diff --git a/.ChangeLog_template b/.ChangeLog_template new file mode 100644 index 0000000000..5186c33143 --- /dev/null +++ b/.ChangeLog_template @@ -0,0 +1,102 @@ +=============================================================== +Tag name: +Originator(s): +Date: +One-line Summary: + +Purpose of changes: + +Requirements for tag: + +Test level of tag: regular, short, tools, build_namelist, doc + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (cime, rtm, cism, etc.): + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +CLM testing: + +[... Remove before making trunk_tag. Available test levels: + + a) regular (must be run before handing off a tag to SEs and must be run + before committing a tag) + b) build_namelist (if namelists and/or build_system changed)) + c) tools (only if tools are modified and no CLM source is modified) + d) short (for use during development and in rare cases where only a small + change with known behavior is added ... eg. a minor bug fix) + e) doc (no source testing required) + +... ] + + build-namelist tests: + + yellowstone + + unit-tests (components/clm/src): + + yellowstone + + tools-tests (components/clm/test/tools): + + yellowstone + + PTCLM testing (components/clm/tools/shared/PTCLM/test): + + yellowstone + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel + yellowstone_pgi + yellowstone_gnu (clm45 only) + hobart_nag + +CLM tag used for the baseline comparisons: + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000000..2ec83ff776 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,46679 @@ +=============================================================== +Tag name: clm4_5_1_r120 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Sat Aug 29 22:58:57 MDT 2015 +One-line Summary: CLM 5 nitrogen models Flexible CN and LUNA + +Purpose of changes: + CLM 5 nitrogen models Flexible CN (Bardan Ghimire, LBNL) + and LUNA (Chonggang Xu, LANL). The LUNA model predicts + photosynthetic capacities as measured by Vc, max25 and Jmax25 + under different environmental conditions (see Ali et al 2015). + +Requirements for tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ - 2208 + https://github.com/CESM-Development/cime/issues - 115, 116 + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + addition of use_luna and use_flexibleCN. use_flexibleCN adds + additional namelist options in the clm_nitrogen group. See xml + definitions file for details. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, Bardan Ghimire, Chonggang Xu + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 - flexibleCN. + cimetest/testmods_dirs/clm/flexibleCN - flexible cn regression test + src/biogeophys/LunaMod.F90 - luna model + cimetest/testmods_dirs/clm/luna - luna regression case + +List all existing files that have been modified, and describe the changes: + + new namelist controls for flexibleCN and luna, clm_nitrogen namelist group: + bld/namelist_files/namelist_definition_clm4_5.xml + bld/namelist_files/namelist_defaults_clm4_5.xml + bld/CLMBuildNamelist.pm + src/main/clm_varctl.F90 + src/main/controlMod.F90 + + flexibleCN + src/biogeochem/CNVegCarbonStateType.F90 - Michaelis-Menten Nitrogen uptake + src/biogeochem/CNVegNitrogenStateType.F90 - Michaelis-Menten Nitrogen uptake + + src/biogeochem/CNGRespMod.F90 - excess carbon storage + src/biogeochem/CNGapMortalityMod.F90 - excess carbon storage + + src/biogeochem/NutrientCompetitionFactoryMod.F90 - add flexible cn option + src/biogeochem/NutrientCompetitionMethodMod.F90 - modify interface to accomidate flexiblecn + src/biogeochem/CNPhenologyMod.F90 - floating cn evergreen phenology + src/biogeochem/CNDriverMod.F90 - update function call args + src/main/pftconMod.F90 - flexible cn pft variables + + src/main/histFileMod.F90 - nlev canopy + src/main/clm_driver.F90 - update function call args + src/main/clm_instMod.F90 - update function call args + src/biogeophys/WaterfluxType.F90 - additional water flux vars + src/biogeophys/SoilWaterMovementMod.F90 - soil water work around + + LUNA + src/main/clm_varcon.F90 - new constant for luna + src/biogeophys/PhotosynthesisMod.F90 - luna use of vcmax25 and jmax25 + src/biogeophys/CanopyFluxesMod.F90 - luna calculation of vcmax25 and jmax25 + src/main/atm2lndType.F90 - state data needed for luna + src/biogeophys/FrictionVelocityMod.F90 - luna variables + src/biogeophys/WaterStateType.F90 - luna variables + src/biogeophys/TemperatureType.F90 - luna variables + src/biogeophys/SolarAbsorbedType.F90 - luna variables + src/biogeophys/QSatMod.F90 - saturated vapor pressure density + src/biogeophys/SoilHydrologyType.F90 - luna var + src/biogeophys/CanopyStateType.F90 - update vcmax and jmax for luna + + cimetest/ExpectedTestFails.xml - update for cime bugs 115 and 116 + cimetest/testlist_clm.xml - update test list for aux_clm_short, new luna and flexibleCN tests + + +CLM testing: regular, build-namelist + + build-namelist tests: + + yellowstone - unit tests : pass, other pass + + unit-tests (components/clm/src): + + yellowstone - ok + + tools-tests (components/clm/test/tools): n/a + + PTCLM testing (components/clm/tools/shared/PTCLM/test): n/a + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel - 40 ok, 45 ok + yellowstone_pgi - 40 ok, 45 ok + yellowstone_gnu (clm45 only) ok + hobart_nag - not run, tests hang, see bug 2208 + + Testing notes: + + * new namelist group clm_nitrogen causes all nlcomp tests to fail + * introduces new tests for flexibleCN and luna that do not + have baselines in clm4_5_1_r119. + * two new expected fails believed to be related to cime issues + 115 and 116. + * removes the existing aux_clm_short tests and replaces them with + a new set of SMS, ERS and ERP tests that are replicated for + yellowstone gnu, intel and pgi. + +CLM tag used for the baseline comparisons: clm4_5_1_r119 + +Changes answers relative to baseline: none + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r119 +Originator(s): erik (Erik Kluzek) +Date: Wed Aug 26 22:29:10 MDT 2015 +One-line Summary: Bring hobart/nag bug fixes to trunk, and fix a few bugs + +Purpose of changes: + +Bring hobart/nag bug fixes to trunk. Fix ncl6.3.0 bug for getregional script. +Fix use_c13 bug. Update RTM to handle regional direction files. Make sure _r8 +constants in ED have a decimal point, so the NAG compiler will treat them as +double-precision rather than as integer*2. + +Move testing from goldbach to hobart. For hobart_nag make all of the tests +on just one node (24 processors). + +Requirements for tag: compile run with hobart/nag (fix bugs 2205 and 2199) + move testing from goldbach to hobart + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2206 (PTCLM stopped working with pft number in surface dataset filenames for mksurfdata.pl) + 2205 (Problems with some constants in ED for NAG compiler) + 2199 (crayftn compiler issue with continuation in middle of string) + 2180 (ncl6.3.0 bug for getregional script) + 2174 (use_c13 bug, unformatted write caused model to die) + 2156 (Update RTM to handle regional direction files) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, klindsay + +List any svn externals directories updated (cime, rtm, cism, etc.): PTCLM, cime and rtm + cime to cime2.0.07 + rtm to rtm1_0_52 + PTCLM to PTCLM2_150826 + +List all files eliminated: Move goldbach to hobart + +D components/clm/test/tools/tests_posttag_goldbach_nompi + +List all files added and what they do: Move goldbach to hobart + +A components/clm/test/tools/tests_posttag_hobart_nompi + +List all existing files that have been modified, and describe the changes: + +------------ Move goldbach to hobart, remove PGI option for hobart +M components/clm/test/tools/test_driver.sh + +M components/clm/bld/unit_testers/build-namelist_test.pl -- Fix ED tests so megan off + +M components/clm/cimetest/testlist_clm.xml --- Move goldbach tests to hobart + Make 2-node hobart_nag tests on a single node + +M components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl -- Fix so will + work with ncl6.3.0, bug 2180 + +M components/clm/src/README.unit_testing --- add some notes about unit-testing + +------------ Bug 2205, some _r8 constants in ED don't have a decimal point +------------ and the NAG compiler then treats them as integer*2. +M components/clm/src/ED/main/EDCLMLinkMod.F90 +M components/clm/src/ED/main/EDRestVectorMod.F90 +M components/clm/src/ED/main/EDInitMod.F90 +M components/clm/src/ED/fire/SFMainMod.F90 +M components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +M components/clm/src/ED/biogeophys/EDBtranMod.F90 +M components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +M components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +M components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +M components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 + +------------ Bug 2199, write to iulog was unformatted, which caused the model +------------ to die after it had already done formatted writes. +M components/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +M components/clm/src/biogeochem/CNVegCarbonStateType.F90 + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (components/clm/src): + + yellowstone yes + + tools testing (components/clm/test/tools): + + yellowstone yes + + PTCLM testing (components/clm/tools/shared/PTCLM/test): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu (clm45 only) yes + hobart_nag yes + hobart_pgi yes + hobart_intel yes + +CLM tag used for the baseline comparisons: clm4_5_1_r118 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r118 +Originator(s): sacks (Bill Sacks) +Date: Wed Aug 5 16:22:33 MDT 2015 +One-line Summary: Minor rework of glc coupling fields + +Purpose of changes: + + This makes CLM compatible with recent CIME changes. + + (1) Use renamed coupler field, in both clm40 and clm45 + + (2) In clm45 code, rework clm_cpl_indices to use glc_elevclass_mod (simpler + and more robust than the earlier code) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.1.11 -> cime2.0.0 + cism2_0_09 -> cism2_1_02 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes +M components/clm/src/cpl/clm_cpl_indices.F90 +M components/clm/src/cpl/lnd_import_export.F90 +M components/clm/src_clm40/main/clm_cpl_indices.F90 +M components/clm/src_clm40/main/lnd_import_export.F90 + +========= Document new unit testing method needed for yellowstone, due to cime update +M components/clm/src/README.unit_testing + +========= Rework test mods due to a fundamental change in how the forced + decrease / increase in glc area works +M components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/user_nl_cism +M components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/user_nl_cism + +========= New failures, which seem to be attributable to the cime update, + unrelated to my changes. However, the NCK and CME test failures seem + dependent on the order in which tests are run, so these problems are + hard to reproduce. Running them as single tests leads to PASSes. +M components/clm/cimetest/ExpectedTestFails.xml ++ CFAIL CME_Ld5.f10_f10.ICN.yellowstone_intel ++ FAIL NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default ++ RUN ERS_D_Mmpi-serial_Ld5.1x1_brazil.ICLM45ED.yellowstone_gnu.clm-edTest + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok - but see caveat below! + +As noted above, there are three new test failures. The ERS_D ICLM45ED failure +seems to be a legitimate bug in CLM. The other two (CFAIL +CME_Ld5.f10_f10.ICN.yellowstone_intel and FAIL +NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default) seem to be intermittent +failures, likely due to a bug in the test system or elsewhere in cime. These +sometimes pass and sometimes fail. They always seem to pass when run as single +tests, but sometimes fail when run as part of a test suite. It's not clear if +the new cime is to blame directly, or if these are arising now simply because +tests are being run in a different order. + +golbach-nag does not run out-of-the-box with this tag. However, it should run +out-of-the-box if you merge in the next commit in cime master +(4b52ec73086a4290323dddfde6087a6d6d12ab96). I did my changes with that commit +merged in, but this hadn't come to master in time for me to include it in this +CLM tag. + +CLM tag used for the baseline comparisons: clm4_5_1_r117 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Configurations with CISM (IG), both CLM4 and CLM45 + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Likely larger than roundoff/same climate (but not investigated closely) + + These changes are due to a complete rework of the coupling between CISM + and CLM, manifested as major changes in the CIME and CISM externals. (The + changes in CLM are not directly responsible for the answer changes.) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r117 +Originator(s): sacks (Bill Sacks) +Date: Tue Jul 28 06:01:04 MDT 2015 +One-line Summary: Repartition rain vs. snow from atmosphere + +Purpose of changes: + + Add an option to repartition rain vs. snow from atmosphere based on + near-surface temperature. This repartitioning uses a ramp-based partitioning + that is also used in datm: we ignore the rain vs. snow partitioning sent from + the atmosphere, and generate our own rain vs. snow partitioning. A sensible + heat flux is generated to conserve energy with this repartitioning. + + The motivation for this is two-fold: + + (1) There are biases in CAM which cause rain to be generated in cold + conditions. This is particularly a problem for glacier surface mass + balance in Greenland. Andrew Gettelman has suggested putting in place + this workaround in CLM until CAM can find a robust fix. + + (2) With the downscaling to glacier elevation classes, it is useful to have + a different rain/snow partitioning in each elevation class. + + This repartitioning is on by default in CLM5, off by default in CLM4.5. + + If / when the CAM bias is fixed, we could potentially change this code so + that it just does the repartitioning over the do_smb filter, similarly to the + other downscaling in atm2lndMod. (Rather than doing this correction + everywhere - which we do now in order to correct the rain vs. snow + partitioning bias in CAM.) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + + Removed glcmec_downscale_rain_snow_convert option, added + repartition_rian_snow option + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Sean Swenson reviewed the calculation of the sensible heat +flux correction + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.1.10 -> cime1.1.11 + This creates a new shared routine for partitioning rain vs. snow, now shared + between datm and CLM. + +List all files eliminated: + +List all files added and what they do: + +========= Add unit tests for repartitioning of rain vs snow, and supporting + utility code +A components/clm/src/main/test/atm2lnd_test/test_sens_heat_from_precip_conversion.pf +A components/clm/src/main/test/atm2lnd_test/CMakeLists.txt +A components/clm/src/main/test/atm2lnd_test/test_partition_precip.pf +A components/clm/src/main/test/atm2lnd_test +A components/clm/src/unit_test_shr/unittestArrayMod.F90 +A components/clm/src/unit_test_shr/test/unittestArray_test/CMakeLists.txt +A components/clm/src/unit_test_shr/test/unittestArray_test/test_unittestArray.pf +A components/clm/src/unit_test_shr/test/unittestArray_test + +List all existing files that have been modified, and describe the changes: + +========= Repartition rain vs snow from atmosphere, and add a sensible heat flux + correction for energy conservation +M components/clm/src/biogeophys/EnergyFluxType.F90 +M components/clm/src/main/clm_driver.F90 +M components/clm/src/main/clm_varctl.F90 +M components/clm/src/main/controlMod.F90 +M components/clm/src/main/atm2lndType.F90 +M components/clm/src/main/lnd2atmType.F90 +M components/clm/src/main/atm2lndMod.F90 +M components/clm/src/main/lnd2atmMod.F90 + +========= Remove glcmec_rain_snow_threshold +M components/clm/src/main/clm_varcon.F90 + +========= Remove glcmec_downscale_rain_snow_convert option, add + repartition_rain_snow option +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M components/clm/bld/CLMBuildNamelist.pm + +========= Add an IG CLM5 test +M components/clm/cimetest/testlist_clm.xml + +========= Remove glcmec_downscale_rain_snow_convert setting (which no longer exists) +M components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/user_nl_clm + +========= Add unit tests for repartitioning of rain vs snow, and supporting + utility code +M components/clm/src/main/CMakeLists.txt +M components/clm/src/main/test/CMakeLists.txt +M components/clm/src/biogeophys/CMakeLists.txt +M components/clm/src/unit_test_shr/test/CMakeLists.txt +M components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 +M components/clm/src/unit_test_shr/CMakeLists.txt + +CLM testing: + + build-namelist tests: + + yellowstone: ok (changes namelists, as expected) + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r116 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM5 cases + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Likely new climate, but not investigated closely + + Answer changes are due to new rain vs. snow partitioning, which is on by + default in CLM5. + + Also changes answers for + ERP_D_Ld5.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags + (expected, since it no longer downscales precip). + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r116 +Originator(s): sacks (Bill Sacks) +Date: Wed Jul 22 06:39:28 EDT 2015 +One-line Summary: Rename some history fields + +Purpose of changes: + + (1) Make QSNOMELT point to qflx_snomelt, as it does in CLM4.0, rather than + qflx_snow_drain (previously qflx_snow_melt) + + (2) Turn on QSNOFRZ by default (parallels QSNOMELT) + + (3) For the 3 history fields that have FOO and FOO_NODYNLNDUSE versions: + Rename FOO to FOO_TO_COUPLER and FOO_NODYNLNDUSE to FOO. This is at Sean + Swenson's suggestion: He points out that the version without the dyn landuse + adjustment (and, soon, the sensible heat adjustment from rain/snow + conversion) is the one most people will be interested in, so should be the + one without the suffix. + + (4) Tweak test lists: + + (a) Move prealpha & prebeta goldbach tests to hobart + + (b) Move an aux_clm45 pgi test to intel: With recent versions of cime + (starting with cime1.1.0), threading tests with pgi take a very long time. So + this test took 3 hours with pgi, vs 20 min with intel. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 2178 (QSNOMELT incorrect in clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= See summary above +M components/clm/src/main/lnd2atmType.F90 +M components/clm/src/biogeophys/WaterfluxType.F90 +M components/clm/src/biogeophys/EnergyFluxType.F90 +M components/clm/cimetest/testlist_clm.xml + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: NOT RUN + mac: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r115 + +Changes answers relative to baseline: YES + + Just changes a few diagnostic fields, for CLM4.5 and CLM5: + + - QSNOMELT: changed to qflx_snomelt rather than qflx_snow_drain + + - QRUNOFF: differs for cases with transient landcover + + - FSH: differs for cases with CISM + + - QSNWCPICE: differs for cases with CISM + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r115 +Originator(s): sacks (Bill Sacks) +Date: Wed Jul 15 05:26:37 MDT 2015 +One-line Summary: Remove redundant code, rename a variable + +Purpose of changes: + + (1) Remove some redundant code in SnowHydrologyMod, related to 'void'. This + was supposed to be removed a long time ago. (Apparently the issue this was + trying to fix was fixed in a different, more robust way.) + + (2) Remove redundant, unused copy of accumulMod in utils/ (newer copy is in + main/) + + (3) Rename qflx_snow_melt to qflx_snow_drain, to avoid confusion with the + existing qflx_snomelt. + + (4) Clarify documentation of snowdp_col + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: + +========= Redundant and unused (copy in main/ is used) +D components/clm/src/utils/accumulMod.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Rename qflx_snow_melt to qflx_snow_drain +M components/clm/src/biogeophys/CanopyHydrologyMod.F90 +M components/clm/src/biogeophys/LakeHydrologyMod.F90 +M components/clm/src/biogeophys/BalanceCheckMod.F90 +M components/clm/src/biogeophys/WaterfluxType.F90 +M components/clm/src/biogeophys/SoilTemperatureMod.F90 +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + - also remove redundant lines of code related to 'void' (see above) +M components/clm/src/biogeophys/LakeTemperatureMod.F90 + +========= Clarify documentation for snowdp_col +M components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +M components/clm/src/biogeophys/WaterStateType.F90 + +========= Remove SMS_Lm25.f10_f10.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + (runs out of wall-clock time, and we have sufficient test coverage of + that configuration) +M components/clm/cimetest/testlist_clm.xml + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r114 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r114 +Originator(s): sacks (Bill Sacks) +Date: Fri Jul 10 19:34:57 MDT 2015 +One-line Summary: Update cime external, remove genf90-generated files + +Purpose of changes: + + Main purpose is to update the cime external to the version in cesm1_4_beta05. + + This also required updating the unit test build to use genf90 during the + build rather than relying on already-generated files. + + Making this change led to some genf90'd files being regenerated in-source + during the unit test build, which would lead these files to be updated every + time we make a tag. To avoid this annoyance, I have removed the genf90'd + files from the repository: These are not needed any more in either the unit + test or system builds, and it simplifies things to remove them. + + Then I added an svn:ignore property to ignore files generated by genf90 + during the unit test build. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.0.7 -> cime1.1.10 + + Among other things, this brings in Jay's big batch system refactor + +List all files eliminated: + +========= Remove genf90-generated files, and some scripts that were used to + create them (these are now created as part of the unit test or system build) +D components/clm/src/dyn_subgrid/dynVarMod.F90 +D components/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +D components/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +D components/clm/src/dyn_subgrid/do_genf90 +D components/clm/src/unit_test_stubs/utils/do_genf90 +D components/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90 +D components/clm/src/unit_test_stubs/main/ncdio_var.F90 +D components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 +D components/clm/src/unit_test_stubs/main/do_genf90 +D components/clm/src/utils/restUtilMod.F90 +D components/clm/src/main/ncdio_pio.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Generate files with genf90 rather than using pre-generated files +M components/clm/src/CMakeLists.txt + +========= Document new, simpler method for building and running the unit tests + (thanks largely to new default options in run_tests.py) +M components/clm/src/README.unit_testing + +========= Add svn:ignore property to ignore files generated by genf90 during the + unit test build + M components/clm/src/dyn_subgrid + M components/clm/src/unit_test_stubs/utils + M components/clm/src/unit_test_stubs/main + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r112 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: intel + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff, according to cime documentation + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A: Trusting Sean Santos's cime documentation. + + These changes were likely due to this change in cime: + + commit 0d7eab6bd112565ba9eb6eb82b74127ae5a5f390 + Author: Sean Patrick Santos + Date: Fri May 15 12:35:31 2015 -0600 + + Use our native gamma/erf implementations on Intel + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r113 +Originator(s): sacks (Bill Sacks) +Date: Thu Jul 9 10:01:13 MDT 2015 +One-line Summary: Support backwards compatibility of restart variable names + +Purpose of changes: + + Previously, if a restart variable was renamed, backwards compatibility was + implemented in an ad-hoc manner. A key point is taht none of these ad-hoc + solutions allowed backwards compatibility when running + initInterp. (initInterp would just skip any variable if it could not find an + exact match on the input [template] file.) + + This tag provides a standard mechanism for putting in place backwards + compatibility when renaming a restart variable. This backwards compatibility + carries over to initInterp, by communicating the necessary metadata through a + new attribute on the restart file: 'varnames_on_old_files'. + + In order to use this new mechanism, give a colon-delimited list of variable + names in the varname argument to restartvar. For example, if a restart + variable FOO has been renamed to BAR, then specify varname='BAR:FOO'. Note + that this list is searched in order, and the first item should be the current + restart variable name. + + Also, applied this new mechanism to the recently-added LIQCAN + variable. Previously, backwards compatibility of this variable was handled in + an ad-hoc manner, which did not work when running initInterp. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Erik + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= Add module for higher-level netcdf utilities. Currently contains + routine for finding a variable on a netcdf file from a list of + possible variables. Also add unit tests for this routine. +A components/clm/src/main/ncdio_utils.F90 +A components/clm/src/main/test/ncdio_utils_test/test_ncdio_utils.pf +A components/clm/src/main/test/ncdio_utils_test/CMakeLists.txt +A components/clm/src/main/test/ncdio_utils_test + +List all existing files that have been modified, and describe the changes: + +========= Allow multiple possible names in reading restart files and in reading + the 'input' file in initInterp +M components/clm/src/utils/restUtilMod.F90.in +M components/clm/src/utils/restUtilMod.F90 +M components/clm/src/main/initInterp.F90 + +========= Apply new mechanism to recently-added LIQCAN restart field. Also + remove redundant setting of snocan_patch to 0 if it isn't found on the + restart file - not needed since initCold is always called. +M components/clm/src/biogeophys/WaterStateType.F90 + +========= Changes to support unit testing of ncdio_utils +M components/clm/src/main/CMakeLists.txt +M components/clm/src/main/test/CMakeLists.txt +M components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in +M components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 + +========= Fix path to genf90 for new cime organization +M components/clm/src/unit_test_stubs/main/do_genf90 +M components/clm/src/unit_test_stubs/main/ncdio_var.F90 + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r112 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r112 +Originator(s): oleson (Keith Oleson,UCAR/TSS,303-497-1332) +Date: Wed Jul 1 10:14:11 MDT 2015 +One-line Summary: Justin Perket snow on vegetation + +Purpose of changes: Incorporate Justin Perket's snow on vegetation changes + +Requirements for tag: + +Test level of tag: regular, build-namelist, unit_tests + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: Add snowveg_flag item + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Keith Oleson, Justin Perket, Erik Kluzek + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: +M components/clm/src/README.unit_testing Add note that instructions are for bash shell +M components/clm/src/biogeophys/CanopyFluxesMod.F90 snow/liq on vegetation +M components/clm/src/biogeophys/WaterStateType.F90 history/restart handling for snow/liq on vegetation +M components/clm/src/biogeophys/BalanceCheckMod.F90 line spaces only +M components/clm/src/biogeophys/WaterfluxType.F90 history handling for snow on vegetation +M components/clm/src/biogeophys/CanopyHydrologyMod.F90 snow/liq on vegetation and snowveg_flag handling +M components/clm/src/biogeophys/SurfaceAlbedoMod.F90 snow on vegetation optical properties +M components/clm/src/main/controlMod.F90 line spaces only +M components/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml snowveg_flag handling +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml snowveg_flag handling +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml snowveg_flag handling +M components/clm/bld/CLMBuildNamelist.pm snowveg_flag handling + +CLM testing: + + build-namelist tests: + + yellowstone: ok + All CLM45 and CLM50 tests have namelist differences; this is expected due + to addition of new namelist item + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r111 + +Changes answers relative to baseline: Yes, for CLM50 + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM50 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate. See Justin Perket (perketj@umich.edu) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? NA + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: NA + + URL for LMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r111 +Originator(s): sacks (Bill Sacks) +Date: Fri Jun 12 20:19:25 MDT 2015 +One-line Summary: Remove temporary hack to get bfb results in InitSnowLayers + +Purpose of changes: + + In order to get bit-for-bit results in clm4_5_1_r110 (relative to r109), we + put in place a temporary hack in InitSnowLayers that set dz based on the old + equations rather than the new, more general ones - thus avoiding + roundoff-level changes. This looked like: + + if (abs(dz(c,0)-3.59_r8) < eps) then ! TODO remove + col%dz(c, 0) = snow_depth(c)-col%dz(c,-4)-col%dz(c,-3)-col%dz(c,-2)-col%dz(c,-1) + if (abs(dz(c,0)-3.59_r8) > eps) & + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + + This tag removes that temporary hack. + + In this way, we have separated the answer-changing from non-answer-changing + parts of the r110 refactor. Note that the above code confirms that the + differences are no larger than roundoff (eps was 1e-9 in the above case, but + some tests showed that it could have been much smaller - e.g., ~ 1e-15). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r110 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 / CLM5 cold start + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + See above code sample, which confirms that the changes were no greater + than roundoff-level. + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r110 +Originator(s): sacks (Bill Sacks) +Date: Fri Jun 12 15:30:11 MDT 2015 +One-line Summary: Add flexibility to have more snow layers + +Purpose of changes: + + Generalize snow code so that it no longer assumes 5 snow layers. Instead, + make the number of snow layers (and the maximum SWE in the snow pack) a + runtime parameter, allowing 3 - 12 snow layers. + + Most changes were made by Leo van Kampenhout (l.vankampenhout@uu.nl). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 2182 (possible threading issue with optimized pgi builds) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + - new namelist parameters: nlevsno, h2osno_max + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= Add tests with different number of snow layers +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12/user_nl_clm +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12/include_user_mods +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12 +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/user_nl_clm +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/include_user_mods +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly + +========= Add unit tests for snow pack initialization (note: these were added + mainly to facilitate debugging InitSnowLayers; since this routine is + only used in cold-start, these are not critical unit tests, and can be + removed if the maintenance cost proves too high) +A components/clm/src/biogeophys/test/SnowHydrology_test/CMakeLists.txt +A components/clm/src/biogeophys/test/SnowHydrology_test/README +A components/clm/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology.pf +A components/clm/src/biogeophys/test/SnowHydrology_test + +List all existing files that have been modified, and describe the changes: + +========= Major rework to remove assumption of 5 snow layers - instead allow + runtime-setable number of snow layers, between 3 and 12. + Also, clean up white space throughout file, and add mode/indentation + emacs line. +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +========= Minor changes to remove assumption of 5 snow layers +M components/clm/src/biogeophys/SurfaceRadiationMod.F90 +M components/clm/src/biogeophys/SoilTemperatureMod.F90 + - also: remove unused variables, fix array argument declarations to + conform to conventions +M components/clm/src/main/initVerticalMod.F90 + - also: clean up some white space + +========= Add namelist variables to control number of snow layers and maximum SWE +M components/clm/src/main/clm_varcon.F90 +M components/clm/src/main/clm_varpar.F90 +M components/clm/src/main/controlMod.F90 +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M components/clm/bld/CLMBuildNamelist.pm + +========= Minor changes needed for unit testing of SnowHydrologyMod +M components/clm/src/biogeophys/CMakeLists.txt +M components/clm/src/biogeophys/test/CMakeLists.txt +M components/clm/src/biogeophys/SnowSnicarMod.F90 +M components/clm/src/biogeophys/SnowHydrologyMod.F90 +M components/clm/src/biogeophys/AerosolMod.F90 +M components/clm/src/main/CMakeLists.txt +M components/clm/src/unit_test_stubs/main/histFileMod_stub.F90 + +========= Add tests with different number of snow layers +M components/clm/cimetest/testlist_clm.xml + +========= Unrelated change: remove unused variables in associate statements +M components/clm/src/biogeophys/SoilFluxesMod.F90 + +========= Remove a test that now passes (hooray for weird compiler bugs!) +M components/clm/cimetest/ExpectedTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: ok + All CLM45 and CLM50 tests have namelist differences; this is expected due + to addition of 2 new namelist items. + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r109 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r109 +Originator(s): sacks (Bill Sacks) +Date: Sat Jun 6 06:12:02 MDT 2015 +One-line Summary: Fix bug in DivideSnowLayers + +Purpose of changes: + + Fix bug in DivideSnowLayers. Leo van Kampenhout (l.vankampenhout@uu.nl) + discovered the bug and determined how to fix it. He found this bug in the + course of refactoring this routine to introduce loops; without this bug fix, + answers differed with his new logic that removes duplication. + + Specifically: Logic using many IF-statements is employed to see whether or + not a layer may be subdivided, depending on the layer thickness. Currently, + the test for subdividing the BOTTOM layer are only reachable when the layer + above it was also too thick. As it turns out, this is faulty as a situation + can arise where the bottom layers grows even though the layer above it was + not divided, i.e. dumped mass to it. The current understanding is that this + happens through meltwater percolation (liquid h2o is translated to thickness + as well). + + Note that the indentation has not been appropriately corrected, this is because this + fix is only temporary (less cluttered logic will be implemented next). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2183 (incorrect logic for sub-dividing bottom +snow layer in DivideSnowLayers) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mark Flanner + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Bug fix, described above +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +========= Remove failures from here, now that we're using the file in cimetest +M components/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Change a failure type from FAIL to RUN (presumably due to new test + reporting) +M components/clm/cimetest/ExpectedTestFails.xml + +CLM testing: + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r108 + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: All clm4.5 and clm5 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Larger than roundoff. While not investigated carefully, Leo showed that + the impacts are relatively small, so this is believed NOT to be + climate-changing. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r108 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Fri May 29 15:14:26 MDT 2015 +One-line Summary: Crop changes from Sam Levis + +Purpose of changes: Crop model changes from Sam Levis. Increases the number of +crops to 64, with 78 total pfts. Requires new parameters file, surface dataset, +and land use timeseries files. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2146, 2155 + +Known bugs (include bugzilla ID): 2180, 2182 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: n/a + +Describe any changes made to the namelist: n/a + +List any changes to the defaults for the boundary datasets: + Regenerate surface data sets and land use timeseries to increase the number of + pfts and crops with data from Levis. New raw datasets: + rawdata/pftlanduse.3minx3min.simyr2000.c110913/mksrf_78pft_landuse_rc2000_c130927.nc + rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_78pft_landuse_rc2000_c150130.nc + +Describe any substantial timing or memory changes: + Increased memory usage for all crop runs. Exact consequences requires further study. + +Code reviewed by: andre, levis + +List any svn externals directories updated (cime, rtm, cism, etc.): n/a + +List all files eliminated: n/a + +List all files added and what they do: + components/clm/cimetest/ExpectedTestFails.xml - new expected fails file for upcoming cime xfail integration + components/clm/tools/clm4_5/mksurfdata_map/Makefile.data - automate generating all surface data sets + +List all existing files that have been modified, and describe the changes: + clm/bld/CLMBuildNamelist.pm - increase max pft, add info to error message, fix quoted empty string processing (bug 2146) + clm/bld/namelist_files/namelist_defaults_clm4_5.xml - point to new datasets + clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - update rawdata sets + clm/bld/namelist_files/namelist_definition_clm4_5.xml - update sim year range to avoid special cases for testing + clm/bld/test_build_namelist/t/test_do_harvest.pm - update test (bug 2146) + clm/bld/test_build_namelist/t/test_do_transient_crops.pm - update test (bug 2146) + clm/bld/test_build_namelist/t/test_do_transient_pfts.pm - update test (bug 2146) + + clm/cimetest/testmods_dirs/clm/crop_trans_f10/user_nl_clm - point to new datafiles + clm/cimetest/testmods_dirs/clm/crop_trans_sville/user_nl_clm - point to new datafiles + + clm/src/biogeophys/WaterStateType.F90 - workaround for pgi compiler bug + + clm/src/biogeochem/CNNDynamicsMod.F90 - new crop model + clm/src/biogeochem/CNPhenologyMod.F90 + clm/src/biogeochem/CNVegStructUpdateMod.F90 + clm/src/biogeochem/CropType.F90 + clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 + clm/src/biogeochem/VOCEmissionMod.F90 + clm/src/biogeophys/CanopyFluxesMod.F90 + clm/src/biogeophys/PhotosynthesisMod.F90 + clm/src/main/PatchType.F90 + clm/src/main/clm_varpar.F90 + clm/src/main/pftconMod.F90 + clm/src/main/subgridRestMod.F90 + clm/src/main/surfrdMod.F90 + + clm/tools/clm4_5/mksurfdata_map/README + clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - move file writes into functions. write to __dataset_name__.namelist + clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 - update for new crops + clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 + clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 - update for new crops, fix bug 2155. + + clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 - work around for an issue causing abort during urban dataset generation + clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 + + +CLM testing: regular + + build-namelist tests: + + yellowstone unit tests - ok + + unit-tests (components/clm/src): + + yellowstone_intel - ok + + regular tests (aux_clm40, aux_clm45): + + - yellowstone aux clm40 intel - ok + - yellowstone aux clm40 pgi - ok + - yellowstone aux clm45 intel - ok + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - ed - new parameters file - baseline failures expected, ok'd by rfisher + - ERP_D_Ld5.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags - baseline compare fails, roundoff level, unknown cause, ok'd by sacks + - ERP_E_Ld5.f19_g16.I1850CRUCLM45CN.yellowstone_intel.clm-default - baseline compare fails, only occurs with esmf - ok'd by mvertens + - yellowstone aux clm45 gnu - ok + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - yellowstone aux clm45 pgi - + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - ed - new parameters file - baseline failures expected, ok'd by rfisher + - ERI_D_Ld9.f19_g16.I1850CLM45CN.yellowstone_pgi - roundoff in cpl baseline + - ERI_D_Ld9.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan - roundoff in baseline + - ERP_P15x2_Lm13.f10_f10.IHISTCLM45BGC.yellowstone_pgi.clm-monthly - new xfail, #2182, dies at runtime in optimized, threaded pgi builds only. + - yellowstone mksurfdata_map unit_testers - ok + - yellowstone tools tests - ok, known issues with PTCLMmkdata (bug 2180) + +CLM tag used for the baseline comparisons: clm4_5_1_r106 (bit for bit with clm4_5_1_r107) + +Changes answers relative to baseline: yes + + Summarize any changes to answers, i.e., + - what code configurations: crop, ed + - what platforms/compilers: all + - nature of change : answer changes updated crop model. approved by levis. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - simulations with all pfts everywhere were run with merged code. Levis compared current runs with his archived runs. + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r107 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Tue May 19 10:05:49 MDT 2015 +One-line Summary: Update externals to use github version of cime1.0.7. + +Purpose of changes: Switch the cime external from using svn to github. Update cime to cime1.0.7. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): cime 1.0.7 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: regular + + build-namelist tests: + unit-tests: ok + system-tests: not run + + unit-tests (models/lnd/clm/src): + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel 40 - ok; 45 - ok + yellowstone_pgi 40 - ok; 45 - ok + yellowstone_gnu (clm45 only) 45 - ok + +CLM tag used for the baseline comparisons: clm4_5_1_r106 + +Changes answers relative to baseline: none + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r106 +Originator(s): erik/fvitt +Date: Thu May 14 13:22:51 MDT 2015 +One-line Summary: Fix CO2 forcing for MEGAN + +Purpose of changes: + +Bring in changes from Francis Vitt, and Louisa Emmons to correct CO2 forcing +for MEGAN and dry-deposition. Previously, the fixed value of CO2 was being used +rather than using the CO2 forcing sent in from the atmosphere model. + +Also fix some issues with clm4_0 code where some urban diagnostic fields have +a different fill-value pattern on restart from startup. Fill-value is now only +set over non-land, and areas without urban, are set to zero. + ++M models/lnd/clm/src_clm40/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ ++M models/lnd/clm/src_clm40/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin ++ ++M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average ++ ++M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin ++ ++M models/lnd/clm/src/biogeophys/CanopyStateType.F90 ++ - get 10-day average of LAI rather than 1-day average + +Requirements for tag: Fix 2177 and some 2165 clm40 tests + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2177 (MEGAN improperly uses constant CO2 rather than time varying) + 2176 (ED doesn't work with MEGAN -- partial just turn MEGAN off when ED on) + 2165 (some clm40 tests have history files differ on restart in urban fillvalue) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Turn MEGAN off when ED on + Have build-namelist make sure MEGAN is off when ED is on + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,fvitt,simone,emmons + +List any svn externals directories updated (cime, rtm, cism, etc.): cime, cism + cime up to cime0_3_21 (bring in optional orbital calculation) + cism up to cism2_0_09 (just bring the branch to the trunk) + +List all files eliminated: None + +List all files added and what they do: Turn MEGAN off for ED tests + +A components/clm/cimetest/testmods_dirs/clm/edTest/shell_commands + +List all existing files that have been modified, and describe the changes: + + M components/clm/src_clm40/biogeophys/UrbanInitMod.F90 -- Initialize to + zero over land + M components/clm/src_clm40/main/clm_initializeMod.F90 --- Call urbanInit + before reading restart files + M components/clm/src_clm40/main/accFldsMod.F90 ---------- Change running mean + from 1 day to 10 days + M components/clm/src_clm40/main/clmtypeInitMod.F90 ------ Initilize to spval + + M components/clm/src_clm40/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average + M components/clm/src_clm40/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin + + M components/clm/src/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average + M components/clm/src/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin + M components/clm/src/biogeophys/CanopyStateType.F90 ++ - get 10-day average of LAI rather than 1-day average + + M README_cime --- Update documentation + + M components/clm/bld/CLMBuildNamelist.pm -- Check that MEGAN off when ED on + M components/clm/bld/unit_testers/build-namelist_test.pl - Add check for + MEGAN off when ED on + M components/clm/bld/clm.buildnml --- only copy drv_flds_in over if it + was actually created. + + M components/clm/tools/README ---- Have documentation point to gen_domain + under cime/tools/mapping + +CLM testing: regular + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r105 + +Changes answers relative to baseline: Yes -- MEGAN diagnostic fields only! + as well as dry-deposition because of science update + + Summarize any changes to answers, i.e., + - what code configurations: All with MEGAN on + - what platforms/compilers: All + - nature of change: Diagnostic fields change + + VOC emissions change + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r105 +Originator(s): erik (Erik) +Date: Thu Apr 16 13:23:19 MDT 2015 +One-line Summary: Move test lists to beneath active components, change build scripts from cshell + to perl, move to new cime directory structure + +Purpose of changes: + + * Move CESM test lists from under scripts to under active components. + Now clm and rtm have their own CESM test lists under their "cimetest" directory. + * Change build scripts from cshell to perl + cshell is buggy with arbitrary problems with line lengths and number of arguments + cshell doesn't allow long scripts to be broken up into subroutine -- perl does +:::::::::: Get unit-testing working with directory structure change + M src/CMakeLists.txt + M src/README.unit_testing + +:::::::::: Get tools testing working with directory structure change + M test/tools/TBLtools.sh + M test/tools/TSMCFGtools.sh + M test/tools/TSMscript_tools.sh + M test/tools/TCBCFGtools.sh + M test/tools/TCBscripttools.sh + M test/tools/TSMncl_tools.sh + M test/tools/TBLCFGtools.sh + M test/tools/TSMtools.sh + M test/tools/TBLscript_tools.sh + M test/tools/TCBtools.sh + M test/tools/test_driver.sh + +:::::::::: Get tools working with directory structure change + M tools/clm4_0/mksurfdata_map/mksurfdata.pl + M tools/clm4_5/mksurfdata_map/mksurfdata.pl + M tools/shared/ncl_scripts/getco2_historical.ncl + +:::::::::: Updates to build + M bld/CLMBuildNamelist.pm + M bld/configure + M bld/queryDefaultNamelist.pl + M bld/listDefaultNamelist.pl + M bld/unit_testers/xFail/wrapClmTests.pl + M bld/unit_testers/xFail/expectedFail.pm + M bld/test_build_namelist/test_build_namelist.pl + M bld/namelist_files/checkmapfiles.ncl + M bld/namelist_files/namelist_definition.xsl + +:::::::::: Updates to documentation with new directory structure + M doc/README + M doc/UsersGuide/co2_streams.txt + M doc/Quickstart.userdatasets + M doc/Quickstart.GUIDE + M doc/KnownLimitations + M tools/README + M tools/README.filecopies + M tools/clm4_0/interpinic/README + M tools/clm4_0/mksurfdata_map/README + M tools/clm4_5/refactorTools/associate/README + M tools/clm4_5/refactorTools/clmType/README + M tools/clm4_5/mksurfdata_map/README + M tools/shared/mkmapgrids/README + M tools/shared/mkmapdata/README + M tools/shared/mkprocdata_map/README + M tools/shared/ncl_scripts/README + M tools/README.testing + M bld/README + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, and aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r104 + +Changes answers relative to baseline: + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r104 +Originator(s): erik (Erik) +Date: Tue Jan 27 11:22:48 MST 2015 +One-line Summary: Update externals to latest cesm beta tag + bring in shared build for clm4_5/clm5_0 for testing + +Purpose of changes: + +* Update externals to cesm1_3_beta15+ shared clm4_5/clm5_0 library build for testing. +* Fix BG1850CN @ f09 by changing fglcmask (Bill Sacks) +* Update more prealpha/prebeta tests to test with clm4_5 +* Create datasets for clm4_5 at ne16 and ne120 resolution + (for ne120 create rcp8.5 and rcp4.5 transient datasets) + M models/lnd/clm/src/cpl/lnd_comp_mct.F90 ----------- Add only for lnd_import_export use statement + +------------ Change so sample subsetting uses the high resolution datasets + M models/lnd/clm/tools/shared/ncl_scripts/README.getregional + M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist + M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + tools testing: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu (clm45 only) yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r103 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: time-change all, roundoff-intel + - nature of change: roundoff + + Small change in driver changes time-stamps on history files by roundoff (drvseq5_1_05). + Normal cprnc comparison then does NOT compare fields and calls files different. Changes + in the intel build (on yellowstone) change answers to roundoff for intel on yellowstone + (Machines update between Machines_141125 and Machines_150106a causes answers to change) + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r103 +Originator(s): sacks (Bill Sacks) +Date: Thu Jan 1 06:15:57 MST 2015 +One-line Summary: enable transient crops + +Purpose of changes: + +(1) Allow transient crops! Note that carbon and nitrogen conservation still is + not done, but this at least allows crop areas to evolve in time. + +(2) Add control flags for which pieces of the transient dynamics should be done: + transient natural PFTs, transient crops, and/or harvest. + +(3) Reworked both source code and unit tests to be able to use the true CLM time + manager in unit tests rather than a stub version. Also added functionality + to time_info_type to be able to take the date from the end of the current + time step or the beginning of the time step. This flexibility was needed + because: (a) for crops, with an annual update, I wanted the update time to + be consistent with the glacier update time: the first time step after + crossing the year boundary (so take time from the start of the time step); + (b) for transient PFTs and harvest, for consistency with what was being done + before, we need to take the time from the end of the time step. + +(4) Make CNBalanceCheck more modular and object-oriented. Also, bypass the + balance check for newly-active columns, which is needed to avoid balance + check errors with transient crops. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: New control flags that control which +aspects of transient subgrid dynamics (and harvest) are turned on/off. This lets +you turn on/off transient natural PFTs, transient crops, and/or harvest +independently. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: some pieces reviewed by Erik + + scripts: append_nl_value_n03_scripts4_141201 -> append_nl_value_n07_scripts4_141201 + esmf_wrf_timemgr: esmf_wrf_timemgr_141028 -> esmf_wrf_timemgr_141217 + +List all files eliminated: + +========= No longer use stub time manager - use true time manager instead +D models/lnd/clm/src/unit_test_stubs/utils/clm_time_manager_stub.F90 + +List all files added and what they do: + +========= Add transient crops +A models/lnd/clm/src/dyn_subgrid/dyncropFileMod.F90 + +========= Reads and stores namelist items controlling transient dynamics. This + allows turning off select pieces of the transient subgrid behavior. +A models/lnd/clm/src/dyn_subgrid/dynSubgridControlMod.F90 + +========= Add unit test utilities that wrap the clm time manager +A models/lnd/clm/src/unit_test_shr/unittestTimeManagerMod.F90 + +========= Start adding unit tests for the clm time manager +A models/lnd/clm/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf +A models/lnd/clm/src/utils/test/clm_time_manager_test/CMakeLists.txt +A models/lnd/clm/src/utils/test/clm_time_manager_test +A models/lnd/clm/src/utils/test/CMakeLists.txt +A models/lnd/clm/src/utils/test + +========= Test logic for new control flags +A models/lnd/clm/bld/test_build_namelist/t/test_do_transient_pfts.pm +A models/lnd/clm/bld/test_build_namelist/t/test_do_harvest.pm +A models/lnd/clm/bld/test_build_namelist/t/test_do_transient_crops.pm + +List all existing files that have been modified, and describe the changes: + +========= Reworked both source code and unit tests to be able to use the true + CLM time manager in unit tests rather than a stub version. Also added + functionality to time_info_type to be able to take the date from the + end of the current time step or the beginning of the time step. Note + that some unit test builds now need to link against the + esmf_wrf_timemgr library, if they use the time manager either directly + or indirectly. +M models/lnd/clm/src/utils/clm_time_manager.F90 +M models/lnd/clm/src/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 +M models/lnd/clm/src/unit_test_stubs/utils/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt +M models/lnd/clm/src/unit_test_shr/CMakeLists.txt +M models/lnd/clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +M models/lnd/clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/Daylength_test/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt +M models/lnd/clm/src/utils/CMakeLists.txt + +========= Changes related to new control flags, as well as the rework of the + time_info%set_current_year interface +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 + +========= Changes related to new control flags and addition of transient crops +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Moved flanduse_timeseries and other control flags into dynSubgridControlMod +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/subgridRestMod.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/biogeochem/CNDriverMod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 + +========= Make CNBalanceCheck more modular and object-oriented +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 + - also, bypass balance checks for newly-active columns (needed to + avoid balance check errors for newly-active crop columns) +M models/lnd/clm/src/biogeochem/CNVegNitrogenStateType.F90 +M models/lnd/clm/src/biogeochem/CNVegCarbonStateType.F90 +M models/lnd/clm/src/main/clm_instMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 + - also make alt_calc operate over inactive as well as active points + +========= Added new control flags +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +========= Make test files (more) consistent with actual files. This may not have + been necessary. +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml + +========= Minor changes (e.g., changes to comments and other small changes) +M models/lnd/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 +M models/lnd/clm/src/dyn_subgrid/do_genf90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +M models/lnd/clm/src/biogeophys/ActiveLayerMod.F90 + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + Note that there are differences from baseline due to new control flags + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r102 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r102 +Originator(s): sacks (Bill Sacks) +Date: Sat Dec 27 06:52:20 MST 2014 +One-line Summary: make new input datasets to support transient crops + +Purpose of changes: + +While the main purpose of this tag was to make new input datasets to support +transient crops, it also includes a number of reworks of mksurfdata_map, which +were either central or tangential to this overall goal. Specifically: + +(1) Update mksurfdata_map to be able to generate datasets with transient + crops. Currently the logic uses the non-prognostic-crop raw data for the + transient time series: It takes the area of the generic crop from that + timeseries to specify the transient PCT_CROP area, and sets the PCT_CFT + areas based on the year-2000 areas. + +(2) Rewrite mksurfdata_map code that normalizes pct_pft to account for special + landunits. The code to handle urban was very confusing, and I hope this new + code is at least astep towards being less confusing. Note that this + introduces roundoff-level differences. + +(3) Introduce new mksurfdata_map utility routines: ncd_def_spatial_var and + ncd_put_time_slice. These encapsulate behavior that used to be duplicated in + the code. + +(4) Add mksurfdata_map unit tests using the new pfunit-based unit testing + framework. However, I have NOT done a full migration of the mksurfdata_map + unit tests. Thus, there are still some tests that use the old unit testing + framework that I put in place (which leveraged the test stuff that Erik set + up for csm_share a while ago). These tests can be migrated to pfunit + incrementally: as someone touches code that is under test using the old + framework, they could move the relevant tests into the new pfunit-based + framework. + +(5) Create new input datasets, based on the above changes: + + - new flanduse_timeseries files created because I have changed the + information on these files + + - new surface datasets created because I introduced roundoff-level changes + in the surface datasets, and so regenerated all surface datasets now in + order to save someone a headache later. + + - new initial conditions files created so that out-of-the-box initial + conditions will be compatible with the surface datasets, according to + various consistency checks. + + See the following files in inputdata for documentation of how the new + datasets were created: + + lnd/clm2/surfdata_map/README_c141219 + lnd/clm2/initdata_map/README_c141226 + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- new surface datasets +- new flanduse_timeseries files +- new initial conditions files + +List any changes to the defaults for the boundary datasets: +- new surface datasets +- new flanduse_timeseries files +- new initial conditions files + +Describe any substantial timing or memory changes: none + +Code reviewed by: Most changes sent to Erik for review, although I can't +remember how much he actually reviewed. + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: append_nl_value_n02_scripts4_141201 -> append_nl_value_n03_scripts4_141201 + - point tropicAtl_subset tests to new file + +List all files eliminated: + +========= Move tests elsewhere +D models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkpftMod.F90 + + +List all files added and what they do: + +========= New object-oriented class for storing and operating on pct_pft + data. Encapsulating a bunch of behavior in here allowed me to simplify + other code. Before this, I was keeping track of two separate + representations of pct_pft: First it was stored as % of grid cell, + then it was later converted into % of landunit together with the + landunit's % of grid cell. This was starting to get hard to manage, + because certain operations could only be done on the first + representation, and other operations could only be done on the second + representation – and at some point in the processing pipeline, the + conversion happened and the first representation was no longer + usable. Now there is a single representation, and the class allows any + desired operation to be performed on that single representation. This + adds some complexity within the class, but removes complexity from the + rest of the code, particularly mksurfdat.F90. +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpctPftTypeMod.F90 + +========= This new module contains routines that operate on both instances of + pct_pft_type (pctnatpft and pctcft) at once. Thus, this contains + higher-level logic than was appropriate for mkpctPftTypeMod. Yet, I + wanted these routines in a separate module from mkpftMod as an aid to + testing, since mkpftMod has a bunch of dependencies. +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftUtilsMod.F90 + +========= Moved constants from other places into here, partly to centralize + them, and partly to remove problems with circular dependencies +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 + +========= Add automated test of making a transient crop surface dataset +A models/lnd/clm/test/tools/nl_files/mksrfdt_10x15_crp_1850-2000 + +========= Add input file for creating a transient smallville dataset for testing + transient crops +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README.landuse_timeseries_smallvilleIA_hist_simyr1850-1855 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files + +========= Add pfunit-based unit tests for mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_adjust_total_veg_area.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_convert_from_p2g.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/test_mkpctPftType.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/README.unit_testing + + +List all existing files that have been modified, and describe the changes: + +========= Changes that take advantage of some of the other refactoring described + here, plus add logic to allow input dataset to not contain crops even + when generating a transient dataset for crops; also add PCT_CROP and + PCT_CFT on the landuse_timeseries output file +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Changes that take advantage of some of the other refactoring described + here, especially making use of the new pct_pft_type methods. Plus: (a) + save pctcft from the initial input file so it can be used when + generating landuse_timeseries, (b) remove unwanted landunit percents + from the landuse_timeseries file, (c) add transient PCT_CROP and + PCT_CFT, (d) complete rewrite of the code that normalizes pct_pft to + account for special landunits: the code to handle urban was very + confusing, and I hope this new code is at least a step towards being + less confusing [this change introduces roundoff-level differences], + (e) remove some error-checking code that is now embedded in the + pct_pft_type routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + +========= Updated for new files +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles + +========= Added two new routines: ncd_def_spatial_var and + ncd_put_time_slice. These encapsulate behavior that used to be + duplicated in the code. Also, moved convert_latlon from mkutilsMod to + here, since it is really related to netcdf stuff. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 + +========= Simplify this module significantly by using the new + ncd_def_spatial_var. Also change what fields are present on the + transient landuse file: remove some no-longer-desired fields (% of + special landunits, etc.). +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 + +========= Use new ncd_def_spatial_var +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 + +========= Delete routines that have been moved to a more appropriate place +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 + +========= Remove tests from old test framework for code that I have deleted or + migrated to my new modules; and fix some minor errors that appeared + when runnng the old unit tests with gfortran. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 + +========= Trivial changes (change 'use' statements to reflect migrated code, add + comments, etc.) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 + +========= Add logic needed for creating transient crop datasets. The main + differences are (a) for crop, we create a year-2000 surface dataset + together with the transient dataset (rather than a year-1850 surface + dataset), and (b) we always use the non-crop transient raw data, even + when creating a transient crop dataset. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +========= New fsurdat, flanduse_timeseries and finidat files +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Add automated test of making a transient crop surface dataset +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + tools tests: + + yellowstone: ok + + Note that there were diffs in baseline comparisons for mksurfdata_map tests + (and the PTCLM test, which uses mksurfdata_map). See below for details + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r101 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: most clm4_5 runs + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Note that there were no source code changes in this tag, so the only + differences come from differences in datasets (fsurdat, + flanduse_timeseries, finidat). + + I confirmed that differences in fsurdat and flanduse_timeseries are + generally roundoff-level. There are greater than roundoff-level diffs in + PCT_NAT_PFT at a small number of points, but all of these points have + PCT_NATVEG = 0 (this is due to a fix in how PCT_NAT_PFT is determined for + points with 0% vegetated landunit, and > 0% urban); this would only affect + dynamic landunit runs. Other than that, max normalized RMS diffs are 2e-8, + and most are considerbly smaller. + + finidat files were created as one-offs to ensure that the only differences + are in the subgrid weights, arising from these surface dataset differences. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r101 +Originator(s): sacks (Bill Sacks) +Date: Tue Dec 9 06:27:39 MST 2014 +One-line Summary: rework cold start initialization for transient runs + +Purpose of changes: + + (1) Do not adjust subgrid weights (or set harvest variables) in cold start + initialization. Instead, wait to do this until the first run step. The + motivation for this is (a) this is consistent with what is done for + glacier (for which prognostic weights aren't available until the run + phase), and (b) it simplifies what needs to be done in initialization, + particularly for transient crops (which are coming soon). + + (2) Do not run the biogeophys & biogeochem dyn subgrid conservation code in + the first step of a cold start run. This affects the current operation of + glacier, and is important in conjunction with (1): this avoids doing a + large adjustment of physics or BGC caused by a fictitious change in area + in the first time step after cold start. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens reviewed conceptual changes to clm_time_manager and + DaylengthMod; other changes only reviewed by self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes, as documented above +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 + +========= Unrelated change: Fix a possible threading bug in DaylengthMod + (although this would rarely cause problems: I think this would only + cause a problem if you started / restarted exactly on the solstice) +M models/lnd/clm/src/utils/clm_time_manager.F90 +M models/lnd/clm/src/biogeophys/DaylengthMod.F90 + + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r100 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 cold start runs with glacier and/or + transient PFTs + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Changes answers only in initialization. This shows up as changes in the + fields set to the coupler in initialization, and/or changes in the initial + history file. In offline runs (I compsets), this change does not affect + the simulation beyond initialization, but it is expected to change the + evolution of the system in coupled runs. However, again note that this + only affects cold start runs wth glacier and/or transient PFTs, which + would not be typical for production runs. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r100 +Originator(s): sacks (Bill Sacks); most changes from Jim Edwards +Date: Wed Dec 3 06:21:13 MST 2014 +One-line Summary: update pio calls to pio2 API + +Purpose of changes: + + Update pio calls to the pio2 API, so that the transition to pio2 will be + seamless. Most changes were from Jim Edwards. There are also some other minor + changes that are unrelated to this main change, as noted below. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: sacks + +List any svn externals directories updated (csm_share, mct, etc.): + + pio: pio1_8_13 -> pio1_9_5 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes needed for pio2 API +M models/lnd/clm/src_clm40/main/ncdio_pio.F90 +M models/lnd/clm/src_clm40/main/ncdio_pio.F90.in +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in + +========= Change 2-d array to 1-d. Jim says he thinks this was also needed for + pio2 support. +M models/lnd/clm/src_clm40/main/histFileMod.F90 +M models/lnd/clm/src/main/histFileMod.F90 + +========= Unrelated change: change len to len_trim. Jim says this was needed to + fix a problem on some machine. +M models/lnd/clm/src_clm40/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r099 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r099 +Originator(s): sacks (Bill Sacks) +Date: Tue Dec 2 15:05:09 MST 2014 +One-line Summary: add ozone stress code from Danica Lombardozzi + +Purpose of changes: + +(1) Implement ozone stress. The scientific implementation was done by Danica + Lombardozzi. The software reimplementation was done by Bill Sacks. + +(2) Fix some misc. bugs, including a restart bug that was introduced in r097. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 2091: some restarts not bit-for-bit starting in clm4_5_1_r097 +- 2029: Memory leak in GetGlobalValuesMod + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ +- 2094: ozone code doesn't work with the PGI compiler + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new namelist option, use_ozone + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: ozone changes reviewed by Danica Lombardozzi (she reviewed +both the code and the changes seen due to ozone in a short simulation) + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: append_nl_value_n02_scripts4_141129 -> append_nl_value_n02_scripts4_141201 + +List all files eliminated: + +List all files added and what they do: + +========= Implement ozone stress. Uses polymorphism to handle ozone-on vs. ozone-off. +A models/lnd/clm/src/biogeophys/OzoneFactoryMod.F90 +A models/lnd/clm/src/biogeophys/OzoneOffMod.F90 +A models/lnd/clm/src/biogeophys/OzoneBaseMod.F90 +A models/lnd/clm/src/biogeophys/OzoneMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Calculate and apply ozone stress +M models/lnd/clm/src/biogeophys/PhotosynthesisMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/main/clm_instMod.F90 + - also fix restart bug (bug 2091) +M models/lnd/clm/src/main/clm_driver.F90 + +========= Add namelist flag to turn ozone on +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 + +========= Fix memory leak (bug 2029) +M models/lnd/clm/src/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src_clm40/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 + +========= Workarounds for compiler bugs +M models/lnd/clm/src/biogeochem/CNDVType.F90 +M models/lnd/clm/src/biogeochem/CNDriverMod.F90 + +========= Improve documentation comments for compiler bug workarounds +M models/lnd/clm/src/biogeophys/IrrigationMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 + +========= Add allocation of Points, matching behavior of true routine +M models/lnd/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + Remove these two entries that now pass: + restarts not bit-for-bit + error on hist comparison + + Add this new failure: + compiler bug in PGI's handling of polymorphism + + +CLM testing: + + Note: testing was done on ozone_polymorphism_n09_clm4_5_1_r098, which was + before I put in place the abort if you're trying to run ozone with pgi. After + that, I ran two tests with pgi (one with ozone and one without), and one test + with intel (with ozone) in order to make sure that the abort check was put in + properly. After all testing was complete, I reverted accidental whitespace + changes in clm_initializeMod.F90 and restFileMod.F90 - I did not run any + additional testing after reverting those whitespace changes. + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + + Also, ran these two additional tests, with comparisons to baselines - these + are tests that I have replaced with new tests: + + ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrigOn_reduceOutput + + +CLM tag used for the baseline comparisons: clm4_5_1_r098 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r098 +Originator(s): sacks (Bill Sacks) +Date: Sat Nov 29 06:18:59 MST 2014 +One-line Summary: update externals to cesm1_3_beta14 or beyond + +Purpose of changes: + + Update most externals to cesm1_3_beta14 or beyond. The one exception is mct, + for which I had trouble accessing the tag at the location used in beta14, so + I am sticking with the previous mct tag. + + Some notable changes: + + (1) update in intel compiler on yellowstone to intel15 + + (2) robust fix for number of datm streams, using Sean Santos's dynamic vector + + (3) testmods reworked to use recursive testmods + + (4) unit_testing, CMake & Machines updated so that unit tests now work on + yellowstone + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/refactor_koven_tags/refactor_koven_n02_scripts4_141023 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/append_nl_value_tags/append_nl_value_n02_scripts4_141129 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141017a ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141125 +-scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140715 ++scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_141122 +-models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 ++models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_18 +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141022 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141121 +-models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_140529 ++models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_141028 +-models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_12/pio ++models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_13/pio +-tools/load_balancing_tool https://svn-ccsm-models.cgd.ucar.edu/tools/load_balancing_tool/trunk_tags/load_balancing_tool_140818/ ++tools/load_balancing_tool https://svn-ccsm-models.cgd.ucar.edu/tools/load_balancing_tool/trunk_tags/load_balancing_tool_141008 +-tools/pyReshaper https://subversion.ucar.edu/asap/pyReshaper/tags/v0.9.1/ ++tools/pyReshaper https://proxy.subversion.ucar.edu/pubasap/pyReshaper/tags/v0.9.1 +-tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_08 ++tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_12 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Workaround for pgi internal compiler error +M models/lnd/clm/src/main/clm_driver.F90 + +========= Rework README, mainly to remove the need for using '--clean' +M models/lnd/clm/src/README.unit_testing + +========= Move an xfail from goldbach to yellowstone; add xfail for ERS_Ly5 test + (bug 2091) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Update what machine-comiler combos we test +M .ChangeLog_template + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + + Other than xFails, note that the following failed: + + *** presumably this failed in the previous tag, so baselines didn't exist + BFAIL SMS_D.1x1_mexicocityMEX.I.goldbach_nag.compare_hist.clm4_5_1_r097 + + *** ozone tests that won't work until an upcoming tag that brings ozone in + SFAIL ERS_D.f10_f10.I1850CLM45.goldbach_nag.clm-o3.GC.1128-0838.45.n + SFAIL PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrig_o3_reduceOutput.GC.1128-0838.45.p + SFAIL ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrig_o3_reduceOutput.GC.1128-0838.45.i + + Also, note that the following test failed: + + FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan + + This appears to be a scripts problem. Since Mariana wants to do away with + ERH tests anyway, I just replaced this with: + + PASS ERI_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan + + + Also ran the following two tests, which have been replaced with + (currently-failing) o3 tests: + + ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrigOn_reduceOutput + + The PET test passed, but the ERS test failed (see bug 2091) + +CLM tag used for the baseline comparisons: clm4_5_1_r097 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: yellowstone-intel + - nature of change (roundoff; larger than roundoff/same climate; new climate): + NOT INVESTIGATED + + These diffs are presumably due to the yellowstone-intel compiler upgrade + to v15. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r097 +Originator(s): mvertens mvertens (Mariana Vertenstein,UCAR/CSEG,303-497-1349) +Date: Mon Nov 24 11:06:30 MST 2014 +One-line Summary: major refactorization to introduce new soilbiogeochem data + types and routines that are independent of either ED or CN datatypes + +Purpose of changes: Major refactorization to introduce new soilbiogeochem + data types and permit ED and CN vegetation to be independent of each other + AND both work with either the same soilbiogeochem or in the future + potentially different soilbiogeochem modules + +Requirements for tag: None + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: bld/configure modified to + accomodate new directory structure - introduction of soilbiogeochem/ + directory + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Since use_cn and use_ed + are now mutually exclusive, CN memory is not longer allocated when ED is run + and the memory reduction (for f19_g16) seems to be about 50%. + +Code reviewed by: mvertens, muszala, sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts branch is used + https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/refactor_koven_tags/refactor_koven_n01_scripts4_141023 + +List all files eliminated, added and modified: (see below) +List all files added and what they do: (see below) +List all existing files that have been modified, and describe the changes: (see below) + +These are all grouped together here - since splitting the items up simply did +not make sense in this case + +--------------------------------------------------- +New module where all instances are now declared (moved from clm_initializeMod) +- all calls to instance restarts are here as well - so restFileMod + is greatly simplified +--------------------------------------------------- +A models/lnd/clm/src/main/clm_instMod.F90 + +--------------------------------------------------- +New soilbiogeochem/ directory introduced (new modules and data types) +--------------------------------------------------- +A models/lnd/clm/src/soilbiogeochem + +--------------------------------------------------- +CN state and flux types split into: +SoilBiogeoChem[Carbon|Nitrogen][State|Flux]Type and SoilBiogoechemStateType +CNVeg[Carbon|Nitrogen][State|Flux]Type and CNVegStateType +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNStateType.F90 +D models/lnd/clm/src/biogeochem/CNCarbonFluxType.F90 +D models/lnd/clm/src/biogeochem/CNCarbonStateType.F90 +D models/lnd/clm/src/biogeochem/CNNitrogenFluxType.F90 +D models/lnd/clm/src/biogeochem/CNNitrogenStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegCarbonFluxType.F90 +A models/lnd/clm/src/biogeochem/CNVegCarbonStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegNitrogenStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegNitrogenFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemStateType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 + +--------------------------------------------------- +New modules in soilbiogeochem/ directory that are independent of CNVeg or ED types +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNDecompCascadeConType.F90 +D models/lnd/clm/src/biogeochem/CNNitrifDenitrifMod.F90 +D models/lnd/clm/src/biogeochem/CNVerticalProfileMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompMod.F90 +D models/lnd/clm/src/biogeochem/CNAllocationMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompCascadeCNMod.F90 +D models/lnd/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 + +--------------------------------------------------- +Moved CNEcosystemDynMod to CNDRiverMod +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 +A models/lnd/clm/src/biogeochem/CNDriverMod.F90 + +--------------------------------------------------- +Changes to modules in biogeochem/ directory to now use new datatypes (see above) +--------------------------------------------------- +A models/lnd/clm/src/biogeochem/C14BompbSpikeMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/biogeochem/CNDVDriverMod.F90 +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/biogeochem/SatellitePhenologyMod.F90 +M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/biogeochem/NutrientCompetitionMethodMod.F90 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNSharedParamsMod.F90 +M models/lnd/clm/src/biogeochem/CNDVType.F90 +M models/lnd/clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CropType.F90 +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/biogeochem/CNC14DecayMod.F90 + +--------------------------------------------------- +Moved frictionvel_type to FrictionVelocityMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/FrictionVelocityType.F90 + +--------------------------------------------------- +Moved aerosol_type to AerosolMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/AerosolType.F90 + +--------------------------------------------------- +Moved photosyns_type to PhotosynthesisMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/PhotosynthesisType.F90 + +--------------------------------------------------- +Moved soilstate cold start initialization to a new module +--------------------------------------------------- +A models/lnd/clm/src/biogeophys/SoilStateInitTimeConstMod.F90 + +--------------------------------------------------- +Moved soilhydrology time constant initialization to a new module +--------------------------------------------------- +A models/lnd/clm/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 + +--------------------------------------------------- +ED Refactorization1 +(1) EDPhenologyMod changed to EDPhenologyType +(2) EDBioType moved as a module type (ed_clm_type) in EDCLMLINKMod.F90 +(3) EDVecPatchType no longer needed (for now is_veg, is_bareground and wt_ed are in PatchType.F90) +--------------------------------------------------- +D models/lnd/clm/src/ED/main/EDBioType.F90 +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +D models/lnd/clm/src/ED/main/EDVecPatchType.F90 +D models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 +A models/lnd/clm/src/ED/biogeochem/EDPhenologyType.F90 +A models/lnd/clm/src/ED/biogeochem/EDSharedParamsMod.F90 + +--------------------------------------------------- +ED Refactorization2 +(1) Modified EDTypesMod.F90 + Removed gridcell_edstate_type (array of pointers) and instance + gridcelledstate - now have the following ED types and instance + defined in clm_instMod.F90 and passed down in clm_initialize and clm_driver (top level) + type(ed_site_type), allocatable, target :: ed_allsites_inst(:) + type(ed_phenology_type) :: ed_phenology_inst + type(ed_clm_type) :: ed_clm_inst + so now have ed_allsites_inst which is an array of sites (at this point allocated at the + gridcell level - but that could easily be modified to be at some other level like the + column level +(2) In EDTypesMod.F90 added method map_clmpatch_to_edpatch that + maps a CLM vector patch to an ED linked-list patch - there is still + a one to one correspondence between an ED patch and a CLM vector patch. The + call looks like the following + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + +(3) In EDTypesMod.F90 added a ED Patch type-bound method set_root_fraction that computes + the root fraction for an ED patch +(4) In EDTypes.F90 eliminated the following components of userdata + type (site) , pointer :: firstsite_pnt => null() ! pointer to the first site in the system + type (cohort), pointer :: storesmallcohort => null() ! storage of the smallest cohort for insertion routine + type (cohort), pointer :: storebigcohort => null() ! storage of the largest cohort for insertion routine + These are no longer needed since the above pointers are now local variables + in EDCohortDynamics and EDPatchDynamics +--------------------------------------------------- +M models/lnd/clm/src/ED/main/EDVecCohortType.F90 +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +M models/lnd/clm/src/ED/main/EDInitMod.F90 +M models/lnd/clm/src/ED/main/EDMainMod.F90 +M models/lnd/clm/src/ED/main/EDTypesMod.F90 +M models/lnd/clm/src/ED/fire/SFMainMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDBtranMod.F90 + +--------------------------------------------------- +The following changes are implemented below (and in the above routines) +(1) _vars% changed to _inst% +(2) pft% changed to patch% +(3) merged ecophyscon and pftvarcon into single derived type pftcon (in pftconMod) + "use EcophysConType, only : ecophyscon" changed to "use pftconMod, only : pftcon" +(4) module save statements removed in majority of routines +--------------------------------------------------- +D models/lnd/clm/src/main/EcophysConType.F90 +D models/lnd/clm/src/main/pftvarcon.F90 +A models/lnd/clm/src/main/pftconMod.F90 +M models/lnd/clm/src/main/initInterp.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/main/landunit_varcon.F90 +M models/lnd/clm/src/main/accumulMod.F90 +M models/lnd/clm/src/main/subgridWeightsMod.F90 +M models/lnd/clm/src/main/decompInitMod.F90 +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/subgridRestMod.F90 +M models/lnd/clm/src/main/ColumnType.F90 +M models/lnd/clm/src/main/subgridMod.F90 +M models/lnd/clm/src/main/PatchType.F90 +M models/lnd/clm/src/main/ndepStreamMod.F90 +M models/lnd/clm/src/main/lnd2atmType.F90 +M models/lnd/clm/src/main/atm2lndType.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/clm_varsur.F90 +M models/lnd/clm/src/main/LandunitType.F90 +M models/lnd/clm/src/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSubgridMod.F90 +M models/lnd/clm/src/main/filterMod.F90 +M models/lnd/clm/src/main/lnd2glcMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/main/initGridCellsMod.F90 +M models/lnd/clm/src/main/atm2lndMod.F90 +M models/lnd/clm/src/main/lnd2atmMod.F90 +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/surfrdMod.F90 +M models/lnd/clm/src/main/decompMod.F90 +M models/lnd/clm/src/main/reweightMod.F90 +M models/lnd/clm/src/main/readParamsMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/WaterfluxType.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/SnowSnicarMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/LakeTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/SoilFluxesMod.F90 +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +M models/lnd/clm/src/biogeophys/HumanIndexMod.F90 +M models/lnd/clm/src/biogeophys/PhotosynthesisMod.F90 +M models/lnd/clm/src/biogeophys/LakeFluxesMod.F90 +M models/lnd/clm/src/biogeophys/AerosolMod.F90 +M models/lnd/clm/src/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceResistanceMod.F90 +M models/lnd/clm/src/biogeophys/SoilStateType.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyType.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 +M models/lnd/clm/src/biogeophys/UrbanAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/biogeophys/RootBiophysMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/biogeophys/SoilWaterMovementMod.F90 +M models/lnd/clm/src/biogeophys/SoilMoistStressMod.F90 +M models/lnd/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 +M models/lnd/clm/src/biogeophys/CanopyHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/EnergyFluxType.F90 +M models/lnd/clm/src/biogeophys/CanopyStateType.F90 +M models/lnd/clm/src/biogeophys/UrbanFluxesMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/UrbanRadiationMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/IrrigationMod.F90 +M models/lnd/clm/src/biogeophys/CanopyTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/UrbanParamsType.F90 +M models/lnd/clm/src/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynEDMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynInitColumnsMod.F90 +M models/lnd/clm/src/cpl/lnd_comp_esmf.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/lnd_comp_mct.F90 +M models/lnd/clm/src/utils/accumulMod.F90 +M models/lnd/clm/src/utils/domainMod.F90 + +--------------------------------------------------- +Changes for Unit testing +--------------------------------------------------- +R models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 +M models/lnd/clm/src/CMakeLists.txt + +--------------------------------------------------- +Configuration changes for new soilbiogeochem/ +--------------------------------------------------- +M models/lnd/clm/bld/configure + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone - okay + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - okay + yellowstone_pgi - okay + yellowstone_gnu - okay + goldbach_nag - okay + + goldbach_intel (moved these to yellowstone_intel for future tests) + +CLM tag used for the baseline comparisons: clm4_5_1_r096 + +Changes answers relative to baseline: NO (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r096 +Originator(s): erik (Erik) +Date: Wed Nov 19 02:11:09 MST 2014 +One-line Summary: Several answer changing bug-fixes: snow grain size, lake hydrology, default settings, organic soil + +Purpose of changes: + +Bring in several bug-fixes most of which change answers. + +Snow grain size bug that Mark Flanner discovered under snow layer combination. +Lake hydrology fix from Zack Subin that would rarely cause the code to abort. Snow depth fix from +Sean Swenson. Use Priglent inversion as recommended by Charlie Koven. Correct population density for 2000 conditions +from 1850 to peroperly be 2000. Modify all Carbon on spinup from Dave Lawrenece. Add option to square or not square +the organic fraction (default is to square for clm4_5 and to NOT for clm5_0). Bug with pervious road that Keith +Oleson found. Simplify an if for urban to consistently use a double precision constant. Point to the new CLMNCEP_V5 +dataset. + +For clm4_0 rcp6 and rcp8.5 pftdyn datasets are updated for after 2005. + +Some fixes that don't change answers. Get the Prigilent inversion and usephfact options working again. +Fix a bug in interp_source option that Sean Swenson found. Split out test datasets for getregional script since +the datasets all have to be at the same resolution as the domain file. Also read filelist rather than use env +variables. + +Requirements for tag: Fix the bugs below + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1934 -- snow grain size (both clm4_0 and clm4_5). Just fix on clm4_5 side. + 1717 -- lake hydrology fix (clm4_5 only) + 1941 -- snowdp fix from Sean (both clm4_0 and clm4_5) (fix in clm4_5_1_r087) + 1759 -- ngwh for clm4_0 datasets (apply cesm1_2_x_n10_clm4_5_10) + 1772 -- use Priglent inversion + 1838 -- pop dens is 1850 for 2000 compsets + 1774 -- modify all Carbon on spinup + 1765 -- remove duplicate setting of bd and tkdry + 1764 -- Bug with pervious road + 2066 -- getregional_datasets.pl bug for long lists of files + 2067 -- get Prigilent inversion and usephfact options working. + 2081 -- point to new CLMNCEP_V5 version + 2061 -- make constant consistently double precision rather than have an if around it + 2089 -- bug in interp_source that Sean Swenson found + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Add organic_frac_squared=.false. logical as a clm5_0 default feature + The old behavior organic_frac_squared=.true. is on as before for clm4_5. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, swensosc, mflanner, subin + +List any svn externals directories updated (csm_share, mct, etc.): datm + update datm to datm8_141113 update CRUNCEP_V5 dataset version used + +List all files eliminated: None + +List all files added and what they do: + +=========== Split out getregional lists (all files in list MUST be at same res as domain file) +A models/lnd/clm/test/tools/nl_files/getregional_05popd +A models/lnd/clm/test/tools/nl_files/getregional_T62 +A models/lnd/clm/test/tools/nl_files/getregional_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_0.5popd +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_0.5popd +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_T62 +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_T62 + +List all existing files that have been modified, and describe the changes: + +=========== Change getregional tests +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_posttag_nompi_regression + +=========== Bring in +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist + +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ------------ correct number of tests +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ---- Update rcp6 and rcp8.5 pftdyn datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ---- Add organic_frac_squared, + set fin_use_fsat=.false. by default +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml -- Add organic_frac_squared +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ------ Correct year for popd from 1850 to 2000 +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml - Correct year for popd from 1850 to 2000 + +M models/lnd/clm/bld/CLMBuildNamelist.pm - Add organic_frac_squared and change setup_logic_more_vertlayers to + setup_logic_soilstate + +M models/lnd/clm/src/utils/CMakeLists.txt - Add namelist util to source list + +M models/lnd/clm/src/biogeochem/ch4Mod.F90 ------------- Pass fsurdat to initCold +M models/lnd/clm/src/biogeochem/CNCarbonStateType.F90 -- Use nlevdecomp_full in place of nlevdecomp +M models/lnd/clm/src/main/initInterp.F90 --------------- Change use of rbufsli to rbufslo +M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Pass nlfilename into soilstate_vars init +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Add col%itype(c) == icol_road_perv to an if condition +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Use 1.0_r8 constant always, rather than integer 1 + for clm4_5 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 --- Use Mass-weighted combination of radius for combo +M models/lnd/clm/src/biogeophys/SoilStateType.F90 ------ Add organic_frac_squared logical and namelist read + for it. Add two if's that determine if organic_frac + should be squared or not. +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 --- Break apart if-condition for snl==-1 + +CLM testing: regular + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes (although still fails) + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: (when tools modified or scripts updated (for PTCLM)) + + yellowstone interactive yes + PTCLM (models/lnd/clm/tools/shared/PTCLM/test) yellowstone yes + +CLM tag used for the baseline comparisons: + +Changes answers relative to baseline: Yes! + + Summarize any changes to answers, i.e., + - what code configurations: clm4_5 and clm5_0 + - what platforms/compilers: all + - nature of change (similar climate, except new clm5_0 feature) + + clm4_0 for rcp6 and rcp8.5 changes answers by using the new good wood harvest + datasets for after 2005. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + /home/erik/noorg_clm451r092_I1850CRUCLM45BGC -- clm4_5 default version + /home/erik/clm451r092_I1850CRUCLM45BGC -------- clm4_5 with organic_frac_squared=.false. + (clm5_0 default version) + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r095 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Mon Nov 10 17:54:18 MST 2014 +One-line Summary: refactoring N comp by Jinyun Tang (LBL) and transpiration sink isolation by Gautam Bisht (LBL) + +Purpose of changes: Bring in two refactorings: + Jinyun Tang (LBL) - isolation of the routines to do soil nutrient + competition dynamics into a module, and allow for different + implementations through runtime polymorphism. + + Gautam Bisht (LBL) - new function to make transpiration sink + distribution independent of subsurface flow physics + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2039 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: andre, cmt + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +Nutrient Competition + List all files added and what they do: + A clm/src/biogeochem/NutrientCompetitionFactoryMod.F90 - factory module to select soil nutrient competition method + A clm/src/biogeochem/NutrientCompetitionMethodMod.F90 - abstract base class for soil nutrient competition dynamics + A clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 - existing clm45 implementation of soil nutrient competition dynamics + + List all existing files that have been modified, and describe the changes: + M clm/src/biogeochem/CNDecompMod.F90 - add nutrient competition method to function parameters + M clm/src/biogeochem/CropType.F90 - rename UpdateAccVars() to work around pgi compiler error, remove dependency on temperature_type + M clm/src/biogeochem/CNAllocationMod.F90 - move code into clm45 default nutrient competition module + M clm/src/biogeochem/CNEcosystemDynMod.F90 - add nutrient competition method to function parameters + MM clm/src/main/clm_initializeMod.F90 - add nutrient competition method to function parameters + M clm/src/main/clm_driver.F90 - add nutrient competition method to function parameters, call to renamed CropUpdateAccVars + M clm/src/main/readParamsMod.F90 - add nutrient competition method to function parameters + +Transpiration Sink: + List all existing files that have been modified, and describe the changes: +M clm/src/biogeophys/SoilWaterMovementMod.F90 - move transpiration sink into separate function so it is independent of physics. + + +CLM testing: + + build-namelist tests: n/a + + unit-tests (models/lnd/clm/src): no + + yellowstone + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 4.0 ok; 4.5 ok + yellowstone_pgi - 4.0 ok; 4.5 ok + yellowstone_gnu - n/a; 4.5 ok + goldbach_nag - 4.0 ok; 4.5 ok + goldbach_intel - 4.0 ok; 4.5 ok + + short tests (aux_clm_short) - no + + tools testing: (when tools modified or scripts updated (for PTCLM)) - n/a + +CLM tag used for the baseline comparisons: clm4_5_1_r094 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r094 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Nov 7 13:43:38 MST 2014 +One-line Summary: misc. glacier-related updates + +Purpose of changes: + +(1) Add dlnd, satm and srof externals, so that TG compsets (CISM-only, forced by + dlnd) can be run from a CLM tag. This will facilitate CISM development and + testing. + +(2) Remove CLM's dependence on the CISM grid. Previously, CLM used the CISM grid + to determine which fglcmask file to use. But the differences between the + fglcmask files were inconsequential (all of them included the full area of + Greenland, which is what was important). I have created a new set of + fglcmask files that are independent of the CISM grid, and point CLM to these + new files. This will make it easier to add new CISM grids in the future, + because no changes will be needed in CLM for this purpose. However, note + that the use of these new files means that the number of virtual landunits & + columns changes for glcmec runs. + +(3) In subgridAveMod, fix c2l routines: change pft%wtlunit to col%wtlunit (bugz + 2077) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 2077 (c2l references pft instead of col) +- 2085 (listDefaultNamelist is broken) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: change fglcmask + +List any changes to the defaults for the boundary datasets: change fglcmask + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +========= Added new externals for the sake of running TG compsets (CISM-only) + from a CLM tag ++models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 ++models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm ++models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/srof + +========= Other externals updates +-tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_07 ++tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_08 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Remove dependence on CISM grid +M models/lnd/clm/bld/listDefaultNamelist.pl + - also fix bug 2085 +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/src_clm40/main/controlMod.F90 +M models/lnd/clm/src_clm40/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 + +========= Change pft%wtlunit to col%wtlunit in c2l routines (which currently + aren't called from anywhere in the code) (bugz 2077) +M models/lnd/clm/src/main/subgridAveMod.F90 + +========= fix numbers of build-namelist unit test failures, due to removal of a test +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + expected failure in 23, due to change in fglcmask + + unit-tests (models/lnd/clm/src): + + yellowstone: still broken, due to internal compiler error + roo2 (mac laptop): ok + + See notes in clm4_5_1_r090. Point (2) has been fixed, but point (1) remains. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: ok + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r093 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: IG compsets - both CLM40 and CLM45 + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + only changes diagnostic cpl hist fields - no change in the simulation + + The changes arise from the new glcmask files, which exclude a few points + from the glcmask that used to be included. These points are all outside + of Greenland, so they are not important for coupling to CISM. However, + it means that a few virtual columns have been removed. This, in turn, + changes the values of some l2x topo, tsrf and qice fields sent to the + coupler. But this does NOT feed back on the simulation in any way. + + Some tests also exhibit diffs in the CLM diagnostic fields PCT_GLC_MEC + and QICE_FORC. Again, these are due to changes in where we have virtual + columns, and do not affect the simulation. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r093 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Nov 7 13:17:47 MST 2014 +One-line Summary: change cold-start snow initialization, update cism external + +Purpose of changes: + +(1) Change cold-start snow initialization logic. The original logic did +different snow initialization depending on whether we are inside or outside the +glcmask. That's a problem in that answers change depending on the glcmask. The +new logic instead uses a latitude threshold for determining where to initialize +a non-zero snow pack. Note that this will change answers for all cold-start +cases, including non-glcmec cases. + +(2) Update CISM to version 2. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self; Dave Lawrence agreed with the change to snow initialization + +List any svn externals directories updated (csm_share, mct, etc.): +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140916 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_0_02 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/main/clm_initializeMod.F90 + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: ok + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r092 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + (1) any CLM4.5 case with cold start initialization, due to change in snow + initialization + + (2) any case that includes CISM, due to answer changes in the CISM external + + I carefully checked the yellowstone-intel clm4.5 tests to ensure that: + (a) FAILed compare_hist all had finidat = ' ' + (b) PASSed compare_hist either had non-blank finidat OR were single-point + + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated, but expected to be larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r092 +Originator(s): muszala (Stefan Muszala) +Date: Tue Nov 4 06:10:16 MST 2014 +One-line Summary: bug fixes from santos that address valgrind problems. update rtm external + +Purpose of changes: Addresses issues found with Valgrind by Santos. Update RTM. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: santos, self + +List any svn externals directories updated (csm_share, mct, etc.): +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_39 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_40 + +List all files eliminated: N/A + +List all files added and what they do: + +A + models/lnd/clm/src/main/dtypes.h + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- update failures + +M SVN_EXTERNAL_DIRECTORIES +-- rtm update to 40 + +M models/lnd/clm/src_clm40/main/ncdio_pio.F90 +M models/lnd/clm/src_clm40/main/ncdio_pio.F90.in +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in +-- example changes: +- status = pio_inq_vardimid(ncid, vardesc , dids) ++ status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + +M models/lnd/clm/src_clm40/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +-- change 1.0_8 to 1.0_r8 + +CLM testing: + + build-namelist tests: N/A + + unit-tests (models/lnd/clm/src): N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel 40- OK 45- OK + yellowstone_pgi 40- OK 45- OK + yellowstone_gnu 40- N/A 45- OK + goldbach_nag 40- OK 45- OK + goldbach_intel 40- OK 45- OK + + tools testing: (when tools modified or scripts updated (for PTCLM)) N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r091 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r091 +Originator(s): muszala (Stefan Muszala) +Date: Mon Oct 27 09:48:56 MDT 2014 +One-line Summary: update externals. fix bug so CLM runs with Intel 14x. + +Purpose of changes: Update externals. Fix bug in VOCEmissionMod.F90 that prevented +CLM from running with Intel 14x on yellowstone. Bring in workaround for bug 1730 from +Sacks. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ - see CLM test fail list + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, clm developers, particularly Bill Sacks. + +List any svn externals directories updated (csm_share, mct, etc.): +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_141009 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_141023 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141001 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141017a +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141003 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141022 +-models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_140416 ++models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_140925 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-- reflect changes in new testlists +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- Sacks' workaround for bug 1730 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in +-- remove duplicate assignment of 0_r8 to meg_out(imeg)%flux_out +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 +-- update externals +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + + Please view the CLM expected fail list for new test failures. They are matched + to bugzilla bug ids. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 - OK 45 - OK + yellowstone_pgi - 40 - OK 45 - OK + yellowstone_gnu - 40 - N/A 45 - OK + goldbach_nag - 40 - OK 45 - OK + goldbach_intel - 40 - OK 45 - OK + +CLM tag used for the baseline comparisons: clm4_5_1_r090 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r090 +Originator(s): sacks (Bill Sacks) +Date: Thu Oct 16 06:39:52 MDT 2014 +One-line Summary: modularize irrigation; do some unit test rework + +Purpose of changes: + +(1) Pull irrigation code out of CanopyFluxes and CanopyHydrology, into its + own module + +(2) Pull out the locally-created filters from CanopyFluxes and BareGroundFluxes + into filterMod, in order to support pulling irrigation out of + CanopyFluxes. This will also be needed to support pulling other hydrology + stuff out of CanopyFluxes. + +(3) Add unit tests for irrigation + +(4) Rework some irrigation infrastruture, and add some more unit test utility + routines + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2063 (HumanIndexMod fails to compile with gfortran) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: muszala + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Renamed to unit_test_stubs +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/GetGlobalValuesMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/do_genf90 +D models/lnd/clm/src/unit_test_mocks/util_share/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share +D models/lnd/clm/src/unit_test_mocks/csm_share/shr_mpi_mod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/csm_share/mct_mod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/csm_share +D models/lnd/clm/src/unit_test_mocks/main/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/main/histFileMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/main +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid/dynFileMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid +D models/lnd/clm/src/unit_test_mocks/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks + +========= Remove unnecessary files +D models/lnd/clm/src/ED/CMakeLists.txt +D models/lnd/clm/src/ED/biogeophys/CMakeLists.txt + +List all files added and what they do: + +========= Pull out irrigation code into its own module +A models/lnd/clm/src/biogeophys/IrrigationMod.F90 + +========= Add some unit test utility code (and some tests for the utility code) +A models/lnd/clm/src/unit_test_shr/unittestFilterBuilderMod.F90 +A models/lnd/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test/test_filterBuilder.pf +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test +A models/lnd/clm/src/unit_test_shr/test/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr/test + +========= Renamed from unit_test_mocks to unit_test_stubs; also renamed + individual files from mock to stub (or 'fake' for ncdio_pio, because + it does more than a stub); also, moved some stubs to match the current + organization of the main source tree +A models/lnd/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils/do_genf90 +A models/lnd/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90.in +A models/lnd/clm/src/unit_test_stubs/utils/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/utils/clm_time_manager_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils +A models/lnd/clm/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/csm_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/csm_share +A models/lnd/clm/src/unit_test_stubs/main/histFileMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_var.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_var.F90.in +A models/lnd/clm/src/unit_test_stubs/main/GetGlobalValuesMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/main/do_genf90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in +A models/lnd/clm/src/unit_test_stubs/main/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/main +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid +A models/lnd/clm/src/unit_test_stubs/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs + +========= Add dependencies (direct & indirect) of IrrigationMod +A models/lnd/clm/src/biogeochem/CMakeLists.txt + +========= Add unit tests for irrigation (see README file for some design notes) +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_deficit.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_multipatch.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/IrrigationWrapperMod.F90 +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_singlepatch.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt +A models/lnd/clm/src/biogeophys/test/Irrigation_test/README +A models/lnd/clm/src/biogeophys/test/Irrigation_test + +List all existing files that have been modified, and describe the changes: + +========= Pull irrigation out of CanopyFluxes into its own routine, and also + pull out the filters that used to be created locally in CanopyFluxes + and BareGroundFluxes +M models/lnd/clm/src/main/clm_driver.F90 + +========= Pull out filters that used to be created locally in CanopyFluxes and + BareGroundFluxes, so that they can be reused in irrigation and + elsewhere +M models/lnd/clm/src/main/filterMod.F90 + +========= Add calls to irrigation init & restart routines +MM models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 + +========= Irrigation computations are now done in the irrigation module; also, + the relevant filter is now created outside CanopyFluxes +MM models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +========= Irrigation computations are now done in the irrigation module +M models/lnd/clm/src/biogeophys/CanopyHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 + +========= Irrigation variables are now defined in the irrigation module +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/WaterfluxType.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 + +========= Filter is now created outside BareGroundFluxes; also, moved some bare + ground initialization from CanopyFluxes (needed because the filters + are no longer created locally, so CanopyFluxes does not know what + points it would need to set for bare ground) +MM models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 + +========= Remove some dependencies to aid unit testing (this includes combining + two branches of a conditional (allowlakeprod) that were doing the same + thing +M models/lnd/clm/src/biogeophys/SoilStateType.F90 + + +========= Add dependencies (direct & indirect) of IrrigationMod for unit testing +M models/lnd/clm/src/utils/CMakeLists.txt +M models/lnd/clm/src/main/CMakeLists.txt +M models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt +M models/lnd/clm/src/biogeophys/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/CMakeLists.txt + +========= Add new unit test utilities +M models/lnd/clm/src/unit_test_shr/CMakeLists.txt + +========= Make newly-added subgrid units active by default +M models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 + +========= Unrelated fix for gfortran +MM models/lnd/clm/src/biogeophys/HumanIndexMod.F90 + +========= Change whitespace +M models/lnd/clm/src/dyn_subgrid/CMakeLists.txt + + +CLM testing: + + build-namelist tests: + + yellowstone: not run + + unit-tests (models/lnd/clm/src): + + yellowstone: fail due to two issues: + + (1) The unit tests currently won't build on yellowstone due to an ICE that + will probably be fixed when we remove dependencies of SoilStateType. + + (2) In addition, even once that's fixed, the yellowstone unit tests either + need (a) a bump in the unit testing external (unit_testing_0_08) and + Machines external (Machines_141007) (I didn't do that for my tag because + it pulls in a bump in the intel compiler version to 14 rather than 13.1), + or (b) the following diffs: + + Index: tools/unit_testing/python/machine_setup.py + =================================================================== + --- tools/unit_testing/python/machine_setup.py (revision 64421) + +++ tools/unit_testing/python/machine_setup.py (working copy) + @@ -52,7 +52,7 @@ + mod.load("ncarenv/1.0") + mod.load("ncarbinlibs/1.0") + if compiler == "intel": + - mod.load("intel/13.1.2") + + mod.load("intel/14.0.2") + elif compiler == "pgi": + mod.load("pgi/13.9") + mod.load("ncarcompilers/1.0") + Index: scripts/ccsm_utils/Machines/config_compilers.xml + =================================================================== + --- scripts/ccsm_utils/Machines/config_compilers.xml (revision 64421) + +++ scripts/ccsm_utils/Machines/config_compilers.xml (working copy) + @@ -547,7 +547,7 @@ + -xHost + -xHost + $(TRILINOS_PATH) + - /glade/u/home/santos/pFUnit/pFUnit_Intel + + /glade/u/home/sacks/pFUnit/pFUnit3.0.1_Intel14.0.2_Serial + + + + + + + However, I have run the unit tests on my mac, with gfortran, and they all + pass + + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r089 + +Changes answers relative to baseline: YES (but only because of bug 1998) + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: irrigation + - what platforms/compilers: all + - nature of change: larger than roundoff, not investigated closely + + The changes are entirely due to the btran bug (bug 1998): The old flow was: + - compute btran + - calculate irrigation (depends on btran) + - hack btran for soybeans + + whereas the new flow is: + - call CanopyFluxes: computes btran and hacks btran for soybeans + - calculate irrigation (depends on btran) + + I have confirmed that answers are bit-for-bit for both irrigation tests (for + both cpl and clm hist files), when I introduce the following diffs in both + the trunk and the branch: + + Index: src/biogeophys/CanopyFluxesMod.F90 + =================================================================== + --- src/biogeophys/CanopyFluxesMod.F90 (revision 64406) + +++ src/biogeophys/CanopyFluxesMod.F90 (working copy) + @@ -842,9 +842,6 @@ + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + - if (pft%itype(p) == nsoybean .or. pft%itype(p) == nsoybeanirrig) then + - btran(p) = min(1._r8, btran(p) * 1.25_r8) + - end if + end do + + if ( use_ed ) then + @@ -894,9 +891,6 @@ + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + - if (pft%itype(p) == nsoybean .or. pft%itype(p) == nsoybeanirrig) then + - btran(p) = min(1._r8, btran(p) * 1.25_r8) + - end if + end do + + call Photosynthesis (bounds, fn, filterp, & + + + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r089 +Originator(s): erik (Erik) +Date: Mon Oct 13 13:46:43 MDT 2014 +One-line Summary: Bring new urban building temperature to trunk as a clm5.0 feature + as well as human-stress index calculations + +Purpose of changes: + +New prognostic internal building air temperature methodology for CLM5.0. Retain the older simpler method +for CLM4.5. The namelist toggle to switch between them is: building_temp_method. By default for clm4_5 physics +the older method is used and for clm5_0 the newer one is used. Also add in a package of human-stress index +calculations. Again this is by default on for clm5_0 and off for clm4_5. + +The new building air temperature methodology, solves the system of equations for internal: air, roof, floor, +and wall (shade and sunlit) Temperatures. It uses the LAPACK subroutine DGESV to solve the system. It also +figures out the energy flux needed to either cool the building air temperature to a maximum allowed temperature +or to heat it to the minimum allowed temperature. + +Add in the new load balancing tool and the PyReshaper tool (changes multi-variable +monthly history files into single-variable time-series files). + +Remove the now unneeded clm4_5 interpinic as well as the mkmapgrids FORTRAN program. + +Requirements for tag: Bring in new clm5_0 building temperature as option, Fix scripts bugs, bug 2053/2032 + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2053 Problems with dry-deposition for fully coupled cases with CLM4.5 in cesm1_3_beta13 + 2032 rtm.buildnml.csh kills cesm_setup if GET_REFCASE is FALSE + 1685 Drydeposition potentially using "rs" variable before it's defined (over water) + (was fixed but came back) + Fix bugs: 2024, 2035, 2037 in scripts SBN and namelistcompare issues + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: new namelists and namelist items + add: clmu_inparm and clm_humanindex_inparm namelists + move: urban_hac and urban_traffic to clmu_inparm + add: calc_human_stress_indices to clm_humanindex_inparm + building_temp_method to clmu_inparm + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + clm5_0 memory use is greater than clm4_5 due to human_stress_indices calculations + and output on history (I've seen it make up to a 20% difference) + +Code reviewed by: self, oleson, sacks, mvertens, andre + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, rtm, cism, csm_share + Update to cesm1_3_alpha13c externals. + Also add in load_balancing_tool and pyReshaper + + scripts to scripts4_141009 + Machines to Machines_141001 + rtm to rtm1_0_39 + cism to cism1_140916 + csm_share to share3_141003 + load_balancing_tool to load_balancing_tool_140818 + pyReshaper to v0.9.1 + +List all files eliminated: + +--------- Remove clm4_5 interpinic, online interpinic supersedes it +D models/lnd/clm/tools/clm4_5/interpinic +D models/lnd/clm/tools/clm4_5/interpinic/* +D models/lnd/clm/tools/clm4_5/interpinic/src/* + +--------- Remove mkmapgrids program +D models/lnd/clm/tools/shared/mkmapgrids/src +D models/lnd/clm/tools/shared/mkmapgrids/src/* +D models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.namelist +D models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.csh + +--------- shr_sys_mod was mocked only because of it's use of shr_mpi_mod +--------- mock shr_mpi_mod instead and standard shr_sys_mod can be used +D models/lnd/clm/src/unit_test_mocks/csm_share/shr_sys_mod_mock.F90 + +List all files added and what they do: + +A models/lnd/clm/src/biogeophys/HumanIndexMod.F90 -- New module to + calculate a bunch of human stress index values. + +A models/lnd/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 --- New module + for calculating the prognostic internal building air temperature. + +--------- New simple unit tester for humanstress indices module +A models/lnd/clm/src/biogeophys/test/HumanStress_test/test_humanstress.pf +A models/lnd/clm/src/biogeophys/test/HumanStress_test/CMakeLists.txt +A models/lnd/clm/src/biogeophys/test/HumanStress_test + +A models/lnd/clm/src/unit_test_mocks/csm_share/shr_mpi_mod_mock.F90 -- shell + for most shr_mpi_ calls that do nothing (so assumes MPI is NOT being done) + shr_mpi_abort does a stop + +List all existing files that have been modified, and describe the changes: + +--------- remove the mkgriddata and clm4_5 interpinic tools from testing +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_posttag_yong +M models/lnd/clm/test/tools/tests_posttag_nompi_regression +M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + +--------- remove documentation of mkgriddata and clm4_5 interpinic tools +--------- but add documentation on ncl script +M models/lnd/clm/tools/shared/mkmapgrids/README +M models/lnd/clm/tools/README + +--------- Add new namelists: clmu_inparm and clm_humanindex_inparm +M models/lnd/clm/bld/configure ---- use same configuration for clm4_5 AND clm5_0 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Set + calc_human_stress_indices, and building_temp_method by clm4_5/clm5_0 +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Move + urban_hac and urban_traffic to new clmu_inparm namelist and + add building_temp_method and add calc_human_stress_indices to + clm_humanindex_inparm namelist +M models/lnd/clm/bld/CLMBuildNamelist.pm -------- Handle new namelists: + clmu_inparm and clm_humanindex_inparm + +--------- Get unit tests working again, and add a simple humanindex test +M models/lnd/clm/src/utils/CMakeLists.txt +M models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/ED/biogeophys/CMakeLists.txt +M models/lnd/clm/src/README.unit_testing +M models/lnd/clm/src/biogeophys/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/CMakeLists.txt +M models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 - set mpicom +M models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt + +--------- Fix so can work with drydeposition namelist and without megan namelist +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - Don't initialize if + megan namelist is turned off (bug 2053) +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Make sure rs is set + before used (bug 1685) + +--------- Handle new building temperature options, add new constants +MM models/lnd/clm/src/main/clm_varcon.F90 -------- Bunch of new constants + for urban-building (should be moved to modules that use them). + Also pass is_simple_buildtemp into init method +MM models/lnd/clm/src/main/clm_initializeMod.F90 - Pass building temp type + down to relevent init methods add initialization for humanindex_vars, + initialize drydepvel_vars (bug 2053) +M models/lnd/clm/src/main/restFileMod.F90 ------- Pass building temp type + logicals down to energyflux_vars and temperature_vars restart methods +M models/lnd/clm/src/main/LandunitType.F90 ------ Add documentation, correct + error in documentation +MM models/lnd/clm/src/main/controlMod.F90 -------- Move urban namelist items to + UrbanReadNML, add HumanIndexReadNML +M models/lnd/clm/src/main/clm_driver.F90 -------- Pass humanindex_vars down as needed + +--------- Change for new shr_cal_mod names +M models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 - Use full name of month + "january" instead of "jan" + +--------- Add new building temperature module and add capability to do old clm4_5 +--------- method as well as new method, also do human_stress_indices calculations +MM models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 --- Add BuildingHAC for + simple building temp method (should move to it's own module) add if + statements for building_temp_method type, call BuildingTemperature + when prognostic method used +M models/lnd/clm/src/biogeophys/SoilFluxesMod.F90 -------- Change name of + eflx_building_heat to eflx_building_heat_errsoi +M models/lnd/clm/src/biogeophys/TemperatureType.F90 ------ Add building + temperature variables (should move to urbBuildTemp module), pass building_temp + method logical down for initialization, add documentation headers + hist, cold, and restart init depends on building temp method logical +M models/lnd/clm/src/biogeophys/LakeFluxesMod.F90 -------- calc_human_stress_indices + (should move to method in humanIndexMod) +MM models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 -- calc_human_stress_indices + (should move to method in humanIndexMod) +MM models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ------ calc_human_stress_indices + (should move to method in humanIndexMod) +M models/lnd/clm/src/biogeophys/EnergyFluxType.F90 ---- change name of eflx_building_heat_col + to eflx_building_heat_errsoi_col, add some new building temperature flux terms + add documentation, alloc, hist, restart and cold initialization depends on + building temperature method type (should move to urban building module) +M models/lnd/clm/src/biogeophys/UrbanFluxesMod.F90 ---- Add private functions: + wasteheat, simple_wasteheatfromac, calc_simple_internal_building_temp + (should move to building_temp modules). + calc_human_stress_indices (should move to method in humanIndexMod) +M models/lnd/clm/src/biogeophys/UrbanParamsType.F90 --- Add methods: UrbanReadNML, + IsSimpleBuildTemp, IsProgBuildTemp, add clmu_inparm namelist, and move urban_* items + there and add building_temp_method to it. + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + + short tests (aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: + + yellowstone interactive yes + PTCLM (models/lnd/clm/tools/shared/PTCLM/test) yellowstone yes + +CLM tag used for the baseline comparisons: clm4_5_1_r088 + +Changes answers relative to baseline: No for CLM40 and CLM45 + But, answers DO change for CLM50 + (except scripts tag update changes history files for IG and irrigation compsets/tests) + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r088 +Originator(s): muszala (Stefan Muszala) +Date: Wed Oct 1 09:24:43 MDT 2014 +One-line Summary: Pull out ED deps. in TemperatureTypeMod, can now compile with pgi 14.7 + +Purpose of changes: Pull out the dependency on EDBioType in TemperatureType.F90. The ED +variables related to phenology now reside in EDPhenologyMod.F90. This refactor also had +the effect of getting past a PGI 14.7 ICE which looks like it was due to the use of EDbio_vars +in TemperatureType.F90. When I pulled out lines 1227 and 1226 of biogeophys/TemperatureType.F90 +(in clm4_5_1_r087) and passed the two EDbio_vars variables through the argument list the ICE +went away. + +This tag breaks ED restart tests. We went ahead with the tag because we had to fix a more +general problem with the CESM and CAM builds and PGI 14.7. the ED v0.1.0 branch does not +have these modifications and may be used as an alternative. A new clm tag will shortly +follow that addresses any remaining problems. + +Requirements for tag: None + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +Temporary addition of a cal parameter type in a branch tag. Will be merged into csm_share trunk shortly. + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/share_ece_tags/share_ece_01_140723 + +List all files eliminated: N/A + +List all files added and what they do: + +! new home for ED phenology variables and type-bound procedures that +! allow for accumulation of buffers +A + models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 +! put some CMakeLists.txt in place for ED unittests +A + models/lnd/clm/src/ED/main/CMakeLists.txt +A + models/lnd/clm/src/ED/biogeophys/CMakeLists.txt +A + models/lnd/clm/src/ED/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +! pull out deps. on EDBioType +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/clm_initializeMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/restFileMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/clm_driver.F90 + +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +! pull out ED_GDD_patch and phen_cd_status_patch +M models/lnd/clm/src/ED/main/EDBioType.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDMainMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDInitMod.F90 + +! for ED unit tests +M models/lnd/clm/src/CMakeLists.txt + +! update CNED failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + +ERS CNED tests are failing in this tag. It is expected. expectedClmTestFails.xml is updated to reflect this. + + build-namelist tests: N/A + + yellowstone + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel 40-OK, 45-OK + yellowstone_pgi 40-OK, 45-OK + goldbach_nag 40-OK, 45-OK + goldbach_intel 40-OK, 45-OK + +CLM tag used for the baseline comparisons: clm4_5_1_r087 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r087 +Originator(s): erik (Erik) +Date: Tue Sep 30 12:07:10 MDT 2014 +One-line Summary: Fix two balance check errors, and turn abort for balance check back on to appropriate levels + +Purpose of changes: + +Fix two balance check errors that were causing problems for simulations. Also some of the balance check aborts +were turned off in clm4_5_1_r082, so turn them back on again. Tighten water balance error from 1.e-4 to 1.e-5. +Tighten LW, surface-flux and solar radiation balance errors from 1.e-3 to 1.e-5 and add warning for 1.e-7. +Turn surface-flux balance and soil balance check errors abort back on. Soil balance tightened to 1.e-4 (from 1.e-3) +with warnings shown at 1.e-6. + +Also bring in an update to PTCLM, and allow tools tester to be submitted to geyser or caldera. Just as an aside +as something that was already done. + +Requirements for tag: Fix bugs: 2026 and 1941 + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2026 Soil balance error + 1941 snowdp balance error + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, swensosc + +List any svn externals directories updated (csm_share, mct, etc.): Update PTCLMmkdata version + + Update PTCLM to PTCLM2_140816 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/tools/test_driver.sh ------ Allow to run in caldera and geyser as well + +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Add aborts back as well as warnings + and tighten some error conditions and warnings. +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Remove calculation and use of the + heat capacity of frozen h2osfc layer but use the heat capacity of the liquid layer + as balance check doesn't know about the frozen, and the discrepency causes balance + check errors. +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 --- snow includes dew. + +CLM testing: + + build-namelist tests: + + yellowstone YES + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel YES + yellowstone_pgi YES + yellowstone_gnu (optional) YES + goldbach_nag YES + goldbach_intel YES + +CLM tag used for the baseline comparisons: clm4_5_1_r086 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 + - what platforms/compilers: ALL + - nature of change: same climate (some shorter simulations are still exact) + +Simulations that Keith ran to test the snowdp change are: + +/glade/p/work/oleson/urb2dev_n00_clm4_5_52/scripts/urb2dev_n03_clm4_5_64_V2DomLam_I20TRCRUCLM45 + +/glade/p/work/oleson/urb2dev_n00_clm4_5_52/scripts/urb2dev_n03_clm4_5_64_V2DomLam_IRCP85CRUCLM45 + + URL for LMWG diagnostics output used to validate new climate: + + For soil balance error... + +http://www.cgd.ucar.edu/staff/swensosc/public/diagnostics/ColdtestTRENDYspinupf091850CRU-ColdtestTRENDYspinupf091850CRU_control/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r086 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 25 09:04:08 MDT 2014 +One-line Summary: critical ED modifications from r fisher, fix bug 2043 + +Purpose of changes: add modifications to ED, particularly for cold deciduous. add + fix for bug 2043. Consider these ED baselines as fixed (ie. + unless you are modifying ED science, these should now be BFB). + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2043 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, r fisher + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/main/lnd2atmMod.F90 +-- change intent of waterstate_vars to inout (fixes bug 2043) + +M models/lnd/clm/src/main/clm_driver.F90 +-- add EDbio_vars to edmodel actual argument list + +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +-- change leaves_off_switch and laimemory handling + +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +-- rework cold deciduous and threshold code. add fragmentation_scaler routine + +M models/lnd/clm/src/ED/main/EDMainMod.F90 +-- change argument lists to include EDbio_vars for ecosystem_dynamics and phenology + +M models/lnd/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +-- overhaul ED norman radiation code + +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +-- tweak calculation of jmax25top and tpu25top + +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +-- clean up two comments + +CLM testing: + + ED compsets change values. + + For bug 2043. Confirmed that a gnu compile on yellowstone gets passed the intent problem. + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 OK - 45 OK + yellowstone_pgi - 40 OK - 45 OK + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + +CLM tag used for the baseline comparisons: clm4_5_1_r085 + +Changes answers relative to baseline: Only for ED compsets + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r085 +Originator(s): sacks (Bill Sacks) +Date: Fri Sep 19 10:22:30 MDT 2014 +One-line Summary: replace conditionals with polymorphism for soil water retention curve + +Purpose of changes: + +The main motivation for this tag was the need to introduce a +soil_suction_inverse routine, which will be used for irrigation. It is important +that soil_suction_inverse remains consistent with soil_suction for every soil +water retention curve method. In talking with Ben Andre and Erik, we felt the +best way to ensure this consistency was to have a separate, small module for +each soil retention curve method. We felt the best way to implement this was via +polymorphism. Polymorphism is arguably overkill in this simple case, but we +thought it would be good to convert it to polymorphism partly as an example that +we and others can follow in more complex cases where it will provide greater +benefit. + +To add a new soil retention curve method: + + (1) Create a module similar to + SoilWaterRetentionCurveClappHornberg1978Mod.F90 + + (2) Modify the select case statement in SoilWaterRetentionCurveFactoryMod.F90 + so that it is able to create an instance of your new type + +Note that this refactor also combines the soil_suction and soil_hk +parameterization options into a single option. Dave Lawrence and Rosie Fisher +felt that was preferable, and Jinyun Tang was okay with this. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: andre, muszala, Jinyun Tang + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Replaced with the 3 new files noted below +D models/lnd/clm/src/biogeophys/SoiWatRetCurveParMod.F90 + +List all files added and what they do: + +========= Replacement for SoiWatRetCurveParMod, implemented using + polymorphism. Note that I have also added a soil_suction_inverse + routine, which is not yet used or tested. I'll be using (and testing) + this in an upcoming tag, where I refactor the irrigation code to use this. +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveMod.F90 +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Minor changes to accommodate the refactored code +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/init_hydrology.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/biogeophys/SoilWaterMovementMod.F90 +M models/lnd/clm/src/biogeophys/SoilMoistStressMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyNoDrainageMod.F90 + + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r084 + +Changes answers relative to baseline: NO - bfb + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r084 +Originator(s): sacks (Bill Sacks) +Date: Thu Sep 18 14:39:44 MDT 2014 +One-line Summary: make glc_dyn_runoff_routing spatially-varying, based on input from glc + +Purpose of changes: + +Dave Lawrence, Bill Lipscomb and Jeremy Fyke have pointed out that +glc_dyn_runoff_routing needs to be spatially-varying: Even when we're coupling +to CISM, we should continue to use the old scheme in regions that don't have an +active icesheet model underneath (which currently includes Antarctica and all of +the world's smaller glaciers - i.e., everything except Greenland). Furthermore, +we have introduced a new ability into CISM to run in diagnostic mode, without +sending calving/runoff fluxes to the coupler. In this case, too, CLM should +revert to using the old scheme (glc_dyn_runoff_routing = .false.). + +To accomplish both of these things, I have introduced a new coupling field, +through which GLC tells CLM which areas have an icesheet that is "active" in the +sense of sending fluxes to the coupler. In this CLM tag, CLM sets a +spatially-varying version of glc_dyn_runoff_routing based on this new coupler +field - replacing the old, namelist-settable version of this flag. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + + - removed glc_dyn_runoff_routing + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + drv: drvseq5_0_15 -> drvseq5_0_17 + - fix for some multi-instance runs + - add icemask_coupled_fluxes field + + cism: cism1_140602 -> cism1_140914 + - Add zero_gcm_fluxes option; send icemask_coupled_fluxes field to coupler + + scripts: scripts4_140916b -> scripts4_140916c + - Rename CLM_UPDATE_GLC_AREAS to GLC_TWO_WAY_COUPLING + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Rename CLM_UPDATE_GLC_AREAS xml variable to GLC_TWO_WAY_COUPLING. + Remove glc_dyn_runoff_routing namelist variable (this is now a + spatially-varying field, tied more tightly to CISM). +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/env_run.xml + +========= Receive icemask_coupled_fluxes from CISM +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 + +========= Set spatially-varying glc_dyn_runoff_routing field based on + icemask_coupled_fluxes, and use this in place of the old scalar + glc_dyn_runoff_routing flag +M models/lnd/clm/src/main/glc2lndMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Add write statement to workaround a pgi compiler problem +M models/lnd/clm/src/main/restFileMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: ok (baseline comparisons fail for clm45 & clm50, as expected) + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + + Note: Most testing was run on glc_runoff_routing_n06_clm4_5_1_r083. After + that tag, I added the following write statement in restFileMod, as a + workaround for a PGI compiler bug: + + write(iulog,*) 'about to call aerosol_vars%restart: ', ubound(waterstate_vars%h2osoi_ice_col) + + After that addition, I just reran a subset of tests: 6 yellowstone-intel + tests, 10 yellowstone-pgi tests (including the 2 that had failed due to the + compiler bug), and 5 goldbach-nag tests. + +NOTE: Unit test build is currently failing due to a change in r082. Stefan is +working on a fix. + +CLM tag used for the baseline comparisons: clm4_5_1_r083 + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with CISM (i.e., IG) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + (1) Large changes in runoff from glaciers in IG compsets, due to setting + glc_dyn_runoff_routing to .false. outside of Greenland. + + (2) Roundoff-level changes in icemask for some resolutions and compilers, + due to changes in the cism external. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? For icemask changes: examined cprnc RMS errors. For other + changes, diffs are greater than roundoff. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r083 +Originator(s): muszala (Stefan Muszala) +Date: Wed Sep 17 09:21:31 MDT 2014 +One-line Summary: only update scripts and run new baselines. this due to an error in yellowstone pgi test naming (clm_aux45 changed to aux_clm45) + +Purpose of changes: Update scripts due to an error in a previous scripts tag in which I named pgi tests as clm_aux45 instead +of aux_clm45. These were for tests moved from goldbach to yellowstone. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_140910 -> scripts4_140916b + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +- update test list failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + WJS: note: Stef told me that he actually ran all the yellowstone tests, and + all were okay + + yellowstone_intel - 40 OK + yellowstone_pgi + + goldbach_nag - 40 OK, 45 OK + goldbach_intel - 40 OK, 45 OK + +Note 1: Due to the fact that in older baselines component_gen_comp was failing due to a scripts error (now fixed) +some older baselines don't have the clm history files. As one example: + + BFAIL ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.compare_hist.clm4_5_1_r082 + - rerun. compare against clm4_5_1_r081, then it passes. + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.memleak + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.compare_hist.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.memcomp.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.tputcomp.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.C.140917-082253.nlcomp + + For these tests, I made sure that clm2 history files were in the clm4_5_1_r083 baseline dirs. They + should pass going forward. + + ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput + PEM.f10_f10.ICLM45BGCCROP.goldbach_intel.clm-crop + SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default + +Note 2: For these N2 tests, there was a scripts problem with st_archiver in the previous tag. These should pass next time. + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.clm2.h0.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.clm2.h1.compare_hist.clm4_5_1_r082 + +CLM tag used for the baseline comparisons: clm4_5_1_r082 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r082 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 11 14:07:58 MDT 2014 +One-line Summary: Merge in a number of ED changes to address science bugs and infrastructure (particularly restarts) + +Purpose of changes: Merge in ED changes. Most of these have to do with science changes from rfisher. There +is also a refactor and added functionality for ED restarts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): Bug 2041, 2042 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, rfisher + +List any svn externals directories updated (csm_share, mct, etc.): + scripts4_140814a -> scripts4_140910 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- add failing N2 tests (due to scripts, see below). + +M models/lnd/clm/bld/build-namelist +-- documentation at top of file should reference CLMBuildNamelist.pm + +M models/lnd/clm/src/main/clm_driver.F90 +-- add call to SurfaceAlbedo for use_ed logical branch, add EDBioVars as +-- argument to temperature_vars%UpdateAccVars and add canopystate_vars as +-- argument to BalanceCheck (for ED) +M models/lnd/clm/src/main/decompMod.F90 +-- added openMP output...remove mods after getting ED working with openMP + +M models/lnd/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +-- change handling of CWD_AG and CWD_BG +M models/lnd/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +-- added tree_sai function +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +-- signifcant reworking of entire module +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +-- minor code clean up +M models/lnd/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +-- change an error check to: if (( areatot - area ) > 0._r8 ) then + +M models/lnd/clm/src/ED/main/EDBioType.F90 +-- add infrastrucutre (define, allocate, etc...) +M models/lnd/clm/src/ED/main/EDMainMod.F90 +-- major update for updating canopy biomass pools +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +-- modify calls for history file output and error checking +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +-- add resp_clm as restart variable and use SHR_ASSERT instead of call assert. major refactor +-- of createPatchCohortStructure to handle arbitrary number of cohorts and patches +M models/lnd/clm/src/ED/main/EDInitMod.F90 +-- add logical to deal with different values of assignemnt dc%laimemory +M models/lnd/clm/src/ED/main/EDTypesMod.F90 +-- add cohort_type and change paramters: numCohortsPerPatch, cohorts_per_gcell and fire_threshold + +M models/lnd/clm/src/ED/fire/SFMainMod.F90 +-- clean up write statemnts and a bug fix: change tau_b(dg_sf) -> tau_b(c) + +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +-- change tpu25top(FT) = 0.06_r8 * jmax25top(FT) to tpu25top(FT) = 0.167_r8 * jmax25top(FT), some cleanup + +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +-- clean up a use statement +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +-- remove whitespaces after a statement +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +-- add a use_ed block to prevent some unassigned pointer errors +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +-- add canopystate_vars as argument for elai and esai for more verbose error +-- reporting added by rfisher +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +-- add arg. for UpdateAccVars for new calculations, split out use_ed and use_crop +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +-- add associate statement to tlai for error reporting + +M UpDateChangeLog.pl +-- fix tiny typo + +M SVN_EXTERNAL_DIRECTORIES +-- for scripts update + +CLM testing: + + build-namelist tests: + + yellowstone - N/A, no namelist changes made in this tag + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 45 OK , 40 OK + + Changes due to update of scripts from scripts4_140814a -> scripts4_140910 (this change came with scripts4_140828) + FAIL namelist compare: user_nl_clm differs + These should pass next time. + + NEW: flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/surfdata.pftdyn_1x1_tropicAtl_TEST_simyr1939-1943_c140108.nc' + BASELINE: flanduse_timeseries = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/surfdata.pftdyn_1x1_tropicAtl_TEST_simyr1939-1943_c140108.nc' + + FAIL SMS_Ly3.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetLate.GC.newPgi_45_intel.nlcomp + FAIL SMS_Ly5.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetMid.GC.newPgi_45_intel.nlcomp + FAIL SMS_Ly8.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetEarly.GC.newPgi_45_intel.nlcomp + + These fail due to a bug in scripts4_140905c. Alice is aware of this and will provide a fix for a future CLM tag (but 2041): + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default + + Failure that looks like a hardware problem and that Erik is looking into (bug 2042): + RUN ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.newPgi_45_intel + + yellowstone_pgi - 45 OK , 40 OK + + New PGI tests brought over from goldbach. These are expected as there are no baselines for this on yellowstone + + BFAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f10_f10.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICLM45.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f10_f10.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f10_f10.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f19_g16.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f19_g16.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.compare_hist.clm4_5_1_r081 + BFAIL ERS_Lm3.1x1_smallvilleIA.ICLM45BGCCROP.yellowstone_pgi.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_Lm3.1x1_smallvilleIA.ICLM45BGCCROP.yellowstone_pgi.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsROA.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.compare_hist.clm4_5_1_r081 + + goldbach_nag - 45 OK , 40 OK + + Baseline missing from previous tag: + ERI_D.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput- + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/ERI_D.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput/cpl.hi.nc does not exis + SMS.f09_g16.ICRUCLM45.goldbach_nag.clm-af_bias_v5 + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS.f09_g16.ICRUCLM45.goldbach_nag.clm-af_bias_v5/cpl.hi.nc does not exist + SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput/cpl.hi.nc does no + SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput/cpl.hi.nc does no t exist + + goldbach_intel - 45 OK , 40 OK + + goldbach_pgi (These have been moved to yellowstone due to PGI 14.1 throwing and ICE on goldbach) + +CLM tag used for the baseline comparisons: clm4_5_1_r081 + +Changes answers relative to baseline: Only for ED compsets + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r081 +Originator(s): mvertens (Mariana Vertenstein) +Date: Sun Aug 24 19:39:50 MDT 2014 +One-line Summary: major infrastructure changes and directory reorganization under src + +Purpose of changes: + + Overview of previous code design + ========================================== + - data structures arranged by subgrid type (pps, cps, lps, grc) + - all functional categorization lumped in that one subgrid type which led to + - centralization rather than modularization of all data + - definition and instantiation in ONE big module (clmtype.F90) + - allocation and initialization in ONE big module (clmtypeInitMod.F90) + - history variables all in ONE big module (histFldsMod.F90) + - restart variables in effectively TWO big modules (biogeophysicsRestMod.F90 and CNRestMod.F90) + - time constant initialization in ONE complex module (initTimeConst.F90) + - time varying cold start initialization in ONE module (initColdMod.F90) + - accumulation variables in ONE module (accumulMod.F90) + + Overview of new code design + ========================================== + data structures arranged by scientific functional categories + (e.g. temperature_type, waterstate_type, energyflux_type, etc) + - a given data structure now contains ALL subgrid levels are in the data structure - + and variables in the data structure are now appended with a unique suffix to + indicate their subgrid levels (new suffixes: _patch, _col, _lun, _grc) + - this does NOT effect the science code base, ONLY the associate statements + - there are separate module for each data type definition + (e.g. TemperatureType.F90, WaterstateType.F90, EnergyFluxType.F90, etc) + - each data type has associated methods for + - Allocation: + variables now initialized as NaNs upon allocation + - Cold Start Initialization: + cold start initialization of variables is now ALWAYS done + and overwritten if finidat is read in as spun up dataset (also now + have on line interpolation of initial conditions as part of this refactor as well) + - History initialization of variables + All history fields now initialized as spval + - Restart initialization of variables + - Accumulation Initialization + initialization and accumulation update of variables + - Instantiation of datatypes is now separate from their declaration + (for now in clm_initialize.F90 - will be moved in the future) + + Centralized routines that no longer exist: + ========================================== + Data types : clmtype.F90, clmtypeInitMod.F90 + Initialization : initTimeConst.F90, initCold.F90 + History : histFldsMod.F90 + Accumulation : accumulMod.F90 + Restart : biogeophysRestMod.F90, CNRestMod.F90 + Biogeochemistry: CNSetValue.F90 + + New Type modules that now replace clmtype.F90 + ========================================== + main/atm2lndType.F90 + main/lnd2atmType.F90 + main/ColumnType.F90 + main/EcophysConType.F90 + main/GridcellType.F90 + main/LandunitType.F90 + main/PatchType.F90 + + biogeochem/CNCarbonFluxType.F90 + biogeochem/CNCarbonStateType.F90 + biogeochem/CNDecompCascadeConType.F90 + biogeochem/CNDVType.F90 + biogeochem/CNNitrogenFluxType.F90 + biogeochem/CNNitrogenStateType.F90 + biogeochem/CNStateType.F90 + biogeochem/CropType.F90 + + biogeophys/AerosolType.F90 + biogeophys/CanopyStateType.F90 + biogeophys/EnergyFluxType.F90 + biogeophys/FrictionVelocityType.F90 + biogeophys/LakeStateType.F90 + biogeophys/PhotosynthesisType.F90 + biogeophys/SoilHydrologyType.F90 + biogeophys/SoilStateType.F90 + biogeophys/SolarAbsorbedType.F90 + biogeophys/SurfaceAlbedoType.F90 + biogeophys/TemperatureType.F90 + biogeophys/UrbanParamsType.F90 + biogeophys/WaterfluxType.F90 + biogeophys/WaterStateType.F90 + + ED/main/EDBioType.F90 + ED/main/EDEcophysConType.F90 + ED/main/EDVecCohortType.F90 + ED/main/EDVecPatchType.F90 + + + Instantiation of Types + +2) Public Types: + + - the following are public types that can BE PASSED AS ARGUMENTS + - the type instances FOR NOW are clm_initialized and then used by the driver + - this will be generalized in the future + + type(ch4_type) :: ch4_vars + type(carbonstate_type) :: carbonstate_vars + type(carbonstate_type) :: c13_carbonstate_vars + type(carbonstate_type) :: c14_carbonstate_vars + type(carbonflux_type) :: carbonflux_vars + type(carbonflux_type) :: c13_carbonflux_vars + type(carbonflux_type) :: c14_carbonflux_vars + type(nitrogenstate_type) :: nitrogenstate_vars + type(nitrogenflux_type) :: nitrogenflux_vars + type(dgvs_type) :: dgvs_vars + type(crop_type) :: crop_vars + type(cnstate_type) :: cnstate_vars + type(dust_type) :: dust_vars + type(vocemis_type) :: vocemis_vars + type(drydepvel_type) :: drydepvel_vars + type(aerosol_type) :: aerosol_vars + type(canopystate_type) :: canopystate_vars + type(energyflux_type) :: energyflux_vars + type(frictionvel_type) :: frictionvel_vars + type(lakestate_type) :: lakestate_vars + type(photosyns_type) :: photosyns_vars + type(soilstate_type) :: soilstate_vars + type(soilhydrology_type) :: soilhydrology_vars + type(solarabs_type) :: solarabs_vars + type(surfalb_type) :: surfalb_vars + type(surfrad_type) :: surfrad_vars + type(temperature_type) :: temperature_vars + type(urbanparams_type) :: urbanparams_vars + type(waterflux_type) :: waterflux_vars + type(waterstate_type) :: waterstate_vars + type(atm2lnd_type) :: atm2lnd_vars + type(glc2lnd_type) :: glc2lnd_vars + type(lnd2atm_type) :: lnd2atm_vars + type(lnd2glc_type) :: lnd2glc_vars + type(glc_diagnostics_type) :: glc_diagnostics_vars + type(EDbio_type) :: EDbio_vars + + - private Types (now som modules have their own PRIVATE types) + + DUSTMod.F90 : type(dust_type) + VOCEmissionMod.F90: type(vocemis_type) + ch4Mod.F90 : type(ch4_type) + + API Changes: + ========================================== + Original APIs: + clmtype was in effect a global common block and all routines had use statements into it + difficult to track any intent or flow through system + difficult to set up functional unit testing (.e.g. CanopyFluxesMod.F90, etc) + + Refactorized APIs: + all new datatype instances are passed as arguments + science code is effectively the same since only the associate statements have been modified + + New Directory Structure under clm/ + ========================================== + bld/ + doc/ + src/biogeochem/ + src/biogeophys/ + src/cpl/ + src/dyn_subgrid/ + src/ED/ + src/ED/biogeochem + src/ED/biogeophys + src/ED/fire + src/ED/main + src/main/ + src/unit_test_mocks/ + src/unit_test_shr/ + src/utils/ + src_clm4_0/ + test/ + tools/ + + Advantages of refactorization: + ========================================== + - Lets compiler enforce intent attributes + - Makes functional unit testing easier since module drivers can be + constructed with relevant mock data more easily + - Makes more sense scientifically since now easier to extend code logic as + to where you want to introduce new variables + - Easier to maintain code since code flow is easier to follow and to modify + - Easy to move variables around from one data type to another since now + know everything that is logically connected to that variable that + needs to be moved Offers new modularity for trading in and out new + formulations of targeted functionality + +Requirements for tag: N.A. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N.A. + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + directory restructuring has been reflected in changes to configure in setting up the Filepath + +Describe any changes made to the namelist: + clm_hydrology1_inparm changed to clm_canopyhydrology_inparm + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself, Bill Sacks + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +D clm/src/clm4_5 +D clm/src/clm4_5/biogeochem +D clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +D clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +D clm/src/clm4_5/biogeochem/CNRestMod.F90 +D clm/src/clm4_5/biogeochem/CropRestMod.F90 +D clm/src/clm4_5/biogeochem/CNGRespMod.F90 +D clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +D clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +D clm/src/clm4_5/biogeochem/CNFireMod.F90 +D clm/src/clm4_5/biogeochem/CNMRespMod.F90 +D clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +D clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 +D clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +D clm/src/clm4_5/biogeochem/ch4RestMod.F90 +D clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +D clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +D clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +D clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +D clm/src/clm4_5/biogeochem/ch4Mod.F90 +D clm/src/clm4_5/biogeochem/DUSTMod.F90 +D clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +D clm/src/clm4_5/biogeochem/CNInitMod.F90 +D clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +D clm/src/clm4_5/biogeochem/ch4varcon.F90 +D clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +D clm/src/clm4_5/biogeochem/CNDecompMod.F90 +D clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +D clm/src/clm4_5/biogeochem/CNDVMod.F90 +D clm/src/clm4_5/biogeochem/ED +D clm/src/clm4_5/biogeochem/ED/EDCanopyStructureMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDSetValuesMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDGrowthFunctionsMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDPhysiologyMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDCohortDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDPatchDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +D clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +D clm/src/clm4_5/biogeochem/ch4InitMod.F90 +D clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +D clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +D clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +D clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +D clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +D clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +D clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +D clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +D clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +D clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +D clm/src/clm4_5/biogeochem/CNDVInitMod.F90 +D clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 + +D clm/src/clm4_5/main +D clm/src/clm4_5/main/clm_varcon.F90 +D clm/src/clm4_5/main/initInterp.F90 +D clm/src/clm4_5/main/clm_varpar.F90 +D clm/src/clm4_5/main/landunit_varcon.F90 +D clm/src/clm4_5/main/initTimeConstMod.F90 +D clm/src/clm4_5/main/subgridWeightsMod.F90 +D clm/src/clm4_5/main/decompInitMod.F90 +D clm/src/clm4_5/main/clm_initializeMod.F90 +D clm/src/clm4_5/main/subgridRestMod.F90 +D clm/src/clm4_5/main/clm_glclnd.F90 +D clm/src/clm4_5/main/paramUtilMod.F90 +D clm/src/clm4_5/main/accFldsMod.F90 +D clm/src/clm4_5/main/subgridMod.F90 +D clm/src/clm4_5/main/clmtypeInitMod.F90 +D clm/src/clm4_5/main/ndepStreamMod.F90 +D clm/src/clm4_5/main/init_hydrology.F90 +D clm/src/clm4_5/main/initColdMod.F90 +D clm/src/clm4_5/main/column_varcon.F90 +D clm/src/clm4_5/main/histFileMod.F90 +D clm/src/clm4_5/main/pft2colMod.F90 +D clm/src/clm4_5/main/clm_atmlnd.F90 +D clm/src/clm4_5/main/findHistFields.pl +D clm/src/clm4_5/main/clm_varsur.F90 +D clm/src/clm4_5/main/restFileMod.F90 +D clm/src/clm4_5/main/CMakeLists.txt +D clm/src/clm4_5/main/controlMod.F90 +D clm/src/clm4_5/main/spitfireSF +D clm/src/clm4_5/main/spitfireSF/SFParamsMod.F90 +D clm/src/clm4_5/main/spitfireSF/SFMainMod.F90 +D clm/src/clm4_5/main/test +D clm/src/clm4_5/main/test/subgridWeights_test +D clm/src/clm4_5/main/test/subgridWeights_test/test_subgridWeights.pf +D clm/src/clm4_5/main/test/subgridWeights_test/CMakeLists.txt +D clm/src/clm4_5/main/test/clm_glclnd_test +D clm/src/clm4_5/main/test/clm_glclnd_test/test_clm_glclnd.pf +D clm/src/clm4_5/main/test/clm_glclnd_test/CMakeLists.txt +D clm/src/clm4_5/main/test/CMakeLists.txt +D clm/src/clm4_5/main/initSubgridMod.F90 +D clm/src/clm4_5/main/filterMod.F90 +D clm/src/clm4_5/main/clm_varctl.F90 +D clm/src/clm4_5/main/clm_driver.F90 +D clm/src/clm4_5/main/surfrdUtilsMod.F90 +D clm/src/clm4_5/main/ED +D clm/src/clm4_5/main/ED/EDInitTimeConst.F90 +D clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +D clm/src/clm4_5/main/ED/EDClmType.F90 +D clm/src/clm4_5/main/ED/EDRestVectorMod.F90 +D clm/src/clm4_5/main/ED/EDHistFldsMod.F90 +D clm/src/clm4_5/main/ED/EDClmTypeInitMod.F90 +D clm/src/clm4_5/main/ED/EDPftvarcon.F90 +D clm/src/clm4_5/main/ED/EDParamsMod.F90 +D clm/src/clm4_5/main/ED/EDInitMod.F90 +D clm/src/clm4_5/main/ED/EDTypesMod.F90 +D clm/src/clm4_5/main/ED/EDMainMod.F90 +D clm/src/clm4_5/main/subgridAveMod.F90 +D clm/src/clm4_5/main/initGridCellsMod.F90 +D clm/src/clm4_5/main/initSoilParVICMod.F90 +D clm/src/clm4_5/main/pftvarcon.F90 +D clm/src/clm4_5/main/surfrdMod.F90 +D clm/src/clm4_5/main/decompMod.F90 +D clm/src/clm4_5/main/FuncPedotransferMod.F90 +D clm/src/clm4_5/main/clmtype.F90 +D clm/src/clm4_5/main/reweightMod.F90 +D clm/src/clm4_5/main/readParamsMod.F90 +D clm/src/clm4_5/main/histFldsMod.F90 + +D clm/src/clm4_5/biogeophys +D clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +D clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +D clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +D clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +D clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +D clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +D clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +D clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +D clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +D clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +D clm/src/clm4_5/biogeophys/UrbanMod.F90 +D clm/src/clm4_5/biogeophys/QSatMod.F90 +D clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +D clm/src/clm4_5/biogeophys/SurfaceResistanceMod.F90 +D clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +D clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +D clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +D clm/src/clm4_5/biogeophys/SNICARMod.F90 +D clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +D clm/src/clm4_5/biogeophys/CMakeLists.txt +D clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +D clm/src/clm4_5/biogeophys/RootBiophysMod.F90 +D clm/src/clm4_5/biogeophys/test +D clm/src/clm4_5/biogeophys/test/CMakeLists.txt +D clm/src/clm4_5/biogeophys/test/Daylength_test +D clm/src/clm4_5/biogeophys/test/Daylength_test/test_daylength.pf +D clm/src/clm4_5/biogeophys/test/Daylength_test/CMakeLists.txt +D clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +D clm/src/clm4_5/biogeophys/SoilWaterMovementMod.F90 +D clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +D clm/src/clm4_5/biogeophys/SoilMoistStressMod.F90 +D clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +D clm/src/clm4_5/biogeophys/SoiWatRetCurveParMod.F90 +D clm/src/clm4_5/biogeophys/ED +D clm/src/clm4_5/biogeophys/ED/EDAccumulateFluxesMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDSurfaceAlbedoMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDBtranMod.F90 +D clm/src/clm4_5/biogeophys/FracWetMod.F90 +D clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +D clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +D clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +D clm/src/clm4_5/biogeophys/SLakeCon.F90 +D clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +D clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +D clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/DaylengthMod.F90 + +D clm/src/clm4_5/dyn_subgrid +D clm/src/clm4_5/dyn_subgrid/test +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +D clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +D clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +D clm/src/clm4_5/dyn_subgrid/do_genf90 +D clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 +D clm/src/clm4_5/dyn_subgrid/CMakeLists.txt + +D clm/src/util_share +D clm/src/util_share/organicFileMod.F90 +D clm/src/util_share/spmdGathScatMod.F90 +D clm/src/util_share/clm_time_manager.F90 +D clm/src/util_share/clm_nlUtilsMod.F90 +D clm/src/util_share/clm_varorb.F90 +D clm/src/util_share/abortutils.F90 +D clm/src/util_share/accumulMod.F90 +D clm/src/util_share/getdatetime.F90 +D clm/src/util_share/fileutils.F90 +D clm/src/util_share/dtypes.h +D clm/src/util_share/ncdio_pio.F90 +D clm/src/util_share/SimpleMathMod.F90 +D clm/src/util_share/spmdMod.F90 +D clm/src/util_share/domainMod.F90 +D clm/src/util_share/ncdio_pio.F90.in +D clm/src/util_share/restUtilMod.F90 +D clm/src/util_share/quadraticMod.F90 +D clm/src/util_share/restUtilMod.F90.in +D clm/src/util_share/CMakeLists.txt +D clm/src/util_share/GetGlobalValuesMod.F90 + +D clm/src/clm4_0 +D clm/src/clm4_0/biogeochem +D clm/src/clm4_0/biogeochem/CNCStateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/CNGapMortalityMod.F90 +D clm/src/clm4_0/biogeochem/CropRestMod.F90 +D clm/src/clm4_0/biogeochem/CNGRespMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNBalanceCheckMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/CNFireMod.F90 +D clm/src/clm4_0/biogeochem/CNMRespMod.F90 +D clm/src/clm4_0/biogeochem/MEGANFactorsMod.F90 +D clm/src/clm4_0/biogeochem/CNPrecisionControlMod.F90 +D clm/src/clm4_0/biogeochem/CNWoodProductsMod.F90 +D clm/src/clm4_0/biogeochem/CNSummaryMod.F90 +D clm/src/clm4_0/biogeochem/DUSTMod.F90 +D clm/src/clm4_0/biogeochem/CNDVLightMod.F90 +D clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +D clm/src/clm4_0/biogeochem/CNCStateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNDecompMod.F90 +D clm/src/clm4_0/biogeochem/STATICEcosysDynMod.F90 +D clm/src/clm4_0/biogeochem/CNCStateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/CNDVMod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNrestMod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 +D clm/src/clm4_0/biogeochem/CNDVEcosystemDynIniMod.F90 +D clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/C13SummaryMod.F90 +D clm/src/clm4_0/biogeochem/DryDepVelocity.F90 +D clm/src/clm4_0/biogeochem/CNC13FluxMod.F90 +D clm/src/clm4_0/biogeochem/CNAllocationMod.F90 +D clm/src/clm4_0/biogeochem/CNNDynamicsMod.F90 +D clm/src/clm4_0/biogeochem/CNEcosystemDynMod.F90 +D clm/src/clm4_0/biogeochem/CNSetValueMod.F90 +D clm/src/clm4_0/biogeochem/CNVegStructUpdateMod.F90 +D clm/src/clm4_0/biogeochem/CNDVEstablishmentMod.F90 + +D clm/src/clm4_0/main +D clm/src/clm4_0/main/clm_varcon.F90 +D clm/src/clm4_0/main/clm_varpar.F90 +D clm/src/clm4_0/main/CNiniTimeVar.F90 +D clm/src/clm4_0/main/dynlandMod.F90 +D clm/src/clm4_0/main/decompInitMod.F90 +D clm/src/clm4_0/main/clm_initializeMod.F90 +D clm/src/clm4_0/main/subgridRestMod.F90 +D clm/src/clm4_0/main/clm_glclnd.F90 +D clm/src/clm4_0/main/accFldsMod.F90 +D clm/src/clm4_0/main/subgridMod.F90 +D clm/src/clm4_0/main/clmtypeInitMod.F90 +D clm/src/clm4_0/main/ndepStreamMod.F90 +D clm/src/clm4_0/main/pftdynMod.F90 +D clm/src/clm4_0/main/iniTimeConst.F90 +D clm/src/clm4_0/main/histFileMod.F90 +D clm/src/clm4_0/main/pft2colMod.F90 +D clm/src/clm4_0/main/clm_atmlnd.F90 +D clm/src/clm4_0/main/findHistFields.pl +D clm/src/clm4_0/main/restFileMod.F90 +D clm/src/clm4_0/main/clm_varsur.F90 +D clm/src/clm4_0/main/controlMod.F90 +D clm/src/clm4_0/main/initSurfAlbMod.F90 +D clm/src/clm4_0/main/filterMod.F90 +D clm/src/clm4_0/main/clm_driver.F90 +D clm/src/clm4_0/main/clm_varctl.F90 +D clm/src/clm4_0/main/subgridAveMod.F90 +D clm/src/clm4_0/main/initGridCellsMod.F90 +D clm/src/clm4_0/main/CNiniSpecial.F90 +D clm/src/clm4_0/main/pftvarcon.F90 +D clm/src/clm4_0/main/surfrdMod.F90 +D clm/src/clm4_0/main/decompMod.F90 +D clm/src/clm4_0/main/clmtype.F90 +D clm/src/clm4_0/main/histFldsMod.F90 +D clm/src/clm4_0/main/mkarbinitMod.F90 +D clm/src/clm4_0/biogeophys +D clm/src/clm4_0/biogeophys/BalanceCheckMod.F90 +D clm/src/clm4_0/biogeophys/SurfaceRadiationMod.F90 +D clm/src/clm4_0/biogeophys/SoilTemperatureMod.F90 +D clm/src/clm4_0/biogeophys/SnowHydrologyMod.F90 +D clm/src/clm4_0/biogeophys/UrbanInputMod.F90 +D clm/src/clm4_0/biogeophys/Biogeophysics1Mod.F90 +D clm/src/clm4_0/biogeophys/Biogeophysics2Mod.F90 +D clm/src/clm4_0/biogeophys/FracWetMod.F90 +D clm/src/clm4_0/biogeophys/UrbanInitMod.F90 +D clm/src/clm4_0/biogeophys/FrictionVelocityMod.F90 +D clm/src/clm4_0/biogeophys/TridiagonalMod.F90 +D clm/src/clm4_0/biogeophys/SurfaceAlbedoMod.F90 +D clm/src/clm4_0/biogeophys/Hydrology1Mod.F90 +D clm/src/clm4_0/biogeophys/Hydrology2Mod.F90 +D clm/src/clm4_0/biogeophys/BiogeophysicsLakeMod.F90 +D clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 +D clm/src/clm4_0/biogeophys/UrbanMod.F90 +D clm/src/clm4_0/biogeophys/SoilHydrologyMod.F90 +D clm/src/clm4_0/biogeophys/QSatMod.F90 +D clm/src/clm4_0/biogeophys/clm_driverInitMod.F90 +D clm/src/clm4_0/biogeophys/HydrologyLakeMod.F90 +D clm/src/clm4_0/biogeophys/BareGroundFluxesMod.F90 +D clm/src/clm4_0/biogeophys/SNICARMod.F90 +D clm/src/clm4_0/biogeophys/CanopyFluxesMod.F90 + +List all files added and what they do: + +A clm/src_clm40 +A clm/src_clm40/biogeochem +A clm/src_clm40/biogeochem/CNCStateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/CNGRespMod.F90 +A clm/src_clm40/biogeochem/CNBalanceCheckMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNSummaryMod.F90 +A clm/src_clm40/biogeochem/CNPhenologyMod.F90 +A clm/src_clm40/biogeochem/STATICEcosysDynMod.F90 +A clm/src_clm40/biogeochem/CNCStateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNrestMod.F90 +A clm/src_clm40/biogeochem/VOCEmissionMod.F90 +A clm/src_clm40/biogeochem/CNAnnualUpdateMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/C13SummaryMod.F90 +A clm/src_clm40/biogeochem/CNAllocationMod.F90 +A clm/src_clm40/biogeochem/DryDepVelocity.F90 +A clm/src_clm40/biogeochem/CNNDynamicsMod.F90 +A clm/src_clm40/biogeochem/CNSetValueMod.F90 +A clm/src_clm40/biogeochem/CNGapMortalityMod.F90 +A clm/src_clm40/biogeochem/CropRestMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNFireMod.F90 +A clm/src_clm40/biogeochem/CNMRespMod.F90 +A clm/src_clm40/biogeochem/MEGANFactorsMod.F90 +A clm/src_clm40/biogeochem/CNWoodProductsMod.F90 +A clm/src_clm40/biogeochem/CNPrecisionControlMod.F90 +A clm/src_clm40/biogeochem/DUSTMod.F90 +A clm/src_clm40/biogeochem/CNDVLightMod.F90 +A clm/src_clm40/biogeochem/CNDecompMod.F90 +A clm/src_clm40/biogeochem/CNDVMod.F90 +A clm/src_clm40/biogeochem/CNCStateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNDVEcosystemDynIniMod.F90 +A clm/src_clm40/biogeochem/CNC13FluxMod.F90 +A clm/src_clm40/biogeochem/CNEcosystemDynMod.F90 +A clm/src_clm40/biogeochem/CNVegStructUpdateMod.F90 +A clm/src_clm40/biogeochem/CNDVEstablishmentMod.F90 + +A clm/src_clm40/main +A clm/src_clm40/main/spmdGathScatMod.F90 +A clm/src_clm40/main/organicFileMod.F90 +A clm/src_clm40/main/clm_varcon.F90 +A clm/src_clm40/main/clm_varpar.F90 +A clm/src_clm40/main/CNiniTimeVar.F90 +A clm/src_clm40/main/abortutils.F90 +A clm/src_clm40/main/accumulMod.F90 +A clm/src_clm40/main/decompInitMod.F90 +A clm/src_clm40/main/clm_glclnd.F90 +A clm/src_clm40/main/accFldsMod.F90 +A clm/src_clm40/main/subgridMod.F90 +A clm/src_clm40/main/pftdynMod.F90 +A clm/src_clm40/main/pft2colMod.F90 +A clm/src_clm40/main/clm_atmlnd.F90 +A clm/src_clm40/main/quadraticMod.F90 +A clm/src_clm40/main/GetGlobalValuesMod.F90 +A clm/src_clm40/main/clm_time_manager.F90 +A clm/src_clm40/main/filterMod.F90 +A clm/src_clm40/main/clm_varctl.F90 +A clm/src_clm40/main/subgridAveMod.F90 +A clm/src_clm40/main/dtypes.h +A clm/src_clm40/main/CNiniSpecial.F90 +A clm/src_clm40/main/surfrdMod.F90 +A clm/src_clm40/main/domainMod.F90 +A clm/src_clm40/main/lnd_import_export.F90 +A clm/src_clm40/main/restUtilMod.F90 +A clm/src_clm40/main/clmtype.F90 +A clm/src_clm40/main/mkarbinitMod.F90 +A clm/src_clm40/main/restUtilMod.F90.in +A clm/src_clm40/main/dynlandMod.F90 +A clm/src_clm40/main/getdatetime.F90 +A clm/src_clm40/main/clm_initializeMod.F90 +A clm/src_clm40/main/subgridRestMod.F90 +A clm/src_clm40/main/fileutils.F90 +A clm/src_clm40/main/clmtypeInitMod.F90 +A clm/src_clm40/main/ndepStreamMod.F90 +A clm/src_clm40/main/SimpleMathMod.F90 +A clm/src_clm40/main/iniTimeConst.F90 +A clm/src_clm40/main/lnd_comp_esmf.F90 +A clm/src_clm40/main/histFileMod.F90 +A clm/src_clm40/main/clm_cpl_indices.F90 +A clm/src_clm40/main/findHistFields.pl +A clm/src_clm40/main/restFileMod.F90 +A clm/src_clm40/main/clm_varsur.F90 +A clm/src_clm40/main/controlMod.F90 +A clm/src_clm40/main/CMakeLists.txt +A clm/src_clm40/main/initSurfAlbMod.F90 +A clm/src_clm40/main/clm_nlUtilsMod.F90 +A clm/src_clm40/main/clm_driver.F90 +A clm/src_clm40/main/clm_varorb.F90 +A clm/src_clm40/main/initGridCellsMod.F90 +A clm/src_clm40/main/lnd_comp_mct.F90 +A clm/src_clm40/main/pftvarcon.F90 +A clm/src_clm40/main/ncdio_pio.F90 +A clm/src_clm40/main/spmdMod.F90 +A clm/src_clm40/main/decompMod.F90 +A clm/src_clm40/main/ncdio_pio.F90.in +A clm/src_clm40/main/histFldsMod.F90 + +A clm/src_clm40/biogeophys +A clm/src_clm40/biogeophys/BalanceCheckMod.F90 +A clm/src_clm40/biogeophys/SoilTemperatureMod.F90 +A clm/src_clm40/biogeophys/UrbanInputMod.F90 +A clm/src_clm40/biogeophys/SnowHydrologyMod.F90 +A clm/src_clm40/biogeophys/Biogeophysics1Mod.F90 +A clm/src_clm40/biogeophys/FrictionVelocityMod.F90 +A clm/src_clm40/biogeophys/TridiagonalMod.F90 +A clm/src_clm40/biogeophys/Hydrology1Mod.F90 +A clm/src_clm40/biogeophys/BiogeophysRestMod.F90 +A clm/src_clm40/biogeophys/UrbanMod.F90 +A clm/src_clm40/biogeophys/QSatMod.F90 +A clm/src_clm40/biogeophys/clm_driverInitMod.F90 +A clm/src_clm40/biogeophys/HydrologyLakeMod.F90 +A clm/src_clm40/biogeophys/BareGroundFluxesMod.F90 +A clm/src_clm40/biogeophys/SNICARMod.F90 +A clm/src_clm40/biogeophys/CanopyFluxesMod.F90 +A clm/src_clm40/biogeophys/SurfaceRadiationMod.F90 +A clm/src_clm40/biogeophys/Biogeophysics2Mod.F90 +A clm/src_clm40/biogeophys/UrbanInitMod.F90 +A clm/src_clm40/biogeophys/FracWetMod.F90 +A clm/src_clm40/biogeophys/SurfaceAlbedoMod.F90 +A clm/src_clm40/biogeophys/Hydrology2Mod.F90 +A clm/src_clm40/biogeophys/BiogeophysicsLakeMod.F90 +A clm/src_clm40/biogeophys/SoilHydrologyMod.F90 + +A clm/src/main +A clm/src/main/organicFileMod.F90 +A clm/src/main/clm_varcon.F90 +A clm/src/main/initInterp.F90 +A clm/src/main/landunit_varcon.F90 +A clm/src/main/clm_varpar.F90 +A clm/src/main/abortutils.F90 +A clm/src/main/accumulMod.F90 +A clm/src/main/subgridWeightsMod.F90 +A clm/src/main/decompInitMod.F90 +A clm/src/main/subgridMod.F90 +A clm/src/main/atm2lndType.F90 +A clm/src/main/lnd2atmType.F90 +A clm/src/main/column_varcon.F90 +A clm/src/main/EcophysConType.F90 +A clm/src/main/GetGlobalValuesMod.F90 +A clm/src/main/initSubgridMod.F90 +A clm/src/main/lnd2glcMod.F90 +A clm/src/main/glc2lndMod.F90 +A clm/src/main/filterMod.F90 +A clm/src/main/surfrdUtilsMod.F90 +A clm/src/main/clm_varctl.F90 +A clm/src/main/subgridAveMod.F90 +A clm/src/main/initVerticalMod.F90 +A clm/src/main/glcDiagnosticsMod.F90 +A clm/src/main/lnd2atmMod.F90 +A clm/src/main/atm2lndMod.F90 +A clm/src/main/surfrdMod.F90 +A clm/src/main/FuncPedotransferMod.F90 +A clm/src/main/readParamsMod.F90 +A clm/src/main/clm_initializeMod.F90 +A clm/src/main/subgridRestMod.F90 +A clm/src/main/paramUtilMod.F90 +A clm/src/main/ColumnType.F90 +A clm/src/main/PatchType.F90 +A clm/src/main/ndepStreamMod.F90 +A clm/src/main/init_hydrology.F90 +A clm/src/main/histFileMod.F90 +A clm/src/main/findHistFields.pl +A clm/src/main/restFileMod.F90 +A clm/src/main/clm_varsur.F90 +A clm/src/main/controlMod.F90 +A clm/src/main/LandunitType.F90 +A clm/src/main/CMakeLists.txt +A clm/src/main/test +A clm/src/main/test/subgridWeights_test +A clm/src/main/test/subgridWeights_test/test_subgridWeights.pf +A clm/src/main/test/subgridWeights_test/CMakeLists.txt +A clm/src/main/test/clm_glclnd_test +A clm/src/main/test/clm_glclnd_test/test_clm_glclnd.pf +A clm/src/main/test/clm_glclnd_test/CMakeLists.txt +A clm/src/main/test/CMakeLists.txt +A clm/src/main/clm_driver.F90 +A clm/src/main/GridcellType.F90 +A clm/src/main/initGridCellsMod.F90 +A clm/src/main/pftvarcon.F90 +A clm/src/main/ncdio_pio.F90 +A clm/src/main/decompMod.F90 +A clm/src/main/ncdio_pio.F90.in +A clm/src/main/reweightMod.F90 + +A clm/src/ED +A clm/src/ED/biogeochem +A clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +A clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +A clm/src/ED/biogeochem/EDPhysiologyMod.F90 +A clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +A clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +A clm/src/ED/main +A clm/src/ED/main/EDBioType.F90 +A clm/src/ED/main/EDEcophysConType.F90 +A clm/src/ED/main/EDParamsMod.F90 +A clm/src/ED/main/EDMainMod.F90 +A clm/src/ED/main/EDCLMLinkMod.F90 +A clm/src/ED/main/EDVecCohortType.F90 +A clm/src/ED/main/EDVecPatchType.F90 +A clm/src/ED/main/EDRestVectorMod.F90 +A clm/src/ED/main/EDPftvarcon.F90 +A clm/src/ED/main/EDInitMod.F90 +A clm/src/ED/main/EDTypesMod.F90 +A clm/src/ED/fire +A clm/src/ED/fire/SFParamsMod.F90 +A clm/src/ED/fire/SFMainMod.F90 +A clm/src/ED/biogeophys +A clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +A clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +A clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +A clm/src/ED/biogeophys/EDBtranMod.F90 +A clm/src/Notes +M clm/src/unit_test_shr/unittestSubgridMod.F90 + +A clm/src/utils +A clm/src/utils/spmdGathScatMod.F90 +A clm/src/utils/clm_time_manager.F90 +A clm/src/utils/clm_nlUtilsMod.F90 +A clm/src/utils/clm_varorb.F90 +A clm/src/utils/accumulMod.F90 +A clm/src/utils/getdatetime.F90 +A clm/src/utils/fileutils.F90 +A clm/src/utils/dtypes.h +A clm/src/utils/spmdMod.F90 +A clm/src/utils/SimpleMathMod.F90 +A clm/src/utils/domainMod.F90 +A clm/src/utils/restUtilMod.F90 +A clm/src/utils/quadraticMod.F90 +A clm/src/utils/CMakeLists.txt +A clm/src/utils/restUtilMod.F90.in + +A clm/src/biogeochem +A clm/src/biogeochem/CNCStateUpdate2Mod.F90 +A clm/src/biogeochem/CNDecompCascadeConType.F90 +A clm/src/biogeochem/CNNitrifDenitrifMod.F90 +A clm/src/biogeochem/CNGRespMod.F90 +A clm/src/biogeochem/CNBalanceCheckMod.F90 +A clm/src/biogeochem/CNNStateUpdate3Mod.F90 +A clm/src/biogeochem/CNDVDriverMod.F90 +A clm/src/biogeochem/SatellitePhenologyMod.F90 +A clm/src/biogeochem/CNPhenologyMod.F90 +A clm/src/biogeochem/CNCarbonFluxType.F90 +A clm/src/biogeochem/CNCarbonStateType.F90 +A clm/src/biogeochem/CNCStateUpdate1Mod.F90 +A clm/src/biogeochem/VOCEmissionMod.F90 +A clm/src/biogeochem/CNAnnualUpdateMod.F90 +A clm/src/biogeochem/CNNStateUpdate2Mod.F90 +A clm/src/biogeochem/CropType.F90 +A clm/src/biogeochem/CNAllocationMod.F90 +A clm/src/biogeochem/CNNDynamicsMod.F90 +A clm/src/biogeochem/DryDepVelocity.F90 +A clm/src/biogeochem/CNDecompCascadeBGCMod.F90 +A clm/src/biogeochem/CNSoilLittVertTranspMod.F90 +A clm/src/biogeochem/CNDecompCascadeCNMod.F90 +A clm/src/biogeochem/CNC14DecayMod.F90 +A clm/src/biogeochem/CNGapMortalityMod.F90 +A clm/src/biogeochem/CNNStateUpdate1Mod.F90 +A clm/src/biogeochem/CNFireMod.F90 +A clm/src/biogeochem/CNNitrogenFluxType.F90 +A clm/src/biogeochem/CNMRespMod.F90 +A clm/src/biogeochem/MEGANFactorsMod.F90 +A clm/src/biogeochem/CNVerticalProfileMod.F90 +A clm/src/biogeochem/CNCIsoFluxMod.F90 +A clm/src/biogeochem/CNWoodProductsMod.F90 +A clm/src/biogeochem/CNPrecisionControlMod.F90 +A clm/src/biogeochem/ch4Mod.F90 +A clm/src/biogeochem/DUSTMod.F90 +A clm/src/biogeochem/CNDVLightMod.F90 +A clm/src/biogeochem/ch4varcon.F90 +A clm/src/biogeochem/CNDecompMod.F90 +A clm/src/biogeochem/CNCStateUpdate3Mod.F90 +A clm/src/biogeochem/CNSharedParamsMod.F90 +A clm/src/biogeochem/CNDVType.F90 +A clm/src/biogeochem/CNStateType.F90 +A clm/src/biogeochem/CNEcosystemDynMod.F90 +A clm/src/biogeochem/CNNitrogenStateType.F90 +A clm/src/biogeochem/CNVegStructUpdateMod.F90 +A clm/src/biogeochem/CNDVEstablishmentMod.F90 + +A clm/src/biogeophys +A clm/src/biogeophys/SnowSnicarMod.F90 +A clm/src/biogeophys/SnowHydrologyMod.F90 +A clm/src/biogeophys/TridiagonalMod.F90 +A clm/src/biogeophys/FrictionVelocityType.F90 +A clm/src/biogeophys/LakeFluxesMod.F90 +A clm/src/biogeophys/PhotosynthesisMod.F90 +A clm/src/biogeophys/AerosolType.F90 +A clm/src/biogeophys/ActiveLayerMod.F90 +A clm/src/biogeophys/QSatMod.F90 +A clm/src/biogeophys/SoilHydrologyType.F90 +A clm/src/biogeophys/HydrologyDrainageMod.F90 +A clm/src/biogeophys/LakeStateType.F90 +A clm/src/biogeophys/BareGroundFluxesMod.F90 +A clm/src/biogeophys/SolarAbsorbedType.F90 +A clm/src/biogeophys/CanopyHydrologyMod.F90 +A clm/src/biogeophys/UrbanFluxesMod.F90 +A clm/src/biogeophys/SurfaceAlbedoMod.F90 +A clm/src/biogeophys/UrbanRadiationMod.F90 +A clm/src/biogeophys/PhotosynthesisType.F90 +A clm/src/biogeophys/CanopyTemperatureMod.F90 +A clm/src/biogeophys/HydrologyNoDrainageMod.F90 +A clm/src/biogeophys/DaylengthMod.F90 +A clm/src/biogeophys/WaterfluxType.F90 +A clm/src/biogeophys/BalanceCheckMod.F90 +A clm/src/biogeophys/SoilTemperatureMod.F90 +A clm/src/biogeophys/WaterStateType.F90 +A clm/src/biogeophys/LakeTemperatureMod.F90 +A clm/src/biogeophys/FrictionVelocityMod.F90 +A clm/src/biogeophys/SoilFluxesMod.F90 +A clm/src/biogeophys/TemperatureType.F90 +A clm/src/biogeophys/SurfaceAlbedoType.F90 +A clm/src/biogeophys/AerosolMod.F90 +A clm/src/biogeophys/SoilStateType.F90 +A clm/src/biogeophys/SurfaceResistanceMod.F90 +A clm/src/biogeophys/UrbanAlbedoMod.F90 +A clm/src/biogeophys/CanopyFluxesMod.F90 +A clm/src/biogeophys/CMakeLists.txt +A clm/src/biogeophys/RootBiophysMod.F90 +A clm/src/biogeophys/test +A clm/src/biogeophys/test/CMakeLists.txt +A clm/src/biogeophys/test/Daylength_test +A clm/src/biogeophys/test/Daylength_test/test_daylength.pf +A clm/src/biogeophys/test/Daylength_test/CMakeLists.txt +A clm/src/biogeophys/SurfaceRadiationMod.F90 +A clm/src/biogeophys/SoilWaterMovementMod.F90 +A clm/src/biogeophys/SoilMoistStressMod.F90 +A clm/src/biogeophys/SoiWatRetCurveParMod.F90 +A clm/src/biogeophys/EnergyFluxType.F90 +A clm/src/biogeophys/CanopyStateType.F90 +A clm/src/biogeophys/BandDiagonalMod.F90 +A clm/src/biogeophys/SoilHydrologyMod.F90 +A clm/src/biogeophys/LakeCon.F90 +A clm/src/biogeophys/LakeHydrologyMod.F90 +A clm/src/biogeophys/UrbanParamsType.F90 +A clm/src/dyn_subgrid +A clm/src/dyn_subgrid/dynLandunitAreaMod.F90 +A clm/src/dyn_subgrid/dynTimeInfoMod.F90 +A clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +A clm/src/dyn_subgrid/dynFileMod.F90 +A clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +A clm/src/dyn_subgrid/dynEDMod.F90 +A clm/src/dyn_subgrid/dynVarMod.F90 +A clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +A clm/src/dyn_subgrid/dynVarMod.F90.in +A clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +A clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90.in +A clm/src/dyn_subgrid/do_genf90 +A clm/src/dyn_subgrid/CMakeLists.txt +A clm/src/dyn_subgrid/test +A clm/src/dyn_subgrid/test/dynLandunitArea_test +A clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A clm/src/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +A clm/src/dyn_subgrid/test/dynVar_test +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +A clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynTimeInfo_test +A clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +A clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynInitColumns_test +A clm/src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +A clm/src/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +A clm/src/dyn_subgrid/dynHarvestMod.F90 +A clm/src/dyn_subgrid/dynPriorWeightsMod.F90 +A clm/src/dyn_subgrid/dynpftFileMod.F90 +A clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +A clm/src/dyn_subgrid/dynCNDVMod.F90 +A clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 +A clm/src/dyn_subgrid/dynInitColumnsMod.F90 +A clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90 +A clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90.in + +List all existing files that have been modified, and describe the changes: + ALL files have been modified - see the general description for an + overview of what was done - the following files have not had their directories + changed - so the summary is below + +M clm/bld/configure + - needed to account for change in filepath + +M clm/bld/CLMBuildNamelist.pm +M clm/bld/namelist_files/namelist_definition_clm4_5.xml + - see namelist changes mentioned above + +M clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 +M clm/src/unit_test_mocks/util_share/ncdio_var.F90 +M clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +M clm/src/unit_test_mocks/util_share/do_genf90 +M clm/src/unit_test_mocks/util_share/CMakeLists.txt +M clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +M clm/src/unit_test_mocks/main/histFileMod_mock.F90 +M clm/src/CMakeLists.txt + - unit test changes needed to account for introduction of new data types and + directory structure + +M clm/src/cpl/lnd_comp_esmf.F90 +M clm/src/cpl/lnd_import_export.F90 +M clm/src/cpl/lnd_comp_mct.F90 + - coupling interface changes needed to account for introduction of new data types + +CLM testing: + + build-namelist tests: + + yellowstone yes + goldbach yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + NOTE for goldbach_nag - four ED compare_hist tests fail with small bit for bit differences. + In fact - looking more closely, these tests are also run for pgi and intel on goldbach - and + values for LITTER_IN and LITTER_OUT are 0. for those compilers but non-zero for nag. + With the refactoring code - those fields are again 0. for intel and pgi - but totally different + and non-zero for nag. Apparently, this is known problem that will get resolved in when new ED changes + are brount in + + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + + + short tests (aux_clm_short) (generally these are NOT used when making a tag): N/A + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r080 + +Changes answers relative to baseline: No - BFB + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r080 +Originator(s): erik (Erik) +Date: Sat Aug 16 15:01:35 MDT 2014 +One-line Summary: Update externals to CESM trunk versions, allow eighth degree as a valid resolution + +Purpose of changes: + +Update all the externals to the very latest CESM trunk versions (based off of current +cesm1_3_alpha13a). + +Requirements for tag: Get working with trunk externals + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 2012 Problem with mksurfdata_map for eighth degree grid... + Scripts issues as follows: + 2024 nlcompareonly option to create_test not working correctly for reporting + 2019 ERH tests don't save the base env_run.xml, so have trouble when resubmitted... + 2018 Failed tests in cesm1_3_beta11 needed for CLM + 2005 Remove untested named compsets and grids + 1999 T85_g16 has inconsistent land domain and surface datasets + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Archiving updated in support of time series generation + Running test suite now builds some shared libraries built only once + +Describe any changes made to the namelist: + Resolve env and xml vars used in user_nl_* + + Default for drv_in profile_timer changed from 4 to 1 + Some PE layours change: f10_f10 change from 15x1 to 30x1 + +List any changes to the defaults for the boundary datasets: Add 0.125x0.125 mapping files + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): Update to cesm1_3_alpha13a externals + + scripts to scripts4_140814a + scripts/doc to doc_140519 + Machines to Machines_140811 + CMake to CMake_Fortran_utils_140715 + drv to drvseq5_0_15 + cism to cism1_140602 + timing to timing_140416 + pio to pio1_8_12 + cprnc to cprnc_140625 + mapping to mapping_140702b (note: gen_domain changes answers) + unit_testing to unit_testing_0_07 + + PTCLM to PTCLM2_140816 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 -- decrease tolerance + M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl - Loop over variables + and then cat the files together at the end. This makes the process possible for + high resolution and speeds up lower resolution sub-setting as well. + M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 -- decrease tolerance + M models/lnd/clm/tools/shared/mkmapdata/README --------------------- Fix/update documentation + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ----------- Correct test count + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Add 0.125x0.125 + mapping files + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Add 0.125x0.125 + as a valid resolution + M models/lnd/clm/bld/namelist_files/createMapEntry.pl --- Correct path, get working again + +CLM testing: + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_1_r079 + +Changes answers relative to baseline: Yes! (PE layouts that change) + + Summarize any changes to answers, i.e., + - what code configurations: non single-point configurations, where PE layout + changes (f10_f10) + - what platforms/compilers: all + - nature of change (roundoff) + x2l_Flrr_volr changes to roundoff + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r079 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jul 31 17:09:57 MDT 2014 +One-line Summary: G. Bisht (LBL) soil temperature refactor; machines update for goldbach-intel + +Purpose of changes: Refactor soil temperature module to break the construction of the linear system LHS matrix and RHS vector into small physics based routines. Update machines external to fix compiling with goldbach-intel. + +Requirements for tag: regular + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: gbisht, self, muszala + +List any svn externals directories updated (csm_share, mct, etc.): Machines + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 - break creation of linear system into small physics based routines. + + +CLM testing: regular + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 4.0 ok, 4.5 ok + yellowstone_pgi - 4.0 ok, 4.5 ok + goldbach_nag - 4.0 ok, 4.5 ok (see note below) + goldbach_intel - 4.0 ok, 4.5 ok + goldbach_pgi - 4.0 ok, 4.5 ok + + NOTE for goldbach_nag - four ED compare_hist tests fail with small non bit for bit differences. This is the same issue described in clm4_5_1_r078 tag notes. + + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r078 + +Changes answers relative to baseline: No, bit for bit + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r078 +Originator(s): muszala (Stefan Muszala) +Date: Wed Jul 23 20:42:00 MDT 2014 +One-line Summary: Add lai stream capability and the ability to run with V5 cruncep data. Code written by swenson, +modified and tested by muszala. + +Purpose of changes: Add lai stream capability with use_lai_streams namelist variable. Also add a datm_mode option +s.t. we can use cruncep V5 data if a user wants. Move anomaly focing code out of CLM and into DATM. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: add setup_logic_lai_streams which controls use_lai_streams namelist variable + +List any changes to the defaults for the boundary datasets: added option to use V5 cruncep data sets. V4 is default. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: kluzek, swenson, self + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/addclm50_tags/addclm50_n06_ED_scripts_015_140305_rev ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/addclm50_tags/addclm50_n09_ED_scripts_015_140305_rev + +-models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_140312 ++models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_140723 + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140418 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +! add setup_logic_lai_streams function +M models/lnd/clm/bld/CLMBuildNamelist.pm +! add entries for: stream_year_first_lai, stream_year_last_lai, model_year_align_lai, stream_fldfilename_lai, lai_mapalgo +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +! add default values for items added in namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +! add use_lai_streams code. lai_init, lai_interp +M models/lnd/clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 +! some comment clean up. add use_lai_streams logical +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +! add use_lai_streams namelist handling and mpi_bcast call +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +! remove snomaly forcing streams since they are now in the datm +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +! remove anomaly forcing code since it is now in datm +M models/lnd/clm/src/cpl/lnd_import_export.F90 + +CLM testing: + + build-namelist tests: + + yellowstone - failed 20 tests of 537. This is expected due to the addition of the use_lai_streams namelist variable. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + -- nlcomp tests for 45 will fail -- + + yellowstone_intel - 40 OK - 45 OK + yellowstone_pgi - 40 OK - 45 OK + + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + goldbach_pgi - 40 OK - 45 OK + +Both NAG tests on goldbach for ED compsets failed BFB. All other compilers and machines pass. Error probably related to a non-BFB error that I (spm) see with varying numbers of +time-steps on an ERS test and am currently trying to fix. + +FAIL ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.compare_hist.clm4_5_1_r077_redo +FAIL ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.clm2.h0.compare_hist.clm4_5_1_r077_redo +FAIL SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.compare_hist.clm4_5_1_r077_redo +FAIL SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.clm2.h0.compare_hist.clm4_5_1_r077_redo +CLM tag used for the baseline comparisons: clm4_5_1_r077 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r077 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jul 10 21:55:11 MDT 2014 +One-line Summary: Refactor from Jinyun Tang (LBL) to make hydrology more modular and eventually allow runtime selection of different physics implementations. + +Purpose of changes: Refactor a number of routines in clm45 hydrology to move duplicate code into reusable routines, make the code more modular for eventual unit testing and run time selection of different physics. + +Requirements for tag: bit for bit, regular testing + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, clm-cmt + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + models/lnd/clm/src/util_share/SimpleMathMod.F90 - reuseable array functions + models/lnd/clm/src/clm4_5/main/init_hydrology.F90 - initialize different hydrology submodules. + models/lnd/clm/src/clm4_5/main/FuncPedotransferMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SurfaceResistanceMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/RootBiophysMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilWaterMovementMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilMoistStressMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoiWatRetCurveParMod.F90 - modularize + + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/bld/query-xFail - check python version and provide an error message of it is too old. + models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 - remove unused min/max variables that conflict with intrinsics with gfortran. + + + models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 - modularize + models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - allocate new variable, fix bounds on porosity + models/lnd/clm/src/clm4_5/main/controlMod.F90 - initialize new hydrology modules + models/lnd/clm/src/clm4_5/main/clmtype.F90 - add new variable + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 - modularize + +CLM testing: regular + + build-namelist tests: + + yellowstone - n/a + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - OK clm40, OK clm45 + yellowstone_pgi - OK clm40, OK clm45 + goldbach_nag - OK clm40, OK clm45 + goldbach_intel - OK clm40, OK clm45 + goldbach_pgi - OK clm40, OK clm45 + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel - n/a + yellowstone_pgi - n/a + goldbach_nag - n/a + + tools testing: + + yellowstone interactive - n/a + goldbach interactive - n/a + +CLM tag used for the baseline comparisons: clm4_5_1_r076 + +Changes answers relative to baseline: No, bit for bit + + Note: SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest is not bit for bit. This is the same test Stef had problems with in clm4_5_75. He has looked at it and given the ok make the tag as is. + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r076 +Originator(s): erik (Erik) +Date: Mon Jul 7 14:24:07 MDT 2014 +Orig Date: Wed Jun 25 13:49:49 MDT 2014 (Date of what was tagged as clm4_6_0, before we changed naming convention) +One-line Summary: Answer changes for fire code from Fang Li + +Purpose of changes: + +Several changes to CN Fire model. Some fixes for non-transient, as well as limiting of fire for high tropical +forest coverage. Change some units from per time-step to per second. Change Lightning input dataset from just +cloud to ground to total lightning. Some fire parameters were also changed and re-tuned for Qian forcing. +Some more documentation on fire fields was added. + +When -ed_mode is sent to CLM build-namelist, a particular ED params dataset is used over the default. Make +a simple change that allows ED to run when CN is off. Add a 1850 and transient 20thC and rcp=8.5 datasets +for 1x1_brazil. + +Requirements for tag: Fix bugs 1805 and 1719, lower fire amount in amazon + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1996 -- change cloud to ground lightning dataset to total lightning + 1995 -- change units from per time-step to per second + 1805 -- fire fix for non-transient + 1719 -- remove double counting of baf in fire area + 1992 -- allow ED to run when use_cn=.false. + 1988 -- Add ED params dataset. + 1991 -- transient datasets for 1x1_brazil + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + specific rparams file for ED + add 1850 and 20thC, rcp8.5 datasets for 1x1_brazil + use lightning file that is total lightning not just cloud-to-ground + +Describe any substantial timing or memory changes: + The test SMS.f19_g16.IRCP45CN.yellowstone_pgi showed a memory increase + +Code reviewed by: self, lifang + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to addclm50_n06_ED_scripts_015_140305_rev + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl --------- Add some ED tests + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - Different + params file for ED, and add 1850 and 20thC, rcp8.5 datasets for 1x1_brazil + and use lightning file that is total lightning not just cloud-to-ground + M models/lnd/clm/bld/CLMBuildNamelist.pm ------------------------- Pass use_ed + when getting paramfile + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ------------- Revisions from + Fang Li (2014), change parameters, add documentation, tropical forests will + only burn if > 60% coverage, change some fields units to per second rather than + per time-step, + M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 ------------- change units + for nfire, and farea_burned + M models/lnd/clm/src/clm4_5/main/clmtype.F90 --------------------- Change units + for nfire, lfc, lfc2, baf_crop, baf_peatf, fbac, fbac1, farea_burned + M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 ----------------- Change units for: + LFC2, NFIRE, FAREA_BURNED, BAF_CROP, BAF_PEATF + M models/lnd/clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 Allow to work + when use_cn is .false., use c3psn+1 in finding index for dr array. + +CLM testing: + + build-namelist tests: yes + + NOTE: 191 of the 537 compare tests fail, compared to clm4_5_75, because of changes in the namelist. + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_75 + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CN and BGC with CLM4.5 physics + CLM4.0 for all modes, and CLM4.5 with SP or ED should be identical + - what platforms/compilers: All + - nature of change: new climate + + Fang Li, ran simulations with Qian forcing on yellowstone and tuned fire parameters to that forcing. + However, her simulations had a minor bug in the conversion of total lightning to just cloud-to-ground + (latitude in degree's was used for a cosine, rather than latitude in radians -- see bug 1996). + +=============================================================== +=============================================================== +Tag name: clm4_5_75 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Fri May 30 11:18:35 MDT 2014 +One-line Summary: update externals to rtm1_0_38 and esmf_wrf_timemgr_140529 + +Purpose of changes: update externals to rtm1_0_38 and esmf_wrf_timemgr_140529. These modifications +are based on valgrind errors that orginated in src/riverroute. Tested in clm4_5_72 to make sure +everything was still BFB (at least w.r.t. CLM testing). Retested (results below) against clm4_5_73. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID):N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_37 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_38 + +-models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 ++models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_140529 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: + +in addition to other clm tests I updated the rtm and esmf externals in cesm1_3_alpha09c and +ran two B cases. + +Note: There is one ED test (SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTestGb) that failed for me in my +testing but passed for Bill with the same checkout. We will keep an eye on this, but it's not super-critical at the moment. +Differences are very small in cpl. voc fields (largest RMS difference is 1e-13). + +>>more TestStatus +PASS ERS_PT.T31_g37.B1850CN.yellowstone_gnu +PASS ERS_PT.T31_g37.B1850CN.yellowstone_gnu.memleak + +>>more TestStatus +PASS ERS.ne30_g16.B1850C5CN.yellowstone_intel +PASS ERS.ne30_g16.B1850C5CN.yellowstone_intel.memleak + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 OK - 45 OK - component gen comp - OK + yellowstone_pgi - 40 OK - 45 OK - component gen comp - OK + + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + goldbach_pgi - 40 OK - 45 OK + +CLM tag used for the baseline comparisons: clm4_5_73 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_74 +Originator(s): sacks (sacks) +Date: Wed May 28 16:05:36 MDT 2014 +One-line Summary: misc. bfb changes - see detailed summary below + +Purpose of changes: + + (1) Rename fpftdyn to flanduse_timeseries, and make related changes to names + throughout the code. This rename is in preparation for an upcoming tag + where this file will take on more general uses (e.g., transient crop + areas). + + (2) Decrease thresholds for water, snow and energy balance checks (these were + too permissive) + + (3) Move stuff out of clm_varcon into landunit_varcon (for constants specific + to CLM's landunits) and column_varcon (for constants specific to CLM's + columns) - analogous to the existing pftvarcon + + (4) Move some routines out of initGridCellsMod into a new initSubgridMod + + (5) Make time_info a public member of dyn_file_type, which allows removing a + bunch of delegation methods. And rename some things in time_info_type for + clarity. + + (6) Rework metadata for the description of landunit, column and pft types + on the history and restart files, to centralize these descriptions to the + appropriate place in the code. + + (7) Add general-purpose functionality for setting up subgrid structure for + unit tests + + (8) Move unit tests into source tree, rather than being in + test/unit_testers. Now the top-level script is in models/lnd/clm/src. + + (9) Fix baseline comparisons for PTCLM tests + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 1928 (create landunit_varcon.F90 and column_varcon.F90 from parts of clm_varcon.F90) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: fpftdyn renamed to flanduse_timeseries + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: addclm50_n03_ED_scripts_015_140305_rev -> addclm50_n04_ED_scripts_015_140305_rev + - Rename CLM's fpftdyn to flanduse_timeseries in tests; update perl5lib + + tools/unit_testing: unit_testing_0_04 -> unit_testing_0_05 + - the major change here is allowing rebuilds with intel without needing to + specify --clean + + models/lnd/clm/tools/PTCLM: PTCLM2_140423 -> PTCLM2_140521 + - rename fpftdyn -> flanduse_timeseries, and other related renames + +List all files eliminated: + +========= Renamed +D models/lnd/clm/tools/clm4_5/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +D models/lnd/clm/tools/clm4_0/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt + +========= Move unit tests into source tree +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/test_daylength.pf +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarShared.F90 +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeInterp.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeUninterp.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/test_init_columns.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/GetGlobalValuesMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/clm_time_manager_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/do_genf90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90.in +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/mct_mod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/histFileMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/main +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynFileMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid +D models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock +D models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/README +D models/lnd/clm/test/unit_testers/clm4_5 +D models/lnd/clm/test/unit_testers + + +List all files added and what they do: + +========= Renamed +A models/lnd/clm/tools/clm4_5/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt +A models/lnd/clm/tools/clm4_0/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt + +========= Move stuff out of clm_varcon into landunit_varcon (for constants + specific to CLM's landunits) and column_varcon (for constants specific + to CLM's columns) - analogous to the existing pftvarcon. +A models/lnd/clm/src/clm4_5/main/landunit_varcon.F90 +A models/lnd/clm/src/clm4_5/main/column_varcon.F90 + + +========= Move some routines out of initGridCellsMod - these are lower-level + routines that can also be used by unit test code. So initGridCellsMod + contains higher-level stuff that is specific to how the subgrid + structure is set up in a production run; and initSubgridMod contains + lower-level stuff that doesn't know or care how things are actually + set up, conceptually. +A models/lnd/clm/src/clm4_5/main/initSubgridMod.F90 + +========= Add general-purpose functionality for setting up subgrid structure for unit tests +A models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 +A models/lnd/clm/src/unit_test_shr/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr + + +========= Move unit tests into source tree; also modify some unit tests to take + advantage of the new unittestSubgridMod; also add tests of + subgridWeightsMod and clm_glclnd +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test/test_subgridWeights.pf +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test +A models/lnd/clm/src/clm4_5/main/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test/test_clm_glclnd.pf +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test +A models/lnd/clm/src/clm4_5/main/test +A models/lnd/clm/src/clm4_5/biogeophys/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test/test_daylength.pf +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test +A models/lnd/clm/src/clm4_5/biogeophys/test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test +A models/lnd/clm/src/README.unit_testing +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/GetGlobalValuesMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90.in +A models/lnd/clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 + - also add a routine to this mock, needed because of refactor of + dyn_file_type / dyn_time_inof +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/do_genf90 +A models/lnd/clm/src/unit_test_mocks/util_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +A models/lnd/clm/src/unit_test_mocks/util_share +A models/lnd/clm/src/unit_test_mocks/csm_share/shr_sys_mod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/csm_share/mct_mod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/csm_share +A models/lnd/clm/src/unit_test_mocks/main/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/main/histFileMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/main +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid/dynFileMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid +A models/lnd/clm/src/unit_test_mocks/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks +A models/lnd/clm/src/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +========= Renamed fpftdyn -> flanduse_timeseries, and other related changes to + variable names + (NOTE: Some source files are listed both here and elsewhere in the + ChangeLog entry) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/clm4_5/mksurfdata_map/README +M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varctl.F90 +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/clm4_0/mksurfdata_map/README +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml +M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml +M models/lnd/clm/doc/UsersGuide/single_point.xml +M models/lnd/clm/doc/UsersGuide/tools.xml +M models/lnd/clm/doc/UsersGuide/adding_files.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/ptclm.xml +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 +M models/lnd/clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 + +========= Updated PTCLM external to rename fpftdyn -> flanduse_timeseries +M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + +========= Decrease threshold for water & snow balance checks by 3 orders of + magnitude; decrease threshold for energy balance checks by 2 orders of + magnitude +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Separate clm_varcon into clm_varcon, column_varcon and landunit_varcon +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + +========= Move some routines out of initGridCellsMod, into a new initSubgridMod + (see detailed notes above) +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Make time_info a public member of dyn_file_type. This allows us to + remove all methods from dyn_file_type (which were just delegating + responsibility to time_info_type). Also rename some methods and + variables in time_info_type. +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in + - also change intent(in) to intent(inout), fixing a gfortran problem +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 + +========= Rework metadata for the description of landunit, column and pft types + on the history and restart files. Point is to centralize the + definition of these different types as much as possible (rather than, + e.g., having restFileMod know about the translation between landunit + indices and names). For the history file, I am removing the metadata + from the PCT_LANDUNIT long name, instead putting it in global + metadata, as is done for the restart file. +M models/lnd/clm/src/clm4_5/main/subgridWeightsMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 + +========= Change 'use' statements based on my split of clm_varcon into + clm_varcon, landunit_varcon and column_varcon +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4InitMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 + +========= Fix baseline comparisons for PTCLM tests +M models/lnd/clm/test/tools/TSMscript_tools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh + +========= Just changes in whitespace +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/biogeophys/CMakeLists.txt + + +CLM testing: + + Most testing done on dynlu_crops_n01_addclm50bld_n06_clm4_5_72; PTCLM and + tools testing done on dynlu_crops_n03_addclm50bld_n06_clm4_5_72 + + Note that the branch was up-to-date with addclm50bld_n06_clm4_5_72; this is + identical to clm4_5_73 except for a fix to the build-namelist tests (see below) + + build-namelist tests: + + yellowstone: ok + compared against addclm50bld_n06_clm4_5_72 (essentially clm4_5_73) + expected diffs for transient cases + + The following tests also failed when comparing the baseline against + itself (NOTE: this is apparently fixed in clm4_5_73): + + 466/497 < FAIL> + 467/497 < FAIL> + 496/497 < FAIL> + 497/497 < FAIL> + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + goldbach_nag: ok + goldbach_intel: ok + goldbach_pgi: ok + + Most comparisons were done against clm4_5_72. + + These comparisons failed due to a problem with component_gen_comp and the + SSP test; manual comparisons show these to be identical to Erik's tests (for + clm4_5_73): + + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default.GC.0520-2021.45.p.clm2.h0.compare_hist.clm4_5_72 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default.GC.0520-2021.45.p.clm2.h1.compare_hist.clm4_5_72 + + For new tests added in Erik's upcoming tag (clm4_5_73), I did manual + comparisons against Erik's baselines (cpl & clm hist for the yellowstone + tests, just cpl for goldbach tests) - all PASS. + + Note that CLM hist files were NOT compared for any goldbach tests, because + there were no CLM hist file baselines for clm4_5_72. + + tools testing: + + yellowstone interactive: ok + + Compared against addclm50bld_n06_clm4_5_72 (essentially clm4_5_73) + + Failures in the following baseline comparisons, due to changed name of output + file (surfdata.pftdyn -> landuse.timeseries). Manual comparisons showed the + output files to be identical in all cases: + + 010 bl754 TBLtools.sh clm4_0 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 018 bl974 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 040 blfg4 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Global_clm4_5^buildtools ......\c + rc=7 FAIL + + Other than that, all tests & baseline comparisons passed + +CLM tag used for the baseline comparisons: clm4_5_72, except where noted above + +Changes answers relative to baseline: NO - bfb + +=============================================================== +=============================================================== +Tag name: clm4_5_73 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed May 28 15:33:10 MDT 2014 +One-line Summary: Add the stub ability for clm5_0 physics to CLM build system + +Purpose of changes: + +Add phys=clm5_0 as an option to the build. Currently, nothing is different in the code, this just +adds the capability to do clm5_0 as a seperate configuration. The one thing that is different between +clm4_5 and clm5_0 is the setting of urban_hac. + +Fix several issues needed for CAM: problem in DryDeposition (reoccurance of bug 1883, that was fixed and then +unfixed in clm4_5_48), fix for internal compiler errors. CAM has been using the branch version of this +since: cam5_3_29. + +Work on updates for PTCLM. Add some new sites for Rosie and Jinyun. Correct the call to mkmapdata.sh. +Have CLM1PT forcing directory to use DIN_LOC_ROOT_CLMFORC so you can point it to a location seperate +from DIN_LOC_ROOT. Add a new support script to PTCLM to submit a list of sites to batch: PTCLMsublist. +Also allow release_tags in version find. Get buildtools to work on edison/hopper. + +Get tools to work on hopper and edison, and update mapping to use ESMF6.3.0. + +Fix various bugs: internal compiler error on janus, trigger an error if user_datm.streams.txt file is + readonly (rather than hang). Use DIN_LOC_ROOT_CLMFORC for CLM1PT. + +Requirements for tag: Fix bug 1883 and 1985 for Cheryl and CAM, fix PTCLM, add clm5_0, tools on hopper/edison + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1985 Internal compiler error on yellowstone with CLM in CAM standalone build + 1965 Internal compiler error on janus with CLM on janus + 1938 Upgrade mkmapdata to ESMF6.3.0 + 1937 Using a read-only user_datm.streams.txt file causes cesm_setup to hang + 1936 CLM1PT forcing directory needs to use DIN_LOC_ROOT_CLMFORC + 1935 Changes needed to get tools to build on hopper... + 1933 Correct call to mkmapdata.sh in PTCLM + 1925 Add more sites to PTCLM + 1904 check for LSF_PJL_TYPE in regridbatch.sh doesn't work correctly + 1883 uninitialized variable in DryDepVelocity.F90 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add clm5_0 as a new supported physics type + +Describe any changes made to the namelist: Set urban_hac according to physics + clm5_0=ON_WASTEHEAT, and clm4_5=ON + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self (clm_phys perl object reviewed by team: bandre, muszala, sacks) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm + scripts to addclm50_n03_ED_scripts_015_140305_rev + datm to datm8_140312 + csm_share to share3_140418 Use trunk version rather than branch + tools/mapping to mapping_131217a + PTCLM to PTCLM2_140423 + +List all files eliminated: + + D models/lnd/clm/bld/unit_testers/env_run.xml -- This file is now built dynamically when the tester is run. + +List all files added and what they do: + + A models/lnd/clm/bld/query-xFail --- Add a script from Ben Andre to read and report on expected fails. + A models/lnd/clm/bld/env_run.xml --- envxml_dir option is now required, so this provides a env_*.xml + file that can be read by default, when build-namelist is called outside of CESM for testing. + A models/lnd/clm/bld/config_files/clm_phys_vers.pm - Enter physics version as a string i.e.: clm4_0 + and then have the ability to interpret it as different types so you can do logical operations + on physics versions + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/shared/mkmapdata/regridbatch.sh ------- Add ability to run on hopper + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh --------- Add ability to run on hopper/edison + remove jaguarpf, and upgrade to ESMF6.3.0 + M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl - New version of NCL requires + load before "begin" statement + + M models/lnd/clm/bld/configure ------------- Allow phys=clm5_0 and add in new clm_phys_vers object + M models/lnd/clm/bld/README ---------------- Update info on files + M models/lnd/clm/bld/CLMBuildNamelist.pm --- Put list of required options at top of help, and make envxml_dir + a required option. Add in use of clm_phys_vers object. Make sure use_ed_spitfire is only on if use_ed is + on. If CLM_UPDATE_GLC_AREAS=TRUE and phys=clm4_0 trigger an error + M models/lnd/clm/bld/config_files/config_definition_clm4_5.xml - Add all three physics version options + M models/lnd/clm/bld/config_files/config_definition_clm4_0.xml - Add info. about clm4_5/clm5_0 options + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - Add use of clm_phys_vers, and create env_run.xml + on the fly. Also add new tests for glacier update areas, and ED: usespitfireButNOTED, useEDclm40, useEDContradict2 + useEDContradict, clm40andUpdateGlc, clm40andUpdateGlc, UpdateGlcContradict, UpdateGlcNoGLCMe, and tests + for clm5_0 + + M models/lnd/clm/bld/test_build_namelist/t/test_vichydro.pm ----- Needs to use clm_phys_vers object + M models/lnd/clm/bld/test_build_namelist/test_build_namelist.pl - Needs to use clm_phys_vers object + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - urban_hac depends on clm4_5/clm5_0 + +-------------- Add phys=clm5_0 for all use-cases that test on phys + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + +------------- Fix bugs 1883 (rs over lake) and 1983 (CAM internal compiler error) and 1965 +------------- (janus internal compiler error) + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 ----- Set rs over lake + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 -------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/main/restFileMod.F90 -------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 ------ Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 -- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 ----- Add use only for clmtype and dynVarTimeUninterpMod + fixes internal compiler error on janus (1965) + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 ----- Set rs over lake + M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 -------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/subgridRestMod.F90 ----------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/iniTimeConst.F90 ------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/restFileMod.F90 -------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/biogeophys/UrbanInputMod.F90 ------ Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 -- Add use only for ncd_pio + +CLM testing: + + a) regular + b) build_namelist + c) tools + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_72 + +Changes answers relative to baseline: No (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_72 +Originator(s): muszala (Stefan Muszala) +Date: Mon May 5 17:47:52 MDT 2014 +One-line Summary: Introduce code for Ecosystem Demography (CLM(ED)) Model + +Purpose of changes: Introduce code for Ecosystem Demography (CLM(ED)) Model - first functional tag. + +A large chunk of this code was written and re-written by Rosie Fisher. + +"Introduce code for Ecosystem Demography (CLM(ED)) Model. Adds capability to allow plant functional +types to compete for light, to represent recovery from disturbance, and to allow disturbances +(i.e. fire) to only afflict some fraction of the canopy, and to represent vegetation at the scale +of cohorts of trees. Note that this is a large change and includes: + +1. Significant alterations to canopy albedo and surface radiation calculations +2. New photosynthesis scheme, based on existing science but to allow for more complex canopy structure +3. Introduction of a new allocation and growth scheme, (no consistent with that in CLM(CN) +4. Removal, for now, of Nitrogen limitation capabilities +5. Introduction of the SPITFIRE fire model, which interacts with ED via it's representation of + size-structured mortality and removal of litter pools. +6. Introduction of a simple seed bank model to allow persistence of vegetation through fire events. +7. For ED compsets there exists a cohort dimension on the restart files. + +Cold starts and restarts work for the following. The 1x1_brazil is the most heavily tested case both from +science and SE standpoint: + +1x1_brazil.ICLM45CNED.yellowstone_[intel | pgi] +5x5_amazon.ICLM45CNED.yellowstone_[intel | pgi] +1x1_brazil.ICLM45CNED.goldbach_[nag | intel | pgi ] +5x5_amazon.ICLM45CNED.goldbach_[nag | intel | pgi ] + +Cold starts work for: + +f10_f10.ICLM45CNED.yellowstone_[intel | pgi]. +f19_g16.ICLM45CNED.yellowstone_[intel | pgi] + +Code Origins: + +The ED code in CLM is originally based on code by Moorcroft (www.oeb.harvard.edu/faculty/moorcroft/code_and_data/index.html) +and has been heavily modified in regards to both scientific implementation and assumptions. Fom a software engineering +perspective, ED was rewritten from C into F2003 and the structure of the code has been significantly altered to fit into +the CESM/CLM framework. + +The SPITFIRE code is based on (http://www.biogeosciences.net/7/1991/2010/bg-7-1991-2010.pdf) and has been significantly +altered and extended to fit into the CESM/CLM framework. + +Other points: + 1. removed many unused variables and module uses as reported by nag + 2. changing text wrapping on comments so they end at 139 characters + 3. changed many text based logical operators (.ne., .lt., .ge.) with their math. equivlanet (/=, > , <=) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: ED functionality brought in. Does not change existing +configurations. For ED, there are now a CNED and BGCED compset. Use CNED until BGC issues are worked +out. + +Describe any changes made to the namelist: ED functionality brought in. Does not change existing +configurations. For ED compsets, there are two new namelist variables. They are: + +use_ed = .true. +use_ed_spit_fire = .true. + +use_ed_spit_fire is set to true by default if use_ed is on. Unless you are running our ED tests, you will +have to change your user_nl_clm to something like: + +paramfile ='/glade/p/cesmdata/cseg/inputdata/lnd/clm2/edParams/CLMPARAMS_ED_011514.nc' +finidat = '' +hist_mfilt = 365 +hist_nhtfrq = -24 + +hist_empty_htapes = .true. + +hist_fincl1='NPP','GPP','BTRAN','TOTVEGC','H2OSOI','TLAI','LITTER_IN','LITTER_OUT', +'STORVEGC','FIRE_AREA','SCORCH_HEIGHT','FIRE_INTENSITY','FIRE_TFC_ROS','fire_fuel_mef', +'LITTERC','fire_fuel_bulkd','fire_fuel_sav','FIRE_NESTEROV_INDEX','PFTbiomass', +'PFTleafbiomass','FIRE_ROS','WIND','TFC_ROS','DISPVEGC','AREA_TREES','AREA_PLANT' + +If on goldbach, use: + +paramfile ='/fs/cgd/csm/inputdata/lnd/clm2/edParams/CLMPARAMS_ED_011514.nc' + +List any changes to the defaults for the boundary datasets: N/A. + +Describe any substantial timing or memory changes: + +Code reviewed by: Stefan Muszala and Rosie Fisher. Detailed code review by Bill Sacks, Mariana Vertenstein, +Ben Andre, and Erik Kluzek. Discussion of code review included Dave Lawrence, Forrest Hoffmann +and Ryan Knox. + +List any svn externals directories updated (csm_share, mct, etc.): + +Changed externals to a branch_tag that supports ED compsets. We are using branch_tags because trunk +scripts does not work with all of the current CLM tests: + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/add_dynlu_tests_tags/add_dynlu_tests_n03_scripts4_140305 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/ED_scripts_tags/ED_scripts_015_140305_rev + +List all files eliminated: N/A + +List all files added and what they do: + +### SPITFIRE code +# new SPITEFIRE directory +A + models/lnd/clm/src/clm4_5/main/spitfireSF +# main SPITFIRE code +A + models/lnd/clm/src/clm4_5/main/spitfireSF/SFParamsMod.F90 +# handle SPITFIRE parameters +A + models/lnd/clm/src/clm4_5/main/spitfireSF/SFMainMod.F90 + +# pull out, move to a shared location, place in own module +A + models/lnd/clm/src/util_share/quadraticMod.F90 + +### new source and directories for ED +## ED code required for biogeophysics +# ED directory in biogeophys +A + models/lnd/clm/src/clm4_5/biogeophys/ED +# Calculates daily carbon flux drivers from hourly calculations. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDAccumulateFluxesMod.F90 +# Calculates absorbed, reflected and transmitted radiation in diffuse and direct streams for +# each of the canopy layer x PFT x leaf layer three-dimensional matrix. Uses iterative Norman +# radiation transfer scheme. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDSurfaceAlbedoMod.F90 +# Main photosynthesis model. Calculates leaf level fluxes on a canopy layer x PFT x leaf layer +# three-dimensional matrix. Sums to canopy to produce overall canopy conductance. Unpacks leaf- +# level fluxes into cohort level fluxes. Uses same scientific assumptions as CLM4.5. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 +# Generates PFT specific BTRAN vector for each ED patch. Includes option for SPA-like calculations. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDBtranMod.F90 + +## ED code required for biogeochemistry +# ED directory in biogeochem +A + models/lnd/clm/src/clm4_5/biogeochem/ED +# Determines which cohorts are in the upper and lower canopy layers. Sets leaf area index inputs to biogeophysics calculations. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDCanopyStructureMod.F90 +# Initializes some ED-specific variables to zero at startup. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDSetValuesMod.F90 +# Contains allometric relationships between vegetation properties (height, dbh, LAI, dead biomass, live biomass, crown area) biogeochem/ED/EDPatchDynamicsMod.F90 : Creates patches, fuses similar patches, controls disturbance and generation of area. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDGrowthFunctionsMod.F90 +# Creates, fuses, terminates, sorts, counts and copies cohort structures. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDCohortDynamicsMod.F90 +# Contains all calculations of derivatives of biomass, litter and seed pools. Also includes phenology model, seed and litter production and decay models, and canopy optimization model. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDPhysiologyMod.F90 +# Creates, fuses, terminates, sorts, counts and copies patch structures. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDPatchDynamicsMod.F90 + +## ED core functionality and types that interact with CLM (generally not science) +# ED directory in main +A + models/lnd/clm/src/clm4_5/main/ED +# Transmits required information for CLM (tlai, htop, tile weights). Updates ED-specific history field variables. +A + models/lnd/clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +# Initializes ED PFT parameter structure. +A + models/lnd/clm/src/clm4_5/main/ED/EDInitTimeConst.F90 +# Contains ED-specific variables for CLM +A + models/lnd/clm/src/clm4_5/main/ED/EDClmType.F90 +# Adds history field variables specific to ED to history file. +A + models/lnd/clm/src/clm4_5/main/ED/EDHistFldsMod.F90 +# Prints out and reads in ED state vector to/from history files. +A + models/lnd/clm/src/clm4_5/main/ED/EDRestVectorMod.F90 +# Initializes ED-specific variables for CLM +A + models/lnd/clm/src/clm4_5/main/ED/EDClmTypeInitMod.F90 +# Allocates ED PFT specific variables. +A + models/lnd/clm/src/clm4_5/main/ED/EDPftvarcon.F90 +# Initializes ED site, patch and cohort structures, either to restarting or bare ground values. +A + models/lnd/clm/src/clm4_5/main/ED/EDInitMod.F90 +# Allocates and initializes ED parameters (that are not PFT specific). +A + models/lnd/clm/src/clm4_5/main/ED/EDParamsMod.F90 +# Main ED model routine. Calls all other daily ED dynamics, integrates variables, checks carbon balance. +A + models/lnd/clm/src/clm4_5/main/ED/EDMainMod.F90 +# Contains ED type structures (cohort, site, patch) and static values. +A + models/lnd/clm/src/clm4_5/main/ED/EDTypesMod.F90 + +# utility routine to help in reading parameter files +A + models/lnd/clm/src/clm4_5/main/paramUtilMod.F90 +# transfers weights calculated internally by ED into wtcol. +A + models/lnd/clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 + +List all existing files that have been modified, and describe the changes: + +### build modifications +# add ED source directories for build +M models/lnd/clm/bld/configure +# build namelist additions for ED +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +# setup_cmdl_ed_mode addition. sets namelist vars +M models/lnd/clm/bld/CLMBuildNamelist.pm + +### util_share modifications +# add function is_beg_curr_day() +M models/lnd/clm/src/util_share/clm_time_manager.F90 +# modify get_proc_bounds to include beg, end cohort +M models/lnd/clm/src/util_share/accumulMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/util_share/ncdio_pio.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +### 4_5 Modifications +# change text based logical with math style (.gt. to >, .ne. to /=) +# modify get_proc_bounds to include beg, end cohort +M models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +# move some variables from stack to heap. +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 + +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initInterp.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +# add call to call EDInitTimeConst +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 +# add decomposition for cohort dimension +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +# add call for ed_init +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +# add code for cohort dimension +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +# add use_ed logical to support cohort dimension +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +# broadcast ed namelist variables +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +# use_ed logical to call edmodel +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +# clean up unsued variables from nag compiler warnings +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +# add routine set_cohort_decomp +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +# change spacing, text wrapping +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +# add support for cohort dimension +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +# add call to read ED and SPITFIRE params +R + models/lnd/clm/src/clm4_5/main/readParamsMod.F90 +# add routine set_cohort_decomp +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +# change spacing, text wrapping +# add use_ed logical(s) +# calculate ed root fractionation +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +# add use_ed logical(s) for forc_solai and parsun +# use_ed reporting +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +# add use_ed logical(s) for norman_radiation +# change spacing +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +# remove unused variable +M models/lnd/clm/src/clm4_5/biogeophys/SLakeCon.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +# add use_ed logical(s) for call dyn_ED +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +### 4_0 Modifications +# add optional cohort argument for new ED dimension to get_proc_global and +# get_proc_bounds_old for 40 backward compatibility +M models/lnd/clm/src/clm4_0/main/decompMod.F90 + +CLM testing: + +--SNICARFRC - moved ERI_D.T31_g37.ICLM45.goldbach_nag.clm-SNICARFRC to goldbach and nag. This is a BFAIL. + +--Testing for new ED compsets. All compare hist portions were BFAIL's since this is the first time +the tests are being put in place. + +--ED and yellowstone [ intel | pgi ] + PASS ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS.f10_f10.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS.f19_g16.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + +--ED and goldbach [nag | intel | pgi ] + PASS ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_[nag | intel | pgi ].clm-edTestGb + PASS SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_[nag | intel | pgi ].clm-edTestGb + +--CLM history file comparison: + +yellowstone [intel | pgi] - OK + +I ran without the -model_gen_comp option, but ran component_gen_comp and summarize_cprnc_diffs +by hand for both yellowstone_intel and yellowstone_pgi. These are both OK + +--Regular tests (aux_clm testlist) + + yellowstone_intel - OK + yellowstone_pgi - OK + goldbach_nag - OK + goldbach_intel - OK + goldbach_pgi - OK + +CLM tag used for the baseline comparisons: clm4_5_71 + +Changes answers relative to baseline: No. Existing compsets do not change. +If you run with an *ED* compset, then results will differ, but that is expected. + +=============================================================== +=============================================================== +Tag name: clm4_5_71 +Originator(s): Bill Sacks & Jeremy Fyke +Date: Fri May 2 13:00:10 MDT 2014 +One-line Summary: 2-way feedbacks for glacier, veg columns compute glacier SMB, and related changes + +Purpose of changes: + + (1) Bring in two-way feedbacks for glacier when coupled to CISM, via dynamic + landunits, so that CLM's glacier area remains consistent with CISM's + glacier area. Also update CLM's glacier topography to be consistent with + CISM. + + (2) Add an elevation class "0", which provides surface mass balance over the + vegetated portion of the grid cell. This is used to achieve glacial + inception in CISM. Along with this change, also (a) set the topographic + height of non-glacier areas based on bare land topography from CISM, and + (b) change the downscaling of atmospheric fields so that they are also + downscaled over vegetated columns within CISM's ice mask, to achieve + greater consistency between what's happening in the glacier and vegetated + portions of CISM's domain. (Note that, because longwave radiation is + normalized, downscaling it over the vegetated column also changes answers + over glacier columns.) These changes were primarily from Jeremy Fyke. + + (3) Rework some consistency checks to play nicely with dynamic landunits. + + (4) Rework unit test build to use libraries for the clm source and csm_share source + + (5) Misc. other changes, as noted below. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 1969 (incorrect values for QSNWCPICE_NODYNLNDUSE) + - 1929 (dynFileMod breaks with gfortran 4.8) + - 1832 (logic for weights error check differs between clm4.0 and clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +========= Add tests +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140305 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/add_dynlu_tests_tags/add_dynlu_tests_n03_scripts4_140305 + +========= Pull in Machines_140318, needed for goldbach +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_01_mach140218 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_02_mach140218 + +========= Changes needed for elevation class 0, etc. +-models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_07 ++models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_10 +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140416 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140501 + + +List all files eliminated: + +========= Point to real decompMod rather than mock +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/decompMod_boundsTypeDecl.F90 + +List all files added and what they do: + +========= Most of reweightMod.F90 moved here; also includes the following changes: + (1) renames some subroutines + (2) adds some diagnostic fields that are written to the history file + (3) adds some utility routines such as get_landunit_weight +A models/lnd/clm/src/clm4_5/main/subgridWeightsMod.F90 + +========= Add code to initialize newly-active columns +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 + +========= New unit tests +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/test_init_columns.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test + +========= Need new mocks and new real files now that we use the real decompMod, and also because of endrun calls +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/GetGlobalValuesMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/mct_mod_mock.F90 +A models/lnd/clm/src/util_share/CMakeLists.txt + +========= Need stub histFileMod now that many modules include calls to hist_addfld +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/histFileMod_mock.F90 + +List all existing files that have been modified, and describe the changes: + +========= Update glacier cover and topographic heights based on values from CISM; rework + code to accommodate icemask and elevation class 0 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 + +========= Change to be consistent with clm4_5 version, adding elevation class 0 and + x2s%icemask (neither of which are used in the clm4_0 version) +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 + +========= Add glc_do_dynglacier namelist option, which triggers off of + CLM_UPDATE_GLC_AREAS; rename glc_dyntopo to glc_dyn_runoff_routing and make it + also trigger off of CLM_UPDATE_GLC_AREAS; add glc_snow_persistence_max_days; add + dynpft_consistency_checks and finidat_consistency_checks groups +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/env_run.xml +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + - also use parameter for file name length, so that other modules can + ensure consistency of char length + +========= Add functions to convert between col%itype and icemec class; also add + landunit_names vector +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +========= Add functions add_landunit, add_column, add_patch (cleans up this code, and will + assist with setting up unit tests) and use new functions from clm_varcon +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Use new functions from initGridCellsMod +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 + +========= Remove old consistency checks for restart file, add new ones (these changes are + needed so that consistency checks work right with dynamic landunits, and we're + adding some new consistency checks that weren't in place before) +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + - also read all subgrid weights and glc topo on restart + (some of these used to be read in BiogeophysRestMod; + we need all of them with dynamic landunits) + - also remove redundant mcdate, mcsec + - also add icemask restart variable +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + - also remove redundant PFT_WTGCELL, PFT_WTLUNIT, PFT_WTCOL + (equivalent variables are already output by subgridRestMod) + - also add snow_persistence + +========= Remove old consistency checks for pftdyn file, add new ones + (these changes are needed so that consistency checks work right with dynamic landunits) +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + - also call init_subgrid_weights_mod, put call to update_clm_s2x in + loop over clumps, and move deallocation of topo_glc_mec to later +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 + +========= Add new dimensions for multi-level fields - for subgrid weight diagnostics; add + a dimension to accommodate fields dimensioned by glc_nec+1 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +========= Call new routines (update_clm_x2s, set_subgrid_diagnostic_fields, initialize_new_columns) +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Make various code operate over veg as well as icemec columns +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also put call to update_clm_s2x in a loop over clumps +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 + - also compute snow_persistence, and rework some code for clarity + +========= Add initialization of icemask & snow_persistence; change + initialization of glc_topo and h2osno +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 + +========= Add l2g_scale_type = natveg +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + +========= Fix QSNWCPICE_NODYNLNDUSE, add l2g_scale_type for QICE & related fields, add + SNOW_PERSISTENCE and ICE_MASK, change _FORC fields to include elevation class 0 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +========= Get rid of associate statement that caused problems with some compilers +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 + +========= Track old col%active values, needed for initializing new columns +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 + +========= Moved most functionality to subgridWeightsMod.F90 (now just a small + wrapper to some of the stuff in subgridWeightsMod, whose main purpose + is to avoid a dependency of subgridWeightsMod on filterMod) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Changes for unit tests: + (1) Update unit tests to use libraries for the clm source and csm_share source + (2) New unit test + (3) Make unit tests work with latest CLM trunk + (4) Point to real decompMod rather than mock +M models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt + +========= Add icemask & snow_persistence; remove unused glc_frac, glc_rofi & glc_rofl +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +========= Minor changes to 'use' statements for the sake of breaking dependencies for unit tests +M models/lnd/clm/src/util_share/GetGlobalValuesMod.F90 +M models/lnd/clm/src/clm4_5/main/decompMod.F90 + +========= Changes to comments only +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/util_share/domainMod.F90 + +========= Remove no-longer-failing test, change failType of a test (it was RUN + rather than FAIL at least as far back as clm4_5_69) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + regular tests + + NOTE: Most tests were done on bare_land_smb_n15_clm4_5_70, which did NOT + include r59820 (add a comma in histFileMod to fix a syntax error caught by + nag). After r59820, reran all goldbach_nag tests, plus one goldbach_pgi and + one goldbach_intel. + + yellowstone_intel: ok + yellowstone_pgi: ok + goldbach_nag: ok + goldbach_intel: ok + goldbach_pgi: ok + + component_gen_comp on yellowstone_intel & yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_69 (clm4_5_68 for a few tests + with missing baselines in clm4_5_69) + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All IG compsets (i.e., GLC compsets) + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + New Climate + + Changes are: + + (1) All IG compsets (clm4.0 & clm4.5) change due to new CISM external + + (2) In addition, IG compsets with CLM4.5 change further due to: + (a) 2-way feedbacks (CLM updated to match CISM) + (b) downscaling done over vegetated landunits within the icemask + + (3) Also, the QSNWCPICE_NODYNLNDUSE history diagnostic field changes for + ALL CLM4.5 runs, due to fixing bug 1969. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_70 +Originator(s): muszala (Stefan Muszala) +Date: Fri Apr 18 08:24:44 MDT 2014 +One-line Summary: bring in SHR_ASSERT macros + +Purpose of changes: bring in SHR_ASSERT macros for Santos. + +Add: #include "shr_assert.h" to source files +Remove: use shr_assert_mod , only : shr_assert + +then replace "call shr_assert" with SHR_ASSERT_ALL when asserting more than one dim + +- call shr_assert((ubound(carr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) ++ SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + +and use SHR_ASSERT when asserting one dimen + +- call shr_assert(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) ++ SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Self, Santos, Sacks + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_140218 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_01_mach140218 + +-scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140109 ++scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140403 + +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_37 + +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140303 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140416 + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_131231 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/shr_assert_macro_tags/shr_assert_macro_n04_share3_140115 + +-models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n03_MCT_2.8.3 ++models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n04_MCT_2.8.3 + +-models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_9/pio ++models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_11/pio + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/DaylengthMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 + +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + +Tested with two sets of externals because: + +The old scripts do not allow any PGI tests to run while the new scripts have various issues +with ERI tests and selected PGI tests plus nag debug runs (fixed in a more recent machines tag). + +By running with two sets of externals, I am confident that the source mods for SHR_ASSERT are +working correctly. When CLM gets updates in scripts and machines, these will be updated in +later tags. + +I) Those included in this tag +II) Those that are a part of cesm1_3_alpha09b (only tested clm45). + + build-namelist tests: N/A + + regular tests: for (I) above: + + yellowstone_intel - OK - component_comp_gen - OK + goldbach_nag - OK + goldbach_intel - OK + + regular tests: for (II) above: + +1) Yellowstone + Intel : all ERI tests are completing ref1 and ref2 but die a silent death in the base case. Erik looks like you changed Testlists, so the two VIC tests might be expected. + +>>./cs.status.70Intel.yellowstone | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay | grep -v ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay | grep -v ERS_Ld211_D_P112x1.f10_f10.ICNCROP +RUN ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI.f10_f10.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI.f19_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.T31_g37.ICLM45.yellowstone_intel.clm-SNICARFRC.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f19_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +FAIL ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel.compare_hist.clm4_5_69 + 69 Comparing hist file with baseline hist file, /glade/scratch/muszala/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel/run/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel.cpl.hi.0001-01-12-00000 .nc /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_69/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay/cpl.hi.nc + 70 ncdump1 done + 71 ncdump2 done + 72 comparing split files x[a-z][a-z] + 73 xaa + 74 6979,6981c6979,6981 < 0.983149585541109, 0.972017300931466, 0.972017300784614, < 0.972017300929172, 0.964088275988772, 0.971373805810303, < 0.977583443108289, 0.983149585551217, 0.983149585568791, --- + 75 FAIL + 76 hist file comparison is FAIL +FAIL SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default.GC.70Intel.compare_hist.clm4_5_69 + 60 /glade/u/spooldir/1397689222.575650.shell: Storing new baseline in /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_70/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default + 61 Comparing hist file with baseline hist file, /glade/scratch/muszala/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default.GC.70Intel/run/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm- default.GC.70Intel.cpl.hi.0001-01-06-00000.n c /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_69/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default/cpl.hi.nc + 62 ncdump1 done + 63 ncdump2 done + 64 comparing split files x[a-z][a-z] + 65 xad + 66 18300c18300 < 0.983410370293909, 0.984052369383093, 0.979227772964994, --- > 0.983410370293909, 0.984052369383093, 0.979228345951215, 18341,18350c18341,18350 + 67 FAIL + 68 hist file comparison is FAIL + +2) Goldbach + NAG seems to have passed OK, _D runs have failed as expected. The reporting is messed up...ie., TestStatus.out look OK, but TestStatus does not. + +>> ./cs.status.70nag.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v _D +FAIL ERI.f10_f10.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag +--look at /scratch/cluster/muszala/tests/ERI.f10_f10.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag/TestStatus.out and there is no FAIL +FAIL ERI.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag +--/scratch/cluster/muszala/tests/ERI.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag and there is no FAIL + +3) Goldbach + Intel - these look all like passes to me: see /scratch/cluster/muszala/tests/*/TestStatus.out + +>> ./cs.status.70intel.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp +FAIL ERI.f10_f10.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI.f19_g16.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.T31_g37.I1850CLM45.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f10_f10.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f19_g16.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out + +4) Goldbach + PGI - some are indicating FAIL with TestStatus.out shows PASSes, others are straight out FAILs + +./cs.status.70pgi.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_pgi +FAIL ERI.f10_f10.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI.f19_g16.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 22 g005.cgd.ucar.edu - daemon did not report back when launched + 23 g006.cgd.ucar.edu - daemon did not report back when launched + 24 g009.cgd.ucar.edu - daemon did not report back when launched + 25 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory +FAIL ERI_D.f10_f10.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f19_g16.ICLM45.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 1 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 2 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 3 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 4 -------------------------------------------------------------------------- + 5 A daemon (pid 29755) died unexpectedly with status 127 while attempting +FAIL ERI_D.f19_g16.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 23 g021.cgd.ucar.edu - daemon did not report back when launched + 24 g022.cgd.ucar.edu - daemon did not report back when launched + 25 g023.cgd.ucar.edu - daemon did not report back when launched + 26 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory +FAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.goldbach_pgi.clm-decStart.GC.70pgi +-- ERROR in /var/spool/torque/mom_priv/jobs/19500.goldbach.cgd.ucar.edu.SC: file /fs/cgd/csm/ccsm_baselines/clm4_5_69/SMS_Ld5.f19_g16.IRCP45CLM45BGC.goldbach_pgi.clm-decStart/cpl.hi.nc does not exist + +CLM tag used for the baseline comparisons: clm4_5_69 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_69 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Tue Mar 18 21:12:34 MDT 2014 +One-line Summary: start unit testing build-namelist + +Purpose of changes: start doing unit testing on construction of the clm namelist. +This involved moving the contents of build-namelist into CLMBuildNamelist.pm and +bringing in perl infrastructure to supplement Test::More. Initial test suites are +implented for several name list variables. + +Requirements for tag: N/A + +Test level of tag: regular, build_namelist + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, clm-cmt + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + + models/lnd/clm/bld: + CLMBuildNamelist.pm - contents of build-namelist + test_build_namelist/perl5lib/* - CPAN modules needed for unit testing + test_build_namelist/t/input/* - mock input files for build-namelist tests + test_build_namelist/t/template_test_XXX.pm - template for new tests + test_build_namelist/t/test_*.pm - unit tests + test_build_namelist/test_build_namelist.pl - unit test driver + test_build_namelist/README + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/bld: + build-namelist - moved contents into CLMBuildNamelist.pm, now just a driver calling main function. + + +CLM testing: + + build-namelist tests: + + yellowstone - OK new and existing generate tests + goldbach - OK new and existing generate tests + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + goldbach_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: N/A + + short tests (aux_clm_short): + + yellowstone_intel - OK + yellowstone_pgi - OK + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_68 + +Changes answers relative to baseline: No + + +=============================================================== +=============================================================== +Tag name: clm4_5_68 +Originator(s): erik (Erik) +Date: Fri Mar 7 16:43:23 MST 2014 +One-line Summary: Update scripts to version that turns on transient CO2 streams for + transient compsets, and update CISM (changes answers) + +Purpose of changes: + +Bring in the scripts version that by default had transient CO2 for any transient +compsets. You can still turn it off by setting DATM_CO2_TSERIES=FALSE in env_run.xml. +Also bring in the latest CISM version that has answer changes for any IG compsets. +It fixes fields sent from CISM to the coupler (fixes an exact restart problem). + +Requirements for tag: + update scripts and CISM, transient and IG compsets have different answers + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 979 (adding CO2 streams) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + scripts to scripts4_140305 + cism to cism1_140303 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: None + +CLM testing: + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_pgi yes + goldbach_intel yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel yes + yellowstone_pgi yes + + tools testing: None + +CLM tag used for the baseline comparisons: clm4_5_67 + +Changes answers relative to baseline: Yes! + + Summarize any changes to answers: + - what code configurations: transient and IG compsets + - what platforms/compilers: all + - nature of change: larger than roundoff + +=============================================================== +=============================================================== +Tag name: clm4_5_67 +Originator(s): mvertens +Date: Thu Mar 6 16:53:23 MST 2014 +One-line Summary: removed initSurfAlb as part of the initialization + +Purpose of changes: removed the call to initSurfAlb as well as part of + the initialization and also removed the routine from the clm4.5 + code base + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +M bld/namelist_files/namelist_defaults_clm4_5.xml + - clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c140111.nc had not + in fact been created - this effected the PEM test in the goldbach clm45 test suite + - the default namelist has not been backed up to the original + clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c131028.nc + for now + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M src/clm4_5/biogeochem/ch4InitMod.F90 + - removal of code block that is no longer needed due to removal of initSurfAlb + (this had already been commented out in clm4_5_66) + +M src/clm4_5/main/initInterp.F90 + - minor bug fix the turn off spval by default for nonactive points + +D src/clm4_5/main/initSurfAlbMod.F90 +M src/clm4_5/main/clm_initializeMod.F90 + - removal of call initSurfAlb (main purpose of this tag) + - removal of code to upgrade old initial data files to have new metadata + a new scheme should be put in place with a namelist option to take clm4.5 + restart datasets that have been created prior to the introduction of initInterp + and introduce the new metadata at run time + +M src/clm4_5/main/initColdMod.F90 + - had to introduce setting values for the following variables in order to remove + call to initSurfAlb + cps%albgrd_pur(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_pur(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_bc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_bc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_oc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_oc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_dst(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_dst(bounds%begc:bounds%endc,:) = 0.2_r8 + +M src/clm4_5/main/clm_driver.F90 + - just comments + +CLM testing: + + regular tests (aux_clm): OK means only failures were expected + + yellowstone_intel : OK + yellowstone_pgi : OK + goldbach_nag : OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi : OK + +CLM tag used for the baseline comparisons: clm4_5_66 + +Changes answers relative to baseline: some - for all compsets where + finidat is set to blank, then answers will change relative to baseline + + for all compsets wehre finidat is pointing to a dataset, answers will be bfb + compared to baseline + +=============================================================== +=============================================================== +Tag name: clm4_5_66 +Originator(s): mvertens +Date: Mon Mar 3 10:50:24 MST 2014 +One-line Summary: refactoring of initialization and introduction of run-time finidat interpolation + +Purpose of changes: refactoring of initialization and introduction of run-time finidat interpolation + +Completely rewrote clm_initialize to leverage new initialization scheme +In the new scheme, cold start initialization is ALWAYS called and values +are overwritten by either an appropriate finidat file OR by calling +finidat_interp to interplate finidat to the output resolution/mask. + +Requirements for tag: + +Test level of tag: regular, short, tools, build_namelist, doc + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + + 1930 (MEGAN does not work correctly with prognostic crops on) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + NONE + +Describe any changes made to the namelist: + + - ALL clm4.5 finidat files have been updated to contain new metadata that will enable the + online interpinic to operate on them. The time stamp on all new files has the date c140111. + The files have been created so that they are bit-for-bit compatible with the code base. + - The following new namelist variables have been added to the namelist_definition_clm4_5.xml file + - finidat_interp_source + if non-blank, then interpinic will be called to interpolate finidat_interp_source and + create output file specified by finidat_interp_dest. + - finidat_interp_dest + if finidat_interp_source is set to non-blank, then interpinic will be called + to interpolate finidat_interp_source and create output file finidat_interp_dest + +List any changes to the defaults for the boundary datasets: + + None + +Describe any substantial timing or memory changes: + + None + +Code reviewed by: + + mvertens, sacks + +List any svn externals directories updated (csm_share, mct, etc.): + + None + +List all files eliminated: + + The following file pairs were renamed and subsequently extensively modfified + Summaries of the modifications are below: + + ------- New module initColdMod.F90 contains calls to initialize the cold start for + ------- the entire model. The cold start values are then overwritten with either + ------- an finidat file or an interpolation file using finidat_interp_source. +D models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +A models/lnd/clm/src/clm4_5/main/initColdMod.F90 + + ------- Renamed file +D models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 + + ------- Renamed file +D models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/CNDVInitMod.F90 + + ------- Renamed file, removed initch4, merged routines initTimeConst_ch4 and makearbinit_ch4 + --------into new routine initColdCH4.Also removed almost all associate statements + ------- (but kept the intput/output documentation) and used the explicit clmtype definition. +D models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/ch4InitMod.F90 + + ------- Renamed and combined files + ------- Migrated all CN cold start initialization for both soil and + ------- special landuntis into new routine initColdCN in new module biogeochem/CNInitMod. +D models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +D models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +A models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 + + ------- Renamed file and merged routines makearbinit and snow_depth2Lake + ------- into one new routine initColdSlake. Also removed almost all associate + ------- statements (but kept the intput/output documentation) and used the explict + ------- clmtype definition. +A models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +D models/lnd/clm/src/clm4_5/biogeophys/initSlakeMod.F90 + + ------- Renamed iniTimeConst, removed associate statements but kept + ------- the documentation of input/output and also explictly listed + ------- full clmtype variables +D models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +A models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 + +List all files added and what they do: + + ------- New run-time interpolation of input finidat to target resolution/mask + ------- using the new namelist variables finidat_interp_source and finidat_interp_dest +A models/lnd/clm/src/clm4_5/main/initInterp.F90 + + ------- Obtain/write global index space value for target point at given clmlevel +A models/lnd/clm/src/util_share/GetGlobalValuesMod.F90 + +List all existing files that have been modified, and describe the changes: + + ------- In all files, unless otherwise noted added call to errMsg(__FILE__,__LINE__) + ------- and in some cases optional arguments of decomp_index and clmlevel also added + + ------- See documentation for namelist changes above +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + + ------ Overloaded endrun subroutine to also print out global index infromation by + ------ calling new GetGlobalWrite routine if optional arguments decomp_index and + ------ clm_level are passed in +M models/lnd/clm/src/util_share/abortutils.F90 + + ------- Replaced missing value setting of huge(1) with ispval +M models/lnd/clm/src/util_share/accumulMod.F90 + + ------- Replaced endrun with call to shr_sys_abort +M models/lnd/clm/src/util_share/domainMod.F90 + + ------- Added in missing values and special values for variable metadata - this + ------- is needed needed by initInterp +M models/lnd/clm/src/util_share/restUtilMod.F90 +M models/lnd/clm/src/util_share/restUtilMod.F90.in + + ------- Completely rewrote clm_initialize to leverage new initialization scheme + ------- In the new scheme, cold start initialization is ALWAYS called and values + ------- are overwritten by either an appropriate finidat file OR by calling + ------- finidat_interp to interplate finidat to the output resolution/mask. +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + + ------- Added new metadata and variables - include global indices for parent subgrid + ------- level(s) (i.e. column, landunit and gridcell for pfts) +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + + ------- Moved view_factor routine and associated variable from a separate routine + ------- in UrbanMod to part of the initTimeConstUrban subroutine in UrbanInitMod +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + + ------- Removed vf_xx variables from restart file and also + ------- removed do_initsurfalb variable +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + + ------- In all files, unless otherwise noted added call to errMsg(__FILE__,__LINE__) + ------- and in some cases optional arguments of decomp_index and clmlevel also added +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/ndepStreamMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in + +CLM testing: + + regular tests (aux_clm): + + NOTE1: that all namelists compares where finidat was not blank will fail - since + new finidat files are used that have new metadata - BUT - the results are still bfb + + yellowstone_intel - OK + expected failures: + ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + + yellowstone_pgi - OK + expected failures: + ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + goldbach_nag - OK + + goldbach_intel - OK + + goldbach_pgi - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + NOTE1: all .h1 tests fail since there are new meta data fields for + cols1d_active, pfts1d_active - and FILLDIFF is different + + yellowstone_intel OK + yellowstone_pgi OK + +CLM tag used for the baseline comparisons: clm4_5_65 + +Changes answers relative to baseline: No - bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_65 +Originator(s): mvertens (Mariana Vertenstein,UCAR/CSEG,303-497-1349) +Date: Tue Feb 25 13:45:38 MST 2014 +One-line Summary: Turn off MEGAN vocs when crops is running + +Purpose of changes: + +MEGAN does not currently work with prognostic crops. It needs a table of pft-specific values, and that this table has only been created for the 16 "standard" (non-crop) pfts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1930 (MEGAN does not work correctly with prognostic crops on) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.):s + +scripts4_140214a -> scripts4_140220 +Machines_140214 -> Machines_140218 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +======== + Add a new logical variable - use_voc - that is true by default but + is set to false if prognostic cop is activated +======== + +M src/clm4_5/main/clm_initializeMod.F90 +M src/clm4_5/main/clm_atmlnd.F90 +M src/clm4_5/main/controlMod.F90 +M src/clm4_5/main/clm_varctl.F90 +M src/clm4_5/main/clm_driver.F90 +M src/clm4_5/main/histFldsMod.F90 +M src/clm4_0/main/clm_varctl.F90 +M src/cpl/clm_cpl_indices.F90 + + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + expected failures + ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + expected non-bfb failures due to VIC/CROP changes + ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default + ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel + SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel + + yellowstone_pgi - OK + expected failures + ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + goldbach_nag - OK + expected non-bfb failures due to VIC/CROP changes + ERS_D.f10_f10.ICLM45BGCCROP.goldbach_nag.clm-allActive + ERS_Lm3.1x1_numaIA.ICLM45BGCCROP.goldbach_nag + + goldbach_intel - OK + expected non-bfb failures due to VIC/CROP changes + ERS_Ly20.1x1_numaIA.ICLM45BGCDVCROP.goldbach_intel.clm-crop + PEM.f10_f10.ICLM45BGCCROP.goldbach_intel.clm-crop + + goldbach_pgi - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK - + yellowstone_pgi - OK + +CLM tag used for the baseline comparisons: clm4_5_64 + +Changes answers relative to baseline: No - except for VOC fields when + prognostic crop is on (this is a diagnostic only and does not impact + the answers) + +=============================================================== +=============================================================== +Tag name: clm4_5_64 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Wed Feb 19 09:19:40 MST 2014 +One-line Summary: fix and clean ncdio_pio.F90.in. clean clm_time_manager. update externals. + +Purpose of changes: + +Note 1: This is the last tag that is tested on frankfurt; new tests are on goldbach. + +Note 2: Pts. mode is being deprecated for science use as of this tag. Use PTCLM. Pts. mode + remains in place in our test system. + +Note 3: There is an unresolved problem with higher resolutions when dov2xy is .false. and we are + using pnetcdf. Please see bug 1730. + +ncdio_pio.F90.in - fix initialization problem where count and start are sometimes used without + being set. +clm_time_manager - clean out unused variables +update externals to support ED compsets, move pts. mode tests to testmods. Update Machines and + pio to address bug 1730. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.):s + +scripts4_140209 -> scripts4_140214a +Machines_140213 -> Machines_140214 +pio1_8_8 -> pio1_8_9 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.I.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS.f45_f45.I.yellowstone_intel.clm-ptsROA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + Expected due to change in pio_buffer_size_limit + FAIL ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.64Intel.nlcomp + FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.64Intel.nlcomp + New Failure for VIC but due to dov2xy problem + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + + yellowstone_pgi - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.I.yellowstone_pgi.clm-ptsRLB.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLA.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLA.GC.64Pgi.compare_hist.clm4_5_63 + Expected due to change in pio_buffer_size_limit + FAIL ERI.f09_g16.I1850CRUCLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERI.f09_g16.ICLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERS_D.hcru_hcru.ICRUCLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERS_D.hcru_hcru.ICRUCN.yellowstone_pgi.GC.64Pgi.nlcomp + New Failure for VIC but due to dov2xy problem + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + frankfurt_nag - OK + Expected due to change in pts. mode: + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + BFAIL SMS_Mmpich.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + + frankfurt_intel - OK + + frankfurt_pgi - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.ICLM45.frankfurt_pgi.clm-ptsRLB.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS.f45_f45.ICLM45.frankfurt_pgi.clm-ptsROA.GC.64Pgi.compare_hist.clm4_5_63 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_63 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_63 +Originator(s): sacks (sacks) +Date: Fri Feb 14 07:22:37 MST 2014 +One-line Summary: add some code needed for dynamic landunits; activate 0-weight veg landunit sometimes + +Purpose of changes: + +(1) Add grc%landunit_indices(:,:), so you can find a given l index if you have + the g index (this will be needed in a few places for dynamic landunits) + +(2) Add code to update landunit weights; currently has no effect because + landunit areas don't change yet + +(3) Refactor logic in the is_active_X routines, and add logic to activate a + virtual vegetated landunit under some conditions (needed for coupling with + CISM, and helpful for dynamic landunits). Specifically, we activate a + virtual (0-weight) vegetated landunit for any grid cell that is NOT 100% + istice (i.e., standard glacier) (we exclude grid cells that are 100% istice + to avoid the performance penalty, because these aren't used for coupling + with CISM, and the only way this glacier can retreat is if another landunit, + like crop, increases there, which will rarely happen). + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Performance about 6% worse for clm4.5 IG runs at f09 (i.e., with glcmec), + because of the new virtual vegetated columns. Not investigated for f19 or + T31, but probably a similar performance hit. + + There were also a few memcomp failures + +Code reviewed by: quick review by mvertens + +List any svn externals directories updated (csm_share, mct, etc.): + + Machines: Machines_140207a -> Machines_140213 (to fix pgi on yellowstone) + +List all files eliminated: + +========= Remove "IN_PROGRESS" +D models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90.IN_PROGRESS + +List all files added and what they do: + +========= Add code to update landunit weights; currently has no effect because + landunit areas don't change yet +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 + +========= Add unit tests for dynLandunitAreaMod +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights.pf + +List all existing files that have been modified, and describe the changes: + +========= Add grc%landunit_indices(:,:), so you can find a given l index if you + have the g index (this will be needed in a few places for dynamic + landunits) +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + - just add a comment +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Call new code in dynLandunitAreaMod +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Refactor logic in the is_active_X routines, and add logic to activate + a virtual vegetated landunit under some conditions (needed for + coupling with CISM, and helpful for dynamic landunits) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Add unit tests for dynLandunitAreaMod +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + + +CLM testing: + + regular tests (aux_clm): + + NOTE: frankfurt intel & pgi ran on a slightly older version of the branch + (dynlu_weight_updates_glacier_n05_clm4_5_62, which did not include some + final minor refactoring to reweightMod); frankfurt nag & yellowstone + intel/pgi ran on the final version + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + + A bunch of expected failures in h1 (1-d) hist files, due to the newly-active + points. + + + Also: Did a manual test to show that answers are the same for virtual + vegetated columns as they would be if the column had non-zero weight (to + ensure there are no dependencies on whether a column's weight is non-zero). + +CLM tag used for the baseline comparisons: clm4_5_62 for yellowstone (but +clm4_5_61 for component_gen_comp); clm4_5_61 for frankfurt + +Changes answers relative to baseline: NO + + However, note diffs in 1-d hist files due to newly-active points. + +=============================================================== +=============================================================== +Tag name: clm4_5_62 +Originator(s): erik (Erik) +Date: Mon Feb 10 04:16:07 MST 2014 +One-line Summary: Get PTCLM working robustly, US-UMB test working, add CO2 streams to datm, add more + consistency testing between compsets and user settings + +Purpose of changes: + +US-UMB fix in scripts and datm update. Fix so build-namelist will abort if there is an inconsistency with CLM_BLDNML_OPTS +and user_nl_clm. Add CO2 streams as a built-in option to datm. Turn CO2 streams on with the DATM_CO2_TSERIES env_run.xml +variable. Can be set to: none,20tr,rcp2.6,rcp4.5,rcp6.0,rcp8.5, by default is none. + +Requirements for tag: + + datm -- CO2 update, streams improvements + Fix build-namelist consistency issues + Fix bug 1847 -- end1d in hist for clm4_0 + Add envxml_dir + check that cndv and fpftdyn aren't on the same time + Add PTCLM tests to test_Driver + Add PTCLM test system in + Make PTCLM more robust + +Test level of tag: regular, tools, build_namelist + +Bugs fixed (include bugzilla ID): + 1918 -- sort options in build-namelist + 1917 -- remove WRF resolutions + 1903 -- buildtools fails for PTCLM + 1900 -- Remove BUILDHEAT and Qanth from output for CLM testing + 1896 -- CLM build-namelist should abort if use_cndv AND fpftdyn are set. + 1881 -- Add envxml_casedir option to CLM build-namelist + 1879 -- need error triggered when use_crop and CLM_BLDNL_OPTS are not consistent + 1847 -- 'histfilemod_mp_hist_restart_ncd_$END1D' is being used without being defined + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: frankfurt switched out for goldbach + +Describe any changes made to the namelist: CLM build-namelist changed to ensure user changes don't conflict with + command-line options + +List any changes to the defaults for the boundary datasets: remove WRF datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts to scripts4_140209 + Machines to Machines_140207a + datm to datm8_140114 + pio to pio1_8_8 + cprnc to cprnc_140203 + + PTCLM to PTCLM2_140204 + +List all files eliminated: move frankfurt to goldbach + +D models/lnd/clm/test/tools/tests_posttag_frankfurt_nompi + +List all files added and what they do: goldbach, and add PTCLM tools testing + +A + models/lnd/clm/test/tools/tests_posttag_goldbach_nompi +A models/lnd/clm/test/tools/TCBscripttools.sh ------------ Add script to run buildtools for PTCLM +A models/lnd/clm/test/tools/config_files/PTCLM__s -------- Config for PTCLM +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_clm4_0 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_clm4_5 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_Cycle_clm4_5 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_Global_clm4_5 +A models/lnd/clm/bld/unit_testers/myuser_nl_clm --- New build-namelist tests +A models/lnd/clm/bld/unit_testers/env_run.xm + + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist ----- Sort options, add -envxml_dir option, check that user hasn't contradicted themself + with CLM_BLDNML_OPTS and user_nl_clm, remove options: -noio, -nofire, -snicar_frc, -vsoilc, -exlaklayers, -clm4me + use Cwd::abs_path and remove home-grown absolute_path, add some more docmentation and comments, redo some ordering and names + M models/lnd/clm/bld/clm.buildnml.csh --- add -envxml_dir so will use env_*.xml files to expand env variables + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml --- Add irrig setting, remove WRF files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Add irrig, bgc_spinup, and bgc_mode + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml -- Remove WRF resolutions: us20, wus12 + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml - Remove WRF resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Remove WRF resolutions, add bgc_mode + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ----------- Add a bunch of new tests + M models/lnd/clm/bld/user_nl_clm ----- make note of variables that should be done by command-line build-namelist options + + M models/lnd/clm/src/clm4_0/main/histFileMod.F90 --- Fix bug 1847 + +------------ Add PTCLM testing + M models/lnd/clm/test/tools/README.testnames + M models/lnd/clm/test/tools/test_driver.sh ------ Remove bluefire, lynx, mirage, jaguarpf -- switch frankfurt for goldbach + M models/lnd/clm/test/tools/TBLscript_tools.sh + M models/lnd/clm/test/tools/TSMscript_tools.sh + M models/lnd/clm/test/tools/input_tests_master + M models/lnd/clm/test/tools/tests_posttag_nompi_regression + M models/lnd/clm/test/tools/tests_posttag_yong + M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + +------------ Don't die if debug and files were not created. + M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +CLM testing: regular, build-namelist, tools + + build-namelist tests: + + yellowstone + + regular tests (aux_clm): + + yellowstone_intel + yellowstone_pgi + goldbach_nag + edison_intel + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel + yellowstone_pgi + + tools testing: + + yellowstone interactive + goldbach interactive + +CLM tag used for the baseline comparisons: clm4_5_61 + +Changes answers relative to baseline: None, bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_61 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Feb 4 09:45:43 MST 2014 +One-line Summary: add 3-d snow history fields; continue harvest past end of pftdyn timeseries + +Purpose of changes: + + There are two separate sets of changes in this tag; both apply just to CLM4.5: + + (1) Addition of 3-d snow history fields: These history fields (inactive by + default) provide diagnostics for each layer of the snow pack. This + involved adding some additional history file infrastructure to handle + the variable number of snow pack layers. See the new section in the + user's guide (custom.xml) for a description of how these new history + fields work, and how to interpret them. + + (2) Change the harvest logic for transient runs that extend past the end of + the pftdyn dataset: Until now, harvest was set to 0 when you passed the + end of the pftdyn dataset. With this tag, this behavior is changed, so + that for all years past the end of the pftdyn dataset, harvest rates + remain fixed at the last year's value. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Memory use increases slightly, as observed by memcomp failures for a few + tests. This is presumably due to new fields in clmtype. + +Code reviewed by: Erik reviewed changes for the 3-d snow history fields. + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Add 3-d snow history fields +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/doc/UsersGuide/custom.xml + +========= Add a new snow diagnostic, sub_surf_abs_SW +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 + +========= Continue harvest past end of pftdyn time series +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + + Only failures are these expected failures (see notes on answer changes + below): + + FAIL SMS_Ly3.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetLate.compare_hist.clm4_5_60.clm2.h0 + FAIL SMS_Ly5.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetMid.compare_hist.clm4_5_60.clm2.h0 + FAIL SMS_Ly8.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetEarly.compare_hist.clm4_5_60.clm2.h0 + +CLM tag used for the baseline comparisons: clm4_5_60 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 transient runs that continue past the end of the pftdyn dataset + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate: Harvest rates are now continued past the end of the pftdyn + dataset (staying fixed at their value from the last year), for the + remainder of the simulation. This leads to potentially large answer + changes for transient runs that continue past the end of the pftdyn + dataset. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_60 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jan 30 18:27:03 MST 2014 +One-line Summary: refactor build-namelist + +Purpose of changes: : break build-namelist into small unit-testable functions + instead of a single massive script. Use output functions to standardize + screen output for errors, warnings and messages so that results can be + automatically searched by scripts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Erik + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist - major refactor described above + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - fix incorrect comments + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - minor updates to check new output style + +CLM testing: + + build-namelist tests: + + yellowstone - pass compare and generate with only xfails + frankfurt - not tested, CLM-CMT believes tests may be broken. + + regular tests (aux_clm): + + yellowstone_intel - ok + yellowstone_pgi - ok + frankfurt_intel - ok + frankfurt_pgi - ok + frankfurt_nag - ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - ok + yellowstone_pgi - ok + + short tests (aux_clm_short): + + yellowstone_intel - ok + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_59 + +Changes answers relative to baseline: none, bit for bit + + +=============================================================== +=============================================================== +Tag name: clm4_5_59 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Jan 22 15:04:12 MST 2014 +One-line Summary: use new get_curr_yearfrac function in clm_time_manager + +Purpose of changes: + + Use the new get_curr_yearfrac function in clm_time_manager in place of + dyn_time_weights. The reason is that, as Erik pointed out, dyn_time_weights + was out of place in dynUtilsMod, and really this functionality belongs in the + clm_time_manager module. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Made obsolete by get_curr_yearfrac in clm_time_manager +D models/lnd/clm/src/clm4_5/dyn_subgrid/dynUtilsMod.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynUtilsMod_mock.F90 + +List all files added and what they do: + +========= Mock out get_curr_yearfrac: return a fixed fraction +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/clm_time_manager_mock.F90 + +List all existing files that have been modified, and describe the changes: + +========= Fix get_curr_yearfrac to be real rather than integer +M models/lnd/clm/src/util_share/clm_time_manager.F90 + +========= Use get_curr_yearfrac instead of dyn_time_weights +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in + +========= Update unit tests to pull in clm_time_manager (mock) rather than dynUtilsMod (mock) +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_58 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45, either transient or with DV + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Ran testing on an intermediate tag, where I computed the time weights in + both the old and new ways. I confirmed that the difference in time weights + (which is the only change in this tag) is always less than 1e-13. Actually, + this difference is always less than 2e-16, double-precision roundoff. + + Also examined cpl hist diffs for a few select tests. Diffs are generally + ~ 1e-6 after 5 days. + +=============================================================== +=============================================================== +Tag name: clm4_5_58 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Jan 22 14:11:30 MST 2014 +One-line Summary: major refactor of transient pft code, in prep for dynamic landunits + +Purpose of changes: + +Major refactor of transient pft code, in prep for dynamic landunits. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1899 (harvest rates remain non-zero even after the end of the pftdyn dataset) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Erik; design reviewed by CLM-CMT + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_140102 -> scripts4_140114 + Machines: Machines_131206b -> Machines_140107 + csm_share: share3_131226 -> share3_131231 + pio: pio1_8_3 -> pio1_8_6 + + CMake: New external added + +List all files eliminated: + +========= renamed to dynConsBiogeophysMod.F90 +D models/lnd/clm/src/clm4_5/main/dynlandMod.F90 + +========= renamed to dynpftFileMod.F90; much of the stuff in here moved to other + files in the dyn_subgrid directory +D models/lnd/clm/src/clm4_5/main/pftdynMod.F90 + +========= renamed +D models/lnd/clm/test/unit + +List all files added and what they do: + +========= Rename test/unit to test/unit_testers, and add unit tests for some of + the stuff in dyn_subgrid. This also involved adding some mocks - + particularly of ncdio_pio. +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/test_daylength.pf +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarShared.F90 +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeInterp.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeUninterp.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/do_genf90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90.in +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/decompMod_boundsTypeDecl.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/main +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynFileMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynUtilsMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid +A models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock +A models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/README +A models/lnd/clm/test/unit_testers/clm4_5 +A models/lnd/clm/test/unit_testers + +========= Make a new directory to hold all of the stuff related to dynamic + subgrid weights. Currently this means transient PFTs, but soon it will + also mean dynamic landunits. This includes stuff that used to be in + pftdynMod and dynlandMod, as well as a bit from clm_driver. I have + added a new driver for the dyn_subgrid stuff (dynSubgridDriverMod), + and pulled out much of the shared, lower-level functionality into new + modules (dynTimeInfoMod, dynFileMod, dynVarMod, dynVarTimeInterpMod, + dynVarTimeUninterpMod, dynUtilsMod [which will soon go away]). In + addition, I have separated the many routines in pftdynMod into + separate modules, each with a single, better-defined function. +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90.IN_PROGRESS +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynUtilsMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid + +========= script to generate files from their .in files using genf90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/do_genf90 + + +========= move check_sums_equal_1 to a new module, partly to reduce dependencies + of unit tests, and partly because it is cleaner design to have it + outside of surfrdMod +A models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Add dyn_subgrid directory +M models/lnd/clm/bld/configure + +========= Add get_curr_yearfrac function (currently broken, will be fixed in + next tag) +M models/lnd/clm/src/util_share/clm_time_manager.F90 + +========= Change type(file_desc_t) to class(file_desc_t); add 'only' clause to + use statements to allow compilation with pgi +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +========= Change 'use statement' for reworked dyn_subgrid code +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 + +========= Move surfrd_check_urban and surfrd_check_sums_equal_1 to more + appropriate places +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 + +========= Move some code into dynSubgridDriverMod +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also remove incorrect header comment + +========= Add compute_higher_order_weights routine +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Add unit testing support +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + + +========= Frankfurt-PGI tests now pass! +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_57 + +Changes answers relative to baseline: YES (very limited; see below) + + Can change answers due to the following: + + (1) Changes answers for harvest when a run starts inside the pftdyn timeseries + but extends beyond it, without an intervening restart (see bug 1899) + + (2) Could theoretically change answers for yellowstone-pgi or hopper-pgi due + to machines updates, but no changes showed up in the yellowstone test suite + +=============================================================== +=============================================================== +Tag name: clm4_5_57 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Jan 7 14:17:04 MST 2014 +One-line Summary: change CNDV water conservation to use the pftdyn method + +Purpose of changes: + + For my dynamic landunit work, I was trying to reconcile what's going on with + prescribed transient PFTs (pftdyn) vs CNDV. The reason is that I'm trying to + set up an overall control flow for dynamic landunits, and you need to be able + to run either of these in conjunction with dynamic landunits. + + In doing this, I noticed that water conservation is handled differently for + pftdyn vs CNDV: + + For pftdyn, water conservation is done as described in section 21.2 of the + CLM4.5 tech note: water contents are summed before and after transition, and + the difference is put in the runoff term + + CNDV appears not to use this before & after difference. Instead, it does a + correction for canopy water in pftdynMod: pftdyn_wbal. + + For dynamic landunits, we're planning to use an approach like what is + currently done for pftdyn. I think it's going to be messy and confusing to + try to maintain the current CNDV approach when it's possible to have CNDV in + conjunction with dynamic landunits. + + Thus, I am changing CNDV to use the pftdyn approach to water conservation, + whether or not you are running with dynamic landunits. This will change + answers for CNDV/BGCDV cases in CLM4.5, though I expect the effects to be + small. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik; concept approved by Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Main changes are here; also minor (somewhat related) cleanup: fix some + section heading comments, add a timer (ndep_interp) - pulling out some + stuff that used to be (inappropriately) in the pftdynwts timer section +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Remove a bunch of now-unneeded code, especially from pftdynMod +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 + + +CLM testing: + + NOTE: Most testing was done from tag cndv_water_conservation_n01_clm4_5_55 - + up-to-date with clm4_5_55, NOT clm4_5_56. I then updated to clm4_5_56 and + reran just the three tests that were run for that tag (see its ChangeLog + entry, below), with comparison to clm4_5_56. + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_55 for most tests, clm4_5_56 +for three tests (see above note) + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with DV (CNDV / BGCDV) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated, but expected to be larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_56 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Thu Jan 2 09:06:32 MST 2014 +One-line Summary: update scripts external to fix I20TRCLM45BGC compset + +Purpose of changes: update scripts external to fix I20TRCLM45BGC compset + +Requirements for tag: fix bug 1869 + +Test level of tag: limited (see below) + +Bugs fixed (include bugzilla ID): 1869 (I20TRCLM45BGC compset improperly defined) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_131203 -> scripts4_140102 + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: none + +CLM testing: + + ONLY TESTED THE 3 AFFECTED TESTS from the yellowstone & frankfurt aux_clm test suites: + + PASS PET_P15x2_Lm13.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-reduceOutput.GC.140102-060037 + PASS ERS_D.f10_f10.I20TRCLM45BGC.frankfurt_pgi.clm-decStart.GC.140102-060448 + PASS ERS_Mmpich.f10_f10.I20TRCLM45BGC.frankfurt_nag.clm-decStart.GC.140102-060608 + +CLM tag used for the baseline comparisons: clm4_5_55 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Only I20TRCLM45BGC compsets + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate for this compset: correctly uses CLM4.5 instead of CLM4.0 code. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_55 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Dec 27 16:21:45 MST 2013 +One-line Summary: add hooks to Sean Santos's unit test framework, and begin to add CLM unit tests + +Purpose of changes: + + (1) add hooks to Sean Santos's unit test framework + + (2) begin to add CLM unit tests + + Note: this tag currently does NOT have the CMake utilities that are needed to + run the unit tests. Instead, the instructions show how to point to a version + of these in my directory. That's because, as of the time I submitted this tag + for testing, the necessary working version of the CMake utilities was not yet + tagged. In the near future, another external could be added to pull in these + CMake utilities in the CLM directory tree. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, santos + +List any svn externals directories updated (csm_share, mct, etc.): + + tools/unit_testing: added external + models/csm_share: share3_131101 -> share3_131226 (to get changes needed for building unit tests) + +List all files eliminated: None + +List all files added and what they do: + +========= Set up unit test directories & CMakeLists.txt files, and add unit + tests for DaylengthMod. Note that the tests themselves are in + Daylength_test/test_daylength.pf. See the README file for how to run + the tests +A models/lnd/clm/test/unit +A models/lnd/clm/test/unit/clm4_5 +A models/lnd/clm/test/unit/clm4_5/README +A models/lnd/clm/test/unit/clm4_5/CMakeLists.txt +A models/lnd/clm/test/unit/clm4_5/mock +A models/lnd/clm/test/unit/clm4_5/mock/decompMod_boundsTypeDecl.F90 +A models/lnd/clm/test/unit/clm4_5/mock/CMakeLists.txt +A models/lnd/clm/test/unit/clm4_5/Daylength_test +A models/lnd/clm/test/unit/clm4_5/Daylength_test/test_daylength.pf +A models/lnd/clm/test/unit/clm4_5/Daylength_test/CMakeLists.txt + +========= Add CMakeLists.txt files that are needed to build unit tests +A models/lnd/clm/src/clm4_5/main/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +========= Remove unneeded 'use' statement, to prevent pulling in more than is + necessary for the unit test build +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Externals updated - see above +M SVN_EXTERNAL_DIRECTORIES + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + Also ran the new unit tests, as per the instructions in + models/lnd/clm/test/unit/clm4_5/README - all PASS + +CLM tag used for the baseline comparisons: clm4_5_54 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_54 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Dec 27 15:55:05 MST 2013 +One-line Summary: update externals to cesm1_3_beta06 + +Purpose of changes: + + Update externals to cesm1_3_beta06 versions. + + However, do NOT update RTM, because the latest version of RTM results in + failures for ERI _N2 tests. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not investigated + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (.../trunk_tags/clm4_5_53) (revision 56268) + +++ SVN_EXTERNAL_DIRECTORIES (.../branch_tags/clm_update_externals_cesm1_3_beta06_tags/clm_update_externals_cesm1_3_beta06_n02_clm4_5_53) (revision 56268) + @@ -1,25 +1,25 @@ + # CESM scripts, machines and driver + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131126a + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130930b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_02 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131203 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_131206b + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_07 + + # Model components: Data atmosphere, and stub components as well as land-ice model + -models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_131116 + -models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/socn + -models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/sice + -models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/sglc + -models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/swav + -models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130924 + +models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_131201 + +models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/socn + +models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + +models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + +models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/swav + +models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_131008 + + # Utilities: csm_share, esmf, timing, MCT, PIO + -models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130918 + +models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_131101 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 + -models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130506 + +models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_131108 + models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n03_MCT_2.8.3 + -models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_7_2/pio + +models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_3/pio + + # Mapping tools: + -tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130529 + +tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_131120 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130716 + models/lnd/clm/tools/shared/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130716/gen_domain_files + + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= NCK tests no longer fail; change fail type of + ERS_D.f19_g16.IGRCP26CN.frankfurt_pgi from CFAIL to RUN +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: generate only (no baselines from clm4_5_53) + +CLM tag used for the baseline comparisons: clm4_5_53 + +Changes answers relative to baseline: YES, but only for multi-instance + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Multi-instance + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated, but suspected to be new climate + + Note that NCK tests newly pass (they had been failing), so this answer change + for multi-instance tests is expected. + + These answer changes show up in the following tests: + + FAIL CME_N2.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-default.GC.131227-063851.compare_hist.clm4_5_53 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.GC.131227-063851.compare_hist.clm4_5_53 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.GC.131227-063851.compare_hist.clm4_5_53 + + FAIL CME_N2.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_53.clm2.h0 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_53.clm2.h0 + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_53 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Dec 19 07:59:56 MST 2013 +One-line Summary: refactor restart interfaces + +Purpose of changes: Refactor restart interfaces. Most work done by mvertens. + +1) Add two *.F90.in files that use genf90.pl go generate source. This saves time + in dev. and maintenence. If you modify only the *.F90 file, your changes will + be lost. Instead modify the *F90.in file, then run genf90.pl on that file. + If you have questions, ask a clm developer for help. +2) Restart capability has now been encapsulated in a subroutine call that uses + Fortran 2003 interfaces over type and dimension. For example: + +- if (flag == 'define') then +- call ncd_defvar(ncid=ncid, varname='grainc_storage_to_xfer', xtype=ncd_double, & +- dim1name='pft',long_name='grain C shift storage to transfer',units='gC/m2/s') +- else if (flag == 'read' .or. flag == 'write') then +- call ncd_io(varname='grainc_storage_to_xfer', data=pcf%grainc_storage_to_xfer, & +- dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) +- if (flag=='read' .and. .not. readvar) then +- if (is_restart()) call endrun +- end if +- end if ++ call restartvar(ncid=ncid, flag=flag, varname='grainc_storage_to_xfer', xtype=ncd_double, & ++ dim1name='pft', & ++ long_name='grain C shift storage to transfer', units='gC/m2/s', & ++ interpinic_flag='interp', readvar=readvar, data=pcf%grainc_storage_to_xfer) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary data sets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +! renamed for consistency +D models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + +List all files added and what they do: + +A models/lnd/clm/src/util_share/dtypes.h +A models/lnd/clm/src/util_share/ncdio_pio.F90.in +A models/lnd/clm/src/util_share/restUtilMod.F90 +A models/lnd/clm/src/util_share/restUtilMod.F90.in +A models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_52 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_52 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Nov 26 22:07:32 MST 2013 +One-line Summary: turn on longwave radiation downscaling for glc_mec by default + +Purpose of changes: Turn on longwave radiation downscaling for glc_mec by default + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: set glcmec_downscale_longwave to true +by default + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: updated to scripts4_131126a, to get tweaked test list + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Change glcmec_downscale_longwave to true by default +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +========= Remove build-namelist tests that are no longer xFails +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Update scripts to scripts4_131126a, to get tweaked test list +M SVN_EXTERNAL_DIRECTORIES + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + frankfurt + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + +Expected baseline failures: +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131126-131812.compare_hist.clm4_5_51 +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131126-131812.nlcomp + +Two BFAILs due to changed tests; I reran them as their old versions and confirmed that answers changed, as expected: +BFAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags.GC.131126-131807.compare_hist.clm4_5_51 +BFAIL PEM_D.f19_g16.IG1850CLM45.yellowstone_pgi.clm-glcMEC.GC.131126-214346.compare_hist.clm4_5_51 + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_51 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with glc_mec (IG compsets) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + larger than roundoff; not investigated whether it is same climate or new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_51 +Originator(s): sacks (sacks) +Date: Tue Nov 26 05:46:29 MST 2013 +One-line Summary: rework downscaling of atm fields for glc_mec + +Purpose of changes: + +A number of changes related to downscaling atm -> clm fields for glc_mec +landunits: + +(1) Add new options to downscale precip (division into rain/snow) and longwave + radiation (developed by Bill Lipscomb). Both are currently off by default. + +(2) Move downscaling code out of clm_driverInit into clm_atmlnd.F90 - this is a + more appropriate module, and is a step towards modularity, because the code + to deal with the atmospheric forcing fields lives in the same module as the + definition of these atmospheric forcing fields. + +(3) Ensure that all code uses the downscaled, column-level fields where + possible. Previously, some code (which did not operate over glc_mec + landunits) used the non-downscaled, gridcell-level version of fields such as + forc_t. This was a problem because (a) it was confusing and error-prone, and + (b) we will soon be bringing in code to do downscaling over other landunits + as well as glc_mec landunits. + +(4) To support (3), and make it harder for someone to accidentally use the + gridcell-level version of a field when they should be using the downscaled, + column-level version: Broke clm_a2l into two pieces - one containing fields + that aren't downscaled, and one containing fields that are downscaled. For + fields that are downscaled, clearly distinguished the non-downscaled + versions so they couldn't be used by accident. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: For glc_mec runs, added two new +namelist options: glcmec_downscale_rain_snow_convert and +glcmec_downscale_longwave. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik; portions reviewed by Bill Lipscomb, Mariana, Stefan + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Significant changes: includes stuff that used to be in + clm_driverInitMod; added new downscaling code for precip & lwrad; + split atm2lnd type into two types; reworked initialization interfaces; + removed unused field rainf, because it currently isn't used and could + theoretically become inconsistent with the downscaled rain/snow +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 + +========= Removed downscaling code from here +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 + +========= Added call to downscale_forcings +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Changed interface to init_atm2lnd: previously, clm_initialize used + clm_a2l from clm_atmlnd and passed it to init_atm2lnd_type (also in + clm_atmlnd) - there was no reason for this, it was confusing, and to + some extent broke modularity +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= New parameter +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +========= Removed some variables +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +========= New namelist control variables +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +========= Removed unused rainf, added pointer to allow lnd_import_export to + remain identical between clm4_0 and clm4_5 code +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 + +========= Fixed test ids for failing build-namelist tests +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Minor changes in lots of places to (a) use fields from + a2l_downscaled_col instead of clm_a2l, and (b) index those fields by + column rather than by gridcell +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/cpl/lnd_comp_esmf.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/lnd_comp_mct.F90 + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Note the following expected nlcomp failures: + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.GC.131125-104703.nlcomp + FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131125-104751.nlcomp + FAIL PEM_D.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131125-104751.nlcomp + + Also, there were BFAILs for the following, implying that the baselines + didn't exist; I'm not too concerned because baseline comparisons passed for + similar tests: + BFAIL SMS_Ly1_Mmpich.f19_g16.ICLM45BGCCROP.frankfurt_nag.clm-reduceOutput.GC.131125-104832.compare_hist.clm4_5_50 + BFAIL ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.GC.131125-104703.compare_hist.clm4_5_50 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + As above, baselines were missing for this test: + BFAIL2 ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.compare_hist.clm4_5_50.clm2.h0 (baseline history file does not exist) + BFAIL2 ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.compare_hist.clm4_5_50.clm2.h1 (baseline history file does not exist) + + +CLM tag used for the baseline comparisons: clm4_5_50 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_50 +Originator(s): erik (Erik) +Date: Sun Nov 24 18:51:11 MST 2013 +One-line Summary: Bring in a crop of b4b bugfixes, fix getregional script, + start move of PTCLM to PTCLMmkdata tool + +Purpose of changes: + +Bring in a crop of bit-for-bit bug-fixes to the trunk for November. +Fix the getregional_datasets script and initial move of PTCLM to just +be a CLM tool under models/lnd/clm/tools/shared to create single-point +datasets. + +New option to create_newcase "-user_mods_dir" for a directory with +user chagnes such as user_nl_* namelist modification files, xmlchange_cmnds +file with xmlchanges to make, and SourceMods/src.*/* files. + +Requirements for tag: bit-for-bit bug-fixes and work on PTCLM + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1868 (Add user_mods_dir to create_newcase) + 1854 (Remove fndepdat no longer used) + 1842 (Remove unused variables from gridcell type) (Bill) + 1835 (Add write statement to pftdyn so you can see what it is doing) + 1828 (Clarify modulo used in irrigation code) (Bill) + 1770 (Remove sitespf_pt valid_values list for clm4_0) + 1724 (getregional script does NOT work) + 1625 (Problem setting finidat in CLM for RUN_TYPE=hybrid/branch) + 1543 (large-file format does NOT work in latest clm) + 1481 (Provide a more direct way to set a user provided finidat file) + 1437 (problems with link_dirtree -- no longer needed) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: SourceMods directory on create_newcase + + New -user_mods_dir option to create_newcase that will copy SourceMods/src.*/* + files to the new case. Also copies user_nl_* files and xmlchange_cmnds + +Describe any changes made to the namelist: remove outnc_large_files + Remove outnc_large_files -- wasn't functional + (now always use 64-bit format) + Remove fndepdat from namelist_definition/defaults no longer used. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (fixes for 1842 and 1828) + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts updated to scripts4_131119 + +List all files eliminated: None + +List all files added and what they do: + +------ Add externals for tools so PTCLM shows up in tool directory +------ Add same files and a README file for getregional +A models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist +A models/lnd/clm/tools/shared/ncl_scripts/README.getregional + +List all existing files that have been modified, and describe the changes: + +------ Get getregional_datasets script working again. Now operates on +------ lists of files. +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/test/tools/TSMscript_tools.sh --- Copy sample_*list files +M models/lnd/clm/test/tools/nl_files/getregional - change arguments + +------ +M models/lnd/clm/tools/clm4_0/interpinic/src/interpinic.F90 + +------ Remove clm_startfile option and outnc_large_files +M models/lnd/clm/bld/config_files/config_definition_clm4_0.xml -- + Remove valid_values from sitespf_pt so can be anything. +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl -- Remove + clm_startfile option and move some clm4_5 configure options + to build-namelist +M models/lnd/clm/bld/build-namelist --- Remove clm_startfile option + and outnc_large_files +M models/lnd/clm/bld/clm.buildnml.csh - Remove clm_startfile option + set finidat/nrevsn like how is done in CAM + +------ Remove fndepdat and outnc_large_files +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 -------- Remove + some gridcell variables not sued +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 ------------- write + on what's going on +M models/lnd/clm/src/clm4_5/main/controlMod.F90 ------------ Remove + outnc_large_files +M models/lnd/clm/src/clm4_5/main/clmtype.F90 --------------- Remove + a bunch of gridcell variables not needed +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - Add + seconds_since_irrig_start_time temporary to clarify + +------ +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 --- add some writes statements +M models/lnd/clm/src/clm4_0/main/controlMod.F90 -- remove outnc_large_files + +CLM testing: + + build-namelist tests: + + yellowstone yes + frankfurt no + + NOTE: there were some tests that were passing but in the xFail list + from before clm4_5_49 that I marked as working. + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel yes + yellowstone_pgi yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_49 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_49 +Originator(s): muszala (Stefan Muszala) +Date: Sat Nov 16 07:51:27 MST 2013 +One-line Summary: Swenson anomaly forcing - Part 1 + +purpose of changes: + add additional data streams to modify existing + data streams for purposes such as bias correction or specifying + future changes relative to baseline data streams, e.g. specifying + future atmospheric forcing anomalies when running CLM with data atmosphere. + Paired with datm8_131115. + + For what to set in user_nl_cpl, user_nl_datm, see testing section. + + This is part 1 of 2. Part 2 will address a general way to handle + streams in the DATM that is triggered off of an AF compset. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: swenson, kluzek, self + +List any svn externals directories updated (csm_share, mct, etc.): update to datm8_131116 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + +Testing for features of this tag: f09_g16, ICRUCLM45 + +anomaly forcing namelists + user_nl_cpl: cplflds_custom = 'Sa_prec_af->a2x', 'Sa_prec_af->x2l','Sa_tbot_af->a2x', + 'Sa_tbot_af->x2l','Sa_pbot_af->a2x', 'Sa_pbot_af->x2l','Sa_shum_af->a2x', + 'Sa_shum_af->x2l','Sa_u_af->a2x', 'Sa_u_af->x2 l','Sa_v_af->a2x', + 'Sa_v_af->x2l','Sa_swdn_af->a2x', 'Sa_swdn_af->x2l','Sa_lwdn_af->a2x', + 'Sa_lwdn_af->x2l' + user_nl_datm: anomaly_forcing = 'Anomaly.Forcing.Precip','Anomaly.Forcing.Temperature', + 'Anomaly.Forcing.Pressure','Anomaly.Forcing.Humidity','Anomaly.Forcing.Uwind', + 'Anomaly.Forcing.Vwind','Anomaly.Forcing.Shortwave','Anomaly.Forcing.Longwave' +bias correction namelists + user_nl_cpl: cplflds_custom = 'Sa_precsf->a2x', 'Sa_precsf->x2l' + user_nl_datm: bias_correct = 'BC.CRUNCEP.GPCP.Precip' + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_48 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_48 +Originator(s): muszala (Stefan Muszala) +Date: Thu Nov 14 08:28:31 MST 2013 +One-line Summary: bug fixes for CLM dry deposition and MEGAN VOC emissions + +Purpose of changes: Bring in bug fixes from fvitt for CLM dry deposition and MEGAN VOC emissions. Any changes + to answers are limited to rare circumstances. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: fvitt, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_47 + +Changes answers relative to baseline: Answers change for some of the chemistry configurations, but + these changes will not be see in the CLM standalone tests. + +=============================================================== +=============================================================== +Tag name: clm4_5_47 +Originator(s): muszala (Stefan Muszala) +Date: Tue Nov 12 09:26:20 MST 2013 +One-line Summary: fix Bug 1858 - AGDD now reset annually + +Purpose of changes: Fix bug 1858. AGDD is now reset annually. Replace -99999_r8 with a + parameter in accumulMod.F90 which is used in accFldsMod.F90 + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1858 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: slevis, sacks, muszala + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_46 + +Changes answers relative to baseline: Generally, No. There may be changes + in DV compsets over very long simulation times and at very high resolutions. + +=============================================================== +=============================================================== +Tag name: clm4_5_46 +Originator(s): sacks (sacks) +Date: Fri Nov 8 17:26:02 MST 2013 +One-line Summary: remove zeroing out of slope for special landunits + +Purpose of changes: + + Previously, there was code to zero out slope for grid cells with 100% special + landunits. However, there were a number of problems with this: + + (1) With dynamic landunits, this is problematic, because a grid cell could + start as 100% special landunits, then later become < 100% special landunits + (e.g., due to retreating glaciers) + + (2) Moreover, why should the slope of a special landunit depend on whether + the grid cell has 100% special landunits. This seems to be saying that, e.g., + the slope of a glacier landunit depends on whether the grid cell is entirely + glacier or part glacier and part natural veg. + + (3) And I guess moreover, why is the slope zeroed out for special landunits + in the first place? + + + From talking with Erik, we decided thish code was probably a relic from a + time when the surface dataset had some bad values (e.g., over Greenland / + Antarctica). This is no longer the case, so this code is no longer needed. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Following are the baseline failures, which are expected (see below): + +FAIL SMS_D.1x1_mexicocityMEX.ICLM45.frankfurt_intel.clm-default.GC.131107-223431.compare_hist.clm4_5_45 +FAIL SMS_D.1x1_vancouverCAN.ICLM45.frankfurt_pgi.clm-default.GC.131107-223435.compare_hist.clm4_5_45 +FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_nag.clm-default.GC.131107-223439.compare_hist.clm4_5_45 +FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_nag.clm-default.GC.131107-223439.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.GC.131107-223256.compare_hist.clm4_5_45 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.I1850CRUCLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.ICLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 +FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + Following are the baseline failures, which are expected: + +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h0 +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h1 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h0 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h1 + + +CLM tag used for the baseline comparisons: clm4_5_45 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Any configuration that includes a grid cell that + has 100% special landunits, including at least some urban + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated carefully, but expected to be larger than roundoff/same + climate - since this only affects a very small number of grid cells, and + (I believe) only the urban pervious road in those grid cells + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_45 +Originator(s): sacks (sacks) +Date: Fri Nov 8 16:10:22 MST 2013 +One-line Summary: refactor daylength calculation, and other minor changes + +Purpose of changes: + + (1) Compute daylength in a single place, and compute necessary variables at + initialization rather than having them on the restart file + + (2) Compute daylength-related variables at initialization rather than having + them on the restart file, both to clean things up and to fix some daylength + bugs at initialization (these bugs were fixed in a kludgey way in clm4_5_44, + and now are fixed robustly) + + (3) Fix daylength calculation at the poles (previously blew up due to + roundoff errors) (doesn't change behavior currently, but could change + behavior / answers if there were a vegetated landunit at the pole) + + (4) Fix sminn on restart, so that crop restarts can be bfb (bug 1846) + + (5) Add all_active namelist variable that makes even 0-weight points active, + for testing purposes + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + - 1846 (crop restarts aren't exact due to sminn field) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: add all_active namelist variable + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: (1) & (2) reviewed by erik, (3) by self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: update from scripts4_131030 -> scripts4_131107a + +List all files eliminated: none + +List all files added and what they do: + +========= Compute daylength in a single place +A models/lnd/clm/src/clm4_5/biogeophys/DaylengthMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Refactor daylength calculation to just compute daylength in a single, + central place, and compute necessary variables at initialization + rather than having them on the restart file +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + - also fix sminn on restart (bug 1846) +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + +========= Add all_active namelist variable that makes even 0-weight points + active, for testing purposes +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + + +========= Add & remove tests from xFail list +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +*** No longer tested (replaced by CME_Ly4) +- Runs out of time. CME_Ly4.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-monthly passes + +*** Now passes +- restarts not exact due to bug 1846: crop restarts are not exact due to sminn field + ++ Diffs in cpl log files in rofl, rofi and volr ++ Diffs in cpl log files in rofl, rofi and volr + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Note that we get the following failures in compare_hist: + + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.131107-214732.compare_hist.clm4_5_44 + FAIL PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput.GC.131107-214732.compare_hist.clm4_5_44 + + However, I think that's expected due to the oddities in the clm4_5_44 tag + with openmp - see notes in the ChangeLog for clm4_5_44 for details. Note + that this one is identical to clm4_5_43, suggesting that clm4_5_45 undoes + the problem introduced in clm4_5_44: + + PASS PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_43.cpl.hi + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + In particular, note that the clm hist comparison passes for the two above + tests that had unexpected cpl diffs: + + PASS PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_44.clm2.h0 + PASS PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput.compare_hist.clm4_5_44.clm2.h0 + + +CLM tag used for the baseline comparisons: clm4_5_44 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_44 +Originator(s): sacks (sacks) +Date: Fri Nov 8 08:19:56 MST 2013 +One-line Summary: temporary hack to daylength initialization to provide baselines for the next tag + +Purpose of changes: + + The next tag (clm4_5_45) involves a major refactor to the daylength + calculation. That refactor is bfb in most respects, but gives differences in + the first time step in a few situations. + + This tag (clm4_5_44) does the minimal changes needed to get the same results + as clm4_5_45, in order to have more confidence when testing clm4_5_45. + + Note that the changes here are a kludge that will be reverted in clm4_5_45. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1850 (incorrect daylength in first timestep of some runs) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + There were a number of expected compare_hist failures, as described below. + + There was one unexpected compare_hist failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.145424.compare_hist.clm4_5_43 + + Diffs are just in voc cpl fields. CLM hist files are identical at the end of + the run. An SMS version of this test passes. Interestingly, the kludgey code + that I have added for clm4_5_44 isn't even executed in this test... so the + only diffs should be in variable declarations and 'use' statements. And + clm4_5_45 (which I will tag soon) gives identical cpl hist files to + clm4_5_43. So there may just be a compiler fluke in the compilation of this + tag with openmp enabled. Because clm4_5_45 will give identical results to + clm4_5_43, I'm not worrying about this. + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + A number of expected compare_hist failures, as described below. + +CLM tag used for the baseline comparisons: clm4_5_43 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with BGC (and probably CN), involving + either (a) initial conditions interpolated from a different resolution, or + (b) a change in start date relative to the ref date of an initial file + (which shows up in ERI tests) - see bug 1850 + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated carefully, but almost certainly larger than + roundoff/same climate, since this code mod just changes things in the + first timestep. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_43 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Nov 6 09:21:25 MST 2013 +One-line Summary: allocate memory for most landunits in every grid cell (needed for dynamic landunits) + +Purpose of changes: + + Main change is to allocate memory for most landunits in every grid cell, to + support dynamic landunits. Note that we ALWAYS do this extra memory + allocation, so that the user isn't required to do interpinic between a + non-dynamic run and a dynamic landunit run. (If we eventually change the + restart file format / processing so that you can add / remove 0-weight points + at will, then we could potentially add some logic to only do this extra + allocation if we're using dynamic landunits.) + + Supporting changes are (1) determining which grid cells have enough parameter + data to support urban landunits, (2) new initial conditions files, (3) in + mksurfdata_map, don't set soil parameters to 0 under glacier, and set urban + parameters even if urban cover is 0% + + Other changes are: + + (1) only do snow balance check over active columns + + (2) fix interpinic bug (bug 1839) + + (3) newer files for testing interpinic + + + NOTE: All CLM4.5 initial conditions will need to be interpinic'ed to be + usable in this tag (this has been done for all out-of-the-box initial + conditions) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + - 1839 (interpinic uses wrong column when there are 0-weight columns in the + input file) + + - 1840 (snow balance check is executed over inactive columns) + + - 1825 (surface datasets need urban parameters even when pcturb is 0 + everywhere): partial fix - still waiting on new USUMB dataset + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new initial conditions for CLM4.5 + +List any changes to the defaults for the boundary datasets: new initial +conditions for CLM4.5 + +Describe any substantial timing or memory changes: + + Significant memory increases for all CLM4.5 configurations - memory is now + allocated for all natural veg landunits, all crop landunits (if using + create_crop_landunit), and most urban landunits. + + Also, significant performance decrease (~ 10%) associated with the above + change, which I believe is mainly due to decreased cache friendliness. + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +D models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c130607.nc + +List all files added and what they do: + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +A models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c131104.nc + +List all existing files that have been modified, and describe the changes: + +========= Determine which grid cells should have urban landunits +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 + +========= Create a natural veg landunit and crop landunit in all grid cells; + create an urban landunit in all grid cells for which we have + determined that urban is "valid" +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 + +========= Change a comment +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + +========= Only do snow balance check over active columns (fixes bug 1840) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Use new initial conditions files that are consistent with the expanded + 1-d memory structures +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Don't set soil parameters to 0 under glacier; set urban parameters + even if urban cover is 0% +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + +========= Fix interpinic bug (bug 1839) +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +M models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions + + +========= Add two tests to the xFail list +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + ++ Runs out of time. CME_Ly4.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-monthly passes ++ Needs new surface dataset + + +CLM testing: + +NOTE: main tests were done with +dynlu_allocate_memory_n11_fix_cndv_time_averages_n01_clm4_5_41; tools tests with +dynlu_allocate_memory_n12_clm4_5_42; build-namelist tests with a slightly older +tag + + build-namelist tests: + + yellowstone: OK. However, the "correct" comparisons are spurious, because I + think the build-namelist test is broken + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + tools testing: + + yellowstone interactive: OK + + *** Expected failures + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=4 FAIL + + + *** Expected baseline failure (uses new input & output file, and there is a non-bfb change in interpinic) + 016 blh54 TBLtools.sh clm4_5 interpinic tools__ds runoptions ....................................\c + rc=7 FAIL + + *** Expected diffs in PCT_SAND, PCT_CLAY, SOIL_COLOR + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds \c + rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....\c + rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...\c + rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...\c + rc=7 FAIL + + *** Expected diffs in urban fields + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_\c + rc=7 FAIL + + +CLM tag used for the baseline comparisons: clm4_5_42 + +Changes answers relative to baseline: NO - but see note below: + + NOTE: This tag has the potential to change answers for cases using initial + conditions that were interpinic'ed using the out-of-the-box interpinic, + because of bugs in interpinic. This applies to CLM4.5 cases @ ne30 and hcru + resolutions, as well as CLM4.5 cases using DV @ f09. However, no diffs showed + up in the test suite, so it's possible that this isn't a problem. + +=============================================================== +=============================================================== +Tag name: clm4_5_42 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Mon Nov 4 09:45:36 MST 2013 +One-line Summary: fix bug 1857 for CLM4.5 - CNDV running temperature means are incorrect + +Purpose of changes: + + Fix bug 1857 for CLM4.5 (not yet fixed for CLM4.0!). From the bugzilla entry: + + In this code in CNDVMod: + + do p = bounds%begp, bounds%endp + g = pft%gridcell(p) + if (kyr == 2) then ! slevis: add ".and. start_type==arb_ic" here? + tmomin20(g) = t_mo_min(p) ! NO, b/c want to be able to start dgvm + agdd20(g) = agdd(p) ! w/ clmi file from non-dgvm simulation + end if + tmomin20(g) = (19._r8 * tmomin20(g) + t_mo_min(p)) / 20._r8 + agdd20(g) = (19._r8 * agdd20(g) + agdd(p) ) / 20._r8 + end do + + Notice that this is a loop over p, but it's updating gridcell-level variables. + This means that the running temperature means aren't at all what they purport + to be. e.g., in a grid cell with the 17 natural PFTs and nothing else, the grid + cell-level values will get the 17 pft values averaged in each year, rather than + getting a single pft value per year. This means that these temperature + variables are closer to a single year's value than to a running mean. + + The fix here should be simple: just change tmomin20 & agdd20 to pft-level + variables. + + + WARNING: USE CAUTION WHEN USING THIS TAG WITH AN OLDER RESTART FILE FROM A + CLM4.5 DV CASE (this is not a problem for any out-of-the-box initial + conditions files, but could apply if you have your own initial file from a DV + run): In this case, the two DV-related variables AGDD20 and TMOMIN20 will be + reset to their arbitrary initial conditions. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1857 - partial fix (still open for clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Remove SSP compare_hist BFAIL from xFAIL list (Ben fixed this in the last tag) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + All baseline comparisons pass except the following expected failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.104252.compare_hist.clm4_5_41 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + All baseline comparisons pass except the following expected failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_41.clm2.h0 + +CLM tag used for the baseline comparisons: clm4_5_41 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with DV + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Definitely larger than roundoff, but not investigated as to whether it's + same climate or new climate. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_41 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Wed Oct 30 17:33:16 MDT 2013 +One-line Summary: update scripts to convert clm4_5 CPP flags to namelist variables. + +Purpose of changes: Convert clm4_5 CPP flags in controlMod.F90 + into namelist variables, update scripts infrastructure + to generate cases with namelist variables for bgc + (CN, CNDV, methane, vsoilc_centbgc), crop, extra lake layers, + vic, nofire, noio, sitespf_pt, snicarfrc, maxpatch_pft. + +Requirements for tag: + +Test level of tag: regular, tools, build_namelist + +Bugs fixed (include bugzilla ID): 1728 (scripts4_20131030 tag). 1770 (clm4_5 portion). + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: removed clm4_5 CPP flags: + NOFIRE, LCH4, NITRIF, VERTSOILC, EXTRALAKELAYERS, VICHYDRO, CENTURY, CN, + CNDV, CROP, SNICAR, VANCOUVER, NOIO, MEXICOCITY + +Describe any changes made to the namelist: added namelist variables: + + use_nofire, use_lch4, use_nitrif_denitrif, use_vertsoilc, use_extralakelayers, + use_vichydro, use_century_decomp, use_cn, use_cndv, use_crop, use_snicar_frc, + use_vancouver, use_mexicocity, use_noio + + All new namelist variables are logicals. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Erik Kluzek, Bill Sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_131030 + +List all files eliminated: +D models/lnd/clm/bld/config_files/config_definition.xml - split into clm4_X variants + +List all files added and what they do: +A models/lnd/clm/bld/config_files/config_definition_clm4_5.xml +A models/lnd/clm/bld/config_files/config_definition_clm4_0.xml + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - set crop=off by default to pick up correct defaults. +M models/lnd/clm/bld/configure - completely remove clm4_5 only cpp flags, add physics dependent logic to clm4_0 flags. +M models/lnd/clm/bld/queryDefaultNamelist.pl - point to physics specific config_definitions.xml file +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml - replace xml special characters with alternatives so file can be parsed. Add new build-namelist failures. + +M models/lnd/clm/bld/build-namelist - add logic for all new clm4_5 namelist variables, commandline options, switch defaults to use_N. + +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - add new namelist variables + +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 - add CNNDynamicsInit() and logic to set nfix_timeconst from use_nitrif_denitrif namelist instead of CPP. +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 - convert ifdef'd parameters to variables +M models/lnd/clm/src/clm4_5/main/controlMod.F90 - final conversion of CPP flags to namelist variables + + Switch the following files to use new namelist variables for attributes: +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + + +CLM testing: + + build-namelist tests: + + yellowstone - most tests will fail, tests need to be updated in future tag + frankfurt + + regular tests (aux_clm): + - nlcomp tests fail for all clm4_5 because of the new namelist variables. + - SSP tests should now be BFAIL, pass on next tag + - All hist comp are bit for bit. + + yellowstone_intel ok + yellowstone_pgi ok + frankfurt_intel ok + frankfurt_pgi ok + frankfurt_nag ok + + tools testing: + + yellowstone interactive - smiS4 (getregional) also fails in clm4_5_40 + frankfurt interactive - N/A + +CLM tag used for the baseline comparisons: clm4_5_40 + +Changes answers relative to baseline: None. + +=============================================================== +=============================================================== +Tag name: clm4_5_40 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Oct 24 07:54:46 MDT 2013 +One-line Summary: fix Bug 1752 - urban conductances depend on weights in an undesirable way + +Purpose of changes: + +Three parts to this tag. Description from Oleson: + +1) + fix Bug 1752 - modified UrbanMod.F90 to calculate +2) + add 2 new diagnostic history fields (FIRE_U, FIRE_R) + the conductances correctly. I created new variables to more clearly + distinguish between scaled and unscaled conductances. +3) + fix small bug in which the history field output of some of the + anthropogenic heat flux variables are not bfb on restart when finidat is blank. + I found this when verifying bfb for the original bug fix. The cause of this + is initialization which sets non-urban to special value, instead of zero, which + is what is desired. On restart, this initialization is not done and the history + file set_nourb=0 has precedent. A related issue is that eflx_building_heat is + not zero for pervious/impervious road when nlevurb /= nlevgrnd. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1752 + + long test with irrigate=.true. (because irrigation likely never took effect + in the old test). + +Requirements for tag: + +Test level of tag: regular & build_namelist + +Bugs fixed (include bugzilla ID): + - 1827 / 1830: testmods don't work right for multi-instance tests (fix via + scripts update) + - 1829: PCT_SAND, PCT_CLAY and SOIL_COLOR are incorrect for some grid cells + (fix via new surface datasets) + - 1831: turning on irrigation leads to death in initialization (fix via a new + initial conditions file) + + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: see changes in boundary datasets + +List any changes to the defaults for the boundary datasets: + + - new surface datasets for all resolutions for CLM4.5: same as before except + for PCT_SAND, PCT_CLAY and SOIL_COLOR: these are no longer zeroed out under + points that are believed to be 100% glacier ("believed to be" because this + previously zeroed out some points that ended up having some other special + landunits, such as lake) + + - new initial conditions file for CLM4.5, irrigate=.true., f10 + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_131001 -> scripts4_131003 + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= new logic for irrigation for finidat +M models/lnd/clm/bld/build-namelist + +========= new surface datasets; distinguish finidat based on value of 'irriagte' +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +CLM testing: + + build-namelist tests: + + caldera: OK + The following failures were expected due to new surface datasets: + 413/439 < FAIL> + 418/439 < FAIL> + 423/439 < FAIL> + 428/439 < FAIL> + 433/439 < FAIL> + 438/439 < FAIL> + + + regular tests (aux_clm): + + edison_intel (aux_clm_ys_intel & aux_clm_ys_pgi lists): OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + edison_intel: aux_clm_ys_intel list: OK + edison_intel: aux_clm_ys_pgi list: OK + +CLM tag used for the baseline comparisons: clm4_5_35 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated carefully, but probably larger than roundoff/same climate. + + Answer changes are due to new surface datasets. This is due to fixing + bug 1829 (PCT_SAND, PCT_CLAY and SOIL_COLOR are incorrect for some grid + cells); it looks like this just affects answers over a small number of + lake points (e.g., 9 lake points in an f19 run). + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_35 +Originator(s): sacks (Bill Sacks) +Date: Tue Oct 1 09:47:45 PDT 2013 +One-line Summary: get CLM running on edison + +Purpose of changes: + + Update scripts and Machines externals to get the CLM test suite running on + edison; this will be our replacement for yellowstone while yellowstone is + down. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: N/A + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130929 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130927 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131001 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130930b + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Remove PEM test that should pass now; add xFails for edison +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + NOTE: Testing was done on tag port_to_edison_02_clm4_5_34. Since then, scripts + has been updated from scripts4_130930a to scripts4_131001. However, the only + difference is the removal of some duplicated tests from the test list. + + regular tests (aux_clm): + + edison_intel (aux_clm_ys_intel & aux_clm_ys_pgi lists): OK + All pass except: + + See "ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + Can't find user datasets + Seg fault while writing h1 file + See ERS_Ld211_D_P112x1.f10_f10.ICNCROP in yellowstone intel list + + #1 and #4 have been failing on yellowstone, #2 and #3 are new failures on edison + + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + NOTE: only generate done here, because no baselines existed + + edison_intel: aux_clm_ys_intel list: OK + edison_intel: aux_clm_ys_pgi list: OK + +CLM tag used for the baseline comparisons: clm4_5_34 + + NOTE: Baseline comparisons only done for frankfurt tests; no baseline + comparisons done with component_gen_comp, because no baselines existed on + edison. + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_34 +Originator(s): erik (Erik Kluzek) +Date: Mon Sep 30 01:30:25 MDT 2013 +One-line Summary: Get PTCLM working, fix a few small bugs + +Purpose of changes: + +Get PTCLM fully working. Allow PTCLM to work with ALL I compsets including clm4_0 compsets. +Add a new option to PTCLM from Keith Oleson --cycle_forcing to set it up to cycle over the forcing. +Another option is to build datasets in the "-mydatafiles" directory (by default under PTCLM +directory). The datasets now have creation time-stamps in them as well. Rename QIAN_tower_yrs +to -use_tower_yrs and remove QIANforcing (now chosen by compset). +scripts now has four different I1PT compsets two new ones for CLM40CN and CLM45BGC. datm +CLM_USRDAT domain file for CLM1PT forcing points to the ATM_DOMAIN_FILE/PATH. Add some new +datasets to the siteDIR from Keith Oleson. Update documenation, remove unused template dir. +Add a script to rename creation dates for map files, so you don't have to regenerate them +each day. + +Fix a few small bugs. Allow clm4_5 to have suplnitro and bgc_spinup to only give a warning +rather than die. Fix a corrupted rawdata PFT file. Fix mkscripgrid.ncl for regional SCRIP +grid creation. Remove some leftover fine-mesh variables that aren't needed anymore. Remove +reference to scaled_harvest in CLM build-namelist which was removed a long time ago. + +Remove a mapping file that didn't seem to be needed for clm4_0 mkmapdata (a default +didn't exist for it either). Add -usr_mapdir option to clm4_0 mksurfdata.pl which is needed +for PTCLM for clm4_0 compsets. + +Requirements for tag: Update scripts and get PTCLM working + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1826 (allow clm4_5 and suplnitro to be ALL for bgc_spinup) + 1818 (two new options to PTCLM) + 1762 (Fix corrupted rawdata PFT file) + 1757 (Bug in mkscripgrid.ncl for regional/global SCRIP grid creation) + 1623 (Remove some leftover fine-mesh variables _a arrays) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Allow two options to go without dying + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, datm, and csm_share + scripts to scripts4_130929 + Machines to Machines_130927 + datm to datm8_130919 + csm_share to share3_130918 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh ------- Remove 10x10min_IGBPmergeICESatGIS for clm4_0 + M models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl --- Fix bug 1757 for regional grid creation + M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl - Add usr_mapdir option + + M models/lnd/clm/bld/build-namelist - Allow missing clm_usrdat files to continue, remove scaled_harvest (long gone) + allow bgc_spinup and suplnitro to coexist with warning + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml - Fix corrupted 856 raw PFT file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - Fix corrupted 856 raw PFT file, remove 1000-1004 testyrs + + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - Remove finemesh _a variables + M models/lnd/clm/src/clm4_5/main/clmtype.F90 -------- Remove finemesh _a variables + M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 - Remove finemesh _a variables + M models/lnd/clm/src/clm4_0/main/clmtype.F90 -------- Remove finemesh _a variables + +CLM testing: regular, build_namelist, tools + + build-namelist tests: + + yellowstone yes + frankfurt yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_33 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_33 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Sep 26 10:42:56 MDT 2013 +One-line Summary: clean up from mistakes in previous tag + +Purpose of changes: clean up time-stamps and a mistake in clm4_5_32 + +Requirements for tag: N/A + +Test level of tag: N/A + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: N/A + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: N/A + +CLM tag used for the baseline comparisons: N/A + +Changes answers relative to baseline: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_32 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Sep 26 10:07:14 MDT 2013 +One-line Summary: bug fix tag - 1798, 1810 + +Purpose of changes: fix bug 1798 and 1810. + +http://bugs.cgd.ucar.edu/show_bug.cgi?id=1798 +http://bugs.cgd.ucar.edu/show_bug.cgi?id=1810 + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1798 and 1810 + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- for bug 1798 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +- for bug 1810 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_31 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_31 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Sep 25 10:12:47 MDT 2013 +One-line Summary: fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + +Purpose of changes: + + Fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and + decomposition dependence. Fix for this is based on analysis of the original + Agro-IBIS code. + +Requirements for tag: fix bug 1820, the following tests should now pass: + PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Beth Drewniak, Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 + +========= Remove now-passing PET tests +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_30 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with CROP + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + larger than roundoff, but not investigated in detail + + Note that no changes were observed in the test suite, but this is due to + a limitation of the test suite (there are very few multi-year crop tests; + the only global multi-year tests are the newly-passing PET tests, which + don't have baselines) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_30 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Sep 24 13:08:01 MDT 2013 +One-line Summary: fix performance bug in decomposition initialization + +Purpose of changes: + +Fix performance bug in decomposition initialization (bug 1771). Code mods from +Tony Craig. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1771 ( Fix for an initialization performance bug) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Improves timing of initialization for high resolution casse + +Code reviewed by: tcraig + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +M models/lnd/clm/src/clm4_0/main/decompInitMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_29 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_29 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Sep 24 10:55:42 MDT 2013 +One-line Summary: fix threading in CLM4.5, and other misc fixes + +Purpose of changes: + +(Mostly) fix threading in CLM4.5. This consisted of: + +(1) Rework initGridCellsMod to keep all points in a clump contiguous + +(2) Add info in bounds derived type (not necessary, but this allows +for more error checking and simplifies some code) + +(3) Fix which bounds are passed to reweightWrapup in initialization + +(4) Get rid of syntax like foo(:) = 0, instead using explicit bounds + +(5) Rework bounds declarations for subroutine array arguments, both in +caller (explicitly subset argument by bounds) and callee (use +assumed-shape array arguments rather than declaring upper bounds), and +add assertions on array sizes. + +See https://wiki.ucar.edu/display/ccsm/Community+Land+Model+Developers+Guide +("Guidelines for passing array arguments to subroutines") for the new +conventions that are implemented here. + +(6) Fix crop threading bug, related to nyrs (bug 1598), both in clm4.5 and clm4.0 + +However, note that there is still a crop threading bug (bug 1820), which will +need to be fixed in a separate tag. + + +Also, some unrelated changes: + +(1) Fix size of a megan variable, both in clm4.5 and clm4.0. + +(2) Remove some unused variables from Hydrology2Mod / SoilHydrologyMod + +(3) Fix some bugs in histFileMod / histFldsMod + +(4) Reorder a loop in SurfaceAlbedo to get better performance (especially with +expanded memory allocation for dynamic landunits, in an upcoming tag) + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1598 (crop threading in clm4.0 and clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + + Added f10 initial file for CLM4.5 BGCCROP, for testing purposes + +Describe any substantial timing or memory changes: + + Timing is currently 5-10% worse, due to calls to shr_log_errMsg, within + shr_assert calls. This should return to previous timings in non-debug runs + once shr_assert calls are ifdef'ed out in non-debug runs (this requires a + csm_share update that Sean Santos is working on). + +Code reviewed by: portions reviewed by erik + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts4_130912 -> scripts4_130916 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Significant rework to work with multiple clumps per proc +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Add info in bounds derived type +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also fix crop threading bug (1598) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + - also use explicit bounds instead of things like foo(:) + +========= Remove some unused variables +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + - also other bounds-related changes as above + +========= Change 'bounds' to 'bounds_proc', use clump bounds for call to + reweightWrapup, get rid of abort if running with openMP +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= Get rid of syntax like foo(:), instead using explicit bounds +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 + +========= Rework bounds declarations for subroutine array arguments, both in + caller (explicitly subset argument by bounds) and callee (use + assumed-shape array arguments rather than declaring upper bounds), and + add assertions on array sizes +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 + - also remove some now-unneeded temporary arrays + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + - also reorder a loop to get better performance +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 + +========= Fix crop threading bug (1598), in both clm4.5 and clm4.0, by reworking + where nyrs is updated +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 + +========= Add comments +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 + +========= Fix size of a megan variable +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + - also initialize rootr, as it was in clm4_5_20 and prior +M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 + +========= Fix some hist file bugs: + - increase max number of characters allowed for hist field names + - when adding a field, make it work to say default='active' -- + previously, explicitly setting default='active' did the same thing + as setting default='inactive' + - change ptr_pft to ptr_col for a few column-level history variables + - remove two duplicate hist_addfld calls +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + - also add some bounds to array arguments +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +========= Add f10 initial file for CLM45 BGCCROP, for testing +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Remove some PET tests from the xFail list; note that some PET tests + still fail due to bug 1820 +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_28 + +Changes answers relative to baseline: NO, with the following minor exceptions: + + In general, no answer changes for non-threaded runs (changes answers for + threaded runs due to significant bug fixes!) + + Changes answers for CLM45 BGC CROP at f10 due to new initial conditions + (instead of cold start) + +=============================================================== +=============================================================== +Tag name: clm4_5_28 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Sep 20 21:29:39 MDT 2013 +One-line Summary: fix FracH2oSfc bug + +Purpose of changes: + +Fix bug 1811: FracH2oSfc is called from within a loop over all points. Sean +Swenson realized that the offending block of code is no longer needed, so we +have removed it. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1811 (FracH2oSfc is called from within a loop +over all points) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove the offending (and no longer needed) block of code +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +========= Remove a now-unused variable +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Move xFail test to the right location +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + See notes below on answer changes + + +CLM tag used for the baseline comparisons: clm4_5_27 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45 cases + - what platforms/compilers: All + - nature of change: larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Sean Swenson performed two 20-year runs with and without the fix. His report + is: + + There are some differences, mainly in runoff, and it looks like at the 1% + level mostly, with a few scattered points showing up on the significance + plots. Other fields like latent heat, soil moisture/temperature, or water + table show even less differences. + + http://www.cgd.ucar.edu/staff/swensosc/public/diagnostics/test_frach2o-test_no_frach2o/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm4_5_27 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Sep 20 20:43:16 MDT 2013 +One-line Summary: fix crop nyrs bug + +Purpose of changes: Fix bug 1815 (nyrs is incorrect at the start of a crop run, +leading to incorrect GDD values for the first 20 years or so of a crop +simulation) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 1815 (nyrs is incorrect at the start of a crop run, leading to incorrect GDD +values for the first 20 years or so of a crop simulation) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None (but see changes to boundary +datasets below) + +List any changes to the defaults for the boundary datasets: + + New crop initial conditions for CLM4.5 BGCCROP @ f19 - same as old dataset, + but with restyear changed from 1 to 0 + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Don't increment nyrs on the first timestep of a startup run, so that + nyrs is correctly 0 rather than 1 for the first year +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 + +========= New crop initial conditions for CLM4.5 BGCCROP @ f19 - same as old dataset, + but with restyear changed from 1 to 0 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= add test that sometimes runs out of time, move test from + yellowstone_intel to yellowstone_pgi +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + - expected diffs in SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel + - baselines messed up for + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel, so comparison not + done for that test + yellowstone_pgi: NO BASELINES, SO COMPARISONS NOT RUN + +CLM tag used for the baseline comparisons: clm4_5_27 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All crop cases (clm4.0 or clm4.5) that either + use arbitrary initial conditions or use the clm4.5 out-of-the-box initial + conditions for BGCCROP @ f19 + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new + climate): new climate + + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + Sam Levis examined a 3-year run with arbitrary initial conditions, and + verified that crop LAI is much more realistic in the new simulation + (previously, crop LAI was near-zero for the first few years) + +=============================================================== +=============================================================== +Tag name: clm4_5_26 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 19 17:07:11 MDT 2013 +One-line Summary: water balance and SMS_Ly1.f19_g16.ICLM45BGCCROP fix + +Purpose of changes: 1) Fix water balance error in f09_g16 I1850CRUCLM45BGC simulation + 2) Get all machine/compiler combinations of + SMS_Ly1.f19_g16.ICLM45BGCCROP working + - this fix required (1) and a fix to fthresh in RtmFloodInit + - new RTM tag rtm1_0_32 to go along with this + - PGI+frankfurt version of this test only work with 16 MPI processes + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID):1808 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: S. Swenson, D. Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): rtm1_0_32 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Index: models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +=================================================================== +--- models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 (revision 51190) ++++ models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 (working copy) +@@ -1110,15 +1110,8 @@ + do j = 1, nlevsoi + if(h2osoi_liq(c,j)<0._r8)then + qflx_deficit(c) = qflx_deficit(c) - h2osoi_liq(c,j) +- h2osoi_liq(c,j) = 0._r8 + endif + enddo +- !reduce qcharge if necessary +- !ideally, I can set qflx_deficit as a local variable, but it is helpful +- !to diagnose the problem associated with the solver for the richards' equation. +- if(qflx_deficit(c)>0._r8)then +- qcharge(c) = qcharge(c) - qflx_deficit(c)/dtime +- endif + enddo + + end associate +@@ -1892,9 +1885,12 @@ + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) +- xs1(c) = max(max(h2osoi_liq(c,1),0._r8)-max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1))),0._r8) +- h2osoi_liq(c,1) = min(max(0._r8,pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)), h2osoi_liq(c,1)) + ++ !scs: watmin addition to fix water balance errors ++ xs1(c) = max(max(h2osoi_liq(c,1)-watmin,0._r8)- & ++ max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)-watmin)),0._r8) ++ h2osoi_liq(c,1) = h2osoi_liq(c,1) - xs1(c) ++ + if (urbpoi(clandunit(c))) then + qflx_rsub_sat(c) = xs1(c) / dtime + else + +CLM testing: + +- general note: for clm45 compsets-both clm and cpl history files change + +- specfic testing for these bug fixes: + +1) Water balance fix-ran a clone of run from Dave Lawrence: + -- create_newcase -compset I1850CRUCLM45BGC -res f09_g16 -mach yellowstone -case /glade/u/home/dlawren/expts/clm4.5/clm45bgc_1deg4519_1850spin_bd + -- this ran for over 25 years with no water balance errors. + +2) SMS_Ly1.f19_g16.ICLM45BGCCROP + +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel.clm-reduceOutput.115612 +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_pgi.clm-reduceOutput.115522 + +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_intel.clm-reduceOutput.115217 +PASS SMS_Ly1_Mmpich.f19_g16.ICLM45BGCCROP.frankfurt_nag.clm-reduceOutput.120824 +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_pgi.clm-reduceOutput.016 -- only with 16 MPI tasks + +3) To make sure the RTM refactor did not create any BFB changes, I ran SMS_D.f19_g16.ICLM45BGCCROP.yellowstone_intel + with rtm1_0_31 and rivrtm/branch_tags/bcf_tags/bcf_02_rtm1_0_31. + - With flood_mode='NULL' - Coupler and land history files were BFB. + - With flood_mode='ACTIVE' - Coupler, rtm and land history files were BFB. + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK - changes in cpl. hist files expected + yellowstone_pgi - OK - changes in cpl. hist files expected + frankfurt_intel - OK - changes in cpl. hist files expected + frankfurt_pgi - OK - changes in cpl. hist files expected + frankfurt_nag - OK - changes in cpl. hist files expected + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK - changes in clm fields expected. + +CLM tag used for the baseline comparisons: clm4_5_25 + +Changes answers relative to baseline: Yes. For CLM45 compsets. All changes are from the SoilHydrology mods +as the RTM refactor and fthresh fix are BFB. + +Coupler history fields that change: + +l2x_Sl_avsdr, l2x_Sl_anidr, l2x_Sl_avsdf, l2x_Sl_anidf, l2x_Sl_tref, l2x_Sl_qref, +l2x_Sl_t, l2x_Sl_fv, l2x_Sl_ram1, l2x_Sl_snowh, l2x_Sl_u10, l2x_Fall_swnet, +l2x_Fall_taux, l2x_Fall_tauy, l2x_Fall_lat, l2x_Fall_sen, l2x_Fall_lwup, +l2x_Fall_evap, l2x_Fall_flxdst1, l2x_Fall_flxdst2, l2x_Fall_flxdst3, l2x_Fall_flxdst4, +l2x_Flrl_rofl, l2x_Fall_voc001, l2x_Fall_voc002, l2x_Fall_voc003, l2x_Fall_voc004, +l2x_Fall_voc005, l2x_Fall_voc006, l2x_Fall_voc007, l2x_Fall_voc008, x2l_Flrr_volr, +r2x_Forr_rofl, r2x_Forr_rofi, r2x_Flrr_volr, x2r_Flrl_rofl + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 compsets + - what platforms/compilers: All + +=============================================================== +=============================================================== +Tag name: clm4_5_25 +Originator(s): erik (Erik Kluzek) +Date: Fri Sep 13 13:49:45 MDT 2013 +One-line Summary: Bring in Tony's changes to kick sno all the way up to the coupler layer, makes all + CESM components more similar to each other + +Purpose of changes: + Bring in Tony's cplupa branch (cplupa_n06_clm4_5_24) to trunk. This branch moves sno + fields all the way to the top coupler layer rather than being inside of CLM. This makes all + CESM components more similar to each other. + + There was also some small fixes on the side that allow some more tests to work. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1789 (fix NoVSNoNI test) + 1788 (fix US-UMB test) + 1779 (fix RTM multi-instance) + 1777 (fix RTM branch cases) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add new CPP token to CLM USE_ESMF_METADATA (with no direct machanism to use) + We hate CPP tokens (but had to let this go, only needed by ESMF development folks) + +Describe any changes made to the namelist: drv namelist changes, no changes to CLM namelist + +List any changes to the defaults for the boundary datasets: CLM_USRDAT fsurdat files different directory for clm4_0 than clm4_5 + remove missing ne16np4 fpftdyn file + +Describe any substantial timing or memory changes: + +Code reviewed by: self, tcraig + +List any svn externals directories updated (csm_share, mct, etc.):, scripts, drv, cism, rtm, csm_share, data and stub models + + scripts to scripts4_130912 + drv to drvseq4_3_03 + datm to datm8_130424 + socn/sice/sglc/swav to stubs1_4_02 + rtm to rtm1_0_31 + cism to cism1_130905 + csm_share to share3_130906 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ------------ Remove ne16 20thC test + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ---- Remove missing ne16 fpftdyn file + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Different directory for + clm4_0/clm4_5 surface datasets + + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Field names change + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ------ Remove "sno" and "s" fields + M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 ---- Remove rofi/rofl + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ---- Remove "sno" and "s" fields, add USE_ESMF_METADATA #ifdef + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 ----- Remove "sno" and "s" fields, add USE_ESMF_METADATA #ifdef + M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 ---- Remove rofi/rofl + +CLM testing: regular + + build-namelist tests: + + bluefire yes + frankfurt yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel partial (not completed before tag made) + yellowstone_pgi partial (not completed before tag made) + +CLM tag used for the baseline comparisons: clm4_5_24 + +Changes answers relative to baseline: None (bit-for-bit) + + Although my "I compset" testing showed no changes, fully coupled changes + do show differences. Coupler namelists also change. + +=============================================================== +=============================================================== +Tag name: clm4_5_24 +Originator(s): sacks (sacks) +Date: Tue Sep 3 21:36:13 MDT 2013 +One-line Summary: update externals to cesm1_3_beta02 or later + +Purpose of changes: + +Update externals to cesm1_3_beta02 or later + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1722 (Test failure with VIC and more_vertlayers) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not investigated + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts : scripts4_130816 -> scripts4_130830a + Machines : Machines_130529 -> Machines_130830 + drv : drvseq4_2_33 -> drvseq4_2_35 + cism : cism1_130502 -> cism1_130624 + csm_share : share3_130528 -> share3_130723 + timing : timing_130417 -> timing_130506 + mct : compiler_fixes_n01_MCT_2.8.3 -> compiler_fixes_n03_MCT_2.8.3 + mapping : mapping_130509 -> mapping_130716 + gen_domain : mapping_130509/gen_domain_files -> mapping_130716/gen_domain_files + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove trailing whitespace +M .ChangeLog_template + + +Index: models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +=================================================================== +--- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (revision 50759) ++++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (working copy) +@@ -51,17 +51,14 @@ + + + use before define in history. runs with frankfurt_pgi, yellowstone_intel and yellowstone_pgi +- floating point exception. problem with VIC combined with vertical layers + once threading fixed, this should pass + once threading fixed, this should pass +- core dumps in ref1. Problems with vertical layers. Run without clm-vrtlay and clm-default and it runs + starting in clm4_5_07--The cpl.hi.nc file is not being copied on a generate like it should. + Cannot turn clm4me mode on -- without clm4_5 physics! problem in scripts4_130809b + + +- Problem with scripts and testId string length. This passes with a long testId ++ Problem with scripts and testId string length. This passes with a long testId + Restart not BFB. Runs as ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi +- floating point exception. problem with VIC combined with vertical layers + once threading fixed, this should pass + once threading fixed, this should pass + once threading fixed, this should pass +@@ -78,7 +75,7 @@ + Water balance errors followed by "negative conc. in ch4tran", then tries "-10^-12 < smin_nh4 < 0. resetting to zero.", then it exits at approximately 9 months. This same test passes with yellowstone_intel and frankfurt_intel + + +- CMake 2.8.6 or higher is required. You are running version 2.6.4 ++ Problem with cism build + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel, yellowstone_pgi, frankfurt_intel and frankfurt_nag + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel, yellowstone_pgi, frankfurt_intel and frankfurt_nag + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel + + +CLM testing: + + build-namelist tests: + + yellowstone: YES + All PASS or xFAIL + + regular tests (aux_clm): + + yellowstone_intel: YES + yellowstone_pgi: YES + frankfurt_intel: YES + frankfurt_pgi: YES + frankfurt_nag: YES + + All PASS or xFAIL + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: YES + All PASS except for the following newly-passing tests (for + which these failures are unsurprising): + + BFAIL2 ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h0 (baseline history file does not exist) + BFAIL2 ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h1 (baseline history file does not exist) + FAIL ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h0 + FAIL ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h1 + + yellowstone_pgi: YES + Some answer changes (presumably due to compiler change) + +CLM tag used for the baseline comparisons: clm4_5_23 + Note: renamed baselines for frankfurt nag because test names have changed + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + compsets using cism change answers for g2x gields + + many tests change answers with pgi, both on yellowstone & + frankfurt, presumably due to new compiler + + nature of change not investigated + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_23 +Originator(s): muszala (Stefan Muszala) +Date: Thu Aug 22 09:42:43 MDT 2013 +One-line Summary: refactor to allow CH4 params. to be read from netcdf file and clean up clm4_5_20 + +Purpose of changes: + The second of two tags that brings in parameters that are read from netcdf file (ch4 parameters). Please + see the ChangeLog entry for clm4_5_20. + + - Bring in ch4 parameters + - Combine fconsts file and fpftcon file. New file name is paramfile (clm_params.c130821.nc) + - Refactor so that types, subroutine names and type instances have the names params in them (instead of consts) + - Remove many ch4 namelist vars. since they are now read from the param file + - Add new namelist called use_aereoxid_prog to control old aereoxid namelist + + A bulk of this work was completed by Rajendra Paudel. + +Requirements for tag: N/A + +Test level of tag: regular and build_namelist + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: remove many optional ch4 namelists. + add new namelist valled use_aereoxid_prog. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, dlawren, Rajendra Paudel + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_130730 -> scripts4_130816 + +List all files eliminated: + +- these were renamed +models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 +models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 + +List all files added and what they do: + +- renamed +models/lnd/clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +models/lnd/clm/src/clm4_5/main/readParamsMod.F90 + +List all existing files that have been modified, and describe the changes: + +- refactor to remove old namelist vars. for ch4 and add new functionality +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +- put in ch4 parameters and refactor const->params names +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: OK. Some changes to phys45 and phys45-crop. Should be OK in next tag. + + regular tests (aux_clm): A few nlcomp differences that will go away in the next tag. + Other than a few expected failures due to new scripts entries, all OK. + + yellowstone_intel OK + yellowstone_pgi OK + frankfurt_intel OK + frankfurt_pgi OK + frankfurt_nag OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel OK + yellowstone_pgi OK + +CLM tag used for the baseline comparisons: clm4_5_22 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_22 +Originator(s): muszala (Stefan Muszala) +Date: Tue Jul 30 15:22:51 MDT 2013 +One-line Summary: aux_clm testlist reorganization + +Purpose of changes: + + Reorganize all aux_clm tests and fix new failing tests. As part of + this, bring in a change from Maoyi for VIC w/vertical layers. + A few bug fixes to get new tests working. + Why did we do this? + + 1) better balance between frankfurt, yellowstone and various compilers + 2) faster turn around time for development + 3) make sure current science functionality is properly tested + 4) removed outdated / irrelevant tests + + Other points: + + 1) Introduce regular and short test list. Testing now can consist of: + + a) regular (must be run before handing off a tag to SEs and must be run + before committing a tag) + b) build_namelist (if namelists and/or build_system changed)) + c) tools (only if tools are modified and no CLM source is modified) + d) short (for use during development and in rare cases where only a small + change with known behavior is added ... eg. a minor bug fix) + e) doc (no source testing required) + + 2) PET tests will fail until threading is fixed in CLM + +Requirements for tag: N/A + +Test level of tag: regular. ran tests with old testlists to double check any new mods. + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: add no-vert:no-nitrif option to configure + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self. Extensive discussion regaring list content with Lawrence, + Sacks, Kluzek and Andre. + +List any svn externals directories updated (csm_share, mct, etc.): new scripts + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- add no-vert:no-nitrif option +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +- Update expected failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +- Maoyi VIC+vertical layers fix +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +- Update change log template +M .ChangeLog_template +- Change intent out to inout for ciso_flux +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +- Remove crop_prog check to get rid of unassociated pointer with NAG +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +- Fix bounds type error (should be intent=in) +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +Machines testing ran on: (Tests in priority order) + + Note: + + 1) All PET tests will fail until openMP is fixed. + 2) All IG compsets fail with the NAG compiler due to non-compliant f77 code. + 3) If one combination fails, it's backed up with a another combination that passes. + There are one or two exceptions to this. + + I) aux_clm tests with old testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + CESM history file comparison: + + yellowstone/aux_clm intel - OK + + II) aux_clm tests with new testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + III) aux_clm_short tests with new testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + CESM history file comparison: Not run since no baseline comparisons. + +CLM tag used for the baseline comparison tests if applicable: CLM4_5_21 with old testlist. Only ran generate with new testlists. + +Changes answers relative to baseline: Only for VIC with vertical layers. + +=============================================================== +=============================================================== +Tag name: clm4_5_21 +Originator(s): muszala (Stefan Muszala) +Date: Wed Jul 24 14:23:19 MDT 2013 +One-line Summary: ifdef and bounds refactor + +Purpose of changes: +- Almost all implementation by Mvertens +- Refactor ifdef use so that a majority are now in controlMod.F90. This is the +first step to removing them competely. +- Introduction of bounds_type and clump_type +- Refactor interfaces to support bounds_type and clump_type +- Bug fix from Sacks + +Also: Changed layout of landunit, column and pft-level arrays: Previously, all +points for a given grid cell were grouped together. Now, all points for a given +landunit type are grouped together. This improves performance of loops over +filters, because it leads to more memory locality – this will be especially true +when we add more 0-weight points to arrays for the purpose of dynamic +landunits. For example, if a processor has 2 grid cells and there are 3 landunit +types: + +Old layout in memory: (G1L1, G1L2, G1L3, G2L1, G2L2, G2L3) +New layout in memory: (G1L1, G2L1, G1L2, G2L2, G1L3, G2L3) + + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: mvertens, sacks, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +D models/lnd/clm/src/util_share/decompInitMod.F90 +D models/lnd/clm/src/util_share/ndepStreamMod.F90 +D models/lnd/clm/src/util_share/decompMod.F90 +D models/lnd/clm/src/clm4_5/main/initParametersMod.F90 + +List all files added and what they do: + +A + models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +A + models/lnd/clm/src/clm4_5/main/ndepStreamMod.F90 +A + models/lnd/clm/src/clm4_5/main/decompMod.F90 +A + models/lnd/clm/src/clm4_0/main/decompInitMod.F90 +A + models/lnd/clm/src/clm4_0/main/ndepStreamMod.F90 +A + models/lnd/clm/src/clm4_0/main/decompMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/doc/ChangeLog +M models/lnd/clm/doc/ChangeSum +M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/QSatMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: Not run + + CESM test lists: + + yellowstone/aux_clm intel BFB + yellowstone/aux_clm pgi BFB + frankfurt/aux_clm intel BFB + frankfurt/aux_clm pgi BFB + frankfurt/aux_clm nag BFB + + CESM history file comparison: + + yellowstone/aux_clm intel BFB + +CLM tag used for the baseline comparison tests if applicable: clm4_5_20 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_20 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Sat Jul 20 10:54:43 MDT 2013 +One-line Summary: refactor to allow CN and BGC params. to be read from netcdf file + +Purpose of changes: + +The first of two tags that allows all parameters to be read from a netcdf file to +provide sensitivity analysis capability, to increase modularity of code and to +remove "magic numbers" from code. This tag introduces a new namelist variable +"fconsts" which points to a netcdf file of CN and BGC parameters. In a future +tag, this netcdf file will be combined with CH4 parameters and PFT parameters. + +Values are read in readConstantsMod.F90. Each module that requires +a parameter provides a read subroutine. That read subroutine is called +from readConstantsMod.F90 and places parameters into a private type +for that module. For example, CNDecompMod.F90 provides readCNDecompConsts which +is called from readConstantsMod and populates the type instance CNConstShareInst. +CHConstShareInst is then used in CNDecompMod as: + ++ sminn_to_denit_decomp_cascade_vr(c,j,k) = -CNDecompConstInst%dnp * pmnf_decomp_cascade(c,j,k + +which replaces: + +- dnp = 0.01_r8 +... +- sminn_to_denit_decomp_cascade_vr(c,j,k) = -dnp * pmnf_decomp_cascade(c,j,k) + +A bulk of this work was completed by Rajendra Paudel. + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: new namelist variable called fconsts. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, D. Lawrence, R. Paudel. (for design: discussion w/ mvertens, sacks, kluzek) + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +Renamed +D models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +D models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 + +List all files added and what they do: + +Rename of Deleted files +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 + +Module to read parameters shared by multiple modules +A + models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 + +Module that reads shared an private parameters +A + models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 + +List all existing files that have been modified, and describe the changes: + +Add fconsts namelist variable +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +Add in functionality to read parameters off of netcdf file +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. These FAILs should pass next round: + + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + CESM test lists: + +CLM45 compsets have failures for nlcomp due to the introduction of fconsts namelist variable. +For example: + +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.test20Pgi.nlcomp +FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_intel.GC.test20Intel.nlcomp + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CLM history file comparison: + + yellowstone/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_19 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_19 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Wed Jul 17 14:29:32 MDT 2013 +One-line Summary: fix setting of bd in iniTimeConst + +Purpose of changes: + +In iniTimeConst, bd (bulk density) was being set incorrectly, so that, +for a given processor, the same value was being put in all (c,j) +locations. In addition to being incorrect, this meant that results +differed depending on processor count. This tag fixes this problem. + +This only affects CLM4.5 BGC runs, because the bd array is only used +in CNNitrifDenitrifMod.F90. (However, as a side note: This array +SHOULD be used in DUSTMod and initSLakeMod, which currently recompute +bd.) + + +Requirements for tag: + +Test level of tag: + +Bugs fixed (include bugzilla ID): + 1736 (bd set incorrectly in iniTimeConst, leads to results that depend on processor count) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: NO + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL1 except CLM45BGC comparisons + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_18 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45BGC + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Larger than roundoff; still to be determined if this gives new + climate (Dave Lawrence will run a simulation to determine this) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: (Not yet done) + + URL for LMWG diagnostics output used to validate new climate: (Not + yet done) + +=============================================================== +=============================================================== +Tag name: clm4_5_18 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jul 9 10:07:08 MDT 2013 +One-line Summary: rework urban indexing + +Purpose of changes: + +Change urban derived type and local variables in UrbanMod subroutines to go +lbl:ubl rather than 1:num_urbanl. There are a few reasons for this: (1) this +works better when the urban filter can change (with dynamic landunits), (2) more +consistency with the rest of the CLM code, (3) no longer have to remember +whether a given variable should be indexed by fl or l. The downside is that it +leads to slightly greater memory use. + +Along with doing this, I also changed a few loops in UrbanMod to be simpler +(which is allowed with the above change). + +Also, no longer run over 0-weight urban columns - we don't have to do this any +more now that I have reworked some loops in UrbanMod. + + +Requirements for tag: + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + + Increase in memory use by UrbanMod, which should lead to a small overall + memory increase - though this doesn't show up in most memcomp tests, showing + that the increase is pretty small. + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Major changes to indexing: local variables now dimensioned lbl:ubl + rather than 1:num_urbanl. Also, remove canyon_hwr, wtroad_perv, + ht_roof and wtlunit_roof from urban_params, because there are + duplicate variables in clmtype. +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= No longer make 0-weight urban columns active +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Remove unused wind_hgt_canyon from clmtype +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 + +========= Minor changes for new UrbanMod interfaces +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: NO + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes ** + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS, except the following, which appears to be a system problem: + FAIL ERI_D.f19_g16.ICLM45.frankfurt_pgi.GC.214513 + I will rerun the above test once the system problem is resolved + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL, except the following expected failures: + + *** Expected failures because of failures in the base tests + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_Ld211_D_P112x1.f10_f10.ICNCROP.yellowstone_intel.clm-crop.compare_hist.clm4_5_17.clm2.h0 (no history file in test case) + + *** Expected differences in cols1d_active and pfts1d_active, as well as + FILLDIFFs, due to making 0-weight urban columns no longer active + FAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set2_ciso.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set3_pftroot.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_17 + +Changes answers relative to baseline: NO, except for inconsequential changes in +1-d hist files (cols1d_active, pfts1d_active, and some FILLDIFFS, due to making +0-weight urban columns no longer active) + +=============================================================== +=============================================================== +Tag name: clm4_5_17 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Wed Jul 3 10:54:03 MDT 2013 +One-line Summary: misc cleanup and bug fixes + +Purpose of changes: + +Bit-for-bit cleanup following from tag clm4_5_11. The biggest change is the +removal of maxpatch, npatch_* and some related variables from clm_varpar (these +were maintenance headaches). + + +Requirements for tag: + +Test level of tag: standard + tools + +Bugs fixed (include bugzilla ID): + + 1747 (need 1x1_tropicAtl datasets) + 1754 (mksurfdata_map problem making CH4 parameters for ne240 CLM4.5 surface dataset) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New 1x1_tropicAtl datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove maxpatch, npatch_* and a few related variables that are no + longer needed (these variables were a maintenance headache) +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +========= Rework code to not require the variables that were removed from clm_varpar +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 + +========= Remove unneeded 'use' statements +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + +========= Allow roundoff-level errors (needed to make ne240 dataset) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 + +========= Fix generation of 1x1_tropicAtl datasets +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +========= New 1x1_tropicAtl datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes ** + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + Additional tests (with comparison to clm4_5_16, including + component_gen_comp; for the FARM test, used a sandbox corresponding to + cesm1_3_alpha01a for components other than CLM): + + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial + SMS.T42_T42.FARM95C4.yellowstone_intel.clm-daily + [the clm-daily nl dir just sets hist_nhtfrq = -24] + + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL1, except irrelevant failures from this failing test: + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_16.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_16.clm2.h1 + + test_driver.sh tools testing: + + yellowstone interactive: yes + All PASS except expected failures: + + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=4 FAIL + + + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_16 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_16 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jul 2 09:22:41 MDT 2013 +One-line Summary: only run filters over 'active' points + +Purpose of changes: + +In preparation for dynamic landunits, we only want to run most filters over +'active' points. This required changing landunit and column-level filters to +only run over active points. In addition, I changed the nourbanp filter to only +run over active points (in contrast to other pft-level filters, this filter had +previously operated over non-active points, too). + +In addition, this tag includes some related changes, most of which were required +to get the code to run correctly in light of the above changes. Some of these +changes - in particular, the changes to reweightMod, filterMod, and the use of +the new filter_inactive_and_active in some places - effectively undid that +general filter change for select landunits (urban) or subroutine calls. + + +Requirements for tag: + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: changes to filterMod reviewed by erik, mvertens, + stefan, dave lawrence & ben andre; other changes + only by self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Change main filters to just run over active points; add new filters + that include inactive as well as active points; refactor subroutines + to avoid code duplication now that we have two groups of filters +M models/lnd/clm/src/clm4_5/main/filterMod.F90 + +========= Change filter to just run over active points +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 + +========= Change urban columns & pfts to be active whenever their landunit is + active (to avoid making urban code messier) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Get rid of wt > 0 checks, which are no longer appropriate in the code + (checks of the active flags should be done instead - and these have + been folded in to the filters) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= Make a loop more consistent in its use of a filter; remove undesirable + pactive check (because decomp_vertprofiles now sometimes operates on + inactive as well as active points) +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 + +========= Use filters that include inactive points in call to + decomp_vertprofiles (this is needed because of the unusual placement + of this routine in the driver sequence) +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Use filters that include inactive points in calls to SurfaceAlbedo and + UrbanAlbedo. For SurfaceAlbedo, this is necessary to avoid floating + point exceptions in transient cases; for UrbanAlbedo, this probably + isn't necessary now, but likely will be needed when we have dynamic + landunits, for the same reason that we need it for SurfaceAlbedo. +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 + +========= Remove pactive check in setting up vegsol / novegsol filters - as far + as I can tell, this check is now unnecessary, and it led to the odd + result that novegsol included all inactive points (e.g., even inactive + istsoil points). Also add some comments and remove some obsolete + comments. +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + +========= Remove pactive checks that are unnecessary now that the nourbanp + definition has changed +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 + +========= Only check errsoi_col on active columns (to prevent NaN-related + problems in crop runs) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Add comments +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 + + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/aux_clm intel yes + All PASS or xFail + + Also ran the following, which PASSes (also PASSes cpl & clm + hist comparisons, except for expected failures in .h1 file + comparisons, as below): + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial + + yellowstone/aux_clm pgi yes + All PASS + + frankfurt/aux_clm intel yes + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + All PASS, except: + *** Irrelevant, because this test fails + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h1 + + *** Expected diffs in h1 files: differences in cols1d_active, + pfts1d_active, and related FILLDIFFs in a number of variables + FAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set2_ciso.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set3_pftroot.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_15 + +Changes answers relative to baseline: NO, except for changes in fill +patterns & active flags in 1-d hist files, as noted above + +=============================================================== +=============================================================== +Tag name: clm4_5_15 +Originator(s): muszala (Stefan Muszala) +Date: Mon Jul 1 10:44:05 MDT 2013 +One-line Summary: complete associate refactor for pointers in clm4_5 source + +Purpose of changes: Refactor all clm4_5 source so that pointers assignements are + placed in associate blocks at the start of a subroutine. This allows us to + get rid of pointer declarations, makes the code easier to modify, makes the + code more robust and sets us up for future interface refactorings. The refactor is + explained in more detail in models/lnd/clm/tools/clm4_5/refactorTools/README. + +- real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) +- fdry => pps%fdry ++ associate(& ++ fdry => pps%fdry & ! Output: [real(r8) (:)] fraction of foliage that is green and dry [-] (new) ++ ) + ... +- end subroutine FracWet ++ end associate ++ end subroutine FracWet + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: BGC compsets will see increases + in memory (highwater) use. This can be seen in memcomp portions of testing with + one specific example. Something to keep track of. + + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.GC.4515preIntel.memcomp.clm4_5_14 + - highwater goes from 166 MB in clm4_5_14 to 236 MB in clm4_5_15 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOff.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOff.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOn.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnIceOn.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16_r01.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOff.GC.4515preIntel.memcomp.clm4_5_14 + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + +A models/lnd/clm/tools/clm4_5/refactorTools/associate/refactor_new.pl +A models/lnd/clm/tools/clm4_5/refactorTools/associate/README + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + + yellowstone/aux_clm OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_14 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_14 +Originator(s): muszala (Stefan Muszala) +Date: Thu Jun 20 07:51:54 MDT 2013 +One-line Summary: preparation for associate refactor in clm4_5_15 + +Purpose of changes: + Most work by mvertens. + - prep. work for modifying associate + - refactor subgridAveMod.F90 to accept upper and lower bounds + - remove duplicate pointer uses + - remove inicPerpMod.F90 and is_perpetual use + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +D models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. Fixed generate numbering. + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_13 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_13 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Fri Jun 14 15:01:33 MDT 2013 +One-line Summary: hydrology reordering from Jinyun Tang + +Purpose of changes: + reordering the operations of the hydrology. hydrology with and without drainage + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Jinyun Tang, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 - splits out leaching + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - add icefrac and qflx_deficit + M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 - update calls to CNEcosystemDyn + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 - update calls to CNEcosystemDyn and Hydrology + M models/lnd/clm/src/clm4_5/main/clmtype.F90 - add icefrac and qflx_deficit + M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 - splits out drainage calculations + M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 - calculate water table before subsurface drainage, icefraction, water deficit + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes/no *** + + CESM test lists: + + yellowstone/aux_clm intel yes OK + yellowstone/aux_clm pgi yes OK + frankfurt/aux_clm intel no + frankfurt/aux_clm pgi no + frankfurt/aux_clm nag no + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + test_driver.sh tools testing: N/A + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_12 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: all clm 4.5 with hydrology + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + casename: ERS_D.f19_g16.ICLM45 - an 11-year base line simulation + was created with the standard trunk version, then a comparison run + was created with the version including hydrology re-ordering. The + comparisons were evaluated by looking at the relative differences + for hydrologic variables as QDRAI, EFLX_LH_TOT, QRUNOFF. Large + relative differences were found for these variables in a few grid + cells, but their absolute magnitudes in those grid cells were + small. Tests were also conducted with VIC hydrology on, the + change in results were similar as that when VIC hydrology was off. + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_12 +Originator(s): muszala (Stefan Muszala) +Date: Thu Jun 13 09:41:56 MDT 2013 +One-line Summary: NoVS test, NAG mods and remove TWS from restart file + +Purpose of changes: + + -Fix (from jedwards) for ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit test + Previous tags using ICLM45BGCNoVS are suspect! + -Since I tested this with NAG there are also port mods to CLM that I had to put in. + -Remove TWS from BiogeophysRestMod.F90 per sacks request. OK'd by swenson. + -Update to rtm1_0_29 + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): 1746 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, NoVs error: Charlie Koven and jedwards + +List any svn externals directories updated (csm_share, mct, etc.): rtm1_0_28 -> rtm1_0_29 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-NoVS fix and NAG mods +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +-Nag mods +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +-remove TWS from restart +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +-update to rtm1_0_29 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel OK. The only differences are in ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit. + These are expected due to the fix in ch4Mod.F90. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_11 + +Changes answers relative to baseline: Only for ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit. Previous + versions of this compset should be considered suspect. Fields that change (119 in total) for this test are: + + ACTUAL_IMMOB, CH4STRESS_SAT, CH4STRESS_UNSAT, CH4_AERE_DEPTH_SAT, CH4_AERE_DEPTH_UNSAT, CH4_EBUL_DEPTH_SAT, + CH4_OXID_DEPTH_SAT, CH4_OXID_DEPTH_UNSAT, CH4_PROD_DEPTH_SAT, CH4_SURF_AERE_SAT, CH4_SURF_AERE_UNSAT, + CH4_SURF_DIFF_SAT, CH4_SURF_DIFF_UNSAT, CH4_SURF_EBUL_SAT, CH4_TRAN_DEPTH_SAT, CH4_TRAN_DEPTH_UNSAT, + COL_CTRUNC, COL_NTRUNC, CONC_CH4_SAT, CONC_CH4_UNSAT, CONC_O2_SAT, CONC_O2_UNSAT, CWDC, CWDC_LOSS, + CWDC_TO_LITR2C, CWDC_TO_LITR3C, CWDN, CWDN_TO_LITR2N, CWDN_TO_LITR3N, DENIT, ER, FCH4, FCH4TOCO2, + FUELC, F_DENIT, F_N2O_DENIT, F_N2O_NIT, F_NIT, GROSS_NMIN, HR, LAND_UPTAKE, LITHR, LITR1C, LITR1C_TO_SOIL1C, + LITR1N, LITR1N_TO_SOIL1N, LITR1_HR, LITR2C, LITR2C_TO_SOIL1C, LITR2N, LITR2N_TO_SOIL1N, LITR2_HR, LITR3C, + LITR3C_TO_SOIL2C, LITR3N, LITR3N_TO_SOIL2N, LITR3_HR, LITTERC, LITTERC_HR, LITTERC_LOSS, NBP, NEE, NEM, NEP, + NET_NMIN, O2STRESS_SAT, O2_AERE_DEPTH_SAT, O2_DECOMP_DEPTH_SAT, O2_DECOMP_DEPTH_UNSAT, POTENTIAL_IMMOB, + POT_F_DENIT, POT_F_NIT, SMINN_TO_SOIL1N_L1, SMINN_TO_SOIL1N_L2, SMINN_TO_SOIL1N_S2, SMINN_TO_SOIL1N_S3, + SMINN_TO_SOIL2N_L3, SMINN_TO_SOIL2N_S1, SMINN_TO_SOIL3N_S1, SMINN_TO_SOIL3N_S2, SMIN_NH4, SMIN_NO3, + SMIN_NO3_LEACHED, SOIL1C, SOIL1C_TO_SOIL2C, SOIL1C_TO_SOIL3C, SOIL1N, SOIL1N_TO_SOIL2N, SOIL1N_TO_SOIL3N, + SOIL1_HR_S2, SOIL1_HR_S3, SOIL2C, SOIL2C_TO_SOIL1C, SOIL2C_TO_SOIL3C, SOIL2N, SOIL2N_TO_SOIL1N, + SOIL2N_TO_SOIL3N, SOIL2_HR_S1, SOIL2_HR_S3, SOIL3C, SOIL3C_TO_SOIL1C, SOIL3N, SOIL3N_TO_SOIL1N, SOIL3_HR, + SOILC, SOILC_HR, SOILC_LOSS, SOMHR, SR, TOTCOLC, TOTCOLCH4, TOTCOLN, TOTECOSYSC, TOTECOSYSN, TOTLITC, TOTLITN, + TOTSOMC, TOTSOMN + +=============================================================== +=============================================================== +Tag name: clm4_5_11 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jun 11 20:54:11 MDT 2013 +One-line Summary: Change pct_pft and related surface dataset variables to be % of landunit + +Purpose of changes: + +Main purpose is to change pct_pft and related surface dataset variables to be % +of landunit rather than % of grid cell. This is needed to support transient PFTs +with dynamic landunits. This required substantial changes in both mksurfdata_map +and CLM. This also required generating all new surface datasets. + +A very related change is the separation of PCT_PFT in the surface dataset into +PCT_NAT_PFT and PCT_CFT; in addition to these two variables, there are also new +PCT_NATVEG (% of natural veg landunit on the gridcell) and PCT_CROP (% of crop +landunit on the gridcell) variables. Note that the separation of PCT_PFT into +natural vs crop was only done on the surface dataset -- raw datasets to +mksurfdata_map have not been changed, nor have most of the CLM data structures. + +In addition, this tag includes the following: + +(1) Renumbered landunits to (a) add separate landunit numbers for each urban +landunit, (b) do away with the obsolete shallow lake, and (c) group together +similar landunits + +(2) In any urban landunit, allocate space for ALL urban columns. Previously, +there were some urban landunits with only one of the two road types. This change +simplifies the code and only adds a relatively small number of columns in memory. + +(3) Modified interpinic, partly to have compatibility with (1), partly to fix +urban bug (allowed by (1)), and partly to fix an unrelated bug + +(4) All new initial conditions for CLM4.5, to have compatibility with (1) and (2) + +(5) Check _OPENMP in initialization rather than driver + +(6) Tighten error check in reweightMod: checkWeights. It seems like this error +check can be stricter with the new pct_pft formulation + + +Requirements for tag: Standard test + tools + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1621 (normalization issue in ne120np4 datasets and in CLM) + 1675 (need to relax error tolerance in reweightMod: weightsOkay) -- note + that I have actually TIGHTENED the tolerance, but that seems to be + okay now + 1702- PARTIAL FIX (clm4.5 interpinic doesn't work right for urban) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1747 - need 1x1_tropicAtl surface dataset and pftdyn dataset for clm4_5_11 and later + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Changes to fsurdat and finidat for +CLM4.5, as described below + +List any changes to the defaults for the boundary datasets: + + For CLM4.5, all surface datasets and initial conditions files have been + recreated. For surface datasets, changes result in only roundoff-level + differences in the pct_* fields. For initial conditions, the new initial + conditions are effectively the same as the old, but bugs in interpinic + prevent them from being exactly the same. + +Describe any substantial timing or memory changes: + + Slight (probably < 1%) increase in memory for all CLM4.5 cases, due to + allocation of ALL urban columns wherever there is an urban landunit + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): NONE + +List all files eliminated: + +========= Remove unneeded modules (iulog moved to fileutils.F90) +D models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varpar.F90 +D models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varctl.F90 + +========= Now differs for clm4_0 and clm4_5, so copied to those two places +D models/lnd/clm/src/util_share/clm_varsur.F90 + +========= Replaced with new file for testing interpinic +D models/lnd/clm/tools/clm4_5/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c121113.nc + + +List all files added and what they do: + +========= New file for testing interpinic +A models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c130607.nc + +========= Add tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkpftMod.F90 + +========= Moved from util_share +A models/lnd/clm/src/clm4_0/main/clm_varsur.F90 + +========= Moved from util_share, and modified extensively to support new surface + dataset format +A models/lnd/clm/src/clm4_5/main/clm_varsur.F90 + +========= Add module to do some initialization that doesn't fit well elsewhere, + and/or can't go elsewhere because of circular dependencies +A models/lnd/clm/src/clm4_5/main/initParametersMod.F90 + + +List all existing files that have been modified, and describe the changes: + +========= Change pct_pft and related variables on surface dataset to be % of + landunit; this requires significant changes for mkpftMod, mkglcmecMod + and the error checks / corrections done in mksurfdat.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/fileutils.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Add tests +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 + +========= Update crop landunit numbering, fix urban bug for column-level + variables, take code out of a conditional to prevent floating point + exceptions +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + +========= New files for testing interpinic +M models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions + +========= Change landunit and column numbering; delete udenstype +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + +========= Add variables for determining number of natural & crop PFTs +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +========= Major changes to handle pct_pft being specified as % of landunit + rather than % of gridcell +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Initialize new surface variables, check _OPENMP here instead of driver +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= Update comments, remove udenstype +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Change 'use' statements, use ltype instead of udenstype, fix + initialization for 0-weight columns +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= Add some consistency checks (moved here from clmtypeInitMod), change others +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +========= Change 'use' statements; use urbpoi rather than isturb; remove + references to 'istslak' +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + -- also, remove udenstype, and move some consistency checks elsewhere +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + -- also, move _OPENMP check to initialization +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +========= Tighten tolerance for error check +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Use 'crop_prog' rather than the CROP CPP def +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + +========= New surface datasets and initial conditions +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Change environment variable in component_gen_comp command to something universal +M .ChangeLog_template + +========= Restore a failing test (see bug 1658) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + All PASS or xFail except for the following expected baseline failures: + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + + CESM test lists: + + yellowstone/aux_clm intel yes + Tests themselves: All PASS or xFail, except + ERB.ne30_g16.I_1948-2004.yellowstone_intel, which I have re-added to the + xFail list (see bugz 1658) + + Comparisons: Some nlcomp and compare_hist failures, as expected + + yellowstone/aux_clm pgi yes + All PASS or xFail except for some nlcomp & compare_hist failures (expected) + + frankfurt/aux_clm intel yes + All PASS or xFail except for some nlcomp & compare_hist failures (expected) + + frankfurt/aux_clm pgi NO + + frankfurt/aux_clm nag yes + All PASS or xFail except for nlcomp failures (expected) + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + + Some compare_hist failures for CLM4.5 tests, as expected + + test_driver.sh tools testing: + + yellowstone interactive: yes + All PASS except for expected baseline failures: + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................rc=7 FAIL + 016 blh54 TBLtools.sh clm4_5 interpinic tools__ds runoptions ....................................rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_rc=7 FAIL + + and expected failures: + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............rc=4 FAIL + + + frankfurt interactive: NO + + yellowstone/PTCLM: NO + +CLM tag used for the baseline comparison tests if applicable: clm4_5_10 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Changes in all CLM4.5 configurations. See below + for details + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Mostly roundoff, but some larger than roundoff -- see below for details. + + Changes are limited to CLM4.5. Where the below notes refer to "all + configurations", this is really limited to CLM4.5 configurations. + + For all configurations, there are roundoff-level changes due to + roundoff-level differences in subgrid weights. These changes can quickly + grow to greater than roundoff (which I believe is due to nonlinear + feedbacks with snow variables), but as described below, I have verified + that the root cause of differences is this roundoff-level change. + + For cases that use initial conditions, where these initial conditions were + previously interpinic'ed, there are greater-than-roundoff level changes + due to various bugs and limitations of interpinic (for example, some + fields, like tsai, are skipped). I took pains to ensure that, for cases + using original (non-interpinic'ed) initial conditions in clm4_5_10 and + prior, the new initial conditions are nearly identical to the old (but not + entirely identical, due to bug 1702 - see comment 2); this applies to most + f09 initial conditions. However, this was not practical for cases that + used interpinic'ed files; this applies to f19, ne30 and hcru initial + conditions, as well as f09 BGCDV initial conditions. So for this latter + set of cases, there can be large differences from clm4_5_10, especially at + the start of the simulation. + + There are also greater than roundoff-level changes for some glc_mec + virtual columns, because we now use information on topo_glc_mec whenever + we can. + + There are also greater than roundoff-level changes in subgrid weights in + virtual (0-weight) glc_mec and crop landunits, now that we no longer use + arbitrary subgrid weights there; I don't think this will affect anything + important, though. + + Some tests that exhibited larger-than-usual changes from baseline, in cpl + hist and/or clm hist files, were the following (ignoring changes that can + be explained by the above notes): + + ERS_Lm3.f19_g16.IGRCP60CLM45CN.yellowstone_intel + ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC + ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit + ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default + + From these results, it seems that large changes may occur more often in + glc_mec runs, even above and beyond the virtual column changes that are + expected, as noted above. + + For the four above tests, I verified that differences were attributable to + the roundoff-level changes in subgrid weights, using the procedure + documented below. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + In order to confirm that answers only differed by roundoff, I ran 7 + additional tests (these tests all had nl_dirs, but that was not central to + these tests, so I'm not listing them here): + + SMS_Lm1.f19_g16.I_1850_CLM45_BGC + SMS_Ly2.T31_g37.IG1850CLM45CN + SMS_Ly5.T31_g37.I20TRCRUCLM45BGC + SMS_Ly5.T31_g37.ICLM45BGCDV + SMS_Ly5.T31_g37.I_2000_CLM45_BGC + SMS_Ly5.f10_f10.ICLM45BGCDVCROP + SMS_Ly5.f10_f10.I_2000_CLM45_BGC_CROP + + Each test was done as follows: + + (1) Created baselines from clm4_5_04 + + (2) Ran tests from a branch (allocate_all_urban_cols), where all I changed + from the baseline was (a) wherever we have an urban landunit, create ALL + urban landunits, and (b) for f19, change finidat files to use a new, + interpinic'ed file based on the original. Confirmed that this was bfb with + (1) except for (a) 1-d history files (now have extra urban columns), and + (b) any CLM4.5 test that uses initial conditions, since interpinic is + currently broken for urban. + + Side-note: I actually confirmed bfb behavior for the full yellowstone + aux_clm test suite, in addition to the above 7 tests + + This extra branch was necessary because I cannot compare 1-d history files + directly between my main branch and the trunk, because of the extra urban + columns present in the new code. + + + (3) Ran these 7 tests from my main branch, off of clm4_5_04, comparing + with (2). For this comparison, I only confirmed that the subgrid weights + were the same within roundoff (up to about 1e-12 differences for the + transient case; smaller for other cases). Note that greater than + roundoff-level changes are seen in many other fields, presumably because + small differences in subgrid pft weights can cause differences in how + variables are averaged from pft to column. This, in turn, can lead to + larger changes due to nonlinearities in the system (e.g., snow). The + following steps were taken to confirm that other differences between my + branch and the trunk were only due to these small differences in subgrid + weights. + + That is, I am confirming that: + (a) the only differences in the branch are subgrid weights + (b) these subgrid weights only differ by roundoff + + + (4) Reran (2), but with extra code to write out subgrid weights (including + writing these weights at every time step for pftdyn) -- from branch + allocate_all_urban_cols_writeWeights + + (5) Reran (3), but with extra code to read the subgrid weights written in + (4). Confirmed that, with this one-off, my branch was bfb with (4). + + +=============================================================== +=============================================================== +Tag name: clm4_5_10 +Originator(s): muszala (Stefan Muszala) +Date: Mon Jun 10 13:10:31 MDT 2013 +One-line Summary: refactor clmtype + +Purpose of changes: Refactor clmtype so that there is only one level of indirection. + + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & +- ptr_pft=clm3%g%l%c%p%pef%sfc_frc_oc, set_urb=spval) ++ ptr_pft=pef%sfc_frc_oc, set_urb=spval) + +There is a README (with more detailed information) and a script to help with future merges in: + + models/lnd/clm/tools/clm4_5/refactorTools/clmType/{README & renameClmType.pl} + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + +- script and README for refactoring clmType +A models/lnd/clm/tools/clm4_5/refactorTools +A models/lnd/clm/tools/clm4_5/refactorTools/associate +A models/lnd/clm/tools/clm4_5/refactorTools/clmType +A models/lnd/clm/tools/clm4_5/refactorTools/clmType/renameClmType.pl +A models/lnd/clm/tools/clm4_5/refactorTools/clmType/README + +List all existing files that have been modified, and describe the changes: + +- major refactor in these to flatten clmtype +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +- change derived type access to match those of clmtype +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + + yellowstone/aux_clm intel + +CLM tag used for the baseline comparison tests if applicable: clm4_5_09 + +Changes answers relative to baseline: No. Everything in this refactor should be BFB. + +=============================================================== +=============================================================== +Tag name: clm4_5_09 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Jun 4 15:59:07 MDT 2013 +One-line Summary: volr and vic fix, update mct and rtm + +Purpose of changes: add volr area correction, minor vic fix from maoyi, update mct and + rtm externals + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, swenson + +List any svn externals directories updated (csm_share, mct, etc.): +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_27 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_28 + +-models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.3 ++models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n01_MCT_2.8.3 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- fix for VIC hydrology +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +- volr area correction +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +- mct and rtm update +M SVN_EXTERNAL_DIRECTORIES +- clean up +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_08 + +Changes answers relative to baseline: only for VIC compsets. VOLR diagnostic changes. + +=============================================================== +=============================================================== +Tag name: clm4_5_08 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Jun 3 13:29:30 MDT 2013 +One-line Summary: port for NAG compiler + +Purpose of changes: Bring in Sean Santos mods, port clm4_5 and test with the NAG compiler on Frankfurt. + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): 1721 - Jim Edwards fixed problem in PIO + +Known bugs (include bugzilla ID): 1722 - Error in some VIC tests starting in clm4_5_07 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Santos + +List any svn externals directories updated (csm_share, mct, etc.): PIO - update to pio1_7_2 + +List all files eliminated: + +D models/lnd/clm/src/util_share/nanMod.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/util_share/ndepStreamMod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/spmdMod.F90 +M models/lnd/clm/src/util_share/domainMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_0/main/subgridMod.F90 +M models/lnd/clm/src/clm4_0/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_0/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_0/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_0/main/histFileMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/biogeophys/SNICARMod.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: - OK. + + yellowstone/aux_clm intel - OK. + yellowstone/aux_clm pgi - OK. + One BFAIL for hcru_hcru which should pass next time around. Bug fixed when upgrading to pio1_7_2. + BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.08testPgi.compare_hist.clm4_5_07 + frankfurt/aux_clm intel - OK. + frankfurt/aux_clm pgi - OK. + frankfurt/aux_clm nag - OK. No baselines to compare against. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_07 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_07 +Originator(s): erik (Erik Kluzek) +Date: Fri May 31 02:49:45 MDT 2013 +One-line Summary: New spinup files for CLM45 AND RTM, work on PTCLM, turn drydep off by default, update externals + +Purpose of changes: + + Bring in new spinup finidat files (f09_g16@1850 for SP and BGC). interpinic to 2deg, hcru_hcru and ne30. + New spinup finidat files for BGCCROP and BGCDV (f19 and f09 respectively) + New spinup finidat files for 2000 (f09_g16 for SP and BGC) + Update RTM to bring in finidat_rtm files for either 1850 or 2000. + Update scripts, Machines, pio + scripts includes update for CLM40CRU hybrid startup + Turn drydep namelist off by default + Do a lot of work on getting PTCLM working and tools working for single-point. + +Requirements for tag: + New spinup files, fix bugs: 1708, 1700 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1715 (rmdups.ncl fails for no-overlap case) + 1714 (mkscripgrid.ncl doesn't calculate corners correctly.) + 1708 (Need Initial conditions for RTM) + 1706 (VIC tests fail) + 1700 (Memory leak in MPI layer on yellowstone) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: drydep namelist now OFF by default + +List any changes to the defaults for the boundary datasets: New initial conditions + Native initial conditions for f09 for: + I1850CLM45SP, I1850CLM45BGC, ICLM45SP, ICLM45BGC + Interpinic for: + I1850CLM45 & I1850CLM45BGC: f19, hcru_hcru, ne30 + ICLM45BGCCROP @ f19 + ICLM45BGCDB @ f09 + + ALSO NOTE THAT NOW RTM HAS INITIAL CONDITIONS FOR R05 -- SO RIVERFLOW CHANGES + FOR BOTH CLM45 AND CLM40 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): many + csm_share, pio, scripts, Machines, RTM, cprnc, mapping + + + scripts to scripts4_130529 (update PTCLM, send simyr to RTM, new IC for CLM40CRUCN) + csm_share to share3_130528 + rtm to rtm1_0_27 (Set startup initial condition files by -simyr flag) + Machines to Machines_130529 (Set hcru_hcru PE-layout, and PE-layout on yellowstone for f09 I cases) + pio to pio1_7_1 + cprnc to cprnc_130425 + mapping to mapping_130509 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/tools/TBLCFGtools.sh --- Correctly point to TSMCFGtools rather than TSMtools.sh. + + M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - Add -usr_mapdir option + + M models/lnd/clm/tools/shared/mkmapdata/rmdups.ncl ------ Exit early if n_s==0 + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh ---- Skip if file already exists, give + directory for rmdups.ncl + M models/lnd/clm/tools/shared/mkmapdata/mknoocnmap.pl --- Don't hide NCL output + M models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl Explicitly calculate corners + + M models/lnd/clm/bld/build-namelist - Set drydep to off by default, check crop setting for finidat files + + M models/lnd/clm/bld/clm.buildnml.csh - Add back logic in about ignoring IC year or date + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - New initial conditions for: + Native initial conditions for f09 for: + I1850CLM45SP, I1850CLM45BGC, ICLM45SP, ICLM45BGC + Interpinic for: + I1850CLM45SP & I1850CLM45BGC: f19, hcru_hcru, ne30 + ICLM45BGCCROP @ f19 + ICLM45BGCDB @ f09 + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Use surfdata_map rather than surfdata + for CLM_USRDAT_NAME fsurdat files + + M models/lnd/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml - Remove setting of dtime, adjust hist output + + More work on readme files... + + M README + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/Quickstart.GUIDE + M models/lnd/clm/doc/Quickstart.userdatasets + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm intel yes + frankfurt/aux_clm pgi yes + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $GLDCSEG/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + + yellowstone/PTCLM: yes! + +CLM tag used for the baseline comparison tests if applicable: clm4_5_06 + +Changes answers relative to baseline: Yes -- due to new initial condition files + for I1850CLM45SP and I1850CLM45BGC @ f09, f19, hcru, ne30 + ICLM45SP and ICLM45BGC @ f09 + ICLM45BGCCROP @ f19 and ICLM45BGCDB @ f09 + and ICLM40CRUCN @ f09 + + AND new initial conditions for RTM for ALL R05 grids + + And turning drydep namelist off in the driver causes answers to appear to be different + when comparing coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_5_06 +Originator(s): erik (Erik Kluzek) +Date: Wed May 15 13:52:43 MDT 2013 +One-line Summary: A few small bug fixes, more updates to README files + +Purpose of changes: + More work on README files and documentation. + Fix from Danica/Bill for transient simulations. + Fix from Zack for Lake output variables + Another multi-instance script fix. + Fix tropixAtl pftdyn filename. + Remove models/lnd/clm/bld/config_query as doesn't work with new CESM scripts. + +Requirements for tag: + Requirements: Fix bug: 1697, 1691, 1675, fix tropicAtl fpftdyn file, minimal testing on frankfurt + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + 1675 (need to relax error tolerance in reweightMod: weightsOkay) + 1691 (Scripts issue for multi-instance for CLM/RTM) + 1697 (ZLAKE and DZLAKE are NOT set) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Fix 1x1_tropicAtl fpftdyn file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (transient fix), dlawren/subin (lake fix), jedwards (multi-instance scripts) + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: testing namelist files for old CLM standalone + + D models/lnd/clm/bld/config_query --- no longer works with new CESM scripts + + D models/lnd/clm/test/tools/nl_files/nl_ch4_set2_ciso + D models/lnd/clm/test/tools/nl_files/nl_ch4_set3_pftroot + D models/lnd/clm/test/tools/nl_files/nl_rootlit + D models/lnd/clm/test/tools/nl_files/nl_ciso + D models/lnd/clm/test/tools/nl_files/nl_anoxia_wtsat + D models/lnd/clm/test/tools/nl_files/nl_vrtlay + D models/lnd/clm/test/tools/nl_files/nl_oldhyd + +List all files added and what they do: + + A models/lnd/clm/tools/clm4_5/interpinic/addmetadata --- Add script to add important meta-data to finidat files. + +List all existing files that have been modified, and describe the changes: + +---------------- Work on README files documentation + M models/lnd/clm/test/tools/config_files/README + M models/lnd/clm/test/tools/README + M models/lnd/clm/test/tools/README.testnames + M models/lnd/clm/tools/README + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/Quickstart.GUIDE + M models/lnd/clm/doc/README + +---------------- + M models/lnd/clm/bld/config_files/config_definition.xml ------------ Document experimental settings / fix syntax error + M models/lnd/clm/bld/clm.buildnml.csh ------------------------------ Multi-instance fix + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Fix 1x1_tropicAtl fpftdyn filename + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Document experimental settings + +---------------- + M models/lnd/clm/src/clm4_5/main/histFileMod.F90 ---- ZLAKE/DZLAKE fix + M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 -- ZLAKE/DZLAKE fix + M models/lnd/clm/src/clm4_5/main/reweightMod.F90 ---- Increase tolerance to 1.e-7 so transient + simulations can run their full course. + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: (limited testing on yellowstone/aux_clm/intel) + + frankfurt/aux_clm pgi yes + frankfurt/aux_clm intel yes + +CLM tag used for the baseline comparison tests if applicable: clm4_5_04 + +Changes answers relative to baseline: no (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_05 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue May 14 13:15:12 MDT 2013 +One-line Summary: hcru bug fixes + +Purpose of changes: update pio tag and nfire init. mod + +Requirements for tag: N/A + +Test level of tag: Only run hcru_hcru tests + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Fang and Erik for nfire problem + +List any svn externals directories updated (csm_share, mct, etc.): update pio to 1_7_0 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-- nfire init. changed from nan to spval to fix problem with hcru_hcru debug + intel runs +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +Machines testing ran on: Only testing hcru_hcru resolutions + +Yellowstone Tests: + + The following were run with DEBUG=TRUE and for 1 day initial + 1 day restart + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_gnu_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_intel_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_pgi_pioFixed/ PASS + + ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_intel.125102 PASS + ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.125128 PASS + +Frankfurt Tests: + + The following were run with DEBUG=TRUE and for 1 day initial + 1 day restart + hcru_hcru_I_2000_CRUFRC_CLM45_CN_frankfurt_pgi_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_frankfurt_intel_pioFixed/ FAIL initial run (this is + likely related to other existing MPI problems on Frankfurt). + +CLM tag used for the baseline comparison tests if applicable: N/A + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_04 +Originator(s): erik (Erik Kluzek) +Date: Mon May 13 12:25:14 MDT 2013 +One-line Summary: Fix the previous broken tag + +Purpose of changes: + +Fix the problems in the clm4_5_03 untested tag. + +Requirements for tag: Fix bug 1692, 1693 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1693 (Misc. issues with clm4_5_03) + 1692 (externals screwed up in clm4_5_03) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): externals updated to those in SVN_EXTERNAL_DIRECTORIES + +List all files eliminated: Remove test/system as replaced by CESM testing + + models/lnd/clm/test/system -- Delete the whole directory tree + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 -- fixed screwed up code + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm intel yes + frankfurt/aux_clm pgi yes + +CLM tag used for the baseline comparison tests if applicable: clm4_5_01 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_03 +Originator(s): erik (Erik Kluzek) +Date: Fri May 10 17:29:56 MDT 2013 +One-line Summary: Several bug fixes for release, urban and test single point surface datasets + +Purpose of changes: + + Some work on IMPORTANT_NOTES file. + Fix PTS_MODE restarts from John Truesdale. (implimented, but there are still issues) + Fix history change number of tapes on startup issue. + Bring in urban single pt surface datasets and single pt test: mexicocityMEX, vancouverCAN , urbanc_alpha, 1x1_tropicAtl, 1x1_smallvilleIA + Drydep use before defined problem. + Always bypass first two time-steps for CN/BGC. + Fix gregorian calendar on history files. + Remove two fields on clm45 fpftdata file as per Gordon Bonan. + ncd_pio fix from Jim Edwards/Mariana V. + set nsegspc=20 for HOMME and high resolution grids. + Change documentation on CLM build-namelist -drydep, but keep it default on (will change to off in next tag) + Remove a bunch of datm/drv fields in namelist_definition. + Fix some issues with Crop and DV that Sam found. + Fix a scripts issue with multi-instance. + Update RTM (multi-instance fix, allow null grid). + Update test list so that CLM45/DV/CROP are exercised. + Update scripts/machines tag because of multiple problems. + +Requirements for tag: fix bug 1488, 1673, 1677, 1682, 1653, 1689, 1690, 1687, 1688, 1685, 1691 + +Test level of tag: limited! + +Bugs fixed (include bugzilla ID): + + 1025 (partial -- implement changes from John Truesdale so SCAM can read global IC files) + 1488 (HOMME grids can not use nsegspc=20) + 1653 (Calls to PIO are not properly done) + 1673 (B compset gregorian calendar not reflected in CLM history) + 1677 (Remove bypass_CN_balance_check_on_restart in CLM45) + 1682 (Problem starting up CLM with no history files) + 1685 (use before define issue in DryDeposition) + 1687 (SBN scripts bug) + 1688 (misc. issues with new create_test) + 1689 (CLM45 dgvm does not build) + 1690 (CLM45 CNDV lightning namelist is missing) + 1691 (Scripts issue for multi-instance) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Set nsegspc=20 for HOMME and f05/f02 resolutions + Set stream_fldfilename_lightng for CLM45/CNDV + +List any changes to the defaults for the boundary datasets: New single-point test and urban datasets + New surface datsets for: mexicocityMEX, vancouverCAN, urbanc_alpha, 1x1_tropicAtl, 1x1_smallvilleIA + New fpftdyn for: 1x1_tropicAtl 1850-2005 + New pft-physiology file for CLM45 with three fields removed that were NOT being read in (qe25, mp, and resist) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jedwards/mvertens (fix for bug 1653), jet (fix for bug 1025), slevis (fixes for DV) + +List any svn externals directories updated (csm_share, mct, etc.): Machines, scripts, rtm + Machines to Machines_130509 + scripts to scripts4_130510 + rtm to rtm1_0_25 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist ---- Document drydep as if it's off (will actually become off in next tag) + M models/lnd/clm/bld/clm.buildnml.csh -- Multi-instance bug fix. + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ----- nsegspc for ALL grids is 20 + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml --- Remove datm/drv namelist crap + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ----- nsegspc for ALL grids is 20 + New pft-physiology file, new surface/fpftdyn datasets for single point test and urban + Set stream_fldfilename_lightng for CNDV. + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml --- Remove datm/drv namelist crap + + M models/lnd/clm/doc/IMPORTANT_NOTES -- updates + + M models/lnd/clm/src/util_share/clm_time_manager.F90 - Set parameters for calendar type. + M models/lnd/clm/src/util_share/ncdio_pio.F90 -------- Fix so that type of data output on read is based + on the variable type of the data rather than the type of data on the input file. (from mvertens/jedwards) + + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ------ Fix so CNDV can build. + M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 ------ Remove bypass_CN_balance_check_on_restart + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 - Fix use before define error. + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 ---- On restart set fieldlist and later compare to make sure + not screwed up. + M models/lnd/clm/src/clm4_5/main/histFileMod.F90 ---------- Make htapes_fieldlist public, check calendar for output files, + check that namelist didn't change number of tapes or fields on restart + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 ----------- Remove bypass_CN_balance_check_on_restart, NEVER do balance check + on first time-step + + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 - Fix use before define error. + M models/lnd/clm/src/clm4_0/main/histFileMod.F90 ---------- Make htapes_fieldlist public, check calendar for output files, + check that namelist didn't change number of tapes or fields on restart + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 ---- On restart set fieldlist and later compare to make sure + not screwed up. + +Machines testing ran on: Limited! (watch out for this tag!) + + I ran preliminary testing, with versions on the cbugfixclm450 ranch. We will fix other issues with the entire + package as we find them. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_02 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_02 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue May 7 21:04:35 MDT 2013 +One-line Summary: make 'shared' tools directory, and other minor tools fixes + +Purpose of changes: + +- Make separate 'shared' tools directory, move some tools from the clm4_5 + directory into there. + +- Change interpinic so that htop and hbot are skipped + +- Change Makefile.common files in tools to use ifort by default on yellowstone, + so users can just type 'gmake' without needing to do 'gmake USER_FC=ifort'. + For simplicity, this has been implemented by defaulting to ifort for ALL Linux + machines. + +- Fix minor mksurfdata.pl bugs (1669, 1681). + +Requirements for tag: +- fix bug 1669, 1681* +- only tools testing needed + +Test level of tag: tools only + +Bugs fixed (include bugzilla ID): +- 1669: change needed for mksurfdata.pl for smallville (or crop PFT override anyway) +- Changes to get mksurfdata.pl working with urban single point datasets + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None for CLM; tools builds changed to +use ifort by default on Linux machines + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +========= Moved to 'shared' directory +D models/lnd/clm/tools/clm4_5/mkmapdata +D models/lnd/clm/tools/clm4_5/mkprocdata_map +D models/lnd/clm/tools/clm4_5/ncl_scripts +D models/lnd/clm/tools/clm4_5/mkmapgrids + +List all files added and what they do: + +========= Tools moved from clm4_5 directory to shared directory +A models/lnd/clm/tools/shared +A models/lnd/clm/tools/shared/mkmapdata/mvNimport.sh +A models/lnd/clm/tools/shared/mkmapdata/rmdups.ncl +A models/lnd/clm/tools/shared/mkmapdata/regridbatch.sh +A models/lnd/clm/tools/shared/mkmapdata/createXMLEntries.pl +A models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh +A models/lnd/clm/tools/shared/mkmapdata/mkunitymap.ncl +A models/lnd/clm/tools/shared/mkmapdata/mknoocnmap.pl +A models/lnd/clm/tools/shared/mkmapdata/README +A models/lnd/clm/tools/shared/mkmapdata +A models/lnd/clm/tools/shared/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_functions.bash +A models/lnd/clm/tools/shared/mkprocdata_map/src/mkprocdata_map.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/gridmapMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/constMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/Makefile.common +A models/lnd/clm/tools/shared/mkprocdata_map/src/fmain.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/shr_file_mod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/nanMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/Mkdepends +A models/lnd/clm/tools/shared/mkprocdata_map/src/Srcfiles +A models/lnd/clm/tools/shared/mkprocdata_map/src/Filepath +A models/lnd/clm/tools/shared/mkprocdata_map/src/Makefile +A models/lnd/clm/tools/shared/mkprocdata_map/src/fileutils.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/shr_kind_mod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_in +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_all +A models/lnd/clm/tools/shared/mkprocdata_map/clm +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_wrap +A models/lnd/clm/tools/shared/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/README +A models/lnd/clm/tools/shared/mkprocdata_map +A models/lnd/clm/tools/shared/ncl_scripts/cprnc.pl +A models/lnd/clm/tools/shared/ncl_scripts/getco2_historical.ncl +A models/lnd/clm/tools/shared/ncl_scripts/cprnc.ncl +A models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +A models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +A models/lnd/clm/tools/shared/ncl_scripts/README +A models/lnd/clm/tools/shared/ncl_scripts +A models/lnd/clm/tools/shared/mkmapgrids/src/Makefile.common +A models/lnd/clm/tools/shared/mkmapgrids/src/domainMod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_sys_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_file_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/nanMod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_log_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/Mkdepends +A models/lnd/clm/tools/shared/mkmapgrids/src/Srcfiles +A models/lnd/clm/tools/shared/mkmapgrids/src/mkmapgrids.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/Filepath +A models/lnd/clm/tools/shared/mkmapgrids/src/Makefile +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_kind_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src +A models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.namelist +A models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl +A models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.csh +A models/lnd/clm/tools/shared/mkmapgrids/README +A models/lnd/clm/tools/shared/mkmapgrids + +========= Add test for mkmapdata using '-p clm4_0' +A models/lnd/clm/test/tools/nl_files/mkmapdata_ne30np4_clm4_0 + +List all existing files that have been modified, and describe the changes: + +========= Point to new 'shared' tools directory where appropriate +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + - also fix mksurfdata.pl for crop PFT override (bug 1669) + - also changes to get mksurfdata.pl working with urban single point datasets (bug 1681) +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + - also fix mksurfdata.pl for crop PFT override (bug 1669) +M models/lnd/clm/test/tools/TBLCFGtools.sh +M models/lnd/clm/test/tools/TOPtools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh +M models/lnd/clm/test/tools/TBLtools.sh +M models/lnd/clm/test/tools/input_tests_master + - also add test for mkmapdata using '-p clm4_0' +M models/lnd/clm/tools/README +M models/lnd/clm/tools/clm4_5/mksurfdata_map/README.developers + +========= Put gen_domain in 'shared' tools directory +M SVN_EXTERNAL_DIRECTORIES + +========= Use ifort by default on yellowstone (and other Linux machines) +M models/lnd/clm/tools/clm4_5/interpinic/src/Makefile.common +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common +M models/lnd/clm/tools/clm4_0/interpinic/src/Makefile.common +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common + +========= Change interpinic so that htop and hbot are skipped +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel no + frankfurt/aux_clm_int intel no + yellowstone/aux_clm pgi no + frankfurt/aux_clm intel no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: yes + + All PASS except for the following expected failures (note that 006 & 008 + baselines are expected to always fail): + + 006 ble14 TBLCFGtools.sh shared gen_domain CFGtools__ds T31.runoptions .......................... rc=4 FAIL + 008 ble@4 TBLCFGtools.sh shared gen_domain CFGtools__ds ne30.runoptions ......................... rc=4 FAIL + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional ............. rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional ............. rc=4 FAIL + + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_01 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_01 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon May 6 16:52:27 MDT 2013 +One-line Summary: update externals + +Purpose of changes: update externals to alpha08b + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +< scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130502 +< scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130502 +< models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_33 +--- +> scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130422 +> scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130412 +> models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_29 +13c13 +< models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130502 +--- +> models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130405 +16c16 +< models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130423 +--- +> models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130226 +18c18 +< models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130417 +--- +> models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130214 +20c20 +< models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_9/pio +--- +> models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_7/pio +23,25c23,25 +< tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130425 +< tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130426a +< models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130426a/gen_domain_files +--- +> tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130411 +> tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403 +> models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403/gen_domain_files + +List all files eliminated:N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +- clean up test list + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK (detail of fails that should pass next time) + +BFAIL ERI_D.f10_f10.I20TRCN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL ERS.f19_g16_r01.I1850CLM45CN4Me.nldir_rtmOnFloodOnEffvelOff.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- No matching time found in cprnc? should pass next time. +FAIL ERS_D.f19_g16.ICLM45GLCMEC.nldir_glcMEC.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.ICLM45GLCMEC.nldir_glcMEC.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +FAIL ERS_D.f19_g16.IGRCP26CLM45CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.IGRCP26CLM45CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +BFAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL ERS_Ld3_D_P64x16.ne30_g16.ICN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +BFAIL PET_D_P1x30.ne30_g16.ICN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLA.f45_f45.I.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_ROA.f45_f45.I.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_ROA.f45_f45.ICLM45.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round + + yellowstone/aux_clm pgi OK (detail of fails that should pass next time) + +FAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism_config +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism config +BFAIL ERI_D.f10_f10.I20TRCN.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 +FAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism config + -- changes in drv_in (ocn_ntreades=2) +FAIL SMS.T31_g37.IG4804CLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +BFAIL SMS_RLB.f45_f45.I.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLB.f45_f45.ICLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_8 + -- no baseline, should pass next round + + frankfurt/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_0_81 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: only changes in g2x_Sg_frac01 and g2x_Sg_topo01 + - what platforms/compilers: all + +=============================================================== +=============================================================== +Tag name: clm4_5_00 +Originator(s): erik (Erik Kluzek) +Date: Thu May 2 00:20:17 MDT 2013 +One-line Summary: Official end to CLM4.5 development for CLM offline + +Purpose of changes: Changes from clm4_0_54 to now... + +Compsets and Scripts Changes: + +Remove ability to set compset file on command line, and use a new expanded compset file definition that +allows user to create many compsets on the fly by defining a long name with the "-user_compset" option +to "create_newcase". "-user_compset" is in the form of... + +TIME_DATM[%phys]_CLM[40|45][%phys]_SICE_SOCN_RTM[%phys]_GLC[%phys]_SWAV[_BGC%phys] + +Where + TIME = Time period (e.g. 2000, 20TR, RCP8...) + GLC = [CISM1, SGLC] + BGC = optional BGC scenario +The OPTIONAL %phys attributes specify submodes of the given system + +So for example + +./create_newcase -user_compset 1850_DATM%CRU_CLM45%BGC_SICE_SOCN_RTM_SGLC_SWAV -case cru1850 -res f19_g16 -mach yellowstone -compiler intel + +will setup a 1850 case at f19 resolution with CRUNCEP forcing with CLM4.5-BGC. + +Changes for both clm4.0 and clm4.5: + +* Bug fixes in MEGAN VOC emission fluxes and dry deposition velocities +* CRUNCEP is now an option for atmospheric forcing +* Change from Sam Levis for CROP to pft-physiology file so that CROP parameter is in Kelvin rather than Celsius. +* Don't re-weight pftdyn if weights are essentially identical. + +CLM4.5 includes the following: + +* Bring in flood capability to RTM. +* Bring LBNL-merge branch on with: vertical soil, Methane, CENTURY, split nitrification, new-lake model. +* Modifications to GPP, on gppdev branch, multilayer canopy and then single-layer version that reproduces it. +* Crop model updates. Irrigation included with crop model as an option. Fix CNDV-CROP. +* Urban model updates, multi-density, urban depth seperate from soil depth, wasteheat to zero. +* Bring in permafrostsims09 branch with Sean Swensons's flooding changes. +* Update pft-physiology file, change some CN defaults, change min flow slightly in RTM. +* Set ponding to zero, acclimation mods from Keith Oleson, a hydrology change from Sean Swenson. +* Add active flags, change subgrid weighting convention. +* Turn off subgrid topography snow parameterization for glc_mec landunits. +* Jinyun photosynthesis change impacting arid regions. +* Keith Oleson's photosynthesis change, changes canopy top: triose phosphate util. rate to be dependent on vcmax. +* VIC hydrology is an option. +* Update mksurfdata_map for CLM4.5 (also add support for glc_nec=36 although we have no datasets for this). +* Snow depth averaged over grid-cell (SNOWDP) on history file changed in favor of SNOW_DEPTH (averaged only over snow covered area). +* Spinup changes from Charlie Koven from build-time to run-time (spinup now option added to CLM_BLDNML_OPTS as "-spinup on|off"). +* Bring the F. Li and S. Levis Fire model for CLMCN and CLMBGC based on Li et al. (2012a,b; 2013). +* BSW calculation changed affecting drought phenology and frozen temperature sensitivity (SP, CN, and BGC as well as DV) + +Test level of tag: doc + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Changes to CLM configure: + -phys option to specify clm4_0 or clm4_5 + -pergro and -c13 option removed + -spinup option removed for CLM4_0 + New options for clm4_5: -clm4me, -vichydro, -exlaklayers, -vsoilc_centbgc + +Describe any changes made to the namelist: + For CLM4.0: WRF and 360x720cru resolutions added + For CLM4.5: new namelists: popd_streams light_streams clm_hydrology1_inparm clm_soilhydrology_inparm + irrigate is a namelist option rather than using different surface datasets + New namelist items for clm_inparm: + anoxia no_frozen_nitrif_denitrif + atm_c14_filename override_bgc_restart_mismatch_dump + cryoturb_diffusion_k perchroot + decomp_depth_efolding perchroot_altk + deepmixing_depthcrit pftspecific_rootingprofile + deepmixing_mixfact rootprof_exp + exponential_rooting_profile rootprof_exp + froz_q10 som_adv_flux + hist_wrtch4diag som_diffus + lake_melt_icealb spinup_state + max_altdepth_cryoturbation surfprof_exp + max_depth_cryoturb use_c13 + more_vertlayers use_c14 + nfix_timeconst use_c14_bombspike + + +List any changes to the defaults for the boundary datasets: + All CLM4.5 datasets are new. + For CLM4.0, new ne120, ne240, and 360x720cru surface datasets (ne120 ne120 finidat files) + new pft-physiology file + +New history fields: + Dozens of new fields for clm4_5. + Three new fields for clm4_0: ++ >>>>>>>>>>> Set first and last pop-dens year, and do "arb_ic" rather than "startup" +>>>>>>>>>>>> type for all transient cases (allow transient cases to do a cold-start) +>>>>>>>>>>>> ALTHOUGH YOU SHOULD NEVER DO A COLD START FOR A TRANSIENT CASE! + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + +>>>>>>>>>>>> Some small changes to documentation about irrigation. + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + + M models/lnd/clm/src/util_share/ndepStreamMod.F90 -- make default private, namelist data private, and clm_domain_mct public + + M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 --- add number of individuals + M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 -- handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ----------- Fire module -- almost entirely replaced. Two new public + methods added: ++ public :: CNFireInit ! Initialization of CNFire ++ public :: CNFireInterp ! Interpolate fire data + M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 -------- Handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 -- Handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 ----------- burndate, lfc, wf, btran2, col_ctrunc, totsomc added to restart + old fire fields removed, _vr fields required if expected., + M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 --- Add CNFireInit, and update CNFireArea call. + M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 ------- Set fire variables. + M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 farea_burned impacts SAI for stubble after harvest + M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 -------------- Initialize new fire variables + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 --------- Update CNEcosystemDynInit call + M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 ---------------- Add prec10 and prec60 (10 and 60 day total precipitation) + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 ------------ Initialize new fire variables. + M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 ----------------- Update lf_conv_cflux, make PFT weight check same as for surfrdMod.F90 + M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 -------------- Read in new fire data, abort if data needed NOT found on the + surface dataset. + M models/lnd/clm/src/clm4_5/main/findHistFields.pl ------------- Also read in CNFireMod for history fields. + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 ---------------- Add CNFireInterp call. + M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 -------------- Initialize lf_conv_cflux to zero. + M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 ----------------- Read in new fire parameters + (no longer need "resist" on the pft-physiology file) + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 ----------------- Fix tolerances to match mksurdata_map + bug fix for non-irrigated crop. + M models/lnd/clm/src/clm4_5/main/clmtype.F90 ------------------- New fire fields + M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 -------------- Initialize some new fire fields: tsoi17, fsat + M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 --------------- New fire history fields + M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 ----- Save btran2, smp_node_lf for fire + M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 ------- Save wf2, tsoi17, h2osoi_liqice_10cm + + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 ----------------- Fix tolerances to match mksurdata_map + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm_int intel yes + frankfurt/aux_clm intel yes + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_79 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers: + - what code configurations: All with CLM45 + - what platforms/compilers: All + - nature of change: new climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + /glade/p/cesm/lmwg/cases/cesm1/C20new -- on yellowstone + /glade/scratch/erik/archive/clm4079_NewFire10f19_CRU_20TR_CN4Me + /glade/scratch/erik/archive/clm4077_I1850CLM45CN4Me + /glade/scratch/erik/archive/clm4077_NewFire10f19_QIAN_20TR_CN4Me + hsi:/home/fangli/qian20 + +=============================================================== +=============================================================== +Tag name: clm4_0_79 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 24 20:27:01 MDT 2013 +One-line Summary: pftdyn, pft-phys*.nc and datm8 update + +Purpose of changes: From Erik:: - update Don't re-weight pftdyn if weights are essentially identical (Both CLM40 AND CLM45). + - Turn wasteheat to "ON" in CLM45. (namelist change) (done) + - Change from Sam Levis for CROP to pft-physiology file so that CROP parameter is in Kelvin rather than Celsius (both CLM40 and CLM45). + - Change datm so that LWDN is NOT read from files for CRUNCEP (datm8_130424). + +Requirements for tag: fix bug 1621 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): fixed 1621 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: turn waste heat on in clm4_5 + +List any changes to the defaults for the boundary datasets: change pft-phys files for 4_0 and 4_5 + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Erik, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): + +< models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130424 +--- +> models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130325 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + update to datm8_130424 + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml + - $CSMDATA/lnd/clm2/pftdata/pft-physiology.clm40.c130424.nc +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + - change ON_WASTEHEAT to ON + - use $CSMDATA/lnd/clm2/pftdata/pft-physiology.c130424.nc + +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 + - change wtpfttot2 check + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + - syntax clean up - caught by Ben Andre + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. many expected failures due to new pft-physiology files. Should pass next time. + + CESM test lists: + Many nlcomp failures: + clm4_5: + NEW: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c130424.nc' + BASELINE: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c121025.nc' + NEW: urban_hac = 'ON' + BASELINE: urban_hac = 'ON_WASTEHEAT' + clm4_0: + NEW: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.clm40.c130424.nc' + BASELINE: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c110425.nc' + + component_gen_comp: all PASS or BFAIL1 + summarize_cprnc_diffs: differences in CLM files + + yellowstone/CESM: + intel: OK. Expected failures for compare_hist (should pass next time) + FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_E.f19_g16.I1850CRUCLM45CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL NCK.f10_f10.ICRUCLM45.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL PET_PT.f10_f10.I20TRCN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL SMS.f19_g16.IRCP45CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + pgi : OK. Expected failures for compare_hist (should pass next time) + FAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + FAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + FAIL PET_PT.f10_f10.I20TRCN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + + frankfurt/CESM: + intel: OK. Expected failures for compare_hist (should pass next time) + FAIL SMS.f10_f10.IRCP26CN.frankfurt_intel.GC.pft79.compare_hist.clm4_0_78 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_78 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): same climate + -in coupler history files: l2x_Sl_*, l2x_Fall, x2l_Slrr* and some r2x_* fields change + -in clm history files: for these tests only differences seen in IGRCP60CN + +=============================================================== +=============================================================== +Tag name: clm4_0_78 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Apr 23 19:25:18 MDT 2013 +One-line Summary: MEGAN fixes + +Purpose of changes: + + - Bug fixes in MEGAN VOC emission fluxes and dry deposition velocities + - Remove the land fraction weighting from MEGAN history fields + - Added XPAN capability to dry deposition parametrization + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, starting branch from Erik. + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + - maximum string length of megan_specifier increased to 1024 characters + + M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 + M models/lnd/clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 + - land fraction weighting has been removed from the MEGAN diagnostics + - added initialization of the vocflx_meg array to zero to prevent + erroneous values from contributing to the MEGAN emissions + + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 + - corrected surface pressure + - added XPAN specification + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + yellowstone/CESM: + -intel: OK + -component_gen_comp fails on a number of tests, but it is all expected. summarize_cprnc_diffs verifies that all fails in the + CLM history files is consistent. + -compare_hist failures are expected due to new dry deposition values going through coupler. + -pgi : OK + -compare_hist failures are expected + + frankfurt/CESM: + -intel: OK. + -compare_hist failures are expected + +CLM tag used for the baseline comparison tests if applicable: clm4_0_77 + +Changes answers relative to baseline: Yes. Changes in l2x_Sl_dd{001-035},l2x_Sl_dd{040,041,043} in coupler hist file. + Possible changes in *_voc fields in coupler hist files for certain configurations. Changes in 10 MEG_* fields and VOCFLXT in CLM history files. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): same climate. changes in CLM fields range from 1.e-9 + (VOCFLXT) to 1.e-17 (MEG_thujene_a) + +=============================================================== +=============================================================== +Tag name: clm4_0_77 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Apr 23 11:38:45 MDT 2013 +One-line Summary: fix carbon balance bug in transient runs with VERTSOI, and fix Soil Hydrology bug + +Purpose of changes: + +Fix two bugs: + +(1) In transient CLM45 runs with VERTSOI, a carbon balance error + occurred due to two routines being called with updated filters + when they should have been called with filters set at their values + from the previous time step. This bug has existed since clm4_0_62. + +(2) A potential for an array out-of-bounds error (which could show up + as garbage results if array bounds checking was off) which showed + up in rare circumstances (e.g., a single grid cell in Greenland in + a 1-year test run) + +Requirements for tag: Fix bugs 1663, 1664 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + + 1663 (array bounds error in SoilHydrologyMod) + 1664 (carbon balance errors) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Fix for bug 1664 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Fix for bug 1663 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + + All PASS or xFAIL; all component_gen_comp comparisons pass or BFAIL1 + + yellowstone/CESM/allIcompsets: no + + frankfurt/CESM: yes + + All PASS or xFAIL + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_76 + +Changes answers relative to baseline: YES, potentially (though none +observed in standard testing) + + Answer changes are possible in any CLM45 case due to the SoilHydrology + bug fix (1663). This changes answers only in rare situations where the + water table comes near the surface (e.g., in a 1-year test run, this only + happened in one grid cell in Greenland) + + In addition, the following answer changes are expected due to the fix for + bug 1664: + + (1) CLM45 transient with VERTSOI (i.e., BGC). Implementing this change in + clm4_0_62 (the first tag that exhibited bug 1664), clm4_0_62-withFix + was identical to clm4_0_61 for this configuration. But clm4_0_77 will + differ from clm4_0_76 for this configuration. + + (2) Answers are changed for CLM45 CNDV with VERTSOI (i.e., BGCDV). It + appears that this configuration was buggy before this tag (e.g., + restarts weren't exact), so this tag changes answers in a way that + seems to fix this configuration. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? NOT DONE + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_76 +Originator(s): muszala (Stefan Muszala) +Date: Mon Apr 22 13:36:26 MDT 2013 +One-line Summary: spinup changes from Charlie Koven (part 1) + +Purpose of changes: + +Remove SPINUP CPP tokens, in favor of a run-time namelist item that can be set to +change the spinup mode on the fly. The state is stored on the restart file, and +if the user changes the mode on the namelist -- the model will automatically do +the "ENTER-SPINUP" or "EXIT-SPINUP" step as needed on the first time-step. The +spinup options were thus removed from the CLM configure for CLM45 and moved to +the build-namelist as option "-spinup" with values either "on" or "off". + + +Add new history fields: TOTLITC_1m, TOTSOMC_1m, TOTLITN_1m, and TOTSOMN_1m. +Remove the namelist item: reset_permafrost_c_n_pools. Removed default history +output for decomposing C pool changes due to vertical transport, and for vertical + profiles for N Deposition and fixation. + + +Answer Changes for C13: C13 and C13 Carbon isotopes are handled a bit differently + when they are NOT on the restart file. For C13 prior timestep's downregulation +is used in calculating ci used for photosynthetic discrimination. This changes + answers when use_c13 is turned on. + +Requirements for tag: N/A + +Test level of tag: std-tag + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Change the way spin up is handled + +Describe any changes made to the namelist: spinup now controlled in build-namelist + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave L. checked spinup test comparing old and new method. Erik, Charlie Koven + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130416a ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130419a + +List all files eliminated: N/A + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. + some new failures that should be gone when compared to the next tag. This is due to the new namelist variable + + < spinup_state = 0 + + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + CESM test lists: + + yellowstone/CESM: SPM - tracking tputcomp failures + cesm intel: OK + FAIL ERS.f09_g16.ICLM45VIC.nldir_vic_vrtlay.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4Me.nldir_ch4_set2_ciso.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4Me.nldir_ch4_set3_pftroot.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4MeNoVS.nldir_rootlit.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_E.f19_g16.I1850.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + cesm pgi : OK + FAIL SMS.1x1_numaIA.ICNCROP.yellowstone_pgi.GC.111075.tputcomp.clm4_0_74 + + frankfurt/CESM: + cesm intel: OK + FAIL ERS.f45_g37.I1850CN.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + FAIL SMS.f10_f10.IRCP26CN.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + FAIL SMS_D.1x1_mexicocityMEX.I.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_75 + +Changes answers relative to baseline: some changes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Answer Changes for C13: C13 and C13 Carbon isotopes are handled a bit differently + when they are NOT on the restart file. For C13 prior timestep's downregulation +is used in calculating ci used for photosynthetic discrimination. This changes + answers when use_c13 is turned on. + +=============================================================== +=============================================================== +Tag name: clm4_0_75 +Originator(s): muszala (Stefan Muszala) +Date: Fri Apr 19 16:13:42 MDT 2013 +One-line Summary: run propset + +Purpose of changes: run propset so externals are updated + +Requirements for tag:N/A + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system:N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes:N/A + +Machines testing ran on: no testing run +=============================================================== +=============================================================== +Tag name: clm4_0_74 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 17 15:58:50 MDT 2013 +One-line Summary: snow_depth changes, major scripts overhaul, small fix for tools + +Purpose of changes: bring in snow_depth changes (bfb except for one field in clm hist files, SNOWDP) + update external to alpha06e and bring in scripts refactoring by mvertens. Bug fix for mksurfdata_map + by sacks. Some minor code cleanup by muszala. + +Requirements for tag: N/A + +Test level of tag: doc, std-test + tools + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): Bug in pio1_6_6 which kills mpi-serial runs, jedwards is working on fix. + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens, swensoc + +List any svn externals directories updated (csm_share, mct, etc.): + +< scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130416a +> scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_02_scripts4_130405a +< scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130412 +> scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130403 +< models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_29 +> models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_26 +< models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_6/pio +> models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_5/pio +< tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130411 +< tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403 +> mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308 +< models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403/gen_domain_files +> models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308/gen_domain_files + +List all files eliminated: models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES (moved cprnc to common location). + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES + +--small fix from sacks. +models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 + +--update xFail list since we now run test_system tests out of cesm and scripts +--test_system now uses create_test +models/lnd/clm/test/system/test_system +models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +--minor clean up +models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +models/lnd/clm/src/util_share/organicFileMod.F90 +models/lnd/clm/src/util_share/decompInitMod.F90 + +--snow depth changes +models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +models/lnd/clm/src/clm4_5/main/clm_driver.F90 +models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +models/lnd/clm/src/clm4_5/main/clmtype.F90 +models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. + + CESM test lists: (this now includes tests from test_system batch from yellowstone). + +yellowstone:: + CESM intel: OK + CESM pgi: OK +frankfurt: + CESM intel: OK. just ran generate. run these instead of test_system interactive tests from now on. + +Tool testing: OK. This was to double check my merge since the branch I started with was in clm4_0_68. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_73 + +Changes answers relative to baseline: Only change is in the clm history field, SNOWDP. Everything else is bfb. + + +=============================================================== +=============================================================== +Tag name: clm4_0_73 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Mon Apr 15 09:48:03 MDT 2013 +One-line Summary: update mksurfdata_map for CLM4.5, and other misc. updates, mainly to tools + +Purpose of changes: + +Main purpose is to add a bunch of new fields to the CLM4.5 mksurfdata_map: +- SLOPE, STD_ELEV +- LAKEDEPTH +- peatf, abm, gdp (for fire) +- binfl, Ws, Dsmax, Ds (for VIC) +- F0, P3, ZWT0 (for methane) + +Also, other miscellaneous changes: + +- some refactoring of mksurfdata_map, and get more routines under unit test + +- for CLM4.5 mksurfdata_map, always use hires datasets, except for pft + +- add support for 36 glc_mec elevation classes (though there are currently + no surface datasets for this option) + +- add support for 1-d domain files in mksurfdata_map + +- add createXMLEntries.pl for creating xml entries for new mapping files + +- change default behavior of new_woodharv for clm4.0 (default is true now), + and only support new_woodharv=true for clm4.5 + +- allow global & regional map generation in a single submission of + mkmapdata/regridbatch.sh + +- handle clm4_0 vs clm4_5 distinction in mkmapdata.sh + +- handle large file support more robustly in mkmapdata.sh + +- refactored mkscripgrid.ncl to use built-in ESMF utility + +- remove 0.47x0.63 support for CLM4.5, since we don't have a good scrip + grid file for that resolution + +- in some files in bld/namelist_files, fix some resolutions listed as + 360x720 to be 360x720cru + +- a few other minor changes, as noted below + + +Requirements for tag: Requirements: tools tests, and build-namelist +test (to catch any accidental changes to CLM's namelist), fix bug: +1641. Also ran standard tests to cover all bases. + +Test level of tag: standard + tools + +Bugs fixed (include bugzilla ID): + - 1641 (RCP6 and RCP8.5 used old bad wood harvest for 2006 and 2007) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None to CLM namelist, but many +changes to mksurfdata_map namelist. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +========= Move to new inputs directory +D models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc + +List all files added and what they do: + +========= Create xml entries and commands to move files to inputdata for + a bunch of mapping files +A models/lnd/clm/tools/clm4_5/mkmapdata/createXMLEntries.pl + +========= Guide for how to add new fields to mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/README.developers + +========= Pull out shared mksurfdata_map code into new, shared modules +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdiagnosticsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkchecksMod.F90 + +========= Regrid new fields for mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mktopostatsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgdpMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkagfirepkmonthMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpeatMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkVICparamsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 + +========= Get more of mksurfdata_map code under unit tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 + +========= Add inputs for new mksurfdata_map unit tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lsmlon.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__num_pixels.nc + +========= Move to inputs directory +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_lookup_2d_netcdf.nc + + +List all existing files that have been modified, and describe the changes: + +========= Add new mksurfdata_map variables and mapping files +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + - also add no_inlandwet option + - also handle the case where special landunits sum to a + tiny bit more than 100% and thus give negative pct_pft +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 + - also add some other global attributes +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + - also add merge_gis and inlandwet options, remove ngwh + option, remove hires option (instead use hirespft) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + - also add support for 36 glc_mec columns, and remove 0.47x0.63 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml + - also remove 0.47x0.63, remove coarse-res lake, change logic for + determining glacier dataset, remove ngwh=off rcp6 and rcp8.5 datasets + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + - also add support for 36 glc_mec columns, no_inlandwet option, + remove a duplicate section, remove 0.47x0.63 + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/checkmapfiles.ncl +M models/lnd/clm/doc/UsersGuide/tools.xml + +========= Add nodata argument to gridmap_areaave +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 + - also add gridmap_areastddev and gridmap_check routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Add support for 36 glc_mec elevation classes +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml + - also fix ngwh default for rcp6 for 2006 and 2007 + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + +========= Change default behavior of new_woodharv for clm4.0 +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + +========= Add new test routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles + +========= Change location of input files for unit testing +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 + +========= Add support for 1-d domain files; allow larger diffs in + domain_checksame +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 + +========= Allow global & regional map generation in a single submission +M models/lnd/clm/tools/clm4_5/mkmapdata/regridbatch.sh + +========= Fix yellowstone ESMF path, add new grids, remove bluefire, + no longer make atm-ocn and RTM mapping files, handle large + file support and other grid-specific flags in a more robust + way, add option to differentiate between clm4_0 vs 4_5 +M models/lnd/clm/tools/clm4_5/mkmapdata/mkmapdata.sh + +========= Refactored to use built-in ESMF utility +M models/lnd/clm/tools/clm4_5/mkmapgrids/mkscripgrid.ncl + +========= Remove 0.47x0.63 for CLM4.5, since we don't have a good scrip grid + file for that resolution +M models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.csh + +========= Renumber build-namelist unit tests due to removing a + resolution. Also cleaned up expectedFails list, mostly removing + tests that now pass, changing failure types, and adding + ERB.ne30_g16.I_1948-2004, which failed in clm4_0_72, too +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Fix some paths in tools test scripts +M models/lnd/clm/test/tools/TBLCFGtools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh +M models/lnd/clm/test/tools/test_driver.sh +M models/lnd/clm/test/tools/TBLtools.sh +M models/lnd/clm/test/tools/TOPtools.sh + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFAIL except: + + ***** Not listed in xFAIL list, but failed in clm4_0_72, so I'm + adding it to the xFAIL list + FAIL ERB.ne30_g16.I_1948-2004.yellowstone_intel + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: yes + All PASS or xFAIL except: + + ***** No baselines + BFAIL ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.GC.142502.compare_hist.clm4_0_72 + + From component_gen_comp, all PASS or BFAIL1 except: + + ****** No baselines + BFAIL2 ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.compare_hist.clm4_0_72.clm2.h0 (baseline history file does not exist) + BFAIL2 ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.compare_hist.clm4_0_72.clm2.h1 (baseline history file does not exist) + + + frankfurt interactive: yes + All PASS or xFAIL (including component_gen_comp) + + + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + frankfurt interactive: no + Couldn't get tools to build on frankfurt, from either my branch or + the clm4_0_72 trunk tag + + yellowstone interactive: yes + All PASS except: + + ********* These seem to be expected failures, based on the fact that they fail in clm4_0_72. Note that the + ********* gen_domain tests themselves pass, but the baseline comparisons fail, even if I compare clm4_0_72 + ********* against itself + 006 ble14 TBLCFGtools.sh clm4_5 gen_domain CFGtools__ds T31.runoptions ..........................rc=4 FAIL + 008 ble@4 TBLCFGtools.sh clm4_5 gen_domain CFGtools__ds ne30.runoptions .........................rc=4 FAIL + 027 smiS4 TSMscript_tools.sh clm4_5 ncl_scripts getregional_datasets.pl getregional .............rc=6 FAIL + 028 bliS4 TBLscript_tools.sh clm4_5 ncl_scripts getregional_datasets.pl getregional .............rc=4 FAIL + + ********* Expected baseline failures due to changes in default behavior of CLM4_5 mksurfdata_map + ********* (see notes on answer changes, below, for what changed; I have rerun these tests with some + ********* changes on my branch and in the trunk tag to confirm that baseline comparisons pass when I + ********* revert the differences noted there) + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...rc=7 FAIL + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_ rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_ rc=7 FAIL + + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_72 + +Changes answers relative to baseline: NO. However, changes behavior of +these offline tools: + +mksurfdata_map for clm4.5: changes the following defaults: +- use hires raw datasets (where available) for everything except pctpft +- zeroes out inland wetland areas +- changes default glacier dataset for glc_mec surface datasets +- uses correct ngwh dataset for rcp6.0 2006 & 2007 + +mksurfdata_map for clm4.0: changes the following defaults: +- uses correct ngwh dataset for rcp6.0 2006 & 2007 + +mkmapdata.sh: +- no longer generates ocean-atmosphere and RTM mapping files + +mkscripgrid.ncl: +- roundoff-level changes in coordinates +- grid_dims is fixed (now correctly nx by ny, rather than ntot by ntot) + +=============================================================== +=============================================================== +Tag name: clm4_0_72 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Thu Apr 11 15:13:40 MDT 2013 +One-line Summary: maoyi bug fix for vic hydro + +Purpose of changes: Bring in changes from Maoyi that fix a few bugs in the VIC hydrology code. Make a small change in + scripts that fixes NoVS runs. + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): 1648 + +Known bugs (include bugzilla ID): 1658 - ERB problem with clm4_0. + 1659 - RTM restart problem when under a day boundary + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: changed NoVSBGC to NoVS in scripts branch_tag + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): changed scripts branch tag to + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_01_scripts4_130405a ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_02_scripts4_130405a + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +from Maoyi Huang: + +The variable cps%ws in my original codes overlaps with another variable in the SLAKE option. So I renamed it to cps$Wsvic. +wtsub in SoilHydrologyMod.F90 when VICHYDRO was on was not initialized. To avoid any potential conflicts, I renamed it to wtsub_vic and initialized it to 0._r8. +cleaned up the codes a little bit by taking out all variables that were not used. + +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + +- updated xFail list and slightly modified test_system yellowstone.batch to reflect ERS_D and ERS_Ln48_D changes. +- tracking tputcomp and memcomp changes in advance of refactoring modifications. + + build-namelist unit tester: All OK. All Failures in clm4_0_71 now pass. + + CESM test lists: + + cesm intel: PID: 163148: OK. a number of tputcomp failures: + FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + + cesm pgi: PID: 163101 OK. one memcomp failure + FAIL ERS.f19_g16.ICNCROP.yellowstone_pgi.GC.163101 + + test_system testing: + + yellowstone batch: OK. Fixed a problem with NoVS, found bug in + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirs.GC.162650.tputcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set2_ciso.GC.162650.memcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set2_ciso.GC.162650.tputcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set3_pftroot.GC.162650.tputcomp.clm4_0_71 + + frankfurt interactive: OK. generate and tputcomp sub-tests failed. + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.generate.clm4_0_72 + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.tputcomp.clm4_0_71 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.generate.clm4_0_72 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.tputcomp.clm4_0_71 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_72 + +Changes answers relative to baseline: only for VIC. Original implementation broken. Consider this tag the new baseline against which to test for VIC. + +IF tag changes answers relative to baseline comparison the +following should be filled in: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_71 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 10 08:43:00 MDT 2013 +One-line Summary: compsets refactoring by mvertens + +Purpose of changes: Bring in externals that refactor the compset handling. Update CLM to + work with the new compsets. Compsets are now extensible and easier to + modify and work with. + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: modify CLM to work with new compset refactor + +Describe any changes made to the namelist: modify CLM to work with new compset refactor + +List any changes to the defaults for the boundary datasets: N/A Levy's new files will come in later. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: mvertens, erik + +List any svn externals directories updated (csm_share, mct, etc.): + +https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_01_scripts4_130405a +https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130403 +https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_26 +https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130325 +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/socn +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/sice +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/sglc +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/swav +https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130405 +http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_5/pio +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308 +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308/gen_domain_files + +List all files eliminated: + +D models/lnd/clm/test/system/tests_posttag_lynx_nompi +D models/lnd/clm/test/system/mirage.interactive +D models/lnd/clm/test/system/TCBCFGtools.sh +D models/lnd/clm/test/system/tests_pretag_bluefire_nompi +D models/lnd/clm/test/system/config_files +D models/lnd/clm/test/system/config_files/gen_domain +D models/lnd/clm/test/system/config_files/tools__do +D models/lnd/clm/test/system/config_files/tools__s +D models/lnd/clm/test/system/config_files/CFGtools__ds +D models/lnd/clm/test/system/config_files/tools__ds +D models/lnd/clm/test/system/config_files/README +D models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +D models/lnd/clm/test/system/config_files/tools__o +D models/lnd/clm/test/system/get_cprnc_diffs.sh +D models/lnd/clm/test/system/TSMncl_tools.sh +D models/lnd/clm/test/system/CLM_compare.sh +D models/lnd/clm/test/system/TBLCFGtools.sh +D models/lnd/clm/test/system/README.testnames +D models/lnd/clm/test/system/tests_posttag_yong +D models/lnd/clm/test/system/TCBtools.sh +D models/lnd/clm/test/system/test_driver.sh +D models/lnd/clm/test/system/lynx.interactive +D models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +D models/lnd/clm/test/system/bluefire.batch +D models/lnd/clm/test/system/Makefile +D models/lnd/clm/test/system/TSMscript_tools.sh +D models/lnd/clm/test/system/tests_posttag_mirage +D models/lnd/clm/test/system/tests_posttag_frankfurt_nompi +D models/lnd/clm/test/system/gen_test_table.sh +D models/lnd/clm/test/system/TOPtools.sh +D models/lnd/clm/test/system/input_tests_master +D models/lnd/clm/test/system/TSMtools.sh +D models/lnd/clm/test/system/TBLscript_tools.sh +D models/lnd/clm/test/system/tests_posttag_nompi_regression +D models/lnd/clm/test/system/TBLtools.sh +D models/lnd/clm/test/system/show_var_diffs.sh +D models/lnd/clm/test/system/TSMCFGtools.sh + +List all files added and what they do: + +A + models/lnd/clm/test/tools +A + models/lnd/clm/test/tools/TSMscript_tools.sh +A + models/lnd/clm/test/tools/TCBCFGtools.sh +A + models/lnd/clm/test/tools/tests_posttag_frankfurt_nompi +A + models/lnd/clm/test/tools/config_files +A + models/lnd/clm/test/tools/config_files/gen_domain +A + models/lnd/clm/test/tools/config_files/tools__do +A + models/lnd/clm/test/tools/config_files/tools__s +A + models/lnd/clm/test/tools/config_files/CFGtools__ds +A + models/lnd/clm/test/tools/config_files/tools__ds +A + models/lnd/clm/test/tools/config_files/README +A + models/lnd/clm/test/tools/config_files/tools__o +A + models/lnd/clm/test/tools/get_cprnc_diffs.sh +A + models/lnd/clm/test/tools/gen_test_table.sh +A + models/lnd/clm/test/tools/TSMncl_tools.sh +A + models/lnd/clm/test/tools/CLM_compare.sh +A + models/lnd/clm/test/tools/nl_files +A + models/lnd/clm/test/tools/nl_files/nl_ch4_set2_ciso +A + models/lnd/clm/test/tools/nl_files/nl_ch4_set3_pftroot +A + models/lnd/clm/test/tools/nl_files/gen_domain.ne30.runoptions +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850 +A + models/lnd/clm/test/tools/nl_files/nl_rootlit +A + models/lnd/clm/test/tools/nl_files/gen_domain.T31.runoptions +A + models/lnd/clm/test/tools/nl_files/mksrfdt_10x15_1850 +A + models/lnd/clm/test/tools/nl_files/nl_ciso +A + models/lnd/clm/test/tools/nl_files/nl_anoxia_wtsat +A + models/lnd/clm/test/tools/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 +A + models/lnd/clm/test/tools/nl_files/mksrfdt_T31_crpglc_2000 +A + models/lnd/clm/test/tools/nl_files/clm4_0_mksrfdt_10x15_irr_1850 +A + models/lnd/clm/test/tools/nl_files/getregional +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_numaIA_mp24_2000 +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850-2000 +A + models/lnd/clm/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 +A + models/lnd/clm/test/tools/nl_files/mkmapdata_ne30np4 +A + models/lnd/clm/test/tools/nl_files/nl_vrtlay +A + models/lnd/clm/test/tools/nl_files/nl_oldhyd +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_vancouverCAN_2000 +A + models/lnd/clm/test/tools/nl_files/mkmapdata_if10 +A + models/lnd/clm/test/tools/TBLCFGtools.sh +A + models/lnd/clm/test/tools/input_tests_master +A + models/lnd/clm/test/tools/TOPtools.sh +A + models/lnd/clm/test/tools/README +A + models/lnd/clm/test/tools/TSMtools.sh +A + models/lnd/clm/test/tools/README.testnames +A + models/lnd/clm/test/tools/TBLscript_tools.sh +A + models/lnd/clm/test/tools/tests_posttag_yong +A + models/lnd/clm/test/tools/TCBtools.sh +A + models/lnd/clm/test/tools/test_driver.sh +A + models/lnd/clm/test/tools/tests_posttag_nompi_regression +A + models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi +A + models/lnd/clm/test/tools/TBLtools.sh +A + models/lnd/clm/test/tools/show_var_diffs.sh +A + models/lnd/clm/test/tools/TSMCFGtools.sh +A + models/lnd/clm/test/tools/Makefile +A + models/lnd/clm/test/system/yellowstone.namelist + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_system +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/frankfurt.interactive +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/yellowstone.batch +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +MM models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +MM models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: + +These should pass next time around: +-these two are due to megan now being on by default: + 030/449 < FAIL> + 037/449 < FAIL> +-these four should pass next time...no baselines in clm4_0_70 + 108/449 < FAIL> + 109/449 < FAIL> + 443/449 < FAIL> + 444/449 < FAIL> + + CESM test lists: + + yellowstone/CESM: +intel: other than our expected fail list, current failures should pass during the next round of testing +pgi : see intel + +note for intel and pgi: nlcomp fails should not be considered truth or otherwise. There is a bug compare_namelist. +lots of BFAILS when comparing to clm4_0_70 and some differences in coupler hist. vars. +These are expected due to a new CISM and DATM. + + test_system testing: + + yellowstone batch: OK. See explanation for yellowstone/CESM tests above. + frankfurt interactive: OK. After modifying the frankfurt compset for 1PT. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_70 + +Changes answers relative to baseline: yes, due to CISM, but not due to any science changes in CLM itself. There will be +changes in some coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_0_70 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Apr 1 15:58:23 MDT 2013 +One-line Summary: bring in vic hydrology + +Purpose of changes: Merge in VIC hydrology. This is an isolated option that stands on it's +own and does not effect existing code. Added tests with and without vrtlay = .true.. + +Requirements for tag: Add vic tests for CLM45 and CLM45-vrtlay, normal testing protocol + +Test level of tag: standard + I_compsets + yellowstone_rtm batch + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID):VIC crashes when run in debug mode-1648 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add namelist option for vichydro + +Describe any changes made to the namelist: Add namelist option for vichydro + +List any changes to the defaults for the boundary datasets: Using temporary surface data sets. New datasets + will come in at a later tag. The temporary data sets do not effect normal CLM runs. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Erik,Maoyi Huang + +List any svn externals directories updated (csm_share, mct, etc.):N/A + +List all files eliminated:N/A + +List all files added and what they do: + +- For new VIC tests: +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09 +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19 +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay +A models/lnd/clm/test/system/user_nl_dirs/vic +- For VIC implementation: +A models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +A models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 + +List all existing files that have been modified, and describe the changes: + +- For VIC namelist fucntionality +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +- For new VIC tests +M models/lnd/clm/test/system/yellowstone.batch +- VIC implementation +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/CESM: + cesm intel: OK. some tputcomp FAILs, but main tests pass + cesm pgi: OK. one tputcomp FAIL, main tests pass + yellowstone/CESM/allIcompsets: OK. + + test_system testing: + yellowstone rtm batch: OK. + yellowstone batch: OK. + + new VIC tests: + ERS.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09 + SMS.f19_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19 + ERS.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay + ERS_D.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay + this last one expected to Fail. + + frankfurt interactive: OK. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_69 + +Changes answers relative to baseline: No. The VIC hydro option, if turned on + does change answers, but the use of this code is isolated from the rest of CLM. + +=============================================================== +=============================================================== +Tag name: clm4_0_69 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Mar 26 16:24:54 MDT 2013 +One-line Summary: remove hydro reorder, volr and esmf mods + +Purpose of changes: fix volrlnd init. from SPVAL to 0.0 so TWS in CLM looks correct. + modify esmf interfaces for volr. remove hydrology reordering due to nasty bug in + restart. + +Requirements for tag: fix bug 1644 + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1644 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave L. and Jinyn Tang. Minor review by Erik and Bill. + +List any svn externals directories updated (csm_share, mct, etc.): update RTM to 1_0_22 + +List all files eliminated: N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + only run CESM tests: + +=== CESM Yellowstone PGI tests: OK. All BFAILS occur in cmopare_hist which is expected due to the removal of the hydro. reordering. +Status with expected failures removed: +./cs.status.114300.yellowstone | grep -v PET_PT.f19_g16.I1850 | grep -v SMS.1x1_numaIA.ICN_CROP | grep -v PET_PT.f10_f10.I20TRCN | grep -v PET_PT.f19_g16.ICLM451850 | grep -v SMS.T31_g37.IG4804CLM45 | grep -v SMS.1x1_numaIA.ICLM45CNCROP | grep -v PET_PT.f10_f10.I20TRCLM45CN | grep -v PASS +Possible test result outcomes: +... +BFAIL SMS_RLB.f45_f45.I.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CN.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS.f19_g16.ICNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS.1x1_numaIA.ICNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS_RLB.f45_f45.ICLM45.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS.f19_g16.ICLM45CNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 + +=== CESM Yellowstone INTEL tests: OK. All BFAILS occur in cmopare_hist which is expected due to the removal of the hydro. reordering. +Status with expected failures removed: +>>./cs.status.114247.yellowstone | grep -v ERH_D.f19_g16.I1850CLM45CN | grep -v ERB.ne30_g16.I_1948-2004_CLM45 | grep -v ERS_E.f19_g16.I1850CRUCLM45CN | grep -v CME.f10_f10.ICN | grep -v ERS_D.f10_f10.ICLM45 | grep -v PET_PT.f19_g16.I1850CN | grep -v ERB.ne30_g16.I_1948-2004 | grep -v PET_PT.f10_f10.I20TRCN | grep -v PET_PT.f19_g16.I1850CLM45CN | grep -v ERS_E.f19_g16.ICLM451850 | grep -v ERS_D.f19_g16.IGRCP26CLM45CN | grep -v ERS_Lm3.f19_g16.IGRCP60CLM45CN | grep -v PET_PT.f10_f10.I20TRCLM45CN | grep -v SMS.f19_g16.IRCP45CLM45CN | grep -v ERS_D.f19_g16.IRCP85CLM45CN | grep -v PASS | grep -v COMMENT +... +FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL NCK.f10_f10.I.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_E.f19_g16.I1850.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERH_D.f19_g16.I1850CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL SMS.f19_g16.IRCP45CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.114247.memcomp.clm4_0_68 +FAIL SMS_ROA.f45_f45.ICLM45.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL NCK.f10_f10.ICRUCLM45.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 + +=== test_system yellowstone.rtm.batch: OK. All compare_hist failures are expected due changes in photosynthesis + +CLM tag used for the baseline comparison tests if applicable: For Cesm intel and pgi tests- clme_0_68 + for rtm tests, against clm4_0_66. + for science validation, clm4_0_66 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + obvious changes in GPP,FPSN and FCTR. Other fields changed as well. + ran the following and had Dave L. and Jinyun Tang look at output. + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_66/ + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_68/ + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_69/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_66/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_68/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_69/ + +=============================================================== +=============================================================== +Tag name: clm4_0_68 +Originator(s): erik (Erik Kluzek) +Date: Sat Mar 16 16:03:14 MDT 2013 +One-line Summary: Fix mksurfdata_map for ne120np. Error out if SUM(weights)/=100. Photosynthesis change for CLM45. + +Purpose of changes: + +Bring in ne120fix branch to trunk. This fixes some issues in mksurfdata_map for generation +of ne120np surface data file. Put error back in CLM if weights don't sum to 100. Add in +Keith Oleson's photosynthesis change. This changes canopy top: triose phosphate utilization rate at 25C to +be dependent on vcmax25top ( maximum rate of carboxylation) rather than jmax25top (maximum electron +transport rate). Update getco2_historical.ncl script to be able to handle rcp files as well. + +Update scripts so that I1PT settings for urban single-point files will be used, and IRCP +will properly do a hybrid startup. And seperate out intel/pgi test lists. + +Update datasets for ne120np4 and ne240np4 (CLM40), with updated mksurfdata_map. + +Requirements for tag: + Tools test, yellowstone batch, fix bug 1632/1643 + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1632 (ne120np4 mksurfdata problem) + 1643 (Fix RES_COMPSET_MATCH for I1PT, IRCP*) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New surfdata and pftdyn files for ne120np4 (CLM40) + New surfdata files for ne240np4 (CLM40) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (mksrfdata changes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts updated to scripts4_130315c + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/yellowstone.batch --- Fix some compset names + + M models/lnd/clm/tools/clm4_5/ncl_scripts/getco2_historical.ncl - Handle rcp CO2 files + M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 -- Clean out small PFT values + M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 -- Clean out small PFT values + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ------- Update ne120/ne240 surfdata/pftdyn datasets + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ------- Delete ALL finidat files as none compatible + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - Add rcp CO2 datasets: rcp2.6/4.5/6/8.5 + + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 - Add back abort if surfdata weights don't sum to 100% + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 - Add back abort if surfdata weights don't sum to 100% + M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - change in photosynthesis + +Changes in expected fails for testing: + + build-namelist unit-test: Following fail because of new datasets will pass next tag + 203 ne120 + 208 ne240 + 306 ne120 20th Century + 428 48x96 for CLM45 (remove finidat) + failType="FAIL">answers change on restart + + + Changes to expected fail: + + + + ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart + + + + + +Restart difference + +Restart difference + +Restart difference + +Restart difference + +Restart difference + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: yes + + test_system testing: + + yellowstone batch: yes + frankfurt interactive: yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + +CLM tag used for the baseline comparison tests if applicable: clm4_0_68 + +Changes answers relative to baseline: Yes! + + - what code configurations: + All CLM45 change because of change in photosynthisis + I1PT compsets change because of scripts bug + IRCP compsets now startup with new initial conditions + - what platforms/compilers: All + - nature of change: similar climate + +=============================================================== +=============================================================== +Tag name: clm4_0_67 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Mar 12 11:14:59 MDT 2013 +One-line Summary: Jinyun photosynthesis and hydrology reorder + +Purpose of changes: Bring in mods that reorder hydrology code and modes that + address photosynthesis CN code. This tag is F90 code only. + +Requirements for tag: N/A + +Test level of tag: std-test + ICompset tests + yellowstone interactive + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets:N/A + +Describe any substantial timing or memory changes:N/A + +Code reviewed by: Dave L, S. Swenson, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated:N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +Major changes in CNEcosystemDynMod, SoilHydrologyMod and Hydrology2Mod. Also did some deadCode removal (unused pointer +assignments, unused modules and local variables. + + M biogeochem/CNEcosystemDynMod.F90 - effects CN. Split out CNEcosystemDynA and CNEcosystemDynB + + M main/CNiniTimeVar.F90 - removed some commented out code + M main/clmtypeInitMod.F90 - removed commented out init_gridcell_pstate_type + M main/pftdynMod.F90 + M main/initSurfAlbMod.F90 - effects CN. For photosynthesis. + M main/clm_driver.F90 + M main/CNiniSpecial.F90 + M ain/clmtype.F90 + M main/histFldsMod.F90 + + M biogeophys/Hydrology2Mod.F90 - split out 2A and 2B subroutines + M biogeophys/SoilHydrologyMod.F90 - split out new WaterTable routine from existing Drainage routine + M biogeophys/BareGroundFluxesMod.F90 + M biogeophys/CanopyFluxesMod.F90 - For photosynthesis. + + +Machines testing ran on: (Tests in priority order) + +Dave Lawrence looked at 1 year runs to make sure behavior looked OK before and after mods. +S. Swenson looked at short simulations to make sure reordering worked correctly in the hydrology code. +Expect changes in the following fields (depending on compset and test type) + +roff Flrl_rofliq +roff Flrl_rofliq +lnd Flrl_rofliq +lnd Flrl_rofliq +roff Forr_roff +roff Forr_roff +roff Flrl_rofliq +roff Flrl_rofliq +lnd Fall_lat +lnd Fall_lat +lnd Fall_sen +lnd Fall_sen +lnd Fall_evap +lnd Fall_evap +lnd Flrl_rofliq +lnd Flrl_rofliq +roff Forr_roff +roff Forr_roff +roff Flrl_rofliq +roff Flrl_rofliq +lnd Sl_fv +lnd Sl_f + +l2x_Sl_avsdr +l2x_Sl_anidr +l2x_Sl_avsdf +l2x_Sl_anidf +l2x_Sl_tref +l2x_Sl_qref +l2x_Sl_t +l2x_Sl_fv +l2x_Sl_ram1 +l2x_Sl_snowh +l2x_Sl_u10 +l2x_Fall_swnet +l2x_Fall_taux +l2x_Fall_tauy +l2x_Fall_lat +l2x_Fall_sen +l2x_Fall_lwup +l2x_Fall_evap +l2x_Fall_flxdst1 +l2x_Fall_flxdst2 +l2x_Fall_flxdst3 +l2x_Fall_flxdst4 +l2x_Flrl_rofliq +x2l_Slrr_volr +r2x_Slrr_volr +r2x_Forr_roff +r2x_Forr_ioff +x2r_Flrl_rofliq + + build-namelist unit tester: yes - OK + + CESM test lists: + + yellowstone/CESM: yes - OK. Fails are due to new code. These should pass next tag. + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirGC.113407 + oAIL ERS_D.fol_g16.I_1850_CLM45_CNCENTNoMe.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.113407 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.yellowstone_intel_ciso.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.GC.113407 + + yellowstone/CESM/allIcompsets: yes - OK + + test_system testing: + + yellowstone batch: yes - OK. Fails are due to new code. These should pass next tag. + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_D.f19_g16.I_1850_CLM45_CNCENTNoMe.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.113407 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.yellowstone_intel_ciso.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.GC.113407 + + frankfurt interactive: yes - OK + yellowstone interactive: yes - reasonably OK. Added a few tests to xFail list that need new + surface data sets. + The following fail due to new code and should pass next round: + + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45USUMB.yellowstone_intel_user_nl_dirs.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.075359 + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CLM45_CN.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45_CNDV.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + +CLM tag used for the baseline comparison tests if applicable: clm4_0_66 + +Changes answers relative to baseline: Photosynthesis mods and reordering will change answers + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): hydrology reordering will introducce very small changes due to the process of moving around, but not changing code. + photosysthesis mods are major changes that effect science + + +=============================================================== +=============================================================== +Tag name: clm4_0_66 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Thu Mar 7 11:54:05 MST 2013 +One-line Summary: turn off subgrid topography snow parameterization for glc_mec landunits + +Purpose of changes: + +Change from Sean Swenson to turn off subgrid topography snow +parameterization over glc_mec landunits: ice_mec columns already account +for subgrid topographic variability through their use of multiple elevation +classes; thus, to avoid double-accounting for topographic variability in +these columns, we ignore topo_std and use a value of n_melt that assumes +little topographic variability within the column. + +Requirements for tag: yellowstone cesm tests, make sure GLC test goes + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFail (ignoring tput failures); only baseline failure is, + the following, which is an expected failure: + FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.C.113330.compare_hist.clm4_0_65 + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_65 + +Changes answers relative to baseline: Yes, just for CLM4.5 with glc_mec + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with glc_mec + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_65 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Thu Mar 7 09:53:31 MST 2013 +One-line Summary: back out Machines external to get more tests to pass, especially IG + +Purpose of changes: + +Some tests - particularly IG - became broken in clm4_0_64. This tag rolls +back the Machines external so that GLC compiles properly. + +Requirements for tag: + +Test level of tag: only yellowstone CESM tests + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130304b ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130301 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Difference in expected fails: this brings the xfail list back to what it +was in clm4_0_63, with the exception of some SBN IcompsetTests that were +added to xFail in clm4_0_64: +@@ -154,12 +154,6 @@ + scripts issue component not threaded + missing finidat file + missing finidat file +- +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- +- ERROR: lnd_prognostic but num_inst_lnd not num_inst_max +- ERROR: lnd_prognostic but num_inst_lnd not num_inst_max + + + scripts issue with ocean not threaded +@@ -170,10 +164,6 @@ + checkWeights error, probably due to old-format urban on surface dataset + Bad compset name: ICNCROP + scripts issue with ocean not threaded +- +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' + + + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFail (ignoring tput failures) + (note that baselines didn't exist in clm4_0_64 for some tests, + particularly IG) + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_64 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_0_64 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Mar 6 12:41:26 MST 2013 +One-line Summary: update externals. fixes 40/45 intial condition problem + +Purpose of changes: Main purpose is to bring in scripts4_130227b so that + CLM45 compsets do not use CLM40 initial conditions. Put in + PTCLM fix. Secondary purpose is to update other externals. + NOTE: This tag only changes externals. No clm + code, scripts or xml files were touched. + +Requirements for tag: N/A + +Test level of tag: critical (only yellowstone, Icompset and aux 40/45 aux tests) + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Changes in processor count for certain resolutions. + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: the 40/45 fix in scripts4_130227b will fix initial condition problems. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: muszala, Erik + +List any svn externals directories updated (csm_share, mct, etc.): + + cprnc_120828 -> cprnc_130301 + scripts4_130207 -> scripts4_130304 + Machines_130214 -> Machines_130304b + rtm1_0_19 -> rtm1_0_20 + share3_130220 -> share3_130226 + esmf_wrf_timemgr_120427 -> esmf_wrf_timemgr_130213 + timing_120731 -> timing_130214 + mapping_121113b -> mapping_130222 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + + M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + yellowstone/CESM: yes - looks decent, but not great. There are no new test failures and new tests that do fail are + most likely due to new testlists that weren't tested in a clm tag. + A few nl comp failures since number of pes changed (expected). + Many comparisons failed due to baselines not existing. + 5 IG compsets fail due to a linking error. + 2 NCK.F10_f10 tests die with "ERROR: lnd_prognostic but num_inst_lnd not num_inst_max" + + yellowstone/CESM/allIcompsets: yes - looks OK. Transient runs added to xFail list as well as SBN.1x1_smallvilleIA.ICLM45CNCROP + and SBN.f09_g16.IGCLM45IS2 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_63 + +Changes answers relative to baseline: Yes. PE counts change plus the initial condition fixes will change answers compared + to existing baselines + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + The 40/45 fix should bring this back to being correct (ie. the state before clm4_0_60). + +=============================================================== +=============================================================== +Tag name: clm4_0_63 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Mar 4 13:50:15 MST 2013 +One-line Summary: bug 1635 fix - 4_0 CN bug + +Purpose of changes: Put back some removed code. This allows CN to run with 4_0 + beyond one year + +Requirements for tag: + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1635 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave Lawrence, Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 +--- models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 (revision 44311) ++++ models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 (working copy) +@@ -183,6 +183,12 @@ + call p2c(num_soilc, filter_soilc, annavg_t2m, cannavg_t2m) + end if + + + ! column loop + + do fc = 1,num_soilc + + c = filter_soilc(fc) + + if (annsum_counter(c) >= get_days_per_year() * secspday) annsum_counter(c) = 0._r8 + + end do + + + end subroutine CNAnnualUpdate + !----------------------------------------------------------------------- + + +Machines testing ran on: (Tests in priority order) + yellowstone/CESM: yes only 40 list - OK. Matches xFail list + yellowstone/CESM/allIcompsets: yes - OK. Matches xFail list + + Also had D. Lawrence look at one 45 run and a 40 run from this tag compared to one from + clm4_0_58 (the tag just before this bug was introduced). All three runs were 2 years long. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_62 + +Changes answers relative to baseline: No + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_62 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Sun Feb 24 15:27:09 MST 2013 +One-line Summary: add active flags, change subgrid weighting convention, other misc fixes + +Purpose of changes: + +Main set of changes involves adding 'active' flags at the pft, column & landunit +levels, saying whether computations should be run over a given point. This +change involved many changes throughout the code, changing conditionals like 'if +(pwtgcell(p) > 0)' to 'if (pactive(p))'. The purpose of this change was +two-fold: (1) make these conditionals less error-prone and more robust to future +changes in the code: currently, the 'active' condition is: weight > 0 OR type = +glc_mec -- but sometimes people forgot to include the latter condition, and it +could get worse moving forwards; (2) make it easy to change the 'active' +condition in the future -- this now just has to be done in one place, in +reweightMod. + +In changing these conditionals to use the new 'active' flags, I also added or +removed conditionals in a few places -- see notes below on the individual file +modifications. + +Also, changed subgrid weighting convention, so that the sum of weights always +adds to 1 at all levels. Previously, there was no fixed convention for the +weights of, e.g., pfts on a 0-weight column. Now, even on a 0-weight column, the +sum of pft weights on the column will still add to 1. + +Also a number of other miscellaneous fixes: +- bug-fix in handling of unstructured grids in determining new vs old urban format +- add some new surface datasets with new urban format +- other misc. fixes noted below + +Requirements for tag: + Testing: build-namelist unit tests, yellowstone cesm, yellowstone + test_system batch, frankfurt test_system interactive; include + component_gen_comp for test_system tests + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: A few new surface datasets (see below) + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): +Main purpose is to update cism (along with necessary scripts & machines +updates), but also updated other externals to their cesm1_2_beta02 versions: +- scripts +- machines +- cism +- mct +- pio +- csm_share (includes scam update from Erik) + +List all files eliminated: + +List all files added and what they do: + +======= Handles modifications and error-checks related to changing subgrid weights +======= (note that direct calls to setFilters should no longer be made -- +======= instead, call reweightWrapup in this new module). This adds a routine that confirms +======= that all subgrid weights add to 1 (from Zack Subin). +A models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +List all existing files that have been modified, and describe the changes: + +======= add 'active' flags; replace use of things like 'if (pwtgcell(p) > 0)' +======= with 'if (pactive(p))' +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ---------- also removed unnecessary conditional +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 ------------ also added a pactive check +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 --------------- also added a new conditional +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 ------------ also added a new conditional in p2c_2d_filter + (similar to existing conditional in p2c_1d_filter) +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 --- also remove ^M line endings accidentally added in clm4_0_61 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 + +======= replace calls to setFilters with calls to reweightWrapup; in driver, +======= moved these calls based on an analysis of where they are needed +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +======= change subgrid weighting convention; remove duplicated code in setting +======= up urban landunits. Note that, in a few places (marked by "TODO WJS") I +======= assumed an arbitrary weighting for, e.g., pft weights in a 0-weight +======= landunit. This can be changed in the future once we change how weights +======= are defined on the surface dataset (using weights on the landunit rather +======= than on the grid cell). +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +======= declare some parameters as 'parameter' (needed in order to use them in +======= select case statements) +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +======= make check for new vs old format more robust; in particular, fix +======= handling of unstructured grids (before, these were deemed to be +======= old-format urban files by accident) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 + +======= use nlevurb=5 even for more_vertlayers (based on suggestion from Keith +======= and Erik) +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +======= use new surface datasets for glcmec 1.9x2.5 1850&2000, and f10 1850, in +======= order to have valid urban data for some tests to pass +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +======= use cism rather than sglc for test_system tests, because sglc means no +======= sno fields are sent to the coupler, which leads to ERS test failures and +======= generally weaker tests +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml + +======= add cism1 distinction in compset name +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/bluefire.interactive +M models/lnd/clm/test/system/lynx.batch + +======= add call to component_gen_comp +M models/lnd/clm/test/system/test_system + +======= Removed some now-passing tests, including some that were passing earlier +======= but still remained in this file +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +xFAIL differences: +Index: models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +=================================================================== +--- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (revision 44092) ++++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (working copy) +@@ -113,8 +113,7 @@ + + + +- +- ++ + + + +@@ -137,7 +136,6 @@ + + scripts issue with ocean not threaded + Restart difference +- Soil balance error on restart + scripts issue with ocean not threaded + + scripts issue with ocean not threaded +@@ -149,20 +147,12 @@ + missing finidat file + + +- problem building with mpi-serial with pgi compiler +- missing LAPACK symbol dgbsv + scripts issue with ocean not threaded +- Need LAPACK for PGI (dgbsv) +- Need LAPACK for PGI (dgbsv) + Bad compset name: ICNCROP + scripts issue with ocean not threaded + +- problem building with mpi-serial with pgi compiler +- missing LAPACK symbol dgbsv +- missing LAPACK symbol dgbsv + scripts issue with ocean not threaded +- Need LAPACK for PGI (dgbsv) +- Need LAPACK for PGI (dgbsv) ++ checkWeights error, probably due to old-format urban on surface dataset + Bad compset name: ICNCROP + scripts issue with ocean not threaded + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + +NOTE: Ignoring throughput fails + + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + Note: the following change was made after running the CESM test list (just + reran the one affected case: ERI.f19_g16.IG1850CLM45.yellowstone_pgi): + In bld/namelist_files/namelist_defaults_clm4_5.xml: + -lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_glcmec10_c130221.nc + + yellowstone/CESM: yes + All PASS or xFAIL except: + + ***** Expected failure due to urban bug-fix for unstructured grids + FAIL ERB.ne30_g16.I_1948-2004_CLM45.yellowstone_intel.GC.051632.compare_hist.clm4_0_61 + + ***** memcomp failures probably due to using cism2 code + FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + + ***** memcomp failures with unknown cause + FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + COMMENT pesmaxmem_incr = 28.2 + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: yes, including component_gen_comp + All PASS or xFAIL except: + + ***** Expected failure due to new surface dataset + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.051756.compare_hist.clm4_0_61_test_system + + ***** Expected failure due to urban bug-fix for unstructured grids + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.051756.compare_hist.clm4_0_61_test_system + + ***** memcomp failures with unknown cause + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.051756.memcomp.clm4_0_61_test_system + FAIL ERS_Ln48_D_P64x16.ne30_g16.ICN.yellowstone_intel_user_nl_dirs.GC.051756.memcomp.clm4_0_61_test_system + + + ----- COMPONENT_GEN_COMP RESULTS --- + All comparisons PASS except: + + ****** Expected failures due to new surface dataset and fix in urban for + ****** ne30 These failures all go away when I compare against one-offs + ****** from clm4_0_61 with fixes in surface datasets and the urban ne30 + ****** bug. However, there is then a diff in the h1 file for the GLCMEC + ****** test: diffs just in cols1d_wtlunit & pfts1d_wtlunit, and this is + ****** just over glc_mec columns -- this is expected due to changes in + ****** subgrid weighting convention + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.compare_hist.clm4_0_61.clm2.h1 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h1 + + ****** Differences just over crop landunits: RMS diffs in pft weights on + ****** col and landunit, and col weights on landunit; and FILLDIFFs in 12 + ****** column-level variables (now _FillValue in 0-weight places). These + ****** differences aren't surprising given the changes in subgrid weight + ****** convention and the fact that inactive points are now given spval in + ****** 1-d output + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h1 + + + frankfurt interactive: yes, including component_gen_comp + All PASS or xFAIL + + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_61 + +Changes answers relative to baseline: yes, in limited cases - see below + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with the following: + - unstructured grids, due to urban bug fix + - glcmec @ 1.9x2.5, due to new surface datasets with new urban + - 1850 @ f10, due to new surface dataset + - what platforms/compilers: ALL + - nature of change: larger than roundoff/same climate OR new climate (not + investigated carefully) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: NOT DONE + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_61 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Feb 20 15:53:38 MST 2013 +One-line Summary: rtm, drv and clm mods: tws, Volr, r01 rdric file and SoilHydroMod + +Purpose of changes: Bring Volr from RTM to CLM. + New ne120 files. + New SoidHydrologyMod file for 45 (not bit-for-bit) + Bring tws in. + Sacks test list change and test_system change. + Add yellowstone to xFail options. + Added RTM test list for test_system tests (yellowstone.rtm.batch) + DEPRECATE WT in 4_5 code. WT and the variable wt are left in since they are used in other + portions of the code, but they are marked as deprecated since we now have TWS. + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: muszala, swenseon, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): + drv: update from drvseq4_2_20 to drvseq4_2_22 + rtm: update from rtm1_0_18 to rtm1_0_19 + csm_share: update from share3_130213 to share3_130131 + +List all files eliminated: +D https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn +D https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01 + +List all files added and what they do: + Added RTM rtm test_system tests +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOff/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOff +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOn/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOn +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOff/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOff +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOn/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOn +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.rtm.batch + +List all existing files that have been modified, and describe the changes: +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/test_system +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.interactive +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff/user_nl_rtm +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/README +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.batch +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/doc/ChangeLog +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/doc/ChangeSum +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clmtype.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/SVN_EXTERNAL_DIRECTORIES +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/ChangeLog +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/ChangeSum + + +Machines testing ran on: (Tests in priority order) + NOTE: Lots of throughput, NLComp and memcomp fails. Also ran rtm test_system tests + + build-namelist unit tester: OK (yellowstone) - added two tests that were missing from xFail list + + CESM test lists: + + yellowstone/CESM: + -> 4_0 testing: OK. Removed tests in xFail file and ignoring NLComp tests. Remaining Fails (tputcomp and memcomp) will be ignored since test tolerences are too narrow. + + -> 4_5 testing: OK. There will be B4B differences due to a new SoilHydrologyMod which are listed below + + FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERS_D.f10_f10.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL NCK.f10_f10.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERB.ne30_g16.I_1948-2004_CLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + + yellowstone/CESM/allIcompsets: OK + + test_system testing: + + yellowstone batch: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_D.f19_g16.I_1850_CLM45_CNCENTNoMe.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.monthly.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.crop.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.crop.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.voc.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.ciso.GC.114029.compare_hist.clm4_0_60 + + frankfurt interactive: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.ICLM451PT.frankfurt_intel_user_nl_dirs.GC.104908.compare_hist.clm4_0_60 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.ICLM451PT.frankfurt_intel_user_nl_dirs.GC.104908.compare_hist.clm4_0_60 + + yellowstone interactive: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45alaskaCN.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45USUMB.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_P1x1_Mmpi-serial.5x5_amazon.I_2000_CLM45.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D_P1x1_Mmpi-serial.f45_g37.ICLM45VOC.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CLM45_CN.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45_CNDV.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.IVSCN.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + + frankfurt batch: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS_D_P16x1.f19_g16.I_1850_CLM45_CN4Me.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERI_P16x1.f19_g16.I_1850_CLM45_CNCENTNoMe.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_Ld211_P16x1.f10_f10.ICLM45CNADSPIN.frankfurt_intel_monthly.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_P16x1.f19_g16.I_1850_CLM45_CN4Me_LessSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f19_g16.I_1850_CLM45_CN4Me_EXLessSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f10_f10.I_2000_CLM45_CN4Me.frankfurt_intel_vrtlay.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_D_P16x1.f19_g16.I_2000_CLM45_CN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERI_P16x1.f19_g16.I_2000_CLM45_CN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f19_g16.ICLM45CNEXSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + +CLM tag used for the baseline comparison tests if applicable: CLM4_0_60 + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: 4_5 code + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + 1) SoilHydrologyMod.F90 mods from Swenson effect soil moisture which are effecting certain l2x coupler fields + 2) bringing VOLR from RTM through the coupler adds one more field to coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_0_60 +Originator(s): erik (Erik Kluzek) +Date: Mon Feb 11 03:55:56 MST 2013 +One-line Summary: Bring CLM4.5 code from clm45sci branch to trunk as an option set at configure time + +Purpose of changes: + +Bring in CLM4.5 branch as additional directories. Change directory structure, so there are shared files +and utilities for both CLM4.0 and CLM4.5 and files that are different for each. Update compsets in +scripts in order to work in this paradigm. Move clm45sci15_clm4_0_58 code to trunk under clm4_5 phys. + +clm4.5 includes the following: + +* Bring LBNL-merge branch on with: vertical soil, Methane, CENTURY, split nitrification, new-lake model. +* Modifications to GPP, on gppdev branch, multilayer canopy and then single-layer version that reproduces it. +* Crop model updates. Irrigation included with crop model as an option. Fix CNDV-CROP. +* Urban model updates, multi-density, urban depth seperate from soil depth, wasteheat to zero +* Bring in permafrostsims09 branch with Sean Swensons's flooding changes. +* Update pft-physiology file, change some CN defaults, change min flow slightly in RTM +* Set ponding to zero, acclimation mods from Keith Oleson, a hydrology change from Sean Swenson. + +Requirements for tag: clm40/clm45 code/tools work/tested, answers same, complete move from bluefire to yellowstone + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1621 (normalization issue in mksurfdata_map and clm -- partial) + 1604 (The -co2_type flag in the CLM namelist is not set correct.) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Compsets to run CLM4.5 added. + +I_2000_CLM45 (ICLM45) +I_2000_1PTFRC_CLM45 (I1PTCLM45) +I_2000_GLC_CLM45_CISM1 (IGCLM45) +I_2000_GLC_CLM45_CISM2P (IGCLM45IS2) +I_2000_CLM45_CN (ICLM45CN) +I_2000_CLM45_CN_CROP (ICLM45CNCROP) +I_2000_CLM45_CN_4Me (ICLM45CN4Me) +I_2000_CRUFRC_CLM45 (ICRUCLM45) +I_2000_CRUFRC_CLM45_CN (ICRUCLM45CN) +I_2000_CRUFRC_CLM45_CN_4Me (ICRUCLM45CN4Me) +I_2000_CLM45_CN_GLC_CISM1 (IGCLM45CN) +I_1850_CLM45 (I1850CLM45) +I_1850_CLM45_CN_4Me (I1850CLM45CN4Me) +I_1850_CRUFRC_CLM45 (I1850CRUCLM45) +I_1850_CRUFRC_CLM45_CN (I1850CRUCLM45CN) +I_1850_CRUFRC_CLM45_CN_4Me (I1850CRUCLM45CN4Me) +I_1850_CLM45_GLC_CISM1 (IG1850CLM45) +I_1850_CLM45_CN (I1850CLM45CN) +I_1850-2000_CLM45 (I20TRCLM45) +I_1850-2000_CLM45_CN (I20TRCLM45CN) +I_1850-2000_CRUFRCCLM45 (I20TRCRUCLM45) +I_1850-2000_CRUFRC_CLM45_CN (I20TRCRUCLM45CN) +I_1850-2000_CRUFRC_CLM45_CN_4Me (I20TRCRU4MeCLM45) +I_1850-2000_CLM45_GLC_CISM1 (IG20TRCLM45) +I_1850-2000_CLM45_CN_GLC_CISM1 (IG20TRCLM45CN) +I_1948-2004_CLM45 (I4804CLM45) +I_1948-2004_CLM45_GLC_CISM1 (IG4804CLM45) +I_1948-2004_CLM45_CN_GLC_CISM1 (IG4804CLM45CN) +I_RCP8.5_CLM45_CN_GLC_CISM1 (IGRCP85CLM45CN) +I_RCP6.0_CLM45_CN (IRCP60CLM45CN) +I_RCP6.0_CLM45_CN_GLC_CISM1 (IGRCP60CLM45CN) +I_RCP4.5_CLM45_CN (IRCP45CLM45CN) +I_RCP4.5_CLM45_CN_GLC_CISM1 (IGRCP45CNCLM45) +I_RCP2.6_CLM45_CN (IRCP26CLM45CN) +I_RCP2.6_CLM45_CN_GLC_CISM1 (IGRCP26CLM45CN) +I_RCP8.5_CLM45_CN (IRCP85CLM45CN) +I_1850_SPINUP_3HrWx_CLM45_CN_4Me + + CLM configure changes: + + Add physics option to determine if CLM4.0 or CLM4.5 physics is used: ++ -phys Value of clm4_0 or clm4_5 (default is clm4_0) + + Options removed + + -pergro + -c13 + + Options added for CLM4.5 physics: + ++ -clm4me Turn Methane model: [on | off] ++ Requires bgc=cn/cndv (Carbon Nitrogen model) ++ (ONLY valid for CLM4.5!) ++ -exlaklayers Turn on extra lake layers (25 layers instead of 10) [on | off] ++ (ONLY valid for CLM4.5!) ++ -vsoilc_centbgc Turn on vertical soil Carbon profile, CENTURY model decomposition, ++ split Nitrification/de-Nitrification into two mineral ++ pools for NO3 and NH4 (requires clm4me Methane model), and ++ eliminate inconsistent duplicate soil hydraulic ++ parameters used in soil biogeochem. ++ (requires either CN or CNDV) ++ (ONLY valid for CLM4.5!) ++ [on,off or colen delimited list of no options] (default off) ++ no-vert Turn vertical soil Carbon profile off ++ no-cent Turn CENTURY off ++ no-nitrif Turn the Nitrification/denitrification off ++ no-stnd-bsw Turn the standard BSW for soil psi off ++ [no-vert,no-cent,no-nitrif,no-stnd-bsw, ++ no-vert:no-cent,no-nitrif:no-stnd-bsw, ++ no-vert:no-cent:no-stnd-bsw] + + New spinup options added for CLM4.5 physics (but are now deprecated and NOT recommended for use) + ++ Enter-AD Turn on Accelerated Decomposition from (6) ++ existing initial conditions (optional) (deprecated) ++ (ONLY valid for CLM4.5!) ++ AD2Lesser Jump from full AD to lesser AD spinup (optional) (4) ++ (deprecated) (ONLY valid for CLM4.5!) ++ LesserAD Lesser Accelerated Decomposition mode (3) ++ (deprecated) (ONLY valid for CLM4.5!) ++ LesserAD-exit Jump from lesser AD to normal mode (1) ++ (deprecated) (ONLY valid for CLM4.5!) ++ Two sequences are valid: 6-5-4-3-1-0 or 6-5-2-0 (where 6 and 4 are optional) ++ The recommended sequence is 5-2-0 + + + +Describe any changes made to the namelist: + Extensive list of new namelist options for CLM4.5 physics + +List any changes to the defaults for the boundary datasets: + Extensive list of new datasets for CLM4.5 + Add 360x720 grid (hcru_hcru) for CLM4.0 physics + +Describe any substantial timing or memory changes: CLM4.0 -- identical to clm4_0_59 + CLM4.5 -- identical to clm45sci15_clm4_0_58 + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): to cesm1_2_alpha02a versions + + scripts to scripts4_130204 + Machines to Machines_130204 + drv to drvseq4_2_18 + datm to datm8_130130 + rtm to rtm1_0_18 + cism to 45merge_02_cism1_121114 + csm_share to share3_130131 + pio to pio1_6_1 + mapping/gen_domain to mapping_121113b + +List all files eliminated: + +============== Eliminate PERGRO option, remove duplicated tools from clm4_0, change names to include clm4_0 +D models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 +D models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 +D models/lnd/clm/tools/mkmapdata/* ---------> remove +D models/lnd/clm/tools/mkprocdata_map/* ----> remove +D models/lnd/clm/tools/ncl_scripts/* -------> remove +D models/lnd/clm/tools/interpinic/* --------> move to under clm4_0 +D models/lnd/clm/tools/mkmapgrids/* --------> remove +D models/lnd/clm/tools/mksurfdata_map/* ----> move to under clm4_0 +D models/lnd/clm/bld/namelist_files/namelist_definition.xml ---> use clm4_5 version +D models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -> move to name with clm4_0 +D models/lnd/clm/bld/namelist_files/use_cases/pergro_pd.xml ---> Remove PERGRO option +D models/lnd/clm/bld/namelist_files/use_cases/pergro0_pd.xml --> Remove PERGRO option +D models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml -> move to name with clm4_0 + +List all files added and what they do: + +============== testing for clm4_5 and change name of some tests to include clm4_0 +A + models/lnd/clm/test/system/config_files/gen_domain +A + models/lnd/clm/test/system/tests_posttag_frankfurt_nompi +A + models/lnd/clm/test/system/user_nl_dirs/anoxia_wtsat +A + models/lnd/clm/test/system/user_nl_dirs/anoxia_wtsat/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/vrtlay +A + models/lnd/clm/test/system/user_nl_dirs/vrtlay/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/oldhyd +A + models/lnd/clm/test/system/user_nl_dirs/oldhyd/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set2_ciso +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set2_ciso/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set3_pftroot +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set3_pftroot/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/rootlit +A + models/lnd/clm/test/system/user_nl_dirs/rootlit/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ciso +A + models/lnd/clm/test/system/user_nl_dirs/ciso/user_nl_clm +A + models/lnd/clm/test/system/nl_files/nl_ch4_set2_ciso +A + models/lnd/clm/test/system/nl_files/nl_ch4_set3_pftroot +A + models/lnd/clm/test/system/nl_files/mksrfdt_10x15_1850 +A + models/lnd/clm/test/system/nl_files/nl_rootlit +A + models/lnd/clm/test/system/nl_files/nl_ciso +A + models/lnd/clm/test/system/nl_files/nl_anoxia_wtsat +A + models/lnd/clm/test/system/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 +A + models/lnd/clm/test/system/nl_files/clm4_0_mksrfdt_10x15_irr_1850 +A + models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp24_2000 +A + models/lnd/clm/test/system/nl_files/nl_vrtlay +A + models/lnd/clm/test/system/nl_files/nl_oldhyd +============== clm4_5 version of tools (from clm45sci15_clm4_0_58) +A + models/lnd/clm/tools/clm4_5 +A + models/lnd/clm/tools/clm4_5/mkmapdata +A + models/lnd/clm/tools/clm4_5/mkmapdata/mvNimport.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/rmdups.ncl +A + models/lnd/clm/tools/clm4_5/mkmapdata/regridbatch.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/mkmapdata.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/mkunitymap.ncl +A + models/lnd/clm/tools/clm4_5/mkmapdata/mknoocnmap.pl +A + models/lnd/clm/tools/clm4_5/mkmapdata/README +A + models/lnd/clm/tools/clm4_5/mkprocdata_map +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_functions.bash +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/mkprocdata_map.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/gridmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/constMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/fmain.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_in +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_all +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_wrap +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/README +A + models/lnd/clm/tools/clm4_5/ncl_scripts +A + models/lnd/clm/tools/clm4_5/ncl_scripts/cprnc.pl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getco2_historical.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/cprnc.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getregional_datasets.pl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getregional_datasets.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/README +A + models/lnd/clm/tools/clm4_5/interpinic +A + models/lnd/clm/tools/clm4_5/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c121113.nc +A + models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions +A + models/lnd/clm/tools/clm4_5/interpinic/src +A + models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_infnan_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_isnan.c +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/fmain.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/interpinic/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_isnan.h +A + models/lnd/clm/tools/clm4_5/interpinic/src/Filepath +A + models/lnd/clm/tools/clm4_5/interpinic/src/Makefile +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/README +A + models/lnd/clm/tools/clm4_5/mkmapgrids +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/domainMod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/mkmapgrids.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Filepath +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Makefile +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.namelist +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkscripgrid.ncl +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.csh +A + models/lnd/clm/tools/clm4_5/mkmapgrids/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varpar.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_timer_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_string_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varctl.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Filepath +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Makefile +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkurbanparMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +============== clm4_0 version of tools +A + models/lnd/clm/tools/clm4_0 +A + models/lnd/clm/tools/clm4_0/interpinic +A + models/lnd/clm/tools/clm4_0/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc +A + models/lnd/clm/tools/clm4_0/interpinic/interpinic.runoptions +A + models/lnd/clm/tools/clm4_0/interpinic/src +A + models/lnd/clm/tools/clm4_0/interpinic/src/interpinic.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/Makefile.common +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/fmain.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/Mkdepends +A + models/lnd/clm/tools/clm4_0/interpinic/src/Srcfiles +A + models/lnd/clm/tools/clm4_0/interpinic/src/Filepath +A + models/lnd/clm/tools/clm4_0/interpinic/src/Makefile +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvarctl.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkncdio.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varpar.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_timer_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mklaiMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksoilMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparDomMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkharvestMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparCommonMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_string_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvarpar.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varctl.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvocefMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkdomainMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparAvgMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mklanwatMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkpftMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkncdio.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Srcfiles +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Filepath +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Makefile +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml +A + models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +A + models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +============== clm4_5 version of source (from clm45sci15_clm4_0_58) +A + models/lnd/clm/src/clm4_5 +A + models/lnd/clm/src/clm4_5/biogeochem +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +A + models/lnd/clm/src/clm4_5/main +A + models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +A + models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +A + models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +A + models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +A + models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +A + models/lnd/clm/src/clm4_5/main/subgridMod.F90 +A + models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +A + models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +A + models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +A + models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +A + models/lnd/clm/src/clm4_5/main/histFileMod.F90 +A + models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +A + models/lnd/clm/src/clm4_5/main/findHistFields.pl +A + models/lnd/clm/src/clm4_5/main/restFileMod.F90 +A + models/lnd/clm/src/clm4_5/main/controlMod.F90 +A + models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +A + models/lnd/clm/src/clm4_5/main/filterMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +A + models/lnd/clm/src/clm4_5/main/clm_driver.F90 +A + models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +A + models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +A + models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +A + models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +A + models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +A + models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +A + models/lnd/clm/src/clm4_5/main/clmtype.F90 +A + models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +A + models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys +A + models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/QSatMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeCon.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/TCBCFGtools.sh +M models/lnd/clm/test/system/frankfurt.batch +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/test/system/TSMncl_tools.sh +M models/lnd/clm/test/system/TBLCFGtools.sh +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_yong +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/shortlist.interactive +M models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +M models/lnd/clm/test/system/bluefire.batch +M models/lnd/clm/test/system/frankfurt.interactive +M models/lnd/clm/test/system/TSMscript_tools.sh +M models/lnd/clm/test/system/tests_posttag_mirage +M models/lnd/clm/test/system/gen_test_table.sh +M models/lnd/clm/test/system/nl_files/gen_domain.ne30.runoptions +M models/lnd/clm/test/system/nl_files/gen_domain.T31.runoptions +M models/lnd/clm/test/system/TOPtools.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/TSMtools.sh +M models/lnd/clm/test/system/TBLscript_tools.sh +M models/lnd/clm/test/system/yellowstone.batch +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/lynx.batch +M models/lnd/clm/test/system/TBLtools.sh +M models/lnd/clm/test/system/shortlist.batch +M models/lnd/clm/test/system/TSMCFGtools.sh + +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/queryDefaultNamelist.pl +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + +MM models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +Difference in expected Fails: + + + +- +- +- +- +- +- missing datasets for us20 +- ne16 missing finidat file for 1850 +- ne60 missing finidat file for 1850 +- 1x1_tropicAtl missing finidat file for 1850 +- +- +- + + + +@@ -25,10 +13,17 @@ + + + ++ + ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + +- missing datasets for wus12 + missing datasets for us20 + ne16 missing finidat file for 1850 + ne60 missing finidat file for 1850 +@@ -38,17 +33,6 @@ + + + +- +- +- +- cprnc showing diffs are not b4b +- problem configuring +- problem configuring +- clm stand-alone can no longer work +- clm stand-alone can no longer work +- +- +- + + + +@@ -62,24 +46,6 @@ + + + +- +- +- +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Failing for long time. endrun initiated from CNBalanceCheckMod.F90. +- Failing for long time. __cnbalancecheckmod_NMOD_cbalancecheck. +- Failing for long time. Fail because erU61 fails. +- Failing for long time. Fail because erU61 fails. +- Have been failing for a long time . +- Have been failing for a long time. +- Have been failing for a long time. +- Have been failing for a long time. +- +- +- + + + +@@ -93,91 +59,108 @@ + + + +- +- +- Initial simulation fails +- Initial simulation fails +- History files are different +- Initial simulation fails +- Initial simulation fails +- History files are different on restart (known problem + restarting mid-day with _GLC: bug 1557) +- Initial simulation fails +- build error? +- +- + + +- ???? + + + + + + +- ???? + + + + +- Initial simulation fails +- Initial simulation fails case name too + long +- History files are different on restart (known + problem restarting mid-day with _GLC: bug 1557) ++ ++ ++ ++ ++ ++ ++ ++ ++ + + + + + +- +- +- T62 not working +- Dies early with a floating point trap +- +- Baseline comp. test will always fail +- build error? +- +- + + + History files are different on restart (known problem +restarting mid-day with _GLC: bug 1557) + + ++ ++ ++ ++ + + + History files are different on restart (known problem restarting +mid-day with _GLC: bug 1557) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ + + +- ++ + + +- +- ++ ++ ++ + missing datasets + missing datasets +- missing datasets +- +- ++ missing datasets ++ missing 0.1 mapping dataset (for RTM at R01) ++ ++ ++ ++ ++ ++ + ++ ++ scripts issue with ocean not threaded ++ Restart difference ++ Soil balance error on restart ++ scripts issue with ocean not threaded ++ ++ scripts issue with ocean not threaded ++ bad compset name ++ surfdata and pftdyn file mismatched ++ Soil balance error on restart ++ scripts issue component not threaded ++ missing finidat file ++ missing finidat file ++ + +- ???? +- ???? ++ problem building with mpi-serial with pgi compiler ++ missing LAPACK symbol dgbsv ++ scripts issue with ocean not threaded ++ Need LAPACK for PGI (dgbsv) ++ Need LAPACK for PGI (dgbsv) ++ Bad compset name: ICNCROP ++ scripts issue with ocean not threaded ++ ++ problem building with mpi-serial with pgi compiler ++ missing LAPACK symbol dgbsv ++ missing LAPACK symbol dgbsv ++ scripts issue with ocean not threaded ++ Need LAPACK for PGI (dgbsv) ++ Need LAPACK for PGI (dgbsv) ++ Bad compset name: ICNCROP ++ scripts issue with ocean not threaded + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: yes + + test_system testing: + + yellowstone batch: yes + frankfurt interactive: yes + yellowstone interactive: yes + frankfurt batch: yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + + yellowstone/PTCLM: no (PTCLM still doesn't quite work) + +CLM tag used for the baseline comparison tests if applicable: clm4_0 to clm4_0_59 clm4_5 to clm45sci15_clm4_0_58 + +Changes answers relative to baseline: Yes, for some resolutions for clm4_0 -- because of new default initial condition files in compsets + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + For clm4_0... + New initial conditions for: f09/f19-I_2000, f09/f19-I_1850, f09/f19-I_1850-2000 + f09/f19-I_1948-2004, f09/f19-I_1850_SPINUP_3HrWx + f09/f19-I_RCP + +=============================================================== +=============================================================== +Tag name: clm4_0_59 +Originator(s): mvertens (Mariana Vertenstein) / erik +Date: Thu Dec 20 09:24:16 MST 2012 +One-line Summary: restructure clmtype and all pointer references, new directory structure + +Purpose of changes: + Reststucture trunk directory tree to prepare for incorporation of clm4_5 + Move all cpp-ifdefs to clm_varctl and introduce new logical variables in their place + Restructure clmtype to remove nesting - and also redo all the pointer references + All together the code can then move to having no cpp-ifdefs + +Test level of tag: + std-test + +Bugs fixed (include bugzilla ID): + None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 147 (mkgriddata can't straddle over Greenwich) + 025 (SCM mode can NOT use a global finidat file) + 017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + 1598 (non-repeatable results when running with CNDV and/or CROP) + + Threading seems to work for all cases where CROP and/or CNDV + is not on + +Describe any changes made to build system: + New directory structure + +Describe any changes made to the namelist: + variables use_c13 and use_c14 added to namelist_definition.xml file + +List any changes to the defaults for the boundary datasets: + No + +Describe any substantial timing or memory changes: + Currently more memory for compsets without CN, etc - less memory + when CN, CNDV, etc are activated. This will be fixed in clm4_0_59. + +Code reviewed by: + self (proposed changes reviewed by Erik, Bill and Stefan) + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + src/biogeochem -> src/clm4_0/biogeochem + src/biogeophys -> src/clm4_0/biogeophys + src/main -> src/clm4_0/main + + +List all files added and what they do: + None + +List all existing files that have been modified, and describe the changes: + + All files in src/clm4_0 have been modified relative to their + original versions to remove the cpp-ifdefs and to adjust pointer + references to new names + + M src/cpl_share/clm_cpl_indices.F90 + M src/cpl_mct/lnd_comp_mct.F90 + M src/cpl_esmf/lnd_comp_esmf.F90 + + M bld/configure + M bld/namelist_files/namelist_definition.xml + M test/system/yellowstone.interactive + M test/system/yellowstone.batch + + Add in 360x720_cruncep datasets (from Erik). + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl --- correct number of tests + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +Machines testing ran on: + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: no + + PTCLM + yellowstone: no + + test_system testing: + + yellowstone batch: yes + yellowstone interactive: no + frankfurt batch: no + frankfurt interactive: yes + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + +Difference in expected fails from testing: + ++ Numbers change for build-namelist unit tests + + +- ???? + + + + +- ???? +- ???? +- ???? + +- +- ???? +- + + +CLM tag used for the baseline comparison tests if applicable: + clm4_0_58 + +Changes answers relative to baseline: + no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_58 +Originator(s): erik (Erik Kluzek) +Date: Fri Dec 14 05:13:33 MST 2012 +One-line Summary: Uncomment us20 and wus12 datasets, more testing to: bluefire, yellowstone, frankfurt + +Purpose of changes: + +Uncomment WRF grids in namelist xml files. Fix mkprocdata bug on lynx. + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1601 (mkprocdata seg faults on lynx) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: No + +Describe any changes made to the namelist: No + +List any changes to the defaults for the boundary datasets: Yes + uncomment out wus12 and us20 WRF datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, csm_share + + scripts to: scripts4_121207b + Machines to: Machines_121207 + csm_share to: share3_121204a + +List all files eliminated: None + +List all files added and what they do: Add frankfurt test lists + +>>>>>>>>>>>>>>>> Tests for frankfurt + A models/lnd/clm/test/system/frankfurt.interactive + A models/lnd/clm/test/system/frankfurt.batch + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_system + M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml + + M models/lnd/clm/test/system/bluefire.batch + M models/lnd/clm/test/system/yellowstone.batch + M models/lnd/clm/test/system/nl_files/mkprocdata_ne30_to_f19_I2000 + +>>>>>>>>>>>>>>>> Fix mkprocdata and allow it to run from a different exe directory for testing + M models/lnd/clm/tools/mkprocdata_map/src/mkprocdata_map.F90 + M models/lnd/clm/tools/mkprocdata_map/src/gridmapMod.F90 + M models/lnd/clm/tools/mkprocdata_map/src/fmain.F90 + M models/lnd/clm/tools/mkprocdata_map/src/shr_file_mod.F90 + M models/lnd/clm/tools/mkprocdata_map/src/fileutils.F90 + M models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_all + M models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_wrap + +>>>>>>>>>>>>>>>> Fix bug in unit-tester + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + +>>>>>>>>>>>>>>>> Uncomment WRF files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Machines testing ran on: + + build-namelist unit tester: yes + + CESM test lists: + + bluefire/CESM: yes + bluefire/CESM/allIcompsets: yes + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + bluefire interactive: yes + yellowstone batch: yes + yellowstone interactive: yes + frankfurt batch: yes + frankfurt interactive: yes + + test_driver.sh tools testing: + + bluefire interactive: yes + lynx interactive: yes + yellowstone interactive: yes + frankfurt interactive: yes + +Difference in expected fails from testing: + +Index: expectedClmTestFails.xml +=================================================================== +--- expectedClmTestFails.xml (revision 42691) ++++ expectedClmTestFails.xml (working copy) +@@ -5,12 +5,12 @@ + + + +- + + +- ne16 missing finidat file for 1850 +- ne60 missing finidat file for 1850 +- 1x1_tropicAtl missing finidat file for 1850 ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + + +@@ -24,6 +24,17 @@ + + + ++ ++ ++ ++ ++ missing datasets for wus12 ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 ++ ++ + + + +@@ -101,6 +112,19 @@ + + + ++ ++ ++ ???? ++ ???? ++ ++ ++ ++ ++ Initial simulation fails ++ Initial simulation fails case name too +long ++ History files are different on restart (known +problem restarting mid-day with _GLC: bug 1557) ++ ++ + + + +@@ -118,6 +142,11 @@ + History files are different on restart (known problem +restarting mid-day with _GLC: bug 1557) + + ++ ++ ++ History files are different on restart (known problem restarting +mid-day with _GLC: bug 1557) ++ ++ + + + +@@ -128,6 +157,18 @@ + missing datasets + + ++ ++ ++ ???? ++ ???? ++ ???? ++ ???? ++ ???? ++ ++ ++ ???? ++ ++ + + + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_58 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +=============================================================== +Tag name: clm4_0_57 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Fri Nov 30 14:20:13 MST 2012 +One-line Summary: update trunk with release mods, some rtm fixes + +Purpose of changes: + +CLM: Merge the changes Erik made in the release branch tags to trunk. +RTM: Add effective velocity as a namelist variable. + Change rdirc file. + Add RTM tests to test_system batch CLM tests. + Clean up logic in RtmFloodInit so R01 works without SLOPE and MAX_VOLR. + Change rdirc file to rdirc_0.5x0.5_simyr2000_slpmxvl_c120717.nc which is + correct and contains FLOOD and MAX_VOLR. This fixes an error in choice + of rdirc file from clm4_0_55 / rtm1_0_10 + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: Changed RTM rdirc file. + +Describe any substantial timing or memory changes: None Known + +Code reviewed by: Erik, Tony, Mariana (in progress) + +List any svn externals directories updated (csm_share, mct, etc.): + - rtm1_0_13 + - scripts4_121127 + - Machines_121126 + - drvseq4_2_13 + - datm8_121123 + - cism1_121114 + +List all files eliminated: + + - Deleted during release tag cleanup +D models/lnd/clm/test/system/TCB.sh +D models/lnd/clm/test/system/tests_pretag_bluefire +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh +D models/lnd/clm/test/system/config_files/17p_cndvsc_m +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m +D models/lnd/clm/test/system/config_files/17p_cndvsc_o +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm +D models/lnd/clm/test/system/config_files/_persc_dh +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +D models/lnd/clm/test/system/config_files/17p_cndvsc_s +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s +D models/lnd/clm/test/system/config_files/_persc_dm +D models/lnd/clm/test/system/config_files/_persc_do +D models/lnd/clm/test/system/config_files/_scnv_ds +D models/lnd/clm/test/system/config_files/_persc_ds +D models/lnd/clm/test/system/config_files/17p_sc_dh +D models/lnd/clm/test/system/config_files/17p_sc_dm +D models/lnd/clm/test/system/config_files/17p_sc_do +D models/lnd/clm/test/system/config_files/_sc_dh +D models/lnd/clm/test/system/config_files/17p_sc_ds +D models/lnd/clm/test/system/config_files/_sc_dm +D models/lnd/clm/test/system/config_files/21p_cncrpsc_h +D models/lnd/clm/test/system/config_files/17p_cnsc_h +D models/lnd/clm/test/system/config_files/_sc_do +D models/lnd/clm/test/system/config_files/21p_cncrpsc_dh +D models/lnd/clm/test/system/config_files/17p_cnsc_dh +D models/lnd/clm/test/system/config_files/21p_cncrpsc_m +D models/lnd/clm/test/system/config_files/17p_cnsc_m +D models/lnd/clm/test/system/config_files/_sc_ds +D models/lnd/clm/test/system/config_files/21p_cncrpsc_o +D models/lnd/clm/test/system/config_files/17p_cnsc_o +D models/lnd/clm/test/system/config_files/17p_cnsc_dm +D models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +D models/lnd/clm/test/system/config_files/17p_cnsc_do +D models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +D models/lnd/clm/test/system/config_files/21p_cncrpsc_do +D models/lnd/clm/test/system/config_files/21p_cncrpsc_s +D models/lnd/clm/test/system/config_files/17p_sc_h +D models/lnd/clm/test/system/config_files/17p_cnsc_ds +D models/lnd/clm/test/system/config_files/21p_cncrpsc_ds +D models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +D models/lnd/clm/test/system/config_files/_mexsc_ds +D models/lnd/clm/test/system/config_files/17p_cnc13sc_do +D models/lnd/clm/test/system/config_files/17p_sc_m +D models/lnd/clm/test/system/config_files/17p_sc_o +D models/lnd/clm/test/system/config_files/_sc_h +D models/lnd/clm/test/system/config_files/17p_cnnfsc_dh +D models/lnd/clm/test/system/config_files/_sc_m +D models/lnd/clm/test/system/config_files/17p_cnnfsc_dm +D models/lnd/clm/test/system/config_files/_sc_o +D models/lnd/clm/test/system/config_files/17p_cndvsc_dh +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh +D models/lnd/clm/test/system/config_files/17p_cnnfsc_do +D models/lnd/clm/test/system/config_files/_sc_s +D models/lnd/clm/test/system/config_files/17p_cndvsc_dm +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm +D models/lnd/clm/test/system/config_files/17p_cndvsc_do +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds +D models/lnd/clm/test/system/config_files/_vansc_ds +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +D models/lnd/clm/test/system/config_files/_nil3sc_dh +D models/lnd/clm/test/system/config_files/_nil3sc_dm +D models/lnd/clm/test/system/config_files/_scsnf_dh +D models/lnd/clm/test/system/config_files/_scsnf_dm +D models/lnd/clm/test/system/config_files/_scsnf_do +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h +D models/lnd/clm/test/system/config_files/17p_cndvsc_h +D models/lnd/clm/test/system/TBL.sh +D models/lnd/clm/test/system/tests_pretag_edinburgh +D models/lnd/clm/test/system/tests_pretag_edinburgh_nompi +D models/lnd/clm/test/system/TBR.sh +D models/lnd/clm/test/system/TER.sh +D models/lnd/clm/test/system/mknamelist +D models/lnd/clm/test/system/tests_posttag_hybrid_regression +D models/lnd/clm/test/system/tests_posttag_purempi_regression +D models/lnd/clm/test/system/TRP.sh +D models/lnd/clm/test/system/tests_pretag_jaguarpf +D models/lnd/clm/test/system/TSMrst_tools.sh +D models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +D models/lnd/clm/test/system/nl_files/nl_per +D models/lnd/clm/test/system/nl_files/nl_voc +D models/lnd/clm/test/system/nl_files/clm_std +D models/lnd/clm/test/system/nl_files/multi_inst +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_1 +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_2 +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_3 +D models/lnd/clm/test/system/nl_files/clm_nortm +D models/lnd/clm/test/system/nl_files/clm_transient_rcp2.6 +D models/lnd/clm/test/system/nl_files/clm_ndepdyn +D models/lnd/clm/test/system/nl_files/clm_transient_rcp4.5 +D models/lnd/clm/test/system/nl_files/clm_pftdyn +D models/lnd/clm/test/system/nl_files/clm_transient_rcp8.5 +D models/lnd/clm/test/system/nl_files/clm_per0 +D models/lnd/clm/test/system/nl_files/nl_ptsmode_ocn +D models/lnd/clm/test/system/nl_files/nl_urb_br +D models/lnd/clm/test/system/nl_files/clm_spin +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp6 +D models/lnd/clm/test/system/nl_files/clm_urb1pt +D models/lnd/clm/test/system/nl_files/nl_urb +D models/lnd/clm/test/system/nl_files/nl_crcrop +D models/lnd/clm/test/system/nl_files/clm_per +D models/lnd/clm/test/system/nl_files/clm_drydep +D models/lnd/clm/test/system/nl_files/nl_std +D models/lnd/clm/test/system/nl_files/clm_glcmec +D models/lnd/clm/test/system/nl_files/clm_transient_rcp6 +D models/lnd/clm/test/system/nl_files/nl_crop +D models/lnd/clm/test/system/nl_files/clm_usrdat +D models/lnd/clm/test/system/nl_files/nl_cn_conly +D models/lnd/clm/test/system/nl_files/clm_stdIgnYr +D models/lnd/clm/test/system/nl_files/clm_transient_20thC +D models/lnd/clm/test/system/nl_files/nl_ptsmode +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp2.6 +D models/lnd/clm/test/system/nl_files/clm_irrig +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp4.5 +D models/lnd/clm/test/system/nl_files/nl_lfiles +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp8.5 +D models/lnd/clm/test/system/TSMpergro.sh +D models/lnd/clm/test/system/TSMcnspinup.sh +D models/lnd/clm/test/system/TBLrst_tools.sh +D models/lnd/clm/test/system/CLM_runcmnd.sh +D models/lnd/clm/test/system/TSM.sh +D models/lnd/clm/test/system/tests_posttag_lynx +D models/lnd/clm/tools/mkprocdata_map/camhomme +D models/lnd/clm/tools/mkprocdata_map/camhomme/src +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/mkprocdata_map.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/gridmapMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Depends +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/domainMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_file_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/nanMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Srcfiles +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Filepath +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Makefile +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/fileutils.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_kind_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/mkprocdata_map_in +D models/lnd/clm/tools/mkprocdata_map/clm/src +D models/lnd/clm/tools/mkprocdata_map/clm/src/mkprocdata_map.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/gridmapMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/constMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/fmain.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/shr_file_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/nanMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/Mkdepends +D models/lnd/clm/tools/mkprocdata_map/clm/src/Srcfiles +D models/lnd/clm/tools/mkprocdata_map/clm/src/Filepath +D models/lnd/clm/tools/mkprocdata_map/clm/src/Makefile +D models/lnd/clm/tools/mkprocdata_map/clm/src/fileutils.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/shr_kind_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_in +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_all +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_wrap +D models/lnd/clm/tools/mkprocdata_map/clm/README +D models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat +D models/lnd/clm/tools/ncl_scripts/RMSlahey.dat +D models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl +D models/lnd/clm/tools/ncl_scripts/RMSjaguar.dat +D models/lnd/clm/tools/ncl_scripts/RMSintel.dat +D models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat +D models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl +D models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl +D models/lnd/clm/tools/ncl_scripts/runDepositionRegrid.pl +D models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl +D models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl +D models/lnd/clm/bld/config_files/config_sys_defaults.xml +D models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl +D models/lnd/clm/bld/namelist_files/datm-build-namelist +D models/lnd/clm/bld/namelist_files/checklatsfiles.ncl +D models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml +D models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml + +List all files added and what they do: + + - Added for RTM testing +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01 +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff +A models/lnd/clm/test/system/user_nl_dirs/rtm + - Added from release tags +A models/lnd/clm/test/system/yellowstone.interactive +A models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +A models/lnd/clm/test/system/nl_files/mkprocdata_ne30_to_f19_I2000 +A models/lnd/clm/test/system/yellowstone.batch +A models/lnd/clm/tools/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_functions.bash +A models/lnd/clm/tools/mkprocdata_map/src/mkprocdata_map.F90 +A models/lnd/clm/tools/mkprocdata_map/src/gridmapMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/constMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/Makefile.common +A models/lnd/clm/tools/mkprocdata_map/src/fmain.F90 +A models/lnd/clm/tools/mkprocdata_map/src/shr_file_mod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/nanMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/Mkdepends +A models/lnd/clm/tools/mkprocdata_map/src/Srcfiles +A models/lnd/clm/tools/mkprocdata_map/src/Filepath +A models/lnd/clm/tools/mkprocdata_map/src/Makefile +A models/lnd/clm/tools/mkprocdata_map/src/fileutils.F90 +A models/lnd/clm/tools/mkprocdata_map/src/shr_kind_mod.F90 +A models/lnd/clm/tools/mkprocdata_map/src +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_in +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_all +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_wrap +A models/lnd/clm/tools/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/README +A models/lnd/clm/bld/config_query +A models/lnd/clm/doc/UsersGuide/modelnl/xmldef2html_compsets +A models/lnd/clm/doc/UsersGuide/modelnl/showinfo.js +A models/lnd/clm/doc/UsersGuide/modelnl/index.cpp +A models/lnd/clm/doc/UsersGuide/modelnl/Makefile +A models/lnd/clm/doc/UsersGuide/modelnl + +List all existing files that have been modified, and describe the changes: + + - put back qflx_snomelt for consistency with older models. clm4_0_55 mods to the snow + balance check otherwise only effect the diagnostic fields errh2osno, snow_source and snow_sinks +M models/lnd/clm/src/main/histFldsMod.F90 + - modified for RTM testing +M config_files/config_CLMtestCompsets.xml +M bluefire.batch + - modified during release tag modification +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/mirage.interactive +M models/lnd/clm/test/system/test_system +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_yong +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/lynx.interactive +M models/lnd/clm/test/system/shortlist.interactive +M models/lnd/clm/test/system/TSMscript_tools.sh +M models/lnd/clm/test/system/tests_posttag_mirage +M models/lnd/clm/test/system/gen_test_table.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/bluefire.interactive +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +M models/lnd/clm/tools/ncl_scripts +M models/lnd/clm/tools/ncl_scripts/README +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/tools/interpinic +M models/lnd/clm/tools/mksurfdata_map/src +M models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkutilsMod.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 +M models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +M models/lnd/clm/bld +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/queryDefaultNamelist.pl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/config_files/config_definition.xsl +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/README +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/appendix.xml +M models/lnd/clm/doc/UsersGuide/ptclm.xml +M models/lnd/clm/doc/Quickstart.userdatasets +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE +M models/lnd/clm/doc/ChangeLog +M models/lnd/clm/doc/CodeReference/Filepath +M models/lnd/clm/doc/KnownLimitations +M models/lnd/clm/doc/ChangeSum +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/README +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 +M ChangeLog +M ChangeSum +M READM + +Machines testing ran on: (in progress) + + build-namelist unit tester: yes + + - OK. All FAILs (~78 of them) should pass during the next round. + + CESM test lists: + + bluefire/CESM: yes + + -Fail due to throuput comparison problems: + + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.164220.tputcomp.clm4_0_56 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.164220.tputcomp.clm4_0_56 + + -Fail due to new and correct rdirc file. diffs in r2x_Forr_roff & r2x_Forr_ioff + These should pass next time around: + + FAIL ERS_D.f45_g37.I.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL NCK.T31_g37.I.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL PET_PT.f45_g37.I1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + + bluefire/CESM/allIcompsets: yes + + Error in SBN script handling in generate of namelist files so all compare tests are BFAILs. + + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + + 4 xFAIL. The rest that fail now, but should pass the next time around. + + - Fail due to new and correct rdirc file. diffs in r2x_Forr_roff & r2x_Forr_ioff + These should pass next time around: + + FAIL ERS_Ld211.f10_f10.ICNADSPIN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL ERS_Ln48_D_P64x16.ne30_g16.ICN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL PET_D_P1x64.ne30_g16.ICN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL ERS_Ld211.f10_f10.I_2000_VOC_CN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + + - Fail due to throughput comparison + + FAIL ERS_Ld211.f10_f10.ICNADSPIN.bluefire_ibm.GC.164759.tputcomp.clm4_0_56 + FAIL ERS_Ld211_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.164759.tputcomp.clm4_0_56 + + - Will pass next time, these tests just introduced + + BFAIL ERS.f19_g16.I_2000_CN_rtmR01.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + BFAIL ERS.f19_g16.I_2000_CN_rtmOff.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + BFAIL ERS.f19_g16.I_2000_CN_rtmOn.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + + bluefire interactive: yes + + - xFAIL or new tests that will pass next time (missing baselines): + + BFAIL ERS_D_Mmpi-serial.CLM_USRDAT.IalaskaCN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.CLM_USRDAT.I_2000_1PTFRC_US-UMB.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_P1x64_Mmpi-serial.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_P1x25_Mmpi-serial.5x5_amazon.I_2000.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.1x1_asphaltjungleNJ.I_2000_VOC.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x64_Mmpi-serial.f19_g16.I_2000_GLCMECPD.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CNDV.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_VOC_SNCRFRC_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + + lynx/pgi batch: yes + + - xFAIL or will pass next time (new rdirc file effecting r2x_Forr_roff & r2x_Forr_ioff) + + FAIL ERS_Ln48_D.f45_g37.I_2000_VOC.lynx_pgi.GC.170117.compare_hist.clm4_0_56 + FAIL ERS_Ln48_D.f10_f10.I_2000_CN.lynx_pgi.GC.170117.compare_hist.clm4_0_56 + + lynx/pgi interactive: yes + + - OK except for new test that will pass next time (missing baselines): + + BFAIL SMS_RLA_Mmpi-serial.f45_f45.I.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL SMS_Mmpi-serial.CLM_USRDAT.I_2000_1PTFRC_US-UMB.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x12_Mmpi-serial.f10_f10.ICNCROP.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PT.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PT.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + + lyn/intel mirage testlist: yes + + - OK except for new tests will pass next time (missing baselines): + + BFAIL ERS_Mmpi-serial.1x1_brazil.I_2000.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERI_D_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.1x1_asphaltjungleNJ.I_2000_VOC.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x12_Mmpi-serial.f10_f10.I_2000_CN.lynx_intel.GC.095009.compare_hist.clm4_0_56 + + test_driver.sh tools testing: + + bluefire interactive: yes + + test 001 fails due to a bug in mkprocdata_map_wrap + test 002 fails due to 001 + test 008 will pass next time + + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: modification to default value for effvel in RtmMod.F90 + changes the values of r2x_Forr_roff & r2x_Forr_ioff. This causes cprnc to fail. + This should pass in the next round and matches the value found in CLM4.5. + + - real(r8),parameter :: effvel(nt_rtm) = 0.7_r8 ! downstream velocity (m/s) + + real(r8),parameter :: effvel(nt_rtm) = 1.0_r8 ! downstream velocity (m/s) + + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + with flooding on and new rdirc file, climate may be different. + with flooding off we have b4b + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_56 +Originator(s): sacks (Sacks Bill 303-497-1762 CGD) +Date: Tue Nov 27 14:12:42 MST 2012 +One-line Summary: fix s2x tsrf, add s2x diagnostics + +Purpose of changes: + +The s2x tsrf field was not being time-averaged; this is fixed now. + +Also, add history fields giving per-column diagnostics of the fields sent +from CLM to GLC. + +Requirements for tag: + fix bug 1590 + test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage-test for lynx_intel + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): 1590 (surface temperature sent from CLM to GLC not averaged properly) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>> Do time-averaging of tsrf field; remove calls to create_clm_s2x +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +>>>>>>> Call to create_clm_s2x now done here instead of lnd_comp_mct / +>>>>>>> lnd_comp_esmf, so that clm_s2x can be used for hist file writes +>>>>>>> (this is needed so that the fields are updated before the history +>>>>>>> updates happen in the driver) +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 + +>>>>>>> Clean up interface to create_clm_s2x +M models/lnd/clm/src/main/clm_glclnd.F90 + +>>>>>>> Add capability to output fields sent from CLM to GLC +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/histFldsMod.F90 + +>>>>>>> Remove non-existent PMT test +M models/lnd/clm/test/system/lynx.batch + +>>>>>>> Add ERS_Ln48_P96x2.f19_g16.I_2000_VOC_SNCRFRC_CN_GLCMECPD to xFail +>>>>>>> list; add comment +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Machines testing ran on: + + build-namelist unit tester: no + + CESM test lists: + + bluefire/CESM: yes + All PASS except: + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + + These are expected failures: diffs in topo and tsrf fields + sent to coupler, and topo diffs are small (RMS ~ 1e-13) + + bluefire/CESM/allIcompsets: no + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + All PASS or xFAIL except: + FAIL ERS_Ld211_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.101753.compare_hist.clm4_0_55 + + I believe this is an old problem, not due to the changes here: see bug 1598 + + bluefire interactive: yes + All PASS or xFAIL + + lynx/pgi batch: yes + All PASS or xFAIL + + lynx/pgi interactive: yes + All PASS + + lyn/intel mirage testlist: yes + All PASS + + test_driver.sh tools testing: + + bluefire interactive: no + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_55 + +Difference in expected fails from testing: + + Note: the additional expected fail is NOT a new failure, it is just newly + documented + + --- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (.../trunk_tags/clm4_0_55) (revision 42229) + +++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (.../branches/fix_glc_tsrf) (revision 42229) + @@ -90,7 +90,7 @@ + + + Initial simulation fails + - History files are different on restart + + History files are different on restart (known problem restarting mid-day with _GLC: bug 1557) + Initial simulation fails + build error? + + @@ -113,6 +113,9 @@ + + + + + + + History files are different on restart (known problem restarting mid-day with _GLC: bug 1557) + + + + + + +Changes answers relative to baseline: YES: changes tsrf and topo fields +sent to GLC (everything else bfb) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: glc_mec + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + new climate for tsrf; roundoff-level for topo field sent to GLC. Note that these + fields are limited to GLC, and don't feed back to the atmosphere at all. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? For topo: examined differences in cprnc output + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: None done + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_55 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Thu Nov 15 10:17:23 MST 2012 +One-line Summary: bring in flooding capability + +Purpose of changes: + + Test driver mods from Tony that allows flooding from rof to lnd. Also + brought in code from the rtmflood branch to handle the new flooding values. + Fthresh calculed by reading SLOPE and MAX_VOLR from the rdirc file. Merged + in qflx_snow_melt from Swensons perfmafrost sims branch to fix snow + balance problems in BalanceCheckMod.F90. + +Requirements for tag: + + Test flooding code in CLM by varying fthresh. Test coupler mods by + plotting coupler fields. Look at differences in overall energy balance + with and without flooding. + +Test level of tag: doc, critical, standard, std-test, reg-test + + Critical. Bluefire CESM/CLM tests and namelist tests only + +Bugs fixed (include bugzilla ID): + + N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + N/A + +Describe any changes made to the namelist: + + N/A + +List any changes to the defaults for the boundary datasets: + + N/A + +Describe any substantial timing or memory changes: + + N/A + +Code reviewed by: + + Tony Craig, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): + + Updated all of the following (in relation to clm4_0_54) + scripts4_121105 + Machines_121106 + drvseq4_2_11 + rtm1_0_10 + cism1_121012 + share3_121025 + pio1_5_7 + mapping_121106 + +List all files eliminated: + + N/A + +List all files added and what they do: + + N/A + +List all existing files that have been modified, and describe the changes: + + -the following all for bringing in qflx_snow_melt for new + -balance check calculation with flooding + M models/lnd/clm/src/main/clmtypeInitMod.F90 + M models/lnd/clm/src/main/histFldsMod.F90 + M models/lnd/clm/src/main/mkarbinitMod.F90 + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 + + - mods to bring in flooding from rtmflood + M main/clm_driver.F90 + M main/cmlmtype.F90 + M main/clmtypeInitMod.F90 + M main/histFldsMod.F90 + M main/mkarbinitMod.F90 + M main/clm_varcon.F90 + + - fixes for some test problems + M build-namelist_test.pl + M clm/bld/configure + +Machines testing ran on: + + build-namelist unit tester: yes + + 6 xFails - all OK. + + CESM test lists: + + bluefire/CESM: yes + + Fail due to new coupler fields: + + new field r2x_Forr_roff + + NCK.T31_g37.I.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_E.T31_g37.I1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERI.T31_g37.IG1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + SMS.T31_g37.IG4804.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + + new fields r2x_Forr_roff & r2x_Forr_ioff + + ERS_D.f45_g37.I.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + PET_PT.f45_g37.I1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERB.ne30_g16.I_1948-2004.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + PET_PT.f10_f10.I20TRCN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + SMS.f10_f10.IRCP45CN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + + Fail due to throughput differences: + + FAIL ERS_D.f45_g37.I.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + + bluefire/CESM/allIcompsets: no + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: no + bluefire interactive: no + lynx/pgi batch: no + lynx/pgi interactive: no + lyn/intel mirage testlist: no + + test_driver.sh tools testing: + + bluefire interactive: no + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: + + us20/wus12 tests were removed so removed from expected fail + ne16/ne60/1x1_tropicAtl 20thC transient tests fails -- need finidat files + New bug: ERS_Ln48_D_P1x64.f19_g16.I_2000_GLCMECPD (bugzilla 1557) + New testname: ERS_Ln48_D_P1x64.f45_g37.I_2000_VOC (was ERS48s_...) + New fail: ERS_Ld211.1x1_camdenNJ.I_2000_VOC, ERS_Ld211_D_P112x2.f10_f10.ICNCROP + Some ERS_L tests now pass that failed previously + I1PT tests pass now + Most SBN tests pass now + Intel single point tests pass now +@@ -5,14 +5,11 @@ + + + +- us20 not fully implmented +- us20 not fully implmented +- wus12 not fully implmented +- wus12 not fully implmented + + +- us20 not fully implemented +- wus12 not fully implemented ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + + +@@ -89,19 +86,17 @@ + CESM script issue + Restart length different + Restart length different +- Initial simulation fails ++ Initial simulation fails ++ History files are different on restart + Initial simulation fails + build error? + + + + +- datm namelist problem for single-point forcing +- datm namelist problem for single-point forcing ++ ???? + + +- CESM script issue +- CESM script issue + + + +@@ -110,10 +105,8 @@ + + + T62 not working +- ignore_ic_date is incompatable with crop! +- CESM script problem didn't see both files +- CESM script problem didn't see both files +- build error? ++ Dies early with a floating point trap ++ build error? + + + +@@ -123,22 +116,9 @@ + + + +- datm namelist issue +- datm namelist issue +- datm namelist issue + 277/277 < PASS> + Successully ran all testing for build-namelist + + Cleanup files created + rm: lnd_in.default: A file or directory in the path name does not exist. + rm: temp_file.txt: A file or directory in the path name does not exist. + # Looks like you failed 4 tests of 277. + +%%cesm/clm tests + + mostly OK + + generate : ./cs.status.164019.bluefire + + nohup create_test_suite -input_list bluefire.clm.auxtest -compare clm4_0_50 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_51 -testroot /glade/scratch/muszala/tests > & ! bf_out_`date +"%m%d%y"`.lg & + ID: 203212 + + ## Reason: throughput measure off + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_50 + FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_50 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_50 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.tputcomp.clm4_0_50 + ## baseline diretory already existed, error copying over nc files + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_D.f45_g37.I.bluefire_ibm.generate.clm4_0_51 + FAIL NCK.T31_g37.I.bluefire_ibm.generate.clm4_0_51 + FAIL PST.f45_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL PET_PT.f45_g37.I1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_51 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.generate.clm4_0_51 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.generate.clm4_0_51 + ## fails due to cprnc time check. new runs are 11 ts. in 50 these were 10, I expect these to pass next time around + FAIL ERS_D.f45_g37.I.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_50 + ## No Lm3 directories created during clm4_0_50 generate...new case, should pass next time around + SFAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.203212 + ERROR: datm.buildnml.csh failed + BFAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_50 + No dir to compare to in tag 50 + ## problems in generate due to scripts for single point + SFAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.203212 + ERROR: datm.buildnml.csh failed also failed during generate + BFAIL SMS.1x1_numaIA.ICN.bluefire_ibm.compare_hist.clm4_0_50 + No dir to compare to in tag 50 - failed during generate + + ## these were failing but passed when rerun - keep an eye on these + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_50 + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_50 + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_50 + + went to generated ref case + ./setup -clean + ./setup + then build and rerun + + went to generate case + ./setup -clean + ./setup + clean-build, then build then reurn + + did the same in the CG case for ref and normal case + + After hand running + ./cs.status.203212.bluefire | grep ERB.f09_g16.I1850SPINUPCN + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.memleak + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.memcomp.clm4_0_50 + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.tputcomp.clm4_0_50 + + This test was rerun with a new testlist + ./cs.status.203212.bluefire | grep ERB.ne30_g16.I_1948-2004 + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.memleak + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.memcomp.clm4_0_50 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.tputcomp.clm4_0_50 + throughput tol. error + + ./cs.status.141307.bluefire + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.memleak + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.memcomp.clm4_0_50 + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.tputcomp.clm4_0_50 + +%%cesm/clm rof tests + nohup create_test_suite -input_list bluefire.clmRof.auxtest -compare clm4_0_50 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_51 -testroot /glade/scratch/muszala/tests > & ! bf_out_`date +"%m%d%y"`.lg & + + These don't exist anymore, but will be replaced once Tony works out default grid resolutions for r01 and r05 + + ID: 091144 + + BFAIL SMR.f19_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + BFAIL SMR.f09_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + FAIL SMR.f05_g16.I_2000_CN.bluefire_ibm + larger scipt errors in rof - kills the following two tests outright + BFAIL SMR.f05_g16.I_2000_CN.bluefire_ibm.generate.clm4_0_51 + BFAIL SMR.f05_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + FAIL SMR.ne120_g16.I_2000_CN.bluefire_ibm.generate.clm4_0_51 + can't copy in, clm4_0_51 baseline already exists + BFAIL SMR.ne120_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + RUN SMR.ne240_g16.I_2000_CN.bluefire_ibm.GC.091144 + + +%%%%%% testing reporting end + +CLM tag used for the baseline comparison tests if applicable: + + clm4_0_50 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_50 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Fri Sep 21 15:13:52 MDT 2012 +One-line Summary: testing of clm and new rof component + +Purpose of changes: + +Run tests on clm for new ROF component. CLM mods by tcraig to support ROF. + +Requirements for tag: + +Test level of tag: doc, critical, standard, std-test, reg-test + +std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + + Not needed since ROF is now a CLM external + D models/lnd/clm/src/main/clm_mct_mod.F90 + D models/lnd/clm/src/riverroute + D models/lnd/clm/src/riverroute/RtmMod.F90 + D models/lnd/clm/src/riverroute/RunoffMod.F90 + +List all files added and what they do: + + Fix for some of Erik's new tests + A models/lnd/clm/test/system/user_nl_dirs/monthly + A models/lnd/clm/test/system/user_nl_dirs/monthly/user_nl_clm + A models/lnd/clm/test/system/user_nl_dirs/monthly/user_nl_cpl + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/tools/ncl_scripts + M models/lnd/clm/tools/interpinic + M models/lnd/clm/tools/mksurfdata_map/src + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl + M models/lnd/clm/bld + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/user_nl_clm + M models/lnd/clm/bld/listDefaultNamelist.pl + M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/clm.buildnml.csh + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 + M models/lnd/clm/src/biogeochem/CNDVMod.F90 + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/spmdGathScatMod.F90 + M models/lnd/clm/src/main/clm_varpar.F90 + M models/lnd/clm/src/main/decompInitMod.F90 + M models/lnd/clm/src/main/clm_initializeMod.F90 + M models/lnd/clm/src/main/clmtypeInitMod.F90 + M models/lnd/clm/src/main/histFileMod.F90 + M models/lnd/clm/src/main/clm_atmlnd.F90 + M models/lnd/clm/src/main/findHistFields.pl + M models/lnd/clm/src/main/restFileMod.F90 + M models/lnd/clm/src/main/controlMod.F90 + M models/lnd/clm/src/main/clm_varctl.F90 + M models/lnd/clm/src/main/clm_driver.F90 + M models/lnd/clm/src/main/ncdio_pio.F90 + M models/lnd/clm/src/main/domainMod.F90 + M models/lnd/clm/src/main/decompMod.F90 + M models/lnd/clm/src/main/clmtype.F90 + M models/lnd/clm/src/main/histFldsMod.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 + M SVN_EXTERNAL_DIRECTORIES + M ChangeLog + M ChangeSum + M scripts/ccsm_utils/Case.template/config_definition.xml + + +Machines testing ran on: + +%%%%%%%% Test reporting START %%%%%%%% + + Test system is currently in flux so I will simply list all tests that have + failed and the 8 tests that we need to keep an eye on. I've included bluefire + and lynx and pointers to where tests live. + +* tests that will pass in next tag due to new features +** denotes an expected fail. +*** any tputcomp tests that fail I'm inclined to ignore also. These change from test to test. +? or cd a test that will need fixing + +BLUEFIRE: + +OK ############ run build-namelist tests +>>cd models/lnd/clm/bld/unit_testers +>>./build-namelist_test.pl -compare /glade/scratch/muszala/svn/clm4_0_49/models/lnd/clm/bld/unit_testers -generate -test -csmdata /glade/proj3/cseg/inputdata >&! out_unit_`date +"%m%d%y"`.lg + + OK...failed tests will pass in next tag + +OK ############# run new I case tests +[be1105en /glade/scratch/muszala/svn/clm_trunk/scripts ]$ +create_test_suite -mach bluefire_ibm -input_list allIcompsetsRes.clm.auxtest -nobatch on -nobuild on -compare clm4_0_49 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_50 -testroot /glade/scratch/muszala/tests > & ! bf_out_allI_`date +"%m%d%y"`.lg + + 165507 - /glade/scratch/muszala/tests + >>./cs.status.165507.bluefire | grep FAIL +... +** SFAIL SBN.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_urbanc_alpha.I1PT.bluefire_ibm.GC.165507 +** TFAIL SBN.1x1_asphalt_jungle.ICNTEST.bluefire_ibm.GC.165507 +** TFAIL SBN.T42_g16.I1850.bluefire_ibm.GC.165507 +** TFAIL SBN.T31_g16.I1850.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_tropicAtl.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.ne30_g16.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.ne120_g16.I20TRCN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP26CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP45CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP60CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP85CN.bluefire_ibm.GC.165507 + + +OK ############ run clm interactive tools tests +[be1105en /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system ]$ +>>nohup env CLM_SOFF=FALSE ./test_driver.sh -i >&! bluefire_i_`date +"%m%d%y"`.lg & + + OK: looking at /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system/td.951030.status.xFail - rerun + clmTests/test-driver.533240 - /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system/td.533240.status.xFail + +############# run old cesm/clm tests out of scripts + + +[be1105en /glade/scratch/muszala/svn/clm_trunk/scripts ]$ +>>create_test_suite -input_list bluefire.clm.auxtest -compare clm4_0_49 \ +-baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines \ +-generate clm4_0_50 \ +-testroot /glade/scratch/muszala/tests >&! bf_out_`date +"%m%d%y"`.lg & + + 143258 +>>cs.status.143258.bluefire | grep -v PASS +... + +*** FAIL SMS.T31_g37.IG4804.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f45_g37.I.bluefire_ibm.compare_hist.clm4_0_49 + +* FAIL NCK.T31_g37.I.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERS_E.T31_g37.I1850.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm + + Failing in Generate: + "/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statement for + unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_50 + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm + + Failing in Generate: + 0:"/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statemen t for unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_50 + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm + + Failing in Generate: + "/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statement for + unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_50 + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_49 + +* FAIL SMS.T31_g37.IG4804.bluefire_ibm.compare_hist.clm4_0_49 +** SFAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.143258 + should be xFAIL : ERROR(build-namelist::new): Required input variable yearfirst was not found +** SFAIL ERP.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.143258 + should be xFAIL : ERROR(build-namelist::new): Required input variable yearfirst was not found +* FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERP.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_49 + + + + +############# run new test_system tests + +## interactive +>> test_system -i -c clm4_0_49 -g clm4_0_50 >&! bluefire_tsi_`date +"%m%d%y"`.lg & + + 161038 +>>cs.status.161038.bluefire | grep -v PASS +... +SFAIL ERS_D.CLM_USRDAT.IalaskaCN.bluefire_ibm.GC.161038 +* FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +* FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.memcomp.clm4_0_49 + max memory values differ +*** FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.tputcomp.clm4_0_49 +** FAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm +** BFAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm.generate.clm4_0_50 +** BFAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm.compare_hist.clm4_0_49 +cd RUN ERS_D_P1x25.5x5_amazon.I_2000.bluefire_ibm.GC.161038 +** RUN ERS_D.1x1_asphaltjungleNJ.I_2000_VOC.bluefire_ibm.GC.161038 +** RUN ERS48s_D_P1x64.f45_g37.I_2000_VOC.bluefire_ibm.GC.161038 +* FAIL ERS48s_D_P1x64.f19_g16.I_2000_GLCMECPD.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS48s_D_P1x64.f19_g16.I_2000_GLCMECPD.bluefire_ibm.tputcomp.clm4_0_49 +** FAIL PET_D_P1x64.f45_g37.I_2000_VOC.bluefire_ibm + + + +## batch +>>test_system -c clm4_0_49 -g clm4_0_50 > & ! bluefire_ts_`date +"%m%d%y"`.lg & + + 143420 -- cs.status.143420.bluefire +cs.status.143420.bluefire | grep -v PASS +... +* FAIL ERS211d.f10_f10.ICNADSPIN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS211d.f10_f10.ICNADSPIN.bluefire_ibm.tputcomp.clm4_0_49 +** CFAIL ERS48s_D.f09_g16.ICNEXSPIN.bluefire_ibm.GC.143420 + this is xFAIL for interactive, should also be listed here +* FAIL ERS48s_D_P64x16.ne30_g16.ICN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS48s_D_P64x16.ne30_g16.ICN.bluefire_ibm.tputcomp.clm4_0_49 +* FAIL PET_D_P1x64.ne30_g16.ICN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +? RUN ERS211d_D_P112x2.f10_f10.ICNCROP.bluefire_ibm.GC.143420 + run failed +** FAIL ERS211d.f10_f10.I_2000_VOC_CN.bluefire_ibm.compare_hist.clm4_0_49 +*** FAIL ERS211d.f10_f10.I_2000_VOC_CN.bluefire_ibm.tputcomp.clm4_0_49 +** RUN ERS211d_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.143420 +** SFAIL ERS_D_P96x32.T62_g37.I_2000.bluefire_ibm.GC.143420 + + + +############# + +LYNX: + +############# run new test_system tests + +## interactive +>> test_system -i -c clm4_0_49_lynx_pgi -g clm4_0_50_lynx_pgi >&! lynx_i_`date +"%m%d%y"`.lg & + + 144558 + +cs.status.144558.lynx | grep -v PASS +... +*** FAIL ERS211d.1x1_brazil.I_2000.lynx_pgi.tputcomp.clm4_0_49_lynx_pgi +* FAIL ERS48s_D_P1x12.f10_f10.ICNCROP.lynx_pgi.compare_hist.clm4_0_49_lynx_pgi + new fields in cpl history files +** SFAIL SMS_D.1x1_vancouverCAN.I1PT.lynx_pgi.GC.144558 +** SFAIL ERS.1x1_mexicocityMEX.I1PT.lynx_pgi.GC.144558 + + +## batch +>> test_system -c clm4_0_49_lynx_pgi -g clm4_0_50_lynx_pgi >&! lynx_`date +"%m%d%y"`.lg & + + 160925 +./cs.status.160925.lynx | grep -v PASS +... +? BFAIL PMT_D.f45_g37.I_2000.lynx_pgi.compare_hist.clm4_0_49_lynx_pgi + + problem in generate case not copying over file + PASS + Initial Test log is /glade/scratch/muszala/PMT_D.f45_g37.I_2000.lynx_pgi.G.114232/run/cpl.log.120920-152048 + /var/spool/torque/mom_priv/jobs/102008.nid00003.SC: Storing new baseline in /glade/proj2/cgd/tss/clm_cesm_baselines/clm4_0_49_ly + nx_pgi/PMT_D.f45_g37.I_2000.lynx_pgi + ERROR in /var/spool/torque/mom_priv/jobs/102008.nid00003.SC: could not copy /glade/scratch/muszala/archive/PMT_D.f45_g37.I_2000. + lynx_pgi.G.114232/cpl/hist/ to /glade/proj2/cgd/tss/clm_cesm_baselines/clm4_0_49_lynx_pgi/PMT_D.f45_g37.I_2000.lynx_pgi/cpl.hi.nc + +? RUN ERS48s_D.f45_g37.I_2000_VOC.lynx_pgi.GC.160925 + run didn't finish? +? RUN ERS48s_D.f10_f10.I_2000_CN.lynx_pgi.GC.160925 + PBS: job killed: walltime 9021 exceeded limit 9000 +? RUN ERS48s_P96x2.f19_g16.I_2000_VOC_SNCRFRC_CN_GLCMECPD.lynx_pgi.GC.160925 + PBS: job killed: walltime 9041 exceeded limit 9000 + +## interactive, with mirage test list and intel compiler +>>test_system -i -p intel -l mirage.interactive -o "-mach lynx" -c clm4_0_49_lynx_intel -g clm4_0_50_lynx_intel > & ! lynx_mi_intel_`date +"%m%d%y"`.lg & + + 143620 cs.status.143620.lynx +>>cs.status.143620.lynx | grep -v PASS +... +** FAIL ERS.1x1_brazil.I_2000.lynx_intel +** BFAIL ERS.1x1_brazil.I_2000.lynx_intel.generate.clm4_0_50_lynx_intel +** BFAIL ERS.1x1_brazil.I_2000.lynx_intel.compare_hist.clm4_0_49_lynx_intel +? FAIL ERI_D.1x1_camdenNJ.I_2000_VOC.lynx_intel + forrtl: error (73): floating divide by zero - rtmmod_mp_rtmini_ 303 RtmMod.F90 +** RUN ERS_D.1x1_asphaltjungleNJ.I_2000_VOC.lynx_intel.GC.143620 + forrtl: error (73): floating divide by zero - rtmmod_mp_rtmini_ 303 RtmMod.F90 +* FAIL ERS48s_D_P1x12.f10_f10.I_2000_CN.lynx_intel.compare_hist.clm4_0_49_lynx_intel + new fields in cpl history files +*** FAIL ERS48s_D_P1x12.f10_f10.I_2000_CN.lynx_intel.tputcomp.clm4_0_49_lynx_intel + +%%%%%%%% Test reporting END %%%%%%%% + + + build-namelist unit tester: + + CESM test lists: + + bluefire/CESM + lynx/CESM + + bluefire/PTCLM + + test_system testing: + + bluefire batch: + bluefire interactive: + lynx/pgi batch: + lynx/pgi interactive: + mirage,storm/ifort interactive: + +CLM tag used for the baseline comparison tests if applicable: + + clm4_0_49 + +Changes answers relative to baseline: Yes, runoff is different (similar climate) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all with RTM + - what platforms/compilers: all + - nature of change (similar climate) I compsets only have runoff change + + MSS location of control simulations used to validate new climate: + + https://wiki.ucar.edu/display/ccsm/CCSM4+-+Track5+experiments + + /CCSM/csm/b.e11.B1850CN.f19_g16.004 + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_49 +Originator(s): erik (Kluzek Erik 303-497-1326 CGD) +Date: Sun Sep 16 01:05:04 MDT 2012 +One-line Summary: Move clm testing to use CESM test framework + +Purpose of changes: + +Move testing for CLM from CLM stand-alone test_driver.sh to one based on +the CESM testing framework. Create CLM specific tests-lists, user_nl_dir, +and compset files to handle most CLM testing. + +Requirements for tag: + + Move major testing from test_driver.sh to one based on CESM framework. Try + to get most of it to work. + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Update to cesm1_1_beta18b + + scripts updated to: scripts4_120915 + scripts updated to: Machines_120915 + mapping updated to: mapping_120816 + stubs updated to: stubs1_3_05 + drv updated to: drvseq1_4_26 + +List all files eliminated: None + +List all files added and what they do: + +A + models/lnd/clm/test/system/test_system ---- New main testing script for CLM. + wrapper script to CESM scripts/create_test_suite with behavior + similar to test_driver.sh + + -b directory [or --baseline] baseline directory + -c version [or --compare] version to compare to + (generate must already have been run to create these) + -d debug usage -- display tests that will run -- but + do NOT actually execute them + -g version [or --generate] name of this version to generate version as + -h [or --help] displays help + -i interactive usage + -l list [or --list] input test list to use instead of default + (path relative to this directory) + -o options [or --options] options to pass to create_test_suite + -p compiler [or --compiler] compiler to use instead of default + -s [or --shortlist] use the short test list + + Typical use: + + cd models/lnd/clm/test/system + test_system -i -c clm4_0_48 -g clm4_0_49 + test_system -c clm4_0_48 -g clm4_0_49 + + +>>>>>>>>>>>>> Test lists +A + models/lnd/clm/test/system/mirage.interactive +A + models/lnd/clm/test/system/lynx.interactive +A + models/lnd/clm/test/system/shortlist.interactive +A + models/lnd/clm/test/system/bluefire.batch +A + models/lnd/clm/test/system/bluefire.interactive +A + models/lnd/clm/test/system/lynx.batch +A + models/lnd/clm/test/system/shortlist.batch + +>>>>>>>>>>>>> compset file and user_nl_* files for testing +A + models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +A + models/lnd/clm/test/system/user_nl_dirs +A + models/lnd/clm/test/system/user_nl_dirs/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/crop +A + models/lnd/clm/test/system/user_nl_dirs/crop/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/cn_conly +A + models/lnd/clm/test/system/user_nl_dirs/cn_conly/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/voc +A + models/lnd/clm/test/system/user_nl_dirs/voc/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/voc/user_nl_cpl +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC/user_nl_cpl + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml - New failed + tests from new test framework +M models/lnd/clm/bld/clm.buildnml.csh - Copy drv_flds_in if clm creates it + and if it doesn't already exist. +M UpDateChangeLog.pl -- Add some support for xFail. Not fully working. + +Machines testing ran on: + + build-namelist unit tester: yes + + test_system testing: + + bluefire batch: yes + bluefire interactive: yes + bluefire/CESM: yes + lynx/pgi batch: yes + lynx/pgi interactive: yes + +CLM tag used for the baseline comparison tests if applicable: clm4_0_48 + +Difference in expected fails from testing: + +Index: expectedClmTestFails.xml +=================================================================== +--- expectedClmTestFails.xml (.../trunk_tags/clm4_0_48/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml) (revision 40288) ++++ expectedClmTestFails.xml (.../trunk/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml) (revision 40288) +@@ -34,6 +34,10 @@ + + + cprnc showing diffs are not b4b ++ problem configuring ++ problem configuring ++ clm stand-alone can no longer work ++ clm stand-alone can no longer work + + + +@@ -71,14 +75,70 @@ + + + ++ ++ CESM script issue ++ CESM script issue ++ + + + + + ++ ++ ++ ++ CESM script issue ++ Restart length different ++ Restart length different ++ Initial simulation fails ++ Initial simulation fails ++ ++ ++ ++ ++ datm namelist problem for single-point forcing ++ datm namelist problem for single-point forcing ++ ++ ++ ++ ++ ++ ++ ++ T62 not working ++ ignore_ic_date is incompatable with crop! ++ CESM script problem didn't see both files ++ CESM script problem didn't see both files ++ ++ ++ ++ ++ ++ + + + ++ datm namelist issue ++ datm namelist issue ++ datm namelist issue ++ datm namelist issue ++ missing wus12 datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ ++ ++ ++ ++ ++ + + + + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_48 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Tue Sep 11 09:14:40 MDT 2012 +One-line Summary: bug fixes, xFail to tests and normalize test output for CLM + +Purpose of changes: Bug Fixes. Add xFail capability to CLM batch, +interactive and namelist tests. Make test output the same for CLM +tests. + +Requirements for tag: Test on bluefire (CESM, int, bat), lynx/pgi (int,bat) +Fix bugs: 1436,1500,1521,1537 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + + 1436,1500,1521,1537 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1545 - on lynx clm-batch doesn't call our new xFAIL module. + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: xFail module Bill, Erik. Rest of code Erik. + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +List a files added and what they do: + +A models/lnd/clm/bld/unit_testers/xFail +A models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +A models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +A models/lnd/clm/bld/unit_testers/xFail/wrapClmTests.pl + + - xFAIL module that implements expected fail reporting. wrapClmTests.pl is used +as a wrapper and called by test_driver.sh. The XML file holds test cases. +Documentation is in POD in expectedFail.pm + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/TBL.sh + - fix so that mct and pio are built out of the baseline directory +M models/lnd/clm/bld/configure + - fix path to mct/.../mpi-serial +M models/lnd/clm/src/main/getdatetime.F90 + - fix to broadcast correct time stamp +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + - both of these files modified to support xFAIL functionality +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + - remove wrf mapping entry that isn't in inputdata. fix entries per bug + 1521 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + - remove wrf mapping entry that isn't in inputdata. fix entry per bug 1521 + +Summary of testing: + +Note that tests that used to fail are now being reported as xFAIL. The file +to look at is models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml. + +There are no tests that used to FAIL that now PASS. + + build-namelist unit testing: all pass + bluefire: all pass + bluefire interactive testing: all pass + bluefire/CESM testing: a few throughput failures + + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 2.945 tput_percent_decr = 21.3 + + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 65.6 tput_percent_decr = 41.9 + + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 1.8039999 tput_percent_decr = 2.07 + + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 2.325 tput_percent_decr = 9.80 + + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 7.0280000 tput_percent_decr = 3.69 + + bluefire/PTCLM testing: N/A + lynx/pgi testing: all pass + lynx/pgi interactive testing: all pass + lynx/CESM testing: + mirage,storm/ifort interactive testing: all pass + +CLM tag used for the baseline comparison tests if applicable: clm4_0_47 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_47 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Thu Aug 23 11:09:27 MDT 2012 +One-line Summary: bug fixes + +Purpose of changes: + + Fix some bugs and tag early since CAM needs fix of bug 1538 asap. + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + + 1534,1533,1507,1444,1538 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/configure +-- Passes FLAGS down to cesm_lib build and for pio (only for CLM testing) + +M models/lnd/clm/tools/mkmapdata/regridbatch.sh +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +-- Fixes as per bug 1507. Logic clean up for interactive and using mpi + +M models/lnd/clm/bld/build-namelist +-- Fix as per bug 1538 + +M models/lnd/clm/src/main/controlMod.F90 +-- Fix as per bug 1444. remove call to "mpi_bcast (glc_topomax," and logic + controlling it. + +M models/lnd/clm/src/main/ncdio_pio.F90 +-- Fix as per bug 1533 and 1534 + +M SVN_EXTERNAL_DIRECTORIES +-- Mistake from last tag. Replaced two repos with correct trunk-tag urls. + + +Summary of testing: + + build-namelist unit testing: + All PASS except: + fails involve us20 and wus12 + not ok 141 - lnd_in file the same as expected for CN - 94x192 - fixed. Should pass in next tag. + not ok 214 - lnd_in file exists - us20 - no tests in place + not ok 219 - lnd_in file exists - wus12 - no tests in place + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 - wus12 - no tests in place + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 - wus12 - no tests in place + bluefire: + + 016-019 will be removed and put in CESM/CLM tests + 016 smW51 TSM.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 10 + 017 erW51 TER.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -3+-2 cold ..............FAIL! rc= 5 + 018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 5 + 019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 4 + + 036-039 Failed in the past, see prior versions + 036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 + 037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 + 038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + 039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 + + 049-052 Failed in the past, see prior versions + 049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 + 050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 + 051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + 052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + + bluefire interactive testing: + All PASS execpt: + 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 5 + 012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 5 + 016 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + 020 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 + 024 blCA8 TBL.sh _sc_ds clm_drydep^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic .....FAIL! rc= 5 + 026 blCK4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 + 028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -10 cold ...........FAIL! rc= 5 + 030 blC78 TBL.sh _sc_s clm_std^nl_urb 20021231:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 + 038 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 5 + 042 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 + 046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 5 + 050 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 5 + 054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 5 + 067 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + bluefire/CESM testing: + All PASS except: + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_46 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_46 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_46 + Reason: the throughput tolerance is likely still not large enough. + bluefire/PTCLM testing: N/A + lynx/pgi testing: + lynx/pgi interactive testing: + 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 + 010 blCL4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 + 014 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + lynx/CESM testing: + N/A + mirage,storm/ifort interactive testing: + All PASS except: + 70 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 71 007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 5 + 72 011 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + 73 015 blCA8 TBL.sh _sc_ds clm_drydep^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic .....FAIL! rc= 5 + 74 019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 5 + 75 023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_46 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_46 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Wed Aug 8 11:53:44 MDT 2012 +One-line Summary: R01 support and update externals + +Purpose of changes: + + Add support for r01 rtm. Add mapping files for ne120 and ne240. Update all svn + externals to what is in cesm_alpha16e and modify and update our test system as + necessary. + +Requirements for tag: test on bluefire (CESM, int, bat, build-namelist), lynx/pgi (int,bat), mirage. + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID):N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system:N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets:N/A + +Describe any substantial timing or memory changes:N/A + +Code reviewed by: self, Erik + +List any svn externals directories updated (csm_share, mct, etc.): + Created the following tags: + https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120808 + https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_1_23 + https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_120807 + +List all files eliminated:N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: + +== modifications to update externals == + M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + M SVN_EXTERNAL_DIRECTORIES + +== modifications to get cesm/clm, interactive tests to pass == + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + -- added more output for easier test reading + M models/lnd/clm/test/system/TCB.sh + -- fix some indentation + M models/lnd/clm/test/system/TCBtools.sh + -- add support for gen_domain configure on bluefire + M models/lnd/clm/test/system/test_driver.sh + -- move tests to clmTest directory on /glade/scratch + M models/lnd/clm/test/system/CLM_runcmnd.sh + -- just indent diffs + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 + -- handle all files as large files (from ne240 runs) + M models/lnd/clm/bld/configure + -- add dependency for pio piovdf.o: pio_kinds.o + -- remove -lgptl from cesm Makefile + +== added r01 maps to namelist_defaults_clm.xml == + + M clm.buildnml.csh + M namelist_files/namelist_defaults_overall.xml + -- modified namelist_defaults_overall.xml to take wus12 and us20 with rmt off + -- also added ne240 and default gx1v6 ocean mask + -- modes to bld/clm.buildnml.csh so that rtm is off for wus12 + -- added path and script name to xml generated by createMapEntry.pl + -- checked wus12_wus12 run. Configures and runs. Error message to look for is: + + "Do not run the River Transport Model (RTM)" which is correct since wus12_wus12 is + a regional grid + +== modify scripts and drv to get new r01 to gx1v6 mapping files == + M scripts/ccsm_utils/Case.template/config_grid.xml + M scripts/ccsm_utils/Case.template/config_definition.xml + M models/drv/bld/namelist_files/namelist_defaults_drv.xml + -- namelist_defaults_drv.xml - added rof_grid for r01 and gx1v6 + +== modify xml so that 1/10 degree runs work == + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh + M models/lnd/clm/tools/mkmapgrids/mkmapgrids.namelist + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + M models/lnd/clm/src/riverroute/RtmMod.F90 + +Summary of testing: + + build-namelist unit testing: + All PASS except: + fails involve us20 and wus12 + not ok 141 - lnd_in file the same as expected for CN - 94x192 - fixed. Should pass in next tag. + not ok 214 - lnd_in file exists - us20 - no tests in place + not ok 219 - lnd_in file exists - wus12 - no tests in place + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 - wus12 - no tests in place + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 - wus12 - no tests in place + bluefire: + All PASS except: + 018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 + modified to -3+-3 -- still FAIL + 036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 + 037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 + 038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + 039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 + 036-039 needs major work + + and why they fail... + + 018 - cprnc differences in comparison + 036 - endrun initiated from CNBalanceCheckMod.F90 + 037 - __cnbalancecheckmod_NMOD_cbalancecheck + 038, 039 - fail since 037 didn't run + + bluefire interactive testing: + All PASS except: + bl514 - will fail because tag 45 has a broken gen_domain build + bl954 - no ne240 in tag 45 + bl9C4 - 8 bit difference in file size due to using large file write in mkfileMod.F90 + These should pass in next tag + bluefire/CESM testing: + All PASS except: + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_45 + + There is tolerance check built into the tests that may be too tight. Jay will look at this in the future. + Throughputs are reported and a sampling looks reasonable: + + CHECK SMS_RLA.f45_f45.I.bluefire_ibm.perf npes=1 tput=16.026 memh=259.677 memr=-0.001 tag=clm4_0_45 baseline + CHECK SMS_RLA.f45_f45.I.bluefire_ibm.perf npes=1 tput=9.392 memh=259.856 memr=-0.001 tag= + + CHECK SMS.f10_f10.IRCP45CN.bluefire_ibm.perf npes=16 tput=200.866 memh=265.074 memr=-0.001 tag=clm4_0_45 baseline + CHECK SMS.f10_f10.IRCP45CN.bluefire_ibm.perf npes=16 tput=187.881 memh=267.630 memr=-0.001 tag= + + CHECK ERS_D.f19_g16.IRCP85CN.bluefire_ibm.perf npes=64 tput=29.741 memh=292.035 memr=-0.001 tag=clm4_0_45 baseline + CHECK ERS_D.f19_g16.IRCP85CN.bluefire_ibm.perf npes=64 tput=28.368 memh=294.879 memr=-0.001 tag= + + bluefire/PTCLM testing: + lynx/pgi testing: + lynx/pgi interactive testing:All PASS + lynx/CESM testing:All PASS + mirage,storm/ifort interactive testing:All PASS + +CLM tag used for the baseline comparison tests if applicable: CLM4_0_45 + +Changes answers relative to baseline:No + +=============================================================== +=============================================================== +Tag name: clm4_0_45 +Originator(s): sacks (Sacks Bill 303-497-1762 CGD) +Date: Fri Jul 20 11:41:14 MDT 2012 +One-line Summary: fix virtual columns; new urban mksurfdata_map + +Purpose of changes: + +GLC-related: Fix places where glc virtual columns were not being treated +correctly (major bug!). Change albice default to 0.6,0.4 for glc_mec +cases, based on suggestion from Bill Lipscomb. Fix dust calculation for +glc_mec. + +Other CLM changes: Add an instance of istcrop. Fix landunit-level output +for dov2xy=false. + +Tools changes: Update mksurfdata_map to handle new urban raw data format +(use dominant density class, together with lookup tables; currently used +for mksurfdata_map with hires). Minor fixes to mksurfdata_map. Add unit +tests to mksurfdata_map. Change tools build to support addition of unit +tests. Minor fixes to mkscripgrid.ncl, mkunitymap.ncl and mknoocnmap.pl. + +Namelist-related: Refer to correct scrip grid files for f09, f19; and +a few fixed mapping files for those resolutions, including clm->rtm mapping +files for those resolutions (changes answers for RTM). (The old scrip grid +files had a displaced pole, which is not what we want for CLM. Note that I +did NOT replace the f05 scrip grid file, because the only alternative I can +find has bad values in the corner arrays -- see bug 1518.) + +SPM--Mostly changes to get more tests to pass. Added 1x1_* mapping files to +inputdata. Created script that auto-generates XML for new mapping files for +easier inclusion into existing XML files. Modify build-namelist_test.pl to +pass CSMDATA to build-namelist. Tests were failing if a user didn't have +CSMDATA env set. Touched CFGtools__ds to get a CLM interactive test to pass. +Added openMP and debug openMP tests for bluefire interactive tests for 10x15. +--SPM + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage. +Fix bug 1492 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1492 (missing istcrop) + 1515 (nedd mapping files for + single-point)-SPM + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Makefiles reorganized for tools (mksurfdata_map, interpinic, mkmapgrids) + +Describe any changes made to the namelist: + + albice changed to 0.6,0.4 for glc_mec cases + +List any changes to the defaults for the boundary datasets: + + Use corrected mapping files for CLM->RTM for f09,f19, and for some + mapping files used to create surface datasets. Use correct scrip grids + for f09,f19. Add new urban raw data file for hires mksurfdata_map, and + associated scrip grid file & mapping files. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +>>>>>>> Split into mkurbanparCommonMod, mkurbanparAvgMod and mkurbanparDomMod +D models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 + +>>>>>>> Modify build system to make it easier to add unit testers +D models/lnd/clm/tools/mksurfdata_map/src/Macros.custom +D models/lnd/clm/tools/interpinic/src/Macros.custom +D models/lnd/clm/tools/mkmapgrids/src/Macros.custom + + +List all files added and what they do: + +>>>>>>> SPM-- Dump XML of mappings for a specified resolution +A namelist_files/createMapEntry.pl +>>>>>>> --SPM + + +>>>>>>> Pull out routines from mkurbanparMod that are common to different +>>>>>>> ways of creating urban parameter data +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparCommonMod.F90 + +>>>>>>> Modules to handle old (area-average) and new (dominant-type) urban +>>>>>>> input files +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparAvgMod.F90 - mostly from mkurbanparMod +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparDomMod.F90 - new code, to handle new format + +>>>>>>> New modules with general-purpose utilities for mksurfdata_map +A models/lnd/clm/tools/mksurfdata_map/src/mkutilsMod.F90 +A models/lnd/clm/tools/mksurfdata_map/src/mkindexmapMod.F90 + +>>>>>>> New unit testers for mksurfdata_map +A models/lnd/clm/tools/mksurfdata_map/unit_testers +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Srcfiles +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Filepath +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Makefile +A models/lnd/clm/tools/mksurfdata_map/unit_testers/README +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 + +>>>>>>> Modify build system to make it easier to add unit testers +A models/lnd/clm/tools/mksurfdata_map/src/Makefile.common +A models/lnd/clm/tools/mkmapgrids/src/Makefile.common +A models/lnd/clm/tools/interpinic/src/Makefile.common + + +List all existing files that have been modified, and describe the changes: + +>>>>>>> SPM-- +>>>>>>> Pass csmdata down to build-namelist and add logic so CSMDATA is set +>>>>>>> even if user does not +M unit_testers/build-namelist_test.pl +>>>>>>> Add support for 1x1_* single point mapping files +M namelist_files/namelist_defaults_clm.xml +M namelist_files/namelist_defaults_clm_tools.xml +>>>>>>> Add support for a few openMP 10x15 tests, modify test list +>>>>>>> and remove some old single point tests +M test/system/tests_pretag_bluefire_nompi +M test/system/input_tests_master +M test/system/tests_posttag_nompi_regression + +>>>>>>> --SPM + +>>>>>>> Fix glc virtual column bugs: change checks of (wt > 0) +>>>>>>> to (wt > 0 .or. ityplun(l)==istice_mec) +M models/lnd/clm/src/main/histFileMod.F90 ---------- also fix landunit-level fields + with dov2xy=.false. +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - also change + 'if (itypelun==istice)' to 'if (itypelun==istice .or. itypelun==istice_mec)' + in setting parameters +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 + +>>>>>>> Add istcrop (fix bug 1492) +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + +>>>>>>> Remove unnecessary 'use' +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 + +>>>>>>> Change albice to 0.6,0.4 for glc_mec cases; add mapping files for +>>>>>>> 3x3min_LandScan2004; use corrected mapping files for 5x5min_ISRIC-WISE_to_0.9x1.25, +>>>>>>> 3x3min_MODIS_to_0.9x1.25 and 5x5min_nomask_to_1.9x2.5, as well as for CLM->RTM +>>>>>>> for f09 and f19 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>> Point to correct files for f09,f19 scrip grids; add new urban raw data file +>>>>>>> for hires mksurfdata_map +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>> Add support for new 3x3min_LandScan2004 grid +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +M models/lnd/clm/bld/namelist_files/checkmapfiles.ncl +M models/lnd/clm/bld/namelist_files/namelist_definition.xml + +>>>>>>> Changes to mksurfdata_map to support new input urban format +M models/lnd/clm/tools/mksurfdata_map/src/Srcfiles ------ add new source files +M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 - use new urban interfaces; + also, substantially increase tolerance for roundoff error fix in + normalizencheck_landuse (the latter change is unrelated to the new urban + format; this change makes it so more points have 100% special rather than + nearly-100% special, which was required to avoid CLM termination due to + rounding errors in some cases) +M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 - add URBAN_DENSITY_CLASS + and URBAN_REGION_ID fields +M models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 --- public declarations of + routines that are now needed + +>>>>>>> Other, incidental changes to mksurfdata_map +M models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 ---- fix zero_out +M models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 - correct rounding errors + in topoglcmec_o; change a warning to a fatal error +M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 - add tolerance in + checking for lat/lon equality + +>>>>>>> Add src_grid_dims & dst_grid_dims +M models/lnd/clm/tools/mkmapdata/mkunitymap.ncl + +>>>>>>> Fix direction of ocn->atm mapping file +M models/lnd/clm/tools/mkmapdata/mknoocnmap.pl +M models/lnd/clm/tools/README ------------------ also fix typos + +>>>>>>> Fix ordering of corners +M models/lnd/clm/tools/mkmapgrids/mkscripgrid.ncl + +>>>>>>> Modify build system to make it easier to add unit testers +M models/lnd/clm/tools/mksurfdata_map/src/Makefile +M models/lnd/clm/tools/interpinic/src/Makefile +M models/lnd/clm/tools/mkmapgrids/src/Makefile +M models/lnd/clm/test/system/TCBtools.sh ----------- copy correct file + +>>>>>>> Document copy of test_mod +M models/lnd/clm/tools/README.filecopies + + +Summary of testing: + +--SPM. New tests run after update to clm4_0_44 and after tests modifications. + +==== bluefire build-namelist tests: ==== + + * expected fail due to new mapping file + < fmapinp_rtm = '/glade/proj3/CESM/cseg/inputdata//lnd/clm2/mappingdata/maps/1.9x2.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120522.nc' + --- + > fmapinp_rtm = '/glade/proj3/CESM/cseg/inputdata//lnd/clm2/mappingdata/maps/1.9x2.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120221.nc' + + * not ok 6 - lnd_in file the same as expected for standard + not ok 23 - lnd_in file the same as expected for standard + +This is expected. Bill states this mod in ChangeLog + + < albice = 0.60,0.40 + --- + > albice = 0.50,0.50 + + * not ok 29 - lnd_in file the same as expected for standard + * not ok 36 - lnd_in file the same as expected for standard + * not ok 43 - lnd_in file the same as expected for standard + * not ok 49 - lnd_in file the same as expected for standard + * not ok 54 - lnd_in file the same as expected for standard + * not ok 59 - lnd_in file the same as expected for standard + * not ok 64 - lnd_in file the same as expected for standard + * not ok 69 - lnd_in file the same as expected for standard + * not ok 74 - lnd_in file the same as expected for standard + * not ok 80 - lnd_in file the same as expected for standard + * not ok 85 - lnd_in file the same as expected for standard + * not ok 91 - lnd_in file the same as expected for standard + * not ok 156 - lnd_in file the same as expected for CN + * not ok 161 - lnd_in file the same as expected for CN + + 221 and 222 are for new WRF tests, ignoring for now since tests not complete + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 + # in NMLTest/CompFiles.pm at line 103. + WARNING(NMLTest::CompFiles::comparefiles):: File /glade/scratch/muszala/svn/clm4_0_44/models/lnd/clm/bld/unit_testers/temp_file.txt.CN.-res+wus12 + does NOT exist! + + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 + +WARNING(NMLTest::CompFiles::comparefiles):: File /glade/scratch/muszala/svn/clm4_0_44/models/lnd/clm/bld/unit_testers/temp_file.txt.CN.-res+wus12 + 2349 does NOT exist! + + # Failed test 'compare file temp_file.txt DNE for CN and -res+wus12 + # ' + # in NMLTest/CompFiles.pm at line 103. + + * not ok 276 - lnd_in file the same as expected for crop + +==== bluefire interactive ==== + now pass due to new mapping files (ignore numbering, use test descriptor) +001 sm514 TSMCFGtools.sh gen_domain CFGtools__ds T31.runoptions .................................PASS +002 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds PASS +003 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dPASS +004 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds PASS + + new tests and test descriptors for 10x15 openMP tests +001 sm953 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__o .......PASS +002 bl953 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__o .......SKIPPED* +003 sm954 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......PASS +004 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......SKIPPED* +005 sm957 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__do ......PASS +006 bl957 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__do ......SKIPPED* +007 sm959 TSMscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................PASS +008 bl959 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................SKIPPED* + +--SPM + +NOTE: UNLESS OTHERWISE NOTED, THE BELOW TESTS WERE RUN FROM TAG +virtual_column_fix_03_clm4_0_43. This means that they were run before +reverting the scrip grid file & rtm mapping file for f05. However, that +shouldn't change any test results, since as far as I can tell, nothing in +the CLM test suite tests f05 resolution. THESE TESTS SHOULD BE RERUN ON THE +FINAL VERSION OF THE TAG BEFORE MERGING IT TO THE TRUNK. + + bluefire build-namelist unit testing (run with -test): ALL PASS EXCEPT: +not ok 42 - rtm tstep inconsistent + bluefire mksurfdata_map unit testing: ALL PASS + bluefire: All PASS except: +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +043 blCn1 TBL.sh _sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arb_ic FAIL! rc= 7 +049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except: +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 7 +054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except: +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERP.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_43 + bluefire/PTCLM testing: NOT DONE! + lynx/pgi testing: All PASS + lynx/pgi interactive testing: All PASS except: +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +024 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +025 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + lynx/CESM testing: All PASS except: +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.C.123047 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_43 +FAIL ERS.f19_g16.IRCP26CN.lynx_gnu.compare_hist.clm4_0_43 +FAIL ERS.f19_g16.IG1850.lynx_pgi.compare_hist.clm4_0_43 + mirage,storm/ifort interactive testing: All PASS + + Additional testing: Additional CESM B compset tests to test new RTM + mapping files. Ran these from cesm1_1_alpha13e; for most tests, switched + clm to virtual_column_fix_03_clm4_0_43; for the lynx f05 test, switched + clm to virtual_column_fix_04_clm4_0_43. Note that the baseline + comparisons are expected to fail, except for the f05 test. +PASS ERI.f19_g16.BRCP45WCN.bluefire_ibm +FAIL ERI.f19_g16.BRCP45WCN.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS ERS.f19_g16.B2000CNCHM.bluefire_ibm +FAIL ERS.f19_g16.B2000CNCHM.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS SMS_D.f19_g16.B20TRC5.bluefire_ibm +FAIL SMS_D.f19_g16.B20TRC5.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS ERS.f09_g16.B1850BPRP.bluefire_ibm +FAIL ERS.f09_g16.B1850BPRP.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS SMS_D.f19_g16.B20TRC5.lynx_pgi +FAIL SMS_D.f19_g16.B20TRC5.lynx_pgi.compare_hist.cesm1_1_alpha13e +PASS SMS.f05_g16.B.lynx_pgi +PASS SMS.f05_g16.B.lynx_pgi.compare_hist.cesm1_1_alpha13e + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_43; +for my additional CESM tests, compared against cesm1_1_alpha13e + +Changes answers relative to baseline: YES, for GLC configurations and all +f09 & f19 configurations with RTM + + Baseline failures that are not because of GLC or RTM mapping file changes + are: + +>>> also failed in clm4_0_43; fails with "build-namelist ERROR:: bad input to drv_runlength option" +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +>>> I think the problem here is that the baseline test is trying to build interpinic from the current directory, +>>> rather than from BL_ROOT. This is a problem because of changes in the tools' build. +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 + + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: - all GLC configurations (albice change & virtual column bug fix) + - all f09 & f19 configurations with RTM (due to change in RTM mapping file) + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + For GLC: climate-changing + + For f09/f19 due to RTM mapping file change: Larger than roundoff, but + expected to have same climate. The new scrip grid files have + roundoff-level differences globally, plus differ substantially at the + poles because the old (incorrect) files had poles displaced from + -90/90. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - compset (and additional configure options): + - build-namelist options (or complete namelist): + - MSS location of output: + + EVALUATION OF NEW CLIMATE NOT PERFORMED + +=============================================================== +=============================================================== +Tag name: clm4_0_44 +Originator(s): erik (Erik Kluzek) +Date: Mon Jul 9 11:14:11 MDT 2012 +One-line Summary: Add wrf resolutions, update externals to cesm1_1_beta15, all components use build-namelist now + +Purpose of changes: + +set nsegspc=1 for all ne grids. Update to latest externals and new datm. Latest externals +have ALL components using a build-namelist, and user_nl.$COMP files are created for you. +Env files changed most fields in env_conf moved to env_run and secondly env_build. +env_mach_pes moved to env_configure. env_conf removed. Add ne4, ne16, ne60 datasets. Add +in ne16, ne30, ne120 20th Century datasets. Change of templates to have +clm.buildnml.csh and clm.buildexe.csh copied to Buildconf. Have -chk_res option to +build-namelist to check for resolution/mask, -note option to include (or not) note on the +bottom of the namelist. Expand build-namelist unit test. + +Requirements for tag: + Requirements: test on bluefire (CESM, int, bat) + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1513 (mksurfdata.pl doesn't work with -crop flag) + 1514 (inconsistancy in char variable fexcl) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (Problem reading restarts@ne30_g16 for some layouts) + 1517 (Performance of datm in clm4_0_44 is even worse) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Yes! + env*.xml files changed as follows: + + env_conf.xml ------> removed! + Most variables moved to env_run.xml. Some variables moved to env_build.xml + env_mach_pes.xml --> Renamed to env_configure.xml + + Buildconf directory ---> think of it as readonly! +Describe any changes made to the namelist: Yes! + + user_nl_* files for ALL components created for you. Put, your changes to namelists + files here. + + New options to clm build-namelist: + (all but -chk_res and -note are already exercised when running CESM) + -chk_res ------- Check resolution and land mask first. + -clm_startfile - Input file to use to startup for branch or startup cases. + -co2_type ------ CO2 type + -inst_string --- Instance string to use for clm_startfile for multi-instance cases. + -l_ncpl -------- Number of coupling time-steps to take per day. + -lnd_frac ------ Land fraction file to use (domain file) + -note ---------- Write out note about build-namelist usage to end of file. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: Yes! + Most of the throughput tests fail, and single-point performance looks horrible. + Although this may be a sporatic problem due to file systems. See bug 1517. + +Code reviewed by: self, mvertens, tcraig + +List any svn externals directories updated (csm_share, mct, etc.): + Update to cesm1_1_beta15 external versions (other than timing) + scripts to scripts4_120604 + Machines to Machines_120529 + drv to drvseq4_1_15 + datm to datm8_120528 + csm_share to share3_120509 + mct to MCT2_8_0_120503 + pio to pio_1_4_5 + stubs to cism1_120529 + esmf_wrf_timemgr to esmf_wrf_timemgr_120427 + mapping to mapping_120525 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add tools testers for directories that use CESM configure + A models/lnd/clm/test/system/TCBCFGtools.sh + A models/lnd/clm/test/system/TSMCFGtools.sh + A models/lnd/clm/test/system/TBLCFGtools.sh + + A models/lnd/clm/bld/unit_testers/NMLTest/CompFiles.pm - New test module + + A models/lnd/clm/test/system/nl_files/mksrfdt_T31_crpglc_2000 - mksurfdata crop test + +>>>>>>>>>>>> Split out buildexe/buildnml from template so that editing templates +>>>>>>>>>>>> isn't a nightmare + A models/lnd/clm/bld/clm.buildexe.csh + A models/lnd/clm/bld/clm.buildnml.csh + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change tests a bit add a global crop test, get working on mirage + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/CLM_runcmnd.sh --- Allow hostname==vpn* for yong + M models/lnd/clm/test/system/test_driver.sh ---- Add TOOLSLIBS TOOLS_CONF_STRING + if hostname=vpn* use setup for yong + M models/lnd/clm/test/system/input_tests_master Fix test blCK8, add global + crop test case for mksurfdata, add cfg-tool tests + M models/lnd/clm/test/system/TSM.sh ------------ Add cpl.log file + M models/lnd/clm/test/system/TCBtools.sh ------- Set SLIBS needed on generic machines + + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh ------- Use different version of ESMF + for regional, don't do RTM maps for regional + M models/lnd/clm/tools/interpinic/src/Makefile ------ Use NETCDF4 link + M models/lnd/clm/tools/mkmapgrids/src/Makefile ------ Use NETCDF4 link + M models/lnd/clm/tools/mksurfdata_map/src/Makefile -- Use NETCDF4 link + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl - Send crop setting for + determining LAI file + +>>>>>>>>>>>> Add CESM options to build-namelist, add handling of SLIBS for generic +>>>>>>>>>>>> machines. Add new grids: wrf, ne4, ne16, ne60. Set nsegspv=1 for hi-res/ne +>>>>>>>>>>>> grids. Use drv/datm namelist definition/defaults files. Extend +>>>>>>>>>>>> build-namelist unit tester test ALL resolutions/use-cases. + M models/lnd/clm/bld/configure ---- Add ability to handle slibs + M models/lnd/clm/bld/user_nl_clm -- Format change + M models/lnd/clm/bld/config_files/config_definition.xml - slibs, wrf grids + M models/lnd/clm/bld/build-namelist ---------- Add a bunch of options needed for CESM + (all but -chk_res and -note are already exercised when running CESM) + -chk_res ------- Check resolution and land mask first. + -clm_startfile - Input file to use to startup for branch or startup cases. + -co2_type ------ CO2 type + -inst_string --- Instance string to use for clm_startfile for multi-instance cases. + -l_ncpl -------- Number of coupling time-steps to take per day. + -lnd_frac ------ Land fraction file to use (domain file) + -note ---------- Write out note about build-namelist usage to end of file. + namelist definition/defaults files also come from drv/bld and datm/bld, get working + with latest externals + M models/lnd/clm/bld/clm.cpl7.template ------- Use new + clm.buildnml.csh/clm.buildexe.csh scripts which save us from the "\" nightmare + M models/lnd/clm/bld/queryDefaultNamelist.pl - namelist_defaults/definition files + are now split out in datm/drv directories + M models/lnd/clm/bld/queryDefaultXML.pm ------ definition files are an array now + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - Test a ton more + things. Add -compare, -test, -generate options. Test all use_cases and all + resolutions + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl ------ Add some more resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Get rid of drv/datm + namelist items + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl - Get rid of drv/datm + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add chk_res, note + and default masks for WRF grids + M models/lnd/clm/bld/namelist_files/datm-build-namelist ----- Use datm namelist + defaults/definition files. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Set do_rtm for + regional grids to .false. Add wrf grids: us20, wus12. Add ne4, ne16, ne60 + files. Add 20th transient PFT for: ne16, ne30, ne60, ne120. Set nsegspc to 1 + for hi-res and ne grids. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Domain files + for 512x1024, ne4, ne16, ne60, ne240, and us20, wus12. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Set crop + for LAI and vegtyp files + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Remove settings + already in drv/bld file + +>>>>>>>>>>>> Remove write(6 for write to iulog, remove unneeded writes +>>>>>>>>>>>> use shr_pio over seq_pio. Allow -180-180 form. + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - remove write + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - write to iulog + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------ use endrun not write(6 + M models/lnd/clm/src/main/ndepStreamMod.F90 -------- use shr_pio_getiotype + M models/lnd/clm/src/main/pftdynMod.F90 ------------ use endrun not write(6 + M models/lnd/clm/src/main/histFileMod.F90 ---------- use shr_pio_getiotype + dimension hist_excl* as max_namlen+2 + M models/lnd/clm/src/main/ncdio_pio.F90 ------------ use + shr_pio_getiotype/shr_pio_getiosys + M models/lnd/clm/src/main/surfrdMod.F90 ------------ remove write(6 statements + put write in "if ( masterproc )", if longitudes off by more than 300 + see if -180-180 form works + +Summary of testing: + + build-namelist unit testing: All PASS except... + us20 + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +058 bl514 TBLCFGtools.sh gen_domain CFGtools__ds T31.runoptions .................................FAIL! rc= 4 +060 bl754 TBLtools.sh mksurfdata_map tools__s namelist ..........................................FAIL! rc= 5 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +071 bl924 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds .....FAIL! rc= 5 +073 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 7 +075 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 5 +078 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +079 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +080 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +081 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +082 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +083 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except.. +FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_43 +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL ERI.T31_g37.IG1850.bluefire_ibm.generate.clm4_0_44 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 + lynx/pgi testing: All PASS + lynx/pgi interactive testing: All PASS except... +024 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +025 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +026 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + mirage,storm/ifort interactive testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_43 + +Changes answers relative to baseline: No, bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_43 +Originator(s): sacks (Bill Sacks); erik (Erik Kluzek) +Date: Fri Apr 6 11:36:21 MDT 2012 +One-line Summary: Add diagnostic fields, modify some existing history fields + +Purpose of changes: + +Add new diagnostic fields to track snow and ice fluxes. Modify some soil-related fields to +only be averaged over vegetated landunits (from Dave Lawrence). Fix some diagnostic fields +that were incorrect, especially over lakes and urban areas. Change QICE to spval rather +than 0 over non-ice_mec landunits. Rename QMELT to QSNOMELT. Delete redundant QICEYR. Add +snow balance check from Keith Oleson. Add flexible handling of l2g_scale_type in +subgridAveMod, replacing 'urbanh' c2l_scale_type and adding new functionality. Modify +create_clm_s2x to only reference qflx_glcice in the run loop, not in initialization, +because it is now NaN in initialization. Update scripts and esmf_wrf_timemgr. Changes in +clm.cpl7.template from Tony. Add in unit_testers for build-namelist. Update to nsegspc +branch. New qtr-degree RTM file, updates to mkmapdata.sh so requires -r if -f set, +build-namelist changes to ensure rtm and glc options consistent, and updates of +documentation to the latest cesm1_0_4 release tag. Sets nsegspc in the namelist and for +ne30_g16 sets it to 5. Enhancements to baseline tests. + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage. +Fix perf bug 1485, Fix ne30 issue 1488, Fix history dimension issue 1489 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (partial -- now works with nsegspc=5) + 1489 (history dimension issue) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (Problem reading restarts@ne30_g16 for some layouts) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Modified clm.cpl7.template to no longer copy lnd_in to the case directory + +Describe any changes made to the namelist: + + For glacierMEC, use QICE rather than QICEYR for annual history files + Set nsegspc to 5 for ne30np4 and the default of 20 otherwise + +List any changes to the defaults for the boundary datasets: + + Fix qtr-degree RTM mapping file name + +Describe any substantial timing or memory changes: + + Fixes bug 1485 (performance issue with esmf_wrf_timemgr) + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + esmf_wrf_timemgr, cprnc + + scripts to scripts4_120329d + Machines to Machines_120406 + esmf_wrf_timemgr to esmf_wrf_timemgr_120327 + cprnc to cprnc_120405 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>> Enhancements to baseline tests, and post-processor for test results +A models/lnd/clm/test/system/get_cprnc_diffs.sh - Script used by TBL.sh and + TBLrst_tools.sh +A models/lnd/clm/test/system/show_var_diffs.sh -- Post-processor for baseline test + results + +>>>>>>> Add build-namelist unit_tester +A models/lnd/clm/bld/unit_testers +A models/lnd/clm/bld/unit_testers/build-namelist_test.pl + +List all existing files that have been modified, and describe the changes: + +>>>>>>> Use CSMDATA rather than HOME +M models/lnd/clm/test/system/nl_files/getregional + +>>>>>>> Require -res to be set if -f option used +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh + +>>>>>>> Fix qtr-degree RTM map, set nsegspc, work on usability +M models/lnd/clm/bld/user_nl_clm ---- Add notes about setting some things + with build-namelist options +M models/lnd/clm/bld/build-namelist - Set nsegspc, make sure glc_grid, glc_smb + do_rtm, and maxpatch_glcmec aren't set inconsistently between user_nl_clm + and build-namelist options +M models/lnd/clm/bld/README --------- Add notes about new unit_testers +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- qtr-degree RTM + mapping file, and set nsegspc + +>>>>>>> Bring in documentation updates from cesm1_0_4_n05_clm4_0_32, notes on setting +>>>>>>> finidat, adding history fields list +M models/lnd/clm/doc/UsersGuide/special_cases.xml +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>> Remove duplicate line +M models/lnd/clm/test/system/tests_pretag_bluefire + +>>>>>>> Use get_cprnc_diffs.sh; truly print diffs from last file with a failed comparison +>>>>>>> rather than just printing diffs if last comparison failed +M models/lnd/clm/test/system/TBL.sh +M models/lnd/clm/test/system/TBLrst_tools.sh + +>>>>>>> Use QICE rather than QICEYR for annual history files +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml + +>>>>>>> no longer copy lnd_in to the case directory +M models/lnd/clm/bld/clm.cpl7.template + +>>>>>>> Add new variables for tracking snow and ice fluxes +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Also changed init of btran + and fpsn to spval +M models/lnd/clm/src/main/histFldsMod.F90 -------------- Add some fields, add + c2l_scale_type or l2g_scale_type for others; rename QMELT to QSNOMELT; delete + QICEYR +M models/lnd/clm/src/main/histFileMod.F90 -------------- Time-constant fields just + averaged over certain land units; add handling of set_noglcmec for pft-level + variables. Also, use lon & lat rather than lonatm & latatm +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------ Compute qflx_glcice_frz +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Compute qflx_glcice_melt + and qflx_snofrz_col +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 --- To get proper grid cell + averages, turn some locals into globals, and add calculation of additional + fields + +>>>>>>> Change QICE to spval rather than 0 over non-ice_mec landunits +M models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 + +>>>>>>> Add snow balance check, fix water balance check for glc_dyntopo +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - Add calculation of + qflx_sl_top_soil, needed for snow balance check +M models/lnd/clm/src/main/pft2colMod.F90 ------------- Column-level averages of some + variables needed for snow balance check; also fixed average of qflx_evap_tot + for lakes + +>>>>>>> Only reference qflx_glcice in the run loop, not in initialization +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 - pass init argument +M models/lnd/clm/src/main/clm_glclnd.F90 ------ in init, qice remains 0 + +>>>>>>> Flexible handling of l2g_scale_type +M models/lnd/clm/src/main/clm_varcon.F90 ---- max_lunit parameter +M models/lnd/clm/src/main/subgridAveMod.F90 - new subroutines for concise handling + of l2g_scale_type; add checks for l2g_scale_type==spval; remove urbanh + c2l_scale_type + + + +Summary of testing: + + bluefire: All PASS except: +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 7 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 7 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 7 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +043 blCn1 TBL.sh _sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arb_ic FAIL! rc= 7 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 +047 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 2 +051 blH#2 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 ne30np4 gx1v6@2000 48 startup .........FAIL! rc= 7 +053 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +054 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +055 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +056 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except: +008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 7 +012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 7 +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +038 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 7 +046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 7 +054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 7 +075 bl9S4 TBLscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 5 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except: +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_42 + bluefire/PTCLM testing: Not done + lynx/pgi testing: All PASS except: +004 blC92 TBL.sh _sc_dm clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +007 blD92 TBL.sh _persc_dm clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blF92 TBL.sh 17p_sc_dm clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +015 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +019 blL52 TBL.sh _sc_dm clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 + lynx/pgi interactive testing: All PASS except: +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +024 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +025 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + lynx/CESM testing: All PASS except: +FAIL ERS_D.T31_g37.I1850.lynx_pgi.compare_hist.clm4_0_42 +FAIL ERS_D.T31_g37.I1850.lynx_pgi.compare_hist.clm4_0_42 +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.C.124327 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_42 + mirage,storm/ifort interactive testing: All PASS except: +007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 +023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 7 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_42 + +Changes answers relative to baseline: Just changes some diagnostic fields + + Changes the following default history fields: TSOI, HCSOI, ZWT, WA, WT, H2OSOI, + SOILLIQ, SOILICE, SOILWATER_10CM, QICE, QSNWCPICE_NODYNLNDUSE, QSNWCPLIQ + + Renames QMELT to QSNOMELT + + Also changes some fields not output by default + + Also changes cpl avghist files due to changes in qflx_glcice in initialization, but + this doesn't affect the simulation + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change: diagnostic fields only + +=============================================================== +=============================================================== +Tag name: clm4_0_42 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 27 21:14:59 MDT 2012 +One-line Summary: Bring in Francis Vitt's MEGAN changes. + +Purpose of changes: + +Bring Francis Vitt's MEGAN branch to the trunk. Replace the five VOC +compounds with the MEGAN model that allows up to 150 compounds to be +generated and passed to the driver. The mechanism allows the fields to +be choosen by a driver namelist which CLM responds to. + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1459 (PTSMODE fails) + 1480 (Darwin_intel build) + 1482 (Problems running 1x1 resolutions for CLM) + 1484 (re-configure removes the user_nl_clm) + 1486 (bad irrigation maps) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + + Add new -megan option to CLM build-namelist to add a megan namelist to + the drv_flds_in file. + Rename -drv_drydep option to -drydep. + + New namelist items for MEGAN: megan_factors_file, megan_specifier, and + megan_mapped_emisfctrs go into the megan_emis_nl namelist in drv_flds_in + + History fields removed: BIOGENCO, ISOPRENE (replaced by MEG_isoprene), + MONOTERP, ORVOC, ORVOC, OVOC + + Units of VOCFLXT changed from uGC/M2/H to moles/m2/sec + + New history fields: + ++ GAMMAC = gamma C for VOC calc (0-1) ++ MEG_2met_2s = MEGAN flux (kg/m2/sec) ++ MEG_2met_nonatriene = MEGAN flux (kg/m2/sec) ++ MEG_2met_s = MEGAN flux (kg/m2/sec) ++ MEG_2met_styrene = MEGAN flux (kg/m2/sec) ++ MEG_3met_3DCTT = MEGAN flux (kg/m2/sec) ++ MEG_Ehsalate = MEGAN flux (kg/m2/sec) ++ MEG_MBO_2m3e2ol = MEGAN flux (kg/m2/sec) ++ MEG_MBO_3m2e1ol = MEGAN flux (kg/m2/sec) ++ MEG_MBO_3m3e1ol = MEGAN flux (kg/m2/sec) ++ MEG_Napthalene = MEGAN flux (kg/m2/sec) ++ MEG_PPPP_2s = MEGAN flux (kg/m2/sec) ++ MEG_acetaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_acetic_acid = MEGAN flux (kg/m2/sec) ++ MEG_acetone = MEGAN flux (kg/m2/sec) ++ MEG_acoradiene = MEGAN flux (kg/m2/sec) ++ MEG_ammonia = MEGAN flux (kg/m2/sec) ++ MEG_anisole = MEGAN flux (kg/m2/sec) ++ MEG_aromadendrene = MEGAN flux (kg/m2/sec) ++ MEG_benzaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_benzyl-acetate = MEGAN flux (kg/m2/sec) ++ MEG_benzyl-alcohol = MEGAN flux (kg/m2/sec) ++ MEG_bergamotene_a = MEGAN flux (kg/m2/sec) ++ MEG_bergamotene_b = MEGAN flux (kg/m2/sec) ++ MEG_bisabolene_a = MEGAN flux (kg/m2/sec) ++ MEG_bisabolene_b = MEGAN flux (kg/m2/sec) ++ MEG_bornene = MEGAN flux (kg/m2/sec) ++ MEG_borneol = MEGAN flux (kg/m2/sec) ++ MEG_bornyl_ACT = MEGAN flux (kg/m2/sec) ++ MEG_bourbonene_b = MEGAN flux (kg/m2/sec) ++ MEG_butanone_2 = MEGAN flux (kg/m2/sec) ++ MEG_butene = MEGAN flux (kg/m2/sec) ++ MEG_cadinene_d = MEGAN flux (kg/m2/sec) ++ MEG_cadinene_g = MEGAN flux (kg/m2/sec) ++ MEG_camphene = MEGAN flux (kg/m2/sec) ++ MEG_camphor = MEGAN flux (kg/m2/sec) ++ MEG_carbon_2s = MEGAN flux (kg/m2/sec) ++ MEG_carbon_monoxide = MEGAN flux (kg/m2/sec) ++ MEG_carbonyl_s = MEGAN flux (kg/m2/sec) ++ MEG_carene_3 = MEGAN flux (kg/m2/sec) ++ MEG_caryophyllene_b = MEGAN flux (kg/m2/sec) ++ MEG_cedrene_a = MEGAN flux (kg/m2/sec) ++ MEG_cedrol = MEGAN flux (kg/m2/sec) ++ MEG_cineole_1_8 = MEGAN flux (kg/m2/sec) ++ MEG_copaene_a = MEGAN flux (kg/m2/sec) ++ MEG_cubebene_a = MEGAN flux (kg/m2/sec) ++ MEG_cubebene_b = MEGAN flux (kg/m2/sec) ++ MEG_cymene_o = MEGAN flux (kg/m2/sec) ++ MEG_cymene_p = MEGAN flux (kg/m2/sec) ++ MEG_decanal = MEGAN flux (kg/m2/sec) ++ MEG_diallyl_2s = MEGAN flux (kg/m2/sec) ++ MEG_dodecene_1 = MEGAN flux (kg/m2/sec) ++ MEG_elemene_b = MEGAN flux (kg/m2/sec) ++ MEG_estragole = MEGAN flux (kg/m2/sec) ++ MEG_ethane = MEGAN flux (kg/m2/sec) ++ MEG_ethanol = MEGAN flux (kg/m2/sec) ++ MEG_ethene = MEGAN flux (kg/m2/sec) ++ MEG_farnescene_a = MEGAN flux (kg/m2/sec) ++ MEG_farnescene_b = MEGAN flux (kg/m2/sec) ++ MEG_fenchene_a = MEGAN flux (kg/m2/sec) ++ MEG_fenchone = MEGAN flux (kg/m2/sec) ++ MEG_formaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_formic_acid = MEGAN flux (kg/m2/sec) ++ MEG_geranyl_acetone = MEGAN flux (kg/m2/sec) ++ MEG_germacrene_B = MEGAN flux (kg/m2/sec) ++ MEG_germacrene_D = MEGAN flux (kg/m2/sec) ++ MEG_gurjunene_b = MEGAN flux (kg/m2/sec) ++ MEG_heptanal = MEGAN flux (kg/m2/sec) ++ MEG_heptane = MEGAN flux (kg/m2/sec) ++ MEG_heptanone = MEGAN flux (kg/m2/sec) ++ MEG_hexanal = MEGAN flux (kg/m2/sec) ++ MEG_hexane = MEGAN flux (kg/m2/sec) ++ MEG_hexanol_1 = MEGAN flux (kg/m2/sec) ++ MEG_hexenal_c3 = MEGAN flux (kg/m2/sec) ++ MEG_hexenal_t2 = MEGAN flux (kg/m2/sec) ++ MEG_hexenol_c3 = MEGAN flux (kg/m2/sec) ++ MEG_hexenyl_ACT_c3 = MEGAN flux (kg/m2/sec) ++ MEG_homosalate = MEGAN flux (kg/m2/sec) ++ MEG_humulene_a = MEGAN flux (kg/m2/sec) ++ MEG_humulene_g = MEGAN flux (kg/m2/sec) ++ MEG_hydrogen_cyanide = MEGAN flux (kg/m2/sec) ++ MEG_hydrogen_s = MEGAN flux (kg/m2/sec) ++ MEG_indole = MEGAN flux (kg/m2/sec) ++ MEG_ionone_b = MEGAN flux (kg/m2/sec) ++ MEG_ipsenol = MEGAN flux (kg/m2/sec) ++ MEG_isolongifolene = MEGAN flux (kg/m2/sec) ++ MEG_isoprene = MEGAN flux (kg/m2/sec) ++ MEG_jasmone = MEGAN flux (kg/m2/sec) ++ MEG_limonene = MEGAN flux (kg/m2/sec) ++ MEG_linalool = MEGAN flux (kg/m2/sec) ++ MEG_linalool_OXD_c = MEGAN flux (kg/m2/sec) ++ MEG_linalool_OXD_t = MEGAN flux (kg/m2/sec) ++ MEG_longifolene = MEGAN flux (kg/m2/sec) ++ MEG_longipinene = MEGAN flux (kg/m2/sec) ++ MEG_met_benzoate = MEGAN flux (kg/m2/sec) ++ MEG_met_bromide = MEGAN flux (kg/m2/sec) ++ MEG_met_chloride = MEGAN flux (kg/m2/sec) ++ MEG_met_heptenone = MEGAN flux (kg/m2/sec) ++ MEG_met_iodide = MEGAN flux (kg/m2/sec) ++ MEG_met_jasmonate = MEGAN flux (kg/m2/sec) ++ MEG_met_mercaptan = MEGAN flux (kg/m2/sec) ++ MEG_met_propenyl_2s = MEGAN flux (kg/m2/sec) ++ MEG_met_salicylate = MEGAN flux (kg/m2/sec) ++ MEG_meta-cymenene = MEGAN flux (kg/m2/sec) ++ MEG_methane = MEGAN flux (kg/m2/sec) ++ MEG_methanol = MEGAN flux (kg/m2/sec) ++ MEG_muurolene_a = MEGAN flux (kg/m2/sec) ++ MEG_muurolene_g = MEGAN flux (kg/m2/sec) ++ MEG_myrcene = MEGAN flux (kg/m2/sec) ++ MEG_myrtenal = MEGAN flux (kg/m2/sec) ++ MEG_nerolidol_c = MEGAN flux (kg/m2/sec) ++ MEG_nerolidol_t = MEGAN flux (kg/m2/sec) ++ MEG_neryl_acetone = MEGAN flux (kg/m2/sec) ++ MEG_nitric_OXD = MEGAN flux (kg/m2/sec) ++ MEG_nitrous_OXD = MEGAN flux (kg/m2/sec) ++ MEG_nonanal = MEGAN flux (kg/m2/sec) ++ MEG_nonenal = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_al = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_c_b = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_t_b = MEGAN flux (kg/m2/sec) ++ MEG_octanal = MEGAN flux (kg/m2/sec) ++ MEG_octanol = MEGAN flux (kg/m2/sec) ++ MEG_octenol_1e3ol = MEGAN flux (kg/m2/sec) ++ MEG_oxopentanal = MEGAN flux (kg/m2/sec) ++ MEG_pentanal = MEGAN flux (kg/m2/sec) ++ MEG_pentane = MEGAN flux (kg/m2/sec) ++ MEG_phellandrene_a = MEGAN flux (kg/m2/sec) ++ MEG_phellandrene_b = MEGAN flux (kg/m2/sec) ++ MEG_phenyl_CCO = MEGAN flux (kg/m2/sec) ++ MEG_pinene_a = MEGAN flux (kg/m2/sec) ++ MEG_pinene_b = MEGAN flux (kg/m2/sec) ++ MEG_piperitone = MEGAN flux (kg/m2/sec) ++ MEG_propane = MEGAN flux (kg/m2/sec) ++ MEG_propene = MEGAN flux (kg/m2/sec) ++ MEG_pyruvic_acid = MEGAN flux (kg/m2/sec) ++ MEG_sabinene = MEGAN flux (kg/m2/sec) ++ MEG_selinene_b = MEGAN flux (kg/m2/sec) ++ MEG_selinene_d = MEGAN flux (kg/m2/sec) ++ MEG_terpinene_a = MEGAN flux (kg/m2/sec) ++ MEG_terpinene_g = MEGAN flux (kg/m2/sec) ++ MEG_terpineol_4 = MEGAN flux (kg/m2/sec) ++ MEG_terpineol_a = MEGAN flux (kg/m2/sec) ++ MEG_terpinolene = MEGAN flux (kg/m2/sec) ++ MEG_terpinyl_ACT_a = MEGAN flux (kg/m2/sec) ++ MEG_tetradecene_1 = MEGAN flux (kg/m2/sec) ++ MEG_thujene_a = MEGAN flux (kg/m2/sec) ++ MEG_thujone_a = MEGAN flux (kg/m2/sec) ++ MEG_thujone_b = MEGAN flux (kg/m2/sec) ++ MEG_toluene = MEGAN flux (kg/m2/sec) ++ MEG_tricyclene = MEGAN flux (kg/m2/sec) ++ MEG_verbenene = MEGAN flux (kg/m2/sec) + +List any changes to the defaults for the boundary datasets: + Correct fpftdyn historical f05 dataset, and add rcp datasets + Fix irrig map for f19 and f10 + +Describe any substantial timing or memory changes: None + Although bug 1485 is NOT fixed! (4X performance hit due to updated esmf_wrf_timemgr!) + +Code reviewed by: self,fvitt + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + drv, pio, cprnc, and cism + + scripts to scripts4_120323 + Machines to Machines_120323a + drv to drvseq4_1_04 + pio to pio_1_4_2 + cprnc to cprnc_120322 + cism to cism1_120322 + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/bld/namelist_files/history_fields.xsl - Style sheet to view history_fields XML file +A + models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 ---- MEGAN factors file + +List all existing files that have been modified, and describe the changes: + +>>>>>>>> Remove PTS-MODE restart tests +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi +M models/lnd/clm/test/system/tests_posttag_yong +MM models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/test_driver.sh ----- Correct machine name for lynx +M models/lnd/clm/test/system/nl_files/nl_voc ---- Add megan namelist +M models/lnd/clm/test/system/nl_files/clm_drydep Add -megan option rename drydep +to drydep +M models/lnd/clm/test/system/input_tests_master - Tests with VOC must use + clm_drydep, make CA8 tests use drydep + +M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES - update cprnc + +M models/lnd/clm/bld/configure --------- Change top level model from cesm to driver +M models/lnd/clm/bld/build-namelist ---- Add -megan option/namelist, rename + -drv_drydep to drydep, add checking for megan namelist items +M models/lnd/clm/bld/clm.cpl7.template - Fix multi-instance issues, and + don't overwrite user_nl_clm file if it already exists + +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ----- Update driver + namelist items, add megan namelist, more fields to drydep_list, list + megan compounds +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Add commented + out finidat file for f05, update f05 fpftdyn and add fpftdyn for f05 rcp's + update irrig 10x15 mapping file +M models/lnd/clm/bld/namelist_files/namelist_defaults_drydep.xml - Add defaults + for megan namelist + +M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Change VOC fields to megan + fields +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ------ Change VOC fields to megan + fields +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ---- Change VOC fiels to megan +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - Use Megan_factors_mod, + add VOCEmission_init, megan namelist determines the fields that will be + output rather than the 5 VOC fields +MM models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - More fields that can be + "mapped": 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' +M models/lnd/clm/src/main/clm_varpar.F90 ----------- Remove nvoc +M models/lnd/clm/src/main/clm_initializeMod.F90 ---- Add call to VOCEmission_init +M models/lnd/clm/src/main/clmtypeInitMod.F90 ------- Remove averaged voc fields +M models/lnd/clm/src/main/clm_atmlnd.F90 ----------- Remove voc add megan fields +M models/lnd/clm/src/main/findHistFields.pl -------- Add ability to handle new + megan fields +M models/lnd/clm/src/main/clm_driver.F90 ----------- Initialize cisun/cisha + to -999. each time-step for VOCEmission +M models/lnd/clm/src/main/ncdio_pio.F90 ------------ Changes from John Truesdale + so that PTS_MODE will work +M models/lnd/clm/src/main/clmtype.F90 -------------- VOC fields have extra + dimension remove averaged field +M models/lnd/clm/src/main/histFldsMod.F90 ---------- Remove specific VOC fields + add MEG_ fields + +Summary of testing: + + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 7 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 +047 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 2 + bluefire interactive testing: All PASS except +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +050 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +073 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except.. +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL SMS.1x1_numaIA.ICN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL ERP.1x1_mexicocityMEX.I.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_41 + bluefire/PTCLM testing: All FAIL + lynx interactive testing: ALL PASS up to... +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 + lynx/CESM testing: All PASS except.. +FAIL ERS_D.T31_g37.I1850.lynx_pgi.generate.clm4_0_42 +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.GC.121827 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_41 +BFAIL ERS.1x1_vancouverCAN.I.lynx_pgi.compare_hist.clm4_0_41 + mirage,storm/ifort interactive testing: All PASS! + yong/darwin/ifort interactive testing: All PASS up to... +005 smCL4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_41 + +Changes answers relative to baseline: bit-for-bit (except cases with MEGAN or VOC) + +=============================================================== +=============================================================== +Tag name: clm4_0_41 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 13 23:43:45 MDT 2012 +One-line Summary: Bring rmfmesh/rtmmap branches to trunk + +Purpose of changes: + +Get working with latest scripts and have clm template call build-namelist directly. Move +rmfmesh/rtmmap branch to trunk. Remove CASA completely. Start using RTM mapping files. +Allow bigger tolerance for mksurfdata_map frac up to 1.e-5 so can work for f4x5. New +half-degree mapping files. Remove code to calculate RTM mapping. Remove ability to set +maxpatch_pft to something different than numpft in CLM configure. Remove +-ad_spinup/-exit_spinup options in configure make generic -spinup option with a few +allowed values (similar to the clm45sci version of configure). New 1850 fsurdat dataset +for ne240np4. Update externals to the latest, get test_driver working. + +Requirements for tag: test on bluefire (CESM,int,bat), lynx/pgi (CESM), mirage, +template calls build-namelist. Fix 1477, 1476, 1468, 1467 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1477 (Bad f05 datasets) + 1476 (Problem with stand-alone build on bluefire) + 1468 (Bad f09, f19 SCRIP Grid files) + 1467 (Remove runinit_ibm.csh script) + 1449 (Remove fine-mesh) + 1448 (Remove CASA) + 1432 (Several resolutions fail for new mksurfdata_map) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1480 (Darwin_intel build) + 1482 (Problems running 1x1 resolutions for CLM) + 1485 (Performance issue with esmf_wrf_timemgr) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Remove CASA option, don't allow maxpft to be set. + CESM scripts/Machines updated. + +Describe any changes made to the namelist: + + BuildConf/clm.buildnml.csh now becomes a script that simply calls the clm + build-namelist script to build your namelist. This means you effectively treat it + as a READ-only script that you don't put changes into! Instead you use + the "user_nl_clm" file to put your custom changes to the namelist into. + The use of user_nl_clm is documented in the CLM User's Guide at... + + http://www.cesm.ucar.edu/models/cesm1.0/clm/models/lnd/clm/doc/UsersGuide/x1423.html#config_time_nml + + Use preview_namelists to see full namelists that will be created. + +List any changes to the defaults for the boundary datasets: Activate RTM mapping files + New 1840 ne240 fsurdat file, replace all f05 mapping files, replace all f05 mapping + files, and f05, f09, and f19 SCRIP grid files + +Describe any substantial timing or memory changes: Yes! + Much less global memory needed now! Only one temporary global integer array + used. + + 4X performance hit due to updated esmf_wrf_timemgr! (see bug 1485) + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + drv, csm_share, esmf_wrf_timemgr, datm + + scripts to datm8_120219 + Machines to Machines_120309 + drv to drvseq4_1_02 + csm_share to share3_120308 + esmf_wrf_timemgr to esmf_wrf_timemgr_120218 + datm to datm8_120219 + +List all files eliminated: + +>>>>>>> Eliminate stand-alone intrepid/kraken testing files, CASA, fine-mesh, +>>>>>>> and RTM mapping calc. Elimanate interpinic run script, too hard to support. +D models/lnd/clm/test/system/tests_posttag_intrepid +D models/lnd/clm/test/system/tests_posttag_intrepid_nompi +D models/lnd/clm/test/system/tests_posttag_kraken +D models/lnd/clm/tools/interpinic/runinit_ibm.csh +D models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 +D models/lnd/clm/src/biogeochem/CASAMod.F90 +D models/lnd/clm/src/main/CASAiniTimeVarMod.F90 +D models/lnd/clm/src/main/downscaleMod.F90 +D models/lnd/clm/src/riverroute/RtmMapMod.F90 + +List all files added and what they do: Add config defaults files for supported + single point datasets, add empty user_nl_clm file + +A + models/lnd/clm/bld/user_nl_clm +A + models/lnd/clm/bld/config_files/config_defaults_1x1_smallvilleIA.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_mexicocityMEX.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_numaIA.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_vancouverCAN.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Changes to config_file for changes to configure +>>>>>>>>>>>>> eliminate use of maxpft, ad_spinup and exit_spinup use spinup option +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh +M models/lnd/clm/test/system/config_files/17p_cndvsc_m +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m +M models/lnd/clm/test/system/config_files/17p_cndvsc_o +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s +M models/lnd/clm/test/system/config_files/17p_cndvsc_s +M models/lnd/clm/test/system/config_files/17p_sc_dh +M models/lnd/clm/test/system/config_files/17p_sc_dm +M models/lnd/clm/test/system/config_files/17p_sc_do +M models/lnd/clm/test/system/config_files/17p_sc_ds +M models/lnd/clm/test/system/config_files/17p_cnsc_h +M models/lnd/clm/test/system/config_files/21p_cncrpsc_h +M models/lnd/clm/test/system/config_files/17p_cnsc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_m +M models/lnd/clm/test/system/config_files/17p_cnsc_m +M models/lnd/clm/test/system/config_files/17p_cnsc_o +M models/lnd/clm/test/system/config_files/21p_cncrpsc_o +M models/lnd/clm/test/system/config_files/17p_cnsc_dm +M models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +M models/lnd/clm/test/system/config_files/17p_cnsc_do +M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_do +M models/lnd/clm/test/system/config_files/21p_cncrpsc_s +M models/lnd/clm/test/system/config_files/17p_sc_h +M models/lnd/clm/test/system/config_files/21p_cncrpsc_ds +M models/lnd/clm/test/system/config_files/17p_cnsc_ds +M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +M models/lnd/clm/test/system/config_files/17p_cnc13sc_do +M models/lnd/clm/test/system/config_files/17p_sc_m +M models/lnd/clm/test/system/config_files/17p_sc_o +M models/lnd/clm/test/system/config_files/17p_cnnfsc_dh +M models/lnd/clm/test/system/config_files/17p_cnnfsc_dm +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh +M models/lnd/clm/test/system/config_files/17p_cndvsc_dh +M models/lnd/clm/test/system/config_files/17p_cnnfsc_do +M models/lnd/clm/test/system/config_files/17p_cndvsc_dm +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm +M models/lnd/clm/test/system/config_files/17p_cndvsc_do +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h +M models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>> Get working with latest scripts, eliminate intrepid. +M models/lnd/clm/test/system/TCB.sh --------- Send -comp to configure +M models/lnd/clm/test/system/test_driver.sh - Eliminate intrepid, get working + with latest CESM scripts/Machines, update env settings to Machines +M models/lnd/clm/test/system/CLM_runcmnd.sh - Eliminate intrepid +M models/lnd/clm/test/system/tests_pretag_bluefire - Correct test name + +>>>>>>>>>>>>> Eliminate CASA +M models/lnd/clm/tools/interpinic/src/interpinic.F90 +M models/lnd/clm/tools/mksurfdata_map/src/clm_varctl.F90 + +>>>>>>>>>>>>> Eliminate CASA, and maxpft. Read site specific config_defaults +>>>>>>>>>>>>> Change spinup option, get working with latest scripts. +M models/lnd/clm/bld/configure --------- Use clm45sci API (use -spinup in + place of ad_spinup/exit_spinup), read site specific config_defaults + file when sitespf_pt option is used. Eliminate CASA, and maxpft option. + Get configure working with latest CESM scripts. Add mct/pio subdirectory + for SMP=on/off so will build on bluefire. Add -comp option required + for new CESM scripts (for stand-alone test). +M models/lnd/clm/bld/build-namelist ---- Remove faerdep, use spinup from + configure rather than ad/exit_spinup, remove substition of CSMDATA + in filenames. +M models/lnd/clm/bld/clm.cpl7.template - Use sitespf_pt for regional case + when CLM_USRDAT NOT used and don't use clm_root in configure. +M models/lnd/clm/bld/config_files/config_sys_defaults.xml - Add comp settings + and change mach settings to NOT include compiler. Remove: dec_osf, + es, irix, solaris, super-ux, unicosmp as no longer tested on +M models/lnd/clm/bld/config_files/config_definition.xml --- Remove CASA option + mxpft can only be 17 or 21. Add comp, remove ad_spinup/exit_spinup + for spinup option. Change description of sitespf_pt option. + +>>>>>>>>>>>>> Eliminate CASA, move ad/exit_spinup to spinup, add 1850 ne240 fsurdat +>>>>>>>>>>>>> Activate all RTM maps, replace all f05 maps. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Rm fget_archdev + only allow R05 for rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - ad_spinup + to spinup +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + add 1840 ne240 fsurdat, remove null setting of findat for maxpft=4 + activate RTM maps, replace all 0.47x0.63 mapping files +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Use + standard shared SCRIP-grid files for: f05, f09, f19 resolutions +M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Change + ad/exit_spinup to spinup +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Remove + fatmgrid, flndtopo, fatmtopo, and fatmlndfrc files +M models/lnd/clm/doc/IMPORTANT_NOTES - Remove CASA, fine-mesh, and fget_archdev + +>>>>>>>>>>>>> Eliminate CASA, fine-mesh and atm data, change llatlon for ldomain +>>>>>>>>>>>>> Require RTM map files to be read. Require fatmlndfrc files to be +>>>>>>>>>>>>> in CESM domain file format. Require maxpft=numpft+1. Fix a pnetcdf issue. +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Remove CASA use ldomain + in place of llatlon +M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------ ldomain replaces llatlon +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- Get rid of fine-mesh + downscaling, use ldomain in place of llatlon remove atm, lnd versions + of everything (adomain, adecomp, get_proc_bounds_atm, begg_a/l, atm_sx for example. +M models/lnd/clm/src/main/organicFileMod.F90 ---- llatlon becomes ldomain +M models/lnd/clm/src/main/decompInitMod.F90 ----- Remove decompInit_atm, acid + remove atm grid stuff for: decompInit_lnd and decompInit_glcp +M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove downscaling and atm/lnd + grid stuff as well as CASA. +M models/lnd/clm/src/main/clm_glclnd.F90 -------- Remove clm_maps2x and clm_mapx2s + and atm_s2x and atm_x2s +M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Remove CASA stuff +M models/lnd/clm/src/main/ndepStreamMod.F90 ----- Replace llatlon with ldomain +M models/lnd/clm/src/main/histFileMod.F90 ------- Remove atm grid stuff such + as gratm, namea grids, remove CASA +M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove downscaling/upscaling + init_adiag_type, clm_downscale_a2l and data: atm_a2l, atm_l2a, adiag_arain +M models/lnd/clm/src/main/restFileMod.F90 ------- Remove CASA +M models/lnd/clm/src/main/controlMod.F90 -------- Remove fatmgrid, CASA, fatmtopo + add write about flndtopo (still needed for glc_nec) +M models/lnd/clm/src/main/initSurfAlbMod.F90 ---- Remove CASA +M models/lnd/clm/src/main/clm_varctl.F90 -------- Remove downscale and CASA +M models/lnd/clm/src/main/clm_driver.F90 -------- Remove CASA +M models/lnd/clm/src/main/initGridCellsMod.F90 -- Remove setting of _a domain + info, gindex_a, longdeg_a, latdeg_a, lon_a, lat_a +M models/lnd/clm/src/main/ncdio_pio.F90 --------- Remove use of gratm, set + data=' ' needed for pnetcdf +M models/lnd/clm/src/main/surfrdMod.F90 --------- Remove surfrd_get_latlon, + surfrd_get_frac, surfrd_wtxy_veg_rank, surfrd_mkrank, add + surfrd_get_globmask in place of surfrd_get_latlon, get rid of + ability to read in CLM frac datasets and only read in CESM domain file + format. Abort if allocate_all_vegpfts is NOT true. +M models/lnd/clm/src/main/domainMod.F90 --------- Remove latlon_type, + nara, and ntop add isgrid2d, adomain, alatlon, llatlon, gatm, amask, pftm + methods: domain_setptrs, latlon_init, latlon_check, latlon_clean, + latlon_setsame +M models/lnd/clm/src/main/decompMod.F90 --------- Remove get_proc_global_atm, + get_proc_bounds_atm, and atmosphere decomposition data +M models/lnd/clm/src/main/clmtype.F90 ----------- Remove CASA, gratm +M models/lnd/clm/src/main/histFldsMod.F90 ------- Remove use of atm_a2l, +- adiag_arain, adiag_asnow, adiag_aflux, adiag_lflux, downscale + remove CASA and downscale if's +M models/lnd/clm/src/main/mkarbinitMod.F90 ------ Remove CASA +M models/lnd/clm/src/riverroute/RtmMod.F90 ------ Remove some global RTM + data. Replace call's to endrun to shr_sys_abort as intial + step of the move to having RTM on it's own component. + Add rtm_celledge. +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ---- llatlon to ldomain +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 - formatting change +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ---- Remove CASA +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ------ Remove downscaling + +Summary of testing: + + bluefire: TBL tests fail because of use of RTM mapping files and NetCDF issue and +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 + bluefire interactive testing: All PASS except, TBL tests fail because of NetCDF build issue and +026 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +027 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +031 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 + bluefire/CESM testing: All PASS except + (and ALL compare tests fail couldn't find base result) +FAIL SMS.1x1_numaIA.ICN.bluefire_ibm +FAIL ERP.1x1_mexicocityMEX.I.bluefire_ibm + bluefire/PTCLM testing: All FAIL + lynx/pgi testing: ALL FAIL + lynx/pgi interactive testing: ALL FAIL + lynx CESM testing: ALL PASS except... (don't compare as no baselines for clm4_0_40) +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.162157 +FAIL PST.f19_g16.I.lynx_pgi +RUN ERS.1x1_vancouverCAN.I.lynx_pgi.162157 + mirage,storm/ifort interactive testing: All PASS! + jaguarpf CESM testing: All FAIL +RUN ERS_D.f09_g16.I1850.titan_pgi.182111 +FAIL ERI.f10_f10.IRCP60CN.titan_pgi +FAIL PST.f09_g16.I.titan_pgi +FAIL PET_PT.f10_f10.I20TRCN.titan_pgi +FAIL ERP.f19_g16.I4804CN.titan_pgi +RUN ERS.1x1_mexicocityMEX.I.titan_pgi.182111 +FAIL ERI_D.ne30_g16.I1850CN.titan_pgi +TFAIL ERH.ne120_g16.I2000CN.titan_pgi.182111 +RUN ERS.f09_g16.IRCP26CN.titan_pgi.182111 +FAIL SMS.f10_f10.IRCP45CN.titan_pgi +RUN ERS.f19_g16.IRCP60CN.titan_pgi.182111 +FAIL SMS_D.f10_f10.IRCP85CN.titan_pgi +RUN ERS.f09_g16.IG1850.titan_pgi.182111 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_40 + +Changes answers relative to baseline: Yes (using RTM mapping files now) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: RTM mapping for f05 + - what platforms/compilers: + - nature of change larger than roundoff/same climate + +=============================================================== +=============================================================== +Tag name: clm4_0_40 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 16 14:19:28 MST 2012 +One-line Summary: Back out update to new T31 surface datasets + +Purpose of changes: + +Back out the new T31 surface datasets so will have initial conditions to use +for T31. Bring in the new surface datasets with initial conditions in the next tag. + +Requirements for tag: Run on bluefire + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Bring back old T31 datasets + Comment out the new T31 surface datasets and put back the old T31 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/src/main/findHistFields.pl -- Add script to figure out list of + history field names, long_names, and units + Create's a XML file as well as giving you a neatly formatted sorted list. + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Move T31 files + back to previous version and comment out the new files. + +Summary of testing: + + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + bluefire interactive testing: All PASS except... +026 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +027 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +031 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +065 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +080 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +082 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +084 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= + bluefire/CESM testing: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_39 + +Changes answers relative to baseline: T31 + + Answers are identical to clm4_0_38, if fatmgrid=fsurdat in controlMod.F90 + except for ntop for some grids and TREFMXAV and TREFMNAV for others. + +=============================================================== +=============================================================== +Tag name: clm4_0_39 +Originator(s): erik (Erik Kluzek) +Date: Wed Feb 1 11:40:11 MST 2012 +One-line Summary: Bring newgrid branch to trunk + +Purpose of changes: + +Move newgrid branch from Mariana to trunk. Add ne4np4, ne16np4, ne240np4 surface +datasets. Replace all T31 surface datasets. Start removing CASA and fine-mesh testing +and support. Bring in Tony's updates to ESMF5.2.0. + +Requirements for tag: + +run on lynx-pgi/bluefire/mirage-intel, fix bugs: 1446, 1444, 1442, 1404, 1430, 1425, 1420 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1458 (Problem using fsurdat for fatmgrid as no verticies) + 1444 (attempt to read unallocated variable) + 1442 (Make clm-template same as CAM template) + 1430 (Remove DIN_LOC_ROOT_CLMQIAN -- add ...CLM_FORC) + 1425 (Double quotes causes Namelist.pm to hang) + 1420 (Bad history output for TREFMNAV, TREFMXAV) + 1404 (Inconsistent domain and fatmlndfrc files) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Move rtm, voc, and glc_nec from configure-time to run-time namelist options + + Remove the -rtm -glc_nec and -voc options from "configure" + (NO longer available to CLM_CONFIG_OPTS) + + +Describe any changes made to the namelist: + + Add "-glc_nec, -glc_smb, -rtm options to build-namelist + (now available to CLM_BLDNML_OPTS) + + Remove fine-mesh option to build-namelist "-lnd_res" + (NO longer available to CLM_BLDNML_OPTS) + + Add following to clm_inparm namelist: + + do_rtm => If TRUE, turn on rtm river routing + maxpatch_glcmec => Number of multiple elevation classes over glacier points. + Normally this is ONLY used when running CESM with the active glacier model. + + Add following to the driver namelist to pass extra fields + + flds_voc + flds_co2a + flds_co2a + flds_co2c + flds_co2_dmsa + cplflds_custom + glc_nec + +List any changes to the defaults for the boundary datasets: + Replace T31 surface datasets, remove T31 finidat datasets + Add T31 fpftdyn datasets for all cases + Add ne240np4 datasets, ne4np4, ne16np4 surface datasets + + remove ALL fatmtopo datasets and all but T31, f09, f19 for glc_nec flndtopo + + Remove fatmlndfrc datasets -- use datm domainfiles in their place + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,mvertens,tcraig (ESMF update) + +List any svn externals directories updated (csm_share, mct, etc.): almost all + scripts to scripts4_120123 + Machines to Machines_120123 + drv to drvseq4_1_01 + datm to datm8_120123 + socn/sice/sglc to stubs1_3_01 + cism to cism1_120123 + csm_share to share3_120123 + esmf_wrf_tmgr to esmf_wrf_timemgr_120123 + gen_domain to gen_domain_120117 + +List all files eliminated: + +>>>>>>>>>>>>>> Get rid of mkgriddata as no longer needed +>>>>>>>>>>>>>> Use gen_domain or models/lnd/clm/tools/mkmapdata/mknoocnmap.pl + D mkgriddata/mkgriddata.namelist + D mkgriddata/mkgriddata.regional + D mkgriddata/src/mkvarpar.F90 + D mkgriddata/src/mkvarctl.F90 + D mkgriddata/src/clm_varpar.F90 + D mkgriddata/src/clm_varctl.F90 + D mkgriddata/src/shr_sys_mod.F90 + D mkgriddata/src/shr_file_mod.F90 + D mkgriddata/src/ncdio.F90 + D mkgriddata/src/shr_log_mod.F90 + D mkgriddata/src/Filepath + D mkgriddata/src/Macros.custom + D mkgriddata/src/shr_kind_mod.F90 + D mkgriddata/src/shr_const_mod.F90 + D mkgriddata/src/mkgriddata.F90 + D mkgriddata/src/domainMod.F90 + D mkgriddata/src/areaMod.F90 + D mkgriddata/src/creategridMod.F90 + D mkgriddata/src/nanMod.F90 + D mkgriddata/src/Srcfiles + D mkgriddata/src/Mkdepends + D mkgriddata/src/Makefile + D mkgriddata/src + D mkgriddata/mkgriddata.singlept + D mkgriddata/mkgriddata.cesm_dom + D mkgriddata/README + D mkgriddata + +>>>>>>>>>>>>>> Remove config files for CASA or that turn off RTM, or +>>>>>>>>>>>>>> turn on VOC or glc_mec + D models/lnd/clm/test/system/config_files/_nrsc_dh + D models/lnd/clm/test/system/config_files/4p_casasc_dh + D models/lnd/clm/test/system/config_files/4p_casasc_dm + D models/lnd/clm/test/system/config_files/4p_casasc_do + D models/lnd/clm/test/system/config_files/4p_casasc_ds + D models/lnd/clm/test/system/config_files/4p_casasc_h + D models/lnd/clm/test/system/config_files/4p_casasc_m + D models/lnd/clm/test/system/config_files/4p_casasc_o + D models/lnd/clm/test/system/config_files/17p_nrsc_ds + D models/lnd/clm/test/system/config_files/_nrsc_dm + D models/lnd/clm/test/system/config_files/_nrsc_do + D models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_h + D models/lnd/clm/test/system/config_files/_nrsc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_m + D models/lnd/clm/test/system/config_files/17p_nrcnsc_do + D models/lnd/clm/test/system/config_files/17p_vorsc_o + D models/lnd/clm/test/system/config_files/17p_nrcnsc_ds + D models/lnd/clm/test/system/config_files/_nrmexsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_dh + D models/lnd/clm/test/system/config_files/_nrcnsc_do + D models/lnd/clm/test/system/config_files/_mec10sc_dm + D models/lnd/clm/test/system/config_files/_nrcnsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_do + D models/lnd/clm/test/system/config_files/_mec10sc_ds + D models/lnd/clm/test/system/config_files/_nrsc_s + D models/lnd/clm/test/system/config_files/_nrvansc_ds + D models/lnd/clm/test/system/config_files/_nrnil3sc_dh + D models/lnd/clm/test/system/config_files/_nrnil3sc_dm + D models/lnd/clm/test/system/config_files/17p_vorsc_dh + D models/lnd/clm/test/system/config_files/21p_nrcncrpsc_s + D models/lnd/clm/test/system/config_files/21p_nrcncrpsc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_dm + D models/lnd/clm/test/system/config_files/17p_vorsc_do + D models/lnd/clm/test/system/config_files/17p_vorsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_h + D models/lnd/clm/test/system/config_files/_mec10sc_m + D models/lnd/clm/test/system/config_files/_mec10sc_o + +>>>>>>>>>>>>>> Remove mkdatadomain always use gen_domain + D models/lnd/clm/tools/mkdatadomain + D models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist + D models/lnd/clm/tools/mkdatadomain/src + D models/lnd/clm/tools/mkdatadomain/src/addglobal.F90 + D models/lnd/clm/tools/mkdatadomain/src/create_domain.F90 + D models/lnd/clm/tools/mkdatadomain/src/Mkdepends + D models/lnd/clm/tools/mkdatadomain/src/Srcfiles + D models/lnd/clm/tools/mkdatadomain/src/Filepath + D models/lnd/clm/tools/mkdatadomain/src/Macros.custom + D models/lnd/clm/tools/mkdatadomain/src/Makefile + D models/lnd/clm/tools/mkdatadomain/src/shr_kind_mod.F90 + D models/lnd/clm/tools/mkdatadomain/src/shr_const_mod.F90 + D models/lnd/clm/tools/mkdatadomain/README +>>>>>>>>>>>>>> fine-mesh no longer supported don't worry about topo files anymore + D models/lnd/clm/bld/namelist_files/checktopofiles.ncl + +List all files added and what they do: + +>>>>>>>>>>>>>> Rename without RTM off option + A + models/lnd/clm/test/system/config_files/17p_cnsc_ds + A + models/lnd/clm/test/system/config_files/_mexsc_ds + A + models/lnd/clm/test/system/config_files/_vansc_ds + +>>>>>>>>>>>>>> namelist to turn on VOC and RTM off, and gen_domain options + A + models/lnd/clm/test/system/nl_files/nl_voc + A + models/lnd/clm/test/system/nl_files/clm_nortm + A + models/lnd/clm/test/system/nl_files/gen_domain.ne30.runoptions + A + models/lnd/clm/test/system/nl_files/gen_domain.T31.runoptions + +>>>>>>>>>>>>>> Add scripts to create SCRIP grid/map files for region/single-point domains + A + models/lnd/clm/tools/mkmapdata/mkunitymap.ncl + A + models/lnd/clm/tools/mkmapdata/mknoocnmap.pl + A + models/lnd/clm/tools/mkmapgrids/mkscripgrid.ncl + + mknoocnmap.pl [options] Gets map and grid files for a single land-only point. + REQUIRED OPTIONS + -centerpoint [or -p] Center latitude,longitude of the grid to create. + -name [-or -n] Name to use to describe point + + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Remove rtm off from config files and update README file + M models/lnd/clm/test/system/config_files/_nil3sc_dh + M models/lnd/clm/test/system/config_files/_nil3sc_dm + M models/lnd/clm/test/system/config_files/README + +>>>>>>>>>>>>>> Change tests + M models/lnd/clm/test/system/README.testnames --- Update test names + 6, A, J, Q, S, V, X, and Z configurations are now unused + resolutions: 3, F, G and H are now unused + M models/lnd/clm/test/system/mknamelist --------- Remove fine-mesh option + M models/lnd/clm/test/system/test_driver.sh ----- Update paths for + edinburgh/jaguar + M models/lnd/clm/test/system/input_tests_master - Remove nr,vo,mec in configure + files for tests and move to namelist, remove compile-only test names + M models/lnd/clm/test/system/TSMtools.sh -------- Allow run files to + be in test directory + +>>>>>>>>>>>>>> Change testnames + 6, A, J, Q, S, V, X, and Z configurations are now unused + resolutions: 3, F, G and H are now unused + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + MM models/lnd/clm/test/system/tests_pretag_jaguarpf + MM models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>>>>>> Fix run-time options + M models/lnd/clm/test/system/nl_files/clm_usrdat ----- Add rtm off + M models/lnd/clm/test/system/nl_files/mkmapdata_if10 - Remove -i option + +>>>>>>>>>>>>>> Add option to create datasets NOT entered into XML database + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Use domainfile + rather than fatmgrid file, which changes variable names as well + M models/lnd/clm/tools/README.testing --------------- Note that run files + can be in tool directory or test directory + M models/lnd/clm/tools/README ----------------------- Update information on + process + MM models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl - Add usrspc option + M models/lnd/clm/tools/mkmapdata/regridbatch.sh ----- Use -b instead of -i + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh ------- Replace -i option with + -b for batch, add option to read input SCRIP grid file (-f) and (-t) + option for regional or global type, update usage + M models/lnd/clm/tools/mksurfdata_map/README -------- Update usage info + M models/lnd/clm/tools/mkmapdata/README ------------- Update usage info + + New options for unsupported resolutions to mksurfdata.pl + ++ For unsupported, user-specified resolutions: ++ $ProgName -res usrspec -usr_gname -usr_gdate [OPTIONS] ++ -usr_gname "user_gname" User resolution name to find grid file with ++ (only used if -res is set to 'usrspec') ++ -usr_gdate "user_gdate" User map date to find mapping files with ++ (only used if -res is set to 'usrspec') ++ NOTE: all mapping files are assumed to be in mkmapdata ++ - and the user needs to have invoked mkmapdata in ++ that directory first ++ + +>>>>>>>>>>>>>> Move rtm, glc_nec, voc from configure to build-namelist + M models/lnd/clm/bld/configure -------------- Remove -rtm, -glc_nec, -voc options + M models/lnd/clm/bld/listDefaultNamelist.pl - Get datm namelist files as well + M models/lnd/clm/bld/build-namelist --------- Add: glc_nec, glc_smb, rtm options + Remove: lnd_res fine-mesh option + M models/lnd/clm/bld/clm.cpl7.template ------ Move rtm, glc_nec settings from + configure to build-namelist, set fatmlndfrc from domain file set in scripts + add processing for LND_GRID=reg, set glc_smb, loop over namelists for DART, + M models/lnd/clm/bld/README + M models/lnd/clm/bld/config_files/config_definition.xml - Remove rtm, glc_nec, voc + +>>>>>>>>>>>>>> Add new namelist items, remove CASA, fine-mesh, update T31 +>>>>>>>>>>>>>> add ne4np4, ne16np4, ne240np4 datasets + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ + Add: rtm, maxpatch_glcmec, do_rtm, new cpl files, navy lmask + remove: fatmtopo, CASA namelist items, + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - rtm/glc_nec + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ------- rm CASA + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- + Add: do_rtm, new T31 fsurdat/fpftdyn files, new ne4np4, ne16np4, + fsurdat and ne240np4 fsurdat/fatmlndfrc, missing map files (f19,T31) + Remove: T31 finidat, remove fatmtopo, and most flndtopo + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Change + paths of domainfiles to share/domains + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Add 10min + navy grid file + +>>>>>>>>>>>>>> Add glc_nec + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml + + +>>>>>>>>>>>>>> Remove RTM, GLC_NEC, ESMF5.2.0 updates, don't require extents on fsurdat + M models/lnd/clm/src/main/clm_varpar.F90 -- Change for glc_nec + M models/lnd/clm/src/main/accumulMod.F90 -- Initialize val to zero if period=1 + M models/lnd/clm/src/main/clm_initializeMod.F90 - Change order of calls, rm RTM + M models/lnd/clm/src/main/clm_glclnd.F90 -- Use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/subgridMod.F90 -- Use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/histFileMod.F90 - Remove RTM add do_rtm + make sure ninst suffix is in restart history filename + M models/lnd/clm/src/main/restFileMod.F90 - Remove RTM add do_rtm + M models/lnd/clm/src/main/controlMod.F90 -- Remove RTM add do_rtm, + maxpatch_glcmec, glc_grid, use fatmlndfrc for fatmgrid if empty + broadcast glc_topomax if create_glacier_mec_landunit + M models/lnd/clm/src/main/clm_time_manager.F90 - Changes from Tony to update + to ESMF5.2.0 + M models/lnd/clm/src/main/clm_varctl.F90 ---- Remove RTM, use do_rtm, and remove + GLC_NEC use arrays for glc_nec variables + M models/lnd/clm/src/main/clm_driver.F90 ---- Remove RTM use do_rtm + M models/lnd/clm/src/main/initGridCellsMod.F90 - Write more info on error + M models/lnd/clm/src/main/pftvarcon.F90 ----- Remove unused MPI vars + M models/lnd/clm/src/main/surfrdMod.F90 ----- Don't require LATS/N,LONE/W on + files set to nan if not used, use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/domainMod.F90 ----- Don't write LATS/N,LONE/W if + first lonw is nan + M models/lnd/clm/src/main/decompMod.F90 ----- Remove RTM use do_rtm + M models/lnd/clm/src/main/histFldsMod.F90 --- Remove RTM use do_rtm + M models/lnd/clm/src/riverroute/RtmMod.F90 -- Remove RTM use run_rtm NOT do_rtm + M models/lnd/clm/src/riverroute/RunoffMod.F90 Remove RTM + +>>>>>>>>>>>>>> ESMF5.2.0 updates, remove RTM, GLC_NEC + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - ESMF5.2.0 updates, remove RTM + use do_rtm, remove GLC_NEC use arrays of glc_nec + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- ESMF5.2.0 updates + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- ESMF4.2.0 updates + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Updated for new coupler fields spec + Remove RTM, GLC_NEC CPP tokens, make glc_nec variables arrays + some updates to ESMF5.2.0 + +Summary of testing: + + bluefire: All PASS except... +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 7 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 (bluefire compiler error) +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 (bluefire compiler error) +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 (bluefire compiler error) +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 (bluefire compiler error) +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 (bluefire compiler error) +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 (bluefire compiler error) +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 (bluefire compiler error) +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 (bluefire compiler error) +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 (bluefire compiler error) +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 (bluefire compiler error) +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 (bluefire compiler error) +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 (bluefire compiler error) +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 (bluefire compiler error) +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 (bluefire compiler error) +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 (bluefire compiler error) +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 (bluefire compiler error) +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 (bluefire compiler error) + bluefire interactive testing: +008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 7 +012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 7 +016 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +020 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 +024 blJ74 TBL.sh 4p_casasc_ds clm_std^nl_urb 10001230:3600 1x1_tropicAtl test -100 arb_ic .......FAIL! rc= 7 +028 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic ........FAIL! rc= 7 +029 smCK4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 10 +030 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 5 +031 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 5 +032 blCK4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 4 +033 smCK8 TSM.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -10 cold ...........FAIL! rc= 10 +034 erCK8 TER.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 5 +035 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 5 +036 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +042 blF93 TBL.sh 17p_sc_do clm_std^nl_voc 20021230:1800 4x5 gx3v7 48 cold .......................FAIL! rc= 5 +046 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 7 +054 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 5 +058 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 5 +062 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +066 bl514 TBLtools.sh gen_domain tools__ds T31.runoptions .......................................FAIL! rc= 5 +075 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +076 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +083 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 7 +085 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 7 +090 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +091 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +092 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +093 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +094 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +095 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except, compare_hist +FAIL SMS_RLA.f45_f45.I.bluefire - bug 1459 +FAIL SMS_RLB.f45_f45.I.bluefire - bug 1459 +FAIL SMS_ROA.f45_f45.I.bluefire - bug 1459 + bluefire/PTCLM testing: All FAIL + lynx/pgi: All PASS except... +004 blC92 TBL.sh _sc_dm clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +007 blD92 TBL.sh _persc_dm clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blF92 TBL.sh 17p_sc_dm clm_std^nl_voc 20021230:1800 4x5 gx3v7 48 cold .......................FAIL! rc= 5 +015 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +019 blJ92 TBL.sh 4p_casasc_dm clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +023 blL52 TBL.sh _sc_dm clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 + lynx/pgi interactive testing: All PASS except.. +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +009 smCL4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 10 +010 erCL4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +011 brCL4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +012 blCL4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 4 +016 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +020 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic .....FAIL! rc= 5 +024 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 +025 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +026 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +027 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + mirage,storm/ifort interactive testing: +007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +015 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic ........FAIL! rc= 7 +019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 +023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 7 + jaguarpf: Currently NOT available: + edinburgh: Currently not supported + +CLM tag used for the baseline comparison tests if applicable: clm4_0_38 + +=============================================================== +=============================================================== +Tag name: clm4_0_38 +Originator(s): erik (Erik Kluzek) +Date: Mon Jan 23 13:56:45 MST 2012 +One-line Summary: Fix some minor issues with tools, add high resolution option and +datasets to mksurfdata, remove crap from clmtype so C13 will work on bluefire, convert +nans to FillValue for some cases, fix datasets, update doc + +Purpose of changes: + +Update externals to new version of scripts/Machines. Fix some bugs. Add in maps for: +ne4np4, ne16np4, ne60np4, and ne240np4 resolutions. Begin adding _FillValue/missing_value +to restart files. Start adding in new high-resolution datasets for mksurfdata. Add an +option to mksurfdata.pl to run at hi-res let default be standard half-degree datasets. +Add in 3x3min PFT dataset for 2000, and 5x5min organic. Add in maps for 3x3min and +5x5min_ISRIC_WISE to output grids. Separate out wetland and lake datasets, add in 3x3min +lake dataset. Get mksurfdata to work with T31, fix maps. Have both mksurfdata_map and clm +check files for consistencies. Add initial version of a script to check that maps in the +XML database are correct. Make sure keywords are set in tools, and OPT correctly added to +meta-data. Update gen_domain. Correct some typo's in filenames. Remove some unused data +in clmtype.F90. Update documentation to cesm1_0_4. + +Requirements for tag: + Testing on bluefire-only, Fix bugs: 1432 (part X), 1424X, 1423X, 1401 (part)X, 1309, + mksurfdata works at regular and hi-res and for f09, and at regular for: 128x256, + 512x1024, ne4np4, ne16np4, ne30np4, ne60np4, and ne240np4 resolutions, T31 and T31 + mksurfdata rcp's work + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + 1432 (Several resolutions fail for new mksurfdata_map) + 1424 (variables written out as gdir) + 1423 (Problem building clmtype on bluefire) + 1398 (clm and mksurfdata_map needs to check map files -- partial) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Correct and add new mapping datasets and datasets for mksurfdata_map + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): most + + scripts to scripts4_111108 + Machines to Machines_111101 + drv to drvseq4_0_08 + cism to cism1_111004 + csm_share to share3_111027 + timing to timing_111101 + MCT to MCT2_7_0-111101 + pio to pio1_3_12 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_scnv_ds - Add serial option + A models/lnd/clm/bld/namelist_files/checkmapfiles.ncl - check that map files + are consistent + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/input_tests_master - Add serial irrig test + + M models/lnd/clm/test/system/test_driver.sh ----- Fix issues on bluefire, + update some paths on edinburgh + +>>>>>>>>>>>>>> Update documentation + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/KnownBugs + +>>>>>>>>>>>>>> Get svn keywords set on tools, and make sure OPT is set + M models/lnd/clm/tools/mkmapdata/mvNimport.sh -------- Fix syntax error + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh -------- Add in 3x3 grid and ISRIC-WISE + mask, add option to build ocean-land mask, and large-file format option, + M models/lnd/clm/tools/interpinic/src/interpinic.F90 - Fix svn keywords + M models/lnd/clm/tools/interpinic/src/Makefile ------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkgriddata/src/Makefile ------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkdatadomain/src/Makefile ----- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkmapgrids/src/mkmapgrids.F90 - Add more meta-data + M models/lnd/clm/tools/mkmapgrids/src/Makefile-------- Set OPT CPP if OPT=TRUE + +>>>>>>>>>>>>>> Add call to domain_checksame to check if domains are the same, +>>>>>>>>>>>>>> split lake and wetland processing, add write statment for each file +>>>>>>>>>>>>>> opened, add -hires and -allownofile options to mksurfdata.pl + M models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 ---- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkvarctl.F90 ------- Split lake/wetland + M models/lnd/clm/tools/mksurfdata_map/src/mkvocefMod.F90 ----- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mklaiMod.F90 ------- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mksoilMod.F90 ------ Use domain_checksame + increase kmap_max_min from 50 to 90 (so T31 can be run) + M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 ---- Add domain_checksame, + make domain_init private, add metadata if frac/mask set, eliminate + lats/n,lone/w, use call abort in place of stop, + M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 ------ Split lake/wetland + remove documentation on specific datasets, increase allowed sum of special + landunits from 120 to 250 + M models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 -- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkharvestMod.F90 --- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 ------ Fix meta-data, + remove lats/n,lone/w + M models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 --- Add headers, more + checking, add gridmap_setptrs method private gridmap_checkifset method, + + M models/lnd/clm/tools/mksurfdata_map/src/mklanwatMod.F90 ---- Split mklanwat + into mklakwat/mkwetlnd subroutines, use domain_checksame, + M models/lnd/clm/tools/mksurfdata_map/src/Makefile ----------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 ------- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl ---------- Add -hires and + -allownofile options, split lake and wetland + + -allownofile Allow the script to run even if one of the input files + does NOT exist. + -hires If you want to use high-resolution input datasets rather than the default + lower resolution datasets (low resolution is typically at half-degree) + + M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt Use $CSMDATA + directory path rather than /cgd/tss path + M models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist Split lake and wetland + +>>>>>>>>>>>>>> Minor changes + M models/lnd/clm/bld/build-namelist --------- Move groups earlier, start adding + code to handle lnd_inst_counter + M models/lnd/clm/bld/listDefaultNamelist.pl - Get rcp list sooner + +>>>>>>>>>>>>>> Fix some filename typos, add new mapping files, add hi-res +>>>>>>>>>>>>>> datasets + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------ Add + ne4np4, ne16np4, ne60np4, ne240np4 mapping files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Correct + some typo's in filenames (ne4np4 scripgrid, ngwh mksurfdata pftdyn file + for rcp 6 for year 2006 + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add mksrf_filename, + correct mksrf_* filenames to mksrf_f*, add ISRIC-WISE lmask + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------- Only require + datm_data_dir for CPLHIST3HrWx + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add ISRIC-WISE, + 3x3min_MODIS mapping datasets, correct some map dataset names, + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Add more data + to output table + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Correct and + add new scrip grid files, add hires option for some data, add + mksrf_filename for types of files, add in all mksurfdata raw + datasets, add new hires datasets, correct mksrf_fvegtyp filenames, + +>>>>>>>>>>>>>> Remove initialization of unused data types (allows C13 on bluefire) +>>>>>>>>>>>>>> Add option to convert nan to fillvalue on output files +>>>>>>>>>>>>>> (and vica-versa on input) + M models/lnd/clm/src/main/clmtypeInitMod.F90 - Remove initialization of unused + data types + M models/lnd/clm/src/main/clm_atmlnd.F90 ----- Remove unused pdf variable + M models/lnd/clm/src/main/initSurfAlbMod.F90 - Remove unused CNZeroFluxes + M models/lnd/clm/src/main/ncdio_pio.F90 ------ Add cnvrtnan2fill option + to convert from spval to nan on read and from nan to spval on write + M models/lnd/clm/src/main/clmtype.F90 -------- Remove unused variables + M models/lnd/clm/src/main/histFldsMod.F90 ---- Add some documentation, change + longname of QSOIL, correct: CISUN, CISHA, ALPHAPSNSUN, ALPHAPSNSHA + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + + +Summary of testing: + + bluefire testing: +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 + bluefire interactive testing: All PASS except... +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +037 blAK8 TBL.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +067 bl5@4 TBLtools.sh gen_domain tools__ds namelist .............................................FAIL! rc= 7 +003 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +004 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +008 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +011 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +012 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +013 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +014 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +015 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +016 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (compare tests fail because clm4_0_37 file did not exist) + +CLM tag used for the baseline comparison tests if applicable: clm4_0_37 + +=============================================================== +=============================================================== +Tag name: clm4_0_37 +Originator(s): erik (Erik Kluzek) +Date: Mon Sep 26 10:35:24 MDT 2011 +One-line Summary: Fix unstructured grids history files + +Purpose of changes: + +Comment out code for writing out fine-mesh lat/lon for unstructured grids. This caused +the code to blow up when running for HOMME grids such as ne30np4. + +Bugs fixed (include bugzilla ID): + 1415 (History files can't be written out for HOMME grids) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1423 (Problem building clmtype on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/main/histFileMod.F90 - Comment out code for fine-mesh + lat/lon for unstructured grids + +Summary of testing: None! + +CLM tag used for the baseline comparison tests if applicable: clm4_0_36 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_36 +Originator(s): erik (Erik Kluzek) +Date: Thu Sep 22 11:05:59 MDT 2011 +One-line Summary: Comment out RTM mapping files for f09 and f19 + +Purpose of changes: + +Comment out the RTM mapping files for f09/f19 so answers are the same as clm4_0_34 and as the f19 mapping +files cause the fully coupled model to blow up in POP. Add "mv" option to mksurfdata.pl and make -nomv the +default so it doesn't try to copy files by default. Increase length of filename strings for mksurfdata pftdyn +files. Add some metadata for some restart file variables. Add "new good wood harvest" datasets +and option (-new_woodharv) to mksurfdata.pl from Peter Lawrence so can make surface +datasets with either set of files. New good wood harvest applies to rcp6 and rcp8.5. +Also add in some new mapping files for: 512x1024,128x256,64x128,32x64,8x16,0.23x0.31,5x5_amazon. +Add SCRIP grid files for: ne4np4,ne16np4, ne60np4, ne240np4. Add 3x3min resolution +and 3x3min SCRIP grid file which will be used for high resolution surface dataset +creation in the future. Use new surface datasets with old fatmgrid values for f09_g16 +for 1850 and 2000 so that answers can be identical to clm4_0_34 without requiring the +fatmgrid file. + +Bugs fixed (include bugzilla ID): + 1414 (Answers change @ f09 resolution w/o fatmgrid file) + 1413 (re is in incorrect units in mksurfdata_map) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1415 (History files can't be written out for HOMME grids) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Comment out RTM mapping files for f09/f19 + Also new mapping files for: 512x1024,128x256,64x128,32x64,8x16,0.23x0.31,5x5_amazon. + Add SCRIP grid files for: ne4np4,ne16np4, ne60np4, ne240np4. + Add 3x3min SCRIP grid file. + New surface datasets with old fatmgrid grid coordinate values for f09/1850/2000 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 -------------- Increase pftdyn file length to 135 + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 -------------- Increase nchar dim to 256 + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl ------------------ Add "mv" option with "nomv" the default + M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt - Increse length of strings for files + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add 3x3min, + ne4np4,ne16np4, ne60np4, ne240np4 as valid resolutions + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Comment out f09/f19 RTM mapping files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add new + good wood harvest pftdyn input files from Peter Lawrence for mksurfdata_map + for rcp6 and rcp8.5 + + M models/lnd/clm/src/biogeochem/CNrestMod.F90 --------- Add some FillValue to some fields for restart files + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 - Add some FillValue to some fields for restart files + +Summary of testing: + + bluefire interactive testing: Following PASS +001 sm754 TSMtools.sh mksurfdata_map tools__s namelist ..........................................PASS +003 sm953 TSMscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................PASS +005 sm954 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......PASS +007 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................PASS +008 bl9S4 TBLscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................PASS + bluefire/CESM testing: All PASS except (compare to clm4_0_34) +CFAIL ERS_E.T31_g37.I1850.bluefire.GC.125250 (ESMF doesn't work with NetCDF4) +BFAIL ERB.ne30_g16.I_1948-2004.bluefire.compare.clm4_0_34 (ne30 wasn't in clm4_0_34) (answers are identical to clm4_0_35) +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_34 (I1850SPINUPCN wasn't in clm4_0_34 or before) +FAIL NCK.f10_f10.I.bluefire -- scripts needs to cleannamelist after changing NINST_LND + bluefire extra CESM testing: Following PASS +PASS ERS.f09_g16.ICN.bluefire +PASS ERS.f09_g16.ICN.bluefire.generate.clm4_0_36 +PASS ERS.f09_g16.ICN.bluefire.compare_hist.clm4_0_33 +PASS ERS.f09_g16.ICN.bluefire.compare.clm4_0_33 +PASS ERS.f09_g16.I1850CN.bluefire +PASS ERS.f09_g16.I1850CN.bluefire.generate.clm4_0_36 +PASS ERS.f09_g16.I1850CN.bluefire.compare_hist.clm4_0_33 +PASS ERS.f09_g16.I1850CN.bluefire.compare.clm4_0_33 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_35 + +Changes answers relative to baseline: f09/f19 now same as clm4_0_34 + +=============================================================== +=============================================================== +Tag name: clm4_0_35 +Originator(s): erik (Erik Kluzek), mvertens +Date: Tue Sep 13 22:15:17 MDT 2011 +One-line Summary: Bring in Mariana's non2D grid branch to trunk, enabling HOMME grids: ne30np4/ne120np4 + +Purpose of changes: + +Move Mariana's new non-2D branch to trunk. Extensive changes to mksurfdata, allows 1D-vector surface +datasets. Mariana change mksurfdata to add unstructured grid format using SCRIP weights. Won't work +with PTCLM and mksurfdata won't be able to create single-pt/regional surface datasets. Fix reverse +coordinates on VOC/irrig mksurfdata input file. Update scripts and datm with HOMME grids. Add in +half-degree pftdyn historical dataset. Partial fix to PTSMODE restart problem. Fix the US-UMB data for PTCLM. + +NOTE: File creation process is changed substantially! mksurfdata now requires mapping files to be created first + in order to run the new mksurfdata_map. This means you need to do the following: + + 1.) run mkgriddata + 2.) run mkmapgrid (add files to XML database) (requires 1) + 3.) run mkmapdata (add files to XML database) (requires 2) + 4.) run mksurfdata_map (requires 3) + 5.) run gen_domain (requires 3 needed for datm) + + See the models/lnd/clm/tools/README file for more help on the process. + +WARNING: YOU CAN'T CREATE SINGLE-POINT DATASETS WITH THIS VERSION! You can create frac/grid files with this + version and then use an older verison of clm to use mksurfdata to create surface datasets. The mapping + for single-point datasets using ESMF does NOT work -- although it does work if you have at least 4 points + so you can create regional datasets. + + THIS MEANS PTCLM DOES NOT WORK FOR CREATING NEW DATASETS! It will work for datasets already created however. + +CAUTION: Mapping files to allow mksurfdata to work are only provided for: f09, f19, f10, T31, f45, f25, ne30 and ne120 + +Bugs fixed (include bugzilla ID): + 1392 (US-UMB site has some incorrect data) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1413 (re is in incorrect units in mksurfdata_map) + 1414 (Answers change @ f09 resolution w/o fatmgrid file) + 1415 (History files can't be written out for HOMME grids) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Can now read in domain files in place of fatmlndfrac + fatmgrid no longer required (use fsurdat to get grid) + fmapinp_rtm new namelist item to give mapping for RTM + +List any changes to the defaults for the boundary datasets: + + Add: ne30np4/ne120np4 datasets, add 1850-2000 0.47x0.63 fpftdyn file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens, sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm + + scripts to scripts4_110906 + csm_share to share3_110906 + datm to datm8_110908 + +List all files eliminated: + +>>>>>>>>>>>> Rename mksurfdata to mksurfdata_map + D models/lnd/clm/tools/mksurfdata/* + +>>>>>>>>>>>> Move source code to src subdirectory + D models/lnd/clm/tools/mkdatadomain/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + D models/lnd/clm/tools/mkgriddata/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + D models/lnd/clm/tools/interpinic/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + +List all files added and what they do: + +>>>>>>>>>>>> Rename mksurfdata to mksurfdata_map, create src sub-directory + A models/lnd/clm/tools/mksurfdata_map + A models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl + A models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist + A models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt + A models/lnd/clm/tools/mksurfdata_map/README + A models/lnd/clm/tools/mksurfdata_map/src + A models/lnd/clm/tools/mksurfdata_map/src/clm_varctl.F90 + A models/lnd/clm/tools/mksurfdata_map/src/clm_varpar.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Filepath + A models/lnd/clm/tools/mksurfdata_map/src/fileutils.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Macros.custom + A models/lnd/clm/tools/mksurfdata_map/src/Makefile + A models/lnd/clm/tools/mksurfdata_map/src/Mkdepends + A models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkharvestMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mklaiMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mklanwatMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mksoilMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvarctl.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvarpar.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvocefMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/nanMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_const_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_file_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_log_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_string_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_sys_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_timer_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Srcfiles + +>>>>>>>>>>>> Scripts to use ESMF to create SCRIP mapping files from SCRIP grid files + A models/lnd/clm/tools/mkmapdata + A models/lnd/clm/tools/mkmapdata/mkmapdata.sh + A models/lnd/clm/tools/mkmapdata/mvNimport.sh + A models/lnd/clm/tools/mkmapdata/README + A models/lnd/clm/tools/mkmapdata/regridbatch.sh + A models/lnd/clm/tools/mkmapdata/rmdups.ncl ----- NCL script to remove duplicates + +>>>>>>>>>>>> Program to create SCRIP grid files from CLM grid/frac files + A models/lnd/clm/tools/mkmapgrids + A models/lnd/clm/tools/mkmapgrids/mkmapgrids.csh + A models/lnd/clm/tools/mkmapgrids/mkmapgrids.namelist + A models/lnd/clm/tools/mkmapgrids/README + A models/lnd/clm/tools/mkmapgrids/src + A models/lnd/clm/tools/mkmapgrids/src/domainMod.F90 + A models/lnd/clm/tools/mkmapgrids/src/Filepath + A models/lnd/clm/tools/mkmapgrids/src/Macros.custom + A models/lnd/clm/tools/mkmapgrids/src/Makefile + A models/lnd/clm/tools/mkmapgrids/src/Mkdepends + A models/lnd/clm/tools/mkmapgrids/src/mkmapgrids.F90 + A models/lnd/clm/tools/mkmapgrids/src/nanMod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_log_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_sys_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/Srcfiles + +>>>>>>>>>>>> Programs to postprocess 1D vector unstructured grids + A models/lnd/clm/tools/mkprocdata_map + A models/lnd/clm/tools/mkprocdata_map/camhomme + A models/lnd/clm/tools/mkprocdata_map/camhomme/mkprocdata_map_in + A models/lnd/clm/tools/mkprocdata_map/camhomme/src + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Depends + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/domainMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Filepath + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/fileutils.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/gridmapMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Makefile + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/mkprocdata_map.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/nanMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Srcfiles + A models/lnd/clm/tools/mkprocdata_map/clm + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_all + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_in + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_wrap + A models/lnd/clm/tools/mkprocdata_map/clm/README + A models/lnd/clm/tools/mkprocdata_map/clm/src + A models/lnd/clm/tools/mkprocdata_map/clm/src/constMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Filepath + A models/lnd/clm/tools/mkprocdata_map/clm/src/fileutils.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/fmain.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/gridmapMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Makefile + A models/lnd/clm/tools/mkprocdata_map/clm/src/Mkdepends + A models/lnd/clm/tools/mkprocdata_map/clm/src/mkprocdata_map.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/nanMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Srcfiles + +>>>>>>>>>>>> Make macros files to customize how tools operate (allows all tools to have an identical Makefile) + A models/lnd/clm/tools/interpinic/src/Macros.custom + A models/lnd/clm/tools/mkgridata/src/Macros.custom + A models/lnd/clm/tools/mkdomaindata/src/Macros.custom + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add tests for new grids/tools + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/README.testnames --------------- 4/5=mkmapgrids/gen_domain config + I=CN spinup, @=ne120np4, #=ne30np4, *=ne16np4 run options + +>>>>>>>>>>>> Change build/run for tools, update netcdf on bluefire, update modules on jaguar, add new tests + M models/lnd/clm/test/system/TCB.sh ------------- Remove setting of MACFILE not needed + M models/lnd/clm/test/system/TCBtools.sh -------- Add src directory, Mkdepends, Macros.custom + M models/lnd/clm/test/system/TBLscript_tools.sh - Set CLM_ROOT + M models/lnd/clm/test/system/TBLtools.sh -------- Set CLM_ROOT + M models/lnd/clm/test/system/TBL.sh ------------- Allow compile-only mode to work + M models/lnd/clm/test/system/TSM.sh ------------- Handle multi-instance rpointer files + M models/lnd/clm/test/system/test_driver.sh -- Get netcdf4.1.3 working on bluefire, get mirage build working, + use glade paths, add ESMFBIN_PATH, update jaguar modules + M models/lnd/clm/test/system/input_tests_master - Fill out HM tests, add H#, H@, blJ07, 454, 5@4, 9#2, 953 + tests, mksurfdata=>mksurfdata_map + M models/lnd/clm/test/system/nl_files/clm_spin -- Change case to agree with 1850 MOAR case in CESM scripts + M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 ------------ Remove -nomv option + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 ----- Remove -nomv option + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 - Remove -nomv option + +>>>>>>>>>>>> Run interpinic and checkin the result + M models/lnd/clm/tools/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + +>>>>>>>>>>>> Update to glade path, add notes on src subdirectory + M models/lnd/clm/tools/interpinic/README ------------------ Add notes about src subdirectory + M models/lnd/clm/tools/mkgriddata/mkgriddata.namelist ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.regional ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.singlept ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.cesm_dom ----- Use glade path + M models/lnd/clm/tools/mkgriddata/README ------------------ Update with added src sub-directory + M models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist - Use glade path + M models/lnd/clm/tools/mkdatadomain/README ---------------- Add notes about src subdirectory + +>>>>>>>>>>>> Update tools README information + M models/lnd/clm/tools/README.testing ------ Note about src subdirectory required + M models/lnd/clm/tools/README -------------- Updated with notes on new process + M models/lnd/clm/tools/README.filecopies --- Notes on list of file copies has changed + +>>>>>>>>>>>> Changes to tools source codes moved to src subdirectories, Makefile was standardized +>>>>>>>>>>>> update shr_sys_mod.F90 file to latest csm_share + M models/lnd/clm/tools/interpinic/src/interpinic.F90 --- Add metadata on OPT and OMP + M models/lnd/clm/tools/interpinic/src/Makefile --------- Standardize + M models/lnd/clm/tools/interpinic/src/shr_sys_mod.F90 -- Update + M models/lnd/clm/tools/mkdatadomain/src/Makefile ------- Standardize + M models/lnd/clm/tools/mkdatadomain/src/Filepath ------- Only use local directory + M models/lnd/clm/tools/mkgriddata/src/Makefile --------- Standardize + M models/lnd/clm/tools/mkgriddata/src/shr_sys_mod.F90 -- Update + M models/lnd/clm/tools/mkgriddata/src/clm_varctl.F90 --- Update + +>>>>>>>>>>>> Add RTM mapping file, change some namelist file required logic + M models/lnd/clm/bld/listDefaultNamelist.pl - Also get RTM mapping file, and use $CSMDATA if set + M models/lnd/clm/bld/build-namelist --------- If can't find a frac file use the datm domain file, only + get fatmgrid file for fine-mesh, if RTM on get mapping file, if fine-mesh on and fatmgrid not found + use fsurdat file + M models/lnd/clm/bld/clm.cpl7.template ------ Clarify documentation for CLM_RTM_RES + +>>>>>>>>>>>> Add new files needed for ne30np4/ne120np4 and processing of them + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl --------- Add test for more resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add: fmapinp_rtm, scripgriddata, mksrf_fglctopo, + map, lmask, hgrid + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Add: ne30np4/ne120np4 datasets, add + 1850-2000 0.47x0.63 fpftdyn file, remove some of the single-point fatmlndgrd files, add mapping files, + add lmask/hgrid for different map types + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add ne30np4/ne120np4 domain files + +>>>>>>>>>>>> Use llatlon structure in place of lsmlat/lsmlon, required files a bit different, use fsurdat if +>>>>>>>>>>>> fatmgrid is not given, add RTM mapping file, if fatmlndfrc NOT set set mask/frac to 1. + M models/lnd/clm/src/biogeochem/CASAMod.F90 ------------ Use llatlon%ni/nj in place of lsmlon/lat + don't allow 1D grids for CASA + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------------ Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ---------- asca => ascale + M models/lnd/clm/src/main/organicFileMod.F90 ----------- Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/main/clm_varpar.F90 --------------- Remove lsmlon/lsmlat parameters + M models/lnd/clm/src/main/clm_timemanager.F90 ---------- Add some meta-data to restart file, check restart values + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Remove cellarea, surfrd gets area + M models/lnd/clm/src/main/fileutils.F90 ---------------- Make iflag required argument + M models/lnd/clm/src/main/ndepStreamMod.F90 ------------ Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/main/iniTimeConst.F90 ------------- Remove start/count lsmlon/lsmlat + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add namea grid, replace lsmlon/lat with llatlon + handle unstructured grids + M models/lnd/clm/src/main/controlMod.F90 --------------- If fatmgrid NOT set, use fsurdat, add fmapinp_rtm + if fatmlndfrc NOT set, set mask/frac to 1. + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Add fmapinp_rtm + M models/lnd/clm/src/main/ncdio_pio.F90 ---------------- Add ncd_inqfdims, io_type public, clmlevel set + earlier, remove switchdim from ncd_io_int_var2, handle switchdim in ncd_io_real_var2 read for + singlept + M models/lnd/clm/src/main/surfrdMod.F90 ---------------- Remove surfrd, add surfrd_get_data hande 1D grids + M models/lnd/clm/src/main/domainMod.F90 ---------------- asca=>ascale + M models/lnd/clm/src/main/decompMod.F90 ---------------- Add namea remove get_clmlevel_dsize + M models/lnd/clm/src/main/clmtype.F90 ------------------ Increase len=8 to len=16 + M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Add L2R_Decomp, remove lsmlat/lon for llatlon + remove river meta-data + M models/lnd/clm/src/riverroute/RtmMapMod.F90 ---------- Pass in fracout + M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ------ Use llatlon in place of lsmlat/lon + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 -------- asca=>ascale + +Summary of testing: + + bluefire: All PASS except... +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 + bluefire interactive testing: All PASS except... +009 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 5 +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +037 blAK8 TBL.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +051 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 +004 blS63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +005 smQQ4 TSM.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 4 +006 erQQ4 TER.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -3+-7 cold ............FAIL! rc= 5 +007 brQQ4 TBR.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -5+-5 cold ............FAIL! rc= 5 +008 blQQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 4 +012 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +014 bl454 TBLtools.sh mkmapgrids tools__ds namelist .............................................FAIL! rc= 5 +016 bl5@4 TBLtools.sh gen_domain tools__ds namelist .............................................FAIL! rc= 5 +024 bl754 TBLtools.sh mksurfdata_map tools__s namelist ..........................................FAIL! rc= 5 +025 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +026 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +033 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +037 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 5 +039 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +043 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +045 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +047 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare_hist.clm4_0_34 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare.clm4_0_34 +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare_hist.clm4_0_34 +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare.clm4_0_34 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_34 +BFAIL ERB.ne30_g16.I_1948-2004.bluefire.compare.clm4_0_34 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_34 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_34 + bluefire/PTCLM testing: All PASS + lynx/pgi testing: All FAIL (build issues) + lynx/pgi interactive testing: All PASS except... +010 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 7 +011 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 6 + lynx/CESM extra testing: ... +PASS ERS.ne30_g16.I1850CN.lynx_gnu +PASS ERS.ne30_g16.I1850CN.lynx_intel +PASS ERS.ne30_g16.I1850CN.lynx_pathscale + jaguarpf: All FAIL (system build issue) + jaguarpf interactive testing: All PASS up to... +14 PTCLM.16750_US-UMB_ICN_exit_spinup.PTCLM PASS + jaguarpf/CESM testing: All PASS except... +FAIL PST.f09_g16.I.jaguarpf +FAIL ERI_D.ne30_g16.I1850CN.jaguarpf +TFAIL ERH.ne120_g16.I2000CN.jaguarpf.G.235924 + jaguarpf/CESM additional testing: ... +FAIL ERH.ne120_g16.ICN.jaguarpf +PASS SMS.ne120_g16.I.jaguarpf +FAIL ERS.ne120_g16.I.jaguarpf + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 7 +007 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 6 +008 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 +025 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +026 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +027 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + edinburgh/CESM testing: ... +PASS ERS.ne30_g16.I1850CN.edinburgh_pgi +PASS ERS.ne30_g16.I1850CN.edinburgh_lahey + edinburgh/PTCLM testing: All PASS up to... +14 PTCLM.30770_US-UMB_ICN_exit_spinup.PTCLM PASS + mirage,storm/ifort interactive testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_34 + +Changes answers relative to baseline: + + f09_gx1v6, f19_gx1v6 are similar climate but different because of new RTM mapping files + +=============================================================== +=============================================================== +Tag name: clm4_0_34 +Originator(s): erik (Erik Kluzek) +Date: Thu Aug 18 13:14:01 MDT 2011 +One-line Summary: Bring tcens branch to trunk, fix a few issues + +Purpose of changes: + +Remove -pftlc to mksurfdata.pl. Correct units of H2OSNOTOP, HC, and HCSOI history fields. +Remove fget_archdev. Fix single point restarts from Brenden Rogers (although now there +is a PIO issue). Fix pio error when clm is running at same grid as RTM from Mariana. +Move Tony's "tcens" DART ensemble branch to trunk. Add save statement to ncdio. Have +chkdatmfiles.ncl check both grid and frac files. +Update pio/MCT/scripts/datm/PTCLM/csm_share. + +Bugs fixed (include bugzilla ID): + 1383 (Remove no-VOC and MAXPFT=4 tests) + 1381 (Can't change monthly average files to NOT be one per month) + 1372 (pio problem writing out RTM hist fields at RTM res) + 1361 (Problem with transient compsets for PTCLM) + 1358 (incorrect units for a few history fields) + 1025 (SCM mode can NOT use a global finidat file) (partial) + 1017 (SCM mode can NOT restart) (partial) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1392 (US-UMB site has some incorrect data) + 1393 (error when running Gregorian calendar) + 1396 (pio problem reading 2D data with 1st dim=1) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: + Add -ninst_lnd for multiple ensembles of CLM for data assimulation to configure. + Build pio and mct as seperate libraries (add -mct_dir/pio_dir to configure). + + Set multiple instances with NINST_LND env variable in env_mach_pes.xml + (make sure NTASKS_LND is >= NINST_LND) + +Describe any changes made to the namelist: + Remove fget_archdev option (don't try to get input files from archival device). + + Set multiple instances of namelists by creating a "user_nl_clm" directory + + Inside of the directory place + + user_nl_clm ---- namelist changes to make for ALL instances + user_nl_clm_1 -- namelist changes for first instance + user_nl_clm_2 -- namelist changes for first instance + user_nl_clm_3 -- namelist changes for third instance +. +. +. + + build-namelist will create a namelist for each instance of the model being run. + +List any changes to the defaults for the boundary datasets: domain files updated + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + scripts to scripts4_110812 + drv to drvseq4_0_04 + datm to datm8_110811 + csm_share to share3_110803 + mct to MCT2_7_0_110804a + pio to pio1_3_9 + +List all files eliminated: + +>>>>>>>>>> Delete some 4p and non-VOC tests to reduce testing + D models/lnd/clm/test/system/config_files/4p_vorsc_dm + D models/lnd/clm/test/system/config_files/17p_scnv_dm + D models/lnd/clm/test/system/config_files/4p_vorsc_do + D models/lnd/clm/test/system/config_files/17p_scnv_do + D models/lnd/clm/test/system/config_files/_scnv_dh + D models/lnd/clm/test/system/config_files/4p_vorsc_ds + D models/lnd/clm/test/system/config_files/17p_scnv_ds + D models/lnd/clm/test/system/config_files/_scnv_dm + D models/lnd/clm/test/system/config_files/_scnv_do + D models/lnd/clm/test/system/config_files/17p_scnv_m + D models/lnd/clm/test/system/config_files/17p_scnv_o + D models/lnd/clm/test/system/config_files/17p_scnv_s + D models/lnd/clm/test/system/config_files/4p_vorsc_h + D models/lnd/clm/test/system/config_files/4p_vorsc_o + D models/lnd/clm/test/system/config_files/17p_nrscnv_ds + D models/lnd/clm/test/system/config_files/4p_vonrsc_ds + D models/lnd/clm/test/system/config_files/4p_vorsc_dh + D models/lnd/clm/test/system/config_files/17p_scnv_dh + +List all files added and what they do: + +>>>>>>>>>> Add tests for multi-instance + A models/lnd/clm/test/system/config_files/_nrnil3sc_dh + A models/lnd/clm/test/system/config_files/_nrnil3sc_dm + A models/lnd/clm/test/system/config_files/_nil3sc_dh + A models/lnd/clm/test/system/config_files/_nil3sc_dm + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_1 + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_2 + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_3 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Remove old tests add new multi-instance tests in + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>> Handle clm* for multi-instance files, remove PFTDATA + M models/lnd/clm/test/system/TCB.sh -- Set pio/mct_dir in configure, send MACFILE + to make, and create clm exec temp for debug mode + M models/lnd/clm/test/system/TBL.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TBR.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TER.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMrst_tools.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMpergro.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMscript_tools.sh -- Remove PFTDATA setting + M models/lnd/clm/test/system/TSM.sh - compare clm* for multi-instance, cat lnd_in_000? files + M models/lnd/clm/test/system/input_tests_master -- add new multi_inst tests remove old + M models/lnd/clm/test/system/mknamelist - add quotes + M models/lnd/clm/test/system/README - Remove storm + M models/lnd/clm/test/system/README.testnames -- Add nil tests remove some 4p no-voc + M models/lnd/clm/test/system/TBLrst_tools.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/CLM_runcmnd.sh - remove storm + M models/lnd/clm/test/system/test_driver.sh -- use glade paths, add mct/pio_dir + add gres setting on jaguarpf, remove PFTDATA, remove storm, update cprnc on lynx + M models/lnd/clm/test/system/config_files/README - add nil3 config + change x resolution from T31 to f19 (no datasets at T31 for glc) + +>>>>>>>>>> Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 --------- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 --- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 -- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 -------- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 -- Remove PFTDATA + +>>>>>>>>>> Remove PFTDATA and -p option, add -nobreak to cprnc.pl, print out more info + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - Remove PFTDATA + M models/lnd/clm/tools/ncl_scripts/cprnc.pl ----- Add -nobreak + M models/lnd/clm/tools/ncl_scripts/cprnc.ncl ----- Add BREAKONDIFF, print avg/max diffs + +>>>>>>>>>> Add NINST_LND and build with new MCT/PIO where need mct_pio_dir +>>>>>>>>>> Handle user_nl_clm directory for multi-instance + M models/lnd/clm/bld/configure - Add ninst_lnd/mct_dir/pio_dir options + change to work with new MCT/PIO + M models/lnd/clm/bld/config_files/config_definition.xml - add mct_dir/pio_dir/ninst_lnd/ninst_atm + M models/lnd/clm/bld/build-namelist - Add ability to write out multiple ensemble + namelist files, handle multiple infiles, and infile directories for multiple + ensembles + M models/lnd/clm/bld/clm.cpl7.template - handle NINST_LND add user_nl_clm directory + for multiple ensembles + +>>>>>>>>>> Compare grid/frac files, update domain files for datm, handle multiple infiles + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl - compare grid/frac files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Add glc_pio stuff + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - New f45, f10, f09, + f19, T31 domain files + M models/lnd/clm/bld/namelist_files/datm-build-namelist - Be able to handle multiple + infiles + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Add glc_pio settings + +>>>>>>>>>> Handle multi-instance SPMD and files, remove fget_archdev, fix problem +>>>>>>>>>> of running on RTM grid (mvertens), handle scam restart files (still fails +>>>>>>>>>> because of PIO problem) + M models/lnd/clm/src/biogeochem/CNDVMod.F90 - Add inst_suffix to hv files + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 - Handle multiple instances and + multiple instances lnd_in and lnd_modelio.nml namelist files + M models/lnd/clm/src/main/fileutils.F90 -- Remove set_filename and putfil, simplify + getfil to NOT do archival retreival + M models/lnd/clm/src/main/ndepStreamMod.F90 - Handle multi-instances + M models/lnd/clm/src/main/histFileMod.F90 --- Pass mfilt to set_hist_filename, don't + require mfilt to be one if nhtfrq=0, only use monthly form of filenames if + nhtfrq=0 AND mfilt=1 + M models/lnd/clm/src/main/restFileMod.F90 - Handle multi-instance files + M models/lnd/clm/src/main/controlMod.F90 -- Remove fget_archdev + M models/lnd/clm/src/main/clm_varctl.F90 -- Remove fget_archdev, add inst_* vars + M models/lnd/clm/src/main/ncdio_pio.F90 --- Fix problem of running on RTM grid, handle + multi-instance files, pass vardesc to scam_field_offsets, handle landunit + in scam_field_offsets, start/count set for all dims, check that dimension + sizes and names are equal in order to share iodesc + M models/lnd/clm/src/main/spmdMod.F90 ---- spmd_init has LNDID passed in + M models/lnd/clm/src/main/histFldsMod.F90 - Fix units/long_names + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - Handle multi-instances and + multiple instances lnd_in and lnd_modelio.nml namelist files + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- Get LNDID + +Summary of testing: + + bluefire: All PASS except TBL tests and... +>>>>>>> rpointer.lnd_* files empty +017 erX51 TER.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -3+-2 cold ..............FAIL! rc= 7 +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +>>>>>>> Build fails +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +>>>>>>> Build fails +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +>>>>>>> Build fails +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 + bluefire interactive testing: All PASS except... (pio bug 1396) +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERS_RLA.f45_f45.I.bluefire -- pio bug 1396 +>>>>>>> Compare fails because of new domain files/new pftdyn +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_33 +BFAIL ERS_RLA.f45_f45.I.bluefire.generate.clm4_0_34 +BFAIL ERS_RLA.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare_hist.clm4_0_33 -- only glc map area? +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare_hist.clm4_0_33 ---- only glc map area? +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_33 +FAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_33 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_33 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare_hist.clm4_0_33 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_33 + bluefire/PTCLM testing: All PASS + jaguarpf interactive testing: All PASS except... +014 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +015 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS, except TBL and... (pio bug 1396) +006 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +007 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 + mirage,storm/ifort interactive testing: All fail -- problem with pio build + yong/ifort interactive testing: All fail -- problem with pio build + +CLM tag used for the baseline comparison tests if applicable: clm4_0_33 + +Changes answers relative to baseline: No bit-for-bit, except: + + f10_f10, f45_f45, f09_f09, f19_f19, T31_T31, with new domain files + +=============================================================== +=============================================================== +Tag name: clm4_0_33 +Originator(s): erik (Erik Kluzek) +Date: Mon Jul 25 14:34:18 MDT 2011 +One-line Summary: Move changes on release branch over to trunk + +Purpose of changes: + +Move changes from release branch over to trunk. Update README files and documentation. +Add new tools testing. Use if masterproc and iulog for output. Move pft mksurfdata into +inputdata. rh files are t-1. All clm tools namelist items in XML database. Fix tools +Makefiles. Survey testlists, move tests around. Remove clm* from path, add quotes in test +scripts, remove CLM_CESMBLD. Remove getfil in mksurfdata, make fdynuse optional. Add +-nomv to getregional. Cleanup help and improve documentation in scripts and XML database. +Update datm8/scripts/drv/cism/csm_share. Update pergro data. Changes answers because of +drv update to cesm1_0_beta22 version (answers are identical to cesm1_0_beta22). + +Bugs fixed (include bugzilla ID): + 1301 (Add doc on OpenMP fortran tools) + 1329 (Add new tool tests) + 1338 (Move raw pftdata into inputdata in XML database) + 1341 (Error running with crop for a single-point) + 1346 (save history namelist to the rh0 files NOT rh1) + 1351 (Add all CLM tools namelist items to XML) + 1351 (Problem with interpinic on non bluefire machines) + 1353 (Huge "ccsm.log" file) + 1367 (final_spinup stop time isn't right) +data) +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1358 (incorrect units for a few history fields) + 1360 (Can't do a ncdump on US-UMB data) + 1361 (Problem with transient compsets for PTCLM) + 1372 (pio problem writing out RTM hist fields at RTM res) + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1355 (tlai is zero for first two time-steps in CLMSP) + 1326 (Crop and irrigation sims give balance check error) + 1310 (Restart files different over different tasks) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts/drv/shr/cism/datm + scripts to scripts4_110711 + drv to drvseq3_1_54 + datm to datm8_110624 + csm_share to share3_110717 + cism to cism1_110418 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>> Add new tests for tools + A models/lnd/clm/test/system/TOPtools.sh ------- Ensure different number of threads + give the same answers for tools + A models/lnd/clm/test/system/TBLscript_tools.sh Comparison test for script tools + A models/lnd/clm/test/system/TBLrst_tools.sh --- Comparison test for rst_tools + A models/lnd/clm/test/system/config_files/tools__do ---- Add OpenMP debug config + A models/lnd/clm/test/system/config_files/17p_nrscnv_ds Add non-RTM debug serial CN + +>>>>>>>>>>> Make copies of existing files to inside of +>>>>>>>>>>> individual tools so that tools can be standalone + A models/lnd/clm/tools/mksurfdata/clm_varpar.F90 + A models/lnd/clm/tools/mksurfdata/shr_file_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_timer_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_log_mod.F90 + A models/lnd/clm/tools/mksurfdata/fileutils.F90 + A models/lnd/clm/tools/mksurfdata/shr_const_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_string_mod.F90 + A models/lnd/clm/tools/mksurfdata/clm_varctl.F90 + A models/lnd/clm/tools/mksurfdata/shr_sys_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_kind_mod.F90 + A models/lnd/clm/tools/mksurfdata/nanMod.F90 + A models/lnd/clm/tools/mksurfdata/Mkdepends + A models/lnd/clm/tools/mksurfdata/clm_varpar.F90 + A models/lnd/clm/tools/mkgriddata/mkvarpar.F90 + A models/lnd/clm/tools/mkgriddata/clm_varctl.F90 + A models/lnd/clm/tools/mkgriddata/clm_varpar.F90 + A models/lnd/clm/tools/mkgriddata/shr_sys_mod.F90 + A models/lnd/clm/tools/mkgriddata/shr_log_mod.F90 + A models/lnd/clm/tools/mkgriddata/ncdio.F90 + A models/lnd/clm/tools/mkgriddata/shr_kind_mod.F90 + A models/lnd/clm/tools/mkgriddata/shr_const_mod.F90 + A models/lnd/clm/tools/mkgriddata/domainMod.F90 + A models/lnd/clm/tools/mkgriddata/areaMod.F90 + A models/lnd/clm/tools/mkgriddata/nanMod.F90 + A models/lnd/clm/tools/mkgriddata/Mkdepends + A models/lnd/clm/tools/mkdatadomain/Mkdepends + A models/lnd/clm/tools/mkdatadomain/shr_kind_mod.F90 + A models/lnd/clm/tools/mkdatadomain/shr_const_mod.F90 + +>>>>>>>>>>> Add new README files to talk about testing and file copies + A models/lnd/clm/tools/README.testing + A models/lnd/clm/tools/README.filecopies + +>>>>>>>>>>> Add a new chapter for PTCLM + A models/lnd/clm/doc/UsersGuide/ptclm.xml + +List all existing files that have been modified, and describe the changes: + + +>>>>>>>>>>> Remove CLM_CESMBLD, remove clm* in pathname, add quotes in tests +>>>>>>>>>>> fix some spelling and unused vars, add new scripts tests +M models/lnd/clm/test/system/TCB.sh -------------- Remove CLM_CESMBLD +M models/lnd/clm/test/system/TSMncl_tools.sh ----- Remove clm* in pathname +M models/lnd/clm/test/system/TBL.sh -------------- Remove clm* in pathname +M models/lnd/clm/test/system/README.testnames ---- Update for new tests +M models/lnd/clm/test/system/TBR.sh -------------- Remove unused cfgdir +M models/lnd/clm/test/system/TCBtools.sh --------- Remove clm* in pathname, fix spelling +M models/lnd/clm/test/system/TER.sh -------------- Remove unused cfgdir +M models/lnd/clm/test/system/test_driver.sh ------ Remove CLM_CESMBLD, change temp on lynx +M models/lnd/clm/test/system/TSMrst_tools.sh ----- Remove unused cfgdir, add quotes + in comparison +M models/lnd/clm/test/system/nl_files/getregional - Add -nomv option in +M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 - Put -exedir last +M models/lnd/clm/test/system/input_tests_master --- Add TBLtools, TOPtools, + TBLrst_tools, TBLscript_tools tests in +M models/lnd/clm/test/system/TSMtools.sh ---------- Add CLM_RERUN (needed for + TOPtools which runs the same test over for different threads) + Remove clm* from path add quotes to some if tests +M models/lnd/clm/test/system/TBLtools.sh ---------- Remove clm* from path + +>>>>>>>>>>> Move tests around a bit +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi - Add TOP test +M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>> Make fdynuse file optional and remove use of getfil +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 ---- Remove fdynuse file, + remove use of getfil, all averaging is the same (no *_pft options) +M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 --- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/creategridMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 - Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkvocefMod.F90 -- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkglacierMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/areaMod.F90 ----- Remove _pft methods +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Make mksrf_fdynuse optional + remove use of getfil +M models/lnd/clm/tools/mksurfdata/mklanwatMod.F90 - Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ---- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt -- new paths + +>>>>>>>>>>> Updated RMS differences, and add -nomv option to getregional_datasets +M models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat ---------- Updated RMS differences +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add -nomv option +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Add NOMV env var + +>>>>>>>>>>> Fix bug 1351 +M models/lnd/clm/tools/interpinic/interpinic.F90 -------- Make sure: htop_var, + fpcgrid_var, present_var, itypveg_var are set +M models/lnd/clm/tools/interpinic/interpinic.runoptions - Update the input file to use + +>>>>>>>>>>> Work on formatting, remove use of getfils +M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 - Work on formatting a bit, + removed use of fileutils +M models/lnd/clm/tools/mkgriddata/areaMod.F90 ---- Remove use of getfil +M models/lnd/clm/tools/mkdatadomain/create_domain.F90 - Work on output write + +>>>>>>>>>>> Update documentation in README files +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/bld/namelist_files/use_cases/README +M models/lnd/clm/test/system/README +M models/lnd/clm/tools/mkgriddata/README +M models/lnd/clm/tools/mkdatadomain/README +M models/lnd/clm/tools/interpinic/README +M models/lnd/clm/tools/README.testing +M models/lnd/clm/tools/README +M models/lnd/clm/bld/README + +>>>>>>>>>>> Sync up tools Makefile, make Filepath standalone (only includes .) +>>>>>>>>>>> Work on formatting, set OPT default, add TOOLROOT default +>>>>>>>>>>> compare to null instead of strip +M models/lnd/clm/tools/mksurfdata/Makefile +M models/lnd/clm/tools/mksurfdata/Filepath +M models/lnd/clm/tools/mksurfdata/Srcfiles - Remove spmdMod,fileutils, + abortutils/shr_cal_mod, ESMF, mpi, shr_mpi_mod +M models/lnd/clm/tools/interpinic/Makefile +M models/lnd/clm/tools/mkgriddata/Filepath +M models/lnd/clm/tools/mkgriddata/Srcfiles - Remove fileutils,spmdMod, + abortutils,shr_timer_mod,shr_mpi_mod,shr_file_mod,MPI +M models/lnd/clm/tools/mkgriddata/Makefile +M models/lnd/clm/tools/mkdatadomain/Filepath +M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>> Cleanup help and documentation +M models/lnd/clm/bld/configure --------------- Cleanup help, remove cesm_bld +M models/lnd/clm/bld/queryDefaultNamelist.pl - Cleanup help +M models/lnd/clm/bld/listDefaultNamelist.pl -- Add more description, documentation + set maxpft for crop +M models/lnd/clm/bld/build-namelist ---------- Cleanup help, add papi_inparm + remove some list options for non-CLM vars +M models/lnd/clm/bld/clm.cpl7.template ------- Remove clm* in path + remove warning about CAM and CLM dtime, remove comment about *.h files + +>>>>>>>>>>> Make sure all 1x1 files are in supported single-point res +M models/lnd/clm/bld/config_files/config_definition.xsl - Add CLM in descriptions +M models/lnd/clm/bld/config_files/config_definition.xml - Add + 1x1_numaIA,1x1_smallvilleIA to supported single-point resolutions + cleanup spelling and a few descriptions + +>>>>>>>>>>> Work on documentation descriptions, document all tools namelist items +M models/lnd/clm/bld/namelist_files/checklatsfiles.ncl --------- Add doc, continue + if file NOT found rather than abort +M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl --------- Add doc, continue + if file NOT found rather than abort +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Work on descriptions, + add in all mksurfdata/mkdatadomain/mkgriddata namelist vars, add in + new driver namelist vars (so documented in table in UG), + add HCN,CH3CN to drydep +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add datasource + small formatting change +M namelist_files/namelist_defaults_drv.xml --------------------- Fix final_spinup + (bug 1367) +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ------ Add attributes + to output for: crop, irrig, ad_spinup, and source +M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ---- Work to improve + output formatting of table +M models/lnd/clm/bld/namelist_files/datm-build-namelist -------- Cleanup help / source +M models/lnd/clm/bld/namelist_files/checktopofiles.ncl --------- Change res list, + add documentation, continue rather than abort if file not found +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Update paths + to landuse for mksurfdata as all in repo now, add default values for + other mksurfdata namelist items + +>>>>>>>>>>> Update documentation for latest release +M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml +M models/lnd/clm/doc/UsersGuide/single_point.xml +M models/lnd/clm/doc/UsersGuide/special_cases.xml +M models/lnd/clm/doc/UsersGuide/tools.xml +M models/lnd/clm/doc/UsersGuide/limitLineLen.pl +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/adding_files.xml +M models/lnd/clm/doc/UsersGuide/appendix.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>>>>>> Update documentation for latest release +M models/lnd/clm/doc/Quickstart.userdatasets +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE +M models/lnd/clm/doc/CodeReference/Filepath +M models/lnd/clm/doc/KnownLimitations +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/README +M README + +>>>>>>>>>>> Add if masterproc, work on documentation, use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CropRestMod.F90 ---------- Add if masterproc +M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- Cleanup endrun statement +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CNDVMod.F90 -------------- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Ensure arepr is initialized + (bug 1341) +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Comment out debug write +M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 - Use iulog NOT unit 6 + +>>>>>>>>>>> Add if masterproc, work on documentation, rh files are t-1 +M models/lnd/clm/src/main/fileutils.F90 --- Add if masterproc +M models/lnd/clm/src/main/pftdynMod.F90 --- Add if masterproc (fix bug 1353) +M models/lnd/clm/src/main/histFileMod.F90 - Add if masterproc, rh files are t-1 + (bug 1346) +M models/lnd/clm/src/main/clmtype.F90 ----- Work on documentation + + +Summary of testing: + + bluefire: All PASS except... (up to 43) +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 5 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 5 +015 blEH1 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021231:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic ......FAIL! rc= 5 +019 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 5 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 5 +028 smG41 TSM.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 10 +029 erG41 TER.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +030 brG41 TBR.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +031 blG41 TBL.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 4 +035 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 5 +039 blG61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:1800 1.9x2.5 gx1v6 48 startup .................FAIL! rc= 5 +043 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 5 + bluefire interactive testing: All PASS except TBL tests + bluefire/CESM testing: All PASS except compare tests to clm4_0_32 + bluefire/CESM extra testing (show that answers are identical with cesm1_0_beta22): +PASS ERI.T31_g37.IGCN.bluefire +PASS ERI.T31_g37.IGCN.bluefire.compare.cesm1_0_alpha22a +PASS ERS.T31_g37.ITEST.bluefire +PASS ERS.T31_g37.ITEST.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.T31_g37.ITEST.bluefire.compare.cesm1_0_alpha22a +PASS ERS.f19_g16.IGCN.bluefire +PASS ERS.f19_g16.IGCN.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.f19_g16.IGCN.bluefire.compare.cesm1_0_alpha22a +PASS ERS.f45_g37.I4804.bluefire +PASS ERS.f45_g37.I4804.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.f45_g37.I4804.bluefire.compare.cesm1_0_alpha22a +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLA.f45_f45.I.bluefire.compare_hist.cesm1_0_alpha22a +PASS SMS_RLA.f45_f45.I.bluefire.compare.cesm1_0_alpha22a +PASS SMS_RLB.f45_f45.ITEST.bluefire +PASS SMS_RLB.f45_f45.ITEST.bluefire.compare_hist.cesm1_0_alpha22a +PASS SMS_RLB.f45_f45.ITEST.bluefire.compare.cesm1_0_alpha22a + jaguarpf interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 5 +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 +012 blVU4 TBL.sh 21p_cncrpsc_ds clm_stdIgnYr^nl_crop 20020101:3600 1x1_smallvilleIA test -1100 cold FAIL! rc= 5 +014 blAK4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 +015 smG43 TSM.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 10 +016 erG43 TER.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +017 brG43 TBR.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +018 blG43 TBL.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 4 +022 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 +026 blSn3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arFAIL! rc= 5 +030 blQQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 5 +034 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 5 +038 blS63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 5 +040 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +042 bl954 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ..........FAIL! rc= 6 +046 bl9T4 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__ds FAIL! rc= 6 +050 bl9C4 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds ...FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS except... +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 7 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 7 + edinburgh/lf95 testing: All PASS except TBL tests + lynx/intel testing: All PASS except TBL tests + +CLM tag used for the baseline comparison tests if applicable: clm4_0_32 + +Changes answers relative to baseline: Yes (Driver change) + + But, answers are identical to cesm1_0_beta22 where the driver change + was already in effect. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: larger than roundoff/same climate + +=============================================================== +=============================================================== +Tag name: clm4_0_32 +Originator(s): erik (Erik Kluzek) +Date: Thu May 19 15:18:49 MDT 2011 +One-line Summary: Make I1850SPINUPCN compset use MOAR data, various bug fixes, work on test lists + +Purpose of changes: + +Update datm and scripts so can run I1850SPINUPCN compset with MOAR data. Fix CN units. +Fix some documentation for crop. Add attribute that notes that flux variables are NOT +multiplied by landfrac. Change align year for I4804 and I4804CN compsets, add append/warn +option to xmlchange. Some clarifications to clm namelist. build-namelist can run list +options without a config_cache file. Add comment/title to output files. Remove the +2.65x3.33 grid, no longer supported. Work on test lists a bit. + +Bugs fixed (include bugzilla ID): + 1337 (have ISPINUPCN compset use MOAR data) + 1336 (evaluate CLM testing for release) + 1327 (correct documentation of CN variable units) + 1158 (make 4804 compsets consistent with 1850 etc.) + 1151 (remove co2_ppmv when co2_type is NOT constant) + 1140 (build-namelist -list options die with config file) + 1108 (have append/warn mode for xmlchange) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1325 (GDDHARV on hist causes model to die in debug) + 1367 (final_spinup stop time isn't right) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: + + I1850SPINUP compset changed to use MOAR data + + DATM_CPL_* variables added to env_conf.xml to set casename, years run over + I4804 compsets ALIGN year changed to agree with doc. and I1850 compsets + + New options to xmlchange -- allow you to append (-a) to the end of something already + there and another option (-w) warn you and abort if already set. + +Describe any changes made to the namelist: Add options to build-namelist + + Add -co2_ppmv and -rtm_tstep options to set co2_ppmv when co2_type is constant + and set rtm time-step when RTM is on. + + This way co2_ppmv and rtm_nsteps do NOT show up in the namelist if they aren't needed. + +List any changes to the defaults for the boundary datasets: Remove 2.65x3.33 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, slevis (units change), sacks (crop doc) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm + scripts to scripts4_110517 + csm_share to share3_110516 + datm to datm8_110517b + +List all files eliminated: + +>>>>>>>>>>>>> Remove as no longer needed to get lists for documentation + D models/lnd/clm/doc/UsersGuide/config_cache.xml + +List all files added and what they do: + +>>>>>>>>>>>>> Add new test configurations + A models/lnd/clm/test/system/config_files/_scnv_dm + A models/lnd/clm/test/system/config_files/17p_scnv_dm + A models/lnd/clm/test/system/config_files/17p_scnv_ds + A models/lnd/clm/test/system/config_files/17p_nrcnsc_do + A models/lnd/clm/test/system/config_files/17p_nrcnsc_ds + A models/lnd/clm/test/system/config_files/17p_scnv_m + A models/lnd/clm/test/system/config_files/17p_scnv_o + A models/lnd/clm/test/system/config_files/17p_scnv_s + A models/lnd/clm/test/system/config_files/17p_cnnfsc_dh -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/17p_cnnfsc_dm -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/17p_cnnfsc_do -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/21p_nrcncrpsc_s + A models/lnd/clm/test/system/config_files/21p_nrcncrpsc_ds + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README + +>>>>>>>>>>>>> Change tests a bit to make them more consistent with naming convention +>>>>>>>>>>>>> make sure tests are covered, and have no-RTM tests for single-point + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/nl_files/clm_spin --- Use MOAR data on bluefire + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>>>>>> Change test lists + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>>>>> Add -co2_ppmv, and -rtm_tstep options to build-namelist +>>>>>>>>>>>>> Don't require config file for build-namelist list options +>>>>>>>>>>>>> Remove 2.65x3.33 files, add capability to handle MOAR data + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/clm.cpl7.template + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/datm-build-namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>>>> Correct documentation of units from kg to g + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 -- Also documentation changes + from Bill Sacks + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 + +>>>>>>>>>>>>> Add title and comment attributes to output files + M models/lnd/clm/src/main/histFileMod.F90 + M models/lnd/clm/src/main/restFileMod.F90 + +Summary of testing: + + bluefire interactive testing: All PASS up to... +006 smC97 TSM.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 10 + bluefire/CESM testing: All PASS except... +BFAIL PST.f45_g37.I1850CN.bluefire.compare.clm4_0_31 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_31 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_31 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_31 +Originator(s): erik (Erik Kluzek) +Date: Fri May 13 17:11:38 MDT 2011 +One-line Summary: Fix answers for transient_CN, fix interpinic + +Purpose of changes: + +Fix interpinic test with finidat files. Fix CNPrecisionControl so answers with transient +CN are same as clm4_0_26 without crop. + +Bugs fixed (include bugzilla ID): + 1335 (transient_CN sometimes different than clm4_0_26) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1325 (GDDHARV on hist causes model to die in debug) + 1367 (final_spinup stop time isn't right) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>>>> Add transient 20th Century namelist config + A models/lnd/clm/test/system/nl_files/clm_transient_20thC + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add f19 transient-CN tests that start in 1979 (which showed bug 1335) + M models/lnd/clm/test/system/input_tests_master - Add f19 transient CN tests + Also make glc_nec interpinic test run for f09@1850 + M models/lnd/clm/test/system/README.testnames --- Add run-4 for f19 transient CN + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ------ Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_purempi_regression - Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_hybrid_regression -- Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi ------ Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_nompi_regression --- Add f19 transient_CN +test + +>>>>>>>>>>>>>> Put changes from clm4_0_27 back in except those that cause runs to fail + M models/lnd/clm/tools/interpinic/interpinic.F90 + M models/lnd/clm/tools/interpinic/Srcfiles ------ Add shr_const_mod.F90 back in + +>>>>>>>>>>>>>> + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Add if ( crop_prog ) to + a crop change that needed it + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Remove pft_ctrunc not used + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Remove pft_ctrunc not used + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 -------- Set wesveg for crop_prog + +Summary of testing: + + bluefire extra interactive testing: +001 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS +001 sm893 TSMrst_tools.sh _sc_do interpinic clm_std^nl_urb 20000101:1800 1.9x2.5 gx1v6 4x5 gx3v7 -1 PASS +001 sm857 TSMrst_tools.sh 17p_cnsc_o interpinic clm_std^nl_urb 18500101:1800 1.9x2.5 gx1v6@1850 10x1PASS +002 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6PASS +003 sm813 TSMrst_tools.sh 17p_cndvsc_do interpinic clm_std^nl_urb 18500101:1800 1.9x2.5 gx1v6@1850 4PASS +>>>>> This test compares to clm4_0_30 and rightly shows that answers change +001 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 + bluefire/CESM testing: All PASS except... (why did these comparisons PASS in clm4_0_27) +BFAIL ERP.f19_g16.IGRCP60CN.bluefire.compare.clm4_0_30 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_30 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_30 + bluefire/CESM testing compared to cesm1_0_beta19: +PASS SMS_D.f09_g16.BRCP45CN.bluefire +PASS SMS_D.f09_g16.BRCP45CN.bluefire.compare_hist.cesm1_0_beta19 +PASS SMS_D.f09_g16.BRCP45CN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f09_f09.FAMIPCN.bluefire +PASS ERS.f09_f09.FAMIPCN.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f09_f09.FAMIPCN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPC5.bluefire +PASS ERS.f19_f19.FAMIPC5.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPC5.bluefire.compare.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPCN.bluefire +PASS ERS.f19_f19.FAMIPCN.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPCN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f09_g16.BRCP45CN.lynx_pgi +PASS ERS.f09_g16.BRCP45CN.lynx_pgi.compare_hist.cesm1_0_beta19 +PASS ERS.f09_g16.BRCP45CN.lynx_pgi.compare.cesm1_0_beta19 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_30 + +Changes answers relative to baseline: Some transient_CN tests are different + because of bug 1335 introduced in clm4_0_27 + + With these changes answers are the same as clm4_0_26 + +=============================================================== +=============================================================== +Tag name: clm4_0_30 +Originator(s): erik (Erik Kluzek) +Date: Wed May 11 14:32:19 MDT 2011 +One-line Summary: New finidat/fsurdat files for T31 + +Purpose of changes: + +Externals update, fix some PTCLM problems. New finidat/fsurdat files for T31, make sure +works. + +Bugs fixed (include bugzilla ID): + 1279 (Latest version of PTCLM requires python2.5) + 1248 (PTCLM can only go to 2005) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1325 (GDDHARV on hist causes model to die in debug) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New finidat files for T31 + New fsurdat file for T31@2000 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, mct, pio + + scripts to scripts4_110511 + mct to MCT2_7_0_110504a + pio to pio1_3_0 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/17p_cnsc_h + A models/lnd/clm/test/system/config_files/17p_cnsc_o + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/README.testnames --- Add R f19 rcp4.5 resol + M models/lnd/clm/test/system/input_tests_master - Make some tests startup, add + some rcp tests, change some tests from T31 to f19 + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add new finidat + files for T31@1850/2000, add new surdata file for T31@2000, remove empty + half-degree pftdyn file + +Summary of testing: + + bluefire: All PASS except... +024 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +026 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +049 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 +054 erJ61 TER.sh 4p_casasc_dh clm_std^nl_urb 20021230:1800 1.9x2.5 gx1v6 10+38 cold .............FAIL! rc= 5 +055 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:1800 1.9x2.5 gx1v6 72+72 cold ..........FAIL! rc= 5 +056 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:1800 1.9x2.5 gx1v6 48 cold ................FAIL! rc= 4 + bluefire interactive testing: All PASS + bluefire extra interactive testing: +001 smE13 TSM.sh 17p_vorsc_do clm_std^nl_urb 20021230:1800 48x96 gx3v7 96 startup ...............PASS +001 smH13 TSM.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:1800 48x96 gx3v7@1850-2000 96 startup PASS + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_29 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_29 +BFAIL ERS_E.T31_g37.I1850.bluefire.compare.clm4_0_29 +BFAIL ERI.T31_g37.IG1850.bluefire.compare.clm4_0_29 +BFAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare.clm4_0_29 + + bluefire/CESM rcps extra testing: All PASS... +PASS SMS.f09_g16.IRCP26CN.bluefire +PASS SMS.f09_g16.IRCP45CN.bluefire +PASS SMS.f09_g16.IRCP60CN.bluefire +PASS SMS.f09_g16.IRCP85CN.bluefire +PASS SMS.f09_g16.IGRCP26CN.bluefire +PASS SMS.f09_g16.IGRCP45CN.bluefire +PASS SMS.f09_g16.IGRCP60CN.bluefire +PASS SMS.f09_g16.IGRCP85CN.bluefire +PASS SMS.f19_g16.IRCP26CN.bluefire +PASS SMS.f19_g16.IRCP45CN.bluefire +PASS SMS.f19_g16.IRCP60CN.bluefire +PASS SMS.f19_g16.IGRCP45CN.bluefire +PASS SMS.f19_g16.IGRCP85CN.bluefire + + bluefire/PTCLM testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_29 + +Changes answers relative to baseline: no bit-for-bit (except T31 with new files) + +=============================================================== +=============================================================== +Tag name: clm4_0_29 +Originator(s): erik (Erik Kluzek) +Date: Thu May 5 14:19:04 MDT 2011 +One-line Summary: Backout interpinic changes to one that works + +Purpose of changes: + +Backout interpinic to Mariana's non2dgrid version. Won't work for new +files (have to remove fields to get it to work). Adds back in bugs 1318 and 1319. +Add more comparison tests for tools and add cprnc.pl/ncl scripts to compare files that +don't have a time-axis. + +Bugs fixed (include bugzilla ID): + 1328 (interpinic gives bad results that can NOT be used!) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1325 (GDDHARV on hist causes model to die in debug) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>>>> Add scripts to compare two NetCDF files and report if different +>>>>>>>>>>>>>> This mimic's the cprnc program, but also works on files without +>>>>>>>>>>>>>> a time coordinate. For big files it's considerably slower as well. + A models/lnd/clm/tools/ncl_scripts/cprnc.pl + A models/lnd/clm/tools/ncl_scripts/cprnc.ncl + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add tool comparison tests, use cprnc.pl for tool comparison + M models/lnd/clm/test/system/input_tests_master - Add TBLtools test for: + mkgriddata, mksurfdata, mkdatadomain, and interpinic, remove pftdyn + mksurfdata test + M models/lnd/clm/test/system/CLM_compare.sh ----- Remove unused variable + M models/lnd/clm/test/system/TSMtools.sh -------- Copy .txt files over if exist + M models/lnd/clm/test/system/TBLtools.sh -------- Use cprnc.pl in place of cprnc binary + +>>>>>>>>>>>>>> Add tool comparison tests + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Add notes on cprnc tools + M models/lnd/clm/tools/ncl_scripts/README + +>>>>>>>>>>>>>> Move back to Mariana's version of interpinic in non2dgrid08_clm4_0_26 +>>>>>>>>>>>>>> This means it won't work for new files, but will work for older files +>>>>>>>>>>>>>> and gives the same answers as the non2dgrid version. + M models/lnd/clm/tools/interpinic/interpinic.F90 + M models/lnd/clm/tools/interpinic/Srcfiles + + +Summary of testing: + + bluefire interactive testing: These PASS + +002 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS (same as non2dgrid08_clm4_0_26) +001 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................PASS +002 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................PASS +001 bl654 TBLtools.sh mkgriddata tools__ds namelist .............................................PASS +001 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................PASS +002 blZ94 TBLtools.sh mkdatadomain tools__ds namelist ...........................................PASS + + yong/ifort interactive testing: These PASS + +001 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS (same as non2dgrid08_clm4_0_26) + +CLM tag used for the baseline comparison tests if applicable: clm4_0_28 + +Changes answers relative to baseline: no bit-for-bit (except interpinic) + +=============================================================== +=============================================================== +Tag name: clm4_0_28 +Originator(s): erik (Erik Kluzek) +Date: Tue May 3 09:14:24 MDT 2011 +One-line Summary: Remove DUST/PROGSSLT in land coupler layer, update driver and scripts + +Purpose of changes: + +Update drv to branch version, fix ram1/fv issue (remove DUST/PROGSSLT #ifdef's in +lnd_comp_*). Answers will then be identical to clm4_0_26 (except air density sent to +cpl). Don't allow both -irrig and -crop to be on at same time in scripts. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1325 (GDDHARV on hist causes model to die in debug) + 1328 (interpinic gives bad results that can NOT be used!) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): drv, scripts + scripts to scripts4_110428a + drv to branch version: t3148b_tags/t3148b02_drvseq3_1_48 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist - Don't allow crop and irrig on at same time + + M models/lnd/clm/tools/interpinic/interpinic.F90 -------- Move input read up + M models/lnd/clm/tools/interpinic/interpinic.runoptions - Use latest input file + + M models/lnd/clm/test/system/tests_pretag_bluefire -- Remove some tests + M models/lnd/clm/test/system/README.testnames ------- Don't mix crop and irrig + M models/lnd/clm/test/system/input_tests_master ----- Change irrig+crop tests to + just crop + + +>>>>>>>>>> Remove DUST, PROGSSLT and VOC #ifdef's + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +Summary of testing: + + bluefire: All PASS except... +024 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +026 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +049 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +058 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (compare to clm4_0_26 with updated datm) +SFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.GC.160557 +SFAIL ERP.T31_g37.IGRCP60CN.bluefire.GC.160557 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_26_datmdens +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_26_datmdens + +CLM tag used for the baseline comparison tests if applicable: clm4_0_27 + +Changes answers relative to baseline: No bit-for-bit + Although coupler log file will show changes in fv and ram1 to clm4_0_27, but + will be identical to clm4_0_26 (although then dens in atm changes) + +=============================================================== +=============================================================== +Tag name: clm4_0_27 +Originator(s): erik (Erik Kluzek) +Date: Mon May 2 09:37:57 MDT 2011 +One-line Summary: Move crop branch over to trunk + +Purpose of changes: + +Move crop branch to trunk. Add crop and noio options to configure. maxpft option to +configure can now only be a number (removing numpft+1 option to it). Add datasets for +crop. Add T31 historical and rcp2.6 transient dynpft datasets. Remove some of the CPP +tokens (DUST, PROGSSLT, etc.) Bring Marian Vertensteins version of interpinic over to the +trunk as well. This version is faster and is able to run for higher resolution cases. +Remove scaled_harvest and carbon_only namelist options and add suplnitro option +(supplemental Nitrogen which can be: NONE, PROG_CROP_ONLY, or ALL). Add number parameters +for the different nsrest settings, and have only one copy of is_restart in +clm_time_manager. Update to ESMF interface from Tony. + +Bugs fixed (include bugzilla ID): + 1323 (Remove some unused items) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1318 (interpinic has trouble with new restart files) + 1303 (remove complexity of no-urban in interpinic) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 901 (remove some CPP tokens) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1325 (GDDHARV on hist causes model to die in debug) + 1328 (interpinic gives bad results that can NOT be used!) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Yes + + Add -crop and -noio options to configure, remove -dust and -progsslt options + Remove "numpft+1" option to -maxpft. maxpft can go up to 17 without crop and + needs to be 21 for crop. + + -crop adds the CROP #ifdef. Removes the DUST, PROGSSLT, CLAMP CPP tokens. + Also remove: DISTURB, COUP_WRF, NO_DAYLEN_VCMAX, TCX_REMOVE_SEE_NOTES_ABOVE, and + L2R_Decomp, and some testing/debug CPP defines + +Describe any changes made to the namelist: Yes + + Remove Carbon_only and scaled_harvest options + Add suplnitro option which can be set to: NONE, PROG_CROP_ONLY, or ALL + + Add new history output variables: + + A5TMIN 5-day running mean of min 2-m temperature (K) + A10TMIN 10-day running mean of min 2-m temperature (K) + GDD0 Growing degree days base 0C from planting (ddays) + GDD8 Growing degree days base 8C from planting (ddays) + GDD10 Growing degree days base 10C from planting (ddays) + GDD020 Twenty year average of growing degree days base 0C from planting (ddays) + GDD820 Twenty year average of growing degree days base 8C from planting (ddays) + GDD1020 Twenty year average of growing degree days base 10C from planting (ddays) + GDDPLANT Accumulated growing degree days past planting date for crop (ddays) + GDDHARV Growing degree days (gdd) needed to harvest (ddays) + GDDTSOI Growing degree-days from planting (top two soil layers) (ddays) + +List any changes to the defaults for the boundary datasets: + New point mode for crop: 1x1_numaIA and 1x1_smallvilleIA + pftcon: pft-physiology.c110425.nc + surface datasets for crop mode for: f19, f10, 1x1_numaIA, and 1x1_smallvilleIA + (also crop datasets with crop AND irrigation on) + finidat file for crop for f19 + New T31 pftdyn file for historical and rcp2.6 + Raw veg and lai datasets for mksurfdata for crop + +Describe any substantial timing or memory changes: Crop adds some additional variables + and if checks that may make small differences in run-time and/or memory + +Code reviewed by: self, slevis + +List any svn externals directories updated (csm_share, mct, etc.): Almost all + + scripts to scripts4_110421 + share to share3_110411 + drv to drvseq3_1_53 + datm to datm8_110419 + stubs to stubs1_2_04 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove test configs that explicitly have dust + D models/lnd/clm/test/system/config_files/4p_vodsrsc_dh + D models/lnd/clm/test/system/config_files/4p_vodsrsc_dm + D models/lnd/clm/test/system/config_files/4p_vodsrsc_do + D models/lnd/clm/test/system/config_files/4p_vodsrsc_ds + D models/lnd/clm/test/system/config_files/17p_vodsrsc_h + D models/lnd/clm/test/system/config_files/17p_vodsrsc_m + D models/lnd/clm/test/system/config_files/17p_vodsrsc_o + D models/lnd/clm/test/system/config_files/17p_vodsrsc_dh + D models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + D models/lnd/clm/test/system/config_files/17p_vodsrsc_dm + D models/lnd/clm/test/system/config_files/17p_vodsrsc_do + D models/lnd/clm/test/system/config_files/4p_vodsrsc_h + D models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + D models/lnd/clm/test/system/config_files/4p_vodsrsc_o + +>>>>>>>>>>>>>>> Remove test for scaled_harvest namelist item + D models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + +>>>>>>>>>>>>>>> Remove sample namelists and always use mksurfdata.pl script + D models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig + D models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn + +>>>>>>>>>>>>>>> Remove these two from changes that mvertens applied + D models/lnd/clm/tools/interpinic/addglobal.F90 + D models/lnd/clm/tools/interpinic/wrap_nf.F90 + +>>>>>>>>>>>>>>> Update sample IC file + D models/lnd/clm/tools/interpinic/clmi.IQ.1953-01-01_10x15_USGS_simyr2000_c081202.nc + +List all files added and what they do: + +>>>>>>>>>>>>>>> Add crop test configs + A models/lnd/clm/test/system/config_files/21p_cncrpsc_do + A models/lnd/clm/test/system/config_files/21p_cncrpsc_s + A models/lnd/clm/test/system/config_files/21p_cncrpsc_ds + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s + A models/lnd/clm/test/system/config_files/21p_cncrpsc_h + A models/lnd/clm/test/system/config_files/21p_cncrpsc_dh + A models/lnd/clm/test/system/config_files/21p_cncrpsc_m + A models/lnd/clm/test/system/config_files/21p_cncrpsc_o + A models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +>>>>>>>>>>>>>>> Add test configs without dust + A models/lnd/clm/test/system/config_files/4p_vorsc_dm + A models/lnd/clm/test/system/config_files/4p_vorsc_do + A models/lnd/clm/test/system/config_files/4p_vorsc_ds + A models/lnd/clm/test/system/config_files/17p_vorsc_h + A models/lnd/clm/test/system/config_files/17p_vorsc_m + A models/lnd/clm/test/system/config_files/17p_vorsc_o + A models/lnd/clm/test/system/config_files/4p_vorsc_h + A models/lnd/clm/test/system/config_files/4p_vorsc_o + A models/lnd/clm/test/system/config_files/17p_vorsc_dm + A models/lnd/clm/test/system/config_files/17p_vorsc_dh + A models/lnd/clm/test/system/config_files/17p_vorsc_do + A models/lnd/clm/test/system/config_files/17p_vorsc_ds + A models/lnd/clm/test/system/config_files/4p_vorsc_dh + +>>>>>>>>>>>>>>> Add crop restart variables + A models/lnd/clm/src/biogeochem/CropRestMod.F90 + +>>>>>>>>>>>>>>> Add namelist for crop, and mksurfdata to create crop single point + A models/lnd/clm/test/system/nl_files/nl_crop + A models/lnd/clm/test/system/nl_files/nl_cn_conly + A models/lnd/clm/test/system/nl_files/clm_stdIgnYr + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 + + A models/lnd/clm/test/system/TSMrst_tools.sh - Add test to use finidat files + run interpinic on it and then make sure you can startup from the result + +>>>>>>>>>>>>>>> Explicitly add csm_share files into interpinic build + A models/lnd/clm/tools/interpinic/Mkdepends + A models/lnd/clm/tools/interpinic/shr_sys_mod.F90 + A models/lnd/clm/tools/interpinic/shr_log_mod.F90 + A models/lnd/clm/tools/interpinic/shr_kind_mod.F90 + A models/lnd/clm/tools/interpinic/shr_const_mod.F90 + +>>>>>>>>>>>>>>> Add the latest 10x15 initial conditions file to test on + A models/lnd/clm/tools/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Set maxpft to number + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_m + M models/lnd/clm/test/system/config_files/17p_cndvsc_o + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_s + M models/lnd/clm/test/system/config_files/_nrmexsc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_m + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/_nrvansc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_dm + M models/lnd/clm/test/system/config_files/17p_cndvsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/4p_vonrsc_ds + M models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>>>> Remove some tests add new crop tests + M models/lnd/clm/test/system/README.testnames ---------------- + M models/lnd/clm/test/system/tests_posttag_lynx_nompi -------- + M models/lnd/clm/test/system/tests_pretag_bluefire ----------- + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ----- + M models/lnd/clm/test/system/tests_pretag_edinburgh ---------- + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi ---- + M models/lnd/clm/test/system/tests_posttag_yong -------------- + M models/lnd/clm/test/system/tests_pretag_jaguarpf ----------- + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi ----- + M models/lnd/clm/test/system/tests_posttag_mirage ------------ + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression - + M models/lnd/clm/test/system/tests_posttag_nompi_regression -- + + M models/lnd/clm/test/system/TCBtools.sh ------- Add TOOL_ROOT + M models/lnd/clm/test/system/test_driver.sh ---- Use path to glade, update path + M models/lnd/clm/test/system/mknamelist -------- Add ability to set finidat file on + startup + M models/lnd/clm/test/system/input_tests_master Change out vodsrsc for vorsc, + add crop tests, add interpinic restart tests + M models/lnd/clm/test/system/tests_posttag_lynx Add sm9T4 test + M models/lnd/clm/test/system/CLM_runcmnd.sh ---- Remove -d + + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 Change from 1850-2000 + to just 1850 + M models/lnd/clm/test/system/nl_files/clm_irrig -------------- Use ignore_ic_year + instead of ignore_ic_date + +>>>>>>>>>>>>>>> Add ability to add crop in, add -crop to mksurfdata.pl which sets the +>>>>>>>>>>>>>>> numpft=20 namelist item + M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 - Add numstdpft + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 - Add numpft + M models/lnd/clm/tools/mksurfdata/ncdio.F90 ---- Add nf_get_att_double/nf_get_var_text + M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 - Use numpft + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 Add mksrf_flai/mksrf_firrig to file + M models/lnd/clm/tools/mksurfdata/areaMod.F90 -- Put numpft in mkvarctl + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 - Add numpft to namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl Handle crop and irrig and change + names accordingly + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 - Add numpft and add to namelist + if numpft = 20 add crop in + +>>>>>>>>>>>>>>> Bring in interpinic version from Mariana Vertenstein +>>>>>>>>>>>>>>> Make faster and use less memory, update NetCDF interface, make +>>>>>>>>>>>>>>> standalone so not dependant on other directories + M models/lnd/clm/tools/interpinic/interpinic.F90 - Make faster by saving indices, + use less memory, update to F90 NetCDF interface, make standalone + M models/lnd/clm/tools/interpinic/fmain.F90 ------ Add -a option to NOT override missing + M models/lnd/clm/tools/interpinic/Srcfiles ------- Remove mpi files + M models/lnd/clm/tools/interpinic/Filepath ------- Make standalone + M models/lnd/clm/tools/interpinic/Makefile ------- Use local MkDepends, compare + to null, change interface for testing a bit + M models/lnd/clm/tools/interpinic/README --------- Add note about SMP, update clmi file + M models/lnd/clm/tools/interpinic/interpinic.runoptions Use new file + +>>>>>>>>>>>>>>> Add numpft + M models/lnd/clm/tools/mkgriddata/mkvarctl.F90 + +>>>>>>>>>>>>>>> Add crop/noio remove dust and progsslt and CLAMP setting + M models/lnd/clm/bld/configure ------------- Add -crop/-noio remove -dust/-progsslt + turn RTM off for sitespf_pt, error check crop, maxpft, remove CLAMP setting + M models/lnd/clm/bld/listDefaultNamelist.pl Add loop for crop + M models/lnd/clm/bld/build-namelist -------- Sense crop=on/off, add suplnitro remove + Carbon_only + M models/lnd/clm/bld/clm.cpl7.template ----- Change order of $CLM_CONFIG_OPTS + so will be done last and override other settings + M models/lnd/clm/bld/config_files/config_definition.xml Add crop/noio, remove dust/progsslt + have maxpft only allow numbers up to 21 + +>>>>>>>>>>>>>>> New files for crop, remove old namelist items add new, add crop datasets + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Remove + Carbon_only add suplnitro, remove scaled_harvest, correct spellings + 1x1_numaIA,1x1_smallvilleIA resolutions + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Add + 1x1_numaIA,1x1_smallvilleIA + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ Add + 1x1_numaIA,1x1_smallvilleIA + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- Add + settings for suplnitro, new fpftcon, finidat for crop f19, add crop parameters + files for crop for f19,f10,1x1_numaIA,1x1_smallvilleIA, fix T31 files + turn create_crop_landunit on for crop + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add + mksrf_flai/mksrf_fvegtyp for crop add crop=on/off for those files + +>>>>>>>>>>>>>>> Use nsrest parameters, use secspday/days_per_year, handle prognostic crop +>>>>>>>>>>>>>>> Remove CLAMP/is_restart/DUST/DISTURB/CLAMP +>>>>>>>>>>>>>>> if soil also check if crop, use vegetation indices, add initialization +>>>>>>>>>>>>>>> subroutines, pass crop filters down, suplementatal Nitrogen can be for +>>>>>>>>>>>>>>> nothing, just for crop, or for all. + M models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 ----- Use nsrest parameters, secspday + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ---- Use secspday + M models/lnd/clm/src/biogeochem/CNGRespMod.F90 ----------- Handle crop + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 --- Handle crop + M models/lnd/clm/src/biogeochem/CNFireMod.F90 ------------ Use secspday/days_per_year + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 ----------- If crop add livestem + M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- Remove CLAMP is_restart + if soil or crop, nsrest parameters, use veg indices + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 Handle crop + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Remove CLAMP, add crop + M models/lnd/clm/src/biogeochem/DUSTMod.F90 -------------- Remove DUST, if soil or crop + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 ------- Add init and crop-Phenology + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 --- Add prog crop + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ---------- Pass crop filter down + use secspday + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Remove extra use + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------ Remove is_restart + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ---- Add CROP #ifdef to CNDV + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 ------- Use dayspyr and secspday + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Add init subroutine + section for prognostic crop, supplemental Nitrogen can be on for nothing, + crop only, or everything + M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ---- Add init subroutine, + add crop filters + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set crop vars remove CLAMP + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Add if section for crop + M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 - Remove DISTURB + +>>>>>>>>>>>>>>> Use nsrest parameters, update ESMF interface + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- Use nsrest parameters + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - Update interface from Tony Craig + Use nsrest parameters, use phase as a keyword. + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- Update interface from Tony Craig + compare success to ESMF_SUCCESS rather than 0. + +>>>>>>>>>>>>>>> Add istcrop and if statements for istsoil also test for istcrop +>>>>>>>>>>>>>>> Remove CLAMP/DUST/PROGSSLT/debug ifdef/vcmx25/dw_fcel/dw_flig +>>>>>>>>>>>>>>> /scaled_harv/ bad hist indices. Set if prog_crop in surfrdMod +>>>>>>>>>>>>>>> Use secspday and days_per_year, more vars on pft-physiology file +>>>>>>>>>>>>>>> Add parameters for nsrest settings, new hist vars, error check CROP + M models/lnd/clm/src/main/clm_varcon.F90 -------- Add istcrop + M models/lnd/clm/src/main/clm_varpar.F90 -------- Add numveg and mxpft + M models/lnd/clm/src/main/CNiniTimeVar.F90 ------ Remove CLAMP, if soil or crop + also set some crop vars + M models/lnd/clm/src/main/dynlandMod.F90 -------- If soil or crop + M models/lnd/clm/src/main/accumulMod.F90 -------- Remove is_restart, add missing to _PERIOD + M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove CLAMP/DUST, use nsrest parameters + add call to CNEcosystemDynInit + M models/lnd/clm/src/main/subgridRestMod.F90 ---- Remove incorrect grid indices (bug 1310) + M models/lnd/clm/src/main/accFldsMod.F90 -------- Add GDD0/8/10/PLANT/HARV/TSOI/TDM5/10 + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Remove CLAMP + CROP & C13 is not valid, add crop vars, remove vcmx25/dw_fcel/dw_flig + M models/lnd/clm/src/main/ndepStreamMod.F90 ----- Use secspday in place of 86400 + M models/lnd/clm/src/main/pftdynMod.F90 --------- Use days_per_year in place of 365 + move pconv/pprod10/pprod100 to pft-physiology file, if soil or crop + use nsrest parameters, remove scaled_harvest + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Add graincn, remove: vcmx25/dw_fcel/dw_flig + M models/lnd/clm/src/main/histFileMod.F90 ------- Use secspday in place of 86400 + fix Conventions, use nsrest parameters, comment out indices (bug 1310) + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove DUST/PROGSSLT/1==1 + M models/lnd/clm/src/main/restFileMod.F90 ------- Use nsrest parameters, add CropRest + fix Conventions + M models/lnd/clm/src/main/controlMod.F90 -------- Remove scaled_harvest/Carbon_only + use nsrest parameters, add suplnitro + M models/lnd/clm/src/main/initSurfAlbMod.F90 ---- if soil or crop, send crop filters + to CNEcosystemDyn + M models/lnd/clm/src/main/clm_time_manager.F90 -- Remove COUP_WRF, add get_driver_start_ymd + M models/lnd/clm/src/main/filterMod.F90 --------- Add filter for prognostic-crop + if soil or crop + M models/lnd/clm/src/main/clm_varctl.F90 -------- Add parameters for nsrest valid + values: nsrStartup, nsrContinue, nsrBranch, remove scaled_harvest + make sure crop allocates all PFT's + M models/lnd/clm/src/main/clm_driver.F90 -------- Remove DUST send crop filters + to CNEcosystemDyn + M models/lnd/clm/src/main/initGridCellsMod.F90 -- If crop send istcrop to set_landunit_crop_noncompete + M models/lnd/clm/src/main/CASAiniTimeVarMod.F90 - Remove CLAMP + M models/lnd/clm/src/main/pftvarcon.F90 --------- Add crop vars, corn, + temperate sping/winter cereal, and soybean, remove vcmx25/dw_flig/dw_fcel + add new variables for crop add npcropmin, npcropmax and error checking + M models/lnd/clm/src/main/ncdio_pio.F90 --------- Add logical field support + M models/lnd/clm/src/main/spmdMod.F90 ----------- Add MPI_LOR + M models/lnd/clm/src/main/surfrdMod.F90 --------- Add crop_prog as public module data + Remove TCX_REMOVE_SEE_NOTES_ABOVE, error checking if prognostic crops avail + and CROP not defined and vice versa + M models/lnd/clm/src/main/clmtype.F90 ----------- New variables for CROP, remove CLAMP + Remove dw_fcel, dw_flig, vcmx25 + M models/lnd/clm/src/main/histFldsMod.F90 ------- Remove CLAMP and DUST, T10 output + for CNDV or CROP, add A5TMIN, A10TMIN, GDD0, GDD8, GDD10, GDD020, GDD820, + GDD1020, GDDPLANT, GDDTSOI and GDDHARV for crop (as inactive) + + M models/lnd/clm/src/main/mkarbinitMod.F90 ------ If soil or crop + + M models/lnd/clm/src/riverroute/RtmMod.F90 - Remove L2R_Decomp #ifdef, and #if (1 == + Remove is_restart and use clm_time_manager version. +0) + +>>>>>>>>>>>>>>> Change if statements on "if soil" to "if soil or crop" +>>>>>>>>>>>>>>> Remove DUST, NO_DAYLEN_VCMAX #ifdefs, is_restart, vcmx25, avcmx, +>>>>>>>>>>>>>>> and SNICAR stats. vcmx calc is different for crop and btran for soybean + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - If soil or crop + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 -- If soil or crop + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 ---- If soil or crop + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- If soil or crop + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 --- If soil or crop + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Remove DUST #ifdef + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- If soil or crop + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 ------- If soil, urb, wet or crop + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- If soil or crop + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Remove is_restart use + clm_time_manger version, use nsrest parameters + M models/lnd/clm/src/biogeophys/SNICARMod.F90 ----------- Remove commented out SNICAR stats + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - If soil or crop + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Remove NO_DAYLEN_VCMAX, + and vcmx25,avcmx, vcmx calc different for crop and btran for soybean. + +Summary of testing: + + bluefire: All PASS except... +008 blAZ1 TBL.sh 21p_cncrpsc_dh clm_irrig^nl_crop 20020401:3600 10x15 USGS -10 cold .............FAIL! rc= 5 +015 blE91 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 arb_ic ...................FAIL! rc= 5 +020 blF92 TBL.sh 17p_vorsc_dm clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 +024 blEH1 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021231:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic ......FAIL! rc= 5 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 7 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +032 blF93 TBL.sh 17p_vorsc_do clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 +056 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +057 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +058 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (dens, fv and ram1 change) +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_26 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_26 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_26 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_26 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_26 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_26 +FAIL ERI.f19_g16.IG1850.bluefire.compare.clm4_0_26 +SFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.GC.231059 +SFAIL ERP.T31_g37.IGRCP60CN.bluefire.GC.231059 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_26 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_26 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_26 +FAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_26 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_26 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare_hist.clm4_0_26 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_26 + bluefire/PTCLM testing: All PASS up to.. +US-Ha1_ICN_ad_spinup.PTCLM PASS + jaguarpf interactive testing: All PASS up to... +008 blAZ3 TBL.sh 21p_cncrpsc_do clm_irrig^nl_crop 20020401:3600 10x15 USGS -10 cold .............FAIL! rc= 5 +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +035 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 7 +010 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic .............FAIL! rc= 7 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 7 +018 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ..FAIL! rc= 7 +026 blL74 TBL.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 + mirage,storm/ifort interactive testing: All PASS except... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_26 + +Changes answers relative to baseline: no bit-for-bit + with the exception that the new crop mode is NOT in previous tags + +=============================================================== +=============================================================== +Tag name: clm4_0_26 +Originator(s): erik (Erik Kluzek) +Date: Wed Mar 23 11:43:00 MDT 2011 +One-line Summary: Update externals, driver update changes answers, drydep changes from fvitt, fix bugs + +Purpose of changes: + +Update externals to latest pre-cesm1_0_beta17 version. driver to beyond cesm1_0_beta16 +version -- so answers change. Always update ndep_interp in clm_driver -- so restarts are +exact. Bring in Francis Vitt drydep changes. Remove bad T31 pftdyn datasets add in +a new T31 rcp2.6 T31 dataset. Fix interpinic _var bug. Remove HIRES from bld. Change +tools Makefile's so that you can set env variables. Change test_driver to use newer +version of cprnc. + +Bugs fixed (include bugzilla ID): + 1284 (Crop restart test fails) + 1304 (bug in interpinic *_var) + 1308 (tools Make doesn't allow setting env vars) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: more fields added for drydep namelist + +List any changes to the defaults for the boundary datasets: + Remove bad T31 pftdyn datasets + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, drydep changes from fvitt and JFL + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, cprnc + + scripts to scripts4_110314 + drv to drvseq3_1_51 + cprnc to cprnc_110310 + +List all files eliminated: None + +List all files added and what they do: + + A README_EXTERNALS -- Describes how to work with externals (similar to cam file) + +List all existing files that have been modified, and describe the changes: + + M README - Update with new + + M models/lnd/clm/test/system/CLM_compare.sh - Update for latest cprnc which + doesn't have a "completed successfully line at the end" + M models/lnd/clm/test/system/test_driver.sh - Use newer cprnc on bluefire + +>>>>>>>>>>> Change tools build so that you can set env variables for SMP/USER_FC/CC + M models/lnd/clm/tools/mksurfdata/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/interpinic/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/mkgriddata/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/mkdatadomain/Makefile ------ Compare to ,null rather than strip + + M models/lnd/clm/tools/interpinic/interpinic.F90 -- Make sure htop_var/fpcgrid_var + are initialized to false each time comes into routine (bug 1304) + + M models/lnd/clm/bld/configure -- Remove HIRES setting for stand-alone testing + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New rcp2.6 T31 + pftdyn dataset remove rcp4.5,6,8.5 T31 pftdyn files as they only go to 2035 + + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Pick wesveg and index_season + differently for special landunits, add max for rc, assume no surface + resistance for SO2 over water, use has_rain logical (from fvitt) + M models/lnd/clm/src/main/clm_driver.F90 ----------- Always call ndep_interp + even if (stream_year_first_ndep /= stream_year_last_ndep) as can change + answers if not + +Summary of testing: + + bluefire: All PASS except TBL tests and... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS except TBL tests + bluefire/CESM testing: All PASS (even the comparision tests) + bluefire/PTCLM testing: All PASS up to... +US-Ha1_ICN_ad_spinup.PTCLM PASS + edinburgh/lf95 interactive testing: All PASS except... +021 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 10 + mirage,storm/ifort interactive testing: All PASS except TBL tests and... +016 smVx3 TSM.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 10 +017 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 5 +018 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 5 +024 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +026 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + yong/ifort interactive testing: All PASS except... +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_25 + +Changes answers relative to baseline: Yes! Greater than roundoff + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change:(larger than roundoff/same climate + + driver mapping changes, drydep code has changes, ndep_interp is always called + which changes answers on some platforms/compilers (such as intel compiler). + +=============================================================== +=============================================================== +Tag name: clm4_0_25 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 22 10:13:08 MDT 2011 +One-line Summary: Always output restart-history files add more meta-data to them, + fix urbanc_alpha and 2.5x3.33 datasets, Changes from Keith O on SNOWLIQ/SNOWICE + +Purpose of changes: + +Move history namelist information to restart history files and always output them. Add +attributes and meta-data to the restart history files. Fix urbanc_alpha test site surface +dataset. Fix datm namelist for urban cases. Use new crop pft-physiology file. Update +scripts and csm_share. Changes from Keith O on SNOWLIQ/SNOWICE so goes to zero rather +than missing value. Update 2.5x3.33 datasets. Fix dvolrdt units documentation, call +mksoifmaxInit. + +Bugs fixed (include bugzilla ID): + 1247 (Some changes to ncd_pio in clm) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New pft-physiology file with fields for prognostic crop + New surface dataset for urbanc_alpha + New grid/topo/frac/domain files for 2.5x3.33 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, snowliq/snowice changes by oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, cism, csm_share + + scripts to scripts4_110204 + datm to datm8_110210 + cism to cism1_110220 + csm_share to share3_110201 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/input_tests_master - Change start dates of urban tests + +>>>>>>>>>>>> Move mksoil*Init subroutines private to mksoilMod, and call a mksoilInit +>>>>>>>>>>>> routine from mksrfdata, making sure mksoifmaxInit is called. + M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 - Add mksoilInit to call + mksoitexInit/mksoicolInit and mksoifmaxInit (mksoifmaxInit was missing) + fix mksoifmaxInit, and make mksoitex/col/fmaxInit routines private + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -- Call mksoilInit, + remove mksoicol/texInit + +>>>>>>>>>>>> Add notes about setting path to NetCDF, and other gmake options + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/interpinic/README + M models/lnd/clm/tools/mkgriddata/README + M models/lnd/clm/tools/mkdatadomain/README + + M models/lnd/clm/bld/queryDefaultNamelist.pl - Remove white-space from input options + M models/lnd/clm/bld/listDefaultNamelist.pl -- Also list datm_internal files + M models/lnd/clm/bld/build-namelist ---------- Add drv_final_spinup from PTCLM + document precidence of the different env_conf.xml + +>>>>>>>>>>>> Fix 2.5x3.33 and urbanc_alpha files, change some settings for CLM1PT +>>>>>>>>>>>> or pt1_pt1 resolution, remove ndepsrc. + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Add + taxmode and dtlimit, add 2.5x3.33 resolution + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Add + sim_year="2000" sim_year_range="constant" for pft1_pt1 datm_presaero files + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ Add + 1x1_numaIA and 1x1_smallvilleIA domain/preseaero files, update 2.5x3.33 domain + make mapalgo nn for CLM1PT, set taxmode and tintalgo appropriately + if CLM1PT is set. Add transient presaero file for 1x1_tropicAtl. + M models/lnd/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml ------- Set + dtime to 1800 for 1x1_urbanc_alpha + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- Set + tintalgo, mapalgo by datm_source, and set taxmode as well. Remove + option for datm_presaero="none". Set mapalgo=nn for datm_presaero=pt1_pt1. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- Update + urbanc_alpha surface dataset, 2.5x3.33 grid/topo/frac datasets + Remove ndepsrc="stream" in ndepmapalgo settings as doesn't exist anymore. + Use latest pft-physiology file from CROP branch (has extra data needed + for prognostic crop) + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Set + atm_cpl_dt=1800 for urbanc_alpha, set stop_option/stop_n for + urban sites carefully (add 1 time-step to stop_n, double for urbanc_alpha). + Use "test" mask for urbanc_alpha + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Remove + ndepsrc="stream" + +>>>>>>>>>>>> Add meta-data to restart hist files, put history restart data on +>>>>>>>>>>>> restart hist files and off master restart files (so initial condition +>>>>>>>>>>>> files aren't cluttered with information only needed for continue runs). +>>>>>>>>>>>> Some changes to SNOWLIQ/SNOWICE, document dvolrdt units. + M models/lnd/clm/src/main/histFileMod.F90 - Use htape_create for restart_hist + files, modify hist_restart_ncd so that namelist vars on one restart + history files and they are always output, add more metadata to + restart hist files, remove some temp arrays. Restart history files + now always needed for continue runs, but not for other run types, + and restart history information does not clutter the master restart + files. The only history variables on master restart files are the + history and restart filenames. Comments on the files make this clear. + M models/lnd/clm/src/main/restFileMod.F90 - Change hist_restart_ncd calls + M models/lnd/clm/src/main/ncdio_pio.F90 --- Add ncd_io_log_var0_nf interface + add options for attributes: comment, flag_values, flag_meanings, and + nvalid_range for variables., fix an issue in ncd_io_int_var0_nf + M models/lnd/clm/src/main/histFldsMod.F90 - Change default for SNOWLIQ/SNOWICE + to "Average" rather than "Instant" (from oleson). + M models/lnd/clm/src/riverroute/RtmMod.F90 ---- Document dvolrdt conversion + M models/lnd/clm/src/riverroute/RunoffMod.F90 - Document dvolrdt units + correctly. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 - Initialize snowice/snowliq + to zero over lake filter (from oleson). + +Summary of testing: + + bluefire: All PASS except TBL tests and... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS except all TBL tests fail + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL SMS_RLB.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL SMS_ROA.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL ERS_D.f45_g37.I.bluefire.generate.clm4_0_25 +BFAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_23 +FAIL PST.f45_g37.I1850.bluefire.generate.clm4_0_25 +FAIL PET_PT.f45_g37.I1850.bluefire.generate.clm4_0_25 +FAIL ERS_E.f19_g16.I1850.bluefire.generate.clm4_0_25 +FAIL ERI.f19_g16.IG1850.bluefire.generate.clm4_0_25 +FAIL ERS_D.T31_g37.IGRCP26CN.bluefire.generate.clm4_0_25 +FAIL ERP.T31_g37.IGRCP60CN.bluefire.generate.clm4_0_25 +BFAIL ERP.T31_g37.IGRCP60CN.bluefire.compare.clm4_0_23 +FAIL ERB.f09_g16.I_1948-2004.bluefire.generate.clm4_0_25 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_25 +FAIL ERH_D.f10_f10.I1850CN.bluefire.generate.clm4_0_25 +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_23 +FAIL PST.f10_f10.I20TRCN.bluefire.generate.clm4_0_25 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.generate.clm4_0_25 +FAIL SMS.f10_f10.IRCP45CN.bluefire.generate.clm4_0_25 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.generate.clm4_0_25 +BFAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_23 + jaguarpf interactive testing: +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -5+-5 arb_ic .............FAIL! rc= 13 +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:1800 1x1_brazil navy -5+-5 arb_ic ..........FAIL! rc= 11 +006 erAZ3 TER.sh _sc_do clm_irrig 20020401:3600 10x15 USGS -3+-7 cold ...........................FAIL! rc= 13 +007 brAZ3 TBR.sh _sc_do clm_irrig 20020401:3600 10x15 USGS -5+-5 cold ...........................FAIL! rc= 11 +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +016 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:3600 1x1_tropicAtl test -10+-10 arb_ic ..FAIL! rc= 13 +017 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 11 +020 erK74 TER.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -334+-336 arb_ic ............FAIL! rc= 13 +021 brK74 TBR.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -334+-336 arb_ic ............FAIL! rc= 11 +024 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 13 +025 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 11 +028 erHQ4 TER.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -3+-7 cold ............FAIL! rc= 13 +029 brHQ4 TBR.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -5+-5 cold ............FAIL! rc= 11 +032 erV63 TER.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 10+38 arb_ic ................FAIL! rc= 13 + jaguarpf/CESM testing: All PASS including comparision tests except... +FAIL PST.f10_f10.I20TRCN.jaguarpf + edinburgh/lf95 interactive testing: +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -5+-5 arb_ic .............FAIL! rc= 13 +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:1800 1x1_brazil navy -5+-5 arb_ic ..........FAIL! rc= 11 +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 7 +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 7 +008 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -45+-45 arb_ic .........FAIL! rc= 13 +009 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:3600 1x1_camdenNJ navy -10+-10 arb_ic ......FAIL! rc= 11 +010 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic .............FAIL! rc= 7 +012 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 115+115 arb_ic FAIL! rc= 13 +013 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:3600 1x1_vancouverCAN navy 72+72 arb_ic FAIL! rc= 11 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 5 +016 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 58+100 arb_ic FAIL! rc= 13 +017 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:3600 1x1_mexicocityMEX navy 72+72 arb_ic FAIL! rc= 11 +018 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ..FAIL! rc= 5 +020 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 13 +021 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 11 +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 7 +024 erL74 TER.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -5+-5 arb_ic ..............FAIL! rc= 13 +025 brL74 TBR.sh _nrsc_s clm_std^nl_urb_br 20020101:1800 1x1_brazil navy -10+-10 arb_ic .........FAIL! rc= 11 +026 blL74 TBL.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 + edinburgh/CESM testing: All PASS including comparision tests + yong/intel testing: +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 2 +012 erD94 TER.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 +022 smV24 TSM.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 96 arb_ic .....................FAIL! rc= 10 +023 erV24 TER.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 10+38 arb_ic ..................FAIL! rc= 5 +024 brV24 TBR.sh _mec10sc_ds clm_glcmec^nl_urb_br 19980115:1800 48x96 gx3v7 72+72 arb_ic ........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_24 + +Changes answers relative to baseline: answers bit-for-bit, but SNOWLIQ/SNOWICE on history + files change. + +=============================================================== +=============================================================== +Tag name: clm4_0_24 +Originator(s): erik (Erik Kluzek) +Date: Wed Feb 9 13:20:39 MST 2011 +One-line Summary: Fix mksurfdata and add ability to override soil_fmax + +Purpose of changes: + +Fix mksurfdata for urban. Add soil_fmx to mksurfdata. Add attributes to suface datasets +that tell you the special namelist settings (such as all_urban, soil_, pft_). Add -irrig +as option to mksurfdata.pl. Update datm with new datasets for urbanc_alpha. Add new frac +dataset for urbanc_alpha. Update documentation to cesm1_0_rel_09_clm4_0_14 tag. Change +test_driver from jaguar to jaguarpf. Fix bug in build-namelist creating namelist +with clm_usr_name option. + +Bugs fixed (include bugzilla ID): + 1281 (bug in mksurfdata for urban_only case) + 1280 (improve modularity of mksurfdata) [partial] + 1276 (urbanc_alpha site does not work) [partial] + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Update frac and domain file for urbanc_alpha site + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts, drv and csm_share to cesm1_0_beta15 versions + + scripts to scripts4_110204 + drv to drvseq3_1_48 + csm_share to share3_110201 + datm to datm8_110204 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/mkfmaxMod.F90 --- Put inside of mksoilMod.F90 + + D models/lnd/clm/test/system/tests_pretag_jaguar ------- rename to jaguarpf + D models/lnd/clm/test/system/tests_pretag_jaguar_nompi - rename to jaguarpf + +>>>>>>>>>>>> Remove files that were no longer used +>>>>>>>>>>>> (they are already in mksoilMod or mkpftMod) + D models/lnd/clm/tools/mksurfdata/mkorganic.F90 + D models/lnd/clm/tools/mksurfdata/mkrank.F90 + D models/lnd/clm/tools/mksurfdata/mkirrig.F90 + D models/lnd/clm/tools/mksurfdata/mksoicolMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>> Add an irrigation and urban test for mksurfdata + A models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 + + A models/lnd/clm/test/system/tests_pretag_jaguarpf ------- rename from jaguar + A models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi - rename from jaguar + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add all_urban and irrigation mksurfdata tests +>>>>>>>>>>>> Update jaguar to jaguarpf + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/TCBtools.sh ---- Remove copy of *.h files + M models/lnd/clm/test/system/test_driver.sh - change jaguar to jaguarpf, update + modules to agree with scripts + M models/lnd/clm/test/system/CLM_runcmnd.sh - change jaguar to jaguarpf + +>>>>>>>>>>>> Add soil_fmax option and soil_fmx, soil_col and irrig option to +>>>>>>>>>>>> mksurfdata.pl. Add attributes to file for override cases. +>>>>>>>>>>>> Put mkfmax inside of mksoilMod, add mksoilAtt and mkpftAtt methods. + M models/lnd/clm/tools/mksurfdata/Srcfiles -------- Remove unused files + M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 --- Move mkfmax inside here + add mksoifmaxInit, mkfmax, and mksoilAtt interfaces, add soil_fmax as + an override setting + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ---- Fix bug in if statement + (needed to also ask if .not. zerod_out). Create mkpftAtt interface, move + settings from mkfileMod.F90 to there. + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 --- Move soil and pft specific + declarations to either mksoilAtt or mkpftAt interfaces + if all_urban is set add all_urban=TRUE attribute to file + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Add soil_fmax to namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Add ability to set soil_col, + soil_fmax and irrig on command line + bring irrigation, setting of numpft and query of lai file from crop branch + +>>>>>>>>>>>> Update urbanc_alpha domain/frac files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml -------- Add mksrf_flai + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml -- Set + urbanc_alpha default mask to test + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ----- urbanc_alpha + domain file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------ urbanc_alpha + frac file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Add in + mksrf_flai file + +>>>>>>>>>>>> Update to cesm1_0_rel_09_clm4_0_14 documentation (includes info on new bugs) + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/KnownBugs + +Summary of testing: + + bluefire interactive testing: +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 5 + jaguarpf interactive testing: +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +026 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 +034 blV63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 + edinburgh/lf95 interactive testing: +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + mirage/intel interactive testing: All PASS except... +017 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 5 +018 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 5 +019 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 4 +021 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +022 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +024 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +026 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +029 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +030 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + yong/intel interactive testing: +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +012 erD94 TER.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 +022 smV24 TSM.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 96 arb_ic .....................FAIL! rc= 10 +023 erV24 TER.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 10+38 arb_ic ..................FAIL! rc= 5 +024 brV24 TBR.sh _mec10sc_ds clm_glcmec^nl_urb_br 19980115:1800 48x96 gx3v7 72+72 arb_ic ........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_23 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_23 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 3 13:42:17 MST 2011 +One-line Summary: Add in new glacier-MEC use-cases + +Purpose of changes: + +Add in new datasets and use-cases for glc_mec to support glc_nec=10 for 1850, 2000, +1850-2000, and 1850-2100 for all 4 rcp's. Standardize naming convention for use-cases. +Use scripts branch that has new compsets in it that access the new use-cases. Make sure +ncdpio is used for all I/O. Work with PTCLM a bit, and PTCLM testing. Change precedence +for build-namelist so that use-case is lower after user_nl_clm. + +Bugs fixed (include bugzilla ID): + 1273 (fix pts_mode problem on jaguar) + 1256 (fix PTCLM testcases.csh on jaguar to use netcdf/3) + 1254 (PTCLM add .nc and date to pft-physiology file copy) + 1250 (add scratchroot in PTCLM for generic machines) + 1247 (some changes in ncdio_pio) [partial] + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1168 (Change precedence so user_nl_clm used over use-case) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Change order of precedence so that + use_case is AFTER -namelist -infile and clm_usr_name options. + Thus values in your user_nl_clm file will be used instead of what's in + the use_case. + + New precedence is... + 1. values set on the command-line using the -namelist option, + 2. values read from the file specified by -infile, + 3. datasets from the -clm_usr_name option, + 4. values set from a use-case scenario, e.g., -use_case + 5. values from the namelist defaults file. +List any changes to the defaults for the boundary datasets: + New datasets for glc_nec="10" + surfdata for 1850@(f09,f19,T31) + pftdyn for 1850-2000@(f09,f19,T31) + pftdyn for 1850-2100@(f09,f19,T31) rcp (2.6,4.5,6,8.5) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, cism + + scripts to glccsbr01_scripts4_110111 + datm to datm8_110124 + cism to cism1_110125 + +List all files eliminated: + + Rename use-cases to versions with an _pd ending or 2000_*_control form + + models/lnd/clm/bld/namelist_files/use_cases/... + D .../use_cases/stdurbpt.xml ----- rename to stdurbpt_pd + D .../use_cases/glacier_mec.xml -- rename to 2000_glacierMEC_control + D .../use_cases/pergro.xml ------- rename to pergro_pd + D .../use_cases/pergro0.xml ------ rename to pergro0_pd + +List all files added and what they do: + +>>>>>>>>>>>>>> Add tests for all new glacier-MEC use-cases + A models/lnd/clm/test/system/nl_files/clm_glcmec + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp2.6 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp4.5 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp8.5 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp6 + + A models/lnd/clm/test/system/nl_files/nl_per - PERGRO testing namelist + +>>>>>>>>>>>>>> + models/lnd/clm/bld/namelist_files/use_cases/... + A .../use_cases/pergro_pd.xml -------------- Renamed from pergro + A .../use_cases/2000_glacierMEC_control.xml Copy of glacier_mec_pd + A .../use_cases/stdurbpt_pd.xml ------------ Renamed from stdurbpt + A .../use_cases/pergro0_pd.xml ------------- Renamed from pergro0 + A .../use_cases/README --------------------- Add README file to describe + naming convention for use_cases + +>>>>>>>>>>>>>> Add new glacier_MEC use_cases + models/lnd/clm/bld/namelist_files/use_cases/... + A .../use_cases/1850_glacierMEC_control.xml + A .../use_cases/20thC_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp6_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + A .../use_cases/glacierMEC_pd.xml --- renamed from glacier_mec + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add some new glacierMEC use-case tests + M models/lnd/clm/test/system/README.testnames ------------- Add n,w,x,y glcMEC resolutions + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Get glcmec branch testing to work and pergro testing working with +>>>>>>>>>>>>>> build-namelist precedence change + M models/lnd/clm/test/system/TBR.sh ------------- Match history files + NOT restart-history files + M models/lnd/clm/test/system/nl_files/clm_per0 -- Change use-case name + M models/lnd/clm/test/system/nl_files/nl_urb_br - Add hist_fincl2 to remove + any secondardy history files from use-case + M models/lnd/clm/test/system/nl_files/clm_per --- Change use-case name + M models/lnd/clm/test/system/input_tests_master - Add new tests + M models/lnd/clm/test/system/TSM.sh ------------- Make restart file touched + with .nc extension, remove bit about deleting clm.i files + +>>>>>>>>>>>>>> Use mksrf_glacier files from XML database, add glc_nec to mksurfdata.pl, +>>>>>>>>>>>>>> allow glc_nec=0, and don't write out glcmec fields if glc_nec=0. + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 --- Don't define glc_nec + fields if nglcec == 0. + M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 - Set nglcec=0 by default, + add ability to handle nglcec=0 + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Don't write out or call + glc-mec stuff if nglcec == 0. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Add ability to set glc_nec + get mksrf_glacier file from XML database + +>>>>>>>>>>>>>> Add in new glc_nec=10 datasets, change precedence order in +>>>>>>>>>>>>>> build-namelist so use_case is AFTER -namelist/-infile/-clm_usr_name. +>>>>>>>>>>>>>> Add mksrf_glacier files to XML database + M models/lnd/clm/bld/listDefaultNamelist.pl - Make faster and add settings + for glc_nec and glc_grid, also add loop over sim_year_range + M models/lnd/clm/bld/build-namelist --------- Change precedence order so + that use-cases are after namelist and infile (thus user_nl_clm files + are used in place of the use-case. Check that the use-cases follow + a strict naming convention (ensures will work with PTCLM.py). + This is the new order of precedence ++ 1. values set on the command-line using the -namelist option, ++ 2. values read from the file specified by -infile, ++ 3. datasets from the -clm_usr_name option, ++ 4. values set from a use-case scenario, e.g., -use_case ++ 5. values from the namelist defaults file. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Add + mksrf_glacier file for mksurfdata.pl to XML database + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- Change + order of precedence so that use_case is after infile and namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- New glc datasets + surfdata for 1850@(f09,f19,T31) + pftdyn for 1850-2000@(f09,f19,T31) + pftdyn for 1850-2100@(f09,f19,T31) rcp (2.6,4.5,6,8.5) + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add + mksrf_glacier datasets for glc_nec=0 (previous version), glc_nec=3,5,10 + use older glacier dataset that Bill Lipscomb says has better glacier + representation over greenland +>>>>>>>>>>>>>> Remove direct calls to pio -- use ncdio_pio module for all NetCDF +>>>>>>>>>>>>>> read/write/define/query. Write out at initialization if there is no +>>>>>>>>>>>>>> land and won't be running CLM. + M models/lnd/clm/src/main/clm_initializeMod.F90 - Set subname and write out + if no land exists and clm will NOT be run + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Use ncd_io to read in mxsoil_color + (remove direct calls to pio) + M models/lnd/clm/src/main/histFileMod.F90 ------- Use ncd_io to read/write + everything (remove direct calls to pio). Add max_nFields function. + M models/lnd/clm/src/main/restFileMod.F90 ------- Change use of PIO_GLOBAL + to NCD_GLOBAL + M models/lnd/clm/src/main/ncdio_pio.F90 --------- Remove making pio interfaces + public, add new interfaces to ncd_io global, add dimexist as optional + argument to ncd_inqdid, and name as optional argument to ncd_inqdlen + change ncd_io interfaces that could NOT need to call scam_field_offsets + so that they don't. Initialize data_offset and pfts to bigint NOT nan. + New interfaces: ++ module procedure ncd_io_char_var1_nf ++ module procedure ncd_io_char_var3_nf ++ module procedure ncd_io_char_varn_strt_nf + M models/lnd/clm/src/main/surfrdMod.F90 --------- Use ncd_inqdid and ncd_inqvid + instead of pio interfaces directly. + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +057 blV61 TBL.sh _mec10sc_dh clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +061 blVn1 TBL.sh _mec10sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arFAIL! rc= 5 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +066 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + +glcmec TBL tests fail since they didn't exist in previous version + + bluefire interactive testing: +006 smHS3 TSM.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 8 +007 erHS3 TER.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic ...FAIL! rc= 5 +008 brHS3 TBR.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic ...FAIL! rc= 5 +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 4 +044 blV63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +060 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + bluefire/CESM testing: All PASS except... (new compare tests fail since didn't exist before) +BFAIL ERI.f19_g16.IG1850.bluefire.compare.clm4_0_22 +BFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.compare.clm4_0_22 +BFAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_22 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_22 +BFAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_22 + +PEND ERS_D.f45_g37.I.bluefire.GC.003008 +PEND ERP.T31_g37.IGRCP60CN.bluefire.GC.003008 +PEND ERH_D.f10_f10.I1850CN.bluefire.GC.003008 +PEND ERS_D.f19_g16.IRCP85CN.bluefire.GC.003008 + + bluefire/CESM Extra testing: +PASS ERI.f19_g16.IG1850.bluefire +PASS ERI.f19_g16.IG1850CN.bluefire +PASS ERS.T31_g37.IGRCP45CN.bluefire +PASS ERS.T31_g37.IGRCP85CN.bluefire + +PASS ERS_D.T31_g37.IG.bluefire +PASS ERS_D.f19_g16.IGCN.bluefire + + bluefire/CESM Extra testing for coupled with CAM and CAM/POP: +PASS ERI.f19_g16.BGCN.bluefire +PASS SMS_D.f19_g16.BG1850CN.bluefire +PASS ERP.f09_g16.BG20TRCN.bluefire +PASS ERS.T31_g37.BGRCP26CN.bluefire +RUN ERS_D.T31_g37.BGRCP45CN.bluefire.111336 --- takes too long +PASS ERS.T31_g37.BGRCP60CN.bluefire +RUN ERS_D.T31_g37.BGRCP85CN.bluefire.111336 --- takes too long +FAIL SMS.f19_f19.EGCN.bluefire ----------------- seg-fault +FAIL SMS.T31_T31.EG1850CN.bluefire ------------- seg-fault +PASS ERI.f09_f09.FGCN.bluefire +PASS SMS.f19_f19.FG1850CN.bluefire +PASS SMS.T31_T31.FG20TRCN.bluefire +FAIL SMS.T31_g37.TG.bluefire + + bluefire/PTCLM testing: +PTCLM.631306_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.631306_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.631306_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.631306_US-Ha1_I_1850.PTCLM PASS +PTCLM.631306_US-Ha1_I20TR.PTCLM PASS +PTCLM.631306_US-Ha1_I20TRCN.PTCLM PASS +PTCLM.631306_US-Ha1_ICN.PTCLM PASS +PTCLM.631306_US-Ha1_I1850CN.PTCLM PASS +PTCLM.631306_US-Ha1_IRCP85CN.PTCLM PASS +PTCLM.631306_US-Ha1_I.PTCLM PASS +PTCLM.631306_US-Ha1_I_QIAN.PTCLM PASS +PTCLM.631306_US-Ha1_I.PTCLM PASS +PTCLM.631306_US-UMB_I.PTCLM PASS +PTCLM.631306_US-UMB_I_QIAN.PTCLM PASS +PTCLM.631306_US-UMB_I.PTCLM PASS +US-Ha1_ICN_ad_spinup.PTCLM PASS + jaguar interactive testing: All PASS except... +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +026 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + jaguar/PTCLM testing: +PTCLM.4224_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.4224_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.4224_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.4224_US-Ha1_I_1850.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I20TR.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I20TRCN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_ICN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I1850CN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_IRCP85CN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I_QIAN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I_QIAN.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I.PTCLM FAIL 0 +US-Ha1_ICN_ad_spinup.PTCLM PASS + edinburgh/lf95 interactive testing: All PASS up to... +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + edinburgh/PTCLM testing: Fails because Python is too OLD (2.4 when needs 2.5) + yong/intel/PTCLM testing: Following PASS... +PTCLM.4900_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.4900_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.4900_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.4900_US-Ha1_I_1850.PTCLM PASS +PTCLM.4900_US-Ha1_I20TR.PTCLM PASS +PTCLM.4900_US-Ha1_I20TRCN.PTCLM PASS +PTCLM.4900_US-Ha1_ICN.PTCLM PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_22 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_22 +Originator(s): erik (Erik Kluzek) +Date: Thu Jan 20 13:17:56 MST 2011 +One-line Summary: Move coupler field indicies to clm, move cpl_* directories up a level, add the cpl_share directory + +Purpose of changes: + +Move cpl_* directories up a level, add cpl_shr directory. Update driver, move coupler +field indicies to clm, and allow fields to be passed in driver with just names added to +namelist. Make is_restart() public in clm_time_manager.F90. Fix PTS_MODE. Don't pass +Sl_landfrac to driver in run-phase. + +Bugs fixed (include bugzilla ID): + 1271 (Problem in PTS_MODE with clm) + 1270 (Make is_restart public in clm_time_manager.F90) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1273 (fix pts_mode problem on jaguar) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error in datm8 with partial year forcing) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Change Filepath + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens (most code changes originate from mvertens) + I made some tweaks after the review and added protex header documentation to the + new clm_cpl_indices file. + +List any svn externals directories updated (csm_share, mct, etc.): datm, cism + datm to datm8_110118 + cism to cism1_100913 + +List all files eliminated: + +>>>>>>>>> Move to directories up a level + D models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + D models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + D models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 + +List all files added and what they do: + +>>>>>>>>> Use this local version of indices rather than seq_indices_mod.F90 + A models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 + +>>>>>>>>> Move to directories up a level, use local version of indices rather +>>>>>>>>> than seq_* version and remove sending landfrac at run phase. + A models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + A models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + A models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/doc/README -- Update directory info. + +>>>>>>>>> Change pts_mode test so that RTM is not turned on. + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>> Change Filepath + M models/lnd/clm/bld/configure + +>>>>>>>>> Make is_restart() method public + M models/lnd/clm/src/main/clm_time_manager.F90 + +>>>>>>>>> Fix PTS_MODE. + M models/lnd/clm/src/main/pftvarcon.F90 ------- Pass posNOTonfile=.true. down + to ncd_io methods so won't check for lat/lon + M models/lnd/clm/src/main/ncdio_pio.F90 ------- Add posNOTonfile option to global + reads so that if set, won't try to find nearest lat/lon to PTS_MODE point + (for files that are global data NOT spatial). + M models/lnd/clm/src/biogeophys/SNICARMod.F90 - Pass posNOTonfile=.true. down + to ncd_io methods so won't check for lat/lon + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +>>>>>>>> Test was changed to remove RTM +025 blAK4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_20 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_20 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_20 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_20 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_20 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_20 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_20 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_20 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_20 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_20 +FAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_20 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_20 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_20 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_20 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_20 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_20 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_20 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_20 +>>>>>>>> Compare tests fail because Sl_landfrac is missing on new case +>>>>>>>> Everything else is identical + bluefire/PTCLM testing: All PASS + edinburgh/lf95 interactive testing: All PASS except... +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 + yong/intel interactive testing: +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 +011 smD94 TSM.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +012 erD94 TER.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +013 blD94 TBL.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 4 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_21 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_21 +Originator(s): jedwards (Jim Edwards) +Date: Wed Jan 12 14:50:45 MST 2011 +One-line Summary: Remove includes, finish PIO transition + +Purpose of changes: + +Code cleanup + +Remove misc.h/preproc.h, update SNICARMod to use ncdio_pio calls rather than NetCDF +directly. + +Bugs fixed (include bugzilla ID): + 394 (misc.h and preproc.h NOT used at all anymore) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1271 (Problem in PTS_MODE with clm) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error when a full year isn't available) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Removed generation of files misc.h and preproc.h + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Erik K + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: misc.h, preproc.h + +D models/lnd/clm/tools/mksurfdata/misc.h +D models/lnd/clm/tools/mksurfdata/preproc.h +D models/lnd/clm/tools/mkdatadomain/preproc.h +D models/lnd/clm/tools/mkdatadomain/misc.h + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/tools/mkgriddata/README + models/lnd/clm/tools/mksurfdata/README + models/lnd/clm/tools/mkdatadomain/README + models/lnd/clm/tools/README + models/lnd/clm/bld/configure + models/lnd/clm/bld/clm.cpl7.template + models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 + models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CNGRespMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNFireMod.F90 + models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 + models/lnd/clm/src/biogeochem/CNSummaryMod.F90 + models/lnd/clm/src/biogeochem/CNDVLightMod.F90 + models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 + models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNDVEcosystemDynIniMod.F90 + models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 + models/lnd/clm/src/biogeochem/C13SummaryMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 + models/lnd/clm/src/biogeochem/CNAllocationMod.F90 + models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 + models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 + models/lnd/clm/src/biogeochem/CNSetValueMod.F90 + models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 + models/lnd/clm/src/main/organicFileMod.F90 + models/lnd/clm/src/main/dynlandMod.F90 + models/lnd/clm/src/main/accFldsMod.F90 + models/lnd/clm/src/main/fileutils.F90 + models/lnd/clm/src/main/pftdynMod.F90 + models/lnd/clm/src/main/pft2colMod.F90 + models/lnd/clm/src/main/restFileMod.F90 + models/lnd/clm/src/main/clm_varsur.F90 + models/lnd/clm/src/main/controlMod.F90 + models/lnd/clm/src/main/initSurfAlbMod.F90 + models/lnd/clm/src/main/filterMod.F90 + models/lnd/clm/src/main/clm_varorb.F90 + models/lnd/clm/src/main/initGridCellsMod.F90 + models/lnd/clm/src/main/pftvarcon.F90 + models/lnd/clm/src/main/spmdMod.F90 + models/lnd/clm/src/main/domainMod.F90 + models/lnd/clm/src/riverroute/RunoffMod.F90 + models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 + models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 + models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 + models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 + models/lnd/clm/src/biogeophys/QSatMod.F90 + models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 + models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 + + models/lnd/clm/src/biogeophys/SNICARMod.F90 + models/lnd/clm/src/main/ncdio_pio.F90 + + Removed reference to preproc.h and misc.h in all files. Converted snicarmod to use pio + and added support for a 3d non-decomposed real variable in ncdio. + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +NOTE: pts_mode tests failed... (bug 1271) + bluefire/CESM testing: All PASS + + jaguarpf: All pass except ... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 72+72 arb_ic ..................FAIL! rc= 10 +022 erH92 TER.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 10+38 cold FAIL! rc= 13 +023 brH92 TBR.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 72+72 cold FAIL! rc= 11 +038 smLI2 TSM.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +039 erLI2 TER.sh _sc_dm clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +040 brLI2 TBR.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +041 blLI2 TBL.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 +042 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 +043 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +044 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +045 blL58 TBL.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 48 arb_ic ....................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_19 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +Tag name: clm4_0_20 +Originator(s): erik (Erik Kluzek) +Date: Tue Jan 11 11:18:30 MST 2011 +One-line Summary: Update for ESMF metadata, update doc. from release branch, + bug fixes (doc of qflx_evap_tot, threading CNDV, aer/ndepregrid) + +Purpose of changes: + +Update externals, fix in datm speeds up single-point simulations, update for esmf +metadata capability. Update documentation from Release branch (cesm1_0_rel07_clm4_0_14). +Fix documentation of qflx_evap_tot. Fix ndepregrid/aerdepregrid scripts. Fix threading +problem with CNDV. + +Bugs fixed (include bugzilla ID): + 1266 (Threading problem with CNDV) + 1265 (Fix ndep/aerdepregrid.ncl) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1258 (runinit_ibm.csh needs to be updated) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error when a full year isn't available) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + Small section of clm_driver was moved to a OMP loop. This should + improve threading performance slightly. + +Code reviewed by: self, doc of qflx_evap_tot by Keith Oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, + stubs, datm, csm_share, timing + + scripts to scripts4_110108 + drv to drvseq3_1_47 + sice to stubs1_2_03 + socn to stubs1_2_03 + sglc to stubs1_2_03 + datm to datm8_110106 + csm_share to share3_101231 + timing to timing_101215 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Fix deposition regrid scripts so they will work (from crop04) + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Fix XML queries so will + work, using the datm_internal namelist now + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Fix XML queries so will + work, using stream_fldfilename_ndep in the ndepdyn_nml namelist. + +>>>>>>>>> Fix so will work (from rel07) + M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Fix config options so will work + M models/lnd/clm/bld/config_files/config_definition.xsl ---- Remove extra empty rows + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl Fix missing ">" + +>>>>>>>>> Update documentation (from rel07) + M models/lnd/clm/doc/UsersGuide/single_point.xml - Change how supported single-point + cases are handled and add documentation on setting start/stop times + M models/lnd/clm/doc/UsersGuide/tools.xml -------- Add new options to mksurfdata.pl + add notes about bugs, add notes that aer/ndepregid is optional + M models/lnd/clm/doc/UsersGuide/preface.xml ------ Update what_is_new section + M models/lnd/clm/doc/UsersGuide/clm_ug.xml ------- Add more versions in quicklist + M models/lnd/clm/doc/UsersGuide/appendix.xml ----- Add note about runinit_ibm.csh + problem + M models/lnd/clm/doc/UsersGuide/custom.xml ------- Remove DATM_PRESAERO=none option, + remove hist_crtinic, and use_ndepstream namelist settings + +>>>>>>>>> Update documentation (from rel07) + M models/lnd/clm/doc/KnownLimitations - Add doc on dtlimit error + M models/lnd/clm/doc/KnownBugs -------- Add bug 1168, remove bug 498 + M models/lnd/clm/doc/README ----------- Rework what's new + M models/lnd/clm/doc/index.shtml ------ Add link to KnownLimitations + M README ------------------------------ Rework what's new + +>>>>>>>>> Fix threading problem with CNDV, by adding an OMP loop in a section +>>>>>>>>> in clm_driver that didn't have one, pass down beg/end c|g|p indices +>>>>>>>>> as needed + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 - Pass in begc/endc, begp/endp + M models/lnd/clm/src/main/clm_initializeMod.F90 --- Add OMP loop over setFilters + M models/lnd/clm/src/main/pftdynMod.F90 ----------- Pass down beg/end indices as needed + pftdyn_wbal_init, pftdyn_cnbal, pftwt_interp, + M models/lnd/clm/src/main/filterMod.F90 ----------- Pass clump index down to setFilters + remove OMP from inside + M models/lnd/clm/src/main/clm_driver.F90 ---------- Add OMP loop around section that + wasn't inside an OMP loop + +>>>>>>>>> Fix the documentation of the qflx_evap_tot field + M models/lnd/clm/src/main/clmtype.F90 -------------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 -- Fix qflx_evap_tot doc + +>>>>>>>>> Add component meta-data for ESMF + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - Add meta-data description + of CLM + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 -- Add more arguments to + lnd_register method + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS + bluefire/CESM testing: All PASS + bluefire/PTCLM testing: All PASS + jaguar interactive testing: All PASS except (up to 017 brJ74)... +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic +.............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic +...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + up to.... + +017 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:3600 1x1_tropicAtl test -3+-3 arb_ic .PASS + edinburgh/lf95 interactive testing: All PASS except... +005 smAL4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ....................FAIL! rc= 10 + edinburgh/PTCLM testing: All PASS up to ... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 + mirage,storm/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_19 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_19 +Originator(s): erik (Erik Kluzek) +Date: Wed Dec 8 22:20:30 MST 2010 +One-line Summary: Bring irrigation branch to the trunk + +Purpose of changes: + +Add option for simple code to redirect some riverflow to irrigate generic crops. +Irrigation is turned on at 6AM, runs for 4 hours and keeps soil moisture to 0.7. +Change corn and wheat indices to c3crop and irrigated generic c3 crop. +Add QIRRIG as a history file output. Change pft-physiology and RTM flow files from +ASCII to NetCDF. Single pft-physiology file can handle all cases (has extra FCUR value +for CNDV), also has for new fields for crops that will come in later: corn, spring-wheat, +winter-wheat and soybean. Add findat and fsurdat files for irrigation (f09, f19, f10, finidat +only for f19). Split RTM run method into three and move subroutines around to where makes +more sense. Fix a mksurfdata PFT override bug. Synchronize the Makefiles for the tools +and add build for Darwin intel and PGI and remove Darwin XLF. Remove concurrent +directives and UNICOSMP, CPP_VECTOR, NEC_SX CPP #ifdefs. Remove some #include +misc.h/preproc.h statements. Switch pio_close for ncd_close calls. Replace some constants +with parameters. Remove clm_comp layer and call clm_initialize and clm_driver directly. +Change mk*.F90 subroutines in mksurfdata into modules, so that argument checking will +happen at compile-time. + +Bugs fixed (include bugzilla ID): + 964 (Remove UNICOS #ifdef logic in clm) + 1238 (PST test fails) + 1249 (problem in mksurfdata for PFT override mode) + 1253 (mkglacier in mksurfdata has arguments in wrong order) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add -irrig and -rtm_res options to build-namelist + ++ -irrig Seek surface datasets with irrigation turned on. ++ -rtm_res "resolution" Specify river transport model resolution. + (Still only have half-degree files in the XML database) + + Add new history field: + + QIRRIG water added through irrigation (mm/s) + +List any changes to the defaults for the boundary datasets: NetCDF pft-phys/RTM files + NetCDF PT-physiology file: pft-physiology.c101006.nc + finidat and surfdata files for irrigation (for 1.9x2.5@2000) + surfdata files for irrigation (for f09 and f10) + NetCDF River-direction file: clmi.IQirrcr_2000-01-01_1.9x2.5_gx1v6_c101115.nc + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, slevis, dlawren, wsacks, mvertens, swensosc + slevis/wsacks -- irrigation changes + dlawren -------- convert pft-physiology file to NetCDF + mvertens ------- high level restructuring + swensosc ------- convert RTM flow file to NetCDF + +List any svn externals directories updated (csm_share, mct, etc.): scripts and csm_share + + scripts to scripts4_101206 + csm_share to csm_share3_101122 + +List all files eliminated: + +D models/lnd/clm/src/main/inicFileMod.F90 --------- Move to inicPerpMod +D models/lnd/clm/src/main/clm_comp.F90 ------------ Move to clm_initialize and + clm_driver +D models/lnd/clm/src/main/scam_setlatlonidx.F90 --- Use shr_scam version +D models/lnd/clm/src/main/snowdp2lev.F90 ---------- Move to mkarbinitMod +D models/lnd/clm/src/main/areaMod.F90 ------------- Split out into relavent modules: + celledge -> RtmMapMod + map_setmapsAr -> RmtMapMod + cellarea -> clm_initialize + map_setgatm -> downscaleMod +D models/lnd/clm/test/system/tests_posttag_spot1 -- rename to yong + +D models/lnd/clm/tools/mksurfdata/mkfmax.F90 ---- rename to mkfmaxMod.F90 +D models/lnd/clm/tools/mksurfdata/mkvocef.F90 --- rename to mkvocefMod.F90 +D models/lnd/clm/tools/mksurfdata/mkglacier.F90 - put in mkglcmecMod.F90 +D models/lnd/clm/tools/mksurfdata/mklanwat.F90 -- rename to mklanwatMod.F90 +D models/lnd/clm/tools/mksurfdata/mkelev.F90 ---- put in mkurbanparMod.F90 +D models/lnd/clm/tools/mksurfdata/mkurban.F90 --- put in mkurbanparMod.F90 +D models/lnd/clm/tools/mksurfdata/mksoitexMod.F90 rename to mksoilMod.F90 + +List all files added and what they do: + +A + models/lnd/clm/test/system/nl_files/clm_irrig -- New irrigation test + +>>>>>>>>>>> Some high level restructuring/renames +A + models/lnd/clm/src/main/inicPerpMod.F90 -------- From inicFileMod +A + models/lnd/clm/src/riverroute/RtmMapMod.F90 ---- From areaMod.F90 +A models/lnd/clm/test/system/tests_posttag_yong -- rename add more tests + +>>>>>>>>>>> Rename mksurfdata subroutines into modules +A models/lnd/clm/tools/mksurfdata/mkfmaxMod.F90 +A models/lnd/clm/tools/mksurfdata/mksoilMod.F90 +A models/lnd/clm/tools/mksurfdata/mkvocefMod.F90 +A models/lnd/clm/tools/mksurfdata/mklanwatMod.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Add irrigation "AZ" tests at 10x15 with irrigation on +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_pretag_edinburgh +M models/lnd/clm/test/system/tests_pretag_jaguar_nompi +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/tests_posttag_intrepid_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi -- Remove repeated test + +M models/lnd/clm/test/system/README.testnames --- Add Z res (10x15 with irrig) +M models/lnd/clm/test/system/test_driver.sh ----- Changes for lynx and yong + +>>>>>>>>>>> Fix bug 1249 for PFT overrides, correct irrigation sample namelist +>>>>>>>>>>> Change subroutines into modules for mk*.F90 files (allows compiler to check args) +>>>>>>>>>>> Fix bug 1253 putting mksoitex call after mkglacier +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig - Correct name of irrigation dataset +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 nullify pctpft_i +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 Set nlat_i/nlon_i to 1 if PFT override +M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 -- Add mkglacier subroutine +M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 Add mkurban and mkelev subroutines +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ----- Change subroutines into modules + nullify pctpft_i, put mksoitex call after mkglacier +M models/lnd/clm/tools/mksurfdata/Srcfiles --------- Change names of files +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ----- Add mkirrig subroutine + + +>>>>>>>>>>> Sync up the tools Makefiles and add darwin intel and pgi build (remove darwin xlf) +M models/lnd/clm/tools/mksurfdata/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/interpinic/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/mkgriddata/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/mkdatadomain/Makefile -- Sync up makefiles, add darwin build + +>>>>>>>>>>> Add -irrig and -rtm_res options, update files to new NetCDF versions, +>>>>>>>>>>> add in findat/fsurdat files for irrigation (f19,f10, f09) +M models/lnd/clm/bld/build-namelist ----- Add -irrig, -rtm_res options + set do_budgets, and budget_inst in drv_namelist, finidat/fsurdat depend on irrig + set create_crop_landunit by irrig +M models/lnd/clm/bld/clm.cpl7.template -- Set CLM_RTM_RES to half-degree and pass + to build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ add irrig and rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml default for irrig and rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---- New NetCDF + pft-physiology file (for all configs), finidat and fsurdat files check + irrig, f19, f10, and f09 surfdata files for irrigation (and f19 finidat) + defaults for create_croplandunit, new NetCDF RTM direction file +M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ---- Set do_budgets + to .true. and budget_inst to 1. + +>>>>>>>>>>> Remove concurrent directives and misc.h/preproc.h #includes +>>>>>>>>>>> Remove scam_setlatlonidx and use shr_scam_. +>>>>>>>>>>> Switch ncorn for nc3crop and nwheat for nirrig change pio_close for ncd_close +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 -------- Remove concurrent directives + remove misc.h/preproc.h #includes +M models/lnd/clm/src/biogeochem/CASAMod.F90 ----------- Change pio_closefile to + ncd_pioclosefile +M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 - Remove directives +M models/lnd/clm/src/biogeochem/DUSTMod.F90 ----------- Remove directives +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 ncorn->nc3crop, + use shr_scam_getCloseLatLon in place of scam_setlatlonidx, + Remove directives, switch pio_close with ncd_pio_closefile +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ------- Remove directives and #includes +M models/lnd/clm/src/biogeochem/CNDVMod.F90 ----------- Switch pio_plosefile with ncd_close +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ---- ncorn->nc2crop +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ---- ncorn->nc3crop, nwheat->nirrig + and remove #includes +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 ncorn->nc3crop, nwheat->nirrig + and remove #includes + +>>>>>>>>>>> Remove concurrent directives and misc.h/preproc.h #includes +>>>>>>>>>>> Remove scam_setlatlonidx and use shr_scam_. +>>>>>>>>>>> Switch ncorn for nc3crop and nwheat for nirrig change pio_close for ncd_close +M models/lnd/clm/src/main/clm_varcon.F90 ------- Add degpsec, isecspday, + and remove #includes +M models/lnd/clm/src/main/clm_varpar.F90 ------- Remove #includes, add ivis/inir + indices, and make rtmlat/rtmlon variables not parameters +M models/lnd/clm/src/main/CNiniTimeVar.F90 ----- Remove directives, and #includes, + add qflx_irrig +M models/lnd/clm/src/main/abortutils.F90 ------- Remove directives, and #includes + and NEC_SX, and UNICOSMP CPP defines +M models/lnd/clm/src/main/accumulMod.F90 ------- Remove directives +M models/lnd/clm/src/main/decompInitMod.F90 ---- Remove UNICOSMP CPP defines +M models/lnd/clm/src/main/clm_initializeMod.F90 Move cellarea from areaMod to here + work with downscale a bit, add stuff from clm_comp init to here +M models/lnd/clm/src/main/clmtypeInitMod.F90 --- Add irrig_rate and n_irrig_steps_left +M models/lnd/clm/src/main/iniTimeConst.F90 ----- Switch pio_close with ncd_close, + add single-column read for PCT_CLAY, switch 86400 for secspday +M models/lnd/clm/src/main/histFileMod.F90 ------ Remove UNICOSMP, switch pio_close + with ncd_close +M models/lnd/clm/src/main/restFileMod.F90 ------ Switch pio_close with ncd_close +There's also a new driver namelist setting that will update the orbit each year +(setting orb_mode and orb_iyear_align). + +Bugs fixed (include bugzilla ID): + 1225 (abort if both trigrid and finemesh on) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1238 (PST test fails) + 1239 (ESMF build fails) + 1240 (lynx_pgi build fails) + 1249 (problem in mksurfdata for PFT override mode) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Add in darwin_intel build + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: Add in T341 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, + csm_share, pio, mct, cprnc + + scripts to mpiserial07_scripts4_101117 + drv to drv3_1_45 + datm to datm8_101105 + csm_share to share3_101118 + pio to pio1_2_6 + mct to MCT2_7_0_100228-mpiserial101109_tag02 + cprnc to cprnc_101119 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/tests_pretag_jaguar - remove non-existant tests + +>>>>>>>>>> Remove clmi frequency setting, add darwin build/run + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/TBR.sh + M models/lnd/clm/test/system/test_driver.sh - Add darwin builds + M models/lnd/clm/test/system/mknamelist + +>>>>>>>>>> Change orb_iyear for orb_iyear_ad + M models/lnd/clm/test/system/nl_files/nl_urb + M models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + M models/lnd/clm/test/system/nl_files/clm_ndepdyn -- remove ndepsrc stream setting + Can now replace usage of this file with clm_std + M models/lnd/clm/test/system/nl_files/nl_cn_conly + M models/lnd/clm/test/system/nl_files/nl_urb_br + +>>>>>>>>>> Get build working with darwin_intel + M models/lnd/clm/bld/configure ------ get it working with darwin_intel + M models/lnd/clm/bld/clm.cpl7.template - Use $GMAKE, set to gmake if not set + +>>>>>>>>>> Remove non-existant resolution: 2.5x3.33 + M models/lnd/clm/bld/namelist_files/checklatsfiles.ncl + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl + +>>>>>>>>>> Add orb_mode, set orbit based on it, also add orb_iyear_align +>>>>>>>>>> Add run_barriers, pio_inparm namelist, add T341 resolution (512x1024) + M models/lnd/clm/bld/build-namelist - Set orbit based on orb_mode, set pio namelist + for stand-alone testing, + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Remove pio namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/datm-build-namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Add T341: griddata, + fracdata, surfdata, topodata (fracdata for USGS and tx0.1 masks)` + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml + +>>>>>>>>>> Switch orb_iyear for orb_iyear_ad + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +>>>>>>>>>> Switch ncd_x for pio_x/nf_x +>>>>>>>>>> Fix a couple memory leaks that Jim Edwards found +>>>>>>>>>> Make ncd_pio private, add documentation add attributes for restart history +>>>>>>>>>> files, add 2D character read (needed for NetCDF pft-physiology file read on +>>>>>>>>>> irrigation branch) + M models/lnd/clm/src/biogeochem/CASAMod.F90 ------------ Replcae pio_x + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - use masterproc at top of module + M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------------ Replace pio_x + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ---------- Replace pio_x + M models/lnd/clm/src/main/inicFileMod.F90 -------------- Add use MPI_LOGICAL + M models/lnd/clm/src/main/accumulMod.F90 --------------- Replace pio_x + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Remove samegrids use downscale, + don't pass namelist to ncd_pio initialization + M models/lnd/clm/src/main/subgridRestMod.F90 ----------- Add use endrun, switch ncd_x for nf_x + M models/lnd/clm/src/main/ndepStreamMod.F90 ------------ PIO initialization uses + driver settings, pass get_calendar to initialization + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add attributes to history restart files + M models/lnd/clm/src/main/restFileMod.F90 -------------- Replace pio_x + M models/lnd/clm/src/main/clm_time_manager.F90 --------- Replace nf_x with ncd_x add + get_calendar + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ----- Abort if trigrid and downscale + Update orbit params in run-phase + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Remove samegrids + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 --- Abort if trigrid and downscale + Update orbit params in run-phase + M models/lnd/clm/src/main/ncdio_pio.F90 ---------------- Update documentation, make private + add ncd_pio_closefile wrapper, make some pio interfaces public from here, + add ncd_io_char_var2_nf for NetCDF pft-physiology file, remove pio namelist + remove a second allocation that Jim Edwards found + M models/lnd/clm/src/main/surfrdMod.F90 ---------------- Fix memory leak from Jim Edwards + M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Switch nf_x with ncd_x + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 -- Add use for spval and iulog, + change nf_x for ncd_x + +Summary of testing: + +All TBL tests fail... (although you can use clm4_0_16 with updated externals and show b4b) + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS + bluefire/CESM testing: +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_16 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_16 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_16 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_16 +FAIL PST.f45_g37.I1850.bluefire <<<<< Didn't create scripts problem, bug 1238 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_16 +FAIL ERS_E.f19_g16.I1850.bluefire <<<< Scripts build issue, bug 1239 +BFAIL ERS_E.f19_g16.I1850.bluefire.generate.clm4_0_17 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_16 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_16 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_16 +FAIL PST.f10_f10.I8520CN.bluefire <<<<< Didn't create scripts problem, bug 1238 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_16 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_16 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_16 + bluefire/PTCLM testing: All PASS + jaguar: All PASS except... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 72+72 arb_ic ..................FAIL! rc= 13 +022 erH92 TER.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 10+38 cold FAIL! rc= 13 +023 brH92 TBR.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 72+72 cold FAIL! rc= 11 +038 smLI2 TSM.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +039 erLI2 TER.sh _sc_dm clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +040 brLI2 TBR.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +042 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 +043 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +044 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 + jaguar interactive testing: All PASS except... +007 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +008 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +009 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS + edinburgh/lf95 testing: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 96 arb_ic .................FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 10+38 arb_ic ..............FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:1800 4x5 gx3v7 72+72 arb_ic ...........FAIL! rc= 5 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:1800 10x15 USGS 96 arb_ic .......................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:1800 10x15 USGS 10+38 arb_ic ....................FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 96 cold ..FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 5 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 + edinburgh/PTCLM testing: All PASS up to... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 + mirage,storm/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + lynx/pgi testing: All FAIL scripts build issue <<<< bug 1240 + yong/darwin_intel testing: All PASS up to ... +005 smD94 TSM.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_16 + + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All with datm + - what platforms/compilers: All + - nature of change: roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + PERGRO test on bluefire + +=============================================================== +=============================================================== +Tag name: clm4_0_16 +Originator(s): erik/mvertens (Kluzek Erik 1326 CGD) (Vertenstein Mariana 1349 CGD) +Date: Wed Oct 27 13:33:21 MDT 2010 +One-line Summary: Fix downscaling roundoff difference for same-grids by copying scale factor when needed + +Purpose of changes: + +Fix bug 1230, that caused problems with runoff to the ocean when running fully coupled. The global integrals of runoff fields +was the same in the coupler -- but the values where roundoff different. This caused problems both in testing for bit-for-bit with +the previous version and with restarts. The problem was that in the downscaling changes made in clm4_0_15 the areal scaling factor +asca needed to be copied from adomain into ldomain is no downscaling is taking place. + +Bugs fixed (include bugzilla ID): +=============================================================== +Tag name: clm4_0_14 +Originator(s): erik (Erik Kluzek) +Date: Tue Oct 19 13:12:36 MDT 2010 +One-line Summary: Fix finidat file for T31 sim_year=2000 cases + +Purpose of changes: + +Remove the 1850 T31 finidat file for sim_year=2000 and use the previous sim_year=2000 +files (created using interpinic). Update scripts and datm. + +Bugs fixed (include bugzilla ID): Correct finidat file for T31 sim_year=2000 + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1249 (problem in mksurfdata for PFT override mode) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Go back to T31,sim_year=2000 +finidat file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and datm + + scripts to mpiserial05_scripts4_101018 + datm to datm8_101008 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Return to old + finidat file for T31 sim_year=2000 +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - change + fearedep to datm_file_aero + +Summary of testing: + + bluefire/CESM testing: +PASS SMS_D.T31_g37.I1850CN.bluefire +PASS SMS_D.T31_g37.ICN.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm4_0_13 + +Changes answers relative to baseline: T31 2000 cases + +=============================================================== +=============================================================== +Tag name: clm4_0_13 +Originator(s): erik (Erik Kluzek) +Date: Sat Oct 16 09:14:08 MDT 2010 +One-line Summary: Bring in PTCLM branch, add in T31 finidat file and turn off ice_runoff for T31 + +Purpose of changes: + +Bring in PTCLM work. Update externals for scripts, datm, drv. Get mksurfdata to have options to override soil/PFT with user input values. Fix some issues with getregional_datasets.pl. Remove old stand-alone CLM Makefile (always use CESM Macro's files and Makefile). More removal of ndepsrc in build-namelist. Turn off ice_runoff for T31. Add in T31 finidat file. + +Bugs fixed (include bugzilla ID): + 1189 (Create ability to change soil color/texture in mksurfdata) + 1188 (Add ability to handle control transient land-cover change) + 1206 (Problem looping over a single year of CPLHIST forcing) + 1211 (Small memory leak in CLM4 initialization) + 1223 (ESMF problem) +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1249 (problem in mksurfdata for PFT override mode) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: + + Remove custom options to stand-alone build/test, require using cesm make files + +Describe any changes made to the namelist: None, although many new options to mksurfdata namelist + +List any changes to the defaults for the boundary datasets: New T31 finidat files + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + + drv to drvseq3_1_37 + datm to datm8_100921 + csm_share to share3_101001 + scripts to PTCLM03_scripts4_101005 + +List all files eliminated: + + R models/lnd/clm/test/system/tests_posttag_breeze >>> rename to mirage +>>>>>>>>>>> Rename to module + R models/lnd/clm/tools/mksurfdata/mkglcmec.F90 + R models/lnd/clm/tools/mksurfdata/mksoicol.F90 + R models/lnd/clm/tools/mksurfdata/mksoitex.F90 + + R models/lnd/clm/bld/config_files/Makefile.in --- Remove always use CESM make + +List all files added and what they do: + +>>>>>>>>>>> Renames + A models/lnd/clm/test/system/tests_posttag_mirage + A models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 + A models/lnd/clm/tools/mksurfdata/mksoitexMod.F90 + A models/lnd/clm/tools/mksurfdata/mksoicolMod.F90 + +>>>>>>>>>>> Namelist settings for standard urban single-point + A models/lnd/clm/bld/namelist_files/use_cases/stdurbpt.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Remove PTS_MODE restart/branch tests + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_posttag_spot1 --------- remove hybrid test + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>> Change breeze+ for mirage changes for new build that requires CESM build files + M models/lnd/clm/test/system/TCB.sh -------------------- Set nc_path + M models/lnd/clm/test/system/config_files/_nrmexsc_ds -- Use -sitespf_pt + M models/lnd/clm/test/system/config_files/_nrvansc_ds -- Use -sitespf_pt + M models/lnd/clm/test/system/test_driver.sh ------------ Swap out mirage/storm for breeze+, add GEN machine options, remove CLM_CESMBLD + M models/lnd/clm/test/system/mknamelist ---------------- Use config_file variable + M models/lnd/clm/test/system/TSMscript_tools.sh -------- Add exedir + M models/lnd/clm/test/system/CLM_runcmnd.sh ------------ Add more options for yong, change breeze+ to mirage/storm + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 ------ Add exedir + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 - Add exedir + +>>>>>>>>>>> Add new options to override dataset setttings with your own values for: soil color/texture, and PFT + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 ----- Make private + M models/lnd/clm/tools/mksurfdata/mkglacier.F90 ---- Add option to zero out glacier + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 - Add mkharvest_parse_oride to override harvesting + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ---- Move nglcec here + M models/lnd/clm/tools/mksurfdata/mklanwat.F90 ----- Add option to zero out lake + M models/lnd/clm/tools/mksurfdata/mkurban.F90 ------ Add option to zero out urban + M models/lnd/clm/tools/mksurfdata/mkvarsur.F90 ----- Make private + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ----- Add new namelist options: soil_color, soil_sand, soil_clay, pft_idx, pft_frc + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ----- Add init and override methods: mkpftInit, mkpft, and mkpft_parse_oride + M models/lnd/clm/tools/mksurfdata/Filepath --------- Add esmf_wrf_timemgr to directory list + M models/lnd/clm/tools/mksurfdata/Srcfiles --------- Change names, add shr_cal_mod, shr_string_mod, and ESMF files + + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---- Add new options to override your own values, and error check the input: ++ -dynpft "filename" Dynamic PFT/harvesting file to use ++ (rather than create it on the fly) ++ (must be consistent with first year) ++ -exedir "directory" Directory where mksurfdata program is ++ (by default assume it's in the current directory) ++OPTIONS to override the mapping of the input gridded data with hardcoded input ++ ++ -pft_frc "list of fractions" Comma delimited list of percentages for veg types ++ -pft_idx "list of veg index" Comma delimited veg index for each fraction ++ -soil_cly "% of clay" % of soil that is clay ++ -soil_snd "% of sand" % of soil that is sand + +>>>>>>>>>>> Start fixing some issues with getregional scripts +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl + +>>>>>>>>>>> Add USER_FCTYP + M models/lnd/clm/tools/mksurfdata/Makefile + M models/lnd/clm/tools/interpinic/Makefile + M models/lnd/clm/tools/mkgriddata/Makefile + M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>> Remove stand-alone user options and require cesm_bld, add ice_runoff run_stopdate, and new finidat files for T31, more ndepmapalgo defaults +>>>>>>>>>>> Change stop_n values for urban single-point so will run to completion + M models/lnd/clm/bld/configure --------------- Remove options: test, cc, cflags, fc, fflags, fopt, gmake, ldflags, linker, mpi/nc_inc/_lib + add nc_path and mpi_path options, require cesm_bld, and remove logic for doing + clm-stand-alone build + M models/lnd/clm/bld/queryDefaultNamelist.pl - Check for valid values, add list options, + M models/lnd/clm/bld/queryDefaultXML.pm ------ Change a comment + M models/lnd/clm/bld/build-namelist ---------- Add setting of ice_runoff + M models/lnd/clm/bld/config_files/config_sys_defaults.xml --- Set more default machine names + M models/lnd/clm/bld/config_files/config_definition.xml ----- Remove compiler options above and add nc_path/mpi_path + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add run_stopdate and work on comments + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add ice_runoff defaults, new finidat files for T31, add more ndepmapalgo defaults + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Change stop_n for urban single-point, add stop_date + + M models/lnd/clm/doc/UsersGuide/preface.xml - Change comment + +>>>>>>>>>>> Fix two code bugs (1211 and 1223) + M models/lnd/clm/src/main/iniTimeConst.F90 ------------ make sure to deallocate memory + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 -- add use statement needed for endrun + +Summary of testing: + + bluefire testing: All PASS except.. (up to 054 smI59) +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS except.. +061 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 6 + bluefire/CESM testing: All PASS except +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_11 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_11 + jaguar interactive testing: All PASS except... +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 10 +007 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +008 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +009 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/lf95 interactive testing: All PASS + mirage/storm.intel interactive testing: ALL PASS up to... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_12 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_12 +Originator(s): erik (Erik Kluzek) +Date: Fri Sep 10 13:07:03 MDT 2010 +One-line Summary: Add U10 to history, cesm1_0_rel06 updates, PTCLM02 updates (except + mksurfdata), remove ndepdat/dyn/faerdep + +Purpose of changes: + +Update to latest cesm1 release branch. Change SPMD from spmd to use_mpiserial in +configure. Remove old aerdep and ndepdat/dyn files from code and scripts. Change ccsm in +scripts to cesm. Add in new U10 field to history files, change old name to U10_DUST. Some +updates from PTCLM branch for XML database. Also perturb initial conditions read in from +initial file by pertlim. With with PERGRO CPP #ifdef a bit. Start adding in testing on +lynx. + +Bugs fixed (include bugzilla ID): + 1199 (Add trusted machine history file for PERGRO analysis) + 1196 (Add urban option to configure, delete GRANDVIEW ifdefs) + 1191 (UG documentation for single-point needs to change que to shared-que) + 1167 (Add note about reducing PE's for single-point mode) + 1115 (Make config_definition names the same as configure options) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1206 (Problem looping over a single year of CPLHIST forcing) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1147 (mkgriddata can't straddle over Greenwich) + +Type of tag: std-test + +Describe any changes made to build system: + Names of configure modes changed: seq_ccsm to clm_stndln, and ext_ccsm_seq to ext_cesm + Add sitespf_pt option which will set either MEXICOCITY or VANCOUVER cpp ifdefs + Names of some configure options changed to make consistent with config_definition file. + +Describe any changes made to the namelist: Remove use_ndepstream/fndepdat/fndepdyn/faerdep + +List any changes to the defaults for the boundary datasets: + + New 10x15 rcp6 transient 1850-2100 pftdyn dataset + Add navy oro file to clm_tools XML file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, U10 code from Keith Oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts and datm + scripts to scripts4_100901a + datm to datm8_100830 + +List all files eliminated: + + D models/lnd/clm/src/main/aerdepMod.F90 + D models/lnd/clm/src/main/ndepFileMod.F90 + D models/lnd/clm/tools/ncl_scripts/convertUrbanOffline2Seq.ncl + D models/lnd/clm/tools/ncl_scripts/getndepdatFrom20thCentury.ncl + D models/lnd/clm/tools/mkgriddata/mkgriddata.ccsm_dom -- Rename to .cesm_dom + D models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all files added and what they do: + +>>>>>>>>>> Transient test files for rcp2.6 and rcp4.5, start adding lynx testing + A models/lnd/clm/test/system/nl_files/clm_transient_rcp2.6 + A models/lnd/clm/test/system/nl_files/clm_transient_rcp4.5 + A models/lnd/clm/test/system/tests_posttag_lynx + A models/lnd/clm/test/system/tests_posttag_lynx_nompi + +>>>>>>>>>> Sample perturbation growth data for jaguar, intel and lahey + A models/lnd/clm/tools/ncl_scripts/RMSjaguar.dat + A models/lnd/clm/tools/ncl_scripts/RMSintel.dat + A models/lnd/clm/tools/ncl_scripts/RMSlahey.dat + + A models/lnd/clm/tools/mkgriddata/mkgriddata.cesm_dom - rename from .ccsm_dom + +>>>>>>>>>> Plot of sample bad perturbation error growth + A models/lnd/clm/doc/UsersGuide/badpergro.jpg + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Change ccsm_seq=>clm_stndln, spmd=>nouse_mpiserial + M models/lnd/clm/test/system/config_files/_nrsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_nrsc_ds + M models/lnd/clm/test/system/config_files/17p_scnv_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_m + M models/lnd/clm/test/system/config_files/_scnv_dh + M models/lnd/clm/test/system/config_files/_nrsc_dm + M models/lnd/clm/test/system/config_files/17p_cndvsc_o + M models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/_nrsc_do + M models/lnd/clm/test/system/config_files/_persc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_s + M models/lnd/clm/test/system/config_files/_nrsc_ds + M models/lnd/clm/test/system/config_files/_scnv_do + M models/lnd/clm/test/system/config_files/_persc_dm + M models/lnd/clm/test/system/config_files/_persc_do + M models/lnd/clm/test/system/config_files/4p_vodsrsc_dh + M models/lnd/clm/test/system/config_files/_persc_ds + M models/lnd/clm/test/system/config_files/_nrmexsc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_dm + M models/lnd/clm/test/system/config_files/_nrcnsc_do + M models/lnd/clm/test/system/config_files/17p_sc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_do + M models/lnd/clm/test/system/config_files/_mec10sc_dm + M models/lnd/clm/test/system/config_files/_nrcnsc_ds + M models/lnd/clm/test/system/config_files/4p_casasc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_ds + M models/lnd/clm/test/system/config_files/17p_sc_dm + M models/lnd/clm/test/system/config_files/_mec10sc_do + M models/lnd/clm/test/system/config_files/17p_sc_do + M models/lnd/clm/test/system/config_files/_sc_dh + M models/lnd/clm/test/system/config_files/_mec10sc_ds + M models/lnd/clm/test/system/config_files/4p_casasc_dm + M models/lnd/clm/test/system/config_files/4p_casasc_do + M models/lnd/clm/test/system/config_files/17p_sc_ds + M models/lnd/clm/test/system/config_files/_sc_dm + M models/lnd/clm/test/system/config_files/4p_casasc_ds + M models/lnd/clm/test/system/config_files/_nrsc_s + M models/lnd/clm/test/system/config_files/_sc_do + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_m + M models/lnd/clm/test/system/config_files/_sc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/_nrvansc_ds + M models/lnd/clm/test/system/config_files/17p_sc_h + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/4p_casasc_h + M models/lnd/clm/test/system/config_files/17p_sc_m + M models/lnd/clm/test/system/config_files/17p_sc_o + M models/lnd/clm/test/system/config_files/_sc_h + M models/lnd/clm/test/system/config_files/4p_casasc_m + M models/lnd/clm/test/system/config_files/4p_casasc_o + M models/lnd/clm/test/system/config_files/_sc_m + M models/lnd/clm/test/system/config_files/17p_vodsrsc_h + M models/lnd/clm/test/system/config_files/17p_cndvsc_dh + M models/lnd/clm/test/system/config_files/_sc_o + M models/lnd/clm/test/system/config_files/17p_vodsrsc_m + M models/lnd/clm/test/system/config_files/_sc_s + M models/lnd/clm/test/system/config_files/17p_cndvsc_dm + M models/lnd/clm/test/system/config_files/17p_vodsrsc_o + M models/lnd/clm/test/system/config_files/17p_cndvsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/17p_vodsrsc_dh + M models/lnd/clm/test/system/config_files/_scsnf_dh + M models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + M models/lnd/clm/test/system/config_files/17p_vodsrsc_dm + M models/lnd/clm/test/system/config_files/_scsnf_dm + M models/lnd/clm/test/system/config_files/17p_vodsrsc_do + M models/lnd/clm/test/system/config_files/4p_vodsrsc_h + M models/lnd/clm/test/system/config_files/_scsnf_do + M models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_h + M models/lnd/clm/test/system/config_files/4p_vodsrsc_o + M models/lnd/clm/test/system/config_files/_mec10sc_m + M models/lnd/clm/test/system/config_files/_mec10sc_o + M models/lnd/clm/test/system/config_files/17p_scnv_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_h + M models/lnd/clm/test/system/config_files/README --- seq-ccsm=>standalone clm + +>>>>>>>>>> Change comments of CCSM to CESM, start adding in test support of lynx, convert +>>>>>>>>>> SPMD to NOUSE_MPISERIAL, change mode name of seq_ccsm to clm_stndln, add tests +>>>>>>>>>> for more rcp's. + M models/lnd/clm/test/system/TCB.sh ------------- CCSM_MACH=>CESM_MACH, ccsm_bld=>cesm_bld + M models/lnd/clm/test/system/README.testnames --- Change ccsm=>cesm, seq_ccsm=>clm_stndln + M models/lnd/clm/test/system/test_driver.sh ----- Change CLM_CCSMBLD=>CLM_CESMBLD, + Start adding lynx. + M models/lnd/clm/test/system/input_tests_master - Add HX and HY tests, ccsm=>cesm + M models/lnd/clm/test/system/README ------------- CLM_CCSMBLD=>CLM_CESMBLD + M models/lnd/clm/test/system/CLM_runcmnd.sh ----- NOSPMD=>NOUSE_MPISERIAL + +>>>>>>>>>> Change comments from ccsm to cesm, change namelist to get faerdep file from, +>>>>>>>>>> work on pergro plot so can plot more graphs. + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl --- ccsm=>cesm, + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl -- ccsm=>cesm, + get aerdep file from clmexp clm_tool namelist + M models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat ---- New data + M models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat ---- New data + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl --- Get from clmexp namelist + M models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl ----- Add ability to plot up to + five files, make sure lines are different, add success line to end. + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Do some operations with + out meta-data to save time and remove warnings + M models/lnd/clm/tools/ncl_scripts/README --------- Change ccsm=>cesm and improve + M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Change ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/mkvarctl.F90 ---- Correct documentation, ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 -- ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/README ---------- ccsm=>cesm + M models/lnd/clm/tools/mkdatadomain/addglobal.F90 - ccsm=>cesm + +>>>>>>>>>> Changes comments of ccsm to cesm, add sitespf_pt config option, remove +>>>>>>>>>> -ndepsrc, add ndepmapalgo, switch prog_seasalt for progsslt, spmd for +>>>>>>>>>> nouse_mpiserial, change names of modes + M models/lnd/clm/bld/configure ---------------- ccsm=>cesm, +sitespf_pt, + prog_seasalt=>progsslt, spmd=>nouse_mpiserial, modes changed to + ext_cesm, and clm_stndln, remove setting of SPMD cppdef + M models/lnd/clm/bld/queryDefaultNamelist.pl -- ccsm=>cesm + M models/lnd/clm/bld/queryDefaultXML.pm ------- Remove ability to use cam config + file, spmd=>nouse_mpiserial + M models/lnd/clm/bld/build-namelist ----------- ccsm=>cesm, remove -ndepsrc, + add rcp to some settings, ccsm_seq=>clm_stndln, set start_ymd from + runstart_date, add settings of ndepmapalgo, remove fndepdat/dyn/faerdep + M models/lnd/clm/bld/clm.cpl7.template -------- Remove -spmd, mode now ext_cesm, + ccsm=>cesm + M models/lnd/clm/bld/README ------------------- CCSM=>CESM + M models/lnd/clm/bld/config_files/Makefile.in - SPMD=>NOUSE_MPISERIAL, ccsm=>cesm + M models/lnd/clm/bld/config_files/config_definition.xsl --- Titles to caption, + put valid_values under description + M models/lnd/clm/bld/config_files/config_sys_defaults.xml - spmd=>nouse_mpiserial + M models/lnd/clm/bld/config_files/config_definition.xml --- +sitespf_pt, + comp_interface=>comp_intf, ccsm=>cesm, spmd=>nouse_mpiserial, mode + valid values are: ext_cesm, clm_stndln + +>>>>>>>>>> Remove ndepsrc/usr_ndepstream/fndepdat/fndepdyn/faerdep add mksrf_navyoor +>>>>>>>>>> Change comments from ccsm to cesm, exchange run_startdate for start_ymd, add +>>>>>>>>>> ndepmapalo, add stop_option/stop_n settings for spinup modes + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Remove + ndepsrc/use_ndepstream/fndepdat/dyn/faerdep, ccsm=>cesm, add mksrf_navyoro, + run_startdate, faerdep and fndepdat for aerdepregrid/ndepregrid tools, + add 0.33x0.33 resolution for navyoro file + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Remove + ndepsrc add defaults when sitespf_pt is set + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ rcp6 datm_presaero + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----------- Add sitespf_pt + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --------- Headers to captions + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- ccsm=>cesm + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- ccsm=>cesm, + remove use_ndepstream, faerdep, fndepdat, fndepdyn + add ndepmapalgo + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add navy oro + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Add + stop_option/stop_n for spinup modes, change start_ymd for run_startdate + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add ndepmapalgo + +>>>>>>>>>> Change config mode names (from ccsm_seq to clm_stndln), remove ndepsrc, +>>>>>>>>>> remove start_ymd, clm_demand just sets fpftdyn (fndepdat/dyn removed) + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/glacier_mec.xml ----- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml ---- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml - mode + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml - mode + changes to clm_stndln, clm_demand just sets fpftdyn remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml --- mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml -- Also output TSA + M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml - Also output TSA + +>>>>>>>>>> Change so any scripts calls start with "./", ccsm=>cesm, remove ndepsrc +>>>>>>>>>> Use macro for PTS_MODE, use .submit rather than .run scripts. +>>>>>>>>>> Add bit about managing your data with link_dirtree, add more notes and +>>>>>>>>>> examples for PERGRO testing, add more notes about using batch for single-pt +>>>>>>>>>> mode + M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml -- Add more about ccsm log file + M models/lnd/clm/doc/UsersGuide/config_cache.xml ------ Update from configure + M models/lnd/clm/doc/UsersGuide/single_point.xml ------ Add section on which mode + Add warning about single-point on batch machines, remove warning about + error that was fixed, remove notes about setting ndepsrc + M models/lnd/clm/doc/UsersGuide/special_cases.xml ----- Use .submit, add notes + about using provided history files from bluefire for PERGRO testing, and + add bit about TSA as well as TSOI, add more machines and examples of + bad pergro for PERGRO examples. + M models/lnd/clm/doc/UsersGuide/tools.xml ------------- Remove ndepsrc stuff + M models/lnd/clm/doc/UsersGuide/preface.xml ----------- Talk about very latest updates. + remove bit about PERGRO not validated + M models/lnd/clm/doc/UsersGuide/clm_ug.xml ------------ Update version, remove bug fix + M models/lnd/clm/doc/UsersGuide/appendix.xml ---------- + M models/lnd/clm/doc/UsersGuide/adding_files.xml ------ Add bit about managing your + data when you use link_dirtree, update table, remove ndepsrc + M models/lnd/clm/doc/UsersGuide/custom.xml ------------ Remove bit about rcp experimental + comment out tables that cause docbook to fail with a seg fault. + M models/lnd/clm/doc/UsersGuide/pergro.jpg ------------ New data + M models/lnd/clm/doc/UsersGuide/Makefile -------------- Remove vandif bug fix + M models/lnd/clm/doc/Quickstart.userdatasets ---------- Shorten lines remove faerdep + correct procedure + M models/lnd/clm/doc/Quickstart.GUIDE ----------------- Use .submit script + M models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl - Change tables from + informal to formal, using captions for titles, add template for bold. + +>>>>>>>>>> Changes comments for CCSM to CESM, remove misc.h and preproc.h #includes +>>>>>>>>>> Remove use_ndepstream/fndepdat/fndepdyn/faerdep/set_*dep_from_file +>>>>>>>>>> Add u10_clm and va, add ability to perturb IC from startup finidat file + M models/lnd/clm/src/biogeochem/DUSTMod.F90 ----- CCSM=>CESM, remove misc/preproc.h + M models/lnd/clm/src/main/clm_comp.F90 ---------- CCSM=>CESM + M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove use_ndepstream logic + hardwire it to on + M models/lnd/clm/src/main/clm_glclnd.F90 -------- CCSM=>CESM + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Add u10 and va + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Rm set_caerdep_from_file/dustdep + M models/lnd/clm/src/main/controlMod.F90 -------- Rm fndepdat, fndepdyn, + use_ndepstream, faerdep, ccsm=>cesm + M models/lnd/clm/src/main/clm_time_manager.F90 -- ccsm=>cesm, remove misc/preproc.h + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- lnd_chkAerDep_mct just + aborts if aerosols NOT sent from atm. + M models/lnd/clm/src/main/clm_driver.F90 ------------- Rm aerdep and old ndep interpoaltion + M models/lnd/clm/src/main/clm_varctl.F90 ------------- Rm set_caerdep_from_file/dustdep, + faerdep, fndepdat, fndepdyn, use_ndepstream + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - lnd_chkAerDep_mct just + aborts if aerosols NOT sent from atm. + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 -- ccsm=>cesm + M models/lnd/clm/src/main/surfrdMod.F90 ---------- ccsm=>cesm, remove misc/preproc.h + M models/lnd/clm/src/main/domainMod.F90 ---------- Rm misc/preproc.h, ccsm=>cesm + M models/lnd/clm/src/main/clmtype.F90 ------------ Add u10_clm, and va + M models/lnd/clm/src/main/histFldsMod.F90 -------- Add U10, and VA, and mv old U10 to U10_DUST + M models/lnd/clm/src/main/mkarbinitMod.F90 ------- Make into module, remove + misc/preproc.h, add seperate subroutine to perturb initial conditions + M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 - Remove misc/preproc.h, + remove GRANDVIEW #ifdefs + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Add u10/va, + remove misc/preproc.h and concurrent loops + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 Add some PERGRO #ifdef + remove misc/preproc.h + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Add perturbIC call + remove misc/preproc.h and concurrent loops + M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ---- Remove misc/preproc.h, + KO comments and concurrent loops + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------ Remove misc/preproc.h, + and GRANDVIEW #ifdefs + + M README - Start with ./, and correct .build script name, and use .submit in exp + +Summary of testing: + + bluefire interactive testing: All PASS except... +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + jaguar: All PASS except... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic .............FAIL! rc= 13 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@1850 72+72 cold .FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_11 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_11 +Originator(s): erik (Erik Kluzek) +Date: Fri Aug 27 14:14:37 MDT 2010 +One-line Summary: New files for rcp6, fix MPI bug, update externals + +Purpose of changes: + +Add in new pftdyn and stream_ndep files for rcp=6.0. Fix MPI bug where send array was the same as receive array. +Fix problem with datm template on gust, and syntax errors for pt1_pt1 mode. Add start_tod to drv/scripts. + +Bugs fixed (include bugzilla ID): + 1197 (MPI problem sending and receiving data in same array) + 1207 (Problem with datm template on gust) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1206 (Problem looping over a single year of CPLHIST forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add ndepmapalgo + Move datasets just for clm tools to clm_tools namelist_defaults XML file + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, +csm_share + scripts to scripts4_100730 + drv to drvseq3_1_33 + datm to datm8_100728 + csm_share to share3_100802 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add configure test file for serial + A models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + +>>>>>>>>>>>> Add some files to test mksurfdata.pl script + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 + +>>>>>>>>>>>> Put all files for clm-tools in seperate file + A models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>>>>>>> Add new chapter on trouble shooting, add a script to limit +>>>>>>>>>>>> the line lengths, add style sheet to convert HTML XSL table +>>>>>>>>>>>> to docbook. Add file to fix vancouver problem. + A models/lnd/clm/doc/UsersGuide/trouble_shooting.xml + A models/lnd/clm/doc/UsersGuide/limitLineLen.pl + A models/lnd/clm/doc/UsersGuide/addxhtmlhead.pl + A models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl + A models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change some of the tests around + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>> Work with testing a bit, add mksurfdata.pl and drydep tests + M models/lnd/clm/test/system/README.testnames ---- Add "V" drydep test + M models/lnd/clm/test/system/test_driver.sh ------ Add pftdata, change +multi-processing a bit + M models/lnd/clm/test/system/TSMscript_tools.sh -- Fix some glitches + M models/lnd/clm/test/system/gen_test_table.sh --- Convert to xhtml + M models/lnd/clm/test/system/nl_files/clm_usrdat - Remove non-streams mode for ndep +and aerdep + M models/lnd/clm/test/system/input_tests_master -- Add mksurfdata.pl and drydep tests + make scsnf 4x5 rather than 10x15 + +>>>>>>>>>>>> Add -nomv, usrname, and pftdyn options, add ability to run in +>>>>>>>>>>>> a different directory, check for vegtyp files before running. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +>>>>>>>>>>>> Handle rcp's correctly, and handle datm streams for presaero files +>>>>>>>>>>>> and ndep streams files + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- default rcp=hist, set + RCP to ncl script + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - add ability to handle + usrname files, and handle ndep and aerdep streams files correctly + +>>>>>>>>>>>> Move tools files into clm_tools default file, add ndepmapalgo +>>>>>>>>>>>> Work on the formatting of the files, do better with clm_usrdat_name + M models/lnd/clm/bld/queryDefaultNamelist.pl - Add clm_tools default file. + Don't limit list to -var, as now done in .pm file below. + M models/lnd/clm/bld/queryDefaultXML.pm ------ If -var set, don't process variables + that don't match + M models/lnd/clm/bld/config_files/config_definition.xsl - Change to lowercase + for xhtml standard, remove glacier list + M models/lnd/clm/bld/config_files/config_definition.xml - Put glc_nec in physics list + M models/lnd/clm/bld/build-namelist --------------------- Fix minor doc issues + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add ndepmapalgo, + change formatting for GPTL options + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Improve formatting, + put note in table if All: res, masks, yrs, or sim_yr_rng + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --- Improve formatting + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove mksrf_fvegtyp + files and fndepdat files for single-years only used for processing +tools + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add in handling + of rcp's, and stream_fldfilename_ndep, remove fndepdat/dyn + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/get_Icaselist.pl + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/src/main/ndepStreamMod.F90 + M models/lnd/clm/src/main/surfrdMod.F90 + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +038 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 10 +039 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 5 +040 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 5 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smHS3 TSM.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 8 +007 erHS3 TER.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic FAIL! rc= 5 +008 brHS3 TBR.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic FAIL! rc= 5 +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 4 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +065 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 6 +066 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + bluefire/CESM testing: +FAIL SMS_RLA.f45_f45.I.bluefire +BFAIL SMS_RLA.f45_f45.I.bluefire.generate.clm4_0_11 +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_10 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_10 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_10 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_10 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_10 +FAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_10 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_11 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_10 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_10 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_10 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_10 +Originator(s): erik (Erik Kluzek) +Date: Wed Aug 4 14:37:59 MDT 2010 +One-line Summary: Update doc to cesm_rel05, bug-fixes, fix issues for single-point, mksurfdata/getregional scripts + +Purpose of changes: + +Use nn instead of copy for CO2 patch file. Update documentation to latest cesm version +05. Update externals. Some changes to build-namelist for generic single-point +simulations. Move tools XML files to clm_tools namelist_default file. Add 4x5 drydep +test, work with testing a bit. Add tests for getregional.pl and mksurfdata.pl scripts. +Add: usrname, nomv and pftdata options to mksurfdata.pl. Get RCP's working in getregional +script. Update getregional to handle ndep and aerdep streams, also get it to run in a +different directory. XML query wont test variables that don't match when -var option is +specified. Convert test table to xhtml. Move glc_nec to physics. Add option for +ndepmapalgo. Get faerdep and fndep streams files working right in +namelist_defaults_usrdat.xml file. + +Bugs fixed (include bugzilla ID): + 1166 (get_regional script needs to be updated) + 1190 (add ndepmapalgo to ndep streams) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1207 (Problem with datm template on gust) + +Update of datm also fixes several issues with datm for single pt simulations: 1173, 1175, 1176, 1181 + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add ndepmapalgo + Move datasets just for clm tools to clm_tools namelist_defaults XML file + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + scripts to scripts4_100730 + drv to drvseq3_1_33 + datm to datm8_100728 + csm_share to share3_100802 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add configure test file for serial + A models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + +>>>>>>>>>>>> Add some files to test mksurfdata.pl script + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 + +>>>>>>>>>>>> Put all files for clm-tools in seperate file + A models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>>>>>>> Add new chapter on trouble shooting, add a script to limit +>>>>>>>>>>>> the line lengths, add style sheet to convert HTML XSL table +>>>>>>>>>>>> to docbook. Add file to fix vancouver problem. + A models/lnd/clm/doc/UsersGuide/trouble_shooting.xml + A models/lnd/clm/doc/UsersGuide/limitLineLen.pl + A models/lnd/clm/doc/UsersGuide/addxhtmlhead.pl + A models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl + A models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change some of the tests around + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>> Work with testing a bit, add mksurfdata.pl and drydep tests + M models/lnd/clm/test/system/README.testnames ---- Add "V" drydep test + M models/lnd/clm/test/system/test_driver.sh ------ Add pftdata, change multi-processing a bit + M models/lnd/clm/test/system/TSMscript_tools.sh -- Fix some glitches + M models/lnd/clm/test/system/gen_test_table.sh --- Convert to xhtml + M models/lnd/clm/test/system/nl_files/clm_usrdat - Remove non-streams mode for ndep and aerdep + M models/lnd/clm/test/system/input_tests_master -- Add mksurfdata.pl and drydep tests + make scsnf 4x5 rather than 10x15 + +>>>>>>>>>>>> Add -nomv, usrname, and pftdyn options, add ability to run in +>>>>>>>>>>>> a different directory, check for vegtyp files before running. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +>>>>>>>>>>>> Handle rcp's correctly, and handle datm streams for presaero files +>>>>>>>>>>>> and ndep streams files + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- default rcp=hist, set + RCP to ncl script + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - add ability to handle + usrname files, and handle ndep and aerdep streams files correctly + +>>>>>>>>>>>> Move tools files into clm_tools default file, add ndepmapalgo +>>>>>>>>>>>> Work on the formatting of the files, do better with clm_usrdat_name + M models/lnd/clm/bld/queryDefaultNamelist.pl - Add clm_tools default file. + Don't limit list to -var, as now done in .pm file below. + M models/lnd/clm/bld/queryDefaultXML.pm ------ If -var set, don't process variables + that don't match + M models/lnd/clm/bld/config_files/config_definition.xsl - Change to lowercase + for xhtml standard, remove glacier list + M models/lnd/clm/bld/config_files/config_definition.xml - Put glc_nec in physics list + M models/lnd/clm/bld/build-namelist --------------------- Fix minor doc issues + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add ndepmapalgo, + change formatting for GPTL options + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Improve formatting, + put note in table if All: res, masks, yrs, or sim_yr_rng + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --- Improve formatting + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove mksrf_fvegtyp + files and fndepdat files for single-years only used for processing tools + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add in handling + of rcp's, and stream_fldfilename_ndep, remove fndepdat/dyn + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/get_Icaselist.pl + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/src/main/ndepStreamMod.F90 + M models/lnd/clm/src/main/surfrdMod.F90 + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 4 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_10 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_09 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 4 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 4 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +028 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +032 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 4 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_09 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_09 +Originator(s): erik (erik) +Date: Mon Jun 14 00:02:12 MDT 2010 +One-line Summary: Fix some small issues, update documentation, and externals + +Purpose of changes: + +Work on documentation for CESM1.0 release, with glcec changes, and namelist changes. Run +testing and fix bugs. Move documentation changes from release branch to trunk. Fix +getregional script for transient. Remove "At point 2" from lnd log files. Update +csm_share, and scripts version so can now run testing with lahey compiler. Get CO2 patch +file working. + +Bugs fixed (include bugzilla ID): + 1092 (Problems running on dublin with datm8 with debug) + 1159 (date in fco2 file is not used) + 1160 (Fix mksurfdata.pl script to work with 1000-1004) + 1167 (doc. about running single point reduce pes) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, +cism, csm_share + scripts to scripts4_100612 + drv to drvseq3_1_31 + datm to datm8_100612 + cism to cism1_100608 + csm_share to share3_100607 + +List all files eliminated: None + +List all files added and what they do: None + +>>>>>>>>>>>> Add testing configure file + A models/lnd/clm/test/system/config_files/_nrcnsc_do + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add CLM_USRDAT_NAME and getregional.pl tests + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/TSMscript_tools.sh + M models/lnd/clm/test/system/nl_files/clm_usrdat + M models/lnd/clm/test/system/nl_files/getregional + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/README + +>>>>>>>>>>>> + M models/lnd/clm/tools/ncl_scripts/getco2_historical.ncl ---- Add comment that + date variable is NOT used + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add path to scripts + so can run from a different directory + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Fix warnings and + allow some files to not be converted if not needed + M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl ------- Re-order longitudes + so from -180-180 rather than 0-360 + +>>>>>>>>>>>> + M models/lnd/clm/bld/queryDefaultXML.pm ----- Get working for usrdat better + M models/lnd/clm/bld/listDefaultNamelist.pl - Get working for usrdat files + M models/lnd/clm/bld/build-namelist --------- Allow lnd_res to be usrdat name + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Set year first/last + for datm_presaero for clim_2000 + M models/lnd/clm/bld/namelist_files/datm-build-namelist -------- Don't allow + prognostic for datm_presaero + +>>>>>>>>>>>> Update documentation, add cprnc README to document + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff - Update patch to + work with the latest datm with DATM_PRESAERO + +>>>>>>>>>>>> Remove "at point 2" and fix esmf duplication from fix by Mariana + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + +>>>>>>>>>>>> Update README files and use CESM in place of CCSM + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/doc/index.shtml + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 5 +017 smEH1 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 +018 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +019 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 4 +021 smHN1 TSM.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 8 +022 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 3 +023 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 3 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 3 +025 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -90 cold .............FAIL! rc= 3 +026 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -3+-7 cold ...........FAIL! rc= 3 +027 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -5+-5 cold ...........FAIL! rc= 3 +028 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -90 cold .............FAIL! rc= 3 +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 3 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 3 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 3 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 3 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 3 +034 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 3 +035 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 3 +036 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 3 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 3 +038 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 3 +039 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 3 +040 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 3 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 3 +042 smC61 TSM.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 -6 startup ............FAIL! rc= 3 +043 erC61 TER.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 10+38 startup .........FAIL! rc= 3 +044 brC61 TBR.sh _scnv_dh clm_std^nl_urb_br 20020101:NONE:1800 1.9x2.5 gx1v6 -3+-3 startup ......FAIL! rc= 3 +045 blC61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 48 startup ............FAIL! rc= 3 +046 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 96 cold ..........FAIL! rc= 3 +047 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 3 +048 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 3 +049 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold ..........FAIL! rc= 3 +050 smV61 TSM.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 96 arb_ic ..............FAIL! rc= 3 +051 erV61 TER.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 10+38 arb_ic ...........FAIL! rc= 3 +052 brV61 TBR.sh _mec10sc_dh clm_std 19980115:NONE:1800 1.9x2.5 gx1v6 72+72 arb_ic ..............FAIL! rc= 3 +053 blV61 TBL.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 48 arb_ic ..............FAIL! rc= 3 +054 smI59 TSMcnspinup.sh 17p_cnadspinupsc_dm 17p_cnexitspinupsc_dm 17p_cnsc_dm clm_std 20020115:NONEFAIL! rc= 3 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 3 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 3 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 3 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 3 +059 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 3 +060 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 3 +061 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 3 +062 blL58 TBL.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 48 arb_ic ...............FAIL! rc= 3 +063 smJ61 TSM.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 3 +064 erJ61 TER.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 3 +065 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 3 +066 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 3 +067 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 3 + bluefire interactive testing: All PASS except... +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 5 +021 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 5 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +062 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 3 +063 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 3 +064 smZ94 TSMtools.sh mkdatadomain tools__ds namelist ...........................................FAIL! rc= 3 +065 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 3 + bluefire/CESM testing: All PASS except... +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_08 +BFAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_08 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_09 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_08 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 smV23 TSM.sh _mec10sc_do clm_glcmec 19980115:NONE:1800 48x96 gx3v7 96 arb_ic ................FAIL! rc= 8 +026 erV23 TER.sh _mec10sc_do clm_glcmec 19980115:NONE:1800 48x96 gx3v7 10+38 arb_ic .............FAIL! rc= 5 +027 brV23 TBR.sh _mec10sc_do clm_std 19980115:NONE:1800 48x96 gx3v7 72+72 arb_ic ................FAIL! rc= 5 + jaguar/CESM testing: All PASS + edinburgh/lf95 interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +008 blAL4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -10 cold ...............FAIL! rc= 5 +012 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 5 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 4 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 4 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +028 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +032 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 4 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_08 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_08 +Originator(s): erik (erik) +Date: Fri Jun 4 01:25:39 MDT 2010 +One-line Summary: Snow hydrology bug fix from Keith and Dave + +Purpose of changes: + +SnowHydrology bug fix from Keith Oleson. For test-suite, make default to send aerosol +data through datm. Update version of cism, scripts and datm. Remove some of the old aerdep +stuff from the XML database as we now are using presaero from datm (leave 1-deg and +2-deg). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: none + +Describe any changes made to the namelist: Move datm_presaero to overall defaults + +List any changes to the defaults for the boundary datasets: + Remove all faerdep files except f09 and f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + code changes come from Keith Oleson and Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): scripts, cism and drv + scripts to scripts4_100603a + drv to drvseq3_1_29 + cism to cism1_100603 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/17p_cnsc_m + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Switch demand for ndepdyn for + ndepsrc stream + + M models/lnd/clm/bld/build-namelist ----- Get datm_presaero if not null + do NOT set faerdep + M models/lnd/clm/bld/clm.cpl7.template -- Set datm_presaero by DATM_PRESAERO + if datm or to prognostic if not (so aerosol dep require from atm) + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Set + datm_presaero by resolution, sim_year, sim_year_range and rcp + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Remove datm_presaero + M models/lnd/clm/bld/namelist_files/datm-build-namelist ----------- Set + datm_presaero by resolution, sim_year, sim_year_range and rcp + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Remove + all faerdep files except for f09 and 19 + + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - Snow hydrology fix + +Summary of testing: + + bluefire interactive testing: All PASS up to... +014 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test +-1100 arb_ic FAIL! rc= 10 + bluefire/CCSM testing: All PASS except.. +FAIL SMS_RLB.f45_f45.I.bluefire +BFAIL SMS_RLB.f45_f45.I.bluefire.generate.clm4_0_08 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_06 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_06 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_06 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_06 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_06 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_06 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_08 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_06 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_06 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_06 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_06 + Extra testing: +PASS ERI.f19_g16.IG.bluefire +Make sure answers agree with /OLESON/csm/ccsm4_0_beta52_ndepaer other than VOC fields +Test that F case will configure.. +create_newcase -compset F -case testF -res f19_g16 -mach bluefire -skip_rundb + +CLM tag used for the baseline comparison tests if applicable: clm4_0_07 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: ALL + - what platforms/compilers: ALL + - nature of change: larger than roundoff/same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + + - platform/compilers: IBM + - compset (and additional configure options): I1850CN + - build-namelist options (or complete namelist): -ndepsrc stream + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/ccsm4_0_beta52_ndepaer + /OLESON/csm/ccsm4_0_beta52_ndepaertrans + + The above is identical to this tag (other than the two VOC fields that changed) + +=============================================================== +=============================================================== +Tag name: clm4_0_07 +Originator(s): erik (erik) +Date: Thu Jun 3 21:22:46 MDT 2010 +One-line Summary: Some cleanup/fix bugs, add RTM var, add albice to namelist, allow last-millenium in mksurfdata, allow setting of datm_presaero in clm test-suite + +Purpose of changes: + +Fix mksurfdata.pl, to correctly create 1000-1004 test datasets. Fix drydep for OpenMP. +Update 1x1_tropicAtl_1000-1004 test fsurdat file. Move glc_grid from configure to +build-namelist. Add in alb_ice to namelist. Start adding in the capability to handle +mksurfdata from 0850-1850AD, put all mksrf_fvegtyp files in XML database (remove some of +the sample pftdyn text files). New RTM field on history output from Sean (VOLR and +VOLR_ICE, only VOLR output by default). Allow use of aerosol data from datm for I cases +in the clm test suite. Split out datm-build-namelist from clm build-namelist (put in +bld/namelist_files). + +Bugs fixed (include bugzilla ID): + 1162 (OpenMP bug with dry-deposition code in clm) + 883 (aerosol deposition not from atm) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: Move glc_grid to build-namelist + remove esmf_libdir, fix ccsm_bld so will build threaded properly + +Describe any changes made to the namelist: Add albice to namelist + Add new history fields VOLR and VOLR_ICE + + VOLR RTM storage: LIQ (m3) + VOLR_ICE RTM storage: ICE (m3) + +List any changes to the defaults for the boundary datasets: + New datasets for 1x1_tropicAtl 1000 tests + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, VOLR changes come from Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + scripts to scripts4_100601 + drv to drvseq3_1_28 + pio to pio1_1_1 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove mksurdata pftdyn text files, let XML database create them + D models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp6.0_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt + +List all files added and what they do: + +>>>>>>>>>>>>>>> Split out datm part of build-namelist into it's own script + A models/lnd/clm/bld/namelist_files/datm-build-namelist + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000-2000.txt -- Same as + old file with 2000.txt name rather than 2000-2000.txt name. + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Move glc_grid to build-namelist, remove kraken + M models/lnd/clm/test/system/config_files/_mec10sc_dh + M models/lnd/clm/test/system/config_files/_mec10sc_dm + M models/lnd/clm/test/system/config_files/_mec10sc_do + M models/lnd/clm/test/system/config_files/_mec10sc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_h + M models/lnd/clm/test/system/config_files/_mec10sc_m + M models/lnd/clm/test/system/config_files/_mec10sc_o + M models/lnd/clm/test/system/test_driver.sh --------- Remove kraken, update dataroot + for bluefire, and tempworkspacefor intrepid + M models/lnd/clm/test/system/CLM_runcmnd.sh --------- Remove kraken + M models/lnd/clm/test/system/nl_files/clm_drydep ---- Change drydep to drv_drydep + +>>>>>>>>>>>>>>> Use XML database for pftdyn files, have mksrfdata.pl write out pftdyn files + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig - change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ------ start at 1850 + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---------- Get mksrf_vegtyp filenames + from XML database for all files, and write out pftdyn files with them + also get working for 1000-1004 test cases (specifically for 1x12_tropicAtl + test case) + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt - Use CSMDATA versions + of 1850 and 2000 files + +>>>>>>>>>>>>>>> Move glc_grid to namelist, fix ccsm_bld=on, add datm_presaero +>>>>>>>>>>>>>>> Only do COLD start for startup type + M models/lnd/clm/bld/configure --------------- Remove glc_grid and esmf_libdir + add in control of CCSM_VOC, set compile_threaded for ccsm_bld on, + M models/lnd/clm/bld/queryDefaultNamelist.pl - Remove double reading of namelist_defaults_overall.xml + M models/lnd/clm/bld/queryDefaultXML.pm ------ Add csmdata to beginning of file, only + if it's a relative pathname (to handle instances of /cgd/tss for mksrf_vegtyp files) + M models/lnd/clm/bld/config_files/config_definition.xml - Remove glc_grid/esmf_libdir + M models/lnd/clm/bld/listDefaultNamelist.pl --- Move glc_grid to namelist vars + M models/lnd/clm/bld/build-namelist ----------- Add in glc_grid, and datm_presaero + change -drydep to -drv_drydep option, set glc_nthreads, outnc_large_files + and albice if glc_nec>0, move datm settings to own datm-build-namelist. + M models/lnd/clm/bld/clm.cpl7.template -------- Move glc_grid to build-namelist, + remove outnc_large_files setting (now in build-namelist), only do + COLD start for startup type (NOT for hybrid or branch). + +>>>>>>>>>>>>>>> Add albice/glc_grid/datm_presaero/outnc_large_files +>>>>>>>>>>>>>>> New datasets for 1x1_tropicAtl 1000 tests +>>>>>>>>>>>>>>> Add in all mksrf_fvegtyp files and include last-millenium + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ Add in albice, + and glc_* settings for drv (glc_nthreads, glc_ntasks etc.), add presaero + datam_presaero, datm_file_aero, datm_year_first_aero, datm_year_last_aero, + datm_year_align_aero, and glc_grid. Add 0.5x0.5 resolution (for mksurfdata) + and some premillenial years (850,1100,1350,1600) and sim-year ranges + (850-1100,1100-1350,1350-1600,1600-1850) + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Set default + masks here, and add in glc_grid default + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Add in some + new domain files that are in datm template, and add in datm_presaero + settings needed: datm_file_aero, datm_aero_streams, datm_year_first_aero +  datm_year_last_aero, and datm_year_align_aero + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl --------- Show + datm_presaero setting if set. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Add + outnc_large_files, albice, and move mask to overall, update + 1x1_tropicAtl files for 1000, 1000-1004, add in all mksrf_fvegtyp + files for all scenarios and last-millenium. Add in diri and diro. + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ----- Get URL + svn keyword set properly. + +>>>>>>>>>>>>>>> Put datm/drv settings on bottom (only for mode=ccsm_seq) +>>>>>>>>>>>>>>> set datm_presaero and data_cycle_beg/end years + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml -- default + datm_presaero is clim_2000 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml - default + datm_presaero is rcp8.5, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml - default + datm_presaero is rcp8.5, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml ------------ default + datm_presaero is trans_1850-2000, beg/end year 1948-1972, co2=386.9 + M models/lnd/clm/bld/namelist_files/use_cases/glacier_mec.xml ---------------- default + datm_presaero is clim_2000 + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml --------------- default + datm_presaero is clim_1850, beg/end year 1948/1972 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml - default + datm_presaero is rcp2.6, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml --- default + datm_presaero is rcp6.0, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml - default + datm_presaero is rcp4.5, beg/end year 1972-2004 + +>>>>>>>>>>>>>>> Add in albice to namelist, add VOLR and VOLR_ICE to history files +>>>>>>>>>>>>>>> always call interpMonthlyVeg for drydep + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Remove interpMonthlyVeg + call as coming from a threaded region + M models/lnd/clm/src/main/clm_comp.F90 ------------- Call interpMonthlyVeg + for drydep even if CN is on + M models/lnd/clm/src/main/controlMod.F90 ----------- Add albice + M models/lnd/clm/src/main/clm_varcon.F90 ----------- Remove albice + M models/lnd/clm/src/main/clm_driver.F90 ----------- Always call interpMonthlyVeg + if drydep is on (even when NOT doalb) + M models/lnd/clm/src/main/histFldsMod.F90 ---------- Add VOLR and VOLR_ICE + (VOLR_ICE is an optional field) + M models/lnd/clm/src/riverroute/RtmMod.F90 --------- Handle volr under runoff + type, rather than as local variable + M models/lnd/clm/src/riverroute/RunoffMod.F90 ------ Add volr, volrlnd, volr_nt1/2 + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 Add albice as public var + that can be set in controlMod on namelist + +Summary of testing: + + bluefire: All PASS except (up to test 061 nl_crcrop) +061 brL58 TBR.sh _sc_dh clm_std^nl_crcrop +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 7 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 7 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 7 +045 blC61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 48 startup ............FAIL! rc= 7 + bluefire interactive testing: All PASS up to... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except.. +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_06 + + + bluefire/extra CCSM testing: +Make sure answers agree with /OLESON/csm/ccsm4_0_beta52_ndepaer other than VOC fields + (when snowhydrology changes are put in) + + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@1850 72+72 cold .FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_06 + +Changes answers relative to baseline: no bit-for-bit (except omp active stand-alone tests) + The standalone tests with OpenMP on are different because the previous tag + wasn't building with OpenMP + +=============================================================== +=============================================================== +Tag name: clm4_0_06 +Originator(s): erik (erik) +Date: Wed May 26 10:35:26 MDT 2010 +One-line Summary: Update gglc to cism + +Purpose of changes: + +Changes from jwolfe to lnd_comp* subroutines to exchange cism fields. Requires an update +to the driver for the index of the fieldnames passed. Change paths of gglc glc_grid files +from gglc to cism. Make stream the default for all resolutions for ndepsrc. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1162 (OpenMP bug with dry-deposition code in clm) + 1163 (finidat file has a bunch of NaN's in it) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: + Change name of ice model from gglc to cism + Change list of fields exchanged with cism + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Change pathnames for gglc fglcmask datasets to cism + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jwolfe, lipscomb + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, cism + scripts to scripts4_100525 + drv to drvseq3_1_26 + cism to cism1_100525b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Change default + of ndepsrc for f19 and f09 to stream + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Change pathnames + for fglcmask files to pathame with cism instead of gglc + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ---------------- Pass a different + set of fields for sno (needed for update to cism) + + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 -------------- Pass a different + set of fields for sno (needed for update to cism) + +Summary of testing: + + bluefire/CCSM testing: +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_06 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_05 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_05 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_05 + bluefire/CCSM extra testing: +PASS SMS.f19_g16.IG.bluefire +PASS ERS.f19_g16.IG.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm4_0_05 + +Changes answers relative to baseline: Only when glc is active + Or for f19 and f09 with CN as now ndepsrc streams is the default for all resolutions + (previously ndepsrc data was the default for f19 and f09) + +=============================================================== +=============================================================== +Tag name: clm4_0_05 +Originator(s): erik (erik) +Date: Tue May 25 15:13:30 MDT 2010 +One-line Summary: Move Nitrogen deposition stream branch to trunk + +Purpose of changes: + +Move branch that treats ndepdyn files as streams to trunk. Change csm_share to have a +simpler normalization for coszen scaling (from dlawren/kauff in datm/csm_share). Fix +fragile code in clm_atmlnd, from Mariana. Update to datm8 that can set streams for +aerosols. Fix template so that CLM_BLDNML_OPTS is active. Update scripts and get in +other new finidat files, change clm test list, include _E test and IG f19 test. + +Bugs fixed (include bugzilla ID): + 1161 (New history fields added that should NOT be) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1162 (OpenMP bug with dry-deposition code in clm) + 1163 (finidat file has a bunch of NaN's in it) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Add -ndepsrc option to build-namelist + +List any changes to the defaults for the boundary datasets: + Add new datasets for Nitrogen deposition streams files (same as fndepdyn files) + Remove fndepdat/fndepdyn files for resolutions other than f09 and f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + scripts to scripts4_100524b + drv to drvseq3_1_23 + datm to datm8_100420 + csm_share to share3_100423 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Handle Nitrogen deposition streams +A models/lnd/clm/src/main/ndepStreamMod.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add some CN drydep tests for hybrid/open-MP +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>>>>> Add ability to handle ndep streams namelists +>>>>>>>>>>>> Add ability to set CLM_BLDNML_OPTS +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +>>>>>>>>>>>> Set ndepstreams variables if ndepsrc=stream, otherwise set fndep files +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +>>>>>>>>>>>> Handle new ndep streams namelist and namelist variables +>>>>>>>>>>>> Remove misc.h and preproc.h #includes +M models/lnd/clm/src/main/clm_comp.F90 ---------- Renumber starting at 1 not 0 +M models/lnd/clm/src/main/clm_initializeMod.F90 - Handle initialization both + for ndep streams and old ndep handling +M models/lnd/clm/src/main/aerdepMod.F90 --------- Check if allocated before allocate +M models/lnd/clm/src/main/iniTimeConst.F90 ------ Move setting of ndep out of here +M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove fragile code +M models/lnd/clm/src/main/controlMod.F90 -------- Handle use_ndepstream +M models/lnd/clm/src/main/clm_varctl.F90 -------- Add use_ndepstream +M models/lnd/clm/src/main/clm_driver.F90 -------- Add ndep_interp if use_ndepstream + and first and last years are different +M models/lnd/clm/src/main/ndepFileMod.F90 ------- Make fndepdat optional input so + can do this way (old way) or ndep streams (new way). +M models/lnd/clm/src/main/clm_glclnd.F90 -------- Change order of vars from Bill Lipscomb + +M models/lnd/clm/src/main/areaMod.F90 - Add interfaces for MCT datatypes + +M models/lnd/clm/src/main/clmtypeInitMod.F90 - Remove unfilled history vars +M models/lnd/clm/src/main/clmtype.F90 -------- Remove unfilled history vars +M models/lnd/clm/src/main/histFldsMod.F90 ---- Remove unfilled history vars, add QTOPSOIL + as an optional history variable. +M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - Handle fragile code mapping with MCT +M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- Handle fragile code mapping with MCT + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 7 +049 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold ..........FAIL! rc= 7 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 7 +048 blHQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:NONE:1800 1x1_brazil navy@2000 -150 cold ........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_04 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_04 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_04 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_04 +BFAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_04 +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_04 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_05 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_04 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_04 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_04 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_04 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_04 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_04 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_04 + +Changes answers relative to baseline: Yes! + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + ndepaer01_clm3_7_15 + SnowHydrology changes + - platform/compilers: IBM + - compset (and additional configure options): I1850CN + - build-namelist options (or complete namelist): -ndepsrc stream + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/ccsm4_0_beta52_ndepaer + /OLESON/csm/ccsm4_0_beta52_ndepaertrans + +=============================================================== +=============================================================== +Tag name: clm4_0_04 +Originator(s): erik (erik) +Date: Thu May 20 10:57:54 MDT 2010 +One-line Summary: New namelist items: ice_runoff, scaled_harvest, carbon_only, new + RTM hist vars, new finidat files, update esmf interface, turn off aerosol read quicker + +Purpose of changes: + +Redo all fndepdyn datasets for f19. Add namelist option to turn off ice-flow and send it +to liquid runoff: ice_runoff (by default .true.). Add new coefficients for harvest from +Johann, and add ability to trigger it on and off for backwards compatibility +(scaled_harvest, by default .false.). Change SUPLN from CPP token to carbon_only namelist +item. Add in new RTM variable to history files from Sean. Add in T31 1850/2000 CN/non-CN +and 2-deg 2000 CNDV finidat files. Turn off reading of aerosol/dust at initialization +rather than run time, so files aren't even opened if CAM is passing data to clm. Update +lnd_comp_esmf to same as mct interface. + +New history fields are incorrect. This is bug 1161. Since, time-lines are critical +and testing was completed, these changes will go in, but will be removed next week. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1161 (New history fields added that should NOT be) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: Remove SUPLN #ifdef change to namelist option + +Describe any changes made to the namelist: Add namelist items + + ice_runoff = If true, river runoff will be split up into liquid and ice streams, + otherwise ice runoff will be zero and all runoff directed to liquid stream + scaled_harvest = If true, harvesting will be scaled according to coeffecients + determined by Johann Feddema, 2009 + carbon_only = If true, and CLMCN carbon-nitrogen model is on, Nitrogen will be + prescribed rather than prognosed + +List any changes to the defaults for the boundary datasets: + New fndepdyn files with correct time coordinate + New finidat files for T31 1850/2000 and f19 2000 for CNDV + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +>>>>>>>>>>>>>> Remove SUPLN build tests + D models/lnd/clm/test/system/config_files/17p_cnnsc_h + D models/lnd/clm/test/system/config_files/17p_cnnsc_m + D models/lnd/clm/test/system/config_files/17p_cnnsc_o + D models/lnd/clm/test/system/config_files/_cnnsc_h + D models/lnd/clm/test/system/config_files/_cnnsc_m + D models/lnd/clm/test/system/config_files/_cnnsc_o + D models/lnd/clm/test/system/config_files/17p_nrcnnsc_ds + D models/lnd/clm/test/system/config_files/17p_cnnsc_dh + D models/lnd/clm/test/system/config_files/17p_cnnsc_dm + D models/lnd/clm/test/system/config_files/17p_cnnsc_do + D models/lnd/clm/test/system/config_files/_cnnsc_dh + D models/lnd/clm/test/system/config_files/17p_cnnsc_ds + D models/lnd/clm/test/system/config_files/_cnnsc_dm + D models/lnd/clm/test/system/config_files/_cnnsc_do + D models/lnd/clm/test/system/config_files/_cnnsc_ds + +>>>>>>>>>>>>>> Remove namelist files no longer used + D models/lnd/clm/test/system/nl_files/scam + D models/lnd/clm/test/system/nl_files/ext_ccsm_seq_cam + D models/lnd/clm/test/system/nl_files/nl_glcsmb + D models/lnd/clm/test/system/nl_files/scam_prep + +List all files added and what they do: + +>>>>>>>>>>>>>> Add ice_runoff=.false., scaled_harvest=.true., and carbon_only tests + A models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + A models/lnd/clm/test/system/nl_files/nl_cn_conly + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Switch SUPLN tests for carbon_only +>>>>>>>>>>>>>> Add ice_runoff=.false., scaled_harvest=.true tests + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_breeze + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Remove setting of supln to off + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + +>>>>>>>>>>>>>> Remove SUPLN from configure + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/config_files/config_definition.xml + +>>>>>>>>>>>>>> Add carbon_only, scaled_harvest and ice_runoff options +>>>>>>>>>>>>>> T31 1850/2000 finidat files, f19 CNDV 2000 finidat file +>>>>>>>>>>>>>> Add error checking, change fndepdyn files for ones with +>>>>>>>>>>>>>> corrected time axis. + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>>>>> Remove SUPLN #ifdef for carbon_only namelist + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 - Correct comment + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ---- Switch SUPLN for carbon_only + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ----- Remove ltype as duplicated + +>>>>>>>>>>>>>> Add carbon_only, scaled_harvest, and ice_runoff options +>>>>>>>>>>>>>> Add new RTM history variables + M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Add res_sno, topo_ndx, + topo_slope, var_track, var_track2, frost_table, zwt_perched, + qflx_top_soil, qflx_snow_out, qflx_drain_perched + M models/lnd/clm/src/main/pftdynMod.F90 ---------------- Add CN ifdef's for harvest + add if for scaled_harvest or not + M models/lnd/clm/src/main/iniTimeConst.F90 ------------- Add CN ifdef's for ndep + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add RTM ifdef's for frivinp_rtm + M models/lnd/clm/src/main/controlMod.F90 --------------- Put options in appropriate + RTM and CN #ifdef blocks. Add ice_runoff, scaled_harvest and carbon_only to namelist + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Add CN/RTM #ifdefs, add + scaled_harvest and ice_runoff + M models/lnd/clm/src/main/clm_driver.F90 --------------- Add CN #ifdef for ndepdyn + M models/lnd/clm/src/main/ndepFileMod.F90 -------------- Add CN #ifdef + M models/lnd/clm/src/main/clmtype.F90 ------------------ Add res_sno, topo_ndx, + topo_slope, var_track, var_track2, frost_table, zwt_perched, + qflx_top_soil, qflx_snow_out, qflx_drain_perched + M models/lnd/clm/src/main/histFldsMod.F90 -------------- Add + FROST_TABLE, ZWT_PERCH, QDRAI_PERCH, QTOPSOIL + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ----- Move lnd_chkAerDep_mct to init + add ice_runoff option to output rtm streams + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 --- Move lnd_chkAerDep_mct to + add ice_runoff option to output rtm streams. And sync up with lnd_comp_mct +init + + +Summary of testing: + + bluefire interactive extra checking: +001 smH43 TSM.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold PASS +002 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coPASS +003 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coPASS +005 smH93 TSM.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 96 cold PASS +006 erH93 TER.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 10+38 coPASS +007 brH93 TBR.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 72+72 coPASS + bluefire/CCSM testing: All PASS except... +FAIL ERI.T31_g37.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_04 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_03 + jaguar/CCSM testing: All FAIL +FAIL ERS_D.f09_g16.I1850.jaguar +FAIL PST.f10_f10.I8520CN.jaguar +FAIL PET_PT.f10_f10.I8520CN.jaguar + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_03 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_03 +Originator(s): erik (erik) +Date: Mon May 17 14:06:50 MDT 2010 +One-line Summary: Changes from Francis for VOC and drydep + +Purpose of changes: + +Changes from Francis Vitt and Jean-Francois Lamarque for VOC and drydep. Add a scaling +factor for VOC isoprene. Get annual LAI and differences from CLMSP even when CLMCN is +on when sending drydep to atm, as need LAI monthly differences to estimate season index. +Get these changes to work with CN on and off and also get it to work with DEBUG mode +on. Use clm veg indicies in pftvarcon and abort drydep if don't find a wesley veg type +index. Fix ndeplintInterp.ncl script for rcp=-999.9 historical (bug 1153). Add in quarter +degree gx1v6 fraction dataset. + +Bugs fixed (include bugzilla ID): + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: qtr-degree, gx1v6 frac/domain datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, fvitt + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_100513 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_nrcnsc_ds --- cn test without rtm or supln + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Add in qtr-degree fraction and domain file datasets +>>>>>>>>>>> Make gx1v6 default mask for qtr-degree + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>> Separate out CN+SUPLN tests as H and CN only as P + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/nl_files/clm_drydep ---- correct build-nml options + M models/lnd/clm/test/system/input_tests_master ----- Remove 360x720 tests, add + drydep tests with CN and without, have start dates for drydep + tests span the year + +>>>>>>>>>>> A few small fixes to tools + M models/lnd/clm/tools/mksurfdata/mkvocef.F90 --------- Remove diagnostics as nonsensical + (also was incorrect, see bug 1157) + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Fix so can work with historical case + +>>>>>>>>>>> Allow some CLMSP subroutines to be called even with CLMCN so that LAI can help set +>>>>>>>>>>> the season index when dry-deposition is active (and only when dry-dep is active) + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Change #ifdefs so that + some can be called from drydep even when CN is on. Don't allow + EcosystemDyn to be called if CN on though. + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ----- Add a scaling factor + for isoprene + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ----- Make winter season on + anytime you have snow. Use pftvarcon indices to set wesveg type from + clmveg type. Add landuse type and set to desert winter if not veg type. + (so won't abort on DEBUG mode) + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Also call + EcosystemDynini and readAnnualVegetation even if CN is on when drydep is on. + +Summary of testing: + + bluefire: Ran 100 days of 1850CN, compared to Francis's mods and the two results were identical + bluefire interactive testing: +001 smCO3 TSM.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -10 cold ................PASS +002 erCO3 TER.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -3+-7 cold ..............PASS +003 brCO3 TBR.sh _sc_do clm_drydep^nl_urb_br 20021001:NONE:3600 10x15 USGS -5+-5 cold ...........PASS +004 blCO3 TBL.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -30 cold ................PASS +005 smCP3 TSM.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -15 startup ..........PASS +006 erCP3 TER.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -3+-7 startup ........PASS +007 brCP3 TBR.sh _sc_do clm_drydep^nl_urb_br 20020317:NONE:1800 1.9x2.5 gx1v6 -5+-5 startup .....PASS +008 blCP3 TBL.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -15 startup ..........PASS +001 sm654 TSMtools.sh mkgriddata tools__ds namelist .............................................PASS +002 sm674 TSMtools.sh mkgriddata tools__ds singlept .............................................PASS +003 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................PASS +004 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................SKIPPED* +005 sm853 TSMtools.sh interpinic tools__o runoptions ............................................PASS + bluefire/CCSM testing: All PASS except... +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_0+upext +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_0+upext +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_0+upext +FAIL ERI.T31_g37.IG.bluefire +BFAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_0+upext +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_03 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_0+upext + +CLM tag used for the baseline comparison tests if applicable: clm4_0_02 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_02 +Originator(s): erik (erik) +Date: Thu May 13 00:47:40 MDT 2010 +One-line Summary: Make sure dtime is initialized, so that answers are consistently the same as clm4_0_00 + +Purpose of changes: + +Make sure dtime is initialized before it is used in lnd_run_mct/lnd_run_esmf so +that results are consistent. This bug has been around since clm3_6_36 where doalb +logic was changed. However, until clm4_0_01 results seemed to have been consistent, +but with clm4_0_01 results were inconsistent, and usually incorrect for nstep=1 (in +calculating calday1 and hence doalb). + +Bugs fixed (include bugzilla ID): + 1156 (Reproducability problem with clm4_0_01) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>> Add a reproducability test + A models/lnd/clm/test/system/TRP.sh + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Add reproducability test + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>> Set glcmec by GLC_NEC_ $ifdefs + M models/lnd/clm/src/main/clm_varpar.F90 + +>>>>>>>>> Make sno fields NOT optional, and set dtime before use in _run + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + +Summary of testing: + + bluefire interactive testing: +001 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........PASS + bluefire/CCSM testing: +PASS PST.f45_g37.I1850.bluefire.compare.clm4_0_0+upext +PASS PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_0+upext +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm4_0_0+upext +PASS ERS.f19_g16.I1850.bluefire.compare.clm4_0_0+upext +PASS PST.f10_f10.I8520CN.bluefire.compare.clm4_0_0+upext +PASS PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_0+upext + +CLM tag used for the baseline comparison tests if applicable: clm4_0_00 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_01 +Originator(s): erik (erik) +Date: Tue May 11 14:39:25 MDT 2010 +One-line Summary: Move glacier multiple elevation class branch to the trunk so that we can work with the active glacier model + +Purpose of changes: + +Add ability to handle glacier multiple elevation classes (glc_mec) in clm, so that we +can interact with the active glacier component (glc). Adds glacier elevation classes +to the surface datasets and requires they be read in when glacier multiple elevation +classes are active. New namelist options for glc_mec include glc_smb and glc_dyntopo. +At build-time the number of glc_mec classes is set (can be 0, 1, 3, 5, or 10). The +model also interacts with the mask of valid glacier points that the active glacier +model determined (input with the fglcmask file), and set by glc_grid (which can be +gland5,gland10, or gland20 for 5-20km resolution over Greenland). glc_grid is set at +build time, but should be moved to the build-namelist. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1156 (Reproducability problem with clm4_0_01) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: Add glc_nec and glc_grid options to configure + glc_nec can be 1,3,5, or 10 and MUST match the number on the input surface dataset + the elevation classes themselves are read from the surface dataset + glc_grid can be gland5, gland10, gland20 for greenland 5, 10, or 20km resolution + it is merely passed on to build-namelist to pick the glcmask file + +Describe any changes made to the namelist: + +- create_glacier_mec_landunit (= T when these landunits are created; F by default) +- glc_smb (= T if passing surface mass balance to GLC; else pass PDD info; T by default) +- glc_dyntopo (= T if CLM topography changes dynamically; currently F) + (NOT fully implemented yet) + + New history fields: + QICE ice growth/melt (mm/s) + QICEYR ice growth/melt (mm/s) + gris_mask Greenland mask (unitless) + gris_area Greenland ice area (km^2) + aais_mask Antarctic mask (unitless) + aais_area Antarctic ice area (km^2) + +Changes to build-namelist: + + finidat file and possibly the fsurdat files include glc_nec values + Currently only support glc_nec=0 or glc_nec=10 + +List any changes to the defaults for the boundary datasets: Update datm domain file for T31 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jwolfe, lipscomb, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share + Also add in active glacier model + scripts to scripts4_100510a + csm_share to share3_100423 + gglc to glc4_100507 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>> Add mec tests + A models/lnd/clm/test/system/config_files/_mec10sc_dh + A models/lnd/clm/test/system/config_files/_mec10sc_dm + A models/lnd/clm/test/system/config_files/_mec10sc_do + A models/lnd/clm/test/system/config_files/_mec10sc_ds + A models/lnd/clm/test/system/config_files/_mec10sc_h + A models/lnd/clm/test/system/config_files/_mec10sc_m + A models/lnd/clm/test/system/config_files/_mec10sc_o + A models/lnd/clm/test/system/nl_files/clm_glcmec + A models/lnd/clm/test/system/nl_files/nl_glcsmb + +>>>>>>>>>> Handle passing of data from clm to the active glacier model + A models/lnd/clm/src/main/clm_glclnd.F90 -- handle passing data to glc model + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Add mec tests + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/README.testnames + +>>>>>>>>>>>> Add GLC_MEC to mksurfdata, add ability to set glc_nec on namelist + M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 + M models/lnd/clm/tools/mksurfdata/Makefile ------ Add gfortran remove xlf90 for Darwin + M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 + +>>>>>>>>>>>> Add some more checking for glc settings + M models/lnd/clm/bld/listDefaultNamelist.pl - Try to make faster, add loop over + glc_nec and glc_grid + M models/lnd/clm/bld/build-namelist --------- Get default glc_smb when + create_glacier_mec_landunits is on + M models/lnd/clm/bld/clm.cpl7.template ------ Add glc_ settings + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add glc_nec to + finidat files, add glc_nec="10" fsurdat files for T31, 1-deg, 2-deg + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/config_files/Makefile.in - Add gfortran to Darwin and remove +xlf90 + M models/lnd/clm/bld/config_files/config_definition.xsl - Add glacier types + M models/lnd/clm/bld/config_files/config_definition.xml + +>>>>>>>>>>>> Read in glacier elevation classes from surfdata file as GLC_MEC +>>>>>>>>>>>> require it when create_glacier_mec_landunits is .true. and use it +>>>>>>>>>>>> to set value of glc_topomax. Add checking for glc options. +>>>>>>>>>>>> Also remove concurrent directives + M models/lnd/clm/src/main/clm_varcon.F90 -------- Add h2osno_max, lapse_glcmec + and istice_mec, change albice when GLC_NEC>0 + M models/lnd/clm/src/main/clm_varpar.F90 -------- Add npatch_glacier_mec + M models/lnd/clm/src/main/dynlandMod.F90 -------- Add checking for istice_mec + M models/lnd/clm/src/main/decompInitMod.F90 ----- Pass glcmask in + M models/lnd/clm/src/main/clm_initializeMod.F90 - Handle create_glacier_mec_landunit + M models/lnd/clm/src/main/ncdio.F90 ------------- Add 2D module procedures to ncd_iolocal interface + M models/lnd/clm/src/main/subgridMod.F90 -------- Handle create_glacier_mec_landunit if true + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Add glcmecpoi and greenland and antarctic mask/area + add forc_pbot, forc_rho, glc_topo, forc_t, forc_th to ces, forc_q to cws, eflx_bot to cef + add qflx_glcice, glc_rofi, glc_rofl + M models/lnd/clm/src/main/pftdynMod.F90 --------- Change comments + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Handle istice_mec + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Fix comment + M models/lnd/clm/src/main/clm_varsur.F90 -------- Add topoxy + M models/lnd/clm/src/main/controlMod.F90 -------- Add create_glacier_mec_landunit, glc_dyntopo, glc_smb, fglcmask to namelist + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Add sno_export/import + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 Add sno_export/import + M models/lnd/clm/src/main/filterMod.F90 --------- Add istice_mec + M models/lnd/clm/src/main/clm_varctl.F90 -------- Add fglcmask, create_glacier_mec_landunit, + glc_dyntopo, glc_smb, glc_nec, and glc_topomax add some error checking for them + M models/lnd/clm/src/main/initGridCellsMod.F90 -- Make ice sheet masks and deal with glcmask + M models/lnd/clm/src/main/surfrdMod.F90 --------- Read GLCMASK, GLC_MEC, PCT_GLC_MEC and TOPO_GLC_MEC when create_glacier_mec_landunit + M models/lnd/clm/src/main/domainMod.F90 --------- Add glcmask + M models/lnd/clm/src/main/clmtype.F90 ----------- Add forc_pbot, forc_rho, glc_frac, glc_topo add + forc_t, forc_q, eflx_bot, qflx_glcice, glc_rofi, glc_rofl, glcmecpoi, gris and assis mask/area + M models/lnd/clm/src/main/histFldsMod.F90 ------- Add new fields when create_glacier_mec_landunit + M models/lnd/clm/src/main/histFileMod.F90 ------- Add glacier_mec to notes, set_noglcmec to hist_addfld1d + M models/lnd/clm/src/main/mkarbinitMod.F90 ------ Set mask sno to h2osno_max, use istice_mec + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ----- Assess if istice_mec and add qflx_glcice for glc_dyntopo +P + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - Assess if istice_mec + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 -- Assess if istice_mec and add eflx_bot + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 ---- Assess if istice_mec + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- Move forc_pbot/forc_q/forc_t/forc_th from g to c, assess istice_mec + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- Assess if isice_mec + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 ------- Assess if isice_mec move force_t from g to c + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- Assess if istice_mec and add qflx_glcice + M models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 --- Downscale forc_t, forc_th, forc_q, forc_pbot from gridcell to columns + based on surface eleveation for glc_mec landunits + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - Change forcing from g to c + +Summary of testing: + + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_15 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_15 +FAIL ERS.f19_g16.I1850.bluefire.compare_hist.clm3_7_15 +FAIL ERS.f19_g16.I1850.bluefire.compare.clm3_7_15 +FAIL ERI.T31_g37.IG.bluefire +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_15 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_01 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_15 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_15 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_15 + +PASS SMS_D.f19_g16.IG.bluefire +PASS ERS.f19_g16.IG.bluefire +FAIL SMS.T31_g37.IG.bluefire +FAIL SMS.f09_g16.IG.bluefire + + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_15 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_00 +Originator(s): erik (erik) +Date: Tue May 4 23:02:18 MDT 2010 +One-line Summary: Update to datm8, redirect aquifer overflow to drainage, add + gx3v7 masks, script to extract regional datasets, add harvesting for CN, + modify shrubs, include urban model, ice stream for snowcapping, new + build-namelist system, scale solar by solar zenith angle in datm, deep + soil with bedrock at bottom, organic matter in soils, SNICAR for snow + radiation, sparce dense aero, snow cover changes + +Type of tag: doc + +Software engineering changes: + + Update to cpl7 and scripts. + Remove offline and cpl6 modes. + Remove support for CASA model. + Update to datm8 atmospheric data model. + Add gx3v7 land mask for T31 and fv-4x5 horizontal resolutions. + Add gx1v6 land mask for f05, f09, and f19 horizontal resolutions. + Add tx1v1 land mask and 1.9x2.5_tx1v1 horizontal resolution. + Add in 2.5x3.33 horizontal resolution. + Add in T62 horizontal resolution so can run at same resolution as input datm data. + Allow first history tape to be 1D. + Add ability to use own version of input datasets with CLM_USRDAT_NAME variable. + Add a script to extract out regional datasets. + New build-namelist system with XML file describing all namelist items. + Add glacier_mec use-case and stub glacier model. + Add ncl script to time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. + Make default of maxpatch_pft=numpft+1 instead of 4. + Only output static 3D fields on first h0 history file to save space. + Add new fields for VOC (Volatile Organic Compounds) on some surface datasets + Add irrigation area to mksurfdata tool (NOT used in CLM yet). + Add multiple elevation class option for glaciers in mksurfdata tool (NOT used in CLM yet). + Add ascale field to land model in support of model running on it's own grid. + +Science changes: + + Change to freezing temperature constant + Forcing height at atm plus z0+d on each tile + Effective porosity divide by zero fix + Sparse/dense canopy aerodynamic parameters + Ground/snow emissivity smooth transition + Thermal and hydraulic properties of organic soil + Init h2osoi=0.3 + Snow compaction fix + Snow T profile during layer splitting fix + Snow burial fraction + Snow cover fraction + SNICAR (snow aging, black carbon and dust deposition, vertical distribution of solar energy) + Remove SNOWAGE, no longer used + Deep soil (15 layers, ~50m), 5 new layers are hydrologically inactive bed rock + Ground evap (beta), stability, and litter resistance + Organic/mineral soil hydraulic conductivity percolation theory + Richards equation modifications + Normalization of frozen fraction of soil formulation + One-step solution for soil moisture and qcharge + Changes to rsub_max for drainage and decay factor for surface runoff + Fixed diurnal cycle of solar radiation in offline forcing data + Back to CLM3 lakes and wetlands datasets, but 1% rather than 5% threshold (same for glacier) + Changes to pft physiology file from CN + New grass optical properties + New surface dataset assuming no herbaceous understory + Direct versus diffuse radiation offline + New VOC model (MEGAN) + Snow-capped runoff goes to new ice stream and routed to ocean as ice + Dust model always on, LAI threshold parameter change from 0.1 to 0.3 + Daylength control on vcmax + SAI and get_rad_dtime fix + Always run with MAXPATCH_PFT=npfts + 1 instead of 4 + Transient land cover/use mode - datasets, energy and water balance + RTM sub-cycling + Twostream bug fix + Update soil colors + 2m relative humidity + Fix for aquifer leak (SoilHydrologyMod, BalanceCheckMod) + New nitrogen deposition file (units and sum of NOx, NHy) + +Quickstart to new cpl7 scripts... + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) +Quickstart to use of regional extraction scripts and PERSONAL datasets: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) +Describe any changes made to build system: + + Change directory structure to match CCSM. + Add BGP target. + Add choice between ESMF and MCT frameworks. + Start removing #ifdef and directives that supported Cray-X1 Phoenix as now decommissioned. + Make default of maxpatch_pft=numpft+1 instead of 4 for all configurations. + By default turn on CLAMP when either CN or CASA is enabled + New SNICAR_FRC, CARBON_AERO, and C13 CPP ifdef tokens. + + New options added to configure: + + -comp_intf Component interface to use (ESMF or MCT) (default MCT) + -nofire Turn off wildfires for bgc setting of CN (default includes fire for CN) + -pio Switch enables building with Parallel I/O library. [on | off] (default is on) + -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] (default is off) + +Describe any changes made to the namelist: + + NOTE: build-namelist now checks the validity of your namelist you generate by looking at data in the namelist_definition.xml + file. In order to add new namelist items you need to change the code and also edit this file. To view information + on the namelist view the file: + models/lnd/clm/bld/namelist_files/namelist_definition.xml + in your browser and you'll see the names, type, description and valid_values for all namelist variables. + + Changes to build-namelist: + Transient sim_year ranges (i.e. 1850-2000) + Remove cam_hist_case option. + Make sure options ONLY used for stand-alone testing have a "drv_" or "datm_" prefix in them and list these + options all together and last when asking for help from build-namelist. + New options to build-namelist: + -clm_usr_name "name" Dataset resolution/descriptor for personal datasets. Default: not used + Example: 1x1pt_boulderCO_c090722 to describe location, + number of pts, and date files created + New list options to build-namelist: + build-namelist -res list # List valid resolutions + build-namelist -mask list # List valid land-masks + build-namelist -sim_year list # List valid simulation years and simulation year ranges + build-namelist -clm_demand list # List namelist variables including those you could demand to be included. + build-namelist -use_case list # List valid use-cases + build-namelist -rcp list # List valid representative concentration pathways + # for future scenarios + + List of use-cases for build-namelist: + +1850-2100_rcp4.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +1850-2100_rcp8.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + + 1850_control = Conditions to simulate 1850 land-use +2000-2100_rcp8.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 2000 to 2005 and then with the RCP8.5 scenario from MESSAGE + + 2000_control = Conditions to simulate 2000 land-use +20thC_transient = Simulate transient land-use, and aerosol deposition changes from 1850 +to 2005 + pergro = Perturbation error growth test with initial conditions perturbed by +roundoff level + pergro0 = Perturbation error growth test with unperturbed initial conditions + + + New namelist items: + + urban_hac = OFF, ON or ON_WASTEHEAT (default OFF) Flag for urban Heating and Air-Conditioning + OFF = Building internal temperature is un-regulated. + ON = Building internal temperature is bounded to reasonable range. + ON_WASTEHEAT = Building internal temperature is bounded and resultant waste + heat is given off. + urban_traffic = .true. or .false. (default .false.) Flag to include additional multiplicative factor of urban traffic + to sensible heat flux. + fsnowoptions = filename file for snow/aerosol optical properties (required) + fsnowaging = filename file for snow aging parameters (required) + faerdep = filename file of aerosol deposition (required) + + New history variables: (note watt vs. W in units, 26 vs. 76) + BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s + BIOGENCO biogenic CO flux uGC/M2/H + C13_PRODUCT_CLOSS C13 total carbon loss from wood product pools gC13/m^2/s + DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s + EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 + FGR12 heat flux between soil layers 1 and 2 watt/m^2 + FSAT fractional area with water table at surface unitless + FSH_NODYNLNDUSE sensible heat flux not including correction for land use change + watt/m^2 + GC_HEAT1 initial gridcell total heat content J/m^2 + GC_HEAT2 post land cover change total heat content J/m^2 inactive + GC_ICE1 initial gridcell total ice content mm/s + GC_ICE2 post land cover change total ice content mm/s inactive + GC_LIQ1 initial gridcell total liq content mm + GC_LIQ2 initial gridcell total liq content mm inactive <<<< name?? + H2OSNO_TOP mass of snow in top snow layer kg + HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning + watt/m^2 + HK hydraulic conductivity mm/s inactive + ISOPRENE isoprene flux uGC/M2/H + LAND_USE_FLUX total C emitted from land cover conversion and wood produc t pools gC/m^2/s + LAND_UPTAKE NEE minus LAND_USE_FLUX, negative for update gC/m^2/s + LWup upwelling longwave radiation watt/m^2 inactive + MONOTERP monoterpene flux uGC/M2/H + NBP net biome production, includes fire, landuse, and harvest flux, positive for sink + gC/m^2/s + OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s + OVOC other VOC flux uGC/M2/H + ORVOC other reactive VOC flux uGC/M2/H + PBOT atmospheric pressure Pa + PCO2 atmospheric partial pressure of CO2 Pa + PRODUCT_CLOSS total carbon loss from wood product pools gC/m^2/s + PRODUCT_NLOSS total N loss from wood product pools gN/m^2/s + Qair atmospheric specific humidity kg/kg inactive + Qanth anthropogenic heat flux watt/m^2 inactive + Qtau momentum flux kg/m/s^2 + QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s + QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s + QRUNOFF_NODYNLNDUSE total liquid runoff not including correction for land use change (does not include QSNWCPICE) + mm/s + QSNWCPICE excess snowfall due to snow capping mm/s + QSNWCPICE_NODYNLNDUSE excess snowfall due to snow capping not including correction for land use change + mm/s + QSNWCPLIQ excess rainfall due to snow capping mm/s inactive + SMP soil matric potential mm inactive + SNOAERFRC2L surface forcing of all aerosols in snow, averaged only when snow is present (land) + watt/m^2 + SNOAERFRCL surface forcing of all aerosols in snow (land) watt/m^2 + SNOBCFRCL surface forcing of BC in snow (land) watt/m^2 + SNOBCMCL mass of BC in snow column kg/m2 + SNOBCMSL mass of BC in top snow layer kg/m2 + SNOdTdzL top snow layer temperature gradient (land) K/m + SNODSTFRC2L surface forcing of dust in snow, averaged only when snow is present (land) + watt/m^2 + SNODSTFRCL surface forcing of dust in snow (land) watt/m^2 + SNODSTMCL mass of dust in snow column kg/m2 + SNODSTMSL mass of dust in top snow layer kg/m2 + SNOFSRND direct nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRNI diffuse nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRVD direct vis reflected solar radiation from snow watt/m^2 inactive + SNOFSRVI diffuse vis reflected solar radiation from snow watt/m^2 inactive + SNOFSDSND direct nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSNI diffuse nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSVD direct vis incident solar radiation on snow watt/m^2 inactive + SNOFSDSVI diffuse vis incident solar radiation on snow watt/m^2 inactive + SNOLIQFL top snow layer liquid water fraction (land) fraction inactive + SNOOCMCL mass of OC in snow column kg/m2 + SNOOCMSL mass of OC in top snow layer Kg/m2 + SNOOCFRC2L surface forcing of OC in snow, averaged only when snow is present (land) + SNOOCFRCL surface forcing of OC in snow (land) watt/m^2 + watt/m^2 + SNORDSL top snow layer effective grain radius m^-6 inactive + SNOTTOPL snow temperature (top layer) K/m inactive <<< units? + SOILWATER_10CM soil liquid water + ice in top 10cm of soil kg/m2 + SWup upwelling shortwave radiation watt/m^2 inactive + TSOI_10CM soil temperature in top 10cm of soil K + URBAN_AC urban air conditioning flux watt/m^2 + URBAN_HEAT urban heating flux watt/m^2 + VOCFLXT total VOC flux into atmosphere uGC/M2/H + Wind atmospheric wind velocity magnitude m/s inactive + WOOD_HARVESTC wood harvest (to product pools) gC/m^2/s + WOOD_HARVESTN wood harvest (to product pools) gN/m^2/s + + History field name changes: + + ANNSUM_PLANT_NDEMAND => ANNSUM_POTENTIAL_GPP + ANNSUM_RETRANSN => ANNMAX_RETRANSN + C13_DWT_PROD10C_LOSS => C13_PROD10C_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + C13_DWT_PROD10N_LOSS => C13_PROD10N_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + DWT_PROD100N_LOSS => PROD10N_LOSS + DWT_PROD100N_LOSS => PROD100N_LOSS + DWT_PROD100C_LOSS => PROD10C_LOSS + DWT_PROD100C_LOSS => PROD100C_LOSS + HCSOISNO => HC + TEMPSUM_PLANT_NDEMAND => TEMPSUM_POTENTIAL_GPP + TEMPSUM_RETRANSN => TEMPMAX_RETRANSN + + History field names deleted: + SNOWAGE, TSNOW, FMICR, FCO2, DMI, QFLX_SNOWCAP + + Add new urban oriented _U, and _R (Urban and Rural) for: + EFLX_LH_TOT, FGR, FIRA, FSH, FSM, Q2M, QRUNOFF, RH2M, SoilAlpha, TG, TREFMNAV, TREFMXAV, and TSA + (missing _R for SoilAlpha) + +Describe timing and memory performance: + +Versions of any externally defined libraries: + + scripts scripts4_100108b + drv vocemis-drydep12_drvseq3_1_11 + datm datm8_091218 + socn stubs1_2_02/socn + sice stubs1_2_02/sice + sglc stubs1_2_02/sglc + csm_share vocemis-drydep13_share3_091217 + esmf_wrf_timemgr esmf_wrf_timemgr_090402 + timing timing_090929 + mct MCT2_7_0_100106 + pio pio60_prod + cprnc cprnc_081022 + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_5_00 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: new climate for clm4 + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ + +=============================================================== +=============================================================== +Tag name: clm3_8_00 +Originator(s): erik (erik) +Date: Tue May 4 22:39:18 MDT 2010 +One-line Summary: Get future scenarios working, finalize documentation, bring in MEGAN VOC and CNDV, simplify, mksurfdata optimization, fix bugs: snow enthalpy, BMOZ, pergro, use pft weights from fsurdat NOT finidat + +Purpose of changes: + +Get all of the future scenarios working (other than rcp=6.0) and get all of the datasets +for these scenarios (pftdyn, fndepdyn, and aerdep files, for rcp=2.6,4.5, and 8.5). +Finalize the User's Guide for now, with reviews from: Sam, Keith, Dave, and Sean, as +well as more work on tools chapter, and adding testing chapter in appendix. We brought +in the MEGAN version of the Volatile Organic Compounds (VOC) module which also reads +in VOC emission factors from the surface dataset, and hence all fsurdat files needed +to be replaced. Along with this the mksurfdata tool was changed in order to handle VOC's +and effort was made to optimize it, add shared memory paralelism, and do memory +optimization. We also removed the old Dynamic Global Vegetation Model (DGVM) and replaced +it with the Carbon Nitrogen Dynamic Vegetation model (CNDV). Make some simplifications +in the configure system to always use the CCSM version of build files, remove some +unused options, put standalone test options last in configure. Improve documenation in +XML files for configure and build-namelist options. + +Fix many different bugs. Enthalpy in snow combination was sometimes NOT conserved and now +is. There was a problem running DryDeposition for the BMOZ compset that is now fixed. +There were multiple issues running PERGRO testing that is now fixed. Previously, if +both the finidat file and the fsurdat file had PFT weights on them, the values from +the finidat file was used, now it will use the values from the fsurdat file. There are +also several cases where if the weights are different it will abort with an error, or +at least send a message to the log file about the differences. + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Type of tag: doc + +Describe any changes made to build system: + Switch cndv for dgvm, Have configure disallow bad cases + Change configure to NOT allow supln with spinup cases + Do NOT allow exit_spinup and ad_spinup at the same time. + Only allow voc to be set for seq_ccsm NOT ext_ccsm_seq + Remove carbon_aero and pio from configure (always build with pio) + emove unused configure options: clm_exe, -clm_exedir, and -clm_bld. + Move standalone testing options to the end of help. Use CCSM version + of mkSrcfiles/mkDepends, separate config vars into categories, work + on documentation with comments from Keith/Sam. + +Describe any changes made to the namelist: + Add 2000-2100 simulation year range as allowed option + + Two new history fields: + + TSOI_10CM = soil temperature in top 10cm of soil (K) + SOILWATER_10CM = soil liquid water + ice in top 10cm of soil (kg/m2) + + Check for some files based on rcp (fpftdyn, ndepdyn, and aerdep) + + Add in ability to add a user namelist in your case directory to input + namelist items at configure time. Simply add a file called "user_nl_clm" + as a valid namelist and the items in that namelist will show up in the initial + BuildConf/clm.buildnml.csh file. + +List any changes to the defaults for the boundary datasets: + get urbanc_alpha grid and frac files in + get in new single-point datasets + new qtr-degree, T62 and T85 fsurdat + new f10, f05, f09, 1850 fsurdat + new rcp=8.5, f19 pftdyn, + new rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=8.5/4.5/2.6 f19 aerdep 1850-2100 datasets + new rcp=8.5/4.5 f19 fndepdyn 1850-2100 datasets + new rcp=2.6/4.5 f10, f45, f25, f09 aerdep/ndepdyn datasets + new rcp=2.6/4.5,8.5 f19 decadal averages for ndepdat + (Note: harvest was updated in PFTDYN files and raw PFT input files for 2006). + New 10x15 and 4x5 finidat files so that transient cases will work at those resolutions + New finidat files for 1-deg and 2-deg (from fully coupled simulations) + New datasets for I cases that are set in scripts + Duplicate cn datasets for cndv + New pft-physiology files with extra fields for CNDV + Remove 360x720 files, gx3v5, gx1v5 files + Remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + Remove gx1v3, gx1v4, gx1v5 land masks, add drydep defaults. + add mksrf_fvegtyp@1000-1004 + +Describe any substantial timing or memory changes: None + +Code reviewed by: + snow changes came from dlawren and also reviewed by oleson + PFT weight change also reviewed by: dlawren, slevis, oleson + CNDV came from slevis + VOC changes came from Francis Vitt and Jean-Francois Lamarque + history changes came from Keith Oleson, reviewed by Dave Lawrenece + OpenMP bug fix came from Mariana-Vertenstein, reviewed by Pat Worley + +List any svn externals directories updated (csm_share, mct, etc.): all + scripts to scripts4_100406a + drv to drvseq3_1_23 + datm to datm8_100406 + csm_share to share3_100407 + pio to pio1_0_18 + timing to timing_091021 + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_00 + +Changes answers relative to baseline: Yes! + snow change has a small effect on climate (see below) + Bringing in MEGAN VOC changes answers for VOC fluxes in a diagnostic way + Changing to use weights from fsurdat file rather than finidat file, changes + answers for cases with finidat startup files, if the weights are different. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ +http://www.cgd.ucar.edu/ccr/dlawren/research/clm4.0_dev/b40.1850.track1.2deg.003.snowa-b40.1850.track1.2deg.003.controla/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_7_15 +Originator(s): erik (erik) +Date: Tue Apr 27 10:13:57 MDT 2010 +One-line Summary: Finish User's Guide, surfdata files for urban-1pt, fix mksurfdata ifort bugs, work with testing + +Purpose of changes: + +Fix all urban single-point datasets (mexicocity, urbanc_alpha), fix get_regional script +to work. Add more documentation on mksurfdata to users-guide, add pergro procedure +examples, more to testing section. Remove "moving the sun" warning. Fix +ndeplintInterp.ncl and getregional_datasets.ncl scripts. + +Bugs fixed (include bugzilla ID): + 1125 (T85, qtr-degree and urban pt surface datasets) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1150 (Bug in indices in getregional_datasets.ncl script) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New fsurdat files for urban-1p datasets + 1x1_vancouverCAN, 1x1_mexicocityMEX, 1x1_urbanc_alpha, 1x1_asphaltjungleNJ + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm + + datm to datm8_100406 + +List all files eliminated: + +>>>>>>>>>>> Remove test lists no longer used + D models/lnd/clm/test/system/tests_pretag_bangkok + D models/lnd/clm/test/system/tests_pretag_calgary + D models/lnd/clm/test/system/tests_posttag_lightning_nompi + +List all files added and what they do: + +>>>>>>>>>>> Add plot of pergro testing + A models/lnd/clm/doc/UsersGuide/pergro.jpg +>>>>>>>>>>> Add in plotting for pergro testing + A models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat + A models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat + A models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Remove tests no longer used, work on documentation + M models/lnd/clm/test/system/test_driver.sh ---- Remove calgary, work on doc + M models/lnd/clm/test/system/gen_test_table.sh - Remove note for calgary + M models/lnd/clm/test/system/README ------------ Clarify documentation + M models/lnd/clm/test/system/CLM_runcmnd.sh ---- Remove calgary +>>>>>>>>>>> Fix ifort compiler problems, point to $CSMDATA locations of 1850 +>>>>>>>>>>> and 2000 PFT datasets + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ---- Change path + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt - Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ------- Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn --------- Change path + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt - Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ------- Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist ------- Change path + M models/lnd/clm/tools/mksurfdata/README -------------------- Update documentation + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -------------- outnc_double to + .true., fix implicit none statements, add documentation + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ------------- Add ability to set + inputdata directory + M models/lnd/clm/tools/mksurfdata/creategridMod.F90 --------- Change where to loops +>>>>>>>>>>> Fix bug in time axis and getregional indices + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Fix time axis and check it + M models/lnd/clm/tools/ncl_scripts/README ------------- Add note about pergroPlot + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl +>>>>>>>>>>> Fix CLM_USRDAT_NAME and add urban 1pt datasets + M models/lnd/clm/bld/clm.cpl7.template ------------------------ Set resolution for CLM_USRDAT_NAME + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New urban pt1 + datasets: 1x1_vancouverCAN, 1x1_mexicocityMEX, 1x1_urbanc_alpha, 1x1_asphaltjungleNJ +>>>>>>>>>>> Remove SNICAR message about moving the sun + M models/lnd/clm/src/biogeophys/SNICARMod.F90 +>>>>>>>>>>> Finish off current User's Guide +>>>>>>>>>>> Bring rel03->rel04 updates in, run ispell on everything +>>>>>>>>>>> Work on mksurfdata and testing sections, give instructions for pergro +>>>>>>>>>>> Add help from mksurfdata.pl and test_driver.sh scripts + M models/lnd/clm/doc/KnownBugs -- Add note that mkgriddata can not straddle Greenwich + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/config_cache.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/special_cases.xml + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_14 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_14 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Apr 8 16:15:35 MDT 2010 +One-line Summary: Fix rcp=2.6/4.5 1-degree fndepdyn filenames + +Purpose of changes: + +Fix the names of the rcp=2.6/4.5 1-degree fndepdyn filenames (had a 100208 file creation +date but should be 100407). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Fix fndepdyn filenames + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Fix fndepdyn filenames + +Summary of testing: None + +=============================================================== +=============================================================== +Tag name: clm3_7_13 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Apr 8 10:53:06 MDT 2010 +One-line Summary: Add in missing rcp=2.6/6 use-cases, and fix syntax errors in the namelist_defaults file + +Purpose of changes: + +Add in missing use cases for rcp=4.5 and rcp=6 transient future scenarios. Fix syntax errors in the namelist_defaults_clm +file. + +Bugs fixed (include bugzilla ID): Above two problems + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Nonae + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Fix syntax errors + +Summary of testing: None, other than script creation testing + +=============================================================== +=============================================================== +Tag name: clm3_7_12 +Originator(s): erik (erik) +Date: Thu Apr 8 00:30:30 MDT 2010 +One-line Summary: rcp=2.6/4.5 datasets for fndepdyn and aerdepdat, fix some minor issues, new 1pt urban surfdata files + +Purpose of changes: + +Add in urban single-point surfdata files. Add in regridded ndepdyn/aerdep files: f09, +f45, f10, f25. Fix name of f05, 1850 fsurdat file, add in new urban single point +datasets, add back urbanc_alpha grid/frac files. Put rcp in filenames for aerdep/ndep +regrid scripts. chomp frac filename in mksurfdata.pl, for urban single-point files. Make +OPT=TRUE default for mksurfdata. Lengthen allowed gridname for mksurfdata. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + aerdep/ndepdyn for rcp=2.6/4.5 f10, f45, f25, f09 + fix name of f05 fsurdata file for 1850 + get urbanc_alpha grid and frac files in + get in new urban single-point datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + csm_share to share3_100407 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/Makefile ------ make OPT=TRUE the default +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -- lengthen gridname to 32 +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - make sure to chomp fracdata file + +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Add rcp to filename +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Add rcp to filename + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New datasets + aerdep/ndepdyn for rcp=2.6/4.5 f10, f45, f25, f09 + fix name of f05 fsurdata file for 1850 + get urbanc_alpha grid and frac files in + get in new urban single-point datasets + +Summary of testing: + + bluefire interactive testing: All PASS except up to 014 smJ74 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +010 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 + +=============================================================== +=============================================================== +Tag name: clm3_7_11 +Originator(s): erik (erik) +Date: Wed Apr 7 11:59:22 MDT 2010 +One-line Summary: qtr-degree and T85 surfdata, rcp=2.6/4.5 datasets, doc updates + +Purpose of changes: + +Documentation updates, for users guide and namelist and configure xml files (rel04 to +rel05 update). Fix missing deallocate (bug 1133), and line length for NEE. Changes in +mksurfdata so that will run for qtr-degree. New rcp datasets for 4.5 and 2.6, aerdep +(only f19)/ndepdyn/pftdyn datasets. Fix CN spinup test, fix test name for bluefire tests. +Add in qtr-degree and T85 surfdata files. + +Bugs fixed (include bugzilla ID): + 1141 (CN spinup test) + 1137 (qtr-deg fsurdat) + 1136 (line length for NEE in histFlds) + 1135 (miss smG45 test) + 1133 (missing deallocate) + 1125 (T85, qtr-degree and urban pt surface datasets) + (partial T85 and qtr-degree) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + new qtr-degree and T85 fsurdat + new rcp=8.5, f19 pftdyn, rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=4.5/2.6 f19 aerdep 1850-2100 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv + scripts to scripts4_100406a + drv to drvseq3_1_23 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt -- Rename with _hist_ + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt -- Rename with _hist_ + +List all files added and what they do: + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt - Renamed from above + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt - Renamed from above + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Turn supln off for spinup modes + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/tests_pretag_bluefire --------------- Change name of missing test smG45->smG55 + +>>>>>>>>>>>>> Change names of pftdyn text files to include _hist_ +>>>>>>>>>>>>> Memory updates so uses less memory (allocate just before needed +>>>>>>>>>>>>> deallocate after done). This is from the ccsm4_0_rel05 update +>>>>>>>>>>>>> Mariana started the changes and Erik added some more. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 ----- Memory updates + + M models/lnd/clm/bld/clm.cpl7.template - Use $CASETOOLS for Makefile + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - + new qtr-degree and T85 fsurdat + new rcp=8.5, f19 pftdyn, rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=4.5/2.6 f19 aerdep 1850-2100 datasets + +>>>>>>>>>>>>> Documentation udpates updating from rel04 to ccsm4_0_rel05 + M models/lnd/clm/bld/configure -------------------------- change CVS to SVN + M models/lnd/clm/bld/config_files/config_definition.xsl - Correct name + M models/lnd/clm/bld/config_files/config_definition.xml - Add category for maxpft + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Work with categories + and improve descriptions, remove rpntpath + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl - Seperate out + stand-alone testing categories, improve documentation, work + on categories. + +>>>>>>>>>>>>> Documentation udpates updating from rel04 to ccsm4_0_rel05 +>>>>>>>>>>>>> Updates from Sam, Keith, and Sean, more doc on tools and appendix + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_stylesheet.dsl + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/KnownBugs --------------------------- Add notes on: + bugzilla bugs: 669, 1024, 1124, 1125, 1127 + + M models/lnd/clm/src/main/accFldsMod.F90 -- Deallocate outside #ifdef + M models/lnd/clm/src/main/histFldsMod.F90 - Shorten long line for NEE + +Summary of testing: + + bluefire: All PASS up to 024, blHN1 test except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except (up to 26 brAK8 test) +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + jaguar interactive testing: All PASS up to smAK4 test except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............SKIPPED* +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +008 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_10 + +Changes answers relative to baseline: no (b4b) + +=============================================================== +=============================================================== +Tag name: clm3_7_10 +Originator(s): erik (erik) +Date: Mon Mar 22 23:54:48 MDT 2010 +One-line Summary: Fix drydep so that BMOZ case will work + +Purpose of changes: + +Update externals, fix drydep bug (so that BMOZ case will run bug 1132). Add 10x15 and 4x5 +finidat files, so that bluefire.clm.auxtest PET and PST cases will work. Fix +documentation on transient CO2. + +Bugs fixed (include bugzilla ID): + 1132 (clm failure for BMOZ compset) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New 10x15 and 4x5 finidat files so that transient cases will work at those resolutions + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, pio + Update to ccsm4_0_beta47 versions + scripts to scripts4_100322b + drv to drvseq3_1_20 + datm to datm8_100225 + pio to pio1_0_18 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/doc/UsersGuide/Makefile ---------- Fix conversion to xml +M models/lnd/clm/doc/UsersGuide/special_cases.xml - Fix transient CO2 doc +M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff - Fix CO2 file + +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Fix historical rcp value +M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Fix so will run + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add 10x15, 4x5 + finidat files + +M models/lnd/clm/src/main/clm_comp.F90 ------- check drydep_method +M models/lnd/clm/src/main/clmtypeInitMod.F90 - check drydep_method +M models/lnd/clm/src/main/clm_atmlnd.F90 ----- check drydep_method, don't pass + drydep stuff unless drydep_method is DD_XLND + +Summary of testing: + + bluefire/CCSM testing: All PASS except... +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_10 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_07 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_09 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_09 +Originator(s): erik (erik) +Date: Sun Mar 21 21:08:54 MDT 2010 +One-line Summary: Fix snow enthalpy bug, cndv datasets, various fixes + +Purpose of changes: + +Fix snow enthalpy bug from Dave Lawrence. Add rcp to mksurfdata.pl. Add new 2006 datasets +for pftdyn files for mksurfdata. Fix history bug. New rcp 8.5 1-degree pftdyn dataset. +Duplicate all cn datasets for cndv. pergro use cases output in double precision. Some +work on documentation. + +Bugs fixed (include bugzilla ID): + 1128 (cndv needs the same input files as cn) + 1130 (History problem on restarts) + 1131 (pergro use cases need double output files) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + + New 1-degree rcp=8.5 pftdyn dataset with harvest for 2006 + Duplicate cn datasets for cndv + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + snow changes come from dlawren and also reviewed by oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>> Add AIM rcp datasets +A models/lnd/clm/tools/mksurfdata/pftdyn_rcp6.0_simyr1850-2100.txt + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - Add rcp as argument +M models/lnd/clm/tools/mksurfdata/README -------- Document mksurfdata.pl and rcp files + +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl - Get rid of old masks + +M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Get rid of old masks/grids, and sim_year +M models/lnd/clm/tools/interpinic/README ---------- Update documentation + +M models/lnd/clm/tools/mkgriddata/mkgriddata.ccsm_dom - Add clm grid file +M models/lnd/clm/tools/mkgriddata/README ------------- More documentation + +M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml ------ Output history in double +M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml ----- Output history in double +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Duplicate cn files for cndv + New 1-degree rcp=8.5 pftdyn file + +M models/lnd/clm/src/main/histFileMod.F90 - Make sure 3D fields defined before output + +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - conserve enthalpy on snow combination + +M models/lnd/clm/doc/IMPORTANT_NOTES ----- Add notes about fine-mesh +M models/lnd/clm/doc/UsersGuide/Makefile - Remove file for realclean + +Summary of testing: + + bluefire: +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 11 +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 7 +010 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 11 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 7 +015 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 cold .......FAIL! rc= 11 +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 7 +019 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 13 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +023 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 13 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic .....FAIL! rc= 13 +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +016 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 11 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +031 brF93 TBR.sh 17p_vodsrsc_do clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 cold .......FAIL! rc= 11 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 7 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 13 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +047 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +049 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 2 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort: interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +009 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +010 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +011 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +013 smOC4 TSM.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +017 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 + edinburgh/ifort +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_08 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ +http://www.cgd.ucar.edu/ccr/dlawren/research/clm4.0_dev/b40.1850.track1.2deg.003.snowa-b40.1850.track1.2deg.003.controla/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_7_08 +Originator(s): Mariana Vertenstein (mvertens) +Date: Fri Mar 12 13:26:09 MST 2010 +One-line Summary: Removal of check for weights if dynamic land use is used + +Purpose of changes: +This one line change enabled the vast majority of the CCSM tests to pass. + +Verified that ERI 20th century tests in CCSM test suite for ccsm4_0_beta46 now passed with this changed + +This was reviewed by Dave Lawrence and Sam Levis + +Everything from clm3_7_07 applies except for the following: + +M biogeophys/BiogeophysRestMod.F90 + - if ( nsrest == 1 .or. (nsrest == 3 .and. fpftdyn /= ' ') )then + - ! Do NOT do any testing for restart or a pftdyn branch case + + if ( nsrest == 1 .or. fpftdyn /= ' ' )then + + ! Do NOT do any testing for restart or a pftdyn case + also added in a #if CNDV + +M biogeochem/CNDVEstablishmentMod.F90 +M main/clmtypeInitMod.F90 + - fix for case when leaf area index is pathologically large + the original fix for this was not longer working - and the above changes address this + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_clm.xml + - fixed issues related to getting fndepdat for -bgc cndv + +=============================================================== +Tag name: clm3_7_07 +Originator(s): erik (erik) +Date: Wed Mar 10 23:35:37 MST 2010 +One-line Summary: New finidat datasets for 1-deg, 2-deg, and abort if weights from finidat/fsurdat files are too different, and use fsurdat files as truth + +Purpose of changes: + +Use surfdata weights and stop if finidat file weights are too different. Use ccsm4init +datasets for finidat files for 1-deg and 2-deg. In I compsets, setup for special I case +finidat files. Update scripts. Drydep changes from Francis. Change cell_method to +cell_methods. Allow clm_start_type to be overridden if on use_case. Only set orb_iyearad +for standalone clm testing. Allow vars on use_cases to not be set for some configs. Make +sure all BGC modes are set for variables on use_cases. Set cold-start for pergro cases. +Update documentation. + +Bugs fixed (include bugzilla ID): + 1098 (use weights from surdat file rather than finidat file) + 1121 (history variable attribute cell_methods misnamed) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + + New finidat files for 1-deg and 2-deg (from fully coupled simulations) + New datasets for I cases that are set in scripts + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, slevis, oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_100310c + + This version of scripts sets up special finidat files that will be used + for all I cases (other cases use the fully coupled datasets that are stored + in the namelist_defaults_clm.xml database). + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New finidat files +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ------------ Changes from Francis +M models/lnd/clm/src/main/ncdio.F90 --------------------------- Change cell_method to cell_methods +M models/lnd/clm/src/main/clm_initializeMod.F90 --------------- Remove second call to pftdyn_interp +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --------- Compare weights only + if NOT restart and NOT branch with pftdyn. If weights are too different + abort, if close enough write a warning and continue using the surfdata + weights + +>>>>>>>>>>>>>>>> Some work on documentation +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE + +>>>>>>>>>>>>>>>> Allow clm_start_type to be overridden if on use_case +>>>>>>>>>>>>>>>> Allow vars in use_cases to not be set for some configs +M models/lnd/clm/bld/build-namelist + +>>>>>>>>>>>>>>>> Change start_type to clm_start_type for all use-cases +>>>>>>>>>>>>>>>> Only set orb_iyearad for standalone clm testing +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml --------- Set start to cold +M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml -------- Set start to cold +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +Summary of testing: + + bluefire: All PASS except... +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except... +FAIL ERS.f19_g16.I1850.bluefire.compare_hist.clm3_7_06 +FAIL ERS.f19_g16.I1850.bluefire.compare.clm3_7_06 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_06 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_07 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_06 +SFAIL PST.f10_f10.I8520CN.bluefire.GC.201955 +SFAIL PET_PT.f10_f10.I8520CN.bluefire.GC.201955 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_06 + jaguar interactive testing: All PASS up to... +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold + +CLM tag used for the baseline comparison tests if applicable: clm3_7_06 + +Changes answers relative to baseline: Different initial condition datasets, + also now using weights from surfdata files rather than finidat files + +=============================================================== +=============================================================== +Tag name: clm3_7_06 +Originator(s): erik (erik) +Date: Wed Mar 10 16:35:57 MST 2010 +One-line Summary: Bring cndv branch to trunk + +Purpose of changes: + +Bring CNDV branch to trunk cndv16_clm3_7_05 (erik/slevis). Fix bug 978 for Sam (nl +option for branch). Put CROP part of CNDV branch on it's own branch. Add a couple more +history fields (LAND_USE_FLUX, and LAND_UPTAKE). Add HTOP to default output. SNICAR_FRC +fix, test SNICAR_FRC. Fix VOC by making sure fsun240 is between 0 and 1. Fix CO2 PPMV for +I cases. Add in script to create CO2 streams file that can be used by datm8. Update VOC +documentation. Get in updates from ccsm4_0_rel branch. Remove 360x720 grid, files with +gx3v5/gx1v5 masks. Fix bug 1120, by initializing displavegc+ for CN, Change start_type to +clm_start_type, don't allow both fndepdat and fndepdyn. Don't allow spinup modes with +supln, and don't allow both ad_spinup and exit_spinup. Move testing from gx3v5 to gx3v7 +mask + +Bugs fixed (include bugzilla ID): + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1121 (history variable attribute cell_methods misnamed) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Switch cndv for dgvm, Have configure disallow +bad cases + Change configure to NOT allow supln with spinup cases + Do NOT allow exit_spinup and ad_spinup at the same time. + Only allow voc to be set for seq_ccsm NOT ext_ccsm_seq + +Describe any changes made to the namelist: Add override_nsrest namelist option + +List any changes to the defaults for the boundary datasets: + New pft-physiology files with extra fields for CNDV + Add new f05 1850 surfdata file + Remove 360x720 files, gx3v5, gx1v5 files + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis, self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, csm_share, mct, and pio + + scripts to scripts4_100306 + drv to drvseq3_1_19 + csm_share to share3_100228 + mct to MCT2_7_0_100228 + pio to pio1_0_15 + +List all files eliminated: Remove DGVM files + + D models/lnd/clm/src/biogeochem/DGVMLightMod.F90 + D models/lnd/clm/src/biogeochem/DGVMReproductionMod.F90 + D models/lnd/clm/src/biogeochem/DGVMAllocationMod.F90 + D models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 + D models/lnd/clm/src/biogeochem/DGVMKillMod.F90 + D models/lnd/clm/src/biogeochem/DGVMEstablishmentMod.F90 + D models/lnd/clm/src/biogeochem/DGVMRestMod.F90 + D models/lnd/clm/src/biogeochem/DGVMMod.F90 + D models/lnd/clm/src/biogeochem/DGVMMortalityMod.F90 + D models/lnd/clm/src/biogeochem/DGVMTurnoverMod.F90 + D models/lnd/clm/src/biogeochem/DGVMFireMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>>> Add CNDV files + A models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 + A models/lnd/clm/src/biogeochem/CNDVLightMod.F90 + A models/lnd/clm/src/biogeochem/CNDVMod.F90 + A models/lnd/clm/src/biogeochem/CNDVEcosystemDynIniMod.F90 +>>>>>>>>>>>>> Add script to convert CAM historical greenhouse gas file to CO2 history +>>>>>>>>>>>>> file that can be used in datm streams + A models/lnd/clm/tools/ncl_scripts/getco2_historical.ncl +>>>>>>>>>>>>> Add SNICAR_FRC and CNDV config files to test + A models/lnd/clm/test/system/config_files/_scsnf_dh + A models/lnd/clm/test/system/config_files/_scsnf_dm + A models/lnd/clm/test/system/config_files/_scsnf_do + A models/lnd/clm/test/system/config_files/17p_cndvsc_dh + A models/lnd/clm/test/system/config_files/17p_cndvsc_dm + A models/lnd/clm/test/system/config_files/17p_cndvsc_do + A models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>> Add files to describe how to add streams for CO2 + A models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + A models/lnd/clm/doc/UsersGuide/co2_streams.txt + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Document new getco2 script, use correct namelist in getregional script + M models/lnd/clm/tools/ncl_scripts/README + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl + +>>>>>>>>>>>>>>> Add K configure tests for CNDV, B configure tests for SNICAR_FRC, +>>>>>>>>>>>>>>> and create_croplunit tests Change maxpft 17 tests to numpft+1 + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_h + M models/lnd/clm/test/system/config_files/17p_cnnsc_m + M models/lnd/clm/test/system/config_files/17p_cnnsc_o + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnnsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_ds + + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_breeze + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_pretag_bangkok + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_pretag_calgary + + M models/lnd/clm/test/system/input_tests_master - Add B and K tests + M models/lnd/clm/test/system/test_driver.sh ----- Update for bluefire changes + to scripts + M models/lnd/clm/test/system/mknamelist --------- Change start_type to + clm_start_type add in nrevsnfile + M models/lnd/clm/test/system/README.testnames --- Change K configure +tests to mean CNDV + +>>>>>>>>>>>>> + M models/lnd/clm/bld/configure ---- Swap out cndv for dgvm. -bgc cndv turns on + both CN AND CNDV cpp tokens. + voc part of standalone_test arguments + supln and spinup options can't be on at the same +time + exit_spinup and ad_spinup can't be on at the +same time + M models/lnd/clm/bld/queryDefaultXML.pm ---------------- Swap cndv for DGVM + M models/lnd/clm/bld/config_files/config_definition.xml - Swap cndv for dgvm + voc in standalone_test, maxpft lists valid numbers +category + M models/lnd/clm/bld/build-namelist ----- Change start_type to clm_start_type + Don't allow both fndepdyn and fndepdat to e set + Work with nrevsn, so not always given + M models/lnd/clm/bld/clm.cpl7.template -- Rename start_type to clm_start_type, and + let default be "default" + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl ------ Update mask list + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Add override_nsrest, + mkghg_bndtvghg, rename start_type to clm_startype + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add +clm_start_type + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Remove domain +files + with gx3v5 and gx1v5 masks + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- new pft-physiology files for CNDV + Use same fndepdat datasets for cndv + Remove 360x720 files, + files with gx3v5 and gx1v5 masks + New 1850 f05 fsurdat file + Add mkghg_bndtvghg dataset to point to CAM + historical greenhouse dataset + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ----- Remove +start_type + + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/special_cases.xml + +>>>>>>>>>>>>> Add in landuseflux/landuptake, always use hardwire_sla for VOC +>>>>>>>>>>>>> Set displavegc for CN not just CNDV, new fields for SNICAR_FRC restarts + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Calculate landuseflux/landuptake + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 ------- Calculate pftmayexist for CNDV + Remove concurrent directives + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Always use hardwire_sla + Remove DGVM CPP ifdefs, fix for transient problem from Dave + loop over soil filter rather than non-lake + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set displavegc etc. for CN as well as CNDV + Add some CNDV fields + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------- Remove agdd0/agdd5,fnpsn10, + initialize landuseflux/landuptake + M models/lnd/clm/src/main/CNiniSpecial.F90 --------------- initialize landuseflux/landuptake + M models/lnd/clm/src/main/clmtype.F90 -------------------- Swap DGVM vars for CNDV + add pftmayexist, landuseflux/landuptake + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Add LAND_USE_FLUX, LAND_UPTAKE, make HTOP active + Swap DGVM fields for CNDV + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 ---- Add fields needed for SNICAR_FRC + + M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 --- Remove uneeded use statement + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ---- CNDV changes + M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNGRespMod.F90 ----------- Remove junk + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ---- + M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 --- + M models/lnd/clm/src/biogeochem/CNFireMod.F90 ------------ CNDV section + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 ----------- Remove junk + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 Remove junk + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ---------- Pass lbp, ubp to CNAllocate + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 --- Formatting changes + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- Swap CNDV for DGVM + M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------ Add CNDV section + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ---- Add CNDV section + M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 -------- Remove junk + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 ------- Remove junk + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Pass pft loop indices in, + formatting changes remove junk + M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 --------- Remove junk + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ------- Swap CNDV for DGVM + M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ---- Pass lbp, ubp to CNDecompAlloc + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Use dwood from pft-physiology file + Add CNDV section + + M models/lnd/clm/src/main/clm_varpar.F90 --------- Change some of the names around + M models/lnd/clm/src/main/CNiniTimeVar.F90 ------- CNDV section for litter fall + M models/lnd/clm/src/main/clm_comp.F90 ----------- Swap CNDV for DGVM + M models/lnd/clm/src/main/clm_initializeMod.F90 -- Swap CNDV for DGVM + M models/lnd/clm/src/main/accFldsMod.F90 --------- Swap CNDV for DGVM + M models/lnd/clm/src/main/subgridMod.F90 --------- Handle create_croplandunit correctly + M models/lnd/clm/src/main/pftdynMod.F90 ---------- Add CNDV subroutine: pftwt_init + For CNDV make pftwt_interp public +and + M models/lnd/clm/src/main/iniTimeConst.F90 ------- Change dgvm vars init + M models/lnd/clm/src/main/restFileMod.F90 -------- Remove DGVM + M models/lnd/clm/src/main/controlMod.F90 --------- Add override_nsrest, swap CNDV for DGVM + M models/lnd/clm/src/main/initSurfAlbMod.F90 ----- Swap CNDV for DGVM + M models/lnd/clm/src/main/filterMod.F90 ---------- Swap CNDV for DGVM remove concurrent directives + M models/lnd/clm/src/main/clm_driver.F90 --------- Swap CNDV for DGVM + M models/lnd/clm/src/main/clm_varctl.F90 --------- Swap CNDV for DGVM, fix check for create_croplandunit + M models/lnd/clm/src/main/ndepFileMod.F90 -------- Remove junk + M models/lnd/clm/src/main/initGridCellsMod.F90 --- Fix create_croplandunit + M models/lnd/clm/src/main/pftvarcon.F90 ---------- New CNDV parameters, formatting changes, + Always read all parameters to make read easier to understand + M models/lnd/clm/src/main/surfrdMod.F90 ---------- Swap CNDV for DGVMA, fix create_croplandunit, change some names + + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ----- Remove junk + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - Remove junk add comments + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Change comments remove DGVM + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- Change formatting add comments + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- Remove DGVM + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - Remove junk + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Remove DGVM add in CNDV + +Summary of testing: + + bluefire: +FAIL! rc= 7 +025 smK51 TSM.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................PASS +026 erK51 TER.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 10+38 arb_ic ...............PASS +027 brK51 TBR.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 24+24 arb_ic ...............PASS +028 blK51 TBL.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +029 smHN1 TSM.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colPASS +030 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 13 +031 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 11 +032 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 5 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 7 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 + bluefire/CCSM testing: All PASS except.. (compare tests fail because CO2 level was changed for 2000 compsets) +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm3_7_05 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_7_05 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm3_7_05 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_7_05 +BFAIL ERS_D.f45_g37.I.bluefire.compare.clm3_7_05 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_05 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_06 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_05 +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_05 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_05 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_05 +BFAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_05 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_05 + +Changes answers relative to baseline: I2000 cases are different because of new CCSM_CO2_PPMV + +=============================================================== +=============================================================== +Tag name: clm3_7_05 +Originator(s): erik (erik) +Date: Wed Feb 24 00:33:08 MST 2010 +One-line Summary: Bring VOC branch source code to trunk + +Purpose of changes: + +Move VOC branch over to trunk (vocemis-drydep19_clm3_7_04), this includes source code +changes for VOC and drydep. Ensure answers for f09, f19, f10 are identical to clm3_7_02 +(other than VOC fields). Split users guide into separate files by chapter. Remove dublin. +Add rcp option to getregional dataset script. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Fix date of 1x1_tropicAtl surfdata + New T62 fsurdat file with VOC + Fix syntax error in default_datm file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and drv + + scripts to scripts4_100222 (uses new bluefire compiler with bug-fix for + reproducibility bug) + drv to drvseq3_1_17 + +List all files eliminated: + +>>>>>>>>>>>>> Rename to edinburgh + D models/lnd/clm/test/system/tests_pretag_dublin + D models/lnd/clm/test/system/tests_pretag_dublin_nompi + +>>>>>>>>>>>>> Split into separate files + D models/lnd/clm/doc/UsersGuide/index.xml + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_edinburgh ------- Rename dublin files + A models/lnd/clm/test/system/tests_pretag_edinburgh_nompi - Rename dublin files + +>>>>>>>>>>>>> Split Users Guide into separate files by chapter + A models/lnd/clm/doc/UsersGuide/tools.xml + A models/lnd/clm/doc/UsersGuide/preface.xml + A models/lnd/clm/doc/UsersGuide/clm_ug.xml + A models/lnd/clm/doc/UsersGuide/adding_files.xml + A models/lnd/clm/doc/UsersGuide/config_cache.xml + A models/lnd/clm/doc/UsersGuide/custom.xml + A models/lnd/clm/doc/UsersGuide/get_Icaselist.pl --- Script to list I cases + A models/lnd/clm/doc/UsersGuide/single_point.xml + A models/lnd/clm/doc/UsersGuide/special_cases.xml + +>>>>>>>>>>>>> Add module to handle dry-deposition velocity + A models/lnd/clm/src/biogeochem/DryDepVelocity.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Remove dublin + M models/lnd/clm/test/system/test_driver.sh + M models/lnd/clm/test/system/input_tests_master - Decrease mexicoCity run length to 157 + M models/lnd/clm/test/system/CLM_runcmnd.sh + +>>>>>>>>>>>>> Fix bug in dynamic PFT file generation example, let intel allow lines of +>>>>>>>>>>>>> any length + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn - Use 1850 veg file to start from + M models/lnd/clm/tools/mksurfdata/Makefile ---------- Remove intel -132 so can be any +length + M models/lnd/clm/tools/mkgriddata/Makefile ---------- Remove intel -132 so can be any + length, add SMP option + M models/lnd/clm/tools/mkdatadomain/Makefile -------- Remove intel -132 so can be any +length + + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add absolute_path and + ability to use rcp + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Add rcp + correct namelist for domainfile + +>>>>>>>>>>>>> + M models/lnd/clm/bld/clm.cpl7.template ---- Turn rtm off for PTS_MODE, remove lnd_in +and Filepath files from clmconf + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Fix syntax error in +2.5x3.33 domain file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Fix date of +surfdata_1x1_tropicAtl file + +>>>>>>>>>>>>> Split into separate files by Chapter + M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>>>>>>>> Source code changes to use MEGAN VOC and dry-deposition + + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 -- Add readAnnualVegetation + subroutine for dry-deposition, use some F90 NetCDF, + get mlai difference between months for dry-deposition + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------ New MEGAN VOC module + remove concurrent directives + M models/lnd/clm/src/main/clm_varpar.F90 ---------------- Change comment on nvoc + M models/lnd/clm/src/main/clm_comp.F90 ------------------ Interp monthly veg for + drydep on clm_init2 + M models/lnd/clm/src/main/clm_initializeMod.F90 --------- add readAnnualVegetation + M models/lnd/clm/src/main/accFldsMod.F90 ---------------- 24hr and 10day accumulators for + t_veg, fsd, fsi, fsun, laip, remove concurrent directives + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------ Add new VOC and drydep variables + M models/lnd/clm/src/main/iniTimeConst.F90 -------------- Read in VOC emission + factors, remove concurrent directives + M models/lnd/clm/src/main/clm_atmlnd.F90 ---------------- Add VOC and drydep fluxes + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ------ Pass VOC and drydep fluxes + M models/lnd/clm/src/main/clm_driver.F90 ---------------- Always call VOC emission + and call depvel_compute + M models/lnd/clm/src/main/clmtype.F90 ------------------- Add some VOC and drydep + variables, move sandfrac/clayfrac for all not just CASA + add accumulation variables + M models/lnd/clm/src/main/histFldsMod.F90 --------------- Bunch of new inactive + variables for VOC fluxes + M models/lnd/clm/src/main/inicFileMod.F90 --------------- Li Xu: correct ncd_iolocal and snow_fraction + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Deal with drydep velocity + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Add mlaidiff to restart + file, if fsun set to NaN on restart set it to spval + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Keep track of boundary + layer resistance + +Summary of testing: + + Baseline tests are identical other than VOC flux fields.. +> grep RMS +> /ptmp/erik/test-driver.612049/TBL.4p_vodsrsc_dh.clm_std^nl_urb.20021231:NONE:3600.1.9x2.5^0.9x1.25.gx1v6.48.arb_ic/cprnc.clmrun.clm2.h0.2002-12-31-00000.nc.out +> | grep -v 0.0000E+00 + RMS BIOGENCO 1.0058E-01 + RMS ISOPRENE 2.9500E+02 + RMS MONOTERP 2.9129E+00 + RMS ORVOC 3.3526E-01 + RMS OVOC 3.3526E-01 + RMS VOCFLXT 2.9641E+02 + + bluefire: +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +033 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 +041 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 7 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 8 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +050 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 7 + bluefire interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +017 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 7 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +023 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +028 blL78 TBL.sh _nrsc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic ...........FAIL! rc= 7 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 7 +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +RUN ERS_D.f45_g37.I.bluefire.GC.092123 +PASS PST.f45_g37.I1850.bluefire.cpl +PASS PST.f45_g37.I1850.bluefire.atm +PASS PST.f45_g37.I1850.bluefire.lnd +PASS PST.f45_g37.I1850.bluefire.ice +PASS PST.f45_g37.I1850.bluefire.ocn +PASS PST.f45_g37.I1850.bluefire.glc +PASS PET_PT.f45_g37.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PEND ERH_D.f10_f10.I1850CN.bluefire.GC.092123 +PASS PST.f10_f10.I8520CN.bluefire.cpl +PASS PST.f10_f10.I8520CN.bluefire.atm +PASS PST.f10_f10.I8520CN.bluefire.lnd +PASS PST.f10_f10.I8520CN.bluefire.ice +PASS PST.f10_f10.I8520CN.bluefire.ocn +PASS PST.f10_f10.I8520CN.bluefire.glc + jaguar/CCSM testing: +PASS ERS_D.f09_g16.I1850.jaguar +PASS PST.f10_f10.I8520CN.jaguar.cpl +PASS PST.f10_f10.I8520CN.jaguar.atm +PASS PST.f10_f10.I8520CN.jaguar.lnd +PASS PST.f10_f10.I8520CN.jaguar.ice +PASS PST.f10_f10.I8520CN.jaguar.ocn +PASS PST.f10_f10.I8520CN.jaguar.glc +PASS PET_PT.f10_f10.I8520CN.jaguar + jaguar interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic FAIL! rc= 8 +014 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 5 +016 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 4 + edinburgh/ifort interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +009 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +010 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +011 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +012 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +013 smOC4 TSM.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +017 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +008 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +015 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 7 +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold .......FAIL! rc= 7 +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_04 + +Changes answers relative to baseline: No bit-for-bit (except voc flux fields) + +=============================================================== +=============================================================== +Tag name: clm3_7_04 +Originator(s): erik (erik) +Date: Wed Feb 17 23:22:23 MST 2010 +One-line Summary: Bring VOC branch (vocemis-drydep18_clm3_7_03) tools, testing, and build to trunk (everything other than VOC code changes) + +Purpose of changes: + +Move VOC branch (vocemis-drydep18_clm3_7_03) to trunk for support functionality, tools, +testing, everything but the code changes. This includes optimization of mksurfdata, +adding new tests, adding drydep to build, listen to cpl flag if aerosols are sent, update +documentation about configure variables, remove pio and carbon_aero config options +(always build with pio), remove local Macro's files for Darwin (yong_g95, and +breeze_intel), and remove gx1v3, gx1v4 masks, and 1x1.25 and 2x2.5 grids. All NCL regrid +scripts to be able to use GRDFIL env variable to set location of a grid file just +created. turn rtm off if PTS_MODE is TRUE. mksurfdata optimization includes: create +subroutines for landuse normalization, add OpenMP parallelism, optimize memory so +deallocate when done, and put OMP threads, veg filenames and optimization level on +mksurfdata files. Move shr_drydepInputMod.F90 to drv/shr/seq_drydepMod.F90 (from +csm_share to drv). Update externals. Work on documentation using output logs from scripts +and moving documentation into separate chapters. + +Bugs fixed (include bugzilla ID): + 926 (pftdyn code needs to be shared in mksurfdata) + 1105 (Turn RTM mode off for PTS_MODE) + 1110 (dt limit error, for mexicocity) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1121 (history variable attribute cell_methods misnamed) + 1118 (Restarts with SNICAR_FRC fail) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Remove carbon_aero and pio from configure (always build with pio) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + Remove gx1v3, gx1v4, gx1v5 land masks, add drydep defaults. + Update 2.65x3.33@2000, 1x1_tropicAtl@2000, f09@1850 and 1x1_tropicAtl@1000-1004 pftdyn + add mksrf_fvegtyp@1000-1004 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, drv, datm, and timing + + csm_share to share3_100215 + scripts to scripts4_100216 + drv to drvseq3_1_16 + datm to datm8_100215 + timing to timing_091021 + +List all files eliminated: + +>>>>>>>>>>>> Remove local Macros files, and remove maxpft=4 vodsrcsc tests + D models/lnd/clm/bld/config_files/Macros.yong_g95 + D models/lnd/clm/bld/config_files/Macros.breeze_intel + D models/lnd/clm/test/system/config_files/4p_vodsrsc_m + D models/lnd/clm/test/system/config_files/4p_vodsrsc_h + + D models/lnd/clm/doc/UsersGuide/index.xml -- Rename to clm_ug.xml + Divide most of the content into separate chapters. + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_scnv_dh ---- No-VOC debug-hybrid mode + A models/lnd/clm/test/system/config_files/_scnv_do ---- No-VOC debug-pure SMP hybrid mode + A models/lnd/clm/test/system/config_files/17p_scnv_dh - 17pft no-VOC debug-hybrid mode + A models/lnd/clm/test/system/config_files/17p_scnv_do - 17pft no-VOC debug-pure SMP mode + A models/lnd/clm/test/system/nl_files/clm_drydep ------ Turn on drydep in namelist + A models/lnd/clm/tools/mksurfdata/mkvocef.F90 --------- VOC emissions + A models/lnd/clm/bld/namelist_files/namelist_defaults_drydep.xml - Drydep namelist defaults + A models/lnd/clm/doc/UsersGuide/tools.xml --------- Tools chapter + A models/lnd/clm/doc/UsersGuide/preface.xml ------- Preface and introduction chapter + A models/lnd/clm/doc/UsersGuide/clm_ug.xml -------- Change name of index.xml + Move most of the contents into separate chapters + A models/lnd/clm/doc/UsersGuide/adding_files.xml -- Adding files chapter + A models/lnd/clm/doc/UsersGuide/config_cache.xml -- Sample config cache file so can + run build-namelist for documentation + A models/lnd/clm/doc/UsersGuide/custom.xml -------- Customizing chapter + A models/lnd/clm/doc/UsersGuide/get_Icaselist.pl -- Script to get list of I cases + A models/lnd/clm/doc/UsersGuide/single_point.xml -- Single point chapter + A models/lnd/clm/doc/UsersGuide/special_cases.xml - Special cases chapter + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README - Add nv no-VOC config case + M models/lnd/clm/test/system/README.testnames ---- Add drydep testnames + M models/lnd/clm/test/system/test_driver.sh ------ Use generic_linux_intel mach for breeze + also changes to get jaguar to work + M models/lnd/clm/test/system/input_tests_master -- Add drydep and no-VOC tests, cut + back Mexicocity test to 158 steps + + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 -------- Add mksrf_gridnm and mksrf_fvocef + M models/lnd/clm/tools/mksurfdata/ncdio.F90 ----------- Write out error codes on a problem. + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional - Add voc file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn --- Add voc file, use 1850 veg file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept - Add voc file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist - Add voc file. + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 ---- Move file definition for harvest to init sub + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ------- Write out OpenMP threads + and OPT TRUE or FALSE, VOC fields, and veg filenames + M models/lnd/clm/tools/mksurfdata/mkorganic.F90 ------- Remove test and use 3D areaave + M models/lnd/clm/tools/mksurfdata/Makefile ------------ Add in SMP option to turn on OpenMP + M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 --- Remove single level fields + and use 4D areaave + M models/lnd/clm/tools/mksurfdata/areaMod.F90 --------- Add 3D and 4D areaave interfaces + and add OpenMP directives + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -------- Create subroutines shared + by dynpft loop and surfdata: change_landuse and normalizencheck_landuse. + Allocate memory as late as possible and deallocate as soon as possible. + Add: mksrf_gridnm and mksrf_fvocef to namelist + Add mkvocef and add to output file + M models/lnd/clm/tools/mksurfdata/Srcfiles ------------ Add mkvocef.F90 + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ------- Allow command line arguments + to pick resolutions and simulation-years. Read in namelist database information + for checking and using defaults. Add in mksrf_fvocef, and use mksrf_gridnm to + give output file same name as the input grid resolution name. + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 -------- Remove testing, add 3D areaave + + M models/lnd/clm/tools/ncl_scripts/README ----------- Remove script no longer available. + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Allow env var GRDFIL to give + grid file to use + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Allow env var GRDFIL to give + grid file to use + + M models/lnd/clm/tools/mkgriddata/README -- Fix typo + + M models/lnd/clm/bld/configure --------------------------------- Remove carbon_aero + and pio (always build with pio), and make voc default on + M models/lnd/clm/bld/queryDefaultNamelist.pl ------------------- Add drydep file. + M models/lnd/clm/bld/config_files/config_sys_defaults.xml ------ Change mach + defaults, remove darwin make linux edinburgh_pgi + M models/lnd/clm/bld/config_files/config_definition.xml -------- Remove carbon_aero + and pio, make default for mode ext_ccsm_seq, make voc on, + work on documentation + M models/lnd/clm/bld/build-namelist ---------------------------- Add drydep, remove + carbon_aero and pio + M models/lnd/clm/bld/clm.cpl7.template ------------------------- Turn rtm off for PTS_MODE + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add mksrf_fvegtyp, + remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + remove gx1v3, gx1v4, gx1v5 land masks, add drydep_method, and drydep_list + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Remove 1x1.25, + 2x2.5, and gx1v3, gx1v4, gx1v5 domain files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Remove 1x1.25, + and gx1v3, gx1v4, gx1v5 files + update 2.65x3.33@2000, 1x1_tropicAtl@2000, f09@1850 + and 1x1_tropicAtl@1000-1004 pftdyn + add mksrf_fvegtyp@1000-1004 + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml -- Remove gx1v4, gx1v5 start dates + + M models/lnd/clm/doc/UsersGuide/Makefile --- Get makefile to use scripts to make + log info to put into document, and separate out document + into chapters + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- Use atm_aero in infodata + to determine: caerdep_filled, and dustdep_filled + some changes to get ready for VOC and drydep branch to come to trunk + +Summary of testing: + + bluefire: All PASS up to 019 brEH1 + bluefire interactive testing: All PASS except... +004 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 +arb_ic FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: +PASS SMS_RLB.f45_f45.I.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort: All PASS except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_03 + +Changes answers relative to baseline: 1x1_tropicAtl changes due to new surfdata file + +=============================================================== +=============================================================== +Tag name: clm3_7_03 +Originator(s): erik (erik) +Date: Wed Feb 10 11:29:56 MST 2010 +One-line Summary: Add in more future scenario datasets, new history fields from Keith + +Purpose of changes: + +Add in pftdyn dataset for 1-degree rcp-8.5. Add in interpolated aerdep/ndepdyn scenario +files for f10, f09. Add in code change from Keith O. for average of top soil layers. Add +in rcp for ndep and aerdep regrid scripts. Allow 2000-2100 sim_year_range for 1-degree +resolution, and have a aerdep dataset for 1-degree for 2000-2100 (copy other 1850-2100 +datasets). There is also a 1-degree 1850-2100 aerosol dataset, but the file is large (~9GB). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add 2000-2100 simulation year range as allowed option + + Two new history fields: + + TSOI_10CM = soil temperature in top 10cm of soil (K) + SOILWATER_10CM = soil liquid water + ice in top 10cm of soil (kg/m2) + +List any changes to the defaults for the boundary datasets: New datasets for rcp=8.5 + f09, rcp=8.5 pftdyn for 1850-200 (use same file for 2000-2100) + faerdep, for 1850-2100 rcp=8.5, f10, f45, f25, f09 (and 2000-2100) and f19 for 2000-2100 + fndepdyn, for 1850-2000 rcp=8.5 f09 (use same file for 2000-2100), f25, f45, f10 + fndepdyn for 1850-2100 rcp=2.6 for native f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, history changes from Keith Oleson, reviewed by Dave Lawrenece + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: use-case for 2000-2100 for high resolution (1 degree and up) + +>>>>>>>>>> Add a use-case for a future scenario that only includes 2000-2100 +>>>>>>>>>> this is for 1-degree and higher resolution where we can't include the +>>>>>>>>>> historical period and have resonable sized files. + A models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Get regridding scripts working for rcp's + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Allow rcp to be set, more printing + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Allow rcp to be set, allow more sim_year_ranges + +>>>>>>>>>> New rcp=8.5 datasets, and 2000-2100 support for 1-degree + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New rcp=8.5 datasets + f09, rcp=8.5 pftdyn for 1850-200 (use same file for 2000-2100) + faerdep, for 1850-2100 rcp=8.5, f10, f45, f25, f09 (and 2000-2100) and f19 for 2000-2100 + fndepdyn, for 1850-2000 rcp=8.5 f09 (use same file for 2000-2100), f25, f45, f10 + fndepdyn for 1850-2100 rcp=2.6 for native f19 + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Allow 2000-2100 sim-year range + + M models/lnd/clm/doc/UsersGuide/index.xml --- Update documentation with namelist examples + +>>>>>>>>>> Code changes from Keith Oleson to add 10cm soil temperature and soil water history variables. + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------ Add h2osoi_liqice_10cm and t_soi_10cm + M models/lnd/clm/src/main/clmtype.F90 ------------- Add h2osoi_liqice_10cm and t_soi_10cm + M models/lnd/clm/src/main/histFldsMod.F90 --------- Add TSOI_10CM and SOILWATER_10CM, + on by default and output as average by default. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 - Calculate 10cm soil averages for non-urban points + +Summary of testing: + + bluefire: All PASS except... +022 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +034 erL83 TER.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ........FAIL! rc= 6 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 3 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 3 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLA.f45_f45.I.bluefire.compare_hist.clm3_7_02 +PASS SMS_RLA.f45_f45.I.bluefire.compare.clm3_7_02 +PEND SMS_RLB.f45_f45.I.bluefire.GC.140232 +PEND SMS_ROA.f45_f45.I.bluefire.GC.140232 +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_7_02 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_7_02 +PEND PET.f45_g37.I1850.bluefire.GC.140232 +PEND ERS.f19_g16.I1850.bluefire.GC.140232 +RUN ERB.f09_g16.I_1948-2004.bluefire.GC.140232 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_02 +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_02 +PEND PET.f10_f10.I8520CN.bluefire.GC.140232 +FAIL ERS_D.f19_g16.I8521CNR85.bluefire +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.compare.clm3_7_02 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/lf95: All PASS up to smL58 (test 29) except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_02 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_02 +Originator(s): erik (erik) +Date: Sat Feb 6 00:43:49 MST 2010 +One-line Summary: Start adding in new rcp=8.5 datasets, remove some junk, change some env_conf variables, add user_nl_clm + +Purpose of changes: + +New pftdyn, ndep and aerdep files for rcp=8.5 future scenario 2005+ . Need to have the +ability to handle four future scenarios: minicam (rcp4.5), aim (rcp 6), image (rcp2.6), +and message (rcp8.5). Add in ndepdat datasets for rcp2.6 for future decades. Add in +ndepdyn, pftdyn, aerdep datasets for rcp8.5, and ndepdyn for rcp4.5 (f19) and pftdyn for +f10 as well. Some changes to scripts, remove CLM_DEMAND, add CLM_NML_USE_CASE, +CLM_CO2_TYPE and user namelist. Add user_nl to clm.cpl7.template, remove CLM_DEMAND add +CLM_CO2_TYPE and CLM_NML_USE_CASE (in favor of use_case's,). Make sure driver/scripts +updated with this change. Update documentation Users-Guide with comments from Keith and +Sam. Remove clm copy of mkSrcfiles/mkDepends. Remove run-ibm. Remove following options +from configure and config_definition: clm_exe, clm_exedir, and clm_bld. Remove +CASE/CCSM/CAM tests from test_driver.sh. Add some tests for new rcp=8.5. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Some changes to configure + Remove unused configure options: clm_exe, -clm_exedir, and -clm_bld. + Move standalone testing options to the end of help. Use CCSM version + of mkSrcfiles/mkDepends, separate config vars into categories, work + on documentation with comments from Keith/Sam. + +Describe any changes made to the namelist: Check for some files based on rcp + + Add in ability to add a user namelist in your case directory to input + namelist items at configure time. Simply add a file called "user_nl_clm" + as a valid namelist and the items in that namelist will show up in the initial + BuildConf/clm.buildnml.csh file. + +List any changes to the defaults for the boundary datasets: + fsurdat: f10, 1850 + fpftdyn: f10, 1850-2000, 1850-2100 (rcp=8.5) + fpftdyn: f19, 1850-2100 (rcp=8.5) + faerdep: f19, 1850-2100 (rcp=8.5) + fndepdat: f19, decadal averages (rcp=2.6) + fndepdyn: f19, 1850-2100 (rcp=8.5 and rcp=4.5) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + + scripts to scripts4_100204 + drv to drvseq3_1_15 + pio to pio1_0_8 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove CCSM, scam, cam, and run-ibm script testing from test-system +>>>>>>>>>>>>>>> Use .clm.auxtest lists in CCSM scripts for CCSM testing + D models/lnd/clm/test/system/TSM_ccsmseq.sh + D models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh + D models/lnd/clm/test/system/TCT_ccsmseq.sh + D models/lnd/clm/test/system/TCSruncase.sh + D models/lnd/clm/test/system/TSMruncase.sh + D models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh + D models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh + D models/lnd/clm/test/system/tests_posttag_lightning + D models/lnd/clm/test/system/config_files/scam_ds + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_10x15_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_4x5_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_1.9x2.5_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_0.9x1.25_dh + D models/lnd/clm/bld/run-ibm.csh + D models/lnd/clm/bld/create_newcase +>>>>>>>>>>>>>>> Remove mkSrcfiles/mkDepends duplicated from ccsm scripts + D models/lnd/clm/bld/mkSrcfiles + D models/lnd/clm/bld/mkDepends + +List all files added and what they do: + +>>>>>>>>>>>>> no-RTM mode configurations for hybrid and mpi-only testing + A models/lnd/clm/test/system/config_files/_nrsc_dh + A models/lnd/clm/test/system/config_files/_nrsc_dm +>>>>>>>>>>>>> Add transient_rcp8.5 use-case option + A models/lnd/clm/test/system/nl_files/clm_transient_rcp8.5 + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/README.testnames --- Update test names + M models/lnd/clm/test/system/test_driver.sh ----- Remove CLM_SEQCCSMROOT + M models/lnd/clm/test/system/input_tests_master - Remove CCSM/cam tests, add rcp8.5 test + M models/lnd/clm/test/system/README ------------- Remove doc on CLM_SEQCCSMROOT +>>>>>>>>>>>>> Remove CCSM, cam, scam, and run-ibm tests from test lists + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_bangkok + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_pretag_dublin + M models/lnd/clm/test/system/tests_pretag_dublin_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_pretag_calgary + +>>>>>>>>>>>>> New location for mkDepends, correct documentation + M models/lnd/clm/tools/mkgriddata/README ----- Correct mention of download + M models/lnd/clm/tools/mksurfdata/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/interpinic/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/mkgriddata/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/mkdatadomain/Makefile - Change location of mkDepends + +>>>>>>>>>>>>> Remove unused configure options: clm_exe, -clm_exedir, and -clm_bld +>>>>>>>>>>>>> Move standalone testing options to the end of help +>>>>>>>>>>>>> Use CCSM version of mkSrcfiles/mkDepends, separate config vars into +>>>>>>>>>>>>> categories, work on documentation + M models/lnd/clm/bld/configure -------------------------- Move clm standalone testing + options to the end of the help, remove: -clm_exe, + -clm_exedir, and -clm_bld options + M models/lnd/clm/bld/config_files/Makefile.in ----------- Use CCSM version of mkSrcfiles/mkDepends + M models/lnd/clm/bld/config_files/config_definition.xsl - Separate variables into categories. + M models/lnd/clm/bld/config_files/config_definition.xml - Add categories, add + description changes from Keith/Sam, remove clm_exe, clm_exedir, and clm_bld + + M models/lnd/clm/bld/listDefaultNamelist.pl -- Also loop over rcp values + + M models/lnd/clm/bld/build-namelist ----- have rcp value impact filenames retrieved + M models/lnd/clm/bld/clm.cpl7.template -- Add CLM_NML_USE_CASE and CLM_CO2_TYPE, + remove CLM_DEMAND add user_nl_clm namelist, remove -clm_bld. + M models/lnd/clm/bld/README ------------- Update documentation after removing the + clm stand-alone build/run scripts. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------- Remove defaults + as in namelist_defaults files, apply suggestions from Keith/Sam + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Change rcp default to -999.9 + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ------- Put description above valid values + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- New datasets: + fsurdat: f10, 1850 + fpftdyn: f10, 1850-2000, 1850-2100 (rcp=8.5) + fpftdyn: f19, 1850-2100 (rcp=8.5) + faerdep: f19, 1850-2100 (rcp=8.5) + fndepdat: f19, decadal averages (rcp=2.6) + fndepdyn: f19, 1850-2100 (rcp=8.5 and rcp=4.5) +>>>>>>>>>>>>> Update documentation, add in documentation on changes added in here + M models/lnd/clm/doc/UsersGuide/index.xml -- Spellcheck, more work on doc, update + for changes that came in on this tag. + M models/lnd/clm/doc/index.shtml ----------- Correct test table. + +Summary of testing: + + bluefire: All PASS except... +009 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 10 +010 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +011 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +012 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 4 +013 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +.........FAIL! rc= 10 +017 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic +.........FAIL! rc= 7 + bluefire interactive testing: All PASS + bluefire/CCSM testing: All PASS, except.. +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_02 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_01 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_01 +FAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_7_01 +FAIL ERS_D.f19_g16.I8521CNR85.bluefire +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.generate.clm3_7_02 +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.compare.clm3_7_01 + Special testing: +PASS ERS.f19_g16.I8521CNR85.bluefire + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_01 + +Changes answers relative to baseline: f10 because of new surface dataset + Other resolutions will be bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_01 +Originator(s): erik (Erik Kluzek) +Date: Fri Jan 29 12:58:12 MST 2010 +One-line Summary: OpenMP fix for pftdyn, start adding in rcp's, update ndeplintInterp.ncl script + +Purpose of changes: + +Changes to ndeplintInterp script to add the ability to generate ndepdyn datasets for future scenarios +2005+. Add rcp as input to build-namelist and add use-cases with different rcp's. Small bug-fixes to +mksurfdata. Add lists for 1850-2100 for the rcp's. Update drv and scripts to latest. Update documentation. +Fix from Mariana on OpenMP problem in pftdyn. Remove lightning from tests, start adding in +edinburgh. + +Bugs fixed (include bugzilla ID): + 1102 (OpenMP problem with pftdyn mode) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, code-changes came from Mariana-Vertenstein, reviewed by Pat Worley + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, and datm + + scripts to scripts4_100125 + drv to drvseq3_1_13 + datm to datm8_100122 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt --> rename to pftdyn_hist_simyr1850-2005.txt + +List all files added and what they do: + +>>>>>>>>>>>>>>> List of surface datasets to create pftdyn files + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt +>>>>>>>>>>>>>>> Add use-cases for future scenarios + A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt --> renamed + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add edinburgh, remove lightning + M models/lnd/clm/test/system/test_driver.sh --------- Remove lightning, add edinburgh + M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh -- Delete csm_share/dshr directory no longer exists + M models/lnd/clm/test/system/CLM_runcmnd.sh --------- Remove lightning, add edinburgh + + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 -- Fix small compiler bug for jaguar + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn - Point to new name for historical pftdyn file + +>>>>>>>>>>>>>> Handle future scenarios for dynamic Nitrogen-Deposition file creation + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl -- Add ability to handle future scenario data, and also leave + previous historical data the same as before, or + +>>>>>>>>>>>>>> Start adding ability to handle future scenarios for different RCP's + M models/lnd/clm/bld/build-namelist ------------------------------- Add rcp, + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------- Add rcp, new sim_year, sim_year_range values, allow blank + for hist_type1d_pertape + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add default for rcp as -999. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Add new Nitrogen deposition decadal datasets for RCP4.5/RCP8.5 + + M models/lnd/clm/doc/UsersGuide/index.xml -- Add more in, add notes on namelist, tools, and special cases + +>>>>>>>>>>>> Changes from Mariana V. to fix bug 1102, OpenMP bug with pftdyn cases + M models/lnd/clm/src/main/clm_initializeMod.F90 - Don't pass decomp bounds down + M models/lnd/clm/src/main/pftdynMod.F90 --------- Get decomp bounds here + M models/lnd/clm/src/main/clm_driver.F90 -------- Call pftdyn_interp on own OMP loop + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +049 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +050 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +051 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +052 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + bluefire interactive testing: +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7022 +brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire special testing: + Run I8520 from Dec/1/1850 @f09_g16 for 14 months with 64 tasks and 4 threads and make sure identical + to same with 128 tasks and 1 thread (require openMP build) comparing clm history files. clm3_7_00 4-thread case for this fails. But, answers are identical with clm3_7_00 for 128 tasks and 1 thread. + jaguar: +020 blJ62 TBL.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 5 +026 erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................FAIL! rc= 4 +027 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + jaguar/special testing: + Run I8520 from Dec/1/1850 @f09_g16 for 5 months with 416 tasks and 4 threads and make sure identical + to same with 1 thread (require openMP build) comparing clm history files. clm3_7_00 4-thread case for this fails. + jaguar/CCSM testing: +PASS ERS_D.f09_g16.I1850.jaguar +PASS PET.f10_f10.I8520CN.jaguar.cpl +PASS PET.f10_f10.I8520CN.jaguar.atm +PASS PET.f10_f10.I8520CN.jaguar.lnd +PASS PET.f10_f10.I8520CN.jaguar.ice +PASS PET.f10_f10.I8520CN.jaguar.ocn +PASS PET.f10_f10.I8520CN.jaguar.glc + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + dublin/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + edinburgh/pgi interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_00 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_00 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jan 22 22:48:09 MST 2010 +One-line Summary: Update to datm8, redirect aquifer overflow to drainage, add gx3v7 + masks, script to extract regional datasets, add harvesting for CN, + modify shrubs, include urban model, ice stream for snowcapping, + new build-namelist system, scale solar by solar zenith angle in + datm, deep soil with bedrock at bottom, organic matter in soils, + SNICAR for snow radiation, sparce dense aero, snow cover changes + +Software engineering changes: + + Update to cpl7 and scripts. + Remove offline and cpl6 modes. + Remove support for CASA model. + Update to datm8 atmospheric data model. + Add gx3v7 land mask for T31 and fv-4x5 horizontal resolutions. + Add gx1v6 land mask for f05, f09, and f19 horigonzl resolutions. + Add tx1v1 land mask and 1.9x2.5_tx1v1 horizontal resolution. + Add in 2.5x3.33 horizontal resolution. + Add in T62 horizontal resolution so can run at same resolution as input datm data. + Allow first history tape to be 1D. + Add ability to use own version of input datasets with CLM_USRDAT_NAME variable. + Add a script to extract out regional datasets. + New build-namelist system with XML file describing all namelist items. + Add glacier_mec use-case and stub glacier model. + Add ncl script to time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. + Make default of maxpatch_pft=numpft+1 instead of 4. + Only output static 3D fields on first h0 history file to save space. + Add new fields for VOC (Volatile Organic Compounds) on some surface datasets, that will be + needed for the new MEGAN VOC model (NOT incorporated yet). + Add irrigation area to mksurfdata tool (NOT used in CLM yet). + Add multiple elevation class option for glaciers in mksurfdata tool (NOT used in CLM yet). + Add ascale field to land model in support of model running on it's own grid. + +Science changes: + + Change to freezing temperature constant + Forcing height at atm plus z0+d on each tile + Effective porosity divide by zero fix + Sparse/dense canopy aerodynamic parameters + Ground/snow emissivity smooth transition + Thermal and hydraulic properties of organic soil + Init h2osoi=0.3 + Snow compaction fix + Snow T profile during layer splitting fix + Snow burial fraction + Snow cover fraction + SNICAR (snow aging, black carbon and dust deposition, vertical distribution of solar energy) + Remove SNOWAGE, no longer used + Deep soil (15 layers, ~50m), 5 new layers are hydrologically inactive bed rock + Ground evap (beta), stability, and litter resistance + Organic/mineral soil hydraulic conductivity percolation theory + Richards equation modifications + Normalization of frozen fraction of soil formulation + One-step solution for soil moisture and qcharge + Changes to rsub_max for drainage and decay factor for surface runoff + Fixed diurnal cycle of solar radiation in offline forcing data + Back to CLM3 lakes and wetlands datasets, but 1% rather than 5% threshold (same for glacier) + Changes to pft physiology file from CN + New grass optical properties + New surface dataset assuming no herbaceous understory + Direct versus diffuse radiation offline + New VOC model (MEGAN) + Snow-capped runoff goes to new ice stream and routed to ocean as ice + Dust model always on, LAI threshold parameter change from 0.1 to 0.3 + Daylength control on vcmax + SAI and get_rad_dtime fix + Always run with MAXPATCH_PFT=npfts + 1 instead of 4 + Transient land cover/use mode - datasets, energy and water balance + RTM sub-cycling + Twostream bug fix + Update soil colors + 2m relative humidity + Fix for aquifer leak (SoilHydrologyMod, BalanceCheckMod) + New nitrogen deposition file (units and sum of NOx, NHy) + +Quickstart to new cpl7 scripts... + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) +Quickstart to use of regional extraction scripts and PERSONAL datasets: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 -skip_rundb + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + 1121 (history variable attribute cell_methods misnamed) + 1118 (Restarts with SNICAR_FRC fail) + +Describe any changes made to build system: + + Change directory structure to match CCSM. + Add BGP target. + Add choice between ESMF and MCT frameworks. + Start removing #ifdef and directives that supported Cray-X1 Phoenix as now decommisioned. + Make default of maxpatch_pft=numpft+1 instead of 4 for all configurations. + By default turn on CLAMP when either CN or CASA is enabled + New SNICAR_FRC, CARBON_AERO, and C13 CPP ifdef tokens. + + New options added to configure: + + -comp_intf Component interface to use (ESMF or MCT) (default MCT) + -nofire Turn off wildfires for bgc setting of CN (default includes fire for CN) + -pio Switch enables building with Parallel I/O library. [on | off] (default is on) + -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] (default is off) + +Describe any changes made to the namelist: + + NOTE: build-namelist now checks the validity of your namelist you generate by looking at data in the namelist_definition.xml + file. In order to add new namelist items you need to change the code and also edit this file. To view information + on the namelist view the file: + models/lnd/clm/bld/namelist_files/namelist_definition.xml + in your browser and you'll see the names, type, description and valid_values for all namelist variables. + + Changes to build-namelist: + Transient sim_year ranges (i.e. 1850-2000) + Remove cam_hist_case option. + Make sure options ONLY used for stand-alone testing have a "drv_" or "datm_" prefix in them and list these + options all together and last when asking for help from build-namelist. + New options to build-namelist: + -clm_usr_name "name" Dataset resolution/descriptor for personal datasets. Default: not used + Example: 1x1pt_boulderCO_c090722 to describe location, + number of pts, and date files created + New list options to build-namelist: + build-namelist -res list # List valid resolutions + build-namelist -mask list # List valid land-masks + build-namelist -sim_year list # List valid simulation years and simulation year ranges + build-namelist -clm_demand list # List namelist variables including those you could demand to be included. + build-namelist -use_case list # List valid use-cases + + New use-cases for: + + 1850_control = Conditions to simulate 1850 land-use + 2000_control = Conditions to simulate 2000 land-use +20thC_transient = Simulate transient land-use, and aerosol deposition changes from 1850 to 2005 + glacier_mec = Placeholder for running IG cases with the ice sheet model glimmer + + New namelist items: + + urban_hac = OFF, ON or ON_WASTEHEAT (default OFF) Flag for urban Heating and Air-Conditioning + OFF = Building internal temperature is un-regulated. + ON = Building internal temperature is bounded to reasonable range. + ON_WASTEHEAT = Building internal temperature is bounded and resultant waste + heat is given off. + urban_traffic = .true. or .false. (default .false.) Flag to include additional multiplicative factor of urban traffic + to sensible heat flux. + fsnowoptions = filename file for snow/aerosol optical properties (required) + fsnowaging = filename file for snow aging parameters (required) + faerdep = filename file of aerosol deposition (required) + + New history variables: (note watt vs. W in units, 26 vs. 76) + BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s + C13_PRODUCT_CLOSS C13 total carbon loss from wood product pools gC13/m^2/s + DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s + EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 + FGR12 heat flux between soil layers 1 and 2 watt/m^2 + FSAT fractional area with water table at surface unitless + FSH_NODYNLNDUSE sensible heat flux not including correction for land use change + watt/m^2 + GC_HEAT1 initial gridcell total heat content J/m^2 + GC_HEAT2 post land cover change total heat content J/m^2 inactive + GC_ICE1 initial gridcell total ice content mm/s + GC_ICE2 post land cover change total ice content mm/s inactive + GC_LIQ1 initial gridcell total liq content mm + GC_LIQ2 initial gridcell total liq content mm inactive <<<< name?? + H2OSNO_TOP mass of snow in top snow layer kg + HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning + watt/m^2 + HK hydraulic conductivity mm/s inactive + LWup upwelling longwave radiation watt/m^2 inactive + NBP net biome production, includes fire, landuse, and harvest flux, positive for sink + gC/m^2/s + OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s + PBOT atmospheric pressure Pa + PCO2 atmospheric partial pressure of CO2 Pa + PRODUCT_CLOSS total carbon loss from wood product pools gC/m^2/s + PRODUCT_NLOSS total N loss from wood product pools gN/m^2/s + Qair atmospheric specific humidity kg/kg inactive + Qanth anthropogenic heat flux watt/m^2 inactive + Qtau momentum flux kg/m/s^2 + QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s + QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s + QRUNOFF_NODYNLNDUSE total liquid runoff not including correction for land use change (does not include QSNWCPICE) + mm/s + QSNWCPICE excess snowfall due to snow capping mm/s + QSNWCPICE_NODYNLNDUSE excess snowfall due to snow capping not including correction for land use change + mm/s + QSNWCPLIQ excess rainfall due to snow capping mm/s inactive + SMP soil matric potential mm inactive + SNOAERFRC2L surface forcing of all aerosols in snow, averaged only when snow is present (land) + watt/m^2 + SNOAERFRCL surface forcing of all aerosols in snow (land) watt/m^2 + SNOBCFRCL surface forcing of BC in snow (land) watt/m^2 + SNOBCMCL mass of BC in snow column kg/m2 + SNOBCMSL mass of BC in top snow layer kg/m2 + SNOdTdzL top snow layer temperature gradient (land) K/m + SNODSTFRC2L surface forcing of dust in snow, averaged only when snow is present (land) + watt/m^2 + SNODSTFRCL surface forcing of dust in snow (land) watt/m^2 + SNODSTMCL mass of dust in snow column kg/m2 + SNODSTMSL mass of dust in top snow layer kg/m2 + SNOFSRND direct nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRNI diffuse nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRVD direct vis reflected solar radiation from snow watt/m^2 inactive + SNOFSRVI diffuse vis reflected solar radiation from snow watt/m^2 inactive + SNOFSDSND direct nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSNI diffuse nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSVD direct vis incident solar radiation on snow watt/m^2 inactive + SNOFSDSVI diffuse vis incident solar radiation on snow watt/m^2 inactive + SNOLIQFL top snow layer liquid water fraction (land) fraction inactive + SNOOCMCL mass of OC in snow column kg/m2 + SNOOCMSL mass of OC in top snow layer Kg/m2 + SNOOCFRC2L surface forcing of OC in snow, averaged only when snow is present (land) + SNOOCFRCL surface forcing of OC in snow (land) watt/m^2 + watt/m^2 + SNORDSL top snow layer effective grain radius m^-6 inactive + SNOTTOPL snow temperature (top layer) K/m inactive <<< units? + SWup upwelling shortwave radiation watt/m^2 inactive + URBAN_AC urban air conditioning flux watt/m^2 + URBAN_HEAT urban heating flux watt/m^2 + Wind atmospheric wind velocity magnitude m/s inactive + WOOD_HARVESTC wood harvest (to product pools) gC/m^2/s + WOOD_HARVESTN wood harvest (to product pools) gN/m^2/s + + History field name changes: + + ANNSUM_PLANT_NDEMAND => ANNSUM_POTENTIAL_GPP + ANNSUM_RETRANSN => ANNMAX_RETRANSN + C13_DWT_PROD10C_LOSS => C13_PROD10C_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + C13_DWT_PROD10N_LOSS => C13_PROD10N_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + DWT_PROD100N_LOSS => PROD10N_LOSS + DWT_PROD100N_LOSS => PROD100N_LOSS + DWT_PROD100C_LOSS => PROD10C_LOSS + DWT_PROD100C_LOSS => PROD100C_LOSS + HCSOISNO => HC + TEMPSUM_PLANT_NDEMAND => TEMPSUM_POTENTIAL_GPP + TEMPSUM_RETRANSN => TEMPMAX_RETRANSN + + History field names deleted: + SNOWAGE, TSNOW, FMICR, FCO2, DMI, QFLX_SNOWCAP + + Add new urban oriented _U, and _R (Urban and Rural) for: + EFLX_LH_TOT, FGR, FIRA, FSH, FSM, Q2M, QRUNOFF, RH2M, SoilAlpha, TG, TREFMNAV, TREFMXAV, and TSA + (missing _R for SoilAlpha) + +Describe timing and memory performance: + +Versions of any externally defined libraries: + + scripts scripts4_100108b + drv vocemis-drydep12_drvseq3_1_11 + datm datm8_091218 + socn stubs1_2_02/socn + sice stubs1_2_02/sice + sglc stubs1_2_02/sglc + csm_share vocemis-drydep13_share3_091217 + esmf_wrf_timemgr esmf_wrf_timemgr_090402 + timing timing_090929 + mct MCT2_7_0_100106 + pio pio60_prod + cprnc cprnc_081022 + +Summary of testing: + bluefire: All PASS up to...017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............PASS + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +PASS ERH.f09_g16.B20TRCN.bluefire +BFAIL ERH.f09_g16.B20TRCN.bluefire.compare.ccsm4_0_beta38 --- compset names changed -- but cpl.log files compare exactly +! +> ../Tools/check_exactrestart.pl cpl.log.100109-171753 $FISHOME/ccsm4_0_beta38/scripts/ERH.f09_g16.B20TRTR1CN.bluefire.G +.172652/logs/cpl.log.100108-181015 +log files match! +PASS +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<< Failed before bug 1063 +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: None PASS because of bug 1092 + dublin/lf95: None PASS because of bug 1092 + dublin/INTEL interactive testing: ALL PASS except (and didn't compare to baseline) +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +028 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/INTEL: All PASS up to 021 smJ92 TSM.sh (and didn't compare to baseline) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + +=============================================================== +=============================================================== +Tag name: clm3_6_64 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jan 22 22:19:24 MST 2010 +One-line Summary: Update documentation and README/Quickstart files, set NetCDF large-file format on by default in template, update pio, update some fsurdat files to vocemis-drydep versions, add 2.5x3.33_gx3v7 frac file, make gx3v7 default for 4x5 res + +Purpose of changes: + +Setup makefiles for docbook UsersGuide to output both pdf and html formats. Work on documentation of new _esmf driver files. Work on documentation. Make sure documentation of clm xml variables is good. Add note about CASA NOT being supported. Work on README/Quickstart files, and move the files from the top level to clm doc directory, but leave a file at top level pointing to these files. Make large file support default, remove LND_CDF64. Add in VOC surfdata files from voc branch: T42, T31, T21, T5, 4x5, 10x15-pftdyn. Add in new 2x5x3.33_gx3v7 frac file. Make default mask for 4x5 gx3v7. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Turn NetCDF large-file support on by default + +List any changes to the defaults for the boundary datasets: + + New fsurdat files for: T42, T31, T21, T5, 4x5 + New fpftdyn file for 10x15 for 1850-2000, new frac file for 2.5x3.33_gx3v7 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): pio + + pio updated to google version: http://parallelio.googlecode.com/svn/trunk_tags/pio1_0_7/pio + +List all files eliminated: + + D Quickstart.userdatasets --- Move to models/lnd/clm/doc + D Quickstart.GUIDE ---------- Move to models/lnd/clm/doc + D README.DGVM --------------- Move to models/lnd/clm/doc + D KnownBugs ----------------- Move to models/lnd/clm/doc + D models/lnd/clm/doc/docs.html ----------------- Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/clm_head.shtml - Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/tree.html ------ Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/clm_foot.shtml - Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/index.shtml ---- Remove in favor of DocBook documentation + +List all files added and what they do: + + A models/lnd/clm/doc/Quickstart.userdatasets - Move from top level + A models/lnd/clm/doc/IMPORTANT_NOTES --------- Add important notes about what's scientifically valided/expected to work + A models/lnd/clm/doc/Quickstart.GUIDE -------- Move from top level + A models/lnd/clm/doc/KnownBugs --------------- Move from top level + A models/lnd/clm/doc/UsersGuide/Makefile ----- Makefile to build Users-Guide + A models/lnd/clm/doc/index.shtml ------------- Add HTML guide to documentation + A models/lnd/clm/doc/CodeReference/Filepath -- Filepath to source-code to build Code Reference Guide + A models/lnd/clm/doc/CodeReference/Makefile -- Makefile to build Code Reference Guide using Protex + + A models/lnd/clm/test/system/Makefile -------- Makefile to build HTML test table + + A models/lnd/clm/test/system/config_files/_nrsc_do --- Add smp only option for no-RTM seq-ccsm default mode + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/clm.cpl7.template -------------------------- Set large_file_format to true by default + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Add in vocemis-drydep branch fsurdat files for: T42, T31, T21, T5, + and 4x5 resolution (as well as 10x15 1850-2005 pftdyn file) + Add in 2.5x3.33_gx3v7 frac file, and make gx3v7 mask the default + for 4x5 resolution. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml -- 2.5x3.33_gx3v7 domain file +>>>>>>>>>>>>> Update documentation and README text files + M models/lnd/clm/test/system/README + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ------------------ Make namelist documentation a little more clea + M models/lnd/clm/tools/ncl_scripts/convertUrbanOffline2Seq.ncl -- Document datm as datm8 + M models/lnd/clm/tools/ncl_scripts/README + M models/lnd/clm/tools/interpinic/README + M models/lnd/clm/tools/mkdatadomain/README + M models/lnd/clm/tools/README + M models/lnd/clm/bld/README + M models/lnd/clm/doc/UsersGuide/index.xml ---- Update docbook UsersGuide + M models/lnd/clm/doc/README + M README + + M models/lnd/clm/test/system/tests_pretag_bluefire ----------- Remove LD1 (2.65x3.33 res) tests + M models/lnd/clm/test/system/tests_posttag_hybrid_regression - Remove LD1 tests + M models/lnd/clm/test/system/input_tests_master -------------- Remove LD1 tests + +Summary of testing: + + bluefire: All PASS except... +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 << 4x5 fsurdat +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 << 4x5 fsurdat +012 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 << 4x5 fsurdat +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 << 4x5 fsurdat +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 << 10x15 fpftdyn different +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +043 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 5 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 << 4x5 fsurdat +040 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 5 << no _nrsc_do in previous +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 << script error +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 << script error +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 3 << script error +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 3 + bluefire/CCSM testing: All PASS except... +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different than previous version +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 <<<<<<<< 4x5 surfdata file different +FAIL ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<<<< 4x5 surfdata file different +FAIL PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<<<< Previous failure +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_6_64 <<<<<<<< Previous failure +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 <<< Previous failure +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_6_58+datm8 <<<<<<< 10x15 pftdyn file different +BFAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_6_58+datm8 <<<<<<<<< 10x15 pftdyn file different + +CLM tag used for the baseline comparison tests if applicable: clm3_6_63 + +Changes answers relative to baseline: Only for the following resolutions because of new fsurdat files: T42, T31, T5, 4x5 + and for dynamic PFT at 10x15 resolution because of a new pftdyn file + +=============================================================== +=============================================================== +Tag name: clm3_6_63 +Originator(s): erik (erik) +Date: Sat Jan 9 20:37:53 MST 2010 +One-line Summary: Get answers to be identical with ccsm4_0_beta38 for 1 and 2 degree transient cases + +Purpose of changes: + +Get answers to be identical to ccsm4_0_beta38 for both 1 and 2 degree transient cases. Update scripts to +very latest. Tweak test_suite for CN so that can run with finidat file, and can run interactive on dublin +by turning CCSM_BLD to off. + +Bugs fixed (include bugzilla ID): + 1098 (Use finidat weights instead of weights from fpftdyn file) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + +List all files eliminated: None + +List all files added and what they do: + +>>>>>> Add configuration files for CN with default of numpft+1 maxpft +A models/lnd/clm/test/system/config_files/_cnnsc_h +A models/lnd/clm/test/system/config_files/_cnnsc_m +A models/lnd/clm/test/system/config_files/_cnnsc_o +A models/lnd/clm/test/system/config_files/_cnnsc_dh +A models/lnd/clm/test/system/config_files/_cnnsc_dm +A models/lnd/clm/test/system/config_files/_cnnsc_do +A models/lnd/clm/test/system/config_files/_cnnsc_ds + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Tweak test suite so can test for a CN transient case with a startup file, needed to find bug +M models/lnd/clm/test/system/test_driver.sh ------------ Turn CCSM_BLD to off for interactive use +M models/lnd/clm/test/system/input_tests_master -------- Tweak CN tests so can use finidat file +>>>>>>>>>>>>>>> Get answers to be identical with ccsm4_0_beta38 +M models/lnd/clm/src/main/clm_initializeMod.F90 -------- add extra call to pftdyn_interp after restart +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 -- Read weights directly into clm_type rather than + a temporary array. + +Summary of testing: + + bluefire: All PASS up to... +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............PASS + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +PASS ERH.f09_g16.B20TRCN.bluefire +BFAIL ERH.f09_g16.B20TRCN.bluefire.compare.ccsm4_0_beta38 --- compset names changed -- but cpl.log files compare exactly! +> ../Tools/check_exactrestart.pl cpl.log.100109-171753 $FISHOME/ccsm4_0_beta38/scripts/ERH.f09_g16.B20TRTR1CN.bluefire.G.172652/logs/cpl.log.100108-181015 +log files match! +PASS +PASS SMS_RLA.f45_f45.I.bluefire +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS SMS_RLB.f45_f45.I.bluefire +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS SMS_ROA.f45_f45.I.bluefire +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<< Failed before bug 1063 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 +PASS ERH_D.f10_f10.I1850CN.bluefire +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_6_58+datm8 <<< f10_f10 NOT allowed in baseline +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc +BFAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_6_58+datm8 <<< f10_f10 NOT allowed in baseline + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: None PASS because of bug 1092 + dublin/lf95: None PASS because of bug 1092 + dublin/INTEL interactive testing: ALL PASS except (and didn't compare to baseline) +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +028 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/INTEL: All PASS up to 021 smJ92 TSM.sh (and didn't compare to baseline) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58+datm8 + +Changes answers relative to baseline: No bit-for-bit -- really now! + +=============================================================== +=============================================================== +Tag name: clm3_6_62 +Originator(s): erik (erik) +Date: Fri Jan 8 04:50:59 MST 2010 +One-line Summary: Fix startup of PFT transient cases so properly use data from pftdyn file rather than finidat file + +Purpose of changes: + +Attempt to fix bug 1098 so that properly use the PFT weights interpolated from the fpftdyn file rather than using the +weights from the input finidat file. + +Bugs fixed (include bugzilla ID): Attempt to fix -- but only a partial fix, answers were still different + 1098 (Use finidat weights instead of weights from fpftdyn file) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and mct + + scripts to scripts4_100107b + mct to MCT2_7_0_100106 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Fix bug with fpftdyn weights + M models/lnd/clm/test/system/test_driver.sh ------------- Fix name of ifort Macros file + +Summary of testing: + + bluefire: All PASS except, up to 045 erLD1 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except CN spinup as below +PASS ERS.f09_g16.I8520CN.bluefire +PASS ERS.f09_g16.I8520CN.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f09_g16.I8520CN.bluefire.compare.clm3_6_58+datm8 +PASS SMS_RLA.f45_g37.I.bluefire +PASS SMS_RLA.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_RLA.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS SMS_RLB.f45_g37.I.bluefire +PASS SMS_RLB.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_RLB.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS SMS_ROA.f45_g37.I.bluefire +PASS SMS_ROA.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_ROA.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 +PASS ERH_D.f09_g16.I1850CN.bluefire +PASS ERH_D.f09_g16.I1850CN.bluefire.compare.clm3_6_58+datm8 +PASS PET.f19_g16.I8520CN.bluefire.cpl +PASS PET.f19_g16.I8520CN.bluefire.atm + jaguar: All PASS up to 021 smJ05 + jaguar interactive testing: All FAIL except... +001 smA74 TSM.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........PASS +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic ........PASS +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic .....PASS +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........PASS +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............PASS +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............PASS + dublin/lf95: None pass because of bug 1092 + dublin/pgi: All PASS except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 + dublin/ifort interactive: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58+datm8 (ccsm4_0_beta38) + +Changes answers relative to baseline: Identical without fpftdyn files + with and without finidat files. But, can be + different to roundoff or more for transient cases. + +=============================================================== +=============================================================== +Tag name: clm3_6_61 +Originator(s): erik (erik) +Date: Thu Jan 7 00:55:20 MST 2010 +One-line Summary: Comment out endrun on finidat and fsurdat weights being incomptable, and go back to using finidat weights + +Purpose of changes: + +Most of our finidat files have weights incompatible with our new fsurdat files. Hence, we went back to allowing +the weights to be different and to using the finidat weights so that answers would be the same as before. +Also hardwire the logfile for datm and clm so that can run testsuite on jaguar. Also add in cppdef required +for breeze. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1098 (Use finidat weights instead of weights from fpftdyn file) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to scripts4_100107 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_driver.sh -------------------- Add -cppdefs '-DFORTRANUNDERSCORE' for breeze. + M models/lnd/clm/bld/build-namelist ---------------------------- For standalone testing hardwire clm and + datm output log files + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add comment remove logfile + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 ---------- Put implicit none in right place, comment + out abort if weights too different, and use finidat weights instead of fsurdat weights. Hence + this version is identical to clm3_6_58, other than the use of datm8 (which is roundoff different). + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + bluefire/CCSM testing: +PEND SMS_RLA.f45_f45.I.bluefire.200614 +PEND SMS_RLB.f45_f45.I.bluefire.200614 +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g37.I.bluefire +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS ERS.f19_g16.I1850.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc + jaguar interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 5 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic FAIL! rc= 8 +014 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 5 +016 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 4 + dublin/lf95: All Fail due to bug 1092 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58 (but with datm8 rather than datm7) + +Changes answers relative to baseline: No bit-for-bit except for transient cases which are different + +=============================================================== +=============================================================== +Tag name: clm3_6_60 +Originator(s): erik (erik) +Date: Tue Jan 5 23:59:43 MST 2010 +One-line Summary: Fix clm template + +Purpose of changes: + +Fix the broken clm template. Update externals for very latest scripts tag. + +Bugs fixed (include bugzilla ID): Fix clm template which was broken + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): Update scripts + + scripts to scripts4_100105b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_driver.sh -- update bl to ccsm4_0_beta38 +M models/lnd/clm/bld/clm.cpl7.template ------- fix so can work + +Summary of testing: + + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +FAIL ERS.f19_g16.I_1850.bluefire +FAIL ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd + +CLM tag used for the baseline comparison tests if applicable: clm3_6_59 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_59 +Originator(s): erik (erik) +Date: Tue Jan 5 17:44:48 MST 2010 +One-line Summary: Update to datm8, fix so wts used are from fsurdat file NOT finidat file + +Purpose of changes: + +Changes needed for beta34 ESMF upgrade. Use new datm8 model which is more flexible and +has new options as well as parallel IO. Add in 4x5_gx3v7 frac file. Remove use for +ESMF_mod. Abort if finidat weights are significantly different from surfdata file +weights. Change name of driver and initializeMod to have a clm_ prefix. Convert UG +outline from html to DocBook. Make changes to code documentation for high level +subroutines. Remove documentation of namelist items in controlMod and have it point +to the documentation in the xml namelist file. Fix "called from" in code documentation +and remove a lot of the concurrent directives. New files from Tony for esmf interface. +Alpha release testing will start with this version. + +Bugs fixed (include bugzilla ID): + 1084 (don't use only for ESMF_Mod) + 1087 (let weights come from fsurdat file NOT finidat) + 1088 (change name of driver module) + 1093 (namelist tweaks) -- partial + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Let CCSM build determine FORTRAN mangle definitions + Directory structure changes slightly with new ESMF interfaces and new datm8 + +Describe any changes made to the namelist: + Make default for hist_crtinic NONE so clm.i files are NOT made by default. + Change names of options to build-namelist that only are for clm stand-alone testing. + Add a drv_ or datm_ prefix, and separate how these options are displayed in the help + Also add an option to several commands for "list" so that you can list the variables + for clm_demand, for resolution, and for use-cases. + Also update build-namelist to work with the new datm8 + +List any changes to the defaults for the boundary datasets: Add in 4x5_gx3v7 dataset + +Describe any substantial timing or memory changes: datm8 is approx. 30% faster + datm8 also allows you to enable parallel I/O + +Code reviewed by: self, oleson, slevis, dlawren review of weights change + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, csm_share, drv, pio + ++scripts to scripts4_100103b ++drv to vocemis-drydep12_drvseq3_1_11 ++datm to datm8_091218 ++csm_share to vocemis-drydep13_share3_091217 ++pio to pio60_prod + +List all files eliminated: + + D models/lnd/clm/test/system/config_files/_mexsc_ds --- Rename with nr in name + D models/lnd/clm/test/system/config_files/_vansc_ds --- Rename with nr in name + D models/lnd/clm/src/main/driver.F90 ------------------ Rename with clm_ prefix + D models/lnd/clm/src/main/initializeMod.F90 ----------- Rename with clm_ prefix + D models/lnd/clm/src/biogeophys/DriverInitMod.F90 ----- Rename to clm_driverInitMod + +List all files added and what they do: + + A models/lnd/clm/doc/UsersGuide/index.xml ---------------- Users Guide Outline in docbook format +>>>>>>>>>>> Version with "nr" so that RTM is turned off for non-global tests + A models/lnd/clm/test/system/config_files/_nrsc_s + A models/lnd/clm/test/system/config_files/17p_nrsc_ds + A models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + A models/lnd/clm/test/system/config_files/_nrsc_ds + A models/lnd/clm/test/system/config_files/_nrmexsc_ds + A models/lnd/clm/test/system/config_files/_nrvansc_ds + A models/lnd/clm/test/system/config_files/17p_nrcnnsc_ds +>>>>>>>>>>> New files from Tony for ESMF interfaces + A models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + A models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 + + A models/lnd/clm/src/main/clm_initializeMod.F90 ---------- Rename with clm_ prefix + Also change so that dyn pft is always called before reading in the restart + file. + A models/lnd/clm/src/main/clm_driver.F90 ----------------- Rename with clm_ prefix + A models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 ---- Rename from driverInitMod + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README -- Note about nr means no-RTM + M models/lnd/clm/test/system/test_driver.sh ------- Some tweaks for dublin/intrepid + M models/lnd/clm/test/system/mknamelist ----------- Changes for datm namelists, and + change for new options names for + build-namelist + M models/lnd/clm/test/system/nl_files/clm_per ----- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_std ----- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_pftdyn -- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_per0 ---- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_spin ---- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_urb1pt -- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/input_tests_master --- Use nr in test names + M models/lnd/clm/test/system/CLM_runcmnd.sh ------- Change name for laptop + M models/lnd/clm/test/system/TSM.sh --------------- Change datm restart files + + M models/lnd/clm/bld/clm.cpl7.template ------------ Change template to not put RTM + time-step in when rtm is off + M models/lnd/clm/bld/configure -------------------- Change to new datm dir structure + M models/lnd/clm/bld/listDefaultNamelist.pl ------- Change name of datm namelist + M models/lnd/clm/bld/build-namelist --------------- New list options, update for + new datm8 namelist. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Document pio options + new datm8 namelist items, CASA nameist items, and fget_archdev + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- New 4x5_gx3v7 frac file + set default of hist_crtinic to NONE + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - New datm8 defaults + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ---- Add section for + CASA nl items, and a commented out section for the pio items + + M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 ---- Fix called from, rm concurrnt directives + M models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 ------ Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 --- Fix called from + M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CASAMod.F90 --------------- Doc routine as private, fix called from, rm con dirct. + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 ---------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/DGVMMod.F90 --------------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 --------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 ---------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 --------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 -- Fix called from, rm con dirt. + + M models/lnd/clm/src/main/clm_comp.F90 ------------- Add clm_ prefix to calls + M models/lnd/clm/src/main/pftdynMod.F90 ------------ Fix called from, rm con dirt. + M models/lnd/clm/src/main/histFileMod.F90 ---------- Add more documentation, rm con direct. + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------- Change documentation of units for nee + M models/lnd/clm/src/main/restFileMod.F90 ---------- Change called from documentation + M models/lnd/clm/src/main/controlMod.F90 ----------- Remove namelist items documentation + point to xml files for documenation + Work with code documentation + Get rid of notes about aerdep + files going away + M models/lnd/clm/src/main/clm_time_manager.F90 ----- Fix called from doc + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Add documentation + M models/lnd/clm/src/main/domainMod.F90 ------------ Clarify which driver in doc + M models/lnd/clm/src/main/clmtype.F90 -------------- Work on code documentation + M models/lnd/clm/src/main/histFldsMod.F90 ---------- Work on code documentation and formatting + + M models/lnd/clm/src/riverroute/RtmMod.F90 - Fix called from + + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ Remove KO and fix called from in code doc, rm con dirct. + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/SNICARMod.F90 ------------ Fix called from. + + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 - Check that weights when read + in agree reasonably closely with fsurdat weights + +Summary of testing: + + bluefire: +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 +012 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +021 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +028 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 13 +029 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 11 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 +034 blC61 TBL.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 48 cold .................FAIL! rc= 7 +038 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 7 +043 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 7 +049 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 7 +050 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 3 +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 3 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 3 + bluefire interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +023 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +028 blL78 TBL.sh _nrsc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic ...........FAIL! rc= 5 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +033 smL83 TSM.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 4 +034 erL83 TER.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ........FAIL! rc= 5 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 5 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 4 +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/lf95: No testing as all tests fail due to bug 1092 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58 + +Changes answers relative to baseline: datm8 causes answers to be roundoff different + Change to use of fsurdat instead of finidat weights means answers may change + for non-coldstart cases. + +=============================================================== +=============================================================== +Tag name: clm3_6_58 +Originator(s): erik (erik) +Date: Tue Dec 8 12:56:47 MST 2009 +One-line Summary: Fix rpointer, correct units for export of nee, start adding testing for intrepid + +Purpose of changes: + Only update the rpointer file when restart files are written NOT when clm.i initial + files are written. This was causing problems to restart the model when it was + aborting before it completed it's period to run for. + Correct the units for the export of NEE from kg C to kg CO2 (kgCO2/m2/s) + Remove some concurent directives in the code and the unicosmp target_os in + configure as we no longer have Phoenix. + Add bgp target_os to configure, only set Fortran mangling if NOT using the + CCSM build in configure. + Add CN atm spinup data source as option to configure and to test_driver.sh. + Update version of external to test with to ccsm4_0_beta35 + Add ability to test on intrepid to test_driver.sh. + +Bugs fixed (include bugzilla ID): + 1079 (rpointer file updated with clm.i files) + 1082 (Add bgp, don't do Fortran mangling for CCSM build) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1070 (pftdyn datasets bad for f19, 2.5x3.33) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Have configure write out unresolved filepaths + when called from cpl7.template + +Describe any changes made to the namelist: drv namelist updated + +List any changes to the defaults for the boundary datasets: + Add 2.5x3.33 resolution + Remove 2x2.5 res files + New f09, f19 finidat files + New f09, f19, f10, 1x1_tropicAtl fsurdat/fpftdyn files (only f19 change answers) + New f05, 5x5_amazon, 1x1_brazil 2000 fsurdat file (b4b) + New f03, f09, f19, f03, f10 ndepdyn files (changes 1851-1924, 1996-2004) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): to ccsm4_0_beta33 versions + + scripts to scripts4_091027b + drv to vocemis-drydep12_drvseq3_0_37 + datm7 to datm7_090928 + socn/sice/sglc to stubs1_2_02 + csm_share to share3_091013 + timing to timing_090929 + mct to MCT2_6_0_090926 + pio to pio57_prod + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Quickstart.userdatasets --- Update notes about setting user-defined datasets +>>>>>>>>>>>>>>> Update jaguar, kraken, and bluefire env vars to latest scripts +>>>>>>>>>>>>>>> Remove blAK8 test as ocean-only and no clm files to compare + M models/lnd/clm/test/system/README.testnames ---------------- Add 2.5x3.33 test resolution + M models/lnd/clm/test/system/tests_driver.sh ----------------- Update env vars + to whats in scripts4_091015 for jaguar, kraken and bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ----- Rm blAK8 + M models/lnd/clm/test/system/input_tests_master -------------- Rm blAK8, add 1x1_tropicAtl@1850,1850-2000, and 2.5x3.33 tests + M models/lnd/clm/test/system/tests_posttag_nompi_regression -- Rm blAK8 + +>>>>>>>>>>>>>>> Allow configure to write out unresolved Filepath, make TopCCSMBld +>>>>>>>>>>>>>>> Makefile closer to CPL7 version + M models/lnd/clm/bld/configure -------------------------- Add clm_root option + add ability to set comp_intf to cpl_$COMP, allow ability to check for + directories existance resolving env vars that are set. Create a subroutine + is_valid_directory to check for directories instead of "-d". + M models/lnd/clm/bld/config_files/config_definition.xml - Allow cpl_$COMP rm lapacklibdir + M models/lnd/clm/bld/clm.cpl7.template -- Set COMP based on COMP_INTERFACE, + add clm_root to configure, don't resolve CODEROOT and CASEROOT on output + M models/lnd/clm/bld/config_files/TopCCSMBldMakefile.in - Changes to make closer to scripts4_091015 version. +>>>>>>>>>>>>>>> Change drv namelist names, + M models/lnd/clm/bld/build-namelist ----- Change drv namelist names: cpl_io_numtasks/cpl_io_typename +>>>>>>>>>>>>>>> Change drv namelist names, add 2.5x3.33 resolution +>>>>>>>>>>>>>>> Remove 2x2.5 res files +>>>>>>>>>>>>>>> New f09, f19 finidat files +>>>>>>>>>>>>>>> New f09, f19, f10, 1x1_tropicAtl fsurdat/fpftdyn files (only f19 change answers) +>>>>>>>>>>>>>>> New f05, 5x5_amazon, 1x1_brazil 2000 fsurdat file (b4b) +>>>>>>>>>>>>>>> New f03, f09, f19, f03, f10 ndepdyn files (changes 1851-1924, 1996-2004) + M models/lnd/clm/bld/namelist_files/namelist_definition.xml -----Change drv namelist + names: cpl_io_numtasks/cpl_io_typename, add 2.5x3.33 resolution + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml -- Add 2.5x3.33 res domainfile + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- New f19, f09 finidat files + new f09, f19, f10 fsurdat/fpftdyn files + new 2.5x3.33: fatmgrid, flndtopo, fatmtopo, fatmlndfrc, faerdep, fndepdat files + new f05, 5x5_amazon, 1x1_brazil 2000 fsurdat files + new f03, f09, f19, f03, f10 ndepdyn files + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml --- Change drv namelist + names: cpl_io_numtasks/cpl_io_typename + + M models/lnd/clm/src/main/histFldsMod.F90 -- GC_HEAT2, GC_LIQ2, GC_ICE2 NOT on by default +>>>>>>>>>>>>>>> Remove dips in 20th Century transient Nitrogen deposition +>>>>>>>>>>>>>>> for 1855 and 2000. + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl --- Remove 1855-1915 and 2000 + from list of input files. The 1850 dataset had too high of CO2 and hence + to high Nitrogen deposition, which gives a unrealistic dip near the + beginning. + +>>>>>>>>>>>>>>> Documentation changes of ProTex comments to fit the ProTex standard +M tools/mksurfdata/mkglcmec.F90 +M tools/mksurfdata/mkfmax.F90 +M tools/mksurfdata/ncdio.F90 +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkglacier.F90 +M tools/mksurfdata/mkharvestMod.F90 +M tools/mksurfdata/creategridMod.F90 +M tools/mksurfdata/mkorganic.F90 +M tools/mksurfdata/mklanwat.F90 +M tools/mksurfdata/mksoicol.F90 +M tools/mksurfdata/mkrank.F90 +M tools/mksurfdata/mkelev.F90 +M tools/mksurfdata/mkurban.F90 +M tools/mksurfdata/mkurbanparMod.F90 +M tools/mksurfdata/mksoitex.F90 +M tools/mksurfdata/mkirrig.F90 +M tools/mksurfdata/domainMod.F90 +M tools/mksurfdata/areaMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/mkpftMod.F90 +M tools/mkgriddata/mkgriddata.F90 +M tools/mkgriddata/creategridMod.F90 +M tools/mkdatadomain/create_domain.F90 +M src/biogeochem/DGVMLightMod.F90 +M src/biogeochem/DGVMReproductionMod.F90 +M src/biogeochem/DGVMAllocationMod.F90 +M src/biogeochem/DGVMEcosystemDynMod.F90 +M src/biogeochem/CASAMod.F90 +M src/biogeochem/DGVMKillMod.F90 +M src/biogeochem/DUSTMod.F90 +M src/biogeochem/DGVMEstablishmentMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMRestMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/biogeochem/CNrestMod.F90 +M src/biogeochem/VOCEmissionMod.F90 +M src/biogeochem/DGVMMortalityMod.F90 +M src/biogeochem/DGVMTurnoverMod.F90 +M src/biogeochem/DGVMFireMod.F90 +M src/biogeochem/CNEcosystemDynMod.F90 +M src/main/inicFileMod.F90 +M src/main/organicFileMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/clm_varpar.F90 +M src/main/CNiniTimeVar.F90 +M src/main/dynlandMod.F90 +M src/main/accumulMod.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/decompInitMod.F90 +M src/main/ncdio.F90 +M src/main/getdatetime.F90 +M src/main/subgridRestMod.F90 +M src/main/accFldsMod.F90 +M src/main/subgridMod.F90 +M src/main/fileutils.F90 +M src/main/aerdepMod.F90 +M src/main/initializeMod.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/pft2colMod.F90 +M src/main/clm_atmlnd.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/initSurfAlbMod.F90 +M src/main/clm_time_manager.F90 +M src/main/cpl_mct/lnd_comp_mct.F90 +M src/main/ndepFileMod.F90 +M src/main/subgridAveMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/CASAiniTimeVarMod.F90 +M src/main/CNiniSpecial.F90 +M src/main/pftvarcon.F90 +M src/main/snowdp2lev.F90 +M src/main/spmdMod.F90 +M src/main/surfrdMod.F90 +M src/main/domainMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/iobinary.F90 +M src/main/do_close_dispose.F90 +M src/main/mkarbinitMod.F90 +M src/riverroute/RtmMod.F90 +M src/riverroute/RunoffMod.F90 +M src/biogeophys/BalanceCheckMod.F90 +M src/biogeophys/SurfaceRadiationMod.F90 +M src/biogeophys/SoilTemperatureMod.F90 +M src/biogeophys/SnowHydrologyMod.F90 +M src/biogeophys/UrbanInputMod.F90 +M src/biogeophys/Biogeophysics1Mod.F90 +M src/biogeophys/Biogeophysics2Mod.F90 +M src/biogeophys/FracWetMod.F90 +M src/biogeophys/UrbanInitMod.F90 +M src/biogeophys/FrictionVelocityMod.F90 +M src/biogeophys/TridiagonalMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/Hydrology1Mod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/BiogeophysicsLakeMod.F90 +M src/biogeophys/BiogeophysRestMod.F90 +M src/biogeophys/SoilHydrologyMod.F90 +M src/biogeophys/UrbanMod.F90 +M src/biogeophys/QSatMod.F90 +M src/biogeophys/HydrologyLakeMod.F90 +M src/biogeophys/SNICARMod.F90 +M src/biogeophys/DriverInitMod.F90 +M src/biogeophys/BareGroundFluxesMod.F90 +M src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +.........FAIL! rc= 10 +031 smC61 TSM.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 -6 cold +.................FAIL! rc= 10 +032 erC61 TER.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 10+38 cold +..............FAIL! rc= 5 +033 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold +...........FAIL! rc= 5 +034 blC61 TBL.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 48 cold +.................FAIL! rc= 4 +035 smH52 TSM.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 96 cold +.........FAIL! rc= 8 +036 erH52 TER.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 +cold ......FAIL! rc= 5 +037 brH52 TBR.sh 17p_cnnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 +cold ...FAIL! rc= 5 +038 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold +.........FAIL! rc= 4 +039 smI59 TSMcnspinup.sh 17p_cnadspinupsc_dm 17p_cnexitspinupsc_dm 17p_cnsc_dm clm_std +20020115:NONEFAIL! rc= 5 +040 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic +........................FAIL! rc= 10 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic +......................FAIL! rc= 5 + bluefire interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic........FAIL! rc= 10 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +FAIL ERS.f19_g16.I_1850-2000.bluefire <-- script fails, but cpl log same +PASS ERB.f09_g16.I_1948_2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <-- recv lnd Sl_t different +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS + jaguar interactive testing: All PASS except +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +013 smJ74 TSM.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic .FAIL! rc= 8 +014 erJ74 TER.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_casasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic FAIL! rc= 5 + dublin/lf95 interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +026 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +027 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/lf95: +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to.. +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold ......FAIL! rc= 7 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_53 + +Changes answers relative to baseline: Only f19 due to new fsurdat file (off by roundoff) + and startup for f09 and f19 with CN change due + to new finidat files. 20th Century simulations + with CN change because the ndep data set is different + from 1851-1924, and 2001-2004. + +=============================================================== +=============================================================== +Tag name: clm3_6_53 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Tue Sep 22 16:15:39 MDT 2009 +One-line Summary: Fix so that T31_gx3v7 file is actually included + +Purpose of changes: + +Add new optics file from Mark Flanner. Fix so T31_gx3v7 file included. Change testing +for 48x96 to gx3v7. Update datm so that pt1_pt1 res works. Fix clm template so +that RTM is turned off for pt1_pt1 resolution. + +Bugs fixed (include bugzilla ID): + 1042 (Bug with domain directory name in datm for pt1_pt1 resolution) + 789 -- change so that RTM is off should make single-point mode faster + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: In template turn off RTM if grid=pt1 + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Add in T31_gx3v7 frac file, update snicar optics file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm7 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Quickstart.userdatasets +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Summary of testing: Limited + + bluefire: + bluefire interactive testing: + bluefire/CCSM testing: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_53 + +Changes answers relative to baseline: None -- bit for bit + +=============================================================== +=============================================================== +Tag name: clm3_6_52 +Originator(s): erik (erik) +Date: Thu Sep 17 11:07:19 MDT 2009 +One-line Summary: Add T31_gx3v7 support, remove forganic, read from fsurdat, add script to extract regional datasets, work with CN output, add more urban/rural fields + +Purpose of changes: + + Add T31_gx3v7 files needed. Read organic fields from fsurdat file, remove forganic file. + Add in script to extract regional datasets. Change CN output fields list, add NBP (Net + Biome Production field). New Urban/Rural fields from Keith. Update bluefire compiler + to XLF12 (causes some restart issues listed below). + + This tag includes new scripts to extract regional datasets from the global datasets + in order to run for a specific region of interest. The scripts are available in the + models/lnd/clm/tools/ncl_scripts directory, the main script is the + getregional_datasets.pl perl script and it has a command line interface and help with + the "-help" option. There's also a README file in the directory containing the scripts, + and more information in the Quickstart.userdatasets file at the top level. + + Quickstart to use of regional extraction scripts: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 -skip_rundb + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + $EDITOR Tool/Templates/datm.cpl7.template.csh # Add the following line before the check on DOMAINFILE (expand $MYID) + +if ( $DOMAINFILE == "unset" ) set DOMAINFILE = "domain.lnd.$MYID.nc" + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1042 (Bug with domain directory name in datm for pt1_pt1 resolution) + 1063 (Problem in restarts for CCSM spinup data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Filepath, bluefire compiler to XLF12 + + Filepath for stub-components changes + In scripts and in test_driver.sh update compiler for bluefire to XLF12 + (this causes the restart issue for certain cases below). + +Describe any changes made to the namelist: Remove forganic (read organic from fsurdat file) + +List any changes to the defaults for the boundary datasets: Add 48x96_gx3v7 fracdata + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson(urban/rural), slevis (CN fields, new NBP field) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, stub-comps, csm_share + + scripts to scripts4_090916 + drv to vocemis-drydep12_drvseq3_0_29 + datm7 to datm7_090915 + socn/sice/sglc to stubs1_2_01 + csm_share to share3_090902 + +List all files eliminated: Remove noOrganicSoilDataset use case + + Remove the use case that removed the requirement for the forganic dataset. + + D models/lnd/clm/bld/namelist_files/use_cases/noOrganicSoilDataset.xml + +List all files added and what they do: + + Add stylesheet for namelist defaults files. + + A models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + + Scripts to extract regions of interest from global grids and put them into the place + expected by build-namelist with the clm_usr_name option. + + A models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl --- Main script to extract regional datasets. + This one has a command line interface. + A models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl -- Support script to do the actual work. + This one works based on settings of a bunch of environment variables. + +List all existing files that have been modified, and describe the changes: + + M Quickstart.userdatasets - Add notes about using getregional_datasets.pl + M Quickstart.GUIDE -------- Fix typo + + M models/lnd/clm/test/system/test_driver.sh ---- Update seqccsm version to beta26 + Also update bluefire to XLF12. + + M models/lnd/clm/tools/ncl_scripts/README ----- Add note about new getregional_datasets scripts + +>>>>>>>>>>>>>>> Get configure working with new scripts/stub-components + M models/lnd/clm/bld/configure ------- Change Filepath for stub components, remove + write_filepath_ccsm use ccsmbld version + +>>>>>>>>>>>>>>> Remove forganic, add T31_gx3v7, have query NOT return user filenames +>>>>>>>>>>>>>>> for transient files when sim_year_range=constant. +>>>>>>>>>>>>>>> Add style sheets for namelist_defaults files. + M models/lnd/clm/bld/queryDefaultXML.pm -- Skip filenames set to "null" + M models/lnd/clm/bld/build-namelist ------ Remove forganic + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------------ Remove forganic, + add gx3v7 + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml ------ Remove forganic, + add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml --------- Add T31_gx3v7 + domainfile, add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ---------- Add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---------- Make + gx3v7 default for T31, remove reference to forganic, add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml ---- Set transient + files to null for sim_year_range=constant, add stylesheet. + +>>>>>>>>>>>>>>> Add NBP, change which CN fields active/inactive, add new Urban/Rural +>>>>>>>>>>>>>>> fields, remove forganic read organic soil from fsurdat + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Add nbp, update doc for nee, nep, + work with formatting + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 -------- Add nbp, update doc for nee, nep, + work with formatting + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set nbp and work with formatting + M models/lnd/clm/src/main/organicFileMod.F90 ------------- Remove forganic use fsurdat + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------- New urban/rural fields and nbp, + work with formatting + M models/lnd/clm/src/main/controlMod.F90 ----------------- Remove forganic + M models/lnd/clm/src/main/clm_varctl.F90 ----------------- Remove forganic + M models/lnd/clm/src/main/clmtype.F90 -------------------- Add urban/rural (oleson) and nbp, + and update doc on nep, nee + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Add urban/rural fields (oleson), + Change which CN fields on/off, add NBP + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 -- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 --- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 --------- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Add urban/rural (oleson) + +Summary of testing: + + bluefire: All PASS except... +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS up to... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except for branch tests that fail due to XLF12 +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +FAIL ERB.f09_g16.I_1948_2004.bluefire <<<< FAIL's due to compiler upgrade to XLF12 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<< FAIL's due to compiler upgrade to XLF12 +>>>>>>>>>>>>> NOTE This same problem exists in clm3_6_51 if you update the compiler to +>>>>>>>>>>>>> XLF12. +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + dublin/lf95: All PASS except (up to...) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... + change path for cprnc on jaguar +M models/lnd/clm/test/system/input_tests_master -------------- single-column tests are cold-starts +M models/lnd/clm/test/system/tests_pretag_dublin_nompi ------- Add single-column tests +M models/lnd/clm/test/system/tests_posttag_nompi_regression -- Add single-column tests +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ---------- Remove assumption about order of dimensions +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ------------ Remove assumption about order of dimensions +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl -------- Remove assumption about order of dimensions +M models/lnd/clm/bld/config_files/Makefile.in ---------------- For ifort only add -132 to FIXEDFLAGS +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml Go back to old fndepdyn files from clm3_6_47 +M models/lnd/clm/src/main/clm_time_manager.F90 --------------- Label sub as "clm::" and change data to + intent(inout) to comply with ESMF3 + (From Dani Bundy-Coleman) + +Summary of testing: + + bluefire: All PASS except +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS except +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ........FAIL! rc= 5 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ........FAIL! rc= 5 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ....FAIL! rc= 6 +027 blAK8 TBL.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -10 arb_ic ......FAIL! rc= 6 +051 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + lightning/ifort interactive testing: All PASS + dublin/lf95 interactive testing: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_48 + +Changes answers relative to baseline: No (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm3_6_48 +Originator(s): erik (erik) +Date: Wed Aug 12 19:22:59 MDT 2009 +One-line Summary: New aerosol/nitrogen deposition datasets, mksurfdata work, scm work, clm_usr_name option to build-namelist + +Purpose of changes: + +Add in 0.47x0.63, 0.9x1.25 finidat file for CN and 1850, and 0.47x0.63 surface dataset. +Add in datasets at f09, f10, f05, f02 for aerosol (excepting f02 and f05) and nitrogen +deposition from J-F. Work with mksurfdata so that 0.23x0.31 dataset will work (Forrest). +Update csm_share, and get scam working. Add scam tests in. Add clm_usr_name option for +personal datasets to build-namelist. Add a noOrganicSoilDataset use-case so it won't add +in forganic file. Work on using ccsm build files for stand-alone testing. Get testing +going on dublin. + +Bugs fixed (include bugzilla ID): + 813 (use CCSM build files in testing -- partial) + 1010 (error in mksurfdata for qtr degree) + 1014 (shr_scam checkSurface can NOT run an I case) + 1023 (SCM mode check for lnd_present) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1029 (ifort compilation error in pio) + 1031 (Can't run SMS_D.f09_g16.ICN8520) + 1032 (Problem running SCM mode on Lahey) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Get ccsm_bld option working + +Describe any changes made to the namelist: Add -clm_usr_name option for user-datasets, + add noOrganicSoilDataset use case (leaves forganic file off) + + Add the clm_usr_name option to build-namelist, document how this is done in the + Quickstart.userdataset README file. In short... + + if -clm_usr_name is set to ${MYDATAID} then do the following... + + surfdata: copy files into: + $MYCSMDATA/lnd/clm2/surfdata/surfdata_${MYDATAID}_simyr${SIM_YEAR}.nc + fatmgrid: copy files into: + $MYCSMDATA/lnd/clm2/griddata/griddata_${MYDATAID}.nc + fatmlndfrc: copy files into: + $MYCSMDATA/lnd/clm2/griddata/fracdata_${MYDATAID}_${MASK}.nc + faerdep: copy files into: + $MYCSMDATA/lnd/clm2/snicardata/aerosoldep_monthly_${SIM_YEAR}_${MYDATAID}.nc + + Then set CLM_BLDNML_OPTS="-clm_usr_name $MYDATAID" in your env_conf.xml. You + may have to set DIN_LOC_ROOT_CSMDATA in env_run.xml to $MYCSMDATA is this isn't + the standard location as well (use scripts/link_dirtree $CSMDATA $MYCSMDATA to + link standard datasets to your location. + +List any changes to the defaults for the boundary datasets: New datasets + New aerosol and nitrogen deposition datasets from Jean-Francois Lamarque + New interpolated finidat: for 0.9x1.25, and 0.47x0.63 + New fsurdat: for 0.47x0.63 + New faerdep, 1849-2006: for 0.9x1.25 strung together by David Bailey + New faerdep, 1849-2006: for 1.9x2.5, 10x15 (interpolated) + New fndepdat, decadal avgs: for 1.9x2.5 (raw data from J-F) + New fndepdyn, 1850-2006: for 1.9x.25 strung together + New fndepdyn, 1849-2006: for 0.9x1.25, 0.47x0.63, 10x15 (interpolated) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm7 + + scripts to scripts4_090806 + csm_share to share3_090811 + datm7 to datm7_090812 + +List all files eliminated: None + +List all files added and what they do: + + A Quickstart.userdatasets ---------------------------- Documentation on using own datasets + A models/lnd/clm/test/system/nl_files/nl_ptsmode_ocn - Test SCM mode + A models/lnd/clm/test/system/nl_files/nl_ptsmode ----- Test SCM mode over ocean + A models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml --- Template for + user defined input datasets + A models/lnd/clm/bld/namelist_files/use_cases/noOrganicSoilDataset.xml- Use case to + turn off organic soil dataset + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> Add scm tests, new variable to turn on use of CCSM build +>>>>>>>>>>>>>>>> Turn off -test in nl_files, already in mknamelist +>>>>>>>>>>>>>>>> Update dublin build/run to what used by cam. + M models/lnd/clm/test/system/TCB.sh --------------- Test for CLM_CCSMBLD + M models/lnd/clm/test/system/README.testnames ----- Add K and L single point mode cases + M models/lnd/clm/test/system/test_driver.sh ------- Update dublin, add INTEL for dublin + reconcile jaguar module with CCSM build + also set PNETCDF dirs. + M models/lnd/clm/test/system/nl_files/clm_per ----- Remove -test + M models/lnd/clm/test/system/nl_files/clm_std ----- Remove -test + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Remove -test + M models/lnd/clm/test/system/nl_files/clm_pftdyn -- Remove -test + M models/lnd/clm/test/system/nl_files/clm_per0 ---- Remove -test + M models/lnd/clm/test/system/nl_files/clm_urb1pt -- Remove -test + M models/lnd/clm/test/system/input_tests_master --- Add single point tests AK4/AK8,AL4 + M models/lnd/clm/test/system/README --------------- Add note about CLM_CCSMBLD env var + M models/lnd/clm/test/system/CLM_runcmnd.sh ------- Update dublin +>>>>>>>>>>>>>>>> Changes from Forrest Hoffman so that 0.23x0.31 case will work +>>>>>>>>>>>>>>>> I had started this work, but didn't complete it. Forrest checked +>>>>>>>>>>>>>>>> the following changes in. +>>>> 1. Changed the FFLAGS for debug mode on AIX +>>>> 2. Added calls to areaave(), gridmap_clean(), and areaini() in mksoicol.F90 and mksoitex.F90 +>>>> 3. Changed "stop" to "call abort()" in mksrfdat.F90 +>>>> 4. Added roundoff error fixes for gridcells containing only special landunits not +>>>> totalling 100% twice in mksrfdat.F90 +>>>> 5. Added error checking for after landunit adjustment to detect gridcells whose +>>>> components do not total 100% twice in mksrfdat.F90 + M models/lnd/clm/tools/mksurfdata/mksoicol.F90 ---- Add regrid for mask + M models/lnd/clm/tools/mksurfdata/Makefile -------- On IBM optimized remove -C, non-opt remove -O0 + M models/lnd/clm/tools/mksurfdata/mksoitex.F90 ---- Regrid mask + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Roundoff error fix and test +>>>>>>>>>>>>>>>> Handle sim_year_range for datasets, loosen the tolerance for area sum +>>>>>>>>>>>>>>>> Allow time variable to be one ndep files. + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Handle sim_year_range + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Handle sim_year_range, loosen + tolerance, and allow time variable +>>>>>>>>>>>>>>>> Get ccsm_bld option working, change ifort a bit, add clm_usr_name +>>>>>>>>>>>>>>>> option and noOrganicSoilDataset use case to build-namelist +>>>>>>>>>>>>>>>> New datasets + Fix hybrid bug for dynpft case, update externals. Require get_clump_bounds to be called + in threaded regions and get_proc_bounds to be called in non-threaded regions. Remove uneeded get_proc_bounds + calls, and pass down begg stuff as needed. Make loop in initSurfAlb Open-MP. Begin adding + testing for dublin, and add lightning_pgi testing. Add new pftdyn test datasets for 1x1_tropicAtl. + Update testing to beta20, default for lightning is ifort, add lighting_pgi testing. Change hist varnames + of 3D_Time_constants_vars* to Time_constant_3Dvars*. Remove use of LSMLAT/LSMLON cpp tokens, by default + set lsmlat/lsmlon to 1. + +Bugs fixed (include bugzilla ID): 1011 (PGI build problem in driver) + 1016 (Problem with PTS_MODE build) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1010 (error in mksurfdata for qtr degree) + 1014 (shr_scam checkSurface can NOT run an I case) + 1023 (SCM mode check for lnd_present) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: pftdyn test datasets for 1x1_tropicAtl + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, csm_share + +scripts to scripts4_090801 ---------------- Begin adding PTS_MODE settings, update clm testlists +drv to vocemis-drydep12_drvseq3_0_27 -- Add PTS_MODE settings to template +datm7 to datm7_090729 ------------------- Add single_column support +csm_share to share3_090729 ------------------ Add dshr support for scmlat/scmlon in domain + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_dublin ------- Add test list for dublin + A models/lnd/clm/test/system/tests_pretag_dublin_nompi - Add interactive test list for dublin + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_driver.sh ------- Seq testing to beta20, begin adding dublin, default + for lightning is ifort, add lightning_pgi, + M models/lnd/clm/test/system/input_tests_master -- Add openMP 4x5 test + M models/lnd/clm/test/system/CLM_runcmnd.sh ------ Add dublin remove bangkok + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Update pftdyn surfdata for 1000-1004 + tests for 1x1_tropicAtl + + M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 - Remove call to get_proc_bounds -- NOT needed + M models/lnd/clm/src/main/clm_varpar.F90 -------------- By default set lsmlat/lsmlon to 1 + M models/lnd/clm/src/main/dynlandMod.F90 -------------- Remove get_proc_bounds pass begg stuff in + M models/lnd/clm/src/main/driver.F90 ------------------ Pass begg stuff down to pft_interp + M models/lnd/clm/src/main/initializeMod.F90 ----------- Pass begg stuff down to pft_interp + M models/lnd/clm/src/main/pftdynMod.F90 --------------- Pass begg stuff down, remove get_proc_bounds calls + M models/lnd/clm/src/main/histFileMod.F90 ------------- Change var names of 3D_Time_constants_vars* to + Time_constant_3Dvars* + M models/lnd/clm/src/main/initSurfAlbMod.F90 ---------- Make loop OpenMP parallel + M models/lnd/clm/src/main/decompMod.F90 --------------- Make sure get_clumpbounds is called from threaded + regions and get_proc_bounds is NOT. + +Summary of testing: + + bluefire: All PASS except +002 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 7 +010 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 7 +011 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 6 +019 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 +020 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 6 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 7 +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +048 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 6 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS! + bluefire/CCSM testing: All PASS! +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS! + lightning/ifort interactive testing: All PASS! + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_46 + +Changes answers relative to baseline: No bit-for-bit (except dynpft which was irreproducible before) + +=============================================================== +=============================================================== +Tag name: clm3_6_46 +Originator(s): erik (erik) +Date: Wed Jul 22 15:50:43 MDT 2009 +One-line Summary: Get more tests to work/document them, add use cases for 1850_control, + 2000_control, and 20thC_transient, straighten out single-point grids, Listen to + LND_CDF64 env variable from template, remove CLM_ARB_IC. + +Purpose of changes: + +Work with build-namelist to make 20th-Century a use-case so that ndepdyn files will be +included if found, but can still work without them (20thC_transient, 2000_control, and +1850_control use cases). Fix more bugs and tests, report on testing status for each +machine. Add files needed for 1.9x2.5_tx1v1 grid and new 10x15 surface dataset. Reconcile +grids for single-point datasets so consistent (lon within 0-360 rather than -180-180). +Get new single-point datasets for aerosol and nitrogen-deposition. Work with +pftdyntest2raw.ncl so will work. Work with mksurfdata.pl script so will append needed +grid data on urban point datasets. Add in CLM1PT mode for datm7 and use datm7 streams +template for testing. Listen to LND_CDF64 env variable from template, remove CLM_ARB_IC. + +Bugs fixed (include bugzilla ID): 1002 (remove CLM_ARB_IC) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + + Add CLM1PT option to DATM_MODE in env_conf.xml + +Describe any changes made to the namelist: + + New use-cases for: + 2000_control + 1850_control + 20thC_transient + +List any changes to the defaults for the boundary datasets: + 1.9x2.5_tx1v1 datasets, new single-point/regional datasets, new 10x15 surface dataset + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm7, pio + +scripts to scripts4_090720 +datm7 to datm7_090721 +pio to pio51_prod + +List all files eliminated: + +D models/lnd/clm/bld/namelist_files/streams.txt.readme ------- Use datm7 version +D models/lnd/clm/bld/namelist_files/datm.streams.template.xml- Use datm7 version +D models/lnd/clm/test/system/nl_files/clm_organic ------------ organic files included anyway + +List all files added and what they do: + +>>>>>>>>>>>> Add new use cases +A models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- 2000 control +A models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml - 20th Century transient +A models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml ---- 1850 control +A models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- 2000 control + +>>>>>>>>>>>> Add regression tests list for without MPI +A models/lnd/clm/test/system/tests_posttag_nompi_regression ------- no mpi tests + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>> Get more tests working, or at least closer to working +>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>> models/lnd/clm/test/system directory changes +M TCB.sh -------------------------------- Put -mach arg here +M tests_pretag_bluefire ----------------- Change some hybrid tests to MPI +M config_files/ext_ccsm_seq_10x15_dh ---- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_4x5_dh ------ Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_1.9x2.5_dh -- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_64x128_s ---- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_0.9x1.25_dh - Set cice decomp / remove silent mode +M test_driver.sh ------------------------ Set threads/tasks, move -mach to TCB, + set DIN_LOC_ROOT, change needed for latest jaguar build +M tests_posttag_hybrid_regression ------- Remove bad tests, move pure-mpi, serial/open-mp out +M tests_posttag_purempi_regression ------ Remove bad tests, move pure-mpi, serial/open-mp out +M nl_files/nl_urb ----------------------- Remove urban fields already included +M nl_files/nl_urb_br -------------------- Remove urban fields already included +M input_tests_master -------------------- Changes so tests will work +M TCBext_ccsmseq_cam.sh ----------------- Add main/cpl_mct to clm list of dirs + +>>>>>>>>>>>>>>>>>> Update filenames, append grid/frac files to urban single-pt in script +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ---- New griddata, fix filepath +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ---- New griddata, fix filepath +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---------- Fix, append grid/frac data + to urban single-point datasets + +>>>>>>>>>>>>>>>>>> Get the pftdyntest2raw script working (will update datasets later) +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl - Fix so will work, add grazing on +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ----- Add sim_yr to out filenames + +>>>>>>>>>>>>>>>>>> Validate grid +M models/lnd/clm/tools/mkgriddata/creategridMod.F90 - Check for valid grid values + +M models/lnd/clm/srm/main/pftdynMod.F90 - Shorten some long lines + +>>>>>>>>>>>>>>>>>> Change to build: add use-cases, remove CLM_ARB_IC, listen to LND_CDF64 +>>>>>>>>>>>>>>>>>> Add new 1.9x2.5_tx1v1 frac dataset, new datasets for single-point, +>>>>>>>>>>>>>>>>>> new 10x15 datasets, separate out sim_yr and sim_year_range +>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>> models/lnd/clm/bld directory changes +M listDefaultNamelist.pl ----------------------- Add csmdata arg +M build-namelist ------------------------------- Add -list_use_cases option + load uses cases before other defaults, add $ccsm_tools var, + separate sim_yr and sim_year_range, put case_desc for use-cases +M clm.cpl7.template ---------------------------- Remove CLM_ARB_IC, use LND_CDF64 +M namelist_files/checkdatmfiles.ncl ------------ Add tx1v1 mask +M namelist_files/namelist_definition.xml ------- Add tx1v1 mask, make sim_year integer + add sim_year_range, use_case_desc, and clm_demand +M namelist_files/namelist_defaults_overall.xml - default sim_year_range is constant + and default clm_demand is null +M namelist_files/namelist_defaults_datm.xml ---- Use datm7 streams template, + and update domain files +M namelist_files/use_cases/pergro.xml ---------- Add use_case_desc +M namelist_files/use_cases/pergro0.xml --------- Add use_case_desc +M namelist_files/namelist_defaults_clm.xml ----- Move co2_ppmv defaults to use_cases + new surf/frac/aer/ndep/grid data: 5x5_amazon, 1x1_brazil, 1x1_urbanc_alpha, + 1x1_mexicocityMEX, 1x1_vancouverCAN + new frac data: 1.9x2.5_tx1v1 + new aerdep/ndep data: 1x1_camdenNJ, 1x1_tropicAtl, 1x1_asphaltjungleNJ + new surfdata/pftdyn: 10x15 + (new finidat file for f09 CN, 1850 -- commented out -- so answers same as last tag) + +Summary of testing: + + bluefire: All PASS except +019 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 +020 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 6 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +027 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 8 +028 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 5 +029 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 5 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 4 +033 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold ...........FAIL! rc= 6 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 7 +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS except +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +013 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +017 blJ74 TBL.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ..FAIL! rc= 7 +019 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +021 blL78 TBL.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 7 +027 erL83 TER.sh _sc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 7 +028 brL83 TBR.sh _sc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 6 +029 blL83 TBL.sh _sc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 5 +034 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 4 +036 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 +043 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire + lightning/ifort: All PASS except -- up to test 18 +002 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +005 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +006 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +007 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +008 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +009 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +011 erJ42 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 7 +012 brJ42 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 6 +015 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 7 +016 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 6 + lightning/ifort interactive testing: up to test 004 +004 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 + calgary/lf95: All PASS except... +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +015 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +019 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 7 +023 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +024 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +025 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +026 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +028 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +049 blL74 TBL.sh _sc_s clm_std^nl_urb 20020101:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 7 +052 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +053 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +055 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +056 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze,gale,hail,gust/ifort: All PASS except... +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +011 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold .......FAIL! rc= 7 +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_45 + +Changes answers relative to baseline: Bit-for-bit EXCEPT for (as datasets change) + 5x5_amazon, 1x1_brazil, 1x1_urbanc_alpha, 1x1_mexicocityMEX, 1x1_vancouverCAN + 1x1_camdenNJ, 1x1_tropicAtl, 1x1_asphaltjungleNJ, 10x15 + +=============================================================== +=============================================================== +Tag name: clm3_6_45 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jul 10 14:00:27 MDT 2009 +One-line Summary: Remove inconsistent finidat file in clm3_6_44 + +Purpose of changes: A few simple bug fixes from clm3_6_44, with minimul testing + + Remove finidat inconsistent with the surface datasets for f19_g16, bgc=cn, sim_yr=1850 + Fix typo in test list, and fix thread settings for bluefire tests + Remove -ftz from CFLAGS for ifort for mkdatadomain + Change csh run scripts so: use CCSM env_machopts settings, set defaults, fix so can run serial + Update datm7 so that CPLHIST3HrWxHfHrSol mode has iradsw=-1 so mimics running with CAM + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Remove inconsistent + finidat file for 0.9x1.25, gx1v6, BGC=cn, sim_yr=1850 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm7 + + datm7 to datm7_090709 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_driver.sh ------------------- Fix threads settings for bluefire +M models/lnd/clm/test/system/input_tests_master --------------- Fix typo +M models/lnd/clm/tools/interpinic/runinit_ibm.csh ------------- Use CCSM env_machopts settings +M models/lnd/clm/tools/mkdatadomain/Makefile ------------------ Remove -ftz from CFLAGS for ifort +M models/lnd/clm/bld/run-ibm.csh ------------------------------ Use CCSM env_machopts settings, set defaults, + fix so can run serial +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove 0.9x1.25, BGC=cn, sim_year=1850, mask=gx1v6 + finidat file as was inconsistent with new surface dataset + +Summary of testing: Limited + +CLM tag used for the baseline comparison tests if applicable: clm3_6_44 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_44 +Originator(s): erik (erik) +Date: Thu Jul 9 11:47:40 MDT 2009 +One-line Summary: Fix C13 bug, update scripts, drv, datm. Add domain files for idmap +atm-ocn grids for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with +ndeplintInterp, fix SCAM + +Purpose of changes: + +Fix C13 nflds bug, update scripts, drv, datm. Add domain files for idmap atm-ocn grids +for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with ndeplintInterp to +enable using J-F's new Nitrogen deposition files for transient 20th Century simulations. +SCAM fixes from John Truesdale. Add indices for PFT types. + +Bugs fixed (include bugzilla ID): 981 (ccsm domain files for atm=ocn grid) + 987 (remove SEQ_MCT) + 991 (C13 nfields cause model to blowup on jaguar) + 997 (interpolated finidat files cause fully coupled cases to fail) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Remove SEQ_MCT + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New surface datasets for 0.9x1.25 and 1.9x2.5, and new finidat for 1850 for 0.9x1.25 + 10x15 2000 10x15 dataset set to the 1850 version so that testing will work. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson (pftvarcon changes) + SCAM changes from John Truesdale + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, + csm_share and pio + + scripts to scripts4_090707b + drv to vocemis-drydep11_drvseq3_0_23 + datm7 to datm7_090708 + csm_share to share3_090706b + pio to pio50_prod + +List all files eliminated: + + D models/lnd/clm/test/system/tests_pretag_bangkok -- Rename to calgary + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_calgary ----------- Rename from bangkok + A models/lnd/clm/test/system/tests_pretag_bluefire_nompi ---- serial/open-MP tests + A models/lnd/clm/test/system/tests_pretag_jaguar_nompi ------ serial/open-MP tests + A models/lnd/clm/test/system/tests_posttag_lightning_nompi -- serial/open-MP tests + +List all existing files that have been modified, and describe the changes: + + M Quickstart.GUIDE --- fix minor error in name of directory as scripts changed. + + >>>>>>>>>>>> Separate out non-mpi tests for bluefire, jaguar, and lightning + Test list is different if run interactive or submitted to batch que. + Serial, open-mp only tests are run interactive, MPI and hybrid tests + are run when submitted to the batch que. This prevents waste of resources + for serial and open-mp only tests. + Remove bangkok, replace with calgary only. Default threads depends + on if interative or not. + M models/lnd/clm/test/system/test_driver.sh ----------- + M models/lnd/clm/test/system/tests_pretag_bluefire ---- + M models/lnd/clm/test/system/tests_pretag_jaguar ------ + M models/lnd/clm/test/system/tests_posttag_lightning -- + M models/lnd/clm/test/system/README ------------------- Add note about CLM_SOFF + + >>>>>>>>>>>> + M models/lnd/clm/tools/mksurfdata/Makefile ------------------- For ifort remove -ftz option to CFLAGS + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ----- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ---------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt -- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl -------------- New input PFT datasets from Peter L. + + >>>>>>>>>>>> Work on linear interpolation of Nitrogen deposition so that add in mid-decades + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ------- Check if interpolation should be cyclic + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl ----- Also loop over mid decades as well + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --------- Check if interpolation should be cyclic + + >>>>>>>>>>>> Fix from Sam so that don't have negative ice flow + M models/lnd/clm/tools/interpinic/interpinic.F90 --- Change from Sam so that fully coupled cases don't trap negative ice flow + M models/lnd/clm/tools/interpinic/Srcfiles --------- Don't repeat filenames so can build with lahey + + >>>>>>>>>>>> Change so that document that files should have longs between 0 and 360 rather than -180 to 180 + M models/lnd/clm/tools/mkgriddata/mkgriddata.regional --- Use longs 0-360 + M models/lnd/clm/tools/mkgriddata/mkgriddata.singlept --- Use longs 0-360 + M models/lnd/clm/tools/mkgriddata/Makefile -------------- For ifort remove -ftz option to CFLAGS + M models/lnd/clm/tools/mkgriddata/README ---------------- Make note that regional/single-pt grid files should have longs: 0 <= longs <= 360 + + >>>>>>>>>>>> Remove SEQ_MCT and handle COMP_INTERFACE from ccsm cpl7 scripts, new surface datasets + M models/lnd/clm/bld/configure ----------- Remove SEQ_MCT, handle cpl_esmf + M models/lnd/clm/bld/clm.cpl7.template --- Handle $COMP_INTERFACE + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Allow mid-decadal + sim_years so can process ndepdyn files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- New 0.9 finidat, + 0.9x1.25, and 1.9x2.5 surfdata, fndepdat files for mid-decadal sim_years. + + >>>>>>>>>>>> Add indices for PFTs. Fixes for SCAM. Break up long lines > 132chars + M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- noveg, nc3_nonarctic_grass + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- noveg, ncorn, nbrdlf_dcd_brl_shrub + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Add PFT indices + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Add PFT indices + M models/lnd/clm/src/main/organicFileMod.F90 ------------- SCAM fix (from jet) + M models/lnd/clm/src/main/ncdio.F90 ---------------------- Break up long lines + M models/lnd/clm/src/main/pftdynMod.F90 ------------------ Break up long lines, add + noveg, nbrdlf_evr_shrub + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------------- C13 bug fix for number of fields + (found by Jon Wolfe) + M models/lnd/clm/src/main/pftvarcon.F90 ------------------ Add PFT indices, make sure + pftnames from pftcon file is + as expected. + M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 -------- SCAM fix (from jet) + +Summary of testing: + + bluefire: All FAIL except... +008 smB91 TSMruncase.sh .........................................................................PASS +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................PASS + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire.001802 +PASS ERH_D.f10_f10.I_1850_CN.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm3_6_43 + +Changes answers relative to baseline: No -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_43 +Originator(s): erik (erik) +Date: Wed Jun 10 11:41:57 MDT 2009 +One-line Summary: Fix pftdyn bug, enable 1D primary hist files, fix time-const3D output, fix template bug, enable cpl_esmf/cpl_mct + +Purpose of changes: + +Add src/main/cpl_esmf,src/main/cpl_mct directories, change configure to build either way, +add -comp_intf option. Remove SEQ_ #ifdef's, simplify some of the logic associated with +the old options (cpl6 and program_off). Brian K -- fix nans, enable openMP again. Allow +first history tape to be 1D (Sean Swenson). Fix template co2_ppmv error. Remove SPMD +#ifdef from RTM. Fix driver pftdyn bug. Fix bug on writing out 3D time-constant fields. + +Bugs fixed (include bugzilla ID): + 929 (bug in co2ppmv value in template) + 969 (allow primary tapes to be 1D) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 991 (C13 nfields cause model to blowup on jaguar) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Add choice between ESMF/MCT compilation + NOTE: ESMF option does NOT work as files do NOT exist yet! + Add -comp_intf option to configure + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, swensosc (1D and history changes), + kauff (reenable OpenMP, some vars spval instead of nan) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + + scripts to scripts4_090605b + drv to vocemis-drydep08_drvseq3_0_18 + pio back to pio45_prod (to eliminate compilation problem with pathscale) + +List all files eliminated: + +D models/lnd/clm/src/main/lnd_comp_mct.F90 --- Move to cpl_mct + +List all files added and what they do: + +A models/lnd/clm/src/main/cpl_mct ---- Directory for MCT interface +A models/lnd/clm/src/main/cpl_esmf --- Directory for ESMF interface +A models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Moved from main directory + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add -comp_intf option, fix template bug, closing input namelist +M models/lnd/clm/bld/configure ----------- Add -comp_intf option +M models/lnd/clm/bld/config_files/config_definition.xml -- Add comp_interface +M models/lnd/clm/bld/clm.cpl7.template --- Close input namelist with ending "/" + +>>>>>>>>>>>>>> Remove SEQ_ CPP #if's, require some arguments + (needed to be optional for cpl6/offline), allow primary hist files 1D + Fix so that 3D time-constant data does get written out. +M models/lnd/clm/src/main/clm_comp.F90 --------- Make rstwr, nlend, rdate required +M models/lnd/clm/src/main/driver.F90 ----------- Remove doalb if's, PFTDYNWBAL CPP + (for pftdyn bug). Require rstwr, + nlend, and rdate +M models/lnd/clm/src/main/clmtypeInitMod.F90 --- Some vars init to spval (kauff) + certain cell & pft level variables are initialized to spval + instead of nan so eliminate the appearance of nans on restart files. + (not all cell & pfts were used and given non-nan values) +M models/lnd/clm/src/main/histFileMod.F90 ------ Write out 3D time-constant vars, + fix so can write primary 1D files + (Sean Swenson) +M models/lnd/clm/src/main/restFileMod.F90 ------ nlend required +M models/lnd/clm/src/main/controlMod.F90 ------- Remove SEQ_ CPP #if's, allow 1D primary + ability to run threaded is re-enabled (kauff) +M models/lnd/clm/src/main/do_close_dispose.F90 - Require rstwr, nlend +M models/lnd/clm/src/riverroute/RtmMod.F90 ----- Remove SPMD #ifdef + +>>>>>>>>>>>>>> Move testing to calgary from bangkok +M models/lnd/clm/test/system/test_driver.sh ---- Add LD_LIBRARY_PATH for calgary/lf95 + +Summary of testing: + + bluefire: All PASS except (up to test 35) +007 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +008 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +009 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +012 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 5 +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -1100 cold FAIL! rc= 8 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -100 cold FAIL! rc= 4 +019 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 5 +028 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +034 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 + + bluefire/CCSM testing: +PASS ERS.f45_g35.I_2000.bluefire +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +SFAIL ERH.f10_f10.I_1850_CN.bluefire.235943 <<< f10_f10 doesn't work for datm7 right now + +TBL hybrid/openMP tests fail since previous version had OpenMP disabled. + + breeze/gale/hail/gust/ifort: All PASS up to test 12 (10x15, smL51 test) + +CLM tag used for the baseline comparison tests if applicable: clm3_6_43 + +Changes answers relative to baseline: Only pftdyn mode + +=============================================================== +=============================================================== +Tag name: clm3_6_42 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Tue Jun 2 11:58:25 MDT 2009 +One-line Summary: Bring CN Harvest branch (cnhrv02_clm3_6_41) to trunk + +Purpose of changes: + + Add in Peter Thornton's code to read in harvesting variables on surface datasets + and apply harvesting to carbon and nitrogen pools. + Add in surface datasets from clm3_6_40 that have harvesting fields on them for + 0.9x1.25, 1.9x2.5, and 10x15 (as well as aerdep, ndepdat, and ndepdyn datasets). + Remove urban test list as urban on by default, and remove top level doc directory. + Add C13 CPP token for C13 extension of CN add -c13 option to configure. + Add C13/10x15@1850-2000 testing. + Let sum of percent types match to 100 within small value rather than an exact match. + Increase wasteheat limit from 40 to 100 W/m2. + Change default masks to USGS for 4x5,T31,T42, and T85 resolutions so same as cice + Update drv to latest version (drvseq3_0_17 -- on voc branch). + Update ccsm comparision version used in test suite. + +Bugs fixed (include bugzilla ID): + 977 (bug writing out 3D time-const data) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Add C13 #ifdef for CN + Add -c13 option to configure + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Make USGS mask default for 4x5,T31,T42, and T85 + surface datasets with harvesting for: 0.9x1.25, 1.9x2.5, 10x15 (1850,2000) + pftdyn datasets with harvesting for: 0.9x1.25, 10x15 (1850-2005) + faerdep datasets for: 0.9x1.25, 10x15 (1850, 2000, 1850-2000) + fndepdat datasets for: 0.9x1.25, 10x15 (1850,2000) + fndepdyn datasets for: 0.9x1.25, 1.9x2.5, 10x15 (1850-2000) + +Describe any substantial timing or memory changes: Minor for CN + +Code reviewed by: thornton, erik + +List any svn externals directories updated (csm_share, mct, etc.): + Remove top level doc directory as out of date and won't be updated. Howto is in + the scripts directory + +List all files eliminated: + +D models/lnd/clm/test/system/tests_posttag_urban - Urban on by default so doesn't + need it's own tests +>>>>>>>>>>>>>>>>>> Remove as can NOT easily recreate source from them and code + has changed since the creation of the scripts. Would take work + to get the two in sync and be able to use these scripts as source. +D models/lnd/clm/src/main/gen_ncdio_global_subs.csh +D models/lnd/clm/src/main/gen_ncdio_local_subs.csh +D models/lnd/clm/src/main/gen_spmdgs_subs.csh + +List all files added and what they do: + +>>>>>>>>>>>>>>>>>> Add new configurations to test C13 config +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_do +>>>>>>>>>>>>>>>>>> New module to handle wood harvesting +A + models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 Calculate loss fluxes from wood + products pools, and update + product pool state variables + +List all existing files that have been modified, and describe the changes: + +M Quickstart.GUIDE --- Update documentation +M README ------------- Update documentation +>>>>>>>>>>>>>>>>>> Add C13 and 10x15@1850-2000 tests +M models/lnd/clm/test/system/tests_pretag_bluefire --- Add 10x15@1850-2000 tests +M models/lnd/clm/test/system/config_files/README ----- Add note on new C13 config +M models/lnd/clm/test/system/tests_posttag_breeze ---- Add openmp C13 test +M models/lnd/clm/test/system/README.testnames -------- Add R configuration for C13 config +M models/lnd/clm/test/system/tests_posttag_hybrid_regression -- Add C45 and R51 tests +M models/lnd/clm/test/system/tests_posttag_purempi_regression - Add C45 and R52 tests +M models/lnd/clm/test/system/input_tests_master ------ Add C45 (10x15@1850-2000, pure-mpi) and + R51-R53 (C13) tests +M models/lnd/clm/test/system/test_driver.sh ---------- Update ccsm4 comparision version + to beta17 +>>>>>>>>>>>>>>>>>> Add C13 configuration option, and new datasets +M models/lnd/clm/bld/configure -------------------------------- Add -c13 option +M models/lnd/clm/bld/config_files/config_definition.xml ------- Add c13 entry +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - + Change default masks for 4x5,T31,T42,T85 to USGS so agree with cice defaults + surface datasets with harvesting for: 0.9x1.25, 1.9x2.5, 10x15 (1850,2000) + pftdyn datasets with harvesting for: 0.9x1.25, 10x15 (1850-2005) + faerdep datasets for: 0.9x1.25, 10x15 (1850, 2000, 1850-2000) + fndepdat datasets for: 0.9x1.25, 10x15 (1850,2000) + fndepdyn datasets for: 0.9x1.25, 1.9x2.5, 10x15 (1850-2000) +>>>>>>>>>>>>>>>>>> C13/DGVM #ifdefs, add harvest vars and calculations +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 ---- Add CStateUpdate2h method for + harvest mortality fluxes +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 -- Add C13 cpp and add C13StateUpdate2h + method for harvesting +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 ---- Remove 10n and 100n variables +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ----- Add in harvesting terms +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Add C13 #ifdef's +M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 ---------- Add harvesting fields +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Remove 10c, 100c variables, + formatting changes +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Add C13 #ifdef, remove 10c, 100c vars +M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 -- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 ---- Add NStateUpdate2h Nitrogen + harvesting method +M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 --------- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------- Add C13 #ifdef and harvesting variables +M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 ---------- Add C13 #ifdef and C13Flux2h harvest + method, and CNC13HarvestPftToColumn + private method +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ----- Add harvesting method calls + filters by lbc,ubc + Add C13 #ifdef, add CNHarvest call if + fpftdyn file is set. +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 --------- Add C13 #ifdef, remove 10c, 100c loss + vars, add harvest vars +M models/lnd/clm/src/main/clm_varcon.F90 ------------------ Add C13 #ifdef + Increase wasteheat limit to 100 W/m2 +M models/lnd/clm/src/main/CNiniTimeVar.F90 ---------------- Add C13 #ifdef + begc, endc to methods +M models/lnd/clm/src/main/accFldsMod.F90 ------------------ Put frmf and other vars (t10, t_mo, + ... agdd) in DGVM #ifdef +M models/lnd/clm/src/main/clmtypeInitMod.F90 -------------- Add C13 and DGVM #ifdef and new + harvesting vars +M models/lnd/clm/src/main/pftdynMod.F90 ------------------- Add CNHarvest and CNHarvestPftToColumn + as public methods, + add pftdyn_getharvest private methods, + check that land fractions sum to 100 + within 1e-15 rather than exactly 100, + change pftdyn_get_data to pftdyn_getdata + Add C13 #ifdef, remove 10c, 100c loss + calculation +M models/lnd/clm/src/main/iniTimeConst.F90 ---------------- Add DGVM #ifdef +M models/lnd/clm/src/main/clm_atmlnd.F90 ------------------ Add C13 #ifdef +M models/lnd/clm/src/main/lnd_comp_mct.F90 ---------------- Add C13 #ifdef +M models/lnd/clm/src/main/CNiniSpecial.F90 ---------------- Add C13 #ifdef +M models/lnd/clm/src/main/clmtype.F90 --------------------- Add DGVM, C13 #ifdef, + harvest vars +M models/lnd/clm/src/main/histFldsMod.F90 ----------------- Add C13 #ifdef, correct SEEDN, + Add: WOOD_HARVESTC, PRODUCT_CLOSS, C13_PRODUCT_CLOSS, WOOD_HARVESTN, PRODUCT_NLOSS + Change long_name: DWT_PROD10C_GAIN, DWT_PROD100C_GAIN, DWT_CLOSS, DWT_NLOSS +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 --- Add C13 #ifdef +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ------- Add C13 #ifdef + +Summary of testing: + + bluefire: hybrid and open-mp tests FAIL, pftdyn 1000 tests fail, most TBL tests FAIL as answers change +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +005 smL74 TSM.sh _sc_s clm_std^nl_urb 20020101:NONE:1800 1x1_brazil navy -10 arb_ic .............PASS +015 smB91 TSMruncase.sh .........................................................................PASS +021 smF92 TSM.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 96 cold .............PASS +022 erF92 TER.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 cold ..........PASS +023 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 cold .......PASS +029 smCA4 TSM.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +030 erCA4 TER.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......PASS +031 brCA4 TBR.sh _sc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...PASS +032 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +046 smCA8 TSM.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +047 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +048 smNB4 TSM.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic PASS +049 erNB4 TER.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 59+100 arb_icPASS +050 brNB4 TBR.sh _mexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arb_PASS +051 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic PASS +065 smL78 TSM.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -366 arb_ic ............PASS +066 blL78 TBL.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic .............PASS +PASS ERS.f45_g35.I_2000.bluefire +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +SFAIL ERH.f10_f10.I_1850_CN.bluefire.014926 <<< f10_f10 doesn't work for datm7 right now +PASS ERP.f19_g16.I_CN_1850-2000.bluefire + bangkok/lf95: Up to test 6 as follows +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +005 smA92 TSM.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 + breeze/gale/hail/gust/ifort: +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............SKIPPED* +005 smD94 TSM.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................PASS +006 erD94 TER.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............PASS +007 blD94 TBL.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................SKIPPED* +008 smCA4 TSM.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........SKIPPED* +010 smCA8 TSM.sh _sc_ds clm_std^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +011 blCA8 TBL.sh _sc_ds clm_std^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...SKIPPED* +012 smL54 TSM.sh _sc_ds clm_std^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_41 + +Changes answers relative to baseline: Yes, urban wasteheat limit increased to 100 W/m2 + and CN changes due to harvesting + +=============================================================== +Tag name: clm3_6_41 +Originator(s): kauff,erik +Date: Fri May 29 14:15:38 MDT 2009 +One-line Summary: shrub mods, abort if nthreads > 1 (temporary, wrt bugz #965) + +Purpose of changes: fix shrub height, disable threading (due to inexact restart) + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + - update externals for scripts and pio. + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + + - abort if num threads > 1 + main/controlMod.F90 + + - Change CNVegStructUpdateMod.F90 according to Keith Oleson for shrubs. + * First change tsai_min to be multiplied by 0.5 instead of 0.65, and + * second to lower the tapering for shrubs (types 9 and 11) to 10 with 200 for other woody plants. + + main/aerdepMod.F90 ./aerdepMod.F90 + main/clmtype.F90 ./clmtype.F90 + main/clmtypeInitMod.F90 ./clmtypeInitMod.F90 + main/decompInitMod.F90 ./decompInitMod.F90 + main/driver.F90 ./driver.F90 + main/filterMod.F90 ./filterMod.F90 + main/histFileMod.F90 ./histFileMod.F90 + main/histFldsMod.F90 ./histFldsMod.F90 + main/initializeMod.F90 ./initializeMod.F90 + main/pftdynMod.F90 ./pftdynMod.F90 + main/subgridRestMod.F90 + + biogeochem/CNAnnualUpdateMod.F90 ./CNAnnualUpdateMod.F90 + biogeochem/CNBalanceCheckMod.F90 ./CNBalanceCheckMod.F90 + biogeochem/CNEcosystemDynMod.F90 ./CNEcosystemDynMod.F90 + biogeochem/CNVegStructUpdateMod.F90 ./CNVegStructUpdateMod.F90 + + biogeophys//BalanceCheckMod.F90 ./BalanceCheckMod.F90 + biogeophys//SurfaceAlbedoMod.F90 ./SurfaceAlbedoMod.F90 + biogeophys//UrbanInputMod.F90 + +Summary of testing: + + bluefire: + PASS ERS.f45_g35.I_2000.bluefire + PASS ERS.f19_g16.I_1850.bluefire + PASS ERS.f19_g16.I_1850-2000.bluefire + PASS ERB.f09_g16.I_1948_2004.bluefire + SFAIL ERH.f10_f10.I_1850_CN.bluefire.b16+pretag + * code exact restarts when threaded but using only 1 thread + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_6_40 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu May 28 15:17:11 MDT 2009 +One-line Summary: Fix openMP bug, add fndepdyn ncl script, fix interpinic for urban, add mkharvest to mksurfdata, new spinups, turn CLAMP on for CASA or CN + +Purpose of changes: + +Fix hybrid/open-MP mode bug, and testing for hybrid/open-MP. Add ncl script to +time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. Fix +interpinic for urban and cndv (jet/oleson/slevis). Update aerdepregrid.ncl and +ndepregrid.ncl scripts. Add mkharvest fields to mksurfdata. Remove furbinp and just use +fsurdat (leave forganic, so can remove to turn off). Begin to add an option to build +with ccsm makefiles, for test-suite. Remove archiving, branching and resub from last run +script in models/lnd/clm/bld. New spin-up files for 1850 and 2000 for 1.9x2.5 and 1850 +for CN. Make sure CLAMP is turned on for either CASA or CN. Change testing years to +2002-2003 so same as for ccsm tests. + +Bugs fixed (include bugzilla ID): 954 (hybrid problem) + 959 (test suite NOT testing hybrid) + 965 (hybrid problem for high-proc count) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 967 (PIO bounds problem on jaguar) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Start adding option to build with ccsm Makefiles + + By default turn on CLAMP when either CN or CASA is enabled + +Describe any changes made to the namelist: Remove furbinp (use fsurdat) + +List any changes to the defaults for the boundary datasets: New spinup files + + clmi.IQmp17_1950-01-01_1.9x2.5_gx1v6_simyr1850_c090509.nc + clmi.IQmp17_2000-01-01_1.9x2.5_gx1v6_simyr2000_c090509.nc + clmi.BCN_0093-01-01_1.9x2.5_gx1v6_simyr1850_c090527.nc + +Describe any substantial timing or memory changes: Faster because of a fix to a I/O + write bug in datm7 + +Code reviewed by: self, forrest, mvertens, oleson, jet (relevant portions from them) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm7, csm_share + + scripts to scripts4_090527 + datm7 to datm7_090518 + csm_share to share3_090512 + +List all files eliminated: + +D models/lnd/clm/bld/build-streams -- Remove phasing out old run scripts, another + version exists in scripts/ccsm_utils/Tools/build_streams + +List all files added and what they do: + +>>>>>>>>>>>>>>>>>>>> Add harvest fields to surface datasets +A models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 ------------- New module to handle harvest fields + +>>>>>>>>>>>>>>>>>>>> New files for ccsm_bld option +A models/lnd/clm/bld/config_files/Macros.yong_g95 -------------- Macro's file for my Darwin Mac-OSX laptop +A models/lnd/clm/bld/config_files/Macros.breeze_intel ---------- Macro's file for intel on breeze. +A models/lnd/clm/bld/config_files/TopCCSMBldMakefile.in -------- Top level makefile for a ccsm_bld + +>>>>>>>>>>>>>>>>>>>> New scripts to regrid all aerosol/nitrogen deposition resolutions and create + transient Nitrogen-Deposition +A models/lnd/clm/tools/ncl_scripts/runDepositionRegrid.pl ------ Run regrid for many resolutions for + aerosol and nitrogen deposition +A models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl ---------- Linearly interpolate nitrogen-deposition + between 1850 and 2000 to get + transient nitrogen deposition. + +>>>>>>>>>>>>>>>>>>>> New serial and open-MP tests +A models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +A models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +A models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>> Fix hybrid bug (959), some tweaks, change dates to 2002/2003 to correspond with + data checked in +M models/lnd/clm/test/system/tests-driver.sh -------------------- Add -mach option to configure, + able to set CLM_THREADS as input +M models/lnd/clm/test/system/tests_pretag_bluefire -------------- Move f19_g16 test closer to + beginning of list +M models/lnd/clm/test/system/config_files/17p_cnsc_dh ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnsc_dm ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnsc_do ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh --- Turn supln on +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm --- Turn supln on +M models/lnd/clm/test/system/mknamelist ------------------------- Set number of threads by input CLM_THREADS +M models/lnd/clm/test/system/input_tests_master ----------------- Change all start dates to 2002/2003 to + correspond with data checked in +M models/lnd/clm/test/system/README ----------------------------- Document that can set CLM_THREADS +M models/lnd/clm/test/system/TSM.sh ----------------------------- Set number of threads by input + CLM_THREADS / handle cold start + +>>>>>>>>>>>>>>>>>>>> Add harvest fields +M models/lnd/clm/tools/mksurfdata/ncdio.F90 --------------------- Add nf_get_att_text +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ----------------- Write out harvest fields +M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 ------------------ Formatting change +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ------------------ Call mkharvest_init, mkharvest, + and add harvest fields to file +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ---------- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt ----- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ---------- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/Srcfiles ---------------------- Add mkharvestMod.F90 file to list + +>>>>>>>>>>>>>>>>>>>> Fix interpinic for urban +M models/lnd/clm/tools/interpinic/interpinic.F90 ---- Changes from Keith Oleson/John Truesdale to + handle urban +M models/lnd/clm/tools/interpinic/runinit_ibm.csh --- Tweak sim_years, maxpft, and start times + +>>>>>>>>>>>>>>>>>>>> Fix regrid scripts for new sim_yr +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl --- Add sim_yr, document better, add time coord. + variable +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ----- Add sim_yr, figure out file-type from it, + document better, transient files use + lowercase lat, lon instead of LAT, LON. + +>>>>>>>>>>>>>>>>>>>> Fix hybrid bug (959), deprecate old scripts +M models/lnd/clm/bld/configure ----------------- By default turn on CLAMP when either CN or CASA is enabled, + start adding ccsm_bld option, and -mach option. +M models/lnd/clm/bld/mkSrcfiles ---------------- Get it to match scripts version of same thing +M models/lnd/clm/bld/mkDepends ----------------- Get it to match scripts version of same thing, + remove Darwin kludge for assert.h (as has been renamed) +M models/lnd/clm/bld/queryDefaultXML.pm -------- Handle return characters in values +M models/lnd/clm/bld/config_files/Makefile.in -- Get rid of SGI, Nec-SX6, ES, Cray-X1 build options, + tweak Linux build +M models/lnd/clm/bld/listDefaultNamelist.pl ---- Add option to do all resolutions, correct prints +M models/lnd/clm/bld/build-namelist ------------ Add drv_in namelist "ccsm_pes" setting threads to + OMP_NUM_THREADS value, remove furbinp file +M models/lnd/clm/bld/create_newcase ------------ Document that this script is deprecated +M models/lnd/clm/bld/run-ibm.csh --------------- Remove archiving, change defaults, + add notes that script is deprecated +M models/lnd/clm/bld/README -------------------- Remove files taken out +M models/lnd/clm/bld/config_files/config_sys_defaults.xml ----- Add default mach settings +M models/lnd/clm/bld/config_files/config_definition.xml ------- Add mach and ccsm_bld settings +M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Remove furbinp, add task thread layouts + for ccsm_pe namelist +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml - Make same as datm7 version + (except using %p instead of DIN_LOC_ROOT) +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New finidat spinup files for 1.9x2.5, + 1850, 2000 and 1850-CN + +>>>>>>>>>>>>>>>>>>>> Changes from Forrest Hoffman to fix hybrid issues on jaguar (bug 954 and more) +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 -- Add lbc,ubc +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 -- Add lbc, ubc, lbp, ubp +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 -- Explicitly dimension filters to "ubp-lbp+1" + rather than ":" + +>>>>>>>>>>>>>>>>>>>> Fix hybrid issues (bug 954), add #ifdefs to clmtype so can use CLAMP with CASA, + remove CSD and USE_OMP junk +M models/lnd/clm/src/main/driver.F90 ------------------- Remove CSD directives and USE_OMP. + Add more variables to private for OMP loops + (forrest) (bug 954) + Pass array bounds to dynland_hwcontent + (mvertens) (bug 954). + Pass array bounds needed by Forrest's + biogeochem changes above. +M models/lnd/clm/src/main/decompInitMod.F90 ------------ Make a line shorter (with continue lines) +M models/lnd/clm/src/main/subgridRestMod.F90 ----------- Make a line shorter (with continue lines) +M models/lnd/clm/src/main/aerdepMod.F90 ---------------- Remove generic save statement, add save for + each data instantiation +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Add #ifdefs from casafire branch to limit + clmtype size +M models/lnd/clm/src/main/initializeMod.F90 ------------ Remove USE_OMP and CSD directives +M models/lnd/clm/src/main/pftdynMod.F90 ---------------- #ifdef pftdyn_cnbal +M models/lnd/clm/src/main/histFileMod.F90 -------------- Remove CSD directives +M models/lnd/clm/src/main/controlMod.F90 --------------- Remove furbinp, remove UNICOSMP and SSP complexity +M models/lnd/clm/src/main/filterMod.F90 ---------------- Remove CSD directives +M models/lnd/clm/src/main/clmtype.F90 ------------------ Add #ifdefs from casafire branch to limit + clmtype size +M models/lnd/clm/src/main/histFldsMod.F90 -------------- Remove KO comments + +>>>>>>>>>>>>>>>>>>>> Fix hybrid issues (bug 954 and 965), use fsurdat instead of furbinp file for urban input +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Pass in array bounds (mvertens) (bug 954) +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ------ Use fsurdat instead of separate furbinp file +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 --- Remove num_solar logic that caused an early exit + (bug 965) + +Summary of testing: + + bluefire: All PASS except +007 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +008 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +011 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 7 +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -1100 cold FAIL! rc= 8 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -100 cold FAIL! rc= 4 +017 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 7 +018 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 6 +022 erF92 TER.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 cold ..........FAIL! rc= 7 +023 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 cold .......FAIL! rc= 6 +009 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +021 erC61 TER.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 10+38 cold ..............FAIL! rc= 7 +022 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold ...........FAIL! rc= 6 +025 erH51 TER.sh 17p_cnnsc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 7 +027 blH51 TBL.sh 17p_cnnsc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +029 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +030 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +031 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +032 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +036 erLD1 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:1800 2.65x3.33 USGS -5+-5 arb_ic ...........FAIL! rc= 7 +007 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 6 + jaguar: All PASS except +005 smA91 TSM.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 <<< bug 967 +006 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 <<< bug 967 +010 erE92 TER.sh 4p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +013 smEH2 TSM.sh 4p_vodsrsc_dm clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 <<< bug 967 +014 erEH2 TER.sh 4p_vodsrsc_dm clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +015 brEH2 TBR.sh 4p_vodsrsc_dm clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 96 cold .............FAIL! rc= 8 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 <<< bug 967 +026 erJ62 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 + lightning/pathscale: All PASS except +009 smA91 TSM.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +010 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +011 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +012 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 4 +017 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +018 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +019 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +021 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +023 erJ42 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 7 +024 brJ42 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 6 +026 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +027 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +028 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +029 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +032 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +035 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +036 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +037 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 5 + bangkok/lf95: +024 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +025 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +026 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +052 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +055 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +056 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS up to the pftdyn test +016 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_39 + +Changes answers relative to baseline: No bit-for-bit (unless compare cases using the new vs old spin-up files) + +=============================================================== +=============================================================== +Tag name: clm3_6_39 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu May 7 14:18:08 MDT 2009 +One-line Summary: Bug fix for script version and maxpatchpft back to numpft+1 + +Purpose of changes: Bug fixes for two issues, script version to set CLM_DEMAND="null" instead of none + And reset default maxpatch_pft=numpft+1 instead of 4 which crept in on clm3_6_38 + +Bugs fixed (include bugzilla ID): 943 (CLM_DEMAND="null") + 946 (default maxpatchpft) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Change default for maxpatch_pft back to numpft+1 + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_090506 (default CLM_DEMAND is null rather than none) + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/config_files/config_definition.xml ----- maxpft=numpft+1 +M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Allow sim_year=1000 for test datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml Add co2_ppmv for test_yr=1000 +M models/lnd/clm/src/main/driver.F90 ------------------------ Don't write out message about dynamic pft every time-step +M models/lnd/clm/src/main/lnd_comp_mct.F90 ------------------ Set iulog for non-masterproc processors +M models/lnd/clm/test/system/input_tests_master ------------- Put year-range for pftdyn 10x15 tests + +Summary of testing: Limited + +CLM tag used for the baseline comparison tests if applicable: clm3_6_38 + +Changes answers relative to baseline: Default number of PFT's is numpft+1 instead of 4. + +=============================================================== +=============================================================== +Tag name: clm3_6_38 +Originator(s): erik (erik) +Date: Wed May 6 00:20:37 MDT 2009 +One-line Summary: New fsurdat for other resolutions, bug-fixes, deep wetlands to bedrock, new spinups for 1.9x2.5 1850, 2000 + +Purpose of changes: + +New surfdata for all resolutions, and new pftdyn test datasets (1x1 and 10x15). Make sure +furbinp/forganic/fsurdata consistent. New 1850 and 2000 spin-up for 1.9x2.5. Add in field +to restart files needed for urban interpinic. Change deep wetlands to bedrock. Remove +some output for urban and aerdep. fcov changes from Sean. Bring in history change from +Dave (so only output static 3D fields on first h0 file). Bug fix for RTM bug from Keith +O. + +Bugs fixed (include bugzilla ID): 941 (RTM output 6X too low) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 943 (CLM_DEMAND="null") + 946 (default maxpatchpft) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + +Describe any changes made to the namelist: Remove step2init, add irad from datm + factorfn now null instead of unused. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: None + +Code reviewed by: swensosc, oleson, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, +drv, datm7, mct, pio + + scripts to scripts4_090505c + drv to vocemis-drydep08_drvseq3_0_16 + datm7 to datm7_090505b + csm_share to share3_090429 + pio to pio40_prod + +List all files eliminated: Remove old run scripts, pt-urban input data + +D models/lnd/clm/test/system/nl_files/clm_urb -- remove since urban is default +D models/lnd/clm/tools/ncl_scripts/addgrid2spointurban.ncl -- only needed to create + urban pt surface datasets +D models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl - only needed to go + from 10 layer to 15 layer finidat files. +D models/lnd/clm/bld/urban_input +D models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc +D models/lnd/clm/bld/urban_input/metropolis_fluxes.nc +D models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc +D models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_tropicAtl_urb3den_simyr2000_c090320.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr2000_c090320.nc +D models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr1850_c090317.nc +D models/lnd/clm/bld/run-pc.csh +D models/lnd/clm/bld/run-lightning.csh + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> configure defaults for everything on, update for new datm7 + new sim_year for pftdyn test datasets. New fsurdat for all + resolutions, furbinp and forganic=fsurdat. +M models/lnd/clm/bld/configure -------------------------------- document defaults +correctly +M models/lnd/clm/bld/config_files/config_definition.xml ------- defaults for: + dust: on, maxpft:numpft+1, progsslt:on, rtm:on +M models/lnd/clm/bld/listDefaultNamelist.pl ------------------- all -res all option +M models/lnd/clm/bld/clm.cpl7.template ------------------------ use defaults for + dust, progsslt, and rtm. Don't demand furbinp, or forganic +M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Remove step2init, +change defaults for factorfn, and sim_year (for test ranges 1000-1002, and 1000-1004) +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml Factorfn=null, rm step2init +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New 1.9x2.5 finidat, + new fsurdat for all resolutions, +M models/lnd/clm/bld/build-namelist --------------------------- furbinp,forganic now +longer clm_demand + furbinp = fsurdat, forganic = fsurdat, fsurdat no longer need + furbinp and fpftdyn, finidat doesn't need furbinp, remove step2init +>>>>>>>>>>>>>>>> +M models/lnd/clm/src/main/aerdepMod.F90 ---------------- log output only to masterproc +M models/lnd/clm/src/main/iniTimeConst.F90 ------------- remove urban log output +M models/lnd/clm/src/main/subgridRestMod.F90 ----------- add cols1d_ityp +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- add fsat +M models/lnd/clm/src/main/iniTimeConst.F90 ------------- make deep wetlands bedrock +M models/lnd/clm/src/main/histFileMod.F90 -------------- only write out static fields + to h0 tapes on nstep=0 +M models/lnd/clm/src/main/clmtype.F90 ------------------ add fcov and fsat +M models/lnd/clm/src/main/histFldsMod.F90 -------------- add fsat to history files +M models/lnd/clm/src/main/mkarbinitMod.F90 ------------- make wetlands bedrock +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - make wetlands bedrock +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 ------- add fcov/fsat +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------ add fcov/fsat +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 --- add fcov/fsat +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 --- add fcov/fsat +M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Fix RTM bug so accumulate + during RTM intervals +>>>>>>>>>>>>>>>> Remove run-pc/run-lighning tests, remove CLMNCEP, update to beta15 + lightning no parallel gmake, no clm_demand for furbinp, change clm_urb + to clm_std, add sim_year for pftdyn tests, add serial vodsrsc tests +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/test_driver.sh --------- update to beta15, lightning gmake no parallel +M models/lnd/clm/test/system/mknamelist ------------- remove CLMNCEP option +M models/lnd/clm/test/system/TCSruncase.sh ---------- remove lightning, pc option +M models/lnd/clm/test/system/nl_files/clm_per ------- no clm_demand on furbinp +M models/lnd/clm/test/system/nl_files/clm_per0 ------ no clm_demand on furbinp +M models/lnd/clm/test/system/nl_files/clm_urb1pt ---- no clm_demand on furbinp +M models/lnd/clm/test/system/input_tests_master ----- change clm_urb to clm_std + add sim_year for pftdyn tests, add serial vodsrsc + tests +>>>>>>>>>>>>>>>> Change urban pt datasets from 1850 to 2000 sim_year. +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +Summary of testing: limited testing on breeze, lightning, and bangkok + + bluefire: All PASS except TBL up to test 27 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_37 + +Changes answers relative to baseline: Yes, RTM 6X higher, surface datasets different + deep wetlands now bedrock + +=============================================================== +=============================================================== +Tag name: clm3_6_37 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Mon Apr 27 23:27:26 MDT 2009 +One-line Summary: Update faerdep dataset for 1.9x2.5 to point to version cice is using for 1850 and 2000 + +Purpose of changes: Point to same version of faerdep datasets used by cice for 1.9x2.5 1850/2000 + This was needed for the ccsm4_0_beta15 tag. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New faerdep datasets for 1.9x2.5 used by cice (only difference is time coord) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to scripts4_090427b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Summary of testing: None, other than build-namelist for 1.9x2.5 sim_year=1850/2000 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_36 + +Changes answers relative to baseline: Should be identical + +=============================================================== +=============================================================== +Tag name: clm3_6_36 +Originator(s): erik (erik) +Date: Mon Apr 27 14:10:13 MDT 2009 +One-line Summary: Handle transient aersol, make maxpatchpft=numpft+1 default, new datasets for 1.9x2.5 and 0.9x1.25, change doalb + +Purpose of changes: + +Changes so can do aerosol transient time-series (1850-2000) (kauff). New surfdata +datasets for 1.9x2.5 and 0.9x1.25 (1850 and 2000). New 1850-2000 pftdyn dataset for +1.9x2.5. New aerosol and ndep for 1.9x2.5 (1850 and 2000). Change to doalb from Mariana. +Make maxpatchpft=numpft+1 the default and remove all finidat files + +Bugs fixed (include bugzilla ID): 936 (create_test bug) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: maxpatchpft default is now numpft+1 + +Describe any changes made to the namelist: build-namelist now allows 1850-2000 for sim_year for transient datasets + aerdep now chooses a transient dataset for this case as well + +List any changes to the defaults for the boundary datasets: + New aerosol deposition and nitrogen deposition datasets for 1.9x2.5 and transient + New pftdyn dataset for 1.9x2.5 for 1850-2000 + New surfdata for 1.9x2.5 and 0.9x1.25 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, kauff (aer transient), mvertens (doalb changes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, and pio + scripts to scripts4_090424 + drv to vocemis-drydep08_drvseq3_0_14 + datm7 to datm7_090406 + pio to pio38_prod + +List all files eliminated: None + +List all files added and what they do: Add file for generic settings NOT used by a specific model component + +A models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>>>>>> Add cice decomp info, use xml input file for PE change +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_10x15_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_4x5_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_1.9x2.5_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_0.9x1.25_dh +M models/lnd/clm/test/system/TCT_ccsmseq.sh --- use xml file format for PE change +>>>>>>>>>>>>>>>>>>>>>>>> Base LANDMASK on SUM(PCT_PFT) rather than LANDFRAC_PFT +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl +>>>>>>>>>>>>>>>>>>>>>>>> Add 1850-2000 simyr option +M models/lnd/clm/bld/config_files/config_definition.xml ------ maxpatchpft default +is numpft+1 +M models/lnd/clm/bld/namelist_files/namelist_definition.xml -- Add 1850-2000 to valid sim_year values +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove finidat files, + remove data in namelist_defaults_overall, + new fsurdat,forganic,furbinp for 1.9x2.5 and 0.9x1.25 + 1850-2000 PFT dataset for 1.9x2.5 + new aerdep and ndep datasets for 1.9x2.5 and 0.9x1.25, + and transient 1850-2000 aerdep datasets +M models/lnd/clm/bld/build-namelist ----------- Be careful if datasets are picked +based on full sim_year (which could be 1850-2000) or the first year (1850 finidat, +fsurdat files) +M models/lnd/clm/bld/listDefaultNamelist.pl --- Use list of defaults files +M models/lnd/clm/bld/queryDefaultNamelist.pl -- Use list of defaults files, remove scpto option +M models/lnd/clm/bld/queryDefaultXML.pm ------- Use list of defaults files +>>>>>>>>>>>>>>>>>>>>>>>> doalb changes from Mariana Vertenstein (branches/new_doalb) +>>>>>>>>>>>>>>>>>>>>>>>> remove caldayp1 use next_swcday sent from atm +M models/lnd/clm/src/biogeochem/DGVMMod.F90 ---------- remove caldayp1, send nextsw_cday +M models/lnd/clm/src/main/clm_comp.F90 --------------- don't calcualte caldayp1, calc declinp1 based on nextsw_cday +M models/lnd/clm/src/main/driver.F90 ----------------- Pass nextsw_cday instead of caldayp1 +M models/lnd/clm/src/main/initSurfAlbMod.F90 --------- Don't pass calday and declin +M models/lnd/clm/src/main/lnd_comp_mct.F90 ----------- Remove never_doAlb logic, pass nextsw_cday down +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 - cosz based on nextsw_cday NOT caldayp1 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 --------- Do NOT pass calday, declin +>>>>>>>>>>>>>>>>>>>>>>>> aerdep changes from Brian Kauffman (cbgcdev05_clm3_6_35) +M models/lnd/clm/src/main/aerdepMod.F90 -- Time-interpolation done each time-step (rather than just each day) method slightly different. + Also allows transient file where uses first year + until reaches middle years, then after last year continues to use last year. + +Summary of testing: + + bluefire: All PASS except TBL and... up to test 62 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +038 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +039 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +040 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +042 smCA8 TSM.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 10 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_35 + +Changes answers relative to baseline: Yes -- default for maxpatchpft is numpft+1 + rather than 4 + And aersol time-interpolation is different + method is different and also does interpolation + for every time-step NOT held constant each day. + +=============================================================== +=============================================================== +Tag name: clm3_6_35 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Mon Apr 20 15:19:17 MDT 2009 +One-line Summary: Fix major logic bug in mksurfdata + +Purpose of changes: Fix major logic bug in mksurfdata (bug 934) which requires us to recreate any surface datasets + created with clm3_6_32. The bug zero'd out LAI for some PFT's and biased the LAI values + (LAI, SAI, veg-bot, veg-top). + + This is a note from dlawren + "I have taken a look at the new surface files and they look correct to me. LAI + is defined everywhere. I did a quick test using this surface dataset with a + spunup file from Keith's prior 1850 simulation and it worked fine (no errors). + I also confirmed that indeed the gridbox mean LAI is different by up to about + +-0.5. In most places the difference is below +-0.1." + + +Bugs fixed (include bugzilla ID): 934 (pftdyn logic bug) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Self (but new 1.9x2.5 surface dataset checked by dlawren and lawrence) + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl --- Create raw pftdyn test datasets, so can create new ones. + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 ---------------- Fix pftdyn logic error. +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---------------- Move soil-text calc higher up, allow more space for filenames +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ------ Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ----------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --------------- Get T62, 2x2.5 and qtr deg res's, only do 2000 for urban single-point +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt --- Allow larger size for filenames +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt -------- Allow larger size for filenames +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt -------- Allow larger size for filenames + +MM models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ----------- Add svn keywords +MM models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl - Add svn keywords +M models/lnd/clm/tools/ncl_scripts/README --------------------- Update doc on files + +Summary of testing: No testing except for mksurfdata on bluefire + +001 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................PASS +002 sm754 TSMtools.sh mksurfdata tools__s globalirrig ...........................................PASS +003 sm756 TSMtools.sh mksurfdata tools__s pftdyn ................................................PASS + +CLM tag used for the baseline comparison tests if applicable: clm3_6_34 + +Changes answers relative to baseline: no bit-for-bit (other than mksurfdata) + +=============================================================== +=============================================================== +Tag name: clm3_6_34 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Sun Apr 19 09:34:43 MDT 2009 +One-line Summary: Fix bangkok urban bug + +Purpose of changes: Fix urban bug found from bangkok testing (#927) and eliminate potential water balance error + +Bugs fixed (include bugzilla ID): 927 + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 934 (pftdyn logic bug) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself, Erik Kluzek, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 .... Change loop over all columns to filter_nourbanc +M models/lnd/clm/src/biogeophys/UrbanMod.F90 .... Change some net_solar fields from intent(out) to intent(inout). + add soilalpha_u restriction on soil evaporation/transpiration selection for pervious road (this second + change is bit for bit for all bluefire/bangkok testing, but will prevent small water balance errors in + special situations (e.g., perpetual January simulations) + +Summary of testing: + + bluefire: All PASS except: +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +072 blJ61 TBL.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 4 +082 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +084 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +086 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +088 bl756 TBLtools.sh mksurfdata tools__s pftdyn ................................................FAIL! rc= 7 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: All PASS except: +008 blA92 TBL.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +011 blD91 TBL.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 5 +033 blH52 TBL.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +037 blJ92 TBL.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold ...............FAIL! rc= 4 +041 blL51 TBL.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +048 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +049 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_33 + +Changes answers relative to baseline: No, bit for bit + +=============================================================== +=============================================================== +Tag name: clm3_6_33 +Originator(s): erik (erik) +Date: Thu Apr 16 14:45:23 MDT 2009 +One-line Summary: Bring in dynpft changes from cbgc branch + +Purpose of changes: New method for dealing with dynamic land-use changes + + morph routine casa() in casa_ecosystemDyn(), so casa is more similar to CN & DGVM, + and prepares casa code for adding additional carbon flux functionality. + Larger plan is to duplicate these and other mods from casafire branch on this branch. + Add new method for conserving heat & water wrt dynamic land use. + Conserves heat & water for any change in the land-unit, column, or pft arrangment. + when pftdyn is activated, "normalize" sum of new pft weights in a column + to be the same as the sum of the old pft weights + otherwise BalanceCheck will generate water/heat balance errors. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 927 (problem with urban on bangkok/lahey) + 934 (pftdyn logic bug) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: + B. Kauffman, D. Lawrence, G. Bonan, K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + + D biogeochem/CASASummary.F90 ................ code relocated inside CASAMod.F90 + +List all files added and what they do: + + A main/dynlandMod.F90 ............... new routine is here + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> models/lnd/clm/src + M biogeochem/CASAMod.F90 .......... Add in CASASummary.F90, add casa_recosystemDyn subroutine + M main/pftdynMod.F90 .............. when pftdyn is active, "normalize" pft weights in a column + M biogeophys/BalanceCheckMod.F90 .. improved imbalance write statement + M main/driver.F90 ................. CASAsummary, CASAPhenology now called in + casa_ecocsystemDyn() + M main/initSurfAlbMod.F90 ......... casa() renamed casa_ecocsystemDyn() + M main/driver.F90 ......... call new routine here + M main/clmtype.F90 ......... define new fields + M main/clmtypeInitMod.F90 ......... init new fields + M main/histFldsMod.F90 ......... put new fields on hist file + M main/clm_atmlnd.F90 ......... heat imbalance is applied here + (to latent heat flux) + M riverroute/RtmMod.F90 ......... water imbalance is applied here (to runoff) + +Summary of testing: + + bluefire: All PASS except pftdyn TBL tests and ... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: All PASS except +005 smA91 TSM.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 +010 erE92 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +013 smEH2 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 +014 erEH2 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +015 brEH2 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 96 cold .............FAIL! rc= 10 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +026 erJ62 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +038 erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................FAIL! rc= 4 +039 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + lightning/pathscale: All PASS except pftdyn TBL tests and ... +011 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +012 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +018 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +019 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +020 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +022 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +023 smJ42 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 10x15 USGS 96 cold ..............FAIL! rc= 10 +024 erJ42 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 5 +025 brJ42 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 5 +027 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +028 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +029 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +036 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +037 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +038 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 + bangkok/lf95: All PASS except pftdyn TBL tests and ... +005 smA92 TSM.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA92 TBR.sh _sc_dm clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 5 +030 smH52 TSM.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 96 cold .........FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS@2000 72+72 cold ...FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +038 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +048 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +049 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm3_6_33 + +Changes answers relative to baseline: Only for pftdyn mode + +=============================================================== +================================================================================ +Tag name: clm3_6_32 +Originator(s): dlawren, erik, jet +Date: Fri Apr 10 14:38:52 MDT 2009 +One-line Summary: Add irrigation area to mksrfdata, fix high-res and pftdyn problems + +Purpose of changes: Add irrigation area to mksrfdat tool, for irrigated area copy PFT=15 LAI and heights + into PFT=16, PFT=15 is unirrigated crop, PFT=16 is irrigated crop + fix pftdyn mode for mksurfdata (erik), bug fixes to mksurfdata from John Truesdale + script changes to make gx1v6 default. + +Bugs fixed (include bugzilla ID): 919 (pftdyn mode in mksurfdata) + 821 (problems running mksurfdata at high-res) + 357 (codes replicated in tools) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 927 (problem with urban on bangkok/lahey) + 934 (pftdyn logic bug) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Building with PIO is on by default + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: gx1v6 for and 0.47 res + fix 5x5_amazon surface dataset. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jet, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, +csm_share, esmf_wrf_timemgr + + scripts to scripts4_090406 + drv to vocemis-drydep08_drvseq3_0_13 + datm7 to datm7_090403 + csm_share to share3_090407 + timemgr to esmf_wrf_timemgr_090402 + +List all files eliminated: Remove text urban input files, globalurban mksurf namelist -- +as urban is default. + +D models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +D models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt +D models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +D models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +D models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt +D models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban + +List all files added and what they do: + +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt . List of dynamic PFT files from 1850 to 2005 +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ...... Dynamic PFT file for 1850 +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ...... Dynamic PFT file for 2000 +A models/lnd/clm/tools/mksurfdata/mkirrig.F90 ............... calculates irrigated area from irrigated area on input dataset +A models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig .... namelist file pointing to irrigated area source file +A models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml datm namelist info +A models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml drv namelist info + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Add firrig option, fix bugs, fix pftdyn mode +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 .............. Add mksrf_firrig +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 .............. Copy LAI in PFT=15 into PFT=16 if mksrf_irrig /= '' + use standard averaging for pftdyn +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ............. Add mksrf_firrig +M models/lnd/clm/tools/mksurfdata/README +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 .............. Add pct_irr to surface dataset if mksrf_irrig /= '' +M models/lnd/clm/tools/mksurfdata/Srcfiles +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 .............. Adjust PCT_PFT for non-irrigated (PFT=15) and irrigted (PFT=16) crops +M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 .............. Check for divide by zero (JT) +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 .............. Initialize files to blank +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ............. Only output data needed for pftdyn files +M models/lnd/clm/tools/mksurfdata/mkorganic.F90 ............. Allocate bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/mkurban.F90 ............... bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/areaMod.F90 ............... bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 .............. add mkirrig, changes for pftdyn +M models/lnd/clm/tools/mksurfdata/Srcfiles .................. add mkirrig.F90 +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 .............. if firrig => irrig/non-irrig crops +>>>>>>>>>>>>>>> Always create files using the transient input raw datasets +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist +>>>>>>>>>>>>>>> Add needed fields (mask, LANDMASK) to urban datasets +M models/lnd/clm/tools/ncl_scripts/addgrid2spointurban.ncl +>>>>>>>>>>>>>>> Turn pio on, work with defaults +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/run-ibm.csh +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +>>>>>>>>>>>>>>> Add mask,PCT_URBAN and LANDMASK to urban point input files +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc ..... Add mask +M models/lnd/clm/bld/urban_input/metropolis_fluxes.nc ....... Add mask +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc ..... Add mask +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc .... Add mask +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc .... Changes from Keith, add mask +>>>>>>>>>>>>>>> +M models/lnd/clm/test/system/tests_pretag_bluefire - add pftdyn test +M models/lnd/clm/test/system/test_driver.sh -------- use beta14 +M models/lnd/clm/test/system/input_tests_master ---- fix TBR tests, +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh - remove eshr +M models/lnd/clm/test/system/TSM.sh ---------------- fix +M models/lnd/clm/test/system/tests_pretag_bangkok -- put some serial tests first +M models/lnd/clm/test/system/CLM_runcmnd.sh -------- remove bluesky +>>>>>>>>>>>>>>> Always use T_REF2M NOT t_ref2m +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + +Summary of testing: + + bluefire: All PASS except +004 blA74 TBL.sh _sc_ds clm_urb^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 5 +009 blA91 TBL.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +012 blD91 TBL.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 5 +019 blE91 TBL.sh 4p_vodsrsc_dh clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 5 +024 blF92 TBL.sh 17p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +028 blF93 TBL.sh 17p_vodsrsc_do clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +032 blEH1 TBL.sh 4p_vodsrsc_dh clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 5 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +041 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +043 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +047 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v6 48 cold .................FAIL! rc= 7 +055 blH51 TBL.sh 17p_cnnsc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +062 blL78 TBL.sh _sc_s clm_urb^nl_urb 19971231:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 5 +065 smL83 TSM.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 10 +066 erL83 TER.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 5 +067 brL83 TBR.sh _sc_do clm_urb^nl_urb_br 19980115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 5 +068 blL83 TBL.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 4 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +072 blJ61 TBL.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 4 +073 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 10 +077 blJ74 TBL.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ..FAIL! rc= 5 +084 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +086 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +088 bl756 TBLtools.sh mksurfdata tools__s pftdyn ................................................FAIL! rc= 7 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: ALL FAIL except +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....PASS + breeze/pathscale: All PASS + bangkok/lahey: All PASS except +005 smA92 TSM.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA92 TBR.sh _sc_dm clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 5 +014 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 7 +030 smH52 TSM.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 96 cold .........FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS@2000 72+72 cold ...FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +038 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_30 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_31 +Originator(s): erik (erik) +Date: Wed Apr 1 00:58:15 MDT 2009 +One-line Summary: New surface datasets for 1850,2000, support for 0.9x1.25_gx1v6, urban always on. New pft-physiology file. Update scripts so remove some CLM_ env_conf vars. Fix CN for urban/pftdyn. + +Purpose of changes: + +New surface datasets for 1850,2000. sim_year can be 1850 or 2000 +(1870 no longer supported), support for 0.9x1.25_gx1v6. Demand furbinp (urban always on), +wasteheat='ON_WASTEHEAT' by default. Change cpl7 template so can either do a cold start +or require a finidat file (cold or startup). New pft-physiology file for CN used by +everything. Update scripts so remove some CLM_ env_conf vars: CLM_BGC, CLM_DYNNDEP, +CLM_DYNPFT, CLM_CO2_TYPE, remove CLMNCEP from scripts/datm (keeping CLM_QIAN mode). +Change final CN loop to go over soil filter -- so CN,CASA,DGVM can work with urban. +Remove traffic_flux array as it's subscript was out of bounds on breeze. lnd_comp_mct +changed so that check for spval allows for rounding of spval. + +Bugs fixed (include bugzilla ID): 904 (I cases start in 2003 rather than 1948) + 897 (string comparision in scripts) + 357 (remove duplicated files in tools) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 919 (problems in mksurfdata for pftdyn mode) + 920 (glacier_mec problems in mksurfdata) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Add -pio option to configure + Will set the BUILDPIO CPP token as well as adding pio source to Filepath. + +Describe any changes made to the namelist: Add pio_inparm namelist when -pio + was set in configure + +List any changes to the defaults for the boundary datasets: + New 1850 and 2000 surface datasets with urban enabled for most resolutions + Also new 1850 and 2000 finidat files for 1.9x2.5 resolution (other finidat files removed) + +Describe any substantial timing or memory changes: None + +Code reviewed by: Peter Thornton, Keith Oleson, Forrest Hoffman + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, csm_share, mct, pio + + scripts4_090325 + datm7_090325 + vocemis-drydep11_share3_090112 + CT2_6_0_090308 + pio28_prod + +List all files eliminated: + +>>>>>>>>>>>>>> Remove DGVM namelist tests. +D models/lnd/clm/test/system/config_files/10p_dgvmsc_h +D models/lnd/clm/test/system/config_files/10p_dgvmsc_m +D models/lnd/clm/test/system/config_files/10p_dgvmsc_o +D models/lnd/clm/test/system/config_files/10p_dgvmsc_s +D models/lnd/clm/test/system/config_files/10p_dgvmsc_dh +D models/lnd/clm/test/system/config_files/10p_dgvmsc_dm +D models/lnd/clm/test/system/config_files/10p_dgvmsc_do + +>>>>>>>>>>>>>> Remove script that creates ASCII global data for urban. +D models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_urbanparam_file_p7.ncl + +>>>>>>>>>>>>>> Remove modules replicated in mkgriddata by mksurfdata modules +>>>>>>>>>>>>>> use the versions in mksurfdata. +D models/lnd/clm/tools/mkgriddata/ncdio.F90 +D models/lnd/clm/tools/mkgriddata/domainMod.F90 +D models/lnd/clm/tools/mkgriddata/areaMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>>>> Add point datasets that now have urban information in them. +A models/lnd/clm/bld/urban_input/surfdata_1x1_tropicAtl_urb3den_simyr2000_c090320.nc +A models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr2000_c090320.nc +A models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr1850_c090317.nc + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Make most tests with urban, remove dgvm tests +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/nl_files/clm_per +M models/lnd/clm/test/system/nl_files/clm_per0 +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/tests_posttag_lightning + +>>>>>>>>>>>>>> Add all_urban mode for single-point mode +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 +M models/lnd/clm/tools/mksurfdata/ncdio.F90 +M models/lnd/clm/tools/mksurfdata/mkglacier.F90 +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 +M models/lnd/clm/tools/mksurfdata/mklanwat.F90 +M models/lnd/clm/tools/mksurfdata/mkurban.F90 +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 + +>>>>>>>>>>>>>> Add pio option to configure, and if set add pio_inparm namelist +>>>>>>>>>>>>>> Datasets to 1850/2000 and most with urban. +M models/lnd/clm/bld/configure ------------- Add pio option +M models/lnd/clm/bld/config_files/config_definition.xml - Add pio to config_cache.xml +M models/lnd/clm/bld/clm.cpl7.template ----- require furbinp, remove CLM_ env vars +M models/lnd/clm/bld/build-namelist -------- make sure sim_year sent in, change + some names etc. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add pio_inparm +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml -- Remove CLM_NCEP +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- urban datasets + for most resolutions, datasets for 1850 and 2000, remove most finidat + +>>>>>>>>>>>>>> Add data from grid files as well as LANDMASK and PCT_URBAN. +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc +M models/lnd/clm/bld/urban_input/metropolis_fluxes.nc +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc + +>>>>>>>>>>>>>> Changes from Forrest H./Peter T. to fix some CN problems (single-point, pftdyn) +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/main/driver.F90 +M models/lnd/clm/src/main/pftdynMod.F90 +M models/lnd/clm/src/main/lnd_comp_mct.F90 --------- Change from Mark Flanner + to fix roundoff issues for aerosols. +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------- Remove traffic_flux as subscript + bounds was being exceeded on breeze. + +Summary of testing: + + bluefire: All PASS except TBL and... +023 brF92 TBR.sh 17p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 72+72 cold ..........FAIL! rc= 13 +027 brF93 TBR.sh 17p_vodsrsc_do clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 72+72 cold ..........FAIL! rc= 13 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +065 smL83 TSM.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 10 +066 erL83 TER.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 5 +067 brL83 TBR.sh _sc_do clm_urb^nl_urb_br 19980115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 5 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +076 brJ74 TBR.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 13 + jaguar: All PASS except TBL and... +005 smA91 TSM.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 +010 erE92 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +026 erJ62 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +030 smJ74 TSM.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic .FAIL! rc= 10 +031 erJ74 TER.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +032 brJ74 TBR.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +039 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 7 + bangkok/lf95: All PASS except TBL + breeze/gale/hail/gust/ifort: All PASS + +TBL tests are different since most tests are now with urban. + +Most of the fails are due to missing files. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_30 + +Changes answers relative to baseline: Yes for CN -- new pft-physiology file + +=============================================================== +=============================================================== +Tag name: clm3_6_30 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Thu Mar 19 20:44:33 MDT 2009 +One-line Summary: Fix urban roof/wall layers + +Purpose of changes: Fix urban roof/wall layers + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Me + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/main/iniTimeConst.F90 ---- divide roof/wall thickness by nlevurb instead of nlevsoi + +Summary of testing: + + bluefire: All urban testing passed except TBL + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_29 + +Changes answers relative to baseline: Urban only + +=============================================================== +=============================================================== +Tag name: clm3_6_29 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Thu Mar 19 07:16:05 MDT 2009 +One-line Summary: CN SAI, CN testing fix, rad step size fix + +Purpose of changes: Add SAI decay for CN mode. + Fix CN for tests SmI58, smH51, erH51, brH51 + Add new get_rad_step_size function used by SAI decay function. This is the "simple fix" + and yields correct radiation time step size for all time steps except one for the I and F + cases. The "complete fix" involves changes to other component models and will be available soon. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: K. Oleson, G. Bonan, F. Hoffman, M. Vertenstein, J. Truesdale + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeochem/CNrestMod.F90 --- add seven CN fields deleted previously for restart +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 ---- add SAI decay function (calls get_rad_step_size) +M models/lnd/clm/src/main/clm_time_manager.F90 ---- changes to fix get_rad_step_size function +M models/lnd/clm/src/main/lnd_comp_mct.F90 ---- changes to fix get_rad_step_size function + +Summary of testing: + + bluefire: All PASS except: +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 4 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +055 blH51 TBL.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 48 cold ................FAIL! rc= 7 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +smH74 and blH74 failures are being investigated. +blH51 fails because it fails in clm3_6_28 (fixed in this commit). +Other failures are known. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_28 + +Changes answers relative to baseline: CN mode only due to SAI decay factor + +=============================================================== +=============================================================== +Tag name: clm3_6_28 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Tue Mar 17 07:03:12 MDT 2009 +One-line Summary: Fix permission denied error when reading surface dataset + +Purpose of changes: Change nf_open statement in UrbanInputMod.F90 + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Erik K. + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ---- don't use getavu for nf_open + +Summary of testing: + + bluefire: All PASS except for: +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 4 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 cold .................FAIL! rc= 5 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 10+38 cold .............FAIL! rc= 7 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 72+72 cold .............FAIL! rc= 6 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +sm74, blH74, smI58 are known failures related to CN and are being investigated. +blC61 fails because clm3_6_27 fails (fixed in this tag). +Other failures are known. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_27 + +Changes answers relative to baseline: bfb + +=============================================================== +=============================================================== +Tag name: clm3_6_27 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Mon Mar 16 10:52:05 MDT 2009 +One-line Summary: Urban model changes and FGR12 fix + +Purpose of changes: Fix large urban saturation excess runoff. + Limit urban dew formation. + Change FGR12 diagnostic. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not tested + +Code reviewed by: K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 ---- change eflx_fgr12 diagnostic +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- limit urban dew formation and calculate + pervious road qred over nlevsoi, not nlevurb +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ---- prevent large saturation excess due to + ponded ice + +Summary of testing: + + bluefire: All PASS tests_pretag_bluefire except TBL and : +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +048 smC61 TSM.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 -6 cold .................FAIL! rc= 10 +049 erC61 TER.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 10+38 cold ..............FAIL! rc= 5 +050 brC61 TBR.sh _sc_dh clm_urb^nl_urb_br 19981001:NONE:1800 1.9x2.5 gx1v5 -3+-3 cold ...........FAIL! rc= 5 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 10+38 cold .............FAIL! rc= 7 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 72+72 cold .............FAIL! rc= 6 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc=5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +smH74 and smI58 are CN-related tests that did not fail in clm3_6_25, but fail in clm3_6_26 and in this tag and +thus should be investigated further. +smC61, erC61, brC61 fail because of permission denied when reading surface dataset. This appears to be a test +suite problem only. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_26 + +Changes answers relative to baseline: Urban answers change because of runoff fix. + Standard mode answers only change in FGR12 diagnostic. + +=============================================================== +=============================================================== +Tag name: clm3_6_26 +Originator(s): Peter Thornton +Date: 3/14/09 +One-line Summary: CN time step and restart file changes + +Purpose of changes: shorten CN restart file. Requires moving CLM to physical model timestep. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: nonee + +Describe any substantial timing or memory changes: CLM restart file reduced in size by ~factor of 3. + +Code reviewed by: Forrest Hoffman + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNFireMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 - change q10 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 - remove reference to retransn +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 - change q10 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNrestMod.F90 - eliminate many CN variables +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 - change time step, and cleanup some variable names +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 - cleanup variable names +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - change time step +M models/lnd/clm/src/main/CNiniTimeVar.F90 - cleanup variable names +M models/lnd/clm/src/main/driver.F90 - change time step +M models/lnd/clm/src/main/clmtypeInitMod.F90 - cleanup variable names +M models/lnd/clm/src/main/pftdynMod.F90 - change time step +M models/lnd/clm/src/main/clm_time_manager.F90 - change time step +M models/lnd/clm/src/main/clmtype.F90 - cleanup variable names +M models/lnd/clm/src/main/histFldsMod.F90 - cleanup variable names + +Summary of testing: + + bluefire: + jaguar: + Ran the CLM test suite, with the following results: +smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................PASS +erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................PASS +brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................PASS +blA74 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................SKIPPED* +smA91 TSM.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................PASS +erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 (passes with 512 tasks) +brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 (passes with 512 tasks) +blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................SKIPPED* +smE92 TSM.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ...................PASS +erE92 TER.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic ................PASS +brE92 TBR.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ................PASS +blE92 TBL.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ...................SKIPPED* +smEH2 TSM.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 48 arb_ic .......PASS +erEH2 TER.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 10+38 arb_ic ....PASS +brEH2 TBR.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 24+24 arb_ic ....PASS +blEH2 TBL.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 48 arb_ic .......SKIPPED* +smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................SKIPPED* +smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 96 cold .............PASS +erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........PASS +brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........PASS +blH92 TBL.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 48 cold .............SKIPPED* +smJ62 TSM.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 96 startup ...............PASS +erJ62 TER.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 10+38 startup ............PASS +brJ62 TBR.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 72+72 startup ............PASS +blJ62 TBL.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 48 startup ...............SKIPPED* +smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +smJ74 TSM.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic ........PASS +erJ74 TER.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic ......PASS +brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........PASS +blJ74 TBL.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........SKIPPED* +smK92 TSM.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ...................PASS +erK92 TER.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic ................PASS +brK92 TBR.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ................PASS +blK92 TBL.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ...................SKIPPED* +smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +blLI2 TBL.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................SKIPPED* +erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................PASS +erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................PASS kraken: + +Note: the tests that FAIL here are the same that FAIL on jaguar with clm3_6_25. + + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + q10 changes are climate changing. Time step changes are larger than roundoff, similar climate. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_6_25 +Originator(s): dlawren (Lawrence David 1384 CGD), erik (Kluzek Erik), tcraig (Craig Tony) +Date: Fri Mar 13 15:11:01 MDT 2009 +One-line Summary: Daylength control on Vcmax, 1%Lake,wetland,glacier in mksrfdat, remove ELEVATION in surface data file + +Purpose of changes: Include changes from Peter Thornton to include daylength control +on vcmax in photosynthesis scheme; Set minimum lake, wetland, and glacier area to 1% +to be more consistent with urban and to represent more lakes and wetlands; remove +temporary unused ELEVATION field from surface dataset + +Bugs fixed (include bugzilla ID): 877 (CN restart problem) + 911 (high PE count problem) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New global urban datasets 10x15 and 1.9x2.5 resolutions + +Describe any substantial timing or memory changes: None + +Code reviewed by: David Lawrence (code), Erik Kluzek (testing and build), Tony Craig (DecompInitMod.F90) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, mct, datm + + scripts to scripts4_090310 + datm7 to datm7_090229 + mct to MCT2_6_0_090308 + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/test/system/config_files/tools__s ..... Optimized serial mode for tools + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 ..... correct bug in error check +M models/lnd/clm/tools/mksurfdata/mkglacier.F90 .... reduce min glacier frac from 5 to 1% +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 .... remove ELEVATION field +M models/lnd/clm/tools/mksurfdata/mklanwat.F90 ..... reduce min lake,wetland frac from 5 to 1% +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ..... remove ELEVATION field +M models/lnd/clm/tools/mksurfdata/README ........... add documentation about being slow unless use OPT=TRUE in gmake +M models/lnd/clm/src/main/decompInitMod.F90 ........ Changes from Tony Craig to fix for high PE counts +M models/lnd/clm/src/main/clm_comp.F90 ............. daylength control on vcmax changes +M models/lnd/clm/src/main/driver.F90 ............... daylength control on vcmax changes +M models/lnd/clm/src/main/clmtypeInitMod.F90 ....... daylength control on vcmax changes +M models/lnd/clm/src/main/iniTimeConst.F90 ......... daylength control on vcmax changes +M models/lnd/clm/src/main/clmtype.F90 .............. daylength control on vcmax changes +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 daylength control on vcmax changes + +M models/lnd/clm/test/system/test_driver.sh ........ update to beta10, fix some issues on jaguar +M models/lnd/clm/test/system/input_tests_master .... do most mksurfdata testing optimized + change CN tests to cold-starts, change 1890 to 1870 + +M models/lnd/clm/bld/build-namelist ................ pass sim_year and maxpft in when determining default for finidat +M models/lnd/clm/bld/clm.cpl7.template ............. add in ignore logic like cam +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml . update input files + +Summary of testing: + + bluefire: All PASS except TBL and... +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +052 smH51 TSM.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 96 cold ................FAIL! rc= 8 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 cold .............FAIL! rc= 5 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 cold .............FAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + jaguar: Limited testing... + lightning/pathscale: All PASS except TBL and... +002 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +003 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +004 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +006 smOC4 TSM.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +007 erOC4 TER.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_icFAIL! rc= 5 +008 brOC4 TBR.sh _vansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arb_iFAIL! rc= 5 +011 erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 +012 brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 +019 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 7 +020 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 6 +024 erJ42 TER.sh 4p_casasc_dm clm_std 19981230:NONE:1800 10x15 USGS 10+38 startup ...............FAIL! rc= 7 +025 brJ42 TBR.sh 4p_casasc_dm clm_std 19981230:NONE:1800 10x15 USGS 72+72 startup ...............FAIL! rc= 6 +027 smK51 TSM.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +028 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +029 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 5 +032 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 7 +033 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 6 +040 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +041 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +042 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 5 + breeze/gale/hail/gust/ifort: All PASS except TBL + +CLM tag used for the baseline comparison tests if applicable: clm3_6_24 + +Changes answers relative to baseline: Yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: similar climate + + Dave Lawrence ran a short simulation to show that answers do NOT change significantly + +=============================================================== +=============================================================== +Tag name: clm3_6_24 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Mon Mar 9 21:01:47 MDT 2009 +One-line Summary: Fix urban testing and some history field changes + +Purpose of changes: Convert urban ascii files to netcdf to get urban testing to work. + Add rh_ref2m calculation for urban and change urban/rural humidity from specific to relative in + history files. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 877 (CN restart problem) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: In namelist_defaults_clm.xml: + Change *.txt urban files to *.nc + Change aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090119.nc to + aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090114.nc + Change path for surfdata_0096x0144_090223_v2.nc from + lnd/clm2/surfdata/ to lnd/clm2/urbdata + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not tested + +Code reviewed by: K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: A models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc + A models/lnd/clm/bld/urban_input/metropolis_fluxes.nc + A models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc + A models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc + A models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/test/system/nl_files/nl_urb ---- Remove TSNOW from hist_fincl1, remove Q2M, Q2M_R, Q2M_U and + add RH2M, RH2M_R, RH2M_U to hist_fincl2 +M models/lnd/clm/test/system/nl_files/nl_urb_br --- Remove TSNOW from hist_fincl1 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---- Change *.txt urban files to *.nc + Change aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090119.nc to + aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090114.nc + Change path for surfdata_0096x0144_090223_v2.nc from + lnd/clm2/surfdata/ to lnd/clm2/urbdata +M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- delete q_ref2m_r, q_ref2m_u, and add rh_ref2m_r, rh_ref2m_u +M models/lnd/clm/src/main/clmtype.F90 ---- delete q_ref2m_r, q_ref2m_u, and add rh_ref2m_r, rh_ref2m_u +M models/lnd/clm/src/main/histFldsMod.F90 ---- delete Q2M_U, Q2M_R, and add RH2M_U, RH2M_R +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 ---- delete q_ref2m_u and add rh_ref2m_u +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ---- delete q_ref2m_u and add calculation for rh_ref2m_u +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 ---- delete q_ref2m_r and add rh_ref2m_r +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ---- delete q_ref2m_r and add rh_ref2m_r + +Summary of testing: + + bluefire: All PASS except: +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +037 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +041 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +043 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +047 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 cold .................FAIL! rc= 5 +052 smH51 TSM.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..........FAIL! rc= 1 +053 erH51 TER.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic .......FAIL! rc= 1 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic .......FAIL! rc= 1 +055 blH51 TBL.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..........FAIL! rc= 1 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +090 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +091 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +092 erP61 TSM_ccsmseq.sh ERS f19_g1 701 (svn keyword) + 698 (cprnc bug gives false difference) + 717 (archiving bug -- only archive 1000 files at a time) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + + Known bugs that will NOT be resolved: 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Hydrology changes (Guo-Yue Niu water table below soil column, fff=7, +Qing micropore eqs (hksat and sucsat) and Qing microporosity +-Simulation clm3_5niu5). + +Snow cover fraction (Niu and Yang); snow burial fraction for short vegetation +(Wang and Zeng); thermal and hydraulic organic soil (Lawrence); +snow compaction fix (Lawrence); snow T profile during layer splitting +fix (Lawrence); new FGR12 diagnostic. + +Ground emissivity now weighted combination (using fsno) of snow and soil +emissivity, sparse dense aerodynamic parameters from X. Zeng parameterization, +Liu (2004) saturated hydraulic conductivity and matric potential, +change saturation excess mechanism to only go to next to lowest layer, change +forcing height to min. of 40m. + +Lower volumetric soil water content to remove drainage spikes from some points +with high sand content. Change volumetric soil water content from 0.4 to 0.3. + +Incorporate hydrologically inactive deep soil (15 layers, 11-15 +hyrdologically inactive) and add mksoilcarb capability. +Change deep soil (layers 11-15) to dry rock type rather than wet sand +to reduce spinup time and for greater realism. + +Improved representation of snow-radiation interaction, including snow aging, +darkening from black carbon and dust, and vertically-resolved solar heating. + +Remove code pertaining to 40m minimum forcing height. Forcing height is now +whatever the atmospheric model provides plus z0+d of each pft. For offline +simulations this will be 30m+z0+d. + +saturation excess back to CLM3.5 parameterization. Sakaguchi litter resistance +Remove Qing Liu soil micropore functions and return to CLM3.5 formulations, +change decay factor for drainage to 2.5. remove Niu water table below soil +column formulation, frozen fraction of soil expression normalized per Zeng, +rsubmax=9.9 for drainage calculation, decay factor=0.5 for surface runoff +calculation, Zeng/Decker Richards equation mods, modified one-step solution +for soil moisture and qcharge for compatibility with Zeng/Decker Richards +mods per Swenson. + +Change input datm7 forcing so that Precip is over 6 hour interval, +times are corrected for Temp, Pres, Humid, and Wind data and linear +interpolation is used, and solar data is scaled by the cos(sol-zen angle). + +Set litter LAI = 0.5 and incorporate Swenson organic/mineral soil hk +percolation theory + +CASA changes from Forrest Hoffman: + + These changes add SOILPSI to the CASA' + configuration, correct units on C-LAMP carbon pool type fluxes, and reclassify + microbial pools as soil type pools. I believe this includes all modifications + between bgcmip04_clm3_expa_60 and bgcmip08_clm3_expa_72. + +Summary of CN and Btran changes from Sam Levis: + +- CanopyFluxes modification in the calculation of btran so that it equals 0 in soil layers with temperature <=-2 C. +- CN mods recommended by Peter Thornton and the BGCWG during the bgc development phase of the last few months. + +Grassland AND CROP optical properties changes from Keith Oleson: + +New pft physiology file was created: + +pft-physiology.c081002 + +Description of changes to physiology file: + +New leaf and stem optical properties (VIS and NIR reflectance and transmittance) +were derived for grasslands and crops (pfts 12-16) from full optical range +spectra of measured optical properties (Asner et al. (RSE 1998). + +New properties are: + + Leaf Stem + VIS NIR VIS NIR +Reflectance 0.11 0.35 0.31 0.53 +Transmittance 0.05 0.34 0.12 0.25 + + +Describe any changes made to build system: + + Add SNICAR_FRC and CARBON_AERO ifdef tokens + + DEFINE option SNICAR_FRC: enables second radiative transfer calculation of pure snow for radiative forcing estimation + + in configure use options -carbon_aero and -snicar_frc + +Describe any changes made to the namelist: Add fsnowoptics, fsnowaging, faerdep + +Added namelist variables fsnowoptics, fsnowaging, and faerdep, which point to files containing, respectively, snow/aerosol optical properties, snow aging parameters, and global aerosol deposition file. THESE FILES ARE REQUIRED. + +List any changes to the defaults for the boundary datasets: + + finidat files developed, all new fsurdat files, new pft-physiology, + files for T62, new organic files, new files for SNICAR (fsnowoptics, + fsnowaging, faerdep), fix some inconsistencies with fraction files, + get topo files setup correctly, get all files for 4x5 and 2x2.5 resolution + +Describe any substantial timing or memory changes: Yes + 20% slower because of SNICAR and slower because of deep soil + +Code reviewed by: Keith Oleson, Mark Flanner, Dave Lawrence, + Peter Thornton, Sam Levis, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, + drv, datm7, socn, sice, sglc, csm_share, timing, pio, cprnc + ++scripts scripts4_090112 ++models/drv/seq_mct drvseq3_0_04 ++models/atm/datm7 datm7_090107 ++models/ocn/socn stubs1_1_01/socn ++models/ice/sice stubs1_1_01/sice ++models/glc/sglc stubs1_1_01/sglc ++models/csm_share share3_090112 ++models/utils/timing timing_081028 ++models/utils/pio pio28_prod/pio ++models/lnd/clm/tools/cprnc cprnc_081022 + +List all files eliminated: + +D models/lnd/clm/test/system/tests_pretag_bluevista - remove +D models/lnd/clm/bld/scpDefaultNamelist.pl ---------- replace with listDefaultNamelist.pl +D models/lnd/clm/bld/run-frost.csh ------------------ remove as can use cpl7 +D models/lnd/clm/tools/interpinic/clmi_1999-01-02_10x15_c070330.nc -- new file + +List all files added and what they do: + +A + models/lnd/clm/test/system/nl_files/clm_organic ------------ test organic +A + models/lnd/clm/tools/mksurfdata/mkorganic.F90 -------------- add organic to surfdat +A + models/lnd/clm/tools/mksurfdata/mksurfdata.pl -------------- create all fsurdat files +A + models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ---------- interpolate aerosol deposition +A + models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl interpolate old clmi files to 15 soil levels +A + models/lnd/clm/tools/interpinic/clmi.IQ.1953-01-01_10x15_USGS_simyr2000_c081202.nc + ---------------- new 15 layer file to test interpolation +A + models/lnd/clm/tools/interpinic/runinit_ibm.csh ------------ create all finidat files +A + models/lnd/clm/bld/listDefaultNamelist.pl ------------------ list inputdata files needed +A + models/lnd/clm/src/main/organicFileMod.F90 ----------------- organic soil +A + models/lnd/clm/src/main/aerdepMod.F90 ---------------------- read in aerosol deposition +A + models/lnd/clm/src/biogeophys/SNICARMod.F90 ---------------- SNICAR model +A + Quickstart.GUIDE ------------------------------------------- Quickstart to cpl7 scripts + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>>>>>>> Add compile_only option, fix smp/spmd, change most +>>>>>>>>>>>>>>>>>>>>>>>>> tests to 4x5 resolution, update ccsm version, +>>>>>>>>>>>>>>>>>>>>>>>>> remove bluevista, change to clm_qian inputdata +>>>>>>>>>>>>>>>>>>>>>>>>> add cold start type + +M models/lnd/clm/test/system/TCB.sh +M models/lnd/clm/test/system/config_files/4p_vodsrsc_dm +M models/lnd/clm/test/system/config_files/4p_vodsrsc_do +M models/lnd/clm/test/system/config_files/scam_ds ----- fix defaults for scam +M models/lnd/clm/test/system/config_files/17p_cnnsc_o +M models/lnd/clm/test/system/config_files/4p_casasc_dm +M models/lnd/clm/test/system/config_files/10p_dgvmsc_o +M models/lnd/clm/test/system/config_files/4p_casasc_do +M models/lnd/clm/test/system/config_files/4p_casasc_o +M models/lnd/clm/test/system/config_files/17p_vodsrsc_o +M models/lnd/clm/test/system/config_files/17p_cnnsc_dm +M models/lnd/clm/test/system/config_files/17p_cnnsc_do +M models/lnd/clm/test/system/config_files/10p_dgvmsc_dm +M models/lnd/clm/test/system/config_files/10p_dgvmsc_do +M models/lnd/clm/test/system/config_files/17p_vodsrsc_dm +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/config_files/17p_vodsrsc_do +M models/lnd/clm/test/system/config_files/4p_vodsrsc_o +M models/lnd/clm/test/system/TSMncl_tools.sh +M models/lnd/clm/test/system/CLM_compare.sh +M models/lnd/clm/test/system/TBL.sh +M models/lnd/clm/test/system/TSM_ccsmseq.sh +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_posttag_kraken +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_breeze +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/TBR.sh +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/TER.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/mknamelist +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/TCT_ccsmseq.sh +M models/lnd/clm/test/system/TCSruncase.sh +M models/lnd/clm/test/system/TSMpergro.sh +M models/lnd/clm/test/system/nl_files/clm_per +M models/lnd/clm/test/system/nl_files/clm_urb +M models/lnd/clm/test/system/nl_files/clm_std +M models/lnd/clm/test/system/nl_files/clm_ndepdyn +M models/lnd/clm/test/system/nl_files/clm_pftdyn +M models/lnd/clm/test/system/nl_files/clm_per0 +M models/lnd/clm/test/system/TSMcnspinup.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/TSMtools.sh +M models/lnd/clm/test/system/TSMruncase.sh +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh +M models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/CLM_runcmnd.sh +M models/lnd/clm/test/system/TBLtools.sh +M models/lnd/clm/test/system/TSM.sh + +>>>>>>>>>>>>>>>>>>>>>>>>> Add organic add option to output as double precision +>>>>>>>>>>>>>>>>>>>>>>>>> be more careful with averging add error checking +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 +M models/lnd/clm/tools/mksurfdata/Makefile ----------- -Kieee for pgi +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 +M models/lnd/clm/tools/mksurfdata/Srcfiles +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist + +>>>>>>>>>>>>>>>>>>>>>>>>> 15 levels for urban +MM models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_urbanparam_file_p7.ncl +M models/lnd/clm/tools/ncl_scripts/README + +>>>>>>>>>>>>>>>>>>>>>>>>> Change for 15 levels and new variables/dims on dataset +M models/lnd/clm/tools/interpinic/interpinic.F90 +M models/lnd/clm/tools/interpinic/interpinic.runoptions +M models/lnd/clm/tools/interpinic/Srcfiles +M models/lnd/clm/tools/interpinic/Filepath +M models/lnd/clm/tools/interpinic/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> 10x15 resolution, start to resolve domain checking bug +M models/lnd/clm/tools/mkgriddata/mkgriddata.namelist +M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 +M models/lnd/clm/tools/mkgriddata/domainMod.F90 +M models/lnd/clm/tools/mkgriddata/creategridMod.F90 +M models/lnd/clm/tools/mkgriddata/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> Get grid data from grid files rather than frac files +M models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist +M models/lnd/clm/tools/mkdatadomain/addglobal.F90 +M models/lnd/clm/tools/mkdatadomain/create_domain.F90 +M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> minor changes to build, new datasets for build-namelist +M models/lnd/clm/bld/configure --- add -snicar_frc and -carbon_aero, add sglc, remove timing for cpl7 +M models/lnd/clm/bld/queryDefaultNamelist.pl --- minor change +M models/lnd/clm/bld/config_files/Makefile.in -- add HAVE_GETTIMEOFDAY for new timing, more consistent with cpl7 build +M models/lnd/clm/bld/config_files/config_definition.xml -- add snicar_frc and carbon_aero +M models/lnd/clm/bld/clm.cpl7.template -- simplify update for new scripts +M models/lnd/clm/bld/README ------------- update info. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ----- add new namelist items remove irad +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml --- new Qian datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- new defaults +M models/lnd/clm/bld/build-namelist + +>>>>>>>>>>>>>>>>>>>>>>>>> change default resolution to 4x5 remove irad +M models/lnd/clm/bld/run-pc.csh +M models/lnd/clm/bld/run-ibm.csh +M models/lnd/clm/bld/run-lightning.csh + +>>>>>>>>>>>>>>>>>>>>>>>>> New 15 layer urban single point datasets +M models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt + +>>>>>>>>>>>>>>>>>>>>>>>>> Code changes documented above +M models/lnd/clm/src/biogeochem/CASASummaryMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/biogeochem/CASAMod.F90 +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/DGVMMod.F90 +M models/lnd/clm/src/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/main/inicFileMod.F90 +M models/lnd/clm/src/main/clm_varcon.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/main/CNiniTimeVar.F90 +M models/lnd/clm/src/main/clm_comp.F90 +M models/lnd/clm/src/main/driver.F90 +M models/lnd/clm/src/main/ncdio.F90 +M models/lnd/clm/src/main/fileutils.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/pftdynMod.F90 +M models/lnd/clm/src/main/iniTimeConst.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/clm_atmlnd.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSurfAlbMod.F90 +M models/lnd/clm/src/main/clm_time_manager.F90 +M models/lnd/clm/src/main/filterMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/lnd_comp_mct.F90 +M models/lnd/clm/src/main/CASAiniTimeVarMod.F90 +M models/lnd/clm/src/main/areaMod.F90 +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/mkarbinitMod.F90 +M models/lnd/clm/src/riverroute/RtmMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/biogeophys/DriverInitMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +>>>>>>>>>>>>>>>>>>>>>>>>> update documentation +M README -------------- update information +M KnownBugs ----------- add info on new known bugs + +Summary of testing: + + bluefire: All PASS except TBL and ... + +031 smF96 TSM.sh 17p_vodsrsc_m clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ...................FAIL! rc= 10 +036 smF96 TSM.sh 17p_vodsrsc_m clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ...................FAIL! rc= 2 +013 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +015 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +019 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +020 smC61 TSM.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 -6 arb_ic ...............FAIL! rc= 10 +021 erC61 TER.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 10+38 arb_ic ............FAIL! rc= 5 +022 brC61 TBR.sh _sc_dh clm_urb^nl_urb_br 19981001:NONE:1800 1.9x2.5 gx1v5 -3+-3 arb_ic .........FAIL! rc= 5 +023 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 arb_ic ...............FAIL! rc= 4 +024 smH91 TSM.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 96 startup ..........FAIL! rc= 10 +025 erH91 TER.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 10+38 startup .......FAIL! rc= 5 +026 brH91 TBR.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 72+72 startup .......FAIL! rc= 5 +027 blH91 TBL.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 48 startup ..........FAIL! rc= 4 +029 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 13 +030 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 11 +031 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..............FAIL! rc= 7 + + lightning/pathscale: all PASS except TBL and ... + +009 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +017 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 +020 brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 +021 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................FAIL! rc= 5 +027 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 7 +028 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 6 +029 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 5 +031 smH52 TSM.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..............FAIL! rc= 10 +032 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 5 +033 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 5 +034 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..............FAIL! rc= 4 +036 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 7 +037 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 6 +001 smL51 TSM.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 96 arb_ic .........................FAIL! rc= 10 +002 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 5 +003 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 5 +004 blL51 TBL.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 48 arb_ic .........................FAIL! rc= 4 +005 sm674 TSMtools.sh mkgriddata tools__ds singlept .............................................FAIL! rc= 6 +006 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +007 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 +010 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +011 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +012 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804Q ...................................................FAIL! rc= 4 + + jaguar: ALL PASS except TBL and .... + +001 smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 10 +002 erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +003 brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +013 smE32 TSM.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 48 arb_ic .........FAIL! rc= 10 +014 erE32 TER.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 10+38 arb_ic ......FAIL! rc= 5 +015 brE32 TBR.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 24+24 arb_ic ......FAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 96 startup ..........FAIL! rc= 10 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 10+38 startup .......FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 72+72 startup .......FAIL! rc= 5 +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +030 smJ74 TSM.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic ........FAIL! rc= 10 +031 erJ74 TER.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic ......FAIL! rc= 5 +032 brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........FAIL! rc= 5 +038 smL62 TSM.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 10 +039 erL62 TER.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -5+-5 startup ...................FAIL! rc= 5 +040 brL62 TBR.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10+-10 startup .................FAIL! rc= 5 + + breeze/gale/hail/gust/ifort: All PASS except TBL and... + + bangkok: All PASS except TBL and.. + +005 smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 10 +006 erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +007 brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per 19981231:NONE:1200 4x5 gx3v5 144 startup .....................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per 19981231:NONE:1200 4x5 gx3v5 72+72 startup ...................FAIL! rc= 5 +013 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +014 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +015 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +017 smOC4 TSM.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +018 erOC4 TER.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_icFAIL! rc= 5 +019 brOC4 TBR.sh _vansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arb_iFAIL! rc= 5 +021 smNB4 TSM.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 10 +022 erNB4 TER.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 59+100 arb_icFAIL! rc= 5 +023 brNB4 TBR.sh _mexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arb_FAIL! rc= 5 +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +030 smH52 TSM.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..............FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 5 +038 smK51 TSM.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 5 +042 smL51 TSM.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 96 arb_ic .........................FAIL! rc= 10 +043 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 5 +044 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 5 +046 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 19980115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +047 smL74 TSM.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -10 arb_ic ....................FAIL! rc= 10 +048 erL74 TER.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -5+-5 arb_ic ..................FAIL! rc= 5 +049 brL74 TBR.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -10+-10 arb_ic ................FAIL! rc= 5 +051 sm654 TSMtools.sh mkgriddata tools__ds namelist .............................................FAIL! rc= 6 +052 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +053 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +057 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +Changes answers relative to baseline: Yes! Changes climate + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change (new climate) + - configuration (CPP ifdefs): All + - build-namelist command (or complete namelist): + + MSS location of control simulations used to validate new climate: + + Grass optical properties: /OLESON/csm/clm36sci16_clm3_6_11shklit0_5sfc_goa + + ccsm4_0_beta05: /CCSM/csm/b40.018 + + URL for LMWG diagnostics output used to validate new climate: + +ccsm4_0_beta05 (with clm36sci27_clm3_6_14) + +http://www.cgd.ucar.edu/cdp/mai/ccsmweb/b40.018-b40.017/setsIndex.html + +http://www.cgd.ucar.edu/tss/clm/diagnostics/clm4.0_dev/clm36sci16_clm3_6_11shklit0_5sfc_goa-clm36sci16_clm3_6_11shklit0_5sfca/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_6_14 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Oct 10 11:32:57 MDT 2008 +One-line Summary: Fix some global urban issues, fix pftdyn, really get compile-only option working in testing + +Purpose of changes: Fix column and pft averaging for urban (crtical for coupling to cam) (from Keith) + Fix Qanth (was wasteheat previously) (from Keith) + Fix so that pftdyn works (fix from Sam) + Really get the compile-only option working in test-suite + (so that doesn't re-compile, but does re-run, when sent again) + +Bugs fixed (include bugzilla ID): 826 (pftdyn) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), 830 (missing C-LAMP mods) + 680 (t0 precip diff for seq-ccsm), 789 (pt sims slower than offline) + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 833 (bug with cam in ccsm4_0_alpha37), 722 (threading slow) + 832 (problem with cice bn in ccsm4_0_alpha37) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson, slevis (Sam provided pftdyn fix, and Keith provided urban fixes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts and drv + + scripts to scripts4_081009 + drv to drvseq2_0_33 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Change so that pftdyn will work, do urban averaging, and fix Qanth + M models/lnd/clm/src/main/clm_atmlnd.F90 -------------- Make averaging take into account urban (critical for global urban modeling) + M models/lnd/clm/src/main/histFldsMod.F90 ------------- Add urban scaling, fix Qanth + M models/lnd/clm/src/main/filterMod.F90 --------------- Change urban filter to include pftwgt>0 + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 -- Change filter_vegsol to include pftwgt>0 +>>>>>>>>>>> Fix so that compile-only option leaves compiled program there, doesn't recompile, but does rerun + M models/lnd/clm/test/system/TCB.sh + M models/lnd/clm/test/system/TSMncl_tools.sh + M models/lnd/clm/test/system/TBL.sh + M models/lnd/clm/test/system/TSM_ccsmseq.sh + M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh + M models/lnd/clm/test/system/TBR.sh + M models/lnd/clm/test/system/TCBtools.sh + M models/lnd/clm/test/system/test_driver.sh + M models/lnd/clm/test/system/TER.sh + M models/lnd/clm/test/system/TCT_ccsmseq.sh + M models/lnd/clm/test/system/TSMpergro.sh + M models/lnd/clm/test/system/TSMcnspinup.sh + M models/lnd/clm/test/system/TSMtools.sh + M models/lnd/clm/test/system/TSMruncase.sh + M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh + M models/lnd/clm/test/system/CLM_runcmnd.sh + M models/lnd/clm/test/system/TSM.sh + +Summary of testing: + + bluefire: All PASS except +071 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguar: All PASS + bangkok/lf95: All PASS except +028 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 5 +054 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 6 +055 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +pftdyn TBL test fails, because pftdyn did not work in previous tag. +cam and scam tests fail because of bugs 832 and 833 in ccsm4_0_alpha37 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_13 + +Changes answers relative to baseline: No -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_13 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Wed Oct 1 13:33:36 MDT 2008 +One-line Summary: Update to new version of cpl7 scripts and build, update externals for versions needed for clm36sci branch, add new CASA tests + +Purpose of changes: Update to new version of cpl7 scripts and build. + Update externals for versions needed on clm36sci branch. + Add new CASA tests. + Add $CLM_ACCOUNT as option to test_driver.sh + Add single point capability to cpl7 scripts. + Add CLM_DEMAND, CLM_BLD_NL_OPTIONS as options to cpl7 scripts. + Some code changes from Keith Oleson to fix a CASA startup problem. + +Code changes from Keith Oleson + +1. Volumetric soil water check in BiogeophysRestMod changed so that it accounts for ponded ice/water +that may be present in surface layer. If volumetric soil water is above saturation, h2osoi_liq +and h2osoi_ice are reduced according to their proportion of total water/ice. Both h2osoi_liq +and h2osoi_ice are limited to be no lower than watmin (currently 0.01_r8 mm). All this done for +soil points only. + +2. In SoilHydrologyMod, variable su changed to: + + su = max(0._r8,(s1-fcov(c)) / max(0.01_r8,1._r8-fcov(c)) + +to account for the fact that fcov could be one and hence divide by zero could have occurred. +Also, the factor "1._r8" multiplying fcov in the numerator was removed. + +3. watmin made a global parameter available from clm_varcon + +Bugs fixed (include bugzilla ID): 805 (too much output in build-streams), 801 (G95 in csm_Share), + 786 (dshr_map bug), 834 (CASA startup bug), + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 826 (pftdyn), 833 (bug with cam in ccsm4_0_alpha37) + 832 (problem with cice bn in ccsm4_0_alpha37) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Update to new ccsm4_0_alpha37 scripts + + New options in cpl7 scripts: CLM_DEMAND, CLM_BLD_NL_OPTIONS + + CLM_DEMAND: List of output variables to require be set in namelist + For example, set to "furbinp" to use urban grid. + CLM_BLD_NL_OPTIONS: List of options to pass to clm build-namelist. + + New grid in cpl7 scripts: pt1_pt1 (also set CLM_PT1_NAME) for single point sims + + Add ability to set "none" in clm build-namelist -clm_dmand option. + +Quickstart to new cpl7 scripts... + + New cpl7 namelists now do two things for you. + - Add a ton of error checking at each step -- so it won't let you do something you aren't allowed to + - Only show you the variables that you could actually set in your case. + + To accomplish this we use XML files rather than cshell env files. But, the + operation sequence is similar with options only changed slightly. + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g15 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v5 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) + + Note that the -skip_rundb option to create_newcase no longer needs the argument of "NONE". + Syntax of create_tests changed to only one form. + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik, oleson and dlawren (source code changes) + +List any svn externals directories updated (csm_share, mct, etc.): drv, csm_share, datm7, and scripts + + csm_share, datm7 and scripts include changes required for the clm36sci branch. + + scripts to scripts4_080930 + drv to drvseq2_0_32 + datm7 to datm7_080926 + csm_share to share3_080929 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Add $CLM_ACCOUNT env var, change tests around, update to ccsm4_0_alpha37 + add some more CASA tests. +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_posttag_kraken +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/test_driver.sh ------------------ Add $CLM_ACCOUNT env var + update to ccsm4_0_alpha37 +M models/lnd/clm/test/system/input_tests_master -------------- Add CASA 1.9x2.5 tests +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh ----------- Separate call to cice bn +M models/lnd/clm/test/system/TCT_ccsmseq.sh +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh ----------- Need to set threads/tasks +M models/lnd/clm/test/system/TSM.sh -------------------------- Remove old namelist name + +>>>>>>>>>>>>>> Update for new scripts +M models/lnd/clm/bld/clm.cpl7.template ----------------------- Straighten out clm_demand + Add new env vars. Remove prestaging. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml -- Update to alpha37 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml- Add file for clm36sci branch +M models/lnd/clm/bld/build-namelist -------------------------- Allow clm_demand to include none. + +>>>>>>>>>>>>>> These are Keith's changes to fix bug 834. They do make it possible for + answers to change, but in most cases they don't. It allows code to + startup correctly for situations it might fail in, and sets a mininum + value in SoilHydrologyMod to guard against divide by zero. This would + change answers when amount of ice -- fcov > 0.99 -- which would be rare. +M models/lnd/clm/src/main/clm_varcon.F90 +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 + +Summary of testing: + + bluefire: All PASS except +042 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +043 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +044 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +045 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +P +046 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +079 blL61 TBL.sh _sc_h clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +083 blL62 TBL.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +107 brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........FAIL! rc= 11 +127 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + kraken: All PASS except all TER and TBR tests fail, because of a script problem and ends early + lightning/pathscale: All PASS except +022 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +023 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +024 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +025 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +026 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +050 erP11 TSM_ccsmseq.sh ERS T31_g35 ICN4804 ....................................................FAIL! rc= 5 + bangkok/lf95: All PASS except +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +028 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +054 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 6 +055 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +pftdyn tests fail because of previous problem (bug 826). ext_ccsmseq_ tests fail +because of problem with ccsm4_0_alpha37 (bug 833). + +CLM tag used for the baseline comparison tests if applicable: clm3_6_12 + +Changes answers relative to baseline: Only for some cases, see tests 079 and 083 on +bluefire above + +=============================================================== +=============================================================== +Tag name: clm3_6_12 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Sun Sep 21 10:04:22 MDT 2008 +One-line Summary: Fix restarts for urban, add capability to do global urban experiments, add new forcing height changes, remove cpl6 + +Purpose of changes: Fix restarts for urban model as well as adding capability to do global urban experiments. + It also adds the new forcing height changes into the trunk. + And we remove all the cpl6 #ifdef's, source codes, and associated scripts and script options. + Also fix some memory leaks found in MCT. + Add testing for kraken. + Fix branch tests so they change the start_ymd. + Add some more tests for CASA. + Set minimum urban percentage to use from 5% to 1%. + Completely remove COUP_CAM #ifdef as NOT needed anymore. + +Bugs fixed (include bugzilla ID): Fix urban model restarts, remove cpl6 (755), MCT memory leak (825) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams), 826 (pftdyn) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Add nofire option to configure, remove cpl6 option + +Describe any changes made to the namelist: Add new urban oriented output history variables: + + _U, and _R (Urban and Rural) for: + QRUNOFF, TREFMXAV, TREFMNAV, TSA, SoilAlpha, TG, Q2M, TREFAV + URBAN_AC, and URBAN_HEAT, Qanth, SWup, LWup, QTau, HWR, Wind, Qair + and ZBOT_PFT for forcing height + + Change build-namelist so that to use a dataset with urban points on it you + need to use "-clm_demand furbinp". This way it will not only select the appropriate + furbinp dataset -- but it will select the correct surface dataset that includes + urban data on it. Such as for 10x15 and 1.9x2.5 surface datasets where there is + now an urban version as well as the standard version. + + +List any changes to the defaults for the boundary datasets: Add urbanc point dataset, + and 1.9x2.5 and 10x15 urban datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self (some changes by Keith Oleson) + +List any svn externals directories updated (csm_share, mct, etc.): drv, datm7, mct + + drv to drvseq3_0_26 + datm7 to datm7_080907 + mct to MCT2_5_1_080522 + +List all files eliminated: Remove cpl6 files + +R models/lnd/clm/test/system/TCText_ccsmcon.sh +R models/lnd/clm/test/system/TSMext_ccsmcon.sh +R models/lnd/clm/bld/clm.cpl6.template +R models/lnd/clm/src/main/program_csm.F90 +R models/lnd/clm/src/main/clm_csmMod.F90 + +List all files added and what they do: + +A models/lnd/clm/test/system/config_files/4p_casasc_ds ----- Add serial test for CASA +A models/lnd/clm/test/system/nl_files/clm_urb -------------- For standard urban tests. +A models/lnd/clm/test/system/nl_files/nl_urb_br ------------ Urban namelist for branch tests. +A models/lnd/clm/test/system/tests_posttag_kraken ---------- Add tests for kraken +A models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_fv1_9x2_5_urbanparam_file_p7.ncl -- script to create furbinp dataset +A models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban --- Example namelist to make a global urban surface dataset +A models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt --- Add urban intercomparison test case + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Remove cpl6 option, add nofire, make urban point datasets consistent with global Feddema datasets +M models/lnd/clm/bld/configure -------------------------------- Remove cpl6 option, add nofire option +M models/lnd/clm/bld/queryDefaultNamelist.pl ------------------ Add -filenameonly option +M models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +M models/lnd/clm/bld/build-namelist --------------------------- Have urban surface datasets dependent on furbinp + +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_urban +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_pretag_bluevista +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/nl_files/clm_urb1pt +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/CLM_runcmnd.sh +M models/lnd/clm/test/system/TBR.sh ---------------------- Change so start_ymd of branch runs is initial-length after original start-date +M models/lnd/clm/test/system/test_driver.sh -------------- Reduce from premium to regular, add kraken +M models/lnd/clm/test/system/mknamelist ------------------ Set hist_* values for second file +M models/lnd/clm/test/system/nl_files/nl_crcrop ---------- Set hist_dens for second file +M models/lnd/clm/test/system/nl_files/nl_urb ------------- Set hist_dens for second file, add more fields to list +M models/lnd/clm/test/system/nl_files/nl_std ------------- Set hist_dens for second file +M models/lnd/clm/test/system/nl_files/nl_lfiles ---------- Set hist_dens for second file +M models/lnd/clm/test/system/input_tests_master ---------- Change TBR tests, add more CASA tests + +M models/lnd/clm/tools/mksurfdata/mkurban.F90 ------------ Change threshold to ignore urban from 5% to 1% + +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 -- For DUST fix forcing height appropriately +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Don't set pointers if no urban points + +>>>>>>>>>>>>>>>> Remove COUP_CSM #ifdefs + +M models/lnd/clm/src/main/driver.F90 --------- Also make sure urban calls have urban points +M models/lnd/clm/src/main/accFldsMod.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/initializeMod.F90 +M models/lnd/clm/src/main/iniTimeConst.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSurfAlbMod.F90 +M models/lnd/clm/src/main/clm_time_manager.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/main/initGridCellsMod.F90 +M models/lnd/clm/src/main/spmdMod.F90 +M models/lnd/clm/src/main/surfrdMod.F90 ------------- Also remove COUP_CAM #ifdef +M models/lnd/clm/src/main/do_close_dispose.F90 +M models/lnd/clm/src/main/clmtype.F90 --------------- Also forcing height changes +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/mkarbinitMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ------ Also forcing height changes +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 ------ Also forcing height changes +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --------- Fix restarts for urban +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluefire: All PASS except TBL and +042 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +043 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +044 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +046 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 + jaguar: All PASS except TBL and +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 + kraken: All PASS except TBL and TER and TBR (this may be a setup problem) and +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 + lightning/pathscale: All PASS except TBL and + bangkok/lf95: All PASS except TBL and +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 + kraken: All PASS except TBL and +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ........... +.......FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ......... +.......FAIL! rc= 13 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ......... +.......FAIL! rc= 5 + breeze/gale/hail/gust/ifort: All PASS + + pftdyn tests fail on all platforms -- due to a previous problem that was not +detected because of a bug in the test. + TER and TBR tests fail on kraken -- this may be a setup problem. Possibily a problem +with newcprnc? I'm not sure but since it passes elsewhere, I don't think it's a problem +in the code. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_11 + +Changes answers relative to baseline: Forcing height changes cause answers to change + +=============================================================== +=============================================================== +Tag name: clm3_6_11 +Originator(s): dlawren (Lawrence David 1384 CGD) +Date: Tue Aug 26 21:53:22 MDT 2008 +One-line Summary: Ice stream for snow capped regions + +Purpose of changes: Split liquid and ice runoff streams in snow capped situations + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Update version of pft-physiology file used + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): scripts and csm_share + + scripts to scripts4_080731 + csm_share to share3_080801 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Use the same pft-phisiology file for every option +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/pft2colMod.F90 +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/models/lnd/clm/src/main/clm_time_manager.F90 -- Hack for fake Gregorian calendar +M models/lnd/clm/src/riverroute/RtmMod.F90 --------------- two runoff sreams, liq and ice (qflx_snwcp_ice) +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- dew snwcp +M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 -------- snow and rain split for snwcp +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ----- liq snwcp +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- qrgwl minus snwcp_ice +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- lake snwcp +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - initialize snwcp fields to zero for lakes +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ revised balance check + >>>>>>>>>> Get scam test working +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh +M models/lnd/clm/test/system/nl_files/scam +M models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh +M models/lnd/clm/test/system/config_files/scam_ds +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/nl_files/scam +M models/lnd/clm/test/system/nl_files/scam_prep + +Summary of testing: + + bluefire: All PASS except TBL tests + lightning/pathscale: All PASS except TBL tests + bangkok/lf95: All PASS except TBL tests + breeze/gale/hail/gust/ifort: All PASS + + Didn't test on jaguar -- since it was down. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_10 + +Changes answers relative to baseline: Yes -- pft-physiology file, RTM changes + +=============================================================== +=============================================================== +Tag name: clm3_6_10 +Originator(s): tcraig +Date: Fri Aug 15 09:05:50 MDT 2008 +One-line Summary: extend rtm tracer, ascale for tri-grids, AIX O3 to O2 + +Purpose of changes: extend rtm to handle multiple tracers. added + second tracer to rtm associated with frozen water. first tracer + is now liquid water. both are passed to cpl7 now via the roff and + ioff fields. + + add ascale field to land model in support of model running on it's + own grid. ascale is a field provided by the coupler to the land model + via the driver "domain" datatype. it is needed to correct fluxes + in the land model for conservation. it is being applied to the + land to rtm fluxes and will need to be fully validated in a ccsm4 + tri-grid configuration which is still under development. + + change AIX optimization from -O3 to -O2 at request of LMWG. not + needed for these changes in particular. see bug #812. + +Bugs fixed (include bugzilla ID): 812 + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: + change AIX -O3 to -O2 at request of LMWG, incorporated + into tag for convenience. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + added extra rtm tracer, should have no noticable impact on timing + or memory. + +Code reviewed by: tcraig + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M bld/config_files/Makefile.in +M src/main/clmtypeInitMod.F90 +M src/main/pft2colMod.F90 +M src/main/clm_atmlnd.F90 +M src/main/clm_csmMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/domainMod.F90 +M src/main/clmtype.F90 +M src/main/histFldsMod.F90 +M src/riverroute/RtmMod.F90 +M src/riverroute/RunoffMod.F90 +M src/biogeophys/Biogeophysics2Mod.F90 +M src/biogeophys/Hydrology1Mod.F90 +M src/biogeophys/SoilHydrologyMod.F90 + +- change AIX -O3 to -O2 +- add ascale implementation. add asca field to domain datatype, set + for atm and lnd domains. default is 1.0. received from coupler + in first run call. reset in lnd only if atm and lnd domain are same. +- split qflx_snowcap term into qflx_snowcap_rain and qflx_snowcap_snow. + snowcap_rain term is same implementation as old snowcap term. + snowcap_snow is set to zero now. potential future mods are noted + and commented out, search for tcx_snowcap_new in src code. +- implement multiple tracers extensibility in rtm. add frozen + runoff tracer in addition to liquid runoff tracer. +- set roff and ioff runoff terms in lnd_comp_mct to send back to coupler +- update rtm restart file, support backward compatability by setting + runoff tracers to zero if the new fields are not on the restart file. +- update history file for new rtm tracers. requires individual fields + to be copied from tracer arrays to single field arrays for history + interface. + +Summary of testing: + + bluefire: all PASS except + 073 blL61 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup + 077 blL62 TBL.sh _sc_m clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup + 085 blL74 TBL.sh _sc_s clm_std 19980101:6-HOURLY:1800 1x1_brazil navy -10 arb_ic + 087 blL78 TBL.sh _sc_s clm_std 19971231:NONE:1800 1x1_brazil navy -10 arb_ic + the above 4 bl cases FAIL due to -O3 to -O2 optimzation change + 113 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 + sm984 fails due to inconsistent driver in test + jaguar: all PASS except + 038 erP65 TSM_ccsmseq.sh ERS f19_g13 I + 039 erP15 TSM_ccsmseq.sh ERS T31_g35 ICN + 040 erP66 TSM_ccsmseq.sh ERH f19_g13 I + 041 erP16 TSM_ccsmseq.sh ERH T31_g35 ICN + 042 erP67 TSM_ccsmseq.sh ERB f19_g13 I + 043 erP17 TSM_ccsmseq.sh ERB T31_g35 ICN + erP* tests fail due to script error + bangkok/lf95: all PASS except + 046 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 + 047 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 + sm952 and sm984 fail due to inconsistent driver in test + breeze/gale/hail/gust/ifort: all PASS + + bluefire cam pretag: all PASS except previously documented failures + bluefire ccsm4 pretag: all PASS except previously documented failures + compare with alpha33 FAILS since rtm not bit-for-bit in some tests. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_09 + +Changes answers relative to baseline: + change of AIX -O3 to -O2 changes some results by what ap.........FAIL! rc= 7 +061 smK17 TSM.sh 10p_dgvmsc_h clm_std 19981231:NONE:1800 48x96 gx3v5 -213 arb_ic ................FAIL! rc= 10 +065 blK71 TBL.sh 10p_dgvmsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 +088 smL83 TSM.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 10 +089 erL83 TER.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -5+-5 arb_ic ................FAIL! rc= 5 +090 brL83 TBR.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10+-10 arb_ic ..............FAIL! rc= 6 +091 blL83 TBL.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 4 +095 bl711 TBLtools.sh mksurfdata tools__ds namelist .............................................FAIL! rc= 7 +097 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 + lightning/pathscale: +------>>>>>>> Bug 694 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 11 +025 smE13 TSM.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 10 +026 erE13 TER.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ............FAIL! rc= 5 +027 brE13 TBR.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ............FAIL! rc= 5 +029 smE16 TSM.sh 4p_vodsrsc_o clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ................FAIL! rc= 10 + lightning/ifort: +004 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +------>>>>>>> Bug 694 +010 sm111 TSM.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 10 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 5 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 5 +013 bl111 TBL.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 4 +014 sm114 TSM.sh 4p_vodsr_h clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 10 +016 erE11 TER.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ............FAIL! rc= 13 +017 brE11 TBR.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ............FAIL! rc= 11 +018 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 + tempest: +009 smB11 TSMruncase.sh .........................................................................FAIL! rc= 4 +------>>>>>>> Bug 694 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 11 +036 erE31 TER.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 10+38 arb_ic ....FAIL! rc= 7 +037 brE31 TBR.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 24+24 arb_ic ....FAIL! rc= 6 +045 smH01 TSM.sh 17p_cnnsc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5@2000 48 startup FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_5_19 + +Changes answers relative to baseline: Bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_19 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Mar 6 14:52:17 MST 2008 +One-line Summary: Change directory structure to mimic CCSM, fix so no NaNS on BGC interpinic output, new half degree CN clmi dataset + +Purpose of changes: move cdir1_clm3_5_18 to trunk. Get directory structure to look like CCSM. + + models ------------------------------ Model source code for each component + models/lnd + models/lnd/clm ---------------------- CLM source code, build-scripts, tools, and testing + models/lnd/clm/test/system ---------- CLM test scripts + models/lnd/clm/tools ---------------- CLM tools + models/lnd/clm/tools/mksurfdata + models/lnd/clm/tools/ncl_scripts + models/lnd/clm/tools/interpinic + models/lnd/clm/tools/mkgriddata + models/lnd/clm/tools/mkdatadomain + models/lnd/clm/tools/cprnc + models/lnd/clm/bld ------------------ CLM build scripts + models/lnd/clm/bld/run-ibm.csh ------ sample CLM run script for the IBM + models/lnd/clm/bld/urban_input + models/lnd/clm/bld/usr.src + models/lnd/clm/bld/perl5lib + models/lnd/clm/doc ------------------ CLM documentation + models/lnd/clm/doc/UsersGuide + models/lnd/clm/doc/CodeReference + models/lnd/clm/doc/Dev + models/lnd/clm/src ------------------ CLM specific source code directories + models/lnd/clm/src/biogeochem + models/lnd/clm/src/main + models/lnd/clm/src/riverroute + models/lnd/clm/src/biogeophys + models/ocn/socn --------------------- stub ocean model + models/ice + models/ice/sice --------------------- stub sea-ice model + models/atm + models/atm/datm7 -------------------- data atmosphere model + models/atm/datm7/bld + models/utils ------------------------ Utiltiies + models/utils/esmf_wrf_timemgr ------- ESMF WRF time-manager API + models/utils/timing ----------------- timing utiltities + models/utils/mct -------------------- Model Coupling Toolkit + models/utils/pio -------------------- Parallel I/O + models/drv -------------------------- Sequential CCSM source code + models/drv/seq_mct + models/drv/seq_mct/driver + models/csm_share -------------------- CCSM share code (shared between CCSM component models) + scripts ----------------------------- CCSM build, run and testing scripts + scripts/README ---------------------- ReadMe file on CCSM scripts + doc --------------------------------- CCSM documentation (currently out of date) + + Changes so that interpinic doesn't output NaNS on AIX compiler for CN configuration. + + QUICKSTART: using the new CPL7 scripts: + + cd scripts + ./create_newcase # get help on how to run create_newcase + ./create_newcase -case testI -mach blueice -res f19_g15 -compset I # create new "I" case for blueice at 1.9x2.5_gx1v5 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + configure -mach blueice # create scripts + testI.build # build model and create namelists + bsub < testI.run # submit script + # (NOTE: edit env_run to set RESUBMIT to number of times to automatically resubmit) + +Bugs fixed (include bugzilla ID): 681 (archiving/resub), 696 (save datm7 files) , 707 (xlf90 bug with CAM) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), 680 (t0 precip diff for seq-ccsm), + 694 (restarts for offline) , 697 (version etc.), 698 (cprnc bug), 701 (svn keyword), + 708, (xlf bug on bluevista) + http://bugs.cgd.ucar.edu/ + + New bugs found: 708 -- bug with new xlf90 compiler on bluevista for CASA + 710 -- Some variables are NaNS on clm.i output from CN configuration + + Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Changed to work with new directory structure + (also works with any wildcard in clm "models/lnd/clm*" directory name) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Update half degree CN clmi file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): drv (also add in CCSM doc and scripts directories as externals) + doc_060127, seqmct45_scripts_080108, drvseq2_0_10 + +List all files eliminated: Files moved around extensively + +List all files added and what they do: Files moved around extensively + +List all existing files that have been modified, and describe the changes: Files moved around extensively + + models/lnd/clm/bld/DefaultCLM_INPARM_Namelist.xml --- change CN half degree clmi file + models/lnd/clm/bld/clm.cpl6.template ---------------- change assumed paths (use wildcard for models/lnd/clm*) + models/lnd/clm/bld/clm.cpl7.template ---------------- change assumed paths (use wildcard for models/lnd/clm*) + models/lnd/clm/bld/configure ------------------------ get to work in new directory structure + models/lnd/clm/bld/run-ibm.csh ---------------------- fix archiving, and resubmit + models/lnd/clm/bld/run-lightning.csh ---------------- fix archiving, and resubmit + models/lnd/clm/bld/run-pc.csh ----------------------- fix archiving, and resubmit + models/lnd/clm/src/main/clm_time_manager.F90 -------- make save statements explicit + models/lnd/clm/tools/*/Makefile --------------------- change so CLM_ROOT is top of directory structure with + models/lnd/clm* assumed below + models/lnd/clm/tools/interpinic/interpinic.F90 ------ get numrad dimsize, on AIX check for NaNS and convert to spval, + if weights == 0 set values to spval + models/lnd/clm/test/system/test_driver.sh ----------- new directory structure, update to ccsm3_9_beta03 and ccsm4_0_alpha25 + models/lnd/clm/test/system/TBL.sh ------------------- new directory structure + models/lnd/clm/test/system/TBLtools.sh -------------- new directory structure + models/lnd/clm/test/system/TSMncl_tools.sh ---------- new directory structure + models/lnd/clm/test/system/TBR.sh ------------------- new directory structure + models/lnd/clm/test/system/TER.sh ------------------- new directory structure + models/lnd/clm/test/system/TSM.sh ------------------- new directory structure + models/lnd/clm/test/system/TSMpergro.sh ------------- new directory structure + models/lnd/clm/test/system/TSMtools.sh -------------- new directory structure + models/lnd/clm/test/system/TSMcnspinup.sh ----------- new directory structure + models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh ---- new directory structure + models/lnd/clm/test/system/TCBtools.sh -------------- new directory structure + models/lnd/clm/test/system/TCText_ccsmcon.sh -------- new directory structure, add blueice + +Summary of testing: + + bluevista: All PASS except +052 smJ11 TSM.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 +053 erJ11 TER.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 10+38 arb_ic ...............FAIL! rc= 5 +054 brJ11 TBR.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 24+24 arb_ic ...............FAIL! rc= 5 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + CAM tests: All PASS except: +060 sm711 TSM.sh h5x8adm adia 9s ..................................FAIL! rc= 6 + blueice: + CPL7 test_scripts: ERS.f19_g15.I.blueice, ERB.f19_g15.I.blueice, ERS.f45_g35.I.blueice +FAIL ERB.f19_g15.I.blueice + CPL6 test_scripts: PASS ERT_OS.f19_g15.I.blueice PASS ERH_OS.T31_g35.ICN.blueice + jaguarcnl: All PASS + lightning: All PASS except +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 + bangkok/lf95: All PASS except +18 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + tempest: All PASS + +CLM tag used for the baseline comparison tests if applicable: ccsm4_alpha25 with clm3_5_18 in place of default clm + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_18 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 21 22:57:39 MST 2008 +One-line Summary: Update to latest seq-ccsm4.alpha tag + +Purpose of changes: Get clm trunk to work with latest ccsm4.alpha24 tag + +Bugs fixed (include bugzilla ID): 678 (get clm to work with latest cpl7) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, + 681, 694, 696, 697, 698, 701, 702, 707, 708 + http://bugs.cgd.ucar.edu/ + + New bugs: 697-- username,version,hostname NOT in seq-driver namelists + 707-- bug on new xlf90 compiler on bluevista for running with CAM + 708-- bug on new xlf90 compiler on bluevista for running with CASA + +Describe any changes made to build system: minor change in configure script + name of mode ext_cam changed to ext_ccsm_seq in configure script + +Describe any changes made to the namelist: Sequential driver namelists change + +ccsm_inparm namelist changes to seq_infodata_inparm + (remove restart_override, username, version, hostname) +timemgr_inparm namelist changes to seq_timemgr_inparm + (remove restart_overrideTMG, stop_final_ymd [use stop_ymd instead] ) + +List any changes to the defaults for the boundary datasets: + Add 2.65x3.33 datasets, newer 1x1_brazil domain file + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens (original version on seq branch) + +List any svn externals directories updated (csm_share, mct, etc.): + +drv, datm7, sice, socn, csm_share_, and mct + +src/drv drvseq2_0_07 +src/datm7 drva_datm7_070824_tags/drva07_datm7_071129 +src/sice stubs1_0_7 +src/socn stubs1_0_7 +src/csm_share drva_share3_070903_tags/loga25_share3_071107 +src/utils/mct seqa_MCT2 _3_0_070524_tags/seqa07_MCT2_4_2_071026 + +List all files eliminated: None + +List all files added and what they do: + +A + bld/ExtSeqCCSMDrvInNamelistsDescriptions.xml -- for moving drv_in namelist items +A + bld/clm.cpl7.template ------------------------- for running with cpl7 + +List all existing files that have been modified, and describe the changes: + +------------- Get external CAM tests working, and with changes to seq-ccsm +M test/system/TSMext_ccsmseq_cam.sh +M test/system/test_driver.sh +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/nl_files/scam +M test/system/nl_files/scam_prep +M test/system/nl_files/ext_ccsm_seq_cam +M test/system/TSM.sh + +------------- Now need clm_varpar.F90 in tools +M tools/mksurfdata/Srcfiles +M tools/mkgriddata/Srcfiles + +------------- Add ext_ccsm_seq, add 2.65x3.33 datasets, change for new seq-ccsm namelists + switch 1x1_brazil domain file +M bld/configure +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/run-ibm.csh +M bld/clm_inparm.pm +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/sample.seqccsm.namelists +M bld/run-pc.csh +M bld/timemgr_inparm.pm +M bld/DefaultCCSM_INPARM_Namelist.xml +M bld/drv_in.pm +M bld/run-lightning.csh +M bld/mkSrcfiles +M bld/SeqCCSM_namelist.pm +M bld/ccsm_inparm.pm +M bld/SeqCCSMDrvInNamelistsDescriptions.xml +M bld/DefaultDATM_DSHR_NML_Namelist.xml + +------------- Don't allow seq_ccsm datatypes to go below lnd_comp_mct, fix scam +M src/main/clm_comp.F90 ------------- Remove SyncClock, CCSMInit +M src/main/driver.F90 --------------- Remove SyncClock, CCSMInit +M src/main/decompInitMod.F90 -------- Use endrun rather than shr_sys_abort +M src/main/ncdio.F90 ---------------- fixes for scam +M src/main/atmdrvMod.F90 ------------ remove unneeded printing +M src/main/clmtypeInitMod.F90 ------- explicit use only's +M src/main/initializeMod.F90 -------- remove CCSMInit and EClock +M src/main/controlMod.F90 ----------- move initialization to timemgr/clm_varctl + set methods +M src/main/clm_time_manager.F90 ----- Make namelist input private, add set method +M src/main/clm_varctl.F90 ----------- Add set and initialization methods +M src/main/clm_varorb.F90 ----------- Remove values not needed +M src/main/lnd_comp_mct.F90 --------- Update to new structures/logic + On time-step 0 also advance to time-step 1 +M src/main/program_off.F90 ---------- Move orbital info/dtime to this level +M src/main/spmdMod.F90 -------------- Change print format +M src/biogeophys/UrbanInputMod.F90 -- Initialize filename + +Summary of testing: + + bluevista: +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +008 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +011 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 5 +014 blG71 TBL.sh 17p_sc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........FAIL! rc= 5 +016 blH71 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ......FAIL! rc= 5 +021 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +026 blF27 TBL.sh 17p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..............FAIL! rc= 5 +031 blE31 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic +.......FAIL! rc= 5 +034 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +036 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +040 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +046 blH11 TBL.sh 17p_cnnsc_dh clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 5 +050 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 5 +052 smJ11 TSM.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 <<<< bug 708 +053 erJ11 TER.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 10+38 arb_ic ...............FAIL! rc= 5 <<<< bug 708 +054 brJ11 TBR.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 24+24 arb_ic ...............FAIL! rc= 5 <<<< bug 708 +055 blJ11 TBL.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 +059 blK11 TBL.sh 10p_dgvmsc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 5 +064 blK71 TBL.sh 10p_dgvmsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 +068 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 +072 blL63 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup ..................FAIL! rc= 5 +076 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 5 +080 blL52 TBL.sh _sc_ds clm_std 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ......................FAIL! rc= 5 +084 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 5 +089 blL83 TBL.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 5 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 <<<<< bug 707 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 <<<<<< bug 707 + CAM tests all PASS except +060 sm711 TSM.sh h5x8adm adia 9s ..................................FAIL! rc= 6 +062 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 5 + +First was a Build-namelist error, next was core-dump. + + tempest: +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +007 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 5 +010 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +014 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +016 blG71 TBL.sh 17p_sc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........FAIL! rc= 5 +018 blH71 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ......FAIL! rc= 5 + lightning/pathscale: +004 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +011 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +015 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< bug 694 +026 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +031 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 5 +035 blK51 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +039 blL51 TBL.sh _sc_dh clm_std 19980115:MONTHLY:1800 10x15 USGS 48 arb_ic ......................FAIL! rc= 5 +043 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 +047 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 5 + jaguarcnl: +008 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 7 +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 7 +024 blH12 TBL.sh 17p_cnnsc_dm clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 7 +028 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 7 + bangkok/lf95: +004 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 7 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 7 +011 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 7 +014 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +016 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 7 +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<<<< 694 +025 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 7 +030 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 7 +034 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 7 +038 blK51 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 7 +042 blL51 TBL.sh _sc_dh clm_std 19980115:MONTHLY:1800 10x15 USGS 48 arb_ic ......................FAIL! rc= 7 +047 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +TBL _sc tests fail because of addition of area-corrected fluxes and addition of running + time-step 1 when time-step 0 is done on initialization. +er111/112 tests fail due to previous bug 694 +sm921/982 test fail on bluevista due to new bug 707 on (compiler bug on bluevista) + +CLM tag used for the baseline comparison tests if applicable: clm3_5_17 + +Changes answers relative to baseline: Yes -- greater than roundoff + + Summarize any changes to answers, i.e., + - what code configurations: Any mode with sequential-CCSM + - what platforms/compilers: ALL + - nature of change: larger than roundoff + +Fluxes in driver are corrected by ratio's of area's from different components. +Also at time-step 0 you also run time-step 1 -- rather than just time-step 0. + +=============================================================== +=============================================================== +Tag name: clm3_5_17 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Wed Feb 6 10:10:17 MST 2008 +One-line Summary: Merge Tony Craig's FMI branch fmi12_clm3_5_16 to the clm trunk + +Purpose of changes: Reducing the debug level in some initialization routines, fixing a few diagnostics, + updating timers, improve the write_diagnostic performance, update of rtm init to improve scaling and performance. + +Bugs fixed (include bugzilla ID): 597 + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, 681, 694, 696, 698, 701, 702 + http://bugs.cgd.ucar.edu/ + + New bugs found: datm7 restart files NOT being archived (696), cprnc found to have problems (698), + version autoinsertion in tools (701), test_driver times out on jaguar (702) + +Describe any changes made to build system: Add BUILDPIO CPP variable + +Describe any changes made to the namelist: Add new namelist variables dealing with PIO (see below) + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik,tcraig + +List any svn externals directories updated (csm_share, mct, etc.): pio to pio11_prod + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M doc/UpDateChangeLog.pl ----------------- Tweak update of date to work correctly for both files +M bld/run-frost.csh ---------------------- Tony gets working, add PIO build as commented out, turn querys off, put files + in explicitly, tests new ncd_ options +M src/biogeochem/STATICEcosysDynMod.F90 -- Add timers +M src/main/clm_comp.F90 ------------------ Add timers +M src/main/driver.F90 -------------------- Add timers, add barrier for diagnostics write, change send/recv into reduce (leave option for old code) +M src/main/decompInitMod.F90 ------------- Reduce debug level for initialization +M src/main/initializeMod.F90 ------------- Add timers +M src/main/histFileMod.F90 --------------- PIO option +M src/main/ncdio.F90 --------------------- Work for PIO, new options +M src/main/gen_ncdio_global_subs.csh ----- Work for PIO, new options +M src/main/gen_ncdio_local_subs.csh ------ Work for PIO, new options +M src/main/controlMod.F90 ---------------- Add new namelist items + +History experimental options (mostly for PIO which isn't fully implemented yet) + + o hist_pioflag = logical true if want to turn on hist with pio [.FALSE., .TRUE.] + o ncd_lowmem2d = logical true if want to turn on low memory 2d writes in clm hist [.TRUE., .FALSE.] + o ncd_pio_def = logical true if want default pio use setting [.FALSE., .TRUE.] + o ncd_pio_UseRearranger = logical true if want to use MCT as Rearranger [.TRUE., .FALSE.] + o ncd_pio_UseBoxRearr = logical true if want to use box as Rearranger [.FALSE., .TRUE.] + o ncd_pio_SerialCDF = logical true if want to write with pio serial netcdf mode [.FALSE., .TRUE.] + o ncd_pio_IODOF_rootonly = logical true if want to write history in pio from root only [.FALSE., .TRUE.] + o ncd_pio_DebugLevel = integer pio debug level ( default 2) + o ncd_pio_num_iotasks = integer number of iotasks to use for PIO (default all PEs) + +M src/main/clm_varctl.F90 ----------------- New ncd and PIO history options +M src/main/program_off.F90 ---------------- Add mpi barrier +M src/main/areaMod.F90 -------------------- Improve performance/robustness +M src/main/clm_mct_mod.F90 ---------------- Use pelocs +M src/riverroute/RtmMod.F90 --------------- Add timers, update of rtm init to improve scaling and performance +M test/system/test_driver.sh -------------- Fix for new account names on jaguar/phoenix + +Summary of testing: + + bluevista: All PASS except +021 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +026 blF27 TBL.sh 17p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..............FAIL! rc= 7 +031 blE31 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguarcnl: All PASS except +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 + bangkok/lf95: All PASS except +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +020 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 +051 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + lightning/pathscale: All PASS except +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +021 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 + tempest: All PASS except +010 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 + +er112, bl112, sm921, sm951, sm982 tests failed previously +other bl tests fail because of the changes in RTM + +CLM tag used for the baseline comparison tests if applicable: clm3_5_16 + +Changes answers relative to baseline: Only RTM + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: RTM + - what platforms/compilers: All + - nature of change: Roundoff change + + If bitwise differences were observed, how did you show they were no worse + than roundoff? Only fields with RTM show differences and only to roundoff level + + RMS DVOLRDT_ 8.8031E-22 + RMS DVOLRDT_ 3.4573E-23 + RMS QCHANR 3.6282E-16 + RMS QCHOCNR 5.4893E-17 + +The above is on bluevista after running for a day (other fields show RMS difference of zero) + +=============================================================== +=============================================================== +Tag name: clm3_5_16 +Originator(s): erik (Erik Kluzek) +Date: Mon Jan 28 15:00:53 MST 2008 +One-line Summary: Get point version of Urban code onto trunk (urban code can not restart) + +Purpose of changes: Move urban branch onto trunk. Fix bug so hv files are saved. Add + high resolution datasets from Art Mirin. + + Urban code was started by Gordon Bonan, and taken up by Mariana Vertenstein and Keith Oleson. + This represents work that has been ongoing for several years. Revision dates go back to + before 2003. + + Some papers on the work are available from: + + Oleson et.-al. Journal of Applied Meteorology and Climatology, in-Press as of Jan/2008 + + http://www.cgd.ucar.edu/tss/staff/oleson/publications/JAMC1597_rev_jul27_2007.pdf + http://www.cgd.ucar.edu/tss/staff/oleson/publications/JAMC1598_rev_jul27_2007.pdf + +Bugs fixed (include bugzilla ID): 644 (save hv files) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, 681, 694 + http://bugs.cgd.ucar.edu/ + + New bug found from clm3_5_15 (694) -- restarts are NOT bit-for-bit on lightning and bangkok/lf95 for offline + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Added furbinp -- for urban datasets + +List any changes to the defaults for the boundary datasets: Added more urban datasets. + Add 0.23x0.31 datasets from Art Mirin. + +Describe any substantial timing or memory changes: Approx 1% slower, memory should be very close + +Code reviewed by: oleson + +List any svn externals directories updated (csm_share, mct, etc.): bld/archiving + bld/archiving to scripts_080108 + +List all files eliminated: None + +List all files added and what they do: + +------ Urban point input datasets (ASCII) +A bld/urban_input/asphaltjungle_fluxes.txt +A bld/urban_input/metropolis_fluxes.txt +A bld/urban_input/mexicocityMEX_fluxes.txt +A bld/urban_input/vancouverCAN_fluxes.txt +----- Main urban source codes +A src/biogeophys/UrbanInitMod.F90 +A src/biogeophys/UrbanInputMod.F90 +A src/biogeophys/UrbanMod.F90 +----- Add testing for urban code +A test/system/tests_posttag_urban ------ List of urban point tests +A test/system/nl_files/clm_urb1pt ------ Namelist options for CLM1PT datasets +A test/system/nl_files/nl_urb ---------- Urban namelist +A test/system/config_files/_mexsc_ds --- Mexicocity, MEX +A test/system/config_files/_vansc_ds --- Vancouver, CAN +----- Add tool to convert Urban point datasets to sequential-CCSM mode for datm7 +A tools/ncl_scripts/convertUrbanOffline2Seq.ncl + +List all existing files that have been modified, and describe the changes: + +-------- Add in urban datasets to build-namelist +M bld/configure ---------------------------- Move subroutine definition to before first reference +M bld/datm_dshr_in.pm +M bld/clm_inparm.pm +M bld/datm.streams.template.xml ------------ Add in CLM1PT datasets for Urban +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/DefaultSettings.xml +M bld/DefaultDATM_DSHR_NML_Namelist.xml +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/timemgr_inparm.pm +M bld/run-pc.pm ---------------------------- Remove extra line, set mode in configure, add note about step=coupling step +M bld/run-ibm.pm --------------------------- Add note about step=coupling step +M bld/run-lightning.pm --------------------- Add note about step=coupling step +-------- source code changes to add in urban code +-------- mostly adding urban and non-urban filters +M src/biogeochem/DGVMMod.F90 --------------- Add urban filters +M src/main/atmdrvMod.F90 ------------------- Add RH and rainf, zero out solar if coszen<0, Urban pt CPPs +M src/main/clm_varcon.F90 ------------------ Add PI, RGAS, SECSPDAY, urban PFT types, urban ponding depth +M src/main/clm_varpar.F90 ------------------ Add maxpatch_urb for 5 PFT's +M src/main/clm_atmlnd.F90 ------------------ Fill RH and rainf +M src/main/clmtype.F90 --------------------- Add urban state data +M src/main/clmtypeInitMod.F90 -------------- Initialize urban state data +M src/main/controlMod.F90 ------------------ Add furbinp namelist item for urban input data +M src/main/driver.F90 ---------------------- Pass urban filters, call urban modules +M src/main/filterMod.F90 ------------------- Add urban filters +M src/main/histFileMod.F90 ----------------- Add scale types needed for urban which needs to calculate area-averages based on urban input +M src/main/histFldsMod.F90 ----------------- Add new output fields: + + BUILDHEAT heat flux from urban building interior to walls and roof W/m^2 active + LWdown atmospheric longwave radiation W/m^2 + PSurf surface pressure Pa + Qh sensible heat W/m^2 + Qle total evaporation W/m^2 + Qstor storage heat flux (includes snowmelt) W/m^2 + RH atmospheric relative humidity % + Rainf atmospheric rain mm/s + Rnet net radiation W/m^2 + SWdown atmospheric incident solar radiation W/m^2 + TBUILD internal urban building temperature K active + TRAFFICFLUX sensible heat flux from urban traffic W/m^2 active + Tair atmospheric air temperature K + WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 active + +(Fields not mentioned above as active are set to inactive unless asked for. They are "ALMA" variables needed for + an urban model intercomparision project.) + +M src/main/iniTimeConst.F90 ---------------- Initialize urban data +M src/main/initGridCellsMod.F90 ------------ Add initialization of urban landunits +M src/main/initSurfAlbMod.F90 -------------- Call urban albedo calc +M src/main/initializeMod.F90 --------------- Urban initialization +M src/main/lnd_comp_mct.F90 ---------------- Add saturation vapor calc to compute RH +M src/main/mkarbinitMod.F90 ---------------- Initialize urban state +M src/main/pftvarcon.F90 ------------------- Fix typo +M src/main/program_off.F90 ----------------- Pass declination angle from orbit to atmdrv (so solar can be nullified for coszen<0) +M src/main/subgridAveMod.F90 --------------- Setup grid info for urban +M src/main/subgridMod.F90 ------------------ Set urban landunit +M src/main/surfrdMod.F90 ------------------- Initialize urban weights -- remove old code that aborted if urban fraction>0 +M src/biogeophys/BalanceCheckMod.F90 ------- Incoming rain does NOT include sun or shade wall, some checks only non-urban +M src/biogeophys/Biogeophysics1Mod.F90 ----- Take into account type of urban column +M src/biogeophys/Biogeophysics2Mod.F90 ----- Take into account type of urban column +M src/biogeophys/FrictionVelocityMod.F90 --- Change index and filters +M src/biogeophys/Hydrology1Mod.F90 --------- Take into account no water flow through urban buildings and impervious road +M src/biogeophys/Hydrology2Mod.F90 --------- Send urban filters down, and no water flow in certain urban column types +M src/biogeophys/SnowHydrologyMod.F90 ------ Urban similar to bare-soil landunit +M src/biogeophys/SoilHydrologyMod.F90 ------ Determine ponding limits for urban roof and impervious road, no runoff for sun/shade wall +M src/biogeophys/SoilTemperatureMod.F90 ---- Take into account that urban columns interact +M src/biogeophys/SurfaceAlbedoMod.F90 ------ Filter urban columns appropriately +M src/biogeophys/SurfaceRadiationMod.F90 --- Filter urban columns out +---------- Make MPI and OpenMP settings explicit in configuration files +M test/system/config_files/17p_vodsr_dm +M test/system/config_files/17p_vodsr_do +M test/system/config_files/4p_casa_m +M test/system/config_files/4p_casa_o +M test/system/config_files/17p_vodsr_m +M test/system/config_files/17p_vodsr_o +M test/system/config_files/4p_vodsr_dm +M test/system/config_files/17p_cnn_m +M test/system/config_files/4p_vodsr_do +M test/system/config_files/17p_cnn_o +M test/system/config_files/17p_cnn_dm +M test/system/config_files/17p_cnn_do +M test/system/config_files/10p_dgvm_m +M test/system/config_files/4p_casa_dm +M test/system/config_files/10p_dgvm_o +M test/system/config_files/4p_casa_do +M test/system/config_files/10p_dgvm_dm +M test/system/config_files/README +M test/system/config_files/10p_dgvm_do +M test/system/config_files/4p_vodsr_m +M test/system/config_files/4p_vodsr_o +---------- Add urban tests to testing system +M test/system/input_tests_master +M test/system/README.testnames +M test/system/mknamelist +M test/system/test_driver.sh +M test/system/tests_posttag_bangkok +M test/system/tests_posttag_blueice +M test/system/tests_posttag_lightning +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/tests_pretag_bangkok +M test/system/tests_pretag_bluevista +---------- Put options on separate lines, explicitly set source +M test/system/nl_files/clm_pftdyn +M test/system/nl_files/clm_per +M test/system/nl_files/clm_per0 +M test/system/nl_files/clm_std +---------- Add note about need of other directories to build +M tools/ncl_scripts/README ---------------------- Also add note about new script +M tools/mksurfdata/README +M tools/ncl_scripts/README +M tools/interpinic/README +M tools/mkgriddata/README +M tools/mkdatadomain/README + + +Summary of testing: + + bluevista: All PASS except +034 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +036 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +076 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + tempest: ALL PASS + jaguarcnl: All PASS except TBL tests which fail because of a problem with the previous version on jaguar. +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 4 +008 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 5 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +024 blH12 TBL.sh 17p_cnnsc_dm clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 5 +028 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 5 +032 blK12 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 5 + bangkok/lf95: All PASS except +014 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +016 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< +020 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 +051 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + + lightning/pathf90: All PASS except +011 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +015 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< +021 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 + + +Urban TBL point tests do NOT pass because previous model version didn't have urban enabled. +cam standalone tests require the ccsm4_alpha series version of clm. +<<<<< Tests are the 694 bug found in clm3_5_15. + + +CLM tag used for the baseline comparison tests if applicable: clm3_5_15 + +Changes answers relative to baseline: None bit-for-bit + (except albedo's will be different when running in offline mode see below) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All mode=offline + - what platforms/compilers: All + - nature of change: Solar now set to zero when coszen<0, which influences + some non-common instances near twilight when the dataset shows solar>0 + but coszen<0. It doesn't change the model results -- because everything is + reflected anyway, but it will change how albedo is averaged over those periods. + +=============================================================== +=============================================================== +Tag name: clm3_5_15 +Originator(s): erik (Erik Kluzek) +Date: Fri Dec 21 20:33:01 MST 2007 +One-line Summary: Fix interpinic for half degree grid, add in large-file support, allow configure to work with ccsm directory structure + +Purpose of changes: + +Change configure so it will work with the ccsm4_alpha directory structure (especially for +the test suite). Add in large-file support for main code as well as tools (mksurfdata). +Add in tests for create_croplandunit and large-file support. Get interpinic to work for +half degree, and optimize and verify it's use of Open-MP. Add tool to interpolate +Nitrogen deposition files (ndepregrid.ncl). Update run scripts with suggestions from Sam +(and fix a couple of minor bugs). + +interpinic problem: Previous version may have incorrectly found nearest points for PFT data. + Data would have been valid -- but possibly NOT from the nearest point. + There was also a potential Open-MP problem where answers could change depending on the + number of threads used. The new version corrects both of these problems. The new version + should be used to interpolate critical datasets. + +Bugs fixed (include bugzilla ID): 656 (interpinic), 660 (large-file), 674 (diff -q in run script), 679 (testing task/thread change) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 664, 672, 675, 676 + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Remove mpi include/lib for jaguarcnl + (as already included with the ftn command) + + Make ccsm_seq -- the default way to run. + +Describe any changes made to the namelist: Add outnc_large_files option + + outnc_large_files --- TRUE => use NetCDF 64-bit large file format for output files + (history and restart files) + + The NetCDF 64-bit large file format became available in NetCDF3.6.0 and allows larger dimensions as well as allowing + output files > 2 GBytes. For more info. on Large File Support (LFS) for NetCDF see... + + http://www.unidata.ucar.edu/software/netcdf/docs/faq.html#lfs + + Since, file offsets are stored with 64-bit words rather than 32-bit words -- file sizes may change slightly with LFS. + +List any changes to the defaults for the boundary datasets: + + Added in new clmi files: + ++lnd/clm2/initdata/clmi.BCN.1980-01-01-00000.071207.nc ++lnd/clm2/initdata/clmi.F_0000-01-01_1.9x2.5_gx1v5_c071203.nc ++lnd/clm2/initdata/clmi.F_0000-09-01_1.9x2.5_gx1v5_c071203.nc + + Added in ndep files at half degree + ++lnd/clm2/ndepdata/ndep_clm_2100_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/ndep_clm_2000_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/ndep_clm_1890_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/fndep_clm_1890-2100_0.47x0.63_c071213.nc + + Add documentation and delete extra variables from T42 base ndep datasets + ++lnd/clm2/ndepdata/ndep_clm_2100_64x128_c071221.nc ++lnd/clm2/ndepdata/ndep_clm_2000_64x128_c071221.nc ++lnd/clm2/ndepdata/ndep_clm_1890_64x128_c071221.nc + + Added in urban testing dataset + ++lnd/clm2/surfdata/surfdata_1x1pt_camdenNJ_navy_070824.nc ++lnd/clm2/griddata/griddata_1x1pt_camdenNJ_navy_070824.nc ++lnd/clm2/griddata/fracdata_1x1pt_camdenNJ_navy_070824.nc + + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis (interpinic, run-ibm.csh), + thornton (ndepregrid.ncl, outnc_large_files option) + +List any svn externals directories updated (csm_share, mct, etc.): + perl5lib to perl5lib_071204 which includes new Decomp module. + +List all files eliminated: None + +List all files added and what they do: + +Add files for testing different tool configurations and ncl scripts, and for testing of +create_crop_landunit, large_file support, and an urbin test. Also change offline configuration +files so they have offline explicitly set as the mode. + +A + test/system/config_files/tools__ds +A + test/system/config_files/tools__o +A + test/system/TSMncl_tools.sh +A + test/system/nl_files/nl_crcrop +A + test/system/nl_files/nl_std +A + test/system/nl_files/nl_lfiles + +Add ncl script to regrid Nitrogen deposition files + +A + tools/ncl_scripts +A + tools/ncl_scripts/README +A + tools/ncl_scripts/ndepregrid.ncl +A + tools/mkgriddata/mkgriddata.ccsm_dom ------ add sample script for using CCSM domain files + +List all existing files that have been modified, and describe the changes: + + + Testing system updates... + +M test/system/config_files/* <-- offline configure files -- explicitly set offline mode +M test/system/config_files/README +M test/system/tests_posttag_spot1 +M test/system/tests_pretag_jaguar +M test/system/README.testnames +M test/system/tests_pretag_bangkok +M test/system/TCBtools.sh +M test/system/test_driver.sh +M test/system/mknamelist +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/tests_pretag_tempest +M test/system/tests_pretag_bluevista +M test/system/tests_posttag_blueice +M test/system/input_tests_master +M test/system/README +M test/system/TSMtools.sh +M test/system/TCBext_ccsmseq_cam.sh +M test/system/tests_posttag_lightning +M test/system/TBLtools.sh +M test/system/TSM.sh + + Update tools makefile and change svn keyword strings + +M tools/mksurfdata/mkvarctl.F90 +M tools/mksurfdata/README +M tools/mksurfdata/mkfileMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/Makefile +M tools/interpinic/interpinic.F90 +M tools/interpinic/Srcfiles +M tools/interpinic/Makefile +M tools/mkgriddata/creategridMod.F90 +M tools/mkgriddata/Makefile +M tools/mkdatadomain/Makefile +M tools/README + +M bld/configure ---------------------- changes to work with ccsm4.alpha directory structure, and jaguarcnl +M bld/DefaultCLM_INPARM_Namelist.xml - Add new datasets +M bld/Makefile.in -------------------- changes needed for jaguarcnl and Darwin +M bld/scpDefaultNamelist.pl ---------- extend to work with ndep files + Make changes to run scripts -- move section of things to change to top + Remove stuff not used. Add more documentation. Add suggestions from Sam Levis. +M bld/run-ibm.csh -------------------- remove -q option to diff +M bld/run-lightning.csh -------------- add bit about comparing rpointer files to see if advancing from run-ibm.csh +M bld/run-pc.csh --------------------- add bit about comparing rpointer files to see if advancing from run-ibm.csh + + Add large-file support + +M src/biogeochem/CASAMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/main/ncdio.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/clm_varctl.F90 + +Summary of testing: + + tempest: All PASS + bluevista: All PASS, except +033 smEA1 TSM.sh _sc_ds clm_std 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic .................FAIL! rc= 10 --> Urban not active yet +034 blEA1 TBL.sh _sc_ds clm_std 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic .................FAIL! rc= 4 ---> Urban not active yet +066 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 ---> New test +070 blL63 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup ..................FAIL! rc= 7 ---> New clmi file +074 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 ---> New clmi file +092 bl711 TBLtools.sh mksurfdata tools__ds namelist .............................................FAIL! rc= 4 ---> Test changed +094 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 ---> Test changed +099 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +100 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguarcnl: ALL PASS, except TBL tests because previous code didn't run on jaguar with recent changes + lightning: ALL PASS, except +035 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 ---> New test +042 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 5 ---> New test + bangkok/lf95: All PASS, except +047 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +048 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + + CAM tests fail because of incomptabilities of csm_share code. + +CLM tag used for the baseline comparison tests if applicable: clm3_5_14 + +Changes answers relative to baseline: None -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_14 +Originator(s): erik (Erik Kluzek) +Date: Thu Nov 29 12:18:47 MST 2007 +One-line Summary: Use build-streams, and archiving, multiple bug-fixes + +Purpose of changes: Move bstrms5_clm3_5_13 to trunk + +Remove long-term archiving from clm code. Use Mat's long-term and short-term archiving +scripts like cam. Short term script runs at the end of your run script -- then the +long-term archiving script is submitted to the batch que at the end. Update to newer +version of csm_share that doesn't have any mss_ options. Tune usage of build-namelist. +Make streams file on the fly. Remove references to get_env and $HEADUrl$. Fix interpinic +for CASA and RTM (from Sam). Change testing from being done in offline mode to +seq_ccsm mode. Make default in run scripts to run seq_ccsm mode. Add option to run scripts +to resubmit itself until reaches a given model date. + +Add in HCSOI and HCSOISNO from Dave Lawrence. Add PERGRO test to test suite. Simple PERGRO +fix from Jerry Olson. Use branch of driver code for seq-ccsm and removing archiving. Add +in lnd_comp_mct changes from ccsm4.alpha series. + +Bugs fixed (include bugzilla ID): 449 (create_crop), 548 (rm getenv), 579 (cam config), +Changes answers relative to baseline: None + + To verify bit-for-bit ran standard offline test case (bl111) on: tempest, bluevista, bangkok + (pass on bangkok, and bluevista -- but failed on tempest) + +=============================================================== +=============================================================== +Tag name: clm3_5_13 +Originator(s): erik (Erik Kluzek) +Date: Fri Nov 16 10:17:38 MST 2007 +One-line Summary: Update xml file with file needed for ccsm3_5_beta18 + +Describe any changes made to build system: Add models/utils/perl5lib to path for perl tools + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New 0.47x0.63 fraction + dataset compatible with CCSM datasets + +Describe any substantial timing or memory changes: None + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all subroutines eliminated: None + +List all subroutines added and what they do: + +A bld/scpDefaultNamelist.pl -- Script to help copy files in xml database. + +List all existing files that have been modified, and describe the changes: + +M bld/configure --- add models/util to path +M bld/DefaultCLM_INPARM_Namelist.xml -- add new file +M bld/queryDefaultNamelist.pl --- add models/util to path +M bld/build-namelist --- add models/util to path + +Summary of testing: None + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm3_5_12 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Nov 8 13:49:25 MST 2007 +One-line Summary: Tag with new files needed for ccsm3_5_beta17 + +Purpose of changes: Add new files needed for new resolutions being adding in ccsm3_5_beta17 + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: Small changes to configure from bstrms branch + +Describe any changes made to the namelist: Add new files to Default*.xml files + +List any changes to the defaults for the boundary datasets: New resolutions added + +Describe any substantial timing or memory changes: None + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all existing files that have been modified, and describe the changes: + +Move files over from the bstrms3_clm3_5_11 branch with the new resolutions needed. + +M bld/configure +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/DefaultDATM_NML_Namelist.xml +M bld/DefaultSettings.xml +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/DefaultPROF_INPARM_Namelist.xml +M bld/queryDefaultNamelist.pl +M bld/DefaultCCSM_INPARM_Namelist.xml +M bld/build-namelist +M bld/DefaultDATM_DSHR_NML_Namelist.xml + +Summary of testing: None + +Changes answers relative to baseline: None + +=============================================================== +=============================================================== +Tag name: clm3_5_11 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Sep 28 12:03:30 MDT 2007 +Date:One-line Summary: Update datasets in the DefaultCLM file for 0.23x0.31, 0.47x0.63, 0.9x1.25 and add fndepdyn file for 1.9x2.5 + +Purpose of changes: Needed for CCSM 20th Century simulation needed for ccsm3_5_beta13 + +Bugs fixed (include bugzilla ID): 585, 589, 593, 611 + + Add T42_gx1v5, 0.9x1.25_gx1v5 support. + also look in scripts/ccsm_utils/Tools for perl5lib. + abort if set -cycle_begyr or cycle_nyrs on namelist rather than on build-namelist command-line. + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608, 618, 622, 624 + + New nasty bugs found: + +618 You can't add new fields using: hist_fincl*. +622 CLM blindly continues even if needed fields are missing from surface dataset. + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Just add more files to XML database + +List any changes to the defaults for the boundary datasets: Add new files for: + 0.23x0.31, 0.47x0.63, 0.9x1.25, (64x128 with mask=gx1v5) and add fndepdyn file for 1.9x2.5 + +Describe any substantial timing or memory changes: None + +Code reviewed by: None + +List any svn externals directories updated (csm_share, mct, etc.): csm_share updated to trunk_tags/share3_070927 + + This is the version needed in ccsm3_5_beta13 tag (previous version causes problems building on tempest) + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M bld/DefaultCLM_INPARM_Namelist.xml ---- Add new datasets. +M bld/clm_inparm.pm --------------------- Abort if try to define cycle_nyr and cycle_begyr on namelist + rather than with command line options. +M bld/queryDefaultNamelist.pl ----------- Add ability to use perl5lib from under ccsm_utils/scripts/Tools. +M bld/build-namelist -------------------- Add ability to use perl5lib from under ccsm_utils/scripts/Tools. + + ------------------------- Remove test blZ11 (can't do the comparision), and update cam tag comparing to. +M test/system/tests_pretag_bangkok +M test/system/test_driver.sh +M test/system/tests_posttag_purempi_regression +M test/system/tests_posttag_hybrid_regression +M test/system/tests_pretag_bluevista +M test/system/tests_posttag_lightning + +Summary of testing: None + +Changes answers relative to baseline: No clm source code changed + +=============================================================== +=============================================================== +Tag name: clm3_5_10 +Originator(s): jet +Date: Tue Sep 18 12:00:23 MDT 2007 +Date:One-line Summary: Fixed scam bugs when reading initial land dataset + and moved scam_setlatlon functionality to shr_scam_mod in + csm_shr repos. Merged in Mariana's changes to add new boundary + dataset file to help scam determine land/ocn/ice fractions. + +Purpose of changes: Fix scam bugs and refactor code to allow scam to easily + determine land/ocean/ice fractions. + +Bugs fixed (include bugzilla ID): 612, 480 + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608, 618, 622 + +Describe any changes made to build system: Change configure to include new focndomain file. + +Describe any changes made to the namelist: focndomain file added to ocn_in + +List any changes to the defaults for the boundary datasets: Mariana created + a new focndomain boundary dataset (at the standard resolutions) which + describe the grid fraction of land/ocn/ice + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mariana + +List any svn externals directories updated (csm_share, mct, etc.): + + clm3_5_10 + branches/scm_drvseq1_0_43 + branches/csm_share3_070824_scm + +List all subroutines eliminated: scam_setlatlonidx.F90 + +List all subroutines added and what they do: moved scm functionality + from scam_setlatlonidx.F90 into a csm_share module that can + now be used by all surface models. + +List all existing files that have been modified, and describe the changes: +M test/system/test_driver.sh - use latest cam in testing +M test/system/nl_files/scam - fixed scam bug +M test/system/nl_files/scam_prep - fixed scam bug +M test/system/nl_files/ext_ccsm_seq_cam - use latest cam in testing +M SVN_EXTERNAL_DIRECTORIES - point to needed external dirs +M src/biogeochem/STATICEcosysDynMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/ncdio.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/initializeMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/iniTimeConst.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/restFileMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +D src/main/scam_setlatlonidx.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/clm_varctl.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/surfrdMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +Summary of testing: + + bluevista: Everything but ccsm tests pass ( due to requirment on external + directories) + + bangkok/lf95: all passed except ccsm - expected due to requirment on external + directories + tempest all passed except 034 br531 (failed previous to this commit) + + CLM tag used for the baseline comparison tests if applicable: clm3_5_09 + +Changes answers relative to baseline: None + +=============================================================== +=============================================================== +Tag name: clm3_5_09 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Aug 31 13:58:46 MDT 2007 +Date:One-line Summary: Change configure to NOT have csm_share code for ccsm_con option, and add in 1x1.25 file, and update datm7 and csm_share + +Purpose of changes: Fix for ccsm3_5_beta12 tag + +Bugs fixed (include bugzilla ID): 581, 583 + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608,found with a suggested fix by Inez Fung + +Bugs fixed (include bugzilla ID): 389 (partial), 442, 443, 445, 450 + +Describe any changes made to build system: Fix build for jaguar and phoenix + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: nanr, slevis, dlawren, oleson, and bonan reviewed the mklai changes + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all subroutines eliminated: None + +List all subroutines added and what they do: Documentation files + +A + doc/README.DGVM +A + doc/KnownBugs + +List all existing files that have been modified, and describe the changes: + +---------------------> Improve testing +M test/system/nl_files/t31_cnall +M test/system/nl_files/singlept_dgvm_long +M test/system/nl_files/1.9x2.5 +M test/system/nl_files/t31_dgvm +M test/system/nl_files/singlept +M test/system/nl_files/10x15_cnall +M test/system/nl_files/10x15_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/regional +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/nl_files/10x15 +M test/system/tests_posttag_robin +M test/system/input_tests_master +M test/system/tests_pretag_jaguar +M test/system/tests_posttag_phoenix +M test/system/test_driver.sh +M test/system/TSCscam.sh + +---------------------> Change calculation of LAI,SAI,Canopy-top/bottom so weighted by %-PFT +M tools/mksurfdata/mkfmax.F90 +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkglacier.F90 +M tools/mksurfdata/mkurban.F90 +M tools/mksurfdata/mksoitex.F90 +M tools/mksurfdata/areaMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/Srcfiles +M tools/mksurfdata/mksoicol.F90 +M tools/mksurfdata/mkpftMod.F90 + +---------------------> Use new default files at T42, add and correct documentation +M bld/run-pc.csh +M bld/run-lightning.csh +M bld/Makefile.in +M bld/run-ibm.csh +M bld/config_clm_defaults.xml +M bld/system_defaults.xml +M bld/run-frost.csh + +---------------------> Remove uneeded shr_sys_flush, put #ifndef UNICOSMP around shr_sys_flush(6), correct MCT vector calls + needed for phoenix/robin build. + +M src/biogeochem/CNCStateUpdate2Mod.F90 +M src/biogeochem/CNGapMortalityMod.F90 +M src/biogeochem/CNC13StateUpdate2Mod.F90 +M src/biogeochem/CNFireMod.F90 +M src/biogeochem/CASAMod.F90 -------------------> Fix CASA by uncommenting lines according to Inez Fung +M src/biogeochem/CNPrecisionControlMod.F90 +M src/biogeochem/DUSTMod.F90 -------------------> Changes from Natalie M. and Francis Vitt for CAM/CLM3.5 Aerosols +M src/biogeochem/CNPhenologyMod.F90 +M src/biogeochem/CNCStateUpdate1Mod.F90 +M src/biogeochem/CNDecompMod.F90 +M src/biogeochem/CNCStateUpdate3Mod.F90 +M src/biogeochem/CNC13StateUpdate1Mod.F90 +M src/biogeochem/CNC13StateUpdate3Mod.F90 +M src/biogeochem/CNAllocationMod.F90 +M src/biogeochem/CNC13FluxMod.F90 +M src/biogeochem/CNEcosystemDynMod.F90 +M src/biogeochem/CNVegStructUpdateMod.F90 +M src/main/inicFileMod.F90 +M src/main/abortutils.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 -----------------------> Changes from Keith O. to fix TKFRZ change +M src/main/initializeMod.F90 +M src/main/clmtypeInitMod.F90 +M src/main/histFileMod.F90 +M src/main/clm_csmMod.F90 +M src/main/controlMod.F90 ----------------------> Fix #ifdef's so extra namelist items only on for COUP_CSM or OFFLINE +M src/main/initSurfAlbMod.F90 +M src/main/clm_time_manager.F90 +M src/main/initGridCellsMod.F90 +M src/main/program_off.F90 +M src/main/surfrdMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/clm_mct_mod.F90 +M src/riverroute/RtmMod.F90 +M src/biogeophys/SurfaceRadiationMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluevista: All PASS except +004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................FAIL! rc= +009 bl127 TBL.sh 17p_vodsr_dh t31 48 ..............................FAIL! rc= +014 bl131 TBL.sh 4p_vodsr_dh t42half 48 ...........................FAIL! rc= +019 bl141 TBL.sh 17p__dh 10x15_pftdyn 48 ..........................FAIL! rc= +024 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................FAIL! rc= +028 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................FAIL! rc= +032 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................FAIL! rc= +037 bl471 TBL.sh 10p_dgvm_s singlept_dgvm_long -730 ...............FAIL! rc= +041 bl563 TBL.sh _h 1.9x2.5 -10 ...................................FAIL! rc= +045 bl552 TBL.sh _ds 10x15 24 .....................................FAIL! rc= +049 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +053 bl583 TBL.sh _dh regional -10 .................................FAIL! rc= +057 bl711 TBLtools.sh mksurfdata namelist .........................FAIL! rc= +059 bl771 TBLtools.sh mksurfdata singlept .........................FAIL! rc= +062 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 7 + lightning: All PASS except +004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= +009 bl142 TBL.sh 17p__dm 10x15_pftdyn 48 ..........................FAIL! rc= +014 bl252 TBL.sh 17p_cnn_dm 10x15_cnall 48 ........................FAIL! rc= +018 bl451 TBL.sh 10p_dgvm_dm 10x15_dgvm 48 ........................FAIL! rc= +019 sm551 TSM.sh _dh 10x15 48 .....................................FAIL! rc= 8 +020 er551 TER.sh _dh 10x15 10+38 ..................................FAIL! rc= 5 +021 br551 TBR.sh _dh 10x15 24+24 ..................................FAIL! rc= 5 +022 bl551 TBL.sh _dh 10x15 48 .....................................FAIL! rc= +026 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +029 bl771 TBLtools.sh mksurfdata singlept .........................FAIL! rc= + bangkok/lf95: +004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= +009 bl142 TBL.sh 17p__dm 10x15_pftdyn 48 ..........................FAIL! rc= +014 bl252 TBL.sh 17p_cnn_dm 10x15_cnall 48 ........................FAIL! rc= +018 bl312 TBL.sh 4p_casa_dm t31_casa 48 ...........................FAIL! rc= +022 bl451 TBL.sh 10p_dgvm_dm 10x15_dgvm 48 ........................FAIL! rc= +026 bl551 TBL.sh _dh 10x15 48 .....................................FAIL! rc= +030 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + robin: All compile tests pass + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_98 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: new LAI, TKFRZ change is roundoff different, Dust and CASA changes are significant + +=============================================================== +=============================================================== +Tag name: clm3_expa_98 +Originator(s): erik (KLUZEK ERIK 1326 CGD) +Date: Wed Apr 18 09:51:53 MDT 2007 +One-line Summary: Move externals to top, make SOM4 the default, rename setidx file, use new datafiles, + remove NUMLONS read, tweak testing, remove shell_cmd, remove read of old surfdata file + +Purpose of changes: Some simple cleanup preparing for CLM3.5 release + +Bugs fixed (include bugzilla ID): 440, 441 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Use new datasets + +List any changes to the defaults for the boundary datasets: Use new NCEP forcing datasets, + and new Nitrogen deposition datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Directories are the same -- but SVN externals themselves moved to top level + +List all subroutines eliminated: + +D test/system/tests_pretag_blueice > Rename to posttag filename +D bld/empty -----------------------> Rename to usr.src +D src/main/setlatlonidx.F90 -------> Rename to scam_setlatlonidx.F90 filename +D src/main/system_cmd.c +D src/main/cfort.h +D src/SVN_EXTERNAL_DIRECTORIES ----> Move to top layer + +List all subroutines added and what they do: + + -------------------> Files renamed from above +A + test/system/tests_posttag_blueice +A + bld/usr.src +A + SVN_EXTERNAL_DIRECTORIES +A + src/main/scam_setlatlonidx.F90 + + -------------------> New files +A test/system/config_files/10p_dgvm_s -------> New DGVM test +A + test/system/tests_posttag_blueice ---------> Rename +A test/system/tests_posttag_robin -----------> Add tests for robin/phoenix +A test/system/tests_posttag_phoenix +A test/system/nl_files/singlept_dgvm_long ---> Add new singlept DGVM test + -------------------> Add new documentation README files +A tools/README +A bld/README +A Copyright ----> CCSM Copyright file +A README + +List all existing files that have been modified, and describe the changes: + + -------------------> Tweak testing -- use new datasets, increase diversity of testing +M test/system/tests_pretag_bluevista +M test/system/nl_files/t31_cnall +M test/system/nl_files/1.9x2.5 +M test/system/nl_files/t31_dgvm +M test/system/nl_files/singlept +M test/system/nl_files/10x15_cnall +M test/system/nl_files/10x15_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/regional +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/nl_files/10x15 +M test/system/input_tests_master +M test/system/test_driver.sh + ---------------------> Remove system_cmd.c from list of source files needed to compile +M tools/mksurfdata/Srcfiles +M tools/interpinic/interpinic.F90 <--- fix interpinic compile on bluevista +M tools/mkgriddata/Srcfiles + ---------------------> Use new datasets, make sure works +M bld/run-pc.csh +M bld/configure ---- Remove SOM4 CPP declaration +M bld/run-lightning.csh +M bld/run-ibm.csh +M bld/run-frost.csh + ---------------------> Make SOM4 the default remove other option, remove read of NUMLON + ---------------------> Remove read of old surfdata sets, remove shell_cmd +M src/biogeochem/CNDecompMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/main/ncdio.F90 +M src/main/fileutils.F90 -----> Remove shell_cmd as unused now. +M src/main/iniTimeConst.F90 +M src/main/clm_varsur.F90 +M src/main/surfrdMod.F90 + +Summary of testing: + + bluevista: All PASS, except +062 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 7 + bangkok/lf95: All PASS + tempest: All PASS, except +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_97 + +=============================================================== +=============================================================== +Tag name: clm3_expa_97 +Originator(s): erik (KLUZEK ERIK 1326 CGD) +Date: Wed Apr 11 12:18:32 MDT 2007 +One-line Summary: Remove SPMD, update to clm proc tag, update timing, improve testing + +Purpose of changes: + Remove SPMD #ifdefs -- use mpi-serial code + Remove COUP_CAM #ifdefs for SEQ_MCT || SEQ_ESMF + Remove LOCAL_DEBUG CPP #ifdefs + Update to prof05_clm3_expa_92 tag (timing changes, SCAM fixes) + Update timing library to latest + Fix bugs + Improve test suite + Change scripts so will rebuild each time (only configure first time if config file DNE) + Change tool Makefile to be consistent and have USER_ overload options. + Add script to update ChangeLog + +Bugs fixed (include bugzilla ID): 337, 361, 389(partial), 407, 408, 417, 428 + 337 -- SPMD + 361 -- IRIX + 389 -- Testing + 407 -- Single gridcell + 408 -- mksurfdata,mkgriddata compiling + 417 -- write last file to mss correctly + 428 -- pdt-dyn mode now restarts correctly + +Describe any changes made to build system: Remove HIDE_MPI, remove + stuff left over from CAM Makefile, put FORTRAN name definition in configure + remove LOCAL_DEBUG CPP #ifdefs + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens, oleson, thornton (all just briefly) + +List any svn externals directories updated (csm_share, mct, etc.): + Update csm_share to share3_070321 + Update timing to timing_070328 + +List all subroutines eliminated: + +D bld/run-sgi.csh --------------------> Remove SGI run script +D test/system/tests_pretag_bluesky ---> Remove since bluesky is gone +D tools/mksurfdata/mksrfdat.namelist -> Change name to mksurfdata.namelist + + -------> Rename interpinic files to *.F90 + +D tools/interpinic/fmain.f90 +D tools/interpinic/wrap_nf.f90 +D tools/interpinic/shr_kind_mod.f90 +D tools/interpinic/interpinic.f90 +D tools/interpinic/addglobal.f90 + + --------> Remove file no longer needed by SCAM or for SPMD mode +D src/main/getnetcdfdata.F90 +D src/main/mpiinc.F90 + + +List all subroutines added and what they do: + +------- Add concurrent and sequential CCSM tests, add more resolutions, improve tools tests +A test/system/TSMconccsm.sh ----------- Concurrent CCSM test +--------------------> New configurations to test +A test/system/config_files/scam_ds +A test/system/config_files/_h +A test/system/config_files/_dh +A test/system/config_files/_m +A test/system/config_files/_o +A test/system/config_files/_dm +A test/system/config_files/_do +A test/system/config_files/_s +A test/system/config_files/_ds +A test/system/config_files/seqccsm_4x5_dh +A test/system/config_files/seqccsm_64x128_s +A test/system/config_files/seqccsm_10x15_dm +A test/system/config_files/17p__m +A test/system/config_files/17p__o +A test/system/config_files/17p__dh +A test/system/config_files/17p__dm +A test/system/config_files/17p__do +A test/system/config_files/17p__h +A test/system/TSMseqccsm.sh ------------- Sequential CCSM test +--------------------> New namelists and resolutions to test +A test/system/nl_files/scam +A test/system/nl_files/1.9x2.5 +A test/system/nl_files/singlept +A test/system/nl_files/10x15_cnall +A test/system/nl_files/10x15_dgvm +A test/system/nl_files/seqccsm +A test/system/nl_files/regional +A test/system/nl_files/scam_prep +A test/system/nl_files/10x15 +A test/system/README +A test/system/TCBseqccsm.sh --------> Sequential CCSM configure/build +A test/system/TSCscam.sh -----------> Sequential CCSM SCAM mode configure/build +A test/system/TCTconccsm.sh --------> CCSM create-test +A test/system/TBLtools.sh ----------> Compare tools to baseline version + +----------- add singlept and regional tests +A tools/mksurfdata/mksurfdata.singlept +A tools/mksurfdata/mksurfdata.regional +A + tools/mksurfdata/mksurfdata.namelist + +----------- Get improved code from Sam Levis (change names to *.F90) + +A tools/interpinic/interpinic.runoptions +A + tools/interpinic/fmain.F90 +A tools/interpinic/clmi_1999-01-02_10x15_c070330.nc <---- Test file +A + tools/interpinic/wrap_nf.F90 +A tools/interpinic/Filepath +A + tools/interpinic/interpinic.F90 +A + tools/interpinic/addglobal.F90 +A tools/interpinic/Srcfiles +----------- add singlept and regional tests +A tools/mkgriddata/mkgriddata.singlept +A tools/mkgriddata/mkgriddata.regional + +----------- Help to update ChangeLog +A doc/UpDateChangeLog.pl + +----------- New code needed for SCAM mode +A + src/main/setlatlonidx.F90 + + +List all existing files that have been modified, and describe the changes: + +----------- Improve test system (tweak tests, add new tests to various machines) +M test/system/tests_pretag_bluevista +M test/system/nl_files/t31_cnall +M test/system/nl_files/t31_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/CLM_runcmnd.sh ------- Use mpirun instead of mpiexec on bangkok/calgary +M test/system/tests_pretag_blueice +M test/system/input_tests_master +M test/system/tests_pretag_jaguar +M test/system/TSMtools.sh +M test/system/tests_pretag_bangkok +M test/system/TCBtools.sh +M test/system/test_driver.sh +M test/system/tests_pretag_tempest +M test/system/tests_posttag_lightning + +----------- Get tools to build +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkfileMod.F90 +M tools/mksurfdata/creategridMod.F90 +M tools/mksurfdata/Srcfiles +M tools/mksurfdata/Makefile ------ Make makefile consistent and add USER_ options +M tools/interpinic/Makefile ------ Make makefile consistent and add USER_ options +M tools/mkgriddata/mkgriddata.F90 +M tools/mkgriddata/creategridMod.F90 +M tools/mkgriddata/Srcfiles +M tools/mkgriddata/Makefile ------ Make makefile consistent and add USER_ options + +----------- Improvements to run scripts and build system + Change scripts so will rebuild each time (only configure first time if config file DNE), remove left over + features from CAM Makefile. +M bld/run-pc.csh +M bld/configure +M bld/run-lightning.csh +M bld/Makefile.in +M bld/run-ibm.csh +M bld/run-frost.csh + +----------- Source code changes, removing SPMD #ifdef, LOCAL_DEBUG, get SCAM mode working with new CAM, change + to work with new timing library, fix code bugs above. Remove COUP_CAM #ifdefs for SEQ_MCT || SEQ_ESMF +M src/biogeochem/CASAMod.F90 +M src/biogeochem/CNPhenologyMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/biogeochem/CNAllocationMod.F90 +M src/biogeochem/CNVegStructUpdateMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/abortutils.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 +M src/main/fileutils.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/program_csm.F90 +M src/main/restFileMod.F90 +M src/main/clm_csmMod.F90 +M src/main/controlMod.F90 +M src/main/ndepFileMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/program_off.F90 +M src/main/pftvarcon.F90 +M src/main/spmdMod.F90 +M src/main/surfrdMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/iobinary.F90 +M src/main/do_close_dispose.F90 +M src/riverroute/RtmMod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/BiogeophysRestMod.F90 + +Summary of testing: + + tempest: ALL PASS + bluevista: +019 bl141 TBL.sh 17p_vodsr_dh 10x15_pftdyn 48 .....................FAIL! rc= 7 +022 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................FAIL! rc= 6 +059 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 5 + bangkok/lf95: +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + +TBL test fails because of restart trouble with pftdyn. +Concurrent CCSM test fails because of a problem with ccsm3_5_beta01 for datm7. +bangkok scam test fails as is says that scm_crm_mode is not initialized in +CAM code. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_96 + (had to add in new tests, and set SOM4) + +Changes Answers: No + +=============================================================== + +=============================================================== +Tag name: clm3_expa_96 +Originator(s): tcraig +Date: Mon Mar 12 16:41:58 MDT 2007 +One-line Summary: fixed finemesh, pftdyn modes, add new tests + +Purpose of changes: restore finemesh and pftdyn modes, improve + test coverage + +Bugs fixed (include bugzilla ID): 389 (partial) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: reduced memory use in pftdyn + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + M test/system/tests_pretag_bluevista + A + test/system/nl_files/10x15_pftdyn + A + test/system/nl_files/t31_dgvm_long + A + test/system/nl_files/t42half + M test/system/input_tests_master + M test/system/tests_pretag_blueice + M test/system/tests_pretag_jaguar + M test/system/tests_pretag_bangkok + M test/system/test_driver.sh + M test/system/tests_posttag_lightning + M src/main/subgridMod.F90 + M src/main/initializeMod.F90 + M src/main/pftdynMod.F90 + M src/main/clm_varsur.F90 + M src/main/ndepFileMod.F90 + M src/main/subgridAveMod.F90 + M src/main/initGridCellsMod.F90 + M src/main/lnd_comp_mct.F90 + M src/main/program_off.F90 + M src/main/surfrdMod.F90 + M src/main/domainMod.F90 + M src/main/decompMod.F90 + M src/main/areaMod.F90 + +- rename lvegxy,lwtxy to vegxy, wtxy +- implement general setgatm, get finemesh working again +- refactor pftdynMod for low memory implementation, validate pfydyn mode +- modify ndep and pftdyn from x = x1*wt1 + x2*wt2 to x = x2 + wt1*(x1-x2) + as suggested by k.lindsay, improves roundoff performance +- clean up some old code +- add new tests configurations (10x15_pftdyn, t31_dgvm_long, t42half), +- update pretag lists, add new tests + +Summary of testing: + + bluevista: + all clm tests pass except bl for new cases including new tests + all cam tests pass except bl (due to clm changes in expa_94/95) + ccsm passes ERS.f45_g35.B.bluevista16 (answers change due to expa_94/95) + bangkok/lf95: + all clm tests pass including new tests in list + all cam tests pass except bl (due to clm changes in expa_94/95) + tempest: + all cam tests pass except bl (due to clm changes in expa_94/95) + lightning: + ccsm passes ERS.f45_g35.B2.lightning (answers change due to expa_94/95) + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_95, cam3_4_03, ccsm3_1_beta45 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + answers are bfb with clm3_expa_95 in clm. cam and ccsm could not + be tested for bfb due to lagging clm version in latest cam and ccsm tags + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_95 +Originator(s): nanr, Keith Oleson, Peter Thornton +Date: Thu Mar 8 17:06:06 MST 2007 +One-line Summary: Adding N limitation for CLM standalone w/o CN. + +Purpose of changes: Improve estimation of photosynthesis in CLM when it +is run without CN active. These changes impose a N limitation as a fcn of +PFT [0-1]. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: testing suites: fpftcon = pft-physiology.c070207 + +List any changes to the defaults for the boundary datasets: + fptfcon = pft-physiology.c070207 + pft-physiology.c070207.readme + +Describe any substantial timing or memory changes: none expected + +Code reviewed by: Keith Oleson, Peter Thornton, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bv1103en.ucar.edu-/fis/cgd/tss/nanr/clm/clm3_trunk % !svn +svn status | grep 'M ' +M test/system/nl_files/t31_cnall ! change pft-physiology.c070207 +M test/system/nl_files/t31_dgvm ! change pft-physiology.c070207 +M test/system/nl_files/t31 ! change pft-physiology.c070207 +M test/system/nl_files/t31_casa ! change pft-physiology.c070207 +M bld/run-pc.csh ! change pft-physiology.c070207 +M bld/run-sgi.csh ! change pft-physiology.c070207 +M bld/run-lightning.csh ! change pft-physiology.c070207 +M bld/run-ibm.csh ! change pft-physiology.c070207 +M bld/run-frost.csh ! change pft-physiology.c070207 +M src/main/clmtypeInitMod.F90 ! initialize new N limitation factor (fnitr) +M src/main/iniTimeConst.F90 ! initialize new N limitation factor (fnitr) +M src/main/pftvarcon.F90 ! read in new var (fnitr) +M src/main/clmtype.F90 ! initialize new N limitation factor (fnitr) +M src/biogeophys/CanopyFluxesMod.F90 ! apply new N limitation factor (fnitr) + +Summary of testing: + + bluevista: + 001 sm111 TSM.sh 4p_vodsr_dh t31 48 ...............................PASS + 002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................PASS + 003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................PASS + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................SKIPPED* + 005 sm114 TSM.sh 4p_vodsr_h t31 48 ................................PASS + 006 sm121 TSM.sh 17p_vodsr_dh t31 48 ..............................PASS + 007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................PASS + 008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................PASS + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................SKIPPED* + 010 sm124 TSM.sh 17p_vodsr_h t31 48 ...............................PASS + 011 sm211 TSM.sh 17p_cnn_dh t31_cnall 48 ..........................PASS + 012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................PASS + 013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................PASS + 014 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................SKIPPED* + 015 sm311 TSM.sh 4p_casa_dh t31_casa 48 ...........................PASS + 016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................PASS + 017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................PASS + 018 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................SKIPPED* + 019 sm411 TSM.sh 10p_dgvm_dh t31_dgvm 48 ..........................PASS + 020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................PASS + 021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................PASS + 022 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................SKIPPED* + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CN inactive + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/hydp2_off_communn_hk39 + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/tss/clm/diagnostics/lmwg_hydro/hydp2_off_communn_hk39aa-hydp2_off_communn_hk38aa/setsIndex.html + + + +=============================================================== +=============================================================== +Tag name: clm3_expa_94 +Originator(s): nanr, Keith Oleson, Peter Thornton +Date: Thu Mar 8 14:22:36 MST 2007 +One-line Summary: BTRAN modification + +Purpose of changes: Change BTRAN calculation to improve prognostic + LAI estimation in high latitudes. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Keith Oleson, Peter Thornton, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): nanr + +List all subroutines eliminated: nanr + +List all subroutines added and what they do: nanr + +List all existing files that have been modified, and describe the changes: +M src/biogeophys/CanopyFluxesMod.F90 + +Changing calculation of rootr to allow non-zero rootr (and btran) in partially frozen layers. + +Summary of testing: + + bluevista: + + 001 sm111 TSM.sh 4p_vodsr_dh t31 48 ...............................PASS + 002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................PASS + 003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................PASS + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................SKIPPED* + 005 sm114 TSM.sh 4p_vodsr_h t31 48 ................................PASS + 006 sm121 TSM.sh 17p_vodsr_dh t31 48 ..............................PASS + 007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................PASS + 008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................PASS + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................SKIPPED* + 010 sm124 TSM.sh 17p_vodsr_h t31 48 ...............................PASS + 011 sm211 TSM.sh 17p_cnn_dh t31_cnall 48 ..........................PASS + 012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................PASS + 013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................PASS + 014 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................SKIPPED* + 015 sm311 TSM.sh 4p_casa_dh t31_casa 48 ...........................PASS + 016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................PASS + 017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................PASS + 018 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................SKIPPED* + 019 sm411 TSM.sh 10p_dgvm_dh t31_dgvm 48 ..........................PASS + 020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................PASS + 021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................PASS + 022 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................SKIPPED* + + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: none + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + -larger than roundoff. Climate changes unknown. + -Improves prognostic LAI estimation in high latitudes. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): clm3_expa_89 + - platform/compilers: bluevista + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + /OLESON/csm/hydp2_off_communn_hk38 + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/tss/clm/diagnostics/lmwg_hydro/hydp2_off_communn_hk38aa-hydp2_off_communn_expa89aa/setsIndex.html + + +=============================================================== + +=============================================================== +Tag name: clm3_expa_93 ! NOTE: Tag incremented to correct mistaken tag number in documentation. (nanr) +Originator(s): tcraig +Date: Tue Feb 27 16:53:41 MST 2007 +One-line Summary: merge fmf branch to trunk (low memory mods) + +Purpose of changes: reduce memory and improve memory scaling + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: began adding support + for frost in Makefile and added a run-frost.csh (not yet + fully validated) + +Describe any changes made to the namelist: added new optional namelist + input, nsegspc (number of segments per clump for new decomp. default + is 20, 1 will produce poor loadbalance, infinity yields too many + segments per pe but good load balance. performance asymptotes for + several configurations at about 5-10 segments/pe, use 20 as default.) + +List any changes to the defaults for the boundary datasets: NONE + +Describe any substantial timing or memory changes: significant reduction + in memory use and improved memory scaling. + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): update + to mct external, MCT2_3_0_070206 + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +- implement new 1d decomp based on ngsegspc rather than balancing pfts, + ngsegspc is the number of segments per clump. the 1d gridcells will + be divided into clumps and segments per clump so there will be + a total number of segments, clumps*nsegspc, each of about equal number + of gridcells, that will be distributed round-robin to pes. pfts are + derived later and will hopefully end up being nearly as well load + balanced as the previous method without having to precompute pfts + and requiring much less memory. see above for more info on the namelist + input and default. +- reorganize initialization, split decomp_init into three phases, + atm (coarse), lnd (finemesh), and glcp (subgrid). +- add new datatype, latlon to hold some global grid info +- now all domain info is local (although initialization still needs + to be modified) +- remove some dead code +- add new timers (bug #302) +- split gatm out of domain type +- create simple setgatm_UNITY routine, finemesh capability now disabled, + must fix setgatm in future version +- move wtxy, vegxy, and pctspec to clm_varsur, allocate as local arrays + now (begg:endg) and modify surfrd to handle local data only both for + I/O and initialization. +- implement gather/scatter routines in spmdGathScatMod that use gsmaps. +- update MCT and share +- port to frost +- get rid of some of the global decomps use in code, still more to do +- memory cleanup in STATICEcosysDynMod +- implement new ncdio methods for reading to local gridcell data using gsmaps +- clean up atmdrv, use newer low mem datatypes, reduce memory +- clean up rtm, use newer low mem datatypes, reduce memory +- remove history "lat/lon" fields + +M test/system/test_driver.sh +M tools/mkgriddata/mkgriddata.F90 +M bld/configure +M bld/Makefile.in +A + bld/run-frost.csh +M src/biogeochem/CASAMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/abortutils.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 +M src/main/subgridMod.F90 +M src/main/initializeMod.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/program_csm.F90 +M src/main/clm_atmlnd.F90 +M src/main/clm_varsur.F90 +M src/main/clm_csmMod.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/clm_varctl.F90 +M src/main/ndepFileMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/program_off.F90 +M src/main/surfrdMod.F90 +M src/main/domainMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/clm_mct_mod.F90 +M src/SVN_EXTERNAL_DIRECTORIES +M src/riverroute/RtmMod.F90 + +Summary of testing: + + bluevista: all pass except + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................FAIL! rc= 7 + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................FAIL! rc= 7 + bangkok/lf95: all pass except + 004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= 7 + 009 bl122 TBL.sh 17p_vodsr_dm t31 48 ..............................FAIL! rc= 7 + Due to roundoff change in rtm, only rtm fields affected, otherwise bfb + + Also tested version in CCSM vs ccsm3_1_beta45 + ERS.f45_g35.B.bluevista16 + ERS.f45_g35.B2.lightning + Both PASS and bfb versus beta45 except for rtm roundoff difference and + associated error growth through ocean coupling + + Also tested mods merged to clm3_expa_91 with cam3_4_00, all + CAM tests pass on bangkok, bluevista, and tempest including scam. + Tested on bangkok with cam3_4_01 and updated to clm3_expa_92, all + CAM tests pass on bangkok. bluevista and tempest not tested + due to time constraints and earlier adequate testing with + clm3_expa_91 and cam3_4_00. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_89 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: anything with RTM on + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff change in RTM due to roundoff change in cell area calculation + + If bitwise differences were observed, how did you show they were no worse + than roundoff? tested in multiple systems, review growth of diffs in + stand-alone clm, only rtm fields affected, diffs remain roundoff for + 48 timesteps, no coupling to other fields or error growth in system. + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_92 +Originator(s): erik,mvertens,mvr +Date: Mon Feb 26 15:59:16 MST 2007 +One-line Summary: When running with Sequential CCSM -- use date for albedo calculation + +Purpose of changes: To work with cam3_4_01 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik,mvr,mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/main/clm_comp.F90 +M src/main/lnd_comp_mct.F90 + +Have sequential CCSM give CLM the date of the next radiation calculation so that +it can calculate albedo's for that specific time-step. This is needed to work with +cam3_4_01. + +Summary of testing: + + bluevista: Pass + bangkok/lf95: Pass + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_91 + +=============================================================== +=============================================================== +Tag name: clm3_expa_91 +Originator(s): erik +Date: Wed Feb 21 13:19:51 MST 2007 +One-line Summary: Fix SCAM mode, add more machines for test_driver, have tools use csm_share, + make clmtype private (except for data exporting), fix several bugs + +Purpose of changes: Fix SCAM mode so can make a new CAM tag. + +Bugs fixed (include bugzilla ID): 252, 310, 370, 377, 385 (partial -- 302, 357, 389) + +Describe any changes made to build system: Remove -DNO_R16 from Makefile + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: MSS writes are now synchronous instead of + asynchronous + +Code reviewed by: slevis + +List any externals updated: Update to csm_share3_070220 + +List all subroutines eliminated: + +Remove makdep -- as MkDepends replaces it +Remove cprlndnc -- as newcprnc replaces it + +D tools/makdep +D tools/makdep/main.c +D tools/makdep/Makefile +D tools/makdep/README +D tools/cprlndnc +D tools/cprlndnc/cprtps.F +D tools/cprlndnc/lenchr.F +D tools/cprlndnc/precision.F +D tools/cprlndnc/printstats.F +D tools/cprlndnc/wrap_nf.F +D tools/cprlndnc/stats.F +D tools/cprlndnc/ismax.F +D tools/cprlndnc/initstats.F +D tools/cprlndnc/nldat.F +D tools/cprlndnc/cpr.F +D tools/cprlndnc/prhddiff.F +D tools/cprlndnc/header.F +D tools/cprlndnc/Makefile +D doc/BranchLog +D doc/ChangeSum + +Delete files that tools use that are copied from main src directories (so we don't have +to maintain separate copies of code) + +D Deleting tools/mkgriddata/fileutils.F90 +D Deleting tools/mkgriddata/nanMod.F90 +D Deleting tools/mkgriddata/shr_const_mod.F90 +D Deleting tools/mkgriddata/shr_kind_mod.F90 +D Deleting tools/mkgriddata/shr_sys_mod.F90 +D Deleting tools/mksurfdata/fileutils.F90 +D Deleting tools/mksurfdata/nanMod.F90 +D Deleting tools/mksurfdata/shr_const_mod.F90 +D Deleting tools/mksurfdata/shr_kind_mod.F90 +D Deleting tools/mksurfdata/shr_sys_mod.F90 +D Deleting tools/mksurfdata/shr_timer_mod.F90 + +List all subroutines added and what they do: + +A test/system/TSMtools.sh -- for testing of the tools (not tested yet) +A test/system/TCBtools.sh -- for build testing of the tools (not tested yet) +A test/system/tests_pretag_blueice -- for running on blueice (does work) +A test/system/tests_pretag_jaguar -- for running on jaguar (doesn't work yet) +A test/system/tests_posttag_lightning -- for running on lightning (doesn't work yet) + +Files added so that tools build uses copies of files in main directories rather than separate copies + +A tools/mkgriddata/Filepath +A tools/mkgriddata/Srcfiles +A tools/mkgriddata/misc.h +A tools/mkgriddata/preproc.h +A tools/mksurfdata/Filepath +A tools/mksurfdata/Srcfiles +A tools/mksurfdata/misc.h +A tools/mksurfdata/preproc.h + +List all existing files that have been modified, and describe the changes: + +Add check for soil energy balance: + +M src/biogeophys/BalanceCheckMod.F90 + +Bigint bug fix (don't copy over static fields with bigint values when copying a domain) + +M src/main/domainMod.F90 + +SCAM fixes (read datasets differently for SCAM) + +M src/main/surfrdMod.F90 +M src/main/ndepFileMod.F90 +M src/main/iniTimeConst.F90 + +Change so that tools use main copies of code rather than own particular copy: + +M tools/mkgriddata/Makefile +M tools/mkgriddata/mkgriddata.namelist +M tools/mksurfdata/Makefile +M tools/mksurfdata/domainMod.F90 + +Make MSS write's synchronous instead of asynchronous: Required for LSF queing systems + +M src/main/fileutils.F90 + +Landmask bug fix: (landmask now output globally with no missing or fill values) + +M src/main/histFileMod.F90 +M src/main/initializeMod.F90 +M src/main/ncdio.F90 + +Timers + +M src/main/program_csm.F90 +M src/main/driver.F90 + +Make clmtype private -- so only exports it's data not data it uses. + +M src/biogeochem/CNGapMortalityMod.F90 +M src/biogeochem/VOCEmissionMod.F90 +M src/biogeochem/CNrestMod.F90 +M src/biogeochem/CNC13FluxMod.F90 +M src/biogeochem/CNSetValueMod.F90 +M src/main/atmdrvMod.F90 +M src/main/clmtypeInitMod.F90 +M src/main/pftdynMod.F90 +M src/main/restFileMod.F90 +M src/main/clmtype.F90 +M src/biogeophys/SnowHydrologyMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/BiogeophysRestMod.F90 +M src/biogeophys/DriverInitMod.F90 + +Miscellaneous: + +M bld/Makefile.in --- Remove NO_R16 CPP token, some changes to start work on jaguar +M test/system/test_driver.sh -- add more machines +M test/system/CLM_runcmnd.sh -- add more machines + +Summary of testing: + + bluevista: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + bangkok/lf95: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + blueice: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_90 + + Summarize any changes to answers: larger than roundoff (all config/all machines) + + (No simulations were performed as CCSM scientists deemed the change to be + insignificant) + +=============================================================== +=============================================================== +Tag name: clm3_expa_90 +Originator(s): nanr +Date: Tue Feb 6 13:17:55 MST 2007 +One-line Summary: Changed creategridMod.F90 to read variables from 10min USGS file. + +Purpose of changes: +Added htopo and landfract to retrieve landfrac and topography for processing USGS-gtopo30_10min_c050419.nc + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: nanr + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M creategridMod.F90 + + Added lines to creategridMod.F90 to read variables from USGS-gtopo30-10min_c050419.nc + + ier = nf_inq_varid (ncid, 'landfract', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read landfract' + call check_ret(nf_inq_varid (ncid, 'landfract', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + ier = nf_inq_varid (ncid, 'htopo', varid) + if (ier == NF_NOERR) then + if (toposet) write(6,*) trim(subname),' WARNING, overwriting topo' + toposet = .true. + write(6,*) trim(subname),' read htopo' + call check_ret(nf_inq_varid (ncid, 'htopo', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%topo), subname) + endif + + +Summary of testing: none. Affects tools/mkgriddata only. + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_89 +Originator(s): erik,oleson +Date: Feb/02/2007 +One-line Summary: + +Purpose of changes: Use new water table rise calculation in SoilHydrology + +Bugs fixed (include bugzilla ID): 345, 353 + +Describe any changes made to build system: None (although added Darwin to mksrfdat build Makefile) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Keith Oleson + +List all subroutines eliminated: None + +Remove bld/offline directory tree + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M bld/Makefile.in ---- Add -DFORTRANUNDERSCORE so can compile mpi-serial on IRIX + +Change run scripts so that spmd and smp settings work for both on AND off + +M bld/run-pc.csh ----------------------- Also add LD_LIBRARY_PATH setting +M bld/run-sgi.csh +M bld/run-lightning.csh + +M src/main/spmdMod.F90 ------------------ Remove #ifdef around #include so will + run serial (this is a partial fix to bug 337. The longer term fix is to remove all + #ifdef SPMD as we can use the mpi-serial code to make the serial and SPMD code the same. + +M src/biogeophys/SoilHydrologyMod.F90 --- New drainage formulation from Keith Oleson + +Summary of testing: + + bluesky: -- All but comparision to previous version + tempest: -- All but comparison to previous version and the following restart tests + (These tests fail on previous versions as well -- documented as bug 361) +002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................FAIL! rc= 11 +003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................FAIL! rc= 11 +005 sm116 TSM.sh 4p_vodsr_o t31 48 ................................FAIL! rc= 4 +007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................FAIL! rc= 11 +008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................FAIL! rc= 11 +012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................FAIL! rc= 11 +013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................FAIL! rc= 11 +016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................FAIL! rc= 11 +017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................FAIL! rc= 11 +020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................FAIL! rc= 11 +021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................FAIL! rc= 11 + (We are going to remove tempest as a standard test for CLM) + + bangkok/lf95: -- All but comparision to previous version + +CLM tag used for the baseline comparison tests if applicable: none + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (similar climate) + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: Cray-XT3/jaguar + - configuration (CPP ifdefs): default + - build-namelist command (or complete namelist): + - MSS location of output: /CCSM/csm/b31.020ws/lnd/hist + + URL for LMWG diagnostics output used to validate new climate: Not yet prepared + +=============================================================== +=============================================================== +Tag name: clm3_expa_88 +Originator(s): nanr +Date: Thu Jan 11 12:31:51 MST 2007 +One-line Summary: Minor formatting change in tools. + Correctons to ChangLog + + +Purpose of changes: +1. Update formatted write in tools/ mkgriddata.F90 and tools/mksrfdat.F90 + to accomodate 4 digit lat/lons. +2. Add note to ChangeLog to explain commit by nanr (10/27) that was not tagged. +3. correct Changelog for tag clm3_expa_80. The changes listed below never happened. + surfFileMod.F90 was actually removed from the trunk in a previous tag (clm3_expa_66) + and renamed surfrdMod.F90. So this modification probably reflects the status of the branch + Keith Oleson was working on. + M src/main/surfFileMod.F90 + + Removed statements contained within CN ifdef (OK'd by P. Thornton) that: + + ! the following test prevents the assignment of temperate deciduous + ! vegetation types in the tropics + ! 1. broadleaf deciduous temperate tree -> broadleaf deciduous tropical tree + ! 2. broadleaf deciduous temperate shrub -> broadleaf deciduous tropical tree + ! this reassignment from shrub to tree is necessary because there is currently no + ! tropical deciduous broadleaf shrub type defined. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: nanr + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M tools/mksurfdata/mksrfdat.F90 +M tools/mkgriddata/mkgriddata.F90 + + Changed formatting strings to accomodate 4 char lat/lons. + OLD: write (resol,'(i3.3,"x",i3.3)') lsmlat,lsmlon + NEW: write (resol,'(i4.4,"x",i4.4)') lsmlat,lsmlon + +Summary of testing: none. Changes only to tools and ChangeLog + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: none + +IF tag changes answers relative to baseline comparison the +following should be filled in: none + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: NA + + URL for LMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== +Tag name: clm3_expa_87 +Originator(s): tcraig, jet +Date: Wed Dec 27 05:03:01 GMT 2006 +One-line Summary: merge fme branch, merge refactor_scam branch + +Purpose of changes: bug fixes, reduce memory usage, improve memory scaling, + add mct package, update scam + +Bugs fixed (include bugzilla ID): + #133 adomain,ldomain compare + #290 time bounds problem in history file + #291 fix rtm history bug on bangkok + #301 modify decomp info in i/o + #321 merge refactor_scam branch + +Describe any changes made to build system: none + + consisting of src, dst, S (COL, ROW, S). update the internal clm + atm/lnd mappings to use new datatype. lnd/rtm and driver/atm + mapping still using gridmap_type. this will be updated in future + versions. +- convert domain from 2d global to 1d global arrays. add glo + decomp which is global 1d indexing like ij to 1d or gsn + uncompressed. +- convert wtxy, vegxy, pctspec from 2d to 1d arrays. migrate many other arrays + from 2d global (i,j) to 1d global. this is for nesting and to eventually + cut down on number of index mappings in decomp_type +- reorganize order of initialization calls to start thinking about nesting +- add gatm array to domain datatype +- clean up dead code. +- rename initSubgridMod to subgridMod +- move map_indexes to subgridMod, rename get_subgrid_indexees +- rearrange a few subroutines to improve filename hierarchy and use logic +- delete get_sn routines, no longer needed +- update indexing in clm_atmlnd, remove hardwire indexes +- rewrite i/o as needed for 1d global arrays, not 2d +- delete gatherWeightsDGVM from DGVMMod.F90, no longer needed +- rename surfFileMod to surfrdMod.F90 +- reduce size of subgrid_type and redefine gcelldc and gcellsn + + +Summary of testing: + + bluesky: clm test passes, cam pretag passes except ccsm + tempest: cam pretag passes + bangkok/lf95: cam pretag passes except bl153, bl353, bl553 due to code + changes and resulting binary produced by compiler optimizations. + also scam fails. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_65, cam3_3_16 + + Summarize any changes to answers: NONE bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_expa_65 +Originator(s): Erik Kluzek +Date: Mon Jul 10 13:52:20 MDT 2006 +One-line Summary: Use share clocks and inputinfo object at driver level + +Purpose of changes: Use new version of esmf_wrf and csm_share as next step + in sequential CCSM development. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: Add ability to use Darwin, add eshr to +Filepath + +Describe any changes made to the namelist: Instead of directing namelist from stdin + explicitly open namelist filename. Change namelist name from clmexp to clm_inparm. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Mariana Vertenstein, Tony Craig, Forrest Hoffman + +Externals changed: csm_share to share3_060710 + esmf_wrf_timemgr to esmf_wrf_timemgr_060616 + +List all subroutines eliminated: None + +List all subroutines added and what they do: control_setNL (controlMod.F90) sets the + namelist filename. + +List all existing files that have been modified, and describe the changes: + +tools/newcprnc/Makefile +bld/offline/tests/CLM_namelist.pm +bld/offline/tests/CLM_lab.pm +bld/offline/tests/CLM.pm +bld/offline/tests/model_specs.csh +bld/offline/tests/configure.csh +bld/offline/tests/config_machine_specs.csh +bld/offline/tests/CLM_run.pm +bld/offline/tests/test_batch.csh +bld/offline/tests/Makefile +bld/offline/jobscript.csh + + Add eshr to Filepath, add Darwin as a valid platform, don't redirect unit 5 for +namelist. Set MODEL_DATDIR explicitly. Use lnd.stdin as default namelist name. +Add "-g" to Makefile. Change clm namelist from clmexp to clm_inparm. Get test_batch.csh +to work both on bangkok for Linux/Lahey and tempest for SGI. Write out Rootdir file +when configuring build directory. + +src/main/time_manager.F90 -- Use dayOfYear_r8 for calc_calday. +src/main/clm_comp.F90 ------ Pass CCSMInit in. +src/main/fileutils.F90 ----- Small changes to how using shr_file_mod. +src/main/initializeMod.F90 - Pass clock in. +src/main/program_csm.F90 --- Change where ESMF_Initialize is done. +src/main/controlMod.F90 ---- Add method to set namelist name, pass clock in and use it. +src/main/clm_varctl.F90 ---- Get rid of cam_ variables. +src/main/lnd_comp_mct.F90 -- Pass in clock and CCSMInit object. + +Summary of testing: + + bluesky: test-batch.csh -- PASS and CAM and CAM CCSM tests pass. + tempest: test-batch.csh -- PASS and CAM tests pass. + bangkok/lf95: test-batch.csh -- PASS and CAM tests pass. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_64 + + Summarize any changes to answers: NONE bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_expa_64 +Originator(s): Dani Bundy Coleman +Date: Thu Jun 29 14:44:07 MDT 2006 +One-line Summary: dust modifications from Natalie Mahowald + +Purpose of changes: update dust code + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mariana Vertenstein + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/biogeochem/DUSTMod.F90 + OLD dmt_vma = 2.524e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + NEW dmt_vma = 3.500e-6_r8 ! [m] Mass median diameter analytic + +M src/main/clm_atmlnd.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) +M src/main/lnd_comp_mct.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) + +Summary of testing: + + bluesky: tested with cam, bfb when DUST and PROGSEASALT not defined + tempest: + bangkok/lf95: tested with cam, bfb when DUST and PROGSEASALT not defined + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_63 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_63 +Originator(s): Mariana Vertenstein +Date: Fri May 12 16:08:03 MDT 2006 +One-line Summary: introduced mct domains in COUP_CAM mode + +Purpose of changes: To introduce generalized mct domains +in COUP_CAM mode for the purposes of generating a sequential +ccsm + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Tony Craig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + lnd_comp_mct.f90 + removed lnd_CheckGrid_mct routine and replaced it with lnd_domain_mct + each processor sends it local domain information stored in an MCT + GeneralGrid data structure back to the top level application driver. + A global gather is done for the GeneralGrid and domain comparison is + performed on the master processor. + +Summary of testing: + + bluesky: only cam test suite was run successfully + tempest: only cam test suite was run successfully + bangkok/lf95: only cam test suite was run successfully + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_62 +Originator(s): erik, tcraig +Date: Wed May 10 00:06:39 MDT 2006 +One-line Summary: merge shrgetput08_clm3_expa_61, fix finemesh bugs + +Purpose of changes: changes required for sequential ccsm. validate + finemesh is running properly. + +Bugs fixed (include bugzilla ID): + a couple finemesh bugs, not documented. + +Describe any changes made to build system: modified makefile slightly + to set HIDE_MPI when SPMD is FALSE, remove HIDE_SHR_MSG + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik, tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +Makefile: + - remove HIDE_SHR_MSG, not needed anymore + - add HIDE_MPI if SPMD is FALSE +SVN_EXTERNALS: + - change csm_share version from share3_051205 to share3_060428 + - change emsf_wrf_timemgr version from esmf_wrf_timemgr_051212 to esmf_wrf_timemgr_060501 +fileutils.F90: + - uses shr_file_mod.F90 routines + - use shr_file_mod syntax for archive_dir (using mss: prefix) +initializeMod.F90: + - add pnamer_bin get +program_csm.F90: + - add ESMF_Initialize call +clm_atmlnd.F90: + - fix bug in call to grid_maparray for finemesh mapping, only affects finemesh runs. +controlMod.F90: + - use shr_file_mod syntax for archive_dir (using mss: prefix) +lnd_comp_mct.F90: + - change call to get_proc_bounds to get_proc_bounds_atm (bug for finemesh runs). +program_off.F90: + - add calls to ESMF_Initialize and ESMF_Finalize + + +Summary of testing: + bluesky: cam full suite bfb + clm full suite not bfb (TS is bfb for 2 days, history file not bfb + after ~1.5 days probably due to new esmf time manager, likely roundoff) + tempest: cam full suite bfb, ccsm build test + bangkok/lf95: cam full suite bfb + bluevista : ccsm TER.01a.1.9x2.5_gx1v3.B.bluevista bfb + cam finemesh T42half.clim0 test, bfb for 42 timesteps vs cam3_2_49 + lightning : ccsm TER.01a.4x5_gx3v5.B.bluevista bfb + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_61, cam3_3_4, ccsm3_1_beta27 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: clm standalone only + - what platforms/compilers: only bluesky tested + - nature of change (roundoff; larger than roundoff/same climate; new climate): + assume roundoff. it's bfb for at least a day. in cam and ccsm mode they + are bfb. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? guess + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== +Tag name: clm3_expa_61 +Originator(s): T Craig +Date: Thu Apr 27 01:10:40 MDT 2006 +One-line Summary: merge cammct05_clm3_expa_58 onto main trunk, + modify surface dataset input + +Purpose of changes: merge branch + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself, developed my MV + +List all subroutines eliminated: + clm_camMod.F90 - interface to cam + MCT_atmlnd_cpl.F90 - mct migrated to sequential driver + MCT_lnd_comp.F90 - mct migrated to sequential driver + +List all subroutines added and what they do: + lnd_comp_mct.F90 - interface to sequential driver using mct coupling + +List all existing files that have been modified, and describe the changes: + clm_comp.F90 - separate init method into init1, init2 + initializeMod.F90 - separate initialize into initialize1 and 2 + program_csm.F90 - add call to clm_init0 + clm_atmlnd.F90 - PWorley's changes to improve phoenix performance, + packed arrays in clm_mapa2l and clm_mapl2a interpolation. + program_off.F90 - add call to clm_init0 + areaMod.F90 - PWorley's changes to improve phoenix performance, + interpolate packed arrays in gridmap_maparray + Hydrology2Mod.F90 - remove use of iam + + mksurfdata, several files changed to convert + mksrf_fgrid_global/regional to mksrf_fgrid and mksrf_gridtype + +Summary of testing: + + bluesky: clm full suite bfb, cam full suite bfb + bluevista: ccsm bfb TER.01a.T31_gx3v5.B.bluevista, TER.01a.4x5_gx3v5.B.bluevista + tempest: cam full suite bfb + bangkok/lf95: cam full suite bfb + + mksrf tested on bluevista, 7 cases, bfb + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_60, cam3_3_2, ccsm3_1_beta25 + +changes are bit-for-bit + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_60 +Originator(s): Forrest Hoffman +Date: Fri Apr 14 11:03:34 EDT 2006 +One-line Summary: Rearranged physiology fields, changed CO2 constants, fixed Bug #43 + +Purpose of changes: Make radiation-related physiology fields standard, prepare code for C-LAMP experiments, and make test-model run on Cray X1E (phoenix) + +Bugs fixed (include bugzilla ID): Bug #43 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +nfwrappers.f90: +Changed intent for ncid from intent(in) to intent(out) since it must be +returned to the calling routines. This fixed Bug #43 which was discovered +on the Cray X1E (phoenix). + +ChangeLog: +Added this log entry. + +clm_varcon.F90: +Changed co2_ppmv_const to 283.1878_r8 for both CASA' and CN in preparation +for Experiment 1 of the C-LAMP. + +histFldsMod.F90 +Moved LAISUN, LAISHA, TLAI, TSAI, SLASUN, and SLASHA out of the CN-only +section of the code so that they appear on the regular CLM output files +since the two-leaf radiation code is now standard. In addition, TLAI and +TSAI were removed from the DGVM-only section of the code since these +output fields are now standard. + +Summary of testing: + + cheetah: +Ran test-model for T31, T31cn, T31cnall, T31casa, and T31dgvm with +baseline clm3_expa_59. T31 and T31dgvm passed all tests. The others +passed tests 01-05, but not the 06_control test because of the change +in co2_ppmv_const. + + phoenix: +Ran test-model for T31, T31cn, T31cnall, T31casa, and T31dgvm with +baseline clm3_expa_59. T31 and T31dgvm passed all tests. The others +passed tests 01-05, but not the 06_control test because of the change +in co2_ppmv_const. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_59 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: co2_ppmv_const modification changes answers + - what platforms/compilers: IBM (cheetah) and Cray X1E (phoenix) + - nature of change (roundoff; larger than roundoff/same climate; new climate): larger than roundoff because of changes in carbon pools + + If bitwise differences were observed, how did you show they were no worse + than roundoff? cprnc + + * There is no validated climate in these model configurations. * + +=============================================================== +=============================================================== +Tag name: clm3_expa_59 +Originator(s): Tony Craig +Date: Wed Apr 5 18:03:23 MDT 2006 +One-line Summary: add fatmlndfrc capability + +Purpose of changes: Support new datasets, other minor improvements, + update mkgrid and mksurf tools for new dataset generation. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: jobscript.csh modified for + new surface datasets, change baseline resolution to T31. + +Describe any changes made to the namelist: added optional fatmlndfrc + namelist input for landfrac file on atm grid. + +List any changes to the defaults for the boundary datasets: all new + grid, frac, and surf datasets generated, located in + /fs/cgd/csm/inputdata/lnd/clm2/[griddata,surfdata] + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +tools/mksurfdata/mkrfdat.F90 - change default output filenames +tools/mksurfdata/mklaiMod.F90 - removed masking since there is no mask anymore +tools/mksurfdata/mkfileMod.F90 - removed read of LANDMASK and LANDFRAC +tools/mksurfdata/creategridMod.F90 - removed write of LANDMASK and LANDFRAC +tools/mksurfdata/Makefile - fix clean bug +tools/mkgriddata/mkgriddata.F90 - add generation of ffracdat file + force area calculation for ccsm domain files due to noise in scrip areas + change default output filenames +tools/mkgriddata/mkvarctl.F90 - add support for area recomputation +tools/mkgriddata/mkfileMod.F90 - removed, merged into creategridMod.F90 +tools/mkgriddata/areaMod.F90 - add flush(6) +tools/mkgriddata/creategridMod.F90 - add mkfile subroutine + fix bug in setting of corner points + handle wrap-around points better with corner points + add ability to adjust units of area (not automatic) + add checks for area + add ability write eigher grid or frac file in write_domain +bld/offline/tests/test_batch.csh - change default version from 53 to 58 + turn on dgvm testing by default +bld/offline/jobscript.csh - change to share queue on bluesky + run mixed mpi/openmp by default, 2x2 + change default resolution to T31 (was T42) + update to use new surface datasets + change default, turn on DUST, RTM, VOC, turn off CN, SUPLN, SUNSHA, STOMATA2 + add unlimit unlimited for AIX + fix redirection to compile_log.clm output file +src/main/initializeMod.F90 - add fatmlndfrc stuff + add computation of ldomain%frac and ldomain%mask +src/main/controlMod.F90 - add fatmlndfrc stuff +src/main/clm_varctl.F90 - add fatmlndfrc stuff +src/main/driver.F90 - remove redundant definition of caldayp1 +src/main/clmtypeInitMod.F90 - remove landfrac variable for clm3 gridcell_type +src/main/histFileMod.F90 - add indxupsc, jndxupsc indices for upscaling +src/main/program_csm.F90 - move shr_msg_stdio to after MPI_INIT, change + call so it only redirects log file for masterproc. this will clean + up the log file significantly but may lead to error messages ending + up in stdout. +src/main/surfFileMod.F90 - add fatmlndfrc stuff +src/main/initGridCellsMod.F90 - remove landfrac variable for clm3 gridcell_type +src/main/domainMod.F90 - reorder domain data slightly (nothing changed) +src/main/areaMod.F90 - change default of i_ovr and j_ovr from bigint to -1, + allows for cleaner writing of indxupsc and jndxupsc in history file. + change gridmap_setmapsFM to use _a and _l notation instead of _i and _o +src/main/clmtype.F90 - remove landfrac from clm3 gridcell_type + + +Summary of testing: + + Baseline versions, clm3_expa_58, cam3_2_56, ccsm3_1_beta24 + + bluesky: clm full suite passes, cam full suite passes + tempest: cam full suite passes + bangkok/lf95: cam full suite passes + bluevista: ccsm TER.01a B passes for several resolutions, new datasets + in scripts + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_58 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Code changes are bfb, but answers may change when using new surface datasets + + Summarize any changes to answers, i.e., + - what code configurations: CCSM answers will change with new datasets as + default datasets are changing. clm default test is bfb at T31 with new datasets, + cam will be bfb as current default datasets are not being updated. + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_58 +Originator(s): Forrest Hoffman +Date: Thu Mar 9 17:04:27 EST 2006 +One-line Summary: Updates for the Cray X1E and a forcing height error check. + +Purpose of changes: Improvements on the Cray X1E and avoiding arithmetic exceptions when the forcing height is below the canopy height. + +Bugs fixed (include bugzilla ID): Bug #36 + +Describe any changes made to build system: jobscript.csh modified for Cray X1E + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself and (for forcing height check code) Mariana Vertenstein + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + + jobscript.csh - Modified for Cray X1E and cross-compiler + inicFileMod.F90 - Added compiler directives for vectorization + driver.F90 - Commented out CSDs to avoid model hangs caused by write + statements in science routines within the associated loops + controlMod.F90 - Changed default clump_pproc to 1 for the Cray (since CSDs + are not used in driver.F90 + histFldsMod.F90 - Changed type2d='levlak' for the TLAKE field + CanopyFluxesMod.F90 - Inserted code to check if the forcing height + is below the canopy height for any pft. Model will now abort when this + occurs instead of taking the log() of a negative number. See Bug #36 + +Summary of testing: + + bluesky: test-model ran as follows +01_debug_run_SPMD: T31 ran +02_debug_run_nonSPMD: T31 ran +03_start: T31 ran +04_restart: T31 ran +05_norestart_compare_to_restart: T31 ran +06_control: T31 ran +01_debug_run_SPMD: T31cn ran +02_debug_run_nonSPMD: T31cn ran +03_start: T31cn ran +04_restart: T31cn ran +05_norestart_compare_to_restart: T31cn ran +06_control: T31cn ran +01_debug_run_SPMD: T31cnall ran +02_debug_run_nonSPMD: T31cnall ran +03_start: T31cnall ran +04_restart: T31cnall ran +05_norestart_compare_to_restart: T31cnall ran +06_control: T31cnall ran +01_debug_run_SPMD: T31casa ran +02_debug_run_nonSPMD: T31casa ran +03_start: T31casa ran +04_restart: T31casa ran +05_norestart_compare_to_restart: T31casa ran +06_control: T31casa ran + cheetah: +01_debug_run_SPMD: T31cnall ran +02_debug_run_nonSPMD: T31cnall ran +03_start: T31cnall ran +04_restart: T31cnall ran +05_norestart_compare_to_restart: T31cnall ran +06_control: T31cnall ran +01_debug_run_SPMD: T31 ran +02_debug_run_nonSPMD: T31 ran +03_start: T31 ran +04_restart: T31 ran +05_norestart_compare_to_restart: T31 ran +06_control: T31 ran +01_debug_run_SPMD: T31cn ran +02_debug_run_nonSPMD: T31cn ran +03_start: T31cn ran +04_restart: T31cn ran +05_norestart_compare_to_restart: T31cn ran +06_control: T31cn ran +01_debug_run_SPMD: T31casa ran +02_debug_run_nonSPMD: T31casa ran +03_start: T31casa ran +04_restart: T31casa ran +05_norestart_compare_to_restart: T31casa ran +06_control: T31casa ran + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_57 + +=============================================================== +Tag name: clm3_expa_57 +Originator(s): Peter Thornton +Date: 31 Jan 2006 +One-line Summary: Mods to allow switching between 3 and 4 soil + organic matter pools + +Purpose of changes: New science. + +Bugs fixed (include bugzilla ID): bugs in pftdynMod.F90 and ndepfileMod.F90 + +Describe any changes made to build system: + +Describe any changes made to the namelist: Added SOM4 as new CPP directive + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +main/clmtype.F90: added soil4c (and 13C equiv.), soil4n states and associated + flux variables. Also added long name commenting for many previously defined + variables. +main/clmtypeInitMod.F90: added initialization for new variables +main/CNiniTimeVar.F90: initialize new state variables. +main/histFldsMod.F90: added new variables, and also added long names for + many previously defined variables. +main/pftdynMod.F90: bug fix in mpi_bcast, change MPI_REAL8 to MPI_INTEGER. +main/ndepFileMod.F90: bug fix for mpi_bcast, change MPI_REAL8 to MPI_INTEGER. +biogeochem/CNSetValueMod.F90: add code for new state and flux variables. +biogeochem/CNDecompMod.F90: add code to allow either 3 or 4 SOM pools. Default + behavior is 3 pools, 4-pool behavior triggered by SOM4 CPP directive. +biogeochem/CNCStateUpdate1Mod.F90: handling for new variables. +biogeochem/CNNStateUpdate1Mod.F90: handling for new variables. +biogeochem/CNSummaryMod.F90: handling for new variables. +biogeochem/CNBalanceCheckMod.F90: handling for new variables +biogeochem/CNPrecisionControlMod.F90: handling for new variables +biogeochem/CNC13FluxMod.F90: handling for isotope version of new variables +biogeochem/C13StateUpdate1Mod.F90: handling for new variables +biogeochem/C13SummaryMod.F90: handling for new variables +biogeochem/CNrestMod.F90: handling for new variables, and modify EXIT_SPINUP + controls + +Summary of testing: + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: in 3-pool mode +(SOM4 not set), results are bfb with clm3_expa_55. in 4-pool mode, changes +answers, as expected. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: +bfb under 3-pools is demonstrated at: +http:/www.cgd.ucar.edu/tss/clm/diagnostics/clm3cn/c13/ccsm3_bgc31_I_5a-ccsm3_bgc31_I_2b/setsIndex.html + +=============================================================== +Tag name: clm3_expa_56 +Originator(s): Tony Craig +Date: 31 Jan 2006 +One-line Summary: Final changes for finemesh implementation. + +Purpose of changes: Integrate final changes for finemesh implementation. These +changes are 100% backward compatable and bfb, but also support use of a finemesh grid. finemesh implementation has been test in clm and cam. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Update Makefile so Depends are regenerated if any code is changed. + +Describe any changes made to the namelist: Added one new optional namelist, fatmgrid. This is a dataset for the coarse grid in clm. The format is the same as the surface dataset but only needs to include grid variables. + +List any changes to the defaults for the boundary datasets: Generated some new datasets with filled wetland and higher resolution. Not required and not yet added to default suite of datasets. + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +tools/mksurfdata: + mksrfdat.F90,areaMod.F90,creategridMod.F90 +bld/offline/Makefile +doc/ChangeLog + src/main: +clm_comp.F90,driver.F90,clm_camMod.F90,atmdrvMod.F90,clmtypeInitMod.F90,initializeMod.F90,histFileMod.F90,program_csm.F90,clm_atmlnd.F90,clm_csmMod.F90,surfFileMod.F90,controlMod.F90,clm_varctl.F90,initGridCellsMod.F90,MCT_lnd_comp.F90,program_off.F90,domainMod.F90,decompMod.F90,areaMod.F90,clmtype.F90 +src/biogeophys/SurfaceAlbedoMod.F90 + +Code changes: +add pftm to domain datatype and history file +modify program_off and program_cs to use clm_init[1,2], clm_run[1,2] +modify coupling to handle coarse <-> finemesh for standlaone, cam, and + ccsm. +modify Makefile so depends file is reset whenever there is a code change +add normalized area to history files +add lat_a, lon_a, latdeg_a, londeg_a to clm3 datatype for atm lats/lons. + required in SurfaceAlbedo computation where the the zenith angle has + to be based on the atm (coarse) grid, not the fine clm grid. +merge with clm3_expa_53_brnchT_cam01 tag + +Summary of testing: + + bluesky: clm full suite bfb, cam full suite bfb, ccsm bfb + tempest: cam full suite bfb + bangkok/lf95: cam full suite bfb + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_55 + +IF tag changes answers relative to baseline comparison the +following should be filled in: bfb + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? bfb + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_55 +Originator(s): Peter Thornton +Date: 24 Jan 2006 +One-line Summary: Fixes for 13C isotope code, migration from cvs + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +Files modified: +1. CNFireMod.F90 +Added initialization of variable mep. + +2. CNrestMod.F90 +Added EXIT_SPINUP controls on column-level 13C pools + +3. C13SummaryMod.F90 +Added current and excess maintenance respiration terms to summary MR variable. + +4. CNC13FluxMod.F90 +Added new routines to calculate 13C fluxes. Litter to column, non-mortality fluxes +at the column level, pft-level gap mortality fluxes, pft and column level fire mortality fluxes, + +5. CNEcosystemDynMod.F90 +Added calls for C13Flux2, C13Flux3, C13StateUpdate2, and C13StateUpdate3. + +6. clm_varcon.F90 +Added parameters to define a fixed pre_industrial del13C (set to -6 permil) + +Summary of testing: + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_40 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +Changes answers for CN only, and then only for the isotope prognostics. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/tss/clm/diagnostics/clm3cn/c13/ccsm3_bgc31_I_2a-ccsm3_bgc26_I_1d/setsIndex.html +=============================================================== +Tag name: clm3_expa_54 +Originator(s): Tony Craig +Date: 17 Jan 2006 +One-line Summary: Update infrastructure in support of finemesh, migration from cvs + +Purpose of changes: bfb infrastructure changes committed, partial step towards finemesh implementation + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Some memory added for extra coarse grid, atmosphere domain, as well as changes to interpolation datatypes and code. Redundant memory deleted from some datasets. + +Code reviewed by: Mariana Vertenstein + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +src/main: +initGridIndexMod.F90,lnd2atmMod.F90,CNiniTimeVar.F90,abortutils.F90,clm_comp.F90,driver.F90,clm_camMod.F90,atmdrvMod.F90,subgridRestMod.F90,accFldsMod.F90,clmtypeInitMod.F90,initializeMod.F90,pftdynMod.F90,iniTimeConst.F90,histFileMod.F90,program_csm.F90,clm_atmlnd.F90,clm_varsur.F90,clm_csmMod.F90,restFileMod.F90,surfFileMod.F90,controlMod.F90,initSurfAlbMod.F90,initSubgridMod.F90,clm_varctl.F90,ndepFileMod.F90,initGridCellsMod.F90,MCT_lnd_comp.F90,program_off.F90,domainMod.F90,decompMod.F90,areaMod.F90,clmtype.F90,histFldsMod.F90 + +src/riverroute: +RtmMod.F90 + +src/biogeochem: +CASAMod.F90,DUSTMod.F90,CNPhenologyMod.F90,STATICEcosysDynMod.F90,DGVMMod.F90,CNrestMod.F90,VOCEmissionMod.F90,CNNDynamicsMod.F90,CNVegStructUpdateMod.F90 + +src/biogeophys: +BalanceCheckMod.F90,SurfaceRadiationMod.F90,SoilTemperatureMod.F90,Biogeophysics1Mod.F90,Biogeophysics2Mod.F90,FrictionVelocityMod.F90,Hydrology1Mod.F90,Hydrology2Mod.F90,BiogeophysicsLakeMod.F90,HydrologyLakeMod.F90,BareGroundFluxesMod.F90,CanopyFluxesMod.F90 + +bld/offline/tests: +CLM_lab.pm,test_batch.csh + +tools/mksurfdata: +mkdynpftMod.F90,mkgridMod.F90,shr_timer_mod.F90,mklaiMod.F90,mkglacier.F90,mkurban.F90,fileutils.F90,mksoitex.F90,mkfileMod.F90,domainMod.F90,areaMod.F90,creategridMod.F90,mkvarsur.F90,mksrfdat.F90,nanMod.F90,mklanwat.F90,mksoicol.F90,Makefile,mkpftMod.F90 + +tools/mkgriddata: +mkvarctl.F90,fileutils.F90,mkgriddata.F90,mkfileMod.F90,domainMod.F90,areaMod.F90,creategridMod.F90,mkvarsur.F90,nanMod.F90,Makefile + +Code changes: +Merge atm2lnd_state_type, atm2lnd_flux_type. Same for lnd2atm state/flux. + Related changes in clm3 and elsewhere in code. +Add domainMod.F90 and domain_type. Migrate grid data into domain type. + Instantiate adomain(atm/coarse), ldomain(lnd/finemesh), rdomain(rtm), + ddomain(atmdrv external data) in model. +Add lats, latn, lonw, lone 2d arrays and associated code changes. +Cleanup areaMod.F90; merging subroutines, removing redundant code, eliminate + *_point routines. +Remove numlon +Add decomp_type for gcelldc and gcellsn. Remove redundant data in other + arrays related to addressing physical space and logical space. +Clean up interface in set_landunit subroutines. Remove redundant code. +Clean up procs and clumps datatypes, removing redundant data. +Migrate clm3 topology data to pointers from copies +Add gridmap_type for interpolation and associated code and routines to + support the type. +Add clm_atmlnd.F90 file for upscale/downscale code. Add clm_mapa2l + and clm_mapl2a to carry out mapping associated with upscale/downscale. +Add gridmap_setmapsFM for generation of weights for downscale/upscale + routines. +forc_ndep should not be in atm2lnd_type. +Reuse code as much as possible throughout. +Update mksurfdata, mkgriddata. Speed code up, bfb, new fields added, + new input options for files. Fill with wetland, add PFTDATA_MASK + field for real/fake land. +Update code to clm3_expa_53 +Rename latixy and longxy to latc and lonc. +Remove fullgrid attribute. + +Summary of testing: + + bluesky: full clm test, full cam test + tempest: full cam test + bangkok/lf95: full cam test + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_53 + +IF tag changes answers relative to baseline comparison the +following should be filled in: bfb + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? bfb + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_53 +Originator(s): Mariana Vertenstein +Date: Fri Dec.16 2005 +One-line Summary: Put in MCT communication for cam-clm coupling + +Purpose of changes: removed lp_coupling communication and put in +MCT communication interfaces + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the input datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mariana Vertenstein, Rob Jacob + +List all subroutines eliminated: none + +List all subroutines added and what they do: + main/MCT_atmlnd_cpl.F90 + clm/cam MCT coupling interface - will be moved out of clm code in + near future + main/MCT_lnd_comp.F90 + clm MCT wrapper layer + main/clm_comp.F90 + module containing wrapper routines that separate clm into chunks of + code that contain no communication (e.g. clm_run1, clm_run2 has no + communicaiton). This is needed to satisfy requirement for implementing + multiple coupling interfaces (e.g. concurrent/MCT, sequential/MCT, + sequential/ESMF) within ccsm. + main/clm_varorb.F90 + module for orbital parameters + (this will be added to program_off.F90 and program_csm.F90) + +List all existing files that have been modified, and describe the changes: + clm_camMod.F90 - all coupling still exists here + +Summary of testing: + + bluesky: + test-model.pl -res T31 + test-model.pl -res T31cn + test-model.pl -res T31cnall + test-model.pl -res T31casa + test-model.pl -res T31dgvm + + tempest: No testing + + bangkok/lf95: No testing + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_48 + results were bfb with clm3_expa48 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_52 +Originator(s): Mariana Vertenstein +Date: Tues Dec.12 2005 +One-line Summary: Put in scam fix needed in CAM mode + +Purpose of changes: clean up svn clm structure + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +None + +Describe any changes made to the namelist: +None + +List any changes to the defaults for the input datasets: +None + +Describe any substantial timing or memory changes: +None + +Code reviewed by: +Mariana Vertenstein + +List all subroutines eliminated: +None + +List all subroutines added and what they do: +None + +List all existing files that have been modified, and describe the changes: +clm_camMod.F90 (this change was put into cam3_2_41) + +Summary of testing: +No testing done + +CLM tag used for the baseline comparison tests if applicable: +NA + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_51 +Originator(s): mvr +Date: Tues Dec.12 2005 +One-line Summary: removed src/utils dir + +Purpose of changes: should've been done with external setup in prev tag + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the input datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvr, mvertens + +List all subroutines eliminated: +D src/utils + +List all subroutines added and what they do: +none + +List all existing files that have been modified, and describe the changes: +none + +Summary of testing: + +bluesky: none +tempest: none +bangkok/lf95: none + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? b4b + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_50 +Originator(s): Mariana Vertenstein +Date: Tues Dec.12 2005 +One-line Summary: Updated external definitions for utils + +Purpose of changes: clean up svn clm structure + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +None + +Describe any changes made to the namelist: +None + +List any changes to the defaults for the input datasets: +None + +Describe any substantial timing or memory changes: +None + +Code reviewed by: +NA + +List all subroutines eliminated: +None + +List all subroutines added and what they do: +None + +List all existing files that have been modified, and describe the changes: +None + +Summary of testing: +No testing done + +CLM tag used for the baseline comparison tests if applicable: +NA + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_49 +Originator(s): Mariana Vertenstein +Date: Mon Dec 12 2005 +One-line Summary: Updated clm with changes put into cam3_2_38 + +Purpose of changes: +Cray-X1E OpenMP/CSD compatibility modifications. + +Bugs fixed (include bugzilla ID): +None + +Describe any changes made to build system: +None + +Tested that restarts are bit-for-bit: yes +Tested that different domain decompositions match bit-for-bit: yes +Code reviewed by: myself +Changes answers: no (bit-for-bit) +Changes made: + +This is the start of the clm_exp experimental development +branch. This version is the same as clm3_deva_10 which was checked +into clm_dev by Mariana Vertenstein on April 27th, 2004. +=============================================================== +=============================================================== +=============================================================== + + + + + + + + + + + + + + + + + + + + + diff --git a/ChangeSum b/ChangeSum new file mode 100644 index 0000000000..505427874e --- /dev/null +++ b/ChangeSum @@ -0,0 +1,335 @@ +Tag Who Date Summary +============================================================================================================================ + clm4_5_1_r120 andre 08/29/2015 CLM 5 nitrogen models Flexible CN and LUNA + clm4_5_1_r119 erik 08/26/2015 Bring hobart/nag bug fixes to trunk, and fix a few bugs + clm4_5_1_r118 sacks 08/05/2015 Minor rework of glc coupling fields + clm4_5_1_r117 sacks 07/28/2015 Repartition rain vs. snow from atmosphere + clm4_5_1_r116 sacks 07/22/2015 Rename some history fields + clm4_5_1_r115 sacks 07/15/2015 Remove redundant code, rename a variable + clm4_5_1_r114 sacks 07/10/2015 Update cime external, remove genf90-generated files + clm4_5_1_r113 sacks 07/09/2015 Support backwards compatibility of restart variable names + clm4_5_1_r112 oleson 07/01/2015 Justin Perket snow on vegetation + clm4_5_1_r111 sacks 06/12/2015 Remove temporary hack to get bfb results in InitSnowLayers + clm4_5_1_r110 sacks 06/12/2015 Add flexibility to have more snow layers + clm4_5_1_r109 sacks 06/06/2015 Fix bug in DivideSnowLayers + clm4_5_1_r108 andre 05/29/2015 Crop changes from Sam Levis + clm4_5_1_r107 andre 05/19/2015 Update externals to use github version of cime1.0.7. + clm4_5_1_r106 erik 05/14/2015 Fix CO2 forcing for MEGAN + clm4_5_1_r105 erik 04/16/2015 Move test lists to beneath active components, change build scripts from cshell to perl, move to new cime directory structure + clm4_5_1_r104 erik 01/27/2015 Update externals to latest cesm beta tag + bring in shared build for clm4_5/clm5_0 for testing + clm4_5_1_r103 sacks 01/01/2015 enable transient crops + clm4_5_1_r102 sacks 12/27/2014 make new input datasets to support transient crops + clm4_5_1_r101 sacks 12/09/2014 rework cold start initialization for transient runs + clm4_5_1_r100 sacks 12/03/2014 update pio calls to pio2 API + clm4_5_1_r099 sacks 12/02/2014 add ozone stress code from Danica Lombardozzi + clm4_5_1_r098 sacks 11/29/2014 update externals to cesm1_3_beta14 or beyond + clm4_5_1_r097 mvertens 11/24/2014 major refactorization to introduce new soilbiogeochem data types and routines that are independent of either ED or CN datatypes + clm4_5_1_r096 erik 11/19/2014 Several answer changing bug-fixes: snow grain size, lake hydrology, default settings, organic soil + clm4_5_1_r095 andre 11/10/2014 N comp refactoring by Jinyun Tang (LBL) and transpiration sink isolation by Gautam Bisht (LBL) + clm4_5_1_r094 sacks 11/07/2014 misc. glacier-related updates + clm4_5_1_r093 sacks 11/07/2014 change cold-start snow initialization, update cism external + clm4_5_1_r092 muszala 11/04/2014 bug fixes from santos that address valgrind problems. update rtm external + clm4_5_1_r091 muszala 10/27/2014 update externals. fix bug so CLM runs with Intel 14x. + clm4_5_1_r090 sacks 10/16/2014 modularize irrigation; do some unit test rework + clm4_5_1_r089 erik 10/13/2014 Bring new urban building temperature to trunk as a clm5.0 feature as well as human-stress index calculations + clm4_5_1_r088 muszala 10/01/2014 pull out ED deps. in TemperatureTypeMod, can now compile with pgi 14.7 + clm4_5_1_r087 erik 09/30/2014 Fix two balance check errors, and turn abort for balance check back on to appropriate levels + clm4_5_1_r086 muszala 09/25/2014 critical ED modifications from r fisher, fix bug 2043 + clm4_5_1_r085 sacks 09/19/2014 replace conditionals with polymorphism for soil water retention curve + clm4_5_1_r084 sacks 09/18/2014 make glc_dyn_runoff_routing spatially-varying, based on input from glc + clm4_5_1_r083 muszala 09/17/2014 only update scripts and run new baselines. this due to an error in yellowstone pgi test naming (clm_aux45 changed to aux_clm45) + clm4_5_1_r082 muszala 09/11/2014 Merge in a number of ED changes to address science bugs and infrastructure (partiulararly restarts) + clm4_5_1_r081 mvertens 08/24/2014 major infrastructure changes and directory reorganization under src + clm4_5_1_r080 erik 08/16/2014 Update externals to trunk version, allow eighth degree as a valid resolution + clm4_5_1_r079 andre 07/31/2014 G. Bisht (LBL) soil temperature refactor; machines update for goldbach-intel + clm4_5_1_r078 muszala 07/23/2014 add lai stream capability and the ability to run with V5 cruncep data + clm4_5_1_r077 andre 07/10/2014 Refactor from Jinyun Tang (LBL) to make hydrology more modular. + clm4_5_1_r076 erik 07/07/2014 Answer changes for fire code from Fang Li + clm4_5_75 muszala 05/30/2014 update externals to rtm1_0_38 and esmf_wrf_timemgr_140523 + clm4_5_74 sacks 05/28/2014 misc. bfb changes - see detailed summary below + clm4_5_73 erik 05/28/2014 Add the stub ability for clm5_0 physics to CLM build system + clm4_5_72 muszala 05/05/2014 Introduce code for Ecosystem Demography (CLM(ED)) Model + clm4_5_71 sacks 05/02/2014 2-way feedbacks for glacier, veg columns compute glacier SMB, and related changes + clm4_5_70 muszala 04/18/2014 bring in SHR_ASSERT macros + clm4_5_69 andre 03/18/2014 start unit testing build-namelist + clm4_5_68 erik 03/07/2014 Update scripts to version that turns on transient CO2 streams for transient compsets, and update CISM (changes answers) + clm4_5_67 mvertens 03/06/2014 removed initSurfAlb as part of the initialization + clm4_5_66 mvertens 03/03/2014 refactoring of initialization and introduction of run-time finidat interpolation + clm4_5_65 mvertens 02/25/2014 Turn off MEGAN vocs when crops is running + clm4_5_64 muszala 02/19/2014 fix and clean ncdio_pio.F90.in. clean clm_time_manager. update externals. + clm4_5_63 sacks 02/14/2014 add some code needed for dynamic landunits; activate 0-weight veg landunit sometimes + clm4_5_62 erik 02/10/2014 Get PTCLM working robustly, US-UMB test working, add CO2 streams to datm, add more consistency testing between compsets and user settings + clm4_5_61 sacks 02/04/2014 add 3-d snow history fields; continue harvest past end of pftdyn timeseries + clm4_5_60 andre 01/30/2014 refactor build-namelist + clm4_5_59 sacks 01/22/2014 use new get_curr_yearfrac function in clm_time_manager + clm4_5_58 sacks 01/22/2014 major refactor of transient pft code, in prep for dynamic landunits + clm4_5_57 sacks 01/07/2014 change CNDV water conservation to use the pftdyn method + clm4_5_56 sacks 01/02/2014 update scripts external to fix I20TRCLM45BGC compset + clm4_5_55 sacks 12/27/2013 add hooks to Sean Santos's unit test frameworks, and begin to add CLM unit tests + clm4_5_54 sacks 12/27/2013 update externals to cesm1_3_beta06 + clm4_5_53 muszala 12/19/2013 refactor restart interfaces + clm4_5_52 sacks 11/26/2013 turn on longwave radiation downscaling for glc_mec by default + clm4_5_51 sacks 11/26/2013 rework downscaling of atm fields for glc_mec + clm4_5_50 erik 11/24/2013 Bring in a bunch of b4b bugfixes, fix getregional script, start move of PTCLM to PTCLMmkdata tool + clm4_5_49 muszala 11/16/2013 swenson anomaly forcing - part 1 + clm4_5_48 muszala 11/14/2013 bug fixes for CLM dry deposition and MEGAN VOC emissions + clm4_5_47 muszala 11/12/2013 fix Bug 1858 - AGDD now reset annually + clm4_5_46 sacks 11/08/2013 remove zeroing out of slope for special landunits + clm4_5_45 sacks 11/08/2013 refactor daylength calculation, and other minor changes + clm4_5_44 sacks 11/08/2013 temporary hack to daylength initialization to provide baselines for the next tag + clm4_5_43 sacks 11/06/2013 allocate memory for most landunits in every grid cell (needed for dynamic landunits) + clm4_5_42 sacks 11/04/2013 fix bug 1857 for CLM4.5 - CNDV running temperature means are incorrect + clm4_5_41 andre 10/30/2013 update scripts to convert clm4_5 CPP flags to namelist variables. + clm4_5_40 muszala 10/24/2013 fix Bug 1752 - urban conductances depend on weights in an undesirable way + clm4_5_39 muszala 10/23/2013 bug fix from santos - h2osoi_vol not passed to atmosphere model on restart + clm4_5_38 sacks 10/18/2013 change irrigation variables to be pft-level + clm4_5_37 muszala 10/10/2013 Modifications to bring clm up to date with major driver refactoring in drvseq5_0_01 + clm4_5_36 sacks 10/04/2013 new surface datasets, and other minor fixes + clm4_5_35 sacks 10/01/2013 get CLM running on edison + clm4_5_34 erik 09/30/2013 Get PTCLM working, fix a few small bugs + clm4_5_33 muszala 09/26/2013 clean up from mistakes in previous tag + clm4_5_32 muszala 09/26/2013 bug fix tag - 1798, 1810 + clm4_5_31 sacks 09/25/2013 fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + clm4_5_30 sacks 09/24/2013 fix performance bug in decomposition initialization + clm4_5_29 sacks 09/24/2013 fix threading in CLM4.5, and other misc fixes + clm4_5_28 sacks 09/20/2013 fix FracH2oSfc bug + clm4_5_27 sacks 09/20/2013 fix crop nyrs bug + clm4_5_26 muszala 09/19/2013 water balance and SMS_Ly1.f19_g16.ICLM45BGCCROP fix + clm4_5_25 erik 09/13/2013 Bring in Tony's changes to kick sno all the way up to the coupler layer, makes all + CESM components more similar to each other + clm4_5_24 sacks 09/03/2013 update externals to cesm1_3_beta02 or later + clm4_5_23 muszala 08/22/2013 refactor to allow CH4 params. to be read from netcdf file and clean up clm4_5_20 + clm4_5_22 muszala 07/30/2013 aux_clm testlist reorganization + clm4_5_21 muszala 07/24/2013 ifdef and bounds refactor + clm4_5_20 muszala 07/20/2013 refactor to allow CN and BGC params. to be read from netcdf file + clm4_5_19 sacks 07/17/2013 fix setting of bd in iniTimeConst + clm4_5_18 sacks 07/09/2013 rework urban indexing + clm4_5_17 sacks 07/03/2013 misc cleanup and bug fixes + clm4_5_16 sacks 07/02/2013 only run filters over 'active' points + clm4_5_15 muszala 07/01/2013 complete associate refactor for pointers in clm4_5 source + clm4_5_14 muszala 06/20/2013 preparation for associate refactor in clm4_5_15 + clm4_5_13 andre 06/14/2013 hydrology reordering from Jinyun Tang + clm4_5_12 muszala 06/13/2013 NoVS test, NAG mods and remove TWS from restart file + clm4_5_11 sacks 06/11/2013 Change pct_pft and related surface dataset variables to be % of landunit + clm4_5_10 muszala 06/10/2013 refactor clmtype + clm4_5_09 muszala 06/04/2013 volr and vic fix, update mct and rtm + clm4_5_08 muszala 06/03/2013 port for NAG compiler + clm4_5_07 erik 05/31/2013 New spinup files for CLM45 AND RTM, work on PTCLM, turn drydep off by default, update externals + clm4_5_06 erik 05/15/2013 A few small bug fixes, more updates to README files + clm4_5_05 muszala 05/14/2013 hcru bug fixes + clm4_5_04 erik 05/13/2013 Fix the previous broken tag + clm4_5_03 erik 05/10/2013 Several bug fixes for release, urban and test single point surface datasets + clm4_5_02 sacks 05/07/2013 make 'shared' tools directory, and other minor tools fixes + clm4_5_01 muszala 05/06/2013 update externals + clm4_5_00 erik 05/02/2013 Official end to CLM4.5 development for CLM offline + clm4_0_81 bandre 04/29/2013 Charlie Koven's variable consolidation, cryoturbation and BSW CPP changes + clm4_0_80 erik 04/26/2013 Bring Fang Li. Fire model into CLM4.5 science, update ALL CLM4.5 surface datasets, + provide a working initial condition file for CLM45BGC@f19_g16-1850 + clm4_0_79 muszala 04/24/2013 pftdyn, pft-phys*.nc and datm8 update + clm4_0_78 muszala 04/23/2013 MEGAN fixes + clm4_0_77 sacks 04/23/2013 fix carbon balance bug in transient runs with VERTSOI, and fix Soil Hydrology bug + clm4_0_76 muszala 04/22/2013 spinup changes from Charlie Koven (part 1) + clm4_0_75 muszala 04/19/2013 run propset + clm4_0_74 muszala 04/17/2013 snow_depth changes, major scripts overhaul, bug fix for tools + clm4_0_73 sacks 04/15/2013 update mksurfdata_map for CLM4.5, and other misc. updates, mainly to tools + clm4_0_72 muszala 04/11/2013 maoyi bug fix for vic hydro + clm4_0_71 muszala 04/10/2013 compsets refactoring by mvertens + clm4_0_70 muszala 04/01/2013 bring in vic hydrology + clm4_0_69 muszala 03/26/2013 remove hydro reorder, volr and esmf mods + clm4_0_68 erik 03/16/2013 Fix some issues in mksurfdata_map for generation of ne120np surface data file. + Put error back in CLM if weights don't sum to 100. Add in Keith's photosynthesis change for CLM45. + clm4_0_67 muszala 03/12/2013 Jinyun photosynthesis and hydrology reorder + clm4_0_66 sacks 03/07/2013 turn off subgrid topography snow parameterization for glc_mec landunits + clm4_0_65 sacks 03/07/2013 back out Machines external to get more tests to pass, especially IG + clm4_0_64 muszala 03/06/2013 update externals. fixes 40/45 intial condition problem + clm4_0_63 muszala 03/04/2013 bug 1635 fix - 4_0 CN bug + clm4_0_62 sacks 02/24/2013 add active flags, change subgrid weighting convention, other misc fixes + clm4_0_61 muszala 02/20/2013 rtm, drv and clm mods: tws, olr, r01 rdric file and SoilHydroMod + clm4_0_60 erik 02/11/2013 Bring CLM4.5 code from clm45sci branch to trunk as an option set at configure time + clm4_0_59 mvertens 12/20/2012 restructure clmtype and all pointer references, new directory structure + clm4_0_58 erik 12/14/2012 Uncomment us20 and wus12 datasets, more testing to: bluefire, yellowstone, frankfurt + clm4_0_57 muszala 11/30/2012 update trunk with release mods, some rtm fixes + clm4_0_56 sacks 11/27/2012 fix s2x tsrf, add s2x diagnostics + clm4_0_55 muszala 11/14/2012 bring in flooding capability + clm4_0_54 erik 10/09/2012 Fix esmf for carma field, fix some CLM_USRDAT issues + clm4_0_53 erik 10/03/2012 Update to fsurdat, fpftdyn, finidat datasets, new high resolution organic/fmax/glacier raw datasets + clm4_0_52 sacks 09/27/2012 new pct_glacier raw data file + clm4_0_51 muszala 09/26/2012 bug fixes, pio performance and SCRIP files + clm4_0_50 muszala 09/21/2012 testing of clm and new rof component + clm4_0_49 erik 09/16/2012 Move clm testing to use CESM test framework + clm4_0_48 muszala 09/11/2012 bug fixes, xFail to tests and normalize test output for CLM + clm4_0_47 muszala 08/23/2012 bug fixes + clm4_0_46 muszala 08/08/2012 R01 support and update externals + clm4_0_45 sacks 07/20/2012 fix virtual columns; new urban mksurfdata_map + clm4_0_44 erik 07/09/2012 Add wrf resolutions, update externals to cesm1_1_beta15, all components use build-namelist now + clm4_0_43 sacks 04/06/2012 Add diagnostic fields, modify some existing history fields + clm4_0_42 erik 03/27/2012 Bring in Francis Vitt's MEGAN changes. + clm4_0_41 erik 03/13/2012 Bring rmfmesh/rtmmap branches to trunk + clm4_0_40 erik 02/16/2012 Back out update to new T31 surface datasets + clm4_0_39 erik 02/01/2012 Bring newgrid branch to trunk + clm4_0_38 erik 01/23/2012 Fix f09 surface datasets + clm4_0_37 erik 09/26/2011 Fix unstructured grids history files + clm4_0_36 erik 09/22/2011 Comment out RTM mapping files for f09 and f19 + clm4_0_35 erik 09/13/2011 Bring in Mariana's non2D grid branch to trunk, enabling HOMME grids: ne30np4/ne120np4 + clm4_0_34 erik 08/18/2011 Bring tcens branch to trunk, fix a few issues + clm4_0_33 erik 07/25/2011 Move changes on release branch over to trunk + clm4_0_32 erik 05/19/2011 Make I1850SPINUPCN compset use MOAR data, various bug fixes, work on test lists + clm4_0_31 erik 05/13/2011 Fix answers for transient_CN, fix interpinic + clm4_0_30 erik 05/11/2011 New finidat/fsurdat files for T31 + clm4_0_29 erik 05/05/2011 Backout interpinic changes to one that works + clm4_0_28 erik 05/03/2011 Remove DUST/PROGSSLT in land coupler layer, update driver and scripts + clm4_0_27 erik 05/02/2011 Move crop branch over to trunk + clm4_0_26 erik 03/23/2011 Update externals, driver update changes answers, drydep changes from fvitt, fix bugs + clm4_0_25 erik 03/22/2011 Always output restart-history files add more meta-data to them, fix urbanc_alpha and 2.5x3.33 datasets, Changes from Keith O on SNOWLIQ/SNOWICE + clm4_0_24 erik 02/09/2011 Fix mksurfdata and add ability to override soil_fmax + clm4_0_23 erik 02/03/2011 Add in new glacier-MEC use-cases + clm4_0_22 erik 01/20/2011 Move coupler field indicies to clm, move cpl_* directories up a level, add the cpl_share directory + clm4_0_21 jedwards 01/12/2011 Remove includes, finish PIO transition + clm4_0_20 erik 01/11/2011 Update for ESMF metadata, update doc. from release branch, bug fixes (doc of qflx_evap_tot, threading CNDV, aer/ndepregrid) + clm4_0_19 erik 12/08/2010 Bring irrigation branch to the trunk + clm4_0_18 erik 11/21/2010 Fix a problem with the clm template, update scripts version to fix bug with linking with ESMF + clm4_0_17 erik 11/20/2010 Update to externals that change answers to roundoff, use drv pio namelist, add in T341 datasets + clm4_0_16 erik/mverten 10/27/2010 Fix downscaling roundoff difference for same-grids by copying scale factor when needed + clm4_0_15 erik/mverten 10/24/2010 Move pio branch to trunk + clm4_0_14 erik 10/19/2010 Fix finidat file for T31 sim_year=2000 cases + clm4_0_13 erik 10/16/2010 Bring in PTCLM branch, add in T31 finidat file and turn off ice_runoff for T31 + clm4_0_12 erik 09/10/2010 Add U10 to history, cesm1_0_rel06 updates, PTCLM02 updates (except mksurfdata), remove ndepdat/dyn/faerdep + clm4_0_11 erik 08/27/2010 New files for rcp6, fix MPI bug, update externals + clm4_0_10 erik 08/04/2010 Update doc to cesm_rel05, bug-fixes, fix issues for single-point, mksurfdata/getregional scripts + clm4_0_09 erik 06/14/2010 Fix some small issues, update documentation, and externals + clm4_0_08 erik 06/04/2010 Snow hydrology bug fix from Keith and Dave + clm4_0_07 erik 06/03/2010 Some cleanup/fix bugs, add RTM var, add albice to namelist, allow last-millenium in mksurfdata, allow setting of datm_presaero in clm test-suite + clm4_0_06 erik 05/26/2010 Update gglc to cism + clm4_0_05 erik 05/25/2010 Move Nitrogen deposition stream branch to trunk + clm4_0_04 erik 05/20/2010 New namelist items: ice_runoff, scaled_harvest, carbon_only, + new RTM hist vars, new finidat files, update esmf interface, turn off aerosol read quicker + clm4_0_03 erik 05/17/2010 Changes from Francis for VOC and drydep + clm4_0_02 erik 05/13/2010 Make sure dtime is initialized, so that answers are consistently the same as clm4_0_00 + clm4_0_01 erik 05/11/2010 Move glacier multiple elevation class branch to the trunk so that we can work with the active glacier model + clm4_0_00 erik 05/04/2010 Update to datm8, redirect aquifer overflow + to drainage, add gx3v7 masks, script to extract regional + datasets, add harvesting for CN, modify shrubs, include urban + model, ice stream for snowcapping, new build-namelist system, + scale solar by solar zenith angle in datm, deep soil with + bedrock at bottom, organic matter in soils, SNICAR for snow + radiation, sparce dense aero, snow cover changes + clm3_8_00 erik 05/04/2010 Get future scenarios working, finalize + documentation, bring in MEGAN VOC and CNDV, simplify, + mksurfdata optimization, fix bugs: snow enthalpy, BMOZ, pergro, + use pft weights from fsurdat NOT finidat + clm3_7_15 erik 04/27/2010 Finish User's Guide, surfdata files for urban-1pt, fix mksurfdata ifort bugs, work with testing + clm3_7_14 erik 04/08/2010 Fix rcp=2.6/4.5 1-degree fndepdyn filenames + clm3_7_13 erik 04/08/2010 Add in missing rcp=2.6/6 use-cases, and fix syntax errors in the namelist_defaults file + clm3_7_12 erik 04/08/2010 rcp=2.6/4.5 datasets for fndepdyn and aerdepdat, fix some minor issues, new 1pt urban surfdata files + clm3_7_11 erik 04/07/2010 qtr-degree and T85 surfdata, rcp=2.6/4.5 datasets, doc updates + clm3_7_10 erik 03/22/2010 Fix drydep so that BMOZ case will work + clm3_7_09 erik 03/21/2010 Fix snow enthalpy bug, cndv datasets, various fixes + clm3_7_08 mvertens 03/12/2010 Removal of check for weights if dynamic land use is +used + clm3_7_07 erik 03/10/2010 New finidat datasets for 1-deg, 2-deg, and abort if weights from finidat/fsurdat files are too different, and use fsurdat files as truth + clm3_7_06 erik 03/10/2010 Bring cndv branch to trunk + clm3_7_05 erik 02/24/2010 Bring VOC branch source code to trunk + clm3_7_04 erik 02/17/2010 Bring VOC branch (vocemis-drydep18_clm3_7_03) tools, testing, and build to trunk (everything other than VOC code changes) + clm3_7_03 erik 02/10/2010 Add in more future scenario datasets, new history fields from Keith + clm3_7_02 erik 02/06/2010 Start adding in new rcp=8.5 datasets, remove some junk, change some env_conf variables, add user_nl_clm + clm3_7_01 erik 01/29/2010 OpenMP fix for pftdyn, start adding in rcp's, update ndeplintInterp.ncl script + clm3_7_00 erik 01/22/2010 Update to datm8, redirect aquifer overflow to drainage, add gx3v7 masks, script to extract regional datasets, add harvesting for CN, modify shrubs, include urban model, ice stream for snowcapping, new build-namelist system, scale solar by solar zenith angle in datm, deep soil with bedrock at bottom, organic matter in soils, SNICAR for snow radiation, sparce dense aero, snow cover changes + clm3_6_64 erik 01/22/2010 Update documentation and README/Quickstart files, set NetCDF large-file format on by default in template, update pio, update some fsurdat files to vocemis-drydep versions, add 2.5x3.33_gx3v7 frac file, make gx3v7 default for 4x5 res + clm3_6_63 erik 01/09/2010 Get answers to be identical with ccsm4_0_beta38 for 1 and 2 degree transient cases + clm3_6_62 erik 01/08/2010 Fix startup of PFT transient cases so properly use data from pftdyn file rather than finidat file + clm3_6_61 erik 01/07/2010 Comment out endrun on finidat and fsurdat weights being incomptable, and go back to using finidat weights + clm3_6_60 erik 01/05/2010 Fix clm template + clm3_6_59 erik 01/05/2010 Update to datm8, fix so wts used are from fsurdat file NOT finidat file + clm3_6_58 erik 12/08/2009 Fix rpointer, correct units for export of nee, start adding testing for intrepid + clm3_6_57 erik 11/20/2009 Redirect aquifer overflow to drainage, so doesn't end up in ocean + clm3_6_56 erik 11/10/2009 New ndepdat and ndepdyn datasets + clm3_6_55 erik 11/05/2009 Fix tool to create Nitrogen deposition datasets, and change configure to use CCSM Makefile as source for TopLevel Makefile + clm3_6_54 erik 10/28/2009 Allow comp_intf to change on ccsm build, reduce default hist fields, start adding 2.5x3.33, start adding VOC fsurdat datasets, new finidat files for f09 and f19 + clm3_6_53 erik 09/22/2009 Fix so that T31_gx3v7 file is actually included + clm3_6_52 erik 09/17/2009 Add T31_gx3v7 support, remove forganic, read from fsurdat, add script to extract regional datasets, work with CN output, add more urban/rural fields + clm3_6_51 erik 09/01/2009 Update fndepdyn and aerdep datasets (f02,f05,f09,f10) (1850,2000) and f09, f10 transient (1850-2000) + clm3_6_50 erik 08/28/2009 Fix ncl regridding scripts so that NO missing values are allowed for aerosol and nitrogen deposition + clm3_6_49 erik 08/25/2009 Fix ncl interpolation scripts, update externals, turn on CLM_CCSM_BLD for bluefire,jaguar, ESMF3 compliance + clm3_6_48 erik 08/12/2009 New aerosol/nitrogen deposition datasets, mksurfdata work, scm work, clm_usr_name option to build-namelist + clm3_6_47 erik 08/03/2009 Fix hybrid bug for dynpft case, update externals + clm3_6_46 erik 07/22/2009 Get more tests to work/document them, add use cases for 1850_control, 2000_control, and + 20thC_transient, straighten out single-point grids, Listen to LND_CDF64 env variable from + template, remove CLM_ARB_IC. + clm3_6_45 erik 07/10/2009 Remove inconsistent finidat file in clm3_6_44 + clm3_6_44 erik 07/09/2009 Fix C13 bug, update scripts, drv, datm. Add domain files for idmap atm-ocn grids for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with ndeplintInterp + clm3_6_43 erik 06/10/2009 Fix pftdyn bug, enable 1D primary hist files, fix time-const3D output, fix template bug, enable cpl_esmf/cpl_mct + clm3_6_42 erik 06/02/2009 Bring CN Harvest branch to trunk + clm3_6_41 kauff 05/29/2009 shrub mods, abort if nthreads > 1 (temporary, wrt bugz #965) + clm3_6_40 erik 05/28/2009 Fix openMP bug, add fndepdyn ncl script, fix interpinic for urban, add mkharvest to mksurfdata, new spinups, turn CLAMP on for CASA or CN + clm3_6_39 erik 05/07/2009 Bug fix for script version and maxpatchpft back to numpft+1 + clm3_6_38 erik 05/06/2009 New fsurdat for other resolutions, bug-fixes, deep wetlands to bedrock, new spinups for 1.9x2.5 1850, 2000 + clm3_6_37 erik 04/27/2009 Update faerdep dataset for 1.9x2.5 to point to version cice is using for 1850 and 2000 + clm3_6_36 erik 04/27/2009 Handle transient aersol, make maxpatchpft=numpft+1 default, new datasets for 1.9x2.5 and 0.9x1.25, change doalb + clm3_6_35 erik 04/20/2009 Fix major logic bug in mksurfdata + clm3_6_34 oleson 04/19/2009 Fix bangkok urban bug + clm3_6_33 erik 04/16/2009 Bring in dynpft changes from cbgc branch + clm3_6_32 erik 04/15/2009 Add irrigation area to mksrfdata, fix high-res and pftdyn problems + clm3_6_31 erik 04/01/2009 New surface datasets for 1850,2000, support for 0.9x1.25_gx1v6, urban always on. New pft-physiology file. Update scripts so remove some CLM_ env_conf vars. Fix CN for urban/pftdyn. + clm3_6_30 oleson 03/19/2009 Fix urban roof/wall layers + clm3_6_29 oleson 03/19/2009 CN SAI, CN testing fix, rad step size fix + clm3_6_28 oleson 03/17/2009 Fix permission denied error when reading surface dataset + clm3_6_27 oleson 03/16/2009 Urban model changes and FGR12 fix + clm3_6_25 dlawren 03/13/2009 Daylength control on Vcmax, 1%Lake,wetland,glacier in mksrfdat, remove ELEVATION in surface data file + clm3_6_24 oleson 03/09/2009 Fix urban testing and some history field changes + clm3_6_23 oleson 03/08/2009 Prune history fields and change to snowdp threshold for solar radiation penetration into snow + clm3_6_21 oleson 03/04/2009 History file changes and finish testing on tags clm3_6_19 and clm3_6_20 + clm3_6_19 oleson 02/27/2009 Changes to urban model and urban surface data + clm3_6_17 oleson 02/26/2009 Urban model changes and mksurfdata changes to incorporate urban data + clm3_6_16 erik 02/12/2009 Multiple elevation classes on surface dataset, urban fixes, mpi-serial and testing fixes + clm3_6_15 erik 01/19/2009 Bring clm36sci branch to the trunk + clm3_6_14 erik 10/10/2008 Fix some global urban issues, fix pftdyn, really get compile-only option + working in testing + clm3_6_13 erik 10/01/2008 Update to new version of cpl7 scripts and build, update externals for versions + needed for clm36sci branch, add new CASA tests + clm3_6_12 erik 09/21/2008 Fix restarts for urban, add capability to do global urban experiments, + add in new forcing height changes + clm3_6_11 dlawren 08/26/2008 Ice stream for snow capped regions + clm3_6_10 tcraig 08/15/2008 extend rtm tracer, ascale for tri-grids, AIX O3 to O2 + clm3_6_09 erik 08/11/2008 Fix clm.cpl7.template to run hybrid and branch cases + clm3_6_08 erik 08/06/2008 Fix bugs, and build changes for inputdata repo + clm3_6_07 erik 07/08/2008 Implement new build namelist system from Vertenstein/Eaton, bluefire, and BGP updates + clm3_6_06 erik 05/30/2008 Small fix needed for ccsm4_alpha30 + (use gx1v5 for some resolutions when OCN_GRID==ATM_GRID) + clm3_6_05 erik 05/27/2008 Fix to compile with PGI-6, update scripts, fix cpl7.template for new scripts LND_GRID, + fix 2.65x3.33 frac dataset. + clm3_6_04 erik 05/20/2008 Remove all MCT permutes, fix cpl7 script issues, remove offline mode, + add ability to run over a range of years + clm3_6_03 erik 05/08/2008 Fix so listen to next_swcday to calculate albedo rather than using irad + clm3_6_02 erik 03/25/2008 Minor fix in configure remove perl5lib version under models/lnd/clm/bld + clm3_6_01 erik 03/20/2008 40 m forcing height changes for clm + clm3_6_00 erik 03/20/2008 Fully implement sequential-ccsm mode, upgrade configure, build-namelist and testing, + upgrade interpolation tool, add mkdatadomain, write to iulog rather than 6 explicitly, + SCAM update, Update datasets, add archiving, and build-streams, add in point version + of Urban model, change directory structure to mimic CCSM + clm3_5_20 erik 03/17/2008 Bug fixes before spinning off clm3_6_00, put in changes from ccsm4a01_clm3_5_18 + to ccsm4a04_clm3_5_18 + clm3_5_19 erik 03/06/2008 Change directory structure to mimic CCSM, fix so no NaNS on BGC interpinic output, + new half degree CN clmi dataset + clm3_5_18 erik 02/21/2008 Update to latest seq-ccsm4.alpha tag + clm3_5_17 erik 02/06/2008 Merge Tony Craig's FMI branch fmi12_clm3_5_16 to the clm trunk + clm3_5_16 erik 01/28/2008 Get point version of Urban code onto trunk (urban code can not restart) + clm3_5_15 erik 12/10/2007 Fix interpinic for half degree grid, add in large-file support, + allow configure to work with ccsm directory structure + clm3_5_14 erik 11/27/2007 Use build-streams, and archiving, multiple bug-fixes + clm3_5_13 erik 11/16/2007 Update xml file with file needed for ccsm3_5_beta18 + clm3_5_12 erik 11/08/2007 Tag with new files needed for ccsm3_5_beta17 + clm3_5_11 erik 09/28/2007 Update datasets in the DefaultCLM file for 0.23x0.31, 0.47x0.63, 0.9x1.25 and + add fndepdyn file for 1.9x2.5 + clm3_5_10 jet 09/18/2007 SCAM update + clm3_5_09 erik 08/31/2007 Change configure to NOT have csm_share code for ccsm_con option, and add in 1x1.25 file, + and update datm7 and csm_share + clm3_5_08 tcraig 08/20/2007 convert 6 to iulog in logfile, updates for I/O + clm3_5_07 erik 08/17/2007 Add mkdatadomain tool, add cprnc and perl5lib as externals + clm3_5_06 erik 08/10/2007 Update: interpolation, testing, script namelist build, and scripts. Fix bugs, + and fix possible + clm3_5_05 tcraig 07/11/2007 seq clm mods and first hist refactor mods + clm3_5_04 mvertens 06/05/2007 lnd_comp_mct.F90 change to work with sequential diagnostics + clm3_5_03 tcraig 05/23/2007 reduce memory, partial I/O refactor, downscaling implementation + clm3_5_02 mvertens 05/22/2007 put in hourly coupling with sequential driver + clm3_5_01 erik 05/16/2007 Move newcn06 branch to trunk + clm3_5_00 erik 05/03/2007 New surface datasets, improved canopy integration, and various improvements to Hydrology diff --git a/Copyright b/Copyright new file mode 100644 index 0000000000..1e8c87a1c6 --- /dev/null +++ b/Copyright @@ -0,0 +1,59 @@ +-------------------------------------------------------------------------------- + CESM1.0 +-------------------------------------------------------------------------------- +The Community Earth System Model (CESM) was developed in cooperation with the +National Science Foundation, the Department of Energy, the National Aeronautics +and Space Administration, and the University Corporation for Atmospheric +Research National Center for Atmospheric Research. + +Except for the segregable components listed below, CESM is public domain software. +There may be other third party tools and libraries that are embedded, and they may +have their own copyright notices and terms. + +The following components are copyrighted and may only be used, modified, or +redistributed under the terms indicated below. + +Code ESMF +Institution University of Illinois/NCSA +Copyright Copyright 2002-2009, University of Illinois/NCSA Open Source License +Terms of Use http://www.gnu.org/copyleft/gpl.html + +Code POP, SCRIP, CICE +Institution Los Alamos National Laboratory +Copyright Copyright 2008 Los Alamos National Security, LLC +Terms of Use http://oceans11.lanl.gov/trac/CICE/wiki/CopyRight + +Code Glimmer-CISM +Institution LANL/U. Bristol/U. Edinburgh/U. Montana/U. Swansea) +Copyright Copyright 2004-2010, GNU General Public License +Terms of Use GNU General Public License + +Code AER RRTMG +Institution Atmospheric and Environmental Research, Inc. +Copyright Copyright 2002-2010, Atmospheric and Environmental Research, Inc. +Terms of Use http://rtweb.aer.com/rrtm_frame.html + +Code MCT +Institution Argonne National Laboratory +Copyright Copyright 2000, 2010, University of Chicago. +Terms of Use http://www.cesm.ucar.edu/models/cesm1.0/copyright_MCT.html + +Code ICSSP +Institution N/A +Copyright Copyright 2003, 2010, Steve Klein and Mark Webb +Terms of Use http://gcss-dime.giss.nasa.gov/simulator.html + +Code XML/Lite +Institution Wadsack-Allen Digital Group +Copyright Copyright 2001,2010 Wadsack-Allen Digital Group +Terms of Use http://aspn.activestate.com/ASPN/CodeDoc/XML-Lite/Lite.html + +Code Inf_NaN_Detection module +Institution Lahey Computer Systems, Inc. +Copyright Copyright(c) 2003, Lahey Computer Systems, Inc. +Terms of Use Copies of this source code, or standalone compiled files derived from + this source may not be sold without permission from Lahey Computers Systems. + All or part of this module may be freely incorporated into executable + programs which are offered for sale. Otherwise, distribution of all or + part of this file is permitted, provided this copyright notice and header + are included. diff --git a/README b/README new file mode 100644 index 0000000000..029a891482 --- /dev/null +++ b/README @@ -0,0 +1,113 @@ +components/clm/README 04/07/2015 + +Community Land Surface Model (CLM) science version 4.5.1 series -- source code, tools, +offline-build and test scripts. This gives you everything you need +to run CLM with CESM with datm8 to provide Qian or CRU NCEP forcing data in +place of a modeled atmosphere. + +General directory structure: + +components/clm/doc ---- Documentation of CLM. +components/clm/bld ---- Template, configure and build-namelist scripts for clm. +components/clm/src ---- CLM Source code. +components/clm/test --- CLM Testing scripts for CLM offline tools. +components/clm/tools -- CLM Offline tools to prepare input datasets and process output. + +cime/scripts --------------- CPL7 scripts + +cime/driver_cpl/driver ---------- CESM top level driver source code. +cime/driver_cpl/shr ------------- CESM top level driver shared code. +cime/driver_cpl/shr_esmf -------- CESM top level driver shared code for ESMF. +cime/components/data_comps/datm - CESM Data model version 8 source code. +components/cism ----------------- CESM Community land Ice Sheet Model. +components/rtm ------------------ CESM River Transport Model. +cime/components/stub_comps/sice - CESM stub sea-ice model source code. +cime/components/stub_comps/socn - CESM stub ocean model source code. +cime/components/stub_comps/sglc - CESM stub glacier model source code. +cime/external ------------------- CESM external utility codes + (Model Coupling Toolkit (MCT) + (Earth System Model Framework) + (timing -- code timing utility) + (pio -- Parallel Input/Output) + +Top level documentation: + +README ------------------- This file +README_EXTERNALS --------- Information on how to work with subversion externals for clm +SVN_EXTERNAL_DIRECTORIES - Subversions externals to use +Copyright ---------------- CESM Copyright file +UpDateChangeLog.pl ------- Script to add documentation on a tag to the + ChangeLog/ChangeSum files +ChangeLog ---------------- Documents different CLM versions +ChangeSum ---------------- Summary documentation of different CLM versions +ChangeLog/ChangeSum ------ Also copied to components/lnd/clm/doc + +Documentation of Namelist Items: (view the following in a web browser) + +components/clm/bld/namelist_files/namelist_definition.xml --- Definition of all namelist items +components/clm/bld/namelist_files/namelist_defaults_clm.xml - Default values + +============================================================================================= +Important files in main directories: +============================================================================================= + +components/lnd/clm/doc/Quickstart.GUIDE -------- Quick guide to using cpl7 scripts. +components/lnd/clm/doc/Quickstart.userdatasets - Quick guide to using your own datasets. +components/lnd/clm/doc/IMPORTANT_NOTES --------- Some important notes about this version of + clm, configuration modes and namelist items + that are not validated or functional. +components/clm/doc/KnownBugs --------------- List of known bugs. +components/clm/doc/KnownLimitations -------- List of known limitations and workarounds. +components/clm/doc/ChangeLog --------------- Detailed list of changes for each model version. +components/clm/doc/ChangeSum --------------- Summary one-line list of changes for each + model version. +components/clm/doc/README ------------------ Documentation similar to this file +components/clm/doc/UsersGuide -------------- CLM Users Guide +components/clm/doc/CodeReference ----------- CLM Code Reference Guide + +components/clm/bld/configure --------------- Script to prepare CLM to be built. + +components/clm/test/tools/test_driver.sh -- Script for general software testing of + CLM's offline tools. + +components/clm/tools/clm4_5/mksurfdata_map --- Directory to build program to create surface dataset + at any resolution. +components/clm/tools/clm4_5/interpinic ------- Directory to build program to interpolate initial + conditions to any resolution. +components/clm/tools/shared/mkdatadomain ----- Directory to build program to create datm7 or docn7 + domain files from clm files. +components/clm/tools/shared/mkprocdata_map --- Process history data from unstructed grids to a gridded + format. +components/clm/tools/shared/ncl_scripts ----- Directory of NCL and perl scripts to do various + tasks. Most notably to plot perturbation error growth + testing and to extract regional information from + global datasets for single-point/regional simulations. + +components/clm/bld/README ------------- Description of how to use the configure and + build-namelist scripts. + +============================================================================================= +Source code directory structure: +============================================================================================= + +components/clm/src/biogeochem -- Biogeochemisty +components/clm/src/main -------- Main control and high level code +components/clm/src/cpl --------- Land model high level MCT and ESMF drivers +components/clm/src/biogeophys -- Biogeophysics (Hydrology) + +============================================================================================= + QUICKSTART: using the CPL7 scripts: +============================================================================================= + + cd cime/scripts + ./create_newcase # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I + # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm8, and inactive ice/ocn + cd testI + ./cesm_setup # create the $CASE.run file + ./testI.bluefire.build # build model and create namelists + ./testI.bluefire.submit # submit script + # (NOTE: ./xmlchange RESUBMIT=10 to set RESUBMIT to number + # # of times to automatically resubmit -- 10 in this example) + diff --git a/README_EXTERNALS b/README_EXTERNALS new file mode 100644 index 0000000000..66afc744f6 --- /dev/null +++ b/README_EXTERNALS @@ -0,0 +1,56 @@ +Some guidelines on working with externals in CLM: + +Also see: + + https://wiki.ucar.edu/display/ccsm/Creating+a+CLM+Tag + + https://wiki.ucar.edu/display/ccsm/Using+SVN+to+Work+with+CLM+Development+Branches + +Example taken from bulletin board forum for "Subversion Issues" in the +thread for "Introduction to Subversion"...(070208) + +Working with externals: + +checkout the HEAD of clm's trunk into working copy directory +> svn co $SVN/clm2/trunk clm_trunk_head_wc + +view the property set for clm's external definitions +> svn propget svn:externals clm_trunk_head_wc + +view revision, URL and other useful information specific to external files +> cd clm_trunk_head_wc/components/clm/src +> svn info main + +create new clm branch for mods required of clm +> svn copy $SVN/clm2/trunk_tags/ $SVN/clm2/branches/ -m "appropriate message" + +have external directories in working copy refer to new clm branch to make changes +> svn switch $SVN/clm2/branches//src/main main + +--make changes to clm files-- + +when satisfied with changes and testing, commit to HEAD of clm branch +> svn commit main -m "appropriate message" + +tag new version of clm branch - review naming conventions! +> svn copy $SVN/clm2/branches/ $SVN/clm2/branch_tags/_tags/ -m "appropriate message" + +have external directories in working copy refer to new clm tag +> svn switch $SVN/clm2/branch_tags/_tags//src/main main + +modify clm's property for external definitions in working copy +> vi clm_trunk_head_wc/SVN_EXTERNAL_DIRECTORIES + +--point definition to URL of new-tag-name-- + +set the property - don't forget the 'dot' at the end! +> svn propset svn:externals -F SVN_EXTERNAL_DIRECTORIES clm_trunk_head_wc + +--continue with other clm mods-- + +commit changes from working copy directory to HEAD of clm trunk - NOTE: a commit from here will *NOT* recurse to external directories +> cd clm_trunk_head_wc +> svn commit -m "appropriate message" + +tag new version of clm trunk +> svn copy $SVN/clm2/trunk $SVN/clm2/trunk_tags/ -m "appropriate message" diff --git a/README_cime b/README_cime new file mode 100644 index 0000000000..98c25c94b7 --- /dev/null +++ b/README_cime @@ -0,0 +1,62 @@ +For the trunk: + +1.) Start at the top level directory of your sandbox + + cd $clm_root + +2.) Update JUST the top level directory with the externals. + + svn update --depth immediates + +3.) Move any local changes you have under clm + (This preserves any local changes you have in your sandbox, as well as changes on your branch) + + svn mv models/lnd/clm/ components/clm + +4.) Move any local changes you have under scripts to save your cases + (if you don't have cases to save under scripts, you don't have + to do this step) + + svn mkdir --parents cime/scripts + mv scripts cime/scripts/ + +5.) Bring in updated externals and updates to clm source files + + svn update + +6.) Mark changes to models directory as resolved + + svn resolved models + + +For branches: + +0.) Make sure ALL your changes are checked into your branch. + +1.) Checkout your branch WITHOUT externals + + svn co --ignore-externals $SVN_MOD_URL/clm2/branches/ + +2.) Move any changes you have under clm on your branch + + svn mkdir components + svn mv models/lnd/clm/ components/clm + +3.) Merge the top level + + svn merge --depth immediates $SVN_MOD_URL/clm2/trunk_tags/clm4_5_1_r104 $SVN_MOD_URL/clm2/trunk_tags/clm4_5_1_r105 + +4.) Merge changes in the clm directory + + svn merge $SVN_MOD_URL/clm2/trunk_tags/clm4_5_1_r104/models/lnd/clm $SVN_MOD_URL/clm2/trunk_tags/clm4_5_1_r105/components/clm + +5.) Bring in updated externals and updates to clm source files + + svn update + +6.) Mark changes to models and components/clm directories as resolved + + svn resolved models + svn resolved components + svn resolved components/clm + diff --git a/SVN_EXTERNAL_DIRECTORIES b/SVN_EXTERNAL_DIRECTORIES new file mode 100644 index 0000000000..9933463548 --- /dev/null +++ b/SVN_EXTERNAL_DIRECTORIES @@ -0,0 +1,5 @@ +cime https://github.com/CESM-Development/cime/tags/cime2.0.7 +components/clm/tools/shared/gen_domain https://github.com/CESM-Development/cime/tags/cime2.0.7/tools/mapping/gen_domain_files +components/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_02 +components/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_52 + diff --git a/SVN_EXTERNAL_DIRECTORIES.orig b/SVN_EXTERNAL_DIRECTORIES.orig new file mode 100644 index 0000000000..9933463548 --- /dev/null +++ b/SVN_EXTERNAL_DIRECTORIES.orig @@ -0,0 +1,5 @@ +cime https://github.com/CESM-Development/cime/tags/cime2.0.7 +components/clm/tools/shared/gen_domain https://github.com/CESM-Development/cime/tags/cime2.0.7/tools/mapping/gen_domain_files +components/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_1_02 +components/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_52 + diff --git a/UpDateChangeLog.pl b/UpDateChangeLog.pl new file mode 100755 index 0000000000..27e4803122 --- /dev/null +++ b/UpDateChangeLog.pl @@ -0,0 +1,258 @@ +#!/usr/bin/env perl +#======================================================================= +# +# This is a script to update the ChangeLog +# +# Usage: +# +# perl ChangeLog tag-name One-line summary +# +# +#======================================================================= + +use strict; +use Getopt::Long; +use IO::File; +#use warnings; +#use diagnostics; + +use English; + +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +sub usage { + die < + +OPTIONS + -compbrnch version Enter clm branch version to compare to (under branch_tags in repo). + [or -cb] + -comptrunk version Enter clm trunk version to compare to (under trunk_tags in repo). + [or -ct] + -help [or -h] Help on this script. + -update [or -u] Just update the date/time for the latest tag + In this case no other arguments should be given. +ARGUMENTS + Tag name of tag to document + Short summary description of this tag +EXAMPLES: + To just update the date/time for the latest tag + + $ProgName -update + + To document a new tag + + $ProgName clm4_5_2_r097 "Description of this tag" + + To document a new tag and compare expected fails to previous tag. + + $ProgName clm4_5_2_r097 "Description of this tag" -ct clm4_5_2_r096 +EOF +} + +my %opts = { + help => 0, + update => 0, + comptrunk => undef, + compbrnch => undef, + }; +GetOptions( + "h|help" => \$opts{'help'}, + "u|update" => \$opts{'update'}, + "ct|comptrunk=s" => \$opts{'comptrunk'}, + "cb|compbrnch=s" => \$opts{'compbrnch'}, + ); +if ( $opts{'help'} ) { + usage(); +} +my $tag; my $sum; + +if ( ! $opts{'update'} ) { + if ( $#ARGV != 1 ) { + print "ERROR: wrong number of arguments: $ARGV\n"; + usage(); + } + + $tag = $ARGV[0]; + $sum = $ARGV[1]; + + if ( $tag !~ /clm[0-9]+_([0-9]+)_[0-9]+_r[0-9]+/ ) { + print "ERROR: bad tagname: $tag\n"; + usage(); + } +} else { + if ( $#ARGV != -1 ) { + print "ERROR: wrong number of arguments when update option picked: $ARGV\n"; + usage(); + } +} +my $EDITOR = $ENV{EDITOR}; +if ( $EDITOR !~ /.+/ ) { + print "ERROR: editor NOT set -- set the env variable EDITOR to the text editor you would like to use\n"; + usage(); +} + + +my $template = ".ChangeLog_template"; +my $changelog = "ChangeLog"; +my $changesum = "ChangeSum"; +my $changelog_tmp = "ChangeLog.tmp"; +my $changesum_tmp = "ChangeSum.tmp"; + +my $user = $ENV{USER}; +if ( $user !~ /.+/ ) { + die "ERROR: Could not get user name: $user"; +} +my @list = getpwnam( $user ); +my $fullname = $list[6]; +my $date = `date`; +chomp( $date ); + +if ( $date !~ /.+/ ) { + die "ERROR: Could not get date: $date\n"; +} + +# +# Deal with ChangeLog file +# +my $fh = IO::File->new($changelog_tmp, '>') or die "** $ProgName - can't open file: $changelog_tmp\n"; + +# +# If adding a new tag -- read in template and add information in +# +if ( ! $opts{'update'} ) { + open( TL, "<$template" ) || die "ERROR:: trouble opening file: $template"; + while( $_ = ) { + if ( $_ =~ /Tag name:/ ) { + chomp( $_ ); + print $fh "$_ $tag\n"; + } elsif ( $_ =~ /Originator/ ) { + chomp( $_ ); + print $fh "$_ $user ($fullname)\n"; + } elsif ( $_ =~ /Date:/ ) { + chomp( $_ ); + print $fh "$_ $date\n"; + } elsif ( $_ =~ /One-line Summary:/ ) { + chomp( $_ ); + print $fh "$_ $sum\n"; + } elsif ( $_ =~ /CLM tag used for the baseline comparison tests if applicable:/ ) { + chomp( $_ ); + if ( defined($opts{'comptrunk'}) ) { + print $fh "$_ $opts{'comptrunk'}\n"; + &AddExpectedFailDiff( $fh, "trunk_tags/$opts{'comptrunk'}" ); + } elsif ( defined($opts{'compbrnch'}) ) { + print $fh "$_ $opts{'compbrnch'}\n"; + &AddExpectedFailDiff( $fh, "branch_tags/$opts{'compbrnch'}" ); + } else { + print $fh "$_\n"; + } + } else { + print $fh $_; + } + } + close( TL ); +} +open( CL, "<$changelog" ) || die "ERROR:: trouble opening file: $changelog"; +my $update = $opts{'update'}; +my $oldTag = ""; +while( $_ = ) { + # If adding a new tag check that new tag name does NOT match any old tag + if ( $_ =~ /Tag name:[ ]*(clm.+)/ ) { + $oldTag = $1; + if ( (! $opts{'update'}) && ($tag eq $oldTag) ) { + close( CL ); + close( $fh ); + system( "/bin/rm -f $changelog_tmp" ); + print "ERROR:: New tag $tag matches a old tag name\n"; + usage(); + } + # If updating the date -- find first occurance of data and change it + # Then turn the update option to off + } elsif ( ($update) && ($_ =~ /(Date:)/) ) { + print $fh "Date: $date\n"; + print "Update $oldTag with new date: $date\n"; + $update = undef; + $_ = ; + } + print $fh $_; +} +# Close files and move to final name +close( CL ); +$fh->close( ); +system( "/bin/mv $changelog_tmp $changelog" ); +# +# Deal with ChangeSum file +# + +open( FH, ">$changesum_tmp" ) || die "ERROR:: trouble opening file: $changesum_tmp"; + +open( CS, "<$changesum" ) || die "ERROR:: trouble opening file: $changesum"; + +my $update = $opts{'update'}; + +$date = `date "+%m/%d/%Y"`; +chomp( $date ); + +while( $_ = ) { + # Find header line + if ( $_ =~ /=====================/ ) { + print FH $_; + my $format = "%16.16s %8.8s %10.10s %s\n"; + if ( $update ) { + $_ = ; + if ( /^(.{16}) (.{8}) (.{10}) (.+)$/ ) { + $tag = $1; + $user = $2; + $sum = $4; + } else { + die "ERROR: bad format for ChangeSum file\n"; + } + } + printf FH $format, $tag, $user, $date, $sum; + $_ = ; + } + print FH $_; +} +# Close files and move to final name +close( CS ); +close( FH ); +system( "/bin/mv $changesum_tmp $changesum" ); + +# +# Edit the files +# +if ( ! $opts{'update'} ) { + system( "$EDITOR $changelog" ); + system( "$EDITOR $changesum" ); +} +system( "/bin/cp -fp $changelog components/clm/doc/." ); +system( "/bin/cp -fp $changesum components/clm/doc/." ); +system( "/bin/chmod 0444 components/clm/doc/$changelog" ); +system( "/bin/chmod 0444 components/clm/doc/$changesum" ); + +sub AddExpectedFailDiff { +# +# Add information about the expected fail difference +# + my $fh = shift; + my $version = shift; + + my $SVN_MOD_URL = "https://svn-ccsm-models.cgd.ucar.edu/clm2/"; + my $expectedFail = `find . -name 'expected*Fail*.xml' -print`; + if ( $expectedFail eq "" ) { + die "ERROR:: expectedFails file NOT found here\n"; + } + + `svn ls $SVN_MOD_URL/$version` || die "ERROR:: Bad version to compare to: $version\n"; + `svn ls $SVN_MOD_URL/$version/$expectedFail` || die "ERROR:: expectedFails file NOT found in: $version\n"; + print $fh "\nDifference in expected fails from testing:\n\n"; + my $diff = `svn diff --old $SVN_MOD_URL/$version/$expectedFail \ \n --new $expectedFail`; + if ( $diff eq "" ) { + print $fh " No change in expected failures in testing\n"; + } else { + print $fh $diff; + } +} diff --git a/components/cism/ChangeLog b/components/cism/ChangeLog new file mode 100644 index 0000000000..47d1874d2a --- /dev/null +++ b/components/cism/ChangeLog @@ -0,0 +1,5976 @@ +================================================================================ +This file describes what main-trunk tags were created and why +================================================================================ + +================================================================================ +Originator: sacks +Date: Aug 4, 2015 +Model: cism +Version: cism2_1_02 +One-line summary: Move prebeta goldbach tests to hobart + +Purpose of changes: + + With hobart replacing goldbach, all components are moving prealpha & prebeta + tests from golbach to hobart. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M cimetest/testlist_cism.xml + +Summary of testing: NONE + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: June 3, 2015 +Model: cism +Version: cism2_1_01 +One-line summary: Update glimmer-cism external to add a 'use' statement + +Purpose of changes: + + Two needed variables were missing from a 'use' statement. For some reason, + this did not cause problems on the previous yellowstone testing, but showed + up as a problem in standalone CISM testing. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +-glimmer-cism https://github.com/CESM-Development/cism/tags/move_glint_to_cpl_n01 ++glimmer-cism https://github.com/CESM-Development/cism/tags/move_glint_to_cpl_n02 + +Summary of testing: + + Ran full yellowstone aux_glc test suite. All tests passed. + +Externals used for testing: +https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp/branch_tags/move_glint_into_cpl2_tags/move_glint_into_cpl2_n04_cesm1_4_beta04 +(I *think*), with mpi-serial patch as noted below + +cism tag used for baseline comparisons: cism2_1_00 + +Any other externals that differed in baseline: see below + +================================================================================ +Originator: sacks +Date: May 19, 2015 +Model: cism +Version: cism2_1_00 +One-line summary: Move GLC <-> LND coupling to CESM coupler + +Purpose of changes: + + Up until now, the GLC <-> LND coupling has been done by CISM's glint + library. This is problematic for a few reasons: + - glint can only handle regular land grids - not (for example) the CAM-SE + grid + - glint can only perform bilinear interpolation, not area-conservative + remapping, for mapping from LND -> GLC + - glint’s remapping is done in serial, on the master processor + - any alternative ice sheet model that wants to couple to CESM (e.g., + MPAS-Land Ice) needs to reimplement glint + - coupling between the ocean and GLC would need to go through the LND grid, + leading to loss of accuracy (especially for high-resolution ocean grids) + + To address these limitations, we have moved the GLC <-> LND coupling out of + CISM, into the CESM coupler. This required significant changes to the coupler + and scripts. In addition, for GLC/CISM, it required: + + - Writing a replacement for glint in CISM (called glad, for "glimmer already + downscaled"), which works with inputs and outputs on the CISM grid rather + than on the LND grid. + + - Changing GLC so that its grid is now the CISM grid, not the LND grid. Along + with this, removed the CISM_GRID xml variable (now, just use the GLC_GRID + variable, which has the value that CISM_GRID used to have). + + - Changing various namelist options to accommodate these changes + + I have also enabled the glc -> ocn coupling. Previously, this was disabled + because we didn't have the necessary mapping files. Now I have generated the + necessary mapping files, and they are available out-of-the-box in the + upcoming CIME tag. + + The new code currently does not have any PDD support. I have pulled out some + never-quite-working code related to the PDD option, because now the PDD + option is definitively NOT supported. + + +Changes answers relative to previous tag: YES + + Since the coupling method has changed - including using area-conservative + remapping rather than bilinear remapping for the downscaling - answers change + significantly. However, I have done many eyeball comparisons to verify that + the new code is operating roughly the same as before. + + +Dependencies: Depends on an upcoming CIME tag (cime2_0_00?) + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Point to glimmer-cism branch +M SVN_EXTERNAL_DIRECTORIES + +*** glc_global_fields renamed to glc_fields for accuracy; this is significantly + different now +D source_glc/glc_global_fields.F90 +A source_glc/glc_fields.F90 + +*** Operation of glc overrides fundamentally reworked: It no longer works to + scale fractions. Instead, the fractions specify topographic height cutoffs + below / above which ice_covered is set to 0 / 1. +M source_glc/glc_override_frac.F90 + +*** Point to new input files, which contain lat/lon values that agree with the + values on Jeremy's new SCRIP grid files. These SCRIP grid files were needed + for creating mapping files for the coupler. Lat/lon values are now also + needed on the input files in order for CISM/GLC to tell the coupler about + its domain information. It seemed good (although maybe not completely + necessary) for these two sets of files to agree in terms of lat/lon + values. Also, removed some no-longer-needed namelist items. +M bld/namelist_files/namelist_defaults_cism.xml + +*** Fix some documentation +M tools/glc2scripConvert.ncl +M tools/README.glc_overlap_tools + +*** Other changes; see "Purpose of changes", above, for details. +D source_glc/glc_global_grid.F90 +A source_glc/glc_indexing_info.F90 +M source_glc/glc_io.F90 +M source_glc/glc_constants.F90 +M source_glc/history_tape_base.F90 +M source_glc/glc_FinalMod.F90 +M source_glc/glc_history.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M cimetest/testmods_dirs/cism/override_glc_frac/user_nl_cism +M drivers/cpl/glc_comp_esmf.F90 +M drivers/cpl/glc_import_export.F90 +M drivers/cpl/glc_coupling_flags.F90 +M drivers/cpl/glc_cpl_indices.F90 +M drivers/cpl/glc_comp_mct.F90 +M bld/cismIO/cism.buildIO.template.csh +M bld/README.build-namelist +M bld/cism.template +M bld/build-namelist +M bld/namelist_files/namelist_definition_cism.xml +M bld/trilinosOptions/README +M bld/cism.buildnml + + +Summary of testing: + + Ran full yellowstone aux_glc test suite. All tests passed. + +Externals used for testing: +https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp/branch_tags/move_glint_into_cpl2_tags/move_glint_into_cpl2_n03_cesm1_4_beta04 + with mpi-serial patch as noted below + +cism tag used for baseline comparisons: cism2_0_09 + +Any other externals that differed in baseline: see externals notes under cism2_0_09 + +================================================================================ +Originator: mvertens (brought to trunk by sacks) +Date: Apr 29, 2015 +Model: cism +Version: cism2_0_09 +One-line summary: Updates for latest version of cime + +Purpose of changes: + + Updates to make (a) location of test directory and (b) variable names + consistent with the latest version of CIME. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Change variable names to be consistent with latest version of CIME +M bld/README.build-namelist +M bld/build-namelist +M bld/cism.buildlib +M bld/cism.buildnml +M bld/cism.template + +*** Rename cesmtest to cimetest +D cesmtest +D cesmtest/testlist_cism.xml +D cesmtest/testmods_dirs +D cesmtest/testmods_dirs/cism +D cesmtest/testmods_dirs/cism/apply_to_multiinstance +D cesmtest/testmods_dirs/cism/apply_to_multiinstance/README +D cesmtest/testmods_dirs/cism/apply_to_multiinstance/shell_commands +D cesmtest/testmods_dirs/cism/oneway +D cesmtest/testmods_dirs/cism/oneway/README +D cesmtest/testmods_dirs/cism/oneway/xmlchange_cmnds +D cesmtest/testmods_dirs/cism/override_glc_frac +D cesmtest/testmods_dirs/cism/override_glc_frac/include_user_mods +D cesmtest/testmods_dirs/cism/override_glc_frac/user_nl_cism +D cesmtest/testmods_dirs/cism/test_coupling +D cesmtest/testmods_dirs/cism/test_coupling/include_user_mods +D cesmtest/testmods_dirs/cism/test_coupling/user_nl_cism +D cesmtest/testmods_dirs/cism/trilinos +D cesmtest/testmods_dirs/cism/trilinos/README +D cesmtest/testmods_dirs/cism/trilinos/include_user_mods +D cesmtest/testmods_dirs/cism/trilinos/shell_commands +D cesmtest/testmods_dirs/cism/trilinos/user_nl_cism +A + cimetest + + +Summary of testing: + + Ran full yellowstone aux_glc test suite. All tests passed. + + Note, however, that two tests needed to be rerun to pass: + + PEA_P1_M_Ly2.f09_g16_gl20.TGIS2.yellowstone_intel + - seemed to have a system problem the first time + + SMS_D_Ly1.f09_g16_gl20.TGHISTIS2.yellowstone_gnu + - died with: + MCT::m_AttrVect::lsize_: attribute array length mismatch error, stat =892988089 + - passed when I reran it + - likely a compiler bug + +Externals used for testing: cesm1_4_beta02, with mpi-serial patch as noted below + +cism tag used for baseline comparisons: cism2_0_08 + +Any other externals that differed in baseline: see externals notes under cism2_0_08 + +================================================================================ +Originator: mvertens, sacks +Date: Feb 20, 2015 +Model: cism +Version: cism2_0_08 +One-line summary: Updates for Mariana's new testing infrastructure + +Purpose of changes: + + This tag updates CISM to fit in with Mariana's major overhaul of the test + system and build scripts. Specifically: + + (1) Tests are now distributed with their components, rather than being + centralized in 'scripts' + + (2) Build scripts have been converted to perl, and implicit dependencies on + the environment have been removed. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Build scripts converted to perl; implicit dependencies on environment removed +D bld/cism.buildexe.csh +D bld/cism.cpl7.template +D bld/cism.buildnml.csh +M bld/trilinosOptions/README +A bld/cism.buildlib +A bld/cism.buildnml +M bld/README.build-namelist +A bld/cism.template +M bld/build-namelist +M bld/README + +*** Tests now distributed into components, rather than being centralized in scripts +A cesmtest/testmods_dirs/cism/override_glc_frac/user_nl_cism +A cesmtest/testmods_dirs/cism/override_glc_frac/include_user_mods +A cesmtest/testmods_dirs/cism/override_glc_frac +A cesmtest/testmods_dirs/cism/test_coupling/user_nl_cism +A cesmtest/testmods_dirs/cism/test_coupling/include_user_mods +A cesmtest/testmods_dirs/cism/test_coupling +A cesmtest/testmods_dirs/cism/oneway/xmlchange_cmnds +A cesmtest/testmods_dirs/cism/oneway/README +A cesmtest/testmods_dirs/cism/oneway +A cesmtest/testmods_dirs/cism/trilinos/user_nl_cism +A cesmtest/testmods_dirs/cism/trilinos/include_user_mods +A cesmtest/testmods_dirs/cism/trilinos/shell_commands +A cesmtest/testmods_dirs/cism/trilinos/README +A cesmtest/testmods_dirs/cism/trilinos +A cesmtest/testmods_dirs/cism/apply_to_multiinstance/shell_commands +A cesmtest/testmods_dirs/cism/apply_to_multiinstance/README +A cesmtest/testmods_dirs/cism/apply_to_multiinstance +A cesmtest/testmods_dirs/cism +A cesmtest/testmods_dirs +A cesmtest/testlist_cism.xml +A cesmtest + + +Summary of testing: + + Ran full yellowstone test suite from Mariana's experimental tag + (https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/newtesting_cesm1_3_beta18c). All + tests PASSed. + + Since the CME _D tests failed in the baseline, I ran SMS versions of these, + as noted below (cism2_0_07). These baseline comparisons PASSed. (The CME + tests themselves now pass, too.) + +Externals used for testing: +https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/newtesting_cesm1_3_beta18c - +but since this points to branches rather than tags, it is hard to say exactly +what was used. (I think it was at r68306 for most components.) + + Also, mpi-serial changes, as noted below. + +cism tag used for baseline comparisons: cism2_0_07 + +Any other externals that differed in baseline: See below for notes on externals +used for cism2_0_07. + +================================================================================ +Originator: sacks +Date: Feb 20, 2015 +Model: cism +Version: cism2_0_07 +One-line summary: Separate cism history frequency from coupler history frequency + +Purpose of changes: + + With Mariana's new testing framework, some exact restart tests were failing + because CISM was writing history files at the end of a few-day run, and these + didn't restart properly (specifically, IG/FG/BG tests without + test_coupling). This provided motivation for something I have been wanting to + do for a long time: separating the cism history frequency from the coupler + history frequency. + + With this tag, the default cism history frequency is annual. You can still + tie cism history to cpl history if you want, by setting hist_option = + 'coupler'. However, this is not recommended for production runs, because it + does not write frequency metadata to the history file. + + Along with this change, I have added a global metadata field to the history + files saying the frequency of history writes. This is in accordance with a + new requirement from the CESM post-processing/workflow group. As noted above, + this does NOT work for hist_option = 'coupler'. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml +A source_glc/glc_history.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +A source_glc/history_tape_standard.F90 +M source_glc/glc_io.F90 +A source_glc/history_tape_coupler.F90 +A source_glc/history_tape_base.F90 +M drivers/cpl/glc_comp_mct.F90 +M drivers/cpl/glc_comp_esmf.F90 + +Summary of testing: + + Ran full yellowstone test suite, using the new aux_glc test suite that I have + developed... this test suite is not on the scripts trunk (it is on Mariana's + testing branch), so I'm listing it below: + + CME_D.T31_g37.IGCLM45.yellowstone_intel.cism-test_coupling # Note that this is more about testing CLM (specifically the esmf code in CLM) than it is about testing CISM + ERS_Ly5.T31_g37.IGCLM45.yellowstone_intel.clm-glcMEC_long # Need IG ERS test to catch problems with fields sent before the end of the first year after restart. Also use glcMEC_long testmods to get shorter snow_persistence_max - the main motivation here is to have a long ERS test that checks restart of the snow_persistence stuff (which more belongs in the aux_clm test list, but was added here to avoid needing to add a long ERS test to that test list)... this is mainly needed because we do not have an IG test that uses spun-up initial conditions, so we currently need a long test to completely test the restartability of the snow_persistence stuff. Also note that this is the only multi-year non-TG test in the test list, so this is the one test that a production-like configuration can run for a few years. Consider moving this to the aux_clm45 test list once this test can be made shorter, either through use of initial conditions and/or moving to f10 resolution. + ERS_D_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac # Make sure glc override options work correctly, and restart properly + SMS_D.T31_g37_gl20.IGCLM45IS2.yellowstone_gnu.cism-test_coupling + SMS_D.f09_g16.TG.yellowstone_intel + ERS_Ly20_N2_P2.f09_g16_gl10.TG.yellowstone_pgi + SMS_D.f09_g16_gl10.TG.yellowstone_gnu + SMS_D.f09_g16_gl10.TG.yellowstone_pgi + CME_Ly5_N2_P2_D.f09_g16.TG1850.yellowstone_intel + ERS_Ly20.f09_g16.TG1850.yellowstone_gnu.cism-oneway + ERS_Ly11.f09_g16_gl20.TG1850IS2.yellowstone_gnu + SMS_D_Ly1.f09_g16_gl20.TG1850IS2.yellowstone_pgi + ERS_Ly20_E.f09_g16.TGHIST.yellowstone_intel + PEA_P1_M.f09_g16.TGHIST.yellowstone_pgi + ERI_Ly15.f09_g16_gl20.TGHISTIS2.yellowstone_pgi + SMS_D_Ly1.f09_g16_gl20.TGHISTIS2.yellowstone_gnu + PEA_P1_M_Ly2.f09_g16_gl20.TGIS2.yellowstone_intel # needs to be at least 2 years for there to be enough cpl fields for the cpl log comparison to work + SMS_D_Ly1.f09_g16_gl20.TGIS2.yellowstone_intel + SMS_D_Ly1.f09_g16_gl20.TGIS2.yellowstone_intel.cism-trilinos + SMS_Ly1.f09_g16_gl4.TGIS2.yellowstone_intel # include one short test of the typical production resolution for CISM2 + ERI_Ly44.f09_g16.TGRCP85.yellowstone_intel + CME_Ly3.f09_g16_gl20.TGRCP85IS2.yellowstone_intel + NCK_Ly3.f09_g16_gl20.TGRCP85IS2.yellowstone_pgi + + These all passed, except for these, which are currently expected to fail for + issues unrelated to CISM: + + PEND CME_D.T31_g37.IGCLM45.yellowstone_intel.cism-test_coupling.GC.150219-095007 + PEND CME_Ly5_N2_P2_D.f09_g16.TG1850.yellowstone_intel.GC.150219-095007 + + Also, this comparison failed due to having no history file in the test + case. This is expected and okay - note that this test is about testing the + fields sent to the coupler, so it's fine for this to not have a CISM history + file (and, as a side-note, this was the main test that provided motivation + for this tag, because in Mariana's branch, the ERS comparison of the CISM + history file fails for this test) + + FAIL ERS_D_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.cism.h.compare_hist.cism2_0_05_alpha17d + + Since the CME_D tests currently fail (because of issues unrelated to CISM), I + ran SMS versions of these tests: + + SMS_D.T31_g37.IGCLM45.yellowstone_intel.cism-test_coupling + SMS_Ly5_N2_P2_D.f09_g16.TG1850.yellowstone_intel + + + +Externals used for testing: cesm1_3_alpha17d, with these mods: + + Index: mpi-serial/mpi.h + =================================================================== + --- mpi-serial/mpi.h (revision 1224) + +++ mpi-serial/mpi.h (working copy) + @@ -152,6 +152,8 @@ + + } MPI_Status; + + +#define MPI_STATUS_IGNORE (MPI_Status *)1 + +#define MPI_STATUSES_IGNORE (MPI_Status *)1 + + /* + * Collective operations + Index: mpi-serial/mpif.master.h + =================================================================== + --- mpi-serial/mpif.master.h (revision 1224) + +++ mpi-serial/mpif.master.h (working copy) + @@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) + + INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) + + INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + + Index: mpi-serial/mpif.real4double8.h + =================================================================== + --- mpi-serial/mpif.real4double8.h (revision 1224) + +++ mpi-serial/mpif.real4double8.h (working copy) + @@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) + + INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) + + INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + + Index: mpi-serial/mpif.real8double16.h + =================================================================== + --- mpi-serial/mpif.real8double16.h (revision 1224) + +++ mpi-serial/mpif.real8double16.h (working copy) + @@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) + + INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) + + INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + + Index: mpi-serial/mpif.real8double8.h + =================================================================== + --- mpi-serial/mpif.real8double8.h (revision 1224) + +++ mpi-serial/mpif.real8double8.h (working copy) + @@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) + + INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) + + INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + Index: ccsm_utils/Testlistxml/testmods_dirs/cism/test_coupling/user_nl_cism + =================================================================== + --- ccsm_utils/Testlistxml/testmods_dirs/cism/test_coupling/user_nl_cism (revision 68086) + +++ ccsm_utils/Testlistxml/testmods_dirs/cism/test_coupling/user_nl_cism (working copy) + @@ -1,3 +1,6 @@ + ! This option changes the ice sheet dynamics time step to 1 day rather than 1 year + ! Thus, the ice sheet dynamics can be exercised in a few-day run + test_coupling = .true. + + + +! This option gives us a history file at the end of the run, even for a few-day run + +history_option = 'coupler' + + +cism tag used for baseline comparisons: cism2_0_05 + +Any other externals that differed in baseline: same, but without the mod in +test_coupling/user_nl_cism + +================================================================================ +Originator: sacks +Date: Feb 13, 2015 +Model: cism +Version: cism2_0_06 +One-line summary: Update glimmer-cism external to fix cray compilation problem + +Purpose of changes: + + Fix compilation problem with a string continuation line (bug 2145) + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): 2145 + +List all modified files, and describe the changes: + +*** cism2_141202 -> cism2_150213 +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Just tested the build for these three tests: + + SMS_D.f09_g16_gl4.TGIS2.yellowstone_intel + SMS_D.f09_g16_gl4.TGIS2.yellowstone_pgi + SMS_D.f09_g16_gl4.TGIS2.yellowstone_gnu + +Externals used for testing: cesm1_3_alpha17d + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Dec 02, 2014 +Model: cism +Version: cism2_0_05 +One-line summary: update glimmer-cism external + +Purpose of changes: + + Update to latest development version. Among other things, this includes a bug + fix for basal melt for the higher-order code. + +Changes answers relative to previous tag: YES + + Changes answers for CISM2 compsets + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update from cism2_141119a -> cism2_141202 +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Ran full aux_glc test suite. All tests PASSed. + +Externals used for testing: cesm1_3_beta12 with these diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 65603) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/rollback_timing_updates_tags/rollback_timing_updates_n08_scripts4_141023 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/piscees_testing_tags/piscees_testing_n02_Machines_140923 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,14 +10,14 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + -models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + +models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140918b + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r084//models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + + +cism tag used for baseline comparisons: cism2_0_04 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: Nov 19, 2014 +Model: cism +Version: cism2_0_04 +One-line summary: update glimmer-cism external + +Purpose of changes: + + Point to new external location, in the CESM-Develop github area. + + Update that repo to pull in some minor bug fixes from the piscees repo. + + Also add some error-checking to ensure that beta is present on the input file + if using which_ho_babc = 5. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +-glimmer-cism https://github.com/CISM/cism/tags/v2.0 ++glimmer-cism https://github.com/CESM-Development/cism/tags/cism2_141119a + +Summary of testing: + + Ran full aux_glc test suite (which now just runs on yellowstone). All tests PASSed. + +Externals used for testing: cesm1_3_beta12 with these diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 65521) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/rollback_timing_updates_tags/rollback_timing_updates_n08_scripts4_141023 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/piscees_testing_tags/piscees_testing_n02_Machines_140923 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,14 +10,14 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + -models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + +models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140918b + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r084//models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + +Also, diffs for mpi-serial, as noted below + + +cism tag used for baseline comparisons: cism2_0_03 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: Nov 18, 2014 +Model: cism +Version: cism2_0_03 +One-line summary: tweak namelist options for cism2 + +Purpose of changes: + +- remove 10km support for CISM2: we'll just do testing using the 20km grid + +- add which_ho_approx namelist option + +- for gland20 with cism2, change default dt to 0.5, and default which_ho_babc to 4 + +- decrease dt for gland4 to achieve stability in some of my tests (note that we + need to use a non-round value because dt needs to translate into an integer + number of hours) + + +Changes answers relative to previous tag: YES + + Answers change for cism2 runs due to changes in default namelist options + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + + +Summary of testing: + + Ran two versions of the aux_glc yellowstone tests. (Note that I am removing the + aux_glc titan tests). The final set used externals as listed below. The earlier + set used rollback_timing_updates_n05_scripts4_141023 (up-to-date with + rework_glc_compsets_n04_scripts4_141112a). All tests passed in the final set of + tests. In the earlier set, ERS_Ly3.f09_g16_gl4.TGIS2.yellowstone_intel failed + simply because there were no lines compared in the cpl log file (cpl hist files + were bfb). + + There were lots of BFAILs, because I have totally reworked the test + list. However, there were still quite a few compare_hist PASSes. + + These failed compare_hist, due to changes in default length of TG tests: + + SMS_D.f09_g16_gl10.TG.yellowstone_pgi + SMS_D.f09_g16.TG.yellowstone_intel + +Externals used for testing: cesm1_3_beta12 with these diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 65521) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/rollback_timing_updates_tags/rollback_timing_updates_n08_scripts4_141023 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/piscees_testing_tags/piscees_testing_n02_Machines_140923 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,14 +10,14 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + -models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + +models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140918b + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r084//models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + +Also, diffs for mpi-serial, as noted below + + +cism tag used for baseline comparisons: cism2_0_00 + +Any other externals that differed in baseline: see below for externals used for cism2_0_00 + +================================================================================ +Originator: sacks +Date: Nov 5, 2014 +Model: cism +Version: cism2_0_02 +One-line summary: modify tools for creating glcmask files + +Purpose of changes: + + The toolchain for creating glcmask files is out-dated and didn't work exactly + how I wanted it to. I have made the following modifications: + + (1) Create mapping file using the shared CESM tools, rather than the outdated + tool that used to be contained here. + + (2) It was getting awkward to support all combinations of CLM grid x CISM + grid. Thus, I have rewritten the documentation to just do this glcmask + generation for a single CISM grid. From a quick look at the different + existing glcmask files, as well as the different CISM grids that we + currently support, I don't think the choice of CISM grid should make a + significant difference in this glcmask file. I have (somewhat + arbitrarily) chosen the (old) 5km CISM grid for this purpose. + + (3) Remove dependence on CLM's landfrac. This dependence seems unnecessary, + and fragile in the face of potentially changing ocean grids. With this + change, the overlap file contains a 1 value in any CLM grid cell that + overlaps a CISM grid cell, regardless of whether this grid cell has any + land according to landfrac. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +D tools/scrip_make_wgts_CCSM_to_GLC_bilin.csh +M tools/README.glc_tools +M tools/scrip2CLMoverlap.ncl +M tools/glc2scripConvert.ncl +M tools/README.glc_overlap_tools + + +Summary of testing: + + Did NOT run any aux_glc tests, because I have only changed these offline + tools. + + I have tested the new tool-chain by creating glcmask files for the 3 + supported CLM resolutions. These new glcmask files have been committed to the + inputdata repository. + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Oct 31, 2014 +Model: cism +Version: cism2_0_01 +One-line summary: Update ChangeLog entry for last tag + +Purpose of changes: + +Add stuff to ChangeLog that was accidentally excluded from the last tag + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M ChangeLog + +Summary of testing: none + +Externals used for testing: n/a + +cism tag used for baseline comparisons: n/a + +Any other externals that differed in baseline: n/a + +================================================================================ +Originator: sacks +Date: Oct 31, 2014 +Model: cism +Version: cism2_0_00 +One-line summary: Point to cism2 release code base + +Purpose of changes: + +Update glimmer-cism external to point to recently-released cism2 code base. This +pulls in developments that have been made over the last year in the private +PISCEES repo. + +In addition, a number of misc. changes to namelist defaults, build options, +etc. to work smoothly with new code base. + +Changes answers relative to previous tag: No answer changes for +SIA. Higher-order code (using glissade dycore) finally works! + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Point to cism2 release code base +M SVN_EXTERNAL_DIRECTORIES + +*** Change default config options for cism2 runs, including using glissade + dycore and allowing runs at 4km resolution (trilinosOptions for 4km simply + copies the 5km file). Also add some error checking for the match between + cism_phys (cism1/cism2) and resolution. +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml +M bld/build-namelist +A bld/trilinosOptions/trilinosOptions_gland4.xml + +*** Some changes to accommodate changes made in the glimmer-cism code or build + system. Also, switch to always using parallel_mpi (rather than + parallel_slap), because that's easier than trying to come up with a rule for + when we need one or the other. +M bld/cism.buildexe.csh +M bld/cism.cpl7.template +M source_glc/glc_io.F90 + + +Summary of testing: + + Ran full aux_glc test suite, on yellowstone and titan. All tests PASS! + + In addition, ran these tests from the prebeta test list: + + PASS SMS.T31_g37_gl10.BGCNIS2.yellowstone_intel + PASS SMS.T31_g37_gl10.BGCNIS2.yellowstone_intel.memleak + PASS SMS_Ly2.f09_g16_gl10.TGIS2.yellowstone_intel + PASS SMS_Ly2.f09_g16_gl10.TGIS2.yellowstone_intel.memleak + + +Externals used for testing: cesm1_3_beta12 with the following diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 64812) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/rollback_timing_updates_tags/rollback_timing_updates_n02_scripts4_141023 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/piscees_testing_tags/piscees_testing_n01_Machines_140923 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,14 +10,14 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + -models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + +models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140918b + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r084//models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + + In addition, the following diffs in my yellowstone sandbox, which are needed + for the PEA tests: + +Index: models/utils/mct/mpi-serial/mpi.h +=================================================================== +--- models/utils/mct/mpi-serial/mpi.h (revision 1122) ++++ models/utils/mct/mpi-serial/mpi.h (working copy) +@@ -152,6 +152,8 @@ + + } MPI_Status; + ++#define MPI_STATUS_IGNORE (MPI_Status *)1 ++#define MPI_STATUSES_IGNORE (MPI_Status *)1 + + /* + * Collective operations +Index: models/utils/mct/mpi-serial/mpif.master.h +=================================================================== +--- models/utils/mct/mpi-serial/mpif.master.h (revision 1122) ++++ models/utils/mct/mpi-serial/mpif.master.h (working copy) +@@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) ++ INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) ++ INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + +Index: models/utils/mct/mpi-serial/mpif.real4double8.h +=================================================================== +--- models/utils/mct/mpi-serial/mpif.real4double8.h (revision 1122) ++++ models/utils/mct/mpi-serial/mpif.real4double8.h (working copy) +@@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) ++ INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) ++ INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + +Index: models/utils/mct/mpi-serial/mpif.real8double16.h +=================================================================== +--- models/utils/mct/mpi-serial/mpif.real8double16.h (revision 1122) ++++ models/utils/mct/mpi-serial/mpif.real8double16.h (working copy) +@@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) ++ INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) ++ INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + +Index: models/utils/mct/mpi-serial/mpif.real8double8.h +=================================================================== +--- models/utils/mct/mpi-serial/mpif.real8double8.h (revision 1122) ++++ models/utils/mct/mpi-serial/mpif.real8double8.h (working copy) +@@ -132,6 +132,8 @@ + + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) ++ INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) ++ INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + + + +cism tag used for baseline comparisons: cism1_141006 and +piscees_n13_cism1_141006 + + yellowstone testing: + + - CISM1 tests bfb with cism1_141006, according to both cism & cpl hist + files; CISM2 tests BFAIL with this comparison because the tests were + failing on the trunk until now + + - All tests (CISM1 & CISM2) bfb with piscees_n13_cism1_141006, according to + both cism & cpl hist files + + titan testing: + + - just compared with piscees_n13_cism1_141006; all tests bfb + +Any other externals that differed in baseline: externals were similar, but +possibly not identical in the baseline + +================================================================================ +Originator: sacks +Date: Oct 6, 2014 +Model: cism +Version: cism1_141006 +One-line summary: update glimmer-cism to relax tolerances in glimmer_sparse.F90 + +Purpose of changes: + +Merge r1571 from piscees repo for +libglimmer-solve/glimmer_sparse.F90. This relaxes the tolerances from +1e-11 to 1e-8. + +My purpose in merging this change into the cesm repo is so that SIA +answers can remain bfb between the cesm repo and the piscees repo. + +Changes answers relative to previous tag: YES + + Changes answers for all runs that are long enough to trigger the main CISM code + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update to r64084 +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + All IS2 tests fail (as usual) + + Baseline comparisons fail for many tests, as expected + +Externals used for testing: cesm1_3_beta12, with these diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 64083) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140916c + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,7 +10,7 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + @@ -17,7 +17,7 @@ + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r084//models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + + +cism tag used for baseline comparisons: cism1_140914 + +Any other externals that differed in baseline: See ChangeLog entry for +cism1_140914 - in particular, externals that differed from cesm1_3_beta12 used +branch versions for cism1_140914 + +================================================================================ +Originator: sacks +Date: Sept 16, 2014 +Model: cism +Version: cism1_140916 +One-line summary: Fix ChangeLog entry for cism1_140914 + +Purpose of changes: + + I realized that I incorrectly described the reason for answer changes in the + IG CLM40 test. I'm fixing that here. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M ChangeLog + + +Summary of testing: NONE + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Sept 14, 2014 +Model: cism +Version: cism1_140914 +One-line summary: Add zero_gcm_fluxes option; send icemask_coupled_fluxes field to coupler + +Purpose of changes: + +In talking with Dave Lawrence, Bill Lipscomb and Jeremy Fyke, I realized that we +need to introduce more logic to distinguish between active icesheets and +diagnostic-only icesheets. + +One aspect of this is the ability to zero out the fluxes CISM sends to the +coupler (currently runoff fluxes; later also the heat flux). That way, by +zeroing out these fluxes and turning off the connection to CLM, we can continue +to run with an evolving ice sheet in diagnostic-only mode (i.e., 1-way +coupling). This is achieved via the new zero_gcm_fluxes option. The default for +zero_gcm_fluxes is based on the GLC_TWO_WAY_COUPLING xml variable. The current +logic in scripts sets GLC_TWO_WAY_COUPLING to true for CLM45 (or later) compsets +with CISM, and for TG compsets; otherwise (for CLM40, or for compsets without +CISM) this is set to false. + +In addition, I realized the need to distinguish between areas of active +icesheets and areas of either no icesheet or diagnostic-only icesheets in +applying CLM's glc_dyn_runoff_routing switch. In particular, we should only use +the new runoff routing scheme over areas of icesheet that are generating calving +fluxes. From the perspective of CISM, this is achieved by computing and sending +a new icemask_coupled_fluxes field to the coupler (which is then passed to +CLM). icemask_coupled_fluxes is similar to the existing icemask field, but is +zero over icesheet instances for which zero_gcm_fluxes is true - which will be +the case for icesheets that are not generating calving fluxes (e.g., +diagnostic-only icesheets). + +Changes answers relative to previous tag: YES + + Changes icemask at the roundoff-level, for some resolutions and compilers + + Also, in combination with the new scripts, zeroes out runoff fluxes sent to + coupler (g2x_Fogg_rofl and g2x_Fogg_rofi). + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update to r63495: glint changes needed to support the above changes +M SVN_EXTERNAL_DIRECTORIES + +*** add zero_gcm_fluxes namelist option +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +*** send icemask_coupled_fluxes field to the coupler +M drivers/cpl/glc_cpl_indices.F90 +M drivers/cpl/glc_import_export.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_fields.F90 + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + All IS2 tests fail (as usual) + + compare_hist failures: + + FAIL CME_Ly5.T31_g37.IG.yellowstone_intel.clm-reduceOutput.compare_hist.cism1_140602_beta12 + FAIL ERS_Ly5.T31_g37.IGCLM45.yellowstone_intel.clm-glcMEC_long.compare_hist.cism1_140602_beta12 + FAIL SMS_D.T31_g37.BG1850CN.yellowstone_intel.compare_hist.cism1_140602_beta12 + + These show roundoff-level changes in icemask. In addition, the CME test has + large diffs in g2x_Fogg_rofl and g2x_Fogg_rofi: These fields are identically + 0 in the new run. This makes sense, since zero_gcm_fluxes is set to true for + this CLM40 run (which arises in combination with the new scripts version, + which sets GLC_TWO_WAY_COUPLING to FALSE for this run). + + +Externals used for testing: cesm1_3_beta12, with these diffs: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 63201) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,8 +1,8 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140813 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/glc_runoff_routing_tags/glc_runoff_routing_n01_scripts4_140814a + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/bluewatersfix_Machines_140811_tags/bluewatersfix02_Machines_140811 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_140625 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_15 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/glc_runoff_routing_tags/glc_runoff_routing_n01_drvseq5_0_15 + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20140708/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_45/models/atm/cam/ + @@ -10,7 +10,7 @@ + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140602 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/glc_runoff_routing + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xglc + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20140711 + @@ -17,7 +17,7 @@ + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r079//models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/glc_runoff_routing_tags/glc_runoff_routing_n02_clm4_5_1_r081 + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_8_00/xlnd + +However, for the PEA test, I merged the changes from scripts4_140903b into the sandbox. + + +cism tag used for baseline comparisons: cism1_140602 + +Any other externals that differed in baseline: Baseline used cesm1_3_beta12 with +updated scripts (scripts4_140905???) + +================================================================================ +Originator: sacks +Date: June 2, 2014 +Model: cism +Version: cism1_140602 +One-line summary: Update glimmer-cism external with some fixes for CISM2 + +Purpose of changes: + + Update glimmer-cism external with the following fixes: + + (1) update CMakeLists.txt to fix the yellowstone build when building with trilinos + + (2) fix downscaling of fields in elevation class 0 when running with multiple processors + + (3) set halo values in glint downscaling using parallel_halo calls + +Changes answers relative to previous tag: NO (at least not for CISM1 [SIA] runs) + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update to r60744 +M SVN_EXTERNAL_DIRECTORIES + + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.140530-154133 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.140530-154116 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.140530-154116 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.140530-154116 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.140530-154116 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.140530-154116 + + Note: The IS2 runs now get further than before, because of problems that have + been fixed in this tag. e.g., SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel + gets up to a conservation error before stopping (in contrast to dying due to + a floating point problem or some other problem previously). + + However, the IGIS2 test fails with: + + 0:NOXSolve called + 0: + 0:************************************************************************ + 0:-- Nonlinear Solver Step 0 -- + 0:||F|| = inf step = 0.000e+00 dx = 0.000e+00 + 0:************************************************************************ + 0: + 35: + 35:p=35: *** Caught standard std::exception of type 'Belos::StatusTestError' : + 35: + 35: /glade/u/home/rory/trilinos-11.0.3-Source/packages/belos/src/BelosStatusTestGenResNorm.hpp:574: + 35: + 35: Throw number = 1 + 35: + 35: Throw test that evaluated to true: true + 35: + 35: StatusTestGenResNorm::checkStatus(): NaN has been detected. + 35:INFO: 0031-306 pm_atexit: pm_exit_value is 1. + + +Externals used for testing: cesm1_3_beta07, with many diffs - as in cism1_140501 + +cism tag used for baseline comparisons: cism1_140501 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: jfyke, sacks +Date: May 1, 2014 +Model: cism +Version: cism1_140501 +One-line summary: Add an elevation class 0, for bare land SMB + +Purpose of changes: + + Changes from Jeremy Fyke to add an elevation class 0, for bare land SMB. Also + adds ice_sheet_grid_mask. Also some minor, unrelated changes as noted below. + + This involves extensive changes to glint, as well as some changes to the glc + code. + + In addition, this tag pulls in an unrelated change to the glimmer-cism + external: a fix from Stephen Cornford for glint_mbal_io. + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_override_frac.F90 +M source_glc/glc_global_fields.F90 +M drivers/cpl/glc_cpl_indices.F90 + +*** Also, clean up interfaces for glc_import & glc_export ('use' things directly + rather than having them passed through the interface) +M drivers/cpl/glc_comp_mct.F90 +M drivers/cpl/glc_comp_esmf.F90 +M drivers/cpl/glc_import_export.F90 + +*** Use some constants from shr_const_mod +M source_glc/glc_constants.F90 + +*** Add an option to decrease the mass balance time step, for testing purposes + (currently not exercised in any tests) +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures (note: the GEN cases probably would have given CFAIL if I had been + patient): + +CFAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.140430-125442 +CFAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.140430-125442 +FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.140430-125442 +GEN SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.140430-125442 +GEN SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.140430-125442 +CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.140430-125445 + + Note: I am now getting a CFAIL instead of a FAIL for the IS2 cases... seems + to be something having to do with the yellowstone upgrade... I'm guessing + it's a problem with the C++/Fortran link. I get this message: + + cannot find -lmkl_rt + +Externals used for testing: cesm1_3_beta07, but with quite a few changes: + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (revision 59711) + +++ SVN_EXTERNAL_DIRECTORIES (working copy) + @@ -1,23 +1,23 @@ + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140113 + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_140124 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/add_dynlu_tests_tags/add_dynlu_tests_n02_scripts4_140305 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_01_mach140218 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_131224 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_131217a + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_08 + -models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_131231 + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/bare_land_smb_tags/bare_land_smb_n02_drvseq5_0_08 + +models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/shr_assert_macro_tags/shr_assert_macro_n04_share3_140115 + scripts/validation_testing https://svn-ccsm-models.cgd.ucar.edu/validation_testing/trunk_tags/validation_20131108/run_CESM/ + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_3_23/models/atm/cam + -models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_131201 + +models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_140114 + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xatm + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/dead_share + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_131213 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branch_tags/bare_land_smb_tags/bare_land_smb_n06_cism1_140416 + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xglc + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20131002 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_131201 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xice + -models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_57/models/lnd/clm + +models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/bare_land_smb_tags/bare_land_smb_n14_clm4_5_70/models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xlnd + @@ -27,16 +27,16 @@ + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/socn + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xocn + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_131201 + -models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_36 + +models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_37 + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/srof + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xrof + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 + models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n04_MCT_2.8.3 + -models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_7/pio + +models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_11/pio + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_131108 + models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/swav + models/wav/ww3 https://svn-ccsm-models.cgd.ucar.edu/ww3/trunk_tags/ww3_130905 + models/wav/xwav https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_09/xwav + -scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140116 + +scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140403 + scripts/doc https://svn-ccsm-models.cgd.ucar.edu/doc/trunk_tags/doc_131021 + tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_04 + + +cism tag used for baseline comparisons: cism1_140303 + +Any other externals that differed in baseline: See notes under cism1_140303 below + +================================================================================ +Originator: muszala +Date: April 16, 2014 +Model: cism +Version: cism1_140416 +One-line summary: bring in SHR_ASSERT macros + +Purpose of changes: Removed 'use shr_assert_mod' statements and replace +'call shr_assert' with SHR_ASSERT or SHR_ASSERT_ALL where appropriate. +Add #include "shr_assert.h" to modules where macro is used. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): N/A + +List all modified files, and describe the changes: + +M source_glc/glc_override_frac.F90 +M drivers/cpl/glc_comp_mct.F90 +M drivers/cpl/glc_comp_esmf.F90 +M drivers/cpl/glc_import_export.F90 + +Summary of testing: + +Tested along with clm4_5_70. This includes yellowstone+{intel,pgi} and +goldbach+{nag,pgi,intel} and component comp. gen with ys+intel. + +Externals used for testing: alpha09b + +Cism tag used for baseline comparisons: cism1_140303 in clm4_5_69 + +Any other externals that differed in baseline: Many, including: Pio, Mct, timing, +scripts, machines. Please compare clm4_5_69 and clm4_5_70 for all details. + +================================================================================ +Originator: sacks +Date: April 3, 2014 +Model: cism +Version: cism1_140403 +One-line summary: fix allocate statement so it works with gfortran + +Purpose of changes: + + I accidentally used a F2008 feature - trying to pick up array dimensions with + allocate(..., source=...); I have fixed this. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M drivers/cpl/glc_import_export.F90 + +Summary of testing: + + Just ran a subset of tests: + +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534.memleak +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534.generate.cism1_140403 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534.compare_hist.cism1_140305 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534.memcomp.cism1_140305 +FAIL SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140403-132534.tputcomp.cism1_140305 +COMMENT tput_decr = 8.0199999 tput_decr = 3.7669999 + +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608.memleak +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608.generate.cism1_140403 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608.compare_hist.cism1_140305 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608.memcomp.cism1_140305 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140403-132608.tputcomp.cism1_140305 +COMMENT tput_decr = 2.2609999 + +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743 +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743.memleak +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743.generate.cism1_140403 +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743.compare_hist.cism1_140305 +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743.memcomp.cism1_140305 +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140403-140743.tputcomp.cism1_140305 + +And from component_gen_comp: + +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.compare_hist.cism1_140305.cism.h +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.generate.cism.h + +PASS SMS_D.f09_g16.TG.yellowstone_intel.compare_hist.cism1_140305.cism.h +PASS SMS_D.f09_g16.TG.yellowstone_intel.generate.cism.h + +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.compare_hist.cism1_140305.cism.h +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.generate.cism.h + + +Externals used for testing: cesm1_3_beta07, but scripts4_140305 and Machines_140227 + +cism tag used for baseline comparisons: cism1_140305 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: March 5, 2014 +Model: cism +Version: cism1_140305 +One-line summary: fix capping of increase_frac override + +Purpose of changes: + + The capping of inrease_frac was accidentally capping each elevation class at + 100%, when it should be capping the sum of elevation classes at 100%. That is + now fixed. + +Changes answers relative to previous tag: NO (only changes test cases that use increase_frac) + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M source_glc/glc_override_frac.F90 + +Summary of testing: + + Just ran a subset of tests: + +PASS ERS_Ld9.f19_g16.IGCLM45.yellowstone_pgi.cism-override_glc_frac.GC.140305-092736 + +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.memleak +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.generate.cism1_140305 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.compare_hist.cism1_140303 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.memcomp.cism1_140303 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.tputcomp.cism1_140303 +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi.GC.140305-093532.nlcomp + +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.memleak +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.generate.cism1_140305 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.compare_hist.cism1_140303 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.memcomp.cism1_140303 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.tputcomp.cism1_140303 +PASS SMS_D.f09_g16.TG.yellowstone_intel.GC.140305-093417.nlcomp + +Externals used for testing: cesm1_3_beta07, but scripts4_140305 and Machines_140227 + +cism tag used for baseline comparisons: cism1_140303 + +Any other externals that differed in baseline: baseline used scripts4_140221a + +================================================================================ +Originator: sacks +Date: March 3, 2014 +Model: cism +Version: cism1_140303 +One-line summary: add options to override glc frac sent to cpl, for testing + +Purpose of changes: + + Put in place a number of namelist settings that can be used to modify the glc + frac sent from GLC -> CPL. The point of this is to push CLM's dynamic + landunits in various ways (e.g., going from 0% glacier to non-zero glacier, + from 100% glacier down to 0% glacier, etc.). + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml +M source_glc/glc_InitMod.F90 +A source_glc/glc_override_frac.F90 +M source_glc/glc_global_fields.F90 +M drivers/cpl/glc_import_export.F90 + +*** Unrelated change: fix documentation +M bld/README.build-namelist + + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + +FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.140228-162551 +FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.140228-162551 +FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.140228-162551 +FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.140228-162551 +FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.140228-162551 +CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.140228-162555 + + +Externals used for testing: cesm1_3_beta07, but scripts4_140221a and Machines_140227 + +cism tag used for baseline comparisons: cism1_140203 + +Any other externals that differed in baseline: baseline used cesm1_3_beta07, unmodified + +================================================================================ +Originator: sacks +Date: Feb 3, 2014 +Model: cism +Version: cism1_140203 +One-line summary: fix exact restart problem with cism -> cpl fields + +Purpose of changes: + + Update glimmer-cism external to fix an exact restart problem that appears + with a few of the cism -> cpl fields - specifically, the rofi, rofl and hflx + fields. This problem showed up with runs with daily (rather than annual) + coupling - i.e., all compsets other than TG. For example, this test was + failing: + + ERS_Ly5.T31_g37.IGCLM45.yellowstone_intel + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update from r55984 -> r56989 +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + +CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.140129-134856 +BFAIL ERS_Ly5.T31_g37.IGCLM45.yellowstone_intel.GC.140129-134851.compare_hist.cism1_131213_beta07 +FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.140129-134851 +FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.140129-134851 +FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.140129-134851 +FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.140129-134851 +FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.140129-134851 + + +Externals used for testing: cesm1_3_beta07 + +cism tag used for baseline comparisons: cism1_131213 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: Dec 13, 2013 +Model: cism +Version: cism1_131213 +One-line summary: update glimmer-cism external + +Purpose of changes: + + Update glimmer-cism external to r55984. The main change here is to remove + prevtemp from the computation of the diagnostic quantity dTtop; this changes + answers for hflx, but nothing else. + +Changes answers relative to previous tag: YES + + Just changes answers for the hflx term sent to the coupler. Diffs are + generally about 1e-6 (relative error), though some RMS errors are as large as + 1e-4 (relative error). + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.143014 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.143009 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.143009 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.143009 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.143009 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.143009 + +Externals used for testing: cesm1_3_beta05 + +cism tag used for baseline comparisons: cism1_131212a + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: Dec 12, 2013 +Model: cism +Version: cism1_131212a +One-line summary: update glimmer-cism external + +Purpose of changes: + + Update glimmer-cism external from r55935 to r55978. This changes the number + of seconds in a year to exactly 365 days, in agreement with the rest of CESM. + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.142829 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.142824 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.142824 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.142824 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.142824 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.142824 + + +Externals used for testing: cesm1_3_beta05 + +cism tag used for baseline comparisons: cism1_131212 + +Any other externals that differed in baseline: none + +================================================================================ +Originator: sacks +Date: Dec 12, 2013 +Model: cism +Version: cism1_131212 +One-line summary: update glimmer-cism external, fixing fields sent from glc to cpl + +Purpose of changes: + + Update glimmer-cism external from r54059 to r55935. The main changes here + involve fixing the fields sent from glc to the CESM coupler - specifically, + rofi, rofl and hflx. Also, a few other minor changes. + +Changes answers relative to previous tag: YES + + Changes answers for all fields sent from GLC -> CPL: SIGNIFICANT differences + for hflx, rofi and rofl; and roundoff-level changes for frac and topo. + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.133413 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.133404 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.133404 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.133404 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.133404 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.133404 + + +Externals used for testing: cesm1_3_beta05 + +cism tag used for baseline comparisons: cism1_131203 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: Dec 3, 2013 +Model: cism +Version: cism1_131203 +One-line summary: call glc_export in mct initialization + +Purpose of changes: + + With the changes in cism1_131008, the esmf side had been changed to call + glc_export in initialization, but the mct side had not been changed + similarly. This tag makes a simple change to the mct side so that CME tests + now pass. (This problem was missed in the testing for cism1_131008 because it + only shows up in IG/FG/BG compsets, which were excluded from the testing of + that tag.) + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M drivers/cpl/glc_comp_mct.F90 + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following expected + failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.103449 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.103445 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.clm-reduceOutput.GC.103445 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.103445 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.103445 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.clm-reduceOutput.GC.103445 + + Note that this test failed in the baseline: + + CME_Ly5.T31_g37.IG.yellowstone_intel.clm-reduceOutput + + However, I manually compared the cpl hist files, and they are identical in + the new tag compared with the baseline. + +Externals used for testing: cesm1_3_beta05 + +cism tag used for baseline comparisons: cism1_131008 + +Any other externals that differed in baseline: None (baselines also generated +from cesm1_3_beta05) + +================================================================================ +Originator: sacks, mvertens +Date: Oct 8, 2013 +Model: cism +Version: cism1_131008 +One-line summary: Mariana's changes to cpl infrastructure, update external + +Purpose of changes: + +(1) Bring in Mariana's refactoring of the cpl infrastructure + +(2) Point glimmer-cism external to new repository location + +(3) Small update to glimmer-cism external: Bring in Matt Hoffman's +change to the logic for allocating isostasy variables + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** (1) above +M bld/cism.buildexe.csh +D drivers/cpl_share +D drivers/cpl_mct +D drivers/cpl_esmf +A drivers/cpl/glc_comp_mct.F90 +A drivers/cpl/glc_comp_esmf.F90 +A drivers/cpl/glc_import_export.F90 +A drivers/cpl/glc_coupling_flags.F90 +A drivers/cpl/glc_cpl_indices.F90 +A drivers/cpl + +*** (2) and (3) above +M SVN_EXTERNAL_DIRECTORIES + + +Summary of testing: + + Ran just a subset of the yellowstone intel & pgi test lists: Just the TG + CISM1 tests. It was not ideal to exclude the IG / FG / BG tests, but I made + this compromise because yellowstone is down. + + All PASS except the following expected failure: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.215132 + + Update 12-2-13: Ran IG / FG / BG CISM1 tests; all pass EXCEPT: + + *** Known failure; working on resolving this + FAIL CME_Ly5.T31_g37.IG.yellowstone_intel.GC.100040 + + *** Diffs only in x2l_Flrr_volr + FAIL ERI.f19_g16.IGRCP85CN.yellowstone_pgi.GC.100111.compare_hist.cism1_130924 + + (component_gen_comp: all PASS, including the two above test failures) + +Externals used for testing: cesm1_3_alpha04c + +cism tag used for baseline comparisons: cism1_130924 + +Any other externals that differed in baseline: Baseline used externals at cesm1_3_beta03 + +================================================================================ +Originator: sacks +Date: Sept 24, 2013 +Model: cism +Version: cism1_130924 +One-line summary: Update glimmer-cism external to r1966 + +Purpose of changes: Bring in latest glimmer-cism external - update from r1950 to +r1966 + +Changes answers relative to previous tag: No diffs according to test suite, +although log messages suggest there may have been some small answer changes. + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following + expected failures: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.162146 + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.162141 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.162141 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.162141 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.162141 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.162141 + + +Externals used for testing: cesm1_3_beta03 + +cism tag used for baseline comparisons: cism1_130905 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks, tcraig +Date: Sept 5, 2013 +Model: cism +Version: cism1_130905 +One-line summary: rework coupling fields, update glimmer-cism external + +Purpose of changes: + +(1) Rework the runoff coupling fields (rofi & rofl) to fit in with Tony Craig's + coupler changes. These fields are now routed to the ocean and/or sea ice, + instead of to the land. Also, these are no longer separated by elevation + class. + +(2) Update glimmer-cism external from r1936 -> r1950. This brings in a number of + changes. The most important are some changes from Bill Lipscomb that fix + some of the g2x coupling fields, and remove the elevation class dimension + from the g2x rofi & rofl fields. + + +Changes answers relative to previous tag: YES + Changes all of the g2x coupling fields. + However, CISM history files are bfb + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Changes to coupling fields as described above +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_fields.F90 +M drivers/cpl_share/glc_cpl_indices.F90 +M drivers/cpl_mct/glc_comp_mct.F90 +M drivers/cpl_esmf/glc_comp_esmf.F90 + +*** Routines to determine whether to send calving flux to ocean or sea ice +A source_glc/glc_route_ice_runoff.F90 +A drivers/cpl_share/glc_coupling_flags.F90 + +*** Add a namelist option to choose where calving flux should go +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +*** Update from r1936 -> r1950 +M SVN_EXTERNAL_DIRECTORIES + + + +Summary of testing: + + Yellowstone intel & pgi test lists. Testing was done in the context of Tony + Craig's changes, which involved the coupler and many other components. The + testing documented here was done on cplupa_n03_cism1_130624. + + Baseline comparisons fail for g2x fields and the derived x2l fields. CISM + history files are bfb according to component_gen_comp. + + Test failures are: + + *** Expected failures + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel + + *** Failures in IG/FG tests that I think are expected (note: these all failed + in the baseline, too; also note that I have TG tests that cover the same + kind of functionality - e.g., a CME TG test - so this likely points to + problems outside of GLC; also, Tony says that the IG failures are + expected) + FAIL ERI.f19_g16.IGRCP85CN.yellowstone_pgi + FAIL SMS_D.f09_g16.IG20TR.yellowstone_pgi + FAIL CME_Ly5.T31_g37.IG.yellowstone_intel + FAIL SMS.f19_f19.FG20TRCN.yellowstone_intel + + +Externals used for testing: + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/cesmcosp_cam5_3_xx_tags/cesmcosp_n01_cam5_3_04/models/atm/cam + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130424 + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/satm + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm130325 + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_06/xatm + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/cplupa_tags/cplupa_n01_share3_130528 + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/dead_share + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/cplupa_tags/cplupa_n02_drvseq4_2_33 + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/cplupa + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/sglc + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xglc + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/branch_tags/cplupa_tags/cplupa_n01_cice4_0_20130524 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/branch_tags/cplupa_tags/cplupa_n01_dice8_130313 + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/sice + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xice + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/cplupa_tags/cplupa_n02_clm4_5_11/models/lnd/clm + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/branch_tags/cplupa_tags/cplupa_n01_dlnd8_130213 + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/slnd + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xlnd + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_130313 + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20130517 + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/socn + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xocn + models/ocn/aquap https://svn-ccsm-models.cgd.ucar.edu/aquap/trunk_tags/aquap_130503 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_130503 + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/branch_tags/cplupa_tags/cplupa_n01_rtm1_0_28 + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/srof + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xrof + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 + models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n03_MCT_2.8.3 + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_7_2/pio + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130506 + models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/branch_tags/cplupa_tags/cplupa_n02_stubs1_4_02/swav + models/wav/ww3 https://svn-ccsm-models.cgd.ucar.edu/ww3/trunk_tags/ww3_130314 + models/wav/xwav https://svn-ccsm-models.cgd.ucar.edu/dead7/branch_tags/cplupa_tags/cplupa_n02_dead7_7_06/xwav + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/cplupa_tags/cplupa_n02_scripts4_130627 + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130625 + tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130529 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130509 + + +cism tag used for baseline comparisons: cplupa_n02_cism1_130624 + Note: I removed the rofi & rofl coupling stuff from cism so that it would + work in the context of the above externals + +Any other externals that differed in baseline: Same as above + +================================================================================ +Originator: sacks +Date: June 24, 2013 +Model: cism +Version: cism1_130624 +One-line summary: update glimmer-cism external + +Purpose of changes: + +Update glimmer-cism external, from r1876 to r1936. + +Also update documentation of config options. + + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES +M bld/namelist_files/namelist_definition_cism.xml + + +Summary of testing: + + Yellowstone intel & pgi test lists. All PASS except the following + expected failures: + + *** No ESMF for PGI + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.163141 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.163141 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.163141 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.163141 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.163141 + + + Note that nlcomp failed for 10km & 20km, as expected (with + comparison to cism1_130514) + + +Externals used for testing: cesm1_2_beta08, with scripts @ scripts4_130513b + +cism tag used for baseline comparisons: cism1_130514 + +Any other externals that differed in baseline: None. + +================================================================================ +Originator: sacks +Date: May 24, 2013 +Model: cism +Version: cism1_130524 +One-line summary: change idiag & jdiag for 10km & 20km; allow other + sigma values; fix some namelist documentation + + +Purpose of changes: (see summary) + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +Summary of testing: + + Ran the following with comparison to baseline (but NOT component_gen_comp): + SMS_D.f09_g16_gl10.TG.yellowstone_pgi + ERS_Ly20.f09_g16.TG1850.yellowstone_intel + SMS_D.f09_g16.TG.yellowstone_intel + + Ran the following with NO comparison to baseline: + SMS_D.f09_g16.IG20TR.yellowstone_intel + + Also, ran the following with CISM_GRID=gland20, also with + comparison to baseline (including component_gen_comp): + SMS.f09_g16.TG.yellowstone_pgi + + Note that nlcomp failed for 10km & 20km, as expected + +Externals used for testing: cesm1_2_beta08, with scripts @ scripts4_130513b + +cism tag used for baseline comparisons: cism1_130514 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: May 14, 2013 +Model: cism +Version: cism1_130514 +One-line summary: Update glimmer-cism: use double-precision for all variables + +Purpose of changes: + +Bring in changes from Bill L to convert all variables to double precision + + +Changes answers relative to previous tag: YES -- answers change by +single-precision roundoff (as expected), along with some slightly unexpected, +large changes around the continental margin (at least in acab & temp) + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update from r1863 -> r1876 +M SVN_EXTERNAL_DIRECTORIES + +*** Change some variables to double precision +M source_glc/glc_InitMod.F90 + + +Summary of testing: + + Yellowstone intel & pgi test lists. For this testing, I have switched over to + using the xml-based test lists, since they have been fixed to include all + desired tests in the latest scripts tag. + + Baseline comparisons fail, as expected. Other than that, failures are: + + *** No ESMF for PGI + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.094304 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.094301 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.094301 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.094301 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.094301 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.094301 + + +Externals used for testing: cesm1_2_beta08, with scripts @ scripts4_130513b + +cism tag used for baseline comparisons: cism1_130502 + +Any other externals that differed in baseline: Unsure... I may have used +cesm1_2_beta06 for the baseline by accident, but it doesn't really matter +because there are known baseline differences in this new tag. + +================================================================================ +Originator: sacks +Date: May 2, 2013 +Model: cism +Version: cism1_130502 +One-line summary: Update glimmer-cism: fix restart bugs, clean-up from Bill L + +Purpose of changes: + +Update glimmer-cism from r1849 -> 1863, mainly for two purposes: + +- Fixes for restart bugs in non-default configurations (from Matt Hoffman) + +- Clean-up (mostly of comments) from Bill Lipscomb + + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + + Yellowstone intel & pgi test lists. I used the plain text test lists as they + existed before the conversion of test lists to xml, because there were some + missing tests in the xml + + All PASS except: + + *** No ESMF for PGI + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.150138 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.150142 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.150142 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.150142 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.150142 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.150142 + +Externals used for testing: cesm1_2_beta06, but PIO @ pio1_6_8 + +cism tag used for baseline comparisons: cism1_130430a + +Any other externals that differed in baseline: No differences + +================================================================================ +Originator: sacks +Date: April 30, 2013 +Model: cism +Version: cism1_130430a +One-line summary: Update glimmer-cism external, including getting restarts to + work for evolution=2; also add some config options + +Purpose of changes: + +- Update external (1846 -> 1849): + - some cleanup from Bill Lipscomb + - get restarts to work with evolution=2 + +- Add some config options to namelist_definition file + + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_definition_cism.xml +M SVN_EXTERNAL_DIRECTORIES + + +Summary of testing: + + Yellowstone intel & pgi test lists. I used the plain text test lists as they + existed before the conversion of test lists to xml, because there were some + missing tests in the xml + + All PASS except: + + *** No ESMF for PGI + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.084959 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.085004 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.085004 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.085004 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.085004 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.085004 + + + Also ran all CISM1 tests from a sandbox that set evolution=2, + dt=0.0083333333333333333333333333333333333 by default (for all + resolutions). These all pass except: + + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.102727 + + Note, in particular, that all restart tests are now passing for + evolution=2. However, note that a small time step is needed for these + evolution=2 cases to pass (even using dt=0.025 led to failure of some cases) + +Externals used for testing: cesm1_2_beta06, but PIO @ pio1_6_8 + +cism tag used for baseline comparisons: cism1_130429 + +Any other externals that differed in baseline: No differences + +================================================================================ +Originator: sacks +Date: April 30, 2013 +Model: cism +Version: cism1_130430 +One-line summary: Use new glint interfaces + +Purpose of changes: + +Use new glint interfaces from Bill L. + + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update glimmer-cism external from r1837 to r1846, to use new glint + interfaces (this also includes some other changes that should have no effect + on the code run within CESM) +M SVN_EXTERNAL_DIRECTORIES + +*** Use new glint interfaces +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 + +*** Comment out use of deleted itest, jtest (now these are iglint_global and + jglint_global, but those are hard-coded values that don't make sense for + most runs, so for now it's best not to use them) +M source_glc/glc_global_grid.F90 + +*** Unrelated clean-up of documentation +M bld/namelist_files/namelist_definition_cism.xml + + +Summary of testing: + + Yellowstone intel & pgi test lists. I used the plain text test lists as they + existed before the conversion of test lists to xml, because there were some + missing tests in the xml + + All PASS except: + + *** No ESMF for PGI + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.202525 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.202556 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.202556 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.202556 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.202556 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.202556 + + +Externals used for testing: cesm1_2_beta06, but PIO @ pio1_6_8 + +cism tag used for baseline comparisons: cism1_130429 + +Any other externals that differed in baseline: No differences + +================================================================================ +Originator: sacks +Date: April 29, 2013 +Model: cism +Version: cism1_130429 +One-line summary: Change some parameter values + +Purpose of changes: + +The previous tag kept parameter values at their cism1 defaults, for testing +purposes. In this tag, we change parameter values to those that we want moving +forward. In particular, this changes: + +- temp_init: 2 instead of 1 +- basal_mass_balance: 1 instead of 0 +- sigma: 0 instead of 2 for cism_phys=cism1 + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_defaults_cism.xml + +*** fix some comments +M bld/build-namelist + +Summary of testing: + + Yellowstone intel & pgi test lists. I used the plain text test lists as they + existed before the conversion of test lists to xml, because there were some + missing tests in the xml + + All PASS except: + + *** Missing ESMF library + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.G.061715 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.G.061723 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.G.061723 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.G.061723 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.G.061723 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.G.061723 + + +Externals used for testing: cesm1_2_beta06, but PIO @ pio1_6_8 + +cism tag used for baseline comparisons: N/A -- no baseline comparisons performed + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: April 28, 2013 +Model: cism +Version: cism1_130428 +One-line summary: Cleanup of glimmer-cism external code, with focus on cleaning + up config options + +Purpose of changes: + +- Bring in latest glimmer-cism external, which cleans up config options, as well + as a number of other changes from Bill L + +- Get cismIO generation working + +- Run some tests to make sure that new code gives the same answers as the + cesm1.1.1 release + + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + +*** Get cismIO generation working. This includes getting files from glimmer-cism + external rather than maintaining copies of them +D bld/cismIO/glide_lithot_vars.def +D bld/cismIO/glint_mbal_vars.def +D bld/cismIO/glint_vars.def +D bld/cismIO/ncdf_template.F90.in +D bld/cismIO/glide_vars.def +D bld/cismIO/generate_ncvars.py +M bld/cismIO/cism.buildIO.template.csh +M bld/cism.cpl7.template + +*** Handle Bill L's changes to config options +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +*** Add blank line +M bld/user_nl_cism + + +Summary of testing: + + (1) Yellowstone intel & pgi test lists. I used the plain text test lists as + they existed before the conversion of test lists to xml, because there + were some missing tests in the xml + + All PASS except: + + *** Missing ESMF library + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.194914 + + *** CISM2 failures + FAIL ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.GC.194923 + FAIL NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel.GC.194923 + FAIL PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.GC.194923 + FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel.GC.194923 + FAIL SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel.GC.194923 + + + (2) Comparisons of latest code base with cesm1.1.1 release code. Expect CISM1 + compsets to be the same within roundoff, once some code mods were made to + the new and old code to correct for known differences (put in place by + Bill L). For each of these, I ran one-year TG compsets from the new code + base and from cesm1.1.1; I compared log files (first few time steps, and + last time step of the year-long run), looked at cprnc results, and did a + visual comparison of history files for any fields with large differences + according to cprnc. + + (a) baseline, out-of-the-box settings (done by Bill L, reproduced by me) + + (b) basal sliding on (done by Bill L) + + (c) 10 km + + (d) 20 km + + (e) evolution=2 + + (f) basal_water=1 + + (g) flow_law: 0 in new, 2 in old + + (h) sigma=0 (in old code, implemented this by commenting out the call to + glide_read_sigma) + + (i) use Jeremy Fyke's initial conditions, which have been copied to + bg40.1850.track1.1deg.006b.cism.r.0863-01-01-00000.nc; along with + hotstart=1 + + (j) slip_coeff: 5 in old, 3 in new; also, use initial conditions as in + (i) + + All of these appeared to differ only by single-precision roundoff, EXCEPT + (i) was questionable and (j) had big differences (in cesm1.1.1, (j) was + unstable in the old code). The differences in (i) suggest that old cism1 + restart files MAY not be compatible with the new code base. The + differences in (j) might be connected to the use of initial conditions in + this run, rather than a problem with slip_coeff per se. For example, it + seems that the old code, with Bill L's mods to make the old & new more + similar, didn't read bheatflx from the restart file. + + +Externals used for testing: cesm1_2_beta06, but PIO @ pio1_6_8 + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: April 25, 2013 +Model: cism +Version: cism1_130425 +One-line summary: Allow longer case names, and error-check too-long case names + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M source_glc/glc_io.F90 +M source_glc/glc_time_management.F90 + +Summary of testing: + + Ran standard cism1 tests on yellowstone, from glc aux test lists (for intel & + pgi); took these test lists from an older scripts tag from before the + conversion to xml, since the xml list has some problems. + + All tests PASSed, except the following expected failures: + + *** No esmf library for pgi + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.GC.145755 + + *** PIO broken for mpi-serial + RUN PEA_P1_M.f09_g16.TG20TR.yellowstone_intel.GC.145802 + + All baseline comparisons, including component_gen_comp, PASSed or BFAILed in + an expected way. + + + Also ran an ERI_Ly44 test with a long testid that resulted in a > 160 + character case name (old limit was 80, new is 256 characters). + +Externals used for testing: cesm1_2_beta06 + +cism tag used for baseline comparisons: cism1_130405 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: April 5, 2013 +Model: cism +Version: cism1_130405 +One-line summary: Change namelist defaults for cism1 + +Purpose of changes: + +I was getting instabilities in cism1. Resolving these required either +decreasing the time step or changing evolution back to 0 (rather than the +new default of 2). Bill L recommended changing evolution back to 0. + +So this tag changes these defaults for cism1: +- evolution=0 rather than 2 +- dt=0.1 rather than 0.025 for gl10 + +These changes bring the cism1 namelist defaults back to what they were in +cism1_121114 + + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_defaults_cism.xml + +Summary of testing: + + NOTE: The testing was accidentally run on a version of code that + did NOT include the changes from cism1_130403. + + JUST RAN THE CISM1 TESTS FROM THESE LISTS (NO BASELINE COMPARISONS): + - yellowstone_intel.glc.auxtest + - yellowstone_pgi.glc.auxtest + + All PASS except the following expected failures: + CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.G.205611 + FAIL CME_Ly5.T31_g37.IG.yellowstone_intel.G.205554 + + NOTE THAT THE ERS AND ERI TESTS ARE NOW PASSING! + + CONFIRMING THAT RESTART TESTS ARE NOW WORKING: + Ran the following additional tests: + +PASS ERS_Ly100.f09_g16.TG.yellowstone_intel.062613 +PASS ERS_Ly100.f09_g16.TG.yellowstone_intel.062613.memleak +PASS ERI_Ly220.f09_g16.TG20TR.yellowstone_intel.062613 +PASS ERI_Ly220.f09_g16.TG20TR.yellowstone_intel.062613.memleak +PASS ERS_Ly200.f09_g16_gl10.TG1850.yellowstone_intel.062613 +PASS ERS_Ly200.f09_g16_gl10.TG1850.yellowstone_intel.062613.memleak +PASS ERI_Ly440.f09_g16_gl10.TGRCP85.yellowstone_intel.062613 +PASS ERI_Ly440.f09_g16_gl10.TGRCP85.yellowstone_intel.062613.memleak +PASS ERS_Ly20.f09_g16_gl10.TG1850.yellowstone_intel.062613 +PASS ERS_Ly20.f09_g16_gl10.TG1850.yellowstone_intel.062613.memleak +PASS ERI_Ly44.f09_g16_gl10.TGRCP85.yellowstone_intel.062613 +PASS ERI_Ly44.f09_g16_gl10.TGRCP85.yellowstone_intel.062613.memleak + + SO INDEED, IT SEEMS THAT RESTARTS ARE EXACT NOW, WITH EVOLUTION=0 + + +Externals used for testing: cesm1_2_beta05, except scripts4_130405 and +CLM at branches/newcompsets/models/lnd/clm, r45570 + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: April 3, 2013 +Model: cism +Version: cism1_130403 +One-line summary: Add CISM_OBSERVED_IC option for hybrid runs + +Purpose of changes: + +Allow cism to ignore the refcase's restart file in a hybrid run by +setting the CISM_OBSERVED_IC env_run.xml variable to TRUE. + +As part of this change, the default value of hotstart is now set in +build-namelist rather than being set via namelist_defaults_cism.xml. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + + +Summary of testing: + +- Test runs where I leave CISM_OBSERVED_IC at its default value (FALSE); compare namelist/config file and cism history file with baseline runs + - startup + - namelist/config files + - hist file + - hybrid + - namelist/config files + - hist file + - branch + - namelist/config files + - hist file + +- Test runs where I set CISM_OBSERVED_IC to TRUE; compare namelist/config file and cism history file with baseline runs + - startup + - namelist/config files + NOT DOING - hist file + - hybrid: should differ from baseline hybrid, be identical to baseline startup (in particular: hostart, cisminputfile) + - namelist/config files + - hist file: should be identical to baseline startup + Note: time coordinate variable differs from baseline hybrid + - restart file: should be identical to baseline startup + Note: time coordinate variable differs from baseline hybrid + - compare netcdf headers for hist & restart files + - branch: BUILD-NAMELIST SHOULD DIE + + + +Externals used for testing: cesm1_2_beta05, with updated scripts + +cism tag used for baseline comparisons: cism1_130401 + +Any other externals that differed in baseline: old scripts used for +baseline runs + +================================================================================ +Originator: sacks +Date: April 1, 2013 +Model: cism +Version: cism1_130401 +One-line summary: Update external, including significant glide updates + +Purpose of changes: + +Update glimmer-cism external. Among other things, this includes a +large set of glide updates from Bill Lipscomb. + +Changes answers relative to previous tag: YES + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update glimmer-cism from r1773 to r1785 +M SVN_EXTERNAL_DIRECTORIES + +*** Delete bluefire test stubs +M ChangeLog_template + +Summary of testing: + + yellowstone_intel.glc.auxtest & yellowstone_pgi.glc.auxtest + + (skipped hopper glc auxtests because for now I just care about + testing CISM1 compsets) + +All PASS except: + +***** NEW FAILURE: Problems building with mpi-serial with cmake +RUN PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel.G.162507 + +***** NEW FAILURE: Problem in CLM or RTM ESMF (should be resolved as of clm4_0_69) +FAIL CME_Ly5.T31_g37.IG.yellowstone_intel.G.162507 + +***** Expected failures based on failures in cism1_130207 +FAIL ERS_Ly20.f09_g16.TG1850.yellowstone_intel.G.162507 +FAIL ERI_Ly44.f09_g16.TGRCP85.yellowstone_intel.G.162507 +RUN ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel.G.162507 +FAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_intel.G.162507 +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.yellowstone_pgi.G.162510 +CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi.G.162510 + + +Externals used for testing: cesm1_2_beta05 + +cism tag used for baseline comparisons: N/A: No baseline comparisons done + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: tcraig +Date: March 25, 2013 +Model: cism +Version: cism1_130325 +One-line summary: updates for new CISM_GRID env variable + +the scripts env variable GLC_GRID was renamed to CISM_GRID and a few changes +were needed in cism scripts. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M models/glc/cism/bld/trilinosOptions/README +M models/glc/cism/bld/README.build-namelist +M models/glc/cism/bld/build-namelist +M models/glc/cism/bld/cism.buildnml.csh + +Summary of testing: Ran a handful of yellowstone prealpha/beta tests + +Externals used for testing: cesm1_2_alpha04a+ + +cism tag used for baseline comparisons: cism1_130315 + +Any other externals that differed in baseline: Several including a + dependency on scripts changes and everything else in alpha05a. This + tag does depends on the scripts tag in cesm1_2_alpha05a and that + scripts tag depends on everything else in alpha05a (add wave model). + +================================================================================ +Originator: sacks +Date: March 15, 2013 +Model: cism +Version: cism1_130315 +One-line summary: update glimmer-cism, including adding support for 36 columns + +Purpose of changes: + +Add support for 36 columns. + +While I'm at it, update glimmer-cism external to latest revision. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Update glimmer-cism from r1746 to r1773 + M . +M SVN_EXTERNAL_DIRECTORIES + +Summary of testing: + +Ran the following test list, including component_gen_comp (note: this +is the shortlist.glc.auxtest list, plus a long IG test): + +SMS_D.f09_g16.TG +SMS_D_Ly1.f09_g16_gl10.TGIS2 +ERS_Ly20.f09_g16.TG1850 +SMS_D.f09_g16.IG20TR +SMS_Ly5.T31_g37.IG + +All pass, except the following, which also failed in the baseline: +FAIL ERS_Ly20.f09_g16.TG1850.yellowstone_intel.GC.141629 + +Externals used for testing: cesm1_2_alpha03d + +cism tag used for baseline comparisons: cism1_130307 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: March 7, 2013 +Model: cism +Version: cism1_130307 +One-line summary: fix dependency appends for new mkDepends... for real, now + +Purpose of changes: + +Yesterday's fix didn't really do the right thing. Now I have removed the +awkward awk script, and instead use new functionality in mkDepends to do +this appending the right way. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/cism.buildexe.csh + +Summary of testing: + +Summary of testing: + +MINIMAL TESTING DONE: JUST TESTED BUILD FOR A CASE WITH: +-mach yellowstone -compset IG -res f09_g16 + +Externals used for testing: cesm1_2_alpha03b, with Machines at Machines_130307 + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: March 6, 2013 +Model: cism +Version: cism1_130306 +One-line summary: fix dependency appends for new mkDepends + +Purpose of changes: + +The awk script that appended libglimmercismfortran.a to the list of +dependencies accidentally assumed a space at the end of the lines +created by mkDepends. The new version of mkDepends doesn't include a +space at the end of each line, so the dependencies weren't created +correctly. Now the necessary space is added in the awk script. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Just add a space +M bld/cism.buildexe.csh + +Summary of testing: + +MINIMAL TESTING DONE: JUST TESTED BUILD FOR A CASE WITH: +-mach yellowstone -compset IG -res f09_g16 + +Externals used for testing: cesm1_2_alpha03b, with Machines at Machines_130304b + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Feb 7, 2013 +Model: cism +Version: cism1_130207 +One-line summary: bring cism2 to trunk + +Purpose of changes: + +Bring cism2 to trunk (merge changes from cism2_cesm_bld_wjs branch). This +inovles: + +- bringing in the new glimmer-cism code base as an svn external, rather than + using copies of the source files + +- updating the build system to handle building glimmer-cism as a standalone + library, using its native cmake-based build system + +- modifying some source code so GLC works properly in a parallel environment + (see README.parallelization for details) + +- adding namelist options to support cism2 + + +Changes answers relative to previous tag: YES. + +There are currently big answer changes (orders of magnitude differences), even +for cism1 compsets that are supposed to give roughly the same answer. Bill +Lipscomb is looking into this, and a new tag will be made once these changes are +resolved. + + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): None + +List all modified files, and describe the changes: + +*** Bring in new glimmer-cism code base as an svn external, delete old copies of +*** source files +A SVN_EXTERNAL_DIRECTORIES +D source_glimmer-cism +D source_glimmer-cism/glide.F90 +D source_glimmer-cism/glimmer_scales.F90 +D source_glimmer-cism/glint_timestep.F90 +D source_glimmer-cism/smb_dummy.F90 +D source_glimmer-cism/glide_thck.F90 +D source_glimmer-cism/isostasy_setup.F90 +D source_glimmer-cism/isostasy_el.F90 +D source_glimmer-cism/glide_nc_custom.F90 +D source_glimmer-cism/glide_lithot_io.F90 +D source_glimmer-cism/glint_mbal_io.F90 +D source_glimmer-cism/glimmer_ts.F90 +D source_glimmer-cism/isostasy_types.F90 +D source_glimmer-cism/glimmer_searchcircle.F90 +D source_glimmer-cism/glimmer_routing.F90 +D source_glimmer-cism/glimmer_daily_pdd.F90 +D source_glimmer-cism/xls.F90 +D source_glimmer-cism/glint_mbal.F90 +D source_glimmer-cism/glide_temp.F90 +D source_glimmer-cism/glint_climate.F90 +D source_glimmer-cism/glimmer_utils.F90 +D source_glimmer-cism/glimmer_map_init.F90 +D source_glimmer-cism/glimmer_anomcouple.F90 +D source_glimmer-cism/glimmer_filenames.F90 +D source_glimmer-cism/glimmer_ncparams.F90 +D source_glimmer-cism/glimmer_writestats.F90 +D source_glimmer-cism/glimmer_restart_gcm.F90 +D source_glimmer-cism/glint_initialise.F90 +D source_glimmer-cism/glimmer_paramets.F90 +D source_glimmer-cism/glimmer_vers.F90 +D source_glimmer-cism/glide_lithot1d.F90 +D source_glimmer-cism/glimmer_map_CFproj.F90 +D source_glimmer-cism/glide_mask.F90 +D source_glimmer-cism/glint_io.F90 +D source_glimmer-cism/glide_setup.F90 +D source_glimmer-cism/glide_profile.F90 +D source_glimmer-cism/glimmer_map_proj4.F90 +D source_glimmer-cism/glide_types.F90 +D source_glimmer-cism/glide_velo.F90 +D source_glimmer-cism/glimmer_global.F90 +D source_glimmer-cism/glimmer_map_types.F90 +D source_glimmer-cism/glimmer_deriv.F90 +D source_glimmer-cism/glimmer_coordinates.F90 +D source_glimmer-cism/glimmer_ncdf.F90 +D source_glimmer-cism/kelvin.F90 +D source_glimmer-cism/glide_stop.F90 +D source_glimmer-cism/ncdf_utils.F90 +D source_glimmer-cism/glint_example_clim.F90 +D source_glimmer-cism/glimmer_log.F90 +D source_glimmer-cism/glimmer_integrate.F90 +D source_glimmer-cism/glint_precip_param.F90 +D source_glimmer-cism/glint_global_grid.F90 +D source_glimmer-cism/glint_constants.F90 +D source_glimmer-cism/glimmer_sparse.F90 +D source_glimmer-cism/glide_diagnostics.F90 +D source_glimmer-cism/isostasy.F90 +D source_glimmer-cism/glint_global_interp.F90 +D source_glimmer-cism/glint_main.F90 +D source_glimmer-cism/glimmer_config.F90 +D source_glimmer-cism/glimmer_pdd.F90 +D source_glimmer-cism/glint_mpinterp.F90 +D source_glimmer-cism/glint_interp.F90 +D source_glimmer-cism/glide_lithot3d.F90 +D source_glimmer-cism/glimmer_physcon.F90 +D source_glimmer-cism/glimmer_map_trans.F90 +D source_glimmer-cism/profile.F90 +D source_glimmer-cism/glimmer_ncio.F90 +D source_glimmer-cism/glide_lithot.F90 +D source_glimmer-cism/glint_mbal_coupling.F90 +D source_glimmer-cism/glide_io.F90 +D source_glimmer-cism/glint_type.F90 +D source_slap +D source_slap/dmset.F +D source_slap/dlaputil.F +D source_slap/xersla.F +D source_slap/dcgs.F +D source_slap/blas.F +D source_slap/dmvops.F +D source_slap/mach.F + +*** Add xml files giving trilinos options; the correct one (based on resolution) +*** is copied to the run directory +A bld/trilinosOptions +A bld/trilinosOptions/trilinosOptions_gland10.xml +A bld/trilinosOptions/trilinosOptions_gland20.xml +A bld/trilinosOptions/trilinosOptions_gland5.xml +A bld/trilinosOptions/trilinosOptions_gland5UM.xml +A bld/trilinosOptions/README +M bld/cism.buildnml.csh +M bld/README + +*** New build system for cism2, which includes building a separate glimmer-cism +*** library using a cmake-based build system +M bld/cism.buildexe.csh + +*** Support new config options for cism2, including new xml variables +*** "CISM_PHYS" and "CISM_USE_TRILINOS". Also change a few defaults for cism1: +*** evolution=2 rather than 0, and dt=0.025 rather than 0.1 for 10km (to achieve +*** stability when using evolution=2) +M bld/build-namelist +M bld/README.build-namelist +M bld/namelist_files/namelist_definition_cism.xml +M bld/namelist_files/namelist_defaults_cism.xml + +*** Use new sourceMods directory for glimmer-cism-specific code +*** (src.cism/glimmer-cism) +M bld/cism.cpl7.template + +*** Support operation in a parallel environment +M mpi/glc_communicate.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_io.F90 --------- also, minor changes for new glimmer-cism + i/o interface +M drivers/cpl_mct/glc_comp_mct.F90 +M drivers/cpl_esmf/glc_comp_mct.F90 +M drivers/cpl_esmf/glc_comp_esmf.F90 +A README.parallelization + +Summary of testing: + +------------------------------------------------------------------------ +Core testing +------------------------------------------------------------------------ + +Ran the following from https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/cism2_bld_tags/cism2_bld_21_cesm1_2_beta01 + +For each machine, I first give failures, then passes. All of these +failures should be resolved at some point (except the titan failures, +which basically duplicate the hopper failures: no need to rerun titan +tests in the future). + +Yellowstone: yellowstone_intel.glc.auxtest & yellowstone_pgi.glc.auxtest + +***** Restarts currently are not bfb +FAIL ERS_Ly20.f09_g16.TG1850.yellowstone_intel +FAIL ERI_Ly44.f09_g16.TGRCP85.yellowstone_intel +FAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_intel +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.yellowstone_pgi +***** Hangs in initialization of the last run (the continue run) +***** (similar to the ERS IS2 run that fails on hopper) +RUN ERI_Ly15.f09_g16_gl10.TG20TRIS2.yellowstone_intel +***** No ESMF library for PGI +CFAIL ERS_Ly20_E.f09_g16.TG20TR.yellowstone_pgi + +PASS SMS_D.f09_g16.TG.yellowstone_intel +PASS SMS_D_Ly1.f09_g16_gl10.TGIS2.yellowstone_intel +PASS PEA_P1_M.f09_g16.TG20TR.yellowstone_intel +PASS PEA_P1_M_Ly2.f09_g16_gl10.TGIS2S.yellowstone_intel +PASS NCK.f09_g16.TG.yellowstone_intel +PASS NCK_Ly3.f09_g16_gl10.TGRCP85IS2.yellowstone_intel +PASS CME_Ly10_N2_P2_D.f09_g16.TG1850.yellowstone_intel +PASS CME_Ly5.T31_g37.IG.yellowstone_intel +PASS SMS.f19_f19.FG20TRCN.yellowstone_intel +PASS SMS_D.T31_g37.BG1850CN.yellowstone_intel +PASS SMS_Ly3.T31_g37_gl10.IGIS2.yellowstone_intel +PASS SMS_D.f09_g16_gl10.TG.yellowstone_pgi +PASS SMS_D.f09_g16.IG20TR.yellowstone_pgi +PASS ERI.f19_g16.IGRCP85CN.yellowstone_pgi + + +Hopper: hopper_gnu.glc.auxtest & hopper_pgi.glc.auxtest + +***** Hangs in initialization of GLC for the restart run +RUN ERS_Ly11.f09_g16_gl10.TG1850IS2.hopper_gnu +***** Dies while writing history file: subscript out of range (Dies +***** while trying to write uflx: The problem is that it's trying to +***** write 1:local_ewn, but for uflx, values only go 1:18, since it's +***** on the flux grid. I think this is due to glint using some glide +***** init routines rather than glissade, so nhalo has the wrong +***** value) +FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.hopper_pgi +***** Dies as follows: +***** (shr_mct_sMatReaddnc) reading mapping matrix data decomposed... +***** (shr_mct_sMatReaddnc) * file name : idmap +***** (shr_sys_abort) ERROR: (shr_mct_sMatReaddnc)No such file or directory +***** I believe I have fixed this with a drv change, and have tested +***** SMS.T31_g37_gl10.BGCNIS2.yellowstone_intel, but haven't rerun +***** this exact test +FAIL SMS_D.T31_g37_gl10.BGCNIS2.hopper_pgi + +PASS SMS_D_Ly1.f09_g16_gl10.TGIS2.hopper_gnu +PASS SMS.f19_f19_gl10.FGCNIS2.hopper_gnu +PASS CME_Ly3.f09_g16_gl10.TGRCP85IS2.hopper_pgi + + + +Titan: titan.glc.auxtest: + +***** See notes for the similar hopper_pgi test +FAIL SMS_D_Ly1.f09_g16_gl10.TGIS2.titan_pgi +***** See notes for the similar hopper_gnu test +RUN ERS_Ly11.f09_g16_gl10.TG1850IS2.titan_pgi +***** See notes for the similar hopper_pgi test +FAIL SMS_D.T31_g37_gl10.BGCNIS2.titan_pgi + +PASS CME_Ly3.f09_g16_gl10.TGRCP85IS2.titan_pgi +PASS SMS.f19_f19_gl10.FGCNIS2.titan_pgi + + + +------------------------------------------------------------------------ +Additional CISM1 testing on multiple machines/compilers +------------------------------------------------------------------------ + +Ran the following test list: +[SMS_Ly5 test is just in case the CME test fails because of lack of an esmf library] +[B is to test a NON-GLC compset, to make sure I haven't broken that] + +SMS_D_Ly2.f09_g16.TGIS1 +SMS_D.f09_g16.IG20TRIS1 +SMS_Ly5.f09_g16_gl10.TG1850IS1 +CME_Ly5.f09_g16_gl10.TG1850IS1 +SMS.T31_g37.B + +on the following machines & compilers: + +- hopper + - pgi +- frankfurt + - intel + - pgi +- yellowstone + - pgi + - intel + - gnu +- titan + - pgi +- intrepid + - ibm + +(I did NOT run on Janus, assuming it's close enough to +yellowstone. However, I DID test a TG build on Janus) + +In general, used: https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/cism2_bld_tags/cism2_bld_17_cesm1_2_beta01 +(on yellowstone, used the following for the B compset test; this updates POP: +https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/cism2_bld_tags/cism2_bld_18_cesm1_2_beta01) +(on yellowstone, used the following for the gnu tests: +https://svn-ccsm-models.cgd.ucar.edu/cesm1/exp_tags/cism2_bld_tags/cism2_bld_19_cesm1_2_beta01) + +IMPORTANT TEST FAILURES (I want to resolve these at some point): + +FAIL SMS_D_Ly2.f09_g16.TGIS1.frankfurt_intel +FAIL SMS_Ly5.f09_g16_gl10.TG1850IS1.frankfurt_intel + +UNIMPORTANT TEST FAILURES: + +***** I think these are just because there are no ESMF libraries for these machines/compilers: +CFAIL CME_Ly5.f09_g16_gl10.TG1850IS1.frankfurt_intel +CFAIL CME_Ly5.f09_g16_gl10.TG1850IS1.frankfurt_pgi +CFAIL CME_Ly5.f09_g16_gl10.TG1850IS1.yellowstone_pgi +CFAIL CME_Ly5.f09_g16_gl10.TG1850IS1.yellowstone_gnu +CFAIL CME_Ly5.f09_g16_gl10.TG1850IS1.intrepid_ibm + +***** Dies in lnd init. Sheri says no I compsets are being tested on +***** intrepid, so I'm not going to worry about this. The following +***** two additional tests passed on intrepid: +***** ERS.f09_f09.FG1850CN.intrepid_ibm and ERS_Ld7.f09_g16.BGRCP26CN +FAIL SMS_D.f09_g16.IG20TRIS1.intrepid_ibm + +***** Also, Sheri said that she could only get glc to build if she set +***** NTHRDS_GLC=1 (weird!) -- otherwise xlf hung while compiling +***** glide_thck.F90. For now I have changed the PE layouts to set +***** NTHRDS_GLC=1 by default on intrepid, as a workaround. + + +------------------------------------------------------------------------ + +Externals used for testing: See above + +cism tag used for baseline comparisons: N/A -- no baseline comparisons done, +because big answer changes were expected (at some point, once some bugs are +fixed, we should probably do baseline comparisons against cism1_121114 to +confirm that cism1 compsets give [nearly] identical answers) + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Nov 14, 2012 +Model: cism +Version: cism1_121114 +One-line summary: remove docs folder + +Purpose of changes: + +Remove duplicated docs folder. Instead, see +https://svn-cism-model.cgd.ucar.edu/docs + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +D doc +D doc/CESM_ice_sheets_documentation.pdf +D doc/glimmer_doc.pdf +D doc/README + +Summary of testing: NONE + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: N/A + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: jwolfe +Date: Nov 13, 2012 +Model: cism +Version: cism1_121113 +One-line summary: Add parallel support in source_glc code + +Purpose of changes: + +In preparation for bringing cism2 in, some modifications were needed +in source_glc so that this interface layer could operate in a parallel +environment. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +A mpi/glc_broadcast.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_io.F90 +M source_glc/glc_time_management.F90 + +Summary of testing: (Testing done by Bill Sacks) + +- bluefire.glc.auxtest: main test results: All PASS + + Note: I made a mistake in running the baseline comparisons, so ran + them after the fact with component_gen_comp -model cpl + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: All PASS + +- Other tests: Jon Wolfe ran some tests specific to the new + functionality + +Externals used for testing: cesm1_1_beta18 + +cism tag used for baseline comparisons: cism1_121012 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: Nov 6, 2012 +Model: cism +Version: cism1_121106a +One-line summary: Change name of documentation file + +Purpose of changes: + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +A + doc/CESM_ice_sheets_documentation.pdf +D doc/cism_doc.pdf +M doc/README + +Summary of testing: NONE + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: NONE + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Nov 6, 2012 +Model: cism +Version: cism1_121106 +One-line summary: Update documentation + +Purpose of changes: + +Update documentation for CESM1.1 release + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Add the CISM documentation to the repository +A doc/cism_doc.pdf + +*** Update to version 1.5.1 (rather than 1.0.0) +M doc/glimmer_doc.pdf + +*** Update notes about what's included in the doc directory +M doc/README + +*** Add notes about how to add a new optional section in cism.config +M bld/README.build-namelist + +Summary of testing: NONE (JUST CHANGED DOCUMENTATION) + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: NONE + +Externals used for testing: N/A + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: sacks +Date: Oct 12, 2012 +Model: cism +Version: cism1_121012 +One-line summary: add namelist documentation, validation of dt, + add/remove namelist items + +Purpose of changes: + +Main purpose is adding namelist documentation. Also added validation of dt in +build-namelist (can't add this through simple valid_values). + +Also added / removed a few namelist parameters: Add scale_factor in cism.config: +projection section. Removed namelist parameters which seem not to be used +anywhere: isostasy, sliding_law, stress_calc, isos_time + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Add lots of documentation & valid_values; +*** add scale_factor namelist parameter; +*** remove isostasy, sliding_law, stress_calc, isos_time; +*** change standard_parallel to length-2 array +*** change categories for html documentation +M bld/namelist_files/namelist_definition_cism.xml + +*** Add validation of dt; remove isostasy, sliding_law, stress_calc, isos_time +M bld/build-namelist + +*** remove isostasy, sliding_law, stress_calc, isos_time +M bld/namelist_files/namelist_defaults_cism.xml + +*** Mostly unrelated: Add documentation +M bld/README.build-namelist + +*** Update ChangeLog entry for cism1_121009: document some more careful +*** checks of the reasons for differences from baseline +M ChangeLog + +Summary of testing: + +- bluefire.glc.auxtest: main test results: All PASS except: + +(Ignoring failures in NLComp & tputcomp) + +***** Test not run in baseline case (this test was deleted in a recent scripts tag) +BFAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.C.161152.compare_hist.cesm1_1_alpha18h_cism_smallerDT + +***** Diffs just in x2a dust fluxes, due to externals change compared to baseline +FAIL SMS.f19_f19.FG20TRCN.bluefire_ibm.GC.063931.compare_hist.cesm1_1_alpha18f_scripts4_121008_clm_newGlacierData2_dlnd_121001_cism_changeTimeToDouble +FAIL SMS_D.T31_g37.BG1850CN.bluefire_ibm.GC.063931.compare_hist.cesm1_1_alpha18f_scripts4_121008_clm_newGlacierData2_dlnd_121001_cism_changeTimeToDouble + +So none of these failures are worrisome + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: All PASS except: + +***** Test not run in baseline case (this test was deleted in a recent scripts tag) +BFAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.compare_hist.cesm1_1_alpha18h_cism_smallerDT.cism (baseline directory does not exist) + + +- Other tests: + + - out-of-the-box TG compset cism_in & cism.config identical to old + case, except for the 4 removed parameters (and runid in cism_in) + +Externals used for testing: + +https://svn-ccsm-models.cgd.ucar.edu/cesm1/tags/cesm1_1_alpha18g except: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_121008 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_54/models/lnd/clm + +cism tag used for baseline comparisons: cism1_121009 for most tests; +cism1_121010 for _gl10 tests + +Any other externals that differed in baseline: MANY! (used baselines generated +from cism1_121009 and cism1_121010, using externals as listed below) + +================================================================================ +Originator: sacks +Date: Oct 10, 2012 +Model: cism +Version: cism1_121010 +One-line summary: Decrease dt for resolutions other than gland5UM + +Purpose of changes: + +I found that temperature was blowing up for out-of-the-box gland10 +cases, ever since the cism1_121001 tag. Jeremy Fyke & Bill Lipscomb +suggested fixing this by decreasing dt to 0.1. + +I am decreasing dt to 0.1 for gland10 & gland20, and to 0.05 for +gland5 (same as what is already the case for gland5UM). + +Changes answers relative to previous tag: YES, for gland10, gland20 +and gland5 (but not gland5UM) + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Change defaults for dt & ndiag +M bld/namelist_files/namelist_defaults_cism.xml + +*** Update ChangeLog entry for cism1_121009: document additional testing +M ChangeLog + + +Summary of testing: + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: + +Ran the single test from the bluefire.glc.auxtest list that tests a +resolution other than gland5UM: + +PASS ERS_Ly20_N2_P2.f09_g16_gl10.TG.bluefire_ibm.G.132320 + +Also, ran 300-year tests with TG compset, GLC_GRID=gland10 or +gland20. Jeremy Fyke confirmed that temperature and other values look +reasonable. + + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_121009b + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_121009 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120929 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_07 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_121003 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_1_44/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_54/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_08 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120927 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120927 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_121008 + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_121001 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120924 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120925 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120921 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.2 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_4/pio + + + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: lipscomb / sacks +Date: Oct 9, 2012 +Model: cism +Version: cism1_121009 +One-line summary: Change time to double precision to fix restart problem + +Purpose of changes: + +Starting with cism1_121001, some ERS tests were failing. Bill Lipscomb +traced this to the mixture of single and double precision variables +(and in one case an integer!) that are used to track time: a double +precision time variable was being converted to single precision before +being written to the restart file. + +We have changed these to be double precision universally. Note that +this just refers to the time variables that are specified as +fractional years: time variables that give number of hours are still +integers. + +Also: Fix GetValueDouble to read in value as double precision + +Note that Bill L has also implemented these fixes in the seacism +branch of cism2. + +Changes answers relative to previous tag: YES + + I expected answer changes on the order of single precision + roundoff. However, the actual answer changes are larger than that for + select grid cells (cprnc's worst decimal digits between 1 and 2 for + some variables). I suspect this is just due to non-linear feedbacks in + the system, but haven't confirmed that; I am doing more investigation + of this, but needed to make this tag before that investigation is + complete. + + - update 10-12-12: diffs in first year are less, then diffs + increase. From looking quickly at maps of diffs in first year, + I'm not too concerned about this - I can believe that these diffs + are really due to single vs double precision, with initial small + differences expanding over time due to feedbacks in the system. + + Also, there are differences in a gland10 run, too; I did not expect + these differences, since dt=1 there. This is also undergoing additional + investigation. + + - update 10-11-12: note that geothermal heat flux is now read as + double rather than single precision. That could be the + explanation. Another explanation could be that time is used in + calculations that are now done in double rather than single + precision. I'm not too concerned because diffs in first year are + very small. + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Main changes: change time variables to double precision +M source_glc/glc_io.F90 +M source_glimmer-cism/glide_thck.F90 +M source_glimmer-cism/glide_lithot_io.F90 +M source_glimmer-cism/glint_mbal_io.F90 +M source_glimmer-cism/glimmer_ncparams.F90 +M source_glimmer-cism/glint_io.F90 +M source_glimmer-cism/glide_diagnostics.F90 +M source_glimmer-cism/glimmer_ncio.F90 +M source_glimmer-cism/glide_io.F90 +M source_glimmer-cism/glint_type.F90 +M source_glimmer-cism/glimmer_ncdf.F90 + - includes change of an integer to double +M source_glimmer-cism/glide.F90 + - also change unit 6 to stdout, changed some diagnostic output +M source_glimmer-cism/glide_types.F90 + - also change defaults for tend, tinc + - also fix typo in comment +M source_glimmer-cism/glint_main.F90 + - also add some diagnostic output + - also change diagnostic output to write model%numerics%time rather + than the local 'time' variable -- latter contains the time at the + start of the glint timestep, which can be up to a year behind +M source_glimmer-cism/glint_timestep.F90 + - also add diagnostic output + +*** Fix GetValueDouble to read in value as double precision +M source_glimmer-cism/glimmer_config.F90 + +*** Unrelated change: add a comment +M bld/namelist_files/namelist_defaults_cism.xml + + +Summary of testing: + +- bluefire.glc.auxtest: main test results: All PASS except: + +(Not listing failures in NLComp [which I don't think is working right] or +tputcomp) + +FAIL SMS_D.f09_g16.TG.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL PEA_P1.f09_g16.TG20TR.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +BFAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL ERI_Ly44.f09_g16.TGRCP85.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL NCK_P2.f09_g16.TG.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL CME_Ly10_N2_P2_D.f09_g16.TG1850.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +BFAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +FAIL CME_Ly5_PL.T31_g37.IG.bluefire_ibm.GC.123515.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 + +These are all failures in history comparisons, which are expected. + +Note that the previously-failing ERS tests are now passing. + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: All PASS except: + +FAIL CME_Ly10_N2_P2_D.f09_g16.TG1850.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL CME_Ly5_PL.T31_g37.IG.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL ERI_Ly44.f09_g16.TGRCP85.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL NCK_P2.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL PEA_P1.f09_g16.TG20TR.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism +FAIL SMS_D.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002.cism + +These are all expected failures, except I did not expect failures in the two +gl10 comparisons. I am investigating this further. + +- Other tests: + +Note: these two tests below used a user_nl_dir, which set cism's dt=0.05: +ERS_D_Ly20.f09_g16_gl10.TG1850.bluefire_ibm +ERI_D_Ly44.f09_g16_gl10.TGRCP85.bluefire_ibm + +PASS ERS_D_Ly200.f09_g16_gl10.TG1850.bluefire_ibm.134929 +PASS ERS_Ly100.f09_g16.TG.bluefire_ibm.204752 +PASS ERS_D_Ly20.f09_g16_gl10.TG1850.bluefire_ibm.204752 +PASS ERI_D_Ly44.f09_g16_gl10.TGRCP85.bluefire_ibm.204752 +PASS ERI_D_Ly220.f09_g16_gl10.TGRCP85.bluefire_ibm.204752 + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_121008 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120921 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_02 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120918 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_1_42/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/new_glacier_data2_tags/new_glacier_data2_06_clm4_0_52/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_08 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120927 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/change_time_to_double + + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120927 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120925b + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_121001 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120924 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120925 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120921 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.2 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_4/pio + + +cism tag used for baseline comparisons: cism1_121002 + +Any other externals that differed in baseline: +- scripts4_120930 +- dlnd8_120918 + +================================================================================ +Originator: sacks +Date: Oct 8, 2012 +Model: cism +Version: cism1_121008 +One-line summary: add some namelist items, remove others + +Purpose of changes: + +Add some namelist items to namelist_definition_cism that users may want to +change. Remove some items that should not be changed. + +Requires some new functionality in build-namelist to only create a section +in cism.config under certain conditions. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +Summary of testing: + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- shortlist.glc.auxtest on bluefire: main test results: All PASS except: + +FAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.C.165451 +BFAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.C.165451.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 + +These are expected failures based on cism1_121002 test results + +- shortlist.glc.auxtest: results of component_gen_comp -model cism: All PASS + +- Other tests: + + - Confirmed that build-namelist gives error when trying to define + variables in gthf section, without setting do_gthf to .true.; same for + isostasy section; same for elastic lithosphere section, but this keys + off of lithosphere==1 + + - Confirmed that GTHF section isn't output when do_gthf is not set to + .true.; same for isostasy section; same for elastic lithosphere + section, but this keys off of lithosphere==1 + + - With empty user_nl_cism, gives identical cism.config to that in + cism1_121002. + + - Added all new parameters to user_nl_cism, with values different from + their defaults (along with do_gthf=.true., do_isostasy=.true.) + - Checked cism.config: made sure each appears in the right section + - Ran model, checked output to make sure they are all read in correctly + + Note: this job died with the error: + + * FATAL ERROR : (/glade/proj3/cseg/people/sacks/cesm_code/cesm1_1_alpha18f_newCISM/models/glc/cism/source_glimmer-cism/glide_nc_custom.F90:1 +29) NetCDF: Start+count exceeds dimension bound + + I have filed a bug report about this (1560); I am not going to worry + about this for now. + +Externals used for testing: + +NOTE: perl5lib updated to include my new get_defined_vars_in_group function +-- similar, but not identical, to the perl5lib tag I made 10-8-2012 + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120930 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120921 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_02 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120918 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_1_42/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/new_glacier_data2_tags/new_glacier_data2_06_clm4_0_52/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_08 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120927 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120927 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120925b + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_120918 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120924 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120925 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120921 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.2 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_4/pio + + + +cism tag used for baseline comparisons: cism1_121002 + +Any other externals that differed in baseline: None (except unchanged perl5lib) + +================================================================================ +Originator: sacks +Date: Oct 2, 2012 +Model: cism +Version: cism1_121002 +One-line summary: add some namelist variables, fix others + +Purpose of changes: + +Change idiag and jdiag into config parameters rather than hard-coded, +following what is done in the seacism branch. + +Add some optional config options that were missing from +namelist_definition_cism.xml (found by searching for GetValue calls in +cism). + +Remove niso (unused). + +Make ntem & nvel integers + +Make ndiag 20 for gland5UM + +Change basal_tract from real(10) to real(5) + +Fix categories in namelist_definition_cism, for documentation +purposes. + +Changes answers relative to previous tag: NO + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Remove hard-coded idiag, jdiag; instead use values set in config file +M source_glimmer-cism/glimmer_paramets.F90 +M source_glimmer-cism/glide_setup.F90 +M source_glimmer-cism/glide_types.F90 +M source_glimmer-cism/glint_main.F90 + +*** Changes to namelist variables as documented above +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cism.xml +M bld/namelist_files/namelist_definition_cism.xml + +*** Fix documentation of categories +M bld/README.build-namelist + + +Summary of testing: + +- bluefire.glc.auxtest: main test results: All PASS except: + +These were all expected failures based on previous tag: +FAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.GC.233417 +BFAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.GC.233417.generate.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +BFAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.GC.233417.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +FAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.GC.233417 +BFAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.GC.233417.generate.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_121002 +BFAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.GC.233417.compare_hist.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 + +tputcomp failures: +FAIL SMS_D.f09_g16.TG.bluefire_ibm.GC.233417.tputcomp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +COMMENT tput_decr = 71.718 tput_percent_decr = 21.9 +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.bluefire_ibm.GC.233417.tputcomp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +COMMENT tput_decr = 7477.653 tput_percent_decr = 55.8 +FAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.GC.233417.tputcomp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +COMMENT tput_decr = 983.18499 tput_percent_decr = 13.1 + +NLComp failures; as far as I can tell, this is an error in the test script: +FAIL SMS_D.f09_g16.TG.bluefire_ibm.GC.233417.NLComp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +FAIL ERS_Ly20_N2_P2.f09_g16_gl10.TG.bluefire_ibm.GC.233417.NLComp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 +FAIL ERS_Ly20_E.f09_g16_gl10.TG20TR.bluefire_ibm.GC.233417.NLComp.cesm1_1_alpha18f_scripts4_120930_clm_newGlacierData2_cism1_120930 + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: All PASS + +- Other tests: + + - added newly-added config options to user_nl_cism, confirmed that they + appeared in correct place in cism.config, and that at least some of + them were read properly by cism + + - confirmed that diagnostic output is done at the desired coordinates, + based on new idiag & jdiag + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120930 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120921 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_02 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120918 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_1_42/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/new_glacier_data2_tags/new_glacier_data2_06_clm4_0_52/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_08 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120927 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120927 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120925b + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_120918 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120924 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120925 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120921 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.2 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_4/pio + + +cism tag used for baseline comparisons: cism1_121001 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: Oct 1, 2012 +Model: cism +Version: cism1_121001 +One-line summary: change parameter defaults + +Purpose of changes: + +Change some parameters to give better results, based on suggestions from +Jeremy Fyke and Bill Lipscomb: + +- sigma_levels: focus resolution at the bottom + +- flow_law = 0 + +- ntem=nvel=niso=1, because we realized these are multipliers, and values < + 1 don't make sense + +Changes answers relative to previous tag: YES! + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Change parameters +M bld/namelist_files/namelist_defaults_cism.xml + +*** Document that ntemp, nvel & niso are multipliers +M bld/namelist_files/namelist_definition_cism.xml + + +Summary of testing: + +Note: baseline comparisons not done: I know this changes answers substantially + +- bluefire.glc.auxtest: main test results: + +All pass except the following: + +FAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.G.140709 +BFAIL ERS_Ly20.f09_g16.TG1850.bluefire_ibm.G.140709.generate.cesm1_1_alpha18f_scripts4_120930_cism1_120930 +FAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.G.140709 +BFAIL ERS_Ly20_E.f09_g16.TG20TR.bluefire_ibm.G.140709.generate.cesm1_1_alpha18f_scripts4_120930_cism1_120930 + +These failures reveal an old problem which has just come to the surface: +under certain circumstatnces, cism isn't restarting exactly. The problem is +in the temp field, and this only affects the cpl fields once we set +flow_law=0. With flow_law=1 (the old default), there is still a problem, +but it is only apparent in the cism history files, so doesn't trigger a +failure in the ERS test. I confirmed that the same problem existed in +cism1_110418, if you set parameters appropriately (in particular: gland5UM +with evolution=0, dt=0.05). + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: + +(Just did -generate, not -compare; all PASS) + +- Other tests: + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120930 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120921 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_02 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120918 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/trunk_tags/cam5_1_42/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/new_glacier_data2_tags/new_glacier_data2_06_clm4_0_52/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_08 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120927 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk + + models/ocn/pop2 https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120927 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120925b + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_120918 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120924 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120925 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120921 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.2 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_4/pio + + +cism tag used for baseline comparisons: N/A + +Any other externals that differed in baseline: N/A + +================================================================================ +Originator: mvertens, tcraig +Date: Sept 21, 2012 +Model: cism +Version: cism1_120921 +One-line summary: add esmf interface + +Purpose of changes: Add esmf interface + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/cism.buildexe.csh +A drivers/cpl_esmf/glc_comp_mct.F90 +A drivers/cpl_esmf/glc_comp_esmf.F90 + +Summary of testing: + +(testing performed by Bill Sacks) + +*** Full test suite NOT run: Since the changes were isolated to the +*** esmf interface, the full test suite seemed unnecessary + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: + +PASS CME10y.f09_g16.TG1850.bluefire_ibm +PASS CME10y_N2_P2_D.f09_g16.TG1850.bluefire_ibm +PASS CME10y_N2_P2.f09_g16.TG1850.bluefire_ibm +PASS ERS20y_E.f09_g16.TG20TR.bluefire_ibm +PASS ERS20y_E.f09_g16.TG20TR.bluefire_ibm.memleak +PASS CME5y_PL.T31_g37.IG.bluefire_ibm +PASS SMS_D.f09_g16.BGRCP45CN.bluefire_ibm +PASS SMS_D.f09_g16.BGRCP45CN.bluefire_ibm.memleak +PASS SMS_DE.f09_g16.BGRCP45CN.bluefire_ibm +PASS SMS_DE.f09_g16.BGRCP45CN.bluefire_ibm.memleak +PASS NCK_E.T31_g37.BG1850CN.bluefire_ibm + +Ran shortlist.glc.auxtest, with comparison to cesm1_1_alpha18a: + +PASS SMS_D.f09_g16.TG.bluefire_ibm +PASS SMS_D.f09_g16.TG.bluefire_ibm.memleak +PASS SMS_D.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha18a +PASS SMS_D.f09_g16.TG.bluefire_ibm.memcomp.cesm1_1_alpha18a +FAIL SMS_D.f09_g16.TG.bluefire_ibm.tputcomp.cesm1_1_alpha18a +COMMENT tput_decr = 79.75 tput_percent_decr = 13.8 +PASS ERS20y.f09_g16.TG1850.bluefire_ibm +PASS ERS20y.f09_g16.TG1850.bluefire_ibm.memleak +PASS ERS20y.f09_g16.TG1850.bluefire_ibm.compare_hist.cesm1_1_alpha18a +PASS ERS20y.f09_g16.TG1850.bluefire_ibm.memcomp.cesm1_1_alpha18a +PASS ERS20y.f09_g16.TG1850.bluefire_ibm.tputcomp.cesm1_1_alpha18a PASS SMS_D.T31_g37.IG.bluefire_ibm +PASS SMS_D.T31_g37.IG.bluefire_ibm.memleak +FAIL SMS_D.T31_g37.IG.bluefire_ibm.compare_hist.cesm1_1_alpha18a +PASS SMS_D.T31_g37.IG.bluefire_ibm.memcomp.cesm1_1_alpha18a +FAIL SMS_D.T31_g37.IG.bluefire_ibm.tputcomp.cesm1_1_alpha18a +COMMENT tput_decr = 2.949 tput_percent_decr = 12.1 + +The failure in compare_hist with the IG case seems just due to runoff +changes: + +[be1105en:/ptmp/sacks/tests/SMS_D.T31_g37.IG.bluefire_ibm.C.111836]$ grep RMS cprnc.out + RMS r2x_Forr 1.3464E-06 +[be1105en:/ptmp/sacks/tests/SMS_D.T31_g37.IG.bluefire_ibm.C.111836]$ grep FILLDIFF cprnc.out + FILLDIFF domr_lat + FILLDIFF domr_lon + FILLDIFF domr_are + FILLDIFF domr_are + FILLDIFF domr_mas + FILLDIFF domr_fra + FILLDIFF r2x_Forr + FILLDIFF r2x_Forr + +So I'm not worried about this + +Related component_gen_comp: + +PASS ERS20y.f09_g16.TG1850.bluefire_ibm.compare_hist.cesm1_1_alpha18a.cism +PASS SMS_D.T31_g37.IG.bluefire_ibm.compare_hist.cesm1_1_alpha18a.cism +PASS SMS_D.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha18a.cism + + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/rtmcomp_tags/rtmcomp07_scripts4_120828 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/rtmcomp_tags/rtmcomp03_Machines_120829 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/rtmcomp_tags/rtmcomp15_drvseq4_1_26 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/rtmcomp_tags/rtmcomp02_share3_120803 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/exe_cam5_1_33_tags/exe01_cam5_1_33/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/branch_tags/rtmcomp_tags/rtmcomp14_clm4_0_46/models/lnd/clm + + models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_04 + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120825 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/rtmcomp + + models/ocn/pop2/ https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120824 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120626 + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/branch_tags/rtmcomp_tags/rtmcomp02_dlnd8_120626 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120626 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120626 + models/rof/drof https://svn-ccsm-models.cgd.ucar.edu/drof/trunk_tags/drof8_120827 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xlnd + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xglc + models/rof/xrof https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/xrof + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_7_04/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/slnd + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/sglc + models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_01/srof + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.0 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_3/pio + +cism tag used for baseline comparisons: cism1_120905 + +Any other externals that differed in baseline: Used cesm1_1_alpha18a +for baselines; this involves many differences in externals + +================================================================================ +Originator: sacks +Date: Sept 5, 2012 +Model: cism +Version: cism1_120905 +One-line summary: change basal_tract to real rather than integer + +Purpose of changes: + +basal_tract was mistakenly listed as an integer; I am fixing this. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_definition_cism.xml + +Summary of testing: No system tests; just tested namelist generation + +- bluefire.glc.auxtest: main test results: NOT DONE + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: NOT DONE + +- Other tests: + +(1) Ran 'create_newcase -compset TG -res f09_g16 -mach bluefire', then +'setup'. Compared default cism.config with baseline version: identical + +(2) In that case, did the following: +echo 'basal_tract = 2.5 10 10 0 1' >> user_nl_cism +preview_namelists + +Confirmed that it worked to use a real value. + + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120828 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120829 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_1_26 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120803 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/exe_cam5_1_33_tags/exe01_cam5_1_33/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_46/models/lnd/clm + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120825 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/ensemble + + models/ocn/pop2/ https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120824 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120626 + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_120626 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120626 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120626 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xlnd + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/slnd + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.0 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_3/pio + + +cism tag used for baseline comparisons: cism1_120829 + +Any other externals that differed in baseline: None + +================================================================================ +Originator: sacks +Date: Aug 29, 2012 +Model: cism +Version: cism1_120829 +One-line summary: enable ensemble capabilities + +Purpose of changes: + +Enable ensemble capabilities for cism. These were already implemented +in drv & scripts, but required some changes in the cism code. + +Also, change flow_factor to real rather than integer. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** New modules to handle variables that differ between ensemble members +A source_glc/glc_ensemble.F90 +A source_glc/glc_files.F90 +A test/unit/unit_test_replacements/glc_files.F90 + - simplified version needed because the time management unit test + doesn't know anything about ensemble number + +*** Add ensemble capability +M drivers/cpl_mct/glc_comp_mct.F90 +M source_glc/glc_io.F90 + - Also deleted unused glc_io_create_suffix_cesm, because I think it + would have been broken with ensemble capabilities +M source_glc/glc_constants.F90 + - Move file names that are no longer constant + +*** Change use statements to reflect movement of some file name variables +M source_glc/glc_InitMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_time_management.F90 + +*** Add use of glc_files.F90 +M test/unit/time_management/Srcfiles + +*** Change flow_factor to real rather than integer +M bld/namelist_files/namelist_definition_cism.xml + +*** Updated changeLog template to give more testing details +M ChangeLog_template + +Summary of testing: + +- bluefire.glc.auxtest: main test results: + +All PASS except the following (other than throughput tests, these are all expected failures): + +FAIL ERS20y.f09_g16.TG1850.bluefire_ibm.tputcomp.cesm1_1_alpha17c +COMMENT tput_decr = 1694.229 tput_percent_decr = 44.5 +BFAIL ERS20y_N2_P2.f09_g16.TGG10.bluefire_ibm.compare_hist.cesm1_1_alpha17c +BFAIL NCK_P2.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha17c +FAIL SMS_PL.T31_g37.IGLONG.bluefire_ibm.tputcomp.cesm1_1_alpha17c +COMMENT tput_decr = 3.6440000 tput_percent_decr = 2.08 +FAIL SMS.f19_f19.FG20TRCN.bluefire_ibm.tputcomp.cesm1_1_alpha17c +COMMENT tput_decr = 1.627 tput_percent_decr = 13.5 + +(Note: test list was that in scripts4_120828, plus +ERS20y.f09_g16.TGG10.bluefire_ibm [which was included in the baseline test +suite, but has now been replaced by a _N2 version of this test]) + +- bluefire.glc.auxtest: results of component_gen_comp -model cism: + +All PASS except the following (these are expected failures): + +BFAIL ERS20y_N2_P2.f09_g16.TGG10.bluefire_ibm.compare_hist.cesm1_1_alpha17c.cism (baseline directory does not exist) +BFAIL NCK_P2.f09_g16.TG.bluefire_ibm.compare_hist.cesm1_1_alpha17c.cism (baseline directory does not exist) + +- Other tests: + + - 4-instance TG run with differences in flow_factor: startup with one + continue run; compared instances #1 and #3 with analogous + single-instance runs (comparisons included cism hist, cism rest & cpl + hist files) + + - as above, but 16 PE run with glc on PEs 4-7: compared with above run to + make sure results don't depend on PE location + + - 4-instance IGLONG test with differences in the albice CLM parameter; + compared instance #3 with analogous single-instance run (comparisons + included clm hist, cism hist & cpl hist files) + +Externals used for testing: + + scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120828 + + scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_120826 + + mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_120816 + + models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_1_26 + + models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_120803 + + models/atm/cam https://svn-ccsm-models.cgd.ucar.edu/cam1/branch_tags/exe_cam5_1_33_tags/exe01_cam5_1_33/models/atm/cam + models/atm/wrf https://svn-ccsm-models.cgd.ucar.edu/wrf/trunk_tags/wrf32_ccsm120726 + + models/lnd/clm https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_46/models/lnd/clm + + models/ice/cice https://svn-ccsm-models.cgd.ucar.edu/cice/trunk_tags/cice4_0_20120825 + + models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/branches/ensemble + + models/ocn/pop2/ https://svn-ccsm-models.cgd.ucar.edu/pop2/trunk_tags/cesm_pop_2_1_20120824 + + models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_120626 + models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_120626 + models/ice/dice https://svn-ccsm-models.cgd.ucar.edu/dice7/trunk_tags/dice8_120626 + models/ocn/docn https://svn-ccsm-models.cgd.ucar.edu/docn7/trunk_tags/docn8_120626 + + models/atm/xatm https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xatm + models/lnd/xlnd https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xlnd + models/ice/xice https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xice + models/ocn/xocn https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xocn + models/glc/xglc https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/xglc + models/dead_share https://svn-ccsm-models.cgd.ucar.edu/dead7/trunk_tags/dead7_6_05/dead_share + + models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/satm + models/lnd/slnd https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/slnd + models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/sice + models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/socn + models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_3_05/sglc + + models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_120731 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_120427 + + models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.0 + + models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_5_3/pio + + +cism tag used for baseline comparisons: cism1_120823 + +Any other externals that differed in baseline: + +- scripts4_120727d: only diff is in bluefire.glc.auxtest list + +================================================================================ +Originator: sacks +Date: Aug 23, 2012 +Model: cism +Version: cism1_120823 +One-line summary: Turn evolution on for gland5UM + +Purpose of changes: + +Turn evolution on for gland5UM (evolution=0 rather than -1). Also shorten +time steps so ice sheet evolution is stable for gland5UM: dt=0.05, +ntem=nvel=niso=0.1. These parameters came from Jeremy Fyke's most recent +runs. + +The values of these (and other) parameters may still change, but I wanted +to use something for now that gives ice sheet evolution with gland5UM to +facilitate testing. + +Changes answers relative to previous tag: Yes, for gland5UM + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/namelist_files/namelist_defaults_cism.xml + +Summary of testing: + +No system tests! + +Just created three cases and compared cism.config with previously-generated +cases: + +- gland5UM: diffs as expected + +- gland5: no diffs + +- gland10: no diffs + +================================================================================ +Originator: mvertens +Date: June 29, 2012 +Model: cism +Version: cism1_120629 +One-line summary: Change DIN_LOC_ROOT_CSMDATA to DIN_LOC_ROOT + +Purpose of changes: Change DIN_LOC_ROOT_CSMDATA to DIN_LOC_ROOT + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** simple, one-line change +M bld/build-namelist + +Summary of testing: NONE! + +================================================================================ +Originator: mvertens +Date: May 29, 2012 +Model: cism +Version: cism1_120529 +One-line summary: Modifications to build to fit with latest scripts + +Purpose of changes: + +Minor changes to fit in with other system changes Mariana is bringing in + + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/cism.cpl7.template + + +Summary of testing: NONE! + +================================================================================ +Originator: mvertens +Date: May 21, 2012 +Model: cism +Version: cism1_120521 +One-line summary: Support removal of env_conf.xml + +Purpose of changes: + +Changes to build-namelist to support removal of env_conf.xml, and related +cleanup + + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +M bld/build-namelist + + +Summary of testing: + +(All tests except the ERI IGCN test were conducted by Bill S) + +Main testing: Unless otherwise noted, the following tests were done with a +10-year TG compset, f09_g16, GLC_GRID=gland20. I compared (1) cism_in input +file, (2) cism.config input file, (3) year 10 cism history output (using +cprnc). The comparison cases were generated from cesm1_1_beta14. + +- startup run + +- startup run at f19_g16 + +- startup run with gland5UM + +- branch run; 1 year (continuing the above startup run) + + +Other tests: + +- ERI.T31_g37.IGCN.bluefire_ibm + - comparison with cesm1_1_alpha14a + +- Checked dt_option & dt_count in cism in for the following: + - NCPL_BASE_PERIOD=decade, GLC_NCPL=5 (dt_option=steps_per_year, dt_count=0.5) + +================================================================================ +Originator: mvertens, sacks +Date: May 15, 2012 +Model: cism +Version: cism1_120512 +One-line summary: New build-namelist functionality + +Purpose of changes: + +- New build-namelist functionality to make cism consistent with other CESM + components. Makes cism.buildnml.csh just a thin wrapper to + build-namelist. Namelist defaults now set in an xml file. + +- Set dt_option and dt_count automatically to match the coupling interval. + +- Multi-instance capability in the build scripts (create multiple cism_in & + cism.config files). + + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Major rework of build +D bld/configure +D bld/config_definition.xsl +D bld/namelist_defaults_overall.xml +D bld/namelist_definition_overall.xml +D bld/namelist_defaults.xsl +D bld/namelist_definition.xsl +D bld/config_definition.xml +D bld/namelist_defaults_cism.xml +D bld/namelist_definition_cism.xml +A bld/user_nl_cism +A bld/cismIO/cism.buildIO.template.csh +A bld/README.build-namelist +A bld/cism.buildexe.csh +M bld/build-namelist +M bld/cism.cpl7.template +A bld/cism.buildnml.csh +M bld/README +A bld/namelist_files/namelist_defaults_cism.xml +A bld/namelist_files/namelist_definition_cism.xml +A bld/namelist_files + +*** Remove now-unnecessary input templates (replaced by +*** namelist_files/namelist_defaults_cism.xml) +D input_templates + +*** Add unit test for 2-year time step +M test/unit/time_management/restart_testlist +A test/unit/time_management/inputs/twoyear/time_management_test_in +A test/unit/time_management/inputs/twoyear/cism_in +A test/unit/time_management/inputs/twoyear +M test/unit/time_management/inputs/README +A test/unit/time_management/inputs/twoyear.restart1/time_management_test_in +A test/unit/time_management/inputs/twoyear.restart1/cism_in +A test/unit/time_management/inputs/twoyear.restart1 +A test/unit/time_management/inputs/twoyear.restart2/time_management_test_in +A test/unit/time_management/inputs/twoyear.restart2/cism_in +A test/unit/time_management/inputs/twoyear.restart2 +M test/unit/time_management/testlist + +*** Fix path +M test/unit/unit_test_shr/Makefile.common + +*** Remove redundant README file +D README + +*** Remove "Known bugs" section +M ChangeLog_template + + +Summary of testing: + +CESM Tests (implemented change off of cesm1_1_beta13, compared with baseline +cesm1_1_beta13): + +- bluefire.glc.auxtest: All tests passed except: + +CFAIL ERS.T31_g37.IGRCP85CN.bluefire_ibm.C.215553 +FAIL SMS.T31_T31.FG20TRCN.bluefire_ibm +BFAIL SMS.T31_T31.FG20TRCN.bluefire_ibm.compare_hist.cesm1_1_beta13 +FAIL SMS.T31_g37.TG.bluefire_ibm +BFAIL SMS.T31_g37.TG.bluefire_ibm.compare_hist.cesm1_1_beta13 + +These were all expected failures (also failed in cesm1_1_beta13) + +- ERS.f19_g16.IGCN.bluefire_ibm: PASS + - ran this because of failure in ERS.T31_g37.IGRCP85CN.bluefire_ibm + + +Main testing of new build: Unless otherwise noted, the following tests were done +with a 10-year TG compset, f09_g16, GLC_GRID=gland20. I compared (1) cism_in +input file, (2) cism.config input file, (3) year 10 cism history output (using +cprnc). The comparison cases were generated from cesm1_1_beta13. + +- startup run + - Also made sure that list of files in run directory is the same as before + +- startup run at f19_g16 + +- startup run with gland5UM + +- startup run with gland5 + - just checked cism_in and cism.config -- didn't actually do the run + +- startup run with gland10 + - just checked cism_in and cism.config -- didn't actually do the run + +- hybrid run; 1 year (continuing the above startup run) + +- branch run; 1 year (continuing the above startup run) + +- continue run; 1 year -- continuing the above startup run + +- continue run; 1 year -- continuing the above branch run + +- IG: 1-year test at f19_g16, continuing an older run that had run for + 10 years (hybrid) + - main point of this was to make sure 1-day coupling still works right + + + +Testing automatic setting of dt_option and dt_count, and making sure that it +works to use values more general than what we have been using before: + +- New time manager unit tests, to make sure it works to have fractional dt_count + with steps_per_year (as we could get with NCPL_BASE_PERIOD='decade'): + - twoyear + - looked through output manually (briefly) + - compared with output from using dt_option='seconds', dt_count=63072000 + - restart_test twoyear + +- Checked dt_option & dt_count in cism_in for the following: + - out-of-the-box TG + - out-of-the-box IG + - various values of NCPL_BASE_PERIOD & GLC_NCPL + - values overridden by user_nl_cism + +- TG run with NCPL_BASE_PERIOD='year', GLC_NCPL=2 (i.e., two time steps per + year): confirmed that there is one cism time step per coupling interval + +- TG run with NCPL_BASE_PERIOD='decade', GLC_NCPL=5 (i.e., 2-year time step), + with mass balance time step = 2 years (requires source mod in glint_mbal.F90), + ice dynamics time step = 2 years (dt=2.): confirmed that there is one cism + time step per coupling interval + +- Compared log files in two 1-year TG runs, which have the same time step but + specified in different ways: one with NCPL_BASE_PERIOD=day, GLC_NCPL=48 + (results in dt_option=steps_per_day, dt_count=48); the other with + NCPL_BASE_PERIOD=hour, GLC_NCPL=2 (results in dt_option=seconds, + dt_count=1800): glc log files essentially identical (with verbose=.true.) + - Note that these runs both died just before the end, with "Unexpected calling + of GLINT at time 8759", but I don't think that's a problem that I caused + (but it meant I could not compare hist files) + + +Other tests: + +- modifications via user_nl_cism: just checked the generated cism_in and + cism.config files to make sure the modifications are picked up + - changed a cism_in variable: cism_debug + - changed a cism.config variable: basal_tract + +- multi-instance test: 4 instances, with no modifications in user_nl_cism_000*: + just checked the generated cism_in and cism.config files: paramfile set + correctly in cism_in_000*; everything else matches a single-instance case + +- multi-instance test: 4 instances, with modifications to ihour0 and evolution + in user_nl_cism_0001 & 0003 (but no changes in 0002 or 0004): just checked the + generated cism_in and cism.config files + +- cism.buildIO.csh: + - confirmed that the generated script is essentially the same as before + - added a variable in glide_vars.def, confirmed that all F90 files + created by cism.buildIO.csh are identical to those from an old + case with the same change in glide_vars.def + +================================================================================ +Originator: sacks +Date: March 22, 2012 +Model: cism +Version: cism1_120322 +One-line summary: fixed memory leak + +Purpose of changes: + +Fixed memory leak in glint_downscaling_gcm (~ 40 MB/year for some test +runs) + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + 1433 (time manager needs additional changes to support longer timesteps) + 1441 (time manager doesn't restart properly when last run stopped in the middle of a day) + +List all modified files, and describe the changes: + +*** Fix memory leak +M https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_120123/source_glimmer-cism/glint_climate.F90 + +*** Fix comment (unrelated change) +M https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_120123/test/unit/unit_test_shr/Makefile.common + +Summary of testing: + +- CESM tests: bluefire.glc.auxtest, with comparison to previous + version (implemented change in cesm1_1_beta11, compared with + baseline cesm1_1_beta11). All tests passed except: + + RUN ERS.T31_g37.IGRCP85CN.bluefire_ibm.C.095358 + FAIL SMS.T31_T31.FG20TRCN.bluefire_ibm + BFAIL SMS.T31_T31.FG20TRCN.bluefire_ibm.compare_hist.cesm1_1_beta11 + FAIL SMS.T31_g37.TG.bluefire_ibm + BFAIL SMS.T31_g37.TG.bluefire_ibm.compare_hist.cesm1_1_beta11 + + All of these tests also failed in cesm1_1_beta11 + + +- 10-year TG compset using Bill L's recent instructions: f09_g16, + gland5UM, annual coupling interval using Gail's annual-average cpl + forcings; evolution=0, dt=ntem=nvel=niso=0.1. Last year of cism hist + is identical to code without this fix. NOTE: This change was done + off of an earlier version of cism (cism1_111214), but the change is + so straightforward that I'm pretty confident that the results should + translate to the latest version. + +================================================================================ +Originator: tcraig +Date: Jan 23, 2012 +Model: cism +Version: cism1_120123 +One-line summary: update esmf to 520r + +M source_glc/glc_io.F90 +M drivers/cpl_mct/glc_comp_mct.F90 +================================================================================ +Originator: sacks +Date: Dec 21, 2011 +Model: cism +Version: cism1_111221 +One-line summary: Restore "correct" glc_time_management, with fix for compiler bug + +Purpose of changes: + +Return glc_time_management to its "correct" state - i.e., before the changes +made in cism1_111220a; introduce unused module variable in glc_time_management +to get around an internal compiler error in xlf. Also, move incorrectly-placed +'implicit none' in glc_time_management_test.F90. + +Changes answers relative to previous tag: No, but replaces functionality removed +in cism1_111220a + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + 1433 (time manager needs additional changes to support longer timesteps) + 1441 (time manager doesn't restart properly when last run stopped in the middle of a day) + +List all modified files, and describe the changes: + +*** Restore to version prior to cism1_111220a, introduce unused module variable + to get around internal compiler error +M source_glc/glc_time_management.F90 + +*** Move incorrectly-placed 'implicit none' +M test/unit/time_management/glc_time_management_test.F90 + + +Summary of testing: + +- Tested build for an IGCN case + +- Full cesm system tests pending, including bluefire.glc.auxtest with comparison + to beta07 (needed to create this tag before testing was complete, but I will + create a new tag if any fail) + +================================================================================ +Originator: sacks +Date: Dec 20, 2011 +Model: cism +Version: cism1_111220a +One-line summary: Rolled back glc_time_management + +Purpose of changes: + +The cesm build was failing with the new version of glc_time_management. I have +temporarily rolled this file back to the version in 31393. + +This should be fixed ASAP! + + +Changes answers relative to previous tag: No, but removes functionality + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +*** Rolled back +M source_glc/glc_time_management.F90 + +Summary of testing: Just tested build + +================================================================================ +Originator: sacks +Date: Dec 20, 2011 +Model: cism +Version: cism1_111220 +One-line summary: Updated ChangeLog entry for cism1_111214 + +Purpose of changes: + I realized that I hadn't documented the testing done for cism1_111214 entirely + correctly; I have now fixed this. + +Changes answers relative to previous tag: No + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + 1433 (time manager needs additional changes to support longer timesteps) + 1441 (time manager doesn't restart properly when last run stopped in the middle of a day) + +List all modified files, and describe the changes: + +*** Update ChangeLog entry for cism1_111214 +M ChangeLog + +Summary of testing: None + +================================================================================ +Originator: mvertens +Date: Dec 18, 2011 +Model: cism +Version: cism1_111218 +One-line summary: Simplified way that cism field names generated for driver + +Purpose of changes: + Implemented new scheme of determine cism field names that is more flexible + and robust + +Changes answers relative to previous tag: No + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): None + +List all modified files, and describe the changes: +M source_glc/glc_constants.F90 + - no longer set glc_nec to 10 - but determine it from fields set in + coupler - consistency check is also made in the land - more + robust implemention +M drivers/cpl_share/glc_cpl_indices.F90 + - new index array for multiple elevation classes now is used instead + of hard wired index names for each class - much more extensible + scheme +M drivers/cpl_mct/glc_comp_mct.F90 + - using changes in glc_cpl_indices - glc_export_mct and glc_import_mct + are greatly simplified (no more hard-wiring) + +Summary of testing: +Ran IGCN and BGCN system tests and verified that results were bit-for-bit + +================================================================================ +Originator: sacks +Date: Dec 14, 2011 +Model: cism +Version: cism1_111214 +One-line summary: Add test driver for glc_time_management + +Purpose of changes: + +Add a test driver for glc_time_management, along with a list of standard tests +to run. Remove some variables from glc_time_management that aren't being used +and weren't properly preserved in restarts. Add code & makefile that can be used +for future unit testers. Add ChangeLog_template. + + +Changes answers relative to previous tag: No + + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +Known bugs (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + 1433 (time manager needs additional changes to support longer timesteps) + 1441 (time manager doesn't restart properly when last run stopped in the middle of a day) + + +List all modified files, and describe the changes: + +*** Remove unused variables that aren't preserved in restarts +M source_glc/glc_time_management.F90 + +*** Add code & makefile that can be used for any cism unit tester +A test +A test/unit +A test/unit/unit_test_replacements +A test/unit/unit_test_replacements/glc_communicate.F90 +A test/unit/unit_test_replacements/shr_sys_mod.F90 +A test/unit/unit_test_replacements/README +A test/unit/unit_test_shr/writevar_mod.F90 +A test/unit/unit_test_shr/Makefile.common +A test/unit/unit_test_shr/README +A test/unit/unit_test_shr + +*** Add test driver for the glc_time_management module +A test/unit/time_management +A test/unit/time_management/README +A test/unit/time_management/Filepath +A test/unit/time_management/Srcfiles +A test/unit/time_management/Makefile +A test/unit/time_management/glc_time_management_test_mod.F90 +A test/unit/time_management/glc_time_management_test.F90 + +*** Script to run exact restart test using the time management test driver +A test/unit/time_management/restart_test + +*** Add list of tests to be run with the time management test driver +A test/unit/time_management/restart_testlist +A test/unit/time_management/testlist + +*** Namelists for each of the standard tests to run using the time management + test driver and the restart_test script (note: I am not listing all of the + individual files added in this directory) +A test/unit/time_management/inputs + +*** Add ChangeLog_template to be used for new ChangeLog entries +A ChangeLog_template + + +Summary of testing: No system tests, but many unit tests + +- test/unit/time_management (tests in testlist & restart_testlist; for testlist, + performed regression tests against code similar to cism1_111026 where + possible, manually checked output where regression tests were impossible - + e.g., where the old code was buggy): + +Note that there is a known bug in newhour (see bug 1433). I am considering tests +to have passed even if they have the wrong newhour value. Also, since I didn't +do a careful look at every variable output by the test driver, it's possible +that there are errors in other variables that I didn't catch. Here, I am just +listing tests that have failures in variables that I checked, other than +newhour (variables I checked more carefully were: iyear, imonth, iday, +seconds_this_day, eoy, eom, eod, adjust_nyears, elapsed_days, elapsed_months, +elapsed_years). + +All pass except: + + oneyear_leap: model doesn't run to completion (see bug 1433) + + threeyear_leap: also has problems related to bug 1433, though here the model + runs to completion + + 219day_leap: also has problems related to bug 1433; the first error I notice + is that year 5, day_of_year 73 is translated to 0005-mar-13 rather than + 0005-mar-14, but there are likely other errors, too, as for oneyear_leap + + 511day_leap: also has problems relatd to bug 1433; e.g., both the leap and the + non-leap tests have a time step with time stamp 0005-mar-15; the leap should + differ + + +================================================================================ +Originator: sacks +Date: Nov 22, 2011 +Model: cism +Version: cism1_111122 +One-line summary: Modified time manager to support longer time steps + +Previously, the time manager did not correctly handle time steps longer +than one month. With the changes here, time steps as long as desired +should be possible. However, as noted below, I have only tested this for +daily and annual time steps so far. + +M source_glc/glc_time_management.F90 + +pretag testing: so far I have tested this for daily and annual time steps; +more testing is needed of other length time steps + + - 10-year TG compset with daily time step (i.e., the default), + using gland10 and 10 years of forcing from a af19_g16 IG compset: + last year of cism history output identical to a similar run set up + using old version; cism log files also essentially identical + + - Similar to the above, but with annual time step & annual + coupling interval. This was set up by (1) averaging the 10 years + of cpl history files into annual-average files; (2) explicitly + setting atm_cpl_dt to 31536000, and the same for other components, + in cpl.buildnml.csh; (3) changing dt_option from steps_per_day to + steps_per_year in cism.buildnml.csh. Last year of cism history + output identical to the daily run; cism log files also show + correct time stepping + + - exact restart, daily time step: similar to daily time step run + above, but two 5-year runs; checked last year of history file + against the above 10-year run + + - exact restart, annual time step: similar to annual time step run + above, but two 5-year runs; checked last year of history file + against the above 10-year run + +================================================================================ +Originator: sacks +Date: Oct 26, 2011 +Model: cism +Version: cism1_111026 +One-line summary: change ntem default to 1000000. for gland5UM + +This turns off ice temperature evolution (I think) -- at least, as long as +you are running for less than 1000000 years. This change should have been +made at the same time as the creation of ice.config.gland5UM, when +evolution was (correctly) set to -1. + +M input_templates/ice.config.gland5UM + +pretag testing: NONE + +================================================================================ +Originator: jwolfe +Date: +Model: cism +Version: cism1_111007 +One-line summary: add support for new GLC_GRID gland5UM + +M bld/cism.cpl7.template +A input_templates/ice.config.gland5UM + +================================================================================ +Originator: sacks, lipscomb +Date: Oct 4, 2011 +Model: cism +Version: cism1_111004 +One-line summary: allow evolution=-1; reformat glimmer_ncio.F90 to satisfy + some compilers + +* Allow evolution=-1 -- i.e., no thickness evolution +M source_glimmer-cism/glide.F90 +M source_glimmer-cism/glide_setup.F90 + +* Reformat to satisfy some compilers +M source_glimmer-cism/glimmer_ncio.F90 + +pretag testing: + - 10-year TG compsets before and after these modifications + (evolution=0 in both cases), using a single year of forcing from a + f19_g16 IG compset: last year of cism history output identical + + - 10-year TG compset with evolution=-1, compared with the above + evolution=0 case: last year of cism history output differs, as + expected (but didn't evaluate whether the differences make sense) + +================================================================================ +Originator: jwolfe, lipscomb +Date: Mon Apr 18, 2011 +Model: cism +Version: cism1_110418 +One-line summary: changes to make restarts completely functional for branch + and hybrid runs, using the glimmer-cism native hotstart + capability + +M bld/cism.cpl7.template +M input_templates/ice.config.gland10 +M input_templates/ice.config.gland20 +M input_templates/ice.config.gland5 + +================================================================================ +Originator: jwolfe, lipscomb +Date: Mon Mar 07, 2011 +Model: cism +Version: cism1_110307 +One-line summary: modify input templates to remove setting native glimmer-cism + history output files, which interferes with creating CESM-style + history output + +M input_templates/ice.config.gland10 +M input_templates/ice.config.gland20 +M input_templates/ice.config.gland5 + +pretag testing: Results are bfb relative to cesm1_0_beta15 for ERI.f19_f19.FG.bluefire + +================================================================================ +Originator: jwolfe, lipscomb +Date: Sun Feb 20, 2011 +Model: cism +Version: cism1_110220 +One-line summary: reworked the way CISM handles history files, to more closely + follow CESM naming conventions and alarms + +M bld/cism.cpl7.template +M source_glc/glc_InitMod.F90 +M source_glc/glc_io.F90 +M drivers/cpl_mct/glc_comp_mct.F90 + +pretag testing: Results are bfb relative to cesm1_0_beta15 for ERI.f19_f19.FG.bluefire + +================================================================================ +Originator: fischer +Date: Tue Jan 25, 2011 +Model: cism +Version: cism1_110125 +One-line summary: renamed glint_smb.F90 to smb_dummy.F90 + +A source_glimmer-cism/smb_dummy.F90 +D source_glimmer-cism/glint_smb.F90 + +================================================================================ +Originator: mvertens +Date: Mon Jan 24, 2011 +Model: cism +Version: cism1_110124 +One-line summary: removed use seq_flds_indices, now using local glc_cpl_indices_set + +A drivers/cpl_share +A drivers/cpl_share/glc_cpl_indices.F90 +M drivers/cpl_mct/glc_comp_mct.F90 + +pretag testing: Results are bfb relative to cesm1_0_beta14 for ERI.f19_f19.FG.bluefire + +================================================================================ +Originator: jwolfe, lipscomb +Date: Sep 13, 2010 +Model: cism +Version: cism1_100913 +One-line summary: add more capabilities, clean-up + +* pull vars.def files together along with template and python script, to + allow users to modify the IO list on a per case basis +A bld/cismIO +A bld/cismIO/glide_lithot_vars.def +A bld/cismIO/README.cismIO +A bld/cismIO/glint_mbal_vars.def +A bld/cismIO/glint_vars.def +A bld/cismIO/ncdf_template.F90.in +A bld/cismIO/glide_vars.def +A bld/cismIO/generate_ncvars.py +M bld/cism.cpl7.template + +* make GLC_DEBUG a variable instead of an IFDEF +M source_glimmer-cism/glide.F90 +M source_glimmer-cism/glint_timestep.F90 +M source_glimmer-cism/glint_climate.F90 +M source_glimmer-cism/glimmer_paramets.F90 +M source_glimmer-cism/glide_diagnostics.F90 +M source_glimmer-cism/glint_main.F90 +M source_glimmer-cism/glint_interp.F90 +M source_glimmer-cism/glint_type.F90 + +* reworked restart to keep glc calls out of glimmer-cism +M source_glc/glc_InitMod.F90 +M source_glc/glc_io.F90 +A source_glimmer-cism/glimmer_restart_gcm.F90 +M source_glimmer-cism/glint_initialise.F90 +M source_glimmer-cism/glimmer_config.F90 + +* fixed configuration files to make other resolutions work correctly +M input_templates/ice.config.gland10 +M input_templates/ice.config.gland20 +M input_templates/ice.config.gland5 + +================================================================================ +Originator: jwolfe, lipscomb +Date: Jun 17, 2010 +Model: cism +Version: cism1_100617a +One-line summary: keep use statement for shr_file_mod (temporarily) + +M source_glimmer-cism/glimmer_config.F90 + +================================================================================ +Originator: jwolfe, lipscomb +Date: Jun 17, 2010 +Model: cism +Version: cism1_100617 +One-line summary: pick up mods to glc_comp from Bill L's sandbox + +M drivers/cpl_mct/glc_comp_mct.F90 + +================================================================================ +Originator: jwolfe, lipscomb +Date: Jun 16, 2010 +Model: cism +Version: cism1_100616a +One-line summary: change Filepath to refer to new drivers directory + +M bld/cism.cpl7.template + +================================================================================ +Originator: jwolfe, lipscomb +Date: Jun 16, 2010 +Model: cism +Version: cism1_100616 +One-line summary: rearrange driver code for future esmf support, clean-up + +* rearrange driver code for future esmf support +D source_glc/glc_comp_mct.F90 +A drivers +A drivers/cpl_mct +A drivers/cpl_mct/glc_comp_mct.F90 +A drivers/cpl_esmf + +* remove unused code +D source_glc/glc_domain_size.F90 +D source_glimmer-cism/glimmer_restart_statarr.F90 +D source_glimmer-cism/glimmer_restart_pointarr.F90 +D source_glimmer-cism/glimmer_restart_common.F90 +D source_glimmer-cism/glimmer_restart.F90 +D source_glimmer-cism/glimmer_restart_statscal.F90 + +* fixed input template files for different resolutions +M input_templates/ice.config.gland10 +M input_templates/ice.config.gland20 +M input_templates/ice.config.gland5 + +* enhanced I/O to fix restart issue +M source_glimmer-cism/glint_io.F90 +M source_glimmer-cism/glide_lithot_io.F90 +M source_glimmer-cism/glint_mbal_io.F90 +M source_glimmer-cism/glide_io.F90 + +* clean-up and fix documentation +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_io.F90 +M source_glc/glc_constants.F90 +M source_glc/glc_global_fields.F90 +M source_glc/glc_FinalMod.F90 +M source_glc/glc_time_management.F90 +M source_glimmer-cism/glide.F90 +M source_glimmer-cism/glimmer_scales.F90 +M source_glimmer-cism/glint_timestep.F90 +M source_glimmer-cism/glide_thck.F90 +M source_glimmer-cism/isostasy_setup.F90 +M source_glimmer-cism/isostasy_el.F90 +M source_glimmer-cism/glide_nc_custom.F90 +M source_glimmer-cism/isostasy_types.F90 +M source_glimmer-cism/glimmer_ts.F90 +M source_glimmer-cism/glimmer_routing.F90 +M source_glimmer-cism/glimmer_searchcircle.F90 +M source_glimmer-cism/glimmer_daily_pdd.F90 +M source_glimmer-cism/xls.F90 +M source_glimmer-cism/glint_mbal.F90 +M source_glimmer-cism/glide_temp.F90 +M source_glimmer-cism/glint_climate.F90 +M source_glimmer-cism/glimmer_utils.F90 +M source_glimmer-cism/glimmer_map_init.F90 +M source_glimmer-cism/glimmer_anomcouple.F90 +M source_glimmer-cism/glimmer_filenames.F90 +M source_glimmer-cism/glimmer_ncparams.F90 +M source_glimmer-cism/glimmer_writestats.F90 +M source_glimmer-cism/glint_initialise.F90 +M source_glimmer-cism/glimmer_paramets.F90 +M source_glimmer-cism/glimmer_vers.F90 +M source_glimmer-cism/glide_lithot1d.F90 +M source_glimmer-cism/glimmer_map_CFproj.F90 +M source_glimmer-cism/glide_mask.F90 +M source_glimmer-cism/glide_profile.F90 +M source_glimmer-cism/glide_setup.F90 +M source_glimmer-cism/glimmer_map_proj4.F90 +M source_glimmer-cism/glide_types.F90 +M source_glimmer-cism/glide_velo.F90 +M source_glimmer-cism/glimmer_global.F90 +M source_glimmer-cism/glimmer_map_types.F90 +M source_glimmer-cism/glimmer_deriv.F90 +M source_glimmer-cism/glimmer_ncdf.F90 +M source_glimmer-cism/glimmer_coordinates.F90 +M source_glimmer-cism/kelvin.F90 +M source_glimmer-cism/glide_stop.F90 +M source_glimmer-cism/ncdf_utils.F90 +M source_glimmer-cism/glint_example_clim.F90 +M source_glimmer-cism/glimmer_log.F90 +M source_glimmer-cism/glimmer_integrate.F90 +M source_glimmer-cism/glint_precip_param.F90 +M source_glimmer-cism/glint_global_grid.F90 +M source_glimmer-cism/glimmer_sparse.F90 +M source_glimmer-cism/glint_constants.F90 +M source_glimmer-cism/glide_diagnostics.F90 +M source_glimmer-cism/isostasy.F90 +M source_glimmer-cism/glint_global_interp.F90 +M source_glimmer-cism/glimmer_config.F90 +M source_glimmer-cism/glint_main.F90 +M source_glimmer-cism/glimmer_pdd.F90 +M source_glimmer-cism/glint_mpinterp.F90 +M source_glimmer-cism/glint_interp.F90 +M source_glimmer-cism/glide_lithot3d.F90 +M source_glimmer-cism/glimmer_physcon.F90 +M source_glimmer-cism/glimmer_map_trans.F90 +M source_glimmer-cism/profile.F90 +M source_glimmer-cism/glimmer_ncio.F90 +M source_glimmer-cism/glide_lithot.F90 +M source_glimmer-cism/glint_mbal_coupling.F90 +M source_glimmer-cism/glint_smb.F90 +M source_glimmer-cism/glint_type.F90 + +================================================================================ +Originator: jwolfe +Date: Jun 08, 2010 +Model: cism +Version: cism1_100608 +One-line summary: Additional resolution support, fix calendar bug + +M bld/cism.cpl7.template +M source_glc/glc_io.F90 +M source_glc/glc_time_management.F90 + +================================================================================ +Originator: jwolfe +Date: Jun 03, 2010 +Model: cism +Version: cism1_100603 +One-line summary: Update cpl7 template to work correctly with hybrid and branch runs + +M bld/cism.cpl7.template + +================================================================================ +Originator: jwolfe +Date: May 25, 2010 +Model: cism +Version: cism1_100525a +One-line summary: patch to new tag, deleting one file that no longer belongs + +D source_glc/glc_glint_interp.F90 + +================================================================================ +Originator: jwolfe +Date: May 25, 2010 +Model: cism +Version: cism1_100525 +One-line summary: initial commit of cism1, which is more-or-less the same as + $SVN/glc/branch_tags/glimmer-cism-gcm_tags/glimmer-cism-gcm03_glc4_100301 + except the var.def files have been removed from the bld as well + as the scripts to handle them. CSEG decided not to require + python, which one of the scripts uses, so the resulting _io.F90 + files are included in source_glimmer-cism instead. + +A source_slap +A source_slap/dmset.F +A source_slap/dlaputil.F +A source_slap/xersla.F +A source_slap/dcgs.F +A source_slap/blas.F +A source_slap/dmvops.F +A source_slap/mach.F +D bld/namelist_definition_gglc.xml +M bld/configure +M bld/config_definition.xsl +D bld/gglc.cpl7.template +M bld/README +A bld/namelist_definition_cism.xml +D bld/namelist_defaults_gglc.xml +A bld/cism.cpl7.template +M bld/build-namelist +M bld/config_definition.xml +A bld/namelist_defaults_cism.xml +M source_glc/glc_glint_interp.F90 +M source_glc/glc_comp_mct.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_io.F90 +M source_glc/glc_constants.F90 +M source_glc/glc_global_fields.F90 +M source_glc/glc_time_management.F90 +A source_glimmer-cism +A source_glimmer-cism/glide.F90 +A source_glimmer-cism/glimmer_scales.F90 +A source_glimmer-cism/glint_timestep.F90 +A source_glimmer-cism/glide_thck.F90 +A source_glimmer-cism/glide_lithot_io.F90 +A source_glimmer-cism/isostasy_setup.F90 +A source_glimmer-cism/isostasy_el.F90 +A source_glimmer-cism/glide_nc_custom.F90 +A source_glimmer-cism/glint_mbal_io.F90 +A source_glimmer-cism/glimmer_restart_statarr.F90 +A source_glimmer-cism/isostasy_types.F90 +A source_glimmer-cism/glimmer_ts.F90 +A source_glimmer-cism/glimmer_routing.F90 +A source_glimmer-cism/glimmer_searchcircle.F90 +A source_glimmer-cism/glimmer_daily_pdd.F90 +A source_glimmer-cism/xls.F90 +A source_glimmer-cism/glint_mbal.F90 +A source_glimmer-cism/glide_temp.F90 +A source_glimmer-cism/glint_climate.F90 +A source_glimmer-cism/glimmer_utils.F90 +A source_glimmer-cism/glimmer_map_init.F90 +A source_glimmer-cism/glimmer_anomcouple.F90 +A source_glimmer-cism/glimmer_restart_pointarr.F90 +A source_glimmer-cism/glimmer_filenames.F90 +A source_glimmer-cism/glimmer_ncparams.F90 +A source_glimmer-cism/glimmer_writestats.F90 +A source_glimmer-cism/glint_initialise.F90 +A source_glimmer-cism/glimmer_paramets.F90 +A source_glimmer-cism/glimmer_vers.F90 +A source_glimmer-cism/glide_lithot1d.F90 +A source_glimmer-cism/glimmer_map_CFproj.F90 +A source_glimmer-cism/glide_mask.F90 +A source_glimmer-cism/glint_io.F90 +A source_glimmer-cism/glide_profile.F90 +A source_glimmer-cism/glide_setup.F90 +A source_glimmer-cism/glimmer_map_proj4.F90 +A source_glimmer-cism/glimmer_restart_common.F90 +A source_glimmer-cism/glide_types.F90 +A source_glimmer-cism/glide_velo.F90 +A source_glimmer-cism/glimmer_global.F90 +A source_glimmer-cism/glimmer_map_types.F90 +A source_glimmer-cism/glimmer_deriv.F90 +A source_glimmer-cism/glimmer_coordinates.F90 +A source_glimmer-cism/glimmer_ncdf.F90 +A source_glimmer-cism/kelvin.F90 +A source_glimmer-cism/glide_stop.F90 +A source_glimmer-cism/ncdf_utils.F90 +A source_glimmer-cism/glint_example_clim.F90 +A source_glimmer-cism/glimmer_log.F90 +A source_glimmer-cism/glimmer_integrate.F90 +A source_glimmer-cism/glint_precip_param.F90 +A source_glimmer-cism/glimmer_restart.F90 +A source_glimmer-cism/glint_global_grid.F90 +A source_glimmer-cism/glimmer_sparse.F90 +A source_glimmer-cism/glint_constants.F90 +A source_glimmer-cism/glide_diagnostics.F90 +A source_glimmer-cism/isostasy.F90 +A source_glimmer-cism/glint_global_interp.F90 +A source_glimmer-cism/glimmer_config.F90 +A source_glimmer-cism/glint_main.F90 +A source_glimmer-cism/glimmer_pdd.F90 +A source_glimmer-cism/glint_mpinterp.F90 +A source_glimmer-cism/glint_interp.F90 +A source_glimmer-cism/glide_lithot3d.F90 +A source_glimmer-cism/glimmer_restart_statscal.F90 +A source_glimmer-cism/glimmer_physcon.F90 +A source_glimmer-cism/profile.F90 +A source_glimmer-cism/glimmer_map_trans.F90 +A source_glimmer-cism/glimmer_ncio.F90 +A source_glimmer-cism/glide_lithot.F90 +A source_glimmer-cism/glint_mbal_coupling.F90 +A source_glimmer-cism/glide_io.F90 +A source_glimmer-cism/glint_type.F90 +A source_glimmer-cism/glint_smb.F90 +M ChangeLog +D source_glimmer +A input_templates/ice.config.gland10 +M input_templates/ice.config.gland20 +A input_templates/ice.config.gland5 +M README + +================================================================================ +Originator: jwolfe +Date: May 07, 2010 +Model: glc +Version: glc4_100507 +One-line summary: bug fixes and clean up + +* replace hard-wired unit numbers with calls to shr_file_getunit +M source_glimmer/glimmer_ts.F90 +M source_glimmer/glimmer_config.F90 + +* clean up unused files +D input_templates/glc_in.jw +D input_templates/glc_in + +* rename "ice.config" file to "cism.config" +M bld/gglc.cpl7.template +M bld/namelist_defaults_gglc.xml + +================================================================================ +Originator: jwolfe +Date: Mar 30, 2010 +Model: glc +Version: glc4_100330 +One-line summary: CCSMize output filenames, add tools for creating overlap files, + bug fix + +* CCSMize output filenames +A source_glc/glc_io.F90 +M bld/gglc.cpl7.template +M input_templates/ice.config.gland20 +M source_glimmer/glint_initialise.F90 + +* Add tools for creating overlap files +A tools +A tools/README.glc_tools +A tools/README.glc_overlap_tools +A tools/glc2scripConvert.ncl +A tools/scrip_make_wgts_CCSM_to_GLC_bilin.csh +A tools/scrip2CLMoverlap.ncl + +* Fix bug that closed log file before the end of output +M source_glimmer/glint_main.F90 + +================================================================================ +Originator: jwolfe +Date: Mar 16, 2010 +Model: glc +Version: glc4_100316 +One-line summary: Support for fracdata files for downscaling + +* Changed output for gglc.buildnml.csh to point at fracdata file +M bld/gglc.cpl7.template + +* The following files were changed Bill Lipscomb to support the use of fracdata + files for downscaling: +M source_glc/glc_InitMod.F90 +M source_glc/glc_comp_mct.F90 +M source_glc/glc_constants.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_glint_interp.F90 +M source_glimmer/glint_global_grid.F90 +M source_glimmer/glint_interp.F90 +M source_glimmer/glint_main.F90 +M source_glimmer/glint_mbal_coupling.F90 +M source_glimmer/glint_timestep.F90 + +================================================================================ +Originator: jwolfe +Date: Mar 01, 2010 +Model: glc +Version: glc4_100301 +One-line summary: Set test cell information in code based on global grid size, + instead of set as parameters in glc_constants (caused a + problem with T31 grid) + +M source_glc/glc_global_grid.F90 ----- Added test cell settings based on + global grid size +M source_glc/glc_constants.F90 ------- Removed parameter attribute from + test cell constants + +================================================================================ +Originator: erik +Date: Nov 03, 2009 +Model: glc +Version: glc4_091103 +One-line summary: Point to checked in version of topo files, add documentation, + add config files to buildnml script so can change, start adding + xml support. + +M bld/gglc.cpl7.template -------------- Point to checked in version of topo files + Add documentation and put config file in + the buildnml script so can be changed by + the user. Start adding flexibility for + support for different GLC grids. + +A bld/README -------------------------- Document files in the build directory +A bld/namelist_defaults_gglc.xml ------ GGLC specific namelist defaults +A bld/namelist_definition_gglc.xml ---- GGLC specific namelist defintion +A bld/namelist_defaults_overall.xml --- Overall namelist defaults +A bld/namelist_definition_overall.xml - Overall namelist defintion +A bld/namelist_defaults.xsl ----------- Style sheet to display defaults as html +A bld/namelist_definition.xsl --------- Style sheet to display definition as html + +Some scripts starting to add that do NOT work yet. + +A bld/build-namelist ----------------- Start adding a build-namelist (not working yet) +A bld/configure ---------------------- Start adding a configure (not working yet) +A bld/configure_definition.xml ------- Definition of configurations +A bld/configure_definition.xsl ------- Style sheet to display definition as html + +================================================================================ +Originator: lipscomb +Date: Oct 27, 2009 +Model: glc +Version: glc4_091027 +One-line summary: Add glimmer log file and add greenland 20km config file + + M source_glc/glc_InitMod.F90 ---------- Change glimmer log file + M source_glimmer/glimmer_log.F90 ------ Add subroutine to change glimmer log + M input_templates/ice.config.gland20 -- Add greenland 20km config file + +================================================================================ +Originator: erik +Date: Aug 14, 2009 +Model: glc +Version: glc4_090814 +One-line summary: Template changes to allow multiple grid files + +Set up grid files for 48x96, 1.9x.25, and 0.9x1.25 resolutions. Abort +if it isn't one of those. Also remove the coupled_nml namelist as not needed, +and set the stop_option to never, since, the coupler will tell it to stop. + +M bld/gglc.cpl7.template + +================================================================================ +Originator: lipscomb +Date: Aug 13, 2009 +Model: glc +Version: glc4_090813 +One-line summary: Latest changes from Bill Lipscomb + +Mostly changes to get time-management working correctly. Also +make sure proper mask of r8 for some variables. Update some of +the documentation and formatting. + +M README +M source_glc/glc_glint.F90 +M source_glc/glc_comp_mct.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_grid.F90 +M source_glc/glc_FinalMod.F90 +M source_glc/glc_time_management.F90 +M source_glimmer/glide.F90 +M source_glimmer/glint_initialise.F90 +M source_glimmer/glimmer_ncio.F90 + +================================================================================ +Originator: tcraig +Date: Fri Jan 16, 2009 +Model: glc +Version: glc4_090116 +One-line summary: Upgrade from ccsm3 to ccsm4 coupling + +- Try not to touch any glimmer code +- Delete unusued code and remove use of unused code from used code as needed +- Add bld and gglc.cpl7.template +- Delete glc.F90 and add glc_comp_mct.F90 for migration from ccsm3 to ccsm4 +- Update the stdout, stderr, and nml unit numbers to be set from shr_file_getunit, + eliminate use of local get_unit in favor of shr_file_getunit in glc +- Migrate all use of unit 6 to stdout in all source_glc code. includes write, + print, and flush statements. this was not done to glimmer. +- Add a shr_sys_abort to source_glimmer/glimmer_log.F90 before the stop to + prevent ccsm4 hang from glimmer abort. (there are probably more calls to + stop that need to be fixed in the code). +- Get rid of use and reference to ccsm3 coupling code +- Update initialization of glc communicator from ccsm4 driver + +Other potential issues still not addressed +- other unit numbers hardwired in glc/glimmer +- use of stop, proper aborts +- reference to gland20.input.nc file from ice.config input file +- hardwired glc_nec = 10 +- hardwired T31 resolution +- glimmer mostly writes to unit 6 +- restart flag captured in coupling interface but not used + +A bld +A bld/gglc.cpl7.template +D mpi/glc_gather_scatter.F90 +D mpi/glc_global_reductions.F90 +D mpi/glc_broadcast.F90 +D mpi/glc_boundary.F90 +D mpi/glc_timers.F90 +M mpi/glc_communicate.F90 +A source_glc/glc_comp_mct.F90 +D source_glc/glc_fileunits.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_global_grid.F90 +D source_glc/glc_domain.F90 +M source_glc/glc_exit_mod.F90 +M source_glc/glc_constants.F90 +M source_glc/glc_glint.F90 +D source_glc/glc_blocks.F90 +D source_glc/glc_distribution.F90 +D source_glc/glc.F90 +M source_glc/glc_FinalMod.F90 +M source_glc/glc_ErrorMod.F90 +M source_glc/glc_time_management.F90 +D source_glc/glc_coupled.F90 +D source_glc/glc_io_types.F90 +M source_glimmer/glimmer_log.F90 + +================================================================================ +Originator: tcraig +Date: Oct 17, 2009 +Model: glc +Version: glc_081017 +One-line summary: Port to bluefire, update usability + +M input_templates/glc_in + update input file paths to bluefire inputdata area + +================================================================================ +Originator: +Date: +Model: glc +Version: glc_080817 +One-line summary: +Changes made: + +================================================================================ + +Originator: jwolfe +Date: Mon Nov 5 13:39:33 MST 2007 +Model: glc +Version: glc_071105 +One-line summary: update to include all of Bll Lipscomb's new changes +Changes made: + +? source_glc/glc_glint.F90 +? source_glc/glc_global_fields.F90 +? source_glc/glc_coupled.F90 +? source_glc/glc_global_grid.F90 +? source_glc/POP_files/grid.F90 +M source_glc/glc_domain_size.F90 +M source_glc/glc_InitMod.F90 +M source_glc/glc_RunMod.F90 +M source_glc/glc_domain.F90 +M source_glc/glc_io.F90 +M source_glc/glc_kinds_mod.F90 +M source_glc/glc_constants.F90 +M source_glc/glc.F90 +M source_glc/glc_FinalMod.F90 +M source_glc/glc_ErrorMod.F90 +M source_glc/glc_IOUnitsMod.F90 +M source_glc/glc_time_management.F90 +M source_glimmer/glint_timestep.F90 +M source_glimmer/glint_initialise.F90 +M source_glimmer/glint_example_clim.F90 +M source_glimmer/glint_main.F90 +M source_glimmer/glint_interp.F90 +M input_templates/glc_in + +================================================================================ diff --git a/components/cism/ChangeLog_template b/components/cism/ChangeLog_template new file mode 100644 index 0000000000..42b0273337 --- /dev/null +++ b/components/cism/ChangeLog_template @@ -0,0 +1,23 @@ +================================================================================ +Originator: +Date: +Model: +Version: +One-line summary: + +Purpose of changes: + +Changes answers relative to previous tag: + +Bugs fixed (include bugzilla ID) (http://bugs.cgd.ucar.edu/): + +List all modified files, and describe the changes: + +Summary of testing: + +Externals used for testing: + +cism tag used for baseline comparisons: + +Any other externals that differed in baseline: + diff --git a/components/cism/README.parallelization b/components/cism/README.parallelization new file mode 100644 index 0000000000..43a918ee67 --- /dev/null +++ b/components/cism/README.parallelization @@ -0,0 +1,22 @@ +------------------------------------------------------------------------ +Notes on parallelization of glc + + Bill Sacks + Jan 18, 2013 +------------------------------------------------------------------------ + +(See also glimmer-cism/libglint/README.parallelization.) + +The master task is responsible for the full global (i.e., land) grid; +other tasks have 0-size grids. + +In general, grid-related variables are still allocated / initialized +on other tasks, but with size 0. + +Some places where the assumption appears that only the master task has +points are (this may not be a complete list): +- glc_global_grid : read_horiz_grid +- glc_comp_mct : glc_SetgsMap_mct +- glc_comp_esmf : glc_DistGrid_esmf (similar to glc_comp_mct : + glc_SetgsMap_mct) + diff --git a/components/cism/SVN_EXTERNAL_DIRECTORIES b/components/cism/SVN_EXTERNAL_DIRECTORIES new file mode 100644 index 0000000000..022ffa8d2a --- /dev/null +++ b/components/cism/SVN_EXTERNAL_DIRECTORIES @@ -0,0 +1 @@ +glimmer-cism https://github.com/CESM-Development/cism/tags/move_glint_to_cpl_n02 diff --git a/components/cism/bld/README b/components/cism/bld/README new file mode 100644 index 0000000000..118ef613f2 --- /dev/null +++ b/components/cism/bld/README @@ -0,0 +1,23 @@ +Scripts and datasets to create input text files to run the model with CESM + + cism.buildexe ----------------- Script to build cism + (called by $CASE.build script) + cism.buildnml ----------------- Wrapper to build-namelist, doing some initial setup, etc. + (called by $CASEROOT/cesm_setup and $CASEROOT/preview_namelists) + cism.build_usernl -------------- Script to create user_nl_cism(_nnnn) files in $CASEROOT + (called by $CASEROOT/cesm_setup) + cism.template ------------- Script to copy necessary files from CODEROOT to the CASE directory + (called by $CASEROOT/cesm_setup) + build-namelist ----------------- Script to build the namelists needed by cism + (called cism.buildnml) + user_nl_cism ------------------- File in $CASEROOT into which users can put namelist modifications + (used by build-namelist) + trilinosOptions ---------------- Directory containing resolution-dependent trilinosOptions.xml files + (used when running with trilinos solver) + +XML namelist description files, in namelist_files: + + namelist_definition_cism.xml ------ Definition of all CISM namelist items + (also used by clm to build CISM namelist) + namelist_defaults_cism.xml -------- Default values to use in CISM namelists + (also used by clm to build CISM namelist) diff --git a/components/cism/bld/README.build-namelist b/components/cism/bld/README.build-namelist new file mode 100644 index 0000000000..e8cfff212a --- /dev/null +++ b/components/cism/bld/README.build-namelist @@ -0,0 +1,660 @@ +============================================================================ +Synopsis +============================================================================ + +SYNOPSIS + build-namelist [options] +OPTIONS + -infile "filepath" Specify a file containing namelists to read values from. + -namelist "namelist" Specify namelist settings directly on the commandline by supplying + a string containing FORTRAN namelist syntax, e.g., + -namelist "&cism_nml dt=1800 /" + -help [or -h] Print usage to STDOUT. + -silent [-s] Turns on silent mode - only fatal messages issued. + -verbose Turn on verbose echoing of informational messages. + -caseroot CASEROOT directory variable + -scriptsroot SCRIPTSROOT directory variable + -inst_string INST_STRING variable + -lnd_grid LND_GRID variable + -glc_grid GLC_GRID variable + -cism_phys CISM_PHYS variable + +The precedence for setting the values of namelist variables is (highest to +lowest): + 1. namelist values set by specific command-line options, e.g., paramfile + 2. values set on the command-line using the -namelist option + 3. values read from the file specified by -infile + 4. values from the namelist defaults file or values specifically set in + build-namelist + + +============================================================================ +Summary of build-namelist +============================================================================ + +build-namelist + + - exists in $CCSMROOT/components/cism/bld (throughout this document, + $ALLCAPS denotes an xml variable while $nocaps denotes a perl variable) + + - is called from $CASEBUILD/cism.buildnml + + (cism.buildnml is now just a wrapper to build-namelist) + + - allows the user to edit existing namlist variables or introduce new + variables if that is desired + (see "user_nl_cism" and "CISM Use Cases" sections below for details) + + - depends on two files in $CCSMROOT/components/cism/bld/namelist_files + + 1. namelist_defaults_cism.xml + 2. namelist_definition_cism.xml + + (see "namelist_definition_cism.xml" and "namelist defaults.xml" sections + below for details) + + - is invoked upon every build -AND- upon every call to cism.buildnml + + +============================================================================ +user_nl_cism +============================================================================ + +ALL USER-SPECIFIED MODIFICATIONS TO THE CISM NAMELIST AND CISM.CONFIG FILE +SHOULD OCCUR AS ENTRIES IN $CASEROOT/user_nl_cism. Simply append each +variable entry to user_nl_cism prior to running build-namelist. Note that +there is no distinction in user_nl_cism between variables that will appear +in cism_in and those that will appear in cism.config: simply add a new +variable setting in user_nl_cism, and it will be added to the appropriate +place in cism_in or cism.config. + +For example, to set the value of cism_debug to .true. and basal_tract to the +array (/1,2,3,4,5/), include the following in user_nl_cism: + + cism_debug = .true. + basal_tract = 1 2 3 4 5 + +After running build-namelist, the following will appear in cism_in: + + &cism_params + ... + cism_debug = .true. + ... + / + +and the following will appear in cism.config: + + [parameters] + basal_tract = 1 2 3 4 5 + ... + + +A new utility in $CASEROOT, preview-namelist, will enable you to preview the +cism_in namelist and cism.config file in $CASEROOT/CaseDocs at any time + + +============================================================================ +namelist_definition_cism.xml +============================================================================ + +The file namelist_definition_cism.xml is located in the directory +$CCSMROOT/components/cism/bld/namelist_files/. It contains entries for all namelist +variables that can be output by build-namelist. + +As mentioned in the "CISM Use Cases" section below, a modified copy of this +file (with the same name) may be placed in the directory +$CASEROOT/SourceMods/src.cism/. Otherwise the namelist definition file +appears in build-namelist as follows: + + $nl_definition_file = \ + "$cfgdir/namelist_files/namelist_definition_cism.xml"; + +Each namelist variable is defined in an element. The content of the +element is the documentation of how the variable is used. Other aspects of +the variable's definition are expressed as attributes of the +element. Note that it is an XML requirement that the attribute values are +enclosed in quotes. The attributes are: + + 1. id + The variable's name. Although Fortran is case insensitive, the name + MUST BE LOWER CASE for the perl scripts. + + 2. type + An abbreviation of the Fortran declaration for the variable. Valid + declarations are: + + char*n + integer + logical + real + + Any of these types may be followed by a comma separated list of + integers enclosed in parenthesis to indicate an array. The current + namelist validation code only distinguishes between string and + non-string types. + + All namelist values are stored in exactly the format that is required + in a valid namelist, so if that value is a string then the quotes are + stored as part of the value. + + 3. category + A category assigned for organizing the documentation. + + 4. group + The name of the namelist (or group) that the variable is declared + in. Some groups will appear in cism_in; others (by convention, those + whose names begin with 'cism_config') will appear in cism.config. + + 5. valid_values (optional) + This attribute is mainly useful for variables that have only a small + number of allowed values; an empty string denotes no restrictions, + as does omitting the valid_values attribute entirely. + + 6. input_pathname (optional) + Only include this attribute to indicate that the variable contains the + pathname of an input dataset that resides in the CESM inputdata + directory tree. The recognized values are "abs" to indicate that an + absolute pathname is required or "rel:var_name" to indicate that the + pathname is relative and that the namelist variable "var_name" contains + the absolute root directory. + +The following is an example entry for the dt_option variable: + + + time-step units + + +Any text that appears after the first > (after valid_values) and before the + string is used for documentation purposes only. In the example +above, "time-step units" is ignored by build-namelist. + + +============================================================================ +namelist_defaults_cism.xml +============================================================================ + +The file namelist_defaults_cism.xml is located in the directory +$CCSMROOT/components/cism/bld/namelist_files/. It provides default values for +variables contained in the input namelist definition file. + +The build-namelist script is passed the glc_grid, lnd_grid and cism_phys +attributes as command-line arguments. These attributes, along with optional +user-specified attributes, are used in build-namelist to find the best match +when looking for default values of variables. + +In build-namelist the namelist defaults file appears as follows + + $nl_defaults_file = "$cfgdir/namelist_files/namelist_defaults_cism.xml"; + +The default namelist value for a given namelist variable is the one that +matches the most attributes; if multiple values match the same number of +attributes then the first value encountered will be chosen. For example, +consider the namelist variable ewn. Its entry in the defaults file is + + 151 + 76 + 301 + 301 + +The default value of ewn therefore depends on the value of glc_grid. + +Not all namelist items have defaults specified in +namelist_defaults_cism.xml. Those that don't have a default value there have +their default value set in build-namelist. This applies, for example, to +namelist items whose default value is derived from other variables (e.g., +'runid' is taken from the case name, and so does not have a default in +namelist_defaults_cism.xml). + + +============================================================================ +build-namelist details +============================================================================ + +--- Overview of four main perl objects --- + +build-namelist has four perl objects that it uses + + 1. $cfg + A configuration object obtained from the CISM config_cache.xml + file. This specifies the glc and land grid resolutions. + + my $cfg = Build::Config->new('config_cache.xml'); + + 2. $definition + A namelist definition object which provides a method for verifying that + the output namelist variables are in the definition file and are output + in the correct namelist groups. + + my $definition = Build::NamelistDefinition->new($nl_definition_file); + + 3. $defaults + A namelist defaults object which provides default values for variables + contained in the namelist_definition_cism.xml file. + + my $defaults = Build::NamelistDefaults->new($nl_defaults_file, $cfg); + + Note that both $nl_defaults_file and $cfg are passed - this is why the + glc_grid, lnd_grid and cism_phys attributes do not need to be passed to + add_defaults() (see "Examples" subsection below) + + 4. $nl + An empty namelist object which contains the model namelist values + (where the values are determined by the order of precedence outlined + in the "Synopsis" section above) + + my $nl = Build::Namelist->new(); + +--- Required $SCRIPTSROOT/../perl5lib perl files --- + +The root directory for the perl5 required utilities is + + my $perl5lib_dir = ${SCRIPTSROOT}/../perl5lib"; + +This directory contains all the required perl files: + + 1. The Build::Config module provides utilities to access the configuration + information in the config_cache.xml file + + $perl5lib_dir/Build/Config.pm + + 2. The Build::NamelistDefinition module provides utilities to validate + that the output namelists are consistent with the namelist definition + file + + $perl5lib_dir/Build/NamelistDefinition.pm + + 3. The Build::NamelistDefaults module provides a utility to obtain default + values of namelist variables based on finding a best fit with the + attributes specified in the defaults file. + + $perl5lib_dir/Build/NamelistDefaults.pm + + 4. The Build::Namelist module provides utilities to parse input namelists, + to query and modify namelists, and to write output namelists. + + $perl5lib_dir/Build/Namelist.pm + +--- Creation of $nl --- + +Additions to the namelist object, $nl, are made via calls to the +build-namelist method add_default(), which adds a value for the specified +variable to the specified namelist object. This method checks the +definition file and adds the variable to the correct namelist group. The +value can be provided by using the optional argument key 'val' in the +calling list, otherwise a default value is obtained from the namelist +defaults object. If no default value is found this method throws an +exception unless the 'nofail' option is set to 1 (true). + +Additional optional keyword=>value pairs may be specified. If the keyword +'val' is not present, then any other keyword=>value pairs that are specified +will be used to match attributes in the defaults file. + +The variables already in the object have the higher precedence, so if the +specified variable is already defined in the object it does not get +overwritten. + +In some cases, a namelist variable only appears in the namelist if its value +is given by the user in user_nl_cism. For these variables, the default value +is given in the code rather than in namelist_defaults_cism.xml. This is +achieved by NOT putting an add_default call for this variable in +build-namelist. + +--- Examples --- + + 1. Use the default value for namelist variable cism_debug + + build-namelist: + + add_default($nl, 'cism_debug'); + + namelist_defaults_cism.xml: + + .false. + + namelist_definitions_cism.xml: + + + Default: false + + + result in cism_in: + + &cism_params + ... + cism_debug = .true. + ... + / + + + 2. Set the value for the namelist variable ewn, which depends on the value + of "glc_grid" in the config_cache.xml file. Note that the value of + "glc_grid" does not need to be explicitly passed. + + build-namelist: + + add_default($nl, 'ewn'); + + namelist_defaults_cism.xml: + + 151 + 76 + 301 + 301 + + namelist_definitions_cism.xml: + + + + + result in cism.config if glc_grid="gland5": + + [grid] + ... + ewn = 301 + ... + + result in cism.config if glc_grid="gland10": + + [grid] + ... + ewn = 151 + ... + + + 3. Set the value for the namelist variable runid to $CASE + + build-namelist: + + add_default($nl, 'runid', 'val'=>"$CASE"); + + namelist_defaults_cism.xml: + + The contents of namelist defaults does not matter, since a value is + specified in build-namelist. + + namelist_definitions_cism.xml: + + + Simulation identifier (ie case name) + + + result in cism_in if $CASE="mycase": + + &time_manager_nml + ... + runid = 'mycase' + ... + / + + + 4a. Add a default for variable $var if an appropriate value is found, + otherwise do not include $var in the namelist + + build-namelist: + + add_default($nl, $var, 'nofail'=>1) + + 4b. Set the value for the namelist variable $var, but do not prepend it + with a directory prefix. + + build-namelist: + + add_default($nl, $var, 'noprepend'=>1) + + 5. Only include the namelist variable 'calving_fraction' in cism.config if a + value is given by the user in user_nl_cism; otherwise, use default value + given in the code + + (No references to calving_fraction in build-namelist) + +============================================================================ +Handling multiple instances +============================================================================ + +When NINST_GLC > 1, there are multiple instances of CISM (i.e., an +ensemble). Each instance has its own namelist, and its own cism.config file. + +In this case, there is no user_nl_cism. Instead, there is one such file for +each instance: user_nl_cism_0001, user_nl_cism_0002, etc. User modifications +in user_nl_cism_0001 will be put in cism_in_0001 or cism.config_0001, and +similarly for user_nl_cism_0002, etc. If there are modifications to cism_in +or cism.config that you want to make for all instances, you must put these +modifications in ALL of the user_nl_cism files (user_nl_cism_0001, +user_nl_cism_0002, etc.). + +Note that one of the namelist items in cism_in is 'paramfile', which gives +the name of the cism.config file. For simplicity, this namelist item is +specified by a command-line option from the script calling build-namelist, +and cannot be overridden by users. In the single instance case, cism_in +specifies a paramfile of 'cism.config'. In the multi-instance case, +cism_in_0001 specifies a paramfile of 'cism.config_0001', cism_in_0002 +specifies a paramfile of 'cism.config_0002', etc. + + +============================================================================ +CISM Use Cases +============================================================================ + +Q: How do I add my own case-specific namelist variable changes? + +A: For each namelist variable, just add a line of the form + + namelist_var = namelist_val + + to $CASEROOT/user_nl_cism. As shown in the "user_nl_cism" section above, + one example is to set cism_debug to .true. and basal_tract to the array + (/1,2,3,4,5/). The file $CASEROOT/user_nl_cism would then look as follows + + ... + cism_debug = .true. + basal_tract = 1 2 3 4 5 + + All cism namelist variables, as well as entries in cism.config, can be + changed in this manner. + +---------------------------------------------------------------------------- + +Q: Rather than making the same changes to user_nl_cism over and over, can + I change the default values used by build-namelist? + +A: Yes, you can modify the namelist_defaults_cism.xml file in + $CCSMROOT/components/cism/bld/namelist_files to change the default values. For + example: + + 1. If you want to change geothermal from -5.e-2 to -6.e-2, you + would change + + -5.e-2 + + to + + -6.e-2 + + This would result in the following new default setting in cism.config: + + [parameters] + ... + geothermal = -6.e-2 + ... + + 2. If you want to change ntem from 1. to 2. for runs using the gland5 + grid, without affecting the value for any other grid, you would change + + 1. + + to + + 2. + + This would result in the following new default setting in cism.config: + + [time] + ... + ntem = 2. + ... + + for any runs with GLC_GRID=gland5, while not changing the value for + other grids. + +---------------------------------------------------------------------------- + +Q: How do I add new cism namelist variables for just my case? + +A: Place a modified copy of namelist_definition_cism.xml (that includes your + new variables) in the $CASEROOT/SourceMods/src.cism directory. You do + not need to modify build-namelist or the defaults file, just set the + appropriate values for the new variables in $CASEROOT/user_nl_cism file. + + For example, to add a variable the_answer to the cism.config parameters + and set it equal to 42, you would take the following steps: + + 1. Copy $CODEROOT/glc/cism/bld/namelist_definition_cism.xml to + $CASEROOT/SourceMods/src.cism + + 2. Add the following (it can be added anywhere as long as it isn't in a + comment, but for consistency put it in the "group: cism.config: + parameters" block): + + + The answer to the question of life, the universe and everything + + + 3. Add the following to $CASEROOT/user_nl_cism + + the_answer=42 + + Note that you will also need to include a SourceMod to read in this + new variable, otherwise you will get a runtime error! + +---------------------------------------------------------------------------- + +Q: How do I add a new cism namelist variable to the cism code base? + +A: Follow the instructions above, but rather than editing a copy in + SourceMods/src.cism, edit namelist_definition_cism.xml directly in + $CODEROOT/glc/cism/bld/namelist_files. You may also want to update + namelist_defaults_cism.xml and build-namelist so your new value can be + set automatically. Continuing the example above, we would add + + 42 + + to namelist_defaults_cism.xml and + + add_default($nl, 'the_answer'); + + to build-namelist. Again, note that this will build a namelist with the + new variable, but you will need to update the source code to read it! + +---------------------------------------------------------------------------- + +Q: How do I introduce a new namelist variable that has dependencies on other + namelist variables? + +A: You can pass values through the add_default() function. As above, suppose + we want to introduce a new variable 'the_answer'. Let's also introduce a + new variable named 'is_binary'. To have gatekeeper_id depend on + is_binary, we do the following. + + 1. Add is_binary and the_answer to namelist_definitions_cism.xml (for + this example, assume is_binary is of type logical) + + 2. Add this dependency to the namelist_defaults_cism.xml file + + 42 + 101010 + + 3. Add the following lines to build-namelist (note that is_binary must + be set before the_answer) + + add_default($nl, 'is_binary', 'val'=>".false."); + my $is_binary = $nl->get_value('is_binary'); + add_default($nl, 'the_answer', 'is_binary'=>"$is_binary"); + + + Note that strings can not have spaces in the XML; to remove spaces + from a Perl variable use the following prior to sending it through + add_default as a dependency + + $varname =~ s/ //g; + +---------------------------------------------------------------------------- + +Q: How do I add an optional section in the cism.config file? There are some + CISM settings that depend on the mere presence / absence of a certain + section. + +A: An existing example of this is the [GTHF] section. If this section is + present in the config file, then certain code is enabled, controlled by + the variables in this section. The following changes were needed to + create this optional section; this is also what you'll have to do to + create a new optional section: + + 1. Added a do_gthf variable in + namelist_files/namelist_definition_cism.xml, with + group="cism_config_control": + + + Determines whether the GTHF (geothermal heat flux) section is output to the cism.config file. + Default: false + + + Also added a corresponding default value in + namelist_files/namelist_defaults_cism.xml: + + .false. + + 2. Added a new section in namelist_files/namelist_definition_cism.xml + that lists all of the possible variables that might appear in that + section. See the section with the heading "group: cism.config: GTHF + (geothermal heat flux)". + + Note that the variables in this section do NOT appear in + namelist_defaults_cism.xml. Thus, if a user sets do_gthf to + .true. without specifying the values of any of these variables, they + will take their values from the hard-coded defaults in the cism code. + + 3. Added some code in build-namelist that controls whether to print the + [GTHF] section in the cism.config file: + + # Some code in cism keys off of whether the [GTHF] section is present + # (even if it's empty), thus we only want to add this section if it's + # really desired by the user + add_default($nl, 'do_gthf'); + if ($nl->get_value('do_gthf') eq '.true.') { + print $fh "\n[GTHF]\n"; + $nl->write_cism_config($fh, "cism_config_gthf"); + } + else { + confirm_empty("cism_config_gthf", "items in gthf section can only be set if do_gthf is set to .true."); + } + + + Note that, if defaults were desired (specified in + namelist_defaults_cism.xml), add_default lines could be added in the + 'if' block of the above conditional, before the call to + write_cism_config. + + diff --git a/components/cism/bld/build-namelist b/components/cism/bld/build-namelist new file mode 100755 index 0000000000..b09d1a04ab --- /dev/null +++ b/components/cism/bld/build-namelist @@ -0,0 +1,1041 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# build-namelist +# +# This script builds the namelists for the CISM configuration of CESM1. +# +# build-namelist uses a config_cache.xml file that current contains the glc grid information. +# build-namelist reads this file to obtain information it needs to provide +# default values that are consistent with the CISM library. For example, the grid resolution +# is obtained from the cache file and used to determine appropriate defaults for namelist input +# that is resolution dependent. +# +# The simplest use of build-namelist is to execute it from the build directory where configure +# was run. By default it will use the config_cache.xml file that was written by configure to +# determine the build time properties of the executable, and will write the files that contain +# the output namelists in that same directory. +# +# +# Date Contributor Modification +# ------------------------------------------------------------------------------------------- +# 2012-01-30 Vertenstein Original version +#-------------------------------------------------------------------------------------------- +use strict; +use Cwd qw(getcwd abs_path); +use English; +use Getopt::Long; +use IO::File; +#----------------------------------------------------------------------------------------------- + +sub usage { + die < 0, + silent => 0, + caseroot => undef, + scriptsroot => undef, + inst_string => undef, + paramfile => undef, + lnd_grid => undef, + glc_grid => undef, + cism_phys => undef, + ); + +GetOptions( + "h|help" => \$opts{'help'}, + "infile=s" => \$opts{'infile'}, + "namelist=s" => \$opts{'namelist'}, + "s|silent" => \$opts{'silent'}, + "v|verbose" => \$opts{'verbose'}, + "caseroot=s" => \$opts{'caseroot'}, + "scriptsroot=s" => \$opts{'scriptsroot'}, + "inst_string=s" => \$opts{'inst_string'}, + "paramfile=s" => \$opts{'paramfile'}, + "lnd_grid=s" => \$opts{'lnd_grid'}, + "glc_grid=s" => \$opts{'glc_grid'}, + "cism_phys=s" => \$opts{'cism_phys'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Check for unparsed arguments +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +# Define print levels: +# 0 - only issue fatal error messages +# 1 - only informs what files are created (default) +# 2 - verbose +my $print = 1; +if ($opts{'silent'}) { $print = 0; } +if ($opts{'verbose'}) { $print = 2; } +my $eol = "\n"; + +if ($print>=2) { print "Setting CISM configuration script directory to $cfgdir$eol"; } + +my $CASEROOT = $opts{'caseroot'}; +my $SCRIPTSROOT = $opts{'scriptsroot'}; +my $INST_STRING = $opts{'inst_string'}; +my $LND_GRID = $opts{'lnd_grid'}; +my $GLC_GRID = $opts{'glc_grid'}; +my $CISM_PHYS = $opts{'cism_phys'}; + +#----------------------------------------------------------------------------------------------- +# Build empty config_cache.xml file (needed below) + +my $bldconfdir = "$CASEROOT/Buildconf/datmconf"; +if ( $opts{'debug'} ) { + my $cmd = "mkdir -p $bldconfdir"; + print "Execute: $cmd\n"; + system( "$cmd" ); + chdir( "$bldconfdir" ); +} + +# build config_cache.xml file (needed below) +my $config_cache = "${CASEROOT}/Buildconf/cismconf/config_cache.xml"; +my $fh = new IO::File; +$fh->open(">$config_cache") or die "** can't open file: $config_cache\n"; +print $fh <<"EOF"; + + + + + + +EOF +$fh->close; +if ($print>=2) { print "Wrote file $config_cache $eol"; } +(-f "config_cache.xml") or die <<"EOF"; +** $ProgName - Cannot find configuration cache file: config_cache.xml\" ** +EOF + +#----------------------------------------------------------------------------------------------- +# Make sure we can find required perl modules, definition, and defaults files. +# Look for them under the directory that contains the configure script. + +# The root directory for the perl5 required utilities +my $perl5lib_dir = "${SCRIPTSROOT}/../utils/perl5lib"; + +# The root diretory for the perl SetupTools.pm module +my $SetupTools_dir = "${SCRIPTSROOT}/Tools"; + +# The Build::Config module provides utilities to access the configuration information +# in the config_cache.xml file (see below) +(-f "$perl5lib_dir/Build/Config.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/Config.pm\" in directory \"$perl5lib_dir\" ** +EOF + +# The Build::NamelistDefinition module provides utilities to validate that the output +# namelists are consistent with the namelist definition file +(-f "$perl5lib_dir/Build/NamelistDefinition.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/NamelistDefinition.pm\" in directory \"$perl5lib_dir\" ** +EOF + +# The Build::NamelistDefaults module provides a utility to obtain default values of namelist +# variables based on finding a best fit with the attributes specified in the defaults file. +(-f "$perl5lib_dir/Build/NamelistDefaults.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/NamelistDefaults.pm\" in directory \"$perl5lib_dir\" ** +EOF + +# The Build::Namelist module provides utilities to parse input namelists, to query and modify +# namelists, and to write output namelists. +(-f "$perl5lib_dir/Build/Namelist.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/Namelist.pm\" in directory \"$perl5lib_dir\" ** +EOF + +# The namelist definition file contains entries for all namelist variables that +# can be output by build-namelist. The version of the file that is associate with a +# fixed CISM tag is $cfgdir/namelist_files/namelist_definition.xml. To aid developers +# who make use of the SourceMods/src.cism directory - we allow the definition file +# to come from that directory +my $nl_definition_file; +if (-f "${CASEROOT}/SourceMods/src.cism/namelist_definition_cism.xml") { + $nl_definition_file = "${CASEROOT}/SourceMods/src.cism/namelist_definition_cism.xml"; +} +if (! defined $nl_definition_file) { + # default location of namelist definition file + $nl_definition_file = "$cfgdir/namelist_files/namelist_definition_cism.xml"; + (-f "$nl_definition_file") or die <<"EOF"; + ** $ProgName - ERROR: Cannot find namelist definition file \"$nl_definition_file\" ** +EOF +} +if ($print>=2) { print "Using namelist definition file $nl_definition_file$eol"; } + +# The namelist defaults file contains default values for all required namelist variables. +my $nl_defaults_file = "$cfgdir/namelist_files/namelist_defaults_cism.xml"; +(-f "$nl_defaults_file") or die <<"EOF"; +** $ProgName - Cannot find namelist defaults file \"$nl_defaults_file\" ** +EOF +if ($print>=2) { print "Using namelist defaults file $nl_defaults_file$eol"; } + +#----------------------------------------------------------------------------------------------- +# Add $perl5lib_dir to the list of paths that Perl searches for modules +unshift @INC, "$CASEROOT/Tools/", "$perl5lib_dir"; +require Build::Config; +require Build::NamelistDefinition; +require Build::NamelistDefaults; +require Build::Namelist; +require SetupTools; + +#----------------------------------------------------------------------------------------------- +# Create a configuration object from the CISM config_cache.xml file- created by +# cism.cpl7.template in $CASEROOT/Buildconf/cismconf +my $cfg = Build::Config->new('config_cache.xml'); + +# Create a namelist definition object. This object provides a method for verifying that the +# output namelist variables are in the definition file, and are output in the correct +# namelist groups. +my $definition = Build::NamelistDefinition->new($nl_definition_file); + +# Create a namelist defaults object. This object provides default values for variables +# contained in the input defaults file. The configuration object provides attribute +# values that are relevent for the CISM library for which the namelist is being produced. +my $defaults = Build::NamelistDefaults->new($nl_defaults_file, $cfg); + +# Create an empty namelist object. Add values to it in order of precedence. +my $nl = Build::Namelist->new(); + +#----------------------------------------------------------------------------------------------- +# Process the user input in order of precedence. +# At each point we'll only add new values to the namelist and not overwrite previously +# specified specified values which have higher precedence. + +# Process command-line options +my $val; +my $group; +my $var; + +# paramfile +# Note special handling of paramfile: This namelist item, which appears in cism_in, cannot be +# set by the user, but instead must be specified as a command-line option. This is because this +# file (cism.config) is created by build-namelist, and then copied by the calling script into a +# new location. Thus, the calling script needs to know the name of the paramfile; to keep things +# simple, we have the calling script set this value and do not allow the user to override it. +$var='paramfile'; +if (defined $opts{$var}) { + $val = $opts{$var}; + $val = quote_string($val); + $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); +} else { + die "$ProgName - ERROR: paramfile must be specified"; +} + + +# Process the -namelist arg. +if (defined $opts{'namelist'}) { + # Parse commandline namelist + my $nl_arg = Build::Namelist->new($opts{'namelist'}); + + # Validate input namelist -- trap exceptions + my $nl_arg_valid; + eval { $nl_arg_valid = $definition->validate($nl_arg); }; + if ($@) { + die "$ProgName - ERROR: Invalid namelist variable in commandline arg '-namelist'.\n $@"; + } + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_arg_valid); +} + +# Process the -infile arg. +if (defined $opts{'infile'}) { + # Parse namelist input from a file + my $nl_infile = Build::Namelist->new($opts{'infile'}); + + # Validate input namelist -- trap exceptions + my $nl_infile_valid; + eval { $nl_infile_valid = $definition->validate($nl_infile); }; + if ($@) { + die "$ProgName - ERROR: Invalid namelist variable in '-infile' $opts{'infile'}.\n $@"; + } + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_infile_valid); +} + +#----------------------------------------------------------------------------------------------- +# Determine namelist +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +#################################### +# Required xml variables # +#################################### + +my %xmlvars = (); +SetupTools::getxmlvars($CASEROOT, \%xmlvars); +foreach my $attr (keys %xmlvars) { + $xmlvars{$attr} = SetupTools::expand_xml_var($xmlvars{$attr}, \%xmlvars); +} + +my $CASE = $xmlvars{'CASE'}; +my $CALENDAR = $xmlvars{'CALENDAR'}; +my $EXEROOT = $xmlvars{'EXEROOT'}; +my $CODEROOT = $xmlvars{'CODEROOT'}; +my $SCRIPTSROOT = $xmlvars{'SCRIPTSROOT'}; +my $CASEROOT = $xmlvars{'CASEROOT'}; +my $DIN_LOC_ROOT = $xmlvars{'DIN_LOC_ROOT'}; +my $RUN_TYPE = $xmlvars{'RUN_TYPE'}; +my $RUN_STARTDATE = $xmlvars{'RUN_STARTDATE'}; +my $RUN_REFCASE = $xmlvars{'RUN_REFCASE'}; +my $RUN_REFDATE = $xmlvars{'RUN_REFDATE'}; +my $CONTINUE_RUN = $xmlvars{'CONTINUE_RUN'}; +my $NCPL_BASE_PERIOD = $xmlvars{'NCPL_BASE_PERIOD'}; +my $GLC_NCPL = $xmlvars{'GLC_NCPL'}; +my $GLC_TWO_WAY_COUPLING = $xmlvars{'GLC_TWO_WAY_COUPLING'}; +my $CISM_USE_TRILINOS = $xmlvars{'CISM_USE_TRILINOS'}; +my $CISM_OBSERVED_IC = $xmlvars{'CISM_OBSERVED_IC'}; + +(-d $DIN_LOC_ROOT) or die <<"EOF"; +** $ProgName - CCSM inputdata root is not a directory: \"$DIN_LOC_ROOT\" ** +EOF +if ($print>=2) { print "CESM inputdata root directory: $DIN_LOC_ROOT$eol"; } + +#################################### +# Preliminary consistency checks +#################################### + +check_grid($GLC_GRID, $CISM_PHYS); + +#################################### +# namelist group: time_manager_nml # +#################################### + +my $startdate = $RUN_STARTDATE; +if ($RUN_TYPE eq 'branch') { $startdate = $RUN_REFDATE; } + +my $iyear0 = `echo $startdate | cut -c1-4 | sed -e 's/^0*//'`; +$iyear0 =~ s/\n/ /g; # remove imbedded newline +my $imonth0 = `echo $startdate | cut -c6-7 | sed -e 's/^0*//'`; +$imonth0 =~ s/\n/ /g; # remove imbedded newline +my $iday0 = `echo $startdate | cut -c9-10 | sed -e 's/^0*//'`; +$iday0 =~ s/\n/ /g; # remove imbedded newline +my $ihour0 = 0; + +my ($dt_option, $dt_count) = get_glc_dt($NCPL_BASE_PERIOD, $GLC_NCPL); + +add_default($nl, 'runid', 'val'=>"$CASE"); +add_default($nl, 'dt_option', 'val'=>$dt_option); +add_default($nl, 'dt_count', 'val'=>$dt_count); +add_default($nl, 'allow_leapyear', 'calendar'=>"$CALENDAR"); +add_default($nl, 'iyear0', 'val'=>$iyear0); +add_default($nl, 'imonth0', 'val'=>$imonth0); +add_default($nl, 'iday0' , 'val'=>$iday0); +add_default($nl, 'ihour0' , 'val'=>$ihour0); +add_default($nl, 'iminute0','val'=>0); +add_default($nl, 'isecond0','val'=>0); +add_default($nl, 'date_separator'); +add_default($nl, 'stop_option'); + +#################################### +# namelist group: cism_params # +#################################### + +add_default($nl, 'paramfile', 'noprepend'=>'1' ); +add_default($nl, 'cism_debug'); +add_default($nl, 'ice_flux_routing'); + +my $hotstart; +if ($RUN_TYPE eq 'startup') { + add_default($nl, 'cisminputfile'); + $hotstart = 0; +} +elsif ($CISM_OBSERVED_IC eq 'TRUE') { + if ($RUN_TYPE eq 'branch') { + die "$ProgName - ERROR: CISM_OBSERVED_IC=TRUE not allowed for branch runs - only for hybrid runs\n"; + } + + add_default($nl, 'cisminputfile'); + $hotstart = 0; +} +elsif ($RUN_TYPE eq 'branch' || $RUN_TYPE eq 'hybrid') { + add_default($nl, 'cisminputfile', + 'val'=>"${RUN_REFCASE}.cism.r.${RUN_REFDATE}-00000.nc", 'noprepend'=>'1'); + $hotstart = 1; +} +else { + die "$ProgName - ERROR: Unknown RUN_TYPE: $RUN_TYPE\n"; +} + +#################################### +# namelist group: cism_history # +#################################### + +add_default($nl, 'cesm_history_vars'); +add_default($nl, 'history_option'); +if (!($nl->get_value('history_option') =~ /coupler/)) { + add_default($nl, 'history_frequency'); +} + +#################################### +# namelist group: glc_override_nml # +#################################### + +add_default($nl, 'enable_frac_overrides'); +if ($nl->get_value('enable_frac_overrides') =~ $TRUE) { + add_default($nl, 'override_delay'); + add_default($nl, 'decrease_frac'); + add_default($nl, 'increase_frac'); + add_default($nl, 'rearrange_freq'); +} + +#----------------------------------------------------------------------------------------------- +# *** Write output namelist file (cism_in) and input dataset list (cism.input_data_list) *** +#----------------------------------------------------------------------------------------------- +# Set namelist groups to be written out + +my @groups = qw(cism_params cism_history time_manager_nml glc_override_nml); + +# Write out all groups to cism_in +my $outfile = "./cism_in"; +$nl->write($outfile, 'groups'=>\@groups); +if ($print>=2) { print "Writing cism glc component namelist to $outfile $eol"; } + +# Write input dataset list. +check_input_files($nl, $DIN_LOC_ROOT, "../cism.input_data_list"); + +#################################### +# create cism.config in run dir # +#################################### + +# Write cism.config +my $fh = new IO::File; +$fh->open(">cism.config") or die "** can't open file: cism.config\n"; + +print $fh "[grid]\n"; +add_default($nl, 'ewn'); +add_default($nl, 'nsn'); +add_default($nl, 'upn'); +add_default($nl, 'dew'); +add_default($nl, 'dns'); +$nl->write_cism_config($fh, "cism_config_grid"); + +print $fh "\n[GLAD climate]\n"; +add_default($nl, 'evolve_ice'); +add_default($nl, 'test_coupling'); +add_default($nl, 'zero_gcm_fluxes', 'glc_two_way_coupling'=>"$GLC_TWO_WAY_COUPLING"); +$nl->write_cism_config($fh, "cism_config_climate"); + +print $fh "\n[projection]\n"; +add_default($nl, 'type'); +add_default($nl, 'centre_latitude'); +add_default($nl, 'centre_longitude'); +add_default($nl, 'false_easting'); +add_default($nl, 'false_northing'); +add_default($nl, 'standard_parallel'); +$nl->write_cism_config($fh, "cism_config_projection"); + +print $fh "\n[options]\n"; +add_default($nl, 'dycore'); +add_default($nl, 'temperature'); +add_default($nl, 'temp_init'); +add_default($nl, 'flow_law'); +add_default($nl, 'basal_water'); +add_default($nl, 'basal_mass_balance'); +add_default($nl, 'gthf'); +add_default($nl, 'isostasy'); +add_default($nl, 'marine_margin'); +add_default($nl, 'slip_coeff'); +add_default($nl, 'evolution'); +add_default($nl, 'vertical_integration'); +add_default($nl, 'sigma'); +add_default($nl, 'hotstart', 'val'=>$hotstart); +$nl->write_cism_config($fh, "cism_config_options"); + +# The [sigma] section only applies if we're using user-defined sigma +# levels -- if not, leave it out to avoid confusion +if ($nl->get_value('sigma') == $SIGMA_IN_CONFIG_FILE) { + print $fh "\n[sigma]\n"; + add_default($nl, 'sigma_levels'); + $nl->write_cism_config($fh, "cism_config_sigma"); +} +else { + confirm_empty("cism_config_sigma", "items in sigma section can only be set if sigma is set to $SIGMA_IN_CONFIG_FILE"); +} + + +print $fh "\n[time]\n"; +add_default($nl, 'dt'); +add_default($nl, 'ntem'); +add_default($nl, 'dt_diag'); +add_default($nl, 'idiag'); +add_default($nl, 'jdiag'); +$nl->write_cism_config($fh, "cism_config_time"); + +print $fh "\n[parameters]\n"; +add_default($nl, 'log_level'); +add_default($nl, 'ice_limit'); +add_default($nl, 'marine_limit'); +add_default($nl, 'geothermal'); +add_default($nl, 'flow_factor'); +add_default($nl, 'hydro_time'); +add_default($nl, 'basal_tract_const'); +$nl->write_cism_config($fh, "cism_config_parameters"); + +# The ho_options section only applies if dycore is not 0 +if ($nl->get_value('dycore') != 0) { + print $fh "\n[ho_options]\n"; + add_default($nl, 'which_ho_babc'); + add_default($nl, 'which_ho_efvs'); + add_default($nl, 'which_ho_resid'); + add_default($nl, 'which_ho_disp'); + add_default($nl, 'which_ho_sparse', 'dycore'=>$nl->get_value('dycore'), 'cism_use_trilinos'=>"$CISM_USE_TRILINOS"); + add_default($nl, 'which_ho_nonlinear', 'dycore'=>$nl->get_value('dycore')); + $nl->write_cism_config($fh, "cism_config_ho_options"); +} +else { + confirm_empty("cism_config_ho_options", "items in ho_options_section can only be set if dycore is not 0"); +} + +# The [GTHF] section only applies if the 'gthf' option is set to +# GTHF_CALCULATE -- if not, we leave it out to avoid confusion +if ($nl->get_value('gthf') == $GTHF_CALCULATE) { + print $fh "\n[GTHF]\n"; + $nl->write_cism_config($fh, "cism_config_gthf"); +} +else { + confirm_empty("cism_config_gthf", "items in gthf section can only be set if gthf is set to $GTHF_CALCULATE"); +} + +# The [isostasy] section only applies if the 'isostasy' option is +# turned on -- if not, we leave it out to avoid confusion +if ($nl->get_value('isostasy') == $ISOSTASY_ON) { + print $fh "\n[isostasy]\n"; + $nl->write_cism_config($fh, "cism_config_isostasy"); +} +else { + confirm_empty("cism_config_isostasy", "items in isostasy section can only be set if isostasy is set to $ISOSTASY_ON"); +} + + +print $fh <<"EOF"; + +######################################## +# I/O configuration follows +######################################## + +\[CF default] +title: Glimmer-CISM simulation +institution: Community Earth System Model +EOF + +my $cisminputfile= $nl->get_value('cisminputfile'); +$cisminputfile =~ s/\'//g; +if ($CONTINUE_RUN eq 'FALSE') { +print $fh <<"EOF"; + +[CF input] +name: $cisminputfile +EOF +} +$fh->close; + +check_consistency($nl, \%xmlvars); + + +#----------------------------------------------------------------------------------------------- +# END OF MAIN SCRIPT +#=============================================================================================== + +#=============================================================================================== +sub add_default { + +# Add a value for the specified variable to the specified namelist object. The variables +# already in the object have the higher precedence, so if the specified variable is already +# defined in the object then don't overwrite it, just return. +# +# This method checks the definition file and adds the variable to the correct +# namelist group. +# +# The value can be provided by using the optional argument key 'val' in the +# calling list. Otherwise a default value is obtained from the namelist +# defaults object. If no default value is found this method throws an exception +# unless the 'nofail' option is set true. +# +# Additional optional keyword=>value pairs may be specified. If the keyword 'val' is +# not present, then any other keyword=>value pairs that are specified will be used to +# match attributes in the defaults file. +# +# Example 1: Specify the default value $val for the namelist variable $var in namelist +# object $nl: +# +# add_default($nl, $var, 'val'=>$val) +# +# Example 2: Add a default for variable $var if an appropriate value is found. Otherwise +# don't add the variable +# +# add_default($nl, $var, 'nofail'=>1) +# +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object +# $DIN_LOC_ROOT -- CCSM inputdata root directory + + my $nl = shift; # namelist object + my $var = shift; # name of namelist variable + my %opts = @_; # options + + my $val = undef; + + # Query the definition to find which group the variable belongs to. Exit if not found. + my $group = $definition->get_group_name($var); + unless ($group) { + my $fname = $definition->get_file_name(); + die "$ProgName - ERROR: variable \"$var\" not found in namelist definition file $fname.\n"; + } + + # check whether the variable has a value in the namelist object -- if so then return + $val = $nl->get_variable_value($group, $var); + if (defined $val) {return;} + + # Look for a specified value in the options hash + if (defined $opts{'val'}) { + $val = $opts{'val'}; + } + # or else get a value from namelist defaults object. + # Note that if the 'val' key isn't in the hash, then just pass anything else + # in %opts to the get_value method to be used as attributes that are matched + # when looking for default values. + else { + $val = get_default_value($var, \%opts); + } + + # if no value is found then exit w/ error (unless 'nofail' option set) + unless (defined $val) { + unless ($opts{'nofail'}) { + print "$ProgName - ERROR: No default value found for $var\n". + "user defined attributes:\n"; + foreach my $key (keys(%opts)) { + if ($key ne 'nofail' and $key ne 'val') { + print "key=$key val=$opts{$key}\n"; + } + } + die; + } + else { + return; + } + } + + # query the definition to find out if the variable is an input pathname + my $is_input_pathname = $definition->is_input_pathname($var); + + # The default values for input pathnames are relative. If the namelist + # variable is defined to be an absolute pathname, then prepend + # the CCSM inputdata root directory. + # TODO: unless ignore_abs is passed as argument + if ($is_input_pathname eq 'abs') { + unless ($opts{'noprepend'}){ + $val = set_abs_filepath($val, $DIN_LOC_ROOT); + } + } + + # query the definition to find out if the variable takes a string value. + # The returned string length will be >0 if $var is a string, and 0 if not. + my $str_len = $definition->get_str_len($var); + + # If the variable is a string, then add quotes if they're missing + if ($str_len > 0) { + $val = quote_string($val); + } + + # set the value in the namelist + $nl->set_variable_value($group, $var, $val); +} + +#----------------------------------------------------------------------------------------------- + +sub get_default_value { + +# Return a default value for the requested variable. +# Return undef if no default found. +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $defaults -- the namelist defaults object +# $uc_defaults -- the use CASE defaults object + + my $var_name = lc(shift); # name of namelist variable (CASE insensitive interface) + my $usr_att_ref = shift; # reference to hash containing user supplied attributes + + # Check in the namelist defaults + return $defaults->get_value($var_name, $usr_att_ref); + +} + +#----------------------------------------------------------------------------------------------- + +sub confirm_empty { + +# Confirm that a namelist group is empty (i.e., has no defined +# namelist items). +# Die if it isn't empty +# +# Usage: confirm_empty(group, errmsg) +# +# - group: name of namelist group +# - errmsg: error message to print if group is not empty + + my $group = shift; + my $errmsg = shift; + + my ($numvars, $varnames) = $nl->get_defined_vars_in_group($group); + if ($numvars > 0) { + print "$ProgName: ERROR: $errmsg\n"; + die "$ProgName: ERROR: This applies to: $varnames\n"; + } +} + +#----------------------------------------------------------------------------------------------- + +sub check_input_files { + +# For each variable in the namelist which is an input dataset, check to see if it +# exists locally. +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object + + my $nl = shift; # namelist object + my $inputdata_rootdir = shift; # if false prints test, else creates inputdata file + my $outfile = shift; + open(OUTFILE, ">$outfile") if defined $inputdata_rootdir; + + # Look through all namelist groups + my @groups = $nl->get_group_names(); + foreach my $group (@groups) { + + # Look through all variables in each group + my @vars = $nl->get_variable_names($group); + foreach my $var (@vars) { + + # Is the variable an input dataset? + my $input_pathname_type = $definition->is_input_pathname($var); + + # If it is, check whether it exists locally and print status + if ($input_pathname_type) { + # Get pathname of input dataset + my $pathname = $nl->get_variable_value($group, $var); + # Need to strip the quotes + $pathname =~ s/[\'\"]//g; + + if ($input_pathname_type eq 'abs') { + if ($inputdata_rootdir) { + print OUTFILE "$var = $pathname\n"; + } + } + elsif ($input_pathname_type =~ m/rel:(.+)/o) { + # The match provides the namelist variable that contains the + # root directory for a relative filename + my $rootdir_var = $1; + my $rootdir = $nl->get_variable_value($group, $rootdir_var); + $rootdir =~ s/[\'\"]//g; + if ($inputdata_rootdir) { + $pathname = "$rootdir/$pathname"; + print OUTFILE "$var = $pathname\n"; + } + } + } + } + } + close OUTFILE if defined $inputdata_rootdir; + return 0 if defined $inputdata_rootdir; +} + +#----------------------------------------------------------------------------------------------- + +sub set_abs_filepath { + +# check whether the input filepath is an absolute path, and if it isn't then +# prepend a root directory + + my ($filepath, $rootdir) = @_; + + # strip any leading/trailing whitespace + $filepath =~ s/^\s+//; + $filepath =~ s/\s+$//; + $rootdir =~ s/^\s+//; + $rootdir =~ s/\s+$//; + + # strip any leading/trailing quotes + $filepath =~ s/^['"]+//; + $filepath =~ s/["']+$//; + $rootdir =~ s/^['"]+//; + $rootdir =~ s/["']+$//; + + my $out = $filepath; + unless ( $filepath =~ /^\// ) { # unless $filepath starts with a / + $out = "$rootdir/$filepath"; # prepend the root directory + } + return $out; +} + +#------------------------------------------------------------------------------- + +sub valid_option { + + my ($val, @expect) = @_; + my ($expect); + + $val =~ s/^\s+//; + $val =~ s/\s+$//; + foreach $expect (@expect) { + if ($val =~ /^$expect$/i) { return $expect; } + } + return undef; +} + +#------------------------------------------------------------------------------- + +sub quote_string { + my $str = shift; + $str =~ s/^\s+//; + $str =~ s/\s+$//; + unless ($str =~ /^['"]/) { #"' + $str = "\'$str\'"; + } + return $str; +} + +#------------------------------------------------------------------------------- + +sub get_glc_dt { + +# Usage: ($dt_option, $dt_count) = get_glc_dt($ncpl_base_period, $glc_ncpl) +# +# Given the number of coupling intervals for GLC and the coupling base period, +# returns appropriate values of dt_option and dt_count for CISM's namelist. Note +# that this gives the dt values in cism_in - NOT the values in cism.config. +# +# This assumes that we want one timestep per coupling interval. + + my $ncpl_base_period = shift; + my $glc_ncpl = shift; + + my ($dt_option, $dt_count); + + if ($ncpl_base_period eq 'hour') { + if (3600 % $glc_ncpl != 0) { die "$ProgName: ERROR glc NCPL doesn't divide an hour evenly\n";} + $dt_option = 'seconds'; + $dt_count = 3600 / $glc_ncpl; + } elsif ($ncpl_base_period eq 'day') { + $dt_option = 'steps_per_day'; + $dt_count = $glc_ncpl; + } elsif ($ncpl_base_period eq 'year') { + $dt_option = 'steps_per_year'; + $dt_count = $glc_ncpl; + } elsif ($ncpl_base_period eq 'decade') { + $dt_option = 'steps_per_year'; + $dt_count = $glc_ncpl / 10; + } else { + die "$ProgName: ERROR invalid NCPL_BASE_PERIOD $ncpl_base_period\n"; + } + + return ($dt_option, $dt_count); +} + +#------------------------------------------------------------------------------- + +sub check_grid { + +# Usage: check_grid($glc_grid, $cism_phys) +# +# Checks that the glc_grid is valid given the cism_phys setting + + my ($glc_grid, $cism_phys) = @_; + + # we only care about the keys in allowed_grids, not the values; but we use a + # hash for easy lookup later + my %allowed_grids; + + if ($cism_phys eq "cism1") { + %allowed_grids = (gland20 => 1, + gland10 => 1, + gland5 => 1, + gland5UM => 1, + ); + } + elsif ($cism_phys eq "cism2") { + %allowed_grids = (gland20 => 1, + gland4 => 1, + ); + } + + if (!exists($allowed_grids{$glc_grid})) { + print "ERROR: For cism_phys = $cism_phys, allowable grids are:\n"; + print join(", ", sort keys %allowed_grids); + print "\n"; + print "Current value of GLC_GRID is: $glc_grid\n"; + die; + } +} + + +#------------------------------------------------------------------------------- + +sub check_consistency { + +# Usage: check_consistency($nl, \%xmlvars) +# (note that xmlvars is a reference to a hash) +# +# Checks various options for consistency; dies if any errors are found + + my ($nl, $xmlvars) = @_; + my $num_errors = 0; + + $num_errors += check_cism_dt($nl->get_value('dt')); + +# ---------------------------------------------------------------------- +# Requirements for evolve_ice = .false. +# ---------------------------------------------------------------------- + + if ($nl->get_value('evolve_ice') == 0) { + if ($nl->get_value('zero_gcm_fluxes') == 0) { + print "$ProgName: ERROR: for evolve_ice = 0, you must also set zero_gcm_fluxes = 1\n"; + print "(This is because evolve_ice = 0 implies that there will be no fluxes,\n"; + print "and you must explicitly set zero_gcm_fluxes = 1 for the sake of logic\n"; + print "that depends on whether these fluxes will be zero - particularly, the creation\n"; + print "of icemask_coupled_fluxes used by CLM).\n"; + $num_errors += 1; + } + } + +# ---------------------------------------------------------------------- +# Requirements for use of trilinos solver +# ---------------------------------------------------------------------- + + if ($nl->get_value('which_ho_sparse') == 4) { + if ($xmlvars->{'CISM_USE_TRILINOS'} eq 'FALSE') { + print "$ProgName: ERROR: Use of the trilinos solver (which_ho_sparse=4) requires building with trilinos (CISM_USE_TRILINOS=TRUE)\n"; + $num_errors += 1; + } + + if ($nl->get_value('dycore') == 0) { + print "$ProgName: ERROR: Can't use trilinos solver (which_ho_sparse=4) with glide dycore (dycore=0)\n"; + $num_errors += 1; + } + } + +# ---------------------------------------------------------------------- +# Requirements for running with more than one MPI task per ensemble member +# ---------------------------------------------------------------------- + + if ($xmlvars->{'NTASKS_GLC'} > $xmlvars->{'NINST_GLC'}) { + if ($nl->get_value('dycore') == 0) { + print "$ProgName: ERROR: With dycore=0 (glide dycore), can only have 1 GLC task per instance\n"; + print "NTASKS_GLC = " . $xmlvars->{'NTASKS_GLC'} . ", NINST_GLC = " . $xmlvars->{'NINST_GLC'} . "\n"; + $num_errors += 1; + } + + if ($nl->get_value('dycore') == 1 && $nl->get_value('which_ho_sparse') != 4) { + print "$ProgName: ERROR: To run with more than 1 GLC task per instance, with dycore=1, must use trilinos solver (which_ho_sparse=4)\n"; + print "NTASKS_GLC = " . $xmlvars->{'NTASKS_GLC'} . ", NINST_GLC = " . $xmlvars->{'NINST_GLC'} . "\n"; + print "which_ho_sparse = " . $nl->get_value('which_ho_sparse') . "\n"; + $num_errors += 1; + } + } + + + die if ($num_errors > 0); +} + +#------------------------------------------------------------------------------- + +sub check_cism_dt { + +# Usage: check_cism_dt($dt) +# +# Checks cism's dt value: i.e., the dt variable in the time section of cism.config. +# Returns 0 if okay, > 0 if errors found (i.e., if dt is an inappropriate value). Also, if +# any errors are found, an error message is printed. + + my $dt = shift; + my $num_errors = 0; + + +# Ensure that dt translates into an integer number of hours + + my $dt_hours = $dt * 365. * 24.; + # round to nearest integer: + my $dt_hours_int = sprintf("%.0f", $dt_hours); + + # make sure difference is basically 0, by comparing relative difference with a value near machine epsilon + if (abs($dt_hours - $dt_hours_int)/$dt_hours > 1.e-15) { + print "$ProgName: ERROR: dt (in years) must translate into an integer number of hours\n"; + print "dt = $dt\n"; + print "dt (hours) = $dt_hours\n"; + $num_errors += 1; + } + + return $num_errors; +} + diff --git a/components/cism/bld/cism.buildlib b/components/cism/bld/cism.buildlib new file mode 100755 index 0000000000..fa7a817bb8 --- /dev/null +++ b/components/cism/bld/cism.buildlib @@ -0,0 +1,128 @@ +#! /usr/bin/env perl +use strict; + +if ($#ARGV == -1) { + die " ERROR cism.buildexe: must specify a caseroot input argument"; +} +my ($CASEROOT) = @ARGV; +chdir "${CASEROOT}"; + +my $CASEBUILD = `./xmlquery CASEBUILD -value`; +my $CCSMROOT = `./xmlquery CCSMROOT -value`; +my $CASETOOLS = `./xmlquery CASETOOLS -value`; +my $OBJROOT = `./xmlquery OBJROOT -value`; +my $EXEROOT = `./xmlquery EXEROOT -value`; +my $LIBROOT = `./xmlquery LIBROOT -value`; +my $GMAKE_J = `./xmlquery GMAKE_J -value`; +my $GMAKE = `./xmlquery GMAKE -value`; +my $CISM_USE_TRILINOS = `./xmlquery CISM_USE_TRILINOS -value`; + +# directory in which glc is built +my $glc_dir = "$EXEROOT/glc"; + +# directory in which glc obj files are built +my $glc_obj_dir = "$OBJROOT/glc/obj"; + +# directory in which glimmer-cism library is created +my $cism_libdir = "$glc_dir/lib"; + +# directory in which we can find source mods +my $sourcemod_dir = "$CASEROOT/SourceMods/src.cism"; + +chdir "$glc_obj_dir"; + +# ---------------------------------------------------------------------- +# Create Filepath +# ---------------------------------------------------------------------- +# The following just gives the filepath for the cesm-specific code: +# the glimmer-cism stuff is picked up by the cmake-based build + +open(file,">Filepath") or die "Could not open file Filepath to write"; +print file "$sourcemod_dir \n"; +print file "$CCSMROOT/components/cism/drivers/cpl \n"; +print file "$CCSMROOT/components/cism/source_glc \n"; +print file "$CCSMROOT/components/cism/mpi \n"; +close(file); + +# ---------------------------------------------------------------------- +# Set options to cmake +# +# Note: Makefile variables should be given as: \\\$(VAR) +# Perl will expand this to \$(VAR) +# The extra preceding backslash is needed so that when cmake_opts is put on the command line, +# the shell doesn't try to interpret the '$'. +# ---------------------------------------------------------------------- +# Note that some other generic CMAKE options are set in the Makefile +my $cmake_opts; +$cmake_opts = ""; +$cmake_opts = "$cmake_opts -D CISM_COUPLED=ON"; +$cmake_opts = "$cmake_opts -D CISM_USE_MPI_WITH_SLAP=ON"; + +# CISM_USE_GPTL_INSTRUMENTATION is unnecessary (and possibly harmful) +# when built inside CESM; for CESM we instead use -DCCSMCOUPLED, which +# also gives us timing instrumentation +$cmake_opts = "$cmake_opts -D CISM_USE_GPTL_INSTRUMENTATION=OFF"; +$cmake_opts = "$cmake_opts -D CISM_BINARY_DIR=$glc_dir"; +$cmake_opts = "$cmake_opts -D CMAKE_Fortran_MODULE_DIRECTORY=$glc_obj_dir"; +$cmake_opts = "$cmake_opts -D CISM_NETCDF_DIR=\\\$(NETCDF_PATH)"; +$cmake_opts = "$cmake_opts -D CISM_MPI_INC_DIR=\\\$(INC_MPI)"; +$cmake_opts = "$cmake_opts -D CISM_SOURCEMOD_DIR=$sourcemod_dir/glimmer-cism"; + +# Turn on MPI_MODE always. This works within CESM because we always +# have an mpi library (possibly mpi-serial). And always turning on +# MPI_MODE means that we can defer more decisions to +# runtime. (Although this comes with a small performance cost when we +# don't actually need mpi.) +$cmake_opts = "$cmake_opts -D CISM_MPI_MODE=ON"; +$cmake_opts = "$cmake_opts -D CISM_SERIAL_MODE=OFF"; +if ("$CISM_USE_TRILINOS" eq 'TRUE') { + $cmake_opts = "$cmake_opts -D CISM_USE_TRILINOS=ON"; + $cmake_opts = "$cmake_opts -D CISM_TRILINOS_DIR=\\\$(TRILINOS_PATH)"; +} else { + $cmake_opts = "$cmake_opts -D CISM_USE_TRILINOS=OFF"; +} + +# ---------------------------------------------------------------------- +# Set mkDepends to append libglimmercismfortran.a to the end of each +# .o dependency line. +# +# Rationale: Some of the source files in the cesm-specific code depend +# on files included in this library. Ideally, we would be able to +# determine the actual dependencies, but that's not easy with the +# current tools and the fact that we build the glimmer-cism code using +# a different build system than the cesm-specific code. So for now, we +# just rebuild all the cesm-specific code whenever anything in the +# libglimmercismfortran.a library changes. +# +# WJS (3-6-13): I thought we would just need to include these options +# in the call to make the complib target. But for some reason that I +# can't determine, mkDepends is called when we make $glc_dir/Makefile, +# so we also need to include these options there. +# ---------------------------------------------------------------------- +my $mkdepends_opts = "-d $cism_libdir/libglimmercismfortran.a"; + +# ---------------------------------------------------------------------- +# create the glimmer-cism makefile by running cmake (done via a rule +# in the system-level makefile) +# ---------------------------------------------------------------------- +my $sysmod = "$GMAKE $glc_dir/Makefile MODEL=cism USER_CMAKE_OPTS=\"$cmake_opts\" USER_MKDEPENDS_OPTS=\"$mkdepends_opts\" GLC_DIR=$glc_dir -f $CASETOOLS/Makefile"; +system($sysmod) == 0 or die "ERROR cism.buildexe: $sysmod failed: $?\n"; + +# ---------------------------------------------------------------------- +# create the glimmer-cism library (or libraries), using the makefile +# created by cmake +# ---------------------------------------------------------------------- +chdir "$glc_dir"; + +my $sysmod = "$GMAKE -j $GMAKE_J"; +system($sysmod) == 0 or die "ERROR cism.buildexe: $sysmod failed: $?\n"; + +chdir "$glc_obj_dir"; + +# ---------------------------------------------------------------------- +# create the cesm-specific portion of the glc library using cesm's makefile +# ---------------------------------------------------------------------- +my $sysmod = "$GMAKE complib -j $GMAKE_J MODEL=cism COMPLIB=$LIBROOT/libglc.a USER_MKDEPENDS_OPTS=\"$mkdepends_opts\" GLC_DIR=$glc_dir -f $CASETOOLS/Makefile"; +system($sysmod) == 0 or die "ERROR cism.buildexe: $sysmod failed: $?\n"; + +exit 0 diff --git a/components/cism/bld/cism.buildnml b/components/cism/bld/cism.buildnml new file mode 100755 index 0000000000..debf0240bc --- /dev/null +++ b/components/cism/bld/cism.buildnml @@ -0,0 +1,113 @@ +#! /usr/bin/env perl +use strict; +use Cwd; + +if ($#ARGV == -1) { + die " ERROR cism.buildexe: must specify a caseroot input argument"; +} +my ($CASEROOT) = @ARGV; +chdir "${CASEROOT}"; + +my @dirs = ("$CASEROOT/Tools"); +unshift @INC, @dirs; +require SetupTools; +my $sysmod; + +my $CASEBUILD = `./xmlquery CASEBUILD -value`; +my $GLC_GRID = `./xmlquery GLC_GRID -value`; +my $CISM_PHYS = `./xmlquery CISM_PHYS -value`; +my $CISM_USE_TRILINOS = `./xmlquery CISM_USE_TRILINOS -value`; +my $CCSMROOT = `./xmlquery CCSMROOT -value`; +my $LND_GRID = `./xmlquery LND_GRID -value`; +my $NINST_GLC = `./xmlquery NINST_GLC -value`; +my $RUNDIR = `./xmlquery RUNDIR -value`; +my $SCRIPTSROOT = `./xmlquery SCRIPTSROOT -value`; +my $UTILROOT = `./xmlquery UTILROOT -value`; + +if (! -d "$CASEBUILD/cismconf" ) { + $sysmod = "mkdir $CASEBUILD/cismconf"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; +} +chdir "$CASEBUILD/cismconf"; + +my $inst_string; +my $inst_counter = 1; +while ($inst_counter <= $NINST_GLC) { + + # ----------------------------------------------------- + # determine instance string + # ----------------------------------------------------- + + $inst_string = ""; + if ($NINST_GLC > 1) { + $inst_string = `printf _%04d $inst_counter`; + + # If multi-instance case does not have restart file, use single-case restart + # for each instance + if ( (! -e "$RUNDIR/rpointer.glc${inst_string}") && (-e "$RUNDIR/rpointer.glc") ) { + $sysmod = "cp -v $RUNDIR/rpointer.glc $RUNDIR/rpointer.glc${inst_string}"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + } + } + + # ----------------------------------------------------- + # create cismconf/cesm_namelist + # ----------------------------------------------------- + + SetupTools::create_namelist_infile("$CASEROOT", + "$CASEROOT/user_nl_cism${inst_string}", + "$CASEBUILD/cismconf/cesm_namelist"); + + # ----------------------------------------------------- + # call build-namelist + # ----------------------------------------------------- + + if (-e "$CASEBUILD/cism.input_data_list") { + $sysmod = "rm $CASEBUILD/cism.input_data_list"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + } + + $sysmod = "$CCSMROOT/components/cism/bld/build-namelist"; + $sysmod = "$sysmod -infile $CASEBUILD/cismconf/cesm_namelist"; + $sysmod = "$sysmod -caseroot $CASEROOT"; + $sysmod = "$sysmod -scriptsroot $SCRIPTSROOT"; + $sysmod = "$sysmod -inst_string \"$inst_string\" "; + $sysmod = "$sysmod -paramfile cism.config${inst_string}"; + $sysmod = "$sysmod -lnd_grid $LND_GRID -glc_grid $GLC_GRID"; + $sysmod = "$sysmod -cism_phys $CISM_PHYS"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + + if (-d ${RUNDIR}) { + $sysmod = "cp $CASEBUILD/cismconf/cism_in ${RUNDIR}/cism_in${inst_string}"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + + $sysmod = "cp $CASEBUILD/cismconf/cism.config ${RUNDIR}/cism.config${inst_string}"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + } + + # ----------------------------------------------------- + # increment instance counter + # ----------------------------------------------------- + + $inst_counter = $inst_counter + 1; +} + +if ($CISM_USE_TRILINOS eq "TRUE") { + my $sourcemod_dir = "$CASEROOT/SourceMods/src.cism"; + if (-e "${sourcemod_dir}/trilinosOptions.xml") { + $sysmod = "cp ${sourcemod_dir}/trilinosOptions.xml ${RUNDIR}"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + } else { + my $trilinos_options_dir = "$CCSMROOT/components/cism/bld/trilinosOptions"; + my $trilinos_file = "trilinosOptions_${GLC_GRID}.xml"; + if (-e "${trilinos_options_dir}/${trilinos_file}") { + $sysmod = "cp ${trilinos_options_dir}/${trilinos_file} ${RUNDIR}/trilinosOptions.xml"; + system($sysmod) == 0 or die "ERROR cism.buildnml: $sysmod failed: $?\n"; + } else { + die "ERROR: no trilinosOptions file found in $trilinos_options_dir for GLC_GRID=$GLC_GRID \n"; + } + } +} + +exit (0); + diff --git a/components/cism/bld/cism.template b/components/cism/bld/cism.template new file mode 100755 index 0000000000..21d49e7d82 --- /dev/null +++ b/components/cism/bld/cism.template @@ -0,0 +1,81 @@ +#! /usr/bin/env perl +use strict; + +if ($#ARGV == -1) { + die " ERROR cism.buildn_usernl: must specify a caseroot input argument"; +} +my ($CASEROOT) = @ARGV; +my $sysmod; + +my $CCSMROOT = `./xmlquery CCSMROOT -value`; +my $CASEBUILD = `./xmlquery CASEBUILD -value`; + +#------------------------------------------------------------------------------- +# stage variable definition files and related scripts and templates to +# $CASEBUILD/cismIOconf, so users can modify easily modify IO fields +#------------------------------------------------------------------------------- + +my $IOCONF_DIR = "$CASEBUILD/cismIOconf"; +my $GLIMMER_CISM_ROOT = "$CCSMROOT/components/cism/glimmer-cism"; +if (! -d "$IOCONF_DIR") { + $sysmod = "mkdir $IOCONF_DIR"; + system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; +} +$sysmod = "cp $CCSMROOT/components/cism/bld/cismIO/README.cismIO $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/utils/build/generate_ncvars.py $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglimmer/ncdf_template.F90.in $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglide/glide_vars.def $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglad/glad_vars.def $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglad/glad_mbal_vars.def $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +# NOTE(wjs, 2015-04-03) glint is no longer used by CESM. However, I'm keeping +# the glint stuff here for now so that we can keep the glint default i/o files +# up-to-date (since I use this mechanism to regenerate the default i/o files) + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglint/glint_vars.def $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +$sysmod = "cp $GLIMMER_CISM_ROOT/libglint/glint_mbal_vars.def $IOCONF_DIR/"; +system($sysmod) == 0 or die "ERROR cism.build_usernl: $sysmod failed: $?\n"; + +#------------------------------------------------------------------------------- +# create cism.buildIO.csh script to allow users to modify the IO fields +#------------------------------------------------------------------------------- + +my $buildIO_script = "$IOCONF_DIR/cism.buildIO.csh"; +open(file,">$buildIO_script") or die "Could not open file $buildIO_script to write"; + +my $output = < + + + + + + + + + + + + +glc/cism/gland20.input_c150415.nc +glc/cism/gland10.input_c150415.nc +glc/cism/gland5.input_c150415.nc +glc/cism/IceSheetData_UMontana/PresentDayGreenland/Greenland_5km_v1.1_SacksRev_c150415.nc + + +glc/cism/gland20.input_c150415.nc + + +glc/cism/Greenland/glissade/init/greenland_4km.glissade.10kyr.beta6.SSacab_c150415a.nc + + + + + +.false. + +ocn + + + + + +'acab artm thk usurf topg uvel vvel uflx vflx temp bmlt bwat' + +nyears + +1 + + + + + +- + +never + +.false. + + + + + +.false. + +0 + +0.0 + +0.0 + +0 + + + + + +151 +76 +301 +301 +376 + +281 +141 +561 +561 +701 + +11 + +10000. +20000. +5000. +5000. +4000. + +10000. +20000. +5000. +5000. +4000. + + + + + + + + +0.00 0.15 0.30 0.45 0.60 0.75 0.83 0.90 0.95 0.98 1.00 + + + + + +1 + +.false. + +0 +1 + + + + + +"STERE" + +90.0 + +321.0 + +800000.0 + +3400000.0 + +71.0 + + + + + +0 +2 + +1 + +2 + +2 + +0 + +1 + +0 + +0 + +1 + +0 + +0 +3 + +0 + +0 + + + + + +
0.1
+
0.1
+
0.05
+
0.05
+ + +
0.5
+ +
0.0083333333333333333
+ +1 + + +1. + + +38 +19 +76 +76 +95 + +114 +57 +228 +228 +285 + + + + + +6 + +100. + +-200. + +-5.e-2 + +3. +1. + +1000. + +1.e-4 + + + + + + + + +5 +4 +4 +4 +4 + +2 + +3 + +1 + +3 +1 +4 + +1 +0 + + diff --git a/components/cism/bld/namelist_files/namelist_definition_cism.xml b/components/cism/bld/namelist_files/namelist_definition_cism.xml new file mode 100644 index 0000000000..033ed90a15 --- /dev/null +++ b/components/cism/bld/namelist_files/namelist_definition_cism.xml @@ -0,0 +1,1150 @@ + + + + + + + + + + + + +Input file +Default: For startup runs or hybrid runs with CISM_OBSERVED_IC=TRUE, a resolution-dependent + initial conditions file (e.g., gland10.input.nc). + For branch/hybrid runs with CISM_OBSERVED_IC=FALSE, a restart file name + built based on RUN_REFCASE and RUN_REFDATE. + + + + + + + +Name of top-level configuration file for Glimmer Glacier model +(Determined by scripts -- cannot be set by user) + + + +Determines whether extra diagnostics are printed in the cism log file +Default: false + + + +Code describing how the solid ice runoff flux (i.e., calving) should +be routed. +ocn: all solid ice goes to the ocean component +ice: all solid ice goes to the sea ice component +Default: ocn + + + + + + + +Space-delimited list of variables output to history file +Default: 'acab artm thk usurf topg uvel vvel uflx vflx temp bmlt bwat' + + + +How history frequency is specified +nyears: Write history every N years +coupler: Get history frequency from coupler (HIST_OPTION/HIST_N xml variables) + WARNING: SHOULD NOT BE USED IN PRODUCTION RUNS - frequency metadata not set properly +Default: nyears + + + +History frequency +e.g., if history_option=nyears, then 1 = annual, 2 = every two years, etc. +Ignored for history_option = 'coupler' +Default: 1 + + + + + + + +Simulation identifier (ie case name) +Default: case name set by create_newcase + + + +GLC time-step units +This generally should not be changed +Valid values: steps_per_year, steps_per_day, seconds, hours +Default: set based on NCPL_BASE_PERIOD and GLC_NCPL in env_run.xml, +so that there is one GLC time step per coupling period + + + +Time step, in units given by dt_option +This generally should not be changed +Default: set based on NCPL_BASE_PERIOD and GLC_NCPL in env_run.xml, +so that there is one GLC time step per coupling period + + + +Whether leap years are enabled in the GLC time manager. +CAUTION: Leap years don't work correctly with GLC time steps longer than a few months. +Default: .false. + + + +Starting year number +Default: comes from RUN_STARTDATE or RUN_REFDATE + + + +Starting month number +Default: comes from RUN_STARTDATE or RUN_REFDATE + + + +Starting day number in month +Default: comes from RUN_STARTDATE or RUN_REFDATE + + + +Starting hour of the day +Default: 0 + + + +Starting minute of the day +Default: 0 + + + +Starting second of the minute +Default: 0 + + + +Character to separate date values +Default: '-' + + + +Stop option -- always let the coupler stop the model so use 'never'. +Default: 'never' + + + + + + + +Whether to enable overrides of the glc fraction sent to the coupler. +If this is false, the other settings in this namelist group are ignored. +ONLY MEANT FOR TESTING - SHOULD NOT BE USED FOR SCIENCE RUNS. +Default: .false. + + + +Time delay before beginning any overrides (days). +Default: 0 (start overrides at beginning of run) + + + +Fractional decrease in glacier area, per day (should be positive). +(days_elapsed * decrease_frac) determines the elevation threshold below which ice_covered is set to 0. +When this factor reaches 1, all elevations below 3500 m are set to non-ice-covered. +Default: 0 (no decrease) + + + +Fractional increase in glacier area, per day. +(days_elapsed * increase_frac) determines the elevation threshold above which ice_covered is set to 1. +When this factor reaches 1, all elevations >= 0 m are set to ice-covered. +Default: 0 (no increase) + + + +Frequency (days) at which we rearrange elevation classes. +Default: 0 (no flips ever) + + + + + + + + +Number of nodes in x-direction +Default: resolution-dependent + + + +Number of nodes in y-direction +Default: resolution-dependent + + + +Number of nodes in z-direction +Default: 11 + + + +Node spacing in x-direction (m) +Default: resolution-dependent + + + +Node spacing in y-direction (m) +Default: resolution-dependent + + + + + + + + + +List of sigma levels, in ascending order, separated by spaces +These run between 0.0 (at top surface) and 1.0 (at lower surface) +Only relevant if sigma = 2 +Default: 0.00 0.15 0.30 0.45 0.60 0.75 0.83 0.90 0.95 0.98 1.00 + + + + + + + +0: Do not let the ice sheet evolve (hold ice state fixed at initial condition) +1: Let the ice sheet evolve +Default: 1 + + + +Ice time-step multiplier: allows asynchronous climate-ice coupling +Default: 1 + + + +If this is set to true, it sets the mass balance timestep to 1 day. +This means the ice dynamics is called after one day of climate simulation. +THIS IS ONLY FOR TESTING OF COUPLING PROCEDURES, NOT TO BE USED FOR SCIENCE. + + + +0: Send true fluxes to the GCM +1: Zero out all fluxes sent to the GCM +Default: Depends on GLC_TWO_WAY_COUPLING xml variable + + + + + + + + + + +String specifying the map projection type +Valid values: LAEA, AEA, LCC, STERE +Default: STERE + + + +Central latitude (degrees north) +Default: 90.0 + + + +Central longitude (degrees east) +Default: 321.0 + + + +False easting (m) +Default: 800000.0 + + + +False northing (m) +Default: 3400000.0 + + + +Location of standard parallel(s) (degrees north) +Up to two standard parallels may be specified (depending on the projection) +Default: 71.0 + + + +Scale factor; only relevant for the Stereographic projection +Default: 0.0 + + + + + + + + +Which dycore to use +0: glide dycore (SIA, serial only) +1: NOT SUPPORTED: glam dycore (HO, FDM, serial or parallel) + Note that this option is not allowed within CESM, because it is buggy +2: glissade dycore (HO, FEM, serial or parallel) +Default: 0 for cism1, 2 for cism2 + + + +Determines the temperature solution method +0: isothermal: set column to surface air temperature +1: prognostic temperature solution +2: do NOTHING: hold temperatures steady at initial value +3: prognostic enthalpy solution +Default: 1 + + + +Temperature initialization method +0: Initialize temperature to 0 C +1: Initialize temperature to surface air temperature +2: Initialize temperature with a linear profile in each column +Default: 2 + + + +0: constant value, taken from default_flwa +1: uniform value equal to the Paterson-Budd value at -10 deg C +2: Paterson-Budd temperature-dependent relationship +Default: 2 + + + +Determines the treatment of basal water +0: Set to zero everywhere +1: Calculated from local water balance +2: Compute the basal water flux, then find depth via calculation +3: Set to constant everywhere (10m) +4: Calculated from till water content, in the basal processes module +Default: 0 + + + +0: ignore marine margin +1: set thickness to zero if floating +2: lose a specified fraction of floating ice +3: set thickness to zero if relaxed bedrock is below a given depth (marine_limit) +4: set thickness to zero if current bedrock is below a given depth (marine_limit) +5: Huybrechts grounding line scheme for Greenland initialization +Default: 1 + + + +Basal traction parameter +0: no basal sliding +1: constant basal traction coefficient +2: constant coefficient where basal water is present, else no sliding +3: constant coefficient where the basal temperature is at the pressure melting point, else no sliding +4: coefficient is proportional to basal melt rate +5: coefficient is a linear function of basal water depth +Default: 0 + + + +0: pseudo-diffusion +1: ADI scheme [CANNOT BE USED: RESTARTS ARE NOT EXACT] +2: diffusion +3: remap thickness +4: 1st order upwind +5: no thickness evolution +Default: 0 for cism1, 3 for cism2 + + + +Method of integration used to obtain vertical velocity +0: standard vertical integration +1: vertical integration constrained to obey an upper kinematic boundary condition +Default: 0 + + + +0: relaxed topography is read from a separate variable +1: first time slice of input topography is assumed to be relaxed +2: first time slice of input topography is assumed to be in isostatic equilibrium with ice thickness +Default: 0 + + + +0: not in continuity equation +1: in continuity equation +Default: 1 + + + +0: prescribed uniform geothermal heat flux +1: read 2D geothermal flux field from input file (if present) +2: calculate geothermal flux using 3d diffusion +Default: 0 + + + +0: no isostasy +1: compute isostasy +Default: 0 + + + +How to determine sigma values +0: compute standard Glimmer sigma coordinates +1: sigma coordinates are given in external file [NOT ALLOWED WHEN RUNNING CISM IN CESM] +2: read sigma coordinates from config file (from sigma_levels) +3: evenly spaced levels, as required for glam dycore +4: compute Pattyn sigma coordinates +Default: 0 + + + +0: no periodic EW boundary conditions +1: periodic EW boundary conditions +(This is a Glimmer serial option. The parallel code enforces periodic +EW and NS boundary conditions by default.) +Default: 0 + + + +Hotstart (restart) the model if set to 1. +This allows for exact restarts from previous initial conditions +Default: 0 for startup or hybrid with CISM_OBSERVED_IC=TRUE, 1 for hybrid/branch with CISM_OBSERVED_IC=FALSE + + + + + + + +Ice sheet timestep (years) +Must translate into an integer number of hours +Default: Depends on resolution and physics option + + + +Multiplier of ice sheet timestep, dt +(in theory, can be real-valued, but values less than 1 are not handled properly, so restricted to being an integer) +Default: 1 + + + +Subcycling for glissade +Default: 1 + + + +Profile period (number of time steps between profiles) +Default: 100 + + + +Diagnostic frequency (years) +Set to 0 for no diagnostic output; set to dt for diagnostic output every time step +Default: 1 + + + +x coordinate of point for diagnostic output +Default: resolution-dependent + + + +y coordinate of point for diagnostic output +Default: resolution-dependent + + + + + + + +Set to a value between 0 (no messages) and 6 (all messages) +Default: 6 + + + +Thickness below which ice dynamics is ignored (m) +Below this limit, ice is only accumulated +Default: 100. + + + +All ice is assumed lost once water depths reach this value (for marine_margin=2 or 4) (m) +Note that water depth is negative +Default: -200. + + + +Fraction of ice lost to calving +Default: (use hard-coded default) + + + +Constant geothermal heat flux (W m-2; sign convention is positive down) +(May be overwritten by a spatially-varying field in input file [bheatflx]) +Default: -0.05 + + + +The flow law is enhanced with this factor. +The greater the value, the lower the viscosity and the faster the ice will flow. +Default: 3.0 for cism1, 1.0 for cism2 + + + +Glen's A to use in isothermal case +Default: (use hard-coded default) + + + +Time scale for basal water to drain (yr-1) +(Not relevant for basal_water=2) +Default: 1000. + + + +(m yr-1 Pa-1) +Default: 1.e-4 + + + +(m yr-1 Pa-1) +(Only used for slip_coeff = BTRC_LINEAR_BMLT) +Default: (use hard-coded default) + + + +(Pa-1) +(Only used for slip_coeff = BTRC_LINEAR_BMLT) +Default: (use hard-coded default) + + + +5-element list of values +(Only used for slip_coeff = BTRC_TANH_BWAT) +Default: (use hard-coded default) + + + +Optional periodic offset for ismip-hom and similar tests +May be needed to ensure continuous ice geometry at the edges of the +global domain +Default: 0. + + + +Optional periodic offset for ismip-hom and similar tests +May be needed to ensure continuous ice geometry at the edges of the +global domain +Default: 0. + + + + + + + + + +Basal boundary condition for Payne/Price dynamical core +0: constant value of 10 Pa/yr (useful for debugging) +1: simple hard-coded pattern (useful for debugging) +2: treat betasquared value as a till yield stress (in Pa) using Picard iteration +3: linear (inverse) function of bwat +4: very large value for betasquared to enforce no slip everywhere +5: betasquared field passed in from .nc input file as part of standard i/o +6: no slip everywhere (using Dirichlet BC rather than large betasquared) +7: treat betasquared value as till yield stress (in Pa) using Newton-type iteration (in devel.) +Default: 5 + + + +How effective viscosity is computed for higher-order dynamical core +0: constant value +1: multiple of flow factor +2: compute from effective strain rate +Default: 2 + + + +Method for computing residual in Payne/Price dynamical core +0: maxval +1: maxval ignoring basal velocity +2: mean value +3: L2 norm of system residual, Ax-b=resid +Default: 3 + + + +Method for computing the dissipation during the temperature calculation +-1: no dissipation +0: 0-order SIA approx. +1: 1st order solution (e.g., Blatter-Pattyn) +Default: 1 + + + +Method for solving the sparse linear system that arises from the higher-order solver +0: Biconjugate gradient, incomplete LU preconditioner +1: GMRES, incomplete LU preconditioner +2: Conjugate gradient, incomplete LU preconditioner +3: Conjugate gradient, structured grid, parallel-enabled +4: standalone interface to Trilinos +Default: 3 + + + +Method for solving the nonlinear iteration when solving the first-order momentum balance +0: use the standard Picard iteration +1: use Jacobian Free Newton Krylov (JFNK) method +Default: 0 + + + +How to compute the gradient at the ice margin in the glissade dycore. +Not valid for other dycores. +0: Use info from all neighbor cells, ice-covered or ice-free +1: Use info from ice-covered and/or land cells, not ice-free ocean +2: Use info from ice-covered cells only +Default: (use hard-coded default) + + + +Flag that indicates which Stokes approximation to use with the glissade dycore. +Not valid for other dycores. +-1: Shallow-ice approximation, Glide-type calculation (uses glissade_velo_sia) +0: Shallow-ice approximation, vertical-shear stresses only (uses glissade_velo_higher) +1: Shallow-shelf approximation, horizontal-plane stresses only (uses glissade_velo_higher) +2: Blatter-Pattyn approximation with both vertical-shear and horizontal-plane stresses (uses glissade_velo_higher) +3: Vertically integrated 'L1L2' approximation with vertical-shear and horizontal-plane stresses (uses glissade_velo_higher) +Default: (use hard-coded default) + + + + + + + + + +1: 1D calculations +3: 3D calculations +Only relevant if gthf = 2 +Default: 1 + + + +Number of vertical layers +Only relevant if gthf = 2 +Default: 20 + + + +Initial surface temperature (degrees C) +Only relevant if gthf = 2 +Default: (use hard-coded default) + + + +Depth below sea-level at which geothermal heat gradient is applied (m) +Only relevant if gthf = 2 +Default: (use hard-coded default) + + + +Number of time steps for spinning up GTHF calculations +Only relevant if gthf = 2 +Default: 0 + + + +Density of lithosphere (kg m-3) +Only relevant if gthf = 2 +Default: (use hard-coded default) + + + +Specific heat capacity of lithosphere (J kg-1 K-1) +Only relevant if gthf = 2 +Default: (use hard-coded default) + + + +thermal conductivity of lithosphere (W m-1 K-1) +Only relevant if gthf = 2 +Default: (use hard-coded default) + + + + + + + + + + +0: local lithosphere, equilibrium bedrock depression is found using Archimedes' principle +1: elastic lithosphere, flexural rigidity is taken into account +Only relevant if isostasy = 1 +Default: 0 + + + +0: fluid mantle, isostatic adjustment happens instantaneously +1: relaxing mantle, mantle is approximated by a half-space +Only relevant if isostasy = 1 +Default: 0 + + + +Characteristic time constant of relaxing mantle (years) +Only relevant if isostasy = 1 +Default: (use hard-coded default) + + + +Lithosphere update period (years) +Only relevant if isostasy = 1 +Default: (use hard-coded default) + + + +Flexural rigidity of the lithosphere +Only relevant if 'lithosphere' is set to 1 +Default: (use hard-coded default) + + + + + diff --git a/components/cism/bld/trilinosOptions/README b/components/cism/bld/trilinosOptions/README new file mode 100644 index 0000000000..f18193b040 --- /dev/null +++ b/components/cism/bld/trilinosOptions/README @@ -0,0 +1,6 @@ +This directory contains resolution-dependent trilinosOptions xml +files; one of these is copied to the CESM run directory by +cism.buildnml, depending on the value of GLC_GRID. However, if +there is a trilinosOptions.xml file in SourceMods/src.cism, that file +is used instead. + diff --git a/components/cism/bld/trilinosOptions/trilinosOptions_gland10.xml b/components/cism/bld/trilinosOptions/trilinosOptions_gland10.xml new file mode 100755 index 0000000000..9a1d2f3751 --- /dev/null +++ b/components/cism/bld/trilinosOptions/trilinosOptions_gland10.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/bld/trilinosOptions/trilinosOptions_gland20.xml b/components/cism/bld/trilinosOptions/trilinosOptions_gland20.xml new file mode 100755 index 0000000000..9a1d2f3751 --- /dev/null +++ b/components/cism/bld/trilinosOptions/trilinosOptions_gland20.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/bld/trilinosOptions/trilinosOptions_gland4.xml b/components/cism/bld/trilinosOptions/trilinosOptions_gland4.xml new file mode 100755 index 0000000000..9a1d2f3751 --- /dev/null +++ b/components/cism/bld/trilinosOptions/trilinosOptions_gland4.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/bld/trilinosOptions/trilinosOptions_gland5.xml b/components/cism/bld/trilinosOptions/trilinosOptions_gland5.xml new file mode 100755 index 0000000000..9a1d2f3751 --- /dev/null +++ b/components/cism/bld/trilinosOptions/trilinosOptions_gland5.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/bld/trilinosOptions/trilinosOptions_gland5UM.xml b/components/cism/bld/trilinosOptions/trilinosOptions_gland5UM.xml new file mode 100755 index 0000000000..9a1d2f3751 --- /dev/null +++ b/components/cism/bld/trilinosOptions/trilinosOptions_gland5UM.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/bld/user_nl_cism b/components/cism/bld/user_nl_cism new file mode 100644 index 0000000000..99097f72e2 --- /dev/null +++ b/components/cism/bld/user_nl_cism @@ -0,0 +1,21 @@ +!----------------------------------------------------------------------- +! Users should ONLY USE user_nl_cism to change namelist variables for +! any of the namelists in cism_in and the namelist-like sections in +! cism.config. +! +! Users should add ALL user specific namelist changes below using the +! following syntax: +! +! namelist_var = new_namelist_value +! +! Note that there is no distinction between variables that will appear +! in cism_in and those that will appear in cism.config: simply add a new +! variable setting here, and it will be added to the appropriate place +! in cism_in or cism.config. +! +! For example to change the value of evolution to 0, add the following +! below: +! +! evolution = 0 +!----------------------------------------------------------------------- + diff --git a/components/cism/cimetest/testlist_cism.xml b/components/cism/cimetest/testlist_cism.xml new file mode 100644 index 0000000000..93b29775a0 --- /dev/null +++ b/components/cism/cimetest/testlist_cism.xml @@ -0,0 +1,134 @@ + + + + + + yellowstone + + + + + + + yellowstone + + + yellowstone + + + + + yellowstone + + + + + + + yellowstone + yellowstone + + + + + + + yellowstone + + + + + yellowstone + yellowstone + + + yellowstone + yellowstone + + + + + + + yellowstone + + + yellowstone + yellowstone + + + yellowstone + + + + + + + yellowstone + + + yellowstone + + + + + + + yellowstone + + + yellowstone + + + + + + + edison + yellowstone + + + yellowstone + + + + + + + yellowstone + + + titan + yellowstone + yellowstone + yellowstone + + + + + hopper + yellowstone + yellowstone + + + + + + + hobart + yellowstone + + + + + + + yellowstone + + + hobart + yellowstone + + + + diff --git a/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/README b/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/README new file mode 100644 index 0000000000..c012faea8b --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/README @@ -0,0 +1,3 @@ +This testmods directory should not be used directly. Instead, it can be included +by any testmods that wants to apply its user_nl changes to multi-instance as +well as single-intance tests. diff --git a/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/shell_commands b/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/shell_commands new file mode 100644 index 0000000000..ad5adf8ae3 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/apply_to_multiinstance/shell_commands @@ -0,0 +1,11 @@ +# Apply these testmods to multi-instance tests, too (assuming there are only two instances) +# +# Doing this copy rather than explicitly including user_nl_cism_0001, etc. is +# preferable both to avoid duplication and also so that the FINAL version of +# user_nl_cism is copied in the case that there is another testmods directory +# that includes this one. +# +# Ideally, these copies would be done automatically when applying testmods in +# create_newcase. +cp user_nl_cism user_nl_cism_0001 +cp user_nl_cism user_nl_cism_0002 diff --git a/components/cism/cimetest/testmods_dirs/cism/oneway/README b/components/cism/cimetest/testmods_dirs/cism/oneway/README new file mode 100644 index 0000000000..4a6807ea65 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/oneway/README @@ -0,0 +1 @@ +This set of testmods turns off two-way coupling diff --git a/components/cism/cimetest/testmods_dirs/cism/oneway/xmlchange_cmnds b/components/cism/cimetest/testmods_dirs/cism/oneway/xmlchange_cmnds new file mode 100644 index 0000000000..404b22b006 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/oneway/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange GLC_TWO_WAY_COUPLING=FALSE diff --git a/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/include_user_mods b/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/include_user_mods new file mode 100644 index 0000000000..1c29cfcb00 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/include_user_mods @@ -0,0 +1 @@ +../apply_to_multiinstance diff --git a/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/user_nl_cism b/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/user_nl_cism new file mode 100644 index 0000000000..c08fd0bbc0 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/override_glc_frac/user_nl_cism @@ -0,0 +1,7 @@ +! Turn on all overrides of the glc fraction + +enable_frac_overrides = .true. +override_delay = 1 +decrease_frac = 0.05 +increase_frac = 0.05 +rearrange_freq = 3 diff --git a/components/cism/cimetest/testmods_dirs/cism/test_coupling/include_user_mods b/components/cism/cimetest/testmods_dirs/cism/test_coupling/include_user_mods new file mode 100644 index 0000000000..1c29cfcb00 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/test_coupling/include_user_mods @@ -0,0 +1 @@ +../apply_to_multiinstance diff --git a/components/cism/cimetest/testmods_dirs/cism/test_coupling/user_nl_cism b/components/cism/cimetest/testmods_dirs/cism/test_coupling/user_nl_cism new file mode 100644 index 0000000000..1e65ec4b98 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/test_coupling/user_nl_cism @@ -0,0 +1,7 @@ +! This option changes the ice sheet dynamics time step to 1 day rather than 1 year +! Thus, the ice sheet dynamics can be exercised in a few-day run +test_coupling = .true. + +! This is needed to give CISM history output in the (typically short) +! tests that are done with this testmod directory +history_option = 'coupler' diff --git a/components/cism/cimetest/testmods_dirs/cism/trilinos/README b/components/cism/cimetest/testmods_dirs/cism/trilinos/README new file mode 100644 index 0000000000..e8fe16fd42 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/trilinos/README @@ -0,0 +1,5 @@ +This testmods directory tests the use of the trilinos solver. + +Note: We also want to allow the case where cism is built using +CISM_USE_TRILINOS=TRUE, but trilinos isn't actually chosen at runtime. However, +for now I don't feel it's worth actually having a test of that combination. diff --git a/components/cism/cimetest/testmods_dirs/cism/trilinos/include_user_mods b/components/cism/cimetest/testmods_dirs/cism/trilinos/include_user_mods new file mode 100644 index 0000000000..1c29cfcb00 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/trilinos/include_user_mods @@ -0,0 +1 @@ +../apply_to_multiinstance diff --git a/components/cism/cimetest/testmods_dirs/cism/trilinos/shell_commands b/components/cism/cimetest/testmods_dirs/cism/trilinos/shell_commands new file mode 100755 index 0000000000..de22fb6073 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/trilinos/shell_commands @@ -0,0 +1 @@ +./xmlchange CISM_USE_TRILINOS=TRUE diff --git a/components/cism/cimetest/testmods_dirs/cism/trilinos/user_nl_cism b/components/cism/cimetest/testmods_dirs/cism/trilinos/user_nl_cism new file mode 100644 index 0000000000..7b6d595280 --- /dev/null +++ b/components/cism/cimetest/testmods_dirs/cism/trilinos/user_nl_cism @@ -0,0 +1,2 @@ +which_ho_sparse = 4 + diff --git a/components/cism/drivers/cpl/glc_comp_esmf.F90 b/components/cism/drivers/cpl/glc_comp_esmf.F90 new file mode 100644 index 0000000000..0e5523e13b --- /dev/null +++ b/components/cism/drivers/cpl/glc_comp_esmf.F90 @@ -0,0 +1,668 @@ +module glc_comp_esmf + +#ifdef ESMF_INTERFACE +! !USES: + + use shr_sys_mod + use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8 + use shr_kind_mod, only: CS=>SHR_KIND_CS, CL=>SHR_KIND_CL + use shr_file_mod, only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel + use shr_file_mod, only: shr_file_setlogunit, shr_file_setloglevel, shr_file_setio + use shr_file_mod, only: shr_file_freeunit + + use esmf + use esmfshr_mod + + use seq_infodata_mod, only: seq_infodata_start_type_start, seq_infodata_start_type_cont + use seq_infodata_mod, only: seq_infodata_start_type_brnch + use seq_timemgr_mod + + use glc_import_export + use glc_cpl_indices + use glc_constants, only: verbose, stdout, stderr, nml_in, radius + use glc_errormod, only: glc_success + use glc_InitMod, only: glc_initialize + use glc_RunMod, only: glc_run + use glc_FinalMod, only: glc_final + use glc_io, only: glc_io_write_restart + use glc_communicate, only: init_communicate, my_task, master_task + use glc_time_management, only: iyear,imonth,iday,ihour,iminute,isecond,runtype + use glc_fields, only: ice_sheet + + implicit none + SAVE + private ! By default make data private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: glc_register_esmf + public :: glc_init_esmf + public :: glc_run_esmf + public :: glc_final_esmf + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + private :: glc_distgrid_esmf + private :: glc_domain_esmf + + !-------------------------------------------------------------------------- + ! Private module data interfaces + !-------------------------------------------------------------------------- + + !--- stdin input stuff --- + character(CS) :: str ! cpp defined model name + + !--- other --- + integer(IN) :: errorcode ! glc error code + + ! my_task_local and master_task_local are needed for some checks that are done before + ! init_communicate is called (although, it's possible that init_communicate could be + ! moved to earlier to prevent the need for these copies) + integer(IN) :: my_task_local ! my task in mpi communicator mpicom + integer(IN) :: master_task_local=0 ! task number of master task + + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +CONTAINS +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +!==================================================================================== + + subroutine glc_register_esmf(comp, rc) + implicit none + type(ESMF_GridComp) :: comp + integer, intent(out) :: rc + + rc = ESMF_SUCCESS + print *, "In glc register routine" + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + glc_init_esmf, phase=1, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + glc_run_esmf, phase=1, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + glc_final_esmf, phase=1, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine glc_register_esmf + +!==================================================================================== + + subroutine glc_init_esmf(comp, import_state, export_state, EClock, rc) + + use glc_ensemble , only : set_inst_vars, write_inst_vars, get_inst_name + use glc_files , only : set_filenames, ionml_filename + use glc_coupling_flags , only : has_ocn_coupling, has_ice_coupling + use glc_indexing_info , only : nx_tot, ny_tot, npts_tot + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Initialize glc model + ! + ! !INPUT/OUTPUT PARAMETERS: + implicit none + type(ESMF_GridComp) :: comp + type(ESMF_State) :: import_state + type(ESMF_State) :: export_state + type(ESMF_Clock) :: EClock + integer, intent(out) :: rc + ! + ! !LOCAL VARIABLES: + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: dom, g2x, x2g + type(ESMF_VM) :: vm + integer(IN) :: ierr + integer(IN) :: i,j,n + integer(IN) :: shrlogunit, shrloglev + character(CL) :: starttype + real(R8), pointer :: fptr(:,:) + integer :: mpicom_loc, mpicom_vm + character(ESMF_MAXSTR) :: convCIM, purpComp + integer(IN) :: COMPID + character(CS) :: myModelName + + !--- formats --- + character(*), parameter :: F00 = "('(glc_init_esmf) ',8a)" + character(*), parameter :: F01 = "('(glc_init_esmf) ',a,8i8)" + character(*), parameter :: F02 = "('(glc_init_esmf) ',a,4es13.6)" + character(*), parameter :: F03 = "('(glc_init_esmf) ',a,i8,a)" + character(*), parameter :: F90 = "('(glc_init_esmf) ',73('='))" + character(*), parameter :: F91 = "('(glc_init_esmf) ',73('-'))" + character(*), parameter :: subName = "(glc_init_esmf) " + !----------------------------------------------------------------------- + + ! Determine attribute vector indices + + call glc_cpl_indices_set() + + rc = ESMF_SUCCESS + + ! duplicate the mpi communicator from the current VM + call ESMF_VMGetCurrent(vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call MPI_Comm_dup(mpicom_vm, mpicom_loc, rc) + if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Get id of this task + call MPI_Comm_rank(mpicom_loc, my_task_local, ierr) + + ! Initialize glc id + + call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !--------------------------------------------------------------------------- + ! set variables that depend on ensemble index + !--------------------------------------------------------------------------- + + call set_inst_vars(COMPID) + call get_inst_name(myModelName) + call set_filenames() + + !--------------------------------------------------------------------------- + ! determine type of run + !--------------------------------------------------------------------------- + + call ESMF_AttributeGet(export_state, name="start_type", value=starttype, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + runtype = "initial" + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + runtype = "continue" + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + runtype = "branch" + else + write(*,*) 'glc_comp_esmf ERROR: unknown starttype' + call shr_sys_abort() + end if + + !---------------------------------------------------------------------------- + ! Initialize glc + !---------------------------------------------------------------------------- + + if (my_task_local == master_task_local) then + stdout = shr_file_getUnit() + call shr_file_setIO(ionml_filename,stdout) + else + stdout = 6 + endif + stderr = stdout + nml_in = shr_file_getUnit() + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + errorCode = glc_Success + if (verbose .and. my_task_local == master_task_local) then + write(stdout,F00) ' Starting' + write(stdout,*) subname, 'COMPID: ', COMPID + call write_inst_vars + call shr_sys_flush(stdout) + endif + call init_communicate(mpicom_loc) + + call glc_initialize(errorCode) + + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' GLC Initial Date ',iyear,imonth,iday,ihour,iminute,isecond + write(stdout,F01) ' Initialize Done', errorCode + call shr_sys_flush(stdout) + endif + + !--------------------------------------------------------------------------- + ! Initialize distgrids, domains, and arrays + !--------------------------------------------------------------------------- + + ! Initialize glc distgrid + + distgrid = glc_distgrid_esmf(rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="gsize", value=npts_tot, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Initialize glc domain (needs glc initialization info) + + dom = mct2esmf_init(distgrid, attname=seq_flds_dom_fields, name="domain", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call glc_domain_esmf(dom, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Inialize input/output arrays + + g2x = mct2esmf_init(distgrid, attname=seq_flds_g2x_fields, name="d2x", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + x2g = mct2esmf_init(distgrid, attname=seq_flds_x2g_fields, name="x2d", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(export_state, (/dom/), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(export_state, (/g2x/), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(import_state, (/x2g/), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !--------------------------------------------------------------------------- + ! send initial state to driver + !--------------------------------------------------------------------------- + + call ESMF_ArrayGet(g2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call glc_export(fptr) + + call ESMF_AttributeSet(export_state, name="glc_present", value=.true., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glclnd_present", value=.true., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glcocn_present", & + value=has_ocn_coupling(), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glcice_present", & + value=has_ice_coupling(), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.true., rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glc_nx", value=nx_tot, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="glc_ny", value=ny_tot, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + +#ifdef USE_ESMF_METADATA + convCIM = "CIM" + purpComp = "Model Component Simulation Description" + + call ESMF_AttributeAdd(comp, & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "ShortName", "GLC", & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "LongName", & + "TBD", & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "Description", & + "TBD", & + + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "ModelType", "GlC", & + convention=convCIM, purpose=purpComp, rc=rc) + + ! call ESMF_AttributeSet(comp, "Name", "someone", & + ! convention=convCIM, purpose=purpComp, rc=rc) + ! call ESMF_AttributeSet(comp, "EmailAddress", & + ! "someone@someplace", & + ! convention=convCIM, purpose=purpComp, rc=rc) + ! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & + ! convention=convCIM, purpose=purpComp, rc=rc) +#endif + + if (my_task == master_task) then + write(stdout,F91) + write(stdout,F00) trim(myModelName),': start of main integration loop' + write(stdout,F91) + end if + + !---------------------------------------------------------------------------- + ! Reset shr logging to original values + !---------------------------------------------------------------------------- + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + + end subroutine glc_init_esmf + +!==================================================================================== + + subroutine glc_run_esmf(comp, import_state, export_state, EClock, rc) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Run GLC + ! + ! !ARGUMENTS: + implicit none + type(ESMF_GridComp) :: comp + type(ESMF_State) :: import_state + type(ESMF_State) :: export_state + type(ESMF_Clock) :: EClock + integer, intent(out) :: rc + ! + ! !LOCAL VARIABLES: + integer(IN) :: cesmYMD ! cesm model date + integer(IN) :: cesmTOD ! cesm model sec + integer(IN) :: glcYMD ! glc model date + integer(IN) :: glcTOD ! glc model sec + logical :: stop_alarm ! is it time to stop + logical :: rest_alarm ! is it time to write a restart + logical :: done ! time loop logical + integer(IN) :: shrlogunit, shrloglev + real(R8), pointer :: fptr(:,:) + type(ESMF_Array) :: x2g, g2x + character(*), parameter :: F00 = "('(glc_run_esmf) ',8a)" + character(*), parameter :: F01 = "('(glc_run_esmf) ',a,8i8)" + character(*), parameter :: F04 = "('(glc_run_esmf) ',2a,2i8,'s')" + character(*), parameter :: subName = "(glc_run_esmf) " + !--------------------------------------------------------------------------- + + ! Reset shr logging to my log file + + rc = ESMF_SUCCESS + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + ! Set internal time info + + errorCode = glc_Success + call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) + stop_alarm = seq_timemgr_StopAlarmIsOn( EClock ) + + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + done = .false. + if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Run Starting ',glcYMD,glcTOD + call shr_sys_flush(stdout) + endif + + ! Unpack import state + + call ESMF_StateGet(import_state, itemName="x2d", array=x2g, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(x2g, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call glc_import(fptr) + + ! Run + + do while (.not. done) + if (glcYMD > cesmYMD .or. (glcYMD == cesmYMD .and. glcTOD > cesmTOD)) then + write(stdout,*) subname,' ERROR overshot coupling time ',glcYMD,glcTOD,cesmYMD,cesmTOD + call shr_sys_abort('glc error overshot time') + endif + + call glc_run(EClock) + + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' GLC Date ',glcYMD,glcTOD + endif + enddo + + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Run Done',glcYMD,glcTOD + call shr_sys_flush(stdout) + endif + + ! Pack export state + + call ESMF_StateGet(export_state, itemName="d2x", array=g2x, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(g2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call glc_export(fptr) + + ! Log output for model date + + if (my_task == master_task) then + call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) + write(stdout,F01) ' CESM Date ', cesmYMD,cesmTOD + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + write(stdout,F01) ' GLC Date ',glcYMD,glcTOD + call shr_sys_flush(stdout) + end if + + ! If time to write restart, do so + + rest_alarm = seq_timemgr_RestartAlarmIsOn( EClock ) + if (rest_alarm) then + ! TODO loop over instances + call glc_io_write_restart(ice_sheet%instances(1), EClock) + endif + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + call shr_sys_flush(stdout) + + end subroutine glc_run_esmf + +!==================================================================================== + + subroutine glc_final_esmf(comp, import_state, export_state, EClock, rc) + + use glc_ensemble, only : get_inst_name + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Finalize GLC + ! + ! !ARGUMENTS: + ! + implicit none + type(ESMF_GridComp) :: comp + type(ESMF_State) :: import_state + type(ESMF_State) :: export_state + type(ESMF_Clock) :: EClock + integer, intent(out) :: rc + + integer(IN) :: shrlogunit, shrloglev + character(CS) :: myModelName + + !--- formats --- + character(*), parameter :: F00 = "('(glc_final_mct) ',8a)" + character(*), parameter :: F01 = "('(glc_final_mct) ',a,8i8)" + character(*), parameter :: F91 = "('(glc_final_mct) ',73('-'))" + character(*), parameter :: subName = "(glc_final_mct) " + !--------------------------------------------------------------------------- + + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + call get_inst_name(myModelName) + + if (my_task == master_task) then + write(stdout,F91) + write(stdout,F00) trim(myModelName),': end of main integration loop' + write(stdout,F91) + end if + + errorCode = glc_Success + + call glc_final(errorCode) + + ! Note that restart for final timestep was written in run phase. + rc = ESMF_SUCCESS + + ! Destroy ESMF objects + + call esmfshr_util_StateArrayDestroy(export_state,"d2x",rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(export_state,"domain",rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(import_state,"x2d",rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Done',errorCode + call shr_sys_flush(stdout) + endif + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + call shr_sys_flush(stdout) + + end subroutine glc_final_esmf + +!================================================================================= + + function glc_distgrid_esmf(rc) + + ! Initialize global index space array + + use glc_broadcast, only: broadcast_scalar + use glc_indexing_info, only : local_indices, global_indices, nx, ny, npts + + !------------------------------------------------------------------- + ! Arguments + implicit none + integer, intent(out):: rc + + ! Return: + type(ESMF_DistGrid) :: glc_DistGrid_esmf ! Resulting distributed grid + + ! Local Variables + integer,allocatable :: gindex(:) + integer :: i, j, n + integer :: ier + + !--- formats --- + character(*), parameter :: F02 = "('(glc_DistGrid_esmf) ',a,4es13.6)" + character(*), parameter :: subName = "(glc_DistGrid_esmf) " + !------------------------------------------------------------------- + + allocate(gindex(npts)) + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + gindex(n) = global_indices(i,j) + enddo + enddo + + glc_DistGrid_esmf = mct2esmf_init(gindex, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + deallocate(gindex) + + end function glc_DistGrid_esmf + +!======================================================================= + + subroutine glc_domain_esmf( dom, rc ) + + !------------------------------------------------------------------- + use glc_indexing_info, only : nx, ny, local_indices + use glad_main, only : glad_get_lat_lon, glad_get_areas + + implicit none + type(ESMF_Array), intent(inout) :: dom + integer, intent(out) :: rc + + ! Local Variables + integer :: j,i,n + integer :: klon,klat,karea,kmask,kfrac ! domain fields + real(R8), pointer :: fptr(:,:) + real(r8), allocatable :: lats(:,:) ! latitude of each point (degrees) + real(r8), allocatable :: lons(:,:) ! longitude of each point (degrees) + real(r8), allocatable :: areas(:,:) ! area of each point (square meters) + !------------------------------------------------------------------- + + ! Initialize domain type + ! lat/lon in degrees, area in radians^2 + ! + rc = ESMF_SUCCESS + + call ESMF_ArrayGet(dom, localDe=0, farrayPtr=fptr, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + klon = esmfshr_util_ArrayGetIndex(dom,'lon ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + klat = esmfshr_util_ArrayGetIndex(dom,'lat ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + karea = esmfshr_util_ArrayGetIndex(dom,'area',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kmask = esmfshr_util_ArrayGetIndex(dom,'mask',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kfrac = esmfshr_util_ArrayGetIndex(dom,'frac',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + + allocate(lats(nx, ny)) + allocate(lons(nx, ny)) + allocate(areas(nx, ny)) + + ! TODO(wjs, 2015-04-02) The following may need a loop over instances + call glad_get_lat_lon(ice_sheet, instance_index = 1, & + lats = lats, lons = lons) + call glad_get_areas(ice_sheet, instance_index = 1, areas = areas) + + fptr(:,:) = -9999.0_R8 + fptr(kmask,:) = -0.0_R8 + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + fptr(klon , n) = lons(i,j) + fptr(klat , n) = lats(i,j) + + ! convert from m^2 to radians^2 + fptr(karea, n) = areas(i,j)/(radius*radius) + + ! For now, assume mask and frac are 1 everywhere. This may need to be changed + ! in the future. + fptr(kmask, n) = 1._r8 + fptr(kfrac, n) = 1._r8 + end do + end do + + deallocate(lats) + deallocate(lons) + deallocate(areas) + + end subroutine glc_domain_esmf + +#endif + +end module glc_comp_esmf + diff --git a/components/cism/drivers/cpl/glc_comp_mct.F90 b/components/cism/drivers/cpl/glc_comp_mct.F90 new file mode 100644 index 0000000000..2da1a3af15 --- /dev/null +++ b/components/cism/drivers/cpl/glc_comp_mct.F90 @@ -0,0 +1,556 @@ +module glc_comp_mct + + ! !uses: + + use shr_sys_mod + use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, & + CS=>SHR_KIND_CS, CL=>SHR_KIND_CL + use shr_file_mod, only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & + shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & + shr_file_freeunit + use mct_mod + use esmf + + use seq_cdata_mod , only: seq_cdata_getdata=>seq_cdata_setptrs, seq_cdata + use seq_infodata_mod + use seq_timemgr_mod + + use glc_import_export + use glc_cpl_indices + use glc_constants, only: verbose, stdout, stderr, nml_in, radius + use glc_errormod, only: glc_success + use glc_InitMod, only: glc_initialize + use glc_RunMod, only: glc_run + use glc_FinalMod, only: glc_final + use glc_io, only: glc_io_write_restart + use glc_communicate, only: init_communicate, my_task, master_task + use glc_time_management, only: iyear,imonth,iday,ihour,iminute,isecond,runtype + use glc_fields, only: ice_sheet + + ! Public types: + implicit none + save + private ! except + + ! Public interfaces + public :: glc_init_mct + public :: glc_run_mct + public :: glc_final_mct + + ! Private data interfaces + + !--- stdin input stuff --- + character(CS) :: str ! cpp defined model name + + !--- other --- + integer(IN) :: errorcode ! glc error code + + ! my_task_local and master_task_local are needed for some checks that are done before + ! init_communicate is called (although, it's possible that init_communicate could be + ! moved to earlier to prevent the need for these copies) + integer(IN) :: my_task_local ! my task in mpi communicator mpicom + integer(IN),parameter :: master_task_local=0 ! task number of master task + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine glc_init_mct( EClock, cdata, x2g, g2x, NLFilename ) + + ! description: + ! initialize glc model + + ! uses: + + use glc_ensemble , only : set_inst_vars, write_inst_vars, get_inst_name + use glc_files , only : set_filenames, ionml_filename + use glc_coupling_flags , only : has_ocn_coupling, has_ice_coupling + use glc_indexing_info , only : nx_tot, ny_tot, npts + + ! input/output parameters: + + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata + type(mct_aVect) , intent(inout) :: x2g, g2x + character(len=*), optional , intent(in) :: NLFilename ! Namelist filename + + !--- local variables --- + integer(IN) :: ierr ! error code + integer(IN) :: i,j,n + integer(IN) :: COMPID + integer(IN) :: mpicom + type(mct_gsMap), pointer :: gsMap + type(mct_gGrid), pointer :: dom + type(seq_infodata_type), pointer :: infodata ! Input init object + integer(IN) :: shrlogunit, shrloglev + character(CL) :: starttype + character(CS) :: myModelName + + !--- formats --- + character(*), parameter :: F00 = "('(glc_init_mct) ',8a)" + character(*), parameter :: F01 = "('(glc_init_mct) ',a,8i8)" + character(*), parameter :: F02 = "('(glc_init_mct) ',a,4es13.6)" + character(*), parameter :: F91 = "('(glc_init_mct) ',73('-'))" + character(*), parameter :: subName = "(glc_init_mct) " + !------------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Determine attribute vector indices + !---------------------------------------------------------------------------- + + call glc_cpl_indices_set() + + !---------------------------------------------------------------------------- + ! Set cdata pointers + !---------------------------------------------------------------------------- + + call seq_cdata_getdata(cdata, & + id=compid, mpicom=mpicom, gsMap=gsMap, dom=dom, infodata=infodata) + + call mpi_comm_rank(mpicom, my_task_local, ierr) + + !--------------------------------------------------------------------------- + ! set variables that depend on ensemble index + !--------------------------------------------------------------------------- + + call set_inst_vars(COMPID) + call get_inst_name(myModelName) + call set_filenames() + + !--------------------------------------------------------------------------- + ! use infodata to determine type of run + !--------------------------------------------------------------------------- + + call seq_infodata_GetData( infodata, & + start_type=starttype) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + runtype = "initial" + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + runtype = "continue" + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + runtype = "branch" + else + write(*,*) 'glc_comp_mct ERROR: unknown starttype' + call shr_sys_abort() + end if + + !---------------------------------------------------------------------------- + ! Reset shr logging to my log file + !---------------------------------------------------------------------------- + !--- open log file --- + if (my_task_local == master_task_local) then + stdout = shr_file_getUnit() + call shr_file_setIO(ionml_filename,stdout) + else + stdout = 6 + endif + stderr = stdout + nml_in = shr_file_getUnit() + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + errorCode = glc_Success + if (verbose .and. my_task_local == master_task_local) then + write(stdout,F00) ' Starting' + write(stdout,*) subname, 'COMPID: ', COMPID + call write_inst_vars + call shr_sys_flush(stdout) + endif + call init_communicate(mpicom) + call glc_initialize(errorCode) + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' GLC Initial Date ',iyear,imonth,iday,ihour,iminute,isecond + write(stdout,F01) ' Initialize Done', errorCode + call shr_sys_flush(stdout) + endif + + ! Initialize MCT gsmap + + call glc_SetgsMap_mct(mpicom, COMPID, gsMap) + + ! Initialize MCT domain + + call glc_domain_mct(gsMap,dom) + + ! Set flags in infodata + + call seq_infodata_PutData(infodata, glc_present=.true., & + glclnd_present = .true., & + glcocn_present=has_ocn_coupling(), & + glcice_present=has_ice_coupling(), & + glc_prognostic = .true., glc_nx=nx_tot, glc_ny=ny_tot) + + ! Initialize MCT attribute vectors + + call mct_aVect_init(g2x, rList=seq_flds_g2x_fields, lsize=npts) + call mct_aVect_zero(g2x) + + call mct_aVect_init(x2g, rList=seq_flds_x2g_fields, lsize=npts) + call mct_aVect_zero(x2g) + + ! Create initial glc export state + + call glc_export(g2x%rattr) + + if (my_task == master_task) then + write(stdout,F91) + write(stdout,F00) trim(myModelName),': start of main integration loop' + write(stdout,F91) + end if + + !---------------------------------------------------------------------------- + ! Reset shr logging to original values + !---------------------------------------------------------------------------- + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + call shr_sys_flush(stdout) + +end subroutine glc_init_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: glc_run_mct +! +! !DESCRIPTION: +! run method for glc model +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine glc_run_mct( EClock, cdata, x2g, g2x) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2g ! driver -> glc + type(mct_aVect) ,intent(inout) :: g2x ! glc -> driver + +!EOP + !--- local --- + integer(IN) :: cesmYMD ! cesm model date + integer(IN) :: cesmTOD ! cesm model sec + integer(IN) :: glcYMD ! glc model date + integer(IN) :: glcTOD ! glc model sec + integer(IN) :: n ! index + integer(IN) :: nf ! fields loop index + integer(IN) :: ki ! index of ifrac + real(R8) :: lat ! latitude + real(R8) :: lon ! longitude + integer(IN) :: shrlogunit, shrloglev + logical :: stop_alarm ! is it time to stop + logical :: rest_alarm ! is it time to write a restart + logical :: done ! time loop logical + integer :: num + character(len= 2) :: cnum + character(len=64) :: name + + character(*), parameter :: F00 = "('(glc_run_mct) ',8a)" + character(*), parameter :: F01 = "('(glc_run_mct) ',a,8i8)" + character(*), parameter :: F04 = "('(glc_run_mct) ',2a,2i8,'s')" + character(*), parameter :: subName = "(glc_run_mct) " +!------------------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! Reset shr logging to my log file + !---------------------------------------------------------------------------- + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + ! Set internal time info + + errorCode = glc_Success + call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) + stop_alarm = seq_timemgr_StopAlarmIsOn( EClock ) + + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + done = .false. + if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Run Starting ',glcYMD,glcTOD + call shr_sys_flush(stdout) + endif + + ! Unpack + + call glc_import(x2g%rattr) + + ! Run + + do while (.not. done) + if (glcYMD > cesmYMD .or. (glcYMD == cesmYMD .and. glcTOD > cesmTOD)) then + write(stdout,*) subname,' ERROR overshot coupling time ',glcYMD,glcTOD,cesmYMD,cesmTOD + call shr_sys_abort('glc error overshot time') + endif + + call glc_run(EClock) + + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + if (glcYMD == cesmYMD .and. glcTOD == cesmTOD) done = .true. + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' GLC Date ',glcYMD,glcTOD + endif + enddo + + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Run Done',glcYMD,glcTOD + call shr_sys_flush(stdout) + endif + + ! Pack + + call glc_export(g2x%rattr) + + ! Log output for model date + + if (my_task == master_task) then + call seq_timemgr_EClockGetData(EClock,curr_ymd=cesmYMD, curr_tod=cesmTOD) + write(stdout,F01) ' CESM Date ', cesmYMD,cesmTOD + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + write(stdout,F01) ' GLC Date ',glcYMD,glcTOD + call shr_sys_flush(stdout) + end if + + ! If time to write restart, do so + + rest_alarm = seq_timemgr_RestartAlarmIsOn( EClock ) + if (rest_alarm) then + ! TODO loop over instances + call glc_io_write_restart(ice_sheet%instances(1), EClock) + endif + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + call shr_sys_flush(stdout) + +end subroutine glc_run_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: glc_final_mct +! +! !DESCRIPTION: +! finalize method for glc model +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ +! +subroutine glc_final_mct( EClock, cdata, x2d, d2x) + +! !USES: + + use glc_ensemble, only : get_inst_name + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2d + type(mct_aVect) ,intent(inout) :: d2x + +!EOP + + integer(IN) :: shrlogunit, shrloglev + character(CS) :: myModelName + + + !--- formats --- + character(*), parameter :: F00 = "('(glc_final_mct) ',8a)" + character(*), parameter :: F01 = "('(glc_final_mct) ',a,8i8)" + character(*), parameter :: F91 = "('(glc_final_mct) ',73('-'))" + character(*), parameter :: subName = "(glc_final_mct) " + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (stdout) + + call get_inst_name(myModelName) + + if (my_task == master_task) then + write(stdout,F91) + write(stdout,F00) trim(myModelName),': end of main integration loop' + write(stdout,F91) + end if + + errorCode = glc_Success + + call glc_final(errorCode) + + if (verbose .and. my_task == master_task) then + write(stdout,F01) ' Done',errorCode + call shr_sys_flush(stdout) + endif + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + call shr_sys_flush(stdout) + +end subroutine glc_final_mct + +!================================================================================= + +subroutine glc_setgsmap_mct( mpicom_g, GLCID, gsMap_g ) + + ! Initialize MCT global seg map + + use glc_indexing_info, only : local_indices, global_indices, nx, ny, npts + + integer , intent(in) :: mpicom_g + integer , intent(in) :: GLCID + type(mct_gsMap), intent(out) :: gsMap_g + + ! Local Variables + + integer,allocatable :: gindex(:) + integer :: i, j, n + integer :: ier + + !--- formats --- + character(*), parameter :: F02 = "('(glc_SetgsMap_mct) ',a,4es13.6)" + character(*), parameter :: subName = "(glc_SetgsMap_mct) " + !------------------------------------------------------------------- + + allocate(gindex(npts)) + + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + gindex(n) = global_indices(i,j) + enddo + enddo + + call mct_gsMap_init( gsMap_g, gindex, mpicom_g, GLCID ) + + deallocate(gindex) + +end subroutine glc_SetgsMap_mct + +!=============================================================================== + + subroutine glc_domain_mct( gsMap_g, dom_g ) + + use glc_indexing_info, only : npts, nx, ny, local_indices + use glad_main, only : glad_get_lat_lon, glad_get_areas + + !------------------------------------------------------------------- + type(mct_gsMap), intent(inout) :: gsMap_g + type(mct_ggrid), intent(out) :: dom_g + + ! Local Variables + + integer :: i,j,n ! index + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + real(r8), allocatable :: lats(:,:) ! latitude of each point (degrees) + real(r8), allocatable :: lons(:,:) ! longitude of each point (degrees) + real(r8), allocatable :: areas(:,:) ! area of each point (square meters) + character(*), parameter :: subName = "(glc_domain_mct) " + !------------------------------------------------------------------- + + ! Initialize mct domain type + + call mct_gGrid_init( GGrid=dom_g, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=npts ) + + ! Initialize attribute vector with special value + + allocate(data(npts)) + dom_g%data%rAttr(:,:) = -9999.0_R8 + dom_g%data%iAttr(:,:) = -9999 + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_g,"mask" ,data,npts) + call mct_gGrid_importRAttr(dom_g,"frac" ,data,npts) + + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + + call mct_gsMap_orderedPoints(gsMap_g, my_task, idata) + call mct_gGrid_importIAttr(dom_g,'GlobGridNum',idata,npts) + + ! Fill in correct values for domain components + ! lat/lon in degrees, area in radians^2, real-valued mask and frac + + allocate(lats(nx, ny)) + allocate(lons(nx, ny)) + allocate(areas(nx, ny)) + + ! TODO(wjs, 2015-04-02) The following may need a loop over instances + call glad_get_lat_lon(ice_sheet, instance_index = 1, & + lats = lats, lons = lons) + call glad_get_areas(ice_sheet, instance_index = 1, areas = areas) + + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + data(n) = lons(i,j) + end do + end do + call mct_gGrid_importRattr(dom_g,"lon",data,npts) + + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + data(n) = lats(i,j) + end do + end do + call mct_gGrid_importRattr(dom_g,"lat",data,npts) + + do j = 1,ny + do i = 1,nx + n = local_indices(i,j) + ! convert from m^2 to radians^2 + data(n) = areas(i,j)/(radius*radius) + end do + end do + call mct_gGrid_importRattr(dom_g,"area",data,npts) + + ! For now, assume mask and frac are 1 everywhere. This may need to be changed in the + ! future. + data(:) = 1._r8 + call mct_gGrid_importRattr(dom_g,"mask",data,npts) + call mct_gGrid_importRattr(dom_g,"frac",data,npts) + + deallocate(data) + deallocate(idata) + deallocate(lats) + deallocate(lons) + deallocate(areas) + + if (verbose .and. my_task==master_task) then + i = mct_aVect_nIattr(dom_g%data) + do n = 1,i + write(stdout,*) subname,' dom_g ',n,minval(dom_g%data%iAttr(n,:)),maxval(dom_g%data%iAttr(n,:)) + enddo + i = mct_aVect_nRattr(dom_g%data) + do n = 1,i + write(stdout,*) subname,' dom_g ',n,minval(dom_g%data%rAttr(n,:)),maxval(dom_g%data%rAttr(n,:)) + enddo + call shr_sys_flush(stdout) + endif + + end subroutine glc_domain_mct + +!=============================================================================== + +end module glc_comp_mct diff --git a/components/cism/drivers/cpl/glc_coupling_flags.F90 b/components/cism/drivers/cpl/glc_coupling_flags.F90 new file mode 100644 index 0000000000..d95675eaa3 --- /dev/null +++ b/components/cism/drivers/cpl/glc_coupling_flags.F90 @@ -0,0 +1,94 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! +! !MODULE: glc_coupling_flags - determine coupling flags +! +module glc_coupling_flags + +! !DESCRIPTION: +! +! This module determines various coupling flags +! +! !REVISION HISTORY: +! Author: Bill Sacks + +! !USES: + + use glc_kinds_mod + use glc_constants, only: stdout + use glc_exit_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: has_ocn_coupling + public :: has_ice_coupling + +!EOP + +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: has_ocn_coupling +! !INTERFACE: + + logical function has_ocn_coupling() + +! !DESCRIPTION: +! Returns true if glc has coupling to ocn + +! !USES: + + use glc_route_ice_runoff, only: ice_needs_ocean_coupling + +!EOP +!----------------------------------------------------------------------- + +! Local variables + + logical :: liq_to_ocean + logical :: ice_to_ocean + +!----------------------------------------------------------------------- + + ! For now, liquid runoff is always sent to the ocean + liq_to_ocean = .true. + + ice_to_ocean = ice_needs_ocean_coupling() + + has_ocn_coupling = (liq_to_ocean .or. ice_to_ocean) + + end function has_ocn_coupling + +!*********************************************************************** + +!*********************************************************************** +!BOP +! !IROUTINE: has_ice_coupling +! !INTERFACE: + + logical function has_ice_coupling() + +! !DESCRIPTION: +! Returns true if glc has coupling to ice + +! !USES: + + use glc_route_ice_runoff, only: ice_needs_sea_ice_coupling + +!EOP +!----------------------------------------------------------------------- + + has_ice_coupling = ice_needs_sea_ice_coupling() + + end function has_ice_coupling + +!*********************************************************************** + +end module glc_coupling_flags diff --git a/components/cism/drivers/cpl/glc_cpl_indices.F90 b/components/cism/drivers/cpl/glc_cpl_indices.F90 new file mode 100644 index 0000000000..fd829dc903 --- /dev/null +++ b/components/cism/drivers/cpl/glc_cpl_indices.F90 @@ -0,0 +1,70 @@ +module glc_cpl_indices + + use seq_flds_mod + use mct_mod + use glc_constants, only : glc_smb + use shr_sys_mod , only : shr_sys_abort + + implicit none + + SAVE + public + + ! drv -> glc + + integer, public :: index_x2g_Sl_tsrf = 0 + integer, public :: index_x2g_Flgl_qice = 0 + + ! glc -> drv + + integer, public :: index_g2x_Fogg_rofi = 0 ! frozen runoff -> ocn + integer, public :: index_g2x_Figg_rofi = 0 ! frozen runoff -> ice + integer, public :: index_g2x_Fogg_rofl = 0 ! liquid runoff -> ocn + integer, public :: index_g2x_Sg_ice_covered = 0 + integer, public :: index_g2x_Sg_topo = 0 + integer, public :: index_g2x_Flgg_hflx = 0 + integer, public :: index_g2x_Sg_icemask = 0 + integer, public :: index_g2x_Sg_icemask_coupled_fluxes = 0 + +contains + + subroutine glc_cpl_indices_set( ) + + !------------------------------------------------------------- + type(mct_aVect) :: g2x ! temporary + type(mct_aVect) :: x2g ! temporary + !------------------------------------------------------------- + + ! create temporary attribute vectors + + call mct_aVect_init(x2g, rList=seq_flds_x2g_fields, lsize=1) + call mct_aVect_init(g2x, rList=seq_flds_g2x_fields, lsize=1) + + ! glc -> drv + + index_g2x_Fogg_rofi = mct_avect_indexra(g2x,'Fogg_rofi') + index_g2x_Figg_rofi = mct_avect_indexra(g2x,'Figg_rofi') + index_g2x_Fogg_rofl = mct_avect_indexra(g2x,'Fogg_rofl') + index_g2x_Sg_ice_covered = mct_avect_indexra(g2x,'Sg_ice_covered') + index_g2x_Sg_topo = mct_avect_indexra(g2x,'Sg_topo') + index_g2x_Flgg_hflx = mct_avect_indexra(g2x,'Flgg_hflx') + index_g2x_Sg_icemask = mct_avect_indexra(g2x,'Sg_icemask') + index_g2x_Sg_icemask_coupled_fluxes = mct_avect_indexra(g2x,'Sg_icemask_coupled_fluxes') + + ! drv -> glc + index_x2g_Sl_tsrf = mct_avect_indexra(x2g,'Sl_tsrf') + index_x2g_Flgl_qice = mct_avect_indexra(x2g,'Flgl_qice') + + call mct_aVect_clean(x2g) + call mct_aVect_clean(g2x) + + ! Set glc_smb + ! true => get surface mass balance from CLM via coupler (in multiple elev classes) + ! false => use PDD scheme in GLIMMER + ! For now, we always use true + + glc_smb = .true. + + end subroutine glc_cpl_indices_set + +end module glc_cpl_indices diff --git a/components/cism/drivers/cpl/glc_import_export.F90 b/components/cism/drivers/cpl/glc_import_export.F90 new file mode 100644 index 0000000000..494976f887 --- /dev/null +++ b/components/cism/drivers/cpl/glc_import_export.F90 @@ -0,0 +1,117 @@ +module glc_import_export + + use shr_sys_mod + use shr_kind_mod, only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8 + use shr_kind_mod, only: CS=>SHR_KIND_CS, CL=>SHR_KIND_CL + use glc_constants, only: verbose, stdout, stderr, tkfrz + use glc_communicate, only: my_task, master_task + use glc_cpl_indices + + implicit none + save + public + + ! Public interfaces + public :: glc_import + +!================================================================================= +contains +!================================================================================= + + subroutine glc_import(x2g) + + !------------------------------------------------------------------- + use glc_indexing_info, only : nx, ny, local_indices + use glc_fields, only: tsfc, qsmb + + real(r8) , intent(in) :: x2g(:,:) + + integer(IN) :: i,j,n + character(*), parameter :: subName = "(glc_import) " + !------------------------------------------------------------------- + + do j = 1, ny + do i = 1, nx + n = local_indices(i,j) + tsfc(i,j) = x2g(index_x2g_Sl_tsrf, n) - tkfrz + qsmb(i,j) = x2g(index_x2g_Flgl_qice, n) + enddo + enddo + + !Jer hack fix: + !For some land points where CLM sees ocean, and all ocean points, CLM doesn't provide a temperature, + !and so the incoming temperature is 0.d0. This gets dropped to -273.15, in the above code. So, + !manually reverse this, below, to set to 0C. + where (tsfc < -250.d0) tsfc=0.d0 + + end subroutine glc_import + +!================================================================================= + + subroutine glc_export(g2x) + + !------------------------------------------------------------------- + use glc_indexing_info, only : nx, ny, local_indices + use glc_fields , only: ice_covered, topo, rofi, rofl, hflx, & + ice_sheet_grid_mask, icemask_coupled_fluxes ! to coupler + use glc_route_ice_runoff, only: route_ice_runoff + use glc_override_frac , only: frac_overrides_enabled, do_frac_overrides + + real(r8) ,intent(inout) :: g2x(:,:) + + ! if doing frac overrides, these are the modified versions sent to the coupler; + ! otherwise they point to the real fields + real(r8), pointer :: ice_covered_to_cpl(:,:) + real(r8), pointer :: topo_to_cpl(:,:) + logical :: fields_to_cpl_allocated ! whether we allocated the above fields + + integer(IN) :: i,j,n + character(*), parameter :: subName = "(glc_export) " + !------------------------------------------------------------------- + + ! If overrides of glc fraction are enabled (for testing purposes), then apply + ! these overrides, otherwise use the real version of ice_covered and topo + if (frac_overrides_enabled()) then + allocate(ice_covered_to_cpl(lbound(ice_covered,1):ubound(ice_covered,1), & + lbound(ice_covered,2):ubound(ice_covered,2))) + allocate(topo_to_cpl(lbound(topo,1):ubound(topo,1), & + lbound(topo,2):ubound(topo,2))) + + ice_covered_to_cpl = ice_covered + topo_to_cpl = topo + call do_frac_overrides(ice_covered_to_cpl, topo_to_cpl, ice_sheet_grid_mask) + fields_to_cpl_allocated = .true. + else + ice_covered_to_cpl => ice_covered + topo_to_cpl => topo + fields_to_cpl_allocated = .false. + end if + + do j = 1, ny + do i = 1, nx + n = local_indices(i,j) + + call route_ice_runoff(rofi(i,j), & + rofi_to_ocn=g2x(index_g2x_Fogg_rofi, n), & + rofi_to_ice=g2x(index_g2x_Figg_rofi, n)) + + g2x(index_g2x_Fogg_rofl, n) = rofl(i,j) + + g2x(index_g2x_Sg_ice_covered, n) = ice_covered_to_cpl(i,j) + g2x(index_g2x_Sg_topo, n) = topo_to_cpl(i,j) + g2x(index_g2x_Flgg_hflx, n) = hflx(i,j) + + g2x(index_g2x_Sg_icemask, n) = ice_sheet_grid_mask(i,j) + g2x(index_g2x_Sg_icemask_coupled_fluxes, n) = icemask_coupled_fluxes(i,j) + + enddo + enddo + + if (fields_to_cpl_allocated) then + deallocate(ice_covered_to_cpl) + deallocate(topo_to_cpl) + end if + + end subroutine glc_export + +end module glc_import_export diff --git a/components/cism/glimmer-cism/AUTHORS b/components/cism/glimmer-cism/AUTHORS new file mode 100644 index 0000000000..7735c2b62b --- /dev/null +++ b/components/cism/glimmer-cism/AUTHORS @@ -0,0 +1,31 @@ +The following authors (listed alphabetically) have contributed to this version of Glimmer-CISM. +Affiliations shown with an asterisk (*) are no longer current. + +Erin Barker Los Alamos National Laboratory (*) +Tim Bocek University of Montana, Missoula (*) +Josh Campbell University of Montana, Missoula +Katherine J. Evans Oak Ridge National Laboratory +Jeremy Fyke Los Alamos National Laboratory +Glen Granzow University of Montana, Missoula +Magnus Hagdorn School of GeoSciences, University of Edinburgh +Brian Hand University of Montana, Missoula (*) +Felix Hebeler University of Zurich(*) +Matthew Hoffman Los Alamos National Laboratory +Jesse Johnson University of Montana, Missoula +Irina Kalashnikova Sandia National Laboratories +Jean-Francois Lemieux New York University (*) +William Lipscomb Los Alamos National Laboratory +Daniel Martin Lawrence Berkeley National Laboratory +Jeffrey A. Nichols Oak Ridge National Laboratory +Ryan Nong Sandia National Laboratories (*) +Matthew R. Norman Oak Ridge National Laboratory +Tony Payne University of Bristol +Stephen Price Los Alamos National Laboratory +Doug Ranken Los Alamos National Laboratory +Ian Rutt Dept. of Geography, Swansea University +William Sacks National Center for Atmospheric Research +Andrew Salinger Sandia National Laboratories +James B. White III Oak Ridge National Laboratory (*) +Jon Wolfe National Center for Atmospheric Research (*) +Patrick Worley Oak Ridge National Laboratory +Timothy Wylie University of Montana, Missoula (*) diff --git a/components/cism/glimmer-cism/CMakeLists.txt b/components/cism/glimmer-cism/CMakeLists.txt new file mode 100644 index 0000000000..dc6b915c00 --- /dev/null +++ b/components/cism/glimmer-cism/CMakeLists.txt @@ -0,0 +1,479 @@ +# CMAKE File for CISM building against an installed Trilinos + +cmake_minimum_required(VERSION 2.8.4) + +OPTION (CISM_BUILD_CISM_DRIVER "Toggle to build cism_driver, on by default" ON) + +OPTION (CISM_USE_TRILINOS "Toggle to use Trilinos: defaults to OFF" OFF) +OPTION (CISM_MPI_MODE "Toggle to Configure with MPI: defaults to ON" ON) +OPTION (CISM_SERIAL_MODE "Toggle to Configure in Serial mode: defaults to OFF " OFF) + +OPTION (CISM_USE_MPI_WITH_SLAP "Toggle to use mpi when using SLAP solver, only relevant if CISM_SERIAL_MODE=ON: defaults to OFF" OFF) +OPTION (CISM_BUILD_SIMPLE_GLIDE "Toggle to build simple_glide, OFF by default" OFF) +OPTION (CISM_ENABLE_BISICLES "Toggle to build a BISICLES-capable cism_driver, off by default" OFF) + +OPTION (CISM_BUILD_EXTRA_EXECUTABLES "Toggle to other executables, off by default" OFF) +OPTION (CISM_USE_GPTL_INSTRUMENTATION "Toggle to use GPTL instrumentation, on by default " ON) +OPTION (CISM_COUPLED "Toggle to build CISM for use with CESM, off by default" OFF) +OPTION (CISM_USE_DEFAULT_IO "Toggle to use default i/o files rather than running python script, off by default" OFF) +# OPTION (CISM_USE_CISM_FRONT_END "Toggle to use cism_driver or cism_cesm_interface with cism_front_end, off by default" OFF) + +# WJS (1-3-13): We could avoid CISM_GNU by using something like CMAKE_Fortran_COMPILER_ID or CMAKE_COMPILER_IS_GNUCC, +# but it's not clear to me if those work consistently +OPTION (CISM_GNU "Toggle to set compilation flags needed for the gnu compiler, off by default" OFF) +OPTION (CISM_STATIC_LINKING "Toggle to set static linking for executables, off by default" OFF) +OPTION (CISM_FORCE_FORTRAN_LINKER "Toggle to force using a fortran linker for building executables, off by default" OFF) +OPTION (CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES "Toggle to explicitly include the CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES on the link line, on by default" ON) + +MESSAGE("CISM_USE_TRILINOS = ${CISM_USE_TRILINOS}") + +# override CISM_SERIAL_MODE setting, if it conflicts with CISM_MPI_MODE setting: +IF (CISM_MPI_MODE) + SET(CISM_SERIAL_MODE "OFF") + SET(CISM_BUILD_EXTRA_EXECUTABLES "OFF") +ENDIF() + +IF (NOT CISM_MPI_MODE AND NOT CISM_SERIAL_MODE) + SET(CISM_MPI_MODE "ON") +ENDIF() + +IF (CISM_BUILD_CISM_DRIVER) + SET(CISM_USE_CISM_FRONT_END "ON") +ENDIF() + +# set (or override) other options, if CISM_COUPLED is ON: +IF (CISM_COUPLED) + SET(CISM_NO_EXECUTABLE "ON") + SET(CISM_BUILD_SIMPLE_GLIDE "OFF") + SET(CISM_ENABLE_BISICLES "OFF") + SET(CISM_USE_CISM_FRONT_END "OFF") + SET(CISM_USE_DEFAULT_IO "ON") + ADD_DEFINITIONS(-DCCSMCOUPLED) +ENDIF() + + +IF (NOT DEFINED CISM_BINARY_DIR) + SET(CISM_BINARY_DIR ${CMAKE_BINARY_DIR}) +ENDIF() + +MESSAGE("Building in: ${CISM_BINARY_DIR}") + +IF (CISM_USE_TRILINOS) + OPTION(CISM_TRILINOS_DIR "Required path to installed Trilinos") + OPTION(CISM_NETCDF_DIR "Required path to installed Netcdf") + + + IF (CISM_USE_GPTL_INSTRUMENTATION) + IF (DEFINED CISM_TRILINOS_GPTL_DIR) + SET(CISM_TRILINOS_DIR ${CISM_TRILINOS_GPTL_DIR}) + ENDIF() + ENDIF() + + + # Error check up front + IF (NOT DEFINED CISM_TRILINOS_DIR) + MESSAGE(FATAL_ERROR "\nCISM Error: cmake must define CISM_TRILINOS_DIR: + (-D CISM_TRILINOS_DIR=)!") + ENDIF() + + # Get Trilinos as one entity + SET(CMAKE_PREFIX_PATH ${CISM_TRILINOS_DIR} ${CMAKE_PREFIX_PATH}) + FIND_PACKAGE(Trilinos REQUIRED) + + IF (${Trilinos_VERSION} VERSION_LESS 10.8.0) + MESSAGE(FATAL_ERROR "Trilinos version 10.8 or newer required!") + ENDIF() + + MESSAGE("\nFound Trilinos! Here are the details: ") + MESSAGE(" Trilinos_DIR = ${Trilinos_DIR}") + MESSAGE(" Trilinos_VERSION = ${Trilinos_VERSION}") + MESSAGE(" Trilinos_PACKAGE_LIST = ${Trilinos_PACKAGE_LIST}") + MESSAGE(" Trilinos_LIBRARIES = ${Trilinos_LIBRARIES}") + MESSAGE(" Trilinos_INCLUDE_DIRS = ${Trilinos_INCLUDE_DIRS}") + MESSAGE(" Trilinos_LIBRARY_DIRS = ${Trilinos_LIBRARY_DIRS}") + MESSAGE(" Trilinos_TPL_LIST = ${Trilinos_TPL_LIST}") + MESSAGE(" Trilinos_TPL_INCLUDE_DIRS = ${Trilinos_TPL_INCLUDE_DIRS}") + MESSAGE(" Trilinos_TPL_LIBRARIES = ${Trilinos_TPL_LIBRARIES}") + MESSAGE(" Trilinos_TPL_LIBRARY_DIRS = ${Trilinos_TPL_LIBRARY_DIRS}") + MESSAGE(" Trilinos_BUILD_SHARED_LIBS = ${Trilinos_BUILD_SHARED_LIBS}") + MESSAGE(" Trilinos_CXX_COMPILER_FLAGS = ${Trilinos_CXX_COMPILER_FLAGS}") + MESSAGE(" Trilinos_Fortran_COMPILER_FLAGS = ${Trilinos_Fortran_COMPILER_FLAGS}") + MESSAGE("End of Trilinos details\n") + + # Get libraries for link line from Trilinos build information + set(CISM_TRILINOS_LIBS ${Trilinos_LIBRARIES} ${Trilinos_TPL_LIBRARIES} ${Trilinos_EXTRA_LD_FLAGS}) + + IF (NOT DEFINED CMAKE_CXX_COMPILER AND NOT DEFINED ENV{CXX}) + SET(CMAKE_CXX_COMPILER ${Trilinos_CXX_COMPILER}) + ENDIF() + IF (NOT DEFINED CMAKE_C_COMPILER AND NOT DEFINED ENV{CC}) + SET(CMAKE_C_COMPILER ${Trilinos_C_COMPILER}) + ENDIF() + IF (NOT DEFINED CMAKE_Fortran_COMPILER AND NOT DEFINED ENV{FC}) + SET(CMAKE_Fortran_COMPILER ${Trilinos_Fortran_COMPILER}) + ENDIF() +ENDIF() + +ENABLE_LANGUAGE(Fortran) + +IF (CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES) + # WJS (6-3-14) Until now, these Fortran_IMPLICIT_LINK_LIBRARIES were always + # included. However, explicitly appending these implicit link libraries breaks + # the build on yellowstone, for some reason. It could be because the trilinos + # build is old. I suspect these implicit link libraries are needed when you're + # linking with a C++ linker, which is not the case for yellowstone-intel. In + # any case, I'm providing an option to exclude these from the build, to allow + # the yellowstone-intel build to work. + # + # Also, note that, although these are added to the variable CISM_TRILINOS_LIBS, + # this variable is used even when building without trilinos. I am merely + # maintaining the old behavior in this respect. + LIST(APPEND CISM_TRILINOS_LIBS ${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}) + + #message("") + #message(" CMake detected the following libraries for linking Fortran with C++ compiler:") + #message(" ${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES} ") +ENDIF() + +# Only include C++ support if it's really needed, to avoid problems +# caused by broken C++ compilers. +#IK, 8/3/13: added simple_felix option +IF (CISM_USE_TRILINOS OR CISM_ENABLE_BISICLES) + ENABLE_LANGUAGE(CXX) +ENDIF() + +MESSAGE(">> CISM_NETCDF_DIR set to : ${CISM_NETCDF_DIR}") + +IF (NOT DEFINED CISM_NETCDF_DIR) + MESSAGE(FATAL_ERROR "\nCISM Error: cmake must define CISM_NETCDF_DIR: + (-D CISM_NETCDF_DIR=)!") +ENDIF() + +FIND_PATH(CISM_NETCDFF_FOUND libnetcdff.a ${CISM_NETCDF_DIR}/lib) +#MESSAGE(" CISM_NETCDFF_FOUND = ${CISM_NETCDFF_FOUND}") + +IF (${CISM_NETCDFF_FOUND} STREQUAL ${CISM_NETCDF_DIR}/lib ) + SET(CISM_NETCDF_LIBS "netcdff;netcdf" CACHE STRING "Netcdf Library Names(s)") +ELSE() + SET(CISM_NETCDF_LIBS "netcdf" CACHE STRING "Netcdf Library Names(s)") +ENDIF() +MESSAGE(">> CISM_NETCDF_LIBS Library(s) set to : ${CISM_NETCDF_LIBS}") + +IF (DEFINED CISM_MPI_BASE_DIR) + IF (NOT DEFINED CISM_MPI_LIB_DIR) + SET(CISM_MPI_LIB_DIR ${CISM_MPI_BASE_DIR}/lib) + ENDIF() + IF (NOT DEFINED CISM_MPI_INC_DIR) + SET(CISM_MPI_INC_DIR ${CISM_MPI_BASE_DIR}/include) + ENDIF() +ENDIF() +MESSAGE(">> CISM_MPI_LIB_DIR set to : ${CISM_MPI_LIB_DIR}") +MESSAGE(">> CISM_MPI_INC_DIR set to : ${CISM_MPI_INC_DIR}") + + +IF (NOT DEFINED CMAKE_Fortran_MODULE_DIRECTORY) + SET(CMAKE_Fortran_MODULE_DIRECTORY ${CISM_BINARY_DIR}/fortran_mod_files) +ENDIF() +INCLUDE_DIRECTORIES(${CMAKE_Fortran_MODULE_DIRECTORY}) + + +# Note that C++ is excluded here -- we only include C++ support if +# it's really needed (see ENABLE_LANGUAGE(CXX) command above) +PROJECT(CISM Fortran C) + + +IF (NOT CISM_USE_DEFAULT_IO) + # Auto-generate the *_io.F90 files in the build directory: + MESSAGE(">> Calling utils/build/autogenerate-in-build-dir") + EXECUTE_PROCESS(COMMAND ${CISM_SOURCE_DIR}/utils/build/autogenerate-in-build-dir + ${CISM_SOURCE_DIR} + WORKING_DIRECTORY ${CISM_BINARY_DIR} + OUTPUT_FILE ${CISM_BINARY_DIR}/autogenerate.log) + + MESSAGE(">> see ${CISM_BINARY_DIR}/autogenerate.log") + + IF (CISM_USE_CISM_FRONT_END) + # Auto-generate the *_io.F90 files in the build directory: + MESSAGE(">> Calling utils/build/autogenerate-in-build-dir") + EXECUTE_PROCESS(COMMAND ${CISM_SOURCE_DIR}/utils/build/autogen-for-glint-and-glad-in-build-dir + ${CISM_SOURCE_DIR} + WORKING_DIRECTORY ${CISM_BINARY_DIR} + OUTPUT_FILE ${CISM_BINARY_DIR}/autogen-for-glint-and-glad.log) + + MESSAGE(">> see ${CISM_BINARY_DIR}/autogen-for-glint-and-glad.log") + ENDIF() + +ELSE() + # Simply copy the default io files into the build directory + MESSAGE(">> Calling utils/build/autocopy-io-to-build-dir") + EXECUTE_PROCESS(COMMAND ${CISM_SOURCE_DIR}/utils/build/autocopy-io-to-build-dir + ${CISM_SOURCE_DIR} + WORKING_DIRECTORY ${CISM_BINARY_DIR} + OUTPUT_FILE ${CISM_BINARY_DIR}/autocopy-io.log) + + MESSAGE(">> see ${CISM_BINARY_DIR}/autocopy-io.log") +ENDIF() + +# Copy a few needed files to the build directory: +MESSAGE(">> Calling utils/build/autocopy-to-build-dir") +EXECUTE_PROCESS(COMMAND ${CISM_SOURCE_DIR}/utils/build/autocopy-to-build-dir + ${CISM_SOURCE_DIR} + WORKING_DIRECTORY ${CISM_BINARY_DIR} + OUTPUT_FILE ${CISM_BINARY_DIR}/autocopy.log) + +MESSAGE(">> see ${CISM_BINARY_DIR}/autocopy.log") +INCLUDE_DIRECTORIES(${CISM_BINARY_DIR}/fortran_autocopy_includes) + +# End of setup and error checking +# NOTE: PROJECT command checks for compilers, so this statement +# is moved AFTER setting CMAKE_CXX_COMPILER from Trilinos + +## Use CMAKE_CXX_FLAGS CMAKE_Fortran_FLAGS to override Trilinos flags +## USe CISM_CXX_FLAGS CISM_Fortran_FLAGS to append to Trilinos flags + +IF (NOT CMAKE_CXX_FLAGS) + SET(CMAKE_CXX_FLAGS ${Trilinos_CXX_COMPILER_FLAGS} ) +ENDIF() +SET(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} ${CISM_CXX_FLAGS}") + +IF (NOT CMAKE_Fortran_FLAGS) + SET(CMAKE_Fortran_FLAGS ${Trilinos_Fortran_COMPILER_FLAGS} ) +ENDIF() +SET(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${CISM_Fortran_FLAGS}") + +IF (CISM_USE_TRILINOS) + ## CISM requires Trilinos to include the Piro build + MESSAGE("-- Looking for Piro within Trilinos:") + MESSAGE("Trilinos pkg list: " ${Trilinos_PACKAGE_LIST}) + LIST(FIND Trilinos_PACKAGE_LIST Piro Piro_List_ID) + IF (Piro_List_ID GREATER -1) + MESSAGE("-- Looking for Piro: -- found! Continuing.") + ELSE() + MESSAGE(FATAL_ERROR "-- Looking for Piro: -- not found! Rebuild Trilinos with Piro package.") + ENDIF() + + ADD_DEFINITIONS(-DCISM_MPI -DTRILINOS) + ADD_DEFINITIONS(-DGLIMMER_MPI) + MESSAGE(">> Trilinos build: adding -DTRILINOS to compile lines") + + include_directories(${CISM_NETCDF_DIR}/include) + link_directories(${CISM_NETCDF_DIR}/lib) + +ELSE() + + IF (${CISM_MPI_MODE}) + ADD_DEFINITIONS(-DCISM_MPI) + ADD_DEFINITIONS(-DGLIMMER_MPI) + ENDIF() + include_directories(${CISM_NETCDF_DIR}/include ${CISM_MPI_INC_DIR}) + + link_directories(${CISM_NETCDF_DIR}/lib ${CISM_MPI_LIB_DIR} ${CISM_SCI_LIB_DIR} + ${CISM_HDF5_LIB_DIR} ) +ENDIF() + +IF (CISM_ENABLE_BISICLES) + MESSAGE("\nBISICLES build configured.\n") + + SET(CISM_DYCORE_DIR ${CISM_SOURCE_DIR}/libdycore) + SET(CISM_TO_DYCORE ${CISM_DYCORE_DIR}/glimmer_to_dycore.F90) + SET(CISM_BISICLES_DIR ${CISM_DYCORE_DIR}/BISICLES) + + INCLUDE_DIRECTORIES(${CISM_DYCORE_DIR}) + LINK_DIRECTORIES(${CISM_DYCORE_DIR} ${BISICLES_INTERFACE_DIR} ) + ADD_DEFINITIONS(-DCISM_HAS_BISICLES) +ENDIF() + + +IF ( CISM_USE_GPTL_INSTRUMENTATION AND + (NOT CISM_ENABLE_BISICLES) AND + (NOT CISM_SERIAL_MODE)) + OPTION(CISM_GPTL_DIR "Optional path to installed gptl library") + IF (CISM_GPTL_DIR) + message(">> GPTL Library reqested, installed in ${CISM_GPTL_DIR}") + ADD_DEFINITIONS(-DCESMTIMERS) + include_directories(${CISM_GPTL_DIR}) + link_directories(${CISM_GPTL_DIR}) + SET(CISM_GPTL_LIB gptl) + ELSE() + message(">>GPTL Library not requested: can set CISM_GPTL_DIR to enable") + ENDIF() +ENDIF() + +#####Build All Fortran Sources ##### + +#IF (CISM_USE_CISM_FRONT_END) + file(GLOB GLINT_SOURCES libglint/*.F90) + file(GLOB GLAD_SOURCES libglad/*.F90) + file(GLOB GLISSADE_SOURCES libglissade/*.F90) +#ENDIF() + + +file(GLOB FORTRANSOURCES + libglimmer-solve/SLAP/*.f + libglimmer-solve/*.F90 + libglimmer/*.F90 libglimmer/writestats.c + libglide/*.F90 + cism_driver/eismint_forcing.F90 + cism_driver/testsfg.F90 + ${GLINT_SOURCES} + ${GLAD_SOURCES} + ${GLISSADE_SOURCES} + ${CISM_TO_DYCORE}) + +LIST(REMOVE_ITEM FORTRANSOURCES + ${CISM_SOURCE_DIR}/libglimmer-solve/SLAP/dlapqc.f ) + + +IF (CISM_USE_TRILINOS OR CISM_MPI_MODE) + LIST(REMOVE_ITEM FORTRANSOURCES + ${CISM_SOURCE_DIR}/libglimmer/parallel_slap.F90) + +ELSE(${CISM_SERIAL_MODE}) + LIST(REMOVE_ITEM FORTRANSOURCES + ${CISM_SOURCE_DIR}/libglimmer/parallel_mpi.F90) + + IF (CISM_USE_MPI_WITH_SLAP) + ADD_DEFINITIONS(-D_USE_MPI_WITH_SLAP) + ELSE() + LIST(REMOVE_ITEM FORTRANSOURCES + ${CISM_SOURCE_DIR}/libglimmer/mpi_mod.F90) + ENDIF() +ENDIF() + +# Get autogenerated source files, and add them to the FORTRANSOURCES list: +# changed to always do this: +#IF (CISM_COUPLED) + FILE(GLOB FORTRAN_AUTOGEN_SOURCES ${CISM_BINARY_DIR}/fortran_autogen_srcs/*.F90) + message("Autogenerated CISM sources: ${FORTRAN_AUTOGEN_SOURCES}") + + SET(FORTRANSOURCES ${FORTRANSOURCES} ${FORTRAN_AUTOGEN_SOURCES}) + +# Remove old versions of autogenerated F90 files that may be sitting +# around in the source tree from an old cmake-based build or an +# autotools-based build. (Now the cmake-based build doesn't place +# these in the source tree.) +# Unlike SOURCEMODFILES, we just hard-code the files to remove for +# simplicity. +# This can be removed once we switch to consistently using this new +# cmake-based build. + LIST(REMOVE_ITEM FORTRANSOURCES + ${CISM_SOURCE_DIR}/libglide/glide_io.F90 + ${CISM_SOURCE_DIR}/libglide/glide_lithot_io.F90 + ${CISM_SOURCE_DIR}/libglint/glint_io.F90 + ${CISM_SOURCE_DIR}/libglint/glint_mbal_io.F90 + ${CISM_SOURCE_DIR}/libglimmer/glimmer_vers.F90 ) +#ENDIF() + + +### (For CESM) Remove source files with names already in CISM_SOURCEMOD_DIR +OPTION(CISM_SOURCEMOD_DIR + "Path to SourceMod directory of F90 files to replace Glimmer files") + +#MESSAGE("Fortran Source Files: ${FORTRANSOURCES}") + +# Note that the following glob does NOT contain .cpp files, because +# those are built in a separate library - so for now, you can't put +# .cpp files in your sourceMod directory. +FILE(GLOB SOURCEMODFILES + ${CISM_SOURCEMOD_DIR}/*.F90 + ${CISM_SOURCEMOD_DIR}/*.F + ${CISM_SOURCEMOD_DIR}/*.f90 + ${CISM_SOURCEMOD_DIR}/*.f + ${CISM_SOURCEMOD_DIR}/*.c) + +# MESSAGE("glimmer_sourcemod_dir: " ${CISM_SOURCEMOD_DIR}) +# MESSAGE("Fortran Mod Files: ${SOURCEMODFILES}") + +FOREACH( MODFILE ${SOURCEMODFILES}) + STRING(FIND ${MODFILE} / index REVERSE) + MATH(EXPR index ${index}+1) + STRING(SUBSTRING ${MODFILE} ${index} -1 filename) + FOREACH( SOURCEFILE ${FORTRANSOURCES}) + STRING(REGEX MATCH ${filename} match_found ${SOURCEFILE}) + + IF(match_found) + MESSAGE("--SourceMod: removing ${SOURCEFILE} in favor of ${MODFILE}") + LIST(REMOVE_ITEM FORTRANSOURCES ${SOURCEFILE}) + ENDIF() + ENDFOREACH() +ENDFOREACH() +### + +# WJS (1-3-13): Ideally, rather than checking CISM_GNU, we would instead check for whether -fno-range-check works, +# and if so, include that flag (see +# http://stackoverflow.com/questions/3134660/how-to-apply-different-compiler-options-for-different-compilers-in-cmake). +# But it doesn't look like there is that capability for fortran compilers yet. +IF (CISM_GNU) + # Allow explicit NaN values in gfortran compiler + # Note that this won't work if the user has put nan_mod.F90 in their + # SourceMods directory, since it assumes a particular path + SET_PROPERTY(SOURCE ${CISM_SOURCE_DIR}/libglimmer/nan_mod.F90 + APPEND PROPERTY COMPILE_FLAGS -fno-range-check) +ENDIF() + +#IF (CISM_COUPLED) + # enable removal of the autogenerated source files, when 'make clean' is done: + # commented out for now, since it may create more problems than it solves when building + # SET_DIRECTORY_PROPERTIES(PROPERTIES ADDITIONAL_MAKE_CLEAN_FILES "${FORTRAN_AUTOGEN_SOURCES}") +#ENDIF() + + +SET(CMAKE_INCLUDE_PATH ${CISM_BINARY_DIR}/include) + + +#message("Fortransource ${FORTRANSOURCES}") + +# include-dirs: Binary: all the .mod files; SOURCE: config.inc; +# libglide: glide_mask.inc + +include_directories (${CISM_BINARY_DIR} ${CISM_SOURCE_DIR} + ${CISM_SOURCE_DIR}/libglide) + + +SET(LIBRARY_OUTPUT_PATH ${CISM_BINARY_DIR}/lib) + +### Determine which fortran source files are fixed-form, +### which may require special compilation flags +FOREACH (SOURCEFILE ${FORTRANSOURCES} ${SOURCEMODFILES}) + STRING(REGEX MATCH "\\.[fF]$" match_found ${SOURCEFILE}) + IF(match_found) + LIST(APPEND FIXEDSOURCES ${SOURCEFILE}) + ENDIF() +ENDFOREACH() +SET_SOURCE_FILES_PROPERTIES(${FIXEDSOURCES} PROPERTIES Fortran_FORMAT FIXED) + +add_library(glimmercismfortran ${FORTRANSOURCES} ${SOURCEMODFILES}) + + +#####Build C++ Sources ##### + +IF (CISM_USE_TRILINOS) + add_subdirectory(libglimmer-trilinos) +ENDIF() + +#####Build simple_glide executable (unless turned off) ##### +OPTION(CISM_NO_EXECUTABLE "Set to ON to just build libraries (default:OFF)" OFF) + + +#IF (CISM_BUILD_SIMPLE_GLIDE AND (NOT CISM_NO_EXECUTABLE)) +# add_subdirectory(example-drivers/simple_glide/src) +#ENDIF() + +IF (CISM_USE_CISM_FRONT_END) + add_subdirectory(cism_driver) +ENDIF() + + +IF (CISM_ENABLE_BISICLES) + add_subdirectory(libdycore) + + include_directories (${CISM_DYCORE_DIR} + ${CISM_BISICLES_DIR}) + + message("glimmer src dir: ${CISM_SOURCE_DIR}") + message("glimmer dycore dir: ${CISM_DYCORE_DIR}") + get_property(inc_dirs DIRECTORY PROPERTY INCLUDE_DIRECTORIES) + message("inc_dirs = ${inc_dirs}") +ENDIF() + + diff --git a/components/cism/glimmer-cism/COPYING b/components/cism/glimmer-cism/COPYING new file mode 100644 index 0000000000..42d4133cd5 --- /dev/null +++ b/components/cism/glimmer-cism/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/components/cism/glimmer-cism/COPYING.LESSER b/components/cism/glimmer-cism/COPYING.LESSER new file mode 100644 index 0000000000..6600f1c98d --- /dev/null +++ b/components/cism/glimmer-cism/COPYING.LESSER @@ -0,0 +1,165 @@ +GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/components/cism/glimmer-cism/ChangeLog b/components/cism/glimmer-cism/ChangeLog new file mode 100644 index 0000000000..1747042922 --- /dev/null +++ b/components/cism/glimmer-cism/ChangeLog @@ -0,0 +1,29 @@ +CISM Changelog + +Changes in CISM Version 2.0 +=========================== + +CISM version 2.0, which originated from Glimmer-CISM and Glimmer, has a number of major changes and additions relative to these previous codes, including: + +* addition of robust, parallel, 2D and 3D, higher-order accurate approximations to the Stokes momentum balance (Blatter-Pattyn, L1L2, and SSA, all available within the "Glissade" dynamical core) +* adition of 3D, parallel mass and temperature transport +* addition of software interfaces to modern C++ based solver libraries (e.g., Trilinos) +* replacement of the Autotools build system with Cmake build system +* addition of new test cases for higher-order models, including several with analytical solutions +* re-ordering of the time step to be fully consistent with explicit forward Euler scheme +* addition of a new high level "cism_driver", which replaces and reproduces functionality of several old drivers and allows for more flexible integration of additional and/or external dycores +* re-arrangement of the directory structure +* modifications to the Glint coupling software to support coupling with CESM and other climate models that compute surface mass balance external to the ice sheet model +* new and updated documentation + +More information including full documentation of the code can be found at: +http://oceans11.lanl.gov/cism/ + +CISM version 2.0 will be hosted at the CISM Github organization: +https://github.com/cism/cism + +The original Glimmer-CISM and Glimmer codes can be found at the Glimmer-CISM Github organization: +https://github.com/glimmer-cism + +updated 10/21/2014 + diff --git a/components/cism/glimmer-cism/FUNDING b/components/cism/glimmer-cism/FUNDING new file mode 100644 index 0000000000..bb77c9fcd9 --- /dev/null +++ b/components/cism/glimmer-cism/FUNDING @@ -0,0 +1,9 @@ + +The development of CISM has been supported by the following U.K. and U.S. funding agencies: + +Agency, Country Program +---------------- ------------ +National Environmental Research Council, U.K. Centre for Polar and Ocean Modelling +National Science Foundation, U.S. Office of Polar Programs +Department of Energy, U.S. Biological and Environmental Research +Department of Energy, U.S. Advanced Scientific Computing Research diff --git a/components/cism/glimmer-cism/LICENSE b/components/cism/glimmer-cism/LICENSE new file mode 100644 index 0000000000..4ddaf191d6 --- /dev/null +++ b/components/cism/glimmer-cism/LICENSE @@ -0,0 +1,268 @@ +The GNU General Public License (GPL) + +Version 2, June 1991 + +Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +Preamble + +The licenses for most software are designed to take away your freedom to share +and change it. By contrast, the GNU General Public License is intended to +guarantee your freedom to share and change free software--to make sure the +software is free for all its users. This General Public License applies to +most of the Free Software Foundation's software and to any other program whose +authors commit to using it. (Some other Free Software Foundation software is +covered by the GNU Library General Public License instead.) You can apply it +to your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our +General Public Licenses are designed to make sure that you have the freedom to +distribute copies of free software (and charge for this service if you wish), +that you receive source code or can get it if you want it, that you can change +the software or use pieces of it in new free programs; and that you know you +can do these things. + +To protect your rights, we need to make restrictions that forbid anyone to +deny you these rights or to ask you to surrender the rights. These +restrictions translate to certain responsibilities for you if you distribute +copies of the software, or if you modify it. + +For example, if you distribute copies of such a program, whether gratis or for +a fee, you must give the recipients all the rights that you have. You must +make sure that they, too, receive or can get the source code. And you must +show them these terms so they know their rights. + +We protect your rights with two steps: (1) copyright the software, and (2) +offer you this license which gives you legal permission to copy, distribute +and/or modify the software. + +Also, for each author's protection and ours, we want to make certain that +everyone understands that there is no warranty for this free software. If the +software is modified by someone else and passed on, we want its recipients to +know that what they have is not the original, so that any problems introduced +by others will not reflect on the original authors' reputations. + +Finally, any free program is threatened constantly by software patents. We +wish to avoid the danger that redistributors of a free program will +individually obtain patent licenses, in effect making the program +proprietary. To prevent this, we have made it clear that any patent must be +licensed for everyone's free use or not licensed at all. + +The precise terms and conditions for copying, distribution and modification follow. + +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + +0. This License applies to any program or other work which contains a notice + placed by the copyright holder saying it may be distributed under the terms + of this General Public License. The "Program", below, refers to any such + program or work, and a "work based on the Program" means either the Program + or any derivative work under copyright law: that is to say, a work + containing the Program or a portion of it, either verbatim or with + modifications and/or translated into another language. (Hereinafter, + translation is included without limitation in the term "modification".) + Each licensee is addressed as "you". + + Activities other than copying, distribution and modification are not covered + by this License; they are outside its scope. The act of running the Program is + not restricted, and the output from the Program is covered only if its + contents constitute a work based on the Program (independent of having been + made by running the Program). Whether that is true depends on what the Program + does. + +1. You may copy and distribute verbatim copies of the Program's source code as + you receive it, in any medium, provided that you conspicuously and + appropriately publish on each copy an appropriate copyright notice and + disclaimer of warranty; keep intact all the notices that refer to this + License and to the absence of any warranty; and give any other recipients + of the Program a copy of this License along with the Program. + + You may charge a fee for the physical act of transferring a copy, and you may + at your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Program or any portion of it, + thus forming a work based on the Program, and copy and distribute such + modifications or work under the terms of Section 1 above, provided that you + also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices stating + that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in whole or + in part contains or is derived from the Program or any part thereof, to be + licensed as a whole at no charge to all third parties under the terms of + this License. + + c) If the modified program normally reads commands interactively when run, + you must cause it, when started running for such interactive use in the + most ordinary way, to print or display an announcement including an + appropriate copyright notice and a notice that there is no warranty (or + else, saying that you provide a warranty) and that users may redistribute + the program under these conditions, and telling the user how to view a copy + of this License. (Exception: if the Program itself is interactive but does + not normally print such an announcement, your work based on the Program is + not required to print an announcement.) + + These requirements apply to the modified work as a whole. If identifiable + sections of that work are not derived from the Program, and can be + reasonably considered independent and separate works in themselves, then + this License, and its terms, do not apply to those sections when you + distribute them as separate works. But when you distribute the same + sections as part of a whole which is a work based on the Program, the + distribution of the whole must be on the terms of this License, whose + permissions for other licensees extend to the entire whole, and thus to + each and every part regardless of who wrote it. + + Thus, it is not the intent of this section to claim rights or contest your + rights to work written entirely by you; rather, the intent is to exercise + the right to control the distribution of derivative or collective works + based on the Program. + + In addition, mere aggregation of another work not based on the Program with + the Program (or with a work based on the Program) on a volume of a storage + or distribution medium does not bring the other work under the scope of + this License. + +3. You may copy and distribute the Program (or a work based on it, under + Section 2) in object code or executable form under the terms of Sections 1 + and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable source + code, which must be distributed under the terms of Sections 1 and 2 above + on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three years, to + give any third party, for a charge no more than your cost of physically + performing source distribution, a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of Sections 1 + and 2 above on a medium customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer to + distribute corresponding source code. (This alternative is allowed only for + noncommercial distribution and only if you received the program in object + code or executable form with such an offer, in accord with Subsection b + above.) + + The source code for a work means the preferred form of the work for making + modifications to it. For an executable work, complete source code means all + the source code for all modules it contains, plus any associated interface + definition files, plus the scripts used to control compilation and + installation of the executable. However, as a special exception, the source + code distributed need not include anything that is normally distributed (in + either source or binary form) with the major components (compiler, kernel, + and so on) of the operating system on which the executable runs, unless + that component itself accompanies the executable. + + If distribution of executable or object code is made by offering access to + copy from a designated place, then offering equivalent access to copy the + source code from the same place counts as distribution of the source code, + even though third parties are not compelled to copy the source along with + the object code. + +4. You may not copy, modify, sublicense, or distribute the Program except as + expressly provided under this License. Any attempt otherwise to copy, + modify, sublicense or distribute the Program is void, and will + automatically terminate your rights under this License. However, parties + who have received copies, or rights, from you under this License will not + have their licenses terminated so long as such parties remain in full + compliance. + +5. You are not required to accept this License, since you have not signed + it. However, nothing else grants you permission to modify or distribute the + Program or its derivative works. These actions are prohibited by law if you + do not accept this License. Therefore, by modifying or distributing the + Program (or any work based on the Program), you indicate your acceptance of + this License to do so, and all its terms and conditions for copying, + distributing or modifying the Program or works based on it. + +6. Each time you redistribute the Program (or any work based on the Program), + the recipient automatically receives a license from the original licensor + to copy, distribute or modify the Program subject to these terms and + conditions. You may not impose any further restrictions on the recipients' + exercise of the rights granted herein. You are not responsible for + enforcing compliance by third parties to this License. + +7. If, as a consequence of a court judgment or allegation of patent + infringement or for any other reason (not limited to patent issues), + conditions are imposed on you (whether by court order, agreement or + otherwise) that contradict the conditions of this License, they do not + excuse you from the conditions of this License. If you cannot distribute so + as to satisfy simultaneously your obligations under this License and any + other pertinent obligations, then as a consequence you may not distribute + the Program at all. For example, if a patent license would not permit + royalty-free redistribution of the Program by all those who receive copies + directly or indirectly through you, then the only way you could satisfy + both it and this License would be to refrain entirely from distribution of + the Program. + + If any portion of this section is held invalid or unenforceable under any + particular circumstance, the balance of the section is intended to apply + and the section as a whole is intended to apply in other circumstances. + + It is not the purpose of this section to induce you to infringe any patents + or other property right claims or to contest validity of any such claims; + this section has the sole purpose of protecting the integrity of the free + software distribution system, which is implemented by public license + practices. Many people have made generous contributions to the wide range + of software distributed through that system in reliance on consistent + application of that system; it is up to the author/donor to decide if he or + she is willing to distribute software through any other system and a + licensee cannot impose that choice. + + This section is intended to make thoroughly clear what is believed to be a + consequence of the rest of this License. + +8. If the distribution and/or use of the Program is restricted in certain + countries either by patents or by copyrighted interfaces, the original + copyright holder who places the Program under this License may add an + explicit geographical distribution limitation excluding those countries, so + that distribution is permitted only in or among countries not thus + excluded. In such case, this License incorporates the limitation as if + written in the body of this License. + +9. The Free Software Foundation may publish revised and/or new versions of the + General Public License from time to time. Such new versions will be similar + in spirit to the present version, but may differ in detail to address new + problems or concerns. + + Each version is given a distinguishing version number. If the Program + specifies a version number of this License which applies to it and "any + later version", you have the option of following the terms and conditions + either of that version or of any later version published by the Free + Software Foundation. If the Program does not specify a version number of + this License, you may choose any version ever published by the Free + Software Foundation. + +10. If you wish to incorporate parts of the Program into other free programs + whose distribution conditions are different, write to the author to ask + for permission. For software which is copyrighted by the Free Software + Foundation, write to the Free Software Foundation; we sometimes make + exceptions for this. Our decision will be guided by the two goals of + preserving the free status of all derivatives of our free software and of + promoting the sharing and reuse of software generally. + +NO WARRANTY + +11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR + THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN + OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES + PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED + OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS + TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE + PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, + REPAIR OR CORRECTION. + +12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL + ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR + REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, + INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT + LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES + SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE + WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN + ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + diff --git a/components/cism/glimmer-cism/NEWS b/components/cism/glimmer-cism/NEWS new file mode 100644 index 0000000000..8ad9ef8850 --- /dev/null +++ b/components/cism/glimmer-cism/NEWS @@ -0,0 +1,35 @@ +CISM NEWS + +CISM Version 2.0 +================ + +CISM2.0, which originated from Glimmer-CISM and Glimmer, has a number of major changes +relative to these previous codes: + +* addition of robust, parallel, 3D, 1st-order accurate approximation to the Stokes momentum + balance ("Glissade" dynamical core) +* adition of 3D, parallel mass and temperature transport +* addition of software interfaces to modern C++ based solver libraries (e.g., Trilinos) +* replacement of the Autotools build system with Cmake build system +* addition of new test cases for higher-order models +* re-ordering of the time step to be fully consistent with explicit forward Euler scheme +* addition of a new high level "cism_driver", which replaces and reproduces functionality of several + old drivers and allows for more flexible integration of additional and/or external dycores +* re-arrangement of the directory structure +* modifications to the GLINT coupling software to support coupling with CESM and other climate models + that compute surface mass balance external to the ice sheet model +* new and updated documentation + +More information including full documentation of the code can be found at: +http://oceans11.lanl.gov/cism/index.html + +The original Glimmer-CISM and Glimmer codes can be found at the Glimmer-CISM Github organization: +https://github.com/glimmer-cism + +updated 8/27/2014 + + + + + + diff --git a/components/cism/glimmer-cism/README b/components/cism/glimmer-cism/README new file mode 100644 index 0000000000..6bfb03b9f8 --- /dev/null +++ b/components/cism/glimmer-cism/README @@ -0,0 +1,58 @@ + +CISM README file: +=================== + +CISM is a land ice model designed to be used as part of an earth-system model +or as a stand-alone model. Full documentation can be found at: +http://oceans11.lanl.gov/cism/documentation.html + +Licensing: +========= + +CISM is issued under the Lesser GNU General Public Licence (see LICENSE in the main directory). + +Note that this licence DOES NOT APPLY to the SLAP linear algebra library, used by the serial +code, which is included here in its own directory (./libglimmer-solve/SLAP), and is in the public +domain. + + +Mailing list: +============= + +There are two mailing lists, once for general users and one for developers: + +1. The general user mailing list can be signed up for by sending an email to: + cism-users+subscribe@googlegroups.com + +1. The developers mailing list can be signed up for by sending an email to: + cism-devel+subscribe@googlegroups.com + +Note that because these lists are managed by GoogleGroups, they will *always* attempt to associate +you with a Google email address. To insure that the email you would like to use is associated with the +list, please make sure you entirely log out of any Google services before attempting to sign up for the +mailing list. The sign-up process will require you to authenticate the email address you wish to use by +taking you to a website where you will be prompted to enter that information. + + +Discussion Board: +================= + +A discussion board for getting help with running CISM, either in stand-alone mode or as part of CESM, can +be found at: http://bb.cgd.ucar.edu/forums/ice-sheet-modeling-cism + + +Bug Reporting: +============== + +Pleae report unresolved problems using the bug reporting facility at the CISM Github website +(under "Issues"): https://github.com/cism/cism/issues + + +Building / Installing CISM: +=========================== + +For detailed instructions on how to install and build CISM, please see Chapter 2 of the users +guide (available at: http://oceans11.lanl.gov/cism/documentation.html) + + +last updated: 10/21/2014 diff --git a/components/cism/glimmer-cism/builds/README b/components/cism/glimmer-cism/builds/README new file mode 100644 index 0000000000..4ecbc4f4f6 --- /dev/null +++ b/components/cism/glimmer-cism/builds/README @@ -0,0 +1,18 @@ +The seacism/builds directory is intended to contain cmake builds of CISM for the +most common platform/compiler-suite combinations. Each subdirectory of this +directory should contain a README file and a configure script file whose name +is -cmake, for example, hopper-pgi-cmake. The README +file should contain instructions to do the build, provide information on what +compiler suite will be used, and list what executables will be built, e.g. +simple_glide and simple_bisicles. It should also list any dependencies on +other packages. These dependencies should be handled in the configure script. + +The difference between this and using the cmake-scripts directory is that these +builds should be even more out-of-the box, so that a user can cd to the +appropriate directory, read the brief README file, and be able to quickly +generate the CISM build. The cmake scripts in the build directories should +handle loading the appropriate modules as part of simplifying the build +process, and should be kept current as much as possible. A significant part +of that is making sure the installed packages that the build relies on are +current. As an example, the packages that need to be maintained for the +hopper-pgi build are Trilinos and BISICLES (which also includes Chombo). diff --git a/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-build-and-test.csh b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-build-and-test.csh new file mode 100644 index 0000000000..d24d993aa4 --- /dev/null +++ b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-build-and-test.csh @@ -0,0 +1,154 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/blizzard-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = blizzard + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +#set CISM_RUN_SCRIPT = 'hopjob' +set CISM_RUN_SCRIPT = 'ijob_linux' +set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +#set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +#if ( -e example-drivers/simple_glide/src/simple_glide ) then +# echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' +# cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +#else +# echo "cmake '$COMPILER_NAME' build failed, no executable" +# @ build_problem = 1 +#endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake new file mode 100755 index 0000000000..a581c86dc6 --- /dev/null +++ b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake @@ -0,0 +1,69 @@ +# cmake configuration script that works on the Linux box in Matt's office (blueskies) with GCC +# Others will need to modify the Netcdf path. +# This config script is setup to perform a parallel build with Trilinos. +# +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +# After this executes, do: +# make -j 8 +# + +#echo +#echo Run this script by typing: source linux-gnu-cism-cmake +#echo +#echo Set CISM_TRILINOS_DIR to your Trilinos installation directory. +#echo + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_TRILINOS_DIR=/opt/trilinos-11.4.1_GNU4.8.3 \ + -D CISM_HDF5_LIB_DIR=/opt/hdf5_gcc4.8.3 \ + -D CISM_NETCDF_DIR=/opt/netcdf4.3.2_gcc4.8.3 \ +\ + -D CMAKE_Fortran_FLAGS="-g -O2 -ffree-line-length-none -fPIC -fno-range-check" \ +\ + -D CMAKE_CXX_COMPILER=mpicxx \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CISM_EXTRA_LIBS:STRING="-lblas -lcurl" \ +\ + -D CISM_MPI_INC_DIR=/opt/mpi3.1.2_gnu4.8.3/include \ + -D CISM_MPI_LIB_DIR=/opt/mpi3.1.2_gnu4.8.3/lib \ +\ + -D CMAKE_VERBOSE_MAKEFILE=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + .. + +# Note: last argument above "../.." is path to top seacism directory + +# -D CISM_NETCDF_LIBS="netcdff" \ diff --git a/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake-debug b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake-debug new file mode 100755 index 0000000000..528011b303 --- /dev/null +++ b/components/cism/glimmer-cism/builds/blizzard-gnu/blizzard-gnu-cmake-debug @@ -0,0 +1,83 @@ +# Requires (command line or in .bashrc): +# module load cmake +# +# module unload cmake python netcdf hdf5 +# module swap PrgEnv-pgi PrgEnv-gnu +# module load netcdf-hdf5parallel/4.2.0 cmake/2.8.6 python +# +# cmake configuration script that works on jaguar with GCC +# This script needs to be run from a subdirectory (e.g. build-gnu) +# of the main seacism repository (reflected in the several +# instances of # ".." below). +# +# After this executes, do: +# make -j 8 +# cp example-drivers/simple_glide/src/sgcmake . + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_TRILINOS_DIR=/opt/trilinos-11.4.1_GNU4.8.3 \ + -D CISM_HDF5_LIB_DIR=/opt/hdf5_gcc4.8.3 \ + -D CISM_NETCDF_DIR=/opt/netcdf4.3.2_gcc4.8.3 \ +\ + -D CMAKE_Fortran_FLAGS="-g -fbounds-check -fcheck-array-temporaries -ffree-line-length-none" \ +\ + -D CMAKE_CXX_COMPILER=mpicxx \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CISM_EXTRA_LIBS:STRING="-lblas -lcurl" \ +\ + -D CISM_MPI_INC_DIR=/opt/mpi3.1.2_gnu4.8.3/include \ + -D CISM_MPI_LIB_DIR=/opt/mpi3.1.2_gnu4.8.3/lib \ +\ + -D CMAKE_VERBOSE_MAKEFILE=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + .. + +# Note: last argument above ".." is path to top seacism directory + +# Prg Env that worked in titan 1/17/2013 +#Currently Loaded Modulefiles: +# 1) modules/3.2.6.6 22) audit/1.0.0-1.0401.34509.4.34.gem +# 2) xtpe-network-gemini 23) rca/1.0.0-2.0401.34092.9.59.gem +# 3) xtpe-interlagos 24) krca/1.0.0-2.0401.33562.3.95.gem +# 4) eswrap/1.0.15 25) dvs/0.9.0-1.0401.1327.13.34.gem +# 5) lustredu/1.2 26) csa/3.0.0-1_2.0401.33458.3.110.gem +# 6) DefApps 27) job/1.5.5-0.1_2.0401.34507.6.2.gem +# 7) altd/1.0 28) xpmem/0.1-2.0401.32557.3.12.gem +# 8) torque/4.1.4 29) gni-headers/2.1-1.0401.5618.16.1.gem +# 9) moab/7.1.3 30) dmapp/3.2.1-1.0401.5585.5.2.gem +# 10) cray-mpich2/5.5.5 31) pmi/4.0.0-1.0000.9282.69.4.gem +# 11) subversion/1.6.17 32) ugni/4.0-1.0401.5617.15.1.gem +# 12) atp/1.5.2 33) udreg/2.3.2-1.0401.5828.5.1.gem +# 13) xe-sysroot/4.1.20 34) xt-libsci/11.1.01 +# 14) switch/1.0-1.0401.34518.4.34.gem 35) gcc/4.7.2 +# 15) shared-root/1.0-1.0401.34936.4.9.gem 36) xt-asyncpe/5.16 +# 16) pdsh/2.2-1.0401.34516.3.1.gem 37) PrgEnv-gnu/4.1.20 +# 17) nodehealth/3.0-1.0401.35104.16.2.gem 38) cmake/2.8.6 +# 18) lbcd/2.1-1.0401.34512.5.1.gem 39) python/2.7.2 +# 19) hosts/1.0-1.0401.34511.5.34.gem 40) hdf5-parallel/1.8.8 +# 20) configuration/1.0-1.0401.34510.3.3.gem 41) netcdf-hdf5parallel/4.2.0 +# 21) ccm/2.2.0-1.0401.34937.13.25 + + diff --git a/components/cism/glimmer-cism/builds/edison-intel/PKG_CONFIG_PATH_fix.csh b/components/cism/glimmer-cism/builds/edison-intel/PKG_CONFIG_PATH_fix.csh new file mode 100644 index 0000000000..aeff66e806 --- /dev/null +++ b/components/cism/glimmer-cism/builds/edison-intel/PKG_CONFIG_PATH_fix.csh @@ -0,0 +1,2 @@ +setenv PKG_CONFIG_PATH /opt/cray/rca/1.0.0-2.0501.48090.7.46.ari/lib64/pkgconfig:/opt/cray/alps/5.1.1-2.0501.8471.1.1.ari/lib64/pkgconfig:/opt/cray/csa/3.0.0-1_2.0501.47112.1.91.ari/lib64/pkgconfig:/opt/cray/xpmem/0.1-2.0501.48424.3.3.ari/lib64/pkgconfig:/opt/cray/gni-headers/3.0-1.0501.8317.12.1.ari/lib64/pkgconfig:/opt/cray/dmapp/7.0.1-1.0501.8315.8.4.ari/lib64/pkgconfig:/opt/cray/pmi/5.0.3-1.0000.9981.128.2.ari/lib64/pkgconfig:/opt/cray/ugni/5.0-1.0501.8253.10.22.ari/lib64/pkgconfig:/opt/cray/udreg/2.3.2-1.0501.7914.1.13.ari/lib64/pkgconfig:/opt/cray/iobuf/2.0.5/lib/pkgconfig:/opt/cray/switch/1.0-1.0501.47124.1.93.ari/lib64/pkgconfig:/opt/cray/atp/1.7.2/lib/pkgconfig:/opt/cray/libsci/12.2.0/INTEL/130/x86_64/lib/pkgconfig + diff --git a/components/cism/glimmer-cism/builds/edison-intel/edison-bisicles-intel-cmake b/components/cism/glimmer-cism/builds/edison-intel/edison-bisicles-intel-cmake new file mode 100644 index 0000000000..075ca316b0 --- /dev/null +++ b/components/cism/glimmer-cism/builds/edison-intel/edison-bisicles-intel-cmake @@ -0,0 +1,119 @@ +# run this script by typing: source edison-bisicles-intel-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on edison using the INTEL compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to ./../../../BISICLES/CISM-interface/interface ) + +# This script should be run from the builds/edison-intel subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source edison-bisicles-intel-cmake +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake +module load PrgEnv-intel +module load cray-hdf5-parallel +module load cray-netcdf-hdf5parallel +module load python +module load cray-shmem +module load cray-mpich +module unload darshan + +# (hopefully) temporary fix for PKG_CONFIG_PATH problem +source PKG_CONFIG_PATH_fix.csh + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/Trilinos/edison-intel-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/libgptl/libgptl-edison-intel \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE" \ + -D BISICLES_LIB_SUBDIR=libintel \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_intel_parallel -lz" \ + +# -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ diff --git a/components/cism/glimmer-cism/builds/edison-intel/edison-intel-cmake b/components/cism/glimmer-cism/builds/edison-intel/edison-intel-cmake new file mode 100644 index 0000000000..3758525c81 --- /dev/null +++ b/components/cism/glimmer-cism/builds/edison-intel/edison-intel-cmake @@ -0,0 +1,121 @@ +# run this script by typing: source edison-intel-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on edison using the INTEL compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to ./../../../BISICLES/CISM-interface/interface ) + +# This script should be run from the builds/edison-intel subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source edison-intel-cmake +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake +module load PrgEnv-intel +module load cray-hdf5-parallel +module load cray-netcdf-hdf5parallel +module load python +module load cray-shmem +module load cray-mpich + +module unload darshan + +# (hopefully) temporary fix for PKG_CONFIG_PATH problem +source PKG_CONFIG_PATH_fix.csh + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/Trilinos/edison-intel-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ + -D CISM_FMAIN=/opt/intel/composer_xe_2013.5.192/compiler/lib/intel64/for_main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/libgptl/libgptl-edison-intel \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -openmp" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -openmp" \ + -D BISICLES_LIB_SUBDIR=libintel \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_intel_parallel -lz" \ + +# -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ diff --git a/components/cism/glimmer-cism/builds/edison-intel/edison-petsc-bisicles-intel-cmake b/components/cism/glimmer-cism/builds/edison-intel/edison-petsc-bisicles-intel-cmake new file mode 100644 index 0000000000..c93c270246 --- /dev/null +++ b/components/cism/glimmer-cism/builds/edison-intel/edison-petsc-bisicles-intel-cmake @@ -0,0 +1,120 @@ +# run this script by typing: source edison-petsc-bisicles-intel-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on edison using the INTEL compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to ./../../../BISICLES/CISM-interface/interface ) + +# This script should be run from the builds/edison-intel subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source edison-petsc-bisicles-intel-cmake +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake +module load PrgEnv-intel +module load cray-hdf5-parallel +module load cray-netcdf-hdf5parallel +module load python +module load cray-shmem +module load cray-mpich +module unload darshan + +# (hopefully) temporary fix for PKG_CONFIG_PATH problem +source PKG_CONFIG_PATH_fix.csh + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/Trilinos/edison-intel-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/libgptl/libgptl-edison-intel \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE" \ + -D CISM_EXTRA_LIBS:STRING="-L$PETSC_DIR/$PETSC_ARCH/lib -lpetsc -lHYPRE -lpthread -ldl -lssl -lcrypto" \ + -D BISICLES_LIB_SUBDIR=libintel \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_intel_parallel -lz" \ + +# -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ diff --git a/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-bisicles-cmake b/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-bisicles-cmake new file mode 100755 index 0000000000..66c13af737 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-bisicles-cmake @@ -0,0 +1,121 @@ +# run this script by typing: source hopper-gnu-bisicles-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the gnu compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-gnu-bisicles-cmake +echo + +#echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +#echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +#echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +#echo module unload python +#echo module load python/2.7.1 +#echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +module --silent purge + +#module unload cmake netcdf-hdf5parallel/4.2.0 python +#module swap PrgEnv-pgi PrgEnv-gnu; module load cmake/2.8.7 python netcdf-hdf5parallel/4.2.0 usg-default-modules/1.0 + +module load modules/3.2.6.6 +module load cmake/2.8.7 +module load PrgEnv-gnu/4.2.34 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel +module load python/2.7.5 + + +module load torque/4.2.3.h5_notcpretry + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D ALBANY_BUILD_DIR="/project/projectdirs/piscees/albany/albany-cism-build" \ + -D ALBANY_BASE_DIR="/project/projectdirs/piscees/albany/albany-felix-src" \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/GNU/48 \ + -D CISM_MPI_BASE_DIR=/opt/cray/mpt/6.0.1/gni/mpich2-gnu/48 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE -ffree-line-length-none " \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D CISM_GNU:BOOL=ON \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + ../.. +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-felix-cmake b/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-felix-cmake new file mode 100755 index 0000000000..305f07a22f --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu-felix/hopper-gnu-felix-cmake @@ -0,0 +1,115 @@ +# run this script by typing: source hopper-gnu-felix-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the PGI compiler suite. It relies on a build of Trilinos +# located in /global/project/projectdirs/piscees, and a build of BISICLES +# located in the ranken home directory: /global/u1/r/ranken/BISICLES + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-gnu-felix-cmake +echo + +#echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +#echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +#echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +#echo module unload python +#echo module load python/2.7.1 +#echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +module --silent purge + +#module unload cmake netcdf-hdf5parallel/4.2.0 python +#module swap PrgEnv-pgi PrgEnv-gnu; module load cmake/2.8.7 python netcdf-hdf5parallel/4.2.0 usg-default-modules/1.0 + +module load modules/3.2.6.6 +module load cmake/2.8.7 +module load PrgEnv-gnu/4.1.40 +module load hdf5-parallel/1.8.8 +module load python/2.7.1 +module load cray-shmem/5.5.2 +module load cray-mpich2/5.5.2 +module load torque/4.2.3.h5_notcpretry + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D ALBANY_BUILD_DIR="/project/projectdirs/piscees/albany/albany-cism-build" \ + -D ALBANY_BASE_DIR="/project/projectdirs/piscees/albany/albany-felix-src" \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf/4.3.0/GNU/47 \ + -D CISM_MPI_BASE_DIR=/opt/cray/mpt/5.6.4/gni/mpich2-gnu/47 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS="-ffree-line-length-none" \ + -D CISM_GNU:BOOL=ON \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + ../.. +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-gnu/hopper-bisicles-gnu-cmake b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-bisicles-gnu-cmake new file mode 100644 index 0000000000..7f9d6e104d --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-bisicles-gnu-cmake @@ -0,0 +1,122 @@ +# run this script by typing: source hopper-bisicles-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the gnu compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-bisicles-gnu-cmake +echo +echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +echo module unload python +echo module load python/2.7.1 +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load PrgEnv-gnu/4.1.40 + +module load modules/3.2.6.6 +module load cmake/2.8.7 +module load hdf5-parallel/1.8.8 +module load python/2.7.1 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 +module load torque/4.2.3.h5_notcpretry + +#temporary fix for HDF5 error: +module swap gcc gcc/4.7.2 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D ALBANY_FELIX_DYCORE:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf/4.3.0/GNU/47 \ + -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5/1.8.11/GNU/47/lib \ + -D CISM_MPI_BASE_DIR=/opt/cray/mpt/5.6.4/gni/mpich2-gnu/47 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE -ffree-line-length-none " \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D CISM_GNU:BOOL=ON \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test-serial.csh b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test-serial.csh new file mode 100644 index 0000000000..f879e914c3 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test-serial.csh @@ -0,0 +1,155 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/hopper-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = hopper + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-serial-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +set CISM_RUN_SCRIPT = 'hopjob' +#set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'carver_VV.bash' +#set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +if ( -e example-drivers/simple_glide/src/simple_glide ) then + echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' + cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test.csh b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test.csh new file mode 100644 index 0000000000..36339c26c5 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-build-and-test.csh @@ -0,0 +1,155 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/hopper-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = hopper + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +set CISM_RUN_SCRIPT = 'hopjob' +#set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'carver_VV.bash' +#set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +if ( -e example-drivers/simple_glide/src/simple_glide ) then + echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' + cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-cmake b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-cmake new file mode 100644 index 0000000000..4be3adaf36 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-cmake @@ -0,0 +1,126 @@ +# run this script by typing: source hopper-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the gnu compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source hopper-gnu-cmake +echo + +module unload cmake +module unload hdf5 +module unload hdf5-parallel cray-hdf5-parallel +module unload netcdf cray-netcdf-hdf5parallel +module unload python +module unload cray-shmem +module unload cray-mpich2 +module unload boost gcc +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules/3.2.6.6 +module load cmake/2.8.10.2 +module load PrgEnv-gnu/4.2.34 +module load gcc/4.8.1 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel +module load python/2.7.5 +module load boost + +module load torque/4.2.3.h5_notcpretry + +#temporary fix for HDF5 error: +#module swap gcc gcc/4.7.2 + +module list + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D ALBANY_FELIX_DYCORE:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/Trilinos/hopper-gnu-cism-albany-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/GNU/48 \ + -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5/1.8.11/GNU/48/lib \ + -D CISM_MPI_BASE_DIR=/opt/cray/mpt/6.0.1/gni/mpich2-gnu/48 \ +\ + -D CISM_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/libgptl/libgptl-hopper-gnu_4.8.1 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -ffree-line-length-none " \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D CISM_GNU:BOOL=ON \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ + + diff --git a/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-serial-cmake b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-serial-cmake new file mode 100644 index 0000000000..c1fcf742db --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-gnu/hopper-gnu-serial-cmake @@ -0,0 +1,125 @@ +# run this script by typing: source hopper-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the gnu compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-bisicles-gnu-cmake +echo +echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +echo module unload python +echo module load python/2.7.1 +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load PrgEnv-gnu/4.1.40 + +module load modules/3.2.6.6 +module load cmake/2.8.7 +module load hdf5-parallel/1.8.8 +module load python/2.7.1 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 +module load torque/4.2.3.h5_notcpretry + +#temporary fix for HDF5 error: +module swap gcc gcc/4.7.2 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D ALBANY_FELIX_DYCORE:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/Trilinos/hopper-gnu-cism-albany-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos/trilinos-albany-build/install \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf/4.3.0/GNU/47 \ + -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5/1.8.11/GNU/47/lib \ + -D CISM_MPI_BASE_DIR=/opt/cray/mpt/5.6.4/gni/mpich2-gnu/47 \ +\ + -D CISM_GPTL_DIR=/project/projectdirs/piscees/cism_gptl/libgptl/libgptl-hopper-gnu_4.7.2 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -ffree-line-length-none " \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D CISM_GNU:BOOL=ON \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-pgi/README b/components/cism/glimmer-cism/builds/hopper-pgi/README new file mode 100644 index 0000000000..fdba356696 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-pgi/README @@ -0,0 +1,59 @@ +README file for the hopper-pgi build directory. + +The cmake configure file hopper-pgi-cmake can be used to build parallel versions of +simple_glide and simple_bisicles, 2 programs that are part of CISM (the Community +Ice Sheet Model). The PGI compiler suite is used for this build. + +Build Instructions: + +Standard Build (uses Trilinos, builds simple_glide, doesn't build simple_bisicles): + +In the builds/hopper-pgi directory, configure for the build using: + +make clean +source hopper-pgi-cmake + + +The configuration process should complete with a final message: +-- Build files have been written to: /seacism/builds/hopper-pgi + +The next step is to use the make program to do the build: +make -j 8 + +--------- + +In the file hopper-pgi-cmake, the first 4 lines of the cmake call can be modified +to configure different builds. These lines are: + -D NO_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ + -D BUILD_SIMPLE_BISICLES:BOOL=OFF \ + +For instance, to build simple_bisicles (and simple_glide), use: + -D NO_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ + -D BUILD_SIMPLE_BISICLES:BOOL=ON \ + +For a serial build of simple_glide, use: + -D NO_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=OFF \ + -D CISM_SERIAL_MODE:BOOL=ON \ + -D BUILD_SIMPLE_BISICLES:BOOL=OFF \ + + +Dependencies: +The packages this build depends on (Trilinos, BISICLES, and Chombo) have already +been built. The paths to these packages can be found in hopper-pgi-cmake. + +Testing: + +simple_glide quick test: +In seacism/tests/higher-order/dome, do: +1) type dome.py, this will give a 'simple glide not found' error +2) qsub -I -V -q interactive -l mppwidth=4 +3) aprun -n 4 ...hopper-config/example_drivers/simple_glide/src/simple_glide dome.9_5_2012.config + + +simple_bisicles quick test: +TBD. diff --git a/components/cism/glimmer-cism/builds/hopper-pgi/hopper-bisicles-pgi-cmake b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-bisicles-pgi-cmake new file mode 100644 index 0000000000..8d4cc6b39b --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-bisicles-pgi-cmake @@ -0,0 +1,128 @@ +# run this script by typing: source hopper-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the PGI compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-bisicles-pgi-cmake +echo +echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +echo module unload python +echo module load python/2.7.1 +echo +#echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +#echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +#echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +#echo module unload python +#echo module load python/2.7.1 +#echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake/2.8.10.1 +module load PrgEnv-pgi/4.2.34 +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python/2.7.5 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-gptl/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ + -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/ccsm1/libgptl/libgptl-pgi \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=OFF \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-pgi/hopper-petsc-bisicles-pgi-cmake b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-petsc-bisicles-pgi-cmake new file mode 100644 index 0000000000..a65c4b4c3c --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-petsc-bisicles-pgi-cmake @@ -0,0 +1,122 @@ +# run this script by typing: source hopper-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the PGI compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-petsc-bisicles-pgi-cmake +echo +#echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +#echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +#echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +#echo module unload python +#echo module load python/2.7.1 +#echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake/2.8.10.1 +module load PrgEnv-pgi/4.2.34 +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python/2.7.5 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-gptl/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ + -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/ccsm1/libgptl/libgptl-pgi \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -g --diag_suppress 554,111,611 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -g -DNO_RESCALE" \ + -D CISM_EXTRA_LIBS:STRING="-L$PETSC_DIR/$PETSC_ARCH/lib -lpetsc -lHYPRE -lparmetis -lmetis -llapack -lblas -lpthread -ldl" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=OFF \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-build-and-test.csh b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-build-and-test.csh new file mode 100644 index 0000000000..e493d23b68 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-build-and-test.csh @@ -0,0 +1,155 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/hopper-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = pgi +set PLATFORM_NAME = hopper + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +set CISM_RUN_SCRIPT = 'hopjob' +#set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'carver_VV.bash' +#set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +if ( -e example-drivers/simple_glide/src/simple_glide ) then + echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' + cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-cmake b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-cmake new file mode 100755 index 0000000000..35641cfa71 --- /dev/null +++ b/components/cism/glimmer-cism/builds/hopper-pgi/hopper-pgi-cmake @@ -0,0 +1,123 @@ +# run this script by typing: source hopper-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on hopper using the PGI compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to /global/u2/d/dmartin/BISICLES/code/interface) + + +# This script should be run from the builds/hopper-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source hopper-pgi-cmake +echo +echo Warning: Python problem. After the last hopper system updates 1/28/13, in order to run simple_glide +echo or simple_bisicles, you need to replace the python/2.7.3 module with the python/2.7.1 module. +echo The easiest way to do this: In your .cshrc.ext or .bashrc.ext add the lines: +echo module unload python +echo module load python/2.7.1 +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload cray-hdf5-parallel +module unload cray-netcdf-hdf5parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake/2.8.10.1 +module load PrgEnv-pgi/4.2.34 +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python/2.7.5 +module load cray-shmem/6.0.1 +module load cray-mpich/6.0.1 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-gptl/install \ + -D CISM_TRILINOS_ALBANY_DIR=/project/projectdirs/piscees/trilinos-default/hopper-pgi-albany/install \ +\ + -D CISM_NETCDF_DIR=$NETCDF_DIR \ + -D CISM_FMAIN=/opt/pgi/13.6.0/linux86-64/13.6/lib/f90main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CISM_MPI_BASE_DIR=$CRAY_MPICH2_DIR \ + -D CISM_SCI_LIB_DIR=$CRAY_LIBSCI_PREFIX_DIR/lib \ + -D CISM_GPTL_DIR=/project/projectdirs/ccsm1/libgptl/libgptl-pgi \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory + + +# -D CISM_TRILINOS_DIR=/global/project/projectdirs/piscees/trilinos-default/hopper-pgi/install \ +# -D CISM_TRILINOS_DIR=/project/projectdirs/piscees/trilinos/hopper-pgi-ci-nophal/install \ + + +# -D CMAKE_PREFIX_PATH="$HDF5_DIR" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=$HDF5_DIR/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/linux-gnu-bisicles/build_simple_bisicles b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/build_simple_bisicles new file mode 100755 index 0000000000..62dd7b3d80 --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/build_simple_bisicles @@ -0,0 +1,18 @@ +#!/bin/sh + +CHOMBO_DIR=${PWD}/../../../Chombo +BISICLES_DIR=${PWD}/../../../BISICLES/code/interface +CISM_DIR=${PWD}/../.. +CISM_CMAKE_BUILD_DIR=${PWD} + +#first run cmake script +# ./linux-gnu-bisicles-cmake + +#now run script in BISICLES directory +cd ${BISICLES_DIR} +./build_simple_bisicles + +#finally, return here and move executable to a more convenient place +#(in lieu of a formal "install" target +cd ${CISM_CMAKE_BUILD_DIR} +mv ${CISM_CMAKE_BUILD_DIR}/example-drivers/simple_bisicles/src/simple_bisicles ${CISM_DIR}/bin diff --git a/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-cmake b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-cmake new file mode 100755 index 0000000000..bdeae0aca1 --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-cmake @@ -0,0 +1,63 @@ +# run this script by typing: source hopper-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver + + +# This script should be run from the builds/linux-gnu-bisicles subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +#popd + +echo +echo "Doing CMake Configuration step" + +#set Netcdf installation directory here +#setenv NETCDF_HOME /home/loren/users/dmartin/util/netcdf/netcdf-4.1.2 +#setenv NETCDF_HOME /usr/local/netcdf +setenv NETCDF_HOME ${NETCDFHOME} + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_NETCDF_DIR=${NETCDF_HOME} \ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=mpiCC \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CISM_HDF5_LIB_DIR=${ANAG_HDF5_DIR}/lib \ + -D CISM_HDF5_LIBS="-DH5_USE_16_API -lhdf5 -lz -lstdc++" \ + -D CMAKE_PREFIX_PATH="${ANAG_HDF5_DIR}" \ +\ + -D CMAKE_CXX_FLAGS:STRING="-g -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-g -ffree-line-length-none -fno-range-check -DNO_RESCALE" \ + -D CISM_EXTRA_LIBS:STRING="-lblas" \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D BISICLES_LIB_SUBDIR=libgnu \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory diff --git a/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-petsc-cmake b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-petsc-cmake new file mode 100755 index 0000000000..dc1d729fec --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-bisicles/linux-gnu-bisicles-petsc-cmake @@ -0,0 +1,63 @@ +# run this script by typing: source hopper-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver + + +# This script should be run from the builds/linux-gnu-bisicles subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +#popd + +echo +echo "Doing CMake Configuration step" + +#set Netcdf installation directory here +#setenv NETCDF_HOME /home/loren/users/dmartin/util/netcdf/netcdf-4.1.2 +#setenv NETCDF_HOME /usr/local/netcdf +setenv NETCDF_HOME ${NETCDFHOME} + +cmake \ + -D CISM_NETCDF_DIR=${NETCDFHOME} \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=mpiCC \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=/usr/bin/mpif90 \ +\ + -D CISM_HDF5_LIB_DIR=${ANAG_HDF5_DIR}/lib \ + -D CISM_HDF5_LIBS="-DH5_USE_16_API -lhdf5 -lz -lstdc++" \ + -D CMAKE_PREFIX_PATH="${ANAG_HDF5_DIR}" \ +\ + -D CMAKE_CXX_FLAGS:STRING="-g -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-g -ffree-line-length-none -fno-range-check -DNO_RESCALE" \ + -D CISM_EXTRA_LIBS:STRING="-L$PETSC_DIR/$PETSC_ARCH/lib -lpetsc -llapack -lblas" \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D BISICLES_LIB_SUBDIR=libgnu \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory diff --git a/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake b/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake new file mode 100755 index 0000000000..4cb94b9be6 --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake @@ -0,0 +1,67 @@ +# cmake configuration script that works on the Linux box in Matt's office (blueskies) with GCC +# Others will need to modify the Netcdf path. +# This config script is setup to perform a parallel build with Trilinos. +# +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +# After this executes, do: +# make -j 8 +# + +echo +echo Run this script by typing: source linux-gnu-cism-cmake +echo +echo Set CISM_TRILINOS_DIR to your Trilinos installation directory. +echo + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_TRILINOS_DIR=$CISM_TRILINOS_DIR \ + -D CISM_NETCDF_DIR="/usr" \ + -D CISM_NETCDF_LIBS="netcdff" \ +\ + -D CMAKE_Fortran_FLAGS="-g -O2 -ffree-line-length-none -fPIC -fno-range-check" \ +\ + -D CMAKE_CXX_COMPILER=mpicxx \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CISM_EXTRA_LIBS:STRING="-lblas" \ +\ + -D CISM_MPI_INC_DIR=/usr/lib/openmpi/lib \ + -D CISM_MPI_LIB_DIR=/usr/lib/openmpi/lib \ +\ + -D CMAKE_VERBOSE_MAKEFILE=OFF \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory + diff --git a/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake-serial b/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake-serial new file mode 100755 index 0000000000..c2b9f3e551 --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-cism/linux-gnu-cism-cmake-serial @@ -0,0 +1,71 @@ +# cmake configuration script that works on the Linux box in Matt's office (blueskies) with GCC +# Others will need to modify the Netcdf path. +# This config script is setup to perform a serial build without Trilinos. +# +# BUILD OPTIONS: +# The call to cmake below include several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# NO_TRILINOS -- OFF by default, set to on for builds without Trilinos +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_BUILD_SIMPLE_GLIDE -- ON by default, set to OFF to not build simple_glide +# CISM_BUILD_SIMPLE_BISICLES -- OFF by default, set to ON to build simple_bisicles +# Setting NO_TRILINOS to ON will generate a much smaller executable for this build. +# CISM_BUILD_EXTRA_EXECUTABLES -- OFF by default, set to ON to build eis_glide and others +# CISM_USE_GPTL_INSTRUMENTATION -- OFF by default, set to ON to use GPTL instrumentation + +# Serial Build Notes: Setting NO_TRILINOS=ON, CISM_MPI_MODE=OFF, CISM_SERIAL_MODE=ON will +# configure for a serial build. (Note that the openmpi compilers will be used, but act as +# pass-throughs to the underlying serial compilers in this case. If MPI is not installed, +# set the serial compilers directly.) + +# NOTE: There is currently an incompatibility between simple_bisicles and GPTL. If +# the CISM_BUILD_SIMPLE_BISICLES is ON, the GPTL instrumentation is turned OFF. + + +# After this executes, do: +# make -j 8 +# + +echo +echo Run this script by typing: source linux-gnu-cism-cmake-serial +echo + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=OFF \ + -D CISM_SERIAL_MODE:BOOL=ON \ + -D CISM_BUILD_CISM_DRIVER=ON \ + -D CISM_BUILD_SIMPLE_GLIDE:BOOL=OFF \ + -D CISM_BUILD_SIMPLE_BISICLES:BOOL=OFF \ + -D CISM_BUILD_GLINT_EXAMPLE:BOOL=OFF \ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_USE_DEFAULT_IO:BOOL=OFF \ + -D CISM_USE_CISM_FRONT_END:BOOL=ON \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_NETCDF_DIR="/usr" \ + -D CISM_NETCDF_LIBS="netcdff" \ +\ + -D CMAKE_Fortran_FLAGS="-g -O2 -ffree-line-length-none -fPIC -fno-range-check" \ +\ + -D CMAKE_CXX_COMPILER=g++ \ + -D CMAKE_C_COMPILER=gcc \ + -D CMAKE_Fortran_COMPILER=gfortran \ +\ + -D CISM_EXTRA_LIBS:STRING="-lblas" \ +\ + -D CMAKE_VERBOSE_MAKEFILE=OFF \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory + diff --git a/components/cism/glimmer-cism/builds/linux-gnu-felix/linux-gnu-felix-cmake b/components/cism/glimmer-cism/builds/linux-gnu-felix/linux-gnu-felix-cmake new file mode 100755 index 0000000000..a77cc9e5aa --- /dev/null +++ b/components/cism/glimmer-cism/builds/linux-gnu-felix/linux-gnu-felix-cmake @@ -0,0 +1,41 @@ +# cmake configuration script that works on Andy's Linux box with GCC +# Others will need to modify the Trilinos and Netcdf paths. +# This script needs to be run from a subdirectory (e.g. build-linux) +# of the main seacism repository (reflected in the several instances of +# ".." below). + +# After this executes, do: +# make -j 8 +# cp example-drivers/simple_glide/src/sgcmake . +# + +rm ./CMakeCache.txt + +echo +echo "Doing CMake Configuration step" + +TRILINOS_DIR=/home/ikalash/Trilinos_Albany/Trilinos/build/install +ALBANY_DIR=/home/ikalash/Desktop/clean/Albany/cism-build/install +NETCDF_DIR=/home/ikalash/Install/netcdf-4.0.1 + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +# Note: last argument above ".." is path to top seacism directory +# -D ALBANY_BUILD_DIR="/home/ikalash/Desktop/clean/Albany_clean/build_cism" \ +# -D ALBANY_BASE_DIR="/home/ikalash/Desktop/clean/Albany_clean" \ + +#About the DEBUG_OUTPUT_VERBOSITY: +#-D DEBUG_OUTPUT_VERBOSITY:INT=O \ No debug output +#-D DEBUG_OUTPUT_VERBOSITY:INT=1 \ Minimal debug output +#-D DEBUG_OUTPUT_VERBOSITY:INT=2 \ Maximal debug output +#It is set to 1 by default. +#It is set to 1 by default. diff --git a/components/cism/glimmer-cism/builds/mac-gnu-serial/mac-gnu-cmake-serial b/components/cism/glimmer-cism/builds/mac-gnu-serial/mac-gnu-cmake-serial new file mode 100644 index 0000000000..99da0a7219 --- /dev/null +++ b/components/cism/glimmer-cism/builds/mac-gnu-serial/mac-gnu-cmake-serial @@ -0,0 +1,87 @@ +# run this script by typing: source mac-gnu-cmake-serial +# After this script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds simple_glide, and if you enable it below, +# and cism_driver on a Mac using the Gnu compiler suite. +# This build is serial. See the mac-gnu directory for a parallel build. +# Trilinos is not used. + +# This script should be run from the builds/mac-gnu subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# + +# BUILD OPTIONS: +# The call to cmake below include several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_SERIAL_MODE -- OFF by default, set to ON here for a serial build. +# CISM_MPI_MODE -- ON by default, set to OFF here for a serial build. +# CISM_USE_TRILINOS -- Set OFF below to exclude Trilinos from the build. +# CISM_BUILD_SIMPLE_GLIDE -- ON by default, set to OFF to not build simple_glide +# CISM_BUILD_SIMPLE_BISICLES -- OFF by default, set to ON to build simple_bisicles +# Setting NO_TRILINOS to ON will generate a much smaller executable for this build. +# CISM_BUILD_EXTRA_EXECUTABLES -- OFF by default, set to ON to build eis_glide and others +# CISM_USE_GPTL_INSTRUMENTATION -- OFF by default, set to ON to use GPTL instrumentation + +# Serial Build Notes: Setting CISM_USE_TRILINOS=OFF, CISM_MPI_MODE=OFF, CISM_SERIAL_MODE=ON will +# configure for a serial build. (Note that the openmpi compilers will be used if specified, but act as +# pass-throughs to the underlying serial compilers in this case. If MPI is not installed, +# set the serial compilers directly.) + +# You may need to manually set the NETCDF_PATH variable below to point to your NetCDF installation. +# If you have NetCDF installed with MacPorts, you can use that by setting it to "/opt/local" +# (assuming default MacPorts installation location). + +# NOTE: There is currently an incompatibility between simple_bisicles and GPTL. If +# the CISM_BUILD_SIMPLE_BISICLES is ON, the GPTL instrumentation is turned OFF. + +echo +echo Run this script by typing: source mac-cmake +echo + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +NETCDF_PATH="/opt/local" + +cmake \ + -D CISM_SERIAL_MODE:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=OFF \ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_BUILD_SIMPLE_GLIDE:BOOL=OFF \ + -D CISM_BUILD_SIMPLE_BISICLES:BOOL=OFF \ + -D CISM_BUILD_GLINT_EXAMPLE:BOOL=OFF \ + -D CISM_BUILD_EXTRA_EXECUTABLES:BOOL=OFF \ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_USE_DEFAULT_IO:BOOL=OFF \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_NETCDF_DIR=$NETCDF_PATH \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=gxx \ + -D CMAKE_C_COMPILER=gcc \ + -D CMAKE_Fortran_COMPILER=gfortran \ +\ +\ + -D CMAKE_CXX_FLAGS:STRING="-g " \ + -D CMAKE_Fortran_FLAGS="-g -O3 -ffree-line-length-none -fbacktrace" \ +\ + -D CISM_EXTRA_LIBS="-lblas" \ +\ +\ + ../.. + +# Note: last argument above "../.." is path to top seacism directory diff --git a/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-build-and-test.csh b/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-build-and-test.csh new file mode 100644 index 0000000000..c703aa2018 --- /dev/null +++ b/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-build-and-test.csh @@ -0,0 +1,160 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/titan-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + + +setenv QUICK_TEST nope +if (($1 == quick-test) || ($2 == quick-test) || ($3 == quick-test) || ($4 == quick-test) || ($5 == quick-test)) then + setenv QUICK_TEST quick-test +endif + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = mac + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +#set CISM_RUN_SCRIPT = 'hopjob' +set CISM_RUN_SCRIPT = './macjob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'mac_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +#if ( -e example-drivers/simple_glide/src/simple_glide ) then +# echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' +# cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +#else +# echo "cmake '$COMPILER_NAME' build failed, no executable" +# @ build_problem = 1 +#endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME + + #copy cism_driver to simple_glide, until macjob scripts have been changed: + cp -f cism_driver/cism_driver $TEST_DIR/simple_glide_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT $QUICK_TEST + diff --git a/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-cmake b/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-cmake new file mode 100644 index 0000000000..17f11eaa8f --- /dev/null +++ b/components/cism/glimmer-cism/builds/mac-gnu/mac-gnu-cmake @@ -0,0 +1,78 @@ +# run this script by typing: source mac-gnu-cmake +# After this script completes, type: make -j 8 + +# This script is also used by mac-gnu-build-and-test.csh. + +# This cmake configuration script builds cism_driver on a Mac using the Gnu compiler suite. +# If Trilinos is used, it relies on a build of Trilinos located in $CISM_TRILINOS_DIR (set below). +# If BISICLES is used, it relies on a build of BISICLES located in $BISICLES_INTERFACE_DIR (set below). + +# This script should be run from the builds/mac-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +# Serial Build Notes: Setting CISM_USE_TRILINOS=OFF, CISM_MPI_MODE=OFF, CISM_SERIAL_MODE=ON will +# configure for a serial build. (Note that the openmpi compilers will be used, but act as +# pass-throughs to the underlying serial compilers in this case. If MPI is not installed, +# set the serial compilers directly.) + +echo +echo Run this script by typing: source mac-gnu-cmake +echo +echo Set CISM_TRILINOS_DIR to your Trilinos installation directory. +echo + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_GNU=ON \ +\ + -D CISM_TRILINOS_DIR=$CISM_TRILINOS_DIR \ + -D CISM_NETCDF_DIR=/opt/local \ + -D CISM_MPI_BASE_DIR=/opt/local \ + -D CISM_MPI_INC_DIR=/opt/local/lib \ + -D CISM_EXTRA_LIBS="-lblas" \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=mpicxx \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CMAKE_CXX_FLAGS="" \ + -D CMAKE_Fortran_FLAGS="-g -O2 -ffree-line-length-none" \ +\ + -D BISICLES_INTERFACE_DIR=~/BISICLES/CISM-interface/interface \ + ../.. + +# Note: last argument above "../.." is path to top CISM directory diff --git a/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test-serial.csh b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test-serial.csh new file mode 100644 index 0000000000..5baef63823 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test-serial.csh @@ -0,0 +1,284 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/mac-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests)) +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /global/scratch2/sd/$USER/cism2/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = titan + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-serial-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +#set CISM_RUN_SCRIPT = 'hopjob' +set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making serial '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +#if ( -e example-drivers/simple_glide/src/simple_glide ) then +# echo 'Copying '$COMPILER_NAME' simple_glide_serial to test directory' +# cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_serial +#else +# echo "cmake '$COMPILER_NAME' build failed, no executable" +# @ build_problem = 1 +#endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' cism_driver_serial to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_serial +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + + +if ($build_problem == 1 ) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy)) + + # Make copy of test suite in $TEST_DIR: +if (!($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + + if (($1 == "skip-tests") || ($2 == "skip-tests") || ($3 == "skip-tests") || ($4 == "skip-tests")) then + echo "Skipping tests." + exit + endif + + echo 'Submitting test jobs to compute nodes.' + + setenv run_all_tests 1 + if (($1 == "quick-test") || ($2 == "quick-test") || ($3 == "quick-test") || ($4 == "quick-test")) then + setenv run_all_tests 0 + endif + + + + + #diagnostic dome test case + cd $TEST_DIR/reg_test/dome30/diagnostic + qsub $CISM_RUN_SCRIPT + + + if ($run_all_tests == 1) then + + #evolving dome test case + cd $TEST_DIR/reg_test/dome30/evolving + qsub $CISM_RUN_SCRIPT + + # confined shelf to periodic BC + cd $TEST_DIR/reg_test/confined-shelf + qsub $CISM_RUN_SCRIPT + + # circular shelf to periodic BC + cd $TEST_DIR/reg_test/circular-shelf + qsub $CISM_RUN_SCRIPT + + # ISMIP test case A, 80 km + cd $TEST_DIR/reg_test/ismip-hom-a/80km + qsub $CISM_RUN_SCRIPT + + # ISMIP test case A, 20 km + cd $TEST_DIR/reg_test/ismip-hom-a/20km + qsub $CISM_RUN_SCRIPT + + ## ISMIP test case C, 80 km - not operational for glide + cd $TEST_DIR/reg_test/ismip-hom-c/80km + qsub $CISM_RUN_SCRIPT + + ## ISMIP test case C, 20 km - not operational for glide + cd $TEST_DIR/reg_test/ismip-hom-c/20km + qsub $CISM_RUN_SCRIPT + endif + + if ($PERF_TEST == 0 ) then + echo "No performance suite jobs were submitted." + else + echo 'Submitting performance jobs to compute nodes.' + echo 'Go to rhea to complete Visualization and Verification (LIVV)' + + #dome 60 test case + cd $TEST_DIR/perf_test/dome60 + qsub $CISM_RUN_SCRIPT + + #dome 120 test case + cd $TEST_DIR/perf_test/dome120 + qsub $CISM_RUN_SCRIPT + + #dome 240 test case + cd $TEST_DIR/perf_test/dome240 + qsub $CISM_RUN_SCRIPT + + #dome 500 test case + cd $TEST_DIR/perf_test/dome500 + qsub $CISM_RUN_SCRIPT + + #dome 1000 test case - not operational currently + # cd $TEST_DIR/perf_test/dome1000 + # qsub $CISM_RUN_SCRIPT + + #gis 4km test case + # cd $TEST_DIR/perf_test/gis_4km + # qsub $CISM_RUN_SCRIPT + + #gis 2km test case + # cd $TEST_DIR/perf_test/gis_2km + # qsub $CISM_RUN_SCRIPT + + #gis 1km test case + # cd $TEST_DIR/perf_test/gis_1km + # qsub $CISM_RUN_SCRIPT + endif +endif + + + echo + echo "Test Suite jobs started -- using qstat to monitor." + echo + + set still_running = 1 + set counter = 0 + set timeout_error = 0 + + set run_list = "dome_30_test dome_30_evolve conf_shelf circ_shelf ishoma_80 ishoma_20 dome_60_test dome_120_test dome_240_test dome_500_test dome_1000_test" + + while ($still_running) + set ls_out = `qstat | grep $USER` + + set found = 0 + foreach cur ($run_list) + foreach elem ($ls_out) + if ("$cur" == "$elem") then + if (($counter % 5) == 0) echo "Still running: $cur" + set found = 1 + endif + # if ($found == 1) break + end + end + if ($found == 0) then + echo "All jobs completed." + set still_running = 0 + else + sleep 60 + endif + @ counter = $counter + 1 + if ($counter == 120) then + set still_running = 0 + set timeout_error = 1 + echo "Timeout error -- jobs are taking too long. Exiting script." + endif + if (($counter % 5) == 0) echo "Minutes: $counter" + end + + if ($timeout_error == 0) then + echo "Total minutes: $counter" + echo + + echo "Call disabled to: $CISM_VV_SCRIPT, which is located in:" + echo "$TEST_DIR/livv" + echo + echo "Perform this step on rhea after the Test Suite jobs have completed." + # cd $TEST_DIR/livv + # bash $CISM_VV_SCRIPT from-script $1 + endif + + echo + # echo "If there were errors finding ncl, add the ncl installation directory to your PATH in ~/.bashrc." + echo + +endif diff --git a/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test.csh b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test.csh new file mode 100644 index 0000000000..1167f96ba8 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-build-and-test.csh @@ -0,0 +1,154 @@ +#!/bin/csh + + + +# Master build script for mac laptops. Last updated 2/28/2013 by SFP. +# This is a hacked version of Kate's original script for use on Hopper. +# For now, only supports parallel build with Trilinos using gnu and cmake. +# Only a subset of the small, standard tests are run, on both 1 and 4 procs. + +# (1) execute from the builds/titan-gnu subdirectory of CISM + +#add logic at the top to decide which versions to build + +# PARALLEL BUILD WITH CMAKE + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /lustre/atlas/scratch/$USER/cli062/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = gnu +set PLATFORM_NAME = titan + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +#set CISM_RUN_SCRIPT = 'hopjob' +set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +#if ( -e example-drivers/simple_glide/src/simple_glide ) then +# echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' +# cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +#else +# echo "cmake '$COMPILER_NAME' build failed, no executable" +# @ build_problem = 1 +#endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake new file mode 100644 index 0000000000..e50b805c56 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake @@ -0,0 +1,124 @@ +# run this script by typing: source titan-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the GNU compiler suite. + +# This script should be run from the builds/titan-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source titan-gnu-cmake +echo + + +# do this to reduce spurious errors reported purge below: +module unload PrgEnv-gnu PrgEnv-pgi + +module --silent purge + +#module unload cmake +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 +#module unload netcdf-hdf5parallel cray-netcdf-hdf5parallel boost gcc +#module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-gnu +module load gcc/4.8.2 +module load cray-shmem +module load cray-mpich +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.54.0 + +echo module list + +# remove old build data: +rm -rf ./CMakeCache.txt +rm -rf ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ + -D CISM_TRILINOS_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ +\ + -D CISM_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/libgptl/libgptl-titan-gnu \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/GNU/48 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -ffree-line-length-none -fno-range-check" \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# -D CISM_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D CISM_Fortran_FLAGS:STRING="-O2" \ + + +# -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake-newtrilinos b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake-newtrilinos new file mode 100644 index 0000000000..0901aaf86f --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-cmake-newtrilinos @@ -0,0 +1,124 @@ +# run this script by typing: source titan-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the GNU compiler suite. + +# This script should be run from the builds/titan-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source titan-gnu-cmake +echo + + +# do this to reduce spurious errors reported purge below: +module unload PrgEnv-gnu PrgEnv-pgi + +module --silent purge + +#module unload cmake +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 +#module unload netcdf-hdf5parallel cray-netcdf-hdf5parallel boost gcc +#module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-gnu +module load gcc/4.8.2 +module load cray-shmem +module load cray-mpich +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.54.0 + +echo module list + +# remove old build data: +rm -rf ./CMakeCache.txt +rm -rf ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/ccs/proj/cli101/software/Trilinos/Trilinos_gptl/titan-gnu-ci-nophal//install \ + -D CISM_TRILINOS_GPTL_DIR=/ccs/proj/cli101/software/Trilinos/Trilinos_gptl/titan-gnu-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/ccs/proj/cli101/software/Trilinos/trilinos_gptl/titan-gnu-ci-nophal/install \ +\ + -D CISM_GPTL_DIR=/ccs/proj/cli062/cism_gptl/libgptl/libgptl-titan-gnu \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/GNU/48 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -ffree-line-length-none -fno-range-check" \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# -D CISM_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D CISM_Fortran_FLAGS:STRING="-O2" \ + + +# -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-serial-cmake b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-serial-cmake new file mode 100644 index 0000000000..1e2cf794c5 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-gnu/titan-gnu-serial-cmake @@ -0,0 +1,120 @@ +# run this script by typing: source titan-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the GNU compiler suite. + +# This script should be run from the builds/titan-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source titan-gnu-cmake +echo + +module unload PrgEnv-gnu PrgEnv-pgi + +module --silent purge + +#module unload cmake +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 +#module unload netcdf-hdf5parallel cray-netcdf-hdf5parallel boost gcc +#module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-gnu +module load gcc/4.8.2 +module load cray-shmem +module load cray-mpich +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.54.0 + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ + -D CISM_TRILINOS_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-gnu-ci-nophal/install \ +\ + -D CISM_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/libgptl/libgptl-titan-gnu \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/GNU/48 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -ffree-line-length-none -fno-range-check" \ + -D BISICLES_LIB_SUBDIR=libgnu \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# -D CISM_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D CISM_Fortran_FLAGS:STRING="-O2" \ + + +# -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-bisicles-pgi-cmake b/components/cism/glimmer-cism/builds/titan-pgi/titan-bisicles-pgi-cmake new file mode 100644 index 0000000000..c1aa4c78cc --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-bisicles-pgi-cmake @@ -0,0 +1,105 @@ +# run this script by typing: source titan-bisicles-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the PGI compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to a relative path from this directory) + + +# This script should be run from the builds/titan-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source titan-bisicles-pgi-cmake +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake +module load PrgEnv-pgi/ +module load hdf5-parallel +module load netcdf-hdf5parallel +module load python +module load cray-shmem +module load cray-mpich + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.2.0/pgi/119 \ + -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -DNO_RESCALE" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-glissade-only-pgi-cmake-cesmtimers b/components/cism/glimmer-cism/builds/titan-pgi/titan-glissade-only-pgi-cmake-cesmtimers new file mode 100755 index 0000000000..b0a8fb0f39 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-glissade-only-pgi-cmake-cesmtimers @@ -0,0 +1,131 @@ +# run this script by typing: source titan-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds simple_glide and simple_bisicles +# on titan using the PGI compiler suite. + +# This script should be run from the builds/titan-pgi subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below include several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# NO_TRILINOS -- OFF by default, set to on for builds without Trilinos +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_BUILD_SIMPLE_GLIDE -- ON by default, set to OFF to not build simple_glide +# CISM_BUILD_SIMPLE_BISICLES -- OFF by default, set to ON to build simple_bisicles +# Setting NO_TRILINOS to ON will generate a much smaller executable for this build. +# CISM_BUILD_EXTRA_EXECUTABLES -- OFF by default, set to ON to build eis_glide and others +# CISM_USE_GPTL_INSTRUMENTATION -- OFF by default, set to ON to use GPTL instrumentation + +# NOTE: There is currently an incompatibility between simple_bisicles and GPTL. If +# the CISM_BUILD_SIMPLE_BISICLES is ON, the GPTL instrumentation is turned OFF. + +# help user get the correct modules loaded: + + +# module unload modules + +echo +echo Run this script by typing: source titan-pgi-cmake +echo + +module unload cmake +module unload cray-hdf5 +module unload cray-hdf5-parallel +module unload netcdf +module unload python +module unload cray-shmem +module unload cray-mpich cray-mpich2 +module unload netcdf-hdf5parallel boost pgi +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +# Commented out on titan, because of project path that get cleared +# if you do this: +# module --silent purge + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-pgi/4.1.40 +module load pgi/13.10.0 +module load cray-shmem +module load cray-mpich +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.53.0 + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ +\ + -D CISM_BUILD_SIMPLE_GLIDE:BOOL=ON \ + -D CISM_BUILD_SIMPLE_BISICLES:BOOL=OFF \ + -D CISM_BUILD_GLINT_EXAMPLE:BOOL=OFF \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ +\ + -D CISM_TRILINOS_DIR=/ccs/proj/cli062/Trilinos/cism-standard/default-pgi/install \ + -D CISM_TRILINOS_GPTL_DIR=/ccs/proj/cli062/cism_gptl/Trilinos/titan-pgi-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR= \ +\ + -D CISM_GPTL_DIR=/ccs/proj/cli062/cism_gptl/libgptl/libgptl-titan-pgi \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/pgi/121 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-fast -Kieee --diag_suppress 554,111,611" \ + -D CISM_Fortran_FLAGS:STRING="-fast -Kieee" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# -D GLIMMER_FMAIN=/opt/pgi/13.10.0/linux86-64/13.10/lib/f90main.o \ + +# -D GLIMMER_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D GLIMMER_Fortran_FLAGS:STRING="-O2" \ + + +# -D GLIMMER_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-petsc-bisicles-pgi-cmake b/components/cism/glimmer-cism/builds/titan-pgi/titan-petsc-bisicles-pgi-cmake new file mode 100644 index 0000000000..df5665d26c --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-petsc-bisicles-pgi-cmake @@ -0,0 +1,106 @@ +# run this script by typing: source titan-petsc-bisicles-pgi-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the PGI compiler suite. It no longer relies on a build +# of Trilinos, but does need a BISICLES build located in BISICLES_INTERFACE_DIR +# (currently set to a relative path from this directory) + + +# This script should be run from the builds/titan-pgi subdirectory +# of the main seacism repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. +echo +echo Run this script by typing: source titan-petsc-bisicles-pgi-cmake +echo + +module unload cmake +module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi +module unload hdf5 +module unload hdf5-parallel +module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 + +#module --silent purge + +module load modules +module load cmake +module load PrgEnv-pgi/ +module load cray-hdf5-parallel +module load cray-netcdf-hdf5parallel/4.2.1.1 +#module load python +#module load cray-shmem +#module load cray-mpich + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=ON \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.2.0/pgi/119 \ + -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-O2 -g --diag_suppress 554,111,611 -DH5_USE_16_API" \ + -D CISM_Fortran_FLAGS:STRING="-O2 -g -DNO_RESCALE" \ + -D CISM_EXTRA_LIBS:STRING="-L$PETSC_DIR/$PETSC_ARCH/lib -lpetsc -lHYPRE -lmetis -lparmetis -llapack -lblas" \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-build-and-test.csh b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-build-and-test.csh new file mode 100644 index 0000000000..2854bc3440 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-build-and-test.csh @@ -0,0 +1,143 @@ +#!/bin/csh + +# PARALLEL BUILD WITH CMAKE using PGI + +# setenv TEST_DIR "/USERS/$USER/work/modeling/cism/seacism-oceans11/tests/higher-order" + +# 5/7/2014 DMR -- added performance tests: + +## This will automatically submit dome60-500 ijobs. gis_1km and gis_4km will not be submitted +## automatically because you will have to build and run Felix/Albany on hopper first. Once you do that, +## you can go to lines #193-194, 197-198, 201-202, and uncomment them. +setenv PERF_TEST 0 + +@ run_perf_tests = (($1 == run-perf-tests) || ($2 == run-perf-tests) || ($3 == run-perf-tests) || ($4 == run-perf-tests) || ($5 == run-perf-tests)) + +if ($run_perf_tests) then + setenv PERF_TEST 1 +endif + +@ skip_build_set = (($1 == skip-build) || ($2 == skip-build) || ($3 == skip-build) || ($4 == skip-build) || ($5 == skip-build)) + +@ no_copy_set = (($1 == no-copy) || ($2 == no-copy) || ($3 == no-copy) || ($4 == no-copy) || ($5 == no-copy)) + +@ skip_tests_set = (($1 == skip-tests) || ($2 == skip-tests) || ($3 == skip-tests) || ($4 == skip-tests) || ($5 == skip-tests)) + +#**!move this and source it to your .bashrc (wherever your higher-order directory is located) +#setenv TEST_DIR /global/scratch2/sd/$USER/cism2/higher-order + +if (! -d $TEST_DIR) mkdir -p $TEST_DIR + +setenv TEST_SUITE_DEFAULT_LOC http://oceans11.lanl.gov/cism/livv +#setenv TEST_SUITE_DEFAULT_LOC /ccs/proj/cli062/test_suite + +setenv build_problem 0 + +set COMPILER_NAME = pgi +set PLATFORM_NAME = titan + +# set PLATFORM_NAME = $1 +# set COMPILER_NAME = $2 + +set CMAKE_SCRIPT = $PLATFORM_NAME'-'$COMPILER_NAME'-cmake' +set CMAKE_CONF_OUT = 'conf_'$COMPILER_NAME'.out' +set CMAKE_BUILD_OUT = 'cmake_'$COMPILER_NAME'_build.out' +#set CISM_RUN_SCRIPT = $PLATFORM_NAME'job' +#set CISM_RUN_SCRIPT = 'hopjob' +set CISM_RUN_SCRIPT = 'ijob' +#set CISM_VV_SCRIPT = $PLATFORM_NAME'_VV.bash' +set CISM_VV_SCRIPT = 'rhea_VV.bash' + +echo +echo 'To use this script, type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh' +echo +#echo 'For a quick test (dome only), type: csh '$PLATFORM_NAME'-'$COMPILER_NAME'-build-and-test.csh quick-test' +echo +echo "Call with no-copy to prevent copying of the reg_test and livv defaults." +echo "Call with run-perf-tests to run the performance tests." +echo "Call with skip-tests to skip testing (builds executable and copies it to TEST_DIR)." + + +echo +echo 'See the LIVV documentation for instructions on setting up the test directory (TEST_DIR).' +echo + + +#echo 'The following environment variables must be set: TEST_DIR, GLIMMER_TRILINOS_DIR' +#echo 'Examples (place in .cshrc or .bashrc):' +#echo 'csh, tcsh: setenv GLIMMER_TRILINOS_DIR "/Users/$USER/Trilinos/gcc-build/install"' +#echo 'bash: export GLIMMER_TRILINOS_DIR="/Users/$USER/Trilinos/gcc-build/install"' +echo +echo 'Setting TEST_DIR to the location: ' +echo 'TEST_DIR =' $TEST_DIR +echo 'TEST_DIR must also be set in your .bashrc file.' + +# PARALLEL BUILD WITH CMAKE + + +if ($skip_build_set == 0) then + +echo +echo "Configuring and building in directory: " $PWD +echo + +echo 'Configuring '$COMPILER_NAME' cmake build...' +source ./$CMAKE_SCRIPT >& $CMAKE_CONF_OUT +echo 'Making parallel '$COMPILER_NAME'...' +make -j 8 >& $CMAKE_BUILD_OUT + +#if ( -e example-drivers/simple_glide/src/simple_glide ) then +# echo 'Copying '$COMPILER_NAME' parallel simple_glide_'$COMPILER_NAME' to test directory' +# cp -f example-drivers/simple_glide/src/simple_glide $TEST_DIR/simple_glide_$COMPILER_NAME +#else +# echo "cmake '$COMPILER_NAME' build failed, no executable" +# @ build_problem = 1 +#endif + +if ( -e cism_driver/cism_driver ) then + echo 'Copying '$COMPILER_NAME' parallel cism_driver_'$COMPILER_NAME' to test directory' + cp -f cism_driver/cism_driver $TEST_DIR/cism_driver_$COMPILER_NAME +else + echo "cmake '$COMPILER_NAME' build failed, no executable" + @ build_problem = 1 +endif + +endif # skip_build_set + +if ($build_problem == 1) then + echo "No job submitted -- cmake build failed." +else # execute tests: + + # Make copy of test suite in $TEST_DIR: +if (! ($no_copy_set)) then + echo "Copying default reg_test and LIVV to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e reg_test_default.tgz ) rm -f reg_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/reg_test_default.tgz + tar xfz reg_test_default.tgz + popd > /dev/null + + if ($PERF_TEST) then + echo "Copying default perf_test to $TEST_DIR" + pushd . > /dev/null + cd $TEST_DIR + if ( -e perf_test_default.tgz ) rm -f perf_test_default.tgz + wget $TEST_SUITE_DEFAULT_LOC/perf_test_default.tgz + tar xfz perf_test_default.tgz + popd > /dev/null + endif + + cp -rf ../../tests/higher-order/livv $TEST_DIR +endif + +if ($skip_tests_set) then + echo "Skipping tests." + exit +endif + +csh $TEST_DIR/livv/run_livv_default_tests.csh $TEST_DIR $CISM_RUN_SCRIPT $PERF_TEST $CISM_VV_SCRIPT +echo "Back in build-and-test script, exiting." +exit + + diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake new file mode 100644 index 0000000000..b846c74b23 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake @@ -0,0 +1,129 @@ +# run this script by typing: source titan-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the GNU compiler suite. + +# This script should be run from the builds/titan-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source titan-gnu-cmake +echo + +# this unload reduces purge spurious error messages: +module unload PrgEnv-gnu PrgEnv-pgi +module --silent purge + +#module unload cmake +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 +#module unload netcdf-hdf5parallel cray-netcdf-hdf5parallel boost gcc +#module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-pgi + +#module load cray-shmem +#module load cray-mpich +#module load netcdf-hdf5parallel/4.3.0 +#module load python +#module load boost/1.54.0 + +module load cray-shmem +module load cray-mpich +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.54.0 + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-pgi-ci-nophal/install \ + -D CISM_TRILINOS_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-pgi-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/lustre/atlas/world-shared/cli900/cesm/software/Trilinos/Trilinos-11.10.2_gptl/titan-pgi-ci-nophal/install \ + + -D CISM_GPTL_DIR=/lustre/atlas/world-shared/cli900/cesm/software/libgptl/libgptl-titan-pgi \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/pgi/121 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-fast -Kieee --diag_suppress 554,111,611" \ + -D CISM_Fortran_FLAGS:STRING="-fast -Kieee" \ + -D CISM_FMAIN=/opt/pgi/13.10.0/linux86-64/13.10/lib/f90main.o \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + +# -D CISM_FMAIN=/opt/pgi/13.10.0/linux86-64/13.10/lib/f90main.o \ + +# -D CISM_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D CISM_Fortran_FLAGS:STRING="-O2" \ + + +# -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake-newtrilinos b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake-newtrilinos new file mode 100644 index 0000000000..7799f28237 --- /dev/null +++ b/components/cism/glimmer-cism/builds/titan-pgi/titan-pgi-cmake-newtrilinos @@ -0,0 +1,129 @@ +# run this script by typing: source titan-gnu-cmake +# After thus script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script builds cism_driver +# on titan using the GNU compiler suite. + +# This script should be run from the builds/titan-gnu subdirectory +# of the main CISM repository (reflected in the two instances +# of "../.." below). + +# BUILD OPTIONS: +# The call to cmake below includes several input ON/OFF switch parameters, to +# provide a simple way to select different build options. These are: +# CISM_BUILD_CISM_DRIVER -- ON by default, set to OFF to only build the CISM libraries. +# CISM_ENABLE_BISICLES -- OFF by default, set to ON to build a BISICLES-capable cism_driver. +# CISM_ENABLE_FELIX -- OFF by default, set to ON to build a FELIX-capable cism_driver. +# CISM_USE_TRILINOS -- OFF by default, set to on for builds with Trilinos. +# CISM_MPI_MODE -- ON by default, only set to OFF for serial builds. +# CISM_SERIAL_MODE -- OFF by default, set to ON for serial builds. +# CISM_USE_GPTL_INSTRUMENTATION -- ON by default, set to OFF to not use GPTL instrumentation. +# CISM_COUPLED -- OFF by default, set to ON to build with CESM. + +echo +echo Run this script by typing: source titan-gnu-cmake +echo + +# this unload reduces purge spurious error messages: +module unload PrgEnv-gnu PrgEnv-pgi +module --silent purge + +#module unload cmake +#module unload cray-hdf5 +#module unload cray-hdf5-parallel +#module unload netcdf +#module unload python +#module unload cray-shmem +#module unload cray-mpich2 +#module unload netcdf-hdf5parallel cray-netcdf-hdf5parallel boost gcc +#module unload PrgEnv-cray PrgEnv-gnu PrgEnv-intel PrgEnv-pathscale PrgEnv-pgi + +module load modules +module load cmake/2.8.10.2 +module load PrgEnv-pgi + +#module load cray-shmem +#module load cray-mpich +#module load netcdf-hdf5parallel/4.3.0 +#module load python +#module load boost/1.54.0 + +module load cray-shmem +module load cray-mpich +module load cray-hdf5-parallel/1.8.11 +module load cray-netcdf-hdf5parallel/4.3.0 +module load python +module load boost/1.54.0 + +# remove old build data: +rm -f ./CMakeCache.txt +rm -rf ./CMakeFiles + +# run a script that creates some CISM source files: +#pushd . +#cd .. +#../cmake-scripts/autogenerate-script +#popd + +echo +echo "Doing CMake Configuration step" + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=ON \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_COUPLED:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=/ccs/proj/cli101/software/Trilinos/Trilinos_gptl/titan-pgi-ci-nophal/install \ + -D CISM_TRILINOS_GPTL_DIR=/ccs/proj/cli101/software/Trilinos/Trilinos_gptl/titan-pgi-ci-nophal/install \ + -D CISM_TRILINOS_ALBANY_DIR=/ccs/proj/cli101/software/Trilinos/Trilinos_gptl/titan-pgi-ci-nophal/install \ +\ + -D CISM_GPTL_DIR=/ccs/proj/cli062/cism_gptl/libgptl/libgptl-titan-pgi \ + -D CISM_NETCDF_DIR=/opt/cray/netcdf-hdf5parallel/4.3.0/pgi/121 \ +\ + -D CMAKE_INSTALL_PREFIX:PATH=$PWD/install \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=ON \ + -D CMAKE_VERBOSE_CONFIGURE:BOOL=ON \ +\ + -D CMAKE_CXX_COMPILER=CC \ + -D CMAKE_C_COMPILER=cc \ + -D CMAKE_Fortran_COMPILER=ftn \ +\ + -D CMAKE_CXX_FLAGS:STRING="-fast -Kieee --diag_suppress 554,111,611" \ + -D CISM_Fortran_FLAGS:STRING="-fast -Kieee" \ + -D CISM_FMAIN=/opt/pgi/13.10.0/linux86-64/13.10/lib/f90main.o \ + -D BISICLES_LIB_SUBDIR=libpgi \ + -D BISICLES_INTERFACE_DIR=$PWD/../../../BISICLES/CISM-interface/interface \ + -D CISM_MPI_LIBS:STRING="mpichf90" \ + -D CISM_USE_CXX_IMPLICIT_LIBS:BOOL=OFF \ + -D CISM_STATIC_LINKING:BOOL=ON \ + ../.. + +# -D CISM_FMAIN=/opt/pgi/13.10.0/linux86-64/13.10/lib/f90main.o \ + +# -D CISM_TRILINOS_DIR=/tmp/proj/cli054/trilinos-10.12/FEB2013_FAST_PGI/install \ + +# -D CMAKE_CXX_FLAGS:STRING="-O2 --diag_suppress 554,111,611 -DH5_USE_16_API" \ +# -D CISM_Fortran_FLAGS:STRING="-O2" \ + + +# -D CISM_FMAIN=/opt/pgi/13.7.0/linux86-64/13.7/lib/f90main.o \ + +# Note: last argument above "../.." is path to top seacism directory + +# ADD: + +# -D CMAKE_PREFIX_PATH="/opt/cray/hdf5/1.8.8/pgi/119;/opt/cray/hdf5-parallel/1.8.8/pgi/119" \ + +# -D TPL_ENABLE_MPI:BOOL=ON \ + + +# -D CISM_HDF5_LIB_DIR=/opt/cray/hdf5-parallel/1.8.8/pgi/119/lib \ +# -D CISM_HDF5_LIBS="-lhdf5_pgi_parallel -lz" \ diff --git a/components/cism/glimmer-cism/builds/yellowstone-intel-serial/yellowstone-intel-cmake-serial b/components/cism/glimmer-cism/builds/yellowstone-intel-serial/yellowstone-intel-cmake-serial new file mode 100755 index 0000000000..755e758378 --- /dev/null +++ b/components/cism/glimmer-cism/builds/yellowstone-intel-serial/yellowstone-intel-cmake-serial @@ -0,0 +1,69 @@ +# Run this script by typing: source yellowstone-intel-cmake +# After this script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script is set up to perform a serial build + +module purge +module load ncarenv/1.0 +module load ncarbinlibs/1.0 +module load intel/13.1.2 +module load mkl/11.0.1 +module load netcdf/4.3.0 +module load ncarcompilers/1.0 +module load cmake/2.8.10.2 +module load python +module load all-python-libs + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +# Note: the compilation flags were taken from the defaults for a CESM build on +# yellowstone-intel (using Machines_140218). Some of these options (e.g., +# -convert big_endian and -assume byterecl) are probably unnecessary for a +# standalone build, but I am keeping things consistent with the CESM build for +# simplicity. + +# A few non-intuitive things: +# +# - CISM_FORCE_FORTRAN_LINKER: without this, cmake tries to use a C++ linker, which doesn't work +# +# - CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES: (this is a note that applies to the +# parallel build with trilinos, and may or may not apply to this serial +# build): if this is on (the default), some libraries are included on the link +# line which can't be found (e.g., hdf5). This may be related to the fact that +# trilinos on yellowstone is old, and/or the fact that cmake wants to use a +# C++ linker but we're telling it to use a fortran linker. + +cmake \ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=OFF \ + -D CISM_SERIAL_MODE:BOOL=ON \ + -D CISM_BUILD_SIMPLE_GLIDE:BOOL=ON \ + -D CISM_BUILD_SIMPLE_BISICLES:BOOL=OFF \ + -D CISM_BUILD_GLINT_EXAMPLE:BOOL=OFF \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_USE_DEFAULT_IO:BOOL=OFF \ + -D CISM_USE_CISM_FRONT_END:BOOL=OFF \ +\ + -D CISM_NETCDF_DIR=$NETCDF \ + -D CISM_FORCE_FORTRAN_LINKER:BOOL=ON \ + -D CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES:BOOL=OFF \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=OFF \ +\ + -D CMAKE_CXX_COMPILER=icpc \ + -D CMAKE_C_COMPILER=icc \ + -D CMAKE_Fortran_COMPILER=ifort \ +\ + -D CMAKE_Fortran_FLAGS:STRING="-fp-model source -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -xHost -O2" \ + -D CMAKE_C_FLAGS:STRING="-O2 -fp-model precise -xHost" \ + -D CMAKE_CXX_FLAGS:STRING="-O2 -fp-model precise -xHost" \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory diff --git a/components/cism/glimmer-cism/builds/yellowstone-intel/yellowstone-intel-cmake b/components/cism/glimmer-cism/builds/yellowstone-intel/yellowstone-intel-cmake new file mode 100755 index 0000000000..fc61a0bf4a --- /dev/null +++ b/components/cism/glimmer-cism/builds/yellowstone-intel/yellowstone-intel-cmake @@ -0,0 +1,72 @@ +# Run this script by typing: source yellowstone-intel-cmake +# After this script completes, type: make -j 8 +# If rebuilding, type 'make clean' before running 'make -j 8' + +# This cmake configuration script is set up to perform a parallel build with Trilinos + +module purge +module load ncarenv/1.0 +module load ncarbinlibs/1.0 +module load intel/13.1.2 +module load mkl/11.0.1 +module load trilinos/11.0.3 +module load netcdf-mpi/4.3.0 +module load ncarcompilers/1.0 +module load pnetcdf/1.3.0 +module load cmake/2.8.10.2 +module load python +module load all-python-libs + +# remove old build data: +rm ./CMakeCache.txt +rm -r ./CMakeFiles + +echo +echo "Doing CMake Configuration step" + +# Note: the compilation flags were taken from the defaults for a CESM build on +# yellowstone-intel (using Machines_140218). Some of these options (e.g., +# -convert big_endian and -assume byterecl) are probably unnecessary for a +# standalone build, but I am keeping things consistent with the CESM build for +# simplicity. + +# A few non-intuitive things: +# +# - CISM_FORCE_FORTRAN_LINKER: without this, cmake tries to use a C++ linker, which doesn't work +# +# - CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES: if this is on (the default), some +# libraries are included on the link line which can't be found (e.g., +# hdf5). This may be related to the fact that trilinos on yellowstone is old, +# and/or the fact that cmake wants to use a C++ linker but we're telling it to +# use a fortran linker. + +cmake \ + -D CISM_BUILD_CISM_DRIVER:BOOL=ON \ + -D CISM_ENABLE_BISICLES=OFF \ + -D CISM_ENABLE_FELIX=OFF \ +\ + -D CISM_USE_TRILINOS:BOOL=OFF \ + -D CISM_MPI_MODE:BOOL=ON \ + -D CISM_SERIAL_MODE:BOOL=OFF \ +\ + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=OFF \ + -D CISM_COUPLED:BOOL=OFF \ + -D CISM_USE_CISM_FRONT_END:BOOL=OFF \ +\ + -D CISM_TRILINOS_DIR=$TRILINOS_PATH \ + -D CISM_NETCDF_DIR=$NETCDF \ + -D CISM_FORCE_FORTRAN_LINKER:BOOL=ON \ + -D CISM_INCLUDE_IMPLICIT_LINK_LIBRARIES:BOOL=OFF \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=OFF \ +\ + -D CMAKE_CXX_COMPILER=mpiicpc \ + -D CMAKE_C_COMPILER=mpicc \ + -D CMAKE_Fortran_COMPILER=mpif90 \ +\ + -D CMAKE_Fortran_FLAGS:STRING="-fp-model source -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -xHost -O2" \ + -D CMAKE_C_FLAGS:STRING="-O2 -fp-model precise -xHost" \ + -D CMAKE_CXX_FLAGS:STRING="-O2 -fp-model precise -xHost" \ + ../.. + +# Note: last argument above "../.." is path to top seacism directory +# Note: last argument above "../.." is path to top seacism directory diff --git a/components/cism/glimmer-cism/cism_driver/CMakeLists.txt b/components/cism/glimmer-cism/cism_driver/CMakeLists.txt new file mode 100644 index 0000000000..ef2c20a2b9 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/CMakeLists.txt @@ -0,0 +1,88 @@ +# cism_driver and CISM front-end build + +IF (${CISM_USE_TRILINOS}) + LIST(INSERT CISM_TRILINOS_LIBS 0 glimmercismcpp) +ENDIF() + +# Need include directories from Trilinos but also mod files from glimmer +include_directories (${CISM_BINARY_DIR}/include ${PYTHON_INC_DIR} + ${Trilinos_INCLUDE_DIRS} ${Trilinos_TPL_INCLUDE_DIRS}) + +link_directories (${Trilinos_LIBRARY_DIRS} ${Trilinos_TPL_LIBRARY_DIRS} + ${CISM_DYCORE_DIR} + ${BISICLES_INTERFACE_DIR}/${BISICLES_LIB_SUBDIR} + ${CISM_HDF5_LIB_DIR} ${PYTHON_LIB_DIR} ) + +# DMR 6/2/14 -- Moved simple_forcing.F90 and testsfg.F90 to the glimmercismfortran lib. +# These are local source files needed to make the cism_driver executable and CISM front-end +#add_executable(cism_driver cism_driver.F90 cism_front_end.F90 gcm_cism_interface.F90 +# gcm_to_cism_glint.F90 cism_external_dycore_interface.F90 +# ../example-drivers/simple_glide/src/simple_forcing.F90 +# ../example-drivers/simple_glide/src/testsfg.F90) + +add_executable(cism_driver cism_driver.F90 cism_front_end.F90 gcm_cism_interface.F90 + gcm_to_cism_glint.F90 cism_external_dycore_interface.F90) + +#SET(CMAKE_FIND_LIBRARY_SUFFIXES ".a") +IF (CISM_STATIC_LINKING) + SET_TARGET_PROPERTIES(cism_driver PROPERTIES LINK_SEARCH_START_STATIC 1) + SET_TARGET_PROPERTIES(cism_driver PROPERTIES LINK_SEARCH_END_STATIC 1) +ENDIF() + +IF (CISM_FORCE_FORTRAN_LINKER) + SET_PROPERTY(TARGET cism_driver PROPERTY LINKER_LANGUAGE Fortran) +ENDIF() + +MESSAGE("CISM_BISICLES_DIR: " ${CISM_BISICLES_DIR}) +MESSAGE("CISM_HDF5_LIBS: " ${CISM_HDF5_LIBS}) + +# Executable depends on several glimmer libraries and Trilinos, +# and potentially an f90main.o file (on jaguar with PGI at least) + +IF (${CISM_ENABLE_BISICLES}) + set(CISM_USE_EXTERNAL_DYCORE ON) + ELSE() + set(CISM_USE_EXTERNAL_DYCORE OFF) +ENDIF() +MESSAGE("CISM_USE_EXTERNAL_DYCORE: " ${CISM_USE_EXTERNAL_DYCORE}) +IF (NOT ${CISM_USE_EXTERNAL_DYCORE}) + link_directories (${Trilinos_LIBRARY_DIRS} ${Trilinos_TPL_LIBRARY_DIRS} + ${CISM_HDF5_LIB_DIR} ${PYTHON_LIB_DIR} ) + + target_link_libraries(cism_driver + ${CISM_FMAIN} + glimmercismfortran + ${PYTHON_LIBS} + ${CISM_NETCDF_LIBS} + ${CISM_HDF5_LIBS} + ${CISM_MPI_LIBS} + ${CISM_TRILINOS_LIBS} + ${CISM_EXTRA_LIBS} + ${CISM_GPTL_LIB} + ) +ELSEIF (${CISM_ENABLE_BISICLES}) +MESSAGE("CISM_DYCORE_DIR: " ${CISM_DYCORE_DIR}) + link_directories (${Trilinos_LIBRARY_DIRS} ${Trilinos_TPL_LIBRARY_DIRS} + ${CISM_DYCORE_DIR} + ${BISICLES_INTERFACE_DIR}/${BISICLES_LIB_SUBDIR} + ${CISM_HDF5_LIB_DIR} ${PYTHON_LIB_DIR} ) + target_link_libraries(cism_driver + ${CISM_FMAIN} + glimmercismfortran + DyCoreToGlimmer + libBisicles.a + libChomboLibs.a + ${PYTHON_LIBS} + ${CISM_NETCDF_LIBS} + ${CISM_HDF5_LIBS} + ${CISM_MPI_LIBS} + ${CISM_TRILINOS_LIBS} + ${CISM_EXTRA_LIBS} + ${CISM_GPTL_LIB} + ) +ENDIF() + +# Helpful(?) message near end of configuration step +MESSAGE("") +MESSAGE(" Executable cism_driver should appear in dir: build_dir/cism_driver") +MESSAGE("") diff --git a/components/cism/glimmer-cism/cism_driver/cism_cesm_interface.F90 b/components/cism/glimmer-cism/cism_driver/cism_cesm_interface.F90 new file mode 100644 index 0000000000..8b02e0ae2f --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/cism_cesm_interface.F90 @@ -0,0 +1,40 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! cism_cesm_interface.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + +module cism_cesm_interface_module + +contains + + subroutine cism_cesm_interface() + + use cism_front_end_module + + call cism_front_end() + + end subroutine cism_cesm_interface + +end module cism_cesm_interface_module diff --git a/components/cism/glimmer-cism/cism_driver/cism_driver.F90 b/components/cism/glimmer-cism/cism_driver/cism_driver.F90 new file mode 100644 index 0000000000..abe82e15b9 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/cism_driver.F90 @@ -0,0 +1,53 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! cism_driver.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +program cism_driver + + use parallel +! use glimmer_commandline +! use glide + use gcm_cism_interface + use parallel + + integer :: which_gcm = GCM_DATA_MODEL + type(gcm_to_cism_type) :: g2c + + if (command_argument_count() == 0) then + print *,"" + print *,"Call cism_driver with either 1 or 2 arguments. Examples:" + print *,"cism_driver ice_sheet.config" + print *,"cism_driver ice_sheet.config climate.config" + print *,"" + stop + end if + + call parallel_initialise + + call gci_init_interface(which_gcm,g2c) + call gci_run_model(g2c) + call gci_finalize_interface(g2c) + + call parallel_finalise +end program cism_driver diff --git a/components/cism/glimmer-cism/cism_driver/cism_external_dycore_interface.F90 b/components/cism/glimmer-cism/cism_driver/cism_external_dycore_interface.F90 new file mode 100644 index 0000000000..b9fc824b77 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/cism_external_dycore_interface.F90 @@ -0,0 +1,125 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! cism_external_dycore_interface.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module cism_external_dycore_interface + +contains + +subroutine cism_init_external_dycore(external_dycore_type,model) + + use parallel + use glimmer_global + use glide + use glissade + use eismint_forcing + use glimmer_log + use glimmer_config + use glimmer_commandline + use glimmer_writestats + use glimmer_filenames, only : filenames_init + + use glide_diagnostics + +#if defined CISM_HAS_BISICLES || defined CISM_HAS_FELIX +#define CISM_HAS_EXTERNAL_DYCORE 1 +#endif + +#ifdef CISM_HAS_EXTERNAL_DYCORE + use glimmer_to_dycore +#endif + + + implicit none + + integer*4 :: external_dycore_type + type(glide_global_type), intent(inout) :: model + + real(kind=dp) :: cur_time, time_inc + + ! for external dycore: + integer*4 external_dycore_model_index + ! integer argc + integer*4 p_index + + +#ifdef CISM_HAS_EXTERNAL_DYCORE + ! print *,"Initializing external dycore interface." + call gtd_init_dycore_interface() + + call parallel_barrier() + ! print *,"Initializing external dycore." + call gtd_init_dycore(model,external_dycore_model_index) + model%options%external_dycore_model_index = external_dycore_model_index + call parallel_barrier() +#else + print *,"ERROR: The program was not built with an external dynamic core." +#endif + +end subroutine cism_init_external_dycore + + +subroutine cism_run_external_dycore(external_dycore_model_index,cur_time,time_inc) + use parallel + use glimmer_global + use glide + use glissade + use eismint_forcing + use glimmer_log + use glimmer_config + use glimmer_commandline + use glimmer_writestats + use glimmer_filenames, only : filenames_init + + use glide_diagnostics + +#if defined CISM_HAS_BISICLES || defined CISM_HAS_FELIX +#define CISM_HAS_EXTERNAL_DYCORE 1 +#endif + +#ifdef CISM_HAS_EXTERNAL_DYCORE + use glimmer_to_dycore +#endif + + integer*4 external_dycore_model_index + real(kind=dp) :: cur_time, time_inc + +#ifdef CISM_HAS_EXTERNAL_DYCORE +! dycore_model_index = this_rank + 1 + dycore_model_index = 1 + + call parallel_barrier() + ! print *,"Running external dycore." + call gtd_run_dycore(external_dycore_model_index,cur_time,time_inc) + ! print *,"Completed Dycore Run." + call parallel_barrier() +#else + print *,"ERROR: The program was not built with an external dynamic core." +#endif + +end subroutine cism_run_external_dycore + + +end module cism_external_dycore_interface diff --git a/components/cism/glimmer-cism/cism_driver/cism_front_end.F90 b/components/cism/glimmer-cism/cism_driver/cism_front_end.F90 new file mode 100644 index 0000000000..043487c4b6 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/cism_front_end.F90 @@ -0,0 +1,411 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! cism_front_end.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module cism_front_end + ! The CISM front-end is used to connect both the standalone driver + ! (cism_driver) or the CISM interface to CESM (cism_cesm_interface), + ! to the internal and external dycore interface programs. These are + !* cism_internal_dycore_interface and cism_external_dycore_interface. + +contains + +subroutine cism_init_dycore(model) + + use parallel + use glimmer_global + use glide + use glissade + use eismint_forcing + use glimmer_log + use glimmer_config + use glide_nc_custom, only: glide_nc_fillall + use glimmer_commandline + use glimmer_writestats + use glimmer_filenames, only : filenames_init + use glide_io, only: glide_io_writeall + + use cism_external_dycore_interface + +! use glimmer_to_dycore + + use glide_stop, only: glide_finalise + use glide_diagnostics + + implicit none + + + type(glide_global_type) :: model ! model instance + type(ConfigSection), pointer :: config ! configuration stuff + real(kind=dp) :: time ! model time in years + integer :: clock,clock_rate + + integer*4 external_dycore_model_index + + integer :: wd + logical :: do_glide_init + + integer :: tstep_count + + ! print *,'Entering cism_init_dycore' + + + !TODO - call this only for parallel runs? + ! call parallel_initialise + + call glimmer_GetCommandline() + + ! DMR -- open_log call commented out, since called in gci_init_interface() + ! start logging + ! call open_log(unit=50, fname=logname(commandline_configname)) + + ! setup paths + call filenames_init(commandline_configname) + + ! read configuration + call ConfigRead(commandline_configname,config) + +#if (! defined CCSMCOUPLED && ! defined CESMTIMERS) + ! start timing + call system_clock(clock,clock_rate) + wall_start_time = real(clock,kind=dp)/real(clock_rate,kind=dp) +#else + wall_start_time = 0.0 + wall_stop_time = 0.0 +#endif + + ! initialise profiling + call profile_init(model%profile,'glide.profile') + + call t_startf('cism') + + ! initialise GLIDE + call t_startf('initialization') + + call glide_config(model,config) + + ! This call is needed only if running the EISMINT test cases + call eismint_initialise(model%eismint_climate,config) + + wd = model%options%whichdycore +! do_glide_init = (wd == DYCORE_GLIDE) .OR. (wd == DYCORE_BISICLES) .OR. (wd == DYCORE_ALBANYFELIX) + do_glide_init = (wd == DYCORE_GLIDE) + + if (do_glide_init) then + call glide_initialise(model) + else ! glam/glissade dycore + call glissade_initialise(model) + endif + + call CheckSections(config) + + ! fill dimension variables on output files + call glide_nc_fillall(model) + + time = model%numerics%tstart + tstep_count = 0 + model%numerics%time = time ! MJH added 1/10/13 - the initial diagnostic glissade solve won't know + ! the correct time on a restart unless we set it here. + + ! Set EISMINT forcing for initial time + call eismint_massbalance(model%eismint_climate,model,time) + call eismint_surftemp(model%eismint_climate,model,time) + + ! read forcing time slice if needed - this will overwrite values from IC file if there is a conflict. + call glide_read_forcing(model, model) + + call spinup_lithot(model) + + if (model%options%whichdycore == DYCORE_BISICLES) then + call t_startf('init_external_dycore') + call cism_init_external_dycore(model%options%external_dycore_type,model) + call t_stopf('init_external_dycore') + endif + + call t_stopf('initialization') + + if (model%options%whichdycore .ne. DYCORE_BISICLES) then + !MJH Created this block here to fill out initial state without needing to enter time stepping loop. This allows + ! a run with tend=tstart to be run without time-stepping at all. It requires solving all diagnostic (i.e. not + ! time depdendent) variables (most important of which is velocity) for the initial state and then writing the + ! initial state as time 0 (or more accurately, as time=tstart). Also, halo updates need to occur after the + ! diagnostic variables are calculated. + + ! ------------- Calculate initial state and output it ----------------- + + call t_startf('initial_diag_var_solve') + + select case (model%options%whichdycore) + case (DYCORE_GLIDE) + + if (model%numerics%tstart < (model%numerics%tend - model%numerics%tinc)) then + ! disable further profiling in normal usage + call t_adj_detailf(+10) + endif + + ! Don't call glide_init_state_diagnostic when running old glide + ! Instead, start with zero velocity + if (.not. oldglide) then + call glide_init_state_diagnostic(model) + endif + + if (model%numerics%tstart < (model%numerics%tend - model%numerics%tinc)) then + ! restore profiling to normal settings + call t_adj_detailf(-10) + endif + + case (DYCORE_GLAM, DYCORE_GLISSADE, DYCORE_ALBANYFELIX) + + if (model%numerics%tstart < (model%numerics%tend - model%numerics%tinc)) then + ! disable further profiling in normal usage + call t_adj_detailf(+10) + endif + + ! solve the remaining diagnostic variables for the initial state + call glissade_diagnostic_variable_solve(model) ! velocity, usrf, etc. + + if (model%numerics%tstart < (model%numerics%tend - model%numerics%tinc)) then + ! restore profiling to normal settings + call t_adj_detailf(-10) + endif + + case default + + end select + + call t_stopf('initial_diag_var_solve') + + ! Write initial diagnostic output to log file + + call t_startf('initial_write_diagnostics') + call glide_write_diagnostics(model, time, & + tstep_count = tstep_count) + call t_stopf('initial_write_diagnostics') + + end if ! whichdycore .ne. DYCORE_BISICLES + + + ! --- Output the initial state ------------- + + call t_startf('initial_io_writeall') + call glide_io_writeall(model, model, time=time) ! MJH The optional time argument needs to be supplied + ! since we have not yet set model%numerics%time + !WHL - model%numerics%time is now set above + call t_stopf('initial_io_writeall') + +end subroutine cism_init_dycore + + +subroutine cism_run_dycore(model) + + use parallel + use glimmer_global + use glide + use glissade + use eismint_forcing + use glimmer_log + use glimmer_config + use glide_nc_custom, only: glide_nc_fillall + use glimmer_commandline + use glimmer_writestats + use glimmer_filenames, only : filenames_init + use glide_io, only: glide_io_writeall, glide_io_writeall + + use cism_external_dycore_interface + + use glide_stop, only: glide_finalise + use glide_diagnostics + + implicit none + + + type(glide_global_type) :: model ! model instance + type(ConfigSection), pointer :: config ! configuration stuff + real(kind=dp) :: time ! model time in years + real(kind=dp) :: dt ! current time step to use + real(kind=dp) :: time_eps ! tolerance within which times are equal + integer :: clock,clock_rate + integer :: tstep_count + + integer*4 :: external_dycore_model_index + +! external_dycore_model_index = this_rank + 1 + external_dycore_model_index = 1 + + time = model%numerics%tstart + tstep_count = 0 + time_eps = model%numerics%tinc/1000.0d0 + + ! ------------- Begin time step loop ----------------- + + ! run an internal or external dycore, depending on setting external_dycore_type + + ! check if we're doing any evolution + if (time < model%numerics%tend) then + do while(time + time_eps < model%numerics%tend) + + ! Increment time step + if (model%options%whichdycore /= DYCORE_BISICLES) then + time = time + model%numerics%tinc + tstep_count = tstep_count + 1 + model%numerics%time = time ! TODO This is redundant with what is happening in glide/glissade, but this is needed for forcing to work properly. + endif +! print *,"external_dycore_type: ",model%options%external_dycore_type + + + !if (model%options%external_dycore_type .EQ. 0) then ! NO_EXTERNAL_DYCORE) then + ! if (model%options%whichdycore == DYCORE_GLIDE) then + call t_startf('tstep') + + select case (model%options%whichdycore) + case (DYCORE_GLIDE) + + call t_startf('glide_tstep_p1') + call glide_tstep_p1(model,time) + call t_stopf('glide_tstep_p1') + + call t_startf('glide_tstep_p2') + call glide_tstep_p2(model) + call t_stopf('glide_tstep_p2') + + call t_startf('glide_tstep_p3') + call glide_tstep_p3(model) + call t_stopf('glide_tstep_p3') + + case (DYCORE_GLAM, DYCORE_GLISSADE, DYCORE_ALBANYFELIX) + ! glam/glissade dycore + + call glissade_tstep(model,time) + + case (DYCORE_BISICLES) + ! print *,'Using External Dycore' + ! The time variable gets incremented within this call: + dt = model%numerics%tinc + + if (time + dt + time_eps > model%numerics%tend) then + dt = model%numerics%tend - time + endif + call cism_run_external_dycore(model%options%external_dycore_model_index, & + time,dt) + ! time = time + model%numerics%tinc + case default + end select + + call t_stopf('tstep') + !endif + + ! write ice sheet diagnostics to log file at desired interval (model%numerics%dt_diag) + + call t_startf('write_diagnostics') + call glide_write_diagnostics(model, time, & + tstep_count = tstep_count) + call t_stopf('write_diagnostics') + + ! update time from dycore advance + model%numerics%time = time + + ! --- Set forcing --- + ! Setting forcing at the end of the time step maintains consistency + ! with a forward Euler time step and ensures consistency of the time stamp + ! to fields in input and output files. + ! For forward Euler time stepping we want S^n+1 = g(S^n, F^n) + ! where S is the model state, F is forcing, and n, n+1 are time levels + ! We also want a forcing field in the output file to have a time stamp + ! that matches its time stamp in the input file or the EISMINT analytic function. + ! The simplest way to ensure both of these criteria is to set forcing at the + ! end of each time step. + ! EISMINT forcing + ! NOTE: these only do something when an EISMINT case is run + call t_startf('set_forcing') + call eismint_massbalance(model%eismint_climate,model,time) + call eismint_surftemp(model%eismint_climate,model,time) + call t_stopf('set_forcing') + + ! Forcing from a 'forcing' data file - will read time slice if needed + call t_startf('read_forcing') + call glide_read_forcing(model, model) + call t_stopf('read_forcing') + + ! Write to output netCDF files at desired intervals + call t_startf('io_writeall') + call glide_io_writeall(model,model) + call t_stopf('io_writeall') + end do ! time < model%numerics%tend + else ! no evolution -- diagnostic run, still want to do IO + ! (DFM) uncomment this if we want to do an I/O step even if no evoloution + !call t_startf('glide_io_writeall') + !call glide_io_writeall(model,model) + !call t_stopf('glide_io_writeall') + endif + +end subroutine cism_run_dycore + +subroutine cism_finalize_dycore(model) + + use parallel + use glimmer_global + use glide + use glissade + use glimmer_log + use glimmer_config + use glide_nc_custom, only: glide_nc_fillall + use glimmer_commandline + use glimmer_writestats + use glimmer_filenames, only : filenames_init + use glide_io, only: glide_io_writeall + + use cism_external_dycore_interface + + use glide_stop, only: glide_finalise + use glide_diagnostics + + implicit none + + type(glide_global_type) :: model ! model instance + integer :: clock,clock_rate + + call t_stopf('cism') + + ! finalise GLIDE + call glide_finalise(model) + + !TODO - Do we need to call glimmer_write_stats? +#if (! defined CCSMCOUPLED && ! defined CESMTIMERS) + call system_clock(clock,clock_rate) + wall_stop_time = real(clock,kind=dp)/real(clock_rate,kind=dp) + call glimmer_write_stats(commandline_resultsname,commandline_configname,wall_stop_time-wall_start_time) +#endif + + call close_log + + !TODO - call this only for parallel runs? + ! call parallel_finalise +end subroutine cism_finalize_dycore + +end module cism_front_end diff --git a/components/cism/glimmer-cism/cism_driver/eismint_forcing.F90 b/components/cism/glimmer-cism/cism_driver/eismint_forcing.F90 new file mode 100644 index 0000000000..397d5e2281 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/eismint_forcing.F90 @@ -0,0 +1,585 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! eismint_forcing.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module eismint_forcing + + ! read configuration and generate eismint mass balance and + ! temperature fields + + use glimmer_global, only : dp + use glide_types, only : eismint_climate_type + + !MAKE_RESTART +#ifdef RESTARTS +#define RST_EISMINT_FORCING +!JCC - no restarts yet +!#include "glimmer_rst_head.inc" +#undef RST_EISMINT_FORCING +#endif + +contains + +#ifdef RESTARTS +#define RST_EISMINT_FORCING +!JCC - no restarts yet +!#include "glimmer_rst_body.inc" +#undef RST_EISMINT_FORCING +#endif + + subroutine eismint_initialise(eismint_climate,config) + + ! initialise eismint_climate model + + use glimmer_global, only: dp + use glimmer_paramets, only: thk0, scyr, tim0 + use glimmer_physcon, only: scyr + use glimmer_config + use glide_types + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + +!WHL - The old scaling looked like this: eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / (acc0 * scyr) +! where acc0 = thk0*vel0/len0. +! I replaced (acc0 * scyr) with acab_scale = scyr*thk0/tim0, where tim0 = len0/vel0. +! This is the scaling used in other parts of the code, including Glint. +! It can be shown (but is not immediately obvious) that acab_scale = acc0 * scyr. +! This scale factor assumes that the input mass balance has units of m/yr. +! +! Note: We should not use the parameter scale_acab in glimmer_scales because +! it may not have been initialized yet. + + real(dp), parameter :: acab_scale = scyr*thk0/tim0 + + call eismint_readconfig(eismint_climate,config) + call eismint_printconfig(eismint_climate) + + ! scale parameters + ! assumes that eismint_climate%nmsb starts with units of m/yr + + select case(eismint_climate%eismint_type) + + case(1) ! EISMINT-1 fixed margin + eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale + + case(2) ! EISMINT-1 moving margin + eismint_climate%airt(2) = eismint_climate%airt(2) * thk0 + eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale + eismint_climate%nmsb(2) = eismint_climate%nmsb(2) / acab_scale + + case(3) ! EISMINT-2 + eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale + eismint_climate%nmsb(2) = eismint_climate%nmsb(2) / acab_scale + + case(4) ! MISMIP-1 + eismint_climate%nmsb(1) = eismint_climate%nmsb(1) / acab_scale + + end select + + end subroutine eismint_initialise + + subroutine eismint_readconfig(eismint_climate, config) + + ! read configuration + + use glimmer_log + use glimmer_config + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + real(kind=dp), dimension(:), pointer :: dummy + + call GetSection(config,section,'EISMINT-1 fixed margin') + if (associated(section)) then + eismint_climate%eismint_type = 1 + dummy=>NULL() + call GetValue(section,'temperature',dummy,2) + eismint_climate%airt = (/-34.15d0, 8.d-8/) + if (associated(dummy)) then + eismint_climate%airt = dummy + deallocate(dummy) + dummy=>NULL() + end if + call GetValue(section,'massbalance',dummy,1) + eismint_climate%nmsb = (/0.3d0, 0.d0, 0.d0/) + if (associated(dummy)) then + eismint_climate%nmsb(1) = dummy(1) + end if + call GetValue(section,'period',eismint_climate%period) + call GetValue(section,'mb_amplitude',eismint_climate%mb_amplitude) + return + end if + + !TODO - I think the default airt values declared above are appropriate for this case. + ! Set them here instead. + + call GetSection(config,section,'EISMINT-1 moving margin') + if (associated(section)) then + eismint_climate%eismint_type = 2 + dummy=>NULL() + call GetValue(section,'temperature',dummy,2) + if (associated(dummy)) then + eismint_climate%airt = dummy + deallocate(dummy) + dummy=>NULL() + end if + call GetValue(section,'massbalance',dummy,3) + if (associated(dummy)) then + eismint_climate%nmsb = dummy + deallocate(dummy) + dummy=>NULL() + end if + call GetValue(section,'period',eismint_climate%period) + eismint_climate%mb_amplitude = 100000.d0 + call GetValue(section,'mb_amplitude',eismint_climate%mb_amplitude) + return + end if + + call GetSection(config,section,'EISMINT-2') + if (associated(section)) then + eismint_climate%eismint_type = 3 + dummy=>NULL() + call GetValue(section,'temperature',dummy,2) + if (associated(dummy)) then + eismint_climate%airt = dummy + deallocate(dummy) + dummy=>NULL() + else + eismint_climate%airt = (/-35.d0, 1.67d-5/) + end if + call GetValue(section,'massbalance',dummy,3) + if (associated(dummy)) then + eismint_climate%nmsb = dummy + deallocate(dummy) + dummy=>NULL() + end if + return + end if + + !mismip tests + + !TODO - Assign reasonable default values if not present in config file + + call GetSection(config,section,'MISMIP-1') + if (associated(section)) then + eismint_climate%eismint_type = 4 + dummy=>NULL() + call GetValue(section,'temperature',dummy,2) + if (associated(dummy)) then + eismint_climate%airt = dummy + deallocate(dummy) + dummy=>NULL() + end if + call GetValue(section,'massbalance',dummy,3) + if (associated(dummy)) then + eismint_climate%nmsb = dummy + deallocate(dummy) + dummy=>NULL() + end if + return + end if + + !exact verification + !TODO - Is this test currently supported? + + call GetSection(config,section,'EXACT') + if (associated(section)) then + eismint_climate%eismint_type = 5 + dummy=>NULL() + call GetValue(section,'temperature',dummy,2) + if (associated(dummy)) then + eismint_climate%airt = dummy + deallocate(dummy) + dummy=>NULL() + end if + return + end if + + ! Standard higher-order tests + ! These do not require EISMINT-type input parameters. + + call GetSection(config,section,'DOME-TEST') + if (associated(section)) then + return + end if + + call GetSection(config,section,'ISMIP-HOM-TEST') + if (associated(section)) then + return + end if + + call GetSection(config,section,'SHELF-TEST') + if (associated(section)) then + return + end if + + call GetSection(config,section,'STREAM-TEST') + if (associated(section)) then + return + end if + + call GetSection(config,section,'ROSS-TEST') + if (associated(section)) then + return + end if + + call GetSection(config,section,'GIS-TEST') + if (associated(section)) then + return + end if + + !TODO - Any other allowed tests to add here? + + ! Abort if one of the above cases has not been specified. + call write_log('No EISMINT forcing selected',GM_FATAL) + + end subroutine eismint_readconfig + + subroutine eismint_printconfig(eismint_climate) + + ! print eismint_climate configuration + + use glimmer_log + use parallel, only: tasks + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + character(len=100) :: message + + call write_log_div + + select case(eismint_climate%eismint_type) + + case(1) + call write_log('EISMINT-1 fixed margin configuration') + call write_log('------------------------------------') + write(message,*) 'temperature : ',eismint_climate%airt(1) + call write_log(message) + write(message,*) ' ',eismint_climate%airt(2) + call write_log(message) + write(message,*) 'massbalance : ',eismint_climate%nmsb(1) + call write_log(message) + write(message,*) 'period : ',eismint_climate%period + call write_log(message) + if (eismint_climate%period .gt. 0.d0) then + write(message,*) 'mb amplitude : ',eismint_climate%mb_amplitude + call write_log(message) + end if + + case(2) + call write_log('EISMINT-1 moving margin configuration') + call write_log('-------------------------------------') + write(message,*) 'temperature : ',eismint_climate%airt(1) + call write_log(message) + write(message,*) ' ',eismint_climate%airt(2) + call write_log(message) + write(message,*) 'massbalance : ',eismint_climate%nmsb(1) + call write_log(message) + write(message,*) ' ',eismint_climate%nmsb(2) + call write_log(message) + write(message,*) ' ',eismint_climate%nmsb(3) + call write_log(message) + write(message,*) 'period : ',eismint_climate%period + call write_log(message) + if (eismint_climate%period .gt. 0.d0) then + write(message,*) 'mb amplitude : ',eismint_climate%mb_amplitude + call write_log(message) + end if + + case(3) + call write_log('EISMINT-2') + call write_log('---------') + write(message,*) 'temperature : ',eismint_climate%airt(1) + call write_log(message) + write(message,*) ' ',eismint_climate%airt(2) + call write_log(message) + write(message,*) 'massbalance : ',eismint_climate%nmsb(1) + call write_log(message) + write(message,*) ' ',eismint_climate%nmsb(2) + call write_log(message) + write(message,*) ' ',eismint_climate%nmsb(3) + call write_log(message) + end select + + if ( (eismint_climate%eismint_type > 0) .and. (tasks > 1) ) then + call write_log('EISMINT tests are not supported for more than one processor', GM_FATAL) + end if + + call write_log('') + + end subroutine eismint_printconfig + + subroutine eismint_massbalance(eismint_climate,model,time) + + ! calculate eismint mass balance + +!TODO - Remove acc0 + + use glimmer_global, only : dp + use glide_types + use glimmer_paramets, only : len0, acc0, scyr + use glimmer_physcon, only : pi + use glimmer_scales, only : scale_acab + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + type(glide_global_type) :: model ! model instance + real(dp), intent(in) :: time ! current time + + !WHL - Changed 'periodic_bc' to 'periodic' to avoid a name conflict with parallel modules + ! local variables + integer :: ns,ew + real(dp) :: dist, ewct, nsct, grid, rel + real(dp) :: periodic = 1.d0 !TODO - Make this an integer? + + ewct = (real(model%general%ewn,dp) + 1.d0) / 2.d0 + nsct = (real(model%general%nsn,dp) + 1.d0) / 2.d0 + grid = real(model%numerics%dew,dp) * len0 + + if (model%options%periodic_ew) then + periodic = 0.d0 + else + periodic = 1.d0 + end if + + select case(eismint_climate%eismint_type) + + case(1) + ! EISMINT-1 fixed margin + model%climate%acab(:,:) = eismint_climate%nmsb(1) + if (eismint_climate%period .ne. 0.d0) then + model%climate%acab(:,:) = model%climate%acab(:,:) + eismint_climate%mb_amplitude * sin(2.d0*pi*time/eismint_climate%period)/ (acc0 * scyr) +! model%climate%acab(:,:) = model%climate%acab(:,:) + climate%mb_amplitude * sin(2.d0*pi*time/climate%period) / scale_acab + end if + + case(2) + ! EISMINT-1 moving margin + if (eismint_climate%period .ne. 0.d0) then + rel = eismint_climate%nmsb(3) + eismint_climate%mb_amplitude*sin(2.d0*pi*time/eismint_climate%period) + else + rel = eismint_climate%nmsb(3) + end if + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + dist = grid * sqrt(periodic*(real(ew,kind=dp) - ewct)**2 + (real(ns,kind=dp) - nsct)**2) + model%climate%acab(ew,ns) = min(eismint_climate%nmsb(1), eismint_climate%nmsb(2) * (rel - dist)) + end do + end do + + case(3) + ! EISMINT-2 + rel = eismint_climate%nmsb(3) + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + dist = grid * sqrt(periodic*(real(ew,kind=dp) - ewct)**2 + (real(ns,kind=dp) - nsct)**2) + model%climate%acab(ew,ns) = min(eismint_climate%nmsb(1), eismint_climate%nmsb(2) * (rel - dist)) + end do + end do + + case(4) + !mismip 1 + model%climate%acab = eismint_climate%nmsb(1) + + case(5) + !verification + call exact_surfmass(eismint_climate,model,time,1.d0,eismint_climate%airt(2)) + + end select + + end subroutine eismint_massbalance + + subroutine eismint_surftemp(eismint_climate,model,time) + + ! calculate eismint air surface temperature + + use glide_types + use glimmer_global, only: dp + use glimmer_paramets, only : len0 + use glimmer_physcon, only : pi + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + type(glide_global_type) :: model ! model instance + real(dp), intent(in) :: time ! current time + + ! local variables + integer :: ns,ew + real(dp) :: dist, ewct, nsct, grid + real(dp) :: periodic = 1.d0 + + ewct = (real(model%general%ewn,dp)+1.d0) / 2.d0 + nsct = (real(model%general%nsn,dp)+1.d0) / 2.d0 + grid = real(model%numerics%dew,dp) * len0 + + if (model%options%periodic_ew) then + periodic = 0.d0 + else + periodic = 1.d0 + end if + + select case(eismint_climate%eismint_type) + + case(1) + ! EISMINT-1 fixed margin + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + dist = grid * max(periodic*abs(real(ew,kind=dp) - ewct),abs(real(ns,kind=dp) - nsct))*1d-3 + model%climate%artm(ew,ns) = eismint_climate%airt(1) + eismint_climate%airt(2) * dist*dist*dist + end do + end do + if (eismint_climate%period .ne. 0.d0) then + model%climate%artm(:,:) = model%climate%artm(:,:) + 10.d0*sin(2.d0*pi*time/eismint_climate%period) + end if + + case(2) + ! EISMINT-1 moving margin + model%climate%artm(:,:) = eismint_climate%airt(1) - model%geometry%thck(:,:) * eismint_climate%airt(2) + if (eismint_climate%period .ne. 0.d0) then + model%climate%artm(:,:) = model%climate%artm(:,:) + 10.d0*sin(2.d0*pi*time/eismint_climate%period) + end if + + case(3) + ! EISMINT-2 + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + dist = grid * sqrt(periodic*(real(ew,kind=dp) - ewct)**2 + (real(ns,kind=dp) - nsct)**2) + model%climate%artm(ew,ns) = eismint_climate%airt(1)+eismint_climate%airt(2) * dist + end do + end do + + case(4) + model%climate%artm = eismint_climate%airt(1) + + case(5) + !call both massbalance and surftemp at the same time to save computing time. + call exact_surfmass(eismint_climate,model,time,0.d0,eismint_climate%airt(2)) + end select + + end subroutine eismint_surftemp + + !which_call - eismint_surftemp(0)/eismint_massbalance(1)/both(2) + !which_test - test f(0)/test g(1)/exact(2) + + subroutine exact_surfmass(eismint_climate,model,time,which_call,which_test) + + use glide_types + use testsFG + implicit none + + type(eismint_climate_type) :: eismint_climate ! structure holding climate info + type(glide_global_type) :: model ! model instance + real(dp), intent(in) :: time ! current time + real(dp), intent(in) :: which_test ! Which exact test (F=0, G=1) + real(dp), intent(in) :: which_call ! 0 = surface temp, 1 = mass balance + integer :: ns,ew,lev,center + + !verification + real(dp) :: r, z, x, y !in variables + real(dp) :: H, TT, U, w, Sig, M, Sigc !out variables + real(dp) :: H_0 + + center = (model%general%ewn - 1) * 0.5 + + !TODO - Change which_call to an integer? + ! Modify for Glissade? (dissip has smaller vertical dimension) + if (which_call .eq. 0.d0 .or. which_call .eq. 2.d0) then + + !point by point call to the function + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + x = (ew - center)*model%numerics%dew + y = (ns - center)*model%numerics%dns + r = sqrt(x**2 + y**2) + do lev = 1, model%general%upn + z = model%geometry%thck(ew,ns)*model%numerics%sigma(lev) + !the function only returns values within the radius + if(r>0.d0 .and. r0.d0 .and. r. +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! from glide_types.F90: +! integer, parameter :: DYCORE_GLIDE = 0 ! old shallow-ice dycore from Glimmer +! integer, parameter :: DYCORE_GLAM = 1 ! Payne-Price finite-difference solver +! integer, parameter :: DYCORE_GLISSADE = 2 ! prototype finite-element solver +! integer, parameter :: DYCORE_ALBANYFELIX = 3 ! External Albany-Felix finite-element solver +! integer, parameter :: DYCORE_BISICLES = 4 ! BISICLES external dycore + +module gcm_cism_interface + + use parallel + use glint_commandline + use glide + use cism_front_end + + use glint_example_clim + use glint_main + use gcm_to_cism_glint + + + integer, parameter :: GCM_MINIMAL_MODEL = 0 + integer, parameter :: GCM_DATA_MODEL = 1 + integer, parameter :: GCM_CESM = 2 + +contains + +subroutine gci_init_interface(which_gcm,g2c) + use parallel + use glint_commandline + use glimmer_config + use glide + use glide_types + + use cism_front_end + + integer, intent(in) :: which_gcm + type(gcm_to_cism_type) :: g2c ! holds everything + + integer :: whichdycore + type(ConfigSection), pointer :: config ! configuration stuff + type(ConfigSection), pointer :: section !< pointer to the section to be checked + + ! call parallel_initialise + + ! get the CISM dycore to be used: + call glint_GetCommandline() + call open_log(unit=50, fname=logname(commandline_configname)) + call ConfigRead(commandline_configname,config) + call GetSection(config,section,'options') + call GetValue(section,'dycore',whichdycore) + if (main_task) print *,'CISM dycore type (0=Glide, 1=Glam, 2=Glissade, 3=AlbanyFelix, 4 = BISICLES) = ', whichdycore + + ! check to see if running minimal GCM or data GCM. Still need to add CESM GCM: + call GetSection(config,section,'GLINT climate') + + if (associated(section)) then + g2c%which_gcm = GCM_DATA_MODEL + else + g2c%which_gcm = GCM_MINIMAL_MODEL + end if + if (main_task) print *,'g2c%which_gcm (1 = data, 2 = minimal) = ',g2c%which_gcm + + select case (g2c%which_gcm) + case (GCM_MINIMAL_MODEL) + if (main_task) print*, 'call cism_init_dycore' + call cism_init_dycore(g2c%glide_model) + + case (GCM_DATA_MODEL) + if (main_task) print*, 'call g2c_glint_init' + call g2c_glint_init(g2c) + + case (GCM_CESM) + ! call gcm_glint_GetCommandline_proxy() + ! call g2c_glint_init(g2c) + + case default + if (main_task) print *,"Error -- unknown GCM type." + end select + +end subroutine gci_init_interface + +subroutine gci_run_model(g2c) + + type(gcm_to_cism_type) :: g2c + + logical :: finished = .false. + + do while (.not. finished) + select case (g2c%which_gcm) + case (GCM_MINIMAL_MODEL) + ! call gcm_update_model(gcm_model,cism_model) +! if (main_task) print *,"In gci_run_model, calling cism_run_dycore" + call cism_run_dycore(g2c%glide_model) + + case (GCM_DATA_MODEL,GCM_CESM) +! if (main_task) print *,"In gci_run_model, calling g2c_glint_run" + call g2c_glint_run(g2c) + call g2c_glint_climate_time_step(g2c) + case default + end select + finished = (gci_finished(g2c)) + end do +end subroutine gci_run_model + + +! gci_finished is used to test status of GCM +function gci_finished(g2c) result(finished) + + type(gcm_to_cism_type) :: g2c + logical :: finished + + select case (g2c%which_gcm) + case (GCM_MINIMAL_MODEL) + finished = .true. + + case (GCM_DATA_MODEL,GCM_CESM) + call g2c_glint_check_finished(g2c,finished) + case default + end select + !if (main_task) print *,"In gci_finished, finished = ",finished + +end function gci_finished + + +subroutine gci_finalize_interface(g2c) + + type(gcm_to_cism_type) :: g2c + + select case (g2c%which_gcm) + case (GCM_MINIMAL_MODEL) + call cism_finalize_dycore(g2c%glide_model) + + case (GCM_DATA_MODEL) + call g2c_glint_end(g2c) + + case (GCM_CESM) + ! call g2c_glint_end(g2c) + case default + end select + +end subroutine gci_finalize_interface + + +end module gcm_cism_interface diff --git a/components/cism/glimmer-cism/cism_driver/gcm_to_cism_glint.F90 b/components/cism/glimmer-cism/cism_driver/gcm_to_cism_glint.F90 new file mode 100644 index 0000000000..f924609ef3 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/gcm_to_cism_glint.F90 @@ -0,0 +1,433 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! gcm_to_cism_glint.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module gcm_to_cism_glint + + ! This module demonstrates the use of the Glint interface. + ! It loads in some example global fields and associated grid data, + ! initialises the model, and then runs it for a user-prescribed period. + ! The surface mass balance can be computed either with a PDD scheme + ! (as in the original Glimmer code), or with a crude scheme + ! that imitates SMB input from a climate model. + + use glimmer_global, only: dp + use glint_main + use glimmer_log + use glint_global_interp + use glint_example_clim + use glint_commandline + use glimmer_writestats +! use glimmer_commandline + use glimmer_paramets, only: GLC_DEBUG + use parallel, only: main_task + +type gcm_to_cism_type + + ! Program variables ------------------------------------------------------------------- + + integer :: which_gcm = 0 ! type of global climate model being used, 0=minimal model, 1=data model, 2=CESM model + type(glide_global_type) :: glide_model ! ice sheet model used for glide + + type(glint_params) :: ice_sheet ! This is the derived type variable that holds all + ! domains of the ice model + type(glex_climate) :: climate ! Climate parameters and fields + + ! Arrays which hold the global fields used as input to Glint ------------------------ + + real(dp),dimension(:,:),pointer :: temp => null() ! Temperature (degC) + real(dp),dimension(:,:),allocatable :: precip ! Precipitation (mm/s) + real(dp),dimension(:,:),allocatable :: orog ! Orography (m) + + ! Arrays which hold information about the ice model instances ------------------------- + + real(dp),dimension(:,:),allocatable :: coverage ! Coverage map for normal global grid + real(dp),dimension(:,:),allocatable :: cov_orog ! Coverage map for orography grid + + ! Arrays which hold output from the model --------------------------------------------- + ! These are all on the normal global grid, except for the orography + + real(dp),dimension(:,:),allocatable :: albedo ! Fractional albedo + real(dp),dimension(:,:),allocatable :: orog_out ! Output orography (m) + real(dp),dimension(:,:),allocatable :: ice_frac ! Ice coverage fraction + real(dp),dimension(:,:),allocatable :: fw ! Freshwater output flux (mm/s) + real(dp),dimension(:,:),allocatable :: fw_in ! Freshwater input flux (mm/s) + + ! Arrays which hold information about the global grid --------------------------------- + + real(dp),dimension(:), allocatable :: lats_orog ! Latitudes of global orography gridpoints + real(dp),dimension(:), allocatable :: lons_orog ! Longitudes of global oropraphy gridpoints + + ! Scalars which hold information about the global grid -------------------------------- + + integer :: nx,ny ! Size of normal global grid + integer :: nxo,nyo ! Size of global orography grid + + ! Scalar model outputs ---------------------------------------------------------------- + + real(dp) :: twin ! Timestep-integrated input water flux (kg) + real(dp) :: twout ! Timestep-integrated output water flux (kg) + real(dp) :: ice_vol ! Total ice volume (m^3) + + ! Other variables --------------------------------------------------------------------- + + logical :: out ! Outputs set flag + integer :: i,j ! Array index counters + integer :: time ! Current time (hours) + real(dp):: t1,t2 + integer :: clock,clock_rate + + ! fields passed to and from a GCM + ! (useful for testing the GCM subroutines in standalone mode) + ! + ! Note that, for fields that possess a third dimension, this dimension is the elevation + ! class. Elevation class goes from 0 to glc_nec, where class 0 represents the bare land + ! "elevation class". + + real(dp),dimension(:,:,:), allocatable :: qsmb ! surface mass balance (kg/m^2/s) + real(dp),dimension(:,:,:), allocatable :: tsfc ! surface temperature (degC) + real(dp),dimension(:,:,:), allocatable :: topo ! surface elevation (m) + + real(dp),dimension(:,:,:), allocatable :: gfrac ! fractional glacier area [0,1] + real(dp),dimension(:,:,:), allocatable :: gtopo ! glacier surface elevation (m) + real(dp),dimension(:,:,:), allocatable :: ghflx ! heat flux from glacier interior, positive down (W/m^2) + real(dp),dimension(:,:), allocatable :: grofi ! ice runoff (calving) flux (kg/m^2/s) + real(dp),dimension(:,:), allocatable :: grofl ! ice runoff (liquid) flux (kg/m^2/s) + real(dp),dimension(:,:), allocatable :: ice_sheet_grid_mask ! mask of ice sheet grid coverage + real(dp),dimension(:,:), allocatable :: icemask_coupled_fluxes ! mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + integer :: glc_nec ! , parameter :: glc_nec = 10 ! number of elevation classes + + real(dp),dimension(:), allocatable :: glc_topomax +! dimension(0:integer(glc_nec)) :: & +! glc_topomax = (/ 0.d0, 200.d0, 400.d0, 700.d0, 1000.d0, 1300.d0, & +! 1600.d0, 2000.d0, 2500.d0, 3000.d0, 10000.d0 /) ! upper limit of each class (m) + + logical :: ice_tstep ! true if ice timestep was done + logical :: output_flag ! true if outputs have been set + + ! from glint_commandline.F90: + character(len=5000) :: commandline_history !< complete command line + character(len=fname_length) :: commandline_configname !< name of the configuration file + character(len=fname_length) :: commandline_results_fname !< name of results file + character(len=fname_length) :: commandline_climate_fname !< name of climate configur + +end type gcm_to_cism_type + + logical, parameter :: verbose_glint = .true. ! set to true for debugging + +contains + +subroutine g2c_glint_init(g2c) + + ! Initialise glint + + implicit none + + type(gcm_to_cism_type) :: g2c + + integer :: i,j ! Array index counters + + ! ------------------------------------------------------------------------------------- + ! Executable code starts here - Basic initialisation + ! ------------------------------------------------------------------------------------- + integer, parameter :: glc_nec = 10 ! number of elevation classes + + real(dp), dimension(0:glc_nec) :: & + glc_topomax = (/ 0.d0, 200.d0, 400.d0, 700.d0, 1000.d0, 1300.d0, & + 1600.d0, 2000.d0, 2500.d0, 3000.d0, 10000.d0 /) ! upper limit of each class (m) + + g2c%glc_nec = glc_nec + g2c%glc_topomax = glc_topomax + + g2c%which_gcm = 1 + + call glint_GetCommandline() + + g2c%commandline_history = commandline_history !< complete command line + g2c%commandline_configname = commandline_configname !< name of the configuration file + g2c%commandline_results_fname = commandline_resultsname !< name of results file + g2c%commandline_climate_fname = commandline_climatename !< name of climate configuration + + call system_clock(g2c%clock,g2c%clock_rate) + g2c%t1 = real(g2c%clock,kind=dp)/real(g2c%clock_rate,kind=dp) + !print *,"g2c%clock, g2c%clock_rate, t1",g2c%clock,g2c%clock_rate,g2c%t1 + + if (verbose_glint .and. main_task) print*, 'call glex_clim_init' + + ! Initialise climate + + call glex_clim_init(g2c%climate,g2c%commandline_climate_fname) + + ! Set dimensions of global grids + + call get_grid_dims(g2c%climate%clim_grid,g2c%nx,g2c%ny) ! Normal global grid + g2c%nxo=200 ; g2c%nyo=100 ! Example grid used for orographic output + +!print *,"g2c% nxo, nyo, nx, ny: ",g2c%nxo,g2c%nyo,g2c%nx,g2c%ny,nxo,nyo + + ! start logging +! call open_log(unit=101, fname=logname(g2c%commandline_configname)) + + if (verbose_glint .and. main_task) then + print*, ' ' + print*, 'Starting glint_example:' + print*, 'climatename = ', trim(g2c%commandline_climate_fname) + print*, 'configname = ', trim(g2c%commandline_configname) + print*, 'climate%gcm_smb:', g2c%climate%gcm_smb + print*, ' ' + endif + + ! Allocate global arrays + + allocate(g2c%temp(g2c%nx,g2c%ny),g2c%precip(g2c%nx,g2c%ny),g2c%orog(g2c%nx,g2c%ny)) + allocate(g2c%coverage(g2c%nx,g2c%ny),g2c%orog_out(g2c%nxo,g2c%nyo),g2c%albedo(g2c%nx,g2c%ny)) +!!Check this: + allocate(g2c%ice_frac(g2c%nx,g2c%ny),g2c%fw(g2c%nx,g2c%ny)) + allocate(g2c%lats_orog(g2c%nyo),g2c%lons_orog(g2c%nxo),g2c%cov_orog(g2c%nxo,g2c%nyo),g2c%fw_in(g2c%nx,g2c%ny)) + + ! Initialize global arrays + + g2c%temp = 0.d0 + g2c%precip = 0.d0 + g2c%albedo = 0.d0 + g2c%orog_out = 0.d0 + g2c%orog = real(g2c%climate%orog_clim,dp) ! Put orography where it belongs + + ! Allocate and initialize GCM arrays + + if (g2c%climate%gcm_smb) then + + ! input from GCM + allocate(g2c%tsfc(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + allocate(g2c%qsmb(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + allocate(g2c%topo(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + + g2c%tsfc(:,:,:) = 0.d0 + g2c%qsmb(:,:,:) = 0.d0 + g2c%topo(:,:,:) = 0.d0 + + ! output to GCM + allocate(g2c%gfrac(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + allocate(g2c%gtopo(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + allocate(g2c%ghflx(g2c%nx,g2c%ny, 0:g2c%glc_nec)) + allocate(g2c%grofi(g2c%nx,g2c%ny)) + allocate(g2c%grofl(g2c%nx,g2c%ny)) + allocate(g2c%ice_sheet_grid_mask(g2c%nx,g2c%ny)) + allocate(g2c%icemask_coupled_fluxes(g2c%nx,g2c%ny)) + + g2c%gfrac(:,:,:) = 0.d0 + g2c%gtopo(:,:,:) = 0.d0 + g2c%ghflx(:,:,:) = 0.d0 + g2c%grofi(:,:) = 0.d0 + g2c%grofl(:,:) = 0.d0 + g2c%ice_sheet_grid_mask(:,:) = 0.d0 + g2c%icemask_coupled_fluxes(:,:) = 0.d0 + + endif + + ! Set up global grids ---------------------------------------------------------------- + + ! Calculate example orographic latitudes + + do j=1,g2c%nyo + g2c%lats_orog(j) = -(180.d0/g2c%nyo)*j + 90.d0 + (90.d0/g2c%nyo) + enddo + + ! Calculate example orographic longitudes + + do i=1,g2c%nxo + g2c%lons_orog(i) = (360.d0/g2c%nxo)*i - (180.d0/g2c%nxo) + enddo + + ! Initialise the ice model + + if (g2c%climate%gcm_smb) then ! act as if we are receiving the SMB from a GCM + + call initialise_glint_gcm(g2c%ice_sheet, & + g2c%climate%clim_grid%lats, & + g2c%climate%clim_grid%lons, & + g2c%climate%climate_tstep, & + (/g2c%commandline_configname/), & + daysinyear=g2c%climate%days_in_year, & + glc_nec = g2c%glc_nec, & + gfrac = g2c%gfrac, & + gtopo = g2c%gtopo, & + grofi = g2c%grofi, & + grofl = g2c%grofl, & + ghflx = g2c%ghflx, & + ice_sheet_grid_mask = g2c%ice_sheet_grid_mask, & + icemask_coupled_fluxes = g2c%icemask_coupled_fluxes) + + else ! standard Glint initialization + + call initialise_glint(g2c%ice_sheet, & + g2c%climate%clim_grid%lats, & + g2c%climate%clim_grid%lons, & + g2c%climate%climate_tstep, & + (/g2c%commandline_configname/), & + orog=g2c%orog_out, & + albedo=g2c%albedo, & + ice_frac=g2c%ice_frac, & + orog_longs=g2c%lons_orog, & + orog_lats=g2c%lats_orog, & + daysinyear=g2c%climate%days_in_year) + + endif ! gcm_smb + + ! Set the message level (1 is the default - only fatal errors) + ! N.B. Must do this after initialisation + + call glimmer_set_msg_level(6) + + ! Get coverage maps for the ice model instances + + if (g2c%climate%gcm_smb) then ! not using cov_orog + if (glint_coverage_map(g2c%ice_sheet, g2c%coverage) .ne. 0) then + call write_log('Unable to get coverage maps',GM_FATAL,__FILE__,__LINE__) + stop + endif + else + if (glint_coverage_map(g2c%ice_sheet, g2c%coverage, g2c%cov_orog) .ne. 0) then + call write_log('Unable to get coverage maps',GM_FATAL,__FILE__,__LINE__) + stop + endif + endif + + g2c%time = g2c%climate%climate_tstep ! time in integer hours + +! if (main_task) print*, 'Done in g2c_glint_init' + +end subroutine g2c_glint_init + + +subroutine g2c_glint_run(g2c) + + type(gcm_to_cism_type) :: g2c + + ! Do timesteps --------------------------------------------------------------------------- + + !TODO - Timestepping as in simple_glide? Initialize with time = 0, then update time right after 'do' + ! This would require changing some time logic inside the Glint subroutines. + +! g2c%time = g2c%climate%climate_tstep ! time in integer hours + +! do + + ! The SMB is computed crudely for now, just to test the GCM interfaces. + ! At some point we could read in a realistic SMB as in CESM TG runs. + + ! get current temp and precip fields + + call example_climate(g2c%climate, g2c%precip, g2c%temp, real(g2c%time,dp)) + + if (g2c%climate%gcm_smb) then ! act as if we are receiving the SMB from a GCM + + !TODO - For some reason, the gcm code is much slower than the pdd code. + ! Figure out why. + + ! call a simple subroutine to estimate qsmb and tsfc in different elevation classes + + call compute_gcm_smb(g2c%temp, g2c%precip, & + g2c%orog, & + g2c%qsmb, g2c%tsfc, & + g2c%topo, & + g2c%glc_nec, g2c%glc_topomax) + + call glint_gcm (g2c%ice_sheet, g2c%time, & + g2c%qsmb, g2c%tsfc, & + g2c%topo, & + output_flag = g2c%output_flag, & + ice_tstep = g2c%ice_tstep, & + gfrac = g2c%gfrac, & + gtopo = g2c%gtopo, & + grofi = g2c%grofi, & + grofl = g2c%grofl, & + ghflx = g2c%ghflx, & + ice_sheet_grid_mask = g2c%ice_sheet_grid_mask, & + icemask_coupled_fluxes = g2c%icemask_coupled_fluxes) + + else ! standard Glint timestepping + + call glint(g2c%ice_sheet, g2c%time, g2c%temp, g2c%precip, g2c%orog, & + orog_out=g2c%orog_out, albedo=g2c%albedo, output_flag=g2c%out, & + ice_frac=g2c%ice_frac, water_out=g2c%fw, water_in=g2c%fw_in, & + total_water_in=g2c%twin, total_water_out=g2c%twout, ice_volume=g2c%ice_vol) + + endif ! gcm_smb + + !g2c%time = g2c%time + g2c%climate%climate_tstep + ! if (g2c%time > g2c%climate%total_years*g2c%climate%hours_in_year) exit + +! end do ! main timestep loop + + if (GLC_DEBUG) then + ! Print time so as to have something to watch while the code runs + if (mod(real(g2c%time,dp),8760.d0) < 0.01) print*, 'time (yr) =', real(g2c%time,dp)/8760.d0 + end if +end subroutine g2c_glint_run + + +subroutine g2c_glint_climate_time_step(g2c) + type(gcm_to_cism_type) :: g2c + + g2c%time = g2c%time + g2c%climate%climate_tstep +end subroutine g2c_glint_climate_time_step + +subroutine g2c_glint_check_finished(g2c,finished) + type(gcm_to_cism_type) :: g2c + logical :: finished + + if (g2c%time > g2c%climate%total_years*g2c%climate%hours_in_year) then + finished = .true. + else + finished = .false. + endif + +end subroutine g2c_glint_check_finished + + +subroutine g2c_glint_end(g2c) + type(gcm_to_cism_type) :: g2c + + ! Finalise/tidy up everything ----------------------------------------------------------- + + call end_glint(g2c%ice_sheet) + call system_clock(g2c%clock,g2c%clock_rate) + t2 = real(g2c%clock,kind=dp)/real(g2c%clock_rate,kind=dp) + call glimmer_write_stats(g2c%commandline_results_fname,g2c%commandline_configname,g2c%t2-g2c%t1) + + ! 101 format(e12.5) + +end subroutine g2c_glint_end + +!--------------------------------------------------------------------------------- + + +end module gcm_to_cism_glint diff --git a/components/cism/glimmer-cism/cism_driver/testsfg.F90 b/components/cism/glimmer-cism/cism_driver/testsfg.F90 new file mode 100644 index 0000000000..50988426c4 --- /dev/null +++ b/components/cism/glimmer-cism/cism_driver/testsfg.F90 @@ -0,0 +1,284 @@ +module testsFG +! Copyright (C) 2005-2007 Ed Bueler +! +! This file is part of PISM. +! +! PISM is free software; you can redistribute it and/or modify it under the +! terms of the GNU General Public License as published by the Free Software +! Foundation; either version 2 of the License, or (at your option) any later +! version. +! +! PISM is distributed in the hope that it will be useful, but WITHOUT ANY +! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +! details. +! +! You should have received a copy of the GNU General Public License +! along with PISM; if not, write to the Free Software +! Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! TESTSFG is a Fortran 90 implementation of two exact solutions for a +! thermocoupled ice sheet. Reference: +! +! E. Bueler, J. Brown, and C. Lingle (2007). "Exact solutions to the +! thermomechanically coupled shallow ice approximation: effective tools +! for verification", J. Glaciol., J. Glaciol., vol. 53 no. 182, 499--516. +! +! ELB 3/29/05; 7/27/07; 7/29/08 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + use glimmer_global, only : dp + public :: testF, testG + private :: bothexact, p3, p4 + + ! DOUBLE PRECISION DESIRABLE: + integer, parameter, public :: kind=dp + + real(kind), parameter, public :: SperA = 31556926.0 ! 365.2422 days + real(kind), parameter, public :: g=9.81 ! m/s^2; accel of gravity + real(kind), parameter, public :: Rgas=8.314 ! J/(mol K) + + ! ice properties; parameters which appear in constitutive relation + real(kind), parameter, public :: rho=910.0 ! kg/m^3; density + real(kind), parameter, public :: k=2.1 ! J/m K s; thermal conductivity + real(kind), parameter, public :: cpheat=2009.0! J/kg K; specific heat capacity + real(kind), parameter, public :: n=3 ! Glen exponent + ! next two are EISMINT II values; Paterson-Budd for T<263 + real(kind), parameter, public :: A=3.615e-13 ! Pa^-3 s^-1 + real(kind), parameter, public :: Q=6.0e4 ! J/mol + + ! EISMINT II temperature boundary condition (Experiment F): + real(kind), parameter, public :: Ggeo=.042 ! J/m^2 s; geo. heat flux + real(kind), parameter, public :: ST=1.67e-5 ! K m^-1 + real(kind), parameter, public :: Tmin=223.15 ! K + + ! parameters describing extent of sheet + real(kind), parameter, public :: H0=3000.0 ! m + real(kind), parameter, public :: L=750000.0 ! m + + ! period and magnitude of perturbation; inactive in Test F: + real(kind), parameter, public :: Tp=2000.0*SperA ! s + real(kind), parameter, public :: Cp=200.0 ! m + +contains + + subroutine testF(r,z,H,T,U,w,Sig,M,Sigc) + real(kind), intent(in) :: r, z + real(kind), intent(out) :: H, T, U, w, Sig, M, Sigc + call bothexact(0.0_kind,r,z,0.0_kind,H,T,U,w,Sig,M,Sigc) + end subroutine testF + + subroutine testG(t,r,z,H,TT,U,w,Sig,M,Sigc) + real(kind), intent(in) :: t, r, z + real(kind), intent(out) :: H, TT, U, w, Sig, M, Sigc + call bothexact(t,r,z,Cp,H,TT,U,w,Sig,M,Sigc) + end subroutine testG + + subroutine bothexact(t,r,z,Cp,H,TT,U,w,Sig,M,Sigc) + real(kind), intent(in) :: t, r, z, Cp + real(kind), intent(out) :: H, TT, U, w, Sig, M, Sigc + + real(kind), parameter :: pi = 3.14159265358979 + real(kind), parameter :: Kcond=k/(rho*cpheat) ! constant in temp eqn + + ! declare all temporary quantities real(kind); computed in blocks below + real(kind) pow, Hconst, s, lamhat, f, goft, Ts, nusqrt, nu + real(kind) lamhatr, fr, Hr, mu, I3, surfArr, Uconst, omega + real(kind) Sigmu, lamhatrr, frr, Hrr, Tsr, nur, mur, phi, gamma, I4 + real(kind) I4H, divQ, Ht, nut, dTt, Tr, Tz, Tzz + + if (r<=0 .or. r>=L) then + print *,'code and derivation assume 00.3*L .and. r<0.9*L) then + f = ( cos(pi*(r-0.6*L)/(0.6*L)) )**2 + else + f = 0.0 + end if + goft = Cp*sin(2.0*pi*t/Tp) + H = Hconst*(lamhat)**pow + goft*f + + ! compute TT = temperature + Ts = Tmin+ST*r + nusqrt = sqrt( 1 + (4.0*H*Ggeo)/(k*Ts) ) + nu = ( k*Ts/(2.0*Ggeo) )*( 1 + nusqrt ) + TT = Ts * (nu+H) / (nu+z) + + ! compute surface slope and horizontal velocity + lamhatr = ((1+1/n)/L)*( 1 - (1-s)**(1/n) - s**(1/n) ) + if (r>0.3*L .and. r<0.9*L) then + fr = -(pi/(0.6*L)) * sin(2.0*pi*(r-0.6*L)/(0.6*L)) + else + fr = 0.0 + end if + Hr = Hconst * pow * lamhat**(pow-1) * lamhatr + goft*fr ! chain rule + if (Hr>0) then + print *,'code and derivation assume H_r negative for all 00.3*L .and. r<0.9*L) then + frr = -(2.0*pi*pi/(0.36*L*L)) * cos(2.0*pi*(r-0.6*L)/(0.6*L)) + else + frr = 0.0 + end if + Hrr = Hconst*pow*(pow-1)*(lamhat)**(pow-2) * lamhatr**2 + & + Hconst*pow*(lamhat)**(pow-1)*lamhatrr + goft*frr + Tsr = ST + nur = (k*Tsr/(2.0*Ggeo)) * (1 + nusqrt) + & + (1/Ts) * (Hr*Ts-H*Tsr) / nusqrt + mur = (-Q/(Rgas*Ts*Ts*(nu+H)**2)) * (Tsr*(nu+H)+Ts*(nur+Hr)) + phi = 1/r + n*Hrr/Hr + Q*Tsr/(Rgas*Ts*Ts) - (n+1)*mur/mu ! division by r + gamma = mu**n * exp(mu*H) * (mur*H+mu*Hr) * H**n + I4 = p4(mu*H) * exp(mu*H) - p4(mu*(H-z)) * exp(mu*(H-z)) + w = omega * ((mur/mu - phi)*I4/mu + (phi*(H-z)+Hr)*I3 - gamma*z) + + ! compute compensatory accumulation M + I4H = p4(mu*H) * exp(mu*H) - 24 + divQ = - omega * (mur/mu - phi) * I4H / mu + omega * gamma * H + Ht = (Cp*2.0*pi/Tp) * cos(2.0*pi*t/Tp) * f + M = Ht + divQ + + ! compute compensatory heating + nut = Ht/nusqrt + dTt = Ts * ((nut+Ht)*(nu+z)-(nu+H)*nut) * (nu+z)**(-2) + Tr = Tsr*(nu+H)/(nu+z) + Ts * ((nur+Hr)*(nu+z)-(nu+H)*nur) * (nu+z)**(-2) + Tz = -Ts * (nu+H) * (nu+z)**(-2) + Tzz = 2.0 * Ts * (nu+H) * (nu+z)**(-3) + Sigc = dTt + U*Tr + w*Tz - Kcond*Tzz - Sig + end subroutine bothexact + + function p3(x) + real(kind), intent(in) :: x + !real(kind) :: p3 + ! p_3=x^3-3*x^2+6*x-6, using Horner's + p3 = -6 + x*(6 + x*(-3 + x)) + end function p3 + + function p4(x) + real(kind), intent(in) :: x + !real(kind) :: p4 + ! p_4=x^4-4*x^3+12*x^2-24*x+24, using Horner's + p4 = 24 + x*(-24 + x*(12 + x*(-4 + x))) + end function p4 + + subroutine model_exact(t,r,z,Hh,H0,TT,U,w,Sig,M,Sigc) + real(kind), intent(in) :: t, r, z, Hh, H0 + real(kind), intent(inout) :: TT + real(kind), intent(out) :: U, w, Sig, M, Sigc + + real(kind), parameter :: pi = 3.14159265358979 + real(kind), parameter :: Kcond=k/(rho*cpheat) ! constant in temp eqn + + ! declare all temporary quantities real(kind); computed in blocks below + real(kind) pow, Hconst, s, lamhat, f, goft, Ts, nusqrt, nu + real(kind) lamhatr, fr, Hr, mu, I3, surfArr, Uconst, omega + real(kind) Sigmu, lamhatrr, frr, Hrr, Tsr, nur, mur, phi, gamma, I4 + real(kind) I4H, divQ, Ht, nut, dTt, Tr, Tz, Tzz + real Cp, H + + if (r<=0 .or. r>=L) then + print *,'code and derivation assume 00.3*L .and. r<0.9*L) then + f = ( cos(pi*(r-0.6*L)/(0.6*L)) )**2 + else + f = 0.0 + end if + goft = Cp*sin(2.0*pi*t/Tp) + !H = Hconst*(lamhat)**pow + goft*f + if (H .gt. Hconst*(lamhat)**pow + goft*f) then + H = Hconst*(lamhat)**pow + goft*f + end if + ! compute TT = temperature + Ts = Tmin+ST*r + nusqrt = sqrt( 1 + (4.0*H*Ggeo)/(k*Ts) ) + nu = ( k*Ts/(2.0*Ggeo) )*( 1 + nusqrt ) + if(TT .eq. 0.0) then + TT = Ts * (nu+H) / (nu+z) + end if + + ! compute surface slope and horizontal velocity + lamhatr = ((1+1/n)/L)*( 1 - (1-s)**(1/n) - s**(1/n) ) + if (r>0.3*L .and. r<0.9*L) then + fr = -(pi/(0.6*L)) * sin(2.0*pi*(r-0.6*L)/(0.6*L)) + else + fr = 0.0 + end if + Hr = Hconst * pow * lamhat**(pow-1) * lamhatr + goft*fr ! chain rule + if (Hr>0) then + print *,'code and derivation assume H_r negative for all 00.3*L .and. r<0.9*L) then + frr = -(2.0*pi*pi/(0.36*L*L)) * cos(2.0*pi*(r-0.6*L)/(0.6*L)) + else + frr = 0.0 + end if + Hrr = Hconst*pow*(pow-1)*(lamhat)**(pow-2) * lamhatr**2 + & + Hconst*pow*(lamhat)**(pow-1)*lamhatrr + goft*frr + Tsr = ST + nur = (k*Tsr/(2.0*Ggeo)) * (1 + nusqrt) + & + (1/Ts) * (Hr*Ts-H*Tsr) / nusqrt + mur = (-Q/(Rgas*Ts*Ts*(nu+H)**2)) * (Tsr*(nu+H)+Ts*(nur+Hr)) + phi = 1/r + n*Hrr/Hr + Q*Tsr/(Rgas*Ts*Ts) - (n+1)*mur/mu ! division by r + gamma = mu**n * exp(mu*H) * (mur*H+mu*Hr) * H**n + I4 = p4(mu*H) * exp(mu*H) - p4(mu*(H-z)) * exp(mu*(H-z)) + w = omega * ((mur/mu - phi)*I4/mu + (phi*(H-z)+Hr)*I3 - gamma*z) + + ! compute compensatory accumulation M + I4H = p4(mu*H) * exp(mu*H) - 24 + divQ = - omega * (mur/mu - phi) * I4H / mu + omega * gamma * H + Ht = (Cp*2.0*pi/Tp) * cos(2.0*pi*t/Tp) * f + M = Ht + divQ + + ! compute compensatory heating + nut = Ht/nusqrt + dTt = Ts * ((nut+Ht)*(nu+z)-(nu+H)*nut) * (nu+z)**(-2) + Tr = Tsr*(nu+H)/(nu+z) + Ts * ((nur+Hr)*(nu+z)-(nu+H)*nur) * (nu+z)**(-2) + Tz = -Ts * (nu+H) * (nu+z)**(-2) + Tzz = 2.0 * Ts * (nu+H) * (nu+z)**(-3) + Sigc = dTt + U*Tr + w*Tz - Kcond*Tzz - Sig + end subroutine model_exact +end module testsFG diff --git a/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.H b/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.H new file mode 100644 index 0000000000..5bed43bdf2 --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.H @@ -0,0 +1,35 @@ +// The DyCoreToGlimmer class provides methods to move Glimmer Fortran data to C++ structures +// for access by the Chombo-based BISICLES model. The structure names and structure member +// names mostly correspond to derived types defined in Glimmer. In general, pointers to +// the Fortran data arrays are used, rather than copies of these arrays. This saves space +// and reduces the steps needed to update the Glimmer data between calls to the BISICLES +// ice sheet modeling program. Methods are provided to set these array pointers, and +// copy array dimension information. Objects of this class are accessed by extern C +// routines in bike_to_glim_extern.cpp, and by the BISICLES front end. DMR--5/24/10 + +#ifndef BISICLESTOGLIMMER +#define BISICLESTOGLIMMER + + +#include +#include +#include "bike_driver.H" +#include "../DyCoreToGlimmer.H" + + +class BisiclesToGlimmer : public DyCoreToGlimmer +{ + private: + // AmrIce bisicles_object; + + public: + + //DynCoreToGlimmer BisiclesToGlimmer(); + int initDyCore(const char * input_fname); + // cur_time_yr is updated in place as solution is evolved + int runDyCore(double& cur_time_yr, const double time_inc_yr); + int deleteDyCore(); + +}; + +#endif diff --git a/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.cpp b/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.cpp new file mode 100644 index 0000000000..9122389c4a --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/BISICLES/BisiclesToGlimmer.cpp @@ -0,0 +1,54 @@ +// The DyCoreToGlimmer class provides methods to move Glimmer Fortran data to C++ structures +// for access by the Chombo-based BISICLES model. The structure names and structure member +// names mostly correspond to derived types defined in Glimmer. In general, pointers to +// the Fortran data arrays are used, rather than copies of these arrays. This saves space +// and reduces the steps needed to update the Glimmer data between calls to the BISICLES +// ice sheet modeling program. Methods are provided to set these array pointers, and +// copy array dimension information. Objects of this class are accessed by extern C +// routines in bike_to_glim_extern.cpp, and by the BISICLES front end. DMR--5/24/10 + +#include "BisiclesToGlimmer.H" + + +using namespace std; + + +int +BisiclesToGlimmer::initDyCore(const char * input_fname) +{ + + // long * dimInfo; + + cout << "In BISICLES initDyCore" << endl; + // dimInfo = this -> getLongVar("dimInfo","geometry"); + + + // cout << "DimInfo in initDyCore: " << endl; + // for (i=0;i<10;i++) cout << dimInfo[i] << " "; + // cout << "In BISICLES initDyCore, calling bike_driver_inin:" << endl; + bike_driver_init(2,0,this,input_fname); + return 0; // ought to make sensible use of this. + +} + +// updates cur_time_yr to match time update in dycore +int +BisiclesToGlimmer::runDyCore(double& cur_time_yr, const double time_inc_yr) +{ + cout << "In BISICLES runDyCore" << endl; + bike_driver_run(this,cur_time_yr,time_inc_yr); + return 0; // ought to make sensible use of this. +} + +int +BisiclesToGlimmer::deleteDyCore() +{ + bike_driver_finalize(this -> getDyCoreIndex()); + return 0; // ought to make sensible use of this. +} + +//int storeBisiclesObject(AmrIce bisicles_object) +//{} + +//AmrIce retrieveBisiclesObject() +//{} diff --git a/components/cism/glimmer-cism/libdycore/CHANGELOG b/components/cism/glimmer-cism/libdycore/CHANGELOG new file mode 100644 index 0000000000..a80c0cde98 --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/CHANGELOG @@ -0,0 +1,9 @@ +Changes in libdycore and its subdirectories: + +10/4/10 (DFM) +(a) BISICLES/BisiclesToGlimmer.[H,cpp] -- removed hardwired path to bike_driver.H + +(b) dycore_to_glimmer_extern.cpp -- included and in order to compile on my machine here at LBL + +(c) DyCoreToGlimmer.cpp -- include + diff --git a/components/cism/glimmer-cism/libdycore/CMakeLists.txt b/components/cism/glimmer-cism/libdycore/CMakeLists.txt new file mode 100644 index 0000000000..e648d5d00b --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/CMakeLists.txt @@ -0,0 +1,19 @@ +# libdycore build + +FILE(GLOB DYCORE_SOURCES *.cpp *.cpp) +FILE(GLOB DYCORE_HEADERS *.H *.H) + +IF (CISM_ENABLE_BISICLES) + FILE(GLOB BISICLES_SOURCES *.cpp BISICLES/*.cpp) + FILE(GLOB BISICLES_HEADERS *.H BISICLES/*.H) +ENDIF() + +add_library(DyCoreToGlimmer ${DYCORE_SOURCES} ${DYCORE_HEADERS} + ${BISICLES_SOURCES} ${BISICLES_HEADERS}) + +# Need include directories from Trilinos but also mod files from glimmer + +include_directories (${BISICLES_INTERFACE_DIR}) + + + diff --git a/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.H b/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.H new file mode 100644 index 0000000000..67cd0c355f --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.H @@ -0,0 +1,50 @@ +// DyCoreModelRegistry is used to store multiple dynamic core models +// without using global variables, and allowing retrieval by an +// integer model index. --DMR 5/24/10 + +#include "DyCoreToGlimmer.H" +//IK, 8/6/13: added some ifdefs here to allow for other external dycores than just bisicles + +#ifdef CISM_HAS_BISICLES +#include "BISICLES/BisiclesToGlimmer.H" +#endif +//#include "Ymir/YmirToGlimmer.H" +//IK, 8/6/13: added the following for FELIX as external dycore +#ifdef CISM_HAS_FELIX +#include "FELIX/FelixToGlimmer.H" +#endif + +#ifndef DYCORE_MODEL_REGISTRY +#define DYCORE_MODEL_REGISTRY + +#define DYCORE_MODEL_COUNT 10 + +class DyCoreModelRegistry +{ + private: + + struct RegistryEntry { + DyCoreToGlimmer * dycore_to_glimmer; + int dycore_type; // 0=BISICLES, 1=Ymir, 2=FELIX + int my_reg_index; + int dycore_present; + } entry[DYCORE_MODEL_COUNT]; + + int cur_model_count; + + + public: + + DyCoreModelRegistry(); + int ClearRegistryEntries(); + int ClearRegistryEntry(int index); + DyCoreToGlimmer * getDyCoreToGlimmerByIndex(int index); + //int * getDyCoreToGlimmerByIndex(int index); + int getModelCount(); + int incModelCount(); + int setDyCoreByType(int index,int dyncore_type); + int setRegistryIndex(int index); + int getRegistryIndex(int index); +}; + +#endif diff --git a/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.cpp b/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.cpp new file mode 100644 index 0000000000..d13dc0457a --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/DyCoreModelRegistry.cpp @@ -0,0 +1,126 @@ +// DyCoreModelRegistry is used to store multiple dynamic core models +// without using global variables, and allowing retrieval by an +// integer model index. --DMR 5/24/10 + +// 4/9/12 (DMR) commented out Ymir object creation because of a build +// problem on hopper.nersc.gov + +#include +#include +#include +#include "DyCoreModelRegistry.H" + +using namespace std; + +// RegistryEntry entry[BISICLES_MODEL_COUNT]; + +DyCoreModelRegistry::DyCoreModelRegistry() +{ + cur_model_count = 0; +} + +int +DyCoreModelRegistry::ClearRegistryEntries() +{ + int i; + + for (i=0;i deleteDyCore(); + delete entry[index].dycore_to_glimmer; + } + entry[index].dycore_present = 0; + return(0); +} + +DyCoreToGlimmer * +DyCoreModelRegistry::getDyCoreToGlimmerByIndex(int index) +{ + + // cout << index << " Registry entry dycore type: " << entry[index].dycore_type << endl; + //IK, 8/6/13: added error checking here so that if entry[index].dycore_to_glimmer is has not been set + //properly in setDyCoreByType, the code will abort. + if ((entry[index].dycore_to_glimmer) == NULL) { + fprintf(stderr, "Error in DyCoreModelRegistry::getDyCoreToGlimmerByIndex: external dycore not set properly in setDyCoreByType. \n"); + fprintf(stderr, "Aborting... \n"); + exit(1); + } + return((DyCoreToGlimmer *) entry[index].dycore_to_glimmer); +} + +int +DyCoreModelRegistry::setDyCoreByType(int index,int dycore_type) +{ + entry[index].dycore_type = dycore_type; + entry[index].dycore_present = 1; + + switch (entry[index].dycore_type) { + case 0: + entry[index].dycore_to_glimmer = NULL; + break; + case 1: // BISICLES dycore +//IK, 8/6/13: added ifdefs here to allow multiple external dycores +#ifdef CISM_HAS_BISICLES + entry[index].dycore_to_glimmer = new BisiclesToGlimmer; +#else + entry[index].dycore_to_glimmer = NULL; +#endif + break; + case 2: //IK, 8/6/13: added case for FELIX dycore +#ifdef CISM_HAS_FELIX + entry[index].dycore_to_glimmer = new FelixToGlimmer; +#else + entry[index].dycore_to_glimmer = NULL; +#endif + break; + case 3: + //entry[index].dycore_to_glimmer = new YmirToGlimmer; + break; + + default: entry[index].dycore_to_glimmer = NULL; + break; + } + return(0); +} + + +int +DyCoreModelRegistry::getModelCount() +{ + return(cur_model_count); +} + +int +DyCoreModelRegistry::incModelCount() +{ + cur_model_count++; + return(0); +} + +int +DyCoreModelRegistry::setRegistryIndex(int index) +{ + entry[index].my_reg_index = index; + return(0); +} + +int +DyCoreModelRegistry::getRegistryIndex(int index) +{ + return(entry[index].my_reg_index); +} diff --git a/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.H b/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.H new file mode 100644 index 0000000000..1b7ba47ddd --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.H @@ -0,0 +1,147 @@ +// The DyCoreToGlimmer class provides methods to move Glimmer Fortran data to C++ structures +// for access by C++ based dynamical cores. The structure names and structure member +// names mostly correspond to derived types defined in Glimmer. In general, pointers to +// the Fortran data arrays are used, rather than copies of these arrays. This saves space +// and reduces the steps needed to update the Glimmer data between calls to the core +// ice sheet modeling program. Methods are provided to set these array pointers, and +// copy array dimension information. Objects of this class are accessed by extern C +// routines in dycore_to_glimmer_extern.cpp, and by the dynamical core front end. DMR--5/24/10 + +//#pragma once +#ifndef DYCORETOGLIMMER +#define DYCORETOGLIMMER + +#include +#include + + +class DyCoreToGlimmer +{ + + private: + + // Keep track of dycore_type and dycore_index. Dycore_index is used to index the + // the external dycore object storage array. + struct { + int dycore_type; + int dycore_index; + } dycore_info; + + // The following structures are based on the derived types in glide_types.F90 + + struct { + double * thck; + double * usrf; + double * lsrf; + double * topg; + double * floating_mask; + double * ice_mask; + double * lower_cell_loc; // z-location of lowest cell-center + double * lower_cell_temp; // temperature in lowest cell + long * dimInfo; + long * ewlb; + long * ewub; + long * nslb; + long * nsub; + long * nhalo; + + //double * thkmask; + //double * marine_bc_normal; + + } geometry; + + struct { + double * uvel; //output + double * vvel; //output + double * wvel; + double * wgrd; + double * btrc; // basal traction coefficient + long * dimInfo; + } velocity; + + struct { + double * temp; // Three-dimensional temperature field. + double * bheatflx; // basal heat flux (2D) + double * bmlt; // Basal melt-rate + long * dimInfo; + } temper; + + struct { + + } lithot_type; + + struct { + double * tstart; + double * tend; + double * time; + //double * tinc; + + double * dew; // ew cell size + double * dns; // ns cell size + + } numerics; + + struct { + double * acab; // Annual mass balance. + double * acab_tavg; // Annual mass balance (time average) + double * calving; // Calving flux (scaled as mass balance, thickness, etc) + long * dimInfo; + double * eus; // eustatic sea level + } climate; + + struct { + double * beta; // basal shear coefficient + double * btraction; // -dir (1,:,:) and y-dir (2,:,:) "consistent" basal + // traction fields (calculated from matrix coeffs) + long dimInfo; + } velocity_hom; + + struct { + double seconds_per_year; + double gravity; + double rho_ice; + double rho_seawater; + double therm_diffusivity_ice; + double heat_capacity_ice; + } constants; + + + struct { + long * communicator; + long * process_count; + long * my_rank; + } mpi_vars; + + public: + + DyCoreToGlimmer(); + virtual ~DyCoreToGlimmer(); + + + int setDoubleVar( double *var, const char *var_name, const char *struct_name); + double * getDoubleVar( const char *var_name, const char *struct_name); + + int setLongVar( long * var, const char * var_name, const char *struct_name); + long * getLongVar( const char * var_name, const char *struct_name); + + int setInt4Var( int * var, const char * var_name, const char *struct_name); + int * getInt4Var( const char * var_name, const char *struct_name); + + int copyInDoubleVar( const double *var, const char *var_name, + const char *struct_name, const long *var_dim_info); + int copyInLongVar( const long *var, const char *var_name, + const char *struct_name, const long *var_dim_info); + + virtual int initDyCore(const char *input_fname); // = 0; + virtual int runDyCore(double& cur_time_yr, const double time_inc_yr); // = 0; + virtual int deleteDyCore(); // = 0; + + int setDyCoreType(const int dycore_type); + int getDyCoreType(); + + int setDyCoreIndex(const int dycore_index); + int getDyCoreIndex(); + +}; + +#endif diff --git a/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.cpp b/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.cpp new file mode 100644 index 0000000000..aa3810e67e --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/DyCoreToGlimmer.cpp @@ -0,0 +1,585 @@ +// The DyCoreToGlimmer class provides methods to move Glimmer Fortran data to C++ structures +// for access by the Chombo-based BISICLES model. The structure names and structure member +// names mostly correspond to derived types defined in Glimmer. In general, pointers to +// the Fortran data arrays are used, rather than copies of these arrays. This saves space +// and reduces the steps needed to update the Glimmer data between calls to the BISICLES +// ice sheet modeling program. Methods are provided to set these array pointers, and +// copy array dimension information. Objects of this class are accessed by extern C +// routines in dycore_to_glimmer_extern.cpp, and by the BISICLES front end. DMR--5/24/10 + +#include "DyCoreToGlimmer.H" +#include + +using namespace std; + +//DyCoreToGlimmer::DyCoreToGlimmer(int dycore_type) +DyCoreToGlimmer::DyCoreToGlimmer() +{ + // initialize all pointerrs to null + // geometry... + geometry.thck = NULL; + geometry.usrf = NULL; + geometry.lsrf = NULL; + geometry.topg = NULL; + geometry.floating_mask = NULL; + geometry.ice_mask = NULL; + geometry.lower_cell_loc = NULL; + geometry.lower_cell_temp = NULL; + geometry.dimInfo = NULL; + geometry.ewlb = NULL; + geometry.ewub = NULL; + geometry.nslb = NULL; + geometry.nsub = NULL; + geometry.nhalo = NULL; + + // velocity + velocity.uvel = NULL; //output + velocity.vvel = NULL; //output + velocity.wvel = NULL; + velocity.wgrd = NULL; + velocity.btrc = NULL; // basal traction coefficient + velocity.dimInfo = NULL; + + // temper + temper.temp = NULL; // Three-dimensional temperature field. + temper.bheatflx = NULL; // basal heat flux (2D) + temper.bmlt = NULL; // Basal melt-rate + + // numerics + numerics.tstart = NULL; // start time + numerics.tend = NULL; // end time + numerics.time = NULL; // current time + + numerics.dew = NULL; // ew cell size + numerics.dns = NULL; // ns cell size + + // constants are doubles, not pointers. Set to nonphysical values + double bogusVal = -1.2345e10; + constants.seconds_per_year = bogusVal; + constants.gravity = bogusVal; + constants.rho_ice = bogusVal; + constants.rho_seawater = bogusVal; + constants.therm_diffusivity_ice = bogusVal; + constants.heat_capacity_ice = bogusVal; + + + // climate + climate.acab = NULL; // Annual mass balance. + climate.acab_tavg = NULL; // Annual mass balance (time average) + climate.calving = NULL; // Calving flux (scaled as mass balance, thickness,) + climate.dimInfo = NULL; + climate.eus = NULL; // eustatic sea level + +} + +DyCoreToGlimmer::~DyCoreToGlimmer() +{ + // cout << "Init DyCoreToGlimmer" << endl; +} + +int +DyCoreToGlimmer::setDoubleVar(double *var, const char *var_name, const char *struct_name) +{ + //cout << "struct_name::" << struct_name << "::" << endl; + + if (strcmp(struct_name,"geometry") == 0) { + if (strcmp(var_name,"thck") == 0) geometry.thck = var; + else if (strcmp(var_name,"topg") == 0) geometry.topg = var; + else if (strcmp(var_name,"usrf") == 0) geometry.usrf = var; + else if (strcmp(var_name,"lsrf") == 0) geometry.lsrf = var; + else if (strcmp(var_name,"floating_mask") == 0) geometry.floating_mask = var; + else if (strcmp(var_name,"ice_mask") == 0) geometry.ice_mask = var; + else if (strcmp(var_name,"lower_cell_loc") == 0) geometry.lower_cell_loc = var; + else if (strcmp(var_name,"lower_cell_temp") == 0) geometry.lower_cell_temp = var; + else cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + + else if (strcmp(struct_name,"velocity") == 0) { + if (strcmp(var_name,"uvel") == 0) velocity.uvel = var; + else if (strcmp(var_name,"vvel") == 0) velocity.vvel = var; + else if (strcmp(var_name,"wvel") == 0) velocity.wvel = var; + else if (strcmp(var_name,"wgrd") == 0) velocity.wgrd = var; + else if (strcmp(var_name,"btrc") == 0) velocity.btrc = var; + else cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + + + } + + + + else if (strcmp(struct_name,"temper") == 0) { + if (strcmp(var_name,"temp") == 0) temper.temp = var; + else if (strcmp(var_name,"bheatflx") == 0) temper.bheatflx = var; + else if (strcmp(var_name,"bmlt") == 0) temper.bmlt = var; + else cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + else if (strcmp(struct_name,"numerics") == 0) { + if (strcmp(var_name,"tstart") == 0) numerics.tstart = var; + else if (strcmp(var_name,"tend") == 0) numerics.tend = var; + else if (strcmp(var_name,"time") == 0) numerics.time = var; + else cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + else if (strcmp(struct_name,"climate") == 0) { + if (strcmp(var_name,"acab") == 0) climate.acab = var; + else if (strcmp(var_name,"acab_tavg") == 0) climate.acab_tavg = var; + else if (strcmp(var_name,"calving") == 0) climate.calving = var; + else cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + return(0); +} + +double * +DyCoreToGlimmer::getDoubleVar(const char *var_name, const char *struct_name) +{ + + double * var=0; + + //cout << "struct_name::" << struct_name << "::" << endl; + + if (strcmp(struct_name,"geometry") == 0) { + if (strcmp(var_name,"thck") == 0) + { + return(geometry.thck); + } + else if (strcmp(var_name,"topg") == 0) + { + return(geometry.topg); + } + else if (strcmp(var_name,"usrf") == 0) + { + return(geometry.usrf); + } + else if (strcmp(var_name,"lsrf") == 0) + { + return(geometry.lsrf); + } + else if (strcmp(var_name,"floating_mask") == 0) + { + return(geometry.floating_mask); + } + else if (strcmp(var_name,"ice_mask") == 0) + { + return(geometry.ice_mask); + } + else if (strcmp(var_name,"lower_cell_loc") == 0) + { + return(geometry.lower_cell_loc); + } + else if (strcmp(var_name,"lower_cell_temp") == 0) + { + return(geometry.lower_cell_temp); + } + else + { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + } + else if (strcmp(struct_name,"numerics") == 0) { + if (strcmp(var_name,"dew") == 0) return(numerics.dew); + else if (strcmp(var_name,"dns") == 0) return(numerics.dns); + else if (strcmp(var_name,"tstart") == 0) return(numerics.tstart); + else if (strcmp(var_name,"tend") == 0) return(numerics.tend); + else if (strcmp(var_name,"time") == 0) return(numerics.time); + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + } + else if (strcmp(struct_name,"constants") == 0) { + if (strcmp(var_name,"seconds_per_year") == 0) return(&constants.seconds_per_year); + else if (strcmp(var_name,"gravity") == 0) return(&constants.gravity); + else if (strcmp(var_name,"rho_ice") == 0) return(&constants.rho_ice); + else if (strcmp(var_name,"rho_seawater") == 0) return(&constants.rho_seawater); + else if (strcmp(var_name,"therm_diffusivity_ice") == 0) return(&constants.therm_diffusivity_ice); + else if (strcmp(var_name,"heat_capacity_ice") == 0) return(&constants.heat_capacity_ice); + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + } + else if (strcmp(struct_name,"velocity") == 0) { + if (strcmp(var_name,"btrc") == 0) return (velocity.btrc); + else if (strcmp(var_name,"uvel") == 0) return (velocity.uvel); + else if (strcmp(var_name,"vvel") == 0) return (velocity.vvel); + else if (strcmp(var_name,"wvel") == 0) return (velocity.wvel); + else if (strcmp(var_name,"wgrd") == 0) return (velocity.wgrd); + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + //cout << "Set velocity var, " << var_name << endl; + } + + else if (strcmp(struct_name,"temper") == 0) { + if (strcmp(var_name,"temp") == 0) var = temper.temp; + else if (strcmp(var_name,"bheatflx") == 0) var = temper.bheatflx; + else if (strcmp(var_name,"bmlt") == 0) var = temper.bmlt; + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + } + + else if (strcmp(struct_name,"climate") == 0) { + if (strcmp(var_name,"acab") == 0) var = climate.acab; + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + } + else { + cerr << "unknown variable type = " << struct_name + << "." << var_name << " undefined!" << endl; + } + return(var); +} + + +int +DyCoreToGlimmer::setLongVar(long * var, const char *var_name, const char *struct_name) +{ + if (strcmp(struct_name,"geometry") == 0) { + if (strcmp(var_name,"dimInfo") == 0) geometry.dimInfo = var; + } + else if (strcmp(struct_name,"velocity") == 0) { + //cout << "Set velocity var, " << var_name << endl; + } + else { + cerr << "unknown longVar type = " << struct_name + << "." << var_name << endl; + } + return(0); +} + + + +long * +DyCoreToGlimmer::getLongVar( const char *var_name, const char *struct_name) +{ + long * var; + + if (strcmp(struct_name,"geometry") == 0) { + if (strcmp(var_name,"dimInfo") == 0) var = geometry.dimInfo; + else if (strcmp(var_name,"ewlb") == 0) var = geometry.ewlb; + else if (strcmp(var_name,"ewub") == 0) var = geometry.ewub; + else if (strcmp(var_name,"nslb") == 0) var = geometry.nslb; + else if (strcmp(var_name,"nsub") == 0) var = geometry.nsub; + else if (strcmp(var_name,"nhalo") == 0) var = geometry.nhalo; + else + { + cerr << "unknonwn variable " << var_name << " in " + << struct_name << endl; + } + } + else if (strcmp(struct_name,"mpi_vars") == 0) { + if (strcmp(var_name,"communicator") == 0) var = mpi_vars.communicator; + else if (strcmp(var_name,"process_count") == 0) var = mpi_vars.process_count; + else if (strcmp(var_name,"my_rank") == 0) var = mpi_vars.my_rank; + else + { + cerr << "unknonwn variable " << var_name << " in " + << struct_name << endl; + } + } + + else if (strcmp(struct_name,"velocity") == 0) { + if (strcmp(var_name,"dimInfo") == 0) var = velocity.dimInfo; + else + { + cerr << "unknonwn variable " << var_name << " in " + << struct_name << endl; + } + } + + else if (strcmp(struct_name,"climate") == 0) { + if (strcmp(var_name,"dimInfo") == 0) var = climate.dimInfo; + else + { + cerr << "unknonwn variable " << var_name << " in " + << struct_name << endl; + } + } + + return(var); +} + + +int +DyCoreToGlimmer::setInt4Var(int * var, const char *var_name, const char *struct_name) +{ + // cout << "struct_name::" << struct_name << "::" << endl; + + if (strcmp(struct_name,"felix_struct_name") == 0) { + // if (strcmp(var_name,"dimInfo") == 0) geometry.dimInfo = var; + } + else if (strcmp(struct_name,"velocity") == 0) { + //cout << "Set velocity var, " << var_name << endl; + } + else { + cerr << "unknown int4Var type = " << struct_name + << "." << var_name << endl; + } + return(0); +} + + +int * +DyCoreToGlimmer::getInt4Var( const char *var_name, const char *struct_name) +{ + int * var; + + if (strcmp(struct_name,"felix_struct_name") == 0) { + if (strcmp(var_name,"dimInfo") == 0) var = 0; + else + { + cerr << "unknonwn variable " << var_name << " in " + << struct_name << endl; + } + } + + return(var); +} + + + +int +DyCoreToGlimmer::copyInDoubleVar( const double *var, const char *var_name, + const char *struct_name, const long *var_dim_info) +{ + long elem_count=1; + long i; + + // std::cout << "copyInDoubleVar " << var_name << " = " << *var << std::endl; + + for (i=1;i<=var_dim_info[0];i++) elem_count *= var_dim_info[i]; + + //cout << "struct_name::" << struct_name << "::" << endl; + if (strcmp(struct_name,"geometry") == 0) { + if (strcmp(var_name,"dimInfo") == 0) { + + } + } + + if (strcmp(struct_name,"velocity") == 0) { + + } + + if (strcmp(struct_name,"numerics") == 0) { + if (strcmp(var_name,"dew") == 0) + { + numerics.dew = new double[elem_count]; + for (i=0;i getLongVar("dimInfo","geometry"); + + + // cout << "DimInfo in initDyCore: " << endl; + // for (i=0;i<10;i++) cout << dimInfo[i] << " "; + // cout << "In FELIX initDyCore, calling felix_driver_inin:" << endl; + felix_driver_init(2,0,this,input_fname); + return 0; // ought to make sensible use of this. + +} + +// updates cur_time_yr to match time update in dycore +int +FelixToGlimmer::runDyCore(float& cur_time_yr, const float time_inc_yr) +{ + cout << "In FELIX runDyCore" << endl; + felix_driver_run(this,cur_time_yr,time_inc_yr); + return 0; // ought to make sensible use of this. +} + +int +FelixToGlimmer::deleteDyCore() +{ + felix_driver_finalize(this -> getDyCoreIndex()); + return 0; // ought to make sensible use of this. +} + +//int storeFelixObject(AmrIce bisicles_object) +//{} + +//AmrIce retrieveFelixObject() +//{} diff --git a/components/cism/glimmer-cism/libdycore/README b/components/cism/glimmer-cism/libdycore/README new file mode 100644 index 0000000000..431438ea0d --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/README @@ -0,0 +1,14 @@ +The libdycore directory contains routines that allow CISM to be connected to +external dynamic cores written in C++. Currently, an interface to the +BISICLES dycore is being developed. A prototype driver that uses the BISICLES +dycore can be found in example-drivers/simple_bisicles/src. Build instructions +are located in that directory. A typical build of the BISICLES/libDyCoreToGlimmer.a +library can be performed using run_make. Building BISICLES requires access to the +BISICLES and Chombo installations. For more information on BISICLES and Chombo, +please send email to dfmartin@lbl.gov or ranken@lanl.gov. Some additional information +can also be found in glimmer_to_dycore.info, though this file is out-of-date. + +For a description of BISICLES, see: +https://seesar.lbl.gov/anag/staff/martin/talks/Martin-LIWG-Jan2011_final.pdf. + +Last Revised: 04/19/12 DMR diff --git a/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.H b/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.H new file mode 100644 index 0000000000..912e5c8eeb --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.H @@ -0,0 +1,15 @@ +#include "../DyCoreToGlimmer.H" + +#ifndef YMIR_TO_GLIMMER +#define YMIR_TO_GLIMMER + +class YmirToGlimmer : public DyCoreToGlimmer +{ + public: + + // int initDyCore(); + // int runDyCore(); + // int deleteDyCore(); +}; + +#endif diff --git a/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.cpp b/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.cpp new file mode 100644 index 0000000000..d089053f3f --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/Ymir/YmirToGlimmer.cpp @@ -0,0 +1,22 @@ +#include "YmirToGlimmer.H" + +using namespace std; + +int +YmirToGlimmer::initDyCore() +{ + cout << "In Ymir initDyCore" << endl; +} + +int +YmirToGlimmer::runDyCore() +{ + cout << "In Ymir runDyCore" << endl; +} + +int +YmirToGlimmer::deleteDyCore() +{ + +} + diff --git a/components/cism/glimmer-cism/libdycore/dycore_stubs/glimmer_to_dycore_stubs.F90 b/components/cism/glimmer-cism/libdycore/dycore_stubs/glimmer_to_dycore_stubs.F90 new file mode 100644 index 0000000000..72959b92a0 --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/dycore_stubs/glimmer_to_dycore_stubs.F90 @@ -0,0 +1,49 @@ +! The glimmer_to_dycore stubs module contains stubs for the Fortran side of the Glimmer-DyCore +! interface. It uses the routines in dycore_to_glim_extern.cpp to create one +! or more instances of a dynamic core ice sheet model. The dycore_model_index is +! the only parameter needed by glimmer_to_dycore subroutines to interact with a +! specific instance of a dynamic core model. DMR--5/24/10 + +module glimmer_to_dycore + !*FD glimmer_to_dycore contains Fortran routines to couple Glimmer to a + ! dynamic core model. + use glide_types + use simple_forcing + + contains + + subroutine gtd_init_dycore_interface(model,dycore_type,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index, error_code + integer*4 dycore_type ! 0=BISICLES, 1=Ymir + +! call dycore_init_registry() +! call dycore_init_model(dycore_type,dycore_model_index,error_code) +! call gtd_set_geometry_vars(model,dycore_model_index) + +! print *,"In init_dycore_interface, dycore_type = ",dycore_type +! print *,"In init_dycore_interface, dycore1 = ",dycore_model_index + end subroutine gtd_init_dycore_interface + + subroutine gtd_run_dycore(dycore_model_index) + integer*4 dycore_model_index + +! call dycore_run_model(dycore_model_index) + end subroutine gtd_run_dycore + + subroutine gtd_set_geometry_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + end subroutine gtd_set_geometry_vars + + + subroutine gtd_set_velocity_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + end subroutine gtd_set_velocity_vars + + + +end module glimmer_to_dycore diff --git a/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.H b/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.H new file mode 100644 index 0000000000..5a5ffc0177 --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.H @@ -0,0 +1,4 @@ +#include "DyCoreModelRegistry.H" + +int dycore_registry(int init,int get_model_by_index,int * model_index, + DyCoreToGlimmer ** dycore_to_glimmer_ptr,int dycore_type); diff --git a/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.cpp b/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.cpp new file mode 100644 index 0000000000..6633f0650b --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/dycore_to_glimmer_extern.cpp @@ -0,0 +1,264 @@ +// dyncore_to_glimmer_extern.cpp contains the extern C routines used to provide an interface +// between the Fortran based Glimmer and the C++ based BISICLES. These routines access the +// dycore_registry routine to create and use DyCoreToGlimmer class objects. Since the registry +// can contain multiple DyCoreToGlimmer objects, it allows multiple DYCORE models to be +// instantiated and used by Glimmer. DMR--5/24/10 + +#include +#include +#include +#include +#include "DyCoreModelRegistry.H" + + +extern "C" { + void dycore_init_registry_(); + void dycore_reset_registry_(); + void dycore_get_new_model_(int * dycore_type,int * index,int * error_code); + void dycore_init_model_(int * dycore_type,int * index,char * input_fname,int * error_code); + void dycore_run_model_(int * model_index, double * cur_time_yr, double * time_inc_yr); + void dycore_delete_model_(int * dycore_model_index); + + void dycore_set_ptr_double_var_(double *var, char *var_name_in, + char *struct_name_in, int *model_index); + void dycore_set_ptr_long8_var_(long *var, char *var_name, + char *struct_name, int *model_index); + void dycore_set_ptr_int4_var_(int *var, char *var_name, + char *struct_name, int *model_index); + + void dycore_copy_in_double_var_(double *var, char *var_name, char *struct_name, + long *dim_info, int *model_index); + void dycore_copy_in_long_var_(long *var, char *var_name, char *struct_name, + long *dim_info, int *model_index); + + void dycore_test_vel_input_(int *model_index,double *vel,char *var_name,int *dim_info); + void dycore_test_vel_output_(int *model_index,double *vel,char *var_name,int *dim_info); + +} + +using namespace std; + + +// dycore_registry uses the DyCoreModelRegistry class to create a registry of DyCoreToGlimmer +// objects that are interface instances between DYCORE and Glimmer. This is the only +// routine in this file that accesses a DyCoreModelRegistry object. It is not accessed +// directly from Fortran, but used by the extern routines in this file. +int dycore_registry(int init,int get_model_by_index,int * model_index, + DyCoreToGlimmer ** dycore_to_glimmer_ptr,int dycore_type,int clear_entry) +{ + // this declaration initializes the registry, when dycore_registry + // is first called: + static DyCoreModelRegistry dmr; + + if (init == 1){ + cout << "Initializing Dycore Model Registry" << endl; + return(0); + } + if (init == -1){ + dmr.ClearRegistryEntries(); + cout << "Cleared Dycore Model Registry" << endl; + return(0); + } + if (clear_entry > 0) { + cout << "Calling ClearRegistryEntry, for entry: " << clear_entry << endl; + dmr.ClearRegistryEntry(clear_entry); + return(0); + } + + if (get_model_by_index == 1) { + if (*model_index == -1) { + // if model_index=-1, initialize a new registry entry and + // obtain a new model index: + *model_index = dmr.getModelCount() + 1; + + // init a dycore interface object, and add it to the registry: + dmr.setDyCoreByType(*model_index,dycore_type); + + dmr.setRegistryIndex(*model_index); + + if (*model_index > DYCORE_MODEL_COUNT) { + cout << "Error, exceeded DYCORE Registry limit of " << + DYCORE_MODEL_COUNT << endl; + return(-1); + } + dmr.incModelCount(); + return(0); + } + // get pointer to DyCoreToGlimmer object from registry: + *dycore_to_glimmer_ptr = dmr.getDyCoreToGlimmerByIndex(*model_index); + + return(dmr.getRegistryIndex(*model_index)); + } + return(0); +} + +void dycore_init_registry_() +{ + DyCoreToGlimmer * dummy_dtg; + int init_registry = 1; + + // initialize a registry if dycore model interfaces: + dycore_registry(init_registry,0,0,&dummy_dtg,0,0); +} + +void dycore_reset_registry_() +{ + DyCoreToGlimmer * dummy_dtg; + int init_registry = -1; // set init_registry to clear registry + + // initialize a registry if dycore model interfaces: + dycore_registry(init_registry,0,0,&dummy_dtg,0,0); +} + + +void dycore_get_new_model_(int * dycore_type,int * index,int * error_code) +{ + DyCoreToGlimmer * dtg; + int model_index=-1; + + // cout << "In dycore_get_new_model_ , dycore_type = " << *dycore_type << endl; + + // use *model_index=-1 to initialize a new registry entry: + *error_code = dycore_registry(0,1,&model_index,&dtg,*dycore_type,0); + *index = model_index; +} + +void dycore_init_model_(int * dycore_type,int * model_index,char * input_fname,int * error_code) +{ + DyCoreToGlimmer * dtg; + + // cout << "In dycore_init_model_ , dycore_type = " << *dycore_type << endl; + + dycore_registry(0,1,model_index,&dtg,-1,0); + + dtg -> setDyCoreType(*dycore_type); + dtg -> setDyCoreIndex(*model_index); + dtg -> initDyCore(input_fname); +} + +void dycore_run_model_(int * model_index, double * cur_time_yr, double * time_inc_yr) +{ + DyCoreToGlimmer * dtg; + + dycore_registry(0,1,model_index,&dtg,-1,0); + + //cout << "In dycore_run_model, model_index = " << *model_index << endl; + //cout << "In drm, cur_time, time_inc = " << *cur_time_yr << " " << *time_inc_yr << endl; + + dtg -> runDyCore(*cur_time_yr,*time_inc_yr); +} + +void dycore_delete_model_(int * model_index) +{ + DyCoreToGlimmer * dtg; + int clear_entry; + + clear_entry = *model_index; + dycore_registry(0,1,model_index,&dtg,-1,clear_entry); + // reg_index = dycore_registry(0,1,model_index,&dtg,-1); + // dtg -> deleteDyCore(); +} + +void dycore_set_ptr_double_var_(double *var, char *var_name, + char *struct_name, int *model_index) +{ + DyCoreToGlimmer * dtg; + + dycore_registry(0,1,model_index,&dtg,-1,0); + dtg -> setDoubleVar(var,var_name,struct_name); +} + +void dycore_set_ptr_long8_var_(long *var, char *var_name, + char *struct_name, int *model_index) +{ + DyCoreToGlimmer * dtg; + + // cout << "var_name::" << var_name << "::" << endl; + + dycore_registry(0,1,model_index,&dtg,-1,0); + dtg -> setLongVar(var,var_name,struct_name); +} + +void dycore_set_ptr_int4_var_(int *var, char *var_name, + char *struct_name, int *model_index) +{ + DyCoreToGlimmer * dtg; + + // cout << "var_name::" << var_name << "::" << endl; + + dycore_registry(0,1,model_index,&dtg,-1,0); + dtg -> setInt4Var(var,var_name,struct_name); +} + +void dycore_copy_in_double_var_(double *var, char *var_name, char *struct_name, + long *dim_info, int *model_index) +{ + DyCoreToGlimmer * dtg; + + // cout << "In copy_in_double_var, var_name::" << var_name << "::" << endl; + std::cout << " dycore_copy_in_double_var_ " << var_name + << " = " << *var << std::endl; + dycore_registry(0,1,model_index,&dtg,-1,0); + dtg -> copyInDoubleVar(var,var_name,struct_name,dim_info); +} + +void dycore_copy_in_long_var_(long *var, char *var_name, char *struct_name, + long *dim_info, int *model_index) +{ + DyCoreToGlimmer * dtg; + + // cout << "In copy_long_var" << endl; + //cout << "struct_name::" << struct_name << "::" << endl; + + dycore_registry(0,1,model_index,&dtg,-1,0); + dtg -> copyInLongVar(var,var_name,struct_name,dim_info); +} + + +void dycore_test_vel_input_(int *model_index,double *vel,char *var_name, + int * dim_info) +{ + int i, reg_index; + // double test_array[10]; + DyCoreToGlimmer * dtg; + // double * var; + + // cout << "test_vel_in, Calling dycore_registry" << endl; + + reg_index = dycore_registry(0,1,model_index,&dtg,-1,0); + + cout << "test_vel_in model_index compare: " << *model_index << " " + << reg_index << endl; + + // if (*model_index == 1) (*dtg).set_velocity_data(vel,"uvel",dim_info); + // if (*model_index == 2) (*dtg).set_velocity_data(vel,"vvel",dim_info); + + cout << "In vel input, var = " << var_name << ": "; + for (i=0;i<14;i++) cout << vel[i] << " "; + cout << endl; +} + +void dycore_test_vel_output_(int *model_index,double *vel,char *var_name, + int * dim_info) +{ + int i; + // double test_array[10]; + DyCoreToGlimmer * dtg; + double * var; + + cout << "In test output, Model Index: " << *model_index << endl; + + cout << "output: my_reg_index: " << dycore_registry(0,1,model_index,&dtg,-1,0) << endl; + + if (*model_index == 1) { + // (*dtg).get_velocity_data(&var,"uvel",dim_info); + } + + if (*model_index == 2) { + // (*dtg).get_velocity_data(&var,"vvel",dim_info); + } + cout << "In vel output, var = " << var_name << ": "; + for (i=0;i<14;i++) cout << var[i] << " "; + cout << endl; + +} diff --git a/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.F90 b/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.F90 new file mode 100644 index 0000000000..7a7a2a50fc --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.F90 @@ -0,0 +1,384 @@ +! The glimmer_to_dycore module contains the Fortran side of the Glimmer-DyCore +! interface. It uses the routines in dycore_to_glim_extern.cpp to create one +! or more instances of a dynamic core ice sheet model. The dycore_model_index is +! the only parameter needed by glimmer_to_dycore subroutines to interact with a +! specific instance of a dynamic core model. DMR--5/24/10 + +module glimmer_to_dycore + !*FD glimmer_to_dycore contains Fortran routines to couple Glimmer to a + ! dynamic core model. + use glide_types + !use mpi_mod + use parallel + !use simple_forcing + + contains + + subroutine gtd_init_dycore_interface() + call dycore_init_registry() +!print *,"Past dycore_init_registry" + end subroutine gtd_init_dycore_interface + + subroutine gtd_delete_dycore_interface() + call dycore_reset_registry() + end subroutine gtd_delete_dycore_interface + + subroutine gtd_init_dycore(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + integer*4 error_code + integer*4 dycore_type ! 0=BISICLES, 1=Ymir + character(8),DIMENSION(3) :: dycore_names = (/"Native ","BISICLES","FELIX "/) + +!print *,'in init -- topg ndims,shape = ',size(shape(model%geometry%topg)),shape(model%geometry%topg) + dycore_type = model%options%external_dycore_type +!print *,"In gtd_init_dycore, calling get_new_model" + call dycore_get_new_model(dycore_type,dycore_model_index,error_code) +!print *,"In gtd_init_dycore, calling get_set_var routines" + call gtd_set_geometry_vars(model,dycore_model_index) +!print *,"In gtd_init_dycore, past set_geometry_vars" + call gtd_set_velocity_vars(model,dycore_model_index) + call gtd_set_numerics_vars(model,dycore_model_index) + call gtd_set_temper_vars(model,dycore_model_index) + call gtd_set_climate_vars(model,dycore_model_index) + call gtd_set_mpi_vars(model,dycore_model_index) + call gtd_set_constants(model,dycore_model_index) + + !print *,"In gtd_init_dycore, dycore_type, dycore_index = " , & + ! dycore_names(dycore_type+1),dycore_model_index + call dycore_init_model(dycore_type,dycore_model_index, & + trim(model%options%dycore_input_file)//char(0),error_code) + + end subroutine gtd_init_dycore + + subroutine gtd_run_dycore(dycore_model_index,cur_time,time_inc) + integer*4 dycore_model_index + real(dp) cur_time, time_inc + + call dycore_run_model(dycore_model_index,cur_time,time_inc) + end subroutine gtd_run_dycore + + subroutine gtd_delete_dycore(dycore_model_index) + integer*4 dycore_model_index + + call dycore_delete_model(dycore_model_index) + end subroutine gtd_delete_dycore + + subroutine gtd_set_dim_info(shape,dim_info) + integer, dimension(:), intent(in) :: shape + integer*8, dimension(:), intent(inout) :: dim_info + + dim_info = 0 + dim_info(1) = size(shape) + dim_info(2:1+dim_info(1)) = shape + end subroutine gtd_set_dim_info + + subroutine gtd_set_geometry_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + integer*4 shape2, rank + character*20 var_name + character*20 dtype_name + integer*4 var_name_len, dtype_name_len + + integer*8 dim_info(11) + integer*8 dim_info2(2) + integer*8 ewlbl, ewubl, nslbl, nsubl, nhalol + +! print *,"In gtd_set_geometry_vars, dycore_model_index = ",dycore_model_index + +! print *,'thck ndims,shape = ',size(shape(model%geometry%thck)),shape(model%geometry%thck) +! print *,'topg ndims,shape = ',size(shape(model%geometry%topg)),shape(model%geometry%topg) + +! print *,'usrf ndims,shape = ',size(shape(model%geometry%usrf)),shape(model%geometry%usrf) + + dtype_name = 'geometry'//char(0) + + var_name = 'thck'//char(0) + !call gtd_set_dim_info(shape(model%geometry%thck),dim_info) + call dycore_set_ptr_double_var(model%geometry%thck,var_name,dtype_name,dycore_model_index) + + var_name = 'topg'//char(0) + !call gtd_set_dim_info(shape(model%geometry%topg),dim_info) + call dycore_set_ptr_double_var(model%geometry%topg,var_name,dtype_name,dycore_model_index) + + var_name = 'usrf'//char(0) + !call gtd_set_dim_info(shape(model%geometry%usrf),dim_info) + call dycore_set_ptr_double_var(model%geometry%usrf,var_name,dtype_name,dycore_model_index) + + var_name = 'lsrf'//char(0) + !call gtd_set_dim_info(shape(model%geometry%lsrf),dim_info) + call dycore_set_ptr_double_var(model%geometry%lsrf,var_name,dtype_name,dycore_model_index) + + !* (DFM -- added floating_mask, ice_mask, lower_cell_loc, and lower_cell_temp + var_name = 'floating_mask'//char(0) + !call gtd_set_dim_info(shape(model%geometry%floating_mask),dim_info) + call dycore_set_ptr_double_var(model%geometry%floating_mask,var_name,dtype_name,dycore_model_index) + + var_name = 'ice_mask'//char(0) + !call gtd_set_dim_info(shape(model%geometry%ice_mask),dim_info) + call dycore_set_ptr_double_var(model%geometry%ice_mask,var_name,dtype_name,dycore_model_index) + + var_name = 'lower_cell_loc'//char(0) + !call gtd_set_dim_info(shape(model%geometry%lower_cell_loc),dim_info) + call dycore_set_ptr_double_var(model%geometry%lower_cell_loc,var_name,dtype_name,dycore_model_index) + + var_name = 'lower_cell_temp'//char(0) + !call gtd_set_dim_info(shape(model%geometry%lower_cell_temp),dim_info) + call dycore_set_ptr_double_var(model%geometry%lower_cell_temp,var_name,dtype_name,dycore_model_index) + + + ! print *,"this_rank, ewlb, ewub, nslb, nsub", this_rank, ewlb, ewub, nslb, nsub + +! (DFM -2/12/13) since ewlb, et al contain local grid info, use dim_info to +! pass in global index space info + dim_info(1) = 3 + dim_info(2) = model%general%upn + dim_info(3) = global_ewn + dim_info(4) = global_nsn + + +! dtype_name = 'geometry' +! dtype_name_len = 8 + + ! use age to get dim_info for now (only 3d var in geometry derived type) +! call gtd_set_dim_info(shape(model%geometry%age),dim_info) + + ! print *, "dim_info = ", dim_info(1), dim_info(2), dim_info(3), dim_info(4) + + var_name = 'dimInfo'//char(0) + dim_info2(1) = 1 + dim_info2(2) = dim_info(1) + 1 + call dycore_copy_in_long_var(dim_info,var_name,dtype_name,dim_info2, dycore_model_index) + + ewlbl = ewlb + ewubl = ewub + nslbl = nslb + nsubl = nsub + nhalol = nhalo + + dim_info2(1) = 1 + dim_info2(2) = 1 + var_name = 'ewlb'//char(0) + call dycore_copy_in_long_var(ewlbl,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'ewub'//char(0) + call dycore_copy_in_long_var(ewubl,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'nslb'//char(0) + call dycore_copy_in_long_var(nslbl,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'nsub'//char(0) + call dycore_copy_in_long_var(nsubl,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'nhalo'//char(0) + call dycore_copy_in_long_var(nhalol,var_name,dtype_name,dim_info2, dycore_model_index) + + +! print *,"leaving gtd_set_geometry_vars, dim_info = ",dim_info + end subroutine gtd_set_geometry_vars + + + subroutine gtd_set_velocity_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + character*20 var_name + character*20 dtype_name + integer*4 var_name_len, dtype_name_len + + integer*8 dim_info(11) + integer*8 dim_info2(2) + +! print *,"In copy_velocity_vars, dycore_model_index = ",dycore_model_index + + dtype_name = 'velocity'//char(0) + + ! print *,'uvel ndims,shape = ',size(shape(model%velocity%uvel)),shape(model%velocity%uvel) + + ! print *,'vvel ndims,shape = ',size(shape(model%velocity%vvel)),shape(model%velocity%vvel) + + ! print *,'wvel ndims,shape = ',size(shape(model%velocity%wvel)),shape(model%velocity%wvel) + + + var_name = 'uvel'//char(0) + call dycore_set_ptr_double_var(model%velocity%uvel,var_name, & + dtype_name,dycore_model_index); + var_name = 'vvel'//char(0) + call dycore_set_ptr_double_var(model%velocity%vvel,var_name, & + dtype_name,dycore_model_index); + var_name = 'wvel'//char(0) + call dycore_set_ptr_double_var(model%velocity%wvel,var_name, & + dtype_name,dycore_model_index); + + var_name = 'wgrd'//char(0) + call dycore_set_ptr_double_var(model%velocity%wgrd,var_name, & + dtype_name,dycore_model_index); + +! print *,'beta ndims,shape = ',size(shape(model%velocity%beta)),shape(model%velocity%beta) + + var_name = 'btrc'//char(0) + call dycore_set_ptr_double_var(model%velocity%beta,var_name, & + dtype_name,dycore_model_index); + + call gtd_set_dim_info(shape(model%velocity%uvel),dim_info) + + var_name = 'dimInfo'//char(0) + dim_info2(1) = 1 + dim_info2(2) = 4 + call dycore_copy_in_long_var(dim_info,var_name,dtype_name,dim_info2,dycore_model_index) + end subroutine gtd_set_velocity_vars + + subroutine gtd_set_numerics_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + + character*20 var_name + character*20 dtype_name + integer*4 var_name_len, dtype_name_len + integer*8 dim_info2(2) + + dtype_name = 'numerics'//char(0) + + dim_info2(1) = 1 + dim_info2(2) = 1 + + + var_name = 'tstart'//char(0) + call dycore_set_ptr_double_var(model%numerics%tstart,var_name,dtype_name,dycore_model_index) + var_name = 'tend'//char(0) + call dycore_set_ptr_double_var(model%numerics%tend,var_name,dtype_name,dycore_model_index) + var_name = 'time'//char(0) + call dycore_set_ptr_double_var(model%numerics%time,var_name,dtype_name,dycore_model_index) + + var_name = 'dew'//char(0) + call dycore_copy_in_double_var(model%numerics%dew,var_name,dtype_name,dim_info2,dycore_model_index) + var_name = 'dns'//char(0) + call dycore_copy_in_double_var(model%numerics%dns,var_name,dtype_name,dim_info2,dycore_model_index) + + end subroutine gtd_set_numerics_vars + + subroutine gtd_set_constants(model,dycore_model_index) + use glimmer_physcon, only: grav, scyr, rhoi, rhoo + + type(glide_global_type) :: model + integer*4 dycore_model_index + + character*20 var_name + character*20 dtype_name + integer*4 var_name_len, dtype_name_len + integer*8 dim_info2(2) + + dtype_name = 'constants'//char(0) + + dim_info2(1) = 1 + dim_info2(2) = 1 + + var_name = 'gravity'//char(0) + call dycore_copy_in_double_var(grav,var_name,dtype_name,dim_info2,dycore_model_index) + + var_name = 'seconds_per_year'//char(0) + call dycore_copy_in_double_var(scyr,var_name,dtype_name,dim_info2,dycore_model_index) + + var_name = 'rho_ice'//char(0) + call dycore_copy_in_double_var(rhoi,var_name,dtype_name,dim_info2,dycore_model_index) + + var_name = 'rho_seawater'//char(0) + call dycore_copy_in_double_var(rhoo,var_name,dtype_name,dim_info2,dycore_model_index) + + end subroutine gtd_set_constants + + subroutine gtd_set_temper_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + character*20 var_name + character*20 dtype_name + + integer*8 dim_info(11), dim_info2(2) + + dtype_name = 'temper'//char(0) + + var_name = 'temp'//char(0) + call dycore_set_ptr_double_var(model%temper%temp,var_name,dtype_name,dycore_model_index) + + var_name = 'bheatflx'//char(0) + call dycore_set_ptr_double_var(model%temper%bheatflx,var_name,dtype_name,dycore_model_index) + + var_name = 'bmlt'//char(0) + call dycore_set_ptr_double_var(model%temper%bmlt,var_name,dtype_name,dycore_model_index) + + ! print *,'temp ndims,shape = ',size(shape(model%temper%temp)),shape(model%temper%temp) + + ! print *,'bheatflx ndims,shape = ',size(shape(model%temper%bheatflx)),shape(model%temper%bheatflx) + + ! print *,'bmlt ndims,shape = ',size(shape(model%temper%bmlt)),shape(model%temper%bmlt) + + call gtd_set_dim_info(shape(model%temper%temp),dim_info) + + var_name = 'dimInfo'//char(0) + dim_info2(1) = 1 + dim_info2(2) = dim_info(1) + 1 + call dycore_copy_in_long_var(dim_info,var_name,dtype_name,dim_info2,dycore_model_index) + end subroutine gtd_set_temper_vars + + subroutine gtd_set_climate_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + character*20 var_name + character*20 dtype_name + + integer*8 dim_info(11), dim_info2(2) + + dtype_name = 'climate'//char(0) + + var_name = 'acab'//char(0) + call dycore_set_ptr_double_var(model%climate%acab,var_name,dtype_name,dycore_model_index) + var_name = 'acab_tavg'//char(0) + call dycore_set_ptr_double_var(model%climate%acab_tavg,var_name,dtype_name,dycore_model_index) + var_name = 'calving'//char(0) + call dycore_set_ptr_double_var(model%climate%calving,var_name,dtype_name,dycore_model_index) + + call gtd_set_dim_info(shape(model%climate%acab),dim_info) + ! print *,"In climate set, dim_info: ",dim_info + var_name = 'dimInfo'//char(0) + dim_info2(1) = 1 + dim_info2(2) = dim_info(1) + 1 + call dycore_copy_in_long_var(dim_info,var_name,dtype_name,dim_info2,dycore_model_index) + + var_name = 'eus' + dim_info2(1) = 1 + dim_info2(2) = 1 + ! eus parm isn't being set during initialization, so commented out here: + !call dycore_copy_in_double_var(model%climate%eus,var_name,dtype_name,dim_info2,dycore_model_index) + !print *,"eus: ",model%climate%eus + + end subroutine gtd_set_climate_vars + + subroutine gtd_set_mpi_vars(model,dycore_model_index) + type(glide_global_type) :: model + integer*4 dycore_model_index + character*20 var_name + character*20 dtype_name + + integer*8 dim_info(11), dim_info2(2) + + ! integer,save :: comm, tasks, this_rank -- from parallel_mpi.F90 + integer*8 communicator, process_count, my_rank + + + communicator = comm + process_count = tasks + my_rank = this_rank + + dtype_name = 'mpi_vars'//char(0) + + dim_info2(1) = 1 + dim_info2(2) = 1 + var_name = 'communicator'//char(0) + call dycore_copy_in_long_var(communicator,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'process_count'//char(0) + call dycore_copy_in_long_var(process_count,var_name,dtype_name,dim_info2, dycore_model_index) + var_name = 'my_rank'//char(0) + call dycore_copy_in_long_var(my_rank,var_name,dtype_name,dim_info2, dycore_model_index) + + end subroutine gtd_set_mpi_vars + +end module glimmer_to_dycore diff --git a/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.info b/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.info new file mode 100644 index 0000000000..a7821af92f --- /dev/null +++ b/components/cism/glimmer-cism/libdycore/glimmer_to_dycore.info @@ -0,0 +1,89 @@ +Coupling Glimmer to External Dynamic Cores +Last revised: 8/26/2010 Doug Ranken + +The purpose of the Glimmer/Dycore interface is to provide a flexible method for connecting the +Fortran-based Glimmer package to C/C++ based dynamic cores (though it could be modified to +connect external Fortran dynamic cores, as well). This document provides instructions for +building the external dynamic core interface between Glimmer and BISICLES (or Ymir, when it +is available). With the current design, adding new dynamic cores can be done using small +modifications to DyCoreModelRegistry.H and DyCoreModelRegistry.cpp. Since the +DyCoreModelRegistry class is a small code, it would be relatively easy to have a build system +couple-in a specific set of dynamic cores, based on a few user specified configuration +parameters. + +The interface is designed so that all glimmer calls to external dynamic core routines are +contained in the Fortran module glimmer_to_dycore.F90. To allow glimmer to be built without +including any external dynamic cores, there is also a glimmer_to_dycore_stubs.F90 module. + +The rest of the interface is written in C/C++. The dycore_to_glimmer_extern.cpp provides a +bridge between the Fortran and C++. The C++ routines provide a registry class designed to +handle multiple dynamic core interfaces (which can be of different types), and classes that +implement the interface. The DycoreToGlimmer class is designed to be a parent class for +subclasses that handle the interface to specific dynamic cores. + +The rest of this document tells how to build an interface connecting Glimmer to the BISICLES +dynamic core. + +There are 3 main steps to the build process, to be done in this order: +1) Build the interface library +2) Build BISICLES (or Ymir) library +3) Compile simple_bisicles + +1) Build the interface library +In directory your_glimmmer/src/libdycore +make BISICLES + +2) Build BISICLES and single-file Chombo libraries (libBisicles.a, libChomboLibs.a) +In the BISICLES installation, code/interface directory: + make bisicles + +3) Compile simple_bisicles +rm simple_bisicles +make -f Makefile.dycore simple_bisicles + +To compile with stub routines for the interface: +1) Build the interface library +In directory your_glimmmer/src/libdycore +make DYCORE_STUBS + +2) Compile simple_bisicles +rm simple_bisicles +make -f Makefile.dycore simple_bisicles +make -f Makefile.dycore_stubs simple_bisicles + +DyCoreModelRegistry.cpp + .H +DyCoreToGlimmer.cpp + .H +dycore_to_glimmer_extern.cpp + + +Testing simple_bisicles: +1) simple_bisicles, load hump.config +2) simple_bisicles_run +3) gdb simple_bisicles, load hump.config + + +BISICLES Build Notes: + + +Chombo: +with a fresh checkout, need to set Chombo/lib/mk/Make.defs.local +with machine-dependent info + +latest resolved dependencies: +HDF5, which needs szip. +Atlas version of lapack. + +Glimmer-CISM: + +using LANL parallel branch: +svn co https://username@svn.berlios.de/svnroot/repos/glimmer-cism/glimmer-cism-lanl/branches/parallel + +Dan's configure command: + +./configure --with-netcdf=/home/loren/users/dmartin/util/netcdf/netcdf-4.0.1/ --prefix=/home/loren/users/dmartin/cleanCheckout/gc1/parallel --with-blas=-lblas FC=gfortran FCFLAGS="-ffree-line-length-none -g -DNO_RESCALE" FFLAGS="-g -DNO_RESCALE" CFLAGS="-g -DNO_RESCALE" + +Doug's configure command: + +./configure --with-netcdf=/home/ranken/util/netcdf/netcdf-4.0.1 --with-hdf5-lib=/home/ranken/util/hdf/hdf5-1.8.4/hdf5/lib/ --prefix=$PWD --with-blas=-lblas --with-lapack=-llapack --with-tags=gfortran --with-slap-slap FC=gfortran FCFLAGS="-ffree-line-length-none -g -DNO_RESCALE" FFLAGS="-g -DNO_RESCALE" CFLAGS="-g -DNO_RESCALE" + +./configure --with-netcdf=/home/ranken/util/netcdf/netcdf-4.0.1 --with-hdf5-lib=/home/ranken/util/hdf/hdf5-1.8.4/hdf5/lib/ --prefix=$PWD --with-blas=-lblas --with-lapack=-llapack --with-tags=gfortran --with-slap-slap FC=gfortran FCFLAGS="-ffree-line-length-none -g -DNO_RESCALE" FFLAGS="-g -DNO_RESCALE" CFLAGS="-g -DNO_RESCALE" --with-hdf5=/home/ranken/util/hdf/5-1.6.10-linux-x86_64-static --with-szip=/home/ranken/util/hdf/szip-2.1/src/.libs/libsz.a --with-libdycore=/home/ranken/util/BISICLES/code/interface/libdycore --with-bisicles=/home/ranken/util/BISICLES diff --git a/components/cism/glimmer-cism/libglad/README b/components/cism/glimmer-cism/libglad/README new file mode 100644 index 0000000000..83566f317a --- /dev/null +++ b/components/cism/glimmer-cism/libglad/README @@ -0,0 +1,36 @@ +This directory contains an alternative to glint that can be used when a GCM +passes already-downscaled fields: glad (where the "a.d." stands for "already +downscaled"). glad acts as a lightweight layer between the GCM and the rest of +CISM. It is responsible for: + +(1) Handling time stepping and temporal averaging + +(2) Providing a simpler interface to the climate model, rather than requiring +the climate model to make detailed calls to things like glide_tstep_p1, etc. + +(3) Translating inputs and outputs into appropriate quantities + +Eventually, it is possible that this layer could be removed, moving some of its +functionality up into the GLC layer of CESM/ACME, and some of its functionality +down into the rest of the CISM code. However, we may choose to keep this +lightweight layer in place, because it does have some value. + +---- + +The main differences between the code here and the code in libglint are: + +(1) libglad does not do any upscaling / downscaling / interpolation + +(2) libglad currently only works with SMB inputs - not PDD, etc. + +---- + +Note that a few modules here are also used by libglint, including: + +- glad_constants.F90 + +- glad_restart_gcm.F90 + +So those may contain a bit of code that is needed by libglint but not by +libglad. + diff --git a/components/cism/glimmer-cism/libglad/glad_constants.F90 b/components/cism/glimmer-cism/libglad/glad_constants.F90 new file mode 100644 index 0000000000..ece500e48d --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_constants.F90 @@ -0,0 +1,77 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_constants.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_constants + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + + implicit none + + ! ------------------------------------------------------------ + ! global parameters + ! ------------------------------------------------------------ + + real(dp), parameter :: lapse = 0.0065_dp ! atm lapse rate, deg/m + real(dp),parameter :: days2hours = 24.d0 + real(dp),parameter :: hours2seconds = 3600.d0 !> Hours to seconds conversion factor + + real(dp), parameter :: default_diy = 360.d0 !> Default number of days in year + real(dp), parameter :: default_y2h = days2hours*default_diy !> Default years to hours conversion + + ! Constants set at run-time + + integer :: days_in_year = default_diy !> The number of days in a year + real(dp) :: years2hours = default_y2h !> Years to hours conversion factor + real(dp) :: hours2years = 1.d0/default_y2h !> Hours to years conversion factor + + private :: default_diy, default_y2h + + ! Minimum thickness of ice, at or below which a point is considered bare land for upscaling/ + ! downscaling purposes. Values other than 0 can result in odd behavior - e.g., a value + ! greater than 0 means that CLM would consider a point to have become icesheet, and so + ! would send positive SMB, but if this SMB didn't reach the min_thck threshold, then + ! CISM would effectively tell CLM, "no, it's not actually icesheet yet - it's still + ! bare ground". + real(dp), parameter :: min_thck = 0.d0 + +contains + + subroutine glad_set_year_length(daysinyear) + + integer, intent(in) :: daysinyear + + days_in_year = daysinyear + years2hours = days2hours*days_in_year + hours2years = 1.d0/years2hours + + end subroutine glad_set_year_length + +end module glad_constants diff --git a/components/cism/glimmer-cism/libglad/glad_initialise.F90 b/components/cism/glimmer-cism/libglad/glad_initialise.F90 new file mode 100644 index 0000000000..386de60432 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_initialise.F90 @@ -0,0 +1,344 @@ +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +#ifdef CPRIBM +@PROCESS ALIAS_SIZE(107374182) +#endif +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_initialise.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_initialise + + !> Initialise GLAD model instance + + use glad_type + use glimmer_global, only: dp + implicit none + + private + public glad_i_initialise_gcm, glad_i_end + +contains + + subroutine glad_i_initialise_gcm(config, instance, & + force_start, force_dt, & + gcm_restart, gcm_restart_file, & + gcm_config_unit) + + ! Initialise a GLAD ice model instance for GCM coupling + + use glimmer_paramets, only: GLC_DEBUG + use glimmer_log + use glimmer_config + use glimmer_coordinates, only : coordsystem_new + use glad_mbal_coupling, only : glad_mbc_init + use glad_io , only: glad_io_createall , glad_io_writeall + use glad_mbal_io , only: glad_mbal_io_createall, glad_mbal_io_writeall + use glimmer_ncio + use glide_nc_custom , only: glide_nc_fillall + use glide + use glissade + use glad_constants + use glad_restart_gcm + use glide_diagnostics + use parallel, only: main_task + + implicit none + + ! Arguments + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + type(glad_instance), intent(inout) :: instance ! The instance being initialised. + + integer, intent(in) :: force_start ! glad forcing start time (hours) + integer, intent(in) :: force_dt ! glad forcing time step (hours) + + logical, optional, intent(in) :: gcm_restart ! logical flag to read from a restart file + character(*),optional, intent(in) :: gcm_restart_file ! restart filename for restart + integer, optional, intent(in) :: gcm_config_unit ! fileunit for reading config files + + ! Internal + + integer :: config_fileunit + + config_fileunit = 99 + if (present(gcm_config_unit)) then + config_fileunit = gcm_config_unit + endif + + ! initialise model + + call glide_config(instance%model, config, config_fileunit) + + ! if this is a continuation run, then set up to read restart + ! (currently assumed to be a CESM restart file) + + if (present(gcm_restart)) then + + if (gcm_restart) then + + if (present(gcm_restart_file)) then + + ! read the restart file + call glad_read_restart_gcm(instance%model, gcm_restart_file) + instance%model%options%is_restart = 1 + + else + + call write_log('Missing gcm_restart_file when gcm_restart is true',& + GM_FATAL,__FILE__,__LINE__) + + endif + + endif + endif + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then ! SIA dycore + + ! initialise the model + call glide_initialise(instance%model) + + ! compute the initial diagnostic state + call glide_init_state_diagnostic(instance%model) + + else ! glam/glissade HO dycore + + ! initialise the model + call glissade_initialise(instance%model) + + ! compute the initial diagnostic state + call glissade_diagnostic_variable_solve(instance%model) + + endif + + instance%ice_tstep = get_tinc(instance%model)*nint(years2hours) + + instance%glide_time = instance%model%numerics%tstart + + ! read glad configuration + + call glad_i_readconfig(instance, config) + call glad_i_printconfig(instance) + + ! Construct the list of necessary restart variables based on the config options + ! selected by the user in the config file (specific to glad - other configs, + ! e.g. glide, isos, are handled separately by their setup routines). + ! This is done regardless of whether or not a restart ouput file is going + ! to be created for this run, but this information is needed before setting up outputs. MJH 1/17/13 + ! Note: the corresponding call for glide is placed within *_readconfig, which is probably more appropriate, + ! but putting this call into glad_i_readconfig creates a circular dependency. + + call define_glad_restart_variables(instance) + + ! create glad variables for the glide output files + call glad_io_createall(instance%model, data=instance) + + ! create instantaneous glad variables + call openall_out(instance%model, outfiles=instance%out_first) + call glad_mbal_io_createall(instance%model, data=instance, outfiles=instance%out_first) + + ! fill dimension variables + call glide_nc_fillall(instance%model) + call glide_nc_fillall(instance%model, outfiles=instance%out_first) + + ! Check we've used all the config sections + + call CheckSections(config) + + ! New grid (grid on this task) + + ! WJS (1-11-13): I'm not sure if it's correct to set the origin to (0,0) when running + ! on multiple tasks, with a decomposed grid. However, as far as I can tell, the + ! origin of this variable isn't important, so I'm not trying to fix it right now. + + instance%lgrid = coordsystem_new(0.d0, 0.d0, & + get_dew(instance%model), & + get_dns(instance%model), & + get_ewn(instance%model), & + get_nsn(instance%model)) + + ! Allocate arrays appropriately + + call glad_i_allocate_gcm(instance, force_start) + + ! Read data and initialise climate + + call glad_i_readdata(instance) + + ! initialise the mass-balance accumulation + + call glad_mbc_init(instance%mbal_accum, instance%lgrid) + + ! If flag set to force frequent coupling (for testing purposes), + ! then decrease all coupling timesteps to very short intervals + if (instance%test_coupling) then + instance%mbal_accum%tstep = 24 + instance%mbal_accum_time = 24 + instance%ice_tstep = 24 + endif + + instance%mbal_tstep = instance%mbal_accum%tstep + + instance%next_time = force_start - force_dt + instance%mbal_tstep + + if (GLC_DEBUG .and. main_task) then + write (6,*) 'Called glad_mbc_init' + write (6,*) 'mbal tstep =', instance%mbal_tstep + write (6,*) 'next_time =', instance%next_time + write (6,*) 'start_time =', instance%mbal_accum%start_time + end if + + ! Mass-balance accumulation length + + if (instance%mbal_accum_time == -1) then + instance%mbal_accum_time = max(instance%ice_tstep,instance%mbal_tstep) + end if + + if (instance%mbal_accum_time < instance%mbal_tstep) then + call write_log('Mass-balance accumulation timescale must be as '//& + 'long as mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (mod(instance%mbal_accum_time,instance%mbal_tstep) /= 0) then + call write_log('Mass-balance accumulation timescale must be an '// & + 'integer multiple of the mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (.not. (mod(instance%mbal_accum_time, instance%ice_tstep)==0 .or. & + mod(instance%ice_tstep, instance%mbal_accum_time)==0)) then + call write_log('Mass-balance accumulation timescale and ice dynamics '//& + 'timestep must divide into one another',GM_FATAL,__FILE__,__LINE__) + end if + + if (instance%ice_tstep_multiply/=1 .and. mod(instance%mbal_accum_time,nint(years2hours)) /= 0.d0) then + call write_log('For ice time-step multiplication, mass-balance accumulation timescale '//& + 'must be an integer number of years',GM_FATAL,__FILE__,__LINE__) + end if + + ! Initialise some other stuff + + if (instance%mbal_accum_time>instance%ice_tstep) then + instance%n_icetstep = instance%ice_tstep_multiply*instance%mbal_accum_time/instance%ice_tstep + else + instance%n_icetstep = instance%ice_tstep_multiply + end if + + ! Write initial ice sheet diagnostics for this instance + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! Write netCDF output for this instance + + call glide_io_writeall(instance%model, instance%model) + call glad_io_writeall(instance, instance%model) + call glad_mbal_io_writeall(instance, instance%model, outfiles=instance%out_first) + + end subroutine glad_i_initialise_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_i_end(instance) + + !> Tidy up + + use glide + use glimmer_ncio + implicit none + type(glad_instance), intent(inout) :: instance !> The instance being initialised. + + call glide_finalise(instance%model) + call closeall_out(instance%model,outfiles=instance%out_first) + instance%out_first => null() + + end subroutine glad_i_end + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_i_readdata(instance) + !> read data from netCDF file and initialise climate + + use glad_io + use glide_thck, only: glide_calclsrf + implicit none + + type(glad_instance),intent(inout) :: instance !> Instance whose elements are to be allocated. + + ! read data + call glad_io_readall(instance,instance%model) + + call glide_calclsrf(instance%model%geometry%thck,instance%model%geometry%topg, & + instance%model%climate%eus,instance%model%geometry%lsrf) + instance%model%geometry%usrf = instance%model%geometry%thck + instance%model%geometry%lsrf + + end subroutine glad_i_readdata + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine define_glad_restart_variables(instance) + + ! This subroutine analyzes the glad options input by the user in the config file + ! and determines which variables are necessary for an exact restart. MJH 1/11/2013 + + ! Please comment thoroughly the reasons why a particular variable needs to be a restart variable for a given config. + + use glad_io, only: glad_add_to_restart_variable_list + use glad_mbal_io, only: glad_mbal_add_to_restart_variable_list + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glad_instance), intent (in) :: instance !> Derived type that includes all glad options + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + ! lat and lon need to be on the input file. Since a restart run only reads the + ! restart file (and not the original input file) we need to write lat and lon back to + ! the restart file so they will be available for the following run segment. + + call glad_add_to_restart_variable_list('lat lon') + + ! The variables rofi_tavg, rofl_tavg, and hflx_tavg are time-averaged fluxes on the local grid + ! from the previous coupling interval. They are included here so that the coupler can be sent + ! the correct fluxes after restart; otherwise these fluxes would have values of zero. + !TODO - Add av_count_output so we can restart in the middle of a mass balance timestep? + + call glad_add_to_restart_variable_list('rofi_tavg rofl_tavg hflx_tavg') + + end subroutine define_glad_restart_variables + + +end module glad_initialise diff --git a/components/cism/glimmer-cism/libglad/glad_input_averages.F90 b/components/cism/glimmer-cism/libglad/glad_input_averages.F90 new file mode 100644 index 0000000000..c890bd2828 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_input_averages.F90 @@ -0,0 +1,175 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_input_averages.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_input_averages + + !> This module defines a type and related operations for working with inputs from the + !> GCM. Its main purpose is to produce temporal averages of these inputs. + + ! Note that this module has some functionality in common with glad_mbal_coupling, but + ! they are used at different stages in the time loops. + + ! NOTE(wjs, 2015-03-17) Most or all of the functionality here could be removed if we + ! performed all of the necessary temporal averaging in the climate model, with coupling + ! to the CISM code only happening once per mass balance time step. If we do that, we + ! should probably add checks to ensure that the model is really just being called when + ! it's time for a mass balance time step. + + use glimmer_global, only : dp + use glimmer_paramets, only: GLC_DEBUG, stdout + use glimmer_log + use parallel, only : main_task + + implicit none + private + + type, public :: glad_input_averages_type + private + + integer :: av_start_time = 0 ! Value of time from the last occasion averaging was restarted (hours) + integer :: av_steps = 0 ! Number of times glimmer has been called in current round of averaging + integer :: next_av_start = 0 ! Time when we expect next averaging to start + logical :: new_av = .true. ! Set to true if the next correct call starts a new averaging round + + real(dp),pointer,dimension(:,:) :: tot_qsmb => null() ! running total surface mass balance (kg m-2 s-1) + real(dp),pointer,dimension(:,:) :: tot_tsfc => null() ! running total surface temperature (deg C) + + end type glad_input_averages_type + + public :: initialize_glad_input_averages + public :: get_av_start_time + public :: accumulate_averages + public :: calculate_averages + public :: reset_glad_input_averages + +contains + + subroutine initialize_glad_input_averages(glad_inputs, ewn, nsn, next_av_start) + ! Initialize a glad_inputs instance + + type(glad_input_averages_type), intent(inout) :: glad_inputs + + ! dimensions of local grid + integer, intent(in) :: ewn + integer, intent(in) :: nsn + + ! Starting time of next averaging period (hours) + integer, intent(in) :: next_av_start + + allocate(glad_inputs%tot_qsmb(ewn,nsn)); glad_inputs%tot_qsmb = 0.d0 + allocate(glad_inputs%tot_tsfc(ewn,nsn)); glad_inputs%tot_tsfc = 0.d0 + + glad_inputs%next_av_start = next_av_start + end subroutine initialize_glad_input_averages + + integer function get_av_start_time(glad_inputs) + ! Get value of time from the last occasion averaging was restarted (hours) + type(glad_input_averages_type), intent(in) :: glad_inputs + + get_av_start_time = glad_inputs%av_start_time + end function get_av_start_time + + subroutine accumulate_averages(glad_inputs, qsmb, tsfc, time) + ! Accumulate averages based on one set of inputs. + ! + ! Should be called every time we have new inputs from the climate model. + + type(glad_input_averages_type), intent(inout) :: glad_inputs + real(dp),dimension(:,:),intent(in) :: qsmb ! flux of glacier ice (kg/m^2/s) + real(dp),dimension(:,:),intent(in) :: tsfc ! surface ground temperature (C) + integer, intent(in) :: time ! Current model time + + if (glad_inputs%new_av) then + call start_new_averaging_period(glad_inputs, time) + end if + + glad_inputs%tot_qsmb(:,:) = glad_inputs%tot_qsmb(:,:) + qsmb(:,:) + glad_inputs%tot_tsfc(:,:) = glad_inputs%tot_tsfc(:,:) + tsfc(:,:) + + glad_inputs%av_steps = glad_inputs%av_steps + 1 + + end subroutine accumulate_averages + + subroutine calculate_averages(glad_inputs, qsmb, tsfc) + ! Calculate averages over the averaging period + type(glad_input_averages_type), intent(in) :: glad_inputs + real(dp), dimension(:,:), intent(out) :: qsmb ! average surface mass balance (kg m-2 s-1) + real(dp), dimension(:,:), intent(out) :: tsfc ! average surface temperature (deg C) + + qsmb(:,:) = glad_inputs%tot_qsmb(:,:) / real(glad_inputs%av_steps,dp) + tsfc(:,:) = glad_inputs%tot_tsfc(:,:) / real(glad_inputs%av_steps,dp) + end subroutine calculate_averages + + subroutine reset_glad_input_averages(glad_inputs, next_av_start) + ! Resets this glad_inputs instance + ! + ! Should be called at the end of an averaging period, in order to prepare for the + ! next averaging period + type(glad_input_averages_type), intent(inout) :: glad_inputs + integer, intent(in) :: next_av_start ! start time for next averaging period (hours) + + glad_inputs%tot_qsmb(:,:) = 0.d0 + glad_inputs%tot_tsfc(:,:) = 0.d0 + + glad_inputs%av_steps = 0 + glad_inputs%new_av = .true. + glad_inputs%next_av_start = next_av_start + end subroutine reset_glad_input_averages + + subroutine start_new_averaging_period(glad_inputs, time) + ! Should be called the first time accumulate_averages is called for a new averaging + ! period. Sets some flags appropriately in this case. + ! + ! Also performs some error checking to make sure we're not calling GLAD at an + ! unexpected time. + + type(glad_input_averages_type), intent(inout) :: glad_inputs + integer, intent(in) :: time ! Current model time + + character(len=100) :: message + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) 'Accumulating averages, current time (hr) =', time + write (stdout,*) 'av_start_time =', glad_inputs%av_start_time + write (stdout,*) 'next_av_start =', glad_inputs%next_av_start + write (stdout,*) 'new_av =', glad_inputs%new_av + end if + + if (time == glad_inputs%next_av_start) then + glad_inputs%av_start_time = time + glad_inputs%new_av = .false. + else + write(message,*) 'Unexpected calling of GLAD at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + + end subroutine start_new_averaging_period + +end module glad_input_averages diff --git a/components/cism/glimmer-cism/libglad/glad_io.F90.default b/components/cism/glimmer-cism/libglad/glad_io.F90.default new file mode 100644 index 0000000000..8501ba1b6c --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_io.F90.default @@ -0,0 +1,866 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! WARNING: this file was automatically generated on +! Fri, 03 Apr 2015 18:33:13 +0000 +! from ncdf_template.F90.in +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + + +module glad_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use glad_type + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in glad_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine glad_io_createall(model,data,outfiles) + ! open all netCDF files for output + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(glad_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in glad_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call glad_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine glad_io_createall + + subroutine glad_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glad_instance) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glad_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call glad_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glad_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine glad_io_writeall + + subroutine glad_io_create(outfile,model,data) + use parallel + use glide_types + use glad_type + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(glad_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + integer :: time_dimid + integer :: x1_dimid + integer :: y1_dimid + + ! defining dimensions + status = parallel_inq_dimid(NCO%id,'time',time_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'x1',x1_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'y1',y1_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,"_tavg") + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in glad_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + ! hflx_tavg -- heat flux to ice surface + pos = index(NCO%vars,' hflx_tavg ') + status = parallel_inq_varid(NCO%id,'hflx_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%hflx_tavg)) then + call write_log('Creating variable hflx_tavg') + status = parallel_def_var(NCO%id,'hflx_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'heat flux to ice surface') + status = parallel_put_att(NCO%id, varid, 'units', 'W m-2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable hflx_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! lat -- latitude + pos = index(NCO%vars,' lat ') + status = parallel_inq_varid(NCO%id,'lat',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+3) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%lat)) then + call write_log('Creating variable lat') + status = parallel_def_var(NCO%id,'lat',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'latitude') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'latitude') + status = parallel_put_att(NCO%id, varid, 'units', 'degreeN') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable lat was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! lon -- longitude + pos = index(NCO%vars,' lon ') + status = parallel_inq_varid(NCO%id,'lon',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+3) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%lon)) then + call write_log('Creating variable lon') + status = parallel_def_var(NCO%id,'lon',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'longitude') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'longitude') + status = parallel_put_att(NCO%id, varid, 'units', 'degreeE') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable lon was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rofi_tavg -- solid calving flux + pos = index(NCO%vars,' rofi_tavg ') + status = parallel_inq_varid(NCO%id,'rofi_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%rofi_tavg)) then + call write_log('Creating variable rofi_tavg') + status = parallel_def_var(NCO%id,'rofi_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'solid calving flux') + status = parallel_put_att(NCO%id, varid, 'units', 'kg m-2 s-1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable rofi_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rofl_tavg -- liquid runoff flux + pos = index(NCO%vars,' rofl_tavg ') + status = parallel_inq_varid(NCO%id,'rofl_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%rofl_tavg)) then + call write_log('Creating variable rofl_tavg') + status = parallel_def_var(NCO%id,'rofl_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'liquid runoff flux') + status = parallel_put_att(NCO%id, varid, 'units', 'kg m-2 s-1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable rofl_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + end subroutine glad_io_create + + subroutine glad_io_write(outfile,data) + use parallel + use glad_type + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + status = parallel_inq_varid(NCO%id,'hflx_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%hflx_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'lat',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%lat, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'lon',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%lon, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rofi_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%rofi_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rofl_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%rofl_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + end subroutine glad_io_write + + + subroutine glad_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to glad restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine glad_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in glad_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine glad_io_readall(data, model, filetype) + ! read from netCDF file + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glad_instance) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call glad_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine glad_io_readall + + + subroutine glad_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(glad_instance) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call glad_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine glad_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine glad_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use glad_type + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + status = parallel_inq_varid(NCI%id,'hflx_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%hflx_tavg)) then + call write_log(' Loading hflx_tavg') + status = distributed_get_var(NCI%id, varid, & + data%hflx_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling hflx_tavg",GM_DIAGNOSTIC) + data%hflx_tavg = data%hflx_tavg*scaling_factor + end if + else + call write_log('Variable hflx_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'lat',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%lat)) then + call write_log(' Loading lat') + status = distributed_get_var(NCI%id, varid, & + data%lat, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling lat",GM_DIAGNOSTIC) + data%lat = data%lat*scaling_factor + end if + else + call write_log('Variable lat was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'lon',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%lon)) then + call write_log(' Loading lon') + status = distributed_get_var(NCI%id, varid, & + data%lon, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling lon",GM_DIAGNOSTIC) + data%lon = data%lon*scaling_factor + end if + else + call write_log('Variable lon was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'rofi_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%rofi_tavg)) then + call write_log(' Loading rofi_tavg') + status = distributed_get_var(NCI%id, varid, & + data%rofi_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling rofi_tavg",GM_DIAGNOSTIC) + data%rofi_tavg = data%rofi_tavg*scaling_factor + end if + else + call write_log('Variable rofi_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'rofl_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%rofl_tavg)) then + call write_log(' Loading rofl_tavg') + status = distributed_get_var(NCI%id, varid, & + data%rofl_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling rofl_tavg",GM_DIAGNOSTIC) + data%rofl_tavg = data%rofl_tavg*scaling_factor + end if + else + call write_log('Variable rofl_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + end subroutine glad_io_read + + subroutine glad_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glad_type + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glad_instance), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + end subroutine glad_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine glad_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use glad_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glad_instance) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + end subroutine glad_avg_accumulate + + subroutine glad_avg_reset(outfile,data) + use parallel + use glad_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + end subroutine glad_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + subroutine glad_get_lat(data,outarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%lat + end subroutine glad_get_lat + + subroutine glad_set_lat(data,inarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%lat = inarray + end subroutine glad_set_lat + + subroutine glad_get_lon(data,outarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%lon + end subroutine glad_get_lon + + subroutine glad_set_lon(data,inarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%lon = inarray + end subroutine glad_set_lon + + +end module glad_io diff --git a/components/cism/glimmer-cism/libglad/glad_main.F90 b/components/cism/glimmer-cism/libglad/glad_main.F90 new file mode 100644 index 0000000000..cced320b86 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_main.F90 @@ -0,0 +1,921 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_main.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_main + + ! This module provides an interface to GCMs in the case where fields have already been + ! downscaled to the ice sheet grid (and the GCM does its own upscaling from the ice + ! sheet grid to the land grid). + ! + ! This only provides code for the SMB case, not for the PDD case. + + use glimmer_global, only: dp, fname_length + use glad_type + use glad_constants + use glimmer_config + use glimmer_filenames, only : process_path + use parallel, only: main_task + use glad_input_averages, only : get_av_start_time, accumulate_averages, & + calculate_averages, reset_glad_input_averages + + use glimmer_paramets, only: stdout, GLC_DEBUG + + implicit none + private + + ! ------------------------------------------------------------ + ! glad_params derived type definition + ! This is where default values are set. + ! ------------------------------------------------------------ + + type, public :: glad_params + + !> Derived type containing parameters relevant to all instances of + !> the model - i.e. those parameters which pertain to the global model. + + ! Ice model instances -------------------------------------- + + integer :: ninstances = 1 !> Number of ice model instances + character(fname_length),pointer,dimension(:) :: config_fnames => null() ! array of config filenames + type(glad_instance),pointer,dimension(:) :: instances => null() !> Array of glimmer\_instances + + ! Global model parameters ---------------------------------- + + integer :: tstep_mbal = 1 !> Mass-balance timestep (hours) + integer :: start_time !> Time of first call to glad (hours) + integer :: time_step !> Calling timestep of global model (hours) + + ! Parameters that can be set by the GCM calling Glad + + logical :: gcm_restart = .false. !> If true, restart the model from a GCM restart file + character(fname_length) :: gcm_restart_file !> Name of restart file + integer :: gcm_fileunit = 99 !> Fileunit specified by GCM for reading config files + + end type glad_params + + !--------------------------------------------------------------------------------------- + ! Use of the routines here: + ! + ! NOTE(wjs, 2015-03-24) I think this is going to need some rework in order to handle + ! multiple instances the way I'm planning to do it in CESM, with the coupler managing + ! these multiple instances: I think we're going to want a totally separate glad + ! instance for each ice sheet instance. Then some of these initialization routines + ! could be combined. + ! + ! In model initialization: + ! - Call glad_initialize once + ! - Call glad_initialize_instance once per instance + ! - Call glad_get_grid_size once per instance + ! (this is needed so that the caller can allocate arrays appropriately) + ! - Call glad_get_initial_outputs once per instance + ! - Call glad_initialization_wrapup once + ! + ! In the model run loop: + ! - Call glad_gcm once per instance + !--------------------------------------------------------------------------------------- + + public :: glad_initialize + public :: glad_initialize_instance + public :: glad_get_grid_size + public :: glad_get_initial_outputs + public :: glad_initialization_wrapup + + public :: glad_get_grid_indices + public :: glad_get_lat_lon + public :: glad_get_areas + + public :: glad_gcm + + public :: end_glad + + !--------------------------------------------------------------------------------------- + ! Some notes on coupling to the Community Earth System Model (CESM). These may be applicable + ! for coupling to other GCMs: + ! + ! When coupled to CESM, Glad receives two fields from the coupler on the ice sheet grid: + ! qsmb = surface mass balance (kg/m^2/s) + ! tsfc = surface ground temperature (deg C) + ! Both qsmb and tsfc are computed in the CESM land model. + ! Seven fields are returned to CESM on the ice sheet grid: + ! ice_covered = whether a grid cell is ice-covered [0,1] + ! topo = surface elevation (m) + ! hflx = heat flux from the ice interior to the surface (W/m^2) + ! rofi = ice runoff (i.e., calving) (kg/m^2/s) + ! rofl = liquid runoff (i.e., basal melting; the land model handles sfc runoff) (kg/m^2/s) + ! ice_sheet_grid_mask = mask of ice sheet grid coverage + ! icemask_coupled_fluxes = mask of ice sheet grid coverage where we are potentially + ! sending non-zero fluxes + ! + ! Note about ice_sheet_grid_mask and icemask_coupled_fluxes: ice_sheet_grid_mask is + ! non-zero wherever CISM is operating - i.e., grid cells with icesheet or bare land (but + ! not ocean). icemask_coupled_fluxes is similar, but is 0 for icesheet instances that + ! have zero_gcm_fluxes = .true. Thus, icemask_coupled_fluxes can be used to determine + ! the regions of the world in which CISM is operating and potentially sending non-zero + ! fluxes to the climate model. + ! + ! The land model has the option to update its ice coverage and surface elevation, given + ! the fields returned from Glad. + ! + !--------------------------------------------------------------------------------------- + +contains + + subroutine glad_initialize(params, time_step, paramfile, daysinyear, start_time, & + gcm_restart, gcm_restart_file, gcm_debug, gcm_fileunit) + + ! Initialize the model for runs coupled to a GCM. This routine initializes variables + ! shared between instances. See above for documentation of the full initialization + ! sequence. + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(inout) :: params !> parameters to be set + integer, intent(in) :: time_step !> Timestep of calling model (hours) + character(*),dimension(:), intent(in) :: paramfile !> array of configuration filenames. + integer, optional,intent(in) :: daysinyear !> Number of days in the year + integer, optional,intent(in) :: start_time !> Time of first call to glad (hours) + logical, optional,intent(in) :: gcm_restart ! logical flag to restart from a GCM restart file + character(*), optional,intent(in) :: gcm_restart_file ! restart filename for a GCM restart + ! (currently assumed to be CESM) + logical, optional,intent(in) :: gcm_debug ! logical flag from GCM to output debug information + integer, optional,intent(in) :: gcm_fileunit! fileunit for reading config files + + ! Internal variables ----------------------------------------------------------------------- + + type(ConfigSection), pointer :: global_config + + ! Begin subroutine code -------------------------------------------------------------------- + + + if (present(gcm_debug)) then + GLC_DEBUG = gcm_debug + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Initializing glad' + end if + + ! Initialise start time and calling model time-step (time_step = integer number of hours) + ! We ignore t=0 by default + + params%time_step = time_step + + ! Note: start_time = nhour_glad = 0 for an initial run. + ! Does this create problems given that Glad convention is to ignore t = 0? + + if (present(start_time)) then + params%start_time = start_time + else + params%start_time = time_step + end if + + params%gcm_restart = .false. + if (present(gcm_restart)) then + params%gcm_restart = gcm_restart + endif + + params%gcm_restart_file = '' + if (present(gcm_restart_file)) then + params%gcm_restart_file = gcm_restart_file + endif + + params%gcm_fileunit = 99 + if (present(gcm_fileunit)) then + params%gcm_fileunit = gcm_fileunit + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'time_step =', params%time_step + write(stdout,*) 'start_time =', params%start_time + end if + + ! Initialise year-length ------------------------------------------------------------------- + + if (present(daysinyear)) then + call glad_set_year_length(daysinyear) + end if + + ! --------------------------------------------------------------- + ! Determine how many instances there are, according to what + ! configuration files we've been provided with + ! --------------------------------------------------------------- + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Read paramfile' + write(stdout,*) 'paramfile =', paramfile + end if + + if (size(paramfile) == 1) then + ! Load the configuration file into the linked list + call ConfigRead(process_path(paramfile(1)), global_config, params%gcm_fileunit) + ! Parse the list + call glad_readconfig(global_config, params%ninstances, params%config_fnames, paramfile) + else + params%ninstances = size(paramfile) + allocate(params%config_fnames(params%ninstances)) + params%config_fnames(:) = paramfile(:) + end if + + allocate(params%instances(params%ninstances)) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Number of instances =', params%ninstances + end if + + end subroutine glad_initialize + + !=================================================================== + + subroutine glad_initialize_instance(params, instance_index) + + ! Initialize one instance in the params structure. See above for documentation of + ! the full initialization sequence. + + use glad_initialise, only : glad_i_initialise_gcm + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(inout) :: params !> parameters to be set + integer, intent(in) :: instance_index !> index of current ice sheet instance + + ! Internal variables ----------------------------------------------------------------------- + + type(ConfigSection), pointer :: instance_config + + ! Begin subroutine code -------------------------------------------------------------------- + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Read config file and initialize instance #', instance_index + end if + + call ConfigRead(process_path(params%config_fnames(instance_index)),& + instance_config, params%gcm_fileunit) + + call glad_i_initialise_gcm(instance_config, params%instances(instance_index), & + params%start_time, params%time_step, & + params%gcm_restart, params%gcm_restart_file, & + params%gcm_fileunit ) + + end subroutine glad_initialize_instance + + !=================================================================== + + subroutine glad_get_grid_size(params, instance_index, & + ewn, nsn, npts, & + ewn_tot, nsn_tot, npts_tot) + + ! Get the size of a grid corresponding to this instance. + ! + ! Returns both the size of local arrays (ewn, nsn, npts) and the size of global arrays + ! (ewn_tot, nsn_tot, npts_tot). + ! + ! The size is returned withOUT halo cells - note that the other routines here assume + ! that inputs and outputs do not have halo cells. + ! + ! The caller can then allocate arrays (inputs to and outputs from glad) with size + ! (ewn, nsn). + + use parallel, only : own_ewn, own_nsn, global_ewn, global_nsn + + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index ! index of current ice sheet instance + integer, intent(out) :: ewn ! number of east-west points owned by this proc (first dimension of arrays) + integer, intent(out) :: nsn ! number of north-south points owned by this proc (second dimension of arrays) + integer, intent(out) :: npts ! total number of points owned by this proc + integer, intent(out) :: ewn_tot ! total number of east-west points in grid + integer, intent(out) :: nsn_tot ! total number of north-south points in grid + integer, intent(out) :: npts_tot ! total number of points in grid + + ewn = own_ewn + nsn = own_nsn + npts = ewn * nsn + + ewn_tot = global_ewn + nsn_tot = global_nsn + npts_tot = ewn_tot * nsn_tot + + end subroutine glad_get_grid_size + + !=================================================================== + + subroutine glad_get_initial_outputs(params, instance_index, & + ice_covered, topo, & + rofi, rofl, hflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + output_flag) + + ! Get initial outputs for one instance. See above for documentation of the full + ! initialization sequence. + ! + ! Output arrays are assumed to NOT have halo cells. + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index !> index of current ice sheet instance + + real(dp),dimension(:,:),intent(out) :: ice_covered ! whether each grid cell is ice-covered [0,1] + real(dp),dimension(:,:),intent(out) :: topo ! output surface elevation (m) + real(dp),dimension(:,:),intent(out) :: hflx ! output heat flux (W/m^2, positive down) + real(dp),dimension(:,:),intent(out) :: rofi ! output ice runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(out) :: rofl ! output liquid runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(out) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + real(dp),dimension(:,:),intent(out) :: icemask_coupled_fluxes !mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + logical, optional,intent(out) :: output_flag !> Flag to show output set (provided for consistency) + + ! Begin subroutine code -------------------------------------------------------------------- + + call glad_set_output_fields(params%instances(instance_index), & + ice_covered, topo, rofi, rofl, hflx, & + ice_sheet_grid_mask, icemask_coupled_fluxes) + + if (present(output_flag)) output_flag = .true. + + end subroutine glad_get_initial_outputs + + !=================================================================== + + subroutine glad_initialization_wrapup(params, ice_dt) + + type(glad_params), intent(inout) :: params !> parameters to be set + integer, optional,intent(out) :: ice_dt !> Ice dynamics time-step in hours + + ! Wrapup glad initialization - perform error checks, etc. See above for documentation + ! of the full initialization sequence + + ! Check that all mass-balance time-steps are the same length and + ! assign that value to the top-level variable + + params%tstep_mbal = check_mbts(params%instances(:)%mbal_tstep) + + if (present(ice_dt)) then + ice_dt = check_mbts(params%instances(:)%ice_tstep) + end if + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'tstep_mbal =', params%tstep_mbal + write(stdout,*) 'start_time =', params%start_time + write(stdout,*) 'time_step =', params%time_step + if (present(ice_dt)) write(stdout,*) 'ice_dt =', ice_dt + end if + + ! Check time-steps divide into one another appropriately. + + if (.not. (mod (params%tstep_mbal, params%time_step) == 0)) then + call write_log('The mass-balance timestep must be an integer multiple of the forcing time-step', & + GM_FATAL,__FILE__,__LINE__) + end if + + + end subroutine glad_initialization_wrapup + + !=================================================================== + + subroutine glad_get_grid_indices(params, instance_index, & + global_indices, local_indices) + + ! Get 1-d indices for each grid cell. + ! + ! The global indices are unique across all tasks (i.e., the global grid). The local + ! indices go from 1 .. ncells on each task. The global indices increase going from + ! left to right, and then from bottom to top. So the indices for the bottom + ! (southernmost) row go 1 .. (# east-west points), etc. The local indices go in the + ! same order. + ! + ! The global_indices and local_indices arrays should NOT include halo cells. The + ! returned indices also ignore halo cells. + + use parallel, only : own_ewn, own_nsn, global_row_offset, global_col_offset, global_ewn + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index ! index of current ice sheet index + integer, intent(out) :: global_indices(:,:) + integer, intent(out) :: local_indices(:,:) + + ! Internal variables ----------------------------------------------------------------------- + + integer :: own_points ! number of points this proc is responsible for + integer, allocatable :: counts(:) ! count number of times each local index has been set + integer :: local_row, local_col + integer :: global_row, global_col + integer :: local_index, global_index + character(len=*), parameter :: subname = 'glad_get_grid_indices' + + ! Begin subroutine code -------------------------------------------------------------------- + + ! Perform error checking on inputs + + if (size(global_indices, 1) /= own_ewn .or. size(global_indices, 2) /= own_nsn) then + call write_log(subname // ' ERROR: Wrong size for global_indices', & + GM_FATAL, __FILE__, __LINE__) + end if + + if (size(local_indices, 1) /= own_ewn .or. size(local_indices, 2) /= own_nsn) then + call write_log(subname // ' ERROR: Wrong size for local_indices', & + GM_FATAL, __FILE__, __LINE__) + end if + + ! Set global and local indices + + own_points = own_ewn * own_nsn + allocate(counts(own_points)) + counts(:) = 0 + + do local_row = 1, own_nsn + do local_col = 1, own_ewn + local_index = (local_row - 1)*own_ewn + local_col + if (local_index < 1 .or. local_index > own_points) then + write(stdout,*) subname//' ERROR: local_index out of bounds: ', & + local_index, own_points + call write_log(subname // ' ERROR: local_index out of bounds', & + GM_FATAL, __FILE__, __LINE__) + end if + local_indices(local_col,local_row) = local_index + counts(local_index) = counts(local_index) + 1 + + global_row = local_row + global_row_offset + global_col = local_col + global_col_offset + global_index = (global_row - 1)*global_ewn + global_col + global_indices(local_col,local_row) = global_index + end do + end do + + ! Make sure that each local index has been assigned exactly once + if (any(counts /= 1)) then + call write_log(subname // ' ERROR: not all local indices have been assigned exactly once', & + GM_FATAL, __FILE__, __LINE__) + end if + + end subroutine glad_get_grid_indices + + !=================================================================== + + subroutine glad_get_lat_lon(params, instance_index, & + lats, lons) + + ! Get latitude and longitude for each grid cell + + ! Output arrays do NOT have halo cells + + use parallel, only : own_ewn, own_nsn, parallel_convert_haloed_to_nonhaloed + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index ! index of current ice sheet index + real(dp), intent(out) :: lats(:,:) ! latitudes (degrees) + real(dp), intent(out) :: lons(:,:) ! longitudes (degrees) + + ! Internal variables ----------------------------------------------------------------------- + character(len=*), parameter :: subname = 'glad_get_lat_lon' + + ! Begin subroutine code -------------------------------------------------------------------- + + ! Perform error checking on inputs + + if (size(lats, 1) /= own_ewn .or. size(lats, 2) /= own_nsn) then + call write_log(subname // ' ERROR: Wrong size for lats', & + GM_FATAL, __FILE__, __LINE__) + end if + + if (size(lons, 1) /= own_ewn .or. size(lons, 2) /= own_nsn) then + call write_log(subname // ' ERROR: Wrong size for lons', & + GM_FATAL, __FILE__, __LINE__) + end if + + call parallel_convert_haloed_to_nonhaloed(params%instances(instance_index)%lat, lats) + call parallel_convert_haloed_to_nonhaloed(params%instances(instance_index)%lon, lons) + + end subroutine glad_get_lat_lon + + !=================================================================== + + subroutine glad_get_areas(params, instance_index, areas) + + ! Get area of each grid cell + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index ! index of current ice sheet index + real(dp), intent(out) :: areas(:,:) ! areas (m^2) + + areas(:,:) = get_dns(params%instances(instance_index)%model) * & + get_dew(params%instances(instance_index)%model) + + end subroutine glad_get_areas + + + !=================================================================== + + subroutine glad_gcm(params, instance_index, time, & + qsmb, tsfc, & + ice_covered, topo, & + rofi, rofl, hflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + output_flag, ice_tstep) + + ! Main Glad subroutine for GCM coupling. + ! + ! It does all necessary temporal averaging, + ! and calls the dynamic ice sheet model when required. + ! + ! Input fields should be taken as means over the period since the last call. + ! See the user documentation for more information. + ! + ! Input fields are assumed to NOT have halo cells + + use glimmer_utils + use glad_timestep, only: glad_i_tstep_gcm + use glimmer_log + use glimmer_paramets, only: scyr + use parallel, only : parallel_convert_nonhaloed_to_haloed + use glide_types, only : get_ewn, get_nsn + use glad_output_fluxes, only : calculate_average_output_fluxes + + implicit none + + ! Subroutine argument declarations ------------------------------------------------------------- + + type(glad_params), intent(inout) :: params !> parameters for this run + integer, intent(in) :: instance_index !> index of current ice sheet instance + integer, intent(in) :: time !> Current model time (hours) + + real(dp),dimension(:,:),intent(in) :: qsmb ! input surface mass balance of glacier ice (kg/m^2/s) + real(dp),dimension(:,:),intent(in) :: tsfc ! input surface ground temperature (deg C) + + real(dp),dimension(:,:),intent(inout) :: ice_covered ! whether each grid cell is ice-covered [0,1] + real(dp),dimension(:,:),intent(inout) :: topo ! output surface elevation (m) + real(dp),dimension(:,:),intent(inout) :: hflx ! output heat flux (W/m^2, positive down) + real(dp),dimension(:,:),intent(inout) :: rofi ! output ice runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(inout) :: rofl ! output liquid runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(inout) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + real(dp),dimension(:,:),intent(inout) :: icemask_coupled_fluxes !mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + logical,optional,intent(out) :: output_flag ! Set true if outputs are set + logical,optional,intent(out) :: ice_tstep ! Set when an ice dynamic timestep has been done + ! and new output is available + + ! Internal variables ---------------------------------------------------------------------------- + + integer :: ewn,nsn ! dimensions of local grid + + ! version of input fields with halo cells + real(dp),dimension(:,:),allocatable :: qsmb_haloed + real(dp),dimension(:,:),allocatable :: tsfc_haloed + + logical :: icets + character(250) :: message + + integer :: av_start_time ! value of time from the last occasion averaging was restarted (hours) + + ! Begin subroutine code -------------------------------------------------------------------- + + ! Reset output flag + + if (present(output_flag)) output_flag = .false. + if (present(ice_tstep)) ice_tstep = .false. + + ! Accumulate input fields for later averaging + + ewn = get_ewn(params%instances(instance_index)%model) + nsn = get_nsn(params%instances(instance_index)%model) + allocate(qsmb_haloed(ewn,nsn)) + allocate(tsfc_haloed(ewn,nsn)) + call parallel_convert_nonhaloed_to_haloed(qsmb, qsmb_haloed) + call parallel_convert_nonhaloed_to_haloed(tsfc, tsfc_haloed) + + call accumulate_averages(params%instances(instance_index)%glad_inputs, & + qsmb = qsmb_haloed, tsfc = tsfc_haloed, time = time) + + ! --------------------------------------------------------- + ! If this is a mass balance timestep, prepare global fields, and do a timestep + ! for each model instance + ! --------------------------------------------------------- + + av_start_time = get_av_start_time(params%instances(instance_index)%glad_inputs) + + if (mod (time - av_start_time, params%time_step) /= 0) then + + write(message,*) 'Unexpected calling of GLAD at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + + else if (time - av_start_time + params%time_step > params%tstep_mbal) then + + write(message,*) & + 'Incomplete forcing of GLAD mass-balance time-step detected at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + + else if (time - av_start_time + params%time_step == params%tstep_mbal) then + + ! Set output_flag + + ! At present, outputs are done for each mass-balance timestep, since + ! that involved least change to the code. However, it might be good + ! to change the output to occur with user-specified frequency. + + if (present(output_flag)) output_flag = .true. + + ! Do a timestep for this instance + + if (time == params%instances(instance_index)%next_time) then + + params%instances(instance_index)%next_time = & + params%instances(instance_index)%next_time + & + params%instances(instance_index)%mbal_tstep + + ! Calculate averages by dividing by number of steps elapsed + ! since last model timestep. + + call calculate_averages(params%instances(instance_index)%glad_inputs, & + qsmb = params%instances(instance_index)%acab, & + tsfc = params%instances(instance_index)%artm) + + ! Calculate total surface mass balance - multiply by time since last model timestep + ! Note on units: We want acab to have units of meters w.e. (accumulated over mass balance time step) + ! Initial units are kg m-2 s-1 = mm s-1 + ! Divide by 1000 to convert from mm to m + ! Multiply by hours2seconds = 3600 to convert from 1/s to 1/hr. (tstep_mbal has units of hours) + + !TODO - Modify code so that qsmb and acab are always in kg m-2 s-1 water equivalent? + params%instances(instance_index)%acab(:,:) = & + params%instances(instance_index)%acab(:,:) * & + params%tstep_mbal * hours2seconds / 1000.d0 + + if (GLC_DEBUG .and. main_task) write(stdout,*) 'Take a glad time step, instance', instance_index + call glad_i_tstep_gcm(time, & + params%instances(instance_index), & + icets) + + call calculate_average_output_fluxes( & + params%instances(instance_index)%glad_output_fluxes, & + rofi_tavg = params%instances(instance_index)%rofi_tavg, & + rofl_tavg = params%instances(instance_index)%rofl_tavg, & + hflx_tavg = params%instances(instance_index)%hflx_tavg) + + call glad_set_output_fields(params%instances(instance_index), & + ice_covered, topo, rofi, rofl, hflx, & + ice_sheet_grid_mask, icemask_coupled_fluxes) + + + ! Set flag + if (present(ice_tstep)) then + ice_tstep = (ice_tstep .or. icets) + end if + + endif ! time = next_time + + ! --------------------------------------------------------- + ! Reset averaging fields, flags and counters + ! --------------------------------------------------------- + + call reset_glad_input_averages(params%instances(instance_index)%glad_inputs, & + next_av_start = time + params%time_step) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Done in glad_gcm' + endif + + endif ! time - av_start_time + params%time_step > params%tstep_mbal + + end subroutine glad_gcm + + !=================================================================== + + subroutine end_glad(params,close_logfile) + + !> tidy-up operations for Glad + use glad_initialise + use glimmer_log + implicit none + + type(glad_params),intent(inout) :: params ! parameters for this run + logical, intent(in), optional :: close_logfile ! if true, then close the log file + ! (GCM may do this elsewhere) + integer :: i + + ! end individual instances + + do i = 1, params%ninstances + call glad_i_end(params%instances(i)) + enddo + + if (present(close_logfile)) then + if (close_logfile) call close_log + else + call close_log + endif + + deallocate(params%config_fnames) + deallocate(params%instances) + + end subroutine end_glad + + !---------------------------------------------------------------------- + ! PRIVATE INTERNAL GLIMMER SUBROUTINES FOLLOW............. + !---------------------------------------------------------------------- + + subroutine glad_set_output_fields(instance, & + ice_covered, topo, & + rofi, rofl, hflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes) + + ! Sets output fields for this instance. + ! + ! Arguments are assumed to NOT have halo cells. This routine handles the removal of + ! the halo cells. + + use glad_output_states, only : set_output_states + use parallel, only : parallel_convert_haloed_to_nonhaloed + use glide_types, only : get_ewn, get_nsn + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glad_instance), intent(in) :: instance + + real(dp),dimension(:,:),intent(out) :: ice_covered ! whether each grid cell is ice-covered [0,1] + real(dp),dimension(:,:),intent(out) :: topo ! output surface elevation (m) + real(dp),dimension(:,:),intent(out) :: hflx ! output heat flux (W/m^2, positive down) + real(dp),dimension(:,:),intent(out) :: rofi ! output ice runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(out) :: rofl ! output liquid runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:),intent(out) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + real(dp),dimension(:,:),intent(out) :: icemask_coupled_fluxes !mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + ! Internal variables ----------------------------------------------------------------------- + + integer :: ewn,nsn ! dimensions of local grid + + ! temporary versions of output fields with halo cells + real(dp),dimension(:,:),allocatable :: ice_covered_haloed + real(dp),dimension(:,:),allocatable :: topo_haloed + real(dp),dimension(:,:),allocatable :: hflx_haloed + real(dp),dimension(:,:),allocatable :: rofi_haloed + real(dp),dimension(:,:),allocatable :: rofl_haloed + real(dp),dimension(:,:),allocatable :: ice_sheet_grid_mask_haloed + real(dp),dimension(:,:),allocatable :: icemask_coupled_fluxes_haloed + + ! Begin subroutine code -------------------------------------------------------------------- + + ewn = get_ewn(instance%model) + nsn = get_nsn(instance%model) + + allocate(ice_covered_haloed(ewn,nsn)) + allocate(topo_haloed(ewn,nsn)) + allocate(hflx_haloed(ewn,nsn)) + allocate(rofi_haloed(ewn,nsn)) + allocate(rofl_haloed(ewn,nsn)) + allocate(ice_sheet_grid_mask_haloed(ewn,nsn)) + allocate(icemask_coupled_fluxes_haloed(ewn,nsn)) + + call set_output_states(instance, & + ice_covered_haloed, topo_haloed, ice_sheet_grid_mask_haloed) + + if (instance%zero_gcm_fluxes == ZERO_GCM_FLUXES_TRUE) then + icemask_coupled_fluxes_haloed(:,:) = 0.d0 + hflx_haloed(:,:) = 0.d0 + rofi_haloed(:,:) = 0.d0 + rofl_haloed(:,:) = 0.d0 + else + icemask_coupled_fluxes_haloed(:,:) = ice_sheet_grid_mask_haloed(:,:) + hflx_haloed(:,:) = instance%hflx_tavg(:,:) + rofi_haloed(:,:) = instance%rofi_tavg(:,:) + rofl_haloed(:,:) = instance%rofl_tavg(:,:) + end if + + call parallel_convert_haloed_to_nonhaloed(ice_covered_haloed, ice_covered) + call parallel_convert_haloed_to_nonhaloed(topo_haloed, topo) + call parallel_convert_haloed_to_nonhaloed(hflx_haloed, hflx) + call parallel_convert_haloed_to_nonhaloed(rofi_haloed, rofi) + call parallel_convert_haloed_to_nonhaloed(rofl_haloed, rofl) + call parallel_convert_haloed_to_nonhaloed(ice_sheet_grid_mask_haloed, ice_sheet_grid_mask) + call parallel_convert_haloed_to_nonhaloed(icemask_coupled_fluxes_haloed, icemask_coupled_fluxes) + + end subroutine glad_set_output_fields + + !TODO - Move subroutine glad_readconfig to a glad_setup module, in analogy to glide_setup? + + subroutine glad_readconfig(config, ninstances, fnames, infnames) + + !> Determine whether a given config file is a + !> top-level glad config file, and return parameters + !> accordingly. + + use glimmer_config + use glimmer_log + implicit none + + ! Arguments ------------------------------------------- + + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + integer, intent(out) :: ninstances !> Number of instances to create + character(fname_length),dimension(:),pointer :: fnames !> list of filenames (output) + character(fname_length),dimension(:) :: infnames !> list of filenames (input) + + ! Internal variables ---------------------------------- + + type(ConfigSection), pointer :: section + character(len=100) :: message + integer :: i + + if (associated(fnames)) nullify(fnames) + + call GetSection(config,section,'GLAD') + if (associated(section)) then + call GetValue(section,'n_instance',ninstances) + allocate(fnames(ninstances)) + do i=1,ninstances + call GetSection(section%next,section,'GLAD instance') + if (.not.associated(section)) then + write(message,*) 'Must specify ',ninstances,' instance config files' + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + call GetValue(section,'name',fnames(i)) + end do + else + ninstances=1 + allocate(fnames(1)) + fnames=infnames + end if + + ! Print some configuration information + +!!$ call write_log('GLAD global') +!!$ call write_log('------------') +!!$ write(message,*) 'number of instances :',params%ninstances +!!$ call write_log(message) +!!$ call write_log('') + + end subroutine glad_readconfig + + + !======================================================== + + integer function check_mbts(timesteps) + + !> Checks to see that all mass-balance time-steps are + !> the same. Flags a fatal error if not, else assigns that + !> value to the output + + use glimmer_log + + implicit none + + integer,dimension(:) :: timesteps !> Array of mass-balance timsteps + + integer :: n,i + + n = size(timesteps) + if (n==0) then + check_mbts = 0 + return + endif + + check_mbts = timesteps(1) + + do i = 2,n + if (timesteps(i) /= check_mbts) then + call write_log('All instances must have the same mass-balance and ice timesteps', & + GM_FATAL,__FILE__,__LINE__) + endif + enddo + + end function check_mbts + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glad_main + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglad/glad_mbal_coupling.F90 b/components/cism/glimmer-cism/libglad/glad_mbal_coupling.F90 new file mode 100644 index 0000000000..033573809c --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_mbal_coupling.F90 @@ -0,0 +1,164 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_mbal_coupling.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_mbal_coupling + + use glimmer_config + use glimmer_global, only : dp + + implicit none + + ! Module to handle the accumulation of inputs. + + ! Note that this module has some functionality in common with glad_input_averages, but + ! they are used at different stages in the time loops. + + type glad_mbc + real(dp),dimension(:,:),pointer :: acab_save => null() ! used to accumulate mass-balance + real(dp),dimension(:,:),pointer :: artm_save => null() ! used to average air-temperature + real(dp),dimension(:,:),pointer :: acab => null() ! Instantaneous mass-balance + real(dp),dimension(:,:),pointer :: artm => null() ! Instantaneous air temperature + integer :: av_count = 0 ! Counter for averaging inputs + logical :: new_accum = .true. + integer :: start_time ! the time we started averaging (hours) + integer :: tstep ! Timestep of mass-balance scheme in hours + end type glad_mbc + +contains + + subroutine glad_mbc_init(params,lgrid) + + ! Initialize the glad_mbc structure ('params'). + + ! NOTE(wjs, 2015-03-19) In glint, when using SMB coupling, this was done in + ! glint_downscale.F90: glint_init_input_gcm (rather than in glint_mbc_init). However, + ! for simplicity and modularity, I am moving operations like this that act on glad_mbc + ! into this glad_mbal_coupling module. + + use glimmer_coordinates + use glad_constants, only : years2hours + + type(glad_mbc) :: params + type(coordsystem_type) :: lgrid + + ! Deallocate if necessary + + if (associated(params%acab_save)) deallocate(params%acab_save) + if (associated(params%artm_save)) deallocate(params%artm_save) + if (associated(params%acab)) deallocate(params%acab) + if (associated(params%artm)) deallocate(params%artm) + + ! Allocate arrays and zero + + call coordsystem_allocate(lgrid,params%acab_save); params%acab_save = 0.d0 + call coordsystem_allocate(lgrid,params%artm_save); params%artm_save = 0.d0 + call coordsystem_allocate(lgrid,params%acab); params%acab = 0.d0 + call coordsystem_allocate(lgrid,params%artm); params%artm = 0.d0 + + ! Set default mass balance time step + ! + ! This is the default value that was being used in glint for the MASS_BALANCE_GCM + ! scheme (some other schemes used different defaults) + params%tstep = nint(years2hours) ! mbal tstep = 1 year + + end subroutine glad_mbc_init + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_accumulate_input_gcm(params, time, acab, artm) + + ! In glint, this was done in glint_downscale.F90 + + type(glad_mbc) :: params + integer :: time + + real(dp),dimension(:,:),intent(in) :: acab ! Surface mass balance (m) + real(dp),dimension(:,:),intent(in) :: artm ! Mean air temperature (degC) + + ! Things to do the first time + + if (params%new_accum) then + + params%new_accum = .false. + params%av_count = 0 + + ! Initialise + + params%acab_save = 0.d0 + params%artm_save = 0.d0 + params%start_time = time + + end if + + params%av_count = params%av_count + 1 + + ! Accumulate + + params%acab_save = params%acab_save + acab + params%artm_save = params%artm_save + artm + + ! Copy instantaneous fields + + params%acab = acab + params%artm = artm + + end subroutine glad_accumulate_input_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_average_input_gcm(params, dt, acab, artm) + + ! In glint, this was done in glint_downscale.F90 + + use glad_constants, only: hours2years + + type(glad_mbc) :: params + integer, intent(in) :: dt !> mbal accumulation time (hours) + real(dp),dimension(:,:),intent(out) :: artm !> Mean air temperature (degC) + real(dp),dimension(:,:),intent(out) :: acab !> Mass-balance (m/yr) + + if (.not. params%new_accum) then + params%artm_save = params%artm_save / real(params%av_count,dp) + end if + artm = params%artm_save + + ! Note: acab_save has units of m, but acab has units of m/yr + acab = params%acab_save / real(dt*hours2years,dp) + + params%new_accum = .true. + + end subroutine glad_average_input_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++ + + +end module glad_mbal_coupling + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglad/glad_mbal_io.F90.default b/components/cism/glimmer-cism/libglad/glad_mbal_io.F90.default new file mode 100644 index 0000000000..39c0759f0a --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_mbal_io.F90.default @@ -0,0 +1,878 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! WARNING: this file was automatically generated on +! Fri, 03 Apr 2015 18:33:13 +0000 +! from ncdf_template.F90.in +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + + +module glad_mbal_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use glad_type + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in glad_mbal_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine glad_mbal_io_createall(model,data,outfiles) + ! open all netCDF files for output + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(glad_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in glad_mbal_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call glad_mbal_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine glad_mbal_io_createall + + subroutine glad_mbal_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glad_instance) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glad_mbal_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call glad_mbal_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glad_mbal_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine glad_mbal_io_writeall + + subroutine glad_mbal_io_create(outfile,model,data) + use parallel + use glide_types + use glad_type + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(glad_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + integer :: level_dimid + integer :: lithoz_dimid + integer :: staglevel_dimid + integer :: stagwbndlevel_dimid + integer :: time_dimid + integer :: x0_dimid + integer :: x1_dimid + integer :: y0_dimid + integer :: y1_dimid + + ! defining dimensions + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'level',model%general%upn,level_dimid) + else + status = parallel_inq_dimid(NCO%id,'level',level_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'lithoz',model%lithot%nlayer,lithoz_dimid) + else + status = parallel_inq_dimid(NCO%id,'lithoz',lithoz_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'staglevel',model%general%upn-1,staglevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'staglevel',staglevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'stagwbndlevel',model%general%upn+1,stagwbndlevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'stagwbndlevel',stagwbndlevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'time',time_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x0',global_ewn-1,x0_dimid) + else + status = parallel_inq_dimid(NCO%id,'x0',x0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x1',global_ewn,x1_dimid) + else + status = parallel_inq_dimid(NCO%id,'x1',x1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y0',global_nsn-1,y0_dimid) + else + status = parallel_inq_dimid(NCO%id,'y0',y0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y1',global_nsn,y1_dimid) + else + status = parallel_inq_dimid(NCO%id,'y1',y1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,"_tavg") + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in glad_mbal_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + ! level -- sigma layers + if (.not.outfile%append) then + call write_log('Creating variable level') + status = parallel_def_var(NCO%id,'level',get_xtype(outfile,NF90_FLOAT),(/level_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'formula_terms', 'sigma: level topo: topg thick: thk') + status = parallel_put_att(NCO%id, varid, 'long_name', 'sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! lithoz -- vertical coordinate of lithosphere layer + if (.not.outfile%append) then + call write_log('Creating variable lithoz') + status = parallel_def_var(NCO%id,'lithoz',get_xtype(outfile,NF90_FLOAT),(/lithoz_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'vertical coordinate of lithosphere layer') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! staglevel -- stag sigma layers + if (.not.outfile%append) then + call write_log('Creating variable staglevel') + status = parallel_def_var(NCO%id,'staglevel',get_xtype(outfile,NF90_FLOAT),(/staglevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! stagwbndlevel -- stag sigma layers with boundaries + if (.not.outfile%append) then + call write_log('Creating variable stagwbndlevel') + status = parallel_def_var(NCO%id,'stagwbndlevel',get_xtype(outfile,NF90_FLOAT),(/stagwbndlevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers with boundaries') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate_with_bnd') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! x0 -- Cartesian x-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable x0') + status = parallel_def_var(NCO%id,'x0',get_xtype(outfile,NF90_FLOAT),(/x0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_x_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! x1 -- Cartesian x-coordinate + if (.not.outfile%append) then + call write_log('Creating variable x1') + status = parallel_def_var(NCO%id,'x1',get_xtype(outfile,NF90_FLOAT),(/x1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_x_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! y0 -- Cartesian y-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable y0') + status = parallel_def_var(NCO%id,'y0',get_xtype(outfile,NF90_FLOAT),(/y0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_y_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! y1 -- Cartesian y-coordinate + if (.not.outfile%append) then + call write_log('Creating variable y1') + status = parallel_def_var(NCO%id,'y1',get_xtype(outfile,NF90_FLOAT),(/y1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_y_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! instant_acab -- instantaneous mass-balance + pos = index(NCO%vars,' instant_acab ') + status = parallel_inq_varid(NCO%id,'instant_acab',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%acab)) then + call write_log('Creating variable instant_acab') + status = parallel_def_var(NCO%id,'instant_acab',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous mass-balance') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_acab was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_artm -- instantaneous air temperature + pos = index(NCO%vars,' instant_artm ') + status = parallel_inq_varid(NCO%id,'instant_artm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%artm)) then + call write_log('Creating variable instant_artm') + status = parallel_def_var(NCO%id,'instant_artm',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous air temperature') + status = parallel_put_att(NCO%id, varid, 'units', 'degC') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_artm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + end subroutine glad_mbal_io_create + + subroutine glad_mbal_io_write(outfile,data) + use parallel + use glad_type + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + status = parallel_inq_varid(NCO%id,'instant_acab',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%acab, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_artm',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%artm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + end subroutine glad_mbal_io_write + + + subroutine glad_mbal_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to glad_mbal restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine glad_mbal_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in glad_mbal_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine glad_mbal_io_readall(data, model, filetype) + ! read from netCDF file + use glad_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glad_instance) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call glad_mbal_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine glad_mbal_io_readall + + + subroutine glad_mbal_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(glad_instance) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call glad_mbal_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine glad_mbal_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine glad_mbal_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use glad_type + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + end subroutine glad_mbal_io_read + + subroutine glad_mbal_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glad_type + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glad_instance), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + status = parallel_inq_dimid(NCI%id,'level',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size level does not match: ', & + model%general%upn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'lithoz',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%lithot%nlayer) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size lithoz does not match: ', & + model%lithot%nlayer + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'staglevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size staglevel does not match: ', & + model%general%upn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'stagwbndlevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn+1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size stagwbndlevel does not match: ', & + model%general%upn+1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x0 does not match: ', & + global_ewn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x1 does not match: ', & + global_ewn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y0 does not match: ', & + global_nsn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y1 does not match: ', & + global_nsn + call write_log(message,GM_FATAL) + end if + end if + end subroutine glad_mbal_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine glad_mbal_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use glad_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glad_instance) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + end subroutine glad_mbal_avg_accumulate + + subroutine glad_mbal_avg_reset(outfile,data) + use parallel + use glad_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glad_instance) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + end subroutine glad_mbal_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + subroutine glad_mbal_get_instant_acab(data,outarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%acab + end subroutine glad_mbal_get_instant_acab + + subroutine glad_mbal_set_instant_acab(data,inarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%acab = inarray + end subroutine glad_mbal_set_instant_acab + + subroutine glad_mbal_get_instant_artm(data,outarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%artm + end subroutine glad_mbal_get_instant_artm + + subroutine glad_mbal_set_instant_artm(data,inarray) + use glimmer_scales + use glimmer_paramets + use glad_type + implicit none + type(glad_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%artm = inarray + end subroutine glad_mbal_set_instant_artm + + +end module glad_mbal_io diff --git a/components/cism/glimmer-cism/libglad/glad_mbal_vars.def b/components/cism/glimmer-cism/libglad/glad_mbal_vars.def new file mode 100644 index 0000000000..0b7c5fcd5c --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_mbal_vars.def @@ -0,0 +1,95 @@ +#[] +#dimensions: time, y1, x1 +#units: +#long_name: +#data: +#factor: + +# setup for code generator +[VARSET] +# prefix of the generated module +name: glad_mbal +# f90 type containing all necessary data +datatype: glad_instance +# module where type is defined +datamod: glad_type + +[x0] +dimensions: x0 +units: meter +long_name: Cartesian x-coordinate, velocity grid +standard_name: projection_x_coordinate +dimlen: global_ewn-1 + +[y0] +dimensions: y0 +units: meter +long_name: Cartesian y-coordinate, velocity grid +standard_name: projection_y_coordinate +dimlen: global_nsn-1 + +[x1] +dimensions: x1 +units: meter +long_name: Cartesian x-coordinate +standard_name: projection_x_coordinate +dimlen: global_ewn + +[y1] +dimensions: y1 +units: meter +long_name: Cartesian y-coordinate +standard_name: projection_y_coordinate +dimlen: global_nsn + +# --- MJH 8/29/2014 ----------------------------------------------- +# Because glad is calling glide_nc_fillall() these glide dimension variables +# need to be included here even though they are not used by glad, otherwise +# a fatal error occurs (at least on some builds). +# A more appropriate fix might be to create a glad_nc_fillall() that would not +# try to write these variables to the output file. +[level] +dimensions: level +units: 1 +long_name: sigma layers +standard_name: land_ice_sigma_coordinate +formula_terms: sigma: level topo: topg thick: thk +dimlen: model%general%upn + +[staglevel] +dimensions: staglevel +units: 1 +long_name: stag sigma layers +standard_name: land_ice_stag_sigma_coordinate +positive: down +dimlen: model%general%upn-1 + +[stagwbndlevel] +dimensions: stagwbndlevel +units: 1 +long_name: stag sigma layers with boundaries +standard_name: land_ice_stag_sigma_coordinate_with_bnd +positive: down +dimlen: model%general%upn+1 + +[lithoz] +dimensions: lithoz +units: meter +long_name: vertical coordinate of lithosphere layer +dimlen: model%lithot%nlayer +# ------------------------------------------------------------------ + +[instant_acab] +dimensions: time, y1, x1 +units: meter +long_name: instantaneous mass-balance +data: data%mbal_accum%acab +coordinates: lon lat + +[instant_artm] +dimensions: time, y1, x1 +units: degC +long_name: instantaneous air temperature +data: data%mbal_accum%artm +coordinates: lon lat + diff --git a/components/cism/glimmer-cism/libglad/glad_output_fluxes.F90 b/components/cism/glimmer-cism/libglad/glad_output_fluxes.F90 new file mode 100644 index 0000000000..e6b626e82e --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_output_fluxes.F90 @@ -0,0 +1,159 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_output_fluxes.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_output_fluxes + + !> This module defines a type and related operations for working with fluxes output to + !> the GCM. Its main purpose is to produce temporal averages of these outputs. + + ! (Most of the code here used to be in glint_upscale.F90) + + use glimmer_global, only: dp + + implicit none + private + + type, public :: glad_output_fluxes_type + private + + integer :: av_count_output ! step counter + + real(dp), dimension(:,:), pointer :: hflx_sum => null() ! conductive heat flux at top surface (W m-2) + real(dp), dimension(:,:), pointer :: rofi_sum => null() ! solid ice runoff (kg m-2 s-1) + real(dp), dimension(:,:), pointer :: rofl_sum => null() ! liquid runoff from basal/interior melting (kg m-2 s-1) + end type glad_output_fluxes_type + + public :: initialize_glad_output_fluxes ! Initialize a glad_output_fluxes instance + public :: accumulate_output_fluxes ! Accumulate one time step's contribution to fluxes + public :: calculate_average_output_fluxes ! Compute and return time-average fluxes + public :: reset_output_fluxes ! Reset output_fluxes state to start a new averaging period + +contains + + subroutine initialize_glad_output_fluxes(output_fluxes, ewn, nsn) + ! Initialize a glad_output_fluxes instance + + type(glad_output_fluxes_type), intent(inout) :: output_fluxes + + ! dimensions of local grid + integer, intent(in) :: ewn + integer, intent(in) :: nsn + + allocate(output_fluxes%rofi_sum(ewn,nsn)) + allocate(output_fluxes%rofl_sum(ewn,nsn)) + allocate(output_fluxes%hflx_sum(ewn,nsn)) + + call reset_output_fluxes(output_fluxes) + + end subroutine initialize_glad_output_fluxes + + subroutine accumulate_output_fluxes(output_fluxes, model) + ! Given the calving, basal melting, and conductive heat flux fields from the dycore, + ! accumulate contributions to the rofi, rofl, and hflx fields to be sent to the coupler. + + use glimmer_paramets, only: thk0, tim0 + use glimmer_physcon, only : rhoi + use glide_types, only : glide_global_type + + type(glad_output_fluxes_type), intent(inout) :: output_fluxes + type(glide_global_type), intent(in) :: model + + output_fluxes%av_count_output = output_fluxes%av_count_output + 1 + + !-------------------------------------------------------------------- + ! Accumulate solid runoff (calving) + !-------------------------------------------------------------------- + + ! Note on units: model%climate%calving has dimensionless ice thickness units + ! Multiply by thk0 to convert to meters of ice + ! Multiply by rhoi to convert to kg/m^2 water equiv. + ! Divide by (dt*tim0) to convert to kg/m^2/s + + ! Convert to kg/m^2/s + output_fluxes%rofi_sum(:,:) = output_fluxes%rofi_sum(:,:) & + + model%climate%calving(:,:) * thk0 * rhoi / (model%numerics%dt * tim0) + + !-------------------------------------------------------------------- + ! Accumulate liquid runoff (basal melting) + !-------------------------------------------------------------------- + !TODO - Add internal melting for enthalpy case + + ! Note on units: model%temper%bmlt has dimensionless units of ice thickness per unit time + ! Multiply by thk0/tim0 to convert to meters ice per second + ! Multiply by rhoi to convert to kg/m^2/s water equiv. + + ! Convert to kg/m^2/s + output_fluxes%rofl_sum(:,:) = output_fluxes%rofl_sum(:,:) & + + model%temper%bmlt(:,:) * thk0/tim0 * rhoi + + !-------------------------------------------------------------------- + ! Accumulate basal heat flux + !-------------------------------------------------------------------- + + ! Note on units: model%temper%ucondflx has units of W/m^2, positive down + ! Flip the sign so that hflx is positive up. + + output_fluxes%hflx_sum(:,:) = output_fluxes%hflx_sum(:,:) & + - model%temper%ucondflx(:,:) + + end subroutine accumulate_output_fluxes + + subroutine calculate_average_output_fluxes(output_fluxes, rofi_tavg, rofl_tavg, hflx_tavg) + ! Compute and return time-average fluxes + + type(glad_output_fluxes_type), intent(in) :: output_fluxes + real(dp), dimension(:,:), intent(out) :: rofi_tavg ! average solid ice runoff (kg m-2 s-1) + real(dp), dimension(:,:), intent(out) :: rofl_tavg ! average liquid runoff from basal/interior melting (kg m-2 s-1) + real(dp), dimension(:,:), intent(out) :: hflx_tavg ! average conductive heat flux at top surface (W m-2) + + if (output_fluxes%av_count_output > 0) then + rofi_tavg(:,:) = output_fluxes%rofi_sum(:,:) / real(output_fluxes%av_count_output,dp) + rofl_tavg(:,:) = output_fluxes%rofl_sum(:,:) / real(output_fluxes%av_count_output,dp) + hflx_tavg(:,:) = output_fluxes%hflx_sum(:,:) / real(output_fluxes%av_count_output,dp) + else + rofi_tavg(:,:) = 0.d0 + rofl_tavg(:,:) = 0.d0 + hflx_tavg(:,:) = 0.d0 + end if + + end subroutine calculate_average_output_fluxes + + subroutine reset_output_fluxes(output_fluxes) + ! Reset output_fluxes state to start a new averaging period + + type(glad_output_fluxes_type), intent(inout) :: output_fluxes + + output_fluxes%av_count_output = 0 + output_fluxes%rofi_sum(:,:) = 0.d0 + output_fluxes%rofl_sum(:,:) = 0.d0 + output_fluxes%hflx_sum(:,:) = 0.d0 + end subroutine reset_output_fluxes + +end module glad_output_fluxes diff --git a/components/cism/glimmer-cism/libglad/glad_output_states.F90 b/components/cism/glimmer-cism/libglad/glad_output_states.F90 new file mode 100644 index 0000000000..9e135b75d2 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_output_states.F90 @@ -0,0 +1,159 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_output_states.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glad_output_states + + ! This module defines routines for computing the output state variables that CISM sends + ! to a climate model. + + use glimmer_global, only : dp + use glimmer_paramets, only : thk0 + use glide_types, only : glide_global_type, glide_geometry + + implicit none + private + + public :: set_output_states ! set state fields output to a climate model + +contains + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine set_output_states(instance, & + ice_covered, topo, ice_sheet_grid_mask) + + use glad_type, only : glad_instance + + ! Arguments ---------------------------------------------------------------------------- + + type(glad_instance), intent(in) :: instance + real(dp),dimension(:,:),intent(out) :: ice_covered ! whether each grid cell is ice-covered [0,1] + real(dp),dimension(:,:),intent(out) :: topo ! output surface elevation (m) + real(dp),dimension(:,:),intent(out) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + + ! Internal variables ---------------------------------------------------------------------- + + integer :: nxl, nyl ! local grid dimensions + integer :: i, j ! indices + + ! Begin subroutine code ------------------------------------------------------------------- + + ! Initialize arrays. This shouldn't be necessary (because, if the below code is + ! correct, all points should be explicitly assigned some value), but adds some safety + ! in case any bugs creep into the below code. + ice_covered(:,:) = 0.d0 + topo(:,:) = 0.d0 + ice_sheet_grid_mask(:,:) = 0.d0 + + nxl = instance%lgrid%size%pt(1) + nyl = instance%lgrid%size%pt(2) + + do j = 1, nyl + do i = 1, nxl + if (is_in_active_grid(instance%model%geometry, i, j)) then + ice_sheet_grid_mask(i,j) = 1.d0 + + if (is_ice_covered(instance%model%geometry, i, j)) then + ice_covered(i,j) = 1.d0 + else + ice_covered(i,j) = 0.d0 + end if + + ! Note that we use the same method for computing topo whether this point is + ! ice-covered or ice-free. This is in contrast to the method for computing + ! ice-free topo in glint_upscaling_gcm. + topo(i,j) = thk0 * instance%model%geometry%usrf(i,j) + + else + ! Note that this logic implies that if (in theory) we had an ice-covered + ! point outside the "active grid", it will get classified as ice-free for + ! these purposes. This mimics the logic currently in glint_upscaling_gcm. + ice_sheet_grid_mask(i,j) = 0.d0 + ice_covered(i,j) = 0.d0 + topo(i,j) = 0.d0 + end if + + end do + end do + + end subroutine set_output_states + + + !=================================================================== + + logical function is_in_active_grid(geometry, i, j) + ! Return true if the given point is inside the "active grid". The active grid includes + ! any point that can receive a positive surface mass balance, which includes any + ! point classified as land or ice sheet. + type(glide_geometry), intent(in) :: geometry + integer, intent(in) :: i, j ! point of interest + + real(dp) :: usrf ! surface elevation (m) + + ! TODO(wjs, 2015-03-18) Could the logic here be replaced by the use of some existing + ! mask? For now I am simply re-implementing the logic that was in glint. + + usrf = thk0 * geometry%usrf(i,j) + + if (usrf > 0.d0) then + ! points not at sea level are assumed to be land or ice sheet + is_in_active_grid = .true. + else + is_in_active_grid = .false. + end if + + end function is_in_active_grid + + !=================================================================== + + logical function is_ice_covered(geometry, i, j) + ! Return true if the given point is ice-covered + + use glad_constants, only : min_thck + + type(glide_geometry), intent(in) :: geometry + integer, intent(in) :: i, j ! point of interest + + real(dp) :: thck ! ice thickness (m) + + ! TODO(wjs, 2015-03-18) The logic here should probably be replaced by the use of some + ! existing mask. For now I am simply re-implementing the logic that was in glint. + + thck = thk0 * geometry%thck(i,j) + + if (thck > min_thck) then + is_ice_covered = .true. + else + is_ice_covered = .false. + end if + + end function is_ice_covered + +end module glad_output_states diff --git a/components/cism/glimmer-cism/libglad/glad_restart_gcm.F90 b/components/cism/glimmer-cism/libglad/glad_restart_gcm.F90 new file mode 100644 index 0000000000..d40597c0c0 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_restart_gcm.F90 @@ -0,0 +1,95 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_restart_gcm.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glad_restart_gcm + +!BOP +! !MODULE: glad_restart_gcm + +! !DESCRIPTION: +! Contains routines for specialized restarts called by GCMs +! +! !REVISION HISTORY: +! +! !USES: + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glad_read_restart_gcm + +!---------------------------------------------------------------------- +! +! module variables +! +!---------------------------------------------------------------------- + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glad_read_restart_gcm +! !INTERFACE: + + subroutine glad_read_restart_gcm(model, restart_filename) + + use glide_types + implicit none + type(glide_global_type), intent(inout) :: model + character(*), intent(in ) :: restart_filename + + ! local variables + type(glimmer_nc_input), pointer :: ic => null() + + ! create the input unit + allocate(ic) + ic%get_time_slice = 1 + ic%nc%filename = trim(restart_filename) + ic%nc%vars = ' restart ' + ic%nc%restartfile = .true. + ic%nc%vars_copy = ic%nc%vars + + ! add the input unit to the model + ! note that the model will do the actual reading of data + model%funits%in_first => ic + + end subroutine glad_read_restart_gcm + +!----------------------------------------------------------------------- + +end module glad_restart_gcm + +!----------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglad/glad_timestep.F90 b/components/cism/glimmer-cism/libglad/glad_timestep.F90 new file mode 100644 index 0000000000..abdaf23c79 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_timestep.F90 @@ -0,0 +1,348 @@ +#ifdef CPRIBM +@PROCESS ALIAS_SIZE(107374182) +#endif +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_timestep.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glad_timestep + !> timestep of a GLAD instance + + use glad_type + use glad_constants + use glimmer_global, only: dp + implicit none + + private + public glad_i_tstep_gcm + +contains + + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_i_tstep_gcm(time, instance, & + ice_tstep) + + ! Performs time-step of an ice model instance. + ! Input quantities here are accumulated/average totals since the last call. + ! Global output arrays are only valid on the main task. + ! + use glimmer_paramets + use glimmer_physcon, only: rhow, rhoi + use glimmer_log + use glimmer_coordinates, only: coordsystem_allocate + use glide + use glissade + use glide_io + use glad_mbal_coupling, only : glad_accumulate_input_gcm, glad_average_input_gcm + use glad_io + use glad_mbal_io + use glide_diagnostics + use parallel, only: tasks, main_task, this_rank + use glad_output_fluxes, only : accumulate_output_fluxes, reset_output_fluxes + + implicit none + + ! ------------------------------------------------------------------------ + ! Arguments + ! ------------------------------------------------------------------------ + + integer, intent(in) :: time ! Current time in hours + type(glad_instance), intent(inout) :: instance ! Model instance + logical, intent(out) :: ice_tstep ! Set if we have done an ice time step + + ! ------------------------------------------------------------------------ + ! Internal variables + ! ------------------------------------------------------------------------ + + real(dp),dimension(:,:),pointer :: thck_temp => null() ! temporary array for volume calcs + + integer :: i, il, jl + + if (GLC_DEBUG .and. main_task) then + print*, 'In glad_i_tstep_gcm' + endif + + ice_tstep = .false. + + call coordsystem_allocate(instance%lgrid, thck_temp) + + ! ------------------------------------------------------------------------ + ! Sort out some local orography and remove bathymetry. This relies on the + ! point 1,1 being underwater. However, it's a better method than just + ! setting all points < 0.0 to zero + ! ------------------------------------------------------------------------ + + !Note: Call to glad_remove_bath is commented out for now. Not sure if it is needed in GCM runs. +!! call glide_get_usurf(instance%model, instance%local_orog) +!! call glad_remove_bath(instance%local_orog,1,1) + + ! Get ice thickness ---------------------------------------- + + call glide_get_thk(instance%model,thck_temp) + + ! Accumulate Glide input fields, acab and artm + ! Note: At this point, instance%acab has units of m + ! Upon averaging (in glad_average_input_gcm), units are converted to m/yr + + call glad_accumulate_input_gcm(instance%mbal_accum, time, & + instance%acab, instance%artm) + + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) ' ' + write(stdout,*) 'In glad_i_tstep_gcm, time =', time + write(stdout,*) 'next_time =', instance%next_time + write(stdout,*) 'Check for ice dynamics timestep' + write(stdout,*) 'time =', time + write(stdout,*) 'start_time =', instance%mbal_accum%start_time + write(stdout,*) 'mbal_step =', instance%mbal_tstep + write(stdout,*) 'mbal_accum_time =', instance%mbal_accum_time + write(stdout,*) 'time-start_time+mbal_tstep =', time - instance%mbal_accum%start_time + instance%mbal_tstep + write(stdout,*) 'ice_tstep =', instance%ice_tstep + write(stdout,*) 'n_icetstep =', instance%n_icetstep + end if + + ! ------------------------------------------------------------------------ + ! ICE TIMESTEP begins HERE *********************************************** + ! ------------------------------------------------------------------------ + + if (time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time) then + + if (instance%mbal_accum_time < instance%ice_tstep) then + instance%next_time = instance%next_time + instance%ice_tstep - instance%mbal_tstep + end if + + ice_tstep = .true. + + call reset_output_fluxes(instance%glad_output_fluxes) + + ! --------------------------------------------------------------------- + ! Timestepping for ice sheet model + ! --------------------------------------------------------------------- + + do i = 1, instance%n_icetstep + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) 'Ice sheet timestep, iteration =', i + end if + + ! Get average values of acab and artm during mbal_accum_time + ! instance%acab has units of m/yr w.e. after averaging + + call glad_average_input_gcm(instance%mbal_accum, instance%mbal_accum_time, & + instance%acab, instance%artm) + + ! Calculate the initial ice volume (scaled and converted to water equivalent) + call glide_get_thk(instance%model,thck_temp) + thck_temp = thck_temp * rhoi/rhow + + !Note: Call to glad_remove_bath is commented out for now. Not sure if it is needed in GCM runs. + ! Get latest upper-surface elevation (needed for masking) +!! call glide_get_usurf(instance%model, instance%local_orog) +!! call glad_remove_bath(instance%local_orog,1,1) + + ! Mask out non-accumulation in ice-free areas + + where(thck_temp <= 0.d0 .and. instance%acab < 0.d0) + instance%acab = 0.d0 + end where + + ! Set acab to zero for ocean cells (bed below sea level, no ice present) + + where (GLIDE_IS_OCEAN(instance%model%geometry%thkmask)) + instance%acab = 0.d0 + endwhere + + ! Put climate inputs in the appropriate places, with conversion ---------- + + ! Note on units: + ! For subroutine glide_set_acab, input acab is in m/yr ice; this value is multiplied + ! by tim0/(scyr*thk0) and copied to data%climate%acab. + ! Input artm is in deg C; this value is copied to data%climate%artm (no unit conversion). + + !TODO - It is confusing to have units of m/yr w.e. for instance%acab, compared to units m/yr ice for Glide. + ! Change to use the same units consistently? E.g., switch to w.e. in Glide + + call glide_set_acab(instance%model, instance%acab * rhow/rhoi) + call glide_set_artm(instance%model, instance%artm) + + ! This will work only for single-processor runs + if (GLC_DEBUG .and. tasks==1) then + il = instance%model%numerics%idiag + jl = instance%model%numerics%jdiag + write (stdout,*) ' ' + write (stdout,*) 'After glide_set_acab, glide_set_artm: i, j =', il, jl + write (stdout,*) 'acab (m/y), artm (C) =', instance%acab(il,jl)*rhow/rhoi, instance%artm(il,jl) + end if + + ! Adjust glad acab for output + + where (instance%acab < -thck_temp .and. thck_temp > 0.d0) + instance%acab = -thck_temp + end where + + instance%glide_time = instance%glide_time + instance%model%numerics%tinc + + ! call the dynamic ice sheet model (provided the ice is allowed to evolve) + + if (instance%evolve_ice == EVOLVE_ICE_TRUE) then + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then + + call glide_tstep_p1(instance%model, instance%glide_time) + + call glide_tstep_p2(instance%model) + + call glide_tstep_p3(instance%model) + + else ! glam/glissade dycore + +!WHL - debug + print*, 'call glissade_tstep' + + call glissade_tstep(instance%model, instance%glide_time) + + endif + + endif ! evolve_ice + +!WHL - debug + print*, 'write diagnostics' + + ! write ice sheet diagnostics at specified interval (model%numerics%dt_diag) + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! write netCDF output + + call glide_io_writeall(instance%model,instance%model) + call glad_io_writeall(instance,instance%model) + + ! Accumulate Glide output fields to be sent to GCM + + call accumulate_output_fluxes(instance%glad_output_fluxes, instance%model) + + end do ! instance%n_icetstep + + end if ! time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time + +!WHL - debug + print*, 'output instantaneous values' + + ! Output instantaneous values + + call glad_mbal_io_writeall(instance, instance%model, & + outfiles = instance%out_first, & + time = time*hours2years) + + ! Deallocate + + if (associated(thck_temp)) then + deallocate(thck_temp) + thck_temp => null() + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Done in glad_i_tstep_gcm' + endif + + end subroutine glad_i_tstep_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Rewrite glad_remove_bath to support multiple tasks? + ! Calls to this subroutine are currently commented out. + + subroutine glad_remove_bath(orog,x,y) + + ! Sets ocean areas to zero height, working recursively from + ! a known ocean point. + + use glimmer_log + use parallel, only : tasks + + real(dp),dimension(:,:),intent(inout) :: orog !> Orography --- used for input and output + integer, intent(in) :: x,y !> Location of starting point (index) + + integer :: nx,ny + + ! Currently, this routine is called assuming point 1,1 is ocean... this won't be true + ! when running on multiple processors, with a distributed grid + ! This can't be made a fatal error, because this is currently called even if we have + ! more than one task... the hope is just that the returned data aren't needed in CESM. + if (tasks > 1) then + call write_log('Use of glad_remove_bath currently assumes the use of only one task', & + GM_WARNING, __FILE__, __LINE__) + end if + + nx=size(orog,1) ; ny=size(orog,2) + + if (orog(x,y) < 0.d0) orog(x,y) = 0.d0 + call glad_find_bath(orog,x,y,nx,ny) + + end subroutine glad_remove_bath + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + recursive subroutine glad_find_bath(orog,x,y,nx,ny) + + !> Recursive subroutine called by {\tt glimmer\_remove\_bath}. + + real(dp),dimension(:,:),intent(inout) :: orog !> Orography --- used for input and output + integer, intent(in) :: x,y !> Starting point + integer, intent(in) :: nx,ny !> Size of array {\tt orography} + + integer,dimension(4) :: xi = (/ -1,1,0,0 /) + integer,dimension(4) :: yi = (/ 0,0,-1,1 /) + integer :: ns = 4 + integer :: i + + do i=1,ns + if (x+xi(i) <= nx .and. x+xi(i) > 0 .and. & + y+yi(i) <= ny .and. y+yi(i) > 0) then + if (orog(x+xi(i),y+yi(i)) < 0.d0) then + orog(x+xi(i),y+yi(i)) = 0.d0 + call glad_find_bath(orog,x+xi(i),y+yi(i),nx,ny) + endif + endif + enddo + + end subroutine glad_find_bath + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glad_timestep + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglad/glad_type.F90 b/components/cism/glimmer-cism/libglad/glad_type.F90 new file mode 100644 index 0000000000..9e3941d07f --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_type.F90 @@ -0,0 +1,316 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glad_type.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc +#define NCI infile%nc + +module glad_type + + !> contains type definitions for GLAD + + use glimmer_global, only: dp + use glide_types + use glad_input_averages, only : glad_input_averages_type, initialize_glad_input_averages + use glad_mbal_coupling, only : glad_mbc + use glad_output_fluxes, only : glad_output_fluxes_type, initialize_glad_output_fluxes + + implicit none + + ! Constants that describe the options available + + ! basic Glad options + + integer, parameter :: EVOLVE_ICE_FALSE = 0 ! do not let the ice sheet evolve + ! (hold the ice state fixed at initial condition) + integer, parameter :: EVOLVE_ICE_TRUE = 1 ! let the ice sheet evolve + + integer, parameter :: ZERO_GCM_FLUXES_FALSE = 0 ! send true fluxes to the GCM + integer, parameter :: ZERO_GCM_FLUXES_TRUE = 1 ! zero out all fluxes sent to the GCM + + !TODO - Add other Glad options here to avoid hardwiring of case numbers? + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glad_instance + + !> Derived type holding information about ice model instance. + !> Note that variables used for downscaling & upscaling are only valid on the main task, + !> since all downscaling and upscaling is done there. + + type(coordsystem_type) :: lgrid !> Local grid for interfacing with glide (grid on this task) + !> (WJS: Note that origin may be incorrect with multiple tasks; + !> as far as I can tell, this isn't currently a problem) + type(glad_input_averages_type) :: glad_inputs !> Time-averaged inputs from the climate model + type(glide_global_type) :: model !> The instance and all its arrays. + character(fname_length) :: paramfile !> The name of the configuration file. + integer :: ice_tstep !> Ice timestep in hours + integer :: mbal_tstep !> Mass-balance timestep in hours + integer :: mbal_accum_time !> Accumulation time for mass-balance (hours) + !> (defaults to ice time-step) + integer :: ice_tstep_multiply=1 !> Ice time multiplier (non-dimensional) + integer :: n_icetstep !> Number of ice time-steps per mass-balance accumulation + real(dp) :: glide_time !> Time as seen by glide (years) + integer :: next_time !> The next time we expect to be called (hours) + + ! Climate inputs, on the local grid ------------------------- + + real(dp),dimension(:,:),pointer :: artm => null() !> Annual mean air temperature + real(dp),dimension(:,:),pointer :: acab => null() !> Annual mass balance (m/y water equiv) + + ! Arrays to accumulate mass-balance quantities -------------- + + type(glad_mbc) :: mbal_accum + + ! Climate options ------------------------------------------- + + integer :: evolve_ice = 1 + + !> Whether the ice sheet can evolve: + !> \begin{description} + !> \item[0] The ice sheet cannot evolve; hold fixed at initial state + !> \item[1] The ice sheet can evolve + + logical :: test_coupling = .false. + + integer :: zero_gcm_fluxes = ZERO_GCM_FLUXES_FALSE + + !> Whether to zero out the fluxes (e.g., calving flux) sent to the GCM + !> \begin{description} + !> \item[0] send true fluxes to the GCM + !> \item[1] zero out all fluxes sent to the GCM + !> \end{description} + + ! Latitude & longitude of model grid points + real(dp), dimension(:,:), pointer :: lat(:,:) => null() + real(dp), dimension(:,:), pointer :: lon(:,:) => null() + + ! Fields for averaging dycore output + type(glad_output_fluxes_type) :: glad_output_fluxes + real(dp), dimension(:,:), pointer :: hflx_tavg => null() ! conductive heat flux at top surface (W m-2) + real(dp), dimension(:,:), pointer :: rofi_tavg => null() ! solid ice runoff (kg m-2 s-1) + real(dp), dimension(:,:), pointer :: rofl_tavg => null() ! liquid runoff from basal/interior melting (kg m-2 s-1) + + ! Pointers to file input and output + + type(glimmer_nc_output),pointer :: out_first => null() !> first element of linked list defining netCDF outputs + type(glimmer_nc_input), pointer :: in_first => null() !> first element of linked list defining netCDF inputs + + end type glad_instance + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +contains + + subroutine glad_i_allocate_gcm(instance, force_start) + + ! Allocate top-level arrays in the model instance, and ice model arrays. + + implicit none + + type(glad_instance),intent(inout) :: instance !> Instance whose elements are to be allocated. + integer, intent(in) :: force_start !> glad forcing start time (hours) + + integer :: ewn,nsn ! dimensions of local grid + + ewn = get_ewn(instance%model) + nsn = get_nsn(instance%model) + + ! First deallocate if necessary + + if (associated(instance%artm)) deallocate(instance%artm) + if (associated(instance%acab)) deallocate(instance%acab) + + if (associated(instance%lat)) deallocate(instance%lat) + if (associated(instance%lon)) deallocate(instance%lon) + + if (associated(instance%rofi_tavg)) deallocate(instance%rofi_tavg) + if (associated(instance%rofl_tavg)) deallocate(instance%rofl_tavg) + if (associated(instance%hflx_tavg)) deallocate(instance%hflx_tavg) + + + ! Then reallocate and zero... + + allocate(instance%artm(ewn,nsn)); instance%artm = 0.d0 + allocate(instance%acab(ewn,nsn)); instance%acab = 0.d0 + + allocate(instance%lat(ewn,nsn)); instance%lat = 0.d0 + allocate(instance%lon(ewn,nsn)); instance%lon = 0.d0 + + allocate(instance%rofi_tavg(ewn,nsn)); instance%rofi_tavg = 0.d0 + allocate(instance%rofl_tavg(ewn,nsn)); instance%rofl_tavg = 0.d0 + allocate(instance%hflx_tavg(ewn,nsn)); instance%hflx_tavg = 0.d0 + + call initialize_glad_input_averages(instance%glad_inputs, ewn=ewn, nsn=nsn, & + next_av_start=force_start) + + call initialize_glad_output_fluxes(instance%glad_output_fluxes, ewn=ewn, nsn=nsn) + + end subroutine glad_i_allocate_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Move the next two subroutines to a new module called glad_setup? + ! This would be analogous to the organization of Glide. + + subroutine glad_i_readconfig(instance,config) + + !> read glad configuration + + use glimmer_config + use glimmer_log + use glad_constants, only: years2hours + + implicit none + + ! Arguments + + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + type(glad_instance),intent(inout) :: instance !> The instance being initialised. + + ! Internals + + type(ConfigSection), pointer :: section + real(dp) :: mbal_time_temp ! Accumulation time in years + + mbal_time_temp = -1.d0 + + call GetSection(config,section,'GLAD climate') + if (associated(section)) then + call GetValue(section,'evolve_ice',instance%evolve_ice) + call GetValue(section,'test_coupling',instance%test_coupling) + call GetValue(section,'mbal_accum_time',mbal_time_temp) + call GetValue(section,'ice_tstep_multiply',instance%ice_tstep_multiply) + call GetValue(section,'zero_gcm_fluxes',instance%zero_gcm_fluxes) + end if + + if (mbal_time_temp > 0.0) then + instance%mbal_accum_time = mbal_time_temp * years2hours + else + instance%mbal_accum_time = -1 + end if + + call glad_nc_readparams(instance,config) + + end subroutine glad_i_readconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_nc_readparams(instance,config) + + !> read netCDF I/O related configuration file + !> based on glimmer_ncparams + + use glimmer_config + use glimmer_ncparams, only: handle_output, handle_input, configstring + implicit none + + type(glad_instance) :: instance !> GLAD instance + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + type(glimmer_nc_output), pointer :: output + type(glimmer_nc_input), pointer :: input + + ! Initialise local pointers + output => null() + input => null() + + ! setup outputs + call GetSection(config,section,'GLAD output') + do while(associated(section)) + output => handle_output(section,output,0.d0,configstring) + if (.not.associated(instance%out_first)) then + instance%out_first => output + end if + call GetSection(section%next,section,'GLAD output') + end do + + ! setup inputs + call GetSection(config,section,'GLAD input') + do while(associated(section)) + input => handle_input(section,input) + if (.not.associated(instance%in_first)) then + instance%in_first => input + end if + call GetSection(section%next,section,'GLAD input') + end do + + output => null() + input => null() + + end subroutine glad_nc_readparams + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glad_i_printconfig(instance) + + use glimmer_log + use glad_constants, only: hours2years + use parallel, only: tasks + + implicit none + + ! Argument + + type(glad_instance),intent(inout) :: instance !> The instance to be printed + + ! Internal + + character(len=100) :: message + + call write_log(' ') + call write_log('GLAD climate') + call write_log('-------------') + write(message,*) 'evolve_ice (0=fixed, 1=evolve): ',instance%evolve_ice + call write_log(message) + write(message,*) 'test_coupling: ',instance%test_coupling + call write_log(message) + + if (instance%evolve_ice == EVOLVE_ICE_FALSE) then + call write_log('The ice sheet state will not evolve after initialization') + endif + + if (instance%mbal_accum_time == -1) then + call write_log('Mass-balance accumulation time will be set to max(ice timestep, mbal timestep)') + else + write(message,*) 'Mass-balance accumulation time:',instance%mbal_accum_time * hours2years,' years' + call write_log(message) + end if + + write(message,*) 'ice_tstep_multiply:',instance%ice_tstep_multiply + call write_log(message) + + write(message,*) 'zero_gcm_fluxes: ', instance%zero_gcm_fluxes + call write_log(message) + + end subroutine glad_i_printconfig + +end module glad_type diff --git a/components/cism/glimmer-cism/libglad/glad_vars.def b/components/cism/glimmer-cism/libglad/glad_vars.def new file mode 100644 index 0000000000..fe0f1c6ea5 --- /dev/null +++ b/components/cism/glimmer-cism/libglad/glad_vars.def @@ -0,0 +1,56 @@ +#[] +#dimensions: time, y1, x1 +#units: +#long_name: +#data: +#factor: + +# setup for code generator +[VARSET] +# prefix of the generated module +name: glad +# f90 type containing all necessary data +datatype: glad_instance +# module where type is defined +datamod: glad_type + +[lat] +dimensions: time, y1, x1 +units: degreeN +long_name: latitude +standard_name: latitude +data: data%lat +load: 1 +standard_name: latitude + +[lon] +dimensions: time, y1, x1 +units: degreeE +long_name: longitude +data: data%lon +load: 1 +standard_name: longitude + +[rofi_tavg] +dimensions: time, y1, x1 +units: kg m-2 s-1 +long_name: solid calving flux +data: data%rofi_tavg +load: 1 +coordinates: lon lat + +[rofl_tavg] +dimensions: time, y1, x1 +units: kg m-2 s-1 +long_name: liquid runoff flux +data: data%rofl_tavg +load: 1 +coordinates: lon lat + +[hflx_tavg] +dimensions: time, y1, x1 +units: W m-2 +long_name: heat flux to ice surface +data: data%hflx_tavg +load: 1 +coordinates: lon lat diff --git a/components/cism/glimmer-cism/libglide/felix_dycore_interface.F90 b/components/cism/glimmer-cism/libglide/felix_dycore_interface.F90 new file mode 100644 index 0000000000..be33358fe7 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/felix_dycore_interface.F90 @@ -0,0 +1,757 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! felix_dycore_interface.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + +module felix_dycore_interface + + use glimmer_physcon, only : scyr + use glimmer_paramets, only : vel0, tau0, vis0 + use glide_types + use glimmer_log + use parallel + use glissade_grid_operators, only: glissade_stagger + !use glimmer_to_dycore + + implicit none + private + + + !-------------------------------------------------------------------- + ! + ! Public parameters + ! + !-------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! + ! Public member functions + ! + !-------------------------------------------------------------------- + + public :: felix_velo_init, & + felix_velo_driver + + !-------------------------------------------------------------------- + ! + ! Private module variables + ! + !-------------------------------------------------------------------- + + +!*********************************************************************** + + +contains + + +!*********************************************************************** +! +! routine felix_velo_init +! +!> \brief Initializes the external Albany-FELIX velocity solver +!> \author Irina Kalashnikova +!> \date 13 September 2013 +!> \version SVN:$Id$ +!> \details +!> This routine initializes the external Albany-FELIX ice velocity solver. +! +!----------------------------------------------------------------------- + + subroutine felix_velo_init(model) + + !----------------------------------------------------------------- + ! + ! input variables + ! + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! + ! input/output variables + ! + !----------------------------------------------------------------- + + type(glide_global_type),intent(inout) :: model + + !----------------------------------------------------------------- + ! + ! output variables + ! + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------- + + + if (this_rank == 0) print *, 'DEBUG: Inside felix_velo_init.' + + ! === First do any preparations needed on the CISM side (if any) + + + ! === Now call the external Albany code for any init that it needs to do + !call gtd_init_dycore(model,dycore_model_index) + ! Doug - does this interface still make sense here? + ! Doug - what needs to change (if anything) if the code is compiled without + ! external Felix libraries? Do we need a stub module? + ! Doug - We might need to do some rearranging to make sure the call + ! to gtd_init_dycore_interface happens in the right place + ! (presumably in simple_glide/simple_felix/cism_driver). + ! (I think I see how to do this, but will wait for now.) + + !-------------------------------------------------------------------- + end subroutine felix_velo_init + + + + +!*********************************************************************** +! +! routine felix_velo_driver +! +!> \brief Makes preparations and calls the external Albany-FELIX velocity solver +!> \author Irina Kalashnikova +!> \date 13 September 2013 +!> \version SVN:$Id$ +!> \details +!> This routine makes preparations and calls the external +!> Albany-FELIX velocity solver. +! +!----------------------------------------------------------------------- + + subroutine felix_velo_driver(model) + + use glimmer_global, only : dp + use glimmer_physcon, only: gn, scyr + use glimmer_paramets, only: thk0, len0, vel0, vis0 + use glimmer_log + use glide_types + use glide_mask + + !----------------------------------------------------------------- + ! + ! input variables + ! + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! + ! input/output variables + ! + !----------------------------------------------------------------- + + type(glide_global_type),intent(inout) :: model + + !----------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------- + + + call get_parallel_finite_element_mesh_data(model%general%ewn, model%general%nsn ,& + model%general%upn, & + model%numerics%sigma, & + nhalo, & + len0 * model%numerics%dew, & + len0 * model%numerics%dns, & + thk0 * model%geometry%thck, & + thk0 * model%geometry%usrf, & + thk0 * model%geometry%topg,& + thk0 * model%numerics%thklim, & + (tau0 / vel0 / scyr) *model%velocity%beta, & + (vis0*scyr) *model%temper%flwa) + + + !IK, 10/24/13, notes to self: + !To use constant flwa = 1e-16, set flow_law = 0 in input (config) file + !To use beta field from .nc file, set which_ho_babc = 5 in input (config) + !file; to use no-slip, set which_ho_babc = 4 + + + !----------------------------------------------------------------- + ! + ! output variables + ! + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------- + + + if (this_rank == 0) print *, 'DEBUG: Inside felix_velo_driver.' + + ! === First do any preparations needed on the CISM side + + + ! === Now call the external Albany code + !call gtd_run_dycore(dycore_model_index,cur_time,time_inc) + ! Doug - does this interface still make sense here? + ! Doug - what needs to change (if anything) if the code is compiled without + ! external Felix libraries? Do we need a stub module? + + + !-------------------------------------------------------------------- + end subroutine felix_velo_driver + + + +!*********************************************************************** +! Private subroutines: +!*********************************************************************** + + + +!*********************************************************************** +! +! routine get_parallel_finite_element_mesh_data +! +!> \author Irina Kalashnikova +!> \date 18 September 2013 +!> \version SVN:$Id$ +!> \details +! +! Naming convention: +! - cells, vertices are in 2D +! - elements, nodes are in 3D +! +! The function get_parallel_finite_element_mesh_data creates a parallel mesh of +! a given geometry using the data. In particular, global node and element IDs +! are created, and an offset it added to the x and y coordinates on +! multi-processor runs. The following are data that would be needed in +! Albany/FELIX (so these would need to be passed through an interface b/w the 2 +! codes): +! +! xyz_at_nodes: +! Double array of size (nx-1)*(ny-1)*nz x 3. It gives the x, y +! and z coordinates of all the nodes on each processor. +! Note: Right now this array consists of the full mesh, in +! particular, non-active nodes have not been removed. This is OK for +! Albany/FELIX -- the non-active nodes will not be assembled as they will not +! appear in global_element_conn_active, the element connectivity array. We could +! remove the non-active nodes at some point to avoid passing stuff b/w the +! codes that isn't needed. +! Note 2: the nodes need to be converted to km prior to being +! passed to Albany/FELIX b/c Albany/FELIX works with meshes in km. +! +! global_node_id_owned_map: +! Integer array of size (nx-1)*(ny-1)*nz x 1. This is +! effectively a map from local node IDs to global node +! IDs. It is 1-based, consistent w/ Fortran numbering (so the first node +! is node number 1). +! +! global_element_conn_active: +! Dynamically allocated integer array of size nCellsActive*(nz-1) x 8 where nCellsActive is +! the number of active elements (with ice) in 2D. This array is the element +! connectivity array. The 8 columns of this array give the element +! connectivity (node #s defining a given element), 1-based. +! Note: The global element numbering in global_element_conn_active will be +! non-contiguous and there will be some element #s +! missing (e.g., if elements 1 and 2 are not active, they will not appear in +! global_element_conn_active). This is OK for Albany/FELIX. Also some of the nodes +! (the non-active ones) will not appear in the connectivity array. This +! is OK too. +! +! global_element_id_active_owned_map: +! Dynamically allocated integer array of size +! nCellsActive*(nz-1) x 1 where nCellsActive is the number of active +! elements (with ice) in 2D. This is a map from local element IDs to global element IDs. +! It is 1-based. Only active elements are included. +! +! global_basal_face_conn_active: +! Dynamically allocated integer array of size nCellsActive x 5 where nCellsActive is the number of +! active elements (with ice) in 2D. This array is the basal face connectivity +! array. The first column gives the global number of the element to +! which the face belongs. The next 4 columns give the face connectivity (node #s +! defining the face of the element), again 1-based. +! Note: Same comment as for global_element_conn_active. +! +! global_basal_face_id_active_owned_map: +! Dynamically allocated integer array of size +! nCellsActive x 1 where nCellsActive is the number of +! active elements (with ice) in 2D. This is a map from local +! face IDs to global face IDs. It is 1-based. Only active +! faces are included. +! +! surf_height_at_nodes: +! Double array of size (nx-1)*(ny-1)*nz. This is effectively +! stagusrf extended to 3D (we need it as a 3D data structure in Albany/FELIX). +! Note: Like the xyz_at_nodes array this would be defined at all the +! nodes in the original mesh, so it would include non-active +! nodes. We can change this at some point if we don't want to pass extra stuff b/w +! codes. Note also that this needs to be converted to km as Albany/FELIX uses meshes in km not +! meters. +! +! +!----------------------------------------------------------------------- + + subroutine get_parallel_finite_element_mesh_data(nx, ny, & + nz, sigma, & + nhalo, & + dx, dy, & + thck, usrf, & + topg, & + thklim, beta, & + flwa) + + !----------------------------------------------------------------- + ! + ! input variables + ! + !----------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz, & ! number of vertical levels where velocity is computed + ! (same as model%general%upn) + nhalo ! number of rows/columns of halo cells + + real(dp), dimension(:), intent(in) :: & + sigma + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width (m) + ! assumed to have the same value for each grid + ! cell + + real(dp), dimension(:,:), intent(in) :: & + thck, & ! ice thickness (m) + usrf, & ! upper surface elevation (m) + topg ! elevation of topography (m) + + + real(dp), intent(in) :: & + thklim ! minimum ice thickness for active cells (m) + + real(dp), dimension(:,:), intent(in) :: & + beta ! basal traction parameter + + real(dp), dimension(:,:,:), intent(in) :: & + flwa ! flow factor parameter + + + !----------------------------------------------------------------- + ! + ! input/output variables + ! + !----------------------------------------------------------------- + + !----------------------------------------------------------------- + ! + ! output variables + ! + !----------------------------------------------------------------- + + !IK, 9/8/13: xyz_at_nodes will need to be passed to Albany/FELIX + !These are divided by 1000 to convert from meters to km, as Albany/FELIX + !takes meshes in km. + !TO DO: make xyz_at_nodes have intent(out) + real(dp), dimension((nx-2*nhalo+1)*(ny-2*nhalo+1)*nz,3) :: & + xyz_at_nodes ! x, y and z coordinates of each vertex + + !IK, 9/8/13: GlobalNodeID_3D will need to be passed to Albany/FELIX + !TO DO: make GlobalNodeID_3D have intent(out) + integer, dimension((nx-2*nhalo+1)*(ny-2*nhalo+1)*nz) :: & + global_node_id_owned_map !This is effectively a map from local -> global IDs + !for the full 3D mesh + + !IK, 9/8/13: surf_height_at_nodes will need to be passed to Albany/FELIX + !These values are divided by 1000 to convert from meters to km, as + !Albany/FELIX + !takes meshes in km. + !TO DO: make surf_height_at_nodes have intent(out) + real(dp), dimension((nx-2*nhalo+1)*(ny-2*nhalo+1)*nz) :: & + surf_height_at_nodes !This is an extension of + !stagusrf to 3D + + !IK, 9/8/13: global_element_conn_active will need to be passed to + !Albany/FELIX + !TO DO: make global_element_conn_active have intent(out) + integer, dimension(:, :), allocatable :: & + global_element_conn_active !Like global_element_conn but first column is + !removed and only active elements (cells) + !are included + + + !IK, 9/12/13: global_element_id_active_owned_map will need to be passed + !to Albany/FELIX + !TO DO: make global_element_id_active_owned_map have intent(out) + integer, dimension(:, :), allocatable :: & + global_element_id_active_owned_map !First column of global_element_conn but and only + !active elements (cells) are + !included. + !This is effectively a map from + !local -> global IDs for the + !elements + + !TO DO: make global_basal_face_conn_active have intent(out) + integer, dimension(:, :), allocatable :: & + global_basal_face_conn_active !Like global_basal_face_conn but only active + !elements (cells) are included + + !IK, 9/12/13: global_basal_face_id_active_owned_map will need to be passed to + !Albany/FELIX + !TO DO: make global_basal_face_id_active_owned_map have intent(out) + integer, dimension(:, :), allocatable :: & + global_basal_face_id_active_owned_map !First column of global_basal_face_conn but and only + !active elements (cells) are included. + !This is effectively a map from + !local -> global IDs for the + !elements + + !IK, 10/24/13: beta_at_nodes will need to be passed to Albany/FELIX + !These values are divided by 1000 to convert from meters to kPa a m^(-1), + !as + !Albany/FELIX takes meshes in km (so beta needs to be converted to the + !appropriate units). + !TO DO: make beta_at_nodes have intent(out) + real(dp), dimension((nx-2*nhalo+1)*(ny-2*nhalo+1)*nz) :: & + beta_at_nodes !This is an extension of + !beta to 3D + + !IK, 10/24/13: flwa_at_active_cells will need to be passed to Albany/FELIX + !This is the value of the flow factor at the elements + !These values are multilied by 1.0e12 to convert to Albany/FELIX units + !TO DO: make flwa_at_active_cells have intent(out) + real(dp), dimension(:, :), allocatable :: & + flwa_at_active_cells !This is essentially flwa in + !vector form and at only the active + !cells + + + !----------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------- + + integer, dimension(nx,ny) :: & + imask ! = 1 where ice is present, else = 0 + + logical, dimension(nx,ny) :: & + active_cell ! true for active cells (thck > thklim and border locally owned vertices) + + + real(dp), dimension(nx-1,ny-1) :: & + stagusrf, & ! upper surface averaged to vertices + stagthck ! ice thickness averaged to vertices + + real(dp), dimension((nx-2*nhalo+1)*(ny-2*nhalo+1),2) :: & + xy_at_vertices ! x and y coordinates of each vertex + + integer, dimension((nx-2*nhalo+1)*(ny-2*nhalo+1)) :: & + global_vertex_id_owned_map !global IDs of 2D mesh + + integer, dimension((nx-2*nhalo)*(ny-2*nhalo)) :: & + global_cell_id_owned_map !global IDs of cells in 2D mesh + + logical, dimension((nx-2*nhalo)*(ny-2*nhalo)) :: & + active_cell_vector !This is like active_cell except in vector + !form + + logical, dimension((nx-2*nhalo)*(ny-2*nhalo)*(nz-1)) :: & + active_cell_vector3D !This is an extension of + !active_cell_vertex to 3D + + integer, dimension((nx-2*nhalo)*(ny-2*nhalo)*(nz-1), 9) :: & + global_element_conn !First column is effectively a map from local -> global IDs + !Remaining 8 columns give element connectivity (with + !global node #s) + + integer, dimension((nx-2*nhalo)*(ny-2*nhalo), 6) :: & + global_basal_face_conn !First column is effectively a map from local ->global IDs for basal faces + !Second column gives global # of element to which this + !boundary face belongs + !Next 4 columns give the connectivity for the boundary + !face + + real(dp), dimension((nx-2*nhalo)*(ny-2*nhalo)*(nz-1)) :: & + flwa_at_cells !This is a vector form of flwa, defined at + !all the elements + + + integer :: i, j, k, l + real(dp) :: x, y !x and y coordinates of vertices + integer :: gnx, gny !for temporary calculation of global vertex/cell # in x global vertex/cell # in y + integer :: nNodes2D, nNodesProc2D !total # virtices, # vertices on this proc (in 2D) + integer :: nEles2D, nElesProc2D, nElesProc3D !total # cells (in 2D), # cells on this proc (in 2D), # elements on this proc (in 3D) + integer :: nodes_x !total # nodes in x + integer :: x_GID, y_GID, z_GID, x_GIDplus1, y_GIDplus1, z_GIDplus1, elem_GID, xy_plane !for creating element numbering + integer :: nCellsActive !# active cells (with ice) in 2D + + + !-------------------------------------------------------------------- + ! TO DO (IK, 9/18/13): + ! - Make stuff that needs to be passed to Albany/FELIX an out argument of + ! this function + !-------------------------------------------------------------------- + + !IK, 9/9/13: printing for debug + !print *, 'In glissade_velo_higher_data! IK' + !print *, 'Proc #: ', this_rank + !print *, 'nx: ', nx + !print *, 'ny: ', ny + !print *, 'dx: ', dx + !print *, 'dy: ', dy + !print *, 'ewlb: ', ewlb + !print *, 'nslb: ', nslb + !print *, 'global_ewn: ', global_ewn + !print *, 'global_nsn:', global_nsn + !print *, 'nhalo:', nhalo + !print *, 'nz:', nz + + !--------------------------------------------------------------------------------------- + ! Creation of global node numbering of vertices/nodes (IK, 9/8/13) + !--------------------------------------------------------------------------------------- + + !IK, 9/8/13: first, create global vertices for 2D mesh to be extruded as 3D + !mesh + k = 1 + do j = nhalo, ny-nhalo + do i = nhalo, nx-nhalo + x = (ewlb+1)*dx + i*dx !xVertex(i,j) + y = (nslb+1)*dy + j*dy !yVertex(i,j) + gnx = ewlb + 1 + i - nhalo + 1 + gny = nslb + 1 + j - nhalo + 1 + global_vertex_id_owned_map(k) = gnx + (global_ewn+1)*(gny - 1) + xy_at_vertices(k,1) = x/1000.0 !divide by 1000 to convert to km for + !Albany/FELIX + xy_at_vertices(k,2) = y/1000.0 !divide by 1000 to convert to km for + !Albany/FELIX + k = k + 1 + enddo + enddo + + !IK, 9/8/13: now, create global nodes for 3D mesh obtained by extruding 3D + !mesh in z-direction + !------------------------------------------------------------------------------ + ! Compute masks: + ! mask = 1 where dynamically active ice is present, 0 elsewhere + !------------------------------------------------------------------------------ + + do j = 1, ny + do i = 1, nx + if (thck(i,j) > thklim) then + imask(i,j) = 1 + else + imask(i,j) = 0 + endif + enddo + enddo + + !------------------------------------------------------------------------------ + ! Compute ice thickness and upper surface on staggered grid + ! (requires that thck and usrf are up to date in halo cells) + !------------------------------------------------------------------------------ + + call glissade_stagger(nx, ny, & + thck, stagthck, & + imask, stagger_margin_in = 1) + + call glissade_stagger(nx, ny, & + usrf, stagusrf, & + imask, stagger_margin_in = 1) + + !------------------------------------------------------------------------------ + + nNodes2D = (global_ewn + 1)*(global_nsn + 1) + nNodesProc2D = (nx - 2*nhalo+1)*(ny- 2*nhalo+1) + do l = 1, nz !loop over vertical layers + global_node_id_owned_map((l-1)*nNodesProc2D + 1:nNodesProc2D*l) = global_vertex_id_owned_map + nNodes2D*(l - 1) + xyz_at_nodes((l-1)*nNodesProc2D + 1:nNodesProc2D*l, 1:2) = xy_at_vertices + enddo + !IK, 9/8/13: set z-coordinate of mesh + k = 1 + do l = 1, nz + do j = nhalo, ny-nhalo + do i = nhalo, nx-nhalo + ! do j = 1+nhalo, ny-nhalo+1 + ! do i = 1+nhalo, nx-nhalo+1 + !divide by 1000 to convert to km for Albany/FELIX + xyz_at_nodes(k,3) = (stagusrf(i,j) - sigma(l)*stagthck(i,j))/1000.0 + surf_height_at_nodes(k) = stagusrf(i,j)/1000.0 + beta_at_nodes(k) = beta(i,j)/1000.0; + k = k + 1 + enddo + enddo + enddo + + !IK, 9/12/13: printing output for debugging/checking node + !numbering/coordinates + if (this_rank == 0) then + do l=1, (nx-2*nhalo+1)*(ny-2*nhalo+1)*nz + print *, 'x, y, z: ', xyz_at_nodes(l,1), xyz_at_nodes(l,2), xyz_at_nodes(l,3) + print *, 'global node: ', global_node_id_owned_map(l) + print *, 'sh: ', surf_height_at_nodes(l) + print *, 'beta: ', beta_at_nodes(l) + enddo + endif + + ! Identify the active cells. + ! Include all cells that border locally owned vertices and contain ice. + + nCellsActive = 0 !start counter keeping track of how many active cells + !there are on each processor + + active_cell(:,:) = .false. + + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + if (thck(i,j) > thklim) then + active_cell(i,j) = .true. + nCellsActive = nCellsActive + 1 + endif + enddo + enddo + + !IK, 10/24/13: populate flwa_at_cells array from flwa array, and change + !units to Albany/FELIX units + k = 1 + do l = 1, nz-1 + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + flwa_at_cells(k) = flwa(l,i,j)*(1.0E12) !scale flwa by 1e12 to get units + !consistent with those in + !Albany/FELIX + k = k + 1; + enddo + enddo + enddo + + + + !-------------------------------------------------------------------------- + ! Creation of hexahedral mesh and global numbering of elements (IK, 9/8/13) + !-------------------------------------------------------------------------- + + nEles2D = global_ewn*global_nsn + nElesProc2D = (nx - 2*nhalo)*(ny - 2*nhalo) + k = 1 !local cell number + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + gnx = ewlb + 1 + i - nhalo + gny = nslb + 1 + j - nhalo + global_cell_id_owned_map(k) = gnx + global_ewn*(gny - 1) + active_cell_vector(k) = active_cell(i,j) + k = k + 1 + enddo + enddo + do l = 1, nz - 1 !loop over vertical layers + global_element_conn((l-1)*nElesProc2D + 1:nElesProc2D*l, 1) = global_cell_id_owned_map+ nEles2D*(l-1) + active_cell_vector3D((l-1)*nElesProc2D + 1:nElesProc2D*l) = active_cell_vector + enddo + + nodes_x = global_ewn + 1 !# nodes in x + nElesProc3D = (nx - 2*nhalo)*(ny - 2*nhalo)*(nz - 1) !number of elements on proc + k = 1 ! counter for incrementing boundary faces + do i = 1, nElesProc3D + elem_GID = global_element_conn(i, 1) - 1 + z_GID = elem_GID/nEles2D !mesh column number + xy_plane = mod(elem_GID, nEles2D) + x_GID = mod(xy_plane, global_ewn) !mesh column number + y_GID = xy_plane/(global_ewn) !mesh row number + x_GIDplus1 = x_GID + 1 + y_GIDplus1 = y_GID + 1 + z_GIDplus1 = z_GID + 1 + ! find and mark boundary faces on basal boundary + if (z_GIDplus1 == nz - 1) then + global_basal_face_conn(:, 1) = global_cell_id_owned_map + global_basal_face_conn(k, 2) = global_element_conn(i,1) + !IK, 9/8/13: below the +1 is added to make the connectivity 1-based + !like in Fortran -- the node numbering has been created with this + !convention + global_basal_face_conn(k, 3) = x_GID + nodes_x*y_GID + nNodes2D*z_GIDplus1 + 1 + global_basal_face_conn(k, 4) = x_GIDplus1 + nodes_x*y_GID + nNodes2D*z_GIDplus1 + 1 + global_basal_face_conn(k, 5) = x_GIDplus1 + nodes_x*y_GIDplus1 + nNodes2D*z_GIDplus1 + 1 + global_basal_face_conn(k, 6) = x_GID + nodes_x*y_GIDplus1 + nNodes2D*z_GIDplus1 + 1 + k = k + 1 + endif + !IK, 9/8/13: below the +1 is added to make the connectivity 1-based + !like in Fortran -- the node numbering has been created with this + !convention + global_element_conn(i, 2) = x_GID + nodes_x*y_GID + nNodes2D*z_GIDplus1 + 1 + global_element_conn(i, 3) = x_GIDplus1 + nodes_x*y_GID + nNodes2D*z_GIDplus1 + 1 + global_element_conn(i, 4) = x_GIDplus1 + nodes_x*y_GIDplus1 + nNodes2D*z_GIDplus1 + 1 + global_element_conn(i, 5) = x_GID + nodes_x*y_GIDplus1 + nNodes2D*z_GIDplus1 + 1 + global_element_conn(i, 6) = x_GID + nodes_x*y_GID + nNodes2D*z_GID + 1 + global_element_conn(i, 7) = x_GIDplus1 + nodes_x*y_GID + nNodes2D*z_GID + 1 + global_element_conn(i, 8) = x_GIDplus1 + nodes_x*y_GIDplus1 + nNodes2D*z_GID + 1 + global_element_conn(i, 9) = x_GID + nodes_x*y_GIDplus1 + nNodes2D*z_GID + 1 + enddo + + !dynamically allocate arrays that depent on # active cells + allocate(global_element_conn_active(nCellsActive*(nz-1), 8)) + allocate(global_element_id_active_owned_map(nCellsActive*(nz-1),1)) + allocate(global_basal_face_conn_active(nCellsActive, 5)) + allocate(global_basal_face_id_active_owned_map(nCellsActive,1)) + allocate(flwa_at_active_cells(nCellsActive*(nz-1), 1)) + !IK, 9/9/13: do dynamically-allocated arrays need to be deallocated/deleted? + k = 1 + do i = 1, nElesProc3D + if (active_cell_vector3D(i)) then + global_element_conn_active(k, 1:8) = global_element_conn(i,2:9) + global_element_id_active_owned_map(k,1) = global_element_conn(i,1) + flwa_at_active_cells(k,1) = flwa_at_cells(i) + k = k + 1 + endif + enddo + k = 1 + do i = 1, nElesProc2D + if (active_cell_vector(i)) then + global_basal_face_conn_active(k, :) = global_basal_face_conn(i, 2:6) + global_basal_face_id_active_owned_map(k,1) = global_basal_face_conn(i, 1) + k = k + 1 + endif + enddo + + !IK, 9/12/13: printing output for debugging/checking element numbering + if (this_rank == 0) then + do l=1, nCellsActive*(nz-1) + print *, 'element connectivity active: ', global_element_conn_active(l,1:8) + print *, 'global element #: ', global_element_id_active_owned_map(l,1) + print *, 'flwa: ', flwa_at_active_cells(l,1) + enddo + endif + + !IK, 9/12/13: printing output for debugging/checking basal face numbering + if (this_rank == 0) then + do l=1, nCellsActive + print *, 'face connectivity active: ', global_basal_face_conn_active(l,1:5) + print *, 'global face #: ', global_basal_face_id_active_owned_map(l,1) + enddo + endif + + + !-------------------------------------------------------------------- + end subroutine get_parallel_finite_element_mesh_data + + +end module felix_dycore_interface diff --git a/components/cism/glimmer-cism/libglide/glam_grid_operators.F90 b/components/cism/glimmer-cism/libglide/glam_grid_operators.F90 new file mode 100644 index 0000000000..65049eefd2 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glam_grid_operators.F90 @@ -0,0 +1,1568 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glam_grid_operators.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! Various grid operators for glam dycore, including routines for computing gradients +! and switching between staggered and unstaggered grids + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +!> This module contains functions for computing derivatives numerically, both +!> for a single value and for an entire field. +!> Note that this module is written with the first index in a matrix corresponding +!> to the x (east-west) coordinate. If this is not the case (i.e. if the first +!> index corresponds to the y (north-south) coordinate), then transposition +!> will be necessary. Simply ask for the y-derivative when you mean to ask for +!> the x-derivative, and vice versa. + +module glam_grid_operators + + use glimmer_global, only: dp + + implicit none + +contains + +!---------------------------------------------------------------------------- + + subroutine glam_geometry_derivs(model) + + ! Compute derivatives of the ice and bed geometry, as well as averaging + ! them onto the staggered grid + + use glide_types, only: glide_global_type + use glide_grid_operators, only: stagvarb ! can we remove this? + implicit none + + type(glide_global_type), intent(inout) :: model + + call stagthickness(model%geometry% thck, & + model%geomderv%stagthck,& + model%general%ewn, & + model%general%nsn, & + model%geometry%usrf, & + model%numerics%thklim, & + model%geometry%thkmask) + +!NOTE: Should these calls to stagvarb be replaced by calls to df_field_2d_staggered? + call stagvarb(model%geometry%lsrf, & + model%geomderv%staglsrf,& + model%general%ewn, & + model%general%nsn) + + call stagvarb(model%geometry%topg, & + model%geomderv%stagtopg,& + model%general%ewn, & + model%general%nsn) + + model%geomderv%stagusrf = model%geomderv%staglsrf + model%geomderv%stagthck + + call df_field_2d_staggered(model%geometry%usrf, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%geometry%thck, & + model%numerics%thklim ) + + call df_field_2d_staggered(model%geometry%thck, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dthckdew, & + model%geomderv%dthckdns, & + model%geometry%thck, & + model%numerics%thklim ) + + !Make sure that the derivatives are 0 where staggered thickness is 0 + + where (model%geomderv%stagthck == 0.d0) + model%geomderv%dusrfdew = 0.d0 + model%geomderv%dusrfdns = 0.d0 + model%geomderv%dthckdew = 0.d0 + model%geomderv%dthckdns = 0.d0 + endwhere + + model%geomderv%dlsrfdew = model%geomderv%dusrfdew - model%geomderv%dthckdew + model%geomderv%dlsrfdns = model%geomderv%dusrfdns - model%geomderv%dthckdns + + !Compute second derivatives. + + call d2f_field_stag(model%geometry%usrf, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2usrfdew2, model%geomderv%d2usrfdns2, & + .false., .false.) + + call d2f_field_stag(model%geometry%thck, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2thckdew2, model%geomderv%d2thckdns2, & + .false., .false.) + + end subroutine glam_geometry_derivs + +!---------------------------------------------------------------------------- + + subroutine stagthickness(ipvr,opvr,ewn,nsn,usrf,thklim,mask) + + !! A special staggering algorithm that is meant to conserve mass when operating on thickness fields. + !! This incorporates Ann LeBroque's nunatak fix and the calving front fix. + +!NOTE: This subroutine, used by the glam HO dycore, is different from stagvarb, +! which is used by the glide SIA dycore. Here, zero-thickness values are +! ignored when thickness is averaged over four adjacent grid cells. +! In stagvarb, zero-thickness values are included in the average. +! The glam approach works better for calving. + + implicit none + + real(dp), intent(out), dimension(:,:) :: opvr + real(dp), intent(in), dimension(:,:) :: ipvr + + real(dp), intent(in), dimension(:,:) :: usrf + real(dp), intent(in) :: thklim + integer, intent(in), dimension(:,:) :: mask + + integer :: ewn,nsn,ew,ns,n + real(dp) :: tot + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + + !If any of our staggering points are shelf front, ignore zeros when staggering + !if (any(GLIDE_IS_CALVING(mask(ew:ew+1, ns:ns+1)))) then ! in contact with the ocean + !Use the "only nonzero thickness" staggering criterion for ALL marginal ice. For + ! reasons that are not entirely clear, this corrects an error whereby the land ice + ! margin is defined incorrectly as existing one grid cell too far inland from where + ! it should be. + + if (any(GLIDE_HAS_ICE(mask(ew:ew+1,ns:ns+1)))) then + n = 0 + tot = 0 + if (abs(ipvr(ew,ns)) > 0.d0 )then + tot = tot + ipvr(ew,ns) + n = n + 1 + end if + if (abs(ipvr(ew+1,ns)) > 0.d0 )then + tot = tot + ipvr(ew+1,ns) + n = n + 1 + end if + if (abs(ipvr(ew,ns+1)) > 0.d0 )then + tot = tot + ipvr(ew,ns+1) + n = n + 1 + end if + if (abs(ipvr(ew+1,ns+1)) > 0.d0 )then + tot = tot + ipvr(ew+1,ns+1) + n = n + 1 + end if + if (n > 0) then + opvr(ew,ns) = tot/n + else + opvr(ew,ns) = 0.d0 + end if + + !The following cases relate to Anne LeBroque's fix for nunataks + !ew,ns cell is ice free: + else if (ipvr(ew,ns) <= thklim .and. & + ((usrf(ew,ns) >= usrf(ew+1,ns) .and. ipvr(ew+1,ns) >= thklim) & + .or. (usrf(ew,ns) >= usrf(ew,ns+1) .and. ipvr(ew,ns+1) >= thklim))) then + opvr(ew,ns) = 0.d0 + + !ew+1,ns cell is ice free: + else if (ipvr(ew+1,ns) <= thklim .and. & + ((usrf(ew+1,ns) >= usrf(ew,ns) .and. ipvr(ew,ns) >= thklim) & + .or. (usrf(ew+1,ns) >= usrf(ew+1,ns+1) .and. ipvr(ew+1,ns+1) >= thklim))) then + opvr(ew,ns) = 0.d0 + + !ew,ns+1 cell is ice free: + else if (ipvr(ew,ns+1) <= thklim .and. & + ((usrf(ew,ns+1) >= usrf(ew,ns) .and. ipvr(ew,ns) >= thklim) & + .or. (usrf(ew,ns+1) >= usrf(ew+1,ns+1) .and. ipvr(ew+1,ns+1) >= thklim))) then + opvr(ew,ns) = 0.d0 + + !ew+1,ns+1 cell is ice free: + else if (ipvr(ew+1,ns+1) <= thklim .and. & + ((usrf(ew+1,ns+1) >= usrf(ew+1,ns) .and. ipvr(ew+1,ns) >=thklim) & + .or. (usrf(ew+1,ns+1) >= usrf(ew,ns+1) .and. ipvr(ew,ns+1) >=thklim))) then + opvr(ew,ns) = 0.d0 + +! !Standard Staggering !! Not needed if only-nonzero-thickness staggering scheme is used +! else +! opvr(ew,ns) = (ipvr(ew+1,ns) + ipvr(ew,ns+1) + & +! ipvr(ew+1,ns+1) + ipvr(ew,ns)) / 4.d0 + + end if + + end do + end do + + end subroutine stagthickness + +!---------------------------------------------------------------------------- + + !------------------------------------------------------------------ + !First Derivative Estimates, Second Order, 2D + !------------------------------------------------------------------ + + !> Computes derivative fields of the given function. + subroutine df_field_2d(f, & + deltax, deltay, & + out_dfdx, out_dfdy, & + direction_x, direction_y) + + use parallel + implicit none + real(dp), dimension(:, :), intent(in) :: f + real(dp), intent(in) :: deltax, deltay + real(dp), dimension(:, :), intent(out) :: out_dfdx, out_dfdy + real(dp), dimension(:, :), intent(in), optional :: direction_x, direction_y + + logical :: upwind !Whether or not directions for upwinding were provided + + integer :: grad_x, grad_y !Whether to upwind or downwind at the current point + + integer :: nx, ny, x, y + + !Get the size of the field we're working with + nx = size(f, 1) + ny = size(f, 2) + + upwind = present(direction_x) .and. present(direction_y) + + !For now, we'll use the function calls defined above. + !Later on we might want to refactor? + +!LOOP: all scalar points (uses upwinding and downwinding to avoid stepping out of bounds) + do x = 1, nx + do y = 1, ny + grad_x = 0 + grad_y = 0 + if (upwind) then + if (direction_x(x,y) < 0.d0 .and. x > 2) then ! Upstream case + grad_x = -1 + else if(direction_x(x,y) > 0.d0 .and. x < nx - 1) then ! Downstream case + grad_x = 1 + end if + + if (direction_y(x,y) < 0.d0 .and. y > 2) then !Upstream case + grad_y = -1 + else if(direction_y(x,y) > 0.d0 .and. y < ny - 1) then !Downstream case + grad_y = 1 + end if + end if + + !For each of the variables in x, y, check whether or not + !we need to use an upwinding or downwinding differentiation + !scheme. + if (x == 1 .or. grad_x > 0) then + out_dfdx(x, y) = dfdx_2d_downwind(f, x, y, deltax) + else if (x == nx .or. grad_x < 0) then + out_dfdx(x, y) = dfdx_2d_upwind(f, x, y, deltax) + else + out_dfdx(x, y) = dfdx_2d(f, x, y, deltax) + end if + + if (y == 1 .or. grad_y > 0) then + out_dfdy(x, y) = dfdy_2d_downwind(f, x, y, deltay) + elseif (y == ny .or. grad_y < 0) then + out_dfdy(x, y) = dfdy_2d_upwind(f, x, y, deltay) + else + out_dfdy(x, y) = dfdy_2d(f, x, y, deltay) + end if + + end do + end do + +!NOTE: If halo updates are needed, they should be done at a higher level. + +!! call parallel_halo(out_dfdx) +!! call parallel_halo(out_dfdy) + + end subroutine df_field_2d + +!---------------------------------------------------------------------------- + + !> Computes derivative fields of the given function. Places the result + !> on a staggered grid. If periodic in one dimension is set, that + !> dimension for derivatives must be the same size as the value's dimension. + !> Otherwise, it should be one less + + subroutine df_field_2d_staggered(f, & + deltax, deltay, & + out_dfdx, out_dfdy, & + thck, thklim ) + + implicit none + real(dp), dimension(:, :), intent(in) :: f, thck ! unstaggered grid + real(dp), intent(in) :: deltax, deltay, thklim + real(dp), dimension(:, :), intent(out) :: out_dfdx, out_dfdy ! staggered grid + + integer :: nx, ny, x, y + + !Get the size of the field we're working with + nx = size(f, 1) + ny = size(f, 2) + + ! intialize to zeros + out_dfdx = 0.d0 + out_dfdy = 0.d0 + + ! *SFP* old subroutine calls, commented out below but still available, + ! use centered diffs on normal thck / surf grids but do nothing special at lateral + ! boundaries where centered diffs might give unreasonable values (e.g., due to jumping + ! from a region of non-zero to zero thickness / elevation). New calls access new + ! subroutines which attempt to correct for this if/when possible using approx., first-order + ! accurate one-sided diffs. + + !Note - Can remove thck and thklim from argument list if not using new calls + + do x = 1, nx - 1 ! We go to nx - 1 because we're using a staggered grid + do y = 1, ny - 1 + out_dfdx(x,y) = dfdx_2d_stag(f, x, y, deltax) !*SFP* old call + out_dfdy(x,y) = dfdy_2d_stag(f, x, y, deltay) !*SFP* old call +! out_dfdx(x,y) = dfdx_2d_stag_os(f, x, y, deltax, thck, thklim ) +! out_dfdy(x,y) = dfdy_2d_stag_os(f, x, y, deltay, thck, thklim ) + end do + end do + + !NOTE - Remove this chunk of commented-out code +! !Deal with periodic boundary conditions. We will do so by +! !providing another set of values at the end of each dimension +! !that contains the derivative of the value off the edge of the +! !grid. Because this set of values is at the end, when +! !x = nx, x+1 = 1. This identity has been hard-coded below. +! if (periodic_x) then +! do y = 1, ny - 1 +! out_dfdx(nx,y) = -(f(1, y) + f(1, y+1) - f(nx, y) - f(nx, y+1))/(2*deltax) +! out_dfdy(nx,y) = dfdy_2d_stag(f, nx, y, deltay) +! end do +! end if +! +! if (periodic_y) then +! do x = 1, nx - 1 +! out_dfdx(x,ny) = dfdx_2d_stag(f, x, ny, deltax) +! out_dfdy(x,ny) = -(f(x, 1) + f(x+1, 1) - f(x,ny) - f(x+1, ny))/(2*deltay) +! end do +! end if +! +! !Do the corner that hasn't been done if both dimensions are periodic +! if (periodic_x .and. periodic_y) then +! out_dfdx(nx,ny) = (f(1, ny) + f(1, 1) - f(nx, ny) - f(nx, 1))/(2*deltax) +! out_dfdy(nx,ny) = (f(nx, 1) + f(1, 1) - f(nx,ny) - f(1, ny))/(2*deltay) +! end if +! + end subroutine df_field_2d_staggered + +!---------------------------------------------------------------------------- + + !NOTE - Remove subroutine df_field_3d? It is never called. + + subroutine df_field_3d(f, & + deltax, deltay, deltaz, & + out_dfdx, out_dfdy, out_dfdz, & + direction_x, direction_y) + + !> Computes derivative fields of the given function. + !> The z axis is computed on an irregular grid. + + implicit none + real(dp), dimension(:, :, :), intent(in) :: f + real(dp), intent(in) :: deltax, deltay + real(dp), dimension(:), intent(in) :: deltaz + real(dp), dimension(:, :, :), intent(out) :: out_dfdx, out_dfdy, out_dfdz + + !Field containing the direction that derivatives should be upwinded in. + !If 0, centered differences are used. If negative, then upwinded + !derivatives (approaching from the negative side) are used. If + !positive, then downwinded derivatives (approaching from the positive + !side) are used. + real(dp), dimension(:,:), optional :: direction_x, direction_y + + + integer :: grad_x, grad_y !Sign of the gradient, used for determining upwinding + integer :: nx, ny, nz, x, y, z + logical :: upwind + + !Get the size of the field we're working with + nx = size(f, 2) + ny = size(f, 3) + nz = size(f, 1) + + upwind = present(direction_x) .and. present(direction_y) + + !For now, we'll use the function calls defined above. + !Later on we might want to refactor? + +!LOOP: all scalar points +! uses upwinding and downwinding to avoid going out of bounds + do x = 1, nx + do y = 1, ny + grad_x = 0 + grad_y = 0 + if (upwind) then + if (direction_x(x,y) < 0.d0 .and. x > 2) then !Upstream case + grad_x = -1 + else if(direction_x(x,y) > 0.d0 .and. x < nx - 1) then !Downstream case + grad_x = 1 + end if + + if (direction_y(x,y) < 0.d0 .and. y > 2) then !Upstream case + grad_y = -1 + else if(direction_y(x,y) > 0.d0 .and. y < ny - 1) then !Downstream case + grad_y = 1 + end if + end if + + do z = 1, nz + !For each of the variables in x, y, check whether or not + !we need to use an upwinding or downwinding differentiation + !scheme. + if (x == 1 .or. grad_x > 0) then + out_dfdx(z, x, y) = dfdx_3d_downwind(f, x, y, z, deltax) + !out_dfdx(x, y, z) = (f(x+1,y,z) - f(x,y,z))/deltax + else if (x == nx .or. grad_x < 0) then + out_dfdx(z, x, y) = dfdx_3d_upwind(f, x, y, z, deltax) + !out_dfdx(x, y, z) = (f(x,y,z) - f(x-1,y,z))/deltax + else + out_dfdx(z, x, y) = dfdx_3d(f, x, y, z, deltax) + end if + if (y == 1 .or. grad_y > 0) then + out_dfdy(z, x, y) = dfdy_3d_downwind(f, x, y, z, deltay) + !out_dfdy(x, y, z) = (f(x,y+1,z) - f(x,y,z))/deltay + else if (y == ny .or. grad_y < 0) then + out_dfdy(z, x, y) = dfdy_3d_upwind(f, x, y, z, deltay) + !out_dfdy(x, y, z) = (f(x,y,z) - f(x,y-1,z))/deltay + else + out_dfdy(z, x, y) = dfdy_3d(f, x, y, z, deltay) + end if + if (z == 1) then + out_dfdz(z, x, y) = dfdz_3d_downwind_irregular(f, x, y, z, deltaz) + else if (z == nz) then + out_dfdz(z, x, y) = dfdz_3d_upwind_irregular(f, x, y, z, deltaz) + else + out_dfdz(z, x, y) = dfdz_3d_irregular(f, x, y, z, deltaz) + end if + end do + end do + end do + + end subroutine df_field_3d + +!---------------------------------------------------------------------------- + + !NOTE - Remove subroutine df_field_3d_stag? It is never called. + + subroutine df_field_3d_stag(f, & + deltax, deltay, deltaz, & + out_dfdx, out_dfdy, out_dfdz) + + !> Computes the derivative fields of the given function. The X and Y + !> derivatives are computed on a staggered grid. The Z derivative + !> is computed on a nonstaggered but irregular grid. This means that, + !> if an array of dimensions (n1, n2, n3), the output arrays should + !> be of size (n1 - 1, n2 - 1, n3) + + implicit none + real(dp), dimension(:, :, :), intent(in) :: f + real(dp), intent(in) :: deltax, deltay + real(dp), dimension(:), intent(in) :: deltaz + real(dp), dimension(:, :, :), intent(out) :: out_dfdx, out_dfdy, out_dfdz + + real(dp), dimension(4) :: zDerivs !Temporarily holds derivatives in Z to average + integer :: nx, ny, nz, x, y, z + + !Get the size of the field we're working with + nx = size(f, 1) + ny = size(f, 2) + nz = size(f, 3) + +!LOOP: all scalar points +! uses upwinding and downwinding to avoid going out of bounds + + do x = 1, nx - 1 + do y = 1, ny - 1 + do z = 1, nz + !We will never have to compute upstream and downstream + !derivatives in the horizontal (avoided by the staggered scheme), + !but we will in the vertical. + out_dfdx(x,y,z) = dfdx_3d_stag(f, x, y, z, deltax) + out_dfdy(x,y,z) = dfdy_3d_stag(f, x, y, z, deltay) + + !Even though we are not staggering in the vertical, the points + !we compute the derivatives at are still staggered in the + !horizontal. We'll solve this by computing four + !derivatives horizontally around the point requested + !and averaging the results + if (z == 1) then + zDerivs(1) = dfdz_3d_downwind_irregular(f, x, y, z, deltaz) + zDerivs(2) = dfdz_3d_downwind_irregular(f, x+1, y, z, deltaz) + zDerivs(3) = dfdz_3d_downwind_irregular(f, x, y+1, z, deltaz) + zDerivs(4) = dfdz_3d_downwind_irregular(f, x+1, y+1, z, deltaz) + else if (z == nz) then + zDerivs(1) = dfdz_3d_upwind_irregular(f, x, y, z, deltaz) + zDerivs(2) = dfdz_3d_upwind_irregular(f, x+1, y, z, deltaz) + zDerivs(3) = dfdz_3d_upwind_irregular(f, x, y+1, z, deltaz) + zDerivs(4) = dfdz_3d_upwind_irregular(f, x+1, y+1, z, deltaz) + else + zDerivs(1) = dfdz_3d_irregular(f, x, y, z, deltaz) + zDerivs(2) = dfdz_3d_irregular(f, x+1, y, z, deltaz) + zDerivs(3) = dfdz_3d_irregular(f, x, y+1, z, deltaz) + zDerivs(4) = dfdz_3d_irregular(f, x+1, y+1, z, deltaz) + end if + out_dfdz(x, y, z) = (zDerivs(1) + zDerivs(2) + zDerivs(3) + zDerivs(4)) / 4 + end do + end do + end do + + end subroutine df_field_3d_stag + +!---------------------------------------------------------------------------- + + !NOTE - Check the rest of this module for unused functions we might want to remove + + !> Computes derivative with respect to x at a given point. + !> Applies periodic boundary conditions if needed. + + function dfdx_2d(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdx_2d + + dfdx_2d = (-.5d0/delta)*f(i-1, j) + (.5d0/delta)*f(i+1, j) + !write(*,*), i, j, f(i,j), ip1, im1, delta, dfdx_2d + end function dfdx_2d + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at a given point + + function dfdy_2d(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdy_2d + + integer :: jp1, jm1 + jp1 = j + 1 + jm1 = j - 1 + if (jp1 == size(f, 2)+1) jp1 = 2 + if (jm1 == 0) jm1 = size(f, 2)-1 + + dfdy_2d = (-.5d0/delta)*f(i, j-1) + (.5d0/delta)*f(i, j+1) + end function dfdy_2d + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the equivalent + !> point on a staggered grid. + + function dfdx_2d_stag(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdx_2d_stag + dfdx_2d_stag = (f(i+1, j) + f(i+1, j+1) - f(i, j) - f(i, j+1))/(2.d0*delta) + end function dfdx_2d_stag + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the equivalent + !> point on a staggered grid. + + function dfdy_2d_stag(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdy_2d_stag + dfdy_2d_stag = (f(i, j+1) + f(i+1, j+1) - f(i,j) - f(i+1, j))/(2.d0*delta) + end function dfdy_2d_stag + +!---------------------------------------------------------------------------- + + function dfdx_2d_stag_os(f_in, i, j, delta, thck, thklim ) + + !*SFP* altered/expanded version of above function that uses approx. one-sided + ! diffs at physical domain edges so as not to overesimate grads there. + implicit none + real(dp), dimension(:,:), intent(in) :: f_in, thck + integer, intent(in) :: i, j + real(dp), intent(in) :: delta, thklim + real(dp) :: dfdx_2d_stag_os + + real(dp), dimension(2,2) :: f_array, thck_array + real(dp), dimension(1:size(f_in,1),1:size(f_in,2)) :: f + real(dp) :: f_min + + ! initialize vars/arrays to zeros + dfdx_2d_stag_os = 0.d0; f_array = 0.d0; f_min = 0.d0 + + f = f_in + + where( thck <= thklim ) + f = 0.d0 + end where + + f_array(1,1) = f(i,j); f_array(2,1) = f(i+1,j); f_array(1,2) = f(i,j+1); f_array(2,2) = f(i+1,j+1); + + if( sum( f_array/ f_array, MASK = f_array /= 0.0d0 ) == 4.d0 )then + + ! normal differencing for interior points + dfdx_2d_stag_os = (f(i+1,j) + f(i+1,j+1) - f(i,j) - f(i,j+1))/(2*delta) + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 3.d0 )then + + ! corner; use 2x next closest value + if( f(i,j) == f_min )then ! southwest corner point missing: apply value from s.e. point + dfdx_2d_stag_os = ( f(i+1,j+1) + f(i+1,j) - 2.d0*f(i,j+1) )/(2.d0*delta) + elseif( f(i+1,j) == f_min )then ! southeast corner point missing: apply value from s.w. point + dfdx_2d_stag_os = ( 2.d0*f(i+1,j+1) - f(i,j) - f(i,j+1) )/(2.d0*delta) + elseif( f(i,j+1) == f_min )then ! northwest corner point missing: apply value from n.e. point + dfdx_2d_stag_os = ( f(i+1,j+1) + f(i+1,j) - 2.d0*f(i,j))/(2.d0*delta) + elseif( f(i+1,j+1) == f_min )then ! northeast corner point missing: apply value from n.w. point + dfdx_2d_stag_os = ( 2.d0*f(i+1,j) - f(i,j) - f(i,j+1) )/(2.d0*delta) + endif + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 2.0 )then + + ! side; back up and take gradient from points one set of cells in OR use only the single set of + ! cells available along the differencing direction + if( f(i,j) == f_min .and. f(i,j+1) == f_min )then ! west cells empty + dfdx_2d_stag_os = (f(i+2,j) + f(i+2,j+1) - f(i+1,j+1) - f(i+1,j))/(2.d0*delta) + elseif( f(i+1,j) == f_min .and. f(i+1,j+1) == f_min )then ! east cells empty + dfdx_2d_stag_os = (f(i,j) + f(i,j+1) - f(i-1,j) - f(i-1,j+1))/(2.d0*delta) + elseif( f(i,j+1) == f_min .and. f(i+1,j+1) == f_min )then ! north cells empty + dfdx_2d_stag_os = (f(i+1,j) - f(i,j) )/(delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min )then ! south cells empty + dfdx_2d_stag_os = (f(i+1,j+1) - f(i,j+1) )/(delta) + endif + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 1.d0 )then + + ! isolated; treat by assuming it is part of a 3 block for which the rest of the values are not contained in + ! the local 2x2 block with indices i:i+1, j:j+1 + if( f(i,j) /= f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) == f_min)then + ! a northeast corner + dfdx_2d_stag_os = ( f(i,j) - f(i-1,j) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) /= f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) == f_min)then + ! a northwest corner + dfdx_2d_stag_os = ( f(i+2,j) - f(i+1,j) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) /= f_min .and. f(i,j+1) == f_min)then + ! a southwest corner + dfdx_2d_stag_os = ( f(i+2,j+1) - f(i+1,j+1) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) /= f_min)then + ! a southeast corner + dfdx_2d_stag_os = ( f(i,j+1) - f(i-1,j+1) ) / (delta) + endif + + endif + + end function dfdx_2d_stag_os + +!---------------------------------------------------------------------------- + + function dfdy_2d_stag_os(f_in, i, j, delta, thck, thklim ) + + !*SFP* altered/expanded version of above function that uses approx. one-sided + ! diffs at physical domain edges so as not to overesimate grads there. + + implicit none + real(dp), dimension(:,:), intent(in) :: f_in, thck + integer, intent(in) :: i, j + real(dp), intent(in) :: delta, thklim + real(dp) :: dfdy_2d_stag_os + + real(dp), dimension(2,2) :: f_array, thck_array + real(dp), dimension(1:size(f_in,1),1:size(f_in,2)) :: f + real(dp) :: f_min + + ! initialize to zeros + dfdy_2d_stag_os = 0.d0; f_array = 0.d0; f_min = 0.d0 + + f = f_in + + where( thck <= thklim ) + f = 0.d0 + end where + + f_array(1,1) = f(i,j); f_array(2,1) = f(i+1,j); f_array(1,2) = f(i,j+1); f_array(2,2) = f(i+1,j+1); + + if( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 4.d0 )then + + ! normal differencing for interior points + dfdy_2d_stag_os = (f(i,j+1) + f(i+1,j+1) - f(i,j) - f(i+1,j))/(2.d0*delta) + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 3.d0 ) then + + ! corner; use 2x next closest value + if( f(i,j) == f_min )then ! southwest corner point missing: apply value from s.e. point + dfdy_2d_stag_os = (f(i,j+1) + f(i+1,j+1) - 2.d0*f(i+1,j))/(2.d0*delta) + elseif( f(i+1,j) == f_min )then ! southeast corner point missing: apply value from s.w. point + dfdy_2d_stag_os = (f(i,j+1) + f(i+1,j+1) - 2.d0*f(i,j))/(2.d0*delta) + elseif( f(i,j+1) == f_min )then ! northwest corner point missing: apply value from n.e. point + dfdy_2d_stag_os = ( 2.d0*f(i+1,j+1) - f(i,j) - f(i+1,j))/(2.d0*delta) + elseif( f(i+1,j+1) == f_min )then ! northeast corner point missing: apply value from n.w. point + dfdy_2d_stag_os = ( 2.d0*f(i,j+1) - f(i,j) - f(i+1,j))/(2.d0*delta) + endif + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 2.d0 )then + + ! side; back up and take gradient from points one set of cells in OR use only the single set of + ! cells available along the differencing direction + if( f(i,j) == f_min .and. f(i,j+1) == f_min )then ! west cells empty + dfdy_2d_stag_os = (f(i+1,j+1) - f(i+1, j))/(delta) + elseif( f(i+1,j) == f_min .and. f(i+1,j+1) == f_min )then ! east cells empty + dfdy_2d_stag_os = (f(i,j+1) - f(i,j) )/(delta) + elseif( f(i,j+1) == f_min .and. f(i+1,j+1) == f_min )then ! north cells empty + dfdy_2d_stag_os = (f(i,j) + f(i+1,j) - f(i,j-1) - f(i+1,j-1))/(2.d0*delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min )then ! south cells empty + dfdy_2d_stag_os = (f(i,j+2) + f(i+1,j+2) - f(i,j+1) - f(i+1,j+1))/(2.d0*delta) + endif + + elseif( sum( f_array/ f_array, MASK = f_array /= 0.d0 ) == 1.d0 ) then + + ! isolated; treat by assuming it is part of a 3 block for which the rest of the values are not contained within + ! the local 2x2 block with indices i:i+1, j:j+1 + if( f(i,j) /= f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) == f_min )then + ! a northeast corner + dfdy_2d_stag_os = ( f(i,j) - f(i,j-1) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) /= f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) == f_min )then + ! a northwest corner + dfdy_2d_stag_os = ( f(i+1,j) - f(i+1,j-1) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) /= f_min .and. f(i,j+1) == f_min )then + ! a southwest corner + dfdy_2d_stag_os = ( f(i+1,j+2) - f(i+1,j+1) ) / (delta) + elseif( f(i,j) == f_min .and. f(i+1,j) == f_min .and. f(i+1,j+1) == f_min .and. f(i,j+1) /= f_min )then + ! a southeast corner + dfdy_2d_stag_os = ( f(i,j+2) - f(i,j+1) ) / (delta) + endif + + endif + + end function dfdy_2d_stag_os + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the given point + !> using an upwind method (suitable for maximum boundaries) + + function dfdx_2d_upwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdx_2d_upwind + dfdx_2d_upwind = (.5d0 * f(i-2,j) - 2.d0 * f(i-1, j) + 1.5d0 * f(i, j))/delta + end function dfdx_2d_upwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the given point + !> using an upwind method (suitable for maximum boundaries) + + function dfdy_2d_upwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdy_2d_upwind + dfdy_2d_upwind = (.5d0 * f(i,j-2) - 2.d0 * f(i, j-1) + 1.5d0 * f(i, j))/delta + end function dfdy_2d_upwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the given point + !> using a downwind method (suitable for minimum boundaries) + + function dfdx_2d_downwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdx_2d_downwind + dfdx_2d_downwind = (-1.5d0 * f(i, j) + 2.d0 * f(i+1, j) - .5d0 * f(i+2, j))/delta + end function dfdx_2d_downwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the given point + !> using a downwind method (suitable for minimum boundaries) + + function dfdy_2d_downwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: dfdy_2d_downwind + dfdy_2d_downwind = (-1.5d0 * f(i, j) + 2.d0 * f(i, j+1) - .5d0 * f(i, j+2))/delta + end function dfdy_2d_downwind + +!---------------------------------------------------------------------------- + + !------------------------------------------------------------------ + !First Derivative Estimates, Second Order, 3D + !------------------------------------------------------------------ + + !> Computes derivative with respect to x at a given point + + function dfdx_3d(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdx_3d + dfdx_3d = (-.5d0/delta)*f(k, i-1, j) + (.5d0/delta)*f(k, i+1, j) + end function dfdx_3d + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at a given point + + function dfdy_3d(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdy_3d + dfdy_3d = (-.5d0/delta)*f(k, i, j-1) + (.5d0/delta)*f(k, i, j+1) + end function dfdy_3d + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to z at a given point + !> where the Z axis uses an irregular grid defined by \ittext{deltas}. + !> This derivative is given by the formula: + + function dfdz_3d_irregular(f, i, j, k, dz) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), dimension(:), intent(in) :: dz + real(dp) :: dfdz_3d_irregular + + dfdz_3d_irregular = f(k-1,i,j)*(dz(k) - dz(k+1))/((dz(k) - dz(k-1))*(dz(k+1)-dz(k-1))) + & + f(k, i,j)*(dz(k+1)-2.d0*dz(k)+dz(k-1))/((dz(k)-dz(k-1))*(dz(k+1)-dz(k))) + & + f(k+1,i,j)*(dz(k)-dz(k-1))/((dz(k+1)-dz(k))*(dz(K+1)-dz(k-1))) + end function + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to z at a given point using an upwinding + !> scheme. The Z axis uses an irregular grid defined by \iittext{deltas}. + + function dfdz_3d_upwind_irregular(f, i, j, k, deltas) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), dimension(:), intent(in) :: deltas + real(dp) :: dfdz_3d_upwind_irregular + real(dp) :: zkMinusZkm1, zkMinusZkm2, zkm1MinusZkm2 + zkMinusZkm1 = deltas(k) - deltas(k-1) + zkMinusZkm2 = deltas(k) - deltas(k-2) + zkm1MinusZkm2 = deltas(k-1) - deltas(k-2) + + dfdz_3d_upwind_irregular = f(k-2, i, j) * zkMinusZkm1 / (zkm1MinusZkm2 * zkMinusZkm2) - & + f(k-1, i, j) * zkMinusZkm2 / (zkMinusZkm1 * zkm1MinusZkm2) + & + f(k, i, j) * (2.d0*deltas(k) - deltas(k-1) - deltas(k-2)) / (zkMinusZkm1 * zkMinusZkm2) + end function + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to z at a given point using a downwinding + !> scheme. The Z axis uses an irregular grid defined by \iittext{deltas}. + + function dfdz_3d_downwind_irregular(f, i, j, k, deltas) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), dimension(:), intent(in) :: deltas + real(dp) :: dfdz_3d_downwind_irregular + real(dp) :: zkp1MinusZk, zkp2MinusZk, zkp2MinusZkp1 + zkp1MinusZk = deltas(k+1) - deltas(k) + zkp2MinusZk = deltas(k+2) - deltas(k) + zkp2MinusZkp1 = deltas(k+2) - deltas(k+1) + + dfdz_3d_downwind_irregular =f(k, i, j) * (-zkp1MinusZk - zkp2MinusZk)/(zkp1MinusZk * zkp2MinusZk) + & + f(k+1, i, j) * zkp2MinusZk / (zkp2MinusZkp1 * zkp1MinusZk) - & + f(k+2, i, j) * zkp1MinusZk / (zkp2MinusZkp1 * zkp2MinusZk) + end function + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the equivalent + !> point on a staggered grid. + + function dfdx_3d_stag(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdx_3d_stag + dfdx_3d_stag = (f(k, i+1, j) + f(k, i+1, j+1) - f(k, i, j) - f(k, i, j+1))/(2.d0*delta) + end function dfdx_3d_stag + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the equivalent + !> point on a staggered grid. + + function dfdy_3d_stag(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdy_3d_stag + dfdy_3d_stag = (f(k, i, j+1) + f(k, i+1, j+1) - f(k, i, j) - f(k, i+1, j))/(2.d0*delta) + end function dfdy_3d_stag + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the given point + !> using an upwind method (suitable for maximum boundaries) + + function dfdx_3d_upwind(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdx_3d_upwind + dfdx_3d_upwind = (.5d0 * f(k, i-2, j) - 2.d0 * f(k, i-1, j) + 1.5d0 * f(k, i, j))/delta + end function dfdx_3d_upwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the given point + !> using an upwind method (suitable for maximum boundaries) + + function dfdy_3d_upwind(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdy_3d_upwind + dfdy_3d_upwind = (.5d0 * f(k, i, j-2) - 2.d0 * f(k, i, j-1) + 1.5d0 * f(k, i, j))/delta + end function dfdy_3d_upwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to x at the given point + !> using a downwind method (suitable for minimum boundaries) + + function dfdx_3d_downwind(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j, k + real(dp), intent(in) :: delta + real(dp) :: dfdx_3d_downwind + dfdx_3d_downwind = (-1.5d0 * f(k, i, j) + 2.d0 * f(k, i+1, j) - .5d0 * f(k, i+2, j))/delta + end function dfdx_3d_downwind + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to y at the given point + !> using a downwind method (suitable for minimum boundaries) + + function dfdy_3d_downwind(f, i, j, k, delta) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta + real(dp) :: dfdy_3d_downwind + dfdy_3d_downwind = (-1.5d0 * f(k, i, j) + 2.d0 * f(k, i, j+1) - .5d0 * f(k, i, j+2))/delta + end function dfdy_3d_downwind + +!---------------------------------------------------------------------------- + + !------------------------------------------------------------------ + !Second Derivative Estimates, Second Order + !------------------------------------------------------------------ + + !> Computes 2nd derivative with respect to x at the given point + + function d2fdx2_2d(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d + d2fdx2_2d = (f(i+1,j) + f(i-1,j) - 2.d0 * f(i, j))/(delta*delta) + end function d2fdx2_2d + +!---------------------------------------------------------------------------- + + function d2fdx2_2d_downwind(f,i,j,delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d_downwind + + d2fdx2_2d_downwind = (3.d0*f(i, j) - 7.d0*f(i+1, j) + 5.d0*f(i+2, j) - f(i+3, j)) / (2.d0*delta**2) + + end function d2fdx2_2d_downwind + +!---------------------------------------------------------------------------- + + function d2fdx2_2d_upwind(f,i,j,delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d_upwind + + d2fdx2_2d_upwind = (3.d0*f(i, j) - 7.d0*f(i-1, j) + 5.d0*f(i-2, j) - f(i-3, j)) / (2.d0*delta**2) + + end function d2fdx2_2d_upwind + +!---------------------------------------------------------------------------- + + function d2fdy2_2d_downwind(f,i,j,delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d_downwind + + d2fdy2_2d_downwind = (3.d0*f(i, j) - 7.d0*f(i, j+1) + 5.d0*f(i, j+2) - f(i, j+3)) / (2.d0*delta**2) + + end function d2fdy2_2d_downwind + +!---------------------------------------------------------------------------- + + function d2fdy2_2d_upwind(f,i,j,delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d_upwind + + d2fdy2_2d_upwind = (3.d0*f(i, j) - 7.d0*f(i, j-1) + 5.d0*f(i, j-2) - f(i, j-3)) / (2.d0*delta**2) + + end function d2fdy2_2d_upwind + +!---------------------------------------------------------------------------- + + function d2fdx2_2d_stag(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d_stag + + !This formula can be derived using two central differences + !(i to i+2, and i-1 to i+1) to get the derivative at + !i and i+1, then applying a central difference to that + !in order to get the 2nd derivative at a staggered point + d2fdx2_2d_stag = sum(f(i+2, j:j+1) + f(i-1, j:j+1) - f(i+1, j:j+1) - f(i, j:j+1))/(4.d0*delta**2) + end function d2fdx2_2d_stag + +!---------------------------------------------------------------------------- + + function d2fdx2_2d_stag_downwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d_stag_downwind + + d2fdx2_2d_stag_downwind = sum(3.d0*f(i, j:j+1) - 7.d0*f(i+1, j:j+1) + 5.d0*f(i+2, j:j+1) - f(i+3, j:j+1)) / (4.d0*delta**2) + end function d2fdx2_2d_stag_downwind + + function d2fdx2_2d_stag_upwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdx2_2d_stag_upwind + + d2fdx2_2d_stag_upwind = sum(-3.d0*f(i+1, j:j+1) + 7.d0*f(i, j:j+1) - 5.d0*f(i-1, j:j+1) + f(i-2, j:j+1)) / (4.d0*delta**2) + end function d2fdx2_2d_stag_upwind + +!---------------------------------------------------------------------------- + + !> Computes 2nd derivative with respect to y at the given point + + function d2fdy2_2d(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d + d2fdy2_2d = (f(i, j+1) + f(i, j-1) - 2.d0 * f(i, j))/(delta*delta) + end function d2fdy2_2d + +!---------------------------------------------------------------------------- + + function d2fdy2_2d_stag(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d_stag + + !This formula can be derived using two central differences + !(i to i+2, and i-1 to i+1) to get the derivative at + !i and i+1, then applying a central difference to that + !in order to get the 2nd derivative at a staggered point + d2fdy2_2d_stag = sum(f(i:i+1, j+2) + f(i:i+1, j-1) - f(i:i+1, j+1) - f(i:i+1, j))/(4.d0*delta**2) + end function d2fdy2_2d_stag + +!---------------------------------------------------------------------------- + + function d2fdy2_2d_stag_downwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d_stag_downwind + + d2fdy2_2d_stag_downwind = sum(3.d0*f(i:i+1, j) - 7.d0*f(i:i+1, j+1) + 5.d0*f(i:i+1, j+2) - f(i:i+1, j+3)) / (4.d0*delta**2) + end function d2fdy2_2d_stag_downwind + +!---------------------------------------------------------------------------- + + function d2fdy2_2d_stag_upwind(f, i, j, delta) + implicit none + real(dp), dimension(:,:), intent(in) :: f + integer, intent(in) :: i,j + real(dp), intent(in) :: delta + real(dp) :: d2fdy2_2d_stag_upwind + + d2fdy2_2d_stag_upwind = sum(-3.d0*f(i:i+1, j+1) + 7.d0*f(i:i+1, j) - 5.d0*f(i:i+1, j-1) + f(i:i+1, j-2)) / (4.d0*delta**2) + end function d2fdy2_2d_stag_upwind + +!---------------------------------------------------------------------------- + + subroutine d2f_field(f, deltax, deltay, d2fdx2, d2fdy2, direction_x, direction_y) + + use parallel + implicit none + + real(dp), intent(out), dimension(:,:) :: d2fdx2, d2fdy2 + real(dp), intent(in), dimension(:,:) :: f ! unstaggered grid + real(dp), intent(in) :: deltax, deltay + real(dp), intent(in), dimension(:,:), optional :: direction_x, direction_y + integer :: i,j + +!LOOP: all scalar points +! uses upwinding and downwinding to avoid going out of bounds + + do i = 1,size(f,1) + do j = 1,size(f,2) + + !unstaggered grid + if (i == 1) then + d2fdx2(i,j) = d2fdx2_2d_downwind(f,i,j,deltax) + else if (i == size(f,1)) then + d2fdx2(i,j) = d2fdx2_2d_upwind(f,i,j,deltax) + else + if (present(direction_x)) then + if (direction_x(i,j) > 0.d0) then + d2fdx2(i,j) = d2fdx2_2d_downwind(f,i,j,deltax) + else if (direction_x(i,j) < 0.d0) then + d2fdx2(i,j) = d2fdx2_2d_upwind(f,i,j,deltax) + else + d2fdx2(i,j) = d2fdx2_2d(f,i,j,deltax) + end if + else + d2fdx2(i,j) = d2fdx2_2d(f,i,j,deltax) + end if + end if + + if (j == 1) then + d2fdy2(i,j) = d2fdy2_2d_downwind(f,i,j,deltax) + else if (j == size(f,2)) then + d2fdy2(i,j) = d2fdy2_2d_upwind(f,i,j,deltax) + else + if (present(direction_y)) then + if (direction_y(i,j) > 0.d0) then + d2fdy2(i,j) = d2fdy2_2d_downwind(f,i,j,deltax) + else if (direction_y(i,j) < 0.d0) then + d2fdy2(i,j) = d2fdy2_2d_upwind(f,i,j,deltax) + else + d2fdy2(i,j) = d2fdy2_2d(f,i,j,deltax) + end if + else + d2fdy2(i,j) = d2fdy2_2d(f,i,j,deltax) + end if + end if + end do + end do + + call parallel_halo(d2fdx2) + call parallel_halo(d2fdy2) + + end subroutine d2f_field + +!---------------------------------------------------------------------------- + + subroutine d2f_field_stag(f, deltax, deltay, d2fdx2, d2fdy2, periodic_x, periodic_y) + + implicit none + + real(dp), intent(out), dimension(:,:) :: d2fdx2, d2fdy2 + real(dp), intent(in), dimension(:,:) :: f + real(dp), intent(in) :: deltax, deltay + logical :: periodic_x, periodic_y + + real(dp) :: dewsq4, dnssq4 + integer :: ew,ns + + integer :: pt(2) + integer :: nsn + integer :: ewn + + nsn = size(f,2) + ewn = size(f,1) + + dewsq4 = 4.0d0 * deltax * deltax + dnssq4 = 4.0d0 * deltay * deltay + + d2fdx2 = 0.d0 + d2fdy2 = 0.d0 + + !LOOP - not sure what bounds should be in this subroutine + + do ns = 2, nsn-2 + do ew = 2, ewn-2 + d2fdx2(ew,ns) = centerew(ew,ns) + d2fdy2(ew,ns) = centerns(ew,ns) + end do + end do + +! *** 2nd order boundaries using upwinding + + do ew = 1, ewn-1, ewn-2 + + pt = whichway(ew) + + do ns = 2, nsn-2 + d2fdx2(ew,ns) = boundyew(pt,ns) + d2fdy2(ew,ns) = centerns(ew,ns) + end do + + end do + + do ns = 1, nsn-1, nsn-2 + + pt = whichway(ns) + + do ew = 2, ewn-2 + d2fdx2(ew,ns) = centerew(ew,ns) + d2fdy2(ew,ns) = boundyns(pt,ew) + end do + + end do + + do ns = 1, nsn-1, nsn-2 + do ew = 1, ewn-1, ewn-2 + pt = whichway(ew) + d2fdx2(ew,ns) = boundyew(pt,ns) + pt = whichway(ns) + d2fdy2(ew,ns) = boundyns(pt,ew) + end do + end do + + contains + +!---------------------------------------------------------------------------- + + function centerew(ew,ns) + + implicit none + + real(dp) :: centerew + integer ns,ew + + centerew = (sum(f(ew+2,ns:ns+1)) + sum(f(ew-1,ns:ns+1)) - & + sum(f(ew+1,ns:ns+1)) - sum(f(ew,ns:ns+1))) / dewsq4 + + end function centerew + +!---------------------------------------------------------------------------- + + function centerns(ew,ns) + + implicit none + + real(dp) :: centerns + integer ns,ew + + centerns = (sum(f(ew:ew+1,ns+2)) + sum(f(ew:ew+1,ns-1)) - & + sum(f(ew:ew+1,ns+1)) - sum(f(ew:ew+1,ns))) / dnssq4 + + end function centerns + +!---------------------------------------------------------------------------- + + function boundyew(pt,ns) + + implicit none + + integer, intent(in) :: pt(2) + real(dp) :: boundyew + integer ns + + boundyew = pt(1) * (3.d0 * sum(f(pt(2),ns:ns+1)) - 7.d0 * sum(f(pt(2)+pt(1),ns:ns+1)) + & + 5.d0 * sum(f(pt(2)+2*pt(1),ns:ns+1)) - sum(f(pt(2)+3*pt(1),ns:ns+1))) / dewsq4 + + end function boundyew + +!---------------------------------------------------------------------------- + + function boundyns(pt,ew) + + implicit none + + integer, intent(in) :: pt(2) + real(dp) :: boundyns + integer ew + + boundyns = pt(1) * (3.d0 * sum(f(ew:ew+1,pt(2))) - 7.d0 * sum(f(ew:ew+1,pt(2)+pt(1))) + & + 5.d0 * sum(f(ew:ew+1,pt(2)+2*pt(1))) - sum(f(ew:ew+1,pt(2)+3*pt(1)))) / dnssq4 + + end function boundyns + +!---------------------------------------------------------------------------- + + function whichway(i) + + implicit none + + integer, intent(in) :: i + integer :: whichway(2) + + if (i == 1) then + whichway = (/1,1/) + else + whichway = (/-1,i+1/) + end if + + end function whichway + +!---------------------------------------------------------------------------- + !NOTE: Remove this commented-out code? + +! real(dp), dimension(:,:), intent(in) :: f +! real(dp), dimension(:,:), intent(out) :: d2fdx2, d2fdy2 +! real(dp), intent(in) :: deltax, deltay +! logical :: periodic_x, periodic_y +! +! integer :: nx, x, ny, y +! +! nx = size(f, 1) +! ny = size(f, 2) +! +! !NOTE: See the field 1st derivative staggered function for +! !a discussion of periodic boundary conditions +! +! !First compute the values that do not fall on any boundaries +! !This is the same regardless of whether periodic boundary +! !conditions are used +! do x = 1, nx-1 +! do y = 1, ny-1 +! if (x == 1) then +! d2fdx2(1,y) = d2fdx2_2d_stag_downwind(f, 1, y, deltax) +! else if (x == nx - 1) then +! d2fdx2(nx-1, y) = d2fdx2_2d_stag_upwind(f, nx-1, y, deltax) +! else +! d2fdx2(x,y) = d2fdx2_2d_stag(f, x, y, deltax) +! end if +! +! if (y == 1) then +! d2fdy2(x,1) = d2fdy2_2d_stag_downwind(f, x, 1, deltay) +! else if (y == ny - 1) then +! d2fdy2(x, ny-1) = d2fdy2_2d_stag_upwind(f, x, ny-1, deltay) +! else +! d2fdy2(x,y) = d2fdy2_2d_stag(f, x, y, deltay) +! end if +! end do +! end do +! +! !If we are not using periodic boundary conditions, then we need +! !to use an upwinding scheme to get the values when x = 1, y = 1, +! !x = nx - 1, or y = ny - 1 +! !If we are using periodic boundary conditions, then compute the +! !boundaries with input from the periodic conditions. We do not +! !upwind or downwind. Also, because an extra set of values around +! !the edges is necessary to correctly maintain periodicity, +! !we fill in values where x = nx and where y = ny (whereas we +! !do not with nonperiodic boundaries, as the staggered grid +! !points fall strictly in the interior of the nonstaggered +! !grid) +! do y = 1, ny - 2 +! if (.not.(periodic_x)) then +! d2fdx2(1,y) = d2fdx2_2d_stag_downwind(f, 1, y, deltax) +! +! d2fdx2(nx-1, y) = d2fdx2_2d_stag_upwind(f, nx-1, y, deltax) +! +! else +! !Because of the periodicity, I will simply copy the appropriate values +! !(e.g. u(1) = u(n-2), u(n-1) = u(2) +! d2fdx2(1,y) = d2fdx2(nx-2,y) +! d2fdx2(nx-1,y) = d2fdx2(2,y) +! end if +! d2fdy2(1,y) = d2fdy2_2d_stag(f, 1, y, deltay) +! d2fdy2(nx-1, y) = d2fdy2_2d_stag(f, nx-1, y, deltay) +! end do +! +! !See comments for the periodic x boundary case above; the same +! !principles apply here. +! do x=1, nx-2 +! if (.not.(periodic_y)) then +! d2fdy2(x,1) = d2fdy2_2d_stag_downwind(f, x, 1, deltay) +! d2fdy2(x, ny-1) = d2fdy2_2d_stag_upwind(f, x, ny-1, deltay) +! else +! d2fdy2(x,1) = d2fdy2(x,ny-2) +! d2fdy2(x,nx-1) = d2fdy2(x,2) +! end if +! d2fdx2(x,1) = d2fdx2_2d_stag(f, x, 1, deltax) +! d2fdx2(x, ny-1) = d2fdx2_2d_stag(f, x, ny-1, deltax) +! end do +! +! +! !To do: Change this to use the scheme above +! !We have neglected so far to take care of the four points that occur at the +! !maximum two indices in x and y. If no periodic boundaries are being used, +! !we compute the value zt (nx-1, ny-1) using upwinding schemes. +! if (.not. periodic_x .and. .not. periodic_y) then +! d2fdx2(nx-1, ny-1) = d2fdx2_2d_stag_upwind(f, nx-1, ny-1, deltax) +! d2fdy2(nx-1, ny-1) = d2fdy2_2d_stag_upwind(f, nx-1, ny-1, deltay) +! else if (.not. periodic_x) then +! !y is periodic - this means we need to compute the derivative +! !for x=nx-1 and y=ny, ny-1. We will copy and paste +! !y derivatives (for now), as above, and upwind +! !the x derivatives +! d2fdx2(nx-1, ny-1) = d2fdx2_2d_stag_upwind(f, nx-1, ny-1, deltax) +! d2fdy2(nx-1, ny-1) = sum(f(nx-1:nx, 1) + f(nx-1:nx, ny-2) - f(nx-1:nx, ny) - f(nx-1:nx, ny-1))/(4*deltay**2) +! +! +! d2fdx2(nx-1, ny) = d2fdx2_2d_stag_upwind(f, nx-1, ny, deltax) +! d2fdy2(nx-1, ny) = sum(f(nx-1:nx, 2) + f(nx-1:nx, ny-1) - f(nx-1:nx, 1) - f(nx-1:nx, ny))/(4*deltay**2) +! +! else if (.not. periodic_y) then +! !See comments for the periodic y case above - we are basically using the same +! !logic with x and y swapped +! d2fdx2(nx-1, ny-1) = sum(f(1, ny-1:ny) + f(nx-2, ny-1:ny) - f(nx, ny-1:ny) - f(nx-1, ny-1:ny))/(4*deltax**2) +! d2fdy2(nx-1, ny-1) = d2fdy2_2d_stag_upwind(f, nx-1, ny-1, deltay) +! +! d2fdx2(nx, ny-1) = sum(f(2, ny-1:ny) + f(nx-1, ny-1:ny) - f(1, ny-1:ny) - f(nx, ny-1:ny))/(4*deltax**2) +! d2fdy2(nx, ny-1) = d2fdy2_2d_stag_upwind(f, nx-1, ny-1, deltay) +! else +! !X and Y are periodic; we will use the periodic forms of the above differences +! !Some of these will get very funky because +! d2fdx2(nx-1, ny-1) = sum(f(1, ny-1:ny) + f(nx-1, ny-1:ny) - f(nx, ny-1:ny) - f(nx-1, ny-1:ny))/(4*deltax**2) +! d2fdy2(nx-1, ny-1) = sum(f(nx-1:nx, 1) + f(nx-1:nx, ny-2) - f(nx-1:nx, ny) - f(nx-1:nx, ny-1))/(4*deltay**2) +! +! d2fdx2(nx, ny-1) = sum(f(2, ny-1:ny) + f(nx-1, ny-1:ny) - f(1, ny-1:ny) - f(nx, ny-1:ny))/(4*deltax**2) +! d2fdy2(nx, ny-1) = ((f(nx, 1) + f(nx, ny-2) - f(nx, ny) - f(nx, ny-1)) + & +! (f(1, 1) + f(1, ny-2) - f(1, ny) - f(1, ny-1)))/(4*deltay**2) +! +! d2fdy2(nx-1, ny) = ((f(1, ny) + f(nx-1, ny) - f(nx, ny) - f(nx-1, ny)) + & +! (f(1, 1) + f(nx-1, 1) - f(nx, 1) - f(nx-1, 1)))/(4*deltax**2) +! d2fdy2(nx-1, ny) = sum(f(nx-1:nx, 2) + f(nx-1:nx, ny-1) - f(nx-1:nx, 1) - f(nx-1:nx, ny))/(4*deltay**2) +! +! d2fdx2(nx, ny) = ((f(2, ny) + f(nx-1, ny) - f(1, ny) - f(nx, ny)) + (f(2, 1) + f(nx-1, 1) - f(1, 1) - f(nx, 1))) / (4*deltax**2) +! d2fdy2(nx, ny) = ((f(nx, 2) + f(nx, ny-1) - f(nx, 1) - f(nx, ny)) + (f(1, 2) + f(1, ny-1) - f(1, 1) - f(1, ny)))/(4*deltay**2) +! +! end if + + end subroutine d2f_field_stag + +!---------------------------------------------------------------------------- + + !> Computes derivative taken first w.r.t x, then to y at the given point. + + function d2fdxy_3d(f, i, j, k, delta_x, delta_y) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta_x, delta_y + real(dp) :: d2fdxy_3d + + d2fdxy_3d = (f(k, i-1, j-1) - f(k, i-1, j+1) - f(k, i+1, j-1) + f(k, i+1, j+1))/(4.d0*delta_x*delta_y) + end function d2fdxy_3d + +!---------------------------------------------------------------------------- + + function d2fdxz_3d(f, i, j, k, delta_x, dz) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta_x + real(dp), dimension(:), intent(in) :: dz + real(dp) :: d2fdxz_3d + + d2fdxz_3d = (.5d0/delta_x) * ( & + (f(k-1, i+1, j) - f(k-1, i-1, j)) * (dz(k) - dz(k+1)) / ( (dz(k) - dz(k-1)) * (dz(k+1) - dz(k-1)) ) + & + (f(k, i+1, j) - f(k, i-1, j)) * (dz(k+1) + dz(k-1) - 2*dz(k)) / ( (dz(k) - dz(k-1)) * (dz(k+1) - dz(k)) ) + & + (f(k+1, i+1, j) - f(k+1, i-1, j)) * (dz(k) - dz(k-1)) / ( (dz(k+1) - dz(k)) * (dz(k+1) - dz(k-1)) ) ) + end function d2fdxz_3d + + function d2fdyz_3d(f, i, j, k, delta_x, dz) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), intent(in) :: delta_x + real(dp), dimension(:), intent(in) :: dz + real(dp) :: d2fdyz_3d + + d2fdyz_3d = (.5d0/delta_x) * ( & + (f(k-1, i, j+1) - f(k-1, i, j-1)) * (dz(k) - dz(k+1)) / ( (dz(k) - dz(k-1)) * (dz(k+1) - dz(k-1)) ) + & + (f(k, i, j+1) - f(k, i, j-1)) * (dz(k+1) + dz(k-1) - 2*dz(k)) / ( (dz(k) - dz(k-1)) * (dz(k+1) - dz(k)) ) + & + (f(k+1, i, j+1) - f(k+1, i, j-1)) * (dz(k) - dz(k-1)) / ( (dz(k+1) - dz(k)) * (dz(k+1) - dz(k-1)) ) ) + end function d2fdyz_3d + +!---------------------------------------------------------------------------- + + !> Computes derivative with respect to z at a given point + !> where the Z axis uses an irregular grid defined by \ittext{deltas}. + + function d2fdz2_3d_irregular(f, i, j, k, deltas) + implicit none + real(dp), dimension(:,:,:), intent(in) :: f + integer, intent(in) :: i,j,k + real(dp), dimension(:), intent(in) :: deltas + real(dp) :: d2fdz2_3d_irregular + real(dp) :: zkMinusZkp1, zkMinusZkm1, zkp1MinusZkm1, zkp1MinusZk + + zkMinusZkp1 = deltas(k) - deltas(k+1) + zkMinusZkm1 = deltas(k) - deltas(k-1) + zkp1MinusZkm1 = deltas(k+1) - deltas(k-1) + zkp1MinusZk = -1 * zkMinusZkp1 + + + d2fdz2_3d_irregular = 2.d0 * f(k-1, i, j) / (zkMinusZkm1 * zkp1MinusZkm1) - & + 2.d0 * f(k, i, j) / (zkp1MinusZk * zkMinusZkm1) + & + 2.d0 * f(k+1, i, j) / (zkp1Minuszk * zkp1MinusZkm1) + end function d2fdz2_3d_irregular + +!--------------------------------------------------------------------------------- + +end module glam_grid_operators + +!---------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glam_strs2.F90 b/components/cism/glimmer-cism/libglide/glam_strs2.F90 new file mode 100644 index 0000000000..d621304b71 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glam_strs2.F90 @@ -0,0 +1,6571 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glam_strs2.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! 3d velocity calculation based on Blatter/Pattyn, 1st-order equations, by Tony Payne (Univ. +! of Bristol) and Steve Price (Univ. of Bristol / Los Alamos Nat. Lab.). Boundary conditions +! available include periodic (lateral), free surface, zero slip at bed, specified basal +! traction at bed, and specified basal yield stress at bed (all three of which are implemented +! through various verions of the specified traction b.c.) +! include macros for glide mask definitions +#include "glide_mask.inc" +#include "config.inc" + +!NOTE - Get rid of the globalIDs option. +! Make it the default for Trilinos, else not used. + +!GlobalIDs are for distributed TRILINOS variable IDs +#ifdef TRILINOS +#define globalIDs +#endif + +!NOTE: In this module there are chunks of code that are used more than once, for Picard as well as JFNK. +! It would be better to combine these chunks of code into subroutines that can be called +! from multiple places in the code--or even better, to remove the extra chunks of code +! if they are no longer needed. +! KJE looked into creating a generic initialization solver routine but most of init is passing +! variables, so its not worth it IMHO + +!*********************************************************************** +module glam_strs2 +!*********************************************************************** + +use iso_c_binding +use glimmer_paramets, only : dp +use glimmer_physcon, only : gn, rhoi, rhoo, grav, pi, scyr + +use glimmer_paramets, only : thk0, len0, vel0, vis0, tim0, evs0, tau0 + +use glimmer_log, only : write_log +use glide_mask +use glimmer_sparse_type +use glimmer_sparse +use glide_types + +implicit none + + logical, save :: lateralboundry = .false. + integer, dimension(6), save :: loc_latbc + + real(dp), allocatable, dimension(:,:,:), save :: flwafact + real(dp), allocatable, dimension(:), save :: dups + real(dp), allocatable, dimension(:,:,:,:,:), save :: corr + real(dp), allocatable, dimension(:,:,:,:), save :: usav + real(dp), dimension(2), save :: usav_avg + real(dp), allocatable, dimension(:,:,:), save :: tvel + real(dp), allocatable, dimension(:), save :: dup, dupm + + integer, dimension(:,:), allocatable :: uindx + + ! regularization constant for eff. strain rate to avoid infinite visc. + ! NOTE: would be good to explore how small this really needs to be, as + ! code converges much better when this value is made larger. + + !SCALING - This corresponds to an effective min strain rate of 1.0d-20 s^(-1). + real(dp), parameter :: effstrminsq = (1.0d-20 * tim0)**2 + real(dp) :: homotopy = 0.d0 + + real(dp) :: p1, p2, p3 ! variants of Glen's "n" (e.g. n, (1-n)/n) + real(dp) :: dew2, dns2, dew4, dns4 + + ! combinations of coeffs. used in momentum balance calcs + real(dp) :: cdxdy + real(dp), dimension(2) :: cdxdx + real(dp), dimension(:), allocatable :: cdsds, cds + real(dp), dimension(:), allocatable :: cvert, fvert + real(dp), dimension(:,:), allocatable :: cdsdx + + real(dp), dimension(:), allocatable :: dsigmadew, dsigmadns + real(dp), dimension(:), allocatable :: d2sigmadew2, d2sigmadns2, d2sigmadewdns + real(dp) :: d2sigmadewdsigma, d2sigmadnsdsigma + + ! vectors of coeffs. used for switching symmetric solution subroutines between calc. + ! of x-comp of vel or y-comp of vel + real(dp), dimension(2), parameter :: & + oneorfour = (/ 1.d0, 4.d0 /), & + fourorone = (/ 4.d0, 1.d0 /), & + oneortwo = (/ 1.d0, 2.d0 /), & + twoorone = (/ 2.d0, 1.d0 /) + + real(dp), allocatable, dimension(:,:,:), save :: ughost + real(dp), allocatable, dimension(:,:,:), save :: vghost + + ! coeff. for forward differencing template, used for stress bcs at lateral boundaries + real(dp), dimension(3), parameter :: & + onesideddiff = (/ -3.d0, 4.d0, -1.d0 /) + + ! geometric 2nd and cross-derivs + real(dp), dimension(:,:), allocatable :: & + d2thckdew2, d2usrfdew2, d2thckdns2, d2usrfdns2, d2thckdewdns, d2usrfdewdns + + real(dp), dimension(:,:,:,:), allocatable :: ghostbvel + + ! variables for use in sparse matrix calculation + real(dp), dimension(:), allocatable :: pcgval, rhsd, rhsx + integer, dimension(:), allocatable :: pcgcol, pcgrow + integer, dimension(2) :: pcgsize + integer :: ct_nonzero ! number of nonzero matrix entries + +!*SFP* NOTE: these redefined here so that they are "in scope" and can avoid being passed as args + integer :: whatsparse ! needed for putpgcg() + integer :: nonlinear ! flag for indicating type of nonlinar iteration (Picard vs. JFNK) + + logical, save :: inisoln = .false. ! true only if a converged solution (velocity fields) exists + + real(dp) :: linearSolveTime = 0.d0 + real(dp) :: totalLinearSolveTime = 0.d0 ! total linear solve time + + ! AGS: partition information for distributed solves + ! JEFF: Moved to module-level scope for globalIDs + integer, allocatable, dimension(:) :: myIndices + real(dp), allocatable, dimension(:) :: myX, myY, myZ + integer, allocatable, dimension(:,:,:) :: loc2_array + integer :: mySize = -1 + + ! JEFF: Debugging Output Variables + integer :: overallloop = 1 + +!*********************************************************************** + +contains + +!*********************************************************************** + +! WJS: The following routine doesn't compile on gnu; commenting it out for now +! subroutine dumpvels(name, uvel, vvel) +! !JEFF routine to track the uvel and vvel calculations in Picard Iteration for debugging +! !3/28/11 +! use parallel +! implicit none + +! character(*) :: name +! real(dp), dimension(:,:,:), intent(inout) :: uvel, vvel ! horiz vel components: u(z), v(z) + +! if (distributed_execution()) then +! if (this_rank == 0) then +! write(*,*) name, "Proc 0 uvel & vvel (1,7:8,16:17)", uvel(1,7:8,16:17), vvel(1,7:8,16:17) +! else +! write(*,*) name, "Proc 1 uvel & vvel (1,7:8,0:1)", uvel(1,7:8,0:1), vvel(1,7:8,0:1) +! endif +! else +! write(*,*) name, "Parallel uvel & vvel (1,5:6,15:16)", uvel(1,5:6,15:16), vvel(1,5:6,15:16) +! endif +! end subroutine dumpvels + + +subroutine glam_velo_init( ewn, nsn, upn, & + dew, dns, & + sigma) + + ! Allocate arrays and initialize variables. + implicit none + + integer, intent(in) :: ewn, nsn, upn + real(dp), intent(in) :: dew, dns + + real(dp), dimension(:), intent(in) :: sigma + + integer :: up + + allocate( dup(upn) ) + allocate( dupm(upn) ) + allocate( cvert(upn) ) + allocate( cdsdx(upn,2) ) + allocate( cdsds(upn) ) + allocate( cds(upn) ) + allocate( fvert(upn) ) + allocate(ughost(2,ewn-1,nsn-1)) + allocate(vghost(2,ewn-1,nsn-1)) + + ! NOTE: "dup", the sigma coordinate spacing is defined as a vector to allow it to + ! be read in from file for use with non-constant vertical grid spacing. Currently, this + ! is not working, so the code will not give accurate results if the sigma coordinate is + ! not regularly spaced. + dup = (/ ( (sigma(2)-sigma(1)), up = 1, upn) /) + dupm = - 0.25d0 / dup + + ! p1 = -1/n - used with rate factor in eff. visc. def. + ! p2 = (1-n)/2n - used with eff. strain rate in eff. visc. def. + ! p3 = (1-n)/n !NOTE - Remove p3? It is never used. + + p1 = -1.d0 / real(gn,dp) + p2 = (1.d0 - real(gn,dp)) / (2.d0 * real(gn,dp)) + p3 = (1.d0 - real(gn,dp)) / real(gn,dp) + + dew2 = 2.d0 * dew; dns2 = 2.d0 * dns ! 2x the standard grid spacing + dew4 = 4.d0 * dew; dns4 = 4.d0 * dns ! 4x the standard grid spacing + + allocate(dsigmadew(upn), dsigmadns(upn)) + allocate(d2sigmadew2(upn),d2sigmadns2(upn),d2sigmadewdns(upn)) + + allocate (d2thckdew2(ewn-1,nsn-1),d2thckdns2(ewn-1,nsn-1),d2thckdewdns(ewn-1,nsn-1), & + d2usrfdew2(ewn-1,nsn-1),d2usrfdns2(ewn-1,nsn-1),d2usrfdewdns(ewn-1,nsn-1)) + + allocate(flwafact(1:upn-1,ewn,nsn)) ! NOTE: the vert dim here must agree w/ that of 'efvs' + + allocate(dups(upn)) + + allocate(ghostbvel(2,3,ewn-1,nsn-1)) !! for saving the fictious basal vels at the bed !! + + ghostbvel(:,:,:,:) = 0.d0 + + flwafact = 0.d0 + + ! define constants used in various FD calculations associated with the + ! subroutine 'findcoefst' + call calccoeffsinit(upn, dew, dns) + + dups = (/ (sigma(up+1) - sigma(up), up=1,upn-1), 0.d0 /) + +end subroutine glam_velo_init + + +!*********************************************************************** + +! This is the driver subroutine, called from subroutine glissade_velo_driver in +! module glissade_velo.F90. + +subroutine glam_velo_solver(ewn, nsn, upn, & + dew, dns, & + sigma, stagsigma, & + thck, usrf, & + lsrf, topg, & + dthckdew, dthckdns, & + dusrfdew, dusrfdns, & + dlsrfdew, dlsrfdns, & + stagthck, flwa, & + btraction, & + umask, & + whichbabc, & + whichefvs, & + whichresid, & + whichnonlinear, & + whichsparse, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + uvel, vvel, & + uflx, vflx, & + efvs ) + + use parallel + use glimmer_paramets, only: GLC_DEBUG + + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(inout) :: umask + + !NOTE - Make umask intent in? + ! NOTE: 'inout' status to 'umask' should be changed to 'in' at some point, + ! but for now this allows for some minor internal hacks to CISM-defined mask + + real(dp), intent(in) :: dew, dns + + real(dp), dimension(:), intent(in) :: sigma, stagsigma ! sigma coords + real(dp), dimension(:,:), intent(in) :: thck, usrf, lsrf, topg ! geom vars + real(dp), dimension(:,:), intent(in) :: dthckdew, dthckdns ! thick grads + real(dp), dimension(:,:), intent(in) :: dusrfdew, dusrfdns ! upper surf grads + real(dp), dimension(:,:), intent(in) :: dlsrfdew, dlsrfdns ! basal surf grads + real(dp), dimension(:,:), intent(in) :: stagthck ! staggered thickness + real(dp), dimension(:,:,:), intent(inout) :: btraction ! consistent basal traction array + real(dp), dimension(:,:,:), intent(in) :: flwa ! flow law rate factor + + real(dp), dimension(:,:), intent(inout) :: beta ! basal traction coefficient, computed in calcbeta + real(dp), dimension(:,:), intent(in) :: mintauf ! specified basal yield stress, used in calcbeta (if specified in config file) + real(dp), intent(in) :: beta_const ! spatially uniform beta (Pa yr/m) + real(dp), intent(in), dimension(:,:) :: bwat ! basal water depth + type(glide_basal_physics), intent(inout) :: basal_physics ! basal physics object + + integer, intent(in) :: whichbabc ! options for beta basal boundary condition + integer, intent(in) :: whichefvs ! options for efvs calculation (calculate it or make it uniform) + integer, intent(in) :: whichresid ! options for method to use when calculating vel residul + integer, intent(in) :: whichnonlinear ! options for which method for doing elliptic solve + integer, intent(in) :: whichsparse ! options for which method for doing elliptic solve + + real(dp), dimension(:,:,:), intent(inout) :: uvel, vvel ! horiz vel components: u(z), v(z) + real(dp), dimension(:,:), intent(out) :: uflx, vflx ! horiz fluxs: u_bar*H, v_bar*H + real(dp), dimension(:,:,:), intent(out) :: efvs ! effective viscosity + + integer :: ew, ns, up ! counters for horiz and vert do loops + + real(dp), parameter :: minres = 1.0d-4 ! assume vel fields converged below this resid + real(dp), parameter :: NL_tol = 1.0d-6 ! to have same criterion than with JFNK + real(dp), save, dimension(2) :: resid ! vector for storing u resid and v resid + + integer, parameter :: cmax = 100 ! max no. of iterations + integer :: counter, linit ! iteration counter, ??? + character(len=100) :: message ! error message + + ! variables used for incorporating generic wrapper to sparse solver + type(sparse_matrix_type) :: matrix + real(dp), dimension(:), allocatable :: answer, uk_1, vk_1, F + real(dp) :: err, L2norm, L2square, NL_target + integer :: iter, pic + integer , dimension(:), allocatable :: g_flag ! jfl flag for ghost cells + + ! variables for when to stop outer loop when using Picard for nonlinear iteration + real(dp) :: outer_it_criterion, outer_it_target + + ! variables for debugging output JEFF + character(3) :: loopnum + character(3) :: looptime + real(dp) :: multiplier + + call t_startf("PICARD_pre") + ! RN_20100125: assigning value for whatsparse, which is needed for putpcgc() +!NOTE - Can we get rid of whatsparse and use only whichsparse? + whatsparse = whichsparse + + ! assign value for nonlinear iteration flag + nonlinear = whichnonlinear + +!NOTE - Note: d2usrfdew2 and d2usrfdns2 are needed at all locally owned velocity points. +! I am not sure where and why the upwind 2nd derivatives are computed. +!NOTE MJH These 2nd derivatives are already calculated in subroutine geometry_derivs(model) in glide_thck. +!These calls could either be deleted and just use those previous calculations, or possibly use that module here. +!First it needs to be determined that they are making the same (or not) calculation! + + ! calc geometric 2nd deriv. for generic input variable 'ipvr', returns 'opvr' + call geom2ders(ewn, nsn, dew, dns, usrf, stagthck, d2usrfdew2, d2usrfdns2) + call geom2ders(ewn, nsn, dew, dns, thck, stagthck, d2thckdew2, d2thckdns2) + + ! calc geometric 2nd cross-deriv. for generic input variable 'ipvr', returns 'opvr' + call geom2derscros(ewn, nsn, dew, dns, thck, stagthck, d2thckdewdns) + call geom2derscros(ewn, nsn, dew, dns, usrf, stagthck, d2usrfdewdns) + + allocate(uindx(ewn-1,nsn-1)) + + ! If a point from the 2d array 'mask' is associated with a non-zero ice thickness + ! assign it a unique number. If not assign a zero. + uindx = indxvelostr(ewn, nsn, upn, umask,pcgsize(1)) + +!!!!!!!!!! Boundary conditions HACKS section !!!!!!!!!!!!! + +!NOTE - Remove this commented-out code if no longer needed. + +!! A hack of the boundary condition mask needed for the Ross Ice Shelf exp. +!! The quick check of whether or not this is the Ross experiment is to look +!! at the domain size. +! if( ewn == 151 .and. nsn == 115 )then +! call not_parallel(__FILE__, __LINE__) +! do ns=1,nsn-1; do ew=1,ewn-1 +! if( umask(ew,ns) == 21 .or. umask(ew,ns) == 5 )then +! umask(ew,ns) = 73 +! endif +! end do; end do +! end if + +!! hack for basal processes submodel test case, to avoid floatation at downstream +!! end yet still allow for application of a floating ice bc there +! do ns=1,nsn-1; do ew=1,ewn-1 +! if( umask(ew,ns) == 37 )then +! umask(ew,ns) = 41 +! endif +! end do; end do + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! allocate space for storing temporary across-flow comp of velocity + allocate(tvel(upn,ewn-1,nsn-1)) + tvel = 0.d0 + + ! allocate space for variables used by 'mindcrash' function (unstable manifold correction) + allocate(corr(upn,ewn-1,nsn-1,2,2),usav(upn,ewn-1,nsn-1,2)) + ! and initialize them + corr = 0.d0 + usav = 0.d0 + + ! make an initial guess at the size of the sparse matrix + pcgsize(2) = pcgsize(1) * 20 + +!============================================================================== +! RN_20100129: Option to load Trilinos matrix directly bypassing sparse_easy_solve +!============================================================================== + +#ifdef TRILINOS + if (whatsparse == STANDALONE_TRILINOS_SOLVER) then + if (main_task) write(*,*) "Using GlobalIDs..." + ! JEFF: Define myIndices in terms of globalIDs + allocate(myIndices(pcgsize(1))) ! myIndices is an integer vector with a unique ID for each layer for ice grid points + allocate(myX(pcgsize(1))) ! Coordinates of nodes, used by ML preconditioner + allocate(myY(pcgsize(1))) + allocate(myZ(pcgsize(1))) + call distributed_create_partition(ewn, nsn, (upn + 2) , uindx, pcgsize(1), myIndices, myX, myY, myZ) ! Uses uindx mask to determine ice grid points. + mySize = pcgsize(1) ! Set variable for inittrilinos + + !write(*,*) "GlobalIDs myIndices..." + !write(*,*) "pcgsize = ", pcgsize(1) + !write(*,*) "myIndices = ", myIndices + !call parallel_stop(__FILE__, __LINE__) + + ! Now send this partition to Trilinos initialization routines + call inittrilinos(20, mySize, myIndices, myX, myY, myZ, comm) + + ! Set if need full solution vector returned or just owned portion + + !No Triad matrix needed in this case -- save on memory alloc + pcgsize(2) = 1 + + ! JEFF: deallocate myIndices after the solve loop, because used in translation between globalIDs and local indices + ! deallocate(myIndices) + endif +#else + if (whatsparse == STANDALONE_TRILINOS_SOLVER) then + write(*,*) 'Error: Trilinos sparse solver requires Trilinos build' + stop + endif +#endif + +!============================================================================== +! RN_20100126: End of the block +!============================================================================== + + ! allocate sparse matrix variables + allocate (pcgrow(pcgsize(2)),pcgcol(pcgsize(2)),rhsd(pcgsize(1)), & + pcgval(pcgsize(2))) + + allocate(matrix%row(pcgsize(2)), matrix%col(pcgsize(2)), & + matrix%val(pcgsize(2)), answer(pcgsize(1))) + + allocate( uk_1(pcgsize(1)), vk_1(pcgsize(1)), & + F(2*pcgsize(1)), g_flag(pcgsize(1)) ) ! jfl for res calc. + + ! set residual and iteration counter to initial values + resid = 1.d0 + counter = 1 + L2norm = 1.d20 + + ! intialize outer loop test vars + outer_it_criterion = 1.d0 + outer_it_target = 0.d0 + + if (main_task) then + ! print some info to the screen to update on iteration progress + print *, ' ' + print *, 'Running Payne/Price higher-order dynamics solver' + print *, ' ' + if( whichresid == HO_RESID_L2NORM ) then + print *, 'iter # resid (L2 norm) target resid' + else + print *, 'iter # uvel resid vvel resid target resid' + end if + print *, ' ' + endif + + call t_stopf("PICARD_pre") + ! **************************************************************************************** + ! START of Picard iteration + ! **************************************************************************************** + call t_startf("PICARD_iter") + + call ghost_preprocess( ewn, nsn, upn, uindx, ughost, vghost, & + uk_1, vk_1, uvel, vvel, g_flag) ! jfl_20100430 + + ! Picard iteration; continue iterating until resid falls below specified tolerance + ! or the max no. of iterations is exceeded + + !JEFF Guarantees at least one loop + outer_it_criterion = 1.d0 + outer_it_target = 0.d0 + + do while ( outer_it_criterion >= outer_it_target .and. counter < cmax) ! use L2 norm for resid calculation + call t_startf("PICARD_in_iter") + + ! choose outer loop stopping criterion + if( counter > 1 )then + if( whichresid == HO_RESID_L2NORM )then + outer_it_criterion = L2norm + outer_it_target = NL_target + else + outer_it_criterion = maxval(resid) + outer_it_target = minres + end if + else + outer_it_criterion = 1.d10 + outer_it_target = 1.d-12 + end if + + ! WJS: commenting out the following block, because it leads to lots of extra files, + ! which is undesirable even when GLC_DEBUG=.true. + ! if (GLC_DEBUG) then + ! !JEFF Debugging Output to see what differences in final vvel and tvel. + ! write(loopnum,'(i3.3)') counter + ! write(Looptime, '(i3.3)') overallloop + ! loopnum = trim(loopnum) ! Trying to get rid of spaces in name. + ! Looptime = trim(Looptime) + ! call distributed_print("uvela_ov"//Looptime//"_pic"//loopnum//"_tsk", uvel) + + ! call distributed_print("vvela_ov"//Looptime//"_pic"//loopnum//"_tsk", vvel) + + ! ! call dumpvels("Before findefvsstr", uvel, vvel) + + ! ! call distributed_print("preefvs_ov"//Looptime//"_pic"//loopnum//"_tsk", efvs) + ! end if + + call t_startf("PICARD_findefvsstr") + ! calc effective viscosity using previously calc vel. field + call findefvsstr(ewn, nsn, upn, & + stagsigma, counter, & + whichefvs, efvs, & + uvel, vvel, & + flwa, thck, & + dusrfdew, dthckdew, & + dusrfdns, dthckdns, & + umask) + call t_stopf("PICARD_findefvsstr") + + call t_startf("PICARD_findcoefstr1") + ! calculate coeff. for stress balance in y-direction + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 2, efvs, & + vvel, uvel, & + thck, dusrfdns, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 0 ) + call t_stopf("PICARD_findcoefstr1") + + call t_startf("PICARD_solver_pre1") + ! put vels and coeffs from 3d arrays into sparse vector format + call solver_preprocess( ewn, nsn, upn, uindx, matrix, answer, vvel ) + call t_stopf("PICARD_solver_pre1") + +!============================================================================== +! jfl 20100412: residual for v comp: Fv= A(u^k-1,v^k-1)v^k-1 - b(u^k-1,v^k-1) +!============================================================================== + + !NOTE - Is L2square summed correctly in res_vect? + !JEFF - The multiplication Ax is done across all nodes, but Ax - b is only + ! computed locally, so L2square needs to be summed. + call t_startf("PICARD_res_vect") + call res_vect( matrix, vk_1, rhsd, size(rhsd), g_flag, L2square, whichsparse ) + call t_stopf("PICARD_res_vect") + + L2norm = L2square + F(1:pcgsize(1)) = vk_1(:) + +! call output_res(ewn,nsn,upn,uindx,counter,size(vk_1),vk_1, 2) ! JFL + +!============================================================================== +! RN_20100129: Option to load Trilinos matrix directly bypassing sparse_easy_solve +!============================================================================== + + call t_startf("PICARD_solvea") + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrix, rhsd, answer, err, iter, whichsparse) +#ifdef TRILINOS + else + call solvewithtrilinos(rhsd, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime + ! write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + call t_stopf("PICARD_solvea") + +!============================================================================== +! RN_20100129: End of the block +!============================================================================== + + vk_1 = answer ! jfl for residual calculation + + ! put vels and coeffs from sparse vector format (soln) back into 3d arrays + call solver_postprocess( ewn, nsn, upn, 2, uindx, answer, tvel, ghostbvel ) + + ! NOTE: y-component of velocity that comes out is called "tvel", to differentiate it + ! from the y-vel solution from the previous iteration, which is maintained as "vvel". + ! This is necessary since we have not yet solved for the x-comp of vel, which needs the + ! old prev. guess as an input (NOT the new guess). + +! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + call t_startf("PICARD_findcoefstr2") + ! calculate coeff. for stress balance calc. in x-direction + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 1, efvs, & + uvel, vvel, & + thck, dusrfdew, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 0 ) + + call t_stopf("PICARD_findcoefstr2") + + call t_startf("PICARD_solver_pre2") + ! put vels and coeffs from 3d arrays into sparse vector format + call solver_preprocess( ewn, nsn, upn, uindx, matrix, answer, uvel ) + call t_stopf("PICARD_solver_pre2") + +!============================================================================== +! jfl 20100412: residual for u comp: Fu= C(u^k-1,v^k-1)u^k-1 - d(u^k-1,v^k-1) +!============================================================================== + + call t_startf("PICARD_res_vect") + call res_vect( matrix, uk_1, rhsd, size(rhsd), g_flag, L2square, whichsparse ) + call t_stopf("PICARD_res_vect") + + L2norm = sqrt(L2norm + L2square) + F(pcgsize(1)+1:2*pcgsize(1)) = uk_1(:) ! F = [ Fv, Fu ] + +! print *, 'L2 with/without ghost (k)= ', counter, & +! sqrt(DOT_PRODUCT(F,F)), L2norm +! if (counter <= 2) NL_target = NL_tol * L2norm +! if (counter == 1) NL_target = NL_tol * L2norm + if (counter == 1) NL_target = 1.0d-4 + +!============================================================================== +! RN_20100129: Option to load Trilinos matrix directly bypassing sparse_easy_solve +!============================================================================== + + call t_startf("PICARD_solveb") + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrix, rhsd, answer, err, iter, whichsparse) +#ifdef TRILINOS + else + call solvewithtrilinos(rhsd, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime + ! write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + call t_stopf("PICARD_solveb") + +!============================================================================== +! RN_20100129: End of the block +!============================================================================== + + uk_1 = answer ! jfl for residual calculation + + ! put vels and coeffs from sparse vector format (soln) back into 3d arrays + call solver_postprocess( ewn, nsn, upn, 1, uindx, answer, uvel, ghostbvel ) + + ! call fraction of assembly routines, passing current vel estimates (w/o manifold + ! correction!) to calculate consistent basal tractions + + call t_startf("PICARD_findcoefstr3") + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 2, efvs, & + tvel, uvel, & + thck, dusrfdns, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 1 ) + + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 1, efvs, & + uvel, tvel, & + thck, dusrfdew, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 1 ) + + call t_stopf("PICARD_findcoefstr3") + + ! apply unstable manifold correction to converged velocities + + call t_startf("PICARD_mindcrsh") + + call mindcrshstr(1,whichresid,uvel,counter,resid(1)) + + vvel = tvel + call mindcrshstr(2,whichresid,vvel,counter,resid(2)) + + call t_stopf("PICARD_mindcrsh") + +!HALO - I'm pretty sure these updates *are* needed. +! + call t_startf("PICARD_halo_upds") + ! coordinate halos for updated uvel and vvel + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + call t_stopf("PICARD_halo_upds") + + !call dumpvels("After mindcrsh", uvel, vvel) + + if (this_rank == 0) then + + !NOTE - Does this comment still apply, or is parallel_single defunct? + + ! Can't use main_task flag because main_task is true for all processors in case of parallel_single + ! output the iteration status: iteration number, max residual, and location of max residual + ! (send output to the screen or to the log file, per whichever line is commented out) + + if( whichresid == HO_RESID_L2NORM ) then + print '(i4,3g20.6)', counter, L2norm, NL_target ! Output when using L2norm for convergence + !print '(a,i4,3g20.6)', "sup-norm uvel, vvel=", counter, resid(1), resid(2), minres + !write(message,'(i4,3g20.6)') counter, L2norm, NL_target + !call write_log (message) + else + print '(i4,3g20.6)', counter, resid(1), resid(2), minres + !write(message,'(" * strs ",i3,3g20.6)') counter, resid(1), resid(2), minres + !call write_log (message) + end if + endif + + counter = counter + 1 ! advance the iteration counter + call t_stopf("PICARD_in_iter") + + end do ! while ( outer_it_criterion >= outer_it_target .and. counter < cmax) + + inisoln = .true. + + ! **************************************************************************************** + ! END of Picard iteration + ! **************************************************************************************** + call t_stopf("PICARD_iter") + + call t_startf("PICARD_post") + call ghost_postprocess( ewn, nsn, upn, uindx, uk_1, vk_1, & + ughost, vghost ) + +!NOTE - I don't think uflx and vflx are needed; they are not used by the remapping subroutine. + + do ns = 1+staggered_lhalo, size(umask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(umask,1)-staggered_uhalo + ! calc. fluxes from converged vel. fields (needed for input to thickness evolution subroutine) + if (umask(ew,ns) > 0) then + uflx(ew,ns) = vertintg(upn, sigma, uvel(:,ew,ns)) * stagthck(ew,ns) + vflx(ew,ns) = vertintg(upn, sigma, vvel(:,ew,ns)) * stagthck(ew,ns) + end if + end do + end do + + !JEFF: Coordinate halos + !JEFF: umask is marked as INOUT and is updated for the Ross Ice Shelf experiment, but for no other, so don't update halos + !JEFF: uvel, vvel, uflx, and vflx are calculated in this routine, but only for "owned" grid cells, so update halos to get neighboring values. + + !call staggered_parallel_halo(uvel) (called earlier) + !call staggered_parallel_halo(vvel) (called earlier) + +!NOTE - Do we need halo updates for btraction and efvs? +! I think we don't need an update for efvs, because it is already computed in a layer of halo cells. +! And I think we don't need an update for btraction, because it is computed in bodyset for all +! locally owned velocity points. + + call parallel_halo(efvs) + call staggered_parallel_halo(btraction) + + !NOTE - Pretty sure we don't need these updates; uflx and vflx are not used elsewhere. + call staggered_parallel_halo(uflx) + call staggered_parallel_halo(vflx) + + if (GLC_DEBUG) then + !JEFF Debugging Output to see what differences in final vvel and tvel. + ! write(CurrTimeLoopStr, '(i3.3)') CurrTimeLoop + ! call distributed_print("uvel_post_ov"//CurrTimeLoopStr//"_tsk", uvel) + ! + ! call distributed_print("vvel_post_ov"//CurrTimeLoopStr//"_tsk", vvel) + end if + + ! JEFF: Deallocate myIndices which is used to intialize Trilinos + if (whatsparse == STANDALONE_TRILINOS_SOLVER) then + deallocate(myIndices) + deallocate(myX) + deallocate(myY) + deallocate(myZ) + endif + + ! de-allocation sparse matrix solution variables + deallocate(tvel) + deallocate(uindx,corr,usav) + deallocate(pcgval,pcgrow,pcgcol,rhsd) + deallocate(matrix%row, matrix%col, matrix%val) + deallocate(answer) + deallocate(uk_1, vk_1, F, g_flag) + + !JEFF Debugging output + overallloop = overallloop + 1 + call t_stopf("PICARD_post") + + return + +end subroutine glam_velo_solver + +!*********************************************************************** + +!NOTE - Remove umask from argument list; it's the same as model%geometry%stagmask + +subroutine JFNK_velo_solver (model,umask) + + use parallel + use glimmer_paramets, only: GLC_DEBUG + + use iso_c_binding + use glide_types, only : glide_global_type + + implicit none + + type(glide_global_type) ,target, intent(inout) :: model + + !NOTE - Can we make the mask intent in? + + integer, dimension(:,:), intent(inout) :: umask !*SFP* replaces the prev., internally calc. mask + ! ... 'inout' status allows for a minor alteration + ! to cism defined mask, which don't necessarily + ! associate all/any boundaries as a unique mask value. + + type(glide_global_type) ,pointer :: fptr=>NULL() + type(c_ptr) :: c_ptr_to_object + + integer(c_int) :: xk_size + real(dp), dimension(:), allocatable :: xk_1 + integer ,dimension(:) ,allocatable :: gx_flag + +! split off of derived types + +! intent(in) + integer :: ewn, nsn, upn + real(dp) :: dew, dns + + real(dp), dimension(:) ,pointer :: sigma, stagsigma + real(dp), dimension(:,:) ,pointer :: thck, usrf, lsrf, topg + real(dp), dimension(:,:) ,pointer :: dthckdew, dthckdns + real(dp), dimension(:,:) ,pointer :: dusrfdew, dusrfdns + real(dp), dimension(:,:) ,pointer :: dlsrfdew, dlsrfdns + real(dp), dimension(:,:) ,pointer :: stagthck + real(dp), dimension(:,:,:) ,pointer :: flwa + real(dp), dimension(:,:,:) ,pointer :: btraction ! consistent basal traction array + + real(dp), dimension(:,:) ,pointer :: beta ! basal traction coefficient, computed in calcbeta + real(dp) ,pointer :: beta_const ! spatially uniform beta (Pa yr/m) + real(dp), dimension(:,:) ,pointer :: mintauf ! basal yield stress used by calcbeta (if specified) + real(dp), dimension(:,:) ,pointer :: bwat ! basal water depth + type(glide_basal_physics) :: basal_physics ! basal physics object + + integer :: whichbabc + integer :: whichefvs + integer :: whichresid + integer :: whichsparse + integer :: whichnonlinear + +! intent(out) + real(dp), dimension(:,:,:) ,pointer :: uvel, vvel + real(dp), dimension(:,:) ,pointer :: uflx, vflx + real(dp), dimension(:,:,:) ,pointer :: efvs + + integer :: ew, ns, up, nele + real(dp), parameter :: NL_tol = 1.0d-6 + +! currently needed to assess whether basal traction is updated after each nonlinear iteration +! integer :: k +!NOTE: "k" is not needed in order to calculate basal traction; note that new subroutine calls +! at lines 1175 below pass in a dummy value for this variable. In the long run, we can likely remove +! this argument altogether - it was originally passed in to aid in stabilization +! of the ice shelf boundary conditions but may no longer be needed (grep for the variable "cc" within +! the subroutine "bodyset" to see where it is currently used) + + character(len=100) :: message + +!*SFP* needed to incorporate generic wrapper to solver + type(sparse_matrix_type) :: matrixA, matrixC, matrixtp, matrixAuv, matrixAvu + real(dp) :: L2norm + + call t_startf("JFNK_pre") + ewn = model%general%ewn + nsn = model%general%nsn + upn = model%general%upn + dew = model%numerics%dew + dns = model%numerics%dns + sigma => model%numerics%sigma(:) + stagsigma => model%numerics%stagsigma(:) + thck => model%geometry%thck(:,:) + usrf => model%geometry%usrf(:,:) + lsrf => model%geometry%lsrf(:,:) + topg => model%geometry%topg(:,:) + dthckdew => model%geomderv%dthckdew(:,:) + dthckdns => model%geomderv%dthckdns(:,:) + dusrfdew => model%geomderv%dusrfdew(:,:) + dusrfdns => model%geomderv%dusrfdns(:,:) + dlsrfdew => model%geomderv%dlsrfdew(:,:) + dlsrfdns => model%geomderv%dlsrfdns(:,:) + stagthck => model%geomderv%stagthck(:,:) + flwa => model%temper%flwa(:,:,:) + btraction => model%velocity%btraction(:,:,:) + whichbabc = model%options%which_ho_babc + whichefvs = model%options%which_ho_efvs + whichresid = model%options%which_ho_resid + whichsparse = model%options%which_ho_sparse + whichnonlinear = model%options%which_ho_nonlinear + + !Note: The beta passed into the solver is equal to model%velocity%beta + beta => model%velocity%beta(:,:) + beta_const => model%paramets%ho_beta_const + mintauf => model%basalproc%mintauf(:,:) + bwat => model%temper%bwat(:,:) + basal_physics = model%basal_physics + + uvel => model%velocity%uvel(:,:,:) + vvel => model%velocity%vvel(:,:,:) + uflx => model%velocity%uflx(:,:) + vflx => model%velocity%vflx(:,:) + efvs => model%stress%efvs(:,:,:) + + ! RN_20100125: assigning value for whatsparse, which is needed for putpcgc() +!NOTE - Can we use just one variable for each of these options? + whatsparse = whichsparse + nonlinear = whichnonlinear + +!NOTE - Much of the following code is a copy of code above. +! Can we get by with a single copy? I'm thinking of operations that are done once, before the iterations begin. +!NOTE MJH: can we put these derivative calculations in the diagnostic solve part where the other derivatives are calculated? + + ! *SFP* geometric 1st deriv. for generic input variable 'ipvr', + ! output as 'opvr' (includes 'upwinding' for boundary values) + call geom2ders(ewn, nsn, dew, dns, usrf, stagthck, d2usrfdew2, d2usrfdns2) + call geom2ders(ewn, nsn, dew, dns, thck, stagthck, d2thckdew2, d2thckdns2) + + ! *SFP* geometric (2nd) cross-deriv. for generic input variable 'ipvr', output as 'opvr' + call geom2derscros(ewn, nsn, dew, dns, thck, stagthck, d2thckdewdns) + call geom2derscros(ewn, nsn, dew, dns, usrf, stagthck, d2usrfdewdns) + + model%geomderv%d2thckdew2 = d2thckdew2 + model%geomderv%d2thckdns2 = d2thckdns2 + model%geomderv%d2usrfdew2 = d2usrfdew2 + model%geomderv%d2usrfdns2 = d2usrfdns2 + + ! *SFP* make a 2d array identifying if the associated point has zero thickness, + ! has non-zero thickness and is interior, or has non-zero thickness + ! and is along a boundary + + !*SFP* This subroutine has been altered from its original form (was a function, still included + ! below w/ subroutine but commented out) to allow for a tweak to the CISM calculated mask (adds + ! in an unique number for ANY arbitrary boundary, be it land, water, or simply at the edge of + ! the calculation domain). + + allocate(uindx(ewn-1,nsn-1)) + + ! *SFP* if a point from the 2d array 'mask' is associated with non-zero ice thickness, + ! either a boundary or interior point, give it a unique number. If not, give it a zero + uindx = indxvelostr(ewn, nsn, upn, umask, pcgsize(1)) + + L2norm = 1.0d20 + + ! *SFP* an initial guess at the size of the sparse matrix + pcgsize(2) = pcgsize(1) * 20 + + ! Structure to become NOX implementation for JFNK solve + xk_size=2*pcgsize(1) + +!============================================================================== +! RN_20100129: Option to load Trilinos matrix directly bypassing sparse_easy_solve +!============================================================================== + +#ifdef TRILINOS + if (whatsparse == STANDALONE_TRILINOS_SOLVER) then + if (main_task) write(*,*) "Using GlobalIDs..." + ! JEFF: Define myIndices in terms of globalIDs + allocate(myIndices(pcgsize(1))) ! myIndices is an integer vector with a unique ID for each layer for ice grid points + allocate(myX(pcgsize(1))) ! Coordinates of nodes, used by ML preconditioner + allocate(myY(pcgsize(1))) + allocate(myZ(pcgsize(1))) + call distributed_create_partition(ewn, nsn, (upn + 2) , uindx, pcgsize(1), myIndices, myX, myY, myZ) ! Uses uindx mask to determine ice grid points. + mySize = pcgsize(1) ! Set variable for inittrilinos + + if (GLC_DEBUG) then + write(*,*) "GlobalIDs myIndices..." + write(*,*) "pcgsize = ", pcgsize(1) + write(*,*) "myIndices = ", myIndices + !call parallel_stop(__FILE__, __LINE__) + end if + + call inittrilinos(25, mySize, myIndices, myX, myY, myZ, comm) !re: Why 25 not 20 for PIC? needed the mem space + + ! Triad sparse matrix not used in this case, so save on memory + pcgsize(2) = 1 + + ! JEFF: deallocate myIndices after the solve loop, because used in translation between globalIDs and local indices + ! deallocate(myIndices) + endif +#endif + +!NOTE This is the end of the block of code that is (mostly) cut and pasted from above. + +!============================================================================== +! RN_20100126: End of the block +!============================================================================== + + allocate( xk_1(2*pcgsize(1)), gx_flag(2*pcgsize(1)) ) + + ! *SFP* allocate space matrix variables + allocate (pcgrow(pcgsize(2)),pcgcol(pcgsize(2)), rhsd(pcgsize(1)), rhsx(2*pcgsize(1)), & + pcgval(pcgsize(2))) + allocate(matrixA%row(pcgsize(2)), matrixA%col(pcgsize(2)), & + matrixA%val(pcgsize(2))) + allocate(matrixC%row(pcgsize(2)), matrixC%col(pcgsize(2)), & + matrixC%val(pcgsize(2))) + allocate(matrixtp%row(pcgsize(2)), matrixtp%col(pcgsize(2)), & + matrixtp%val(pcgsize(2))) + + allocate(model%solver_data%ui(ewn-1,nsn-1) ) + allocate(model%solver_data%um(ewn-1,nsn-1) ) + allocate(model%solver_data%d2thckcross(ewn-1,nsn-1) ) + allocate(model%solver_data%d2usrfcross(ewn-1,nsn-1) ) + allocate(model%solver_data%gxf( 2*pcgsize(1) ) ) + + call assign_resid(model, uindx, umask, d2thckdewdns, d2usrfdewdns, & + pcgsize, gx_flag, matrixA, matrixC, L2norm, ewn, nsn) + + fptr => model + c_ptr_to_object = c_loc(fptr) + + call ghost_preprocess_jfnk( ewn, nsn, upn, uindx, ughost, vghost, & + xk_1, uvel, vvel, gx_flag, pcgsize(1)) ! jfl_20100430 + +if (main_task) then + print *, ' ' + print *, 'Running Payne/Price higher-order dynamics with JFNK solver' +end if + + call t_stopf("JFNK_pre") + +#ifdef TRILINOS + +!============================================================================== +! Newton loop Using Trilinos NOX. Solves F(x) = 0 for x where x = [v, u] and +! F = [Fv(u,v), Fu(u,v)] +!============================================================================== + + call t_startf("JFNK_noxinit") + call noxinit(xk_size, xk_1, comm, c_ptr_to_object) + call t_stopf("JFNK_noxinit") + + call t_startf("JFNK_noxsolve") + call noxsolve(xk_size, xk_1, c_ptr_to_object) + call t_stopf("JFNK_noxsolve") + + call t_startf("JFNK_noxfinish") + call noxfinish() + call t_stopf("JFNK_noxfinish") + +! k = 0 + +#else + +!============================================================================== +! SLAP JFNK loop: calculate F(u^k-1,v^k-1) +!============================================================================== + + call t_startf("JFNK_SLAP") + call slapsolve(xk_1, xk_size, c_ptr_to_object, NL_tol, pcgsize) + call t_stopf("JFNK_SLAP") + +! k = 1 + +#endif + + call t_startf("JFNK_post") + +! need to update these values from fptr%uvel,vvel,stagthck etc + call solver_postprocess_jfnk( ewn, nsn, upn, uindx, xk_1, vvel, uvel, ghostbvel, pcgsize(1) ) + call ghost_postprocess_jfnk( ewn, nsn, upn, uindx, xk_1, ughost, vghost, pcgsize(1) ) + + ! call fraction of assembly routines, passing current vel estimates (w/o manifold + ! correction!) to calculate consistent basal tractions + ! + ! *SFP* NOTE that if wanting to use basal tractions for the Newton method of converging on a + ! coulomb-friction basasl BC, must update basal tractions estimate at EACH nonlinear iteration. + ! In this case, the following two calls need to sit INSIDE of the do loop above. They are left + ! out here because the current implementation of NOX skips to the end of this do loop, in order + ! to skip JFs original implementation of JFNK (and jumping out of the do loop means these calls + ! are skipped if they are inside of the do loop). + ! + +! KJE this is now outside the loop of both JFNK methods (and has been for while) +! appears to be redundant, but leaving commented for a while in case an unknown issues pops up + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 2, efvs, & + vvel, uvel, & + thck, dusrfdns, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 1 ) + + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 1, efvs, & + uvel, vvel, & + thck, dusrfdew, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, umask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 1 ) + + inisoln = .true. + + if (GLC_DEBUG) then + print*,"Solution vector norm after JFNK = " ,sqrt(DOT_PRODUCT(xk_1,xk_1)) + end if + +!NOTE - The remaining code in this subroutine is cut and pasted from above. +! Can we encapsulate this repeated code in a subroutine? + +! I don't think uflx and vflux are needed. + + ! Locally owned velocity points + do ns = 1+staggered_lhalo, size(umask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(umask,1)-staggered_uhalo + ! *SFP* calc. fluxes from converged vel. fields (for input to thickness evolution subroutine) + if (umask(ew,ns) > 0) then + uflx(ew,ns) = vertintg(upn, sigma, uvel(:,ew,ns)) * stagthck(ew,ns) + vflx(ew,ns) = vertintg(upn, sigma, vvel(:,ew,ns)) * stagthck(ew,ns) + end if + end do + end do + + ! JEFF: Deallocate myIndices which is used to intialize Trilinos + if (whatsparse == STANDALONE_TRILINOS_SOLVER) then + deallocate(myIndices) + deallocate(myX) + deallocate(myY) + deallocate(myZ) + endif + + ! *SFP* de-allocation of sparse matrix solution variables + deallocate(uindx) + deallocate(pcgval,pcgrow,pcgcol,rhsd, rhsx) + deallocate(matrixA%row, matrixA%col, matrixA%val) + deallocate(matrixC%row, matrixC%col, matrixC%val) + deallocate(matrixtp%row, matrixtp%col, matrixtp%val) + deallocate(gx_flag ) + deallocate(model%solver_data%ui) + deallocate(model%solver_data%um) + deallocate(model%solver_data%d2thckcross) + deallocate(model%solver_data%d2usrfcross) + deallocate(model%solver_data%gxf) + + !PW following are needed for glam_velo_fordsiapstr - putting here until can be convinced + ! that they are not needed (or that they should be delayed until later) + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + +!NOTE - Not sure we need halo updates for efvs, btraction, uflx, vflx +! I think we do not need an update for efvs, because it is already computed in a layer of halo cells. +! And I think we don't need an update for btraction, because it is computed in bodyset for all +! locally owned velocity points. + + call parallel_halo(efvs) + call staggered_parallel_halo(btraction) + call staggered_parallel_halo(uflx) + call staggered_parallel_halo(vflx) + + call t_stopf("JFNK_post") + + return + +end subroutine JFNK_velo_solver + +!*********************************************************************** + +function indxvelostr(ewn, nsn, upn, & + mask, pointno) + + !if a point from the 2d array 'mask' is associated with non-zero ice thickness, + ! (either a boundary or interior point) give it a unique number. If not, give it a zero. + + use parallel + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, intent(in), dimension(:,:) :: mask + integer, intent(out) :: pointno + + integer :: ew, ns + integer, dimension(size(mask,1),size(mask,2)) :: indxvelostr + + pointno = 1 + + do ns = 1+staggered_lhalo, size(mask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(mask,1)-staggered_uhalo + if ( GLIDE_HAS_ICE( mask(ew,ns) ) ) then + indxvelostr(ew,ns) = pointno + pointno = pointno + 1 + else + indxvelostr(ew,ns) = 0 + end if + end do + end do + + ! add two ghost points at upper and lower boundaries (needed for sfc and basal bcs) + pointno = (pointno - 1) * (upn + 2) + + return + +end function indxvelostr + +!*********************************************************************** + +subroutine findefvsstr(ewn, nsn, upn, & + stagsigma, counter, & + whichefvs, efvs, & + uvel, vvel, & + flwa, thck, & + dusrfdew, dthckdew, & + dusrfdns, dthckdns, & + mask) + + ! calculate the effective viscosity + + use parallel + use glimmer_paramets, only: GLC_DEBUG + implicit none + + integer, intent(in) :: ewn, nsn, upn + real(dp), intent(in), dimension(:) :: stagsigma + real(dp), intent(in), dimension(:,:,:) :: uvel, vvel, flwa + real(dp), intent(inout), dimension(:,:,:) :: efvs + real(dp), intent(in), dimension(:,:) :: thck, dthckdew, dusrfdew, & + dusrfdns, dthckdns + integer, intent(in), dimension(:,:) :: mask + integer, intent(in) :: whichefvs, counter + + integer :: ew, ns, up + + real(dp), dimension(size(efvs,1)) :: effstr, ugradup, vgradup, & + ugradew, ugradns, vgradew, vgradns + + integer, dimension(2) :: mew, mns + + ! This is the factor 1/4(X0/H0)^2 in front of the term ((dv/dz)^2+(du/dz)^2) + real(dp), parameter :: f1 = 0.25d0 * (len0 / thk0)**2 + + if (counter == 1) then + + ! effstrminsq = (1.0d-20 * tim0)**2 + + if (GLC_DEBUG) then + + ! if (main_task) then + ! print *, 'nsn=', nsn + ! print *, 'ewn=', ewn + ! print *, 'uvel shape =', shape(uvel) + ! print *, 'vvel shape =', shape(vvel) + ! print *, 'thck shape =', shape(thck) + ! print *, 'efvs shape =', shape(efvs) + ! print *, 'flwafact shape =', shape(flwafact) + ! endif + + end if + +!NOTE - Can remove the 'if' becuase Glam required temp and flwa on staggered vertical grid. + + if (size(flwa,1)==upn-1) then ! temperature and flwa live on staggered vertical grid + + !Note: To avoid parallel halo calls for efvs within glam_strs2, we need to compute efvs in one layer of halo cells + ! surrounding the locally owned velocity cells. + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > 0.d0) then + ! This is the rate factor term in the expression for the eff. visc: 1/2*A^(-1/n). + ! If both temperature and eff. visc. live on a staggered grid in the vertical, then + ! no vertical averaging is needed. + flwafact(1:upn-1,ew,ns) = 0.5d0 * flwa(1:upn-1,ew,ns)**p1 + end if + + end do + end do + + else ! size(flwa,1)=upn; temperature and flwa live on unstaggered vertical grid + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > 0.d0) then + ! this is the rate factor term in the expression for the eff. visc: 1/2*A^(-1/n), + ! which is averaged to midpoints in the vertical (i.e. it lives on a staggered + ! grid in the vertical, which is the case for "efvs" as well). + forall (up = 1:upn-1) flwafact(up,ew,ns) = 0.5d0 * (sum(flwa(up:up+1,ew,ns)) / 2.d0)**p1 + end if + end do + end do + + end if ! present(flwa_vstag) + endif ! counter + + select case(whichefvs) + + case(HO_EFVS_CONSTANT) ! set the eff visc to a constant value + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > 0.d0) then + ! Steve recommends 10^6 to 10^7 Pa yr + ! ISMIP-HOM Test F requires 2336041.42829 Pa yr, so use this as the typical value + efvs(1:upn-1,ew,ns) = 2336041.42829d0 * scyr/tim0 / tau0 ! tau0 = rhoi*grav*thk0 + else + efvs(:,ew,ns) = effstrminsq ! if the point is associated w/ no ice, set to min value + endif + enddo + enddo + + case(HO_EFVS_FLOWFACT) ! set the eff visc to a value based on the flow rate factor + +! *SFP* changed default setting for linear viscosity so that the value of the rate +! factor is taken into account + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > 0.d0) then +! KJE code used to have this +! efvs(1:upn-1,ew,ns) = 0.5d0 * flwa(1:upn-1,ew,ns)**(-1.d0) + efvs(1:upn-1,ew,ns) = flwafact(1:upn-1,ew,ns) + else + efvs(:,ew,ns) = effstrminsq ! if the point is associated w/ no ice, set to min value + end if + end do + end do + + case(HO_EFVS_NONLINEAR) ! calculate eff. visc. using eff. strain rate + +!Note - This code may not work correctly if nhalo = 1. +! In that case we would need a halo update of efvs to make sure we have the correct value +! in all neighbors of locally owned velocity cells. + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > 0.d0) then + ! The hsum() is on the unstaggered grid picking up the four points. + ! Then there is a derivative in the vertical direction. + ugradup = vertideriv(upn, hsum(uvel(:,ew-1:ew,ns-1:ns)), thck(ew,ns)) + vgradup = vertideriv(upn, hsum(vvel(:,ew-1:ew,ns-1:ns)), thck(ew,ns)) + + ugradew = horizderiv(upn, stagsigma, & + sum(uvel(:,ew-1:ew,ns-1:ns),3), & + dew4, ugradup, & + sum(dusrfdew(ew-1:ew,ns-1:ns)), & + sum(dthckdew(ew-1:ew,ns-1:ns))) + + vgradew = horizderiv(upn, stagsigma, & + sum(vvel(:,ew-1:ew,ns-1:ns),3), & + dew4, vgradup, & + sum(dusrfdew(ew-1:ew,ns-1:ns)), & + sum(dthckdew(ew-1:ew,ns-1:ns))) + + ugradns = horizderiv(upn, stagsigma, & + sum(uvel(:,ew-1:ew,ns-1:ns),2), & + dns4, ugradup, & + sum(dusrfdns(ew-1:ew,ns-1:ns)), & + sum(dthckdns(ew-1:ew,ns-1:ns))) + + vgradns = horizderiv(upn, stagsigma, & + sum(vvel(:,ew-1:ew,ns-1:ns),2), & + dns4, vgradup, & + sum(dusrfdns(ew-1:ew,ns-1:ns)), & + sum(dthckdns(ew-1:ew,ns-1:ns))) + + ! "effstr" = eff. strain rate squared + effstr = ugradew**2 + vgradns**2 + ugradew*vgradns + & + 0.25d0 * (vgradew + ugradns)**2 + & +! f1 * (ugradup**2 + vgradup**2) ! make line ACTIVE for "capping" version (see note below) + f1 * (ugradup**2 + vgradup**2) + effstrminsq ! make line ACTIVE for new version + + ! ----------------------------------------------------------------------------------- + ! NOTES on capping vs. non-capping version of eff. strain rate calc. + ! ----------------------------------------------------------------------------------- + ! + ! Set eff. strain rate (squared) to some min value where it falls below some + ! threshold value, 'effstrminsq'. Commented out the old version below, which "caps" + ! the min eff strain rate (and thus the max eff visc) in favor of a version that + ! leads to a "smooth" description of eff strain rate (and eff visc). The change for + ! new version is that the value of 'effstrminsq' simply gets added in with the others + ! (e.g. how it is done in the Pattyn model). The issues w/ the capping approach are + ! discussed (w.r.t. sea ice model) in: Lemieux and Tremblay, JGR, VOL. 114, C05009, + ! doi:10.1029/2008JC005017, 2009). Long term, the capping version should probably be + ! available as a config file option or possibly removed altogether. + + ! Old "capping" scheme ! these lines must be active to use the "capping" scheme for the efvs calc +! where (effstr < effstrminsq) +! effstr = effstrminsq +! end where + + ! Note that the vert dims are explicit here, since glide_types defines this + ! field as having dims 1:upn. This is something that we'll have to decide on long-term; + ! should efvs live at cell centroids in the vert (as is assumed in this code) + ! or should we be doing some one-sided diffs at the sfc/bed boundaries so that it has vert dims + ! of upn? For now, we populate ONLY the first 1:upn-1 values of the efvs vector and leave the one + ! at upn empty (the Pattyn/Bocek/Johnson core would fill all values, 1:upn). + + ! NOTE also that efvs lives on the non-staggered grid in the horizontal. That is, in all of the + ! discretizations conducted below, efvs is explicitly averaged from the normal horiz grid onto the + ! staggered horiz grid (Thus, in the calculations, efvs is treated as if it lived on the staggered + ! horiz grid, even though it does not). + + ! Below, p2=(1-n)/2n. The 1/2 is from taking the sqr root of the squared eff. strain rate + efvs(1:upn-1,ew,ns) = flwafact(1:upn-1,ew,ns) * effstr**p2 + homotopy +! efvs(:,ew,ns) = flwafact(:,ew,ns) * effstr**p2 + + else + efvs(:,ew,ns) = effstrminsq ! if the point is associated w/ no ice, set to min value + end if + + end do ! end ew + end do ! end ns + + end select + + return +end subroutine findefvsstr + +!*********************************************************************** + +function vertideriv(upn, varb, thck) + + implicit none + + integer, intent(in) :: upn + real(dp), intent(in), dimension(:) :: varb + real(dp), intent(in) :: thck + + real(dp), dimension(size(varb)-1) :: vertideriv + !'dupm' is defined as -1/(2*del_sigma), in which case it seems like + ! there should be a '-' in front of this expression ... but note that + ! the negative sign is implicit in the fact that the vertical index + ! increases moving downward in the ice column (up=1 is the sfc, + ! up=upn is the bed). + + integer :: k + +!WHL - Rewriting to get code to run on Mac with array bounds checking +!! vertideriv(1:upn-1) = dupm * (varb(2:upn) - varb(1:upn-1)) / thck + + do k = 1, upn-1 + vertideriv(k) = dupm(k) * (varb(k+1) - varb(k)) / thck + enddo + + return + +end function vertideriv + +!*********************************************************************** + +function horizderiv(upn, stagsigma, & + varb, grid, & + dvarbdz, dusrfdx, dthckdx) + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: stagsigma + real(dp), dimension(:,:), intent(in) :: varb + real(dp), dimension(:), intent(in) :: dvarbdz + real(dp), intent(in) :: dusrfdx, dthckdx, grid + + real(dp) :: horizderiv(size(varb,1)-1) + + horizderiv = (varb(1:upn-1,2) + varb(2:upn,2) - varb(1:upn-1,1) - varb(2:upn,1)) / grid - & + dvarbdz * (dusrfdx - stagsigma * dthckdx) / 4.d0 + + return + +end function horizderiv + +!*********************************************************************** + +function getlocrange(upn, indx) + + implicit none + + integer, intent(in) :: upn + integer, intent(in) :: indx + integer, dimension(2) :: getlocrange + + getlocrange = (indx - 1) * (upn + 2) + 1 + (/ 1, upn /) + + return + +end function getlocrange + +!*********************************************************************** + +!! WHL - Testing whether this function will work for single-processor parallel runs +!! with solvers other than trilinos + +function getlocationarray(ewn, nsn, upn, mask, indxmask, return_global_IDs) +!function getlocationarray(ewn, nsn, upn, mask, indxmask) + + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: mask + integer, dimension(:,:), intent(in) :: indxmask + logical, intent(in), optional :: return_global_IDs + + integer, dimension(ewn,nsn,2) :: getlocationarray + + logical :: return_globalIDs ! set to return_global_IDs, if present + + integer :: ew, ns + integer, dimension(ewn,nsn) :: temparray + integer :: cumsum + + if (present(return_global_IDs)) then + if (return_global_IDs) then + return_globalIDs = .true. + else + return_globalIDs = .false. + endif + else + return_globalIDs = .true. + endif + +!NOTE - Make this if which_ho_sparse = 4 instead (or ifdef Trilinos?) +#ifdef globalIDs + ! Returns in (:,:,1) the global ID bases for each grid point, including + ! halos and those without ice. + ! Since the code checks elsewhere whether ice occurs at a given grid point, + ! this information is not encoded here. For the local indices (see below) + ! the mask information is used since ice-free grid points are not indexed + ! locally + +!WHL - debug +! print*, 'In getlocationarray, ifdef globalIDs' +! print*, 'return_globalIDs =', return_globalIDs + +!LOOP NOTE - Not sure if these loops are correct. +! Is the input mask on the scalar (ice) grid? +!SFP: Need to check indices here - getlocationarray should exist on the velocity grid, not the thickness (scalar) grid + +!WHL - added this conditional + + if (return_globalIDs) then + + do ns = 1,nsn + do ew = 1,ewn + getlocationarray(ew,ns,1) = parallel_globalID(ns, ew, upn + 2) ! Extra two layers for ghost layers + end do + end do + + ! Returns in (:,:,2) the local index base for each ice grid point + ! (same indices as those used in myIndices) + ! indxmask is ice mask with non-zero values for cells with ice. + ! If a point (ew,ns) doesn't have ice, then value is set to 0. + ! If a point (ew,ns) is in the halo, value is also set to 0. + ! upn+2 is the total number of vertical layers including any ghosts + ! (logic modelled after distributed_create_partition) + + ! initialize to zero (in order to set halo and ice-free cells to zero) + + getlocationarray(:,:,2) = 0 + + ! Step through indxmask, but exclude halo + + do ns = 1+staggered_lhalo, size(indxmask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(indxmask,1)-staggered_uhalo + if ( indxmask(ew,ns) /= 0 ) then + getlocationarray(ew,ns,2) = (indxmask(ew,ns) - 1) * (upn+2) + 1 + endif + end do + end do + +!NOTE - Clean this up, so we always use this procedure when solving without Trilinos. + + else ! use the procedure below under #else + + ! initialize to zero + cumsum = 0 + temparray = 0 + getlocationarray = 0 + + do ns=1+staggered_lhalo, size(mask,2)-staggered_uhalo + do ew=1+staggered_lhalo, size(mask,1)-staggered_uhalo + if ( GLIDE_HAS_ICE( mask(ew,ns) ) ) then + cumsum = cumsum + ( upn + 2 ) + getlocationarray(ew,ns,1) = cumsum + temparray(ew,ns) = upn + 2 + else + getlocationarray(ew,ns,1) = 0 + temparray(ew,ns) = 1 + end if + end do + end do + + getlocationarray(:,:,1) = ( getlocationarray(:,:,1) + 1 ) - temparray(:,:) + getlocationarray(:,:,2) = getlocationarray(:,:,1) + + endif ! return_globalIDs + +#else + + ! initialize to zero + cumsum = 0 + temparray = 0 + getlocationarray = 0 + + do ns=1+staggered_lhalo, size(mask,2)-staggered_uhalo + do ew=1+staggered_lhalo, size(mask,1)-staggered_uhalo + if ( GLIDE_HAS_ICE( mask(ew,ns) ) ) then + cumsum = cumsum + ( upn + 2 ) + getlocationarray(ew,ns,1) = cumsum + temparray(ew,ns) = upn + 2 + else + getlocationarray(ew,ns,1) = 0 + temparray(ew,ns) = 1 + end if + end do + end do + + getlocationarray(:,:,1) = ( getlocationarray(:,:,1) + 1 ) - temparray(:,:) + getlocationarray(:,:,2) = getlocationarray(:,:,1) + +#endif + + return + +end function getlocationarray + +!*********************************************************************** +!NOTE - Remove function slapsolvstr? I think it's no longer used. + +function slapsolvstr(ewn, nsn, upn, & + vel, uindx, its, answer ) + +! *sp* routine to solve Ax=b sparse matrix problem + + implicit none + + integer, intent(in) :: ewn, nsn, upn + real(dp), dimension(:,:,:), intent(in) :: vel + integer, dimension(:,:), intent(in) :: uindx + + real(dp), dimension(:), intent(out) :: answer + + real(dp), dimension(size(vel,1),size(vel,2),size(vel,3)) :: slapsolvstr + integer, intent(inout) :: its + + integer :: ew, ns + + real(dp), dimension(:), allocatable :: rwork + integer, dimension(:), allocatable :: iwork + + real(dp), parameter :: tol = 1.0d-12 + real(dp) :: err + + integer, parameter :: isym = 0, itol = 2, itmax = 100 + integer, dimension(2) :: loc + integer :: iter, ierr, mxnelt + +! ** move to values subr + + pcgsize(2) = ct_nonzero - 1 + + call ds2y(pcgsize(1),pcgsize(2),pcgrow,pcgcol,pcgval,isym) + +!** plot the matrix to check that it has the correct form +!call dcpplt(pcgsize(1),pcgsize(2),pcgrow,pcgcol,pcgval,isym,ulog) + + mxnelt = 60 * pcgsize(1); allocate(rwork(mxnelt),iwork(mxnelt)) + +!** solve the problem using the SLAP package routines +!** ------------------------------------------------- +!** n ... order of matrix a (in) +!** b ... right hand side vector (in) +!** x ... initial quess/final solution vector (in/out) +!** nelt ... number of non-zeroes in A (in) +!** ia, ja ... sparse matrix format of A (in) +!** a ... matrix held in SLAT column format (in) +!** isym ... storage method (0 is complete) (in) +!** itol ... convergence criteria (2 recommended) (in) +!** tol ... criteria for convergence (in) +!** itmax ... maximum number of iterations (in) +!** iter ... returned number of iterations (out) +!** err ... error estimate of solution (out) +!** ierr ... returned error message (0 is ok) (out) +!** iunit ... unit for error writes during iteration (0 no write) (in) +!** rwork ... workspace for SLAP routines (in) +!** mxnelt ... maximum array and vector sizes (in) +!** iwork ... workspace for SLAP routines (in) + +! *sp* initial estimate for vel. field? + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + answer(loc(1):loc(2)) = vel(:,ew,ns) + answer(loc(1)-1) = vel(1,ew,ns) + answer(loc(2)+1) = vel(upn,ew,ns) + end if + end do + end do + + call dslucs(pcgsize(1),rhsd,answer,pcgsize(2),pcgrow,pcgcol,pcgval, & + isym,itol,tol,itmax,iter,err,ierr,0,rwork,mxnelt,iwork,mxnelt) + + if (ierr /= 0) then + print *, 'pcg error ', ierr, itmax, iter, tol, err + ! stop + end if + + deallocate(rwork,iwork) + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + slapsolvstr(:,ew,ns) = answer(loc(1):loc(2)) + else + slapsolvstr(:,ew,ns) = 0.d0 + end if + end do + end do + + its = its + iter + + return + +end function slapsolvstr + +! ***************************************************************************** + +subroutine solver_preprocess( ewn, nsn, upn, uindx, matrix, answer, vel ) + + ! Puts sparse matrix variables in SLAP triad format into "matrix" derived type, + ! so that it can be passed to the generic solver wrapper, "sparse_easy_solve". + ! Takes place of the old, explicit solver interface to SLAP linear solver. + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn + real(dp), dimension(:,:,:), intent(in) :: vel + integer, dimension(:,:), intent(in) :: uindx + type(sparse_matrix_type), intent(inout) :: matrix + real(dp), dimension(:), intent(out) :: answer + + integer :: ew, ns + integer, dimension(2) :: loc + + pcgsize(2) = ct_nonzero - 1 + + matrix%order = pcgsize(1) + matrix%nonzeros = pcgsize(2) + matrix%symmetric = .false. + + matrix%row = pcgrow + matrix%col = pcgcol + matrix%val = pcgval + + ! Initial estimate for vel. field; take from 3d array and put into + ! the format of a solution vector. + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + answer(loc(1):loc(2)) = vel(:,ew,ns) + answer(loc(1)-1) = vel(1,ew,ns) + answer(loc(2)+1) = vel(upn,ew,ns) + + !JEFF Verifying Trilinos Input + ! write(*,*) "Initial answer at (", ew, ", ", ns, ") = ", answer(loc(1)-1:loc(2)+1) + end if + end do + end do + +end subroutine solver_preprocess + +!*********************************************************************** + +subroutine solver_postprocess( ewn, nsn, upn, pt, uindx, answrapped, ansunwrapped, ghostbvel ) + + ! Unwrap the vels from the solution vector and place into a 3d array. + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn, pt + integer, dimension(:,:), intent(in) :: uindx + real(dp), dimension(:), intent(in) :: answrapped + real(dp), dimension(upn,ewn-1,nsn-1), intent(out) :: ansunwrapped + real(dp), dimension(:,:,:,:), intent(inout) :: ghostbvel + + integer, dimension(2) :: loc + integer :: ew, ns + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + ansunwrapped(:,ew,ns) = answrapped(loc(1):loc(2)) + !! save the fictitious basal velocities for basal traction calculation !! + ghostbvel(pt,:,ew,ns) = answrapped( loc(2)-1:loc(2)+1 ) + else + ansunwrapped(:,ew,ns) = 0.d0 + end if + end do + end do + +end subroutine solver_postprocess + +!*********************************************************************** + +subroutine solver_postprocess_jfnk( ewn, nsn, upn, uindx, answrapped, ansunwrappedv, & + ansunwrappedu, ghostbvel, pcg1 ) + + ! Unwrap the vels from the solution vector and place into a 3d array. + use parallel + + implicit none + + integer :: pcg1 + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: uindx + real(dp), dimension(:), intent(in) :: answrapped + real(dp), dimension(upn,ewn-1,nsn-1), intent(out) :: ansunwrappedv, ansunwrappedu + real(dp), dimension(:,:,:,:), intent(inout) :: ghostbvel + + integer, dimension(2) :: loc + integer :: ew, ns + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + ansunwrappedv(:,ew,ns) = answrapped(loc(1):loc(2)) + ansunwrappedu(:,ew,ns) = answrapped(pcg1+loc(1):pcg1+loc(2)) + !! save the fictitious basal velocities for basal traction calculation !! + ghostbvel(2,:,ew,ns) = answrapped( loc(2)-1:loc(2)+1 ) + ghostbvel(1,:,ew,ns) = answrapped( pcg1+loc(2)-1:pcg1+loc(2)+1 ) + else + ansunwrappedv(:,ew,ns) = 0.d0 + ansunwrappedu(:,ew,ns) = 0.d0 + end if + end do + end do + +end subroutine solver_postprocess_jfnk + +!*********************************************************************** + +subroutine resvect_postprocess_jfnk( ewn, nsn, upn, uindx, pcg1, answrapped, ansunwrappedv, & + ansunwrappedu, ansunwrappedmag ) +! Unwrap the jfnk residual vector from the solution vector and place into a 3d array. + use parallel + + implicit none + + integer :: pcg1 + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: uindx + real(dp), dimension(:), intent(in) :: answrapped + real(dp), dimension(upn,ewn-1,nsn-1), intent(out), optional :: ansunwrappedv, ansunwrappedu, ansunwrappedmag + + integer, dimension(2) :: loc + integer :: ew, ns + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + ansunwrappedv(:,ew,ns) = answrapped(loc(1):loc(2)) + ansunwrappedu(:,ew,ns) = answrapped(pcg1+loc(1):pcg1+loc(2)) + else + ansunwrappedv(:,ew,ns) = 0.d0 + ansunwrappedu(:,ew,ns) = 0.d0 + end if + end do + end do + + ansunwrappedmag = dsqrt( ansunwrappedu**2.d0 + ansunwrappedv**2.d0 ) + +end subroutine resvect_postprocess_jfnk + +!*********************************************************************** + +subroutine form_matrix( matrix ) ! for JFNK solver + + ! Puts sparse matrix variables in SLAP triad format into "matrix" + ! derived type. Similar to solver_preprocess but does not form answer vector + + implicit none + +! integer, intent(in) :: ewn, nsn, upn + type(sparse_matrix_type), intent(inout) :: matrix + + pcgsize(2) = ct_nonzero - 1 + + matrix%order = pcgsize(1) + matrix%nonzeros = pcgsize(2) + matrix%symmetric = .false. + + matrix%row = pcgrow + matrix%col = pcgcol + matrix%val = pcgval + +end subroutine form_matrix + +!*********************************************************************** + +subroutine forcing_term ( k, L2normk_1, gamma_l ) + + ! Calculates the forcing term (i.e. the factor that multiplies the initial + ! L2 norm to determine the tolerance for the linear solve in the JFNK solver) + ! at iteration k given the L2norm at k-1 and k-2. + ! jfl, 10 Sept 2010 + + ! See eq 2.6 in S.C. Eisenstat, H.F. Walker, Choosing the forcing terms in + ! an inexact Newton method, SIAM J. Sci. Comput. 17 (1996) 16-32. + + implicit none + + integer, intent(in) :: k + real(dp), intent(in) :: L2normk_1 ! L2 norm at k-1 + real(dp), intent(out):: gamma_l + real(dp) :: gamma_ini, gamma_min, expo + real(dp), save :: L2normk_2 ! L2 norm at k-2 + + gamma_ini = 0.9d0 + gamma_min = 0.01d0 + expo = 2.d0 + + if (k == 1) then + gamma_l = gamma_ini + else + gamma_l = (L2normk_1 / L2normk_2)**expo + endif + + if (gamma_l > gamma_ini) gamma_l = gamma_ini + if (gamma_l < gamma_min) gamma_l = gamma_min + + L2normk_2 = L2normk_1 + +end subroutine forcing_term + +!*********************************************************************** + +subroutine apply_precond( matrixA, matrixC, nu1, nu2, wk1, wk2, whichsparse ) + + ! Apply preconditioner operator for JFNK solver: wk2 = P^-1 *wk1 + ! The preconditioner operator is in fact taken from the Picard solver + ! There is a splitting of the v (A matrix) and u (C matrix) equations + ! Each component is solved to a loose tolerance (as opposed to Picard) + + implicit none + + integer, intent(in) :: nu1, nu2, whichsparse + integer :: iter + type(sparse_matrix_type), intent(in) :: matrixA, matrixC + real(dp), dimension(nu2), intent(in) :: wk1 + real(dp), dimension(nu2), intent(out):: wk2 + real(dp), dimension(nu1) :: answer, vectp + real(dp) :: err + +! precondition v component + + answer = 0.d0 ! initial guess + vectp(:) = wk1(1:nu1) ! rhs for precond v + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrixA, vectp, answer, err, iter, whichsparse, nonlinear_solver = nonlinear) +#ifdef TRILINOS + else + call restoretrilinosmatrix(0); + call solvewithtrilinos(vectp, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime + write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + wk2(1:nu1) = answer(:) + +! precondition u component + + answer = 0.d0 ! initial guess + vectp(:) = wk1(nu1+1:nu2) ! rhs for precond u + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrixC, vectp, answer, err, iter, whichsparse, nonlinear_solver = nonlinear) +#ifdef TRILINOS + else + call restoretrilinosmatrix(1); + call solvewithtrilinos(vectp, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime + write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + wk2(nu1+1:nu2) = answer(:) + +end subroutine apply_precond + +!*********************************************************************** + +subroutine apply_precond_nox( wk2_nox, wk1_nox, xk_size, c_ptr_to_object ) bind(C, name='apply_precond_nox') + + ! Apply preconditioner operator for JFNK solver through NOX: wk2 = P^-1 *wk1 + ! The preconditioner operator is in fact taken from the Picard solver + ! There is a splitting of the v (A matrix) and u (C matrix) equations + ! Each component is solved to a loose tolerance (as opposed to Picard) + + implicit none + +! variables coming through from NOX + integer(c_int) ,intent(in) ,value :: xk_size + real (c_double) ,intent(in) :: wk1_nox(xk_size) + real (c_double) ,intent(out) :: wk2_nox(xk_size) + type(glide_global_type) ,pointer :: fptr=>NULL() + type(c_ptr) ,intent(inout) :: c_ptr_to_object + + integer :: nu1, nu2, whichsparse + integer :: iter + type(sparse_matrix_type) :: matrixA, matrixC + real(dp), dimension(xk_size) :: wk1 + real(dp), dimension(xk_size) :: wk2 + real(dp), allocatable, dimension(:) :: answer, vectp + real(dp) :: err + + call c_f_pointer(c_ptr_to_object,fptr) ! convert C ptr to F ptr= model + + matrixA = fptr%solver_data%matrixA + matrixC = fptr%solver_data%matrixC + whichsparse = fptr%options%which_ho_sparse + pcgsize = fptr%solver_data%pcgsize + + nu1 = pcgsize(1) + nu2 = 2*pcgsize(1) + allocate ( answer(nu1) ) + allocate ( vectp(nu1) ) + wk1 = wk1_nox + +! ID as a test +! wk2_nox = wk1 + +! precondition v component + + answer = 0.d0 ! initial guess + vectp(:) = wk1(1:nu1) ! rhs for precond v + call t_startf("nox_precond_v") + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrixA, vectp, answer, err, iter, whichsparse, nonlinear_solver = nonlinear) +#ifdef TRILINOS + else + call restoretrilinosmatrix(0); + call solvewithtrilinos(vectp, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime +! write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + call t_stopf("nox_precond_v") + wk2(1:nu1) = answer(:) + +! precondition u component + + answer = 0.d0 ! initial guess + vectp(:) = wk1(nu1+1:nu2) ! rhs for precond u + call t_startf("nox_precond_u") + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call sparse_easy_solve(matrixC, vectp, answer, err, iter, whichsparse, nonlinear_solver = nonlinear) +#ifdef TRILINOS + else + call restoretrilinosmatrix(1); + call solvewithtrilinos(vectp, answer, linearSolveTime) + totalLinearSolveTime = totalLinearSolveTime + linearSolveTime +! write(*,*) 'Total linear solve time so far', totalLinearSolveTime +#endif + endif + call t_stopf("nox_precond_u") + wk2(nu1+1:nu2) = answer(:) + + wk2_nox = wk2 + +end subroutine apply_precond_nox + +!*********************************************************************** + +subroutine reset_effstrmin (esm_factor) bind(C, name='reset_effstrmin') + use iso_c_binding + real (c_double), intent(in):: esm_factor + + ! esm_factor of 0 leads to desired target. Valid values are [0,10] +! effstrminsq = effstrminsq_target * 10.0**(2.0 * esm_factor) + + ! Homotopy parameter needs to be zero when esm_factor hits zero + if (esm_factor > 1.0d-10) then + homotopy = 10.0**( esm_factor - 9.0 ) + else + homotopy = 0.0; + endif + +end subroutine reset_effstrmin + +!*********************************************************************** + +!NOTE - There is more repeated code here. + + subroutine calc_F (xtp, F, xk_size, c_ptr_to_object, ispert) bind(C, name='calc_F') + + ! Calculates either F(x) or F(x+epsilon*vect) for the JFNK method + ! Recall that x=[v,u] + ! xtp is both vtp and utp in one vector + + use iso_c_binding + use glide_types ,only : glide_global_type + use parallel + + implicit none + + integer(c_int) ,intent(in) ,value :: xk_size +! ispert is 0 for base calculations, 1 for perturbed calculations + integer(c_int) ,intent(in) ,value :: ispert + real(c_double) ,intent(in) :: xtp(xk_size) + real(c_double) ,intent(out) :: F(xk_size) + type(glide_global_type) ,pointer :: fptr=>NULL() + type(c_ptr) ,intent(inout) :: c_ptr_to_object + + integer :: ewn, nsn, upn, counter, whichbabc, whichefvs, i + integer ,dimension(2) :: pcgsize + integer ,dimension(:) ,allocatable :: gxf ! 0 :reg cell + integer ,dimension(:,:) ,allocatable :: ui, um + real(dp) :: dew, dns + real(dp), dimension(:) ,pointer :: sigma, stagsigma + real(dp), dimension(:,:) ,pointer :: thck, dusrfdew, dthckdew, dusrfdns, dthckdns, & + dlsrfdew, dlsrfdns, stagthck, lsrf, topg + + real(dp), dimension(:,:) ,pointer :: beta, bwat, mintauf + type(glide_basal_physics) :: basal_physics + real(dp), pointer :: beta_const + + real(dp), dimension(:,:) ,pointer :: d2usrfdew2, d2thckdew2, d2usrfdns2, d2thckdns2 + real(dp), dimension(:,:,:) ,pointer :: efvs, btraction + real(dp), dimension(:,:,:) ,pointer :: uvel, vvel, flwa +! real(dp), dimension(:,:,:) ,pointer :: ures, vres, magres !! used for output of residual fields + type(sparse_matrix_type) :: matrixA, matrixC + real(dp), dimension(:) ,allocatable :: vectx + real(dp), dimension(:) ,allocatable :: vectp + + real(dp) :: L2square +! real(dp), intent(inout):: L2norm + +! real(dp) :: Ft(xk_size) !! used for output of residual fields (ures,vres,magres) + ! storage for "F" vector when using F to output residual fields for plotting (because it + ! during the process of calc. the resid. and unwrapping it and we don't want to alter the + ! actual F vector) + real(dp) :: L2norm + + call t_startf("Calc_F") + call c_f_pointer(c_ptr_to_object,fptr) ! convert C ptr to F ptr= model + + ewn = fptr%general%ewn + nsn = fptr%general%nsn + upn = fptr%general%upn + whichbabc = fptr%options%which_ho_babc + whichefvs = fptr%options%which_ho_efvs + dew = fptr%numerics%dew + dns = fptr%numerics%dns + sigma => fptr%numerics%sigma(:) + stagsigma => fptr%numerics%stagsigma(:) + thck => fptr%geometry%thck(:,:) + lsrf => fptr%geometry%lsrf(:,:) + topg => fptr%geometry%topg (:,:) + stagthck => fptr%geomderv%stagthck(:,:) + dthckdew => fptr%geomderv%dthckdew(:,:) + dthckdns => fptr%geomderv%dthckdns(:,:) + dusrfdew => fptr%geomderv%dusrfdew(:,:) + dusrfdns => fptr%geomderv%dusrfdns(:,:) + dlsrfdew => fptr%geomderv%dlsrfdew(:,:) + dlsrfdns => fptr%geomderv%dlsrfdns(:,:) + d2thckdew2 => fptr%geomderv%d2thckdew2(:,:) + d2thckdns2 => fptr%geomderv%d2thckdns2(:,:) + d2usrfdew2 => fptr%geomderv%d2usrfdew2(:,:) + d2usrfdns2 => fptr%geomderv%d2usrfdns2(:,:) + + !Note: The beta passed into the solver is equal to model%velocity%beta + beta => fptr%velocity%beta(:,:) + beta_const => fptr%paramets%ho_beta_const + mintauf => fptr%basalproc%mintauf(:,:) + bwat => fptr%temper%bwat(:,:) + basal_physics = fptr%basal_physics + +!intent (inout) terms + btraction => fptr%velocity%btraction(:,:,:) + flwa => fptr%temper%flwa(:,:,:) + efvs => fptr%stress%efvs(:,:,:) + uvel => fptr%velocity%uvel(:,:,:) + vvel => fptr%velocity%vvel(:,:,:) +! ures => fptr%velocity%ures(:,:,:) !! used for output of residual fields +! vres => fptr%velocity%vres(:,:,:) !! used for output of residual fields +! magres => fptr%velocity%magres(:,:,:) !! used for output of residual fields + L2norm = fptr%solver_data%L2norm + + allocate( ui(ewn-1,nsn-1), um(ewn-1,nsn-1) ) + ui= fptr%solver_data%ui + um = fptr%solver_data%um + + pcgsize = fptr%solver_data%pcgsize + allocate( gxf(2*pcgsize(1)) ) + + gxf = fptr%solver_data%gxf +! temporary to test JFNK - need to take out + counter = 1 + + d2usrfdewdns = fptr%solver_data%d2usrfcross + d2thckdewdns = fptr%solver_data%d2thckcross + + matrixA = fptr%solver_data%matrixA + matrixC = fptr%solver_data%matrixC + allocate( vectp( pcgsize(1)) ) + allocate( vectx(2*pcgsize(1)) ) + + call solver_postprocess_jfnk( ewn, nsn, upn, ui, & + xtp, vvel, uvel, ghostbvel, pcgsize(1) ) + + ! coordinate halos for updated uvel and vvel + call t_startf("Calc_F_uvhalo_upd") + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + call t_stopf("Calc_F_uvhalo_upd") + + call t_startf("Calc_F_findefvsstr") + call findefvsstr(ewn, nsn, upn, & + stagsigma, counter, & + whichefvs, efvs, & + uvel, vvel, & + flwa, thck, & + dusrfdew, dthckdew, & + dusrfdns, dthckdns, & + um) + call t_stopf("Calc_F_findefvsstr") + +!============================================================================== +! jfl 20100412: residual for v comp: Fv= A(utp,vtp)vtp - b(utp,vtp) +!============================================================================== + + ! *SFP* calculation of coeff. for stress balance calc. + call t_startf("Calc_F_findcoefstr1") + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 2, efvs, & + vvel, uvel, & + thck, dusrfdns, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + ui, um, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 0 ) + + call t_stopf("Calc_F_findcoefstr1") + + rhsx(1:pcgsize(1)) = rhsd ! Fv + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call t_startf("Calc_F_form_matrix1") + call form_matrix ( matrixA ) ! to get A(utp,vtp) + call t_stopf("Calc_F_form_matrix1") +#ifdef TRILINOS + else + if (ispert == 0) then + call t_startf("Calc_F_savetrilinos1") + call savetrilinosmatrix(0); + call t_stopf("Calc_F_savetrilinos1") + endif +#endif + end if + + vectp = xtp(1:pcgsize(1)) + + call t_startf("Calc_F_res_vect") + call res_vect(matrixA, vectp, rhsd, pcgsize(1), gxf, L2square, whatsparse) + call t_stopf("Calc_F_res_vect") + L2norm=L2square + + F(1:pcgsize(1)) = vectp(1:pcgsize(1)) + +!============================================================================== +! jfl 20100412: residual for u comp: Fu= C(utp,vtp)utp - d(utp,vtp) +!============================================================================== + + call t_startf("Calc_F_findcoefstr2") + + call findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + 1, efvs, & + uvel, vvel, & + thck, dusrfdew, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + ui, um, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + 0 ) + + call t_stopf("Calc_F_findcoefstr2") + + rhsx(pcgsize(1)+1:2*pcgsize(1)) = rhsd ! Fv + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + call t_startf("Calc_F_form_matrix2") + call form_matrix ( matrixC ) ! to get C(utp,vtp) + call t_stopf("Calc_F_form_matrix2") +#ifdef TRILINOS + else + if (ispert == 0) then + call t_startf("Calc_F_savetrilinos2") + call savetrilinosmatrix(1); + call t_stopf("Calc_F_savetrilinos2") + endif +#endif + end if + + vectp(1:pcgsize(1)) = xtp(pcgsize(1)+1:2*pcgsize(1)) + + call t_startf("Calc_F_res_vect") + call res_vect(matrixC, vectp, rhsd, pcgsize(1), gxf, L2square, whatsparse) + call t_stopf("Calc_F_res_vect") + L2norm = sqrt(L2norm + L2square) + + F(pcgsize(1)+1:2*pcgsize(1)) = vectp(1:pcgsize(1)) + +!NOTE: Older code that doesn't seem to be needed anymore? Note that "res_vect_jfnk" sits inside of "res_vect.F90" +! and should NOT be removed. It is still useful, as per below where it can be used during debug/perf. testing to +! output the 3d residual fields. +! +! vectx = xtp +! call res_vect_jfnk(matrixA, matrixC, vectx, rhsx, pcgsize(1), 2*pcgsize(1), gxf, L2square, whatsparse) +! L2norm = L2square +! F = vectx + + call solver_postprocess_jfnk( ewn, nsn, upn, ui, xtp, vvel, uvel, ghostbvel, pcgsize(1) ) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! This section used and active only if / for output of residual fields !! +! Ft = F !! need a temp variable to pass in here because "res_vect_jfnk" alters the value of "F" +! call res_vect_jfnk(matrixA, matrixC, Ft, rhsx, pcgsize(1), 2*pcgsize(1), gxf, L2square, whatsparse) +! call resvect_postprocess_jfnk( ewn, nsn, upn, ui, pcgsize(1), Ft, vres, ures, magres ) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + fptr%solver_data%L2norm = L2norm + fptr%solver_data%matrixA = matrixA + fptr%solver_data%matrixC = matrixC + call t_stopf("Calc_F") + +end subroutine calc_F + +!*********************************************************************** + +subroutine ghost_preprocess( ewn, nsn, upn, uindx, ughost, vghost, & + uk_1, vk_1, uvel, vvel, g_flag) + +! puts vel values in uk_1, vk_1 (including ghost values) and creates the +! ghost flag vector. uk_1, vk_1 and the ghost flag vector are used for +! the residual calculation (jfl 20100430) + + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: uindx + integer, dimension(:), intent(out) :: g_flag + real(dp), dimension(2,ewn-1,nsn-1), intent(in) ::ughost,vghost + real(dp), dimension(:,:,:), intent(in) :: uvel, vvel + real(dp), dimension(:), intent(out) :: uk_1, vk_1 + + integer :: ew, ns + integer, dimension(2) :: loc + + g_flag = 0 + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + uk_1(loc(1):loc(2)) = uvel(:,ew,ns) + uk_1(loc(1)-1) = ughost(1,ew,ns) ! ghost at top + uk_1(loc(2)+1) = ughost(2,ew,ns) ! ghost at base + + vk_1(loc(1):loc(2)) = vvel(:,ew,ns) + vk_1(loc(1)-1) = vghost(1,ew,ns) ! ghost at top + vk_1(loc(2)+1) = vghost(2,ew,ns) ! ghost at base + + g_flag(loc(1)-1) = 1 ! ghost at top + g_flag(loc(2)+1) = 2 ! ghost at base + end if + end do + end do + +end subroutine ghost_preprocess + +!*********************************************************************** + + subroutine ghost_preprocess_jfnk( ewn, nsn, upn, uindx, ughost, vghost, & + xk_1, uvel, vvel, gx_flag, pcg1) + + ! puts vel values in xk_1 (including ghost values) and creates the + ! ghost flag vector. xk_1 and the ghost flag vector are used for + ! the residual calculation (jfl 20100430), adapted to combine uk, vk (kje 20101002) + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: uindx + integer, dimension(:), intent(out) :: gx_flag + real(dp), dimension(2,ewn-1,nsn-1), intent(in) ::ughost,vghost + real(dp), dimension(:,:,:), intent(in) :: uvel, vvel + real(dp), dimension(:), intent(out) :: xk_1 + + integer :: ew, ns, pcg1 + integer, dimension(2) :: loc + + gx_flag = 0 + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + xk_1(pcg1+loc(1):pcg1+loc(2)) = uvel(:,ew,ns) + xk_1(pcg1+loc(1)-1) = ughost(1,ew,ns) ! ghost at top + xk_1(pcg1+loc(2)+1) = ughost(2,ew,ns) ! ghost at base + + xk_1(loc(1):loc(2)) = vvel(:,ew,ns) + xk_1(loc(1)-1) = vghost(1,ew,ns) ! ghost at top + xk_1(loc(2)+1) = vghost(2,ew,ns) ! ghost at base + +! independent of u and v + gx_flag(loc(1)-1) = 1 ! ghost at top + gx_flag(loc(2)+1) = 2 ! ghost at base + end if + end do + end do + + end subroutine ghost_preprocess_jfnk + +!*********************************************************************** + +subroutine ghost_postprocess( ewn, nsn, upn, uindx, uk_1, vk_1, & + ughost, vghost ) + +! puts ghost values (which are now in uk_1 and vk_1) into ughost and +! vghost so that they can be used fro the next time step (jfl 20100430) + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, dimension(:,:), intent(in) :: uindx + real(dp), dimension(:), intent(in) :: uk_1, vk_1 + real(dp), dimension(2,ewn-1,nsn-1), intent(out) :: ughost,vghost + + integer :: ew, ns + integer, dimension(2) :: loc + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + ughost(1,ew,ns) = uk_1(loc(1)-1) ! ghost at top + ughost(2,ew,ns) = uk_1(loc(2)+1) ! ghost at base + vghost(1,ew,ns) = vk_1(loc(1)-1) ! ghost at top + vghost(2,ew,ns) = vk_1(loc(2)+1) ! ghost at base + else + ughost(1,ew,ns) = 0.d0 + ughost(2,ew,ns) = 0.d0 + vghost(1,ew,ns) = 0.d0 + vghost(2,ew,ns) = 0.d0 + end if + end do + end do +end subroutine ghost_postprocess + +!*********************************************************************** + + subroutine ghost_postprocess_jfnk( ewn, nsn, upn, uindx, xk_1, & + ughost, vghost, pcg1 ) + + ! puts ghost values (which are now in uk_1 and vk_1) into ughost and + ! vghost so that they can be used fro the next time step (jfl 20100430) + ! update to use combined uk and vk = xk (kje 20101003) + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn, pcg1 + integer, dimension(:,:), intent(in) :: uindx + real(dp), dimension(:), intent(in) :: xk_1 + real(dp), dimension(2,ewn-1,nsn-1), intent(out) :: ughost,vghost + + integer :: ew, ns + integer, dimension(2) :: loc + + do ns = 1+staggered_lhalo, size(uindx,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(uindx,1)-staggered_uhalo + if (uindx(ew,ns) /= 0) then + loc = getlocrange(upn, uindx(ew,ns)) + ughost(1,ew,ns) = xk_1(pcg1+loc(1)-1) ! ghost at top + ughost(2,ew,ns) = xk_1(pcg1+loc(2)+1) ! ghost at base + vghost(1,ew,ns) = xk_1(loc(1)-1) ! ghost at top + vghost(2,ew,ns) = xk_1(loc(2)+1) ! ghost at base + else + ughost(1,ew,ns) = 0.d0 + ughost(2,ew,ns) = 0.d0 + vghost(1,ew,ns) = 0.d0 + vghost(2,ew,ns) = 0.d0 + end if + end do + end do + end subroutine ghost_postprocess_jfnk + +!*********************************************************************** + +subroutine mindcrshstr(pt,whichresid,vel,counter,resid) + + ! Function to perform 'unstable manifold correction' (see Hindmarsh and Payne, 1996, + ! "Time-step limits for stable solutions of the ice-sheet equation", Annals of + ! Glaciology, 23, p.74-85) + use parallel + use glimmer_paramets, only: GLC_DEBUG + + implicit none + + real(dp), intent(inout), dimension(:,:,:) :: vel + integer, intent(in) :: counter, pt, whichresid + + real(dp), intent(out) :: resid + +!NOTE - critlimit is never used +!NOTE - SCALING - Does 'small' need a velocity scale factor? + real(dp), parameter :: ssthres = 5.d0 * pi / 6.d0, & + critlimit = 10.d0 / (scyr * vel0), & + small = 1.0d-16 + + real(dp) :: temp_vel + + integer, dimension(2), save :: new = 1, old = 2 + !JEFF integer :: locat(3) + integer ew, ns, nr + + integer, dimension(size(vel,1),size(vel,2),size(vel,3)) :: vel_ne_0 + real(dp) :: sum_vel_ne_0 + +!WHL - debug (to print out intermediate terms in equations) +!! real(dp) :: alpha, theta + +! Note: usav and corr initialized to zero upon allocation; following probably +! not necessary, but occurs only once (per nonlinear solve) + if (counter == 1) then + usav(:,:,:,pt) = 0.d0 + corr(:,:,:,old(pt),pt) = 0.d0 + end if + + ! RESIDUAL CALCULATION + + select case (whichresid) + ! options for residual calculation method, as specified in configuration file + ! (see additional notes in "higher-order options" section of documentation) + ! case(0): use max of abs( vel_old - vel ) / vel ) + ! case(1): use max of abs( vel_old - vel ) / vel ) but ignore basal vels + ! case(2): use mean of abs( vel_old - vel ) / vel ) + ! case(3): use max of abs( vel_old - vel ) / vel ) (in addition to L2 norm calculated externally) + + case(HO_RESID_MAXU) + + ! resid = maxval( abs((usav(:,:,:,pt) - vel ) / vel ), MASK = vel /= 0.d0) + resid = 0.d0 + + do ns = 1 + staggered_lhalo, size(vel,3) - staggered_uhalo + do ew = 1 + staggered_lhalo, size(vel,2) - staggered_uhalo + do nr = 1, size(vel, 1) + if (vel(nr,ew,ns) /= 0.d0) then + resid = max(resid, abs(usav(nr,ew,ns,pt) - vel(nr,ew,ns)) / vel(nr,ew,ns)) + endif + enddo + enddo + enddo + + resid = parallel_reduce_max(resid) + !locat is only used in diagnostic print statement below. + !locat = maxloc( abs((usav(:,:,:,pt) - vel ) / vel ), MASK = vel /= 0.d0) + + case(HO_RESID_MAXU_NO_UBAS) + ! nr = size( vel, dim=1 ) ! number of grid points in vertical ... + ! resid = maxval( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), MASK = vel /= 0.d0) + resid = 0.d0 + + do ns = 1 + staggered_lhalo, size(vel,3) - staggered_uhalo + do ew = 1 + staggered_lhalo, size(vel,2) - staggered_uhalo + do nr = 1, size(vel, 1) - 1 + if (vel(nr,ew,ns) /= 0.d0) then + resid = max(resid, abs(usav(nr,ew,ns,pt) - vel(nr,ew,ns)) / vel(nr,ew,ns)) + endif + enddo + enddo + enddo + + resid = parallel_reduce_max(resid) + !locat = maxloc( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), & + ! MASK = vel /= 0.d0) + + case(HO_RESID_MEANU) + call not_parallel(__FILE__, __LINE__) + !JEFF This has not been translated to parallel. + resid = 0.d0 + nr = size( vel, dim=1 ) + vel_ne_0 = 0 + where ( vel /= 0.d0 ) vel_ne_0 = 1 + + ! include basal velocities in resid. calculation when using MEAN + ! JEFF Compute sums across nodes in order to compute mean. + resid = sum( abs((usav(:,:,:,pt) - vel ) / vel ), & + MASK = vel /= 0.d0) + + resid = parallel_reduce_sum(resid) + sum_vel_ne_0 = sum( vel_ne_0 ) + sum_vel_ne_0 = parallel_reduce_sum(sum_vel_ne_0) + + resid = resid / sum_vel_ne_0 + + ! ignore basal velocities in resid. calculation when using MEAN + ! resid = sum( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), & + ! MASK = vel /= 0.d0) / sum( vel_ne_0(1:nr-1,:,:) ) + + ! NOTE that the location of the max residual is somewhat irrelevent here + ! since we are using the mean resid for convergence testing + ! locat = maxloc( abs((usav(:,:,:,pt) - vel ) / vel ), MASK = vel /= 0.d0) + + case(HO_RESID_L2NORM) + +!! SFP - the L2norm option is handled entirely external to this subroutine. That is, if the L2norm option +!! for the residul is specified (it is currently the default), the residual is calculated as the L2norm of +!! the system residul, r = Ax - b (rather than defining the residual according to the velocity update, as +!! is done in all the parts of this subroutine). If the L2norm option is active, the value of "residual" +!! passed out of this subroutine is NOT used for determining when to halt iterations on the velocity solution. +!! The original code that was here for this option has been removed. + + end select + + if (GLC_DEBUG) then + ! Additional debugging line, useful when trying to determine if convergence is being consistently + ! help up by the residual at one or a few particular locations in the domain. + ! print '("* ",i3,g20.6,3i6,g20.6)', counter, resid, locat, vel(locat(1),locat(2),locat(3))*vel0 + end if + + ! SAVE VELOCITY AND CALCULATE CORRECTION + + corr(:,:,:,new(pt),pt) = vel(:,:,:) - usav(:,:,:,pt) ! changed + +! if (counter > 1) then +! where (acos((corr(:,:,:,new(pt),pt) * corr(:,:,:,old(pt),pt)) / & +! (abs(corr(:,:,:,new(pt),pt)) * abs(corr(:,:,:,old(pt),pt)) + small)) > & +! ssthres .and. corr(:,:,:,new(pt),pt) - corr(:,:,:,old(pt),pt) /= 0.d0 ) +! mindcrshstr = usav(:,:,:,pt) + & +! corr(:,:,:,new(pt),pt) * abs(corr(:,:,:,old(pt),pt)) / & +! abs(corr(:,:,:,new(pt),pt) - corr(:,:,:,old(pt),pt)) +!! mindcrshstr = vel; ! jfl uncomment this and comment out line above +!! ! to avoid the unstable manifold correction +! elsewhere +! mindcrshstr = vel; +! end where +! else +! mindcrshstr = vel; +! end if +! usav(:,:,:,pt) = vel +! vel = mindcrshstr + + if (counter > 1) then + + ! Replace where clause with explicit, owned variables for each processor. + + do ns = 1 + staggered_lhalo, size(vel,3) - staggered_uhalo + do ew = 1 + staggered_lhalo, size(vel,2) - staggered_uhalo + do nr = 1, size(vel, 1) + temp_vel = vel(nr,ew,ns) + + if (acos((corr(nr,ew,ns,new(pt),pt) * corr(nr,ew,ns,old(pt),pt)) / & + (abs(corr(nr,ew,ns,new(pt),pt)) * abs(corr(nr,ew,ns,old(pt),pt)) + small)) > & + ssthres .and. corr(nr,ew,ns,new(pt),pt) - corr(nr,ew,ns,old(pt),pt) /= 0.d0) then + + ! theta and alpha are intermediate terms that might be useful to print out +!! theta = acos((corr(nr,ew,ns,new(pt),pt) * corr(nr,ew,ns,old(pt),pt)) / & +!! (abs(corr(nr,ew,ns,new(pt),pt)) * abs(corr(nr,ew,ns,old(pt),pt)) + small)) + +!! alpha = abs(corr(nr,ew,ns,old(pt),pt)) / & +!! abs(corr(nr,ew,ns,new(pt),pt) - corr(nr,ew,ns,old(pt),pt)) + + vel(nr,ew,ns) = usav(nr,ew,ns,pt) + & + corr(nr,ew,ns,new(pt),pt) * abs(corr(nr,ew,ns,old(pt),pt)) / & + abs(corr(nr,ew,ns,new(pt),pt) - corr(nr,ew,ns,old(pt),pt)) + + endif + + usav(nr,ew,ns,pt) = temp_vel + enddo + enddo + enddo + else + + usav(:,:,:,pt) = vel + + end if + + ! UPDATE POINTERS + + !*SFP* Old version + ! if (new(pt) == 1) then; old(pt) = 1; new(pt) = 2; else; old(pt) = 1; new(pt) = 2; end if + + !*SFP* correction from Carl Gladdish + if (new(pt) == 1) then; old(pt) = 1; new(pt) = 2; else; old(pt) = 2; new(pt) = 1; end if + + return + +end subroutine mindcrshstr + +!*********************************************************************** + +!NOTE - There are two mindcrshstr subroutines. Remove one of them? + +function mindcrshstr2(pt,whichresid,vel,counter,resid) + + ! Function to perform 'unstable manifold correction' (see Hindmarsch and Payne, 1996, + ! "Time-step limits for stable solutions of the ice-sheet equation", Annals of + ! Glaciology, 23, p.74-85) + + ! Alternate unstable manifold scheme, based on DeSmedt, Pattyn, and De Goen, J. Glaciology 2010 + ! Written by Carl Gladdish + + use parallel ! Use of WHERE statements is causing inconsistencies on the halos in parallel. Rewrite like mindcrshstr() + implicit none + + real(dp), intent(in), dimension(:,:,:) :: vel + integer, intent(in) :: counter, pt, whichresid + real(dp), intent(out) :: resid + + real(dp), dimension(size(vel,1),size(vel,2),size(vel,3)) :: mindcrshstr2 + + integer, parameter :: start_umc = 3 + real(dp), parameter :: cvg_accel = 2.d0 + real(dp), parameter :: small = 1.0d-16 + + real(dp) in_prod, len_new, len_old, mean_rel_diff, sig_rel_diff + real(dp) :: theta + + integer, dimension(2), save :: new = 1, old = 2 + integer :: locat(3) + + integer :: nr + integer, dimension(size(vel,1),size(vel,2),size(vel,3)) :: vel_ne_0 + real(dp),dimension(size(vel,1),size(vel,2),size(vel,3)) :: rel_diff + + call not_parallel(__FILE__, __LINE__) + + if (counter == 1) then + usav(:,:,:,pt) = 0.d0 + corr(:,:,:,:,:) = 0.d0 + end if + + corr(:,:,:,new(pt),pt) = vel - usav(:,:,:,pt) + + if (counter >= start_umc) then + + in_prod = sum( corr(:,:,:,new(pt),pt) * corr(:,:,:,old(pt),pt) ) + len_new = sqrt(sum( corr(:,:,:,new(pt),pt) * corr(:,:,:,new(pt),pt) )) + len_old = sqrt(sum( corr(:,:,:,old(pt),pt) * corr(:,:,:,old(pt),pt) )) + + theta = acos( in_prod / (len_new * len_old + small) ) + + if (theta < (1.d0/8.d0)*pi) then + mindcrshstr2 = usav(:,:,:,pt) + cvg_accel * corr(:,:,:,new(pt),pt) +! print *, theta/pi, 'increased correction' + else if(theta < (19.d0/20.d0)*pi) then + mindcrshstr2 = vel +! print *, theta/pi, 'standard correction' + else + mindcrshstr2 = usav(:,:,:,pt) + (1.0/cvg_accel) * corr(:,:,:,new(pt),pt) +! print *, theta/pi, 'decreasing correction' + end if + + else + + mindcrshstr2 = vel; + ! print *, 'Not attempting adjustment to correction' + + end if + + + ! now swap slots for storing the previous correction + if (new(pt) == 1) then + old(pt) = 1; new(pt) = 2 + else + old(pt) = 2; new(pt) = 1 + end if + + if (counter == 1) then + usav_avg = 1.d0 + else + usav_avg(1) = sum( abs(usav(:,:,:,1)) ) / size(vel) ! a x-dir transport velocity scale + usav_avg(2) = sum( abs(usav(:,:,:,2)) ) / size(vel) ! a y-dir transport velocity scale + end if + +! print *, 'usav_avg(1)',usav_avg(1),'usav_avg(2)',usav_avg(2) + + select case (whichresid) + + ! options for residual calculation method, as specified in configuration file + ! (see additional notes in "higher-order options" section of documentation) + ! case(0): use max of abs( vel_old - vel ) / vel ) + ! case(1): use max of abs( vel_old - vel ) / vel ) but ignore basal vels + ! case(2): use mean of abs( vel_old - vel ) / vel ) + + case(HO_RESID_MAXU) + rel_diff = 0.d0 + vel_ne_0 = 0 + where ( mindcrshstr2 /= 0.d0 ) + vel_ne_0 = 1 + rel_diff = abs((usav(:,:,:,pt) - mindcrshstr2) / mindcrshstr2) & + * usav_avg(pt)/sqrt(sum(usav_avg ** 2.0)) + end where + + resid = maxval( rel_diff, MASK = mindcrshstr2 /= 0.d0 ) + locat = maxloc( rel_diff, MASK = mindcrshstr2 /= 0.d0 ) + +! mean_rel_diff = sum(rel_diff) / sum(vel_ne_0) +! sig_rel_diff = sqrt( sum((rel_diff - mean_rel_diff) ** 2.d0 )/ sum(vel_ne_0) ) +! print *, 'mean', mean_rel_diff, 'sig', sig_rel_diff + + !write(*,*) 'locat', locat + !call write_xls('resid1.txt',abs((usav(1,:,:,pt) - mindcrshstr2(1,:,:)) / (mindcrshstr2(1,:,:) + 1e-20))) + + case(HO_RESID_MAXU_NO_UBAS) + !**cvg*** should replace vel by mindcrshstr2 in the following lines, I belive + nr = size( vel, dim=1 ) ! number of grid points in vertical ... + resid = maxval( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), & + MASK = vel /= 0.d0) + locat = maxloc( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), & + MASK = vel /= 0.d0) + + case(HO_RESID_MEANU) + !**cvg*** should replace vel by mindcrshstr2 in the following lines, I believe + nr = size( vel, dim=1 ) + vel_ne_0 = 0 + where ( vel /= 0.d0 ) vel_ne_0 = 1 + + ! include basal velocities in resid. calculation when using MEAN + resid = sum( abs((usav(:,:,:,pt) - vel ) / vel ), & + MASK = vel /= 0.d0) / sum( vel_ne_0 ) + + ! ignore basal velocities in resid. calculation when using MEAN + ! resid = sum( abs((usav(1:nr-1,:,:,pt) - vel(1:nr-1,:,:) ) / vel(1:nr-1,:,:) ), & + ! MASK = vel /= 0.d0) / sum( vel_ne_0(1:nr-1,:,:) ) + + ! NOTE that the location of the max residual is somewhat irrelevent here + ! since we are using the mean resid for convergence testing + locat = maxloc( abs((usav(:,:,:,pt) - vel ) / vel ), MASK = vel /= 0.d0) + + end select + + usav(:,:,:,pt) = mindcrshstr2 + + ! Additional debugging line, useful when trying to determine if convergence is being consistently + ! held up by the residual at one or a few particular locations in the domain. +! print '("* ",i3,g20.6,3i6,g20.6)', counter, resid, locat, vel(locat(1),locat(2),locat(3))*vel0 + + return + +end function mindcrshstr2 + +!*********************************************************************** + +subroutine findcoefstr(ewn, nsn, upn, & + dew, dns, sigma, & + pt, efvs, & + thisvel, othervel, & + thck, thisdusrfdx, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + stagthck, whichbabc, & + uindx, mask, & + lsrf, topg, & + flwa, & + beta, & + beta_const, & + mintauf, & + bwat, & + basal_physics, & + btraction, & + assembly ) + + ! Main subroutine for determining coefficients that go into the LHS matrix A + ! in the expression Au = b. Calls numerous other subroutines, including boundary + ! condition subroutines, which determine "b". + + use glissade_basal_traction, only: calcbeta + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upn, assembly + real(dp), intent(in) :: dew, dns + real(dp), dimension(:), intent(in) :: sigma + + real(dp), dimension(:,:,:), intent(in) :: efvs, thisvel, & + othervel + real(dp), dimension(:,:), intent(in) :: stagthck, thisdusrfdx, & + dusrfdew, dthckdew, & + d2usrfdew2, d2thckdew2, & + dusrfdns, dthckdns, & + d2usrfdns2, d2thckdns2, & + d2usrfdewdns,d2thckdewdns, & + dlsrfdew, dlsrfdns, & + thck, lsrf, topg + + real(dp), dimension(:,:), intent(inout) :: beta + real(dp), dimension(:,:), intent(in) :: mintauf + real(dp), intent(in) :: beta_const ! spatially uniform beta (Pa yr/m) + real(dp), intent(in), dimension(:,:) :: bwat ! basal water depth + type(glide_basal_physics), intent(inout) :: basal_physics ! basal_physics object + + real(dp), dimension(:,:,:), intent(in) :: flwa + real(dp), dimension(:,:,:), intent(inout) :: btraction + + integer, dimension(:,:), intent(in) :: mask, uindx + integer, intent(in) :: pt, whichbabc + + real(dp), dimension(2,2,2) :: localefvs + real(dp), dimension(3,3,3) :: localothervel + real(dp), dimension(upn) :: boundaryvel + real(dp) :: flwabar + + integer, dimension(6,2) :: loc2 + integer, dimension(2) :: loc2plusup + integer, dimension(3) :: shift + integer :: ew, ns, up, up_start + + logical :: comp_bound + +!WHL - debug + integer :: i, j + + ct_nonzero = 1 ! index to count the number of non-zero entries in the sparse matrix + + if( assembly == 1 )then ! for normal assembly (assembly=0), start vert index at sfc and go to bed + up_start = upn ! for boundary traction calc (assembly=1), do matrix assembly on for equations at bed + else + up_start = 1 + end if + + ! Note loc2_array is defined only for non-halo ice grid points. + ! JEFFLOC returns an array with starting indices into solution vector for each ice grid point. + + allocate(loc2_array(ewn,nsn,2)) + +!WHL - Using a different procedure depending on whether or not we are using trilinos. +! This is needed to avoid an error when using the SLAP solver in a +! single-processor parallel run. + + loc2_array = getlocationarray(ewn, nsn, upn, mask, uindx) + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + loc2_array = getlocationarray(ewn, nsn, upn, mask, uindx, & + return_global_IDs = .false.) + else + loc2_array = getlocationarray(ewn, nsn, upn, mask, uindx) + endif + +!WHL - debug +! print*, ' ' +! print*, 'loc2_array(1)' +! do ns = nsn, 1, -1 +! write(6,'(34i6)') loc2_array(:,ns,1) +! enddo + +! print*, ' ' +! print*, 'loc2_array(2)' +! do ns = nsn, 1, -1 +! write(6,'(34i6)') loc2_array(:,ns,2) +! enddo + + ! !!!!!!!!! useful for debugging !!!!!!!!!!!!!! + ! print *, 'loc2_array = ' + ! print *, loc2_array + ! pause + + ! Note: With nhalo = 2, efvs has been computed in a layer of halo cells, + ! so we have its value in all neighbors of locally owned velocity points. + + ! Compute or prescribe the basal traction coefficient 'beta' + ! Note: The initial value of model%velocity%beta can change depending on + ! the value of model%options%which_ho_babc. + + ! Note: Arguments must be converted to dimensional units + + beta(:,:) = beta(:,:) * tau0/(vel0*scyr) ! convert to Pa yr/m + + call calcbeta (whichbabc, & + dew * len0, dns * len0, & ! m + ewn, nsn, & + thisvel(upn,:,:) * vel0*scyr, & ! m/yr + othervel(upn,:,:) * vel0*scyr, & + bwat * thk0, & ! m + beta_const * tau0/(vel0*scyr), & ! Pa yr/m + mintauf * tau0, & ! Pa + basal_physics, & + flwa(upn,:,:) * vis0*scyr, & + thck, & + mask, & + beta ) + + beta(:,:) = beta(:,:) / (tau0/(vel0*scyr)) ! convert to dimensionless + + do ns = 1+staggered_lhalo, size(mask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(mask,1)-staggered_uhalo + + !Theoretically, this should just be .false. to remove it from the if statements and let the ghost cells + !take over. However, with only one process, this give an exception error when calc_F calls savetrilinosmatrix(0). + !Therefore, it will currently revert back to the old BC's when using only one task for now. I am working to + !debug and fix this case, but for now, it does no harm for the original BC's. + +! comp_bound = ( nslb < 1 .and. ns < staggered_lhalo+1+ghost_shift ) .or. & +! ( ewlb < 1 .and. ew < staggered_lhalo+1+ghost_shift ) .or. & +! ( nsub > global_nsn .and. ns > size(mask,2)-staggered_uhalo -ghost_shift ) .or. & +! ( ewub > global_ewn .and. ew > size(mask,1)-staggered_uhalo -ghost_shift ) + + comp_bound = .false. + + ! Calculate the depth-averaged value of the rate factor, needed below when applying an ice shelf + ! boundary condition (complicated code so as not to include funny values at boundaries ... + ! ... kind of a mess and could be redone or made into a function or subroutine). + ! SUM has the definition SUM(ARRAY, DIM, MASK) where MASK is either scalar or the same shape as ARRAY + ! JEFFLOC Concerned about the edges at (ew+1, ns), (ew, ns+1), and (ew+1,ns+1) + + !SCALING - The following is OK because flwa*vis0 is equal to the dimensional flow factor. + ! The product will still equal the dimensional flow factor when vis0 = 1. + flwabar = ( sum( flwa(:,ew,ns), 1, flwa(1,ew,ns)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew,ns+1), 1, flwa(1,ew,ns+1)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew+1,ns), 1, flwa(1,ew+1,ns)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew+1,ns+1), 1, flwa(1,ew+1,ns+1)*vis0 < 1.0d-10 )/real(upn) ) / & + ( sum( flwa(:,ew,ns)/flwa(:,ew,ns), 1, flwa(1,ew,ns)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew,ns+1)/flwa(:,ew,ns+1), 1, flwa(1,ew,ns+1)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew+1,ns)/flwa(:,ew+1,ns), 1, flwa(1,ew+1,ns)*vis0 < 1.0d-10 )/real(upn) + & + sum( flwa(:,ew+1,ns+1)/flwa(:,ew+1,ns+1), 1, flwa(1,ew+1,ns+1)*vis0 < 1.0d-10 )/real(upn) ) + + loc2(1,:) = loc2_array(ew,ns,:) + + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + if ( GLIDE_HAS_ICE(mask(ew,ns)) .and. .not. & + comp_bound .and. .not. & + GLIDE_IS_MARGIN(mask(ew,ns)) .and. .not. & + GLIDE_IS_DIRICHLET_BOUNDARY(mask(ew,ns)) .and. .not. & + GLIDE_IS_CALVING(mask(ew,ns) ) .and. .not. & + GLIDE_IS_THIN(mask(ew,ns) ) ) then + ! print *, 'In main body ... ew, ns = ', ew, ns + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + call calccoeffs( upn, sigma, & + stagthck(ew,ns), & + dusrfdew(ew,ns), dusrfdns(ew,ns), & + dthckdew(ew,ns), dthckdns(ew,ns), & + d2usrfdew2(ew,ns), d2usrfdns2(ew,ns), & + d2usrfdewdns(ew,ns), & + d2thckdew2(ew,ns), d2thckdns2(ew,ns), & + d2thckdewdns(ew,ns)) + + ! get index of cardinal neighbours + loc2(2,:) = loc2_array(ew+1,ns,:) + loc2(3,:) = loc2_array(ew-1,ns,:) + loc2(4,:) = loc2_array(ew,ns+1,:) + loc2(5,:) = loc2_array(ew,ns-1,:) + + ! this loop fills coeff. for all vertical layers at index ew,ns (including sfc. and bed bcs) + do up = up_start, upn + + ! Function to adjust indices at sfc and bed so that most correct values of 'efvs' and 'othervel' + ! are passed to function. Because of the fact that efvs goes from 1:upn-1 rather than 1:upn + ! we simply use the closest values. This could probably be improved upon at some point + ! by extrapolating values for efvs at the sfc and bed using one-sided diffs, and it is not clear + ! how important this simplfication is. + !JEFFLOC indshift() returns three-element shift index for up, ew, and ns respectively. + !JEFFLOC It does get passed loc2_array, but it doesn't use it. Further, the shifts can be at most 1 unit in any direction. + + shift = indshift( 0, ew, ns, up, ewn, nsn, upn, loc2_array(:,:,1), stagthck(ew-1:ew+1,ns-1:ns+1) ) + + !HALO - Note that ew and ns below are locally owned velocity points. + !HALO - This means we need efvs in one layer of halo cells. + !JEFFLOC As long as not accessing halo ice points, then won't shift off of halo of size at least 1. + !JEFFLOC Completed scan on 11/23. Testing change of definition of loc2_array. + + call bodyset(ew, ns, up, & + ewn, nsn, upn, & + dew, dns, & + pt, loc2_array,& + loc2, stagthck, & + thisdusrfdx, & + dusrfdew, dusrfdns, & + dlsrfdew, dlsrfdns, & + efvs(up-1+shift(1):up+shift(1),ew:ew+1,ns:ns+1), & + othervel(up-1+shift(1):up+1+shift(1), & + ew-1+shift(2):ew+1+shift(2), & + ns-1+shift(3):ns+1+shift(3)), & + thisvel(up-1+shift(1):up+1+shift(1), & + ew-1+shift(2):ew+1+shift(2), & + ns-1+shift(3):ns+1+shift(3)), & + beta(ew,ns), & + btraction, & + whichbabc, assembly ) + enddo ! upn + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !NOTE - Not sure COMP_DOMAIN_BND condition is needed + elseif ( GLIDE_IS_CALVING( mask(ew,ns) ) .and. .not. & + comp_bound .and. .not. & + GLIDE_IS_DIRICHLET_BOUNDARY(mask(ew,ns)) .and. .not. & + GLIDE_IS_THIN(mask(ew,ns) ) ) then + ! print *, 'At a SHELF boundary ... ew, ns = ', ew, ns + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + call calccoeffs( upn, sigma, & + stagthck(ew,ns), & + dusrfdew(ew,ns), dusrfdns(ew,ns), & + dthckdew(ew,ns), dthckdns(ew,ns), & + d2usrfdew2(ew,ns), d2usrfdns2(ew,ns), & + d2usrfdewdns(ew,ns), & + d2thckdew2(ew,ns), d2thckdns2(ew,ns), & + d2thckdewdns(ew,ns)) + + do up = up_start, upn + + lateralboundry = .true. + shift = indshift( 1, ew, ns, up, & + ewn, nsn, upn, & + loc2_array(:,:,1), & + stagthck(ew-1:ew+1,ns-1:ns+1) ) + + call bodyset(ew, ns, up, & + ewn, nsn, upn, & + dew, dns, & + pt, loc2_array,& + loc2, stagthck, & + thisdusrfdx, & + dusrfdew, dusrfdns, & + dlsrfdew, dlsrfdns, & + efvs(up-1+shift(1):up+shift(1),ew:ew+1,ns:ns+1), & + othervel(up-1+shift(1):up+1+shift(1), & + ew-1+shift(2):ew+1+shift(2), & + ns-1+shift(3):ns+1+shift(3)), & + thisvel(up-1+shift(1):up+1+shift(1), & + ew-1+shift(2):ew+1+shift(2), & + ns-1+shift(3):ns+1+shift(3)), & + beta(ew,ns), & + btraction, & + whichbabc, assembly, & + abar=flwabar) + enddo + lateralboundry = .false. + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + !NOTE - Here we deal with cells on the computational domain boundary. + ! Currently the velocity is always set to a specified value on this boundary. + ! With open (non-Dirichlet) BCs, we might want to solve for these velocities, + ! using the code above to compute the matrix elements. + elseif ( GLIDE_HAS_ICE(mask(ew,ns)) .and. ( GLIDE_IS_DIRICHLET_BOUNDARY(mask(ew,ns)) .or. & + comp_bound ) .or. GLIDE_IS_LAND_MARGIN(mask(ew,ns)) .or. & + GLIDE_IS_THIN(mask(ew,ns)) ) then + ! print*, ' ' + ! print*, 'At a NON-SHELF boundary ... ew, ns = ', ew, ns + ! print*, 'LAND_MARGIN =', GLIDE_IS_LAND_MARGIN(mask(ew,ns)) + ! print*, 'MASK(ew,ns) =', mask(ew,ns) + ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + + ! Put specified value for vel on rhs. NOTE that this is NOT zero by default + ! unless the initial guess is zero. It will be set to whatever the initial value + ! for the vel at location up,ew,ns is in the initial array! + loc2plusup = loc2(1,:) + call valueset(0.d0, loc2plusup) + + loc2plusup = loc2(1,:) + upn + 1 + call valueset(0.d0, loc2plusup) + + do up = up_start, upn + loc2plusup = loc2(1,:) + up + call valueset( thisvel(up,ew,ns), loc2plusup ) ! vel at margin set to initial value + !call valueset( 0.d0 ) ! vel at margin set to 0 + enddo + endif + enddo ! ew + enddo ! ns + + deallocate(loc2_array) + +end subroutine findcoefstr + +!*********************************************************************** + +subroutine bodyset(ew, ns, up, & + ewn, nsn, upn, & + dew, dns, & + pt, loc2_array, & + loc2, stagthck, & + thisdusrfdx, & + dusrfdew, dusrfdns, & + dlsrfdew, dlsrfdns, & + local_efvs, & + local_othervel, & + local_thisvel, & + beta, & + btraction, & + whichbabc, assembly, & + abar) + + ! This subroutine does the bulk of the work in calling the appropriate discretiztion routines, + ! which determine the values for coefficients that will go into the sparse matrix, for points + ! on and inside of the boundaries. + + use glimmer_paramets, only: evs0, evs_scale + implicit none + + integer, intent(in) :: ewn, nsn, upn + integer, intent(in) :: ew, ns, up + real(dp), intent(in) :: dew, dns + integer, intent(in) :: pt, whichbabc, assembly + integer, dimension(ewn,nsn,2), intent(in) :: loc2_array + integer, dimension(6,2), intent(in) :: loc2 + + real(dp), dimension(:,:), intent(in) :: stagthck + real(dp), dimension(:,:), intent(in) :: dusrfdew, dusrfdns + real(dp), dimension(:,:), intent(in) :: dlsrfdew, dlsrfdns + real(dp), dimension(:,:), intent(in) :: thisdusrfdx + real(dp), dimension(2,2,2), intent(in) :: local_efvs + ! "local_othervel" is the other vel component (i.e. u when v is being calc and vice versa), + ! which is taken as a known value (terms involving it are moved to the RHS and treated as sources) + real(dp), dimension(3,3,3), intent(in) :: local_othervel, local_thisvel + real(dp), intent(in) :: beta + real(dp), dimension(:,:,:), intent(inout) :: btraction + real(dp), intent(in), optional :: abar + + ! storage space for coefficients that go w/ the discretization at the local point up, ew, ns. + ! Note that terms other than 'g' are used for storing particular parts needed for calculation + ! of the basal traction vector. + real(dp), dimension(3,3,3) :: g, h, g_cros, g_vert, g_norm, g_vel_lhs, g_vel_rhs + + ! source term for the rhs when using ice shelf lateral boundary condition, + ! e.g. source = rho*g*H/(2*Neff) * ( 1 - rho_i / rho_w ) for ice shelf + real(dp) :: source + + real(dp) :: slopex, slopey ! local sfc (or bed) slope terms + + ! lateral boundary normal and vector to indicate use of forward + ! or bacward one-sided diff. when including specified stress lateral bcs + real(dp), dimension(2) :: fwdorbwd, normal + + real(dp) :: nz ! z dir normal vector component at sfc or bed (takes diff value for each) + + integer, dimension(2) :: bcflag ! indicates choice of sfc and basal bcs ... + + real(dp) :: scalebabc + + integer, dimension(2) :: loc2plusup + + logical :: fons, foew ! true when geom. requires using 1st-order one sided diffs. at floating ice boundary + ! (default is 2nd-order, which requires larger stencil) + + loc2plusup = loc2(1,:) + up + + if( lateralboundry )then + + ! ********************************************************************************************* + ! lateral boundary conditions + + ! if at sfc or bed, source due to seawater pressure is 0 and bc normal vector + ! should contain sfc/bed slope components, e.g. (-ds/dx, -ds/dy, 1) or (db/dx, db/dy, -1) + source = 0.d0 + + call getlatboundinfo( ew, ns, up, & + ewn, nsn, upn, & + stagthck(ew-2:ew+2, ns-2:ns+2), & + loc2_array(:,:,1), fwdorbwd, normal, & + loc_latbc, foew, fons) + + if( up == 1 .or. up == upn )then + + if( up == 1 )then ! specify necessary variables and flags for free sfc + bcflag = (/1,0/) + loc2plusup = loc2(1,:) + up - 1 ! reverse the sparse matrix / rhs vector row index by 1 ... + slopex = -dusrfdew(ew,ns); slopey = -dusrfdns(ew,ns); nz = 1.d0 + else ! specify necessary variables and flags for basal bc + + if( whichbabc == HO_BABC_NO_SLIP )then + bcflag = (/0,0/) ! flag for u=v=0 at bed; doesn't work well so commented out here... + ! better to specify very large value for beta below + elseif( whichbabc == HO_BABC_CONSTANT .or. whichbabc == HO_BABC_SIMPLE .or. & + whichbabc == HO_BABC_YIELD_PICARD .or. whichbabc == HO_BABC_BETA_BWAT .or. & + whichbabc == HO_BABC_LARGE_BETA .or. whichbabc == HO_BABC_EXTERNAL_BETA .or. & + whichbabc == HO_BABC_POWERLAW .or. whichbabc == HO_BABC_COULOMB_FRICTION) then + bcflag = (/1,1/) ! flag for specififed stress at bed: Tau_zx = beta * u_bed, + ! where beta is MacAyeal-type traction parameter + end if + + loc2plusup = loc2(1,:) + up + 1 ! advance the sparse matrix / rhs row vector index by 1 ... + slopex = dlsrfdew(ew,ns); slopey = dlsrfdns(ew,ns); nz = -1.d0 + + end if + +!NOTE: conduct realistic test cases with and w/o this hack +! !! Hack to avoid bad sfc and basal bc normal vectors !! +! slopex = 0.d0; slopey = 0.d0 + + ! get coeffs. associated with horiz. normal stresses lateral boundary + g = normhorizmainbc_lat(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, 2, & + dup(up), local_efvs, & + oneorfour, fourorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) + + ! add on coeffs. associated with vertical shear stresses + g(:,3,3) = g(:,3,3) & + + vertimainbc( stagthck(ew,ns), bcflag, dup(up), & + local_efvs, beta, g_vert, nz ) + + !! scale basal bc coeffs when using JFNK solver + scalebabc = scalebasalbc( g, bcflag, lateralboundry, beta, local_efvs ) + g = g / scalebabc ! put the coeff. for the b.c. equation in the same place as the prev. equation + ! (w.r.t. cols), on a new row ... + call fillsprsebndy( g, loc2plusup(1), loc_latbc, up, normal, pt ) + + + ! get coeffs. for horiz shear stress terms, multiply by other vel and put into RHS vector + + ! NOTE that in the following expression, the "-" sign on the crosshoriz terms, + ! which results from moving them from the LHS over to the RHS, has been moved + ! inside of "croshorizmainbc_lat". + rhsd(loc2plusup(2)) = sum( croshorizmainbc_lat(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, 2, & + dup(up), local_othervel,& + local_efvs, & + oneortwo, twoorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) & + * local_othervel ) /scalebabc + + end if ! up = 1 or up = upn (IF at lateral boundary and IF at surface or bed) + + ! If in main body and at ice/ocean boundary, calculate depth-averaged stress + ! due to sea water, bc normal vector components should be boundary normal + loc2plusup = loc2(1,:) + up + + ! for this bc, the normal vector components are not the sfc/bed slopes but are taken + ! from a normal to the shelf front in map view (x,y plane); slopex,slopey are simply renamed here + slopex = normal(1) + slopey = normal(2) + + ! There are two options here for the source term associated with the boundary condition for + ! floating ice: + ! + ! (1) use the 1d solution that involves the rate factor (not accurate for + ! 3d domains, but can be more robust and stable) + ! (2) use the more general solution that involves the eff. visc. and normal + ! vector orientation at lateral boundary + ! + ! Only one of these options should be active at a time (i.e. comment the other lines out) + ! The default setting is (2), which is the more general case that should also work for 1d problems. + + ! In some cases, the two options can be used together to improve performance, e.g. for the Ross + ! ice shelf experiment, a number of early iterations could use the more simple bc (option 1) and then + ! when the solution has converged a bit, we switch to the more realistic implementation (option 2). + ! This has the advantage of "conditioning" the eff. visc. in the source term a bit before turning + ! the source term dependence on the eff. visc. "on". + + ! NOTE that the newer sfc, basal, and lateral bc subroutines keep the eff. visc. terms with the LHS + ! matrix coeffs. In this case, they do not have any affect on the source term for floating ice bcs + ! and the considerations in the above paragraph do not apply (w.r.t. adversely affecting the source term). + +! ! -------------------------------------------------------------------------------------- +! ! (1) source term (strain rate at shelf/ocean boundary) from Weertman's analytical solution +! ! This is primarily of use for debugging purposes, e.g. when a 1d test case is run. Also useful +! ! if one wants to turn "off" the eff. visc. dependence in the matrix coeffs. that go with this +! ! boundary condition, since this form of it has no eff. visc. terms. +! ! -------------------------------------------------------------------------------------- +! ! See eq. 2, Pattyn+, 2006, JGR v.111; eq. 8, Vieli&Payne, 2005, JGR v.110). Note that this +! ! contains the 1d assumption that ice is not spreading lateraly !(assumes dv/dy = 0 for u along flow) +! +! source = abar * vis0 * ( 1.d0/4.d0 * rhoi * grav * stagthck(ew,ns)*thk0 * ( 1.d0 - rhoi/rhoo))**3.d0 +! +! ! multiply by 4 so that case where v=0, du/dy = 0, LHS gives: du/dx = du/dx|_shelf +! ! (i.e. LHS = 4*du/dx, requires 4*du/dx_shelf) +! source = source * 4.d0 +! +! ! split source based on the boundary normal orientation and non-dimensinoalize +! ! Note that it is not really appropriate to apply option (1) to 2d flow, since terms other than du/dx in +! ! eff. strain rate are ignored. For 2d flow, should use option (2) below. +! source = source * normal(pt) +! source = source * tim0 ! make source term non-dim +! ! -------------------------------------------------------------------------------------- + + ! -------------------------------------------------------------------------------------- + ! (2) source term (strain rate at shelf/ocean boundary) from MacAyeal depth-ave solution. + ! -------------------------------------------------------------------------------------- + + source = (rhoi*grav*stagthck(ew,ns)*thk0) / tau0 / 2.d0 * ( 1.d0 - rhoi / rhoo ) + + source = source * normal(pt) ! partition according to normal vector at lateral boundary + ! NOTE that source term is already non-dim here + ! -------------------------------------------------------------------------------------- + + ! get matrix coefficients that go with horiz normal stresses at a floating ice boundary + g = normhorizmainbc_lat(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, 1, & + dup(up), local_efvs, & + oneorfour, fourorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) + + ! NOTE that for lateral floating ice boundary, we assume u_sfc ~ u_bed and stress free bc + ! at both upper and lower sfc boundaries, so that there are no coeffs. for vert. shear stresses + + ! put the coeff. for the b.c. equation in the same place as the prev. equation + ! (w.r.t. cols), on a new row ... + +!NOTE: is above comment correct or is this now just a normal scatter of coeffs. into the matrix? + call fillsprsebndy( g, loc2plusup(1), loc_latbc, up, normal, pt ) + + + ! get matrix coefficients that go with the horiz shear stresses at a floating ice + ! boundary, multiply by their respective "other" velocity and put into RHS vector + + ! NOTE that in the following expression, the "-" sign on the crosshoriz terms, + ! which results from moving them from the LHS over to the RHS, has been moved + ! inside of "croshorizmainbc_lat". + rhsd(loc2plusup(2)) = sum( croshorizmainbc_lat(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, 1, & + dup(up), local_othervel, & + local_efvs, & + oneortwo, twoorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) & + * local_othervel ) + source + + else ! NOT at a lateral boundary + +! ********************************************************************************************* +! normal discretization for points inside of lateral boundary and inside main body of ice sheet + + ! This if construct skips the normal discretization for the RHS and LHS for the sfc and basal indices + ! because these vertical levels are handled by different subroutines. + if( up /= upn .and. up /= 1 )then + + g = normhorizmain(pt,up,local_efvs) ! normal stress grad coeffs + + g(:,2,2) = g(:,2,2) + vertimain(hsum(local_efvs),up) ! add vert stress grad coeffs + + ! NOTE that version of 'fillspremain' for one-sided bcs needs additional argument to specify a + ! column shift of coeffs. of rows in LHS matrix. That is the "0" past last here (no shift for internal bcs) + call fillsprsemain(g,loc2plusup(1),loc2(:,1),up,pt,0) + + ! NOTE that in the following expression, the "-" sign on the crosshoriz terms, + ! which results from moving them from the LHS over to the RHS, is explicit and + ! hast NOT been moved inside of "croshorizmin" (as is the case for the analogous + ! boundary condition routines). + rhsd(loc2plusup(2)) = thisdusrfdx(ew,ns) - & ! shear stress grad coeffs into RHS vector + sum(croshorizmain(pt,up,local_efvs) * local_othervel) + end if + + ! The follow two if constructs set the ghost cell storage to have ones on the martrix diag and zeros + ! on the rhs, enforcing a zero vel bc for the ghost cells. Eventually, the capacity allowing for ghost + ! cells can probably be removed but keeping here for now for backward compatibility. + if( up == upn )then + loc2plusup = loc2(1,:) + upn + 1 ! basal ghost cells + call valueset(0.d0, loc2plusup) + endif + if( up == 1 )then + loc2plusup = loc2(1,:) ! sfc ghost cells + call valueset(0.d0, loc2plusup) + endif + + end if + +! ********************************************************************************************* +! higher-order sfc and bed boundary conditions in main body of ice sheet (NOT at lat. boundry) + + if( ( up == upn .or. up == 1 ) .and. .not. lateralboundry) then + + if( up == 1 )then ! specify necessary variables and flags for free sfc + bcflag = (/1,0/) + loc2plusup = loc2(1,:) + up - 1 ! reverse the sparse matrix / rhs vector row index by 1 ... + slopex = -dusrfdew(ew,ns); slopey = -dusrfdns(ew,ns); nz = 1.d0 + else ! specify necessary variables and flags for basal bc + + if( whichbabc == HO_BABC_NO_SLIP )then + bcflag = (/0,0/) ! flag for u=v=0 at bed; doesn't work well so commented out here... + ! better to specify very large value for beta below + + elseif( whichbabc == HO_BABC_CONSTANT .or. whichbabc == HO_BABC_SIMPLE .or. & + whichbabc == HO_BABC_YIELD_PICARD .or. whichbabc == HO_BABC_BETA_BWAT .or. & + whichbabc == HO_BABC_LARGE_BETA .or. whichbabc == HO_BABC_EXTERNAL_BETA .or. & + whichbabc == HO_BABC_POWERLAW .or. whichbabc == HO_BABC_COULOMB_FRICTION) then + bcflag = (/1,1/) ! flag for specififed stress at bed: Tau_zx = beta * u_bed, + ! where beta is MacAyeal-type traction parameter + end if + + loc2plusup = loc2(1,:) + up + 1 ! advance the sparse matrix / rhs row vector index by 1 ... + slopex = dlsrfdew(ew,ns); slopey = dlsrfdns(ew,ns); nz = -1.d0 + + end if + + ! get matrix coefficients that go with normal stresses at sfc or basal boundary + g = normhorizmainbcos(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, bcflag, & + dup(up), local_efvs, & + oneorfour, fourorone) + + g_norm = g ! save these coeffs, as needed for basal traction calculation + + + ! get matrix coefficients that go with vertical stresses at sfc or basal boundary + g(:,2,2) = g(:,2,2) & + + vertimainbcos( stagthck(ew,ns),bcflag,dup(up),local_efvs, & + beta, g_vert, nz ) + + !! scale basal bc coeffs when using JFNK solver + scalebabc = scalebasalbc( g, bcflag, lateralboundry, beta, local_efvs ) + g = g / scalebabc + + loc2plusup = loc2(1,:) + up ! Need to reset this index since we want the bc on the actual row + ! coinciding with the boundary at up=1 + + ! Replace ghost cells w/ one-sided diffs at sfc/basal indices. This section shifts the LHS matrix coeffs for the sfc + ! and basal bcs back on to the main diagonal, as opposed to staggered off the diag, which was necessary for the ghost + ! cell implementation. + if( up == 1 .or. up == upn )then + if( up == 1 )then + call fillsprsemain(g,loc2plusup(1),loc2(:,1),up,pt,1) + else if( up == upn )then + call fillsprsemain(g,loc2plusup(1),loc2(:,1),up,pt,-1) + end if + end if + + ! calc shear stress coeffs., multiply by other vel and move to RHS vector + rhsd(loc2plusup(2)) = sum( croshorizmainbcos(dew, dns, & + slopex, slopey, & + dsigmadew(up), dsigmadns(up), & + pt, bcflag, & + dup(up), local_othervel, & + local_efvs, & + oneortwo, twoorone, g_cros ) & + * local_othervel ) / scalebabc + + ! The following calculates the basal traction AFTER an updated solution is obtain by passing the new + ! values of uvel, vvel back to the matrix assembly routines, and thus obtaining updated values of the + ! relevant coefficients. The if construct allows the assembly routines to be called for only the vert + ! layers that are needed to cacluate the basal traction (as opposed to all vert levels 1:upn). + if( assembly == 1 )then + + g_vel_lhs = local_thisvel + g_vel_rhs = local_othervel + +!HALO - Since ew and ns are locally owned velocity points, we will have btraction at all such points. + btraction(pt,ew,ns) = sum( (g_norm+g_vert)*g_vel_lhs*thk0/len0 ) & + - sum( g_cros*g_vel_rhs*thk0/len0 ) + end if + + end if ! (up = 1 or up = upn) and lateralboundry = F + + return + +end subroutine bodyset + +!*********************************************************************** + +subroutine valueset(local_value, loc2plusup) + + ! plugs given value into the right location in the rhs vector of matrix equation Ax=rhs + + implicit none + + real(dp), intent(in) :: local_value + integer, dimension(2), intent(in) :: loc2plusup + + call putpcgc(1.d0,loc2plusup(1),loc2plusup(1)) + rhsd(loc2plusup(2)) = local_value + + return + +end subroutine valueset + +!*********************************************************************** + +subroutine calccoeffsinit (upn, dew, dns) + + ! determines constants used in various FD calculations associated with 'findcoefst' + ! In general, the constants contain (1) grid spacing info, (2) numeric constants + ! used for averaging of eff. visc. from normal grid in horiz onto stag grid in horiz. + implicit none + + integer, intent(in) :: upn + real(dp), intent(in) :: dew, dns + + ! this coefficient used in finite differences of vertical terms. + cvert(:) = (len0**2) / (4.d0 * thk0**2 * dup**2) + + ! these coefficients used in finite differences of horizontal terms + ! for d/dx(fdu/dx), d/dx(fdu/dy), d/dsigma(fdu/dx), d/dx(fdu/dsigma) and + ! du/dsigma. + cdxdx = (/ 0.25d0 / dew**2, 0.25d0 / dns**2 /) + cdsdx(:,1) = 0.0625d0 / (dew * dup); cdsdx(:,2) = 0.0625d0 / (dns * dup); + cdsds = 0.25d0 / (dup * dup) + cds = 0.0625d0 / dup + cdxdy = 0.0625d0 / (dew * dns) + + return + +end subroutine calccoeffsinit + +!*********************************************************************** + +subroutine calccoeffs(upn, sigma, & + stagthck, & + dusrfdew, dusrfdns, & + dthckdew, dthckdns, & + d2usrfdew2, d2usrfdns2, d2usrfdewdns, & + d2thckdew2, d2thckdns2, d2thckdewdns) + + ! Called from 'findcoefst' to find coefficients in stress balance equations + ! Detemines coeficients needed for finite differencing. + ! This is a column-based operation. In general these coefficients refer + ! to grid transformations and averaging of efvs to half grid points. + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: sigma + real(dp), intent(in) :: stagthck, dusrfdew, dusrfdns, dthckdew, dthckdns, & + d2usrfdew2, d2usrfdns2, d2usrfdewdns, & + d2thckdew2, d2thckdns2, d2thckdewdns + + fvert(:) = cvert(:) / stagthck**2 + + dsigmadew = calcdsigmadx(upn, sigma, dusrfdew, dthckdew, stagthck) + dsigmadns = calcdsigmadx(upn, sigma, dusrfdns, dthckdns, stagthck) + + d2sigmadew2 = calcd2sigmadxdy(upn, sigma, & + d2usrfdew2, d2thckdew2, & + dusrfdew, dusrfdew, & + dthckdew, dthckdew, & + stagthck) + + d2sigmadns2 = calcd2sigmadxdy(upn, sigma, & + d2usrfdns2, d2thckdns2, & + dusrfdns, dusrfdns, & + dthckdns, dthckdns, & + stagthck) + + d2sigmadewdns = calcd2sigmadxdy(upn, sigma, & + d2usrfdewdns, d2thckdewdns, & + dusrfdew, dusrfdns, & + dthckdew, dthckdns, & + stagthck) + + d2sigmadewdsigma = calcd2sigmadxdsigma(dthckdew,stagthck) + d2sigmadnsdsigma = calcd2sigmadxdsigma(dthckdns,stagthck) + + return + +end subroutine calccoeffs + +!*********************************************************************** + +function calcdsigmadx(upn, sigma, & + dusrfdx, dthckdx, & + stagthck) + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: sigma + real(dp), intent(in) :: stagthck, dusrfdx, dthckdx + real(dp), dimension(upn) :: calcdsigmadx + + calcdsigmadx = (dusrfdx - sigma * dthckdx) / stagthck + + return + +end function calcdsigmadx + +!*********************************************************************** + +function calcd2sigmadxdy(upn, sigma, & + d2usrfdxdy, d2thckdxdy, & + dusrfdx, dusrfdy, & + dthckdx, dthckdy, & + stagthck) + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: sigma + real(dp), intent(in) :: d2usrfdxdy, d2thckdxdy, dusrfdx, dusrfdy, & + dthckdx, dthckdy, stagthck + real(dp), dimension(upn) :: calcd2sigmadxdy + + calcd2sigmadxdy = (stagthck * d2usrfdxdy - & + dusrfdx * dthckdy - dusrfdy * dthckdx + & + sigma * (2.d0 * dthckdx * dthckdy - & + stagthck * d2thckdxdy)) / stagthck**2 + + return + +end function calcd2sigmadxdy + +!*********************************************************************** + +function calcd2sigmadxdsigma(dthckdx,stagthck) + + implicit none + + real(dp), intent(in) :: dthckdx, stagthck + real(dp) :: calcd2sigmadxdsigma + + calcd2sigmadxdsigma = - dthckdx / stagthck + + return + +end function calcd2sigmadxdsigma + +!*********************************************************************** + +function vertimain(efvs,up) + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + + real(dp), dimension(3) :: vertimain + + integer, intent(in) :: up + + vertimain(3) = fvert(up) * efvs(2) + vertimain(1) = fvert(up) * efvs(1) + vertimain(2) = - vertimain(3) - vertimain(1) + + return + +end function vertimain + +!*********************************************************************** + +function normhorizmain(which,up,efvs) + + ! Called from 'findcoefst' to calculate normal-stress grad terms + ! like: d/dx(f(du/dx)), d/dy(f(dv/dy)), etc. + ! ... calls FUNCTIONS: horiztermdxdx, horiztermdsdx, horiztermdxds, + ! horiztermdsds, horiztermds + ! determines coefficients from d/dx(fdu/dx) and d/dy(fdu/dy) + + implicit none + + integer, intent(in) :: which, up + real(dp), dimension(:,:,:), intent(in) :: efvs + + real(dp), dimension(3,3,3) :: normhorizmain + real(dp), dimension(3,3,3) :: g, h + real(dp), dimension(2) :: sumefvsup, sumefvsew, sumefvsns + real(dp) :: sumefvs + + g = 0.d0 + h = 0.d0 + + sumefvsup = hsum(efvs) + sumefvsew = sum(sum(efvs,3),1) + sumefvsns = sum(sum(efvs,2),1) + sumefvs = sum(efvs) + +! for d(f.du/dx)/dx + + g(2,:,2) = horiztermdxdx(sumefvsew,cdxdx(1)) + g(:,1:3:2,2) = g(:,1:3:2,2) + horiztermdsdx(dsigmadew(up),sumefvsup,cdsdx(up,1)) + g(1:3:2,:,2) = g(1:3:2,:,2) + horiztermdxds(dsigmadew(up),sumefvsew,cdsdx(up,1)) + g(:,2,2) = g(:,2,2) + horiztermdsds(dsigmadew(up)**2,sumefvsup,cdsds(up)) + g(1:3:2,2,2) = g(1:3:2,2,2) + horiztermds(d2sigmadew2(up)+d2sigmadewdsigma*dsigmadew(up),sumefvs,cds(up)) + +! for d(f.du/dy)/dy + + h(2,2,:) = horiztermdxdx(sumefvsns,cdxdx(2)) + h(:,2,1:3:2) = h(:,2,1:3:2) + horiztermdsdx(dsigmadns(up),sumefvsup,cdsdx(up,2)) + h(1:3:2,2,:) = h(1:3:2,2,:) + horiztermdxds(dsigmadns(up),sumefvsns,cdsdx(up,2)) + h(:,2,2) = h(:,2,2) + horiztermdsds(dsigmadns(up)**2,sumefvsup,cdsds(up)) + h(1:3:2,2,2) = h(1:3:2,2,2) + horiztermds(d2sigmadns2(up)+d2sigmadnsdsigma*dsigmadns(up),sumefvs,cds(up)) + + normhorizmain = g * fourorone(which) + h * oneorfour(which) + + return + +end function normhorizmain + +!*********************************************************************** + +function croshorizmain(which,up,efvs) + + ! Called from 'findcoefst' to calculate cross-stress grad terms + ! like: d/dx(f(du/dy)), d/dy(f(dv/dx)), etc. + ! ... calls FUNCTIONS: horiztermdxdy, horiztermdsdx, horiztermdxds, + ! horiztermdsds, horiztermds + ! determines coefficients from d/dx(fdu/dy) and d/dy(fdu/dx) + + implicit none + + integer, intent(in) :: which, up + real(dp), dimension(:,:,:), intent(in) :: efvs + + real(dp), dimension(3,3,3) :: croshorizmain + real(dp), dimension(3,3,3) :: g = 0.d0, h = 0.d0 + real(dp), dimension(2) :: sumefvsup, sumefvsew, sumefvsns + real(dp) :: sumefvs + + g = 0.d0 + h = 0.d0 + + sumefvsup = hsum(efvs) + sumefvsew = sum(sum(efvs,3),1) + sumefvsns = sum(sum(efvs,2),1) + sumefvs = sum(efvs) + +! for d(f.du/dy)/dx + + g(2,:,1:3:2) = horiztermdxdy(sumefvsew,cdxdy) + g(:,2,1:3:2) = g(:,2,1:3:2) + horiztermdsdx(dsigmadew(up),sumefvsup,cdsdx(up,2)) + g(1:3:2,:,2) = g(1:3:2,:,2) + horiztermdxds(dsigmadns(up),sumefvsew,cdsdx(up,1)) + g(:,2,2) = g(:,2,2) + horiztermdsds(dsigmadew(up)*dsigmadns(up),sumefvsup,cdsds(up)) + g(1:3:2,2,2) = g(1:3:2,2,2) + horiztermds(d2sigmadewdns(up)+d2sigmadnsdsigma*dsigmadew(up),sumefvs,cds(up)) + +! for d(f.du/dx)/dy + + h(2,1:3:2,:) = transpose(horiztermdxdy(sumefvsns,cdxdy)) + h(:,1:3:2,2) = h(:,1:3:2,2) + horiztermdsdx(dsigmadns(up),sumefvsup,cdsdx(up,1)) + h(1:3:2,2,:) = h(1:3:2,2,:) + horiztermdxds(dsigmadew(up),sumefvsns,cdsdx(up,2)) + h(:,2,2) = h(:,2,2) + horiztermdsds(dsigmadew(up)*dsigmadns(up),sumefvsup,cdsds(up)) + h(1:3:2,2,2) = h(1:3:2,2,2) + horiztermds(d2sigmadewdns(up)+d2sigmadewdsigma*dsigmadns(up),sumefvs,cds(up)) + + croshorizmain = g * twoorone(which) + h * oneortwo(which) + + return + +end function croshorizmain + +!*********************************************************************** + +! *************************************************************************** +! start of functions to deal with higher-order boundary conditions at sfc and bed +! *************************************************************************** + +function vertimainbc(thck, bcflag, dup, efvs, beta, g_vert, nz ) + +! altered form of 'vertimain' that calculates coefficients for higher-order +! b.c. that go with the 'normhorizmain' term: -(X/H)^2 * dsigma/dzhat * du/dsigma + + implicit none + + real(dp), intent(in) :: dup, thck, beta + real(dp), intent(in) :: nz ! sfc normal vect comp in z-dir + real(dp), intent(in), dimension(2,2,2) :: efvs + real(dp), intent(out), dimension(3,3,3) :: g_vert + integer, intent(in), dimension(2) :: bcflag + + real(dp) :: c + real(dp), dimension(3) :: vertimainbc + + c = 0.d0 + g_vert = 0.d0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + if( bcflag(1) == 1 )then + + c = nz / thck / (2.d0*dup) * (len0**2 / thk0**2) ! value of coefficient + + vertimainbc(:) = 0.d0 + vertimainbc(3) = -c + vertimainbc(1) = c + vertimainbc(2) = vertimainbc(3) + vertimainbc(1) ! should = 0 + + ! this is the part of the vertimain coeff. block that we want to keep for calc + ! of boundary tractions (note that it DOES NOT include terms from boundary forcing) + g_vert(:,2,2) = vertimainbc + + ! for higher-order BASAL B.C. w/ specified basal traction, add on the necessary source term ... + if( bcflag(2) == 1 )then + + ! last set of terms is mean visc. of ice nearest to the bed + vertimainbc(2) = vertimainbc(2) & + + ( beta / ( sum( efvs(2,:,:) ) / 4.d0 ) ) * (len0 / thk0) + end if + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this is not often implemented, as it is generally sufficient to implement + ! an "almost" no slip BC by just making the coeff. for beta very large (and the + ! the code converges more quickly/stably in this case than for actual no-slip). + else if( bcflag(1) == 0 )then + + ! if u,v set to 0, there are no coeff. assoc. with du/digma terms ... + vertimainbc(:) = 0.d0 + + end if + + return + +end function vertimainbc + +!*********************************************************************** + +function vertimainbcos(thck, bcflag, dup, efvs, beta, g_vert, nz ) + +! altered form of 'vertimain' that calculates coefficients for higher-order +! b.c. that go with the 'normhorizmain' term: -(X/H)^2 * dsigma/dzhat * du/dsigma + + implicit none + + real (dp), intent(in) :: dup, thck, beta + real (dp), intent(in) :: nz ! sfc normal vect comp in z-dir + real (dp), intent(in), dimension(2,2,2) :: efvs + real (dp), intent(out), dimension(3,3,3) :: g_vert + integer, intent(in), dimension(2) :: bcflag + + real (dp) :: c + real (dp), dimension(3) :: vertimainbcos + real (dp) :: bar_sfc, bar_bed, efvsbar_bed, efvsbar_sfc + + ! averaging number for eff. visc. at domain edges + bar_sfc = sum( (efvs(1,:,:)/efvs(1,:,:)), efvs(1,:,:) > effstrminsq ) + bar_bed = sum( (efvs(2,:,:)/efvs(2,:,:)), efvs(2,:,:) > effstrminsq ) + + ! average visc. to use in coeff. calc. + efvsbar_sfc = sum( efvs(1,:,:), efvs(1,:,:) > effstrminsq ) / bar_sfc + efvsbar_bed = sum( efvs(2,:,:), efvs(2,:,:) > effstrminsq ) / bar_bed + + ! make the following lines active to turn OFF the visc. dependence in the LHS matrix coeffs. + !efvsbar_sfc = 1.0d0; efvsbar_bed = 1.0d0 + + c = 0.d0 + g_vert = 0.d0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + if( bcflag(1) == 1 .and. bcflag(2) == 0 )then + + c = nz / thck / (2.d0*dup) * (len0**2 / thk0**2) * efvsbar_sfc ! value of coefficient + + vertimainbcos(:) = 0.d0 + vertimainbcos(1) = 3.d0*c + vertimainbcos(2) = -4.d0*c + vertimainbcos(3) = c + + ! this is the part of the vertimain coeff. block that we want to keep for calc + ! of boundary tractions (note that it DOES NOT include terms from boundary forcing) + g_vert(:,2,2) = vertimainbcos + + end if + + ! for higher-order BASAL B.C. w/ specified basal traction, add on the necessary source term ... + if( bcflag(1) == 1 .and. bcflag(2) == 1 )then + + c = nz / thck / (2.d0*dup) * (len0**2 / thk0**2) * efvsbar_bed ! value of coefficient + + vertimainbcos(:) = 0.d0 + vertimainbcos(1) = -1.d0*c + vertimainbcos(2) = 4.d0*c + vertimainbcos(3) = -3.d0*c + + ! this is the part of the vertimain coeff. block that we want to keep for calc + ! of boundary tractions (note that it DOES NOT include terms from boundary forcing) + ! NOTE that here we do this BEFORE adding in the sliding coefficient, as in the standard + ! expression for the BC, this term is on the RHS. + g_vert(:,2,2) = vertimainbcos + + ! this is the part of the vertimain coeff. block that we want to keep for calc + ! of boundary tractions (note that it DOES NOT include terms from boundary forcing) + + ! last set of terms is mean visc. of ice nearest to the bed +! vertimainbcos(3) = vertimainbcos(3) & +! + ( beta / efvsbar_bed ) * (len0 / thk0) + vertimainbcos(3) = vertimainbcos(3) & + + ( beta ) * (len0 / thk0) + + end if + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this is not often implemented, as it is generally sufficient to implement + ! an "almost" no slip BC by just making the coeff. for beta very large (and the + ! the code converges more quickly/stably in this case than for actual no-slip). + if( bcflag(1) == 0 )then + + ! if u,v set to 0, there are no coeff. assoc. with du/digma terms ... + vertimainbcos(:) = 0.d0 + + end if + + return + +end function vertimainbcos + +!*********************************************************************** + +function normhorizmainbcos(dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, bcflag, & + dup, efvs, & + oneorfour, fourorone) + + ! Determines higher-order surface and basal boundary conditions for LHS of equation. + ! Gives 3x3x3 coeff. array for either u or v component of velocity, depending on the + ! value of the flag 'which'. Example of function call: + ! + ! g = normhorizmainbc(dusrfew(ew,ns),dusrfnx(ew,ns),dsigmadew(up),dsigmadns(up),which,up,bcflag) + ! + ! ... where g is a 3x3x3 array. + ! + ! 'bcflag' is a 1 x 2 vector to indicate (1) which b.c. is being solved for (surface or bed) and + ! (2), if solving for the bed b.c., which type of b.c. to use. For example, bcflag = [ 0, 0 ] + ! denotes free sfc bc; bcflag = [ 1, 0 ] denotes basal bc w/ u=v=0, etc. (see also subroutine + ! "bodyset"). "fourorone" and "oneorfour" are given by vectors: fourorone = [ 4 1 ]; oneorfour = [ 1 4 ]. + ! A single value is chosen from each vector and applied to the calculation of coefficients below. + ! The "correct" value needed to satisfy the expression is chosen based on the "which" flag, which + ! takes on a value of 1 for calculations in the x direction and a value of 2 for calculations in + ! the y direction. + + implicit none + + real (kind = dp), intent(in) :: dew, dns + real (kind = dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real (kind = dp), intent(in), dimension(2) :: oneorfour, fourorone + real (kind = dp), dimension(3,3,3) :: normhorizmainbcos + real (kind = dp), dimension(3,3,3) :: g + real (kind = dp) :: c + + integer, intent(in) :: which + integer, intent(in), dimension(2) :: bcflag + real (kind = dp), intent(in), dimension(2,2,2) :: efvs + + c = 0.d0 + g(:,:,:) = 0.d0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this handles the case for specified stress at the bed as well, as we + ! simply pass in a different value for the normal vector (slope) components (still + ! called "dusrfdns", "dusrfdew" here, but args passed in are different). + if( bcflag(1) == 1 .and. bcflag(2) == 0 )then + + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... +! c = ( fourorone(which) * dusrfdew * dsigmadew & +! + oneorfour(which) * dusrfdns * dsigmadns )/(2.d0*dup) + c = ( fourorone(which) * dusrfdew * dsigmadew & + + oneorfour(which) * dusrfdns * dsigmadns )/(2.d0*dup) * ( sum( efvs(1,:,:) ) / 4.d0 ) + + g(1,2,2) = 3.d0*c + g(2,2,2) = -4.d0*c + g(3,2,2) = c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... +! c = fourorone(which) * dusrfdew / (2*dew) + c = fourorone(which) * dusrfdew / (2*dew) * ( sum( efvs(1,:,:) ) / 4.d0 ) + g(1,3,2) = c + g(1,1,2) = -c + +! c = oneorfour(which) * dusrfdns / (2*dns) + c = oneorfour(which) * dusrfdns / (2*dns) * ( sum( efvs(1,:,:) ) / 4.d0 ) + g(1,2,3) = c + g(1,2,1) = -c + + end if + + ! higher-order, specified traction basal bc, must use fwd rather than bwd one-sided + ! diff in vertical direction + if( bcflag(1) == 1 .and. bcflag(2) == 1 )then + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... +! c = ( fourorone(which) * dusrfdew * dsigmadew & +! + oneorfour(which) * dusrfdns * dsigmadns )/(2*dup) + c = ( fourorone(which) * dusrfdew * dsigmadew & + + oneorfour(which) * dusrfdns * dsigmadns )/(2*dup) * ( sum( efvs(2,:,:) ) / 4.d0 ) + + g(1,2,2) = -1.d0*c + g(2,2,2) = 4.d0*c + g(3,2,2) = -3.d0*c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... +! c = fourorone(which) * dusrfdew / (2*dew) + c = fourorone(which) * dusrfdew / (2.d0*dew) * ( sum( efvs(2,:,:) ) / 4.d0 ) + g(3,3,2) = c + g(3,1,2) = -c + +! c = oneorfour(which) * dusrfdns / (2*dns) + c = oneorfour(which) * dusrfdns / (2.d0*dns) * ( sum( efvs(2,:,:) ) / 4.d0 ) + g(3,2,3) = c + g(3,2,1) = -c + + end if + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! note that this requires that rhs(up) be set to 0 as well ... + if( bcflag(1) == 0 )then + + g(:,:,:) = 0.d0 + g(2,2,2) = 1.d0; + + end if + + normhorizmainbcos = g + + return + +end function normhorizmainbcos + +!*********************************************************************** + +function croshorizmainbcos(dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, bcflag, & + dup, local_othervel, & + efvs, & + oneortwo, twoorone, & + g_cros, velbc ) + + ! As described for "normhorizmainbc" above. The vectors "twoorone" and + ! "oneortwo" are given by: twoorone = [ 2 1 ]; oneortwo = [ 1 2 ]; + + implicit none + + integer, intent(in) :: which + integer, intent(in), dimension(:) :: bcflag + + real (kind = dp), intent(in) :: dew, dns + real (kind = dp), intent(in), dimension(:) :: oneortwo, twoorone + real (kind = dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real (kind = dp), intent(in), dimension(:,:,:) :: local_othervel + real (kind = dp), intent(in), dimension(:,:,:) :: efvs + real (kind = dp), intent(in), optional :: velbc + real (kind = dp), intent(out),dimension(:,:,:) :: g_cros + + + real (kind = dp), dimension(3,3,3) :: g, croshorizmainbcos + real (kind = dp) :: c + integer :: nz + + c = 0.d0 + g(:,:,:) = 0.d0 + g_cros = g + nz = 0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this handles the case for specified stress at the bed as well, as we + ! simply pass in a different value for the normal vector (slope) components (still + ! called "dusrfdns", "dusrfdew" here, but args passed in are different). + if( bcflag(1) == 1 .and. bcflag(2) == 0 )then + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... +! c = ( - twoorone(which) * dusrfdew * dsigmadns & +! - oneortwo(which) * dusrfdns * dsigmadew )/(2.d0*dup) + c = ( - twoorone(which) * dusrfdew * dsigmadns & + - oneortwo(which) * dusrfdns * dsigmadew )/(2.d0*dup) * ( sum( efvs(1,:,:) ) / 4.d0 ) + + g(1,2,2) = 3.d0*c + g(2,2,2) = -4.d0*c + g(3,2,2) = c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... +! c = - oneortwo(which) * dusrfdns / (2*dew) + c = - oneortwo(which) * dusrfdns / (2.d0*dew) * ( sum( efvs(1,:,:) ) / 4.d0 ) + g(1,3,2) = c + g(1,1,2) = -c + +! c = - twoorone(which) * dusrfdew / (2*dns) + c = - twoorone(which) * dusrfdew / (2.d0*dns) * ( sum( efvs(1,:,:) ) / 4.d0 ) + g(1,2,3) = c + g(1,2,1) = -c + + end if + + ! higher-order, specified traction basal bc, must use fwd rather than bwd one-sided + ! diff in vertical direction + if( bcflag(1) == 1 .and. bcflag(2) == 1 )then + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... +! c = ( - twoorone(which) * dusrfdew * dsigmadns & +! - oneortwo(which) * dusrfdns * dsigmadew )/(2*dup) + c = ( - twoorone(which) * dusrfdew * dsigmadns & + - oneortwo(which) * dusrfdns * dsigmadew )/(2.d0*dup) * ( sum( efvs(2,:,:) ) / 4.d0 ) + + g(1,2,2) = -1.d0*c + g(2,2,2) = 4.d0*c + g(3,2,2) = -3.d0*c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... +! c = - oneortwo(which) * dusrfdns / (2*dew) + c = - oneortwo(which) * dusrfdns / (2.d0*dew) * ( sum( efvs(2,:,:) ) / 4.d0 ) + g(3,3,2) = c + g(3,1,2) = -c + + +! c = - twoorone(which) * dusrfdew / (2*dns) + c = - twoorone(which) * dusrfdew / (2.d0*dns) * ( sum( efvs(2,:,:) ) / 4.d0 ) + g(3,2,3) = c + g(3,2,1) = -c + + end if + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! This forces the multiplication by 'local_otherval' in the main program + ! to result in a value of 1, thus leaving the boundary vel. unchanged + ! ... conditional makes sure there is no div by zero if the bc value IS also zero + if( bcflag(1) == 0 )then + + g(:,:,:) = 0.d0 + + where( local_othervel /= 0.d0 ) + g = 1.d0 + elsewhere + g = 0.d0 + endwhere + + nz = sum( g ) + g(:,:,:) = 0.d0 + + where( local_othervel /= 0.d0 ) + g = ( velbc / nz ) / local_othervel + elsewhere + g = 0.d0 + endwhere + + end if + + ! NOTE: here we define 'g_cros' FIRST, because we want the value w/o the plastic + ! bed coeff. included (needed for estimate of basal traction in plastic bed iteration) + g_cros = g + + croshorizmainbcos = g + + return + +end function croshorizmainbcos + +!*********************************************************************** + +function normhorizmainbc_lat(dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, what, & + dup, efvs, & + oneorfour, fourorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) + + ! Analogous to "normhorizmainbc" but for the case of lateral stress (ice shelf) + ! boundary conditions. Note that the basic form of the equations is the same. + ! What changes here is (1) the value of the normal vector that is passed in (at + ! the sfc and bed we pass in the surface or basal slopes, while at the boundaries + ! we use the normal vector orientation to the boundary in map view) and (2) we to + ! to use one sided diffs at the lateral boundaries rather than centerd diffs. + + ! Note that we assume here that du/dz (and thus du/dsigma) is approx. 0 for an ice + ! shelf, and also that the sfc/basal slopes of an ice shelf are very flat at/near + ! the boundary. Thus, we assume flow is depth independent and we ignore gradients + ! in sigma. + + implicit none + + real(dp), intent(in) :: dew, dns + real(dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real(dp), intent(in), dimension(2) :: oneorfour, fourorone, normal, fwdorbwd + real(dp), intent(in), dimension(3) :: onesideddiff + real (kind = dp), intent(in), dimension(:,:,:) :: efvs + + integer, intent(in) :: which, what + + logical, intent(in) :: fons, foew ! true when geom. requires 1st-order one sided diffs for shelf bcs + + real(dp), dimension(3,3,3) :: normhorizmainbc_lat + real(dp), dimension(3,3,3) :: g + real(dp), dimension(2) :: whichbc + real(dp) :: c + real (kind = dp) :: bar, efvsbar + + c = 0.d0; g(:,:,:) = 0.d0; whichbc = (/ 0.d0, 1.d0 /) + + ! averaging number for eff. visc. at domain edges + bar = sum( (efvs(:,:,:)/efvs(:,:,:)), efvs(:,:,:) > effstrminsq ) + + ! average visc. to use in coeff. calc. + efvsbar = sum( efvs(:,:,:), efvs(:,:,:) > effstrminsq ) / bar + + ! make the following lines active to turn OFF the visc. dependence in the LHS matrix coeffs. + !efvsbar = 1.0d0; + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + ! (also applies to basal stress bc) + + ! first, coeff. that go with du/dsigma, and thus are associated with u(1,2,2) and u(3,2,2) ... + ! ...note that these are stored in an empty column of 'g' (a corner column) so that we don't + ! overwrite these values in the case of fwd/bwd horiz. diffs., which require 3 spaces + c = ( fourorone(which) * dusrfdew * dsigmadew & + + oneorfour(which) * dusrfdns * dsigmadns )/(2*dup) * efvsbar + g(3,3,3) = -c * whichbc(what) + g(1,3,3) = c * whichbc(what) + + if( normal(1) == 0.d0 )then ! centered in x ... + + c = fourorone(which) * dusrfdew / (2*dew) * efvsbar + g(2,3,2) = c + g(2,1,2) = -c + + elseif( normal(1) /= 0.d0 )then ! forward/backward in x ... + + if( foew )then + c = -1.d0 * fwdorbwd(1) * fourorone(which) * dusrfdew / dew * efvsbar + else + c = fourorone(which) * fwdorbwd(1) * onesideddiff(1) * dusrfdew / (2.d0*dew) * efvsbar + endif + g(2,2-int(fwdorbwd(1)),2) = c + + if( foew )then + c = fwdorbwd(1)*fourorone(which) * dusrfdew / dew * efvsbar + else + c = fourorone(which) * fwdorbwd(1) * onesideddiff(2) * dusrfdew / (2.d0*dew) * efvsbar + endif + g(2,2,2) = c + + if( foew )then + c = 0.d0 + else + c = fourorone(which) * fwdorbwd(1) * onesideddiff(3) * dusrfdew / (2.d0*dew) * efvsbar + endif + g(2,2+int(fwdorbwd(1)),2) = c + + end if + + if( normal(2) == 0.d0 ) then ! centered in y ... + ! (NOTE that y coeff. are stored in g(1,:,:) ) + + c = oneorfour(which) * dusrfdns / (2*dns) * efvsbar + g(1,2,3) = c + g(1,2,1) = -c + + elseif( normal(2) /= 0.d0) then ! forward/backward in y ... + + if( fons )then + c = -1.d0 * fwdorbwd(2) * oneorfour(which) * dusrfdns / dns * efvsbar + else + c = oneorfour(which) * fwdorbwd(2) * onesideddiff(1) * dusrfdns / (2.d0*dns) * efvsbar + endif + g(1,2,2-int(fwdorbwd(2))) = c + + if( fons )then + c = fwdorbwd(2)*oneorfour(which) * dusrfdns / dns * efvsbar + else + c = oneorfour(which) * fwdorbwd(2) * onesideddiff(2) * dusrfdns / (2.d0*dns) * efvsbar + endif + g(1,2,2) = c + + if( fons )then + c = 0.d0 + else + c = oneorfour(which) * fwdorbwd(2) * onesideddiff(3) * dusrfdns / (2.d0*dns) * efvsbar + endif + g(1,2,2+int(fwdorbwd(2))) = c + + end if + + normhorizmainbc_lat = g + + return + +end function normhorizmainbc_lat + +!*********************************************************************** + +function croshorizmainbc_lat (dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, what, & + dup, local_othervel, & + efvs, & + oneortwo, twoorone, & + onesideddiff, & + normal, fwdorbwd, & + foew, fons ) + + ! Analagous to "normhorizmainbc_lat" but for cross terms. See notes above. + + implicit none + + real(dp), intent(in) :: dew, dns + real(dp), intent(in), dimension(2) :: oneortwo, twoorone, fwdorbwd, normal + real(dp), intent(in), dimension(3) :: onesideddiff + real(dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real(dp), intent(in), dimension(3,3,3) :: local_othervel + real (kind = dp), intent(in), dimension(:,:,:) :: efvs + + integer, intent(in) :: which, what + + real(dp), dimension(3,3,3) :: g, croshorizmainbc_lat + real(dp), dimension(3) :: gvert + real(dp), dimension(2) :: whichbc + real(dp) :: c + + integer, dimension(2) :: inormal + + logical, intent(in) :: fons, foew ! true when geom. requires 1st-order one sided diffs for shelf bcs + + real (kind = dp) :: bar, efvsbar + + ! averaging number for eff. visc. at domain edges + bar = sum( (efvs(:,:,:)/efvs(:,:,:)), efvs(:,:,:) > effstrminsq ) + + ! average visc. to use in coeff. calc. + efvsbar = sum( efvs(:,:,:), efvs(:,:,:) > effstrminsq ) / bar + + ! make the following lines active to turn OFF the visc. dependence in the LHS matrix coeffs. +! efvsbar = 1.0d0; + + c = 0.d0 + g(:,:,:) = 0.d0 + gvert = 0.d0 + whichbc = (/ 0.d0, 1.d0 /) + croshorizmainbc_lat = 0.d0 + + ! first, coeff. that go with du/dsigma, and thus are associated with u(1,2,2) and u(3,2,2) + ! ... note that these are stored in a separate vector (to avoid being overwritten if stored in normal 'g') + c = ( - twoorone(which) * dusrfdew * dsigmadns & + - oneortwo(which) * dusrfdns * dsigmadew )/(2.d0*dup) * efvsbar + gvert(3) = -c * whichbc(what) + gvert(1) = c * whichbc(what) + + if( normal(1) == 0.d0 )then ! centered in x ... + + c = -oneortwo(which) * dusrfdns / (2.d0*dew) * efvsbar + g(2,3,2) = c + g(2,1,2) = -c + + elseif( normal(1) /= 0.d0 )then ! forward/backward in x ... + ! (NOTE that x coeff. are stored in g(2,:,:) ) + + if( foew )then + c = oneortwo(which) * fwdorbwd(1) * dusrfdns / dew * efvsbar + else + c = -oneortwo(which) * fwdorbwd(1) * onesideddiff(1) * dusrfdns / (2.d0*dew) * efvsbar + endif + g(2,2-int(fwdorbwd(1)),2) = c + + if( foew )then + c = -oneortwo(which) * fwdorbwd(1) * dusrfdns / dew * efvsbar + else + c = -oneortwo(which) * fwdorbwd(1) * onesideddiff(2) * dusrfdns / (2.d0*dew) * efvsbar + endif + g(2,2,2) = c + + if( foew )then + c = 0.d0 + else + c = -oneortwo(which) * fwdorbwd(1) * onesideddiff(3) * dusrfdns / (2.d0*dew) * efvsbar + endif + g(2,2+int(fwdorbwd(1)),2) = c + + end if + + if( normal(2) == 0.d0 )then ! centered in y ... + ! (NOTE that y coeff. are stored in g(1,:,:) ) + + c = -twoorone(which) * dusrfdew / (2.d0*dns) * efvsbar + g(1,2,3) = c + g(1,2,1) = -c + + elseif( normal(2) /= 0.d0 )then ! forward/backward in y ... + + if( fons )then + c = twoorone(which) * fwdorbwd(2) * dusrfdew / dns * efvsbar + else + c = -twoorone(which) * fwdorbwd(2) * onesideddiff(1) * dusrfdew / (2.d0*dns) * efvsbar + endif + g(1,2,2-int(fwdorbwd(2))) = c + + if( fons )then + c = -twoorone(which) * fwdorbwd(2) * dusrfdew / dns * efvsbar + else + c = -twoorone(which) * fwdorbwd(2) * onesideddiff(2) * dusrfdew / (2.d0*dns) * efvsbar + endif + g(1,2,2) = c + + if( fons )then + c = 0.d0 + else + c = -twoorone(which) * fwdorbwd(2) * onesideddiff(3) * dusrfdew / (2.d0*dns) * efvsbar + endif + g(1,2,2+int(fwdorbwd(2))) = c + + end if + + ! Now rearrange position of coefficients in structure 'g' so that they are multiplied by + ! the correct velocity component of 'local_othervel' in 'bodyset' ... + ! ... this can be done by using the boundary normal vector to shift the indices of the rows/columns + ! in 'g', in the appropriate direction. First, convert the boundary normal to an integer index ... + inormal(1) = int( normal(1)/abs(normal(1)) ) + inormal(2) = int( normal(2)/abs(normal(2)) ) + if( abs( inormal(1) ) /= 1 )then; inormal(1) = 0; end if + if( abs( inormal(2) ) /= 1 )then; inormal(2) = 0; end if + + croshorizmainbc_lat(2,:,2+inormal(2)) = g(2,:,2) ! move x-coeffs. appropriate amount + croshorizmainbc_lat(1,2+inormal(1),:) = g(1,2,:) ! move y-coeffs. appropriate amount + + ! sum coeffs. that are in same column and flatten so that all coeff. are on level (2,:,:) + croshorizmainbc_lat(2,:,:) = croshorizmainbc_lat(2,:,:) + croshorizmainbc_lat(1,:,:) + + ! set remaining coeff. on this level to to 0 ... + croshorizmainbc_lat(1,:,:) = 0.d0 + + ! accounter for vertical terms stored seperately and temporarily in 'gvert' + croshorizmainbc_lat(1,2+inormal(1),2+inormal(2)) = gvert(1) * whichbc(what) + croshorizmainbc_lat(3,2+inormal(1),2+inormal(2)) = gvert(3) * whichbc(what) + + return + +end function croshorizmainbc_lat + +!*********************************************************************** + +! ---> the following routines are for derivatives in the main body + +function horiztermdxdx(efvs,fact) + + ! this is the d/dx(f.du/dx) and d/dy(f.du/dy) terms + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + real(dp), intent(in) :: fact + + real(dp), dimension(3) :: horiztermdxdx + + horiztermdxdx(3) = efvs(2) * fact + horiztermdxdx(1) = efvs(1) * fact + horiztermdxdx(2) = - horiztermdxdx(3) - horiztermdxdx(1) + + return + +end function horiztermdxdx + +!*********************************************************************** + +function horiztermdxdy(efvs,fact) + + ! this is the d/dy(f.du/dx) and d/dx(f.du/dy) terms + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + real(dp), intent(in) :: fact + + real(dp), dimension(3,2) :: horiztermdxdy + + horiztermdxdy(3,2) = efvs(2) * fact + horiztermdxdy(2,2) = horiztermdxdy(3,2) + horiztermdxdy(3,1) = - horiztermdxdy(3,2) + horiztermdxdy(2,1) = - horiztermdxdy(3,2) + + horiztermdxdy(1,2) = - efvs(1) * fact + horiztermdxdy(2,2) = horiztermdxdy(2,2) + horiztermdxdy(1,2) + horiztermdxdy(2,1) = horiztermdxdy(2,1) - horiztermdxdy(1,2) + horiztermdxdy(1,1) = - horiztermdxdy(1,2) + + return + +end function horiztermdxdy + +!*********************************************************************** + +function horiztermdsdx(dsigmadxy,efvs,fact) + + ! this is the d/ds(f.du/dx) and d/ds(f.du/dy) terms + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + real(dp), intent(in) :: dsigmadxy, fact + + real(dp), dimension(3,2) :: horiztermdsdx + + horiztermdsdx(3,2) = dsigmadxy * efvs(2) * fact + horiztermdsdx(2,2) = horiztermdsdx(3,2) + horiztermdsdx(3,1) = - horiztermdsdx(3,2) + horiztermdsdx(2,1) = - horiztermdsdx(3,2) + + horiztermdsdx(1,2) = - dsigmadxy * efvs(1) * fact + horiztermdsdx(2,2) = horiztermdsdx(2,2) + horiztermdsdx(1,2) + horiztermdsdx(2,1) = horiztermdsdx(2,1) - horiztermdsdx(1,2) + horiztermdsdx(1,1) = - horiztermdsdx(1,2) + + return + +end function horiztermdsdx + +!*********************************************************************** + +function horiztermdxds(dsigmadxy,efvs,fact) + + ! this is the d/dx(f.du/ds) and d/dy(f.du/ds) terms + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + real(dp), intent(in) :: dsigmadxy, fact + + real(dp), dimension(2,3) :: horiztermdxds + + horiztermdxds(2,3) = dsigmadxy * efvs(2) * fact + horiztermdxds(2,2) = horiztermdxds(2,3) + horiztermdxds(1,3) = - horiztermdxds(2,3) + horiztermdxds(1,2) = - horiztermdxds(2,3) + + horiztermdxds(2,1) = - dsigmadxy * efvs(1) * fact + horiztermdxds(2,2) = horiztermdxds(2,2) + horiztermdxds(2,1) + horiztermdxds(1,2) = horiztermdxds(1,2) - horiztermdxds(2,1) + horiztermdxds(1,1) = - horiztermdxds(2,1) + + return + +end function horiztermdxds + +!*********************************************************************** + +function horiztermdsds(dsigmadxysq,efvs,fact) + + ! this is the d/ds(f.du/ds) term + + implicit none + + real(dp), dimension(2), intent(in) :: efvs + real(dp), intent(in) :: dsigmadxysq, fact + + real(dp), dimension(3) :: horiztermdsds + + horiztermdsds(3) = dsigmadxysq * efvs(2) * fact + horiztermdsds(1) = dsigmadxysq * efvs(1) * fact + + horiztermdsds(2) = - horiztermdsds(3) - horiztermdsds(1) + + return + +end function horiztermdsds + +!*********************************************************************** + +function horiztermds(d2sigmadxy2etc,efvs,fact) + + ! this is the f.du/ds term + + implicit none + + real(dp), intent(in) :: efvs, d2sigmadxy2etc, fact + + real(dp), dimension(2) :: horiztermds + + horiztermds(2) = d2sigmadxy2etc * efvs * fact + horiztermds(1) = - horiztermds(2) + + return + +end function horiztermds + +! ---> end of routines for derivatives in the main body + +!*********************************************************************** + +subroutine fillsprsemain(inp,locplusup,ptindx,up,pt,osshift) + + ! scatter coefficients from 3x3x3 block "g" onto sparse matrix row + implicit none + + real(dp), dimension(3,3,3), intent(in):: inp + integer, intent(in) :: locplusup, up, pt + integer, dimension(6), intent(in) :: ptindx + integer, intent(in) :: osshift + + ! insert entries to "g" that are on same level + call putpcgc(inp(2,2,2),ptindx(1)+up+osshift,locplusup,pt) + call putpcgc(inp(2,3,2),ptindx(2)+up+osshift,locplusup,pt) + call putpcgc(inp(2,1,2),ptindx(3)+up+osshift,locplusup,pt) + call putpcgc(inp(2,2,3),ptindx(4)+up+osshift,locplusup,pt) + call putpcgc(inp(2,2,1),ptindx(5)+up+osshift,locplusup,pt) + + ! add points for level above (that is, points in "g" with a LARGER first index, + ! which correspond to grid points that are CLOSER TO THE BED than at current level) + call putpcgc(inp(3,2,2),ptindx(1)+up+1+osshift,locplusup,pt) + call putpcgc(inp(3,3,2),ptindx(2)+up+1+osshift,locplusup,pt) + call putpcgc(inp(3,1,2),ptindx(3)+up+1+osshift,locplusup,pt) + call putpcgc(inp(3,2,3),ptindx(4)+up+1+osshift,locplusup,pt) + call putpcgc(inp(3,2,1),ptindx(5)+up+1+osshift,locplusup,pt) + + ! add points for level below (that is, points in "g" with a SMALLER first index, + ! which correspond to grid points that are CLOSER TO THE SURFACE than at current level) + call putpcgc(inp(1,2,2),ptindx(1)+up-1+osshift,locplusup,pt) + call putpcgc(inp(1,3,2),ptindx(2)+up-1+osshift,locplusup,pt) + call putpcgc(inp(1,1,2),ptindx(3)+up-1+osshift,locplusup,pt) + call putpcgc(inp(1,2,3),ptindx(4)+up-1+osshift,locplusup,pt) + call putpcgc(inp(1,2,1),ptindx(5)+up-1+osshift,locplusup,pt) + + return + +end subroutine fillsprsemain + +!*********************************************************************** + +subroutine fillsprsebndy(inp,locplusup,ptindx,up,normal,pt) + + ! scatter coeff. from 3x3x3 block "g" onto sparse matrix row. This subroutine + ! is specifically for the boundary conditions, which are handled differently + ! than points in the "main" body of the domain (interior to boundaries). + implicit none + + integer, intent(in) :: locplusup, up, pt + integer, dimension(6), intent(in) :: ptindx + real(dp), dimension(3,3,3), intent(in) :: inp + real(dp), dimension(2), intent(in) :: normal + + ! at points where mixed centered and one-side diffs. would apply + if( normal(1) == 0.d0 )then ! at boundary normal to y, centered diffs in x + if( normal(2) == -1.d0 )then ! at boundary w/ normal [0,-1] + call putpcgc(inp(1,3,3),ptindx(5)+up-1,locplusup,pt) + call putpcgc( inp(2,3,3)+inp(1,2,1),ptindx(5)+up,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(5)+up+1,locplusup,pt) + call putpcgc(inp(1,2,3),ptindx(4)+up,locplusup,pt) + else ! at boundary w/ normal [0,1] + call putpcgc(inp(1,3,3),ptindx(4)+up-1,locplusup,pt) + call putpcgc(inp(2,3,3)+inp(1,2,3),ptindx(4)+up,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(4)+up+1,locplusup,pt) + call putpcgc(inp(1,2,1),ptindx(5)+up,locplusup,pt) + end if + call putpcgc(inp(1,2,2),ptindx(1)+up,locplusup,pt) + end if + + if( normal(2) == 0.d0 )then ! at boundary normal to x, centered diffs in y + if( normal(1) == -1.d0 )then ! at boundary w/ normal [-1,0] + call putpcgc(inp(1,3,3),ptindx(3)+up-1,locplusup,pt) + call putpcgc( inp(2,3,3)+inp(2,1,2),ptindx(3)+up,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(3)+up+1,locplusup,pt) + call putpcgc(inp(2,3,2),ptindx(2)+up,locplusup,pt) + else ! at boundary w/ normal [1,0] + call putpcgc(inp(1,3,3),ptindx(2)+up-1,locplusup,pt) + call putpcgc( inp(2,3,3)+inp(2,3,2),ptindx(2)+up,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(2)+up+1,locplusup,pt) + call putpcgc(inp(2,1,2),ptindx(3)+up,locplusup,pt) + end if + call putpcgc(inp(2,2,2),ptindx(1)+up,locplusup,pt) + end if + + ! at corners where only one-side diffs. apply + if( normal(1) > 0.d0 .and. normal(2) /= 0.d0 )then + if( normal(2) > 0.d0 )then ! corner w/ normal [ 1/sqrt(2), 1/sqrt(2) ] + call putpcgc(inp(1,3,3),ptindx(2)+up-1,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(2)+up+1,locplusup,pt) + call putpcgc(inp(2,3,3)+inp(2,3,2)+inp(1,2,3),ptindx(2)+up,locplusup,pt) + call putpcgc(inp(2,2,2),ptindx(1)+up,locplusup,pt) + call putpcgc(inp(1,2,2),ptindx(6)+up,locplusup,pt) + call putpcgc(inp(1,2,1),ptindx(5)+up,locplusup,pt) + call putpcgc(inp(2,1,2),ptindx(3)+up,locplusup,pt) + else ! corner w/ normal [ 1/sqrt(2), -1/sqrt(2) ] + call putpcgc(inp(1,3,3),ptindx(2)+up-1,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(2)+up+1,locplusup,pt) + call putpcgc(inp(2,3,3)+inp(1,2,1)+inp(2,3,2),ptindx(2)+up,locplusup,pt) + call putpcgc(inp(2,2,2),ptindx(1)+up,locplusup,pt) + call putpcgc(inp(2,1,2),ptindx(3)+up,locplusup,pt) + call putpcgc(inp(1,2,2),ptindx(6)+up,locplusup,pt) + call putpcgc(inp(1,2,3),ptindx(4)+up,locplusup,pt) + end if + end if + + if( normal(1) < 0.d0 .and. normal(2) /= 0.d0 )then + if( normal(2) > 0.d0 )then ! corner w/ normal [ -1/sqrt(2), 1/sqrt(2) ] + call putpcgc(inp(1,3,3),ptindx(3)+up-1,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(3)+up+1,locplusup,pt) + call putpcgc(inp(2,3,3)+inp(1,2,3)+inp(2,1,2),ptindx(3)+up,locplusup,pt) + call putpcgc(inp(2,2,2),ptindx(1)+up,locplusup,pt) + call putpcgc(inp(2,3,2),ptindx(2)+up,locplusup,pt) + call putpcgc(inp(1,2,2),ptindx(6)+up,locplusup,pt) + call putpcgc(inp(1,2,1),ptindx(5)+up,locplusup,pt) + else ! corner w/ normal [ -1/sqrt(2), -1/sqrt(2) ] + call putpcgc(inp(1,3,3),ptindx(3)+up-1,locplusup,pt) + call putpcgc(inp(3,3,3),ptindx(3)+up+1,locplusup,pt) + call putpcgc(inp(2,3,3)+inp(2,1,2)+inp(1,2,1),ptindx(3)+up,locplusup,pt) + call putpcgc(inp(2,2,2),ptindx(1)+up,locplusup,pt) + call putpcgc(inp(1,2,2),ptindx(6)+up,locplusup,pt) + call putpcgc(inp(2,3,2),ptindx(2)+up,locplusup,pt) + call putpcgc(inp(1,2,3),ptindx(4)+up,locplusup,pt) + end if + end if + + return + +end subroutine fillsprsebndy + +!*********************************************************************** + +subroutine getlatboundinfo( ew, ns, up, ewn, nsn, upn, & + thckin, loc_array, & + fwdorbwd, normal, loc_latbc, & + foew, fons) + + ! Calculate map plane normal vector at 45 deg. increments + ! for regions of floating ice + implicit none + + integer, intent(in) :: ew, ns, up + integer, intent(in) :: ewn, nsn, upn + integer, dimension(ewn,nsn), intent(in) :: loc_array + + real(dp), dimension(5,5), intent(in) :: thckin + + real(dp), dimension(2), intent(out) :: fwdorbwd, normal + integer, dimension(6), intent(out) :: loc_latbc + + logical, intent(out) :: fons, foew + + real(dp), dimension(3,3) :: mask, maskcorners + + integer, dimension(5,5) :: thckinmask + + real(dp), dimension(3,3) :: thckmask, thck + real(dp), dimension(3) :: testvect + real(dp) :: phi, deg2rad + + thck(:,:) = thckin(2:4,2:4) + thckinmask = 0 + +! deg2rad = 3.141592654d0 / 180.d0 + deg2rad = pi / 180.d0 + loc_latbc = 0; phi = 0.d0 + mask(:,1) = (/ 0.d0, 180.d0, 0.d0 /) + mask(:,2) = (/ 270.d0, 0.d0, 90.d0 /) + mask(:,3) = (/ 0.d0, 360.d0, 0.d0 /) + maskcorners(:,1) = (/ 225.d0, 0.d0, 135.d0 /) + maskcorners(:,2) = (/ 0.d0, 0.d0, 0.d0 /) + maskcorners(:,3) = (/ 315.d0, 0.d0, 45.d0 /) + + !! first section below contains logic to ID where 1st-order one-sided diffs are needed + where( thckin /= 0.d0 ) + thckinmask = 1 + endwhere + !! check if 1st-order one sided diffs. are needed in n/s direction + if( (thckinmask(3,3)+thckinmask(3,4)+thckinmask(3,5)) < 3 .and. (thckinmask(3,1)+thckinmask(3,2)) < 2 )then + !print *, '1st-order one-sided diffs. in N/S direction at ew,ns = ', ew, ns + fons = .true. + elseif( (thckinmask(3,1)+thckinmask(3,2)+thckinmask(3,3)) < 3 .and. (thckinmask(3,4)+thckinmask(3,5)) < 2 )then + !print *, '1st-order one-sided diffs. in N/S direction at ew,ns = ', ew, ns + fons = .true. + else + fons = .false. + endif + !! check if 1st-order one sided diffs. are needed in n/s direction + if( (thckinmask(3,3)+thckinmask(4,3)+thckinmask(5,3)) < 3 .and. (thckinmask(1,3)+thckinmask(2,3)) < 2 )then + !print *, '1st-order one-sided diffs. in E/W direction at ew,ns = ', ew, ns + foew = .true. + elseif( (thckinmask(1,3)+thckinmask(2,3)+thckinmask(3,3)) < 3 .and. (thckinmask(4,3)+thckinmask(5,3)) < 2 )then + !print *, '1st-order one-sided diffs. in E/W direction at ew,ns = ', ew, ns + foew = .true. + else + foew = .false. + endif + + ! specify new value of 'loc' vector such that fwd/bwd diffs. are set up correctly in sparse matrix + ! when function 'fillsprsebndy' is called. Also, specify appropriate values for the vectors 'normal' + ! and 'fwdorbwd', which specify the orientation of the boundary normal and the direction of forward or + ! backward differencing to be done in the lateral boundary condition functions 'normhorizmainbc_lat' + ! and 'croshorizmainbc_lat' + + ! following is algorithm for calculating boundary normal at 45 deg. increments, based on arbitray + ! boundary shape (based on initial suggestions by Anne LeBrocq) + where( thck /= 0.d0 ) + thckmask = 0.d0 + elsewhere( thck == 0.d0 ) + thckmask = 1.d0 + endwhere + + testvect = sum( thckmask * mask, 1 ) + + ! calculate the angle of the normal in cart. (x,y) system w/ 0 deg. at 12 O'clock, + ! 90 deg. at 3 O'clock, etc. + if( sum( sum( thckmask, 1 ) ) == 1.d0 )then + phi = sum( sum( thckmask * maskcorners, 1 ) ) + else + if( any( testvect == 360.d0 ) )then + if( sum( testvect ) == 450.d0 )then + phi = 45.d0 + elseif( sum( testvect ) == 630.d0 )then + phi = 315.d0 + else + phi = 0.d0 + end if + elseif( all( testvect /= 360 ) )then + phi = sum( testvect ) / sum( testvect/testvect, testvect /= 0.d0 ) + end if + end if + + ! define normal vectors and change definition of loc_array based on this angle + if( phi == 0.d0 )then + loc_latbc(1) = loc_array(ew,ns-1); loc_latbc(4) = loc_array(ew,ns); loc_latbc(5) = loc_array(ew,ns-2) + loc_latbc(2) = loc_array(ew+1,ns); loc_latbc(3) = loc_array(ew-1,ns) + normal = (/ 0.d0, 1.d0 /); fwdorbwd = (/ -1.d0, -1.d0 /) + elseif( phi == 45.d0 )then + loc_latbc(1) = loc_array(ew-1,ns); loc_latbc(2) = loc_array(ew,ns); loc_latbc(3) = loc_array(ew-2,ns) + loc_latbc(6) = loc_array(ew,ns-1); loc_latbc(4) = loc_array(ew,ns); loc_latbc(5) = loc_array(ew,ns-2) + normal = (/ 1.d0/sqrt(2.d0), 1.d0/sqrt(2.d0) /); fwdorbwd = (/ -1.d0, -1.d0 /) + elseif( phi == 90.d0 )then + loc_latbc(1) = loc_array(ew-1,ns); loc_latbc(2) = loc_array(ew,ns); loc_latbc(3) = loc_array(ew-2,ns) + loc_latbc(4) = loc_array(ew,ns+1); loc_latbc(5) = loc_array(ew,ns-1) + normal = (/ 1.d0, 0.d0 /); fwdorbwd = (/ -1.d0, -1.d0 /) + elseif( phi == 135.d0 )then + loc_latbc(1) = loc_array(ew-1,ns); loc_latbc(2) = loc_array(ew,ns); loc_latbc(3) = loc_array(ew-2,ns) + loc_latbc(6) = loc_array(ew,ns+1); loc_latbc(4) = loc_array(ew,ns+2); loc_latbc(5) = loc_array(ew,ns) + normal = (/ 1.d0/sqrt(2.d0), -1.d0/sqrt(2.d0) /); fwdorbwd = (/ -1.d0, 1.d0 /) + elseif( phi == 180.d0 )then + loc_latbc(1) = loc_array(ew,ns+1); loc_latbc(4) = loc_array(ew,ns+2); loc_latbc(5) = loc_array(ew,ns) + loc_latbc(2) = loc_array(ew+1,ns); loc_latbc(3) = loc_array(ew-1,ns) + normal = (/ 0.d0, -1.d0 /); fwdorbwd = (/ 1.d0, 1.d0 /) + elseif( phi == 225.d0 )then + loc_latbc(1) = loc_array(ew+1,ns); loc_latbc(2) = loc_array(ew+2,ns); loc_latbc(3) = loc_array(ew,ns) + loc_latbc(6) = loc_array(ew,ns+1); loc_latbc(4) = loc_array(ew,ns+2); loc_latbc(5) = loc_array(ew,ns); + normal = (/ -1.d0/sqrt(2.d0), -1.d0/sqrt(2.d0) /); fwdorbwd = (/ 1.d0, 1.d0 /) + elseif( phi == 270.d0 )then + loc_latbc(1) = loc_array(ew+1,ns); loc_latbc(2) = loc_array(ew+2,ns); loc_latbc(3) = loc_array(ew,ns) + loc_latbc(4) = loc_array(ew,ns+1); loc_latbc(5) = loc_array(ew,ns-1) + normal = (/ -1.d0, 0.d0 /); fwdorbwd = (/ 1.d0, 1.d0 /) + else + loc_latbc(1) = loc_array(ew+1,ns); loc_latbc(2) = loc_array(ew+2,ns); loc_latbc(3) = loc_array(ew,ns) + loc_latbc(6) = loc_array(ew,ns-1); loc_latbc(4) = loc_array(ew,ns); loc_latbc(5) = loc_array(ew,ns-2) + normal = (/ -1.d0/sqrt(2.d0), 1.d0/sqrt(2.d0) /); fwdorbwd = (/ 1.d0, -1.d0 /) + end if + + return + +end subroutine getlatboundinfo + +!*********************************************************************** + +function indshift( which, ew, ns, up, ewn, nsn, upn, loc_array, thck ) + + ! Subroutine to rearrange indices slightly at sfc,bed, and lateral boundaries, + ! so that values one index inside of the domain are used for, e.g. eff. visc. + + ! Function output is a vector containing necessary index shifts for portions of 'othervel' and 'efvs' + ! extracted near domain boundaries. NOTE that this contains duplication of some of the code in the + ! subroutine "getlatboundinfo", and the two could be combined at some point. + +!NOTE: Function indshift does not use loc_array. Remove from argument list? + + implicit none + + integer, intent(in) :: which + integer, intent(in) :: ew, ns, up, ewn, nsn, upn + integer, dimension(ewn,nsn), intent(in) :: loc_array + real(dp), dimension(3,3), intent(in) :: thck + + integer, dimension(3) :: indshift + integer :: upshift = 0, ewshift = 0, nsshift = 0 + + real(dp), dimension(3,3) :: mask, maskcorners + real(dp), dimension(3,3) :: thckmask + real(dp), dimension(3) :: testvect + real(dp) :: phi, deg2rad + +! deg2rad = 3.141592654d0 / 180.d0 + deg2rad = pi / 180.d0 + mask(:,1) = (/ 0.d0, 180.d0, 0.d0 /) + mask(:,2) = (/ 270.d0, 0.d0, 90.d0 /) + mask(:,3) = (/ 0.d0, 360.d0, 0.d0 /) + maskcorners(:,1) = (/ 225.d0, 0.d0, 135.d0 /) + maskcorners(:,2) = (/ 0.d0, 0.d0, 0.d0 /) + maskcorners(:,3) = (/ 315.d0, 0.d0, 45.d0 /) + + if( up == 1 )then !! first treat bed/sfc, which aren't complicated + upshift = 1 + elseif( up == upn )then + upshift = -1 + else + upshift = 0 + end if + + !NOTE - Remove hardwiring of case numbers? + select case(which) + + case(0) !! internal to lateral boundaries; no shift to ew,ns indices + + ewshift = 0; nsshift = 0; + + case(1) !! at lateral boundaries; shift to ew,ns may be non-zero + + where( thck /= 0.d0 ) + thckmask = 0.d0 + elsewhere( thck == 0.d0 ) + thckmask = 1.d0 + endwhere + + testvect = sum( thckmask * mask, 1 ) + + ! calculate the angle of the normal in cart. (x,y) system w/ 0 deg. at 12 O'clock, 90 deg. at 3 O'clock, etc. + if( sum( sum( thckmask, 1 ) ) == 1.d0 )then + phi = sum( sum( thckmask * maskcorners, 1 ) ) + else + if( any( testvect == 360.d0 ) )then + if( sum( testvect ) == 450.d0 )then + phi = 45.d0 + elseif( sum( testvect ) == 630.d0 )then + phi = 315.d0 + else + phi = 0.d0 + end if + elseif( all( testvect /= 360 ) )then + phi = sum( testvect ) / sum( testvect/testvect, testvect /= 0.d0 ) + end if + end if + + ! define shift to indices based on this angle + if( phi == 0.d0 )then + nsshift = -1; ewshift = 0 + elseif( phi == 45.d0 )then + nsshift = -1; ewshift = -1 + elseif( phi == 90.d0 )then + nsshift = 0; ewshift = -1 + elseif( phi == 135.d0 )then + nsshift = 1; ewshift = -1 + elseif( phi == 180.d0 )then + nsshift = 1; ewshift = 0 + elseif( phi == 225.d0 )then + nsshift = 1; ewshift = 1 + elseif( phi == 270.d0 )then + nsshift = 0; ewshift = 1 + elseif( phi == 315.d0 )then + nsshift = -1; ewshift = 1 + end if + + end select + + indshift = (/ upshift, ewshift, nsshift /) + + return + +end function indshift + +!*********************************************************************** + +function vertintg(upn, sigma, in) + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: sigma + real(dp), dimension(:), intent(in) :: in + real(dp) :: vertintg + + integer :: up + + vertintg = 0.d0 + + do up = upn-1, 1, -1 + vertintg = vertintg + sum(in(up:up+1)) * dups(up) + end do + + vertintg = vertintg / 2.d0 + + return + +end function vertintg + +!*********************************************************************** + +subroutine geom2derscros(ewn, nsn, & + dew, dns, & + ipvr, stagthck, opvrewns) + + ! geometric (2nd) cross-deriv. for generic input variable 'ipvr', output as 'opvr' + + implicit none + + integer, intent(in) :: ewn, nsn + real(dp), intent(in) :: dew, dns + real(dp), intent(out), dimension(:,:) :: opvrewns + real(dp), intent(in), dimension(:,:) :: ipvr, stagthck + + integer :: ew, ns + real(dp) :: dewdns + + dewdns = dew*dns + +! NOTE: Check this over and if ok remove old code !! +! *SFP* OLD method; replaced (below) w/ loops and logic for compatibility w/ gnu compilers +! where (stagthck /= 0.d0) +! opvrewns = (eoshift(eoshift(ipvr,1,0.d0,2),1,0.d0,1) + ipvr & +! - eoshift(ipvr,1,0.d0,1) - eoshift(ipvr,1,0.d0,2)) / (dewdns) +! elsewhere +! opvrewns = 0.d0 +! end where + +! *SFP* NEW method + + opvrewns = ( ipvr(2:ewn,2:nsn) - ipvr(2:ewn,1:nsn-1) - ipvr(1:ewn-1,2:nsn) + ipvr(1:ewn-1,1:nsn-1) ) / dewdns + + do ns = 1, nsn-1 + do ew = 1, ewn-1 + if (stagthck(ew,ns) == 0.d0) then + opvrewns(ew,ns) = 0.d0 + end if + end do + end do + + return + +end subroutine geom2derscros + + +!*********************************************************************** + +subroutine geom2ders(ewn, nsn, & + dew, dns, & + ipvr, stagthck, & + opvrew, opvrns) + + ! geometric 1st deriv. for generic input variable 'ipvr', + ! output as 'opvr' (includes 'upwinding' for boundary values) + + implicit none + + integer, intent(in) :: ewn, nsn + real(dp), intent(in) :: dew, dns + real(dp), intent(out), dimension(:,:) :: opvrew, opvrns + real(dp), intent(in), dimension(:,:) :: ipvr, stagthck + + integer :: ew, ns + real(dp) :: dewsq4, dnssq4 + + integer :: pt(2) + + dewsq4 = 4.d0 * dew * dew + dnssq4 = 4.d0 * dns * dns + + do ns = 2, nsn-2 + do ew = 2, ewn-2 + if (stagthck(ew,ns) > 0.d0) then + opvrew(ew,ns) = centerew(ew,ns,ipvr,dewsq4) + opvrns(ew,ns) = centerns(ew,ns,ipvr,dnssq4) + else + opvrew(ew,ns) = 0.d0 + opvrns(ew,ns) = 0.d0 + end if + end do + end do + + ! *** 2nd order boundaries using upwinding + +!NOTE - If nhalo = 2, then I'm not clear on why upwinding is needed. +! Where are these values used in the computation? +! I don't think they should be used for any interior halo cells. +! Are they needed at the global boundaries? If so, then need to use the correct indices for global boundaries. +! Would be easier if we could set global halos in a way that gives reasonable 2nd derivs +! without a special case. + + do ew = 1, ewn-1, ewn-2 + + pt = whichway(ew) + + do ns = 2, nsn-2 + if (stagthck(ew,ns) > 0.d0) then + opvrew(ew,ns) = boundyew(ns,pt,ipvr,dewsq4) + opvrns(ew,ns) = centerns(ew,ns,ipvr,dnssq4) + else + opvrew(ew,ns) = 0.d0 + opvrns(ew,ns) = 0.d0 + end if + end do + + end do + + do ns = 1, nsn-1, nsn-2 + + pt = whichway(ns) + + do ew = 2, ewn-2 + if (stagthck(ew,ns) > 0.d0) then + opvrew(ew,ns) = centerew(ew,ns,ipvr,dewsq4) + opvrns(ew,ns) = boundyns(ew,pt,ipvr,dnssq4) + else + opvrew(ew,ns) = 0.d0 + opvrns(ew,ns) = 0.d0 + end if + end do + + end do + + do ns = 1, nsn-1, nsn-2 + do ew = 1, ewn-1, ewn-2 + if (stagthck(ew,ns) > 0.d0) then + pt = whichway(ew) + opvrew(ew,ns) = boundyew(ns,pt,ipvr,dewsq4) + pt = whichway(ns) + opvrns(ew,ns) = boundyns(ew,pt,ipvr,dnssq4) + else + opvrew(ew,ns) = 0.d0 + opvrns(ew,ns) = 0.d0 + end if + end do + end do + +end subroutine geom2ders + +!*********************************************************************** + + function centerew(ew, ns, ipvr, dewsq4) + + implicit none + + integer, intent(in) :: ew, ns + real(dp), intent(in) :: ipvr(:,:) + real(dp), intent(in) :: dewsq4 + real(dp) :: centerew + + centerew = (sum(ipvr(ew+2,ns:ns+1)) + sum(ipvr(ew-1,ns:ns+1)) - & + sum(ipvr(ew+1,ns:ns+1)) - sum(ipvr(ew,ns:ns+1))) / dewsq4 + + return + + end function centerew + +!*********************************************************************** + + function centerns(ew, ns, ipvr, dnssq4) + + implicit none + + integer, intent(in) :: ew, ns + real(dp), intent(in) :: ipvr(:,:) + real(dp), intent(in) :: dnssq4 + real(dp) :: centerns + + centerns = (sum(ipvr(ew:ew+1,ns+2)) + sum(ipvr(ew:ew+1,ns-1)) - & + sum(ipvr(ew:ew+1,ns+1)) - sum(ipvr(ew:ew+1,ns))) / dnssq4 + + return + + end function centerns + +!*********************************************************************** + + function boundyew(ns,pt,ipvr,dewsq4) + + implicit none + + integer, intent(in) :: ns + integer, intent(in) :: pt(2) + real(dp), intent(in) :: ipvr(:,:) + real(dp), intent(in) :: dewsq4 + real(dp) :: boundyew + + boundyew = pt(1) * (3.d0 * sum(ipvr(pt(2),ns:ns+1)) - 7.d0 * sum(ipvr(pt(2)+pt(1),ns:ns+1)) + & + 5.d0 * sum(ipvr(pt(2)+2*pt(1),ns:ns+1)) - sum(ipvr(pt(2)+3*pt(1),ns:ns+1))) / dewsq4 + + return + + end function boundyew + +!*********************************************************************** + + function boundyns(ew,pt,ipvr,dnssq4) + + implicit none + + integer, intent(in) :: ew + integer, intent(in) :: pt(2) + real(dp), intent(in) :: ipvr(:,:) + real(dp), intent(in) :: dnssq4 + real(dp) :: boundyns + + boundyns = pt(1) * (3.d0 * sum(ipvr(ew:ew+1,pt(2))) - 7.d0 * sum(ipvr(ew:ew+1,pt(2)+pt(1))) + & + 5.d0 * sum(ipvr(ew:ew+1,pt(2)+2*pt(1))) - sum(ipvr(ew:ew+1,pt(2)+3*pt(1)))) / dnssq4 + + return + + end function boundyns + +!*********************************************************************** + + function whichway(i) + + implicit none + + integer, intent(in) :: i + integer :: whichway(2) + + if (i == 1) then + whichway = (/1,1/) + else + whichway = (/-1,i+1/) + end if + + return + + end function whichway + + +!*********************************************************************** + + function hsum(inp) + + implicit none + + real(dp), dimension(:,:,:), intent(in) :: inp + real(dp), dimension(size(inp,dim=1)) :: hsum + + hsum = sum(sum(inp(:,:,:),dim=3),dim=2) + + return + + end function hsum + +!*********************************************************************** + +subroutine putpcgc(value,col,row,pt) + + implicit none + + integer, intent(in) :: row, col + integer, intent(in), optional :: pt + real(dp), intent(in) :: value + + !*SFP*for now, ignoring the possibility of using JFNK w/ Trilinos ... + if( nonlinear == HO_NONLIN_PICARD )then + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + ! Option to load entry into Triad sparse matrix format + if (value /= 0.d0) then + pcgval(ct_nonzero) = value + pcgcol(ct_nonzero) = col + pcgrow(ct_nonzero) = row + ct_nonzero = ct_nonzero + 1 + end if +#ifdef TRILINOS + else + ! Option to load entry directly into Trilinos sparse matrix + if (value /= 0.d0) then + !AGS: If we find that sparsity changes inside a time step, + ! consider adding entry even for value==0. + call putintotrilinosmatrix(row, col, value) + + !JEFF: Verify matrix matches for globalIDs case + ! call verify_trilinos_rowcolval(row, col, value) + end if +#endif + end if + + + !*SFP* if using JFNK, store the main block diagonal coeffs and off diag coeffs + elseif ( nonlinear == HO_NONLIN_JFNK )then + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then ! if using Triad format to store matrix entries + + ! load entry into Triad sparse matrix format + if (value /= 0.d0) then + pcgval(ct_nonzero) = value + pcgcol(ct_nonzero) = col + pcgrow(ct_nonzero) = row + ct_nonzero = ct_nonzero + 1 + end if + +#ifdef TRILINOS + else ! if storing matrix entires directly in Trilinos sparse format + + if (value /= 0.d0) then + !AGS: If we find that sparsity changes inside a time step, + ! consider adding entry even for value==0. + call putintotrilinosmatrix(row, col, value) + end if +#endif + end if ! end of "if using Triad or Trilinos storage format" construct + + end if ! end of "if using Picard or JFNK for nonlinear solve" construct + + return + +end subroutine putpcgc + +!*********************************************************************** + + subroutine distributed_create_partition(ewn, nsn, upstride, indxmask, mySize, myIndices, myX, myY, myZ) + + ! distributed_create_partition builds myIndices ID vector for Trilinos using (ns,ew) coordinates in indxmask + ! upstride is the total number of vertical layers including any ghosts + ! indxmask is ice mask with non-zero values for cells with ice. + ! mySize is number of elements in myIndices + ! myIndices is integer vector in which IDs are def + + use parallel + + implicit none + + integer, intent(in) :: ewn, nsn, upstride + integer, intent(in), dimension(:,:) :: indxmask + integer, intent(in) :: mySize + integer, intent(out), dimension(:) :: myIndices + real(dp), intent(out), dimension(:) :: myX, myY, myZ + + integer :: ew, ns, pointno + integer :: glblID, upindx, slnindx + + ! Step through indxmask, but exclude halo + +! SFP: debug line below +! print *, 'mySize = ', mySize + + do ns = 1+staggered_lhalo, size(indxmask,2)-staggered_uhalo + do ew = 1+staggered_lhalo, size(indxmask,1)-staggered_uhalo + if ( indxmask(ew,ns) /= 0 ) then + pointno = indxmask(ew,ns) ! Note that pointno starts at value 1. If we step through correctly then consecutive values + ! write(*,*) "pointno = ", pointno + ! first layer ID is set from parallel_globalID, rest by incrementing through layers + glblID = parallel_globalID(ns, ew, upstride) + ! write(*,*) "global ID (ew, ns) = (", ew, ",", ns, ") ", glblID + upindx = 0 + do slnindx = (pointno - 1) * upstride + 1, pointno * upstride + ! slnindx is offset into myIndices for current ice cell's layers. upindx is offset from current globalID. + myIndices(slnindx) = glblID + upindx + ! Return coordinates for nodes. Assumes structured with dx=1,dy=1,dz=1.0e6 + myX(slnindx) = (ewlb+ew) * 1.0 + myY(slnindx) = (nslb+ns) * 1.0 + myZ(slnindx) = upindx * 1.0e-6 + upindx = upindx + 1 + ! write(*,*) "myIndices offset = ", slnindx + end do + endif + end do + end do + + return + + end subroutine distributed_create_partition + +!*********************************************************************** + + function distributed_globalID_to_localindex(globalID) + + ! distributed_globalID_to_localindex converts a globalID to its position in the solution vector. + ! It is a utility function that is not currently used, but retained for future debugging capability. + ! The function searches loc2_array(:,:,1) for the globalID closest to the + ! given globalID, then uses this difference and loc2_array(:,:,2) for the same ew,ns coordinates + ! to calculate (and return) the corresponding index. + ! Result is checked using myIndices. + ! loc2_array is assumed to be a module-level variable set by the routine getlocationarray. + ! myIndices is assumed to be a module-level variable which holds the local processor's ID partition list. + ! This function will work for both globalIDs and regular partitions. + ! In the latter case it is redundant, because the ID will be at the same index, so it is just an identity function. + ! Original implementation using myIndices, and then fast inverse, by JEFF 11/2010 and 11/2011 + ! Current loc2_array-based implementation by PW 12/2011 + + use parallel + + implicit none + + integer, intent(in) :: globalID + + integer :: distributed_globalID_to_localindex + +#ifdef globalIDs + !JEFF integer :: GlobalIDsGet ! C++ function with return value + integer :: ew, ns + integer :: minew, minns + integer :: curdiff, mindiff + integer :: lindex + + !LOOP NOTE: Please confirm that these are the correct loop bounds. + ! loc2_array-based search + minew = 1 + minns = 1 + mindiff = globalID +! do ns = 1+staggered_lhalo,size(loc2_array,2)-staggered_uhalo +! do ew = 1+staggered_lhalo,size(loc2_array,1)-staggered_uhalo + ! loc2_array(:,:,1) defined for all ew,ns, + ! while loc2_array(:,:,2) == 0 for halos and ice-free loactions + do ns = 1,size(loc2_array,2) + do ew = 1,size(loc2_array,1) + curdiff = globalID-loc2_array(ew,ns,1) + if ((curdiff >= 0) .and. (curdiff < mindiff)) then + mindiff = globalID-loc2_array(ew,ns,1) + minew = ew + minns = ns + endif + enddo + enddo + lindex = loc2_array(minew,minns,2) + mindiff + + if ( myIndices(lindex) == globalID ) then + distributed_globalID_to_localindex = lindex + return + else + write(*,*) "Error in distributed_globalID_to_localindex()." + write(*,*) "GlobalID to match = ", globalID + write(*,*) "GlobalID found = ", myIndices(lindex), "(lindex = ",lindex,")" + stop + endif + + ! linear search from beginning of myIndices. + ! Inefficient. There could be some ordering of myIndices that would enable us to us a binary search. Not certain at this time. + !JEFF do lindex = 1, size(myIndices) + !JEFF if ( myIndices(lindex) == globalID ) then + !JEFF distributed_globalID_to_localindex = lindex + !JEFF return + !JEFF endif + !JEFF end do + +#else + distributed_globalID_to_localindex = globalID + return +#endif + + end function distributed_globalID_to_localindex + +!*********************************************************************** + + subroutine verify_trilinos_rowcolval(row, col, value) + ! Translates back globalID row and col values to their original grid values and outputs the set + ! For verification of the matrix passed to Trilinos. + ! JEFF November 2010 + integer, intent(in) :: row, col + real(dp), intent(in) :: value + integer :: locrow, loccol + +#ifdef globalIDs + locrow = distributed_globalID_to_localindex(row) + loccol = distributed_globalID_to_localindex(col) +#else + locrow = row + loccol = col +#endif + + write (*,*) "Row = ", locrow, " Col = ", loccol, " Value = ", value + end subroutine verify_trilinos_rowcolval + +!*********************************************************************** + +function scalebasalbc( coeffblock, bcflag, lateralboundry, beta, efvs ) + + ! *SFP* This function is used to scale the matrix coeffs and rhs vector coeff + ! of the basal boundary condition when using JFNK for the nonlinear iteration + ! (iteration on viscosity). + implicit none + + integer, dimension(2), intent(in) :: bcflag + logical :: lateralboundry + real(dp), dimension(:,:,:), intent(in) :: coeffblock + real(dp), dimension(:,:,:), intent(in) :: efvs + real(dp), intent(in) :: beta !NOTE - Remove? Commented out in computation below + + real(dp) :: scale, scalebasalbc + + if( nonlinear == 1 )then + if( bcflag(1) == 1 )then + + ! use the dominant terms in the coeff associated with the velocity under consideration + !scale = beta / ( sum( efvs(2,:,:) ) / 4.d0 ) * (len0 / thk0) + + ! Use the magnitude of the coeff associated with the vert stress gradients. + ! NOTE that relevant coeffs are stored in diff parts of block depending + ! on type of boudnary + if( lateralboundry )then + scale = abs( coeffblock(3,3,3) ); + else + scale = abs( coeffblock(3,2,2) ); + end if + + if( scale <= 0.d0 )then + scale = 1.d0 + end if + + else + scale = 1.d0 + end if + + else + scale = 1.d0 + end if + + scalebasalbc = scale + + return + +end function scalebasalbc + +!*********************************************************************** + +subroutine assign_resid(model, uindx, umask, & + d2thckdewdns, d2usrfdewdns, pcgsize, gx_flag, matrixA, matrixC, L2norm, ewn, nsn) + + + use iso_c_binding + use glide_types, only : glide_global_type + use glimmer_sparse_type, only : sparse_matrix_type + + implicit none + + type(glide_global_type) ,intent(inout) :: model + type(sparse_matrix_type) ,intent(in) :: matrixA, matrixC + + integer :: i, j + integer ,intent(in) :: ewn, nsn + integer, dimension(2) ,intent(in) :: pcgsize + integer ,intent(in) :: gx_flag(2*pcgsize(1)) ! 0 :reg cell + integer ,intent(in) :: uindx(ewn-1,nsn-1), umask(ewn-1,nsn-1) + real(dp) ,intent(in) :: L2norm + real(dp) ,intent(in) :: d2thckdewdns(ewn-1,nsn-1), d2usrfdewdns(ewn-1,nsn-1) + + do i = 1, ewn-1 + do j = 1, nsn-1 + model%solver_data%ui(i,j) = uindx(i,j) + model%solver_data%um(i,j) = umask(i,j) + model%solver_data%d2thckcross(i,j) = d2thckdewdns(i,j) + model%solver_data%d2usrfcross(i,j) = d2usrfdewdns(i,j) + end do + end do + + model%solver_data%pcgsize = pcgsize + do i = 1, 2*pcgsize(1) + model%solver_data%gxf(i) = gx_flag(i) + end do + model%solver_data%L2norm = L2norm + model%solver_data%matrixA = matrixA + model%solver_data%matrixC = matrixC + +end subroutine assign_resid + +!------------------------------------------------------------------- + +! uvec is either u^k-1 or v^k-1 on input and Av-b or Cu-d on output + +subroutine res_vect ( matrix, uvec, bvec, nu, g_flag, L2square, whatsparse) + +use parallel + +use glimmer_paramets, only : dp +use glimmer_sparse_type +use glimmer_sparse +use glide_mask +use profile + +implicit none + +integer :: i, j, nu, nele, whatsparse ! nu: size of uvec and bvec +integer, dimension(nu), intent(in) :: g_flag ! 0 :reg cell + ! 1 :top ghost, 2 :base ghost + +type(sparse_matrix_type), intent(in) :: matrix + +real(dp), dimension(nu), intent(in) :: bvec +real(dp), dimension(nu), intent(inout) :: uvec +real(dp), dimension(nu) :: Au_b_wig +real(dp), intent(out) :: L2square +! +real(dp) :: scale_ghosts = 0.0d0 + +! calculate residual vector of the u OR v component + + Au_b_wig = 0d0 ! regular+ghost cells + +call t_startf("res_vect_matvec") + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + + do nele = 1, matrix%nonzeros + + i = matrix%row(nele) + j = matrix%col(nele) + Au_b_wig(i) = Au_b_wig(i) + matrix%val(nele) * uvec(j) + + enddo + +#ifdef TRILINOS + else + call matvecwithtrilinos(uvec, Au_b_wig); +#endif + endif +call t_stopf("res_vect_matvec") + + do i = 1, nu + Au_b_wig(i) = Au_b_wig(i) - bvec(i) + enddo + + uvec = Au_b_wig + +! AGS: Residual norm includes scaling to decrease importance of ghost values +! By calling it a redefinition of an inner product, it is kosher. + L2square = 0.d0 + do i = 1, nu + if (g_flag(i) == 0) then + L2square = L2square + Au_b_wig(i) * Au_b_wig(i) + else + L2square = L2square + scale_ghosts * Au_b_wig(i) * Au_b_wig(i) + endif + end do + + !JEFF Sum L2square across nodes +call t_startf("res_vect_reduce") + L2square = parallel_reduce_sum(L2square) +call t_stopf("res_vect_reduce") + + return + +end subroutine res_vect + +!------------------------------------------------------------------- + +subroutine res_vect_jfnk ( matrixA, matrixC, uvec, bvec, nu1, nu2, g_flag, L2square, whatsparse) + +! similar to res_vect, but state vector uvec and rhs vector bvec are now both velocities +! A and C matrices are separate, but eventually could be combined + +use glimmer_paramets, only : dp +use glimmer_sparse_type +use glimmer_sparse +use glide_mask + +implicit none + +integer :: i, j, nu1, nu2, nele, whatsparse ! nu2: size of uvec and bvec, size of u, v within + +type(sparse_matrix_type), intent(in) :: matrixA, matrixC + +integer, dimension(nu2) :: g_flag ! 0=reg cell, 1: top ghost, 2, base ghost +real(dp), dimension(nu2), intent(in) :: bvec +real(dp), dimension(nu2), intent(inout) :: uvec +real(dp), dimension(nu1) :: Au_b_wig, Cv_d_wig +real(dp), intent(out) :: L2square +! +real(dp) :: scale_ghosts = 0.0d0 + +! calculate residual vector of the u and v component + + Au_b_wig = 0d0 ! regular+ghost cells + Cv_d_wig = 0d0 ! regular+ghost cells + + if (whatsparse /= STANDALONE_TRILINOS_SOLVER) then + + do nele = 1, matrixA%nonzeros + + i = matrixA%row(nele) + j = matrixA%col(nele) + Au_b_wig(i) = Au_b_wig(i) + matrixA%val(nele) * uvec(j) + + enddo + + do nele = 1, matrixC%nonzeros + + i = matrixC%row(nele) + j = matrixC%col(nele) + Cv_d_wig(i) = Cv_d_wig(i) + matrixC%val(nele) * uvec(nu1+j) + + enddo + +#ifdef TRILINOS + else + + call matvecwithtrilinos(uvec(1:nu1), Au_b_wig); + call matvecwithtrilinos(uvec(nu1+1:nu2), Cv_d_wig); +#endif + endif + + do i = 1, nu1 + + Au_b_wig(i) = Au_b_wig(i) - bvec(i) + Cv_d_wig(i) = Cv_d_wig(i) - bvec(nu1+i) + + enddo + +! to do: combine A and C + + do i = 1, nu1 + + uvec(i) = Au_b_wig(i) + uvec(nu1+i) = Cv_d_wig(i) + + enddo + +! AGS: Residual norm includes scaling to decrease importance of ghost values +! By calling it a redefinition of an inner product, it is kosher. +! L2square = 0.0 +! do i = 1, nu1 +! if (g_flag(i) == 0) then +! L2square = L2square + Au_b_wig(i) * Au_b_wig(i) +! else +! L2square = L2square + scale_ghosts * Au_b_wig(i) * Au_b_wig(i) +! endif +! end do +! +! do i = 1, nu1 +! if (g_flag(nu1+i) == 0) then +! L2square = L2square + Cv_d_wig(i) * Cv_d_wig(i) +! else +! L2square = L2square + scale_ghosts * Cv_d_wig(i) * Cv_d_wig(i) +! endif +! end do +! when the combined version is used, convergence wrong +!NOTE (KJE) what is the comment above. What is wrong? + + do i = 1, nu2 + if (g_flag(i) == 0) then + L2square = L2square + uvec(i) * uvec(i) + else + L2square = L2square + scale_ghosts * uvec(i) * uvec(i) + endif + end do + + + return + +end subroutine res_vect_jfnk + +!------------------------------------------------------------------- + +subroutine slapsolve(xk_1, xk_size, c_ptr_to_object, NL_tol, pcgsize) + + use iso_c_binding + use glimmer_paramets, only : dp + use glide_types ,only : glide_global_type + use parallel + + implicit none + + real(dp), dimension(:), intent(out) :: xk_1 + integer(c_int) ,intent(in) ,value :: xk_size + type(c_ptr) ,intent(inout) :: c_ptr_to_object + real(dp) ,intent(in) :: NL_tol + integer, dimension(2) :: pcgsize + + type(glide_global_type) ,pointer :: fptr=>NULL() + + real(dp), dimension(:), allocatable :: xk_1_plus, vectx + real(dp), dimension(:), allocatable :: dx, F, F_plus + real(dp), dimension(:), allocatable :: wk1, wk2, rhs + real(dp), dimension(:,:), allocatable :: vv, wk + real(dp) :: L2norm_wig, tol, gamma_l, epsilon, NL_target + integer :: tot_its, itenb, maxiteGMRES, iout, icode + integer, parameter :: img = 20, img1 = img+1, kmax = 500 + integer :: k + + type(sparse_matrix_type) :: matrixA, matrixC + real(dp) :: L2norm + + allocate( vectx(2*pcgsize(1)), xk_1_plus(2*pcgsize(1)) ) + allocate( F(2*pcgsize(1)), F_plus(2*pcgsize(1)), dx(2*pcgsize(1)) ) + allocate( wk1(2*pcgsize(1)), wk2(2*pcgsize(1)), rhs(2*pcgsize(1)) ) + allocate( vv(2*pcgsize(1),img1), wk(2*pcgsize(1),img) ) + +! Iteration loop + + do k = 1, kmax + + call calc_F (xk_1, F, xk_size, c_ptr_to_object, 0) + + call c_f_pointer(c_ptr_to_object,fptr) ! convert C ptr to F ptr + L2norm = fptr%solver_data%L2norm + matrixA = fptr%solver_data%matrixA + matrixC = fptr%solver_data%matrixC + +! calcoffdiag = .false. ! next time calling calc_F, DO NOT save off diag matrix components + + L2norm_wig = sqrt(DOT_PRODUCT(F,F)) ! with ghost + +!============================================================================== +! -define nonlinear target (if k=1) +! -check at all k if target is reached +!============================================================================== + + if (k == 1) NL_target = NL_tol * (L2norm_wig + 1.0e-2) + + print *, 'L2 w/ghost (k)= ',k,L2norm_wig,L2norm + + if (L2norm_wig < NL_target) exit ! nonlinear convergence criterion + +!============================================================================== +! solve J(u^k-1,v^k-1)dx = -F(u^k-1,v^k-1) with fgmres, dx = [dv, du] +!============================================================================== + + rhs = -1.d0*F + + dx = 0.d0 ! initial guess + + call forcing_term (k, L2norm_wig, gamma_l) + + tol = gamma_l * L2norm_wig ! setting the tolerance for fgmres + + epsilon = 1.d-07 ! for J*vector approximation + + maxiteGMRES = 300 + + iout = 0 ! set higher than 0 to have res(ite) + + icode = 0 + + 10 CONTINUE +! icode = 0 means that fgmres has finished and sol contains the app. solution + + call fgmres (2*pcgsize(1),img,rhs,dx,itenb,vv,wk,wk1,wk2, & + tol,maxiteGMRES,iout,icode,tot_its) + + IF ( icode == 1 ) THEN ! precond step: use of Picard linear solver + ! wk2 = P^-1*wk1 + call apply_precond_nox( wk2, wk1, xk_size, c_ptr_to_object ) + GOTO 10 + ELSEIF ( icode >= 2 ) THEN ! matvec step: Jacobian free approach + ! J*wk1 ~ wk2 = (F_plus - F)/epsilon + +! form v^k-1_plus = v^k-1 + epsilon*wk1v. We use solver_postprocess to +! transform vk_1_plus from a vector to a 3D field. (same idea for u^k-1_plus) + vectx(:) = wk1(1:2*pcgsize(1)) ! for v and u + xk_1_plus = xk_1 + epsilon*vectx + +! form F(x + epsilon*wk1) = F(u^k-1 + epsilon*wk1u, v^k-1 + epsilon*wk1v) + call calc_F (xk_1_plus, F_plus, xk_size, c_ptr_to_object, 1) + +! put approximation of J*wk1 in wk2 + + wk2 = ( F_plus - F ) / epsilon + + GOTO 10 + ENDIF + +!------------------------------------------------------------------------ +! End of FGMRES method +!------------------------------------------------------------------------ + if (tot_its == maxiteGMRES) then + print *,'WARNING: FGMRES has not converged' + stop + endif + +!------------------------------------------------------------------------ +! Update solution vectors (x^k = x^k-1 + dx) and 3D fields +!------------------------------------------------------------------------ + xk_1 = xk_1 + dx(1:2*pcgsize(1)) + + end do ! k = 1, kmax + + deallocate(dx, vectx, xk_1_plus) + deallocate(F, F_plus, rhs) + deallocate(wk1, wk2) + deallocate(vv, wk) + +end subroutine slapsolve + +!----------------------------------------------------------------------- + + subroutine fgmres (n,im,rhs,sol,i,vv,w,wk1, wk2, & + eps,maxits,iout,icode,its) + +! JFL to be removed + +!----------------------------------------------------------------------- +! jfl Dec 1st 2006. We modified the routine so that it is double precison. +! Here are the modifications: +! 1) implicit real (a-h,o-z) becomes implicit real*8 (a-h,o-z) +! 2) real bocomes real*8 +! 3) subroutine scopy.f has been changed for dcopy.f +! 4) subroutine saxpy.f has been changed for daxpy.f +! 5) function sdot.f has been changed for ddot.f +! 6) 1e-08 becomes 1d-08 +! +! Be careful with the dcopy, daxpy and ddot code...there is a slight +! difference with the single precision versions (scopy, saxpy and sdot). +! In the single precision versions, the array are declared sightly differently. +! It is written for single precision: +! +! modified 12/3/93, array(1) declarations changed to array(*) +!----------------------------------------------------------------------- + + implicit double precision (a-h,o-z) !jfl modification + integer n, im, maxits, iout, icode + double precision rhs(*), sol(*), vv(n,im+1),w(n,im) + double precision wk1(n), wk2(n), eps +!----------------------------------------------------------------------- +! flexible GMRES routine. This is a version of GMRES which allows a +! a variable preconditioner. Implemented with a reverse communication +! protocole for flexibility - +! DISTRIBUTED VERSION (USES DISTDOT FOR DDOT) +! explicit (exact) residual norms for restarts +! written by Y. Saad, modified by A. Malevsky, version February 1, 1995 +!----------------------------------------------------------------------- +! This Is A Reverse Communication Implementation. +!------------------------------------------------- +! USAGE: (see also comments for icode below). FGMRES +! should be put in a loop and the loop should be active for as +! long as icode is not equal to 0. On return fgmres will +! 1) either be requesting the new preconditioned vector applied +! to wk1 in case icode==1 (result should be put in wk2) +! 2) or be requesting the product of A applied to the vector wk1 +! in case icode==2 (result should be put in wk2) +! 3) or be terminated in case icode == 0. +! on entry always set icode = 0. So icode should be set back to zero +! upon convergence. +!----------------------------------------------------------------------- +! Here is a typical way of running fgmres: +! +! icode = 0 +! 1 continue +! call fgmres (n,im,rhs,sol,i,vv,w,wk1, wk2,eps,maxits,iout,icode) +! +! if (icode == 1) then +! call precon(n, wk1, wk2) <--- user's variable preconditioning +! goto 1 +! else if (icode >= 2) then +! call matvec (n,wk1, wk2) <--- user's matrix vector product. +! goto 1 +! else +! ----- done ---- +! ......... +!----------------------------------------------------------------------- +! list of parameters +!------------------- +! +! n == integer. the dimension of the problem +! im == size of Krylov subspace: should not exceed 50 in this +! version (can be reset in code. looking at comment below) +! rhs == vector of length n containing the right hand side +! sol == initial guess on input, approximate solution on output +! vv == work space of size n x (im+1) +! w == work space of length n x im +! wk1, +! wk2, == two work vectors of length n each used for the reverse +! communication protocole. When on return (icode \= 1) +! the user should call fgmres again with wk2 = precon * wk1 +! and icode untouched. When icode==1 then it means that +! convergence has taken place. +! +! eps == tolerance for stopping criterion. process is stopped +! as soon as ( ||.|| is the euclidean norm): +! || current residual||/||initial residual|| <= eps +! +! maxits== maximum number of iterations allowed +! +! iout == output unit number number for printing intermediate results +! if (iout <= 0) no statistics are printed. +! +! icode = integer. indicator for the reverse communication protocole. +! ON ENTRY : icode should be set to icode = 0. +! ON RETURN: +! * icode == 1 value means that fgmres has not finished +! and that it is requesting a preconditioned vector before +! continuing. The user must compute M**(-1) wk1, where M is +! the preconditioing matrix (may vary at each call) and wk1 is +! the vector as provided by fgmres upun return, and put the +! result in wk2. Then fgmres must be called again without +! changing any other argument. +! * icode == 2 value means that fgmres has not finished +! and that it is requesting a matrix vector product before +! continuing. The user must compute A * wk1, where A is the +! coefficient matrix and wk1 is the vector provided by +! upon return. The result of the operation is to be put in +! the vector wk2. Then fgmres must be called again without +! changing any other argument. +! * icode == 0 means that fgmres has finished and sol contains +! the approximate solution. +! comment: typically fgmres must be implemented in a loop +! with fgmres being called as long icode is returned with +! a value \= 0. +!----------------------------------------------------------------------- +! local variables -- !jfl modif + double precision hh(201,200),c(200),s(200),rs(201),t,ro,ddot,sqrt +! +!------------------------------------------------------------- +! arnoldi size should not exceed 50 in this version.. +! to reset modify sizes of hh, c, s, rs +!------------------------------------------------------------- + + save + data epsmac/1.d-16/ + + !WHL - added integer declarations + integer :: i, its, i1, ii, j, jj, k, k1, n1 +! +! computed goto +! + goto (100,200,300,11) icode +1 + 100 continue + n1 = n + 1 + its = 0 +!------------------------------------------------------------- +! ** outer loop starts here.. +!--------------compute initial residual vector -------------- +! 10 continue + call dcopy (n, sol, 1, wk1, 1) !jfl modification + icode = 3 + return + 11 continue + do j=1,n + vv(j,1) = rhs(j) - wk2(j) + enddo + 20 ro = ddot(n, vv, 1, vv,1) !jfl modification + ro = sqrt(ro) + if (ro == 0.0d0) goto 999 + t = 1.0d0/ ro + do j=1, n + vv(j,1) = vv(j,1)*t + enddo + if (its == 0) eps1=eps + if (its == 0) r0 = ro + if (iout > 0) write(*, 199) its, ro!& +! print *,'chau',its, ro !write(iout, 199) its, ro +! +! initialize 1-st term of rhs of hessenberg system.. +! + rs(1) = ro + i = 0 + 4 i=i+1 + its = its + 1 + i1 = i + 1 + do k=1, n + wk1(k) = vv(k,i) + enddo +! +! return +! + icode = 1 + + return + 200 continue + do k=1, n + w(k,i) = wk2(k) + enddo +! +! call matvec operation +! + icode = 2 + call dcopy(n, wk2, 1, wk1, 1) !jfl modification +! +! return +! + return + 300 continue +! +! first call to ope corresponds to intialization goto back to 11. +! +! if (icode == 3) goto 11 + call dcopy (n, wk2, 1, vv(1,i1), 1) !jfl modification +! +! modified gram - schmidt... +! + do j=1, i + t = ddot(n, vv(1,j), 1, vv(1,i1), 1) !jfl modification + hh(j,i) = t + call daxpy(n, -t, vv(1,j), 1, vv(1,i1), 1) !jfl modification + enddo + t = sqrt(ddot(n, vv(1,i1), 1, vv(1,i1), 1)) !jfl modification + hh(i1,i) = t + if (t == 0.0d0) goto 58 + t = 1.0d0 / t + do k=1,n + vv(k,i1) = vv(k,i1)*t + enddo +! +! done with modified gram schimd and arnoldi step. +! now update factorization of hh +! + 58 if (i == 1) goto 121 +! +! perfrom previous transformations on i-th column of h +! + do k=2,i + k1 = k-1 + t = hh(k1,i) + hh(k1,i) = c(k1)*t + s(k1)*hh(k,i) + hh(k,i) = -s(k1)*t + c(k1)*hh(k,i) + enddo + 121 gam = sqrt(hh(i,i)**2 + hh(i1,i)**2) + if (gam == 0.0d0) gam = epsmac +!-----------#determine next plane rotation #------------------- + c(i) = hh(i,i)/gam + s(i) = hh(i1,i)/gam + rs(i1) = -s(i)*rs(i) + rs(i) = c(i)*rs(i) +! +! determine res. norm. and test for convergence- +! + hh(i,i) = c(i)*hh(i,i) + s(i)*hh(i1,i) + ro = abs(rs(i1)) + if (iout > 0) & + write(*, 199) its, ro + if (i < im .and. (ro > eps1)) goto 4 +! +! now compute solution. first solve upper triangular system. +! + rs(i) = rs(i)/hh(i,i) + do ii=2,i + k=i-ii+1 + k1 = k+1 + t=rs(k) + do j=k1,i + t = t-hh(k,j)*rs(j) + enddo + rs(k) = t/hh(k,k) + enddo +! +! done with back substitution.. +! now form linear combination to get solution +! + do j=1, i + t = rs(j) + call daxpy(n, t, w(1,j), 1, sol,1) !jfl modification + enddo +! +! test for return +! + if (ro <= eps1 .or. its >= maxits) goto 999 +! +! else compute residual vector and continue.. +! +! goto 10 + + do j=1,i + jj = i1-j+1 + rs(jj-1) = -s(jj-1)*rs(jj) + rs(jj) = c(jj-1)*rs(jj) + enddo + do j=1,i1 + t = rs(j) + if (j == 1) t = t-1.0d0 + call daxpy (n, t, vv(1,j), 1, vv, 1) + enddo +! +! restart outer loop. +! + goto 20 + 999 icode = 0 + + 199 format(' -- fmgres its =', i4, ' res. norm =', d26.16) +! + return + + end subroutine fgmres +!----------------------------------------------------------------------- + +!*********************************************************************************************** +!BELOW here are deprecated boundary condition subroutines that have been replaced by newer +! ones (using one sided differences) or slightly altered ones. +!*********************************************************************************************** + +!*********************************************************************************************** +!NOTE: This subroutine has been deprecated because it is has been replaced by +! 'normhorizmainbcos', where the "os" stands for one-sided difference. +function normhorizmainbc(dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, bcflag, & + dup, & + oneorfour, fourorone) + + ! Determines higher-order surface and basal boundary conditions for LHS of equation. + ! Gives 3x3x3 coeff. array for either u or v component of velocity, depending on the + ! value of the flag 'which'. Example of function call: + ! + ! g = normhorizmainbc(dusrfew(ew,ns),dusrfnx(ew,ns),dsigmadew(up),dsigmadns(up),which,up,bcflag) + ! + ! ... where g is a 3x3x3 array. + ! + ! 'bcflag' is a 1 x 2 vector to indicate (1) which b.c. is being solved for (surface or bed) and + ! (2), if solving for the bed b.c., which type of b.c. to use. For example, bcflag = [ 0, 0 ] + ! denotes free sfc bc; bcflag = [ 1, 0 ] denotes basal bc w/ u=v=0, etc. (see also subroutine + ! "bodyset"). "fourorone" and "oneorfour" are given by vectors: fourorone = [ 4 1 ]; oneorfour = [ 1 4 ]. + ! A single value is chosen from each vector and applied to the calculation of coefficients below. + ! The "correct" value needed to satisfy the expression is chosen based on the "which" flag, which + ! takes on a value of 1 for calculations in the x direction and a value of 2 for calculations in + ! the y direction. + + implicit none + + real(dp), intent(in) :: dew, dns + real(dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real(dp), intent(in), dimension(2) :: oneorfour, fourorone + real(dp), dimension(3,3,3) :: normhorizmainbc + real(dp), dimension(3,3,3) :: g + real(dp) :: c + + integer, intent(in) :: which + integer, intent(in), dimension(2) :: bcflag + + c = 0.d0 + g(:,:,:) = 0.d0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this handles the case for specified stress at the bed as well, as we + ! simply pass in a different value for the normal vector (slope) components (still + ! called "dusrfdns", "dusrfdew" here, but args passed in are different). + if( bcflag(1) == 1 )then + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... + c = ( fourorone(which) * dusrfdew * dsigmadew & + + oneorfour(which) * dusrfdns * dsigmadns )/(2*dup) + g(3,2,2) = -c + g(1,2,2) = c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... + c = fourorone(which) * dusrfdew / (2*dew) + g(2,3,2) = c + g(2,1,2) = -c + + c = oneorfour(which) * dusrfdns / (2*dns) + g(2,2,3) = c + g(2,2,1) = -c + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! note that this requires that rhs(up) be set to 0 as well ... + else if( bcflag(1) == 0 )then + + g(:,:,:) = 0.d0 + g(2,2,2) = 1.d0; + + end if + + normhorizmainbc = g + + return + +end function normhorizmainbc + +!*********************************************************************** +!NOTE: This subroutine has been deprecated because it is has been replaced by +! 'croshorizmainbcos', where the "os" stands for one-sided difference. +function croshorizmainbc(dew, dns, & + dusrfdew, dusrfdns, & + dsigmadew, dsigmadns, & + which, bcflag, & + dup, local_othervel, & + efvs, & + oneortwo, twoorone, & + g_cros, velbc ) + + ! As described for "normhorizmainbc" above. The vectors "twoorone" and + ! "oneortwo" are given by: twoorone = [ 2 1 ]; oneortwo = [ 1 2 ]; + + implicit none + + integer, intent(in) :: which + integer, intent(in), dimension(:) :: bcflag + + real(dp), intent(in) :: dew, dns + real(dp), intent(in), dimension(:) :: oneortwo, twoorone + real(dp), intent(in) :: dusrfdew, dusrfdns, dsigmadew, dsigmadns, dup + real(dp), intent(in), dimension(:,:,:) :: local_othervel + real(dp), intent(in), dimension(:,:,:) :: efvs + real(dp), intent(in), optional :: velbc + real(dp), intent(out),dimension(:,:,:) :: g_cros + + real(dp), dimension(3,3,3) :: g, croshorizmainbc + real(dp) :: c + integer :: nz + + c = 0.d0 + g(:,:,:) = 0.d0 + g_cros = g + nz = 0 + + ! for higher-order FREE SURFACE B.C. for x ('which'=1) or y ('which'=2) direction ... + ! NOTE that this handles the case for specified stress at the bed as well, as we + ! simply pass in a different value for the normal vector (slope) components (still + ! called "dusrfdns", "dusrfdew" here, but args passed in are different). + if( bcflag(1) == 1 )then + + ! first, coeff. that go with du/dsigma, and thus are associated + ! with u(1,2,2) and u(3,2,2) ... + c = ( - twoorone(which) * dusrfdew * dsigmadns & + - oneortwo(which) * dusrfdns * dsigmadew )/(2*dup) + g(3,2,2) = -c + g(1,2,2) = c + + ! next, coeff. that go with du/dxhat and du/dyhat terms ... + c = - oneortwo(which) * dusrfdns / (2*dew) + g(2,3,2) = c + g(2,1,2) = -c + + c = - twoorone(which) * dusrfdew / (2*dns) + g(2,2,3) = c + g(2,2,1) = -c + + ! for higher-order BASAL B.C. U=V=0, in x ('which'=1) or y ('which'=2) direction ... + ! This forces the multiplication by 'local_otherval' in the main program + ! to result in a value of 1, thus leaving the boundary vel. unchanged + ! ... conditional makes sure there is no div by zero if the bc value IS also zero + else if( bcflag(1) == 0 )then + + g(:,:,:) = 0.d0 + + where( local_othervel /= 0.d0 ) + g = 1 + elsewhere + g = 0.d0 + endwhere + + nz = sum( g ) + g(:,:,:) = 0.d0 + + where( local_othervel /= 0.d0 ) + g = ( velbc / nz ) / local_othervel + elsewhere + g = 0.d0 + endwhere + + end if + + ! NOTE: here we define 'g_cros' FIRST, because we want the value w/o the plastic + ! bed coeff. included (needed for estimate of basal traction in plastic bed iteration) + g_cros = g + + croshorizmainbc = g + + return + +end function croshorizmainbc + +!*********************************************************************************************** +!ABOVE here are deprecated boundary condition subroutines that have been replaced by newer +! ones (using one sided differences) or slightly altered ones. +!*********************************************************************************************** + + +end module glam_strs2 + +!!!*********************************************************************** diff --git a/components/cism/glimmer-cism/libglide/glam_velo.F90 b/components/cism/glimmer-cism/libglide/glam_velo.F90 new file mode 100644 index 0000000000..ae7977be7b --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glam_velo.F90 @@ -0,0 +1,340 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glam_velo.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif +#include "glide_nan.inc" +#include "glide_mask.inc" + +!NOTE - What is shapedbg? +#define shapedbg(x) write(*,*) "x", shape(x) + +module glam_velo + + use parallel + use glimmer_global, only : dp + + ! Driver for glam higher-order velocity solver + + implicit none + + private + public :: glam_velo_driver, glam_basal_friction + +contains + + subroutine glam_velo_driver(model) + + ! Glissade higher-order velocity driver + + use glimmer_log + use glide_types + use glam_strs2, only: glam_velo_solver, JFNK_velo_solver +!!sp use glissade_basal_traction, only: calcbeta + use glam_grid_operators, only: glam_geometry_derivs, df_field_2d_staggered + use glide_grid_operators, only: stagvarb + use glide_mask + use glide_stress + use glimmer_paramets, only: tau0, vel0 + use glimmer_physcon, only: scyr + + type(glide_global_type),intent(inout) :: model + + logical, parameter :: verbose_glam_velo = .false. + integer :: i, j, k + + !------------------------------------------------------------------- + ! Velocity prep; compute geometry info. + !------------------------------------------------------------------- + + !NOTE - The next chunk of code needs work. Several calls are repeated. + ! We should work out which calls are actually needed. + + ! ------------------------------------------------------------------------ + ! Now that geometry (thck, topg, lsrf, usrf) is finalized for the time step, + ! calculate derivatives that may be needed for the velocity solve. + ! ------------------------------------------------------------------------ + + !NOTE - Make sure these geometry derivs are computed everywhere they are needed + ! (all locally owned velocity points?) + + + !NOTE - The subroutine glam_geometry_derivs calls subroutine stagthickness to compute stagthck. + ! Similarly for dthckdew/ns and dusrfdew/ns + ! I don't know why we need to call the next three subroutines as well as glam_geometry_derivs. + ! This calculation of stagthck differs from that in glam_geometry_derivs which calls stagthickness() + ! in glide_grids.F90 Which do we want to use? + ! stagthickness() seems to be noisier but there are notes in there about some issue related to margins. + + ! SFP: not sure if these are all needed here or not. Halo updates for usrf and thck are needed in order + ! for periodic bcs to work. Otherwise, global halos do not contain correct values and, presumably, the gradients + ! calculated below are incorrect in and near the global halos. + ! Calls were added here for other staggered variables (stagusrf, stagtopg, and staglsrf), first providing halo + ! updates to the non-stag vars, then calc. their stag values. This was done because debug lines show that these + ! stag fields did not have the correct values in their global halos. This may be ok if they are not used at all + ! by the dycores called here, but I added them for consistency. More testing needed to determine if they are + ! essential or not. + + ! SFP: for consistency, I added these calls, so that all scalars interpolated to the stag mesh + ! first have had their global halos updated. As w/ above calls to halo updates, these may be better + ! placed elsewhere. The only call originally here was the one to calc stagthck. + + !NOTE - Should we replace these with calls to df_field_2d_staggered? + + call stagvarb(model%geometry%usrf, model%geomderv%stagusrf,& + model%general%ewn, model%general%nsn) + + call stagvarb(model%geometry%lsrf, model%geomderv%staglsrf,& + model%general%ewn, model%general%nsn) + + call stagvarb(model%geometry%topg, model%geomderv%stagtopg,& + model%general%ewn, model%general%nsn) + + call stagvarb(model%geometry%thck, model%geomderv%stagthck,& ! SFP: this call was already here. Calls to calc + model%general%ewn, model%general%nsn) ! stagusrf, staglsrf, and stagtopg were added + + + call df_field_2d_staggered(model%geometry%usrf, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%geometry%thck, model%numerics%thklim ) + + call df_field_2d_staggered(model%geometry%thck, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dthckdew, model%geomderv%dthckdns, & + model%geometry%thck, model%numerics%thklim ) + + !SFP: W.r.t WHL comment below, I went the other route above - that is, did halo updates for the non-stag + !fields first, then did the subroutine calls to calc. fields on the unstag mesh. I think this makes sure + !you are not populating the stag field global halos with bad information that may have been sitting in the + !associated non-stag field halos in the case that you forgot to update them. Maybe? + + !NOTE - Not sure halo updates are needed for dusrfdew, etc. + !Halo updates required for inputs to glide_stress? + call staggered_parallel_halo (model%geomderv%dusrfdew) + call staggered_parallel_halo (model%geomderv%dusrfdns) + call staggered_parallel_halo (model%geomderv%dthckdew) + call staggered_parallel_halo (model%geomderv%dthckdns) + ! call parallel_halo(model%geometry%thkmask) in earlier glide_set_mask call + + ! Compute the new geometry derivatives for this time step + ! NOTE Merge glam_geometry_derivs with the above calculation. + + !SFP: For some reason, this next call IS needed. It does not affect the results of the periodic ismip-hom test case either + ! way (that is, if it is active or commented out), or the dome test case. But for some reason, if it is not active, it + ! messes up both shelf test cases. There must be some important derivs being calculated within this call that are NOT + ! being explicitly calculated above. + + ! Compute stagthck, staglsrf, stagtopg, dusrfdew/dns, dthckdew/dns, dlsrfdew/dns, d2thckdew2/dns2, d2usrfdew2/dns2 + + call glam_geometry_derivs(model) + + !WHL - This is the end of the geometry calculations that need to be streamlined. + + !NOTE - Verify that glide_set_mask works correctly when the input field is on the velo grid. + ! Would be safer to call a set_mask_staggered subroutine? + + !Compute the "geometry mask" (type of square) for the staggered grid + + call glide_set_mask(model%numerics, & + model%geomderv%stagthck, model%geomderv%stagtopg, & + model%general%ewn-1, model%general%nsn-1, & + model%climate%eus, model%geometry%stagmask) + + ! call stag_parallel_halo (model%geometry%stagmask) + + !Augment masks with kinematic boundary condition info + call augment_kinbc_mask(model%geometry%thkmask, model%velocity%kinbcmask) + call augment_kinbc_mask(model%geometry%stagmask, model%velocity%kinbcmask) + + ! save the final mask to 'dynbcmask' for exporting to netCDF output file + model%velocity%dynbcmask = model%geometry%stagmask + + !------------------------------------------------------------------- + ! Compute the velocity field + !------------------------------------------------------------------- + + if (model%options%which_ho_nonlinear == HO_NONLIN_PICARD ) then ! Picard (standard solver) + + call t_startf('glam_velo_solver') + call glam_velo_solver( model%general%ewn, model%general%nsn, & + model%general%upn, & + model%numerics%dew, model%numerics%dns, & + model%numerics%sigma, model%numerics%stagsigma, & + model%geometry%thck, model%geometry%usrf, & + model%geometry%lsrf, model%geometry%topg, & + model%geomderv%dthckdew, model%geomderv%dthckdns, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%geomderv%dlsrfdew, model%geomderv%dlsrfdns, & + model%geomderv%stagthck, model%temper%flwa, & + model%velocity%btraction, & + model%geometry%stagmask, & + model%options%which_ho_babc, & + model%options%which_ho_efvs, & + model%options%which_ho_resid, & + model%options%which_ho_nonlinear, & + model%options%which_ho_sparse, & + model%velocity%beta, & + model%paramets%ho_beta_const, & + model%basalproc%mintauf, & + model%temper%bwat, & + model%basal_physics, & + model%velocity%uvel, model%velocity%vvel, & + model%velocity%uflx, model%velocity%vflx, & + model%stress%efvs ) + call t_stopf('glam_velo_solver') + + else if ( model%options%which_ho_nonlinear == HO_NONLIN_JFNK ) then ! JFNK + + ! noxsolve could eventually go here + !NOTE - Remove model%geometry%stagmask from argument list; just pass in model + ! (model%geometry%stagmask used to be called geom_mask_stag, which was not part of model derived type) + + call t_startf('JFNK_velo_solver') + call JFNK_velo_solver (model, model%geometry%stagmask) + call t_stopf('JFNK_velo_solver') + + else + call write_log('Invalid which_ho_nonlinear option.',GM_FATAL) + end if ! which_ho_nonlinear + + ! Compute internal stresses + call glide_calcstrsstr(model) + + !WHL - debug - output internal stresses and velocity at a diagnostic point + if (verbose_glam_velo .and. this_rank==model%numerics%rdiag_local) then + i = model%numerics%idiag_local + j = model%numerics%jdiag_local + print*, ' ' + print*, ' ' + print*, 'i, j =', i, j + print*, 'k, tau_xz, tau_yz, tau_xx, tau_yy, tau_xy, tau_eff:' + do k = 1, model%general%upn-1 + print*, k, tau0*model%stress%tau%xz(k,i,j), tau0*model%stress%tau%yz(k,i,j), & + tau0*model%stress%tau%xx(k,i,j), tau0*model%stress%tau%yy(k,i,j), & + tau0*model%stress%tau%xy(k,i,j), tau0*model%stress%tau%scalar(k,i,j) + enddo + print*, 'New velocity: rank, i, j =', this_rank, i, j + print*, 'k, uvel, vvel:' + do k = 1, model%general%upn + print*, k, vel0*scyr*model%velocity%uvel(k,i,j), vel0*scyr*model%velocity%vvel(k,i,j) + enddo + endif + + end subroutine glam_velo_driver + +!======================================================================= + + subroutine glam_basal_friction (ewn, nsn, & + ice_mask, floating_mask, & + ubas, vbas, & + btraction, bfricflx) + + ! Compute frictional heat source due to sliding at the bed + ! Based on a subroutine that used to be in glissade_temp.F90 + ! but now is used only by Glam + + use glimmer_paramets, only: vel0, vel_scale + + !----------------------------------------------------------------- + ! Input/output arguments + !----------------------------------------------------------------- + + integer, intent(in) :: ewn, nsn ! grid dimensions + integer, dimension(:,:), intent(in) :: & + ice_mask, & ! = 1 if thck > thklim, else = 0 + floating_mask ! = 1 if ice is floating, else = 0 + real(dp), dimension(:,:), intent(in) :: ubas, vbas ! basal velocity + real(dp), dimension(:,:,:), intent(in) :: btraction ! basal traction + real(dp), dimension(:,:), intent(out) :: bfricflx ! basal friction heat flux (W m-2) + + !----------------------------------------------------------------- + ! Local arguments + !----------------------------------------------------------------- + + real(dp) :: slterm ! sliding friction + integer :: ew, ns, i, j + integer :: slide_count ! number of neighbor cells with nonzero sliding + + bfricflx(:,:) = 0.d0 + + ! compute heat source due to basal friction + ! Note: slterm and bfricflx are defined to be >= 0 + + do ns = 2, nsn-1 + do ew = 2, ewn-1 + + slterm = 0.d0 + slide_count = 0 + + ! Note: btraction is computed in glam_strs2.F90 + + !WHL - Using thklim instead of thklim_temp because ice thinner than thklim + ! is assumed to be at rest. + + if (ice_mask(ew,ns)==1 .and. floating_mask(ew,ns)==0) then + do j = ns-1,ns + do i = ew-1,ew + + !SCALING - WHL: Multiplied ubas by vel0/vel_scale so we get the same result in these two cases: + ! (1) With scaling: vel0 = vel_scale = 500/scyr, and ubas is non-dimensional + ! (2) Without scaling: vel0 = 1, vel_scale = 500/scyr, and ubas is in m/s. + +!!! if (abs(ubas(i,j)) > 1.0d-6 .or. & +!!! abs(vbas(i,j)) > 1.0d-6) then + if ( abs(ubas(i,j))*(vel0/vel_scale) > 1.0d-6 .or. & + abs(vbas(i,j))*(vel0/vel_scale) > 1.0d-6 ) then + slide_count = slide_count + 1 + slterm = slterm + btraction(1,i,j)*ubas(i,j) + btraction(2,i,j)*vbas(i,j) + end if + end do + end do + + endif ! ice_mask = 1, floating_mask = 0 + + ! include sliding contrib only if temperature node is surrounded by sliding velo nodes + !NOTE - This may result in non-conservation of energy. + + if (slide_count == 4) then + slterm = 0.25d0 * slterm + else + slterm = 0.0d0 + end if + + bfricflx(ew,ns) = slterm + + enddo ! ns + enddo ! ew + + end subroutine glam_basal_friction + +!=============================================================================== + +end module glam_velo + +!=============================================================================== diff --git a/components/cism/glimmer-cism/libglide/glide.F90 b/components/cism/glimmer-cism/libglide/glide.F90 new file mode 100644 index 0000000000..51cbfeb684 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide.F90 @@ -0,0 +1,1053 @@ +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!CLEANUP - glide.F90 +! Moved higher-order computations to a new module, glissade.F90. +! Simplified glide.F90 to include only SIA computations. +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +!======================================================================= + +module glide + + ! Driver for Glide (serial, SIA) dynamical core + + use glide_types + use glide_stop + use glide_io + use glide_lithot + use glide_profile + use glimmer_config + use glimmer_global, only: dp + + use glimmer_paramets, only: oldglide + + implicit none + + integer, private, parameter :: dummyunit=99 + +!WHL - debug + logical, parameter :: verbose_glide = .false. + +contains + +!======================================================================= + + subroutine glide_config(model,config,fileunit) + + ! Read glide configuration from file and print it to the log + + use glide_setup + use isostasy + use glimmer_ncparams + use glimmer_config + use glimmer_map_init + use glimmer_filenames + + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + integer, intent(in), optional :: fileunit ! fileunit for reading config file + + type(ConfigSection), pointer :: ncconfig + integer :: unit + + unit = 99 + if (present(fileunit)) then + unit = fileunit + endif + + ! read configuration file + call glide_readconfig (model,config) + call glide_printconfig(model) + + ! read sigma levels from config file, if present + call glide_read_sigma(model,config) + + !WHL - Moved isostasy configuration to glide_setup +! call isos_readconfig(model%isos,config) +! call isos_printconfig(model%isos) + + ! read mapping from config file + ! **** Use of dew and dns here is an ugly fudge that + ! **** allows the use of old [GLINT projection] config section + ! **** for backwards compatibility. It will be deleted soon. + ! **** (You have been warned!) + ! **** N.B. Here, dew and dns are unscaled - i.e. real distances in m + + call glimmap_readconfig(model%projection, config, & + model%numerics%dew, model%numerics%dns) + + ! netCDF I/O + if (trim(model%funits%ncfile) == '') then + ncconfig => config + else + call ConfigRead(process_path(model%funits%ncfile), ncconfig, unit) + end if + + call glimmer_nc_readparams(model, ncconfig) + + end subroutine glide_config + +!======================================================================= + + subroutine glide_initialise(model) + + ! Initialise Glide model instance + + use glide_setup + use glimmer_ncio + use glide_velo, only: init_velo + use glide_thck + use glide_temp + use glimmer_log + use glimmer_scales + use glide_mask + use isostasy + use glimmer_map_init + use glimmer_coordinates, only: coordsystem_new + use glide_diagnostics, only: glide_init_diag + use glide_bwater + + use parallel, only: distributed_grid + + type(glide_global_type), intent(inout) :: model ! model instance + +!TODO - Is glimmer_version_char still used? +! Old Glide does not include this variable. + character(len=100), external :: glimmer_version_char + + integer, parameter :: my_nhalo = 0 ! no halo layers for Glide dycore + +!!!Old Glide has this: +!!! call write_log(glimmer_version) + + call write_log(trim(glimmer_version_char())) + + ! initialise scales + call glimmer_init_scales + + ! scale parameters (some conversions to SI units) + call glide_scale_params(model) + + ! set up coordinate systems + + ! Note: nhalo = 0 is included in call to distributed_grid to set other halo + ! variables (lhalo, uhalo, etc.) to 0 instead of default values + +!WHL - distributed_grid is not in old glide + + call distributed_grid(model%general%ewn, model%general%nsn, & + nhalo_in=my_nhalo) + + model%general%ice_grid = coordsystem_new(0.d0, 0.d0, & + model%numerics%dew, model%numerics%dns, & + model%general%ewn, model%general%nsn) + + model%general%velo_grid = coordsystem_new(model%numerics%dew/2.d0, model%numerics%dns/2.d0, & + model%numerics%dew, model%numerics%dns, & + model%general%ewn-1, model%general%nsn-1) + + ! allocate arrays + call glide_allocarr(model) + +!TODO - Eliminate the bed softness parameter and set btrc to model%velowo%btrac_const in glide_velo? + ! initialise bed softness to uniform parameter + model%velocity%bed_softness = model%velowk%btrac_const + + ! set uniform basal heat flux (positive down) + !NOTE: This value will be overridden if we read bheatflx from an input file + ! (model%options%gthf = 1) or compute it (model%options%gthf = 2) + model%temper%bheatflx = model%paramets%geot + + ! compute sigma levels or load from external file + ! (if not already read from config file) + call glide_load_sigma(model,dummyunit) + + ! open all input files and forcing files + call openall_in(model) + + ! read first time slice + call glide_io_readall(model,model) + + ! write projection info to log + call glimmap_printproj(model%projection) + + !WHL - Should have been read from glide_io_readall + ! read lithot if required +!! if (model%options%gthf > 0) then +! if (model%options%gthf == GTHF_COMPUTE) then +! call glide_lithot_io_readall(model,model) +! end if + + ! handle relaxed/equilibrium topo + ! Initialise isostasy first + call init_isostasy(model) + + select case(model%options%whichrelaxed) + + case(RELAXED_TOPO_INPUT) ! Supplied topography is relaxed + model%isostasy%relx = model%geometry%topg + case(RELAXED_TOPO_COMPUTE) ! Supplied topography is in equilibrium + !TODO - test case RELAXED_TOPO_COMPUTE + call isos_relaxed(model) + end select + + ! open all output files + call openall_out(model) + + ! create glide variables + call glide_io_createall(model, model) + +!WHL - debug +! print*, ' ' +! print*, 'Created Glide variables' +! print*, 'max, min bheatflx (W/m2)=', maxval(model%temper%bheatflx), minval(model%temper%bheatflx) + + ! If a 2D bheatflx field is present in the input file, it will have been written + ! to model%temper%bheatflx. For the case model%options%gthf = 0, we want to use + ! a uniform heat flux instead. + ! If no bheatflx field is present in the input file, then we default to the + ! prescribed uniform value, model%paramets%geot. + + if (model%options%gthf == GTHF_UNIFORM) then + + ! Check to see if this flux was present in the input file + ! (by checking whether the flux is nonuniform over the domain) + if (abs(maxval(model%temper%bheatflx) - minval(model%temper%bheatflx)) > 1.d-6) then + call write_log('Setting uniform prescribed geothermal flux') + call write_log('(Set gthf = 1 to read geothermal flux field from input file)') + endif + + ! set uniform basal heat flux (positive down) + model%temper%bheatflx = model%paramets%geot + +!WHL - debug +! print*, ' ' +! print*, 'Use uniform bheatflx' +! print*, 'max, min bheatflx (W/m2)=', maxval(model%temper%bheatflx), minval(model%temper%bheatflx) + + endif + + !TODO - Change subroutine names to glide_init_velo, glide_init_thck + + ! initialise velocity calc + call init_velo(model) + +!WHL - old glide has a call to init_temp, which is similar to glide_init_temp +! but does not set the temperature or compute flwa until later call to timeevoltemp +!WHL - In old glide I added artm as a hotstart variable + + ! Initialize temperature field - this needs to happen after input file is + ! read so we can assign artm (which could possibly be read in) if temp has not been input. + ! + ! Note: If the temperature field has not been read already from an input or restart file, + ! then temperature is initialized by this subroutine based on model%options%temp_init. + ! If the temperature has been read already, this subroutine will *not* overwrite it. + + call glide_init_temp(model) + + ! Initialize basal hydrology model, if enabled + call bwater_init(model) + + ! initialise thickness evolution calc + call init_thck(model) + + if (model%options%gthf == GTHF_COMPUTE) then +!! call glide_lithot_io_createall(model) !WHL - Variables should have been created by glide_io_createall + call init_lithot(model) + end if + +!WHL - This call will set the ice column temperature to artm as in old glide, +! regardless of the value of model%options%temp_init +! Commented out at least for now. To reproduce results of old_glide, make sure +! model%options%temp_init = TEMP_INIT_ARTM. +!! if (oldglide) then +!! if (model%options%hotstart.ne.1) then +!! ! initialise Glen's flow parameter A using an isothermal temperature distribution +!! call glide_temp_driver(model,0) +!! endif +!! endif ! oldglide + +!WHL - This option is disabled for now. + ! *mb* added; initialization of basal proc. module +!! if (model%options%which_bproc == BAS_PROC_FULLCALC .or. & +!! model%options%which_bproc == BAS_PROC_FASTCALC) then +!! call Basal_Proc_init (model%general%ewn, model%general%nsn,model%basalproc, & +!! model%numerics%dttem) +!! end if + + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + + ! calculate lower and upper ice surface + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus,model%geometry%lsrf) + + model%geometry%usrf = model%geometry%thck + model%geometry%lsrf + + ! initialise thckwk variables; used in timeders subroutine + model%thckwk%olds(:,:,1) = model%geometry%thck(:,:) + model%thckwk%olds(:,:,2) = model%geometry%usrf(:,:) + + ! initialise standard glide profiling + call glide_prof_init(model) + + !TODO - Unclear on how subroutine register_model is used - Is it needed for serial code? + ! register the newly created model so that it can be finalised in the case + ! of an error without needing to pass the whole thing around to every + ! function that might cause an error + + call register_model(model) + + ! initialise model diagnostics \ + + call glide_init_diag(model) + +!WHL - debug +! print*, 'After glide_initialise:' +! print*, 'max, min thck (m)=', maxval(model%geometry%thck)*thk0, minval(model%geometry%thck)*thk0 +! print*, 'max, min usrf (m)=', maxval(model%geometry%usrf)*thk0, minval(model%geometry%usrf)*thk0 +! print*, 'max, min artm =', maxval(model%climate%artm), minval(model%climate%artm) +! print*, 'max, min temp =', maxval(model%temper%temp), minval(model%temper%temp) +! print*, 'max, min flwa =', maxval(model%temper%flwa), minval(model%temper%flwa) + +! print*, ' ' +! print*, 'thck:' +! do j = model%general%nsn, 1, -1 +! write(6,'(30f5.0)') thk0 * model%geometry%thck(:,j) +! enddo +! print*, ' ' +! print*, 'temp, k = 2:' +! do j = model%general%nsn+1, 0, -1 +! write(6,'(32f5.0)') model%temper%temp(2,:,j) +! enddo +! print*, 'basal temp:' +! do j = model%general%nsn+1, 0, -1 +! write(6,'(32f5.0)') model%temper%temp(model%general%upn,:,j) +! enddo + + end subroutine glide_initialise + +!======================================================================= + + subroutine glide_init_state_diagnostic(model) + + ! Calculate diagnostic variables for the initial model state + ! This provides calculation of output fields at time 0 + ! This is analagous to glissade_diagnostic_variable_solve but is only + ! called from init. The glide tstep routines take care of these calculations + ! during time stepping. + ! Note that none of this is needed on a restart - this code ensures a complete + ! set of diagnostic output fields for the initial state. + + use glide_thck + use glide_velo + use glide_mask + use glimmer_paramets, only: tim0 + use glimmer_physcon, only: scyr + use glide_ground, only: glide_marinlim + use glide_bwater, only: calcbwat + use glide_temp, only: glide_calcbmlt, glide_calcbpmp + use glide_grid_operators + + type(glide_global_type), intent(inout) :: model ! model instance + + integer :: i, j + + if (model%options%is_restart == RESTART_TRUE) then + ! On a restart, just assign the basal velocity from uvel/vvel (which are restart variables) + ! to ubas/vbas which are used by the temperature solver to calculate basal heating. + ! During time stepping ubas/vbas are calculated by slipvelo during thickness evolution or below on a cold start. + model%velocity%ubas = model%velocity%uvel(model%general%upn,:,:) + model%velocity%vbas = model%velocity%vvel(model%general%upn,:,:) + + else + ! Only make the calculations on a cold start. + + ! ------------------------------------------------------------------------ + ! ***Part 1: Make geometry consistent with calving law, if necessary + ! ------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------ + ! Remove ice which is either floating, or is present below prescribed + ! depth, depending on value of whichmarn + ! ------------------------------------------------------------------------ + + ! On a cold start, marinlim needs the mask to be calculated, but a call to + ! glide_set_mask occurs in glide_initialise, so we should be set here without calling it again. + + call glide_marinlim(model%options%whichmarn, & + model%geometry%thck, & + model%isostasy%relx, & + model%geometry%topg, & + model%geometry%thkmask, & + model%numerics%mlimit, & + model%numerics%calving_fraction, & + model%climate%eus, & + model%climate%calving, & + model%ground, & + model%numerics%dew, & + model%numerics%dns, & + model%general%nsn, & + model%general%ewn) + + ! We now need to recalculate the mask because marinlim may have modified the geometry. + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + + ! Compute total areas of grounded and floating ice + call calc_iareaf_iareag(model%numerics%dew, model%numerics%dns, & + model%geometry%thkmask, & + model%geometry%iareaf, model%geometry%iareag) + + ! ------------------------------------------------------------------------ + ! ***Part 2: Calculate geometry related fields + ! ------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------ + ! calculate upper and lower ice surface + ! ------------------------------------------------------------------------ + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%geometry%lsrf) + + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + ! ------------------------------------------------------------------------ + ! Calculate various derivatives + ! + ! This call is needed here to make sure stagthck is calculated + ! the same way as in thck_lin_evolve/thck_nonlin_evolve + ! ------------------------------------------------------------------------ + + call glide_prof_start(model,model%glide_prof%geomderv) + + call glide_geometry_derivs(model) ! stagvarb, geomders as in old Glide + + call glide_prof_stop(model,model%glide_prof%geomderv) + + call glide_prof_start(model,model%glide_prof%ice_mask1) + + !TREY This sets local values of dom, mask, totpts, and empty + !EIB! call veries between lanl and gc2, this is lanl version + !magi a hack, someone explain what whichthck=5 does + +!WHL - Modified this subroutine so that ice can accumulate in regions with +! a small positive mass balance. + + call glide_thck_index(model%geometry% thck, & + model%climate% acab, & + model%geometry% thck_index, & + model%geometry% totpts, & + .true., & + model%geometry% empty) + + call glide_prof_stop(model,model%glide_prof%ice_mask1) + + + ! ------------------------------------------------------------------------ + ! Part 3: Solve velocity + ! ------------------------------------------------------------------------ + + ! initial value for flwa should already be calculated as part of glide_init_temp() + ! calculate the part of the vertically averaged velocity field which solely depends on the temperature + + call velo_integrate_flwa(model%velowk, & + model%geomderv%stagthck, & + model%temper%flwa) + + ! Calculate diffusivity + + call velo_calc_diffu(model%velowk, & + model%geomderv%stagthck, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%velocity%diffu) + + ! If necessary, compute staggered variables required for basal traction calculation + + if (model%options%whichbtrc == BTRC_CONSTANT_BWAT) then + + !TODO - I think the next two calls are not needed, given that bwat should be in restart file for this option. + + ! Calculate basal melt rate -------------------------------------------------- + ! Note: For the initial state, we won't have values for ubas/vbas (unless they were + ! supplied in the input file) to get an initial guess of sliding heating. + ! We could iterate on this, but for simplicity that is not done. + + call glide_calcbmlt(model, & +!! model%options%which_bmelt, & + model%temper%temp, & + model%geometry%thck, & + model%geomderv%stagthck, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%velocity%ubas, & + model%velocity%vbas, & + model%temper%bmlt, & + GLIDE_IS_FLOAT(model%geometry%thkmask)) + + ! Note: calcbwat computes stagbwat + call calcbwat(model, & + model%options%whichbwat, & + model%temper%bmlt, & + model%temper%bwat, & + model%temper%bwatflx, & + model%geometry%thck, & + model%geometry%topg, & + model%temper%temp(model%general%upn,:,:), & + GLIDE_IS_FLOAT(model%geometry%thkmask), & + model%tempwk%wphi) + + + ! This call is redundant for now, but is needed if the call to calcbwat is removed + call stagvarb(model%temper%bwat, & + model%temper%stagbwat ,& + model%general%ewn, & + model%general%nsn) + + elseif (model%options%whichbtrc == BTRC_CONSTANT_TPMP) then + + call stagvarb(model%temper%temp(model%general%upn,1:model%general%ewn,1:model%general%nsn), & + model%temper%stagbtemp ,& + model%general% ewn, & + model%general% nsn) + + call glide_calcbpmp(model, & + model%geometry%thck, & + model%temper%bpmp) + + call stagvarb(model%temper%bpmp, & + model%temper%stagbpmp ,& + model%general% ewn, & + model%general% nsn) + + endif ! whichbtrc + + !------------------------------------------------------------------------ + ! Calculate basal traction factor + !------------------------------------------------------------------------ + + do j = 1, model%general%nsn-1 + do i = 1, model%general%ewn-1 + if (model%geomderv%stagthck(i,j)*thk0 < 1000.d0) then + model%temper%stagbtemp(i,j) = model%temper%stagbpmp(i,j) + else + model%temper%stagbtemp(i,j) = -20.d0 + endif + enddo + enddo + + call calc_btrc(model, & + model%options%whichbtrc, & + model%velocity%btrc) + + call slipvelo(model, & + 0, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + + + ! Calculate velocity + call velo_calc_velo(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%temper%flwa, model%velocity%diffu, & + model%velocity%ubas, model%velocity%vbas, & + model%velocity%uvel, model%velocity%vvel, & + model%velocity%uflx, model%velocity%vflx, & + model%velocity%velnorm) + + endif ! if a restart + + + ! MJH: I have left these calls outside of the restart if-construct so that there will + ! always be a velnorm field calculated, which can be helpful for debugging. + + ! ------------------------------------------------------------------------ + ! Part 4: Calculate other diagnostic fields that depend on velocity + ! ------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------ + ! basal shear stress calculation + ! ------------------------------------------------------------------------ + + call calc_basal_shear(model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%tau_x, model%velocity%tau_y) + + ! velocity norm + model%velocity%velnorm = sqrt(model%velocity%uvel**2 + model%velocity%vvel**2) + +!WHL - debug + if (verbose_glide) then + + print*, ' ' + print*, 'stagthck:' + do i = 1, model%general%ewn-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i3)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f7.2)',advance='no') model%geomderv%stagthck(i,j)*thk0 + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'diffu (m^2/yr):' + do i = 1, model%general%ewn-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i3)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f8.0)',advance='no') -model%velocity%diffu(i,j) * vel0*len0*scyr + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'ubas:' + do i = 1, model%general%ewn-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f7.2)',advance='no') model%velocity%uvel(model%general%upn,i,j)*(vel0*scyr) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'vbas:' + do i = 1, model%general%ewn-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f7.2)',advance='no') model%velocity%vvel(model%general%upn,i,j)*(vel0*scyr) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'uvel, k = 1:' + do i = 1, model%general%ewn-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f8.2)',advance='no') model%velocity%uvel(1,i,j) * (vel0*scyr) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'u=vvel, k = 1:' + do i = 1, model%general%ewn-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f8.2)',advance='no') model%velocity%vvel(1,i,j) * (vel0*scyr) + enddo + print*, ' ' + enddo + + endif ! verbose_glide + + end subroutine glide_init_state_diagnostic + +!======================================================================= + + subroutine glide_tstep_p1(model,time) + + ! Perform first part of time-step of an ice model instance: + ! temperature advection, vertical conduction, and internal dissipation. + + use glide_thck + use glide_velo + use glide_temp + use glide_mask + use glimmer_paramets, only: tim0 + use glimmer_physcon, only: scyr + use glide_grid_operators + use glide_bwater + + type(glide_global_type), intent(inout) :: model ! model instance + real(dp), intent(in) :: time ! current time in years + + ! Update internal clock + model%numerics%time = time + model%temper%newtemps = .false. + + model%thckwk%oldtime = model%numerics%time - (model%numerics%dt * tim0/scyr) + + call glide_prof_start(model,model%glide_prof%geomderv) + + ! Update geometric quantities: stagthck, dusrfdew/dns, dthckdew/dns + + call glide_geometry_derivs(model) ! compute stagthck, dusrfdew/dns, dthckdew/dns + + call glide_prof_stop(model,model%glide_prof%geomderv) + + call glide_prof_start(model,model%glide_prof%ice_mask1) + + !WHL - Modified this subroutine so that ice can accumulate in regions with + ! a small positive mass balance. + + call glide_thck_index(model%geometry% thck, & + model%climate% acab, & + model%geometry% thck_index, & + model%geometry% totpts, & + .true., & + model%geometry% empty) + + call glide_prof_stop(model,model%glide_prof%ice_mask1) + + ! ------------------------------------------------------------------------ + ! calculate geothermal heat flux + ! ------------------------------------------------------------------------ + + if (model%options%gthf == GTHF_COMPUTE) then + call calc_lithot(model) + end if + + ! ------------------------------------------------------------------------ + ! Calculate temperature evolution and Glen's A, if necessary + ! ------------------------------------------------------------------------ + + ! Note: These times have units of years. + ! dttem has scaled units, so multiply by tim0/scyr to convert to years + + if ( model%numerics%tinc > mod(model%numerics%time,model%numerics%dttem*tim0/scyr)) then + + call glide_prof_start(model,model%glide_prof%temperature) + + if (oldglide) then ! compute vertical velocity in glide_tstep_p1 + ! In new glide, this is called in glide_tstep_p3 + + call glide_velo_vertical(model) + + endif ! oldglide = T + + ! temperature advection, vertical conduction, and internal dissipation + + call glide_temp_driver(model, model%options%whichtemp) + + model%temper%newtemps = .true. + + call glide_prof_stop(model,model%glide_prof%temperature) + + ! Update hydrology, if needed ------------------------------------------------ + call calcbwat(model, & + model%options%whichbwat, & + model%temper%bmlt, & + model%temper%bwat, & + model%temper%bwatflx, & + model%geometry%thck, & + model%geometry%topg, & + model%temper%temp(model%general%upn,:,:), & + GLIDE_IS_FLOAT(model%geometry%thkmask), & + model%tempwk%wphi) + + end if + + ! ------------------------------------------------------------------------ + ! Calculate basal traction factor + ! ------------------------------------------------------------------------ + + call calc_btrc(model, & + model%options%whichbtrc, & + model%velocity%btrc) + + +!WHL - debug +! print*, ' ' +! print*, 'After glide_tstep_p1:' +! print*, 'max, min temp =', maxval(model%temper%temp), minval(model%temper%temp) +! print*, 'max, min flwa =', maxval(model%temper%flwa), minval(model%temper%flwa) + +! print*, ' ' +! print*, 'temp, k = 2:' +! do j = model%general%nsn+1, 0, -1 +! write(6,'(14f12.7)') model%temper%temp(2,3:16,j) +! enddo +! print*, 'basal temp:' +! do j = model%general%nsn+1, 0, -1 +! write(6,'(14f12.7)') model%temper%temp(model%general%upn,3:16,j) +! enddo + + end subroutine glide_tstep_p1 + +!======================================================================= + + subroutine glide_tstep_p2(model) + + ! Perform second part of time-step of an ice model instance: + ! thickness evolution by one of several methods. + + use glide_thck + use glide_velo + use glide_temp + use glide_mask + use isostasy + use glide_ground, only: glide_marinlim + + type(glide_global_type), intent(inout) :: model ! model instance + + ! ------------------------------------------------------------------------ + ! Calculate flow evolution by various different methods + ! ------------------------------------------------------------------------ + + call glide_prof_start(model,model%glide_prof%ice_evo) + + select case(model%options%whichevol) + + case(EVOL_PSEUDO_DIFF) ! Use precalculated uflx, vflx ----------------------------------- + + call thck_lin_evolve(model,model%temper%newtemps) + + case(EVOL_ADI) ! Use explicit leap frog method with uflx,vflx ------------------- + + call stagleapthck(model,model%temper%newtemps) + + case(EVOL_DIFFUSION) ! Use non-linear calculation that incorporates velocity calc ----- + + call thck_nonlin_evolve(model,model%temper%newtemps) + + end select + + call glide_prof_stop(model,model%glide_prof%ice_evo) + + ! ------------------------------------------------------------------------ + ! get new mask + ! Note: A call to glide_set_mask is needed before glide_marinlim. + ! ------------------------------------------------------------------------ + + call glide_prof_start(model,model%glide_prof%ice_mask2) + + !TODO - Calculate area and vol separately from glide_set_mask? + + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + + call glide_prof_stop(model,model%glide_prof%ice_mask2) + + ! ------------------------------------------------------------------------ + ! Remove ice which is either floating, or is present below prescribed + ! depth, depending on value of whichmarn + ! ------------------------------------------------------------------------ + + !TODO - Some arguments for glide_marinlim may not be needed. + ! Old glide includes only arguments through model%climate%calving. + + call glide_marinlim(model%options%whichmarn, & + model%geometry%thck, & + model%isostasy%relx, & + model%geometry%topg, & + model%geometry%thkmask, & + model%numerics%mlimit, & + model%numerics%calving_fraction, & + model%climate%eus, & + model%climate%calving, & + model%ground, & + model%numerics%dew, & + model%numerics%dns, & + model%general%nsn, & + model%general%ewn) + + ! Recalculate the mask following calving + ! Note - This call to glide_set_mask is not in old Glide, but should have been. + + if (.not. oldglide) then ! recalculate the thickness mask after calving + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + endif ! oldglide = F + + if (.not. oldglide) then ! calculate area of floating and grounded ice + call calc_iareaf_iareag(model%numerics%dew, model%numerics%dns, & + model%geometry%thkmask, & + model%geometry%iareaf, model%geometry%iareag) + endif ! oldglide = F + + ! ------------------------------------------------------------------------ + ! update ice/water load if necessary + ! ------------------------------------------------------------------------ + + call glide_prof_start(model,model%glide_prof%isos_water) + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + if (model%numerics%time >= model%isostasy%next_calc) then + model%isostasy%next_calc = model%isostasy%next_calc + model%isostasy%period + call isos_icewaterload(model) + model%isostasy%new_load = .true. + end if + end if + + call glide_prof_stop(model,model%glide_prof%isos_water) + + ! ------------------------------------------------------------------------ + ! basal shear stress calculation + ! ------------------------------------------------------------------------ + +! Old glide just passes 'model' + + call calc_basal_shear(model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%tau_x, model%velocity%tau_y) + +! not in old glide, but this is a useful diagnostic + + ! velocity norm + model%velocity%velnorm = sqrt(model%velocity%uvel**2 + model%velocity%vvel**2) + +!WHL - debug +! print*, ' ' +! print*, 'After tstep_p2:' +! print*, 'max, min thck (m)=', maxval(model%geometry%thck)*thk0, minval(model%geometry%thck)*thk0 +! print*, 'max, min usrf (m)=', maxval(model%geometry%usrf)*thk0, minval(model%geometry%usrf)*thk0 +! print*, 'max uvel, vvel =', maxval(model%velocity%uvel), maxval(model%velocity%vvel) + +! print*, ' ' +! print*, 'thck:' +! do j = model%general%nsn, 1, -1 +! write(6,'(14f12.7)') thk0 * model%geometry%thck(3:16,j) +! enddo +! print*, 'sfc uvel:' +! do j = model%general%nsn-1, 1, -1 +! write(6,'(14f12.7)') model%velocity%uvel(1,3:16,j) +! enddo +! print*, 'sfc vvel:' +! do j = model%general%nsn-1, 1, -1 +! write(6,'(14f12.7)') model%velocity%vvel(1,3:16,j) +! enddo + + end subroutine glide_tstep_p2 + +!======================================================================= + + subroutine glide_tstep_p3(model) + + ! Perform third part of time-step of an ice model instance: + ! calculate isostatic adjustment and upper and lower ice surface + + use isostasy + use glide_setup + use glide_velo, only: glide_velo_vertical + use glide_thck, only: glide_calclsrf + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + + ! ------------------------------------------------------------------------ + ! Calculate isostasy + ! ------------------------------------------------------------------------ + + call glide_prof_start(model,model%glide_prof%isos) + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + call isos_compute(model) + end if + + call glide_prof_stop(model,model%glide_prof%isos) + + ! ------------------------------------------------------------------------ + ! calculate upper and lower ice surface + ! ------------------------------------------------------------------------ + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%geometry%lsrf) + + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + !TODO - Move timecounter to a driver routine? + !CESM Glimmer code has this after the netCDF write. + + ! increment time counter + model%numerics%timecounter = model%numerics%timecounter + 1 + + !TODO - Combine these timeders and vert velo calls into a subroutine? + + ! For exact restart, compute wgrd here and write it to the restart file. + ! (This is easier than writing thckwk quantities to the restart file.) + + if (.not. oldglide) then ! compute vertical velocity in glide_tstep_p3 + + ! compute vertical velocity + + call t_startf('vertical_velo') + + call glide_velo_vertical(model) + + call t_stopf('vertical_velo') + + endif ! oldglide = F + + !WHL - Moved netCDF output to simple_glide + !! call glide_io_writeall(model,model) + + end subroutine glide_tstep_p3 + +!======================================================================= + +end module glide diff --git a/components/cism/glimmer-cism/libglide/glide_bwater.F90 b/components/cism/glimmer-cism/libglide/glide_bwater.F90 new file mode 100644 index 0000000000..e515bd292a --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_bwater.F90 @@ -0,0 +1,716 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_bwater.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Support Jesse's water-routing code (or something similar) in parallel? Currently serial only. + +module glide_bwater + + use glimmer_global, only: dp + use glide_types + + implicit none + +contains + + subroutine bwater_init(model) + ! Driver for initializing basal hydrology + use glimmer_paramets + + implicit none + + type(glide_global_type),intent(inout) :: model + real(dp) :: estimate + + + select case(model%options%whichbwat) + case(BWATER_LOCAL) + + allocate(model%tempwk%smth(model%general%ewn,model%general%nsn)) + + model%paramets%hydtim = tim0 / (model%paramets%hydtim * scyr) + estimate = 0.2d0 / model%paramets%hydtim + !EIB! following not in lanl glide_temp + call find_dt_wat(model%numerics%dttem,estimate,model%tempwk%dt_wat,model%tempwk%nwat) + + model%tempwk%c = (/ model%tempwk%dt_wat, 1.0d0 - 0.5d0 * model%tempwk%dt_wat * model%paramets%hydtim, & + 1.0d0 + 0.5d0 * model%tempwk%dt_wat * model%paramets%hydtim, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0 /) + + !TODO - Test option BWATER_FLUX. Note: It has not been parallelized. + + case(BWATER_FLUX) ! steady-state routing using flux calculation + + allocate(model%tempwk%wphi(model%general%ewn,model%general%nsn)) + + model%tempwk%watvel = model%paramets%hydtim * tim0 / (scyr * len0) + estimate = (0.2d0 * model%tempwk%watvel) / min(model%numerics%dew,model%numerics%dns) + call find_dt_wat(model%numerics%dttem,estimate,model%tempwk%dt_wat,model%tempwk%nwat) + + !print *, model%numerics%dttem*tim0/scyr, model%tempwk%dt_wat*tim0/scyr, model%tempwk%nwat + + model%tempwk%c = (/ rhow * grav, rhoi * grav, 2.0d0 * model%numerics%dew, 2.0d0 * model%numerics%dns, & + 0.25d0 * model%tempwk%dt_wat / model%numerics%dew, 0.25d0 * model%tempwk%dt_wat / model%numerics%dns, & + 0.5d0 * model%tempwk%dt_wat / model%numerics%dew, 0.5d0 * model%tempwk%dt_wat / model%numerics%dns /) + end select + + end subroutine bwater_init + + + + subroutine calcbwat(model, which, bmlt, bwat, bwatflx, thck, topg, btem, floater, wphi) + ! Driver for updating basal hydrology + + use parallel + use glimmer_paramets, only : thk0 + use glide_grid_operators, only: stagvarb + use glissade_grid_operators, only: glissade_stagger + + implicit none + + type(glide_global_type),intent(inout) :: model + integer, intent(in) :: which + real(dp), dimension(:,:), intent(inout) :: bwat, wphi, bwatflx + real(dp), dimension(:,:), intent(in) :: bmlt, thck, topg, btem + logical, dimension(:,:), intent(in) :: floater + + real(dp), dimension(2), parameter :: & + blim = (/ 0.00001 / thk0, 0.001 / thk0 /) + + integer :: t_wat,ns,ew + + real(dp), dimension(model%general%ewn,model%general%nsn) :: N, flux, lakes + real(dp) :: c_effective_pressure,c_flux_to_depth,p_flux_to_depth,q_flux_to_depth + + real(dp), parameter :: const_bwat = 10.d0 ! constant value for basal water depth (m) + + ! Variables used by BWATER_OCEAN_PENETRATION + real(dp), allocatable, dimension(:,:) :: Haf !< Floatation thickness (m) + real(dp), allocatable, dimension(:,:) :: Fp !< function that controls ocean pressure transition + real(dp) :: ocean_p + + real(dp), dimension(:,:), allocatable :: N_capped ! version of effective pressure capped at 0x and 1x overburden + + c_effective_pressure = 0.0d0 ! For now estimated with c/w + c_flux_to_depth = 1./(1.8d-3*12.0d0) ! + p_flux_to_depth = 2.0d0 ! exponent on the depth + q_flux_to_depth = 1.0d0 ! exponent on the potential gradient + + select case (which) + + ! which = BWATER_NONE Nothing, basal water depth = 0. + ! which = BWATER_LOCAL Completely local, bwat_new = c1 * melt_rate + c2 * bwat_old + ! which = BWATER_FLUX Flux based calculation + ! which = BWATER_BASAL_PROC, till water content in the basal processes module + ! which = BWATER_OCEAN_PENETRATION, effective pressure from ocean penetration parameterization (Leguy et al 2014) + + case(BWATER_LOCAL) + + ! model%tempwk%c(1) = model%tempwk%dt_wat + ! c(2) = 1.0d0 - 0.5d0 * model%tempwk%dt_wat * model%paramets%hydtim + ! c(3) = 1.0d0 + 0.5d0 * model%tempwk%dt_wat * model%paramets%hydtim + + do t_wat = 1, model%tempwk%nwat + + !LOOP - For glissade, loop should be over locally owned cells (ilo:ihi,jo:jhi). + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + + if (model%numerics%thklim < thck(ew,ns) .and. .not. floater(ew,ns)) then + bwat(ew,ns) = (model%tempwk%c(1) * bmlt(ew,ns) + model%tempwk%c(2) * bwat(ew,ns)) / & + model%tempwk%c(3) + if (bwat(ew,ns) < blim(1)) then + bwat(ew,ns) = 0.0d0 + end if + else + bwat(ew,ns) = 0.0d0 + end if + + end do + end do + end do + + model%tempwk%smth = 0. + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + call smooth_bwat(ew-1,ew,ew+1,ns-1,ns,ns+1) + end do + end do + + ! apply periodic BC + if (model%options%periodic_ew) then + do ns = 2,model%general%nsn-1 + call smooth_bwat(model%general%ewn-1,1,2,ns-1,ns,ns+1) + call smooth_bwat(model%general%ewn-1,model%general%ewn,2,ns-1,ns,ns+1) + end do + end if + + bwat(1:model%general%ewn,1:model%general%nsn) = & + model%tempwk%smth(1:model%general%ewn,1:model%general%nsn) + + ! Case added by Jesse Johnson 11/15/08 + ! Steady state routing of basal water using flux calculation + + case(BWATER_FLUX) + + call effective_pressure(bwat,c_effective_pressure,N) + call pressure_wphi(thck,topg,N,wphi,model%numerics%thklim,floater) + call route_basal_water(wphi,bmlt,model%numerics%dew,model%numerics%dns,bwatflx,lakes) + call flux_to_depth(bwatflx,wphi,c_flux_to_depth,p_flux_to_depth,q_flux_to_depth,model%numerics%dew,model%numerics%dns,bwat) + + case(BWATER_CONST) + + ! Use a constant thickness of water, to force Tpmp. + bwat(:,:) = const_bwat / thk0 + +!! case(BWATER_BASAL_PROC) ! not currently supported + + ! Normalized basal water + +!! bwat = model%basalproc%Hwater / thk0 + + case(BWATER_OCEAN_PENETRATION) + + allocate(Haf(model%general%ewn,model%general%nsn)) + allocate(Fp(model%general%ewn,model%general%nsn)) + ocean_p = model%paramets%p_ocean_penetration + Haf = max(f * (topg*thk0 - model%climate%eus*thk0), 0.0d0) + Fp = max( (1.0d0 - Haf / (thck*thk0)), 0.0d0 )**ocean_p + model%basal_physics%effecpress = rhoi * grav * thck*thk0 * Fp + deallocate(Haf) + deallocate(Fp) + + case default ! includes BWATER_NONE + + bwat(:,:) = 0.0d0 + + end select + + !TODO - Switch to glissade version (glissade_stagger) + ! now also calculate basal water in velocity (staggered) coord system + call stagvarb(model%temper%bwat, & + model%temper%stagbwat ,& + model%general%ewn, & + model%general%nsn) + + ! Stagger effective pressure if a friction law will need it. cases BWATER_OCEAN_PENETRATION, BWATER_SHEET calculate it, but it may also be passed in as data or forcing. + ! cap the staggered effective pressure at 0x and 1x overburden pressure to avoid strange values going to the friction laws + if ( (model%options%which_ho_babc == HO_BABC_POWERLAW) .or. & + (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) ) then + + allocate(N_capped(model%general%ewn,model%general%nsn)) + + where (model%basal_physics%effecpress < 0.0d0) + N_capped = 0.0d0 + else where (model%basal_physics%effecpress > rhoi * grav * model%geometry%thck * thk0) + N_capped = rhoi * grav * model%geometry%thck * thk0 + else where + N_capped = model%basal_physics%effecpress + end where + call glissade_stagger(model%general%ewn, model%general%nsn, & + N_capped, model%basal_physics%effecpress_stag, & + model%geometry%thkmask, stagger_margin_in=1) ! only use values where there is ice + + deallocate(N_capped) + endif + + + contains + + ! Internal subroutine for smoothing + subroutine smooth_bwat(ewm,ew,ewp,nsm,ns,nsp) + ! smoothing basal water distrib + implicit none + integer, intent(in) :: ewm,ew,ewp,nsm,ns,nsp + + if (bwat(ew,ns) > blim(2)) then + model%tempwk%smth(ew,ns) = bwat(ew,ns) + model%paramets%bwat_smooth * & + (bwat(ewm,ns) + bwat(ewp,ns) + bwat(ew,nsm) + bwat(ew,nsp) - 4.0d0 * bwat(ew,ns)) + else + model%tempwk%smth(ew,ns) = bwat(ew,ns) + end if + end subroutine smooth_bwat + + end subroutine calcbwat + + subroutine find_dt_wat(dttem,estimate,dt_wat,nwat) + + implicit none + + real(dp), intent(out) :: dt_wat + integer, intent(out) :: nwat + real(dp), intent(in) :: dttem, estimate + + nwat = int(dttem/estimate) + 1 + dt_wat = dttem / nwat + + end subroutine find_dt_wat + + ! Note: This routing is supported in serial code only. + + subroutine route_basal_water(wphi,melt,dx,dy,flux,lakes) + !> Routes water from melt field to its destination, recording flux + !> of water along the route. Water flow direction is determined according + !> to the gradient of a wphi elevation field. For the algorithm to + !> function properly depressions in the wphi surface must be filled. + !> this results in the lakes field, which is the difference between the + !> filled surface and the original wphi. + !> The method used is by Quinn et. al. (1991). + !> + !> 12/9/05 Jesse Johnson based on code from the glimmer_routing file + !> by Ian Rutt. + + implicit none + + real(dp),dimension(:,:),intent(in) :: wphi !> Input potential surface + real(dp),dimension(:,:),intent(in) :: melt !> Input melting field + real(dp), intent(in) :: dx !> Input $x$ grid-spacing + real(dp), intent(in) :: dy !> Input $y$ grid-spacing + real(dp),dimension(:,:),intent(out) :: flux !> Output flux field + real(dp),dimension(:,:),intent(out) :: lakes !> Output lakes field + + ! Internal variables -------------------------------------- + + integer :: nx,ny,k,nn,cx,cy,px,py,x,y + integer, dimension(:,:),allocatable :: mask !> Masked points + integer, dimension(:,:),allocatable :: sorted + real(dp),dimension(:,:),allocatable :: flats,potcopy + real(dp),dimension(-1:1,-1:1) :: slopes + real(dp),dimension(-1:1,-1:1) :: dists + logical :: flag + + ! Set up grid dimensions ---------------------------------- + + nx=size(wphi,1) ; ny=size(wphi,2) + nn=nx*ny + + ! Change these distances for slope determination + + dists(-1,:)=(/sqrt(dx**2+dy**2),dy,sqrt(dx**2+dy**2)/) + dists(0,:)=(/dx,0d0,dx/) + dists(1,:)=dists(-1,:) + + ! Allocate internal arrays and copy data ------------------ + + allocate(sorted(nn,2),flats(nx,ny),potcopy(nx,ny),mask(nx,ny)) + potcopy=wphi + mask=1 + + ! Fill holes in data, and sort heights -------------------- + + call fillholes(potcopy,flats,mask) + call heights_sort(potcopy,sorted) + + lakes=potcopy-wphi + + ! Initialise flux with melt, which will then be -------- + ! redistributed. Multiply by area, so volumes are found.--- + + flux=melt * dx * dy + + ! Begin loop over points, highest first ------------------- + + do k=nn,1,-1 + + ! Get location of current point ------------------------- + + x=sorted(k,1) + y=sorted(k,2) + + ! Only propagate down slope positive values + if (melt(x,y) > 0) then + + ! Reset flags and slope arrays -------------------------- + + flag=.true. + slopes=0.0 + + ! Loop over adjacent points, and calculate slopes ------- + + do cx=-1,1,1 + do cy=-1,1,1 + ! If this is the centre point, ignore + if (cx==0.and.cy==0) continue + ! Otherwise do slope calculation + px=x+cx ; py=y+cy + if (px > 0 .and. px<=nx .and. py > 0 .and. py <= ny) then + ! Only allow flow to points that are melted or freezing. + ! Testing relax this condition (Hell, Frank does). + !if (potcopy(px,py) Assuming that the flow is steady state, this function simply solves + !> flux = depth * velocity + !> for the depth, assuming that the velocity is a function of depth, + !> and pressure potential. This amounts to assuming a Weertman film, + !> or Manning flow, both of which take the form of a constant times water + !> depth to a power, times pressure wphi to a power. + + use glam_grid_operators, only: df_field_2d ! Find grad_wphi + use glimmer_physcon, only : scyr ! Seconds per year + + real(dp),dimension(:,:),intent(in) :: flux ! Basal water flux + real(dp),dimension(:,:),intent(in) :: wphi ! Pressure wphi + real(dp) ,intent(in) :: c ! Constant of proportionality + real(dp) ,intent(in) :: p ! Exponent of the water depth + real(dp) ,intent(in) :: q ! Exponent of the pressure pot. + real(dp) ,intent(in) :: dew ! Grid spacing, ew direction + real(dp) ,intent(in) :: dns ! Grid spacing, ns direction + real(dp),dimension(:,:),intent(out):: bwat ! Water Depth + + ! Internal variables + real(dp),dimension(:,:),allocatable :: grad_wphi, dwphidx, dwphidy + + integer nx,ny,nn + + ! Set up grid dimensions ---------------------------------- + nx=size(flux,1) ; ny=size(flux,2) + nn=nx*ny + + ! Allocate internal arrays and copy data ------------------ + allocate(dwphidx(nx,ny),dwphidy(nx,ny),grad_wphi(nx,ny)) + + ! Compute the gradient of the potential field. + call df_field_2d(wphi,dew,dns,dwphidx,dwphidy) + + grad_wphi = sqrt(dwphidx**2 + dwphidy**2) + + where (grad_wphi /= 0.d0) + bwat = ( flux / (c * scyr * dns * grad_wphi ** q) ) ** (1./(p+1.)) + elsewhere + bwat = 0.d0 + endwhere + + + end subroutine flux_to_depth + +!============================================================== + + subroutine effective_pressure(bwat,c,N) + real(dp),dimension(:,:),intent(in) :: bwat! Water depth + real(dp) ,intent(in) :: c ! Constant of proportionality + real(dp),dimension(:,:),intent(out) :: N ! Effective pressure + + where (bwat > 0.d0) + N = c / bwat + elsewhere + N = 0.d0 + endwhere + end subroutine effective_pressure + +!============================================================== + + subroutine pressure_wphi(thck,topg,N,wphi,thicklim,floater) + !> Compute the pressure wphi at the base of the ice sheet according to + !> ice overburden plus bed height minus effective pressure. + !> + !> whpi/(rhow*g) = topg + bwat * rhoi / rhow * thick - N / (rhow * g) + + use glimmer_physcon, only : rhoi,rhow,grav + implicit none + real(dp),dimension(:,:),intent(in) :: thck ! Thickness + real(dp),dimension(:,:),intent(in) :: topg ! Bed elevation + real(dp),dimension(:,:),intent(in) :: N ! Effective pressure + logical,dimension(:,:),intent(in) :: floater ! Mask of floating ice + real(dp),intent(in) :: thicklim ! Minimal ice thickness + real(dp),dimension(:,:),intent(out) :: wphi ! Pressure wphi + + + where (thck > thicklim .and. .not. floater) + wphi = thck + rhow/rhoi * topg - N / (rhow * grav) + elsewhere + wphi = max(topg *rhow/rhoi,0.0d0) + end where + + end subroutine pressure_wphi + +!============================================================== +! Internal subroutines +!============================================================== + + subroutine fillholes(phi,flats,mask) + + implicit none + + real(dp),dimension(:,:),intent(inout) :: phi + real(dp),dimension(:,:),intent(inout) :: flats + integer, dimension(:,:),intent(in) :: mask + + ! Internal variables -------------------------------------- + + real(dp),allocatable,dimension(:,:) :: old_phi + integer, allocatable,dimension(:,:) :: pool + + real(dp) :: pvs(9), max_val + real(dp), parameter :: null = 1e+20 + integer :: flag,nx,ny,i,j + + ! --------------------------------------------------------- + + nx=size(phi,1) ; ny=size(phi,2) + + allocate(pool(nx,ny),old_phi(nx,ny)) + + flag = 1 + + ! --------------------------------------------------------- + + do while (flag == 1) + + flag = 0 + + old_phi = phi + + do i=2,nx-1 + do j=2,ny-1 + + flats(i,j) = 0 + + if (mask(i,j) == 1) then + + if (any(old_phi(i-1:i+1,j-1:j+1) < old_phi(i,j))) then + pool(i,j) = 0 + else + pool(i,j) = 1 + end if + + if (pool(i,j) == 1) then + + flag = 1 + + pvs = (/ old_phi(i-1:i+1,j-1), old_phi(i-1:i+1,j+1), old_phi(i-1:i+1,j) /) + + where (pvs == old_phi(i,j)) + pvs = null + end where + + max_val = minval(pvs) + + if (max_val /= null) then + phi(i,j) = max_val + else + flag = 0 + flats(i,j) = 1 + end if + + end if + + end if + end do + end do + + end do + + deallocate(pool,old_phi) + + end subroutine fillholes + +!============================================================== + + subroutine heights_sort(wphi,sorted) + + real(dp),dimension(:,:) :: wphi + integer,dimension(:,:) :: sorted + + integer :: nx,ny,nn,i,j,k + real(dp),dimension(:),allocatable :: vect + integer,dimension(:),allocatable :: ind + + nx=size(wphi,1) ; ny=size(wphi,2) + nn=size(sorted,1) + + allocate(vect(nn),ind(nn)) + + if (nn/=nx*ny.or.size(sorted,2) /= 2) then + print*,'Wrong dimensions' + stop + endif + + k=1 + + do i=1,nx + do j=1,ny + vect(k)=wphi(i,j) + k=k+1 + enddo + enddo + + call indexx(vect,ind) + + do k=1,nn + sorted(k,1)=floor(real(ind(k)-1)/real(ny))+1 + sorted(k,2)=mod(ind(k)-1,ny)+1 + enddo + + do k=1,nn + vect(k)=wphi(sorted(k,1),sorted(k,2)) + enddo + + end subroutine heights_sort + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! + ! The following two subroutines perform an index-sort of an array. + ! They are a GPL-licenced replacement for the Numerical Recipes routine indexx. + ! They are not derived from any NR code, but are based on a quicksort routine by + ! Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + ! in C, and issued under the GNU General Public License. The conversion to + ! Fortran 90, and modification to do an index sort was done by Ian Rutt. + ! + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine indexx(array,index) + + use glimmer_log + + !> Performs an index sort of \texttt{array} and returns the result in + !> \texttt{index}. The order of elements in \texttt{array} is unchanged. + !> + !> This is a GPL-licenced replacement for the Numerical Recipes routine indexx. + !> It is not derived from any NR code, but are based on a quicksort routine by + !> Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + !> in C, and issued under the GNU General Public License. The conversion to + !> Fortran 90, and modification to do an index sort was done by Ian Rutt. + + real(dp),dimension(:) :: array !> Array to be indexed. + integer, dimension(:) :: index !> Index of elements of \texttt{array}. + integer :: i + + if (size(array) /= size(index)) then + call write_log('ERROR: INDEXX size mismatch.',GM_FATAL,__FILE__,__LINE__) + endif + + do i=1,size(index) + index(i)=i + enddo + + call q_sort_index(array,index,1,size(array)) + + end subroutine indexx + +!============================================================== + + recursive subroutine q_sort_index(numbers,index,left,right) + + !> This is the recursive subroutine actually used by \texttt{indexx}. + !> + !> This is a GPL-licenced replacement for the Numerical Recipes routine indexx. + !> It is not derived from any NR code, but are based on a quicksort routine by + !> Michael Lamont (http://linux.wku.edu/~lamonml/kb.html), originally written + !> in C, and issued under the GNU General Public License. The conversion to + !> Fortran 90, and modification to do an index sort was done by Ian Rutt. + + implicit none + + real(dp),dimension(:) :: numbers !> Numbers being sorted + integer, dimension(:) :: index !> Returned index + integer :: left, right !> Limit of sort region + + integer :: ll,rr + integer :: pv_int,l_hold, r_hold,pivpos + real(dp) :: pivot + + ll=left + rr=right + + l_hold = ll + r_hold = rr + pivot = numbers(index(ll)) + pivpos=index(ll) + + do + if (.not.(ll < rr)) exit + + do + if (.not.((numbers(index(rr)) >= pivot) .and. (ll < rr))) exit + rr=rr-1 + enddo + + if (ll /= rr) then + index(ll) = index(rr) + ll=ll+1 + endif + + do + if (.not.((numbers(index(ll)) <= pivot) .and. (ll < rr))) exit + ll=ll+1 + enddo + + if (ll /= rr) then + index(rr) = index(ll) + rr=rr-1 + endif + enddo + + index(ll) = pivpos + pv_int = ll + ll = l_hold + rr = r_hold + if (ll < pv_int) call q_sort_index(numbers, index,ll, pv_int-1) + if (rr > pv_int) call q_sort_index(numbers, index,pv_int+1, rr) + + end subroutine q_sort_index + +end module glide_bwater diff --git a/components/cism/glimmer-cism/libglide/glide_diagnostics.F90 b/components/cism/glimmer-cism/libglide/glide_diagnostics.F90 new file mode 100644 index 0000000000..eab4235864 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_diagnostics.F90 @@ -0,0 +1,729 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_diagnostics.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Calculations of iarea, iareaf and areag in calc_iareaf_iareag() and glide_set_mask() could be replaced by values computed here. +! These could be saved to the model derived type (model%geometry%iarea, etc.) for output. + +module glide_diagnostics + + ! subroutines for computing various useful diagnostics + ! Author: William Lipscomb, LANL + + use glimmer_global, only: dp + use glimmer_log + use glide_types + + implicit none + +contains + + subroutine glide_write_diagnostics (model, time, & + tstep_count, & + minthick_in) + + ! Short driver subroutine to decide whether it's time to write diagnostics. + ! If so, it calls glide_write_diag. + + ! input/output arguments + + type(glide_global_type), intent(in) :: model ! model instance + real(dp), intent(in) :: time ! current time in years + + integer, intent(in), optional :: tstep_count ! current timestep + + real(dp), intent(in), optional :: & + minthick_in ! ice thickness threshold (m) for including in diagnostics + + ! local arguments + + real(dp) :: minthick ! ice thickness threshold (m) for including in diagnostics + ! defaults to eps (a small number) if not passed in + + real(dp), parameter :: & + eps = 1.0d-11 + + real(dp) :: & + quotient, nint_quotient + + if (present(minthick_in)) then + minthick = minthick_in + else + minthick = eps + endif + +! debug +! print*, ' ' +! print*, 'In glide_write_diagnostics' +! print*, 'time =', time +! print*, 'dt_diag =', model%numerics%dt_diag +! print*, 'ndiag =', model%numerics%ndiag +! print*, 'tstep_count =', tstep_count + + !TODO - Make the write_diag criterion more robust; e.g., derive ndiag from dt_diag at initialization. + ! Then we would work with integers (tstep_count and ndiag) and avoid roundoff errors. + + if (model%numerics%dt_diag > 0.d0) then ! usual case + +!! if (mod(time,model%numerics%dt_diag)) < eps) then ! not robust because of roundoff error + + quotient = time/model%numerics%dt_diag + nint_quotient = nint(quotient) + if (abs(quotient - real(nint_quotient,dp)) < eps) then ! time to write + + call glide_write_diag(model, & + time, & + minthick) + endif + + elseif (present(tstep_count) .and. model%numerics%ndiag > 0) then ! decide based on ndiag + + if (mod(tstep_count, model%numerics%ndiag) == 0) then ! time to write + call glide_write_diag(model, & + time, & + minthick) + endif + + endif ! dt_diag > 0 + + end subroutine glide_write_diagnostics + +!-------------------------------------------------------------------------- + + subroutine glide_init_diag (model) + + use parallel + + implicit none + + ! input/output arguments + + type(glide_global_type), intent(inout) :: model ! model instance + + ! local variables + + character(len=100) :: message + + !----------------------------------------------------------------- + ! Find the local rank and indices of the global diagnostic point + !----------------------------------------------------------------- + + call parallel_localindex(model%numerics%idiag, model%numerics%jdiag, & + model%numerics%idiag_local, model%numerics%jdiag_local, & + model%numerics%rdiag_local) + + !WHL - debug + if (main_task) then + write(6,'(a25,2i6)') 'Global idiag, jdiag: ', & + model%numerics%idiag, model%numerics%jdiag + write(6,'(a25,3i6)') 'Local idiag, jdiag, task:', & + model%numerics%idiag_local, & + model%numerics%jdiag_local, & + model%numerics%rdiag_local + endif + + if (main_task) then + + write(message,'(a25,2i6)') 'Global idiag, jdiag: ', & + model%numerics%idiag, model%numerics%jdiag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,3i6)') 'Local idiag, jdiag, task:', & + model%numerics%idiag_local, & + model%numerics%jdiag_local, & + model%numerics%rdiag_local + call write_log(trim(message), type = GM_DIAGNOSTIC) + + endif ! main_task + + end subroutine glide_init_diag + +!-------------------------------------------------------------------------- + + subroutine glide_write_diag (model, time, & + minthick) + + ! Write global diagnostics + ! Also write local diagnostics for a selected grid cell + + use parallel + + use glimmer_paramets, only: thk0, len0, vel0, tim0, unphys_val + use glimmer_physcon, only: scyr, rhoi, shci + + implicit none + + ! input/output arguments + + type(glide_global_type), intent(in) :: model ! model instance + real(dp), intent(in) :: time ! current time in years + real(dp), intent(in) :: & + minthick ! ice thickness threshold (m) for including in diagnostics + + ! local variables + + real(dp) :: & + tot_area, & ! total ice area (km^2) + tot_volume, & ! total ice volume (km^3) + tot_energy, & ! total ice energy (J) + mean_thck, & ! mean ice thickness (m) + mean_temp, & ! mean ice temperature (deg C) + mean_acab, & ! mean surface accumulation/ablation rate (m/yr) + mean_bmlt, & ! mean basal melt (m/yr) + max_thck, max_thck_global, & ! max ice thickness (m) + max_temp, max_temp_global, & ! max ice temperature (deg C) + min_temp, min_temp_global, & ! min ice temperature (deg C) + max_spd_sfc, max_spd_sfc_global, & ! max surface ice speed (m/yr) + max_spd_bas, max_spd_bas_global, & ! max basal ice speed (m/yr) + spd, & ! speed + thck_diag, usrf_diag, & ! local column diagnostics + topg_diag, relx_diag, & + artm_diag, acab_diag, & + bmlt_diag, bwat_diag, & + bheatflx_diag, level + + real(dp), dimension(model%general%upn) :: & + temp_diag, & ! Note: sfc temp not included if temps are staggered + ! (use artm instead) + spd_diag + + real(dp), dimension(model%lithot%nlayer) :: & + lithtemp_diag ! lithosphere column diagnostics + + integer :: i, j, k, ktop, kbed, & + imax, imin, & + jmax, jmin, & + kmax, kmin, & + imax_global, imin_global, & + jmax_global, jmin_global, & + kmax_global, kmin_global, & + procnum, & + ewn, nsn, upn, & ! model%numerics%ewn, etc. + nlith, & ! model%lithot%nlayer + velo_ew_ubound, velo_ns_ubound ! upper bounds for velocity variables + + character(len=100) :: message + + real(dp), parameter :: & + eps = 1.0d-11 ! small number + + ewn = model%general%ewn + nsn = model%general%nsn + upn = model%general%upn + + nlith = model%lithot%nlayer + + if (uhalo > 0) then + velo_ns_ubound = nsn-uhalo + velo_ew_ubound = ewn-uhalo + else + ! for uhalo==0 (as is the case for the glide dycore), the velocity grid has one less + ! point than the main grid, so we need to subtract one to avoid out-of-bounds problems + velo_ns_ubound = nsn-uhalo-1 + velo_ew_ubound = ewn-uhalo-1 + end if + + !----------------------------------------------------------------- + ! Compute and write global diagnostics + !----------------------------------------------------------------- + + call write_log('----------------------------------------------------------') + call write_log(' ') + write(message,'(a25,f24.16)') 'Diagnostic output, time =', time + call write_log(trim(message), type = GM_DIAGNOSTIC) + call write_log(' ') + + ! total ice area (m^2) + + tot_area = 0.d0 + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + tot_area = tot_area + model%numerics%dew * model%numerics%dns + endif + enddo + enddo + tot_area = tot_area * len0**2 + tot_area = parallel_reduce_sum(tot_area) + + ! total ice volume (m^3) + + tot_volume = 0.d0 + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + tot_volume = tot_volume + model%geometry%thck(i,j) & + * model%numerics%dew * model%numerics%dns + endif + enddo + enddo + tot_volume = tot_volume * thk0 * len0**2 + tot_volume = parallel_reduce_sum(tot_volume) + + ! total ice energy relative to T = 0 deg C (J) + + tot_energy = 0.d0 + if (size(model%temper%temp,1) == upn+1) then ! temps are staggered in vertical + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + do k = 1, upn-1 + tot_energy = tot_energy + & + model%geometry%thck(i,j) * model%temper%temp(k,i,j) & + * model%numerics%dew * model%numerics%dns & + *(model%numerics%sigma(k+1) - model%numerics%sigma(k)) + enddo + endif + enddo + enddo + + else ! temps are unstaggered in vertical + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + ! upper half-layer, T = upper sfc temp + tot_energy = tot_energy + & + model%geometry%thck(i,j) * model%temper%temp(1,i,j) & + * model%numerics%dew * model%numerics%dns & + * 0.5d0 * model%numerics%sigma(2) + do k = 2, upn-1 + tot_energy = tot_energy + & + model%geometry%thck(i,j) * model%temper%temp(k,i,j) & + * model%numerics%dew * model%numerics%dns & + * 0.5d0*(model%numerics%sigma(k+1) - model%numerics%sigma(k-1)) + enddo + ! lower half-layer, T = lower sfc temp + tot_energy = tot_energy + & + model%geometry%thck(i,j) * model%temper%temp(upn,i,j) & + * model%numerics%dew * model%numerics%dns & + * 0.5d0 * (1.0d0 - model%numerics%sigma(upn-1)) + endif + enddo + enddo + endif + + tot_energy = tot_energy * thk0 * len0**2 * rhoi * shci + tot_energy = parallel_reduce_sum(tot_energy) + + ! mean thickness + + if (tot_area > eps) then + mean_thck = tot_volume/tot_area + else + mean_thck = 0.d0 + endif + + ! mean temperature + + if (tot_volume > eps) then + mean_temp = tot_energy/ (rhoi*shci*tot_volume) + else + mean_temp = 0.d0 + endif + + ! mean surface accumulation/ablation rate (m/yr) + + mean_acab = 0.d0 + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + mean_acab = mean_acab + model%climate%acab(i,j) & + * model%numerics%dew * model%numerics%dns + endif + enddo + enddo + mean_acab = mean_acab * scyr * thk0 / tim0 * len0**2 ! convert to m^3/yr + mean_acab = parallel_reduce_sum(mean_acab) + + if (tot_area > eps) then + mean_acab = mean_acab/tot_area ! divide by total area to get m/yr + else + mean_acab = 0.d0 + endif + + ! mean basal melting rate (positive for ice loss) + + mean_bmlt = 0.d0 + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + mean_bmlt = mean_bmlt + model%temper%bmlt(i,j) & + * model%numerics%dew * model%numerics%dns + endif + enddo + enddo + + mean_bmlt = mean_bmlt * scyr * thk0 / tim0 * len0**2 ! convert to m^3/yr + mean_bmlt = parallel_reduce_sum(mean_bmlt) + + if (tot_area > eps) then + mean_bmlt = mean_bmlt/tot_area ! divide by total area to get m/yr + else + mean_bmlt = 0.d0 + endif + + ! write global sums and means + + write(message,'(a25,e24.16)') 'Total ice area (km^2) ', & + tot_area*1.0d-6 ! convert to km^2 + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total ice volume (km^3) ', & + tot_volume*1.0d-9 ! convert to km^3 + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Total ice energy (J) ', tot_energy + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Mean thickness (m) ', mean_thck + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Mean temperature (C) ', mean_temp + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Mean accum/ablat (m/yr) ', mean_acab + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,e24.16)') 'Mean basal melt (m/yr) ', mean_bmlt + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! Find various global maxes and mins + + ! max thickness + + imax = 0 + jmax = 0 + max_thck = unphys_val ! = -999.d0 (an arbitrary large negative number) + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) > max_thck) then + max_thck = model%geometry%thck(i,j) + imax = i + jmax = j + endif + enddo + enddo + + imax_global = 0 + jmax_global = 0 + max_thck_global = parallel_reduce_max(max_thck) + if (max_thck == max_thck_global) then ! max_thck lives on this processor + imax_global = (imax - lhalo) + global_col_offset + jmax_global = (jmax - lhalo) + global_row_offset + endif + imax_global = parallel_reduce_max(imax_global) + jmax_global = parallel_reduce_max(jmax_global) + + write(message,'(a25,f24.16,2i4)') 'Max thickness (m), i, j ', & + max_thck_global*thk0, imax_global, jmax_global + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! max temperature + + ktop = lbound(model%temper%temp,1) + kbed = ubound(model%temper%temp,1) + + imax = 0 + jmax = 0 + kmax = 0 + max_temp = unphys_val + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + do k = ktop, kbed + if (model%temper%temp(k,i,j) > max_temp) then + max_temp = model%temper%temp(k,i,j) + imax = i + jmax = j + kmax = k + endif + enddo + endif + enddo + enddo + + call parallel_reduce_maxloc(xin=max_temp, xout=max_temp_global, xprocout=procnum) + call parallel_globalindex(imax, jmax, imax_global, jmax_global) + kmax_global = kmax + call broadcast(imax_global, procnum) + call broadcast(jmax_global, procnum) + call broadcast(kmax_global, procnum) + + write(message,'(a25,f24.16,3i4)') 'Max temperature, i, j, k ', & + max_temp_global, imax_global, jmax_global, kmax_global + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! min temperature + + imin = 0 + jmin = 0 + kmin = 0 + min_temp = 999.d0 ! arbitrary large positive number + do j = lhalo+1, nsn-uhalo + do i = lhalo+1, ewn-uhalo + if (model%geometry%thck(i,j) * thk0 > minthick) then + do k = ktop, kbed + if (model%temper%temp(k,i,j) < min_temp) then + min_temp = model%temper%temp(k,i,j) + imin = i + jmin = j + kmin = k + endif + enddo + endif + enddo + enddo + + call parallel_reduce_minloc(xin=min_temp, xout=min_temp_global, xprocout=procnum) + call parallel_globalindex(imin, jmin, imin_global, jmin_global) + kmin_global = kmin + call broadcast(imin_global, procnum) + call broadcast(jmin_global, procnum) + call broadcast(kmin_global, procnum) + + write(message,'(a25,f24.16,3i4)') 'Min temperature, i, j, k ', & + min_temp_global, imin_global, jmin_global, kmin_global + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! max surface speed + + imax = 0 + jmax = 0 + max_spd_sfc = unphys_val + + do j = lhalo+1, velo_ns_ubound + do i = lhalo+1, velo_ew_ubound + spd = sqrt(model%velocity%uvel(1,i,j)**2 & + + model%velocity%vvel(1,i,j)**2) + if (model%geometry%thck(i,j) * thk0 > minthick .and. spd > max_spd_sfc) then + max_spd_sfc = spd + imax = i + jmax = j + endif + enddo + enddo + + call parallel_reduce_maxloc(xin=max_spd_sfc, xout=max_spd_sfc_global, xprocout=procnum) + call parallel_globalindex(imax, jmax, imax_global, jmax_global) + call broadcast(imax_global, procnum) + call broadcast(jmax_global, procnum) + + write(message,'(a25,f24.16,2i4)') 'Max sfc spd (m/yr), i, j ', & + max_spd_sfc_global*vel0*scyr, imax_global, jmax_global + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! max basal speed + + imax = 0 + jmax = 0 + max_spd_bas = unphys_val + do j = lhalo+1, velo_ns_ubound + do i = lhalo+1, velo_ew_ubound + spd = sqrt(model%velocity%uvel(upn,i,j)**2 & + + model%velocity%vvel(upn,i,j)**2) + if (model%geometry%thck(i,j) * thk0 > minthick .and. spd > max_spd_bas) then + max_spd_bas = spd + imax = i + jmax = j + endif + enddo + enddo + + call parallel_reduce_maxloc(xin=max_spd_bas, xout=max_spd_bas_global, xprocout=procnum) + call parallel_globalindex(imax, jmax, imax_global, jmax_global) + call broadcast(imax_global, procnum) + call broadcast(jmax_global, procnum) + + write(message,'(a25,f24.16,2i4)') 'Max base spd (m/yr), i, j', & + max_spd_bas_global*vel0*scyr, imax_global, jmax_global + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! local diagnostics + + ! initialize to unphysical negative values + usrf_diag = unphys_val + thck_diag = unphys_val + topg_diag = unphys_val + relx_diag = unphys_val + artm_diag = unphys_val + acab_diag = unphys_val + bmlt_diag = unphys_val + bwat_diag = unphys_val + bheatflx_diag = unphys_val + temp_diag(:) = unphys_val + spd_diag (:) = unphys_val + lithtemp_diag(:) = unphys_val + + ! Set local diagnostic values, and communicate them to main_task + + if (model%numerics%idiag_local >= 1 .and. model%numerics%idiag_local <= ewn & + .and. & + model%numerics%jdiag_local >= 1 .and. model%numerics%jdiag_local <= nsn) then + + if (this_rank == model%numerics%rdiag_local) then + + i = model%numerics%idiag_local + j = model%numerics%jdiag_local + usrf_diag = model%geometry%usrf(i,j)*thk0 + thck_diag = model%geometry%thck(i,j)*thk0 + topg_diag = model%geometry%topg(i,j)*thk0 + relx_diag = model%isostasy%relx(i,j)*thk0 + artm_diag = model%climate%artm(i,j) + acab_diag = model%climate%acab(i,j) * thk0*scyr/tim0 + bmlt_diag = model%temper%bmlt(i,j) * thk0*scyr/tim0 + bwat_diag = model%temper%bwat(i,j) * thk0 + bheatflx_diag = model%temper%bheatflx(i,j) + + temp_diag(:) = model%temper%temp(1:upn,i,j) + spd_diag(:) = sqrt(model%velocity%uvel(1:upn,i,j)**2 & + + model%velocity%vvel(1:upn,i,j)**2) * vel0*scyr + if (model%options%gthf == GTHF_COMPUTE) & + lithtemp_diag(:) = model%lithot%temp(i,j,:) + endif + + usrf_diag = parallel_reduce_max(usrf_diag) + thck_diag = parallel_reduce_max(thck_diag) + topg_diag = parallel_reduce_max(topg_diag) + relx_diag = parallel_reduce_max(relx_diag) + artm_diag = parallel_reduce_max(artm_diag) + acab_diag = parallel_reduce_max(acab_diag) + bmlt_diag = parallel_reduce_max(bmlt_diag) + bwat_diag = parallel_reduce_max(bwat_diag) + bheatflx_diag = parallel_reduce_max(bheatflx_diag) + + do k = 1, upn + temp_diag(k) = parallel_reduce_max(temp_diag(k)) + spd_diag(k) = parallel_reduce_max(spd_diag(k)) + enddo + + do k = 1, nlith + lithtemp_diag(k) = parallel_reduce_max(lithtemp_diag(k)) + enddo + + call write_log(' ') + write(message,'(a39,2i6)') & + 'Grid point diagnostics: (i,j) =', model%numerics%idiag, & + model%numerics%jdiag + call write_log(trim(message), type = GM_DIAGNOSTIC) + write(message,'(a39,3i6)') & + 'Local (i,j,rank) = ', model%numerics%idiag_local, & + model%numerics%jdiag_local, & + model%numerics%rdiag_local + call write_log(trim(message), type = GM_DIAGNOSTIC) + call write_log(' ') + + write(message,'(a25,f24.16)') 'Upper surface (m) ', usrf_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Thickness (m) ', thck_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Bedrock topo (m) ', topg_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + write(message,'(a25,f24.16)') 'Relaxed bedrock (m) ', relx_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + endif + + write(message,'(a25,f24.16)') 'Sfc mass balance (m/yr) ', acab_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Basal melt rate (m/yr) ', bmlt_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Basal water depth (m) ', bwat_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + write(message,'(a25,f24.16)') 'Basal heat flux (W/m^2) ', bheatflx_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! Vertical profile of ice speed and temperature + + call write_log(' ') + write(message,'(a55)') ' Sigma Ice speed (m/yr) Ice temperature (C)' + call write_log(trim(message), type = GM_DIAGNOSTIC) + + if (size(model%temper%temp,1) == upn+1) then ! temperatures staggered in vertical + ! (at layer midpoints) + + ! upper surface + write (message,'(f6.3,2f24.16)') model%numerics%sigma(1), spd_diag(1), artm_diag + call write_log(trim(message), type = GM_DIAGNOSTIC) + + ! internal + do k = 1, upn-1 + + ! speed at top of layer + if (k > 1) then + write (message,'(f6.3,f24.16)') model%numerics%sigma(k), spd_diag(k) + call write_log(trim(message), type = GM_DIAGNOSTIC) + endif + + ! temp at layer midpoint + write (message,'(f6.3,24x,f24.16)') model%numerics%stagsigma(k), temp_diag(k) + call write_log(trim(message), type = GM_DIAGNOSTIC) + + enddo + + ! lower surface + write (message,'(f6.3,2f24.16)') model%numerics%sigma(upn), spd_diag(upn), temp_diag(upn) + call write_log(trim(message), type = GM_DIAGNOSTIC) + + else ! temperatures unstaggered in vertical (at layer interfaces) + + do k = 1, upn + write (message,'(f6.3,2f24.16)') model%numerics%sigma(k), spd_diag(k), temp_diag(k) + call write_log(trim(message), type = GM_DIAGNOSTIC) + enddo + + endif ! temps staggered + + ! Vertical profile of upper lithosphere temperature + + if (model%options%gthf == GTHF_COMPUTE) then + + call write_log(' ') + write(message,'(a41)') ' Level (m) Lithosphere temp (C)' + call write_log(trim(message), type = GM_DIAGNOSTIC) + + level = 0.d0 + do k = 1, nlith + level = level + model%lithot%deltaz(nlith) + write (message,'(f10.0,6x,f24.16)') level, lithtemp_diag(k) + call write_log(trim(message), type = GM_DIAGNOSTIC) + enddo + + endif ! gthf_compute + + endif ! idiag_local and jdiag_local in bounds + + call write_log(' ') + + end subroutine glide_write_diag + +!============================================================== + +end module glide_diagnostics diff --git a/components/cism/glimmer-cism/libglide/glide_grid_operators.F90 b/components/cism/glimmer-cism/libglide/glide_grid_operators.F90 new file mode 100644 index 0000000000..dbd81e1950 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_grid_operators.F90 @@ -0,0 +1,241 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_grid_operators.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! Various grid operators for the Glide dycore, including routines for computing gradients +! and switching between staggered and unstaggered grids + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_nan.inc" +#include "glide_mask.inc" + +module glide_grid_operators + + use glimmer_global, only : dp + implicit none + +contains + +!---------------------------------------------------------------------------- + + subroutine glide_geometry_derivs(model) + +! Compute geometric quantities needed by the glide dycore: +! stagthck (given thck), along with the gradients +! dusrfdew/dns (given usrf) and dthckdew/dns (given thck). + + use glide_types, only: glide_global_type + + implicit none + + type(glide_global_type), intent(inout) :: model + + ! Interpolate ice thickness to velocity points + + call stagvarb(model%geometry% thck, & + model%geomderv% stagthck, & + model%general% ewn, & + model%general% nsn) + + ! Compute EW and NS gradients in usrf and thck + + call geomders(model%numerics, & + model%geometry% usrf, & + model%geomderv% stagthck,& + model%geomderv% dusrfdew, & + model%geomderv% dusrfdns) + + call geomders(model%numerics, & + model%geometry% thck, & + model%geomderv% stagthck,& + model%geomderv% dthckdew, & + model%geomderv% dthckdns) + + !NOTE: The following commented-out code is included in stagthickness. +! where (model%geomderv%stagthck == 0.d0) +! model%geomderv%dusrfdew = 0.d0 +! model%geomderv%dusrfdns = 0.d0 +! model%geomderv%dthckdew = 0.d0 +! model%geomderv%dthckdns = 0.d0 +! endwhere + + end subroutine glide_geometry_derivs + +!--------------------------------------------------------------- + + subroutine stagvarb(ipvr,opvr,ewn,nsn) + + ! Interpolate a scalar variable such as ice thickness from cell centers to cell corners. + + !NOTE: This subroutine, used by the glide SIA dycore, is different from + ! stagthickness, which is used by the glam HO dycore. In stagthickness, zero-thickness + ! values are ignored when thickness is averaged over four adjacent grid cells. + ! In stagvarb, zero-thickness values are included in the average. + ! The glam approach works better for calving. + !TODO: Add a flag that allows zero-thickness values to be omitted from the gradient (e.g., for flwa and temp). + + implicit none + + real(dp), intent(out), dimension(:,:) :: opvr + real(dp), intent(in), dimension(:,:) :: ipvr + + integer, intent(in) :: ewn,nsn + + opvr(1:ewn-1,1:nsn-1) = (ipvr(2:ewn,1:nsn-1) + ipvr(1:ewn-1,2:nsn) + & + ipvr(2:ewn,2:nsn) + ipvr(1:ewn-1,1:nsn-1)) / 4.0d0 + + end subroutine stagvarb + +!---------------------------------------------------------------------------- + + subroutine stagvarb_3d(ipvr, opvr, ewn, nsn, upn) + real(dp), intent(in), dimension(:,:,:) :: ipvr + real(dp), intent(out), dimension(:,:,:) :: opvr + integer, intent(in) :: ewn, nsn, upn + integer :: k + + do k = 1, upn + call stagvarb(ipvr(k,:,:), opvr(k,:,:), ewn, nsn) + end do + + end subroutine stagvarb_3d + +!---------------------------------------------------------------------------- + + subroutine stagvarb_mask(ipvr,opvr,ewn,nsn,geometry_mask) + + implicit none + + real(dp), intent(out), dimension(:,:) :: opvr + real(dp), intent(in), dimension(:,:) :: ipvr + + integer, intent(in) :: ewn,nsn + integer, intent(in), dimension(:,:) :: geometry_mask + integer :: ew,ns,n + real(dp) :: tot + + opvr(1:ewn-1,1:nsn-1) = (ipvr(2:ewn,1:nsn-1) + ipvr(1:ewn-1,2:nsn) + & + ipvr(2:ewn,2:nsn) + ipvr(1:ewn-1,1:nsn-1)) / 4.0d0 + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + + !If any of our staggering points are shelf front, ignore zeros when staggering + if (any(GLIDE_NO_ICE(geometry_mask(ew:ew+1, ns:ns+1)))) then + n = 0 + tot = 0 + + if (GLIDE_HAS_ICE(geometry_mask(ew,ns))) then + tot = tot + ipvr(ew,ns) + n = n + 1 + end if + if (GLIDE_HAS_ICE(geometry_mask(ew+1,ns))) then + tot = tot + ipvr(ew+1,ns) + n = n + 1 + end if + if (GLIDE_HAS_ICE(geometry_mask(ew,ns+1))) then + tot = tot + ipvr(ew,ns+1) + n = n + 1 + end if + if (GLIDE_HAS_ICE(geometry_mask(ew+1,ns+1))) then + tot = tot + ipvr(ew+1,ns+1) + n = n + 1 + end if + if (n > 0) then + opvr(ew,ns) = tot/n + else + opvr(ew,ns) = 0 + end if + + !Standard Staggering + else + opvr(ew,ns) = (ipvr(ew+1,ns) + ipvr(ew,ns+1) + & + ipvr(ew+1,ns+1) + ipvr(ew,ns)) / 4.0d0 + end if + + end do + end do + + end subroutine stagvarb_mask + +!---------------------------------------------------------------------------- + + subroutine stagvarb_3d_mask(ipvr, opvr, ewn, nsn, upn, geometry_mask) + real(dp), intent(in), dimension(:,:,:) :: ipvr + real(dp), intent(out), dimension(:,:,:) :: opvr + integer, intent(in) :: ewn, nsn, upn + integer, intent(in), dimension(:,:) :: geometry_mask + integer :: k + + do k = 1, upn + call stagvarb_mask(ipvr(k,:,:), opvr(k,:,:), ewn, nsn, geometry_mask) + end do + + end subroutine stagvarb_3d_mask + +!---------------------------------------------------------------------------- + + subroutine geomders(numerics,ipvr,stagthck,opvrew,opvrns) + + use glide_types, only: glide_numerics + + implicit none + + type(glide_numerics) :: numerics + real(dp), intent(out), dimension(:,:) :: opvrew, opvrns + real(dp), intent(in), dimension(:,:) :: ipvr, stagthck + + real(dp) :: dew2, dns2 + integer :: ew,ns,ewn,nsn + + ! Obviously we don't need to do this every time, + ! but will do so for the moment. + dew2 = 1.d0/(2.0d0 * numerics%dew) + dns2 = 1.d0/(2.0d0 * numerics%dns) + ewn=size(ipvr,1) + nsn=size(ipvr,2) + + do ns=1,nsn-1 + do ew = 1,ewn-1 + if (stagthck(ew,ns) /= 0.0d0) then + opvrew(ew,ns) = (ipvr(ew+1,ns+1)+ipvr(ew+1,ns)-ipvr(ew,ns)-ipvr(ew,ns+1)) * dew2 + opvrns(ew,ns) = (ipvr(ew+1,ns+1)+ipvr(ew,ns+1)-ipvr(ew,ns)-ipvr(ew+1,ns)) * dns2 + else + opvrew(ew,ns) = 0. + opvrns(ew,ns) = 0. + end if + end do + end do + + end subroutine geomders + +!---------------------------------------------------------------------------- + +end module glide_grid_operators + +!---------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_ground.F90 b/components/cism/glimmer-cism/libglide/glide_ground.F90 new file mode 100644 index 0000000000..f1172fd5db --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_ground.F90 @@ -0,0 +1,412 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_ground.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Change module name to something more appropriate (glide_marine?) +!TODO - Make glide_marinlim fully parallel? + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" +module glide_ground + + use glide_types + use glimmer_global, only: dp + use parallel + + implicit none + +contains +!------------------------------------------------------------------------------- + + subroutine glide_marinlim(which, & + thck, relx, & + topg, mask, & + mlimit, calving_fraction, & + eus, calving_field, & + ground, & + dew, dns, & + nsn, ewn) + + ! Remove non-grounded ice according to one of several alternative methods + + implicit none + + !--------------------------------------------------------------------- + ! Subroutine arguments + !--------------------------------------------------------------------- + + !TODO: Change mask to thkmask? The argument passed in is model%geometry%thkmask. + + integer, intent(in) :: which !> Calving method option + real(dp),dimension(:,:),intent(inout) :: thck !> Ice thickness + real(dp),dimension(:,:),intent(in) :: relx !> Relaxed topography + real(dp),dimension(:,:),intent(in) :: topg !> Present bedrock topography + integer, dimension(:,:), intent(in) :: mask !> grid type mask + real(dp), intent(in) :: mlimit !> Lower limit on topography elevation for + !> ice to be present. + real(dp), intent(in) :: calving_fraction !> fraction of ice lost when calving; used with + !> $\mathtt{which}=3$. + real(dp), intent(in) :: eus !> eustatic sea level + real(dp),dimension(:,:),intent(out) :: calving_field ! thickness lost due to calving + real(dp), intent(in) :: dew,dns + integer, intent(in) :: nsn,ewn + + type(glide_grnd), intent(inout) :: ground !> ground instance + + integer :: ew,ns + !--------------------------------------------------------------------- + + calving_field(:,:) = 0.d0 ! using dp for constants in case calving_field changed to dp + + select case (which) + + case(MARINE_NONE) ! do nothing + + + case(MARINE_FLOAT_ZERO) ! Set thickness to zero if ice is floating + + where (GLIDE_IS_FLOAT(mask)) + calving_field = thck + thck = 0.0d0 + end where + + case(MARINE_FLOAT_FRACTION) ! remove fraction of ice when floating + + do ns = 2,size(thck,2)-1 + do ew = 2,size(thck,1)-1 + if (GLIDE_IS_CALVING(mask(ew,ns))) then + calving_field(ew,ns) = (1.d0-calving_fraction)*thck(ew,ns) + thck(ew,ns) = calving_fraction*thck(ew,ns) + !mask(ew,ns) = ior(mask(ew,ns), GLIDE_MASK_OCEAN) + end if + end do + end do + + ! if uncomment above mask update, then call parallel_halo(mask) + + case(MARINE_RELX_THRESHOLD) ! Set thickness to zero if relaxed bedrock is below a given level + + where (relx <= mlimit+eus) + calving_field = thck + thck = 0.0d0 + end where + + case(MARINE_TOPG_THRESHOLD) ! Set thickness to zero at marine edge if present bedrock is below a given level + + where (GLIDE_IS_MARINE_ICE_EDGE(mask) .and. topg < mlimit+eus) + calving_field = thck + thck = 0.0d0 + end where + +!WHL - Removed old case (5) based on recommendation from Jesse Johnson +! Then changed old case(7) to new case(5) to avoid a gap in the case numbering. + + ! Huybrechts grounding line scheme for Greenland initialization + + case(MARINE_HUYBRECHTS) ! used to be case(7) + + !TODO - MARINE_HUYBRECHTS case assumes eus has units of meters. Change to eus*thk0? + ! Also check units of relx. + if(eus > -80.d0) then + where (relx <= 2.d0*eus) + calving_field = thck + thck = 0.0d0 + end where + elseif (eus <= -80.d0) then + where (relx <= (2.d0*eus - 0.25d0*(eus + 80.d0)**2.d0)) + calving_field = thck + thck = 0.0d0 + end where + end if + + ! Commenting out this case for now +!! case(6) + + ! not serial as far as I can tell as well; for parallelization, issues + ! arise from components of ground being updated, and corresponding halos + ! also need to be updated? Waiting until serial fixes are implemented + +!! call not_parallel(__FILE__, __LINE__) ! not serial as far as I can tell as well +!! call update_ground_line(ground, topg, thck, eus, dew, dns, ewn, nsn, mask) + +!! where (GLIDE_IS_FLOAT(mask)) +!! calving_field = thck +!! thck = 0.0d0 +!! end where + + end select + + end subroutine glide_marinlim + +!------------------------------------------------------------------------- + + subroutine calc_gline_flux(stagthk, velnorm, mask, gline_flux, ubas, vbas, dew) + + ! simple subroutine to calculate the flux at the grounding line + + implicit none + + !JEFF removing pointer attribute integer, dimension(:,:),pointer :: mask !> grid type mask + integer, dimension(:,:) :: mask ! grid type mask + real(dp),dimension(:,:),intent(in) :: stagthk ! Ice thickness (scaled) + real(dp),dimension(:,:,:), intent(in) :: velnorm ! horizontal ice speed + real(dp),dimension(:,:), intent(inout) :: gline_flux ! Grounding Line flux + real(dp),dimension(:,:), intent(in) :: ubas ! basal velocity in u-dir + real(dp),dimension(:,:), intent(in) :: vbas ! basal velocity in v-dir + real(dp),intent(in) :: dew ! grid spacing + integer :: ewn, nsn + + !TODO: get the grounding line flux on the velo grid; currently using both the ice grid and the velo grid. + + ewn = size(gline_flux, 1) + nsn = size(gline_flux, 2) + + where (GLIDE_IS_GROUNDING_LINE(mask)) + gline_flux = stagthk * ((4.d0/5.d0)* velnorm(1,:,:) + & + (ubas**2.d0 + vbas**2.d0)**(1.d0/2.d0)) * dew + end where + + !Note: - This update may not be needed. gline_flux is just a diagnostic. + call parallel_halo(gline_flux) + + end subroutine calc_gline_flux + +!------------------------------------------------------------------------- + !TODO - The next few subroutines are associated with case 6, which is not supported. Remove them? + + !Loops through the mask and does the interpolation for all the grounding lines + + subroutine update_ground_line(ground, topg, thck, eus, dew, dns, ewn, nsn, mask) + + implicit none + type(glide_grnd) :: ground !> ground instance + real(dp),dimension(:,:),intent(in) :: topg !> Present bedrock topography (scaled) + real(dp),dimension(:,:),intent(in) :: thck !> Present thickness (scaled) + real(dp),intent(in) :: eus !> eustatic sea level + real(dp),intent(in) :: dew, dns + integer, intent(in) :: ewn, nsn + !JEFF remove pointer attribute integer, dimension(:,:),pointer :: mask !> grid type mask + integer, dimension(:,:) :: mask !> grid type mask + integer :: ew,ns,jns,jew,j1ns,j1ew + real(dp) :: xg !grounding line + !this is assuming the grounding line is the last grounded pt on the mask + !reset grounding line data to zero + ground%gl_ew = 0.d0 + ground%gl_ns = 0.d0 + do ns = 1,nsn + do ew = 1,ewn + if (GLIDE_IS_GROUNDING_LINE(mask(ew,ns))) then + !the grounding line always rounds down so it is grounded. + !southern grounding line + if (GLIDE_IS_OCEAN(mask(ew,ns - 1)) & + .or. (GLIDE_IS_FLOAT(mask(ew,ns - 1)))) then + xg = lin_reg_xg(topg,thck,eus,dew,dns,ew,ns,ew,ns-1) + call set_ground_line(ground,ew,ns,ew,ns-1,xg) + !northern grounding line + else if (GLIDE_IS_OCEAN(mask(ew,ns + 1)) & + .or. (GLIDE_IS_FLOAT(mask(ew,ns + 1)))) then + xg = lin_reg_xg(topg,thck,eus,dew,dns,ew,ns,ew,ns+1) + call set_ground_line(ground,ew,ns,ew,ns+1,xg) + end if + + !western grounding line + if (GLIDE_IS_OCEAN(mask(ew - 1,ns)) & + .or. GLIDE_IS_FLOAT(mask(ew - 1,ns))) then + xg = lin_reg_xg(topg,thck,eus,dew,dns,ew,ns,ew - 1,ns) + call set_ground_line(ground,ew,ns,ew-1,ns,xg) + !eastern grounding line + else if (GLIDE_IS_OCEAN(mask(ew + 1,ns)) & + .or. GLIDE_IS_FLOAT(mask(ew + 1,ns))) then + xg = lin_reg_xg(topg,thck,eus,dew,dns,ew,ns,ew + 1,ns) + call set_ground_line(ground,ew,ns,ew + 1,ns,xg) + end if + end if + end do + end do + + end subroutine update_ground_line + +!------------------------------------------------------------------------- + + subroutine set_ground_line(ground,ew1,ns1,ew2,ns2,value) + + use glide_types + implicit none + + type(glide_grnd) :: ground !> model instance + integer, intent(in) :: ns1 !grounding line in ns direction + integer, intent(in) :: ew1 !grounding line in ew direction + integer, intent(in) :: ns2 !grounding line in ns direction + integer, intent(in) :: ew2 !grounding line in ew direction + real(dp), intent(in) :: value !grounding line in ew direction + integer :: slot_ew, slot_ns !integers to compute the min + + if (ns1 == ns2) then + slot_ew = min(ew1,ew2) + ground%gl_ew(slot_ew,ns1) = value + else if (ew1 == ew2) then + slot_ns = min(ns1,ns2) + ground%gl_ns(ew1,slot_ns) = value + end if + end subroutine set_ground_line + +!------------------------------------------------------------------------- + + !does the pattyn interpolation for the grounding line + +!! real function lin_reg_xg(topg, thck, eus, dew, dns, ew, ns, j1ew, j1ns) + function lin_reg_xg(topg, thck, eus, dew, dns, ew, ns, j1ew, j1ns) + + use glide_types + use glimmer_physcon, only : rhoi, rhoo + real(dp) :: lin_reg_xg + real(dp),dimension(:,:),intent(in) :: topg !> Present bedrock topography (scaled) + real(dp),dimension(:,:),intent(in) :: thck !> Present thickness (scaled) + real(dp), intent(in) :: eus !> eustatic sea level + real(dp), intent(in) :: dew, dns + integer, intent(in) :: ns !grounding line in ns direction + integer, intent(in) :: ew !grounding line in ew direction + integer, intent(in) :: j1ns !ice shelf in ns direction + integer, intent(in) :: j1ew !ice shelf line in ew direction + real(dp) :: xg !grounding line + real(dp) :: dx !distance between gridpts + real(dp) :: xj !grounding line + real(dp) :: fj !f at grid pnt j + real(dp) :: fj_1 !f evaluated at j (+/-) 1 + real(dp) :: df !delta f of fj,jf_1 + + if (ew == j1ew) then + dx = dns + xj = ns*dx + else + dx = dew + xj = ew*dx + end if + !set the pattyn f function - assuming ocean water + fj = (eus - topg(ew,ns))*rhoo/(rhoi*thck(ew,ns)) + if (thck(j1ew,j1ns) > 0.d0) then + fj_1 = (eus - topg(j1ew,j1ns))*rhoo/(rhoi*thck(j1ew,j1ns)) + df = (fj_1 - fj)/dx + xg = (1 - fj + df*xj)/df + else + xg = xj + end if + + lin_reg_xg = xg + return + end function lin_reg_xg + +!------------------------------------------------------------------------- + + !TODO - Remove function get_ground_thck? Currently not called. + +!! real function get_ground_thck(ground,topg,usrf,dew,dns,ew1,ns1,ew2,ns2) + function get_ground_thck(ground,topg,usrf,dew,dns,ew1,ns1,ew2,ns2) + + use glide_types + implicit none + real(dp) :: get_ground_thck + type(glide_grnd) :: ground !> ground instance + real(dp),dimension(:,:),intent(in) :: topg !> Present bedrock topography (scaled) + real(dp),dimension(:,:),intent(in) :: usrf !> surface height + real(dp), intent(in) :: dew, dns + integer :: ns1,ew1,ns2,ew2,min_ns,min_ew,max_ns,max_ew !grounding line in ns/ew direction + real(dp) :: xg !grounding line + real(dp) :: tg !topographic height at grounding line + real(dp) :: ig !ice height at grounding line + real(dp) :: hg !thickness at the grounding line + real(dp) :: x1 !pts for linear interpolation + real(dp) :: x0 + real(dp) :: y1 + real(dp) :: y0 + !using lin. interpolation to find top at grounding line + if (ns1 == ns2) then + min_ew = min(ew1,ew2) + max_ew = max(ew1,ew2) + min_ns = ns1 + max_ns = ns1 + x0 = min_ew*dew !model%numerics%dew + x1 = max_ew*dew + else if (ew1 == ew2) then + min_ns = min(ns1,ns2) + max_ns = max(ns1,ns2) + min_ew = ew1 + max_ew = ew1 + x0 = min_ns*dns !model%numerics%dns + x1 = max_ns*dns + end if + !get grounding line + xg = ground%gl_ns(min_ew,min_ns) + !find top height at xg + y0 = topg(min_ew,min_ns) !model%geometry%topg + y1 = topg(max_ew,max_ns) + tg = y0 + (xg - x0)*((y1 - y0)/(x1 - x0)) + !find ice at xg + y0 = usrf(min_ew,min_ns) !model%geometry%usrf + y1 = usrf(max_ew,max_ns) + ig = y0 + (xg - x0)*((y1 - y0)/(x1 - x0)) + !thickness + hg = ig - tg + get_ground_thck = hg + return + end function get_ground_thck + +!------------------------------------------------------------------------- + !TODO - Remove function get_ground_line? Currently not called. + + !This function returns the correct grounding line using the data given + ! the mask reference point. dir is specifying 'ew' or 'ns', but can be + ! left null if there's only one option. + +!! real function get_ground_line(ground,ew1,ns1,ew2,ns2) + function get_ground_line(ground,ew1,ns1,ew2,ns2) + + use glide_types + implicit none + real(dp) :: get_ground_line + type(glide_grnd) :: ground !> glide ground instance + integer :: ns1,ew1,ns2,ew2,slot_ns,slot_ew !grounding line in ns/ew direction + real(dp) :: appr_ground !grounding line + + if (ns1 == ns2) then + slot_ew = min(ew1,ew2) + appr_ground = ground%gl_ns(slot_ew,ns1) + else if (ew1 == ew2) then + slot_ns = min(ns1,ns2) + appr_ground = ground%gl_ew(ew1,slot_ns) + end if + get_ground_line = appr_ground + return + + end function get_ground_line + +!--------------------------------------------------------------------------- + +end module glide_ground + +!--------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_io.F90.default b/components/cism/glimmer-cism/libglide/glide_io.F90.default new file mode 100644 index 0000000000..42445d1ede --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_io.F90.default @@ -0,0 +1,5035 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! WARNING: this file was automatically generated on +! Fri, 03 Apr 2015 18:33:13 +0000 +! from ncdf_template.F90.in +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + + +module glide_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use glide_types + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in glide_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine glide_io_createall(model,data,outfiles) + ! open all netCDF files for output + use glide_types + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(glide_global_type) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in glide_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call glide_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine glide_io_createall + + subroutine glide_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use glide_types + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glide_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call glide_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glide_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine glide_io_writeall + + subroutine glide_io_create(outfile,model,data) + use parallel + use glide_types + use glide_types + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(glide_global_type) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + integer :: level_dimid + integer :: lithoz_dimid + integer :: staglevel_dimid + integer :: stagwbndlevel_dimid + integer :: time_dimid + integer :: x0_dimid + integer :: x1_dimid + integer :: y0_dimid + integer :: y1_dimid + + ! defining dimensions + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'level',model%general%upn,level_dimid) + else + status = parallel_inq_dimid(NCO%id,'level',level_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'lithoz',model%lithot%nlayer,lithoz_dimid) + else + status = parallel_inq_dimid(NCO%id,'lithoz',lithoz_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'staglevel',model%general%upn-1,staglevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'staglevel',staglevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'stagwbndlevel',model%general%upn+1,stagwbndlevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'stagwbndlevel',stagwbndlevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'time',time_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x0',global_ewn-1,x0_dimid) + else + status = parallel_inq_dimid(NCO%id,'x0',x0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x1',global_ewn,x1_dimid) + else + status = parallel_inq_dimid(NCO%id,'x1',x1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y0',global_nsn-1,y0_dimid) + else + status = parallel_inq_dimid(NCO%id,'y0',y0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y1',global_nsn,y1_dimid) + else + status = parallel_inq_dimid(NCO%id,'y1',y1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,"_tavg") + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in glide_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + ! level -- sigma layers + if (.not.outfile%append) then + call write_log('Creating variable level') + status = parallel_def_var(NCO%id,'level',get_xtype(outfile,NF90_FLOAT),(/level_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! lithoz -- vertical coordinate of lithosphere layer + if (.not.outfile%append) then + call write_log('Creating variable lithoz') + status = parallel_def_var(NCO%id,'lithoz',get_xtype(outfile,NF90_FLOAT),(/lithoz_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'vertical coordinate of lithosphere layer') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! staglevel -- stag sigma layers + if (.not.outfile%append) then + call write_log('Creating variable staglevel') + status = parallel_def_var(NCO%id,'staglevel',get_xtype(outfile,NF90_FLOAT),(/staglevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! stagwbndlevel -- stag sigma layers with boundaries + if (.not.outfile%append) then + call write_log('Creating variable stagwbndlevel') + status = parallel_def_var(NCO%id,'stagwbndlevel',get_xtype(outfile,NF90_FLOAT),(/stagwbndlevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers with boundaries') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate_with_bnd') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! x0 -- Cartesian x-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable x0') + status = parallel_def_var(NCO%id,'x0',get_xtype(outfile,NF90_FLOAT),(/x0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + status = parallel_put_att(NCO%id, varid, 'axis', 'X') + end if + + ! x1 -- Cartesian x-coordinate + if (.not.outfile%append) then + call write_log('Creating variable x1') + status = parallel_def_var(NCO%id,'x1',get_xtype(outfile,NF90_FLOAT),(/x1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + status = parallel_put_att(NCO%id, varid, 'axis', 'X') + end if + + ! y0 -- Cartesian y-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable y0') + status = parallel_def_var(NCO%id,'y0',get_xtype(outfile,NF90_FLOAT),(/y0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + status = parallel_put_att(NCO%id, varid, 'axis', 'Y') + end if + + ! y1 -- Cartesian y-coordinate + if (.not.outfile%append) then + call write_log('Creating variable y1') + status = parallel_def_var(NCO%id,'y1',get_xtype(outfile,NF90_FLOAT),(/y1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + status = parallel_put_att(NCO%id, varid, 'axis', 'Y') + end if + + ! acab -- accumulation, ablation rate + pos = index(NCO%vars,' acab ') + status = parallel_inq_varid(NCO%id,'acab',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%climate%acab)) then + call write_log('Creating variable acab') + status = parallel_def_var(NCO%id,'acab',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_acab)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'accumulation, ablation rate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_surface_specific_mass_balance') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable acab was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! adv_cfl_dt -- advective CFL maximum time step + pos = index(NCO%vars,' adv_cfl_dt ') + status = parallel_inq_varid(NCO%id,'adv_cfl_dt',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%numerics%adv_cfl_dt)) then + call write_log('Creating variable adv_cfl_dt') + status = parallel_def_var(NCO%id,'adv_cfl_dt',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'advective CFL maximum time step') + status = parallel_put_att(NCO%id, varid, 'units', 'years') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable adv_cfl_dt was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! artm -- annual mean air temperature + pos = index(NCO%vars,' artm ') + status = parallel_inq_varid(NCO%id,'artm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%climate%artm)) then + call write_log('Creating variable artm') + status = parallel_def_var(NCO%id,'artm',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'annual mean air temperature') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_temperature') + status = parallel_put_att(NCO%id, varid, 'cell_methods', 'time: mean') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable artm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! beta -- higher-order bed stress coefficient + pos = index(NCO%vars,' beta ') + status = parallel_inq_varid(NCO%id,'beta',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%beta)) then + call write_log('Creating variable beta') + status = parallel_def_var(NCO%id,'beta',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_beta)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'higher-order bed stress coefficient') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa yr/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable beta was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! bfricflx -- basal friction heat flux + pos = index(NCO%vars,' bfricflx ') + status = parallel_inq_varid(NCO%id,'bfricflx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%bfricflx)) then + call write_log('Creating variable bfricflx') + status = parallel_def_var(NCO%id,'bfricflx',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(1.0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal friction heat flux') + status = parallel_put_att(NCO%id, varid, 'units', 'watt/meter2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable bfricflx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! bheatflx -- upward basal heat flux + pos = index(NCO%vars,' bheatflx ') + status = parallel_inq_varid(NCO%id,'bheatflx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%bheatflx)) then + call write_log('Creating variable bheatflx') + status = parallel_def_var(NCO%id,'bheatflx',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_bflx)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'upward basal heat flux') + status = parallel_put_att(NCO%id, varid, 'units', 'watt/meter2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable bheatflx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! bmlt -- basal melt rate + pos = index(NCO%vars,' bmlt ') + status = parallel_inq_varid(NCO%id,'bmlt',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%bmlt)) then + call write_log('Creating variable bmlt') + status = parallel_def_var(NCO%id,'bmlt',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_acab)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal melt rate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_basal_melt_rate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable bmlt was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! btemp -- basal ice temperature + pos = index(NCO%vars,' btemp ') + status = parallel_inq_varid(NCO%id,'btemp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%temp)) then + call write_log('Creating variable btemp') + status = parallel_def_var(NCO%id,'btemp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal ice temperature') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_temperature') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable btemp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! btractx -- basal traction (x-direction comp) + pos = index(NCO%vars,' btractx ') + status = parallel_inq_varid(NCO%id,'btractx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%btractx)) then + call write_log('Creating variable btractx') + status = parallel_def_var(NCO%id,'btractx',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal traction (x-direction comp)') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable btractx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! btracty -- basal traction (y-direction comp) + pos = index(NCO%vars,' btracty ') + status = parallel_inq_varid(NCO%id,'btracty',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%btracty)) then + call write_log('Creating variable btracty') + status = parallel_def_var(NCO%id,'btracty',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal traction (y-direction comp)') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable btracty was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! btrc -- basal slip coefficient + pos = index(NCO%vars,' btrc ') + status = parallel_inq_varid(NCO%id,'btrc',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%btrc)) then + call write_log('Creating variable btrc') + status = parallel_def_var(NCO%id,'btrc',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_btrc)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal slip coefficient') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/pascal/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable btrc was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! bwat -- basal water depth + pos = index(NCO%vars,' bwat ') + status = parallel_inq_varid(NCO%id,'bwat',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%bwat)) then + call write_log('Creating variable bwat') + status = parallel_def_var(NCO%id,'bwat',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal water depth') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable bwat was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! bwatflx -- basal water flux + pos = index(NCO%vars,' bwatflx ') + status = parallel_inq_varid(NCO%id,'bwatflx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%bwatflx)) then + call write_log('Creating variable bwatflx') + status = parallel_def_var(NCO%id,'bwatflx',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal water flux') + status = parallel_put_att(NCO%id, varid, 'units', 'meter3/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable bwatflx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! calving -- ice margin calving + pos = index(NCO%vars,' calving ') + status = parallel_inq_varid(NCO%id,'calving',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%climate%calving)) then + call write_log('Creating variable calving') + status = parallel_def_var(NCO%id,'calving',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice margin calving') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable calving was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! diff_cfl_dt -- diffusive CFL maximum time step + pos = index(NCO%vars,' diff_cfl_dt ') + status = parallel_inq_varid(NCO%id,'diff_cfl_dt',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+11) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%numerics%diff_cfl_dt)) then + call write_log('Creating variable diff_cfl_dt') + status = parallel_def_var(NCO%id,'diff_cfl_dt',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'diffusive CFL maximum time step') + status = parallel_put_att(NCO%id, varid, 'units', 'years') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable diff_cfl_dt was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! diffu -- apparent diffusivity + pos = index(NCO%vars,' diffu ') + status = parallel_inq_varid(NCO%id,'diffu',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%diffu)) then + call write_log('Creating variable diffu') + status = parallel_def_var(NCO%id,'diffu',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_diffu)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'apparent diffusivity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter2/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable diffu was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! dissip -- dissipation rate (W m-3) divided by rhoi Ci + pos = index(NCO%vars,' dissip ') + status = parallel_inq_varid(NCO%id,'dissip',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%dissip)) then + call write_log('Creating variable dissip') + status = parallel_def_var(NCO%id,'dissip',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scyr)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'dissipation rate (W m-3) divided by rhoi Ci') + status = parallel_put_att(NCO%id, varid, 'units', 'deg C/yr') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable dissip was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! dissipstag -- dissipation rate (W m-3) divided by rhoi Ci + pos = index(NCO%vars,' dissipstag ') + status = parallel_inq_varid(NCO%id,'dissipstag',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%dissip)) then + call write_log('Creating variable dissipstag') + status = parallel_def_var(NCO%id,'dissipstag',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scyr)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'dissipation rate (W m-3) divided by rhoi Ci') + status = parallel_put_att(NCO%id, varid, 'units', 'deg C/yr') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable dissipstag was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! dthckdtm -- tendency of ice thickness (NOTE: Glide only) + pos = index(NCO%vars,' dthckdtm ') + status = parallel_inq_varid(NCO%id,'dthckdtm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geomderv%dthckdtm)) then + call write_log('Creating variable dthckdtm') + status = parallel_def_var(NCO%id,'dthckdtm',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_acab)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'tendency of ice thickness (NOTE: Glide only)') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable dthckdtm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! dusrfdtm -- rate of upper ice surface elevation change (NOTE: Glide only) + pos = index(NCO%vars,' dusrfdtm ') + status = parallel_inq_varid(NCO%id,'dusrfdtm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geomderv%dusrfdtm)) then + call write_log('Creating variable dusrfdtm') + status = parallel_def_var(NCO%id,'dusrfdtm',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_acab)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'rate of upper ice surface elevation change (NOTE: Glide only)') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable dusrfdtm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! dynbcmask -- 2d array of higher-order model boundary condition mask values (NOTE: Glam ONLY) + pos = index(NCO%vars,' dynbcmask ') + status = parallel_inq_varid(NCO%id,'dynbcmask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%dynbcmask)) then + call write_log('Creating variable dynbcmask') + status = parallel_def_var(NCO%id,'dynbcmask',get_xtype(outfile,NF90_INT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', '2d array of higher-order model boundary condition mask values (NOTE: Glam ONLY)') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable dynbcmask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! effecpress -- effective pressure + pos = index(NCO%vars,' effecpress ') + status = parallel_inq_varid(NCO%id,'effecpress',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%basal_physics%effecpress)) then + call write_log('Creating variable effecpress') + status = parallel_def_var(NCO%id,'effecpress',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'effective pressure') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable effecpress was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! efvs -- effective viscosity + pos = index(NCO%vars,' efvs ') + status = parallel_inq_varid(NCO%id,'efvs',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%efvs)) then + call write_log('Creating variable efvs') + status = parallel_def_var(NCO%id,'efvs',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_efvs)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'effective viscosity') + status = parallel_put_att(NCO%id, varid, 'units', 'Pascal * years') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable efvs was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! enthalpy -- specific enthalpy + pos = index(NCO%vars,' enthalpy ') + status = parallel_inq_varid(NCO%id,'enthalpy',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%enthalpy)) then + call write_log('Creating variable enthalpy') + status = parallel_def_var(NCO%id,'enthalpy',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, stagwbndlevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'specific enthalpy') + status = parallel_put_att(NCO%id, varid, 'units', 'J/m^3') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable enthalpy was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! eus -- global average sea level + pos = index(NCO%vars,' eus ') + status = parallel_inq_varid(NCO%id,'eus',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+3) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%climate%eus)) then + call write_log('Creating variable eus') + status = parallel_def_var(NCO%id,'eus',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'global average sea level') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'global_average_sea_level_change') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable eus was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! flwa -- Pre-exponential flow law parameter + pos = index(NCO%vars,' flwa ') + status = parallel_inq_varid(NCO%id,'flwa',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%flwa)) then + call write_log('Creating variable flwa') + status = parallel_def_var(NCO%id,'flwa',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_flwa)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Pre-exponential flow law parameter') + status = parallel_put_att(NCO%id, varid, 'units', 'pascal**(-n) year**(-1)') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable flwa was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! flwastag -- Pre-exponential flow law parameter + pos = index(NCO%vars,' flwastag ') + status = parallel_inq_varid(NCO%id,'flwastag',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%flwa)) then + call write_log('Creating variable flwastag') + status = parallel_def_var(NCO%id,'flwastag',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_flwa)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Pre-exponential flow law parameter') + status = parallel_put_att(NCO%id, varid, 'units', 'pascal**(-n) year**(-1)') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable flwastag was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! gravity -- gravitational acceleration + pos = index(NCO%vars,' gravity ') + status = parallel_inq_varid(NCO%id,'gravity',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(grav)) then + call write_log('Creating variable gravity') + status = parallel_def_var(NCO%id,'gravity',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'gravitational acceleration') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'gravity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/s/s') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable gravity was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! iarea -- area covered by ice + pos = index(NCO%vars,' iarea ') + status = parallel_inq_varid(NCO%id,'iarea',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%iarea)) then + call write_log('Creating variable iarea') + status = parallel_def_var(NCO%id,'iarea',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(len0*len0*1.e-6)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'area covered by ice') + status = parallel_put_att(NCO%id, varid, 'units', 'km2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable iarea was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! iareaf -- area covered by floating ice + pos = index(NCO%vars,' iareaf ') + status = parallel_inq_varid(NCO%id,'iareaf',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%iareaf)) then + call write_log('Creating variable iareaf') + status = parallel_def_var(NCO%id,'iareaf',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(len0*len0*1.e-6)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'area covered by floating ice') + status = parallel_put_att(NCO%id, varid, 'units', 'km2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable iareaf was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! iareag -- area covered by grounded ice + pos = index(NCO%vars,' iareag ') + status = parallel_inq_varid(NCO%id,'iareag',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%iareag)) then + call write_log('Creating variable iareag') + status = parallel_def_var(NCO%id,'iareag',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(len0*len0*1.e-6)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'area covered by grounded ice') + status = parallel_put_att(NCO%id, varid, 'units', 'km2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable iareag was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! ice_mask -- real-valued mask denoting ice (1) or no ice (0) + pos = index(NCO%vars,' ice_mask ') + status = parallel_inq_varid(NCO%id,'ice_mask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%ice_mask)) then + call write_log('Creating variable ice_mask') + status = parallel_def_var(NCO%id,'ice_mask',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(1.0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'real-valued mask denoting ice (1) or no ice (0)') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable ice_mask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! ice_specific_heat -- ice specific heat + pos = index(NCO%vars,' ice_specific_heat ') + status = parallel_inq_varid(NCO%id,'ice_specific_heat',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+17) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(shci)) then + call write_log('Creating variable ice_specific_heat') + status = parallel_def_var(NCO%id,'ice_specific_heat',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice specific heat') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'ice_specific_heat') + status = parallel_put_att(NCO%id, varid, 'units', 'J/kg/K') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable ice_specific_heat was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! ice_thermal_conductivity -- ice thermal conductivity + pos = index(NCO%vars,' ice_thermal_conductivity ') + status = parallel_inq_varid(NCO%id,'ice_thermal_conductivity',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+24) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(coni)) then + call write_log('Creating variable ice_thermal_conductivity') + status = parallel_def_var(NCO%id,'ice_thermal_conductivity',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice thermal conductivity') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'ice_thermal_conductivity') + status = parallel_put_att(NCO%id, varid, 'units', 'J/(K kg)') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable ice_thermal_conductivity was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! ivol -- ice volume + pos = index(NCO%vars,' ivol ') + status = parallel_inq_varid(NCO%id,'ivol',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%ivol)) then + call write_log('Creating variable ivol') + status = parallel_def_var(NCO%id,'ivol',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0*len0*len0*1.e-9)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice volume') + status = parallel_put_att(NCO%id, varid, 'units', 'km3') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable ivol was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! kinbcmask -- Mask of locations where uvel, vvel value should be held + pos = index(NCO%vars,' kinbcmask ') + status = parallel_inq_varid(NCO%id,'kinbcmask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%kinbcmask)) then + call write_log('Creating variable kinbcmask') + status = parallel_def_var(NCO%id,'kinbcmask',get_xtype(outfile,NF90_INT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Mask of locations where uvel, vvel value should be held') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable kinbcmask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! litho_temp -- lithosphere temperature + pos = index(NCO%vars,' litho_temp ') + status = parallel_inq_varid(NCO%id,'litho_temp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%lithot%temp)) then + call write_log('Creating variable litho_temp') + status = parallel_def_var(NCO%id,'litho_temp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, lithoz_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'lithosphere temperature') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable litho_temp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! lsurf -- ice lower surface elevation + pos = index(NCO%vars,' lsurf ') + status = parallel_inq_varid(NCO%id,'lsurf',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%lsrf)) then + call write_log('Creating variable lsurf') + status = parallel_def_var(NCO%id,'lsurf',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice lower surface elevation') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable lsurf was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! relx -- relaxed bedrock topography + pos = index(NCO%vars,' relx ') + status = parallel_inq_varid(NCO%id,'relx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%isostasy%relx)) then + call write_log('Creating variable relx') + status = parallel_def_var(NCO%id,'relx',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'relaxed bedrock topography') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable relx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! resid_u -- u component of residual Ax - b (NOTE: Glam only) + pos = index(NCO%vars,' resid_u ') + status = parallel_inq_varid(NCO%id,'resid_u',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%resid_u)) then + call write_log('Creating variable resid_u') + status = parallel_def_var(NCO%id,'resid_u',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_resid)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'u component of residual Ax - b (NOTE: Glam only)') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable resid_u was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! resid_v -- v component of residual Ax - b (NOTE: Glam only) + pos = index(NCO%vars,' resid_v ') + status = parallel_inq_varid(NCO%id,'resid_v',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%resid_v)) then + call write_log('Creating variable resid_v') + status = parallel_def_var(NCO%id,'resid_v',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_resid)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'v component of residual Ax - b (NOTE: Glam only)') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable resid_v was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rho_ice -- ice density + pos = index(NCO%vars,' rho_ice ') + status = parallel_inq_varid(NCO%id,'rho_ice',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(rhoi)) then + call write_log('Creating variable rho_ice') + status = parallel_def_var(NCO%id,'rho_ice',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice density') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'rho_ice') + status = parallel_put_att(NCO%id, varid, 'units', 'kg/meter3') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable rho_ice was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rho_seawater -- seawater density + pos = index(NCO%vars,' rho_seawater ') + status = parallel_inq_varid(NCO%id,'rho_seawater',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(rhoo)) then + call write_log('Creating variable rho_seawater') + status = parallel_def_var(NCO%id,'rho_seawater',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'seawater density') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'rho_seawater') + status = parallel_put_att(NCO%id, varid, 'units', 'kg/meter3') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable rho_seawater was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rhs_u -- u component of b in Ax = b + pos = index(NCO%vars,' rhs_u ') + status = parallel_inq_varid(NCO%id,'rhs_u',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%rhs_u)) then + call write_log('Creating variable rhs_u') + status = parallel_def_var(NCO%id,'rhs_u',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_resid)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'u component of b in Ax = b') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable rhs_u was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rhs_v -- v component of b in Ax = b + pos = index(NCO%vars,' rhs_v ') + status = parallel_inq_varid(NCO%id,'rhs_v',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%rhs_v)) then + call write_log('Creating variable rhs_v') + status = parallel_def_var(NCO%id,'rhs_v',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_resid)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'v component of b in Ax = b') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable rhs_v was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! seconds_per_year -- seconds per year + pos = index(NCO%vars,' seconds_per_year ') + status = parallel_inq_varid(NCO%id,'seconds_per_year',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+16) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(scyr)) then + call write_log('Creating variable seconds_per_year') + status = parallel_def_var(NCO%id,'seconds_per_year',get_xtype(outfile,NF90_FLOAT),(/time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',1.0) + status = parallel_put_att(NCO%id, varid, 'long_name', 'seconds per year') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'seconds_per_year') + status = parallel_put_att(NCO%id, varid, 'units', 's/yr') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable seconds_per_year was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! soft -- bed softness parameter + pos = index(NCO%vars,' soft ') + status = parallel_inq_varid(NCO%id,'soft',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%bed_softness)) then + call write_log('Creating variable soft') + status = parallel_def_var(NCO%id,'soft',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_btrc)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'bed softness parameter') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/pascal/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable soft was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! stagthk -- staggered ice thickness + pos = index(NCO%vars,' stagthk ') + status = parallel_inq_varid(NCO%id,'stagthk',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geomderv%stagthck)) then + call write_log('Creating variable stagthk') + status = parallel_def_var(NCO%id,'stagthk',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'staggered ice thickness') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'stag_land_ice_thickness') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable stagthk was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! surftemp -- annual mean surface temperature + pos = index(NCO%vars,' surftemp ') + status = parallel_inq_varid(NCO%id,'surftemp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%climate%artm)) then + call write_log('Creating variable surftemp') + status = parallel_def_var(NCO%id,'surftemp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'annual mean surface temperature') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_temperature') + status = parallel_put_att(NCO%id, varid, 'cell_methods', 'time: mean') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable surftemp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_eff -- effective stress + pos = index(NCO%vars,' tau_eff ') + status = parallel_inq_varid(NCO%id,'tau_eff',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%scalar)) then + call write_log('Creating variable tau_eff') + status = parallel_def_var(NCO%id,'tau_eff',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'effective stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_eff was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_xx -- x component of horiz. normal stress + pos = index(NCO%vars,' tau_xx ') + status = parallel_inq_varid(NCO%id,'tau_xx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%xx)) then + call write_log('Creating variable tau_xx') + status = parallel_def_var(NCO%id,'tau_xx',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'x component of horiz. normal stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_xx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_xy -- horiz. shear stress + pos = index(NCO%vars,' tau_xy ') + status = parallel_inq_varid(NCO%id,'tau_xy',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%xy)) then + call write_log('Creating variable tau_xy') + status = parallel_def_var(NCO%id,'tau_xy',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'horiz. shear stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_xy was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_xz -- X component vertical shear stress + pos = index(NCO%vars,' tau_xz ') + status = parallel_inq_varid(NCO%id,'tau_xz',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%xz)) then + call write_log('Creating variable tau_xz') + status = parallel_def_var(NCO%id,'tau_xz',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'X component vertical shear stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_xz was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_yy -- y component of horiz. normal stress + pos = index(NCO%vars,' tau_yy ') + status = parallel_inq_varid(NCO%id,'tau_yy',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%yy)) then + call write_log('Creating variable tau_yy') + status = parallel_def_var(NCO%id,'tau_yy',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'y component of horiz. normal stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_yy was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tau_yz -- Y component vertical shear stress + pos = index(NCO%vars,' tau_yz ') + status = parallel_inq_varid(NCO%id,'tau_yz',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%stress%tau%yz)) then + call write_log('Creating variable tau_yz') + status = parallel_def_var(NCO%id,'tau_yz',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Y component vertical shear stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tau_yz was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tauf -- higher-order basal yield stress + pos = index(NCO%vars,' tauf ') + status = parallel_inq_varid(NCO%id,'tauf',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%basalproc%mintauf)) then + call write_log('Creating variable tauf') + status = parallel_def_var(NCO%id,'tauf',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_tau)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'higher-order basal yield stress') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tauf was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! taux -- basal shear stress in x direction (NOTE: Glide only) + pos = index(NCO%vars,' taux ') + status = parallel_inq_varid(NCO%id,'taux',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%tau_x)) then + call write_log('Creating variable taux') + status = parallel_def_var(NCO%id,'taux',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(1e-3*thk0*thk0/len0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal shear stress in x direction (NOTE: Glide only)') + status = parallel_put_att(NCO%id, varid, 'units', 'kilopascal') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable taux was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tauy -- basal shear stress in y direction + pos = index(NCO%vars,' tauy ') + status = parallel_inq_varid(NCO%id,'tauy',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%tau_y)) then + call write_log('Creating variable tauy') + status = parallel_def_var(NCO%id,'tauy',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(1e-3*thk0*thk0/len0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal shear stress in y direction') + status = parallel_put_att(NCO%id, varid, 'units', 'kilopascal') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable tauy was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! temp -- ice temperature + pos = index(NCO%vars,' temp ') + status = parallel_inq_varid(NCO%id,'temp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%temp)) then + call write_log('Creating variable temp') + status = parallel_def_var(NCO%id,'temp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice temperature') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_temperature') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable temp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! tempstag -- ice temperature on staggered vertical levels with boundaries + pos = index(NCO%vars,' tempstag ') + status = parallel_inq_varid(NCO%id,'tempstag',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+8) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%temp)) then + call write_log('Creating variable tempstag') + status = parallel_def_var(NCO%id,'tempstag',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, stagwbndlevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice temperature on staggered vertical levels with boundaries') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_temperature_stag') + status = parallel_put_att(NCO%id, varid, 'units', 'degree_Celsius') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable tempstag was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! thk -- ice thickness + pos = index(NCO%vars,' thk ') + status = parallel_inq_varid(NCO%id,'thk',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+3) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%thck)) then + call write_log('Creating variable thk') + status = parallel_def_var(NCO%id,'thk',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice thickness') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_thickness') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable thk was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! thkmask -- mask + pos = index(NCO%vars,' thkmask ') + status = parallel_inq_varid(NCO%id,'thkmask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%thkmask)) then + call write_log('Creating variable thkmask') + status = parallel_def_var(NCO%id,'thkmask',get_xtype(outfile,NF90_INT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'mask') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable thkmask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! topg -- bedrock topography + pos = index(NCO%vars,' topg ') + status = parallel_inq_varid(NCO%id,'topg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%topg)) then + call write_log('Creating variable topg') + status = parallel_def_var(NCO%id,'topg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'bedrock topography') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'bedrock_altitude') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable topg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! ubas -- basal slip velocity in x direction + pos = index(NCO%vars,' ubas ') + status = parallel_inq_varid(NCO%id,'ubas',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%ubas)) then + call write_log('Creating variable ubas') + status = parallel_def_var(NCO%id,'ubas',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal slip velocity in x direction') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_basal_x_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable ubas was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! uflx -- flux in x direction (NOTE: Glide and Glam only) + pos = index(NCO%vars,' uflx ') + status = parallel_inq_varid(NCO%id,'uflx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%uflx)) then + call write_log('Creating variable uflx') + status = parallel_def_var(NCO%id,'uflx',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uflx)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'flux in x direction (NOTE: Glide and Glam only)') + status = parallel_put_att(NCO%id, varid, 'units', 'meter2/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable uflx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! unstagbeta -- higher-order bed stress coefficient on the unstaggered grid (NOTE: this will overwrite beta if both are input) + pos = index(NCO%vars,' unstagbeta ') + status = parallel_inq_varid(NCO%id,'unstagbeta',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%unstagbeta)) then + call write_log('Creating variable unstagbeta') + status = parallel_def_var(NCO%id,'unstagbeta',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_beta)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'higher-order bed stress coefficient on the unstaggered grid (NOTE: this will overwrite beta if both are input)') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa yr/m') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable unstagbeta was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! usurf -- ice upper surface elevation + pos = index(NCO%vars,' usurf ') + status = parallel_inq_varid(NCO%id,'usurf',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%geometry%usrf)) then + call write_log('Creating variable usurf') + status = parallel_def_var(NCO%id,'usurf',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(thk0)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice upper surface elevation') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_altitude') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable usurf was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! uvel -- ice velocity in x direction + pos = index(NCO%vars,' uvel ') + status = parallel_inq_varid(NCO%id,'uvel',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%uvel)) then + call write_log('Creating variable uvel') + status = parallel_def_var(NCO%id,'uvel',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice velocity in x direction') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_x_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable uvel was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! uvel_extend -- ice velocity in x direction (extended grid) + pos = index(NCO%vars,' uvel_extend ') + status = parallel_inq_varid(NCO%id,'uvel_extend',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+11) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%uvel_extend)) then + call write_log('Creating variable uvel_extend') + status = parallel_def_var(NCO%id,'uvel_extend',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice velocity in x direction (extended grid)') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_x_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable uvel_extend was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! vbas -- basal slip velocity in y direction + pos = index(NCO%vars,' vbas ') + status = parallel_inq_varid(NCO%id,'vbas',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%vbas)) then + call write_log('Creating variable vbas') + status = parallel_def_var(NCO%id,'vbas',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'basal slip velocity in y direction') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_basal_y_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable vbas was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! velnorm -- Horizontal ice velocity magnitude + pos = index(NCO%vars,' velnorm ') + status = parallel_inq_varid(NCO%id,'velnorm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%velnorm)) then + call write_log('Creating variable velnorm') + status = parallel_def_var(NCO%id,'velnorm',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Horizontal ice velocity magnitude') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable velnorm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! vflx -- flux in x direction (NOTE: Glide and Glam only) + pos = index(NCO%vars,' vflx ') + status = parallel_inq_varid(NCO%id,'vflx',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%vflx)) then + call write_log('Creating variable vflx') + status = parallel_def_var(NCO%id,'vflx',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uflx)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'flux in x direction (NOTE: Glide and Glam only)') + status = parallel_put_att(NCO%id, varid, 'units', 'meter2/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable vflx was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! vvel -- ice velocity in y direction + pos = index(NCO%vars,' vvel ') + status = parallel_inq_varid(NCO%id,'vvel',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%vvel)) then + call write_log('Creating variable vvel') + status = parallel_def_var(NCO%id,'vvel',get_xtype(outfile,NF90_FLOAT),(/x0_dimid, y0_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice velocity in y direction') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_y_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable vvel was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! vvel_extend -- ice velocity in y direction (extended grid) + pos = index(NCO%vars,' vvel_extend ') + status = parallel_inq_varid(NCO%id,'vvel_extend',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+11) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%vvel_extend)) then + call write_log('Creating variable vvel_extend') + status = parallel_def_var(NCO%id,'vvel_extend',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_uvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ice velocity in y direction (extended grid)') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_y_velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + end if + else + call write_log('Variable vvel_extend was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! waterfrac -- internal water fraction + pos = index(NCO%vars,' waterfrac ') + status = parallel_inq_varid(NCO%id,'waterfrac',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%temper%waterfrac)) then + call write_log('Creating variable waterfrac') + status = parallel_def_var(NCO%id,'waterfrac',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, staglevel_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'internal water fraction') + status = parallel_put_att(NCO%id, varid, 'units', 'unitless [0,1]') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable waterfrac was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! wgrd -- Vertical grid velocity + pos = index(NCO%vars,' wgrd ') + status = parallel_inq_varid(NCO%id,'wgrd',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%wgrd)) then + call write_log('Creating variable wgrd') + status = parallel_def_var(NCO%id,'wgrd',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_wvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Vertical grid velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable wgrd was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! wvel -- vertical ice velocity + pos = index(NCO%vars,' wvel ') + status = parallel_inq_varid(NCO%id,'wvel',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%wvel)) then + call write_log('Creating variable wvel') + status = parallel_def_var(NCO%id,'wvel',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_wvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'vertical ice velocity') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable wvel was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! wvel_ho -- vertical ice velocity relative to ice sheet base from higher-order model (NOTE: Glam only) + pos = index(NCO%vars,' wvel_ho ') + status = parallel_inq_varid(NCO%id,'wvel_ho',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%velocity%wvel_ho)) then + call write_log('Creating variable wvel_ho') + status = parallel_def_var(NCO%id,'wvel_ho',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, level_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'scale_factor',(scale_wvel)) + status = parallel_put_att(NCO%id, varid, 'long_name', 'vertical ice velocity relative to ice sheet base from higher-order model (NOTE: Glam only)') + status = parallel_put_att(NCO%id, varid, 'units', 'meter/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable wvel_ho was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + end subroutine glide_io_create + + subroutine glide_io_write(outfile,data) + use parallel + use glide_types + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + status = parallel_inq_varid(NCO%id,'acab',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%climate%acab, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'adv_cfl_dt',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%numerics%adv_cfl_dt, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'artm',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%climate%artm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'beta',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%beta, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'bfricflx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%bfricflx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'bheatflx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%bheatflx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'bmlt',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%bmlt, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'btemp',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%temp(data%general%upn,1:data%general%ewn,1:data%general%nsn), (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'btractx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%stress%btractx(:,:), (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'btracty',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%stress%btracty(:,:), (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'btrc',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%btrc, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'bwat',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%bwat, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'bwatflx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%temper%bwatflx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'calving',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%climate%calving, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'diff_cfl_dt',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%numerics%diff_cfl_dt, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'diffu',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%diffu, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'dissip',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%temper%dissip(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'dissipstag',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%temper%dissip(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'dthckdtm',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geomderv%dthckdtm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'dusrfdtm',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geomderv%dusrfdtm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'dynbcmask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%dynbcmask, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'effecpress',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%basal_physics%effecpress, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'efvs',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%efvs(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'enthalpy',varid) + if (status .eq. nf90_noerr) then + do up=0,NCO%nstagwbndlevel + status = distributed_put_var(NCO%id, varid, & + data%temper%enthalpy(up,:,:), (/1,1,up+1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'eus',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%climate%eus, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'flwa',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%temper%flwa(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'flwastag',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%temper%flwa(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'gravity',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + grav, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'iarea',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%iarea, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'iareaf',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%iareaf, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'iareag',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%iareag, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'ice_mask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%ice_mask, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'ice_specific_heat',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + shci, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'ice_thermal_conductivity',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + coni, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'ivol',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%ivol, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'kinbcmask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%kinbcmask(:,:), (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'litho_temp',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%lithot%temp, (/1,1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'lsurf',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%lsrf, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'relx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%isostasy%relx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'resid_u',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%resid_u(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'resid_v',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%resid_v(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'rho_ice',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + rhoi, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rho_seawater',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + rhoo, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rhs_u',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%rhs_u(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'rhs_v',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%rhs_v(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'seconds_per_year',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + scyr, (/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'soft',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%bed_softness, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'stagthk',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geomderv%stagthck, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'surftemp',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%climate%artm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'tau_eff',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%scalar(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tau_xx',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%xx(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tau_xy',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%xy(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tau_xz',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%xz(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tau_yy',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%yy(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tau_yz',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%stress%tau%yz(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tauf',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%basalproc%mintauf, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'taux',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%tau_x, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'tauy',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%tau_y, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'temp',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'tempstag',varid) + if (status .eq. nf90_noerr) then + do up=0,NCO%nstagwbndlevel + status = distributed_put_var(NCO%id, varid, & + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn), (/1,1,up+1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'thk',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%thck, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'thkmask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%thkmask, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'topg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%topg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'ubas',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%ubas, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'uflx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%uflx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'unstagbeta',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%unstagbeta, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'usurf',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%geometry%usrf, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'uvel',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%uvel(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'uvel_extend',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%uvel_extend(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'vbas',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%vbas, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'velnorm',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%velnorm(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'vflx',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%velocity%vflx, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'vvel',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%vvel(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'vvel_extend',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%vvel_extend(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'waterfrac',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nstaglevel + status = distributed_put_var(NCO%id, varid, & + data%temper%waterfrac(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'wgrd',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%wgrd(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'wvel',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%wvel(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + status = parallel_inq_varid(NCO%id,'wvel_ho',varid) + if (status .eq. nf90_noerr) then + do up=1,NCO%nlevel + status = distributed_put_var(NCO%id, varid, & + data%velocity%wvel_ho(up,:,:), (/1,1,up,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end do + end if + + end subroutine glide_io_write + + + subroutine glide_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to glide restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine glide_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in glide_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine glide_io_readall(data, model, filetype) + ! read from netCDF file + use glide_types + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call glide_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine glide_io_readall + + + subroutine glide_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(glide_global_type) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call glide_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine glide_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine glide_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + status = parallel_inq_varid(NCI%id,'x1',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%general%x1)) then + call write_log(' Loading x1') + status = distributed_get_var(NCI%id, varid, & + data%general%x1, (/1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling x1",GM_DIAGNOSTIC) + data%general%x1 = data%general%x1*scaling_factor + end if + else + call write_log('Variable x1 was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'y1',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%general%y1)) then + call write_log(' Loading y1') + status = distributed_get_var(NCI%id, varid, & + data%general%y1, (/1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling y1",GM_DIAGNOSTIC) + data%general%y1 = data%general%y1*scaling_factor + end if + else + call write_log('Variable y1 was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'acab',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%climate%acab)) then + call write_log(' Loading acab') + status = distributed_get_var(NCI%id, varid, & + data%climate%acab, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_acab) + else + scaling_factor = scaling_factor/(scale_acab) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling acab",GM_DIAGNOSTIC) + data%climate%acab = data%climate%acab*scaling_factor + end if + else + call write_log('Variable acab was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'artm',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%climate%artm)) then + call write_log(' Loading artm') + status = distributed_get_var(NCI%id, varid, & + data%climate%artm, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling artm",GM_DIAGNOSTIC) + data%climate%artm = data%climate%artm*scaling_factor + end if + else + call write_log('Variable artm was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'beta',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%beta)) then + call write_log(' Loading beta') + status = distributed_get_var(NCI%id, varid, & + data%velocity%beta, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_beta) + else + scaling_factor = scaling_factor/(scale_beta) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling beta",GM_DIAGNOSTIC) + data%velocity%beta = data%velocity%beta*scaling_factor + end if + else + call write_log('Variable beta was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'bfricflx',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%bfricflx)) then + call write_log(' Loading bfricflx') + status = distributed_get_var(NCI%id, varid, & + data%temper%bfricflx, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(1.0) + else + scaling_factor = scaling_factor/(1.0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling bfricflx",GM_DIAGNOSTIC) + data%temper%bfricflx = data%temper%bfricflx*scaling_factor + end if + else + call write_log('Variable bfricflx was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'bheatflx',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%bheatflx)) then + call write_log(' Loading bheatflx') + status = distributed_get_var(NCI%id, varid, & + data%temper%bheatflx, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_bflx) + else + scaling_factor = scaling_factor/(scale_bflx) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling bheatflx",GM_DIAGNOSTIC) + data%temper%bheatflx = data%temper%bheatflx*scaling_factor + end if + else + call write_log('Variable bheatflx was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'bmlt',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%bmlt)) then + call write_log(' Loading bmlt') + status = distributed_get_var(NCI%id, varid, & + data%temper%bmlt, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_acab) + else + scaling_factor = scaling_factor/(scale_acab) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling bmlt",GM_DIAGNOSTIC) + data%temper%bmlt = data%temper%bmlt*scaling_factor + end if + else + call write_log('Variable bmlt was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'bwat',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%bwat)) then + call write_log(' Loading bwat') + status = distributed_get_var(NCI%id, varid, & + data%temper%bwat, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(thk0) + else + scaling_factor = scaling_factor/(thk0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling bwat",GM_DIAGNOSTIC) + data%temper%bwat = data%temper%bwat*scaling_factor + end if + else + call write_log('Variable bwat was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'dissip',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%dissip)) then + call write_log(' Loading dissip') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%temper%dissip(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scyr) + else + scaling_factor = scaling_factor/(scyr) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling dissip",GM_DIAGNOSTIC) + data%temper%dissip(up,:,:) = data%temper%dissip(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable dissip was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'dissipstag',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%dissip)) then + call write_log(' Loading dissipstag') + do up=1,NCI%nstaglevel + status = distributed_get_var(NCI%id, varid, & + data%temper%dissip(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scyr) + else + scaling_factor = scaling_factor/(scyr) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling dissipstag",GM_DIAGNOSTIC) + data%temper%dissip(up,:,:) = data%temper%dissip(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable dissipstag was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'effecpress',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%basal_physics%effecpress)) then + call write_log(' Loading effecpress') + status = distributed_get_var(NCI%id, varid, & + data%basal_physics%effecpress, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling effecpress",GM_DIAGNOSTIC) + data%basal_physics%effecpress = data%basal_physics%effecpress*scaling_factor + end if + else + call write_log('Variable effecpress was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'flwa',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%flwa)) then + call write_log(' Loading flwa') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%temper%flwa(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_flwa) + else + scaling_factor = scaling_factor/(scale_flwa) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling flwa",GM_DIAGNOSTIC) + data%temper%flwa(up,:,:) = data%temper%flwa(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable flwa was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'flwastag',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%flwa)) then + call write_log(' Loading flwastag') + do up=1,NCI%nstaglevel + status = distributed_get_var(NCI%id, varid, & + data%temper%flwa(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_flwa) + else + scaling_factor = scaling_factor/(scale_flwa) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling flwastag",GM_DIAGNOSTIC) + data%temper%flwa(up,:,:) = data%temper%flwa(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable flwastag was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'kinbcmask',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%kinbcmask)) then + call write_log(' Loading kinbcmask') + status = distributed_get_var(NCI%id, varid, & + data%velocity%kinbcmask(:,:), (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling kinbcmask",GM_DIAGNOSTIC) + data%velocity%kinbcmask(:,:) = data%velocity%kinbcmask(:,:)*scaling_factor + end if + else + call write_log('Variable kinbcmask was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'litho_temp',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%lithot%temp)) then + call write_log(' Loading litho_temp') + status = distributed_get_var(NCI%id, varid, & + data%lithot%temp, (/1,1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling litho_temp",GM_DIAGNOSTIC) + data%lithot%temp = data%lithot%temp*scaling_factor + end if + else + call write_log('Variable litho_temp was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'relx',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%isostasy%relx)) then + call write_log(' Loading relx') + status = distributed_get_var(NCI%id, varid, & + data%isostasy%relx, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(thk0) + else + scaling_factor = scaling_factor/(thk0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling relx",GM_DIAGNOSTIC) + data%isostasy%relx = data%isostasy%relx*scaling_factor + end if + else + call write_log('Variable relx was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'soft',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%bed_softness)) then + call write_log(' Loading soft') + status = distributed_get_var(NCI%id, varid, & + data%velocity%bed_softness, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_btrc) + else + scaling_factor = scaling_factor/(scale_btrc) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling soft",GM_DIAGNOSTIC) + data%velocity%bed_softness = data%velocity%bed_softness*scaling_factor + end if + else + call write_log('Variable soft was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'surftemp',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%climate%artm)) then + call write_log(' Loading surftemp') + status = distributed_get_var(NCI%id, varid, & + data%climate%artm, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling surftemp",GM_DIAGNOSTIC) + data%climate%artm = data%climate%artm*scaling_factor + end if + else + call write_log('Variable surftemp was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'tauf',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%basalproc%mintauf)) then + call write_log(' Loading tauf') + status = distributed_get_var(NCI%id, varid, & + data%basalproc%mintauf, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_tau) + else + scaling_factor = scaling_factor/(scale_tau) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling tauf",GM_DIAGNOSTIC) + data%basalproc%mintauf = data%basalproc%mintauf*scaling_factor + end if + else + call write_log('Variable tauf was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'temp',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%temp)) then + call write_log(' Loading temp') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling temp",GM_DIAGNOSTIC) + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn) = data%temper%temp(up,1:data%general%ewn,1:data%general%nsn)*scaling_factor + end if + end do + else + call write_log('Variable temp was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'tempstag',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%temp)) then + call write_log(' Loading tempstag') + do up=0,NCI%nstagwbndlevel + status = distributed_get_var(NCI%id, varid, & + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn), (/1,1,up+1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling tempstag",GM_DIAGNOSTIC) + data%temper%temp(up,1:data%general%ewn,1:data%general%nsn) = data%temper%temp(up,1:data%general%ewn,1:data%general%nsn)*scaling_factor + end if + end do + else + call write_log('Variable tempstag was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'thk',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%geometry%thck)) then + call write_log(' Loading thk') + status = distributed_get_var(NCI%id, varid, & + data%geometry%thck, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(thk0) + else + scaling_factor = scaling_factor/(thk0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling thk",GM_DIAGNOSTIC) + data%geometry%thck = data%geometry%thck*scaling_factor + end if + else + call write_log('Variable thk was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'thkmask',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%geometry%thkmask)) then + call write_log(' Loading thkmask') + status = distributed_get_var(NCI%id, varid, & + data%geometry%thkmask, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling thkmask",GM_DIAGNOSTIC) + data%geometry%thkmask = data%geometry%thkmask*scaling_factor + end if + else + call write_log('Variable thkmask was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'topg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%geometry%topg)) then + call write_log(' Loading topg') + status = distributed_get_var(NCI%id, varid, & + data%geometry%topg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(thk0) + else + scaling_factor = scaling_factor/(thk0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling topg",GM_DIAGNOSTIC) + data%geometry%topg = data%geometry%topg*scaling_factor + end if + else + call write_log('Variable topg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'ubas',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%ubas)) then + call write_log(' Loading ubas') + status = distributed_get_var(NCI%id, varid, & + data%velocity%ubas, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_uvel) + else + scaling_factor = scaling_factor/(scale_uvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling ubas",GM_DIAGNOSTIC) + data%velocity%ubas = data%velocity%ubas*scaling_factor + end if + else + call write_log('Variable ubas was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'unstagbeta',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%unstagbeta)) then + call write_log(' Loading unstagbeta') + status = distributed_get_var(NCI%id, varid, & + data%velocity%unstagbeta, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_beta) + else + scaling_factor = scaling_factor/(scale_beta) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling unstagbeta",GM_DIAGNOSTIC) + data%velocity%unstagbeta = data%velocity%unstagbeta*scaling_factor + end if + else + call write_log('Variable unstagbeta was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'usurf',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%geometry%usrf)) then + call write_log(' Loading usurf') + status = distributed_get_var(NCI%id, varid, & + data%geometry%usrf, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(thk0) + else + scaling_factor = scaling_factor/(thk0) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling usurf",GM_DIAGNOSTIC) + data%geometry%usrf = data%geometry%usrf*scaling_factor + end if + else + call write_log('Variable usurf was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'uvel',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%uvel)) then + call write_log(' Loading uvel') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%velocity%uvel(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_uvel) + else + scaling_factor = scaling_factor/(scale_uvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling uvel",GM_DIAGNOSTIC) + data%velocity%uvel(up,:,:) = data%velocity%uvel(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable uvel was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'vbas',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%vbas)) then + call write_log(' Loading vbas') + status = distributed_get_var(NCI%id, varid, & + data%velocity%vbas, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_uvel) + else + scaling_factor = scaling_factor/(scale_uvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling vbas",GM_DIAGNOSTIC) + data%velocity%vbas = data%velocity%vbas*scaling_factor + end if + else + call write_log('Variable vbas was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'vvel',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%vvel)) then + call write_log(' Loading vvel') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%velocity%vvel(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_uvel) + else + scaling_factor = scaling_factor/(scale_uvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling vvel",GM_DIAGNOSTIC) + data%velocity%vvel(up,:,:) = data%velocity%vvel(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable vvel was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'waterfrac',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%temper%waterfrac)) then + call write_log(' Loading waterfrac') + do up=1,NCI%nstaglevel + status = distributed_get_var(NCI%id, varid, & + data%temper%waterfrac(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling waterfrac",GM_DIAGNOSTIC) + data%temper%waterfrac(up,:,:) = data%temper%waterfrac(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable waterfrac was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'wgrd',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%wgrd)) then + call write_log(' Loading wgrd') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%velocity%wgrd(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_wvel) + else + scaling_factor = scaling_factor/(scale_wvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling wgrd",GM_DIAGNOSTIC) + data%velocity%wgrd(up,:,:) = data%velocity%wgrd(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable wgrd was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'wvel',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%wvel)) then + call write_log(' Loading wvel') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%velocity%wvel(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_wvel) + else + scaling_factor = scaling_factor/(scale_wvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling wvel",GM_DIAGNOSTIC) + data%velocity%wvel(up,:,:) = data%velocity%wvel(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable wvel was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'wvel_ho',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%velocity%wvel_ho)) then + call write_log(' Loading wvel_ho') + do up=1,NCI%nlevel + status = distributed_get_var(NCI%id, varid, & + data%velocity%wvel_ho(up,:,:), (/1,1,up,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0/(scale_wvel) + else + scaling_factor = scaling_factor/(scale_wvel) + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling wvel_ho",GM_DIAGNOSTIC) + data%velocity%wvel_ho(up,:,:) = data%velocity%wvel_ho(up,:,:)*scaling_factor + end if + end do + else + call write_log('Variable wvel_ho was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + end subroutine glide_io_read + + subroutine glide_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glide_types + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glide_global_type), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + status = parallel_inq_dimid(NCI%id,'level',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size level does not match: ', & + model%general%upn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'lithoz',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%lithot%nlayer) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size lithoz does not match: ', & + model%lithot%nlayer + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'staglevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size staglevel does not match: ', & + model%general%upn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'stagwbndlevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn+1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size stagwbndlevel does not match: ', & + model%general%upn+1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x0 does not match: ', & + global_ewn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x1 does not match: ', & + global_ewn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y0 does not match: ', & + global_nsn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y1 does not match: ', & + global_nsn + call write_log(message,GM_FATAL) + end if + end if + end subroutine glide_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine glide_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use glide_types + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glide_global_type) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + end subroutine glide_avg_accumulate + + subroutine glide_avg_reset(outfile,data) + use parallel + use glide_types + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + end subroutine glide_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + subroutine glide_get_acab(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_acab)*(data%climate%acab) + end subroutine glide_get_acab + + subroutine glide_set_acab(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%climate%acab = inarray/(scale_acab) + end subroutine glide_set_acab + + subroutine glide_get_adv_cfl_dt(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = data%numerics%adv_cfl_dt + end subroutine glide_get_adv_cfl_dt + + subroutine glide_set_adv_cfl_dt(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%numerics%adv_cfl_dt = inarray + end subroutine glide_set_adv_cfl_dt + + subroutine glide_get_artm(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%climate%artm + end subroutine glide_get_artm + + subroutine glide_set_artm(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%climate%artm = inarray + end subroutine glide_set_artm + + subroutine glide_get_beta(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_beta)*(data%velocity%beta) + end subroutine glide_get_beta + + subroutine glide_set_beta(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%beta = inarray/(scale_beta) + end subroutine glide_set_beta + + subroutine glide_get_bfricflx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (1.0)*(data%temper%bfricflx) + end subroutine glide_get_bfricflx + + subroutine glide_set_bfricflx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%temper%bfricflx = inarray/(1.0) + end subroutine glide_set_bfricflx + + subroutine glide_get_bheatflx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_bflx)*(data%temper%bheatflx) + end subroutine glide_get_bheatflx + + subroutine glide_set_bheatflx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%temper%bheatflx = inarray/(scale_bflx) + end subroutine glide_set_bheatflx + + subroutine glide_get_bmlt(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_acab)*(data%temper%bmlt) + end subroutine glide_get_bmlt + + subroutine glide_set_bmlt(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%temper%bmlt = inarray/(scale_acab) + end subroutine glide_set_bmlt + + subroutine glide_get_btemp(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%temper%temp(data%general%upn,1:data%general%ewn,1:data%general%nsn) + end subroutine glide_get_btemp + + subroutine glide_get_btractx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_tau)*(data%stress%btractx(:,:)) + end subroutine glide_get_btractx + + subroutine glide_set_btractx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%stress%btractx(:,:) = inarray/(scale_tau) + end subroutine glide_set_btractx + + subroutine glide_get_btracty(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_tau)*(data%stress%btracty(:,:)) + end subroutine glide_get_btracty + + subroutine glide_set_btracty(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%stress%btracty(:,:) = inarray/(scale_tau) + end subroutine glide_set_btracty + + subroutine glide_get_btrc(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_btrc)*(data%velocity%btrc) + end subroutine glide_get_btrc + + subroutine glide_set_btrc(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%btrc = inarray/(scale_btrc) + end subroutine glide_set_btrc + + subroutine glide_get_bwat(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%temper%bwat) + end subroutine glide_get_bwat + + subroutine glide_set_bwat(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%temper%bwat = inarray/(thk0) + end subroutine glide_set_bwat + + subroutine glide_get_bwatflx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%temper%bwatflx) + end subroutine glide_get_bwatflx + + subroutine glide_set_bwatflx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%temper%bwatflx = inarray/(thk0) + end subroutine glide_set_bwatflx + + subroutine glide_get_calving(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%climate%calving) + end subroutine glide_get_calving + + subroutine glide_set_calving(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%climate%calving = inarray/(thk0) + end subroutine glide_set_calving + + subroutine glide_get_diff_cfl_dt(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = data%numerics%diff_cfl_dt + end subroutine glide_get_diff_cfl_dt + + subroutine glide_set_diff_cfl_dt(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%numerics%diff_cfl_dt = inarray + end subroutine glide_set_diff_cfl_dt + + subroutine glide_get_diffu(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_diffu)*(data%velocity%diffu) + end subroutine glide_get_diffu + + subroutine glide_set_diffu(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%diffu = inarray/(scale_diffu) + end subroutine glide_set_diffu + + subroutine glide_get_dthckdtm(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_acab)*(data%geomderv%dthckdtm) + end subroutine glide_get_dthckdtm + + subroutine glide_set_dthckdtm(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geomderv%dthckdtm = inarray/(scale_acab) + end subroutine glide_set_dthckdtm + + subroutine glide_get_dusrfdtm(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_acab)*(data%geomderv%dusrfdtm) + end subroutine glide_get_dusrfdtm + + subroutine glide_set_dusrfdtm(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geomderv%dusrfdtm = inarray/(scale_acab) + end subroutine glide_set_dusrfdtm + + subroutine glide_get_dynbcmask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(out) :: outarray + + outarray = data%velocity%dynbcmask + end subroutine glide_get_dynbcmask + + subroutine glide_set_dynbcmask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(in) :: inarray + + data%velocity%dynbcmask = inarray + end subroutine glide_set_dynbcmask + + subroutine glide_get_effecpress(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%basal_physics%effecpress + end subroutine glide_get_effecpress + + subroutine glide_set_effecpress(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%basal_physics%effecpress = inarray + end subroutine glide_set_effecpress + + subroutine glide_get_eus(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = (thk0)*(data%climate%eus) + end subroutine glide_get_eus + + subroutine glide_set_eus(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%climate%eus = inarray/(thk0) + end subroutine glide_set_eus + + subroutine glide_get_gravity(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = grav + end subroutine glide_get_gravity + + subroutine glide_set_gravity(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_gravity + + subroutine glide_get_iarea(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = (len0*len0*1.e-6)*(data%geometry%iarea) + end subroutine glide_get_iarea + + subroutine glide_set_iarea(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%geometry%iarea = inarray/(len0*len0*1.e-6) + end subroutine glide_set_iarea + + subroutine glide_get_iareaf(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = (len0*len0*1.e-6)*(data%geometry%iareaf) + end subroutine glide_get_iareaf + + subroutine glide_set_iareaf(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%geometry%iareaf = inarray/(len0*len0*1.e-6) + end subroutine glide_set_iareaf + + subroutine glide_get_iareag(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = (len0*len0*1.e-6)*(data%geometry%iareag) + end subroutine glide_get_iareag + + subroutine glide_set_iareag(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%geometry%iareag = inarray/(len0*len0*1.e-6) + end subroutine glide_set_iareag + + subroutine glide_get_ice_mask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (1.0)*(data%geometry%ice_mask) + end subroutine glide_get_ice_mask + + subroutine glide_set_ice_mask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geometry%ice_mask = inarray/(1.0) + end subroutine glide_set_ice_mask + + subroutine glide_get_ice_specific_heat(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = shci + end subroutine glide_get_ice_specific_heat + + subroutine glide_set_ice_specific_heat(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_ice_specific_heat + + subroutine glide_get_ice_thermal_conductivity(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = coni + end subroutine glide_get_ice_thermal_conductivity + + subroutine glide_set_ice_thermal_conductivity(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_ice_thermal_conductivity + + subroutine glide_get_ivol(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = (thk0*len0*len0*1.e-9)*(data%geometry%ivol) + end subroutine glide_get_ivol + + subroutine glide_set_ivol(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + + data%geometry%ivol = inarray/(thk0*len0*len0*1.e-9) + end subroutine glide_set_ivol + + subroutine glide_get_kinbcmask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(out) :: outarray + + outarray = data%velocity%kinbcmask(:,:) + end subroutine glide_get_kinbcmask + + subroutine glide_set_kinbcmask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(in) :: inarray + + data%velocity%kinbcmask(:,:) = inarray + end subroutine glide_set_kinbcmask + + subroutine glide_get_lsurf(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%geometry%lsrf) + end subroutine glide_get_lsurf + + subroutine glide_set_lsurf(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geometry%lsrf = inarray/(thk0) + end subroutine glide_set_lsurf + + subroutine glide_get_relx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%isostasy%relx) + end subroutine glide_get_relx + + subroutine glide_set_relx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%isostasy%relx = inarray/(thk0) + end subroutine glide_set_relx + + subroutine glide_get_rho_ice(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = rhoi + end subroutine glide_get_rho_ice + + subroutine glide_set_rho_ice(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_rho_ice + + subroutine glide_get_rho_seawater(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = rhoo + end subroutine glide_get_rho_seawater + + subroutine glide_set_rho_seawater(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_rho_seawater + + subroutine glide_get_seconds_per_year(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(out) :: outarray + + outarray = scyr + end subroutine glide_get_seconds_per_year + + subroutine glide_set_seconds_per_year(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), intent(in) :: inarray + +! no rescaling here + end subroutine glide_set_seconds_per_year + + subroutine glide_get_soft(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_btrc)*(data%velocity%bed_softness) + end subroutine glide_get_soft + + subroutine glide_set_soft(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%bed_softness = inarray/(scale_btrc) + end subroutine glide_set_soft + + subroutine glide_get_stagthk(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%geomderv%stagthck) + end subroutine glide_get_stagthk + + subroutine glide_set_stagthk(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geomderv%stagthck = inarray/(thk0) + end subroutine glide_set_stagthk + + subroutine glide_get_surftemp(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%climate%artm + end subroutine glide_get_surftemp + + subroutine glide_set_surftemp(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%climate%artm = inarray + end subroutine glide_set_surftemp + + subroutine glide_get_tauf(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_tau)*(data%basalproc%mintauf) + end subroutine glide_get_tauf + + subroutine glide_set_tauf(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%basalproc%mintauf = inarray/(scale_tau) + end subroutine glide_set_tauf + + subroutine glide_get_taux(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (1e-3*thk0*thk0/len0)*(data%velocity%tau_x) + end subroutine glide_get_taux + + subroutine glide_set_taux(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%tau_x = inarray/(1e-3*thk0*thk0/len0) + end subroutine glide_set_taux + + subroutine glide_get_tauy(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (1e-3*thk0*thk0/len0)*(data%velocity%tau_y) + end subroutine glide_get_tauy + + subroutine glide_set_tauy(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%tau_y = inarray/(1e-3*thk0*thk0/len0) + end subroutine glide_set_tauy + + subroutine glide_get_thk(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%geometry%thck) + end subroutine glide_get_thk + + subroutine glide_set_thk(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geometry%thck = inarray/(thk0) + end subroutine glide_set_thk + + subroutine glide_get_thkmask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(out) :: outarray + + outarray = data%geometry%thkmask + end subroutine glide_get_thkmask + + subroutine glide_set_thkmask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + integer, dimension(:,:), intent(in) :: inarray + + data%geometry%thkmask = inarray + end subroutine glide_set_thkmask + + subroutine glide_get_topg(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%geometry%topg) + end subroutine glide_get_topg + + subroutine glide_set_topg(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geometry%topg = inarray/(thk0) + end subroutine glide_set_topg + + subroutine glide_get_ubas(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_uvel)*(data%velocity%ubas) + end subroutine glide_get_ubas + + subroutine glide_set_ubas(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%ubas = inarray/(scale_uvel) + end subroutine glide_set_ubas + + subroutine glide_get_uflx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_uflx)*(data%velocity%uflx) + end subroutine glide_get_uflx + + subroutine glide_set_uflx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%uflx = inarray/(scale_uflx) + end subroutine glide_set_uflx + + subroutine glide_get_unstagbeta(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_beta)*(data%velocity%unstagbeta) + end subroutine glide_get_unstagbeta + + subroutine glide_set_unstagbeta(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%unstagbeta = inarray/(scale_beta) + end subroutine glide_set_unstagbeta + + subroutine glide_get_usurf(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (thk0)*(data%geometry%usrf) + end subroutine glide_get_usurf + + subroutine glide_set_usurf(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%geometry%usrf = inarray/(thk0) + end subroutine glide_set_usurf + + subroutine glide_get_vbas(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_uvel)*(data%velocity%vbas) + end subroutine glide_get_vbas + + subroutine glide_set_vbas(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%vbas = inarray/(scale_uvel) + end subroutine glide_set_vbas + + subroutine glide_get_vflx(data,outarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = (scale_uflx)*(data%velocity%vflx) + end subroutine glide_get_vflx + + subroutine glide_set_vflx(data,inarray) + use glimmer_scales + use glimmer_paramets + use glide_types + implicit none + type(glide_global_type) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%velocity%vflx = inarray/(scale_uflx) + end subroutine glide_set_vflx + + +end module glide_io diff --git a/components/cism/glimmer-cism/libglide/glide_lithot.F90 b/components/cism/glimmer-cism/libglide/glide_lithot.F90 new file mode 100644 index 0000000000..13b5e7b3cf --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_lithot.F90 @@ -0,0 +1,176 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_lithot.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +! module for temperature calculations in the upper lithosphere + + !TODO - Test module glide_lithot (1D version) in parallel code. + ! 3D version probably will not work in parallel + +module glide_lithot + + implicit none + +contains + + subroutine init_lithot(model) + use glide_types + use glide_setup + use glimmer_paramets, only: tim0 + use glimmer_log + use glide_lithot1d + use glide_lithot3d + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + ! local variables + integer k + real(dp) :: factor + + ! allocate memory for common arrays + allocate(model%lithot%deltaz(model%lithot%nlayer)); model%lithot%deltaz = 0.0 + allocate(model%lithot%zfactors(3,model%lithot%nlayer)); model%lithot%zfactors = 0.0 + + ! set up vertical grid + do k=1,model%lithot%nlayer + model%lithot%deltaz(k) = (1.d0 - glide_calc_sigma(real((model%lithot%nlayer-k),dp)/real((model%lithot%nlayer-1),dp), 2.d0)) & + *model%lithot%rock_base + end do + + ! calculate diffusion coefficient + model%lithot%diffu = model%lithot%con_r/(model%lithot%rho_r*model%lithot%shc_r) + + ! set up factors for vertical finite differences + do k=2,model%lithot%nlayer-1 + model%lithot%zfactors(1,k) = model%lithot%diffu*tim0*model%numerics%dt / & + ((model%lithot%deltaz(k)-model%lithot%deltaz(k-1)) * (model%lithot%deltaz(k+1)-model%lithot%deltaz(k-1))) + model%lithot%zfactors(2,k) = model%lithot%diffu*tim0*model%numerics%dt / & + ((model%lithot%deltaz(k+1)-model%lithot%deltaz(k)) * (model%lithot%deltaz(k)-model%lithot%deltaz(k-1))) + model%lithot%zfactors(3,k) = model%lithot%diffu*tim0*model%numerics%dt / & + ((model%lithot%deltaz(k+1)-model%lithot%deltaz(k)) * (model%lithot%deltaz(k+1)-model%lithot%deltaz(k-1))) + end do + k = model%lithot%nlayer + model%lithot%zfactors(:,k) = 0.5*model%lithot%diffu*tim0*model%numerics%dt / & + (model%lithot%deltaz(k)-model%lithot%deltaz(k-1))**2 + + !TODO - Make sure the sign is correct for the geothermal flux. + !NOTE: CISM convention is that geot is positive down, so geot < 0 for upward geothermal flux + + if (model%options%is_restart == RESTART_FALSE) then + ! set initial temp distribution to thermal gradient + factor = model%paramets%geot / model%lithot%con_r + do k=1,model%lithot%nlayer + model%lithot%temp(:,:,k) = model%lithot%surft + model%lithot%deltaz(k)*factor + end do + end if + + if (model%lithot%num_dim==1) then + call init_lithot1d(model) + else if (model%lithot%num_dim==3) then + call init_lithot3d(model) + else + call write_log('Error, init_lithot: Wrong number of dimensions',GM_FATAL,__FILE__,__LINE__) + end if + + end subroutine init_lithot + + subroutine spinup_lithot(model) + use parallel + use glide_types + use glimmer_log + use glide_mask + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + integer t + + if (model%options%is_restart == RESTART_FALSE .and. model%lithot%numt > 0) then + call write_log('Spinning up GTHF calculations',type=GM_INFO) + call not_parallel(__FILE__,__LINE__) + do t=1,model%lithot%numt + call calc_lithot(model) + end do + + end if + end subroutine spinup_lithot + + subroutine calc_lithot(model) + use glide_types + use glimmer_log + use glide_lithot1d + use glide_lithot3d + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + if (model%lithot%num_dim==1) then + call calc_lithot1d(model) + else if (model%lithot%num_dim==3) then + call calc_lithot3d(model) + else + call write_log('Wrong number of dimensions.',GM_FATAL,__FILE__,__LINE__) + end if + + call calc_geoth(model) + + end subroutine calc_lithot + + subroutine calc_geoth(model) + !> calculate geothermal heat flux + use glide_types + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + real(dp) factor + + factor = model%lithot%con_r/(model%lithot%deltaz(2)-model%lithot%deltaz(1)) + model%temper%bheatflx(:,:) = factor*(model%lithot%temp(:,:,2)-model%lithot%temp(:,:,1)) + + end subroutine calc_geoth + + subroutine finalise_lithot(model) + use glide_types + use glide_lithot1d + use glimmer_log + use glide_lithot3d + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + deallocate(model%lithot%deltaz) + deallocate(model%lithot%zfactors) + + if (model%lithot%num_dim==1) then + call finalise_lithot1d(model) + else if (model%lithot%num_dim==3) then + call finalise_lithot3d(model) + else + call write_log('Wrong number of dimensions.',GM_FATAL,__FILE__,__LINE__) + end if + end subroutine finalise_lithot + +end module glide_lithot diff --git a/components/cism/glimmer-cism/libglide/glide_lithot1d.F90 b/components/cism/glimmer-cism/libglide/glide_lithot1d.F90 new file mode 100644 index 0000000000..1c90451e3e --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_lithot1d.F90 @@ -0,0 +1,132 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_lithot1d.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +! module for 1D temperature calculations in the upper lithosphere + +!TODO - Test glide_lithot1d in parallel. It is local and should be parallel-friendly. + +module glide_lithot1d + + implicit none + +contains + + subroutine init_lithot1d(model) + + use glide_types + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + ! allocate memory for 1D code + allocate(model%lithot%rhs(model%lithot%nlayer)) + allocate(model%lithot%subd(model%lithot%nlayer)) + allocate(model%lithot%diag(model%lithot%nlayer)) + allocate(model%lithot%supd(model%lithot%nlayer)) + + ! setup coefficient matrix + model%lithot%subd(:) = - model%lithot%zfactors(1,:) + model%lithot%diag(:) = 1. + model%lithot%zfactors(2,:) + model%lithot%supd(:) = - model%lithot%zfactors(3,:) + ! and the boundary conditions + ! top face + ! simply match air temperature where no ice and basal temperature where ice + model%lithot%subd(1) = 0. + model%lithot%diag(1) = 1. + model%lithot%supd(1) = 0. + ! bottom face + ! keep constant + model%lithot%subd(model%lithot%nlayer) = 0. + model%lithot%diag(model%lithot%nlayer) = 1. + model%lithot%supd(model%lithot%nlayer) = 0. + end subroutine init_lithot1d + + subroutine calc_lithot1d(model) + use glide_types + use glimmer_utils, only: tridiag + !use glide_mask + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + integer i,j,k + + !Note - I think these loops can be left as is for parallel code. + ! Local calculation, so no issues with computing in halo cells. + + ! loop over grid + do j=1,model%general%nsn + do i=1,model%general%ewn + ! calculate RHS for upper BC + if (GLIDE_IS_GROUND(model%geometry%thkmask(i,j)) .and. .not. GLIDE_IS_THIN(model%geometry%thkmask(i,j)) ) then + model%lithot%rhs(1) = model%temper%temp(model%general%upn,i,j) ! ice basal temperature + model%lithot%mask(i,j) = .true. + else + if (model%lithot%mask(i,j)) then + if (GLIDE_IS_OCEAN(model%geometry%thkmask(i,j))) then + model%lithot%rhs(1) = model%lithot%mart + else if (GLIDE_IS_LAND(model%geometry%thkmask(i,j))) then + model%lithot%rhs(1) = model%climate%artm(i,j) ! air temperature outside ice sheet + end if + end if + end if + + if (model%lithot%mask(i,j)) then + ! calculate RHS for rest + do k=2,model%lithot%nlayer-1 + model%lithot%rhs(k) = - model%lithot%subd(k)*model%lithot%temp(i,j,k-1) & + + (2.-model%lithot%diag(k))*model%lithot%temp(i,j,k) & + - model%lithot%supd(k)*model%lithot%temp(i,j,k+1) + end do + model%lithot%rhs(model%lithot%nlayer) = model%lithot%temp(i,j,model%lithot%nlayer) + + ! solve tri-diagonal matrix eqn + call tridiag(model%lithot%subd(1:), & + model%lithot%diag(:), & + model%lithot%supd(:model%lithot%nlayer), & + model%lithot%temp(i,j,:) , & + model%lithot%rhs(:)) + end if + end do + end do + end subroutine calc_lithot1d + + subroutine finalise_lithot1d(model) + use glide_types + implicit none + type(glide_global_type),intent(inout) :: model !> model instance + + deallocate(model%lithot%rhs) + deallocate(model%lithot%subd) + deallocate(model%lithot%diag) + deallocate(model%lithot%supd) + end subroutine finalise_lithot1d + +end module glide_lithot1d diff --git a/components/cism/glimmer-cism/libglide/glide_lithot3d.F90 b/components/cism/glimmer-cism/libglide/glide_lithot3d.F90 new file mode 100644 index 0000000000..1d7ffae409 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_lithot3d.F90 @@ -0,0 +1,238 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_lithot3d.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +! module for 3D temperature calculations in the upper lithosphere +! (serial only) + + !TODO - Support a 3D lithosphere calculation in parallel? Not easy to do. + +module glide_lithot3d + + implicit none + + private + public :: init_lithot3d, calc_lithot3d, finalise_lithot3d + + +contains + + subroutine init_lithot3d(model) + + use glide_types + use glimmer_paramets, only: len0,tim0 + implicit none + type(glide_global_type),intent(inout) :: model ! model instance + + ! local variables + integer i,j,k,r,icount,jcount,ewn,nsn + + ! allocate memory for 3D code + !TODO - Move to glide_allocarr? + + ewn=model%general%ewn + nsn=model%general%nsn + + call new_sparse_matrix(ewn*nsn*model%lithot%nlayer, & + (model%lithot%nlayer-1)*ewn*nsn*7+ewn*nsn+1,model%lithot%fd_coeff) + call new_sparse_matrix(ewn*nsn*model%lithot%nlayer, & + (model%lithot%nlayer-1)*ewn*nsn*7+ewn*nsn+1,model%lithot%fd_coeff_slap) + allocate(model%lithot%rhs(model%lithot%nlayer*ewn*nsn)) + allocate(model%lithot%answer(model%lithot%nlayer*ewn*nsn)) + model%lithot%mxnelt = 20 * model%lithot%nlayer*ewn*nsn + + !TODO - Deallocate these arrays + allocate(model%lithot%rwork(model%lithot%mxnelt)) + allocate(model%lithot%iwork(model%lithot%mxnelt)) + + ! set up factors for horizontal finite differences + model%lithot%xfactor = 0.5*model%lithot%diffu*tim0*model%numerics%dt / (model%numerics%dew*len0)**2 + model%lithot%yfactor = 0.5*model%lithot%diffu*tim0*model%numerics%dt / (model%numerics%dns*len0)**2 + + + ! calculate finite difference coefficient matrix + ! top face + ! simply match air temperature where no ice and basal temperature where ice + k = 1 + do j=1,model%general%nsn + do i=1,model%general%ewn + r = linearise(model,i,j,k) + call sparse_insert_val(model%lithot%fd_coeff,r,r, 1.d0) + end do + end do + do k=2, model%lithot%nlayer-1 + do j=1,model%general%nsn + do i=1,model%general%ewn + icount = 0 + jcount = 0 + r = linearise(model,i,j,k) + ! i-1,j,k + if (i /= 1) then + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i-1,j,k), -model%lithot%xfactor) + icount = icount + 1 + end if + ! i+1, j, k + if (i /= model%general%ewn) then + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i+1,j,k), -model%lithot%xfactor) + icount = icount + 1 + end if + ! i,j-1,k + if (j /= 1) then + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i,j-1,k), -model%lithot%yfactor) + jcount = jcount + 1 + end if + ! i,j+1,k + if (j /= model%general%nsn) then + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i,j+1,k), -model%lithot%yfactor) + jcount = jcount + 1 + end if + ! i,j,k-1 + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i,j,k-1), -model%lithot%zfactors(1,k)) + ! i,j,k+1 + call sparse_insert_val(model%lithot%fd_coeff,r,linearise(model,i,j,k+1), -model%lithot%zfactors(3,k)) + ! i,j,k + call sparse_insert_val(model%lithot%fd_coeff,r,r, & + icount*model%lithot%xfactor + jcount*model%lithot%yfactor + model%lithot%zfactors(2,k) + 1.) + end do + end do + end do + + ! bottom face + ! keep constant + k = model%lithot%nlayer + do j=1,model%general%nsn + do i=1,model%general%ewn + r = linearise(model,i,j,k) + call sparse_insert_val(model%lithot%fd_coeff,r,r, 1.d0) + end do + end do + + ! convert from SLAP Triad to SLAP Column format + call copy_sparse_matrix(model%lithot%fd_coeff,model%lithot%fd_coeff_slap) + call ds2y(model%general%nsn*model%general%ewn*model%lithot%nlayer,model%lithot%fd_coeff_slap%nonzeros, & + model%lithot%fd_coeff_slap%col,model%lithot%fd_coeff_slap%row,model%lithot%fd_coeff_slap%val, 0) + + ! initialise result vector + do k=1,model%lithot%nlayer + do j=1,model%general%nsn + do i=1,model%general%ewn + model%lithot%answer(linearise(model,i,j,k)) = model%lithot%temp(i,j,k) + end do + end do + end do + + end subroutine init_lithot3d + + subroutine calc_lithot3d(model) + use glide_types + use glide_stop + use glimmer_log + implicit none + type(glide_global_type),intent(inout) :: model ! model instance + + integer i,j,k,r + integer iter + real(dp) err + real(dp), parameter :: tol = 1.0d-12 + integer, parameter :: isym = 0, itol = 2, itmax = 101 + integer :: ierr + + ! calculate RHS + call sparse_matrix_vec_prod(model%lithot%fd_coeff,model%lithot%answer,model%lithot%rhs) + model%lithot%rhs = -model%lithot%rhs + 2. * model%lithot%answer + ! calc RHS on upper boundary + k = 1 + do j=1,model%general%nsn + do i=1,model%general%ewn + r = linearise(model,i,j,k) + if (GLIDE_IS_GROUND(model%geometry%thkmask(i,j)) .and. .not. GLIDE_IS_THIN(model%geometry%thkmask(i,j)) ) then + model%lithot%rhs(r) = model%temper%temp(model%general%upn,i,j) ! ice basal temperature + model%lithot%mask(i,j) = .true. + else + if (model%lithot%mask(i,j)) then + if (GLIDE_IS_OCEAN(model%geometry%thkmask(i,j))) then + model%lithot%rhs(r) = model%lithot%mart + else if (GLIDE_IS_LAND(model%geometry%thkmask(i,j))) then + model%lithot%rhs(r) = model%climate%artm(i,j) ! air temperature outside ice sheet + end if + end if + end if + end do + end do + + ! solve matrix equation + call dslucs(model%general%nsn*model%general%ewn*model%lithot%nlayer, model%lithot%rhs, model%lithot%answer, & + model%lithot%fd_coeff_slap%nonzeros, model%lithot%fd_coeff_slap%col,model%lithot%fd_coeff_slap%row, & + model%lithot%fd_coeff_slap%val, isym,itol,tol,itmax,iter,err,ierr,0, & + model%lithot%rwork, model%lithot%mxnelt, model%lithot%iwork, model%lithot%mxnelt) + + if (ierr /= 0) then + print *, 'pcg error ', ierr, itmax, iter + write(*,*) model%numerics%time + call glide_finalise(model,.true.) + call close_log + stop + end if + + ! de-linearise results + do k=1, model%lithot%nlayer + do j=1,model%general%nsn + do i=1,model%general%ewn + model%lithot%temp(i,j,k) = model%lithot%answer(linearise(model,i,j,k)) + end do + end do + end do + + end subroutine calc_lithot3d + + subroutine finalise_lithot3d(model) + use glide_types + implicit none + type(glide_global_type),intent(inout) :: model ! model instance + + call del_sparse_matrix(model%lithot%fd_coeff) + call del_sparse_matrix(model%lithot%fd_coeff_slap) + deallocate(model%lithot%rhs) + deallocate(model%lithot%answer) + end subroutine finalise_lithot3d + + function linearise(model,i,j,k) + use glide_types + implicit none + type(glide_global_type),intent(in) :: model + integer, intent(in) :: i,j,k + integer :: linearise + + linearise = i + (j-1)*model%general%ewn + (k-1)*model%general%ewn*model%general%nsn + end function linearise + + +end module glide_lithot3d diff --git a/components/cism/glimmer-cism/libglide/glide_mask.F90 b/components/cism/glimmer-cism/libglide/glide_mask.F90 new file mode 100644 index 0000000000..23a33e239c --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_mask.F90 @@ -0,0 +1,589 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_mask.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glide_mask + + ! masking ice thicknesses + + use glimmer_global, only : dp + use nan_mod, only : NaN + + implicit none + +contains + +!TODO - Remove iarea and ivol calculation? They can be computed elsewhere. + +!TODO - Write a new subroutine (in addition to glide_set_mask) to compute mask for staggered grid? +! This subroutine is now called from glissade_velo_driver with stagthck and stagtopg +! as input arguments. + + subroutine glide_set_mask(numerics, thck, topg, ewn, nsn, eus, mask, iarea, ivol, exec_serial) + + use parallel + use glide_types + use glimmer_physcon, only : rhoi, rhoo + implicit none + + type(glide_numerics), intent(in) :: numerics !Numerical parameters structure + real(dp), dimension(:,:), intent(in) :: thck ! Ice thickness + real(dp), dimension(:,:), intent(in) :: topg ! Bedrock topography (not lower surface!) + integer, intent(in) :: ewn, nsn ! Grid size + real(dp), intent(in) :: eus ! Sea level + integer, dimension(:,:), intent(inout) :: mask ! Output mask + real(dp), intent(inout), optional :: ivol, iarea ! Area and volume of ice + logical, optional :: exec_serial !JEFF If executing in serial in MPI program. + + ! local variables + integer ew,ns + real(dp), parameter :: con = - rhoi / rhoo + logical :: exec_serial_flag + + !Note - This array may not be needed, at least in parallel. + + ! Create an array to "fake" the boundaries of the mask so that boundary + ! finding can work even on the boundaries of the real mask. + + integer, dimension(0:ewn+1,0:nsn+1) :: maskWithBounds; + + !TODO - What is the exec_serial option? Is it still needed? + + !JEFF Handle exec_serial optional parameter + if ( present(exec_serial) ) then + exec_serial_flag = exec_serial + else + ! Default to off + exec_serial_flag = .FALSE. + endif + + mask = 0 + + if (present(iarea)) iarea = 0.d0 + if (present(ivol)) ivol = 0.d0 + +!Note - This mask is confusing. Wondering if we should replace it by a series of logical masks. + +! Would need the following: +! glide_mask_has_ice = 1 +! glide_mask_thin_ice = 3 +! glide_mask_ocean = 4 (below sea level, with or without ice) +! glide_mask_land = 8 (complement of glide_mask_ocean) +! glide_mask_grounding_line = 16 (could define in terms of margin and has ice?) +! glide_mask_margin = 32 (has_ice + at least one neighbor with no ice) +! glide_mask_dirichlet_bc = 64 +! glide_mask_comp_domain_bnd = 128 (no longer needed with new global BC?) +! glide_no_ice (complement of glide_has_ice) +! glide_is_thin +! glide_is_ocean (ocean + no_ice; change to glide_ocean_icefree or remove?) +! glide_is_land (land + no_ice; change to glide_land_icefree or remove?) +! glide_is_ground (land + has_ice) +! glide_is_float (ocean + has_ice) +! glide_is_grounding_line (just inside or just outside? Used only in glide_ground) +! glide_is_margin +! glide_is_land_margin (margin + land + has_ice) +! glide_is_calving (margin + ocean + has_ice; change the name to is_marine_margin?) +! glide_is_marine_ice_edge (margin + (float or GL); may not be needed) +! glide_is_dirichlet_boundary +! glide_is_comp_domain_bnd (may not be needed with new global BC?) +! +! If we keep the present structure, could change glide_is_land to glide_icefree_land, +! glide_is_ocean to glide_icefree_ocean +! Could get by with fewer masks in the code by removing some combinations +! Could remove *BITS + + !Identify points with any ice + where (thck > 0.d0) + mask = ior(mask, GLIDE_MASK_HAS_ICE) ! GLIDE_MASK_HAS_ICE = 1; see glide_mask.inc + endwhere + + !Identify points where the ice is below the ice dynamics limit + where (thck > 0.d0 .and. thck < numerics%thklim) + mask = ior(mask, GLIDE_MASK_THIN_ICE) ! GLIDE_MASK_THIN_ICE = 3 + endwhere + + !Identify points where the ice is floating or where there is open ocean + where (topg - eus < con * thck) + mask = ior(mask, GLIDE_MASK_OCEAN) ! GLIDE_MASK_OCEAN = 8 + elsewhere + mask = ior(mask, GLIDE_MASK_LAND) ! GLIDE_MASK_LAND = 4 + endwhere + + if (present(iarea) .and. present(ivol)) then + call get_area_vol(thck, numerics%dew, numerics%dns, numerics%thklim, iarea, ivol, exec_serial_flag) + end if + + !TODO - Replace the following with a halo call for 'mask', with appropriate global BC? + + maskWithBounds = 0 + maskWithBounds(1:ewn, 1:nsn) = MASK + maskWithBounds(0,1:nsn) = mask(1,:) + maskWithBounds(1:ewn,0) = mask(:,1) + maskWithBounds(ewn+1,1:nsn) = mask(ewn,:) + maskWithBounds(1:ewn,nsn+1) = mask(:,nsn) + maskWithBounds(0,0) = mask(1,1) + maskWithBounds(ewn+1,nsn+1) = mask(ewn,nsn) + maskWithBounds(0,nsn+1) = mask(1,nsn) + maskWithBounds(ewn+1,0) = mask(ewn,1) + + ! finding boundaries + + !Note: If halo cells are present, maskWithBounds array may not be needed; can replace with mask array. + ! Not sure what happens here when we're computing a mask on the velocity grid. + + do ns = 1,nsn + do ew = 1,ewn + !Find the grounding line + if (GLIDE_IS_GROUND(MASK(ew,ns))) then ! land + has_ice + if (GLIDE_IS_FLOAT(maskWithBounds(ew-1,ns)) .or. & + GLIDE_IS_FLOAT(maskWithBounds(ew+1,ns)) .or. & + GLIDE_IS_FLOAT(maskWithBounds(ew,ns-1)) .or. & + GLIDE_IS_FLOAT(maskWithBounds(ew,ns+1))) then + MASK(ew,ns) = ior(MASK(ew,ns),GLIDE_MASK_GROUNDING_LINE) + end if + end if + + ! Ice margin + ! *tb* A point is now masked even if it touches the ocean on one corner. + if ( GLIDE_HAS_ICE(mask(ew, ns)) .and. & + (GLIDE_NO_ICE(maskWithBounds(ew-1,ns)) .or. GLIDE_NO_ICE(maskWithBounds(ew+1,ns)) .or. & + GLIDE_NO_ICE(maskWithBounds(ew,ns-1)) .or. GLIDE_NO_ICE(maskWithBounds(ew,ns+1)) .or. & + GLIDE_NO_ICE(maskWithBounds(ew-1,ns-1)) .or. GLIDE_NO_ICE(maskWithBounds(ew-1,ns+1)) .or. & + GLIDE_NO_ICE(maskWithBounds(ew+1,ns-1)) .or. GLIDE_NO_ICE(maskWithBounds(ew+1,ns+1)))) then + MASK(ew,ns) = ior(MASK(ew,ns),GLIDE_MASK_MARGIN) + end if + +! The GLIDE_MASK_COMP_DOMAIN_BND condition is currently used in glam_strs2.F90. + + !Mark domain boundaries + !if (ns == 1 .or. ns == nsn .or. ew == 1 .or. ew == ewn) then + if (parallel_boundary(ew,ewn,ns,nsn)) then +! SFP: commenting out for now, while trying to get periodic bcs working +! mask(ew, ns) = ior(mask(ew, ns), GLIDE_MASK_COMP_DOMAIN_BND) + end if + end do + end do + + !JEFF Don't call halo update if running in serial mode + !WHL - I think the halo update will now work in serial mode. + if (.NOT. exec_serial_flag) then + call parallel_halo(mask) + endif + + end subroutine glide_set_mask + + subroutine augment_kinbc_mask(mask, kinbcmask) + + ! Augments the Glide mask with the location of kinematic (dirichlet) boundary + ! conditions. These locations cannot be determined by the model a priori, and + ! must be specified through a field in a NetCDF file. + integer, dimension(:,:), target :: mask + integer, dimension(:,:) :: kinbcmask + + integer, dimension(:,:), pointer :: maskp + + !Because the kinematic boundary conditions are specified on the staggered grid, + !there may be a size mismatch here depending on whether we are computing a mask + !for the staggered grid. + if (size(mask, 1) /= size(kinbcmask, 1)) then + maskp => mask(1:size(mask,1) - 1, 1:size(mask,2) - 1) + else + maskp => mask + end if + + where (kinbcmask /= 0) + maskp = ior(maskp, GLIDE_MASK_DIRICHLET_BC) + endwhere + end subroutine augment_kinbc_mask + + subroutine get_area_vol(thck, dew, dns, thklim, iarea, ivol, exec_serial) + use parallel + implicit none + real(dp), dimension(:,:) :: thck + real(dp) :: dew, dns, thklim + real(dp) :: iarea, ivol, sum(2) + logical :: exec_serial + + integer :: i,j + + do i = 1+lhalo, size(thck,1)-uhalo + do j = 1+lhalo, size(thck,2)-uhalo + if (thck(i,j) > thklim ) then + iarea = iarea + 1 + ivol = ivol + thck(i,j) + end if + end do + end do + + iarea = iarea * dew * dns + ivol = ivol * dew * dns + + if (.NOT. exec_serial) then + sum(1) = iarea + sum(2) = ivol + call global_sum(sum) + iarea = sum(1) + ivol = sum(2) + endif + + end subroutine get_area_vol + + subroutine calc_iareaf_iareag(dew, dns, mask, iareaf, iareag, exec_serial) + + use parallel + + implicit none + real(dp), intent(in) :: dew, dns + real(dp), intent(out) :: iareaf, iareag + integer, dimension(:,:), intent(in) :: mask + logical, optional :: exec_serial ! If executing in serial in MPI program. + + integer :: i,j + logical :: exec_serial_flag + real(dp) :: sum(2) + + !TODO - exec_serial option may not be needed + if ( present(exec_serial) ) then + exec_serial_flag = exec_serial + else + ! Default to off + exec_serial_flag = .FALSE. + endif + + iareaf = 0.d0 + iareag = 0.d0 + + !loop over locally owned scalars + do j = 1+lhalo, size(mask,2)-uhalo + do i = 1+lhalo, size(mask,1)-uhalo + if (GLIDE_IS_FLOAT(mask(i,j))) then + iareaf = iareaf + dew * dns + else if(GLIDE_IS_GROUND_OR_GNDLINE(mask(i,j))) then + iareag = iareag + dew * dns + end if + end do + end do + + if (.NOT. exec_serial_flag) then + sum(1) = iareaf + sum(2) = iareag + call global_sum(sum) + iareaf = sum(1) + iareag = sum(2) + endif + + end subroutine calc_iareaf_iareag + + subroutine glide_marine_margin_normal(thck, mask, marine_bc_normal, exec_serial) + + !TODO - Remove subroutine glide_marine_margin_normal? Old PBJ routine. + ! Also can remove calc_normal_45deg + + use parallel + use glimmer_physcon, only:pi + implicit none + !> This subroutine derives from the given mask the normal to an ice shelf + !> each point on the marine margin. + real(dp), dimension(:,:), intent(in) :: thck + integer, dimension(:,:), intent(in) :: mask + real(dp), dimension(:,:), intent(out) :: marine_bc_normal + logical, optional :: exec_serial !JEFF If executing in serial in MPI program. + + integer :: i, j, dx, dy, k + logical :: exec_serial_flag + + real(dp), dimension(size(thck,1), size(thck,2)) :: direction_x, direction_y + + real(dp), dimension(-1:1, -1:1) :: angle_lookup + + !JEFF Handle exec_serial optional parameter + if ( present(exec_serial) ) then + exec_serial_flag = exec_serial + else + ! Default to off + exec_serial_flag = .FALSE. + endif + + !direction_y = -1 0 1 !direction_x = + angle_lookup(-1, :) = (/ 3*pi/4, pi/2, pi/4 /) !-1 + angle_lookup( 0, :) = (/ pi, 0D0, 2*pi /) ! 0 + angle_lookup( 1, :) = (/ 5*pi/4, 3*pi/2, 7*pi/4 /) ! 1 + call upwind_from_mask(mask, direction_x, direction_y, exec_serial_flag) + + !Set up a thickness variable with "ghost cells" so that we don't go out + !of bounds with the vectorized operation below + !thckWithBounds(1:size(thck,1), 1:size(thck,2)) = thck + !thckWithBounds(:,0) = thckWithBounds(:,1) + !thckWithBounds(0,:) = thckWithBounds(1,:) + !thckWithBounds(size(thck,1)+1,:) = thckWithBounds(size(thck,1),:) + !thckWithBounds(:,size(thck,2)+1) = thckWithBounds(:,size(thck,2)) + do i = 1, size(mask, 1) + do j = 1, size(mask, 2) + if (GLIDE_IS_CALVING(mask(i,j))) then + dx = int(direction_x(i,j)) + dy = int(direction_y(i,j)) + if (dx == 0 .and. dy == 0) then + write(*,*)"A shelf front point has been identified at:" + write(*,*)"x = ",i + write(*,*)"y = ",j + write(*,*)"But neither x nor y derivatives have been marked as upwinded." + write(*,*)"This should never happen, if this error appears it is a bug" + write(*,*)"and should be reported." + write(*,*)"The mask around this point follows:" + write(*,*)"--------------------------" + + !Write a header row with a * in the column corresponding to the center + do k = -4, 4 + if (k==0) then + write(*,"(A)",advance="no")" *" + else if (i+k > 0 .and. i+k <= size(mask,1)) then + write(*,"(A)",advance="no")" " + end if + end do + write(*,*) + + do k=4, -4, -1 + if (j+k > 0 .and. j+k <= size(mask, 2)) then + if (k == 0) then + write(*,*) "*", mask(max(1,i-4):min(size(mask,1),i+4),j+k) + else + write(*,*) " ", mask(max(1,i-4):min(size(mask,1),i+4),j+k) + end if + end if + end do + write(*,*)"--------------------------" + write(*,*)"Have a nice day!" + !stop + end if + marine_bc_normal(i,j) = angle_lookup(dx, dy) + !marine_bc_normal(i,j) = calc_normal_45deg(thckWithBounds(i-1:i+1,j-1:j+1)) + else + marine_bc_normal(i,j) = NaN + end if + end do + end do + if (.NOT. exec_serial_flag) then + call parallel_halo(marine_bc_normal) + endif + end subroutine + + function calc_normal_45deg(thck3x3) + use glimmer_physcon, only: pi + + !> Computes the angle of the normal vector, in radians, for the given + !> 3x3 segment of ice geometry. + !> The normal is given in increments of 45 degrees (no nicer + !> interpolation is currently done) + !> This is based on the Payne and Price GLAM code, if/when this is + !> integrated into CISM it should probably be refactored to use this. + real(dp), dimension(3,3) :: thck3x3 + + real(dp) :: calc_normal_45deg + + real(dp), dimension(3,3) :: mask, maskcorners + real(dp), dimension(3,3) :: thckmask + real(dp), dimension(3) :: testvect + real(dp) :: phi, deg2rad + integer :: loc_latbc + + deg2rad = pi / 180.0d0 + loc_latbc = 0 + phi = 0.d0 + mask(:,1) = (/ 0.0d0, 180.0d0, 0.0d0 /) + mask(:,2) = (/ 270.0d0, 0.0d0, 90.0d0 /) + mask(:,3) = (/ 0.0d0, 360.0d0, 0.0d0 /) + maskcorners(:,1) = (/ 225.0d0, 0.0d0, 135.0d0 /) + maskcorners(:,2) = (/ 0.0d0, 0.0d0, 0.0d0 /) + maskcorners(:,3) = (/ 315.0d0, 0.0d0, 45.0d0 /) + + ! specify new value of 'loc' vector such that fwd/bwd diffs. are set up correctly in sparse matrix + ! when function 'fillsprsebndy' is called. Also, specify appropriate values for the vectors 'normal' + ! and 'fwdorbwd', which specify the orientation of the boundary normal and the direction of forward or + ! backward differencing to be done in the lateral boundary condition functions 'normhorizmainbc_lat' + ! and 'crosshorizmainbc_lat' + + ! following is algorithm for calculating boundary normal at 45 deg. increments, based on arbitray + ! boundary shape + + where( thck3x3 /= 0.0d0 ) + thckmask = 0.0_dp + elsewhere( thck3x3 == 0.0d0 ) + thckmask = 1.0d0 + endwhere + + testvect = sum( thckmask * mask, 1 ) + + !if( up == 3 )then ! temporary code for debugging + ! do i = 3,1,-1 + ! print *, 'thck = ', thck(:,i) + ! end do + ! print *, ' ' + ! + ! do i = 3,1,-1 + ! print *, 'thckmask = ', thckmask(:,i) + ! end do + ! print *, ' ' + ! + ! print *, 'testvect = ', testvect + ! print *, ' ' + !end if + + ! calculate the angle of the normal in cart. (x,y) system w/ 0 deg. at 12 O'clock, 90 deg. at 3 O'clock, etc. + if( sum( sum( thckmask, 1 ) ) == 1.0d0 )then + phi = sum( sum( thckmask * maskcorners, 1 ) ) + else + if( any( testvect == 360.0d0 ) )then + if( sum( testvect ) == 450.0d0 )then + phi = 45.0d0 + elseif( sum( testvect ) == 630.0d0 )then + phi = 315.0d0 + else + phi = 0.0d0 + end if + elseif( all( testvect /= 360 ) )then + phi = sum( testvect ) / sum( testvect/testvect, testvect /= 0.0d0 ) + end if + end if + + calc_normal_45deg = deg2rad * phi + + !Tim's Note: This appears to actually compute 0 at 6 O'clock according + !to Glimmer's coordinate system. 90 deg. is still 3 O'clock. + !I'm going to correct for this here rather than dig through the code + !above + calc_normal_45deg = pi - calc_normal_45deg + if (calc_normal_45deg < 0) calc_normal_45deg = calc_normal_45deg + 2*pi + + end function + +!TODO - Remove subroutine upwind_from_mask? Not currently used. + + !Fills a field of differencing directions suitable to give a field + !derivative routine. Uses centered differencing everywhere except for the + !marine ice margin, where upwinding and downwinding is used to avoid + !differencing across the boundary. + + subroutine upwind_from_mask(mask, direction_x, direction_y, exec_serial) + use parallel + integer, dimension(:,:), intent(in) :: mask + double precision, dimension(:,:), intent(out) :: direction_x, direction_y + logical, optional :: exec_serial !JEFF If executing in serial in MPI program. + + integer :: i,j + logical :: exec_serial_flag + + !JEFF Handle exec_serial optional parameter + if ( present(exec_serial) ) then + exec_serial_flag = exec_serial + else + ! Default to off + exec_serial_flag = .FALSE. + endif + + direction_x = 0 + direction_y = 0 + + !Detect locations of the marine margin + do i = 1, size(mask,1) + do j = 1, size(mask,2) + if (GLIDE_IS_CALVING(mask(i,j))) then + !Detect whether we need to upwind or downwind in the Y + !direction + if (i > 1) then + if (.not. GLIDE_HAS_ICE(mask(i-1,j))) then + direction_x(i,j) = 1 + end if + end if + + if (i < size(mask, 1)) then + if (.not. GLIDE_HAS_ICE(mask(i+1,j))) then + direction_x(i,j) = -1 + end if + end if + + !Detect whether we need to upwind or downwind in the X + !direction + if (j > 1) then + if (.not. GLIDE_HAS_ICE(mask(i,j-1))) then + direction_y(i,j) = 1 + end if + end if + + if (j < size(mask, 2)) then + if (.not. GLIDE_HAS_ICE(mask(i,j+1))) then + direction_y(i,j) = -1 + end if + end if + + !If we are at a point that is "interior" to two other boundary points, + !such as the lower right of: + !o b i + !b b i + !(o = ocean, b = boundary, i = interior), then we will not detect the need + !to upwind or downwind. However, we still should for consistency with other + !mask points (in some cases, not doing so can lead to a singular calculation + !at the marine ice front) + ! + !We can think of this operation as avoiding calving points where there is + !a non-calving point to upwind into. + ! + !NOTE: We need a better way to detect interior points. Right now I am just using + !points that are floating, and that works, but this doesn't work for two reasons: + !1. Boundary points are also floating + !2. Could fail for a very thin ice shelf + if (int(direction_x(i,j)) == 0 .and. int(direction_y(i,j)) == 0 .and. & + i > 1 .and. j > 1 .and. i < size(mask, 1) .and. j < size(mask, 2)) then + if (.not. GLIDE_HAS_ICE(mask(i-1, j-1))) then + direction_x(i,j) = 1 + direction_y(i,j) = 1 + else if (.not. GLIDE_HAS_ICE(mask(i-1, j+1))) then + direction_x(i,j) = 1 + direction_y(i,j) = -1 + else if (.not. GLIDE_HAS_ICE(mask(i+1, j-1))) then + direction_x(i,j) = -1 + direction_y(i,j) = 1 + else if (.not. GLIDE_HAS_ICE(mask(i+1, j+1))) then + direction_x(i,j) = -1 + direction_y(i,j) = -1 + end if + end if + end if + end do + end do + + if (.NOT. exec_serial_flag) then + call parallel_halo(direction_x) + call parallel_halo(direction_y) + endif + + end subroutine upwind_from_mask + +end module glide_mask diff --git a/components/cism/glimmer-cism/libglide/glide_mask.inc b/components/cism/glimmer-cism/libglide/glide_mask.inc new file mode 100644 index 0000000000..94576e85f0 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_mask.inc @@ -0,0 +1,123 @@ +#ifndef GLIDE_MASK_INC + +!Bits 1:0 - Ice presence (0 if no ice). NOTE: If bit 2 is activated, bit 1 must be activated +#define GLIDE_MASK_HAS_ICE 1 +#define GLIDE_MASK_THIN_ICE 3 +#define GLIDE_ICE_PRESENCE_BITS 3 + +!TODO - Is the grounding line mask needed? +! Also, note that MASK_LAND is redundant given MASK_OCEAN, since one is the complement of the other. + +!Bits 4:2 - Type of base (Land or ocean - grounding line has both bits on). The 16 bit specifies grounding line, +! set up so that those points are treated as grounded) +#define GLIDE_MASK_LAND 4 +#define GLIDE_MASK_OCEAN 8 +#define GLIDE_MASK_GROUNDING_LINE 16 + +!Bit 5: Identifies a margin (jump from zero to nonzero thickness). Margin type determined by whether ice grounded or floating. +#define GLIDE_MASK_MARGIN 32 + +!Bit 6: Identifies a dirichlet condition. The velocity at points marked with this bit should be held constant. +#define GLIDE_MASK_DIRICHLET_BC 64 + +!Bit 7: Identifies a computational domain boundary. These are normally just activated on the edges of the domain, +!unless there is a domain decomposition (in which case they may be missing) +#define GLIDE_MASK_COMP_DOMAIN_BND 128 + +!======= +! All mask values actually used in code (as defined below) should be made up of some combination of one or more +! of the above "base" type bits. + +!TODO - Rename to GLIDE_ICEFREE_OCEAN? +!Checks for an iceless square +!Checks for open ocean with no ice +#define GLIDE_IS_OCEAN(mask) (iand(mask, GLIDE_MASK_OCEAN) == GLIDE_MASK_OCEAN .and. GLIDE_NO_ICE(mask)) + +!TODO - Rename to GLIDE_ICEFREE_LAND? +!Checks for land with no ice +#define GLIDE_IS_LAND(mask) (iand(mask, GLIDE_MASK_LAND) == GLIDE_MASK_LAND .and. GLIDE_NO_ICE(mask)) + +!Checks for the presence of any ice, dynamic or not +#define GLIDE_HAS_ICE(mask) (iand(mask, GLIDE_MASK_HAS_ICE) == GLIDE_MASK_HAS_ICE) + +!Checks for a lack of ice +#define GLIDE_NO_ICE(mask) (iand(mask, GLIDE_MASK_HAS_ICE) == 0) + +!Checks for the presence of ice that is below the ice dynamics limit +#define GLIDE_IS_THIN(mask) (iand(mask,GLIDE_MASK_THIN_ICE) == GLIDE_MASK_THIN_ICE) + +!Checks for any ice, dynamic or not, that is on an ice shelf. +#define GLIDE_IS_FLOAT(mask) (iand(mask,GLIDE_MASK_OCEAN) == GLIDE_MASK_OCEAN .and. GLIDE_HAS_ICE(mask)) + +!Checks for any ice, dynamic or not, that is grounded +#define GLIDE_IS_GROUND(mask) (iand(mask,GLIDE_MASK_LAND) == GLIDE_MASK_LAND .and. GLIDE_HAS_ICE(mask)) + +!TODO - Remove hardwiring? +! Actually, not sure this is needed +!Checks for any ice, dynamic or not, that is on the grounding line + +!TODO: define from above available combinations rather than hardcode? +!17 = 16 + 1 +#define GLIDE_IS_GROUNDING_LINE(mask) (iand(mask, 17) == 17) + +!TODO - This one probably is not needed - NOTE that removing it affects the iarea/ivol calculation +!Checks for any ice, dynamic or not, that is either floating *or* on the grounding line +!TODO: IF NEEDED, define from above available combinations rather than hardcode? +#define GLIDE_IS_FLOAT_OR_GNDLINE(mask) (iand(mask, 24) > 0 .and. GLIDE_HAS_ICE(mask)) + +!TODO - This one probably is not needed - NOTE that removing it affects the iarea/ivol calculation +!Checks for any ice, dynamic or not, that is either grounded *or* on the grounding line +!TODO: IF NEEDED, define from above available combinations rather than hardcode? +#define GLIDE_IS_GROUND_OR_GNDLINE(mask) (iand(mask, 20) > 0 .and. GLIDE_HAS_ICE(mask)) + +!Checks whether this is an ice margin (thickness jumps from 0 to non-zero at this point) +#define GLIDE_IS_MARGIN(mask) (iand(mask, GLIDE_MASK_MARGIN) == GLIDE_MASK_MARGIN) + +!TODO - Not sure this is needed +!Checks whether this is a margin in contact with the ocean, floating or not +#define GLIDE_IS_MARINE_ICE_EDGE(mask) (GLIDE_IS_MARGIN(mask) .and. GLIDE_IS_FLOAT_OR_GNDLINE(mask)) + +!TODO - Not a good name for this mask +!Checks whether this is a margin in contact with the ocean +!41 = 32 + 8 + 1 +!TODO: define from above available combinations rather than hardcode? +#define GLIDE_IS_CALVING(mask) (iand(mask, 41) == 41) + +!Checks whether this is a land margin +!37 = 32 + 4 + 1 +!TODO: define from above available combinations rather than hardcode? +#define GLIDE_IS_LAND_MARGIN(mask) (iand(mask, 37) == 37) + +!TODO - Where are the Dirichlet and domain_bnd masks set in the code? +!Checks whether a dirichlet boundary has been defined at this point +#define GLIDE_IS_DIRICHLET_BOUNDARY(mask) (iand(mask, GLIDE_MASK_DIRICHLET_BC) == GLIDE_MASK_DIRICHLET_BC) + +!Checks whether we are at the edge of the computational domain *and* there is ice in this square + +!TODO: define from above available combinations rather than hardcode? + +! 129 = 128 + 1 +#define GLIDE_IS_COMP_DOMAIN_BND(mask) (iand(mask, 129) == 129) + +! table of common combinations: +!1 ! has ice +!3 ! has thin ice +!4 ! land +!5 = 4 + 1 ! grounded ice +!7 = 4 + 3 ! grounded thin ice +!8 ! ocean +!9 = 8 + 1 ! floating ice +!11 = 8 + 3 ! floating thin ice +!17 = 16 + 1 ! grounding line with ice +!19 = 16 + 3 ! grounding line with thin ice +!21 = 16 + 4 + 1 ! non-thin ice grounding line +!23 = 16 + 4 + 3 ! thin ice grounding line +!32 ! margin +!37 = 32 + 4 + 1 ! land margin +!39 = 32 + 4 + 3 ! land margin with thin ice +!41 = 32 + 8 + 1 ! calving margin (ocean) +!43 = 32 + 8 + 3 ! calving margin (ocean) with thin ice +!53 = 32 + 21 ! margin AND grounding line +!55 = 32 + 23 ! margin AND grounding line with thin ice + +#endif diff --git a/components/cism/glimmer-cism/libglide/glide_nan.inc b/components/cism/glimmer-cism/libglide/glide_nan.inc new file mode 100644 index 0000000000..8f54dc1a05 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_nan.inc @@ -0,0 +1,8 @@ +#ifndef GLIDE_NAN_INC +#define GLIDE_NAN_INC + +#define IS_NAN(x) ((x) /= (x)) +#define IS_INF(x) (ISNAN((x)*0)) +#define IS_POS_INF(x) (IS_INF(x) .and. ((x) > 0) +#define IS_NEG_INF(x) (IS_INF(x) .and. ((x) < 0) +#endif diff --git a/components/cism/glimmer-cism/libglide/glide_nc_custom.F90 b/components/cism/glimmer-cism/libglide/glide_nc_custom.F90 new file mode 100644 index 0000000000..6deb235fe9 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_nc_custom.F90 @@ -0,0 +1,187 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_nc_custom.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc + +module glide_nc_custom + + !module for filling in dimension variables + + use glimmer_global, only: dp + implicit none + +contains + + subroutine glide_nc_fillall(model, outfiles) + + !> fill dimension variables of all files + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + + type(glide_global_type) :: model + type(glimmer_nc_output),pointer,optional :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + if (.not.oc%append) then + call glide_nc_filldvars(oc,model) + endif + oc=>oc%next + end do + + end subroutine glide_nc_fillall + + subroutine glide_nc_filldvars(outfile, model) + + use parallel + use glide_types + use glimmer_ncdf + use glimmer_paramets, only : len0 + implicit none + + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + + integer i,status,varid + real(dp),dimension(model%general%ewn-1) :: x0 + real(dp),dimension(model%general%ewn) :: x1 + real(dp),dimension(model%general%nsn-1) :: y0 + real(dp),dimension(model%general%nsn) :: y1 + + ! check if we are still in define mode and if so leave it + if (NCO%define_mode) then + status = parallel_enddef(NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + NCO%define_mode = .FALSE. + end if + + ! horizontal dimensions + ! (x1,y1) is the unstaggered scalar grid + ! (x0,y0) is the staggered velocity grid + + if (associated(model%funits%in_first)) then + + status = parallel_inq_varid(NCO%id,'x1',varid) + status = distributed_put_var(NCO%id,varid,model%general%x1) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = parallel_inq_varid(NCO%id,'y1',varid) + status= distributed_put_var(NCO%id,varid,model%general%y1) + call nc_errorhandle(__FILE__,__LINE__,status) + + !create the x0 and y0 grids from x1 and y1 + + status = parallel_inq_varid(NCO%id,'x0',varid) + do i=1, model%general%ewn-1 + x0(i) = (model%general%x1(i)+model%general%x1(i+1))/2.0 + end do + status=distributed_put_var(NCO%id,varid,x0) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = parallel_inq_varid(NCO%id,'y0',varid) + do i=1, model%general%nsn-1 + y0(i) = (model%general%y1(i)+model%general%y1(i+1))/2.0 + end do + status = distributed_put_var(NCO%id,varid,y0) + call nc_errorhandle(__FILE__,__LINE__,status) + + else if(.not. associated(model%funits%in_first)) then + + ! filling coordinate variables + status = parallel_inq_varid(NCO%id,'x0',varid) + do i=1, model%general%ewn-1 + x0(i) = ((i-0.5)*model%numerics%dew*len0) + end do + status=distributed_put_var(NCO%id,varid,x0) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = parallel_inq_varid(NCO%id,'y0',varid) + do i=1, model%general%nsn-1 + y0(i) = (i-0.5)*model%numerics%dns*len0 + end do + status=distributed_put_var(NCO%id,varid,y0) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = parallel_inq_varid(NCO%id,'x1',varid) + do i=1, model%general%ewn + x1(i) = (i-1.)*model%numerics%dew*len0 + end do + status=distributed_put_var(NCO%id,varid,x1) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = parallel_inq_varid(NCO%id,'y1',varid) + do i=1, model%general%nsn + y1(i) = (i-1.)*model%numerics%dns*len0 + end do + status=distributed_put_var(NCO%id,varid,y1) + call nc_errorhandle(__FILE__,__LINE__,status) + + end if ! associated(model%funits%in_first) + + ! layer interfaces + + status = parallel_inq_varid(NCO%id,'level',varid) + status = parallel_put_var(NCO%id,varid,model%numerics%sigma) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! layer midpoints + + status = parallel_inq_varid(NCO%id,'staglevel',varid) + status = parallel_put_var(NCO%id,varid,model%numerics%stagsigma) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! layer midpoints, plus upper and lower surfaces + ! (e.g., temperature field in HO dycore) + + status = parallel_inq_varid(NCO%id,'stagwbndlevel',varid) + status = parallel_put_var(NCO%id,varid,model%numerics%stagwbndsigma) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! lithosphere vertical coordinate + + if (model%options%gthf == GTHF_COMPUTE) then + status = parallel_inq_varid(NCO%id,'lithoz',varid) + status= parallel_put_var(NCO%id,varid,model%lithot%deltaz) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + end subroutine glide_nc_filldvars + +end module glide_nc_custom diff --git a/components/cism/glimmer-cism/libglide/glide_nonlin.F90 b/components/cism/glimmer-cism/libglide/glide_nonlin.F90 new file mode 100644 index 0000000000..19c443a262 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_nonlin.F90 @@ -0,0 +1,266 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_nonlin.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!Contains helper functions for nonlinear iteration, both to embed in the +!iteration loop and to serialize the data into the vector format that these +!functions require. +!Currently only unstable manifold correction is implemented. + +module glide_nonlin + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + implicit none + +contains + + subroutine check_vector_size(start, veclen, ni, nj, nk) + use glimmer_log + integer :: start, veclen, ni, nj, nk + character(256) :: message + if (ni*nj*nk > veclen - start + 1) then + write(message, *) "Need ",ni*nj*nk," elements in vector, starting from element ",start," only have ",veclen - start+1 + call write_log(message, GM_FATAL) + end if + end subroutine + + + subroutine linearize_3d(vector, start, field) + use glimmer_paramets, only: GLC_DEBUG + real(dp), dimension(:) :: vector + integer :: start + real(dp), dimension(:,:,:) :: field + integer :: ni, nj, nk + integer :: i,j,k + + ni = size(field, 1) + nj = size(field, 2) + nk = size(field, 3) + if (GLC_DEBUG) then + call check_vector_size(start, size(vector), ni, nj, nk) + end if + do i=1,ni + do j=1,nj + do k=1,nk + vector(start) = field(i,j,k) + start = start + 1 + end do + end do + end do + end subroutine + + subroutine linearize_2d(vector, start, field) + use glimmer_paramets, only: GLC_DEBUG + real(dp), dimension(:) :: vector + integer :: start + real(dp), dimension(:,:) :: field + integer :: ni, nj + integer :: i,j + + ni = size(field, 1) + nj = size(field, 2) + if (GLC_DEBUG) then + call check_vector_size(start, size(vector), ni, nj, 1) + end if + do i=1,ni + do j=1,nj + vector(start) = field(i,j) + start = start + 1 + end do + end do + end subroutine + + subroutine delinearize_3d(vector, start, field) + real(dp), dimension(:) :: vector + integer :: start + real(dp), dimension(:,:,:) :: field + integer :: ni, nj, nk + integer :: i,j,k + + ni = size(field, 1) + nj = size(field, 2) + nk = size(field, 3) + + do i=1,ni + do j=1,nj + do k=1,nk + field(i,j,k) = vector(start) + start = start + 1 + end do + end do + end do + end subroutine + + subroutine delinearize_2d(vector, start, field) + real(dp), dimension(:) :: vector + integer :: start + real(dp), dimension(:,:) :: field + integer :: ni, nj + integer :: i,j + + ni = size(field, 1) + nj = size(field, 2) + + do i=1,ni + do j=1,nj + field(i,j) = vector(start) + start = start + 1 + end do + end do + end subroutine + + function picard_iterate(vec_new, vec_old, vec_size, toler, tot_out) + logical :: picard_iterate + + real(dp), dimension(:), intent(in) :: vec_new + real(dp), dimension(:), intent(inout) :: vec_old + integer :: vec_size + real(dp) :: toler + real(dp), optional, intent(out) :: tot_out + + real(dp) :: err, norm1, norm2 + + norm1 = sqrt(sum(vec_new**2)) + norm2 = sqrt(sum((vec_new-vec_old)**2)) + + err = norm2/(norm1 + 1d-10) + picard_iterate = err >= toler + + vec_old = vec_new + + if (present(tot_out)) then + tot_out = err + end if + end function picard_iterate + + function unstable_manifold_correction(vec_new, vec_old, vec_correction, & + vec_size, toler, tot_out, theta_out) + logical :: unstable_manifold_correction + + real(dp), dimension(:), intent(in) :: vec_new + real(dp), dimension(:), intent(inout) :: vec_old + real(dp), dimension(:), intent(inout) :: vec_correction + integer :: vec_size + real(dp) :: toler + real(dp), optional, intent(out) :: tot_out + real(dp), optional, intent(out) :: theta_out + + real(dp) :: norm1, norm2, norm3, norm4, norm5 + real(dp) :: tot + real(dp) :: theta + real(dp) :: alpha + integer :: i + real(dp) :: vmean + real(dp) :: vstd + + real(dp), dimension(vec_size) :: vec_correction_new + + !Assume we need to iterate again until proven otherwise + unstable_manifold_correction = .true. + + norm1 = 0.d0 + norm2 = 0.d0 + norm3 = 0.d0 + norm4 = 0.d0 + norm5 = 0.d0 + + vec_correction_new = vec_new(1:vec_size) - vec_old(1:vec_size) + + do i = 1, vec_size + vmean = vmean + abs(vec_correction_new(i)) + end do + vmean = vmean / vec_size + + do i = 1, vec_size + vstd = vstd + (vec_correction_new(i) - vmean)**2 + end do + vstd = sqrt(vstd/vec_size) + + do i = 1,vec_size + norm1 = norm1 + (vec_correction_new(i) - vec_correction(i)) ** 2 + norm2 = norm2 + vec_correction(i) ** 2 + !if (abs(vec_correction_new(i)) > vmean * 4. * vstd) then + !else + norm3 = norm3 + vec_correction_new(i) ** 2 + !endif + norm4 = norm4 + vec_correction(i) * vec_correction_new(i) + norm5 = norm5 + vec_new(i) ** 2 + end do + + !Compute the angle between successive correction vectors + if ((abs(norm2) < 1d-10) .or. (abs(norm3) < 1d-10)) then + theta=pi/2. + else + theta=acos(norm4/sqrt(norm2*norm3)) + endif + + if ( (theta <= (5.*pi/6.) ) ) then + !We've requested unstable manifold correction, and the angle is + !small (less than 5pi/6, a value identified by Hindmarsh and Payne + !to work well). If this is the case, we compute and apply + !a correction vector. + + !Compute the error between the last two *correction vectors* (not + !the last two iteration values!) (See (51) in Pattyn's paper) + if (abs(norm2) > 0.) then !We're just avoiding a divide by 0 here + alpha=sqrt(norm1/norm2) + else + alpha=1. + endif + + if (alpha < 1.e-6) then + !If the correction vector didn't change much, we're done + unstable_manifold_correction = .false. + else + !Update the previous guess of the velocity with the correction + !vector. This throws out the current iteration's computed + !velocity, and instead uses the computed correction vector. + vec_old = vec_old + vec_correction_new / alpha + vec_correction = vec_correction_new + + endif + else + !Copy this iteration's new values to the old values + !for the next iteration - because the angle between correction + !vectors is large we do not want to apply a correction, so + !we just go Picard instead + vec_old = vec_new + vec_correction = vec_correction_new + endif + + tot=sqrt(norm3/(norm5+1d-10)) !Regularize the denominator so we don't get NAN with simple geometries + + if (present(tot_out)) then + tot_out = tot + end if + + if (present(theta_out)) then + theta_out = theta * 180 / pi + end if + + if (tot < toler) unstable_manifold_correction = .false. + end function unstable_manifold_correction +end module glide_nonlin diff --git a/components/cism/glimmer-cism/libglide/glide_profile.F90 b/components/cism/glimmer-cism/libglide/glide_profile.F90 new file mode 100644 index 0000000000..a76204cb6d --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_profile.F90 @@ -0,0 +1,102 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_profile.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + + ! This module and (profile.F90) is needed for both the Glimmer 1.x profiling functionality + ! and the newer GPTL profiling functionality added by Pat Worley during the SEACISM project. + ! When GPTL profiling is enabled some of the below routines are used and others + ! are ifdef'ed out to allow GPTL-enabled versions to be used instead. + ! Currently, the old Glimmer 1.x profiling functionality does nothing more than + ! print the total run time, and should eventually be deprecated, at which point + ! the glide_profile.F90 and profile.F90 modules could be cleaned up. + +module glide_profile + + ! profiling for glide + + implicit none + +contains + + subroutine glide_prof_init(model) + + ! initialise glide profiling + use profile + use glide_types + implicit none + + type(glide_global_type) :: model !> model instance + + if (model%profile%profile_unit == 0) then + call profile_init(model%profile,'glide.profile') +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + write(model%profile%profile_unit,*) '# take a profile every ',model%numerics%profile_period,' time steps' +#endif + end if + + ! registering glide profiles + model%glide_prof%geomderv = profile_register(model%profile,'horizontal derivatives') + model%glide_prof%hvelos = profile_register(model%profile,'horizontal velocities') + model%glide_prof%ice_mask1 = profile_register(model%profile,'ice mask 1') + model%glide_prof%temperature = profile_register(model%profile,'temperature') + model%glide_prof%ice_evo = profile_register(model%profile,'ice evolution') + model%glide_prof%ice_mask2 = profile_register(model%profile,'ice mask 2') + model%glide_prof%isos_water = profile_register(model%profile,'isostasy water') + model%glide_prof%isos = profile_register(model%profile,'isostasy') + end subroutine glide_prof_init + + subroutine glide_prof_start(model,profn) + !> start logging profile + use profile + use glide_types + implicit none + type(glide_global_type) :: model !> model instance + integer, intent(in) :: profn !> profile number + + call profile_start(model%profile,profn) + end subroutine glide_prof_start + + subroutine glide_prof_stop(model,profn) + !> write message to profile + use profile + use glide_types + implicit none + type(glide_global_type) :: model !> model instance + integer, intent(in) :: profn !> profile number + + !local variables + character (len=20) :: timestring + + call profile_stop(model%profile,profn) + if (mod(model%numerics%timecounter,model%numerics%profile_period)==0) then + write(timestring,*) real(model%numerics%time) + call profile_log(model%profile,profn,trim(timestring)) + end if + end subroutine glide_prof_stop +end module glide_profile diff --git a/components/cism/glimmer-cism/libglide/glide_setup.F90 b/components/cism/glimmer-cism/libglide/glide_setup.F90 new file mode 100644 index 0000000000..d7801a2d48 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_setup.F90 @@ -0,0 +1,1775 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_setup.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glide_setup + + ! general routines for initialisation, etc, called from top-level glimmer subroutines + + use glimmer_global, only: dp + + implicit none + + private + public :: glide_readconfig, glide_printconfig, glide_scale_params, & + glide_load_sigma, glide_read_sigma, glide_calc_sigma + +!------------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------- + + subroutine glide_readconfig(model,config) + + ! read GLIDE configuration file + ! Note: sigma coordinates are handled by a subsequent call to glide_read_sigma + + use glide_types + use glimmer_config + implicit none + type(glide_global_type) :: model !> model instance + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + + ! read grid size parameters + call GetSection(config,section,'grid') + if (associated(section)) then + call handle_grid(section, model) + end if + + ! read time parameters + call GetSection(config,section,'time') + if (associated(section)) then + call handle_time(section, model) + end if + + ! read options parameters + call GetSection(config,section,'options') + if (associated(section)) then + call handle_options(section, model) + end if + + !read options for higher-order computation + call GetSection(config,section,'ho_options') + if (associated(section)) then + call handle_ho_options(section, model) + end if + + !read options for computation using an external dycore -- Doug Ranken 04/20/12 + call GetSection(config,section,'external_dycore_options') + if (associated(section)) then + call handle_dycore_options(section, model) + end if + + ! read parameters + call GetSection(config,section,'parameters') + if (associated(section)) then + call handle_parameters(section, model) + end if + + ! read GTHF + ! NOTE: The [GTHF] section is ignored unless model%options%gthf = GTHF_COMPUTE + if (model%options%gthf == GTHF_COMPUTE) then + call GetSection(config,section,'GTHF') + if (associated(section)) then + call handle_gthf(section, model) + end if + endif + + ! read isostasy + ! NOTE: The [isostasy] section is ignored unless model%options%isostasy = ISOSTASY_COMPUTE + if (model%options%isostasy == ISOSTASY_COMPUTE) then + call GetSection(config,section,'isostasy') + if (associated(section)) then + call handle_isostasy(section, model) + end if + endif + + ! Till options are not currently supported + ! read till parameters +!! call GetSection(config,section,'till_options') +!! if (associated(section)) then +!! call handle_till_options(section, model) +!! end if + + ! Construct the list of necessary restart variables based on the config options + ! selected by the user in the config file. + ! (Glint restart variables are handled separately by Glint setup routines.) + ! This is done regardless of whether or not a restart ouput file is going + ! to be created for this run, but this information is needed before setting up outputs. MJH 1/17/13 + + call define_glide_restart_variables(model%options) + + end subroutine glide_readconfig + +!------------------------------------------------------------------------- + + subroutine glide_printconfig(model) + + !> print model configuration to log + use glimmer_log + use glide_types + implicit none + type(glide_global_type) :: model !> model instance + + call write_log_div + call print_grid(model) + call print_time(model) + call print_options(model) + call print_parameters(model) + call print_gthf(model) + call print_isostasy(model) +!! call print_till_options(model) ! disabled for now + + end subroutine glide_printconfig + +!------------------------------------------------------------------------- + + subroutine glide_scale_params(model) + !> scale parameters + use glide_types + use glimmer_physcon, only: scyr + + use glimmer_physcon, only: gn + use glimmer_paramets, only: thk0, tim0, len0, vel0, vis0, acc0, tau0 + + implicit none + + type(glide_global_type) :: model !> model instance + + model%numerics%dttem = model%numerics%ntem * model%numerics%tinc + + ! convert dt and dttem to scaled time units + model%numerics%dt = model%numerics%tinc * scyr / tim0 + model%numerics%dttem = model%numerics%dttem * scyr / tim0 + + ! allow for subcycling of ice transport + model%numerics%dt_transport = model%numerics%dt / real(model%numerics%subcyc, dp) + + model%numerics%thklim = model%numerics%thklim / thk0 + model%numerics%thklim_temp = model%numerics%thklim_temp / thk0 + + model%numerics%dew = model%numerics%dew / len0 + model%numerics%dns = model%numerics%dns / len0 + + model%numerics%mlimit = model%numerics%mlimit / thk0 + + model%numerics%periodic_offset_ew = model%numerics%periodic_offset_ew / thk0 + model%numerics%periodic_offset_ns = model%numerics%periodic_offset_ns / thk0 + + model%velowk%trc0 = vel0 * len0 / (thk0**2) + model%velowk%btrac_const = model%paramets%btrac_const/model%velowk%trc0/scyr + model%velowk%btrac_max = model%paramets%btrac_max / model%velowk%trc0/scyr + model%velowk%btrac_slope = model%paramets%btrac_slope*acc0/model%velowk%trc0 + + model%paramets%ho_beta_const = model%paramets%ho_beta_const / (tau0/(vel0*scyr)) + + end subroutine glide_scale_params + +!------------------------------------------------------------------------- + + subroutine glide_read_sigma(model,config) + + ! read sigma levels from configuration file, if present + ! called immediately after glide_readconfig + + use glide_types + use glimmer_config + use glimmer_log + implicit none + + type(glide_global_type) :: model !> model instance + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + + ! read sigma levels + ! NOTE: The [sigma] section is ignored unless model%options%which_sigma = SIGMA_CONFIG + + if (model%options%which_sigma == SIGMA_CONFIG) then + call GetSection(config,section,'sigma') + if (associated(section)) then + call handle_sigma(section, model) + else + model%options%which_sigma = SIGMA_COMPUTE_GLIDE ! default to standard sigma levels + call write_log('No [sigma] section present; will compute standard Glide sigma levels') + end if + endif + + end subroutine glide_read_sigma + +!------------------------------------------------------------------------- + + subroutine glide_load_sigma(model,unit) + + ! Compute sigma coordinates or read them from a file + ! Note: This subroutine is called from glide_initialise or glissade_initialise. + ! If sigma levels are provided in the config file, then they are read + ! in by glide_read_sigma, and model%options%which_sigma is set to + ! SIGMA_CONFIG, in which case this subroutine does nothing. + + use glide_types + use glimmer_log + use glimmer_filenames + use parallel + + implicit none + + ! Arguments + type(glide_global_type),intent(inout) :: model !> Ice model to use + integer, intent(in) :: unit !> Logical file unit to use. + !> (Must not already be in use) + + ! Internal variables + + integer :: up,upn + logical :: there + real(dp) :: level + + ! Beginning of code + + upn=model%general%upn + + select case(model%options%which_sigma) + + case(SIGMA_COMPUTE_GLIDE) ! compute standard Glide sigma levels + + do up = 1,upn + level = real(up-1,kind=dp) / real(upn-1,kind=dp) + model%numerics%sigma(up) = glide_calc_sigma(level, 2.d0) + end do + + call write_log('Computing Glide sigma levels') + + case(SIGMA_EXTERNAL) ! read from external file + + if (main_task) inquire (exist=there, file=process_path(model%funits%sigfile)) + call broadcast(there) + if (.not.there) then + call write_log('Sigma levels file: '//trim(process_path(model%funits%sigfile))// & + ' does not exist',GM_FATAL) + end if + call write_log('Reading sigma file: '//process_path(model%funits%sigfile)) + if (main_task) then + open(unit,file=process_path(model%funits%sigfile)) + read(unit,'(f9.7)',err=10,end=10) (model%numerics%sigma(up), up=1,upn) + close(unit) + end if + call broadcast(model%numerics%sigma) + + case(SIGMA_CONFIG) ! read from config file + + ! sigma levels have already been read from glide_read_sigma + + call write_log('Getting sigma levels from configuration file') + + case(SIGMA_COMPUTE_EVEN) + + do up = 1,upn + model%numerics%sigma(up) = real(up-1,kind=dp) / real(upn-1,kind=dp) + enddo + + call write_log('Computing evenly spaced sigma levels') + + case(SIGMA_COMPUTE_PATTYN) + + do up = 1,upn + if (up == 1) then + model%numerics%sigma(up) = 0.d0 + else if (up == upn) then + model%numerics%sigma(up) = 1.d0 + else + level = real(up-1,kind=dp) / real(upn-1,kind=dp) + model%numerics%sigma(up) = glide_calc_sigma_pattyn(level) + end if + enddo + + call write_log('Computing Pattyn sigma levels') + + end select + + + !NOTE: Glam will always use evenly spaced levels, + ! overriding other values of which_sigma + ! (including sigma levels in config file) + + if (model%options%whichdycore == DYCORE_GLAM) then ! evenly spaced levels are required + + do up = 1,upn + model%numerics%sigma(up) = real(up-1,kind=dp) / real(upn-1,kind=dp) + enddo + + call write_log('Using evenly spaced sigma levels for Glam as required') + + endif + + ! Compute stagsigma (= sigma values at layers midpoints) + + model%numerics%stagsigma(1:upn-1) = & + (model%numerics%sigma(1:upn-1) + model%numerics%sigma(2:upn)) / 2.0_dp + + ! Compute stagwbndsigma, adding the boundaries to stagsigma + + model%numerics%stagwbndsigma(1:upn-1) = model%numerics%stagsigma(1:upn-1) + model%numerics%stagwbndsigma(0) = 0.d0 + model%numerics%stagwbndsigma(upn) = 1.d0 + + call print_sigma(model) + + return + +10 call write_log('something wrong with sigma coord file',GM_FATAL) + + end subroutine glide_load_sigma + +!-------------------------------------------------------------------------------- + + function glide_calc_sigma(x,n) + + implicit none + real(dp) :: glide_calc_sigma, x, n + + glide_calc_sigma = (1-(x+1)**(-n)) / (1-2**(-n)) + + end function glide_calc_sigma + +!-------------------------------------------------------------------------------- + + function glide_calc_sigma_pattyn(x) + + ! Implements an alternate set of sigma levels that encourages better + ! convergence for higher-order velocities + + implicit none + real(dp) :: glide_calc_sigma_pattyn, x + + glide_calc_sigma_pattyn = & + (-2.5641025641d-4)*(41d0*x)**2+3.5256410256d-2*(41d0*x)-8.0047080075d-13 + + end function glide_calc_sigma_pattyn + +!-------------------------------------------------------------------------------- + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! private procedures + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! grid sizes + + subroutine handle_grid(section, model) + use glimmer_config + use glide_types + use glimmer_filenames + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section,'ewn',model%general%ewn) + call GetValue(section,'nsn',model%general%nsn) + call GetValue(section,'upn',model%general%upn) + call GetValue(section,'dew',model%numerics%dew) + call GetValue(section,'dns',model%numerics%dns) + call GetValue(section,'sigma_file',model%funits%sigfile) + + !WHL - added global boundary conditions + call GetValue(section,'global_bc',model%general%global_bc) + + ! We set this flag to one to indicate we've got a sigfile name. + ! A warning/error is generated if sigma levels are specified in some other way + ! and mangle the name + if (trim(model%funits%sigfile) /= '') then + model%funits%sigfile = filenames_inputname(model%funits%sigfile) + model%options%which_sigma = SIGMA_EXTERNAL + end if + + end subroutine handle_grid + +!-------------------------------------------------------------------------------- + + subroutine print_grid(model) + use glide_types + use glimmer_log + implicit none + type(glide_global_type) :: model + character(len=512) :: message + + + call write_log('Grid specification') + call write_log('------------------') + write(message,*) 'ewn : ',model%general%ewn + call write_log(trim(message)) + write(message,*) 'nsn : ',model%general%nsn + call write_log(trim(message)) + write(message,*) 'upn : ',model%general%upn + call write_log(trim(message)) + write(message,*) 'EW grid spacing : ',model%numerics%dew + call write_log(trim(message)) + write(message,*) 'NS grid spacing : ',model%numerics%dns + call write_log(trim(message)) + if (model%general%global_bc==GLOBAL_BC_PERIODIC) then + write(message,*) 'Periodic global boundary conditions' + call write_log(trim(message)) + elseif (model%general%global_bc==GLOBAL_BC_OUTFLOW) then + write(message,*) 'Outflow global boundary conditions; scalars in global halo will be set to zero' + call write_log(trim(message)) + endif + + write(message,*) 'sigma file : ',trim(model%funits%sigfile) + call write_log(trim(message)) + call write_log('') + + end subroutine print_grid + +!-------------------------------------------------------------------------------- + + ! time + subroutine handle_time(section, model) + use glimmer_config + use glide_types + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + +!TODO - Make the ice dynamic timestep more flexible. +! To handle timesteps both greater and less than one year, we may want to +! define ice_dt_option and ice_dt_count in place of the current dt. +! For instance, ice_dt_option could be either 'nyears' or 'steps_per_year'. +! For timesteps < 1 year, we would use ice_dt_option = 'steps_per_year'. +! This would ensure that the ice sheet dynamic timestep divides evenly +! into the mass balance timestep (= 1 year) when running with Glint. + call GetValue(section,'tstart',model%numerics%tstart) + call GetValue(section,'tend',model%numerics%tend) + call GetValue(section,'dt',model%numerics%tinc) + call GetValue(section,'subcyc',model%numerics%subcyc) + call GetValue(section,'ntem',model%numerics%ntem) + call GetValue(section,'profile',model%numerics%profile_period) + + call GetValue(section,'dt_diag',model%numerics%dt_diag) + call GetValue(section,'idiag',model%numerics%idiag) + call GetValue(section,'jdiag',model%numerics%jdiag) + + !WHL - ndiag replaced by dt_diag, but retained for backward compatibility + call GetValue(section,'ndiag',model%numerics%ndiag) + + end subroutine handle_time + +!-------------------------------------------------------------------------------- + + subroutine print_time(model) + use glide_types + use glimmer_log + implicit none + type(glide_global_type) :: model + character(len=100) :: message + + call write_log('Time steps') + call write_log('----------') + write(message,*) 'start time (yr) : ',model%numerics%tstart + call write_log(message) + write(message,*) 'end time (yr) : ',model%numerics%tend + call write_log(message) + write(message,*) 'time step (yr) : ',model%numerics%tinc + call write_log(message) + write(message,*) 'thermal dt factor : ',model%numerics%ntem + call write_log(message) + if ( (model%numerics%ntem < 1.0d0) .or. & + (floor(model%numerics%ntem) /= model%numerics%ntem) ) then + call write_log('ntem is a multiplier on the basic time step. It should be a positive integer. Aborting.',GM_FATAL) + endif + write(message,*) 'profile frequency : ',model%numerics%profile_period + call write_log(message) + + if (model%numerics%dt_diag > 0.d0) then + write(message,*) 'diagnostic time (yr): ',model%numerics%dt_diag + call write_log(message) + !TODO - Verify that this mod statement works for real numbers. Might need different logic. + if (mod(model%numerics%dt_diag, model%numerics%tinc) > 1.e-11) then + write(message,*) 'Warning: diagnostic interval does not divide evenly into ice timestep dt' + call write_log(message) + endif + endif + + !WHL - ndiag replaced by dt_diag, but retained for backward compatibility + if (model%numerics%ndiag > 0) then + write(message,*) 'diag time (steps) : ',model%numerics%ndiag + call write_log(message) + endif + + !WHL - Written to log in glide_init_diag +! write(message,*) 'idiag : ',model%numerics%idiag +! call write_log(message) +! write(message,*) 'jdiag : ',model%numerics%jdiag +! call write_log(message) + + call write_log('') + + end subroutine print_time + +!-------------------------------------------------------------------------------- + + ! options + subroutine handle_options(section, model) + + use glimmer_config + use glide_types + + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section,'dycore',model%options%whichdycore) + call GetValue(section,'evolution',model%options%whichevol) + call GetValue(section,'temperature',model%options%whichtemp) + call GetValue(section,'temp_init',model%options%temp_init) + call GetValue(section,'flow_law',model%options%whichflwa) + call GetValue(section,'slip_coeff',model%options%whichbtrc) + call GetValue(section,'basal_water',model%options%whichbwat) + call GetValue(section,'basal_mass_balance',model%options%basal_mbal) + call GetValue(section,'gthf',model%options%gthf) + call GetValue(section,'isostasy',model%options%isostasy) + call GetValue(section,'marine_margin',model%options%whichmarn) + call GetValue(section,'vertical_integration',model%options%whichwvel) + call GetValue(section,'topo_is_relaxed',model%options%whichrelaxed) + call GetValue(section,'periodic_ew',model%options%periodic_ew) + call GetValue(section,'sigma',model%options%which_sigma) + call GetValue(section,'ioparams',model%funits%ncfile) + + ! Both terms 'hotstart' and 'restart' are supported in the config file, + ! but if they are both supplied for some reason, then restart will be used. + ! 'restart' is the preferred term moving forward. + ! 'hotstart' is retained for backward compatability. + call GetValue(section,'hotstart',model%options%is_restart) + call GetValue(section,'restart',model%options%is_restart) + + ! These are not currently supported + !call GetValue(section, 'use_plume',model%options%use_plume) + !call GetValue(section,'basal_proc',model%options%which_bproc) + + end subroutine handle_options + +!-------------------------------------------------------------------------------- + + !Higher order options + subroutine handle_ho_options(section, model) + use glimmer_config + use glide_types + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section, 'which_ho_efvs', model%options%which_ho_efvs) + call GetValue(section, 'which_ho_disp', model%options%which_ho_disp) + call GetValue(section, 'which_ho_babc', model%options%which_ho_babc) + call GetValue(section, 'which_ho_resid', model%options%which_ho_resid) + call GetValue(section, 'which_ho_nonlinear', model%options%which_ho_nonlinear) + call GetValue(section, 'which_ho_sparse', model%options%which_ho_sparse) + call GetValue(section, 'which_ho_approx', model%options%which_ho_approx) + call GetValue(section, 'which_ho_precond', model%options%which_ho_precond) + call GetValue(section, 'which_ho_gradient', model%options%which_ho_gradient) + call GetValue(section, 'which_ho_gradient_margin', model%options%which_ho_gradient_margin) + call GetValue(section, 'which_ho_assemble_beta', model%options%which_ho_assemble_beta) + call GetValue(section, 'which_ho_ground', model%options%which_ho_ground) + call GetValue(section, 'glissade_maxiter', model%options%glissade_maxiter) + + end subroutine handle_ho_options + +!-------------------------------------------------------------------------------- + + ! Handles external dycore options -- Doug Ranken 03/26/12 + subroutine handle_dycore_options(section, model) + use glimmer_config + use glide_types + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section, 'external_dycore_type', model%options%external_dycore_type) + call GetValue(section, 'dycore_input_file', model%options%dycore_input_file) + if (model%options%external_dycore_type .eq. 1) model%options%whichdycore = 4 ! DYCORE_BISICLES + if (model%options%external_dycore_type .eq. 2) model%options%whichdycore = 3 ! DYCORE_ALBANYFELIX + + print *,"In handle_dycore_options, external dycore type, input file = ", & + model%options%external_dycore_type,model%options%dycore_input_file + ! print *,"In handle_dycore_options, whichdycore = ",model%options%whichdycore + end subroutine handle_dycore_options + +!-------------------------------------------------------------------------------- + + subroutine print_options(model) + + use glide_types + use glimmer_log + + use parallel + + implicit none + + type(glide_global_type) :: model + character(len=500) :: message + + ! basic Glide/Glimmer options + + character(len=*), dimension(0:4), parameter :: dycore = (/ & + 'glide ', & ! Glimmer SIA + 'glam ', & ! Payne-Price finite difference + 'glissade ', & ! prototype finite element + 'albany-felix ', & ! External Albany-FELIX finite element + 'bisicles ' /) ! External BISICLES-Chombo FVM + + character(len=*), dimension(0:5), parameter :: evolution = (/ & + 'pseudo-diffusion ', & + 'ADI scheme ', & + 'iterated diffusion ', & + 'incremental remapping ', & + '1st order upwind ', & + 'thickness fixed at initial value ' /) + + character(len=*), dimension(0:3), parameter :: temperature = (/ & + 'isothermal ', & + 'prognostic temperature', & + 'constant in time ', & + 'prognostic enthalpy ' /) + + character(len=*), dimension(0:2), parameter :: temp_init = (/ & + 'set to 0 C ', & + 'set to surface air temp', & + 'linear vertical profile' /) + + character(len=*), dimension(0:2), parameter :: flow_law = (/ & + 'const 1e-16 Pa^-n a^-1 ', & + 'Paterson and Budd (T = -5 C)', & + 'Paterson and Budd ' /) + + !TODO - Rename slip_coeff to something like which_btrc? + character(len=*), dimension(0:5), parameter :: slip_coeff = (/ & + 'no basal sliding ', & + 'constant basal traction', & + 'constant where bwat > 0', & + 'constant where T = Tpmp', & + 'linear function of bmlt', & + 'tanh function of bwat ' /) + + character(len=*), dimension(0:4), parameter :: basal_water = (/ & + 'none ', & + 'local water balance ', & + 'local + steady-state flux', & + 'Constant value (= 10 m) ', & + 'ocean penetration ' /) +!! 'From basal proc model '/) ! not supported + + ! basal proc model is disabled for now. +!! character(len=*), dimension(0:2), parameter :: which_bproc = (/ & +!! 'Basal proc mod disabled ' , & +!! 'Basal proc, high res. ' , & +!! 'Basal proc, fast calc. ' /) + character(len=*), dimension(0:0), parameter :: which_bproc = (/ & + 'Basal process model disabled ' /) + + character(len=*), dimension(0:1), parameter :: b_mbal = (/ & + 'not in continuity eqn', & + 'in continuity eqn ' /) + + ! NOTE: Set gthf = 1 in the config file to read the geothermal heat flux from an input file. + ! Otherwise it will be overwritten, even if the 'bheatflx' field is present. + + character(len=*), dimension(0:2), parameter :: gthf = (/ & + 'uniform geothermal flux ', & + 'read flux from file, if present ', & + 'compute flux from diffusion eqn ' /) + + ! NOTE: This option has replaced the old do_isos option + character(len=*), dimension(0:1), parameter :: isostasy = (/ & + 'no isostasy calculation ', & + 'compute isostasy with model ' /) + + character(len=*), dimension(0:5), parameter :: marine_margin = (/ & + 'do nothing at marine margin ', & + 'remove all floating ice ', & + 'remove fraction of floating ice ', & + 'relaxed bedrock threshold ', & + 'present bedrock threshold ', & + 'Huybrechts grounding line scheme' /) + + character(len=*), dimension(0:1), parameter :: vertical_integration = (/ & + 'standard ', & + 'obey upper BC' /) + + ! higher-order options + + character(len=*), dimension(0:2), parameter :: ho_whichefvs = (/ & + 'constant value ', & + 'multiple of flow factor ', & + 'nonlinear, from eff strain rate' /) + + character(len=*), dimension(-1:1), parameter :: ho_whichdisp = (/ & + 'no dissipation ', & + '0-order SIA ', & + 'first-order model (Blatter-Pattyn)' /) + + character(len=*), dimension(0:10), parameter :: ho_whichbabc = (/ & + 'constant beta ', & + 'simple pattern of beta ', & + 'till yield stress (Picard) ', & + 'function of bwat ', & + 'no slip (using large B^2) ', & + 'beta passed from CISM ', & + 'no slip (Dirichlet implementation) ', & + 'till yield stress (Newton) ', & + 'beta as in ISMIP-HOM test C ', & + 'power law using effective pressure ', & + 'Coulomb friction law using effec press ' /) + + character(len=*), dimension(0:1), parameter :: which_ho_nonlinear = (/ & + 'use standard Picard iteration ', & + 'use JFNK '/) + + character(len=*), dimension(0:4), parameter :: ho_whichresid = (/ & + 'max value ', & + 'max value ignoring ubas ', & + 'mean value ', & + 'L2 norm of Ax-b = resid ', & + 'relative L2 norm, |Ax-b|/|b|' /) + + character(len=*), dimension(-1:4), parameter :: ho_whichsparse = (/ & + 'PCG with incomplete Cholesky preconditioner', & + 'BiCG with LU preconditioner ', & + 'GMRES with LU preconditioner ', & + 'Native PCG solver, standard ', & + 'Native PCG solver, Chronopoulos-Gear ', & + 'Trilinos interface '/) + + character(len=*), dimension(-1:3), parameter :: ho_whichapprox = (/ & + 'SIA only (glissade_velo_sia) ', & + 'SIA only (glissade_velo_higher) ', & + 'SSA only (glissade_velo_higher) ', & + 'Blatter-Pattyn HO (glissade_velo_higher) ', & + 'Depth-integrated L1L2 (glissade_velo_higher)' /) + + character(len=*), dimension(0:2), parameter :: ho_whichprecond = (/ & + 'No preconditioner (glissade PCG) ', & + 'Diagonal preconditioner (glissade PCG) ', & + 'SIA preconditioner (glissade PCG) ' /) + + character(len=*), dimension(0:1), parameter :: ho_whichgradient = (/ & + 'centered gradient (glissade dycore) ', & + 'upstream gradient (glissade dycore) ' /) + + character(len=*), dimension(0:2), parameter :: ho_whichgradient_margin = (/ & + 'all neighbor cells in gradient (glissade dycore) ', & + 'ice-covered &/or land cells in gradient (glissade dycore)', & + 'only ice-covered cells in gradient (glissade dycore) ' /) + + character(len=*), dimension(0:1), parameter :: ho_whichassemble_beta = (/ & + 'standard finite-element assembly (glissade dycore) ', & + 'use local beta for assembly (glissade dycore) ' /) + + character(len=*), dimension(0:2), parameter :: ho_whichground = (/ & + 'f_ground = 0 or 1; no GLP (glissade dycore) ', & + 'f_ground = 1 for all active cells (glissade dycore)', & + '0 <= f_ground <= 1, based on GLP (glissade dycore) ' /) + + call write_log('GLIDE options') + call write_log('-------------') + + write(message,*) 'I/O parameter file : ',trim(model%funits%ncfile) + call write_log(message) + + if (model%options%whichdycore < 0 .or. model%options%whichdycore >= size(dycore)) then + call write_log('Error, dycore option out of range',GM_FATAL) + end if + write(message,*) 'Dycore : ',model%options%whichdycore,dycore(model%options%whichdycore) + call write_log(message) + + ! unsupported dycore options + if (model%options%whichdycore == DYCORE_GLAM) then + call write_log('Glam dycore is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%whichdycore == DYCORE_ALBANYFELIX) then + call write_log('Albany-FELIX dycore is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%whichdycore == DYCORE_BISICLES) then + call write_log('BISICLES dycore is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + ! Forbidden options associated with the Glide dycore + if (model%options%whichdycore == DYCORE_GLIDE) then + + if (model%options%whichevol==EVOL_INC_REMAP .or. & + model%options%whichevol==EVOL_UPWIND .or. & + model%options%whichevol==EVOL_NO_THICKNESS) then + call write_log('Error, Glam/glissade thickness evolution options cannot be used with Glide dycore', GM_FATAL) + endif + + if (model%options%whichtemp == TEMP_ENTHALPY) then + call write_log('Error, Enthalpy scheme cannot be used with Glide dycore', GM_FATAL) + endif + + if (tasks > 1) then + call write_log('Error, Glide dycore not supported for runs with more than one processor', GM_FATAL) + end if + + if (model%options%whichevol==EVOL_ADI) then + call write_log('Warning, exact restarts are not currently possible with ADI evolution', GM_WARNING) + endif + + else ! forbidden evolution options with dycores other than Glide + + if (model%options%whichevol==EVOL_PSEUDO_DIFF .or. & + model%options%whichevol==EVOL_ADI .or. & + model%options%whichevol==EVOL_DIFFUSION) then + call write_log('Error, Glide thickness evolution options cannot be used with glam/glissade dycore', GM_FATAL) + endif + + endif + + ! Forbidden options for running in parallel + if (tasks > 1 .and. (model%options%which_ho_sparse==HO_SPARSE_BICG .or. & + model%options%which_ho_sparse==HO_SPARSE_GMRES .or. & + model%options%which_ho_sparse==HO_SPARSE_PCG_INCH) ) then + call write_log('Error, SLAP solver not supported for more than one processor', GM_FATAL) + end if + + if (tasks > 1 .and. model%options%which_ho_babc==HO_BABC_ISHOMC) then + call write_log('Error, ISHOM basal BCs not supported for more than one processor', GM_FATAL) + endif + + if (tasks > 1 .and. model%options%whichbwat==BWATER_FLUX) then + call write_log('Error, flux-based basal water option not supported for more than one processor', GM_FATAL) + endif + + ! Forbidden options associated with Glam and Glissade dycores + + if (model%options%whichdycore == DYCORE_GLISSADE) then + if ( (model%options%which_ho_approx == HO_APPROX_SSA .or. & + model%options%which_ho_approx == HO_APPROX_L1L2) & + .and. & + (model%options%which_ho_sparse == HO_SPARSE_PCG_STANDARD .or. & + model%options%which_ho_sparse == HO_SPARSE_PCG_CHRONGEAR) ) then + if (model%options%which_ho_precond == HO_PRECOND_SIA) then + call write_log('Error, cannot use SIA preconditioning for 2D solve', GM_FATAL) + endif + endif + endif + + if (model%options%whichdycore == DYCORE_GLISSADE) then + if ( model%options%which_ho_approx == HO_APPROX_LOCAL_SIA .and. & + model%options%which_ho_disp == HO_DISP_FIRSTORDER ) then + call write_log('Error, cannot use first-order dissipation with local SIA solver', GM_FATAL) + endif + endif + + if (model%options%whichdycore /= DYCORE_GLISSADE) then + if (model%options%which_ho_sparse == HO_SPARSE_PCG_STANDARD .or. & + model%options%which_ho_sparse == HO_SPARSE_PCG_CHRONGEAR) then + call write_log('Error, native PCG solver requires glissade dycore', GM_FATAL) + endif + endif + + if (model%options%whichdycore == DYCORE_GLAM) then + if (model%options%which_ho_approx == HO_APPROX_LOCAL_SIA .or. & + model%options%which_ho_approx == HO_APPROX_SIA .or. & + model%options%which_ho_approx == HO_APPROX_SSA .or. & + model%options%which_ho_approx == HO_APPROX_L1L2) then + call write_log('Error, Glam dycore must use higher-order Blatter-Pattyn approximation', GM_FATAL) + endif + endif + + ! Config specific to Albany-Felix dycore + if (model%options%whichdycore == DYCORE_ALBANYFELIX) then + call write_log('Warning, Albany-FELIX dycore requires external libraries, and it is still in development!!!', GM_WARNING) + endif + + !NOTE : Old option 3 (TEMP_REMAP_ADV) has been removed. + ! If this has been set, then change to option 1 (TEMP_PROGNOSTIC), which applies to any dycore. + + if (model%options%whichtemp < 0 .or. model%options%whichtemp >= size(temperature)) then + call write_log('Error, temperature option out of range',GM_FATAL) + end if + write(message,*) 'temperature calculation : ',model%options%whichtemp,temperature(model%options%whichtemp) + call write_log(message) + + ! unsupported temperature options + if (model%options%whichtemp == TEMP_ENTHALPY) then + call write_log('Enthalpy-based formulation for solving temperature evolution is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + if (model%options%temp_init < 0 .or. model%options%temp_init >= size(temp_init)) then + call write_log('Error, temp_init option out of range',GM_FATAL) + end if + ! Note: If reading temperature from an input or restart file, the temp_init option is overridden, + ! in which case it could be confusing here to write the option to the log file. + ! The method actually used is written to the log file by glide_init_temp. + + if (model%options%whichflwa < 0 .or. model%options%whichflwa >= size(flow_law)) then + call write_log('Error, flow_law out of range',GM_FATAL) + end if + write(message,*) 'flow law : ',model%options%whichflwa,flow_law(model%options%whichflwa) + call write_log(message) + + if (model%options%whichbwat < 0 .or. model%options%whichbwat >= size(basal_water)) then + call write_log('Error, basal_water out of range',GM_FATAL) + end if + write(message,*) 'basal_water : ',model%options%whichbwat,basal_water(model%options%whichbwat) + call write_log(message) + + ! unsupported basal_water options + if (model%options%whichbwat == BWATER_FLUX) then + call write_log('Steady state routing basal_water option is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%whichbwat == BWATER_OCEAN_PENETRATION) then + call write_log('Ocean penetration basal_water option is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + if (model%options%whichmarn < 0 .or. model%options%whichmarn >= size(marine_margin)) then + call write_log('Error, marine_margin out of range',GM_FATAL) + end if + write(message,*) 'marine_margin : ', model%options%whichmarn, marine_margin(model%options%whichmarn) + call write_log(message) + + if (model%options%whichbtrc < 0 .or. model%options%whichbtrc >= size(slip_coeff)) then + call write_log('Error, slip_coeff out of range',GM_FATAL) + end if + + !WHL - Currently, not all basal traction options are supported for the Glissade SIA solver + if (model%options%whichdycore == DYCORE_GLISSADE .and. model%options%which_ho_approx == HO_APPROX_LOCAL_SIA) then + if (model%options%whichbtrc > BTRC_CONSTANT_TPMP) then + call write_log('Error, slip_coeff out of range for Glissade dycore',GM_FATAL) + end if + endif + + write(message,*) 'slip_coeff : ', model%options%whichbtrc, slip_coeff(model%options%whichbtrc) + call write_log(message) + + if (model%options%whichevol < 0 .or. model%options%whichevol >= size(evolution)) then + call write_log('Error, evolution out of range',GM_FATAL) + end if + + write(message,*) 'evolution : ', model%options%whichevol, evolution(model%options%whichevol) + call write_log(message) + + if (model%options%whichwvel < 0 .or. model%options%whichwvel >= size(vertical_integration)) then + call write_log('Error, vertical_integration out of range',GM_FATAL) + end if + + if (model%options%whichwvel /= VERTINT_STANDARD .and. model%options%whichdycore /= DYCORE_GLIDE) then + call write_log('Error, only standard vertical velocity calculation is supported for higher-order dycores.',GM_FATAL) + end if + + write(message,*) 'vertical_integration : ',model%options%whichwvel,vertical_integration(model%options%whichwvel) + call write_log(message) + + if (model%options%basal_mbal < 0 .or. model%options%basal_mbal >= size(b_mbal)) then + call write_log('Error, basal_mass_balance out of range',GM_FATAL) + end if + + write(message,*) 'basal_mass_balance : ',model%options%basal_mbal,b_mbal(model%options%basal_mbal) + call write_log(message) + + if (model%options%gthf < 0 .or. model%options%gthf >= size(gthf)) then + print*, 'gthf =', model%options%gthf + call write_log('Error, geothermal flux option out of range',GM_FATAL) + end if + + write(message,*) 'geothermal heat flux : ',model%options%gthf,gthf(model%options%gthf) + call write_log(message) + + if (model%options%isostasy < 0 .or. model%options%isostasy >= size(isostasy)) then + print*, 'isostasy =', model%options%isostasy + call write_log('Error, isostasy option out of range',GM_FATAL) + end if + + write(message,*) 'isostasy : ',model%options%isostasy,isostasy(model%options%isostasy) + call write_log(message) + + if (model%options%whichrelaxed==1) then + call write_log('First topo time slice has relaxed bedrock topography') + end if + + if (model%options%periodic_ew) then + if (model%options%whichevol == EVOL_ADI) then + call write_log('Periodic boundary conditions not implemented in ADI scheme',GM_FATAL) + end if + call write_log('Periodic EW lateral boundary condition') + call write_log(' Slightly cheated with how temperature is implemented.',GM_WARNING) + end if + + if (model%options%is_restart == RESTART_TRUE) then + call write_log('Restarting model from a previous run') + end if + +!! This option is not currently supported +!! if (model%options%which_bproc < 0 .or. model%options%which_bproc >= size(which_bproc)) then +!! call write_log('Error, basal_proc out of range',GM_FATAL) +!! end if +!! write(message,*) 'basal_proc : ',model%options%which_bproc,which_bproc(model%options%which_bproc) +!! call write_log(message) + + !HO options + + if (model%options%whichdycore /= DYCORE_GLIDE) then ! glam/glissade higher-order + + call write_log(' ') + call write_log('Higher-order options:') + call write_log('----------') + + write(message,*) 'ho_whichefvs : ',model%options%which_ho_efvs, & + ho_whichefvs(model%options%which_ho_efvs) + call write_log(message) + if (model%options%which_ho_efvs < 0 .or. model%options%which_ho_efvs >= size(ho_whichefvs)) then + call write_log('Error, HO effective viscosity input out of range', GM_FATAL) + end if + + write(message,*) 'ho_whichdisp : ',model%options%which_ho_disp, & + ho_whichdisp(model%options%which_ho_disp) + call write_log(message) + if (model%options%which_ho_disp < -1 .or. model%options%which_ho_disp >= size(ho_whichdisp)-1) then + call write_log('Error, HO dissipation input out of range', GM_FATAL) + end if + + write(message,*) 'ho_whichbabc : ',model%options%which_ho_babc, & + ho_whichbabc(model%options%which_ho_babc) + call write_log(message) + if (model%options%which_ho_babc < 0 .or. model%options%which_ho_babc >= size(ho_whichbabc)) then + call write_log('Error, HO basal BC input out of range', GM_FATAL) + end if + ! unsupported ho-babc options + if (model%options%which_ho_babc == HO_BABC_YIELD_NEWTON) then + call write_log('Yield stress higher-order basal boundary condition is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%which_ho_babc == HO_BABC_POWERLAW) then + call write_log('Weertman-style power law higher-order basal boundary condition is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) then + call write_log('Coulomb friction law higher-order basal boundary condition is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + write(message,*) 'which_ho_nonlinear : ',model%options%which_ho_nonlinear, & + which_ho_nonlinear(model%options%which_ho_nonlinear) + call write_log(message) + if (model%options%which_ho_nonlinear < 0 .or. model%options%which_ho_nonlinear >= size(which_ho_nonlinear)) then + call write_log('Error, HO nonlinear solution input out of range', GM_FATAL) + end if + ! unsupported nonlinear options + if (model%options%which_ho_nonlinear == HO_NONLIN_JFNK) then + call write_log('JFNK treatment of nonlinearity in momentum balance is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + write(message,*) 'ho_whichresid : ',model%options%which_ho_resid, & + ho_whichresid(model%options%which_ho_resid) + call write_log(message) + if (model%options%which_ho_resid < 0 .or. model%options%which_ho_resid >= size(ho_whichresid)) then + call write_log('Error, HO residual input out of range', GM_FATAL) + end if + ! unsupported resid options + if (model%options%which_ho_resid == HO_RESID_MAXU) then + call write_log('Residual as max. value of normalized velocity vector update is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%which_ho_resid == HO_RESID_MAXU_NO_UBAS) then + call write_log('Residual as max. value of normalized velocity vector update with basal velocity omitted is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + if (model%options%which_ho_resid == HO_RESID_MEANU) then + call write_log('Residual as mean value of normalized velocity vector update is not currently scientifically supported. USE AT YOUR OWN RISK.', GM_WARNING) + endif + + write(message,*) 'ho_whichsparse : ',model%options%which_ho_sparse, & + ho_whichsparse(model%options%which_ho_sparse) + call write_log(message) + if (model%options%which_ho_sparse < -1 .or. model%options%which_ho_sparse >= size(ho_whichsparse)) then + call write_log('Error, HO sparse solver input out of range', GM_FATAL) + end if + + if (model%options%whichdycore == DYCORE_GLISSADE) then + + write(message,*) 'ho_whichapprox : ',model%options%which_ho_approx, & + ho_whichapprox(model%options%which_ho_approx) + call write_log(message) + if (model%options%which_ho_approx < -1 .or. model%options%which_ho_approx >= size(ho_whichapprox)-1) then + call write_log('Error, Stokes approximation out of range for glissade dycore', GM_FATAL) + end if + + write(message,*) 'ho_whichgradient : ',model%options%which_ho_gradient, & + ho_whichgradient(model%options%which_ho_gradient) + call write_log(message) + if (model%options%which_ho_gradient < 0 .or. model%options%which_ho_gradient >= size(ho_whichgradient)) then + call write_log('Error, gradient option out of range for glissade dycore', GM_FATAL) + end if + + write(message,*) 'ho_whichgradient_margin : ',model%options%which_ho_gradient_margin, & + ho_whichgradient_margin(model%options%which_ho_gradient_margin) + call write_log(message) + if (model%options%which_ho_gradient_margin < 0 .or. & + model%options%which_ho_gradient_margin >= size(ho_whichgradient_margin)) then + call write_log('Error, gradient margin option out of range for glissade dycore', GM_FATAL) + end if + + write(message,*) 'ho_whichassemble_beta : ',model%options%which_ho_assemble_beta, & + ho_whichassemble_beta(model%options%which_ho_assemble_beta) + call write_log(message) + if (model%options%which_ho_assemble_beta < 0 .or. & + model%options%which_ho_assemble_beta >= size(ho_whichassemble_beta)) then + call write_log('Error, beta assembly option out of range for glissade dycore', GM_FATAL) + end if + + write(message,*) 'ho_whichground : ',model%options%which_ho_ground, & + ho_whichground(model%options%which_ho_ground) + call write_log(message) + if (model%options%which_ho_ground < 0 .or. model%options%which_ho_ground >= size(ho_whichground)) then + call write_log('Error, ground option out of range for glissade dycore', GM_FATAL) + end if + + write(message,*) 'glissade_maxiter : ',model%options%glissade_maxiter + call write_log(message) + + end if + + if (model%options%whichdycore == DYCORE_GLISSADE .and. & + (model%options%which_ho_sparse == HO_SPARSE_PCG_STANDARD .or. & + model%options%which_ho_sparse == HO_SPARSE_PCG_CHRONGEAR) ) then + write(message,*) 'ho_whichprecond : ',model%options%which_ho_precond, & + ho_whichprecond(model%options%which_ho_precond) + call write_log(message) + if (model%options%which_ho_precond < 0 .or. model%options%which_ho_precond >= size(ho_whichprecond)) then + call write_log('Error, glissade preconditioner out of range', GM_FATAL) + end if + end if + + endif ! whichdycore + + end subroutine print_options + +!-------------------------------------------------------------------------------- + + ! parameters + subroutine handle_parameters(section, model) + + use glimmer_config + use glide_types + use glimmer_log + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + real(dp), pointer, dimension(:) :: tempvar => NULL() + integer :: loglevel + + loglevel = GM_levels-GM_ERROR + + !TODO - Change default_flwa to flwa_constant? Would have to change config files. + ! Change flow_factor to flow_enhancement_factor? Would have to change many SIA config files + call GetValue(section,'log_level',loglevel) + call glimmer_set_msg_level(loglevel) + call GetValue(section,'ice_limit', model%numerics%thklim) + call GetValue(section,'ice_limit_temp', model%numerics%thklim_temp) + call GetValue(section,'marine_limit', model%numerics%mlimit) + call GetValue(section,'calving_fraction', model%numerics%calving_fraction) + call GetValue(section,'geothermal', model%paramets%geot) + call GetValue(section,'flow_factor', model%paramets%flow_enhancement_factor) + call GetValue(section,'default_flwa', model%paramets%default_flwa) + call GetValue(section,'efvs_constant', model%paramets%efvs_constant) + call GetValue(section,'hydro_time', model%paramets%hydtim) + + ! NOTE: bpar is used only for BTRC_TANH_BWAT + ! btrac_max and btrac_slope are used (with btrac_const) for BTRC_LINEAR_BMLT + ! btrac_const is used for several options + + call GetValue(section,'basal_tract_const', model%paramets%btrac_const) + call GetValue(section,'basal_tract_max', model%paramets%btrac_max) + call GetValue(section,'basal_tract_slope', model%paramets%btrac_slope) + + !WHL - Changed this so that bpar can be read correctly from config file. + ! This parameter is now called 'basal_tract_tanh' instead of 'basal_tract'. + call GetValue(section,'basal_tract_tanh', tempvar, 5) + if (associated(tempvar)) then +!! model%paramets%btrac_const = tempvar(1) ! old code + model%paramets%bpar(:) = tempvar(:) + deallocate(tempvar) + end if + +!! call GetValue(section,'sliding_constant', model%climate%slidconst) ! not currently used + + call GetValue(section,'ho_beta_const', model%paramets%ho_beta_const) + + ! Friction law parameters + call GetValue(section, 'friction_powerlaw_k', model%basal_physics%friction_powerlaw_k) + call GetValue(section, 'coulomb_c', model%basal_physics%Coulomb_C) + call GetValue(section, 'coulomb_bump_max_slope', model%basal_physics%Coulomb_Bump_max_slope) + call GetValue(section, 'coulomb_bump_wavelength', model%basal_physics%Coulomb_bump_wavelength) + + ! ocean penetration parameterization parameter + call GetValue(section,'p_ocean_penetration', model%paramets%p_ocean_penetration) + + ! added for ismip-hom + call GetValue(section,'periodic_offset_ew',model%numerics%periodic_offset_ew) + call GetValue(section,'periodic_offset_ns',model%numerics%periodic_offset_ns) + + end subroutine handle_parameters + +!-------------------------------------------------------------------------------- + + subroutine print_parameters(model) + + use glide_types + use glimmer_log + implicit none + type(glide_global_type) :: model + character(len=100) :: message + + call write_log(' ') + call write_log('Parameters') + call write_log('----------') + + write(message,*) 'ice limit for dynamics (m) : ',model%numerics%thklim + call write_log(message) + + !Note: The Glissade dycore is known to crash for thklim = 0, but has not + ! been extensively tested for small values of thklim. + ! Values smaller than 1 mm may be OK, but no guarantees. + if (model%options%whichdycore == DYCORE_GLISSADE .and. & + model%numerics%thklim < 1.d-3) then ! 1 mm + call write_log('ice limit (thklim) is too small for Glissade dycore', GM_FATAL) + endif + + if (model%options%whichdycore /= DYCORE_GLIDE) then + write(message,*) 'ice limit for temperature (m) : ',model%numerics%thklim_temp + call write_log(message) + endif + + write(message,*) 'marine depth limit (m) : ',model%numerics%mlimit + call write_log(message) + + if (model%options%whichmarn == MARINE_FLOAT_FRACTION) then + write(message,*) 'ice fraction lost due to calving : ', model%numerics%calving_fraction + call write_log(message) + end if + + write(message,*) 'geothermal flux (W/m2) : ', model%paramets%geot + call write_log(message) + + write(message,*) 'flow enhancement factor : ', model%paramets%flow_enhancement_factor + call write_log(message) + + write(message,*) 'basal hydro time constant (yr): ', model%paramets%hydtim + call write_log(message) + + if (model%options%whichflwa == FLWA_CONST_FLWA) then + write(message,*) 'constant flow factor (Pa^-n yr^-1):', model%paramets%default_flwa + call write_log(message) + end if + + if (model%options%which_ho_efvs == HO_EFVS_CONSTANT) then + write(message,*) 'constant effec viscosity (Pa yr): ', model%paramets%efvs_constant + call write_log(message) + end if + + if (model%options%whichbtrc == BTRC_CONSTANT .or. & + model%options%whichbtrc == BTRC_CONSTANT_BWAT .or. & + model%options%whichbtrc == BTRC_LINEAR_BMLT .or. & + model%options%whichbtrc == BTRC_CONSTANT_TPMP) then + write(message,*) 'basal traction param (m/yr/Pa): ', model%paramets%btrac_const + call write_log(message) + end if + + if (model%options%whichbtrc == BTRC_TANH_BWAT) then + write(message,*) 'basal traction tanh factors: ',model%paramets%bpar(1) + call write_log(message) + write(message,*) ' ',model%paramets%bpar(2) + call write_log(message) + write(message,*) ' ',model%paramets%bpar(3) + call write_log(message) + write(message,*) ' ',model%paramets%bpar(4) + call write_log(message) + write(message,*) ' ',model%paramets%bpar(5) + call write_log(message) + end if + + if (model%options%whichbtrc == BTRC_LINEAR_BMLT) then + write(message,*) 'basal traction max : ',model%paramets%btrac_max + call write_log(message) + write(message,*) 'basal traction slope : ',model%paramets%btrac_slope + call write_log(message) + end if + + if (model%options%which_ho_babc == HO_BABC_CONSTANT) then + write(message,*) 'uniform beta (Pa yr/m) : ',model%paramets%ho_beta_const + call write_log(message) + end if + + if (model%options%which_ho_babc == HO_BABC_ISHOMC) then + if (model%general%ewn /= model%general%nsn) then + call write_log('Error, must have ewn = nsn for ISMIP-HOM test C', GM_FATAL) + endif + endif + + if (model%options%which_ho_babc == HO_BABC_POWERLAW) then + write(message,*) 'roughness parameter, k, for power-law friction law : ',model%basal_physics%friction_powerlaw_k + call write_log(message) + end if + + if (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) then + write(message,*) 'C coefficient for Coulomb friction law : ', model%basal_physics%Coulomb_C + call write_log(message) + write(message,*) 'bed bump max. slope for Coulomb friction law : ', model%basal_physics%Coulomb_Bump_max_slope + call write_log(message) + write(message,*) 'bed bump wavelength for Coulomb friction law : ', model%basal_physics%Coulomb_bump_wavelength + call write_log(message) + end if + + if (model%options%whichbwat == BWATER_OCEAN_PENETRATION) then + write(message,*) 'p_ocean_penetration : ', model%paramets%p_ocean_penetration + call write_log(message) + endif + + if (model%numerics%idiag < 1 .or. model%numerics%idiag > model%general%ewn & + .or. & + model%numerics%jdiag < 1 .or. model%numerics%jdiag > model%general%nsn) then + call write_log('Error, global diagnostic point (idiag, jdiag) is out of bounds', GM_FATAL) + endif + + ! added for ismip-hom + if (model%numerics%periodic_offset_ew /= 0.d0) then + write(message,*) 'periodic offset_ew (m) : ',model%numerics%periodic_offset_ew + call write_log(message) + endif + + if (model%numerics%periodic_offset_ns /= 0.d0) then + write(message,*) 'periodic offset_ns (m) : ',model%numerics%periodic_offset_ns + call write_log(message) + endif + + call write_log('') + + end subroutine print_parameters + +!-------------------------------------------------------------------------------- + + ! Sigma levels + subroutine handle_sigma(section, model) + + use glimmer_config + use glide_types + use glimmer_log + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + if (model%options%which_sigma==SIGMA_EXTERNAL) then + call write_log('Sigma levels specified twice - use only'// & + ' config file or separate file, not both',GM_FATAL) + else + call GetValue(section,'sigma_levels',model%numerics%sigma,model%general%upn) + end if + + end subroutine handle_sigma + +!-------------------------------------------------------------------------------- + + subroutine print_sigma(model) + use glide_types + use glimmer_log + implicit none + type(glide_global_type) :: model + character(len=100) :: message,temp + integer :: i + + call write_log('Sigma levels:') + call write_log('------------------') + message='' + do i=1,model%general%upn + write(temp,'(f6.3)') model%numerics%sigma(i) + message=trim(message)//trim(temp) + enddo + call write_log(trim(message)) + call write_log('') + + end subroutine print_sigma + +!-------------------------------------------------------------------------------- + + ! geothermal heat flux calculations + subroutine handle_gthf(section, model) + use glimmer_config + use glide_types + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section,'num_dim',model%lithot%num_dim) + call GetValue(section,'nlayer',model%lithot%nlayer) + call GetValue(section,'surft',model%lithot%surft) + call GetValue(section,'rock_base',model%lithot%rock_base) + call GetValue(section,'numt',model%lithot%numt) + call GetValue(section,'rho',model%lithot%rho_r) + call GetValue(section,'shc',model%lithot%shc_r) + call GetValue(section,'con',model%lithot%con_r) + end subroutine handle_gthf + +!-------------------------------------------------------------------------------- + + subroutine print_gthf(model) + use glide_types + use glimmer_log + implicit none + type(glide_global_type) :: model + character(len=100) :: message + + if (model%options%gthf == GTHF_COMPUTE) then + call write_log('Geothermal heat flux configuration') + call write_log('----------------------------------') + if (model%lithot%num_dim==1) then + call write_log('solve 1D diffusion equation') + else if (model%lithot%num_dim==3) then + call write_log('solve 3D diffusion equation') + else + call write_log('Wrong number of dimensions.',GM_FATAL,__FILE__,__LINE__) + end if + write(message,*) 'number of layers : ',model%lithot%nlayer + call write_log(message) + write(message,*) 'initial surface temperature : ',model%lithot%surft + call write_log(message) + write(message,*) 'rock base : ',model%lithot%rock_base + call write_log(message) + write(message,*) 'density of rock layer : ',model%lithot%rho_r + call write_log(message) + write(message,*) 'specific heat capacity of rock layer : ',model%lithot%shc_r + call write_log(message) + write(message,*) 'thermal conductivity of rock layer : ',model%lithot%con_r + call write_log(message) + write(message,*) 'number of time steps for spin-up : ',model%lithot%numt + call write_log(message) + call write_log('') + end if + end subroutine print_gthf + +!-------------------------------------------------------------------------------- + + subroutine handle_isostasy(section, model) + use glimmer_config + use glide_types + implicit none + type(ConfigSection), pointer :: section + type(glide_global_type) :: model + + call GetValue(section,'lithosphere',model%isostasy%lithosphere) + call GetValue(section,'asthenosphere',model%isostasy%asthenosphere) + call GetValue(section,'relaxed_tau',model%isostasy%relaxed_tau) + call GetValue(section,'update',model%isostasy%period) + + !NOTE: This value used to be in a separate section ('elastic lithosphere') + ! Now part of 'isostasy' section + call GetValue(section,'flexural_rigidity',model%isostasy%rbel%d) + +!! call GetSection(config,section,'elastic lithosphere') +!! if (associated(section)) then +!! call GetValue(section,'flexural_rigidity',isos%rbel%d) +!! end if + + end subroutine handle_isostasy + +!-------------------------------------------------------------------------------- + + subroutine print_isostasy(model) + use glide_types + use glimmer_log + use parallel, only: tasks + implicit none + type(glide_global_type) :: model + character(len=100) :: message + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + call write_log('Isostasy') + call write_log('--------') + + if (model%isostasy%lithosphere==LITHOSPHERE_LOCAL) then + call write_log('using local lithosphere approximation') + else if (model%isostasy%lithosphere==LITHOSPHERE_ELASTIC) then + if (tasks > 1) then + call write_log('Error, elastic lithosphere not supported for multiple processors',GM_FATAL) + endif + call write_log('using elastic lithosphere approximation') + write(message,*) ' flexural rigidity : ', model%isostasy%rbel%d + call write_log(message) + write(message,*) ' update period (yr): ', model%isostasy%period + call write_log(message) + else + call write_log('Error, unknown lithosphere option',GM_FATAL) + end if + + if (model%isostasy%asthenosphere==ASTHENOSPHERE_FLUID) then + call write_log('using fluid mantle') + else if (model%isostasy%asthenosphere==ASTHENOSPHERE_RELAXING) then + call write_log('using relaxing mantle') + write(message,*) ' characteristic time constant (yr): ', model%isostasy%relaxed_tau + call write_log(message) + else + call write_log('Error, unknown asthenosphere option',GM_FATAL) + end if + call write_log('') + endif ! compute isostasy + + end subroutine print_isostasy + +!-------------------------------------------------------------------------------- + +! These options are disabled for now. + +!! subroutine handle_till_options(section,model) +!! !Till options +!! use glimmer_config +!! use glide_types +!! implicit none +!! type(ConfigSection), pointer :: section +!! type(glide_global_type) :: model + +!! if (model%options%which_bproc==1) then +!! call GetValue(section, 'fric', model%basalproc%fric) +!! call GetValue(section, 'etillo', model%basalproc%etillo) +!! call GetValue(section, 'No', model%basalproc%No) +!! call GetValue(section, 'Comp', model%basalproc%Comp) +!! call GetValue(section, 'Cv', model%basalproc%Cv) +!! call GetValue(section, 'Kh', model%basalproc%Kh) +!! else if (model%options%which_bproc==2) then +!! call GetValue(section, 'aconst', model%basalproc%aconst) +!! call GetValue(section, 'bconst', model%basalproc%bconst) +!! end if +!! if (model%options%which_bproc > 0) then +!! call GetValue(section, 'Zs', model%basalproc%Zs) +!! call GetValue(section, 'tnodes', model%basalproc%tnodes) +!! call GetValue(section, 'till_hot', model%basalproc%till_hot) +!! end if +!! end subroutine handle_till_options + +!! subroutine print_till_options(model) +!! use glide_types +!! use glimmer_log +!! implicit none +!! type(glide_global_type) :: model +!! character(len=100) :: message + +!! if (model%options%which_bproc > 0) then +!! call write_log('Till options') +!! call write_log('----------') +!! if (model%options%which_bproc==1) then +!! write(message,*) 'Internal friction : ',model%basalproc%fric +!! call write_log(message) +!! write(message,*) 'Reference void ratio : ',model%basalproc%etillo +!! call write_log(message) +!! write(message,*) 'Reference effective Stress : ',model%basalproc%No +!! call write_log(message) +!! write(message,*) 'Compressibility : ',model%basalproc%Comp +!! call write_log(message) +!! write(message,*) 'Diffusivity : ',model%basalproc%Cv +!! call write_log(message) +!! write(message,*) 'Hyd. conductivity : ',model%basalproc%Kh +!! call write_log(message) +!! end if +!! if (model%options%which_bproc==2) then +!! write(message,*) 'aconst : ',model%basalproc%aconst +!! call write_log(message) +!! write(message,*) 'bconst : ',model%basalproc%aconst +!! call write_log(message) +!! end if +!! write(message,*) 'Solid till thickness : ',model%basalproc%Zs +!! call write_log(message) +!! write(message,*) 'Till nodes number : ',model%basalproc%tnodes +!! call write_log(message) +!! write(message,*) 'till_hot :',model%basalproc%till_hot +!! call write_log(message) +!! end if +!! end subroutine print_till_options + +!-------------------------------------------------------------------------------- + + subroutine define_glide_restart_variables(options) + !> This subroutine analyzes the glide/glissade options input by the user in the config file + !> and determines which variables are necessary for an exact restart. MJH 1/11/2013 + + ! Please comment thoroughly the reasons why a particular variable needs to be a restart variable for a given config. + ! Note: this subroutine assumes that any restart variables you add you loadable. Check glide_vars.def to make sure any variables you add have load: 1 + + use glide_types + use glide_io, only: glide_add_to_restart_variable_list + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glide_options), intent (in) :: options !> Derived type holding all model options + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + !This was the restart list as of 1/11/13 using the old hot=1 systme in glide_vars.def: + !restart_variable_list=' lat relx tauf thk thkmask topg bheatflx bmlt bwat uvel vvel wgrd flwa temp litho_temp age ' + + ! Start with a few variables that we always want - prognostic variables and b.c. + ! topg - needed to reconstruct all other geometry fields + ! thk - prognostic variable + ! temp - prognostic variable + ! Note: the conversion from temp/flwa to tempstag/flwastag (if necessary) happens in glide_io.F90 + ! bheatflx, artm, acab - boundary conditions. Of course if these fields are 0 they don't need + ! to be in the restart file, but without adding a check for that we cannot assume any of them are. + ! There are some options where artm would not be needed. Logic could be added to make that distinction. + ! Note that bheatflx may not be an input variable but can also be assigned as a parameter in the config file! + call glide_add_to_restart_variable_list('topg thk temp bheatflx artm acab') + + ! add dycore specific restart variables + select case (options%whichdycore) + + case (DYCORE_GLIDE) + ! thkmask - TODO is this needed? + ! wgrd & wvel - temp driver calculates weff = f(wgrd, wvel) so both are needed by temp code. + ! It looks possible to calculate wvel on a restart from wgrd because wvel does not + ! appear to require a time derivative (see subroutine wvelintg). + ! wgrd does require time derivatives and therefore should be + ! calculated at the end of each time step and stored as a restart variable + ! so that the time derivatives do not need to be restart variables. + ! For now I am calculating wvel at the same time (end of glide time step) + ! and then saving both as restart variables. This has the advantage of + ! them being on consistent time levels in the output file. + ! (If we waited to calculate wvel in the temp driver, we would not need to + ! add it as a restart variable, been then in the output wgrd and wvel would + ! be based on different time levels.) + ! flwa - in principal this could be reconstructed from temp. However in the current + ! implementation of glide the flwa calculation occurs after temp evolution but + ! before thk evolution. This means flwa is calculated from the current temp and + ! the old thk. The old thk is not available on a restart (just the current thk). + ! (thk is needed to calculate flwa for 1) a mask for where ice is, 2) correction for pmp.) + call glide_add_to_restart_variable_list('thkmask wgrd wvel flwa uvel vvel') + + ! slip option for SIA + select case (options%whichbtrc) + case (0) + ! no restart variable needed when no-slip is chosen + case default + ! when a slip option is chosen, ubas & vbas are needed by the temperature solver + ! for calculating basal heating prior to the first calculation of velocity. + ! Rather than recalculate the sliding field on restart, it is easier and + ! less error-prone to have them be restart variables. + ! This could either be done by making ubas, vbas restart variables or + ! having them assigned from the bottom level of uvel,vvel on init + ! Note that btrc and soft are not needed as restart variables because + ! their current implementation is as a scalar ('basal_tract_const' config parameter). + ! If they are ever implemented as 2-d fields, then they (probably just one of them) + ! should become restart variables. + + ! Nothing needs to happen because ubas,vbas are assigned from uvel,vel in glide_init_state_diagnostic() + end select + + case (DYCORE_GLAM, DYCORE_GLISSADE) + ! uvel,vvel - these are needed for an exact restart because we can only + ! recalculate them to within the picard/jfnk convergence tolerance. + ! beta - b.c. needed for runs with sliding - could add logic to only include in that case + ! flwa is not needed for glissade. + ! TODO not sure if thkmask is needed for HO + call glide_add_to_restart_variable_list('uvel vvel thkmask bfricflx dissip') + + end select + + ! ==== Other non-dycore specific options ==== + + ! basal water option + select case (options%whichbwat) + case (BWATER_NONE, BWATER_CONST) + ! no restart variables needed + case default + ! restart needs to know bwat value + call glide_add_to_restart_variable_list('bwat') + end select + + ! internal water option (for enthalpy scheme) + select case (options%whichtemp) + case (TEMP_ENTHALPY) + ! restart needs to know internal water fraction + call glide_add_to_restart_variable_list('waterfrac') + case default + ! no restart variables needed + end select + + select case (options%which_ho_babc) + case (HO_BABC_POWERLAW, HO_BABC_COULOMB_FRICTION) + ! These friction laws need effective pressure + call glide_add_to_restart_variable_list('effecpress') + case default + ! Most other HO basal boundary conditions need the beta field (although there are a few that don't) + call glide_add_to_restart_variable_list('beta') + end select + + ! geothermal heat flux option + select case (options%gthf) + case(GTHF_COMPUTE) + ! restart needs to know lithosphere temperature + call glide_add_to_restart_variable_list('litho_temp') + case default + ! no restart variables needed + end select + + !WHL - added isostasy option + select case (options%isostasy) + case(ISOSTASY_COMPUTE) + ! restart needs to know relaxation depth + ! TODO MJH: I suspect that relx is only needed when asthenosphere=1 (relaxing mantle), but I'm not sure - + ! this should be tested when isostasy implementation is finalized/tested. + call glide_add_to_restart_variable_list('relx') + case default + ! no new restart variables needed + end select + + + ! basal processes module - requires tauf for a restart +!! if (options%which_bproc /= BAS_PROC_DISABLED ) then +!! call glide_add_to_restart_variable_list('tauf') +!! endif + + ! TODO bmlt was set as a restart variable, but I'm not sure when or if it is needed. + + ! TODO age should be a restart variable if it is an input variable. + ! Same goes for b.c. (bheatflxm, artm, acab) and any other tracers that get introduced. + ! These could be included all the time (as I have down above for b.c.), or + ! we could add logic to only include them when they were in the input file. + ! To do this, this subroutine would have to be moved to after where input files are read, + ! glide_io_readall(), but before the output files are created, glide_io_createall() + + ! TODO lat is only needed for some climate drivers. It is not needed for cism_driver. + ! Need to add logic that will add it only when those drivers are used. + + end subroutine define_glide_restart_variables + +!-------------------------------------------------------------------------------- + +end module glide_setup + +!-------------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_stop.F90 b/components/cism/glimmer-cism/libglide/glide_stop.F90 new file mode 100644 index 0000000000..1760f69b3c --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_stop.F90 @@ -0,0 +1,152 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_stop.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glide_stop + + use glide_types + use glimmer_log + + implicit none + + !> module containing finalisation of glide + !> this subroutine had to be split out from glide.f90 to avoid circular dependencies + + !> Updated by Tim Bocek to allow for several models to be + !> registered and finalized with a single call without needing + !> the model at call time + + integer, parameter :: max_models = 32 + + type pmodel_type + !> Contains a pointer to a model + !> This is a hack to get around Fortran's lack of arrays of pointers + type(glide_global_type), pointer :: p => null() + end type pmodel_type + + !> Pointers to all registered models + !> This has a fixed size at compile time + type(pmodel_type), dimension(max_models), save :: registered_models + +contains + +!EIB! register and finalise_all not present in gc2, are present in lanl, therefore added here + + subroutine register_model(model) + !> Registers a model, ensuring that it is finalised in the case of an error + type(glide_global_type), target :: model + integer :: i + + do i = 1, max_models + if (.not. associated(registered_models(i)%p)) then + registered_models(i)%p => model + model%model_id = i + return + end if + end do + call write_log("Model was not registered, did you instantiate too many instances?", GM_FATAL) + end subroutine + + subroutine deregister_model(model) + !> Removes a model from the registry. Normally this should only be done + !> glide_finalise is called on the model, and is done automatically by + !> that function + type(glide_global_type) :: model + + if (model%model_id < 1 .or. model%model_id > max_models) then + call write_log("Attempting to deregister a non-allocated model", GM_WARNING) + else + registered_models(model%model_id)%p => null() + model%model_id = 0 + end if + end subroutine + + !Note: Currently, glide_finalise_all is never called. (glide_finalise is called from cism_driver) + + subroutine glide_finalise_all(crash_arg) + !> Finalises all models in the model registry + logical, optional :: crash_arg + + logical :: crash + integer :: i + + if (present(crash_arg)) then + crash = crash_arg + else + crash = .false. + end if + + do i = 1,max_models + if (associated(registered_models(i)%p)) then + call glide_finalise(registered_models(i)%p, crash) + end if + end do + end subroutine + + + subroutine glide_finalise(model,crash) + + !> finalise model instance + + use glimmer_ncio + use glimmer_log + use glide_types + use glide_io + use profile + implicit none + type(glide_global_type) :: model !> model instance + logical, optional :: crash !> set to true if the model died unexpectedly + character(len=100) :: message + + ! force last write if crashed + if (present(crash)) then + if (crash) then + call glide_io_writeall(model,model,.true.) + end if + end if + + call closeall_in(model) + call closeall_out(model) + + call glide_deallocarr(model) + call deregister_model(model) + + ! write some statistics + call write_log('Some Stats') + write(message,*) 'Maximum temperature iterations: ',model%temper%niter + call write_log(message) + + ! close profile +#if (defined PROFILING || defined CCSMCOUPLED || defined CESMTIMERS) + call profile_close(model%profile) +#endif + + end subroutine glide_finalise + +end module glide_stop diff --git a/components/cism/glimmer-cism/libglide/glide_stress.F90 b/components/cism/glimmer-cism/libglide/glide_stress.F90 new file mode 100644 index 0000000000..68ef091a73 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_stress.F90 @@ -0,0 +1,219 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_stress.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! *sfp* module to hold subroutines for calculation of stress components from converged, higher-order +! stress and effective viscosity fields. To be called at the end of HO vel calculation. + +module glide_stress + + use glimmer_paramets, only : dp + use glide_types + use parallel + + implicit none + + private + public :: glide_calcstrsstr + + contains + + subroutine glide_calcstrsstr( model ) + + type(glide_global_type) :: model + + call calcstrsstr(model%general%ewn, model%general%nsn, model%general%upn, & + model%numerics%dew, model%numerics%dns, & + model%numerics%sigma, model%numerics%stagsigma, & + model%geometry%thck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%geomderv%dthckdew, model%geomderv%dthckdns, & + model%velocity%uvel, model%velocity%vvel, & + model%stress%efvs, & + model%stress%tau%xx, model%stress%tau%yy, & + model%stress%tau%xy, model%stress%tau%scalar, & + model%stress%tau%xz, model%stress%tau%yz ) + + end subroutine glide_calcstrsstr + + subroutine calcstrsstr( ewn, nsn, upn, & + dew, dns, & + sigma, stagsigma, & + thck, & + dusrfdew, dusrfdns, & + dthckdew, dthckdns, & + uvel, vvel, & + efvs, & + tauxx, tauyy, & + tauxy, tau, & + tauxz, tauyz ) + + use glimmer_paramets, only : len0, thk0 + + implicit none + + integer, intent(in) :: ewn, nsn, upn + + real(dp), intent(in) :: dew, dns + real(dp), intent(in), dimension(:) :: sigma, stagsigma + real(dp), intent(in), dimension(:,:,:) :: efvs, uvel, vvel + real(dp), intent(in), dimension(:,:) :: thck, dusrfdew, & + dusrfdns, dthckdew, dthckdns + + real(dp), intent(out), dimension(:,:,:) :: tauxx, tauyy, tauxy, & + tauxz, tauyz, tau + !*sfp* local vars + integer :: ew, ns + real(dp), parameter :: f1 = len0 / thk0 + real(dp) :: dew2, dew4, dns2, dns4 + real(dp), dimension(upn-1) :: dup, dupm + + !*sfp* note that these are already defined and used in glam_strs2. If needed by PB&J + + ! stress calc routine as well, consider moving these up-scope + dup(1:upn-1) = sigma(2:upn) - sigma(1:upn-1) + dupm(:) = - 0.25_dp / dup(:) + dew2 = 2.0_dp * dew; dns2 = 2.0_dp * dns ! *sp* 2x the standard grid spacing + dew4 = 4.0_dp * dew; dns4 = 4.0_dp * dns ! *sp* 4x the standard grid spacing + + do ns = 2,nsn-1 + do ew = 2,ewn-1; + + if (thck(ew,ns) > 0.0_dp) then + + tauxz(:,ew,ns) = vertideriv(upn, hsum(uvel(:,ew-1:ew,ns-1:ns)), & + thck(ew,ns), dupm(1:upn-1)) + tauyz(:,ew,ns) = vertideriv(upn, hsum(vvel(:,ew-1:ew,ns-1:ns)), & + thck(ew,ns), dupm(1:upn-1)) + tauxx(:,ew,ns) = horizderiv(upn, stagsigma, & + sum(uvel(:,ew-1:ew,ns-1:ns),3), & + dew4, tauxz(:,ew,ns), & + sum(dusrfdew(ew-1:ew,ns-1:ns)), & + sum(dthckdew(ew-1:ew,ns-1:ns))) + tauyy(:,ew,ns) = horizderiv(upn, stagsigma, & + sum(vvel(:,ew-1:ew,ns-1:ns),2), & + dns4, tauyz(:,ew,ns), & + sum(dusrfdns(ew-1:ew,ns-1:ns)), & + sum(dthckdns(ew-1:ew,ns-1:ns))) + tauxy(:,ew,ns) = horizderiv(upn, stagsigma, & + sum(uvel(:,ew-1:ew,ns-1:ns),2), & + dns4, tauxz(:,ew,ns), & + sum(dusrfdns(ew-1:ew,ns-1:ns)), & + sum(dthckdns(ew-1:ew,ns-1:ns))) + & + horizderiv(upn, stagsigma, & + sum(vvel(:,ew-1:ew,ns-1:ns),3), & + dew4, tauyz(:,ew,ns), & + sum(dusrfdew(ew-1:ew,ns-1:ns)), & + sum(dthckdew(ew-1:ew,ns-1:ns))) + else + tauxz(:,ew,ns) = 0.0_dp + tauyz(:,ew,ns) = 0.0_dp + tauxx(:,ew,ns) = 0.0_dp + tauyy(:,ew,ns) = 0.0_dp + tauxy(:,ew,ns) = 0.0_dp + end if + + end do + end do + + tauxz = f1 * efvs * tauxz + tauyz = f1 * efvs * tauyz + tauxx = 2.0_dp * efvs * tauxx + tauyy = 2.0_dp * efvs * tauyy + tauxy = efvs * tauxy + + !*sfp* expanding this in terms of viscosity and velocity gradients, I've confirmed that + ! one gets the same thing as if one took Tau_eff = N_eff * Eps_eff, where Eps_eff is the + ! 1st order approx. to the 2nd strain-rate invariant (outlined in model description document). + tau = sqrt(tauxz**2 + tauyz**2 + tauxx**2 + tauyy**2 + tauxx*tauyy + tauxy**2) + + call parallel_halo(tauxx) + call parallel_halo(tauyy) + call parallel_halo(tauxy) + call parallel_halo(tauxz) + call parallel_halo(tauyz) + call parallel_halo(tau) + return + + end subroutine calcstrsstr + + + function vertideriv( upn, varb, thck, dupm ) + + implicit none + + integer, intent(in) :: upn + real(dp), intent(in), dimension(:) :: varb + real(dp), intent(in) :: thck + real(dp), intent(in), dimension(:) :: dupm + + real(dp), dimension(size(varb)-1) :: vertideriv + + !*sfp* 'dupm' defined as -1/(2*del_sigma), in which case it seems like + !there should be a '-' in front of this expression ... or, negative sign + !may be implicit in the vert indices ( "arb(2:upn) - varb(1:upn-1)" ) and + !the fact that up=1 at the sfc and up=upn at the bed ??? + vertideriv(1:upn-1) = dupm(1:upn-1) * (varb(2:upn) - varb(1:upn-1)) / thck + + return + + end function vertideriv + + function horizderiv( upn, stagsigma, & + varb, grid, & + dvarbdz, dusrfdx, dthckdx) + + implicit none + + integer, intent(in) :: upn + real(dp), dimension(:), intent(in) :: stagsigma + real(dp), dimension(:,:), intent(in) :: varb + real(dp), dimension(:), intent(in) :: dvarbdz + real(dp), intent(in) :: dusrfdx, dthckdx, grid + + real(dp) :: horizderiv(size(varb,1)-1) + + ! *sfp* where does this factor of 1/4 come from ... averaging? + horizderiv = (varb(1:upn-1,2) + varb(2:upn,2) - varb(1:upn-1,1) - varb(2:upn,1)) / grid - & + dvarbdz * (dusrfdx - stagsigma * dthckdx) / 4.0_dp + + return + + end function horizderiv + + function hsum(inp) + + implicit none + + real(dp), dimension(:,:,:), intent(in) :: inp + real(dp), dimension(size(inp,dim=1)) :: hsum + + hsum = sum(sum(inp(:,:,:),dim=3),dim=2) + + return + + end function hsum + +end module glide_stress diff --git a/components/cism/glimmer-cism/libglide/glide_temp.F90 b/components/cism/glimmer-cism/libglide/glide_temp.F90 new file mode 100644 index 0000000000..d4d2605d38 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_temp.F90 @@ -0,0 +1,1351 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_temp.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +! some macros used to disable parts of the temperature equation +! vertical diffusion +#ifdef NO_VERTICAL_DIFFUSION +#define VERT_DIFF 0. +#else +#define VERT_DIFF 1. +#endif + +! horizontal advection +#ifdef NO_HORIZONTAL_ADVECTION +#define HORIZ_ADV 0. +#else +#define HORIZ_ADV 1. +#endif + +! vertical advection +#ifdef NO_VERTICAL_ADVECTION +#define VERT_ADV 0. +#else +#define VERT_ADV 1. +#endif + +! strain heating +#ifdef NO_STRAIN_HEAT +#define STRAIN_HEAT 0. +#else +#define STRAIN_HEAT 1. +#endif + +module glide_temp + + use glide_types + use glimmer_global, only : dp + + !TODO - Remove 'oldglide' logic when comparisons are complete + use glimmer_paramets, only : oldglide + + implicit none + + private + public :: glide_init_temp, glide_temp_driver, glide_calcbmlt, glide_calcbpmp + +contains + +!------------------------------------------------------------------------------------ + + subroutine glide_init_temp(model) + + !> initialise temperature module + use glimmer_physcon, only : rhoi, shci, coni, scyr, grav, gn, lhci, rhow, trpt + use glimmer_paramets, only : tim0, thk0, acc0, len0, vis0, vel0 + use glimmer_log + use parallel, only: lhalo, uhalo + + type(glide_global_type), intent(inout) :: model ! model instance + + integer, parameter :: p1 = gn + 1 + integer :: up, ns, ew + + !TODO - Change VERT_DIFF, etc. to integers? + if (VERT_DIFF==0.) call write_log('Vertical diffusion is switched off') + if (HORIZ_ADV==0.) call write_log('Horizontal advection is switched off') + if (VERT_ADV==0.) call write_log('Vertical advection is switched off') + if (STRAIN_HEAT==0.) call write_log('Strain heating is switched off') + + !TODO - Should these tempwk allocations be done in glide_allocarr, called from glide_types? + ! Should the arrays be deallocated here at the end of the run? + + ! horizontal advection stuff + allocate(model%tempwk%hadv_u(model%general%upn,model%general%ewn,model%general%nsn)) + allocate(model%tempwk%hadv_v(model%general%upn,model%general%ewn,model%general%nsn)) + allocate(model%tempwk%initadvt(model%general%upn,model%general%ewn,model%general%nsn)) + + allocate(model%tempwk%inittemp(model%general%upn,model%general%ewn,model%general%nsn)) + !WHL - Moved dissip to model%temper and allocated in glide_types. +!! allocate(model%tempwk%dissip(model%general%upn,model%general%ewn,model%general%nsn)) + allocate(model%tempwk%compheat(model%general%upn,model%general%ewn,model%general%nsn)) + model%tempwk%compheat = 0.0d0 + allocate(model%tempwk%dups(model%general%upn,3)) + + allocate(model%tempwk%c1(model%general%upn)) + + allocate(model%tempwk%dupa(model%general%upn),model%tempwk%dupb(model%general%upn)) + allocate(model%tempwk%dupc(model%general%upn)) + + model%tempwk%advconst(1) = HORIZ_ADV*model%numerics%dttem / (16.0d0 * model%numerics%dew) + model%tempwk%advconst(2) = HORIZ_ADV*model%numerics%dttem / (16.0d0 * model%numerics%dns) + + model%tempwk%dups = 0.0d0 + + do up = 2, model%general%upn-1 + model%tempwk%dups(up,1) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up-1)) * & + (model%numerics%sigma(up) - model%numerics%sigma(up-1))) + model%tempwk%dups(up,2) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up-1)) * & + (model%numerics%sigma(up+1) - model%numerics%sigma(up))) + model%tempwk%dups(up,3) = 1.d0/(model%numerics%sigma(up+1) - model%numerics%sigma(up-1)) + end do + + model%tempwk%zbed = 1.0d0 / thk0 + model%tempwk%dupn = model%numerics%sigma(model%general%upn) - model%numerics%sigma(model%general%upn-1) + +! In dimensional units, wmax = thk0 / (tim0/scyr) = 2000 m / 400 yr = 5 m/yr +! In nondimensional units, wmax = 5 m/yr / (thk0*scyr/tim0) = 1.0 +! If we remove scaling, then tim0 = thk0 = 1, and wmax = 5 m/yr / scyr. +! The following expression is correct if scaling is removed. + + model%tempwk%wmax = 5.0d0 * tim0 / (scyr * thk0) + + model%tempwk%cons = (/ 2.0d0 * tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2), & + model%numerics%dttem / 2.0d0, & + VERT_DIFF*2.0d0 * tim0 * model%numerics%dttem / (thk0 * rhoi * shci), & + VERT_ADV*tim0 * acc0 * model%numerics%dttem / coni, & + 0.d0 /) !WHL - last term no longer needed + !*sfp* added last term to vector above for use in HO & SSA dissip. cacl + + model%tempwk%c1 = STRAIN_HEAT *(model%numerics%sigma * rhoi * grav * thk0**2 / len0)**p1 * & + 2.0d0 * vis0 * model%numerics%dttem * tim0 / (16.0d0 * rhoi * shci) + + model%tempwk%dupc = (/ (model%numerics%sigma(2) - model%numerics%sigma(1)) / 2.0d0, & + ((model%numerics%sigma(up+1) - model%numerics%sigma(up-1)) / 2.0d0, & + up=2,model%general%upn-1), (model%numerics%sigma(model%general%upn) - & + model%numerics%sigma(model%general%upn-1)) / 2.0d0 /) + + model%tempwk%dupa = (/ 0.0d0, 0.0d0, & + ((model%numerics%sigma(up) - model%numerics%sigma(up-1)) / & + ((model%numerics%sigma(up-2) - model%numerics%sigma(up-1)) * & + (model%numerics%sigma(up-2) - model%numerics%sigma(up))), & + up=3,model%general%upn) /) + + model%tempwk%dupb = (/ 0.0d0, 0.0d0, & + ((model%numerics%sigma(up) - model%numerics%sigma(up-2)) / & + ((model%numerics%sigma(up-1) - model%numerics%sigma(up-2)) * & + (model%numerics%sigma(up-1) - model%numerics%sigma(up))), & + up=3,model%general%upn) /) + + model%tempwk%f = (/ tim0 * coni / (thk0**2 * lhci * rhoi), & + tim0 / (thk0 * lhci * rhoi), & + tim0 * thk0 * rhoi * shci / (thk0 * tim0 * model%numerics%dttem * lhci * rhoi), & + tim0 * thk0**2 * vel0 * grav * rhoi / (4.0d0 * thk0 * len0 * rhoi * lhci), & + 0.d0 /) !WHL - last term no longer needed + !*sfp* added the last term in the vect above for HO and SSA dissip. calc. + + ! setting up some factors for sliding contrib to basal heat flux + model%tempwk%slide_f = (/ VERT_DIFF * grav * thk0 * model%numerics%dttem/ shci, & ! vert diffusion + VERT_ADV * rhoi*grav*acc0*thk0*thk0*model%numerics%dttem/coni /) ! vert advection + + + + !==== Initialize ice temperature.============ + + ! Five possibilities: + ! (1) Set ice temperature to 0 C everywhere in column (TEMP_INIT_ZERO) + ! (2) Set ice temperature to surface air temperature everywhere in column (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + ! (4) Read ice temperature from an initial input file. + ! (5) Read ice temperature from a restart file. + ! + ! If restarting, we always do (5). + ! If not restarting and the temperature field is present in the input file, we do (4). + ! If (4) or (5), then the temperature field should already have been read from a file, + ! and the rest of this subroutine will do nothing. + ! Otherwise, the initial temperature is controlled by model%options%temp_init, + ! which can be read from the config file. + ! + !TODO - Remove halo parameters below, since uhalo = lhalo = 0 for Glide. + !TODO - Make sure cells in the Glide temperature halo are initialized to reasonable values + ! (not unphys_val), e.g. if reading temps from input or restart file. + + if (model%options%is_restart == RESTART_TRUE) then + + ! Temperature has already been initialized from a restart file. + ! (Temperature is always a restart variable.) + + call write_log('Initializing ice temperature from the restart file') + + elseif ( minval(model%temper%temp(1:model%general%upn, & + 1+lhalo:model%general%ewn-lhalo, 1+uhalo:model%general%nsn-uhalo)) > & + (-1.0d0 * trpt) ) then ! trpt = 273.15 K + ! Default initial temps in glide_types are unphys_val = -999 + + ! Temperature has already been initialized from an input file. + ! (We know this because the unphysical initial values have been overwritten.) + + call write_log('Initializing ice temperature from an input file') + + else ! not reading temperature from restart or input file, so initialize it here + + ! First set T = 0 C everywhere (including Glide temperature halo: ew = 0, ewn+1, ns = 0, nsn+1). + + model%temper%temp(:,:,:) = 0.0d0 + + if (model%options%temp_init == TEMP_INIT_ZERO) then + + ! Nothing else to do; just write to log + call write_log('Initializing ice temperature to 0 deg C') + + elseif (model%options%temp_init == TEMP_INIT_ARTM) then + + ! Initialize ice column temperature to surface air temperature + ! If artm > 0 C, then set T = 0 C. + ! Loop over physical cells where artm is defined (not temperature halo cells). + + !Note: Old glide sets temp = artm everywhere without regard to whether ice exists in a column. + + call write_log('Initializing ice temperature to the surface air temperature') + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + call glide_init_temp_column(model%options%temp_init, & + model%numerics%sigma(:), & + dble(model%climate%artm(ew,ns)), & !TODO - Remove 'dble' (artm is dp) + model%geometry%thck(ew,ns), & + model%temper%temp(:,ew,ns) ) + end do + end do + + elseif (model%options%temp_init == TEMP_INIT_LINEAR) then + + ! Initialize ice column temperature with a linear profile: + ! T = artm at the surface, and T <= Tpmp at the bed. + ! Loop over physical cells where artm is defined (not temperature halo cells) + + call write_log('Initializing ice temperature to a linear profile in each column') + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + call glide_init_temp_column(model%options%temp_init, & + model%numerics%sigma(:), & + dble(model%climate%artm(ew,ns)), & + model%geometry%thck(ew,ns), & + model%temper%temp(:,ew,ns) ) + end do + end do + + endif ! model%options%temp_init + + endif ! restart file, input file, or other options + + + ! ====== Calculate initial value of flwa ================== + + if (model%options%is_restart == RESTART_FALSE) then + call write_log("Calculating initial flwa from temp and thk fields") + + ! Calculate Glen's A -------------------------------------------------------- + + call glide_calcflwa(model%numerics%sigma, & + model%numerics%thklim, & + model%temper%flwa, & + model%temper%temp(:,1:model%general%ewn,1:model%general%nsn), & + model%geometry%thck, & + model%paramets%flow_enhancement_factor, & + model%paramets%default_flwa, & + model%options%whichflwa) + else + call write_log("Using flwa values from restart file for flwa initial condition.") + endif + + end subroutine glide_init_temp + +!**************************************************** + + subroutine glide_init_temp_column(temp_init, & + sigma, artm, & + thck, temp) + + ! Initialize temperatures in a column based on the value of temp_init + ! Three possibilities: + ! (1) Set ice temperature in column to 0 C (TEMP_INIT_ZERO) + ! (2) Set ice temperature in column to surface air temperature (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A local parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + + ! In/out arguments + + integer, intent(in) :: temp_init ! option for temperature initialization + + real(dp), dimension(:), intent(in) :: sigma ! vertical coordinate + real(dp), intent(in) :: artm ! surface air temperature (deg C) + ! Note: artm should be passed in as double precision + real(dp), intent(in) :: thck ! ice thickness + real(dp), dimension(:), intent(inout) :: temp ! ice column temperature (deg C) + + ! Local variables and parameters + + real(dp) :: tbed ! initial temperature at bed + real(dp) :: pmptb ! pressure melting point temp at the bed + real(dp), dimension(size(sigma)) :: pmpt ! pressure melting point temp thru the column + + real(dp), parameter :: pmpt_offset = 2.d0 ! offset of initial Tbed from pressure melting point temperature (deg C) + ! Note: pmtp_offset is positive for T < Tpmp + + ! Set the temperature in the column + + select case(temp_init) + + case(TEMP_INIT_ZERO) ! set T = 0 C + + temp(:) = 0.d0 + + case(TEMP_INIT_ARTM) ! initialize ice-covered areas to the min of artm and 0 C + + if (thck > 0.0d0) then + temp(:) = dmin1(0.0d0, artm) + else + temp(:) = 0.d0 + endif + + case(TEMP_INIT_LINEAR) + + ! Tsfc = artm, Tbed = Tpmp - pmpt_offset, linear profile in between + + call calcpmptb (pmptb, thck) + tbed = pmptb - pmpt_offset + + temp(:) = artm + (tbed - artm)*sigma(:) + + ! Make sure T <= Tpmp - pmpt_offset throughout column + + call calcpmpt(pmpt(:), thck, sigma(:)) + temp(:) = min(temp(:), pmpt(:) - pmpt_offset) + + end select + + end subroutine glide_init_temp_column + + + subroutine glide_temp_driver(model,whichtemp) + + !> Calculates the ice temperature, according to one + !> of several alternative methods. + + use glimmer_utils, only: tridiag + use glimmer_paramets, only : thk0, tim0, GLC_DEBUG + use glide_grid_operators, only: stagvarb + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_global_type),intent(inout) :: model ! model instance + integer, intent(in) :: whichtemp ! flag to choose method. + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp),dimension(size(model%numerics%sigma)) :: subd, diag, supd, rhsd + real(dp),dimension(size(model%numerics%sigma)) :: prevtemp, iteradvt, diagadvt + real(dp) :: tempresid + real(dp) :: dTtop, dthck + + integer :: iter + integer :: ew,ns + + real(dp),parameter :: tempthres = 0.001d0, floatlim = 10.0d0 / thk0 + integer, parameter :: mxit = 100 + integer, parameter :: ewbc = 1, nsbc = 1 + + real(dp), dimension(size(model%numerics%sigma)) :: weff + + !------------------------------------------------------------------------------------ + ! ewbc/nsbc set the type of boundary condition aplied at the end of + ! the domain. a value of 0 implies zero gradient. + !------------------------------------------------------------------------------------ + + select case(whichtemp) + + case(TEMP_SURFACE_AIR_TEMP) ! Set column to surface air temperature ------------------ + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + model%temper%temp(:,ew,ns) = dmin1(0.0d0,dble(model%climate%artm(ew,ns))) + end do + end do + + case(TEMP_PROGNOSTIC) ! Do full temperature solution as in standard Glide------------- + + ! Note: In older versions of Glimmer, the vertical velocity was computed here. + ! It is now computed in glide_tstep_p3 to support exact restart. + + model%tempwk%inittemp = 0.0d0 + model%tempwk%initadvt = 0.0d0 + !*MH model%temper%dissip = 0.0d0 is also set to zero in finddisp + + ! ---------------------------------------------------------------------------------- + + call glide_finddisp(model, & + model%geometry%thck, & + model%geomderv%stagthck, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%temper%flwa) + + ! Loop over all scalar points except outer row + ! Outer row of cells is omitted because velo points are not available at boundaries + + ! translate velo field + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + model%tempwk%hadv_u(:,ew,ns) = model%tempwk%advconst(1) * ( model%velocity%uvel(:,ew-1,ns-1) & + + model%velocity%uvel(:,ew-1,ns) + model%velocity%uvel(:,ew,ns-1) + model%velocity%uvel(:,ew,ns) ) + model%tempwk%hadv_v(:,ew,ns) = model%tempwk%advconst(2) * ( model%velocity%vvel(:,ew-1,ns-1) & + + model%velocity%vvel(:,ew-1,ns) + model%velocity%vvel(:,ew,ns-1) + model%velocity%vvel(:,ew,ns) ) + end do + end do + + call hadvall(model, & + model%temper%temp, & + model%geometry%thck) + + ! zeroth iteration + iter = 0 + tempresid = 0.0d0 + + ! Loop over all scalar points except outer row + ! Note: temperature array has dimensions (upn, 0:ewn+1, 0:nsn+1) + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + if (model%geometry%thck(ew,ns) > model%numerics%thklim) then + + weff = model%velocity%wvel(:,ew,ns) - model%velocity%wgrd(:,ew,ns) + + !TODO - It seems odd to zero out weff when it's big. Why not set to wmax? + if (maxval(abs(weff)) > model%tempwk%wmax) then + weff = 0.0d0 + end if + + call hadvpnt(iteradvt, & + diagadvt, & + model%temper%temp(:,ew-2:ew+2,ns), & + model%temper%temp(:,ew,ns-2:ns+2), & + model%tempwk%hadv_u(:,ew,ns), & + model%tempwk%hadv_v(:,ew,ns)) + + call findvtri(model,ew,ns,subd,diag,supd,diagadvt, & + weff, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + call findvtri_init(model,ew,ns,subd,diag,supd,weff,model%temper%temp(:,ew,ns), & + model%geometry%thck(ew,ns),GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + call findvtri_rhs(model,ew,ns,model%climate%artm(ew,ns),iteradvt,rhsd, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + prevtemp(:) = model%temper%temp(:,ew,ns) + + call tridiag(subd(1:model%general%upn), & + diag(1:model%general%upn), & + supd(1:model%general%upn), & + model%temper%temp(1:model%general%upn,ew,ns), & + rhsd(1:model%general%upn)) + + call corrpmpt(model%temper%temp(:,ew,ns), & + model%geometry%thck(ew,ns), & + model%temper%bwat(ew,ns), & + model%numerics%sigma, & + model%general%upn) + + tempresid = max(tempresid,maxval(abs(model%temper%temp(:,ew,ns)-prevtemp(:)))) + + endif ! thk > thklim + end do ! ew + end do ! ns + + do while (tempresid > tempthres .and. iter <= mxit) + + tempresid = 0.0d0 + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + + if(model%geometry%thck(ew,ns) > model%numerics%thklim) then + + weff = model%velocity%wvel(:,ew,ns) - model%velocity%wgrd(:,ew,ns) + if (maxval(abs(weff)) > model%tempwk%wmax) then + weff = 0.0d0 + end if + + call hadvpnt(iteradvt, & + diagadvt, & + model%temper%temp(:,ew-2:ew+2,ns), & + model%temper%temp(:,ew,ns-2:ns+2), & + model%tempwk%hadv_u(:,ew,ns), & + model%tempwk%hadv_v(:,ew,ns)) + + call findvtri(model,ew,ns,subd,diag,supd,diagadvt, & + weff, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + call findvtri_rhs(model,ew,ns,model%climate%artm(ew,ns),iteradvt,rhsd, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + prevtemp(:) = model%temper%temp(:,ew,ns) + + call tridiag(subd(1:model%general%upn), & + diag(1:model%general%upn), & + supd(1:model%general%upn), & + model%temper%temp(1:model%general%upn,ew,ns), & + rhsd(1:model%general%upn)) + + call corrpmpt(model%temper%temp(:,ew,ns), & + model%geometry%thck(ew,ns), & + model%temper%bwat(ew,ns), & + model%numerics%sigma, & + model%general%upn) + + ! Compute conductive flux = (k/H * dT/dsigma) at upper surface; positive down + ! This is computed in case it needs to be upscaled and passed back to a GCM. + + dTtop = model%temper%temp(2,ew,ns) - model%temper%temp(1,ew,ns) + dthck = model%geometry%thck(ew,ns)*thk0 * (model%numerics%sigma(2) - model%numerics%sigma(1)) + model%temper%ucondflx(ew,ns) = -coni * dTtop / dthck + + ! Check whether the temperature has converged everywhere + tempresid = max(tempresid, maxval(abs(model%temper%temp(:,ew,ns)-prevtemp(:)))) + + else ! thck <= thklim + ! Still need to set ucondflx, even for thin ice, so that something is + ! passed to the coupler. Arbitrarily setting the flux to 0 in this case. + model%temper%ucondflx(ew,ns) = 0.0d0 + endif ! thck > thklim + end do ! ew + end do ! ns + + iter = iter + 1 + + end do ! tempresid > tempthres .and. iter <= mxit + + model%temper%niter = max(model%temper%niter, iter) + + ! Set temperature of thin ice based on model%options%temp_init + ! T = 0 for TEMP_INIT_ZERO + ! T = artm for TEMP_INIT_ARTM + ! Linear vertical profile for TEMP_INIT_LINEAR + ! Set T = 0 for ice-free cells + ! + ! NOTE: Calling this subroutine will maintain a sensible temperature profile + ! for thin ice, but in general does *not* conserve energy. + ! To conserve energy, we need either thklim = 0, or some additional + ! energy accounting and correction. + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + if (GLIDE_IS_THIN(model%geometry%thkmask(ew,ns))) then + + !TODO - Remove 'oldglide' logic when comparisons are complete + if (oldglide) then + model%temper%temp(:,ew,ns) = min(0.0d0,dble(model%climate%artm(ew,ns))) + else + call glide_init_temp_column(model%options%temp_init, & + model%numerics%sigma(:), & + dble(model%climate%artm(ew,ns)), & + model%geometry%thck(ew,ns), & + model%temper%temp(:,ew,ns) ) + endif + + else if (GLIDE_NO_ICE(model%geometry%thkmask(ew,ns))) then + + model%temper%temp(:,ew,ns) = 0.0d0 + + end if + end do + end do + + ! apply periodic ew BC + if (model%options%periodic_ew) then + model%temper%temp(:,0,:) = model%temper%temp(:,model%general%ewn-2,:) + model%temper%temp(:,1,:) = model%temper%temp(:,model%general%ewn-1,:) + model%temper%temp(:,model%general%ewn,:) = model%temper%temp(:,2,:) + model%temper%temp(:,model%general%ewn+1,:) = model%temper%temp(:,3,:) + end if + + ! Calculate basal melt rate -------------------------------------------------- + + call glide_calcbmlt(model, & + model%temper%temp, & + model%geometry%thck, & + model%geomderv%stagthck, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%velocity%ubas, & + model%velocity%vbas, & + model%temper%bmlt, & + GLIDE_IS_FLOAT(model%geometry%thkmask)) + + ! Transform basal temperature and pressure melting point onto velocity grid + ! We need stagbpmp for one of the basal traction cases. + + call stagvarb(model%temper%temp(model%general%upn,1:model%general%ewn,1:model%general%nsn), & + model%temper%stagbtemp ,& + model%general% ewn, & + model%general% nsn) + + call glide_calcbpmp(model,model%geometry%thck,model%temper%bpmp) + + call stagvarb(model%temper%bpmp, & + model%temper%stagbpmp ,& + model%general% ewn, & + model%general% nsn) + + case(TEMP_STEADY) ! *sfp* stealing this un-used option ... + + ! DO NOTHING. That is, hold T const. at initially assigned value + + end select ! whichtemp + + ! Rescale dissipation term to deg C/s (instead of deg C) + !WHL - Treat dissip above as a rate (deg C/s) instead of deg + model%temper%dissip(:,:,:) = model%temper%dissip(:,:,:) / (model%numerics%dttem*tim0) + + ! Calculate Glen's A -------------------------------------------------------- + + call glide_calcflwa(model%numerics%sigma, & + model%numerics%thklim, & + model%temper%flwa, & + model%temper%temp(:,1:model%general%ewn,1:model%general%nsn), & + model%geometry%thck, & + model%paramets%flow_enhancement_factor, & + model%paramets%default_flwa, & + model%options%whichflwa) + + ! Output some information ---------------------------------------------------- + + if (GLC_DEBUG) then + print *, "* temp ", model%numerics%time, iter, model%temper%niter, & + real(model%temper%temp(model%general%upn,model%general%ewn/2+1,model%general%nsn/2+1)) + end if + + end subroutine glide_temp_driver + + !------------------------------------------------------------------------- + + subroutine hadvpnt(iteradvt,diagadvt,tempx,tempy,u,v) + + real(dp), dimension(:), intent(in) :: u,v + real(dp), dimension(:,:), intent(in) :: tempx, tempy + real(dp), dimension(:), intent(out) :: iteradvt, diagadvt + + iteradvt = 0.0d0 + diagadvt = 0.0d0 + + if (u(1) > 0.0d0) then + iteradvt = u * (- 4.0d0*tempx(:,2) + tempx(:,1)) + diagadvt = u * 3.0d0 + else if (u(1) < 0.0d0) then + iteradvt = u * (4.0d0*tempx(:,4) - tempx(:,5)) + diagadvt = - u * 3.0d0 + end if + + if (v(1) > 0.0d0) then + iteradvt = iteradvt + v * (- 4.0d0*tempy(:,2) + tempy(:,1)) + diagadvt = diagadvt + v * 3.0d0 + else if (v(1) < 0.0d0) then + iteradvt = iteradvt + v * (4.0d0*tempy(:,4) - tempy(:,5)) + diagadvt = diagadvt - v * 3.0d0 + end if + + end subroutine hadvpnt + + !------------------------------------------------------------------------- + + subroutine fohadvpnt(tempwk,iteradvt,diagadvt,tempx,tempy,uvel,vvel) + + use glimmer_utils, only: hsum + + type(glide_tempwk) :: tempwk + real(dp), dimension(:,:,:), intent(in) :: uvel, vvel + real(dp), dimension(:,:), intent(in) :: tempx, tempy + real(dp), dimension(:), intent(out) :: iteradvt, diagadvt + + real(dp), dimension(size(iteradvt)) :: u, v + + iteradvt = 0.0d0 + diagadvt = 0.0d0 + + u = tempwk%advconst(1) * hsum(uvel(:,:,:)) + v = tempwk%advconst(2) * hsum(vvel(:,:,:)) + + if (u(1) > 0.0d0) then + iteradvt = - u * 2.0d0 * tempx(:,1) + diagadvt = 2.0d0 * u + else if (u(1) < 0.0d0) then + iteradvt = u * 2.0d0 * tempx(:,3) + diagadvt = - 2.0d0 * u + end if + + if (v(1) > 0.0d0) then + iteradvt = iteradvt - v * 2.0d0 * tempy(:,1) + diagadvt = diagadvt + 2.0d0 * v + else if (v(1) < 0.0d0) then + iteradvt = iteradvt + v * 2.0d0 * tempy(:,3) + diagadvt = diagadvt - 2.0d0 * v + end if + + end subroutine fohadvpnt + + !------------------------------------------------------------------------- + + subroutine hadvall(model,temp,thck) + + type(glide_global_type) :: model + real(dp), dimension(:,0:,0:), intent(in) :: temp + real(dp), dimension(:,:), intent(in) :: thck + + real(dp), dimension(size(temp,dim=1)) :: diagadvt + + integer :: ew,ns + + model%tempwk%initadvt = 0.0d0 + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + if (thck(ew,ns) > model%numerics%thklim) then + + call hadvpnt(model%tempwk%initadvt(:,ew,ns), & + diagadvt, & + temp(:,ew-2:ew+2,ns), & + temp(:,ew,ns-2:ns+2), & + model%tempwk%hadv_u(:,ew,ns), & + model%tempwk%hadv_v(:,ew,ns)) + end if + end do + end do + + end subroutine hadvall + + !------------------------------------------------------------------------- + + subroutine findvtri(model,ew,ns,subd,diag,supd,diagadvt,weff,float) + + type(glide_global_type) :: model + integer, intent(in) :: ew, ns + real(dp), dimension(:), intent(in) :: weff, diagadvt + real(dp), dimension(:), intent(out) :: subd, diag, supd + logical, intent(in) :: float + + real(dp) :: fact(2) + +! These constants are precomputed: +! model%tempwk%cons(1) = 2.0d0 * tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2) +! model%tempwk%cons(2) = model%numerics%dttem / 2.0d0 + + fact(1) = VERT_DIFF*model%tempwk%cons(1) / model%geometry%thck(ew,ns)**2 + fact(2) = VERT_ADV*model%tempwk%cons(2) / model%geometry%thck(ew,ns) + + subd(2:model%general%upn-1) = fact(2) * weff(2:model%general%upn-1) * & + model%tempwk%dups(2:model%general%upn-1,3) + + supd(2:model%general%upn-1) = - subd(2:model%general%upn-1) - fact(1) * & + model%tempwk%dups(2:model%general%upn-1,2) + + subd(2:model%general%upn-1) = subd(2:model%general%upn-1) - fact(1) * & + model%tempwk%dups(2:model%general%upn-1,1) + + diag(2:model%general%upn-1) = 1.0d0 - subd(2:model%general%upn-1) & + - supd(2:model%general%upn-1) & + + diagadvt(2:model%general%upn-1) + + supd(1) = 0.0d0 + subd(1) = 0.0d0 + diag(1) = 1.0d0 + + ! now do the basal boundary + ! for grounded ice, a heat flux is applied + ! for floating ice, temperature held constant + + if (float) then + + supd(model%general%upn) = 0.0d0 + subd(model%general%upn) = 0.0d0 + diag(model%general%upn) = 1.0d0 + + else + + supd(model%general%upn) = 0.0d0 + subd(model%general%upn) = -0.5*fact(1)/(model%tempwk%dupn**2) + diag(model%general%upn) = 1.0d0 - subd(model%general%upn) + diagadvt(model%general%upn) + + end if + + end subroutine findvtri + + !------------------------------------------------------------------------- + + subroutine findvtri_init(model,ew,ns,subd,diag,supd,weff,temp,thck,float) + !> called during first iteration to set inittemp + + use glimmer_paramets, only: vel0, vel_scale + + type(glide_global_type) :: model + integer, intent(in) :: ew, ns + real(dp), dimension(:), intent(in) :: temp,diag,subd,supd,weff + real(dp), intent(in) :: thck + logical, intent(in) :: float + + ! local variables + real(dp) :: slterm + integer ewp,nsp + integer slide_count + + model%tempwk%inittemp(2:model%general%upn-1,ew,ns) = temp(2:model%general%upn-1) * & + (2.0d0 - diag(2:model%general%upn-1)) & + - temp(1:model%general%upn-2) * subd(2:model%general%upn-1) & + - temp(3:model%general%upn) * supd(2:model%general%upn-1) & + - model%tempwk%initadvt(2:model%general%upn-1,ew,ns) & + + model%temper%dissip(2:model%general%upn-1,ew,ns) + + if (float) then + model%tempwk%inittemp(model%general%upn,ew,ns) = temp(model%general%upn) + !EIB old!model%tempwk%inittemp(model%general%upn,ew,ns) = pmpt(thck) + else + ! sliding contribution to basal heat flux + slterm = 0. + slide_count = 0 + + !whl - BUG! - The following expression for taub*ubas is valid only for the SIA + ! Need a different expression for HO dynamics + + ! only include sliding contrib if temperature node is surrounded by sliding velo nodes + do nsp = ns-1,ns + do ewp = ew-1,ew + +!SCALING - WHL: Multiply ubas by vel0/vel_scale so we get the same result in these two cases: +! (1) Old Glimmer with scaling: vel0 = vel_scale = 500/scyr, and ubas is non-dimensional. +! (2) New CISM without scaling: vel0 = 1/scyr, vel_scale = 500/scyr, and ubas is in m/yr. + +!!! if ( abs(model%velocity%ubas(ewp,nsp)) > 0.000001 .or. & +!!! abs(model%velocity%vbas(ewp,nsp)) > 0.000001 ) then + if ( abs(model%velocity%ubas(ewp,nsp))*(vel0/vel_scale) > 1.d-6 .or. & + abs(model%velocity%vbas(ewp,nsp))*(vel0/vel_scale) > 1.d-6 ) then + + slide_count = slide_count + 1 + slterm = slterm + (& + model%geomderv%dusrfdew(ewp,nsp) * model%velocity%ubas(ewp,nsp) + & + model%geomderv%dusrfdns(ewp,nsp) * model%velocity%vbas(ewp,nsp)) + end if + end do + end do + if (slide_count >= 4) then + slterm = 0.25*slterm + else + slterm = 0. + end if + model%tempwk%inittemp(model%general%upn,ew,ns) = temp(model%general%upn) * & + (2.0d0 - diag(model%general%upn)) & + - temp(model%general%upn-1) * subd(model%general%upn) & + - 0.5*model%tempwk%cons(3) * model%temper%bheatflx(ew,ns) / (thck * model%tempwk%dupn) & ! geothermal heat flux (diff) + - model%tempwk%slide_f(1)*slterm/ model%tempwk%dupn & ! sliding heat flux (diff) + - model%tempwk%cons(4) * model%temper%bheatflx(ew,ns) * weff(model%general%upn) & ! geothermal heat flux (adv) + - model%tempwk%slide_f(2)*thck*slterm* weff(model%general%upn) & ! sliding heat flux (adv) + - model%tempwk%initadvt(model%general%upn,ew,ns) & + + model%temper%dissip(model%general%upn,ew,ns) + end if + + end subroutine findvtri_init + + !----------------------------------------------------------------------- + + subroutine findvtri_rhs(model,ew,ns,artm,iteradvt,rhsd,float) + + !> RHS of temperature tri-diag system + + type(glide_global_type) :: model + integer, intent(in) :: ew, ns + real(dp), intent(in) :: artm + real(dp), dimension(:), intent(in) :: iteradvt + real(dp), dimension(:), intent(out) :: rhsd + logical, intent(in) :: float + + ! upper boundary condition + rhsd(1) = artm + if (float) then + rhsd(model%general%upn) = model%tempwk%inittemp(model%general%upn,ew,ns) + else + rhsd(model%general%upn) = model%tempwk%inittemp(model%general%upn,ew,ns) - iteradvt(model%general%upn) + end if + rhsd(2:model%general%upn-1) = model%tempwk%inittemp(2:model%general%upn-1,ew,ns) - iteradvt(2:model%general%upn-1) + + end subroutine findvtri_rhs + +!------------------------------------------------------------------- + + subroutine glide_calcbmlt(model, temp, & + thck, stagthck, & + dusrfdew, dusrfdns, & + ubas, vbas, & + bmlt, floater) + + type(glide_global_type) :: model + real(dp), dimension(:,0:,0:), intent(in) :: temp + real(dp), dimension(:,:), intent(in) :: thck, stagthck, dusrfdew, dusrfdns, ubas, vbas + real(dp), dimension(:,:), intent(inout) :: bmlt ! scaled basal melting, m/s * tim0/thk0 + ! > 0 for melting, < 0 for freeze-on + logical, dimension(:,:), intent(in) :: floater + + real(dp), dimension(size(model%numerics%sigma)) :: pmptemp + real(dp) :: slterm, newmlt + + integer :: ewp, nsp, up, ew, ns + + !LOOP: all scalar points except outer row + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + if (thck(ew,ns) > model%numerics%thklim .and. .not. floater(ew,ns)) then + + call calcpmpt(pmptemp,thck(ew,ns),model%numerics%sigma) + + if (abs(temp(model%general%upn,ew,ns)-pmptemp(model%general%upn)) < 0.001) then + + slterm = 0.0d0 + + ! 0-order SIA approx. --> Tau_d = Tau_b + + do nsp = ns-1,ns + do ewp = ew-1,ew + slterm = slterm - stagthck(ewp,nsp) * & + (dusrfdew(ewp,nsp) * ubas(ewp,nsp) + dusrfdns(ewp,nsp) * vbas(ewp,nsp)) + end do + end do + + !*sfp* NOTE that multiplication by this term has been moved up from below + slterm = model%tempwk%f(4) * slterm + + bmlt(ew,ns) = 0.0d0 + + !*sfp* changed this so that 'slterm' is multiplied by f(4) const. above ONLY for the 0-order SIA case, + ! since for the HO and SSA cases a diff. const. needs to be used + + ! OLD version +! newmlt = model%tempwk%f(4) * slterm - model%tempwk%f(2)*model%temper%bheatflx(ew,ns) + model%tempwk%f(3) * & +! model%tempwk%dupc(model%general%upn) * & +! thck(ew,ns) * model%temper%dissip(model%general%upn,ew,ns) + + ! NEW version (sfp) + newmlt = slterm - model%tempwk%f(2)*model%temper%bheatflx(ew,ns) & + + model%tempwk%f(3) * model%tempwk%dupc(model%general%upn) * & + thck(ew,ns) * model%temper%dissip(model%general%upn,ew,ns) + + up = model%general%upn - 1 + + do while (abs(temp(up,ew,ns)-pmptemp(up)) < 1.d-3 .and. up >= 3) + bmlt(ew,ns) = bmlt(ew,ns) + newmlt + newmlt = model%tempwk%f(3) * model%tempwk%dupc(up) * thck(ew,ns) * model%temper%dissip(up,ew,ns) + up = up - 1 + end do + + up = up + 1 + + if (up == model%general%upn) then + bmlt(ew,ns) = newmlt - & + model%tempwk%f(1) * ( (temp(up-2,ew,ns) - pmptemp(up-2)) * model%tempwk%dupa(up) & + + (temp(up-1,ew,ns) - pmptemp(up-1)) * model%tempwk%dupb(up) ) / thck(ew,ns) + else + bmlt(ew,ns) = bmlt(ew,ns) + max(0.d0, newmlt - & + model%tempwk%f(1) * ( (temp(up-2,ew,ns) - pmptemp(up-2)) * model%tempwk%dupa(up) & + + (temp(up-1,ew,ns) - pmptemp(up-1)) * model%tempwk%dupb(up) ) / thck(ew,ns)) + end if + + else + + bmlt(ew,ns) = 0.d0 + + end if + + !EIB! else if (model%options%use_plume == 1) then + + ! do nothing because the plume model will have written the bmlt field + else + + bmlt(ew,ns) = 0.d0 + + end if + end do + end do + + ! apply periodic BC + + if (model%options%periodic_ew) then + do ns = 2,model%general%nsn-1 + bmlt(1,ns) = bmlt(model%general%ewn-1,ns) + bmlt(model%general%ewn,ns) = bmlt(2,ns) + end do + end if + + end subroutine glide_calcbmlt + +!------------------------------------------------------------------- + + subroutine glide_finddisp(model, & + thck , stagthck, & + dusrfdew, dusrfdns, & + flwa) + + ! Compute the dissipation source term associated with strain heating. + ! Note also that dissip and flwa must have the same vertical dimension + ! (1:upn on an unstaggered vertical grid, or 1:upn-1 on a staggered vertical grid). + + use glimmer_physcon, only : gn + + type(glide_global_type) :: model + real(dp), dimension(:,:), intent(in) :: thck, stagthck, dusrfdew, dusrfdns + real(dp), dimension(:,:,:), intent(in) :: flwa + + integer, parameter :: p1 = gn + 1 + integer :: ew, ns + + real(dp) :: c2 + + !WHL - Previously, this subroutine computed dissipation using either an SIA + ! or 1st-order expression, based on the value of which_disp. + ! Now only the SIA expression is used for Glide. + ! (Glissade can use either one, depending on which_ho_disp.) + + !*sfp* 0-order SIA case only + ! two methods of doing this. + ! 1. find dissipation at u-pts and then average + ! 2. find dissipation at H-pts by averaging quantities from u-pts + ! 2. works best for eismint divide (symmetry) but 1 likely to be better for full expts + + model%temper%dissip(:,:,:) = 0.0d0 + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + if (thck(ew,ns) > model%numerics%thklim) then + + c2 = (0.25*sum(stagthck(ew-1:ew,ns-1:ns)) * dsqrt((0.25*sum(dusrfdew(ew-1:ew,ns-1:ns)))**2 & + + (0.25*sum(dusrfdns(ew-1:ew,ns-1:ns)))**2))**p1 + + model%temper%dissip(:,ew,ns) = c2 * model%tempwk%c1(:) * ( & + flwa(:,ew-1,ns-1) + flwa(:,ew-1,ns+1) + flwa(:,ew+1,ns+1) + flwa(:,ew+1,ns-1) + & + 2*(flwa(:,ew-1,ns)+flwa(:,ew+1,ns)+flwa(:,ew,ns-1)+flwa(:,ew,ns+1)) + & + 4*flwa(:,ew,ns)) + + end if + end do + end do + + end subroutine glide_finddisp + +!----------------------------------------------------------------------------------- + + subroutine corrpmpt(temp,thck,bwat,sigma,upn) + + real(dp), dimension(:), intent(inout) :: temp + real(dp), intent(in) :: thck, bwat + integer,intent(in) :: upn + real(dp),dimension(:),intent(in) :: sigma + + real(dp), dimension(:) :: pmptemp(size(temp)) + + ! corrects a temperature column for melting point effects + ! 1. if temperature at any point in column is above pressure melting point then + ! set temperature to pressure melting point + ! 2. if bed is wet set basal temperature to pressure melting point + + call calcpmpt(pmptemp,thck,sigma) + + temp = dmin1(temp,pmptemp) + + if (bwat > 0.0d0) temp(upn) = pmptemp(upn) + + end subroutine corrpmpt + +!------------------------------------------------------------------- + + subroutine calcpmpt(pmptemp,thck,sigma) + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), dimension(:), intent(out) :: pmptemp + real(dp), intent(in) :: thck + real(dp),intent(in),dimension(:) :: sigma + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp(:) = fact * thck * sigma(:) + + end subroutine calcpmpt + + !----------------------------------------------------------------------- + + subroutine glide_calcbpmp(model,thck,bpmp) + + ! Calculate the pressure melting point at the base of the ice sheet + + type(glide_global_type) :: model + real(dp), dimension(:,:), intent(in) :: thck + real(dp), dimension(:,:), intent(out) :: bpmp + + integer :: ew,ns + + bpmp = 0.d0 + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + call calcpmptb(bpmp(ew,ns),thck(ew,ns)) + end do + end do + + end subroutine glide_calcbpmp + +!------------------------------------------------------------------- + + subroutine calcpmptb(pmptemp,thck) + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), intent(out) :: pmptemp + real(dp), intent(in) :: thck + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp = fact * thck + + end subroutine calcpmptb + +!------------------------------------------------------------------- + + subroutine glide_calcflwa(sigma, thklim, flwa, temp, thck, flow_enhancement_factor, default_flwa_arg, flag) + + !> Calculates Glen's $A$ over the three-dimensional domain, + !> using one of three possible methods. + + use glimmer_physcon + use glimmer_paramets, only : thk0, vis0 + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + ! Note: The temperature array is assumed to start with horizontal index 1 (not 0). + ! We are not updating flwa in the glide temperature halo. + + ! The flwa, temp, and sigma arrays should have the same vertical dimension, 1:upn. + ! These quantities are defined at layer interfaces (not layer midpoints as in the + ! glam/glissade dycore). + + real(dp),dimension(:), intent(in) :: sigma !> Vertical coordinate + real(dp), intent(in) :: thklim !> thickness threshold + real(dp),dimension(:,:,:), intent(out) :: flwa !> The calculated values of $A$ + real(dp),dimension(:,:,:), intent(in) :: temp !> The 3D temperature field + real(dp),dimension(:,:), intent(in) :: thck !> The ice thickness + real(dp) :: flow_enhancement_factor !> flow enhancement factor in arrhenius relationship + real(dp), intent(in) :: default_flwa_arg !> Glen's A to use in isothermal case + integer, intent(in) :: flag !> Flag to select the method + !> of calculation: + !> \begin{description} + !> \item[0] {\em Paterson and Budd} relationship. + !> \item[1] {\em Paterson and Budd} relationship, with temperature set to + !> -5$^{\circ}$C. + !> \item[2] Set constant, {\em but not sure how this works at the moment\ldots} + !> \end{description} + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp), parameter :: fact = grav * rhoi * pmlt * thk0 + real(dp), parameter :: contemp = -5.0d0 + real(dp) :: default_flwa + real(dp),dimension(4) :: arrfact + real(dp), dimension(size(flwa,1)) :: tempcor + + integer :: ew, ns, up, ewn, nsn, upn + + !------------------------------------------------------------------------------------ + +! Some notes: +! vis0 = 1.39e-032 Pa-3 s-1 for glam dycore (and here for glide) +! = tau0**(-gn) * (vel0/len0) where tau0 = rhoi*grav*thk0 +! vis0*scyr = 4.39e-025 Pa-2 yr-1 +! For glam: default_flwa_arg = 1.0d-16 Pa-3 yr-1 by default +! Result is default_flwa = 227657117 (unitless) if flow factor = 1 +! This is the value given to thin ice. +! +! In old glide, default_flwa is just set to the flow factor (called 'fiddle') +! vis0 = 3.17E-024 Pa-3 s-1 for old glide dycore = 1d-16 Pa-3 yr-1 / scyr +! + + default_flwa = flow_enhancement_factor * default_flwa_arg / (vis0*scyr) + + !write(*,*)"Default flwa = ",default_flwa + + upn=size(flwa,1) ; ewn=size(flwa,2) ; nsn=size(flwa,3) + + arrfact = (/ flow_enhancement_factor * arrmlh / vis0, & ! Value of a when T* is above -263K + flow_enhancement_factor * arrmll / vis0, & ! Value of a when T* is below -263K + -actenh / gascon, & ! Value of -Q/R when T* is above -263K + -actenl / gascon/) ! Value of -Q/R when T* is below -263K + + select case(flag) + case(FLWA_PATERSON_BUDD) + + ! This is the Paterson and Budd relationship + + do ns = 1,nsn + do ew = 1,ewn + if (thck(ew,ns) > thklim) then + + ! Calculate the corrected temperature + + do up = 1, upn + tempcor(up) = min(0.0d0, temp(up,ew,ns) + thck(ew,ns) * fact * sigma(up)) + tempcor(up) = max(-50.0d0, tempcor(up)) + enddo + + ! Calculate Glen's A + + call patebudd(tempcor(:), flwa(:,ew,ns), arrfact) + + else + flwa(:,ew,ns) = default_flwa + end if + + end do + end do + + case(FLWA_PATERSON_BUDD_CONST_TEMP) + + ! This is the Paterson and Budd relationship, but with the temperature held constant + ! at -5 deg C + + do ns = 1,nsn + do ew = 1,ewn + if (thck(ew,ns) > thklim) then + + ! Calculate Glen's A with a fixed temperature. + + call patebudd((/(contemp, up=1,upn)/),flwa(:,ew,ns),arrfact) + + else + flwa(:,ew,ns) = default_flwa + end if + end do + end do + + case(FLWA_CONST_FLWA) + + flwa(:,:,:) = default_flwa + + end select + + end subroutine glide_calcflwa + +!------------------------------------------------------------------------------------------ + + subroutine patebudd(tempcor,calcga,arrfact) + + !> Calculates the value of Glen's $A$ for the temperature values in a one-dimensional + !> array. The input array is usually a vertical temperature profile. The equation used + !> is from \emph{Paterson and Budd} [1982]: + !> \[ + !> A(T^{*})=a \exp \left(\frac{-Q}{RT^{*}}\right) + !> \] + !> This is equation 9 in {\em Payne and Dongelmans}. $a$ is a constant of proportionality, + !> $Q$ is the activation energy for for ice creep, and $R$ is the universal gas constant. + !> The pressure-corrected temperature, $T^{*}$ is given by: + !> \[ + !> T^{*}=T-T_{\mathrm{pmp}}+T_0 + !> \] + !> \[ + !> T_{\mathrm{pmp}}=T_0-\sigma \rho g H \Phi + !> \] + !> $T$ is the ice temperature, $T_{\mathrm{pmp}}$ is the pressure melting point + !> temperature, $T_0$ is the triple point of water, $\rho$ is the ice density, and + !> $\Phi$ is the (constant) rate of change of melting point temperature with pressure. + + use glimmer_physcon, only : trpt + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + real(dp),dimension(:), intent(in) :: tempcor !> Input temperature profile. This is + !> {\em not} $T^{*}$, as it has $T_0$ + !> added to it later on; rather it is + !> $T-T_{\mathrm{pmp}}$. + real(dp),dimension(:), intent(out) :: calcga !> The output values of Glen's $A$. + real(dp),dimension(4), intent(in) :: arrfact !> Constants for the calculation. These + !> are set when the velo module is initialised + + !------------------------------------------------------------------------------------ + +! arrfact = (/ flow_enhancement_factor * arrmlh / vis0, & ! Value of a when T* is above -263K +! flow_enhancement_factor * arrmll / vis0, & ! Value of a when T* is below -263K +! -actenh / gascon, & ! Value of -Q/R when T* is above -263K +! -actenl / gascon/) ! Value of -Q/R when T* is below -263K +! +! where arrmlh = 1.733d3 Pa-3 s-1 +! arrmll = 3.613d-13 Pa-3 s-1 +! and vis0 has units Pa-3 s-1 +! The result calcga is a scaled flwa, multiplied by flow_enhancement_factor + + ! Actual calculation is done here - constants depend on temperature ----------------- + + where (tempcor >= -10.0d0) + calcga = arrfact(1) * exp(arrfact(3) / (tempcor + trpt)) + elsewhere + calcga = arrfact(2) * exp(arrfact(4) / (tempcor + trpt)) + end where + + end subroutine patebudd + +!------------------------------------------------------------------- + +end module glide_temp + +!------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_thck.F90 b/components/cism/glimmer-cism/libglide/glide_thck.F90 new file mode 100644 index 0000000000..a8f47ecb08 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_thck.F90 @@ -0,0 +1,1137 @@ +! WJS (1-30-12): The following (turning optimization off) is included as a workaround for +! LONG (infinite???) compile times with xlf, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_thck.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_nan.inc" + +module glide_thck + + use glimmer_global, only : dp + use glide_types + use glimmer_sparse + use glimmer_sparse_type + + !DEBUG only +!! use xls + + !TODO - Remove oldglide when code comparisons are complete + use glimmer_paramets, only: oldglide + + implicit none + + private + + public :: init_thck, thck_nonlin_evolve, thck_lin_evolve, stagleapthck, & + glide_thck_index, glide_calclsrf + + ! debugging Picard iteration + integer, private, parameter :: picard_unit=101 + real(dp),private, parameter :: picard_interval=500.d0 + integer, private :: picard_max=0 + +contains + + subroutine init_thck(model) + + !> initialise work data for ice thickness evolution + use glimmer_log + use glimmer_paramets, only: GLC_DEBUG + implicit none + type(glide_global_type) :: model + + ! Removed this messy array +!! model%solver_data%fc2 = (/ model%numerics%alpha * model%numerics%dt / (2.0d0 * model%numerics%dew * model%numerics%dew), & +!! model%numerics%dt, & +!! (1.0d0 - model%numerics%alpha) / model%numerics%alpha, & +!! 1.0d0 / model%numerics%alpha, & +!! model%numerics%alpha * model%numerics%dt / (2.0d0 * model%numerics%dns * model%numerics%dns), & +!! 0.0d0 /) + + ! WJS: The following code has syntax errors; simply commenting it out for now + ! if (GLC_DEBUG) then + ! call write_log('Logging Picard iterations') + ! if (main_task) then + ! open(picard_unit,name='picard_info.data',status='unknown') + ! write(picard_unit,*) '#time max_iter' + ! end if + ! end if + +!TODO - Make sure the arrays allocated here are deallocated at the end of the run. +! Might want to move allocation/deallocation to subroutines in glide_types. + + ! allocate memory for ADI scheme + + if (model%options%whichevol == EVOL_ADI) then + allocate(model%thckwk%alpha(max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%beta (max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%gamma(max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%delta(max(model%general%ewn, model%general%nsn))) + end if + + end subroutine init_thck + +!--------------------------------------------------------------------------------- + + subroutine thck_lin_evolve(model,newtemps) + + !> this subroutine solves the linearised ice thickness equation by computing the + !> diffusivity from quantities of the previous time step + + use glide_velo + use glimmer_paramets, only: GLC_DEBUG + use glide_grid_operators, only: glide_geometry_derivs + + implicit none + + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !> true when we should recalculate Glen's A + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0, model%geometry%thck + model%climate%acab * model%numerics%dt) + if (GLC_DEBUG) then + print *, "* thck empty - net accumulation added", model%numerics%time + end if + else + + !Note: glide_geometry_derivs is called at the beginning of glide_tstep_p1, + ! and the geometry has not changed, so stagthck and the geometry + ! derivatives are still up to date. A call might be needed here + ! if glide_tstep_p2 were called out of order. + +!! call glide_geometry_derivs(model) + + ! calculate basal velos + if (newtemps) then + + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk, & + model%geomderv%stagthck, & + model%temper%flwa) + + end if + + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + + call velo_calc_diffu(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%diffu) + + ! get new thicknesses + + call thck_evolve(model, & + model%velocity%diffu, model%velocity%diffu, & + .true., & + model%geometry%thck, model%geometry%thck) + +!--- MJH: Since the linear evolution uses a diffusivity based on the old geometry, the +! velocity calculated here will also be based on the old geometry. If it is +! desired to calculate a velocity for the new evolved geometry, then the diffusivity +! and other things need to be updated before calculating velocity (commented out with !* ). +! If using this block starting with !* , delete the call to slipvelo with option 3 below. +!* ! Update geometry information for new thickness before calculating velocity +!* model%geometry%usrf = model%geometry%lsrf + model%geometry%thck ! usrf needed for slope calculations in geometry_derivs +!* call geometry_derivs(model) !this updates stagthck and the slopes +!* call velo_calc_diffu(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & +!* model%geomderv%dusrfdns,model%velocity%diffu) +!* call slipvelo(model, & +!* 0, & +!* model%velocity% btrc, & +!* model%velocity% ubas, & +!* model%velocity% vbas) +!---- + + ! calculate horizontal velocity field + ! (These calls must appear after thck_evolve, as thck_evolve uses ubas, + ! which slipvelo mutates) + + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + + call velo_calc_velo(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%temper%flwa, model%velocity%diffu, & + model%velocity%ubas, model%velocity%vbas, & + model%velocity%uvel, model%velocity%vvel, & + model%velocity%uflx, model%velocity%vflx,& + model%velocity%velnorm) + + end if + + end subroutine thck_lin_evolve + +!--------------------------------------------------------------------------------- + + subroutine thck_nonlin_evolve(model,newtemps) + + !> this subroutine solves the ice thickness equation by doing an outer, + !> non-linear iteration to update the diffusivities and in inner, linear + !> iteration to calculate the new ice thickness distrib + + use glide_velo + use glide_setup + use glide_nonlin !For unstable manifold correction + use glimmer_paramets, only: thk0, thk_scale, GLC_DEBUG + use glide_grid_operators, only: glide_geometry_derivs + + !EIB! use glide_deriv, only : df_field_2d_staggered + implicit none + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !> true when we should recalculate Glen's A + + ! local variables + integer, parameter :: pmax=50 !> maximum Picard iterations + + real(dp), parameter :: tol=1.0d-6 + real(dp) :: residual + integer p + logical first_p + +#ifdef USE_UNSTABLE_MANIFOLD + ! local variables used by unstable manifold correction + real(dp), dimension(model%general%ewn*model%general%nsn) :: umc_new_vec + real(dp), dimension(model%general%ewn*model%general%nsn) :: umc_old_vec + real(dp), dimension(model%general%ewn*model%general%nsn) :: umc_correction_vec + logical :: umc_continue_iteration + integer :: linearize_start + + umc_correction_vec = 0 + umc_new_vec = 0 + umc_old_vec = 0 +#endif + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0, model%geometry%thck + model%climate%acab * model%numerics%dt) + if (GLC_DEBUG) then + print *, "* thck empty - net accumulation added", model%numerics%time + end if + else + + !Note: glide_geometry_derivs is called at the beginning of glide_tstep_p1, + ! and the geometry has not changed, so stagthck and the geometry + ! derivatives are still up to date. A call might be needed here + ! if glide_tstep_p2 were called out of order. + ! This subroutine must be called during each Picard iteration below. + +!! call glide_geometry_derivs(model) + + ! calculate basal velos + if (newtemps) then + + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk, & + model%geomderv%stagthck, & + model%temper%flwa) + + end if + + first_p = .true. + model%thckwk%oldthck = model%geometry%thck + + ! do Picard iteration + + model%thckwk%oldthck2 = model%geometry%thck + + do p = 1, pmax + + ! update stagthck, dusrfdew/dns, dthckdew/dns + + call glide_geometry_derivs(model) + + ! flag = 2: compute basal contribution to diffusivity + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + call velo_calc_diffu(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%diffu) + + ! get new thickness + call thck_evolve(model, model%velocity%diffu, model%velocity%diffu, & + first_p, model%geometry%thck, model%geometry%thck) + + first_p = .false. + +!TODO - Is this option ever used? If so, then replace the ifdef with a logical option? +#ifdef USE_UNSTABLE_MANIFOLD + linearize_start = 1 + call linearize_2d(umc_new_vec, linearize_start, model%geometry%thck) + linearize_start = 1 + call linearize_2d(umc_old_vec, linearize_start, model%thckwk%oldthck2) + umc_continue_iteration = unstable_manifold_correction(umc_new_vec, umc_old_vec, & + umc_correction_vec, size(umc_correction_vec),& + tol) + !Only the old thickness might change as a result of this call + linearize_start = 1 + call delinearize_2d(umc_old_vec, linearize_start, model%thckwk%oldthck2) + + if (umc_continue_iteration) then + exit + end if +#else +!SCALING - Multiply thickness residual by thk0/thk_scale so we get the same result in these two cases: +! (1) Old Glimmer with scaling: thk0 = thk_scale = 2000 m, and thck is non-dimensional +! (2) New CISM without scaling: thk0 = 1, thk_scale = 2000 m, and thck is in true meters. + +!!! residual = maxval(abs(model%geometry%thck-model%thckwk%oldthck2)) + residual = maxval( abs(model%geometry%thck-model%thckwk%oldthck2) * (thk0/thk_scale) ) + + if (residual <= tol) then + exit + end if + + model%thckwk%oldthck2 = model%geometry%thck +#endif + + end do ! Picard iteration + + if (GLC_DEBUG) then + picard_max = max(picard_max,p) + if (model%numerics%tinc > mod(model%numerics%time,picard_interval)) then + write(picard_unit,*) model%numerics%time, p + picard_max = 0 + end if + end if + + ! Note: the values for stagthck, slopes, diffu, and ubas (from option 2 call to slipvelo) + ! will be outdated from the previous Picard iteration. + ! To ensure exact restarts are possible, calculate these one more time so that + ! they can be reconstructed with the restart values of thk and flwa + ! This will change answers very slightly (to within the Picard convergence tolerance) + ! relative to older versions of the code. --MJH 1/9/13 + +!WHL - oldglide does not update the diffusivity here +! By skipping this update, I get the same velocities as oldglide on the +! first timestep of the dome test case (within double-precision roundoff). +! Including this update, velocites agree only to ~4 sig digits. +! + + if (.not. oldglide) then ! update the diffusivity before computing the final velocity + + call glide_geometry_derivs(model) ! stagvarb, geomders as in old Glide code + + ! flag = 2: basal contribution to diffusivity + call slipvelo(model, & + 2, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + + ! calculate diffusivity + call velo_calc_diffu(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%diffu) + + endif ! oldglide = F + + ! calculate horizontal velocity field + + ! flag = 3: Calculate the basal velocity from the diffusivities + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + + call velo_calc_velo(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%temper%flwa, model%velocity%diffu, & + model%velocity%ubas, model%velocity%vbas, & + model%velocity%uvel, model%velocity%vvel, & + model%velocity%uflx, model%velocity%vflx,& + model%velocity%velnorm) + + end if ! model%geometry%empty + + end subroutine thck_nonlin_evolve + +!--------------------------------------------------------------------------------- + + subroutine thck_evolve(model, diffu_x, diffu_y, calc_rhs, old_thck, new_thck) + + !> set up sparse matrix and solve matrix equation to find new ice thickness distribution + !> this routine does not override the old thickness distribution + + use glimmer_log + use glimmer_paramets, only: vel0, thk0, GLC_DEBUG + + implicit none + + ! subroutine arguments ------------------------------------------------------------- + + type(glide_global_type) :: model + logical,intent(in) :: calc_rhs !> set to true when rhs should be calculated + !> i.e. when doing lin solution or first picard iteration + real(dp), intent(in), dimension(:,:) :: diffu_x + real(dp), intent(in), dimension(:,:) :: diffu_y + real(dp), intent(in), dimension(:,:) :: old_thck !> contains ice thicknesses from previous time step + real(dp), intent(inout), dimension(:,:) :: new_thck !> on entry contains first guess for new ice thicknesses + !> on exit contains ice thicknesses of new time step + + ! local variables ------------------------------------------------------------------ + + real(dp), dimension(5) :: sumd + real(dp) :: err + integer :: linit + integer :: ew,ns + + real(dp) :: alpha_dt_ew, alpha_dt_ns ! factors used repeatedly in matrix elements + + alpha_dt_ew = model%numerics%alpha * model%numerics%dt / (2.0d0 * model%numerics%dew * model%numerics%dew) + alpha_dt_ns = model%numerics%alpha * model%numerics%dt / (2.0d0 * model%numerics%dns * model%numerics%dns) + + ! Zero the arrays holding the sparse matrix + call sparse_clear(model%solver_data%matrix) + + ! Set the order of the matrix + model%solver_data%matrix%order = model%geometry%totpts + + !EIB! old way + ! the number of grid points + !model%solver_data%pcgsize(1) = model%geometry%totpts + ! Zero the arrays holding the sparse matrix + !model%solver_data%pcgval = 0.0 + !model%solver_data%pcgcol = 0 + !model%solver_data%pcgrow = 0 + !model%solver_data%ct = 1 + + ! Boundary Conditions --------------------------------------------------------------- + + ! BCs are for scalar points in outer layer of cells + + ! north and south BC + + do ew = 1,model%general%ewn + + ns=1 + if (model%geometry%thck_index(ew,ns) /= 0) then + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%solver_data,1.0d0, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns)) + if (calc_rhs) then + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = old_thck(ew,ns) + end if + model%solver_data%answ(model%geometry%thck_index(ew,ns)) = new_thck(ew,ns) + end if + + ns=model%general%nsn + if (model%geometry%thck_index(ew,ns) /= 0) then + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%solver_data,1.0d0, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns)) + if (calc_rhs) then + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = old_thck(ew,ns) + end if + model%solver_data%answ(model%geometry%thck_index(ew,ns)) = new_thck(ew,ns) + end if + + end do + + ! east and west BC + + if (model%options%periodic_ew) then + + do ns=2,model%general%nsn-1 + ew = 1 + if (model%geometry%thck_index(ew,ns) /= 0) then + call findsums(model%general%ewn-2,model%general%ewn-1,ns-1,ns) + call generate_row(model%general%ewn-2,ew,ew+1,ns-1,ns,ns+1) + end if + + ew=model%general%ewn + if (model%geometry%thck_index(ew,ns) /= 0) then + call findsums(1,2,ns-1,ns) + call generate_row(ew-1,ew,3,ns-1,ns,ns+1) + end if + end do + + else + + do ns=2,model%general%nsn-1 + + ew=1 + if (model%geometry%thck_index(ew,ns) /= 0) then + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%solver_data,1.0d0, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns)) + if (calc_rhs) then + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = old_thck(ew,ns) + end if + model%solver_data%answ(model%geometry%thck_index(ew,ns)) = new_thck(ew,ns) + end if + + ew=model%general%ewn + if (model%geometry%thck_index(ew,ns) /= 0) then + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%solver_data,1.0d0, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns)) + if (calc_rhs) then + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = old_thck(ew,ns) + end if + model%solver_data%answ(model%geometry%thck_index(ew,ns)) = new_thck(ew,ns) + end if + + end do + + end if ! periodic_ew + + ! ice interior ------------------------------------------------------------------------- + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + + if (model%geometry%thck_index(ew,ns) /= 0) then + + call findsums(ew-1, ew, ns-1, ns) + call generate_row(ew-1, ew, ew+1, ns-1, ns, ns+1) + + end if + end do + end do + + !TODO - EIB - not needed? + ! Calculate the total number of points + !model%solver_data%pcgsize(2) = model%solver_data%ct - 1 + + ! Solve the system using SLAP + !EIB! call slapsolv(model,linit,err) + + call sparse_easy_solve(model%solver_data%matrix, & + model%solver_data%rhsd, model%solver_data%answ, & + err, linit) + + ! Rejig the solution onto a 2D array + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + if (model%geometry%thck_index(ew,ns) /= 0) then + new_thck(ew,ns) = model%solver_data%answ(model%geometry%thck_index(ew,ns)) + end if + end do + end do + + new_thck = max(0.0d0, new_thck) + + if (GLC_DEBUG) then + print *, "* thck ", model%numerics%time, linit, model%geometry%totpts, & + real(thk0 * new_thck(model%general%ewn/2+1,model%general%nsn/2+1)), & + real(vel0 * maxval(abs(model%velocity%ubas))), real(vel0*maxval(abs(model%velocity%vbas))) + end if + + !TODO Why are lsrf and usrf calculated here? This is confusing because model%geometry%thck has only been updated + ! because new_thck points to it, but that was only the case because of the way this subroutine is called, and would + ! not generally be true. This calculation should be made with new_thck, if it's going to be made here at all! + + ! calculate upper and lower surface + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + contains + + subroutine generate_row(ewm, ew, ewp, & + nsm, ns, nsp) + + ! calculate row of sparse matrix equation + + implicit none + + integer, intent(in) :: ewm,ew,ewp ! ew index to left, central, right node + integer, intent(in) :: nsm,ns,nsp ! ns index to lower, central, upper node + + !fill matrix using the new API + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ewm,ns), sumd(1)) ! point (ew-1,ns) + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ewp,ns), sumd(2)) ! point (ew+1,ns) + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,nsm), sumd(3)) ! point (ew,ns-1) + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,nsp), sumd(4)) ! point (ew,ns+1) + call sparse_insert_val(model%solver_data%matrix, model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns), 1d0 + sumd(5))! point (ew,ns) + + !EIB! old way + ! fill sparse matrix + ! call putpcgc(model%solver_data,sumd(1), model%geometry%thck_index(ewm,ns), model%geometry%thck_index(ew,ns)) ! point (ew-1,ns) + ! call putpcgc(model%solver_data,sumd(2), model%geometry%thck_index(ewp,ns), model%geometry%thck_index(ew,ns)) ! point (ew+1,ns) + ! call putpcgc(model%solver_data,sumd(3), model%geometry%thck_index(ew,nsm), model%geometry%thck_index(ew,ns)) ! point (ew,ns-1) + ! call putpcgc(model%solver_data,sumd(4), model%geometry%thck_index(ew,nsp), model%geometry%thck_index(ew,ns)) ! point (ew,ns+1) + ! call putpcgc(model%solver_data,1.0d0 + sumd(5), model%geometry%thck_index(ew,ns), model%geometry%thck_index(ew,ns))! point (ew,ns) + + ! calculate RHS + if (calc_rhs) then + + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = & + old_thck(ew,ns) * (1.0d0 - ((1.0d0-model%numerics%alpha)/model%numerics%alpha) * sumd(5)) & + - ((1.0d0 - model%numerics%alpha) / model%numerics%alpha) * & + (old_thck(ewm,ns) * sumd(1) & + + old_thck(ewp,ns) * sumd(2) & + + old_thck(ew,nsm) * sumd(3) & + + old_thck(ew,nsp) * sumd(4)) & + - (1.d0 / model%numerics%alpha) * (model%geometry%lsrf(ew,ns) * sumd(5) & + + model%geometry%lsrf(ewm,ns) * sumd(1) & + + model%geometry%lsrf(ewp,ns) * sumd(2) & + + model%geometry%lsrf(ew,nsm) * sumd(3) & + + model%geometry%lsrf(ew,nsp) * sumd(4)) & + + model%climate%acab(ew,ns) * model%numerics%dt + + if (model%options%basal_mbal==1) then ! basal melt rate included in continuity equation + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) = & + model%solver_data%rhsd(model%geometry%thck_index(ew,ns)) & + - model%temper%bmlt(ew,ns) * model%numerics%dt ! basal melt is positive for mass loss + end if + + end if ! calc_rhs + + model%solver_data%answ(model%geometry%thck_index(ew,ns)) = new_thck(ew,ns) + + end subroutine generate_row + +!--------------------------------------------------------------- + + subroutine findsums(ewm, ew, nsm, ns) + + ! calculate diffusivities + + implicit none + integer, intent(in) :: ewm,ew ! ew index to left, right + integer, intent(in) :: nsm,ns ! ns index to lower, upper + + ! calculate sparse matrix elements + sumd(1) = alpha_dt_ew * (& + (diffu_x(ewm,nsm) + diffu_x(ewm,ns)) + & + (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ewm,ns))) + sumd(2) = alpha_dt_ew * (& + (diffu_x(ew,nsm) + diffu_x(ew,ns)) + & + (model%velocity%ubas (ew,nsm) + model%velocity%ubas (ew,ns))) + sumd(3) = alpha_dt_ns * (& + (diffu_y(ewm,nsm) + diffu_y(ew,nsm)) + & + (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ew,nsm))) + sumd(4) = alpha_dt_ns * (& + (diffu_y(ewm,ns) + diffu_y(ew,ns)) + & + (model%velocity%ubas (ewm,ns) + model%velocity%ubas (ew,ns))) + sumd(5) = - (sumd(1) + sumd(2) + sumd(3) + sumd(4)) + + !EIB! old way + !sumd(1) = alpha_dt_ew * (& + ! (model%velocity%diffu(ewm,nsm) + model%velocity%diffu(ewm,ns)) + & + ! (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ewm,ns))) + !sumd(2) = alpha_dt_ew * (& + ! (model%velocity%diffu(ew,nsm) + model%velocity%diffu(ew,ns)) + & + ! (model%velocity%ubas (ew,nsm) + model%velocity%ubas (ew,ns))) + !sumd(3) = alpha_dt_ns * (& + ! (model%velocity%diffu(ewm,nsm) + model%velocity%diffu(ew,nsm)) + & + ! (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ew,nsm))) + !sumd(4) = alpha_dt_ns * (& + ! (model%velocity%diffu(ewm,ns) + model%velocity%diffu(ew,ns)) + & + ! (model%velocity%ubas (ewm,ns) + model%velocity%ubas (ew,ns))) + !sumd(5) = - (sumd(1) + sumd(2) + sumd(3) + sumd(4)) + + end subroutine findsums + + end subroutine thck_evolve + +!--------------------------------------------------------------- + +!WHL - This subroutine used to be called glide_maskthck and located in its own module, +! but I put it in glide_thck.F90 since it is used only for the glide thickness calculation. + + subroutine glide_thck_index(thck, acab, & + thck_index, totpts, & + include_adjacent, empty) + + ! Compute an integer mask for the glide thickness calculation. + ! The mask generally includes ice-covered cells (thck > 0), cells adjacent to + ! ice-covered cells, and cells with a positive mass balance (acab > 0). + + !------------------------------------------------------------------------- + ! Subroutine arguments + !------------------------------------------------------------------------- + + real(dp),dimension(:,:),intent(in) :: thck !> Ice thickness + real(dp),dimension(:,:),intent(in) :: acab !> Mass balance + integer, dimension(:,:),intent(out) :: thck_index !> integer index (1, 2, 3, ..., totpts) + integer, intent(out) :: totpts !> Total number of points in mask + logical, intent(in) :: include_adjacent ! If true, points with no ice but that are adjacent + ! to points with ice are included in the mask + logical, intent(out) :: empty !> true if no points in mask + + !------------------------------------------------------------------------- + ! Internal variables + !------------------------------------------------------------------------- + + logical,dimension(size(thck,2)) :: full + integer :: covtot + integer :: ew,ns,ewn,nsn + +!! integer,dimension(size(thck,2),2) :: band ! no longer used +!! integer, dimension(4) :: dom ! used to be an output argument, but no longer used + + !------------------------------------------------------------------------- + + ewn=size(thck,1) ; nsn=size(thck,2) + + thck_index = 0 + covtot = 0 + + !------------------------------------------------------------------------- + + do ns = 1,nsn + + full(ns) = .false. + + do ew = 1,ewn + + if ( thckcrit(thck(max(1,ew-1):min(ewn,ew+1),max(1,ns-1):min(nsn,ns+1)), acab(ew,ns)) ) then + + covtot = covtot + 1 + thck_index(ew,ns) = covtot + + if ( .not. full(ns) ) then +!! band(ns,1) = ew + full(ns) = .true. + else +!! band(ns,2) = ew + end if + + end if + end do + end do + + totpts = covtot + +!! dom(1:2) = (/ewn,1/) + empty = .true. + + do ns = 1,nsn + + if (full(ns)) then + + if (empty) then + empty = .false. +!! dom(3) = ns + end if + +!! dom(4) = ns +!! dom(1) = min0(dom(1),band(ns,1)) +!! dom(2) = max0(dom(2),band(ns,2)) + end if + + end do + + contains + + logical function thckcrit(ca,cb) + + implicit none + + real(dp),dimension(:,:),intent(in) :: ca + real(dp), intent(in) :: cb + + +!TODO - Is there any case in which we would not want to include adjacent cells +! in the mask for the thickness calculation? + + if (.not. include_adjacent) then + + ! Include only points with ice in the mask + ! ca(2,2) corresponds to the current (ew,ns) + + if ( ca(2,2) > 0.d0 .or. cb > 0.d0) then + thckcrit = .true. + else + thckcrit = .false. + end if + + else + + ! If the thickness in the region under consideration + ! or the mass balance is positive, thckcrit is .true. + ! This means that the mask includes points that have no + ! ice but are adjacent to points that do have ice + + if ( any((ca(:,:) > 0.d0)) .or. cb > 0.d0 ) then + thckcrit = .true. + else + thckcrit = .false. + end if + + end if + + end function thckcrit + + end subroutine glide_thck_index + + !----------------------------------------------------------------------------- + ! ADI routines + !----------------------------------------------------------------------------- + + subroutine stagleapthck(model,newtemps) + + !> this subroutine solves the ice sheet thickness equation using the ADI scheme + !> diffusivities are updated for each half time step + + !TODO The ADI scheme has not been checked for consistency with the new time-stepping convention. + + use glide_velo + use glimmer_utils, only: tridiag + use glimmer_paramets, only: GLC_DEBUG + use glide_grid_operators, only: glide_geometry_derivs + implicit none + + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !> true when we should recalculate Glen's A + + ! local variables + integer ew,ns, n + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0, model%geometry%thck + model%climate%acab * model%numerics%dt) + if (GLC_DEBUG) then + print *, "* thck empty - net accumulation added", model%numerics%time + end if + + else + + !Note: glide_geometry_derivs is called at the beginning of glide_tstep_p1, + ! and the geometry has not changed, so stagthck and the geometry + ! derivatives are still up to date. A call might be needed here + ! if glide_tstep_p2 were called out of order. + +!! call glide_geometry_derivs(model) + + ! calculate basal velos + + if (newtemps) then + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk,model%geomderv%stagthck,model%temper%flwa) + end if + + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + + call velo_calc_diffu(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%velocity%diffu) + + model%velocity%total_diffu(:,:) = model%velocity%diffu(:,:) + model%velocity%ubas(:,:) + + ! first ADI step, solve thickness equation along rows j + + n = model%general%ewn + do ns=2,model%general%nsn-1 + + call adi_tri ( model%thckwk%alpha, & + model%thckwk%beta, & + model%thckwk%gamma, & + model%thckwk%delta, & + model%geometry%thck(:,ns), & + model%geometry%lsrf(:,ns), & + model%climate%acab(:,ns), & + model%velocity%vflx(:,ns), & + model%velocity%vflx(:,ns-1), & + model%velocity%total_diffu(:,ns), & + model%velocity%total_diffu(:,ns-1), & + model%numerics%dt, & + model%numerics%dew, & + model%numerics%dns ) + !EIB! gc2 acab input, not sure why the difference + !model%climate%acab(:,ns)-real(model%options%basal_mbal)*real(model%temper%bmlt(:,ns),sp), & + + call tridiag(model%thckwk%alpha(1:n), & + model%thckwk%beta(1:n), & + model%thckwk%gamma(1:n), & + model%thckwk%oldthck(:,ns), & + model%thckwk%delta(1:n)) + end do + + model%thckwk%oldthck(:,:) = max(model%thckwk%oldthck(:,:), 0.d0) + + ! second ADI step, solve thickness equation along columns i + n = model%general%nsn + do ew=2,model%general%ewn-1 + call adi_tri ( model%thckwk%alpha, & + model%thckwk%beta, & + model%thckwk%gamma, & + model%thckwk%delta, & + model%thckwk%oldthck(ew,:), & + model%geometry%lsrf(ew, :), & + model%climate%acab(ew, :), & + model%velocity%uflx(ew,:), & + model%velocity%uflx(ew-1,:), & + model%velocity%total_diffu(ew,:), & + model%velocity%total_diffu(ew-1,:), & + model%numerics%dt, & + model%numerics%dns, & + model%numerics%dew ) + !EIB! again, input difference + !model%climate%acab(ew, :)-real(model%options%basal_mbal)*real(model%temper%bmlt(ew, :),sp), & + + call tridiag(model%thckwk%alpha(1:n), & + model%thckwk%beta(1:n), & + model%thckwk%gamma(1:n), & + model%geometry%thck(ew, :), & + model%thckwk%delta(1:n)) + end do + + model%geometry%thck(:,:) = max(model%geometry%thck(:,:), 0.d0) + + ! Apply boundary conditions + model%geometry%thck(1,:) = 0.d0 + model%geometry%thck(model%general%ewn,:) = 0.d0 + model%geometry%thck(:,1) = 0.d0 + model%geometry%thck(:,model%general%nsn) = 0.d0 + + ! calculate horizontal velocity field + + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + + call velo_calc_velo(model%velowk, model%geomderv%stagthck, & + model%geomderv%dusrfdew, model%geomderv%dusrfdns, & + model%temper%flwa, model%velocity%diffu, & + model%velocity%ubas, model%velocity%vbas, & + model%velocity%uvel, model%velocity%vvel, & + model%velocity%uflx, model%velocity%vflx, & + model%velocity%velnorm) + + end if ! empty + + !------------------------------------------------------------ + ! calculate upper and lower surface + !------------------------------------------------------------ + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + end subroutine stagleapthck + +!--------------------------------------------------------------------------------- + + subroutine adi_tri(a,b,c,d,thk,tpg,mb,flx_p,flx_m,dif_p,dif_m,dt,ds1, ds2) + + !> construct tri-diagonal matrix system for a column/row + + implicit none + + real(dp), dimension(:), intent(out) :: a !> alpha (subdiagonal) + real(dp), dimension(:), intent(out) :: b !> alpha (diagonal) + real(dp), dimension(:), intent(out) :: c !> alpha (superdiagonal) + real(dp), dimension(:), intent(out) :: d !> right-hand side + + real(dp), dimension(:), intent(in) :: thk !> ice thickness + real(dp), dimension(:), intent(in) :: tpg !> lower surface of ice + real(dp), dimension(:), intent(in) :: mb !> mass balance + real(dp), dimension(:), intent(in) :: flx_p !> flux +1/2 + real(dp), dimension(:), intent(in) :: flx_m !> flux -1/2 + real(dp), dimension(:), intent(in) :: dif_p !> diffusivity +1/2 + real(dp), dimension(:), intent(in) :: dif_m !> diffusivity -1/2 + + real(dp), intent(in) :: dt !> time step + real(dp), intent(in) :: ds1, ds2 !> spatial steps inline and transversal + + ! local variables + real(dp) :: f1, f2, f3 + integer :: i,n + + n = size(thk) + + f1 = dt/(4*ds1*ds1) + f2 = dt/(4*ds2) + f3 = dt/2. + + a(:) = 0. + b(:) = 0. + c(:) = 0. + d(:) = 0. + + a(1) = 0. + do i=2,n + a(i) = f1*(dif_m(i-1)+dif_p(i-1)) + end do + do i=1,n-1 + c(i) = f1*(dif_m(i)+dif_p(i)) + end do + c(n) = 0. + b(:) = -(a(:)+c(:)) + + ! calculate RHS + do i=2,n-1 + d(i) = thk(i) - & + f2 * (flx_p(i-1) + flx_p(i) - flx_m(i-1) - flx_m(i)) + & + f3 * mb(i) - & + a(i)*tpg(i-1) - b(i)*tpg(i) - c(i)*tpg(i+1) + end do + + b(:) = 1.+b(:) + + end subroutine adi_tri + +!------------------------------------------------------------------------- + + subroutine glide_calclsrf(thck,topg,eus,lsrf) + + ! Calculates the elevation of the lower surface of the ice, + ! by considering whether it is floating or not. + ! + ! NOTE: This subroutine computes over all grid cells, not just locally owned. + ! Halos should be updated before it is called. + + use glimmer_physcon, only : rhoi, rhoo + + implicit none + + real(dp), intent(in), dimension(:,:) :: thck !> Ice thickness + real(dp), intent(in), dimension(:,:) :: topg !> Bedrock topography elevation + real(dp), intent(in) :: eus !> global sea level + real(dp), intent(out), dimension(:,:) :: lsrf !> Lower ice surface elevation + + real(dp), parameter :: con = - rhoi / rhoo + + where (topg - eus < con * thck) + lsrf = con * thck + elsewhere + lsrf = topg + end where + + end subroutine glide_calclsrf + +!--------------------------------------------------------------------------------- + +!TODO - This subroutine is not used. Remove it? + + subroutine filterthck(thck,ewn,nsn) + + implicit none + + real(dp), dimension(:,:), intent(inout) :: thck + real(dp), dimension(:,:), allocatable :: smth + integer :: ewn,nsn + + real(dp), parameter :: f = 0.1d0 / 16.0d0 + integer :: count + integer :: ns,ew + + allocate(smth(ewn,nsn)) + count = 1 + + do ns = 3,nsn-2 + do ew = 3,ewn-2 + + if (all((thck(ew-2:ew+2,ns) > 0.0d0)) .and. all((thck(ew,ns-2:ns+2) > 0.0d0))) then + smth(ew,ns) = thck(ew,ns) + f * & + (thck(ew-2,ns) - 4.0d0 * thck(ew-1,ns) + 12.0d0 * thck(ew,ns) - & + 4.0d0 * thck(ew+1,ns) + thck(ew+2,ns) + & + thck(ew,ns-2) - 4.0d0 * thck(ew,ns-1) - & + 4.0d0 * thck(ew,ns+1) + thck(ew,ns+2)) + count = count + 1 + else + smth(ew,ns) = thck(ew,ns) + end if + + end do + end do + + thck(3:ewn-2,3:nsn-2) = smth(3:ewn-2,3:nsn-2) + print *, count + + deallocate(smth) + + end subroutine filterthck + +!---------------------------------------------------------------------- + +!TODO - This subroutine is not used. Remove it? + + subroutine swapbndh(bc,a,b,c,d) + + implicit none + + real(dp), intent(out), dimension(:) :: a, c + real(dp), intent(in), dimension(:) :: b, d + integer, intent(in) :: bc + + if (bc == 0) then + a = b + c = d + end if + + end subroutine swapbndh + +!--------------------------------------------------------------------------------- + +end module glide_thck + +!--------------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_thck.F90.archive b/components/cism/glimmer-cism/libglide/glide_thck.F90.archive new file mode 100644 index 0000000000..4408515d10 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_thck.F90.archive @@ -0,0 +1,1019 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_thck.F90.archive - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_nan.inc" + +module glide_thck + + use glide_types + use glide_velo_higher + use glimmer_sparse + use glimmer_sparse_type + use glide_grids + + !DEBUG ONLY, these should be deleted eventually + use glide_stop + use xls + use glide_io + private + public :: init_thck, thck_nonlin_evolve, thck_lin_evolve, timeders, & + stagleapthck, geometry_derivs, & + geometry_derivs_unstag + +#ifdef DEBUG_PICARD + ! debugging Picard iteration + integer, private, parameter :: picard_unit=101 + real, private, parameter :: picard_interval=500. + integer, private :: picard_max=0 +#endif + +contains + + subroutine init_thck(model) + !*FD initialise work data for ice thickness evolution + use glimmer_log + implicit none + type(glide_global_type) :: model + + + model%pcgdwk%fc2 = (/ model%numerics%alpha * model%numerics%dt / (2.0d0 * model%numerics%dew * model%numerics%dew), & + model%numerics%dt, & + (1.0d0-model%numerics%alpha) / model%numerics%alpha, & + 1.0d0 / model%numerics%alpha, & + model%numerics%alpha * model%numerics%dt / & + (2.0d0 * model%numerics%dns * model%numerics%dns), & + 0.0d0 /) + +#ifdef DEBUG_PICARD + call write_log('Logging Picard iterations') + open(picard_unit,name='picard_info.data',status='unknown') + write(picard_unit,*) '#time max_iter' +#endif + + ! allocate memory for ADI scheme + if (model%options%whichevol.eq.1) then + allocate(model%thckwk%alpha(max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%beta (max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%gamma(max(model%general%ewn, model%general%nsn))) + allocate(model%thckwk%delta(max(model%general%ewn, model%general%nsn))) + end if + end subroutine init_thck + +!--------------------------------------------------------------------------------- + + subroutine thck_lin_evolve(model,newtemps) + + !*FD this subroutine solves the linearised ice thickness equation by computing the + !*FD diffusivity from quantities of the previous time step + + use glide_velo + use glide_thckmask + implicit none + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !*FD true when we should recalculate Glen's A + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0,model%geometry%thck + model%climate%acab * model%pcgdwk%fc2(2)) +#ifdef DEBUG + print *, "* thck empty - net accumulation added", model%numerics%time +#endif + else + + !EIB! added from lanl + call geometry_derivs(model) + + ! calculate basal velos + if (newtemps) then + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk,model%geomderv%stagthck,model%temper%flwa) + end if + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + call velo_calc_diffu(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%velocity%diffu) + + !EIB! added from lanl + !Calculate higher-order velocities if the user asked for them + if (model%options%which_ho_diagnostic /= 0 ) then + call geometry_derivs_unstag(model) + call run_ho_diagnostic(model) + end if + + if (model%options%diagnostic_run == 1) then + call glide_finalise_all(.true.) + stop + end if + + if (model%options%which_ho_prognostic == HO_PROG_SIAONLY) then + ! get new thicknesses + call thck_evolve(model,model%velocity%diffu, model%velocity%diffu, .true.,model%geometry%thck,model%geometry%thck) + else if (model%options%which_ho_prognostic == HO_PROG_PATTYN) then + call thck_evolve(model,model%velocity_hom%diffu_x, model%velocity_hom%diffu_y, .true.,& + model%geometry%thck, model%geometry%thck) + + end if + !EIB! old? from gc2 + !call thck_evolve(model,.true.,model%geometry%thck,model%geometry%thck) + + ! calculate horizontal velocity field + ! (These calls must appear after thck_evolve, as thck_evolve uses ubas, + ! which slipvelo mutates) + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx,& + model%velocity%surfvel) + !EIB! old + !call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + ! model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + ! model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx) + end if + end subroutine thck_lin_evolve + +!--------------------------------------------------------------------------------- + + subroutine thck_nonlin_evolve(model,newtemps) + + !*FD this subroutine solves the ice thickness equation by doing an outer, + !*FD non-linear iteration to update the diffusivities and in inner, linear + !*FD iteration to calculate the new ice thickness distrib + + use glimmer_global, only : dp + use glide_velo + use glide_setup + use glide_thckmask + use glide_nonlin !For unstable manifold correction + !EIB! use glide_deriv, only : df_field_2d_staggered + implicit none + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !*FD true when we should recalculate Glen's A + + ! local variables + integer, parameter :: pmax=50 !*FD maximum Picard iterations + real(kind=dp), parameter :: tol=1.0d-6 + real(kind=dp) :: residual + integer p + logical first_p + +#ifdef USE_UNSTABLE_MANIFOLD + ! local variables used by unstable manifold correction + real(kind=dp), dimension(model%general%ewn*model%general%nsn) :: umc_new_vec + real(kind=dp), dimension(model%general%ewn*model%general%nsn) :: umc_old_vec + real(kind=dp), dimension(model%general%ewn*model%general%nsn) :: umc_correction_vec + logical :: umc_continue_iteration + integer :: linearize_start + + umc_correction_vec = 0 + umc_new_vec = 0 + umc_old_vec = 0 +#endif + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0,model%geometry%thck + model%climate%acab * model%pcgdwk%fc2(2)) +#ifdef DEBUG + print *, "* thck empty - net accumulation added", model%numerics%time +#endif + else + + ! calculate basal velos + if (newtemps) then + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk,model%geomderv%stagthck,model%temper%flwa) + end if + + first_p = .true. + model%thckwk%oldthck = model%geometry%thck + ! do Picard iteration + model%thckwk%oldthck2 = model%geometry%thck + do p=1,pmax + !EIB moved! model%thckwk%oldthck2 = model%geometry%thck + + call geometry_derivs(model) + !EIB! old way + !call stagvarb(model%geometry% thck, & + ! model%geomderv% stagthck,& + ! model%general% ewn, & + ! model%general% nsn) + !call df_field_2d_staggered(model%geometry%usrf, & + ! model%numerics%dew, model%numerics%dns, & + ! model%geomderv%dusrfdew, & + ! model%geomderv%dusrfdns, & + ! .false., .false.) + !call df_field_2d_staggered(model%geometry%thck, & + ! model%numerics%dew, model%numerics%dns, & + ! model%geomderv%dthckdew, & + ! model%geomderv%dthckdns, & + ! .false., .false.) + + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + call velo_calc_diffu(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%velocity%diffu) + + !Calculate higher-order velocities if the user asked for them + if (model%options%which_ho_diagnostic /= 0 ) then + call geometry_derivs_unstag(model) + call run_ho_diagnostic(model) + end if + + ! get new thicknesses + if (model%options%which_ho_prognostic == HO_PROG_SIAONLY) then + + call thck_evolve(model, model%velocity%diffu, model%velocity%diffu, & + first_p, model%geometry%thck, model%geometry%thck) + + else if (model%options%which_ho_prognostic == HO_PROG_PATTYN) then + + call thck_evolve(model,model%velocity_hom%diffu_x, model%velocity_hom%diffu_y, .true.,& + model%geometry%thck, model%geometry%thck) + + end if + !EIB! old way + ! get new thicknesses + !call thck_evolve(model,first_p,model%thckwk%oldthck,model%geometry%thck) + + first_p = .false. + +#ifdef USE_UNSTABLE_MANIFOLD + linearize_start = 1 + call linearize_2d(umc_new_vec, linearize_start, model%geometry%thck) + linearize_start = 1 + call linearize_2d(umc_old_vec, linearize_start, model%thckwk%oldthck2) + umc_continue_iteration = unstable_manifold_correction(umc_new_vec, umc_old_vec, & + umc_correction_vec, size(umc_correction_vec),& + tol) + !Only the old thickness might change as a result of this call + linearize_start = 1 + call delinearize_2d(umc_old_vec, linearize_start, model%thckwk%oldthck2) + + if (umc_continue_iteration) then + exit + end if +#else + residual = maxval(abs(model%geometry%thck-model%thckwk%oldthck2)) + if (residual.le.tol) then + exit + end if + model%thckwk%oldthck2 = model%geometry%thck +#endif + !EIB! old way + !residual = maxval(abs(model%geometry%thck-model%thckwk%oldthck2)) + !if (residual.le.tol) then + ! exit + !end if + + end do +#ifdef DEBUG_PICARD + picard_max=max(picard_max,p) + if (model%numerics%tinc > mod(model%numerics%time,picard_interval)) then + write(picard_unit,*) model%numerics%time,p + picard_max = 0 + end if +#endif + + ! calculate horizontal velocity field + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx,& + model%velocity%surfvel) + !EIB! old way + !call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + ! model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + ! model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx) + end if + end subroutine thck_nonlin_evolve + +!--------------------------------------------------------------------------------- + + subroutine thck_evolve(model,diffu_x, diffu_y, calc_rhs,old_thck,new_thck) + + !*FD set up sparse matrix and solve matrix equation to find new ice thickness distribution + !*FD this routine does not override the old thickness distribution + + use glide_setup, only: glide_calclsrf + use glimmer_global, only : dp + use glide_stop + use glimmer_log +#if DEBUG + use glimmer_paramets, only: vel0, thk0 +#endif + + implicit none + + ! subroutine arguments ------------------------------------------------------------- + + type(glide_global_type) :: model + logical,intent(in) :: calc_rhs !*FD set to true when rhs should be calculated + !*FD i.e. when doing lin solution or first picard iteration + real(dp), intent(in), dimension(:,:) :: diffu_x + real(dp), intent(in), dimension(:,:) :: diffu_y + real(dp), intent(in), dimension(:,:) :: old_thck !*FD contains ice thicknesses from previous time step + real(dp), intent(inout), dimension(:,:) :: new_thck !*FD on entry contains first guess for new ice thicknesses + !*FD on exit contains ice thicknesses of new time step + + ! local variables ------------------------------------------------------------------ + + real(dp), dimension(5) :: sumd + real(dp) :: err + integer :: linit + integer :: ew,ns + + ! Zero the arrays holding the sparse matrix + call sparse_clear(model%pcgdwk%matrix) + + ! Set the order of the matrix + model%pcgdwk%matrix%order = model%geometry%totpts + + !EIB! old way + ! the number of grid points + !model%pcgdwk%pcgsize(1) = model%geometry%totpts + ! Zero the arrays holding the sparse matrix + !model%pcgdwk%pcgval = 0.0 + !model%pcgdwk%pcgcol = 0 + !model%pcgdwk%pcgrow = 0 + !model%pcgdwk%ct = 1 + + ! Boundary Conditions --------------------------------------------------------------- + ! lower and upper BC + do ew = 1,model%general%ewn + ns=1 + if (model%geometry%mask(ew,ns) /= 0) then + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%pcgdwk,1.0d0, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns)) + if (calc_rhs) then + model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = old_thck(ew,ns) + end if + model%pcgdwk%answ(model%geometry%mask(ew,ns)) = new_thck(ew,ns) + end if + ns=model%general%nsn + if (model%geometry%mask(ew,ns) /= 0) then + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%pcgdwk,1.0d0, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns)) + if (calc_rhs) then + model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = old_thck(ew,ns) + end if + model%pcgdwk%answ(model%geometry%mask(ew,ns)) = new_thck(ew,ns) + end if + end do + + !left and right BC + if (model%options%periodic_ew) then + do ns=2,model%general%nsn-1 + ew = 1 + if (model%geometry%mask(ew,ns) /= 0) then + call findsums(model%general%ewn-2,model%general%ewn-1,ns-1,ns) + call generate_row(model%general%ewn-2,ew,ew+1,ns-1,ns,ns+1) + end if + ew=model%general%ewn + if (model%geometry%mask(ew,ns) /= 0) then + call findsums(1,2,ns-1,ns) + call generate_row(ew-1,ew,3,ns-1,ns,ns+1) + end if + end do + else + do ns=2,model%general%nsn-1 + ew=1 + if (model%geometry%mask(ew,ns) /= 0) then + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%pcgdwk,1.0d0, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns)) + if (calc_rhs) then + model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = old_thck(ew,ns) + end if + model%pcgdwk%answ(model%geometry%mask(ew,ns)) = new_thck(ew,ns) + end if + ew=model%general%ewn + if (model%geometry%mask(ew,ns) /= 0) then + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns), 1d0) + !EIB! old way + !call putpcgc(model%pcgdwk,1.0d0, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns)) + if (calc_rhs) then + model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = old_thck(ew,ns) + end if + model%pcgdwk%answ(model%geometry%mask(ew,ns)) = new_thck(ew,ns) + end if + end do + end if + + ! ice body ------------------------------------------------------------------------- + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + + if (model%geometry%mask(ew,ns) /= 0) then + + call findsums(ew-1,ew,ns-1,ns) + call generate_row(ew-1,ew,ew+1,ns-1,ns,ns+1) + + end if + end do + end do + + !EIB! still needed? + ! Calculate the total number of points + !model%pcgdwk%pcgsize(2) = model%pcgdwk%ct - 1 + + ! Solve the system using SLAP + !EIB! call slapsolv(model,linit,err) + call sparse_easy_solve(model%pcgdwk%matrix, model%pcgdwk%rhsd, model%pcgdwk%answ, & + err, linit) + + ! Rejig the solution onto a 2D array + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + if (model%geometry%mask(ew,ns) /= 0) then + new_thck(ew,ns) = model%pcgdwk%answ(model%geometry%mask(ew,ns)) + end if + + end do + end do + + new_thck = max(0.0d0, new_thck) + +#ifdef DEBUG + print *, "* thck ", model%numerics%time, linit, model%geometry%totpts, & + real(thk0*new_thck(model%general%ewn/2+1,model%general%nsn/2+1)), & + real(vel0*maxval(abs(model%velocity%ubas))), real(vel0*maxval(abs(model%velocity%vbas))) +#endif + + ! calculate upper and lower surface + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + contains + + subroutine generate_row(ewm,ew,ewp,nsm,ns,nsp) + ! calculate row of sparse matrix equation + implicit none + integer, intent(in) :: ewm,ew,ewp ! ew index to left, central, right node + integer, intent(in) :: nsm,ns,nsp ! ns index to lower, central, upper node + + !fill matrix using the new API + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ewm,ns), sumd(1)) ! point (ew-1,ns) + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ewp,ns), sumd(2)) ! point (ew+1,ns) + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,nsm), sumd(3)) ! point (ew,ns-1) + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,nsp), sumd(4)) ! point (ew,ns+1) + call sparse_insert_val(model%pcgdwk%matrix, model%geometry%mask(ew,ns), model%geometry%mask(ew,ns), 1d0 + sumd(5))! point (ew,ns) + !EIB! old way + ! fill sparse matrix + ! call putpcgc(model%pcgdwk,sumd(1), model%geometry%mask(ewm,ns), model%geometry%mask(ew,ns)) ! point (ew-1,ns) + ! call putpcgc(model%pcgdwk,sumd(2), model%geometry%mask(ewp,ns), model%geometry%mask(ew,ns)) ! point (ew+1,ns) + ! call putpcgc(model%pcgdwk,sumd(3), model%geometry%mask(ew,nsm), model%geometry%mask(ew,ns)) ! point (ew,ns-1) + ! call putpcgc(model%pcgdwk,sumd(4), model%geometry%mask(ew,nsp), model%geometry%mask(ew,ns)) ! point (ew,ns+1) + ! call putpcgc(model%pcgdwk,1.0d0 + sumd(5), model%geometry%mask(ew,ns), model%geometry%mask(ew,ns))! point (ew,ns) + + ! calculate RHS + if (calc_rhs) then + model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = & + old_thck(ew,ns) * (1.0d0 - model%pcgdwk%fc2(3) * sumd(5)) & + - model%pcgdwk%fc2(3) * (old_thck(ewm,ns) * sumd(1) & + + old_thck(ewp,ns) * sumd(2) & + + old_thck(ew,nsm) * sumd(3) & + + old_thck(ew,nsp) * sumd(4)) & + - model%pcgdwk%fc2(4) * (model%geometry%lsrf(ew,ns) * sumd(5) & + + model%geometry%lsrf(ewm,ns) * sumd(1) & + + model%geometry%lsrf(ewp,ns) * sumd(2) & + + model%geometry%lsrf(ew,nsm) * sumd(3) & + + model%geometry%lsrf(ew,nsp) * sumd(4)) & + + model%climate%acab(ew,ns) * model%pcgdwk%fc2(2) + end if + !EIB! old way + ! calculate RHS + !if (calc_rhs) then + ! model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = & + ! old_thck(ew,ns) * (1.0d0 - model%pcgdwk%fc2(3) * sumd(5)) & + ! - model%pcgdwk%fc2(3) * (old_thck(ewm,ns) * sumd(1) & + ! + old_thck(ewp,ns) * sumd(2) & + ! + old_thck(ew,nsm) * sumd(3) & + ! + old_thck(ew,nsp) * sumd(4)) & + ! - model%pcgdwk%fc2(4) * (model%geometry%lsrf(ew,ns) * sumd(5) & + ! + model%geometry%lsrf(ewm,ns) * sumd(1) & + ! + model%geometry%lsrf(ewp,ns) * sumd(2) & + ! + model%geometry%lsrf(ew,nsm) * sumd(3) & + ! + model%geometry%lsrf(ew,nsp) * sumd(4)) & + ! + model%climate%acab(ew,ns) * model%pcgdwk%fc2(2) + ! if(model%options%basal_mbal==1) then + ! model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) = & + ! model%pcgdwk%rhsd(model%geometry%mask(ew,ns)) & + ! - model%temper%bmlt(ew,ns) * model%pcgdwk%fc2(2) ! basal melt is +ve for mass loss + ! end if + !end if + + model%pcgdwk%answ(model%geometry%mask(ew,ns)) = new_thck(ew,ns) + + end subroutine generate_row + + subroutine findsums(ewm,ew,nsm,ns) + ! calculate diffusivities + implicit none + integer, intent(in) :: ewm,ew ! ew index to left, right + integer, intent(in) :: nsm,ns ! ns index to lower, upper + + ! calculate sparse matrix elements + sumd(1) = model%pcgdwk%fc2(1) * (& + (diffu_x(ewm,nsm) + diffu_x(ewm,ns)) + & + (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ewm,ns))) + sumd(2) = model%pcgdwk%fc2(1) * (& + (diffu_x(ew,nsm) + diffu_x(ew,ns)) + & + (model%velocity%ubas (ew,nsm) + model%velocity%ubas (ew,ns))) + sumd(3) = model%pcgdwk%fc2(5) * (& + (diffu_y(ewm,nsm) + diffu_y(ew,nsm)) + & + (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ew,nsm))) + sumd(4) = model%pcgdwk%fc2(5) * (& + (diffu_y(ewm,ns) + diffu_y(ew,ns)) + & + (model%velocity%ubas (ewm,ns) + model%velocity%ubas (ew,ns))) + sumd(5) = - (sumd(1) + sumd(2) + sumd(3) + sumd(4)) + !EIB! old way + !sumd(1) = model%pcgdwk%fc2(1) * (& + ! (model%velocity%diffu(ewm,nsm) + model%velocity%diffu(ewm,ns)) + & + ! (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ewm,ns))) + !sumd(2) = model%pcgdwk%fc2(1) * (& + ! (model%velocity%diffu(ew,nsm) + model%velocity%diffu(ew,ns)) + & + ! (model%velocity%ubas (ew,nsm) + model%velocity%ubas (ew,ns))) + !sumd(3) = model%pcgdwk%fc2(5) * (& + ! (model%velocity%diffu(ewm,nsm) + model%velocity%diffu(ew,nsm)) + & + ! (model%velocity%ubas (ewm,nsm) + model%velocity%ubas (ew,nsm))) + !sumd(4) = model%pcgdwk%fc2(5) * (& + ! (model%velocity%diffu(ewm,ns) + model%velocity%diffu(ew,ns)) + & + ! (model%velocity%ubas (ewm,ns) + model%velocity%ubas (ew,ns))) + !sumd(5) = - (sumd(1) + sumd(2) + sumd(3) + sumd(4)) + + end subroutine findsums + end subroutine thck_evolve + + + + +!--------------------------------------------------------------- + +subroutine geometry_derivs(model) + use glide_mask, only: upwind_from_mask + implicit none + + !*FD Computes derivatives of the ice and bed geometry, as well as averaging + !*FD them onto the staggered grid + type(glide_global_type), intent(inout) :: model + + call stagthickness(model%geometry% thck, & + model%geomderv%stagthck,& + model%general%ewn, & + model%general%nsn, & + model%geometry%usrf, & + model%numerics%thklim, & + model%geometry%thkmask) + + call stagvarb(model%geometry%lsrf, & + model%geomderv%staglsrf,& + model%general%ewn, & + model%general%nsn) + + call stagvarb(model%geometry%topg, & + model%geomderv%stagtopg,& + model%general%ewn, & + model%general%nsn) + + + model%geomderv%stagusrf = model%geomderv%staglsrf + model%geomderv%stagthck + + + call df_field_2d_staggered(model%geometry%usrf, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + .false., .false.) + + call df_field_2d_staggered(model%geometry%thck, & + model%numerics%dew, model%numerics%dns, & + model%geomderv%dthckdew, & + model%geomderv%dthckdns, & + .false., .false.) + + !Make sure that the derivatives are 0 where staggered thickness is 0 + where (model%geomderv%stagthck == 0) + model%geomderv%dusrfdew = 0 + model%geomderv%dusrfdns = 0 + model%geomderv%dthckdew = 0 + model%geomderv%dthckdns = 0 + endwhere + + !TODO: correct signs + model%geomderv%dlsrfdew = model%geomderv%dusrfdew - model%geomderv%dthckdew + model%geomderv%dlsrfdns = model%geomderv%dusrfdns - model%geomderv%dthckdns + + !Compute second derivatives. + !TODO: Turn this on and off conditionally based on whether the computation + !is requred + + !Compute seond derivatives + !TODO: maybe turn this on and off conditionally? + call d2f_field_stag(model%geometry%usrf, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2usrfdew2, model%geomderv%d2usrfdns2, & + .false., .false.) + + call d2f_field_stag(model%geometry%thck, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2thckdew2, model%geomderv%d2thckdns2, & + .false., .false.) + +end subroutine + +!*FD Computes derivatives of the geometry onto variables on a nonstaggered +!*FD grid. Used for some higher-order routines +subroutine geometry_derivs_unstag(model) + implicit none + type(glide_global_type) :: model + + !Fields allow us to upwind derivatives at the ice sheet lateral boundaries + !so that we're not differencing out of the domain + real(dp), dimension(model%general%ewn, model%general%nsn) :: direction_x, direction_y + + call upwind_from_mask(model%geometry%thkmask, direction_x, direction_y) + call write_xls("direction_x_unstag.txt", direction_x) + call write_xls("direction_y_unstag.txt", direction_y) + !Compute first derivatives of geometry + call df_field_2d(model%geometry%usrf, model%numerics%dew, model%numerics%dns, & + model%geomderv%dusrfdew_unstag, model%geomderv%dusrfdns_unstag, & + .false., .false., direction_x, direction_y) + + call df_field_2d(model%geometry%lsrf, model%numerics%dew, model%numerics%dns, & + model%geomderv%dlsrfdew_unstag, model%geomderv%dlsrfdns_unstag, & + .false., .false., direction_x, direction_y) + + call df_field_2d(model%geometry%thck, model%numerics%dew, model%numerics%dns, & + model%geomderv%dthckdew_unstag, model%geomderv%dthckdns_unstag, & + .false., .false., direction_x, direction_y) + + call d2f_field(model%geometry%usrf, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2usrfdew2_unstag, model%geomderv%d2usrfdns2_unstag, & + direction_x, direction_y) + + call d2f_field(model%geometry%thck, model%numerics%dew, model%numerics%dns, & + model%geomderv%d2thckdew2_unstag, model%geomderv%d2thckdns2_unstag, & + direction_x, direction_y) + + +end subroutine + +!--------------------------------------------------------------------------------- + + subroutine timeders(thckwk,ipvr,opvr,mask,time,which) + + !*FD Calculates the time-derivative of a field. This subroutine is used by + !*FD the temperature solver only. + + use glimmer_global, only : dp, sp + use glimmer_paramets, only : conv + + implicit none + + type(glide_thckwk) :: thckwk !*FD Derived-type containing work data + real(dp), intent(out), dimension(:,:) :: opvr !*FD Input field + real(dp), intent(in), dimension(:,:) :: ipvr !*FD Output (derivative) field + real(sp), intent(in) :: time !*FD current time + integer, intent(in), dimension(:,:) :: mask !*FD mask for calculation + integer, intent(in) :: which !*FD selector for stored field + + real(sp) :: factor + + factor = (time - thckwk%oldtime) + if (factor .eq.0) then + opvr = 0.0d0 + else + factor = 1./factor + where (mask /= 0) + opvr = conv * (ipvr - thckwk%olds(:,:,which)) * factor + elsewhere + opvr = 0.0d0 + end where + end if + + thckwk%olds(:,:,which) = ipvr + + if (which == thckwk%nwhich) then + thckwk%oldtime = time + end if + + end subroutine timeders + +!--------------------------------------------------------------------------------- + + subroutine filterthck(thck,ewn,nsn) + + use glimmer_global, only : dp ! ew, ewn, ns, nsn + + implicit none + + real(dp), dimension(:,:), intent(inout) :: thck + real(dp), dimension(:,:), allocatable :: smth + integer :: ewn,nsn + + real(dp), parameter :: f = 0.1d0 / 16.0d0 + integer :: count + integer :: ns,ew + + allocate(smth(ewn,nsn)) + count = 1 + + do ns = 3,nsn-2 + do ew = 3,ewn-2 + + if (all((thck(ew-2:ew+2,ns) > 0.0d0)) .and. all((thck(ew,ns-2:ns+2) > 0.0d0))) then + smth(ew,ns) = thck(ew,ns) + f * & + (thck(ew-2,ns) - 4.0d0 * thck(ew-1,ns) + 12.0d0 * thck(ew,ns) - & + 4.0d0 * thck(ew+1,ns) + thck(ew+2,ns) + & + thck(ew,ns-2) - 4.0d0 * thck(ew,ns-1) - & + 4.0d0 * thck(ew,ns+1) + thck(ew,ns+2)) + count = count + 1 + else + smth(ew,ns) = thck(ew,ns) + end if + + end do + end do + + thck(3:ewn-2,3:nsn-2) = smth(3:ewn-2,3:nsn-2) + print *, count + + deallocate(smth) + + end subroutine filterthck + +!---------------------------------------------------------------------- + + subroutine swapbndh(bc,a,b,c,d) + + use glimmer_global, only : dp + + implicit none + + real(dp), intent(out), dimension(:) :: a, c + real(dp), intent(in), dimension(:) :: b, d + integer, intent(in) :: bc + + if (bc == 0) then + a = b + c = d + end if + + end subroutine swapbndh + + !----------------------------------------------------------------------------- + ! ADI routines + !----------------------------------------------------------------------------- + + subroutine stagleapthck(model,newtemps) + + !*FD this subroutine solves the ice sheet thickness equation using the ADI scheme + !*FD diffusivities are updated for each half time step + + use glide_setup, only: glide_calclsrf + use glide_velo + use glimmer_utils + implicit none + ! subroutine arguments + type(glide_global_type) :: model + logical, intent(in) :: newtemps !*FD true when we should recalculate Glen's A + + ! local variables + integer ew,ns, n + + if (model%geometry%empty) then + + model%geometry%thck = dmax1(0.0d0,model%geometry%thck + model%climate%acab * model%pcgdwk%fc2(2)) +#ifdef DEBUG + print *, "* thck empty - net accumulation added", model%numerics%time +#endif + else + + ! calculate basal velos + if (newtemps) then + call slipvelo(model, & + 1, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + ! calculate Glen's A if necessary + call velo_integrate_flwa(model%velowk,model%geomderv%stagthck,model%temper%flwa) + end if + call slipvelo(model, & + 2, & + model%velocity% btrc, & + model%velocity% ubas, & + model%velocity% vbas) + + ! calculate diffusivity + call velo_calc_diffu(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%velocity%diffu) + + model%velocity%total_diffu(:,:) = model%velocity%diffu(:,:) + model%velocity%ubas(:,:) + + ! first ADI step, solve thickness equation along rows j + n = model%general%ewn + do ns=2,model%general%nsn-1 + call adi_tri ( model%thckwk%alpha, & + model%thckwk%beta, & + model%thckwk%gamma, & + model%thckwk%delta, & + model%geometry%thck(:,ns), & + model%geometry%lsrf(:,ns), & + model%climate%acab(:,ns), & + model%velocity%vflx(:,ns), & + model%velocity%vflx(:,ns-1), & + model%velocity%total_diffu(:,ns), & + model%velocity%total_diffu(:,ns-1), & + model%numerics%dt, & + model%numerics%dew, & + model%numerics%dns ) + !EIB! gc2 acab input, not sure why the difference + !model%climate%acab(:,ns)-real(model%options%basal_mbal)*real(model%temper%bmlt(:,ns),sp), & + call tridiag(model%thckwk%alpha(1:n), & + model%thckwk%beta(1:n), & + model%thckwk%gamma(1:n), & + model%thckwk%oldthck(:,ns), & + model%thckwk%delta(1:n)) + end do + + model%thckwk%oldthck(:,:) = max(model%thckwk%oldthck(:,:), 0.d0) + + ! second ADI step, solve thickness equation along columns i + n = model%general%nsn + do ew=2,model%general%ewn-1 + call adi_tri ( model%thckwk%alpha, & + model%thckwk%beta, & + model%thckwk%gamma, & + model%thckwk%delta, & + model%thckwk%oldthck(ew,:), & + model%geometry%lsrf(ew, :), & + model%climate%acab(ew, :), & + model%velocity%uflx(ew,:), & + model%velocity%uflx(ew-1,:), & + model%velocity%total_diffu(ew,:), & + model%velocity%total_diffu(ew-1,:), & + model%numerics%dt, & + model%numerics%dns, & + model%numerics%dew ) + !EIB! again, input difference + !model%climate%acab(ew, :)-real(model%options%basal_mbal)*real(model%temper%bmlt(ew, :),sp), & + + call tridiag(model%thckwk%alpha(1:n), & + model%thckwk%beta(1:n), & + model%thckwk%gamma(1:n), & + model%geometry%thck(ew, :), & + model%thckwk%delta(1:n)) + end do + + model%geometry%thck(:,:) = max(model%geometry%thck(:,:), 0.d0) + + ! Apply boundary conditions + model%geometry%thck(1,:) = 0.0 + model%geometry%thck(model%general%ewn,:) = 0.0 + model%geometry%thck(:,1) = 0.0 + model%geometry%thck(:,model%general%nsn) = 0.0 + + ! calculate horizontal velocity field + call slipvelo(model, & + 3, & + model%velocity%btrc, & + model%velocity%ubas, & + model%velocity%vbas) + call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx,& + model%velocity%surfvel) + !EIB! old way + !call velo_calc_velo(model%velowk,model%geomderv%stagthck,model%geomderv%dusrfdew, & + ! model%geomderv%dusrfdns,model%temper%flwa,model%velocity%diffu,model%velocity%ubas, & + ! model%velocity%vbas,model%velocity%uvel,model%velocity%vvel,model%velocity%uflx,model%velocity%vflx) + end if + + !------------------------------------------------------------ + ! calculate upper and lower surface + !------------------------------------------------------------ + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus, model%geometry%lsrf) + model%geometry%usrf = max(0.d0,model%geometry%thck + model%geometry%lsrf) + + end subroutine stagleapthck + +!--------------------------------------------------------------------------------- + + subroutine adi_tri(a,b,c,d,thk,tpg,mb,flx_p,flx_m,dif_p,dif_m,dt,ds1, ds2) + !*FD construct tri-diagonal matrix system for a column/row + use glimmer_global, only : dp, sp + implicit none + + real(dp), dimension(:), intent(out) :: a !*FD alpha (subdiagonal) + real(dp), dimension(:), intent(out) :: b !*FD alpha (diagonal) + real(dp), dimension(:), intent(out) :: c !*FD alpha (superdiagonal) + real(dp), dimension(:), intent(out) :: d !*FD right-hand side + + real(dp), dimension(:), intent(in) :: thk !*FD ice thickness + real(dp), dimension(:), intent(in) :: tpg !*FD lower surface of ice + real(sp), dimension(:), intent(in) :: mb !*FD mass balance + real(dp), dimension(:), intent(in) :: flx_p !*FD flux +1/2 + real(dp), dimension(:), intent(in) :: flx_m !*FD flux -1/2 + real(dp), dimension(:), intent(in) :: dif_p !*FD diffusivity +1/2 + real(dp), dimension(:), intent(in) :: dif_m !*FD diffusivity -1/2 + + real(dp), intent(in) :: dt !*FD time step + real(dp), intent(in) :: ds1, ds2 !*FD spatial steps inline and transversal + + ! local variables + real(dp) :: f1, f2, f3 + integer :: i,n + + n = size(thk) + + f1 = dt/(4*ds1*ds1) + f2 = dt/(4*ds2) + f3 = dt/2. + + a(:) = 0. + b(:) = 0. + c(:) = 0. + d(:) = 0. + + a(1) = 0. + do i=2,n + a(i) = f1*(dif_m(i-1)+dif_p(i-1)) + end do + do i=1,n-1 + c(i) = f1*(dif_m(i)+dif_p(i)) + end do + c(n) = 0. + b(:) = -(a(:)+c(:)) + + ! calculate RHS + do i=2,n-1 + d(i) = thk(i) - & + f2 * (flx_p(i-1) + flx_p(i) - flx_m(i-1) - flx_m(i)) + & + f3 * mb(i) - & + a(i)*tpg(i-1) - b(i)*tpg(i) - c(i)*tpg(i+1) + end do + + b(:) = 1.+b(:) + + end subroutine adi_tri + +end module glide_thck + diff --git a/components/cism/glimmer-cism/libglide/glide_types.F90 b/components/cism/glimmer-cism/libglide/glide_types.F90 new file mode 100644 index 0000000000..05ae316839 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_types.F90 @@ -0,0 +1,1992 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_types.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glide_types + + !> Holds type definitions for the derived types used by each + !> instance of the ice model. Originally, each of these types + !> was a module containing variables, which were used as containers + !> for global variables. However, the need to allow for multiple + !> ice model instances meant that the nested derived types were instituted + !> instead. However, there is probably one too many levels in this scheme. + !> It would be better if the different types here were contained in the + !> higher-level instance type (\texttt{glint\_instance}), rather than + !> the intermediate model type (\texttt{glide\_global\_type}). + !> + !> Note that this \emph{is} now where the defaults are defined for these + !> variables. + +!TODO - Clean up the glide_global type so it holds fewer subtypes? +! For example, we could replace some work types (tempwk, velowk) with local arrays and parameters. + + use glimmer_sparse_type + use glimmer_global, only: sp, dp + use glimmer_ncdf + use profile + use glimmer_coordinates, only: coordsystem_type + use glimmer_map_types + use glimmer_physcon + + implicit none + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + ! Constants that describe the options available + ! We use these integer parameters elsewhere in the code to avoid + ! hardwiring of option numbers + + ! basic Glimmer/Glide options + + integer, parameter :: GLOBAL_BC_PERIODIC = 0 ! doubly periodic + integer, parameter :: GLOBAL_BC_OUTFLOW = 1 ! free outflow; scalars in global halo set to zero + + integer, parameter :: DYCORE_GLIDE = 0 ! old shallow-ice dycore from Glimmer + integer, parameter :: DYCORE_GLAM = 1 ! Payne-Price finite-difference solver + integer, parameter :: DYCORE_GLISSADE = 2 ! prototype finite-element solver + integer, parameter :: DYCORE_ALBANYFELIX = 3 ! External Albany-Felix finite-element solver + integer, parameter :: DYCORE_BISICLES = 4 ! BISICLES-Chombo external FVM solver + + integer, parameter :: EVOL_PSEUDO_DIFF = 0 ! glide only + integer, parameter :: EVOL_ADI = 1 ! glide only + integer, parameter :: EVOL_DIFFUSION = 2 ! glide only + integer, parameter :: EVOL_INC_REMAP = 3 ! glam/glissade only + integer, parameter :: EVOL_UPWIND = 4 ! glam/glissade only + integer, parameter :: EVOL_NO_THICKNESS = 5 ! glam/glissade only + + !NOTE: Use option 1 for prognostic temperature with any dycore + ! Option 3 is under construction + + integer, parameter :: TEMP_SURFACE_AIR_TEMP = 0 + integer, parameter :: TEMP_PROGNOSTIC = 1 + integer, parameter :: TEMP_STEADY = 2 + integer, parameter :: TEMP_ENTHALPY = 3 + + integer, parameter :: TEMP_INIT_ZERO = 0 + integer, parameter :: TEMP_INIT_ARTM = 1 + integer, parameter :: TEMP_INIT_LINEAR = 2 + + integer, parameter :: FLWA_CONST_FLWA = 0 + integer, parameter :: FLWA_PATERSON_BUDD_CONST_TEMP = 1 + integer, parameter :: FLWA_PATERSON_BUDD = 2 + + integer, parameter :: BTRC_ZERO = 0 + integer, parameter :: BTRC_CONSTANT = 1 + integer, parameter :: BTRC_CONSTANT_BWAT = 2 + integer, parameter :: BTRC_CONSTANT_TPMP = 3 + integer, parameter :: BTRC_LINEAR_BMLT = 4 + integer, parameter :: BTRC_TANH_BWAT = 5 + + integer, parameter :: BWATER_NONE = 0 + integer, parameter :: BWATER_LOCAL = 1 + integer, parameter :: BWATER_FLUX = 2 + integer, parameter :: BWATER_CONST = 3 + integer, parameter :: BWATER_OCEAN_PENETRATION = 4 ! effective pressure calculation with pw=ocean pressure for grounding line parameterisation (Leguy, et al., TC, 2014) + !integer, parameter :: BWATER_BASAL_PROC = 4 ! not currently supported + + integer, parameter :: BASAL_MBAL_NO_CONTINUITY = 0 + integer, parameter :: BASAL_MBAL_CONTINUITY = 1 + + integer, parameter :: GTHF_UNIFORM = 0 + integer, parameter :: GTHF_PRESCRIBED_2D = 1 + integer, parameter :: GTHF_COMPUTE = 2 + + integer, parameter :: RELAXED_TOPO_NONE = 0 ! Do nothing + integer, parameter :: RELAXED_TOPO_INPUT = 1 ! Input topo is relaxed + integer, parameter :: RELAXED_TOPO_COMPUTE = 2 ! Input topo in isostatic equilibrium + ! compute relaxed topo + + integer, parameter :: ISOSTASY_NONE = 0 + integer, parameter :: ISOSTASY_COMPUTE = 1 + + integer, parameter :: LITHOSPHERE_LOCAL = 0 + integer, parameter :: LITHOSPHERE_ELASTIC = 1 + + integer, parameter :: ASTHENOSPHERE_FLUID = 0 + integer, parameter :: ASTHENOSPHERE_RELAXING = 1 + + integer, parameter :: MARINE_NONE = 0 + integer, parameter :: MARINE_FLOAT_ZERO = 1 + integer, parameter :: MARINE_FLOAT_FRACTION = 2 + integer, parameter :: MARINE_RELX_THRESHOLD = 3 + integer, parameter :: MARINE_TOPG_THRESHOLD = 4 + integer, parameter :: MARINE_HUYBRECHTS = 5 + + integer, parameter :: VERTINT_STANDARD = 0 + integer, parameter :: VERTINT_KINEMATIC_BC = 1 + + integer, parameter :: SIGMA_COMPUTE_GLIDE = 0 + integer, parameter :: SIGMA_EXTERNAL = 1 + integer, parameter :: SIGMA_CONFIG = 2 + integer, parameter :: SIGMA_COMPUTE_EVEN = 3 + integer, parameter :: SIGMA_COMPUTE_PATTYN = 4 + + integer, parameter :: RESTART_FALSE = 0 + integer, parameter :: RESTART_TRUE = 1 + + !basal proc option disabled for now + integer, parameter :: BAS_PROC_DISABLED = 0 +!! integer, parameter :: BAS_PROC_FULLCALC = 1 +!! integer, parameter :: BAS_PROC_FASTCALC = 2 + + ! higher-order options + + integer, parameter :: HO_EFVS_CONSTANT = 0 + integer, parameter :: HO_EFVS_FLOWFACT = 1 + integer, parameter :: HO_EFVS_NONLINEAR = 2 + + integer, parameter :: HO_DISP_NONE = -1 + integer, parameter :: HO_DISP_SIA = 0 + integer, parameter :: HO_DISP_FIRSTORDER = 1 + + integer, parameter :: HO_BABC_CONSTANT = 0 + integer, parameter :: HO_BABC_SIMPLE = 1 + integer, parameter :: HO_BABC_YIELD_PICARD = 2 + integer, parameter :: HO_BABC_BETA_BWAT = 3 + integer, parameter :: HO_BABC_LARGE_BETA = 4 + integer, parameter :: HO_BABC_EXTERNAL_BETA = 5 + integer, parameter :: HO_BABC_NO_SLIP = 6 + integer, parameter :: HO_BABC_YIELD_NEWTON = 7 + integer, parameter :: HO_BABC_ISHOMC = 8 + integer, parameter :: HO_BABC_POWERLAW = 9 + integer, parameter :: HO_BABC_COULOMB_FRICTION = 10 + + integer, parameter :: HO_NONLIN_PICARD = 0 + integer, parameter :: HO_NONLIN_JFNK = 1 + + integer, parameter :: HO_RESID_MAXU = 0 + integer, parameter :: HO_RESID_MAXU_NO_UBAS = 1 + integer, parameter :: HO_RESID_MEANU = 2 + integer, parameter :: HO_RESID_L2NORM = 3 + integer, parameter :: HO_RESID_L2NORM_RELATIVE = 4 + + integer, parameter :: HO_SPARSE_PCG_INCH = -1 + integer, parameter :: HO_SPARSE_BICG = 0 + integer, parameter :: HO_SPARSE_GMRES = 1 + integer, parameter :: HO_SPARSE_PCG_STANDARD = 2 + integer, parameter :: HO_SPARSE_PCG_CHRONGEAR = 3 + integer, parameter :: HO_SPARSE_TRILINOS = 4 + + integer, parameter :: HO_APPROX_LOCAL_SIA = -1 + integer, parameter :: HO_APPROX_SIA = 0 + integer, parameter :: HO_APPROX_SSA = 1 + integer, parameter :: HO_APPROX_BP = 2 + integer, parameter :: HO_APPROX_L1L2 = 3 + + integer, parameter :: HO_PRECOND_NONE = 0 + integer, parameter :: HO_PRECOND_DIAG = 1 + integer, parameter :: HO_PRECOND_SIA = 2 + + integer, parameter :: HO_GRADIENT_CENTERED = 0 + integer, parameter :: HO_GRADIENT_UPSTREAM = 1 + + integer, parameter :: HO_GRADIENT_MARGIN_ALL = 0 + integer, parameter :: HO_GRADIENT_MARGIN_ICE_LAND = 1 + integer, parameter :: HO_GRADIENT_MARGIN_ICE_ONLY = 2 + + integer, parameter :: HO_ASSEMBLE_BETA_STANDARD = 0 + integer, parameter :: HO_ASSEMBLE_BETA_LOCAL = 1 + + integer, parameter :: HO_GROUND_NO_GLP = 0 + integer, parameter :: HO_GROUND_GLP = 1 + integer, parameter :: HO_GROUND_ALL = 2 + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_general + + !> Holds fundamental parameters of the ice model geometry. + + integer :: ewn = 0 !> The number of grid-points in the E-W direction. + integer :: nsn = 0 !> The number of grid-points in the N-S direction. + integer :: upn = 1 !> The number of vertical levels in the model. + + type(coordsystem_type) :: ice_grid !> coordinate system of the ice grid + type(coordsystem_type) :: velo_grid !> coordinate system of the velocity grid + + real(dp), dimension(:),pointer :: x0 => null() !original x0 grid + real(dp), dimension(:),pointer :: y0 => null() !original y0 grid + real(dp), dimension(:),pointer :: x1 => null() !original x1 grid + real(dp), dimension(:),pointer :: y1 => null() !original y1 grid + + integer :: global_bc = 0 ! 0 for periodic, 1 for outflow + + end type glide_general + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_options + + !> Holds user options controlling the methods used in the ice-model integration. + + !----------------------------------------------------------------------- + ! standard options + !----------------------------------------------------------------------- + + integer :: whichdycore = 2 + + ! Choice of two Glimmer dycores: + !> \begin{description} + !> \item[0] Glide dycore (SIA, serial (SLAP) only) + !> \item[1] SEACISM/Glam dycore (1st-order, FDM, serial (SLAP) or parallel (Trilinos)) + !> \item[2] Glissade dycore (1st-order, FEM, serial (SLAP) or parallel (F90 native PCG solver) ) + !> \item[3] FELIX-Albany dycore (1st-order, FEM, using Trilino/Albany, mesh information from Glissade) + !> \item[4] BISICLES dycore (L1L2, FVM, parallel using Chombo AMR) + !> \end{description} + + integer :: whichevol = 0 + + !> Thickness evolution method: + !> \begin{description} + !> \item[0] Pseudo-diffusion + !> \item[1] Alternating direction implicit (ADI) + !> \item[2] Diffusion (also calculates velocities) + !> \item[3] Incremental remapping + !> \item[4] 1st-order upwind scheme + !> \item[5] Temperature evolves but thickness does not + !> \end{description} + + integer :: whichtemp = 1 + + !> Method of ice temperature calculation: + !> \begin{description} + !> \item[0] Set column to surface air temperature + !> \item[1] Prognostic temperature solution + !> \item[2] Do NOTHING - hold temperatures steady at initial value + !> \item[3] Prognostic enthalpy solution + !> \end{description} + + integer :: temp_init = 1 + + ! Temperature initialization: + !> \begin{description} + !> \item[0] Initialize temperature to 0 C + !> \item[1] Initialize temperature to surface air temperature + !> \item[2] Initialize temperature with a linear profile in each column + !> \end{description} + + !> Method for calculating flow factor $A$: + + integer :: whichflwa = 2 + + !> \begin{description} + !> \item[0] Set equal to $1\times 10^{-16}\,\mathrm{yr}^{-1} + !> \item[1] \emph{Paterson and Budd} relationship, + !> with temperature set to $-5^{\circ}\mathrm{C}$ + !> \item[2] \emph{Paterson and Budd} relationship + !> \,\mathrm{Pa}^{-n}$ + !> \end{description} + + integer :: whichbtrc = 0 + + !> Basal slip coefficient: + !> \begin{description} + !> \item[0] Set equal to zero everywhere + !> \item[1] Set to (non--zero) constant + !> \item[2] Set to (non--zero) constant where basal water is present, otherwise to zero + !> \item[3] Set to (non--zero) constant where temperature is at pressure melting point of ice, otherwise to zero + !> \item[4] linear function of basal melt rate + !> \item[5] \texttt{tanh} function of basal water depth + !> \end{description} + + integer :: whichbwat = 0 + + !> Basal water depth: + !> \begin{description} + !> \item[0] Set to zero everywhere + !> \item[1] Compute from local basal water balance + !> \item[2] Compute the basal water flux, then find depth via calculation + !> \item[3] Set to constant (10 m) everywhere, to force T = Tpmp. + !> \item[4] Calculated from till water content, in the basal processes module + !> \end{description} + + integer :: basal_mbal = 0 + + !> basal melt rate: + !> \begin{description} + !> \item[0] Basal melt rate not included in continuity equation + !> \item[1] Basal melt rate included in continuity equation + !> \end{description} + + integer :: gthf = 0 + + !> geothermal heat flux: + !> \begin{description} + !> \item[0] prescribed uniform geothermal heat flux + !> \item[1] read 2D geothermal flux field from input file (if present) + !> \item[2] calculate geothermal flux using 3d diffusion + !> \end{description} + + ! This replaces model%isos%do_isos + integer :: isostasy = 0 + + !> isostasy: + !> \begin{description} + !> \item[0] no isostatic adjustment + !> \item[1] compute isostatic adjustment using lithosphere/asthenosphere model + !> \end{description} + + !TODO - Should whichrelaxed move from the options to the isostasy section? + integer :: whichrelaxed = 0 + + !> relaxed topography: + !> \begin{description} + !> \item[0] get relaxed topo from separate variable (in practice, do nothing) + !> \item[1] first time slice of input topo is relaxed + !> \item[2] first time slice of input topo is in isostatic equilibrium + !> \end{description} + + integer :: whichmarn = 1 + + !> Marine limit: + !> \begin{description} + !> \item[0] No action + !> \item[1] Set thickness to zero if floating + !> \item[2] Lose fraction of ice when edge cell + !> \item[3] Set thickness to zero if relaxed bedrock is more than + !> certain water depth (variable "mlimit" in glide_types) + !> \item[4] Set thickness to zero if present bedrock is more than + !> certain water depth (variable "mlimit" in glide_types) + !> \item[5] Huybrechts grounding line scheme for Greenland initialization + !> \end{description} + + integer :: whichwvel = 0 + + !> Vertical velocities: + !> \begin{description} + !> \item[0] Usual vertical integration + !> \item[1] Vertical integration constrained so that + !> upper kinematic B.C. obeyed + !> \end{description} + + integer :: which_sigma = 0 + + !> \begin{description} + !> \item[0] compute standard Glimmer sigma coordinates + !> \item[1] sigma coordinates are given in external file + !> \item[2] sigma coordinates are given in configuration file + !> \item[3] evenly spaced levels, as required for glam dycore + !> \item[4] compute Pattyn sigma coordinates + !> \end{description} + + !TODO - Make is_restart a logical variable? + + integer :: is_restart = 0 + !> if the run is a restart of a previous run + !> \begin{description} + !> \item[0] normal start-up (take init fields from .nc input file OR if absent, use default options) + !> \item[1] restart model from previous run (do not calc. temp, rate factor, or vel) + !> \end{description} + + ! This is a Glimmer serial option + ! The parallel code enforces periodic EW and NS boundary conditions by default + logical :: periodic_ew = .false. + + !> \begin{description} + !> \item[0] no periodic EW boundary conditions + !> \item[1] periodic EW boundary conditions + !> \end{description} + + !----------------------------------------------------------------------- + ! Higher-order options + ! Associated with Payne-Price dycore (glam) and newer glissade dycore + !----------------------------------------------------------------------- + + integer :: which_ho_efvs = 2 + + !> Flag that indicates how effective viscosity is computed + !> \begin{description} + !> \item[0] constant value + !> \item[1] multiple of flow factor + !> \item[2] compute from effective strain rate + + integer :: which_ho_disp = 1 + + !> Flag that indicates method for computing the dissipation during the temperature calc. + !> \begin{description} + !> \item[-1] for no dissipation + !> \item[0] for 0-order SIA approx + !> \item[1] for first-order dissipation (Blatter-Pattyn) + !> + !> \end{description} + + integer :: which_ho_babc = 4 + + !> Flag that describes basal boundary condition for HO dyn core: + !> \begin{description} + !> \item[0] spatially uniform value (low value of 10 Pa/yr by default) + !> \item[1] simple hard-coded pattern (useful for debugging) + !> \item[2] treat beta value as a till yield stress (in Pa) using Picard iteration + !> \item[3] linear (inverse) function of bwat + !> \item[4] very large value for beta to enforce no slip everywhere + !> \item[5] beta field passed in from .nc input file as part of standard i/o + !> \item[6] no slip everywhere (using Dirichlet BC rather than large beta) + !> \item[7] treat beta value as till yield stress (in Pa) using Newton-type iteration (in development) + !> \item[8] beta field as prescribed for ISMIP-HOM test C (serial only) + !> \item[9] power law based using effective pressure + !> \item[10] Coulomb friction law using effective pressure + !> \end{description} + + integer :: which_ho_nonlinear = 0 + !> Flag that indicates method for solving the nonlinear iteration when solving + !> the first-order momentum balance + !> \item[0] use the standard Picard iteration + !> \item[1] use Jacobian Free Newton Krylov (JFNK) method + + integer :: which_ho_resid = 3 + !> Flag that indicates method for computing residual in PP dyn core: + !> \begin{description} + !> \item[0] maxval + !> \item[1] maxval ignoring basal velocity + !> \item[2] mean value + !> \item[3] L2 norm of system residual, Ax-b=resid + !> \item[4] L2 norm of system residual relative to rhs, |Ax-b|/|b| + !> \begin{description} + + integer :: which_ho_sparse = 0 + !> Flag that indicates method for solving the sparse linear system + !> that arises from the higher-order solver + !> \begin{description} + !> \item[-1] SLAP (serial): Preconditioned conjugate gradient, incomplete Cholesky preconditioner + !> \item[0] SLAP (serial): Biconjugate gradient, incomplete LU preconditioner + !> \item[1] SLAP (serial): GMRES, incomplete LU preconditioner + !> \item[2] Native PCG, parallel-enabled, standard solver + !> \item[3] Native PCG, parallel-enabled, Chronopoulos-Gear solver + !> \item[4] standalone interface to Trilinos + !> \end{description} + + ! parameters to store external dycore options/information -- Doug Ranken 04/20/12 + integer*4 :: external_dycore_type = 0 + integer*4 :: external_dycore_model_index = -1 + !> Flag to select an external dynamic core. + !> \begin{description} + !> \item[0] Do not use an external dynamic core + !> \item[1] Use the BISICLES external dynamic core + !> \item[2] Use the ALBANY_FELIX external dynamic core + !> \end{description} + + character(fname_length) :: dycore_input_file='' + !FD Name of a file containing external dycore settings. + + integer :: which_ho_approx = 2 + !> Flag that indicates which Stokes approximation to use with the glissade dycore. + !> Not valid for other dycores + !> Compute Blatter-Pattyn HO momentum balance by default. + !> Note: There are two SIA options: + !> Option -1 uses module glissade_velo_sia to compute local SIA velocities, similar to Glide + !> Option 0 uses module glissade_velo_higher to compute SIA velocities via an iterative solve + !> \begin{description} + !> \item[-1] Shallow-ice approximation, Glide-type calculation (uses glissade_velo_sia) + !> \item[0] Shallow-ice approximation, vertical-shear stresses only (uses glissade_velo_higher) + !> \item[1] Shallow-shelf approximation, horizontal-plane stresses only (uses glissade_velo_higher) + !> \item[2] Blatter-Pattyn approximation with both vertical-shear and horizontal-plane stresses (uses glissade_velo_higher) + !> \item[3] Vertically integrated 'L1L2' approximation with vertical-shear and horizontal-plane stresses (uses glissade_velo_higher) + !> \end{description} + + integer :: which_ho_precond = 2 + !> Flag that indicates which Stokes preconditioner to use in the glissade dycore. + !> Not valid for other dycores + !> \begin{description} + !> \item[0] No preconditioner + !> \item[1] Diagonal preconditioner + !> \item[2] Physics-based shallow-ice preconditioner + !> \end{description} + + integer :: which_ho_gradient = 0 + !> Flag that indicates which gradient operator to use in the glissade dycore. + !> Not valid for other dycores + !> NOTE: Option 1 may be better for ice evolution because it damps checkerboard noise. + !> \begin{description} + !> \item[0] Centered gradient + !> \item[1] Upstream gradient + + integer :: which_ho_gradient_margin = 1 + !> Flag that indicates how to compute the gradient at the ice margin in the glissade dycore. + !> Not valid for other dycores + !> \begin{description} + !> \item[0] Use info from all neighbor cells, ice-covered or ice-free + !> \item[1] Use info from ice-covered and/or land cells, not ice-free ocean + !> \item[2] Use info from ice-covered cells only + + integer :: which_ho_assemble_beta = 0 + + !> Flag that describes how beta terms are assembled in the glissade finite-element calculation + !> \begin{description} + !> \item[0] standard finite-element calculation (which effectively smooths beta) + !> \item[1] apply local beta value at each vertex + + integer :: which_ho_ground = 0 + !> Flag that indicates how to compute the grounded fraction of each gridcell in the glissade dycore. + !> Not valid for other dycores + !> \begin{description} + !> \item[0] fground = 0 in floating cells (based on flotation condition), else fground = 1 + !> \item[1] fground = 1 in all cells + !> \item[2] 0 <= fground <= 1, based on a grounding line parameterization + + integer :: glissade_maxiter = 100 + !> maximum number of nonlinear iterations to be used by the Glissade velocity solver + + ! The remaining options are not currently supported + + !integer :: which_bproc = 0 + !Options for the basal processes code + !> \begin{description} + !> \item[0] Disabled + !> \item[1] Full calculation, with at least 3 nodes to represent the till layer + !> \item[2] Fast calculation, using Tulaczyk empirical parametrization + !> \end{description} + + !integer :: use_plume = 0 !! Option to be supported in future releases + !> \begin{description} + !> \item[0] standard bmlt calculation + !> \item[1] use plume to calculate bmlt + !> \end{description} + + end type glide_options + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_geometry + + !> Holds fields and other information relating to the + !> geometry of the ice sheet and bedrock. + + real(dp),dimension(:,:),pointer :: thck => null() + !> The thickness of the ice, divided by \texttt{thk0}. + + real(dp),dimension(:,:),pointer :: usrf => null() + !> The elevation of the upper ice surface, divided by \texttt{thk0}. + + real(dp),dimension(:,:),pointer :: lsrf => null() + !> The elevation of the lower ice surface, divided by \texttt{thk0}. + + real(dp),dimension(:,:),pointer :: topg => null() + !> The elevation of the topography, divided by \texttt{thk0}. + + real(dp),dimension(:,:),pointer :: f_ground => null() + !> The fractional area at each vertex which is grounded + ! (computed by glissade dycore only) + + real(dp),dimension(:,:,:),pointer :: age => null() + !> The age of a given ice layer, divided by \texttt{tim0}. + + integer, dimension(:,:),pointer :: thkmask => null() + !> see glide_mask.f90 for possible values + + integer, dimension(:,:),pointer :: stagmask => null() + !> see glide_mask.f90 for possible values + + !TODO - Consider moving BISICLES variables to their own type at some point + !* (DFM ----------------- added for BISICLES interface --------------) + real(dp),dimension(:,:),pointer :: floating_mask => null() + !*(DFM) Real-valued mask indicated where ice is grounded or floating + + !* (DFM ----------------- added for BISICLES interface --------------) + real(dp),dimension(:,:),pointer :: ice_mask => null() + !*(DFM) Real-valued mask indicating where ice is present or absent + + + !* (DFM ----------------- added for BISICLES interface --------------) + real(dp),dimension(:,:),pointer :: lower_cell_loc => null() + !*(DFM) The z-location of the center of the lowest ice cell center + + !* (DFM ----------------- added for BISICLES interface --------------) + real(dp),dimension(:,:),pointer :: lower_cell_temp => null() + !*(DFM) The temperature in the cell located at lower_cell_loc + + integer, dimension(:,:),pointer :: thck_index => null() + ! Set to nonzero integer for ice-covered cells (thck > 0), cells adjacent to ice-covered cells, + ! and cells with acab > 0. The non-zero points are numbered in sequence from the bottom left + ! to the top right, going along the rows. + + integer :: totpts = 0 ! total number of points with nonzero thck_index + logical :: empty = .true. ! true if totpts = 0 + + real(dp) :: ivol, iarea,iareag, iareaf !> ice volume and ice area + + end type glide_geometry + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_geomderv + + !> Holds the horizontal and temporal derivatives of the thickness and + !> upper surface elevation, as well as the thickness on the staggered grid. + + !*tb* Added a bunch of stuff here to clean up the higher order code that + !I've been writing. Might be worth it to add a mechanism to conditionally + !allocate these depending on whether they are needed by the SIA core or by + !the higher-order extensions + + !First derivatives on a staggered grid + real(dp),dimension(:,:),pointer :: dthckdew => null() !> E-W derivative of thickness. + real(dp),dimension(:,:),pointer :: dusrfdew => null() !> E-W derivative of upper surface elevation. + real(dp),dimension(:,:),pointer :: dthckdns => null() !> N-S derivative of thickness. + real(dp),dimension(:,:),pointer :: dusrfdns => null() !> N-S derivative of upper surface elevation. + real(dp),dimension(:,:),pointer :: dlsrfdew => null() !*tb* added + real(dp),dimension(:,:),pointer :: dlsrfdns => null() !*tb* added + + !Second derivatives on a staggered grid + !*tb* added all of these + ! Used by glam_strs2 + real(dp),dimension(:,:),pointer :: d2usrfdew2 => null() + real(dp),dimension(:,:),pointer :: d2usrfdns2 => null() + real(dp),dimension(:,:),pointer :: d2thckdew2 => null() + real(dp),dimension(:,:),pointer :: d2thckdns2 => null() + + !Time derivatives + real(dp),dimension(:,:),pointer :: dthckdtm => null() !> Temporal derivative of thickness. + real(dp),dimension(:,:),pointer :: dusrfdtm => null() !> Temporal derivative of upper surface elevation. + + !TODO - Move staggered variables from glide_geomderv type to glide_geometry? + + !Staggered grid versions of geometry variables + real(dp),dimension(:,:),pointer :: stagthck => null() !> Thickness averaged onto the staggered grid. + real(dp),dimension(:,:),pointer :: stagusrf => null() !> Upper surface averaged onto the staggered grid + real(dp),dimension(:,:),pointer :: staglsrf => null() !> Lower surface averaged onto the staggered grid + real(dp),dimension(:,:),pointer :: stagtopg => null() !> Bedrock topography averaged onto the staggered grid + + end type glide_geomderv + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_tensor + real(dp), dimension(:,:,:), pointer :: scalar => null() + real(dp), dimension(:,:,:), pointer :: xz => null() + real(dp), dimension(:,:,:), pointer :: yz => null() + real(dp), dimension(:,:,:), pointer :: xx => null() + real(dp), dimension(:,:,:), pointer :: yy => null() + real(dp), dimension(:,:,:), pointer :: xy => null() + end type glide_tensor + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_velocity + + !> Holds the velocity fields in 2D and 3D. At least some of these fields + real(dp),dimension(:,:,:),pointer :: uvel => null() !> 3D $x$-velocity. + real(dp),dimension(:,:,:),pointer :: vvel => null() !> 3D $y$-velocity. + real(dp),dimension(:,:,:),pointer :: velnorm => null() ! horizontal ice speed + real(dp),dimension(:,:,:),pointer :: wvel => null() !> 3D $z$-velocity. + real(dp),dimension(:,:,:),pointer :: wgrd => null() !> 3D grid vertical velocity. + real(dp),dimension(:,:,:),pointer :: wvel_ho => null()!> 3D $z$-velocity.from higher-order dycores + real(dp),dimension(:,:) ,pointer :: uflx => null() !> + real(dp),dimension(:,:) ,pointer :: vflx => null() !> + real(dp),dimension(:,:) ,pointer :: diffu => null() !> + real(dp),dimension(:,:) ,pointer :: diffu_x => null() !*sfp* moved from velocity_hom deriv type + real(dp),dimension(:,:) ,pointer :: diffu_y => null() + real(dp),dimension(:,:) ,pointer :: total_diffu => null() !> total diffusivity + + real(dp),dimension(:,:) ,pointer :: ubas => null() !> + real(dp),dimension(:,:) ,pointer :: ubas_tavg => null() + real(dp),dimension(:,:) ,pointer :: vbas => null() !> + real(dp),dimension(:,:) ,pointer :: vbas_tavg => null() + + !! next 3 used for output of residual fields (when relevant code in glam_strs2 is active) +! real(dp),dimension(:,:,:),pointer :: ures => null() !> 3D $x$-residual. +! real(dp),dimension(:,:,:),pointer :: vres => null() !> 3D $y$-residual. +! real(dp),dimension(:,:,:),pointer :: magres => null() !> 3D $magnitude$-residual. + + ! Note: uvel_extend and vvel_extend can be used for output of uvel, vvel on a staggered grid + ! that is the same size as the unstaggered grid (e.g., for ISMIP-HOM problems with periodic BC, + ! where the number of velocity points is equal to the number of grid cells.) + real(dp),dimension(:,:,:),pointer :: uvel_extend => null() !> 3D $x$-velocity on extended staggered grid + real(dp),dimension(:,:,:),pointer :: vvel_extend => null() !> 3D $y$-velocity on extended staggered grid + + real(dp),dimension(:,:) ,pointer :: bed_softness => null() !> bed softness parameter + real(dp),dimension(:,:) ,pointer :: btrc => null() !> basal traction (scaler field) + real(dp),dimension(:,:,:),pointer :: btraction => null() !> x(1,:,:) and y(2,:,:) "consistent" basal traction fields + real(dp),dimension(:,:) ,pointer :: beta => null() !> basal shear coefficient on velo grid (Pa yr/m by default) + real(dp),dimension(:,:) ,pointer :: unstagbeta => null() !> basal shear coefficient on ice grid (Pa yr/m by default) + real(dp),dimension(:,:) ,pointer :: tau_x => null() !> SIA basal shear stress, x-dir + real(dp),dimension(:,:) ,pointer :: tau_y => null() !> SIA basal shear stress, y-dir + + !> A mask similar to glide_geometry%thck_index, but on the velocity grid instead of the + !> ice grid. This is to aid in converging higher-order velocities +!! integer, dimension(:,:), pointer :: velmask => null() ! No longer used + + !> A mask that specifies where the velocity being read in should be held constant as a dirichlet condition + integer, dimension(:,:), pointer :: kinbcmask => null() + + !*sfp* mask on vel grid showing which dyn bc is applied at each grid cell (mainly for debugging) + integer, dimension(:,:), pointer :: dynbcmask => null() + + ! for viewing the spatial pattern of residuals + real(dp),dimension(:,:,:),pointer :: resid_u => null() ! u component of residual Ax - b where x is the velocity + real(dp),dimension(:,:,:),pointer :: resid_v => null() ! v component of residual Ax - b where x is the velocity + + ! for viewing the driving stress on the RHS + real(dp),dimension(:,:,:),pointer :: rhs_u => null() ! u component of b in Ax = b + real(dp),dimension(:,:,:),pointer :: rhs_v => null() ! v component of b in Ax = b + + end type glide_velocity + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_stress_t + + type(glide_tensor) :: tau ! HO only + real(dp),dimension(:,:,:),pointer :: efvs => null() !> effective viscosity + real(dp),dimension(:,:), pointer :: btractx => null() !> basal traction (Pa), x comp + real(dp),dimension(:,:), pointer :: btracty => null() !> basal traction (Pa), y comp + + end type glide_stress_t + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Should calving and eus be part of some type other than glide_climate? + +!TODO - Rename acab in glide_climate type to avoid confusion over units? (e.g., acab_ice?) +! Here, acab has units of m/y ice, whereas in Glint, acab has units of m/y water equiv. + + type glide_climate + !> Holds fields used to drive the model + real(dp),dimension(:,:),pointer :: acab => null() !> Annual mass balance (m/y ice) + real(dp),dimension(:,:),pointer :: acab_tavg => null() !> Annual mass balance (time average). + real(dp),dimension(:,:),pointer :: artm => null() !> Annual mean air temperature (degC) + real(dp),dimension(:,:),pointer :: calving => null() !> Calving flux + ! (scaled as mass balance, thickness, etc) + + real(dp) :: eus = 0.d0 !> eustatic sea level + end type glide_climate + + + type eismint_climate_type + + ! holds parameters for the eismint climate + + ! For EISMINT2: + ! airt(1) = Tmin = summit surface temperature (K) + ! airt(2) = S_T = horizontal temperature gradient (K/m) + ! nmsb(1) = M_max = max accumulation (m/yr) + ! nmsb(2) = S_b = horizontal smb gradient (m/yr/m) + ! nmsb(3) = R_el = radial distance from summit where mass balance = 0 (m) + ! + + integer :: eismint_type = 0 + !> select EISMINT experiment + !> \begin{description} + !> \item[{\bf 1}] EISMINT-1 fixed margin + !> \item[{\bf 2}] EISMINT-1 moving margin + !> \item[{\bf 3}] EISMINT-2 + !> \item[{\bf 4}] MISMIP-1 (not EISMINT but has similar climate parameters) + !> \item[{\bf 5}] Exact verification (not EISMINT but has similar climate parameters) + !> \end{description} + + ! NOTE: The initial nmsb values in the declarations below are appropriate + ! for EISMINT-2, but the initial airt values are not. + ! TODO: Change default airt values in eismint_type to be consistent with EISMINT-2? + + !> air temperature parameterisation K, K km$^{-3}$ + real(dp), dimension(2) :: airt = (/ -3.15d0, 1.d-2 /) + + !> mass balance parameterisation: + real(dp), dimension(3) :: nmsb = (/ 0.5d0, 1.05d-5, 450.0d3 /) + + !> EISMINT time-dep climate forcing period, switched off when set to 0 + real(dp) :: period = 0.d0 + + !> EISMINT amplitude of mass balance time-dep climate forcing + real(dp) :: mb_amplitude = 0.2d0 + + end type eismint_climate_type + + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_temper + + !> Holds fields relating to temperature. + + !Note: In the Glide dycore, temp, flwa and dissip live on the unstaggered vertical grid + ! at layer interfaces and have vertical dimension (1:upn). + ! In the Glam/Glissade dycore, with remapping advection of temperature, + ! temp, flwa and dissip live on the staggered vertical grid at layer midpoints. + ! The vertical dimensions are (0:upn) for temp and (1:upn-1) for flwa and dissip. + ! + ! bheatflx, ucondflx, and lcondflx are defined as positive down, + ! so they will often be < 0. + ! However, bfricflx and dissipcol are defined to be >= 0. + ! + ! If bheatflx is read from a data file, be careful about the sign! + ! In input data, the geothermal heat flux is likely to be defined as positive upward. + ! + !TODO: Create separate fields for basal melt beneath grounded and floating ice. + + real(dp),dimension(:,:,:),pointer :: temp => null() !> 3D temperature field. + real(dp),dimension(:,:), pointer :: bheatflx => null() !> basal heat flux (W/m^2) (geothermal, positive down) + real(dp),dimension(:,:,:),pointer :: flwa => null() !> Glen's flow factor $A$. + real(dp),dimension(:,:,:),pointer :: dissip => null() !> interior heat dissipation rate, divided by rhoi*Ci (deg/s) + real(dp),dimension(:,:), pointer :: bwat => null() !> Basal water depth + real(dp),dimension(:,:), pointer :: bwatflx => null() !> Basal water flux + real(dp),dimension(:,:), pointer :: stagbwat => null() !> Basal water depth on velo grid + real(dp),dimension(:,:), pointer :: bmlt => null() !> Basal melt-rate (> 0 for melt, < 0 for freeze-on) + real(dp),dimension(:,:), pointer :: bmlt_tavg => null() !> Basal melt-rate + real(dp),dimension(:,:), pointer :: stagbtemp => null() !> Basal temperature on velo grid + real(dp),dimension(:,:), pointer :: bpmp => null() !> Basal pressure melting point + real(dp),dimension(:,:), pointer :: stagbpmp => null() !> Basal pressure melting point on velo grid + real(dp),dimension(:,:), pointer :: bfricflx => null() !> basal heat flux (W/m^2) from friction (>= 0) + real(dp),dimension(:,:,:),pointer :: waterfrac => null() !> fractional water content in layer (0 <= waterfrac <= 1) + real(dp),dimension(:,:,:),pointer :: enthalpy => null() !> specific enthalpy in layer (J m-3) + !> = rhoi * Ci * T for cold ice + !TODO - Remove ucondflx, lcondflx, dissipcol; make these local to glissade_therm + real(dp),dimension(:,:), pointer :: ucondflx => null() !> conductive heat flux (W/m^2) at upper sfc (positive down) + real(dp),dimension(:,:), pointer :: lcondflx => null() !> conductive heat flux (W/m^2) at lower sfc (positive down) + real(dp),dimension(:,:), pointer :: dissipcol => null() !> total heat dissipation rate (W/m^2) in column (>= 0) + integer :: niter = 0 + real(dp) :: perturb = 0.d0 + real(dp) :: grid = 0.d0 + integer :: tpt = 0 !> Pointer to time series data + logical :: first1 = .true. !> + logical :: newtemps = .false. !> new temperatures + end type glide_temper + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_basal_physics + !< Holds variables related to basal physics associated with ice dynamics + + ! see glissade_basal_traction.F90 for usage details + ! Note: It may make sense to move effecpress to a hydrology model when one is available. + real(dp), dimension(:,:), pointer :: effecpress => null() !< effective pressure + real(dp), dimension(:,:), pointer :: effecpress_stag => null() !< effective pressure staggered grid + ! paramter for friction law + real(dp) :: friction_powerlaw_k = 8.4e-9 !< the friction coefficient for the power-law friction law (m y^-1 Pa^-2). The default value is that given in Bindschadler (1983) based on fits to observations, converted to CISM units. + ! Parameters for Coulomb friction sliding law (default values from Pimentel et al. 2010) + real(dp) :: Coulomb_C = 0.84d0*0.5d0 !< basal stress constant (no dimension) + real(dp) :: Coulomb_Bump_Wavelength = 2.0d0 !< bed rock wavelength at subgrid scale precision (m) + real(dp) :: Coulomb_Bump_max_slope = 0.5d0 !< maximum bed bump slope at subgrid scale precision (no dimension) + end type glide_basal_physics + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_lithot_type + !> holds variables for temperature calculations in the lithosphere + + real(dp),dimension(:,:,:),pointer :: temp => null() !> Three-dimensional temperature field. + logical, dimension(:,:), pointer :: mask => null() !> whether the point has been ice covered at some time + + integer :: num_dim = 1 !> either 1 or 3 for 1D/3D calculations + + ! The sparse matrix and linearised arrays + type(sparse_matrix_type) :: fd_coeff, fd_coeff_slap + integer :: all_bar_top + real(dp), dimension(:), pointer :: rhs + real(dp), dimension(:), pointer :: answer + real(dp), dimension(:), pointer :: supd,diag,subd + + ! work arrays for solver + real(dp), dimension(:), pointer :: rwork + integer, dimension(:), pointer :: iwork + integer mxnelt + + real(dp), dimension(:), pointer :: deltaz => null() !> array holding grid spacing in z + real(dp), dimension(:,:), pointer :: zfactors => null()!> array holding factors for finite differences of vertical diffu + real(dp) :: xfactor,yfactor !> factors for finite differences of horizontal diffu + + + real(dp) :: surft = 2.d0 !> surface temperature, used for calculating initial temperature distribution + real(dp) :: mart = 2.d0 !> sea floor temperature + integer :: nlayer = 20 !> number of layers in lithosphere + real(dp) :: rock_base = -5000.d0 !> depth below sea-level at which geothermal heat gradient is applied + + integer :: numt = 0 !> number time steps for spinning up GTHF calculations + + real(dp) :: rho_r = 3300.0d0 !> The density of lithosphere (kg m$^{-3}$) + real(dp) :: shc_r = 1000.0d0 !> specific heat capcity of lithosphere (J kg$^{-1}$ K$^{-1}$) + real(dp) :: con_r = 3.3d0 !> thermal conductivity of lithosphere (W m$^{-1}$ K$^{-1}$) + + real(dp) :: diffu = 0. !> diffusion coefficient + + end type glide_lithot_type + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type isos_elastic + !> Holds data used by isostatic adjustment calculations + + real(dp) :: d = 0.24d25 !> flexural rigidity !TODO - What are units of d? + real(dp) :: lr !> radius of relative stiffness + real(dp) :: a !> radius of disk + real(dp) :: c1,c2,cd3,cd4 !> coefficients + real(dp), dimension(:,:), pointer :: w !> matrix operator for lithosphere deformation + integer :: wsize !> size of operator (0:rbel_wsize, 0:rbel_wsize), operator is axis symmetric + end type isos_elastic + + type isostasy_type + !> contains isostasy configuration + + integer :: lithosphere = 0 + !> method for calculating equilibrium bedrock depression + !> \begin{description} + !> \item[0] local lithosphere, equilibrium bedrock depression is found using Archimedes' principle + !> \item[1] elastic lithosphere, flexural rigidity is taken into account + !> \end{description} + + integer :: asthenosphere = 0 + !> method for approximating the mantle + !> \begin{description} + !> \item[0] fluid mantle, isostatic adjustment happens instantaneously + !> \item[1] relaxing mantle, mantle is approximated by a half-space + !> \end{description} + + real(dp) :: relaxed_tau = 4000.d0 ! characteristic time constant of relaxing mantle (yr) + real(dp) :: period = 500.d0 ! lithosphere update period (yr) + real(dp) :: next_calc ! when to update lithosphere + logical :: new_load = .false. ! set to true if there is a new surface load + type(isos_elastic) :: rbel ! structure holding elastic lithosphere setup + + real(dp),dimension(:,:),pointer :: relx => null() ! elevation of relaxed topography, by \texttt{thck0}. + real(dp),dimension(:,:),pointer :: load => null() ! load imposed on lithosphere + real(dp),dimension(:,:),pointer :: load_factors => null() ! temporary used for load calculation + + end type isostasy_type + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_funits + character(fname_length) :: sigfile='' !> sigma coordinates file + character(fname_length) :: ncfile='' !> configuration file for netCDF I/O + type(glimmer_nc_output),pointer :: out_first=>NULL() !> first element of linked list defining netCDF outputs + type(glimmer_nc_input), pointer :: in_first=>NULL() !> first element of linked list defining netCDF inputs + type(glimmer_nc_input), pointer :: frc_first=>NULL() !> first element of linked list defining netCDF forcings + ! Note: forcing files are of the same type as input files since they share a lot in common. + end type glide_funits + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_numerics + + !> Parameters relating to the model numerics + real(dp) :: tstart = 0.d0 !> starting time + real(dp) :: tend = 1000.d0 !> end time + real(dp) :: time = 0.d0 !> main loop counter in years + real(dp) :: tinc = 1.d0 !> time step of main loop in years + real(dp) :: ntem = 1.d0 !> multiplier of main time step; allows longer temperature time step + real(dp) :: alpha = 0.5d0 !> richard suggests 1.5 - was a parameter in original + real(dp) :: alphas = 0.5d0 !> was a parameter in the original + real(dp) :: thklim = 100.d0 ! min thickness for computing ice dynamics (m) + real(dp) :: thklim_temp = 1.d0 ! min thickness for computing vertical temperature (m) (higher-order only) + real(dp) :: mlimit = -200.d0 + real(dp) :: calving_fraction = 0.8d0 + real(dp) :: dew = 20.d3 + real(dp) :: dns = 20.d3 + real(dp) :: dt = 0.d0 ! ice dynamics timestep + real(dp) :: dttem = 0.d0 ! temperature timestep + real(dp) :: dt_transport = 0.d0 ! timestep for subcycling transport within the dynamics timestep dt + real(dp) :: nshlf = 0.d0 !TODO - not currently used; remove? + integer :: subcyc = 1 + real(dp) :: periodic_offset_ew = 0.d0 ! optional periodic_offsets for ismip-hom and similar tests + real(dp) :: periodic_offset_ns = 0.d0 ! These may be needed to ensure continuous ice geometry at + ! the edges of the global domain. + + integer :: timecounter = 0 !> count time steps + + ! Vertical coordinate --------------------------------------------------- + + real(dp),dimension(:),pointer :: sigma => null() !> Sigma values for vertical spacing of + !> model levels + real(dp),dimension(:),pointer :: stagsigma => null() !> Staggered values of sigma (layer midpts) + real(dp),dimension(:),pointer :: stagwbndsigma => null() !> Staggered values of sigma (layer midpts) with boundaries + + integer :: profile_period = 100 ! profile frequency + + !TODO - Compute ndiag as a function of dt_diag and pass to glide_diagnostics? + ! This is more robust than computing mods of real numbers. + + real(dp) :: dt_diag = 0.d0 ! diagnostic time interval (write diagnostics every dt_diag years) + integer :: ndiag = -999 ! diagnostic period (write output every ndiag steps) + integer :: idiag = 1 ! global grid indices for diagnostic point + integer :: jdiag = 1 ! + integer :: idiag_local = 1 ! local grid indices for diagnostic point + integer :: jdiag_local = 1 + integer :: rdiag_local = 0 ! task number for diagnostic point + + real(dp) :: adv_cfl_dt = 0.0d0 ! maximum allowable dt (yrs) based on advective CFL (calculated by model for each time step) + real(dp) :: diff_cfl_dt = 0.0d0 ! maximum allowable dt (yrs) based on diffusive CFL (calculated by model for each time step) + end type glide_numerics + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !TODO - Is the glide_grnd type still needed? + type glide_grnd + ! variables for tracking the grounding line + real(dp),dimension(:,:),pointer :: gl_ew => null() + real(dp),dimension(:,:),pointer :: gl_ns => null() + real(dp),dimension(:,:),pointer :: gline_flux => null() !> flux at the + !grounding line + end type glide_grnd + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_velowk + real(dp),dimension(:), pointer :: depth => null() + real(dp),dimension(:), pointer :: dupsw => null() + real(dp),dimension(:), pointer :: depthw => null() + real(dp),dimension(:), pointer :: suvel => null() + real(dp),dimension(:), pointer :: svvel => null() + real(dp),dimension(:,:),pointer :: fslip => null() + real(dp),dimension(:,:),pointer :: dintflwa => null() + real(dp),dimension(:), pointer :: dups => null() + real(dp),dimension(4) :: fact + real(dp),dimension(4) :: c = 0.d0 + real(dp) :: watwd = 3.0d0 + real(dp) :: watct = 10.0d0 + real(dp) :: trc0 = 0.d0 + real(dp) :: trcmin = 0.0d0 + real(dp) :: marine = 1.0d0 + real(dp) :: trcmax = 10.0d0 + real(dp) :: btrac_const = 0.0d0 !TODO - Remove from glide_velowk type; already in glide_paramets type. + real(dp) :: btrac_slope = 0.0d0 + real(dp) :: btrac_max = 0.d0 + end type glide_velowk + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_thckwk + real(dp),dimension(:,:), pointer :: oldthck => null() + real(dp),dimension(:,:), pointer :: oldthck2 => null() +!! real(dp),dimension(:,:),pointer :: float => null() ! no longer used + real(dp),dimension(:,:,:),pointer :: olds => null() + integer :: nwhich = 2 + real(dp) :: oldtime = 0.d0 + + ! next four are for ADI evolution only + real(dp), dimension(:), pointer :: alpha => null() + real(dp), dimension(:), pointer :: beta => null() + real(dp), dimension(:), pointer :: gamma => null() + real(dp), dimension(:), pointer :: delta => null() + + end type glide_thckwk + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !WHL - Moved dissip to glide_temper + type glide_tempwk + real(dp),dimension(:,:,:),pointer :: inittemp => null() + real(dp),dimension(:,:,:),pointer :: compheat => null() + real(dp),dimension(:,:,:),pointer :: initadvt => null() + real(dp),dimension(:), pointer :: dupa => null() + real(dp),dimension(:), pointer :: dupb => null() + real(dp),dimension(:), pointer :: dupc => null() + real(dp),dimension(:), pointer :: c1 => null() + real(dp),dimension(:,:), pointer :: dups => null() + real(dp),dimension(:,:), pointer :: wphi => null() + real(dp),dimension(:,:), pointer :: smth => null() + real(dp),dimension(:,:,:),pointer :: hadv_u => null() + real(dp),dimension(:,:,:),pointer :: hadv_v => null() + + !*sfp** added space to the next 2 (cons, f) for use w/ HO and SSA dissip. calc. + real(dp),dimension(5) :: cons = 0.d0 + real(dp),dimension(5) :: f = 0.d0 + real(dp),dimension(8) :: c = 0.d0 + real(dp),dimension(2) :: slide_f + real(dp) :: noflow = -1 + real(dp),dimension(2) :: advconst = 0.d0 + real(dp) :: zbed = 0.d0 + real(dp) :: dupn = 0.d0 + real(dp) :: wmax = 0.d0 + real(dp) :: dt_wat = 0.d0 + real(dp) :: watvel = 0.d0 + integer :: nwat = 0 + end type glide_tempwk + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_paramets + real(dp),dimension(5) :: bpar = (/ 0.2d0, 0.5d0, 0.0d0 ,1.0d-2, 1.0d0/) + real(dp) :: btrac_const = 0.d0 ! m yr^{-1} Pa^{-1} (gets scaled during init) + real(dp) :: btrac_slope = 0.0d0 ! Pa^{-1} (gets scaled during init) + real(dp) :: btrac_max = 0.d0 ! m yr^{-1} Pa^{-1} (gets scaled during init) + real(dp) :: geot = -5.0d-2 ! W m^{-2}, positive down + real(dp) :: flow_enhancement_factor = 1.0d0 ! flow enhancement parameter for the Arrhenius relationship; + ! typically used in SIA model to speed up the ice + ! (NOTE change relative to prev. versions of code - used to be 3) + real(dp) :: slip_ratio = 1.0d0 ! Slip ratio, used only in higher order code when the slip ratio beta computation is requested + real(dp) :: hydtim = 1000.0d0 ! years, converted to s^{-1} and scaled + ! 0 if no drainage + real(dp) :: bwat_smooth = 0.01d0 ! basal water field smoothing strength + real(dp) :: default_flwa = 1.0d-16 ! Glen's A to use in isothermal case, in units Pa^{-n} yr^{-1} + ! (would change to e.g. 4.6e-18 in EISMINT-ROSS case) + real(dp) :: efvs_constant = 2336041.d0 ! value of efvs to use in constant efvs case, in units Pa yr + ! = 0.5*A^(-1), where A = 2.140373 Pa^(-1) yr^(1) is the value used in ISMIP-HOM Test F + real(dp) :: ho_beta_const = 10.d0 ! spatially uniform beta for HO dycores, Pa yr m^{-1} (gets scaled during init) + real(dp) :: p_ocean_penetration = 0.0d0 ! p-exponent parameter for ocean penetration parameterization + + end type glide_paramets + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Should the glide_basalproc type be removed? + ! Keeping it for now because glam_strs2 uses mintauf (but this could be moved to another type). + type glide_basalproc + !Tuneables, set in the config file +! real(dp):: fric=0.45d0 ! Till coeff of internal friction: ND +! real(dp):: etillo=0.7d0 ! Till void ratio at No +! real(dp):: No=1000.d0 ! Reference value of till effective stress +! real(dp):: Comp=0.12d0 ! Till coeff of compressibility: ND +! real(dp):: Cv = 1.0d-8 ! Till hydraulic diffusivity: m2/s +! real(dp):: Kh = 1.0d-10 !Till hydraulic conductivity: m/s +! real(dp):: Zs = 3.0d0 ! Solid till thickness: m +! real(dp):: aconst=994000000d0 ! Constant in till strength eq. (Pa) +! real(dp):: bconst=21.7d0 ! Constant in till strength eq. (ND) +! integer:: till_hot = 0 +! integer:: tnodes = 5 + + real(dp), dimension (:) , pointer :: till_dz => null() !holds inital till layer spacing - + + !Model variables that will be passed to other subroutines + real(dp),dimension(:,:) ,pointer :: mintauf => null() !Bed strength calculated with basal proc. mod. +! real(dp),dimension(:,:) ,pointer :: Hwater => null() !Water available from till layer (m) + !Model variabled necessary for restart +! real(dp),dimension(:,:,:) ,pointer :: u => null() !Till excess pore pressure (Pa) +! real(dp),dimension(:,:,:) ,pointer :: etill => null() !Till void ratio (ND) + + end type glide_basalproc + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type glide_prof_type + integer :: geomderv + integer :: hvelos + integer :: ice_mask1 + integer :: temperature + integer :: ice_evo + integer :: ice_mask2 + integer :: isos_water + integer :: isos + end type glide_prof_type + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Remove the glide_phaml type? Commented out for now +!! type glide_phaml +!! real(dp),dimension(:,:),pointer :: uphaml => null() +!! real(dp),dimension(:,:),pointer :: init_phaml => null() +!! real(dp),dimension(:,:),pointer :: rs_phaml => null() +!! !maybe put the x/y vectors here too just for simplicity +!! end type glide_phaml + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + ! for JFNK, NOX Trilinos solver + type, public :: glissade_solver + + integer ,dimension(:,:) ,allocatable :: ui + integer ,dimension(:,:) ,allocatable :: um + real(dp) ,dimension(:,:) ,allocatable :: d2thckcross + real(dp) ,dimension(:,:) ,allocatable :: d2usrfcross + integer ,dimension(2) :: pcgsize + integer ,dimension(:) ,allocatable :: gxf + real(dp) :: L2norm + type(sparse_matrix_type) :: matrix + type(sparse_matrix_type) :: matrixA + type(sparse_matrix_type) :: matrixC + real(dp),dimension(:),pointer :: rhsd => null() + real(dp),dimension(:),pointer :: answ => null() + integer :: ct = 0 + + !TODO - KJE - Remove ewn/nsn from glissade_solver type once new glide_global_type is working and we can use those ewn/nsn + integer :: ewn + integer :: nsn + + end type glissade_solver + + + type glide_global_type ! type containing all of the above for an ice sheet model instance + integer :: model_id !> Used in the global model list for error handling purposes + type(glide_general) :: general + type(glide_options) :: options + type(glide_geometry) :: geometry + type(glide_geomderv) :: geomderv + type(glide_velocity) :: velocity + type(glide_stress_t) :: stress + type(glide_climate) :: climate + type(eismint_climate_type) :: eismint_climate + type(glide_temper) :: temper + type(glide_basal_physics) :: basal_physics + type(glide_lithot_type) :: lithot + type(glide_funits) :: funits + type(glide_numerics) :: numerics + type(glide_velowk) :: velowk + type(glide_thckwk) :: thckwk + type(glide_tempwk) :: tempwk + type(glide_paramets) :: paramets + type(glimmap_proj) :: projection + type(glide_basalproc):: basalproc + type(profile_type) :: profile + type(glide_prof_type):: glide_prof + type(isostasy_type) :: isostasy +!! type(glide_phaml) :: phaml + type(glide_grnd) :: ground + type(glissade_solver):: solver_data + + end type glide_global_type + +contains + + subroutine glide_allocarr(model) + + !> Allocates the model arrays, and initialises some of them to zero. + !> These are the arrays allocated, and their dimensions: + + !TODO - Make sure the itemized lists in subroutine glide_allocarr are complete. + + !> In \texttt{model\%temper}: + !> \begin{itemize} + !> \item \texttt{temp(upn,0:ewn+1,0:nsn+1))} !WHL - 2 choices + !> \item \texttt{bheatflx(ewn,nsn))} + !> \item \texttt{flwa(upn,ewn,nsn))} !WHL - 2 choices + !> \item \texttt{dissip(upn,ewn,nsn))} !WHL - 2 choices + !> \item \texttt{bwat(ewn,nsn))} + !> \item \texttt{bmlt(ewn,nsn))} + !> \item \texttt{bfricflx(ewn,nsn))} + !> \item \texttt{ucondflx(ewn,nsn))} + !> \item \texttt{lcondflx(ewn,nsn))} + !> \item \texttt{dissipcol(ewn,nsn))} + !> \item \texttt{waterfrac(upn-1ewn,nsn))} ! for enthalpy scheme under construction + !> \item \texttt{enthalpy(0:upn,ewn,nsn))} ! for enthalpy scheme under construction + !> \end{itemize} + + !> In \texttt{model\%velocity}: + !> \begin{itemize} + !> \item \texttt{uvel(upn,ewn-1,nsn-1))} + !> \item \texttt{vvel(upn,ewn-1,nsn-1))} + !> \item \texttt{wvel(upn,ewn,nsn))} + !> \item \texttt{wgrd(upn,ewn,nsn))} + !> \item \texttt{uflx(ewn-1,nsn-1))} + !> \item \texttt{vflx(ewn-1,nsn-1))} + !> \item \texttt{diffu(ewn,nsn))} + !> \item \texttt{btrc(ewn,nsn))} + !> \item \texttt{ubas(ewn,nsn))} + !> \item \texttt{vbas(ewn,nsn))} + !> \end{itemize} + + !> In \texttt{model\%climate}: + !> \begin{itemize} + !> \item \texttt{acab(ewn,nsn))} + !> \item \texttt{artm(ewn,nsn))} + !> \end{itemize} + + !> In \texttt{model\%geomderv}: + !> \begin{itemize} + !> \item \texttt{dthckdew(ewn,nsn))} + !> \item \texttt{dusrfdew(ewn,nsn))} + !> \item \texttt{dthckdns(ewn,nsn))} + !> \item \texttt{dusrfdns(ewn,nsn))} + !> \item \texttt{dthckdtm(ewn,nsn))} + !> \item \texttt{dusrfdtm(ewn,nsn))} + !> \item \texttt{stagthck(ewn-1,nsn-1))} + !> \end{itemize} + + !> In \texttt{model\%geometry}: + !> \begin{itemize} + !> \item \texttt{thck(ewn,nsn))} + !> \item \texttt{usrf(ewn,nsn))} + !> \item \texttt{lsrf(ewn,nsn))} + !> \item \texttt{topg(ewn,nsn))} + !> \item \texttt{mask(ewn,nsn))} + !> \item \texttt{age(ewn,nsn))} + !> \item \texttt{f_ground(ewn-1,nsn-1)} + !* (DFM) added floating_mask, ice_mask, lower_cell_loc, and lower_cell_temp + !> \item \texttt{floating_mask(ewn,nsn))} + !> \item \texttt{ice_mask(ewn,nsn))} + !> \item \texttt{lower_cell_loc(ewn,nsn))} + !> \item \texttt{lower_cell_temp(ewn,nsn))} + !> \end{itemize} + + !> In \texttt{model\%thckwk}: + !> \begin{itemize} + !> \item \texttt{olds(ewn,nsn,thckwk\%nwhich))} + !> \end{itemize} + + !> In \texttt{model\%numerics}: + !> \begin{itemize} + !> \item \texttt{sigma(upn))} + !> \end{itemize} + + !> In \texttt{model\%numerics}: + !> \begin{itemize} + !> \item \texttt{stagsigma(upn-1))} + !> \end{itemize} + + use glimmer_log + use glimmer_coordinates, only: coordsystem_allocate + use glimmer_paramets, only: unphys_val + + implicit none + + type(glide_global_type),intent(inout) :: model + + integer :: ewn,nsn,upn + + ! for simplicity, copy these values... + + ewn = model%general%ewn + nsn = model%general%nsn + upn = model%general%upn + + ! horizontal coordinates + + allocate(model%general%x0(ewn-1))!; model%general%x0 = 0.d0 ! velocity grid + allocate(model%general%y0(nsn-1))!; model%general%y0 = 0.d0 + allocate(model%general%x1(ewn))!; model%general%x1 = 0.d0 ! ice grid (for scalars) + allocate(model%general%y1(nsn))!; model%general%y1 = 0.d0 + + ! vertical sigma coordinates + ! If we already have sigma, don't reallocate + + if (associated(model%numerics%sigma)) then + if (size(model%numerics%sigma) /= upn) then + call write_log('Wrong number of sigma levels given',GM_FATAL) + end if + else + allocate(model%numerics%sigma(upn)) + endif + + allocate(model%numerics%stagsigma(upn-1)) + allocate(model%numerics%stagwbndsigma(0:upn)) !MJH added (0:upn) as separate variable + + ! temperature arrays + + !NOTE: In the glide dycore (whichdycore = DYCORE_GLIDE), the temperature and + ! flow factor live on the unstaggered vertical grid, and extra rows and columns + ! (with indices 0:ewn+1, 0:nsn+1) are needed. + ! In the glam/glissade dycore, the temperature and flow factor live on + ! the staggered vertical grid, with temp and flwa defined at the + ! center of each layer k = 1:upn-1. The temperature (but not flwa) + ! is defined at the upper surface (k = 0) and lower surface (k = upn). + + if (model%options%whichdycore == DYCORE_GLIDE) then + allocate(model%temper%temp(upn,0:ewn+1,0:nsn+1)) + call coordsystem_allocate(model%general%ice_grid, upn, model%temper%flwa) + call coordsystem_allocate(model%general%ice_grid, upn, model%temper%dissip) + else ! glam/glissade dycore + allocate(model%temper%temp(0:upn,1:ewn,1:nsn)) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%temper%flwa) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%temper%dissip) + endif + + ! MJH - Set temp and flwa to physically unrealistic values so we can tell later if + ! arrays were initialized correctly + model%temper%temp(:,:,:) = unphys_val ! unphys_val = -999.d0 + model%temper%flwa(:,:,:) = unphys_val + model%temper%dissip(:,:,:) = 0.d0 + + call coordsystem_allocate(model%general%ice_grid, model%temper%bheatflx) + call coordsystem_allocate(model%general%ice_grid, model%temper%bwat) + call coordsystem_allocate(model%general%ice_grid, model%temper%bwatflx) + call coordsystem_allocate(model%general%velo_grid, model%temper%stagbwat) + call coordsystem_allocate(model%general%ice_grid, model%temper%bmlt) + call coordsystem_allocate(model%general%ice_grid, model%temper%bmlt_tavg) + call coordsystem_allocate(model%general%ice_grid, model%temper%bpmp) + call coordsystem_allocate(model%general%velo_grid, model%temper%stagbpmp) + call coordsystem_allocate(model%general%velo_grid, model%temper%stagbtemp) + call coordsystem_allocate(model%general%ice_grid, model%temper%ucondflx) + + if (model%options%whichdycore /= DYCORE_GLIDE) then ! glam/glissade only + call coordsystem_allocate(model%general%ice_grid, model%temper%bfricflx) + call coordsystem_allocate(model%general%ice_grid, model%temper%lcondflx) + call coordsystem_allocate(model%general%ice_grid, model%temper%dissipcol) + ! water fraction and enthalpy live at the midpoint of each layer (with temp and flwa) + ! enthalpy (like temp) is defined at the upper and lower surfaces as well + call coordsystem_allocate(model%general%ice_grid, upn-1, model%temper%waterfrac) + allocate(model%temper%enthalpy(0:upn,1:ewn,1:nsn)) + model%temper%enthalpy(:,:,:) = 0.d0 + endif + + ! velocity arrays + + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%uvel) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%vvel) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%velnorm) + call coordsystem_allocate(model%general%velo_grid, model%velocity%uflx) + call coordsystem_allocate(model%general%velo_grid, model%velocity%vflx) + call coordsystem_allocate(model%general%velo_grid, model%velocity%bed_softness) + call coordsystem_allocate(model%general%velo_grid, model%velocity%btrc) + call coordsystem_allocate(model%general%velo_grid, 2, model%velocity%btraction) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%resid_u) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%resid_v) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%rhs_u) + call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%rhs_v) + + ! These two are on the extended staggered grid, which is the same size as the ice grid. + call coordsystem_allocate(model%general%ice_grid, upn, model%velocity%uvel_extend) + call coordsystem_allocate(model%general%ice_grid, upn, model%velocity%vvel_extend) + + call coordsystem_allocate(model%general%velo_grid, model%velocity%ubas) + call coordsystem_allocate(model%general%velo_grid, model%velocity%ubas_tavg) + call coordsystem_allocate(model%general%velo_grid, model%velocity%vbas) + call coordsystem_allocate(model%general%velo_grid, model%velocity%vbas_tavg) + + if (model%options%whichdycore == DYCORE_GLIDE) then + call coordsystem_allocate(model%general%ice_grid, upn, model%velocity%wvel) + call coordsystem_allocate(model%general%ice_grid, upn, model%velocity%wgrd) + call coordsystem_allocate(model%general%velo_grid, model%velocity%diffu) + call coordsystem_allocate(model%general%velo_grid, model%velocity%diffu_x) + call coordsystem_allocate(model%general%velo_grid, model%velocity%diffu_y) + call coordsystem_allocate(model%general%velo_grid, model%velocity%total_diffu) + call coordsystem_allocate(model%general%velo_grid, model%velocity%tau_x) + call coordsystem_allocate(model%general%velo_grid, model%velocity%tau_y) + else ! glam/glissade dycore + call coordsystem_allocate(model%general%velo_grid, model%velocity%beta) + ! Set beta to a physically unrealistic value so we can tell later if it was read + ! correctly from an input file + model%velocity%beta(:,:) = -999.0d0 + call coordsystem_allocate(model%general%ice_grid, model%velocity%unstagbeta) + ! WHL - Set unstagbeta to a physically unrealistic values so we can tell later if + ! it was read correctly from an input file + model%velocity%unstagbeta(:,:) = unphys_val + + call coordsystem_allocate(model%general%ice_grid, upn, model%velocity%wvel_ho) + call coordsystem_allocate(model%general%velo_grid, model%velocity%kinbcmask) + call coordsystem_allocate(model%general%velo_grid, model%velocity%dynbcmask) + ! next 3 used for output of residual fields (when relevant code in glam_strs2 is active) +! call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%ures) +! call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%vres) +! call coordsystem_allocate(model%general%velo_grid, upn, model%velocity%magres) + endif + + ! higher-order stress arrays + + if (model%options%whichdycore /= DYCORE_GLIDE) then ! glam/glissade dycore + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%efvs) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%scalar) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%xz) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%yz) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%xx) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%yy) + call coordsystem_allocate(model%general%ice_grid, upn-1, model%stress%tau%xy) + call coordsystem_allocate(model%general%velo_grid, model%stress%btractx) + call coordsystem_allocate(model%general%velo_grid, model%stress%btracty) + endif + + ! geometry arrays + call coordsystem_allocate(model%general%ice_grid, model%geometry%thck) + call coordsystem_allocate(model%general%ice_grid, model%geometry%usrf) + call coordsystem_allocate(model%general%ice_grid, model%geometry%lsrf) + call coordsystem_allocate(model%general%ice_grid, model%geometry%topg) + call coordsystem_allocate(model%general%ice_grid, model%geometry%thkmask) + call coordsystem_allocate(model%general%velo_grid, model%geometry%stagmask) + + call coordsystem_allocate(model%general%velo_grid, model%geomderv%stagthck) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dthckdew) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dthckdns) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dusrfdew) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dusrfdns) + + !* (DFM) -- added floating_mask, ice_mask, lower_cell_loc, and lower_cell_temp here + call coordsystem_allocate(model%general%ice_grid, model%geometry%floating_mask) + call coordsystem_allocate(model%general%ice_grid, model%geometry%ice_mask) + call coordsystem_allocate(model%general%ice_grid, model%geometry%lower_cell_loc) + call coordsystem_allocate(model%general%ice_grid, model%geometry%lower_cell_temp) + + if (model%options%whichdycore == DYCORE_GLIDE) then + call coordsystem_allocate(model%general%ice_grid, model%geometry%thck_index) + call coordsystem_allocate(model%general%ice_grid, model%geomderv%dthckdtm) + call coordsystem_allocate(model%general%ice_grid, model%geomderv%dusrfdtm) + allocate(model%thckwk%olds(ewn,nsn,model%thckwk%nwhich)) + model%thckwk%olds = 0.d0 + call coordsystem_allocate(model%general%ice_grid, model%thckwk%oldthck) + call coordsystem_allocate(model%general%ice_grid, model%thckwk%oldthck2) + else ! glam/glissade dycore + call coordsystem_allocate(model%general%ice_grid, upn-1, model%geometry%age) + call coordsystem_allocate(model%general%velo_grid, model%geometry%f_ground) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dlsrfdew) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%dlsrfdns) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%staglsrf) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%stagusrf) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%stagtopg) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%d2usrfdew2) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%d2usrfdns2) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%d2thckdew2) + call coordsystem_allocate(model%general%velo_grid, model%geomderv%d2thckdns2) + endif + + ! Basal Physics + if ( (model%options%which_ho_babc == HO_BABC_POWERLAW) .or. & + (model%options%which_ho_babc == HO_BABC_COULOMB_FRICTION) .or. & + (model%options%whichbwat == BWATER_OCEAN_PENETRATION) ) then + call coordsystem_allocate(model%general%ice_grid, model%basal_physics%effecpress) + call coordsystem_allocate(model%general%velo_grid, model%basal_physics%effecpress_stag) + endif + + ! climate arrays + call coordsystem_allocate(model%general%ice_grid, model%climate%acab) + call coordsystem_allocate(model%general%ice_grid, model%climate%acab_tavg) + call coordsystem_allocate(model%general%ice_grid, model%climate%artm) + call coordsystem_allocate(model%general%ice_grid, model%climate%calving) + + ! matrix solver arrays + + allocate (model%solver_data%rhsd(ewn*nsn)) + allocate (model%solver_data%answ(ewn*nsn)) + + call new_sparse_matrix(ewn*nsn, 5*ewn*nsn, model%solver_data%matrix) + + !TODO - In model%lithot%temp, put the vertical index 3rd as in model%temper%temp? + + ! lithosphere arrays + + if (model%options%gthf == GTHF_COMPUTE) then + allocate(model%lithot%temp(1:ewn,1:nsn,model%lithot%nlayer)); model%lithot%temp = 0.d0 + call coordsystem_allocate(model%general%ice_grid, model%lithot%mask) + endif + + ! isostasy arrays + + call coordsystem_allocate(model%general%ice_grid, model%isostasy%relx) ! MJH: relx needs to be allocated always. + if (model%options%isostasy == ISOSTASY_COMPUTE) then + call coordsystem_allocate(model%general%ice_grid, model%isostasy%load) + call coordsystem_allocate(model%general%ice_grid, model%isostasy%load_factors) + endif + + ! The remaining arrays are not currently used (except mintauf) + ! phaml arrays +!! call coordsystem_allocate(model%general%ice_grid, model%phaml%init_phaml) +!! call coordsystem_allocate(model%general%ice_grid, model%phaml%rs_phaml) +!! call coordsystem_allocate(model%general%ice_grid, model%phaml%uphaml) + + ! grounding line arrays (not currently supported) + +!! if (model%options%whichdycore /= DYCORE_GLIDE) then ! glam/glissade dycore +!! allocate (model%ground%gl_ew(ewn-1,nsn)) +!! allocate (model%ground%gl_ns(ewn,nsn-1)) +!! allocate (model%ground%gline_flux(ewn,nsn)) +!! endif + + ! basal process arrays + ! not currently supported, except that glam_strs2 uses mintauf + + if (model%options%whichdycore /= DYCORE_GLIDE) then ! glam/glissade dycore +!! call coordsystem_allocate(model%general%ice_grid, model%basalproc%Hwater) + call coordsystem_allocate(model%general%velo_grid, model%basalproc%mintauf) +!! allocate(model%basalproc%u (ewn-1,nsn-1,model%basalproc%tnodes)); model%basalproc%u=41.0d3 +!! allocate(model%basalproc%etill (ewn-1,nsn-1,model%basalproc%tnodes));model%basalproc%etill=0.5d0 + endif + + end subroutine glide_allocarr + + + subroutine glide_deallocarr(model) + + !> deallocate model arrays + !TODO - Check that all arrays allocated above are deallocated here. + + implicit none + type(glide_global_type),intent(inout) :: model + + ! horizontal coordinates + + if (associated(model%general%x0)) & + deallocate(model%general%x0) + if (associated(model%general%y0)) & + deallocate(model%general%y0) + if (associated(model%general%x1)) & + deallocate(model%general%x1) + if (associated(model%general%y1)) & + deallocate(model%general%y1) + + ! vertical sigma coordinates + + if (associated(model%numerics%sigma)) & + deallocate(model%numerics%sigma) + if (associated(model%numerics%stagsigma)) & + deallocate(model%numerics%stagsigma) + if (associated(model%numerics%stagwbndsigma)) & + deallocate(model%numerics%stagwbndsigma) + + ! temperature arrays + + if (associated(model%temper%temp)) & + deallocate(model%temper%temp) + if (associated(model%temper%bheatflx)) & + deallocate(model%temper%bheatflx) + if (associated(model%temper%bwat)) & + deallocate(model%temper%bwat) + if (associated(model%temper%bwatflx)) & + deallocate(model%temper%bwatflx) + if (associated(model%temper%stagbwat)) & + deallocate(model%temper%stagbwat) + if (associated(model%temper%bmlt)) & + deallocate(model%temper%bmlt) + if (associated(model%temper%bmlt_tavg)) & + deallocate(model%temper%bmlt_tavg) + if (associated(model%temper%bpmp)) & + deallocate(model%temper%bpmp) + if (associated(model%temper%stagbpmp)) & + deallocate(model%temper%stagbpmp) + if (associated(model%temper%stagbtemp)) & + deallocate(model%temper%stagbtemp) + if (associated(model%temper%bfricflx)) & + deallocate(model%temper%bfricflx) + if (associated(model%temper%ucondflx)) & + deallocate(model%temper%ucondflx) + if (associated(model%temper%lcondflx)) & + deallocate(model%temper%lcondflx) + if (associated(model%temper%dissipcol)) & + deallocate(model%temper%dissipcol) + if (associated(model%temper%waterfrac)) & + deallocate(model%temper%waterfrac) + if (associated(model%temper%enthalpy)) & + deallocate(model%temper%enthalpy) + if (associated(model%temper%flwa)) & + deallocate(model%temper%flwa) + if (associated(model%temper%dissip)) & + deallocate(model%temper%dissip) + + ! velocity arrays + + if (associated(model%velocity%uvel)) & + deallocate(model%velocity%uvel) + if (associated(model%velocity%vvel)) & + deallocate(model%velocity%vvel) + if (associated(model%velocity%velnorm)) & + deallocate(model%velocity%velnorm) + if (associated(model%velocity%wvel)) & + deallocate(model%velocity%wvel) + if (associated(model%velocity%uflx)) & + deallocate(model%velocity%uflx) + if (associated(model%velocity%vflx)) & + deallocate(model%velocity%vflx) + if (associated(model%velocity%bed_softness)) & + deallocate(model%velocity%bed_softness) + if (associated(model%velocity%btrc)) & + deallocate(model%velocity%btrc) + if (associated(model%velocity%btraction)) & + deallocate(model%velocity%btraction) + if (associated(model%velocity%uvel_extend)) & + deallocate(model%velocity%uvel_extend) + if (associated(model%velocity%vvel_extend)) & + deallocate(model%velocity%vvel_extend) + if (associated(model%velocity%resid_u)) & + deallocate(model%velocity%resid_u) + if (associated(model%velocity%resid_v)) & + deallocate(model%velocity%resid_v) + if (associated(model%velocity%rhs_u)) & + deallocate(model%velocity%rhs_u) + if (associated(model%velocity%rhs_v)) & + deallocate(model%velocity%rhs_v) + + if (associated(model%velocity%ubas)) & + deallocate(model%velocity%ubas) + if (associated(model%velocity%ubas_tavg)) & + deallocate(model%velocity%ubas_tavg) + if (associated(model%velocity%vbas)) & + deallocate(model%velocity%vbas) + if (associated(model%velocity%vbas_tavg)) & + deallocate(model%velocity%vbas_tavg) + + if (associated(model%velocity%wgrd)) & + deallocate(model%velocity%wgrd) + if (associated(model%velocity%diffu)) & + deallocate(model%velocity%diffu) + if (associated(model%velocity%diffu_x)) & + deallocate(model%velocity%diffu_x) + if (associated(model%velocity%diffu_y)) & + deallocate(model%velocity%diffu_y) + if (associated(model%velocity%total_diffu)) & + deallocate(model%velocity%total_diffu) + if (associated(model%velocity%tau_x)) & + deallocate(model%velocity%tau_x) + if (associated(model%velocity%tau_y)) & + deallocate(model%velocity%tau_y) + +!! if (associated(model%velocity%velmask)) & ! no longer used +!! deallocate(model%velocity%velmask) + + if (associated(model%velocity%beta)) & + deallocate(model%velocity%beta) + if (associated(model%velocity%unstagbeta)) & + deallocate(model%velocity%unstagbeta) + if (associated(model%velocity%wvel_ho)) & + deallocate(model%velocity%wvel_ho) + if (associated(model%velocity%kinbcmask)) & + deallocate(model%velocity%kinbcmask) + if (associated(model%velocity%dynbcmask)) & + deallocate(model%velocity%dynbcmask) + + !! next 3 used for output of residual fields (when relevant code in glam_strs2 is active) +! if (associated(model%velocity%ures)) & +! deallocate(model%velocity%ures) +! if (associated(model%velocity%vres)) & +! deallocate(model%velocity%vres) +! if (associated(model%velocity%magres)) & +! deallocate(model%velocity%magres) + + ! higher-order stress arrays + + if (associated(model%stress%efvs)) & + deallocate(model%stress%efvs) + if (associated(model%stress%tau%scalar)) & + deallocate(model%stress%tau%scalar) + if (associated(model%stress%tau%xz)) & + deallocate(model%stress%tau%xz) + if (associated(model%stress%tau%yz)) & + deallocate(model%stress%tau%yz) + if (associated(model%stress%tau%xx)) & + deallocate(model%stress%tau%xx) + if (associated(model%stress%tau%yy)) & + deallocate(model%stress%tau%yy) + if (associated(model%stress%tau%xy)) & + deallocate(model%stress%tau%xy) + if (associated(model%stress%btractx)) & + deallocate(model%stress%btractx) + if (associated(model%stress%btracty)) & + deallocate(model%stress%btracty) + + ! basal physics arrays + if (associated(model%basal_physics%effecpress)) & + deallocate(model%basal_physics%effecpress) + if (associated(model%basal_physics%effecpress_stag)) & + deallocate(model%basal_physics%effecpress_stag) + + ! geometry arrays + + if (associated(model%geometry%thck)) & + deallocate(model%geometry%thck) + if (associated(model%geometry%usrf)) & + deallocate(model%geometry%usrf) + if (associated(model%geometry%lsrf)) & + deallocate(model%geometry%lsrf) + if (associated(model%geometry%topg)) & + deallocate(model%geometry%topg) + if (associated(model%geometry%thkmask)) & + deallocate(model%geometry%thkmask) + if (associated(model%geometry%stagmask)) & + deallocate(model%geometry%stagmask) + if (associated(model%geomderv%stagthck)) & + deallocate(model%geomderv%stagthck) + if (associated(model%geomderv%dthckdew)) & + deallocate(model%geomderv%dthckdew) + if (associated(model%geomderv%dthckdns)) & + deallocate(model%geomderv%dthckdns) + if (associated(model%geomderv%dusrfdew)) & + deallocate(model%geomderv%dusrfdew) + if (associated(model%geomderv%dusrfdns)) & + deallocate(model%geomderv%dusrfdns) +!! if (associated(model%geometry%marine_bc_normal)) & +!! deallocate(model%geometry%marine_bc_normal) + + !*SFP: fields that need to be passed to POP for ice ocean coupling + !* (DFM -- deallocate floating_mask, ice_mask, lower_cell_loc, and lower_cell_temp) + if (associated(model%geometry%floating_mask)) & + deallocate(model%geometry%floating_mask) + if (associated(model%geometry%ice_mask)) & + deallocate(model%geometry%ice_mask) + if (associated(model%geometry%lower_cell_loc)) & + deallocate(model%geometry%lower_cell_loc) + if (associated(model%geometry%lower_cell_temp)) & + deallocate(model%geometry%lower_cell_temp) + + if (associated(model%geometry%thck_index)) & + deallocate(model%geometry%thck_index) + if (associated(model%geomderv%dthckdtm)) & + deallocate(model%geomderv%dthckdtm) + if (associated(model%geomderv%dusrfdtm)) & + deallocate(model%geomderv%dusrfdtm) + if (associated(model%thckwk%olds)) & + deallocate(model%thckwk%olds) + if (associated(model%thckwk%oldthck)) & + deallocate(model%thckwk%oldthck) + if (associated(model%thckwk%oldthck2)) & + deallocate(model%thckwk%oldthck2) +!! if (associated(model%thckwk%float)) & ! no longer used +!! deallocate(model%thckwk%float) + + if (associated(model%geometry%age)) & + deallocate(model%geometry%age) + if (associated(model%geometry%f_ground)) & + deallocate(model%geometry%f_ground) + if (associated(model%geomderv%dlsrfdew)) & + deallocate(model%geomderv%dlsrfdew) + if (associated(model%geomderv%dlsrfdns)) & + deallocate(model%geomderv%dlsrfdns) + if (associated(model%geomderv%staglsrf)) & + deallocate(model%geomderv%staglsrf) + if (associated(model%geomderv%stagusrf)) & + deallocate(model%geomderv%stagusrf) + if (associated(model%geomderv%stagtopg)) & + deallocate(model%geomderv%stagtopg) + if (associated(model%geomderv%d2usrfdew2)) & + deallocate(model%geomderv%d2usrfdew2) + if (associated(model%geomderv%d2usrfdns2)) & + deallocate(model%geomderv%d2usrfdns2) + if (associated(model%geomderv%d2thckdew2)) & + deallocate(model%geomderv%d2thckdew2) + if (associated(model%geomderv%d2thckdns2)) & + deallocate(model%geomderv%d2thckdns2) + + ! climate arrays + + if (associated(model%climate%acab)) & + deallocate(model%climate%acab) + if (associated(model%climate%acab_tavg)) & + deallocate(model%climate%acab_tavg) + if (associated(model%climate%artm)) & + deallocate(model%climate%artm) + if (associated(model%climate%calving)) & + deallocate(model%climate%calving) + + ! matrix solver arrays + + if (associated(model%solver_data%rhsd)) & + deallocate(model%solver_data%rhsd) + if (associated(model%solver_data%answ)) & + deallocate(model%solver_data%answ) + + !KJE do we need this here? The parts within are allocated in glam_strs2 + call del_sparse_matrix(model%solver_data%matrix) + + ! lithosphere arrays + + if (associated(model%lithot%temp)) & + deallocate(model%lithot%temp) + if (associated(model%lithot%mask)) & + deallocate(model%lithot%mask) + + ! isostasy arrays + + if (associated(model%isostasy%relx)) & + deallocate(model%isostasy%relx) + if (associated(model%isostasy%load)) & + deallocate(model%isostasy%load) + if (associated(model%isostasy%load_factors)) & + deallocate(model%isostasy%load_factors) + + ! The remaining arrays are not currently used (except mintauf) + ! phaml arrays + +!! if (associated(model%phaml%init_phaml)) & +!! deallocate(model%phaml%init_phaml) +!! if (associated(model%phaml%rs_phaml)) & +!! deallocate(model%phaml%rs_phaml) +!! if (associated(model%phaml%uphaml)) & +!! deallocate(model%phaml%uphaml) + + ! grounding line arrays (not currently supported) + +!! if (associated(model%ground%gl_ns)) & +!! deallocate(model%ground%gl_ns) +!! if (associated(model%ground%gl_ew)) & +!! deallocate(model%ground%gl_ew) +!! if (associated(model%ground%gline_flux)) & +!! deallocate(model%ground%gline_flux) + + ! basal process arrays + ! not currently supported, except that glam_strs2 uses mintauf + +!! if (associated(model%basalproc%Hwater)) & +!! deallocate(model%basalproc%Hwater) + if (associated(model%basalproc%mintauf)) & + deallocate(model%basalproc%mintauf) +!! if (associated(model%basalproc%u)) & +!! deallocate(model%basalproc%u) +!! if (associated(model%basalproc%etill)) & +!! deallocate(model%basalproc%etill) + + end subroutine glide_deallocarr + + + ! some accessor functions + function get_dew(model) + !> return scaled x node spacing + use glimmer_paramets, only : len0 + implicit none + real(dp) :: get_dew + type(glide_global_type) :: model + + get_dew = model%numerics%dew * len0 + end function get_dew + + function get_dns(model) + !> return scaled y node spacing + use glimmer_paramets, only : len0 + implicit none + real(dp) :: get_dns + type(glide_global_type) :: model + + get_dns = model%numerics%dns * len0 + end function get_dns + + function get_tstart(model) + !> return start time + implicit none + real(dp) :: get_tstart + type(glide_global_type) :: model + + get_tstart = model%numerics%tstart + end function get_tstart + + function get_tend(model) + !> return end time + implicit none + real(dp) :: get_tend + type(glide_global_type) :: model + + get_tend = model%numerics%tend + end function get_tend + + function get_tinc(model) + !> return time increment + implicit none + real(dp) :: get_tinc + type(glide_global_type) :: model + + get_tinc = model%numerics%tinc + end function get_tinc + + function get_ewn(model) + !> get number of nodes in x dir + implicit none + integer get_ewn + type(glide_global_type) :: model + + get_ewn = model%general%ewn + end function get_ewn + + function get_nsn(model) + !> get number of nodes in y dir + implicit none + integer get_nsn + type(glide_global_type) :: model + + get_nsn = model%general%nsn + end function get_nsn + + subroutine set_time(model,time) + !> Set the model time counter --- useful for + !> fractional year output + implicit none + type(glide_global_type) :: model + real(dp) :: time + + model%numerics%time = time + end subroutine set_time + +end module glide_types diff --git a/components/cism/glimmer-cism/libglide/glide_vars.def b/components/cism/glimmer-cism/libglide/glide_vars.def new file mode 100644 index 0000000000..416b59956c --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_vars.def @@ -0,0 +1,821 @@ +#[] +#dimensions: time, level, y1, x1 +#units: The documentation will complain if units have LaTeX characters like ^ +#long_name: +#data: +#factor: + +# setup for code generator +[VARSET] +# prefix of the generated module +name: glide +# f90 type containing all necessary data +datatype: glide_global_type +# module where type is defined +datamod: glide_types + +[x0] +dimensions: x0 +units: meter +long_name: Cartesian x-coordinate, velocity grid +axis: X +data: data%general%x0 +dimlen: global_ewn-1 + +[y0] +dimensions: y0 +units: meter +long_name: Cartesian y-coordinate, velocity grid +axis: Y +data: data%general%y0 +dimlen: global_nsn-1 + +[x1] +dimensions: x1 +units: meter +long_name: Cartesian x-coordinate +axis: X +data: data%general%x1 +dimlen: global_ewn +load:1 + +[y1] +dimensions: y1 +units: meter +long_name: Cartesian y-coordinate +axis: Y +data: data%general%y1 +dimlen: global_nsn +load:1 + +[level] +dimensions: level +units: 1 +long_name: sigma layers +standard_name: land_ice_sigma_coordinate +#formula_terms: sigma: level topo: topg thick: thk +positive: down +dimlen: model%general%upn + +[staglevel] +dimensions: staglevel +units: 1 +long_name: stag sigma layers +standard_name: land_ice_stag_sigma_coordinate +positive: down +dimlen: model%general%upn-1 + +[stagwbndlevel] +dimensions: stagwbndlevel +units: 1 +long_name: stag sigma layers with boundaries +standard_name: land_ice_stag_sigma_coordinate_with_bnd +positive: down +dimlen: model%general%upn+1 + +[lithoz] +dimensions: lithoz +units: meter +long_name: vertical coordinate of lithosphere layer +dimlen: model%lithot%nlayer + +[relx] +dimensions: time, y1, x1 +units: meter +long_name: relaxed bedrock topography +data: data%isostasy%relx +factor: thk0 +load: 1 +coordinates: lon lat + +[eus] +dimensions: time +units: meter +long_name: global average sea level +data: data%climate%eus +factor: thk0 +standard_name: global_average_sea_level_change + +[uflx] +dimensions: time, y0, x0 +units: meter2/year +long_name: flux in x direction (NOTE: Glide and Glam only) +data: data%velocity%uflx +factor: scale_uflx + +[vflx] +dimensions: time, y0, x0 +units: meter2/year +long_name: flux in x direction (NOTE: Glide and Glam only) +data: data%velocity%vflx +factor: scale_uflx + +[diffu] +dimensions: time, y0, x0 +units: meter2/year +long_name: apparent diffusivity +data: data%velocity%diffu +factor: scale_diffu + +[btrc] +dimensions: time, y0, x0 +units: meter/pascal/year +long_name: basal slip coefficient +data: data%velocity%btrc +factor: scale_btrc + +[soft] +dimensions: time, y0, x0 +units: meter/pascal/year +long_name: bed softness parameter +data: data%velocity%bed_softness +factor: scale_btrc +load: 1 + +[beta] +dimensions: time, y0, x0 +units: Pa yr/m +long_name: higher-order bed stress coefficient +data: data%velocity%beta +factor: scale_beta +load: 1 + +#WHL - added unstagbeta, which lives on the unstaggered ice grid +# (unlike beta, which lives on the staggered velocity grid) +[unstagbeta] +dimensions: time, y1, x1 +units: Pa yr/m +long_name: higher-order bed stress coefficient on the unstaggered grid (NOTE: this will overwrite beta if both are input) +data: data%velocity%unstagbeta +factor: scale_beta +load: 1 + +[tauf] +dimensions: time, y0, x0 +units: Pa +long_name: higher-order basal yield stress +data: data%basalproc%mintauf +factor: scale_tau +load: 1 + +[btractx] +dimensions: time, y0, x0 +units: Pa +long_name: basal traction (x-direction comp) +data: data%stress%btractx(:,:) +factor: scale_tau + +[btracty] +dimensions: time, y0, x0 +units: Pa +long_name: basal traction (y-direction comp) +data: data%stress%btracty(:,:) +factor: scale_tau + +[ubas] +dimensions: time, y0, x0 +units: meter/year +long_name: basal slip velocity in x direction +data: data%velocity%ubas +factor: scale_uvel +standard_name: land_ice_basal_x_velocity +load: 1 +#average: 1 + +[vbas] +dimensions: time, y0, x0 +units: meter/year +long_name: basal slip velocity in y direction +data: data%velocity%vbas +factor: scale_uvel +standard_name: land_ice_basal_y_velocity +load: 1 +#average: 1 + +[taux] +dimensions: time, y0, x0 +units: kilopascal +long_name: basal shear stress in x direction (NOTE: Glide only) +data: data%velocity%tau_x +factor: 1e-3*thk0*thk0/len0 + +[tauy] +dimensions: time, y0, x0 +units: kilopascal +long_name: basal shear stress in y direction +data: data%velocity%tau_y +factor: 1e-3*thk0*thk0/len0 + +[thk] +dimensions: time, y1, x1 +units: meter +long_name: ice thickness +data: data%geometry%thck +factor: thk0 +load: 1 +standard_name: land_ice_thickness +coordinates: lon lat + +[stagthk] +dimensions: time, y0, x0 +units: meter +long_name: staggered ice thickness +data: data%geomderv%stagthck +factor: thk0 +standard_name: stag_land_ice_thickness +load: 0 +coordinates: lon lat + +[calving] +dimensions: time, y1, x1 +units: meter +long_name: ice margin calving +data: data%climate%calving +factor: thk0 +coordinates: lon lat + +[ivol] +dimensions: time +units: km3 +factor: thk0*len0*len0*1.e-9 +long_name: ice volume +data: data%geometry%ivol + +[iarea] +dimensions: time +units: km2 +long_name: area covered by ice +factor: len0*len0*1.e-6 +data: data%geometry%iarea + +[iareag] +dimensions: time +units: km2 +long_name: area covered by grounded ice +factor: len0*len0*1.e-6 +data: data%geometry%iareag + +[iareaf] +dimensions: time +units: km2 +long_name: area covered by floating ice +factor: len0*len0*1.e-6 +data: data%geometry%iareaf + +[thkmask] +dimensions: time, y1, x1 +long_name: mask +units: 1 +data: data%geometry%thkmask +type: int +coordinates: lon lat +load: 1 + +[usurf] +dimensions: time, y1, x1 +units: meter +long_name: ice upper surface elevation +data: data%geometry%usrf +factor: thk0 +load: 1 +standard_name: surface_altitude +coordinates: lon lat + +[lsurf] +dimensions: time, y1, x1 +units: meter +long_name: ice lower surface elevation +data: data%geometry%lsrf +factor: thk0 +coordinates: lon lat + +[topg] +dimensions: time, y1, x1 +units: meter +long_name: bedrock topography +data: data%geometry%topg +factor: thk0 +load: 1 +standard_name: bedrock_altitude +coordinates: lon lat + +## D. Martin added - fields that need to be passed to POP for ice-ocean coupling +#[floating_mask] +#dimensions: time, y1, x1 +#units: 1 +#long_name: real-valued mask denoting grounded/floating +#data: data%geometry%floating_mask +#factor: 1.0 +#coordinates: lon lat + +# D. Martin added - fields that need to be passed to POP for ice-ocean coupling +[ice_mask] +dimensions: time, y1, x1 +units: 1 +long_name: real-valued mask denoting ice (1) or no ice (0) +data: data%geometry%ice_mask +factor: 1.0 +coordinates: lon lat + +## D. Martin added - fields that need to be passed to POP for ice-ocean coupling +#[lower_cell_loc] +#dimensions: time, y1, x1 +#units: meter +#long_name: location in z of lower cell location +#data: data%geometry%lower_cell_loc +#factor: 1.0 +#coordinates: lon lat + +## D. Martin added - fields that need to be passed to POP for ice-ocean coupling +#[lower_cell_temp] +#dimensions: time, y1, x1 +#units: degrees K +#long_name: temperature at lower_cell_loc +#data: data%geometry%lower_cell_temp +#factor: 1.0 +#coordinates: lon lat + +[acab] +dimensions: time, y1, x1 +units: meter/year +long_name: accumulation, ablation rate +data: data%climate%acab +factor: scale_acab +standard_name: land_ice_surface_specific_mass_balance +coordinates: lon lat +#average: 1 +load: 1 + +#WHL: scale_bflux = -1, to reverse sign convention from + up to + down +[bheatflx] +dimensions: time, y1, x1 +units: watt/meter2 +long_name: upward basal heat flux +data: data%temper%bheatflx +factor: scale_bflx +load: 1 +coordinates: lon lat + +[bmlt] +dimensions: time, y1, x1 +units: meter/year +long_name: basal melt rate +data: data%temper%bmlt +factor: scale_acab +standard_name: land_ice_basal_melt_rate +load: 1 +coordinates: lon lat +#average: 1 + +[bfricflx] +dimensions: time, y1, x1 +units: watt/meter2 +long_name: basal friction heat flux +data: data%temper%bfricflx +factor: 1.0 +load: 1 +coordinates: lon lat + +[bwat] +dimensions: time, y1, x1 +units: meter +long_name: basal water depth +data: data%temper%bwat +factor: thk0 +load: 1 +coordinates: lon lat + +[bwatflx] +dimensions: time, y1, x1 +units: meter3/year +long_name: basal water flux +data: data%temper%bwatflx +factor: thk0 +coordinates: lon lat + +[effecpress] +dimensions: time, y1, x1 +units: Pa +long_name: effective pressure +data: data%basal_physics%effecpress +load: 1 +coordinates: lon lat + +[artm] +dimensions: time, y1, x1 +units: degree_Celsius +long_name: annual mean air temperature +data: data%climate%artm +standard_name: surface_temperature +cell_methods: time: mean +coordinates: lon lat +load: 1 + +[surftemp] +dimensions: time, y1, x1 +units: degree_Celsius +long_name: annual mean surface temperature +data: data%climate%artm +standard_name: surface_temperature +cell_methods: time: mean +coordinates: lon lat +load: 1 + +[btemp] +dimensions: time, y1, x1 +units: degree_Celsius +long_name: basal ice temperature +data: data%temper%temp(data%general%upn,1:data%general%ewn,1:data%general%nsn) +standard_name: land_ice_temperature +coordinates: lon lat + +[dusrfdtm] +dimensions: time, y1, x1 +units: meter/year +long_name: rate of upper ice surface elevation change (NOTE: Glide only) +data: data%geomderv%dusrfdtm +factor: scale_acab +coordinates: lon lat + +[dthckdtm] +dimensions: time, y1,x1 +units: meter/year +long_name: tendency of ice thickness (NOTE: Glide only) +data: data%geomderv%dthckdtm +factor: scale_acab +coordinates: lon lat + +[uvel] +dimensions: time, level, y0, x0 +units: meter/year +long_name: ice velocity in x direction +data: data%velocity%uvel(up,:,:) +factor: scale_uvel +standard_name: land_ice_x_velocity +load: 1 + +[vvel] +dimensions: time, level, y0, x0 +units: meter/year +long_name: ice velocity in y direction +data: data%velocity%vvel(up,:,:) +factor: scale_uvel +standard_name: land_ice_y_velocity +load: 1 + +[uvel_extend] +dimensions: time, level, y1, x1 +units: meter/year +long_name: ice velocity in x direction (extended grid) +data: data%velocity%uvel_extend(up,:,:) +factor: scale_uvel +standard_name: land_ice_x_velocity +hot: 0 + +[vvel_extend] +dimensions: time, level, y1, x1 +units: meter/year +long_name: ice velocity in y direction (extended grid) +data: data%velocity%vvel_extend(up,:,:) +factor: scale_uvel +standard_name: land_ice_y_velocity +hot: 0 + +[resid_u] +dimensions: time, level, y0, x0 +units: Pa/m +long_name: u component of residual Ax - b (NOTE: Glam only) +data: data%velocity%resid_u(up,:,:) +factor: scale_resid + +[resid_v] +dimensions: time, level, y0, x0 +units: Pa/m +long_name: v component of residual Ax - b (NOTE: Glam only) +data: data%velocity%resid_v(up,:,:) +factor: scale_resid + +[rhs_u] +dimensions: time, level, y0, x0 +units: Pa/m +long_name: u component of b in Ax = b +data: data%velocity%rhs_u(up,:,:) +factor: scale_resid + +[rhs_v] +dimensions: time, level, y0, x0 +units: Pa/m +long_name: v component of b in Ax = b +data: data%velocity%rhs_v(up,:,:) +factor: scale_resid + +# used for output of residual +#[ures] +#dimensions: time, level, y0, x0 +#units: meter/year +#long_name: ice velocity resid. in x direction +#data: data%velocity%ures(up,:,:) +#factor: scale_uvel +#standard_name: land_ice_x_velocity_resid + +# used for output of residual +#[vres] +#dimensions: time, level, y0, x0 +#units: meter/year +#long_name: ice velocity resid. in y direction +#data: data%velocity%vres(up,:,:) +#factor: scale_uvel +#standard_name: land_ice_y_velocity_resid + +# used for output of res fields +#[magres] +#dimensions: time, level, y0, x0 +#units: meter/year +#long_name: ice velocity resid. magnitude +#data: data%velocity%magres(up,:,:) +#factor: scale_uvel +#standard_name: land_ice_y_velocity_resid + +[kinbcmask] +dimensions: time, y0, x0 +units: 1 +long_name: Mask of locations where uvel, vvel value should be held +data: data%velocity%kinbcmask(:,:) +type: int +load: 1 + +[dynbcmask] +dimensions: time, y0, x0 +units: 1 +long_name: 2d array of higher-order model boundary condition mask values (NOTE: Glam ONLY) +data: data%velocity%dynbcmask +type: int +load: 0 + +[velnorm] +dimensions: time, level, y0, x0 +units: meter/year +long_name: Horizontal ice velocity magnitude +data: data%velocity%velnorm(up,:,:) +factor: scale_uvel +coordinates: lon lat + +[tau_eff] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: effective stress +data: data%stress%tau%scalar(up,:,:) +factor: scale_tau + +[tau_xz] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: X component vertical shear stress +data: data%stress%tau%xz(up,:,:) +factor: scale_tau + +[tau_yz] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: Y component vertical shear stress +data: data%stress%tau%yz(up,:,:) +factor: scale_tau + +[tau_xx] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: x component of horiz. normal stress +data: data%stress%tau%xx(up,:,:) +factor: scale_tau + +[tau_yy] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: y component of horiz. normal stress +data: data%stress%tau%yy(up,:,:) +factor: scale_tau + +[tau_xy] +dimensions: time, staglevel, y1, x1 +units: Pa +long_name: horiz. shear stress +data: data%stress%tau%xy(up,:,:) +factor: scale_tau + +[wvel] +dimensions: time, level, y1, x1 +units: meter/year +long_name: vertical ice velocity +data: data%velocity%wvel(up,:,:) +factor: scale_wvel +coordinates: lon lat +load: 1 + +[wvel_ho] +dimensions: time, level, y1, x1 +units: meter/year +long_name: vertical ice velocity relative to ice sheet base from higher-order model (NOTE: Glam only) +data: data%velocity%wvel_ho(up,:,:) +factor: scale_wvel +coordinates: lon lat +load: 1 + +[wgrd] +dimensions: time, level, y1, x1 +units: meter/year +long_name: Vertical grid velocity +data: data%velocity%wgrd(up,:,:) +factor: scale_wvel +coordinates: lon lat +load: 1 + +[waterfrac] +dimensions: time, staglevel, y1, x1 +units: unitless [0,1] +long_name: internal water fraction +data: data%temper%waterfrac(up,:,:) +coordinates: lon lat +load: 1 + +[enthalpy] +dimensions: time, stagwbndlevel, y1, x1 +units: J/m^3 +long_name: specific enthalpy +data: data%temper%enthalpy(up,:,:) +coordinates: lon lat + +[flwa] +dimensions: time, level, y1, x1 +units: pascal**(-n) year**(-1) +long_name: Pre-exponential flow law parameter +data: data%temper%flwa(up,:,:) +factor: scale_flwa +load: 1 +coordinates: lon lat + +[flwastag] +dimensions: time, staglevel, y1, x1 +units: pascal**(-n) year**(-1) +long_name: Pre-exponential flow law parameter +data: data%temper%flwa(up,:,:) +factor: scale_flwa +# hot=0 because we do not want the stag version to be in the hotvars definition. +# The conversion to stag happens if needed in check_for_tempstag +# but we do want it loadable in case flwa is listed as hot. +load: 1 +coordinates: lon lat + +[efvs] +dimensions: time, staglevel, y1, x1 +units: Pascal * years +long_name: effective viscosity +data: data%stress%efvs(up,:,:) +factor: scale_efvs +coordinates: lon lat + +[temp] +dimensions: time, level, y1, x1 +units: degree_Celsius +long_name: ice temperature +data: data%temper%temp(up,1:data%general%ewn,1:data%general%nsn) +standard_name: land_ice_temperature +load: 1 +coordinates: lon lat + +[tempstag] +dimensions: time, stagwbndlevel, y1, x1 +units: degree_Celsius +long_name: ice temperature on staggered vertical levels with boundaries +data: data%temper%temp(up,1:data%general%ewn,1:data%general%nsn) +standard_name: land_ice_temperature_stag +# hot=0 because we do not want the stag version to be in the hotvars definition. +# The conversion to stag happens if needed in check_for_tempstag. +load: 1 +coordinates: lon lat + +[litho_temp] +dimensions: time, lithoz, y1, x1 +units: degree_Celsius +long_name: lithosphere temperature +data: data%lithot%temp +load: 1 +coordinates: lon lat + +#[age] +#dimensions: time, level, y1, x1 +#units: year +#long_name: ice age +#data: data%geometry%age(up,:,:) +#standard_name: land_ice_age +#factor: tim0/scyr +#load: 0 +#coordinates: lon lat + +#[f_ground] +#dimensions: time, y0, x0 +#units: unitless [0,1] +#long_name: grounded ice fraction +#data: data%geometry%f_ground +#standard_name: grounded_fraction +#load: 0 +#coordinates: lon lat + +#TODO - Are these gline fields needed? +#[gl_ew] +#dimensions: time, y1, x0 +#units: meter +#long_name: grounding line movement in ew directions +#data: data%ground%gl_ew +#coordinates: lon lat + +#[gl_ns] +#dimensions: time, y0, x1 +#units: meter +#long_name: grounding line movement in ns directions +#data: data%ground%gl_ns +#coordinates: lon lat + +#[gline_flux] +#dimensions: time, y1, x1 +#units: meter2/year +#long_name: grounding line fluxu +#data: data%ground%gline_flux +#coordinates: lon f + +[rho_ice] +dimensions: time +units: kg/meter3 +long_name: ice density +data: rhoi +factor: noscale +standard_name: rho_ice + +[rho_seawater] +dimensions: time +units: kg/meter3 +long_name: seawater density +data: rhoo +factor: noscale +standard_name: rho_seawater + +[gravity] +dimensions: time +units: meter/s/s +long_name: gravitational acceleration +data: grav +factor: noscale +standard_name: gravity + +[seconds_per_year] +dimensions: time +units: s/yr +long_name: seconds per year +data: scyr +factor: noscale +standard_name: seconds_per_year + +[ice_specific_heat] +dimensions: time +units: J/kg/K +long_name: ice specific heat +data: shci +factor: noscale +standard_name: ice_specific_heat + +[ice_thermal_conductivity] +dimensions: time +units: J/(K kg) +long_name: ice thermal conductivity +data: coni +factor: noscale +standard_name: ice_thermal_conductivity + +[dissip] +dimensions: time, level, y1, x1 +units: deg C/yr +long_name: dissipation rate (W m-3) divided by rhoi Ci +data: data%temper%dissip(up,:,:) +factor: scyr +load: 1 +coordinates: lon lat + +[dissipstag] +dimensions: time, staglevel, y1, x1 +units: deg C/yr +long_name: dissipation rate (W m-3) divided by rhoi Ci +data: data%temper%dissip(up,:,:) +factor: scyr +load: 1 +coordinates: lon lat + +[adv_cfl_dt] +dimensions: time +units: years +long_name: advective CFL maximum time step +data: data%numerics%adv_cfl_dt + +[diff_cfl_dt] +dimensions: time +units: years +long_name: diffusive CFL maximum time step +data: data%numerics%diff_cfl_dt diff --git a/components/cism/glimmer-cism/libglide/glide_velo.F90 b/components/cism/glimmer-cism/libglide/glide_velo.F90 new file mode 100644 index 0000000000..9994e3f8e6 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_velo.F90 @@ -0,0 +1,1181 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_velo.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glide_velo + + !> Contains routines which handle various aspects of velocity in the model, + !> not only the bulk ice velocity, but also basal sliding, and vertical grid + !> velocities, etc. + + use glide_types + use glimmer_global, only : dp + use glimmer_physcon, only : rhoi, grav, gn + use glimmer_paramets, only : thk0, len0, vis0, vel0 + + implicit none + + private vertintg + + ! some private parameters + integer, private, parameter :: p1 = gn+1 + integer, private, parameter :: p2 = gn-1 + integer, private, parameter :: p3 = 2*gn+1 + integer, private, parameter :: p4 = gn+2 + + real(dp),private, parameter :: cflow = -2.0d0*vis0*(rhoi*grav)**gn*thk0**p3/(8.0d0*vel0*len0**gn) + +contains + +!TODO - Pretty sure that none of the arrays in init_velo are needed for Glissade, +! so we may not need to call this subroutine from glissade_initialise. +! Move allocation/deallocation to subroutines in glide_types? +! Some velowk arrays are used in wvelintg, but could rewrite wvelintg without these arrays. + + subroutine init_velo(model) + !> initialise velocity module + use glimmer_physcon, only : arrmll, arrmlh, gascon, actenl, actenh, scyr, pi + implicit none + type(glide_global_type) :: model + + integer ewn, nsn, upn + integer up + + ewn=model%general%ewn + nsn=model%general%nsn + upn=model%general%upn + + allocate(model%velowk%fslip(ewn-1,nsn-1)) + + allocate(model%velowk%depth(upn)) + allocate(model%velowk%dintflwa(ewn-1,nsn-1)) + + model%velowk%depth = (/ (((model%numerics%sigma(up+1)+model%numerics%sigma(up))/2.0d0)**gn & + *(model%numerics%sigma(up+1)-model%numerics%sigma(up)),up=1,upn-1),0.0d0 /) + + allocate(model%velowk%dups(upn)) + model%velowk%dups = (/ (model%numerics%sigma(up+1) - model%numerics%sigma(up), up=1,upn-1),0.0d0 /) + + allocate(model%velowk%dupsw (upn)) + allocate(model%velowk%depthw(upn)) + allocate(model%velowk%suvel (upn)) + allocate(model%velowk%svvel (upn)) + + ! Calculate the differences between adjacent sigma levels ------------------------- + + model%velowk%dupsw = (/ (model%numerics%sigma(up+1)-model%numerics%sigma(up), up=1,upn-1), 0.0d0 /) + + ! Calculate the value of sigma for the levels between the standard ones ----------- + + model%velowk%depthw = (/ ((model%numerics%sigma(up+1)+model%numerics%sigma(up)) / 2.0d0, up=1,upn-1), 0.0d0 /) + + model%velowk%fact = (/ model%paramets%flow_enhancement_factor* arrmlh / vis0, & ! Value of a when T* is above -263K + model%paramets%flow_enhancement_factor* arrmll / vis0, & ! Value of a when T* is below -263K + -actenh / gascon, & ! Value of -Q/R when T* is above -263K + -actenl / gascon/) ! Value of -Q/R when T* is below -263K + + model%velowk%watwd = model%paramets%bpar(1) + model%velowk%watct = model%paramets%bpar(2) + model%velowk%trcmin = model%paramets%bpar(3) / scyr + model%velowk%trcmax = model%paramets%bpar(4) / scyr + model%velowk%marine = model%paramets%bpar(5) + model%velowk%trcmax = model%velowk%trcmax / model%velowk%trc0 + model%velowk%trcmin = model%velowk%trcmin / model%velowk%trc0 + model%velowk%c(1) = (model%velowk%trcmax + model%velowk%trcmin) / 2.0d0 + model%velowk%c(2) = (model%velowk%trcmax - model%velowk%trcmin) / 2.0d0 + model%velowk%c(3) = (thk0 * pi) / model%velowk%watwd + model%velowk%c(4) = pi*(model%velowk%watct / model%velowk%watwd) + + + end subroutine init_velo + + + + !***************************************************************************** + ! new velo functions come here + !***************************************************************************** + + subroutine velo_integrate_flwa(velowk,stagthck,flwa) + + !> this routine calculates the part of the vertically averaged velocity + !> field which solely depends on the temperature + !> (The integral in eq. 3.22d) + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glide_velowk), intent(inout) :: velowk + real(dp),dimension(:,:), intent(in) :: stagthck !> ice thickness on staggered grid + real(dp),dimension(:,:,:),intent(in) :: flwa !> ice flow factor + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + real(dp),dimension(size(flwa,1)) :: hrzflwa, intflwa + integer :: ew,ns,up,ewn,nsn,upn + + upn=size(flwa,1) ; ewn=size(flwa,2) ; nsn=size(flwa,3) + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (stagthck(ew,ns) /= 0.0d0) then + + hrzflwa = flwa(:,ew,ns) + flwa(:,ew,ns+1) + flwa(:,ew+1,ns) + flwa(:,ew+1,ns+1) + intflwa(upn) = 0.0d0 + + !Perform inner integration. + do up = upn-1, 1, -1 + intflwa(up) = intflwa(up+1) + velowk%depth(up) * (hrzflwa(up)+hrzflwa(up+1)) + end do + + velowk%dintflwa(ew,ns) = cflow * vertintg(velowk,intflwa) + + else + + velowk%dintflwa(ew,ns) = 0.0d0 + + end if + end do + end do + end subroutine velo_integrate_flwa + + !***************************************************************************** + + subroutine velo_calc_diffu(velowk,stagthck,dusrfdew,dusrfdns,diffu) + + !> calculate diffusivities + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glide_velowk), intent(inout) :: velowk + real(dp),dimension(:,:), intent(in) :: stagthck + real(dp),dimension(:,:), intent(in) :: dusrfdew + real(dp),dimension(:,:), intent(in) :: dusrfdns + real(dp),dimension(:,:), intent(out) :: diffu + + + where (stagthck /= 0.0d0) + diffu = velowk%dintflwa * stagthck**p4 * sqrt(dusrfdew**2 + dusrfdns**2)**p2 + elsewhere + diffu = 0.0d0 + end where + + end subroutine velo_calc_diffu + + !***************************************************************************** + + subroutine velo_calc_velo(velowk, stagthck, & + dusrfdew, dusrfdns, & + flwa, diffu, & + ubas, vbas, & + uvel, vvel, & + uflx, vflx, & + velnorm) + + !> calculate 3D horizontal velocity field and 2D flux field from diffusivity + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glide_velowk), intent(inout) :: velowk + real(dp),dimension(:,:), intent(in) :: stagthck + real(dp),dimension(:,:), intent(in) :: dusrfdew + real(dp),dimension(:,:), intent(in) :: dusrfdns + real(dp),dimension(:,:,:),intent(in) :: flwa + real(dp),dimension(:,:), intent(in) :: diffu + real(dp),dimension(:,:), intent(in) :: ubas + real(dp),dimension(:,:), intent(in) :: vbas + real(dp),dimension(:,:,:),intent(out) :: uvel + real(dp),dimension(:,:,:),intent(out) :: vvel + real(dp),dimension(:,:), intent(out) :: uflx + real(dp),dimension(:,:), intent(out) :: vflx + real(dp),dimension(:,:,:), intent(out) :: velnorm + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + real(dp),dimension(size(flwa,1)) :: hrzflwa + real(dp) :: factor + real(dp),dimension(3) :: const + integer :: ew,ns,up,ewn,nsn,upn + + upn=size(flwa,1) ; ewn=size(stagthck,1) ; nsn=size(stagthck,2) + + ! Note: Here (confusingly), nsn = size(stagthck,2) = model%general%nsn-1 + ! ewn = size(stagthck,1) = model%general%ewn-1 + + do ns = 1,nsn + do ew = 1,ewn + + if (stagthck(ew,ns) /= 0.0d0) then + + vflx(ew,ns) = diffu(ew,ns) * dusrfdns(ew,ns) + vbas(ew,ns) * stagthck(ew,ns) + uflx(ew,ns) = diffu(ew,ns) * dusrfdew(ew,ns) + ubas(ew,ns) * stagthck(ew,ns) + + uvel(upn,ew,ns) = ubas(ew,ns) + vvel(upn,ew,ns) = vbas(ew,ns) + + hrzflwa = flwa(:,ew,ns) + flwa(:,ew,ns+1) + flwa(:,ew+1,ns) + flwa(:,ew+1,ns+1) + + factor = velowk%dintflwa(ew,ns)*stagthck(ew,ns) + if (factor /= 0.0d0) then + + const(2) = cflow * diffu(ew,ns) / factor + + const(3) = const(2) * dusrfdns(ew,ns) + const(2) = const(2) * dusrfdew(ew,ns) + else + const(2:3) = 0.0d0 + end if + + do up = upn-1, 1, -1 + const(1) = velowk%depth(up) * (hrzflwa(up)+hrzflwa(up+1)) + uvel(up,ew,ns) = uvel(up+1,ew,ns) + const(1) * const(2) + vvel(up,ew,ns) = vvel(up+1,ew,ns) + const(1) * const(3) + end do + + else + + uvel(:,ew,ns) = 0.0d0 + vvel(:,ew,ns) = 0.0d0 + uflx(ew,ns) = 0.0d0 + vflx(ew,ns) = 0.0d0 + + end if + end do + end do + + ! horizontal ice speed (mainly for diagnostic purposes) + + velnorm(:,:,:) = sqrt((uvel(:,:,:)**2 + vvel(:,:,:)**2)) + + end subroutine velo_calc_velo + + !***************************************************************************** + ! old velo functions come here + !***************************************************************************** + + subroutine slipvelo(model,flag1,btrc,ubas,vbas) + + !> Calculate the basal slip velocity and the value of $B$, the free parameter + !> in the basal velocity equation (though I'm not sure that $B$ is used anywhere + !> else). + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_global_type) :: model !> model instance + integer, intent(in) :: flag1 !> \texttt{flag1} sets the calculation + !> method to use for the basal velocity + !> (corresponded to \texttt{whichslip} in the + !> old model. + real(dp),dimension(:,:),intent(in) :: btrc !> The basal slip coefficient. + real(dp),dimension(:,:),intent(out) :: ubas !> The $x$ basal velocity (scaled) + real(dp),dimension(:,:),intent(out) :: vbas !> The $y$ basal velocity (scaled) + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp), parameter :: rhograv = - rhoi * grav + integer :: nsn,ewn + + ! Get array sizes ------------------------------------------------------------------- + + ewn=size(btrc,1) ; nsn=size(btrc,2) + + !------------------------------------------------------------------------------------ + ! Main calculation starts here + !------------------------------------------------------------------------------------ + + select case(flag1) + case(0) + + ! Linear function of gravitational driving stress --------------------------------- + + where (model%numerics%thklim < model%geomderv%stagthck) + ubas = btrc * rhograv * model%geomderv%stagthck * model%geomderv%dusrfdew + vbas = btrc * rhograv * model%geomderv%stagthck * model%geomderv%dusrfdns + elsewhere + ubas = 0.0d0 + vbas = 0.0d0 + end where + + case(1) + + ! *tp* option to be used in picard iteration for thck + ! *tp* start by find constants which dont vary in iteration + + model%velowk%fslip = rhograv * btrc + + case(2) + + ! *tp* option to be used in picard iteration for thck + ! *tp* called once per non-linear iteration, set uvel to ub * H /(ds/dx) which is + ! *tp* a diffusivity for the slip term (note same in x and y) + + where (model%numerics%thklim < model%geomderv%stagthck) + ubas = model%velowk%fslip * model%geomderv%stagthck**2 + elsewhere + ubas = 0.0d0 + end where + + case(3) + + ! *tp* option to be used in picard iteration for thck + ! *tp* finally calc ub and vb from diffusivities + + where (model%numerics%thklim < model%geomderv%stagthck) + vbas = ubas * model%geomderv%dusrfdns / model%geomderv%stagthck + ubas = ubas * model%geomderv%dusrfdew / model%geomderv%stagthck + elsewhere + ubas = 0.0d0 + vbas = 0.0d0 + end where + + case default + ubas = 0.0d0 + vbas = 0.0d0 + end select + + end subroutine slipvelo + +!------------------------------------------------------------------------------------------ + + subroutine zerovelo(velowk,sigma,flag,stagthck,dusrfdew,dusrfdns,flwa,ubas,vbas,uvel,vvel,uflx,vflx,diffu) + + !> Performs the velocity calculation. This subroutine is called with + !> different values of \texttt{flag}, depending on exactly what we want to calculate. + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_velowk), intent(inout) :: velowk + real(dp),dimension(:), intent(in) :: sigma + integer, intent(in) :: flag + real(dp),dimension(:,:), intent(in) :: stagthck + real(dp),dimension(:,:), intent(in) :: dusrfdew + real(dp),dimension(:,:), intent(in) :: dusrfdns + real(dp),dimension(:,:,:),intent(in) :: flwa + real(dp),dimension(:,:), intent(in) :: ubas + real(dp),dimension(:,:), intent(in) :: vbas + real(dp),dimension(:,:,:),intent(out) :: uvel + real(dp),dimension(:,:,:),intent(out) :: vvel + real(dp),dimension(:,:), intent(out) :: uflx + real(dp),dimension(:,:), intent(out) :: vflx + real(dp),dimension(:,:), intent(out) :: diffu + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + + real(dp),dimension(size(sigma)) :: hrzflwa, intflwa + real(dp),dimension(3) :: const + + integer :: ew,ns,up,ewn,nsn,upn + + !------------------------------------------------------------------------------------ + + upn=size(sigma) ; ewn=size(ubas,1) ; nsn=size(ubas,2) + + + !------------------------------------------------------------------------------------ + + select case(flag) + case(0) + + do ns = 1,nsn + do ew = 1,ewn + + if (stagthck(ew,ns) /= 0.0d0) then + + ! Set velocity to zero at base of column + + uvel(upn,ew,ns) = 0.0d0 + vvel(upn,ew,ns) = 0.0d0 + + ! Get column profile of Glen's A + + hrzflwa = flwa(:,ew,ns) + flwa(:,ew,ns+1) + flwa(:,ew+1,ns) + flwa(:,ew+1,ns+1) + + ! Calculate coefficient for integration + + const(1) = cflow * stagthck(ew,ns)**p1 * sqrt(dusrfdew(ew,ns)**2 + dusrfdns(ew,ns)**2)**p2 + + ! Do first step of finding u according to (8) in Payne and Dongelmans + + do up = upn-1, 1, -1 + uvel(up,ew,ns) = uvel(up+1,ew,ns) + const(1) * velowk%depth(up) * sum(hrzflwa(up:up+1)) + end do + + ! Calculate u diffusivity (?) + + diffu(ew,ns) = vertintg(velowk,uvel(:,ew,ns)) * stagthck(ew,ns) + + ! Complete calculation of u and v + + vvel(:,ew,ns) = uvel(:,ew,ns) * dusrfdns(ew,ns) + vbas(ew,ns) + uvel(:,ew,ns) = uvel(:,ew,ns) * dusrfdew(ew,ns) + ubas(ew,ns) + + ! Calculate ice fluxes + + uflx(ew,ns) = diffu(ew,ns) * dusrfdew(ew,ns) + ubas(ew,ns) * stagthck(ew,ns) + vflx(ew,ns) = diffu(ew,ns) * dusrfdns(ew,ns) + vbas(ew,ns) * stagthck(ew,ns) + + else + + ! Where there is no ice, set everything to zero. + + uvel(:,ew,ns) = 0.0d0 + vvel(:,ew,ns) = 0.0d0 + uflx(ew,ns) = 0.0d0 + vflx(ew,ns) = 0.0d0 + diffu(ew,ns) = 0.0d0 + + end if + + end do + end do + + case(1) + + do ns = 1,nsn + do ew = 1,ewn + if (stagthck(ew,ns) /= 0.0d0) then + + hrzflwa = flwa(:,ew,ns) + flwa(:,ew,ns+1) + flwa(:,ew+1,ns) + flwa(:,ew+1,ns+1) + intflwa(upn) = 0.0d0 + + do up = upn-1, 1, -1 + intflwa(up) = intflwa(up+1) + velowk%depth(up) * sum(hrzflwa(up:up+1)) + end do + + velowk%dintflwa(ew,ns) = cflow * vertintg(velowk,intflwa) + + else + + velowk%dintflwa(ew,ns) = 0.0d0 + + end if + end do + end do + + case(2) + + where (stagthck /= 0.0d0) + diffu = velowk%dintflwa * stagthck**p4 * sqrt(dusrfdew**2 + dusrfdns**2)**p2 + elsewhere + diffu = 0.0d0 + end where + + case(3) + + do ns = 1,nsn + do ew = 1,ewn + if (stagthck(ew,ns) /= 0.0d0) then + + vflx(ew,ns) = diffu(ew,ns) * dusrfdns(ew,ns) + vbas(ew,ns) * stagthck(ew,ns) + uflx(ew,ns) = diffu(ew,ns) * dusrfdew(ew,ns) + ubas(ew,ns) * stagthck(ew,ns) + + uvel(upn,ew,ns) = ubas(ew,ns) + vvel(upn,ew,ns) = vbas(ew,ns) + + hrzflwa = flwa(:,ew,ns) + flwa(:,ew,ns+1) + flwa(:,ew+1,ns) + flwa(:,ew+1,ns+1) + + if (velowk%dintflwa(ew,ns) /= 0.0d0) then + + const(2) = cflow * diffu(ew,ns) / velowk%dintflwa(ew,ns)/stagthck(ew,ns) + + const(3) = const(2) * dusrfdns(ew,ns) + const(2) = const(2) * dusrfdew(ew,ns) + else + const(2:3) = 0.0d0 + end if + + do up = upn-1, 1, -1 + const(1) = velowk%depth(up) * sum(hrzflwa(up:up+1)) + uvel(up,ew,ns) = uvel(up+1,ew,ns) + const(1) * const(2) + vvel(up,ew,ns) = vvel(up+1,ew,ns) + const(1) * const(3) + end do + + else + + uvel(:,ew,ns) = 0.0d0 + vvel(:,ew,ns) = 0.0d0 + uflx(ew,ns) = 0.0d0 + vflx(ew,ns) = 0.0d0 + + end if + end do + end do + + end select + + end subroutine zerovelo + +!------------------------------------------------------------------------------------------ + + subroutine glide_velo_vertical(model) + + type(glide_global_type), intent(inout) :: model ! model instance + + ! Compute the ice vertical velocity + + ! This is a new subroutine created by combining calls to several existing subroutines. + + ! Note: It is now called at the end of glide_tstep_p3, so that exact restart is easier. + ! In older versions of Glimmer the vertical velocity was computed at the start of + ! the temperature calculation in glide_tstep_p1. + + ! Calculate time-derivatives of thickness and upper surface elevation ------------ + + call timeders(model%thckwk, & + model%geometry%thck, & + model%geomderv%dthckdtm, & + model%geometry%thck_index, & + model%numerics%time, & + 1) + + call timeders(model%thckwk, & + model%geometry%usrf, & + model%geomderv%dusrfdtm, & + model%geometry%thck_index, & + model%numerics%time, & + 2) + + ! Calculate the vertical velocity of the grid ------------------------------------ + + call gridwvel(model%numerics%sigma, & + model%numerics%thklim, & + model%velocity%uvel, & + model%velocity%vvel, & + model%geomderv, & + model%geometry%thck, & + model%velocity%wgrd) + + ! Calculate the actual vertical velocity; method depends on whichwvel ------------ + + select case(model%options%whichwvel) + + case(VERTINT_STANDARD) ! Usual vertical integration + + call wvelintg(model%velocity%uvel, & + model%velocity%vvel, & + model%geomderv, & + model%numerics, & + model%velowk, & + model%velocity%wgrd(model%general%upn,:,:), & + model%geometry%thck, & + model%temper%bmlt, & + model%velocity%wvel) + + case(VERTINT_KINEMATIC_BC) ! Vertical integration constrained so kinematic upper BC obeyed. + + call wvelintg(model%velocity%uvel, & + model%velocity%vvel, & + model%geomderv, & + model%numerics, & + model%velowk, & + model%velocity%wgrd(model%general%upn,:,:), & + model%geometry%thck, & + model%temper% bmlt, & + model%velocity%wvel) + + call chckwvel(model%numerics, & + model%geomderv, & + model%velocity%uvel(1,:,:), & + model%velocity%vvel(1,:,:), & + model%velocity%wvel, & + model%geometry%thck, & + model%climate% acab) + + end select + + ! apply periodic ew BC + + if (model%options%periodic_ew) then + call wvel_ew(model) + end if + + end subroutine glide_velo_vertical + +!--------------------------------------------------------------- + + subroutine timeders(thckwk,ipvr,opvr,mask,time,which) + + !> Calculates the time-derivative of a field. This subroutine is used by + !> the Glimmer temperature solver only. + + use glimmer_paramets, only : tim0 + use glimmer_physcon, only: scyr + + implicit none + + type(glide_thckwk) :: thckwk !> Derived-type containing work data + real(dp), intent(out), dimension(:,:) :: opvr !> output (time derivative) field + real(dp), intent(in), dimension(:,:) :: ipvr !> input field + real(dp), intent(in) :: time !> current time + integer, intent(in), dimension(:,:) :: mask !> mask for calculation + integer, intent(in) :: which !> selector for stored field + + real(dp) :: factor + + factor = (time - thckwk%oldtime) + if (factor == 0.d0) then + opvr = 0.0d0 + else + factor = 1.d0/factor + where (mask /= 0) + opvr = (tim0/scyr) * (ipvr - thckwk%olds(:,:,which)) * factor + elsewhere + opvr = 0.0d0 + end where + end if + + thckwk%olds(:,:,which) = ipvr + + if (which == thckwk%nwhich) then + thckwk%oldtime = time + end if + + end subroutine timeders + +!------------------------------------------------------------------------------------------ + + subroutine gridwvel(sigma,thklim,uvel,vvel,geomderv,thck,wgrd) + + !> Calculates the vertical velocity of the grid, and returns it in \texttt{wgrd}. This + !> is necessary because the model uses a sigma coordinate system. + !> The equation for grid velocity is: + !> \[ + !> \mathtt{wgrd}(x,y,\sigma)=\frac{\partial s}{\partial t}+\mathbf{U}\cdot\nabla s + !> -\sigma\left(\frac{\partial H}{\partial t}+\mathbf{U}\cdot\nabla H\right) + !> \] + !> Compare this with equation A1 in {\em Payne and Dongelmans}. + + !TODO Change the name of subroutine gridwvel? It computes wgrd but not wvel. + +!! use parallel + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + real(dp),dimension(:), intent(in) :: sigma !> Array holding values of sigma + !> at each vertical level + real(dp), intent(in) :: thklim !> Minimum thickness to be considered + !> when calculating the grid velocity. + !> This is in m, divided by \texttt{thk0}. + real(dp),dimension(:,:,:),intent(in) :: uvel !> The $x$-velocity field (scaled). Velocity + !> is on the staggered grid + real(dp),dimension(:,:,:),intent(in) :: vvel !> The $y$-velocity field (scaled). Velocity + !> is on the staggered grid + type(glide_geomderv), intent(in) :: geomderv !> Derived type holding temporal + !> and horizontal derivatives of + !> ice-sheet thickness and upper + !> surface elevation + real(dp),dimension(:,:), intent(in) :: thck !> Ice-sheet thickness (divided by + !> \texttt{thk0}) + real(dp),dimension(:,:,:),intent(out) :: wgrd !> The grid velocity at each point. This + !> is the output. + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + integer :: ns,ew,nsn,ewn + + !------------------------------------------------------------------------------------ + + ewn=size(wgrd,2) ; nsn=size(wgrd,3) + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > thklim) then + wgrd(:,ew,ns) = geomderv%dusrfdtm(ew,ns) - sigma * geomderv%dthckdtm(ew,ns) + & + ((uvel(:,ew-1,ns-1) + uvel(:,ew-1,ns) + uvel(:,ew,ns-1) + uvel(:,ew,ns)) * & + (sum(geomderv%dusrfdew(ew-1:ew,ns-1:ns)) - sigma * & + sum(geomderv%dthckdew(ew-1:ew,ns-1:ns))) + & + (vvel(:,ew-1,ns-1) + vvel(:,ew-1,ns) + vvel(:,ew,ns-1) + vvel(:,ew,ns)) * & + (sum(geomderv%dusrfdns(ew-1:ew,ns-1:ns)) - sigma * & + sum(geomderv%dthckdns(ew-1:ew,ns-1:ns)))) / 16.0d0 + else + wgrd(:,ew,ns) = 0.0d0 + end if + end do + end do + + !WHL - Removed halo call. wgrd is needed only for the old temperature code, which is not supported in parallel. +!! call parallel_halo(wgrd) + + end subroutine gridwvel + +!------------------------------------------------------------------------------------------ + + subroutine wvelintg(uvel,vvel,geomderv,numerics,velowk,wgrd,thck,bmlt,wvel) + + !> Calculates the vertical velocity field, which is returned in \texttt{wvel}. + !> This is found by doing this integration: + !> \[ + !> w(\sigma)=-\int_{1}^{\sigma}\left[\frac{\partial \mathbf{U}}{\partial \sigma} + !> (\sigma) \cdot (\nabla s - \sigma \nabla H) +H\nabla \cdot \mathbf{U}(\sigma)\right]d\sigma + !> + w(1) + !> \] + !> (This is equation 13 in {\em Payne and Dongelmans}.) Note that this is only + !> done if the thickness is greater than the threshold given by \texttt{numerics\%thklim}. + +!! use parallel + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + real(dp),dimension(:,:,:), intent(in) :: uvel !> The $x$-velocity on the + !> staggered grid (scaled) + real(dp),dimension(:,:,:), intent(in) :: vvel !> The $y$-velocity on the + !> staggered grid (scaled) + real(dp),dimension(:,:), intent(in) :: thck !> The ice thickness, divided + !> by \texttt{thk0} + type(glide_geomderv), intent(in) :: geomderv !> Derived type holding the + !> horizontal and temporal derivatives + !> of the thickness and upper surface + !> elevation. + type(glide_numerics), intent(in) :: numerics !> Derived type holding numerical + !> parameters, including sigma values. + type(glide_velowk), intent(inout) :: velowk !> Derived type holding working arrays + !> used by the subroutine + real(dp),dimension(:,:), intent(in) :: wgrd !> The grid vertical velocity at + !> the lowest model level. + real(dp),dimension(:,:), intent(in) :: bmlt !> Basal melt-rate (scaled?) This + !> is required in the basal boundary + !> condition. See {\em Payne and Dongelmans} + !> equation 14. + real(dp),dimension(:,:,:), intent(out) :: wvel !> The vertical velocity field. + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp) :: dew16, dns16 ! The grid-spacings multiplied by 16 + real(dp),dimension(6) :: cons ! Holds temporary local values of derivatives + integer :: ns,ew,up ! Loop indicies + integer :: nsn,ewn,upn ! Domain sizes + + !------------------------------------------------------------------------------------ + ! Get some values for the domain size by checking sizes of input arrays + !------------------------------------------------------------------------------------ + + upn=size(uvel,1) ; ewn=size(uvel,2) ; nsn=size(uvel,3) + + + ! Multiply grid-spacings by 16 ----------------------------------------------------- + + dew16 = 1.d0/(16.0d0 * numerics%dew) + dns16 = 1.d0/(16.0d0 * numerics%dns) + + ! ---------------------------------------------------------------------------------- + ! Main loop over each grid-box + ! ---------------------------------------------------------------------------------- + + do ns = 2,nsn + do ew = 2,ewn + if (thck(ew,ns) > numerics%thklim) then + + ! Set the bottom boundary condition ------------------------------------------ + + wvel(upn,ew,ns) = wgrd(ew,ns) - bmlt(ew,ns) + + ! Calculate temporary local values of thickness and surface ------------------ + ! elevation derivatives. + + cons(1) = sum(geomderv%dusrfdew(ew-1:ew,ns-1:ns)) / 16.0d0 + cons(2) = sum(geomderv%dthckdew(ew-1:ew,ns-1:ns)) / 16.0d0 + cons(3) = sum(geomderv%dusrfdns(ew-1:ew,ns-1:ns)) / 16.0d0 + cons(4) = sum(geomderv%dthckdns(ew-1:ew,ns-1:ns)) / 16.0d0 + cons(5) = sum(geomderv%stagthck(ew-1:ew,ns-1:ns)) + cons(6) = cons(5)*dns16 + cons(5) = cons(5)*dew16 + ! * better? (an alternative from TP's original code) + !cons(5) = (thck(ew-1,ns)+2.0d0*thck(ew,ns)+thck(ew+1,ns)) * dew16 + !cons(6) = (thck(ew,ns-1)+2.0d0*thck(ew,ns)+thck(ew,ns+1)) * dns16 + + velowk%suvel(:) = uvel(:,ew-1,ns-1) + uvel(:,ew-1,ns) + uvel(:,ew,ns-1) + uvel(:,ew,ns) + velowk%svvel(:) = vvel(:,ew-1,ns-1) + vvel(:,ew-1,ns) + vvel(:,ew,ns-1) + vvel(:,ew,ns) + + ! Loop over each model level, starting from the bottom ---------------------- + + do up = upn-1, 1, -1 + wvel(up,ew,ns) = wvel(up+1,ew,ns) & + - velowk%dupsw(up) * cons(5) * (sum(uvel(up:up+1,ew,ns-1:ns)) - sum(uvel(up:up+1,ew-1,ns-1:ns))) & + - velowk%dupsw(up) * cons(6) * (sum(vvel(up:up+1,ew-1:ew,ns)) - sum(vvel(up:up+1,ew-1:ew,ns-1))) & + - (velowk%suvel(up+1) - velowk%suvel(up)) * (cons(1) - velowk%depthw(up) * cons(2)) & + - (velowk%svvel(up+1) - velowk%svvel(up)) * (cons(3) - velowk%depthw(up) * cons(4)) + end do + else + + ! If there isn't enough ice, set velocities to zero ---------------------------- + + wvel(:,ew,ns) = 0.0d0 + + end if + end do + end do + + !WHL - Removed halo call, since wvel is needed only for the old temperature code, which is not supported in parallel. +!! call parallel_halo(wvel) + + end subroutine wvelintg + + subroutine wvel_ew(model) + + !> set periodic EW boundary conditions + implicit none + type(glide_global_type),intent(inout) :: model !> Ice model parameters. + + model%velocity%wgrd(:,1,:) = model%velocity%wgrd(:,model%general%ewn-1,:) + model%velocity%wgrd(:,model%general%ewn,:) = model%velocity%wgrd(:,2,:) + model%velocity%wvel(:,1,:) = model%velocity%wvel(:,model%general%ewn-1,:) + model%velocity%wvel(:,model%general%ewn,:) = model%velocity%wvel(:,2,:) + + end subroutine wvel_ew + +!------------------------------------------------------------------------------------------ + + subroutine chckwvel(numerics,geomderv,uvel,vvel,wvel,thck,acab) + + !> Constrain the vertical velocity field to obey a kinematic upper boundary + !> condition. + +!! use parallel + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_numerics), intent(in) :: numerics !> Numerical parameters of model + type(glide_geomderv), intent(in) :: geomderv !> Temporal and horizontal derivatives + !> of thickness and upper ice surface + !> elevation. + real(dp),dimension(:,:), intent(in) :: uvel !> $x$ velocity field at top model + !> level (scaled, on staggered grid). + real(dp),dimension(:,:), intent(in) :: vvel !> $y$ velocity field at top model + !> level (scaled, on staggered grid). + real(dp),dimension(:,:,:),intent(inout) :: wvel !> Vertical velocity field, + real(dp),dimension(:,:), intent(in) :: thck !> Ice thickness (scaled) + real(dp),dimension(:,:), intent(in) :: acab !> Mass-balance (scaled) + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp) :: wchk + real(dp) :: tempcoef + integer :: ns,ew,nsn,ewn + + ! Get array sizes ------------------------------------------------------------------- + + ewn=size(thck,1) ; nsn=size(thck,2) + + ! Allocate temporary work array ----------------------------------------------------- + + + ! Loop over all grid-boxes ---------------------------------------------------------- + + do ns = 2,nsn-1 + do ew = 2,ewn-1 + if (thck(ew,ns) > numerics%thklim .and. wvel(1,ew,ns) /= 0) then + + wchk = geomderv%dusrfdtm(ew,ns) & + - acab(ew,ns) & + + (sum(uvel(ew-1:ew,ns-1:ns)) * sum(geomderv%dusrfdew(ew-1:ew,ns-1:ns)) & + + sum(vvel(ew-1:ew,ns-1:ns)) * sum(geomderv%dusrfdns(ew-1:ew,ns-1:ns))) & + / 16.0d0 + + + tempcoef = wchk - wvel(1,ew,ns) + + wvel(:,ew,ns) = wvel(:,ew,ns) + tempcoef * (1.0d0 - numerics%sigma) + end if + end do + end do + + !WHL - Removed halo call, since wvel is needed only for the old temperature code, which is not supported in parallel. +!! call parallel_halo(wvel) + + end subroutine chckwvel + +!------------------------------------------------------------------------------------------ +! PRIVATE subroutines +!------------------------------------------------------------------------------------------ + +!TODO - Remove function vertintg? Not currently used (glam_strs2 has its own version). + + function vertintg(velowk,in) + + !> Performs a depth integral using the trapezium rule. + !*RV The value of in integrated over depth. + + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_velowk), intent(inout) :: velowk !> Work arrays and things for this module + real(dp),dimension(:),intent(in) :: in !> Input array of vertical velocities (size = upn) + real(dp) :: vertintg + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + integer :: up, upn + + ! Set up array of sigma intervals, if not done already ------------------------------ + + upn=size(in) + + ! Do integration -------------------------------------------------------------------- + + vertintg = 0.0d0 + + do up = upn-1, 1, -1 + vertintg = vertintg + (in(up)+in(up+1)) * velowk%dups(up) + end do + + vertintg = 0.5d0*vertintg + + end function vertintg + +!------------------------------------------------------------------------------------------ + + subroutine calc_btrc(model,flag,btrc) + + !> Calculate the value of $B$ used for basal sliding calculations. + + use glimmer_physcon, only : rhoo, rhoi + use glimmer_paramets, only : len0, thk0, scyr, vel0 + implicit none + + type(glide_global_type) :: model !> model instance + integer, intent(in) :: flag !> Flag to select method of + real(dp),dimension(:,:),intent(out) :: btrc !> Array of values of $B$. + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp) :: stagbwat, stagbmlt + integer :: ew,ns,nsn,ewn + real(dp) :: Asl = 1.8d-10 !in units N^-3 yr^-1 m^8 for case(5) + real(dp) :: Z !accounts for reduced basal traction due to pressure of + !subglacial water for case(5) + real(dp) :: tau !basal shear stress + + !scaling + real(dp) :: tau_factor = 1.d-3*thk0*thk0/len0 + !real(dp) :: tau_factor = 1.0d0 + !------------------------------------------------------------------------------------ + + ewn=model%general%ewn + nsn=model%general%nsn + + !------------------------------------------------------------------------------------ + + select case(flag) + + case(BTRC_CONSTANT) + ! constant everywhere + ! This option is used for EISMINT-2 experiment G + btrc = model%velocity%bed_softness + + case(BTRC_CONSTANT_BWAT) + ! constant where basal melt water is present, else = 0 + ! This option can be used for EISMINT-2 experiment H, provided that + ! basal water is present where T = Tpmp (e.g., BWATER_LOCAL) + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (0.0d0 < model%temper%stagbwat(ew,ns)) then + btrc(ew,ns) = model%velocity%bed_softness(ew,ns) + else + btrc(ew,ns) = 0.0d0 + end if + end do + end do + + case(BTRC_CONSTANT_TPMP) + ! constant where basal temperature equal to pressure melting point, else = 0 + ! This is the actual condition for EISMINT-2 experiment H, which may not be + ! the same as case BTRC_CONSTANT_BWAT above, depending on the hydrology + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (abs(model%temper%stagbpmp(ew,ns) - model%temper%stagbtemp(ew,ns))<0.001) then + btrc(ew,ns) = model%velocity%bed_softness(ew,ns) + else + btrc(ew,ns) = 0.0d0 + end if + end do + end do + + case(BTRC_LINEAR_BMLT) + ! linear function of basal melt rate + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + stagbmlt = 0.25d0*sum(model%temper%bmlt(ew:ew+1,ns:ns+1)) + + if (stagbmlt > 0.0d0) then + btrc(ew,ns) = min(model%velowk%btrac_max, & + model%velocity%bed_softness(ew,ns) + model%velowk%btrac_slope*stagbmlt) + else + btrc(ew,ns) = 0.0d0 + end if + end do + end do + + case(BTRC_TANH_BWAT) + ! tanh function of basal water depth + ! The 'velowk%c' parameters are derived above from the 5-part parameter bpar + + do ns = 1,nsn-1 + do ew = 1,ewn-1 + if (0.0d0 < model%temper%stagbwat(ew,ns)) then + + btrc(ew,ns) = model%velowk%c(1) + model%velowk%c(2) * tanh(model%velowk%c(3) * & + model%temper%stagbwat(ew,ns) - model%velowk%c(4)) + + if (0.0d0 > sum(model%isostasy%relx(ew:ew+1,ns:ns+1))) then + btrc(ew,ns) = btrc(ew,ns) * model%velowk%marine + end if + else + btrc(ew,ns) = 0.0d0 + end if + end do + end do + +!WHL - I'm not aware of anyone using this parameterization. Commented out for now. +!! case(6) +!! ! increases with the third power of the basal shear stress, from Huybrechts + +!! Asl = model%climate%slidconst +!! do ns = 1, nsn-1 +!! do ew = 1, ewn-1 +!NOTE - Scaling looks wrong here: stagthck and thklim should have the same scaling. +!! if ((model%geomderv%stagthck(ew,ns)*thk0) > model%numerics%thklim) then +!! if((model%geomderv%stagtopg(ew,ns)*thk0) > (model%climate%eus*thk0)) then +!! Z = model%geomderv%stagthck(ew,ns)*thk0 +!! else +!! Z = model%geomderv%stagthck(ew,ns)*thk0 + rhoi*((model%geomderv%stagtopg(ew,ns) *thk0 & +!! - model%climate%eus*thk0)/ rhoo) +!! end if + +!! if(Z <= model%numerics%thklim) then !avoid division by zero +!! Z = model%numerics%thklim +!! end if + +!! tau = ((tau_factor*model%stress%tau_x(ew,ns))**2 +& +!! (model%stress%tau_y(ew,ns)*tau_factor)**2)**(0.5d0) + +!! btrc(ew,ns) = (Asl*(tau)**2)/Z !assuming that that btrc is later +!! !multiplied again by the basal shear stress + +!! end if +!! end do +!! end do + + case default ! includes BTRC_ZERO + ! zero everywhere + ! This is used for EISMINT-2 experiments A to F + btrc = 0.0d0 + + end select + + end subroutine calc_btrc + +!TODO - Remove one of the two versions of calc_basal_shear? + +#ifdef JEFFORIG + subroutine calc_basal_shear(model) + !> calculate basal shear stress: tau_{x,y} = -rho_i*g*H*d(H+h)/d{x,y} + use glimmer_physcon, only : rhoi,grav + implicit none + type(glide_global_type) :: model !> model instance + + + model%velocity%tau_x = -rhoi*grav*model%geomderv%stagthck + model%velocity%tau_y = model%velocity%tau_x * model%geomderv%dusrfdns + model%velocity%tau_x = model%velocity%tau_x * model%geomderv%dusrfdew + end subroutine calc_basal_shear +#endif + + subroutine calc_basal_shear(stagthck, dusrfdew, dusrfdns, tau_x, tau_y) + + ! calculate basal shear stress: tau_{x,y} = -rho_i*g*H*d(H+h)/d{x,y} + use glimmer_physcon, only : rhoi,grav + + implicit none + real(dp),dimension(:,:),intent(in) :: stagthck !> Ice thickness (scaled) + real(dp),dimension(:,:),intent(in) :: dusrfdew, dusrfdns + real(dp),dimension(:,:),intent(out) :: tau_x + real(dp),dimension(:,:),intent(out) :: tau_y + + tau_x(:,:) = -rhoi*grav*stagthck(:,:) + tau_y(:,:) = tau_x * dusrfdns(:,:) + tau_x(:,:) = tau_x * dusrfdew(:,:) + + !JEFF Are these replaced by the three lines above? They are not compiling. 7/28/11 + ! model%stress%tau_x = -rhoi*grav*model%geomderv%stagthck + ! model%stress%tau_y = model%stress%tau_x * model%geomderv%dusrfdns + ! model%stress%tau_x = model%stress%tau_x * model%geomderv%dusrfdew + + end subroutine calc_basal_shear + +!------------------------------------------------------------------- + +end module glide_velo + +!------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/glide_vertint.F90 b/components/cism/glimmer-cism/libglide/glide_vertint.F90 new file mode 100644 index 0000000000..8e413f779e --- /dev/null +++ b/components/cism/glimmer-cism/libglide/glide_vertint.F90 @@ -0,0 +1,164 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glide_vertint.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Remove module glide_vertint? Not currently used. + +module glide_vertint + + !> This module contains routines to vertically integrate fields + !> All 3d fields are assumed to use the (z,x,y) coordinate system, + !> where the top is the minimum z and the bottom is the maximum z. + + use glimmer_global , only: dp + implicit none + +contains + + !> Performs vertical integration, places the result on a 3d field + !> where each level in the 3d field is the integral of all levels + !> above it + + subroutine vertint_output3d(infield, outfield, levels, topdown, initial_value) + real(dp), dimension(:,:,:), intent(in) :: infield + real(dp), dimension(:,:,:), intent(out) :: outfield + real(dp), dimension(:), intent(in) :: levels + logical :: topdown !> Controls the direction of integration. If true, + !> outfield(1,:,:) contains zeros and each level + !> below it accumulates another part of the + !> integral. If false, outfield(upn,:,:) contains + !> zeros and each level above it accumulates + !> another part of the integral + real(dp), dimension(:,:), intent(in), optional :: initial_value + + integer :: upn + integer :: i + integer :: lower, upper, step !Loop control, parameterized based on + !value of topdown + + real(dp) :: deltax + + upn = size(levels) + if (topdown) then + lower = 2 + upper = upn + step = 1 + else + lower = upn-1 + upper = 1 + step = -1 + end if + + if (present(initial_value)) then + outfield(lower - step,:,:) = initial_value + else + outfield(lower - step,:,:) = 0 + end if + + + do i = lower, upper, step + deltax = step*(levels(i) - levels(i - step)) + !Apply trapezoid rule + outfield(i,:,:) = outfield(i - step,:,:) + .5 * deltax*(infield(i - step,:,:) + infield(i,:,:)) + end do + end subroutine vertint_output3d + + subroutine vertint_output2d(infield, outfield, levels, initial_value) + !> Vertically integrates the 3D field and places the result of the + !> integral on a 2D field + real(dp), dimension(:,:,:), intent(in) :: infield + real(dp), dimension(:,:), intent(out) :: outfield + real(dp), dimension(:), intent(in) :: levels + + real(dp), dimension(:,:), intent(in), optional :: initial_value + + integer :: upn + integer :: i + real(dp) :: deltax + + upn = size(levels) + + if (present(initial_value)) then + outfield = initial_value + else + outfield = 0 + end if + + do i = 2, upn + deltax = levels(i) - levels(i - 1) + outfield = outfield + .5 * deltax*(infield(i-1,:,:) + infield(i,:,:)) + end do + end subroutine + + + !Contained unit test cases + !Based around evaluation of the integral of x^2dx from 0 to 1. + subroutine test_vertint() + real(dp), dimension(11) :: levels + real(dp), dimension(11,1,1) :: values + real(dp), dimension(1,1) :: answer + real(dp), dimension(1,1) :: ival + + integer :: i + real(dp) :: val + + + !Test case where we have evenly spaced levels + val = 0 + do i = 1,11 + levels(i) = val + values(i,1,1) = val ** 2 + val = val + .1 + write(*,*) levels(i),values(i,1,1) + end do + + ival = 0 + + call vertint_output2d(values, answer, levels, ival) + write(*,*) answer(1,1) + + !Test case where we do not have evenly spaced levels + levels(1) = 0 + levels(2) = .2 + levels(3) = .4 + levels(4) = .5 + levels(5) = .6 + levels(6) = .7 + levels(7) = .8 + levels(8) = .85 + levels(9) = .9 + levels(10) = .95 + levels(11) = 1 + do i = 1,11 + values(i,1,1) = levels(i) ** 2 + write(*,*) levels(i),values(i,1,1) + end do + ival = 0 + + call vertint_output2d(values, answer, levels, ival) + write(*,*) answer(1,1) + + end subroutine +end module glide_vertint diff --git a/components/cism/glimmer-cism/libglide/isostasy.F90 b/components/cism/glimmer-cism/libglide/isostasy.F90 new file mode 100644 index 0000000000..f75dc6fb05 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/isostasy.F90 @@ -0,0 +1,213 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! isostasy.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module isostasy + + !TODO - Test the isostasy for parallel simulations. + ! Elastic lithosphere will not easily parallelize, but local lithosphere should be OK. + + !> calculate isostatic adjustment due to changing surface loads + + use glimmer_global, only : dp + use isostasy_elastic + + implicit none + + private :: relaxing_mantle + +!------------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------- + + subroutine init_isostasy(model) + + !> initialise isostasy calculations + use parallel + use glide_types + use glimmer_physcon, only: scyr + use glimmer_paramets, only: tim0 + implicit none + + type(glide_global_type) :: model + + if (model%isostasy%lithosphere == LITHOSPHERE_ELASTIC) then + call not_parallel(__FILE__,__LINE__) + call init_elastic(model%isostasy%rbel,model%numerics%dew) + end if + + model%isostasy%next_calc = model%numerics%tstart + model%isostasy%relaxed_tau = model%isostasy%relaxed_tau * scyr / tim0 + + end subroutine init_isostasy + +!------------------------------------------------------------------------- + + subroutine isos_icewaterload(model) + + !> calculate surface load factors due to water and ice distribution + + use glimmer_physcon + use glide_types + implicit none + + type(glide_global_type) :: model + + real(dp) :: ice_mass, water_depth, water_mass + integer :: ew,ns + + do ns=1,model%general%nsn + do ew=1,model%general%ewn + ice_mass = rhoi * model%geometry%thck(ew,ns) + + if (model%geometry%topg(ew,ns) - model%climate%eus < 0.d0) then ! check if we are below sea level + + water_depth = model%climate%eus - model%geometry%topg(ew,ns) + water_mass = rhoo * water_depth + + ! Just the water load due to changes in sea-level + model%isostasy%load_factors(ew,ns) = rhoo* model%climate%eus/rhom + + ! Check if ice is not floating + if ( ice_mass > water_mass ) then + model%isostasy%load_factors(ew,ns) = model%isostasy%load_factors(ew,ns) + (ice_mass - water_mass)/rhom + end if + + else ! bedrock is above sea level + + model%isostasy%load_factors(ew,ns) = ice_mass/rhom + + end if + + end do + end do + + end subroutine isos_icewaterload + +!------------------------------------------------------------------------- + + subroutine isos_compute(model) + + !> calculate isostatic adjustment due to changing surface loads + + use glide_types + implicit none + + type(glide_global_type) :: model + + ! update load if necessary + if (model%isostasy%new_load) then + call isos_lithosphere(model, model%isostasy%load, model%isostasy%load_factors) + ! update bedrock with (non-viscous) fluid mantle + if (model%isostasy%asthenosphere == ASTHENOSPHERE_FLUID) then + model%geometry%topg = model%isostasy%relx - model%isostasy%load + end if + model%isostasy%new_load = .false. + end if + + ! update bedrock with relaxing mantle + if (model%isostasy%asthenosphere == ASTHENOSPHERE_RELAXING) then + call relaxing_mantle(model) + end if + + end subroutine isos_compute + +!------------------------------------------------------------------------- + + subroutine isos_lithosphere(model,load,load_factors) + + use glide_types + implicit none + type(glide_global_type) :: model + real(dp), dimension(:,:), intent(out) :: load !> loading effect due to load_factors + real(dp), dimension(:,:), intent(in) :: load_factors !> load mass divided by mantle density + + if (model%isostasy%lithosphere == LITHOSPHERE_LOCAL) then + load = load_factors + else if (model%isostasy%lithosphere == LITHOSPHERE_ELASTIC) then + call calc_elastic(model%isostasy%rbel, load, load_factors) + end if + + end subroutine isos_lithosphere + +!------------------------------------------------------------------------- + + subroutine isos_relaxed(model) + + !> Calculate the relaxed topography, assuming the isostatic depression + !> is the equilibrium state for the current topography. + + use glide_types + implicit none + type(glide_global_type) :: model + + ! Calculate the load + call isos_icewaterload(model) + + ! Apply lithosphere model + call isos_lithosphere(model, model%isostasy%load, model%isostasy%load_factors) + + ! Add to present topography to get relaxed topography + model%isostasy%relx = model%geometry%topg + model%isostasy%load + + end subroutine isos_relaxed + +!------------------------------------------------------------------------- +! private subroutines +!------------------------------------------------------------------------- + + subroutine relaxing_mantle(model) + + !> approximate mantle with a relaxing half-space: dh/dt=-1/tau*(w-h) + use glide_types + implicit none + type(glide_global_type) :: model + + integer :: ew,ns + real(dp) :: ft1, ft2 + + ft1 = exp(-model%numerics%dt/model%isostasy%relaxed_tau) + ft2 = 1.d0 - ft1 + + do ns=1,model%general%nsn + do ew=1,model%general%ewn + model%geometry%topg(ew,ns) = ft2 * (model%isostasy%relx(ew,ns) - model%isostasy%load(ew,ns)) & + + ft1 * model%geometry%topg(ew,ns) + end do + end do + + end subroutine relaxing_mantle + +!------------------------------------------------------------------------- + +end module isostasy + +!------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/isostasy_elastic.F90 b/components/cism/glimmer-cism/libglide/isostasy_elastic.F90 new file mode 100644 index 0000000000..2d356cb761 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/isostasy_elastic.F90 @@ -0,0 +1,218 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! isostasy_elastic.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module isostasy_elastic + + !> handle elastic lithosphere + + !NOTE: This works for serial simulations only. + + use glimmer_global, only : dp + use glide_types, only: isos_elastic + + implicit none + + real(dp), private, parameter :: r_lr = 6.d0 ! influence of disk load at (0,0) is felt within a radius of rbel_r_lr*rbel_r + + private :: init_rbel, rbel_ow, rbel_iw + +!------------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------- + + subroutine init_elastic(rbel, deltax) + + !> initialise elastic lithosphere calculations + use glimmer_physcon, only : pi + implicit none + type(isos_elastic) :: rbel !> structure holding elastic litho data + real(dp), intent(in) :: deltax !> grid spacing + + ! local variables + real(dp) :: a ! radius of disk + real(dp) :: r ! distance from centre + integer :: i,j + + ! calculate a so that a circle of radius a is equivalent to a square with size deltax + a = deltax/sqrt(pi) + + ! initialise w + call init_rbel(rbel, a) + + ! calculate size of operator + rbel%wsize = int(r_lr*rbel%lr/deltax) + + ! allocate memory for operator + allocate(rbel%w(0:rbel%wsize,0:rbel%wsize)) + + ! calculating points within disk + rbel%w(0,0) = rbel_iw(rbel,0.d0) + r = deltax/rbel%lr + rbel%w(0,1) = rbel_iw(rbel,r) + rbel%w(1,0) = rbel%w(0,1) + + ! calculating points outside disk + do j=0,rbel%wsize + do i=2,rbel%wsize + r = deltax * sqrt(real(i)**2 + real(j)**2)/rbel%lr + rbel%w(i,j) = rbel_ow(rbel,r) + end do + end do + + do j=2,rbel%wsize + do i=0,1 + r = deltax * sqrt(real(i)**2 + real(j)**2)/rbel%lr + rbel%w(i,j) = rbel_ow(rbel,r) + end do + end do + + i=1 + j=1 + r = deltax * sqrt(real(i)**2 + real(j)**2)/rbel%lr + rbel%w(i,j) = rbel_ow(rbel,r) + +#ifdef DEB_REBOUND + open(1,file='w.dat',status='UNKNOWN') + do j=0,rbel%wsize + do i=0,rbel%wsize + write(1,*) i,j,rbel%w(i,j) + end do + end do + close(1) +#endif + + !rbel%w=rbel%w/len0 + + end subroutine init_elastic + +!------------------------------------------------------------------------- + + subroutine calc_elastic(rbel,load,load_factors) + + !> calculate surface loading effect using elastic lithosphere approximation + implicit none + type(isos_elastic) :: rbel !> structure holding elastic litho data + real(dp), dimension(:,:), intent(out) :: load !> loading effect due to load_factors + real(dp), dimension(:,:), intent(in) :: load_factors !> load mass divided by mantle density + + integer ewn,nsn + integer i,j,n,m + + ewn = size(load,1) + nsn = size(load,2) + + load = 0.d0 + do j=1,nsn + do i=1,ewn + do n=max(1,j-rbel%wsize),min(nsn,j+rbel%wsize) + do m=max(1,i-rbel%wsize),min(ewn,i+rbel%wsize) + load(i,j) = load(i,j) + load_factors(m,n) * rbel%w(abs(m-i),abs(n-j)) + end do + end do + end do + end do + + end subroutine calc_elastic + +!------------------------------------------------------------------------- + + subroutine finalise_elastic(rbel) + !> clean-up data structure + implicit none + type(isos_elastic) :: rbel !> structure holding elastic litho data + + deallocate(rbel%w) + end subroutine finalise_elastic + +!------------------------------------------------------------------------- + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! private subroutines + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine init_rbel(rbel, a) + + !> initialise elastic lithosphere calculations + use glimmer_paramets, only: len0 + use glimmer_physcon, only: rhom,grav + use isostasy_kelvin + implicit none + type(isos_elastic) :: rbel !> structure holding elastic litho data + real(dp), intent(in) :: a !> radius of disk + + real(dp) :: dummy_a + + call set_kelvin(1.d-10,40) + + rbel%lr = ((rbel%d/(rhom*grav))**0.25d0)/len0 + rbel%a = a + + dummy_a = rbel%a/rbel%lr + + rbel%c1 = dummy_a * dker(dummy_a) + rbel%c2 = -dummy_a * dkei(dummy_a) + rbel%cd3 = dummy_a * dber(dummy_a) + rbel%cd4 = -dummy_a * dbei(dummy_a) + + end subroutine init_rbel + +!------------------------------------------------------------------------- + + function rbel_ow(rbel,r) + use isostasy_kelvin + !> calculating deflection outside disk + implicit none + real(dp) :: rbel_ow + real(dp), intent(in) :: r !> radius, r should be scaled with lr + type(isos_elastic) :: rbel !> structure holding elastic litho data + + rbel_ow = rbel%cd3*ker(r) + rbel%cd4*kei(r) + end function rbel_ow + +!------------------------------------------------------------------------- + + function rbel_iw(rbel,r) + use isostasy_kelvin + !> calculating deflection inside disk + implicit none + real(dp) :: rbel_iw + real(dp), intent(in) :: r !> radius, r should be scaled with lr + type(isos_elastic) :: rbel !> structure holding elastic litho data + + rbel_iw = 1.d0 + rbel%c1*ber(r) + rbel%c2*bei(r) + end function rbel_iw + +!------------------------------------------------------------------------- + +end module isostasy_elastic + +!------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglide/isostasy_kelvin.F90 b/components/cism/glimmer-cism/libglide/isostasy_kelvin.F90 new file mode 100644 index 0000000000..7f7b147a92 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/isostasy_kelvin.F90 @@ -0,0 +1,414 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! isostasy_kelvin.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> module for calculating zeroth order Kelvin functions and their derivatives. +!! Both single and double precision versions are provided +!! +!! \author Magnus Hagdorn +!! \date June 2000 + +module isostasy_kelvin + + use glimmer_global, only: sp, dp + use glimmer_physcon, only: pi + implicit none + + real(kind=dp), private, parameter :: gamma=0.577215664901532860606512d0 !< Euler's constant + integer, private :: j_max = 40 !< maximum number of iterations + real(kind=dp), private :: tolerance = 1.d-10 !< the tolerance + + interface ber + module procedure d_ber, s_ber + end interface + interface bei + module procedure d_bei, s_bei + end interface + interface ker + module procedure d_ker, s_ker + end interface + interface kei + module procedure d_kei, s_kei + end interface + + interface dber + module procedure d_dber, s_dber + end interface + interface dbei + module procedure d_dbei, s_dbei + end interface + interface dker + module procedure d_dker, s_dker + end interface + interface dkei + module procedure d_dkei, s_dkei + end interface + +contains + !> set tolerance and maximum number of iterations + subroutine set_kelvin(tol, jmax) + implicit none + real(kind=dp), intent(in) :: tol + integer, intent(in) :: jmax + j_max = jmax + tolerance = tol + end subroutine set_kelvin + + function d_ber(x) + implicit none + real(kind=dp) :: d_ber + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_ber + real(kind=dp) :: factorial + real(kind=dp) :: sign + integer :: j + + p_d_ber = 0.d0 + factorial = 1.d0 + + d_ber = 1.d0 + arg = (x/2.d0)**4 + arg_d = arg + sign = -1.d0 + + j=1 + do while (j < j_max) + p_d_ber = d_ber + factorial = factorial*2*j*(2*j-1.d0) + d_ber = d_ber + sign*arg_d/(factorial*factorial) + if (abs(d_ber-p_d_ber) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_ber + + function d_bei(x) + implicit none + real(kind=dp) :: d_bei + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_bei + real(kind=dp) :: factorial + real(kind=dp) :: sign + integer :: j + + p_d_bei = 1.d12 + factorial = 1.d0 + + arg = (x/2.d0)**2 + d_bei = arg + arg_d = arg*arg*arg + arg = arg*arg + sign = -1.d0 + + j=1 + do while (j < j_max) + p_d_bei = d_bei + factorial = factorial*2*j*(2*j+1.d0) + d_bei = d_bei + sign*arg_d/(factorial*factorial) + if (abs(d_bei-p_d_bei) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_bei + + function d_ker(x) + implicit none + real(kind=dp) :: d_ker + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_ker + real(kind=dp) :: factorial + real(kind=dp) :: phi + real(kind=dp) :: sign + integer :: j + + p_d_ker = 0.d0 + factorial = 1.d0 + + arg = (x/2.d0)**4 + arg_d = arg + sign = -1.d0 + phi = 0.d0 + d_ker = -(log(x/2.d0)+gamma)*d_ber(x)+(pi/4.d0)*d_bei(x) + + j=1 + do while (j < j_max) + p_d_ker = d_ker + factorial = factorial*2*j*(2*j-1.d0) + phi = phi + 1.d0/(2.d0*j-1.d0) + 1.d0/(2.d0*j) + d_ker = d_ker + sign*phi*arg_d/(factorial*factorial) + if (abs(d_ker-p_d_ker) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_ker + + function d_kei(x) + implicit none + real(kind=dp) :: d_kei + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_kei + real(kind=dp) :: factorial + real(kind=dp) :: phi + real(kind=dp) :: sign + integer :: j + + p_d_kei = 0.d0 + factorial = 1.d0 + + arg = (x/2.d0)**2 + sign = -1.d0 + phi = 1.d0 + d_kei = -(log(x/2.d0)+gamma)*d_bei(x)-(pi/4.d0)*d_ber(x)+arg + arg_d = arg + arg = arg*arg + arg_d = arg_d*arg + + j=1 + do while (j < j_max) + p_d_kei = d_kei + factorial = factorial*2*j*(2*j+1.d0) + phi = phi + 1.d0/(2.d0*j+1.d0) + 1.d0/(2.d0*j) + d_kei = d_kei + sign*phi*arg_d/(factorial*factorial) + if (abs(d_kei-p_d_kei) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_kei + + function s_ber(x) + implicit none + real(kind=sp) :: s_ber + real(kind=sp), intent(in) :: x + + s_ber = real(d_ber(real(x,kind=dp)),kind=sp) + end function s_ber + + function s_bei(x) + implicit none + real(kind=sp) :: s_bei + real(kind=sp), intent(in) :: x + + s_bei = real(d_bei(real(x,kind=dp)),kind=sp) + end function s_bei + + function s_ker(x) + implicit none + real(kind=sp) :: s_ker + real(kind=sp), intent(in) :: x + + s_ker = real(d_ker(real(x,kind=dp)),kind=sp) + end function s_ker + + function s_kei(x) + implicit none + real(kind=sp) :: s_kei + real(kind=sp), intent(in) :: x + + s_kei = real(d_kei(real(x,kind=dp)),kind=sp) + end function s_kei + + function d_dber(x) + implicit none + real(kind=dp) :: d_dber + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_dber + real(kind=dp) :: factorial + real(kind=dp) :: sign + integer :: j + + p_d_dber = 0.d0 + factorial = 1.d0 + + d_dber = 0.d0 + arg = (x/2.d0)**4 + arg_d = (x/2.d0)**3 + sign = -1.d0 + + j=1 + do while (j < j_max) + p_d_dber = d_dber + factorial = factorial*2*j*(2*j-1.d0) + d_dber = d_dber + sign*2.d0*j*arg_d/(factorial*factorial) + if (abs(d_dber-p_d_dber) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_dber + + function d_dbei(x) + implicit none + real(kind=dp) :: d_dbei + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_dbei + real(kind=dp) :: factorial + real(kind=dp) :: sign + integer :: j + + p_d_dbei = 1.d12 + factorial = 1.d0 + + arg = (x/2.d0)**4 + arg_d = arg*(x/2.d0) + d_dbei = (x/2.d0) + sign = -1.d0 + + j=1 + do while (j < j_max) + p_d_dbei = d_dbei + factorial = factorial*2*j*(2*j+1.d0) + d_dbei = d_dbei + sign*(2.d0*j+1.d0)*arg_d/(factorial*factorial) + if (abs(d_dbei-p_d_dbei) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_dbei + + function d_dker(x) + implicit none + real(kind=dp) :: d_dker + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_dker + real(kind=dp) :: factorial + real(kind=dp) :: phi + real(kind=dp) :: sign + integer :: j + + p_d_dker = 0.d0 + factorial = 1.d0 + + arg = (x/2.d0)**4 + arg_d = (x/2.d0)**3 + sign = -1.d0 + phi = 0.d0 + d_dker = -(log(x/2.d0)+gamma)*d_dber(x)-d_ber(x)/x+(pi/4.d0)*d_dbei(x) + + j=1 + do while (j < j_max) + p_d_dker = d_dker + factorial = factorial*2*j*(2*j-1.d0) + phi = phi + 1.d0/(2.d0*j-1.d0) + 1.d0/(2.d0*j) + d_dker = d_dker + sign*phi*2.d0*j*arg_d/(factorial*factorial) + if (abs(d_dker-p_d_dker) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_dker + + function d_dkei(x) + implicit none + real(kind=dp) :: d_dkei + real(kind=dp), intent(in) :: x + + real(kind=dp) :: arg, arg_d + real(kind=dp) :: p_d_dkei + real(kind=dp) :: factorial + real(kind=dp) :: phi + real(kind=dp) :: sign + integer :: j + + p_d_dkei = 0.d0 + factorial = 1.d0 + + arg = (x/2.d0) + sign = -1.d0 + phi = 1.d0 + d_dkei = -(log(x/2.d0)+gamma)*d_dbei(x)-d_bei(x)/x-(pi/4.d0)*d_dber(x)+arg + arg_d = arg**5 + arg = arg**4 + + j=1 + do while (j < j_max) + p_d_dkei = d_dkei + factorial = factorial*2*j*(2*j+1.d0) + phi = phi + 1.d0/(2.d0*j+1.d0) + 1.d0/(2.d0*j) + d_dkei = d_dkei + sign*phi*(2.d0*j+1.d0)*arg_d/(factorial*factorial) + if (abs(d_dkei-p_d_dkei) < tolerance) exit + arg_d = arg_d*arg + sign = -sign + j = j+1 + end do + end function d_dkei + + function s_dber(x) + implicit none + real(kind=sp) :: s_dber + real(kind=sp), intent(in) :: x + + s_dber = real(d_dber(real(x,kind=dp)),kind=sp) + end function s_dber + + function s_dbei(x) + implicit none + real(kind=sp) :: s_dbei + real(kind=sp), intent(in) :: x + + s_dbei = real(d_dbei(real(x,kind=dp)),kind=sp) + end function s_dbei + + function s_dker(x) + implicit none + real(kind=sp) :: s_dker + real(kind=sp), intent(in) :: x + + s_dker = real(d_dker(real(x,kind=dp)),kind=sp) + end function s_dker + + function s_dkei(x) + implicit none + real(kind=sp) :: s_dkei + real(kind=sp), intent(in) :: x + + s_dkei = real(d_dkei(real(x,kind=dp)),kind=sp) + end function s_dkei + +end module isostasy_kelvin + + + diff --git a/components/cism/glimmer-cism/libglide/time_vars.def b/components/cism/glimmer-cism/libglide/time_vars.def new file mode 100644 index 0000000000..ad729e4b07 --- /dev/null +++ b/components/cism/glimmer-cism/libglide/time_vars.def @@ -0,0 +1,7 @@ +[time] +dimensions: time +units: year since 1-1-1 0:0:0 +long_name: Model time +standard_name: time +calendar: none + diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/READ.ME b/components/cism/glimmer-cism/libglimmer-solve/SLAP/READ.ME new file mode 100644 index 0000000000..5ca4fb57a2 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/READ.ME @@ -0,0 +1,189 @@ +---------------------------------------------------------------------- + The + Sparse Linear Algebra Package + + @@@@@@@ @ @@@ @@@@@@@@ + @ @ @ @ @ @ @ + @ @ @ @ @ @ + @@@@@@@ @ @ @ @@@@@@@@ + @ @ @@@@@@@@@ @ + @ @ @ @ @ @ + @@@@@@@ @@@@@@@@@ @ @ @ + + @ @ @@@@@@@ @@@@@ + @ @ @ @ @ @@ + @ @ @@@@@@@ @ @@ @ @ @ @ + @ @ @ @ @@ @ @@@@@@ @ @ @ + @ @ @@@@@@@@@ @ @ @ @ @ + @ @ @ @ @ @@@ @@ @ + @@@ @@@@@@@ @ @@@@@@@@@ @@@ @@@@@ + +---------------------------------------------------------------------- + +SLAP This is the official release version 2.0 of the Sparse Linear + Algebra Package: a SLAP for the Masses! It contains "core" + routines for the iterative solution symmetric and non-symmetric + positive definite and positive semi-definite linear systems. + Included in this package are core routines to do Iterative + Refinement iteration, Preconditioned Conjugate Gradient + iteration, Preconditioned Conjugate Gradient iteration on the + Normal Equations, Preconditioned BiConjugate Gradient iteration, + Preconditioned BiConjugate Gradient Squared iteration, Orthomin + iteration and Generalized Minimum Residual iteration. Core + routines require the user to supply "MATVEC" (Matrix Vector + Multiply) and "MSOLVE" (Preconditioning) routines. This allows + the core routines to be written in a way that makes them + independent of the matrix data structure. For each core routine + there are several drivers and support routines that allow the + user to utilize Diagonal Scaling and Incomplete + Cholesky/Incomplete LU factorization as preconditioners with no + coding. The price for this convenience is that one must use the + a specific matrix data structure: SLAP Column or SLAP Triad + format. + +Comments and suggestions should be sent to: + Dr. Mark K. Seager + Lawrence Livermore National Lab. + PO Box 808, L-300 + Livermore, CA 94550 + (415) 423-3141 + seager@lll-crg.llnl.gov +or + Dr. Anne Greenbaum + Courant Institute of Mathematical Sciences + New York University + 251 Mercer St. + New York, NY 10012 + (212)998-3145 + greenbau@nyu.edu + + ********************************************************************** + GETTING STARTED ON ==> NON UNIX <== SYSTEMS + ********************************************************************** +To generate the SLAP test program and library on *NON* Un*x systems +get the following files: + READ.ME This very file. + slapqc.f Quick Check driver routine. Read the comments in this + file for more information about porting the test code. + slap.f Source code for SLAP 2.0. The first "routine" is a + "RoadMap" document routine that describes the package + in gory detail. + dlapqc.f Quick Check driver routine for double precision + routines. Read the comments in this file for more + information about porting the test code. + dlap.f Source code for SLAP 2.0 double precision routines. + The first "routine" is a "RoadMap" document routine + that describes the package in gory detail. +Additional routines required for correct execution that are not +supplied directly with the package are the BLAS and the SLATEC error +handling package. These can be obtained from the SLATEC library +itself. + +To make the library simply compile "slap.f" with the highest +optimization level you have at you disposal. Then look at the listing +to make sure that the "inner loops" in the routines SSMV, SSMTV, +SSLI2, SLLTI2, SSLUI2, SSLUI4 and SSMMI2 vectorized. Compiler +directives have been set up for the Alliant FX/Fortran, Cray CFT and +LCC Civic compilers, but you may want to verify the vectorization of +these loops anyway. Now do what ever is necessary to turn the binary +from "slap.f" into a library. + +To make the test program compile the "slapqc.f" and link this with the +SLAP library made in the last step and the SLATEC library (to get the +SLATEC error handling package and the BLAS). + +********************************************************************** + GETTING STARTED ON UNIX SYSTEMS +********************************************************************** +To generate the SLAP test program and library on Un*x systems edit the +makefile included in this distribution and change the make macros: +1) FFLAGS to what ever your Fortran77 compiler needs to optimize + things. +2) LFLAGS to what ever libraries you need to load in. +3) OWNER to the owner of the library file to be created with + "make install" ( "root" or your login name are two obvious choices + here). +3) GROUP to the group who should have privileges on the library file. +4) LIBDIR to the directory where to put the library. The choice in + the makefile distribution is the standard Un*x place. + +To make the SLAP library type "make install" and the makefile will +construct the libslap.a file and install it in $(LIBDIR) with $(OWNER) +and $(GROUP) privileges. + +Also, the files xersla.f, blas.f and mach.f contain routines that are +usually contained in the SLATEC library and are included to be used if +you don't have them in some library somewhere. xersla.f is the error +handler for SLATEC. Add it to the load line for slapqc: + +slapqc : slapqc.o ${OBJS} xersla.o + $(FC) ${FFLAGS} slapqc.o ${OBJS} xersla.o -o slapqc ${LFLAGS} + +if you don't have the SLATEC library installed and referenced in +${LFLAGS}. mach.f contains the machine constants for various +machines. If you get unsatisfied externals R1MACH and I1MACH then you +need to add mach.o to the load line for slapqc. Uncomment the +machine constants for you machine (or add them if needed) and run make +again. blas.f contains the "LINPACK BLAS" and you should use the hand +coded versions, if your machine vendor supplied them (most do +now-a-days). If you don't have them then add blas.o to the load line +and rerun make. + +After editing the makefile do "make slapqc" or just "make" to get the +SLAP Quick Test program made. + +********************************************************************** + RUNNING THE SLAP 2.0 QUICK CHECK +********************************************************************** +The SLAP 2.0 SLATEC quick check test program "slapqc" requires one +input parameter "KPRINT" from the STANDARD IN (I1MACH(1)) Fortran I/O +unit (this is all described in the source file "slapqc.f") KPRINT=2 +gives nice output about the progression of tests. Running the Quick +Test will generate output to the STANDARD OUT (I1MACH(2)). All +iterative methods should complete their iteration without error. If +all went well with the quick checks then the following message is +printed out at the end of the test: +**************************************************** +**** All SLAP Quick Checks Passed. No Errors. **** +**************************************************** + +********************************************************************** + + Notice + This computer code material was prepared as an account of + work sponsored by the United States Government. Neither the + United States nor the United States Department of Energy, + nor any of their employees, nor any of their contractors, + subcontractors, or their employees, makes any warranty, + express or implied, or assumes any legal liability or + responsibility for the accuracy, completeness or usefulness + of any information, apparatus, product or process disclosed, + or represents that its use would not infringe + privately-owned rights. + +********************************************************************** + + DISCLAIMER + This document was prepared as an account of work sponsored + by an agency of the United States Government. Neither the + United States Government nor the University of California + nor any of their employees, makes any warranty, express or + implied, or assumes any legal liability or responsibility + for the accuracy, completeness or usefulness of any + information, apparatus, product or process disclosed, or + represents that its use would not infringe privately owned + rights. Reference herein to any specific commercial + products, process, or service by trade name, trademark, + manufacturer, or otherwise, does not necessarily constitute + or imply its endorsement, recommendation, or favoring by the + United States Government or the University of California. + The views and opinions of authors expressed herein do not + necessarily state or reflect those of the United States + Government thereof, and shall not be used for advertising or + product endorsement purposes. + + Work performed under the auspices of the U.S. Department of + Energy by Lawrence Livermore National Laboratory under + contract number W-7405-Eng-48. + +********************************************************************** diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dbcg.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dbcg.f new file mode 100644 index 0000000000..45c8bce782 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dbcg.f @@ -0,0 +1,1083 @@ +*DECK DBCG + SUBROUTINE DBCG(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, + $ MSOLVE, MTSOLV, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ R, Z, P, RR, ZZ, PP, DZ, RWORK, IWORK) +C***BEGIN PROLOGUE DBCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DBCG-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, BiConjugate Gradient +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned BiConjugate Gradient Sparse Ax=b solver. +C Routine to solve a Non-Symmetric linear system Ax = b +C using the Preconditioned BiConjugate Gradient method. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINABLE) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N), P(N) +C DOUBLE PRECISION RR(N), ZZ(N), PP(N), DZ(N) +C DOUBLE PRECISION RWORK(USER DEFINABLE) +C EXTERNAL MATVEC, MTTVEC, MSOLVE, MTSOLV +C +C CALL DBCG(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, +C $ MSOLVE, MTSOLV, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, +C $ R, Z, P, RR, ZZ, PP, DZ, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", below for more +C late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C operation Y = A*X given A and X. The name of the MATVEC +C routine must be declared external in the calling program. +C The calling sequence of MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X upon +C return, X is an input vector. NELT, IA, JA, A and ISYM +C define the SLAP matrix data structure: see Description,below. +C MTTVEC :EXT External. +C Name of a routine which performs the matrix transpose vector +C multiply y = A'*X given A and X (where ' denotes transpose). +C The name of the MTTVEC routine must be declared external in +C the calling program. The calling sequence to MTTVEC is the +C same as that for MTTVEC, viz.: +C CALL MTTVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A'*X +C upon return, X is an input vector. NELT, IA, JA, A and ISYM +C define the SLAP matrix data structure: see Description,below. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for Z +C given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine +C must be declared external in the calling program. The +C calling sequence of MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. NELT, IA, JA, A +C and ISYM define the SLAP matrix data structure: see +C Description, below. RWORK is a double precision array that +C can be used +C to pass necessary preconditioning information and/or +C workspace to MSOLVE. IWORK is an integer work array for the +C same purpose as RWORK. +C MTSOLV :EXT External. T +C Name of a routine which solves a linear system M ZZ = RR for +C ZZ given RR with the preconditioning matrix M (M is supplied +C via RWORK and IWORK arrays). The name of the MTSOLV routine +C must be declared external in the calling program. The call- +C ing sequence to MTSOLV is: +C CALL MTSOLV(N, RR, ZZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, RR is the right-hand side +C vector, and ZZ is the solution upon return. NELT, IA, JA, A +C and ISYM define the SLAP matrix data structure: see +C Description, below. RWORK is a double precision array that +C can be used +C to pass necessary preconditioning information and/or +C workspace to MTSOLV. IWORK is an integer work array for the +C same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C Z :WORK Double Precision Z(N). +C P :WORK Double Precision P(N). +C RR :WORK Double Precision RR(N). +C ZZ :WORK Double Precision ZZ(N). +C PP :WORK Double Precision PP(N). +C DZ :WORK Double Precision DZ(N). +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE and MTSOLV. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE +C and MTSOLV. +C +C *Description +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK in some fashion. The SLAP +C routines SDBCG and DSLUBC are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *See Also: +C SDBCG, DSLUBC +C***REFERENCES (NONE) +C***ROUTINES CALLED MATVEC, MTTVEC, MSOLVE, MTSOLV, ISDBCG, +C DCOPY, DDOT, DAXPY, D1MACH +C***END PROLOGUE DBCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N), P(N) + DOUBLE PRECISION RR(N), ZZ(N), PP(N), DZ(N), RWORK(*) + EXTERNAL MATVEC, MTTVEC, MSOLVE, MTSOLV +C +C Check some of the input data. +C***FIRST EXECUTABLE STATEMENT DBCG + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + FUZZ = D1MACH(3) + TOLMIN = 500.0*FUZZ + FUZZ = FUZZ*FUZZ + IF( TOL.LT.TOLMIN ) THEN + TOL = TOLMIN + IERR = 4 + ENDIF +C +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + R(I) = B(I) - R(I) + RR(I) = R(I) + 10 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL MTSOLV(N, RR, ZZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C + IF( ISDBCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, RR, ZZ, PP, + $ DZ, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) + $ GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C ***** iteration loop ***** +C + DO 100 K=1,ITMAX + ITER = K +C +C Calculate coefficient BK and direction vectors P and PP. + BKNUM = DDOT(N, Z, 1, RR, 1) + IF( ABS(BKNUM).LE.FUZZ ) THEN + IERR = 6 + RETURN + ENDIF + IF(ITER .EQ. 1) THEN + CALL DCOPY(N, Z, 1, P, 1) + CALL DCOPY(N, ZZ, 1, PP, 1) + ELSE + BK = BKNUM/BKDEN + DO 20 I = 1, N + P(I) = Z(I) + BK*P(I) + PP(I) = ZZ(I) + BK*PP(I) + 20 CONTINUE + ENDIF + BKDEN = BKNUM +C +C Calculate coefficient AK, new iterate X, new resids R and RR, +C and new pseudo-resids Z and ZZ. + CALL MATVEC(N, P, Z, NELT, IA, JA, A, ISYM) + AKDEN = DDOT(N, PP, 1, Z, 1) + AK = BKNUM/AKDEN + IF( ABS(AKDEN).LE.FUZZ ) THEN + IERR = 6 + RETURN + ENDIF + CALL DAXPY(N, AK, P, 1, X, 1) + CALL DAXPY(N, -AK, Z, 1, R, 1) + CALL MTTVEC(N, PP, ZZ, NELT, IA, JA, A, ISYM) + CALL DAXPY(N, -AK, ZZ, 1, RR, 1) + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL MTSOLV(N, RR, ZZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C +C check stopping criterion. + IF( ISDBCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, RR, ZZ, + $ PP, DZ, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) + $ GO TO 200 +C + 100 CONTINUE +C +C ***** end of loop ***** +C +C stopping criterion not satisfied. + ITER = ITMAX + 1 + IERR = 2 +C + 200 RETURN +C------------- LAST LINE OF DBCG FOLLOWS ---------------------------- + END +*DECK DSDBCG + SUBROUTINE DSDBCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSDBCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSDBCG-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonally Scaled BiConjugate Gradient Sparse Ax=b solver. +C Routine to solve a linear system Ax = b using the +C BiConjugate Gradient method with diagonal scaling. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(10), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(8*N) +C +C CALL DSDBCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= 8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the RWORK array. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= 10. +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C +C *Description: +C This routine performs preconditioned BiConjugate gradient +C method on the Non-Symmetric positive definite linear system +C Ax=b. The preconditioner is M = DIAG(A), the diagonal of the +C matrix A. This is the simplest of preconditioners and +C vectorizes very well. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See above. +C +C *See Also: +C DBCG, DLUBCG +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSDS, DBCG +C***END PROLOGUE DSDBCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSMTV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSDBCG + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the workspace. Compute the inverse of the +C diagonal of the matrix. + LOCIW = LOCIB +C + LOCDIN = LOCRB + LOCR = LOCDIN + N + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCRR = LOCP + N + LOCZZ = LOCRR + N + LOCPP = LOCZZ + N + LOCDZ = LOCPP + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSDBCG', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCDIN + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCDIN)) +C +C Perform the Diagonally Scaled BiConjugate gradient algorithm. + CALL DBCG(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSMTV, + $ DSDI, DSDI, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCZ), RWORK(LOCP), + $ RWORK(LOCRR), RWORK(LOCZZ), RWORK(LOCPP), + $ RWORK(LOCDZ), RWORK(1), IWORK(1)) + RETURN +C------------- LAST LINE OF DSDBCG FOLLOWS ---------------------------- + END +*DECK DSLUBC + SUBROUTINE DSLUBC(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSLUBC +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSLUBC-D), +C Non-Symmetric Linear system, Sparse, +C Iterative incomplete LU Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU BiConjugate Gradient Sparse Ax=b solver. +C Routine to solve a linear system Ax = b using the +C BiConjugate Gradient method with Incomplete LU +C decomposition preconditioning. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+NU+4*N+2), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+NU+8*N) +C +C CALL DSLUBC(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN( ) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the +C number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+NU+8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. +C LENIW >= NEL+NU+4*N+12. +C +C *Description: +C This routine is simply a driver for the DBCGN routine. It +C calls the DSILUS routine to set up the preconditioning and +C then calls DBCGN with the appropriate MATVEC, MTTVEC and +C MSOLVE, MTSOLV routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See above. +C +C *See Also: +C DBCG, SDBCG +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSILUS, DBCG, DSMV, DSMTV +C***END PROLOGUE DSLUBC + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSMTV, DSLUI, DSLUTI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSLUBC + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements preconditioner ILU matrix. +C Then set up the work arrays. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagonal. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIL = LOCIB + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCU = LOCDIN + N + LOCR = LOCU + NU + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCRR = LOCP + N + LOCZZ = LOCRR + N + LOCPP = LOCZZ + N + LOCDZ = LOCPP + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSLUBC', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Perform the incomplete LU preconditioned +C BiConjugate Gradient algorithm. + CALL DBCG(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSMTV, + $ DSLUI, DSLUTI, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCZ), RWORK(LOCP), + $ RWORK(LOCRR), RWORK(LOCZZ), RWORK(LOCPP), + $ RWORK(LOCDZ), RWORK, IWORK ) + RETURN +C------------- LAST LINE OF DSLUBC FOLLOWS ---------------------------- + END +*DECK ISDBCG + FUNCTION ISDBCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, RR, ZZ, PP, DZ, + $ RWORK, IWORK, AK, BK, BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDBCG +C***REFER TO DBCG, DSDBCG, DSLUBC +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDBCG-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Stop Test +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned BiConjugate Gradient Stop Test. +C This routine calculates the stop test for the BiConjugate +C Gradient iteration scheme. It returns a nonzero if the +C error estimate (the type of which is determined by ITOL) +C is less than the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER +C INTEGER IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N), P(N) +C DOUBLE PRECISION RR(N), ZZ(N), PP(N), DZ(N) +C DOUBLE PRECISION RWORK(USER DEFINED), AK, BK, BNRM, SOLNRM +C EXTERNAL MSOLVE +C +C IF( ISDBCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, RR, ZZ, PP, DZ, +C $ RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) +C $ THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", in the SLAP +C routine DBCG for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for Z +C given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine +C must be declared external in the calling program. The +C calling sequence of MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. NELT, IA, JA, A +C and ISYM define the SLAP matrix data structure: see +C Description, below. RWORK is a double precision array that +C can be used +C to pass necessary preconditioning information and/or +C workspace to MSOLVE. IWORK is an integer work array for the +C same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than tol) through a common block, +C COMMON /SOLBLK/ SOLN( ) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than tol. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual r = b - Ax. +C Z :WORK Double Precision Z(N). +C P :DUMMY Double Precision P(N). +C RR :DUMMY Double Precision RR(N). +C ZZ :DUMMY Double Precision ZZ(N). +C PP :DUMMY Double Precision PP(N). +C DZ :WORK Double Precision DZ(N). +C If ITOL.eq.0 then DZ is used to hold M-inv * B on the first +C call. If ITOL.eq.11 then DZ is used to hold X-SOLN. +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE and MTSOLV. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE +C and MTSOLV. +C AK :IN Double Precision. +C Current iterate BiConjugate Gradient iteration parameter. +C BK :IN Double Precision. +C Current iterate BiConjugate Gradient iteration parameter. +C BNRM :INOUT Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C Calculated only on the first call. +C SOLNRM :INOUT Double Precision. +C 2-Norm of the true solution, SOLN. Only computed and used +C if ITOL = 11. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C***REFERENCES (NONE) +C***ROUTINES CALLED MSOLVE, DNRM2 +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDBCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(1) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N), P(N) + DOUBLE PRECISION RR(N), ZZ(N), PP(N), DZ(N), RWORK(*) + DOUBLE PRECISION AK, BK, BNRM, SOLNRM + COMMON /SOLBLK/ SOLN(1) + EXTERNAL MSOLVE +C +C***FIRST EXECUTABLE STATEMENT ISDBCG + ISDBCG = 0 +C + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, B, DZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) + BNRM = DNRM2(N, DZ, 1) + ENDIF + ERR = DNRM2(N, Z, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF(ITER .EQ. 0) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + DZ(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C + IF(IUNIT .NE. 0) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) N, ITOL + ENDIF + WRITE(IUNIT,1010) ITER, ERR, AK, BK + ENDIF + IF(ERR .LE. TOL) ISDBCG = 1 +C + RETURN + 1000 FORMAT(' Preconditioned BiConjugate Gradient for N, ITOL = ', + $ I5,I5,/' ITER',' Error Estimate',' Alpha', + $ ' Beta') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7,1X,E16.7) +C------------- LAST LINE OF ISDBCG FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcg.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcg.f new file mode 100644 index 0000000000..00c3423617 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcg.f @@ -0,0 +1,1053 @@ +*DECK DCG + SUBROUTINE DCG(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, + $ RWORK, IWORK ) +C***BEGIN PROLOGUE DCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DCG-D), +C Symmetric Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Conjugate Gradient iterative Ax=b solver. +C Routine to solve a symmetric positive definite linear +C system Ax = b using the Preconditioned Conjugate +C Gradient method. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINABLE) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) +C DOUBLE PRECISION P(N), DZ(N), RWORK(USER DEFINABLE) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DCG(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSLOVE, +C $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, +C $ RWORK, IWORK ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Integer A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See ``Description'', below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C Y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C +C Where N is the number of unknowns, Y is the product A*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP IA, JA, A storage for the matrix A. +C ISYM is a flag which, if non-zero, denotest that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSLOVE is: +C +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a double +C precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*R1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C Z :WORK Double Precision Z(N). +C P :WORK Double Precision P(N). +C DZ :WORK Double Precision DZ(N). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C +C *Description +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK in some fashion. The SLAP +C routines DSDCG and DSICCG are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *See Also: +C DSDCG, DSICCG +C***REFERENCES 1. Louis Hageman \& David Young, ``Applied Iterative +C Methods'', Academic Press, New York (1981) ISBN +C 0-12-313340-8. +C +C 2. Concus, Golub \& O'Leary, ``A Generalized Conjugate +C Gradient Method for the Numerical Solution of +C Elliptic Partial Differential Equations,'' in Sparse +C Matrix Computations (Bunch \& Rose, Eds.), Academic +C Press, New York (1979). +C***ROUTINES CALLED MATVEC, MSOLVE, ISDCG, DCOPY, DDOT, DAXPY, D1MACH +C***END PROLOGUE DCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IUNIT, IERR, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N), P(N) + DOUBLE PRECISION DZ(N), RWORK(*) + EXTERNAL MATVEC, MSOLVE +C +C Check some of the input data. +C***FIRST EXECUTABLE STATEMENT DCG + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + TOLMIN = 500.0*D1MACH(3) + IF( TOL.LT.TOLMIN ) THEN + TOL = TOLMIN + IERR = 4 + ENDIF +C +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + R(I) = B(I) - R(I) + 10 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C + IF( ISDCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, + $ RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C ***** Iteration loop ***** +C + DO 100 K=1,ITMAX + ITER = K +C +C Calculate coefficient bk and direction vector p. + BKNUM = DDOT(N, Z, 1, R, 1) + IF( BKNUM.LE.0.0D0 ) THEN + IERR = 5 + RETURN + ENDIF + IF(ITER .EQ. 1) THEN + CALL DCOPY(N, Z, 1, P, 1) + ELSE + BK = BKNUM/BKDEN + DO 20 I = 1, N + P(I) = Z(I) + BK*P(I) + 20 CONTINUE + ENDIF + BKDEN = BKNUM +C +C Calculate coefficient ak, new iterate x, new residual r, +C and new pseudo-residual z. + CALL MATVEC(N, P, Z, NELT, IA, JA, A, ISYM) + AKDEN = DDOT(N, P, 1, Z, 1) + IF( AKDEN.LE.0.0D0 ) THEN + IERR = 6 + RETURN + ENDIF + AK = BKNUM/AKDEN + CALL DAXPY(N, AK, P, 1, X, 1) + CALL DAXPY(N, -AK, Z, 1, R, 1) + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C +C check stopping criterion. + IF( ISDCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, RWORK, + $ IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 +C + 100 CONTINUE +C +C ***** end of loop ***** +C +C stopping criterion not satisfied. + ITER = ITMAX + 1 + IERR = 2 +C + 200 RETURN + END +*DECK DSDCG + SUBROUTINE DSDCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSDCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSDCG-D), +C Symmetric Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonally Scaled Conjugate Gradient Sparse Ax=b Solver. +C Routine to solve a symmetric positive definite linear +C system Ax = b using the Preconditioned Conjugate +C Gradient method. The preconditioner is diagonal +C scaling. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(10), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(5*N) +C +C CALL DSDCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Integer A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See ``Description'', +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. LENW >= 5*N. +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the double precision workspace, +C RWORK. Upon return the following locations of IWORK hold +C information which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= 10. +C +C *Description: +C This routine performs preconditioned conjugate gradient +C method on the symmetric positive definite linear system +C Ax=b. The preconditioner is M = DIAG(A), the diagonal of +C the matrix A. This is the simplest of preconditioners and +C vectorizes very well. This routine is simply a driver for +C the DCG routine. It calls the DSDS routine to set up the +C preconditioning and then calls DCG with the appropriate +C MATVEC and MSOLVE routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See above. +C +C *See Also: +C DCG, DSICCG +C***REFERENCES 1. Louis Hageman \& David Young, ``Applied Iterative +C Methods'', Academic Press, New York (1981) ISBN +C 0-12-313340-8. +C 2. Concus, Golub \& O'Leary, ``A Generalized Conjugate +C Gradient Method for the Numerical Solution of +C Elliptic Partial Differential Equations,'' in Sparse +C Matrix Computations (Bunch \& Rose, Eds.), Academic +C Press, New York (1979). +C***ROUTINES CALLED DS2Y, DCHKW, DSDS, DCG +C***END PROLOGUE DSDCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL + INTEGER ITMAX, ITER, IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Modify the SLAP matrix data structure to YSMP-Column. +C***FIRST EXECUTABLE STATEMENT DSDCG + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the work arrays. +C Compute the inverse of the diagonal of the matrix. This +C will be used as the preconditioner. + LOCIW = LOCIB +C + LOCD = LOCRB + LOCR = LOCD + N + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCDZ = LOCP + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSDCG', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCD + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCD)) +C +C Do the Preconditioned Conjugate Gradient. + CALL DCG(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSDI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCP), RWORK(LOCDZ), RWORK, IWORK) + RETURN +C------------- LAST LINE OF DSDCG FOLLOWS ----------------------------- + END +*DECK DSICCG + SUBROUTINE DSICCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSICCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSICCG-D), +C Symmetric Linear system, Sparse, +C Iterative Precondition, Incomplete Cholesky +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete Cholesky Conjugate Gradient Sparse Ax=b Solver. +C Routine to solve a symmetric positive definite linear +C system Ax = b using the incomplete Cholesky +C Preconditioned Conjugate Gradient method. +C +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+2*n+1), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+5*N) +C +C CALL DSICCG(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Integer A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See ``Description'', +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the +C number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal) +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+5*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= NEL+N+11. +C +C *Description: +C This routine performs preconditioned conjugate gradient +C method on the symmetric positive definite linear system +C Ax=b. The preconditioner is the incomplete Cholesky (IC) +C factorization of the matrix A. See DSICS for details about +C the incomplete factorization algorithm. One should note +C here however, that the IC factorization is a slow process +C and that one should save factorizations for reuse, if +C possible. The MSOLVE operation (handled in DSLLTI) does +C vectorize on machines with hardware gather/scatter and is +C quite fast. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *See Also: +C DCG, DSLLTI +C***REFERENCES 1. Louis Hageman \& David Young, ``Applied Iterative +C Methods'', Academic Press, New York (1981) ISBN +C 0-12-313340-8. +C 2. Concus, Golub \& O'Leary, ``A Generalized Conjugate +C Gradient Method for the Numerical Solution of +C Elliptic Partial Differential Equations,'' in Sparse +C Matrix Computations (Bunch \& Rose, Eds.), Academic +C Press, New York (1979). +C***ROUTINES CALLED DS2Y, DCHKW, DSICS, XERRWV, DCG +C***END PROLOGUE DSICCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL + INTEGER ITMAX, ITER, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSLLTI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSICCG + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of elements in lower triangle of the matrix. +C Then set up the work arrays. + IF( ISYM.EQ.0 ) THEN + NEL = (NELT + N)/2 + ELSE + NEL = NELT + ENDIF +C + LOCJEL = LOCIB + LOCIEL = LOCJEL + NEL + LOCIW = LOCIEL + N + 1 +C + LOCEL = LOCRB + LOCDIN = LOCEL + NEL + LOCR = LOCDIN + N + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCDZ = LOCP + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSICCG', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = NEL + IWORK(2) = LOCJEL + IWORK(3) = LOCIEL + IWORK(4) = LOCEL + IWORK(5) = LOCDIN + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete Cholesky decomposition. +C + CALL DSICS(N, NELT, IA, JA, A, ISYM, NEL, IWORK(LOCIEL), + $ IWORK(LOCJEL), RWORK(LOCEL), RWORK(LOCDIN), + $ RWORK(LOCR), IERR ) + IF( IERR.NE.0 ) THEN + CALL XERRWV('DSICCG: Warning...IC factorization broke down '// + $ 'on step i1. Diagonal was set to unity and '// + $ 'factorization proceeded.', 113, 1, 1, 1, IERR, 0, + $ 0, 0.0, 0.0 ) + IERR = 7 + ENDIF +C +C Do the Preconditioned Conjugate Gradient. + CALL DCG(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSLLTI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCP), RWORK(LOCDZ), RWORK(1), + $ IWORK(1)) + RETURN +C------------- LAST LINE OF DSICCG FOLLOWS ---------------------------- + END +*DECK ISDCG + FUNCTION ISDCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, + $ RWORK, IWORK, AK, BK, BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDCG +C***REFER TO DCG, DSDCG, DSICCG +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDCG-D), +C Linear system, Sparse, Stop Test +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Conjugate Gradient Stop Test. +C This routine calculates the stop test for the Conjugate +C Gradient iteration scheme. It returns a nonzero if the +C error estimate (the type of which is determined by ITOL) +C is less than the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER +C INTEGER IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N) +C DOUBLE PRECISION P(N), DZ(N), RWORK(USER DEFINED), AK, BK +C DOUBLE PRECISION BNRM, SOLNRM +C EXTERNAL MSOLVE +C +C IF( ISDCG(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, DZ, RWORK, IWORK, +C $ AK, BK, BNRM, SOLNRM) .NE. 0 ) THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :IN Double Precision X(N). +C The current approximate solution vector. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See ``Description'' +C in the DCG, DSDCG or DSICCG routines. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a double +C precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the ``exact'' +C solution or a very accurate approximation (one with an error +C much less than tol) through a common block, +C COMMON /SOLBLK/ SOLN( ) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than tol. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :IN Integer. +C The iteration for which to check for convergence. +C ERR :OUT Double Precision. +C Error estimate of error in the X(N) approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual R = B-AX. +C Z :WORK Double Precision Z(N). +C Workspace used to hold the pseudo-residual M Z = R. +C P :IN Double Precision P(N). +C The conjugate direction vector. +C DZ :WORK Double Precision DZ(N). +C Workspace used to hold temporary vector(s). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C BNRM :INOUT Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C Calculated only on the first call. +C SOLNRM :INOUT Double Precision. +C 2-Norm of the true solution, SOLN. Only computed and used +C if ITOL = 11. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C *See Also: +C DCG, DSDCG, DSICCG +C +C *Cautions: +C This routine will attempt to write to the fortran logical output +C unit IUNIT, if IUNIT .ne. 0. Thus, the user must make sure that +C this logical unit must be attached to a file or terminal +C before calling this routine with a non-zero value for IUNIT. +C This routine does not check for the validity of a non-zero IUNIT +C unit number. +C***REFERENCES (NONE) +C***ROUTINES CALLED MSOLVE, DNRM2 +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDCG + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N) + DOUBLE PRECISION Z(N), P(N), DZ(N), RWORK(*) + EXTERNAL MSOLVE + COMMON /SOLBLK/ SOLN(1) +C +C***FIRST EXECUTABLE STATEMENT ISDCG + ISDCG = 0 +C + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) + BNRM = DNRM2(N, DZ, 1) + ENDIF + ERR = DNRM2(N, Z, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF(ITER .EQ. 0) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + DZ(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C + IF(IUNIT .NE. 0) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) N, ITOL + ENDIF + WRITE(IUNIT,1010) ITER, ERR, AK, BK + ENDIF + IF(ERR .LE. TOL) ISDCG = 1 + RETURN + 1000 FORMAT(' Preconditioned Conjugate Gradient for ', + $ 'N, ITOL = ',I5, I5, + $ /' ITER',' Error Estimate',' Alpha', + $ ' Beta') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7,1X,E16.7) +C------------- LAST LINE OF ISDCG FOLLOWS ------------------------------ + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgn.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgn.f new file mode 100644 index 0000000000..fde7dd3f1f --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgn.f @@ -0,0 +1,1125 @@ +*DECK DCGN + SUBROUTINE DCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, + $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, + $ ATP, ATZ, DZ, ATDZ, RWORK, IWORK) +C***BEGIN PROLOGUE DCGN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DCGN-D), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition, Normal Equations. +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned CG Sparse Ax=b Solver for Normal Equations. +C Routine to solve a general linear system Ax = b using the +C Preconditioned Conjugate Gradient method applied to the +C normal equations AA'y = b, x=A'y. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINABLE) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) +C DOUBLE PRECISION P(N), ATP(N), ATZ(N), DZ(N), ATDZ(N) +C DOUBLE PRECISION RWORK(USER DEFINABLE) +C EXTERNAL MATVEC, MTTVEC, MSOLVE +C +C CALL DCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, +C $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, +C $ Z, P, ATP, ATZ, DZ, ATDZ, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP-Column IA, JA, A storage for the matrix +C A. ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MTTVEC :EXT External. +C Name of a routine which performs the matrix transpose vector +C multiply y = A'*X given A and X (where ' denotes transpose). +C The name of the MTTVEC routine must be declared external in +C the calling program. The calling sequence to MTTVEC is the +C same as that for MATVEC, viz.: +C CALL MTTVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A'*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP-Column IA, JA, A storage for the matrix +C A. ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*R1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C Z :WORK Double Precision Z(N). +C P :WORK Double Precision P(N). +C ATP :WORK Double Precision ATP(N). +C ATZ :WORK Double Precision ATZ(N). +C DZ :WORK Double Precision DZ(N). +C ATDZ :WORK Double Precision ATDZ(N). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C +C *Description: +C This routine applies the preconditioned conjugate gradient +C (PCG) method to a non-symmetric system of equations Ax=b. To +C do this the normal equations are solved: +C AA' y = b, where x = A'y. +C In PCG method the iteration count is determined by condition +C -1 +C number of the matrix (M A). In the situation where the +C normal equations are used to solve a non-symmetric system +C the condition number depends on AA' and should therefore be +C much worse than that of A. This is the conventional wisdom. +C When one has a good preconditioner for AA' this may not hold. +C The latter is the situation when DCGN should be tried. +C +C If one is trying to solve a symmetric system, SCG should be +C used instead. +C +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK) in some fashion. The SLAP +C routines SSDCGN and SSLUCN are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *See Also: +C DSDCGN, DSLUCN, ISDCGN +C***REFERENCES (NONE) +C***ROUTINES CALLED MATVEC, MTTVEC, MSOLVE, ISDCGN, +C DCOPY, DDOT, DAXPY, D1MACH +C***END PROLOGUE DCGN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(N), R(N), Z(N), P(N) + DOUBLE PRECISION ATP(N), ATZ(N), DZ(N), ATDZ(N), RWORK(*) + EXTERNAL MATVEC, MTTVEC, MSOLVE +C +C Check user input. +C***FIRST EXECUTABLE STATEMENT DCGN + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + TOLMIN = 500.0*D1MACH(3) + IF( TOL.LT.TOLMIN ) THEN + TOL = TOLMIN + IERR = 4 + ENDIF +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + R(I) = B(I) - R(I) + 10 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL MTTVEC(N, Z, ATZ, NELT, IA, JA, A, ISYM) +C + IF( ISDCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, ATP, ATZ, + $ DZ, ATDZ, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) + $ GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C ***** iteration loop ***** +C + DO 100 K=1,ITMAX + ITER = K +C +C Calculate coefficient BK and direction vector P. + BKNUM = DDOT(N, Z, 1, R, 1) + IF( BKNUM.LE.0.0D0 ) THEN + IERR = 6 + RETURN + ENDIF + IF(ITER .EQ. 1) THEN + CALL DCOPY(N, Z, 1, P, 1) + ELSE + BK = BKNUM/BKDEN + DO 20 I = 1, N + P(I) = Z(I) + BK*P(I) + 20 CONTINUE + ENDIF + BKDEN = BKNUM +C +C Calculate coefficient AK, new iterate X, new residual R, +C and new pseudo-residual ATZ. + IF(ITER .NE. 1) CALL DAXPY(N, BK, ATP, 1, ATZ, 1) + CALL DCOPY(N, ATZ, 1, ATP, 1) + AKDEN = DDOT(N, ATP, 1, ATP, 1) + IF( AKDEN.LE.0.0D0 ) THEN + IERR = 6 + RETURN + ENDIF + AK = BKNUM/AKDEN + CALL DAXPY(N, AK, ATP, 1, X, 1) + CALL MATVEC(N, ATP, Z, NELT, IA, JA, A, ISYM) + CALL DAXPY(N, -AK, Z, 1, R, 1) + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL MTTVEC(N, Z, ATZ, NELT, IA, JA, A, ISYM) +C +C check stopping criterion. + IF( ISDCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, + $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, + $ Z, P, ATP, ATZ, DZ, ATDZ, RWORK, IWORK, AK, BK, BNRM, + $ SOLNRM) .NE. 0) GOTO 200 +C + 100 CONTINUE +C +C ***** end of loop ***** +C +C stopping criterion not satisfied. + ITER = ITMAX + 1 +C + 200 RETURN +C------------- LAST LINE OF DCGN FOLLOWS ---------------------------- + END +*DECK DSDCGN + SUBROUTINE DSDCGN(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSDCGN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSDCGN-D), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonally Scaled CG Sparse Ax=b Solver for Normal Eqn's. +C Routine to solve a general linear system Ax = b using +C diagonal scaling with the Conjugate Gradient method +C applied to the the normal equations, viz., AA'y = b, +C where x = A'y. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK, LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(8*N) +C +C CALL DSDCGN(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= 8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the RWORK array. +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= 10. +C +C *Description: +C This routine is simply a driver for the DCGN routine. It +C calls the DSD2S routine to set up the preconditioning and +C then calls DCGN with the appropriate MATVEC and MSOLVE +C routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *See Also: +C DCGN, DSD2S, DSMV, DSMTV, DSDI +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSD2S, DCGN, DSMV, DSMTV, DSDI +C***END PROLOGUE DSDCGN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL + INTEGER ITMAX, ITER, IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSMTV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Modify the SLAP matrix data structure to YSMP-Column. +C***FIRST EXECUTABLE STATEMENT DSDCGN + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the work arrays. +C Compute the inverse of the diagonal of AA'. This will be +C used as the preconditioner. + LOCIW = LOCIB +C + LOCD = LOCRB + LOCR = LOCD + N + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCATP = LOCP + N + LOCATZ = LOCATP + N + LOCDZ = LOCATZ + N + LOCATD = LOCDZ + N + LOCW = LOCATD + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSDCGN', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCD + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DSD2S(N, NELT, IA, JA, A, ISYM, RWORK(1)) +C +C Perform Conjugate Gradient algorithm on the normal equations. + CALL DCGN( N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSMTV, DSDI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCP), RWORK(LOCATP), RWORK(LOCATZ), + $ RWORK(LOCDZ), RWORK(LOCATD), RWORK, IWORK ) +C + IF( ITER.GT.ITMAX ) IERR = 2 + RETURN +C------------- LAST LINE OF DSDCGN FOLLOWS ---------------------------- + END +*DECK DSLUCN + SUBROUTINE DSLUCN(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSLUCN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSLUCN-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Incomplete LU Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU CG Sparse Ax=b Solver for Normal Equations. +C Routine to solve a general linear system Ax = b using the +C incomplete LU decomposition with the Conjugate Gradient +C method applied to the normal equations, viz., AA'y = b, +C x=A'y. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+NU+4*N+2), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+NU+8*N) +C +C CALL DSLUCN(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the number +C of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+NU+8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= +C NEL+NU+4*N+12. +C +C *Description: +C This routine is simply a driver for the DCGN routine. It +C calls the DSILUS routine to set up the preconditioning and then +C calls DCGN with the appropriate MATVEC and MSOLVE routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *See Also: +C DCGN, SDCGN, DSILUS +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DSILUS, DCHKW, DSMV, DSMTV, DSMMTI, DCGN +C***END PROLOGUE DSLUCN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + PARAMETER (LOCRB=1, LOCIB=11) +C + EXTERNAL DSMV, DSMTV, DSMMTI +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSLUCN + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements preconditioner ILU matrix. +C Then set up the work arrays. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagional. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIL = LOCIB + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCU = LOCDIN + N + LOCR = LOCU + NU + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCATP = LOCP + N + LOCATZ = LOCATP + N + LOCDZ = LOCATZ + N + LOCATD = LOCDZ + N + LOCW = LOCATD + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSLUCN', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Perform Conjugate Gradient algorithm on the normal equations. + CALL DCGN(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSMTV, DSMMTI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCP), RWORK(LOCATP), RWORK(LOCATZ), + $ RWORK(LOCDZ), RWORK(LOCATD), RWORK, IWORK ) +C + IF( ITER.GT.ITMAX ) IERR = 2 + RETURN +C------------- LAST LINE OF DSLUCN FOLLOWS ---------------------------- + END +*DECK ISDCGN + FUNCTION ISDCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, + $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, + $ P, ATP, ATZ, DZ, ATDZ, RWORK, IWORK, AK, BK, BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDCGN +C***REFER TO DCGN, DSDCGN, DSLUCN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDCGN-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Normal Equations +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned CG on Normal Equations Stop Test. +C This routine calculates the stop test for the Conjugate +C Gradient iteration scheme applied to the normal +C equations. It returns a nonzero if the error estimate +C (the type of which is determined by ITOL) is less than +C the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER +C INTEGER IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N), P(N) +C DOUBLE PRECISION ATP(N), ATZ(N), DZ(N), ATDZ(N) +C DOUBLE PRECISION RWORK(USER DEFINED), AK, BK, BNRM, SOLNRM +C EXTERNAL MATVEC, MTTVEC, MSOLVE +C +C IF( ISTPCGN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MTTVEC, +C $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, +C $ ATP, ATZ, DZ, ATDZ, RWORK, IWORK, AK, BK, BNRM, SOLNRM) +C $ .NE. 0 ) THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :IN Double Precision X(N). +C The current approximate solution vector. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description" in the +C SDCGN routine. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C Y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP-Column IA, JA, A storage for the matrix +C A. ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MTTVEC :EXT External. +C Name of a routine which performs the matrix transpose vector +C multiply y = A'*X given A and X (where ' denotes transpose). +C The name of the MTTVEC routine must be declared external in +C the calling program. The calling sequence to MTTVEC is the +C same as that for MATVEC, viz.: +C CALL MTTVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A'*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP-Column IA, JA, A storage for the matrix +C A. ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :IN Integer. +C The iteration for which to check for convergence. +C ERR :OUT Double Precision. +C Error estimate of error in the X(N) approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual R = B-AX. +C Z :WORK Double Precision Z(N). +C P :IN Double Precision P(N). +C The conjugate direction vector. +C ATP :IN Double Precision ATP(N). +C A-transpose times the conjugate direction vector. +C ATZ :IN Double Precision ATZ(N). +C A-transpose times the pseudo-residual. +C DZ :IN Double Precision DZ(N). +C Workspace used to hold temporary vector(s). +C ATDZ :WORK Double Precision ATDZ(N). +C Workspace. +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C BNRM :INOUT Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C Calculated only on the first call. +C SOLNRM :INOUT Double Precision. +C 2-Norm of the true solution, SOLN. Only computed and used +C if ITOL = 11. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C *See Also: +C SDCGN +C +C *Cautions: +C This routine will attempt to write to the fortran logical output +C unit IUNIT, if IUNIT .ne. 0. Thus, the user must make sure that +C this logical unit must be attached to a file or terminal +C before calling this routine with a non-zero value for IUNIT. +C This routine does not check for the validity of a non-zero IUNIT +C unit number. +C***REFERENCES (NONE) +C***ROUTINES CALLED MATVEC, MTTVEC, MSOLVE and the BLAS +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDCGN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N), P(N) + DOUBLE PRECISION ATP(N), ATZ(N), DZ(N), ATDZ(N), RWORK(*) + DOUBLE PRECISION AK, BK, BNRM, SOLNRM + EXTERNAL MATVEC, MTTVEC, MSOLVE + COMMON /SOLBLK/ SOLN(1) +C +C***FIRST EXECUTABLE STATEMENT ISDCGN + ISDCGN = 0 +C + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, B, DZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL MTTVEC(N, DZ, ATDZ, NELT, IA, JA, A, ISYM) + BNRM = DNRM2(N, ATDZ, 1) + ENDIF + ERR = DNRM2(N, ATZ, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF(ITER .EQ. 0) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + DZ(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C + IF( IUNIT.NE.0 ) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) N, ITOL + ENDIF + WRITE(IUNIT,1010) ITER, ERR, AK, BK + ENDIF + IF( ERR.LE.TOL ) ISDCGN = 1 +C + RETURN + 1000 FORMAT(' PCG Applied to the Normal Equations for ', + $ 'N, ITOL = ',I5, I5, + $ /' ITER',' Error Estimate',' Alpha', + $ ' Beta') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7,1X,E16.7) +C------------- LAST LINE OF ISDCGN FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgs.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgs.f new file mode 100644 index 0000000000..10685c0b10 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dcgs.f @@ -0,0 +1,1132 @@ +*DECK DCGS + SUBROUTINE DCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, + $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ R, R0, P, Q, U, V1, V2, RWORK, IWORK) +C***BEGIN PROLOGUE DCGS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DCGS-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, BiConjugate Gradient +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned BiConjugate Gradient Sparse Ax=b solver. +C Routine to solve a Non-Symmetric linear system Ax = b +C using the Preconditioned BiConjugate Gradient method. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINABLE) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), R0(N), P(N) +C DOUBLE PRECISION Q(N), U(N), V1(N), V2(N), RWORK(USER DEFINABLE) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, +C $ MSOLVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, +C $ R, R0, P, Q, U, V1, V2, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C operation Y = A*X given A and X. The name of the MATVEC +C routine must be declared external in the calling program. +C The calling sequence of MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X upon +C return, X is an input vector. NELT, IA, JA, A and ISYM +C define the SLAP matrix data structure: see Description,below. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for Z +C given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine +C must be declared external in the calling program. The +C calling sequence of MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. NELT, IA, JA, A +C and ISYM define the SLAP matrix data structure: see +C Description, below. RWORK is a double precision array that +C can be used +C to pass necessary preconditioning information and/or +C workspace to MSOLVE. IWORK is an integer work array for the +C same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C This routine must calculate the residual from R = A*X - B. +C This is un-natural and hence expensive for this type of iter- +C ative method. ITOL=2 is *STRONGLY* recommended. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv time a vector is the pre- +C conditioning step. This is the *NATURAL* stopping for this +C iterative method and is *STRONGLY* recommended. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than tol) through a common block, +C COMMON /SOLBLK/ SOLN( ) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than tol. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Breakdown of the method detected. +C $(r0,r) approximately 0.0$. +C IERR = 6 => Stagnation of the method detected. +C $(r0,v) approximately 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C R0 :WORK Double Precision R0(N). +C P :WORK Double Precision P(N). +C Q :WORK Double Precision Q(N). +C U :WORK Double Precision U(N). +C V1 :WORK Double Precision V1(N). +C V2 :WORK Double Precision V2(N). +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE. +C +C *Description +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK in some fashion. The SLAP +C routines SDBCG and DSLUCS are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *See Also: +C DSDCGS, DSLUCS +C***REFERENCES 1. P. Sonneveld, ``CGS, a fast Lanczos-type solver +C for nonsymmetric linear systems'', Delft University +C of Technology Report 84-16, Department of Math- +C ematics and Informatics, Julianalaan 132, 2628 BL +C Delft, Phone 015-784568. +C +C 2. E.F. Kaasschieter, ``The solution of non-symmetric +C linear systems by bi-conjugate gradients or conjugate +C gradients squared,'' Delft University of Tech- +C nology Report 86-21, Department of Mathematics and +C Informatics, Julianalaan 132, 2628 BL Delft, +C Phone 015-784568. +C***ROUTINES CALLED MATVEC, MSOLVE, ISDCGS, DDOT, D1MACH +C***END PROLOGUE DCGS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), R0(N), P(N) + DOUBLE PRECISION Q(N), U(N), V1(N), V2(N), RWORK(*) + EXTERNAL MATVEC, MSOLVE +C +C Check some of the input data. +C***FIRST EXECUTABLE STATEMENT DCGS + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + TOLMIN = 500.0*D1MACH(3) + IF( TOL.LT.TOLMIN ) THEN + TOL = TOLMIN + IERR = 4 + ENDIF +C +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + V1(I) = R(I) - B(I) + 10 CONTINUE + CALL MSOLVE(N, V1, R, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C + IF( ISDCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, R0, P, Q, + $ U, V1, V2, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) + $ GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C Set initial values. +C + FUZZ = D1MACH(3)**2 + DO 20 I = 1, N + R0(I) = R(I) + 20 CONTINUE + RHONM1 = 1.0 +C +C ***** ITERATION LOOP ***** +C + DO 100 K=1,ITMAX + ITER = K +C +C Calculate coefficient BK and direction vectors U, V and P. + RHON = DDOT(N, R0, 1, R, 1) + IF( ABS(RHONM1).LT.FUZZ ) GOTO 998 + BK = RHON/RHONM1 + IF( ITER.EQ.1 ) THEN + DO 30 I = 1, N + U(I) = R(I) + P(I) = R(I) + 30 CONTINUE + ELSE + DO 40 I = 1, N + U(I) = R(I) + BK*Q(I) + V1(I) = Q(I) + BK*P(I) + 40 CONTINUE + DO 50 I = 1, N + P(I) = U(I) + BK*V1(I) + 50 CONTINUE + ENDIF +C +C Calculate coefficient AK, new iterate X, Q + CALL MATVEC(N, P, V2, NELT, IA, JA, A, ISYM) + CALL MSOLVE(N, V2, V1, NELT, IA, JA, A, ISYM, RWORK, IWORK) + SIGMA = DDOT(N, R0, 1, V1, 1) + IF( ABS(SIGMA).LT.FUZZ ) GOTO 999 + AK = RHON/SIGMA + AKM = -AK + DO 60 I = 1, N + Q(I) = U(I) + AKM*V1(I) + 60 CONTINUE + DO 70 I = 1, N + V1(I) = U(I) + Q(I) + 70 CONTINUE +C X = X - ak*V1. + CALL DAXPY( N, AKM, V1, 1, X, 1 ) +C -1 +C R = R - ak*M *A*V1 + CALL MATVEC(N, V1, V2, NELT, IA, JA, A, ISYM) + CALL MSOLVE(N, V2, V1, NELT, IA, JA, A, ISYM, RWORK, IWORK) + CALL DAXPY( N, AKM, V1, 1, R, 1 ) +C +C check stopping criterion. + IF( ISDCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, R0, P, Q, + $ U, V1, V2, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) + $ GO TO 200 +C +C Update RHO. + RHONM1 = RHON + 100 CONTINUE +C +C ***** end of loop ***** +C Stopping criterion not satisfied. + ITER = ITMAX + 1 + IERR = 2 + 200 RETURN +C +C Breakdown of method detected. + 998 IERR = 5 + RETURN +C +C Stagnation of method detected. + 999 IERR = 6 + RETURN +C------------- LAST LINE OF DCGS FOLLOWS ---------------------------- + END +*DECK DSDCGS + SUBROUTINE DSDCGS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSDCGS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSDCGS-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonally Scaled CGS Sparse Ax=b Solver. +C Routine to solve a linear system Ax = b using the +C BiConjugate Gradient Squared method with diagonal scaling. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(10), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(8*N) +C +C CALL DSDCGS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C This routine must calculate the residual from R = A*X - B. +C This is un-natural and hence expensive for this type of iter- +C ative method. ITOL=2 is *STRONGLY* recommended. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv time a vector is the pre- +C conditioning step. This is the *NATURAL* stopping for this +C iterative method and is *STRONGLY* recommended. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Breakdown of the method detected. +C $(r0,r) approximately 0.0$. +C IERR = 6 => Stagnation of the method detected. +C $(r0,v) approximately 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. LENW >= 8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the RWORK array. +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= 10. +C +C *Description: +C This routine performs preconditioned BiConjugate gradient +C method on the Non-Symmetric positive definite linear system +C Ax=b. The preconditioner is M = DIAG(A), the diagonal of the +C matrix A. This is the simplest of preconditioners and +C vectorizes very well. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See above. +C +C *See Also: +C DCGS, DLUBCG +C***REFERENCES 1. P. Sonneveld, ``CGS, a fast Lanczos-type solver +C for nonsymmetric linear systems'', Delft University +C of Technology Report 84-16, Department of Math- +C ematics and Informatics, Julianalaan 132, 2628 BL +C Delft, Phone 015-784568. +C +C 2. E.F. Kaasschieter, ``The solution of non-symmetric +C linear systems by bi-conjugate gradients or conjugate +C gradients squared,'' Delft University of Tech- +C nology Report 86-21, Department of Mathematics and +C Informatics, Julianalaan 132, 2628 BL Delft, +C Phone 015-784568. +C***ROUTINES CALLED DS2Y, DCHKW, DSDS, DCGS +C***END PROLOGUE DSDCGS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSDCGS + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the workspace. Compute the inverse of the +C diagonal of the matrix. + LOCIW = LOCIB +C + LOCDIN = LOCRB + LOCR = LOCDIN + N + LOCR0 = LOCR + N + LOCP = LOCR0 + N + LOCQ = LOCP + N + LOCU = LOCQ + N + LOCV1 = LOCU + N + LOCV2 = LOCV1 + N + LOCW = LOCV2 + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSDCGS', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCDIN + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCDIN)) +C +C Perform the Diagonally Scaled +C BiConjugate Gradient Squared algorithm. + CALL DCGS(N, B, X, NELT, IA, JA, A, ISYM, DSMV, + $ DSDI, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCR0), RWORK(LOCP), + $ RWORK(LOCQ), RWORK(LOCU), RWORK(LOCV1), + $ RWORK(LOCV2), RWORK(1), IWORK(1)) + RETURN +C------------- LAST LINE OF DSDCGS FOLLOWS ---------------------------- + END +*DECK DSLUCS + SUBROUTINE DSLUCS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSLUCS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSLUCS-D), +C Non-Symmetric Linear system, Sparse, +C Iterative incomplete LU Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU BiConjugate Gradient Sparse Ax=b solver. +C Routine to solve a linear system Ax = b using the +C BiConjugate Gradient method with Incomplete LU +C decomposition preconditioning. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+NU+4*N+2), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+NU+8*N) +C +C CALL DSLUCS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C This routine must calculate the residual from R = A*X - B. +C This is un-natural and hence expensive for this type of iter- +C ative method. ITOL=2 is *STRONGLY* recommended. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv time a vector is the pre- +C conditioning step. This is the *NATURAL* stopping for this +C iterative method and is *STRONGLY* recommended. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Breakdown of the method detected. +C $(r0,r) approximately 0.0$. +C IERR = 6 => Stagnation of the method detected. +C $(r0,v) approximately 0.0$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the +C number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+NU+8*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. +C LENIW >= NEL+NU+4*N+12. +C +C *Description: +C This routine is simply a driver for the DCGSN routine. It +C calls the DSILUS routine to set up the preconditioning and +C then calls DCGSN with the appropriate MATVEC, MTTVEC and +C MSOLVE, MTSOLV routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See above. +C +C *See Also: +C DCGS, DSDCGS +C***REFERENCES 1. P. Sonneveld, ``CGS, a fast Lanczos-type solver +C for nonsymmetric linear systems'', Delft University +C of Technology Report 84-16, Department of Math- +C ematics and Informatics, Julianalaan 132, 2628 BL +C Delft, Phone 015-784568. +C +C 2. E.F. Kaasschieter, ``The solution of non-symmetric +C linear systems by bi-conjugate gradients or conjugate +C gradients squared,'' Delft University of Tech- +C nology Report 86-21, Department of Mathematics and +C Informatics, Julianalaan 132, 2628 BL Delft, +C Phone 015-784568. +C***ROUTINES CALLED DS2Y, DCHKW, DSILUS, DCGS, DSMV, DSLUI +C***END PROLOGUE DSLUCS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSLUI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSLUCS + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements preconditioner ILU matrix. +C Then set up the work arrays. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagonal. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIL = LOCIB + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCUU = LOCDIN + N + LOCR = LOCUU + NU + LOCR0 = LOCR + N + LOCP = LOCR0 + N + LOCQ = LOCP + N + LOCU = LOCQ + N + LOCV1 = LOCU + N + LOCV2 = LOCV1 + N + LOCW = LOCV2 + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSLUCS', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCUU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCUU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Perform the incomplete LU preconditioned +C BiConjugate Gradient Squared algorithm. + CALL DCGS(N, B, X, NELT, IA, JA, A, ISYM, DSMV, + $ DSLUI, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCR0), RWORK(LOCP), + $ RWORK(LOCQ), RWORK(LOCU), RWORK(LOCV1), + $ RWORK(LOCV2), RWORK, IWORK ) + RETURN +C------------- LAST LINE OF DSLUCS FOLLOWS ---------------------------- + END +*DECK ISDCGS + FUNCTION ISDCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, R0, P, Q, U, + $ V1, V2, RWORK, IWORK, AK, BK, BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDCGS +C***REFER TO DCGS, DSDCGS, DSLUCS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDCGS-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Stop Test +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned BiConjugate Gradient Stop Test. +C This routine calculates the stop test for the BiConjugate +C Gradient iteration scheme. It returns a nonzero if the +C error estimate (the type of which is determined by ITOL) +C is less than the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER +C INTEGER IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), R0(N), P(N) +C DOUBLE PRECISION Q(N), U(N), V1(N), V2(N) +C DOUBLE PRECISION RWORK(USER DEFINED), AK, BK, BNRM, SOLNRM +C EXTERNAL MATVEC, MSOLVE +C +C IF( ISDCGS(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, ITOL, +C $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, R0, P, Q, U, V1, +C $ V2, RWORK, IWORK, AK, BK, BNRM, SOLNRM) .NE. 0 ) +C $ THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "LONG DESCRIPTION", in +C the SLAP routine DCGS for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C operation Y = A*X given A and X. The name of the MATVEC +C routine must be declared external in the calling program. +C The calling sequence of MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X upon +C return, X is an input vector. NELT, IA, JA, A and ISYM +C define the SLAP matrix data structure: see LONG DESCRIPTION, +C below. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for Z +C given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine +C must be declared external in the calling program. The +C calling sequence of MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. NELT, IA, JA, A +C and ISYM define the SLAP matrix data structure: see LONG +C DESCRIPTION, below. RWORK is a double precision array that +C can be used +C to pass necessary preconditioning information and/or +C workspace to MSOLVE. IWORK is an integer work array for the +C same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C This routine must calculate the residual from R = A*X - B. +C This is un-natural and hence expensive for this type of iter- +C ative method. ITOL=2 is *STRONGLY* recommended. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than tol, where M-inv time a vector is the pre- +C conditioning step. This is the *NATURAL* stopping for this +C iterative method and is *STRONGLY* recommended. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual r = b - Ax. +C R0 :WORK Double Precision R0(N). +C P :DUMMY Double Precision P(N). +C Q :DUMMY Double Precision Q(N). +C U :DUMMY Double Precision U(N). +C V1 :DUMMY Double Precision V1(N). +C V2 :WORK Double Precision V2(N). +C If ITOL.eq.1 then V2 is used to hold A * X - B on every call. +C If ITOL.eq.2 then V2 is used to hold M-inv * B on the first +C call. +C If ITOL.eq.11 then V2 is used to X - SOLN. +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE. +C AK :IN Double Precision. +C Current iterate BiConjugate Gradient iteration parameter. +C BK :IN Double Precision. +C Current iterate BiConjugate Gradient iteration parameter. +C BNRM :INOUT Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C Calculated only on the first call. +C SOLNRM :INOUT Double Precision. +C 2-Norm of the true solution, SOLN. Only computed and used +C if ITOL = 11. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C***REFERENCES (NONE) +C***ROUTINES CALLED MATVEC, MSOLVE, DNRM2 +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDCGS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(1) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), R0(N), P(N) + DOUBLE PRECISION Q(N), U(N), V1(N), V2(N), RWORK(1) + DOUBLE PRECISION AK, BK, BNRM, SOLNRM + COMMON /SOLBLK/ SOLN(1) + EXTERNAL MATVEC, MSOLVE +C +C***FIRST EXECUTABLE STATEMENT ISDCGS + ISDCGS = 0 +C + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + CALL MATVEC(N, X, V2, NELT, IA, JA, A, ISYM ) + DO 5 I = 1, N + V2(I) = V2(I) - B(I) + 5 CONTINUE + ERR = DNRM2(N, V2, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, B, V2, NELT, IA, JA, A, ISYM, RWORK, IWORK) + BNRM = DNRM2(N, V2, 1) + ENDIF + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF(ITER .EQ. 0) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + V2(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, V2, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C +C Print the error and Coeficients AK, BK on each step, +C if desired. + IF(IUNIT .NE. 0) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) N, ITOL + ENDIF + WRITE(IUNIT,1010) ITER, ERR, AK, BK + ENDIF + IF(ERR .LE. TOL) ISDCGS = 1 +C + RETURN + 1000 FORMAT(' Preconditioned BiConjugate Gradient Squared for ', + $ 'N, ITOL = ',I5, I5, + $ /' ITER',' Error Estimate',' Alpha', + $ ' Beta') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7,1X,E16.7) +C------------- LAST LINE OF ISDCGS FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dgmres.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dgmres.f new file mode 100644 index 0000000000..b159b60d49 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dgmres.f @@ -0,0 +1,2671 @@ +*DECK DGMRES + SUBROUTINE DGMRES(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, SB, SX, + $ RGWK, LRGW, IGWK, LIGW, RWORK, IWORK ) +C***BEGIN PROLOGUE DGMRES +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DGMRES-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Preconditioned GMRES iterative sparse Ax=b solver. +C This routine uses the generalized minimum residual +C (GMRES) method with preconditioning to solve +C non-symmetric linear systems of the form: A*x = b. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER IERR, IUNIT, LRGW, LIGW, IGWK(LIGW) +C INTEGER IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, SB(N), SX(N) +C DOUBLE PRECISION RGWK(LRGW), RWORK(USER DEFINED) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DGMRES(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, +C $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, SB, SX, +C $ RGWK, LRGW, IGWK, LIGW, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for the solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C Y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C where N is the number of unknowns, Y is the product A*X +C upon return, X is an input vector, and NELT is the number of +C non-zeros in the SLAP IA, JA, A storage for the matrix A. +C ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of the routine which solves a linear system Mz = r for +C z given r with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays. The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate the type of convergence criterion used. +C ITOL=0 Means the iteration stops when the test described +C below on the residual RL is satisfied. This is +C the "Natural Stopping Criteria" for this routine. +C Other values of ITOL cause extra, otherwise +C unnecessary, computation per iteration and are +C therefore much less efficient. See ISDGMR (the +C stop test routine) for more information. +C ITOL=1 Means the iteration stops when the first test +C described below on the residual RL is satisfied, +C and there is either right or no preconditioning +C being used. +C ITOL=2 Implies that the user is using left +C preconditioning, and the second stopping criterion +C below is used. +C ITOL=3 Means the iteration stops when the third test +C described below on Minv*Residual is satisfied, and +C there is either left or no preconditioning begin +C used. +C ITOL=11 is often useful for checking and comparing +C different routines. For this case, the user must +C supply the "exact" solution or a very accurate +C approximation (one with an error much less than +C TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the +C difference between the iterative approximation and +C the user-supplied solution divided by the 2-norm +C of the user-supplied solution is less than TOL. +C Note that this requires the user to set up the +C "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling +C routine. The routine with this declaration should +C be loaded before the stop test so that the correct +C length is used by the loader. This procedure is +C not standard Fortran and may not work correctly on +C your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 +C then this common block is indeed standard Fortran. +C TOL :INOUT Double Precision. +C Convergence criterion, as described below. If TOL is set +C to zero on input, then a default value of 500*(the smallest +C positive magnitude, machine epsilon) is used. +C ITMAX :DUMMY Integer. +C Maximum number of iterations in most SLAP routines. In +C this routine this does not make sense. The maximum number +C of iterations here is given by ITMAX = MAXL*(NRMAX+1). +C See IGWK for definitions of MAXL and NRMAX. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. Letting norm() denote the Euclidean +C norm, ERR is defined as follows.. +C +C If ITOL=0, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C for right or no preconditioning, and +C ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C for left preconditioning. +C If ITOL=1, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C since right or no preconditioning +C being used. +C If ITOL=2, then ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C since left preconditioning is being +C used. +C If ITOL=3, then ERR = Max |(Minv*(B-A*X(L)))(i)/x(i)| +C i=1,n +C If ITOL=11, then ERR = norm(SB*(X(L)-SOLN))/norm(SB*SOLN). +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated for +C RGWK or IGWK. +C IERR = 2 => Routine Dgmres failed to reduce the norm +C of the current residual on its last call, +C and so the iteration has stalled. In +C this case, X equals the last computed +C approximation. The user must either +C increase MAXL, or choose a different +C initial guess. +C IERR =-1 => Insufficient length for RGWK array. +C IGWK(6) contains the required minimum +C length of the RGWK array. +C IERR =-2 => Inconsistent ITOL and JPRE values. +C For IERR <= 2, RGWK(1) = RHOL, which is the norm on the +C left-hand-side of the relevant stopping test defined +C below associated with the residual for the current +C approximation X(L). +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C SB :IN Double Precision SB(N). +C Array of length N containing scale factors for the right +C hand side vector B. If JSCAL.eq.0 (see below), SB need +C not be supplied. +C SX :IN Double Precision SX(N). +C Array of length N containing scale factors for the solution +C vector X. If JSCAL.eq.0 (see below), SX need not be +C supplied. SB and SX can be the same array in the calling +C program if desired. +C RGWK :INOUT Double Precision RGWK(LRGW). +C Double Precision array of size at least +C 1 + N*(MAXL+6) + MAXL*(MAXL+3) +C used for work space by DGMRES. See below for definition of +C MAXL. +C On return, RGWK(1) = RHOL. See IERR for definition of RHOL. +C LRGW :IN Integer. +C Length of the double precision workspace, RGWK. +C LRGW > 1 + N*(MAXL+6) + MAXL*(MAXL+3). +C For the default values, RGWK has size at least 131 + 16*N. +C IGWK :INOUT Integer IGWK(LIGW). +C The following IGWK parameters should be set by the user +C before calling this routine. +C IGWK(1) = MAXL. Maximum dimension of Krylov subspace in +C which X - X0 is to be found (where, X0 is the initial +C guess). The default value of MAXL is 10. +C IGWK(2) = KMP. Maximum number of previous Krylov basis +C vectors to which each new basis vector is made orthogonal. +C The default value of KMP is MAXL. +C IGWK(3) = JSCAL. Flag indicating whether the scaling +C arrays SB and SX are to be used. +C JSCAL = 0 => SB and SX are not used and the algorithm +C will perform as if all SB(I) = 1 and SX(I) = 1. +C JSCAL = 1 => Only SX is used, and the algorithm +C performs as if all SB(I) = 1. +C JSCAL = 2 => Only SB is used, and the algorithm +C performs as if all SX(I) = 1. +C JSCAL = 3 => Both SB and SX are used. +C IGWK(4) = JPRE. Flag indicating whether preconditioning +C is being used. +C JPRE = 0 => There is no preconditioning. +C JPRE > 0 => There is preconditioning on the right +C only, and the solver will call routine MSOLVE. +C JPRE < 0 => There is preconditioning on the left +C only, and the solver will call routine MSOLVE. +C IGWK(5) = NRMAX. Maximum number of restarts of the +C Krylov iteration. The default value of NRMAX = 10. +C if IWORK(5) = -1, then no restarts are performed (in +C this case, NRMAX is set to zero internally). +C The following IWORK parameters are diagnostic information +C made available to the user after this routine completes. +C IGWK(6) = MLWK. Required minimum length of RGWK array. +C IGWK(7) = NMS. The total number of calls to MSOLVE. +C LIGW :IN Integer. +C Length of the integer workspace, IGWK. LIGW >= 20. +C +C *Description: +C DGMRES solves a linear system A*X = B rewritten in the form: +C +C (SB*A*(M-inverse)*(SX-inverse))*(SX*M*X) = SB*B, +C +C with right preconditioning, or +C +C (SB*(M-inverse)*A*(SX-inverse))*(SX*X) = SB*(M-inverse)*B, +C +C with left preconditioning, where A is an N-by-N double +C precision matrix, +C X and B are N-vectors, SB and SX are diagonal scaling +C matrices, and M is a preconditioning matrix. It uses +C preconditioned Krylov subpace methods based on the +C generalized minimum residual method (GMRES). This routine +C optionally performs either the full orthogonalization +C version of the GMRES algorithm or an incomplete variant of +C it. Both versions use restarting of the linear iteration by +C default, although the user can disable this feature. +C +C The GMRES algorithm generates a sequence of approximations +C X(L) to the true solution of the above linear system. The +C convergence criteria for stopping the iteration is based on +C the size of the scaled norm of the residual R(L) = B - +C A*X(L). The actual stopping test is either: +C +C norm(SB*(B-A*X(L))) .le. TOL*norm(SB*B), +C +C for right preconditioning, or +C +C norm(SB*(M-inverse)*(B-A*X(L))) .le. +C TOL*norm(SB*(M-inverse)*B), +C +C for left preconditioning, where norm() denotes the euclidean +C norm, and TOL is a positive scalar less than one input by +C the user. If TOL equals zero when DGMRES is called, then a +C default value of 500*(the smallest positive magnitude, +C machine epsilon) is used. If the scaling arrays SB and SX +C are used, then ideally they should be chosen so that the +C vectors SX*X(or SX*M*X) and SB*B have all their components +C approximately equal to one in magnitude. If one wants to +C use the same scaling in X and B, then SB and SX can be the +C same array in the calling program. +C +C The following is a list of the other routines and their +C functions used by DGMRES: +C DPIGMR Contains the main iteration loop for GMRES. +C DORTH Orthogonalizes a new vector against older basis vects. +C DHEQR Computes a QR decomposition of a Hessenberg matrix. +C DHELS Solves a Hessenberg least-squares system, using QR +C factors. +C DRLCAL Computes the scaled residual RL. +C DXLCAL Computes the solution XL. +C ISDGMR User-replaceable stopping routine. +C +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK in some fashion. The SLAP +C routines DSDCG and DSICCG are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C***REFERENCES 1. Peter N. Brown and A. C. Hindmarsh, +C "Reduced Storage Matrix Methods In Stiff ODE +C Systems," LLNL report UCRL-95088, Rev. 1, +C June 1987. +C***ROUTINES CALLED DPIGMR, DORTH, DHEQR, DHELS, DRCAL, DXLCAL, +C ISDGMR, DNRM2, DDOT, DAXPY, DSCAL, IDAMAX, D1MACH. +C***END PROLOGUE DGMRES +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, IUNIT, LRGW, LIGW, IGWK(LIGW) + INTEGER IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, SB(N), SX(N) + DOUBLE PRECISION RGWK(LRGW), RWORK(*) + EXTERNAL MATVEC, MSOLVE, D1MACH + INTEGER JPRE, KMP, MAXL, NMS, MAXLP1, NMSL, NRSTS, NRMAX + INTEGER I, IFLAG, LR, LDL, LHES, LGMR, LQ, LV, LW + DOUBLE PRECISION BNRM, RHOL, SUM +C +C***FIRST EXECUTABLE STATEMENT DGMRES + IERR = 0 +C ------------------------------------------------------------------ +C Load method parameters with user values or defaults. +C ------------------------------------------------------------------ + MAXL = IGWK(1) + IF (MAXL .EQ. 0) MAXL = 10 + IF (MAXL .GT. N) MAXL = N + KMP = IGWK(2) + IF (KMP .EQ. 0) KMP = MAXL + IF (KMP .GT. MAXL) KMP = MAXL + JSCAL = IGWK(3) + JPRE = IGWK(4) +C Check for consistent values of ITOL and JPRE. + IF( ITOL.EQ.1 .AND. JPRE.LT.0 ) GOTO 650 + IF( ITOL.EQ.2 .AND. JPRE.GE.0 ) GOTO 650 + NRMAX = IGWK(5) + IF( NRMAX.EQ.0 ) NRMAX = 10 +C If NRMAX .eq. -1, then set NRMAX = 0 to turn off restarting. + IF( NRMAX.EQ.-1 ) NRMAX = 0 +C If input value of TOL is zero, set it to its default value. + IF( TOL.EQ.0.0D0 ) TOL = 500.0*D1MACH(3) +C +C Initialize counters. + ITER = 0 + NMS = 0 + NRSTS = 0 +C ------------------------------------------------------------------ +C Form work array segment pointers. +C ------------------------------------------------------------------ + MAXLP1 = MAXL + 1 + LV = 1 + LR = LV + N*MAXLP1 + LHES = LR + N + 1 + LQ = LHES + MAXL*MAXLP1 + LDL = LQ + 2*MAXL + LW = LDL + N + LXL = LW + N + LZ = LXL + N +C +C Load igwk(6) with required minimum length of the rgwk array. + IGWK(6) = LZ + N - 1 + IF( LZ+N-1.GT.LRGW ) GOTO 640 +C ------------------------------------------------------------------ +C Calculate scaled-preconditioned norm of RHS vector b. +C ------------------------------------------------------------------ + IF (JPRE .LT. 0) THEN + CALL MSOLVE(N, B, RGWK(LR), NELT, IA, JA, A, ISYM, + $ RWORK, IWORK) + NMS = NMS + 1 + ELSE + CALL DCOPY(N, B, 1, RGWK(LR), 1) + ENDIF + IF( JSCAL.EQ.2 .OR. JSCAL.EQ.3 ) THEN + SUM = 0.D0 + DO 10 I = 1,N + SUM = SUM + (RGWK(LR-1+I)*SB(I))**2 + 10 CONTINUE + BNRM = DSQRT(SUM) + ELSE + BNRM = DNRM2(N,RGWK(LR),1) + ENDIF +C ------------------------------------------------------------------ +C Calculate initial residual. +C ------------------------------------------------------------------ + CALL MATVEC(N, X, RGWK(LR), NELT, IA, JA, A, ISYM) + DO 50 I = 1,N + RGWK(LR-1+I) = B(I) - RGWK(LR-1+I) + 50 CONTINUE +C ------------------------------------------------------------------ +C If performing restarting, then load the residual into the +C correct location in the Rgwk array. +C ------------------------------------------------------------------ + 100 CONTINUE + IF( NRSTS.GT.NRMAX ) GOTO 610 + IF( NRSTS.GT.0 ) THEN +C Copy the curr residual to different loc in the Rgwk array. + CALL DCOPY(N, RGWK(LDL), 1, RGWK(LR), 1) + ENDIF +C ------------------------------------------------------------------ +C Use the DPIGMR algorithm to solve the linear system A*Z = R. +C ------------------------------------------------------------------ + CALL DPIGMR(N, RGWK(LR), SB, SX, JSCAL, MAXL, MAXLP1, KMP, + $ NRSTS, JPRE, MATVEC, MSOLVE, NMSL, RGWK(LZ), RGWK(LV), + $ RGWK(LHES), RGWK(LQ), LGMR, RWORK, IWORK, RGWK(LW), + $ RGWK(LDL), RHOL, NRMAX, B, BNRM, X, RGWK(LXL), ITOL, + $ TOL, NELT, IA, JA, A, ISYM, IUNIT, IFLAG, ERR) + ITER = ITER + LGMR + NMS = NMS + NMSL +C +C Increment X by the current approximate solution Z of A*Z = R. +C + LZM1 = LZ - 1 + DO 110 I = 1,N + X(I) = X(I) + RGWK(LZM1+I) + 110 CONTINUE + IF( IFLAG.EQ.0 ) GOTO 600 + IF( IFLAG.EQ.1 ) THEN + NRSTS = NRSTS + 1 + GOTO 100 + ENDIF + IF( IFLAG.EQ.2 ) GOTO 620 +C ------------------------------------------------------------------ +C All returns are made through this section. +C ------------------------------------------------------------------ +C The iteration has converged. +C + 600 CONTINUE + IGWK(7) = NMS + RGWK(1) = RHOL + IERR = 0 + RETURN +C +C Max number((NRMAX+1)*MAXL) of linear iterations performed. + 610 CONTINUE + IGWK(7) = NMS + RGWK(1) = RHOL + IERR = 1 + RETURN +C +C GMRES failed to reduce last residual in MAXL iterations. +C The iteration has stalled. + 620 CONTINUE + IGWK(7) = NMS + RGWK(1) = RHOL + IERR = 2 + RETURN +C Error return. Insufficient length for Rgwk array. + 640 CONTINUE + ERR = TOL + IERR = -1 + RETURN +C Error return. Inconsistent ITOL and JPRE values. + 650 CONTINUE + ERR = TOL + IERR = -2 + RETURN +C------------- LAST LINE OF DGMRES FOLLOWS ---------------------------- + END +*DECK DSDGMR + SUBROUTINE DSDGMR(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C***BEGIN PROLOGUE DSDGMR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSDGMR-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Diagonally scaled GMRES iterative sparse Ax=b solver. +C This routine uses the generalized minimum residual +C (GMRES) method with diagonal scaling to solve possibly +C non-symmetric linear systems of the form: A*x = b. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE +C INTEGER ITOL, ITMAX, IERR, IUNIT, LENW, IWORK(LENIW), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR +C DOUBLE PRECISION RWORK(LENW) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DSDGMR(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, +C $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, +C $ RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize against. +C Must be greater than 1. +C ITOL :IN Integer. +C Flag to indicate the type of convergence criterion used. +C ITOL=0 Means the iteration stops when the test described +C below on the residual RL is satisfied. This is +C the "Natural Stopping Criteria" for this routine. +C Other values of ITOL cause extra, otherwise +C unnecessary, computation per iteration and are +C therefore much less efficient. See ISDGMR (the +C stop test routine) for more information. +C ITOL=1 Means the iteration stops when the first test +C described below on the residual RL is satisfied, +C and there is either right or no preconditioning +C being used. +C ITOL=2 Implies that the user is using left +C preconditioning, and the second stopping criterion +C below is used. +C ITOL=3 Means the iteration stops when the third test +C described below on Minv*Residual is satisfied, and +C there is either left or no preconditioning begin +C used. +C ITOL=11 is often useful for checking and comparing +C different routines. For this case, the user must +C supply the "exact" solution or a very accurate +C approximation (one with an error much less than +C TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the +C difference between the iterative approximation and +C the user-supplied solution divided by the 2-norm +C of the user-supplied solution is less than TOL. +C Note that this requires the user to set up the +C "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling +C routine. The routine with this declaration should +C be loaded before the stop test so that the correct +C length is used by the loader. This procedure is +C not standard Fortran and may not work correctly on +C your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 +C then this common block is indeed standard Fortran. +C TOL :INOUT Double Precision. +C Convergence criterion, as described below. If TOL is set +C to zero on input, then a default value of 500*(the smallest +C positive magnitude, machine epsilon) is used. +C ITMAX :IN Integer. +C Maximum number of iterations. This routine uses the default +C of NRMAX = ITMAX/NSAVE to determine the when each restart +C oshould ccur. See the description of NRMAX and MAXL in +C DGMRES for a full and frightfully interesting discussion of +C this topic. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. Letting norm() denote the Euclidean +C norm, ERR is defined as follows... +C If ITOL=0, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C for right or no preconditioning, and +C ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C for left preconditioning. +C If ITOL=1, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C since right or no preconditioning +C being used. +C If ITOL=2, then ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C since left preconditioning is being +C used. +C If ITOL=3, then ERR = Max |(Minv*(B-A*X(L)))(i)/x(i)| +C i=1,n +C If ITOL=11, then ERR = norm(SB*(X(L)-SOLN))/norm(SB*SOLN). +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated for +C RGWK or IGWK. +C IERR = 2 => Routine DPIGMR failed to reduce the norm +C of the current residual on its last call, +C and so the iteration has stalled. In +C this case, X equals the last computed +C approximation. The user must either +C increase MAXL, or choose a different +C initial guess. +C IERR =-1 => Insufficient length for RGWK array. +C IGWK(6) contains the required minimum +C length of the RGWK array. +C IERR =-2 => Inconsistent ITOL and JPRE values. +C For IERR <= 2, RGWK(1) = RHOL, which is the norm on the +C left-hand-side of the relevant stopping test defined +C below associated with the residual for the current +C approximation X(L). +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array of size LENW. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= 1 + N*(NSAVE+7) + NSAVE*(NSAVE+3). +C For the recommended values of NSAVE (10), RWORK has size at +C least 131 + 17*N. +C IWORK :INOUT Integer IWORK(USER DEFINED >= 30). +C Used to hold pointers into the RWORK array. +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace IWORK. LENIW >= 30. +C +C *Description: +C DSDGMR solves a linear system A*X = B rewritten in the form: +C +C (SB*A*(M-inverse)*(SX-inverse))*(SX*M*X) = SB*B, +C +C with right preconditioning, or +C +C (SB*(M-inverse)*A*(SX-inverse))*(SX*X) = SB*(M-inverse)*B, +C +C with left preconditioning, where a is an n-by-n double +C precision matrix, +C X and B are N-vectors, SB and SX are diagonal scaling +C matrices, and M is the diagonal of A. It uses +C preconditioned Krylov subpace methods based on the +C generalized minimum residual method (GMRES). This routine +C is a driver routine which assumes a SLAP matrix data +C structure and sets up the necessary information to do +C diagonal preconditioning and calls the main GMRES routine +C DGMRES for the solution of the linear system. DGMRES +C optionally performs either the full orthogonalization +C version of the GMRES algorithm or an incomplete variant of +C it. Both versions use restarting of the linear iteration by +C default, although the user can disable this feature. +C +C The GMRES algorithm generates a sequence of approximations +C X(L) to the true solution of the above linear system. The +C convergence criteria for stopping the iteration is based on +C the size of the scaled norm of the residual R(L) = B - +C A*X(L). The actual stopping test is either: +C +C norm(SB*(B-A*X(L))) .le. TOL*norm(SB*B), +C +C for right preconditioning, or +C +C norm(SB*(M-inverse)*(B-A*X(L))) .le. +C TOL*norm(SB*(M-inverse)*B), +C +C for left preconditioning, where norm() denotes the euclidean +C norm, and TOL is a positive scalar less than one input by +C the user. If TOL equals zero when DSDGMR is called, then a +C default value of 500*(the smallest positive magnitude, +C machine epsilon) is used. If the scaling arrays SB and SX +C are used, then ideally they should be chosen so that the +C vectors SX*X(or SX*M*X) and SB*B have all their components +C approximately equal to one in magnitude. If one wants to +C use the same scaling in X and B, then SB and SX can be the +C same array in the calling program. +C +C The following is a list of the other routines and their +C functions used by GMRES: +C DGMRES Contains the matrix structure independent driver +C routine for GMRES. +C DPIGMR Contains the main iteration loop for GMRES. +C DORTH Orthogonalizes a new vector against older basis vects. +C DHEQR Computes a QR decomposition of a Hessenberg matrix. +C DHELS Solves a Hessenberg least-squares system, using QR +C factors. +C RLCALC Computes the scaled residual RL. +C XLCALC Computes the solution XL. +C ISDGMR User-replaceable stopping routine. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C***REFERENCES 1. Peter N. Brown and A. C. Hindmarsh, +C "Reduced Storage Matrix Methods In Stiff ODE +C Systems," LLNL report UCRL-95088, Rev. 1, +C June 1987. +C***ROUTINES CALLED DS2Y, DCHKW, DSDS, DGMRES +C***END PROLOGUE DSDGMR +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL + INTEGER ITMAX, ITER, IERR, IUNIT, LENW, LENIW, IWORK(LENIW) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSDGMR + IERR = 0 + ERR = 0.0 + IF( NSAVE.LE.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the workspace. We assume MAXL=KMP=NSAVE. +C Compute the inverse of the diagonal of the matrix. + LOCIGW = LOCIB + LOCIW = LOCIGW + 20 +C + LOCDIN = LOCRB + LOCRGW = LOCDIN + N + LOCW = LOCRGW + 1+N*(NSAVE+6)+NSAVE*(NSAVE+3) +C + IWORK(4) = LOCDIN + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Check the workspace allocations. + CALL DCHKW( 'DSDGMR', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCDIN)) +C +C Perform the Diagonaly Scaled Generalized Minimum +C Residual iteration algorithm. The following DGMRES +C defaults are used MAXL = KMP = NSAVE, JSCAL = 0, +C JPRE = -1, NRMAX = ITMAX/NSAVE + IWORK(LOCIGW ) = NSAVE + IWORK(LOCIGW+1) = NSAVE + IWORK(LOCIGW+2) = 0 + IWORK(LOCIGW+3) = -1 + IWORK(LOCIGW+4) = ITMAX/NSAVE + MYITOL = 0 +C + CALL DGMRES( N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSDI, + $ MYITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, RWORK, + $ RWORK(LOCRGW), LENW-LOCRGW, IWORK(LOCIGW), 20, + $ RWORK, IWORK ) +C + IF( ITER.GT.ITMAX ) IERR = 2 + RETURN +C------------- LAST LINE OF DSDGMR FOLLOWS ---------------------------- + END +*DECK DSLUGM + SUBROUTINE DSLUGM(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C***BEGIN PROLOGUE DSLUGM +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLUGM-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Incomplete LU GMRES iterative sparse Ax=b solver. +C This routine uses the generalized minimum residual +C (GMRES) method with incomplete LU factorization for +C preconditioning to solve possibly non-symmetric linear +C systems of the form: Ax = b. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE +C INTEGER ITOL, ITMAX, IERR, IUNIT, LENW, IWORK(LENIW), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, SB(N), SX(N) +C DOUBLE PRECISION RWORK(LENW) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DSLUGM(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, +C $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, +C $ RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize against. +C Must be greater than 1. +C ITOL :IN Integer. +C Flag to indicate the type of convergence criterion used. +C ITOL=0 Means the iteration stops when the test described +C below on the residual RL is satisfied. This is +C the "Natural Stopping Criteria" for this routine. +C Other values of ITOL cause extra, otherwise +C unnecessary, computation per iteration and are +C therefore much less efficient. See ISDGMR (the +C stop test routine) for more information. +C ITOL=1 Means the iteration stops when the first test +C described below on the residual RL is satisfied, +C and there is either right or no preconditioning +C being used. +C ITOL=2 Implies that the user is using left +C preconditioning, and the second stopping criterion +C below is used. +C ITOL=3 Means the iteration stops when the third test +C described below on Minv*Residual is satisfied, and +C there is either left or no preconditioning begin +C used. +C ITOL=11 is often useful for checking and comparing +C different routines. For this case, the user must +C supply the "exact" solution or a very accurate +C approximation (one with an error much less than +C TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the +C difference between the iterative approximation and +C the user-supplied solution divided by the 2-norm +C of the user-supplied solution is less than TOL. +C Note that this requires the user to set up the +C "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling +C routine. The routine with this declaration should +C be loaded before the stop test so that the correct +C length is used by the loader. This procedure is +C not standard Fortran and may not work correctly on +C your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 +C then this common block is indeed standard Fortran. +C TOL :INOUT Double Precision. +C Convergence criterion, as described below. If TOL is set +C to zero on input, then a default value of 500*(the smallest +C positive magnitude, machine epsilon) is used. +C ITMAX :IN Integer. +C Maximum number of iterations. This routine uses the default +C of NRMAX = ITMAX/NSAVE to determine the when each restart +C should occur. See the description of NRMAX and MAXL in +C DGMRES for a full and frightfully interesting discussion of +C this topic. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. Letting norm() denote the Euclidean +C norm, ERR is defined as follows... +C If ITOL=0, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C for right or no preconditioning, and +C ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C for left preconditioning. +C If ITOL=1, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C since right or no preconditioning +C being used. +C If ITOL=2, then ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C since left preconditioning is being +C used. +C If ITOL=3, then ERR = Max |(Minv*(B-A*X(L)))(i)/x(i)| +C i=1,n +C If ITOL=11, then ERR = norm(SB*(X(L)-SOLN))/norm(SB*SOLN). +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated for +C RGWK or IGWK. +C IERR = 2 => Routine DPIGMR failed to reduce the norm +C of the current residual on its last call, +C and so the iteration has stalled. In +C this case, X equals the last computed +C approximation. The user must either +C increase MAXL, or choose a different +C initial guess. +C IERR =-1 => Insufficient length for RGWK array. +C IGWK(6) contains the required minimum +C length of the RGWK array. +C IERR =-2 => Inconsistent ITOL and JPRE values. +C For IERR <= 2, RGWK(1) = RHOL, which is the norm on the +C left-hand-side of the relevant stopping test defined +C below associated with the residual for the current +C approximation X(L). +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array of size LENW. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= 1 + N*(NSAVE+7) + NSAVE*(NSAVE+3)+NEL+NU. +C For the recommended values, RWORK +C has size at least 131 + 17*N + NEL + NU. Where NEL is the +C number of non- zeros in the lower triangle of the matrix +C (including the diagonal). NU is the number of nonzeros in +C the upper triangle of the matrix (including the diagonal). +C IWORK :INOUT Integer IWORK(LENIW). +C Used to hold pointers into the RWORK array. +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. +C LENIW >= NEL+NU+4*N+32. +C +C *Description: +C DSLUGM solves a linear system A*X = B rewritten in the form: +C +C (SB*A*(M-inverse)*(SX-inverse))*(SX*M*X) = SB*B, +C +C with right preconditioning, or +C +C (SB*(M-inverse)*A*(SX-inverse))*(SX*X) = SB*(M-inverse)*B, +C +C with left preconditioning, where a is an n-by-n double +C precision matrix, +C X and B are N-vectors, SB and SX are diagonal scaling +C matrices, and M is the Incomplete LU factorization of A. It +C uses preconditioned Krylov subpace methods based on the +C generalized minimum residual method (GMRES). This routine +C is a driver routine which assumes a SLAP matrix data +C structure and sets up the necessary information to do +C diagonal preconditioning and calls the main GMRES routine +C DGMRES for the solution of the linear system. DGMRES +C optionally performs either the full orthogonalization +C version of the GMRES algorithm or an incomplete variant of +C it. Both versions use restarting of the linear iteration by +C default, although the user can disable this feature. +C +C The GMRES algorithm generates a sequence of approximations +C X(L) to the true solution of the above linear system. The +C convergence criteria for stopping the iteration is based on +C the size of the scaled norm of the residual R(L) = B - +C A*X(L). The actual stopping test is either: +C +C norm(SB*(B-A*X(L))) .le. TOL*norm(SB*B), +C +C for right preconditioning, or +C +C norm(SB*(M-inverse)*(B-A*X(L))) .le. +C TOL*norm(SB*(M-inverse)*B), +C +C for left preconditioning, where norm() denotes the euclidean +C norm, and TOL is a positive scalar less than one input by +C the user. If TOL equals zero when DSLUGM is called, then a +C default value of 500*(the smallest positive magnitude, +C machine epsilon) is used. If the scaling arrays SB and SX +C are used, then ideally they should be chosen so that the +C vectors SX*X(or SX*M*X) and SB*B have all their components +C approximately equal to one in magnitude. If one wants to +C use the same scaling in X and B, then SB and SX can be the +C same array in the calling program. +C +C The following is a list of the other routines and their +C functions used by GMRES: +C DGMRES Contains the matrix structure independent driver +C routine for GMRES. +C DPIGMR Contains the main iteration loop for GMRES. +C DORTH Orthogonalizes a new vector against older basis vects. +C DHEQR Computes a QR decomposition of a Hessenberg matrix. +C DHELS Solves a Hessenberg least-squares system, using QR +C factors. +C RLCALC Computes the scaled residual RL. +C XLCALC Computes the solution XL. +C ISDGMR User-replaceable stopping routine. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C***REFERENCES 1. Peter N. Brown and A. C. Hindmarsh, +C "Reduced Storage Matrix Methods In Stiff ODE +C Systems," LLNL report UCRL-95088, Rev. 1, +C June 1987. +C***ROUTINES CALLED DS2Y, DCHKW, DSILUS, DGMRES, DSMV, DSLUI +C***END PROLOGUE DSLUGM +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL + INTEGER ITMAX, ITER, IERR, IUNIT, LENW, LENIW, IWORK(LENIW) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSLUI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSLUGM + IERR = 0 + ERR = 0.0 + IF( NSAVE.LE.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements preconditioner ILU matrix. +C Then set up the work arrays. We assume MAXL=KMP=NSAVE. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagonal. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIGW = LOCIB + LOCIL = LOCIGW + 20 + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCU = LOCDIN + N + LOCRGW = LOCU + NU + LOCW = LOCRGW + 1+N*(NSAVE+6)+NSAVE*(NSAVE+3) +C +C Check the workspace allocations. + CALL DCHKW( 'DSLUGM', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Perform the Incomplet LU Preconditioned Generalized Minimum +C Residual iteration algorithm. The following DGMRES +C defaults are used MAXL = KMP = NSAVE, JSCAL = 0, +C JPRE = -1, NRMAX = ITMAX/NSAVE + IWORK(LOCIGW ) = NSAVE + IWORK(LOCIGW+1) = NSAVE + IWORK(LOCIGW+2) = 0 + IWORK(LOCIGW+3) = -1 + IWORK(LOCIGW+4) = ITMAX/NSAVE + MYITOL = 0 +C + CALL DGMRES( N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSLUI, + $ MYITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, RWORK, + $ RWORK(LOCRGW), LENW-LOCRGW, IWORK(LOCIGW), 20, + $ RWORK, IWORK ) +C + IF( ITER.GT.ITMAX ) IERR = 2 + RETURN +C------------- LAST LINE OF DSLUGM FOLLOWS ---------------------------- + END +*DECK DHELS + SUBROUTINE DHELS(A, LDA, N, Q, B) +C***BEGIN PROLOGUE DHEQR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DHEQR-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine is extraced from the LINPACK routine SGESL with +C changes due to the fact that A is an upper Hessenberg +C matrix. +C +C DHELS solves the least squares problem: +C +C MIN(B-A*X,B-A*X) +C +C using the factors computed by DHEQR. +C +C *Usage: +C INTEGER LDA, N +C DOUBLE PRECISION A(LDA,1), B(1), Q(1) +C +C CALL DHELS(A, LDA, N, Q, B) +C +C *Arguments: +C A :IN Double Precision A(LDA,N) +C The output from DHEQR which contains the upper +C triangular factor R in the QR decomposition of A. +C LDA :IN Integer +C The leading dimension of the array A. +C N :IN Integer +C A is originally an (N+1) by N matrix. +C Q :IN Double Precision Q(2*N) +C The coefficients of the N givens rotations +C used in the QR factorization of A. +C B :INOUT Double Precision B(N+1) +C On input, B is the right hand side vector. +C On output, B is the solution vector X. +C *See Also: +C DGMRES +C +C***ROUTINES CALLED DAXPY +C***END PROLOGUE DHEQR +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER LDA, N + DOUBLE PRECISION A(LDA,1), B(1), Q(1) +C +C Local Variables. +C + INTEGER IQ, K, KB, KP1 + DOUBLE PRECISION C, S, T, T1, T2 +C +C minimize(B-A*X,B-A*X). First form Q*B. +C + DO 20 K = 1, N + KP1 = K + 1 + IQ = 2*(K-1) + 1 + C = Q(IQ) + S = Q(IQ+1) + T1 = B(K) + T2 = B(KP1) + B(K) = C*T1 - S*T2 + B(KP1) = S*T1 + C*T2 + 20 CONTINUE +C +C Now solve R*X = Q*B. +C + DO 40 KB = 1, N + K = N + 1 - KB + B(K) = B(K)/A(K,K) + T = -B(K) + CALL DAXPY(K-1, T, A(1,K), 1, B(1), 1) + 40 CONTINUE + RETURN +C------------- LAST LINE OF DHELS FOLLOWS ---------------------------- + END +*DECK DHEQR + SUBROUTINE DHEQR(A, LDA, N, Q, INFO, IJOB) +C***BEGIN PROLOGUE DHEQR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DHEQR-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine performs a QR decomposition of an upper +C Hessenberg matrix A using Givens rotations. There are two +C options available: 1) Performing a fresh decomposition 2) +C updating the QR factors by adding a row and a column to the +C matrix A. +C +C *Usage: +C INTEGER LDA, N, INFO, IJOB +C DOUBLE PRECISION A(LDA,1), Q(1) +C +C CALL DHEQR(A, LDA, N, Q, INFO, IJOB) +C +C *Arguments: +C A :INOUT Double Precision A(LDA,N) +C On input, the matrix to be decomposed. +C On output, the upper triangular matrix R. +C The factorization can be written Q*A = R, where +C Q is a product of Givens rotations and R is upper +C triangular. +C LDA :IN Integer +C The leading dimension of the array A. +C N :IN Integer +C A is an (N+1) by N Hessenberg matrix. +C IJOB :IN Integer +C = 1 means that a fresh decomposition of the +C matrix A is desired. +C .ge. 2 means that the current decomposition of A +C will be updated by the addition of a row +C and a column. +C Q :OUT Double Precision Q(2*N) +C The factors c and s of each Givens rotation used +C in decomposing A. +C INFO :OUT Integer +C = 0 normal value. +C = K if A(K,K) .eq. 0.0 . This is not an error +C condition for this subroutine, but it does +C indicate that DHELS will divide by zero +C if called. +C +C *See Also: +C DGMRES +C +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DHEQR +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER LDA, N, INFO, IJOB + DOUBLE PRECISION A(LDA,*), Q(*) +C +C Local Variables. +C + INTEGER I, IQ, J, K, KM1, KP1, NM1 + DOUBLE PRECISION C, S, T, T1, T2 +C +C***FIRST EXECUTABLE STATEMENT DHEQR + IF (IJOB .GT. 1) GO TO 70 +C ------------------------------------------------------------------- +C A new facorization is desired. +C ------------------------------------------------------------------- +C QR decomposition without pivoting. +C + INFO = 0 + DO 60 K = 1, N + KM1 = K - 1 + KP1 = K + 1 +C +C Compute K-th column of R. +C First, multiply the K-th column of a by the previous +C K-1 Givens rotations. +C + IF (KM1 .LT. 1) GO TO 20 + DO 10 J = 1, KM1 + I = 2*(J-1) + 1 + T1 = A(J,K) + T2 = A(J+1,K) + C = Q(I) + S = Q(I+1) + A(J,K) = C*T1 - S*T2 + A(J+1,K) = S*T1 + C*T2 + 10 CONTINUE +C +C Compute Givens components C and S. +C + 20 CONTINUE + IQ = 2*KM1 + 1 + T1 = A(K,K) + T2 = A(KP1,K) + IF( T2.EQ.0.0D0 ) THEN + C = 1.0D0 + S = 0.0D0 + ELSEIF( ABS(T2).GE.ABS(T1) ) THEN + T = T1/T2 + S = -1.0D0/DSQRT(1.0D0+T*T) + C = -S*T + ELSE + T = T2/T1 + C = 1.0D0/DSQRT(1.0D0+T*T) + S = -C*T + ENDIF + Q(IQ) = C + Q(IQ+1) = S + A(K,K) = C*T1 - S*T2 + IF( A(K,K).EQ.0.0D0 ) INFO = K + 60 CONTINUE + RETURN +C ------------------------------------------------------------------- +C The old factorization of a will be updated. A row and a +C column has been added to the matrix A. N by N-1 is now +C the old size of the matrix. +C ------------------------------------------------------------------- + 70 CONTINUE + NM1 = N - 1 +C ------------------------------------------------------------------- +C Multiply the new column by the N previous Givens rotations. +C ------------------------------------------------------------------- + DO 100 K = 1,NM1 + I = 2*(K-1) + 1 + T1 = A(K,N) + T2 = A(K+1,N) + C = Q(I) + S = Q(I+1) + A(K,N) = C*T1 - S*T2 + A(K+1,N) = S*T1 + C*T2 + 100 CONTINUE +C ------------------------------------------------------------------- +C Complete update of decomposition by forming last Givens +C rotation, and multiplying it times the column +C vector(A(N,N),A(NP1,N)). +C ------------------------------------------------------------------- + INFO = 0 + T1 = A(N,N) + T2 = A(N+1,N) + IF ( T2.EQ.0.0D0 ) THEN + C = 1.0D0 + S = 0.0D0 + ELSEIF( ABS(T2).GE.ABS(T1) ) THEN + T = T1/T2 + S = -1.0D0/DSQRT(1.0D0+T*T) + C = -S*T + ELSE + T = T2/T1 + C = 1.0D0/DSQRT(1.0D0+T*T) + S = -C*T + ENDIF + IQ = 2*N - 1 + Q(IQ) = C + Q(IQ+1) = S + A(N,N) = C*T1 - S*T2 + IF (A(N,N) .EQ. 0.0D0) INFO = N + RETURN +C------------- LAST LINE OF DHEQR FOLLOWS ---------------------------- + END +*DECK DORTH + SUBROUTINE DORTH(VNEW, V, HES, N, LL, LDHES, KMP, SNORMW) +C***BEGIN PROLOGUE DORTH +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DORTH-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine orthogonalizes the vector VNEW against the +C previous KMP vectors in the V array. It uses a modified +C gram-schmidt orthogonalization procedure with conditional +C reorthogonalization. +C +C *Usage: +C INTEGER N, LL, LDHES, KMP +C DOUBLE PRECISION VNEW, V, HES, SNORMW +C DIMENSION VNEW(1), V(N,1), HES(LDHES,1) +C +C CALL DORTH(VNEW, V, HES, N, LL, LDHES, KMP, SNORMW) +C +C *Arguments: +C VNEW :INOUT Double Precision VNEW(N) +C On input, the vector of length n containing a scaled +C product of the jacobian and the vector v(*,ll). +C On output, the new vector orthogonal to v(*,i0) to v(*,ll), +C where i0 = max(1, ll-kmp+1). +C V :IN Double Precision V(N,1) +C The n x ll array containing the previous ll +C orthogonal vectors v(*,1) to v(*,ll). +C HES :INOUT Double Precision HES(LDHES,1) +C On input, an LL x LL upper hessenberg matrix containing, +C in HES(I,K), K.lt.LL, the scaled inner products of +C A*V(*,K) and V(*,i). +C On return, column LL of HES is filled in with +C the scaled inner products of A*V(*,LL) and V(*,i). +C LDHES :IN Integer +C The leading dimension of the HES array. +C N :IN Integer +C The order of the matrix A, and the length of VNEW. +C LL :IN Integer +C The current order of the matrix HES. +C KMP :IN Integer +C The number of previous vectors the new vector VNEW +C must be made orthogonal to (KMP .le. MAXL). +C SNORMW :OUT DOUBLE PRECISION +C Scalar containing the l-2 norm of VNEW. +C +C *See Also: +C DGMRES +C +C***ROUTINES CALLED DAXPY +C***END PROLOGUE DORTH +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, LL, LDHES, KMP + DOUBLE PRECISION VNEW, V, HES, SNORMW + DIMENSION VNEW(1), V(N,1), HES(LDHES,1) +C +C Internal variables. +C + INTEGER I, I0 + DOUBLE PRECISION ARG, SUMDSQ, TEM, VNRM +C +C Get norm of unaltered VNEW for later use. +C***FIRST EXECUTABLE STATEMENT DORTH + VNRM = DNRM2(N, VNEW, 1) +C ------------------------------------------------------------------- +C Perform the modified gram-schmidt procedure on VNEW =A*V(LL). +C Scaled inner products give new column of HES. +C Projections of earlier vectors are subtracted from VNEW. +C ------------------------------------------------------------------- + I0 = MAX0(1,LL-KMP+1) + DO 10 I = I0,LL + HES(I,LL) = DDOT(N, V(1,I), 1, VNEW, 1) + TEM = -HES(I,LL) + CALL DAXPY(N, TEM, V(1,I), 1, VNEW, 1) + 10 CONTINUE +C ------------------------------------------------------------------- +C Compute SNORMW = norm of VNEW. If VNEW is small compared +C to its input value (in norm), then reorthogonalize VNEW to +C V(*,1) through V(*,LL). Correct if relative correction +C exceeds 1000*(unit roundoff). Finally, correct SNORMW using +C the dot products involved. +C ------------------------------------------------------------------- + SNORMW = DNRM2(N, VNEW, 1) + IF (VNRM + 0.001D0*SNORMW .NE. VNRM) RETURN + SUMDSQ = 0.0D0 + DO 30 I = I0,LL + TEM = -DDOT(N, V(1,I), 1, VNEW, 1) + IF (HES(I,LL) + 0.001D0*TEM .EQ. HES(I,LL)) GO TO 30 + HES(I,LL) = HES(I,LL) - TEM + CALL DAXPY(N, TEM, V(1,I), 1, VNEW, 1) + SUMDSQ = SUMDSQ + TEM**2 + 30 CONTINUE + IF (SUMDSQ .EQ. 0.0D0) RETURN + ARG = MAX(0.0D0,SNORMW**2 - SUMDSQ) + SNORMW = DSQRT(ARG) +C + RETURN +C------------- LAST LINE OF DORTH FOLLOWS ---------------------------- + END +*DECK DPIGMR + SUBROUTINE DPIGMR(N, R0, SR, SZ, JSCAL, MAXL, MAXLP1, KMP, + $ NRSTS, JPRE, MATVEC, MSOLVE, NMSL, Z, V, HES, Q, LGMR, + $ RPAR, IPAR, WK, DL, RHOL, NRMAX, B, BNRM, X, XL, + $ ITOL, TOL, NELT, IA, JA, A, ISYM, IUNIT, IFLAG, ERR) +C***BEGIN PROLOGUE DPIGMR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DPIGMR-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine solves the linear system A * Z = R0 using a +C scaled preconditioned version of the generalized minimum +C residual method. An initial guess of Z = 0 is assumed. +C +C *Usage: +C EXTERNAL MATVEC, MSOLVE +C INTEGER N,MAXL,MAXLP1,KMP,JPRE,NMSL,LGMR,IPAR,IFLAG,JSCAL,NRSTS +C INTEGER NRMAX,ITOL,NELT,ISYM +C DOUBLE PRECISION R0,SR,SZ,Z,V,HES,Q,RPAR,WK,DL,RHOL,BNRM,TOL, +C $ A,B,X, R0(1), SR(1), SZ(1), Z(1), V(N,1), +C $ HES(MAXLP1,1), Q(1), RPAR(1), IPAR(1), WK(1), DL(1), +C $ IA(NELT), JA(NELT), A(NELT), B(1), X(1), XL(1) +C +C CALL DPIGMR(N, R0, SR, SZ, JSCAL, MAXL, MAXLP1, KMP, +C $ NRSTS, JPRE, MATVEC, MSOLVE, NMSL, Z, V, HES, Q, LGMR, +C $ RPAR, IPAR, WK, DL, RHOL, NRMAX, B, BNRM, X, XL, +C $ ITOL, TOL, NELT, IA, JA, A, ISYM, IUNIT, IFLAG, ERR) +C +C *Arguments: +C R0 :IN Double Precision R0(N) +C R0 = the right hand side of the system A*Z = R0. +C R0 is also used as work space when computing +C the final approximation. +C (R0 is the same as V(*,MAXL+1) in the call to DPIGMR.) +C SR :IN Double Precision SR(N) +C SR is a vector of length N containing the nonzero +C elements of the diagonal scaling matrix for R0. +C SZ :IN Double Precision SZ(N) +C SZ is a vector of length N containing the nonzero +C elements of the diagonal scaling matrix for Z. +C JSCAL :IN Integer +C A flag indicating whether arrays SR and SZ are used. +C JSCAL=0 means SR and SZ are not used and the +C algorithm will perform as if all +C SR(i) = 1 and SZ(i) = 1. +C JSCAL=1 means only SZ is used, and the algorithm +C performs as if all SR(i) = 1. +C JSCAL=2 means only SR is used, and the algorithm +C performs as if all SZ(i) = 1. +C JSCAL=3 means both SR and SZ are used. +C N :IN Integer +C The order of the matrix A, and the lengths +C of the vectors SR, SZ, R0 and Z. +C MAXL :IN Integer +C The maximum allowable order of the matrix H. +C MAXLP1 :IN Integer +C MAXPL1 = MAXL + 1, used for dynamic dimensioning of HES. +C KMP :IN Integer +C The number of previous vectors the new vector VNEW +C must be made orthogonal to. (KMP .le. MAXL) +C NRSTS :IN Integer +C Counter for the number of restarts on the current +C call to DGMRES. If NRSTS .gt. 0, then the residual +C R0 is already scaled, and so scaling of it is +C not necessary. +C JPRE :IN Integer +C Preconditioner type flag. +C WK :IN Double Precision WK(N) +C A double precision work array of length N used by routine +C MATVEC +C and MSOLVE. +C DL :INOUT Double Precision DL(N) +C On input, a double precision work array of length N used for +C calculation of the residual norm RHO when the method is +C incomplete (KMP.lt.MAXL), and/or when using restarting. +C On output, the scaled residual vector RL. It is only loaded +C when performing restarts of the Krylov iteration. +C NRMAX :IN Integer +C The maximum number of restarts of the Krylov iteration. +C NRMAX .gt. 0 means restarting is active, while +C NRMAX = 0 means restarting is not being used. +C B :IN Double Precision B(N) +C The right hand side of the linear system A*X = B. +C BNRM :IN Double Precision +C The scaled norm of b. +C X :IN Double Precision X(N) +C The current approximate solution as of the last +C restart. +C XL :IN Double Precision XL(N) +C An array of length N used to hold the approximate +C solution X(L) when ITOL=11. +C ITOL :IN Integer +C A flag to indicate the type of convergence criterion +C used. see the driver for its description. +C TOL :IN Double Precision +C The tolerance on residuals R0-A*Z in scaled norm. +C NELT :IN Integer +C The length of arrays IA, JA and A. +C IA :IN Integer IA(NELT) +C An integer array of length NELT containing matrix data. +C It is passed directly to the MATVEC and MSOLVE routines. +C JA :IN Integer JA(NELT) +C An integer array of length NELT containing matrix data. +C It is passed directly to the MATVEC and MSOLVE routines. +C A :IN Double Precision A(NELT) +C A double precision array of length NELT containing matrix +C data. It is passed directly to the MATVEC and MSOLVE routines. +C ISYM :IN Integer +C A flag to indicate symmetric matrix storage. +C If ISYM=0, all nonzero entries of the matrix are +C stored. If ISYM=1, the matrix is symmetric and +C only the upper or lower triangular part is stored. +C IUNIT :IN Integer +C The i/o unit number for writing intermediate residual +C norm values. +C Z :OUT Double Precision Z(N) +C The final computed approximation to the solution +C of the system A*Z = R0. +C LGMR :OUT Integer +C The number of iterations performed and +C the current order of the upper hessenberg +C matrix HES. +C RPAR :IN Double Precision RPAR(*) +C Double Precision work space passed directly to the MSOLVE +C routine. +C IPAR :IN Integer IPAR(*) +C Integer work space passed directly to the MSOLVE +C routine. +C NMSL :OUT Integer +C The number of calls to MSOLVE. +C V :OUT Double Precision V(N,MAXLP1) +C The N by (LGMR+1) array containing the LGMR +C orthogonal vectors V(*,1) to V(*,LGMR). +C HES :OUT Double Precision HES(MAXLP1,MAXL) +C The upper triangular factor of the QR decomposition +C of the (LGMR+1) by LGMR upper Hessenberg matrix whose +C entries are the scaled inner-products of A*V(*,I) +C and V(*,K). +C Q :OUT Double Precision Q(2*MAXL) +C A double precision array of length 2*MAXL containing the +C components of the Givens rotations used in the QR +C decomposition of HES. It is loaded in DHEQR and used in +C DHELS. +C RHOL :OUT Double Precision +C A double precision scalar containing the norm of the final +C residual. +C IFLAG :OUT Integer +C An integer error flag.. +C 0 means convergence in LGMR iterations, LGMR.le.MAXL. +C 1 means the convergence test did not pass in MAXL +C iterations, but the residual norm is .lt. norm(R0), +C and so Z is computed. +C 2 means the convergence test did not pass in MAXL +C iterations, residual .ge. norm(R0), and Z = 0. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C +C *See Also: +C DGMRES +C +C***ROUTINES CALLED ISDGMR, MATVEC, MSOLVE, DORTH, DRLCAL, DHELS, +C DHEQR, DXLCAL, DAXPY, DCOPY, DSCAL, +C***END PROLOGUE DPIGMR +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + EXTERNAL MATVEC, MSOLVE + INTEGER N,MAXL,MAXLP1,KMP,JPRE,NMSL,LGMR,IFLAG,JSCAL,NRSTS + INTEGER NRMAX,ITOL,NELT,ISYM + DOUBLE PRECISION RHOL, BNRM, TOL + DOUBLE PRECISION R0(*), SR(*), SZ(*), Z(*), V(N,*) + DOUBLE PRECISION HES(MAXLP1,*), Q(*), RPAR(*), WK(*), DL(*) + DOUBLE PRECISION A(NELT), B(*), X(*), XL(*) + INTEGER IPAR(*), IA(NELT), JA(NELT) +C +C Local variables. +C + INTEGER I, INFO, IP1, I2, J, K, LL, LLP1 + DOUBLE PRECISION R0NRM,C,DLNRM,PROD,RHO,S,SNORMW,TEM +C +C Zero out the z array. +C***FIRST EXECUTABLE STATEMENT DPIGMR + DO 5 I = 1,N + Z(I) = 0.0D0 + 5 CONTINUE +C + IFLAG = 0 + LGMR = 0 + NMSL = 0 +C Load ITMAX, the maximum number of iterations. + ITMAX =(NRMAX+1)*MAXL +C ------------------------------------------------------------------- +C The initial residual is the vector R0. +C Apply left precon. if JPRE < 0 and this is not a restart. +C Apply scaling to R0 if JSCAL = 2 or 3. +C ------------------------------------------------------------------- + IF ((JPRE .LT. 0) .AND.(NRSTS .EQ. 0)) THEN + CALL DCOPY(N, R0, 1, WK, 1) + CALL MSOLVE(N, WK, R0, NELT, IA, JA, A, ISYM, RPAR, IPAR) + NMSL = NMSL + 1 + ENDIF + IF (((JSCAL.EQ.2) .OR.(JSCAL.EQ.3)) .AND.(NRSTS.EQ.0)) THEN + DO 10 I = 1,N + V(I,1) = R0(I)*SR(I) + 10 CONTINUE + ELSE + DO 20 I = 1,N + V(I,1) = R0(I) + 20 CONTINUE + ENDIF + R0NRM = DNRM2(N, V, 1) + ITER = NRSTS*MAXL +C +C Call stopping routine ISDGMR. +C + IF (ISDGMR(N, B, X, XL, NELT, IA, JA, A, ISYM, MSOLVE, + $ NMSL, ITOL, TOL, ITMAX, ITER, ERR, IUNIT, V(1,1), Z, WK, + $ RPAR, IPAR, R0NRM, BNRM, SR, SZ, JSCAL, + $ KMP, LGMR, MAXL, MAXLP1, V, Q, SNORMW, PROD, R0NRM, + $ HES, JPRE) .NE. 0) RETURN + TEM = 1.0D0/R0NRM + CALL DSCAL(N, TEM, V(1,1), 1) +C +C Zero out the HES array. +C + DO 50 J = 1,MAXL + DO 40 I = 1,MAXLP1 + HES(I,J) = 0.0D0 + 40 CONTINUE + 50 CONTINUE +C ------------------------------------------------------------------- +C main loop to compute the vectors V(*,2) to V(*,MAXL). +C The running product PROD is needed for the convergence test. +C ------------------------------------------------------------------- + PROD = 1.0D0 + DO 90 LL = 1,MAXL + LGMR = LL +C ------------------------------------------------------------------- +C Unscale the current V(LL) and store in WK. Call routine +C msolve to compute(M-inverse)*WK, where M is the +C preconditioner matrix. Save the answer in Z. Call routine +C MATVEC to compute VNEW = A*Z, where A is the the system +C matrix. save the answer in V(LL+1). Scale V(LL+1). Call +C routine DORTH to orthogonalize the new vector VNEW = +C V(*,LL+1). Call routine DHEQR to update the factors of HES. +C ------------------------------------------------------------------- + IF ((JSCAL .EQ. 1) .OR.(JSCAL .EQ. 3)) THEN + DO 60 I = 1,N + WK(I) = V(I,LL)/SZ(I) + 60 CONTINUE + ELSE + CALL DCOPY(N, V(1,LL), 1, WK, 1) + ENDIF + IF (JPRE .GT. 0) THEN + CALL MSOLVE(N, WK, Z, NELT, IA, JA, A, ISYM, RPAR, IPAR) + NMSL = NMSL + 1 + CALL MATVEC(N, Z, V(1,LL+1), NELT, IA, JA, A, ISYM) + ELSE + CALL MATVEC(N, WK, V(1,LL+1), NELT, IA, JA, A, ISYM) + ENDIF + IF (JPRE .LT. 0) THEN + CALL DCOPY(N, V(1,LL+1), 1, WK, 1) + CALL MSOLVE(N,WK,V(1,LL+1),NELT,IA,JA,A,ISYM,RPAR,IPAR) + NMSL = NMSL + 1 + ENDIF + IF ((JSCAL .EQ. 2) .OR.(JSCAL .EQ. 3)) THEN + DO 65 I = 1,N + V(I,LL+1) = V(I,LL+1)*SR(I) + 65 CONTINUE + ENDIF + CALL DORTH(V(1,LL+1), V, HES, N, LL, MAXLP1, KMP, SNORMW) + HES(LL+1,LL) = SNORMW + CALL DHEQR(HES, MAXLP1, LL, Q, INFO, LL) + IF (INFO .EQ. LL) GO TO 120 +C ------------------------------------------------------------------- +C Update RHO, the estimate of the norm of the residual R0-A*ZL. +C If KMP < MAXL, then the vectors V(*,1),...,V(*,LL+1) are not +C necessarily orthogonal for LL > KMP. The vector DL must then +C be computed, and its norm used in the calculation of RHO. +C ------------------------------------------------------------------- + PROD = PROD*Q(2*LL) + RHO = ABS(PROD*R0NRM) + IF ((LL.GT.KMP) .AND.(KMP.LT.MAXL)) THEN + IF (LL .EQ. KMP+1) THEN + CALL DCOPY(N, V(1,1), 1, DL, 1) + DO 75 I = 1,KMP + IP1 = I + 1 + I2 = I*2 + S = Q(I2) + C = Q(I2-1) + DO 70 K = 1,N + DL(K) = S*DL(K) + C*V(K,IP1) + 70 CONTINUE + 75 CONTINUE + ENDIF + S = Q(2*LL) + C = Q(2*LL-1)/SNORMW + LLP1 = LL + 1 + DO 80 K = 1,N + DL(K) = S*DL(K) + C*V(K,LLP1) + 80 CONTINUE + DLNRM = DNRM2(N, DL, 1) + RHO = RHO*DLNRM + ENDIF + RHOL = RHO +C ------------------------------------------------------------------- +C Test for convergence. If passed, compute approximation ZL. +C If failed and LL < MAXL, then continue iterating. +C ------------------------------------------------------------------- + ITER = NRSTS*MAXL + LGMR + IF (ISDGMR(N, B, X, XL, NELT, IA, JA, A, ISYM, MSOLVE, + $ NMSL, ITOL, TOL, ITMAX, ITER, ERR, IUNIT, DL, Z, WK, + $ RPAR, IPAR, RHOL, BNRM, SR, SZ, JSCAL, + $ KMP, LGMR, MAXL, MAXLP1, V, Q, SNORMW, PROD, R0NRM, + $ HES, JPRE) .NE. 0) GO TO 200 + IF (LL .EQ. MAXL) GO TO 100 +C ------------------------------------------------------------------- +C Rescale so that the norm of V(1,LL+1) is one. +C ------------------------------------------------------------------- + TEM = 1.0D0/SNORMW + CALL DSCAL(N, TEM, V(1,LL+1), 1) + 90 CONTINUE + 100 CONTINUE + IF (RHO .LT. R0NRM) GO TO 150 + 120 CONTINUE + IFLAG = 2 +C +C Load approximate solution with zero. +C + DO 130 I = 1,N + Z(I) = 0.D0 + 130 CONTINUE + RETURN + 150 IFLAG = 1 +C +C Tolerance not met, but residual norm reduced. +C + IF (NRMAX .GT. 0) THEN +C +C If performing restarting (NRMAX > 0) calculate the residual +C vector RL and store it in the DL array. If the incomplete +C version is being used (KMP < MAXL) then DL has already been +C calculated up to a scaling factor. Use DRLCAL to calculate +C the scaled residual vector. +C + CALL DRLCAL(N, KMP, MAXL, MAXL, V, Q, DL, SNORMW, PROD, + $ R0NRM) + ENDIF +C ------------------------------------------------------------------- +C Compute the approximation ZL to the solution. Since the +C vector Z was used as work space, and the initial guess +C of the linear iteration is zero, Z must be reset to zero. +C ------------------------------------------------------------------- + 200 CONTINUE + LL = LGMR + LLP1 = LL + 1 + DO 210 K = 1,LLP1 + R0(K) = 0.0D0 + 210 CONTINUE + R0(1) = R0NRM + CALL DHELS(HES, MAXLP1, LL, Q, R0) + DO 220 K = 1,N + Z(K) = 0.0D0 + 220 CONTINUE + DO 230 I = 1,LL + CALL DAXPY(N, R0(I), V(1,I), 1, Z, 1) + 230 CONTINUE + IF ((JSCAL .EQ. 1) .OR.(JSCAL .EQ. 3)) THEN + DO 240 I = 1,N + Z(I) = Z(I)/SZ(I) + 240 CONTINUE + ENDIF + IF (JPRE .GT. 0) THEN + CALL DCOPY(N, Z, 1, WK, 1) + CALL MSOLVE(N, WK, Z, NELT, IA, JA, A, ISYM, RPAR, IPAR) + NMSL = NMSL + 1 + ENDIF + RETURN +C------------- LAST LINE OF DPIGMR FOLLOWS ---------------------------- + END +*DECK DRLCAL + SUBROUTINE DRLCAL(N, KMP, LL, MAXL, V, Q, RL, SNORMW, PROD, + $ R0NRM) +C***BEGIN PROLOGUE DRLCAL +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DRLCAL-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine calculates the scaled residual RL from the +C V(I)'s. +C *Usage: +C INTEGER N, KMP, LL, MAXL +C DOUBLE PRECISION SNORMW +C DOUBLE PRECISION V(N,1), Q(1), RL(N) +C +C CALL DRLCAL(N, KMP, LL, MAXL, V, Q, RL, SNORMW, PROD, +C $ R0NRM) +C +C *Arguments: +C N :IN Integer +C The order of the matrix A, and the lengths +C of the vectors SR, SZ, R0 and Z. +C KMP :IN Integer +C The number of previous V vectors the new vector VNEW +C must be made orthogonal to. (KMP .le. MAXL) +C LL :IN Integer +C The current dimension of the Krylov subspace. +C MAXL :IN Integer +C The maximum dimension of the Krylov subspace. +C Q :IN Double Precision Q(2*MAXL) +C A double precision array of length 2*MAXL containing the +C components of the Givens rotations used in the QR +C decomposition of HES. It is loaded in DHEQR and used in +C DHELS. +C PROD :IN Double Precision +C The product s1*s2*...*sl = the product of the sines of the +C givens rotations used in the QR factorization of +C the hessenberg matrix HES. +C R0NRM :IN Double Precision +C The scaled norm of initial residual R0. +C RL :OUT Double Precision RL(N) +C The residual vector RL. This is either SB*(B-A*XL) if +C not preconditioning or preconditioning on the right, +C or SB*(M-inverse)*(B-A*XL) if preconditioning on the +C left. +C +C *See Also: +C DGMRES +C +C***ROUTINES CALLED DCOPY, DSCAL +C***END PROLOGUE DRLCAL +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, KMP, LL, MAXL + DOUBLE PRECISION SNORMW + DOUBLE PRECISION V(N,*), Q(*), RL(N) +C +C Internal Variables. +C + INTEGER I, IP1, I2, K +C +C***FIRST EXECUTABLE STATEMENT DRLCAL + IF (KMP .EQ. MAXL) THEN +C +C calculate RL. Start by copying V(*,1) into RL. +C + CALL DCOPY(N, V(1,1), 1, RL, 1) + LLM1 = LL - 1 + DO 20 I = 1,LLM1 + IP1 = I + 1 + I2 = I*2 + S = Q(I2) + C = Q(I2-1) + DO 10 K = 1,N + RL(K) = S*RL(K) + C*V(K,IP1) + 10 CONTINUE + 20 CONTINUE + S = Q(2*LL) + C = Q(2*LL-1)/SNORMW + LLP1 = LL + 1 + DO 30 K = 1,N + RL(K) = S*RL(K) + C*V(K,LLP1) + 30 CONTINUE + ENDIF +C +C When KMP < MAXL, RL vector already partially calculated. +C Scale RL by R0NRM*PROD to obtain the residual RL. +C + TEM = R0NRM*PROD + CALL DSCAL(N, TEM, RL, 1) + RETURN +C------------- LAST LINE OF DRLCAL FOLLOWS ---------------------------- + END +*DECK DXLCAL + SUBROUTINE DXLCAL(N, LGMR, X, XL, ZL, HES, MAXLP1, Q, V, R0NRM, + $ WK, SZ, JSCAL, JPRE, MSOLVE, NMSL, RPAR, IPAR, + $ NELT, IA, JA, A, ISYM) +C***BEGIN PROLOGUE DXLCAL +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DXLCAL-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Generalized Minimum Residual +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Internal routine for DGMRES. +C***DESCRIPTION +C This routine computes the solution XL, the current DGMRES +C iterate, given the V(I)'s and the QR factorization of the +C Hessenberg matrix HES. This routine is only called when +C ITOL=11. +C +C *Usage: +C EXTERNAL MSOLVE +C DOUBLE PRECISION R0NRM +C DOUBLE PRECISION X(N), XL(N), ZL(N), HES(MAXLP1,1), Q(1) +C DOUBLE PRECISION V(N,1), WK(N), SZ(1), RPAR(1) +C DOUBLE PRECISION A(NELT) +C INTEGER N, LGMR, MAXLP1, JSCAL, JPRE, IPAR, NMSL, NELT, ISYM +C INTEGER IPAR(1), IA(NELT), JA(NELT) +C +C CALL DXLCAL(N, LGMR, X, XL, ZL, HES, MAXLP1, Q, V, R0NRM, +C $ WK, SZ, JSCAL, JPRE, MSOLVE, NMSL, RPAR, IPAR, +C $ NELT, IA, JA, A, ISYM) +C +C *Arguments: +C N :IN Integer +C The order of the matrix A, and the lengths +C of the vectors SR, SZ, R0 and Z. +C LGMR :IN Integer +C The number of iterations performed and +C the current order of the upper Hessenberg +C matrix HES. +C X :IN Double Precision X(N) +C The current approximate solution as of the last restart. +C ZL :IN Double Precision ZL(N) +C An array of length N used to hold the approximate +C solution Z(L). +C SZ :IN Double Precision SZ(N) +C A vector of length N containing the nonzero +C elements of the diagonal scaling matrix for Z. +C JSCAL :IN Integer +C A flag indicating whether arrays SR and SZ are used. +C JSCAL=0 means SR and SZ are not used and the +C algorithm will perform as if all +C SR(i) = 1 and SZ(i) = 1. +C JSCAL=1 means only SZ is used, and the algorithm +C performs as if all SR(i) = 1. +C JSCAL=2 means only SR is used, and the algorithm +C performs as if all SZ(i) = 1. +C JSCAL=3 means both SR and SZ are used. +C MAXLP1 :IN Integer +C MAXLP1 = MAXL + 1, used for dynamic dimensioning of HES. +C MAXL is the maximum allowable order of the matrix HES. +C JPRE :IN Integer +C The preconditioner type flag. +C WK :IN Double Precision WK(N) +C A double precision work array of length N. +C NMSL :IN Integer +C The number of calls to MSOLVE. +C V :IN Double Precision V(N,MAXLP1) +C The N by(LGMR+1) array containing the LGMR +C orthogonal vectors V(*,1) to V(*,LGMR). +C HES :IN Double Precision HES(MAXLP1,MAXL) +C The upper triangular factor of the QR decomposition +C of the (LGMR+1) by LGMR upper Hessenberg matrix whose +C entries are the scaled inner-products of A*V(*,i) and V(*,k). +C Q :IN Double Precision Q(2*MAXL) +C A double precision array of length 2*MAXL containing the +C components of the givens rotations used in the QR +C decomposition of HES. It is loaded in DHEQR. +C R0NRM :IN Double Precision +C The scaled norm of the initial residual for the +C current call to DPIGMR. +C RPAR :IN Double Precision RPAR(*) +C Double Precision work space passed directly to the MSOLVE +C routine. +C IPAR :IN Integer IPAR(*) +C Integer work space passed directly to the MSOLVE +C routine. +C NELT :IN Integer +C The length of arrays IA, JA and A. +C IA :IN Integer IA(NELT) +C An integer array of length NELT containing matrix data. +C It is passed directly to the MATVEC and MSOLVE routines. +C JA :IN Integer JA(NELT) +C An integer array of length NELT containing matrix data. +C It is passed directly to the MATVEC and MSOLVE routines. +C A :IN Double Precision A(NELT) +C A double precision array of length NELT containing matrix +C data. +C It is passed directly to the MATVEC and MSOLVE routines. +C ISYM :IN Integer +C A flag to indicate symmetric matrix storage. +C If ISYM=0, all nonzero entries of the matrix are +C stored. If ISYM=1, the matrix is symmetric and +C only the upper or lower triangular part is stored. +C XL :OUT Double Precision XL(N) +C An array of length N used to hold the approximate +C solution X(L). +C Warning: XL and ZL are the same array in the calling routine. +C +C *See Also: +C DGMRES +C +C***ROUTINES CALLED MSOLVE, DHELS, DAXPY, DCOPY, DSCAL +C***END PROLOGUE DXLCAL +C The following is for optimized compilation on LLNL/LTSS Crays. +CLLL. OPTIMIZE + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + EXTERNAL MSOLVE + INTEGER N, LGMR, MAXLP1, JSCAL, JPRE, IPAR(*), NMSL, NELT + INTEGER IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION R0NRM, X(N), XL(N), ZL(N), HES(MAXLP1,*) + DOUBLE PRECISION Q(*), V(N,*), WK(N), SZ(*), RPAR(*), A(NELT) +C +C Internal variables. +C + INTEGER I, K, LL, LLP1 +C +C***FIRST EXECUTABLE STATEMENT DXLCAL + LL = LGMR + LLP1 = LL + 1 + DO 10 K = 1,LLP1 + WK(K) = 0.0D0 + 10 CONTINUE + WK(1) = R0NRM + CALL DHELS(HES, MAXLP1, LL, Q, WK) + DO 20 K = 1,N + ZL(K) = 0.0D0 + 20 CONTINUE + DO 30 I = 1,LL + CALL DAXPY(N, WK(I), V(1,I), 1, ZL, 1) + 30 CONTINUE + IF ((JSCAL .EQ. 1) .OR.(JSCAL .EQ. 3)) THEN + DO 40 K = 1,N + ZL(K) = ZL(K)/SZ(K) + 40 CONTINUE + ENDIF + IF (JPRE .GT. 0) THEN + CALL DCOPY(N, ZL, 1, WK, 1) + CALL MSOLVE(N, WK, ZL, NELT, IA, JA, A, ISYM, RPAR, IPAR) + NMSL = NMSL + 1 + ENDIF +C calculate XL from X and ZL. + DO 50 K = 1,N + XL(K) = X(K) + ZL(K) + 50 CONTINUE + RETURN +C------------- LAST LINE OF DXLCAL FOLLOWS ---------------------------- + END +*DECK ISDGMR + FUNCTION ISDGMR(N, B, X, XL, NELT, IA, JA, A, ISYM, MSOLVE, + $ NMSL, ITOL, TOL, ITMAX, ITER, ERR, IUNIT, R, Z, DZ, + $ RWORK, IWORK, RNRM, BNRM, SB, SX, JSCAL, + $ KMP, LGMR, MAXL, MAXLP1, V, Q, SNORMW, PROD, R0NRM, + $ HES, JPRE) +C***BEGIN PROLOGUE ISDGMR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=INTEGER(ISDGMR-I) +C Linear system, Sparse, Stop Test, GMRES +C***AUTHOR Brown, Peter, (LLNL), brown@lll-crg.llnl.gov +C Hindmarsh, Alan, (LLNL), alanh@lll-crg.llnl.gov +C Seager, Mark K., (LLNL), seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C***PURPOSE Generalized Minimum Residual Stop Test. +C This routine calculates the stop test for the Generalized +C Minimum RESidual (GMRES) iteration scheme. It returns a +C nonzero if the error estimate (the type of which is +C determined by ITOL) is less than the user specified +C tolerence TOL. +C***DESCRIPTION +C *Usage: +C INTEGER KMP, LGMR, MAXL, MAXLP1, JPRE, NMSL +C DOUBLE PRECISION DXNRM, RNRM, R0NRM, SNORMW, SOLNRM, PROD +C DOUBLE PRECISION B(1), X(1), IA(1), JA(1), A(1), R(1), Z(1) +C DOUBLE PRECISION DZ(1), RWORK(1), IWORK(1), SB(1), SX(1) +C DOUBLE PRECISION Q(1), V(N,1), HES(MAXLP1,MAXL), XL(1) +C EXTERNAL MSOLVE +C +C IF (ISDGMR(N, B, X, XL, NELT, IA, JA, A, ISYM, MSOLVE, +C $ NMSL, ITOL, TOL, ITMAX, ITER, ERR, IUNIT, R, Z, DZ, +C $ RWORK, IWORK, RNRM, BNRM, SB, SX, JSCAL, +C $ KMP, LGMR, MAXL, MAXLP1, V, Q, SNORMW, PROD, R0NRM, +C $ HES, JPRE) .NE. 0) THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand-side vector. +C X :IN Double Precision X(N). +C Approximate solution vector as of the last restart. +C XL :OUT Double Precision XL(N) +C An array of length N used to hold the approximate +C solution as of the current iteration. Only computed by +C this routine when ITOL=11. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", in the DGMRES, +C DSLUGM and DSDGMR routines for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system Mz = r for z +C given r with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays. The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSLOVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C NMSL :INOUT Integer. +C A counter for the number of calls to MSOLVE. +C ITOL :IN Integer. +C Flag to indicate the type of convergence criterion used. +C ITOL=0 Means the iteration stops when the test described +C below on the residual RL is satisfied. This is +C the "Natural Stopping Criteria" for this routine. +C Other values of ITOL cause extra, otherwise +C unnecessary, computation per iteration and are +C therefore much less efficient. See ISDGMR (the +C stop test routine) for more information. +C ITOL=1 Means the iteration stops when the first test +C described below on the residual RL is satisfied, +C and there is either right or no preconditioning +C being used. +C ITOL=2 Implies that the user is using left +C preconditioning, and the second stopping criterion +C below is used. +C ITOL=3 Means the iteration stops when the third test +C described below on Minv*Residual is satisfied, and +C there is either left or no preconditioning begin +C used. +C ITOL=11 is often useful for checking and comparing +C different routines. For this case, the user must +C supply the "exact" solution or a very accurate +C approximation (one with an error much less than +C TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the +C difference between the iterative approximation and +C the user-supplied solution divided by the 2-norm +C of the user-supplied solution is less than TOL. +C Note that this requires the user to set up the +C "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling +C routine. The routine with this declaration should +C be loaded before the stop test so that the correct +C length is used by the loader. This procedure is +C not standard Fortran and may not work correctly on +C your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 +C then this common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :IN Integer. +C The iteration for which to check for convergence. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. Letting norm() denote the Euclidean +C norm, ERR is defined as follows.. +C +C If ITOL=0, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C for right or no preconditioning, and +C ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C for left preconditioning. +C If ITOL=1, then ERR = norm(SB*(B-A*X(L)))/norm(SB*B), +C since right or no preconditioning +C being used. +C If ITOL=2, then ERR = norm(SB*(M-inverse)*(B-A*X(L)))/ +C norm(SB*(M-inverse)*B), +C since left preconditioning is being +C used. +C If ITOL=3, then ERR = Max |(Minv*(B-A*X(L)))(i)/x(i)| +C i=1,n +C If ITOL=11, then ERR = norm(SB*(X(L)-SOLN))/norm(SB*SOLN). +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :INOUT Double Precision R(N). +C Work array used in calling routine. It contains +C information necessary to compute the residual RL = B-A*XL. +C Z :WORK Double Precision Z(N). +C Workspace used to hold the pseudo-residule M z = r. +C DZ :WORK Double Precision DZ(N). +C Workspace used to hold temporary vector(s). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C RNRM :IN Double Precision. +C Norm of the current residual. Type of norm depends on ITOL. +C BNRM :IN Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C SB :IN Double Precision SB(N). +C Scaling vector for B. +C SX :IN Double Precision SX(N). +C Scaling vector for X. +C JSCAL :IN Integer. +C Flag indicating if scaling arrays SB and SX are being +C used in the calling routine DPIGMR. +C JSCAL=0 means SB and SX are not used and the +C algorithm will perform as if all +C SB(i) = 1 and SX(i) = 1. +C JSCAL=1 means only SX is used, and the algorithm +C performs as if all SB(i) = 1. +C JSCAL=2 means only SB is used, and the algorithm +C performs as if all SX(i) = 1. +C JSCAL=3 means both SB and SX are used. +C KMP :IN Integer +C The number of previous vectors the new vector VNEW +C must be made orthogonal to. (KMP .le. MAXL) +C LGMR :IN Integer +C The number of GMRES iterations performed on the current call +C to DPIGMR (i.e., # iterations since the last restart) and +C the current order of the upper hessenberg +C matrix HES. +C MAXL :IN Integer +C The maximum allowable order of the matrix H. +C MAXLP1 :IN Integer +C MAXPL1 = MAXL + 1, used for dynamic dimensioning of HES. +C V :IN Double Precision V(N,MAXLP1) +C The N by (LGMR+1) array containing the LGMR +C orthogonal vectors V(*,1) to V(*,LGMR). +C Q :IN Double Precision Q(2*MAXL) +C A double precision array of length 2*MAXL containing the +C components of the Givens rotations used in the QR +C decomposition +C of HES. +C SNORMW :IN Double Precision +C A scalar containing the scaled norm of VNEW before it +C is renormalized in DPIGMR. +C PROD :IN Double Precision +C The product s1*s2*...*sl = the product of the sines of the +C givens rotations used in the QR factorization of +C the hessenberg matrix HES. +C R0NRM :IN Double Precision +C The scaled norm of initial residual R0. +C HES :IN Double Precision HES(MAXLP1,MAXL) +C The upper triangular factor of the QR decomposition +C of the (LGMR+1) by LGMR upper Hessenberg matrix whose +C entries are the scaled inner-products of A*V(*,I) +C and V(*,K). +C JPRE :IN Integer +C Preconditioner type flag. +C +C *Description +C When using the GMRES solver, the preferred value for ITOL +C is 0. This is due to the fact that when ITOL=0 the norm of +C the residual required in the stopping test is obtained for +C free, since this value is already calculated in the GMRES +C algorithm. The variable RNRM contains the appropriate +C norm, which is equal to norm(SB*(RL - A*XL)) when right or +C no preconditioning is being performed, and equal to +C norm(SB*Minv*(RL - A*XL)) when using left preconditioning. +C Here, norm() is the Euclidean norm. Nonzero values of ITOL +C require additional work to calculate the actual scaled +C residual or its scaled/preconditioned form, and/or the +C approximate solution XL. Hence, these values of ITOL will +C not be as efficient as ITOL=0. +C +C***ROUTINES CALLED MSOLVE, DNRM2, DCOPY, +C***END PROLOG ISDGMR + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER KMP, LGMR, MAXL, MAXLP1, JPRE, NMSL + DOUBLE PRECISION DXNRM, RNRM, R0NRM, SNORMW, SOLNRM, PROD + DOUBLE PRECISION B(*), X(*), IA(*), JA(*), A(*), R(*), Z(*), DZ(*) + DOUBLE PRECISION RWORK(*), IWORK(*), SB(*), SX(*), Q(*), V(N,*) + DOUBLE PRECISION HES(MAXLP1,MAXL), XL(*) + EXTERNAL MSOLVE + COMMON /SOLBLK/ SOLN(1) + SAVE SOLNRM +C +C***FIRST EXECUTABLE STATEMENT ISDGMR + ISDGMR = 0 + IF ( ITOL.EQ.0 ) THEN +C +C Use input from DPIGMR to determine if stop conditions are met. +C + ERR = RNRM/BNRM + ENDIF + IF ( (ITOL.GT.0) .AND. (ITOL.LE.3) ) THEN +C +C Use DRLCAL to calculate the scaled residual vector. +C Store answer in R. +C + IF ( LGMR.NE.0 ) CALL DRLCAL(N, KMP, LGMR, MAXL, V, Q, R, + $ SNORMW, PROD, R0NRM) + IF ( ITOL.LE.2 ) THEN +C err = ||Residual||/||RightHandSide||(2-Norms). + ERR = DNRM2(N, R, 1)/BNRM +C +C Unscale R by R0NRM*PROD when KMP < MAXL. +C + IF ( (KMP.LT.MAXL) .AND. (LGMR.NE.0) ) THEN + TEM = 1.0D0/(R0NRM*PROD) + CALL DSCAL(N, TEM, R, 1) + ENDIF + ELSEIF ( ITOL.EQ.3 ) THEN +C err = Max |(Minv*Residual)(i)/x(i)| +C When jpre .lt. 0, r already contains Minv*Residual. + IF ( JPRE.GT.0 ) THEN + CALL MSOLVE(N, R, DZ, NELT, IA, JA, A, ISYM, RWORK, + $ IWORK) + NMSL = NMSL + 1 + ENDIF +C +C Unscale R by R0NRM*PROD when KMP < MAXL. +C + IF ( (KMP.LT.MAXL) .AND. (LGMR.NE.0) ) THEN + TEM = 1.0D0/(R0NRM*PROD) + CALL DSCAL(N, TEM, R, 1) + ENDIF +C + FUZZ = D1MACH(1) + IELMAX = 1 + RATMAX = ABS(DZ(1))/MAX(ABS(X(1)),FUZZ) + DO 25 I = 2, N + RAT = ABS(DZ(I))/MAX(ABS(X(I)),FUZZ) + IF( RAT.GT.RATMAX ) THEN + IELMAX = I + RATMAX = RAT + ENDIF + 25 CONTINUE + ERR = RATMAX + IF( RATMAX.LE.TOL ) ISDGMR = 1 + IF( IUNIT.GT.0 ) WRITE(IUNIT,1020) ITER, IELMAX, RATMAX + RETURN + ENDIF + ENDIF + IF ( ITOL.EQ.11 ) THEN +C +C Use DXLCAL to calculate the approximate solution XL. +C + IF ( (LGMR.NE.0) .AND. (ITER.GT.0) ) THEN + CALL DXLCAL(N, LGMR, X, XL, XL, HES, MAXLP1, Q, V, R0NRM, + $ DZ, SX, JSCAL, JPRE, MSOLVE, NMSL, RWORK, IWORK, + $ NELT, IA, JA, A, ISYM) + ELSEIF ( ITER.EQ.0 ) THEN +C Copy X to XL to check if initial guess is good enough. + CALL DCOPY(N, X, 1, XL, 1) + ELSE +C Return since this is the first call to DPIGMR on a restart. + RETURN + ENDIF +C + IF ((JSCAL .EQ. 0) .OR.(JSCAL .EQ. 2)) THEN +C err = ||x-TrueSolution||/||TrueSolution||(2-Norms). + IF ( ITER.EQ.0 ) SOLNRM = DNRM2(N, SOLN, 1) + DO 30 I = 1, N + DZ(I) = XL(I) - SOLN(I) + 30 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE + IF (ITER .EQ. 0) THEN + SOLNRM = 0.D0 + DO 40 I = 1,N + SOLNRM = SOLNRM + (SX(I)*SOLN(I))**2 + 40 CONTINUE + SOLNRM = DSQRT(SOLNRM) + ENDIF + DXNRM = 0.D0 + DO 50 I = 1,N + DXNRM = DXNRM + (SX(I)*(XL(I)-SOLN(I)))**2 + 50 CONTINUE + DXNRM = DSQRT(DXNRM) +C err = ||SX*(x-TrueSolution)||/||SX*TrueSolution|| (2-Norms). + ERR = DXNRM/SOLNRM + ENDIF + ENDIF +C + IF( IUNIT.NE.0 ) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) N, ITOL, MAXL, KMP + ENDIF + WRITE(IUNIT,1010) ITER, RNRM/BNRM, ERR + ENDIF + IF ( ERR.LE.TOL ) ISDGMR = 1 +C + RETURN + 1000 FORMAT(' Generalized Minimum Residual(',I3,I3,') for ', + $ 'N, ITOL = ',I5, I5, + $ /' ITER',' Natral Err Est',' Error Estimate') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7) + 1020 FORMAT(1X,' ITER = ',I5, ' IELMAX = ',I5, + $ ' |R(IELMAX)/X(IELMAX)| = ',E12.5) +C------------- LAST LINE OF ISDGMR FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dir.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dir.f new file mode 100644 index 0000000000..8860000a02 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dir.f @@ -0,0 +1,1283 @@ +*DECK DIR + SUBROUTINE DIR(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, + $ RWORK, IWORK) +C***BEGIN PROLOGUE DIR +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DIR-D), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Iterative Refinement sparse Ax = b solver. +C Routine to solve a general linear system Ax = b using +C iterative refinement with a matrix splitting. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINABLE) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N), DZ(N) +C DOUBLE PRECISION RWORK(USER DEFINABLE) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DIR(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSLOVE, ITOL, +C $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Integer A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "Description", below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C Y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X +C upon return, X is an input vector, NELT is the number of +C non-zeros in the SLAP IA, JA, A storage for the matrix A. +C ISYM is a flag which, if non-zero, denotes that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. IA, JA, A and +C ISYM are defined as above. RWORK is a double precision array +C that can be used to pass necessary preconditioning information +C and/or workspace to MSOLVE. IWORK is an integer work array +C for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C Z :WORK Double Precision Z(N). +C DZ :WORK Double Precision DZ(N). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C +C *Description: +C The basic algorithm for iterative refinement (also known as +C iterative improvement) is: +C +C n+1 n -1 n +C X = X + M (B - AX ). +C +C -1 -1 +C If M = A then this is the standard iterative refinement +C algorithm and the "subtraction" in the residual calculation +C should be done in double precision (which it is not in this +C routine). If M = DIAG(A), the diagonal of A, then iterative +C refinement is known as Jacobi's method. The SLAP routine +C DSJAC implements this iterative strategy. If M = L, the +C lower triangle of A, then iterative refinement is known as +C Gauss-Seidel. The SLAP routine DSGS implements this +C iterative strategy. +C +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK) in some fashion. The SLAP +C routines DSJAC and DSGS are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Examples: +C See the SLAP routines DSJAC, DSGS +C +C *Precision: Double Precision +C *See Also: +C DSJAC, DSGS +C***REFERENCES 1. Gene Golub \& Charles Van Loan, "Matrix +C Computations", John Hopkins University Press; 3 +C (1983) IBSN 0-8018-3010-9. +C***ROUTINES CALLED MATVEC, MSOLVE, ISDIR. +C***END PROLOGUE DIR + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + INTEGER ITOL, ITMAX, ITER, IERR, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) + DOUBLE PRECISION DZ(N), RWORK(*) + EXTERNAL MSOLVE, MATVEC, ISDIR +C +C Check some of the input data. +C***FIRST EXECUTABLE STATEMENT DIR + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + TOLMIN = 500.0*D1MACH(3) + IF( TOL.LT.TOLMIN ) THEN + TOL = TOLMIN + IERR = 4 + ENDIF +C +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + R(I) = B(I) - R(I) + 10 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C + IF( ISDIR(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, + $ IWORK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C ***** iteration loop ***** +C + DO 100 K=1,ITMAX + ITER = K +C +C Calculate new iterate x, new residual r, and new +C pseudo-resid z. + DO 20 I = 1, N + X(I) = X(I) + Z(I) + 20 CONTINUE + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 30 I = 1, N + R(I) = B(I) - R(I) + 30 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C +C check stopping criterion. + IF( ISDIR(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, + $ IWORK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 +C + 100 CONTINUE +C +C ***** end of loop ***** +C Stopping criterion not satisfied. + ITER = ITMAX + 1 + IERR = 2 +C + 200 RETURN +C------------- LAST LINE OF DIR FOLLOWS ------------------------------- + END +*DECK DSJAC + SUBROUTINE DSJAC(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSJAC +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSJAC-D), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Jacobi's method iterative sparse Ax = b solver. +C Routine to solve a general linear system Ax = b using +C Jacobi iteration. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(LENIW), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) +C +C CALL DSJAC(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Integer A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. LENW >= 4*N. +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the double precision workspace, +C RWORK. Upon return the following locations of IWORK hold +C information which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= 10. +C +C *Description: +C Jacobi's method solves the linear system Ax=b with the +C basic iterative method (where A = L + D + U): +C +C n+1 -1 n n +C X = D (B - LX - UX ) +C +C n -1 n +C = X + D (B - AX ) +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which one +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *See Also: +C DSGS, DIR +C +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DDCHKW, DSDS, DIR, DSMV, DSDI +C***END PROLOGUE DSJAC + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), RWORK(LENW) + EXTERNAL DSMV, DSDI + PARAMETER(LOCRB=1,LOCIB=11) +C +C Compute the inverse of the diagonal of the matrix. This +C will be used as the precontioner. +C***FIRST EXECUTABLE STATEMENT DSJAC + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + LOCIW = LOCIB + LOCD = LOCRB + LOCR = LOCD + N + LOCZ = LOCR + N + LOCDZ = LOCZ + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSJAC', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCD + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DS2Y(N, NELT, IA, JA, A, ISYM ) + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCD)) +C +C Set up the work array and perform the iterative refinement. + CALL DIR(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSDI, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), RWORK(LOCZ), + $ RWORK(LOCDZ), RWORK, IWORK ) + RETURN +C------------- LAST LINE OF DSJAC FOLLOWS ----------------------------- + END +*DECK DSGS + SUBROUTINE DSGS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSGS +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSGS-S), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Gauss-Seidel method iterative sparse Ax = b solver. +C Routine to solve a general linear system Ax = b using +C Gauss-Seidel iteration. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+2*N+1), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+3*N) +C +C CALL DSGS(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Integer A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the number +C of non-zeros in the lower triangle of the matrix (including +C the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+3*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= +C NEL+N+11. +C +C *Description +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *See Also: +C DSJAC, DIR +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DS2LT, SDIR, DSMV, DSLI +C***END PROLOGUE DSGS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX + INTEGER ITER, IUNIT, IWORK(10) + DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, RWORK(1) + EXTERNAL DSMV, DSLI + PARAMETER(LOCRB=1,LOCIB=11) +C +C Modify the SLAP matrix data structure to YSMP-Column. +C***FIRST EXECUTABLE STATEMENT DSGS + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of elements in lower triangle of the matrix. + IF( ISYM.EQ.0 ) THEN + NEL = 0 + DO 20 ICOL = 1, N + JBGN = JA(ICOL) + JEND = JA(ICOL+1)-1 + DO 10 J = JBGN, JEND + IF( IA(J).GE.ICOL ) NEL = NEL + 1 + 10 CONTINUE + 20 CONTINUE + ELSE + NEL = JA(N+1)-1 + ENDIF +C +C Set up the work arrays. Then store the lower triangle of +C the matrix. +C + LOCJEL = LOCIB + LOCIEL = LOCJEL + N+1 + LOCIW = LOCIEL + NEL +C + LOCEL = LOCRB + LOCR = LOCEL + NEL + LOCZ = LOCR + N + LOCDZ = LOCZ + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSGS', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = NEL + IWORK(2) = LOCIEL + IWORK(3) = LOCJEL + IWORK(4) = LOCEL + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DS2LT( N, NELT, IA, JA, A, ISYM, NEL, IWORK(LOCIEL), + $ IWORK(LOCJEL), RWORK(LOCEL) ) +C +C Call iterative refinement routine. + CALL DIR(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSLI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCDZ), RWORK, IWORK ) +C +C Set the amount of Integer and Double Precision Workspace used. + IWORK(9) = LOCIW+N+NELT + IWORK(10) = LOCW+NELT + RETURN +C------------- LAST LINE OF DSGS FOLLOWS ------------------------------ + END +*DECK DSILUR + SUBROUTINE DSILUR(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSILUR +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSILUR-S), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU Iterative Refinement sparse Ax = b solver. +C Routine to solve a general linear system Ax = b using +C the incomplete LU decomposition with iterative refinement. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+NU+4*N+2), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(NEL+NU+4*N) +C +C CALL DSILUR(N, B, X, NELT, IA, JA, A, ISYM, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Integer A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "Description", +C below. If the SLAP Triad format is chosen it is changed +C internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Matrix A is not Positive Definite. +C $(p,Ap) < 0.0$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NEL is the number +C of non-zeros in the lower triangle of the matrix (including +C the diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NEL+NU+4*N. +C IWORK :WORK Integer IWORK(LENIW). +C Integer array used for workspace. NEL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the integer workspace, IWORK. LENIW >= +C NEL+NU+4*N+10. +C +C *Description +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to be +C the SLAP Column format. See above. +C +C *Portability: +C DSJAC, DSGS, DIR +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSILUS, DIR, DSMV, DSLUI +C***END PROLOGUE DSILUR + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, RWORK(LENW) + PARAMETER (LOCRB=1, LOCIB=11) +C + EXTERNAL DSMV, DSLUI +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSILUR + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements in preconditioner ILU +C matrix. Then set up the work arrays. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagonal. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIL = LOCIB + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCU = LOCDIN + N + LOCR = LOCU + NU + LOCZ = LOCR + N + LOCDZ = LOCZ + N + LOCW = LOCDZ + N +C +C Check the workspace allocations. + CALL DCHKW( 'DSILUR', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Do the Preconditioned Iterative Refinement iteration. + CALL DIR(N, B, X, NELT, IA, JA, A, ISYM, DSMV, DSLUI, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK(LOCR), + $ RWORK(LOCZ), RWORK(LOCDZ), RWORK, IWORK) + RETURN +C------------- LAST LINE OF DSILUR FOLLOWS ---------------------------- + END +*DECK ISDIR + FUNCTION ISDIR(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, + $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, IWORK, + $ BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDIR +C***REFER TO DIR, DSJAC, DSGS +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 880320 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDIR-S), +C Linear system, Sparse, Stop Test +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Iterative Refinement Stop Test. +C This routine calculates the stop test for the iterative +C refinement iteration scheme. It returns a nonzero if the +C error estimate (the type of which is determined by ITOL) +C is less than the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER +C INTEGER IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, R(N), Z(N), DZ(N) +C DOUBLE PRECISION RWORK(USER DEFINED), BNRM, SOLNRM +C EXTERNAL MSOLVE +C +C IF( ISDIR(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, R, Z, DZ, RWORK, IWORK, +C $ BNRM, SOLNRM) .NE. 0 ) THEN ITERATION DONE +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :IN Double Precision X(N). +C The current approximate solution vector. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "C *Description" in the +C DIR routine. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system Mz = r for +C z given r with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays. The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and z is the solution upon return. RWORK is a double +C precision array that can be used to pass necessary +C preconditioning information and/or workspace to MSOLVE. +C IWORK is an integer work array for the same purpose as RWORK. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITER :IN Integer. +C Current iteration count. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ERR :OUT Double Precision. +C Error estimate of error in the X(N) approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual R = B-AX. +C Z :WORK Double Precision Z(N). +C Workspace used to hold the pseudo-residual M z = r. +C DZ :WORK Double Precision DZ(N). +C Workspace used to hold temporary vector(s). +C RWORK :WORK Double Precision RWORK(USER DEFINABLE). +C Double Precision array that can be used by MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINABLE). +C Integer array that can be used by MSOLVE. +C BNRM :INOUT Double Precision. +C Norm of the right hand side. Type of norm depends on ITOL. +C Calculated only on the first call. +C SOLNRM :INOUT Double Precision. +C 2-Norm of the true solution, SOLN. Only computed and used +C if ITOL = 11. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C *See Also: +C DIR, DSJAC, DSGS +C +C *Cautions: +C This routine will attempt to write to the fortran logical output +C unit IUNIT, if IUNIT .ne. 0. Thus, the user must make sure that +C this logical unit must be attached to a file or terminal +C before calling this routine with a non-zero value for IUNIT. +C This routine does not check for the validity of a non-zero IUNIT +C unit number. +C +C***REFERENCES (NONE) +C***ROUTINES CALLED MSOLVE, DNRM2 +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDIR + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, ITOL, ITMAX, ITER + INTEGER IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), R(N), Z(N), DZ(N), RWORK(*) + EXTERNAL MSOLVE + COMMON /SOLBLK/ SOLN(1) +C +C***FIRST EXECUTABLE STATEMENT ISDIR + ISDIR = 0 + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, B, DZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) + BNRM = DNRM2(N, DZ, 1) + ENDIF + ERR = DNRM2(N, Z, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF( ITER.EQ.0 ) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + DZ(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C + IF( IUNIT.NE.0 ) THEN + WRITE(IUNIT,1000) ITER,ERR + ENDIF +C + IF( ERR.LE.TOL ) ISDIR = 1 +C + RETURN + 1000 FORMAT(5X,'ITER = ',I4,' Error Estimate = ',E16.7) +C------------- LAST LINE OF ISDIR FOLLOWS ----------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dlapqc.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dlapqc.f new file mode 100644 index 0000000000..b7200ec8c2 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dlapqc.f @@ -0,0 +1,794 @@ + PROGRAM DLAPQC +C***BEGIN PROLOGUE DLAPQC +C***SUBSIDIARY +C***PURPOSE Driver for testing SLATEC Sparse Linear Algebra Package +C (SLAP) Version 2.0. +C***LIBRARY SLATEC(SLAP) +C***CATEGORY D2A4, D2B4 +C***TYPE SINGLE (DLAPQC-S) +C***KEYWORDS QUICK CHECK DRIVER, SLAP +C***AUTHOR Mark K. Seager (LLNL) +C seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 +C (415)423-3141 +C***DESCRIPTION +C +C *Usage: +C One input data record is required +C READ (LIN,990) KPRINT +C 999 FORMAT (I1) +C +C *Arguments: +C KPRINT = 0 Quick checks - No printing. +C Driver - Short pass or fail message printed. +C 1 Quick checks - No message printed for passed tests, +C short message printed for failed tests. +C Driver - Short pass or fail message printed. +C 2 Quick checks - Print short message for passed tests, +C fuller information for failed tests. +C Driver - Pass or fail message printed. +C 3 Quick checks - Print complete quick check results. +C Driver - Pass or fail message printed. +C 4 Quick checks - Print complete quick check results. +C Prints matricies, etc. Very verbose. +C Driver - Pass or fail message printed. +C +C *Description: +C The +C Sparse Linear Algebra Package +C +C @@@@@@@ @ @@@ @@@@@@@@ +C @ @ @ @ @ @ @ +C @ @ @ @ @ @ +C @@@@@@@ @ @ @ @@@@@@@@ +C @ @ @@@@@@@@@ @ +C @ @ @ @ @ @ +C @@@@@@@ @@@@@@@@@ @ @ @ +C +C @ @ @@@@@@@ @@@@@ +C @ @ @ @ @ @@ +C @ @ @@@@@@@ @ @@ @ @ @ @ +C @ @ @ @ @@ @ @@@@@@ @ @ @ +C @ @ @@@@@@@@@ @ @ @ @ @ +C @ @ @ @ @ @@@ @@ @ +C @@@ @@@@@@@ @ @@@@@@@@@ @@@ @@@@@ +C +C---------------------------------------------------------------------- +C Written By +C Mark K. Seager (LLNL) +C Lawrence Livermore National Lab. +C PO Box 808, L-300 +C Livermore, CA 94550 +C (415) 423-3141 +C seager@lll-crg.llnl.gov +C---------------------------------------------------------------------- +C This is a SLATEC Quick Checks program to test the *SLAP* +C Version 2.0 package. It generates a "random" matrix (See +C DRMGEN) and then runs all the various methods with all the +C various preconditoners and all the various stop tests. +C +C It is assumed that the test is being run interactively and +C that STDIN (STANDARD INPUT) is Fortran I/O unit I1MACH(1) +C and STDOUT (STANDARD OUTPUT) is unit I1MACH(2). +C +C ************************************************************* +C **** WARNING !!! WARNING !!! WARNING !!! WARNING !!! WARNING +C ************************************************************* +C **** THIS PROGRAM WILL NOT FUNCTION PROPERLY IF THE FORTRAN +C **** I/O UNITS I1MACH(1) and I1MACH(2) are not connected +C **** to the program for I/O. +C ************************************************************* +C +C All errors in the driver are handled with the SLATEC error +C handler (revision date 851111). +C +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCPPLT, DSJAC, DSGS, DSILUR, DSDCG, DSICCG, +C DSDCGN, DSLUCN, DSDBCG, DSLUBC, DSDCGS, DSLUCS, +C DSDOMN, DSLUOM, DSDCMR, DSLUCM +C***REVISION HISTORY (YYMMDD) +C 880601 DATE WRITTEN +C 881213 Revised to meet the new SLATEC prologue standards. +C***END PROLOGUE DLAPQC + PARAMETER(MAXN=441, MXNELT=50000, MAXIW=50000, MAXRW=50000) +C$$$ PARAMETER(MAXN=25, MXNELT=50000, MAXIW=50000, MAXRW=50000) + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + CHARACTER*72 MESG + DOUBLE PRECISION A(MXNELT), F(MAXN), XITER(MAXN), RWORK(MAXRW) + INTEGER IA(MXNELT), JA(MXNELT), IWORK(MAXIW) + COMMON /SOLBLK/ SOLN(MAXN) +C +C The following lines is for the braindammaged Sun FPE handler. +C +C$$$ integer oldmode, fpmode +C$$$ oldmode = fpmode( 62464 ) +C +C READ KPRINT PARAMETER +C +C***FIRST EXECUTABLE STATEMENT DLAPQC +C + ISTDI = I1MACH(1) + ISTDO = I1MACH(2) + NFAIL = 0 + READ(ISTDI,990) KPRINT + 990 FORMAT(I1) + CALL XSETUN(LUN) + IF( KPRINT.LE.1 ) THEN + CALL XSETF(0) + ELSE + CALL XSETF(1) + ENDIF + CALL XERMAX(1000) +C +C Maximum problem sizes. +C + NELTMX = MXNELT + NMAX = MAXN + LENIW = MAXIW + LENW = MAXRW +C +C Set some input data. +C + N = NMAX + ITMAX = N + IOUT = KPRINT + FACTOR = 1.2 + IF( IOUT.LT.3 ) THEN + IUNIT = 0 + ELSE + IUNIT = ISTDO + ENDIF +C +C Set the Error tolerance to depend on the machine epsilon. +C + TOL = MAX(1.0D3*D1MACH(3),1.0D-6) +C +C Test routines using various convergence criteria. +C + DO 10 KASE = 3, 3 + IF(KASE .EQ. 1 .OR. KASE .EQ. 2) ITOL = KASE + IF(KASE .EQ. 3) ITOL = 11 +C +C Test routines using nonsymmetric (ISYM=0) and symmetric +C storage (ISYM=1). For ISYM=0 a really non-symmetric matrix +C is generated. The amount of non-symmetry is controlled by +C user. +C + DO 20 ISYM = 0, 1 +C +C Set up a random matrix. +C + CALL DRMGEN( NELTMX, FACTOR, IERR, N, NELT, + $ ISYM, IA, JA, A, F, SOLN, RWORK, IWORK, IWORK(N+1) ) + IF( IERR.NE.0 ) THEN + MESG = 'DLAPQC -- Fatal error (i1) generating '// + $ '*RANDOM* Matrix.' + CALL XERRWV( MESG,LEN(MESG),IERR,2,1,IERR,0, + $ 0,0.0,0.0 ) + ENDIF + IF( ISYM.EQ.0 ) THEN + DENS = FLOAT(NELT)/FLOAT(N*N) + ELSE + DENS = FLOAT(2*NELT)/FLOAT(N*N) + ENDIF + IF( IOUT.GE.2 ) THEN + WRITE(ISTDO,1020) N, NELT, DENS + WRITE(ISTDO,1030) TOL + ENDIF +C +C Convert to the SLAP-Column format and +C write out matrix in SLAP-Column format, if desired. +C + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) + IF( IOUT.GE.4 ) THEN + WRITE(ISTDO,1040) (K,IA(K),JA(K),A(K),K=1,NELT) + CALL DCPPLT( N, NELT, IA, JA, A, ISYM, ISTDO ) + ENDIF +C +C********************************************************************** +C BEGINING OF SLAP QUICK TESTS +C********************************************************************** +C +C * * * * * * DSJAC * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSJAC ', ITOL, ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSJAC(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, 2*ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSJAC ',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * DSGS * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSGS ',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSGS(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSGS ',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSILUR * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSILUR',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSILUR(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSILUR',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSDCG * * * * * * +C + IF( ISYM.EQ.1 ) THEN + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSDCG',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSDCG(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSDCG ',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + ENDIF +C +C * * * * * * DSICCG * * * * * * +C + IF( ISYM.EQ.1 ) THEN + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSICCG',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSICCG(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, + $ LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSICCG',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + ENDIF +C +C * * * * * * DSDCGN * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSDCGN',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSDCGN(N, F, XITER, NELT, IA, JA, A, ISYM, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C + CALL DUTERR( 'DSDCGN',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSLUCN * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSLUCN',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSLUCN(N, F, XITER, NELT, IA, JA, A, ISYM, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C + CALL DUTERR( 'DSLUCN',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSDBCG * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSDBCG',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSDBCG(N, F, XITER, NELT, IA, JA, A, ISYM, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C + CALL DUTERR( 'DSDBCG',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSLUBC * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSLUBC',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSLUBC(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSLUBC',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSDCGS * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSDCGS',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSDCGS(N, F, XITER, NELT, IA, JA, A, ISYM, ITOL, + $ TOL, ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, + $ IWORK, LENIW ) +C + CALL DUTERR( 'DSDCGS',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSLUCS * * * * * * +C + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1000) 'DSLUCS',ITOL,ISYM + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSLUCS(N, F, XITER, NELT, IA, JA, A, ISYM, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSLUCS',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) +C +C * * * * * * DSDOMN * * * * * * +C +CVD$ NOVECTOR + DO 30 NSAVE = 0, 3 + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1010) 'DSDOMN',ITOL, ISYM, NSAVE + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSDOMN(N, F, XITER, NELT, IA, JA, A, + $ ISYM, NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, + $ IUNIT, RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSDOMN',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + 30 CONTINUE +C +C * * * * * * DSLUOM * * * * * * +C +CVD$ NOVECTOR + DO 40 NSAVE=0,3 + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1010) 'DSLUOM',ITOL, ISYM, NSAVE + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSLUOM(N, F, XITER, NELT, IA, JA, A, + $ ISYM, NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, + $ IUNIT, RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSLUOM',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + 40 CONTINUE +C +C * * * * * * DSDGMR * * * * * * +C +CVD$ NOVECTOR + DO 50 NSAVE = 5, 12 + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1010) 'DSDGMR',ITOL, ISYM, NSAVE + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) + ITOLGM = 0 +C + CALL DSDGMR(N, F, XITER, NELT, IA, JA, A, + $ ISYM, NSAVE, ITOLGM, TOL, ITMAX, ITER, ERR, IERR, + $ IUNIT, RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSDGMR',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + 50 CONTINUE +C +C * * * * * * DSLUGM * * * * * * +C +CVD$ NOVECTOR + DO 60 NSAVE = 5, 12 + IF( IOUT.GE.3 ) THEN + WRITE(ISTDO,1010) 'DSLUGM',ITOL, ISYM, NSAVE + ENDIF + CALL DFILL( N, XITER, 0.0D0 ) +C + CALL DSLUGM(N, F, XITER, NELT, IA, JA, A, + $ ISYM, NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, + $ IUNIT, RWORK, LENW, IWORK, LENIW ) +C + CALL DUTERR( 'DSLUGM',IERR,IOUT,NFAIL,ISTDO,ITER,ERR ) + 60 CONTINUE + 20 CONTINUE + 10 CONTINUE +C + IF( NFAIL.EQ.0 ) THEN + WRITE(ISTDO,1050) + ELSE + WRITE(ISTDO,1060) NFAIL + ENDIF +C + STOP 'All Done' +C + 1000 FORMAT(/1X,A6,' : ITOL = ',I2,' ISYM = ',I1) + 1010 FORMAT(/1X,A6,' : ITOL = ',I2,' ISYM = ',I1,' NSAVE = ',I2) + 1020 FORMAT(/' * RANDOM Matrix of size',I5,'*' + $ /' ', + $ 'Number of non-zeros & Density = ', I5,E16.7) + 1030 FORMAT(' Error tolerance = ',E16.7) + 1040 FORMAT(/' ***** SLAP Column Matrix *****'/ + $ ' Indx ia ja a'/(1X,I4,1X,I4,1X,I4,1X,E16.7)) + 1050 FORMAT(// + $ '*******************************************************'/ + $ '**** All SLAP Double Precision Quick Checks Passed ****'/ + $ '**** No Errors ****'/ + $ '*******************************************************') + 1060 FORMAT(// + $ '************************************************'/ + $ '** ===>',I3,' Failures detected <=== **'/ + $ '** SLAP Double Precision Quick Checks **'/ + $ '** Set KPRINT = 3 for DEBUG information and **'/ + $ '** rerun the tests to determine the problem. **'/ + $ '************************************************') + END +*DECK DUTERR + SUBROUTINE DUTERR( METHOD, IERR, IOUT, NFAIL, ISTDO, ITER, ERR ) +C***BEGIN PROLOGUE DUTERR +C***SUBSIDIARY +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DUTERR-D), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Output error messages for the SLAP Quick Check +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DUTERR + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + CHARACTER*6 METHOD + INTEGER IERR, IOUT, NFAIL, ISTDO, ITER + DOUBLE PRECISION ERR +C +C***FIRST EXECUTABLE STATEMENT DUTERR + IF( IERR.NE.0 ) NFAIL = NFAIL+1 + IF( IOUT.EQ.1 .AND. IERR.NE.0 ) THEN + WRITE(ISTDO,1000) METHOD + ENDIF + IF( IOUT.EQ.2 ) THEN + IF( IERR.EQ.0 ) THEN + WRITE(ISTDO,1010) METHOD + ELSE + WRITE(ISTDO,1020) METHOD,IERR,ITER,ERR + ENDIF + ENDIF + IF( IOUT.GE.3 ) THEN + IF( IERR.EQ.0 ) THEN + WRITE(ISTDO,1030) METHOD,IERR,ITER,ERR + ELSE + WRITE(ISTDO,1020) METHOD,IERR,ITER,ERR + ENDIF + ENDIF + RETURN + 1000 FORMAT( 1X,A6,' : **** FAILURE ****') + 1010 FORMAT( 1X,A6,' : **** PASSED ****') + 1020 FORMAT(' **************** WARNING ***********************'/ + $ ' **** ',A6,' Quick Test FAILED: IERR = ',I5,' ****'/ + $ ' **************** WARNING ***********************'/ + $ ' Iteration Count = ',I3,' Stop Test = ',E12.6) + 1030 FORMAT(' ***************** PASSED ***********************'/ + $ ' **** ',A6,' Quick Test PASSED: IERR = ',I5,' ****'/ + $ ' ***************** PASSED ***********************'/ + $ ' Iteration Count = ',I3,' Stop Test = ',E12.6) +C------------- LAST LINE OF DUTERR FOLLOWS ---------------------------- + END +*DECK DRMGEN + SUBROUTINE DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM, + $ IA, JA, A, F, SOLN, DSUM, ITMP, IDIAG ) +C***BEGIN PROLOGUE DRMGEN +C***SUBSIDIARY +C***PURPOSE This routine generates a "Random" symmetric or +C non-symmetric matrix of size N for use in the SLAP +C Quick Checks. +C***LIBRARY SLATEC(SLAP) +C***AUTHOR Seager, Mark K., (LLNL) +C seager@lll-crg.llnl.gov +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 +C (415)423-3141 +C***DESCRIPTION +C +C *Usage: +C INTEGER NELTMX, IERR, N, NELT, ISYM, +C INTEGER IA(NELTMX), JA(NELTMX), ITMP(N), IDIAG(N) +C DOUBLE PRECISION FACTOR, A(NELTMX), F(N), SOLN(N), DSUM(N) +C +C CALL DRMGEN( NELTMX, FACTOR, IERR, N, NELT, ISYM, +C $ IA, JA, A, F, SOLN, DSUM, ITMP, IDIAG ) +C +C *Arguments: +C +C NELTMX :IN Integer. +C Maximum number of non-zeros that can be created by this +C routine for storage in the IA, JA, A arrays, see below. +C FACTOR :IN Double Precision. +C Non-zeros in the upper triangle are set to FACTOR times +C the coresponding entry in the lower triangle when a non- +C symmetric matrix is requested (See ISYM, below). +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => everything went OK. +C = 1 => Ran out of space trying to create matrix. +C Set NELTMX to something larger and retry. +C N :IN Integer. +C Size of the linear system to generate (number of unknowns). +C NELT :OUT Integer. +C Number of non-zeros stored in the IA, JA, A arrays, see below. +C ISYM :IN Integer. +C Flag to indicate the type of matrix to generate: +C ISYM = 0 => Non-Symmetric Matrix (See FACTOR, above). +C = 1 => Symmetric Matrix. +C IA :OUT Integer IA(NELTMX). +C Stores the row indicies for the non-zeros. +C JA :OUT Integer JA(NELTMX). +C Stores the column indicies for the non-zeros. +C A :OUT Double Precision A(NELTMX). +C Stores the values of the non-zeros. +C F :OUT Double Precision F(N). +C The right hand side of the linear system. Obtained by mult- +C iplying the matrix time SOLN, see below. +C SOLN :OUT Double Precision SOLN(N). +C The true solution to the linear system. Each component is +C chosen at random (0.0 Read only the matrix. +C = 1 => Read matrix and RHS (if present). +C = 2 => Read matrix and SOLN (if present). +C = 3 => Read matrix, RHS and SOLN (if present). +C On output JOB indicates what operations were actually +C performed. +C -3 => Unable to parse matrix "CODE" from input file +C to determine if only the lower triangle of matrix +C is stored. +C -2 => Number of non-zeros (NELT) too large. +C -1 => System size (N) too large. +C JOB = 0 => Read in only the matrix. +C = 1 => Read in the matrix and RHS. +C = 2 => Read in the matrix and SOLN. +C = 3 => Read in the matrix, RHS and SOLN. +C = 10 => Read in only the matrix *STRUCTURE*, but no +C non-zero entries. Hence, A(*) is not referenced +C and has the return values the same as the input. +C = 11 => Read in the matrix *STRUCTURE* and RHS. +C = 12 => Read in the matrix *STRUCTURE* and SOLN. +C = 13 => Read in the matrix *STRUCTURE*, RHS and SOLN. +C +C *Precision: Double Precision +C *Portability: +C You must make sure that IUNIT is a valid Fortran logical +C I/O device unit number and that the unit number has been +C associated with a file or the console. This is a system +C dependent function. +C +C***LONG DESCRIPTION +C The format for the output is as follows. On the first line +C are counters and flags: N, NELT, ISYM, IRHS, ISOLN. N, NELT +C and ISYM are described above. IRHS is a flag indicating if +C the RHS was written out (1 is yes, 0 is no). ISOLN is a +C flag indicating if the SOLN was written out (1 is yes, 0 is +C no). The format for the fist line is: 5i10. Then comes the +C NELT Triad's IA(I), JA(I) and A(I), I = 1, NELT. The format +C for these lines is : 1X,I5,1X,I5,1X,E16.7. Then comes +C RHS(I), I = 1, N, if IRHS = 1. Then comes SOLN(I), I = 1, +C N, if ISOLN = 1. The format for these lines is: 1X,E16.7. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DBHIN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, JOB + DOUBLE PRECISION A(NELT), RHS(N), SOLN(N) +C +C Local Variables +C + CHARACTER*80 TITLE + CHARACTER*3 CODE + CHARACTER*16 PNTFMT, RINFMT + CHARACTER*20 NVLFMT, RHSFMT +C + INTEGER NLINE, NPLS, NRILS, NNVLS, NRHSLS, NROW, NCOL, NIND, NELE +C +C Read Matrices In BOEING-HARWELL format. +C +C NLINE Number of Data (after the header) lines in the file. +C NPLS Number of lines for the Column Pointer data in the file. +C NRILS Number of lines for the Row indicies in the data file. +C NNVLS Number of lines for the Matrix elements in the data file. +C NRHSLS Number of lines for the RHS in the data file. +C +C***FIRST EXECUTABLE STATEMENT DBHIN + READ(IUNIT,9000) TITLE + READ(IUNIT,9010) NLINE, NPLS, NRILS, NNVLS, NRHSLS + READ(IUNIT,9020) CODE, NROW, NCOL, NIND, NELE + READ(IUNIT,9030) PNTFMT, RINFMT, NVLFMT, RHSFMT +C + IF( NROW.GT.N ) THEN + N = NROW + JOBRET = -1 + GOTO 999 + ENDIF + IF( NIND.GT.NELT ) THEN + NELT = NIND + JOBRET = -2 + GOTO 999 + ENDIF +C +C Set the parameters. +C + N = NROW + NELT = NIND + IF( CODE.EQ.'RUA' ) THEN + ISYM = 0 + ELSE IF( CODE.EQ.'RSA' ) THEN + ISYM = 1 + ELSE + JOBRET = -3 + GOTO 999 + ENDIF + READ(IUNIT,PNTFMT) (JA(I), I = 1, N+1) + READ(IUNIT,RINFMT) (IA(I), I = 1, NELT) + JOBRET = 10 + IF( NNVLS.GT.0 ) THEN + READ(IUNIT,NVLFMT) (A(I), I = 1, NELT) + JOBRET = 0 + ENDIF + IF( NRHSLS.GT.0 .AND. MOD(JOB,2).EQ.1 ) THEN + READ(5,RHSFMT) (RHS(I), I = 1, N) + JOBRET = JOBRET + 1 + ENDIF +C +C Now loop thru the IA(i) array making sure that the Diagonal +C matrix element appears first in the column. Then sort the +C rest of the column in ascending order. +C +CVD$R NOCONCUR +CVD$R NOVECTOR + DO 70 ICOL = 1, N + IBGN = JA(ICOL) + IEND = JA(ICOL+1)-1 + DO 30 I = IBGN, IEND + IF( IA(I).EQ.ICOL ) THEN +C Swap the diag element with the first element in the column. + ITEMP = IA(I) + IA(I) = IA(IBGN) + IA(IBGN) = ITEMP + TEMP = A(I) + A(I) = A(IBGN) + A(IBGN) = TEMP + GOTO 40 + ENDIF + 30 CONTINUE + 40 IBGN = IBGN + 1 + IF( IBGN.LT.IEND ) THEN + DO 60 I = IBGN, IEND + DO 50 J = I+1, IEND + IF( IA(I).GT.IA(J) ) THEN + ITEMP = IA(I) + IA(I) = IA(J) + IA(J) = ITEMP + TEMP = A(I) + A(I) = A(J) + A(J) = TEMP + ENDIF + 50 CONTINUE + 60 CONTINUE + ENDIF + 70 CONTINUE +C +C Set return flag. + 999 JOB = JOBRET + RETURN + 9000 FORMAT( A80 ) + 9010 FORMAT( 5I14 ) + 9020 FORMAT( A3, 11X, 4I14 ) + 9030 FORMAT( 2A16, 2A20 ) +C------------- LAST LINE OF DBHIN FOLLOWS ------------------------------ + END +*DECK DCHKW + SUBROUTINE DCHKW( NAME, LOCIW, LENIW, LOCW, LENW, + $ IERR, ITER, ERR ) +C***BEGIN PROLOGUE DCHKW +C***DATE WRITTEN 880225 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. R2 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DCHKW-D), +C SLAP, Error Checking, Workspace Checking +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP WORK/IWORK Array Bounds Checker. +C This routine checks the work array lengths and inter- +C faces to the SLATEC error handler if a problem is +C found. +C***DESCRIPTION +C *Usage: +C CHARACTER*(*) NAME +C INTEGER LOCIW, LENIW, LOCW, LENW, IERR, ITER +C DOUBLE PRECISION ERR +C +C CALL DCHKW( NAME, LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) +C +C *Arguments: +C NAME :IN Character*(*). +C Name of the calling routine. This is used in the output +C message, if an error is detected. +C LOCIW :IN Integer. +C Location of the first free element in the integer workspace +C array. +C LENIW :IN Integer. +C Length of the integer workspace array. +C LOCW :IN Integer. +C Location of the first free element in the double precision +C workspace array. +C LENRW :IN Integer. +C Length of the double precision workspace array. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated for +C WORK or IWORK. +C ITER :OUT Integer. +C Set to 0 if an error is detected. +C ERR :OUT Double Precision. +C Set to a very large number if an error is detected. +C +C *Precision: Double Precision +C +C***REFERENCES (NONE) +C***ROUTINES CALLED D1MACH, XERRWV +C***END PROLOGUE DCHKW + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + CHARACTER*(*) NAME + CHARACTER*72 MESG + INTEGER LOCIW, LENIW, LOCW, LENW, IERR, ITER + DOUBLE PRECISION ERR, D1MACH + EXTERNAL D1MACH, XERRWV +C +C Check the Integer workspace situation. +C***FIRST EXECUTABLE STATEMENT DCHKW + IERR = 0 + IF( LOCIW.GT.LENIW ) THEN + IERR = 1 + ITER = 0 + ERR = D1MACH(2) + MESG = NAME // ': INTEGER work array too short. '// + $ ' IWORK needs i1: have allocated i2.' + CALL XERRWV( MESG, LEN(MESG), 1, 1, 2, LOCIW, LENIW, + $ 0, 0.0, 0.0 ) + ENDIF +C +C Check the Double Precision workspace situation. + IF( LOCW.GT.LENW ) THEN + IERR = 1 + ITER = 0 + ERR = D1MACH(2) + MESG = NAME // ': DOUBLE PRECISION work array too short. '// + $ ' RWORK needs i1: have allocated i2.' + CALL XERRWV( MESG, LEN(MESG), 1, 1, 2, LOCW, LENW, + $ 0, 0.0, 0.0 ) + ENDIF + RETURN +C------------- LAST LINE OF DCHKW FOLLOWS ---------------------------- + END +*DECK QS2I1D + SUBROUTINE QS2I1D( IA, JA, A, N, KFLAG ) +C***BEGIN PROLOGUE QS2I1D +C***DATE WRITTEN 761118 (YYMMDD) +C***REVISION DATE 890125 (YYMMDD) +C***CATEGORY NO. N6A2A +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=INTEGER(QS2I1D-I), +C QUICKSORT,DOUBLETON QUICKSORT,SORT,SORTING +C***AUTHOR Jones, R. E., (SNLA) +C Kahaner, D. K., (NBS) +C Seager, M. K., (LLNL) seager@lll-crg.llnl.gov +C Wisniewski, J. A., (SNLA) +C***PURPOSE Sort an integer array also moving an integer and DP array +C This routine sorts the integer array IA and makes the +C same interchanges in the integer array JA and the +C double precision array A. The array IA may be sorted +C in increasing order or decreas- ing order. A slightly +C modified QUICKSORT algorithm is used. +C +C***DESCRIPTION +C Written by Rondall E Jones +C Modified by John A. Wisniewski to use the Singleton QUICKSORT +C algorithm. date 18 November 1976. +C +C Further modified by David K. Kahaner +C National Bureau of Standards +C August, 1981 +C +C Even further modification made to bring the code up to the +C Fortran 77 level and make it more readable and to carry +C along one integer array and one double precision array during +C the sort by +C Mark K. Seager +C Lawrence Livermore National Laboratory +C November, 1987 +C This routine was adapted from the ISORT routine. +C +C ABSTRACT +C This routine sorts an integer array IA and makes the same +C interchanges in the integer array JA and the double precision +C array A. +C The array a may be sorted in increasing order or decreasing +C order. A slightly modified quicksort algorithm is used. +C +C DESCRIPTION OF PARAMETERS +C IA - Integer array of values to be sorted. +C JA - Integer array to be carried along. +C A - Double Precision array to be carried along. +C N - Number of values in integer array IA to be sorted. +C KFLAG - Control parameter +C = 1 means sort IA in INCREASING order. +C =-1 means sort IA in DECREASING order. +C +C***REFERENCES +C Singleton, R. C., Algorithm 347, "An Efficient Algorithm for +C Sorting with Minimal Storage", cacm, Vol. 12, No. 3, 1969, +C Pp. 185-187. +C***ROUTINES CALLED XERROR +C***END PROLOGUE QS2I1D + IMPLICIT DOUBLE PRECISION(A-H,O-Z) +CVD$R NOVECTOR +CVD$R NOCONCUR + DIMENSION IL(21),IU(21) + INTEGER IA(N),JA(N),IT,IIT,JT,JJT + DOUBLE PRECISION A(N), TA, TTA +C +C***FIRST EXECUTABLE STATEMENT QS2I1D + NN = N + IF (NN.LT.1) THEN + CALL XERROR ( 'QS2I1D- the number of values to be sorted was no + $T POSITIVE.',59,1,1) + RETURN + ENDIF + IF( N.EQ.1 ) RETURN + KK = IABS(KFLAG) + IF ( KK.NE.1 ) THEN + CALL XERROR ( 'QS2I1D- the sort control parameter, k, was not 1 + $ OR -1.',55,2,1) + RETURN + ENDIF +C +C Alter array IA to get decreasing order if needed. +C + IF( KFLAG.LT.1 ) THEN + DO 20 I=1,NN + IA(I) = -IA(I) + 20 CONTINUE + ENDIF +C +C Sort IA and carry JA and A along. +C And now...Just a little black magic... + M = 1 + I = 1 + J = NN + R = .375 + 210 IF( R.LE.0.5898437 ) THEN + R = R + 3.90625E-2 + ELSE + R = R-.21875 + ENDIF + 225 K = I +C +C Select a central element of the array and save it in location +C it, jt, at. +C + IJ = I + IDINT( DBLE(J-I)*R ) + IT = IA(IJ) + JT = JA(IJ) + TA = A(IJ) +C +C If first element of array is greater than it, interchange with it. +C + IF( IA(I).GT.IT ) THEN + IA(IJ) = IA(I) + IA(I) = IT + IT = IA(IJ) + JA(IJ) = JA(I) + JA(I) = JT + JT = JA(IJ) + A(IJ) = A(I) + A(I) = TA + TA = A(IJ) + ENDIF + L=J +C +C If last element of array is less than it, swap with it. +C + IF( IA(J).LT.IT ) THEN + IA(IJ) = IA(J) + IA(J) = IT + IT = IA(IJ) + JA(IJ) = JA(J) + JA(J) = JT + JT = JA(IJ) + A(IJ) = A(J) + A(J) = TA + TA = A(IJ) +C +C If first element of array is greater than it, swap with it. +C + IF ( IA(I).GT.IT ) THEN + IA(IJ) = IA(I) + IA(I) = IT + IT = IA(IJ) + JA(IJ) = JA(I) + JA(I) = JT + JT = JA(IJ) + A(IJ) = A(I) + A(I) = TA + TA = A(IJ) + ENDIF + ENDIF +C +C Find an element in the second half of the array which is +C smaller than it. +C + 240 L=L-1 + IF( IA(L).GT.IT ) GO TO 240 +C +C Find an element in the first half of the array which is +C greater than it. +C + 245 K=K+1 + IF( IA(K).LT.IT ) GO TO 245 +C +C Interchange these elements. +C + IF( K.LE.L ) THEN + IIT = IA(L) + IA(L) = IA(K) + IA(K) = IIT + JJT = JA(L) + JA(L) = JA(K) + JA(K) = JJT + TTA = A(L) + A(L) = A(K) + A(K) = TTA + GOTO 240 + ENDIF +C +C Save upper and lower subscripts of the array yet to be sorted. +C + IF( L-I.GT.J-K ) THEN + IL(M) = I + IU(M) = L + I = K + M = M+1 + ELSE + IL(M) = K + IU(M) = J + J = L + M = M+1 + ENDIF + GO TO 260 +C +C Begin again on another portion of the unsorted array. +C + 255 M = M-1 + IF( M.EQ.0 ) GO TO 300 + I = IL(M) + J = IU(M) + 260 IF( J-I.GE.1 ) GO TO 225 + IF( I.EQ.J ) GO TO 255 + IF( I.EQ.1 ) GO TO 210 + I = I-1 + 265 I = I+1 + IF( I.EQ.J ) GO TO 255 + IT = IA(I+1) + JT = JA(I+1) + TA = A(I+1) + IF( IA(I).LE.IT ) GO TO 265 + K=I + 270 IA(K+1) = IA(K) + JA(K+1) = JA(K) + A(K+1) = A(K) + K = K-1 + IF( IT.LT.IA(K) ) GO TO 270 + IA(K+1) = IT + JA(K+1) = JT + A(K+1) = TA + GO TO 265 +C +C Clean up, if necessary. +C + 300 IF( KFLAG.LT.1 ) THEN + DO 310 I=1,NN + IA(I) = -IA(I) + 310 CONTINUE + ENDIF + RETURN +C------------- LAST LINE OF QS2I1D FOLLOWS ---------------------------- + END +*DECK DS2Y + SUBROUTINE DS2Y(N, NELT, IA, JA, A, ISYM ) +C***BEGIN PROLOGUE DS2Y +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DS2Y-D), +C Linear system, SLAP Sparse +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP Triad to SLAP Column Format Converter. +C Routine to convert from the SLAP Triad to SLAP Column +C format. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C DOUBLE PRECISION A(NELT) +C +C CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of non-zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "LONG +C DESCRIPTION", below. If the SLAP Triad format is used +C this format is translated to the SLAP Column format by +C this routine. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C +C *Precision: Double Precision +C +C***LONG DESCRIPTION +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures. If the SLAP Triad format is give +C as input then this routine transforms it into SLAP Column +C format. The way this routine tells which format is given as +C input is to look at JA(N+1). If JA(N+1) = NELT+1 then we +C have the SLAP Column format. If that equality does not hold +C then it is assumed that the IA, JA, A arrays contain the +C SLAP Triad format. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C***REFERENCES (NONE) +C***ROUTINES CALLED QS2I1D +C***END PROLOGUE DS2Y + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION A(NELT) +C +C Check to see if the (IA,JA,A) arrays are in SLAP Column +C format. If it's not then transform from SLAP Triad. +C***FIRST EXECUTABLE STATEMENT DS2LT + IF( JA(N+1).EQ.NELT+1 ) RETURN +C +C Sort into ascending order by COLUMN (on the ja array). +C This will line up the columns. +C + CALL QS2I1D( JA, IA, A, NELT, 1 ) +C +C Loop over each column to see where the column indicies change +C in the column index array ja. This marks the beginning of the +C next column. +C +CVD$R NOVECTOR + JA(1) = 1 + DO 20 ICOL = 1, N-1 + DO 10 J = JA(ICOL)+1, NELT + IF( JA(J).NE.ICOL ) THEN + JA(ICOL+1) = J + GOTO 20 + ENDIF + 10 CONTINUE + 20 CONTINUE + JA(N+1) = NELT+1 +C +C Mark the n+2 element so that future calls to a SLAP routine +C utilizing the YSMP-Column storage format will be able to tell. +C + JA(N+2) = 0 +C +C Now loop thru the ia(i) array making sure that the Diagonal +C matrix element appears first in the column. Then sort the +C rest of the column in ascending order. +C + DO 70 ICOL = 1, N + IBGN = JA(ICOL) + IEND = JA(ICOL+1)-1 + DO 30 I = IBGN, IEND + IF( IA(I).EQ.ICOL ) THEN +C Swap the diag element with the first element in the column. + ITEMP = IA(I) + IA(I) = IA(IBGN) + IA(IBGN) = ITEMP + TEMP = A(I) + A(I) = A(IBGN) + A(IBGN) = TEMP + GOTO 40 + ENDIF + 30 CONTINUE + 40 IBGN = IBGN + 1 + IF( IBGN.LT.IEND ) THEN + DO 60 I = IBGN, IEND + DO 50 J = I+1, IEND + IF( IA(I).GT.IA(J) ) THEN + ITEMP = IA(I) + IA(I) = IA(J) + IA(J) = ITEMP + TEMP = A(I) + A(I) = A(J) + A(J) = TEMP + ENDIF + 50 CONTINUE + 60 CONTINUE + ENDIF + 70 CONTINUE + RETURN +C------------- LAST LINE OF DS2Y FOLLOWS ---------------------------- + END +*DECK DCPPLT + SUBROUTINE DCPPLT( N, NELT, IA, JA, A, ISYM, IUNIT ) +C***BEGIN PROLOGUE DCPPLT +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DCPPLT-D), +C Linear system, SLAP Sparse, Diagnostics +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Printer Plot of SLAP Column Format Matrix. +C Routine to print out a SLAP Column format matrix in +C a "printer plot" graphical representation. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(N+1), ISYM, IUNIT +C DOUBLE PRECISION A(NELT) +C +C CALL DCPPLT( N, NELT, IA, JA, A, ISYM, IUNIT ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of non-zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(N+1). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP +C Column format. See "LONG DESCRIPTION", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C IUNIT :IN Integer. +C Fortran logical I/O device unit number to write the matrix +C to. This unit must be connected in a system dependent fashion +C to a file or the console or you will get a nasty message +C from the Fortran I/O libraries. +C +C *Precision: Double Precision +C *Portability: +C You must make sure that IUNIT is a valid Fortran logical +C I/O device unit number and that the unit number has been +C associated with a file or the console. This is a system +C dependent function. +C +C***LONG DESCRIPTION +C This routine prints out a SLAP Column format matrix to the +C Fortran logical I/O unit number IUNIT. The numbers them +C selves are not printed out, but rather a one character +C representation of the numbers. Elements of the matrix that +C are not represented in the (IA,JA,A) arrays are denoted by +C ' ' character (a blank). Elements of A that are *ZERO* (and +C hence should really not be stored) are denoted by a '0' +C character. Elements of A that are *POSITIVE* are denoted by +C 'D' if they are Diagonal elements and '#' if they are off +C Diagonal elements. Elements of A that are *NEGATIVE* are +C denoted by 'N' if they are Diagonal elements and '*' if +C they are off Diagonal elements. +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DCPPLT + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION A(NELT) + CHARACTER*225 CHMAT(225) +C +C Set up the character matrix... +C***FIRST EXECUTABLE STATEMENT DCPPLT + NMAX = MIN( 225, N) + DO 10 I = 1, NMAX + CHMAT(I)(1:NMAX) = ' ' + 10 CONTINUE + DO 30 ICOL = 1, NMAX + JBGN = JA(ICOL) + JEND = JA(ICOL+1)-1 + DO 20 J = JBGN, JEND + IROW = IA(J) + IF( IROW.LE.NMAX ) THEN + IF( ISYM.NE.0 ) THEN +C Put in non-dym part as well... + IF( A(J).EQ.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = '0' + ELSEIF( A(J).GT.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = '#' + ELSE + CHMAT(IROW)(ICOL:ICOL) = '*' + ENDIF + ENDIF + IF( IROW.EQ.ICOL ) THEN +C Diagonal entry. + IF( A(J).EQ.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = '0' + ELSEIF( A(J).GT.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = 'D' + ELSE + CHMAT(IROW)(ICOL:ICOL) = 'N' + ENDIF + ELSE +C Off-Diagonal entry + IF( A(J).EQ.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = '0' + ELSEIF( A(J).GT.0.0D0 ) THEN + CHMAT(IROW)(ICOL:ICOL) = '#' + ELSE + CHMAT(IROW)(ICOL:ICOL) = '*' + ENDIF + ENDIF + ENDIF + 20 CONTINUE + 30 CONTINUE +C +C Write out the heading. + WRITE(IUNIT,1000) N, NELT, FLOAT(NELT)/FLOAT(N*N) + WRITE(IUNIT,1010) (MOD(I,10),I=1,NMAX) +C +C Write out the character representations matrix elements. + DO 40 IROW = 1, NMAX + WRITE(IUNIT,1020) IROW, CHMAT(IROW)(1:NMAX) + 40 CONTINUE + RETURN + 1000 FORMAT(/'**** Picture of Column SLAP matrix follows ****'/ + $ ' N, NELT and Density = ',2I10,E16.7) + 1010 FORMAT(4X,255(I1)) + 1020 FORMAT(1X,I3,A) +C------------- LAST LINE OF DCPPLT FOLLOWS ---------------------------- + END +*DECK DTOUT + SUBROUTINE DTOUT( N, NELT, IA, JA, A, ISYM, SOLN, RHS, + $ IUNIT, JOB ) +C***BEGIN PROLOGUE DTOUT +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DTOUT-D), +C Linear system, SLAP Sparse, Diagnostics +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Write out SLAP Triad Format Linear System. +C Routine to write out a SLAP Triad format matrix and +C right hand side and solution to the system, if known. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IUNIT, JOB +C DOUBLE PRECISION A(NELT), SOLN(N), RHS(N) +C +C CALL DTOUT( N, NELT, IA, JA, A, ISYM, SOLN, RHS, IUNIT, JOB ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of non-zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP +C Triad format. See "LONG DESCRIPTION", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C SOLN :IN Double Precision SOLN(N). +C The solution to the linear system, if known. This array +C is accessed if and only if JOB is set to print it out, +C see below. +C RHS :IN Double Precision RHS(N). +C The right hand side vector. This array is accessed if and +C only if JOB is set to print it out, see below. +C IUNIT :IN Integer. +C Fortran logical I/O device unit number to write the matrix +C to. This unit must be connected in a system dependent fashion +C to a file or the console or you will get a nasty message +C from the Fortran I/O libraries. +C JOB :IN Integer. +C Flag indicating what I/O operations to perform. +C JOB = 0 => Print only the matrix. +C = 1 => Print matrix and RHS. +C = 2 => Print matrix and SOLN. +C = 3 => Print matrix, RHS and SOLN. +C +C *Precision: Double Precision +C *Portability: +C You must make sure that IUNIT is a valid Fortran logical +C I/O device unit number and that the unit number has been +C associated with a file or the console. This is a system +C dependent function. +C +C***LONG DESCRIPTION +C The format for the output is as follows. On the first line +C are counters and flags: N, NELT, ISYM, IRHS, ISOLN. N, NELT +C and ISYM are described above. IRHS is a flag indicating if +C the RHS was written out (1 is yes, 0 is no). ISOLN is a +C flag indicating if the SOLN was written out (1 is yes, 0 is +C no). The format for the fist line is: 5i10. Then comes the +C NELT Triad's IA(I), JA(I) and A(I), I = 1, NELT. The format +C for these lines is : 1X,I5,1X,I5,1X,E16.7. Then comes +C RHS(I), I = 1, N, if IRHS = 1. Then comes SOLN(I), I = 1, +C N, if ISOLN = 1. The format for these lines is: 1X,E16.7. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DTOUT + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, JOB + DOUBLE PRECISION A(NELT), RHS(N), SOLN(N) +C +C Local variables. +C + INTEGER IRHS, ISOLN, I +C +C If RHS and SOLN are to be printed also. +C Write out the information heading. +C***FIRST EXECUTABLE STATEMENT DTOUT + IRHS = 0 + ISOLN = 0 + IF( JOB.EQ.1 .OR. JOB.EQ.3 ) IRHS = 1 + IF( JOB.GT.1 ) ISOLN = 1 + WRITE(IUNIT,1000) N, NELT, ISYM, IRHS, ISOLN +C +C Write out the matrix non-zeros in Triad format. + DO 10 I = 1, NELT + WRITE(IUNIT,1010) IA(I), JA(I), A(I) + 10 CONTINUE +C +C If requested, write out the rhs. + IF( IRHS.EQ.1 ) THEN + WRITE(IUNIT,1020) (RHS(I),I=1,N) + ENDIF +C +C If requested, write out the soln. + IF( ISOLN.EQ.1 ) THEN + WRITE(IUNIT,1020) (SOLN(I),I=1,N) + ENDIF + RETURN + 1000 FORMAT(5I10) + 1010 FORMAT(1X,I5,1X,I5,1X,E16.7) + 1020 FORMAT(1X,E16.7) +C------------- LAST LINE OF DTOUT FOLLOWS ---------------------------- + END +*DECK DTIN + SUBROUTINE DTIN( N, NELT, IA, JA, A, ISYM, SOLN, RHS, + $ IUNIT, JOB ) +C***BEGIN PROLOGUE DTIN +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DTIN-D), +C Linear system, SLAP Sparse, Diagnostics +C***AUTHOR Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Read in SLAP Triad Format Linear System. +C Routine to read in a SLAP Triad format matrix and +C right hand side and solution to the system, if known. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IUNIT, JOB +C DOUBLE PRECISION A(NELT), SOLN(N), RHS(N) +C +C CALL DTIN( N, NELT, IA, JA, A, ISYM, SOLN, RHS, IUNIT, JOB ) +C +C *Arguments: +C N :OUT Integer +C Order of the Matrix. +C NELT :INOUT Integer. +C On input NELT is the maximum number of non-zeros that +C can be stored in the IA, JA, A arrays. +C On output NELT is the number of non-zeros stored in A. +C IA :OUT Integer IA(NELT). +C JA :OUT Integer JA(NELT). +C A :OUT Double Precision A(NELT). +C On output these arrays hold the matrix A in the SLAP +C Triad format. See "LONG DESCRIPTION", below. +C ISYM :OUT Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C SOLN :OUT Double Precision SOLN(N). +C The solution to the linear system, if present. This array +C is accessed if and only if JOB to read it in, see below. +C If the user requests that SOLN be read in, but it is not in +C the file, then it is simply zeroed out. +C RHS :OUT Double Precision RHS(N). +C The right hand side vector. This array is accessed if and +C only if JOB is set to read it in, see below. +C If the user requests that RHS be read in, but it is not in +C the file, then it is simply zeroed out. +C IUNIT :IN Integer. +C Fortran logical I/O device unit number to write the matrix +C to. This unit must be connected in a system dependent fashion +C to a file or the console or you will get a nasty message +C from the Fortran I/O libraries. +C JOB :INOUT Integer. +C Flag indicating what I/O operations to perform. +C On input JOB indicates what Input operations to try to +C perform. +C JOB = 0 => Read only the matrix. +C = 1 => Read matrix and RHS (if present). +C = 2 => Read matrix and SOLN (if present). +C = 3 => Read matrix, RHS and SOLN (if present). +C On output JOB indicates what operations were actually +C performed. +C JOB = 0 => Read in only the matrix. +C = 1 => Read in the matrix and RHS. +C = 2 => Read in the matrix and SOLN. +C = 3 => Read in the matrix, RHS and SOLN. +C +C *Precision: Double Precision +C *Portability: +C You must make sure that IUNIT is a valid Fortran logical +C I/O device unit number and that the unit number has been +C associated with a file or the console. This is a system +C dependent function. +C +C***LONG DESCRIPTION +C The format for the output is as follows. On the first line +C are counters and flags: N, NELT, ISYM, IRHS, ISOLN. N, NELT +C and ISYM are described above. IRHS is a flag indicating if +C the RHS was written out (1 is yes, 0 is no). ISOLN is a +C flag indicating if the SOLN was written out (1 is yes, 0 is +C no). The format for the fist line is: 5i10. Then comes the +C NELT Triad's IA(I), JA(I) and A(I), I = 1, NELT. The format +C for these lines is : 1X,I5,1X,I5,1X,E16.7. Then comes +C RHS(I), I = 1, N, if IRHS = 1. Then comes SOLN(I), I = 1, +C N, if ISOLN = 1. The format for these lines is: 1X,E16.7. +C +C =================== S L A P Triad format =================== +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DTIN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, JOB + DOUBLE PRECISION A(NELT), RHS(N), SOLN(N) +C +C Local variables. +C + INTEGER IRHS, ISOLN, I, NELTMAX +C +C Read in the information heading. +C***FIRST EXECUTABLE STATEMENT DTIN + NELTMAX = NELT + READ(IUNIT,1000) N, NELT, ISYM, IRHS, ISOLN + NELT = MIN( NELT, NELTMAX ) +C +C Read in the matrix non-zeros in Triad format. + DO 10 I = 1, NELT + READ(IUNIT,1010) IA(I), JA(I), A(I) + 10 CONTINUE +C +C If requested, read in the rhs. + JOBRET = 0 + IF( JOB.EQ.1 .OR. JOB.EQ.3 ) THEN +C +C Check to see if rhs is in the file. + IF( IRHS.EQ.1 ) THEN + JOBRET = 1 + READ(IUNIT,1020) (RHS(I),I=1,N) + ELSE + DO 20 I = 1, N + RHS(I) = 0.0D0 + 20 CONTINUE + ENDIF + ENDIF +C +C If requested, read in the soln. + IF( JOB.GT.1 ) THEN +C +C Check to see if soln is in the file. + IF( ISOLN.EQ.1 ) THEN + JOBRET = JOBRET + 2 + READ(IUNIT,1020) (SOLN(I),I=1,N) + ELSE + DO 30 I = 1, N + SOLN(I) = 0.0D0 + 30 CONTINUE + ENDIF + ENDIF +C + JOB = JOBRET + RETURN + 1000 FORMAT(5I10) + 1010 FORMAT(1X,I5,1X,I5,1X,E16.7) + 1020 FORMAT(1X,E16.7) +C------------- LAST LINE OF DTIN FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmset.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmset.f new file mode 100644 index 0000000000..42b1bd19a7 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmset.f @@ -0,0 +1,1222 @@ +*DECK DSDS + SUBROUTINE DSDS(N, NELT, IA, JA, A, ISYM, DINV) +C***BEGIN PROLOGUE DSDS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSDS-D), +C SLAP Sparse, Diagonal +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonal Scaling Preconditioner SLAP Set Up. +C Routine to compute the inverse of the diagonal of a matrix +C stored in the SLAP Column format. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C DOUBLE PRECISION A(NELT), DINV(N) +C +C CALL DSDS( N, NELT, IA, JA, A, ISYM, DINV ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C NELT :IN Integer. +C Number of elements in arrays IA, JA, and A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C DINV :OUT Double Precision DINV(N). +C Upon return this array holds 1./DIAG(A). +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format all of the "inner loops" of this +C routine should vectorize on machines with hardware support +C for vector gather/scatter operations. Your compiler may +C require a compiler directive to convince it that there are +C no implicit vector dependencies. Compiler directives for +C the Alliant FX/Fortran and CRI CFT/CFT77 compilers are +C supplied with the standard SLAP distribution. +C +C *Precision: Double Precision +C +C *Cautions: +C This routine assumes that the diagonal of A is all non-zero +C and that the operation DINV = 1.0/DIAG(A) will not underflow +C or overflow. This is done so that the loop vectorizes. +C Matricies with zero or near zero or very large entries will +C have numerical difficulties and must be fixed before this +C routine is called. +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSDS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION A(NELT), DINV(N) +C +C Assume the Diagonal elements are the first in each column. +C This loop should *VECTORIZE*. If it does not you may have +C to add a compiler directive. We do not check for a zero +C (or near zero) diagonal element since this would interfere +C with vectorization. If this makes you nervous put a check +C in! It will run much slower. +C***FIRST EXECUTABLE STATEMENT DSDS + 1 CONTINUE + DO 10 ICOL = 1, N + DINV(ICOL) = 1.0D0/A(JA(ICOL)) + 10 CONTINUE +C + RETURN +C------------- LAST LINE OF DSDS FOLLOWS ---------------------------- + END +*DECK DSDSCL + SUBROUTINE DSDSCL( N, NELT, IA, JA, A, ISYM, X, B, DINV, JOB, + $ ITOL ) +C***BEGIN PROLOGUE DSDSCL +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSDSCL-D), +C SLAP Sparse, Diagonal +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonal Scaling of system Ax = b. +C This routine scales (and unscales) the system Ax = b +C by symmetric diagonal scaling. The new system is: +C -1/2 -1/2 1/2 -1/2 +C D AD (D x) = D b +C when scaling is selected with the JOB parameter. When +C unscaling is selected this process is reversed. +C The true solution is also scaled or unscaled if ITOL is set +C appropriately, see below. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, JOB, ITOL +C DOUBLE PRECISION A(NELT), DINV(N) +C +C CALL DSDSCL( N, NELT, IA, JA, A, ISYM, X, B, DINV, JOB, ITOL ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of elements in arrays IA, JA, and A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C X :INOUT Double Precision X(N). +C Initial guess that will be later used in the iterative +C solution. +C of the scaled system. +C B :INOUT Double Precision B(N). +C Right hand side vector. +C DINV :OUT Double Precision DINV(N). +C Upon return this array holds 1./DIAG(A). +C JOB :IN Integer. +C Flag indicating weather to scale or not. JOB nonzero means +C do scaling. JOB = 0 means do unscaling. +C ITOL :IN Integer. +C Flag indicating what type of error estimation to do in the +C iterative method. When ITOL = 11 the exact solution from +C common block solblk will be used. When the system is scaled +C then the true solution must also be scaled. If ITOL is not +C 11 then this vector is not referenced. +C +C *Common Blocks: +C SOLN :INOUT Double Precision SOLN(N). COMMON BLOCK /SOLBLK/ +C The true solution, SOLN, is scaled (or unscaled) if ITOL is +C set to 11, see above. +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format all of the "inner loops" of this +C routine should vectorize on machines with hardware support +C for vector gather/scatter operations. Your compiler may +C require a compiler directive to convince it that there are +C no implicit vector dependencies. Compiler directives for +C the Alliant FX/Fortran and CRI CFT/CFT77 compilers are +C supplied with the standard SLAP distribution. +C +C *Precision: Double Precision +C +C *Cautions: +C This routine assumes that the diagonal of A is all non-zero +C and that the operation DINV = 1.0/DIAG(A) will not under- +C flow or overflow. This is done so that the loop vectorizes. +C Matricies with zero or near zero or very large entries will +C have numerical difficulties and must be fixed before this +C routine is called. +C +C *See Also: +C DSDCG +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSDSCL + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, JOB, ITOL + DOUBLE PRECISION A(NELT), X(N), B(N), DINV(N) + COMMON /SOLBLK/ SOLN(1) +C +C SCALING... +C + IF( JOB.NE.0 ) THEN + DO 10 ICOL = 1, N + DINV(ICOL) = 1.0D0/SQRT( A(JA(ICOL)) ) + 10 CONTINUE + ELSE +C +C UNSCALING... +C + DO 15 ICOL = 1, N + DINV(ICOL) = 1.0D0/DINV(ICOL) + 15 CONTINUE + ENDIF +C + DO 30 ICOL = 1, N + JBGN = JA(ICOL) + JEND = JA(ICOL+1)-1 + DI = DINV(ICOL) + DO 20 J = JBGN, JEND + A(J) = DINV(IA(J))*A(J)*DI + 20 CONTINUE + 30 CONTINUE +C + DO 40 ICOL = 1, N + B(ICOL) = B(ICOL)*DINV(ICOL) + X(ICOL) = X(ICOL)/DINV(ICOL) + 40 CONTINUE +C +C Check to see if we need to scale the "true solution" as well. +C + IF( ITOL.EQ.11 ) THEN + DO 50 ICOL = 1, N + SOLN(ICOL) = SOLN(ICOL)/DINV(ICOL) + 50 CONTINUE + ENDIF +C + RETURN + END +*DECK DSD2S + SUBROUTINE DSD2S(N, NELT, IA, JA, A, ISYM, DINV) +C***BEGIN PROLOGUE DSD2S +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSD2S-D), +C SLAP Sparse, Diagonal +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonal Scaling Preconditioner SLAP Normal Eqns Set Up. +C Routine to compute the inverse of the diagonal of the +C matrix A*A'. Where A is stored in SLAP-Column format. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C DOUBLE PRECISION A(NELT), DINV(N) +C +C CALL DSD2S( N, NELT, IA, JA, A, ISYM, DINV ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of elements in arrays IA, JA, and A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C DINV :OUT Double Precision DINV(N). +C Upon return this array holds 1./DIAG(A*A'). +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format all of the "inner loops" of this +C routine should vectorize on machines with hardware support +C for vector gather/scatter operations. Your compiler may +C require a compiler directive to convince it that there are +C no implicit vector dependencies. Compiler directives for +C the Alliant FX/Fortran and CRI CFT/CFT77 compilers are +C supplied with the standard SLAP distribution. +C +C *Precision: Double Precision +C +C *Cautions: +C This routine assumes that the diagonal of A is all non-zero +C and that the operation DINV = 1.0/DIAG(A*A') will not under- +C flow or overflow. This is done so that the loop vectorizes. +C Matricies with zero or near zero or very large entries will +C have numerical difficulties and must be fixed before this +C routine is called. +C +C *See Also: +C DSDCGN +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSD2S + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION A(NELT), DINV(N) +C +C***FIRST EXECUTABLE STATEMENT DSD2S + DO 10 I = 1, N + DINV(I) = 0. + 10 CONTINUE +C +C Loop over each column. +CVD$R NOCONCUR + DO 40 I = 1, N + KBGN = JA(I) + KEND = JA(I+1) - 1 +C +C Add in the contributions for each row that has a non-zero +C in this column. +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 20 K = KBGN, KEND + DINV(IA(K)) = DINV(IA(K)) + A(K)**2 + 20 CONTINUE + IF( ISYM.EQ.1 ) THEN +C +C Lower triangle stored by columns => upper triangle stored by +C rows with Diagonal being the first entry. Loop across the +C rest of the row. + KBGN = KBGN + 1 + IF( KBGN.LE.KEND ) THEN + DO 30 K = KBGN, KEND + DINV(I) = DINV(I) + A(K)**2 + 30 CONTINUE + ENDIF + ENDIF + 40 CONTINUE + DO 50 I=1,N + DINV(I) = 1./DINV(I) + 50 CONTINUE +C + RETURN +C------------- LAST LINE OF DSD2S FOLLOWS ---------------------------- + END +*DECK DS2LT + SUBROUTINE DS2LT( N, NELT, IA, JA, A, ISYM, NEL, IEL, JEL, EL ) +C***BEGIN PROLOGUE DS2LT +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DS2LT-D), +C Linear system, SLAP Sparse, Lower Triangle +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Lower Triangle Preconditioner SLAP Set Up. +C Routine to store the lower triangle of a matrix stored +C in the Slap Column format. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C INTEGER NEL, IEL(N+1), JEL(NEL), NROW(N) +C DOUBLE PRECISION A(NELT), EL(NEL) +C +C CALL DS2LT( N, NELT, IA, JA, A, ISYM, NEL, IEL, JEL, EL ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of non-zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C NEL :OUT Integer. +C Number of non-zeros in the lower triangle of A. Also +C coresponds to the length of the JEL, EL arrays. +C IEL :OUT Integer IEL(N+1). +C JEL :OUT Integer JEL(NEL). +C EL :OUT Double Precision EL(NEL). +C IEL, JEL, EL contain the lower triangle of the A matrix +C stored in SLAP Column format. See "Description", below +C for more details bout the SLAP Column format. +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DS2LT + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + INTEGER NEL, IEL(NEL), JEL(NEL) + DOUBLE PRECISION A(NELT), EL(NELT) +C***FIRST EXECUTABLE STATEMENT DS2LT + IF( ISYM.EQ.0 ) THEN +C +C The matrix is stored non-symmetricly. Pick out the lower +C triangle. +C + NEL = 0 + DO 20 ICOL = 1, N + JEL(ICOL) = NEL+1 + JBGN = JA(ICOL) + JEND = JA(ICOL+1)-1 +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GE.ICOL ) THEN + NEL = NEL + 1 + IEL(NEL) = IA(J) + EL(NEL) = A(J) + ENDIF + 10 CONTINUE + 20 CONTINUE + JEL(N+1) = NEL+1 + ELSE +C +C The matrix is symmetric and only the lower triangle is +C stored. Copy it to IEL, JEL, EL. +C + NEL = NELT + DO 30 I = 1, NELT + IEL(I) = IA(I) + EL(I) = A(I) + 30 CONTINUE + DO 40 I = 1, N+1 + JEL(I) = JA(I) + 40 CONTINUE + ENDIF + RETURN +C------------- LAST LINE OF DS2LT FOLLOWS ---------------------------- + END +*DECK DSICS + SUBROUTINE DSICS(N, NELT, IA, JA, A, ISYM, NEL, IEL, JEL, + $ EL, D, R, IWARN ) +C***BEGIN PROLOGUE DSICS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSICS-D), +C Linear system, SLAP Sparse, Iterative Precondition +C Incomplete Cholesky Factorization. +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incompl Cholesky Decomposition Preconditioner SLAP Set Up. +C Routine to generate the Incomplete Cholesky decomposition, +C L*D*L-trans, of a symmetric positive definite matrix, A, +C which is stored in SLAP Column format. The unit lower +C triangular matrix L is stored by rows, and the inverse of +C the diagonal matrix D is stored. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C INTEGER NEL, IEL(NEL), JEL(N+1), IWARN +C DOUBLE PRECISION A(NELT), EL(NEL), D(N), R(N) +C +C CALL DSICS( N, NELT, IA, JA, A, ISYM, NEL, IEL, JEL, EL, D, R, +C $ IWARN ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C NELT :IN Integer. +C Number of elements in arrays IA, JA, and A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C NEL :OUT Integer. +C Number of non-zeros in the lower triangle of A. Also +C coresponds to the length of the JEL, EL arrays. +C IEL :OUT Integer IEL(N+1). +C JEL :OUT Integer JEL(NEL). +C EL :OUT Double Precision EL(NEL). +C IEL, JEL, EL contain the unit lower triangular factor of the +C incomplete decomposition of the A matrix stored in SLAP +C Row format. The Diagonal of ones *IS* stored. See +C "Description", below for more details about the SLAP Row fmt. +C D :OUT Double Precision D(N) +C Upon return this array holds D(I) = 1./DIAG(A). +C R :WORK Double Precision R(N). +C Temporary double precision workspace needed for the +C factorization. +C IWARN :OUT Integer. +C This is a warning variable and is zero if the IC factoriza- +C tion goes well. It is set to the row index corresponding to +C the last zero pivot found. See "Description", below. +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format some of the "inner loops" of this +C routine should vectorize on machines with hardware support +C for vector gather/scatter operations. Your compiler may +C require a compiler directive to convince it that there are +C no implicit vector dependencies. Compiler directives for +C the Alliant FX/Fortran and CRI CFT/CFT77 compilers are +C supplied with the standard SLAP distribution. +C +C The IC factorization is not alway exist for SPD matricies. +C In the event that a zero pivot is found it is set to be 1.0 +C and the factorization procedes. The integer variable IWARN +C is set to the last row where the Diagonal was fudged. This +C eventuality hardly ever occurs in practice +C +C *Precision: Double Precision +C +C *See Also: +C SCG, DSICCG +C***REFERENCES 1. Gene Golub & Charles Van Loan, "Matrix Computations", +C John Hopkins University Press; 3 (1983) IBSN +C 0-8018-3010-9. +C***ROUTINES CALLED XERRWV +C***END PROLOGUE DSICS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + INTEGER NEL, IEL(NEL), JEL(NEL) + DOUBLE PRECISION A(NELT), EL(NEL), D(N), R(N) +C +C Set the lower triangle in IEL, JEL, EL +C***FIRST EXECUTABLE STATEMENT DSICS + IWARN = 0 +C +C All matrix elements stored in IA, JA, A. Pick out the lower +C triangle (making sure that the Diagonal of EL is one) and +C store by rows. +C + NEL = 1 + IEL(1) = 1 + JEL(1) = 1 + EL(1) = 1.0D0 + D(1) = A(1) +CVD$R NOCONCUR + DO 30 IROW = 2, N +C Put in the Diagonal. + NEL = NEL + 1 + IEL(IROW) = NEL + JEL(NEL) = IROW + EL(NEL) = 1.0D0 + D(IROW) = A(JA(IROW)) +C +C Look in all the lower triangle columns for a matching row. +C Since the matrix is symmetric, we can look across the +C irow-th row by looking down the irow-th column (if it is +C stored ISYM=0)... + IF( ISYM.EQ.0 ) THEN + ICBGN = JA(IROW) + ICEND = JA(IROW+1)-1 + ELSE + ICBGN = 1 + ICEND = IROW-1 + ENDIF + DO 20 IC = ICBGN, ICEND + IF( ISYM.EQ.0 ) THEN + ICOL = IA(IC) + IF( ICOL.GE.IROW ) GOTO 20 + ELSE + ICOL = IC + ENDIF + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND .AND. IA(JEND).GE.IROW ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).EQ.IROW ) THEN + NEL = NEL + 1 + JEL(NEL) = ICOL + EL(NEL) = A(J) + GOTO 20 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE + 30 CONTINUE + IEL(N+1) = NEL+1 +C +C Sort ROWS of lower triangle into descending order (count out +C along rows out from Diagonal). +C + DO 60 IROW = 2, N + IBGN = IEL(IROW)+1 + IEND = IEL(IROW+1)-1 + IF( IBGN.LT.IEND ) THEN + DO 50 I = IBGN, IEND-1 +CVD$ NOVECTOR + DO 40 J = I+1, IEND + IF( JEL(I).GT.JEL(J) ) THEN + JELTMP = JEL(J) + JEL(J) = JEL(I) + JEL(I) = JELTMP + ELTMP = EL(J) + EL(J) = EL(I) + EL(I) = ELTMP + ENDIF + 40 CONTINUE + 50 CONTINUE + ENDIF + 60 CONTINUE +C +C Perform the Incomplete Cholesky decomposition by looping +C over the rows. +C Scale the first column. Use the structure of A to pick out +C the rows with something in column 1. +C + IRBGN = JA(1)+1 + IREND = JA(2)-1 + DO 65 IRR = IRBGN, IREND + IR = IA(IRR) +C Find the index into EL for EL(1,IR). +C Hint: it's the second entry. + I = IEL(IR)+1 + EL(I) = EL(I)/D(1) + 65 CONTINUE +C + DO 110 IROW = 2, N +C +C Update the IROW-th diagonal. +C + DO 66 I = 1, IROW-1 + R(I) = 0.0D0 + 66 CONTINUE + IBGN = IEL(IROW)+1 + IEND = IEL(IROW+1)-1 + IF( IBGN.LE.IEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 70 I = IBGN, IEND + R(JEL(I)) = EL(I)*D(JEL(I)) + D(IROW) = D(IROW) - EL(I)*R(JEL(I)) + 70 CONTINUE +C +C Check to see if we gota problem with the diagonal. +C + IF( D(IROW).LE.0.0D0 ) THEN + IF( IWARN.EQ.0 ) IWARN = IROW + D(IROW) = 1.0D0 + ENDIF + ENDIF +C +C Update each EL(IROW+1:N,IROW), if there are any. +C Use the structure of A to determine the Non-zero elements +C of the IROW-th column of EL. +C + IRBGN = JA(IROW) + IREND = JA(IROW+1)-1 + DO 100 IRR = IRBGN, IREND + IR = IA(IRR) + IF( IR.LE.IROW ) GOTO 100 +C Find the index into EL for EL(IR,IROW) + IBGN = IEL(IR)+1 + IEND = IEL(IR+1)-1 + IF( JEL(IBGN).GT.IROW ) GOTO 100 + DO 90 I = IBGN, IEND + IF( JEL(I).EQ.IROW ) THEN + ICEND = IEND + 91 IF( JEL(ICEND).GE.IROW ) THEN + ICEND = ICEND - 1 + GOTO 91 + ENDIF +C Sum up the EL(IR,1:IROW-1)*R(1:IROW-1) contributions. +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 80 IC = IBGN, ICEND + EL(I) = EL(I) - EL(IC)*R(JEL(IC)) + 80 CONTINUE + EL(I) = EL(I)/D(IROW) + GOTO 100 + ENDIF + 90 CONTINUE +C +C If we get here, we have real problems... + +C WHL: Usually this means the matrix A is not symmetric. +C The preconditioner is fragile in the sense that it can fail with +C very small departures from symmetry (due to roundoff errors). + + CALL XERRWV('DSICS -- A and EL data structure mismatch'// + $ ' in row (i1)',53,1,2,1,IROW,0,0,0.0,0.0) + 100 CONTINUE + 110 CONTINUE +C +C Replace diagonals by their inverses. +C +CVD$ CONCUR + DO 120 I =1, N + D(I) = 1.0D0/D(I) + 120 CONTINUE + RETURN +C------------- LAST LINE OF DSICS FOLLOWS ---------------------------- + END +*DECK DSILUS + SUBROUTINE DSILUS(N, NELT, IA, JA, A, ISYM, NL, IL, JL, + $ L, DINV, NU, IU, JU, U, NROW, NCOL) +C***BEGIN PROLOGUE DSILUS +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSILUS-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Incomplete LU Factorization +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU Decomposition Preconditioner SLAP Set Up. +C Routine to generate the incomplete LDU decomposition of a +C matrix. The unit lower triangular factor L is stored by +C rows and the unit upper triangular factor U is stored by +C columns. The inverse of the diagonal matrix D is stored. +C No fill in is allowed. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM +C INTEGER NL, IL(N+1), JL(NL), NU, IU(N+1), JU(NU) +C INTEGER NROW(N), NCOL(N) +C DOUBLE PRECISION A(NELT), L(NL), U(NU), DINV(N) +C +C CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IL, JL, L, +C $ DINV, NU, IU, JU, U, NROW, NCOL ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C NELT :IN Integer. +C Number of elements in arrays IA, JA, and A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the lower +C triangle of the matrix is stored. +C NL :OUT Integer. +C Number of non-zeros in the EL array. +C IL :OUT Integer IL(N+1). +C JL :OUT Integer JL(NL). +C L :OUT Double Precision L(NL). +C IL, JL, L contain the unit ower triangular factor of the +C incomplete decomposition of some matrix stored in SLAP +C Row format. The Diagonal of ones *IS* stored. See +C "DESCRIPTION", below for more details about the SLAP format. +C NU :OUT Integer. +C Number of non-zeros in the U array. +C IU :OUT Integer IU(N+1). +C JU :OUT Integer JU(NU). +C U :OUT Double Precision U(NU). +C IU, JU, U contain the unit upper triangular factor of the +C incomplete decomposition of some matrix stored in SLAP +C Column format. The Diagonal of ones *IS* stored. See +C "Description", below for more details about the SLAP +C format. +C NROW :WORK Integer NROW(N). +C NROW(I) is the number of non-zero elements in the I-th row +C of L. +C NCOL :WORK Integer NCOL(N). +C NCOL(I) is the number of non-zero elements in the I-th +C column of U. +C +C *Description +C IL, JL, L should contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in SLAP +C Row format. IU, JU, U should contain the unit upper factor +C of the incomplete decomposition of the A matrix stored in +C SLAP Column format This ILU factorization can be computed by +C the DSILUS routine. The diagonals (which is all one's) are +C stored. +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *See Also: +C SILUR +C***REFERENCES 1. Gene Golub & Charles Van Loan, "Matrix Computations", +C John Hopkins University Press; 3 (1983) IBSN +C 0-8018-3010-9. +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSILUS + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NL, IL(NL), JL(NL) + INTEGER NU, IU(NU), JU(NU), NROW(N), NCOL(N) + DOUBLE PRECISION A(NELT), L(NL), DINV(N), U(NU) +C +C Count number of elements in each row of the lower triangle. +C***FIRST EXECUTABLE STATEMENT DSILUS + DO 10 I=1,N + NROW(I) = 0 + NCOL(I) = 0 + 10 CONTINUE +CVD$R NOCONCUR +CVD$R NOVECTOR + DO 30 ICOL = 1, N + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN + DO 20 J = JBGN, JEND + IF( IA(J).LT.ICOL ) THEN + NCOL(ICOL) = NCOL(ICOL) + 1 + ELSE + NROW(IA(J)) = NROW(IA(J)) + 1 + IF( ISYM.NE.0 ) NCOL(IA(J)) = NCOL(IA(J)) + 1 + ENDIF + 20 CONTINUE + ENDIF + 30 CONTINUE + JU(1) = 1 + IL(1) = 1 + DO 40 ICOL = 1, N + IL(ICOL+1) = IL(ICOL) + NROW(ICOL) + JU(ICOL+1) = JU(ICOL) + NCOL(ICOL) + NROW(ICOL) = IL(ICOL) + NCOL(ICOL) = JU(ICOL) + 40 CONTINUE +C +C Copy the matrix A into the L and U structures. + DO 60 ICOL = 1, N + DINV(ICOL) = A(JA(ICOL)) + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN + DO 50 J = JBGN, JEND + IROW = IA(J) + IF( IROW.LT.ICOL ) THEN +C Part of the upper triangle. + IU(NCOL(ICOL)) = IROW + U(NCOL(ICOL)) = A(J) + NCOL(ICOL) = NCOL(ICOL) + 1 + ELSE +C Part of the lower triangle (stored by row). + JL(NROW(IROW)) = ICOL + L(NROW(IROW)) = A(J) + NROW(IROW) = NROW(IROW) + 1 + IF( ISYM.NE.0 ) THEN +C Symmetric...Copy lower triangle into upper triangle as well. + IU(NCOL(IROW)) = ICOL + U(NCOL(IROW)) = A(J) + NCOL(IROW) = NCOL(IROW) + 1 + ENDIF + ENDIF + 50 CONTINUE + ENDIF + 60 CONTINUE +C +C Sort the rows of L and the columns of U. + DO 110 K = 2, N + JBGN = JU(K) + JEND = JU(K+1)-1 + IF( JBGN.LT.JEND ) THEN + DO 80 J = JBGN, JEND-1 + DO 70 I = J+1, JEND + IF( IU(J).GT.IU(I) ) THEN + ITEMP = IU(J) + IU(J) = IU(I) + IU(I) = ITEMP + TEMP = U(J) + U(J) = U(I) + U(I) = TEMP + ENDIF + 70 CONTINUE + 80 CONTINUE + ENDIF + IBGN = IL(K) + IEND = IL(K+1)-1 + IF( IBGN.LT.IEND ) THEN + DO 100 I = IBGN, IEND-1 + DO 90 J = I+1, IEND + IF( JL(I).GT.JL(J) ) THEN + JTEMP = JU(I) + JU(I) = JU(J) + JU(J) = JTEMP + TEMP = L(I) + L(I) = L(J) + L(J) = TEMP + ENDIF + 90 CONTINUE + 100 CONTINUE + ENDIF + 110 CONTINUE +C +C Perform the incomplete LDU decomposition. + DO 300 I=2,N +C +C I-th row of L + INDX1 = IL(I) + INDX2 = IL(I+1) - 1 + IF(INDX1 .GT. INDX2) GO TO 200 + DO 190 INDX=INDX1,INDX2 + IF(INDX .EQ. INDX1) GO TO 180 + INDXR1 = INDX1 + INDXR2 = INDX - 1 + INDXC1 = JU(JL(INDX)) + INDXC2 = JU(JL(INDX)+1) - 1 + IF(INDXC1 .GT. INDXC2) GO TO 180 + 160 KR = JL(INDXR1) + 170 KC = IU(INDXC1) + IF(KR .GT. KC) THEN + INDXC1 = INDXC1 + 1 + IF(INDXC1 .LE. INDXC2) GO TO 170 + ELSEIF(KR .LT. KC) THEN + INDXR1 = INDXR1 + 1 + IF(INDXR1 .LE. INDXR2) GO TO 160 + ELSEIF(KR .EQ. KC) THEN + L(INDX) = L(INDX) - L(INDXR1)*DINV(KC)*U(INDXC1) + INDXR1 = INDXR1 + 1 + INDXC1 = INDXC1 + 1 + IF(INDXR1 .LE. INDXR2 .AND. INDXC1 .LE. INDXC2) GO TO 160 + ENDIF + 180 L(INDX) = L(INDX)/DINV(JL(INDX)) + 190 CONTINUE +C +C ith column of u + 200 INDX1 = JU(I) + INDX2 = JU(I+1) - 1 + IF(INDX1 .GT. INDX2) GO TO 260 + DO 250 INDX=INDX1,INDX2 + IF(INDX .EQ. INDX1) GO TO 240 + INDXC1 = INDX1 + INDXC2 = INDX - 1 + INDXR1 = IL(IU(INDX)) + INDXR2 = IL(IU(INDX)+1) - 1 + IF(INDXR1 .GT. INDXR2) GO TO 240 + 210 KR = JL(INDXR1) + 220 KC = IU(INDXC1) + IF(KR .GT. KC) THEN + INDXC1 = INDXC1 + 1 + IF(INDXC1 .LE. INDXC2) GO TO 220 + ELSEIF(KR .LT. KC) THEN + INDXR1 = INDXR1 + 1 + IF(INDXR1 .LE. INDXR2) GO TO 210 + ELSEIF(KR .EQ. KC) THEN + U(INDX) = U(INDX) - L(INDXR1)*DINV(KC)*U(INDXC1) + INDXR1 = INDXR1 + 1 + INDXC1 = INDXC1 + 1 + IF(INDXR1 .LE. INDXR2 .AND. INDXC1 .LE. INDXC2) GO TO 210 + ENDIF + 240 U(INDX) = U(INDX)/DINV(IU(INDX)) + 250 CONTINUE +C +C ith diagonal element + 260 INDXR1 = IL(I) + INDXR2 = IL(I+1) - 1 + IF(INDXR1 .GT. INDXR2) GO TO 300 + INDXC1 = JU(I) + INDXC2 = JU(I+1) - 1 + IF(INDXC1 .GT. INDXC2) GO TO 300 + 270 KR = JL(INDXR1) + 280 KC = IU(INDXC1) + IF(KR .GT. KC) THEN + INDXC1 = INDXC1 + 1 + IF(INDXC1 .LE. INDXC2) GO TO 280 + ELSEIF(KR .LT. KC) THEN + INDXR1 = INDXR1 + 1 + IF(INDXR1 .LE. INDXR2) GO TO 270 + ELSEIF(KR .EQ. KC) THEN + DINV(I) = DINV(I) - L(INDXR1)*DINV(KC)*U(INDXC1) + INDXR1 = INDXR1 + 1 + INDXC1 = INDXC1 + 1 + IF(INDXR1 .LE. INDXR2 .AND. INDXC1 .LE. INDXC2) GO TO 270 + ENDIF +C + 300 CONTINUE +C +C replace diagonal lts by their inverses. +CVD$ VECTOR + DO 430 I=1,N + DINV(I) = 1./DINV(I) + 430 CONTINUE +C + RETURN +C------------- LAST LINE OF DSILUS FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmvops.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmvops.f new file mode 100644 index 0000000000..610c9cc7a5 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/dmvops.f @@ -0,0 +1,1476 @@ +*DECK DSMV + SUBROUTINE DSMV( N, X, Y, NELT, IA, JA, A, ISYM ) +C***BEGIN PROLOGUE DSMV +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSMV-S), +C Matrix Vector Multiply, Sparse +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP Column Format Sparse Matrix Vector Product. +C Routine to calculate the sparse matrix vector product: +C Y = A*X. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(N+1), ISYM +C DOUBLE PRECISION X(N), Y(N), A(NELT) +C +C CALL DSMV(N, X, Y, NELT, IA, JA, A, ISYM ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C X :IN Double Precision X(N). +C The vector that should be multiplied by the matrix. +C Y :OUT Double Precision Y(N). +C The product of the matrix and the vector. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(N+1). +C A :IN Integer A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format the "inner loops" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *Cautions: +C This routine assumes that the matrix A is stored in SLAP +C Column format. It does not check for this (for speed) and +C evil, ugly, ornery and nasty things will happen if the matrix +C data structure is, in fact, not SLAP Column. Beware of the +C wrong data structure!!! +C +C *See Also: +C DSMTV +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSMV + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION A(NELT), X(N), Y(N) +C +C Zero out the result vector. +C***FIRST EXECUTABLE STATEMENT DSMV + DO 10 I = 1, N + Y(I) = 0.0D0 + 10 CONTINUE +C +C Multiply by A. +C +CVD$R NOCONCUR + DO 30 ICOL = 1, N + IBGN = JA(ICOL) + IEND = JA(ICOL+1)-1 +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 20 I = IBGN, IEND + Y(IA(I)) = Y(IA(I)) + A(I)*X(ICOL) + 20 CONTINUE + 30 CONTINUE +C + IF( ISYM.EQ.1 ) THEN +C +C The matrix is non-symmetric. Need to get the other half in... +C This loops assumes that the diagonal is the first entry in +C each column. +C + DO 50 IROW = 1, N + JBGN = JA(IROW)+1 + JEND = JA(IROW+1)-1 + IF( JBGN.GT.JEND ) GOTO 50 + DO 40 J = JBGN, JEND + Y(IROW) = Y(IROW) + A(J)*X(IA(J)) + 40 CONTINUE + 50 CONTINUE + ENDIF + RETURN +C------------- LAST LINE OF DSMV FOLLOWS ---------------------------- + END +*DECK DSMTV + SUBROUTINE DSMTV( N, X, Y, NELT, IA, JA, A, ISYM ) +C***BEGIN PROLOGUE DSMTV +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSMTV-S), +C Matrix transpose Vector Multiply, Sparse +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP Column Format Sparse Matrix (transpose) Vector Prdt. +C Routine to calculate the sparse matrix vector product: +C Y = A'*X, where ' denotes transpose. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(N+1), ISYM +C DOUBLE PRECISION X(N), Y(N), A(NELT) +C +C CALL DSMTV(N, X, Y, NELT, IA, JA, A, ISYM ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C X :IN Double Precision X(N). +C The vector that should be multiplied by the transpose of +C the matrix. +C Y :OUT Double Precision Y(N). +C The product of the transpose of the matrix and the vector. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(N+1). +C A :IN Integer A(NELT). +C These arrays should hold the matrix A in the SLAP Column +C format. See "Description", below. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C +C *Description +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format the "inner loops" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *Cautions: +C This routine assumes that the matrix A is stored in SLAP +C Column format. It does not check for this (for speed) and +C evil, ugly, ornery and nasty things will happen if the matrix +C data structure is, in fact, not SLAP Column. Beware of the +C wrong data structure!!! +C +C *See Also: +C DSMV +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSMTV + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM + DOUBLE PRECISION X(N), Y(N), A(NELT) +C +C Zero out the result vector. +C***FIRST EXECUTABLE STATEMENT DSMTV + DO 10 I = 1, N + Y(I) = 0.0D0 + 10 CONTINUE +C +C Multiply by A-Transpose. +C A-Transpose is stored by rows... +CVD$R NOCONCUR + DO 30 IROW = 1, N + IBGN = JA(IROW) + IEND = JA(IROW+1)-1 +CVD$ ASSOC + DO 20 I = IBGN, IEND + Y(IROW) = Y(IROW) + A(I)*X(IA(I)) + 20 CONTINUE + 30 CONTINUE +C + IF( ISYM.EQ.1 ) THEN +C +C The matrix is non-symmetric. Need to get the other half in... +C This loops assumes that the diagonal is the first entry in +C each column. +C + DO 50 ICOL = 1, N + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.GT.JEND ) GOTO 50 +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 40 J = JBGN, JEND + Y(IA(J)) = Y(IA(J)) + A(J)*X(ICOL) + 40 CONTINUE + 50 CONTINUE + ENDIF + RETURN +C------------- LAST LINE OF DSMTV FOLLOWS ---------------------------- + END +*DECK DSDI + SUBROUTINE DSDI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C***BEGIN PROLOGUE DSDI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4, D2B4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSDI-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonal Matrix Vector Multiply. +C Routine to calculate the product X = DIAG*B, +C where DIAG is a diagonal matrix. +C***DESCRIPTION +C *Usage: +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Vector to multiply the diagonal by. +C X :OUT Double Precision X(N). +C Result of DIAG*B. +C NELT :DUMMY Integer. +C Retained for compatibility with SLAP MSOLVE calling sequence. +C IA :DUMMY Integer IA(NELT). +C Retained for compatibility with SLAP MSOLVE calling sequence. +C JA :DUMMY Integer JA(N+1). +C Retained for compatibility with SLAP MSOLVE calling sequence. +C A :DUMMY Double Precision A(NELT). +C Retained for compatibility with SLAP MSOLVE calling sequence. +C ISYM :DUMMY Integer. +C Retained for compatibility with SLAP MSOLVE calling sequence. +C RWORK :IN Double Precision RWORK(USER DEFINABLE). +C Work array holding the diagonal of some matrix to scale +C B by. This array must be set by the user or by a call +C to the slap routine DSDS or DSD2S. The length of RWORK +C must be > IWORK(4)+N. +C IWORK :IN Integer IWORK(10). +C IWORK(4) holds the offset into RWORK for the diagonal matrix +C to scale B by. This is usually set up by the SLAP pre- +C conditioner setup routines DSDS or DSD2S. +C +C *Description: +C This routine is supplied with the SLAP package to perform +C the MSOLVE operation for iterative drivers that require +C diagonal Scaling (e.g., DSDCG, DSDBCG). It conforms +C to the SLAP MSOLVE CALLING CONVENTION and hence does not +C require an interface routine as do some of the other pre- +C conditioners supplied with SLAP. +C +C *Precision: Double Precision +C *See Also: +C DSDS, DSD2S +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSDI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(10) + DOUBLE PRECISION B(N), X(N), A(NELT), RWORK(1) +C +C Determine where the inverse of the diagonal +C is in the work array and then scale by it. +C***FIRST EXECUTABLE STATEMENT DSDI + LOCD = IWORK(4) - 1 + DO 10 I = 1, N + X(I) = RWORK(LOCD+I)*B(I) + 10 CONTINUE + RETURN +C------------- LAST LINE OF DSDI FOLLOWS ---------------------------- + END +*DECK DSLI + SUBROUTINE DSLI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK ) +C***BEGIN PROLOGUE DSLI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLI-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP MSOLVE for Lower Triangle Matrix. +C This routine acts as an interface between the SLAP generic +C MSOLVE calling convention and the routine that actually +C -1 +C computes L B = X. +C +C *Description +C See the Description of SLLI2 for the gory details. +C***ROUTINES CALLED SLLI2 +C***END PROLOGUE DSLI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(10) + DOUBLE PRECISION B(N), X(N), A(NELT), RWORK(1) +C***FIRST EXECUTABLE STATEMENT DSLI +C + NEL = IWORK(1) + LOCIEL = IWORK(2) + LOCJEL = IWORK(3) + LOCEL = IWORK(4) + CALL DSLI2(N, B, X, NEL, IWORK(LOCIEL), IWORK(LOCJEL), + $ RWORK(LOCEL)) +C + RETURN +C------------- LAST LINE OF DSLI FOLLOWS ---------------------------- + END +*DECK DSLI2 + SUBROUTINE DSLI2(N, B, X, NEL, IEL, JEL, EL) +C***BEGIN PROLOGUE DSLI2 +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLI2-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP for Lower Triangle Matrix Backsolve. +C Routine to solve a system of the form Lx = b , where +C L is a lower triangular matrix. +C***DESCRIPTION +C *Usage: +C INTEGER N, NEL, IEL(N+1), JEL(NEL) +C DOUBLE PRECISION B(N), X(N), EL(NEL) +C +C CALL DSLI2( N, B, X, NEL, IEL, JEL, EL ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right hand side vector. +C X :OUT Double Precision X(N). +C Solution to Lx = b. +C NEL :IN Integer. +C Number of non-zeros in the EL array. +C IEL :IN Integer IEL(N+1). +C JEL :IN Integer JEL(NEL). +C EL :IN Double Precision EL(NEL). +C IEL, JEL, EL contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in +C SLAP Row format. The diagonal of ones *IS* stored. This +C structure can be set up by the DS2LT routine. See "LONG +C DESCRIPTION", below for more details about the SLAP Row +C format. +C +C *Description: +C This routine is supplied with the SLAP package as a routine +C to perform the MSOLVE operation in the SIR for the driver +C routine DSGS. It must be called via the SLAP MSOLVE calling +C sequence convention interface routine DSLI. +C **** THIS ROUTINE ITSELF DOES NOT CONFORM TO THE **** +C **** SLAP MSOLVE CALLING CONVENTION **** +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP Row format the "inner loop" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *See Also: +C DSLI +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSLI2 + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NEL, IEL(NEL), JEL(NEL) + DOUBLE PRECISION B(N), X(N), EL(NEL) +C +C Initialize the solution by copying the right hands side +C into it. +C***FIRST EXECUTABLE STATEMENT DSLI2 + DO 10 I=1,N + X(I) = B(I) + 10 CONTINUE +C +CVD$ NOCONCUR + DO 30 ICOL = 1, N + X(ICOL) = X(ICOL)/EL(JEL(ICOL)) + JBGN = JEL(ICOL) + 1 + JEND = JEL(ICOL+1) - 1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NOCONCUR +CVD$ NODEPCHK + DO 20 J = JBGN, JEND + X(IEL(J)) = X(IEL(J)) - EL(J)*X(ICOL) + 20 CONTINUE + ENDIF + 30 CONTINUE +C + RETURN +C------------- LAST LINE OF DSLI2 FOLLOWS ---------------------------- + END +*DECK DSLLTI + SUBROUTINE DSLLTI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C***BEGIN PROLOGUE DSLLTI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLLTI-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP MSOLVE for LDL' (IC) Factorization. +C This routine acts as an interface between the SLAP generic +C MSOLVE calling convention and the routine that actually +C -1 +C computes (LDL') B = X. +C***DESCRIPTION +C See the DESCRIPTION of SLLTI2 for the gory details. +C***ROUTINES CALLED SLLTI2 +C +C***END PROLOGUE DSLLTI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) +CWJS (1-3-13): Changing IWORK from size 1 to size 10, +CWJS in agreement with what was done in the CESM repository. +CWJS This is needed to avoid warnings when array bounds checking is on. + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(10) + DOUBLE PRECISION B(1), X(1), A(NELT), RWORK(1) +C +C***FIRST EXECUTABLE STATEMENT DSLLTI + NEL = IWORK(1) + LOCIEL = IWORK(3) + LOCJEL = IWORK(2) + LOCEL = IWORK(4) + LOCDIN = IWORK(5) + CALL SLLTI2(N, B, X, NEL, IWORK(LOCIEL), IWORK(LOCJEL), + $ RWORK(LOCEL), RWORK(LOCDIN)) +C + RETURN +C------------- LAST LINE OF DSLLTI FOLLOWS ---------------------------- + END +*DECK SLLTI2 + SUBROUTINE SLLTI2(N, B, X, NEL, IEL, JEL, EL, DINV) +C***BEGIN PROLOGUE SLLTI2 +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SLLTI2-S), +C Symmetric Linear system solve, Sparse, +C Iterative Precondition, Incomplete Factorization +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP back solve routine for LDL' Factorization. +C Routine to solve a system of the form L*D*L' X = B, +C where L is a unit lower triangular matrix and D is a +C diagonal matrix and ' means transpose. +C***DESCRIPTION +C *Usage: +C INTEGER N, NEL, IEL(N+1), JEL(NEL) +C DOUBLE PRECISION B(N), X(N), EL(NEL), DINV(N) +C +C CALL SLLTI2( N, B, X, NEL, IEL, JEL, EL, DINV ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right hand side vector. +C X :OUT Double Precision X(N). +C Solution to L*D*L' x = b. +C NEL :IN Integer. +C Number of non-zeros in the EL array. +C IEL :IN Integer IEL(N+1). +C JEL :IN Integer JEL(NEL). +C EL :IN Double Precision EL(NEL). +C IEL, JEL, EL contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in +C SLAP Row format. The diagonal of ones *IS* stored. This +C structure can be set up by the DS2LT routine. See +C "Description", below for more details about the SLAP Row +C format. +C DINV :IN Double Precision DINV(N). +C Inverse of the diagonal matrix D. +C +C *Description: +C This routine is supplied with the SLAP package as a routine +C to perform the MSOLVE operation in the SCG iteration routine +C for the driver routine DSICCG. It must be called via the +C SLAP MSOLVE calling sequence convention interface routine +C DSLLI. +C **** THIS ROUTINE ITSELF DOES NOT CONFORM TO THE **** +C **** SLAP MSOLVE CALLING CONVENTION **** +C +C IEL, JEL, EL should contain the unit lower triangular factor +C of the incomplete decomposition of the A matrix stored in +C SLAP Row format. This IC factorization can be computed by +C the DSICS routine. The diagonal (which is all one's) is +C stored. +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP Row format the "inner loop" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *See Also: +C DSICCG, DSICS +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE SLLTI2 + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NEL, IEL(NEL), JEL(1) + DOUBLE PRECISION B(N), X(N), EL(NEL), DINV(N) +C +C solve l*y = b, storing result in x. +C***FIRST EXECUTABLE STATEMENT SLLTI2 + DO 10 I=1,N + X(I) = B(I) + 10 CONTINUE + DO 30 IROW = 1, N + IBGN = IEL(IROW) + 1 + IEND = IEL(IROW+1) - 1 + IF( IBGN.LE.IEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NOCONCUR +CVD$ NODEPCHK + DO 20 I = IBGN, IEND + X(IROW) = X(IROW) - EL(I)*X(JEL(I)) + 20 CONTINUE + ENDIF + 30 CONTINUE +C +C Solve D*Z = Y, storing result in X. +C + DO 40 I=1,N + X(I) = X(I)*DINV(I) + 40 CONTINUE +C +C Solve L-trans*X = Z. +C + DO 60 IROW = N, 2, -1 + IBGN = IEL(IROW) + 1 + IEND = IEL(IROW+1) - 1 + IF( IBGN.LE.IEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NOCONCUR +CVD$ NODEPCHK + DO 50 I = IBGN, IEND + X(JEL(I)) = X(JEL(I)) - EL(I)*X(IROW) + 50 CONTINUE + ENDIF + 60 CONTINUE +C + RETURN +C------------- LAST LINE OF SLTI2 FOLLOWS ---------------------------- + END +*DECK DSLUI + SUBROUTINE DSLUI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C***BEGIN PROLOGUE DSLUI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLUI-S), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP MSOLVE for LDU Factorization. +C This routine acts as an interface between the SLAP +C generic MSLOVE calling convention and the routine that +C actually computes: -1 +C (LDU) B = X. +C***DESCRIPTION +C See the "DESCRIPTION" of DSLUI2 for the gory details. +C***ROUTINES CALLED DSLUI2 +C***END PROLOGUE DSLUI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) +CWJS (1-2-13): Changing IWORK and RWORK from size 10,1 (respectively) to size *, +CWJS in agreement with what was in the CESM repository. This is needed to avoid problems +CWJS when array bounds checking is on. + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), RWORK(*) +C +C Pull out the locations of the arrays holding the ILU +C factorization. +C***FIRST EXECUTABLE STATEMENT DSLUI + LOCIL = IWORK(1) + LOCJL = IWORK(2) + LOCIU = IWORK(3) + LOCJU = IWORK(4) + LOCL = IWORK(5) + LOCDIN = IWORK(6) + LOCU = IWORK(7) +C +C Solve the system LUx = b + CALL DSLUI2(N, B, X, IWORK(LOCIL), IWORK(LOCJL), RWORK(LOCL), + $ RWORK(LOCDIN), IWORK(LOCIU), IWORK(LOCJU), RWORK(LOCU) ) +C + RETURN +C------------- LAST LINE OF DSLUI FOLLOWS ---------------------------- + END +*DECK DSLUI2 + SUBROUTINE DSLUI2(N, B, X, IL, JL, L, DINV, IU, JU, U ) +C***BEGIN PROLOGUE DSLUI2 +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLUI2-S), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP Back solve for LDU Factorization. +C Routine to solve a system of the form L*D*U X = B, +C where L is a unit lower triangular matrix, D is a +C diagonal matrix, and U is a unit upper triangular matrix. +C***DESCRIPTION +C *Usage: +C INTEGER N, IL(N+1), JL(NL), IU(NU), JU(N+1) +C DOUBLE PRECISION B(N), X(N), L(NL), DINV(N), U(NU) +C +C CALL DSLUI2( N, B, X, IL, JL, L, DINV, IU, JU, U ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right hand side. +C X :OUT Double Precision X(N). +C Solution of L*D*U x = b. +C NEL :IN Integer. +C Number of non-zeros in the EL array. +C IL :IN Integer IL(N+1). +C JL :IN Integer JL(NL). +C L :IN Double Precision L(NL). +C IL, JL, L contain the unit lower triangular factor of the +C incomplete decomposition of some matrix stored in SLAP Row +C format. The diagonal of ones *IS* stored. This structure +C can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C DINV :IN Double Precision DINV(N). +C Inverse of the diagonal matrix D. +C NU :IN Integer. +C Number of non-zeros in the U array. +C IU :IN Integer IU(N+1). +C JU :IN Integer JU(NU). +C U :IN Double Precision U(NU). +C IU, JU, U contain the unit upper triangular factor of the +C incomplete decomposition of some matrix stored in SLAP +C Column format. The diagonal of ones *IS* stored. This +C structure can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C +C *Description: +C This routine is supplied with the SLAP package as a routine +C to perform the MSOLVE operation in the SIR and SBCG +C iteration routines for the drivers DSILUR and DSLUBC. It +C must be called via the SLAP MSOLVE calling sequence +C convention interface routine DSLUI. +C **** THIS ROUTINE ITSELF DOES NOT CONFORM TO THE **** +C **** SLAP MSOLVE CALLING CONVENTION **** +C +C IL, JL, L should contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in SLAP +C Row format. IU, JU, U should contain the unit upper factor +C of the incomplete decomposition of the A matrix stored in +C SLAP Column format This ILU factorization can be computed by +C the DSILUS routine. The diagonals (which is all one's) are +C stored. +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format the "inner loops" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *See Also: +C DSILUS +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSLUI2 + IMPLICIT DOUBLE PRECISION(A-H,O-Z) +CWJS (1-2-13): Reimplementing changes from Jon Wolfe to make code work with array bounds checking +CWJS INTEGER N, IL(1), JL(1), IU(1), JU(1) +CWJS DOUBLE PRECISION B(N), X(N), L(1), DINV(N), U(1) + INTEGER N, IL(N+1), JL(*), IU(*), JU(N+1) + DOUBLE PRECISION B(N), X(N), L(*), DINV(N), U(*) +C +C Solve L*Y = B, storing result in X, L stored by rows. +C***FIRST EXECUTABLE STATEMENT DSLUI2 + DO 10 I = 1, N + X(I) = B(I) + 10 CONTINUE + DO 30 IROW = 2, N + JBGN = IL(IROW) + JEND = IL(IROW+1)-1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ ASSOC +CVD$ NODEPCHK + DO 20 J = JBGN, JEND + X(IROW) = X(IROW) - L(J)*X(JL(J)) + 20 CONTINUE + ENDIF + 30 CONTINUE +C +C Solve D*Z = Y, storing result in X. + DO 40 I=1,N + X(I) = X(I)*DINV(I) + 40 CONTINUE +C +C Solve U*X = Z, U stored by columns. + DO 60 ICOL = N, 2, -1 + JBGN = JU(ICOL) + JEND = JU(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 50 J = JBGN, JEND + X(IU(J)) = X(IU(J)) - U(J)*X(ICOL) + 50 CONTINUE + ENDIF + 60 CONTINUE +C + RETURN +C------------- LAST LINE OF DSLUI2 FOLLOWS ---------------------------- + END +*DECK DSLUTI + SUBROUTINE DSLUTI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C***BEGIN PROLOGUE DSLUTI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLUTI-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP MTSOLV for LDU Factorization. +C This routine acts as an interface between the SLAP +C generic MTSOLV calling convention and the routine that +C actually computes: -T +C (LDU) B = X. +C***DESCRIPTION +C See the "DESCRIPTION" of DSLUI4 for the gory details. +C***ROUTINES CALLED DSLUI4 +C***END PROLOGUE DSLUTI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(10) + DOUBLE PRECISION B(N), X(N), A(N), RWORK(1) +C +C Pull out the pointers to the L, D and U matricies and call +C the workhorse routine. +C***FIRST EXECUTABLE STATEMENT DSLUTI + LOCIL = IWORK(1) + LOCJL = IWORK(2) + LOCIU = IWORK(3) + LOCJU = IWORK(4) + LOCL = IWORK(5) + LOCDIN = IWORK(6) + LOCU = IWORK(7) +C + CALL DSLUI4(N, B, X, IWORK(LOCIL), IWORK(LOCJL), RWORK(LOCL), + $ RWORK(LOCDIN), IWORK(LOCIU), IWORK(LOCJU), RWORK(LOCU)) +C + RETURN +C------------- LAST LINE OF DSLUTI FOLLOWS ---------------------------- + END +*DECK DSLUI4 + SUBROUTINE DSLUI4(N, B, X, IL, JL, L, DINV, IU, JU, U ) +C***BEGIN PROLOGUE DSLUI4 +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSLUI4-S), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP back solve for LDU Factorization. +C Routine to solve a system of the form (L*D*U)' X = B, +C where L is a unit lower triangular matrix, D is a +C diagonal matrix, and U is a unit upper triangular +C matrix and ' denotes transpose. +C***DESCRIPTION +C *Usage: +C INTEGER N, NL, IL(N+1), JL(NL), NU, IU(N+1), JU(NU) +C DOUBLE PRECISION B(N), X(N), L(NEL), DINV(N), U(NU) +C +C CALL DSLUI4( N, B, X, IL, JL, L, DINV, IU, JU, U ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right hand side. +C X :OUT Double Precision X(N). +C Solution of (L*D*U)trans x = b. +C IL :IN Integer IL(N+1). +C JL :IN Integer JL(NL). +C L :IN Double Precision L(NL). +C IL, JL, L contain the unit lower triangular factor of the +C incomplete decomposition of some matrix stored in SLAP Row +C format. The diagonal of ones *IS* stored. This structure +C can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C DINV :IN Double Precision DINV(N). +C Inverse of the diagonal matrix D. +C IU :IN Integer IU(N+1). +C JU :IN Integer JU(NU). +C U :IN Double Precision U(NU). +C IU, JU, U contain the unit upper triangular factor of the +C incomplete decomposition of some matrix stored in SLAP +C Column format. The diagonal of ones *IS* stored. This +C structure can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C +C *Description: +C This routine is supplied with the SLAP package as a routine +C to perform the MTSOLV operation in the SBCG iteration +C routine for the driver DSLUBC. It must be called via the +C SLAP MTSOLV calling sequence convention interface routine +C DSLUTI. +C **** THIS ROUTINE ITSELF DOES NOT CONFORM TO THE **** +C **** SLAP MSOLVE CALLING CONVENTION **** +C +C IL, JL, L should contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in SLAP +C Row format. IU, JU, U should contain the unit upper factor +C of the incomplete decomposition of the A matrix stored in +C SLAP Column format This ILU factorization can be computed by +C the DSILUS routine. The diagonals (which is all one's) are +C stored. +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting across rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format the "inner loops" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *See Also: +C DSILUS +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSLUI4 + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, IL(*), JL(*), IU(*), JU(*) + DOUBLE PRECISION B(N), X(N), L(*), DINV(N), U(*) +C +C***FIRST EXECUTABLE STATEMENT DSLUI4 + DO 10 I=1,N + X(I) = B(I) + 10 CONTINUE +C +C Solve U'*Y = X, storing result in X, U stored by columns. + DO 80 IROW = 2, N + JBGN = JU(IROW) + JEND = JU(IROW+1) - 1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ ASSOC +CVD$ NODEPCHK + DO 70 J = JBGN, JEND + X(IROW) = X(IROW) - U(J)*X(IU(J)) + 70 CONTINUE + ENDIF + 80 CONTINUE +C +C Solve D*Z = Y, storing result in X. + DO 90 I = 1, N + X(I) = X(I)*DINV(I) + 90 CONTINUE +C +C Solve L'*X = Z, L stored by rows. + DO 110 ICOL = N, 2, -1 + JBGN = IL(ICOL) + JEND = IL(ICOL+1) - 1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 100 J = JBGN, JEND + X(JL(J)) = X(JL(J)) - L(J)*X(ICOL) + 100 CONTINUE + ENDIF + 110 CONTINUE + RETURN +C------------- LAST LINE OF DSLUI4 FOLLOWS ---------------------------- + END +*DECK DSMMTI + SUBROUTINE DSMMTI(N, B, X, NELT, IA, JA, A, ISYM, RWORK, IWORK ) +C***BEGIN PROLOGUE DSMMTI +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSMMTI-S), +C Linear system solve, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP MSOLVE for LDU Factorization of Normal Equations. +C This routine acts as an interface between the SLAP +C generic MMTSLV calling convention and the routine that +C actually computes: -1 +C [(LDU)*(LDU)'] B = X. +C***DESCRIPTION +C See the "DESCRIPTION" of DSMMI2 for the gory details. +C***ROUTINES CALLED DSMMI2 +C***END PROLOGUE DSMMTI + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, IWORK(10) + DOUBLE PRECISION B(N), X(N), A(NELT), RWORK(1) +C +C Pull out the locations of the arrays holding the ILU +C factorization. +C***FIRST EXECUTABLE STATEMENT DSMMTI + LOCIL = IWORK(1) + LOCJL = IWORK(2) + LOCIU = IWORK(3) + LOCJU = IWORK(4) + LOCL = IWORK(5) + LOCDIN = IWORK(6) + LOCU = IWORK(7) +C + CALL DSMMI2(N, B, X, IWORK(LOCIL), IWORK(LOCJL), + $ RWORK(LOCL), RWORK(LOCDIN), IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU)) +C + RETURN +C------------- LAST LINE OF DSMMTI FOLLOWS ---------------------------- + END +*DECK DSMMI2 + SUBROUTINE DSMMI2( N, B, X, IL, JL, L, DINV, IU, JU, U ) +C***BEGIN PROLOGUE DSMMI2 +C***DATE WRITTEN 871119 (YYMMDD) +C***REVISION DATE 881213 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DSMMI2-S), +C Linear system, Sparse, Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE SLAP Back solve for LDU Factorization of Normal Equations. +C To solve a system of the form (L*D*U)*(L*D*U)' X = B, +C where L is a unit lower triangular matrix, D is a +C diagonal matrix, and U is a unit upper triangular +C matrix and ' denotes transpose. +C***DESCRIPTION +C *Usage: +C INTEGER N, IL(N+1), JL(NL), IU(N+1), JU(NU) +C DOUBLE PRECISION B(N), X(N), L(NL), DINV(N), U(NU) +C +C CALL DSMMI2( N, B, X, IL, JE, L, DINV, IU, JU, U ) +C +C *Arguments: +C N :IN Integer +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right hand side. +C X :OUT Double Precision X(N). +C Solution of (L*D*U)(L*D*U)trans x = b. +C IL :IN Integer IL(N+1). +C JL :IN Integer JL(NL). +C L :IN Double Precision L(NL). +C IL, JL, L contain the unit lower triangular factor of the +C incomplete decomposition of some matrix stored in SLAP Row +C format. The diagonal of ones *IS* stored. This structure +C can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C DINV :IN Double Precision DINV(N). +C Inverse of the diagonal matrix D. +C IU :IN Integer IU(N+1). +C JU :IN Integer JU(NU). +C U :IN Double Precision U(NU). +C IU, JU, U contain the unit upper triangular factor of the +C incomplete decomposition of some matrix stored in SLAP +C Column format. The diagonal of ones *IS* stored. This +C structure can be set up by the DSILUS routine. See +C "DESCRIPTION", below for more details about the SLAP +C format. +C +C *Description: +C This routine is supplied with the SLAP package as a routine +C to perform the MSOLVE operation in the SBCGN iteration +C routine for the driver DSLUCN. It must be called via the +C SLAP MSOLVE calling sequence convention interface routine +C DSMMTI. +C **** THIS ROUTINE ITSELF DOES NOT CONFORM TO THE **** +C **** SLAP MSOLVE CALLING CONVENTION **** +C +C IL, JL, L should contain the unit lower triangular factor of +C the incomplete decomposition of the A matrix stored in SLAP +C Row format. IU, JU, U should contain the unit upper factor +C of the incomplete decomposition of the A matrix stored in +C SLAP Column format This ILU factorization can be computed by +C the DSILUS routine. The diagonals (which is all one's) are +C stored. +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C ==================== S L A P Row format ==================== +C This routine requires that the matrix A be stored in the +C SLAP Row format. In this format the non-zeros are stored +C counting acrods rows (except for the diagonal entry, which +C must appear first in each "row") and are stored in the +C double precision +C array A. In other words, for each row in the matrix put the +C diagonal entry in A. Then put in the other non-zero +C elements going across the row (except the diagonal) in +C order. The JA array holds the column index for each +C non-zero. The IA array holds the offsets into the JA, A +C arrays for the beginning of each row. That is, +C JA(IA(IROW)), A(IA(IROW)) points to the beginning of the +C IROW-th row in JA and A. JA(IA(IROW+1)-1), A(IA(IROW+1)-1) +C points to the end of the IROW-th row. Note that we always +C have IA(N+1) = NELT+1, where N is the number of rows in +C the matrix and NELT is the number of non-zeros in the +C matrix. +C +C Here is an example of the SLAP Row storage format for a 5x5 +C Matrix (in the A and JA arrays '|' denotes the end of a row): +C +C 5x5 Matrix SLAP Row format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 12 15 | 22 21 | 33 35 | 44 | 55 51 53 +C |21 22 0 0 0| JA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| IA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C With the SLAP format the "inner loops" of this routine +C should vectorize on machines with hardware support for +C vector gather/scatter operations. Your compiler may require +C a compiler directive to convince it that there are no +C implicit vector dependencies. Compiler directives for the +C Alliant FX/Fortran and CRI CFT/CFT77 compilers are supplied +C with the standard SLAP distribution. +C +C *Precision: Double Precision +C *See Also: +C DSILUS +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE DSMMI2 + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, IL(1), JL(1), IU(1), JU(1) + DOUBLE PRECISION B(N), X(N), L(1), DINV(N), U(N) +C +C Solve L*Y = B, storing result in X, L stored by rows. +C***FIRST EXECUTABLE STATEMENT DSMMI2 + DO 10 I = 1, N + X(I) = B(I) + 10 CONTINUE + DO 30 IROW = 2, N + JBGN = IL(IROW) + JEND = IL(IROW+1)-1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ ASSOC +CVD$ NODEPCHK + DO 20 J = JBGN, JEND + X(IROW) = X(IROW) - L(J)*X(JL(J)) + 20 CONTINUE + ENDIF + 30 CONTINUE +C +C Solve D*Z = Y, storing result in X. + DO 40 I=1,N + X(I) = X(I)*DINV(I) + 40 CONTINUE +C +C Solve U*X = Z, U stored by columns. + DO 60 ICOL = N, 2, -1 + JBGN = JU(ICOL) + JEND = JU(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 50 J = JBGN, JEND + X(IU(J)) = X(IU(J)) - U(J)*X(ICOL) + 50 CONTINUE + ENDIF + 60 CONTINUE +C +C Solve U'*Y = X, storing result in X, U stored by columns. + DO 80 IROW = 2, N + JBGN = JU(IROW) + JEND = JU(IROW+1) - 1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ ASSOC +CVD$ NODEPCHK + DO 70 J = JBGN, JEND + X(IROW) = X(IROW) - U(J)*X(IU(J)) + 70 CONTINUE + ENDIF + 80 CONTINUE +C +C Solve D*Z = Y, storing result in X. + DO 90 I = 1, N + X(I) = X(I)*DINV(I) + 90 CONTINUE +C +C Solve L'*X = Z, L stored by rows. + DO 110 ICOL = N, 2, -1 + JBGN = IL(ICOL) + JEND = IL(ICOL+1) - 1 + IF( JBGN.LE.JEND ) THEN +CLLL. OPTION ASSERT (NOHAZARD) +CDIR$ IVDEP +CVD$ NODEPCHK + DO 100 J = JBGN, JEND + X(JL(J)) = X(JL(J)) - L(J)*X(ICOL) + 100 CONTINUE + ENDIF + 110 CONTINUE +C + RETURN +C------------- LAST LINE OF DSMMI2 FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/domn.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/domn.f new file mode 100644 index 0000000000..22b4aa2d7a --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/domn.f @@ -0,0 +1,1084 @@ +*DECK DOMN + SUBROUTINE DOMN( N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, + $ NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, + $ AP, EMAP, DZ, CSAV, RWORK, IWORK ) +C***BEGIN PROLOGUE DOMN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(DOMN-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Orthomin +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Orthomin Sparse Iterative Ax=b Solver. +C Routine to solve a general linear system Ax = b using +C the Preconditioned Orthomin method. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) +C DOUBLE PRECISION P(N,0:NSAVE), AP(N,0:NSAVE), EMAP(N,0:NSAVE) +C DOUBLE PRECISION DZ(N), CSAV(NSAVE), RWORK(USER DEFIED) +C EXTERNAL MATVEC, MSOLVE +C +C CALL DOMN(N, B, X, NELT, IA, JA, A, ISYM, MATVEC, MSOLVE, +C $ NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, +C $ Z, P, AP, EMAP, DZ, PSAV, APSV, QSAV, CSAV, RWORK, IWORK) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays contain the matrix data structure for A. +C It could take any form. See "LONG DESCRIPTION", below +C for more late breaking details... +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MATVEC :EXT External. +C Name of a routine which performs the matrix vector multiply +C Y = A*X given A and X. The name of the MATVEC routine must +C be declared external in the calling program. The calling +C sequence to MATVEC is: +C CALL MATVEC( N, X, Y, NELT, IA, JA, A, ISYM ) +C Where N is the number of unknowns, Y is the product A*X +C upon return X is an input vector, NELT is the number of +C non-zeros in the SLAP IA, JA, A storage for the matrix A. +C ISYM is a flag which, if non-zero, denotest that A is +C symmetric and only the lower or upper triangle is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize +C against. NSAVE >= 0. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Breakdown of method detected. +C $(p,Ap) < epsilon**2$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :WORK Double Precision R(N). +C Z :WORK Double Precision Z(N). +C P :WORK Double Precision P(N,0:NSAVE). +C AP :WORK Double Precision AP(N,0:NSAVE). +C EMAP :WORK Double Precision EMAP(N,0:NSAVE). +C DZ :WORK Double Precision DZ(N). +C CSAV :WORK Double Precision CSAV(NSAVE) +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE. +C +C *Precision: Double Precision +C *See Also: +C DSDOMN, DSLUOM, ISDOMN +C +C *Description +C This routine does not care what matrix data structure is +C used for A and M. It simply calls the MATVEC and MSOLVE +C routines, with the arguments as described above. The user +C could write any type of structure and the appropriate MATVEC +C and MSOLVE routines. It is assumed that A is stored in the +C IA, JA, A arrays in some fashion and that M (or INV(M)) is +C stored in IWORK and RWORK) in some fashion. The SLAP +C routines DSDOMN and DSLUOM are examples of this procedure. +C +C Two examples of matrix data structures are the: 1) SLAP +C Triad format and 2) SLAP Column format. +C +C =================== S L A P Triad format =================== +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C***REFERENCES (NONE) +C***ROUTINES CALLED MATVEC, MSOLVE, ISDOMN, +C DCOPY, DDOT, DAXPY, D1MACH +C***END PROLOGUE DOMN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) + DOUBLE PRECISION P(N,0:NSAVE), AP(N,0:NSAVE), EMAP(N,0:NSAVE) + DOUBLE PRECISION DZ(N), CSAV(NSAVE), RWORK(*) + EXTERNAL MATVEC, MSOLVE +C +C Check some of the input data. +C***FIRST EXECUTABLE STATEMENT DOMN + ITER = 0 + IERR = 0 + IF( N.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + EPS = D1MACH(3) + IF( TOL.LT.500.0*EPS ) THEN + TOL = 500.0*EPS + IERR = 4 + ENDIF + FUZZ = EPS*EPS +C +C Calculate initial residual and pseudo-residual, and check +C stopping criterion. + CALL MATVEC(N, X, R, NELT, IA, JA, A, ISYM) + DO 10 I = 1, N + R(I) = B(I) - R(I) + 10 CONTINUE + CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C + IF( ISDOMN(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ R, Z, P, AP, EMAP, DZ, CSAV, + $ RWORK, IWORK, AK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 + IF( IERR.NE.0 ) RETURN +C +C +C ***** iteration loop ***** +C +CVD$R NOVECTOR +CVD$R NOCONCUR + DO 100 K = 1, ITMAX + ITER = K + IP = MOD( ITER-1, NSAVE+1 ) +C +C calculate direction vector p, a*p, and (m-inv)*a*p, +C and save if desired. + CALL DCOPY(N, Z, 1, P(1,IP), 1) + CALL MATVEC(N, P(1,IP), AP(1,IP), NELT, IA, JA, A, ISYM) + CALL MSOLVE(N, AP(1,IP), EMAP(1,IP), NELT, IA, JA, A, ISYM, + $ RWORK, IWORK) + IF( NSAVE.EQ.0 ) THEN + AKDEN = DDOT(N, EMAP, 1, EMAP, 1) + ELSE + IF( ITER.GT.1 ) THEN + LMAX = MIN( NSAVE, ITER-1 ) + DO 20 L = 1, LMAX + IPO = MOD(IP+(NSAVE+1-L),NSAVE+1) + BKL = DDOT(N, EMAP(1,IP), 1, EMAP(1,IPO), 1) + BKL = BKL*CSAV(L) + CALL DAXPY(N, -BKL, P(1,IPO), 1, P(1,IP), 1) + CALL DAXPY(N, -BKL, AP(1,IPO), 1, AP(1,IP), 1) + CALL DAXPY(N, -BKL, EMAP(1,IPO), 1, EMAP(1,IP), 1) + 20 CONTINUE + IF( NSAVE.GT.1 ) THEN + DO 30 L = NSAVE-1, 1, -1 + CSAV(L+1) = CSAV(L) + 30 CONTINUE + ENDIF + ENDIF + AKDEN = DDOT(N, EMAP(1,IP), 1, EMAP(1,IP), 1) + IF( ABS(AKDEN).LT.EPS*EPS ) THEN + IERR = 6 + RETURN + ENDIF + CSAV(1) = 1./AKDEN +C +C calculate coefficient ak, new iterate x, new residual r, and +C new pseudo-residual z. + ENDIF + AKNUM = DDOT(N, Z, 1, EMAP(1,IP), 1) + AK = AKNUM/AKDEN + CALL DAXPY(N, AK, P(1,IP), 1, X, 1) + CALL DAXPY(N, -AK, AP(1,IP), 1, R, 1) + CALL DAXPY(N, -AK, EMAP(1,IP), 1, Z, 1) +C +C check stopping criterion. + IF( ISDOMN(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ R, Z, P, AP, EMAP, DZ, CSAV, + $ RWORK, IWORK, AK, BNRM, SOLNRM) .NE. 0 ) GO TO 200 +C + 100 CONTINUE +C +C ***** end of loop ***** +C +C Stopping criterion not satisfied. + ITER = ITMAX + 1 + IERR = 2 +C + 200 RETURN +C------------- LAST LINE OF DOMN FOLLOWS ---------------------------- + END +*DECK DSDOMN + SUBROUTINE DSDOMN(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSDOMN +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSDOMN-D), +C Non-Symmetric Linear system solve, Sparse, +C Iterative Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Diagonally Scaled Orthomin Sparse Iterative Ax=b Solver. +C Routine to solve a general linear system Ax = b using +C the Orthomin method with diagonal scaling. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(10), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR +C DOUBLE PRECISION RWORK(7*N+3*N*NSAVE+NSAVE) +C +C CALL DSDOMN(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the Matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "LONG +C DESCRIPTION", below. If the SLAP Triad format is chosen +C it is changed internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize against. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN( ) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Breakdown of method detected. +C $(p,Ap) < epsilon**2$. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= 7*N+NSAVE*(3*N+1). +C IWORK :WORK Integer IWORK(LENIW). +C Used to hold pointers into the RWORK array. +C LENIW :IN Integer. +C Length of the double precision workspace, RWORK. LENW >= 10. +C +C *Description: +C This routine is simply a driver for the DOMN routine. It +C calls the DSDS routine to set up the preconditioning and +C then calls DOMN with the appropriate MATVEC and MSOLVE +C routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C In this format only the non-zeros are stored. They may +C appear in *ANY* order. The user supplies three arrays of +C length NELT, where NELT is the number of non-zeros in the +C matrix: (IA(NELT), JA(NELT), A(NELT)). For each non-zero +C the user puts the row and column index of that matrix +C element in the IA and JA arrays. The value of the non-zero +C matrix element is placed in the corresponding location of +C the A array. This is an extremely easy data structure to +C generate. On the other hand it is not too efficient on +C vector computers for the iterative solution of linear +C systems. Hence, SLAP changes this input data structure to +C the SLAP Column format for the iteration (but does not +C change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See the "LONG DESCRIPTION", +C below. +C +C *See Also: +C DOMN, DSLUOM +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSDS, DOMN, DSMV, DSDI +C***END PROLOGUE DSDOMN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(N), TOL, ERR, RWORK(LENW) + EXTERNAL DSMV, DSDI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSDOMN + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Set up the workspace. Compute the inverse of the +C diagonal of the matrix. + LOCIW = LOCIB +C + LOCDIN = LOCRB + LOCR = LOCDIN + N + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCAP = LOCP + N*(NSAVE+1) + LOCEMA = LOCAP + N*(NSAVE+1) + LOCDZ = LOCEMA + N*(NSAVE+1) + LOCCSA = LOCDZ + N + LOCW = LOCCSA + NSAVE +C +C Check the workspace allocations. + CALL DCHKW( 'DSDOMN', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(4) = LOCDIN + IWORK(9) = LOCIW + IWORK(10) = LOCW +C + CALL DSDS(N, NELT, IA, JA, A, ISYM, RWORK(LOCDIN)) +C +C Perform the Diagonally Scaled Orthomin iteration algorithm. + CALL DOMN(N, B, X, NELT, IA, JA, A, ISYM, DSMV, + $ DSDI, NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCZ), RWORK(LOCP), RWORK(LOCAP), + $ RWORK(LOCEMA), RWORK(LOCDZ), RWORK(LOCCSA), + $ RWORK, IWORK ) + RETURN +C------------- LAST LINE OF DSDOMN FOLLOWS ---------------------------- + END +*DECK DSLUOM + SUBROUTINE DSLUOM(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK, LENW, IWORK, LENIW ) +C***BEGIN PROLOGUE DSLUOM +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(SSLUOM-D), +C Non-Symmetric Linear system, Sparse, +C Iterative incomplete LU Precondition +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Incomplete LU Orthomin Sparse Iterative Ax=b Solver. +C Routine to solve a general linear system Ax = b using +C the Orthomin method with Incomplete LU decomposition. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, LENW, IWORK(NEL+NU+4*N+2), LENIW +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR +C DOUBLE PRECISION RWORK(NEL+NU+7*N+3*N*NSAVE+NSAVE) +C +C CALL DSLUOM(N, B, X, NELT, IA, JA, A, ISYM, NSAVE, ITOL, TOL, +C $ ITMAX, ITER, ERR, IERR, IUNIT, RWORK, LENW, IWORK, LENIW ) +C +C *Arguments: +C N :IN Integer. +C Order of the matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :INOUT Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :INOUT Integer IA(NELT). +C JA :INOUT Integer JA(NELT). +C A :INOUT Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "LONG +C DESCRIPTION", below. If the SLAP Triad format is chosen +C it is changed internally to the SLAP Column format. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize against. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :OUT Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Return error flag. +C IERR = 0 => All went well. +C IERR = 1 => Insufficient storage allocated +C for WORK or IWORK. +C IERR = 2 => Method failed to converge in +C ITMAX steps. +C IERR = 3 => Error in user input. Check input +C value of N, ITOL. +C IERR = 4 => User error tolerance set too tight. +C Reset to 500.0*D1MACH(3). Iteration proceeded. +C IERR = 5 => Preconditioning matrix, M, is not +C Positive Definite. $(r,z) < 0.0$. +C IERR = 6 => Breakdown of the method detected. +C $(p,Ap) < epsilon**2$. +C IERR = 7 => Incomplete factorization broke down +C and was fudged. Resulting preconditioning may +C be less than the best. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C RWORK :WORK Double Precision RWORK(LENW). +C Double Precision array used for workspace. NL is the +C number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C LENW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW >= NL+NU+4*N+NSAVE*(3*N+1) +C IWORK :WORK Integer IWORK(LENIW) +C Integer array used for workspace. NL is the number of non- +C zeros in the lower triangle of the matrix (including the +C diagonal). NU is the number of nonzeros in the upper +C triangle of the matrix (including the diagonal). +C Upon return the following locations of IWORK hold information +C which may be of use to the user: +C IWORK(9) Amount of Integer workspace actually used. +C IWORK(10) Amount of Double Precision workspace actually used. +C LENIW :IN Integer. +C Length of the double precision workspace, RWORK. +C LENW > NL+NU+4*N+12. +C +C *Description: +C This routine is simply a driver for the DOMN routine. It +C calls the DSILUS routine to set up the preconditioning and +C then calls DOMN with the appropriate MATVEC and MSOLVE +C routines. +C +C The Sparse Linear Algebra Package (SLAP) utilizes two matrix +C data structures: 1) the SLAP Triad format or 2) the SLAP +C Column format. The user can hand this routine either of the +C of these data structures and SLAP will figure out which on +C is being used and act accordingly. +C +C =================== S L A P Triad format =================== +C +C This routine requires that the matrix A be stored in the +C SLAP Triad format. In this format only the non-zeros are +C stored. They may appear in *ANY* order. The user supplies +C three arrays of length NELT, where NELT is the number of +C non-zeros in the matrix: (IA(NELT), JA(NELT), A(NELT)). For +C each non-zero the user puts the row and column index of that +C matrix element in the IA and JA arrays. The value of the +C non-zero matrix element is placed in the corresponding +C location of the A array. This is an extremely easy data +C structure to generate. On the other hand it is not too +C efficient on vector computers for the iterative solution of +C linear systems. Hence, SLAP changes this input data +C structure to the SLAP Column format for the iteration (but +C does not change it back). +C +C Here is an example of the SLAP Triad storage format for a +C 5x5 Matrix. Recall that the entries may appear in any order. +C +C 5x5 Matrix SLAP Triad format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 51 12 11 33 15 53 55 22 35 44 21 +C |21 22 0 0 0| IA: 5 1 1 3 1 5 5 2 3 4 2 +C | 0 0 33 0 35| JA: 1 2 1 3 5 3 5 2 5 4 1 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C =================== S L A P Column format ================== +C This routine requires that the matrix A be stored in the +C SLAP Column format. In this format the non-zeros are stored +C counting down columns (except for the diagonal entry, which +C must appear first in each "column") and are stored in the +C double precision array A. In other words, for each column +C in the matrix put the diagonal entry in A. Then put in the +C other non-zero elements going down the column (except the +C diagonal) in order. The IA array holds the row index for +C each non-zero. The JA array holds the offsets into the IA, +C A arrays for the beginning of each column. That is, +C IA(JA(ICOL)), A(JA(ICOL)) points to the beginning of the +C ICOL-th column in IA and A. IA(JA(ICOL+1)-1), +C A(JA(ICOL+1)-1) points to the end of the ICOL-th column. +C Note that we always have JA(N+1) = NELT+1, where N is the +C number of columns in the matrix and NELT is the number of +C non-zeros in the matrix. +C +C Here is an example of the SLAP Column storage format for a +C 5x5 Matrix (in the A and IA arrays '|' denotes the end of a +C column): +C +C 5x5 Matrix SLAP Column format for 5x5 matrix on left. +C 1 2 3 4 5 6 7 8 9 10 11 +C |11 12 0 0 15| A: 11 21 51 | 22 12 | 33 53 | 44 | 55 15 35 +C |21 22 0 0 0| IA: 1 2 5 | 2 1 | 3 5 | 4 | 5 1 3 +C | 0 0 33 0 35| JA: 1 4 6 8 9 12 +C | 0 0 0 44 0| +C |51 0 53 0 55| +C +C *Precision: Double Precision +C *Side Effects: +C The SLAP Triad format (IA, JA, A) is modified internally to +C be the SLAP Column format. See the "LONG DESCRIPTION", +C below. +C +C *See Also: +C DOMN, DSDOMN +C***REFERENCES (NONE) +C***ROUTINES CALLED DS2Y, DCHKW, DSILUS, DOMN, DSMV, DSLUI +C***END PROLOGUE DSLUOM + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX + INTEGER ITER, IERR, IUNIT, LENW, IWORK(LENIW), LENIW + DOUBLE PRECISION B(N), X(N), A(N), RWORK(LENW) + EXTERNAL DSMV, DSLUI + PARAMETER (LOCRB=1, LOCIB=11) +C +C Change the SLAP input matrix IA, JA, A to SLAP-Column format. +C***FIRST EXECUTABLE STATEMENT DSLUOM + IERR = 0 + IF( N.LT.1 .OR. NELT.LT.1 ) THEN + IERR = 3 + RETURN + ENDIF + CALL DS2Y( N, NELT, IA, JA, A, ISYM ) +C +C Count number of Non-Zero elements preconditioner ILU matrix. +C Then set up the work arrays. + NL = 0 + NU = 0 + DO 20 ICOL = 1, N +C Don't count diagonal. + JBGN = JA(ICOL)+1 + JEND = JA(ICOL+1)-1 + IF( JBGN.LE.JEND ) THEN +CVD$ NOVECTOR + DO 10 J = JBGN, JEND + IF( IA(J).GT.ICOL ) THEN + NL = NL + 1 + IF( ISYM.NE.0 ) NU = NU + 1 + ELSE + NU = NU + 1 + ENDIF + 10 CONTINUE + ENDIF + 20 CONTINUE +C + LOCIL = LOCIB + LOCJL = LOCIL + N+1 + LOCIU = LOCJL + NL + LOCJU = LOCIU + NU + LOCNR = LOCJU + N+1 + LOCNC = LOCNR + N + LOCIW = LOCNC + N +C + LOCL = LOCRB + LOCDIN = LOCL + NL + LOCU = LOCDIN + N + LOCR = LOCU + NU + LOCZ = LOCR + N + LOCP = LOCZ + N + LOCAP = LOCP + N*(NSAVE+1) + LOCEMA = LOCAP + N*(NSAVE+1) + LOCDZ = LOCEMA + N*(NSAVE+1) + LOCCSA = LOCDZ + N + LOCW = LOCCSA + NSAVE +C +C Check the workspace allocations. + CALL DCHKW( 'DSLUOM', LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR ) + IF( IERR.NE.0 ) RETURN +C + IWORK(1) = LOCIL + IWORK(2) = LOCJL + IWORK(3) = LOCIU + IWORK(4) = LOCJU + IWORK(5) = LOCL + IWORK(6) = LOCDIN + IWORK(7) = LOCU + IWORK(9) = LOCIW + IWORK(10) = LOCW +C +C Compute the Incomplete LU decomposition. + CALL DSILUS( N, NELT, IA, JA, A, ISYM, NL, IWORK(LOCIL), + $ IWORK(LOCJL), RWORK(LOCL), RWORK(LOCDIN), NU, IWORK(LOCIU), + $ IWORK(LOCJU), RWORK(LOCU), IWORK(LOCNR), IWORK(LOCNC) ) +C +C Perform the incomplete LU preconditioned OrthoMin algorithm. + CALL DOMN(N, B, X, NELT, IA, JA, A, ISYM, DSMV, + $ DSLUI, NSAVE, ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ RWORK(LOCR), RWORK(LOCZ), RWORK(LOCP), RWORK(LOCAP), + $ RWORK(LOCEMA), RWORK(LOCDZ), RWORK(LOCCSA), + $ RWORK, IWORK ) + RETURN + END +*DECK ISDOMN + FUNCTION ISDOMN(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, NSAVE, + $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, + $ R, Z, P, AP, EMAP, DZ, CSAV, + $ RWORK, IWORK, AK, BNRM, SOLNRM) +C***BEGIN PROLOGUE ISDOMN +C***REFER TO DOMN, DSDOMN, DSLUOM +C***DATE WRITTEN 890404 (YYMMDD) +C***REVISION DATE 890404 (YYMMDD) +C***CATEGORY NO. D2A4 +C***KEYWORDS LIBRARY=SLATEC(SLAP), +C TYPE=DOUBLE PRECISION(ISDOMN-D), +C Non-Symmetric Linear system, Sparse, +C Iterative Precondition, Stop Test, Orthomin +C***AUTHOR Greenbaum, Anne, Courant Institute +C Seager, Mark K., (LLNL) +C Lawrence Livermore National Laboratory +C PO BOX 808, L-300 +C Livermore, CA 94550 (415) 423-3141 +C seager@lll-crg.llnl.gov +C***PURPOSE Preconditioned Orthomin Sparse Stop Test. +C This routine calculates the stop test for the Orthomin +C iteration scheme. It returns a nonzero if the error +C estimate (the type of which is determined by ITOL) is +C less than the user specified tolerance TOL. +C***DESCRIPTION +C *Usage: +C INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX +C INTEGER ITER, IERR, IUNIT, IWORK(USER DEFINED) +C DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) +C DOUBLE PRECISION P(N,0:NSAVE), AP(N,0:NSAVE), EMAP(N,0:NSAVE) +C DOUBLE PRECISION DZ(N), CSAV(NSAVE), RWORK(USER DEFINED), AK +C DOUBLE PRECISION BNRM, SOLNRM +C EXTERNAL MSOLVE +C +C IF( ISDOMN(N, B, X, NELT, IA, JA, A, ISYM, MSOLVE, NSAVE, +C $ ITOL, TOL, ITMAX, ITER, ERR, IERR, IUNIT, R, Z, P, AP, +C $ EMAP, DZ, CSAV, RWORK, IWORK, AK, BNRM, SOLNRM) +C $ .NE.0 ) THEN ITERATION CONVERGED +C +C *Arguments: +C N :IN Integer. +C Order of the matrix. +C B :IN Double Precision B(N). +C Right-hand side vector. +C X :IN Double Precision X(N). +C On input X is your initial guess for solution vector. +C On output X is the final approximate solution. +C NELT :IN Integer. +C Number of Non-Zeros stored in A. +C IA :IN Integer IA(NELT). +C JA :IN Integer JA(NELT). +C A :IN Double Precision A(NELT). +C These arrays should hold the matrix A in either the SLAP +C Triad format or the SLAP Column format. See "LONG +C DESCRIPTION" in the DSDOMN or DSLUOM. +C ISYM :IN Integer. +C Flag to indicate symmetric storage format. +C If ISYM=0, all nonzero entries of the matrix are stored. +C If ISYM=1, the matrix is symmetric, and only the upper +C or lower triangle of the matrix is stored. +C MSOLVE :EXT External. +C Name of a routine which solves a linear system MZ = R for +C Z given R with the preconditioning matrix M (M is supplied via +C RWORK and IWORK arrays). The name of the MSOLVE routine must +C be declared external in the calling program. The calling +C sequence to MSOLVE is: +C CALL MSOLVE(N, R, Z, NELT, IA, JA, A, ISYM, RWORK, IWORK) +C Where N is the number of unknowns, R is the right-hand side +C vector, and Z is the solution upon return. RWORK is a +C double precision +C array that can be used to pass necessary preconditioning +C information and/or workspace to MSOLVE. IWORK is an integer +C work array for the same purpose as RWORK. +C NSAVE :IN Integer. +C Number of direction vectors to save and orthogonalize against. +C ITOL :IN Integer. +C Flag to indicate type of convergence criterion. +C If ITOL=1, iteration stops when the 2-norm of the residual +C divided by the 2-norm of the right-hand side is less than TOL. +C If ITOL=2, iteration stops when the 2-norm of M-inv times the +C residual divided by the 2-norm of M-inv times the right hand +C side is less than TOL, where M-inv is the inverse of the +C diagonal of A. +C ITOL=11 is often useful for checking and comparing different +C routines. For this case, the user must supply the "exact" +C solution or a very accurate approximation (one with an error +C much less than TOL) through a common block, +C COMMON /SOLBLK/ SOLN(1) +C if ITOL=11, iteration stops when the 2-norm of the difference +C between the iterative approximation and the user-supplied +C solution divided by the 2-norm of the user-supplied solution +C is less than TOL. Note that this requires the user to set up +C the "COMMON /SOLBLK/ SOLN(LENGTH)" in the calling routine. +C The routine with this declaration should be loaded before the +C stop test so that the correct length is used by the loader. +C This procedure is not standard Fortran and may not work +C correctly on your system (although it has worked on every +C system the authors have tried). If ITOL is not 11 then this +C common block is indeed standard Fortran. +C TOL :IN Double Precision. +C Convergence criterion, as described above. +C ITMAX :IN Integer. +C Maximum number of iterations. +C ITER :IN Integer. +C Number of iterations required to reach convergence, or +C ITMAX+1 if convergence criterion could not be achieved in +C ITMAX iterations. +C ERR :OUT Double Precision. +C Error estimate of error in final approximate solution, as +C defined by ITOL. +C IERR :OUT Integer. +C Error flag. IERR is set to 3 if ITOL is not on of the +C acceptable values, see above. +C IUNIT :IN Integer. +C Unit number on which to write the error at each iteration, +C if this is desired for monitoring convergence. If unit +C number is 0, no writing will occur. +C R :IN Double Precision R(N). +C The residual R = B-AX. +C Z :WORK Double Precision Z(N). +C P :IN Double Precision P(N,0:NSAVE). +C Workspace used to hold the conjugate direction vector(s). +C AP :IN Double Precision AP(N,0:NSAVE). +C Workspace used to hold the matrix A times the P vector(s). +C EMAP :IN Double Precision EMAP(N,0:NSAVE). +C Workspace used to hold M-inv times the AP vector(s). +C DZ :WORK Double Precision DZ(N). +C Workspace. +C CSAV :DUMMY Double Precision CSAV(NSAVE) +C Reserved for future use. +C RWORK :WORK Double Precision RWORK(USER DEFINED). +C Double Precision array that can be used for workspace in +C MSOLVE. +C IWORK :WORK Integer IWORK(USER DEFINED). +C Integer array that can be used for workspace in MSOLVE. +C AK :IN Double Precision. +C Current iterate BiConjugate Gradient iteration parameter. +C +C *Function Return Values: +C 0 : Error estimate (determined by ITOL) is *NOT* less than the +C specified tolerance, TOL. The iteration must continue. +C 1 : Error estimate (determined by ITOL) is less than the +C specified tolerance, TOL. The iteration can be considered +C complete. +C +C *Precision: Double Precision +C *See Also: +C DOMN, DSDOMN, DSLUOM +C +C *Cautions: +C This routine will attempt to write to the fortran logical output +C unit IUNIT, if IUNIT .ne. 0. Thus, the user must make sure that +C this logical unit must be attached to a file or terminal +C before calling this routine with a non-zero value for IUNIT. +C This routine does not check for the validity of a non-zero IUNIT +C unit number. +C***REFERENCES (NONE) +C***ROUTINES CALLED MSOLVE, DNRM2 +C***COMMON BLOCKS SOLBLK +C***END PROLOGUE ISDOMN + IMPLICIT DOUBLE PRECISION(A-H,O-Z) + INTEGER N, NELT, IA(NELT), JA(NELT), ISYM, NSAVE, ITOL, ITMAX + INTEGER ITER, IUNIT, IWORK(*) + DOUBLE PRECISION B(N), X(N), A(NELT), TOL, ERR, R(N), Z(N) + DOUBLE PRECISION P(N,0:NSAVE), AP(N,0:NSAVE), EMAP(N,0:NSAVE) + DOUBLE PRECISION DZ(N), CSAV(NSAVE), RWORK(*) + EXTERNAL MSOLVE + COMMON /SOLBLK/ SOLN(1) +C +C***FIRST EXECUTABLE STATEMENT ISDOMN + ISDOMN = 0 +C + IF( ITOL.EQ.1 ) THEN +C err = ||Residual||/||RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) BNRM = DNRM2(N, B, 1) + ERR = DNRM2(N, R, 1)/BNRM + ELSE IF( ITOL.EQ.2 ) THEN +C -1 -1 +C err = ||M Residual||/||M RightHandSide|| (2-Norms). + IF(ITER .EQ. 0) THEN + CALL MSOLVE(N, B, DZ, NELT, IA, JA, A, ISYM, RWORK, IWORK) + BNRM = DNRM2(N, DZ, 1) + ENDIF + ERR = DNRM2(N, Z, 1)/BNRM + ELSE IF( ITOL.EQ.11 ) THEN +C err = ||x-TrueSolution||/||TrueSolution|| (2-Norms). + IF(ITER .EQ. 0) SOLNRM = DNRM2(N, SOLN, 1) + DO 10 I = 1, N + DZ(I) = X(I) - SOLN(I) + 10 CONTINUE + ERR = DNRM2(N, DZ, 1)/SOLNRM + ELSE +C +C If we get here ITOL is not one of the acceptable values. + ERR = 1.0E10 + IERR = 3 + ENDIF +C + IF(IUNIT .NE. 0) THEN + IF( ITER.EQ.0 ) THEN + WRITE(IUNIT,1000) NSAVE, N, ITOL + ENDIF + WRITE(IUNIT,1010) ITER, ERR, AK + ENDIF + IF(ERR .LE. TOL) ISDOMN = 1 +C + RETURN + 1000 FORMAT(' Preconditioned Orthomin(',I3,') for ', + $ 'N, ITOL = ',I5, I5, + $ /' ITER',' Error Estimate',' Alpha') + 1010 FORMAT(1X,I4,1X,E16.7,1X,E16.7) +C------------- LAST LINE OF ISDOMN FOLLOWS ---------------------------- + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/mach.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/mach.f new file mode 100644 index 0000000000..089d496b6f --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/mach.f @@ -0,0 +1,1135 @@ + REAL FUNCTION R1MACH(I) +C +C SINGLE-PRECISION MACHINE CONSTANTS +C +C R1MACH(1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. +C +C R1MACH(2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. +C +C R1MACH(3) = B**(-T), THE SMALLEST RELATIVE SPACING. +C +C R1MACH(4) = B**(1-T), THE LARGEST RELATIVE SPACING. +C +C R1MACH(5) = LOG10(B) +C +C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, +C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY +C REMOVING THE C FROM COLUMN 1. +C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. +C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) +C +C WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED +C TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES +C REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. +C + INTEGER SMALL(2) + INTEGER LARGE(2) + INTEGER RIGHT(2) + INTEGER DIVER(2) + INTEGER LOG10(2) +C + REAL RMACH(5) +C + EQUIVALENCE (RMACH(1),SMALL(1)) + EQUIVALENCE (RMACH(2),LARGE(1)) + EQUIVALENCE (RMACH(3),RIGHT(1)) + EQUIVALENCE (RMACH(4),DIVER(1)) + EQUIVALENCE (RMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. +C +C DATA RMACH(1) / Z400800000 / +C DATA RMACH(2) / Z5FFFFFFFF / +C DATA RMACH(3) / Z4E9800000 / +C DATA RMACH(4) / Z4EA800000 / +C DATA RMACH(5) / Z500E730E8 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700/6700/7700 SYSTEMS. +C +C DATA RMACH(1) / O1771000000000000 / +C DATA RMACH(2) / O0777777777777777 / +C DATA RMACH(3) / O1311000000000000 / +C DATA RMACH(4) / O1301000000000000 / +C DATA RMACH(5) / O1157163034761675 / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. +C +C DATA RMACH(1) / 00014000000000000000B / +C DATA RMACH(2) / 37767777777777777777B / +C DATA RMACH(3) / 16404000000000000000B / +C DATA RMACH(4) / 16414000000000000000B / +C DATA RMACH(5) / 17164642023241175720B / +C +C MACHINE CONSTANTS FOR CONVEX C-1 +C +C DATA RMACH(1) / '00800000'X / +C DATA RMACH(2) / '7FFFFFFF'X / +C DATA RMACH(3) / '34800000'X / +C DATA RMACH(4) / '35000000'X / +C DATA RMACH(5) / '3F9A209B'X / +C +C MACHINE CONSTANTS FOR THE CRAY 1 +C +C DATA RMACH(1) / 200034000000000000000B / +C DATA RMACH(2) / 577767777777777777776B / +C DATA RMACH(3) / 377224000000000000000B / +C DATA RMACH(4) / 377234000000000000000B / +C DATA RMACH(5) / 377774642023241175720B / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - +C STATIC RMACH(5) +C +C DATA SMALL/20K,0/,LARGE/77777K,177777K/ +C DATA RIGHT/35420K,0/,DIVER/36020K,0/ +C DATA LOG10/40423K,42023K/ +C +C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 +C +C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1),LARGE(2) / '37777777, '00000177 / +C DATA RIGHT(1),RIGHT(2) / '20000000, '00000352 / +C DATA DIVER(1),DIVER(2) / '20000000, '00000353 / +C DATA LOG10(1),LOG10(2) / '23210115, '00000377 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. +C +C DATA RMACH(1) / O402400000000 / +C DATA RMACH(2) / O376777777777 / +C DATA RMACH(3) / O714400000000 / +C DATA RMACH(4) / O716400000000 / +C DATA RMACH(5) / O776464202324 / +C +C MACHINE CONSTANTS FOR AT&T 3B SERIES MACHINES. +C +C DATA SMALL(1) / 8388608 / +C DATA LARGE(1) / 2139095039 / +C DATA RIGHT(1) / 864026624 / +C DATA DIVER(1) / 872415232 / +C DATA LOG10(1) / 1050288283 / +C +C MACHINE CONSTANTS FOR THE IBM PC AND OTHER 8087-ARITHMETIC MICROS +C +C DATA SMALL(1) / 8388608 / +C DATA LARGE(1) / 2139095039 / +C DATA RIGHT(1) / 864026624 / +C DATA DIVER(1) / 872415232 / +C DATA LOG10(1) / 1050288283 / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. +C +C DATA RMACH(1) / Z00100000 / +C DATA RMACH(2) / Z7FFFFFFF / +C DATA RMACH(3) / Z3B100000 / +C DATA RMACH(4) / Z3C100000 / +C DATA RMACH(5) / Z41134413 / +C +C MACHINE CONSTANTS FOR THE INTERDATA 8/32 +C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. +C +C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE +C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. +C +C DATA RMACH(1) / Z'00100000' / +C DATA RMACH(2) / Z'7EFFFFFF' / +C DATA RMACH(3) / Z'3B100000' / +C DATA RMACH(4) / Z'3C100000' / +C DATA RMACH(5) / Z'41134413' / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA OR KI PROCESSOR). +C +C DATA RMACH(1) / "000400000000 / +C DATA RMACH(2) / "377777777777 / +C DATA RMACH(3) / "146400000000 / +C DATA RMACH(4) / "147400000000 / +C DATA RMACH(5) / "177464202324 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1) / 8388608 / +C DATA LARGE(1) / 2147483647 / +C DATA RIGHT(1) / 880803840 / +C DATA DIVER(1) / 889192448 / +C DATA LOG10(1) / 1067065499 / +C +C DATA RMACH(1) / O00040000000 / +C DATA RMACH(2) / O17777777777 / +C DATA RMACH(3) / O06440000000 / +C DATA RMACH(4) / O06500000000 / +C DATA RMACH(5) / O07746420233 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1),SMALL(2) / 128, 0 / +C DATA LARGE(1),LARGE(2) / 32767, -1 / +C DATA RIGHT(1),RIGHT(2) / 13440, 0 / +C DATA DIVER(1),DIVER(2) / 13568, 0 / +C DATA LOG10(1),LOG10(2) / 16282, 8347 / +C +C DATA SMALL(1),SMALL(2) / O000200, O000000 / +C DATA LARGE(1),LARGE(2) / O077777, O177777 / +C DATA RIGHT(1),RIGHT(2) / O032200, O000000 / +C DATA DIVER(1),DIVER(2) / O032400, O000000 / +C DATA LOG10(1),LOG10(2) / O037632, O020233 / +C +C MACHINE CONSTANTS FOR THE SUN MICROSYSTEMS UNIX F77 COMPILER. +C + DATA RMACH(1) / 1.17549435E-38 / + DATA RMACH(2) / 3.40282347E+38 / + DATA RMACH(3) / 5.96016605E-08 / + DATA RMACH(4) / 1.19203321E-07 / + DATA RMACH(5) / 3.01030010E-01 / +C +C MACHINE CONSTANTS FOR THE Alliant FX/8 UNIX Fortran COMPILER +C WITH THE -r8 COMMAND LINE OPTION. This option causes all variables +c declared with 'real' to be of type 'real*8' or double precision. +c This option does not override the 'real*4' declarations. These +c R1MACH numbers below and the coresponding I1MACH are simply the double +c precision or 'real*8' numbers. If you use the -r8 your whole code +c (and the user libraries you link with, the system libraries are taken +c care of automagicly) must be compiled with this option. +C +c$$$ DATA RMACH(1) / 2.22507385850721D-308 / +c$$$ DATA RMACH(2) / 1.79769313486231D+308 / +c$$$ DATA RMACH(3) / 1.1101827117665D-16 / +c$$$ DATA RMACH(4) / 2.2203654423533D-16 / +c$$$ DATA RMACH(5) / 3.01029995663981E-1 / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C +C DATA RMACH(1) / O000400000000 / +C DATA RMACH(2) / O377777777777 / +C DATA RMACH(3) / O146400000000 / +C DATA RMACH(4) / O147400000000 / +C DATA RMACH(5) / O177464202324 / +C +C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER +C +C DATA SMALL(1) / 128 / +C DATA LARGE(1) / -32769 / +C DATA RIGHT(1) / 13440 / +C DATA DIVER(1) / 13568 / +C DATA LOG10(1) / 547045274 / +C +C MACHINE CONSTANTS FOR THE VAX-11 WITH +C FORTRAN IV-PLUS COMPILER +C +C DATA RMACH(1) / Z00000080 / +C DATA RMACH(2) / ZFFFF7FFF / +C DATA RMACH(3) / Z00003480 / +C DATA RMACH(4) / Z00003500 / +C DATA RMACH(5) / Z209B3F9A / +C +C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 +C +C DATA RMACH(1) / '80'X / +C DATA RMACH(2) / 'FFFF7FFF'X / +C DATA RMACH(3) / '3480'X / +C DATA RMACH(4) / '3500'X / +C DATA RMACH(5) / '209B3F9A'X / +C +C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 AND SVS FORTRAN ON +C THE AT&T 7300 (UNIX PC) +C +C DATA SMALL(1) / $00800000 / +C DATA LARGE(1) / $7F7FFFFF / +C DATA RIGHT(1) / $33800000 / +C DATA DIVER(1) / $34000000 / +C DATA LOG10(1) / $3E9A209B / +C +C MACHINE CONSTANTS FOR RM FORTRAN (ON THE AT&T 7300) +C +C DATA RMACH(1) / Z'00800000' / +C DATA RMACH(2) / Z'7F7FFFFF' / +C DATA RMACH(3) / Z'33800000' / +C DATA RMACH(4) / Z'34000000' / +C DATA RMACH(5) / Z'3E9A209B' / +C +C + IF (I .LT. 1 .OR. I .GT. 5) GOTO 999 + R1MACH = RMACH(I) + RETURN + 999 WRITE(I1MACH(2),1999) I + 1999 FORMAT(' R1MACH - I OUT OF BOUNDS',I10) + STOP + END + DOUBLE PRECISION FUNCTION D1MACH(I) +C +C DOUBLE-PRECISION MACHINE CONSTANTS +C +C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. +C +C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. +C +C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. +C +C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. +C +C D1MACH( 5) = LOG10(B) +C +C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, +C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY +C REMOVING THE C FROM COLUMN 1. +C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. +C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) +C +C WHERE POSSIBLE, OCTAL OR HEXADECIMAL CONSTANTS HAVE BEEN USED +C TO SPECIFY THE CONSTANTS EXACTLY WHICH HAS IN SOME CASES +C REQUIRED THE USE OF EQUIVALENT INTEGER ARRAYS. +C +CWJS (1-2-13): Using machine-independent functions to set DMACH, rather than hard-coding it +CWJS (Note that this uses f90 features) +CWJS INTEGER SMALL(4) +CWJS INTEGER LARGE(4) +CWJS INTEGER RIGHT(4) +CWJS INTEGER DIVER(4) +CWJS INTEGER LOG10(4) +C +CWJS DOUBLE PRECISION DMACH(5) + DOUBLE PRECISION, PARAMETER :: DMACH(5) = + & (/ tiny(1.d0), + & huge(1.d0), + & epsilon(1.d0)/2.d0, + & epsilon(1.d0), + & log10(2.d0) /) +C +CWJS EQUIVALENCE (DMACH(1),SMALL(1)) +CWJS EQUIVALENCE (DMACH(2),LARGE(1)) +CWJS EQUIVALENCE (DMACH(3),RIGHT(1)) +CWJS EQUIVALENCE (DMACH(4),DIVER(1)) +CWJS EQUIVALENCE (DMACH(5),LOG10(1)) +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. +C +C DATA SMALL(1) / ZC00800000 / +C DATA SMALL(2) / Z000000000 / +C +C DATA LARGE(1) / ZDFFFFFFFF / +C DATA LARGE(2) / ZFFFFFFFFF / +C +C DATA RIGHT(1) / ZCC5800000 / +C DATA RIGHT(2) / Z000000000 / +C +C DATA DIVER(1) / ZCC6800000 / +C DATA DIVER(2) / Z000000000 / +C +C DATA LOG10(1) / ZD00E730E7 / +C DATA LOG10(2) / ZC77800DC0 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O0000000000000000 / +C +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O0007777777777777 / +C +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. +C +C DATA SMALL(1) / O1771000000000000 / +C DATA SMALL(2) / O7770000000000000 / +C +C DATA LARGE(1) / O0777777777777777 / +C DATA LARGE(2) / O7777777777777777 / +C +C DATA RIGHT(1) / O1461000000000000 / +C DATA RIGHT(2) / O0000000000000000 / +C +C DATA DIVER(1) / O1451000000000000 / +C DATA DIVER(2) / O0000000000000000 / +C +C DATA LOG10(1) / O1157163034761674 / +C DATA LOG10(2) / O0006677466732724 / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. +C +C DATA SMALL(1) / 00604000000000000000B / +C DATA SMALL(2) / 00000000000000000000B / +C +C DATA LARGE(1) / 37767777777777777777B / +C DATA LARGE(2) / 37167777777777777777B / +C +C DATA RIGHT(1) / 15604000000000000000B / +C DATA RIGHT(2) / 15000000000000000000B / +C +C DATA DIVER(1) / 15614000000000000000B / +C DATA DIVER(2) / 15010000000000000000B / +C +C DATA LOG10(1) / 17164642023241175717B / +C DATA LOG10(2) / 16367571421742254654B / +C +C MACHINE CONSTANTS FOR CONVEX C-1 +C +C DATA SMALL(1),SMALL(2) / '00100000'X, '00000000'X / +C DATA LARGE(1),LARGE(2) / '7FFFFFFF'X, 'FFFFFFFF'X / +C DATA RIGHT(1),RIGHT(2) / '3CC00000'X, '00000000'X / +C DATA DIVER(1),DIVER(2) / '3CD00000'X, '00000000'X / +C DATA LOG10(1),LOG10(2) / '3FF34413'X, '509F79FF'X / +C +C MACHINE CONSTANTS FOR THE CRAY 1 +C +C DATA SMALL(1) / 201354000000000000000B / +C DATA SMALL(2) / 000000000000000000000B / +C +C DATA LARGE(1) / 577767777777777777777B / +C DATA LARGE(2) / 000007777777777777776B / +C +C DATA RIGHT(1) / 376434000000000000000B / +C DATA RIGHT(2) / 000000000000000000000B / +C +C DATA DIVER(1) / 376444000000000000000B / +C DATA DIVER(2) / 000000000000000000000B / +C +C DATA LOG10(1) / 377774642023241175717B / +C DATA LOG10(2) / 000007571421742254654B / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD - +C STATIC DMACH(5) +C +C DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/ +C DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/ +C DATA LOG10/40423K,42023K,50237K,74776K/ +C +C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 +C +C DATA SMALL(1),SMALL(2) / '20000000, '00000201 / +C DATA LARGE(1),LARGE(2) / '37777777, '37777577 / +C DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 / +C DATA DIVER(1),DIVER(2) / '20000000, '00000334 / +C DATA LOG10(1),LOG10(2) / '23210115, '10237777 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. +C +C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 / +C +C MACHINE CONSTANTS FOR AT&T 3B SERIES MACHINES. +C +C DATA SMALL(1),SMALL(2) / 1048576, 0 / +C DATA LARGE(1),LARGE(2) / 2146435071, -1 / +C DATA RIGHT(1),RIGHT(2) / 1017118720, 0 / +C DATA DIVER(1),DIVER(2) / 1018167296, 0 / +C DATA LOG10(1),LOG10(2) / 1070810131, 1352628735 / +C +C MACHINE CONSTANTS FOR THE IBM PC AND OTHER 8087-ARITHMETIC MICROS +C +C DATA SMALL(1),SMALL(2) / 0, 1048576 / +C DATA LARGE(1),LARGE(2) / -1, 2146435071 / +C DATA RIGHT(1),RIGHT(2) / 0, 1017118720 / +C DATA DIVER(1),DIVER(2) / 0, 1018167296 / +C DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. +C +C DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 / +C DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF / +C DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 / +C DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 / +C DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF / +C +C MACHINE CONSTANTS FOR THE INTERDATA 8/32 +C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. +C +C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE +C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. +C +C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' / +C DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' / +C DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). +C +C DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 / +C DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 / +C DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 / +C DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 / +C DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). +C +C DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 / +C DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 / +C DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 / +C DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 / +C DATA LOG10(1),LOG10(2) / "177464202324, "047674776746 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1),SMALL(2) / 8388608, 0 / +C DATA LARGE(1),LARGE(2) / 2147483647, -1 / +C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / +C DATA DIVER(1),DIVER(2) / 620756992, 0 / +C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 / +C +C DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 / +C DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 / +C DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 / +C DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 / +C DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL). +C +C DATA SMALL(1),SMALL(2) / 128, 0 / +C DATA SMALL(3),SMALL(4) / 0, 0 / +C +C DATA LARGE(1),LARGE(2) / 32767, -1 / +C DATA LARGE(3),LARGE(4) / -1, -1 / +C +C DATA RIGHT(1),RIGHT(2) / 9344, 0 / +C DATA RIGHT(3),RIGHT(4) / 0, 0 / +C +C DATA DIVER(1),DIVER(2) / 9472, 0 / +C DATA DIVER(3),DIVER(4) / 0, 0 / +C +C DATA LOG10(1),LOG10(2) / 16282, 8346 / +C DATA LOG10(3),LOG10(4) / -31493, -12296 / +C +C DATA SMALL(1),SMALL(2) / O000200, O000000 / +C DATA SMALL(3),SMALL(4) / O000000, O000000 / +C +C DATA LARGE(1),LARGE(2) / O077777, O177777 / +C DATA LARGE(3),LARGE(4) / O177777, O177777 / +C +C DATA RIGHT(1),RIGHT(2) / O022200, O000000 / +C DATA RIGHT(3),RIGHT(4) / O000000, O000000 / +C +C DATA DIVER(1),DIVER(2) / O022400, O000000 / +C DATA DIVER(3),DIVER(4) / O000000, O000000 / +C +C DATA LOG10(1),LOG10(2) / O037632, O020232 / +C DATA LOG10(3),LOG10(4) / O102373, O147770 / +C +C MACHINE CONSTANTS FOR THE SUN MICROSYSTEMS UNIX F77 COMPILER. +C +CWJS DATA DMACH(1) / 2.22507385850720D-308 / +CWJS DATA DMACH(2) / 1.79769313486231D+308 / +CWJS DATA DMACH(3) / 1.1101827117665D-16 / +CWJS DATA DMACH(4) / 2.2203654423533D-16 / +CWJS DATA DMACH(5) / 3.01029995663981E-1 / +C +C MACHINE CONSTANTS FOR THE ALLIANT FX/8 UNIX FORTRAN COMPILER. +C +c$$$ DATA DMACH(1) / 2.22507385850721D-308 / +c$$$ DATA DMACH(2) / 1.79769313486231D+308 / +c$$$ DATA DMACH(3) / 1.1101827117665D-16 / +c$$$ DATA DMACH(4) / 2.2203654423533D-16 / +c$$$ DATA DMACH(5) / 3.01029995663981E-1 / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C +C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / +C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / +C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / +C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / +C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 / +C +C MACHINE CONSTANTS FOR THE VAX UNIX F77 COMPILER +C +C DATA SMALL(1),SMALL(2) / 128, 0 / +C DATA LARGE(1),LARGE(2) / -32769, -1 / +C DATA RIGHT(1),RIGHT(2) / 9344, 0 / +C DATA DIVER(1),DIVER(2) / 9472, 0 / +C DATA LOG10(1),LOG10(2) / 546979738, -805796613 / +C +C MACHINE CONSTANTS FOR THE VAX-11 WITH +C FORTRAN IV-PLUS COMPILER +C +C DATA SMALL(1),SMALL(2) / Z00000080, Z00000000 / +C DATA LARGE(1),LARGE(2) / ZFFFF7FFF, ZFFFFFFFF / +C DATA RIGHT(1),RIGHT(2) / Z00002480, Z00000000 / +C DATA DIVER(1),DIVER(2) / Z00002500, Z00000000 / +C DATA LOG10(1),LOG10(2) / Z209A3F9A, ZCFF884FB / +C +C MACHINE CONSTANTS FOR VAX/VMS VERSION 2.2 +C +C DATA SMALL(1),SMALL(2) / '80'X, '0'X / +C DATA LARGE(1),LARGE(2) / 'FFFF7FFF'X, 'FFFFFFFF'X / +C DATA RIGHT(1),RIGHT(2) / '2480'X, '0'X / +C DATA DIVER(1),DIVER(2) / '2500'X, '0'X / +C DATA LOG10(1),LOG10(2) / '209A3F9A'X, 'CFF884FB'X / +C +C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 +C +C DATA SMALL(1),SMALL(2) / $00000000, $00100000 / +C DATA LARGE(1),LARGE(2) / $FFFFFFFF, $7FEFFFFF / +C DATA RIGHT(1),RIGHT(2) / $00000000, $3CA00000 / +C DATA DIVER(1),DIVER(2) / $00000000, $3CB00000 / +C DATA LOG10(1),LOG10(2) / $509F79FF, $3FD34413 / +C +C MACHINE CONSTANTS FOR SVS FORTRAN ON THE AT&T 7300 (UNIX PC) +C +C DATA SMALL(1),SMALL(2) / $00100000, $00000000 / +C DATA LARGE(1),LARGE(2) / $7FEFFFFF, $FFFFFFFF / +C DATA RIGHT(1),RIGHT(2) / $3CA00000, $00000000 / +C DATA DIVER(1),DIVER(2) / $3CB00000, $00000000 / +C DATA LOG10(1),LOG10(2) / $3FD34413, $509F79FF / +C +C MACHINE CONSTANTS FOR THE RM FORTRAN ON THE AT&T 7300 (UNIX PC) +C +C DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' / +C DATA LARGE(1),LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' / +C DATA RIGHT(1),RIGHT(2) / Z'3CA00000', Z'00000000' / +C DATA DIVER(1),DIVER(2) / Z'3CB00000', Z'00000000' / +C DATA LOG10(1),LOG10(2) / Z'3FD34413', Z'509F79FF' / +C + IF (I .LT. 1 .OR. I .GT. 5) GOTO 999 + D1MACH = DMACH(I) + RETURN + 999 WRITE(I1MACH(2),1999) I + 1999 FORMAT(' D1MACH - I OUT OF BOUNDS',I10) + STOP + END + INTEGER FUNCTION I1MACH(I) +C +C I/O UNIT NUMBERS. +C +C I1MACH( 1) = THE STANDARD INPUT UNIT. +C +C I1MACH( 2) = THE STANDARD OUTPUT UNIT. +C +C I1MACH( 3) = THE STANDARD PUNCH UNIT. +C +C I1MACH( 4) = THE STANDARD ERROR MESSAGE UNIT. +C +C WORDS. +C +C I1MACH( 5) = THE NUMBER OF BITS PER INTEGER STORAGE UNIT. +C +C I1MACH( 6) = THE NUMBER OF CHARACTERS PER INTEGER STORAGE UNIT. +C +C INTEGERS. +C +C ASSUME INTEGERS ARE REPRESENTED IN THE S-DIGIT, BASE-A FORM +C +C SIGN ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) ) +C +C WHERE 0 .LE. X(I) .LT. A FOR I=0,...,S-1. +C +C I1MACH( 7) = A, THE BASE. +C +C I1MACH( 8) = S, THE NUMBER OF BASE-A DIGITS. +C +C I1MACH( 9) = A**S - 1, THE LARGEST MAGNITUDE. +C +C FLOATING-POINT NUMBERS. +C +C ASSUME FLOATING-POINT NUMBERS ARE REPRESENTED IN THE T-DIGIT, +C BASE-B FORM +C +C SIGN (B**E)*( (X(1)/B) + ... + (X(T)/B**T) ) +C +C WHERE 0 .LE. X(I) .LT. B FOR I=1,...,T, +C 0 .LT. X(1), AND EMIN .LE. E .LE. EMAX. +C +C I1MACH(10) = B, THE BASE. +C +C SINGLE-PRECISION +C +C I1MACH(11) = T, THE NUMBER OF BASE-B DIGITS. +C +C I1MACH(12) = EMIN, THE SMALLEST EXPONENT E. +C +C I1MACH(13) = EMAX, THE LARGEST EXPONENT E. +C +C DOUBLE-PRECISION +C +C I1MACH(14) = T, THE NUMBER OF BASE-B DIGITS. +C +C I1MACH(15) = EMIN, THE SMALLEST EXPONENT E. +C +C I1MACH(16) = EMAX, THE LARGEST EXPONENT E. +C +C TO ALTER THIS FUNCTION FOR A PARTICULAR ENVIRONMENT, +C THE DESIRED SET OF DATA STATEMENTS SHOULD BE ACTIVATED BY +C REMOVING THE C FROM COLUMN 1. ALSO, THE VALUES OF +C I1MACH(1) - I1MACH(4) SHOULD BE CHECKED FOR CONSISTENCY +C WITH THE LOCAL OPERATING SYSTEM. +C ON RARE MACHINES A STATIC STATEMENT MAY NEED TO BE ADDED. +C (BUT PROBABLY MORE SYSTEMS PROHIBIT IT THAN REQUIRE IT.) +C + INTEGER IMACH(16),OUTPUT +C + EQUIVALENCE (IMACH(4),OUTPUT) +C +C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. +C +C DATA IMACH( 1) / 7 / +C DATA IMACH( 2) / 2 / +C DATA IMACH( 3) / 2 / +C DATA IMACH( 4) / 2 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 33 / +C DATA IMACH( 9) / Z1FFFFFFFF / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -256 / +C DATA IMACH(13) / 255 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) / -256 / +C DATA IMACH(16) / 255 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -50 / +C DATA IMACH(16) / 76 / +C +C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 48 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 39 / +C DATA IMACH( 9) / O0007777777777777 / +C DATA IMACH(10) / 8 / +C DATA IMACH(11) / 13 / +C DATA IMACH(12) / -50 / +C DATA IMACH(13) / 76 / +C DATA IMACH(14) / 26 / +C DATA IMACH(15) / -32754 / +C DATA IMACH(16) / 32780 / +C +C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 60 / +C DATA IMACH( 6) / 10 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 48 / +C DATA IMACH( 9) / 00007777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 48 / +C DATA IMACH(12) / -974 / +C DATA IMACH(13) / 1070 / +C DATA IMACH(14) / 96 / +C DATA IMACH(15) / -927 / +C DATA IMACH(16) / 1070 / +C +C MACHINE CONSTANTS FOR CONVEX C-1 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) /-1024 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR THE CRAY 1 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 102 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 64 / +C DATA IMACH( 6) / 8 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 46 / +C DATA IMACH( 9) / 1777777777777777B / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 47 / +C DATA IMACH(12) / -8189 / +C DATA IMACH(13) / 8190 / +C DATA IMACH(14) / 94 / +C DATA IMACH(15) / -8099 / +C DATA IMACH(16) / 8190 / +C +C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200 +C +C DATA IMACH( 1) / 11 / +C DATA IMACH( 2) / 12 / +C DATA IMACH( 3) / 8 / +C DATA IMACH( 4) / 10 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) /32767 / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7 +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 0 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 24 / +C DATA IMACH( 6) / 3 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 23 / +C DATA IMACH( 9) / 8388607 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 23 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 38 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 43 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 63 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES (E.G., AT&T 3B +C SERIES COMPUTERS AND 8087-BASED MACHINES LIKE THE IBM PC). +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES, +C THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z7FFFFFFF / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 63 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 63 / +C +C MACHINE CONSTANTS FOR THE INTERDATA 8/32 +C WITH THE UNIX SYSTEM FORTRAN 77 COMPILER. +C +C FOR THE INTERDATA FORTRAN VII COMPILER REPLACE +C THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 6 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / Z'7FFFFFFF' / +C DATA IMACH(10) / 16 / +C DATA IMACH(11) / 6 / +C DATA IMACH(12) / -64 / +C DATA IMACH(13) / 62 / +C DATA IMACH(14) / 14 / +C DATA IMACH(15) / -64 / +C DATA IMACH(16) / 62 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 54 / +C DATA IMACH(15) / -101 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 5 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / "377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 62 / +C DATA IMACH(15) / -128 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 32-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING +C 16-BIT INTEGER ARITHMETIC. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 16 / +C DATA IMACH( 6) / 2 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 15 / +C DATA IMACH( 9) / 32767 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE SUN MICROSYSTEMS UNIX F77 COMPILER. +C + DATA IMACH( 1) / 5 / + DATA IMACH( 2) / 6 / + DATA IMACH( 3) / 6 / + DATA IMACH( 4) / 0 / + DATA IMACH( 5) / 32 / + DATA IMACH( 6) / 4 / + DATA IMACH( 7) / 2 / + DATA IMACH( 8) / 32 / + DATA IMACH( 9) /2147483647/ + DATA IMACH(10) / 2 / + DATA IMACH(11) / 24 / + DATA IMACH(12) / -126 / + DATA IMACH(13) / 128 / + DATA IMACH(14) / 53 / + DATA IMACH(15) / -1022 / + DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE ALLIANT FX/8 UNIX FORTRAN COMPILER. +C +c$$$ DATA IMACH( 1) / 5 / +c$$$ DATA IMACH( 2) / 6 / +c$$$ DATA IMACH( 3) / 6 / +c$$$ DATA IMACH( 4) / 0 / +c$$$ DATA IMACH( 5) / 32 / +c$$$ DATA IMACH( 6) / 4 / +c$$$ DATA IMACH( 7) / 2 / +c$$$ DATA IMACH( 8) / 32 / +c$$$ DATA IMACH( 9) /2147483647/ +c$$$ DATA IMACH(10) / 2 / +c$$$ DATA IMACH(11) / 24 / +c$$$ DATA IMACH(12) / -126 / +c$$$ DATA IMACH(13) / 128 / +c$$$ DATA IMACH(14) / 53 / +c$$$ DATA IMACH(15) / -1022 / +c$$$ DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE ALLIANT FX/8 UNIX FORTRAN COMPILER. +C WITH THE -r8 COMMAND LINE OPTION. +C +c$$$ DATA IMACH( 1) / 5 / +c$$$ DATA IMACH( 2) / 6 / +c$$$ DATA IMACH( 3) / 6 / +c$$$ DATA IMACH( 4) / 0 / +c$$$ DATA IMACH( 5) / 32 / +c$$$ DATA IMACH( 6) / 4 / +c$$$ DATA IMACH( 7) / 2 / +c$$$ DATA IMACH( 8) / 32 / +c$$$ DATA IMACH( 9) /2147483647/ +c$$$ DATA IMACH(10) / 2 / +c$$$ DATA IMACH(11) / 53 / +c$$$ DATA IMACH(12) / -1022 / +c$$$ DATA IMACH(13) / 1024 / +c$$$ DATA IMACH(14) / 53 / +c$$$ DATA IMACH(15) / -1022 / +c$$$ DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. +C +C NOTE THAT THE PUNCH UNIT, I1MACH(3), HAS BEEN SET TO 7 +C WHICH IS APPROPRIATE FOR THE UNIVAC-FOR SYSTEM. +C IF YOU HAVE THE UNIVAC-FTN SYSTEM, SET IT TO 1. +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 36 / +C DATA IMACH( 6) / 6 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 35 / +C DATA IMACH( 9) / O377777777777 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 27 / +C DATA IMACH(12) / -128 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 60 / +C DATA IMACH(15) /-1024 / +C DATA IMACH(16) / 1023 / +C +C MACHINE CONSTANTS FOR VAX +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 4 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -127 / +C DATA IMACH(13) / 127 / +C DATA IMACH(14) / 56 / +C DATA IMACH(15) / -127 / +C DATA IMACH(16) / 127 / +C +C MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000 AND SVS FORTRAN ON +C THE AT&T 7300 (UNIX PC) +C +C DATA IMACH( 1) / 0 / +C DATA IMACH( 2) / 0 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 0 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 1 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C +C MACHINE CONSTANTS FOR THE RM FORTRAN ON THE AT&T 7300 (UNIX PC) +C +C DATA IMACH( 1) / 5 / +C DATA IMACH( 2) / 6 / +C DATA IMACH( 3) / 7 / +C DATA IMACH( 4) / 6 / +C DATA IMACH( 5) / 32 / +C DATA IMACH( 6) / 1 / +C DATA IMACH( 7) / 2 / +C DATA IMACH( 8) / 31 / +C DATA IMACH( 9) / 2147483647 / +C DATA IMACH(10) / 2 / +C DATA IMACH(11) / 24 / +C DATA IMACH(12) / -125 / +C DATA IMACH(13) / 128 / +C DATA IMACH(14) / 53 / +C DATA IMACH(15) / -1021 / +C DATA IMACH(16) / 1024 / +C + IF (I .LT. 1 .OR. I .GT. 16) GO TO 999 + I1MACH=IMACH(I) + RETURN + 999 WRITE(OUTPUT,1999) I + 1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10) + STOP + END + diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/runTests.sh b/components/cism/glimmer-cism/libglimmer-solve/SLAP/runTests.sh new file mode 100755 index 0000000000..3232d145b5 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/runTests.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +echo 2 | ./dlapqc diff --git a/components/cism/glimmer-cism/libglimmer-solve/SLAP/xersla.f b/components/cism/glimmer-cism/libglimmer-solve/SLAP/xersla.f new file mode 100644 index 0000000000..17eb531ca7 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/SLAP/xersla.f @@ -0,0 +1,924 @@ +CVD$G NOVECTOR +CVD$G NOCONCUR +*deck xerabt + subroutine xerabt(messg,nmessg) +c***begin prologue xerabt +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose abort program execution and print error message. +c***description +c +c abstract +c ***note*** machine dependent routine +c xerabt aborts the execution of the program. +c the error message causing the abort is given in the calling +c sequence, in case one needs it for printing on a dayfile, +c for example. +c +c description of parameters +c messg and nmessg are as in xerror, except that nmessg may +c be zero, in which case no message is being supplied. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 1 august 1982 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called (none) +c***end prologue xerabt + dimension messg(nmessg) +c***first executable statement xerabt + call exit(1) + end +*deck xerctl + subroutine xerctl(messg1,nmessg,nerr,level,kontrl) +c***begin prologue xerctl +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose allow user control over handling of errors. +c***description +c +c abstract +c allows user control over handling of individual errors. +c just after each message is recorded, but before it is +c processed any further (i.e., before it is printed or +c a decision to abort is made), a call is made to xerctl. +c if the user has provided his own version of xerctl, he +c can then override the value of kontrol used in processing +c this message by redefining its value. +c kontrl may be set to any value from -2 to 2. +c the meanings for kontrl are the same as in xsetf, except +c that the value of kontrl changes only for this message. +c if kontrl is set to a value outside the range from -2 to 2, +c it will be moved back into that range. +c +c description of parameters +c +c --input-- +c messg1 - the first word (only) of the error message. +c nmessg - same as in the call to xerror or xerrwv. +c nerr - same as in the call to xerror or xerrwv. +c level - same as in the call to xerror or xerrwv. +c kontrl - the current value of the control flag as set +c by a call to xsetf. +c +c --output-- +c kontrl - the new value of kontrl. if kontrl is not +c defined, it will remain at its original value. +c this changed value of control affects only +c the current occurrence of the current message. +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called (none) +c***end prologue xerctl + character*20 messg1 +c***first executable statement xerctl + return + end +*deck xerprt + subroutine xerprt(messg,nmessg) +c***begin prologue xerprt +c***date written 790801 (yymmdd) +c***revision date 851213 (yymmdd) +c***category no. r3 +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose print error messages. +c***description +c +c abstract +c print the hollerith message in messg, of length nmessg, +c on each file indicated by xgetua. +c latest revision --- 1 august 1985 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called i1mach,xgetua +c***end prologue xerprt + integer lun(5) + character*(*) messg +c obtain unit numbers and write line to each unit +c***first executable statement xerprt + call xgetua(lun,nunit) + lenmes = len(messg) + do 20 kunit=1,nunit + iunit = lun(kunit) + if (iunit.eq.0) iunit = i1mach(4) + do 10 ichar=1,lenmes,72 + last = min0(ichar+71 , lenmes) + write (iunit,'(1x,a)') messg(ichar:last) + 10 continue + 20 continue + return + end +*deck xerror + subroutine xerror(messg,nmessg,nerr,level) +c***begin prologue xerror +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose process an error (diagnostic) message. +c***description +c +c abstract +c xerror processes a diagnostic message, in a manner +c determined by the value of level and the current value +c of the library error control flag, kontrl. +c (see subroutine xsetf for details.) +c +c description of parameters +c --input-- +c messg - the hollerith message to be processed, containing +c no more than 72 characters. +c nmessg- the actual number of characters in messg. +c nerr - the error number associated with this message. +c nerr must not be zero. +c level - error category. +c =2 means this is an unconditionally fatal error. +c =1 means this is a recoverable error. (i.e., it is +c non-fatal if xsetf has been appropriately called.) +c =0 means this is a warning message only. +c =-1 means this is a warning message which is to be +c printed at most once, regardless of how many +c times this call is executed. +c +c examples +c call xerror('smooth -- num was zero.',23,1,2) +c call xerror('integ -- less than full accuracy achieved.', +c 1 43,2,1) +c call xerror('rooter -- actual zero of f found before interval f +c 1ully collapsed.',65,3,0) +c call xerror('exp -- underflows being set to zero.',39,1,-1) +c +c written by ron jones, with slatec common math library subcommittee +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called xerrwv +c***end prologue xerror + character*(*) messg +c***first executable statement xerror + call xerrwv(messg,nmessg,nerr,level,0,0,0,0,0.,0.) + return + end +*deck xerrwv + subroutine xerrwv(messg,nmessg,nerr,level,ni,i1,i2,nr,r1,r2) +c***begin prologue xerrwv +c***date written 800319 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose process an error message allowing 2 integer and 2 real +c values to be included in the message. +c***description +c +c abstract +c xerrwv processes a diagnostic message, in a manner +c determined by the value of level and the current value +c of the library error control flag, kontrl. +c (see subroutine xsetf for details.) +c in addition, up to two integer values and two real +c values may be printed along with the message. +c +c description of parameters +c --input-- +c messg - the hollerith message to be processed. +c nmessg- the actual number of characters in messg. +c nerr - the error number associated with this message. +c nerr must not be zero. +c level - error category. +c =2 means this is an unconditionally fatal error. +c =1 means this is a recoverable error. (i.e., it is +c non-fatal if xsetf has been appropriately called.) +c =0 means this is a warning message only. +c =-1 means this is a warning message which is to be +c printed at most once, regardless of how many +c times this call is executed. +c ni - number of integer values to be printed. (0 to 2) +c i1 - first integer value. +c i2 - second integer value. +c nr - number of real values to be printed. (0 to 2) +c r1 - first real value. +c r2 - second real value. +c +c examples +c call xerrwv('smooth -- num (=i1) was zero.',29,1,2, +c 1 1,num,0,0,0.,0.) +c call xerrwv('quadxy -- requested error (r1) less than minimum ( +c 1r2).,54,77,1,0,0,0,2,errreq,errmin) +c +c latest revision --- 1 august 1985 +c written by ron jones, with slatec common math library subcommittee +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called fdump,i1mach,j4save,xerabt,xerctl,xerprt,xersav, +c xgetua +c***end prologue xerrwv + character*(*) messg + character*20 lfirst + character*37 form + dimension lun(5) +c get flags +c***first executable statement xerrwv + lkntrl = j4save(2,0,.false.) + maxmes = j4save(4,0,.false.) +c check for valid input + if ((nmessg.gt.0).and.(nerr.ne.0).and. + 1 (level.ge.(-1)).and.(level.le.2)) go to 10 + if (lkntrl.gt.0) call xerprt('fatal error in...',17) + call xerprt('xerror -- invalid input',23) +c if (lkntrl.gt.0) call fdump + if (lkntrl.gt.0) call xerprt('job abort due to fatal error.', + 1 29) + if (lkntrl.gt.0) call xersav(' ',0,0,0,kdummy) + call xerabt('xerror -- invalid input',23) + return + 10 continue +c record message + junk = j4save(1,nerr,.true.) + call xersav(messg,nmessg,nerr,level,kount) +c let user override + lfirst = messg + lmessg = nmessg + lerr = nerr + llevel = level + call xerctl(lfirst,lmessg,lerr,llevel,lkntrl) +c reset to original values + lmessg = nmessg + lerr = nerr + llevel = level + lkntrl = max0(-2,min0(2,lkntrl)) + mkntrl = iabs(lkntrl) +c decide whether to print message + if ((llevel.lt.2).and.(lkntrl.eq.0)) go to 100 + if (((llevel.eq.(-1)).and.(kount.gt.min0(1,maxmes))) + 1.or.((llevel.eq.0) .and.(kount.gt.maxmes)) + 2.or.((llevel.eq.1) .and.(kount.gt.maxmes).and.(mkntrl.eq.1)) + 3.or.((llevel.eq.2) .and.(kount.gt.max0(1,maxmes)))) go to 100 + if (lkntrl.le.0) go to 20 + call xerprt(' ',1) +c introduction + if (llevel.eq.(-1)) call xerprt + 1('warning message...this message will only be printed once.',57) + if (llevel.eq.0) call xerprt('warning in...',13) + if (llevel.eq.1) call xerprt + 1 ('recoverable error in...',23) + if (llevel.eq.2) call xerprt('fatal error in...',17) + 20 continue +c message + call xerprt(messg,lmessg) + call xgetua(lun,nunit) + isizei = log10(float(i1mach(9))) + 1.0 + isizef = log10(float(i1mach(10))**i1mach(11)) + 1.0 + do 50 kunit=1,nunit + iunit = lun(kunit) + if (iunit.eq.0) iunit = i1mach(4) + do 22 i=1,min(ni,2) + write (form,21) i,isizei + 21 format ('(11x,21hin above message, i',i1,'=,i',i2,') ') + if (i.eq.1) write (iunit,form) i1 + if (i.eq.2) write (iunit,form) i2 + 22 continue + do 24 i=1,min(nr,2) + write (form,23) i,isizef+10,isizef + 23 format ('(11x,21hin above message, r',i1,'=,e', + 1 i2,'.',i2,')') + if (i.eq.1) write (iunit,form) r1 + if (i.eq.2) write (iunit,form) r2 + 24 continue + if (lkntrl.le.0) go to 40 +c error number + write (iunit,30) lerr + 30 format (15h error number =,i10) + 40 continue + 50 continue +c trace-back +c if (lkntrl.gt.0) call fdump + 100 continue + ifatal = 0 + if ((llevel.eq.2).or.((llevel.eq.1).and.(mkntrl.eq.2))) + 1ifatal = 1 +c quit here if message is not fatal + if (ifatal.le.0) return + if ((lkntrl.le.0).or.(kount.gt.max0(1,maxmes))) go to 120 +c print reason for abort + if (llevel.eq.1) call xerprt + 1 ('job abort due to unrecovered error.',35) + if (llevel.eq.2) call xerprt + 1 ('job abort due to fatal error.',29) +c print error summary + call xersav(' ',-1,0,0,kdummy) + 120 continue +c abort + if ((llevel.eq.2).and.(kount.gt.max0(1,maxmes))) lmessg = 0 + call xerabt(messg,lmessg) + return + end +*deck xersav + subroutine xersav(messg,nmessg,nerr,level,icount) +c***begin prologue xersav +c***date written 800319 (yymmdd) +c***revision date 851213 (yymmdd) +c***category no. r3 +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose record that an error has occurred. +c***description +c +c abstract +c record that this error occurred. +c +c description of parameters +c --input-- +c messg, nmessg, nerr, level are as in xerror, +c except that when nmessg=0 the tables will be +c dumped and cleared, and when nmessg is less than zero the +c tables will be dumped and not cleared. +c --output-- +c icount will be the number of times this message has +c been seen, or zero if the table has overflowed and +c does not contain this message specifically. +c when nmessg=0, icount will not be altered. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 1 august 1985 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called i1mach,xgetua +c***end prologue xersav + integer lun(5) + character*(*) messg + character*20 mestab(10),mes + dimension nertab(10),levtab(10),kount(10) + save mestab,nertab,levtab,kount,kountx +c next two data statements are necessary to provide a blank +c error table initially + data kount(1),kount(2),kount(3),kount(4),kount(5), + 1 kount(6),kount(7),kount(8),kount(9),kount(10) + 2 /0,0,0,0,0,0,0,0,0,0/ + data kountx/0/ +c***first executable statement xersav + if (nmessg.gt.0) go to 80 +c dump the table + if (kount(1).eq.0) return +c print to each unit + call xgetua(lun,nunit) + do 60 kunit=1,nunit + iunit = lun(kunit) + if (iunit.eq.0) iunit = i1mach(4) +c print table header + write (iunit,10) + 10 format (32h0 error message summary/ + 1 51h message start nerr level count) +c print body of table + do 20 i=1,10 + if (kount(i).eq.0) go to 30 + write (iunit,15) mestab(i),nertab(i),levtab(i),kount(i) + 15 format (1x,a20,3i10) + 20 continue + 30 continue +c print number of other errors + if (kountx.ne.0) write (iunit,40) kountx + 40 format (41h0other errors not individually tabulated=,i10) + write (iunit,50) + 50 format (1x) + 60 continue + if (nmessg.lt.0) return +c clear the error tables + do 70 i=1,10 + 70 kount(i) = 0 + kountx = 0 + return + 80 continue +c process a message... +c search for this messg, or else an empty slot for this messg, +c or else determine that the error table is full. + mes = messg + do 90 i=1,10 + ii = i + if (kount(i).eq.0) go to 110 + if (mes.ne.mestab(i)) go to 90 + if (nerr.ne.nertab(i)) go to 90 + if (level.ne.levtab(i)) go to 90 + go to 100 + 90 continue +c three possible cases... +c table is full + kountx = kountx+1 + icount = 1 + return +c message found in table + 100 kount(ii) = kount(ii) + 1 + icount = kount(ii) + return +c empty slot found for new message + 110 mestab(ii) = mes + nertab(ii) = nerr + levtab(ii) = level + kount(ii) = 1 + icount = 1 + return + end + subroutine xgetf(kontrl) +c***begin prologue xgetf +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose return the current value of the error control flag. +c***description +c +c abstract +c xgetf returns the current value of the error control flag +c in kontrl. see subroutine xsetf for flag value meanings. +c (kontrl is an output parameter only.) +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 7 june 1978 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xgetf +c***first executable statement xgetf + kontrl = j4save(2,0,.false.) + return + end +*deck xgetua + subroutine xgetua(iunita,n) +c***begin prologue xgetua +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose return unit number(s) to which error messages are being +c sent. +c***description +c +c abstract +c xgetua may be called to determine the unit number or numbers +c to which error messages are being sent. +c these unit numbers may have been set by a call to xsetun, +c or a call to xsetua, or may be a default value. +c +c description of parameters +c --output-- +c iunit - an array of one to five unit numbers, depending +c on the value of n. a value of zero refers to the +c default unit, as defined by the i1mach machine +c constant routine. only iunit(1),...,iunit(n) are +c defined by xgetua. the values of iunit(n+1),..., +c iunit(5) are not defined (for n .lt. 5) or altered +c in any way by xgetua. +c n - the number of units to which copies of the +c error messages are being sent. n will be in the +c range from 1 to 5. +c +c latest revision --- 19 mar 1980 +c written by ron jones, with slatec common math library subcommittee +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xgetua + dimension iunita(5) +c***first executable statement xgetua + n = j4save(5,0,.false.) + do 30 i=1,n + index = i+4 + if (i.eq.1) index = 3 + iunita(i) = j4save(index,0,.false.) + 30 continue + return + end +*deck j4save + function j4save(iwhich,ivalue,iset) +c***begin prologue j4save +c***refer to xerror +c***routines called (none) +c***description +c +c abstract +c j4save saves and recalls several global variables needed +c by the library error handling routines. +c +c description of parameters +c --input-- +c iwhich - index of item desired. +c = 1 refers to current error number. +c = 2 refers to current error control flag. +c = 3 refers to current unit number to which error +c messages are to be sent. (0 means use standard.) +c = 4 refers to the maximum number of times any +c message is to be printed (as set by xermax). +c = 5 refers to the total number of units to which +c each error message is to be written. +c = 6 refers to the 2nd unit for error messages +c = 7 refers to the 3rd unit for error messages +c = 8 refers to the 4th unit for error messages +c = 9 refers to the 5th unit for error messages +c ivalue - the value to be set for the iwhich-th parameter, +c if iset is .true. . +c iset - if iset=.true., the iwhich-th parameter will be +c given the value, ivalue. if iset=.false., the +c iwhich-th parameter will be unchanged, and ivalue +c is a dummy parameter. +c --output-- +c the (old) value of the iwhich-th parameter will be returned +c in the function value, j4save. +c +c written by ron jones, with slatec common math library subcommittee +c adapted from bell laboratories port library error handler +c latest revision --- 1 august 1985 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***end prologue j4save + logical iset + integer iparam(9) + save iparam + data iparam(1),iparam(2),iparam(3),iparam(4)/0,2,0,10/ + data iparam(5)/1/ + data iparam(6),iparam(7),iparam(8),iparam(9)/0,0,0,0/ +c***first executable statement j4save + j4save = iparam(iwhich) + if (iset) iparam(iwhich) = ivalue + return + end +*deck xerclr + subroutine xerclr +c***begin prologue xerclr +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose reset current error number to zero. +c***description +c +c abstract +c this routine simply resets the current error number to zero. +c this may be necessary to do in order to determine that +c a certain error has occurred again since the last time +c numxer was referenced. +c +c written by ron jones, with slatec common math library subcommittee +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xerclr +c***first executable statement xerclr + junk = j4save(1,0,.true.) + return + end + subroutine xerdmp +c***begin prologue xerdmp +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose print the error tables and then clear them. +c***description +c +c abstract +c xerdmp prints the error tables, then clears them. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 7 june 1978 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called xersav +c***end prologue xerdmp +c***first executable statement xerdmp + call xersav(' ',0,0,0,kount) + return + end + subroutine xermax(max) +c***begin prologue xermax +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose set maximum number of times any error message is to be +c printed. +c***description +c +c abstract +c xermax sets the maximum number of times any message +c is to be printed. that is, non-fatal messages are +c not to be printed after they have occured max times. +c such non-fatal messages may be printed less than +c max times even if they occur max times, if error +c suppression mode (kontrl=0) is ever in effect. +c +c description of parameter +c --input-- +c max - the maximum number of times any one message +c is to be printed. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 7 june 1978 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xermax +c***first executable statement xermax + junk = j4save(4,max,.true.) + return + end + subroutine xgetun(iunit) +c***begin prologue xgetun +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3c +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose return the (first) output file to which error messages +c are being sent. +c***description +c +c abstract +c xgetun gets the (first) output file to which error messages +c are being sent. to find out if more than one file is being +c used, one must use the xgetua routine. +c +c description of parameter +c --output-- +c iunit - the logical unit number of the (first) unit to +c which error messages are being sent. +c a value of zero means that the default file, as +c defined by the i1mach routine, is being used. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 23 may 1979 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xgetun +c***first executable statement xgetun + iunit = j4save(3,0,.false.) + return + end + subroutine xsetf(kontrl) +c***begin prologue xsetf +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3a +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose set the error control flag. +c***description +c +c abstract +c xsetf sets the error control flag value to kontrl. +c (kontrl is an input parameter only.) +c the following table shows how each message is treated, +c depending on the values of kontrl and level. (see xerror +c for description of level.) +c +c if kontrl is zero or negative, no information other than the +c message itself (including numeric values, if any) will be +c printed. if kontrl is positive, introductory messages, +c trace-backs, etc., will be printed in addition to the message. +c +c iabs(kontrl) +c level 0 1 2 +c value +c 2 fatal fatal fatal +c +c 1 not printed printed fatal +c +c 0 not printed printed printed +c +c -1 not printed printed printed +c only only +c once once +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 19 mar 1980 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save,xerrwv +c***end prologue xsetf +c***first executable statement xsetf + if ((kontrl.ge.(-2)).and.(kontrl.le.2)) go to 10 + call xerrwv('xsetf -- invalid value of kontrl (i1).',33,1,2, + 1 1,kontrl,0,0,0.,0.) + return + 10 junk = j4save(2,kontrl,.true.) + return + end + subroutine xsetua(iunita,n) +c***begin prologue xsetua +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3b +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose set logical unit numbers (up to 5) to which error +c messages are to be sent. +c***description +c +c abstract +c xsetua may be called to declare a list of up to five +c logical units, each of which is to receive a copy of +c each error message processed by this package. +c the purpose of xsetua is to allow simultaneous printing +c of each error message on, say, a main output file, +c an interactive terminal, and other files such as graphics +c communication files. +c +c description of parameters +c --input-- +c iunit - an array of up to five unit numbers. +c normally these numbers should all be different +c (but duplicates are not prohibited.) +c n - the number of unit numbers provided in iunit +c must have 1 .le. n .le. 5. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 19 mar 1980 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save,xerrwv +c***end prologue xsetua + dimension iunita(5) +c***first executable statement xsetua + if ((n.ge.1).and.(n.le.5)) go to 10 + call xerrwv('xsetua -- invalid value of n (i1).',34,1,2, + 1 1,n,0,0,0.,0.) + return + 10 continue + do 20 i=1,n + index = i+4 + if (i.eq.1) index = 3 + junk = j4save(index,iunita(i),.true.) + 20 continue + junk = j4save(5,n,.true.) + return + end + subroutine xsetun(iunit) +c***begin prologue xsetun +c***date written 790801 (yymmdd) +c***revision date 851111 (yymmdd) +c***category no. r3b +c***keywords error,xerror package +c***author jones, r. e., (snla) +c***purpose set output file to which error messages are to be sent. +c***description +c +c abstract +c xsetun sets the output file to which error messages are to +c be sent. only one file will be used. see xsetua for +c how to declare more than one file. +c +c description of parameter +c --input-- +c iunit - an input parameter giving the logical unit number +c to which error messages are to be sent. +c +c written by ron jones, with slatec common math library subcommittee +c latest revision --- 7 june 1978 +c***references jones r.e., kahaner d.k., 'xerror, the slatec error- +c handling package', sand82-0800, sandia laboratories, +c 1982. +c***routines called j4save +c***end prologue xsetun +c***first executable statement xsetun + junk = j4save(3,iunit,.true.) + junk = j4save(5,1,.true.) + return + end + FUNCTION RAND(R) +C***BEGIN PROLOGUE RAND +C***DATE WRITTEN 770401 (YYMMDD) +C***REVISION DATE 861211 (YYMMDD) +C***CATEGORY NO. L6A21 +C***KEYWORDS LIBRARY=SLATEC(FNLIB),TYPE=SINGLE PRECISION(RAND-S), +C RANDOM NUMBER,SPECIAL FUNCTIONS,UNIFORM +C***AUTHOR FULLERTON, W., (LANL) +C***PURPOSE Generates a uniformly distributed random number. +C***DESCRIPTION +C +C This pseudo-random number generator is portable among a wide +C variety of computers. RAND(R) undoubtedly is not as good as many +C readily available installation dependent versions, and so this +C routine is not recommended for widespread usage. Its redeeming +C feature is that the exact same random numbers (to within final round- +C off error) can be generated from machine to machine. Thus, programs +C that make use of random numbers can be easily transported to and +C checked in a new environment. +C The random numbers are generated by the linear congruential +C method described, e.g., by Knuth in Seminumerical Methods (p.9), +C Addison-Wesley, 1969. Given the I-th number of a pseudo-random +C sequence, the I+1 -st number is generated from +C X(I+1) = (A*X(I) + C) MOD M, +C where here M = 2**22 = 4194304, C = 1731 and several suitable values +C of the multiplier A are discussed below. Both the multiplier A and +C random number X are represented in double precision as two 11-bit +C words. The constants are chosen so that the period is the maximum +C possible, 4194304. +C In order that the same numbers be generated from machine to +C machine, it is necessary that 23-bit integers be reducible modulo +C 2**11 exactly, that 23-bit integers be added exactly, and that 11-bit +C integers be multiplied exactly. Furthermore, if the restart option +C is used (where R is between 0 and 1), then the product R*2**22 = +C R*4194304 must be correct to the nearest integer. +C The first four random numbers should be .0004127026, +C .6750836372, .1614754200, and .9086198807. The tenth random number +C is .5527787209, and the hundredth is .3600893021 . The thousandth +C number should be .2176990509 . +C In order to generate several effectively independent sequences +C with the same generator, it is necessary to know the random number +C for several widely spaced calls. The I-th random number times 2**22, +C where I=K*P/8 and P is the period of the sequence (P = 2**22), is +C still of the form L*P/8. In particular we find the I-th random +C number multiplied by 2**22 is given by +C I = 0 1*P/8 2*P/8 3*P/8 4*P/8 5*P/8 6*P/8 7*P/8 8*P/8 +C RAND= 0 5*P/8 2*P/8 7*P/8 4*P/8 1*P/8 6*P/8 3*P/8 0 +C Thus the 4*P/8 = 2097152 random number is 2097152/2**22. +C Several multipliers have been subjected to the spectral test +C (see Knuth, p. 82). Four suitable multipliers roughly in order of +C goodness according to the spectral test are +C 3146757 = 1536*2048 + 1029 = 2**21 + 2**20 + 2**10 + 5 +C 2098181 = 1024*2048 + 1029 = 2**21 + 2**10 + 5 +C 3146245 = 1536*2048 + 517 = 2**21 + 2**20 + 2**9 + 5 +C 2776669 = 1355*2048 + 1629 = 5**9 + 7**7 + 1 +C +C In the table below LOG10(NU(I)) gives roughly the number of +C random decimal digits in the random numbers considered I at a time. +C C is the primary measure of goodness. In both cases bigger is better. +C +C LOG10 NU(I) C(I) +C A I=2 I=3 I=4 I=5 I=2 I=3 I=4 I=5 +C +C 3146757 3.3 2.0 1.6 1.3 3.1 1.3 4.6 2.6 +C 2098181 3.3 2.0 1.6 1.2 3.2 1.3 4.6 1.7 +C 3146245 3.3 2.2 1.5 1.1 3.2 4.2 1.1 0.4 +C 2776669 3.3 2.1 1.6 1.3 2.5 2.0 1.9 2.6 +C Best +C Possible 3.3 2.3 1.7 1.4 3.6 5.9 9.7 14.9 +C +C Input Argument -- +C R If R=0., the next random number of the sequence is generated. +C If R .LT. 0., the last generated number will be returned for +C possible use in a restart procedure. +C If R .GT. 0., the sequence of random numbers will start with +C the seed R mod 1. This seed is also returned as the value of +C RAND provided the arithmetic is done exactly. +C +C Output Value -- +C RAND a pseudo-random number between 0. and 1. +C***REFERENCES (NONE) +C***ROUTINES CALLED (NONE) +C***END PROLOGUE RAND + SAVE IA1, IA0, IA1MA0, IC, IX1, IX0 + DATA IA1, IA0, IA1MA0 /1536, 1029, 507/ + DATA IC /1731/ + DATA IX1, IX0 /0, 0/ +C***FIRST EXECUTABLE STATEMENT RAND + IF (R.LT.0.) GO TO 10 + IF (R.GT.0.) GO TO 20 +C +C A*X = 2**22*IA1*IX1 + 2**11*(IA1*IX1 + (IA1-IA0)*(IX0-IX1) +C + IA0*IX0) + IA0*IX0 +C + IY0 = IA0*IX0 + IY1 = IA1*IX1 + IA1MA0*(IX0-IX1) + IY0 + IY0 = IY0 + IC + IX0 = MOD (IY0, 2048) + IY1 = IY1 + (IY0-IX0)/2048 + IX1 = MOD (IY1, 2048) +C + 10 RAND = IX1*2048 + IX0 + RAND = RAND / 4194304. + RETURN +C + 20 IX1 = AMOD(R,1.)*4194304. + 0.5 + IX0 = MOD (IX1, 2048) + IX1 = (IX1-IX0)/2048 + GO TO 10 +C + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/caxpy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/caxpy.f new file mode 100644 index 0000000000..ece603c6c2 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/caxpy.f @@ -0,0 +1,52 @@ + SUBROUTINE CAXPY(N,CA,CX,INCX,CY,INCY) +* .. Scalar Arguments .. + COMPLEX CA + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* Purpose +* ======= +* +* CAXPY constant times a vector plus a vector. +* +* Further Details +* =============== +* +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. +* .. External Functions .. + REAL SCABS1 + EXTERNAL SCABS1 +* .. + IF (N.LE.0) RETURN + IF (SCABS1(CA).EQ.0.0E+0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + CY(IY) = CY(IY) + CA*CX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + CY(I) = CY(I) + CA*CX(I) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/ccopy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/ccopy.f new file mode 100644 index 0000000000..97e6a235de --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/ccopy.f @@ -0,0 +1,46 @@ + SUBROUTINE CCOPY(N,CX,INCX,CY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* Purpose +* ======= +* +* CCOPY copies a vector x to a vector y. +* +* Further Details +* =============== +* +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + CY(IY) = CX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + CY(I) = CX(I) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/cdotc.f b/components/cism/glimmer-cism/libglimmer-solve/blas/cdotc.f new file mode 100644 index 0000000000..40b7748cb9 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/cdotc.f @@ -0,0 +1,55 @@ + COMPLEX FUNCTION CDOTC(N,CX,INCX,CY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* Purpose +* ======= +* +* forms the dot product of two vectors, conjugating the first +* vector. +* +* Further Details +* =============== +* +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* .. Local Scalars .. + COMPLEX CTEMP + INTEGER I,IX,IY +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG +* .. + CTEMP = (0.0,0.0) + CDOTC = (0.0,0.0) + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + CTEMP = CTEMP + CONJG(CX(IX))*CY(IY) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + CDOTC = CTEMP + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + CTEMP = CTEMP + CONJG(CX(I))*CY(I) + 30 CONTINUE + CDOTC = CTEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/cdotu.f b/components/cism/glimmer-cism/libglimmer-solve/blas/cdotu.f new file mode 100644 index 0000000000..529c0e264b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/cdotu.f @@ -0,0 +1,51 @@ + COMPLEX FUNCTION CDOTU(N,CX,INCX,CY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* Purpose +* ======= +* +* CDOTU forms the dot product of two vectors. +* +* Further Details +* =============== +* +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* .. Local Scalars .. + COMPLEX CTEMP + INTEGER I,IX,IY +* .. + CTEMP = (0.0,0.0) + CDOTU = (0.0,0.0) + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + CTEMP = CTEMP + CX(IX)*CY(IY) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + CDOTU = CTEMP + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + CTEMP = CTEMP + CX(I)*CY(I) + 30 CONTINUE + CDOTU = CTEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/crotg.f b/components/cism/glimmer-cism/libglimmer-solve/blas/crotg.f new file mode 100644 index 0000000000..2057a29807 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/crotg.f @@ -0,0 +1,33 @@ + SUBROUTINE CROTG(CA,CB,C,S) +* .. Scalar Arguments .. + COMPLEX CA,CB,S + REAL C +* .. +* +* Purpose +* ======= +* +* CROTG determines a complex Givens rotation. +* +* .. Local Scalars .. + COMPLEX ALPHA + REAL NORM,SCALE +* .. +* .. Intrinsic Functions .. + INTRINSIC CABS,CONJG,SQRT +* .. + IF (CABS(CA).NE.0.) GO TO 10 + C = 0. + S = (1.,0.) + CA = CB + GO TO 20 + 10 CONTINUE + SCALE = CABS(CA) + CABS(CB) + NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2) + ALPHA = CA/CABS(CA) + C = CABS(CA)/NORM + S = ALPHA*CONJG(CB)/NORM + CA = ALPHA*NORM + 20 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/cscal.f b/components/cism/glimmer-cism/libglimmer-solve/blas/cscal.f new file mode 100644 index 0000000000..3bcdff67b6 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/cscal.f @@ -0,0 +1,39 @@ + SUBROUTINE CSCAL(N,CA,CX,INCX) +* .. Scalar Arguments .. + COMPLEX CA + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX CX(*) +* .. +* +* Purpose +* ======= +* +* scales a vector by a constant. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,NINCX +* .. + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + CX(I) = CA*CX(I) + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* + 20 DO 30 I = 1,N + CX(I) = CA*CX(I) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/csscal.f b/components/cism/glimmer-cism/libglimmer-solve/blas/csscal.f new file mode 100644 index 0000000000..1bc2b60904 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/csscal.f @@ -0,0 +1,42 @@ + SUBROUTINE CSSCAL(N,SA,CX,INCX) +* .. Scalar Arguments .. + REAL SA + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX CX(*) +* .. +* +* Purpose +* ======= +* +* scales a complex vector by a real constant. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC AIMAG,CMPLX,REAL +* .. + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* + 20 DO 30 I = 1,N + CX(I) = CMPLX(SA*REAL(CX(I)),SA*AIMAG(CX(I))) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/cswap.f b/components/cism/glimmer-cism/libglimmer-solve/blas/cswap.f new file mode 100644 index 0000000000..4a2b33bf0e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/cswap.f @@ -0,0 +1,47 @@ + SUBROUTINE CSWAP(N,CX,INCX,CY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* Purpose +* ======= +* +* interchanges two vectors. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + COMPLEX CTEMP + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + CTEMP = CX(IX) + CX(IX) = CY(IY) + CY(IY) = CTEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 + 20 DO 30 I = 1,N + CTEMP = CX(I) + CX(I) = CY(I) + CY(I) = CTEMP + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dasum.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dasum.f new file mode 100644 index 0000000000..def066cc7f --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dasum.f @@ -0,0 +1,57 @@ + DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*) +* .. +* +* Purpose +* ======= +* +* takes the sum of the absolute values. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + DOUBLE PRECISION DTEMP + INTEGER I,M,MP1,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC DABS,MOD +* .. + DASUM = 0.0d0 + DTEMP = 0.0d0 + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + DTEMP = DTEMP + DABS(DX(I)) + 10 CONTINUE + DASUM = DTEMP + RETURN +* +* code for increment equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,6) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DTEMP = DTEMP + DABS(DX(I)) + 30 CONTINUE + IF (N.LT.6) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,6 + DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2)) + + + DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5)) + 50 CONTINUE + 60 DASUM = DTEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/daxpy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/daxpy.f new file mode 100644 index 0000000000..ceac8cc515 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/daxpy.f @@ -0,0 +1,62 @@ + SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) +* .. Scalar Arguments .. + DOUBLE PRECISION DA + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* Purpose +* ======= +* +* constant times a vector plus a vector. +* uses unrolled loops for increments equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (DA.EQ.0.0d0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + DY(IY) = DY(IY) + DA*DX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,4) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DY(I) = DY(I) + DA*DX(I) + 30 CONTINUE + IF (N.LT.4) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,4 + DY(I) = DY(I) + DA*DX(I) + DY(I+1) = DY(I+1) + DA*DX(I+1) + DY(I+2) = DY(I+2) + DA*DX(I+2) + DY(I+3) = DY(I+3) + DA*DX(I+3) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dcopy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dcopy.f new file mode 100644 index 0000000000..f2305ebc03 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dcopy.f @@ -0,0 +1,63 @@ + SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* Purpose +* ======= +* +* copies a vector, x, to a vector, y. +* uses unrolled loops for increments equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + DY(IY) = DX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,7) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DY(I) = DX(I) + 30 CONTINUE + IF (N.LT.7) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,7 + DY(I) = DX(I) + DY(I+1) = DX(I+1) + DY(I+2) = DX(I+2) + DY(I+3) = DX(I+3) + DY(I+4) = DX(I+4) + DY(I+5) = DX(I+5) + DY(I+6) = DX(I+6) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/ddot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/ddot.f new file mode 100644 index 0000000000..582ae64931 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/ddot.f @@ -0,0 +1,63 @@ + DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* Purpose +* ======= +* +* forms the dot product of two vectors. +* uses unrolled loops for increments equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + DOUBLE PRECISION DTEMP + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + DDOT = 0.0d0 + DTEMP = 0.0d0 + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + DTEMP = DTEMP + DX(IX)*DY(IY) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + DDOT = DTEMP + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,5) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DTEMP = DTEMP + DX(I)*DY(I) + 30 CONTINUE + IF (N.LT.5) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,5 + DTEMP = DTEMP + DX(I)*DY(I) + DX(I+1)*DY(I+1) + + + DX(I+2)*DY(I+2) + DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4) + 50 CONTINUE + 60 DDOT = DTEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dnrm2.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dnrm2.f new file mode 100644 index 0000000000..6102c3e4d7 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dnrm2.f @@ -0,0 +1,64 @@ + DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION X(*) +* .. +* +* Purpose +* ======= +* +* DNRM2 returns the euclidean norm of a vector via the function +* name, so that +* +* DNRM2 := sqrt( x'*x ) +* +* +* -- This version written on 25-October-1982. +* Modified on 14-October-1993 to inline the call to DLASSQ. +* Sven Hammarling, Nag Ltd. +* +* +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* .. Local Scalars .. + DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ + INTEGER IX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,SQRT +* .. + IF (N.LT.1 .OR. INCX.LT.1) THEN + NORM = ZERO + ELSE IF (N.EQ.1) THEN + NORM = ABS(X(1)) + ELSE + SCALE = ZERO + SSQ = ONE +* The following loop is equivalent to this call to the LAPACK +* auxiliary routine: +* CALL DLASSQ( N, X, INCX, SCALE, SSQ ) +* + DO 10 IX = 1,1 + (N-1)*INCX,INCX + IF (X(IX).NE.ZERO) THEN + ABSXI = ABS(X(IX)) + IF (SCALE.LT.ABSXI) THEN + SSQ = ONE + SSQ* (SCALE/ABSXI)**2 + SCALE = ABSXI + ELSE + SSQ = SSQ + (ABSXI/SCALE)**2 + END IF + END IF + 10 CONTINUE + NORM = SCALE*SQRT(SSQ) + END IF +* + DNRM2 = NORM + RETURN +* +* End of DNRM2. +* + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/drot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/drot.f new file mode 100644 index 0000000000..adaa88f6c4 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/drot.f @@ -0,0 +1,49 @@ + SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) +* .. Scalar Arguments .. + DOUBLE PRECISION C,S + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* Purpose +* ======= +* +* applies a plane rotation. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + DOUBLE PRECISION DTEMP + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + DTEMP = C*DX(IX) + S*DY(IY) + DY(IY) = C*DY(IY) - S*DX(IX) + DX(IX) = DTEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + DTEMP = C*DX(I) + S*DY(I) + DY(I) = C*DY(I) - S*DX(I) + DX(I) = DTEMP + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/drotg.f b/components/cism/glimmer-cism/libglimmer-solve/blas/drotg.f new file mode 100644 index 0000000000..e50dd648ab --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/drotg.f @@ -0,0 +1,38 @@ + SUBROUTINE DROTG(DA,DB,C,S) +* .. Scalar Arguments .. + DOUBLE PRECISION C,DA,DB,S +* .. +* +* Purpose +* ======= +* +* construct givens plane rotation. +* jack dongarra, linpack, 3/11/78. +* +* +* .. Local Scalars .. + DOUBLE PRECISION R,ROE,SCALE,Z +* .. +* .. Intrinsic Functions .. + INTRINSIC DABS,DSIGN,DSQRT +* .. + ROE = DB + IF (DABS(DA).GT.DABS(DB)) ROE = DA + SCALE = DABS(DA) + DABS(DB) + IF (SCALE.NE.0.0d0) GO TO 10 + C = 1.0d0 + S = 0.0d0 + R = 0.0d0 + Z = 0.0d0 + GO TO 20 + 10 R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2) + R = DSIGN(1.0d0,ROE)*R + C = DA/R + S = DB/R + Z = 1.0d0 + IF (DABS(DA).GT.DABS(DB)) Z = S + IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C + 20 DA = R + DB = Z + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/drotm.f b/components/cism/glimmer-cism/libglimmer-solve/blas/drotm.f new file mode 100644 index 0000000000..28cf21372a --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/drotm.f @@ -0,0 +1,147 @@ + SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DPARAM(5),DX(1),DY(1) +* .. +* +* Purpose +* ======= +* +* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX +* +* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN +* (DY**T) +* +* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE +* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. +* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +* +* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 +* +* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) +* H=( ) ( ) ( ) ( ) +* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). +* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. +* +* Arguments +* ========= +* +* N (input) INTEGER +* number of elements in input vector(s) +* +* DX (input/output) DOUBLE PRECISION array, dimension N +* double precision vector with 5 elements +* +* INCX (input) INTEGER +* storage spacing between elements of DX +* +* DY (input/output) DOUBLE PRECISION array, dimension N +* double precision vector with N elements +* +* INCY (input) INTEGER +* storage spacing between elements of DY +* +* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 +* DPARAM(1)=DFLAG +* DPARAM(2)=DH11 +* DPARAM(3)=DH21 +* DPARAM(4)=DH12 +* DPARAM(5)=DH22 +* +* ===================================================================== +* +* .. Local Scalars .. + DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO + INTEGER I,KX,KY,NSTEPS +* .. +* .. Data statements .. + DATA ZERO,TWO/0.D0,2.D0/ +* .. +* + DFLAG = DPARAM(1) + IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 140 + IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 +* + NSTEPS = N*INCX + IF (DFLAG) 50,10,30 + 10 CONTINUE + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DO 20 I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W + Z*DH12 + DY(I) = W*DH21 + Z + 20 CONTINUE + GO TO 140 + 30 CONTINUE + DH11 = DPARAM(2) + DH22 = DPARAM(5) + DO 40 I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W*DH11 + Z + DY(I) = -W + DH22*Z + 40 CONTINUE + GO TO 140 + 50 CONTINUE + DH11 = DPARAM(2) + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DH22 = DPARAM(5) + DO 60 I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W*DH11 + Z*DH12 + DY(I) = W*DH21 + Z*DH22 + 60 CONTINUE + GO TO 140 + 70 CONTINUE + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY +* + IF (DFLAG) 120,80,100 + 80 CONTINUE + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DO 90 I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W + Z*DH12 + DY(KY) = W*DH21 + Z + KX = KX + INCX + KY = KY + INCY + 90 CONTINUE + GO TO 140 + 100 CONTINUE + DH11 = DPARAM(2) + DH22 = DPARAM(5) + DO 110 I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W*DH11 + Z + DY(KY) = -W + DH22*Z + KX = KX + INCX + KY = KY + INCY + 110 CONTINUE + GO TO 140 + 120 CONTINUE + DH11 = DPARAM(2) + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DH22 = DPARAM(5) + DO 130 I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W*DH11 + Z*DH12 + DY(KY) = W*DH21 + Z*DH22 + KX = KX + INCX + KY = KY + INCY + 130 CONTINUE + 140 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/drotmg.f b/components/cism/glimmer-cism/libglimmer-solve/blas/drotmg.f new file mode 100644 index 0000000000..3ae647b087 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/drotmg.f @@ -0,0 +1,206 @@ + SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM) +* .. Scalar Arguments .. + DOUBLE PRECISION DD1,DD2,DX1,DY1 +* .. +* .. Array Arguments .. + DOUBLE PRECISION DPARAM(5) +* .. +* +* Purpose +* ======= +* +* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS +* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)* +* DY2)**T. +* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +* +* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 +* +* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) +* H=( ) ( ) ( ) ( ) +* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). +* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 +* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE +* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) +* +* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE +* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE +* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. +* +* +* Arguments +* ========= +* +* DD1 (input/output) DOUBLE PRECISION +* +* DD2 (input/output) DOUBLE PRECISION +* +* DX1 (input/output) DOUBLE PRECISION +* +* DY1 (input) DOUBLE PRECISION +* +* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 +* DPARAM(1)=DFLAG +* DPARAM(2)=DH11 +* DPARAM(3)=DH21 +* DPARAM(4)=DH12 +* DPARAM(5)=DH22 +* +* ===================================================================== +* +* .. Local Scalars .. + DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP, + + DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO + INTEGER IGO +* .. +* .. Intrinsic Functions .. + INTRINSIC DABS +* .. +* .. Data statements .. +* + DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/ + DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/ +* .. + + IF (.NOT.DD1.LT.ZERO) GO TO 10 +* GO ZERO-H-D-AND-DX1.. + GO TO 60 + 10 CONTINUE +* CASE-DD1-NONNEGATIVE + DP2 = DD2*DY1 + IF (.NOT.DP2.EQ.ZERO) GO TO 20 + DFLAG = -TWO + GO TO 260 +* REGULAR-CASE.. + 20 CONTINUE + DP1 = DD1*DX1 + DQ2 = DP2*DY1 + DQ1 = DP1*DX1 +* + IF (.NOT.DABS(DQ1).GT.DABS(DQ2)) GO TO 40 + DH21 = -DY1/DX1 + DH12 = DP2/DP1 +* + DU = ONE - DH12*DH21 +* + IF (.NOT.DU.LE.ZERO) GO TO 30 +* GO ZERO-H-D-AND-DX1.. + GO TO 60 + 30 CONTINUE + DFLAG = ZERO + DD1 = DD1/DU + DD2 = DD2/DU + DX1 = DX1*DU +* GO SCALE-CHECK.. + GO TO 100 + 40 CONTINUE + IF (.NOT.DQ2.LT.ZERO) GO TO 50 +* GO ZERO-H-D-AND-DX1.. + GO TO 60 + 50 CONTINUE + DFLAG = ONE + DH11 = DP1/DP2 + DH22 = DX1/DY1 + DU = ONE + DH11*DH22 + DTEMP = DD2/DU + DD2 = DD1/DU + DD1 = DTEMP + DX1 = DY1*DU +* GO SCALE-CHECK + GO TO 100 +* PROCEDURE..ZERO-H-D-AND-DX1.. + 60 CONTINUE + DFLAG = -ONE + DH11 = ZERO + DH12 = ZERO + DH21 = ZERO + DH22 = ZERO +* + DD1 = ZERO + DD2 = ZERO + DX1 = ZERO +* RETURN.. + GO TO 220 +* PROCEDURE..FIX-H.. + 70 CONTINUE + IF (.NOT.DFLAG.GE.ZERO) GO TO 90 +* + IF (.NOT.DFLAG.EQ.ZERO) GO TO 80 + DH11 = ONE + DH22 = ONE + DFLAG = -ONE + GO TO 90 + 80 CONTINUE + DH21 = -ONE + DH12 = ONE + DFLAG = -ONE + 90 CONTINUE + GO TO IGO(120,150,180,210) +* PROCEDURE..SCALE-CHECK + 100 CONTINUE + 110 CONTINUE + IF (.NOT.DD1.LE.RGAMSQ) GO TO 130 + IF (DD1.EQ.ZERO) GO TO 160 + ASSIGN 120 TO IGO +* FIX-H.. + GO TO 70 + 120 CONTINUE + DD1 = DD1*GAM**2 + DX1 = DX1/GAM + DH11 = DH11/GAM + DH12 = DH12/GAM + GO TO 110 + 130 CONTINUE + 140 CONTINUE + IF (.NOT.DD1.GE.GAMSQ) GO TO 160 + ASSIGN 150 TO IGO +* FIX-H.. + GO TO 70 + 150 CONTINUE + DD1 = DD1/GAM**2 + DX1 = DX1*GAM + DH11 = DH11*GAM + DH12 = DH12*GAM + GO TO 140 + 160 CONTINUE + 170 CONTINUE + IF (.NOT.DABS(DD2).LE.RGAMSQ) GO TO 190 + IF (DD2.EQ.ZERO) GO TO 220 + ASSIGN 180 TO IGO +* FIX-H.. + GO TO 70 + 180 CONTINUE + DD2 = DD2*GAM**2 + DH21 = DH21/GAM + DH22 = DH22/GAM + GO TO 170 + 190 CONTINUE + 200 CONTINUE + IF (.NOT.DABS(DD2).GE.GAMSQ) GO TO 220 + ASSIGN 210 TO IGO +* FIX-H.. + GO TO 70 + 210 CONTINUE + DD2 = DD2/GAM**2 + DH21 = DH21*GAM + DH22 = DH22*GAM + GO TO 200 + 220 CONTINUE + IF (DFLAG) 250,230,240 + 230 CONTINUE + DPARAM(3) = DH21 + DPARAM(4) = DH12 + GO TO 260 + 240 CONTINUE + DPARAM(2) = DH11 + DPARAM(5) = DH22 + GO TO 260 + 250 CONTINUE + DPARAM(2) = DH11 + DPARAM(3) = DH21 + DPARAM(4) = DH12 + DPARAM(5) = DH22 + 260 CONTINUE + DPARAM(1) = DFLAG + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dscal.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dscal.f new file mode 100644 index 0000000000..0b423cf253 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dscal.f @@ -0,0 +1,57 @@ + SUBROUTINE DSCAL(N,DA,DX,INCX) +* .. Scalar Arguments .. + DOUBLE PRECISION DA + INTEGER INCX,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*) +* .. +* +* Purpose +* ======= +** +* scales a vector by a constant. +* uses unrolled loops for increment equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,M,MP1,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + DX(I) = DA*DX(I) + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,5) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DX(I) = DA*DX(I) + 30 CONTINUE + IF (N.LT.5) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,5 + DX(I) = DA*DX(I) + DX(I+1) = DA*DX(I+1) + DX(I+2) = DA*DX(I+2) + DX(I+3) = DA*DX(I+3) + DX(I+4) = DA*DX(I+4) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dsdot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dsdot.f new file mode 100644 index 0000000000..4845123ba0 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dsdot.f @@ -0,0 +1,96 @@ + DOUBLE PRECISION FUNCTION DSDOT(N,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* AUTHORS +* ======= +* Lawson, C. L., (JPL), Hanson, R. J., (SNLA), +* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) +* +* Purpose +* ======= +* Compute the inner product of two vectors with extended +* precision accumulation and result. +* +* Returns D.P. dot product accumulated in D.P., for S.P. SX and SY +* DSDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY), +* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is +* defined in a similar way using INCY. +* +* Arguments +* ========= +* +* N (input) INTEGER +* number of elements in input vector(s) +* +* SX (input) REAL array, dimension(N) +* single precision vector with N elements +* +* INCX (input) INTEGER +* storage spacing between elements of SX +* +* SY (input) REAL array, dimension(N) +* single precision vector with N elements +* +* INCY (input) INTEGER +* storage spacing between elements of SY +* +* DSDOT (output) DOUBLE PRECISION +* DSDOT double precision dot product (zero if N.LE.0) +* +* REFERENCES +* ========== +* +* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. +* Krogh, Basic linear algebra subprograms for Fortran +* usage, Algorithm No. 539, Transactions on Mathematical +* Software 5, 3 (September 1979), pp. 308-323. +* +* REVISION HISTORY (YYMMDD) +* ========================== +* +* 791001 DATE WRITTEN +* 890831 Modified array declarations. (WRB) +* 890831 REVISION DATE from Version 3.2 +* 891214 Prologue converted to Version 4.0 format. (BAB) +* 920310 Corrected definition of LX in DESCRIPTION. (WRB) +* 920501 Reformatted the REFERENCES section. (WRB) +* 070118 Reformat to LAPACK style (JL) +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,KX,KY,NS +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE +* .. + DSDOT = 0.0D0 + IF (N.LE.0) RETURN + IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 20 +* +* Code for unequal or nonpositive increments. +* + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY + DO 10 I = 1,N + DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) + KX = KX + INCX + KY = KY + INCY + 10 CONTINUE + RETURN +* +* Code for equal, positive, non-unit increments. +* + 20 NS = N*INCX + DO 30 I = 1,NS,INCX + DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/dswap.f b/components/cism/glimmer-cism/libglimmer-solve/blas/dswap.f new file mode 100644 index 0000000000..79c123b6dd --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/dswap.f @@ -0,0 +1,70 @@ + SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* Purpose +* ======= +* +* interchanges two vectors. +* uses unrolled loops for increments equal one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + DOUBLE PRECISION DTEMP + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + DTEMP = DX(IX) + DX(IX) = DY(IY) + DY(IY) = DTEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,3) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DTEMP = DX(I) + DX(I) = DY(I) + DY(I) = DTEMP + 30 CONTINUE + IF (N.LT.3) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,3 + DTEMP = DX(I) + DX(I) = DY(I) + DY(I) = DTEMP + DTEMP = DX(I+1) + DX(I+1) = DY(I+1) + DY(I+1) = DTEMP + DTEMP = DX(I+2) + DX(I+2) = DY(I+2) + DY(I+2) = DTEMP + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/icamax.f b/components/cism/glimmer-cism/libglimmer-solve/blas/icamax.f new file mode 100644 index 0000000000..9a6afc1753 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/icamax.f @@ -0,0 +1,54 @@ + INTEGER FUNCTION ICAMAX(N,CX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX CX(*) +* .. +* +* Purpose +* ======= +* +* finds the index of element having max. absolute value. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + REAL SMAX + INTEGER I,IX +* .. +* .. External Functions .. + REAL SCABS1 + EXTERNAL SCABS1 +* .. + ICAMAX = 0 + IF (N.LT.1 .OR. INCX.LE.0) RETURN + ICAMAX = 1 + IF (N.EQ.1) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + IX = 1 + SMAX = SCABS1(CX(1)) + IX = IX + INCX + DO 10 I = 2,N + IF (SCABS1(CX(IX)).LE.SMAX) GO TO 5 + ICAMAX = I + SMAX = SCABS1(CX(IX)) + 5 IX = IX + INCX + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* + 20 SMAX = SCABS1(CX(1)) + DO 30 I = 2,N + IF (SCABS1(CX(I)).LE.SMAX) GO TO 30 + ICAMAX = I + SMAX = SCABS1(CX(I)) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/idamax.f b/components/cism/glimmer-cism/libglimmer-solve/blas/idamax.f new file mode 100644 index 0000000000..44729fe48e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/idamax.f @@ -0,0 +1,53 @@ + INTEGER FUNCTION IDAMAX(N,DX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*) +* .. +* +* Purpose +* ======= +* +* finds the index of element having max. absolute value. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + DOUBLE PRECISION DMAX + INTEGER I,IX +* .. +* .. Intrinsic Functions .. + INTRINSIC DABS +* .. + IDAMAX = 0 + IF (N.LT.1 .OR. INCX.LE.0) RETURN + IDAMAX = 1 + IF (N.EQ.1) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + IX = 1 + DMAX = DABS(DX(1)) + IX = IX + INCX + DO 10 I = 2,N + IF (DABS(DX(IX)).LE.DMAX) GO TO 5 + IDAMAX = I + DMAX = DABS(DX(IX)) + 5 IX = IX + INCX + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* + 20 DMAX = DABS(DX(1)) + DO 30 I = 2,N + IF (DABS(DX(I)).LE.DMAX) GO TO 30 + IDAMAX = I + DMAX = DABS(DX(I)) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/isamax.f b/components/cism/glimmer-cism/libglimmer-solve/blas/isamax.f new file mode 100644 index 0000000000..f6fd31210d --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/isamax.f @@ -0,0 +1,53 @@ + INTEGER FUNCTION ISAMAX(N,SX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + REAL SX(*) +* .. +* +* Purpose +* ======= +* +* finds the index of element having max. absolute value. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + REAL SMAX + INTEGER I,IX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS +* .. + ISAMAX = 0 + IF (N.LT.1 .OR. INCX.LE.0) RETURN + ISAMAX = 1 + IF (N.EQ.1) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + IX = 1 + SMAX = ABS(SX(1)) + IX = IX + INCX + DO 10 I = 2,N + IF (ABS(SX(IX)).LE.SMAX) GO TO 5 + ISAMAX = I + SMAX = ABS(SX(IX)) + 5 IX = IX + INCX + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* + 20 SMAX = ABS(SX(1)) + DO 30 I = 2,N + IF (ABS(SX(I)).LE.SMAX) GO TO 30 + ISAMAX = I + SMAX = ABS(SX(I)) + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/sasum.f b/components/cism/glimmer-cism/libglimmer-solve/blas/sasum.f new file mode 100644 index 0000000000..0677ba47aa --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/sasum.f @@ -0,0 +1,59 @@ + REAL FUNCTION SASUM(N,SX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + REAL SX(*) +* .. +* +* Purpose +* ======= +* +* takes the sum of the absolute values. +* uses unrolled loops for increment equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* + +* .. Local Scalars .. + REAL STEMP + INTEGER I,M,MP1,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,MOD +* .. + SASUM = 0.0e0 + STEMP = 0.0e0 + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + STEMP = STEMP + ABS(SX(I)) + 10 CONTINUE + SASUM = STEMP + RETURN +* +* code for increment equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,6) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + STEMP = STEMP + ABS(SX(I)) + 30 CONTINUE + IF (N.LT.6) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,6 + STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) + ABS(SX(I+2)) + + + ABS(SX(I+3)) + ABS(SX(I+4)) + ABS(SX(I+5)) + 50 CONTINUE + 60 SASUM = STEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/saxpy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/saxpy.f new file mode 100644 index 0000000000..6241a71d1b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/saxpy.f @@ -0,0 +1,62 @@ + SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + REAL SA + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* Purpose +* ======= +* +* SAXPY constant times a vector plus a vector. +* uses unrolled loop for increments equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (SA.EQ.0.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + SY(IY) = SY(IY) + SA*SX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,4) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + SY(I) = SY(I) + SA*SX(I) + 30 CONTINUE + IF (N.LT.4) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,4 + SY(I) = SY(I) + SA*SX(I) + SY(I+1) = SY(I+1) + SA*SX(I+1) + SY(I+2) = SY(I+2) + SA*SX(I+2) + SY(I+3) = SY(I+3) + SA*SX(I+3) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/scasum.f b/components/cism/glimmer-cism/libglimmer-solve/blas/scasum.f new file mode 100644 index 0000000000..5a4abfa97d --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/scasum.f @@ -0,0 +1,47 @@ + REAL FUNCTION SCASUM(N,CX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX CX(*) +* .. +* +* Purpose +* ======= +* +* takes the sum of the absolute values of a complex vector and +* returns a single precision result. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + REAL STEMP + INTEGER I,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,AIMAG,REAL +* .. + SCASUM = 0.0e0 + STEMP = 0.0e0 + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + 10 CONTINUE + SCASUM = STEMP + RETURN +* +* code for increment equal to 1 +* + 20 DO 30 I = 1,N + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + 30 CONTINUE + SCASUM = STEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/scnrm2.f b/components/cism/glimmer-cism/libglimmer-solve/blas/scnrm2.f new file mode 100644 index 0000000000..160e2c4151 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/scnrm2.f @@ -0,0 +1,72 @@ + REAL FUNCTION SCNRM2(N,X,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX X(*) +* .. +* +* Purpose +* ======= +* +* SCNRM2 returns the euclidean norm of a vector via the function +* name, so that +* +* SCNRM2 := sqrt( conjg( x' )*x ) +* +* +* +* -- This version written on 25-October-1982. +* Modified on 14-October-1993 to inline the call to CLASSQ. +* Sven Hammarling, Nag Ltd. +* +* +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) +* .. +* .. Local Scalars .. + REAL NORM,SCALE,SSQ,TEMP + INTEGER IX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,AIMAG,REAL,SQRT +* .. + IF (N.LT.1 .OR. INCX.LT.1) THEN + NORM = ZERO + ELSE + SCALE = ZERO + SSQ = ONE +* The following loop is equivalent to this call to the LAPACK +* auxiliary routine: +* CALL CLASSQ( N, X, INCX, SCALE, SSQ ) +* + DO 10 IX = 1,1 + (N-1)*INCX,INCX + IF (REAL(X(IX)).NE.ZERO) THEN + TEMP = ABS(REAL(X(IX))) + IF (SCALE.LT.TEMP) THEN + SSQ = ONE + SSQ* (SCALE/TEMP)**2 + SCALE = TEMP + ELSE + SSQ = SSQ + (TEMP/SCALE)**2 + END IF + END IF + IF (AIMAG(X(IX)).NE.ZERO) THEN + TEMP = ABS(AIMAG(X(IX))) + IF (SCALE.LT.TEMP) THEN + SSQ = ONE + SSQ* (SCALE/TEMP)**2 + SCALE = TEMP + ELSE + SSQ = SSQ + (TEMP/SCALE)**2 + END IF + END IF + 10 CONTINUE + NORM = SCALE*SQRT(SSQ) + END IF +* + SCNRM2 = NORM + RETURN +* +* End of SCNRM2. +* + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/scopy.f b/components/cism/glimmer-cism/libglimmer-solve/blas/scopy.f new file mode 100644 index 0000000000..ad04ee697e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/scopy.f @@ -0,0 +1,63 @@ + SUBROUTINE SCOPY(N,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* Purpose +* ======= +* +* copies a vector, x, to a vector, y. +* uses unrolled loops for increments equal to 1. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + SY(IY) = SX(IX) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,7) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + SY(I) = SX(I) + 30 CONTINUE + IF (N.LT.7) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,7 + SY(I) = SX(I) + SY(I+1) = SX(I+1) + SY(I+2) = SX(I+2) + SY(I+3) = SX(I+3) + SY(I+4) = SX(I+4) + SY(I+5) = SX(I+5) + SY(I+6) = SX(I+6) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/sdot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/sdot.f new file mode 100644 index 0000000000..deebc348bc --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/sdot.f @@ -0,0 +1,64 @@ + REAL FUNCTION SDOT(N,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* Purpose +* ======= +* +* forms the dot product of two vectors. +* uses unrolled loops for increments equal to one. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* + +* .. Local Scalars .. + REAL STEMP + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + STEMP = 0.0e0 + SDOT = 0.0e0 + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + STEMP = STEMP + SX(IX)*SY(IY) + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + SDOT = STEMP + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,5) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + STEMP = STEMP + SX(I)*SY(I) + 30 CONTINUE + IF (N.LT.5) GO TO 60 + 40 MP1 = M + 1 + DO 50 I = MP1,N,5 + STEMP = STEMP + SX(I)*SY(I) + SX(I+1)*SY(I+1) + + + SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4) + 50 CONTINUE + 60 SDOT = STEMP + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/sdsdot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/sdsdot.f new file mode 100644 index 0000000000..f6349a1426 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/sdsdot.f @@ -0,0 +1,105 @@ + REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + REAL SB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* PURPOSE +* ======= +* +* Compute the inner product of two vectors with extended +* precision accumulation. +* +* Returns S.P. result with dot product accumulated in D.P. +* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), +* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is +* defined in a similar way using INCY. +* +* AUTHOR +* ====== +* Lawson, C. L., (JPL), Hanson, R. J., (SNLA), +* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) +* +* ARGUMENTS +* ========= +* +* N (input) INTEGER +* number of elements in input vector(s) +* +* SB (input) REAL +* single precision scalar to be added to inner product +* +* SX (input) REAL array, dimension (N) +* single precision vector with N elements +* +* INCX (input) INTEGER +* storage spacing between elements of SX +* +* SY (input) REAL array, dimension (N) +* single precision vector with N elements +* +* INCY (input) INTEGER +* storage spacing between elements of SY +* +* SDSDOT (output) REAL +* single precision dot product (SB if N .LE. 0) +* +* REFERENCES +* ========== +* +* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. +* Krogh, Basic linear algebra subprograms for Fortran +* usage, Algorithm No. 539, Transactions on Mathematical +* Software 5, 3 (September 1979), pp. 308-323. +* +* REVISION HISTORY (YYMMDD) +* ========================== +* +* 791001 DATE WRITTEN +* 890531 Changed all specific intrinsics to generic. (WRB) +* 890831 Modified array declarations. (WRB) +* 890831 REVISION DATE from Version 3.2 +* 891214 Prologue converted to Version 4.0 format. (BAB) +* 920310 Corrected definition of LX in DESCRIPTION. (WRB) +* 920501 Reformatted the REFERENCES section. (WRB) +* 070118 Reformat to LAPACK coding style +* +* ===================================================================== +* +* .. Local Scalars .. + DOUBLE PRECISION DSDOT + INTEGER I,KX,KY,NS +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE +* .. + DSDOT = SB + IF (N.LE.0) GO TO 30 + IF (INCX.EQ.INCY .AND. INCX.GT.0) GO TO 40 +* +* Code for unequal or nonpositive increments. +* + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY + DO 10 I = 1,N + DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) + KX = KX + INCX + KY = KY + INCY + 10 CONTINUE + 30 SDSDOT = DSDOT + RETURN +* +* Code for equal and positive increments. +* + 40 NS = N*INCX + DO 50 I = 1,NS,INCX + DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) + 50 CONTINUE + SDSDOT = DSDOT + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/snrm2.f b/components/cism/glimmer-cism/libglimmer-solve/blas/snrm2.f new file mode 100644 index 0000000000..fa54ba1022 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/snrm2.f @@ -0,0 +1,66 @@ + REAL FUNCTION SNRM2(N,X,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + REAL X(*) +* .. +* +* Purpose +* ======= +* +* SNRM2 returns the euclidean norm of a vector via the function +* name, so that +* +* SNRM2 := sqrt( x'*x ). +* +* Further Details +* =============== +* +* -- This version written on 25-October-1982. +* Modified on 14-October-1993 to inline the call to SLASSQ. +* Sven Hammarling, Nag Ltd. +* +* +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) +* .. +* .. Local Scalars .. + REAL ABSXI,NORM,SCALE,SSQ + INTEGER IX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,SQRT +* .. + IF (N.LT.1 .OR. INCX.LT.1) THEN + NORM = ZERO + ELSE IF (N.EQ.1) THEN + NORM = ABS(X(1)) + ELSE + SCALE = ZERO + SSQ = ONE +* The following loop is equivalent to this call to the LAPACK +* auxiliary routine: +* CALL SLASSQ( N, X, INCX, SCALE, SSQ ) +* + DO 10 IX = 1,1 + (N-1)*INCX,INCX + IF (X(IX).NE.ZERO) THEN + ABSXI = ABS(X(IX)) + IF (SCALE.LT.ABSXI) THEN + SSQ = ONE + SSQ* (SCALE/ABSXI)**2 + SCALE = ABSXI + ELSE + SSQ = SSQ + (ABSXI/SCALE)**2 + END IF + END IF + 10 CONTINUE + NORM = SCALE*SQRT(SSQ) + END IF +* + SNRM2 = NORM + RETURN +* +* End of SNRM2. +* + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/srot.f b/components/cism/glimmer-cism/libglimmer-solve/blas/srot.f new file mode 100644 index 0000000000..e9f1cf711e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/srot.f @@ -0,0 +1,54 @@ + SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S) +* .. Scalar Arguments .. + REAL C,S + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* Purpose +* ======= +* +* applies a plane rotation. +* +* Further Details +* =============== +* +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* + +* .. Local Scalars .. + REAL STEMP + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + STEMP = C*SX(IX) + S*SY(IY) + SY(IY) = C*SY(IY) - S*SX(IX) + SX(IX) = STEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* + 20 DO 30 I = 1,N + STEMP = C*SX(I) + S*SY(I) + SY(I) = C*SY(I) - S*SX(I) + SX(I) = STEMP + 30 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/srotg.f b/components/cism/glimmer-cism/libglimmer-solve/blas/srotg.f new file mode 100644 index 0000000000..2625bd589c --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/srotg.f @@ -0,0 +1,38 @@ + SUBROUTINE SROTG(SA,SB,C,S) +* .. Scalar Arguments .. + REAL C,S,SA,SB +* .. +* +* Purpose +* ======= +* +* construct givens plane rotation. +* jack dongarra, linpack, 3/11/78. +* +* +* .. Local Scalars .. + REAL R,ROE,SCALE,Z +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,SIGN,SQRT +* .. + ROE = SB + IF (ABS(SA).GT.ABS(SB)) ROE = SA + SCALE = ABS(SA) + ABS(SB) + IF (SCALE.NE.0.0) GO TO 10 + C = 1.0 + S = 0.0 + R = 0.0 + Z = 0.0 + GO TO 20 + 10 R = SCALE*SQRT((SA/SCALE)**2+ (SB/SCALE)**2) + R = SIGN(1.0,ROE)*R + C = SA/R + S = SB/R + Z = 1.0 + IF (ABS(SA).GT.ABS(SB)) Z = S + IF (ABS(SB).GE.ABS(SA) .AND. C.NE.0.0) Z = 1.0/C + 20 SA = R + SB = Z + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/srotm.f b/components/cism/glimmer-cism/libglimmer-solve/blas/srotm.f new file mode 100644 index 0000000000..3523f99f76 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/srotm.f @@ -0,0 +1,148 @@ + SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SPARAM(5),SX(1),SY(1) +* .. +* +* Purpose +* ======= +* +* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX +* +* (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN +* (DX**T) +* +* SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE +* LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. +* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +* +* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 +* +* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) +* H=( ) ( ) ( ) ( ) +* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). +* SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. +* +* +* Arguments +* ========= +* +* N (input) INTEGER +* number of elements in input vector(s) +* +* SX (input/output) REAL array, dimension N +* double precision vector with 5 elements +* +* INCX (input) INTEGER +* storage spacing between elements of SX +* +* SY (input/output) REAL array, dimension N +* double precision vector with N elements +* +* INCY (input) INTEGER +* storage spacing between elements of SY +* +* SPARAM (input/output) REAL array, dimension 5 +* SPARAM(1)=SFLAG +* SPARAM(2)=SH11 +* SPARAM(3)=SH21 +* SPARAM(4)=SH12 +* SPARAM(5)=SH22 +* +* ===================================================================== +* +* .. Local Scalars .. + REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO + INTEGER I,KX,KY,NSTEPS +* .. +* .. Data statements .. + DATA ZERO,TWO/0.E0,2.E0/ +* .. +* + SFLAG = SPARAM(1) + IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) GO TO 140 + IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 +* + NSTEPS = N*INCX + IF (SFLAG) 50,10,30 + 10 CONTINUE + SH12 = SPARAM(4) + SH21 = SPARAM(3) + DO 20 I = 1,NSTEPS,INCX + W = SX(I) + Z = SY(I) + SX(I) = W + Z*SH12 + SY(I) = W*SH21 + Z + 20 CONTINUE + GO TO 140 + 30 CONTINUE + SH11 = SPARAM(2) + SH22 = SPARAM(5) + DO 40 I = 1,NSTEPS,INCX + W = SX(I) + Z = SY(I) + SX(I) = W*SH11 + Z + SY(I) = -W + SH22*Z + 40 CONTINUE + GO TO 140 + 50 CONTINUE + SH11 = SPARAM(2) + SH12 = SPARAM(4) + SH21 = SPARAM(3) + SH22 = SPARAM(5) + DO 60 I = 1,NSTEPS,INCX + W = SX(I) + Z = SY(I) + SX(I) = W*SH11 + Z*SH12 + SY(I) = W*SH21 + Z*SH22 + 60 CONTINUE + GO TO 140 + 70 CONTINUE + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY +* + IF (SFLAG) 120,80,100 + 80 CONTINUE + SH12 = SPARAM(4) + SH21 = SPARAM(3) + DO 90 I = 1,N + W = SX(KX) + Z = SY(KY) + SX(KX) = W + Z*SH12 + SY(KY) = W*SH21 + Z + KX = KX + INCX + KY = KY + INCY + 90 CONTINUE + GO TO 140 + 100 CONTINUE + SH11 = SPARAM(2) + SH22 = SPARAM(5) + DO 110 I = 1,N + W = SX(KX) + Z = SY(KY) + SX(KX) = W*SH11 + Z + SY(KY) = -W + SH22*Z + KX = KX + INCX + KY = KY + INCY + 110 CONTINUE + GO TO 140 + 120 CONTINUE + SH11 = SPARAM(2) + SH12 = SPARAM(4) + SH21 = SPARAM(3) + SH22 = SPARAM(5) + DO 130 I = 1,N + W = SX(KX) + Z = SY(KY) + SX(KX) = W*SH11 + Z*SH12 + SY(KY) = W*SH21 + Z*SH22 + KX = KX + INCX + KY = KY + INCY + 130 CONTINUE + 140 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/srotmg.f b/components/cism/glimmer-cism/libglimmer-solve/blas/srotmg.f new file mode 100644 index 0000000000..7b3bd42728 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/srotmg.f @@ -0,0 +1,208 @@ + SUBROUTINE SROTMG(SD1,SD2,SX1,SY1,SPARAM) +* .. Scalar Arguments .. + REAL SD1,SD2,SX1,SY1 +* .. +* .. Array Arguments .. + REAL SPARAM(5) +* .. +* +* Purpose +* ======= +* +* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS +* THE SECOND COMPONENT OF THE 2-VECTOR (SQRT(SD1)*SX1,SQRT(SD2)* +* SY2)**T. +* WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +* +* SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 +* +* (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) +* H=( ) ( ) ( ) ( ) +* (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). +* LOCATIONS 2-4 OF SPARAM CONTAIN SH11,SH21,SH12, AND SH22 +* RESPECTIVELY. (VALUES OF 1.E0, -1.E0, OR 0.E0 IMPLIED BY THE +* VALUE OF SPARAM(1) ARE NOT STORED IN SPARAM.) +* +* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE +* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE +* OF SD1 AND SD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. +* +* +* Arguments +* ========= +* +* +* SD1 (input/output) REAL +* +* SD2 (input/output) REAL +* +* SX1 (input/output) REAL +* +* SY1 (input) REAL +* +* +* SPARAM (input/output) REAL array, dimension 5 +* SPARAM(1)=SFLAG +* SPARAM(2)=SH11 +* SPARAM(3)=SH21 +* SPARAM(4)=SH12 +* SPARAM(5)=SH22 +* +* ===================================================================== +* +* .. Local Scalars .. + REAL GAM,GAMSQ,ONE,RGAMSQ,SFLAG,SH11,SH12,SH21,SH22,SP1,SP2,SQ1, + + SQ2,STEMP,SU,TWO,ZERO + INTEGER IGO +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS +* .. +* .. Data statements .. +* + DATA ZERO,ONE,TWO/0.E0,1.E0,2.E0/ + DATA GAM,GAMSQ,RGAMSQ/4096.E0,1.67772E7,5.96046E-8/ +* .. + + IF (.NOT.SD1.LT.ZERO) GO TO 10 +* GO ZERO-H-D-AND-SX1.. + GO TO 60 + 10 CONTINUE +* CASE-SD1-NONNEGATIVE + SP2 = SD2*SY1 + IF (.NOT.SP2.EQ.ZERO) GO TO 20 + SFLAG = -TWO + GO TO 260 +* REGULAR-CASE.. + 20 CONTINUE + SP1 = SD1*SX1 + SQ2 = SP2*SY1 + SQ1 = SP1*SX1 +* + IF (.NOT.ABS(SQ1).GT.ABS(SQ2)) GO TO 40 + SH21 = -SY1/SX1 + SH12 = SP2/SP1 +* + SU = ONE - SH12*SH21 +* + IF (.NOT.SU.LE.ZERO) GO TO 30 +* GO ZERO-H-D-AND-SX1.. + GO TO 60 + 30 CONTINUE + SFLAG = ZERO + SD1 = SD1/SU + SD2 = SD2/SU + SX1 = SX1*SU +* GO SCALE-CHECK.. + GO TO 100 + 40 CONTINUE + IF (.NOT.SQ2.LT.ZERO) GO TO 50 +* GO ZERO-H-D-AND-SX1.. + GO TO 60 + 50 CONTINUE + SFLAG = ONE + SH11 = SP1/SP2 + SH22 = SX1/SY1 + SU = ONE + SH11*SH22 + STEMP = SD2/SU + SD2 = SD1/SU + SD1 = STEMP + SX1 = SY1*SU +* GO SCALE-CHECK + GO TO 100 +* PROCEDURE..ZERO-H-D-AND-SX1.. + 60 CONTINUE + SFLAG = -ONE + SH11 = ZERO + SH12 = ZERO + SH21 = ZERO + SH22 = ZERO +* + SD1 = ZERO + SD2 = ZERO + SX1 = ZERO +* RETURN.. + GO TO 220 +* PROCEDURE..FIX-H.. + 70 CONTINUE + IF (.NOT.SFLAG.GE.ZERO) GO TO 90 +* + IF (.NOT.SFLAG.EQ.ZERO) GO TO 80 + SH11 = ONE + SH22 = ONE + SFLAG = -ONE + GO TO 90 + 80 CONTINUE + SH21 = -ONE + SH12 = ONE + SFLAG = -ONE + 90 CONTINUE + GO TO IGO(120,150,180,210) +* PROCEDURE..SCALE-CHECK + 100 CONTINUE + 110 CONTINUE + IF (.NOT.SD1.LE.RGAMSQ) GO TO 130 + IF (SD1.EQ.ZERO) GO TO 160 + ASSIGN 120 TO IGO +* FIX-H.. + GO TO 70 + 120 CONTINUE + SD1 = SD1*GAM**2 + SX1 = SX1/GAM + SH11 = SH11/GAM + SH12 = SH12/GAM + GO TO 110 + 130 CONTINUE + 140 CONTINUE + IF (.NOT.SD1.GE.GAMSQ) GO TO 160 + ASSIGN 150 TO IGO +* FIX-H.. + GO TO 70 + 150 CONTINUE + SD1 = SD1/GAM**2 + SX1 = SX1*GAM + SH11 = SH11*GAM + SH12 = SH12*GAM + GO TO 140 + 160 CONTINUE + 170 CONTINUE + IF (.NOT.ABS(SD2).LE.RGAMSQ) GO TO 190 + IF (SD2.EQ.ZERO) GO TO 220 + ASSIGN 180 TO IGO +* FIX-H.. + GO TO 70 + 180 CONTINUE + SD2 = SD2*GAM**2 + SH21 = SH21/GAM + SH22 = SH22/GAM + GO TO 170 + 190 CONTINUE + 200 CONTINUE + IF (.NOT.ABS(SD2).GE.GAMSQ) GO TO 220 + ASSIGN 210 TO IGO +* FIX-H.. + GO TO 70 + 210 CONTINUE + SD2 = SD2/GAM**2 + SH21 = SH21*GAM + SH22 = SH22*GAM + GO TO 200 + 220 CONTINUE + IF (SFLAG) 250,230,240 + 230 CONTINUE + SPARAM(3) = SH21 + SPARAM(4) = SH12 + GO TO 260 + 240 CONTINUE + SPARAM(2) = SH11 + SPARAM(5) = SH22 + GO TO 260 + 250 CONTINUE + SPARAM(2) = SH11 + SPARAM(3) = SH21 + SPARAM(4) = SH12 + SPARAM(5) = SH22 + 260 CONTINUE + SPARAM(1) = SFLAG + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/sscal.f b/components/cism/glimmer-cism/libglimmer-solve/blas/sscal.f new file mode 100644 index 0000000000..b900be9a36 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/sscal.f @@ -0,0 +1,57 @@ + SUBROUTINE SSCAL(N,SA,SX,INCX) +* .. Scalar Arguments .. + REAL SA + INTEGER INCX,N +* .. +* .. Array Arguments .. + REAL SX(*) +* .. +* +* Purpose +* ======= +* +* scales a vector by a constant. +* uses unrolled loops for increment equal to 1. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + INTEGER I,M,MP1,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + SX(I) = SA*SX(I) + 10 CONTINUE + RETURN +* +* code for increment equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,5) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + SX(I) = SA*SX(I) + 30 CONTINUE + IF (N.LT.5) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,5 + SX(I) = SA*SX(I) + SX(I+1) = SA*SX(I+1) + SX(I+2) = SA*SX(I+2) + SX(I+3) = SA*SX(I+3) + SX(I+4) = SA*SX(I+4) + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/blas/sswap.f b/components/cism/glimmer-cism/libglimmer-solve/blas/sswap.f new file mode 100644 index 0000000000..e23f380357 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/blas/sswap.f @@ -0,0 +1,70 @@ + SUBROUTINE SSWAP(N,SX,INCX,SY,INCY) +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* Purpose +* ======= +* +* interchanges two vectors. +* uses unrolled loops for increments equal to 1. +* jack dongarra, linpack, 3/11/78. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + REAL STEMP + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 +* +* code for unequal increments or equal increments not equal +* to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO 10 I = 1,N + STEMP = SX(IX) + SX(IX) = SY(IY) + SY(IY) = STEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + 20 M = MOD(N,3) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + STEMP = SX(I) + SX(I) = SY(I) + SY(I) = STEMP + 30 CONTINUE + IF (N.LT.3) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,3 + STEMP = SX(I) + SX(I) = SY(I) + SY(I) = STEMP + STEMP = SX(I+1) + SX(I+1) = SY(I+1) + SY(I+1) = STEMP + STEMP = SX(I+2) + SX(I+2) = SY(I+2) + SY(I+2) = STEMP + 50 CONTINUE + RETURN + END diff --git a/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse.F90 b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse.F90 new file mode 100644 index 0000000000..0cd58b000f --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse.F90 @@ -0,0 +1,470 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_sparse.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glimmer_sparse + + ! This module used to be a wrapper for the umfpack and pardiso solvers. + ! These have been removed, and now it is just a wrapper for the slap solver. + + use glimmer_global, only: dp + use glimmer_sparse_type + use glimmer_sparse_slap + use glide_types + + implicit none + + type sparse_solver_options + type(sparse_solver_options_base) :: base + type(slap_solver_options) :: slap + end type + + type sparse_solver_workspace + type(slap_solver_workspace), pointer :: slap => null() + end type + + + ! These module level parameters are assigned from similar parameters defined in glide_types.F90 + integer, parameter :: SPARSE_HO_NONLIN_PICARD = HO_NONLIN_PICARD + integer, parameter :: SPARSE_HO_NONLIN_JFNK = HO_NONLIN_JFNK + + ! The first three options use the SLAP solver and work only on one processor. + integer, parameter :: SPARSE_SOLVER_PCG_INCH = HO_SPARSE_PCG_INCH ! SLAP PCG with incomplete Cholesky preconditioner + integer, parameter :: SPARSE_SOLVER_BICG = HO_SPARSE_BICG ! SLAP biconjugate gradient + integer, parameter :: SPARSE_SOLVER_GMRES = HO_SPARSE_GMRES ! SLAP GMRES + integer, parameter :: STANDALONE_PCG_STANDARD = HO_SPARSE_PCG_STANDARD ! Native PCG, parallel-enabled, standard solver + integer, parameter :: STANDALONE_PCG_CHRONGEAR = HO_SPARSE_PCG_CHRONGEAR ! Native PCG, parallel-enabled, Chronopoulos-Gear solver + integer, parameter :: STANDALONE_TRILINOS_SOLVER = HO_SPARSE_TRILINOS ! Trilinos solver + + + +contains + + + + subroutine sparse_solver_default_options(method, opt, nonlinear) + + use parallel + integer, intent(in) :: method ! sparse solver: BiCG, GMRES, PCG, etc. + integer, optional, intent(in) :: nonlinear ! Picard vs. JFNK flag + type(sparse_solver_options) :: opt !TODO - intent inout or out? + + opt%base%method = method + opt%base%tolerance = 1.0d-08 !WHL - used to be 1e-11 + opt%base%maxiters = 200 + + if ( present(nonlinear) )then + if (nonlinear .eq. SPARSE_HO_NONLIN_PICARD) opt%base%tolerance = 1.0d-08 ! Picard + if (nonlinear .eq. SPARSE_HO_NONLIN_JFNK) opt%base%tolerance = 1.0d-03 ! JFNK + else ! Picard + opt%base%tolerance = 1.0d-08 + end if + + !TODO - Remove calls to not_parallel? + ! These seem unnecessary when running SLAP solver. Commented out for now. + + !TODO - Remove calls to slap_default_options; set appropriate options here instead. + + !Solver specific options + + if (method == SPARSE_SOLVER_BICG) then +! call not_parallel(__FILE__,__LINE__) + call slap_default_options(opt%slap, opt%base) + opt%base%method = SPARSE_SOLVER_BICG +! opt%slap%itol = 2 ! current default = 2 in slap_default_options + + else if (method == SPARSE_SOLVER_GMRES) then +! call not_parallel(__FILE__,__LINE__) + call slap_default_options(opt%slap, opt%base) + opt%base%method = SPARSE_SOLVER_GMRES +! opt%slap%itol = 2 ! current default = 2 in slap_default_options + + else if (method == SPARSE_SOLVER_PCG_INCH) then +! call not_parallel(__FILE__, __LINE__) + call slap_default_options(opt%slap, opt%base) + opt%base%method = SPARSE_SOLVER_PCG_INCH + opt%slap%itol = 1 + !WHL - itol = 2 does not work for simple test problems + + else + !call glide_finalise_all(.true.) + call write_log("Invalid sparse matrix option", GM_FATAL) + + end if + + end subroutine sparse_solver_default_options + + subroutine sparse_allocate_workspace(matrix, options, workspace, max_nonzeros_arg) + + use parallel + !> Allocate solver workspace. This needs to be done once + !> (when the maximum number of nonzero entries is first known) + !> This function need not be safe to call on already allocated memory + !> + !> Note that the max_nonzeros argument must be optional, and if + !> it is not supplied the current number of nonzeroes must be used. + type(sparse_matrix_type), intent(in) :: matrix + type(sparse_solver_options) :: options + type(sparse_solver_workspace) :: workspace + integer, optional :: max_nonzeros_arg + integer :: max_nonzeros + + if (present(max_nonzeros_arg)) then + max_nonzeros = max_nonzeros_arg + else + max_nonzeros = matrix%nonzeros + end if + + !TODO - Anything needed for standalone_pcg_solver? + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then +! call not_parallel(__FILE__,__LINE__) + allocate(workspace%slap) + call slap_allocate_workspace(matrix, options%slap, workspace%slap, max_nonzeros) + end if + + end subroutine sparse_allocate_workspace + + subroutine sparse_solver_preprocess(matrix, options, workspace) + !> Performs any preprocessing needed to be performed on the slap + !> matrix. Workspace must have already been allocated. + !> This function should be safe to call more than once. + !> + !> It is an error to call this function on a workspace without + !> allocated memory + !> + !> In general slap_allocate_workspace should perform any actions + !> that depend on the *size* of the slap matrix, and + !> sprase_solver_preprocess should perform any actions that depend + !> upon the *contents* of the slap matrix. + type(sparse_matrix_type), intent(in) :: matrix + type(sparse_solver_options) :: options + type(sparse_solver_workspace) :: workspace + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then + + call slap_solver_preprocess(matrix, options%slap, workspace%slap) + + end if + + end subroutine sparse_solver_preprocess + + function sparse_solve(matrix, rhs, solution, & + options, workspace, & + err, niters, verbose) + + !> Solves the linear system, and reports status information. + !> This function returns an error code that should be zero if the + !> call succeeded and nonzero if it failed. No additional error codes + !> are defined. Although this function reports back the final error + !> and the number of iterations needed to converge, these should *not* + !> be relied upon as not every slap linear solver may report them. + + ! Note: The matrix needs to be intent(in), not (inout). + ! If the matrix is modified, then the residual will be computed incorrectly + ! in the higher-level subroutine that calls sparse_solve. + + type(sparse_matrix_type), intent(in) :: matrix + !> Sparse matrix to solve + + real(kind=dp), dimension(:), intent(in) :: rhs + !> Right hand side of the solution vector + + real(kind=dp), dimension(:), intent(inout) :: solution + !> Solution vector, containing an initial guess + + type(sparse_solver_options), intent(in) :: options + !> Options such as convergence criteria + + type(sparse_solver_workspace), intent(inout) :: workspace + !> Internal solver workspace + + real(kind=dp), intent(out) :: err + !> Final solution error + + integer, intent(out) :: niters + !> Number of iterations required to reach the solution + + logical, optional, intent(in) :: verbose + !> If present and true, this argument may cause diagnostic information + !> to be printed by the solver (not every solver may implement this). + + integer :: sparse_solve + + logical :: verbose_var + + verbose_var = .false. + if (present(verbose)) then + verbose_var = verbose + end if + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then + + sparse_solve = slap_solve(matrix, rhs, solution, & + options%slap, workspace%slap, & + err, niters, verbose_var) + + end if + + end function sparse_solve + + + subroutine sparse_solver_postprocess(matrix, options, workspace) + type(sparse_matrix_type), intent(in) :: matrix + type(sparse_solver_options) :: options + type(sparse_solver_workspace) :: workspace + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then + + call slap_solver_postprocess(matrix, options%slap, workspace%slap) + + end if + + end subroutine sparse_solver_postprocess + + subroutine sparse_destroy_workspace(matrix, options, workspace) + + !> Deallocates all working memory for the slap linear solver. + !> This need *not* be safe to call of an unallocated workspace + !> No slap solver should call this automatically. + + type(sparse_matrix_type), intent(in) :: matrix + type(sparse_solver_options) :: options + type(sparse_solver_workspace) :: workspace + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then + + call slap_destroy_workspace(matrix, options%slap, workspace%slap) + deallocate(workspace%slap) + + + end if + + end subroutine sparse_destroy_workspace + + subroutine sparse_interpret_error(options, error_code, error_string) + + !> takes an error code output from slap_solve and interprets it. + !> error_string must be an optional argument. + !> If it is not provided, the error is printed to standard out + !> instead of being put in the string + + type(sparse_solver_options) :: options + integer :: error_code + character(*), optional, intent(out) :: error_string + character(256) :: tmp_error_string + + if (options%base%method == SPARSE_SOLVER_BICG .or. & + options%base%method == SPARSE_SOLVER_GMRES .or. & + options%base%method == SPARSE_SOLVER_PCG_INCH) then + + call slap_interpret_error(error_code, tmp_error_string) + + endif + + if (present(error_string)) then + error_string = tmp_error_string + else + write(*,*) tmp_error_string + endif + + end subroutine sparse_interpret_error + + subroutine sparse_easy_solve(matrix, rhs, answer, err, iter, method_arg, & + calling_file, calling_line, nonlinear_solver ) + + !This subroutine wraps the basic (though probably the most inefficient) + !workflow to solve a sparse matrix using the sparse matrix solver + !framework. It handles errors gracefully, and reports back the + !iterations required and the error estimate in the case of an iterative + !solver. At the very least it is an encapsulated example of how to + !use the sparse solver routines, and is easy enough to drop in your + !code if you don't care about allocating and deallocating workspace + !every single timestep. + + type(sparse_matrix_type), intent(in) :: matrix + real(dp), dimension(:), intent(in) :: rhs + real(dp), dimension(:), intent(inout) :: answer + + real(dp), intent(out) :: err + integer, intent(out) :: iter + + integer, optional, intent(in) :: method_arg ! solver method: BiCG, GMRES, PCG, etc. + integer, optional, intent(in) :: nonlinear_solver ! Picard or JFNK + + character(*), optional :: calling_file + integer, optional :: calling_line + + type(sparse_solver_options) :: opt + type(sparse_solver_workspace) :: wk + + integer :: ierr + integer :: method + integer :: nonlinear + + if (present(method_arg)) then + method = method_arg + else + method = SPARSE_SOLVER_BICG + endif + + if (present(nonlinear_solver)) then + nonlinear = nonlinear_solver + else + nonlinear = SPARSE_HO_NONLIN_PICARD + endif + + if (verbose_slap) then + print*, ' ' + print*, 'In sparse_easy_solve' + print*, 'method (0=BiCG, 1=GMRES, 2=PCG_INCH) =', method + print*, 'nonlinear (0=Picard, 1=JFNK) =', nonlinear + print*, 'matrix%order =', matrix%order + print*, 'matrix%nonzeros =', matrix%nonzeros + print*, 'size(rhs) =', size(rhs) + print*, 'size(answer) =', size(answer) + print*, 'size(row) =', size(matrix%row) + print*, 'size(col) =', size(matrix%col) + print*, 'size(val) =', size(matrix%val) + endif + + call sparse_solver_default_options(method, opt, nonlinear) + + call sparse_allocate_workspace(matrix, opt, wk) + + call sparse_solver_preprocess(matrix, opt, wk) + + ierr = sparse_solve(matrix, rhs, answer, opt, wk, err, iter, .false.) + + if (verbose_slap) then + print*, ' ' + print*, 'Called sparse_solve: iter, err =', iter, err + endif + + call sparse_solver_postprocess(matrix, opt, wk) + + if (ierr /= 0) then + if (present(calling_file) .and. present(calling_line)) then + call handle_sparse_error(matrix, opt, ierr, calling_file, calling_line) + else + call handle_sparse_error(matrix, opt, ierr, __FILE__, __LINE__) + end if + end if + + call sparse_destroy_workspace(matrix, opt, wk) + + end subroutine sparse_easy_solve + + subroutine handle_sparse_error(matrix, solver_options, error, error_file, error_line, time) + + !Checks a sparse error flag and, if an error occurred, log it to + !the GLIMMER log file. This does not stop Glimmer, it just writes + !to the log + !use glide_stop + use glimmer_log + use glimmer_filenames + + integer :: error + integer, optional :: error_line + character(*), optional :: error_file + real(dp), optional :: time + + type(sparse_matrix_type), intent(in) :: matrix + type(sparse_solver_options) :: solver_options + integer :: isym + integer :: lunit + integer :: i + + character(512) :: message + character(128) :: errfname + character(256) :: errdesc + + !If no error happened, this routine should be a nop + if (error == 0 .OR. error == 2 .OR. error == 6) return + + !Aquire a file unit, and open the file + lunit = get_free_unit() + errfname = trim(process_path('sparse_dump.txt')) + open(lunit,file=errfname) + + if (matrix%symmetric) then + isym = 1 + else + isym = 0 + end if + + !Output sparse matrix data to the file + + call dcpplt(matrix%order, matrix%nonzeros, matrix%row, matrix%col, matrix%val,& + isym, lunit) + + write(lunit,*) '***Sparse matrix structure ends. Value listing begins' + do i=1,matrix%nonzeros + write(lunit,*) matrix%val(i) + end do + + !Close unit and finish off + close(lunit) + + !Grab the error message from the sparse solver + call sparse_interpret_error(solver_options, error, errdesc) + + !construct the error message and write it to the log file + if (present(time)) then + write(message, *)'Sparse matrix error at time: ', time, & + 'Error description: ', errdesc, & + 'Data dumped to ', trim(errfname) + else + write(message, *)'Sparse matrix error. Error description: ', errdesc, & + 'Data dumped to ', trim(errfname) + end if + + write(*,*)message + + !call glide_finalise_all(.true.) + + if (present(error_file) .and. present(error_line)) then + call write_log(trim(errdesc), GM_FATAL, error_file, error_line) + else + call write_log(trim(errdesc), GM_FATAL, __FILE__, __LINE__) + end if + + end subroutine handle_sparse_error + +end module glimmer_sparse diff --git a/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_slap.F90 b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_slap.F90 new file mode 100644 index 0000000000..230ee7148b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_slap.F90 @@ -0,0 +1,462 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_sparse_slap.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module glimmer_sparse_slap + !> This module builds on the glimmer_slap module to provide an easy + !> interface to SLAP. The SLAP interface is intended to be both + !> usable and a guide to implementing other interfaces + + use glimmer_sparse_type + use glimmer_global, only: dp, size_t + use glimmer_log + implicit none + + type slap_solver_workspace + !> This type contains any working memory needed for the slap solver. + !> It is used to store states between calls to the solver + !> In the SLAP implementation, it is used to store the SLAP workspace + !> This module must have this type, but its contents should be opaque + !> to the user (e.g. client code should only manipulate the + !> slap_solver_workspace as a whole and should never touch its members) + real(kind=dp), dimension(:), pointer :: rwork => NULL() + integer, dimension(:), pointer :: iwork => NULL() + integer :: max_nelt !> Maximum number of nonzeroes allowed given the allocated workspace + end type slap_solver_workspace + + type slap_solver_options + !> This type holds options that are passed to the slap solver, such + !> as preconditioner type, error tolerances, etc. At a minimum, it + !> must define the tolerance and maxiters field, as these will be + !> common to any iterative slap linear solver. Other options + !> can be defined as necessary. + !> + !> Design note: the options are separated from the workspace because + !> one set of options could apply to multiple matrices, and the + !> lifecycles for each could be different (a workspace need only + !> exist as long as the matrix does, the options could persist + !> throughout the entire program) + + integer :: itol !> Tolerance code, see SLAP documentation + integer :: gmres_saved_vectors !> How many vectors to save while performing GMRES iteration + type(sparse_solver_options_base), pointer :: base => null() !> Pointer to basic options + + end type slap_solver_options + + logical, parameter :: verbose_slap = .false. + +contains + +!TODO - It may be better to set the desired defaults for each method individually (GMRES, BiCG, PCG, etc.) + + subroutine slap_default_options(opt, base) + + !> Populates a slap_solver_options (defined above) with default + !> options. This is necessary because different solvers may define + !> different options beyond the required fields defined above. + !> Filling them in this function allows client code to pick "good" + !> values in a generic way. + + type(slap_solver_options), intent(out) :: opt + type(sparse_solver_options_base), intent(in), target :: base + + !TODO - This value of itol may not be optimal for all solver options. + ! The PCG solver fails for simple test matrices with itol=2, but does fine with itol=1. + opt%itol = 2 + opt%gmres_saved_vectors = 20 + opt%base => base + + end subroutine slap_default_options + + subroutine slap_allocate_workspace(matrix, options, workspace, max_nonzeros_arg) + !> Allocate solver workspace. This needs to be done once + !> (when the maximum number of nonzero entries is first known) + !> This function need not be safe to call on already allocated memory + !> + !> Note that the max_nonzeros argument must be optional, and if + !> it is not supplied the current number of nonzeroes must be used. + + type(sparse_matrix_type), intent(in) :: matrix + type(slap_solver_options) :: options + type(slap_solver_workspace) :: workspace + integer, optional :: max_nonzeros_arg + integer :: max_nonzeros + integer(kind=size_t) :: lenrw + integer(kind=size_t) :: leniw + + if (present(max_nonzeros_arg)) then + max_nonzeros = max_nonzeros_arg + else + max_nonzeros = matrix%nonzeros + end if + + !Only allocate the memory if it hasn't been allocated or it needs to grow + + if (.not. associated(workspace%rwork) .or. workspace%max_nelt < max_nonzeros) then + !If memory is already allocated get rid of it + if (associated(workspace%rwork)) then + deallocate(workspace%rwork) + deallocate(workspace%iwork) + end if + + !Figure out how much memory to allocate. These figures were derived + !from the SLAP documentation. + lenrw = 20*max_nonzeros + leniw = 20*max_nonzeros + + if (lenrw < 0 .or. leniw < 0) then + call write_log("The amount of workspace memory that SLAP needs caused a numerical overflow. " // & + "If you are not running on a 64-bit architecture, you will need to decrease" // & + "the size of your data set. If you are running a 64-bit architecture, try" // & + "modifying size_t in glimmer_global to a larger size and recompiling Glimmer.", GM_FATAL) + end if + + !write(*,*) "MAX NONZEROS",max_nonzeros + !write(*,*) "ALLOCATING WORKSPACE",lenrw,leniw + + allocate(workspace%rwork(lenrw)) + allocate(workspace%iwork(leniw)) + !Recored the number of nonzeros so we know whether to allocate more + !memory in the future + workspace%max_nelt = max_nonzeros + end if + end subroutine slap_allocate_workspace + + + subroutine slap_solver_preprocess(matrix, options, workspace) + + !> Performs any preprocessing needed for the slap solver. + !> Workspace must have already been allocated. + !> This function should be safe to call more than once. + !> + !> It is an error to call this function on a workspace without + !> allocated memory + !> + !> In general slap_allocate_workspace should perform any actions + !> that depend on the *size* of the slap matrix, and + !> sparse_solver_preprocess should perform any actions that depend + !> upon the *contents* of the slap matrix. + + type(sparse_matrix_type), intent(in) :: matrix + type(slap_solver_options) :: options + type(slap_solver_workspace) :: workspace + + ! Nothing to do here. Move along. + + end subroutine slap_solver_preprocess + + function slap_solve (matrix, rhs, solution, options, workspace,err,niters, verbose) + + use glide_types ! only for HO_SPARSE parameter values + + !> Solves the slap linear system, and reports status information. + !> This function returns an error code that should be zero if the + !> call succeeded and nonzero if it failed. No additional error codes + !> are defined. Although this function reports back the final error + !> and the number of iterations needed to converge, these should *not* + !> be relied upon as not every slap linear solver may report them. + + !Note: The matrix should be intent(in) rather than (inout). + ! This requires making a local copy of some data. + + type(sparse_matrix_type), intent(in) :: matrix + !> Sparse matrix to solve. + + real(kind=dp), dimension(:), intent(in) :: rhs + !> Right hand side of the solution vector + + real(kind=dp), dimension(:), intent(inout) :: solution + !> Solution vector, containing an initial guess. + + type(slap_solver_options), intent(in) :: options + !> Options such as convergence criteria + + type(slap_solver_workspace), intent(inout) :: workspace + !> Internal solver workspace + + real(kind=dp), intent(out) :: err + !> Final solution error + + integer, intent(out) :: niters + !> Number of iterations required to reach the solution + + logical, optional, intent(in) :: verbose + !> If present and true, this argument may cause diagnostic information + !> to be printed by the solver (not every solver may implement this). + + integer, dimension(matrix%nonzeros) :: & + matrix_row, &! local copy of matrix%row + matrix_col ! local copy of matrix%col + + real(kind=dp), dimension(matrix%nonzeros) :: & + matrix_val ! local copy of matrix%val + + integer :: slap_solve + + integer :: ierr !SLAP-provided error code + integer :: iunit !Unit number to print verbose output to (6=stdout, 0=no output) + integer :: isym !Whether matrix is symmetric + + logical :: allzeros + integer :: i + + !WHL - debug (for checking matrix symmetry) + integer :: n, m, j + logical, parameter :: & + check_symmetry = .false. ! if true, check matrix symmetry (takes a long time for big matrices) + logical :: sym_partner + real(dp) :: avg_val + + iunit = 0 + if (present(verbose)) then + if(verbose) then + iunit=6 + write(*,*) 'Tolerance=',options%base%tolerance + end if + end if + + if (matrix%symmetric) then + isym = 1 + else + isym = 0 + end if + + allzeros = .true. + + !Check if the RHS is zero; if it is, don't iterate! The biconjugate + !gradient method doesn't work in this case + zero_check: do i = 1, size(rhs) + if (rhs(i) /= 0) then + allzeros = .false. + exit zero_check + end if + end do zero_check + + !---------------------------------------------- + ! RN_20091102: An example of calls to Trilinos solvers + !#ifdef HAVE_TRILINOS + !call helloworld() + !#endif + !---------------------------------------------- + + if (allzeros) then + err = 0 + ierr = 0 + niters = 0 + solution = 0 + call write_log("RHS of all zeros passed to BCG method; iteration not performed.", & + GM_WARNING, __FILE__, __LINE__) + else + + !Set up SLAP if it hasn't been already + call slap_solver_preprocess(matrix, options, workspace) + + if (verbose_slap) then + print*, ' ' + print*, 'In slap_solve' + print*, 'method =', options%base%method + print*, 'order =', matrix%order + print*, 'nonzeros =', matrix%nonzeros + print*, 'isym =', isym + print*, 'itol =', options%itol + print*, 'tolerance =', options%base%tolerance + print*, 'maxiters =', options%base%maxiters + print*, 'size(row) = ', size(matrix%row) + print*, 'size(col) = ', size(matrix%col) + print*, 'size(val) = ', size(matrix%val) + print*, 'size(rwork) =', size(workspace%rwork) + print*, 'size(iwork) =', size(workspace%iwork) + endif + + ! Make a local copy of the nonzero matrix entries. + ! These local arrays can be passed to the various SLAP solvers with intent(inout) + ! and modified by SLAP without changing matrix%row, matrix%col, and matrix%val. + + do n = 1, matrix%nonzeros + matrix_row(n) = matrix%row(n) + matrix_col(n) = matrix%col(n) + matrix_val(n) = matrix%val(n) + enddo + + !TODO - Remove this code when no longer needed for debugging + ! This can take a long time. It's more efficient to check symmetry at a higher level, + ! in the glissade velo solver. + + if (check_symmetry) then + print*, 'Check symmetry...could take a while' + do n = 1, matrix%nonzeros + i = matrix_row(n) + j = matrix_col(n) + sym_partner = .false. + do m = 1, matrix%nonzeros + if (matrix_col(m)==i .and. matrix_row(m)==j) then + if (matrix_val(m) == matrix_val(n)) then + sym_partner = .true. + else ! fix if difference is small, else abort + if ( abs ((matrix_val(m)-matrix_val(n))/matrix_val(m)) < 1.e-10 ) then + avg_val = 0.5d0 * (matrix_val(m) + matrix_val(n)) + matrix_val(m) = avg_val + matrix_val(n) = avg_val + sym_partner = .true. + else + print*, ' ' + print*, 'Entry (i,j) not equal to (j,i)' + print*, 'i, j, val(i,j), val(j,i):', i, j, matrix%val(n), matrix%val(m) +!! stop + endif + endif + go to 100 + endif + enddo + if (.not. sym_partner) then + print*, ' ' + print*, 'Entry (i,j) has no corresponding (j,i): n, i, j, val =', n, i, j, matrix%val(n) + endif +100 continue + enddo + + endif ! check_symmetry + + + select case(options%base%method) + + ! Case values come from parameters defined in glide_types.F90. + ! (These parameter values are also used in glimmer_sparse.F90.) + + case(HO_SPARSE_GMRES) ! GMRES + + if (verbose_slap) then + print*, 'Call dslugm (GMRES)' + print*, 'maxiters, tolerance =', options%base%maxiters, options%base%tolerance + endif + + call dslugm(matrix%order, rhs, solution, matrix%nonzeros, & + matrix_row, matrix_col, matrix_val, & + isym, options%gmres_saved_vectors, options%itol, & + options%base%tolerance, options%base%maxiters, & + niters, err, ierr, iunit, & + workspace%rwork, size(workspace%rwork), workspace%iwork, size(workspace%iwork)) + + if (verbose_slap) print*, 'GMRES: iters, err =', niters, err + + case(HO_SPARSE_PCG_STANDARD) ! PCG with incomplete Cholesky preconditioner + + if (verbose_slap) then + print*, 'Call dsiccg (PCG, incomplete Cholesky)' + endif + + !TODO - Pass in just half the matrix? + ! If we pass in the entire matrix, then the preconditioner is fragile in the sense + ! that it can fail with very small departures from symmetry (due to roundoff errors) + + call dsiccg(matrix%order, rhs, solution, matrix%nonzeros, & + matrix_row, matrix_col, matrix_val, & + isym, options%itol, options%base%tolerance, options%base%maxiters,& + niters, err, ierr, iunit, & + workspace%rwork, size(workspace%rwork), workspace%iwork, size(workspace%iwork)) + + if (verbose_slap) print*, 'PCG_inch: iters, err =', niters, err + + case (HO_SPARSE_BICG) ! Biconjugate gradient + + if (verbose_slap) then + print*, 'Call dslucs (biconjugate gradient)' + print*, 'maxiters, tolerance =', options%base%maxiters, options%base%tolerance + endif + + call dslucs(matrix%order, rhs, solution, matrix%nonzeros, & + matrix_row, matrix_col, matrix_val, & + isym, options%itol, options%base%tolerance, options%base%maxiters,& + niters, err, ierr, iunit, & + workspace%rwork, size(workspace%rwork), workspace%iwork, size(workspace%iwork)) + + if (verbose_slap) print*, 'BiCG: iters, err =', niters, err + + case default + call write_log('Unknown method passed to SLAP solver', GM_FATAL) + + end select ! slap solver + + endif ! allzeros + + slap_solve = ierr + + end function slap_solve + + subroutine slap_solver_postprocess(matrix, options, workspace) + type(sparse_matrix_type), intent(in) :: matrix + type(slap_solver_options) :: options + type(slap_solver_workspace) :: workspace + end subroutine + + subroutine slap_destroy_workspace(matrix, options, workspace) + !> Deallocates all working memory for the slap linear solver. + !> This need *not* be safe to call of an unallocated workspace + !> No slap solver should call this automatically. + type(sparse_matrix_type), intent(in) :: matrix + type(slap_solver_options) :: options + type(slap_solver_workspace) :: workspace + !Deallocate all of the working memory + deallocate(workspace%rwork) + deallocate(workspace%iwork) + end subroutine slap_destroy_workspace + + subroutine slap_interpret_error(error_code, error_string) + !> takes an error code output from slap_solve and interprets it. + !> error_string must be an optional argument. + !> If it is not provided, the error is printed to standard out + !> instead of being put in the string + integer :: error_code + character(*), optional, intent(out) :: error_string + character(256) :: tmp_error_string + + select case (error_code) + case (0) + tmp_error_string="All went well" + case (1) + tmp_error_string="Insufficient space allocated for WORK or IWORK" + case (2) + tmp_error_string="Method failed to converge in ITMAX steps" + case (3) + tmp_error_string="Error in user input. Check input values of N, ITOL." + case (4) + tmp_error_string="User error tolerance set too tight." + case (5) + tmp_error_string="Breakdown of the method detected. (r0,r) approximately 0." + case (6) + tmp_error_string="Stagnation of the method detected. (r0, v) approximately 0." + case (7) + tmp_error_string="Incomplete factorization broke down and was fudged." + end select + + + if (present(error_string)) then + error_string = tmp_error_string + else + write(*,*) tmp_error_string + endif + end subroutine slap_interpret_error + +end module glimmer_sparse_slap diff --git a/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_type.F90 b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_type.F90 new file mode 100644 index 0000000000..0a7e790320 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-solve/glimmer_sparse_type.F90 @@ -0,0 +1,483 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_sparse_type.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glimmer_sparse_type + + use glimmer_global, only:dp + implicit none + + ! sparse matrix type + type sparse_matrix_type + integer :: nonzeros ! number of nonzero elements currently stored + integer :: order ! order of the matrix (e.g. number of rows) + logical :: symmetric ! True only if triangle of the symmetric matrix stored + integer, dimension(:), pointer :: col => NULL() ! column index + integer, dimension(:), pointer :: row => NULL() ! row index + real(kind=dp), dimension(:), pointer :: val => NULL() ! values + end type sparse_matrix_type + + type sparse_solver_options_base + real(kind=dp) :: tolerance ! Error tolerance + integer :: maxiters ! Max iterations before giving up + integer :: method + end type + + ! size of sparse matrix + integer, parameter, private :: chunksize=1000 + + !MAKE_RESTART +!EIB!#ifdef RESTARTS +!EIB!#define RST_GLIMMER_SPARSE +!EIB!#include "glimmer_rst_head.inc" +!EIB!#undef RST_GLIMMER_SPARSE +!EIB!#endif + +contains + +!EIB!#ifdef RESTARTS +!EIB!#define RST_GLIMMER_SPARSE +!EIB!#include "glimmer_rst_body.inc" +!EIB!#undef RST_GLIMMER_SPARSE +!EIB!#endif + + subroutine new_sparse_matrix(order,n,mat) + ! create a new sparse matrix + implicit none + integer, intent(in) :: n ! initial size of matrix (non-zeros) + type(sparse_matrix_type) :: mat ! matrix + integer, intent(in) :: order ! Order (number of rows and columns) of the matrix + + if (.not.associated(mat%col)) then + allocate(mat%row(n)) + !SLAP's sparse column scheme looks past the assumed bounds of col to see + !what sparse storage format we're in. To avoid array bounds problems, we + !add 2 to the column size. See mailing list discussion at: + !http://forge.nesc.ac.uk/pipermail/glimmer-discuss/2005-February/000078.html + allocate(mat%col(n+2)) + allocate(mat%val(n)) + else + if (size(mat%row).lt.n) then + call del_sparse_matrix(mat) + allocate(mat%row(n)) + allocate(mat%col(n+2)) + allocate(mat%val(n)) + end if + end if + mat%nonzeros = 0 + mat%order = order + mat%symmetric = .false. + end subroutine new_sparse_matrix + + subroutine copy_sparse_matrix(inmat,outmat) + ! copy a sparse matrix. + ! Slap workspace allocation on the new + ! matrix is *not* done. + implicit none + type(sparse_matrix_type) :: inmat ! matrix to be copied + type(sparse_matrix_type) :: outmat ! result matrix + + call new_sparse_matrix(inmat%order,inmat%nonzeros,outmat) + outmat%row(:) = inmat%row(:) + outmat%col(:) = inmat%col(:) + outmat%val(:) = inmat%val(:) + outmat%nonzeros = inmat%nonzeros + outmat%symmetric = inmat%symmetric + end subroutine copy_sparse_matrix + + subroutine grow_sparse_matrix(matrix) + ! grow sparse matrix + implicit none + type(sparse_matrix_type) :: matrix ! matrix + + integer, dimension(:), pointer :: newrow,newcol + real(kind=dp), dimension(:), pointer :: newval + integer oldsize + + oldsize = size(matrix%val) + + allocate(newrow(chunksize+oldsize)) + allocate(newcol(chunksize+oldsize)) + allocate(newval(chunksize+oldsize)) + write(*,*)size(matrix%col), size(matrix%row), size(matrix%val), size(newcol), size(newrow), size(newval) + newcol(1:oldsize) = matrix%col(:) + newrow(1:oldsize) = matrix%row(:) + newval(1:oldsize) = matrix%val(:) + + deallocate(matrix%col) + deallocate(matrix%row) + deallocate(matrix%val) + + matrix%col => newcol + matrix%row => newrow + matrix%val => newval + + end subroutine grow_sparse_matrix + + subroutine del_sparse_matrix(matrix) + ! delete sparse matrix + implicit none + type(sparse_matrix_type) :: matrix ! matrix + + if (associated(matrix%col)) then + deallocate(matrix%col) + deallocate(matrix%row) + deallocate(matrix%val) + end if + + end subroutine del_sparse_matrix + + subroutine print_sparse(matrix, unit) + ! print sparse matrix + implicit none + type(sparse_matrix_type) :: matrix ! matrix + integer, intent(in) :: unit ! unit to be printed to + + integer i + do i = 1, matrix%nonzeros + write(unit,*) matrix%col(i), matrix%row(i), matrix%val(i) + end do + end subroutine print_sparse + + subroutine sparse_matrix_vec_prod(matrix, vec, res) + ! sparse matrix vector product + implicit none + type(sparse_matrix_type) :: matrix ! matrix + real(kind=dp), intent(in), dimension(:) :: vec ! input vector + real(kind=dp), intent(out), dimension(:) :: res ! result vector + + integer i + + res = 0. + do i=1,matrix%nonzeros + res(matrix%col(i)) = res(matrix%col(i)) + vec(matrix%row(i))*matrix%val(i) + end do + end subroutine sparse_matrix_vec_prod + + subroutine sparse_insert_val(matrix, i, j, val) + ! insert value into sparse matrix. This is safe to call even if val=0 + implicit none + type(sparse_matrix_type) :: matrix ! matrix + integer, intent(in) :: i,j ! column and row + real(kind=dp), intent(in) :: val ! value + if (val /= 0.d0 .and. i > 0 .and. j > 0 .and. i <= matrix%order .and. j <= matrix%order) then + matrix%nonzeros = matrix%nonzeros + 1 + matrix%row(matrix%nonzeros) = i + matrix%col(matrix%nonzeros) = j + matrix%val(matrix%nonzeros) = val + + if (matrix%nonzeros .eq. size(matrix%val)) then + call grow_sparse_matrix(matrix) + end if + end if + end subroutine sparse_insert_val + + subroutine sparse_clear(matrix) + ! Clears the sparse matrix, without deallocating any of the + ! previously used memory + type(sparse_matrix_type) :: matrix + + matrix%nonzeros = 0 + !Clearing these shouldn't be strictly necessary, but SLAP barfs if we don't + matrix%row = 0 + matrix%col = 0 + matrix%val = 0 + end subroutine + + function is_triad_format(matrix) + type(sparse_matrix_type) :: matrix + logical :: is_triad_format + + is_triad_format = .not. is_column_format(matrix) .and. .not. is_row_format(matrix) + end function + + function is_row_format(matrix) + type(sparse_matrix_type) :: matrix + logical :: is_row_format + + is_row_format = matrix%row(matrix%order + 1) == matrix%nonzeros + 1 + end function +!----------------------------------------------------------------------- + subroutine coicsr (n,nnz,job,a,ja,ia,iwk) + use glimmer_global, only : dp + implicit none + integer,intent(in) :: n,nnz,job + real(dp),dimension(:),intent(inout) :: a + integer, dimension(:),intent(inout) :: ja,ia + integer, dimension(:),intent(inout) :: iwk + + !Local + real(kind=dp) :: t,tnext + logical :: values + integer :: i,j,k,init,ipos,inext,jnext + +!------------------------------------------------------------------------ +! IN-PLACE coo-csr conversion routine. +!------------------------------------------------------------------------ +! this subroutine converts a matrix stored in coordinate format into +! the csr format. The conversion is done in place in that the arrays +! a,ja,ia of the result are overwritten onto the original arrays. +!------------------------------------------------------------------------ +! on entry: +!--------- +! n = integer. row dimension of A. +! nnz = integer. number of nonzero elements in A. +! job = integer. Job indicator. when job=1, the real values in a are +! filled. Otherwise a is not touched and the structure of the +! array only (i.e. ja, ia) is obtained. +! a = real array of size nnz (number of nonzero elements in A) +! containing the nonzero elements +! ja = integer array of length nnz containing the column positions +! of the corresponding elements in a. +! ia = integer array of length nnz containing the row positions +! of the corresponding elements in a. +! iwk = integer work array of length n+1 +! on return: +!---------- +! a +! ja +! ia = contains the compressed sparse row data structure for the +! resulting matrix. +! Note: +!------- +! the entries of the output matrix are not sorted (the column +! indices in each are not in increasing order) use coocsr +! if you want them sorted. +!----------------------------------------------------------------------c +! Coded by Y. Saad, Sep. 26 1989 c +! Released under the LGPL +! +! Converted to F90 by JVJ -- 11/3/09 +!----------------------------------------------------------------------c +!----------------------------------------------------------------------- + values = (job .eq. 1) +! find pointer array for resulting matrix. + do i=1,n+1 + iwk(i) = 0 + end do + do k=1,nnz + i = ia(k) + iwk(i+1) = iwk(i+1)+1 + end do +!------------------------------------------------------------------------ + iwk(1) = 1 + do i=2,n + iwk(i) = iwk(i-1) + iwk(i) + end do +! +! loop for a cycle in chasing process. +! + init = 1 + k = 0 + 5 if (values) t = a(init) + i = ia(init) + j = ja(init) + ia(init) = -1 +!------------------------------------------------------------------------ + 6 k = k+1 +! current row number is i. determine where to go. + ipos = iwk(i) +! save the chased element. + if (values) tnext = a(ipos) + inext = ia(ipos) + jnext = ja(ipos) +! then occupy its location. + if (values) a(ipos) = t + ja(ipos) = j +! update pointer information for next element to come in row i. + iwk(i) = ipos+1 +! determine next element to be chased, + if (ia(ipos) .lt. 0) goto 65 + t = tnext + i = inext + j = jnext + ia(ipos) = -1 + if (k .lt. nnz) goto 6 + goto 70 + 65 init = init+1 + if (init .gt. nnz) goto 70 + if (ia(init) .lt. 0) goto 65 +! restart chasing -- + goto 5 + 70 do i=1,n + ia(i+1) = iwk(i) + end do + ia(1) = 1 + return + end subroutine +!----------------- end of coicsr ---------------------------------------- + + +!----------------------------------------------------------------------- + subroutine coocsr(nrow,nnz,a,ir,jc,ao,jao,iao) + use glimmer_global, only : dp + implicit none + integer, intent(in) :: nrow,nnz + real(dp),dimension(:),intent(in) :: a + integer,dimension(:),intent(in) :: ir + integer,dimension(:),intent(in) :: jc + real(dp),dimension(:),intent(out) :: ao + integer, dimension(:),intent(out) :: jao + integer, dimension(:),intent(out) :: iao + + ! Local + real(dp) :: x + integer :: i,k,j,k0,iad +!----------------------j------------------------------------------------- +! Coordinate to Compressed Sparse Row +! Written by Yousef Saad as part of SparseKit2 +! Released under the LGPL +! +! Converted to F90 by JVJ -- 10/21/09 +!----------------------------------------------------------------------- +! converts a matrix that is stored in coordinate format +! a, ir, jc into a row general sparse ao, jao, iao format. +! +! on entry: +!--------- +! nrow = dimension of the matrix +! nnz = number of nonzero elements in matrix +! a, +! ir, +! jc = matrix in coordinate format. a(k), ir(k), jc(k) store the nnz +! nonzero elements of the matrix with a(k) = actual real value of +! the elements, ir(k) = its row number and jc(k) = its column +! number. The order of the elements is arbitrary. +! +! on return: +!----------- +! ir is destroyed +! +! ao, jao, iao = matrix in general sparse matrix format with ao +! continung the real values, jao containing the column indices, +! and iao being the pointer to the beginning of the row, +! in arrays ao, jao. +!------------------------------------------------------------------------ + iao = 0 +! determine row-lengths. + do k=1, nnz + iao(ir(k)) = iao(ir(k))+1 + end do +! starting position of each row.. + k = 1 + do j=1,nrow+1 + k0 = iao(j) + iao(j) = k + k = k+k0 + end do +! go through the structure once more. Fill in output matrix. + do k=1, nnz + i = ir(k) + j = jc(k) + x = a(k) + iad = iao(i) + ao(iad) = x + jao(iad) = j + iao(i) = iad+1 + end do +! shift back iao + do j=nrow,1,-1 + iao(j+1) = iao(j) + end do + iao(1) = 1 + return + end subroutine +!------------- end of coocsr ------------------------------------------- + function is_column_format(matrix) + type(sparse_matrix_type) :: matrix + logical :: is_column_format + + is_column_format = matrix%col(matrix%order + 1) == matrix%nonzeros + 1 + end function + + subroutine to_column_format(matrix) + type(sparse_matrix_type) :: matrix + + if(is_triad_format(matrix)) then + call ds2y(matrix%order, matrix%nonzeros, matrix%row, matrix%col, matrix%val, 0) + end if + end subroutine + + subroutine sort_column_format(matrix) + ! Takes a column format matrix and sorts the row indices within each column + ! This is not strictly needed in some compressed-column matrices + ! (e.g. those used in SLAP), but it *is* necessary in some other libraries + ! (e.g. UMFPACK). For this reason, it is not done automatically in + ! to_column_format. + implicit none + type(sparse_matrix_type) :: matrix + integer :: i + + do i=1,matrix%order !Loop through each column index + call sort(matrix%val, matrix%row, matrix%col(i), matrix%col(i+1)-1) + end do + end subroutine + + subroutine sort_row_format(matrix) + ! Takes a row format matrix and sorts the column indices within each row + ! This is not strictly needed in some compressed-row matrices + ! (e.g. those used in SLAP), but it *is* necessary in some other libraries + ! (e.g. PARDISO). + implicit none + type(sparse_matrix_type),intent(inout) :: matrix + integer :: i + + do i=1,matrix%order !Loop through each column index + call sort(matrix%val, matrix%col, matrix%row(i), matrix%row(i+1)-1) + end do + end subroutine + + + subroutine sort(values, indices, startindex, endindex) + implicit none + real(dp),dimension(:),intent(inout) :: values + integer,dimension(:),intent(inout) :: indices + integer, intent(in) :: startindex + integer, intent(in) :: endindex + integer :: currentindex + real(dp) :: currentvalue + integer :: i,j + + !Insertion Sort + do i=startindex+1,endindex + currentindex = indices(i) + currentvalue = values(i) + + j = i-1 + do while (j >= startindex .and. indices(j) > currentindex) + indices(j+1) = indices(j) + values(j+1) = values(j) + j = j - 1 + end do + indices(j+1) = currentindex + values(j+1) = currentvalue + end do + end subroutine + +end module glimmer_sparse_type diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/CMakeLists.txt b/components/cism/glimmer-cism/libglimmer-trilinos/CMakeLists.txt new file mode 100644 index 0000000000..22d9af4993 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/CMakeLists.txt @@ -0,0 +1,8 @@ +# +FILE(GLOB CPPSOURCES *.cpp) +FILE(GLOB CPPHEADERS *.hpp) + +add_library(glimmercismcpp ${CPPSOURCES} ${CPPHEADERS}) +include_directories ( ${CISM_SOURCE_DIR} ${CMAKE_CURRENT_SOURCE_DIR} + ${Trilinos_INCLUDE_DIRS} ${Trilinos_TPL_INCLUDE_DIRS}) + diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/Makefile.Trilinos.export.in b/components/cism/glimmer-cism/libglimmer-trilinos/Makefile.Trilinos.export.in new file mode 100644 index 0000000000..59d92d7e10 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/Makefile.Trilinos.export.in @@ -0,0 +1,16 @@ +## Configure processes this file and replaces the strings in @..@ +## If configured --with-trilinos, this pulls in a Makefile where +## Trilinos variables are defined (e.g. Trilinos_LIBS), which +## are used in libglide/Makefile.am within an if Trilinos block. +## Else, this just becomes an unused comment + +## For Trilinos 10.4 or later, use these lines +@TRILINOS_TRUE@include @TRILINOS_PREFIX@/include/Makefile.export.Trilinos +@TRILINOS_TRUE@TRILINOS_LIBS_BASE = $(top_builddir)/libglimmer-trilinos/libglimmertrilinos.la $(Trilinos_LIBRARIES) $(Trilinos_TPL_LIBRARIES) + +## For versions of Trilinos before 10.4, uncomment these two lines instead to grab +## libraries from NOX since a unified Makefile.export.Trilinos did not yet exist +#@TRILINOS_TRUE@include @TRILINOS_PREFIX@/include/Makefile.export.NOX +#@TRILINOS_TRUE@TRILINOS_LIBS_BASE = $(top_builddir)/libglimmer-trilinos/libglimmertrilinos.la $(NOX_LIBRARIES) $(NOX_TPL_LIBRARIES) + +TRILINOS_LIBS_ALL = $(TRILINOS_LIBS_BASE) @EXTRA_LDLIBS_SUBST@ diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/README b/components/cism/glimmer-cism/libglimmer-trilinos/README new file mode 100644 index 0000000000..cd81fe3700 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/README @@ -0,0 +1,57 @@ +AGS:08/04/2010 +AGS:05/11/2011 + +GLIMMER with TRILINOS: +The libglimmer-trilinos directory contains code to interface +to the Trilinos linear solvers. These files are only compiled +when glimmer is configured --with-trilinos. A library +called libglimmertrilinos.a is the result, and is linked +into simple_glide. + +LINKING AGAINST TRILINOS: +The list of the few dozen Trilinos libraries needed on the +link line is automatically picked up through the logic +in Makefile.Trilinos.export.in. This grabs makefile +variables defined during the trilinos build, and +installed with trilinos in include/Makefile.export.Trilinos. +Blas and Lapack should be picked up this way as well. + +Glimmer is now linked with the C++ compiler. The autoconf +system picks up a variable called FCLIBS that should +contain all the fortran libraries needed to link fortran +code with C++ linker. This is not always complete. +Configure scripts for glimmer are being archived in +../configure-scripts. + +BUILDING TRILINOS: +Sample cmake configuration scripts for Trilinos on various +platforms are commited in cmake-scrips directory. More +examples are in Trilinos/sample-scripts. + +USING TRILINOS IN GLIMMER: +The trilinos solvers are accessed by selecting +* which_ho_sparse = 4 +This uses trilinosLinearSolver.cpp (and matrixInterface.cpp) +The entries in the matrix, if owned by this processor, +are loaded directly into the Trilinos (Epetra_CrsMatrix) +format. The hook to this is in putpcgc in glam_strs2.F90. + +SELECTING TRILINOS SOLVER OPTIONS: +The options that control the linear solver methods are +read from an input file called trilinosOptions.xml in +a sublist call "Stratimikos". Stratimikos is the Linear +Solver Strategies package in trilinos that provides a +single interface to all the preconditioners and linear +solvers in Trilinos (Belos, Aztec, Ifpack, ML, Amesos, ...). +The full list of options is documented on the Trilinos +web pages. Click on the Stratimikos package, documentation +of the Trilinos version that you are using, and then the +link to Stratimikos::DefaultLinearSolverBuilder. + +http://trilinos.sandia.gov/packages/docs/r10.6/packages/stratimikos/doc/html/classStratimikos_1_1DefaultLinearSolverBuilder.html + + +NONLINEAR SOLVERS: +An interface to Trilinos Nonliner solvers (NOX) is progressing +in a different svn branch. The C++ interface code will appear +in this directory. diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.cpp b/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.cpp new file mode 100644 index 0000000000..6a170bcf7b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.cpp @@ -0,0 +1,68 @@ +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// matrixInterface.cpp - part of the Community Ice Sheet Model (CISM) +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Copyright (C) 2005-2014 +// CISM contributors - see AUTHORS file for list of contributors +// +// This file is part of CISM. +// +// CISM is free software: you can redistribute it and/or modify it +// under the terms of the Lesser GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// CISM is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// Lesser GNU General Public License for more details. +// +// You should have received a copy of the Lesser GNU General Public License +// along with CISM. If not, see . +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include +#include "Teuchos_TestForException.hpp" +#include "matrixInterface.hpp" + +// Constructor +TrilinosMatrix_Interface::TrilinosMatrix_Interface + (const Teuchos::RCP& rowMap, + int bandwidth, const Epetra_Comm& comm) + : rowMap_(rowMap), bandwidth_(bandwidth), matrixOrder_(-1), comm_(comm) { + + matrixOrder_ = rowMap->NumGlobalElements(); + + operator_ = Teuchos::rcp(new Epetra_CrsMatrix(Copy, *rowMap, bandwidth) ); + isFillCompleted_ = false; +} + +// Destructor +TrilinosMatrix_Interface::~TrilinosMatrix_Interface() { +} + +// Accessor methods +bool TrilinosMatrix_Interface::isSparsitySet() const {return isFillCompleted_;} +int TrilinosMatrix_Interface::bandwidth() const {return bandwidth_;} +int TrilinosMatrix_Interface::matrixOrder() const {return matrixOrder_;} +const Epetra_Map& TrilinosMatrix_Interface::getRowMap() const {return *rowMap_;} +Teuchos::RCP& TrilinosMatrix_Interface::getOperator() {return operator_;} + + +// Fix the sparsity patter by calling FillComplete +void TrilinosMatrix_Interface::finalizeSparsity() { + isFillCompleted_ = true; + int ierr = operator_->FillComplete(); + TEUCHOS_TEST_FOR_EXCEPTION(ierr != 0, std::logic_error, + "Error: Trilinos Fill Complete returned nozero error code ( " << ierr << " )\n"); + +} + +// Update the operator and also the corresponding row map. +void TrilinosMatrix_Interface::updateOperator(Teuchos::RCP newOperator) { + operator_ = newOperator; + isFillCompleted_ = operator_->Filled(); +} diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.hpp b/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.hpp new file mode 100644 index 0000000000..37812365b7 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/matrixInterface.hpp @@ -0,0 +1,49 @@ +#ifndef TRILINOSMATIX_INTERFACE_H +#define TRILINOSMATIX_INTERFACE_H + +#include +#include "Epetra_Comm.h" +#include "Epetra_Map.h" +#include "Epetra_LocalMap.h" +#ifdef GLIMMER_MPI +#include "mpi.h" +#include "Epetra_MpiComm.h" +#else +#include "Epetra_SerialComm.h" +#endif +#include "Epetra_CrsMatrix.h" +#include "Epetra_Vector.h" +#include "Epetra_Import.h" + +#include "Teuchos_ConfigDefs.hpp" +#include "Teuchos_FancyOStream.hpp" + +class TrilinosMatrix_Interface { +public: + // Constructor + TrilinosMatrix_Interface(const Teuchos::RCP& rowMap, + int bandwidth, const Epetra_Comm& comm); + + // Destructor + ~TrilinosMatrix_Interface(); + + // Accessors + bool isSparsitySet() const; + int bandwidth() const; + int matrixOrder() const; + const Epetra_Map& getRowMap() const; + Teuchos::RCP& getOperator(); + + // Mutators + void finalizeSparsity(); // Call FillComplet to lock in sparsity pattern + void updateOperator(Teuchos::RCP newOperator); + +private: + bool isFillCompleted_; // to indicate if operator_ is "FillComplete()"ed + int bandwidth_; + int matrixOrder_; + const Epetra_Comm& comm_; + Teuchos::RCP operator_; + Teuchos::RCP rowMap_; +}; +#endif diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosGlissadeSolver.cpp b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosGlissadeSolver.cpp new file mode 100644 index 0000000000..1fd5d8767d --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosGlissadeSolver.cpp @@ -0,0 +1,412 @@ +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// trilinosGLissadeSolver.cpp - part of the Community Ice Sheet Model (CISM) +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Copyright (C) 2005-2014 +// CISM contributors - see AUTHORS file for list of contributors +// +// This file is part of CISM. +// +// CISM is free software: you can redistribute it and/or modify it +// under the terms of the Lesser GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// CISM is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// Lesser GNU General Public License for more details. +// +// You should have received a copy of the Lesser GNU General Public License +// along with CISM. If not, see . +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include +#include "Epetra_Import.h" +#include "Epetra_Vector.h" +#include "Epetra_CrsMatrix.h" + +#include "Teuchos_ParameterList.hpp" +#include "Teuchos_XMLParameterListHelpers.hpp" +#include "Teuchos_Time.hpp" +//#include "Teuchos_TimeMonitor.hpp" +#include "Teuchos_StandardCatchMacros.hpp" + +#include "Stratimikos_DefaultLinearSolverBuilder.hpp" +#include "Thyra_LinearOpWithSolveFactoryHelpers.hpp" +#include "Thyra_EpetraThyraWrappers.hpp" +#include "Thyra_EpetraLinearOp.hpp" + +#ifdef GLIMMER_MPI +#include "Teuchos_DefaultMpiComm.hpp" +#include "Epetra_MpiComm.h" +#else +#include "Teuchos_DefaultSerialComm.hpp" +#include "Epetra_SerialComm.h" +#endif + +#include "config.inc" + +// Uncomment this #define to write out linear system +//#define WRITE_OUT_LINEAR_SYSTEM +#ifdef WRITE_OUT_LINEAR_SYSTEM +#include "EpetraExt_RowMatrixOut.h" +#include "EpetraExt_MultiVectorOut.h" +int solvecount=0; +#endif + +// Turn this on to check validity of sparse matrix entries +//#define CHECK_FOR_ROGUE_COLUMNS + +// Define variables that are global to this file. +// If this were a C++ class, these would be member data. +Teuchos::RCP rhs; +Teuchos::RCP paramList; +Teuchos::RCP tout; +Teuchos::RCP matrix; +Teuchos::RCP > linOp; +Teuchos::RCP > linOpFactory; +Teuchos::RCP > thyraOp; +bool successFlag = true; + +// Flag for operations done once per time step (e.g. define active unknowns) +bool firstMatrixAssemblyForTimeStep = true; + +// Flag for operations done once per run (e.g. read in trilinosOPtions.xml) +bool firstCallToInitializeTGS = true; + +int linSolveCount=0, linSolveSuccessCount=0, linSolveIters_last=0, linSolveIters_total=0; +double linSolveAchievedTol; +bool printLinSolDetails=true; // Need to set in input file. + +extern "C" { + + // Prototypes for locally called functions + void linSolveDetails_tgs(Thyra::SolveStatus& status); + void check_for_rogue_columns_tgs( Epetra_CrsMatrix& mat); + + //================================================================ + // This needs to be called only once per time step in the beginning + // to set up the owned unknow map for the problem. + //================================================================ + + void FC_FUNC(initializetgs,initializetgs) + (int& mySize, int* myIndicies, int* mpi_comm_f) { + // mySize: the number of active_owned_unknowns on this processor + // myIndicies[]: global_active_owned_unknowns integer array in glissade-speak + // mpi_comm_f: CISM's fortran mpi communicator + + // Define output stream that only prints on Proc 0 + tout = Teuchos::VerboseObjectBase::getDefaultOStream(); + +#ifdef GLIMMER_MPI + // Make sure the MPI_Init in Fortran is recognized by C++. + // We used to call an extra MPI_Init if (!flag), but the behavior of doing so is uncertain, + // especially if CISM's MPI communicator is a subset of MPI_COMM_WORLD (as can be the case in CESM). + // Thus, for now, we die with an error message if C++ perceives MPI to be uninitialized. + // If this causes problems (e.g., if certain MPI implementations seem not to recognize + // that MPI has already been initialized), then we will revisit how to handle this. + int flag; + MPI_Initialized(&flag); + if (!flag) { + *tout << "ERROR in initializetgs: MPI not initialized according to C++ code" << std::endl; + exit(1); + } + MPI_Comm mpi_comm_c = MPI_Comm_f2c(*mpi_comm_f); + Epetra_MpiComm comm(mpi_comm_c); + Teuchos::MpiComm tcomm(Teuchos::opaqueWrapper(mpi_comm_c)); +#else + Epetra_SerialComm comm; + Teuchos::SerialComm tcomm; +#endif + + + // Read parameter list from XML file once per run + if (firstCallToInitializeTGS) { + // Set flag so following code is executed only once per code run + firstCallToInitializeTGS = false; + try { + paramList = Teuchos::rcp(new Teuchos::ParameterList("Trilinos Options")); + Teuchos::updateParametersFromXmlFileAndBroadcast("trilinosOptions.xml", paramList.ptr(), tcomm); + + Teuchos::ParameterList validPL("Valid List");; + validPL.sublist("Stratimikos"); validPL.sublist("Piro"); + paramList->validateParameters(validPL, 0); + + // Set the coordinate position of the nodes for ML for repartitioning (important for #procs > 100s) + if (paramList->sublist("Stratimikos").isParameter("Preconditioner Type")) { + if ("ML" == paramList->sublist("Stratimikos").get("Preconditioner Type")) { + *tout << "\nNOTE: ML preconditioner can work much better when interface is extended\n" + << "\tto include Nodal XYZ coordinates.\n" << std::endl; + Teuchos::ParameterList& mlList = + paramList->sublist("Stratimikos").sublist("Preconditioner Types").sublist("ML").sublist("ML Settings"); + //mlList.set("x-coordinates",myX); + //mlList.set("y-coordinates",myY); + //mlList.set("z-coordinates",myZ); + mlList.set("PDE equations", 2); + } + } + + // Set up solver (preconditioner, iterative method) based on XML file + Stratimikos::DefaultLinearSolverBuilder linearSolverBuilder; + linearSolverBuilder.setParameterList(Teuchos::sublist(paramList, "Stratimikos")); + linOpFactory = linearSolverBuilder.createLinearSolveStrategy(""); + linOpFactory->setOStream(tout); + linOpFactory->setVerbLevel(Teuchos::VERB_LOW); + + linOp=Teuchos::null; + thyraOp=Teuchos::null; + } + catch (std::exception& e) { + std::cout << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + << e.what() << "\nExiting: Invalid trilinosOptions.xml file." + << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" << std::endl; + exit(1); + } + catch (...) { + std::cout << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + << "\nExiting: Invalid trilinosOptions.xml file." + << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" << std::endl; + exit(1); + } + } + + // Continue setup that needs to be redone every time step + try { + // Flag to let subsequent functions know that a new matrix has been created + firstMatrixAssemblyForTimeStep = true; + + Teuchos::RCP rowMap = + Teuchos::rcp(new Epetra_Map(-1, mySize, myIndicies, 1, comm) ); + + TEUCHOS_TEST_FOR_EXCEPTION(!rowMap->UniqueGIDs(), std::logic_error, + "Error: initializetgs, myIndicies array needs to have unique entries" + << " across all processors."); + + // Diagnostic output for partitioning + int minSize, maxSize; + comm.MinAll(&mySize, &minSize, 1); + comm.MaxAll(&mySize, &maxSize, 1); + if (comm.MyPID()==0) + *tout << "\nPartition Info in init_trilinos: Total nodes = " << rowMap->NumGlobalElements() + << " Max = " << maxSize << " Min = " << minSize + << " Ave = " << rowMap->NumGlobalElements() / comm.NumProc() << std::endl; + + // rhs is the b vector, rhs of linear system (owned, active) + rhs = Teuchos::rcp(new Epetra_Vector(*rowMap)); + + // Reset counters every time step: can remove these lines to have averages over entire run + linSolveIters_total = 0; + linSolveCount=0; + linSolveSuccessCount = 0; + + // Construct the CrsMatrix based on the row map and bandwidth estimate + const int bandwidth = 54; + matrix = Teuchos::rcp(new Epetra_CrsMatrix(Copy, *rowMap, bandwidth)); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, successFlag); + if (!successFlag) exit(1); + + //Teuchos::TimeMonitor::summarize(*tout,false,true,false/*zero timers*/); + } + + //============================================================ + // Insert one row of entries into matrix and RHS + //============================================================ + + void FC_FUNC(insertrowtgs,INSERTROWTGS) + (int& rowInd, int& numColumns, int* columns, + double* matrixValues, double& rhsValue ) { + // rowInd: global row number + // numColumns: number of columns in this row (typically 54, but less on boundaries) + // columns[]: array with numColumns valid entries of global column numbers + // matrixValues[]: array with corresponding matrix entries + // rhsValue: entry into "b" vector for that same row. + // + //TEUCHOS_FUNC_TIME_MONITOR("> insertRowTGS"); + + try { + int ierr; + const Epetra_Map& rowMap = matrix->RowMap(); + + // If this row is not owned on this processor, then throw error + TEUCHOS_TEST_FOR_EXCEPTION(!rowMap.MyGID(rowInd), std::logic_error, + "Error: Trilinos matrix has detected an invalid row entry (row=" + << rowInd << ").\n"); + + // Insert contribution to rhs a.k.a. b vector (as in Au=b) + rhs->ReplaceGlobalValues(1, &rhsValue, &rowInd); + + if (firstMatrixAssemblyForTimeStep) { + +//#define ONE_PROC_DEBUG +#ifdef ONE_PROC_DEBUG + if (rowMap.Comm().NumProc()==1) + for (int col=0; colInsertGlobalValues(rowInd, numColumns, matrixValues, columns); + + if (ierr<0) {std::cout << "Error Code for " << rowInd << " = ("<< ierr <<")"<0) std::cout << "Warning Code for " << rowInd << " = ("<< ierr <<")"<ReplaceGlobalValues(rowInd, 1, &matrixValues[col], &columns[col]); + + TEUCHOS_TEST_FOR_EXCEPTION(ierr != 0, std::logic_error, + "Error: Trilinos matrix has detected a new column entry A(" + << rowInd << ", " << columns[col] << ") = " << matrixValues[col] + << "\n\t that did not exist before."); + } +#else + // Subsequent matrix fills of each time step. + ierr = matrix->ReplaceGlobalValues(rowInd, numColumns, matrixValues, columns); + + TEUCHOS_TEST_FOR_EXCEPTION(ierr != 0, std::logic_error, + "Error: Trilinos matrix has detected a new column entry in row (" + << rowInd << ")\n\t that did not exist before."); +#endif + } + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, successFlag); + if (!successFlag) exit(1); + } + + //============================================================ + // Call to perform solve of previously assembled linear system + //============================================================ + + void FC_FUNC(solvevelocitytgs,SOLVEVELOCITYTGS) + (double* velocityResult) { + // velocityResult[]: array of length mySize from initializetgs call, that + // upon return will have the velocities from Au=b solve. + //TEUCHOS_FUNC_TIME_MONITOR("> solveVelocityTGS"); + + try { + //Teuchos::Time linearTime("LinearTime"); linearTime.start(); + + // Lock in sparsity pattern of CrsMatrix -- first solve only + if (firstMatrixAssemblyForTimeStep) { + firstMatrixAssemblyForTimeStep = false; + + matrix->FillComplete(); +#ifdef CHECK_FOR_ROGUE_COLUMNS + check_for_rogue_columns_tgs(*matrix); +#endif + + // Associate matrix with solver strategy layers + thyraOp = Thyra::epetraLinearOp(matrix); + } + // Need to do this call to invoke fresh preconditioner + linOp = Thyra::linearOpWithSolve(*linOpFactory, thyraOp); + + // Wrap velocity vector inside Epetra Vector data structure + Teuchos::RCP solution + = Teuchos::rcp(new Epetra_Vector(View, matrix->RowMap(), velocityResult)); + +#ifdef WRITE_OUT_LINEAR_SYSTEM + solvecount++; + if (solvecount==1) { + EpetraExt::RowMatrixToMatrixMarketFile("matrix1", *matrix); + EpetraExt::MultiVectorToMatrixMarketFile("vector1", *rhs); + } +#endif + + // Wrap Epetra Vetors as Thyra vectors, as the solver requires + Teuchos::RCP > + thyraRhs = Thyra::create_Vector(rhs, thyraOp->range() ); + Teuchos::RCP > + thyraSol = Thyra::create_Vector(solution, thyraOp->domain() ); + Thyra::SolveStatus + status = Thyra::solve(*linOp, Thyra::NOTRANS, *thyraRhs, thyraSol.ptr()); + + if (printLinSolDetails) linSolveDetails_tgs(status); + + //elapsedTime = linearTime.stop(); + //*tout << "Total time elapsed for calling Solve(): " << elapsedTime << std::endl; + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, successFlag); + if (!successFlag) exit(1); + } + + //============================================================ + + void linSolveDetails_tgs(Thyra::SolveStatus& status) { + ++linSolveCount; + bool haveData=false; + if (status.extraParameters != Teuchos::null) { + if (status.extraParameters->isParameter("Belos/Iteration Count")) { + linSolveIters_last = status.extraParameters->get("Belos/Iteration Count"); + linSolveIters_total += linSolveIters_last; + haveData=true; + } + if (status.extraParameters->isParameter("Belos/Achieved Tolerance")) + linSolveAchievedTol = status.extraParameters->get("Belos/Achieved Tolerance"); + if (status.extraParameters->isParameter("AztecOO/Iteration Count")) { + linSolveIters_last = status.extraParameters->get("AztecOO/Iteration Count"); + linSolveIters_total += linSolveIters_last; + haveData=true; + } + if (status.extraParameters->isParameter("AztecOO/Achieved Tolerance")) + linSolveAchievedTol = status.extraParameters->get("AztecOO/Achieved Tolerance"); + + if (haveData) { + *tout << "Precon Linear Solve "; + if (status.solveStatus == Thyra::SOLVE_STATUS_CONVERGED) + {*tout << "Succeeded: "; ++linSolveSuccessCount;} + else *tout << "Failed: "; + *tout << std::setprecision(3) + << linSolveAchievedTol << " drop in " + << linSolveIters_last << " its (avg: " + << linSolveIters_total / (double) linSolveCount << " its/slv, " + << 100.0* linSolveSuccessCount / (double) linSolveCount << "% success)" + << std::endl; + } + } + } + + /* Debugging utility to check if columns have been Inserted into the + * matrix that do not correspond to a row on any processor + */ + void check_for_rogue_columns_tgs( Epetra_CrsMatrix& mat) { + // Set up rowVector of 0s and column vector of 1s + const Epetra_Map& rowMap = mat.RowMap(); + const Epetra_Map& colMap = mat.ColMap(); + Epetra_Vector rowVec(rowMap); rowVec.PutScalar(0.0); + Epetra_Vector colVec(colMap); colVec.PutScalar(1.0); + Epetra_Import importer(colMap, rowMap); + + // Overwrite colVec 1s with rowVec 0s + colVec.Import(rowVec, importer, Insert); + + // Check that all 1s have been overwritten + double nrm=0.0; + colVec.Norm1(&nrm); // nrm = number of columns not overwritten by rows + + // If any rogue columns, exit now (or just get nans later) + if (nrm>=1.0) { + *tout << "ERROR: Column map has " << nrm + << " rogue entries that are not associated with any row." << std::endl; + rowMap.Comm().Barrier(); + exit(-3); + } + else { + *tout << "Debugging check for rogue column indices passed." + << " Turn off for production runs.\n" << std::endl; + } + } + + //============================================================ + +} // extern"C" diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosLinearSolver.cpp b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosLinearSolver.cpp new file mode 100644 index 0000000000..cd83aae9f1 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosLinearSolver.cpp @@ -0,0 +1,457 @@ +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// trilinosLinearSolver.cpp - part of the Community Ice Sheet Model (CISM) +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Copyright (C) 2005-2014 +// CISM contributors - see AUTHORS file for list of contributors +// +// This file is part of CISM. +// +// CISM is free software: you can redistribute it and/or modify it +// under the terms of the Lesser GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// CISM is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// Lesser GNU General Public License for more details. +// +// You should have received a copy of the Lesser GNU General Public License +// along with CISM. If not, see . +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include +#include "Epetra_LocalMap.h" +#include "Epetra_Import.h" +#include "Epetra_CombineMode.h" +#include "matrixInterface.hpp" + +#include "Teuchos_ParameterList.hpp" +#include "Teuchos_XMLParameterListHelpers.hpp" +#include "Teuchos_Time.hpp" +#include "Teuchos_StandardCatchMacros.hpp" + + +#include "Stratimikos_DefaultLinearSolverBuilder.hpp" +#include "Thyra_LinearOpWithSolveFactoryHelpers.hpp" +#include "Thyra_EpetraThyraWrappers.hpp" +#include "Thyra_EpetraLinearOp.hpp" + +#ifdef GLIMMER_MPI +#include "Teuchos_DefaultMpiComm.hpp" +#else +#include "Teuchos_DefaultSerialComm.hpp" +#endif + +#include "config.inc" + +// Uncomment this #define to write out linear system +//#define WRITE_OUT_LINEAR_SYSTEM +#ifdef WRITE_OUT_LINEAR_SYSTEM +#include "EpetraExt_RowMatrixOut.h" +#include "EpetraExt_MultiVectorOut.h" +int solvecount=0; +#endif + +// Turn this on to check validity of sparse matrix entries +#define CHECK_FOR_ROGUE_COLUMNS + +// Define variables that are global to this file. +// If this were a C++ class, these would be member data. +Teuchos::RCP interface; +Teuchos::RCP savedMatrix_A; +Teuchos::RCP savedMatrix_C; +Teuchos::RCP soln; +Teuchos::RCP pl; +Teuchos::RCP out; +Teuchos::RCP > lows; +Teuchos::RCP > lowsFactory; +Teuchos::RCP > thyraOper; +bool success = true; + +int linearSolveCount=0, linearSolveSuccessCount=0, linearSolveIters_last=0, linearSolveIters_total=0; +double linearSolveAchievedTol; +bool printDetails=false; // Need to set in input file. + +extern "C" { + + // Prototype for locally called function + void linSolveDetails(Thyra::SolveStatus& status); + void check_for_rogue_columns( Epetra_CrsMatrix& mat); + + //================================================================ + //================================================================ + // RN_20091215: This needs to be called only once per time step + // in the beginning to set up the problem. + //================================================================ + void FC_FUNC(inittrilinos,INITTRILINOS) (int& bandwidth, int& mySize, + int* myIndicies, double* myX, double* myY, double* myZ, + int* mpi_comm_f) { +// mpi_comm_f: CISM's fortran mpi communicator + +#ifdef GLIMMER_MPI + // Make sure the MPI_Init in Fortran is recognized by C++. + // We used to call an extra MPI_Init if (!flag), but the behavior of doing so is uncertain, + // especially if CISM's MPI communicator is a subset of MPI_COMM_WORLD (as can be the case in CESM). + // Thus, for now, we die with an error message if C++ perceives MPI to be uninitialized. + // If this causes problems (e.g., if certain MPI implementations seem not to recognize + // that MPI has already been initialized), then we will revisit how to handle this. + int flag; + MPI_Initialized(&flag); + if (!flag) { + std::cout << "ERROR in inittrilinos: MPI not initialized according to C++ code" << std::endl; + exit(1); + } + MPI_Comm mpi_comm_c = MPI_Comm_f2c(*mpi_comm_f); + Epetra_MpiComm comm(mpi_comm_c); + Teuchos::MpiComm tcomm(Teuchos::opaqueWrapper(mpi_comm_c)); +#else + Epetra_SerialComm comm; + Teuchos::SerialComm tcomm; +#endif + + Teuchos::RCP rowMap = + Teuchos::rcp(new Epetra_Map(-1,mySize,myIndicies,1,comm) ); + + TEUCHOS_TEST_FOR_EXCEPTION(!rowMap->UniqueGIDs(), std::logic_error, + "Error: inittrilinos, myIndices array needs to have Unique entries" + << " across all processor."); + + // Diagnostic output for partitioning + int minSize, maxSize; + comm.MinAll(&mySize, &minSize, 1); + comm.MaxAll(&mySize, &maxSize, 1); + if (comm.MyPID()==0) + std::cout << "\nPartition Info in init_trilinos: Total nodes = " << rowMap->NumGlobalElements() + << " Max = " << maxSize << " Min = " << minSize + << " Ave = " << rowMap->NumGlobalElements() / comm.NumProc() << std::endl; + + soln = Teuchos::rcp(new Epetra_Vector(*rowMap)); + + // Read parameter list once + try { + pl = Teuchos::rcp(new Teuchos::ParameterList("Trilinos Options")); + Teuchos::updateParametersFromXmlFileAndBroadcast("trilinosOptions.xml", pl.ptr(), tcomm); + + Teuchos::ParameterList validPL("Valid List");; + validPL.sublist("Stratimikos"); validPL.sublist("Piro"); + pl->validateParameters(validPL, 0); + } + catch (std::exception& e) { + std::cout << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + << e.what() << "\nExiting: Invalid trilinosOptions.xml file." + << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" << std::endl; + exit(1); + } + catch (...) { + std::cout << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + << "\nExiting: Invalid trilinosOptions.xml file." + << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" << std::endl; + exit(1); + } + + try { + // Set the coordinate position of the nodes for ML for repartitioning (important for #procs > 100s) + if (pl->sublist("Stratimikos").isParameter("Preconditioner Type")) { + if ("ML" == pl->sublist("Stratimikos").get("Preconditioner Type")) { + Teuchos::ParameterList& mlList = + pl->sublist("Stratimikos").sublist("Preconditioner Types").sublist("ML").sublist("ML Settings"); + mlList.set("x-coordinates",myX); + mlList.set("y-coordinates",myY); + mlList.set("z-coordinates",myZ); + mlList.set("PDE equations", 1); + } + } + + out = Teuchos::VerboseObjectBase::getDefaultOStream(); + + // Reset counters every time step: can remove these lines to have averages over entire run + linearSolveIters_total = 0; + linearSolveCount=0; + linearSolveSuccessCount = 0; + + // Create an interface that holds a CrsMatrix instance and some useful methods. + interface = Teuchos::rcp(new TrilinosMatrix_Interface(rowMap, bandwidth, comm)); + + Stratimikos::DefaultLinearSolverBuilder linearSolverBuilder; + linearSolverBuilder.setParameterList(Teuchos::sublist(pl, "Stratimikos")); + lowsFactory = linearSolverBuilder.createLinearSolveStrategy(""); + lowsFactory->setOStream(out); + lowsFactory->setVerbLevel(Teuchos::VERB_LOW); + + lows=Teuchos::null; + thyraOper=Teuchos::null; + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + //============================================================ + // RN_20091118: This is to update the matrix with new entries. + //============================================================ + + void FC_FUNC(putintotrilinosmatrix,PUTINTOTRILINOSMATRIX) + (int& rowInd, int& colInd, double& val) { + + try { + int ierr; + const Epetra_Map& map = interface->getRowMap(); + // If this row is not owned on this processor, then throw error + TEUCHOS_TEST_FOR_EXCEPTION(!map.MyGID(rowInd), std::logic_error, + "Error: Trilinos matrix has detected an invalide row entry (row=" + << rowInd << ",col=" << colInd << ",val=" << val << ").\n"); + + Epetra_CrsMatrix& matrix = *(interface->getOperator()); + + if (!interface->isSparsitySet()) { + + // The matrix has not been "FillComplete()"ed. First fill of time step. + ierr = matrix.InsertGlobalValues(rowInd, 1, &val, &colInd); + if (ierr<0) {std::cout << "Error Code for " << rowInd << " " << colInd << " = ("<< ierr <<")"<0) std::cout << "Warning Code for " << rowInd << " " << colInd << " = ("<< ierr <<")"<isSparsitySet()) { + interface->finalizeSparsity(); +#ifdef CHECK_FOR_ROGUE_COLUMNS + check_for_rogue_columns(*interface->getOperator()); +#endif + } + + const Epetra_Map& map = interface->getRowMap(); + Teuchos::RCP epetraSol = soln; + Teuchos::RCP epetraRhs; + epetraRhs = Teuchos::rcp(new Epetra_Vector(View, map, rhs)); + + thyraOper = Thyra::epetraLinearOp(interface->getOperator()); + Teuchos::RCP > + thyraRhs = Thyra::create_Vector(epetraRhs, thyraOper->range() ); + Teuchos::RCP > + thyraSol = Thyra::create_Vector(epetraSol, thyraOper->domain() ); + + lows = Thyra::linearOpWithSolve(*lowsFactory, thyraOper); + + // Uncomment following block to Dump out two matrices Avv, Auu. + // This function is called twice per Picard iter, which is twice + // per outer GMRES step for Newton solves, so writing at + // solvecount==1 is first system, solvecount==51 is 26th Picard iter. + +#ifdef WRITE_OUT_LINEAR_SYSTEM + solvecount++; + if (solvecount==1) { + EpetraExt::RowMatrixToMatrixMarketFile("matrix1", *interface->getOperator()); + EpetraExt::MultiVectorToMatrixMarketFile("vector1", *epetraRhs); + } +#endif + + Thyra::SolveStatus + status = Thyra::solve(*lows, Thyra::NOTRANS, *thyraRhs, thyraSol.ptr()); + + if (printDetails) linSolveDetails(status); + + soln->ExtractCopy(answer); + + //elapsedTime = linearTime.stop(); *out << "Total time elapsed for calling Solve(): " << elapsedTime << std::endl; + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + + void FC_FUNC(savetrilinosmatrix,SAVETRILINOSMATRIX) (int* i) { + try { + if (!interface->isSparsitySet()) { + interface->finalizeSparsity(); +#ifdef CHECK_FOR_ROGUE_COLUMNS + check_for_rogue_columns(*interface->getOperator()); +#endif + } + if (*i==0) + savedMatrix_A = Teuchos::rcp(new Epetra_CrsMatrix(*(interface->getOperator()))); + else if (*i==1) + savedMatrix_C = Teuchos::rcp(new Epetra_CrsMatrix(*(interface->getOperator()))); + else if (*i==2) { + savedMatrix_A = Teuchos::rcp(new Epetra_CrsMatrix(*(interface->getOperator()))); + savedMatrix_C = Teuchos::rcp(new Epetra_CrsMatrix(*(interface->getOperator()))); + } + else + assert(false); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + + void FC_FUNC(restoretrilinosmatrix,RESTORTRILINOSMATRIX) (int* i) { + try { + if (*i==0) + interface->updateOperator(savedMatrix_A); + else if (*i==1) + interface->updateOperator(savedMatrix_C); + else + assert(false); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + void FC_FUNC(matvecwithtrilinos,MATVECWITHTRILINOS) + (double* x, double* answer) { + try { + const Epetra_Map& map = interface->getRowMap(); + + Teuchos::RCP epetra_x; + epetra_x = Teuchos::rcp(new Epetra_Vector(View, map, x)); + + Epetra_Vector y(map); + interface->getOperator()->Multiply(false, *epetra_x, y); + + y.ExtractCopy(answer); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + + //============================================================ + // Functionality here is for FEM fills. These differ in that + // contributions to matrix entried can come in multiple parts, + // so we need to ZeroOut and SumInto the matris, instead of + // Replace matrix entries. + // + // This first attempt will not work in parallel -- we need to + // add functionality to deal with off-processor contributions. + //============================================================ + + void FC_FUNC(zeroouttrilinosmatrix,ZEROOUTTRILINOSMATRIX)() { + try { + // Zero out matrix. Don't do anything for first call, when matrix is empty. + if (interface->isSparsitySet()) { + Epetra_CrsMatrix& matrix = *(interface->getOperator()); + matrix.PutScalar(0.0); + } + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, success); + if (!success) exit(1); + } + + void FC_FUNC(sumintotrilinosmatrix,SUMINTOTRILINOSMATRIX) + (int& rowInd, int& numEntries, int* colInd, double* val) { + + try { + const Epetra_Map& map = interface->getRowMap(); + + Epetra_CrsMatrix& matrix = *(interface->getOperator()); + + if (!interface->isSparsitySet()) { + // The matrix has not been "FillComplete()"ed. First fill of time step. + // Inserted values at this stage will be summed together later + int ierr = matrix.InsertGlobalValues(rowInd, numEntries, val, colInd); + if (ierr<0) {std::cout << "Error Code for " << rowInd << " " << colInd[0] << " = ("<< ierr <<")"<0) std::cout << "Warning Code for " << rowInd << " " << colInd[0] << " = ("<< ierr <<")"<& status) { + ++linearSolveCount; + bool haveData=false; + if (status.extraParameters != Teuchos::null) { + if (status.extraParameters->isParameter("Belos/Iteration Count")) { + linearSolveIters_last = status.extraParameters->get("Belos/Iteration Count"); + linearSolveIters_total += linearSolveIters_last; + haveData=true; + } + if (status.extraParameters->isParameter("Belos/Achieved Tolerance")) + linearSolveAchievedTol = status.extraParameters->get("Belos/Achieved Tolerance"); + if (status.extraParameters->isParameter("AztecOO/Iteration Count")) { + linearSolveIters_last = status.extraParameters->get("AztecOO/Iteration Count"); + linearSolveIters_total += linearSolveIters_last; + haveData=true; + } + if (status.extraParameters->isParameter("AztecOO/Achieved Tolerance")) + linearSolveAchievedTol = status.extraParameters->get("AztecOO/Achieved Tolerance"); + + if (haveData) { + *out << "Precon Linear Solve "; + if (status.solveStatus == Thyra::SOLVE_STATUS_CONVERGED) + {*out << "Succeeded: "; ++linearSolveSuccessCount;} + else *out << "Failed: "; + *out << std::setprecision(3) + << linearSolveAchievedTol << " drop in " + << linearSolveIters_last << " its (avg: " + << linearSolveIters_total / (double) linearSolveCount << " its/slv, " + << 100.0* linearSolveSuccessCount / (double) linearSolveCount << "% success)" + << std::endl; + } + } + } + + /* Debugging utility to check if columns have been Inserted into the + * matrix that do not correspond to a row on any processor + */ + void check_for_rogue_columns( Epetra_CrsMatrix& mat) { + // Set up rowVector of 0s and column vector of 1s + const Epetra_Map& rowMap = mat.RowMap(); + const Epetra_Map& colMap = mat.ColMap(); + Epetra_Vector rowVec(rowMap); rowVec.PutScalar(0.0); + Epetra_Vector colVec(colMap); colVec.PutScalar(1.0); + Epetra_Import importer(colMap, rowMap); + + // Overwrite colVec 1s with rowVec 0s + colVec.Import(rowVec, importer, Insert); + + // Check that all 1s have been overwritten + double nrm=0.0; + colVec.Norm1(&nrm); // nrm = number of columns not overwritten by rows + + // If any rogue columns, exit now (or just get nans later) + if (nrm>=1.0) { + *out << "ERROR: Column map has " << nrm + << " rogue entries that are not associated with any row." << std::endl; + rowMap.Comm().Barrier(); + exit(-3); + } + } + + //============================================================ + +} // extern"C" diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.cpp b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.cpp new file mode 100644 index 0000000000..0a35a51c8a --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.cpp @@ -0,0 +1,171 @@ +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// trilinosModelEvaluator.cpp - part of the Community Ice Sheet Model (CISM) +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Copyright (C) 2005-2014 +// CISM contributors - see AUTHORS file for list of contributors +// +// This file is part of CISM. +// +// CISM is free software: you can redistribute it and/or modify it +// under the terms of the Lesser GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// CISM is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// Lesser GNU General Public License for more details. +// +// You should have received a copy of the Lesser GNU General Public License +// along with CISM. If not, see . +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include "trilinosModelEvaluator.hpp" +#include "Teuchos_StandardCatchMacros.hpp" + + +extern "C" { + void calc_F(double* x, double* f, int N, void* bb, int ispert); + void apply_precond_nox(double* x, double* y, int n, void* bb); + void reset_effstrmin(const double* esm); +} +/*******************************************************************************/ +/*******************************************************************************/ +/*******************************************************************************/ + +trilinosModelEvaluator::trilinosModelEvaluator ( + int N_, double* statevector, + const Epetra_Comm& comm_, void* blackbox_res_) + : N(N_), comm(comm_), blackbox_res(blackbox_res_) +{ + bool succeeded=true; + try { + xMap = Teuchos::rcp(new Epetra_Map(-1, N, 0, comm)); + xVec = Teuchos::rcp(new Epetra_Vector(Copy, *xMap, statevector)); + + precOp = Teuchos::rcp(new trilinosPreconditioner(N, xVec, xMap, blackbox_res)); + + pMap = Teuchos::rcp(new Epetra_LocalMap(1, 0, comm)); + pVec = Teuchos::rcp(new Epetra_Vector(*pMap)); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, succeeded); + if (!succeeded) exit(1); +} + +/*******************************************************************************/ +// Return solution vector map +Teuchos::RCP trilinosModelEvaluator::get_x_map() const{ + return xMap; +} + +// Return residual vector map +Teuchos::RCP trilinosModelEvaluator::get_f_map() const{ + return xMap; +} + +// Return initial solution and x_dot init +Teuchos::RCP trilinosModelEvaluator::get_x_init() const{ + return xVec; +} + +Teuchos::RCP +trilinosModelEvaluator::create_WPrec() const +{ + // bool is answer to: "Prec is already inverted?" + return Teuchos::rcp(new EpetraExt::ModelEvaluator::Preconditioner(precOp,true)); +} + +Teuchos::RCP trilinosModelEvaluator::get_p_map(int l) const{ + return pMap; +} +Teuchos::RCP trilinosModelEvaluator::get_p_init(int l) const{ + return pVec; +} +Teuchos::RCP > trilinosModelEvaluator::get_p_names(int l) const{ + RCP > p_names = + rcp(new Teuchos::Array(1) ); + (*p_names)[0] = "Effstrmin Factor"; + + return p_names; +} + +/*******************************************************************************/ +// Create InArgs +EpetraExt::ModelEvaluator::InArgs trilinosModelEvaluator::createInArgs() const{ + InArgsSetup inArgs; + + inArgs.setModelEvalDescription(this->description()); + inArgs.setSupports(IN_ARG_x,true); + inArgs.set_Np(1); + return inArgs; +} + +/*******************************************************************************/ +// Create OutArgs +EpetraExt::ModelEvaluator::OutArgs trilinosModelEvaluator::createOutArgs() const{ + OutArgsSetup outArgs; + outArgs.setModelEvalDescription(this->description()); + outArgs.set_Np_Ng(1, 0); + outArgs.setSupports(OUT_ARG_f,true); + outArgs.setSupports(OUT_ARG_WPrec, true); + + return outArgs; +} + +/*******************************************************************************/ +// Evaluate model on InArgs +void trilinosModelEvaluator::evalModel(const InArgs& inArgs, const OutArgs& outArgs) const{ + + // Get the solution vector x from inArgs and residual vector from outArgs + RCP x = inArgs.get_x(); + EpetraExt::ModelEvaluator::Evaluation f = outArgs.get_f(); + + if (x == Teuchos::null) throw "trilinosModelEvaluator::evalModel: x was NOT specified!"; + + // Check if a "Effminstr Factor" parameter is being set by LOCA + Teuchos::RCP p_in = inArgs.get_p(0); + if (p_in.get()) reset_effstrmin(&(*p_in)[0]); + + // Save the current solution, which makes it initial guess for next nonlienar solve + *xVec = *x; + + if (f != Teuchos::null) { + // Check if this is a perturbed eval. Glimmer only saves off matrices for unperturbed case. + int ispert =0; + if (f.getType() == EpetraExt::ModelEvaluator::EVAL_TYPE_APPROX_DERIV) ispert=1; + + f->PutScalar(0.0); + calc_F(x->Values(), f->Values(), N, blackbox_res, ispert); + } + + RCP WPrec = outArgs.get_WPrec(); + if (WPrec != Teuchos::null) { + //cout << "evalModel called for WPrec -- doing nothing " << endl; + } +} +/*******************************************************************************/ +/*******************************************************************************/ +/*******************************************************************************/ +trilinosPreconditioner::trilinosPreconditioner ( + int N_, RCP xVec_, RCP xMap_, void* blackbox_res_) + : N(N_), xVec(xVec_), xMap(xMap_), blackbox_res(blackbox_res_) +{ +} + +int trilinosPreconditioner::ApplyInverse(const Epetra_MultiVector& X, Epetra_MultiVector& Y) const +{ + bool succeeded=true; + try { + apply_precond_nox(Y(0)->Values(), X(0)->Values(), N, blackbox_res); + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, succeeded); + if (!succeeded) exit(1); + + return 0; +} + + diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.hpp b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.hpp new file mode 100644 index 0000000000..b175d84c91 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosModelEvaluator.hpp @@ -0,0 +1,97 @@ +#ifndef GLIMMER_MODELEVALUATOR_HPP +#define GLIMMER_MODELEVALUATOR_HPP + +#include "Teuchos_RCP.hpp" +#include "EpetraExt_ModelEvaluator.h" +#include "Epetra_Map.h" +#include "Epetra_LocalMap.h" +#include "Epetra_Comm.h" +#include "Epetra_Operator.h" + +using Teuchos::RCP; + + +class trilinosModelEvaluator : public EpetraExt::ModelEvaluator { +public: + + + trilinosModelEvaluator(int N_, + double* statevector, + const Epetra_Comm& comm_, + void* blackbox_res); + //@{ + + //! Return solution vector map + RCP get_x_map() const; + + //! Return residual vector map + RCP get_f_map() const; + + //! Return initial solution and x_dot init + RCP get_x_init() const; + + RCP create_WPrec() const; + + //! Parameter setting functions for LOCA continuation + RCP get_p_map(int l) const; + RCP get_p_init(int l) const; + RCP > get_p_names(int l) const; + + //! Create InArgs + InArgs createInArgs() const; + + //! Create OutArgs + OutArgs createOutArgs() const; + + //! Reset State + // void ResetState(double *statevector,void* blackbox_res_); + + //! Evaluate model on InArgs + void evalModel(const InArgs& inArgs, const OutArgs& outArgs) const; + //@} + +private: + // Solution vector and map + int N; + RCP xMap; + RCP xVec; + const Epetra_Comm& comm; + void* blackbox_res; + RCP precOp; + + RCP pMap; + RCP pVec; +}; + + +class trilinosPreconditioner : public Epetra_Operator { + +public: + // Preconditioner as Epetra_Operator required methods + + trilinosPreconditioner(int N, RCP xVec, RCP xMap, + void* blackbox_res); + + int ApplyInverse(const Epetra_MultiVector& V, Epetra_MultiVector& Y) const; + + // Trivial implemetations + int SetUseTranspose(bool UseTranspose) { TEUCHOS_TEST_FOR_EXCEPT(UseTranspose); return 0;}; + int Apply(const Epetra_MultiVector& X, Epetra_MultiVector& Y) const + { throw "No Apply() in TrilinosPreconditioner";}; + double NormInf() const { throw "NO NormInf Implemented in trilinosPrecon";}; + const char* Label () const { return "trilinosPrec"; }; + bool UseTranspose() const { return false; }; + bool HasNormInf() const { return false; }; + const Epetra_Comm & Comm() const { return xMap->Comm();}; + const Epetra_Map& OperatorDomainMap () const { return *xMap;}; + const Epetra_Map& OperatorRangeMap () const { return *xMap;}; + +private: + int N; + RCP xVec; + RCP xMap; + void* blackbox_res; +}; + +#endif + diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosNoxSolver.cpp b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosNoxSolver.cpp new file mode 100644 index 0000000000..b052fa6a08 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosNoxSolver.cpp @@ -0,0 +1,200 @@ +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// trilinosNoxSolver.cpp - part of the Community Ice Sheet Model (CISM) +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Copyright (C) 2005-2014 +// CISM contributors - see AUTHORS file for list of contributors +// +// This file is part of CISM. +// +// CISM is free software: you can redistribute it and/or modify it +// under the terms of the Lesser GNU General Public License as published +// by the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// CISM is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// Lesser GNU General Public License for more details. +// +// You should have received a copy of the Lesser GNU General Public License +// along with CISM. If not, see . +// +//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +// Trilinos Objects +#include "Piro_Epetra_NOXSolver.hpp" +#include "Piro_Epetra_LOCASolver.hpp" +#include "trilinosModelEvaluator.hpp" + +#include "Epetra_MpiComm.h" +#include "Teuchos_RCP.hpp" +#include "Teuchos_ParameterList.hpp" +#include "Teuchos_XMLParameterListHelpers.hpp" +#include "Teuchos_StandardCatchMacros.hpp" + +#include "Teuchos_DefaultMpiComm.hpp" + +#include "config.inc" + +using namespace std; +using Teuchos::RCP; +using Teuchos::rcp; + +// Objects that are global to the file +static RCP Nsolver; +static RCP model; +static RCP paramList; +static RCP Comm_; + +static EpetraExt::ModelEvaluator::InArgs inArgs; +static EpetraExt::ModelEvaluator::OutArgs outArgs; +static bool printProc; +static int timeStep=1; // time step counter +// Use continuation instead of straight Newton for this many time steps: + +void setCismLocaDefaults(Teuchos::ParameterList& locaList) { + Teuchos::ParameterList& predList = locaList.sublist("Predictor"); + Teuchos::ParameterList& stepperList = locaList.sublist("Stepper"); + Teuchos::ParameterList& stepSizeList = locaList.sublist("Step Size"); + + // If not set in XML list, set these defaults instead + (void) predList.get("Method","Constant"); + (void) stepperList.get("Continuation Method","Natural"); + (void) stepperList.get("Continuation Parameter","Effstrmin Factor"); + (void) stepperList.get("Initial Value",10.0); + (void) stepperList.get("Max Steps",10); + (void) stepperList.get("Max Value",100.0); // not used + (void) stepperList.get("Min Value",0.0); // Important!! + + (void) stepSizeList.get("Initial Step Size",-3.0); // Important!! + (void) stepSizeList.get("Aggressiveness",2.0); // Important!! +} + + +extern "C" { +void FC_FUNC(noxinit,NOXINIT) ( int* nelems, double* statevector, + int* mpi_comm_f, void* blackbox_res) +// mpi_comm_f: CISM's fortran mpi communicator +{ + + bool succeeded=true; + try { + + // Build the epetra communicator + MPI_Comm mpi_comm_c = MPI_Comm_f2c(*mpi_comm_f); + Comm_=rcp(new Epetra_MpiComm(mpi_comm_c)); + Epetra_Comm& Comm=*Comm_; + printProc = (Comm_->MyPID() == 0); + Teuchos::MpiComm tcomm(Teuchos::opaqueWrapper(mpi_comm_c)); + + if (printProc) std::cout << "NOXINIT CALLED for nelem=" << *nelems << std::endl; + + try { // Check that the parameter list is valid at the top + RCP pl = + rcp(new Teuchos::ParameterList("Trilinos Options for NOX")); + Teuchos::updateParametersFromXmlFileAndBroadcast( + "trilinosOptions.xml", pl.ptr(),tcomm); + + Teuchos::ParameterList validPL("Valid List");; + validPL.sublist("Stratimikos"); validPL.sublist("Piro"); + pl->validateParameters(validPL, 0); + paramList = Teuchos::sublist(pl,"Piro",true); + } + catch (std::exception& e) { + std::cout << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" + << e.what() << "\nExiting: Invalid trilinosOptions.xml file." + << "\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" << std::endl; + exit(1); + } + + paramList->set("Lean Matrix Free",true); // Saves some GMRES steps + //pw if (printProc) std::cout << "NOXInit: param list is: (delete this debug line)\n" << *paramList << std::endl; + + model = rcp(new trilinosModelEvaluator(*nelems, statevector, Comm, blackbox_res)); + + // Logic to see if we want to use LOCA continuation or NOX single steady solve + // Turn on LOCA by having a LOCA sublist OR setting "CISM: Number of Time Steps To Use LOCA" + bool useLoca=false; + // If LOCA sublist exists, defaults to using it for 1 time step; but can be set in XML. + int numStepsToUseLOCA = 0; + if (paramList->isSublist("LOCA")) + numStepsToUseLOCA = paramList->get("CISM: Number of Time Steps To Use LOCA",1); + else + numStepsToUseLOCA = paramList->get("CISM: Number of Time Steps To Use LOCA",0); + + if (timeStep <= numStepsToUseLOCA) useLoca=true; + + if (useLoca) if (printProc) + std::cout << "\nUsing LOCA continuation for first " << numStepsToUseLOCA << " time steps." << std::endl; + + if (useLoca) { + setCismLocaDefaults(paramList->sublist("LOCA")); + Nsolver = rcp(new Piro::Epetra::LOCASolver(paramList, model)); + } + else + Nsolver = rcp(new Piro::Epetra::NOXSolver(paramList, model)); + + inArgs=Nsolver->createInArgs(); + outArgs=Nsolver->createOutArgs(); + + // Ask the model for the converged solution from g(0) + RCP xmap = Nsolver->get_g_map(0); + RCP xout = rcp(new Epetra_Vector(*xmap)); + + outArgs.set_g(0,xout); + + // Set up parameter vector for continuation runs + if (useLoca) { + RCP pmap = Nsolver->get_p_map(0); + RCP pvec = rcp(new Epetra_Vector(*pmap)); + inArgs.set_p(0, pvec); + } + + // Time step counter: just for deciding whether to use continuation on relaxatin param + timeStep++; + + } //end try block + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, succeeded); + if (!succeeded) exit(1); +} + +/****************************************************/ +void FC_FUNC(noxsolve,NOXSOLVE) (int* nelems, double* statevector, void* blackbox_res) +{ + bool succeeded=true; + try { + TEUCHOS_TEST_FOR_EXCEPTION(Nsolver==Teuchos::null, logic_error, + "Exception: noxsolve called with solver=null: \n" + << "You either did not call noxinit first, or called noxfinish already"); + if (printProc) std::cout << "NOXSolve called" << std::endl; + + // Solve + Nsolver->evalModel(inArgs,outArgs); + + // Copy out the solution + RCP xout = outArgs.get_g(0); + if(xout == Teuchos::null) throw "evalModel is NOT returning a vector"; + + for (int i=0; i<*nelems; i++) statevector[i] = (*xout)[i]; + } + TEUCHOS_STANDARD_CATCH_STATEMENTS(true, std::cerr, succeeded); + if (!succeeded) exit(1); + +} + +/****************************************************/ +void FC_FUNC(noxfinish,NOXFINISH) (void) +{ + if (printProc) std::cout << "NOXFinish called" << std::endl; + + // Free memory + Nsolver = Teuchos::null; + model = Teuchos::null; + paramList = Teuchos::null; + Comm_ = Teuchos::null; +} + +} //extern "C" diff --git a/components/cism/glimmer-cism/libglimmer-trilinos/trilinosOptions.xml b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosOptions.xml new file mode 100644 index 0000000000..9507c0751b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer-trilinos/trilinosOptions.xml @@ -0,0 +1,105 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/cism/glimmer-cism/libglimmer/cfortran.h b/components/cism/glimmer-cism/libglimmer/cfortran.h new file mode 100644 index 0000000000..ed23011d84 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/cfortran.h @@ -0,0 +1,2363 @@ +/* cfortran.h 4.3 */ +/* http://www-zeus.desy.de/~burow/cfortran/ */ +/* Burkhard Burow burow@desy.de 1990 - 2001. */ + +#ifndef __CFORTRAN_LOADED +#define __CFORTRAN_LOADED + +/* + THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU + SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING, + MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE. +*/ + +/* + Avoid symbols already used by compilers and system *.h: + __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c + + */ + + +/* First prepare for the C compiler. */ + +#ifndef ANSI_C_preprocessor /* i.e. user can override. */ +#ifdef __CF__KnR +#define ANSI_C_preprocessor 0 +#else +#ifdef __STDC__ +#define ANSI_C_preprocessor 1 +#else +#define _cfleft 1 +#define _cfright +#define _cfleft_cfright 0 +#define ANSI_C_preprocessor _cfleft/**/_cfright +#endif +#endif +#endif + +#if ANSI_C_preprocessor +#define _0(A,B) A##B +#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */ +#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */ +#define _3(A,B,C) _(A,_(B,C)) +#else /* if it turns up again during rescanning. */ +#define _(A,B) A/**/B +#define _2(A,B) A/**/B +#define _3(A,B,C) A/**/B/**/C +#endif + +#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__)) +#define VAXUltrix +#endif + +#include /* NULL [in all machines stdio.h] */ +#include /* strlen, memset, memcpy, memchr. */ +#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) ) +#include /* malloc,free */ +#else +#include /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/ +#ifdef apollo +#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */ +#endif +#endif + +#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx)) +#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */ + /* Manually define __CF__KnR for HP if desired/required.*/ +#endif /* i.e. We will generate Kernighan and Ritchie C. */ +/* Note that you may define __CF__KnR before #include cfortran.h, in order to +generate K&R C instead of the default ANSI C. The differences are mainly in the +function prototypes and declarations. All machines, except the Apollo, work +with either style. The Apollo's argument promotion rules require ANSI or use of +the obsolete std_$call which we have not implemented here. Hence on the Apollo, +only C calling FORTRAN subroutines will work using K&R style.*/ + + +/* Remainder of cfortran.h depends on the Fortran compiler. */ + +#if defined(CLIPPERFortran) || defined(pgiFortran) +#define f2cFortran +#endif + +/* VAX/VMS does not let us \-split long #if lines. */ +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If no Fortran compiler is given, we choose one for the machines we know. */ +#if defined(lynx) || defined(VAXUltrix) +#define f2cFortran /* Lynx: Only support f2c at the moment. + VAXUltrix: f77 behaves like f2c. + Support f2c or f77 with gcc, vcc with f2c. + f77 with vcc works, missing link magic for f77 I/O.*/ +#endif +#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */ +#define hpuxFortran /* Should also allow hp9000s7/800 use.*/ +#endif +#if defined(apollo) +#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */ +#endif +#if defined(sun) || defined(__sun) +#define sunFortran +#endif +#if defined(_IBMR2) +#define IBMR2Fortran +#endif +#if defined(_CRAY) +#define CRAYFortran /* _CRAYT3E also defines some behavior. */ +#endif +#if defined(_SX) +#define SXFortran +#endif +#if defined(mips) || defined(__mips) +#define mipsFortran +#endif +#if defined(vms) || defined(__vms) +#define vmsFortran +#endif +#if defined(__alpha) && defined(__unix__) +#define DECFortran +#endif +#if defined(__convex__) +#define CONVEXFortran +#endif +#if defined(VISUAL_CPLUSPLUS) +#define PowerStationFortran +#endif +#endif /* ...Fortran */ +#endif /* ...Fortran */ + +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If your compiler barfs on ' #error', replace # with the trigraph for # */ + #error "cfortran.h: Can't find your environment among:\ + - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \ + - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \ + - VAX VMS CC 3.1 and FORTRAN 5.4. \ + - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \ + - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \ + - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \ + - CRAY \ + - NEC SX-4 SUPER-UX \ + - CONVEX \ + - Sun \ + - PowerStation Fortran with Visual C++ \ + - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \ + - LynxOS: cc or gcc with f2c. \ + - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \ + - f77 with vcc works; but missing link magic for f77 I/O. \ + - NO fort. None of gcc, cc or vcc generate required names.\ + - f2c : Use #define f2cFortran, or cc -Df2cFortran \ + - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \ + - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \ + - Absoft Pro Fortran: Use #define AbsoftProFortran \ + - Portland Group Fortran: Use #define pgiFortran" +/* Compiler must throw us out at this point! */ +#endif +#endif + + +#if defined(VAXC) && !defined(__VAXC) +#define OLD_VAXC +#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */ +#endif + +/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */ + +#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname) +#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#else +#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran) +#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */ +#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ +#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */ +#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */ +#endif +#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */ +#else /* For following machines one may wish to change the fcallsc default. */ +#define CF_SAME_NAMESPACE +#ifdef vmsFortran +#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */ + /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/ + /* because VAX/VMS doesn't do recursive macros. */ +#define orig_fcallsc(UN,LN) UN +#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */ +#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#endif /* vmsFortran */ +#endif /* CRAYFortran PowerStationFortran */ +#endif /* ....Fortran */ + +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN)) +#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p)) + +#define C_FUNCTION(UN,LN) fcallsc(UN,LN) +#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN) + +#ifndef COMMON_BLOCK +#ifndef CONVEXFortran +#ifndef CLIPPERFortran +#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)) +#define COMMON_BLOCK(UN,LN) CFC_(UN,LN) +#else +#define COMMON_BLOCK(UN,LN) _(_C,LN) +#endif /* AbsoftUNIXFortran or AbsoftProFortran */ +#else +#define COMMON_BLOCK(UN,LN) _(LN,__) +#endif /* CLIPPERFortran */ +#else +#define COMMON_BLOCK(UN,LN) _3(_,LN,_) +#endif /* CONVEXFortran */ +#endif /* COMMON_BLOCK */ + +#ifndef DOUBLE_PRECISION +#if defined(CRAYFortran) && !defined(_CRAYT3E) +#define DOUBLE_PRECISION long double +#else +#define DOUBLE_PRECISION double +#endif +#endif + +#ifndef FORTRAN_REAL +#if defined(CRAYFortran) && defined(_CRAYT3E) +#define FORTRAN_REAL double +#else +#define FORTRAN_REAL float +#endif +#endif + +#ifdef CRAYFortran +#ifdef _CRAY +#include +#else +#include "fortran.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */ +/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/ +#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine + arg.'s have been declared float *, or double *. */ +#else +#define FLOATVVVVVVV_cfPP +#define VOIDP +#endif + +#ifdef vmsFortran +#if defined(vms) || defined(__vms) +#include +#else +#include "descrip.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#endif + +#ifdef sunFortran +#if defined(sun) || defined(__sun) +#include /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */ +#else +#include "math.h" /* i.e. if crosscompiling assume user has file. */ +#endif +/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3, + * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in + * , since sun C no longer promotes C float return values to doubles. + * Therefore, only use them if defined. + * Even if gcc is being used, assume that it exhibits the Sun C compiler + * behavior in order to be able to use *.o from the Sun C compiler. + * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc. + */ +#endif + +#ifndef apolloFortran +#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME +#define CF_NULL_PROTO +#else /* HP doesn't understand #elif. */ +/* Without ANSI prototyping, Apollo promotes float functions to double. */ +/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */ +#define CF_NULL_PROTO ... +#ifndef __CF__APOLLO67 +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME __attribute((__section(NAME))) +#else +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME #attribute[section(NAME)] +#endif +#endif + +#ifdef __cplusplus +#undef CF_NULL_PROTO +#define CF_NULL_PROTO ... +#endif + + +#ifndef USE_NEW_DELETE +#ifdef __cplusplus +#define USE_NEW_DELETE 1 +#else +#define USE_NEW_DELETE 0 +#endif +#endif +#if USE_NEW_DELETE +#define _cf_malloc(N) new char[N] +#define _cf_free(P) delete[] P +#else +#define _cf_malloc(N) (char *)malloc(N) +#define _cf_free(P) free(P) +#endif + +#ifdef mipsFortran +#define CF_DECLARE_GETARG int f77argc; char **f77argv +#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV +#else +#define CF_DECLARE_GETARG +#define CF_SET_GETARG(ARGC,ARGV) +#endif + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define AcfCOMMA , +#define AcfCOLON ; + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES USED WITHIN CFORTRAN.H */ + +#define _cfMIN(A,B) (As) { /* Need this to handle NULL string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally +points to the terminating '\0' of s, but may actually point to anywhere in s. +s's new '\0' will be placed at e or earlier in order to remove any trailing t's. +If es) { /* Watch out for neg. length string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* Note the following assumes that any element which has t's to be chopped off, +does indeed fill the entire element. */ +#ifndef __CF__KnR +static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) +#else +static char *vkill_trailing( cstr, elem_len, sizeofcstr, t) + char* cstr; int elem_len; int sizeofcstr; char t; +#endif +{ int i; +for (i=0; i= 4.3 gives message: + zow35> cc -c -DDECFortran cfortest.c + cfe: Fatal: Out of memory: cfortest.c + zow35> + Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine + if using -Aa, otherwise we have a problem. + */ +#ifndef MAX_PREPRO_ARGS +#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR))) +#define MAX_PREPRO_ARGS 31 +#else +#define MAX_PREPRO_ARGS 99 +#endif +#endif + +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +/* In addition to explicit Absoft stuff, only Absoft requires: + - DEFAULT coming from _cfSTR. + DEFAULT could have been called e.g. INT, but keep it for clarity. + - M term in CFARGT14 and CFARGT14FS. + */ +#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0) +#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0) +#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0) +#define DEFAULT_cfABSOFT1 +#define LOGICAL_cfABSOFT1 +#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING +#define DEFAULT_cfABSOFT2 +#define LOGICAL_cfABSOFT2 +#define STRING_cfABSOFT2 ,unsigned D0 +#define DEFAULT_cfABSOFT3 +#define LOGICAL_cfABSOFT3 +#define STRING_cfABSOFT3 ,D0 +#else +#define ABSOFT_cf1(T0) +#define ABSOFT_cf2(T0) +#define ABSOFT_cf3(T0) +#endif + +/* _Z introduced to cicumvent IBM and HP silly preprocessor warning. + e.g. "Macro CFARGT14 invoked with a null argument." + */ +#define _Z + +#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) + +#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#if !(defined(PowerStationFortran)||defined(hpuxFortran800)) +/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields: + SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c + "c.c", line 406: warning: argument mismatch + Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok. + Behavior is most clearly seen in example: + #define A 1 , 2 + #define C(X,Y,Z) x=X. y=Y. z=Z. + #define D(X,Y,Z) C(X,Y,Z) + D(x,A,z) + Output from preprocessor is: x = x . y = 1 . z = 2 . + #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +*/ +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \ + S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \ + F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \ + S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \ + S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \ + S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) +#endif +#else +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \ + F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \ + F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \ + F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \ + F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27) +#endif +#endif + + +#define PROTOCCALLSFSUB1( UN,LN,T1) \ + PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) + +#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef FCALLSC_QUALIFIER +#ifdef VISUAL_CPLUSPLUS +#define FCALLSC_QUALIFIER __stdcall +#else +#define FCALLSC_QUALIFIER +#endif +#endif + +#ifdef __cplusplus +#define CFextern extern "C" +#else +#define CFextern extern +#endif + + +#ifdef CFSUBASFUN +#define PROTOCCALLSFSUB0(UN,LN) \ + PROTOCCALLSFFUN0( VOID,UN,LN) +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after + #include-ing cfortran.h if calling the FORTRAN wrapper within the same + source code where the wrapper is created. */ +#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))(); +#ifndef __CF__KnR +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ); +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) ); +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ); +#else +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB0(UN,LN) +#endif +#endif + + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + + +#define CCALLSFSUB1( UN,LN,T1, A1) \ + CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \ + CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#ifdef __cplusplus +#define CPPPROTOCLSFSUB0( UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +#define CPPPROTOCLSFSUB0(UN,LN) \ + PROTOCCALLSFSUB0(UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#endif + +#ifdef CFSUBASFUN +#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) +#else +/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */ +#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \ + CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \ + ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \ + ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \ + ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \ + CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \ + WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0) +#endif + + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0) +#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0) +#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0) +#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0) +#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) +#else +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0) +#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0) +#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0) +#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0) +#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0) +#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) +#else +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \ + VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \ + CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \ + ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \ + CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \ + WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ + +/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN + function is called. Therefore, especially for creator's of C header files + for large FORTRAN libraries which include many functions, to reduce + compile time and object code size, it may be desirable to create + preprocessor directives to allow users to create code for only those + functions which they use. */ + +/* The following defines the maximum length string that a function can return. + Of course it may be undefine-d and re-define-d before individual + PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived + from the individual machines' limits. */ +#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE + +/* The following defines a character used by CFORTRAN.H to flag the end of a + string coming out of a FORTRAN routine. */ +#define CFORTRAN_NON_CHAR 0x7F + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA) +#define __SEP_0(TN,cfCOMMA) +#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0) +#define INT_cfSEP(T,B) _(A,B) +#define INTV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define PINT_cfSEP(T,B) INT_cfSEP(T,B) +#define PVOID_cfSEP(T,B) INT_cfSEP(T,B) +#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B) +#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B) +#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/ +#define STRING_cfSEP(T,B) INT_cfSEP(T,B) +#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) + +#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE) +#ifdef OLD_VAXC +#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */ +#else +#define INTEGER_BYTE signed char /* default */ +#endif +#else +#define INTEGER_BYTE unsigned char +#endif +#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE +#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION +#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL +#define INTVVVVVVV_cfTYPE int +#define LOGICALVVVVVVV_cfTYPE int +#define LONGVVVVVVV_cfTYPE long +#define SHORTVVVVVVV_cfTYPE short +#define PBYTE_cfTYPE INTEGER_BYTE +#define PDOUBLE_cfTYPE DOUBLE_PRECISION +#define PFLOAT_cfTYPE FORTRAN_REAL +#define PINT_cfTYPE int +#define PLOGICAL_cfTYPE int +#define PLONG_cfTYPE long +#define PSHORT_cfTYPE short + +#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A) +#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V) +#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W) +#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X) +#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y) +#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z) + +#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0) +#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z) +#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0) +#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0) +#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0) +#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0) +#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0) +#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0) +#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0) +#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +/*CRAY coughs on the first, + i.e. the usual trouble of not being able to + define macros to macros with arguments. + New ultrix is worse, it coughs on all such uses. + */ +/*#define SIMPLE_cfINT PVOID_cfINT*/ +#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define CF_0_cfINT(N,A,B,X,Y,Z) + + +#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0) +#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I) +#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0) +#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A +#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A +#define PINT_cfU(T,A) _(T,_cfTYPE) * A +#define PVOID_cfU(T,A) void *A +#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) +#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */ +#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */ +#define STRINGV_cfU(T,A) char *A +#define PSTRING_cfU(T,A) char *A +#define PSTRINGV_cfU(T,A) char *A +#define ZTRINGV_cfU(T,A) char *A +#define PZTRINGV_cfU(T,A) char *A + +/* VOID breaks U into U and UU. */ +#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A +#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */ +#define STRING_cfUU(T,A) char *A + + +#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A +#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A +#else +#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A +#endif +#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A +#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A +#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A +#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A + +#define BYTE_cfE INTEGER_BYTE A0; +#define DOUBLE_cfE DOUBLE_PRECISION A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfE FORTRAN_REAL A0; +#else +#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0; +#endif +#define INT_cfE int A0; +#define LOGICAL_cfE int A0; +#define LONG_cfE long A0; +#define SHORT_cfE short A0; +#define VOID_cfE +#ifdef vmsFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static fstring A0 = \ + {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ + memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#else +#ifdef CRAYFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\ + memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING); +#else +/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; + * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */ +#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + memset(A0, CFORTRAN_NON_CHAR, \ + MAX_LEN_FORTRAN_FUNCTION_STRING); \ + *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#endif +#endif +/* ESTRING must use static char. array which is guaranteed to exist after + function returns. */ + +/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. + ii)That the following create an unmatched bracket, i.e. '(', which + must of course be matched in the call. + iii)Commas must be handled very carefully */ +#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)( +#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)( +#ifdef vmsFortran +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0 +#else +#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0 +#else +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING +#endif +#endif + +#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN) +#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN) +#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/ + +#define BYTEVVVVVVV_cfPP +#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */ +#define DOUBLEVVVVVVV_cfPP +#define LOGICALVVVVVVV_cfPP +#define LONGVVVVVVV_cfPP +#define SHORTVVVVVVV_cfPP +#define PBYTE_cfPP +#define PINT_cfPP +#define PDOUBLE_cfPP +#define PLOGICAL_cfPP +#define PLONG_cfPP +#define PSHORT_cfPP +#define PFLOAT_cfPP FLOATVVVVVVV_cfPP + +#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0) +#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A +#define INTV_cfB(T,A) A +#define INTVV_cfB(T,A) (A)[0] +#define INTVVV_cfB(T,A) (A)[0][0] +#define INTVVVV_cfB(T,A) (A)[0][0][0] +#define INTVVVVV_cfB(T,A) (A)[0][0][0][0] +#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0] +#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0] +#define PINT_cfB(T,A) _(T,_cfPP)&A +#define STRING_cfB(T,A) (char *) A +#define STRINGV_cfB(T,A) (char *) A +#define PSTRING_cfB(T,A) (char *) A +#define PSTRINGV_cfB(T,A) (char *) A +#define PVOID_cfB(T,A) (void *) A +#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A +#define ZTRINGV_cfB(T,A) (char *) A +#define PZTRINGV_cfB(T,A) (char *) A + +#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0) +#define DEFAULT_cfS(M,I,A) +#define LOGICAL_cfS(M,I,A) +#define PLOGICAL_cfS(M,I,A) +#define STRING_cfS(M,I,A) ,sizeof(A) +#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \ + +secondindexlength(A)) +#define PSTRING_cfS(M,I,A) ,sizeof(A) +#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A) +#define ZTRINGV_cfS(M,I,A) +#define PZTRINGV_cfS(M,I,A) + +#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0) +#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0) +#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0) +#define H_CF_SPECIAL unsigned +#define HH_CF_SPECIAL +#define DEFAULT_cfH(M,I,A) +#define LOGICAL_cfH(S,U,B) +#define PLOGICAL_cfH(S,U,B) +#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B +#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define ZTRINGV_cfH(S,U,B) +#define PZTRINGV_cfH(S,U,B) + +/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */ +/* No spaces inside expansion. They screws up macro catenation kludge. */ +#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E) +#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E) +#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E) +#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E) +#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E) +#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E) +#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E) +#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E) +#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E) +#define CF_0_cfSTR(N,T,A,B,C,D,E) + +/* See ACF table comments, which explain why CCF was split into two. */ +#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I)) +#define DEFAULT_cfC(M,I,A,B,C) +#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A); +#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A); +#ifdef vmsFortran +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0')); + /* PSTRING_cfC to beware of array A which does not contain any \0. */ +#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \ + B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \ + memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1)); +#else +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A), \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0')); +#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \ + (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1)); +#endif + /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */ +#define STRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define PSTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define ZTRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) +#define PZTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) + +#define BYTE_cfCCC(A,B) &A +#define DOUBLE_cfCCC(A,B) &A +#if !defined(__CF__KnR) +#define FLOAT_cfCCC(A,B) &A + /* Although the VAX doesn't, at least the */ +#else /* HP and K&R mips promote float arg.'s of */ +#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */ +#endif /* use A here to pass the argument to FORTRAN. */ +#define INT_cfCCC(A,B) &A +#define LOGICAL_cfCCC(A,B) &A +#define LONG_cfCCC(A,B) &A +#define SHORT_cfCCC(A,B) &A +#define PBYTE_cfCCC(A,B) A +#define PDOUBLE_cfCCC(A,B) A +#define PFLOAT_cfCCC(A,B) A +#define PINT_cfCCC(A,B) A +#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */ +#define PLONG_cfCCC(A,B) A +#define PSHORT_cfCCC(A,B) A + +#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I)) +#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define INTV_cfCC(T,A,B) A +#define INTVV_cfCC(T,A,B) A +#define INTVVV_cfCC(T,A,B) A +#define INTVVVV_cfCC(T,A,B) A +#define INTVVVVV_cfCC(T,A,B) A +#define INTVVVVVV_cfCC(T,A,B) A +#define INTVVVVVVV_cfCC(T,A,B) A +#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define PVOID_cfCC(T,A,B) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfCC(T,A,B) &A +#else +#define ROUTINE_cfCC(T,A,B) A +#endif +#define SIMPLE_cfCC(T,A,B) A +#ifdef vmsFortran +#define STRING_cfCC(T,A,B) &B.f +#define STRINGV_cfCC(T,A,B) &B +#define PSTRING_cfCC(T,A,B) &B +#define PSTRINGV_cfCC(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen) +#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen) +#define PSTRING_cfCC(T,A,B) _cptofcd(A,B) +#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen) +#else +#define STRING_cfCC(T,A,B) A +#define STRINGV_cfCC(T,A,B) B.fs +#define PSTRING_cfCC(T,A,B) A +#define PSTRINGV_cfCC(T,A,B) B.fs +#endif +#endif +#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B) +#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B) + +#define BYTE_cfX return A0; +#define DOUBLE_cfX return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfX return A0; +#else +#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0; +#endif +#define INT_cfX return A0; +#define LOGICAL_cfX return F2CLOGICAL(A0); +#define LONG_cfX return A0; +#define SHORT_cfX return A0; +#define VOID_cfX return ; +#if defined(vmsFortran) || defined(CRAYFortran) +#define STRING_cfX return kill_trailing( \ + kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); +#else +#define STRING_cfX return kill_trailing( \ + kill_trailing( A0,CFORTRAN_NON_CHAR),' '); +#endif + +#define CFFUN(NAME) _(__cf__,NAME) + +/* Note that we don't use LN here, but we keep it for consistency. */ +#define CCALLSFFUN0(UN,LN) CFFUN(UN)() + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define CCALLSFFUN1( UN,LN,T1, A1) \ + CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \ + CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \ + BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \ + BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \ + SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \ + SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \ + SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \ + SCF(TD,LN,13,AD) SCF(TE,LN,14,AE)))) + +/* N.B. Create a separate function instead of using (call function, function +value here) because in order to create the variables needed for the input +arg.'s which may be const.'s one has to do the creation within {}, but these +can never be placed within ()'s. Therefore one must create wrapper functions. +gcc, on the other hand may be able to avoid the wrapper functions. */ + +/* Prototypes are needed to correctly handle the value returned correctly. N.B. +Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN +functions returning strings have extra arg.'s. Don't bother, since this only +causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn +for the same function in the same source code. Something done by the experts in +debugging only.*/ + +#define PROTOCCALLSFFUN0(F,UN,LN) \ +_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \ +static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)} + +#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0) +#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0) +#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */ + +#ifndef __CF__KnR +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#else +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#endif + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#if defined(vmsFortran) || defined(CRAYFortran) +#define DCF(TN,I) +#define DDCF(TN,I) +#define DDDCF(TN,I) +#else +#define DCF(TN,I) HCF(TN,I) +#define DDCF(TN,I) HHCF(TN,I) +#define DDDCF(TN,I) HHHCF(TN,I) +#endif + +#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0) +#define DEFAULT_cfQ(B) +#define LOGICAL_cfQ(B) +#define PLOGICAL_cfQ(B) +#define STRINGV_cfQ(B) char *B; unsigned int _(B,N); +#define STRING_cfQ(B) char *B=NULL; +#define PSTRING_cfQ(B) char *B=NULL; +#define PSTRINGV_cfQ(B) STRINGV_cfQ(B) +#define PNSTRING_cfQ(B) char *B=NULL; +#define PPSTRING_cfQ(B) + +#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */ +#define ROUTINE_orig *(void**)& +#else +#define ROUTINE_orig (void *) +#endif + +#define ROUTINE_1 ROUTINE_orig +#define ROUTINE_2 ROUTINE_orig +#define ROUTINE_3 ROUTINE_orig +#define ROUTINE_4 ROUTINE_orig +#define ROUTINE_5 ROUTINE_orig +#define ROUTINE_6 ROUTINE_orig +#define ROUTINE_7 ROUTINE_orig +#define ROUTINE_8 ROUTINE_orig +#define ROUTINE_9 ROUTINE_orig +#define ROUTINE_10 ROUTINE_orig +#define ROUTINE_11 ROUTINE_orig +#define ROUTINE_12 ROUTINE_orig +#define ROUTINE_13 ROUTINE_orig +#define ROUTINE_14 ROUTINE_orig +#define ROUTINE_15 ROUTINE_orig +#define ROUTINE_16 ROUTINE_orig +#define ROUTINE_17 ROUTINE_orig +#define ROUTINE_18 ROUTINE_orig +#define ROUTINE_19 ROUTINE_orig +#define ROUTINE_20 ROUTINE_orig +#define ROUTINE_21 ROUTINE_orig +#define ROUTINE_22 ROUTINE_orig +#define ROUTINE_23 ROUTINE_orig +#define ROUTINE_24 ROUTINE_orig +#define ROUTINE_25 ROUTINE_orig +#define ROUTINE_26 ROUTINE_orig +#define ROUTINE_27 ROUTINE_orig + +#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I)) +#define BYTE_cfT(M,I,A,B,D) *A +#define DOUBLE_cfT(M,I,A,B,D) *A +#define FLOAT_cfT(M,I,A,B,D) *A +#define INT_cfT(M,I,A,B,D) *A +#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A) +#define LONG_cfT(M,I,A,B,D) *A +#define SHORT_cfT(M,I,A,B,D) *A +#define BYTEV_cfT(M,I,A,B,D) A +#define DOUBLEV_cfT(M,I,A,B,D) A +#define FLOATV_cfT(M,I,A,B,D) VOIDP A +#define INTV_cfT(M,I,A,B,D) A +#define LOGICALV_cfT(M,I,A,B,D) A +#define LONGV_cfT(M,I,A,B,D) A +#define SHORTV_cfT(M,I,A,B,D) A +#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/ +#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */ +#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */ +#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */ +#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */ +#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */ +#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVV_cfT(M,I,A,B,D) (void *)A +#define INTVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define PBYTE_cfT(M,I,A,B,D) A +#define PDOUBLE_cfT(M,I,A,B,D) A +#define PFLOAT_cfT(M,I,A,B,D) VOIDP A +#define PINT_cfT(M,I,A,B,D) A +#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) +#define PLONG_cfT(M,I,A,B,D) A +#define PSHORT_cfT(M,I,A,B,D) A +#define PVOID_cfT(M,I,A,B,D) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A) +#else +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A +#endif +/* A == pointer to the characters + D == length of the string, or of an element in an array of strings + E == number of elements in an array of strings */ +#define TTSTR( A,B,D) \ + ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' ')) +#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \ + memchr(A,'\0',D) ?A : TTSTR(A,B,D) +#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \ + vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' ')) +#ifdef vmsFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length , A->dsc$l_m[0]) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \ + num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A) +#else +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D) +#define PPSTRING_cfT(M,I,A,B,D) A +#endif +#endif +#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D) +#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D) +#define CF_0_cfT(M,I,A,B,D) + +#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0) +#define DEFAULT_cfR(A,B,D) +#define LOGICAL_cfR(A,B,D) +#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define STRING_cfR(A,B,D) if (B) _cf_free(B); +#define STRINGV_cfR(A,B,D) _cf_free(B); +/* A and D as defined above for TSTRING(V) */ +#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \ + (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B); +#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B); +#ifdef vmsFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length) +#else +#ifdef CRAYFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A)) +#else +#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D) +#endif +#endif +#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D) +#define PPSTRING_cfR(A,B,D) + +#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)( +#ifndef __CF__KnR +/* The void is req'd by the Apollo, to make this an ANSI function declaration. + The Apollo promotes K&R float functions to double. */ +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void +#ifdef vmsFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS +#else +#ifdef CRAYFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS +#else +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0 +#endif +#endif +#endif +#else +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#endif +#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0 +#endif +#endif + +#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN) +#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN) +#ifndef __CF_KnR +#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN) +#endif +#define INT_cfF(UN,LN) INT_cfFZ(UN,LN) +#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN) +#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN) +#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN) +#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN) +#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN), + +#define INT_cfFF +#define VOID_cfFF +#ifdef vmsFortran +#define STRING_cfFF fstring *AS; +#else +#ifdef CRAYFortran +#define STRING_cfFF _fcd AS; +#else +#define STRING_cfFF char *AS; unsigned D0; +#endif +#endif + +#define INT_cfL A0= +#define STRING_cfL A0= +#define VOID_cfL + +#define INT_cfK +#define VOID_cfK +/* KSTRING copies the string into the position provided by the caller. */ +#ifdef vmsFortran +#define STRING_cfK \ + memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\ + AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ + memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ + AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; +#else +#ifdef CRAYFortran +#define STRING_cfK \ + memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \ + _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \ + memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \ + _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0; +#else +#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \ + D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ + ' ', D0-(A0==NULL?0:strlen(A0))):0; +#endif +#endif + +/* Note that K.. and I.. can't be combined since K.. has to access data before +R.., in order for functions returning strings which are also passed in as +arguments to work correctly. Note that R.. frees and hence may corrupt the +string. */ +#define BYTE_cfI return A0; +#define DOUBLE_cfI return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfI return A0; +#else +#define FLOAT_cfI RETURNFLOAT(A0); +#endif +#define INT_cfI return A0; +#ifdef hpuxFortran800 +/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */ +#define LOGICAL_cfI return ((A0)?1:0); +#else +#define LOGICAL_cfI return C2FLOGICAL(A0); +#endif +#define LONG_cfI return A0; +#define SHORT_cfI return A0; +#define STRING_cfI return ; +#define VOID_cfI return ; + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN) +#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1) +#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2) +#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3) +#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4) +#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5) +#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6) +#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) +#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) +#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) +#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) +#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) +#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) +#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) +#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) +#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) +#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) +#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) +#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) +#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) +#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) +#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) +#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) +#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) +#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) +#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + + +#define FCALLSCFUN1( T0,CN,UN,LN,T1) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0) +#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0) +#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) +#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef __CF__KnR +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) } + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) } + +#else +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \ + CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)} + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \ + CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)} + +#endif + + +#endif /* __CFORTRAN_LOADED */ diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_commandline.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_commandline.F90 new file mode 100644 index 0000000000..d9fdd863f7 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_commandline.F90 @@ -0,0 +1,162 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_commandline.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include "config.inc" + +#ifdef HAVE_2003ARGS +#define NARGS command_argument_count() +#define GETARG get_command_argument +#else +#define NARGS iargc +#define GETARG getarg +#endif + +!> parsing common command line arguments +module glimmer_commandline + + use glimmer_global, only:fname_length + + implicit none + + character(len=5000) :: commandline_history !< complete command line + character(len=fname_length) :: commandline_configname !< name of the configuration file + character(len=fname_length) :: commandline_resultsname !< name of results file + +contains + + !> get the command line and parse it + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glimmer_GetCommandline() + use parallel, only: main_task + implicit none + + integer numargs,nfiles + integer :: i +#ifndef HAVE_2003ARGS + integer, external :: iargc +#endif + character(len=100) :: argument + integer, dimension(100) :: argumentIdx + + ! defaults + commandline_resultsname = 'results' + + if (main_task) then + ! get number of arguments and file names + numargs = NARGS + ! reconstruct command line to store commandline_history + call GETARG(0,commandline_history) + do i=1,numargs + call GETARG(i,argument) + commandline_history = trim(commandline_history)//" "//trim(argument) + end do + + if (numargs > 0) then + i=0 + nfiles = 0 + ! loop over command line arguments + do while (i < numargs) + i = i + 1 + call GETARG(i,argument) + ! check if it is an option + if (argument(1:1) == '-') then + select case (trim(argument)) + case ('-h') + call glimmer_commandlineHelp() + stop + case ('-r') + i = i+1 + if (i > numargs) then + write(*,*) 'Error, expect name of output file to follow -o option' + call glimmer_commandlineHelp() + stop + end if + call GETARG(i,commandline_resultsname) + case default + write(*,*) 'Unkown option ',trim(argument) + call glimmer_commandlineHelp() + stop + end select + else + ! it's not an option + nfiles = nfiles+1 + argumentIdx(nfiles) = i + end if + end do + if (nfiles > 0) then + call GETARG(argumentIdx(1),commandline_configname) + else + write(*,*) 'Need at least one argument' + call glimmer_commandlineHelp() + stop + end if + else + write(*,*) 'Enter name of GLIDE configuration file to be read' + read(*,'(a)') commandline_configname + ! commandline_configname = 'hump.config' + end if ! numargs > 0 + end if ! main_task + + end subroutine glimmer_GetCommandline + + !> print out command line + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glimmer_PrintCommandline() + use parallel, only: main_task + implicit none + + if (main_task) then + write(*,*) 'Entire commandline' + write(*,*) trim(commandline_history) + write(*,*) + write(*,*) 'commandline_configname: ', trim(commandline_configname) + write(*,*) 'commandline_resultsname: ', trim(commandline_resultsname) + endif + end subroutine glimmer_PrintCommandline + + !> print help message + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glimmer_commandlineHelp() + use parallel, only: main_task + implicit none + character(len=500) :: pname + + call GETARG(0,pname) + + if (main_task) then + write(*,*) 'Usage: ',trim(pname),' [options] cfgname' + write(*,*) 'where [options] are' + write(*,*) ' -h: this message' + write(*,*) ' -r : the name of the results file (default: results)' + endif + end subroutine glimmer_commandlineHelp +end module glimmer_commandline diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_config.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_config.F90 new file mode 100644 index 0000000000..b271c0e92c --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_config.F90 @@ -0,0 +1,943 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_config.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> configuration file parser +!! +!! \author Magnus Hagdorn +!! \date May 2004 +!! +!! procedures used to parse configuration files. The file syntax is similar to +!! MS Windows style ini files or files that can be parsed using the Python +!! configuration file parser module. +!! +!! The file is split up into sections. Each section appears in [] brackets. +!! Each section can contain a number of key, value pairs. Key, value pairs are +!! separated by : or =. +!! +!! Strings starting with any of the following characters are ignored +!! (comments): !, # or ; +!! +!! The sections are stored in a linked list. The key-value pairs of each section +!! are also stored in linked lists. The module provides accessors to query the +!! data structure. +module glimmer_config + + use glimmer_global, only : sp, dp, msg_length + use glimmer_log + + implicit none + + private :: handle_section, handle_value, InsertSection, InsertValue, dp + + integer, parameter :: namelen=50 !< the maximum length of key or section + integer, parameter :: valuelen=400 !< the maximum length of a value + integer, parameter :: linelen=valuelen+namelen+1 !< the maximum length of a line + + !> derived type defining a key-value pair + type ConfigValue + character(len=namelen) :: name = '' !< the key + character(len=valuelen) :: value !< the value + type(ConfigValue), pointer :: next=>NULL() !< pointer to the next key-value pair + end type ConfigValue + + !> derived type defining a configuration section + type ConfigSection + character(len=namelen) :: name = '' !< the section name + logical :: used = .false. !< flag used to check if section is used + type(ConfigValue), pointer :: values=>NULL() !< pointer to the first key-value pair + type(ConfigSection), pointer :: next=>NULL() !< pointer to the next section + end type ConfigSection + + !> This type exists so that we can have + !! arrays of config data, since f90 doesn't + !! allow arrays of pointers + type ConfigData + type(ConfigSection), pointer :: config=>null() + end type ConfigData + + !> generic interface for the get accessor + interface GetValue + module procedure GetValueDouble, GetValueReal, GetValueInt, GetValueChar, GetValueLogical, & + GetValueDoubleArray, GetValueRealArray, GetValueIntArray, GetValueCharArray + end interface + + !> generic interface for the set accessor + interface ConfigSetValue + module procedure ConfigSetValueData, ConfigSetValueSec + end interface + + !> generic interface for the combine procedure + interface ConfigCombine + module procedure ConfigCombineData, ConfigCombineSec, ConfigCombineDataSec, ConfigCombineSecData + end interface + +contains + + !> read a configuration file + subroutine ConfigRead(fname,config,fileunit) + !> read configuration file + use parallel + use glimmer_log + implicit none + + character(len=*), intent(in) :: fname !< the name of the file to be read + type(ConfigSection), pointer :: config !< on return this pointer will point to the first section + integer, optional,intent(in) :: fileunit !< if supplied, open this unit + + ! local variables + type(ConfigSection), pointer :: this_section + type(ConfigValue), pointer :: this_value + logical there + integer unit,ios,linenr + character(len=linelen) :: line + character(len=msg_length) :: message + + if (main_task) inquire (exist=there,file=fname) + call broadcast(there) + if (.not.there) then + call write_log('Cannot open configuration file '//trim(fname),GM_FATAL) + end if + + unit = 99 + if (present(fileunit)) then + unit = fileunit + endif + + if (main_task) open(unit,file=trim(fname),status='old') + ios=0 + linenr=0 + config=>NULL() + this_section=>NULL() + do while(ios == 0) + if (main_task) read(unit,fmt='(a450)',iostat=ios) line + call broadcast(line) + call broadcast(ios) + line = adjustl(line) + if (ios /= 0) then + exit + end if + if (.not.(line(1:1) == '!' .or. line(1:1) == '#' .or. line(1:1) == ';' .or. line(1:1) == ' ')) then + ! handle comments + if (line(1:1) == '[') then + ! new section + call handle_section(linenr,line,this_section) + this_value=>NULL() + if (.not.associated(config)) then + ! this is the first section in config file + config=>this_section + end if + else + ! handle value + if (.not.associated(this_section)) then + call write_log('No section defined yet',GM_ERROR) + write(message,*) trim(adjustl(fname)), linenr + call write_log(message,GM_FATAL) + end if + call handle_value(linenr,line,this_value) + if (.not.associated(this_section%values)) then + this_section%values => this_value + end if + end if + end if + linenr = linenr + 1 + end do + if (main_task) close(unit) + return + + end subroutine ConfigRead + + !> print contents of file + subroutine PrintConfig(config) + implicit none + type(ConfigSection), pointer :: config !< pointer to the first section to be printed + + type(ConfigSection), pointer :: sec + type(ConfigValue), pointer :: val + + sec=>config + do while(associated(sec)) + write(*,*) sec%name + val=>sec%values + do while(associated(val)) + write(*,*) ' ',trim(val%name),' == ', trim(val%value) + val=>val%next + end do + write(*,*) + sec=>sec%next + end do + end subroutine PrintConfig + + !> serialise config data structure to string + !! \author Ian Rutt + subroutine ConfigAsString(config,string) + use glimmer_global, only: endline + implicit none + type(ConfigSection), pointer :: config !< pointer to first section + character(*),intent(out) :: string !< on completion this string will hold the conents of the config data structure + + type(ConfigSection), pointer :: sec + type(ConfigValue), pointer :: val + + string='' + + sec=>config + do while(associated(sec)) + string=trim(string)//'['//trim(sec%name)//']'//trim(endline) + val=>sec%values + do while(associated(val)) + string=trim(string)//trim(val%name)//': '//trim(val%value)//trim(endline) + val=>val%next + end do + sec=>sec%next + end do + end subroutine ConfigAsString + + !> Either overwrite a given key-value pair, + !! or create a new one + !! \author Ian Rutt + subroutine ConfigSetValueData(config,secname,valname,value,tag) + + type(ConfigData) :: config !< + character(len=*), intent(in) :: secname !< name of the section + character(len=*), intent(in) :: valname !< name of the key + character(len=*), intent(in) :: value !< the value + character(len=*), intent(in), optional :: tag !< an identifier used to distinguish sections that occur a number of times,e.g. [CF output] + + call ConfigSetValueSec(config%config,secname,valname,value,tag) + + end subroutine ConfigSetValueData + + !> Either overwrite a given key-value pair, + !! or create a new one + !! \author Ian Rutt + subroutine ConfigSetValueSec(config,secname,valname,value,tag) + + type(ConfigSection), pointer :: config !< pointer to the first section + character(len=*), intent(in) :: secname !< name of the section + character(len=*), intent(in) :: valname !< name of the key + character(len=*), intent(in) :: value !< the value + character(len=*), intent(in), optional :: tag !< an identifier used to distinguish sections that occur a number of times,e.g. [CF output] + + type(ConfigSection), pointer :: found + type(ConfigSection), pointer :: newsec + type(ConfigValue), pointer :: val + type(ConfigValue), pointer :: newval + type(ConfigValue), pointer :: newtag + logical :: tagflag + + ! Find or create correct section + + if (.not.associated(config)) allocate(config) + + found=>config + do + if (associated(found)) then + if (present(tag)) then + tagflag=ConfigSectionHasTag(found,tag) + else + tagflag=.true. + end if + if ((trim(secname)==trim(found%name)).and.tagflag) then + exit + else + if (associated(found%next)) then + found=>found%next + else + allocate(newsec) + found%next=>newsec + found=>found%next + found%name=trim(secname) + if (present(tag)) then + allocate(newtag) + newtag%name='tag' + newtag%value=trim(tag) + found%values=>newtag + end if + exit + end if + end if + else + exit + end if + end do + + ! Add or create key-value pair + + if (.not.associated(found%values)) then + allocate(newval) + found%values=>newval + found%values%name=valname + found%values%value=value + else + val=>found%values + do + if (trim(valname)==trim(val%name)) then + val%value=value + exit + else + if (associated(val%next)) then + val=>val%next + else + allocate(newval) + val%next=>newval + val%next%name=valname + val%next%value=value + exit + end if + end if + end do + end if + + end subroutine ConfigSetValueSec + + !> Add the contents of config2 to config1, overwriting if necessary + !! \author Ian Rutt + subroutine ConfigCombineDataSec(config1,config2) + + type(ConfigData) :: config1 + type(ConfigSection),pointer :: config2 + + call ConfigCombineSec(config1%config,config2) + + end subroutine ConfigCombineDataSec + + !> Add the contents of config2 to config1, overwriting if necessary + !! \author Ian Rutt + subroutine ConfigCombineSecData(config1,config2) + + type(ConfigSection),pointer :: config1 + type(ConfigData) :: config2 + + call ConfigCombineSec(config1,config2%config) + + end subroutine ConfigCombineSecData + + + !> Add the contents of config2 to config1, overwriting if necessary + !! \author Ian Rutt + subroutine ConfigCombineData(config1,config2) + + type(ConfigData) :: config1 + type(ConfigData) :: config2 + + call ConfigCombineSec(config1%config,config2%config) + + end subroutine ConfigCombineData + + !> Add the contents of config2 to config1, overwriting if necessary + !! \author Ian Rutt + subroutine ConfigCombineSec(config1,config2) + + type(ConfigSection), pointer :: config1 + type(ConfigSection), pointer :: config2 + + type(ConfigSection), pointer :: thissec + type(ConfigValue), pointer :: thisval + character(namelen) :: thisname + + character(150) :: tag + + thissec=>config2 + do + if (associated(thissec)) then + thisval=>thissec%values + thisname=trim(thissec%name) + do + if (associated(thisval)) then + if (ConfigSectionHasValue(thissec,'tag',tag)) then + call ConfigSetValue(config1,thisname,trim(thisval%name),trim(thisval%value),tag=tag) + else + call ConfigSetValue(config1,thisname,trim(thisval%name),trim(thisval%value)) + end if + thisval=>thisval%next + else + exit + end if + end do + thissec=>thissec%next + else + exit + end if + end do + + end subroutine ConfigCombineSec + + !> check if section has specified tag + !! \author Ian Rutt + !! + !! a tag is jus a special key value pair + logical function ConfigSectionHasTag(section,tag) + + type(ConfigSection), pointer :: section !< pointer to section + character(len=*),intent(in) :: tag !< the name of the tag + character(200) :: testtag + + ConfigSectionHasTag=.false. + if (ConfigSectionHasValue(section,'tag',testtag)) then + if (trim(tag)==trim(testtag)) then + ConfigSectionHasTag=.true. + end if + end if + + end function ConfigSectionhasTag + + !> check if section has a particular key-value pair + !! \author Ian Rutt + logical function ConfigSectionHasValue(section,valname,val) + + type(ConfigSection), pointer :: section !< pointer to the section to be checked + type(ConfigValue), pointer :: thisval + character(len=*), intent(in) :: valname !< the name of the key + character(len=*), intent(inout) :: val !< the value + + ConfigSectionHasValue=.false. + val='' + + if (.not.associated(section)) return + + thisval=>section%values + do + if (.not.associated(thisval)) exit + if (trim(valname)==trim(thisval%name)) then + val=trim(thisval%value) + ConfigSectionHasValue=.true. + exit + else + thisval=>thisval%next + end if + end do + + end function ConfigSectionHasValue + + !> find a return section + !! \author Magnus Hagdorn + subroutine GetSection(config,found,name) + implicit none + type(ConfigSection), pointer :: config !< pointer to the first section + type(ConfigSection), pointer :: found + character(len=*),intent(in) :: name !< the name of the section to be found + + found=>config + do while(associated(found)) + if (name == trim(found%name)) then + found%used = .true. + return + end if + found=>found%next + end do + end subroutine GetSection + + !> traverse linked list and check that all sections have been used + subroutine CheckSections(config) + use glimmer_log + implicit none + type(ConfigSection), pointer :: config + + ! local variables + type(ConfigSection), pointer :: cf + + cf=>config + do while(associated(cf)) + if (.not.cf%used) then + call write_log('Unused section: '//trim(cf%name),GM_WARNING) + end if + cf=>cf%next + end do + end subroutine CheckSections + + !> get double array value + subroutine GetValueDoubleArray(section,name,val,numval) + use glimmer_log + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + real(dp), pointer, dimension(:) :: val !< on exit this will hold the values + integer,intent(in), optional :: numval !< maximum number of values to be read + + ! local variables + character(len=valuelen) :: value,tmp + real(dp), dimension(:),allocatable :: tempval + integer i,numv,inds,indc,ind + + if (present(numval)) then + numv=numval + else + numv=100 + end if + allocate(tempval(numv)) + value='' + call GetValueChar(section,name,value) + if (value == '') return + + i=1 + do + inds=index(value,' ') ; indc=index(value,',') + if (inds==0.and.indc==0) then + exit + else if (inds==1.or.indc==1) then + value=value(2:) + cycle + else if (inds==0) then + ind=indc + else if (indc==0) then + ind=inds + else + ind=min(inds,indc) + end if + tmp=value(1:ind-1) + read(tmp,*,err=10)tempval(i) + value=value(ind+1:) + if (trim(value)=='') exit + i=i+1 + end do + if (i >= 1) then + if (associated(val)) then + deallocate(val) + end if + allocate(val(i)) + val = tempval(1:i) + end if + return + +10 call write_log('Array error in config file - check syntax',GM_FATAL) + + end subroutine GetValueDoubleArray + + !> get real array value + subroutine GetValueRealArray(section,name,val,numval) + + use glimmer_log + implicit none + + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + real(sp), pointer, dimension(:) :: val !< on exit this will hold the values + integer,intent(in), optional :: numval !< maximum number of values to be read + + ! local variables + character(len=valuelen) :: value,tmp + real(sp), dimension(:),allocatable :: tempval + integer i,numv,inds,indc,ind + + if (present(numval)) then + numv=numval + else + numv=100 + end if + allocate(tempval(numv)) + value='' + call GetValueChar(section,name,value) + if (value == '') return + + i=1 + do + inds=index(value,' ') ; indc=index(value,',') + if (inds==0.and.indc==0) then + exit + else if (inds==1.or.indc==1) then + value=value(2:) + cycle + else if (inds==0) then + ind=indc + else if (indc==0) then + ind=inds + else + ind=min(inds,indc) + end if + tmp=value(1:ind-1) + read(tmp,*,err=10)tempval(i) + value=value(ind+1:) + if (trim(value)=='') exit + i=i+1 + end do + + if (i >= 1) then + if (associated(val)) then + deallocate(val) + end if + allocate(val(i)) + val = tempval(1:i) + end if + return + +10 call write_log('Array error in config file - check syntax',GM_FATAL) + + end subroutine GetValueRealArray + + !> get integer value array + subroutine GetValueIntArray(section,name,val,numval) + !> get integer array value + use glimmer_log + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + integer, pointer, dimension(:) :: val !< on exit this will hold the value + integer,intent(in), optional :: numval !< maximum number of values to be read + + ! local variables + character(len=valuelen) :: value,tmp + integer, dimension(:),allocatable :: tempval + integer i,numv,inds,indc,ind + + if (present(numval)) then + numv=numval + else + numv=100 + end if + allocate(tempval(numv)) + value='' + call GetValueChar(section,name,value) + if (value == '') return + + i=1 + do + inds=index(value,' ') ; indc=index(value,',') + if (inds==0.and.indc==0) then + exit + else if (inds==1.or.indc==1) then + value=value(2:) + cycle + else if (inds==0) then + ind=indc + else if (indc==0) then + ind=inds + else + ind=min(inds,indc) + end if + tmp=value(1:ind-1) + read(tmp,*,err=10)tempval(i) + value=value(ind+1:) + if (trim(value)=='') exit + i=i+1 + end do + + if (i >= 1) then + if (associated(val)) then + deallocate(val) + end if + allocate(val(i)) + val = tempval(1:i) + end if + return + +10 call write_log('Array error in config file - check syntax',GM_FATAL) + + end subroutine GetValueIntArray + + !> get character array value + subroutine GetValueCharArray(section,name,val,numval) + use glimmer_log + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + character(len=80), pointer, dimension(:) :: val !< on exit this will hold the values + integer,intent(in), optional :: numval !< maximum number of values to be read + + ! local variables + character(len=valuelen) :: value + character(80), dimension(:),allocatable :: tempval + integer i,numv,inds,indc,ind + + if (present(numval)) then + numv=numval + else + numv=100 + end if + allocate(tempval(numv)) + value='' + call GetValueChar(section,name,value) + if (value == '') return + + i=1 + do + inds=index(value,' ') ; indc=index(value,',') + if (inds==0.and.indc==0) then + exit + else if (inds==1.or.indc==1) then + value=value(2:) + cycle + else if (inds==0) then + ind=indc + else if (indc==0) then + ind=inds + else + ind=min(inds,indc) + end if + tempval(i)=value(1:ind-1) + value=value(ind+1:) + if (trim(value)=='') exit + i=i+1 + end do + + if (i >= 1) then + if (associated(val)) then + deallocate(val) + end if + allocate(val(i)) + val = tempval(1:i) + end if + return + +10 call write_log('Array error in config file - check syntax',GM_FATAL) + + end subroutine GetValueCharArray + + !> get real value + subroutine GetValueReal(section,name,val) + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + real(sp), intent(inout) :: val !< the value + + ! local variables + character(len=valuelen) :: value + real(sp) :: temp + integer ios + + value='' + call GetValueChar(section,name,value) + + read(value,*,iostat=ios) temp + if (ios==0) then + val = temp + elseif (ios > 0) then + call write_log('Value for "' // trim( name) // '" specified in .config file was not used because of a read error (e.g. wrong data type used). Default value has been used instead.', GM_WARNING) + end if + end subroutine GetValueReal + + !> get double value + subroutine GetValueDouble(section,name,val) + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + real(dp), intent(inout) :: val !< the value + + ! local variables + character(len=valuelen) :: value + + real(dp) :: temp + + integer ios + + value='' + call GetValueChar(section,name,value) + + read(value,*,iostat=ios) temp + if (ios==0) then + val = temp + elseif (ios > 0) then + call write_log('Value for the option "' // trim( name) // '" specified in .config file was not used because of a read error (e.g. wrong data type used). Default value has been used instead.', GM_WARNING) + end if + end subroutine GetValueDouble + + !> get integer value + subroutine GetValueInt(section,name,val) + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + integer, intent(inout) :: val !< the value + + ! local variables + character(len=valuelen) :: value + integer temp + integer ios + + value='' + call GetValueChar(section,name,value) + + read(value,*,iostat=ios) temp + if (ios==0) then + val = temp + elseif (ios > 0) then + call write_log('Value for the option "' // trim( name) // '" specified in .config file was not used because of a read error (e.g. wrong data type used). Default value has been used instead.', GM_WARNING) + end if + end subroutine GetValueInt + + !> get character value + subroutine GetValueChar(section,name,val) + use glimmer_log + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + character(len=*), intent(inout) :: val !< the value + + type(ConfigValue), pointer :: value + + value=>section%values + do while(associated(value)) + if (name == trim(value%name)) then + val = value%value + if ((len_trim(val) + 1) >= len(val)) then + ! Assume that if we get within one space of the variable length (excluding spaces) then we may be truncating the intended value. + call write_log('The value of config option ' // trim(name) // ' is too long for the variable.' ,GM_FATAL) + endif + return + end if + value=>value%next + end do + end subroutine GetValueChar + + !> get logical value + subroutine GetValueLogical(section,name,val) + implicit none + type(ConfigSection), pointer :: section !< the section from which the value is loaded + character(len=*),intent(in) :: name !< the name of the key + logical, intent(inout) :: val !< the value + + ! local variables + character(len=valuelen) :: value + integer itemp + logical ltemp + integer ios + integer ierr + + ierr = 0 + value='' + call GetValueChar(section,name,value) + + read(value,*,iostat=ios) itemp + if (ios==0) then + val = itemp == 1 + elseif (ios > 0) then + ierr = 1 + end if + read(value,*,iostat=ios) ltemp + if (ios==0) then + val = ltemp + elseif (ios > 0) then + ierr = ierr + 1 + end if + if (ierr == 2) then + call write_log('Value for the option "' // trim( name) // '" specified in .config file was not used because of a read error (e.g. wrong data type used). Default value has been used instead.', GM_WARNING) + endif + + end subroutine GetValueLogical + + !================================================================================== + ! private procedures + !================================================================================== + + !> handle line in file containing a section + subroutine handle_section(linenr,line,section) + use glimmer_log + implicit none + integer, intent(in) :: linenr !< the line number + character(len=*), intent(in) :: line !< buffer containing the line + type(ConfigSection), pointer :: section !< pointer to place where new section should be inserted + + ! local variables + integer i + character(len=msg_length) :: message + + do i=1,linelen + if (line(i:i) == ']') then + exit + end if + end do + if (line(i:i) /= ']') then + write(message,*) 'Cannot find end of section ',linenr + call write_log(message,GM_FATAL) + end if + + call InsertSection(trim(adjustl(line(2:i-1))),section) + end subroutine handle_section + + !> handle line in file containing a key-value pair + subroutine handle_value(linenr,line,value) + use glimmer_log + implicit none + integer, intent(in) :: linenr !< the line number + character(len=*), intent(in) :: line !< buffer containing the line + type(ConfigValue), pointer :: value !< pointer to value linked list where value should be added + + ! local variables + integer i + character(len=msg_length) :: message + do i=1,linelen + if (line(i:i) == '=' .or. line(i:i) == ':') then + exit + end if + end do + if (.not.(line(i:i) == '=' .or. line(i:i) == ':')) then + write(message,*) 'Cannot find = or : ',linenr + call write_log(message,GM_FATAL) + end if + + call InsertValue(trim(adjustl(line(:i-1))), trim(adjustl(line(i+1:))),value) + end subroutine handle_value + + !> add a new section + subroutine InsertSection(name,section) + !> add a new section + implicit none + character(len=*), intent(in) :: name !< name of new section + type(ConfigSection), pointer :: section !< on entry the element of linked list after which the new element is inserted, on exit: the new element + type(ConfigSection), pointer :: new_sec + + allocate(new_sec) + new_sec%name = name + + if (associated(section)) then + if (associated(section%next)) then + new_sec%next => section%next + end if + section%next=>new_sec + end if + section=>new_sec + end subroutine InsertSection + + !> insert a key-value pair + subroutine InsertValue(name,val,value) + use glimmer_log + implicit none + character(len=*), intent(in) :: name !< the key + character(len=*), intent(in) :: val !< the value + type(ConfigValue), pointer :: value !< on entry the element after which the new value should be added, on exit pointer the new element + type(ConfigValue), pointer :: new_value + + allocate(new_value) + + ! Assume that if we get within one space of the variable length (excluding spaces) then we may be truncating the intended value. + if ((len_trim(val) + 1) >= len(new_value%value)) then + call write_log('The value of config option ' // trim(name) // ' is too long to be read fully.' ,GM_FATAL) + endif + + new_value%name = name + new_value%value = val + + if(associated(value)) then + if (associated(value%next)) then + new_value%next => value%next + end if + value%next => new_value + end if + value=>new_value + end subroutine InsertValue +end module glimmer_config diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_coordinates.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_coordinates.F90 new file mode 100644 index 0000000000..c16cdeee70 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_coordinates.F90 @@ -0,0 +1,322 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_coordinates.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> module for handling regular coordinate systems +!! +!! \author Magnus Hagdorn +!! \date June 2006 +module glimmer_coordinates + + use glimmer_global, only: dp, sp + + implicit none + + !> derived type describing a 2D point + type coord_point + real(kind=dp), dimension(2) :: pt !< the coordinates + end type coord_point + + !> derived type describing a 2D integer point + type coord_ipoint + integer, dimension(2) :: pt !< the coordinates + end type coord_ipoint + + !> type describing coordinate systems + type coordsystem_type + type(coord_point) :: origin !< origin of coordinate space + type(coord_point) :: delta !< stepsize in x and y direction + type(coord_point) :: delta_r !< reciprocal stepsize in x and y direction + type(coord_ipoint) :: size !< extent in x and y direction + end type coordsystem_type + + !> interface of creating new coord system + interface coordsystem_new + module procedure coordsystem_new_real, coordsystem_new_pt + end interface + + !> interface for allocating data for new coord system + interface coordsystem_allocate + module procedure coordsystem_allocate_d, coordsystem_allocate_s, coordsystem_allocate_i, coordsystem_allocate_l, & + coordsystem_allocate_d2, coordsystem_allocate_s2, coordsystem_allocate_i2 + end interface + +#ifdef DEBUG_COORDS + character(len=msg_length), private :: message +#endif + +contains + + !> print coordsystem info to unit + subroutine coordsystem_print(coord, unit) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer,intent(in) :: unit !< unit to be printed to + write(unit,*) 'Origin ',coord%origin%pt + write(unit,*) 'Delta ',coord%delta%pt + write(unit,*) '1/Delta ',coord%delta_r%pt + write(unit,*) 'Size ',coord%size%pt + end subroutine coordsystem_print + + !> create new coordinate system from individual variables + function coordsystem_new_real(ox, oy, dx, dy, sx, sy) + implicit none + real(kind=dp), intent(in) :: ox, oy !< coordinates of origin + real(kind=dp), intent(in) :: dx, dy !< offsets + integer, intent(in) :: sx, sy !< x and y dimension + type(coordsystem_type) :: coordsystem_new_real + + ! origin + coordsystem_new_real%origin%pt(1) = ox + coordsystem_new_real%origin%pt(2) = oy + ! deltas + coordsystem_new_real%delta%pt(1) = dx + coordsystem_new_real%delta%pt(2) = dy + coordsystem_new_real%delta_r%pt(1) = 1.d0/dx + coordsystem_new_real%delta_r%pt(2) = 1.d0/dy + ! size + coordsystem_new_real%size%pt(1) = sx + coordsystem_new_real%size%pt(2) = sy + end function coordsystem_new_real + + !> create new coordinate system from points + function coordsystem_new_pt(o, d, s) + implicit none + type(coord_point), intent(in) :: o !< coordinates of origin + type(coord_point), intent(in) :: d !< offsets + type(coord_ipoint), intent(in) :: s !< x and y dimension + type(coordsystem_type) :: coordsystem_new_pt + + ! origin + coordsystem_new_pt%origin = o + ! deltas + coordsystem_new_pt%delta = d + coordsystem_new_pt%delta_r%pt(:) = 1.d0/d%pt(:) + ! size + coordsystem_new_pt%size = s + end function coordsystem_new_pt + + !> get coordinates of node + function coordsystem_get_coord(coord,node) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_ipoint), intent(in) :: node !< node + + type(coord_point) :: coordsystem_get_coord + +#ifdef DEBUG_COORDS + if (.not.coordsystem_node_inside(coord,node)) then + write(message,*) 'node (',node%pt,') not inside coord system' + call coordsystem_print(coord,glimmer_get_logunit()) + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if +#endif + + coordsystem_get_coord%pt(:) = coord%origin%pt(:) + (node%pt(:) - 1)*coord%delta%pt(:) + end function coordsystem_get_coord + + !> get index of nearest node given coords of a point + function coordsystem_get_node(coord,point) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_point), intent(in) :: point !< point + + type(coord_ipoint) :: coordsystem_get_node + + coordsystem_get_node%pt(:) = 1+floor(0.5+(point%pt(:)-coord%origin%pt(:))*coord%delta_r%pt(:)) + if (coordsystem_get_node%pt(1) == coord%size%pt(1)+1) coordsystem_get_node%pt(1) = coord%size%pt(1) + if (coordsystem_get_node%pt(2) == coord%size%pt(2)+1) coordsystem_get_node%pt(2) = coord%size%pt(2) + +#ifdef DEBUG_COORDS + if (.not.coordsystem_node_inside(coord,coordsystem_get_node)) then + write(message,*) 'point (',point%pt,') not inside coord system' + call coordsystem_print(coord,glimmer_get_logunit()) + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if +#endif + end function coordsystem_get_node + + !> get index of lower-left node of cell into which point falls + function coordsystem_get_llnode(coord,point) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_point), intent(in) :: point !< point + + type(coord_ipoint) :: coordsystem_get_llnode + + coordsystem_get_llnode%pt(:) = 1+floor((point%pt(:)-coord%origin%pt(:))*coord%delta_r%pt(:)) + end function coordsystem_get_llnode + + !> return true iff node is inside coord system + function coordsystem_node_inside(coord,node) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_ipoint), intent(in) :: node !< node + + logical coordsystem_node_inside + + coordsystem_node_inside = (all(node%pt >= 1) .and. all(node%pt <= coord%size%pt)) + end function coordsystem_node_inside + + !> return true iff point is inside coord system + function coordsystem_point_inside(coord,point) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_point), intent(in) :: point !< point + logical coordsystem_point_inside + integer i + + coordsystem_point_inside = .true. + do i=1,2 + coordsystem_point_inside = (point%pt(i) >= coord%origin%pt(i)) .and. & + (point%pt(i) <= coord%origin%pt(i)+coord%size%pt(i)*coord%delta%pt(i)) + if (.not.coordsystem_point_inside) then + exit + end if + end do + end function coordsystem_point_inside + + !> linearise node, given coord + function coordsystem_linearise2d(coord,node) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + type(coord_ipoint), intent(in) :: node !< node + integer coordsystem_linearise2d + + coordsystem_linearise2d = -1 + +#ifdef DEBUG_COORDS + if (.not.coordsystem_node_inside(coord,node)) then + write(message,*) 'node (',node%pt,') not inside coord system' + call write_log(message,GM_ERROR,__FILE__,__LINE__) + return + end if +#endif + + coordsystem_linearise2d = node%pt(1) + (node%pt(2)-1)*coord%size%pt(1) + end function coordsystem_linearise2d + + !> expand linearisation + function coordsystem_delinearise2d(coord, ind) + use glimmer_log + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer, intent(in) :: ind !< index + type(coord_ipoint) :: coordsystem_delinearise2d + +#ifdef DEBUG_COORDS + if (ind < 1 .or. ind > coord%size%pt(1)*coord%size%pt(2)) then + write(message,*) 'index ',ind,' outside coord system' + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if +#endif + + coordsystem_delinearise2d%pt(1) = mod(ind-1,coord%size%pt(1)) + 1 + coordsystem_delinearise2d%pt(2) = (ind-1)/coord%size%pt(1) + 1 + end function coordsystem_delinearise2d + + !> allocate memory to pointer field + subroutine coordsystem_allocate_d(coord, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + real(kind=dp), dimension(:,:), pointer :: field !< unallocated field + + allocate(field(coord%size%pt(1),coord%size%pt(2))) + field = 0.d0 + end subroutine coordsystem_allocate_d + + !> allocate memory to pointer field + subroutine coordsystem_allocate_s(coord, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + real(kind=sp), dimension(:,:), pointer :: field !< unallocated field + + allocate(field(coord%size%pt(1),coord%size%pt(2))) + field = 0.e0 + end subroutine coordsystem_allocate_s + + !> allocate memory to pointer field + subroutine coordsystem_allocate_i(coord, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer, dimension(:,:), pointer :: field !< unallocated field + + allocate(field(coord%size%pt(1),coord%size%pt(2))) + field = 0 + end subroutine coordsystem_allocate_i + + !> allocate memory to pointer field + subroutine coordsystem_allocate_l(coord, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + logical, dimension(:,:), pointer :: field !< unallocated field + + allocate(field(coord%size%pt(1),coord%size%pt(2))) + field = .FALSE. + end subroutine coordsystem_allocate_l + + !> allocate memory to pointer field + subroutine coordsystem_allocate_d2(coord, nup, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer, intent(in) :: nup !< the number of vertical points + real(kind=dp), dimension(:,:,:), pointer :: field !< unallocated field + + allocate(field(nup,coord%size%pt(1),coord%size%pt(2))) + field = 0.d0 + end subroutine coordsystem_allocate_d2 + + !> allocate memory to pointer field + subroutine coordsystem_allocate_s2(coord, nup, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer, intent(in) :: nup !< the number of vertical points + real(kind=sp), dimension(:,:,:), pointer :: field !< unallocated field + + allocate(field(nup,coord%size%pt(1),coord%size%pt(2))) + field = 0.0 + end subroutine coordsystem_allocate_s2 + + !> allocate memory to pointer field + subroutine coordsystem_allocate_i2(coord, nup, field) + implicit none + type(coordsystem_type), intent(in) :: coord !< coordinate system + integer, intent(in) :: nup !< the number of vertical points + integer, dimension(:,:,:), pointer :: field !< unallocated field + + allocate(field(nup,coord%size%pt(1),coord%size%pt(2))) + field = 0 + end subroutine coordsystem_allocate_i2 + +end module glimmer_coordinates diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_filenames.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_filenames.F90 new file mode 100644 index 0000000000..c5885959ba --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_filenames.F90 @@ -0,0 +1,151 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_filenames.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!> Module to handle setting a working directory for glimmer +!! +!! \author Ian Rutt +!! \date May 2007 +module glimmer_filenames + + use glimmer_global,only: dirsep,fname_length + + implicit none + + character(fname_length) :: workingdir = '' !< Working directory for all file operations. Absolute paths are unaffected + character(fname_length) :: configdir = '' !< the directory where the config file lives and possibly other input files + +contains + + !> initialise the config directory + !! + !! \author Magnus Hagdorn + !! \date September 2009 + subroutine filenames_init(cname) + implicit none + character(len=*), intent(in) :: cname !< the configuration file name include path + + ! local variables + integer pos + + ! find the last directory separator, the remaining bit is the filename + pos = scan(trim(cname),dirsep,back=.true.) + if (pos > 0) then + configdir = cname(:pos) + end if + + end subroutine filenames_init + + !> prepend path to filename + !! + !! \author Magnus Hagdorn + !! \date September 2009 + !! + !! first check if name starts with a dir sparator if so don't change name, + !! then check if file exists in present working directory if so do not modify file. if it doesn't exist + !! prepend config dir + !! \return modified file name + function filenames_inputname(infile) + implicit none + character(len=*), intent(in) :: infile + character(len=fname_length) :: filenames_inputname + + logical :: fexist + + filenames_inputname = trim(infile) + + ! check if configdir exists + if (len(trim(configdir)) == 0) then + return + end if + ! check if path is absolute + !! \todo figure out absolute paths for windows + if (infile(1:1) == dirsep) then + return + else + inquire(file=infile,exist=fexist) + ! check if the file exists in the local directory + if (fexist) then + return + else + filenames_inputname = trim(configdir)//trim(infile) + end if + end if + end function filenames_inputname + + + !> set the working directory + subroutine glimmer_set_path(path) + + use glimmer_log + + character(len=*),intent(in) :: path !< the path + + workingdir=path + call write_log('Set GLIMMER working dir to :'//trim(workingdir)) + + end subroutine glimmer_set_path + + !> append path to working dir + character(200) function process_path(path) + + character(*),intent(in) :: path !< the path to be appended + + character(200) :: alpath + + alpath=adjustl(path) + + if (alpath(1:1)/=dirsep .and. trim(workingdir)/='') then + process_path=trim(workingdir)//dirsep//alpath + else + process_path=alpath + end if + + end function process_path + + !> returns the next free file unit between 20 and 100 + integer function get_free_unit() + + use glimmer_log + + + integer :: unit + logical :: op + + unit = 20 + do + inquire(unit,opened=op) + if (.not.op) exit + unit=unit+1 + if (unit>=100) then + call write_log('No file units available',GM_FATAL,__FILE__,__LINE__) + end if + end do + + get_free_unit=unit + + end function get_free_unit + +end module glimmer_filenames diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_global.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_global.F90 new file mode 100644 index 0000000000..0b61b85c7b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_global.F90 @@ -0,0 +1,89 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_global.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glimmer_global + + !> Module holding global variables for Glimmer. Holds real-type + !> kind values, and other global code parameters. + + implicit none + + integer,parameter :: sp = kind(1.0) + + !> Single precision --- Fortran single-precision real-type kind + !> value. Used internally. + !> + !> Note that if the code is being compiled with forced typing (e.g. with + !> the -r8 flag), then this parameter may need to be set in agreement with + !> that. + + integer,parameter :: dp = kind(1.0d0) + + !> Double precision --- Fortran double-precision real-type kind + !> value. Used internally. + !> + !> Note that if the code is being compiled with forced typing (e.g. with + !> the -r8 flag), then this parameter may need to be set in agreement + !> with that + +!WHL - Removed rk from the code, so commenting out these declarations +!!#ifdef GLIMMER_SP +!! integer,parameter :: rk=sp !< Precision of glimmer module --- the general Fortran real-type kind value for the Glimmer module and its interfaces. +!!#else +!! integer,parameter :: rk=dp !< Precision of glimmer module --- the general Fortran real-type kind value for the Glimmer module and its interfaces. +!!#endif + + integer,parameter :: size_t = kind(1) + + !> Precision of glimmer module --- the general Fortran real-type kind value + !> for the Glimmer module and its interfaces. + !> + !> Note that if the code is being compiled with forced typing (e.g. with + !> the -r8 flag), then this parameter must be set in agreement with that. + + integer,parameter :: fname_length=200 !< Specifies the length of character string variables used to hold filenames. + integer,parameter :: msg_length=500 !< lenght of message buffers + + !> Specifies the length of character string variables used to + !> hold filenames. + + character, parameter :: dirsep = '/' + !> directory separator + + character, parameter :: linefeed = achar(10) !< ASCII linefeed + character, parameter :: char_ret = achar(13) !< ASCII carriage-return + character(2), parameter :: cr_lf = char_ret//linefeed !< default newline appropriate for UNIX-type systems + character, parameter :: endline = linefeed + !> ASCII linefeed and carriage-return characters, + !> and set up default newline appropriate for UNIX-type systems + + real(kind=dp) :: wall_start_time, wall_stop_time + +end module glimmer_global diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_log.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_log.F90 new file mode 100644 index 0000000000..c3474af72e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_log.F90 @@ -0,0 +1,260 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_log.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> module providing file logging and error/message handling +!! +!! Six levels of message/error are defined: +!! - Diagnostic messages +!! - Timestep enumeration and related information +!! - Information messages +!! - Warning messages +!! - Error messages +!! - Fatal error messages +!! +!! These are numbered 1--6, with increasing severity, and the level of +!! message output may be set to output all messages, only those above a particular +!! severity, or none at all. It should be noted that even if all messages are +!! turned off, the model will still halt if it encounters a fatal +!! error! +!! +!! The other point to note is that when calling the messaging routines, +!! the numerical identifier of a message level should be replaced by the +!! appropriate parameter: +!! - GM_DIAGNOSTIC +!! - GM_TIMESTEP +!! - GM_INFO +!! - GM_WARNING +!! - GM_ERROR +!! - GM_FATAL +module glimmer_log + + use glimmer_global, only : fname_length,dirsep + + implicit none + + integer,parameter :: GM_DIAGNOSTIC = 1 !< Numerical identifier for diagnostic messages. + integer,parameter :: GM_TIMESTEP = 2 !< Numerical identifier for timestep messages. + integer,parameter :: GM_INFO = 3 !< Numerical identifier for information messages. + integer,parameter :: GM_WARNING = 4 !< Numerical identifier for warning messages. + integer,parameter :: GM_ERROR = 5 !< Numerical identifier for (non-fatal) error messages. + integer,parameter :: GM_FATAL = 6 !< Numerical identifier for fatal error messages. + + integer, parameter :: GM_levels = 6 !< the number of logging levels + logical, private, dimension(GM_levels) :: gm_show = .false. + + character(len=*), parameter, dimension(0:GM_levels), private :: msg_prefix = (/ & + '* UNKNOWN ', & + '* ', & + '* ', & + ' ', & + '* WARNING: ', & + '* ERROR: ', & + '* FATAL ERROR :' /) !< array containing log level names + + + character(len=fname_length),private :: glimmer_logname !< name of log file + integer,private :: glimmer_unit = 6 !< log unit + +contains + !> derives name of log file from file name by stripping directories and appending .log + function logname(fname) + implicit none + character(len=*), intent(in) :: fname !< the file name + character(len=fname_length) :: logname + + character(len=*), parameter :: suffix='.log' + integer i + i = scan(fname,dirsep,.True.) + if (i /= 0) then + logname = trim(fname(i+1:))//suffix + else + logname = trim(fname)//suffix + end if + end function logname + + !> opens log file + subroutine open_log(unit,fname) + use parallel + implicit none + integer, optional :: unit !< file unit to use + character(len=*), optional :: fname !< name of log file + + ! local variables + character(len=8) :: date + character(len=10) :: time + + if (present(unit)) then + glimmer_unit = unit + end if + if (present(fname)) then + glimmer_logname = adjustl(trim(fname)) + else + glimmer_logname = 'glide.log' + end if + + if ((main_task).and.(glimmer_unit /= 6)) then + open(unit=glimmer_unit,file=glimmer_logname,status='unknown') + end if + + call date_and_time(date,time) + call write_log_div + if (main_task) write(unit=glimmer_unit,fmt="(a,a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6)") ' Started logging at ',& + date(1:4),date(5:6),date(7:8),time(1:2),time(3:4),time(5:10) + call write_log_div + end subroutine open_log + + !> write to log + subroutine write_log(message,type,file,line) + use glimmer_global, only : msg_length + use parallel + implicit none + integer,intent(in),optional :: type !< Type of error to be generated (see list above). + character(len=*),intent(in) :: message !< message to be written + character(len=*),intent(in),optional :: file !< the name of the file which triggered the message + integer,intent(in),optional :: line !< the line number at the which the message was triggered + + ! local variables + character(len=msg_length) :: msg + integer :: local_type + character(len=6) :: line_num + + local_type = 0 + if (present(type)) then + if (type >= 1 .or. type <= GM_levels) then + local_type = type + end if + else + local_type = GM_INFO + end if + + ! constructing message + if (present(file) .and. present(line)) then + if (main_task) write(*,*)"Logged at",file,line + write(line_num,'(I6)')line + write(msg,*) trim(msg_prefix(local_type))//' (',trim(file),':',trim(adjustl(line_num)),') '//trim(message) + else + write(msg,*) trim(msg_prefix(local_type))//' '//trim(message) + end if + + ! messages are always written to file log + if (main_task) write(glimmer_unit,*) trim(msg) + + ! and maybe to std out + if (local_type /= 0) then + if ((main_task).and.(gm_show(local_type))) write(*,*) trim(msg) + end if + + ! stop logging if we encountered a fatal error + if (local_type == GM_FATAL) then + if (main_task) write(*,*) "Fatal error encountered, exiting..." + call close_log + call parallel_stop(__FILE__, __LINE__) + end if + end subroutine write_log + + !> start a new section + subroutine write_log_div + use parallel + implicit none + if (main_task) write(glimmer_unit,*) '*******************************************************************************' + end subroutine write_log_div + + !> close log file + subroutine close_log + use parallel + implicit none + ! local variables + character(len=8) :: date + character(len=10) :: time + + call date_and_time(date,time) + call write_log_div + if (main_task) write(unit=glimmer_unit,fmt="(a,a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6)") ' Finished logging at ',& + date(1:4),date(5:6),date(7:8),time(1:2),time(3:4),time(5:10) + call write_log_div + + if (main_task) close(glimmer_unit) + end subroutine close_log + + !> synchronise log to disk + subroutine sync_log + implicit none + close(glimmer_unit) + open(unit=glimmer_unit,file=glimmer_logname, position="append", status='old') + end subroutine sync_log + + !> Sets the output message level. + subroutine glimmer_set_msg_level(level) + integer, intent(in) :: level !< The message level (6 is all messages; 0 is no messages). + integer :: i + + do i=1,GM_levels + if (i>(GM_levels-level)) then + gm_show(i)=.true. + else + gm_show(i)=.false. + endif + enddo + + end subroutine glimmer_set_msg_level + + !> return glimmer log unit + function glimmer_get_logunit() + implicit none + integer glimmer_get_logunit + + glimmer_get_logunit = glimmer_unit + end function glimmer_get_logunit + + subroutine set_glimmer_unit(unit) + + ! This subroutine should be called when the log file is already open, but glimmer_unit + ! needs to be set to a desired value (e.g. for CESM coupled runs). + use parallel + implicit none + integer, optional :: unit !> file unit to use + + ! local variables + character(len=8) :: date + character(len=10) :: time + + if (present(unit)) then + glimmer_unit = unit + end if + + call date_and_time(date,time) + call write_log_div + if (main_task) write(unit=glimmer_unit,fmt="(a,a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6)") & + ' Started logging at ',& + date(1:4),date(5:6),date(7:8),time(1:2),time(3:4),time(5:10) + call write_log_div + end subroutine set_glimmer_unit + +end module glimmer_log diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_map_CFproj.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_map_CFproj.F90 new file mode 100644 index 0000000000..f56f30cee3 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_map_CFproj.F90 @@ -0,0 +1,412 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_map_CFproj.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> Holds derived types and subroutines +!! necessary for handling map projections. +!! +!! Most of the component +!! names of the various derived types are self-explanatory. +!! Note that this doesn't currently interface with the proj4 +!! library in anyway, it simply handles NetCDF data and projection +!! parameters in an appropriate format. +module glimmer_map_CFproj + + use glimmer_map_types + use glimmer_ncdf, only: nc_errorhandle + + implicit none + + private + public glimmap_CFGetProj,glimmap_CFPutProj + +contains + + !EIB! added use glimmer_ncdf to access nc_errorhandle, not sure if/when it + !moved + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! public functions + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> Read projection from a given netCDF file, returning + !! an instance of type glimmap_proj. + !! + !! \return Derived type instance containing projection parameters + function glimmap_CFGetProj(ncid) + + use parallel + use glimmer_log + use glimmer_map_init + + implicit none + + type(glimmap_proj) :: glimmap_CFGetProj + integer, intent(in) :: ncid !< Handle of the file to be read. + + !local variables + integer status + integer nvars, varid + integer natts, attid + logical found_map + character(len=50) :: attname,mapname + + ! getting variables + status = parallel_inquire(ncid,nvariables=nvars) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! looping over variables + found_map=.false. + do varid=1,nvars + status = parallel_inquire_variable(ncid,varid,natts=natts) + ! and loop over attributes + do attid=1,natts + status = parallel_inq_attname(ncid,varid,attid,attname) + if (trim(attname) == 'grid_mapping_name') then + found_map = .true. + status = parallel_get_att(ncid,varid,attname,mapname) + mapname = adjustl(mapname) + call nc_errorhandle(__FILE__,__LINE__,status) + exit + end if + end do + if (found_map) exit + end do + + if (found_map) then + glimmap_CFGetProj%found = .true. + if (index(mapname,'lambert_azimuthal_equal_area') /= 0) then + glimmap_CFGetProj%laea => CFproj_get_laea(ncid,varid) + call glimmap_laea_init(glimmap_CFGetProj%laea) + else if (index(mapname,'albers_conical_equal_area') /= 0) then + glimmap_CFGetProj%aea => CFproj_get_aea(ncid,varid) + call glimmap_aea_init(glimmap_CFGetProj%aea) + else if (index(mapname,'lambert_conformal_conic') /= 0) then + glimmap_CFGetProj%lcc => CFproj_get_lcc(ncid,varid) + call glimmap_lcc_init(glimmap_CFGetProj%lcc) + else if (index(mapname,'polar_stereographic') /= 0) then + glimmap_CFGetProj%stere => CFproj_get_stere_polar(ncid,varid) + call glimmap_stere_init(glimmap_CFGetProj%stere) + else if (index(mapname,'stereographic') /= 0) then + glimmap_CFGetProj%stere => CFproj_get_stere(ncid,varid) + call glimmap_stere_init(glimmap_CFGetProj%stere) + else + glimmap_CFGetProj%found = .false. + call write_log('Do not know about this projection: '//(mapname),GM_ERROR) + end if + else + glimmap_CFGetProj%found = .false. + call write_log('No map projection found',GM_WARNING) + end if + end function glimmap_CFGetProj + + !------------------------------------------------------------------------- + + !> write projection to a netCDF file. + subroutine glimmap_CFPutProj(ncid,mapid,proj) + + use glimmer_log + + implicit none + + type(glimmap_proj) :: proj !< Projection to be written. + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + if (.not.glimmap_allocated(proj)) then + call write_log('No known projection found!',GM_WARNING) + return + end if + + if (associated(proj%laea)) then + call CFproj_put_laea(ncid,mapid,proj%laea) + return + else if (associated(proj%aea)) then + call CFproj_put_aea(ncid,mapid,proj%aea) + return + else if (associated(proj%lcc)) then + call CFproj_put_lcc(ncid,mapid,proj%lcc) + return + else if (associated(proj%stere)) then + call CFproj_put_stere(ncid,mapid,proj%stere) + return + else + call write_log('No known projection found!',GM_WARNING) + end if + end subroutine glimmap_CFPutProj + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! private readers + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + !> get parameters for stereographic projection + function CFproj_get_stere(ncid,mapid) + use parallel + + implicit none + type(proj_stere), pointer :: CFproj_get_stere + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + + allocate(CFproj_get_stere) + status = parallel_get_att(ncid,mapid,'false_easting',CFproj_get_stere%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'false_northing',CFproj_get_stere%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'longitude_of_projection_origin',CFproj_get_stere%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'latitude_of_projection_origin',CFproj_get_stere%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'scale_factor_at_projection_origin',CFproj_get_stere%scale_factor_at_proj_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + + end function CFproj_get_stere + + !> get parameters for polar stereographic projection + function CFproj_get_stere_polar(ncid,mapid) + use parallel + use glimmer_global, only: dp + use glimmer_log + + implicit none + type(proj_stere), pointer :: CFproj_get_stere_polar + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + real(dp) :: dummy + + allocate(CFproj_get_stere_polar) + status = parallel_get_att(ncid,mapid,'false_easting',CFproj_get_stere_polar%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'false_northing',CFproj_get_stere_polar%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'straight_vertical_longitude_from_pole',CFproj_get_stere_polar%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + CFproj_get_stere_polar%latitude_of_projection_origin=90.0 + status = parallel_get_att(ncid,mapid,'latitude_of_projection_origin',CFproj_get_stere_polar%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + if (abs(abs(CFproj_get_stere_polar%latitude_of_projection_origin)-90.0)>0.001) then + call write_log('Error (polar stereographic projection) latitude of origin must be +-90.0',& + GM_FATAL,__FILE__,__LINE__) + end if + status = parallel_get_att(ncid,mapid,'scale_factor_at_projection_origin',dummy) + if (status == NF90_NOERR) then + CFproj_get_stere_polar%scale_factor_at_proj_origin = dummy + end if + status = parallel_get_att(ncid,mapid,'standard_parallel',dummy) + if (status == NF90_NOERR) then + CFproj_get_stere_polar%standard_parallel = dummy + end if + if (CFproj_get_stere_polar%standard_parallel /= 0 .and. CFproj_get_stere_polar%scale_factor_at_proj_origin /= 0.) then + call write_log('Error (stereographic projection), can only handle either standard_parallel or scale_at_orig',& + GM_FATAL,__FILE__,__LINE__) + end if + end function CFproj_get_stere_polar + + !> get parameters for Lambert azimuthal equal area projection + function CFproj_get_laea(ncid,mapid) + use parallel + + implicit none + type(proj_laea), pointer :: CFproj_get_laea + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + allocate(CFproj_get_laea) + status = parallel_get_att(ncid,mapid,'false_easting',CFproj_get_laea%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'false_northing',CFproj_get_laea%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'longitude_of_projection_origin',CFproj_get_laea%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'latitude_of_projection_origin',CFproj_get_laea%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + end function CFproj_get_laea + + !> get parameters for Albers conical equal area projection + function CFproj_get_aea(ncid,mapid) + use parallel + implicit none + type(proj_aea), pointer :: CFproj_get_aea + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + allocate(CFproj_get_aea) + status = parallel_get_att(ncid,mapid,'false_easting',CFproj_get_aea%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'false_northing',CFproj_get_aea%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'longitude_of_central_meridian',CFproj_get_aea%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'latitude_of_projection_origin',CFproj_get_aea%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'standard_parallel',CFproj_get_aea%standard_parallel) + call nc_errorhandle(__FILE__,__LINE__,status) + end function CFproj_get_aea + + !> get parameters for Lambert conformal conic projection + function CFproj_get_lcc(ncid,mapid) + use parallel + implicit none + type(proj_lcc), pointer :: CFproj_get_lcc + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + allocate(CFproj_get_lcc) + status = parallel_get_att(ncid,mapid,'false_easting',CFproj_get_lcc%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'false_northing',CFproj_get_lcc%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'longitude_of_central_meridian',CFproj_get_lcc%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'latitude_of_projection_origin',CFproj_get_lcc%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(ncid,mapid,'standard_parallel',CFproj_get_lcc%standard_parallel) + call nc_errorhandle(__FILE__,__LINE__,status) + end function CFproj_get_lcc + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! private subroutines to write projection info + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> put parameters for stereographic projection + subroutine CFproj_put_stere(ncid,mapid,stere) + use parallel + implicit none + type(proj_stere), pointer :: stere !< the derived type containing projection parameters + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + + if (stere%pole/=0) then + status = parallel_put_att(ncid,mapid,'grid_mapping_name','polar_stereographic') + else + status = parallel_put_att(ncid,mapid,'grid_mapping_name','stereographic') + end if + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_easting',stere%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_northing',stere%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + if (stere%pole/=0) then + status = parallel_put_att(ncid,mapid,'straight_vertical_longitude_from_pole',stere%longitude_of_central_meridian) + else + status = parallel_put_att(ncid,mapid,'longitude_of_projection_origin',stere%longitude_of_central_meridian) + end if + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'latitude_of_projection_origin',stere%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + if (stere%pole/=0) then + if (stere%standard_parallel /= 0) then + status = parallel_put_att(ncid,mapid,'standard_parallel',stere%standard_parallel) + else + status = parallel_put_att(ncid,mapid,'scale_factor_at_projection_origin',stere%scale_factor_at_proj_origin) + end if + else + status = parallel_put_att(ncid,mapid,'scale_factor_at_projection_origin',stere%scale_factor_at_proj_origin) + end if + call nc_errorhandle(__FILE__,__LINE__,status) + end subroutine CFproj_put_stere + + !> put parameters for Lambert azimuthal equal area projection + subroutine CFproj_put_laea(ncid,mapid,laea) + use parallel + implicit none + type(proj_laea), pointer :: laea !< the derived type containing projection parameters + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + + status = parallel_put_att(ncid,mapid,'grid_mapping_name','lambert_azimuthal_equal_area') + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_easting',laea%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_northing',laea%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'longitude_of_projection_origin',laea%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'latitude_of_projection_origin',laea%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + end subroutine CFproj_put_laea + + !> put parameters for Albers conical equal area projection + subroutine CFproj_put_aea(ncid,mapid,aea) + use parallel + implicit none + type(proj_aea), pointer :: aea !< the derived type containing projection parameters + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + + status = parallel_put_att(ncid,mapid,'grid_mapping_name','albers_conical_equal_area') + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_easting',aea%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_northing',aea%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'longitude_of_central_meridian',aea%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'latitude_of_projection_origin',aea%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'standard_parallel',aea%standard_parallel) + call nc_errorhandle(__FILE__,__LINE__,status) + end subroutine CFproj_put_aea + + !> put parameters for Lambert conformal conic projection + subroutine CFproj_put_lcc(ncid,mapid,lcc) + use parallel + implicit none + type(proj_lcc), pointer :: lcc !< the derived type containing projection parameters + integer, intent(in) :: ncid !< Handle of netCDF file. + integer, intent(in) :: mapid !< Handle of map projection in netCDF file. + + integer status + + status = parallel_put_att(ncid,mapid,'grid_mapping_name','lambert_conformal_conic') + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_easting',lcc%false_easting) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'false_northing',lcc%false_northing) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'longitude_of_central_meridian',lcc%longitude_of_central_meridian) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'latitude_of_projection_origin',lcc%latitude_of_projection_origin) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(ncid,mapid,'standard_parallel',lcc%standard_parallel) + call nc_errorhandle(__FILE__,__LINE__,status) + end subroutine CFproj_put_lcc + +end module glimmer_map_CFproj diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_map_init.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_map_init.F90 new file mode 100644 index 0000000000..1e66b237f5 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_map_init.F90 @@ -0,0 +1,455 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_map_init.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> initialise map projection routines +module glimmer_map_init + + use glimmer_map_types + + implicit none + +contains + + !> read projection configuration from file + subroutine glimmap_readconfig(proj,config,dx,dy) + use glimmer_config + use glimmer_log + use glimmer_global, only: dp + implicit none + type(glimmap_proj),intent(inout) :: proj !< The projection parameters to be initialised + type(ConfigSection), pointer :: config !< structure holding sections of configuration file + real(dp),intent(in) :: dx !< grid resolution in x + real(dp),intent(in) :: dy !< grid resolution in y + + ! local variables + type(ConfigSection), pointer :: section + real(dp) :: lonc,latc,efalse,nfalse,stdp1,stdp2,scale_factor,cpx,cpy + real(dp),dimension(:),pointer :: std_par + character(10) :: ptype + logical :: stdp,scfac + integer :: ptval,ptold + + ptype = '' + lonc = 0.d0 ; latc = 0.d0 + efalse = 0.d0 ; nfalse = 0.d0 + std_par => null() + scale_factor = 0.d0 + stdp1 = 0.d0 + stdp2 = 0.d0 + + call GetSection(config,section,'projection') + if (associated(section)) then + call GetValue(section,'type',ptype) + call GetValue(section,'centre_longitude',lonc) + call GetValue(section,'centre_latitude',latc) + call GetValue(section,'false_easting',efalse) + call GetValue(section,'false_northing',nfalse) + call GetValue(section,'standard_parallel',std_par) + call GetValue(section,'scale_factor',scale_factor) + + ! Parse the projection type + if (index(ptype,'LAEA')/=0 .or. index(ptype,'laea')/=0) then + ptval = GMAP_LAEA + else if (index(ptype,'AEA')/=0 .or. index(ptype,'aea')/=0) then + ptval = GMAP_AEA + else if (index(ptype,'LCC')/=0 .or. index(ptype,'lcc')/=0) then + ptval = GMAP_LCC + else if (index(ptype,'STERE')/=0 .or. index(ptype,'stere')/=0) then + ptval = GMAP_STERE + else + call write_log('Unrecognised type in [projection]', & + GM_FATAL,__FILE__,__LINE__) + end if + + ! Deal with presence or not of standard parallel(s) + if (associated(std_par)) then + stdp = .true. + select case (size(std_par)) + case(1) + stdp1 = std_par(1) ; stdp2 = std_par(1) + case(2) + stdp1 = std_par(1) ; stdp2 = std_par(2) + case(0) + stdp=.false. + case default + call write_log('More than two Standard parallels given', & + GM_FATAL,__FILE__,__LINE__) + end select + else + stdp = .false. + end if + + ! Deal with scale factor + if (scale_factor /= 0.d0) then + scfac = .true. + else + scfac = .false. + end if + + else + call GetSection(config,section,'GLINT projection') + if(.not.associated(section)) return + call write_log('Using [GLINT projection] config section',GM_WARNING) + call write_log('This config option has been deprecated, and will be removed at some point.',GM_WARNING) + call write_log('Use [projection] instead',GM_WARNING) + call GetValue(section,'projection',ptold) + call GetValue(section,'lonc',lonc) + call GetValue(section,'latc',latc) + call GetValue(section,'cpx',cpx) + call GetValue(section,'cpy',cpy) + call GetValue(section,'std_parallel',stdp1) + select case(ptold) + case(1) + ptval = GMAP_LAEA + case(2:4) + ptval = GMAP_STERE + case default + call write_log('Unsupported projection in [GLINT projection] config section',GM_FATAL) + end select + efalse = dx*(cpx-1) + nfalse = dy*(cpy-1) + if (stdp1 /= 0.d0) then + stdp2 = stdp1 + stdp = .true. + else + stdp = .false. + end if + scfac=.false. + end if + + + ! Check for conflict + + if (stdp.and.scfac) then + call write_log('You cannot specify both a standard parallel and a scale factor.', & + GM_FATAL,__FILE__,__LINE__) + end if + + ! Initialise the projection + + if (stdp) then + call glimmap_proj_define(proj,ptval, & + lonc,latc,efalse,nfalse, & + standard_parallel = stdp1, & + standard_parallel_2 = stdp2) + else if (scfac) then + call glimmap_proj_define(proj,ptval, & + lonc,latc,efalse,nfalse, & + scale_factor_at_proj_origin = scale_factor) + else + call glimmap_proj_define(proj,ptval, & + lonc,latc,efalse,nfalse) + end if + + end subroutine glimmap_readconfig + + !------------------------------------------------------------------------- + + !> print projection info to log + subroutine glimmap_printproj(proj) + use glimmer_log + use glimmer_global, only : msg_length + + type(glimmap_proj),intent(in) :: proj !< the projection + + character(len=msg_length) :: message + + call write_log('Projection') + call write_log('----------') + if (.not.proj%found) then + call write_log('No projection found') + return + end if + + if (associated(proj%laea)) then + + call write_log('Type: Lambert Azimuthal Equal Area') + write(message,*)'Longitude of central meridian: ',proj%laea%longitude_of_central_meridian + call write_log(message) + write(message,*)'Latitude of projection origin: ',proj%laea%latitude_of_projection_origin + call write_log(message) + write(message,*)'False easting: ',proj%laea%false_easting + call write_log(message) + write(message,*)'False northing: ',proj%laea%false_northing + call write_log(message) + + else if (associated(proj%aea)) then + + call write_log('Type: Albers Equal Area Conic') + write(message,*)'Longitude of central meridian: ',proj%aea%longitude_of_central_meridian + call write_log(message) + write(message,*)'Latitude of projection origin: ',proj%aea%latitude_of_projection_origin + call write_log(message) + write(message,*)'False easting: ',proj%aea%false_easting + call write_log(message) + write(message,*)'False northing: ',proj%aea%false_northing + call write_log(message) + write(message,*)'Standard parallels: ', & + proj%aea%standard_parallel(1),proj%aea%standard_parallel(2) + call write_log(message) + + else if (associated(proj%lcc)) then + + call write_log('Type: Lambert Conformal Conic') + write(message,*)'Longitude of central meridian: ',proj%lcc%longitude_of_central_meridian + call write_log(message) + write(message,*)'Latitude of projection origin: ',proj%lcc%latitude_of_projection_origin + call write_log(message) + write(message,*)'False easting: ',proj%lcc%false_easting + call write_log(message) + write(message,*)'False northing: ',proj%lcc%false_northing + call write_log(message) + write(message,*)'Standard parallels: ', & + proj%lcc%standard_parallel(1),proj%lcc%standard_parallel(2) + call write_log(message) + + else if (associated(proj%stere)) then + + call write_log('Type: Stereographic') + write(message,*)'Longitude of central meridian: ',proj%stere%longitude_of_central_meridian + call write_log(message) + write(message,*)'Latitude of projection origin: ',proj%stere%latitude_of_projection_origin + call write_log(message) + write(message,*)'False easting: ',proj%stere%false_easting + call write_log(message) + write(message,*)'False northing: ',proj%stere%false_northing + call write_log(message) + write(message,*)'Standard parallel: ',proj%stere%standard_parallel + call write_log(message) + write(message,*)'Scale factor: ',proj%stere%scale_factor_at_proj_origin + + end if + + end subroutine glimmap_printproj + + !------------------------------------------------------------------------- + + !> Defines a projection from scratch, and initialises + !! the other elements appropriately. + subroutine glimmap_proj_define(cfp,ptype, & + longitude_of_central_meridian, & + latitude_of_projection_origin, & + false_easting, & + false_northing, & + scale_factor_at_proj_origin, & + standard_parallel, & + standard_parallel_2) + + use glimmer_log + + type(glimmap_proj),intent(inout) :: cfp !< the projection data type + integer,intent(in) :: ptype !< the projection ID + real(dp),intent(in) :: longitude_of_central_meridian !< the longitude of the central meridian + real(dp),intent(in) :: latitude_of_projection_origin !< the latitude of the projection origin + real(dp),intent(in) :: false_easting !< false easting + real(dp),intent(in) :: false_northing !< false northing + real(dp),optional,intent(in) :: scale_factor_at_proj_origin !< scale factor + real(dp),optional,intent(in) :: standard_parallel !< standard parallel 1 + real(dp),optional,intent(in) :: standard_parallel_2 !< standard parallel 2 + + + if (associated(cfp%laea)) deallocate(cfp%laea) + if (associated(cfp%aea)) deallocate(cfp%aea) + if (associated(cfp%lcc)) deallocate(cfp%lcc) + if (associated(cfp%stere)) deallocate(cfp%stere) + + cfp%found = .true. + select case(ptype) + case(GMAP_LAEA) + allocate(cfp%laea) + cfp%laea%longitude_of_central_meridian = longitude_of_central_meridian + cfp%laea%latitude_of_projection_origin = latitude_of_projection_origin + cfp%laea%false_easting = false_easting + cfp%laea%false_northing = false_northing + call glimmap_laea_init(cfp%laea) + case(GMAP_AEA) + allocate(cfp%aea) + cfp%aea%longitude_of_central_meridian = longitude_of_central_meridian + cfp%aea%latitude_of_projection_origin = latitude_of_projection_origin + cfp%aea%false_easting = false_easting + cfp%aea%false_northing = false_northing + if (present(standard_parallel).and.present(standard_parallel_2)) then + cfp%aea%standard_parallel = (/ standard_parallel,standard_parallel_2 /) + else if (present(standard_parallel).and..not.present(standard_parallel_2)) then + cfp%aea%standard_parallel = (/ standard_parallel,standard_parallel /) + else + call write_log('Albers Equal Area: you must supply at least one standard parallel',& + GM_FATAL,__FILE__,__LINE__) + end if + call glimmap_aea_init(cfp%aea) + case(GMAP_LCC) + allocate(cfp%lcc) + cfp%lcc%longitude_of_central_meridian = longitude_of_central_meridian + cfp%lcc%latitude_of_projection_origin = latitude_of_projection_origin + cfp%lcc%false_easting = false_easting + cfp%lcc%false_northing = false_northing + if (present(standard_parallel).and.present(standard_parallel_2)) then + cfp%lcc%standard_parallel = (/ standard_parallel,standard_parallel_2 /) + else if (present(standard_parallel).and..not.present(standard_parallel_2)) then + cfp%lcc%standard_parallel = (/ standard_parallel,standard_parallel /) + else + call write_log('Lambert Conformal Conic: you must supply at least one standard parallel',& + GM_FATAL,__FILE__,__LINE__) + end if + call glimmap_lcc_init(cfp%lcc) + case(GMAP_STERE) + allocate(cfp%stere) + cfp%stere%longitude_of_central_meridian = longitude_of_central_meridian + cfp%stere%latitude_of_projection_origin = latitude_of_projection_origin + cfp%stere%false_easting = false_easting + cfp%stere%false_northing = false_northing + if(present(scale_factor_at_proj_origin) .and. present(standard_parallel)) then + if (scale_factor_at_proj_origin/=0.d0 .and. standard_parallel/=0.d0) & + call write_log('Both standard parallel and scale factor specified', & + GM_FATAL,__FILE__,__LINE__) + end if + if(present(scale_factor_at_proj_origin)) & + cfp%stere%scale_factor_at_proj_origin = scale_factor_at_proj_origin + if(present(standard_parallel)) & + cfp%stere%standard_parallel = standard_parallel + call glimmap_stere_init(cfp%stere) + case default + call write_log('Unrecognised projection type', & + GM_FATAL,__FILE__,__LINE__) + end select + + end subroutine glimmap_proj_define + + !> initialise Lambert azimuthal equal area projection + subroutine glimmap_laea_init(params) + + type(proj_laea),intent(inout) :: params + + params%sinp=sin(params%latitude_of_projection_origin*D2R) + params%cosp=cos(params%latitude_of_projection_origin*D2R) + + ! Check whether polar + + if (abs(params%latitude_of_projection_origin-90.d0) initialise Lambert azimuthal equal area projection + subroutine glimmap_aea_init(params) + + type(proj_aea),intent(inout) :: params + + params%n = 0.5d0*(sin(params%standard_parallel(1)*D2R) & + + sin(params%standard_parallel(2)*D2R)) + params%i_n = 1.d0/params%n + params%c = cos(params%standard_parallel(1)*D2R)**2.d0 & + + 2.d0*params%n*sin(params%standard_parallel(1)*D2R) + params%rho0_R = params%i_n * sqrt(params%c - & + 2.d0*params%n*sin(params%latitude_of_projection_origin*D2R)) + params%rho0 = params%rho0_R * EQ_RAD + + end subroutine glimmap_aea_init + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> initialise Lambert conformal conic projection + subroutine glimmap_lcc_init(params) + + type(proj_lcc),intent(inout) :: params + + if (abs(params%standard_parallel(1)-params%standard_parallel(2)) initialise stereographic projection + subroutine glimmap_stere_init(params) + + use glimmer_log + + type(proj_stere),intent(inout) :: params + + ! Determine polar/equatorial, etc. + + if (abs(params%latitude_of_projection_origin-90.d0) < CONV_LIMIT) then + params%pole = 1 + else if (abs(params%latitude_of_projection_origin+90.d0) < CONV_LIMIT) then + params%pole = -1 + else + params%pole = 0 + if (abs(params%latitude_of_projection_origin) < CONV_LIMIT) then + params%equatorial = .true. + else + params%equatorial = .false. + end if + end if + + ! Set up constants accordingly + + if (params%pole==1 .or. params%pole==-1) then + if (params%standard_parallel /= 0.d0) then + if (params%pole==1) params%k0 = EQ_RAD * (1.d0 + sin(D2R*params%standard_parallel))/2.d0 + if (params%pole==-1) params%k0 = EQ_RAD * (1.d0 - sin(D2R*params%standard_parallel))/2.d0 + else if (params%scale_factor_at_proj_origin /= 0.d0) then + params%k0 = EQ_RAD * params%scale_factor_at_proj_origin + else + params%k0 = EQ_RAD + end if + else + if (params%scale_factor_at_proj_origin /= 0.d0) then + params%k0 = EQ_RAD * params%scale_factor_at_proj_origin + else + params%k0 = EQ_RAD + end if + if (params%standard_parallel /= 0.d0) & + call write_log('Stereographic projection not polar: ignoring standard parallel',GM_WARNING) + params%sinp = sin(D2R * params%latitude_of_projection_origin) + params%cosp = cos(D2R * params%latitude_of_projection_origin) + end if + + params%ik0 = 1.d0/params%k0 + + end subroutine glimmap_stere_init + +end module glimmer_map_init diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_map_proj4.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_map_proj4.F90 new file mode 100644 index 0000000000..5cfa654447 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_map_proj4.F90 @@ -0,0 +1,151 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_map_proj4.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> Generates proj4 strings from projection data type. +!! Not used in GLIMMER at present. +module glimmer_map_proj4 + + use glimmer_map_types + + implicit none + + private + public :: glimmap_proj4 + + integer, parameter :: proj4len=100 + +contains + + !> Returns a proj4 parameter string for a given set of projection parameters + !! \return Pointer to array of projection parameter strings + function glimmap_proj4(proj) + + use glimmer_log + + implicit none + character(len=proj4len), dimension(:), pointer :: glimmap_proj4 + type(glimmap_proj) :: proj !> Projection of interest + + if (.not.glimmap_allocated(proj)) then + call write_log('No known projection found!',GM_WARNING) + return + end if + + if (associated(proj%laea)) then + glimmap_proj4 => glimmap_proj4_laea(proj%laea) + return + else if (associated(proj%aea)) then + glimmap_proj4 => glimmap_proj4_aea(proj%aea) + return + else if (associated(proj%lcc)) then + glimmap_proj4 => glimmap_proj4_lcc(proj%lcc) + return + else if (associated(proj%stere)) then + glimmap_proj4 => glimmap_proj4_stere(proj%stere) + return + else + call write_log('No known projection found!',GM_WARNING) + end if + end function glimmap_proj4 + + !------------------------------------------------------------------ + ! private converters to proj4 strings + !------------------------------------------------------------------ + + !> Returns a proj4 parameter string for a stereographic projection + function glimmap_proj4_stere(stere) + implicit none + character(len=proj4len), dimension(:), pointer :: glimmap_proj4_stere + type(proj_stere) :: stere + + allocate(glimmap_proj4_stere(6)) + write(glimmap_proj4_stere(1),*) 'proj=stere' + write(glimmap_proj4_stere(2),*) 'lon_0=',stere%longitude_of_central_meridian + write(glimmap_proj4_stere(3),*) 'lat_0=',stere%latitude_of_projection_origin + if (stere%pole/=0) then + if (stere%standard_parallel /= 0) then + write(glimmap_proj4_stere(4),*) 'lat_ts=',stere%standard_parallel + else + write(glimmap_proj4_stere(4),*) 'k_0=',stere%scale_factor_at_proj_origin + end if + else + write(glimmap_proj4_stere(4),*) 'k_0=',stere%scale_factor_at_proj_origin + end if + write(glimmap_proj4_stere(5),*) 'x_0=',stere%false_easting + write(glimmap_proj4_stere(6),*) 'y_0=',stere%false_northing + end function glimmap_proj4_stere + + !> Returns a proj4 parameter string for a Lambert azimuthal equal area projection + function glimmap_proj4_laea(laea) + implicit none + character(len=proj4len), dimension(:), pointer :: glimmap_proj4_laea + type(proj_laea) :: laea + + allocate(glimmap_proj4_laea(5)) + write(glimmap_proj4_laea(1),*) 'proj=laea' + write(glimmap_proj4_laea(2),*) 'lon_0=',laea%longitude_of_central_meridian + write(glimmap_proj4_laea(3),*) 'lat_0=',laea%latitude_of_projection_origin + write(glimmap_proj4_laea(4),*) 'x_0=',laea%false_easting + write(glimmap_proj4_laea(5),*) 'y_0=',laea%false_northing + end function glimmap_proj4_laea + + !> Returns a proj4 parameter string for a Lambert azimuthal equal area projection + function glimmap_proj4_aea(aea) + implicit none + character(len=proj4len), dimension(:), pointer :: glimmap_proj4_aea + type(proj_aea) :: aea + + allocate(glimmap_proj4_aea(7)) + write(glimmap_proj4_aea(1),*) 'proj=aea' + write(glimmap_proj4_aea(2),*) 'lon_0=',aea%longitude_of_central_meridian + write(glimmap_proj4_aea(3),*) 'lat_0=',aea%latitude_of_projection_origin + write(glimmap_proj4_aea(4),*) 'lat_1=',aea%standard_parallel(1) + write(glimmap_proj4_aea(5),*) 'lat_2=',aea%standard_parallel(2) + write(glimmap_proj4_aea(6),*) 'x_0=',aea%false_easting + write(glimmap_proj4_aea(7),*) 'y_0=',aea%false_northing + end function glimmap_proj4_aea + + !> Returns a proj4 parameter string for a Lambert conformal conic projection + function glimmap_proj4_lcc(lcc) + implicit none + character(len=proj4len), dimension(:), pointer :: glimmap_proj4_lcc + type(proj_lcc) :: lcc + + allocate(glimmap_proj4_lcc(7)) + write(glimmap_proj4_lcc(1),*) 'proj=lcc' + write(glimmap_proj4_lcc(2),*) 'lon_0=',lcc%longitude_of_central_meridian + write(glimmap_proj4_lcc(3),*) 'lat_0=',lcc%latitude_of_projection_origin + write(glimmap_proj4_lcc(4),*) 'lat_1=',lcc%standard_parallel(1) + write(glimmap_proj4_lcc(5),*) 'lat_2=',lcc%standard_parallel(2) + write(glimmap_proj4_lcc(6),*) 'x_0=',lcc%false_easting + write(glimmap_proj4_lcc(7),*) 'y_0=',lcc%false_northing + end function glimmap_proj4_lcc + +end module glimmer_map_proj4 diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_map_trans.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_map_trans.F90 new file mode 100644 index 0000000000..fca131efbf --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_map_trans.F90 @@ -0,0 +1,566 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_map_trans.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> convert between projections +module glimmer_map_trans + + use glimmer_map_types + use glimmer_global, only: dp + implicit none + + private + public :: glimmap_ll_to_xy, glimmap_xy_to_ll, loncorrect + + +contains + + !> Convert lat-long coordinates to grid coordinates. + !! + !! The subroutine returns the x-y coordinates as real values, + !! non-integer values indicating a position between grid-points. + subroutine glimmap_ll_to_xy(lon,lat,x,y,proj,grid) + + use glimmer_log + use glimmer_coordinates + + implicit none + + real(dp),intent(in) :: lon !< The location of the point in lat-lon space (Longitude) + real(dp),intent(in) :: lat !< The location of the point in lat-lon space (Latitude) + real(dp),intent(out) :: x !< The location of the point in x-y space (x coordinate) + real(dp),intent(out) :: y !< The location of the point in x-y space (y coordinate) + type(glimmap_proj), intent(in) :: proj !< The projection being used + type(coordsystem_type),intent(in) :: grid !< the grid definition + + real(dp) :: xx,yy ! These are real-space distances in meters + + if (associated(proj%laea)) then + call glimmap_laea(lon,lat,xx,yy,proj%laea) + else if (associated(proj%aea)) then + call glimmap_aea(lon,lat,xx,yy,proj%aea) + else if (associated(proj%lcc)) then + call glimmap_lcc(lon,lat,xx,yy,proj%lcc) + else if (associated(proj%stere)) then + call glimmap_stere(lon,lat,xx,yy,proj%stere) + else + call write_log('No known projection found!',GM_WARNING) + end if + + ! Now convert the real-space distances to grid-points using the grid type + + call space2grid(xx,yy,x,y,grid) + + end subroutine glimmap_ll_to_xy + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Convert grid coordinates to lat-lon coordinates. + !! + !! The subroutine returns the lat-lon coordinates as real values, + !! non-integer values indicating a position between grid-points. + subroutine glimmap_xy_to_ll(lon,lat,x,y,proj,grid) + + + use glimmer_log + use glimmer_coordinates + + implicit none + + real(dp),intent(out) :: lon !< The location of the point in lat-lon space (Longitude) + real(dp),intent(out) :: lat !< The location of the point in lat-lon space (Latitude) + real(dp),intent(in) :: x !< The location of the point in x-y space (x coordinate) + real(dp),intent(in) :: y !< The location of the point in x-y space (y coordinate) + type(glimmap_proj), intent(in) :: proj !< The projection being used + type(coordsystem_type),intent(in) :: grid !< the grid definition + + real(dp) :: xx,yy ! These are real-space distances in meters + + ! First convert grid-point space to real space + + call grid2space(xx,yy,x,y,grid) + + if (associated(proj%laea)) then + call glimmap_ilaea(lon,lat,xx,yy,proj%laea) + else if (associated(proj%aea)) then + call glimmap_iaea(lon,lat,xx,yy,proj%aea) + else if (associated(proj%lcc)) then + call glimmap_ilcc(lon,lat,xx,yy,proj%lcc) + else if (associated(proj%stere)) then + call glimmap_istere(lon,lat,xx,yy,proj%stere) + else + call write_log('No known projection found!',GM_WARNING) + end if + + lon=loncorrect(lon,0.d0) + + end subroutine glimmap_xy_to_ll + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! PRIVATE subroutines follow + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Lambert azimuthal equal area projection + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Forward transformation: lat-lon -> x-y of Lambert azimuthal equal area projection + subroutine glimmap_laea(lon,lat,x,y,params) + + + use glimmer_log + + real(dp),intent(in) :: lon !< longitude + real(dp),intent(in) :: lat !< latitude + real(dp),intent(out) :: x !< x + real(dp),intent(out) :: y !< y + type(proj_laea),intent(in) :: params !< projection parameters + + real(dp) :: sin_lat,cos_lat,sin_lon,cos_lon,c,dlon,dlat,tmp,k + character(80) :: errtxt + + dlon = lon-params%longitude_of_central_meridian + + ! Check domain of longitude + + dlon = loncorrect(dlon,-180.d0) + + ! Convert to radians and calculate sine and cos + + dlon = dlon*D2R ; dlat = lat*D2R + + call sincos(dlon,sin_lon,cos_lon); + call sincos(dlat,sin_lat,cos_lat); + c = cos_lat * cos_lon + + ! Mapping transformation + + tmp = 1.d0 + params%sinp * sin_lat + params%cosp * c + + if (tmp > 0.d0) then + k = EQ_RAD * sqrt (2.d0 / tmp) + x = k * cos_lat * sin_lon + y = k * (params%cosp * sin_lat - params%sinp * c) + else + write(errtxt,*)'LAEA projection error:',lon,lat,params%latitude_of_projection_origin + call write_log(trim(errtxt),GM_FATAL,__FILE__,__LINE__) + endif + + ! Apply false eastings and northings + + x = x + params%false_easting + y = y + params%false_northing + + end subroutine glimmap_laea + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Inverse transformation: lat-lon -> x-y of Lambert azimuthal equal area projection + subroutine glimmap_ilaea(lon,lat,x,y,params) + + use glimmer_log + + real(dp),intent(out) :: lon !< longitude + real(dp),intent(out) :: lat !< latitude + real(dp),intent(in) :: x !< x + real(dp),intent(in) :: y !< y + type(proj_laea),intent(in) :: params !< projection parameters + + real(dp) :: rho,c,sin_c,cos_c,xx,yy + character(80) :: errtxt + + xx=x ; yy=y + + ! Account for false eastings and northings + + xx = xx - params%false_easting + yy = yy - params%false_northing + + rho=hypot (xx,yy) + + if (abs(rho) < CONV_LIMIT) then + ! If very near the centre of the map... + lat = params%latitude_of_projection_origin + lon = params%longitude_of_central_meridian + else + c = 2.d0 * asin(0.5d0 * rho * i_EQ_RAD) + call sincos (c, sin_c, cos_c) + lat = asin (cos_c * params%sinp + (yy * sin_c * params%cosp / rho)) * R2D + select case(params%pole) + case(1) + lon = params%longitude_of_central_meridian + R2D * atan2 (xx, -yy) + case(-1) + lon = params%longitude_of_central_meridian + R2D * atan2 (xx, yy) + case(0) + lon = params%longitude_of_central_meridian + & + R2D * atan2 (xx * sin_c, (rho * params%cosp * cos_c - yy * params%sinp * sin_c)) + case default + write(errtxt,*)'Inverse LAEA projection error:',params%pole + call write_log(trim(errtxt),GM_FATAL,__FILE__,__LINE__) + end select + endif + + end subroutine glimmap_ilaea + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Albers equal area conic projection + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Forward transformation: lat-lon -> x-y of Albers equal area conic projection + subroutine glimmap_aea(lon,lat,x,y,params) + + real(dp),intent(in) :: lon !< longitude + real(dp),intent(in) :: lat !< latitude + real(dp),intent(out) :: x !< x + real(dp),intent(out) :: y !< y + type(proj_aea),intent(in) :: params !< projection parameters + + real(dp) :: dlon,theta,sint,cost,rho + + dlon = lon-params%longitude_of_central_meridian + + ! Check domain of longitude + + dlon = loncorrect(dlon,-180.d0) + theta = params%n * dlon * D2R + call sincos(theta,sint,cost) + + rho = params%i_n*sqrt(params%c - 2.0*params%n*sin(lat*D2R)) + + x = EQ_RAD * rho * sint + y = EQ_RAD * (params%rho0_R - rho * cost) + + ! Apply false eastings and northings + + x = x + params%false_easting + y = y + params%false_northing + + end subroutine glimmap_aea + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Inverse transformation: lat-lon -> x-y of Albers equal area conic projection + subroutine glimmap_iaea(lon,lat,x,y,params) + + real(dp),intent(out) :: lon !< longitude + real(dp),intent(out) :: lat !< latitude + real(dp),intent(in) :: x !< x + real(dp),intent(in) :: y !< y + type(proj_aea),intent(in) :: params !< projection parameters + + real(dp) :: xx,yy,rho,theta + + xx=x ; yy=y + + ! Account for false eastings and northings + + xx = xx - params%false_easting + yy = yy - params%false_northing + + rho = sqrt(xx**2.d0 + (params%rho0 - yy)**2.d0) + if (params%n > 0.d0) then + theta = atan2(xx,(params%rho0-yy)) + else + theta = atan2(-xx,(yy-params%rho0)) + end if + + lat = asin((params%c-(rho*params%n/EQ_RAD)**2.d0)*0.5d0*params%i_n)*R2D + lon = params%longitude_of_central_meridian+R2D*theta*params%i_n + + end subroutine glimmap_iaea + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Lambert conformal conic projection + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Forward transformation: lat-lon -> x-y of Lambert conformal conic projection + subroutine glimmap_lcc(lon,lat,x,y,params) + + real(dp),intent(in) :: lon !< longitude + real(dp),intent(in) :: lat !< latitude + real(dp),intent(out) :: x !< x + real(dp),intent(out) :: y !< y + type(proj_lcc),intent(in) :: params !< projection parameters + + real(dp) :: dlon,rho,theta,sint,cost + + dlon = lon-params%longitude_of_central_meridian + + ! Check domain of longitude + + dlon = loncorrect(dlon,-180.d0) + rho = EQ_RAD * params%f/(tan(M_PI_4+lat*D2R/2.d0))**params%n + theta = params%n*dlon*D2R + call sincos(theta,sint,cost) + + x = rho * sint + y = params%rho0 - rho * cost + + ! Apply false eastings and northings + + x = x + params%false_easting + y = y + params%false_northing + + end subroutine glimmap_lcc + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Inverse transformation: lat-lon -> x-y of Lambert conformal conic projection + subroutine glimmap_ilcc(lon,lat,x,y,params) + + real(dp),intent(out) :: lon !< longitude + real(dp),intent(out) :: lat !< latitude + real(dp),intent(in) :: x !< x + real(dp),intent(in) :: y !< y + type(proj_lcc),intent(in) :: params !< projection parameters + + real(dp) :: xx,yy,rho,theta + + xx=x ; yy=y + + ! Account for false eastings and northings + + xx = xx - params%false_easting + yy = yy - params%false_northing + + rho = sign(sqrt(xx**2.d0 + (params%rho0-yy)**2.d0),params%n) + if (params%n > 0.d0) then + theta = atan2(xx,(params%rho0-yy)) + else + theta = atan2(-xx,(yy-params%rho0)) + end if + + if (abs(rho) < CONV_LIMIT) then + lat = sign(real(90.d0,kind=dp),params%n) + else + lat = R2D * (2.d0 * atan((EQ_RAD*params%f/rho)**params%i_n) - M_PI_2) + end if + + lon = params%longitude_of_central_meridian+R2D*theta*params%i_n + + end subroutine glimmap_ilcc + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Stereographic projection + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Forward transformation: lat-lon -> x-y of Stereographic projection + subroutine glimmap_stere(lon,lat,x,y,params) + + use glimmer_log + + real(dp),intent(in) :: lon !< longitude + real(dp),intent(in) :: lat !< latitude + real(dp),intent(out) :: x !< x + real(dp),intent(out) :: y !< y + type(proj_stere),intent(in) :: params !< projection parameters + + real(dp) :: dlon,k,dlat,slat,clat,slon,clon + character(80) :: errtxt + + dlon = lon-params%longitude_of_central_meridian + + ! Check domain of longitude + + dlon = loncorrect(dlon,-180.d0) + dlon = dlon * D2R + dlat = lat * D2R + call sincos(dlon,slon,clon) + + select case(params%pole) + case(1) ! North pole + x = 2.d0 * params%k0 * tan(M_PI_4 - dlat/2.d0)*slon + y = -2.d0 * params%k0 * tan(M_PI_4 - dlat/2.d0)*clon + case(-1) ! South pole + x = 2.d0 * params%k0 * tan(M_PI_4 + dlat/2.d0)*slon + y = 2.d0 * params%k0 * tan(M_PI_4 + dlat/2.d0)*clon + case(0) ! Oblique + call sincos(dlat,slat,clat) + if (params%equatorial) then + k = 2.d0 * params%k0 / (1.d0 + clat*clon) + y = k * slat + else + k = 2.d0 * params%k0 / (1.d0 + params%sinp*slat + params%cosp*clat*clon) + y = k * (params%cosp*slat - params%sinp*clat*clon) + end if + x = k * clat * slon + case default + write(errtxt,*)'Stereographic projection error:',params%pole + call write_log(trim(errtxt),GM_FATAL,__FILE__,__LINE__) + end select + + ! Apply false eastings and northings + + x = x + params%false_easting + y = y + params%false_northing + + end subroutine glimmap_stere + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Inverse transformation: lat-lon -> x-y of Stereographic projection + subroutine glimmap_istere(lon,lat,x,y,params) + + real(dp),intent(out) :: lon !< longitude + real(dp),intent(out) :: lat !< latitude + real(dp),intent(in) :: x !< x + real(dp),intent(in) :: y !< y + type(proj_stere),intent(in) :: params !< projection parameters + + real(dp) :: xx,yy,rho,c,sinc,cosc + + xx=x ; yy=y + + ! Account for false eastings and northings + + xx = xx - params%false_easting + yy = yy - params%false_northing + + rho = hypot(xx,yy) + + if (abs(rho) transform from grid to space + subroutine grid2space(x,y,gx,gy,coordsys) + + use glimmer_coordinates + + implicit none + + real(dp),intent(out) :: x !< x-location in real space + real(dp),intent(out) :: y !< y-location in real space + real(dp),intent(in) :: gx !< x-location in grid space + real(dp),intent(in) :: gy !< y-location in grid space + type(coordsystem_type), intent(in) :: coordsys !< coordinate system + + x=coordsys%origin%pt(1) + real(gx - 1)*coordsys%delta%pt(1) + y=coordsys%origin%pt(2) + real(gy - 1)*coordsys%delta%pt(2) + + end subroutine grid2space + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> convert from space to grid + subroutine space2grid(x,y,gx,gy,coordsys) + + use glimmer_coordinates + + implicit none + + real(dp),intent(in) :: x !< x-location in real space + real(dp),intent(in) :: y !< y-location in real space + real(dp),intent(out) :: gx !< x-location in grid space + real(dp),intent(out) :: gy !< y-location in grid space + type(coordsystem_type), intent(in) :: coordsys !< coordinate system + + gx = 1.d0 + (x - coordsys%origin%pt(1))/coordsys%delta%pt(1) + gy = 1.d0 + (y - coordsys%origin%pt(2))/coordsys%delta%pt(2) + + end subroutine space2grid + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Calculates the sin and cos of an angle. + subroutine sincos(a,s,c) + + implicit none + + real(dp),intent(in) :: a !< Input value (radians). + real(dp),intent(out) :: s !< sin(a) + real(dp),intent(out) :: c !< cos(a) + + s = sin(a) + c = cos(a) + + end subroutine sincos + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Normalises a value of longitude to the range starting at min degrees. + !! \return The normalised value of longitude. + real(dp) function loncorrect(lon,minimum) + + real(dp),intent(in) :: lon !< The longitude under consideration (degrees east) + real(dp),intent(in) :: minimum !< The lower end of the output range (degrees east) + + real(dp) :: maximum + + loncorrect = lon + maximum = minimum + 360.d0 + + do while (loncorrect >= maximum) + loncorrect = loncorrect-360.d0 + enddo + + do while (loncorrect < minimum) + loncorrect = loncorrect+360.d0 + enddo + + end function loncorrect + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> compute \f$\sqrt{x^2+y^2}\f$ + real(dp) function hypot(x,y) + + + implicit none + + real(dp),intent(in) :: x !< One input value + real(dp),intent(in) :: y !< Another input value + + hypot=sqrt(x*x+y*y) + + end function hypot + +end module glimmer_map_trans diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_map_types.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_map_types.F90 new file mode 100644 index 0000000000..ce551470f2 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_map_types.F90 @@ -0,0 +1,193 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_map_types.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> This module contains derived types. +!! +module glimmer_map_types + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + + implicit none + + !> derived type holding all know map projections. This simulates inheritance + type glimmap_proj + logical :: found = .false. + type(proj_laea), pointer :: laea => NULL() !< Pointer to Lambert azimuthal equal area type + type(proj_aea), pointer :: aea => NULL() !< Pointer to Albers equal area conic type + type(proj_lcc), pointer :: lcc => NULL() !< Pointer to Lambert conic conformal type + type(proj_stere), pointer :: stere => NULL() !< Pointer to Stereographic type + end type glimmap_proj + + !------------------------------------------------------------- + + !> Lambert Azimuthal Equal Area + type proj_laea + real(dp) :: longitude_of_central_meridian !< longitude of central meridian + real(dp) :: latitude_of_projection_origin !< latitude of projection origin + real(dp) :: false_easting !< false easting + real(dp) :: false_northing !< false northing + real(dp) :: sinp !< Sine of latitude_of_projection_origin + real(dp) :: cosp !< Cosine of latitude_of_projection_origin + integer :: pole !< Set to 1 for N pole, -1 for S pole, 0 otherwise + end type proj_laea + + !------------------------------------------------------------- + + !> Albers Equal-Area Conic + type proj_aea + real(dp),dimension(2) :: standard_parallel !< two standard parallels + real(dp) :: longitude_of_central_meridian !< longitude of central meridian + real(dp) :: latitude_of_projection_origin !< latitude of projection origin + real(dp) :: false_easting !< false easting + real(dp) :: false_northing !< false northing + real(dp) :: rho0 !< Convenience constant + real(dp) :: rho0_R !< Convenience constant (is rho0/EQ_RAD) + real(dp) :: c !< Convenience constant + real(dp) :: n !< Convenience constant + real(dp) :: i_n !< Convenience constant (inverse of n) + end type proj_aea + + !------------------------------------------------------------- + + !> Lambert Conic Conformal + type proj_lcc + real(dp),dimension(2) :: standard_parallel !< two standard parallels + real(dp) :: longitude_of_central_meridian !< longitude of central meridian + real(dp) :: latitude_of_projection_origin !< latitude of projection origin + real(dp) :: false_easting !< false easting + real(dp) :: false_northing !< false northing + real(dp) :: rho0 !< Convenience constant + real(dp) :: f !< Convenience constant + real(dp) :: n !< Convenience constant + real(dp) :: i_n !< Convenience constant (inverse of n) + end type proj_lcc + + !------------------------------------------------------------- + + !> Stereographic projection derived type + type proj_stere + real(dp) :: longitude_of_central_meridian !< longitude of central meridian + real(dp) :: latitude_of_projection_origin !< latitude of projection origin + real(dp) :: scale_factor_at_proj_origin = 0.d0 !< scale factor at origin + real(dp) :: standard_parallel = 0.d0 !< a standard parallel + real(dp) :: false_easting !< false easting + real(dp) :: false_northing !< false northing + integer :: pole !< Set to 1 for N pole, -1 for S pole, 0 otherwise + logical :: equatorial !< Set true if equatorial aspect + real(dp) :: k0 !< scale factor or std par converted to scale factor + real(dp) :: ik0 !< inverse of k0 + real(dp) :: sinp !< sin of latitude_of_projection_origin + real(dp) :: cosp !< cos of latitude_of_projection_origin + end type proj_stere + + ! Global mapping parameters ---------------------------------- + +! real(dp),parameter :: pi = 3.141592654 !< The value of $\pi$. ! defined in glimmer_physcon + real(dp),parameter :: M_PI_4 = pi/4.d0 !< The value of $\pi/4$. + real(dp),parameter :: M_PI_2 = pi/2.d0 !< The value of $\pi/2$. + real(dp),parameter :: D2R = pi/180.d0 !< Degrees-to-radians conversion factor. + real(dp),parameter :: R2D = 180.d0/pi !< Radians-to-degrees conversion factor. + real(dp),parameter :: EQ_RAD = 6.37d6 !< Radius of the earth (m) + real(dp),parameter :: i_EQ_RAD = 1.d0/EQ_RAD !< Inverse radius of the earth (m^-1) + real(dp),parameter :: CONV_LIMIT = 1.0d-8 !< Convergence limit (a small number). + + integer, parameter :: GMAP_LAEA=1 !< ID for Lambert azimuthal equal area projection + integer, parameter :: GMAP_AEA=2 !< ID for Lambert azimuthal equal area projection + integer, parameter :: GMAP_LCC=3 !< ID for Lambert conformal conic projection + integer, parameter :: GMAP_STERE=4 !< ID for stereographic projection + +contains + + !> return true if structure contains a known projection + function glimmap_allocated(proj) + + implicit none + type(glimmap_proj) :: proj + logical glimmap_allocated + + glimmap_allocated = proj%found + end function glimmap_allocated + + !> This is incomplete diagnostics code to output full + !! content of projection type. Only does + !! Stereographic projections so far. + subroutine glimmap_diag(proj) + + use glimmer_log + + type(glimmap_proj) :: proj + + if (associated(proj%stere)) then + call glimmap_diag_stere(proj%stere) + else + call write_log('Stereographic projection not found') + end if + + end subroutine glimmap_diag + + !> print out parameters of Stereographic projection + subroutine glimmap_diag_stere(params) + + use glimmer_log + use glimmer_global, only : msg_length + + type(proj_stere) :: params + character(len=msg_length) :: message + + call write_log('***** Stereographic *****') + write(message,*)'longitude_of_central_meridian:', params%longitude_of_central_meridian + call write_log(message) + write(message,*)'latitude_of_projection_origin:', params%latitude_of_projection_origin + call write_log(message) + write(message,*)'scale_factor_at_proj_origin:', params%scale_factor_at_proj_origin + call write_log(message) + write(message,*)'standard_parallel:', params%standard_parallel + call write_log(message) + write(message,*)'false_easting:', params%false_easting + call write_log(message) + write(message,*)'false_northing:', params%false_northing + call write_log(message) + write(message,*)'pole:', params%pole + call write_log(message) + write(message,*)'equatorial:', params%equatorial + call write_log(message) + write(message,*)'k0:', params%k0 + call write_log(message) + write(message,*)'ik0:', params%ik0 + call write_log(message) + write(message,*)'sinp:', params%sinp + call write_log(message) + write(message,*)'cosp:', params%cosp + call write_log(message) + + end subroutine glimmap_diag_stere + +end module glimmer_map_types diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_ncdf.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_ncdf.F90 new file mode 100644 index 0000000000..764db5127a --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_ncdf.F90 @@ -0,0 +1,409 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_ncdf.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc +#define NCI infile%nc + +!> netCDF type definitions and functions for managing linked lists +!! +!! \author Magnus Hagdorn +!! \date 2004 +module glimmer_ncdf + + use glimmer_global, only: fname_length, dp + use netcdf + + implicit none + + integer, parameter :: glimmer_nc_meta_len = 100 + !> maximum length for meta data + + character(len=*), parameter :: glimmer_nc_mapvarname = 'mapping' + !> name of the grid mapping variable + + real(dp), parameter :: glimmer_nc_max_time=1.d10 + !> maximum time that can be written + + !> Data structure holding netCDF file description + type glimmer_nc_stat + !> Data structure holding netCDF file description + + logical :: define_mode = .TRUE. + !> set to .TRUE. when we are in define mode + logical :: just_processed = .FALSE. + !> set to .TRUE. if the file was used during the last time step + real(dp) :: processsed_time = 0.d0 + !> the time when the file was last processed + character(len=fname_length) :: filename = " " + !> name of netCDF file + integer id + !> id of netCDF file + + integer :: nlevel = 0 + integer :: nstaglevel = 0 + integer :: nstagwbndlevel = 0 + !> size of vertical and stag vertical coordinate + + integer timedim + !> id of time dimension + integer timevar + !> id of time variable + + ! TODO - Create a variable for vars length so it can be made longer (Matt has this implemented in his subglacial hydrology branch) + ! Apply it here for vars, vars_copy and to restart_variable_list in glimmer_ncparams.F90 + + character(len=310) vars + !> string containing variables to be processed + logical :: restartfile = .false. + !> Set to true if we're writing a restart file + character(len=310) vars_copy + !> string containing variables to be processed (retained copy) + end type glimmer_nc_stat + + type glimmer_nc_meta + !> Data structure holding netCDF meta data, see CF user guide + + character(len=glimmer_nc_meta_len) :: title = '' + !> title of netCDF file + character(len=glimmer_nc_meta_len) :: institution = '' + !> where the data was produced + character(len=glimmer_nc_meta_len) :: references = '' + !> list of references + character(len=glimmer_nc_meta_len) :: source = '' + !> this string will hold the GLIMMER version + character(len=glimmer_nc_meta_len) :: history = '' + !> netCDF file history string + character(len=glimmer_nc_meta_len) :: comment = '' + !> some comments + character(len=10000) :: config = '' + !> the contents of the glide config file + end type glimmer_nc_meta + + type glimmer_nc_output + !> element of linked list describing netCDF output file + !NO_RESTART previous + + type(glimmer_nc_stat) :: nc !< structure containg file info + real(dp) :: freq = 1000.d0 !< frequency at which data is written to file + real(dp) :: next_write = 0.d0 !< next time step at which data is dumped + real(dp) :: end_write = glimmer_nc_max_time !< stop writing after this year + integer :: timecounter = 1 !< time counter + real(dp) :: total_time = 0.d0 !< accumulate time steps (used for taking time averages) + + integer :: default_xtype = NF90_REAL !< the default external type for storing floating point values + logical :: do_averages = .false. !< set to .true. if we need to handle averages + + type(glimmer_nc_meta) :: metadata + !> structure holding metadata + + type(glimmer_nc_output), pointer :: next=>NULL() + !> next element in list + type(glimmer_nc_output), pointer :: previous=>NULL() + !> previous element in list + logical :: append = .false. + !> Set to true if we are appending onto an existing file. + end type glimmer_nc_output + + type glimmer_nc_input + !> element of linked list describing netCDF input file + !NO_RESTART previous + type(glimmer_nc_stat) :: nc + !> structure containg file info + real(dp), pointer, dimension(:) :: times => NULL() + !> pointer to array holding times + integer :: nt, current_time=1 + !>number of elements in times and current time index + integer :: get_time_slice = 1 + !> -1 if all times should be loaded, > 0 to load particular slice and then close file + + type(glimmer_nc_input), pointer :: next=>NULL() + !> next element in list + type(glimmer_nc_input), pointer :: previous=>NULL() + !> previous element in list + end type glimmer_nc_input + + + interface delete + module procedure delete_output, delete_input + end interface + + interface add + module procedure add_output, add_input + end interface + +contains + + function delete_output(oc, cf) + !> remove element from linked list + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: delete_output + type(glimmer_nc_output), pointer :: oc !< the output file to be removed + logical, intent(in), optional :: cf !< set to .True. if file should be closed + ! local variables + logical closefile + integer status + + if (present(cf)) then + closefile = cf + else + closefile = .true. + end if + + if (associated(oc)) then + if (associated(oc%previous)) then + oc%previous%next => oc%next + end if + if (associated(oc%next)) then + oc%next%previous => oc%previous + delete_output => oc%next + else + delete_output => NULL() + end if + if (closefile) then + status = nf90_close(oc%nc%id) + call write_log_div + call write_log('Closing output file '//trim(oc%nc%filename)) + end if + deallocate(oc) + end if + end function delete_output + + !> remove input file from linked list + !! + !! \return the next input file or NULL() + function delete_input(ic,cf) + !> remove element from linked list + use glimmer_log + implicit none + type(glimmer_nc_input), pointer :: delete_input + type(glimmer_nc_input), pointer :: ic !< the input file to be removed + logical, intent(in), optional :: cf !< set to .True. if file should be closed + + ! local variables + logical closefile + integer status + + if (present(cf)) then + closefile = cf + else + closefile = .true. + end if + + if (associated(ic)) then + if (associated(ic%previous)) then + ic%previous%next => ic%next + end if + if (associated(ic%next)) then + ic%next%previous => ic%previous + delete_input => ic%next + else + delete_input => NULL() + end if + if (closefile) then + status = nf90_close(ic%nc%id) + call write_log_div + call write_log('Closing input file '//trim(ic%nc%filename)) + end if + deallocate(ic%times) + deallocate(ic) + end if + end function delete_input + + !> add a new output file + !! + !! \return pointer to added output file + function add_output(oc) + implicit none + type(glimmer_nc_output), pointer :: add_output + type(glimmer_nc_output), pointer :: oc !< the output file to be added + + allocate(add_output) + + if (associated(oc)) then + add_output%previous => oc + if (associated(oc%next)) then + add_output%next => oc%next + oc%next%previous => add_output + end if + oc%next => add_output + end if + end function add_output + + !> add a new input file + !! + !! \return pointer to added input file + function add_input(ic) + implicit none + type(glimmer_nc_input), pointer :: add_input + type(glimmer_nc_input), pointer :: ic !< the input file to be added + + allocate(add_input) + + if (associated(ic)) then + add_input%previous => ic + if (associated(ic%next)) then + add_input%next => ic%next + ic%next%previous => add_input + end if + ic%next => add_input + end if + end function add_input + + !> for debugging print all output files in linked list + recursive subroutine nc_print_output(output) + + !> For debugging + + type(glimmer_nc_output),pointer :: output + + if (.not.associated(output)) then + Print*,'*** Output section not associated' + return + end if + + call nc_print_stat(output%nc) + print*,'freq: ',output%freq + print*,'next_write: ',output%next_write + print*,'timecounter:',output%timecounter + ! call nc_print_meta(output%metadata) + if (associated(output%next)) call nc_print_output(output%next) + + end subroutine nc_print_output + + subroutine nc_print_stat(stat) + + type(glimmer_nc_stat) :: stat + + print*,'define_mode: ',stat%define_mode + print*,'just_processed: ',stat%just_processed + print*,'processsed_time:',stat%processsed_time + print*,'filename: ',stat%filename + print*,'id: ',stat%id + print*,'nlevel: ',stat%nlevel + print*,'nstaglevel: ',stat%nstaglevel + print*,'nstagwbndlevel: ',stat%nstagwbndlevel + print*,'timedim: ',stat%timedim + print*,'timevar: ',stat%timevar + print*,'vars: ',trim(stat%vars) + + end subroutine nc_print_stat + + !> Sets up previous points in the linked list correctly + !! + !! This is needed after a restart, as trying to save both + !! next and previous pointers would cause problems + !! Also resets some other internal components + subroutine nc_repair_outpoint(output) + + implicit none + + type(glimmer_nc_output),pointer :: output + type(glimmer_nc_output),pointer :: most_recent + type(glimmer_nc_output),pointer :: tmp + + most_recent => null() + if (.not.associated(output)) return + tmp => output + + do + if (associated(most_recent)) tmp%previous => most_recent + tmp%nc%vars=tmp%nc%vars_copy + if (.not.associated(tmp%next)) exit + most_recent => tmp + tmp => tmp%next + end do + + end subroutine nc_repair_outpoint + + subroutine nc_repair_inpoint(input) + + implicit none + + !> Sets up previous points in the linked list correctly + !> This is needed after a restart, as trying to save both + !> next and previous pointers would cause problems + + type(glimmer_nc_input),pointer :: input + type(glimmer_nc_input),pointer :: most_recent + type(glimmer_nc_input),pointer :: tmp + + most_recent => null() + if (.not.associated(input)) return + tmp => input + + do + if (associated(most_recent)) tmp%previous => most_recent + if (.not.associated(tmp%next)) exit + most_recent => tmp + tmp => tmp%next + end do + + end subroutine nc_repair_inpoint + + subroutine nc_prefix_outfiles(output,prefix) + + !> Adds a prefix to all the filenames stored in the linked list. + !> Used for restarts. + + type(glimmer_nc_output),pointer :: output + character(*) :: prefix + + type(glimmer_nc_output),pointer :: tmp + + tmp => output + do + tmp%nc%filename=trim(prefix)//trim(tmp%nc%filename) + if (.not.associated(tmp%next)) exit + tmp => tmp%next + end do + + end subroutine nc_prefix_outfiles + + subroutine nc_errorhandle(file,line,status) + !> handle netCDF error + use netcdf + use glimmer_log + implicit none + character(len=*), intent(in) :: file + !> name of f90 file error occured in + integer, intent(in) :: line + !> line number error occured at + integer, intent(in) :: status + !> netCDF return value + + if (status /= NF90_NOERR) then + call write_log(nf90_strerror(status),type=GM_FATAL,file=file,line=line) + end if + end subroutine nc_errorhandle + +end module glimmer_ncdf + + diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_ncio.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_ncio.F90 new file mode 100644 index 0000000000..f933369138 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_ncio.F90 @@ -0,0 +1,670 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_ncio.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc +#define NCI infile%nc + +module glimmer_ncio + !> module for common netCDF I/O + !> written by Magnus Hagdorn, 2004 + + use glimmer_ncdf + + implicit none + + integer,parameter,private :: msglen=512 + +contains + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine openall_out(model,outfiles) + !> open all netCDF files for output + use glide_types + use glimmer_ncdf + implicit none + type(glide_global_type) :: model + type(glimmer_nc_output),pointer,optional :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + if (oc%append) then + call glimmer_nc_openappend(oc,model) + else + call glimmer_nc_createfile(oc,model) + end if + oc=>oc%next + end do + end subroutine openall_out + + subroutine closeall_out(model,outfiles) + !> close all netCDF files for output + use glide_types + use glimmer_ncdf + implicit none + type(glide_global_type) :: model + type(glimmer_nc_output),pointer,optional :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + oc=>delete(oc) + end do + if (.not.present(outfiles)) model%funits%out_first=>NULL() + end subroutine closeall_out + + subroutine glimmer_nc_openappend(outfile,model) + !> open netCDF file for appending + use parallel + use glimmer_log + use glide_types + use glimmer_map_CFproj + use glimmer_map_types + use glimmer_filenames + implicit none + type(glimmer_nc_output), pointer :: outfile + !> structure containg output netCDF descriptor + type(glide_global_type) :: model + !> the model instance + + ! local variables + integer :: status,timedimid,ntime,timeid + real(dp),dimension(1) :: last_time + character(len=msglen) :: message + + ! open existing netCDF file + status = parallel_open(process_path(NCO%filename),NF90_WRITE,NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + call write_log_div + write(message,*) 'Reopening file ',trim(process_path(NCO%filename)),' for output; ' + call write_log(trim(message)) + ! Find out when last time-slice was + status = parallel_inq_dimid(NCO%id,'time',timedimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inquire_dimension(NCO%id,timedimid,len=ntime) + call nc_errorhandle(__FILE__,__LINE__,status) + ! Set timecounter + outfile%timecounter=ntime+1 + write(message,*) ' Starting output at ',outfile%next_write,' and write every ',outfile%freq,' years' + call write_log(trim(message)) + + ! Get time varid + status = parallel_inq_varid(NCO%id,'time',NCO%timevar) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Put dataset into define mode + status = parallel_redef(NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + + end subroutine glimmer_nc_openappend + + subroutine glimmer_nc_createfile(outfile,model) + !> create a new netCDF file + use parallel + use glimmer_log + use glide_types + use glimmer_map_CFproj + use glimmer_map_types + use glimmer_filenames + implicit none + type(glimmer_nc_output), pointer :: outfile + !> structure containg output netCDF descriptor + type(glide_global_type) :: model + !> the model instance + + ! local variables + integer status + integer mapid + character(len=msglen) message + + ! create new netCDF file + !WHL - Changed the following line to support large netCDF output files +!! status = parallel_create(process_path(NCO%filename),NF90_CLOBBER,NCO%id) + status = parallel_create(process_path(NCO%filename), or(NF90_CLOBBER,NF90_64BIT_OFFSET), NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + call write_log_div + write(message,*) 'Opening file ',trim(process_path(NCO%filename)),' for output; ' + call write_log(trim(message)) + write(message,*) ' Starting output at ',outfile%next_write,' and write every ',outfile%freq,' years' + call write_log(trim(message)) + if (outfile%end_write < glimmer_nc_max_time) then + write(message,*) ' Stop writing at ',outfile%end_write + call write_log(trim(message)) + end if + NCO%define_mode=.TRUE. + + ! writing meta data + status = parallel_put_att(NCO%id, NF90_GLOBAL, 'Conventions', "CF-1.3") + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'title',trim(outfile%metadata%title)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'institution',trim(outfile%metadata%institution)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'source',trim(outfile%metadata%source)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'history',trim(outfile%metadata%history)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'references',trim(outfile%metadata%references)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'comment',trim(outfile%metadata%comment)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NF90_GLOBAL,'configuration',trim(outfile%metadata%config)) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! defining time dimension and variable + status = parallel_def_dim(NCO%id,'time',NF90_UNLIMITED,NCO%timedim) + call nc_errorhandle(__FILE__,__LINE__,status) + ! time -- Model time + call write_log('Creating variable time') + !EIB! lanl version + !status = nf90_def_var(NCO%id,'time',NF90_FLOAT,(/NCO%timedim/),NCO%timevar) + !EIB! gc2 version + status = parallel_def_var(NCO%id,'time',outfile%default_xtype,(/NCO%timedim/),NCO%timevar) + !EIB! pick one and consistant + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, NCO%timevar, 'long_name', 'Model time') + status = parallel_put_att(NCO%id, NCO%timevar, 'standard_name', 'time') + status = parallel_put_att(NCO%id, NCO%timevar, 'units', 'year since 1-1-1 0:0:0') + status = parallel_put_att(NCO%id, NCO%timevar, 'calendar', 'none') + + ! adding projection info + if (glimmap_allocated(model%projection)) then + status = parallel_def_var(NCO%id,glimmer_nc_mapvarname,NF90_CHAR,mapid) + call nc_errorhandle(__FILE__,__LINE__,status) + call glimmap_CFPutProj(NCO%id,mapid,model%projection) + end if + + ! setting the size of the level and staglevel dimension + NCO%nlevel = model%general%upn + NCO%nstaglevel = model%general%upn-1 + NCO%nstagwbndlevel = model%general%upn ! MJH this is the max index, not the size + end subroutine glimmer_nc_createfile + + subroutine glimmer_nc_checkwrite(outfile,model,forcewrite,time) + !> check if we should write to file + use parallel + use glimmer_log + use glide_types + use glimmer_filenames + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + logical forcewrite + real(dp),optional :: time + + character(len=msglen) :: message + integer status + real(dp) :: sub_time + + real(dp), parameter :: eps = 1.d-11 + + ! Check for optional time argument + if (present(time)) then + sub_time=time + else + sub_time=model%numerics%time + end if + + ! check if we are still in define mode and if so leave it + if (NCO%define_mode) then + status = parallel_enddef(NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + NCO%define_mode = .FALSE. + end if + + if (sub_time > NCO%processsed_time) then + if (NCO%just_processed) then + ! finished writing during last time step, need to increase counter... + + outfile%timecounter = outfile%timecounter + 1 + status = parallel_sync(NCO%id) + call nc_errorhandle(__FILE__,__LINE__,status) + NCO%just_processed = .FALSE. + end if + end if + + !WHL - Allow for small roundoff error in computing the time +!! if (sub_time >= outfile%next_write .or. (forcewrite .and. sub_time > outfile%next_write-outfile%freq)) then ! prone to roundoff error + if (sub_time + eps >= outfile%next_write .or. (forcewrite .and. sub_time > outfile%next_write-outfile%freq)) then + if (sub_time <= outfile%end_write .and. .not.NCO%just_processed) then + call write_log_div + write(message,*) 'Writing to file ', trim(process_path(NCO%filename)), ' at time ', sub_time + call write_log(trim(message)) + ! increase next_write + outfile%next_write = outfile%next_write + outfile%freq + NCO%processsed_time = sub_time + ! write time + status = parallel_put_var(NCO%id,NCO%timevar,sub_time,(/outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + NCO%just_processed = .TRUE. + end if + end if + + end subroutine glimmer_nc_checkwrite + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine openall_in(model) + !> open all netCDF files for input + use glide_types + use glimmer_ncdf + implicit none + type(glide_global_type) :: model + + ! local variables + type(glimmer_nc_input), pointer :: ic + + ! open input files + ic=>model%funits%in_first + do while(associated(ic)) + call glimmer_nc_openfile(ic,model) + ic=>ic%next + end do + + ! open forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + call glimmer_nc_openfile(ic,model) + ic=>ic%next + end do + end subroutine openall_in + + subroutine closeall_in(model) + !> close all netCDF files for input + use glide_types + use glimmer_ncdf + implicit none + type(glide_global_type) :: model + + ! local variables + type(glimmer_nc_input), pointer :: ic + + ! Input files + ic=>model%funits%in_first + do while(associated(ic)) + ic=>delete(ic) + end do + model%funits%in_first=>NULL() + + ! Forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + ic=>delete(ic) + end do + model%funits%frc_first=>NULL() + + end subroutine closeall_in + + subroutine glimmer_nc_openfile(infile,model) + !> open an existing netCDF file + use glide_types + use glimmer_map_CFproj + use glimmer_map_types + use glimmer_log + use glimmer_paramets, only: len0 + use glimmer_filenames + use parallel + implicit none + type(glimmer_nc_input), pointer :: infile + !> structure containg input netCDF descriptor + type(glide_global_type) :: model + !> the model instance + + ! local variables + integer dimsize, dimid, varid + real, dimension(2) :: delta + integer status + character(len=msglen) message + + real,parameter :: small = 1.e-6 + + ! open netCDF file + status = parallel_open(process_path(NCI%filename),NF90_NOWRITE,NCI%id) + if (status /= NF90_NOERR) then + call write_log('Error opening file '//trim(process_path(NCI%filename))//': '//nf90_strerror(status),& + type=GM_FATAL,file=__FILE__,line=__LINE__) + end if + call write_log_div + call write_log('opening file '//trim(process_path(NCI%filename))//' for input') + + ! getting projection, if none defined already + if (.not.glimmap_allocated(model%projection)) model%projection = glimmap_CFGetProj(NCI%id) + + ! getting time dimension + status = parallel_inq_dimid(NCI%id, 'time', NCI%timedim) + call nc_errorhandle(__FILE__,__LINE__,status) + ! get id of time variable + status = parallel_inq_varid(NCI%id,'time',NCI%timevar) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! getting length of time dimension and allocating memory for array containing times + status = parallel_inquire_dimension(NCI%id,NCI%timedim,len=dimsize) + call nc_errorhandle(__FILE__,__LINE__,status) + allocate(infile%times(dimsize)) + infile%nt=dimsize + status = parallel_get_var(NCI%id,NCI%timevar,infile%times) + + ! setting the size of the level and staglevel dimension + NCI%nlevel = model%general%upn + NCI%nstaglevel = model%general%upn-1 + NCI%nstagwbndlevel = model%general%upn !MJH This is the max index, not size + + ! checking if dimensions and grid spacing are the same as in the configuration file + ! x1 + status = parallel_inq_dimid(NCI%id,'x1',dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + call nc_errorhandle(__FILE__,__LINE__,status) + if (dimsize /= global_ewn) then + write(message,*) 'Dimension x1 of file '//trim(process_path(NCI%filename))// & + ' does not match with config dimension: ', dimsize, global_ewn + call write_log(message,type=GM_FATAL) + end if + status = parallel_inq_varid(NCI%id,'x1',varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_var(NCI%id,varid,delta) + call nc_errorhandle(__FILE__,__LINE__,status) + +!WHL - mod to prevent code from crashing due to small roundoff error +! if (abs(delta(2)-delta(1) - model%numerics%dew*len0) > small) then + if (abs( (delta(2)-delta(1) - model%numerics%dew*len0) / (model%numerics%dew*len0) ) > small) then + write(message,*) 'deltax1 of file '//trim(process_path(NCI%filename))// & + ' does not match with config deltax: ', delta(2)-delta(1),model%numerics%dew*len0 + call write_log(message,type=GM_FATAL) + end if + + ! x0 + !status = nf90_inq_dimid(NCI%id,'x0',dimid) + !call nc_errorhandle(__FILE__,__LINE__,status) + !status = nf90_inquire_dimension(NCI%id,dimid,len=dimsize) + !call nc_errorhandle(__FILE__,__LINE__,status) + !if (dimsize /= model%general%ewn-1) then + ! write(message,*) 'Dimension x0 of file ',trim(process_path(NCI%filename)),' does not match with config dimension: ', & + ! dimsize, model%general%ewn-1 + ! call write_log(message,type=GM_FATAL) + !end if + !status = nf90_inq_varid(NCI%id,'x0',varid) + !call nc_errorhandle(__FILE__,__LINE__,status) + !status = nf90_get_var(NCI%id,varid,delta) + !call nc_errorhandle(__FILE__,__LINE__,status) + !if (abs(delta(2)-delta(1) - model%numerics%dew*len0) > small) then + ! write(message,*) 'deltax0 of file '//trim(process_path(NCI%filename))//' does not match with config deltax: ', & + ! delta(2)-delta(1),model%numerics%dew*len0 + ! call write_log(message,type=GM_FATAL) + !end if + + ! y1 + status = parallel_inq_dimid(NCI%id,'y1',dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + call nc_errorhandle(__FILE__,__LINE__,status) + if (dimsize /= global_nsn) then + write(message,*) 'Dimension y1 of file '//trim(process_path(NCI%filename))// & + ' does not match with config dimension: ', dimsize, global_nsn + call write_log(message,type=GM_FATAL) + end if + status = parallel_inq_varid(NCI%id,'y1',varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_var(NCI%id,varid,delta) + call nc_errorhandle(__FILE__,__LINE__,status) + + +!WHL - mod to prevent code from crashing due to small roundoff error +! if (abs(delta(2)-delta(1) - model%numerics%dns*len0) > small) then + if (abs( (delta(2)-delta(1) - model%numerics%dns*len0) / (model%numerics%dns*len0) ) > small) then + write(message,*) 'deltay1 of file '//trim(process_path(NCI%filename))// & + ' does not match with config deltay: ', delta(2)-delta(1),model%numerics%dns*len0 + call write_log(message,type=GM_FATAL) + end if + + ! y0 + !status = nf90_inq_dimid(NCI%id,'y0',dimid) + !call nc_errorhandle(__FILE__,__LINE__,status) + !status = nf90_inquire_dimension(NCI%id,dimid,len=dimsize) + !call nc_errorhandle(__FILE__,__LINE__,status) + !if (dimsize /= model%general%nsn-1) then + ! write(message,*) 'Dimension y0 of file '//trim(process_path(NCI%filename))//' does not match with config dimension: ',& + ! dimsize, model%general%nsn-1 + ! call write_log(message,type=GM_FATAL) + !end if + !status = nf90_inq_varid(NCI%id,'y0',varid) + !call nc_errorhandle(__FILE__,__LINE__,status) + !status = nf90_get_var(NCI%id,varid,delta) + !call nc_errorhandle(__FILE__,__LINE__,status) + !if (abs(delta(2)-delta(1) - model%numerics%dns*len0) > small) then + ! write(message,*) 'deltay0 of file '//trim(process_path(NCI%filename))//' does not match with config deltay: ',& + ! delta(2)-delta(1),model%numerics%dns*len0 + ! call write_log(message,type=GM_FATAL) + !end if + + ! Check that the number of vertical layers is the same, though it's asking for trouble + ! to check whether the spacing is the same (don't want to put that burden on setup, + ! plus f.p. compare has been known to cause problems here) + status = parallel_inq_dimid(NCI%id,'level',dimid) + ! If we couldn't find the 'level' dimension fail with a warning. + ! We don't want to throw an error, as input files are only required to have it if they + ! include 3D data fields. + if (status == NF90_NOERR) then + status = parallel_inquire_dimension(NCI%id, dimid, len=dimsize) + call nc_errorhandle(__FILE__, __LINE__, status) + if (dimsize /= model%general%upn .and. dimsize /= 1) then + write(message,*) 'Dimension level of file '//trim(process_path(NCI%filename))//& + ' does not match with config dimension: ', & + dimsize, model%general%upn + call write_log(message,type=GM_FATAL) + end if + else + call write_log("Input file contained no level dimension. This is not necessarily a problem.", type=GM_WARNING) + end if + + end subroutine glimmer_nc_openfile + + subroutine glimmer_nc_checkread(infile,model,time) + !> check if we should read from file + use glimmer_log + use glide_types + use glimmer_filenames + implicit none + type(glimmer_nc_input), pointer :: infile !> structure containg output netCDF descriptor + type(glide_global_type) :: model !> the model instance + real(dp),optional :: time !> Optional alternative time + + character(len=msglen) :: message + + integer :: pos ! to identify restart files + + real(dp) :: restart_time ! time of restart (yr) + + if (infile%current_time <= infile%nt) then + if (.not.NCI%just_processed) then + call write_log_div + !EIB! added form gc2, needed? + ! Reset model%numerics%tstart if reading a restart file + !write(message,*) 'Check for restart:', trim(infile%nc%filename) + !call write_log(message) + pos = index(infile%nc%filename,'.r.') ! use CESM naming convention for restart files + if (pos /= 0) then ! get the start time based on the current time slice + restart_time = infile%times(infile%current_time) ! years + model%numerics%tstart = restart_time + model%numerics%time = restart_time + write(message,*) 'Restart: New tstart =', model%numerics%tstart + call write_log(message) + endif + !EIB! end add + write(message,*) 'Reading time slice ',infile%current_time,'(',infile%times(infile%current_time),') from file ', & + trim(process_path(NCI%filename)), ' at time ', sub_time(model, time) + call write_log(message) + NCI%just_processed = .TRUE. + NCI%processsed_time = sub_time(model, time) + end if + end if + + if (sub_time(model, time) > NCI%processsed_time) then + if (NCI%just_processed) then + ! finished reading during last time step, need to increase counter... + infile%current_time = infile%current_time + 1 + NCI%just_processed = .FALSE. + end if + end if + + contains + real(dp) function sub_time(model, time) + ! Get the current time applicable to this subroutine. + ! If time is present, use that; otherwise use model%numerics%time + ! + ! We need this function to avoid code duplication. We canNOT simply set a local + ! sub_time variable variable at the start of glimmer_nc_checkread, because model + ! %numerics%time can be updated in the midst of this routine... so we need to + ! determine sub_time when it's actually needed, with this function. + use glide_types + implicit none + type(glide_global_type) :: model !> the model instance + real(dp),optional :: time !> Optional alternative time + + if (present(time)) then + sub_time = time + else + sub_time = model%numerics%time + end if + end function sub_time + + end subroutine glimmer_nc_checkread + +!------------------------------------------------------------------------------ + + subroutine check_for_tempstag(whichdycore, nc) + ! Check for the need to output tempstag and update the output variables if needed. + ! + ! For the glam/glissade dycore, the vertical temperature grid has an extra level. + ! In that case, the netCDF output file should include a variable + ! called tempstag(0:nz) instead of temp(1:nz). This subroutine is added for + ! convenience to allow the variable "temp" to be specified in the config + ! file in all cases and have it converted to "tempstag" when appropriate. + ! MJH + + use glimmer_log + use glide_types + + implicit none + integer, intent(in) :: whichdycore + type(glimmer_nc_stat) :: nc + + ! Locals + integer :: i + + ! Check if tempstag should be output + + ! If both temp and tempstag are specified, temp will get converted to tempstag + ! and then there will be two tempstags in the list, but that is ok because + ! the parser ignores duplicate entries in the varlist. + ! (The check for the existence of variables looks like: pos = index(NCO%vars,' acab ') ) + + !print *, "Original varstring:", varstring + + if (whichdycore/=DYCORE_GLIDE) then + ! We want temp to become tempstag + i = index(nc%vars, " temp ") + if (i > 0) then + ! temp was specified - change it to tempstag + ! If temp is listed more than once, this just changes the first instance + nc%vars = nc%vars(1:i-1) // " tempstag " // nc%vars(i+6:len(nc%vars)) + call write_log('Temperature remapping option uses temperature on a staggered vertical grid.' // & + ' The netCDF output variable "temp" has been changed to "tempstag".' ) + endif + ! Now check if flwa needs to be changed to flwastag + i = index(nc%vars, " flwa ") ! Look for flwa + if (i > 0) then + ! flwa was specified - change to flwastag + nc%vars = nc%vars(1:i-1) // " flwastag " // nc%vars(i+6:len(nc%vars)) + call write_log('Temperature remapping option uses flwa on a staggered vertical grid.' // & + ' The netCDF output variable "flwa" has been changed to "flwastag".' ) + endif + ! Now check if dissip needs to be changed to dissipstag + i = index(nc%vars, " dissip ") ! Look for dissip + if (i > 0) then + ! dissip was specified - change to dissipstag + nc%vars = nc%vars(1:i-1) // " dissipstag " // nc%vars(i+6:len(nc%vars)) + call write_log('Temperature remapping option uses dissip on a staggered vertical grid.' // & + ' The netCDF output variable "dissip" has been changed to "dissipstag".' ) + endif + else ! glide dycore + ! We want tempstag to become temp + i = index(nc%vars, " tempstag ") + if (i > 0) then + !Change tempstag to temp + nc%vars = nc%vars(1:i-1) // " temp " // nc%vars(i+10:len(nc%vars)) + call write_log('The netCDF output variable "tempstag" should not be used with the Glide dycore.' // & + ' The netCDF output variable "tempstag" has been changed to "temp".' ) + endif + ! We want flwastag to become flwa + i = index(nc%vars, " flwastag ") + if (i > 0) then + !Change flwastag to flwa + nc%vars = nc%vars(1:i-1) // " flwa " // nc%vars(i+10:len(nc%vars)) + call write_log('The netCDF output variable "flwastag" should not be used with the Glide dycore.' // & + ' The netCDF output variable "flwastag" has been changed to "flwa".' ) + endif + ! We want dissipstag to become dissip + i = index(nc%vars, " dissipstag ") + if (i > 0) then + !Change dissipstag to dissip + nc%vars = nc%vars(1:i-1) // " dissip " // nc%vars(i+10:len(nc%vars)) + call write_log('The netCDF output variable "dissipstag" should not be used with the Glide dycore.' // & + ' The netCDF output variable "dissipstag" has been changed to "dissip".' ) + endif + endif ! whichdycore + + ! Copy any changes to vars_copy + nc%vars_copy = nc%vars + + end subroutine check_for_tempstag + +!------------------------------------------------------------------------------ + + +end module glimmer_ncio + +!------------------------------------------------------------------------------ diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_ncparams.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_ncparams.F90 new file mode 100644 index 0000000000..1552475e3b --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_ncparams.F90 @@ -0,0 +1,273 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_ncparams.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc +#define NCI infile%nc + +module glimmer_ncparams + + ! read netCDF I/O related configuration files + ! written by Magnus Hagdorn, May 2004 + + use glimmer_ncdf, only: glimmer_nc_meta + + implicit none + + private + public :: glimmer_nc_readparams, default_metadata, handle_output, handle_input, configstring + + type(glimmer_nc_meta),save :: default_metadata + character(10000) :: configstring + + +contains + subroutine glimmer_nc_readparams(model,config) + ! read netCDF I/O related configuration file + use glide_types + use glimmer_config + implicit none + type(glide_global_type) :: model ! model instance + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + type(glimmer_nc_output), pointer :: output => null() + type(glimmer_nc_input), pointer :: input => null() + type(glimmer_nc_input), pointer :: forcing => null() + + ! get config string + call ConfigAsString(config,configstring) + + ! get default meta data + call GetSection(config,section,'CF default') + if (associated(section)) then + call handle_metadata(section, default_metadata, .true.) + end if + + ! setup outputs + call GetSection(config,section,'CF output') + do while(associated(section)) + output => handle_output(section,output,model%numerics%tstart,configstring) + if (.not.associated(model%funits%out_first)) then + model%funits%out_first => output + end if + call GetSection(section%next,section,'CF output') + end do + + ! setup inputs + call GetSection(config,section,'CF input') + do while(associated(section)) + input => handle_input(section,input) + if (.not.associated(model%funits%in_first)) then + model%funits%in_first => input + end if + call GetSection(section%next,section,'CF input') + end do + + ! setup forcings + call GetSection(config,section,'CF forcing') + do while(associated(section)) + forcing => handle_forcing(section,forcing) + if (.not.associated(model%funits%frc_first)) then + model%funits%frc_first => forcing + end if + call GetSection(section%next,section,'CF forcing') + end do + + output => null() + input => null() + forcing => null() + + end subroutine glimmer_nc_readparams + + !================================================================================== + ! private procedures + !================================================================================== + + subroutine handle_metadata(section,metadata, default) + use glimmer_ncdf + use glimmer_config + !use glimmer_global, only: glimmer_version !EIB! glimmer_verision not module in gc2 + implicit none + type(ConfigSection), pointer :: section + type(glimmer_nc_meta) ::metadata + logical :: default + + !EIB! from gc2, may have been replaced by glimmer_version about, or vice versa?? + + character(len=100), external :: glimmer_version_char + + ! local variables + character(len=8) :: date + character(len=10) :: time + + if (.not.default) then + metadata%title = trim(default_metadata%title) + metadata%institution = trim(default_metadata%institution) + metadata%references = trim(default_metadata%references) + metadata%comment = trim(default_metadata%comment) + end if + + call GetValue(section,'title',metadata%title) + call GetValue(section,'institution',metadata%institution) + call GetValue(section,'references',metadata%references) + call GetValue(section,'comment',metadata%comment) + + if (default) then + call date_and_time(date,time) + !EIB!metadata%source = 'Generated by '//trim(glimmer_version) + metadata%source = 'Generated by '//trim(glimmer_version_char()) + write(metadata%history,fmt="(a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6,' : ',a)") date(1:4),date(5:6),date(7:8),& + !EIB!time(1:2),time(3:4),time(5:10),trim(glimmer_version) + time(1:2),time(3:4),time(5:10),trim(glimmer_version_char()) + else + metadata%source = trim(default_metadata%source) + metadata%history = trim(default_metadata%history) + end if + end subroutine handle_metadata + + + function handle_output(section, output, start_yr, configstring) + use glimmer_ncdf + use glimmer_config + use glimmer_log + use glimmer_global, only: dp + implicit none + + type(ConfigSection), pointer :: section + type(glimmer_nc_output), pointer :: output + type(glimmer_nc_output), pointer :: handle_output + real(dp), intent(in) :: start_yr + character(*),intent(in) :: configstring + character(10) :: mode_str,xtype_str + + handle_output=>add(output) + + handle_output%next_write = start_yr + mode_str='' + xtype_str = 'real' + + ! get filename + call GetValue(section,'name',handle_output%nc%filename) + call GetValue(section,'start',handle_output%next_write) + call GetValue(section,'stop',handle_output%end_write) + call GetValue(section,'frequency',handle_output%freq) + call GetValue(section,'variables',handle_output%nc%vars) + call GetValue(section,'mode',mode_str) + call GetValue(section,'xtype',xtype_str) + + ! handle mode field + if (trim(mode_str)=='append'.or.trim(mode_str)=='APPEND') then + handle_output%append = .true. + else + handle_output%append = .false. + end if + + !EIB! from gc2 + ! handle xtype field + if (trim(xtype_str)=='real'.or.trim(xtype_str)=='REAL') then + handle_output%default_xtype = NF90_REAL + else if (trim(xtype_str)=='double'.or.trim(xtype_str)=='DOUBLE') then + handle_output%default_xtype = NF90_DOUBLE + else + call write_log('Error, unknown xtype, must be real or double [netCDF output]',GM_FATAL) + end if + !EIB! + + ! add config data + handle_output%metadata%config=trim(configstring) + + ! Make copy of variables for future reference + handle_output%nc%vars_copy=handle_output%nc%vars + + ! get metadata + call handle_metadata(section, handle_output%metadata,.false.) + if (handle_output%nc%filename(1:1)==' ') then + call write_log('Error, no file name specified [netCDF output]',GM_FATAL) + end if + end function handle_output + + + function handle_input(section, input) + use glimmer_ncdf + use glimmer_config + use glimmer_log + use glimmer_filenames, only : filenames_inputname !EIB! not in lanl, which is newer? + implicit none + type(ConfigSection), pointer :: section + type(glimmer_nc_input), pointer :: input + type(glimmer_nc_input), pointer :: handle_input + + handle_input=>add(input) + + ! get filename + call GetValue(section,'name',handle_input%nc%filename) + call GetValue(section,'time',handle_input%get_time_slice) + + handle_input%current_time = handle_input%get_time_slice + + if (handle_input%nc%filename(1:1)==' ') then + call write_log('Error, no file name specified [netCDF input]',GM_FATAL) + end if + + !EIB! from gc2 + handle_input%nc%filename = trim(filenames_inputname(handle_input%nc%filename)) + + end function handle_input + + + function handle_forcing(section, forcing) + use glimmer_ncdf + use glimmer_config + use glimmer_log + use glimmer_filenames, only : filenames_inputname + implicit none + type(ConfigSection), pointer :: section + type(glimmer_nc_input), pointer :: forcing + type(glimmer_nc_input), pointer :: handle_forcing + + handle_forcing=>add(forcing) + + ! get filename + call GetValue(section,'name',handle_forcing%nc%filename) + call GetValue(section,'time',handle_forcing%get_time_slice) ! MJH don't think we'll use 'time' keyword in the forcing config section + + handle_forcing%current_time = handle_forcing%get_time_slice + + if (handle_forcing%nc%filename(1:1)==' ') then + call write_log('Error, no file name specified [netCDF forcing]',GM_FATAL) + end if + + handle_forcing%nc%filename = trim(filenames_inputname(handle_forcing%nc%filename)) + + end function handle_forcing + + +end module glimmer_ncparams diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_paramets.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_paramets.F90 new file mode 100644 index 0000000000..ef03aac887 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_paramets.F90 @@ -0,0 +1,145 @@ + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_paramets.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> model scaling constants +module glimmer_paramets + + use glimmer_global, only : dp + use glimmer_physcon, only : scyr, rhoi, grav, gn + + implicit none + save + +!WHL - logical parameter for code testing +! If oldglide = T, the glide dycore will reproduce +! (within roundoff error) the results +! of Glimmer 1.0.18 for the dome and EISMINT-2 test cases. + + !TODO - Remove oldglide parameter when comparisons to old Glide are no longer desired + logical, parameter :: oldglide = .false. +! logical, parameter :: oldglide = .true. + +!TODO - redundant output units (stdout and glimmer_unit) +! It is redundant to define both stdout (which is public) and +! glimmer_unit (which is private to glimmer_log.F90). +! However, it is sometimes convenient to write to stdout in Glimmer +! without calling write_log. +! May want to delete this later (and declare stdout in glc_constants +! for CESM runs). + + integer :: stdout = 6 + +! logical flag to turn on special DEBUG output (related to test points), false by default + + logical :: GLC_DEBUG = .false. + +!TODO: Redefine scaling parameters to have SI or similar units? +! Considered removing these parameters from the code, but may be too much work. +! +! Note: If tau0 is redefined in the code in terms of rhoi and grav, +! then all the scaling parameters could be written in terms of scyr. +! +! See comments below for details. + + + ! unphysical value used for initializing certain variables (e.g., temperature) so we can tell + ! later if they were read from an input file or otherwise computed correctly + real(dp), parameter :: unphys_val = -999.d0 + +! scaling parameters + +! The fundamental scaling parameters are thk0, len0, and vel0. The others are derived from these. + +!SCALING - DFM, 2, Oct 2012 - made scaled vs. unscaled values for thk0, len0, +! and vel0 switchable by the reconstituted NO_RESCALE compilation flag. +! (necessary to be compatible with alternate dycores) + +#ifndef NO_RESCALE +! The following are the old Glimmer scaling parameters. + real(dp), parameter :: thk0 = 2000.0d0 ! m + real(dp), parameter :: len0 = 200.0d3 ! m + real(dp), parameter :: vel0 = 500.d0 / scyr ! m yr^{-1} converted to S.I. units +!! real(dp), parameter :: vis0 = 5.70d-18 / scyr ! yr^{-1} Pa^{-3} converted to S.I. units +#else +! (no rescaling) + real(dp), parameter :: thk0 = 1.d0 ! no scaling of thickness + real(dp), parameter :: len0 = 1.d0 ! no scaling of length + real(dp), parameter :: vel0 = 1.d0 / scyr ! yr * s^{-1} +!Note - With the new value of vel0, the serial JFNK solver barely converges +! for the first time step of the dome test. The Picard solver does fine. +! Safer to use old scaling for now. +! end (no rescaling) +#endif + + !Note: Both the SIA and HO solvers fail unless tim0 = len0/vel0. Not sure if this can be changed. + ! With the revised scaling, tim0 = scyr. + real(dp), parameter :: tim0 = len0 / vel0 ! s + real(dp), parameter :: acc0 = thk0 * vel0 / len0 ! m s^{-1} + +!Note - With thk0 = 1, can replace tau0 by rhoi*grav in code and remove stress scaling. +! Similarly can redefine vis0 and evs0 + + ! GLAM scaling parameters; units are correct if thk0 has units of meters + real(dp), parameter :: tau0 = rhoi*grav*thk0 ! stress scale in GLAM ( Pa ) + real(dp), parameter :: evs0 = tau0 / (vel0/len0) ! eff. visc. scale in GLAM ( Pa s ) + real(dp), parameter :: vis0 = tau0**(-gn) * (vel0/len0) ! rate factor scale in GLAM ( Pa^-3 s^-1 ) + +!SCALING - This is the scaling we would use if we had velocity in m/yr and thk0 = len0 = 1. +! real(dp), parameter :: thk0 = 1.d0 +! real(dp), parameter :: len0 = 1.d0 +! real(dp), parameter :: vel0 = 1.d0 / scyr +! real(dp), parameter :: tim0 = scyr +! real(dp), parameter :: acc0 = 1.d0 / scyr +! real(dp), parameter :: tau0 = rhoi*grav +! real(dp), parameter :: evs0 = tau0*scyr +! real(dp), parameter :: vis0 = tau0**(-gn) / scyr + +!WHL - Here I am defining some new constants that have the same values as thk0, len0, etc. in old Glimmer. +! I am giving the new constants new names to minimize confusion. +! These are used in only a few places. For instance, we have this in glide_thck: +! +! residual = maxval(abs(model%geometry%thck-model%thckwk%oldthck2)) +! +! In old Glimmer, thk0 = 2000 m and thck = O(1) +! In new CISM, thk0 = 1 and thck = true thickness in meters +! With thk0 = 1, we need to divide the rhs by 2000 m to reproduce the results of old Glimmer. +! The following code satisfies either of the two conventions: +! +! residual = maxval( abs(model%geometry%thck-model%thckwk%oldthck2) * (thk0/thk_scale) ) + + real(dp), parameter :: thk_scale = 2000.0d0 ! m + real(dp), parameter :: len_scale = 200.0d3 ! m + real(dp), parameter :: vel_scale = 500.0 / scyr ! m yr^{-1} converted to S.I. units + real(dp), parameter :: tau_scale = rhoi*grav*thk_scale ! stress scale in GLAM ( Pa ) + real(dp), parameter :: vis_scale = tau_scale**(-gn) * (vel_scale/len_scale) ! rate factor scale in GLAM ( Pa^-3 s^-1 ) + real(dp), parameter :: evs_scale = tau_scale / (vel_scale/len_scale) ! eff. visc. scale in GLAM ( Pa s ) + +end module glimmer_paramets diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_physcon.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_physcon.F90 new file mode 100644 index 0000000000..9484a6d3d8 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_physcon.F90 @@ -0,0 +1,87 @@ + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_physcon.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> Contains physical constants required by the ice model. +module glimmer_physcon + + use glimmer_global, only : dp + +#ifdef CCSMCOUPLED + + use shr_const_mod, only: pi=> SHR_CONST_PI,& + rhoi=> SHR_CONST_RHOICE,& + rhoo=> SHR_CONST_RHOSW,& + rhow=> SHR_CONST_RHOFW,& + rearth=> SHR_CONST_REARTH,& + grav=> SHR_CONST_G,& + shci=> SHR_CONST_CPICE,& + lhci=> SHR_CONST_LATICE,& + trpt=> SHR_CONST_TKTRIP + implicit none + save + +#else + + implicit none + save + + real(dp),parameter :: pi = 3.14159265358979d0 !< Value of \f$\pi\f$. + real(dp),parameter :: rhoi = 910.d0 !< The density of ice (kg m-3) + real(dp),parameter :: rhoo = 1028.0d0 !< The density of the ocean (kg m-3) + real(dp),parameter :: rhow = 1000.0d0 !< The density of fresh water (kg m-3) + real(dp),parameter :: rearth = 6.37122d6 ! radius of earth (m) + real(dp),parameter :: grav = 9.81d0 !< The acceleration due to gravity (m s-2) + real(dp),parameter :: shci = 2009.0d0 !< Specific heat capacity of ice (J kg-1 K-1) + real(dp),parameter :: lhci = 335.0d3 !< Latent heat of melting of ice (J kg-1) + real(dp),parameter :: trpt = 273.15d0 !< Triple point of water (K) +#endif + + real(dp),parameter :: scyr = 31536000.d0 !< Number of seconds in a year of exactly 365 days + real(dp),parameter :: rhom = 3300.0d0 !< The density of magma(?) (kg m-3) + real(dp),parameter :: rhos = 2600.0d0 !< The density of solid till (kg m$^{-3}$) + real(dp),parameter :: f = - rhoo / rhoi + integer, parameter :: gn = 3 !< The power dependency of Glenn's flow law. + real(dp),parameter :: actenh = 139.0d3 !< Activation energy in Glenn's flow law for \f$T^{*}\geq263\f$K. (J mol-1) + real(dp),parameter :: actenl = 60.0d3 !< Activation energy in Glenn's flow law for \f$T^{*}<263\f$K. (J mol-1) + real(dp),parameter :: arrmlh = 1.733d3 !< Constant of proportionality in Arrhenius relation + !< in \texttt{patebudd}, for \f$T^{*}\geq263\f$K. + !< (Pa-3 s-1) + real(dp),parameter :: arrmll = 3.613d-13 !< Constant of proportionality in Arrhenius relation + !< in \texttt{patebudd}, for \f$T^{*}<263\f$K. + !< (Pa-3 s-1) + real(dp),parameter :: gascon = 8.314d0 !< The gas ideal constant \f$R\f$ (J mol-1 K-1) + real(dp),parameter :: coni = 2.1d0 !< Thermal conductivity of ice (W m-1 K-1) + real(dp),parameter :: pmlt = 9.7456d-8 !< Factor for dependence of melting point on pressure (K Pa-1) + real(dp),parameter :: tocnfrz_sfc = -1.92d0 !< Freezing temperature of seawater (deg C) at surface pressure, S = 35 PSU + real(dp),parameter :: dtocnfrz_dh = -7.53d-4 !< Rate of change of freezing temperature of seawater with depth (deg/m), given S = 35 PSU + !< These values are from the Ocean Water Freezing Point Calculator, + !< http://www.csgnetwork.com/h2ofreezecalc.html (25 Nov. 2014) +end module glimmer_physcon diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_scales.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_scales.F90 new file mode 100644 index 0000000000..ff00da3f73 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_scales.F90 @@ -0,0 +1,100 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_scales.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +! This module holds scales for various fields + +module glimmer_scales + + use glimmer_global, only : dp + + implicit none + + real(dp) :: scale_uvel, scale_uflx, scale_diffu, scale_acab, scale_wvel, scale_btrc + real(dp) :: scale_beta, scale_flwa, scale_tau, scale_efvs, scale_resid + + !WHL - Added scale_blfx to flip the sign of bheatflx. Typically, this flux has + ! a sign convention of positive up in input data, but the CISM convention + ! is positive down. + ! Considered changing the sign convention to positive up, but this would require + ! changes in several modules. + real(dp) :: scale_bflx + +contains + + subroutine glimmer_init_scales + + ! set scale factors for I/O (can't have non-integer powers) + + use glimmer_physcon, only : scyr, gn + use glimmer_paramets, only : thk0, tim0, vel0, vis0, len0, acc0, tau0, evs0 + implicit none + +#ifndef NO_RESCALE + scale_uvel = scyr * vel0 ! uvel, vvel, ubas, vbas, etc. + scale_uflx = scyr * vel0 * thk0 ! uflx, vflx + scale_diffu = scyr * vel0 * len0 ! diffu + scale_acab = scyr * thk0 / tim0 ! acab, bmlt + scale_wvel = scyr * thk0 / tim0 ! wvel, wgrd + scale_btrc = scyr * vel0 * len0 / (thk0**2) ! btrc, soft + + scale_beta = tau0 / vel0 / scyr ! units: Pa * sec/m * yr/sec = Pa * yr/m + ! NOTE: on i/o, beta has units of Pa yr/m. Since vel0 has units of m/s, + ! the first two terms on the RHS have units of Pa s/m. Thus, the final + ! division by scyr here converts s/m to yr/m. All together, the 3 terms + ! on the RHS scale on i/o by Pa yr/m (thus, making dimensionless on input, + ! assuming the units on input are Pa yr/m, and also converting to Pa yr/m on output) + + scale_flwa = scyr * vis0 ! flwa + scale_tau = tau0 ! tauf, tauxz, btractx + scale_efvs = evs0 / scyr ! efvs + scale_resid= tau0 / len0 ! resid_u, resid_v + scale_bflx = -1.d0 ! bheatflx (CISM sign convention is positive down, + ! whereas input data usually assumes positive up) +#else +! (no rescaling) + scale_uvel = 1.0d0 ! uvel, vvel, ubas, vbas, etc. + scale_uflx = 1.0d0 ! uflx, vflx + scale_diffu = 1.0d0 ! diffu + scale_acab = 1.0d0 ! acab, bmlt + scale_wvel = 1.0d0 ! wvel, wgrd + scale_btrc = 1.0d0 ! btrc, soft + scale_beta = 1.0d0 + + scale_flwa = 1.0d0 ! flwa + scale_tau = 1.0d0 ! tauf, tauxz, btractx + scale_efvs = 1.0d0 ! efvs + scale_resid = 1.0d0 ! resid_u, resid_v + scale_bflx = -1.d0 ! bheatflx (keeping this one -- CISM sign convention is + ! positive down, whereas input data usually assumes positive up) +#endif + + end subroutine glimmer_init_scales + +end module glimmer_scales diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_searchcircle.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_searchcircle.F90 new file mode 100644 index 0000000000..652e41ebee --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_searchcircle.F90 @@ -0,0 +1,250 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_searchcircle.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> improved algorithm for integrating a 2 dimensional array over large circles +!! this used for calculating continentality +!! +!! \author Magnus Hagdorn +module glimmer_searchcircle + + use glimmer_global, only: dp + implicit none + + type searchdata + logical :: initialised = .false. + integer :: radius !< search radius + integer, pointer, dimension(:) :: ipos !< positions on quater circle which will be moved along + integer :: istart, jstart !< starting position of grid to be processed, will default to usally 1 + integer :: isize, jsize !< size of array to be processed + real(dp) :: total_area + real(dp), pointer, dimension(:,:) :: sarray !< array to be searched (expanded to include outside points + real(dp), pointer, dimension(:,:) :: weight !< reciprocal weights + end type searchdata + + !MAKE_RESTART + +contains + + !> initialise search circle data structure + !! + !! \return initialised data type + function sc_initdata(radius,istart,jstart,isize,jsize,searchgrid) + implicit none + integer, intent(in) :: radius !< radius of search radius + integer, intent(in) :: istart,jstart !< starting position of grid to be processed + integer, intent(in) :: isize,jsize !< size of array to be processed + real(dp), dimension(:,:), optional :: searchgrid !< used for determining bounds of grid to be searched + !< if not present, the bounds are assumed to be the same as the resultgrid + + type(searchdata) :: sc_initdata + + ! local variables + real(dp), allocatable, dimension(:) :: area + real(dp) :: area_temp + integer i,j,intrad,ii,jj + integer si_start,si_end,sj_start,sj_end,si_size,sj_size + + ! filling structure + sc_initdata%radius = radius + sc_initdata%istart = istart + sc_initdata%jstart = jstart + sc_initdata%isize = isize + sc_initdata%jsize = jsize + ! allocating data + allocate(sc_initdata%sarray(1-radius:isize+radius,1-radius:jsize+radius)) + allocate(sc_initdata%weight(isize, jsize)) + allocate(sc_initdata%ipos(radius+1)) + + if (present(searchgrid)) then + si_start = lbound(searchgrid,1) + sj_start = lbound(searchgrid,2) + si_end = ubound(searchgrid,1) + sj_end = ubound(searchgrid,2) + si_size = si_end - si_start + 1 + sj_size = sj_end - sj_start + 1 + else + si_start = 1 + sj_start = 1 + si_end = isize + sj_end = jsize + si_size = isize + sj_size = jsize + end if + + ! initialising data + ! mask + sc_initdata%sarray = 0.d0 + sc_initdata%ipos = 0 + ! weights + ! calculate integral over quater circle + allocate(area(0:radius)) + area(0) = radius + do i=1,radius + sc_initdata%ipos(i) = int(sqrt(real(radius*radius-i*i))) + area(i) = area(i-1)+real(sc_initdata%ipos(i)) + end do + sc_initdata%total_area = 1.d0 + 4.d0*area(radius) + + ! complaining if search circle does not fit + if (si_size < 2.d0*radius+2 .and. sj_size < 2.d0*radius+2) then + ! internal sums + sc_initdata%weight(1+radius:isize-radius, 1+radius:jsize-radius) = sc_initdata%total_area + do j=jstart,jstart+jsize-1 + !left + do i=istart,istart+radius-1 + area_temp = 0.d0 + do jj=max(sj_start,j-radius),min(sj_end,j+radius) + intrad = int(sqrt(real(radius*radius-(jj-j)*(jj-j)))) + do ii=max(si_start,i-intrad),min(si_end,i+intrad) + area_temp = area_temp + 1.d0 + end do + end do + sc_initdata%weight(i-istart+1,j-jstart+1) = area_temp + end do + !right + do i=istart+isize-1-radius,istart+isize-1 + area_temp = 0.d0 + do jj=max(sj_start,j-radius),min(sj_end,j+radius) + intrad = int(sqrt(real(radius*radius-(jj-j)*(jj-j)))) + do ii=max(si_start,i-intrad),min(si_end,i+intrad) + area_temp = area_temp + 1.d0 + end do + end do + sc_initdata%weight(i-istart+1,j-jstart+1) = area_temp + end do + end do + ! lower + do j=jstart,jstart+radius-1 + do i=istart+radius,istart+isize-1-radius + area_temp = 0.d0 + do jj=max(sj_start,j-radius),min(sj_end,j+radius) + intrad = int(sqrt(real(radius*radius-(jj-j)*(jj-j)))) + do ii=max(si_start,i-intrad),min(si_end,i+intrad) + area_temp = area_temp + 1.d0 + end do + end do + sc_initdata%weight(i-istart+1,j-jstart+1) = area_temp + end do + end do + ! upper + do j=jstart+jsize-1-radius,jstart+jsize-1 + do i=istart+radius,istart+isize-1-radius + area_temp = 0.d0 + do jj=max(sj_start,j-radius),min(sj_end,j+radius) + intrad = int(sqrt(real(radius*radius-(jj-j)*(jj-j)))) + do ii=max(si_start,i-intrad),min(si_end,i+intrad) + area_temp = area_temp + 1.d0 + end do + end do + sc_initdata%weight(i-istart+1,j-jstart+1) = area_temp + end do + end do + else + do j=jstart,jstart+jsize-1 + do i=istart,istart+isize-1 + area_temp = 0.d0 + do jj=max(sj_start,j-radius),min(sj_end,j+radius) + intrad = int(sqrt(real(radius*radius-(jj-j)*(jj-j)))) + do ii=max(si_start,i-intrad),min(si_end,i+intrad) + area_temp = area_temp + 1.d0 + end do + end do + sc_initdata%weight(i-istart+1,j-jstart+1) = area_temp + end do + end do + end if + + sc_initdata%weight = sc_initdata%total_area/sc_initdata%weight + + sc_initdata%initialised = .true. + end function sc_initdata + + + !> do the search + !! + !! \bug cony does not match at boundary. no idea what is going on... + + subroutine sc_search(sdata,searchgrid,resultgrid) + implicit none + type(searchdata) :: sdata !< the search circle type + real(dp), dimension(:,:), intent(in) :: searchgrid !< the input mesh + real(dp), dimension(:,:), intent(out) :: resultgrid !< the result mesh + + ! local variables + integer i,j,ii,jj,intrad + integer :: istart,iend,jstart,jend + + if (.not.sdata%initialised) then + write(*,*) 'Error (searchcircle), module is not initialised' + stop + end if + + ! checking grid sizes + if (any(shape(resultgrid) /= (/sdata%isize,sdata%jsize/))) then + write(*,*) 'Error (searchcircle), size of result grid does not match: ',shape(resultgrid),(/sdata%isize,sdata%jsize/) + stop + end if + !filling search array + sdata%sarray = 0.d0 + istart = max(1, sdata%istart-sdata%radius) + iend = min(size(searchgrid,1),sdata%istart+sdata%isize+sdata%radius-1) + jstart = max(1, sdata%jstart-sdata%radius) + jend = min(size(searchgrid,2),sdata%jstart+sdata%jsize+sdata%radius-1) + + sdata%sarray(1+istart-sdata%istart:iend-sdata%istart+1, 1+jstart-sdata%jstart:jend-sdata%jstart+1) = & + searchgrid(istart:iend, jstart:jend) + resultgrid = 0.d0 + + ! loop over grid + do j=1,sdata%jsize + ! do the full circle + i=1 + do jj=j-sdata%radius,j+sdata%radius + intrad = int(sqrt(real(sdata%radius*sdata%radius-(jj-j)*(jj-j)))) + do ii=i-intrad,i+intrad + resultgrid(i,j) = resultgrid(i,j) + sdata%sarray(ii,jj) + end do + end do + + ! loop over the remaing columns in the current row + do i=2,sdata%isize + resultgrid(i,j) = resultgrid(i-1,j) - sdata%sarray(i-sdata%radius,j) + sdata%sarray(i+sdata%radius,j) + do jj=1,sdata%radius + resultgrid(i,j) = resultgrid(i,j) - sdata%sarray(i-sdata%ipos(jj),j+jj) + sdata%sarray(i+sdata%ipos(jj),j+jj) + resultgrid(i,j) = resultgrid(i,j) - sdata%sarray(i-sdata%ipos(jj),j-jj) + sdata%sarray(i+sdata%ipos(jj),j-jj) + end do + end do + end do + + ! applying weights + resultgrid = resultgrid * sdata%weight + end subroutine sc_search + +end module glimmer_searchcircle diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_ts.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_ts.F90 new file mode 100644 index 0000000000..f898bc9d9e --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_ts.F90 @@ -0,0 +1,270 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_ts.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> handling time series +!! +!! \author Magnus Hagdorn +!! \date 2006 +!! +!! this module provides support for reading in tabulated ASCII data such as +!! time series. The data can then be accessed through functions which +!! interpolated the data. +module glimmer_ts + + use glimmer_global, only: dp + implicit none + + !> time series derived type + type glimmer_tseries + integer :: numt=0 !< number of times in time series + integer :: numv=1 !< number of values per time + integer :: current=1 !< current position in ts + real(dp), dimension(:), pointer :: times=>NULL() !< array holding times + real(dp), dimension(:,:), pointer :: values=>NULL()!< array holding values + end type glimmer_tseries + + interface glimmer_ts_step + module procedure glimmer_ts_step_array, glimmer_ts_step_scalar + end interface + + interface glimmer_ts_linear + module procedure glimmer_ts_linear_array,glimmer_ts_linear_scalar + end interface + + private :: get_i + +contains + + !> read tabulated ASCII file + subroutine glimmer_read_ts(ts,fname,numv) + use glimmer_log + use glimmer_global, only : msg_length + implicit none + type(glimmer_tseries) :: ts !< time series data + character(len=*), intent(in) :: fname !< read from this file + integer, intent(in),optional :: numv !< number of values per time + + ! local variables + real(dp) :: d1,d2,fact=1. + integer i,j,ios + character(len=msg_length) :: message + + if (present(numv)) then + ts%numv = numv + else + ts%numv = 1 + end if + + open(99,file=trim(fname),status='old',iostat=ios) + + if (ios.ne.0) then + call write_log('Error opening file: '//trim(fname),type=GM_FATAL) + end if + + ! find number of times and checking if ts is strictly monotonic + ios = 0 + d1 = 1 + do + d2 = d1 + read(99,*,iostat=ios) d1 + d1 = fact*d1 + if (ios.ne.0) then + exit + end if + ts%numt = ts%numt + 1 + if (ts%numt.eq.1) then + cycle + else if (ts%numt.eq.2) then + if (d1 > d2) then + fact = 1. + else if (d1 < d2) then + fact = -1. + d1 = -d1 + else + write(message,*) 'Error, time series in file: '//trim(fname)//' is not monotonic line: ',ts%numt + call write_log(message,type=GM_FATAL) + end if + else + if (d1 <= d2) then + write(message,*) 'Error, time series in file: '//trim(fname)//' is not monotonic line: ',ts%numt + call write_log(message,type=GM_FATAL) + end if + end if + end do + rewind(99) + + allocate(ts%times(ts%numt)) + allocate(ts%values(ts%numv,ts%numt)) + ! read data + do i=1,ts%numt + read(99,*) ts%times(i),(ts%values(j,i),j=1,ts%numv) + end do + close(99) + end subroutine glimmer_read_ts + + !> interpolate time series by stepping + subroutine glimmer_ts_step_array(ts,time,value) + use glimmer_log + implicit none + type(glimmer_tseries) :: ts !< time series data + real(dp), intent(in) :: time !< time value to get + real(dp), dimension(:) :: value !< interpolated value + + integer i + + if (size(value).ne.ts%numv) then + call write_log('Error, wrong number of values',GM_FATAL,__FILE__,__LINE__) + end if + + i = get_i(ts,time) + if (i.eq.-1) then + i = 1 + else if (i.eq.ts%numt+1) then + i = ts%numt + end if + + value = ts%values(:,i) + end subroutine glimmer_ts_step_array + + !> interpolate time series by stepping + subroutine glimmer_ts_step_scalar(ts,time,value) + use glimmer_log + implicit none + type(glimmer_tseries) :: ts !< time series data + real(dp), intent(in) :: time !< time value to get + real(dp) :: value !< interpolated value + + integer i + + i = get_i(ts,time) + if (i.eq.-1) then + i = 1 + else if (i.eq.ts%numt+1) then + i = ts%numt + end if + + value = ts%values(1,i) + end subroutine glimmer_ts_step_scalar + + !> linear interpolate time series + subroutine glimmer_ts_linear_array(ts,time,value) + use glimmer_log + implicit none + type(glimmer_tseries) :: ts !< time series data + real(dp), intent(in) :: time !< time value to get + real(dp), dimension(:) :: value !< interpolated value + + integer i + real(dp),dimension(size(value)) :: slope + + if (size(value).ne.ts%numv) then + call write_log('Error, wrong number of values',GM_FATAL,__FILE__,__LINE__) + end if + + i = get_i(ts,time) + if (i.eq.-1) then + value(:) = ts%values(:,1) + else if (i.eq.ts%numt+1) then + value(:) = ts%values(:,ts%numt) + else + slope(:) = (ts%values(:,i+1)-ts%values(:,i))/(ts%times(i+1)-ts%times(i)) + value(:) = ts%values(:,i) + slope(:)*(time-ts%times(i)) + end if + end subroutine glimmer_ts_linear_array + + !> linear interpolate time series + subroutine glimmer_ts_linear_scalar(ts,time,value) + use glimmer_log + implicit none + type(glimmer_tseries) :: ts !< time series data + real(dp), intent(in) :: time !< time value to get + real(dp) :: value !< interpolated value + + integer i + real(dp) :: slope + + i = get_i(ts,time) + if (i.eq.-1) then + value = ts%values(1,1) + else if (i.eq.ts%numt+1) then + value = ts%values(1,ts%numt) + else + slope = (ts%values(1,i+1)-ts%values(1,i))/(ts%times(i+1)-ts%times(i)) + value = ts%values(1,i) + slope*(time-ts%times(i)) + end if + end subroutine glimmer_ts_linear_scalar + + !> get find the index + function get_i(ts,time) + implicit none + type(glimmer_tseries) :: ts !< time series data + real(dp), intent(in) :: time !< time value to get + integer get_i + integer upper,lower + + ! BC + if (time <= ts%times(1)) then + get_i = -1 + return + end if + if (time >= ts%times(ts%numt)) then + get_i = ts%numt + 1 + return + end if + ! first try if the interpolated value is around the last value + ts%current=min(ts%current,ts%numt-1) + if (time >= ts%times(ts%current) .and. time < ts%times(ts%current+1)) then + get_i = ts%current + return + end if + ! this didn't work, let's try the next interval + ts%current=ts%current+1 + if (time >= ts%times(ts%current) .and. time < ts%times(ts%current+1)) then + get_i = ts%current + return + end if + ! nope, let's do a Newton search + lower = 1 + upper = ts%numt + do + ts%current = lower+int((upper-lower)/2.) + if (time >= ts%times(ts%current) .and. time < ts%times(ts%current+1)) then + get_i = ts%current + return + end if + if (time > ts%times(ts%current)) then + lower = ts%current + else + upper = ts%current + end if + end do + end function get_i + +end module glimmer_ts diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_utils.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_utils.F90 new file mode 100644 index 0000000000..35b109c732 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_utils.F90 @@ -0,0 +1,315 @@ + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_utils.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> Module containing utility code for GLIMMER. + !TODO - Move check_conformal and fix_bcs2d to Glint? Used by glint_interp only. + +module glimmer_utils + + use glimmer_global, only: dp + + implicit none + + interface array_bcs + module procedure array_bcs1d,array_bcs2d + end interface + + interface check_conformal + module procedure check_conformal_2d_real + end interface + +contains + + !> Returns the value of a 1D array location,checking first for the boundaries. + !! + !! the location is wrapped around the array boundaries until it falls within the array + !! \author The value of the location in question. + real(dp) function array_bcs1d(array,i) + + ! Arguments + + real(dp),dimension(:),intent(in) :: array !< The array to be indexed. + integer,intent(in) :: i !< The location to be extracted. + + ! Internal variables + + integer :: n,ii + + n=size(array) + ii=i + + if ((i<=n).and.(i>=1)) then + array_bcs1d=array(i) + endif + + do while (ii>n) + ii=ii-n + enddo + + do while (ii<1) + ii=ii+n + enddo + + array_bcs1d=array(ii) + + end function array_bcs1d + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Returns the value of a 1D array location,checking first for the boundaries. + !! + !! the location is wrapped around the array boundaries until it falls within the array + !! as array_bcs1d but for polar boundary conditions + !! \author The value of the location in question. + real(dp) function array_bcs_lats(array,i) + + + ! Arguments + + real(dp),dimension(:),intent(in) :: array !< The array to be indexed. + integer,intent(in) :: i !< The location to be extracted. + + ! Internal variables + + integer :: n,ii + + n=size(array) + ii=i + + if ((i<=n).and.(i>=1)) then + array_bcs_lats=array(i) + return + endif + + if (ii>n) then + ii=2*n-ii + array_bcs_lats=-180.d0+array(ii) + endif + + if (ii<1) then + ii=1-ii + array_bcs_lats=180.d0-array(ii) + endif + + end function array_bcs_lats + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Returns the value of an array + !! location, checking first for the boundaries. + !! Over-the-pole boundary conditions are implemented here. + !! \return The value of the location specified. + real(dp) function array_bcs2d(array,i,j) + + ! Arguments + + real(dp),dimension(:,:),intent(in) :: array !< Array to be indexed + integer,intent(in) :: i !< The location to be extracted + integer,intent(in) :: j !< The location to be extracted + + ! Internal variables + + integer :: nx,ny,ii,jj + + nx=size(array,1) ; ny=size(array,2) + + if ((i>=1).and.(i<=nx).and.(j>=1).and.(j<=ny)) then + array_bcs2d=array(i,j) + return + endif + + ii=i ; jj=j + + if (jj>ny) then + jj=2*ny-jj + ii=ii+nx/2 + endif + + if (jj<1) then + jj=1-jj + ii=ii+nx/2 + endif + + do while (ii>nx) + ii=ii-nx + enddo + + do while (ii<1) + ii=ii+nx + enddo + + array_bcs2d=array(ii,jj) + + end function array_bcs2d + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine fix_bcs2d(i,j,nx,ny) + + !> Adjusts array location indices + !! so that they fall within the domain. + + integer,intent(inout) :: i !< The location of interest + integer,intent(inout) :: j !< The location of interest + integer,intent(in) :: nx !< The size of the domain (number of points in each direction) + integer,intent(in) :: ny !< The size of the domain (number of points in each direction) + + if ((i>=1).and.(i<=nx).and.(j>=1).and.(j<=ny)) return + + if (j>ny) then + j=2*ny-j + i=i+nx/2 + endif + + if (j<1) then + j=1-j + i=i+nx/2 + endif + + do while (i>nx) + i=i-nx + enddo + + do while (i<1) + i=i+nx + enddo + + end subroutine fix_bcs2d + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine check_conformal_2d_real(array1,array2,label) + + !> Checks that two arrays are of the same size. + + use glimmer_log + + real(dp),dimension(:,:),intent(in) :: array1 !< The array 1 to be checked + real(dp),dimension(:,:),intent(in) :: array2 !< The array 2 to be checked + character(*),intent(in),optional :: label !< Optional label, to facilitate bug tracking if the check fails. + + if ((size(array1,1)/=size(array2,1)).or.(size(array1,2)/=size(array2,2))) then + if (present(label)) then + call write_log('Non-conformal arrays. Label: '//label,GM_FATAL,__FILE__,__LINE__) + else + call write_log('ERROR: Non-conformal arrays. No label',GM_FATAL,__FILE__,__LINE__) + endif + endif + + end subroutine check_conformal_2d_real + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> compute horizontal sum for each vertical level + !! + !! Calculates the sum of a given three-dimensional field at each + !! level. The vertical coordinate of the input is the first index of + !! the array. + !! \return + !! A one-dimensional array of the same size as the first dimension of + !! inp is returned, containing the sum of inp for + !! each level. + function hsum(inp) + + + implicit none + + real(dp),dimension(:,:,:),intent(in) :: inp !< The input array. The first index is the vertical, the othe two horizontal. + real(dp),dimension(size(inp,dim=1)) :: hsum + + integer up + + do up=1,size(inp,dim=1) + hsum(up) = sum(inp(up,:,:)) + end do + + end function hsum + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Calculates the sum of a given two-dimensional field along one axis. + !! Within GLIMMER, this function calculates the mean vertical profile + !! in a 2D vertical slice. + !! \return + !! A one-dimensional array of the same size as the first dimension of + !! inp is returned, containing the sum of inp for + !! each row. + + function lsum(inp) + + + implicit none + + real(dp),dimension(:,:), intent(in) :: inp !< Input array + real(dp),dimension(size(inp,dim=1)) :: lsum + + lsum = sum(inp(:,:),dim=2) + + end function lsum + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !> Tridiagonal solver. All input/output arrays should have the + !! same number of elements. + + subroutine tridiag(a,b,c,x,y) + + + real(dp),dimension(:) :: a !< Lower diagonal; a(1) is ignored. + real(dp),dimension(:) :: b !< Centre diagonal + real(dp),dimension(:) :: c !< Upper diagonal; c(n) is ignored. + real(dp),dimension(:) :: x !< Unknown vector + real(dp),dimension(:) :: y !< Right-hand side + + real(dp),dimension(size(a)) :: aa + real(dp),dimension(size(a)) :: bb + + integer :: n,i + + n=size(a) + + aa(1) = c(1)/b(1) + bb(1) = y(1)/b(1) + + do i=2,n + aa(i) = c(i)/(b(i)-a(i)*aa(i-1)) + bb(i) = (y(i)-a(i)*bb(i-1))/(b(i)-a(i)*aa(i-1)) + end do + + x(n) = bb(n) + + do i=n-1,1,-1 + x(i) = bb(i)-aa(i)*x(i+1) + end do + + end subroutine tridiag + +end module glimmer_utils diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.cmake.in b/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.cmake.in new file mode 100644 index 0000000000..4432e75dba --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.cmake.in @@ -0,0 +1,44 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_vers.F90.cmake.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + +!> the glimmer version as a string +function glimmer_version_char() + implicit none + character(len=100) :: glimmer_version_char + + !glimmer_version_char = 'GLIMMER v. ??: (CMake build does not get version)' + glimmer_version_char = 'CISM 2.0' +end function glimmer_version_char + +!> the glimmer version as an integer +function glimmer_version_int() + implicit none + integer :: glimmer_version_int + glimmer_version_int = 10000*1 + 100*7 + 1 +end function glimmer_version_int + + diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.in.in b/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.in.in new file mode 100644 index 0000000000..70ddca3423 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_vers.F90.in.in @@ -0,0 +1,42 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_vers.F90.in.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + +!> the glimmer version as a string +function glimmer_version_char() + implicit none + character(len=100) :: glimmer_version_char + glimmer_version_char = 'GLIMMER v. @GLIMMER_MAJOR_VERSION@.@GLIMMER_MINOR_VERSION@.@GLIMMER_MICRO_VERSION@@GLIMMER_SVN_VERS@' +end function glimmer_version_char + +!> the glimmer version as an integer +function glimmer_version_int() + implicit none + integer :: glimmer_version_int + glimmer_version_int = 10000*@GLIMMER_MAJOR_VERSION@ + 100*@GLIMMER_MINOR_VERSION@ + @GLIMMER_MICRO_VERSION@ +end function glimmer_version_int + + diff --git a/components/cism/glimmer-cism/libglimmer/glimmer_writestats.F90 b/components/cism/glimmer-cism/libglimmer/glimmer_writestats.F90 new file mode 100644 index 0000000000..833a2624d4 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/glimmer_writestats.F90 @@ -0,0 +1,48 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glimmer_writestats.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module glimmer_writestats + !> F90 wrapper to gc_writestats + !! + !! \author Magnus Hagdorn + !! \date April 2009 + + implicit none + +contains + + subroutine glimmer_write_stats(resname, cfgname,wallTime) + use glimmer_global, only : dp + use parallel, only: main_task + implicit none + character(len=*), intent(in) :: resname !< name of the output result file + character(len=*), intent(in) :: cfgname !< name of configuration file + real(kind=dp), intent(in) :: wallTime!< elapsed wall clock tine in seconds + + if (main_task) call gf_writestats(resname,cfgname,wallTime) + end subroutine glimmer_write_stats + +end module glimmer_writestats diff --git a/components/cism/glimmer-cism/libglimmer/mpi_mod.F90 b/components/cism/glimmer-cism/libglimmer/mpi_mod.F90 new file mode 100644 index 0000000000..9927e87125 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/mpi_mod.F90 @@ -0,0 +1,42 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! mpi_mod.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module mpi_mod +! This module wraps the external mpi module + +#ifndef NO_MPIMOD + use mpi +#endif + + implicit none + +#ifdef NO_MPIMOD +#include +#endif + + public + +end module mpi_mod diff --git a/components/cism/glimmer-cism/libglimmer/nan_mod.F90 b/components/cism/glimmer-cism/libglimmer/nan_mod.F90 new file mode 100644 index 0000000000..8a884729db --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/nan_mod.F90 @@ -0,0 +1,46 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! nan_mod.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module nan_mod + +! Set parameter for the floating point flag "nan" not-a-number +! +! Based on the similar module in CESM's CLM & CAM +! + use glimmer_global, only : dp + + implicit none + save + +#ifdef __PGI +! quiet nan for portland group compilers + real(dp), parameter :: NaN = O'0777700000000000000000' +#else +! signaling nan otherwise + real(dp), parameter :: NaN = O'0777610000000000000000' +#endif + +end module nan_mod diff --git a/components/cism/glimmer-cism/libglimmer/ncdf_template.F90.in b/components/cism/glimmer-cism/libglimmer/ncdf_template.F90.in new file mode 100644 index 0000000000..9910db6ed4 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/ncdf_template.F90.in @@ -0,0 +1,564 @@ +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + +!GENVAR_HAVE_AVG! + +module NAME_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use DATAMOD + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in NAME_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine NAME_io_createall(model,data,outfiles) + ! open all netCDF files for output + use DATAMOD + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(DATATYPE) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in NAME_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call NAME_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine NAME_io_createall + + subroutine NAME_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use DATAMOD + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(DATATYPE) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call NAME_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call NAME_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call NAME_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine NAME_io_writeall + + subroutine NAME_io_create(outfile,model,data) + use parallel + use glide_types + use DATAMOD + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(DATATYPE) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + !GENVAR_DIMS! + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,AVG_SUFF) + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in NAME_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + !GENVAR_VARDEF! + end subroutine NAME_io_create + + subroutine NAME_io_write(outfile,data) + use parallel + use DATAMOD + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(DATATYPE) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + !GENVAR_WRITE! + end subroutine NAME_io_write + + + subroutine NAME_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to NAME restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine NAME_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in NAME_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine NAME_io_readall(data, model, filetype) + ! read from netCDF file + use DATAMOD + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(DATATYPE) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call NAME_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine NAME_io_readall + + + subroutine NAME_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(DATATYPE) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call NAME_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine NAME_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine NAME_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use DATAMOD + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(DATATYPE) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + !GENVAR_READ! + end subroutine NAME_io_read + + subroutine NAME_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use DATAMOD + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(DATATYPE), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + !GENVAR_CHECKDIM! + end subroutine NAME_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine NAME_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use DATAMOD + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(DATATYPE) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + !GENVAR_CALCAVG! + end subroutine NAME_avg_accumulate + + subroutine NAME_avg_reset(outfile,data) + use parallel + use DATAMOD + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(DATATYPE) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + !GENVAR_RESETAVG! + end subroutine NAME_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + !GENVAR_ACCESSORS! + +end module NAME_io diff --git a/components/cism/glimmer-cism/libglimmer/ncdf_utils.F90 b/components/cism/glimmer-cism/libglimmer/ncdf_utils.F90 new file mode 100644 index 0000000000..3c97eb4b3c --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/ncdf_utils.F90 @@ -0,0 +1,168 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_utils.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!TODO - Move this module to utils directory? No longer used. + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> This code provides a simple interface to create and then add +!! to a netcdf file containing time-slices of a single 2D field, +!! for use in debugging. +module ncdf_utils + + use netcdf + use glimmer_global, only: sp, dp + + implicit none + + type ncdf_utils_type + integer :: id,varid,dimid1,dimid2,dimid3,d3id + integer :: next=1 + character(100) :: fname + end type ncdf_utils_type + +contains + + ! Note: This subroutine currently is not called, as far as I can tell + + subroutine ncdf_utils_create(handle,fname,varname,d1name,d2name,d1,d2) + + type(ncdf_utils_type),intent(out) :: handle !< Netcdf file handles + character(*), intent(in) :: fname !< File name + character(*), intent(in) :: varname !< Variable name + character(*), intent(in) :: d1name !< Name of first dimension + character(*), intent(in) :: d2name !< Name of second dimension + real(sp),dimension(:),intent(in) :: d1 !< Dimension 1 + real(sp),dimension(:),intent(in) :: d2 !< Dimension 2 + + integer :: ncerr,d1id,d2id + + ! Create file + + ncerr=nf90_create(fname,0,handle%id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + handle%fname=fname + + ! Define dimensions + + ncerr=nf90_def_dim(handle%id,d1name,size(d1),handle%dimid1) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_def_dim(handle%id,d2name,size(d2),handle%dimid2) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_def_dim(handle%id,'time',NF90_UNLIMITED,handle%dimid3) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + + ! Define dimension variables + + ncerr=nf90_def_var(handle%id,d1name,NF90_FLOAT,(/handle%dimid1/),d1id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_def_var(handle%id,d2name,NF90_FLOAT,(/handle%dimid2/),d2id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_def_var(handle%id,'time',NF90_FLOAT,(/handle%dimid3/),handle%d3id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + + ! Define 2D variable + + ncerr=nf90_def_var(handle%id,varname,NF90_DOUBLE, & + (/handle%dimid1,handle%dimid2,handle%dimid3/),handle%varid) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + + ! Exit define mode and save dimension variables + + ncerr=nf90_enddef(handle%id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_put_var(handle%id,d1id,d1) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_put_var(handle%id,d2id,d2) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + + end subroutine ncdf_utils_create + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine ncdf_utils_write(handle,var,time) + + type(ncdf_utils_type), intent(inout) :: handle + real(dp),dimension(:,:),intent(in) :: var + real(dp), intent(in) :: time + + integer :: ncerr + + ncerr=nf90_put_var(handle%id,handle%varid,real(var,dp),(/1,1,handle%next/)) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_put_var(handle%id,handle%d3id,time,(/handle%next/)) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_sync(handle%id) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + + handle%next=handle%next+1 + + end subroutine ncdf_utils_write + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine ncdf_utils_close(handle) + + type(ncdf_utils_type), intent(in) :: handle + + integer :: ncerr + + ncerr=nf90_close(handle%id) + + end subroutine ncdf_utils_close + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine ncdf_utils_read_slice(filename,varname,slice,array) + + character(*), intent(in) :: filename + character(*), intent(in) :: varname + integer, intent(in) :: slice + real(dp),dimension(:,:),intent(out) :: array + + integer :: ncerr,fileid,varid + + ncerr=nf90_open(filename,0,fileid) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_inq_varid(fileid,varname,varid) + if (ncerr/=NF90_NOERR) call ncerr_handle(ncerr) + ncerr=nf90_get_var(fileid,varid,array,(/1,1,slice/)) + + end subroutine ncdf_utils_read_slice + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine ncerr_handle(ncerr) + + integer,intent(in) :: ncerr + + print*,nf90_strerror(ncerr) + stop + + end subroutine ncerr_handle + +end module ncdf_utils diff --git a/components/cism/glimmer-cism/libglimmer/parallel_mpi.F90 b/components/cism/glimmer-cism/libglimmer/parallel_mpi.F90 new file mode 100644 index 0000000000..16bc5f048c --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/parallel_mpi.F90 @@ -0,0 +1,5947 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! parallel_mpi.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module parallel + + use netcdf + implicit none + + ! Information on the local & global bounds of an array + ! This is used to distinguish between arrays on the staggered vs. unstaggered grids + type, private :: bounds_info_type + ! Global number of points in each dimension + integer :: global_ewn + integer :: global_nsn + + ! Range of indices that this proc is responsible for (excludes halo cells) + ! These are the indices in global index space + integer :: mybounds_ew_lb + integer :: mybounds_ew_ub + integer :: mybounds_ns_lb + integer :: mybounds_ns_ub + + ! Local indices that this proc is responsible for (excludes halo cells) + ! These are the indices in local index space + integer :: ilo + integer :: ihi + integer :: jlo + integer :: jhi + end type bounds_info_type + + +!PW - Repeat from glimmer_horiz_bcs_parallel.F90 + integer, parameter, private :: HORIZ_BCS_WALL_SLIP = 0 + integer, parameter, private :: HORIZ_BCS_CYCLIC = 1 + + integer, parameter, private :: horiz_bcs_type_north = HORIZ_BCS_CYCLIC + integer, parameter, private :: horiz_bcs_type_south = HORIZ_BCS_CYCLIC + integer, parameter, private :: horiz_bcs_type_east = HORIZ_BCS_CYCLIC + integer, parameter, private :: horiz_bcs_type_west = HORIZ_BCS_CYCLIC +!PW - End of repeat + + ! Debug and Verification Level + integer,parameter :: DEBUG_LEVEL = 1 + ! If > 0, then debug code executed. Added for parallel_halo_verify() + + !NOTE: The glam/glissade dycore currently requires nhalo = 2, + ! whereas the glide dycore requires nhalo = 0. + ! For glide simulations, we set nhalo = 0 by calling distributed_grid + ! with optional argument nhalo = 0. + + integer, save :: nhalo = 2 + + !TODO - Define lhalo and uhalo in terms of nhalo. + + integer, save :: lhalo = 2 + integer, save :: uhalo = 2 + + ! halo widths for staggered grid +! integer,parameter :: staggered_lhalo = lhalo +! integer,parameter :: staggered_uhalo = uhalo-1 + integer, save :: staggered_lhalo = 2 + integer, save :: staggered_uhalo = 1 + +!TODO - Remove staggered_whalo/shalo/ehalo/nhalo here and in other parts of the code +! integer,parameter :: staggered_whalo = lhalo +! integer,parameter :: staggered_shalo = lhalo +! integer,parameter :: staggered_ehalo = uhalo-1 +! integer,parameter :: staggered_nhalo = uhalo-1 + integer, save :: staggered_whalo = 2 + integer, save :: staggered_shalo = 2 + integer, save :: staggered_ehalo = 1 + integer, save :: staggered_nhalo = 1 + + integer,save :: main_rank + logical,save :: main_task + integer,save :: comm, tasks, this_rank + + ! distributed grid + integer,save :: global_ewn,global_nsn,local_ewn,local_nsn,own_ewn,own_nsn + integer,save :: global_col_offset, global_row_offset + + integer,save :: ewlb,ewub,nslb,nsub + integer,save :: east,north,south,west + + !WHL - added global boundary conditions + ! global boundary conditions + logical,save :: periodic_bc ! doubly periodic + logical,save :: outflow_bc ! if true, set scalars in global halo to zero + ! does not apply to staggered variables (e.g., uvel, vvel) + + ! common work space + integer,dimension(4),save :: d_gs_mybounds + integer,dimension(:,:),allocatable,save :: d_gs_bounds + + ! distributed gather flow control parameter + integer,parameter :: max_gather_block_size = 64 ! max and default + + ! global IDs + integer,save :: ProcsEW + + !TODO - Remove these gathered_* declarations. No longer used. + + ! JEFF Declarations for undistributed variables on main_task. + ! Later move to separate module? These are only temporary until code is completely distributed. + real(8),dimension(:,:,:),allocatable :: gathered_efvs ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_efvs2 ! Variable for testing that scatter/gather are inverses + real(8),dimension(:,:,:),allocatable :: gathered_uvel ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_vvel ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:),allocatable :: gathered_uflx ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:),allocatable :: gathered_vflx ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_velnorm ! Variable calculated in run_ho_diagnostic(), is this used? + real(8),dimension(:,:),allocatable :: gathered_thck ! Used in horizontal_remap_in() + real(8),dimension(:,:),allocatable :: gathered_stagthck ! Used in horizontal_remap_in() + real(4),dimension(:,:),allocatable :: gathered_acab ! Used in horizontal_remap_in() + real(8),dimension(:,:,:),allocatable :: gathered_temp ! Used in horizontal_remap_in() + real(8),dimension(:,:),allocatable :: gathered_dusrfdew ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dusrfdns ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dthckdew ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dthckdns ! Used in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxx ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauyy ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxy ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauscalar ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxz ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauyz ! Calculated in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_topg ! Bedrock topology, Used in glide_set_mask() + integer,dimension(:,:),allocatable :: gathered_thkmask ! Calculated in glide_set_mask() + real(8),dimension(:,:),allocatable :: gathered_marine_bc_normal ! Calculated in glide_marine_margin_normal() + real(8),dimension(:,:,:),allocatable :: gathered_surfvel ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_gline_flux ! Calculated in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_ubas ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_vbas ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_relx ! Used in glide_marinlim() + real(8),dimension(:,:,:),allocatable :: gathered_flwa ! Used in glide_marinlim() + real(4),dimension(:,:),allocatable :: gathered_calving ! Used in glide_marinlim() + real(4),dimension(:,:),allocatable :: gathered_backstress ! Used in glide_marinlim() + real(8),dimension(:,:),allocatable :: gathered_usrf ! Used in glide_marinlim() + logical,dimension(:,:),allocatable :: gathered_backstressmap ! Used in glide_marinlim() + real(8),dimension(:,:),allocatable :: gathered_tau_x ! Calculated in calc_basal_shear() + real(8),dimension(:,:),allocatable :: gathered_tau_y ! Calculated in calc_basal_shear() + real(8),dimension(:,:),allocatable :: gathered_lsrf ! Used in glide_marinlim() + + interface broadcast + module procedure broadcast_character + module procedure broadcast_integer + module procedure broadcast_integer_1d + module procedure broadcast_logical + module procedure broadcast_real4 + module procedure broadcast_real4_1d + module procedure broadcast_real8 + module procedure broadcast_real8_1d + end interface + + interface distributed_gather_var + module procedure distributed_gather_var_integer_2d + module procedure distributed_gather_var_logical_2d + module procedure distributed_gather_var_real4_2d + module procedure distributed_gather_var_real4_3d + module procedure distributed_gather_var_real8_2d + module procedure distributed_gather_var_real8_3d + end interface + + interface distributed_get_var + module procedure distributed_get_var_integer_2d + module procedure distributed_get_var_real4_1d + module procedure distributed_get_var_real4_2d + module procedure distributed_get_var_real8_1d + module procedure distributed_get_var_real8_2d + module procedure distributed_get_var_real8_3d + end interface + + interface distributed_print + ! Gathers a distributed variable and writes to file + module procedure distributed_print_integer_2d + module procedure distributed_print_real8_2d + module procedure distributed_print_real8_3d + end interface + + interface distributed_put_var + module procedure distributed_put_var_integer_2d + module procedure distributed_put_var_real4_1d + module procedure distributed_put_var_real4_2d + module procedure distributed_put_var_real8_1d + module procedure distributed_put_var_real8_2d + module procedure distributed_put_var_real8_3d + + !TODO - Should the parallel_put_var routines be part of this interface? + module procedure parallel_put_var_real4 + module procedure parallel_put_var_real8 + end interface + + interface distributed_scatter_var + module procedure distributed_scatter_var_integer_2d + module procedure distributed_scatter_var_logical_2d + module procedure distributed_scatter_var_real4_2d + module procedure distributed_scatter_var_real4_3d + module procedure distributed_scatter_var_real8_2d + module procedure distributed_scatter_var_real8_3d + end interface + + interface global_sum + module procedure global_sum_real8_scalar + module procedure global_sum_real8_1d + end interface + + interface parallel_convert_haloed_to_nonhaloed + module procedure parallel_convert_haloed_to_nonhaloed_real4_2d + module procedure parallel_convert_haloed_to_nonhaloed_real8_2d + end interface parallel_convert_haloed_to_nonhaloed + + interface parallel_convert_nonhaloed_to_haloed + module procedure parallel_convert_nonhaloed_to_haloed_real4_2d + module procedure parallel_convert_nonhaloed_to_haloed_real8_2d + end interface parallel_convert_nonhaloed_to_haloed + + interface parallel_def_var + module procedure parallel_def_var_dimids + module procedure parallel_def_var_nodimids + end interface + + interface parallel_get_att + module procedure parallel_get_att_character + module procedure parallel_get_att_real4 + module procedure parallel_get_att_real4_1d + module procedure parallel_get_att_real8 + module procedure parallel_get_att_real8_1d + end interface + + interface parallel_get_var + module procedure parallel_get_var_integer_1d + module procedure parallel_get_var_real4_1d + module procedure parallel_get_var_real8_1d + end interface + + interface parallel_halo + module procedure parallel_halo_integer_2d + module procedure parallel_halo_logical_2d + module procedure parallel_halo_real4_2d + module procedure parallel_halo_real8_2d + module procedure parallel_halo_real8_3d + end interface + + interface parallel_halo_verify + module procedure parallel_halo_verify_integer_2d + module procedure parallel_halo_verify_real8_2d + module procedure parallel_halo_verify_real8_3d + end interface + + interface staggered_parallel_halo + module procedure staggered_parallel_halo_integer_2d + module procedure staggered_parallel_halo_integer_3d + module procedure staggered_parallel_halo_real8_2d + module procedure staggered_parallel_halo_real8_3d + module procedure staggered_parallel_halo_real8_4d + end interface + + interface staggered_parallel_halo_extrapolate + module procedure staggered_parallel_halo_extrapolate_integer_2d + module procedure staggered_parallel_halo_extrapolate_real8_2d + end interface + + interface parallel_print + ! Writes a parallel (same on all processors) variable to file by just writing from main_task + module procedure parallel_print_integer_2d + module procedure parallel_print_real8_2d + module procedure parallel_print_real8_3d + end interface + + interface parallel_put_att + module procedure parallel_put_att_character + module procedure parallel_put_att_real4 + module procedure parallel_put_att_real4_1d + module procedure parallel_put_att_real8 + module procedure parallel_put_att_real8_1d + end interface + + interface parallel_put_var + module procedure parallel_put_var_real4 + module procedure parallel_put_var_real8 + module procedure parallel_put_var_real8_1d + end interface + + interface parallel_reduce_max + module procedure parallel_reduce_max_integer + module procedure parallel_reduce_max_real4 + module procedure parallel_reduce_max_real8 + end interface + + interface parallel_reduce_min + module procedure parallel_reduce_min_integer + module procedure parallel_reduce_min_real4 + module procedure parallel_reduce_min_real8 + end interface + + interface parallel_reduce_sum + module procedure parallel_reduce_sum_integer + module procedure parallel_reduce_sum_real4 + module procedure parallel_reduce_sum_real8 + module procedure parallel_reduce_sum_real8_nvar + end interface + + ! This reduce interface determines the global max value and the processor on which it occurs + interface parallel_reduce_maxloc + module procedure parallel_reduce_maxloc_integer + module procedure parallel_reduce_maxloc_real4 + module procedure parallel_reduce_maxloc_real8 + end interface + + ! This reduce interface determines the global min value and the processor on which it occurs + interface parallel_reduce_minloc + module procedure parallel_reduce_minloc_integer + module procedure parallel_reduce_minloc_real4 + module procedure parallel_reduce_minloc_real8 + end interface + +contains + + subroutine broadcast_character(c, proc) + use mpi_mod + implicit none + character(len=*) :: c + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: ierror,n + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + n = len(c) + call mpi_bcast(c,n,mpi_character,source,comm,ierror) + end subroutine broadcast_character + + subroutine broadcast_integer(i, proc) + use mpi_mod + implicit none + integer :: i,ierror + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(i,1,mpi_integer,source,comm,ierror) + end subroutine broadcast_integer + + subroutine broadcast_integer_1d(a, proc) + use mpi_mod + implicit none + integer,dimension(:) :: a + integer :: ierror + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(a,size(a),mpi_integer,source,comm,ierror) + end subroutine broadcast_integer_1d + + subroutine broadcast_logical(l, proc) + use mpi_mod + implicit none + logical :: l + integer :: ierror + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(l,1,mpi_logical,source,comm,ierror) + end subroutine broadcast_logical + + subroutine broadcast_real4(r, proc) + use mpi_mod + implicit none + integer :: ierror + real(4) :: r + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(r,1,mpi_real4,source,comm,ierror) + end subroutine broadcast_real4 + + subroutine broadcast_real4_1d(a, proc) + use mpi_mod + implicit none + real(4),dimension(:) :: a + integer :: ierror + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(a,size(a),mpi_real4,source,comm,ierror) + end subroutine broadcast_real4_1d + + subroutine broadcast_real8(r, proc) + use mpi_mod + implicit none + integer :: ierror + real(8) :: r + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(r,1,mpi_real8,source,comm,ierror) + end subroutine broadcast_real8 + + subroutine broadcast_real8_1d(a, proc) + use mpi_mod + implicit none + real(8),dimension(:) :: a + integer :: ierror + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from + integer :: source ! local variable indicating which processor to broadcast from + ! begin + if (present(proc)) then + source = proc + else + source = main_rank + endif + call mpi_bcast(a,size(a),mpi_real8,source,comm,ierror) + end subroutine broadcast_real8_1d + + function distributed_execution() + ! Returns if running distributed or not. + logical distributed_execution + + distributed_execution = .true. + end function distributed_execution + + subroutine distributed_gather_var_integer_2d(values, global_values) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + integer,dimension(:,:),intent(in) :: values + integer,dimension(:,:),allocatable,intent(inout) :: global_values + + integer :: i,ierror,j,k + integer,dimension(:),allocatable :: displs,recvcounts + integer,dimension(:),allocatable :: recvbuf + integer,dimension(:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1) & + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:) = values(1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_int(sendbuf,size(sendbuf),mpi_integer,& + recvbuf,recvcounts,displs,mpi_integer,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_integer_2d + + subroutine distributed_gather_var_logical_2d(values, global_values) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + logical,dimension(:,:),intent(in) :: values + logical,dimension(:,:),allocatable,intent(inout) :: global_values + + integer :: i,ierror,j,k + integer,dimension(:),allocatable :: displs,recvcounts + logical,dimension(:),allocatable :: recvbuf + logical,dimension(:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:) = .false. + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1)& + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:) = values(1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_log(sendbuf,size(sendbuf),mpi_logical,& + recvbuf,recvcounts,displs,mpi_logical,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_logical_2d + + subroutine distributed_gather_var_real4_2d(values, global_values) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + real(4),dimension(:,:),intent(in) :: values + real(4),dimension(:,:),allocatable,intent(inout) :: global_values + + integer :: i,ierror,j,k + integer,dimension(:),allocatable :: displs,recvcounts + real(4),dimension(:),allocatable :: recvbuf + real(4),dimension(:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1) & + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:) = values(1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_real4(sendbuf,size(sendbuf),mpi_real4,& + recvbuf,recvcounts,displs,mpi_real4,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_real4_2d + + subroutine distributed_gather_var_real4_3d(values, global_values, ld1, ud1) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + real(4),dimension(:,:,:),intent(in) :: values + real(4),dimension(:,:,:),allocatable,intent(inout) :: global_values + integer,optional,intent(in) :: ld1, ud1 + + integer :: i,ierror,j,k,d1l,d1u + integer,dimension(:),allocatable :: displs,recvcounts + real(4),dimension(:),allocatable :: recvbuf + real(4),dimension(:,:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + if (present(ld1)) then + d1l = ld1 + else + d1l = 1 + endif + if (present(ud1)) then + d1u = ud1 + else + d1u = size(values,1)-(d1l-1) + endif + if (size(values,1) /= d1u-d1l+1) then + write(*,*) "size(values,1) .ne. d1u-d1l+1 in gather call" + call parallel_stop(__FILE__, __LINE__) + endif + allocate(global_values(d1l:d1u,& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1)& + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1)& + *size(values,1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(size(values,1),& + d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:,:) = values(:,1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_real4(sendbuf,size(sendbuf),mpi_real4,& + recvbuf,recvcounts,displs,mpi_real4,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(:,& + d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/size(values,1),& + d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_real4_3d + + subroutine distributed_gather_var_real8_2d(values, global_values) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + real(8),dimension(:,:),intent(in) :: values + real(8),dimension(:,:),allocatable,intent(inout) :: global_values + + integer :: i,ierror,j,k + integer,dimension(:),allocatable :: displs,recvcounts + real(8),dimension(:),allocatable :: recvbuf + real(8),dimension(:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1)& + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:) = values(1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_real8(sendbuf,size(sendbuf),mpi_real8,& + recvbuf,recvcounts,displs,mpi_real8,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_real8_2d + + subroutine distributed_gather_var_real8_3d(values, global_values, ld1, ud1) + + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + + use mpi_mod + implicit none + real(8),dimension(:,:,:),intent(in) :: values + real(8),dimension(:,:,:),allocatable,intent(inout) :: global_values + integer,optional,intent(in) :: ld1, ud1 + + integer :: i,ierror,j,k,d1l,d1u + integer,dimension(:),allocatable :: displs,recvcounts + real(8),dimension(:),allocatable :: recvbuf + real(8),dimension(:,:,:),allocatable :: sendbuf + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_gather does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + ! first time + if (.not. allocated(d_gs_bounds)) then + if (main_task) then + allocate(d_gs_bounds(4,tasks)) + else + allocate(d_gs_bounds(1,1)) + endif + + d_gs_mybounds(1) = ewlb+lhalo + d_gs_mybounds(2) = ewub-uhalo + d_gs_mybounds(3) = nslb+lhalo + d_gs_mybounds(4) = nsub-uhalo + call fc_gather_int(d_gs_mybounds,4,mpi_integer,d_gs_bounds,4,& + mpi_integer,main_rank,comm) + endif + + if (main_task) then + if (allocated(global_values)) then + deallocate(global_values) + endif + if (present(ld1)) then + d1l = ld1 + else + d1l = 1 + endif + if (present(ud1)) then + d1u = ud1 + else + d1u = size(values,1)-(d1l-1) + endif + if (size(values,1) /= d1u-d1l+1) then + write(*,*) "size(values,1) .ne. d1u-d1l+1 in gather call" + call parallel_stop(__FILE__, __LINE__) + endif + allocate(global_values(d1l:d1u,& + minval(d_gs_bounds(1,:)):maxval(d_gs_bounds(2,:)),& + minval(d_gs_bounds(3,:)):maxval(d_gs_bounds(4,:)))) + global_values(:,:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (d_gs_bounds(2,:)-d_gs_bounds(1,:)+1)& + *(d_gs_bounds(4,:)-d_gs_bounds(3,:)+1)& + *size(values,1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + if (allocated(global_values)) then + deallocate(global_values) + endif + allocate(global_values(1,1,1)) ! This prevents a problem with NULL pointers later. + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(size(values,1),& + d_gs_mybounds(1):d_gs_mybounds(2),& + d_gs_mybounds(3):d_gs_mybounds(4))) + sendbuf(:,:,:) = values(:,1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_real8(sendbuf,size(sendbuf),mpi_real8,& + recvbuf,recvcounts,displs,mpi_real8,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(:,& + d_gs_bounds(1,i):d_gs_bounds(2,i),& + d_gs_bounds(3,i):d_gs_bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/size(values,1),& + d_gs_bounds(2,i)-d_gs_bounds(1,i)+1,& + d_gs_bounds(4,i)-d_gs_bounds(3,i)+1/)) + end do + end if + ! automatic deallocation + end subroutine distributed_gather_var_real8_3d + + function distributed_get_var_integer_2d(ncid,varid,values,start) + use mpi_mod + implicit none + integer :: distributed_get_var_integer_2d,ncid,varid + integer,dimension(:) :: start + integer,dimension(:,:) :: values + + integer :: ew,i,ierror,ns + integer,dimension(4) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + integer,dimension(:),allocatable :: sendbuf + integer,dimension(:,:),allocatable :: global_values,recvbuf + + ! begin + + if (size(values,1)==local_ewn) then + ew = global_ewn + ns = global_nsn + else if (size(values,1)==local_ewn-1) then + ew = global_ewn-1 + ns = global_nsn-1 + else + call parallel_stop(__FILE__,__LINE__) + end if + mybounds(1) = ewlb + mybounds(2) = ewub + mybounds(3) = nslb + mybounds(4) = nsub + if (main_task) then + allocate(bounds(4,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,4,mpi_integer,bounds,4,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)),& + minval(bounds(3,:)):maxval(bounds(4,:)))) + global_values(:,:) = 0 + distributed_get_var_integer_2d = nf90_get_var(ncid,varid,& + global_values(1:ew,1:ns),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = (bounds(2,:)-bounds(1,:)+1)*(bounds(4,:)-bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = reshape(& + global_values(bounds(1,i):bounds(2,i),bounds(3,i):bounds(4,i)),& + (/displs(i+1)-displs(i)/)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_integer_2d) + allocate(recvbuf(local_ewn,local_nsn)) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_integer,& + recvbuf,size(recvbuf),mpi_integer,main_rank,comm,ierror) + values(:,:) = recvbuf(:size(values,1),:size(values,2)) + !automatic deallocation + end function distributed_get_var_integer_2d + + function distributed_get_var_real4_1d(ncid,varid,values,start) + use mpi_mod + use netcdf + implicit none + integer :: distributed_get_var_real4_1d,ncid,varid + integer,dimension(:) :: start + real(4),dimension(:) :: values + + integer :: i,ierror,myn,status,x1id,y1id + integer,dimension(2) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + real(4),dimension(:),allocatable :: global_values,sendbuf + + ! begin + + if (main_task) then + allocate(bounds(2,tasks)) + status = nf90_inq_varid(ncid,"x1",x1id) + status = nf90_inq_varid(ncid,"y1",y1id) + else + allocate(bounds(1,1)) + end if + call broadcast(x1id) + call broadcast(y1id) + if (varid==x1id) then + mybounds(1) = ewlb + mybounds(2) = ewub + myn = global_ewn + else if (varid==y1id) then + mybounds(1) = nslb + mybounds(2) = nsub + myn = global_nsn + else + call parallel_stop(__FILE__,__LINE__) + end if + call fc_gather_int(mybounds,2,mpi_integer,bounds,2,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)))) + global_values(:) = 0 + distributed_get_var_real4_1d = & + nf90_get_var(ncid,varid,global_values(1:myn),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = bounds(2,:)-bounds(1,:)+1 + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = & + global_values(bounds(1,i):bounds(2,i)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_real4_1d) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_real4,& + values,size(values),mpi_real4,main_rank,comm,ierror) + !automatic deallocation + end function distributed_get_var_real4_1d + + function distributed_get_var_real4_2d(ncid,varid,values,start) + use mpi_mod + implicit none + integer :: distributed_get_var_real4_2d,ncid,varid + integer,dimension(:) :: start + real(4),dimension(:,:) :: values + + integer :: ew,i,ierror,ns + integer,dimension(4) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + real(4),dimension(:),allocatable :: sendbuf + real(4),dimension(:,:),allocatable :: global_values,recvbuf + + ! begin + + if (size(values,1)==local_ewn) then + ew = global_ewn + ns = global_nsn + else if (size(values,1)==local_ewn-1) then + ew = global_ewn-1 + ns = global_nsn-1 + else + call parallel_stop(__FILE__,__LINE__) + end if + mybounds(1) = ewlb + mybounds(2) = ewub + mybounds(3) = nslb + mybounds(4) = nsub + if (main_task) then + allocate(bounds(4,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,4,mpi_integer,bounds,4,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)),& + minval(bounds(3,:)):maxval(bounds(4,:)))) + global_values(:,:) = 0 + distributed_get_var_real4_2d = nf90_get_var(ncid,varid,& + global_values(1:ew,1:ns),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = (bounds(2,:)-bounds(1,:)+1)*(bounds(4,:)-bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = reshape(& + global_values(bounds(1,i):bounds(2,i),bounds(3,i):bounds(4,i)),& + (/displs(i+1)-displs(i)/)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_real4_2d) + allocate(recvbuf(local_ewn,local_nsn)) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_real4,& + recvbuf,size(recvbuf),mpi_real4,main_rank,comm,ierror) + values(:,:) = recvbuf(:size(values,1),:size(values,2)) + !automatic deallocation + end function distributed_get_var_real4_2d + + !WHL - added this function + function distributed_get_var_real8_1d(ncid,varid,values,start) + use mpi_mod + use netcdf + implicit none + integer :: distributed_get_var_real8_1d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:) :: values + + integer :: i,ierror,myn,status,x1id,y1id + integer,dimension(2) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + real(8),dimension(:),allocatable :: global_values,sendbuf + + ! begin + + if (main_task) then + allocate(bounds(2,tasks)) + status = nf90_inq_varid(ncid,"x1",x1id) + status = nf90_inq_varid(ncid,"y1",y1id) + else + allocate(bounds(1,1)) + end if + call broadcast(x1id) + call broadcast(y1id) + if (varid==x1id) then + mybounds(1) = ewlb + mybounds(2) = ewub + myn = global_ewn + else if (varid==y1id) then + mybounds(1) = nslb + mybounds(2) = nsub + myn = global_nsn + else + call parallel_stop(__FILE__,__LINE__) + end if + call fc_gather_int(mybounds,2,mpi_integer,bounds,2,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)))) + global_values(:) = 0 + distributed_get_var_real8_1d = & + nf90_get_var(ncid,varid,global_values(1:myn),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = bounds(2,:)-bounds(1,:)+1 + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = & + global_values(bounds(1,i):bounds(2,i)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_real8_1d) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_real8,& + values,size(values),mpi_real8,main_rank,comm,ierror) + !automatic deallocation + end function distributed_get_var_real8_1d + + function distributed_get_var_real8_2d(ncid,varid,values,start) + use mpi_mod + implicit none + integer :: distributed_get_var_real8_2d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:,:) :: values + + integer :: ew,i,ierror,ns + integer,dimension(4) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + real(8),dimension(:),allocatable :: sendbuf + real(8),dimension(:,:),allocatable :: global_values,recvbuf + + ! begin + + if (size(values,1)==local_ewn) then + ew = global_ewn + ns = global_nsn + else if (size(values,1)==local_ewn-1) then + ew = global_ewn-1 + ns = global_nsn-1 + else + call parallel_stop(__FILE__,__LINE__) + end if + mybounds(1) = ewlb + mybounds(2) = ewub + mybounds(3) = nslb + mybounds(4) = nsub + if (main_task) then + allocate(bounds(4,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,4,mpi_integer,bounds,4,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)),& + minval(bounds(3,:)):maxval(bounds(4,:)))) + global_values(:,:) = 0 + distributed_get_var_real8_2d = nf90_get_var(ncid,varid,& + global_values(1:ew,1:ns),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = (bounds(2,:)-bounds(1,:)+1)*(bounds(4,:)-bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = reshape(& + global_values(bounds(1,i):bounds(2,i),bounds(3,i):bounds(4,i)),& + (/displs(i+1)-displs(i)/)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_real8_2d) + allocate(recvbuf(local_ewn,local_nsn)) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_real8,& + recvbuf,size(recvbuf),mpi_real8,main_rank,comm,ierror) + values(:,:) = recvbuf(:size(values,1),:size(values,2)) + !automatic deallocation + + end function distributed_get_var_real8_2d + + function distributed_get_var_real8_3d(ncid,varid,values,start) + use mpi_mod + implicit none + integer :: distributed_get_var_real8_3d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:,:,:) :: values + + integer :: ew,i,ierror,ns + integer,dimension(4) :: mybounds + integer,dimension(:),allocatable :: displs,sendcounts + integer,dimension(:,:),allocatable :: bounds + real(8),dimension(:),allocatable :: sendbuf + real(8),dimension(:,:,:),allocatable :: global_values,recvbuf + + ! begin + + if (size(values,1)==local_ewn) then + ew = global_ewn + ns = global_nsn + else if (size(values,1)==local_ewn-1) then + ew = global_ewn-1 + ns = global_nsn-1 + else + call parallel_stop(__FILE__,__LINE__) + end if + mybounds(1) = ewlb + mybounds(2) = ewub + mybounds(3) = nslb + mybounds(4) = nsub + if (main_task) then + allocate(bounds(4,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,4,mpi_integer,bounds,4,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)),& + minval(bounds(3,:)):maxval(bounds(4,:)),size(values,3))) + global_values(:,:,:) = 0 + distributed_get_var_real8_3d = nf90_get_var(ncid,varid,& + global_values(1:ew,1:ns,:),start) + allocate(displs(tasks+1)) + allocate(sendcounts(tasks)) + sendcounts(:) = (bounds(2,:)-bounds(1,:)+1)*& + (bounds(4,:)-bounds(3,:)+1)*size(values,3) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+sendcounts(i) + end do + allocate(sendbuf(displs(tasks+1))) + do i = 1,tasks + sendbuf(displs(i)+1:displs(i+1)) = reshape(global_values(& + bounds(1,i):bounds(2,i),bounds(3,i):bounds(4,i),:),& + (/displs(i+1)-displs(i)/)) + end do + else + allocate(displs(1)) + allocate(sendcounts(1)) + allocate(sendbuf(1)) + end if + call broadcast(distributed_get_var_real8_3d) + allocate(recvbuf(local_ewn,local_nsn,size(values,3))) + call mpi_scatterv(sendbuf,sendcounts,displs,mpi_real8,& + recvbuf,size(recvbuf),mpi_real8,main_rank,comm,ierror) + values(:,:,:) = recvbuf(:size(values,1),:size(values,2),:) + !automatic deallocation + end function distributed_get_var_real8_3d + + function distributed_isparallel() + implicit none + logical :: distributed_isparallel + + distributed_isparallel = .true. + end function distributed_isparallel + + !WHL - added global boundary conditions + subroutine distributed_grid(ewn, nsn, nhalo_in, periodic_bc_in, outflow_bc_in) + + implicit none + integer, intent(inout) :: ewn, nsn ! global grid dimensions + integer, intent(in), optional :: nhalo_in ! number of rows of halo cells + logical, intent(in), optional :: periodic_bc_in ! true for periodic global BCs + logical, intent(in), optional :: outflow_bc_in ! true for outflow global BCs + ! (scalars in global halo set to zero) + + integer :: best,i,j,metric + integer :: ewrank,ewtasks,nsrank,nstasks + real(8) :: rewtasks,rnstasks + + ! begin + + ! Optionally, change the halo values + ! Note: The higher-order dycores (glam, glissade) currently require nhalo = 2. + ! The Glide SIA dycore requires nhalo = 0. + ! The default halo values at the top of the module are appropriate for + ! the higher-order dycores. Here they can be reset to zero for Glide. + + if (present(nhalo_in)) then + if (main_task) then + write(*,*) 'Setting halo values: nhalo =', nhalo_in + if (nhalo_in < 0) then + write(*,*) 'ERROR: nhalo must be >= 0' + call parallel_stop(__FILE__, __LINE__) + elseif (nhalo_in /= 2) then + write(*,*) 'WARNING: parallel dycores tested only with nhalo = 2' + endif + endif + nhalo = nhalo_in + lhalo = nhalo + uhalo = nhalo + staggered_lhalo = lhalo + staggered_uhalo = max(uhalo-1, 0) + !TODO - Remove the following variables + staggered_whalo = lhalo + staggered_shalo = lhalo + staggered_ehalo = max(uhalo-1, 0) + staggered_nhalo = max(uhalo-1, 0) + endif + + global_ewn = ewn + global_nsn = nsn + + ewtasks = 0 + nstasks = 0 + best = huge(best) + do i = 1,min(tasks,global_ewn) + j = tasks/i + if (j<=global_nsn.and.i*j==tasks) then ! try to use all tasks + metric = abs(i*global_nsn-j*global_ewn) ! zero if ewn/nsn == i/j + if (metricthis_rank/ewtasks) east = east-ewtasks + south = this_rank-ewtasks + if (south<0) south = south+tasks + north = this_rank+ewtasks + if (north>=tasks) north = north-tasks + + ! Check that haven't split up the problem too much. Idea is that do not want halos overlapping in either dimension. + ! local_* - lhalo - uhalo is the actual number of non-halo cells on a processor. + if ((local_nsn - lhalo - uhalo) .lt. (lhalo + uhalo + 1)) then + write(*,*) "NS halos overlap on processor ", this_rank + call parallel_stop(__FILE__, __LINE__) + endif + + if ((local_ewn - lhalo - uhalo) .lt. (lhalo + uhalo + 1)) then + write(*,*) "EW halos overlap on processor ", this_rank + call parallel_stop(__FILE__, __LINE__) + endif + + !WHL - added global boundary conditions + + periodic_bc = .true. ! this is the default + outflow_bc = .false. + + if (present(outflow_bc_in)) then + outflow_bc = outflow_bc_in + if (outflow_bc) periodic_bc = .false. + endif + + if (present(periodic_bc_in)) then + periodic_bc = periodic_bc_in + if (periodic_bc) outflow_bc = .false. + endif + + ! Print grid geometry +! write(*,*) "Process ", this_rank, " Total = ", tasks, " ewtasks = ", ewtasks, " nstasks = ", nstasks +! write(*,*) "Process ", this_rank, " ewrank = ", ewrank, " nsrank = ", nsrank +! write(*,*) "Process ", this_rank, " l_ewn = ", local_ewn, " o_ewn = ", own_ewn +! write(*,*) "Process ", this_rank, " l_nsn = ", local_nsn, " o_nsn = ", own_nsn +! write(*,*) "Process ", this_rank, " ewlb = ", ewlb, " ewub = ", ewub +! write(*,*) "Process ", this_rank, " nslb = ", nslb, " nsub = ", nsub +! write(*,*) "Process ", this_rank, " east = ", east, " west = ", west +! write(*,*) "Process ", this_rank, " north = ", north, " south = ", south +! write(*,*) "Process ", this_rank, " ew_vars = ", own_ewn, " ns_vars = ", own_nsn + call distributed_print_grid(own_ewn, own_nsn) + + end subroutine distributed_grid + + function distributed_owner(ew,ewn,ns,nsn) + implicit none + logical :: distributed_owner + integer :: ew,ewn,ns,nsn + ! begin + distributed_owner = (ew>lhalo.and.ew<=local_ewn-uhalo.and.& + ns>lhalo.and.ns<=local_nsn-uhalo) + end function distributed_owner + + subroutine distributed_print_grid(l_ewn,l_nsn) + ! Gathers and prints the overall grid layout by processor counts. + use mpi_mod + implicit none + + integer :: l_ewn, l_nsn + integer :: i,j,curr_count + integer,dimension(2) :: mybounds + integer,dimension(:,:),allocatable :: bounds + + ! begin + mybounds(1) = l_ewn + mybounds(2) = l_nsn + + if (main_task) then + allocate(bounds(2,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,2,mpi_integer,bounds,2,mpi_integer,main_rank,comm) + if (main_task) then + do i = 1,tasks + if (bounds(1,i) .ne. -1) then + ! total up number of processors with matching distribution + curr_count = 1 + do j = i+1,tasks + if ((bounds(1,i) .eq. bounds(1,j)) .and. (bounds(2,i) .eq. bounds(2,j))) then + ! if matching current distribution, increment counter + curr_count = curr_count + 1 + bounds(1,j) = -1 ! mark so not counted later + bounds(2,j) = -1 + endif + enddo + write(*,*) "Layout(EW,NS) = ", bounds(1,i), bounds(2,i), " total procs = ", curr_count + endif + end do + end if + ! automatic deallocation + + end subroutine distributed_print_grid + + subroutine distributed_print_integer_2d(name,values) + use mpi_mod + implicit none + character(*) :: name + integer,dimension(:,:) :: values + + integer,parameter :: u = 33 + character(3) :: ts + integer :: i,ierror,j,k + integer,dimension(4) :: mybounds + integer,dimension(:),allocatable :: displs,recvcounts + integer,dimension(:,:),allocatable :: bounds + integer,dimension(:),allocatable :: recvbuf + integer,dimension(:,:),allocatable :: global_values,sendbuf + + ! begin + + if (uhalo==0 .and. size(values,1)==local_ewn-1) then + ! Fixing this would require some generalization as is done for distributed_put_var + write(*,*) "distributed_print does not currently work for" + write(*,*) "variables on the staggered grid when uhalo=0" + call parallel_stop(__FILE__, __LINE__) + end if + + mybounds(1) = ewlb+lhalo + mybounds(2) = ewub-uhalo + mybounds(3) = nslb+lhalo + mybounds(4) = nsub-uhalo + if (main_task) then + allocate(bounds(4,tasks)) + else + allocate(bounds(1,1)) + end if + call fc_gather_int(mybounds,4,mpi_integer,bounds,4,& + mpi_integer,main_rank,comm) + if (main_task) then + allocate(global_values(minval(bounds(1,:)):maxval(bounds(2,:)),& + minval(bounds(3,:)):maxval(bounds(4,:)))) + global_values(:,:) = 0 + allocate(displs(tasks+1)) + allocate(recvcounts(tasks)) + recvcounts(:) = (bounds(2,:)-bounds(1,:)+1)*(bounds(4,:)-bounds(3,:)+1) + displs(1) = 0 + do i = 1,tasks + displs(i+1) = displs(i)+recvcounts(i) + end do + allocate(recvbuf(displs(tasks+1))) + else + allocate(displs(1)) + allocate(recvcounts(1)) + allocate(recvbuf(1)) + end if + allocate(sendbuf(mybounds(1):mybounds(2),mybounds(3):mybounds(4))) + sendbuf(:,:) = values(1+lhalo:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call fc_gatherv_int(sendbuf,size(sendbuf),mpi_integer,& + recvbuf,recvcounts,displs,mpi_integer,main_rank,comm) + if (main_task) then + do i = 1,tasks + global_values(bounds(1,i):bounds(2,i),bounds(3,i):bounds(4,i)) = & + reshape(recvbuf(displs(i)+1:displs(i+1)), & + (/bounds(2,i)-bounds(1,i)+1,bounds(4,i)-bounds(3,i)+1/)) + end do + write(ts,'(i3.3)') tasks + open(unit=u,file=name//ts//".txt",form="formatted",status="replace") + if (size(values,1)global_ewn.and.ew==ewn-uhalo).or.& + (nslb<1.and.ns==1+lhalo).or.& + (nsub>global_nsn.and.ns==nsn-uhalo) + end function parallel_boundary + + function parallel_close(ncid) + implicit none + integer :: ncid,parallel_close + ! begin + if (main_task) parallel_close = nf90_close(ncid) + call broadcast(parallel_close) + end function parallel_close + + subroutine parallel_convert_haloed_to_nonhaloed_real4_2d(input_with_halo, output_no_halo) + ! Given an input array that has halo cells, return an output array without halo cells + real(4),dimension(:,:), intent(in) :: input_with_halo + real(4),dimension(:,:), intent(out) :: output_no_halo + + if (size(input_with_halo,1) /= local_ewn .or. size(input_with_halo,2) /= local_nsn) then + write(*,*) "Unexpected size for input_with_halo: ", & + size(input_with_halo,1), size(input_with_halo,2) + write(*,*) "Expected size is: ", local_ewn, local_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + if (size(output_no_halo,1) /= own_ewn .or. size(output_no_halo,2) /= own_nsn) then + write(*,*) "Unexpected size for output_no_halo: ", & + size(output_no_halo,1), size(output_no_halo,2) + write(*,*) "Expected size is: ", own_ewn, own_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + output_no_halo(1:own_ewn, 1:own_nsn) = & + input_with_halo(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine parallel_convert_haloed_to_nonhaloed_real4_2d + + subroutine parallel_convert_haloed_to_nonhaloed_real8_2d(input_with_halo, output_no_halo) + ! Given an input array that has halo cells, return an output array without halo cells + real(8),dimension(:,:), intent(in) :: input_with_halo + real(8),dimension(:,:), intent(out) :: output_no_halo + + if (size(input_with_halo,1) /= local_ewn .or. size(input_with_halo,2) /= local_nsn) then + write(*,*) "Unexpected size for input_with_halo: ", & + size(input_with_halo,1), size(input_with_halo,2) + write(*,*) "Expected size is: ", local_ewn, local_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + if (size(output_no_halo,1) /= own_ewn .or. size(output_no_halo,2) /= own_nsn) then + write(*,*) "Unexpected size for output_no_halo: ", & + size(output_no_halo,1), size(output_no_halo,2) + write(*,*) "Expected size is: ", own_ewn, own_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + output_no_halo(1:own_ewn, 1:own_nsn) = & + input_with_halo(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine parallel_convert_haloed_to_nonhaloed_real8_2d + + subroutine parallel_convert_nonhaloed_to_haloed_real4_2d(input_no_halo, output_with_halo) + ! Given an input array without halo cells, return an output array with halo cells + real(4),dimension(:,:), intent(in) :: input_no_halo + real(4),dimension(:,:), intent(out) :: output_with_halo + + if (size(input_no_halo,1) /= own_ewn .or. size(input_no_halo,2) /= own_nsn) then + write(*,*) "Unexpected size for input_no_halo: ", & + size(input_no_halo,1), size(input_no_halo,2) + write(*,*) "Expected size is: ", own_ewn, own_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + if (size(output_with_halo,1) /= local_ewn .or. size(output_with_halo,2) /= local_nsn) then + write(*,*) "Unexpected size for output_with_halo: ", & + size(output_with_halo,1), size(output_with_halo,2) + write(*,*) "Expected size is: ", local_ewn, local_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + output_with_halo(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) = & + input_no_halo(1:own_ewn, 1:own_nsn) + + call parallel_halo(output_with_halo) + + end subroutine parallel_convert_nonhaloed_to_haloed_real4_2d + + subroutine parallel_convert_nonhaloed_to_haloed_real8_2d(input_no_halo, output_with_halo) + ! Given an input array without halo cells, return an output array with halo cells + real(8),dimension(:,:), intent(in) :: input_no_halo + real(8),dimension(:,:), intent(out) :: output_with_halo + + if (size(input_no_halo,1) /= own_ewn .or. size(input_no_halo,2) /= own_nsn) then + write(*,*) "Unexpected size for input_no_halo: ", & + size(input_no_halo,1), size(input_no_halo,2) + write(*,*) "Expected size is: ", own_ewn, own_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + if (size(output_with_halo,1) /= local_ewn .or. size(output_with_halo,2) /= local_nsn) then + write(*,*) "Unexpected size for output_with_halo: ", & + size(output_with_halo,1), size(output_with_halo,2) + write(*,*) "Expected size is: ", local_ewn, local_nsn + call parallel_stop(__FILE__, __LINE__) + end if + + output_with_halo(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) = & + input_no_halo(1:own_ewn, 1:own_nsn) + + call parallel_halo(output_with_halo) + + end subroutine parallel_convert_nonhaloed_to_haloed_real8_2d + + function parallel_create(path,cmode,ncid) + implicit none + integer :: cmode,ncid,parallel_create + character(len=*) :: path + ! begin + if (main_task) parallel_create = nf90_create(path,cmode,ncid) + call broadcast(parallel_create) + call broadcast(ncid) + end function parallel_create + + function parallel_def_dim(ncid,name,len,dimid) + use netcdf + implicit none + integer :: dimid,len,ncid,parallel_def_dim + character(len=*) :: name + ! begin + if (main_task) parallel_def_dim = nf90_def_dim(ncid,name,len,dimid) + call broadcast(parallel_def_dim) + call broadcast(dimid) + end function parallel_def_dim + + function parallel_def_var_dimids(ncid,name,xtype,dimids,varid) + implicit none + integer :: ncid,parallel_def_var_dimids,varid,xtype + integer,dimension(:) :: dimids + character(len=*) :: name + ! begin + if (main_task) parallel_def_var_dimids = & + nf90_def_var(ncid,name,xtype,dimids,varid) + call broadcast(parallel_def_var_dimids) + call broadcast(varid) + end function parallel_def_var_dimids + + function parallel_def_var_nodimids(ncid,name,xtype,varid) + implicit none + integer :: ncid,parallel_def_var_nodimids,varid,xtype + character(len=*) :: name + ! begin + if (main_task) parallel_def_var_nodimids = & + nf90_def_var(ncid,name,xtype,varid) + call broadcast(parallel_def_var_nodimids) + call broadcast(varid) + end function parallel_def_var_nodimids + + function parallel_enddef(ncid) + implicit none + integer :: ncid,parallel_enddef + ! begin + if (main_task) parallel_enddef = nf90_enddef(ncid) + call broadcast(parallel_enddef) + end function parallel_enddef + + subroutine parallel_finalise + use mpi_mod + implicit none + integer :: ierror + ! begin + call mpi_finalize(ierror) + end subroutine parallel_finalise + + function parallel_get_att_character(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_get_att_character,varid + character(len=*) :: name,values + ! begin + if (main_task) parallel_get_att_character = & + nf90_get_att(ncid,varid,name,values) + call broadcast(parallel_get_att_character) + call broadcast(values) + end function parallel_get_att_character + + function parallel_get_att_real4(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_get_att_real4,varid + character(len=*) :: name + real(4) :: values + ! begin + if (main_task) parallel_get_att_real4 = & + nf90_get_att(ncid,varid,name,values) + call broadcast(parallel_get_att_real4) + call broadcast(values) + end function parallel_get_att_real4 + + function parallel_get_att_real4_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_get_att_real4_1d,varid + character(len=*) :: name + real(4),dimension(:) :: values + ! begin + if (main_task) parallel_get_att_real4_1d = & + nf90_get_att(ncid,varid,name,values) + call broadcast(parallel_get_att_real4_1d) + call broadcast(values) + end function parallel_get_att_real4_1d + + function parallel_get_att_real8(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_get_att_real8,varid + character(len=*) :: name + real(8) :: values + ! begin + if (main_task) parallel_get_att_real8 = & + nf90_get_att(ncid,varid,name,values) + call broadcast(parallel_get_att_real8) + call broadcast(values) + end function parallel_get_att_real8 + + function parallel_get_att_real8_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_get_att_real8_1d,varid + character(len=*) :: name + real(8),dimension(:) :: values + ! begin + if (main_task) parallel_get_att_real8_1d = & + nf90_get_att(ncid,varid,name,values) + call broadcast(parallel_get_att_real8_1d) + call broadcast(values) + end function parallel_get_att_real8_1d + + function parallel_get_var_integer_1d(ncid,varid,values) + implicit none + integer :: ncid,parallel_get_var_integer_1d,varid + integer,dimension(:) :: values + ! begin + if (main_task) parallel_get_var_integer_1d = & + nf90_get_var(ncid,varid,values) + call broadcast(parallel_get_var_integer_1d) + call broadcast(values) + end function parallel_get_var_integer_1d + + function parallel_get_var_real4_1d(ncid,varid,values) + implicit none + integer :: ncid,parallel_get_var_real4_1d,varid + real(4),dimension(:) :: values + ! begin + if (main_task) parallel_get_var_real4_1d = & + nf90_get_var(ncid,varid,values) + call broadcast(parallel_get_var_real4_1d) + call broadcast(values) + end function parallel_get_var_real4_1d + + function parallel_get_var_real8_1d(ncid,varid,values) + implicit none + integer :: ncid,parallel_get_var_real8_1d,varid + real(8),dimension(:) :: values + ! begin + if (main_task) parallel_get_var_real8_1d = & + nf90_get_var(ncid,varid,values) + call broadcast(parallel_get_var_real8_1d) + call broadcast(values) + end function parallel_get_var_real8_1d + + !TODO - Is function parallel_globalID still needed? No longer called except from glissade_test_halo. + + function parallel_globalID(locns, locew, upstride) + ! Returns a unique ID for a given row and column reference that is identical across all processors. + ! For instance if Proc 0: (17,16) is the same global cell as Proc 3: (17,1), then the globalID will be the same for both. + ! These IDs are spaced upstride apart. upstride = number of vertical layers. Typically (upn) + number of ghost layers (2 = top and bottom) + integer,intent(IN) :: locns, locew, upstride + integer :: parallel_globalID + ! locns is local NS (row) grid index + ! locew is local EW (col) grid index + integer :: global_row, global_col, global_ID + character(len=40) :: local_coord + + ! including global domain halo adds lhalo to offsets + global_row = (locns - lhalo) + (global_row_offset + lhalo) + global_col = (locew - lhalo) + (global_col_offset + lhalo) + + ! if halo cell and if using periodic boundary conditions, + ! define global ID to be associated non-halo cell + if (global_row .le. lhalo) then + if (horiz_bcs_type_south .eq. HORIZ_BCS_CYCLIC) then + global_row = global_row + global_nsn + endif + endif + + if (global_row > (global_nsn+lhalo)) then + if (horiz_bcs_type_north .eq. HORIZ_BCS_CYCLIC) then + global_row = global_row - global_nsn + endif + endif + + if (global_col .le. lhalo) then + if (horiz_bcs_type_west .eq. HORIZ_BCS_CYCLIC) then + global_col = global_col + global_ewn + endif + endif + + if (global_col > (global_ewn+lhalo)) then + if (horiz_bcs_type_east .eq. HORIZ_BCS_CYCLIC) then + global_col = global_col - global_ewn + endif + endif + + ! including global domain halo adds (lhalo + uhalo) to global_ewn + global_ID = ((global_row - 1) * (global_ewn + lhalo + uhalo) + (global_col - 1)) * upstride + 1 + + ! JEFF Testing Code + ! write(local_coord, "A13,I10.1,A2,I10.1,A1") " (NS, EW) = (", locns, ", ", locew, ")" + ! write(*,*) "Processor reference ", this_rank, local_coord, " globalID = ", global_ID + + !return value + parallel_globalID = global_ID + + end function parallel_globalID + + + function parallel_globalID_scalar(locew, locns, upstride) + + !WHL - This function is similar to parallel_globalID, but assigns 0's to cells outside the global domain + + ! Returns a unique ID for a given row and column reference that is identical across all processors. + ! For instance if Proc 0: (17,16) is the same global cell as Proc 3: (17,1), then the globalID will be the same for both. + ! These IDs are spaced upstride apart. upstride = number of vertical layers. + integer,intent(IN) :: locns, locew, upstride + integer :: parallel_globalID_scalar + ! locns is local NS (row) grid index + ! locew is local EW (col) grid index + integer :: global_row, global_col, global_ID + character(len=40) :: local_coord + + ! including global domain halo adds lhalo to offsets + global_row = (locns - lhalo) + global_row_offset + global_col = (locew - lhalo) + global_col_offset + + ! including global domain halo adds (lhalo + uhalo) to global_ewn + global_ID = ((global_row - 1)*(global_ewn) + (global_col - 1)) * upstride + 1 + + ! JEFF Testing Code + ! write(local_coord, "A13,I10.1,A2,I10.1,A1") " (NS, EW) = (", locns, ", ", locew, ")" + ! write(*,*) "Processor reference ", this_rank, local_coord, " globalID = ", global_ID + + !return value + parallel_globalID_scalar = global_ID + + end function parallel_globalID_scalar + + + subroutine parallel_globalindex(ilocal, jlocal, iglobal, jglobal) + ! Calculates the global i,j indices from the local i,j indices + integer,intent(IN) :: ilocal, jlocal ! These include the halos + integer,intent(OUT) :: iglobal, jglobal ! These do NOT include halos + + ! Note: if the local index is in a halo, still convert that to its location + ! on the global grid (even though that location on the global grid is owned + ! by a different processor!) + ! No check is currently made for being located in the global (periodic) halo + iglobal = (ilocal - lhalo) + global_col_offset + jglobal = (jlocal - lhalo) + global_row_offset + end subroutine parallel_globalindex + + subroutine parallel_localindex(iglobal, jglobal, ilocal, jlocal, rlocal) + ! Calculates the local i,j indices and rank from the global i,j indices + integer,intent(IN) :: iglobal, jglobal + integer,intent(OUT) :: ilocal, jlocal, rlocal + integer :: flag + + flag = 0 ! This flag will be flipped on exactly one processor if the global point is valid + ilocal = iglobal + lhalo - global_col_offset + jlocal = jglobal + lhalo - global_row_offset + + ! Check whether these are valid values of ilocal and jlocal + ! If so, then flip the flag and broadcast these values + if ( (ilocal > lhalo .and. ilocal <= lhalo + own_ewn) & + .and. & + (jlocal > lhalo .and. jlocal <= lhalo + own_nsn) ) then + flag = 1 + endif + + call parallel_reduce_maxloc(flag, flag, rlocal) + + if (flag==1) then + call broadcast(ilocal, rlocal) + call broadcast(jlocal, rlocal) + else ! global indices are invalid + if (main_task) then + write(*,*) 'Invalid global indices: iglobal, jglobal =', iglobal, jglobal + call parallel_stop(__FILE__,__LINE__) + endif + endif + end subroutine parallel_localindex + + subroutine parallel_halo_integer_2d(a) + use mpi_mod + implicit none + integer,dimension(:,:) :: a + + integer :: erequest,ierror,nrequest,srequest,wrequest + integer,dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + integer,dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + integer,dimension(local_ewn,lhalo) :: nsend,srecv + integer,dimension(local_ewn,uhalo) :: nrecv,ssend + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_integer,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_integer,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_integer,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_integer,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_integer,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_integer,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:lhalo,1+lhalo:local_nsn-uhalo) = wrecv(:,:) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = erecv(:,:) + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_integer,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_integer,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:lhalo) = srecv(:,:) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,local_nsn-uhalo+1:) = nrecv(:,:) + + if (outflow_bc) then ! set values in global halo to zero + ! interior halo cells should not be affected + + if (this_rank >= east) then ! at east edge of global domain + a(local_ewn-uhalo+1:,:) = 0 + endif + + if (this_rank <= west) then ! at west edge of global domain + a(:lhalo,:) = 0 + endif + + if (this_rank >= north) then ! at north edge of global domain + a(:,local_nsn-uhalo+1:) = 0 + endif + + if (this_rank <= south) then ! at south edge of global domain + a(:,:lhalo) = 0 + endif + + endif ! open BC + + end subroutine parallel_halo_integer_2d + + subroutine parallel_halo_logical_2d(a) + use mpi_mod + implicit none + logical,dimension(:,:) :: a + + integer :: erequest,ierror,nrequest,srequest,wrequest + logical,dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + logical,dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + logical,dimension(local_ewn,lhalo) :: nsend,srecv + logical,dimension(local_ewn,uhalo) :: nrecv,ssend + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_logical,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_logical,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_logical,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_logical,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_logical,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_logical,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:lhalo,1+lhalo:local_nsn-uhalo) = wrecv(:,:) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = erecv(:,:) + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_logical,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_logical,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:lhalo) = srecv(:,:) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,local_nsn-uhalo+1:) = nrecv(:,:) + + if (outflow_bc) then ! set values in global halo to zero + ! interior halo cells should not be affected + + if (this_rank >= east) then ! at east edge of global domain + a(local_ewn-uhalo+1:,:) = .false. + endif + + if (this_rank <= west) then ! at west edge of global domain + a(:lhalo,:) = .false. + endif + + if (this_rank >= north) then ! at north edge of global domain + a(:,local_nsn-uhalo+1:) = .false. + endif + + if (this_rank <= south) then ! at south edge of global domain + a(:,:lhalo) = .false. + endif + + endif ! open BC + + end subroutine parallel_halo_logical_2d + + subroutine parallel_halo_real4_2d(a) + use mpi_mod + implicit none + real(4),dimension(:,:) :: a + + integer :: erequest,ierror,nrequest,srequest,wrequest + real(4),dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + real(4),dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + real(4),dimension(local_ewn,lhalo) :: nsend,srecv + real(4),dimension(local_ewn,uhalo) :: nrecv,ssend + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_real4,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_real4,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_real4,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real4,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_real4,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_real4,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:lhalo,1+lhalo:local_nsn-uhalo) = wrecv(:,:) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = erecv(:,:) + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_real4,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real4,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:lhalo) = srecv(:,:) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,local_nsn-uhalo+1:) = nrecv(:,:) + + if (outflow_bc) then ! set values in global halo to zero + ! interior halo cells should not be affected + + if (this_rank >= east) then ! at east edge of global domain + a(local_ewn-uhalo+1:,:) = 0. + endif + + if (this_rank <= west) then ! at west edge of global domain + a(:lhalo,:) = 0. + endif + + if (this_rank >= north) then ! at north edge of global domain + a(:,local_nsn-uhalo+1:) = 0. + endif + + if (this_rank <= south) then ! at south edge of global domain + a(:,:lhalo) = 0. + endif + + endif ! open BC + + end subroutine parallel_halo_real4_2d + + + subroutine parallel_halo_real8_2d(a, periodic_offset_ew, periodic_offset_ns) + + !WHL - added optional arguments for periodic offsets, to support ismip-hom test cases + + use mpi_mod + implicit none + real(8),dimension(:,:) :: a + real(8), intent(in), optional :: & + periodic_offset_ew, &! offset halo values by this amount + ! if positive, the offset is positive for W halo, negative for E halo + periodic_offset_ns ! offset halo values by this amount + ! if positive, the offset is positive for S halo, negative for N halo + + integer :: erequest,ierror,nrequest,srequest,wrequest + real(8),dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + real(8),dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + real(8),dimension(local_ewn,lhalo) :: nsend,srecv + real(8),dimension(local_ewn,uhalo) :: nrecv,ssend + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:lhalo,1+lhalo:local_nsn-uhalo) = wrecv(:,:) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = erecv(:,:) + + if (present(periodic_offset_ew)) then + if (periodic_offset_ew /= 0.d0) then + if (this_rank <= west) then ! this proc lies at the west edge of the global domain +! print*, 'Offset at west edge: this_rank, west =', this_rank, west + a(:lhalo,1+lhalo:local_nsn-uhalo) = & + a(:lhalo,1+lhalo:local_nsn-uhalo) + periodic_offset_ew + endif + if (this_rank >= east) then ! this proc lies at the east edge of the global domain +! print*, 'Offset at east edge: this_rank, east =', this_rank, east + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = & + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) - periodic_offset_ew + endif + endif + endif + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:lhalo) = srecv(:,:) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,local_nsn-uhalo+1:) = nrecv(:,:) + + if (present(periodic_offset_ns)) then + if (periodic_offset_ns /= 0.d0) then + if (this_rank <= south) then ! this proc lies at the south edge of the global domain +! print*, 'Offset at south edge: this_rank, south =', this_rank, south + a(:,:lhalo) = a(:,:lhalo) + periodic_offset_ns + endif + if (this_rank >= north) then ! this proc lies at the north edge of the global domain +! print*, 'Offset at north edge: this_rank, north =', this_rank, north + a(:,local_nsn-uhalo+1:) = a(:,local_nsn-uhalo+1:) - periodic_offset_ns + endif + endif + endif + + if (outflow_bc) then ! set values in global halo to zero + ! interior halo cells should not be affected + + if (this_rank >= east) then ! at east edge of global domain + a(local_ewn-uhalo+1:,:) = 0.d0 + endif + + if (this_rank <= west) then ! at west edge of global domain + a(:lhalo,:) = 0.d0 + endif + + if (this_rank >= north) then ! at north edge of global domain + a(:,local_nsn-uhalo+1:) = 0.d0 + endif + + if (this_rank <= south) then ! at south edge of global domain + a(:,:lhalo) = 0.d0 + endif + + endif ! open BC + + end subroutine parallel_halo_real8_2d + + subroutine parallel_halo_real8_3d(a) + + use mpi_mod + implicit none + real(8),dimension(:,:,:) :: a + + integer :: erequest,ierror,one,nrequest,srequest,wrequest + real(8),dimension(size(a,1),lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + real(8),dimension(size(a,1),uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + real(8),dimension(size(a,1),local_ewn,lhalo) :: nsend,srecv + real(8),dimension(size(a,1),local_ewn,uhalo) :: nrecv,ssend + + ! begin + + ! staggered grid + if (size(a,2)==local_ewn-1.and.size(a,3)==local_nsn-1) return + + ! unknown grid + if (size(a,2)/=local_ewn.or.size(a,3)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ",", size(a,3), ") & + &and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,& + comm,nrequest,ierror) + + esend(:,:,:) = & + a(:,local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + wsend(:,:,:) = a(:,1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:,:lhalo,1+lhalo:local_nsn-uhalo) = wrecv(:,:,:) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(:,local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = erecv(:,:,:) + + nsend(:,:,:) = a(:,:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + ssend(:,:,:) = a(:,:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:,:lhalo) = srecv(:,:,:) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,:,local_nsn-uhalo+1:) = nrecv(:,:,:) + + if (outflow_bc) then ! set values in global halo to zero + ! interior halo cells should not be affected + + if (this_rank >= east) then ! at east edge of global domain + a(:,local_ewn-uhalo+1:,:) = 0.d0 + endif + + if (this_rank <= west) then ! at west edge of global domain + a(:,:lhalo,:) = 0.d0 + endif + + if (this_rank >= north) then ! at north edge of global domain + a(:,:,local_nsn-uhalo+1:) = 0.d0 + endif + + if (this_rank <= south) then ! at south edge of global domain + a(:,:,:lhalo) = 0.d0 + endif + + endif ! outflow BC + + end subroutine parallel_halo_real8_3d + + + function parallel_halo_verify_integer_2d(a) + use mpi_mod + implicit none + integer,dimension(:,:) :: a + + integer :: erequest,ierror,nrequest,srequest,wrequest + integer,dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + integer,dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + integer,dimension(local_ewn,lhalo) :: nsend,srecv + integer,dimension(local_ewn,uhalo) :: nrecv,ssend + logical :: notverify_flag + logical :: parallel_halo_verify_integer_2d + + ! begin + + if (DEBUG_LEVEL <= 0) return + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) & + call parallel_stop(__FILE__,__LINE__) + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_integer,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_integer,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_integer,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_integer,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_integer,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_integer,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + ! ANY True if any value is true (LOGICAL) + notverify_flag = ANY(a(:lhalo,1+lhalo:local_nsn-uhalo) /= wrecv(:,:)) + call mpi_wait(erequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. & + ANY(a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) /= erecv(:,:)) + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_integer,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_integer,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,:lhalo) /= srecv(:,:)) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,local_nsn-uhalo+1:) /= nrecv(:,:)) + + ! if notverify_flag is TRUE, then there was some difference detected + if (notverify_flag) then + write(*,*) "Halo Verify FAILED on processor ", this_rank + ! call parallel_stop(__FILE__,__LINE__) + endif + + parallel_halo_verify_integer_2d = .NOT. notverify_flag ! return if verified (True) or not verified (False) + end function parallel_halo_verify_integer_2d + + function parallel_halo_verify_real8_2d(a) + use mpi_mod + implicit none + real(8),dimension(:,:) :: a + + integer :: erequest,ierror,nrequest,srequest,wrequest + real(8),dimension(lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + real(8),dimension(uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + real(8),dimension(local_ewn,lhalo) :: nsend,srecv + real(8),dimension(local_ewn,uhalo) :: nrecv,ssend + logical :: notverify_flag + logical :: parallel_halo_verify_real8_2d + + ! begin + + if (DEBUG_LEVEL <= 0) return + + ! staggered grid + if (size(a,1)==local_ewn-1.and.size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn.or.size(a,2)/=local_nsn) & + call parallel_stop(__FILE__,__LINE__) + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,& + comm,nrequest,ierror) + + esend(:,:) = & + a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + wsend(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + notverify_flag = ANY(a(:lhalo,1+lhalo:local_nsn-uhalo) /= wrecv(:,:)) + call mpi_wait(erequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. & + ANY(a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) /= erecv(:,:)) + + nsend(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + ssend(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,:lhalo) /= srecv(:,:)) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,local_nsn-uhalo+1:) /= nrecv(:,:)) + + if (notverify_flag) then + write(*,*) "Halo Verify FAILED on processor ", this_rank + ! call parallel_stop(__FILE__,__LINE__) + endif + + parallel_halo_verify_real8_2d = .NOT. notverify_flag + end function parallel_halo_verify_real8_2d + + function parallel_halo_verify_real8_3d(a) + use mpi_mod + implicit none + real(8),dimension(:,:,:) :: a + + integer :: erequest,ierror,one,nrequest,srequest,wrequest + real(8),dimension(size(a,1),lhalo,local_nsn-lhalo-uhalo) :: esend,wrecv + real(8),dimension(size(a,1),uhalo,local_nsn-lhalo-uhalo) :: erecv,wsend + real(8),dimension(size(a,1),local_ewn,lhalo) :: nsend,srecv + real(8),dimension(size(a,1),local_ewn,uhalo) :: nrecv,ssend + logical :: notverify_flag + logical :: parallel_halo_verify_real8_3d + + ! begin + + if (DEBUG_LEVEL <= 0) return + + ! staggered grid + if (size(a,2)==local_ewn-1.and.size(a,3)==local_nsn-1) return + + ! unknown grid + if (size(a,2)/=local_ewn.or.size(a,3)/=local_nsn) & + call parallel_stop(__FILE__,__LINE__) + + ! unstaggered grid + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,& + comm,wrequest,ierror) + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,& + comm,erequest,ierror) + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,& + comm,srequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,& + comm,nrequest,ierror) + + esend(:,:,:) = & + a(:,local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + wsend(:,:,:) = a(:,1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + + call mpi_wait(wrequest,mpi_status_ignore,ierror) + notverify_flag = ANY(a(:,:lhalo,1+lhalo:local_nsn-uhalo) /= wrecv(:,:,:)) + call mpi_wait(erequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. & + ANY(a(:,local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) /= erecv(:,:,:)) + + nsend(:,:,:) = a(:,:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + ssend(:,:,:) = a(:,:,1+lhalo:1+lhalo+uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + + call mpi_wait(srequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,:,:lhalo) /= srecv(:,:,:)) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + notverify_flag = notverify_flag .OR. ANY(a(:,:,local_nsn-uhalo+1:) /= nrecv(:,:,:)) + + if (notverify_flag) then + write(*,*) "Halo Verify FAILED on processor ", this_rank + ! call parallel_stop(__FILE__,__LINE__) + endif + + parallel_halo_verify_real8_3d = .NOT. notverify_flag + end function parallel_halo_verify_real8_3d + + ! parallel_initialise should generally just be called by standalone cism drivers + ! When cism is nested inside a climate model (so mpi_init has already been called) use parallel_set_info instead + + subroutine parallel_initialise + use mpi_mod + implicit none + integer :: ierror + integer, parameter :: my_main_rank = 0 + ! begin + call mpi_init(ierror) + call parallel_set_info(mpi_comm_world, my_main_rank) + end subroutine parallel_initialise + + ! parallel_set_info should be called directly when cism is nested inside a climate model + ! (then, mpi_init has already been called, so do NOT use parallel_initialise) + + subroutine parallel_set_info(my_comm, my_main_rank) + use mpi_mod + implicit none + integer, intent(in) :: my_comm ! CISM's global communicator + integer, intent(in) :: my_main_rank ! rank of the master task + integer :: ierror + ! begin + comm = my_comm + main_rank = my_main_rank + call mpi_comm_size(comm,tasks,ierror) + call mpi_comm_rank(comm,this_rank,ierror) + main_task = (this_rank==main_rank) + end subroutine parallel_set_info + + function parallel_inq_attname(ncid,varid,attnum,name) + implicit none + integer :: attnum,ncid,parallel_inq_attname,varid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_attname = & + nf90_inq_attname(ncid,varid,attnum,name) + call broadcast(parallel_inq_attname) + call broadcast(name) + end function parallel_inq_attname + + function parallel_inq_dimid(ncid,name,dimid) + implicit none + integer :: dimid,ncid,parallel_inq_dimid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_dimid = nf90_inq_dimid(ncid,name,dimid) + call broadcast(parallel_inq_dimid) + call broadcast(dimid) + end function parallel_inq_dimid + + function parallel_inq_varid(ncid,name,varid) + implicit none + integer :: ncid,parallel_inq_varid,varid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_varid = nf90_inq_varid(ncid,name,varid) + call broadcast(parallel_inq_varid) + call broadcast(varid) + end function parallel_inq_varid + + function parallel_inquire(ncid,nvariables) + implicit none + integer :: ncid,parallel_inquire,nvariables + ! begin + if (main_task) parallel_inquire = nf90_inquire(ncid,nvariables=nvariables) + call broadcast(parallel_inquire) + call broadcast(nvariables) + end function parallel_inquire + + function parallel_inquire_dimension(ncid,dimid,name,len) + implicit none + integer :: dimid,ncid,parallel_inquire_dimension + integer,optional :: len + character(len=*),optional :: name + + integer :: l + + ! begin + + if (present(name)) then + if (main_task) parallel_inquire_dimension = & + nf90_inquire_dimension(ncid,dimid,name,len=l) + call broadcast(name) + else + if (main_task) parallel_inquire_dimension = & + nf90_inquire_dimension(ncid,dimid,len=l) + end if + call broadcast(parallel_inquire_dimension) + if (present(len)) then + call broadcast(l) + len = l + end if + end function parallel_inquire_dimension + + function parallel_inquire_variable(ncid,varid,name,ndims,dimids,natts) + implicit none + integer :: ncid,parallel_inquire_variable,varid + integer,optional :: ndims,natts + character(len=*),optional :: name + integer,dimension(:),optional :: dimids + + integer :: nd,na + ! begin + if (present(name)) then + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,name=name) + call broadcast(parallel_inquire_variable) + call broadcast(name) + if (parallel_inquire_variable/=nf90_noerr) return + end if + if (present(dimids)) then + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,dimids=dimids) + call broadcast(parallel_inquire_variable) + call broadcast(dimids) + if (parallel_inquire_variable/=nf90_noerr) return + end if + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,ndims=nd,natts=na) + call broadcast(parallel_inquire_variable) + if (present(ndims)) then + call broadcast(nd) + ndims = nd + end if + if (present(natts)) then + call broadcast(na) + natts = na + end if + end function parallel_inquire_variable + + function parallel_open(path,mode,ncid) + implicit none + integer :: mode,ncid,parallel_open + character(len=*) :: path + ! begin + if (main_task) parallel_open = nf90_open(path,mode,ncid) + call broadcast(parallel_open) + end function parallel_open + + subroutine parallel_print_all(name,values) + implicit none + character(*) :: name + real(8),dimension(:,:,:) :: values + + integer,parameter :: u = 33 + integer :: i,j,t + ! begin + if (main_task) then + open(unit=u,file=name,form="formatted",status="replace") + close(u) + end if + do t = 0,tasks-1 + call parallel_barrier + if (t==this_rank) then + open(unit=u,file=name,form="formatted",position="append") + do j = 1,size(values,3) + do i = 1,size(values,2) + write(u,'(2i5,100g15.5e3)') nslb+j-1,ewlb+i-1,values(:,i,j) + end do + write(u,'()') + end do + write(u,'(//)') + close(u) + end if + end do + end subroutine parallel_print_all + + subroutine parallel_print_integer_2d(name,values) + implicit none + character(*) :: name + integer,dimension(:,:) :: values + + integer,parameter :: u = 33 + character(3) :: ts + integer :: i,j + + ! begin + if (main_task) then + write(ts,'(i3.3)') tasks + open(unit=u,file=name//ts//".txt",form="formatted",status="replace") + do j = lbound(values,2),ubound(values,2) + do i = lbound(values,1),ubound(values,1) + write(u,*) j,i,values(i,j) + end do + write(u,'()') + end do + close(u) + end if + + call parallel_barrier ! Only the main_task writes the variable. Rest wait here. + ! automatic deallocation + end subroutine parallel_print_integer_2d + + subroutine parallel_print_real8_2d(name,values) + implicit none + character(*) :: name + real(8),dimension(:,:) :: values + + integer,parameter :: u = 33 + character(3) :: ts + integer :: i,j + + ! begin + if (main_task) then + write(ts,'(i3.3)') tasks + open(unit=u,file=name//ts//".txt",form="formatted",status="replace") + do j = lbound(values,2),ubound(values,2) + do i = lbound(values,1),ubound(values,1) + write(u,*) j,i,values(i,j) + end do + write(u,'()') + end do + close(u) + end if + + call parallel_barrier ! Only the main_task writes the variable. Rest wait here. + end subroutine parallel_print_real8_2d + + subroutine parallel_print_real8_3d(name,values) + implicit none + character(*) :: name + real(8),dimension(:,:,:) :: values + + integer,parameter :: u = 33 + character(3) :: ts + integer :: i,j + + ! begin + if (main_task) then + write(ts,'(i3.3)') tasks + open(unit=u,file=name//ts//".txt",form="formatted",status="replace") + do j = lbound(values,3),ubound(values,3) + do i = lbound(values,2),ubound(values,2) + write(u,'(2i6,100g15.5e3)') j,i,values(:,i,j) + end do + write(u,'()') + end do + close(u) + end if + + call parallel_barrier ! Only the main_task writes the variable. Rest wait here. + end subroutine parallel_print_real8_3d + + function parallel_put_att_character(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_character,varid + character(len=*) :: name,values + ! begin + if (main_task) parallel_put_att_character = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_character) + end function parallel_put_att_character + + function parallel_put_att_real4(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real4,varid + character(len=*) :: name + real(4) :: values + ! begin + if (main_task) parallel_put_att_real4 = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real4) + end function parallel_put_att_real4 + + function parallel_put_att_real4_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real4_1d,varid + character(len=*) :: name + real(4),dimension(:) :: values + ! begin + if (main_task) parallel_put_att_real4_1d = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real4_1d) + end function parallel_put_att_real4_1d + + function parallel_put_att_real8(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real8,varid + character(len=*) :: name + real(8) :: values + ! begin + if (main_task) parallel_put_att_real8 = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real8) + end function parallel_put_att_real8 + + function parallel_put_att_real8_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real8_1d,varid + character(len=*) :: name + real(8),dimension(:) :: values + ! begin + if (main_task) parallel_put_att_real8_1d = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real8_1d) + end function parallel_put_att_real8_1d + + function parallel_put_var_real4(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real4,varid + integer,dimension(:) :: start + real(4) :: values + ! begin + if (main_task) parallel_put_var_real4 = & + nf90_put_var(ncid,varid,values,start) + call broadcast(parallel_put_var_real4) + end function parallel_put_var_real4 + + function parallel_put_var_real8(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real8,varid + integer,dimension(:) :: start + real(8) :: values + ! begin + if (main_task) parallel_put_var_real8 = & + nf90_put_var(ncid,varid,values,start) + call broadcast(parallel_put_var_real8) + end function parallel_put_var_real8 + + function parallel_put_var_real8_1d(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real8_1d,varid + integer,dimension(:),optional :: start + real(8),dimension(:) :: values + ! begin + if (main_task) then + if (present(start)) then + parallel_put_var_real8_1d = nf90_put_var(ncid,varid,values,start) + else + parallel_put_var_real8_1d = nf90_put_var(ncid,varid,values) + end if + end if + call broadcast(parallel_put_var_real8_1d) + end function parallel_put_var_real8_1d + + function parallel_redef(ncid) + implicit none + integer :: ncid,parallel_redef + ! begin + if (main_task) parallel_redef = nf90_redef(ncid) + call broadcast(parallel_redef) + end function parallel_redef + +! ------------------------------------------ +! functions for parallel_reduce_sum interface +! ------------------------------------------ + function parallel_reduce_sum_integer(x) + use mpi_mod + implicit none + integer :: x + integer :: ierror + integer :: recvbuf,sendbuf, parallel_reduce_sum_integer + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_integer,mpi_sum,comm,ierror) + parallel_reduce_sum_integer = recvbuf + return + end function parallel_reduce_sum_integer + + function parallel_reduce_sum_real4(x) + use mpi_mod + implicit none + real(4) :: x + integer :: ierror + real(4) :: recvbuf,sendbuf, parallel_reduce_sum_real4 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real4,mpi_sum,comm,ierror) + parallel_reduce_sum_real4 = recvbuf + return + end function parallel_reduce_sum_real4 + + function parallel_reduce_sum_real8(x) + use mpi_mod + implicit none + real(8) :: x + integer :: ierror + real(8) :: recvbuf,sendbuf, parallel_reduce_sum_real8 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real8,mpi_sum,comm,ierror) + parallel_reduce_sum_real8 = recvbuf + return + end function parallel_reduce_sum_real8 + + function parallel_reduce_sum_real8_nvar(x) + use mpi_mod + implicit none + real(8) :: x(:) + integer :: ierror, nvar + real(8), dimension(size(x)) :: recvbuf,sendbuf, parallel_reduce_sum_real8_nvar + ! begin + nvar = size(x) + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,nvar,mpi_real8,mpi_sum,comm,ierror) + parallel_reduce_sum_real8_nvar = recvbuf + return + end function parallel_reduce_sum_real8_nvar + +! ------------------------------------------ +! functions for parallel_reduce_max interface +! ------------------------------------------ + function parallel_reduce_max_integer(x) + use mpi_mod + implicit none + integer :: x + + integer :: ierror + integer :: recvbuf,sendbuf, parallel_reduce_max_integer + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_integer,mpi_max,comm,ierror) + parallel_reduce_max_integer = recvbuf + return + end function parallel_reduce_max_integer + + function parallel_reduce_max_real4(x) + use mpi_mod + implicit none + real(4) :: x + + integer :: ierror + real(4) :: recvbuf,sendbuf, parallel_reduce_max_real4 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real4,mpi_max,comm,ierror) + parallel_reduce_max_real4 = recvbuf + return + end function parallel_reduce_max_real4 + + function parallel_reduce_max_real8(x) + use mpi_mod + implicit none + real(8) :: x + + integer :: ierror + real(8) :: recvbuf,sendbuf, parallel_reduce_max_real8 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real8,mpi_max,comm,ierror) + parallel_reduce_max_real8 = recvbuf + return + end function parallel_reduce_max_real8 + +! ------------------------------------------ +! routines for parallel_reduce_maxloc interface +! ------------------------------------------ + subroutine parallel_reduce_maxloc_integer(xin, xout, xprocout) + use mpi_mod + implicit none + integer, intent(in) :: xin ! variable to reduce + integer, intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + integer, dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2INTEGER,mpi_maxloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) + end subroutine parallel_reduce_maxloc_integer + + subroutine parallel_reduce_maxloc_real4(xin, xout, xprocout) + use mpi_mod + implicit none + real(4), intent(in) :: xin ! variable to reduce + real(4), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + real(4), dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x (coerced to a real) + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2REAL,mpi_maxloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) ! coerced back to integer + end subroutine parallel_reduce_maxloc_real4 + + subroutine parallel_reduce_maxloc_real8(xin, xout, xprocout) + use mpi_mod + implicit none + real(8), intent(in) :: xin ! variable to reduce + real(8), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + real(8), dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x (coerced to a real) + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2DOUBLE_PRECISION,mpi_maxloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) ! coerced back to integer + end subroutine parallel_reduce_maxloc_real8 + +! ------------------------------------------ +! functions for parallel_reduce_min interface +! ------------------------------------------ + function parallel_reduce_min_integer(x) + use mpi_mod + implicit none + integer :: x + + integer :: ierror + integer :: recvbuf,sendbuf, parallel_reduce_min_integer + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_integer,mpi_min,comm,ierror) + parallel_reduce_min_integer = recvbuf + return + end function parallel_reduce_min_integer + + function parallel_reduce_min_real4(x) + use mpi_mod + implicit none + real(4) :: x + + integer :: ierror + real(4) :: recvbuf,sendbuf, parallel_reduce_min_real4 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real4,mpi_min,comm,ierror) + parallel_reduce_min_real4 = recvbuf + return + end function parallel_reduce_min_real4 + + function parallel_reduce_min_real8(x) + use mpi_mod + implicit none + real(8) :: x + + integer :: ierror + real(8) :: recvbuf,sendbuf, parallel_reduce_min_real8 + ! begin + sendbuf = x + call mpi_allreduce(sendbuf,recvbuf,1,mpi_real8,mpi_min,comm,ierror) + parallel_reduce_min_real8 = recvbuf + return + end function parallel_reduce_min_real8 + +! ------------------------------------------ +! routines for parallel_reduce_minloc interface +! ------------------------------------------ + subroutine parallel_reduce_minloc_integer(xin, xout, xprocout) + use mpi_mod + implicit none + integer, intent(in) :: xin ! variable to reduce + integer, intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + integer, dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2INTEGER,mpi_minloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) + end subroutine parallel_reduce_minloc_integer + + subroutine parallel_reduce_minloc_real4(xin, xout, xprocout) + use mpi_mod + implicit none + real(4), intent(in) :: xin ! variable to reduce + real(4), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + real(4), dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x (coerced to a real) + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2REAL,mpi_minloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) ! coerced back to integer + end subroutine parallel_reduce_minloc_real4 + + subroutine parallel_reduce_minloc_real8(xin, xout, xprocout) + use mpi_mod + implicit none + real(8), intent(in) :: xin ! variable to reduce + real(8), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + integer :: ierror + real(8), dimension(2,1) :: recvbuf, sendbuf + ! begin + sendbuf(1,1) = xin + sendbuf(2,1) = this_rank ! This is the processor number associated with the value x (coerced to a real) + call mpi_allreduce(sendbuf,recvbuf,1,MPI_2DOUBLE_PRECISION,mpi_minloc,comm,ierror) + xout = recvbuf(1,1) + xprocout = recvbuf(2,1) ! coerced back to integer + end subroutine parallel_reduce_minloc_real8 + + + ! Andy removed support for returnownedvector in October 2011. + ! subroutine parallel_set_trilinos_return_vect + ! Trilinos can return the full solution to each node or just the owned portion + ! For parallel_mpi mode only the owned portion is expected + ! call returnownedvector() ! in trilinosLinearSolver.cpp + ! end subroutine parallel_set_trilinos_return_vect + + subroutine parallel_show_minmax(label,values) + use mpi_mod + implicit none + character(*) :: label + real(8),dimension(:,:,:) :: values + + integer :: ierror + real(8) :: allmin,allmax,mymin,mymax + ! begin + mymin = minval(values(:,1+lhalo:size(values,2)-uhalo,& + 1+lhalo:size(values,3)-uhalo)) + mymax = maxval(values(:,1+lhalo:size(values,2)-uhalo,& + 1+lhalo:size(values,3)-uhalo)) + call mpi_reduce(mymin,allmin,1,mpi_real8,mpi_min,main_rank,comm,ierror) + call mpi_reduce(mymax,allmax,1,mpi_real8,mpi_max,main_rank,comm,ierror) + if (main_task) print *,label,allmin,allmax + end subroutine parallel_show_minmax + + subroutine parallel_stop(file,line) + use mpi_mod + implicit none + integer :: line + character(len=*) :: file + integer :: ierror + ! begin + if (main_task) write(0,*) "PARALLEL STOP in ",file," at line ",line + call mpi_abort(MPI_COMM_WORLD, 1001, ierror) + stop "PARALLEL STOP" + end subroutine parallel_stop + + function parallel_sync(ncid) + implicit none + integer :: ncid,parallel_sync + ! begin + if (main_task) parallel_sync = nf90_sync(ncid) + call broadcast(parallel_sync) + end function parallel_sync + + !TODO - Remove subroutine parallel_velo_halo? + ! This subroutine is called only from periodic_boundaries subroutine, which is no longer used. + + subroutine parallel_velo_halo(a) + use mpi_mod + implicit none + real(8),dimension(:,:) :: a + + integer :: ierror,nrequest,erequest + real(8),dimension(size(a,2)-lhalo-uhalo+1) :: wsend,erecv + real(8),dimension(size(a,1)-lhalo) :: ssend,nrecv + + ! begin + if (size(a,1)/=local_ewn-1.or.size(a,2)/=local_nsn-1) & + call parallel_stop(__FILE__,__LINE__) + + if (uhalo==0) then + ! NOTE(wjs, 2014-10-16) I think that fixing this would involve replacing instances + ! of (-uhalo+1) with (-staggered_uhalo) + write(*,*) 'parallel_velo_halo currently does not work for uhalo=0' + call parallel_stop(__FILE__,__LINE__) + end if + + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,& + comm,erequest,ierror) + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,& + comm,nrequest,ierror) + + wsend(:) = a(1+lhalo,1+lhalo:size(a,2)-uhalo+1) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(size(a,1),1+lhalo:size(a,2)-uhalo+1) = erecv(:) + + ssend(:) = a(1+lhalo:,1+lhalo) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(1+lhalo:,size(a,2)) = nrecv(:) + + end subroutine parallel_velo_halo + + + subroutine staggered_parallel_halo_extrapolate_integer_2d(a) + + implicit none + integer,dimension(:,:) :: a + integer :: i, j + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Extrapolate the staggered field into halo cells along the global boundary. + ! Currently this is used only for kinbcmask. + ! Note: The extrapolation region includes locally owned cells along + ! the north and east boundaries of the global domain. + + ! First update the halos so that we are sure the interior halos are correct + call staggered_parallel_halo(a) + + ! MJH Note: Modified code to now copy entire east and west columns rather than + ! just the owned cells in those columns. This avoids having the halos have + ! potentially wrong information (i.e., a few cells in the corner don't get extrapolated into) + + if (this_rank >= east) then ! at east edge of global domain + ! extrapolate eastward + do i = size(a,1)-staggered_uhalo, size(a,1) + a(i, :) = a(size(a,1)-staggered_uhalo-1, :) + enddo + endif + + if (this_rank <= west) then ! at west edge of global domain + ! extrapolate westward + do i = 1, staggered_lhalo + a(i, :) = a(staggered_lhalo+1, :) + enddo + endif + + if (this_rank >= north) then ! at north edge of global domain + ! extrapolate northward + do j = size(a,2)-staggered_uhalo, size(a,2) + a(:, j) = a(:, size(a,2)-staggered_uhalo-1) + enddo + endif + + if (this_rank <= south) then ! at south edge of global domain + ! extrapolate southward + do j = 1, staggered_lhalo + a(:, j) = a(:, staggered_lhalo+1) + enddo + endif + + end subroutine staggered_parallel_halo_extrapolate_integer_2d + + + subroutine staggered_parallel_halo_extrapolate_real8_2d(a) + + implicit none + real(8),dimension(:,:) :: a + integer :: i, j + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Extrapolate the staggered field into halo cells along the global boundary. + ! Currently this is used only for kinbcmask. + ! Note: The extrapolation region includes locally owned cells along + ! the north and east boundaries of the global domain. + + ! First update the halos so that we are sure the interior halos are correct + call staggered_parallel_halo(a) + + ! MJH Note: Modified code to now copy entire east and west columns rather than + ! just the owned cells in those columns. This avoids having the halos have + ! potentially wrong information (i.e., a few cells in the corner don't get extrapolated into) + +! Useful for debugging small domains (the YYYY is just a tag for grepping the output, particularly if you prepend the processor number, e.g. "0YYYY") +! do j = 1, size(a,2) +! write(6, "(i3, 'YYYY BEFORE row ', i3, 1000e9.2)") this_rank, j, a(:,j) +! enddo + + if (this_rank >= east) then ! at east edge of global domain + ! extrapolate eastward + do i = size(a,1)-staggered_uhalo, size(a,1) + a(i, :) = a(size(a,1)-staggered_uhalo-1, :) + enddo + endif + + if (this_rank <= west) then ! at west edge of global domain + ! extrapolate westward + do i = 1, staggered_lhalo + a(i, :) = a(staggered_lhalo+1, :) + enddo + endif + + if (this_rank >= north) then ! at north edge of global domain + ! extrapolate northward + do j = size(a,2)-staggered_uhalo, size(a,2) + a(:, j) = a(:, size(a,2)-staggered_uhalo-1) + enddo + endif + + if (this_rank <= south) then ! at south edge of global domain + ! extrapolate southward + do j = 1, staggered_lhalo + a(:, j) = a(:, staggered_lhalo+1) + enddo + endif + +! Useful for debugging small domains +! do j = 1, size(a,2) +! write(6, "(i3, 'YYYY AFTER row ', i3, 1000e9.2)") this_rank, j, a(:,j) +! enddo + end subroutine staggered_parallel_halo_extrapolate_real8_2d + + + subroutine staggered_parallel_halo_integer_2d(a) + use mpi_mod + implicit none + integer,dimension(:,:) :: a + + ! Implements a staggered grid halo update. + ! As the grid is staggered, the array 'a' is one smaller in both dimensions than an unstaggered array. + + ! The grid is laid out from the SW, and the lower left corner is assigned to this_rank = 0. + ! It's eastern nbhr is task_id = 1, proceeding rowwise and starting from the western edge. + ! The South-most processes own one additional row of stagggered variables on the southern edge + ! and have one less 'southern' halo row than other processes. Likewise, the West-most processes own one + ! additional column of staggered variables on the western edge and have one less 'western' halo column. + ! This is implemented by a modification to the staggered_lhalo value on these processes. + + !WHL - I don't think we need to say that the South-most processes "own" an additional row of + ! staggered variables on the southern edge. I think we can treat the southern edge as a halo row + ! and still enforce the various global BC we want. + + ! Maintaining global boundary conditions are not addressed within this routine (yet). + + ! integer :: erequest,ierror,one,nrequest,srequest,wrequest + integer :: ierror,nrequest,srequest,erequest,wrequest + + integer,dimension(staggered_lhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: esend,wrecv + integer,dimension(staggered_uhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: erecv,wsend + integer,dimension(size(a,1),staggered_lhalo) :: nsend,srecv + integer,dimension(size(a,1),staggered_uhalo) :: nrecv,ssend + + !WHL - I defined a logical variable to determine whether or not to fill halo cells + ! at the edge of the global domain. I am setting it to true by default to support + ! cyclic global BCs. + !TODO: Assume fill_global_halos is true in all cases? (Here and below) + + logical :: fill_global_halos = .true. + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Prepost expected receives + + if (this_rank < east .or. fill_global_halos) then + call mpi_irecv(erecv,size(erecv),mpi_integer,east,east,comm,erequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_irecv(wrecv,size(wrecv),mpi_integer,west,west,comm,wrequest,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_irecv(nrecv,size(nrecv),mpi_integer,north,north,comm,nrequest,ierror) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_irecv(srecv,size(srecv),mpi_integer,south,south,comm,srequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then +! wsend(:,1:size(a,2)-staggered_shalo-staggered_nhalo) = & +! a(1+staggered_whalo:1+staggered_whalo+staggered_ehalo-1, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) + wsend(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + call mpi_send(wsend,size(wsend),mpi_integer,west,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then +! esend(:,1:size(a,2)-staggered_shalo-staggered_nhalo) = & +! a(size(a,1)-staggered_ehalo-staggered_whalo+1:size(a,1)-staggered_ehalo, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) + esend(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(size(a,1)-staggered_uhalo-staggered_lhalo+1:size(a,1)-staggered_uhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + call mpi_send(esend,size(esend),mpi_integer,east,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + call mpi_wait(erequest,mpi_status_ignore,ierror) +! a(size(a,1)-staggered_ehalo+1:size(a,1), & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) = & +! erecv(:,1:size(a,2)-staggered_shalo-staggered_nhalo) + a(size(a,1)-staggered_uhalo+1:size(a,1), & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + erecv(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_wait(wrequest,mpi_status_ignore,ierror) +! a(1:staggered_whalo, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) = & +! wrecv(:,1:size(a,2)-staggered_shalo-staggered_nhalo) + a(1:staggered_lhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + wrecv(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > south .or. fill_global_halos) then + ssend(:,:) = & +! a(:,1+staggered_shalo:1+staggered_shalo+staggered_nhalo-1) + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + call mpi_send(ssend,size(ssend),mpi_integer,south,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + nsend(:,:) = & +! a(:,size(a,2)-staggered_nhalo-staggered_shalo+1:size(a,2)-staggered_nhalo) + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo) + call mpi_send(nsend,size(nsend),mpi_integer,north,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_wait(nrequest,mpi_status_ignore,ierror) +! a(:,size(a,2)-staggered_nhalo+1:size(a,2)) = nrecv(:,:) + a(:,size(a,2)-staggered_uhalo+1:size(a,2)) = nrecv(:,:) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_wait(srequest,mpi_status_ignore,ierror) +! a(:,1:staggered_shalo) = srecv(:,:) + a(:,1:staggered_lhalo) = srecv(:,:) + endif + + end subroutine staggered_parallel_halo_integer_2d + + + subroutine staggered_parallel_halo_integer_3d(a) + use mpi_mod + implicit none + integer,dimension(:,:,:) :: a + + ! Implements a staggered grid halo update for a 3D field. + ! As the grid is staggered, the array 'a' is one smaller in both dimensions than an unstaggered array. + ! The vertical dimension is assumed to be the first index, i.e., a(k,i,j). + + ! The grid is laid out from the SW, and the lower left corner is assigned to this_rank = 0. + ! It's eastern nbhr is task_id = 1, proceeding rowwise and starting from the western edge. + ! The South-most processes own one additional row of stagggered variables on the southern edge + ! and have one less 'southern' halo row than other processes. Likewise, the West-most processes own one + ! additional column of staggered variables on the western edge and have one less 'western' halo column. + ! This is implemented by a modification to the staggered_lhalo value on these processes. + + ! Maintaining global boundary conditions are not addressed within this routine (yet). + + ! integer :: erequest,ierror,one,nrequest,srequest,wrequest + integer :: ierror,nrequest,srequest,erequest,wrequest + + integer,dimension(size(a,1),staggered_lhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: esend,wrecv + integer,dimension(size(a,1),staggered_uhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: erecv,wsend + integer,dimension(size(a,1),size(a,2),staggered_lhalo) :: nsend,srecv + integer,dimension(size(a,1),size(a,2),staggered_uhalo) :: nrecv,ssend + + !WHL - I defined a logical variable to determine whether or not to fill halo cells + ! at the edge of the global domain. I am setting it to true by default to support + ! cyclic global BCs. + + logical :: fill_global_halos = .true. + + ! begin + + ! Confirm staggered array + if (size(a,2)/=local_ewn-1.or.size(a,3)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Prepost expected receives + + if (this_rank < east .or. fill_global_halos) then + call mpi_irecv(erecv,size(erecv),mpi_integer,east,east,comm,erequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_irecv(wrecv,size(wrecv),mpi_integer,west,west,comm,wrequest,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_irecv(nrecv,size(nrecv),mpi_integer,north,north,comm,nrequest,ierror) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_irecv(srecv,size(srecv),mpi_integer,south,south,comm,srequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + wsend(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + call mpi_send(wsend,size(wsend),mpi_integer,west,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + esend(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + call mpi_send(esend,size(esend),mpi_integer,east,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(:,size(a,2)-staggered_uhalo+1:size(a,2), & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + erecv(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:,1:staggered_lhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + wrecv(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > south .or. fill_global_halos) then + ssend(:,:,:) = & + a(:,:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + call mpi_send(ssend,size(ssend),mpi_integer,south,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + nsend(:,:,:) = & + a(:,:,size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo) + call mpi_send(nsend,size(nsend),mpi_integer,north,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,:,size(a,3)-staggered_uhalo+1:size(a,3)) = nrecv(:,:,:) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:,1:staggered_lhalo) = srecv(:,:,:) + endif + + end subroutine staggered_parallel_halo_integer_3d + + + !WHL - Edited the original subroutine so that values from N and E edges + ! of global domain can be written to halo cells at the S and W edges, + ! to allow cyclic BCs for staggered variables + + subroutine staggered_parallel_halo_real8_2d(a) + + use mpi_mod + implicit none + real(8),dimension(:,:) :: a + + ! Implements a staggered grid halo update. + ! As the grid is staggered, the array 'a' is one smaller in both dimensions than an unstaggered array. + + ! The grid is laid out from the SW, and the lower left corner is assigned to this_rank = 0. + ! It's eastern nbhr is task_id = 1, proceeding rowwise and starting from the western edge. + ! The South-most processes own one additional row of stagggered variables on the southern edge + ! and have one less 'southern' halo row than other processes. Likewise, the West-most processes own one + ! additional column of staggered variables on the western edge and have one less 'western' halo column. + ! This is implemented by a modification to the staggered_lhalo value on these processes. + + ! Maintaining global boundary conditions are not addressed within this routine (yet). + + ! integer :: erequest,ierror,one,nrequest,srequest,wrequest + integer :: ierror,nrequest,srequest,erequest,wrequest +! real(8),dimension(staggered_whalo,size(a,2)-staggered_shalo-staggered_nhalo) :: esend,wrecv +! real(8),dimension(staggered_ehalo,size(a,2)-staggered_shalo-staggered_nhalo) :: erecv,wsend +! real(8),dimension(size(a,1),staggered_shalo) :: nsend,srecv +! real(8),dimension(size(a,1),staggered_nhalo) :: nrecv,ssend + real(8),dimension(staggered_lhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: esend,wrecv + real(8),dimension(staggered_uhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: erecv,wsend + real(8),dimension(size(a,1),staggered_lhalo) :: nsend,srecv + real(8),dimension(size(a,1),staggered_uhalo) :: nrecv,ssend + + !WHL - I defined a logical variable to determine whether or not to fill halo cells + ! at the edge of the global domain. I am setting it to true by default to support + ! cyclic global BCs. + + logical :: fill_global_halos = .true. + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Prepost expected receives + + if (this_rank < east .or. fill_global_halos) then + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,comm,erequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,comm,wrequest,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,comm,nrequest,ierror) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,comm,srequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then +! wsend(:,1:size(a,2)-staggered_shalo-staggered_nhalo) = & +! a(1+staggered_whalo:1+staggered_whalo+staggered_ehalo-1, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) + wsend(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then +! esend(:,1:size(a,2)-staggered_shalo-staggered_nhalo) = & +! a(size(a,1)-staggered_ehalo-staggered_whalo+1:size(a,1)-staggered_ehalo, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) + esend(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(size(a,1)-staggered_uhalo-staggered_lhalo+1:size(a,1)-staggered_uhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + call mpi_wait(erequest,mpi_status_ignore,ierror) +! a(size(a,1)-staggered_ehalo+1:size(a,1), & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) = & +! erecv(:,1:size(a,2)-staggered_shalo-staggered_nhalo) + a(size(a,1)-staggered_uhalo+1:size(a,1), & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + erecv(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_wait(wrequest,mpi_status_ignore,ierror) +! a(1:staggered_whalo, & +! 1+staggered_shalo:size(a,2)-staggered_nhalo) = & +! wrecv(:,1:size(a,2)-staggered_shalo-staggered_nhalo) + a(1:staggered_lhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + wrecv(:,1:size(a,2)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > south .or. fill_global_halos) then + ssend(:,:) = & +! a(:,1+staggered_shalo:1+staggered_shalo+staggered_nhalo-1) + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + nsend(:,:) = & +! a(:,size(a,2)-staggered_nhalo-staggered_shalo+1:size(a,2)-staggered_nhalo) + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_wait(nrequest,mpi_status_ignore,ierror) +! a(:,size(a,2)-staggered_nhalo+1:size(a,2)) = nrecv(:,:) + a(:,size(a,2)-staggered_uhalo+1:size(a,2)) = nrecv(:,:) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_wait(srequest,mpi_status_ignore,ierror) +! a(:,1:staggered_shalo) = srecv(:,:) + a(:,1:staggered_lhalo) = srecv(:,:) + endif + + end subroutine staggered_parallel_halo_real8_2d + + !WHL - Edited the original subroutine so that values from N and E edges + ! of global domain can be written to halo cells at the S and W edges, + ! to allow cyclic BCs for staggered variables + + subroutine staggered_parallel_halo_real8_3d(a) + + use mpi_mod + implicit none + real(8),dimension(:,:,:) :: a + + ! Implements a staggered grid halo update for a 3D field. + ! As the grid is staggered, the array 'a' is one smaller in both dimensions than an unstaggered array. + ! The vertical dimension is assumed to be the first index, i.e., a(k,i,j). + + ! The grid is laid out from the SW, and the lower left corner is assigned to this_rank = 0. + ! It's eastern nbhr is task_id = 1, proceeding rowwise and starting from the western edge. + ! The South-most processes own one additional row of stagggered variables on the southern edge + ! and have one less 'southern' halo row than other processes. Likewise, the West-most processes own one + ! additional column of staggered variables on the western edge and have one less 'western' halo column. + ! This is implemented by a modification to the staggered_lhalo value on these processes. + + ! Maintaining global boundary conditions are not addressed within this routine (yet). + + ! integer :: erequest,ierror,one,nrequest,srequest,wrequest + integer :: ierror,nrequest,srequest,erequest,wrequest + +! real(8),dimension(size(a,1),staggered_whalo,size(a,3)-staggered_shalo-staggered_nhalo) :: esend,wrecv +! real(8),dimension(size(a,1),staggered_ehalo,size(a,3)-staggered_shalo-staggered_nhalo) :: erecv,wsend +! real(8),dimension(size(a,1),size(a,2),staggered_shalo) :: nsend,srecv +! real(8),dimension(size(a,1),size(a,2),staggered_nhalo) :: nrecv,ssend + real(8),dimension(size(a,1),staggered_lhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: esend,wrecv + real(8),dimension(size(a,1),staggered_uhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: erecv,wsend + real(8),dimension(size(a,1),size(a,2),staggered_lhalo) :: nsend,srecv + real(8),dimension(size(a,1),size(a,2),staggered_uhalo) :: nrecv,ssend + + !WHL - I defined a logical variable to determine whether or not to fill halo cells + ! at the edge of the global domain. I am setting it to true by default to support + ! cyclic global BCs. + + logical :: fill_global_halos = .true. + + ! begin + + ! Confirm staggered array + if (size(a,2)/=local_ewn-1 .or. size(a,3)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Prepost expected receives + + if (this_rank < east .or. fill_global_halos) then + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,comm,erequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,comm,wrequest,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,comm,nrequest,ierror) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,comm,srequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then +! wsend(:,:,1:size(a,3)-staggered_shalo-staggered_nhalo) = & +! a(:,1+staggered_whalo:1+staggered_whalo+staggered_ehalo-1, & +! 1+staggered_shalo:size(a,3)-staggered_nhalo) + wsend(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then +! esend(:,:,1:size(a,3)-staggered_shalo-staggered_nhalo) = & +! a(:,size(a,2)-staggered_ehalo-staggered_whalo+1:size(a,2)-staggered_ehalo, & +! 1+staggered_shalo:size(a,3)-staggered_nhalo) + esend(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + call mpi_wait(erequest,mpi_status_ignore,ierror) +! a(:,size(a,2)-staggered_ehalo+1:size(a,2), & +! 1+staggered_shalo:size(a,3)-staggered_nhalo) = & +! erecv(:,:,1:size(a,3)-staggered_shalo-staggered_nhalo) + a(:,size(a,2)-staggered_uhalo+1:size(a,2), & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + erecv(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_wait(wrequest,mpi_status_ignore,ierror) +! a(:,1:staggered_whalo, & +! 1+staggered_shalo:size(a,3)-staggered_nhalo) = & +! wrecv(:,:,1:size(a,3)-staggered_shalo-staggered_nhalo) + a(:,1:staggered_lhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + wrecv(:,:,1:size(a,3)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > south .or. fill_global_halos) then +! ssend(:,:,:) = & +! a(:,:,1+staggered_shalo:1+staggered_shalo+staggered_nhalo-1) + ssend(:,:,:) = & + a(:,:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + nsend(:,:,:) = & +! a(:,:,size(a,3)-staggered_nhalo-staggered_shalo+1:size(a,3)-staggered_nhalo) + a(:,:,size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_wait(nrequest,mpi_status_ignore,ierror) +! a(:,:,size(a,3)-staggered_nhalo+1:size(a,3)) = nrecv(:,:,:) + a(:,:,size(a,3)-staggered_uhalo+1:size(a,3)) = nrecv(:,:,:) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_wait(srequest,mpi_status_ignore,ierror) +! a(:,:,1:staggered_shalo) = srecv(:,:,:) + a(:,:,1:staggered_lhalo) = srecv(:,:,:) + endif + + end subroutine staggered_parallel_halo_real8_3d + +!WHL - New subroutine for 4D arrays. + subroutine staggered_parallel_halo_real8_4d(a) + + use mpi_mod + implicit none + real(8),dimension(:,:,:,:) :: a + + ! Implements a staggered grid halo update for a 4D field. + ! This subroutine is used for the 4D arrays that hold matrix entries. + + ! As the grid is staggered, the array 'a' is one smaller in x and y dimensions than an unstaggered array. + ! The vertical dimension is assumed to precede the i and j indices, i.e., a(:,k,i,j). + ! The first dimension holds matrix elements for a single row. + + ! The grid is laid out from the SW, and the lower left corner is assigned to this_rank = 0. + ! It's eastern neighbor is task_id = 1, proceeding rowwise and starting from the western edge. + ! The South-most processes own one additional row of stagggered variables on the southern edge + ! and have one less 'southern' halo row than other processes. Likewise, the West-most processes own one + ! additional column of staggered variables on the western edge and have one less 'western' halo column. + ! This is implemented by a modification to the staggered_lhalo value on these processes. + + ! Maintaining global boundary conditions are not addressed within this routine (yet). + + ! integer :: erequest,ierror,one,nrequest,srequest,wrequest + integer :: ierror,nrequest,srequest,erequest,wrequest + + real(8),dimension(size(a,1),size(a,2), & + staggered_lhalo,size(a,4)-staggered_lhalo-staggered_uhalo) :: esend,wrecv + real(8),dimension(size(a,1),size(a,2), & + staggered_uhalo,size(a,4)-staggered_lhalo-staggered_uhalo) :: erecv,wsend + real(8),dimension(size(a,1),size(a,2),size(a,3),staggered_lhalo) :: nsend,srecv + real(8),dimension(size(a,1),size(a,2),size(a,3),staggered_uhalo) :: nrecv,ssend + + !WHL - I defined a logical variable to determine whether or not to fill halo cells + ! at the edge of the global domain. I am setting it to true by default to support + ! cyclic global BCs. + + logical :: fill_global_halos = .true. + + ! begin + + ! Confirm staggered array + if (size(a,3)/=local_ewn-1 .or. size(a,4)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Prepost expected receives + + if (this_rank < east .or. fill_global_halos) then + call mpi_irecv(erecv,size(erecv),mpi_real8,east,east,comm,erequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_irecv(wrecv,size(wrecv),mpi_real8,west,west,comm,wrequest,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_irecv(nrecv,size(nrecv),mpi_real8,north,north,comm,nrequest,ierror) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_irecv(srecv,size(srecv),mpi_real8,south,south,comm,srequest,ierror) + endif + + if (this_rank > west .or. fill_global_halos) then + wsend(:,:,:,1:size(a,4)-staggered_lhalo-staggered_uhalo) = & + a(:,:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) + call mpi_send(wsend,size(wsend),mpi_real8,west,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + esend(:,:,:,1:size(a,4)-staggered_lhalo-staggered_uhalo) = & + a(:,:,size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo, & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) + call mpi_send(esend,size(esend),mpi_real8,east,this_rank,comm,ierror) + endif + + if (this_rank < east .or. fill_global_halos) then + call mpi_wait(erequest,mpi_status_ignore,ierror) + a(:,:,size(a,3)-staggered_uhalo+1:size(a,3), & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) = & + erecv(:,:,:,1:size(a,4)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > west .or. fill_global_halos) then + call mpi_wait(wrequest,mpi_status_ignore,ierror) + a(:,:,1:staggered_lhalo, & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) = & + wrecv(:,:,:,1:size(a,4)-staggered_lhalo-staggered_uhalo) + endif + + if (this_rank > south .or. fill_global_halos) then + ssend(:,:,:,:) = & + a(:,:,:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + call mpi_send(ssend,size(ssend),mpi_real8,south,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + nsend(:,:,:,:) = & + a(:,:,:,size(a,4)-staggered_uhalo-staggered_lhalo+1:size(a,4)-staggered_uhalo) + call mpi_send(nsend,size(nsend),mpi_real8,north,this_rank,comm,ierror) + endif + + if (this_rank < north .or. fill_global_halos) then + call mpi_wait(nrequest,mpi_status_ignore,ierror) + a(:,:,:,size(a,4)-staggered_uhalo+1:size(a,4)) = nrecv(:,:,:,:) + endif + + if (this_rank > south .or. fill_global_halos) then + call mpi_wait(srequest,mpi_status_ignore,ierror) + a(:,:,:,1:staggered_lhalo) = srecv(:,:,:,:) + endif + + end subroutine staggered_parallel_halo_real8_4d + +! Following routines imported from the Community Earth System Model +! (models/utils/mct/mpeu.m_FcComms.F90) +!BOP ------------------------------------------------------------------- +! +! !IROUTINE: fc_gather_int - Gather an array of type integer +! +! !DESCRIPTION: +! This routine gathers a {\em distributed} array of type {\em integer} +! to the {\tt root} process. Explicit handshaking messages are used +! to control the number of processes communicating with the root +! at any one time. +! +! If flow_cntl optional parameter +! < 0 : use MPI_Gather +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! max(min(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is max_gather_block_size. +! !INTERFACE: +! + subroutine fc_gather_int (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnt, recvtype, & + root, comm, flow_cntl ) +! +! !USES: +! + use mpi_mod + +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, intent(in) :: recvcnt + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + +! !OUTPUT PARAMETERS: +! + integer, intent(out) :: recvbuf(*) + +!EOP ___________________________________________________________________ + + integer :: signal + logical :: fc_gather ! use explicit flow control? + integer :: gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, i, count, displs + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer :: ier ! MPI error code + + signal = 1 + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + gather_block_size = max(1,max_gather_block_size) + fc_gather = .true. + endif + + if (fc_gather) then + + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + + ! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + if (recvcnt > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + displs = p*recvcnt + call mpi_irecv ( recvbuf(displs+1), recvcnt, & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier ) + end if + end if + end do + + ! copy local data + displs = mytid*recvcnt + do i=1,sendcnt + recvbuf(displs+i) = sendbuf(i) + enddo + + ! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, sendtype, root, mtag, comm, & + status, ier ) + call mpi_send ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + + else + + call mpi_gather (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnt, recvtype, & + root, comm, ier) + endif + + return + end subroutine fc_gather_int + +!BOP ------------------------------------------------------------------- +! +! !IROUTINE: fc_gatherv_int - Gather an array of type integer +! +! !DESCRIPTION: +! This routine gathers a {\em distributed} array of type {\em integer} +! to the {\tt root} process. Explicit handshaking messages are uesd +! to control the number of processes communicating with the root +! at any one time. +! +! If flow_cntl optional parameter +! < 0 : use MPI_Gatherv +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! max(min(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is max_gather_block_size. +! !INTERFACE: +! + subroutine fc_gatherv_int (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! !USES: +! + use mpi_mod + +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, dimension(:), intent(in) :: recvcnts + integer, dimension(:), intent(in) :: displs + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + +! !OUTPUT PARAMETERS: +! + integer, intent(out) :: recvbuf(*) + +!EOP ___________________________________________________________________ + + integer :: signal + logical :: fc_gather ! use explicit flow control? + integer :: gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer :: ier ! MPI error code + + signal = 1 + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + gather_block_size = max(1,max_gather_block_size) + fc_gather = .true. + endif + + if (fc_gather) then + + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + + ! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier ) + end if + end if + end do + + ! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + + ! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, sendtype, root, mtag, comm, & + status, ier ) + call mpi_send ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + + else + + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + + endif + + return + + end subroutine fc_gatherv_int + +!BOP ------------------------------------------------------------------- +! +! !IROUTINE: fc_gatherv_real4 - Gather an array of type real*4 +! +! !DESCRIPTION: +! This routine gathers a {\em distributed} array of type {\em real*4} to +! the {\tt root} process. Explicit handshaking messages are uesd +! to control the number of processes communicating with the root +! at any one time. +! +! If flow_cntl optional parameter +! < 0 : use MPI_Gatherv +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! max(min(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is max_gather_block_size. +! !INTERFACE: +! + subroutine fc_gatherv_real4 (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! !USES: +! + use mpi_mod + +! +! !INPUT PARAMETERS: +! + real(4), intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, dimension(:), intent(in) :: recvcnts + integer, dimension(:), intent(in) :: displs + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + +! !OUTPUT PARAMETERS: +! + real(4), intent(out) :: recvbuf(*) + +!EOP ___________________________________________________________________ + + real(4) :: signal + logical :: fc_gather ! use explicit flow control? + integer :: gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer :: ier ! MPI error code + + signal = 1.0 + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + gather_block_size = max(1,max_gather_block_size) + fc_gather = .true. + endif + + if (fc_gather) then + + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + + ! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier ) + end if + end if + end do + + ! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + + ! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, sendtype, root, mtag, comm, & + status, ier ) + call mpi_send ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + + else + + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + + endif + + return + + end subroutine fc_gatherv_real4 + +!BOP ------------------------------------------------------------------- +! +! !IROUTINE: fc_gatherv_real8 - Gather an array of type real*4 +! +! !DESCRIPTION: +! This routine gathers a {\em distributed} array of type {\em real*8} to +! the {\tt root} process. Explicit handshaking messages are uesd +! to control the number of processes communicating with the root +! at any one time. +! +! If flow_cntl optional parameter +! < 0 : use MPI_Gatherv +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! max(min(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is max_gather_block_size. +! !INTERFACE: +! + subroutine fc_gatherv_real8 (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! !USES: +! + use mpi_mod + +! +! !INPUT PARAMETERS: +! + real(8), intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, dimension(:), intent(in) :: recvcnts + integer, dimension(:), intent(in) :: displs + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + +! !OUTPUT PARAMETERS: +! + real(8), intent(out) :: recvbuf(*) + +!EOP ___________________________________________________________________ + + real(8) :: signal + logical :: fc_gather ! use explicit flow control? + integer :: gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer :: ier ! MPI error code + + signal = 1.0 + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + gather_block_size = max(1,max_gather_block_size) + fc_gather = .true. + endif + + if (fc_gather) then + + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + + ! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier ) + end if + end if + end do + + ! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + + ! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, sendtype, root, mtag, comm, & + status, ier ) + call mpi_send ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + + else + + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + + endif + + return + + end subroutine fc_gatherv_real8 + +!BOP ------------------------------------------------------------------- +! +! !IROUTINE: fc_gatherv_log - Gather an array of type logical +! +! !DESCRIPTION: +! This routine gathers a {\em distributed} array of type {\em logical} +! to the {\tt root} process. Explicit handshaking messages are uesd +! to control the number of processes communicating with the root +! at any one time. +! +! If flow_cntl optional parameter +! < 0 : use MPI_Gatherv +! >= 0: use point-to-point with handshaking messages and +! preposting receive requests up to +! max(min(1,flow_cntl),max_gather_block_size) +! ahead if optional flow_cntl parameter is present. +! Otherwise, fc_gather_flow_cntl is used in its place. +! Default value is max_gather_block_size. +! !INTERFACE: +! + subroutine fc_gatherv_log (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, flow_cntl ) +! +! !USES: +! + use mpi_mod + +! +! !INPUT PARAMETERS: +! + logical, intent(in) :: sendbuf(*) + integer, intent(in) :: sendcnt + integer, intent(in) :: sendtype + integer, dimension(:), intent(in) :: recvcnts + integer, dimension(:), intent(in) :: displs + integer, intent(in) :: recvtype + integer, intent(in) :: root + integer, intent(in) :: comm + integer, optional, intent(in) :: flow_cntl + +! !OUTPUT PARAMETERS: +! + logical, intent(out) :: recvbuf(*) + +!EOP ___________________________________________________________________ + + logical :: signal + logical :: fc_gather ! use explicit flow control? + integer :: gather_block_size ! number of preposted receive requests + + integer :: mytid, mysize, mtag, p, q, i, count + integer :: preposts, head, tail + integer :: rcvid(max_gather_block_size) + integer :: status(MPI_STATUS_SIZE) + integer :: ier ! MPI error code + + signal = .true. + if ( present(flow_cntl) ) then + if (flow_cntl >= 0) then + gather_block_size = min(max(1,flow_cntl),max_gather_block_size) + fc_gather = .true. + else + fc_gather = .false. + endif + else + gather_block_size = max(1,max_gather_block_size) + fc_gather = .true. + endif + + if (fc_gather) then + + call mpi_comm_rank (comm, mytid, ier) + call mpi_comm_size (comm, mysize, ier) + mtag = 0 + if (root .eq. mytid) then + + ! prepost gather_block_size irecvs, and start receiving data + preposts = min(mysize-1, gather_block_size) + head = 0 + count = 0 + do p=0, mysize-1 + if (p .ne. root) then + q = p+1 + if (recvcnts(q) > 0) then + count = count + 1 + if (count > preposts) then + tail = mod(head,preposts) + 1 + call mpi_wait (rcvid(tail), status, ier) + end if + head = mod(head,preposts) + 1 + call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), & + recvtype, p, mtag, comm, rcvid(head), & + ier ) + call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier ) + end if + end if + end do + + ! copy local data + q = mytid+1 + do i=1,sendcnt + recvbuf(displs(q)+i) = sendbuf(i) + enddo + + ! wait for final data + do i=1,min(count,preposts) + call mpi_wait (rcvid(i), status, ier) + enddo + + else + + if (sendcnt > 0) then + call mpi_recv ( signal, 1, sendtype, root, mtag, comm, & + status, ier ) + call mpi_send ( sendbuf, sendcnt, sendtype, root, mtag, & + comm, ier ) + end if + + endif + + else + + call mpi_gatherv (sendbuf, sendcnt, sendtype, & + recvbuf, recvcnts, displs, recvtype, & + root, comm, ier) + + endif + + return + + end subroutine fc_gatherv_log + +end module parallel diff --git a/components/cism/glimmer-cism/libglimmer/parallel_slap.F90 b/components/cism/glimmer-cism/libglimmer/parallel_slap.F90 new file mode 100644 index 0000000000..445700fb31 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/parallel_slap.F90 @@ -0,0 +1,2699 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! parallel_slap.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module parallel + + use netcdf + implicit none + + !NOTE: The glam/glissade dycore currently requires nhalo = 2, + ! whereas the glide dycore requires nhalo = 0. + ! For glide simulations, we set nhalo = 0 by calling distributed_grid + ! with optional argument nhalo = 0. + + integer, save :: nhalo = 2 + + !TODO - Define lhalo and uhalo in terms of nhalo. + + integer, save :: lhalo = 2 + integer, save :: uhalo = 2 + + integer, save :: staggered_lhalo = 2 + integer, save :: staggered_uhalo = 1 + +#ifdef _USE_MPI_WITH_SLAP + logical,save :: main_task + integer,save :: this_rank + integer,save :: tasks + integer,save :: comm +#else + logical,parameter :: main_task = .true. + integer,parameter :: this_rank = 0 + integer,parameter :: tasks = 1 +#endif + + ! distributed grid + integer,save :: global_ewn,global_nsn,local_ewn,local_nsn,own_ewn,own_nsn + integer,save :: global_col_offset, global_row_offset + + integer,save :: ewlb,ewub,nslb,nsub + integer,save :: east,north,south,west + + ! global boundary conditions + logical,save :: periodic_bc ! doubly periodic + logical,save :: outflow_bc ! if true, set scalars in global halo to zero + ! does not apply to staggered variables (e.g., uvel, vvel) + + ! global IDs + integer,parameter :: ProcsEW = 1 + + !TODO - Remove these gathered_* declarations. No longer used. + + ! JEFF Declarations for undistributed variables on main_task. + ! Later move to separate module? These are only temporary until code is completely distributed. + real(8),dimension(:,:,:),allocatable :: gathered_efvs ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_efvs2 ! Variable for testing that scatter/gather are inverses + real(8),dimension(:,:,:),allocatable :: gathered_uvel ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_vvel ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:),allocatable :: gathered_uflx ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:),allocatable :: gathered_vflx ! Output var from glam_velo_fordsiapstr(), used often + real(8),dimension(:,:,:),allocatable :: gathered_velnorm ! Variable calculated in run_ho_diagnostic(), is this used? + real(8),dimension(:,:),allocatable :: gathered_thck ! Used in horizontal_remap_in() + real(8),dimension(:,:),allocatable :: gathered_stagthck ! Used in horizontal_remap_in() + real(4),dimension(:,:),allocatable :: gathered_acab ! Used in horizontal_remap_in() + real(8),dimension(:,:,:),allocatable :: gathered_temp ! Used in horizontal_remap_in() + real(8),dimension(:,:),allocatable :: gathered_dusrfdew ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dusrfdns ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dthckdew ! Used in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_dthckdns ! Used in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxx ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauyy ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxy ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauscalar ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauxz ! Calculated in glide_stress() + real(8),dimension(:,:,:),allocatable :: gathered_tauyz ! Calculated in glide_stress() + real(8),dimension(:,:),allocatable :: gathered_topg ! Bedrock topology, Used in glide_set_mask() + integer,dimension(:,:),allocatable :: gathered_thkmask ! Calculated in glide_set_mask() + real(8),dimension(:,:),allocatable :: gathered_marine_bc_normal ! Calculated in glide_marine_margin_normal() + real(8),dimension(:,:,:),allocatable :: gathered_surfvel ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_gline_flux ! Calculated in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_ubas ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_vbas ! Used in calc_gline_flux() + real(8),dimension(:,:),allocatable :: gathered_relx ! Used in glide_marinlim() + real(8),dimension(:,:,:),allocatable :: gathered_flwa ! Used in glide_marinlim() + real(4),dimension(:,:),allocatable :: gathered_calving ! Used in glide_marinlim() + real(4),dimension(:,:),allocatable :: gathered_backstress ! Used in glide_marinlim() + real(8),dimension(:,:),allocatable :: gathered_usrf ! Used in glide_marinlim() + logical,dimension(:,:),allocatable :: gathered_backstressmap ! Used in glide_marinlim() + real(8),dimension(:,:),allocatable :: gathered_tau_x ! Calculated in calc_basal_shear() + real(8),dimension(:,:),allocatable :: gathered_tau_y ! Calculated in calc_basal_shear() + real(8),dimension(:,:),allocatable :: gathered_lsrf ! Used in glide_marinlim() + + interface broadcast + module procedure broadcast_character + module procedure broadcast_integer + module procedure broadcast_integer_1d + module procedure broadcast_logical + module procedure broadcast_real4 + module procedure broadcast_real4_1d + module procedure broadcast_real8 + module procedure broadcast_real8_1d + end interface + + interface distributed_gather_var + module procedure distributed_gather_var_integer_2d + module procedure distributed_gather_var_logical_2d + module procedure distributed_gather_var_real4_2d + module procedure distributed_gather_var_real4_3d + module procedure distributed_gather_var_real8_2d + module procedure distributed_gather_var_real8_3d + end interface + + interface distributed_get_var + module procedure distributed_get_var_integer_2d + module procedure distributed_get_var_real4_1d + module procedure distributed_get_var_real4_2d + module procedure distributed_get_var_real8_1d + module procedure distributed_get_var_real8_2d + module procedure distributed_get_var_real8_3d + end interface + + interface distributed_print + ! Gathers a distributed variable and writes to file + module procedure distributed_print_integer_2d + module procedure distributed_print_real8_2d + module procedure distributed_print_real8_3d + end interface + + interface distributed_put_var + module procedure distributed_put_var_integer_2d + module procedure distributed_put_var_real4_1d + module procedure distributed_put_var_real4_2d + module procedure distributed_put_var_real8_1d + module procedure distributed_put_var_real8_2d + module procedure distributed_put_var_real8_3d + + !TODO - Should the parallel_put_var routines be part of this interface? + module procedure parallel_put_var_real4 + module procedure parallel_put_var_real8 + end interface + + interface parallel_convert_haloed_to_nonhaloed + module procedure parallel_convert_haloed_to_nonhaloed_real4_2d + module procedure parallel_convert_haloed_to_nonhaloed_real8_2d + end interface parallel_convert_haloed_to_nonhaloed + + interface parallel_convert_nonhaloed_to_haloed + module procedure parallel_convert_nonhaloed_to_haloed_real4_2d + module procedure parallel_convert_nonhaloed_to_haloed_real8_2d + end interface parallel_convert_nonhaloed_to_haloed + + interface parallel_def_var + module procedure parallel_def_var_dimids + module procedure parallel_def_var_nodimids + end interface + + interface parallel_get_att + module procedure parallel_get_att_character + module procedure parallel_get_att_real4 + module procedure parallel_get_att_real4_1d + module procedure parallel_get_att_real8 + module procedure parallel_get_att_real8_1d + end interface + + interface distributed_scatter_var + module procedure distributed_scatter_var_integer_2d + module procedure distributed_scatter_var_logical_2d + module procedure distributed_scatter_var_real4_2d + module procedure distributed_scatter_var_real4_3d + module procedure distributed_scatter_var_real8_2d + module procedure distributed_scatter_var_real8_3d + end interface + + interface global_sum + module procedure global_sum_real8_scalar + module procedure global_sum_real8_1d + end interface + + interface parallel_get_var + module procedure parallel_get_var_integer_1d + module procedure parallel_get_var_real4_1d + module procedure parallel_get_var_real8_1d + end interface + + interface parallel_halo + module procedure parallel_halo_integer_2d + module procedure parallel_halo_logical_2d + module procedure parallel_halo_real4_2d + module procedure parallel_halo_real8_2d + module procedure parallel_halo_real8_3d + end interface + + interface parallel_halo_verify + module procedure parallel_halo_verify_integer_2d + module procedure parallel_halo_verify_real8_2d + module procedure parallel_halo_verify_real8_3d + end interface + + interface parallel_print + module procedure parallel_print_integer_2d + module procedure parallel_print_real8_2d + module procedure parallel_print_real8_3d + end interface + + interface parallel_put_att + module procedure parallel_put_att_character + module procedure parallel_put_att_real4 + module procedure parallel_put_att_real4_1d + module procedure parallel_put_att_real8 + module procedure parallel_put_att_real8_1d + end interface + + interface parallel_put_var + module procedure parallel_put_var_real4 + module procedure parallel_put_var_real8 + module procedure parallel_put_var_real8_1d + end interface + + interface parallel_reduce_sum + module procedure parallel_reduce_sum_integer + module procedure parallel_reduce_sum_real4 + module procedure parallel_reduce_sum_real8 + module procedure parallel_reduce_sum_real8_nvar + end interface + + interface parallel_reduce_max + module procedure parallel_reduce_max_integer + module procedure parallel_reduce_max_real4 + module procedure parallel_reduce_max_real8 + end interface + + interface parallel_reduce_min + module procedure parallel_reduce_min_integer + module procedure parallel_reduce_min_real4 + module procedure parallel_reduce_min_real8 + end interface + + ! This reduce interface determines the global min value and the processor on which it occurs + interface parallel_reduce_maxloc + module procedure parallel_reduce_maxloc_integer + module procedure parallel_reduce_maxloc_real4 + module procedure parallel_reduce_maxloc_real8 + end interface + + ! This reduce interface determines the global min value and the processor on which it occurs + interface parallel_reduce_minloc + module procedure parallel_reduce_minloc_integer + module procedure parallel_reduce_minloc_real4 + module procedure parallel_reduce_minloc_real8 + end interface + + interface staggered_parallel_halo + module procedure staggered_parallel_halo_integer_2d + module procedure staggered_parallel_halo_integer_3d + module procedure staggered_parallel_halo_real8_2d + module procedure staggered_parallel_halo_real8_3d + module procedure staggered_parallel_halo_real8_4d + end interface + + interface staggered_parallel_halo_extrapolate + module procedure staggered_parallel_halo_extrapolate_integer_2d + module procedure staggered_parallel_halo_extrapolate_real8_2d + end interface + +contains + + subroutine broadcast_character(c, proc) + implicit none + character(len=*) :: c + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_character + + subroutine broadcast_integer(i, proc) + implicit none + integer :: i + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_integer + + subroutine broadcast_integer_1d(a, proc) + implicit none + integer,dimension(:) :: a + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_integer_1d + + subroutine broadcast_logical(l, proc) + implicit none + logical :: l + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_logical + + subroutine broadcast_real4(r, proc) + implicit none + real(4) :: r + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_real4 + + subroutine broadcast_real4_1d(a, proc) + real(4),dimension(:) :: a + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_real4_1d + + subroutine broadcast_real8(r, proc) + implicit none + real(8) :: r + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_real8 + + subroutine broadcast_real8_1d(a, proc) + implicit none + real(8),dimension(:) :: a + integer, intent(in), optional :: proc ! optional argument indicating which processor to broadcast from - not relevant to serial version + end subroutine broadcast_real8_1d + + function distributed_get_var_integer_2d(ncid,varid,values,start) + + implicit none + integer :: distributed_get_var_integer_2d,ncid,varid + integer,dimension(:) :: start + integer,dimension(:,:) :: values + + integer :: ilo, ihi, jlo, jhi + + ! begin + + if (main_task) then + + if (size(values,1)==local_ewn) then + ilo = 1 + lhalo + ihi = local_ewn - uhalo + jlo = 1 + lhalo + jhi = local_nsn - uhalo + else if (size(values,1)==local_ewn-1) then + ilo = 1 + staggered_lhalo + ihi = local_ewn - 1 - uhalo + jlo = 1 + staggered_lhalo + jhi = local_nsn - 1 - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_integer_2d = & + nf90_get_var(ncid,varid,values(ilo:ihi,jlo:jhi),start) + + endif + + end function distributed_get_var_integer_2d + + function distributed_get_var_real4_1d(ncid,varid,values,start) + + implicit none + integer :: distributed_get_var_real4_1d,ncid,varid + integer,dimension(:) :: start + real(4),dimension(:) :: values + + integer :: status, x1id, y1id + integer :: ilo, ihi + + ! begin + + if (main_task) then + + status = nf90_inq_varid(ncid,"x1",x1id) + status = nf90_inq_varid(ncid,"y1",y1id) + if (varid==x1id) then + ilo = 1+lhalo + ihi = local_ewn - uhalo + else if (varid==y1id) then + ilo = 1+lhalo + ihi = local_nsn - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_real4_1d = & + nf90_get_var(ncid,varid,values(ilo:ihi),start) + + endif + + end function distributed_get_var_real4_1d + + function distributed_get_var_real4_2d(ncid,varid,values,start) + + implicit none + integer :: distributed_get_var_real4_2d,ncid,varid + integer,dimension(:) :: start + real(4),dimension(:,:) :: values + + integer :: ilo, ihi, jlo, jhi + + ! begin + + if (main_task) then + + if (size(values,1)==local_ewn) then + ilo = 1 + lhalo + ihi = local_ewn - uhalo + jlo = 1 + lhalo + jhi = local_nsn - uhalo + else if (size(values,1)==local_ewn-1) then + ilo = 1 + lhalo + ihi = local_ewn - 1 - uhalo + jlo = 1 + lhalo + jhi = local_nsn - 1 - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_real4_2d = & + nf90_get_var(ncid,varid,values(ilo:ihi,jlo:jhi),start) + + endif + + end function distributed_get_var_real4_2d + + !WHL - added this function + + function distributed_get_var_real8_1d(ncid,varid,values,start) + + implicit none + integer :: distributed_get_var_real8_1d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:) :: values + + integer :: status, x1id, y1id + integer :: ilo, ihi + + ! begin + + if (main_task) then + + status = nf90_inq_varid(ncid,"x1",x1id) + status = nf90_inq_varid(ncid,"y1",y1id) + if (varid==x1id) then + ilo = 1+lhalo + ihi = local_ewn - uhalo + else if (varid==y1id) then + ilo = 1+lhalo + ihi = local_nsn - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_real8_1d = & + nf90_get_var(ncid,varid,values(ilo:ihi),start) + + endif + + end function distributed_get_var_real8_1d + + function distributed_get_var_real8_2d(ncid,varid,values,start) + implicit none + integer :: distributed_get_var_real8_2d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:,:) :: values + + integer :: ilo, ihi, jlo, jhi + + ! begin + + if (main_task) then + + if (size(values,1)==local_ewn) then + ilo = 1 + lhalo + ihi = local_ewn - uhalo + jlo = 1 + lhalo + jhi = local_nsn - uhalo + else if (size(values,1)==local_ewn-1) then + ilo = 1 + lhalo + ihi = local_ewn - 1 - uhalo + jlo = 1 + lhalo + jhi = local_nsn - 1 - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_real8_2d = & + nf90_get_var(ncid,varid,values(ilo:ihi,jlo:jhi),start) + + endif + + end function distributed_get_var_real8_2d + + function distributed_get_var_real8_3d(ncid,varid,values,start) + + implicit none + integer :: distributed_get_var_real8_3d,ncid,varid + integer,dimension(:) :: start + real(8),dimension(:,:,:) :: values + + integer :: ilo, ihi, jlo, jhi + + ! begin + + if (main_task) then + + if (size(values,1)==local_ewn) then + ilo = 1 + lhalo + ihi = local_ewn - uhalo + jlo = 1 + lhalo + jhi = local_nsn - uhalo + else if (size(values,1)==local_ewn-1) then + ilo = 1 + lhalo + ihi = local_ewn - 1 - uhalo + jlo = 1 + lhalo + jhi = local_nsn - 1 - uhalo + else + call parallel_stop(__FILE__,__LINE__) + end if + + distributed_get_var_real8_3d = & + nf90_get_var(ncid,varid,values(ilo:ihi,jlo:jhi,:),start) + + endif + + end function distributed_get_var_real8_3d + + + subroutine distributed_grid(ewn, nsn, nhalo_in, periodic_bc_in, outflow_bc_in) + + implicit none + + integer, intent(inout) :: ewn, nsn ! global grid dimensions + integer, intent(in), optional :: nhalo_in ! number of rows of halo cells + logical, intent(in), optional :: periodic_bc_in ! true for periodic global BCs + logical, intent(in), optional :: outflow_bc_in ! true for outflow global BCs + ! (scalars in global halo set to zero) + + integer :: ewrank,ewtasks,nsrank,nstasks + + ! Optionally, change the halo values + ! Note: The higher-order dycores (glam, glissade) currently require nhalo = 2. + ! The Glide SIA dycore requires nhalo = 0. + ! The default halo values at the top of the module are appropriate for + ! the higher-order dycores. Here they can be reset to zero for Glide. + + if (present(nhalo_in)) then + if (main_task) then + write(*,*) 'Setting halo values: nhalo =', nhalo_in + if (nhalo_in < 0) then + write(*,*) 'ERROR: nhalo must be >= 0' + call parallel_stop(__FILE__, __LINE__) + endif + endif + nhalo = nhalo_in + lhalo = nhalo + uhalo = nhalo + staggered_lhalo = lhalo + staggered_uhalo = max(uhalo-1, 0) + endif + + ! initialize some grid quantities to be consistent with parallel_mpi + + global_ewn = ewn + global_nsn = nsn + + global_row_offset = 0 + global_col_offset = 0 + + ewrank = 0 + nsrank = 0 + ewtasks = 1 + nstasks = 1 + + east = 0 ! all halo updates are local copies by the main task + west = 0 + north = 0 + south = 0 + +! Trey's original code +! ewlb = 1 +! ewub = global_ewn +! local_ewn = ewub-ewlb+1 +! own_ewn = local_ewn-lhalo-uhalo +! ewn = local_ewn + +! nslb = 1 +! nsub = global_nsn +! local_nsn = nsub-nslb+1 +! own_nsn = local_nsn-lhalo-uhalo +! nsn = local_nsn + +!WHL - modified code for nonzero halo values + ewlb = 1 - lhalo + ewub = global_ewn + uhalo + local_ewn = ewub - ewlb + 1 + own_ewn = local_ewn - lhalo - uhalo + ewn = local_ewn + + nslb = 1 - lhalo + nsub = global_nsn + uhalo + local_nsn = nsub - nslb + 1 + own_nsn = local_nsn - lhalo - uhalo + nsn = local_nsn + + !WHL - added global boundary conditions + + periodic_bc = .true. ! this is the default + outflow_bc = .false. + + if (present(outflow_bc_in)) then + outflow_bc = outflow_bc_in + if (outflow_bc) periodic_bc = .false. + endif + + if (present(periodic_bc_in)) then + periodic_bc = periodic_bc_in + if (periodic_bc) outflow_bc = .false. + endif + + !WHL - debug + if (outflow_bc) write(*,*) "Outflow global boundary conditions" + if (periodic_bc) write(*,*) "Periodic global boundary conditions" + + ! Print grid geometry + write(*,*) "Process ", this_rank, " Total = ", tasks, " ewtasks = ", ewtasks, " nstasks = ", nstasks + write(*,*) "Process ", this_rank, " ewrank = ", ewrank, " nsrank = ", nsrank + write(*,*) "Process ", this_rank, " l_ewn = ", local_ewn, " o_ewn = ", own_ewn + write(*,*) "Process ", this_rank, " l_nsn = ", local_nsn, " o_nsn = ", own_nsn + write(*,*) "Process ", this_rank, " ewlb = ", ewlb, " ewub = ", ewub + write(*,*) "Process ", this_rank, " nslb = ", nslb, " nsub = ", nsub + write(*,*) "Process ", this_rank, " east = ", east, " west = ", west + write(*,*) "Process ", this_rank, " north = ", north, " south = ", south + write(*,*) "Process ", this_rank, " ew_vars = ", own_ewn, " ns_vars = ", own_nsn + + end subroutine distributed_grid + + function distributed_execution() + ! Returns if running distributed or not. + logical distributed_execution + + distributed_execution = .false. + end function distributed_execution + + subroutine distributed_gather_var_integer_2d(values, global_values) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + integer,dimension(:,:),intent(in) :: values + integer,dimension(:,:),allocatable,intent(inout) :: global_values + + if (allocated(global_values)) then + deallocate(global_values) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(size(values,1), size(values,2))) +!! global_values(:,:) = values(:,:) + allocate(global_values(size(values,1)-uhalo-lhalo, size(values,2)-uhalo-lhalo)) + global_values(:,:) = values(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_integer_2d + + subroutine distributed_gather_var_logical_2d(values, global_values) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + logical,dimension(:,:),intent(in) :: values + logical,dimension(:,:),allocatable,intent(inout) :: global_values + + if (allocated(global_values)) then + deallocate(global_values) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(size(values,1), size(values,2))) +!! global_values(:,:) = values(:,:) + allocate(global_values(size(values,1)-uhalo-lhalo, size(values,2)-uhalo-lhalo)) + global_values(:,:) = values(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_logical_2d + + subroutine distributed_gather_var_real4_2d(values, global_values) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + real(4),dimension(:,:),intent(in) :: values + real(4),dimension(:,:),allocatable,intent(inout) :: global_values + + if (allocated(global_values)) then + deallocate(global_values) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(size(values,1), size(values,2))) +!! global_values(:,:) = values(:,:) + allocate(global_values(size(values,1)-uhalo-lhalo, size(values,2)-uhalo-lhalo)) + global_values(:,:) = values(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_real4_2d + + subroutine distributed_gather_var_real4_3d(values, global_values, ld1, ud1) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + real(4),dimension(:,:,:),intent(in) :: values + real(4),dimension(:,:,:),allocatable,intent(inout) :: global_values + integer,optional,intent(in) :: ld1, ud1 + + integer :: d1l,d1u + + if (allocated(global_values)) then + deallocate(global_values) + endif + if (present(ld1)) then + d1l = ld1 + else + d1l = 1 + endif + if (present(ud1)) then + d1u = ud1 + else + d1u = size(values,1) + endif + if (size(values,1) /= d1u-d1l+1) then + write(*,*) "size(values,1) .ne. d1u-d1l+1 in gather call" + call parallel_stop(__FILE__, __LINE__) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(d1l:d1u, size(values,2), size(values,3))) +!! global_values(d1l:d1u,:,:) = values(1:size(values,1),:,:) + allocate(global_values(d1l:d1u, size(values,2)-uhalo-lhalo, size(values,3)-uhalo-lhalo)) + global_values(d1l:d1u,:,:) = values(1:size(values,1), 1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_real4_3d + + subroutine distributed_gather_var_real8_2d(values, global_values) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + real(8),dimension(:,:),intent(in) :: values + real(8),dimension(:,:),allocatable,intent(inout) :: global_values + + if (allocated(global_values)) then + deallocate(global_values) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(size(values,1), size(values,2))) +!! global_values(:,:) = values(:,:) + allocate(global_values(size(values,1)-uhalo-lhalo, size(values,2)-uhalo-lhalo)) + global_values(:,:) = values(1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_real8_2d + + subroutine distributed_gather_var_real8_3d(values, global_values, ld1, ud1) + ! JEFF Gather a distributed variable back to main_task node + ! values = local portion of distributed variable + ! global_values = reference to allocateable array into which the main_task will store the variable. + ! If global_values is allocated, then it will be deallocated and reallocated. It will be unused on other nodes. + ! Variables are assumed to lie on the scalar grid (at cell centers). + implicit none + real(8),dimension(:,:,:),intent(in) :: values + real(8),dimension(:,:,:),allocatable,intent(inout) :: global_values + integer,optional,intent(in) :: ld1, ud1 + + integer :: d1l,d1u + + if (allocated(global_values)) then + deallocate(global_values) + endif + if (present(ld1)) then + d1l = ld1 + else + d1l = 1 + endif + if (present(ud1)) then + d1u = ud1 + else + d1u = size(values,1) + endif + if (size(values,1) /= d1u-d1l+1) then + write(*,*) "size(values,1) .ne. d1u-d1l+1 in gather call" + call parallel_stop(__FILE__, __LINE__) + endif + + !WHL - Commented code will not work if the local arrays include halo cells +!! allocate(global_values(d1l:d1u, size(values,2), size(values,3))) +!! global_values(d1l:d1u,:,:) = values(1:size(values,1),:,:) + allocate(global_values(d1l:d1u, size(values,2)-uhalo-lhalo, size(values,3)-uhalo-lhalo)) + global_values(d1l:d1u,:,:) = values(1:size(values,1), 1+lhalo:local_ewn-uhalo, 1+lhalo:local_nsn-uhalo) + + end subroutine distributed_gather_var_real8_3d + + function distributed_isparallel() + implicit none + logical :: distributed_isparallel + + distributed_isparallel = .false. + end function distributed_isparallel + + function distributed_owner(ew,ewn,ns,nsn) + implicit none + logical :: distributed_owner + integer :: ew,ewn,ns,nsn + ! begin + distributed_owner = .true. + end function distributed_owner + + subroutine distributed_print_integer_2d(name,values) + implicit none + character(*) :: name + integer,dimension(:,:) :: values + + integer,parameter :: u = 33 + character(3) :: ts + integer :: i,j,k + + write(ts,'(i3.3)') tasks + open(unit=u,file=name//ts//".txt",form="formatted",status="replace") + if (size(values,1) lhalo .and. ilocal <= lhalo + own_ewn) & + .and. & + (jlocal > lhalo .and. jlocal <= lhalo + own_nsn) ) then + ! global indices are valid + else ! global indices are invalid + if (main_task) then + write(*,*) 'Invalid global indices: iglobal, jglobal =', iglobal, jglobal + call parallel_stop(__FILE__,__LINE__) + endif + endif + end subroutine parallel_localindex + + + subroutine parallel_halo_integer_2d(a) + + implicit none + integer,dimension(:,:) :: a + + integer,dimension(lhalo,local_nsn-lhalo-uhalo) :: ecopy + integer,dimension(uhalo,local_nsn-lhalo-uhalo) :: wcopy + integer,dimension(local_ewn,lhalo) :: ncopy + integer,dimension(local_ewn,uhalo) :: scopy + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1 .and. size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn .or. size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + if (outflow_bc) then + + a(:lhalo,1+lhalo:local_nsn-uhalo) = 0 + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = 0 + a(:,:lhalo) = 0 + a(:,local_nsn-uhalo+1:) = 0 + + else ! periodic BC + + ecopy(:,:) = a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + wcopy(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + a(:lhalo,1+lhalo:local_nsn-uhalo) = ecopy(:,:) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = wcopy(:,:) + + ncopy(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + scopy(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + a(:,:lhalo) = ncopy(:,:) + a(:,local_nsn-uhalo+1:) = scopy(:,:) + + endif + + end subroutine parallel_halo_integer_2d + + + subroutine parallel_halo_logical_2d(a) + + implicit none + logical,dimension(:,:) :: a + + logical,dimension(lhalo,local_nsn-lhalo-uhalo) :: ecopy + logical,dimension(uhalo,local_nsn-lhalo-uhalo) :: wcopy + logical,dimension(local_ewn,lhalo) :: ncopy + logical,dimension(local_ewn,uhalo) :: scopy + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1 .and. size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn .or. size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + if (outflow_bc) then + + a(:lhalo,1+lhalo:local_nsn-uhalo) = .false. + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = .false. + a(:,:lhalo) = .false. + a(:,local_nsn-uhalo+1:) = .false. + + else ! periodic BC + + ecopy(:,:) = a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + wcopy(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + a(:lhalo,1+lhalo:local_nsn-uhalo) = ecopy(:,:) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = wcopy(:,:) + + ncopy(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + scopy(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + a(:,:lhalo) = ncopy(:,:) + a(:,local_nsn-uhalo+1:) = scopy(:,:) + + endif + + end subroutine parallel_halo_logical_2d + + + subroutine parallel_halo_real4_2d(a) + + implicit none + real(4),dimension(:,:) :: a + + real(4),dimension(lhalo,local_nsn-lhalo-uhalo) :: ecopy + real(4),dimension(uhalo,local_nsn-lhalo-uhalo) :: wcopy + real(4),dimension(local_ewn,lhalo) :: ncopy + real(4),dimension(local_ewn,uhalo) :: scopy + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1 .and. size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn .or. size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + if (outflow_bc) then + + a(:lhalo,1+lhalo:local_nsn-uhalo) = 0. + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = 0. + a(:,:lhalo) = 0. + a(:,local_nsn-uhalo+1:) = 0. + + else ! periodic BC + + ecopy(:,:) = a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + wcopy(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + a(:lhalo,1+lhalo:local_nsn-uhalo) = ecopy(:,:) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = wcopy(:,:) + + ncopy(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + scopy(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + a(:,:lhalo) = ncopy(:,:) + a(:,local_nsn-uhalo+1:) = scopy(:,:) + + endif + + end subroutine parallel_halo_real4_2d + + + subroutine parallel_halo_real8_2d(a, periodic_offset_ew, periodic_offset_ns) + + !WHL - added optional arguments for periodic offsets, to support ismip-hom test cases + + implicit none + real(8),dimension(:,:) :: a + real(8), intent(in), optional :: & + periodic_offset_ew, &! offset halo values by this amount + ! if positive, the offset is positive for W halo, negative for E halo + periodic_offset_ns ! offset halo values by this amount + ! if positive, the offset is positive for S halo, negative for N halo + + real(8),dimension(lhalo,local_nsn-lhalo-uhalo) :: ecopy + real(8),dimension(uhalo,local_nsn-lhalo-uhalo) :: wcopy + real(8),dimension(local_ewn,lhalo) :: ncopy + real(8),dimension(local_ewn,uhalo) :: scopy + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1 .and. size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,1)/=local_ewn .or. size(a,2)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,1), ",", size(a,2), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + if (outflow_bc) then + + a(:lhalo,1+lhalo:local_nsn-uhalo) = 0.d0 + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = 0.d0 + a(:,:lhalo) = 0.d0 + a(:,local_nsn-uhalo+1:) = 0.d0 + + else ! periodic BC + + ecopy(:,:) = a(local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + wcopy(:,:) = a(1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + a(:lhalo,1+lhalo:local_nsn-uhalo) = ecopy(:,:) + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = wcopy(:,:) + + if (present(periodic_offset_ew)) then + if (periodic_offset_ew /= 0.d0) then + a(:lhalo,1+lhalo:local_nsn-uhalo) = & + a(:lhalo,1+lhalo:local_nsn-uhalo) + periodic_offset_ew + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = & + a(local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) - periodic_offset_ew + endif + endif + + ncopy(:,:) = a(:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + scopy(:,:) = a(:,1+lhalo:1+lhalo+uhalo-1) + a(:,:lhalo) = ncopy(:,:) + a(:,local_nsn-uhalo+1:) = scopy(:,:) + + if (present(periodic_offset_ns)) then + if (periodic_offset_ns /= 0.d0) then + a(:,:lhalo) = a(:,:lhalo) + periodic_offset_ns + a(:,local_nsn-uhalo+1:) = a(:,local_nsn-uhalo+1:) - periodic_offset_ns + endif + endif + + endif ! open or periodic BC + + end subroutine parallel_halo_real8_2d + + + subroutine parallel_halo_real8_3d(a) + + implicit none + real(8),dimension(:,:,:) :: a + + real(8),dimension(size(a,1),lhalo,local_nsn-lhalo-uhalo) :: ecopy + real(8),dimension(size(a,1),uhalo,local_nsn-lhalo-uhalo) :: wcopy + real(8),dimension(size(a,1),local_ewn,lhalo) :: ncopy + real(8),dimension(size(a,1),local_ewn,uhalo) :: scopy + + ! begin + + ! staggered grid + if (size(a,1)==local_ewn-1 .and. size(a,2)==local_nsn-1) return + + ! unknown grid + if (size(a,2)/=local_ewn .or. size(a,3)/=local_nsn) then + write(*,*) "Unknown Grid: Size a=(", size(a,2), ",", size(a,3), ") and local_ewn and local_nsn = ", local_ewn, ",", local_nsn + call parallel_stop(__FILE__,__LINE__) + endif + + if (outflow_bc) then + + a(:,:lhalo,1+lhalo:local_nsn-uhalo) = 0.d0 + a(:,local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = 0.d0 + a(:,:,:lhalo) = 0.d0 + a(:,:,local_nsn-uhalo+1:) = 0.d0 + + else ! periodic BC + + ecopy(:,:,:) = a(:,local_ewn-uhalo-lhalo+1:local_ewn-uhalo,1+lhalo:local_nsn-uhalo) + wcopy(:,:,:) = a(:,1+lhalo:1+lhalo+uhalo-1,1+lhalo:local_nsn-uhalo) + a(:,:lhalo,1+lhalo:local_nsn-uhalo) = ecopy(:,:,:) + a(:,local_ewn-uhalo+1:,1+lhalo:local_nsn-uhalo) = wcopy(:,:,:) + + ncopy(:,:,:) = a(:,:,local_nsn-uhalo-lhalo+1:local_nsn-uhalo) + scopy(:,:,:) = a(:,:,1+lhalo:1+lhalo+uhalo-1) + a(:,:,:lhalo) = ncopy(:,:,:) + a(:,:,local_nsn-uhalo+1:) = scopy(:,:,:) + + endif + + end subroutine parallel_halo_real8_3d + + function parallel_halo_verify_integer_2d(a) + implicit none + integer,dimension(:,:) :: a + logical :: parallel_halo_verify_integer_2d + parallel_halo_verify_integer_2d = .true. + end function parallel_halo_verify_integer_2d + + function parallel_halo_verify_real8_2d(a) + implicit none + real(8),dimension(:,:) :: a + logical :: parallel_halo_verify_real8_2d + parallel_halo_verify_real8_2d = .true. + end function parallel_halo_verify_real8_2d + + function parallel_halo_verify_real8_3d(a) + implicit none + real(8),dimension(:,:,:) :: a + logical :: parallel_halo_verify_real8_3d + parallel_halo_verify_real8_3d = .true. + end function parallel_halo_verify_real8_3d + +#ifdef _USE_MPI_WITH_SLAP + ! parallel_initialise should generally just be called by standalone cism drivers + ! When cism is nested inside a climate model (so mpi_init has already been called) use parallel_set_info instead + subroutine parallel_initialise + use mpi_mod + implicit none + integer :: ierror + integer, parameter :: my_main_rank = 0 + ! begin + call mpi_init(ierror) + call parallel_set_info(mpi_comm_world, my_main_rank) + end subroutine parallel_initialise + + ! parallel_set_info should be called directly when cism is nested inside a climate model + ! (then, mpi_init has already been called, so do NOT use parallel_initialise) + + subroutine parallel_set_info(my_comm, my_main_rank) + use mpi_mod + implicit none + integer, intent(in) :: my_comm ! CISM's global communicator + integer, intent(in) :: my_main_rank ! rank of the master task (ignored for parallel_slap) + integer :: ierror + ! begin + comm = my_comm + call mpi_comm_size(comm,tasks,ierror) + call mpi_comm_rank(comm,this_rank,ierror) + main_task = .true. !For parallel_slap, each node duplicates all of the calculations. + end subroutine parallel_set_info + +#else + subroutine parallel_initialise + implicit none + end subroutine parallel_initialise + + subroutine parallel_set_info(my_comm, my_main_rank) + implicit none + integer, intent(in) :: my_comm ! CISM's global communicator (IGNORED) + integer, intent(in) :: my_main_rank ! rank of the master task (IGNORED) + end subroutine parallel_set_info + +#endif + + subroutine parallel_print_integer_2d(name,values) + implicit none + character(*) :: name + integer,dimension(:,:) :: values + + integer,parameter :: u = 33 + integer :: i,j + ! begin + open(unit=u,file=name//".txt",form="formatted",status="replace") + do j = 1,size(values,2) + do i = 1,size(values,1) + write(u,*) j,i,values(i,j) + end do + write(u,'()') + end do + close(u) + end subroutine parallel_print_integer_2d + + function parallel_inq_attname(ncid,varid,attnum,name) + implicit none + integer :: attnum,ncid,parallel_inq_attname,varid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_attname = & + nf90_inq_attname(ncid,varid,attnum,name) + call broadcast(parallel_inq_attname) + call broadcast(name) + end function parallel_inq_attname + + function parallel_inq_dimid(ncid,name,dimid) + implicit none + integer :: dimid,ncid,parallel_inq_dimid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_dimid = nf90_inq_dimid(ncid,name,dimid) + call broadcast(parallel_inq_dimid) + call broadcast(dimid) + end function parallel_inq_dimid + + function parallel_inq_varid(ncid,name,varid) + implicit none + integer :: ncid,parallel_inq_varid,varid + character(len=*) :: name + ! begin + if (main_task) parallel_inq_varid = nf90_inq_varid(ncid,name,varid) + call broadcast(parallel_inq_varid) + call broadcast(varid) + end function parallel_inq_varid + + function parallel_inquire(ncid,nvariables) + implicit none + integer :: ncid,parallel_inquire,nvariables + ! begin + if (main_task) parallel_inquire = nf90_inquire(ncid,nvariables=nvariables) + call broadcast(parallel_inquire) + call broadcast(nvariables) + end function parallel_inquire + + function parallel_inquire_dimension(ncid,dimid,name,len) + implicit none + integer :: dimid,ncid,parallel_inquire_dimension + integer,optional :: len + character(len=*),optional :: name + + integer :: l + + ! begin + + if (present(name)) then + if (main_task) parallel_inquire_dimension = & + nf90_inquire_dimension(ncid,dimid,name,len=l) + call broadcast(name) + else + if (main_task) parallel_inquire_dimension = & + nf90_inquire_dimension(ncid,dimid,len=l) + end if + call broadcast(parallel_inquire_dimension) + if (present(len)) then + call broadcast(l) + len = l + end if + end function parallel_inquire_dimension + + function parallel_inquire_variable(ncid,varid,name,ndims,dimids,natts) + implicit none + integer :: ncid,parallel_inquire_variable,varid + integer,optional :: ndims,natts + character(len=*),optional :: name + integer,dimension(:),optional :: dimids + + integer :: nd,na + ! begin + if (present(name)) then + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,name=name) + call broadcast(parallel_inquire_variable) + call broadcast(name) + if (parallel_inquire_variable/=nf90_noerr) return + end if + if (present(dimids)) then + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,dimids=dimids) + call broadcast(parallel_inquire_variable) + call broadcast(dimids) + if (parallel_inquire_variable/=nf90_noerr) return + end if + if (main_task) parallel_inquire_variable = & + nf90_inquire_variable(ncid,varid,ndims=nd,natts=na) + call broadcast(parallel_inquire_variable) + if (present(ndims)) then + call broadcast(nd) + ndims = nd + end if + if (present(natts)) then + call broadcast(na) + natts = na + end if + end function parallel_inquire_variable + + function parallel_open(path,mode,ncid) + implicit none + integer :: mode,ncid,parallel_open + character(len=*) :: path + ! begin + if (main_task) parallel_open = nf90_open(path,mode,ncid) + call broadcast(parallel_open) + end function parallel_open + + subroutine parallel_print_real8_2d(name,values) + implicit none + character(*) :: name + real(8),dimension(:,:) :: values + + integer,parameter :: u = 33 + integer :: i,j + ! begin + open(unit=u,file=name//".txt",form="formatted",status="replace") + do j = 1,size(values,2) + do i = 1,size(values,1) + write(u,*) j,i,values(i,j) + end do + write(u,'()') + end do + close(u) + end subroutine parallel_print_real8_2d + + subroutine parallel_print_real8_3d(name,values) + implicit none + character(*) :: name + real(8),dimension(:,:,:) :: values + + integer,parameter :: u = 33 + integer :: i,j + ! begin + open(unit=u,file=name//".txt",form="formatted",status="replace") + do j = 1,size(values,3) + do i = 1,size(values,2) + write(u,'(2i6,100g15.5e3)') j,i,values(:,i,j) + end do + write(u,'()') + end do + close(u) + end subroutine parallel_print_real8_3d + + function parallel_put_att_character(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_character,varid + character(len=*) :: name,values + ! begin + if (main_task) parallel_put_att_character = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_character) + end function parallel_put_att_character + + function parallel_put_att_real4(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real4,varid + character(len=*) :: name + real(4) :: values + ! begin + if (main_task) parallel_put_att_real4 = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real4) + end function parallel_put_att_real4 + + function parallel_put_att_real4_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real4_1d,varid + character(len=*) :: name + real(4),dimension(:) :: values + ! begin + if (main_task) parallel_put_att_real4_1d = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real4_1d) + end function parallel_put_att_real4_1d + + function parallel_put_att_real8(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real8,varid + character(len=*) :: name + real(8) :: values + ! begin + if (main_task) parallel_put_att_real8 = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real8) + end function parallel_put_att_real8 + + function parallel_put_att_real8_1d(ncid,varid,name,values) + implicit none + integer :: ncid,parallel_put_att_real8_1d,varid + character(len=*) :: name + real(8),dimension(:) :: values + ! begin + if (main_task) parallel_put_att_real8_1d = nf90_put_att(ncid,varid,name,values) + call broadcast(parallel_put_att_real8_1d) + end function parallel_put_att_real8_1d + + function parallel_put_var_real4(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real4,varid + integer,dimension(:) :: start + real(4) :: values + ! begin + if (main_task) parallel_put_var_real4 = & + nf90_put_var(ncid,varid,values,start) + call broadcast(parallel_put_var_real4) + end function parallel_put_var_real4 + + function parallel_put_var_real8(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real8,varid + integer,dimension(:) :: start + real(8) :: values + ! begin + if (main_task) parallel_put_var_real8 = & + nf90_put_var(ncid,varid,values,start) + call broadcast(parallel_put_var_real8) + end function parallel_put_var_real8 + + function parallel_put_var_real8_1d(ncid,varid,values,start) + implicit none + integer :: ncid,parallel_put_var_real8_1d,varid + integer,dimension(:),optional :: start + real(8),dimension(:) :: values + ! begin + if (main_task) then + if (present(start)) then + parallel_put_var_real8_1d = nf90_put_var(ncid,varid,values,start) + else + parallel_put_var_real8_1d = nf90_put_var(ncid,varid,values) + end if + end if + call broadcast(parallel_put_var_real8_1d) + end function parallel_put_var_real8_1d + + function parallel_redef(ncid) + implicit none + integer :: ncid,parallel_redef + ! begin + if (main_task) parallel_redef = nf90_redef(ncid) + call broadcast(parallel_redef) + end function parallel_redef + +! ------------------------------------------ +! functions for parallel_reduce_sum interface +! ------------------------------------------ + function parallel_reduce_sum_integer(x) + ! Sum x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + integer :: x, parallel_reduce_sum_integer + + parallel_reduce_sum_integer = x + return + end function parallel_reduce_sum_integer + + function parallel_reduce_sum_real4(x) + ! Sum x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(4) :: x, parallel_reduce_sum_real4 + + parallel_reduce_sum_real4 = x + return + end function parallel_reduce_sum_real4 + + function parallel_reduce_sum_real8(x) + ! Sum x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(8) :: x, parallel_reduce_sum_real8 + + parallel_reduce_sum_real8 = x + return + end function parallel_reduce_sum_real8 + + function parallel_reduce_sum_real8_nvar(x) + ! Sum x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(8) :: x(:) + real(8), dimension(size(x)) :: parallel_reduce_sum_real8_nvar + + parallel_reduce_sum_real8_nvar(:) = x(:) + return + end function parallel_reduce_sum_real8_nvar + +! ------------------------------------------ +! functions for parallel_reduce_max interface +! ------------------------------------------ + function parallel_reduce_max_integer(x) + ! Max x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + integer :: x, parallel_reduce_max_integer + + parallel_reduce_max_integer = x + return + end function parallel_reduce_max_integer + + function parallel_reduce_max_real4(x) + ! Max x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(4) :: x, parallel_reduce_max_real4 + + parallel_reduce_max_real4 = x + return + end function parallel_reduce_max_real4 + + function parallel_reduce_max_real8(x) + ! Max x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(8) :: x, parallel_reduce_max_real8 + + parallel_reduce_max_real8 = x + return + end function parallel_reduce_max_real8 + +! ------------------------------------------ +! routines for parallel_reduce_maxloc interface +! ------------------------------------------ + subroutine parallel_reduce_maxloc_integer(xin, xout, xprocout) + ! Max x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + integer, intent(in) :: xin ! variable to reduce + integer, intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_maxloc_integer + + subroutine parallel_reduce_maxloc_real4(xin, xout, xprocout) + ! Max x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + real(4), intent(in) :: xin ! variable to reduce + real(4), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_maxloc_real4 + + subroutine parallel_reduce_maxloc_real8(xin, xout, xprocout) + ! Max x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + real(8), intent(in) :: xin ! variable to reduce + real(8), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_maxloc_real8 + +! ------------------------------------------ +! functions for parallel_reduce_min interface +! ------------------------------------------ + function parallel_reduce_min_integer(x) + ! Min x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + integer :: x, parallel_reduce_min_integer + + parallel_reduce_min_integer = x + return + end function parallel_reduce_min_integer + + function parallel_reduce_min_real4(x) + ! Min x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(4) :: x, parallel_reduce_min_real4 + + parallel_reduce_min_real4 = x + return + end function parallel_reduce_min_real4 + + function parallel_reduce_min_real8(x) + ! Min x across all of the nodes. + ! In parallel_slap mode just return x. + implicit none + real(8) :: x, parallel_reduce_min_real8 + + parallel_reduce_min_real8 = x + return + end function parallel_reduce_min_real8 + +! ------------------------------------------ +! routines for parallel_reduce_minloc interface +! ------------------------------------------ + subroutine parallel_reduce_minloc_integer(xin, xout, xprocout) + ! Min x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + integer, intent(in) :: xin ! variable to reduce + integer, intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_minloc_integer + + subroutine parallel_reduce_minloc_real4(xin, xout, xprocout) + ! Min x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + real(4), intent(in) :: xin ! variable to reduce + real(4), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_minloc_real4 + + subroutine parallel_reduce_minloc_real8(xin, xout, xprocout) + ! Min x across all of the nodes and its proc number + ! In parallel_slap mode just return x. + implicit none + real(8), intent(in) :: xin ! variable to reduce + real(8), intent(out) :: xout ! value resulting from the reduction + integer, intent(out) :: xprocout ! processor on which reduced value occurs + + xout = xin + xprocout = this_rank + end subroutine parallel_reduce_minloc_real8 + + + subroutine parallel_show_minmax(label,values) + implicit none + character(*) :: label + real(8),dimension(:,:,:) :: values + ! begin + print *,label,minval(values),maxval(values) + end subroutine parallel_show_minmax + + subroutine parallel_stop(file,line) + implicit none + integer :: line + character(len=*) :: file + ! begin + write(0,*) "STOP in ",file," at line ",line + stop + end subroutine parallel_stop + + function parallel_sync(ncid) + implicit none + integer :: ncid,parallel_sync + ! begin + if (main_task) parallel_sync = nf90_sync(ncid) + call broadcast(parallel_sync) + end function parallel_sync + + subroutine staggered_parallel_halo_extrapolate_integer_2d(a) + + implicit none + integer,dimension(:,:) :: a + integer :: i, j + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Extrapolate the staggered field into halo cells along the global boundary. + ! Currently this is used only for kinbcmask. + ! Note: The extrapolation region includes locally owned cells along + ! the north and east boundaries of the global domain. + + ! extrapolate westward + do i = 1, staggered_lhalo + a(i, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) = & + a(staggered_lhalo+1, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) + enddo + + ! extrapolate eastward + do i = size(a,1)-staggered_uhalo, size(a,1) + a(i, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) = & + a(size(a,1)-staggered_uhalo-1, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) + enddo + + ! extrapolate southward + do j = 1, staggered_lhalo + a(1:size(a,1), j) = a(1:size(a,1), staggered_lhalo+1) + enddo + + ! extrapolate northward + do j = size(a,2)-staggered_uhalo, size(a,2) + a(1:size(a,1), j) = a(1:size(a,1), size(a,2)-staggered_uhalo-1) + enddo + + end subroutine staggered_parallel_halo_extrapolate_integer_2d + + + subroutine staggered_parallel_halo_extrapolate_real8_2d(a) + + implicit none + real(8),dimension(:,:) :: a + integer :: i, j + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + ! Extrapolate the staggered field into halo cells along the global boundary. + ! Currently this is used only for kinbcmask. + ! Note: The extrapolation region includes locally owned cells along + ! the north and east boundaries of the global domain. + + ! extrapolate westward + do i = 1, staggered_lhalo + a(i, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) = & + a(staggered_lhalo+1, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) + enddo + + ! extrapolate eastward + do i = size(a,1)-staggered_uhalo, size(a,1) + a(i, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) = & + a(size(a,1)-staggered_uhalo-1, staggered_lhalo+1:size(a,2)-staggered_uhalo-1) + enddo + + ! extrapolate southward + do j = 1, staggered_lhalo + a(1:size(a,1), j) = a(1:size(a,1), staggered_lhalo+1) + enddo + + ! extrapolate northward + do j = size(a,2)-staggered_uhalo, size(a,2) + a(1:size(a,1), j) = a(1:size(a,1), size(a,2)-staggered_uhalo-1) + enddo + + end subroutine staggered_parallel_halo_extrapolate_real8_2d + + + subroutine staggered_parallel_halo_integer_2d(a) + + implicit none + integer,dimension(:,:) :: a + + integer,dimension(staggered_lhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: ecopy + integer,dimension(staggered_uhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: wcopy + integer,dimension(size(a,1),staggered_lhalo) :: ncopy + integer,dimension(size(a,1),staggered_uhalo) :: scopy + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + wcopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + + ecopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(size(a,1)-staggered_uhalo-staggered_lhalo+1:size(a,1)-staggered_uhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + + a(size(a,1)-staggered_uhalo+1:size(a,1), 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + wcopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) + + a(1:staggered_lhalo, 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + ecopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) + + scopy(:,:) = a(:, 1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + ncopy(:,:) = a(:, size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo) + + a(:, size(a,2)-staggered_uhalo+1:size(a,2)) = scopy(:,:) + a(:, 1:staggered_lhalo) = ncopy(:,:) + + end subroutine staggered_parallel_halo_integer_2d + + + subroutine staggered_parallel_halo_integer_3d(a) + + implicit none + integer,dimension(:,:,:) :: a + + integer,dimension(size(a,1),staggered_lhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: ecopy + integer,dimension(size(a,1),staggered_uhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: wcopy + integer,dimension(size(a,1),size(a,2),staggered_lhalo) :: ncopy + integer,dimension(size(a,1),size(a,2),staggered_uhalo) :: scopy + + ! begin + + ! Confirm staggered array + if (size(a,2)/=local_ewn-1 .or. size(a,3)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + wcopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + + ecopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + + a(:, size(a,2)-staggered_uhalo+1:size(a,2), 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + wcopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) + + a(:, 1:staggered_lhalo, 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + ecopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) + + scopy(:,:,:) = a(:,:, 1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + ncopy(:,:,:) = a(:,:, size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo) + + a(:,:,size(a,3)-staggered_uhalo+1:size(a,3)) = scopy(:,:,:) + a(:,:,1:staggered_lhalo) = ncopy(:,:,:) + + end subroutine staggered_parallel_halo_integer_3d + + + subroutine staggered_parallel_halo_real8_2d(a) + + implicit none + real(8),dimension(:,:) :: a + + real(8),dimension(staggered_lhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: ecopy + real(8),dimension(staggered_uhalo,size(a,2)-staggered_lhalo-staggered_uhalo) :: wcopy + real(8),dimension(size(a,1),staggered_lhalo) :: ncopy + real(8),dimension(size(a,1),staggered_uhalo) :: scopy + + ! begin + + ! Confirm staggered array + if (size(a,1)/=local_ewn-1 .or. size(a,2)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + wcopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + + ecopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) = & + a(size(a,1)-staggered_uhalo-staggered_lhalo+1:size(a,1)-staggered_uhalo, & + 1+staggered_lhalo:size(a,2)-staggered_uhalo) + + a(size(a,1)-staggered_uhalo+1:size(a,1), 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + wcopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) + + a(1:staggered_lhalo, 1+staggered_lhalo:size(a,2)-staggered_uhalo) = & + ecopy(:, 1:size(a,2)-staggered_lhalo-staggered_uhalo) + + scopy(:,:) = a(:, 1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + ncopy(:,:) = a(:, size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo) + + a(:, size(a,2)-staggered_uhalo+1:size(a,2)) = scopy(:,:) + a(:, 1:staggered_lhalo) = ncopy(:,:) + + end subroutine staggered_parallel_halo_real8_2d + + + subroutine staggered_parallel_halo_real8_3d(a) + + implicit none + real(8),dimension(:,:,:) :: a + + real(8),dimension(size(a,1),staggered_lhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: ecopy + real(8),dimension(size(a,1),staggered_uhalo,size(a,3)-staggered_lhalo-staggered_uhalo) :: wcopy + real(8),dimension(size(a,1),size(a,2),staggered_lhalo) :: ncopy + real(8),dimension(size(a,1),size(a,2),staggered_uhalo) :: scopy + + ! begin + + ! Confirm staggered array + if (size(a,2)/=local_ewn-1 .or. size(a,3)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + wcopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + + ecopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) = & + a(:,size(a,2)-staggered_uhalo-staggered_lhalo+1:size(a,2)-staggered_uhalo, & + 1+staggered_lhalo:size(a,3)-staggered_uhalo) + + a(:, size(a,2)-staggered_uhalo+1:size(a,2), 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + wcopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) + + a(:, 1:staggered_lhalo, 1+staggered_lhalo:size(a,3)-staggered_uhalo) = & + ecopy(:,:, 1:size(a,3)-staggered_lhalo-staggered_uhalo) + + scopy(:,:,:) = a(:,:, 1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + ncopy(:,:,:) = a(:,:, size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo) + + a(:,:,size(a,3)-staggered_uhalo+1:size(a,3)) = scopy(:,:,:) + a(:,:,1:staggered_lhalo) = ncopy(:,:,:) + + end subroutine staggered_parallel_halo_real8_3d + +!WHL - New subroutine for 4D arrays + subroutine staggered_parallel_halo_real8_4d(a) + + ! Implements a staggered grid halo update for a 4D field. + ! This subroutine is used for the 4D arrays that hold matrix entries. + + ! As the grid is staggered, the array 'a' is one smaller in x and y dimensions than an unstaggered array. + ! The vertical dimension is assumed to precede the i and j indices, i.e., a(:,k,i,j). + ! The first dimension holds matrix elements for a single row. + + implicit none + real(8),dimension(:,:,:,:) :: a + + real(8),dimension(size(a,1),size(a,2),staggered_lhalo,size(a,4)-staggered_lhalo-staggered_uhalo) :: ecopy + real(8),dimension(size(a,1),size(a,2),staggered_uhalo,size(a,4)-staggered_lhalo-staggered_uhalo) :: wcopy + real(8),dimension(size(a,1),size(a,2),size(a,3),staggered_lhalo) :: ncopy + real(8),dimension(size(a,1),size(a,2),size(a,3),staggered_uhalo) :: scopy + + ! begin + + ! Confirm staggered array + if (size(a,3)/=local_ewn-1 .or. size(a,4)/=local_nsn-1) then + write(*,*) "staggered_parallel_halo() requires staggered arrays." + call parallel_stop(__FILE__,__LINE__) + endif + + wcopy(:,:,:, 1:size(a,4)-staggered_lhalo-staggered_uhalo) = & + a(:,:,1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1, & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) + + ecopy(:,:,:, 1:size(a,4)-staggered_lhalo-staggered_uhalo) = & + a(:,:,size(a,3)-staggered_uhalo-staggered_lhalo+1:size(a,3)-staggered_uhalo, & + 1+staggered_lhalo:size(a,4)-staggered_uhalo) + + a(:,:, size(a,3)-staggered_uhalo+1:size(a,3), 1+staggered_lhalo:size(a,4)-staggered_uhalo) = & + wcopy(:,:,:, 1:size(a,4)-staggered_lhalo-staggered_uhalo) + + a(:,:, 1:staggered_lhalo, 1+staggered_lhalo:size(a,4)-staggered_uhalo) = & + ecopy(:,:,:, 1:size(a,4)-staggered_lhalo-staggered_uhalo) + + scopy(:,:,:,:) = a(:,:,:, 1+staggered_lhalo:1+staggered_lhalo+staggered_uhalo-1) + ncopy(:,:,:,:) = a(:,:,:, size(a,4)-staggered_uhalo-staggered_lhalo+1:size(a,4)-staggered_uhalo) + + a(:,:,:,size(a,4)-staggered_uhalo+1:size(a,4)) = scopy(:,:,:,:) + a(:,:,:,1:staggered_lhalo) = ncopy(:,:,:,:) + + end subroutine staggered_parallel_halo_real8_4d + +end module parallel diff --git a/components/cism/glimmer-cism/libglimmer/profile.F90 b/components/cism/glimmer-cism/libglimmer/profile.F90 new file mode 100644 index 0000000000..7934a3a44c --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/profile.F90 @@ -0,0 +1,218 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! profile.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> module for profiling programs +!! \author Magnus Hagdorn +!! \date January 2005 +module profile + +#if (defined CCSMCOUPLED || defined CESMTIMERS) + use perf_mod + use parallel +#endif + + use glimmer_global, only: dp + implicit none + +#if (defined CCSMCOUPLED || defined CESMTIMERS) + logical, public :: output_thispe = .false. +#endif + + integer, private :: current_unit = 200 + integer, private,parameter :: max_prof = 100 + + !> the profiling type + type profile_type + integer :: profile_unit=0 !< file unit to be written to + real(dp) :: start_time !< CPU time at start of log + integer :: nump=0 !< number of profiles + + real(dp), dimension(max_prof) :: pstart,ptotal !< for each log store start and totals + character(len=50), dimension(max_prof) :: pname !< name for each profile + end type profile_type + +contains + + !> initialise a profile + subroutine profile_init(prof,name) + implicit none + type(profile_type), intent(out) :: prof !< structure storing profile definitions + character(len=*), intent(in) :: name !< name of file + ! local variables + character(len=8) :: date + character(len=10) :: time + + prof%profile_unit = current_unit + current_unit = current_unit + 1 +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + prof%pstart(:) = 0. + prof%ptotal(:) = 0. + call cpu_time(prof%start_time) + call date_and_time (date, time) + open(unit=prof%profile_unit,file=name,status='unknown') + write(unit=prof%profile_unit,fmt="(a,a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6)") '# Started profile on ',& + date(1:4),date(5:6),date(7:8),time(1:2),time(3:4),time(5:10) +#endif + +#if (! defined CCSMCOUPLED && defined CESMTIMERS) + call t_initf("perf_in", mpicom=comm, MasterTask=main_task) +#endif + end subroutine profile_init + + !> register a new series of meassurements + function profile_register(prof,msg) + use glimmer_log + implicit none + type(profile_type) :: prof !< structure storing profile definitions + character(len=*), intent(in) :: msg !< the message to be associated + integer profile_register + + prof%nump = prof%nump+1 + if (prof%nump > max_prof) then + call write_log('Maximum number of profiles reached',type=GM_FATAL, & + file=__FILE__,line=__LINE__) + end if + profile_register = prof%nump + prof%pname(prof%nump) = trim(msg) + end function profile_register + + !> start profiling + subroutine profile_start(prof,profn) + implicit none + type(profile_type) :: prof !< structure storing profile definitions + integer, intent(in) :: profn !< the profile ID + +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + call cpu_time(prof%pstart(profn)) +#endif + +#if (defined CCSMCOUPLED || defined CESMTIMERS) + call t_startf(prof%pname(profn)) +#endif + end subroutine profile_start + + !> stop profiling + subroutine profile_stop(prof,profn) + implicit none + type(profile_type) :: prof !< structure storing profile definitions + integer, intent(in) :: profn !< the profile ID + +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + real(dp) :: t + + call cpu_time(t) + prof%ptotal(profn) = prof%ptotal(profn) + t-prof%pstart(profn) +#endif + +#if (defined CCSMCOUPLED || defined CESMTIMERS) + call t_stopf(prof%pname(profn)) +#endif + end subroutine profile_stop + + !> log a message to profile + subroutine profile_log(prof,profn,msg) + implicit none + type(profile_type) :: prof !< structure storing profile definitions + integer, intent(in) :: profn !< the profile ID + character(len=*), intent(in), optional :: msg !< message to be written to profile + +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + real(dp) :: t + + call cpu_time(t) + if (present(msg)) then + write(prof%profile_unit,*) t-prof%start_time,prof%ptotal(profn),profn,trim(msg)//' '//trim(prof%pname(profn)) + else + write(prof%profile_unit,*) t-prof%start_time,prof%ptotal(profn),profn,trim(prof%pname(profn)) + end if + prof%ptotal(profn) = 0. + prof%pstart(profn) = 0. +#endif + end subroutine profile_log + + !> close profile + subroutine profile_close(prof) + implicit none + type(profile_type), intent(in) :: prof !< structure storing profile definitions +#if (defined PROFILING && ! defined CCSMCOUPLED && ! defined CESMTIMERS) + ! local variables + character(len=8) :: date + character(len=10) :: time + real(dp) :: t + + call cpu_time(t) + call date_and_time (date, time) + write(prof%profile_unit,*) '# total elapse cpu time: ',t-prof%start_time + write(unit=prof%profile_unit,fmt="(a,a4,'-',a2,'-',a2,' ',a2,':',a2,':',a6)") '# Finished profile on ',& + date(1:4),date(5:6),date(7:8),time(1:2),time(3:4),time(5:10) + close(prof%profile_unit) +#endif + +#if (! defined CCSMCOUPLED && defined CESMTIMERS) + integer :: ewrank, nsrank, nstasks + + ! Sample performance data from process in middle of + ! computational domain + ewrank = mod(this_rank,ProcsEW) + nsrank = this_rank/ProcsEW + nstasks = tasks/ProcsEW + if ((ewrank .eq. (ProcsEW+1)/2) .and. (nsrank .eq. (nstasks+1)/2)) then + call t_prf('cism_timing', num_outpe=1, global_stats=.true., & + output_thispe=.true.) + else + call t_prf('cism_timing', num_outpe=1, global_stats=.true.) + endif + + call t_finalizef () +#endif + end subroutine profile_close + +#if (! defined CCSMCOUPLED && ! defined CESMTIMERS) + subroutine t_startf(event, handle) + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + character(len=*), intent(in) :: event + integer(shr_kind_i8), optional :: handle + return + end subroutine t_startf + + subroutine t_stopf(event, handle) + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + character(len=*), intent(in) :: event + integer(shr_kind_i8), optional :: handle + return + end subroutine t_stopf + + subroutine t_adj_detailf(detail_adjustment) + integer, intent(in) :: detail_adjustment + return + end subroutine t_adj_detailf +#endif + +end module profile diff --git a/components/cism/glimmer-cism/libglimmer/writestats.c b/components/cism/glimmer-cism/libglimmer/writestats.c new file mode 100644 index 0000000000..9bf384cf91 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/writestats.c @@ -0,0 +1,129 @@ +/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + + + + writestats.c - part of the CISM ice model + + + + + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + Copyright (C) 2009, 2010 + CISM contributors - see AUTHORS file for list of contributors + + This file is part of CISM. + + CISM is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 2 of the License, or (at + your option) any later version. + + CISM is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with CISM. If not, see . + + CISM is hosted on BerliOS.de: + https://developer.berlios.de/projects/glimmer-cism/ + + +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ + +#include "writestats.h" +#include "config.inc" + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + + +#define CFG_LEN 35 +#define BUFFER_LEN 400 +#define PERM_FILE (S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH) + +void FC_FUNC(gf_writestats,GF_WRITESTATS) (const char *resname, const char *cfgname, double wallTime) +{ + struct tms runtime; + clock_t clck; + double userTime,sysTime; + time_t now; + struct tm * timeAndDate; + char dateStr[20]; + struct utsname unameData; + char outBuffer[BUFFER_LEN+1]; + char hdrBuffer[BUFFER_LEN+1]; + int fd; + int i,haveLock; + struct flock fl = { F_WRLCK, SEEK_SET, 0, 0, 0 }; + off_t fileLength; + + /* Jeff: Trim the file name on Jaguar, because spaces are embedded otherwise. */ + char resfname[CFG_LEN+1]; + strncpy(resfname, resname, CFG_LEN); + i = 0; + while (isalnum(resfname[i]) && i < CFG_LEN) i++; + resfname[i] = '\0'; + + /* get user and system time */ + clck = times(&runtime); + userTime = ((double) runtime.tms_utime)/((double) sysconf(_SC_CLK_TCK)); + sysTime = ((double) runtime.tms_stime)/((double) sysconf(_SC_CLK_TCK)); + + /* get the current data */ + now = time(NULL); + timeAndDate = localtime(&now); + snprintf(dateStr,20,"%4d-%02d-%02d_%02d:%02d",timeAndDate->tm_year+1900, timeAndDate->tm_mon+1, timeAndDate->tm_mday, timeAndDate->tm_hour, timeAndDate->tm_min); + + /* get host name and architecture */ + if ((uname(&unameData))!=0) { + unameData.nodename[0]='\0'; + unameData.machine[0]='\0'; + } + + /* construct output line */ + snprintf(outBuffer,BUFFER_LEN,"%*s %9.2f %9.2f %8.2f %s %-10s %-6s %-10s \"%s\"\n",-CFG_LEN,cfgname, wallTime, userTime, sysTime, dateStr, \ + unameData.nodename, unameData.machine, VERSION, GLIMMER_FCFLAGS); + snprintf(hdrBuffer,BUFFER_LEN,"%*s %9s %9s %-8s %-16s %-10s %-6s %-10s %s\n",-CFG_LEN,"#cfg_file","wall_time","usr_time","sys_time","date","host","arch","version","FCFLAGS"); + + /* open output file */ + if ((fd = open(resfname, O_CREAT|O_WRONLY|O_SYNC,PERM_FILE)) == -1) { + perror("opening result file"); + printf("%s\n",outBuffer); + return; + } + + /* get a lock on the file */ + i=0; + while ((haveLock=fcntl(fd, F_SETLK, &fl))==-1 && i<100000) i++; + if (haveLock==-1) { + close(fd); + perror("getting lock"); + printf("%s\n",outBuffer); + return; + } + + /* go to the end of the file */ + fileLength = lseek(fd,0,SEEK_END); + + /* write data */ + if (fileLength == 0) + write(fd,hdrBuffer,strlen(hdrBuffer)); + write(fd,outBuffer,strlen(outBuffer)); + + /* release the lock */ + fl.l_type = F_UNLCK; + if (fcntl(fd, F_SETLK, &fl) == -1) { + perror("unlocking file"); + return; + } + + close(fd); + + return; +} diff --git a/components/cism/glimmer-cism/libglimmer/writestats.h b/components/cism/glimmer-cism/libglimmer/writestats.h new file mode 100644 index 0000000000..ea9494fbd3 --- /dev/null +++ b/components/cism/glimmer-cism/libglimmer/writestats.h @@ -0,0 +1,14 @@ +/** \brief write model run statistics to file + * + * \author Magnus Hagdorn + * \date April 2009 + * + * \param resname name of the output result file + * \param cfgname name of the model configuration file + * \param time the elapsed wall clock time in seconds + * + * open statistics file (create it if it does not exist), gather info + * from environment and write to file. + * The file gets locked to avoid parallel access + */ +void gc_writestats(const char *resname, const char *cfgname, double wallTime); diff --git a/components/cism/glimmer-cism/libglint/README.parallelization b/components/cism/glimmer-cism/libglint/README.parallelization new file mode 100644 index 0000000000..e40a6b9499 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/README.parallelization @@ -0,0 +1,101 @@ +------------------------------------------------------------------------ +Notes on parallelization of libglint + + Bill Sacks + Jan 15, 2013 +------------------------------------------------------------------------ + +The challenge in making glint parallel-capable is in doing the +interpolations between the global (land) grid and the decomposed +icesheet grid. + +The goal in parallelizing glint is NOT to make it work WELL, but just +to make it work, in the context of CESM runs (which use the smb +scheme, not the pdd scheme). Thus, for things needed for CESM +coupling, I have modified glint to make it parallel-capable, but in a +non-ideal way: the main task does all of the regridding, with the +necessary gathers / scatters. + +For callers of glint routines, it is important to keep in mind that +many of the output variables are only valid on the main +task. Similarly, initialise_glint should be called with 0-size lats & +longs for all but the main task. + +Some particular design items to note: + + - All variables on the global (land) grid are valid only on the main + task. It is especially important for callers of the glint routines + to keep this in mind: many of the output variables are only valid on + the main task. + + - In many cases, global (land) grid variables still exist on other + tasks, but have size 0. For example, all tasks still call + new_global_grid and do array allocations, but they allocate + arrays of size 0. This was done to minimize the code changes + needed to support parallelization. + + - In general, glint variables on the icesheet grid have remained + unchanged: these variables stay on the task's own portion of the + icesheet grid + + - For upscaling & downscaling: new, temporary variables are created on + the main task, which span the full icesheet domain + + - Before a call to an upscaling routine, a distributed_gather call is + done to fill new, temporary variables on the main task that apply + over the whole domain + + - Downscaling is done to new, temporary variables on the main + task. After downscaling, a distributed_scatter call is done. + + + + +Some parts of glint that (I believe) are not currently needed for CESM +coupling are not yet parallel-capable. I have added checks (which look +like: 'if (tasks > 1)') in a few places, but probably not all. + +Some things that almost certainly won't work right in a parallel +environment are: + + - glint_remove_bath, in glint_timestep.F90. + + - flow_router, from glimmer_routing.F90. + + - interp_wind_to_local. + + - a number of output arguments that are not used for the smb + option, which give the domain-sum of a field + +Some other things that might not work right are: + + - mean_to_local + + - pointwise_to_global + + - output of inmask (which uses the downs variable, which is only + valid on the main task) + + +Note that there may be other things that don't work right in a +parallel environment in addition to those in the above lists. + + + +------------------------------------------------------------------------ +Alternative design (rejected) +------------------------------------------------------------------------ + +I also considered an alternative design, where all tasks have copies +of the global (land) data. For sending data from the land model to +CISM, all tasks would have a copy of the land data, and do their own +downscaling to their locally-owned grid. For sending data from CISM to +the land model, each task would do its own upscaling, then at a higher +level (in the source_glc code in CESM), we would do a final merge of +the locally-owned land grids onto a final land grid that is the merge. + +However, I rejected this design mainly because of the large memory +requirement of having the global (land) variables replicated on all +tasks. Minimizing this memory use would introduce more complexity than +I wanted at the moment. + diff --git a/components/cism/glimmer-cism/libglint/glint_anomcouple.F90 b/components/cism/glimmer-cism/libglint/glint_anomcouple.F90 new file mode 100644 index 0000000000..9743d29ff8 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_anomcouple.F90 @@ -0,0 +1,370 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_anomcouple.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_anomcouple + + !> This module provides code to handle anomaly coupling. Although + !> written for use with GLINT, it has general applicability. Temperature coupling + !> is done linearly, precipitation proportionally. + + use glimmer_global, only: dp, fname_length, msg_length + use glimmer_ncdf, only: nc_errorhandle !EIB! from lanl + + implicit none + + character(9),dimension(5),parameter :: xvars=(/ & + 'longitude', & + 'lon ', & + 'x0 ', & + 'x1 ', & + 'x '/) + character(8),dimension(5),parameter :: yvars=(/ & + 'latitude', & + 'lat ', & + 'y0 ', & + 'y1 ', & + 'y '/) + character(4),dimension(1),parameter :: tvars=(/ & + 'time'/) + + type anomaly_coupling + logical :: enabled = .false. + character(fname_length) :: fname_reference !> File containing reference climate + character(fname_length) :: fname_modelclim !> File containing mean model climate + integer :: nslices !> Number of time-slices in climatologies + real(dp),dimension(:,:,:),pointer :: temp_ref => null() !> Reference climate (temperature) + real(dp),dimension(:,:,:),pointer :: temp_mod => null() !> Model climate (temperature) + real(dp),dimension(:,:,:),pointer :: prcp_ref => null() !> Reference climate (precip) + real(dp),dimension(:,:,:),pointer :: prcp_mod => null() !> Model climate (precip) + real(dp),dimension(:) ,pointer :: time => null() !> Time axis (fraction of year) + integer :: nx,ny !> Grid dimensions (for convenience) + character(20) :: pvarname_ref='prcp ' + character(20) :: tvarname_ref='artm ' + character(20) :: pvarname_mod='prcp ' + character(20) :: tvarname_mod='artm ' + logical :: mult_precip = .false. !> set true if we're multiplying precip + end type anomaly_coupling + + private + public :: anomaly_coupling, anomaly_init, anomaly_calc + +contains + + subroutine anomaly_init(params,config) + + use glimmer_config + + type(anomaly_coupling),intent(out) :: params !> Parameters to be initialised + type(ConfigSection),pointer :: config !> Configuation file + + call anomaly_readconfig(params,config) + if (params%enabled) then + call anomaly_readdata(params) + call anomaly_printconfig(params) + end if + + end subroutine anomaly_init + + !------------------------------------------------------------------------------------------ + + subroutine anomaly_calc(params,time,rawtemp,rawprcp,anomtemp,anomprcp) + + type(anomaly_coupling),intent(in) :: params !> Parameters to be initialised + real(dp) :: time + real(dp),dimension(:,:),intent(in) :: rawtemp, rawprcp + real(dp),dimension(:,:),intent(out) :: anomtemp,anomprcp + + real(dp),dimension(size(rawtemp,1),size(rawtemp,2)) :: tempm,prcpm,tempr,prcpr + integer :: first + real(dp) :: frac + integer :: i,j + + if (params%enabled) then + call anomaly_index(params%time,time,first,frac) + tempm=(1.0-frac)*params%temp_mod(:,:,first)+frac*params%temp_mod(:,:,first+1) + prcpm=(1.0-frac)*params%prcp_mod(:,:,first)+frac*params%prcp_mod(:,:,first+1) + tempr=(1.0-frac)*params%temp_ref(:,:,first)+frac*params%temp_ref(:,:,first+1) + prcpr=(1.0-frac)*params%prcp_ref(:,:,first)+frac*params%prcp_ref(:,:,first+1) + anomtemp=rawtemp-tempm+tempr + if (params%mult_precip) then + do i=1,size(anomprcp,1) + do j=1,size(anomprcp,2) + if (prcpm(i,j)/=0.d0) then + anomprcp(i,j)=rawprcp(i,j)*prcpr(i,j)/prcpm(i,j) + else if (rawprcp(i,j)==0.d0) then + anomprcp(i,j)=prcpr(i,j) + else if (prcpr(i,j)==0.d0) then + anomprcp(i,j)=rawprcp(i,j) + else + anomprcp(i,j)=0.d0 + end if + end do + end do + else + anomprcp=max(rawprcp-prcpm+prcpr,0.d0) + end if + else + anomprcp=rawprcp + anomtemp=rawtemp + end if + + end subroutine anomaly_calc + + !------------------------------------------------------------------------------------------ + ! PRIVATE subroutines + !------------------------------------------------------------------------------------------ + + subroutine anomaly_readconfig(params,config) + + use glimmer_config + + type(anomaly_coupling),intent(out) :: params !> Parameters to be initialised + type(ConfigSection),pointer :: config !> Configuation file + + ! local variables + type(ConfigSection), pointer :: section + integer :: mprcp + + call GetSection(config,section,'anomaly coupling') + + if (associated(section)) then + mprcp = 0 + call GetValue(section,'reference',params%fname_reference) + call GetValue(section,'model', params%fname_modelclim) + call GetValue(section,'precipvar_ref', params%pvarname_ref) + call GetValue(section,'precipvar_model',params%pvarname_mod) + call GetValue(section,'tempvar_ref', params%tvarname_ref) + call GetValue(section,'tempvar_model', params%tvarname_mod) + call GetValue(section,'multiply_precip',mprcp) + if (mprcp==1) params%mult_precip=.true. + params%enabled = .true. + else + params%enabled = .false. + end if + + end subroutine anomaly_readconfig + + !------------------------------------------------------------------------------------------ + + subroutine anomaly_printconfig(params) + + use glimmer_log + + type(anomaly_coupling),intent(inout) :: params !> Parameters to be initialised + character(len=msg_length) :: message + + call write_log_div + + call write_log('Anomaly coupling') + call write_log("----------------") + write(message,*)" Reference climate:",trim(params%fname_reference) + call write_log(message) + write(message,*)" Variables: ",trim(params%tvarname_ref),', ',trim(params%pvarname_ref) + call write_log(message) + write(message,*)" Model climate: ",trim(params%fname_modelclim) + call write_log(message) + write(message,*)" Variables: ",trim(params%tvarname_mod),', ',trim(params%pvarname_mod) + call write_log(message) + write(message,*)" Number of slices: ",params%nslices + call write_log(message) + call write_log("") + + end subroutine anomaly_printconfig + + !------------------------------------------------------------------------------------------ + + subroutine anomaly_readdata(params) + + use glimmer_log + + type(anomaly_coupling),intent(inout) :: params !> Parameters to be initialised + + integer,dimension(4) :: nx,ny,nt + real(dp),dimension(:),pointer :: timemod => null() + real(dp),dimension(:),pointer :: timeref => null() + + call anomaly_readnc(params%fname_reference,params%pvarname_ref,params%prcp_ref,timeref,nx(1),ny(1),nt(1)) + call anomaly_readnc(params%fname_reference,params%tvarname_ref,params%temp_ref,timeref,nx(2),ny(2),nt(2)) + call anomaly_readnc(params%fname_modelclim,params%pvarname_mod,params%prcp_mod,timemod,nx(3),ny(3),nt(3)) + call anomaly_readnc(params%fname_modelclim,params%tvarname_mod,params%temp_mod,timemod,nx(4),ny(4),nt(4)) + + if (any(nx(1)/=nx(2:4)).or.any(ny(1)/=ny(2:4)).or.any(nt(1)/=nt(2:4))) & + call write_log("Anomaly coupling: sizes of arrays in climate files do not agree", & + GM_FATAL,__FILE__,__LINE__) + + params%nx=nx(1) + params%ny=ny(1) + params%nslices=nt(1) + + if (.not.all(abs(timemod-timeref)<1e-8)) & + call write_log("Anomaly coupling: time axes in climate files do not agree",GM_FATAL,__FILE__,__LINE__) + + if (associated(params%time)) then + deallocate(params%time) + params%time => null() + end if + allocate(params%time(params%nslices+2)) + + params%time=timemod + + end subroutine anomaly_readdata + + !------------------------------------------------------------------------------------------ + + subroutine anomaly_readnc(fname,varname,data,timeaxis,nx,ny,nt) + + use netcdf + use glimmer_log + use glimmer_filenames + + character(*), intent(in) :: fname + character(*), intent(in) :: varname + real(dp),dimension(:,:,:),pointer :: data + real(dp),dimension(:), pointer :: timeaxis + integer, intent(out) :: nx,ny,nt + + ! Local variables + integer :: status, ncid, varid, tvarid, ndims, i + integer,dimension(3) :: dimids + character(30) :: dntemp,timevar + real(dp) :: interval + + ! Open file + !EIB lanl!status=nf90_open(process_path(fname),NF90_NOWRITE,ncid) + status=nf90_open(filenames_inputname(process_path(fname)),NF90_NOWRITE,ncid) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Look for required variable + status=nf90_inq_varid(ncid,varname,varid) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Check we have three dimensions + status=nf90_inquire_variable(ncid,varid,ndims=ndims) + call nc_errorhandle(__FILE__,__LINE__,status) + if (ndims/=3) call write_log("Anomaly coupling: file "//trim(process_path(fname))//", variable "// & + trim(varname)//" should have three dimensions",GM_FATAL,__FILE__,__LINE__) + status=nf90_inquire_variable(ncid,varid,dimids=dimids) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Check we have some sensible dimension names in the right order: + ! must be x,y,t (this is t,y,x in netcdf-speak...) + + status=nf90_inquire_dimension(ncid,dimids(1),dntemp,nx) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.any(dntemp==xvars)) & + call write_log("Anomaly coupling: first dimension in climate file "//trim(process_path(fname))// & + " is not x or longitude",GM_FATAL,__FILE__,__LINE__) + + status=nf90_inquire_dimension(ncid,dimids(2),dntemp,ny) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.any(dntemp==yvars)) & + call write_log("Anomaly coupling: second dimension in climate file "//trim(process_path(fname))// & + " is not y or latitude",GM_FATAL,__FILE__,__LINE__) + + status=nf90_inquire_dimension(ncid,dimids(3),dntemp,nt) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.any(dntemp==tvars)) & + call write_log("Anomaly coupling: third dimension in climate file "//trim(process_path(fname))// & + " is not time",GM_FATAL,__FILE__,__LINE__) + timevar=dntemp + + ! If we've got this far, we can retrieve the data itself + + if (associated(data)) then + deallocate(data) + data => null() + end if + allocate(data(nx,ny,nt+2)) + + status=nf90_get_var(ncid,varid,data(:,:,2:nt+1)) + call nc_errorhandle(__FILE__,__LINE__,status) + + data(:,:,1) =data(:,:,nt+1) + data(:,:,nt+2)=data(:,:,2) + + ! Now we try and get the time data + + if (associated(timeaxis)) then + deallocate(timeaxis) + timeaxis => null() + end if + allocate(timeaxis(nt+2)) + + status=nf90_inq_varid(ncid,timevar,tvarid) + select case (status) + case(NF90_NOERR) + status=nf90_get_var(ncid,tvarid,timeaxis(2:nt+1)) + call nc_errorhandle(__FILE__,__LINE__,status) + case(NF90_ENOTVAR) + ! Time variable not found - construct our own + interval=1.0/real(nt) + do i=1,nt + timeaxis(i+1)=(i-1)*interval+interval/2.0 + end do + call write_log('Anomaly coupling: Created time-axis') + case default + ! Some other error - bail out + call nc_errorhandle(__FILE__,__LINE__,status) + end select + + ! Fix up time boundaries + timeaxis(1) =-1.0+timeaxis(nt+1) + timeaxis(nt+2)=1.0+timeaxis(2) + + ! Close the file + status=nf90_close(ncid) + call nc_errorhandle(__FILE__,__LINE__,status) + + end subroutine anomaly_readnc + + subroutine anomaly_index(timeaxis,time,first,frac) + + use glimmer_log + + real(dp),dimension(:),intent(in) :: timeaxis + real(dp), intent(in) :: time + integer, intent(out) :: first + real(dp), intent(out) :: frac + + first=1 + do + if (time >= timeaxis(first) .and. time < timeaxis(first+1)) then + frac = (time-timeaxis(first)) / (timeaxis(first+1)-timeaxis(first)) + exit + endif + first = first+1 + if (first==size(timeaxis)) then + call write_log("Anomaly coupling: Problem indexing time-slices",GM_FATAL,__FILE__,__LINE__) + end if + end do + + end subroutine anomaly_index + +end module glint_anomcouple diff --git a/components/cism/glimmer-cism/libglint/glint_commandline.F90 b/components/cism/glimmer-cism/libglint/glint_commandline.F90 new file mode 100644 index 0000000000..5738e2b230 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_commandline.F90 @@ -0,0 +1,160 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_commandline.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include "config.inc" + +#ifdef HAVE_2003ARGS +#define NARGS command_argument_count() +#define GETARG get_command_argument +#else +#define NARGS iargc +#define GETARG getarg +#endif + + +module glint_commandline + + use glimmer_global, only:fname_length + + implicit none + + character(len=5000) :: commandline_history !< complete command line + character(len=fname_length) :: commandline_configname !< name of the configuration file + character(len=fname_length) :: commandline_resultsname !< name of results file + character(len=fname_length) :: commandline_climatename !< name of climate configuration file + +contains + + !> get the command line and parse it + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glint_GetCommandline() + implicit none + + integer numargs,nfiles + integer :: i +#ifndef HAVE_2003ARGS + integer, external :: iargc +#endif + character(len=100) :: argument + integer, dimension(100) :: argumentIdx + + ! defaults + commandline_resultsname = 'results' + + ! get number of arguments and file names + numargs = NARGS + ! reconstruct command line to store commandline_history + call GETARG(0,commandline_history) + do i=1,numargs + call GETARG(i,argument) + commandline_history = trim(commandline_history)//" "//trim(argument) + end do + + if (numargs > 0) then + i=0 + nfiles = 0 + ! loop over command line arguments + do while (i < numargs) + i = i + 1 + call GETARG(i,argument) + ! check if it is an option + if (argument(1:1) == '-') then + select case (trim(argument)) + case ('-h') + call glint_commandlineHelp() + stop + case ('-r') + i = i+1 + if (i > numargs) then + write(*,*) 'Error, expect name of output file to follow -o option' + call glint_commandlineHelp() + stop + end if + call GETARG(i,commandline_resultsname) + case default + write(*,*) 'Unkown option ',trim(argument) + call glint_commandlineHelp() + stop + end select + else + ! it's not an option + nfiles = nfiles+1 + argumentIdx(nfiles) = i + end if + end do + if (numargs >= 1) then + call GETARG(1,commandline_configname) + if (numargs > 1) then + ! call GETARG(1,commandline_configname) + call GETARG(2,commandline_climatename) + endif + else + write(*,*) 'Need at least one argument' + call glint_commandlineHelp() + stop + end if + else + write(*,*) 'Enter name of climate configuration file' + read(*,'(a)') commandline_climatename + write(*,*) 'Enter name of GLIDE configuration file to be read' + read(*,'(a)') commandline_configname + end if + end subroutine glint_GetCommandline + + !> print out command line + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glint_PrintCommandline() + implicit none + + write(*,*) 'Entire commandline' + write(*,*) trim(commandline_history) + write(*,*) + write(*,*) 'commandline_climatename: ',trim(commandline_climatename) + write(*,*) 'commandline_configname: ', trim(commandline_configname) + write(*,*) 'commandline_resultsname: ', trim(commandline_resultsname) + end subroutine glint_PrintCommandline + + !> print help message + !! + !! \author Magnus Hagdorn + !! \date April 2009 + subroutine glint_commandlineHelp() + implicit none + character(len=500) :: pname + + call GETARG(0,pname) + + write(*,*) 'Usage: ',trim(pname),' [options] climname cfgname' + write(*,*) 'where [options] are' + write(*,*) ' -h: this message' + write(*,*) ' -r : the name of the results file (default: results)' + end subroutine glint_commandlineHelp +end module glint_commandline + diff --git a/components/cism/glimmer-cism/libglint/glint_daily_pdd.F90 b/components/cism/glimmer-cism/libglint/glint_daily_pdd.F90 new file mode 100644 index 0000000000..c583bff95c --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_daily_pdd.F90 @@ -0,0 +1,399 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_daily_pdd.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_daily_pdd + + ! The daily PDD model. + ! N.B. all quantities, inputs and outputs are in m water equivalent. + ! PDD factors are no longer converted to ice equivalent. + + use glimmer_global, only: dp + use glimmer_physcon, only: pi,scyr,rhow,rhoi + + implicit none + + type glint_daily_pdd_params + + ! Holds parameters for daily positive-degree-day mass-balance + ! calculation. + + real(dp) :: wmax = 0.6d0 ! Fraction of firn that must be ice before run-off occurs + real(dp) :: pddfac_ice = 0.008d0 ! PDD factor for ice (m water day$^{-1}$ $^{\circ}C$^{-1}$) + real(dp) :: pddfac_snow = 0.003d0 ! PDD factor for snow (m water day$^{-1}$ $^{\circ}C$^{-1}$) + real(dp) :: rain_threshold = 1.d0 ! Threshold for precip melting (degC) + integer :: whichrain = 1 ! method for determining whether precip is rain or snow + real(dp) :: tau0 = 10.d0*scyr ! Snow densification timescale (seconds) + real(dp) :: constC = 0.0165d0 ! Snow density profile factor C (m$^{-1}$) + real(dp) :: firnbound = 0.872d0 ! Ice-firn boundary as fraction of density of ice + real(dp) :: snowdensity = 300.d0 ! Density of fresh snow ($\mathrm{kg}\,\mathrm{m}^{-3}$) + real(dp) :: tstep = 24.d0*60.d0*60.d0 ! Scheme time-step (seconds) + real(dp) :: a1,a2,a3 ! Factors for relaxation of depth + + end type glint_daily_pdd_params + + real(dp),parameter :: one_over_pi=1.d0/pi + + private + public :: glint_daily_pdd_params, glint_daily_pdd_init, glint_daily_pdd_mbal + +contains + + subroutine glint_daily_pdd_init(params,config) + + use glimmer_physcon, only : rhow, rhoi + use glimmer_config + + type(glint_daily_pdd_params) :: params + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! Read the config file and output to log + + call daily_pdd_readconfig(params,config) + call daily_pdd_printconfig(params) + + params%a1 = params%tstep/params%tau0 + params%a2 = 1.d0 - params%a1/2.d0 + params%a3 = 1.d0 + params%a1/2.d0 + + end subroutine glint_daily_pdd_init + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine daily_pdd_readconfig(params,config) + + ! Reads in configuration data for the daily PDD scheme. + + use glimmer_config + + type(glint_daily_pdd_params),intent(inout) :: params ! The positive-degree-day parameters + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + real(dp) :: tau0 + + tau0 = params%tau0/scyr + + call GetSection(config,section,'GLINT daily pdd') + if (associated(section)) then + call GetValue(section,'wmax',params%wmax) + call GetValue(section,'pddfac_ice',params%pddfac_ice) + call GetValue(section,'pddfac_snow',params%pddfac_snow) + call GetValue(section,'rain_threshold',params%rain_threshold) + call GetValue(section,'whichrain',params%whichrain) + call GetValue(section,'tau0',tau0) + call GetValue(section,'constC',params%constC) + call GetValue(section,'firnbound',params%firnbound) + call GetValue(section,'snowdensity',params%snowdensity) + end if + + params%tau0 = tau0*scyr + + end subroutine daily_pdd_readconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine daily_pdd_printconfig(params) + + use glimmer_log + + type(glint_daily_pdd_params),intent(inout) :: params ! The positive-degree-day parameters + character(len=100) :: message + + call write_log_div + + call write_log('GLINT daily PDD Scheme parameters:') + call write_log('-----------------------------------') + write(message,*) 'Snow refreezing fraction',params%wmax + call write_log(message) + write(message,*) 'PDD factor for ice',params%pddfac_ice + call write_log(message) + write(message,*) 'PDD factor for snow',params%pddfac_snow + call write_log(message) + write(message,*) 'Rain threshold temperature',params%rain_threshold,' degC' + call write_log(message) + write(message,*) 'Rain/snow partition method',params%whichrain + call write_log(message) + write(message,*) 'Snow densification time-scale',params%tau0/scyr,' years' + call write_log(message) + write(message,*) 'Snow density equilibrium profile factor',params%constC,' m^-1' + call write_log(message) + write(message,*) 'Ice-firn boundary as fraction of density of ice',params%firnbound + call write_log(message) + write(message,*) 'Density of fresh snow',params%snowdensity,'kg m^-3' + call write_log(message) + call write_log('') + + end subroutine daily_pdd_printconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_daily_pdd_mbal(params,artm,arng,prcp,snowd,siced,ablt,acab,landsea) + + type(glint_daily_pdd_params) :: params ! Daily PDD scheme parameters + real(dp),dimension(:,:),intent(in) :: artm ! Daily mean air-temperature ($^{\circ}$C) + real(dp),dimension(:,:),intent(in) :: arng ! Daily temperature half-range ($^{\circ}$C) + real(dp),dimension(:,:),intent(in) :: prcp ! Daily precipitation (m) + real(dp),dimension(:,:),intent(inout) :: snowd ! Snow depth (m) + real(dp),dimension(:,:),intent(inout) :: siced ! Superimposed ice depth (m) + real(dp),dimension(:,:),intent(out) :: ablt ! Daily ablation (m) + real(dp),dimension(:,:),intent(out) :: acab ! Daily mass-balance (m) + logical, dimension(:,:),intent(in) :: landsea ! Land-sea mask (land is TRUE) + + real(dp),dimension(size(prcp,1),size(prcp,2)) :: rain ! Daily rain + real(dp),dimension(size(prcp,1),size(prcp,2)) :: degd ! Degree-day + real(dp),dimension(size(prcp,1),size(prcp,2)) :: giced ! Temporary array for glacial ice + real(dp),dimension(size(prcp,1),size(prcp,2)) :: old_snow,old_sice + + integer :: nx,ny,i,j + + nx=size(prcp,1) ; ny=size(prcp,2) + + old_snow = snowd + old_sice = siced + + rain = rainorsnw(params%whichrain, & + artm, arng, prcp, & + params%rain_threshold) + degd = finddegdays(artm,arng) + giced = 0.d0 + + do i=1,nx + do j=1,ny + if (landsea(i,j)) then + call degdaymodel(params,snowd(i,j),siced(i,j),giced(i,j),degd(i,j),rain(i,j),prcp(i,j)) + acab(i,j) = snowd(i,j)+siced(i,j)+giced(i,j)-old_snow(i,j)-old_sice(i,j) + ablt(i,j) = max(prcp(i,j)-acab(i,j), 0.d0) + call firn_densify(params,snowd(i,j),siced(i,j)) + else + ablt(i,j) = prcp(i,j) + acab(i,j) = 0.d0 + snowd(i,j) = 0.d0 + siced(i,j) = 0.d0 + end if + end do + end do + + end subroutine glint_daily_pdd_mbal + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + elemental real(dp) function finddegdays(localartm,localarng) + + ! Finds the degree-day as a function of mean daily temperature and + ! half-range. The calculation is made on the assumption that + ! daily temperatures vary as $T = T_{0} - \Delta T * \cos(\theta)$. + + real(dp), intent(in) :: localartm ! Mean daily temperature (degC) + real(dp), intent(in) :: localarng ! Daily temperture half-range (degC) + + real(dp) :: time + + if (localartm - localarng > 0.d0) then + finddegdays = localartm + else if (localartm + localarng < 0.d0) then + finddegdays = 0.d0 + else + time = acos(localartm / localarng) + finddegdays = (localartm*(pi-time) + localarng*sin(time)) * one_over_pi + end if + + end function finddegdays + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + elemental real(dp) function rainorsnw(which,localartm,localarng,localprcp,threshold) + + ! Determines a value for snow precipitation, dependent on air temperature and half-range. + ! Takes precipitation as input and returns amount of rain. + + integer, intent(in) :: which ! Selects method of calculation + real(dp),intent(in) :: localartm ! Air temperature (degC) + real(dp),intent(in) :: localarng ! Temperature half-range (degC) + real(dp),intent(in) :: localprcp ! Precipitation (arbitrary units) + real(dp),intent(in) :: threshold ! Snow/rain threshold (degC) + + real(dp) :: acosarg + + select case(which) + + case(1) + + if (localarng == 0.d0) then + ! There is no sinusoidal variation + if (localartm > threshold) then + rainorsnw = localprcp + else + rainorsnw = 0.d0 + end if + else + ! Assume sinusoidal variation + acosarg = (localartm - threshold) / localarng + + if (acosarg <= -1.d0) then + rainorsnw = 0.d0 + else if (acosarg >= 1.d0) then + rainorsnw = localprcp + else + rainorsnw = localprcp * (1.d0 - one_over_pi * acos(acosarg)) + end if + + end if + + case default + + ! Just use mean temperature to determine if precip is snow or rain + + if (localartm > threshold) then + rainorsnw = localprcp + else + rainorsnw = 0.d0 + end if + + end select + + end function rainorsnw + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine degdaymodel(params,snowdepth,sicedepth,gicedepth,degd,rain,prcp) + + ! Applies the positive degree-day model. + ! The output of this subroutine is in the variables \texttt{snowdepth}, + ! \texttt{sicedepth}, and \texttt{gicedepth}, which give the new depths + ! of snow, superimposed ice and glacial ice, respectively. + + type(glint_daily_pdd_params) :: params ! PDD parameters + real(dp), intent(inout) :: snowdepth ! Snow depth (m) + real(dp), intent(inout) :: sicedepth ! Superimposed ice depth (m) + real(dp), intent(inout) :: gicedepth ! Glacial ice depth (m) + real(dp), intent(in) :: degd ! The degree-day (degC day) + real(dp), intent(in) :: prcp ! Total precip (m) + real(dp), intent(in) :: rain ! Rain (m) + + real(dp) :: potablt, wfrac, rfrez + + !------------------------------------------------------------------------- + ! Assume snowfall goes into snow, and rainfall goes into superimposed ice + + snowdepth = snowdepth + prcp - rain + sicedepth = sicedepth + rain + + ! Calculate amount of superimposed ice needed before runoff can occur: + ! a fraction of the total depth of the firn layer. + + wfrac = params%wmax * (snowdepth + sicedepth) + + ! Initial potential ablation of snow + + potablt = degd * params%pddfac_snow + + ! Calculate possible amount of refreezing. We need to do this to + ! take into account of the fact that there may already be more superimposed + ! ice than is required for runoff + + rfrez = max(0.d0, wfrac-sicedepth) + + ! Start off trying to ablate snow, and add it to superimposed ice + + if (potablt < snowdepth) then + + ! If we have enough snow to consume all potential ablation + ! Melt that amount of snow + snowdepth = snowdepth - potablt + + ! Refreeze up to the limit + sicedepth = sicedepth + min(potablt,rfrez) + + ! We've used all the potential ablation, so set to zero + potablt = 0.d0 + + else + + ! If there isn't enough snow to use all the potential ablation + ! Set potential ablation to what remains - we use this later. + ! For this section, the ablation is the whole snow depth. + potablt=potablt-snowdepth + + ! Refreeze up to the limit + sicedepth = sicedepth+min(snowdepth,rfrez) + + ! We've ablated all the snow, so set to zero + snowdepth = 0.d0 + + endif + + ! If we have any potential ablation left, use it to melt ice, + ! first from the firn, and then glacial ice + + if (potablt > 0.d0) then + potablt = params%pddfac_ice * (potablt - snowdepth) / params%pddfac_snow + if (potablt < sicedepth) then + sicedepth = sicedepth-potablt + else + potablt = potablt-sicedepth + sicedepth = 0.d0 + gicedepth = gicedepth-potablt + end if + end if + + end subroutine degdaymodel + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine firn_densify(params,snowdepth,sicedepth) + + type(glint_daily_pdd_params) :: params ! PDD parameters + real(dp), intent(inout) :: snowdepth ! Snow depth (m) + real(dp), intent(inout) :: sicedepth ! Superimposed ice depth (m) + + real(dp) :: fracice,fracsnow,firndepth,equfdepth,newdepth + + firndepth = snowdepth+sicedepth + fracice = sicedepth/firndepth + fracsnow = snowdepth/firndepth + + if (fracsnow /= 0.d0) then + equfdepth=(1.d0/(params%constC*rhow))*( & + rhoi*log((fracsnow*(rhoi-params%snowdensity))/(rhoi*(1.d0-params%firnbound))) & + +(fracice-params%firnbound)*rhoi+params%snowdensity*fracsnow) + else + equfdepth = -1.d0 + end if + + if (equfdepth >= 0.d0 .and. equfdepth < firndepth) then + newdepth = (params%a1*equfdepth+params%a2*firndepth)/params%a3 + snowdepth = fracsnow*newdepth + sicedepth = fracice*newdepth + end if + + end subroutine firn_densify + +end module glint_daily_pdd diff --git a/components/cism/glimmer-cism/libglint/glint_downscale.F90 b/components/cism/glimmer-cism/libglint/glint_downscale.F90 new file mode 100644 index 0000000000..a84e3243e7 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_downscale.F90 @@ -0,0 +1,369 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_downscale.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + + module glint_downscale + + ! This module contains subroutines for downscaling fields from the global to the local grid. + ! Much of the actual work is done at a lower level, in glint_interp.F90. + + use glint_type + use glad_constants + use glimmer_global, only: dp + + implicit none + + private + public glint_downscaling, glint_downscaling_gcm, & + glint_init_input_gcm, glint_accumulate_input_gcm, glint_average_input_gcm + + !Note: The three subroutines glint_*_input_gcm are based on old Glint subroutines + ! in glint_mbal_coupling.F90. + +contains + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_downscaling(instance, & + g_temp, g_temp_range, & + g_precip, g_orog, & + g_zonwind, g_merwind, & + g_humid, g_lwdown, & + g_swdown, g_airpress, & + orogflag) + + use glint_interp + + !> Downscale global input fields to the local ice sheet grid + + type(glint_instance) :: instance + real(dp),dimension(:,:),intent(in) :: g_temp !> Global mean surface temperature field ($^{\circ}$C) + real(dp),dimension(:,:),intent(in) :: g_temp_range !> Global surface temperature half-range field ($^{\circ}$C) + real(dp),dimension(:,:),intent(in) :: g_precip !> Global precip field total (mm) + real(dp),dimension(:,:),intent(in) :: g_orog !> Input global orography (m) + real(dp),dimension(:,:),intent(in) :: g_zonwind !> Global mean surface zonal wind (m/s) + real(dp),dimension(:,:),intent(in) :: g_merwind !> Global mean surface meridonal wind (m/s) + real(dp),dimension(:,:),intent(in) :: g_humid !> Global surface humidity (%) + real(dp),dimension(:,:),intent(in) :: g_lwdown !> Global downwelling longwave (W/m^2) + real(dp),dimension(:,:),intent(in) :: g_swdown !> Global downwelling shortwave (W/m^2) + real(dp),dimension(:,:),intent(in) :: g_airpress !> Global surface air pressure (Pa) + logical, intent(in) :: orogflag + + call interp_to_local(instance%lgrid_fulldomain, g_temp, instance%downs, localdp=instance%artm) + call interp_to_local(instance%lgrid_fulldomain, g_temp_range, instance%downs, localdp=instance%arng,z_constrain=.true.) + call interp_to_local(instance%lgrid_fulldomain, g_precip, instance%downs, localdp=instance%prcp,z_constrain=.true.) + + if (instance%whichacab==MASS_BALANCE_EBM) then + call interp_to_local(instance%lgrid_fulldomain, g_humid, instance%downs, localdp=instance%humid,z_constrain=.true.) + call interp_to_local(instance%lgrid_fulldomain, g_lwdown, instance%downs, localdp=instance%lwdown) + call interp_to_local(instance%lgrid_fulldomain, g_swdown, instance%downs, localdp=instance%swdown) + call interp_to_local(instance%lgrid_fulldomain, g_airpress,instance%downs, localdp=instance%airpress,z_constrain=.true.) + end if + + if (orogflag) call interp_to_local(instance%lgrid_fulldomain, g_orog, instance%downs, localdp=instance%global_orog, z_constrain=.true.) + + if (instance%whichprecip==PRECIP_RL .or. instance%whichacab==MASS_BALANCE_EBM) & + call interp_wind_to_local(instance%lgrid_fulldomain, g_zonwind, g_merwind, instance%downs, instance%xwind, instance%ywind) + + end subroutine glint_downscaling + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_downscaling_gcm (instance, & + qsmb_g, tsfc_g, & + topo_g, gmask) + + use glimmer_paramets, only: thk0, GLC_DEBUG + use glad_constants, only: lapse + use glint_type + use glint_interp, only: interp_to_local, copy_to_local + use glimmer_log + use parallel, only: tasks, main_task, this_rank + + ! Downscale global input fields from the global grid (with multiple elevation classes) + ! to the local ice sheet grid. + ! + ! This routine is used for downscaling when the surface mass balance is + ! computed in the GCM land surface model. + + type(glint_instance), intent(inout) :: instance + real(dp),dimension(:,:,0:),intent(in) :: qsmb_g ! Surface mass balance (m) + real(dp),dimension(:,:,0:),intent(in) :: tsfc_g ! Surface temperature (C) + real(dp),dimension(:,:,0:),intent(in) :: topo_g ! Surface elevation (m) + integer ,dimension(:,:), intent(in),optional :: gmask ! = 1 where global data are valid + ! = 0 elsewhere + real(dp), parameter :: maskval = 0.d0 ! value written to masked out gridcells + + integer :: nxl, nyl, nec ! local grid dimensions + + integer :: i, j, n + + real(dp), dimension(:,:,:), allocatable :: & + qsmb_l, &! interpolation of global mass balance to local grid + tsfc_l, &! interpolation of global sfc temperature to local grid + topo_l ! interpolation of global topography in each elev class to local grid + + real(dp) :: fact, usrf, thck + + nxl = instance%lgrid%size%pt(1) + nyl = instance%lgrid%size%pt(2) + nec = ubound(qsmb_g,3) + + allocate(qsmb_l(nxl,nyl,0:nec)) + allocate(tsfc_l(nxl,nyl,0:nec)) + allocate(topo_l(nxl,nyl,0:nec)) + + ! Downscale global fields for each elevation class to local grid (horizontal interpolation). + + if (present(gmask)) then ! set local field = maskval where the global field is masked out + ! (i.e., where instance%downs%lmask = 0) + do n = 1, nec + call interp_to_local(instance%lgrid_fulldomain, qsmb_g(:,:,n), instance%downs, localdp=qsmb_l(:,:,n), & + gmask = gmask, maskval=maskval) + call interp_to_local(instance%lgrid_fulldomain, tsfc_g(:,:,n), instance%downs, localdp=tsfc_l(:,:,n), & + gmask = gmask, maskval=maskval) + call interp_to_local(instance%lgrid_fulldomain, topo_g(:,:,n), instance%downs, localdp=topo_l(:,:,n), & + gmask = gmask, maskval=maskval) + enddo + + else ! global field values are assumed to be valid everywhere + do n = 1, nec + call interp_to_local(instance%lgrid_fulldomain, qsmb_g(:,:,n), instance%downs, localdp=qsmb_l(:,:,n)) + call interp_to_local(instance%lgrid_fulldomain, tsfc_g(:,:,n), instance%downs, localdp=tsfc_l(:,:,n)) + call interp_to_local(instance%lgrid_fulldomain, topo_g(:,:,n), instance%downs, localdp=topo_l(:,:,n)) + enddo + + endif ! gmask + + ! For elevation class 0 (bare land), simply set the values to the values of the + ! global parent cell. No vertical/horizontal interpolation is used, since these + ! elevation-dependent values are not constrained to a discrete elevation band. Also + ! note that we do not consider gmask here. + + call copy_to_local(instance%lgrid_fulldomain, qsmb_g(:,:,0), instance%downs, qsmb_l(:,:,0)) + call copy_to_local(instance%lgrid_fulldomain, tsfc_g(:,:,0), instance%downs, tsfc_l(:,:,0)) + + ! topo_l(:,:,0) isn't used right now, but compute it anyway for consistency + call copy_to_local(instance%lgrid_fulldomain, topo_g(:,:,0), instance%downs, topo_l(:,:,0)) + +! Interpolate tsfc and qsmb to local topography using values in the neighboring +! elevation classes (vertical interpolation). + +! If the local topography is outside the bounds of the global elevation classes, +! extrapolate the temperature using the prescribed lapse rate. + + do j = 1, nyl + do i = 1, nxl + + usrf = instance%model%geometry%usrf(i,j) * thk0 + thck = instance%model%geometry%thck(i,j) * thk0 + + if (thck <= min_thck) then ! if ice-free... + + if (usrf > 0.d0) then ! and on land (not ocean)... + + ! As noted above, no vertical interpolation is done for ice-free land + instance%acab(i,j) = qsmb_l(i,j,0) + instance%artm(i,j) = tsfc_l(i,j,0) + + if (instance%acab(i,j) < 0.d0) then + write (stdout,*)'ERROR: SMB is negative over bare-land point' + write (stdout,*)'i, j, instance%acab(i,j) = ', i, j, instance%acab(i,j) + write (stdout,*)'instance%artm(i,j) = ', instance%artm(i,j) + write (stdout,*)'qsmb_l(i,j,0) = ', qsmb_l(i,j,0) + write (stdout,*)'usrf=', usrf + write (stdout,*)'thck=', thck + call write_log('ERROR: SMB is negative over bare-land point',GM_FATAL,__FILE__,__LINE__) + endif + + else ! usrf <= 0 -- assumed to be ocean + + ! CISM assumes any point with usrf <= 0 is ocean, and thus can't form ice + ! (actually, this isn't exactly the cutoff used elsewhere in CISM - we may + ! want to change this conditional to use GLIDE_IS_OCEAN). So it makes no + ! sense to pass acab and artm there. However, this could lead to a loss of + ! conservation, e.g., if CLM thinks a grid cell is bare ground with some + ! positive SMB (glacial inception) yet CISM says it's ocean (so ignores + ! the SMB). We eventually want to handle this by keeping CLM consistent + ! with CISM in terms of its breakdown into land vs "ocean" (e.g., wetland + ! in CLM). In that case, if CISM says a point is ocean, then it would + ! tell CLM that that point is ocean, and so CLM wouldn't try to generate + ! SMB there. + + instance%acab(i,j) = 0.d0 + instance%artm(i,j) = 0.d0 + endif + + else ! if ice-covered... + + if (usrf <= topo_l(i,j,1)) then + instance%acab(i,j) = qsmb_l(i,j,1) + instance%artm(i,j) = tsfc_l(i,j,1) + lapse*(topo_l(i,j,1) - usrf) + elseif (usrf > topo_l(i,j,nec)) then + instance%acab(i,j) = qsmb_l(i,j,nec) + instance%artm(i,j) = tsfc_l(i,j,nec) - lapse*(usrf - topo_l(i,j,nec)) + else + do n = 2,nec + if (usrf > topo_l(i,j,n-1) .and. usrf <= topo_l(i,j,n)) then + fact = (topo_l(i,j,n) - usrf) / (topo_l(i,j,n) - topo_l(i,j,n-1)) + instance%acab(i,j) = fact*qsmb_l(i,j,n-1) + (1.d0-fact)*qsmb_l(i,j,n) + instance%artm(i,j) = fact*tsfc_l(i,j,n-1) + (1.d0-fact)*tsfc_l(i,j,n) + exit + endif + enddo + endif ! usrf, inner + endif ! thck + enddo ! i + enddo ! j + +!WHL - debug + if (main_task) then + print*, 'glint_downscaling_gcm, max/min qsmb_g, this_rank =', this_rank + do n = 0, nec + print*, n, maxval(qsmb_g(:,:,n)), minval(qsmb_g(:,:,n)) + enddo + print*, ' ' + print*, 'glint_downscaling_gcm, max/min qsmb_l, this_rank =', this_rank + do n = 0, nec + print*, n, maxval(qsmb_l(:,:,n)), minval(qsmb_l(:,:,n)) + enddo + print*, ' ' + print*, 'glint_downscaling_gcm, this_rank, max/min acab:', this_rank, maxval(instance%acab), minval(instance%acab) + endif +!WHL - end debug + + deallocate(qsmb_l, tsfc_l, topo_l) + + end subroutine glint_downscaling_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_init_input_gcm(params, & + lgrid, & + whichacab) + + ! Simplified version of glint_mbc_init, used when coupling + ! to a GCM that provides the surface mass balance and temperature + + use glimmer_coordinates + use glad_constants, only: years2hours + + type(glint_mbc) :: params ! mass balance parameters + type(coordsystem_type) :: lgrid ! local grid + integer, intent(in) :: whichacab ! mass balance method + ! = 0 for GCM coupling + + ! Deallocate if necessary + + if (associated(params%acab_save)) deallocate(params%acab_save) + if (associated(params%artm_save)) deallocate(params%artm_save) + if (associated(params%acab)) deallocate(params%acab) + if (associated(params%artm)) deallocate(params%artm) + + ! Allocate arrays and zero + + call coordsystem_allocate(lgrid,params%acab_save); params%acab_save = 0.d0 + call coordsystem_allocate(lgrid,params%artm_save); params%artm_save = 0.d0 + call coordsystem_allocate(lgrid,params%acab); params%acab = 0.d0 + call coordsystem_allocate(lgrid,params%artm); params%artm = 0.d0 + + ! Set the mbal method and tstep + + params%mbal%which = whichacab ! = 0 for GCM coupling + params%mbal%tstep = nint(years2hours) ! no. of hours in 1 year + + end subroutine glint_init_input_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_accumulate_input_gcm(params, time, acab, artm) + + type(glint_mbc) :: params + integer :: time + + real(dp),dimension(:,:),intent(in) :: acab ! Surface mass balance (m) + real(dp),dimension(:,:),intent(in) :: artm ! Mean air temperature (degC) + + ! Things to do the first time + + if (params%new_accum) then + + params%new_accum = .false. + params%av_count = 0 + + ! Initialise + + params%acab_save = 0.d0 + params%artm_save = 0.d0 + params%start_time = time + + end if + + params%av_count = params%av_count + 1 + + ! Accumulate + + params%acab_save = params%acab_save + acab + params%artm_save = params%artm_save + artm + + ! Copy instantaneous fields + + params%acab = acab + params%artm = artm + + end subroutine glint_accumulate_input_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_average_input_gcm(params, dt, acab, artm) + + use glad_constants, only: hours2years + + type(glint_mbc) :: params + integer, intent(in) :: dt !> mbal accumulation time (hours) + real(dp),dimension(:,:),intent(out) :: artm !> Mean air temperature (degC) + real(dp),dimension(:,:),intent(out) :: acab !> Mass-balance (m/yr) + + if (.not. params%new_accum) then + params%artm_save = params%artm_save / real(params%av_count,dp) + end if + artm = params%artm_save + + ! Note: acab_save has units of m, but acab has units of m/yr + acab = params%acab_save / real(dt*hours2years,dp) + + params%new_accum = .true. + + end subroutine glint_average_input_gcm + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + end module glint_downscale + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_ebm.F90 b/components/cism/glimmer-cism/libglint/glint_ebm.F90 new file mode 100644 index 0000000000..d93605fe8d --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_ebm.F90 @@ -0,0 +1,94 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_ebm.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_ebm + + ! This module provides a dummy, hopefully warning-free interface + ! in place of an energy-balance model to compute the surface mass balance. + ! If either subroutine is called, a fatal error is flagged. + ! + ! The old module name was 'glint_smb'. + + use glimmer_global, only: dp + + implicit none + + type ebm_params + integer :: dummyint + real(dp) :: dummyreal + character(40) :: dummypath + end type ebm_params + +contains + + subroutine EBMInitWrapper(params,nx,ny,dxr,tstep,path) + + use glimmer_log + + type(ebm_params) :: params + integer :: nx,ny,dxr,tstep + character(*) :: path + + ! Fatal error + + call write_log('Glimmer not compiled with EBM mass-balance scheme',GM_FATAL, & + __FILE__,__LINE__) + + ! Need these lines to avoid warnings, though they are never executed + + params%dummyint=nx + params%dummyint=ny + params%dummyint=dxr + params%dummyint=tstep + params%dummypath=path + + end subroutine EBMInitWrapper + + !--------------------------------------------------------------------------------------------- + + subroutine EBMStepWrapper(params,temp,thck,artm,prcp,U10m,V10m,humidity,SWdown,LWdown,Psurf) + + use glimmer_log + + type(ebm_params) :: params + real(dp),dimension(:,:) :: temp,thck,artm,prcp,U10m,V10m,humidity,SWdown,LWdown,Psurf + + ! Fatal error + + call write_log('Glimmer not compiled with EBM mass-balance scheme',GM_FATAL, & + __FILE__,__LINE__) + + ! Need this line to avoid warnings, though it is never executed + + params%dummyreal = sum(temp+thck+artm+prcp+U10m+V10m+humidity+SWdown+LWdown+Psurf) + + end subroutine EBMStepWrapper + +end module glint_ebm diff --git a/components/cism/glimmer-cism/libglint/glint_example_clim.F90 b/components/cism/glimmer-cism/libglint/glint_example_clim.F90 new file mode 100644 index 0000000000..dca42c3812 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_example_clim.F90 @@ -0,0 +1,883 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_example_clim.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_example_clim + + ! Subroutines used to initialize and compute forcing for the glint_example climate driver + + use glimmer_global, only: dp, fname_length + use glint_global_grid + + implicit none + + type glex_climate + + ! Mass-balance coupling timing parameters -------------------------- + integer :: total_years = 10 ! Length of run in years + integer :: climate_tstep = 6 ! Climate time-step in hours + + ! Filenames -------------------------------------------------------- + character(fname_length) :: precip_file = '' !> Name of precip file + character(fname_length) :: stemp_file = '' !> Name of surface temp file + character(fname_length) :: orog_file = '' !> Name of orography file + + ! Variable names --------------------------------------------------- + character(fname_length) :: precip_varname = '' !> precip variable name + character(fname_length) :: stemp_varname = '' !> temperature variable name + character(fname_length) :: orog_varname = '' !> orography variable name + + ! Arrays for holding climatology ----------------------------------- + real(dp),dimension(:,:), pointer :: orog_clim => null() !> Orography + real(dp),dimension(:,:,:),pointer :: precip_clim => null() !> Precip + real(dp),dimension(:,:,:),pointer :: surftemp_clim => null() !> Surface temperature + + ! Grid variables --------------------------------------------------- + type(global_grid) :: clim_grid + + ! Time variables --------------------------------------------------- + real(dp),dimension(:),pointer :: pr_time => null() !> Time in precip climatology + real(dp),dimension(:),pointer :: st_time => null() !> Time in surftemp climatology + + ! Other parameters ------------------------------------------------- + integer :: days_in_year = 365 + integer :: hours_in_year = 365*24 + real(dp) :: precip_scale = 1.d0 ! Factor for scaling precip + logical :: temp_in_kelvin=.true. ! Set if temperature field is in Kelvin + + !NOTE: The glint_example driver assumes we will read in precip, surface air temp, + ! and surface orography as required for a PDD scheme. + ! But this module includes a subroutine (compute_smb_gcm) that computes a crude SMB + ! based on these inputs, so we can run Glint in SMB mode instead of PDD mode. + logical :: gcm_smb = .false. ! if true, pass SMB to glint instead of PDD info + + end type glex_climate + + logical, parameter :: verbose_glex_climate = .false. ! set to true for debugging + + interface read_ncdf + module procedure read_ncdf_1d,read_ncdf_2d,read_ncdf_3d + end interface + +contains + + subroutine glex_clim_init(params,filename) + + use glimmer_config + use glimmer_log + + type(glex_climate) :: params !> Climate parameters + character(*) :: filename !> config filename + + type(ConfigSection),pointer :: config !> structure holding sections of configuration file + type(global_grid) :: pgrid,sgrid,ogrid + character(20) :: sttu,prtu ! Units + + if (verbose_glex_climate) print*, 'Read config file: ', filename + call ConfigRead(filename,config) + call glex_clim_readconfig(params,config) + call glex_clim_printconfig(params) + call CheckSections(config) + + ! Read in global grid data + + if (verbose_glex_climate) print*, 'Read global precip: ', trim(params%precip_file) + call read_ncdf_ggrid(params%precip_file,pgrid) + if (verbose_glex_climate) print*, 'Read global surface temp: ', trim(params%stemp_file) + call read_ncdf_ggrid(params%stemp_file, sgrid) + if (verbose_glex_climate) print*, 'Read global orography: ', trim(params%orog_file) + call read_ncdf_ggrid(params%orog_file, ogrid) + + ! Check all grids are the same, and copy + + call check_ggrids(pgrid,sgrid,ogrid) + params%clim_grid=pgrid + + ! Read in time axes + + call read_ncdf(params%precip_file,'time',params%pr_time,units=prtu) + call read_ncdf(params%stemp_file, 'time',params%st_time,units=sttu) + + ! Scale as fractions of a year if necessary + + call scale_time(params,params%pr_time,prtu) + call scale_time(params,params%st_time,sttu) + + ! Read in data + + if (verbose_glex_climate) print*, 'Read netCDF climate data' + call read_ncdf(params%precip_file,params%precip_varname,params%precip_clim) + call read_ncdf(params%stemp_file, params%stemp_varname, params%surftemp_clim) + call read_ncdf(params%orog_file, params%orog_varname, params%orog_clim) + + ! Scale precip + params%precip_clim = params%precip_clim * params%precip_scale + + ! Convert temps to degrees C if necessary + if (params%temp_in_kelvin) then + params%surftemp_clim=params%surftemp_clim-273.15 + end if + + end subroutine glex_clim_init + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glex_clim_readconfig(params,config) + + use glimmer_config + use glimmer_log + + type(glex_climate) :: params !> Climate parameters + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + type(ConfigSection), pointer :: section + + call GetSection(config,section,'GLEX climate') + if (associated(section)) then + call GetValue(section,'days_in_year',params%days_in_year) + call GetValue(section,'total_years',params%total_years) + call GetValue(section,'climate_tstep',params%climate_tstep) + call GetValue(section,'gcm_smb',params%gcm_smb) + + params%hours_in_year = params%days_in_year*24 + end if + + call GetSection(config,section,'GLEX precip') + if (associated(section)) then + call GetValue(section,'filename',params%precip_file) + call GetValue(section,'variable',params%precip_varname) + call GetValue(section,'scaling',params%precip_scale) + end if + + call GetSection(config,section,'GLEX temps') + if (associated(section)) then + call GetValue(section,'filename',params%stemp_file) + call GetValue(section,'variable',params%stemp_varname) + call GetValue(section,'kelvin', params%temp_in_kelvin) + end if + + call GetSection(config,section,'GLEX orog') + if (associated(section)) then + call GetValue(section,'filename',params%orog_file) + call GetValue(section,'variable',params%orog_varname) + end if + + if (params%precip_file=='') & + call write_log('GLINT Example: precip filename must be supplied',GM_FATAL) + if (params%stemp_file=='') & + call write_log('GLINT Example: temperature filename must be supplied',GM_FATAL) + if (params%orog_file=='') & + call write_log('GLINT Example: orography filename must be supplied',GM_FATAL) + if (params%precip_varname=='') & + call write_log('GLINT Example: precip variable must be specified',GM_FATAL) + if (params%stemp_varname=='') & + call write_log('GLINT Example: temperature variable must be specified',GM_FATAL) + if (params%orog_varname=='') & + call write_log('GLINT Example: orography variable must be specified',GM_FATAL) + + end subroutine glex_clim_readconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glex_clim_printconfig(params) + + use glimmer_log + + type(glex_climate) :: params + character(100) :: message + + call write_log('GLINT Example configuration') + call write_log('---------------------------') + + call write_log('Precip: '//trim(params%precip_varname)//' in file '// & + trim(params%precip_file)) + call write_log('Surface temperature: '//trim(params%stemp_varname)//' in file '// & + trim(params%stemp_file)) + call write_log('Orography: '//trim(params%orog_varname)//' in file '// & + trim(params%orog_file)) + + if (params%temp_in_kelvin) then + call write_log('Temperatures in Kelvin') + else + call write_log('Temperatures in degC') + end if + + if (params%precip_scale /= 1.d0) then + write(message,*)'Precipitation scaled by ', params%precip_scale + call write_log(message) + end if + + if (params%gcm_smb) then + call write_log ('Will pass surface mass balance (not PDD info) to Glint') + endif + + call write_log('') + + end subroutine glex_clim_printconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_ggrid(fname,ggrid) + + use netcdf + use glimmer_log + + !> Constructs a global grid data type from file + + character(*),intent(in) :: fname + type(global_grid),intent(out) :: ggrid + + integer :: ncerr ! NetCDF error + integer :: ncid ! NetCDF file id + + integer :: lon_id,lon_nd,lat_id,lat_nd + character(30) :: lon_varn,lat_varn + + integer :: nx,ny + integer,dimension(1) :: lldimids + real(dp),dimension(:),allocatable :: lons,lats + + ! Open file + ncerr = nf90_open(fname,0,ncid) + call handle_err(ncerr,__LINE__) + + ! Look for desired dimension names - the standard name attribute is the + ! place to look. + call ncdf_find_var(ncid,(/'longitude'/),lon_varn,lon_id,lon_nd) + call ncdf_find_var(ncid,(/'latitude' /),lat_varn,lat_id,lat_nd) + + ! Check they're only 1D arrays + if (lon_nd/=1 .or. lat_nd/=1) & + call write_log('Latitude and longitude variables must be 1D',GM_FATAL) + + ! Find out the sizes + ncerr = nf90_inquire_variable(ncid,lon_id,dimids=lldimids) + call handle_err(ncerr,__LINE__) + ncerr = nf90_inquire_dimension(ncid,lldimids(1),len=nx) + call handle_err(ncerr,__LINE__) + ncerr = nf90_inquire_variable(ncid,lat_id,dimids=lldimids) + call handle_err(ncerr,__LINE__) + ncerr = nf90_inquire_dimension(ncid,lldimids(1),len=ny) + call handle_err(ncerr,__LINE__) + + ! Allocate temporary arrays + allocate(lons(nx),lats(ny)) + + ! Read in lats and lons + ncerr = nf90_get_var(ncid,lon_id,lons) + call handle_err(ncerr,__LINE__) + ncerr = nf90_get_var(ncid,lat_id,lats) + call handle_err(ncerr,__LINE__) + + ! NB we are ignoring cell boundaries here. + ! Construct global grid type + call new_global_grid(ggrid,real(lons,dp),real(lats,dp),correct=.false.) + + ! Close file + ncerr = nf90_close(ncid) + call handle_err(ncerr,__LINE__) + + end subroutine read_ncdf_ggrid + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine check_ggrids(g1,g2,g3) + + use glimmer_log + + !> Compares three grids to make sure they are all the same + + type(global_grid),intent(in) :: g1,g2,g3 + logical :: fail + + fail=.false. + + if (g1%nx/=g2%nx .or. g1%nx/=g3%nx) fail = .true. + if (g1%ny/=g2%ny .or. g1%ny/=g3%ny) fail = .true. + + if (any(g1%lons/=g2%lons) .or. any(g1%lons/=g3%lons)) fail = .true. + if (any(g1%lats/=g2%lats) .or. any(g1%lats/=g3%lats)) fail = .true. + + if (fail) & + call write_log('GLINT Example: All three grids must be the same',GM_FATAL) + + end subroutine check_ggrids + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine ncdf_find_var(ncid,stdnames,varname,varid,ndims,fatal) + + use netcdf + use glimmer_log + + !> Returns the name and id of the first found variable which has + !> the requested standard name attribute + + integer,intent(in) :: ncid !> ID of an open netcdf file + character(*),dimension(:),intent(in) :: stdnames !> standard names sought + character(*),intent(out) :: varname !> variable name + integer,intent(out) :: varid !> variable ID + integer,intent(out) :: ndims !> Number of dimensions of variable + logical,intent(in),optional :: fatal !> set true to halt if name not found + + integer :: nvars,iv,natts,ia,nd,nsn,in + integer :: ncerr + character(50) :: an,sn + character(100) :: message + logical :: ft + + if (present(fatal)) then + ft = fatal + else + ft = .true. + end if + + nsn=size(stdnames) + + ncerr = nf90_inquire(ncid,nVariables=nvars) + call handle_err(ncerr,__LINE__) + + ! Loop over variables + do iv = 1,nvars + ncerr = nf90_inquire_variable(ncid,iv,varname,ndims=nd,nAtts=natts) + call handle_err(ncerr,__LINE__) + + ! Loop over attributes + do ia = 1,natts + an = '' + ncerr = nf90_inq_attname(ncid, iv, ia, an) + call handle_err(ncerr,__LINE__) + + ! If standard name, get value and check + ! against targets in turn + if (trim(an)=='standard_name' .or. trim(an)=='long_name') then + sn = '' + ncerr = nf90_get_att(ncid, iv, an, sn) + call handle_err(ncerr,__LINE__) + do in = 1,nsn + if (trim(sn)==trim(stdnames(in))) then + varid = iv + ndims = nd + return + end if + end do + end if + + end do + end do + + ! If we get to here, we've failed to find the right std name anywhere. + if (ft) then + message = 'Failed to find standard names: ' + do in = 1,nsn + message = trim(message)//' '//trim(stdnames(in)) + if (in/=nsn) message = trim(message)//',' + end do + call write_log(message,GM_FATAL) + end if + + end subroutine ncdf_find_var + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! READ_NCDF routines + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_1d(filename,varname,array,units) + + use netcdf + use glimmer_log + + character(*), intent(in) :: filename,varname + real(dp),dimension(:),pointer :: array + character(*),optional,intent(out) :: units + + integer :: ncerr ! NetCDF error + integer :: ncid ! NetCDF file id + integer :: varid ! NetCDF variable id + integer :: ndims ! Number of dimensions + real(dp) :: offset,scale + integer, dimension(1) :: dimids,dimlens + character(20),dimension(1) :: dimnames + character(100) :: message + integer :: u_attlen + + if (associated(array)) deallocate(array) + offset = 0.d0 + scale = 1.d0 + + call read_ncdf_findvar(filename,ncid,varid,ndims,varname) + + ! If not a 1d variable, flag and error and exit ---- + + if (ndims/=1) then + write(message,*)'NetCDF: Requested variable has ',ndims,' dimensions, 1 required' + call write_log(message,GM_FATAL) + end if + + call read_ncdf_dimnames(ncid,varid,ndims,dimids,dimlens,dimnames) + + ! Allocate output and dimension arrays ------------- + + allocate(array(dimlens(1))) + + ! Retrieve variable contents ----------------------- + + ncerr=nf90_get_var(ncid, varid, array) + call handle_err(ncerr,__LINE__) + + call read_ncdf_scaling(ncid,varid,offset,scale) + + array=offset+(array*scale) + + ! Find units if necessary + if (present(units)) then + ncerr=nf90_inquire_attribute(ncid, varid, 'units', len=u_attlen) + call handle_err(ncerr,__LINE__) + ncerr=nf90_get_att(ncid, varid, 'units', units) + call handle_err(ncerr,__LINE__) + units=units(1:u_attlen) + end if + + end subroutine read_ncdf_1d + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_2d(filename,varname,array) + + use netcdf + + character(*), intent(in) :: filename,varname + real(dp),dimension(:,:),pointer :: array + + integer :: ncerr ! NetCDF error + integer :: ncid ! NetCDF file id + integer :: varid ! NetCDF variable id + integer :: ndims ! Number of dimensions + real(dp) :: offset,scale + integer, dimension(2) :: dimids,dimlens + character(20),dimension(2) :: dimnames + + if (associated(array)) deallocate(array) + offset = 0.d0 + scale = 1.d0 + + call read_ncdf_findvar(filename,ncid,varid,ndims,varname) + + ! If not a 2d variable, flag and error and exit ---- + + if (ndims /= 2) then + print*,'NetCDF: Requested variable only has ',ndims,' dimensions' + stop + end if + + call read_ncdf_dimnames(ncid,varid,ndims,dimids,dimlens,dimnames) + + ! Allocate output ------------- + + allocate(array(dimlens(1),dimlens(2))) + + ! Retrieve variable contents ----------------------- + + ncerr=nf90_get_var(ncid, varid, array) + call handle_err(ncerr,__LINE__) + + call read_ncdf_scaling(ncid,varid,offset,scale) + + array = offset + (array*scale) + + end subroutine read_ncdf_2d + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_3d(filename,varname,array) + + use netcdf + + character(*), intent(in) :: filename,varname + real(dp),dimension(:,:,:),pointer :: array + + integer :: ncerr ! NetCDF error + integer :: ncid ! NetCDF file id + integer :: varid ! NetCDF variable id + integer :: ndims ! Number of dimensions + real(dp) :: offset,scale + integer, dimension(3) :: dimids,dimlens + character(20),dimension(3) :: dimnames + + if (associated(array)) deallocate(array) + offset = 0.d0 + scale = 1.d0 + + call read_ncdf_findvar(filename,ncid,varid,ndims,varname) + + ! If not a 3d variable, flag and error and exit ---- + + if (ndims /= 3) then + print*,'NetCDF: Requested variable only has ',ndims,' dimensions' + stop + end if + + call read_ncdf_dimnames(ncid,varid,ndims,dimids,dimlens,dimnames) + + ! Allocate output ------------- + + allocate(array(dimlens(1),dimlens(2),dimlens(3))) + + ! Retrieve variable contents ----------------------- + + ncerr=nf90_get_var(ncid, varid, array) + call handle_err(ncerr,__LINE__) + + call read_ncdf_scaling(ncid,varid,offset,scale) + + array = offset + (array*scale) + + end subroutine read_ncdf_3d + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_findvar(filename,ncid,varid,ndims,varname) + + use netcdf + + character(*) :: filename + integer :: ncid,varid,ndims + character(*) :: varname + integer :: ncerr + + ! Open file + + ncerr=nf90_open(filename,0,ncid) + call handle_err(ncerr,__LINE__) + + ! Find out the id of variable and its dimensions + + ncerr=nf90_inq_varid(ncid,varname,varid) + call handle_err(ncerr,__LINE__) + ncerr=nf90_inquire_variable(ncid, varid, ndims=ndims) + call handle_err(ncerr,__LINE__) + + end subroutine read_ncdf_findvar + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_dimnames(ncid,varid,ndims,dimids,dimlens,dimnames) + + use netcdf + + integer :: ncid,varid,ndims + integer,dimension(:) :: dimids,dimlens + character(*),dimension(:) :: dimnames + + integer :: ncerr,i + + ! Get dimensions ids + + ncerr=nf90_inquire_variable(ncid, varid, dimids=dimids) + call handle_err(ncerr,__LINE__) + + ! Retrieve dimension names + + do i=1,ndims + ncerr=nf90_inquire_dimension(ncid, dimids(i),name=dimnames(i),len=dimlens(i)) + call handle_err(ncerr,__LINE__) + end do + + end subroutine read_ncdf_dimnames + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine read_ncdf_scaling(ncid,varid,offset,scale) + + use netcdf + + integer :: ncid,varid + real(dp) :: offset,scale + integer :: ncerr + + ! Get scaling and offset, if present, and apply ---- + + ncerr=nf90_get_att(ncid, varid, 'add_offset', offset) + if (ncerr /= NF90_NOERR) then + offset = 0.d0 + ncerr = NF90_NOERR + end if + + ncerr=nf90_get_att(ncid, varid, 'scale_factor', scale) + if (ncerr/=NF90_NOERR) then + scale = 1.d0 + ncerr = NF90_NOERR + end if + + end subroutine read_ncdf_scaling + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine scale_time(params,time,units) + + use glimmer_log + + type(glex_climate), intent(in) :: params + real(dp),dimension(:),intent(inout) :: time + character(*), intent(in) :: units + + select case(trim(units)) + + case('years') + ! Do nothing + + case('hours') + time = time/real(params%hours_in_year,dp) + + !TODO - Test the following alternative options for time units (months, days) + + case('months') + time = time/12.d0 + + case('days') + time = time/real(params%days_in_year,dp) + + case default + call write_log('Time units '//trim(units)//' unrecognised',GM_FATAL) + + end select + + end subroutine scale_time + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine handle_err(status,line) + + use netcdf + + integer, intent (in) :: status + integer, intent (in) :: line + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + print *, 'Line:',line + stop "Stopped" + end if + end subroutine handle_err + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine example_climate(params,precip,temp,time) + + use glimmer_log + + type(glex_climate) :: params + real(dp),dimension(:,:),intent(out) :: precip,temp + real(dp),intent(in) :: time ! Time (hours) + + real(dp) :: pos + integer :: lower,upper + + real(dp) :: fyear + + ! Calculate fraction of year + fyear = real(mod(time,real(params%hours_in_year,dp))) / real(params%hours_in_year,dp) + + ! Do temperature interpolation + call bracket_point(fyear, params%st_time, lower, upper, pos) + temp = linear_interp(params%surftemp_clim(:,:,lower), params%surftemp_clim(:,:,upper), pos) + + ! precip + call bracket_point(fyear, params%pr_time, lower, upper, pos) + precip = linear_interp(params%precip_clim(:,:,lower), params%precip_clim(:,:,upper), pos) + + end subroutine example_climate + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + function linear_interp(a,b,pos) + + real(dp),dimension(:,:),intent(in) :: a,b + real(dp),dimension(size(a,1),size(a,2)) :: linear_interp + real(dp), intent(in) :: pos + + linear_interp = a*(1.d0-pos) + b*pos + + end function linear_interp + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine bracket_point(n,a,lower,upper,frac) + + real(dp), intent(in) :: n ! current fraction of year + real(dp),dimension(:),intent(in) :: a ! array of fractional year values + integer, intent(out) :: lower + integer, intent(out) :: upper + real(dp), intent(out) :: frac + + real(dp),dimension(0:size(a)+1) :: aa + integer :: na + + ! Array bounds + na = size(a) + aa(1:na) = a + aa(0) = -1 + a(na) + aa(na+1) = 1 + aa(1) + + lower = 0 + upper = 1 + do + if (n >= aa(lower) .and. n < aa(upper)) then + exit + end if + lower = lower + 1 + upper = upper + 1 + end do + frac = (n-aa(lower)) / (aa(upper)-aa(lower)) + + call fixbounds(lower,1,na) + call fixbounds(upper,1,na) + + end subroutine bracket_point + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine fixbounds(in,bottom,top) + + integer :: in,top,bottom + + do + if (in<=top) exit + in = in - (top-bottom+1) + end do + + do + if (in>=bottom) exit + in = in + (top-bottom+1) + end do + + end subroutine fixbounds + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine compute_gcm_smb(temp, precip, & + orog, & + qsmb, tsfc, & + topo, & + glc_nec, glc_topomax) + + use glimmer_physcon, only: scyr + + ! This is a crude parameterization for estimating qsmb and tsfc in each elevation class, + ! given temp and precip at a given mean surface elevation. + ! With these estimates we can run the standalone model (glint_example) as if we were + ! getting qsmb and tsfc from a GCM. + ! By tuning ablt_const, we can get an SMB that is not so different from what the PDD scheme computes. + + ! input fields on global grid + real(dp), dimension(:,:), intent(in) :: temp ! 2 m air temp (deg C) + real(dp), dimension(:,:), intent(in) :: precip ! precip rate (mm/s = kg/m2/s) + real(dp), dimension(:,:), intent(in) :: orog ! global orography (m) + + ! output fields on global grid, with elevation class index + ! (note that elevation class 0 is bare land) + real(dp), dimension(:,:,0:), intent(inout) :: qsmb ! ice sfc mass balance (kg/m2/s) + real(dp), dimension(:,:,0:), intent(inout) :: tsfc ! ice sfc temp (deg C) + real(dp), dimension(:,:,0:), intent(inout) :: topo ! ice sfc elevation (m) + + integer, intent(in) :: glc_nec ! number of elevation classes + + real(dp), dimension(0:glc_nec), intent(in) :: glc_topomax ! upper elevation of each class (m) + + integer :: nx, ny + integer :: i, j, k + + real(dp), dimension(glc_nec) :: glc_topomid ! midrange elevation of each class (m) + + real(dp) :: ablt ! ablation rate (kg/m2/s) + + real(dp), parameter :: lapse_rate = 0.006d0 ! temp lapse rate (deg/m) + + real(dp), parameter :: ablt_const = 5000.d0/scyr ! ablation rate per degree above 0 C (converted from kg/m2/yr to kg/m2/s) + ! can be tuned to agree (more or less) with acab from PDD scheme + + ! get global grid size + nx = size(temp,1) + ny = size(temp,2) + + ! compute mid-range elevation of each class + do k = 1, glc_nec-1 + glc_topomid(k) = 0.5d0 * (glc_topomax(k-1) + glc_topomax(k)) + enddo + k = glc_nec + glc_topomid(k) = 2.d0*glc_topomax(k-1) - glc_topomax(k-2) + + do k = 1, glc_nec + + do j = 1, ny + do i = 1, nx + + ! set topo to midrange value for this elevation class + topo(i,j,k) = glc_topomid(k) + + ! set tsfc assuming a fixed lapse rate + tsfc(i,j,k) = temp(i,j) - lapse_rate * (topo(i,j,k) - orog(i,j)) + + ! simple parameterization for ablation as function of temperature + if (tsfc(i,j,k) > 0.d0) then + ablt = ablt_const * tsfc(i,j,k) + else + ablt = 0.d0 + endif + + ! set smb as function of precip and ablation + qsmb(i,j,k) = precip(i,j) - ablt + + enddo + + enddo ! i + enddo ! j + + ! Fill elevation class 0 with arbitrary values. + + ! One option: Assume no SMB in bare land regions (which will mean no glacial inception). + topo(:,:,0) = 0.d0 + tsfc(:,:,0) = 0.d0 + qsmb(:,:,0) = 0.d0 + + ! Another option: Use the values computed for elevation class 1. + ! This will permit glacial inception. + ! However, it will likely result in negative values that will trigger a fatal error + ! in glint_downscaling_gcm. To use this option, glint_downscaling_gcm must be modified + ! to set negative acab values to zero and keep running. +! topo(:,:,0) = topo(:,:,1) +! tsfc(:,:,0) = tsfc(:,:,1) +! qsmb(:,:,0) = qsmb(:,:,1) + + end subroutine compute_gcm_smb + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_example_clim + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_global_grid.F90 b/components/cism/glimmer-cism/libglint/glint_global_grid.F90 new file mode 100644 index 0000000000..2cdd23b82f --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_global_grid.F90 @@ -0,0 +1,613 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_global_grid.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_global_grid + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + + implicit none + + real(dp),parameter :: pi2 = 2.d0*pi + + ! ------------------------------------------------------------ + ! GLOBAL_GRID derived type + ! ------------------------------------------------------------ + + type global_grid + + ! Contains parameters specifying the global grid configuration. + + ! Dimensions of grid --------------------------------------- + + integer :: nx = 0 ! Number of points in the $x$-direction. + integer :: ny = 0 ! Number of points in the $y$-direction. + integer :: nec = 1 ! Number of elevation classes + + ! Locations of grid-points --------------------------------- + + real(dp),pointer,dimension(:) :: lats => null() + ! Latitudinal locations of data-points in global fields (degrees) + real(dp),pointer,dimension(:) :: lons => null() + ! Longitudinal locations of data-points in global fields (degrees) + + ! Locations of grid-box boundaries ------------------------- + + real(dp),pointer,dimension(:) :: lat_bound => null() + ! Latitudinal boundaries of data-points in global fields (degrees) + real(dp),pointer,dimension(:) :: lon_bound => null() + ! Longitudinal boundaries of data-points in global fields (degrees) + + ! Areas of grid-boxes -------------------------------------- + + real(dp),pointer,dimension(:,:) :: box_areas => null() + ! The areas of the grid-boxes (m$^2$). This is a two-dimensional array to take + ! account of the possibility of a grid irregularly spaced in longitude + + integer,pointer,dimension(:,:) :: mask => null() + ! This mask = 1 where the global data are valid, = 0 elsewhere + ! (e.g., over ocean, where the GCM does not compute a surface mass balance) + + end type global_grid + + interface min + module procedure grid_min + end interface + + interface operator(==) + module procedure grid_equiv + end interface + + interface operator(/=) + module procedure grid_nequiv + end interface + + interface operator(>) + module procedure grid_greater_than + end interface + + interface operator(<) + module procedure grid_less_than + end interface + + interface grid_alloc + module procedure grid_alloc_2d,grid_alloc_3d + end interface + +contains + + subroutine new_global_grid(grid, lons, lats, lonb, latb, radius, correct, nec, mask) + + use glimmer_log + + ! Initialises a new global grid type + + type(global_grid), intent(inout) :: grid ! The grid to be initialised + real(dp),dimension(:), intent(in) :: lons ! Longitudinal positions of grid-points (degrees) + real(dp),dimension(:), intent(in) :: lats ! Latitudinal positions of grid-points (degrees) + real(dp),dimension(:), optional,intent(in) :: lonb ! Longitudinal boundaries of grid-boxes (degrees) + real(dp),dimension(:), optional,intent(in) :: latb ! Latitudinal boundaries of grid-boxes (degrees) + real(dp), optional,intent(in) :: radius ! The radius of the Earth (m) + logical, optional,intent(in) :: correct ! Set to correct for boundaries (default is .true.) + integer, optional,intent(in) :: nec ! Number of elevation classes + integer,dimension(:,:),optional,intent(in) :: mask ! Mask indicating where global data are valid + + ! Internal variables + + real(dp) :: radea=1.0 + integer :: i,j + logical :: cor + + ! Deal with optional non-correction + + if (present(correct)) then + cor=correct + else + cor=.true. + end if + + ! Check to see if things are allocated, and if so, deallocate them + + if (associated(grid%lats)) deallocate(grid%lats) + if (associated(grid%lons)) deallocate(grid%lons) + if (associated(grid%lat_bound)) deallocate(grid%lat_bound) + if (associated(grid%lon_bound)) deallocate(grid%lon_bound) + if (associated(grid%box_areas)) deallocate(grid%box_areas) + if (associated(grid%mask)) deallocate(grid%mask) + + ! Find size of grid + + grid%nx=size(lons) ; grid%ny=size(lats) + + ! Allocate arrays + + allocate(grid%lons(grid%nx)) + allocate(grid%lats(grid%ny)) + allocate(grid%lon_bound(grid%nx+1)) + allocate(grid%lat_bound(grid%ny+1)) + allocate(grid%box_areas(grid%nx,grid%ny)) + allocate(grid%mask(grid%nx,grid%ny)) + + ! Check dimensions of boundary arrays, if supplied + + if (present(lonb)) then + if (.not.size(lonb)==grid%nx+1) then + call write_log('Lonb mismatch in new_global_grid',GM_FATAL,__FILE__,__LINE__) + endif + endif + + if (present(latb)) then + if (.not.size(latb)==grid%ny+1) then + call write_log('Latb mismatch in new_global_grid',GM_FATAL,__FILE__,__LINE__) + endif + endif + + ! Copy lats and lons over + + grid%lats=lats + grid%lons=lons + + ! In the following code, there are some things that only work correctly if + ! size(grid%lats) > 0 or size(grid%lons) > 0... we need to explicitly check those + ! conditions to handle the multiple processor case, where tasks other than main have + ! a size-0 global grid + + ! Check to see if we have polar points, and fudge if necessary + ! By moving 1/20 of the way towards the next equatorward point. + + if (size(grid%lats) > 0) then + if (abs(grid%lats(1)-90)<1e-8) grid%lats(1) = 90.0-(grid%lats(1) -grid%lats(2))/20.0 + if (abs(grid%lats(grid%ny)+90)<1e-8) grid%lats(grid%ny) = -90.0+(grid%lats(grid%ny-1)-grid%lats(grid%ny))/20.0 + end if + + ! Calculate boundaries if necessary + + if (size(grid%lons) > 0) then + if (present(lonb)) then + grid%lon_bound=lonb + else + call calc_bounds_lon(lons,grid%lon_bound,cor) + endif + end if + + if (size(grid%lats) > 0) then + if (present(latb)) then + grid%lat_bound=latb + else + call calc_bounds_lat(lats,grid%lat_bound) + endif + end if + + ! Set radius of earth if necessary + + if (present(radius)) radea=radius + + ! Calculate areas of grid-boxes + + do i=1,grid%nx + do j=1,grid%ny + grid%box_areas(i,j)=delta_lon(grid%lon_bound(i),grid%lon_bound(i+1))*radea**2* & + (sin_deg(grid%lat_bound(j))-sin_deg(grid%lat_bound(j+1))) + enddo + enddo + + ! Specify mask + + if (present(mask)) then + grid%mask(:,:) = mask(:,:) + else + grid%mask(:,:) = 1 ! assume global data are valid everywhere + endif + + ! Set number of elevation classes + + if (present(nec)) then + grid%nec = nec + else + grid%nec = 1 + endif + + end subroutine new_global_grid + + !----------------------------------------------------------------------------- + + subroutine copy_global_grid(in,out) + + ! Copies a global grid type. + + type(global_grid),intent(in) :: in ! Input grid + type(global_grid),intent(out) :: out ! Output grid + + ! Copy dimensions + + out%nx = in%nx + out%ny = in%ny + out%nec = in%nec + + ! Check to see if arrays are allocated, then deallocate and + ! reallocate accordingly. + + if (associated(out%lats)) deallocate(out%lats) + if (associated(out%lons)) deallocate(out%lons) + if (associated(out%lat_bound)) deallocate(out%lat_bound) + if (associated(out%lon_bound)) deallocate(out%lon_bound) + if (associated(out%box_areas)) deallocate(out%box_areas) + if (associated(out%mask)) deallocate(out%mask) + + + allocate(out%lons(out%nx)) + allocate(out%lats(out%ny)) + allocate(out%lon_bound(out%nx+1)) + allocate(out%lat_bound(out%ny+1)) + allocate(out%box_areas(out%nx,out%ny)) + allocate(out%mask(out%nx,out%ny)) + + ! Copy data + + out%lons =in%lons + out%lats =in%lats + out%lat_bound=in%lat_bound + out%lon_bound=in%lon_bound + out%box_areas=in%box_areas + out%mask =in%mask + + end subroutine copy_global_grid + + !----------------------------------------------------------------------------- + + subroutine get_grid_dims(grid,nx,ny,nec) + + type(global_grid),intent(in) :: grid + integer,intent(out) :: nx,ny + integer,intent(out), optional :: nec + + nx=grid%nx + ny=grid%ny + + if (present(nec)) nec=grid%nec + + end subroutine get_grid_dims + + !----------------------------------------------------------------------------- + + subroutine print_grid(grid,no_gp) + + type(global_grid),intent(in) :: grid + logical,optional,intent(in) :: no_gp + + logical :: ng + + if (present(no_gp)) then + ng=no_gp + else + ng=.false. + end if + + print*,'Grid parameters:' + print*,'----------------' + print* + print*,'nx=', grid%nx + print*,'ny=', grid%ny + print*,'nec=',grid%nec + if (.not.ng) then + print* + print*,'longitudes:' + print*,grid%lons + print* + print*,'latitudes:' + print*,grid%lats + print* + print*,'longitude boundaries:' + print*,grid%lon_bound + print* + print*,'latitude boundaries:' + print*,grid%lat_bound + end if + + end subroutine print_grid + + !----------------------------------------------------------------------------- + + subroutine calc_bounds_lon(lons,lonb,correct) + + ! Calculates the longitudinal boundaries between + ! global grid-boxes. Note that we assume that the boundaries lie + ! half-way between the points, although + ! this isn't strictly true for a Gaussian grid. + + implicit none + + real(dp),dimension(:),intent(in) :: lons ! locations of global grid-points (degrees) + real(dp),dimension(:),intent(out) :: lonb ! boundaries of grid-boxes (degrees) + logical, intent(in) :: correct ! Set to correct for longitudinal grid boundary + + integer :: nxg,i + + nxg=size(lons) + + ! Longitudes + + do i=1,nxg-1 + lonb(i+1)=mid_lon(lons(i),lons(i+1),correct) + enddo + + lonb(1)=mid_lon(lons(nxg),lons(1),correct) + lonb(nxg+1)=lonb(1) + + end subroutine calc_bounds_lon + + !--------------------------------------------------------------------------------- + + subroutine calc_bounds_lat(lat,latb) + + ! Calculates the boundaries between + ! global grid-boxes. Note that we assume that the boundaries lie + ! half-way between the + ! points, both latitudinally and longitudinally, although + ! this isn't strictly true for a Gaussian grid. + + implicit none + + real(dp),dimension(:),intent(in) :: lat ! locations of global grid-points (degrees) + real(dp),dimension(:),intent(out) :: latb ! boundaries of grid-boxes (degrees) + + integer :: nyg,j + + nyg=size(lat) + + ! Latitudes first - we assume the boundaries of the first and + ! last boxes coincide with the poles. Not sure how to + ! handle it if they don't... + + latb(1)=90.0 + latb(nyg+1)=-90.0 + + do j=2,nyg + latb(j)=lat(j-1)-(lat(j-1)-lat(j))/2.0 + enddo + + end subroutine calc_bounds_lat + + !------------------------------------------------------------- + + real(dp) function mid_lon(a,b,correct) + + use glimmer_log + + ! Calculates the mid-point between two longitudes. + ! \texttt{a} must be west of \texttt{b}. + + real(dp),intent(in) :: a,b + logical :: correct + + real(dp) :: aa,bb,out + + aa=a ; bb=b + + if (aa>360.0.or.aa<0.0 .or. & + bb>360.0.or.bb<0.0) then + call write_log('Out of range in mid_lon',GM_FATAL,__FILE__,__LINE__) + endif + + if (aa>bb) aa=aa-360.0 + + out=aa+((bb-aa)/2.0) + + if (correct) then + do + if (out<=360.0) exit + out=out-360.0 + end do + + do + if (out>=0.0) exit + out=out+360.0 + end do + end if + + mid_lon=out + + end function mid_lon + + !------------------------------------------------------------- + + real(dp) function sin_deg(a) + + ! Calculate sin(a), where a is in degrees + + real(dp) :: a + real(dp) :: aa + + aa=pi*a/180.0 + + do + if (aa<=pi2) exit + aa=aa-pi2 + end do + + do + if (aa>=0.0) exit + aa=aa+pi2 + end do + + sin_deg=sin(aa) + + end function sin_deg + + !------------------------------------------------------------- + + real(dp) function delta_lon(a,b) + + real(dp) :: a,b + real(dp) :: aa,bb,dl + + aa=a ; bb=b + + do + dl=bb-aa + if (dl>=0.0) exit + aa=aa-360.0 + end do + + delta_lon=dl*pi/180.0 + + end function delta_lon + + !------------------------------------------------------------- + + logical function grid_greater_than(a,b) + + type(global_grid),intent(in) :: a,b + + if (a%nx*a%ny > b%nx*b%ny) then + grid_greater_than=.true. + else + grid_greater_than=.false. + end if + + end function grid_greater_than + + !------------------------------------------------------------- + + logical function grid_less_than(a,b) + + type(global_grid),intent(in) :: a,b + + if (a%nx*a%ny < b%nx*b%ny) then + grid_less_than=.true. + else + grid_less_than=.false. + end if + + end function grid_less_than + + !------------------------------------------------------------- + + function grid_min(a,b) + + type(global_grid),intent(in) :: a,b + type(global_grid) :: grid_min + + if (a>b) then + grid_min=b + else + grid_min=a + endif + + end function grid_min + + !------------------------------------------------------------- + + logical function grid_equiv(a,b) + + type(global_grid),intent(in) :: a,b + + if (.not.check_associated(a).or. & + .not.check_associated(b)) then + grid_equiv=.false. + return + end if + + if (a%nx /= b%nx .or. a%ny /= b%ny .or. a%nec /= b%nec) then + grid_equiv=.false. + return + end if + + ! N.B. Only checks grid-box centres and not boundaries + + if (any(a%lats /= b%lats).or. & + any(a%lons /= b%lons).or. & + any(a%mask /= b%mask).or. & + any(a%box_areas /= b%box_areas)) then + grid_equiv=.false. + return + end if + + grid_equiv=.true. + + end function grid_equiv + + !------------------------------------------------------------- + + logical function grid_nequiv(a,b) + + type(global_grid),intent(in) :: a,b + + grid_nequiv=.not.grid_equiv(a,b) + + end function grid_nequiv + + !------------------------------------------------------------- + + logical function check_associated(a) + + type(global_grid),intent(in) :: a + + if (associated(a%lats).and. & + associated(a%lons).and. & + associated(a%lat_bound).and. & + associated(a%lon_bound).and. & + associated(a%mask).and. & + associated(a%box_areas)) then + check_associated=.true. + else + check_associated=.false. + end if + + end function check_associated + + !------------------------------------------------------------- + + subroutine grid_alloc_3d(array,grid,d3) + + real(dp),dimension(:,:,:),pointer :: array + type(global_grid),intent(in) :: grid + integer,intent(in) :: d3 + + if (associated(array)) deallocate(array) + + allocate(array(grid%nx,grid%ny,d3)) + + end subroutine grid_alloc_3d + + !-------------------------------------------------------------- + + subroutine grid_alloc_2d(array,grid) + + real(dp),dimension(:,:),pointer :: array + type(global_grid),intent(in) :: grid + + if (associated(array)) deallocate(array) + + allocate(array(grid%nx,grid%ny)) + + end subroutine grid_alloc_2d + +end module glint_global_grid diff --git a/components/cism/glimmer-cism/libglint/glint_global_interp.F90 b/components/cism/glimmer-cism/libglint/glint_global_interp.F90 new file mode 100644 index 0000000000..2401f31104 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_global_interp.F90 @@ -0,0 +1,510 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_global_interp.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!Note - This module is not currently used, but keeping it for now in case it ever proves useful. + +module glint_global_interp + + use glint_global_grid + use glimmer_global, only: dp + use glimmer_physcon, only: pi + implicit none + +contains + + subroutine global_interp (in_grid,a,out_grid,ao,in_mask,out_mask,missing,error) + + ! This subroutine does an area weighted average from one grid, + ! on a spherical earth, to another. Logical masks may be assigned + ! for each grid, and only those grid boxes which are masked true + ! on both grids will be used. A value of amm will be assigned + ! to all nodes of the new grid which are initially false or have + ! no data from the old grid. The new mask will also be changed to + ! false where no data is available. + ! + ! Restrictions: longitude must be the first dimension and it + ! be monotonically increasing (west to east). + ! + ! latitude must be the second dimension and it + ! must be monotonic. + ! + ! values for longitude and latitude must be in + ! degrees. + ! + ! arrays that wrap around must repeat longitudes + ! with a 360 degree increment. it will be assumed + ! that values in the wrapped input and mask arrays + ! will also repeat (wrapped values in these arrays + ! will not be used). + ! + ! input + ! + ! integer idl first dimension of input a and mask. + ! integer il number of grid boxes in longitude for a and mask. + ! real alon longitude (deg) limits of grid boxes for a and mask. + ! integer jl number of grid boxes in latitude for a and mask. + ! real alat latitude (deg) limits of grid boxes for a and mask. + ! real a array of input data. + ! logical mask mask for input data (.false. to mask out data). + ! + ! output + ! + ! integer idlo first dimension of output ao and masko. + ! integer ilo number of grid boxes in longitude for ao and masko. + ! real alono longitude (deg) limits of grid boxes for ao and masko. + ! integer jlo number of grid boxes in latitude for ao and masko. + ! real alato latitude (deg) limits of grid boxes for ao and masko. + ! real ao array of output data. + ! logical masko mask for output data (.false. to mask out data). + ! integer ier error indication: + ! (values may be summed for multiple errors) + ! 0 no errors + ! 1 input longitude dimension and/or length <=0. + ! 2 output dimension and/or length <=0. + ! 4 input latititude dimension <=0. + ! 8 output latitude dimension <=0. + ! 16 wrap-around on input longitude grid doesn't + ! repeat (+360). + ! 32 wrap-around on output longitude grid doesn't + ! repeat (+360). + ! 64 longitude of input is not monotonic increasing. + ! 128 longitude of output is not monotonic increasing. + ! 256 latitude of input is not monotonic. + ! 512 latitude of output is not monotonic. + ! 1024 input longitude wraps but doesn't repeat identically. + ! 2048 output longitude wraps but doesn't repeat identically. + ! -1 output mask is changed. + ! -2 output mask contains all false values. + + ! -------------------------------------------------------- + ! Subroutine arguments + ! -------------------------------------------------------- + + type(global_grid) :: in_grid + real(dp),dimension(:,:), intent(in) :: a + type(global_grid) :: out_grid + real(dp),dimension(:,:), intent(out) :: ao + logical, dimension(:,:),optional,intent(inout) :: in_mask + logical, dimension(:,:),optional,intent(inout) :: out_mask + real(dp), optional,intent(in) :: missing + integer, optional,intent(out) :: error + + ! -------------------------------------------------------- + ! Automatic arrays + ! -------------------------------------------------------- + + logical, dimension(size(a,1) ,size(a,2)) :: mask + logical, dimension(size(ao,1),size(ao,2)) :: masko + real(dp),dimension(size(a,1)+1) :: alon + real(dp),dimension(size(a,2)+1) :: alat + real(dp),dimension(size(ao,1)+1) :: alono + real(dp),dimension(size(ao,2)+1) :: alato + + ! -------------------------------------------------------- + ! Internal variables + ! -------------------------------------------------------- + + integer :: idl,il,jl,idlo,ilo,jlo,ier + real(dp) :: amm,almx,almn,sgn,al,dln,almxo,almno,dlno,amnlto + real(dp) :: amxlto,amnlt,amxlt,amnlno,amxlno,amnln,amxln,wt,avg + real(dp) :: slatmx,wlat,slatmn,slon,slonp,slonmx,slonmn,delon + integer :: i,j,iil,iilo,j1,j2,jj,i1,i2,k,ii,iii,iip + + ! -------------------------------------------------------- + ! Set up array sizes and check things match up. + ! -------------------------------------------------------- + + idl=size(a,1) + il=size(alon)-1 + jl=size(alat)-1 + idlo=size(ao,1) + ilo=size(alono)-1 + jlo=size(alato)-1 + + alon=in_grid%lon_bound + alat=in_grid%lat_bound + alono=out_grid%lon_bound + alato=out_grid%lat_bound + + ! Check array sizes -------------------------------------- + + if (idl/=in_grid%nx.or. & + jl/=in_grid%ny.or. & + idlo/=out_grid%nx.or. & + jlo/=out_grid%ny) then + print*,'Array size mismatch in global_interp' + stop + end if + + ! Deal with optional mask input -------------------------- + + if (present(in_mask)) then + mask=in_mask + else + mask=.true. + endif + + if (present(out_mask)) then + masko=out_mask + else + masko=.true. + endif + + ! Set up missing value ----------------------------------- + + if (present(missing)) then + amm=missing + else + amm=50. + end if + ier=0 + + ! Check that the sizes of the arrays given are sensible -- + + if (idl < il.or.il <= 0) ier=1 + if (idlo < ilo.or.ilo <= 0) ier=ier+2 + if (jl <= 0) ier=ier+4 + if (jlo <= 0) ier=ier+8 + if (ier > 0) then + if (present(error)) error=ier + return + end if + + ! Check monotonic increasing input longitudes ------------ + + do i=2,il + if (alon(i) <= alon(i-1)) then + ier=ier+64 + exit + endif + end do + + ! Check monotonic increasing output longitudes ----------- + + do i=2,ilo + if (alono(i) <= alono(i-1)) then + ier=ier+128 + exit + endif + end do + + ! Check monotonicity of input latitudes ------------------ + + sgn=(alat(2)-alat(1)) + do j=2,jl + if (sgn < 0.0) then + if (alat(j)-alat(j-1) >= 0) then + ier=ier+256 + exit + endif + else if (sgn > 0.0) then + if (alat(j)-alat(j-1) <= 0.0) then + ier=ier+256 + exit + endif + else + ier=ier+256 + exit + endif + end do + + ! Check monotonicity of output latitudes ------------------ + + sgn=(alato(2)-alato(1)) + do j=2,jlo + if (sgn < 0.0) then + if (alato(j)-alato(j-1) >= 0.0) then + ier=ier+512 + exit + endif + else if (sgn > 0.0) then + if (alato(j)-alato(j-1) <= 0.0) then + ier=ier+512 + exit + endif + else + ier=ier+512 + exit + endif + end do + + ! Find wrap around of input grid, if it exists ------------ + + iil=il + almx=alon(1) + almn=alon(1) + + do i=2,il+1 + almx=max(almx,alon(i)) + almn=min(almn,alon(i)) + al=abs(alon(i)-alon(1))-360.0 + if (abs(al) <= 1.e-4) then + iil=i-1 + exit + else if (al > 0.0) then + ier=ier+1024 + go to 12 + endif + end do + + dln=0.0 + if (almn < 0.0) then + dln=int(-almn/360.0+.001)*360.0 + else if (almn > 360.0) then + dln=-int(almn/360.0+.001)*360.0 + endif +12 continue + + ! Find wrap around of output grid, if it exists ----------- + + iilo=ilo + almxo=alono(1) + almno=alono(1) + do i=2,ilo+1 + almxo=max(almxo,alono(i)) + almno=min(almno,alono(i)) + al=abs(alono(i)-alono(1))-360.0 + if (abs(al) <= 1.e-4) then + iilo=i-1 + exit + else if (al > 0.0) then + ier=ier+2048 + go to 15 + endif + end do + + dlno=0.0 + if (almno < 0.0) then + dlno=int(-almno/360.0+.001)*360.0 + else if (almno > 360.0) then + dlno=-int(almno/360.0+.001)*360.0 + endif +15 continue + + ! Test for errors. return if any -------------------------- + + if (ier /= 0) then + if (present(error)) error=ier + return + end if + + ! The output grid needs to begin with or after the input grid. + + if (almno+dlno < almn+dln) dlno=dlno+360.0 + + do j=1,jlo ! loop 200 - over output latitudes + ! find index limits in latitude to cover the new grid. + j1=jl+1 + j2=0 + amnlto=min(alato(j),alato(j+1)) + amxlto=max(alato(j),alato(j+1)) + + ! search for index limits in j. + + do jj=1,jl + amnlt=min(alat(jj),alat(jj+1)) + amxlt=max(alat(jj),alat(jj+1)) + ! find jj limits + if (amxlt > amnlto.and.amnlt < amxlto) then + j1=min(jj,j1) + j2=max(jj,j2) + endif + end do + + ! if input grid doesn't at least partially cover the + ! output grid box, no values will be assigned. mask out + ! all values for the latitude. + + if (j2 < j1) then + do i=1,iilo + ao(i,j)=amm + if (masko(i,j)) ier=-1 + masko(i,j)=.false. + end do + cycle + endif + + do i=1,iilo ! loop 100 + + ! no need to compute if it is masked out. + if (.not.masko(i,j)) cycle + + ! find index limits in longitude to cover the new grid. + i1=3*il+1 + i2=0 + amnlno=min(alono(i),alono(i+1))+dlno + amxlno=max(alono(i),alono(i+1))+dlno + + ! search for index limits in i. + ! because of wrap around it is necessary to + ! look through the data twice. + ! the output grid longitudes have been adjusted + ! (using dlno) such that the first longitude in + ! the output grid is greater than the first + ! longitude on the input grid. + + do k=0,1 + do ii=1,iil + amnln=min(alon(ii),alon(ii+1))+dln+k*360.0 + amxln=max(alon(ii),alon(ii+1))+dln+k*360.0 + ! find ii limits + if (amxln > amnlno.and.amnln < amxlno) then + i1=min(ii+k*il,i1) + i2=max(ii+k*il,i2) + endif + end do + end do + + ! if input grid doesn't partially cover the output + ! grid box, no values will be assigned. mask out + ! the grid box. + + if (i2 < i1) then + ao(i,j)=amm + if (masko(i,j)) ier=-1 + masko(i,j)=.false. + cycle + endif + + wt=0.0 + avg=0.0 + + do jj=j1,j2 + slatmx=max(alat(jj),alat(jj+1)) + slatmn=min(alat(jj),alat(jj+1)) + wlat=max(sin(min(amxlto,slatmx)*pi/180.d0)-sin(max(amnlto,slatmn)*pi/180.d0),0.d0) + if (wlat /= 0.0) then + do iii=i1,i2 + slon=dln + slonp=dln + if (iii > iil) then + slon=slon+360. + slonp=slonp+360. + endif + ii=mod(iii-1,iil)+1 + iip=ii+1 + if (mask(ii,jj)) then + slon=slon+alon(ii) + slonp=slonp+alon(iip) + slonmx=max(slon,slonp) + slonmn=min(slon,slonp) + delon=max(min(amxlno,slonmx)-max(amnlno,slonmn),0.d0) + wt=wt+wlat*delon + avg=avg+a(ii,jj)*wlat*delon + endif + end do + endif + end do + + if (wt > 0.0) then + ao(i,j)=avg/wt + else + ao(i,j)=amm + if (masko(i,j)) ier=-1 + masko(i,j)=.false. + endif +100 continue + end do +200 continue + end do + + ! Finish filling the output array from wrap-around. + + if (iilo < ilo) then + do j=1,jlo + do i=iilo+1,ilo + ao(i,j)=ao(i-iilo,j) + masko(i,j)=masko(i-iilo,j) + end do + end do + endif + + ! Check if output masko is all false. + + if (all(.not.masko)) ier=-2 + + ! Copy outputs if necessary + + if (present(error)) error=ier + if (present(in_mask)) in_mask=mask + if (present(out_mask)) out_mask=masko + + end subroutine global_interp + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine interp_error(err,line) + + use glimmer_log + + integer :: err,line + character(50) :: message + integer :: e + + write(message,'(A,I6)')'Interpolation errors at line ',line + call write_log(message) + + e=err + + call err_check(e,2048,'output longitude wraps but doesn''t repeat identically') + call err_check(e,1024,'input longitude wraps but doesn''t repeat identically') + call err_check(e,512, 'latitude of output is not monotonic') + call err_check(e,256, 'latitude of input is not monotonic') + call err_check(e,128, 'longitude of output is not monotonic increasing') + call err_check(e,64, 'longitude of input is not monotonic increasing') + call err_check(e,32, 'wrap-around on output longitude grid doesn''t repeat (+360)') + call err_check(e,16, 'wrap-around on input longitude grid doesn''t repeat (+360)') + call err_check(e,8, 'output latitude dimension <=0') + call err_check(e,4, 'input latitude dimension <=0') + call err_check(e,2, 'output dimension and/or length <=0') + call err_check(e,1, 'input longitude dimension and/or length <=0') + stop + + end subroutine interp_error + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine err_check(e,en,out) + + use glimmer_log + + integer :: e,en + character(*) :: out + + if (e>en) then + call write_log(out) + e=e-en + end if + + end subroutine err_check + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_global_interp diff --git a/components/cism/glimmer-cism/libglint/glint_initialise.F90 b/components/cism/glimmer-cism/libglint/glint_initialise.F90 new file mode 100644 index 0000000000..93ac223bde --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_initialise.F90 @@ -0,0 +1,872 @@ +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +#ifdef CPRIBM +@PROCESS ALIAS_SIZE(107374182) +#endif +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_initialise.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_initialise + + !> Initialise GLINT model instance + + use glint_type + use glimmer_global, only: dp + implicit none + + private + public glint_i_initialise, glint_i_initialise_gcm, glint_i_end, calc_coverage + +contains + + subroutine glint_i_initialise(config, instance, & + grid, grid_orog, & + mbts, idts, & + need_winds, enmabal, & + force_start, force_dt, & + gcm_restart, gcm_restart_file, & + gcm_config_unit) + + !> Initialise a GLINT ice model instance + + use glimmer_paramets, only: GLC_DEBUG + use glimmer_log + use glimmer_config + use glimmer_coordinates, only : coordsystem_new + use glint_global_grid + use glint_mbal_coupling + use glint_io , only: glint_io_createall , glint_io_writeall + use glint_mbal_io , only: glint_mbal_io_createall, glint_mbal_io_writeall + use glimmer_ncio + use glide_nc_custom , only: glide_nc_fillall + use glide + use glissade + use glad_constants + use glad_restart_gcm + use glide_diagnostics + use parallel, only: main_task + + implicit none + + ! Arguments + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + type(glint_instance), intent(inout) :: instance !> The instance being initialised. + type(global_grid), intent(in) :: grid !> Global grid to use + type(global_grid), intent(in) :: grid_orog !> Global grid to use for orography + integer, intent(out) :: mbts !> mass-balance time-step (hours) + integer, intent(out) :: idts !> ice dynamics time-step (hours) + logical, intent(inout) :: need_winds !> Set if this instance needs wind input + logical, intent(inout) :: enmabal !> Set if this instance uses the energy balance + ! mass-bal model + integer, intent(in) :: force_start !> glint forcing start time (hours) + integer, intent(in) :: force_dt !> glint forcing time step (hours) + logical, optional, intent(in) :: gcm_restart !> logical flag to read from a restart file + character(*),optional, intent(in) :: gcm_restart_file !> restart filename for restart + integer, optional, intent(in) :: gcm_config_unit !> fileunit for reading config files + + ! Internal + real(dp),dimension(:,:),allocatable :: thk + integer :: config_fileunit, restart_fileunit + + config_fileunit = 99 + if (present(gcm_config_unit)) then + config_fileunit = gcm_config_unit + endif + + ! initialise model + + call glide_config(instance%model, config, config_fileunit) + + ! if this is a continuation run, then set up to read restart + ! (currently assumed to be a CESM restart file) + + if (present(gcm_restart)) then + + if (gcm_restart) then + + if (present(gcm_restart_file)) then + + ! read the restart file + call glad_read_restart_gcm(instance%model, gcm_restart_file) + instance%model%options%is_restart = 1 + + else + + call write_log('Missing gcm_restart_file when gcm_restart is true',& + GM_FATAL,__FILE__,__LINE__) + + endif + + endif + endif + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then ! SIA dycore + + ! initialise the model + call glide_initialise(instance%model) + + ! compute the initial diagnostic state + call glide_init_state_diagnostic(instance%model) + + else ! glam/glissade HO dycore + + ! initialise the model + call glissade_initialise(instance%model) + + ! compute the initial diagnostic state + call glissade_diagnostic_variable_solve(instance%model) + + endif + + instance%ice_tstep = get_tinc(instance%model)*nint(years2hours) + instance%glide_time = instance%model%numerics%tstart + idts = instance%ice_tstep + + ! read glint configuration + + call glint_i_readconfig(instance, config) + call glint_i_printconfig(instance) + + ! Construct the list of necessary restart variables based on the config options + ! selected by the user in the config file (specific to glint - other configs, + ! e.g. glide, isos, are handled separately by their setup routines). + ! This is done regardless of whether or not a restart ouput file is going + ! to be created for this run, but this information is needed before setting up outputs. MJH 1/17/13 + ! Note: the corresponding call for glide is placed within *_readconfig, which is probably more appropriate, + ! but putting this call into glint_i_readconfig creates a circular dependency. + + call define_glint_restart_variables(instance) + + + + ! Check we've used all the config sections + + call CheckSections(config) + + ! New grid (grid on this task) + + ! WJS (1-11-13): I'm not sure if it's correct to set the origin to (0,0) when running + ! on multiple tasks, with a decomposed grid. However, as far as I can tell, the + ! origin of this variable isn't important, so I'm not trying to fix it right now. + + instance%lgrid = coordsystem_new(0.d0, 0.d0, & + get_dew(instance%model), & + get_dns(instance%model), & + get_ewn(instance%model), & + get_nsn(instance%model)) + + ! Allocate arrays appropriately + + call glint_i_allocate(instance, grid%nx, grid%ny, grid_orog%nx, grid_orog%ny) + + ! Read data and initialise climate + + call glint_i_readdata(instance) + + ! Create grid spanning full domain and other information needed for downscaling & + ! upscaling. Note that, currently, these variables only have valid data on the main + ! task, since all downscaling & upscaling is done there + + call setup_lgrid_fulldomain(instance, grid, grid_orog) + + ! initialise the mass-balance accumulation + + call glint_mbc_init(instance%mbal_accum, & + instance%lgrid, & + config, & + instance%whichacab, & + instance%snowd, & + instance%siced, & + instance%lgrid%size%pt(1), & + instance%lgrid%size%pt(2), & + real(instance%lgrid%delta%pt(1),dp)) + + instance%mbal_tstep = instance%mbal_accum%mbal%tstep + mbts = instance%mbal_tstep + + instance%next_time = force_start - force_dt + instance%mbal_tstep + + if (GLC_DEBUG .and. main_task) then + write (6,*) 'Called glint_mbc_init' + write (6,*) 'mbal tstep =', mbts + write (6,*) 'next_time =', instance%next_time + write (6,*) 'start_time =', instance%mbal_accum%start_time + end if + + + ! -- Do all the netCDF output setup operations now that the model config has been finalized -- + ! (We can't do these operations until all needed model variables are allocated) + ! create glint variables for the glide output files + call glint_io_createall(instance%model, data=instance) + + ! create instantaneous glint variables + call openall_out(instance%model, outfiles=instance%out_first) + call glint_mbal_io_createall(instance%model, data=instance, outfiles=instance%out_first) ! + + ! fill dimension variables + call glide_nc_fillall(instance%model) + call glide_nc_fillall(instance%model, outfiles=instance%out_first) + + + ! Mass-balance accumulation length + + if (instance%mbal_accum_time == -1) then + instance%mbal_accum_time = max(instance%ice_tstep,instance%mbal_tstep) + end if + + if (instance%mbal_accum_time < instance%mbal_tstep) then + call write_log('Mass-balance accumulation timescale must be as '//& + 'long as mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (mod(instance%mbal_accum_time,instance%mbal_tstep) /= 0) then + call write_log('Mass-balance accumulation timescale must be an '// & + 'integer multiple of the mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (.not.(mod(instance%mbal_accum_time,instance%ice_tstep)==0 .or. & + mod(instance%ice_tstep,instance%mbal_accum_time)==0)) then + call write_log('Mass-balance accumulation timescale and ice dynamics '//& + 'timestep must divide into one another',GM_FATAL,__FILE__,__LINE__) + end if + + if (instance%ice_tstep_multiply /= 1 .and. mod(instance%mbal_accum_time,nint(years2hours)) /= 0.d0) then + call write_log('For ice time-step multiplication, mass-balance accumulation timescale '//& + 'must be an integer number of years',GM_FATAL,__FILE__,__LINE__) + end if + + ! Initialise some other stuff + + if (instance%mbal_accum_time>instance%ice_tstep) then + instance%n_icetstep = instance%ice_tstep_multiply*instance%mbal_accum_time/instance%ice_tstep + else + instance%n_icetstep = instance%ice_tstep_multiply + end if + + !This was commented out because it destroys exact restart + !TODO - Find another way to set thk to snowd? + ! Copy snow-depth to thickness if no thickness is present + +!! allocate(thk(get_ewn(instance%model),get_nsn(instance%model))) +!! call glide_get_thk(instance%model,thk) +!! where (instance%snowd>0.0 .and. thk==0.0) +!! thk=instance%snowd +!! elsewhere +!! thk=thk +!! endwhere +!! call glide_set_thk(instance%model,thk) +!! deallocate(thk) + + ! Write initial ice sheet diagnostics for this instance + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! Write netCDF output for this instance + + call glide_io_writeall(instance%model, instance%model) + call glint_io_writeall(instance, instance%model) + call glint_mbal_io_writeall(instance, instance%model, outfiles=instance%out_first) + + if (instance%whichprecip == PRECIP_RL) need_winds=.true. + if (instance%whichacab == MASS_BALANCE_EBM) then ! not currently supported + need_winds = .true. + enmabal = .true. + end if + + end subroutine glint_i_initialise + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_initialise_gcm(config, instance, & + grid, & + mbts, idts, & + force_start, force_dt, & + gcm_restart, gcm_restart_file, & + gcm_config_unit) + + ! Initialise a GLINT ice model instance for GCM coupling + + use glimmer_paramets, only: GLC_DEBUG + use glimmer_log + use glimmer_config + use glimmer_coordinates, only : coordsystem_new + use glint_global_grid + use glint_downscale , only: glint_init_input_gcm + use glint_io , only: glint_io_createall , glint_io_writeall + use glint_mbal_io , only: glint_mbal_io_createall, glint_mbal_io_writeall + use glimmer_ncio + use glide_nc_custom , only: glide_nc_fillall + use glide + use glissade + use glad_constants + use glad_restart_gcm + use glide_diagnostics + use parallel, only: main_task + + implicit none + + ! Arguments + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + type(glint_instance), intent(inout) :: instance ! The instance being initialised. + type(global_grid), intent(in) :: grid ! Global grid to use + integer, intent(out) :: mbts ! mass-balance time-step (hours) + integer, intent(out) :: idts ! ice dynamics time-step (hours) + + integer, intent(in) :: force_start ! glint forcing start time (hours) + integer, intent(in) :: force_dt ! glint forcing time step (hours) + + logical, optional, intent(in) :: gcm_restart ! logical flag to read from a restart file + character(*),optional, intent(in) :: gcm_restart_file ! restart filename for restart + integer, optional, intent(in) :: gcm_config_unit ! fileunit for reading config files + + ! Internal + + integer :: config_fileunit + + config_fileunit = 99 + if (present(gcm_config_unit)) then + config_fileunit = gcm_config_unit + endif + + ! initialise model + + call glide_config(instance%model, config, config_fileunit) + + ! if this is a continuation run, then set up to read restart + ! (currently assumed to be a CESM restart file) + + if (present(gcm_restart)) then + + if (gcm_restart) then + + if (present(gcm_restart_file)) then + + ! read the restart file + call glad_read_restart_gcm(instance%model, gcm_restart_file) + instance%model%options%is_restart = 1 + + else + + call write_log('Missing gcm_restart_file when gcm_restart is true',& + GM_FATAL,__FILE__,__LINE__) + + endif + + endif + endif + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then ! SIA dycore + + ! initialise the model + call glide_initialise(instance%model) + + ! compute the initial diagnostic state + call glide_init_state_diagnostic(instance%model) + + else ! glam/glissade HO dycore + + ! initialise the model + call glissade_initialise(instance%model) + + ! compute the initial diagnostic state + call glissade_diagnostic_variable_solve(instance%model) + + endif + + instance%ice_tstep = get_tinc(instance%model)*nint(years2hours) + idts = instance%ice_tstep + + instance%glide_time = instance%model%numerics%tstart + + ! read glint configuration + + call glint_i_readconfig(instance, config) + call glint_i_printconfig(instance) + + ! Construct the list of necessary restart variables based on the config options + ! selected by the user in the config file (specific to glint - other configs, + ! e.g. glide, isos, are handled separately by their setup routines). + ! This is done regardless of whether or not a restart ouput file is going + ! to be created for this run, but this information is needed before setting up outputs. MJH 1/17/13 + ! Note: the corresponding call for glide is placed within *_readconfig, which is probably more appropriate, + ! but putting this call into glint_i_readconfig creates a circular dependency. + + call define_glint_restart_variables(instance) + + ! create glint variables for the glide output files + call glint_io_createall(instance%model, data=instance) + + ! create instantaneous glint variables + call openall_out(instance%model, outfiles=instance%out_first) + call glint_mbal_io_createall(instance%model, data=instance, outfiles=instance%out_first) + + ! fill dimension variables + call glide_nc_fillall(instance%model) + call glide_nc_fillall(instance%model, outfiles=instance%out_first) + + ! Check we've used all the config sections + + call CheckSections(config) + + ! New grid (grid on this task) + + ! WJS (1-11-13): I'm not sure if it's correct to set the origin to (0,0) when running + ! on multiple tasks, with a decomposed grid. However, as far as I can tell, the + ! origin of this variable isn't important, so I'm not trying to fix it right now. + + instance%lgrid = coordsystem_new(0.d0, 0.d0, & + get_dew(instance%model), & + get_dns(instance%model), & + get_ewn(instance%model), & + get_nsn(instance%model)) + + ! Allocate arrays appropriately + + call glint_i_allocate_gcm(instance, grid%nx, grid%ny) + + ! Read data and initialise climate + + call glint_i_readdata(instance) + + ! Create grid spanning full domain and other information needed for downscaling & + ! upscaling. Note that, currently, these variables only have valid data on the main + ! task, since all downscaling & upscaling is done there + + call setup_lgrid_fulldomain(instance, grid) + + ! initialise the mass-balance accumulation + + call glint_init_input_gcm(instance%mbal_accum, & + instance%lgrid, & + instance%whichacab) + + ! If flag set to force frequent coupling (for testing purposes), + ! then decrease all coupling timesteps to very short intervals + if (instance%test_coupling) then + instance%mbal_accum%mbal%tstep = 24 + instance%mbal_accum_time = 24 + instance%ice_tstep = 24 + endif + + instance%mbal_tstep = instance%mbal_accum%mbal%tstep + + mbts = instance%mbal_tstep + + instance%next_time = force_start - force_dt + instance%mbal_tstep + + if (GLC_DEBUG .and. main_task) then + write (6,*) 'Called glint_mbc_init' + write (6,*) 'mbal tstep =', mbts + write (6,*) 'next_time =', instance%next_time + write (6,*) 'start_time =', instance%mbal_accum%start_time + end if + + ! Mass-balance accumulation length + + if (instance%mbal_accum_time == -1) then + instance%mbal_accum_time = max(instance%ice_tstep,instance%mbal_tstep) + end if + + if (instance%mbal_accum_time < instance%mbal_tstep) then + call write_log('Mass-balance accumulation timescale must be as '//& + 'long as mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (mod(instance%mbal_accum_time,instance%mbal_tstep) /= 0) then + call write_log('Mass-balance accumulation timescale must be an '// & + 'integer multiple of the mass-balance time-step',GM_FATAL,__FILE__,__LINE__) + end if + + if (.not. (mod(instance%mbal_accum_time, instance%ice_tstep)==0 .or. & + mod(instance%ice_tstep, instance%mbal_accum_time)==0)) then + call write_log('Mass-balance accumulation timescale and ice dynamics '//& + 'timestep must divide into one another',GM_FATAL,__FILE__,__LINE__) + end if + + if (instance%ice_tstep_multiply/=1 .and. mod(instance%mbal_accum_time,nint(years2hours)) /= 0.d0) then + call write_log('For ice time-step multiplication, mass-balance accumulation timescale '//& + 'must be an integer number of years',GM_FATAL,__FILE__,__LINE__) + end if + + ! Initialise some other stuff + + if (instance%mbal_accum_time>instance%ice_tstep) then + instance%n_icetstep = instance%ice_tstep_multiply*instance%mbal_accum_time/instance%ice_tstep + else + instance%n_icetstep = instance%ice_tstep_multiply + end if + + ! Write initial ice sheet diagnostics for this instance + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! Write netCDF output for this instance + + call glide_io_writeall(instance%model, instance%model) + call glint_io_writeall(instance, instance%model) + call glint_mbal_io_writeall(instance, instance%model, outfiles=instance%out_first) + + end subroutine glint_i_initialise_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_end(instance) + + !> Tidy up + + use glide + use glimmer_ncio + implicit none + type(glint_instance), intent(inout) :: instance !> The instance being initialised. + + call glide_finalise(instance%model) + call closeall_out(instance%model,outfiles=instance%out_first) + instance%out_first => null() + + end subroutine glint_i_end + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_readdata(instance) + !> read data from netCDF file and initialise climate + + use glint_io + use glide_thck, only: glide_calclsrf + implicit none + + type(glint_instance),intent(inout) :: instance !> Instance whose elements are to be allocated. + + ! read data + call glint_io_readall(instance,instance%model) + + call glide_calclsrf(instance%model%geometry%thck,instance%model%geometry%topg, & + instance%model%climate%eus,instance%model%geometry%lsrf) + instance%model%geometry%usrf = instance%model%geometry%thck + instance%model%geometry%lsrf + + end subroutine glint_i_readdata + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine setup_lgrid_fulldomain(instance, grid, grid_orog) + + !> Set up the local (icesheet) grid spanning the full domain (i.e., across all tasks). + !> This also sets up auxiliary variables that depend on this full domain lgrid, + !> such as the downscaling and upscaling derived types. + !> This routine is required because we currently do downscaling and upscaling just + !> on the main task, with the appropriate gathers / scatters. + !> Thus, this creates a lgrid spanning the full domain on the main task; + !> other tasks are left with an uninitialized lgrid_fulldomain. + !> Tasks other than the main task also have uninitialized ups, downs and frac_coverage + !> (along with the similar *_orog variables). + + use glint_type , only : glint_instance + use glint_global_grid , only : global_grid + use parallel , only : main_task, global_ewn, global_nsn, distributed_gather_var + use glimmer_coordinates, only : coordsystem_new + use glide_types , only : get_dew, get_dns + + implicit none + + ! Arguments + + type(glint_instance), intent(inout) :: instance + type(global_grid) , intent(in) :: grid + type(global_grid) , intent(in), optional :: grid_orog + + ! Internal variables + + integer, dimension(:,:), allocatable :: out_mask_fulldomain + + ! Beginning of code + + call distributed_gather_var(instance%out_mask, out_mask_fulldomain) + + if (main_task) then + + instance%lgrid_fulldomain = coordsystem_new(0.d0, 0.d0, & + get_dew(instance%model), & + get_dns(instance%model), & + global_ewn, & + global_nsn) + + call new_downscale(instance%downs, instance%model%projection, grid, & + instance%lgrid_fulldomain, mpint=(instance%use_mpint==1)) + + call new_upscale(instance%ups, grid, instance%model%projection, & + out_mask_fulldomain, instance%lgrid_fulldomain) ! Initialise upscaling parameters + + if (present(grid_orog)) then + call new_upscale(instance%ups_orog, grid_orog, instance%model%projection, & + out_mask_fulldomain, instance%lgrid_fulldomain) ! Initialise upscaling parameters + endif + + call calc_coverage(instance%lgrid_fulldomain, & + instance%ups, & + grid, & + out_mask_fulldomain, & + instance%frac_coverage) + + if (present(grid_orog)) then + call calc_coverage(instance%lgrid_fulldomain, & + instance%ups_orog, & + grid_orog, & + out_mask_fulldomain, & + instance%frac_cov_orog) + endif + + end if + + end subroutine setup_lgrid_fulldomain + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine calc_coverage(lgrid_fulldomain, ups, grid, & + mask_fulldomain, frac_coverage) + + ! Calculates the fractional coverage of the global grid-boxes by the ice model domain + + use glimmer_map_types + use glimmer_coordinates + use glint_global_grid + + ! Arguments + + type(coordsystem_type), intent(in) :: lgrid_fulldomain !> Local grid, spanning full domain (all tasks) + type(upscale), intent(in) :: ups !> Upscaling used + type(global_grid), intent(in) :: grid !> Global grid used + integer, dimension(:,:),intent(in) :: mask_fulldomain !> Mask of points for upscaling, spanning full domain (all tasks) + real(dp),dimension(:,:),intent(out) :: frac_coverage !> Map of fractional + !> coverage of global by local grid-boxes. + ! Internal variables + + integer,dimension(grid%nx,grid%ny) :: tempcount + integer :: i,j + + ! Beginning of code + + tempcount=0 + + do i=1,lgrid_fulldomain%size%pt(1) + do j=1,lgrid_fulldomain%size%pt(2) + tempcount(ups%gboxx(i,j),ups%gboxy(i,j))=tempcount(ups%gboxx(i,j),ups%gboxy(i,j))+mask_fulldomain(i,j) + enddo + enddo + + do i=1,grid%nx + do j=1,grid%ny + if (tempcount(i,j) == 0) then + frac_coverage(i,j) = 0.d0 + else + frac_coverage(i,j) = (tempcount(i,j)*lgrid_fulldomain%delta%pt(1)*lgrid_fulldomain%delta%pt(2))/ & + (lon_diff(grid%lon_bound(i+1),grid%lon_bound(i))*D2R*EQ_RAD**2* & + (sin(grid%lat_bound(j)*D2R)-sin(grid%lat_bound(j+1)*D2R))) + endif + enddo + enddo + + ! Fix points that should be 1.0 by checking their surroundings + + ! Interior points first + + do i=2,grid%nx-1 + do j=2,grid%ny-1 + if ((frac_coverage(i,j) /= 0.d0) .and. & + (frac_coverage(i+1,j) /= 0.d0) .and. & + (frac_coverage(i,j+1) /= 0.d0) .and. & + (frac_coverage(i-1,j) /= 0.d0) .and. & + (frac_coverage(i,j-1) /= 0.d0) ) & + frac_coverage(i,j) = 1.d0 + enddo + enddo + + ! top and bottom edges + + do i=2,grid%nx/2 + if ((frac_coverage(i,1) /= 0.d0).and. & + (frac_coverage(i+1,1) /= 0.d0).and. & + (frac_coverage(i,2) /= 0.d0).and. & + (frac_coverage(i-1,1) /= 0.d0).and. & + (frac_coverage(i+grid%nx/2,1) /= 0.d0)) & + frac_coverage(i,1) = 1.d0 + enddo + + do i=grid%nx/2+1,grid%nx-1 + if ((frac_coverage(i,1) /= 0.d0).and. & + (frac_coverage(i+1,1) /= 0.d0).and. & + (frac_coverage(i,2) /= 0.d0).and. & + (frac_coverage(i-1,1) /= 0.d0).and. & + (frac_coverage(i-grid%nx/2,1) /= 0.d0)) & + frac_coverage(i,1) = 1.d0 + enddo + + do i=2,grid%nx/2 + if ((frac_coverage(i,grid%ny) /= 0.d0).and. & + (frac_coverage(i+1,grid%ny) /= 0.d0).and. & + (frac_coverage(i+grid%nx/2,grid%ny) /= 0.d0).and. & + (frac_coverage(i-1,grid%ny) /= 0.d0).and. & + (frac_coverage(i,grid%ny-1) /= 0.d0)) & + frac_coverage(i,grid%ny) = 1.d0 + enddo + + do i=grid%nx/2+1,grid%nx-1 + if ((frac_coverage(i,grid%ny) /= 0.d0).and. & + (frac_coverage(i+1,grid%ny) /= 0.d0).and. & + (frac_coverage(i-grid%nx/2,grid%ny) /= 0.d0).and. & + (frac_coverage(i-1,grid%ny) /= 0.d0).and. & + (frac_coverage(i,grid%ny-1) /= 0.d0)) & + frac_coverage(i,grid%ny) = 1.d0 + enddo + + ! left and right edges + + do j=2,grid%ny-1 + if ((frac_coverage(1,j) /= 0.d0).and. & + (frac_coverage(2,j) /= 0.d0).and. & + (frac_coverage(1,j+1) /= 0.d0).and. & + (frac_coverage(grid%nx,j) /= 0.d0).and. & + (frac_coverage(1,j-1) /= 0.d0)) & + frac_coverage(1,j) = 1.d0 + if ((frac_coverage(grid%nx,j) /= 0.d0).and. & + (frac_coverage(1,j) /= 0.d0).and. & + (frac_coverage(grid%nx,j+1) /= 0.d0).and. & + (frac_coverage(grid%nx-1,j) /= 0.d0).and. & + (frac_coverage(grid%nx,j-1) /= 0.d0)) & + frac_coverage(grid%nx,j) = 1.d0 + enddo + + ! corners + + if ((frac_coverage(1,1) /= 0.d0).and. & + (frac_coverage(2,1) /= 0.d0).and. & + (frac_coverage(1,2) /= 0.d0).and. & + (frac_coverage(grid%nx,1) /= 0.d0).and. & + (frac_coverage(grid%nx/2+1,1) /= 0.d0)) & + frac_coverage(1,1) = 1.d0 + + if ((frac_coverage(1,grid%ny) /= 0.d0).and. & + (frac_coverage(2,grid%ny) /= 0.d0).and. & + (frac_coverage(grid%nx/2+1,grid%ny) /= 0.d0).and. & + (frac_coverage(grid%nx,grid%ny) /= 0.d0).and. & + (frac_coverage(1,grid%ny-1) /= 0.d0)) & + frac_coverage(1,grid%ny) = 1.d0 + + if ((frac_coverage(grid%nx,1) /= 0.d0).and. & + (frac_coverage(1,1) /= 0.d0).and. & + (frac_coverage(grid%nx,2) /= 0.d0).and. & + (frac_coverage(grid%nx-1,1) /= 0.d0).and. & + (frac_coverage(grid%nx/2,1) /= 0.d0)) & + frac_coverage(grid%nx,1) = 1.d0 + + if ((frac_coverage(grid%nx,grid%ny) /= 0.d0).and. & + (frac_coverage(1,grid%ny) /= 0.d0).and. & + (frac_coverage(grid%nx/2,grid%ny) /= 0.d0).and. & + (frac_coverage(grid%nx-1,grid%ny) /= 0.d0).and. & + (frac_coverage(grid%nx,grid%ny-1) /= 0.d0)) & + frac_coverage(grid%nx,grid%ny) = 1.d0 + + ! Finally fix any rogue points > 1.0 + + where (frac_coverage > 1.d0) frac_coverage = 1.d0 + + end subroutine calc_coverage + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + real(dp) function lon_diff(a,b) + + implicit none + + real(dp),intent(in) :: a,b + real(dp) :: aa,bb + + aa=a ; bb=b + + do + if (aa > bb) exit + aa = aa + 360.d0 + enddo + + lon_diff = aa - bb + + end function lon_diff + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine define_glint_restart_variables(instance) + + ! This subroutine analyzes the glint options input by the user in the config file + ! and determines which variables are necessary for an exact restart. MJH 1/11/2013 + + ! Please comment thoroughly the reasons why a particular variable needs to be a restart variable for a given config. + + use glint_io, only: glint_add_to_restart_variable_list + use glint_mbal_io, only: glint_mbal_add_to_restart_variable_list + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + type(glint_instance), intent (in) :: instance !> Derived type that includes all glint options + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + ! Variables needed for restart with glint. + ! TODO I am inserting out_mask because it was the only variable with hot=1 in the old glint_vars.def + ! Not sure outflux is needed + call glint_add_to_restart_variable_list('outmask') + + ! The variables rofi_tavg, rofl_tavg, and hflx_tavg are time-averaged fluxes on the local grid + ! from the previous coupling interval. They are included here so that the coupler can be sent + ! the correct fluxes after restart; otherwise these fluxes would have values of zero. + ! These arrays are created only when Glint is run in GCM mode. + !TODO - Add av_count_output so we can restart in the middle of a mass balance timestep? + + if (instance%whichacab == MASS_BALANCE_GCM) then + call glint_add_to_restart_variable_list('rofi_tavg rofl_tavg hflx_tavg') + endif + + ! Variables needed for restart with glint_mbal + ! No variables had hot=1 in glint_mbal_vars.def, so I am not adding any restart variables here. + ! call glint_mbal_add_to_restart_variable_list('') + + end subroutine define_glint_restart_variables + + +end module glint_initialise diff --git a/components/cism/glimmer-cism/libglint/glint_integrate.F90 b/components/cism/glimmer-cism/libglint/glint_integrate.F90 new file mode 100644 index 0000000000..79accba10f --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_integrate.F90 @@ -0,0 +1,164 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_integrate.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +!> integration of functions using Romberg integration +module glint_integrate + + use glimmer_global, only : dp + + implicit none + + public :: romberg_int, romberg_int_prms + +!------------------------------------------------------------- + +contains + +!------------------------------------------------------------- + + !> double precision function to perform Romberg Integration on function. + !! + !! This routine is an implementation of ACM algorithm 60, by F. L. Bauer. + !! (Comm. ACM, vol. 4, issue 6, June 1961). + + recursive real(dp) function romberg_int(fct,lgr,rgr) + + implicit none + + interface + !> function to be integrated + function fct(x) + use glimmer_global, only : dp + implicit none + real(dp), intent(in) :: x !< the argument + real(dp) :: fct + end function fct + end interface + + real(dp),intent(in) :: lgr !< Lower bound + real(dp),intent(in) :: rgr !< Upper bound + integer,parameter :: ord = 6 + + real(dp),dimension(ord+1) :: t + real(dp) :: l,u,m + integer :: f,h,j,n + + l=rgr-lgr + t(1)=(fct(lgr)+fct(rgr))/2.0 + n=1 + + do h=1,ord + u=0 + m=l/(2*n) + + do j=1,2*n-1,2 + u=u+fct(lgr+j*m) + end do + + t(h+1)=((u/n)+t(h))/2.0 + f=1 + + do j=h,1,-1 + f=f*4 + t(j)=t(j+1)+(t(j+1)-t(j))/(f-1) + end do + + n=2*n + + end do + + romberg_int=t(1)*l + + end function romberg_int + +!------------------------------------------------------------- + + !> double precision function to perform Romberg Integration on function. + !! + !! This routine is an implementation of ACM algorithm 60, by F. L. Bauer. + !! (Comm. ACM, vol. 4, issue 6, June 1961). + + recursive real(dp) function romberg_int_prms(fct,lgr,rgr,params) + + implicit none + + interface + !> the function to be integrated + function fct(x,params) + use glimmer_global, only : dp + implicit none + real(dp), intent(in) :: x !< the argument + real(dp), intent(in), dimension(:) :: params !< an array of function parameters + real(dp) :: fct + end function fct + end interface + + real(dp),intent(in) :: lgr !< Lower bound + real(dp),intent(in) :: rgr !< Upper bound + real(dp),intent(in),dimension(:) :: params !< parameters for function + integer,parameter :: ord = 6 + + real(dp),dimension(ord+1) :: t + real(dp) :: l,u,m + integer :: f,h,j,n + + l=rgr-lgr + t(1)=(fct(lgr,params)+fct(rgr,params))/2.0 + n=1 + + do h=1,ord + u=0 + m=l/(2*n) + + do j=1,2*n-1,2 + u=u+fct(lgr+j*m,params) + end do + + t(h+1)=((u/n)+t(h))/2.0 + f=1 + + do j=h,1,-1 + f=f*4 + t(j)=t(j+1)+(t(j+1)-t(j))/(f-1) + end do + + n=2*n + + end do + + romberg_int_prms=t(1)*l + + end function romberg_int_prms + +!------------------------------------------------------------- + +end module glint_integrate + +!------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglint/glint_interp.F90 b/components/cism/glimmer-cism/libglint/glint_interp.F90 new file mode 100644 index 0000000000..816bea26c2 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_interp.F90 @@ -0,0 +1,1380 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_interp.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_interp + + !> Downscaling and upscaling routines for use in Glint + + use glimmer_global, only: dp, sp + use glimmer_map_types + use glint_mpinterp + use glimmer_paramets, only: stdout, GLC_DEBUG + + implicit none + + type downscale + + !> Derived type containing indexing + !> information for downscaling. This type was + !> included for speed. Four of the arrays contained in it + !> are arrays of the indices of the corners + !> of the global grid-boxes within which the given + !> local grid point lies. + + real(dp),dimension(:,:),pointer :: llats => null() !> The latitude of each point in x-y space. + real(dp),dimension(:,:),pointer :: llons => null() !> The longitude of each point in x-y space. + + integer, dimension(:,:,:),pointer :: xloc => null() !> The x-locations of the corner points of the + !> interpolation domain. + integer, dimension(:,:,:),pointer :: yloc => null() !> The y-locations of the corner points of the + !> interpolation domain. + integer, dimension(:,:), pointer :: xin => null() !> x-locations of global cell the point is in + integer, dimension(:,:), pointer :: yin => null() !> y-locations of global cell the point is in + + real(dp),dimension(:,:), pointer :: xfrac => null() + real(dp),dimension(:,:), pointer :: yfrac => null() + real(dp),dimension(:,:),pointer :: sintheta => NULL() !> sines of grid angle relative to north. + real(dp),dimension(:,:),pointer :: costheta => NULL() !> coses of grid angle relative to north. + type(mpinterp) :: mpint !> Parameters for mean-preserving interpolation + logical :: use_mpint = .false. !> set true if we're using mean-preserving interpolation + integer,dimension(:,:),pointer :: lmask => null() !> mask = 1 where downscaling is valid + !> mask = 0 elsewhere + + end type downscale + + type upscale + + !> Derived type containing indexing information + !> for upscaling by areal averaging. + + integer, dimension(:,:),pointer :: gboxx => null() !> $x$-indices of global grid-box + !> containing given local grid-box. + integer, dimension(:,:),pointer :: gboxy => null() !> $y$-indices of global grid-box + !> containing given local grid-box. + integer, dimension(:,:),pointer :: gboxn => null() !> Number of local grid-boxes + !> contained in each global box. + logical :: set = .false. !> Set if the type has been initialised. + + end type upscale + +contains + + subroutine new_downscale(downs,proj,ggrid,lgrid,mpint) + + use glint_global_grid + use glimmer_map_trans + use glimmer_map_types + use glimmer_coordinates + + !> Initialises a downscale variable, + !> according to given projected and global grids + + ! Arguments + + type(downscale),intent(out) :: downs !> Downscaling variable to be set + type(glimmap_proj),intent(in) :: proj !> Projection to use + type(global_grid),intent(in) :: ggrid !> Global grid to use + type(coordsystem_type),intent(in) :: lgrid !> Local (ice) grid + logical,optional :: mpint !> Set true if we're using mean-preserving interp + + ! Internal variables + + real(dp) :: llat,llon + integer :: i,j + type(upscale) :: ups + integer,dimension(:,:),pointer :: upsm + + upsm => null() + ! Allocate arrays + + allocate(downs%xloc(lgrid%size%pt(1),lgrid%size%pt(2),4)) + allocate(downs%yloc(lgrid%size%pt(1),lgrid%size%pt(2),4)) + call coordsystem_allocate(lgrid,downs%xfrac) + call coordsystem_allocate(lgrid,downs%yfrac) + call coordsystem_allocate(lgrid,downs%llons) + call coordsystem_allocate(lgrid,downs%llats) + call coordsystem_allocate(lgrid,downs%sintheta) + call coordsystem_allocate(lgrid,downs%costheta) + call coordsystem_allocate(lgrid,downs%xin) + call coordsystem_allocate(lgrid,downs%yin) + call coordsystem_allocate(lgrid,upsm) + call coordsystem_allocate(lgrid,downs%lmask) + + ! index local boxes + + call index_local_boxes(downs%xloc, downs%yloc, & + downs%xfrac, downs%yfrac, & + ggrid, proj, lgrid, & + downs%lmask ) + + ! Calculate grid angle + + call calc_grid_angle(downs,proj,lgrid) + + ! Find lats and lons + + do i=1,lgrid%size%pt(1) + do j=1,lgrid%size%pt(2) + call glimmap_xy_to_ll(llon,llat,real(i,kind=dp),real(j,kind=dp),proj,lgrid) + downs%llons(i,j)=llon + downs%llats(i,j)=llat + end do + end do + + ! Initialise mean-preserving interpolation if necessary + if (present(mpint)) then + if (mpint) then + call new_mpinterp(downs%mpint,ggrid) + downs%use_mpint = .true. + end if + end if + + call new_upscale(ups,ggrid,proj,upsm,lgrid) + downs%xin = ups%gboxx + downs%yin = ups%gboxy + deallocate(upsm) + + end subroutine new_downscale + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine interp_wind_to_local(lgrid_fulldomain,zonwind,merwind,downs,xwind,ywind) + + ! Interpolate a global wind field (or any vector field) onto a given projected grid. + ! + ! Currently doesn't work with multiple tasks + + use glimmer_utils + use glimmer_coordinates + use glimmer_log + use parallel, only : tasks + + ! Argument declarations + + type(coordsystem_type), intent(in) :: lgrid_fulldomain !> Target grid on the full domain (i.e., across all tasks) + real(dp),dimension(:,:),intent(in) :: zonwind !> Zonal component (input) + real(dp),dimension(:,:),intent(in) :: merwind !> Meridional components (input) + type(downscale), intent(inout) :: downs !> Downscaling parameters + real(dp),dimension(:,:),intent(out) :: xwind,ywind !> x and y components on the projected grid (output) + + ! Declare two temporary arrays to hold the interpolated zonal and meridional winds + + real(dp),dimension(size(xwind,1),size(xwind,2)) :: tempzw,tempmw + + ! Check input arrays are conformal to one another + + call check_conformal(zonwind,merwind,'interp_wind 1') + call check_conformal(xwind,ywind,'interp_wind 2') + + ! Interpolate onto the projected grid + + call interp_to_local(lgrid_fulldomain,zonwind,downs,localdp=tempzw) + call interp_to_local(lgrid_fulldomain,merwind,downs,localdp=tempmw) + + ! Apply rotation + + ! WJS (1-15-13): The following code won't work currently if there is more than 1 task, + ! because the downs variable applies to the full (non-decomposed) domain, and is only + ! valid on the master task + if (tasks > 1) then + call write_log('interp_wind_to_local only works with a single task', & + GM_FATAL, __FILE__, __LINE__) + end if + xwind=tempzw*downs%costheta-tempmw*downs%sintheta + ywind=tempzw*downs%sintheta+tempmw*downs%costheta + + end subroutine interp_wind_to_local + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine interp_to_local (lgrid_fulldomain, global, downs, & + localsp, localdp, & + global_fn, z_constrain, & + gmask, maskval) + + !> Interpolate a global scalar field onto a projected grid. + !> + !> This uses a simple bilinear interpolation, which assumes + !> that the global grid boxes are rectangular - i.e. it works + !> in lat-lon space. + !> + !> Either localsp or localdp must be present (or both), depending + !> which precision output is required. + !> + !> Variables referring to the global domain (global, downs, + !> gmask) only need to be valid on the main task + +! Cell indexing for (xloc,yloc) is as follows: +! +! 4---------3 +! | | +! | | +! | | +! 1---------2 +! + + use glimmer_utils + use glimmer_coordinates + use glimmer_log + use parallel, only : main_task, distributed_scatter_var, parallel_halo + + !TODO - Not sure we need localsp now that the code is fully double precision + + ! Argument declarations + + type(coordsystem_type), intent(in) :: lgrid_fulldomain !> Local grid, spanning the full domain (across all tasks) + real(dp), dimension(:,:),intent(in) :: global !> Global field (input) + type(downscale), intent(inout) :: downs !> Downscaling parameters + real(sp),dimension(:,:), intent(out),optional :: localsp !> Local field on projected grid (output) sp + real(dp),dimension(:,:), intent(out),optional :: localdp !> Local field on projected grid (output) dp + real(dp),optional,external :: global_fn !> Function returning values in global field. This + !> may be used as an alternative to passing the + !> whole array in \texttt{global} if, for instance the + !> data-set is in a large file, being accessed point by point. + !> In these circumstances, \texttt{global} + !> may be of any size, and its contents are irrelevant. + logical,optional :: z_constrain + integer, dimension(:,:), intent(in),optional :: gmask !> = 1 where global data are valid, else = 0 + real(dp), intent(in), optional :: maskval !> Value to write for masked-out cells + + ! Local variable declarations + + real(sp), dimension(:,:), allocatable :: localsp_fulldomain ! localsp spanning full domain (all tasks) + real(dp), dimension(:,:), allocatable :: localdp_fulldomain ! localdp spanning full domain (all tasks) + integer :: i,j ! Counter variables for main loop + real(dp),dimension(4) :: f ! Temporary array holding the four points in the + ! interpolation domain. + real(dp), dimension(size(global,1),size(global,2)) :: g_loc + logical, dimension(size(global,1),size(global,2)) :: zeros + logical :: zc + + integer :: x1, x2, x3, x4 + integer :: y1, y2, y3, y4 + + if (present(z_constrain)) then + zc = z_constrain + else + zc = .false. + end if + + ! check we have one output at least... + + if (.not. (present(localsp) .or. present(localdp)) ) then + call write_log('Interp_to_local has no output',GM_WARNING,__FILE__,__LINE__) + endif + + ! Allocate variables to hold result of interpolation + ! We allocate size 0 arrays on non-main task (rather than leaving variables + ! unallocated there), because distributed_scatter_var tries to do a deallocate on all tasks + ! Note that coordsystem_allocate can't be used here because it only works on pointer + ! variables, and the *_fulldomain variables are non-pointers (as is required for distributed_scatter_var) + + if (present(localsp)) then + if (main_task) then + allocate(localsp_fulldomain(lgrid_fulldomain%size%pt(1), lgrid_fulldomain%size%pt(2))) + else + allocate(localsp_fulldomain(0,0)) + end if + end if + + if (present(localdp)) then + if (main_task) then + allocate(localdp_fulldomain(lgrid_fulldomain%size%pt(1), lgrid_fulldomain%size%pt(2))) + else + allocate(localdp_fulldomain(0,0)) + end if + end if + +!WHL - debug +!! print*, ' ' +!! print*, 'In interp_to_local, local nx, ny =', lgrid_fulldomain%size%pt(1), lgrid_fulldomain%size%pt(2) + + ! Do main interpolation work, just on main task + + if (main_task) then + + ! Do stuff for mean-preserving interpolation + + if (downs%use_mpint) then + call mean_preserve_interp(downs%mpint,global,g_loc,zeros) + end if + + ! Main interpolation loop + + do i=1,lgrid_fulldomain%size%pt(1) + do j=1,lgrid_fulldomain%size%pt(2) + + ! Compile the temporary array f from adjacent points + + !TODO - This could be handled more efficiently by precomputing arrays that specify + ! which neighbor gridcell supplies values in each masked-out global gridcell. + + if (present(gmask) .and. present(maskval)) then + + if (downs%lmask(i,j) == 0) then + + f(1) = maskval + f(2) = maskval + f(3) = maskval + f(4) = maskval + + else + + x1 = downs%xloc(i,j,1); y1 = downs%yloc(i,j,1) + x2 = downs%xloc(i,j,2); y2 = downs%yloc(i,j,2) + x3 = downs%xloc(i,j,3); y3 = downs%yloc(i,j,3) + x4 = downs%xloc(i,j,4); y4 = downs%yloc(i,j,4) + + ! if a gridcell is masked out, try to assign a value from a + ! neighbor that is not masked out + + if (gmask(x1,y1) /= 0) then + f(1) = global(x1,y1) + elseif (gmask(x2,y2) /= 0) then + f(1) = global(x2,y2) + elseif (gmask(x4,y4) /= 0) then + f(1) = global(x4,y4) + elseif (gmask(x3,y3) /= 0) then + f(1) = global(x3,y3) + else + f(1) = maskval + endif + + if (gmask(x2,y2) /= 0) then + f(2) = global(x2,y2) + elseif (gmask(x1,y1) /= 0) then + f(2) = global(x1,y1) + elseif (gmask(x3,y3) /= 0) then + f(2) = global(x3,y3) + elseif (gmask(x4,y4) /= 0) then + f(2) = global(x4,y4) + else + f(2) = maskval + endif + + if (gmask(x3,y3) /= 0) then + f(3) = global(x3,y3) + elseif (gmask(x4,y4) /= 0) then + f(3) = global(x4,y4) + elseif (gmask(x2,y2) /= 0) then + f(3) = global(x2,y2) + elseif (gmask(x1,y1) /= 0) then + f(3) = global(x1,y1) + else + f(3) = maskval + endif + + if (gmask(x4,y4) /= 0) then + f(4) = global(x4,y4) + elseif (gmask(x3,y3) /= 0) then + f(4) = global(x3,y3) + elseif (gmask(x1,y1) /= 0) then + f(4) = global(x1,y1) + elseif (gmask(x2,y2) /= 0) then + f(4) = global(x2,y2) + else + f(4) = maskval + endif + + endif ! lmask = 0 + + else ! gmask and maskval not present + + if (present(global_fn)) then + f(1)=global_fn(downs%xloc(i,j,1),downs%yloc(i,j,1)) + f(2)=global_fn(downs%xloc(i,j,2),downs%yloc(i,j,2)) + f(3)=global_fn(downs%xloc(i,j,3),downs%yloc(i,j,3)) + f(4)=global_fn(downs%xloc(i,j,4),downs%yloc(i,j,4)) + else + if (downs%use_mpint) then + f(1)=g_loc(downs%xloc(i,j,1),downs%yloc(i,j,1)) + f(2)=g_loc(downs%xloc(i,j,2),downs%yloc(i,j,2)) + f(3)=g_loc(downs%xloc(i,j,3),downs%yloc(i,j,3)) + f(4)=g_loc(downs%xloc(i,j,4),downs%yloc(i,j,4)) + else + f(1)=global(downs%xloc(i,j,1),downs%yloc(i,j,1)) + f(2)=global(downs%xloc(i,j,2),downs%yloc(i,j,2)) + f(3)=global(downs%xloc(i,j,3),downs%yloc(i,j,3)) + f(4)=global(downs%xloc(i,j,4),downs%yloc(i,j,4)) + end if + end if + + endif ! gmask and maskval present + + ! Apply the bilinear interpolation + + if (zc.and.zeros(downs%xin(i,j),downs%yin(i,j)).and.downs%use_mpint) then + if (present(localsp)) localsp_fulldomain(i,j) = 0.0_sp + if (present(localdp)) localdp_fulldomain(i,j) = 0.0_dp + else + if (present(localsp)) localsp_fulldomain(i,j) = bilinear_interp(downs%xfrac(i,j),downs%yfrac(i,j),f) + if (present(localdp)) localdp_fulldomain(i,j) = bilinear_interp(downs%xfrac(i,j),downs%yfrac(i,j),f) + end if + + enddo + enddo + end if ! main_task + + ! Main task scatters interpolated data from the full domain to the task owning each point + ! Note that distributed_scatter_var doesn't set halo values, so we need to do a halo + ! update if it's important to have correct values in the halo cells. + ! Although it's not strictly necessary to have the halo values, we compute them just in + ! case another part of the code (e.g., glissade_temp) assumes they are available. + + if (present(localsp)) then + localsp(:,:) = 0.d0 + call distributed_scatter_var(localsp, localsp_fulldomain) + call parallel_halo(localsp) + endif + + if (present(localdp)) then + localdp(:,:) = 0.d0 + call distributed_scatter_var(localdp, localdp_fulldomain) + call parallel_halo(localdp) + endif + + ! We do NOT deallocate the local*_fulldomain variables here, because the + ! distributed_scatter_var routines do this deallocation + + end subroutine interp_to_local + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine copy_to_local (lgrid_fulldomain, global, downs, local) + + ! Do a simple copy of a global scalar field onto a projected grid. + ! + ! This copies the value from each global cell into all local cells contained + ! within it. + ! + ! Note that, in contrast to interp_to_local, this routine does not support a gmask. + ! + ! Variables referring to the global domain (global, downs) only need to be valid + ! on the main task. + + use glimmer_coordinates + use parallel, only : main_task, distributed_scatter_var, parallel_halo + + ! Argument declarations + + type(coordsystem_type), intent(in) :: lgrid_fulldomain !> Local grid, spanning the full domain (across all tasks) + real(dp), dimension(:,:),intent(in) :: global !> Global field (input) + type(downscale), intent(in) :: downs !> Downscaling parameters + real(dp),dimension(:,:), intent(out) :: local !> Local field on projected grid (output) + + ! Local variable declarations + + real(dp), dimension(:,:), allocatable :: local_fulldomain ! local spanning full domain (all tasks) + integer :: i,j ! local indices + integer :: ig,jg ! global indices + + if (main_task) then + allocate(local_fulldomain(lgrid_fulldomain%size%pt(1), lgrid_fulldomain%size%pt(2))) + else + allocate(local_fulldomain(0,0)) + end if + + ! Do main copying work, just on main task + + if (main_task) then + do j=1,lgrid_fulldomain%size%pt(2) + do i=1,lgrid_fulldomain%size%pt(1) + ig = downs%xin(i,j) + jg = downs%yin(i,j) + local_fulldomain(i,j) = global(ig,jg) + end do + end do + end if + + ! Main task scatters interpolated data from the full domain to the task owning each point + ! Note that distributed_scatter_var doesn't set halo values, so we need to do a halo + ! update if it's important to have correct values in the halo cells. + ! Although it's not strictly necessary to have the halo values, we compute them just in + ! case another part of the code (e.g., glissade_temp) assumes they are available. + + local(:,:) = 0.d0 + call distributed_scatter_var(local, local_fulldomain) + call parallel_halo(local) + + ! We do NOT deallocate local_fulldomain here, because the distributed_scatter_var + ! routine does this deallocation + + end subroutine copy_to_local + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine mean_to_local(proj,lgrid,ggrid,global,localsp,localdp,global_fn) + + ! Average a high-resolution global field onto the projected grid. + ! This assumes that the global field is sufficiently high-resolution + ! compared with the local grid - it just averages the points contained + ! in each local grid-box. + ! + ! This may not work properly with multiple tasks. + + use glimmer_map_types + use glimmer_map_trans + use glimmer_coordinates + use glimmer_utils + use glimmer_log + use glint_global_grid + + ! Argument declarations + + type(glimmap_proj), intent(in) :: proj !> Target map projection + type(coordsystem_type), intent(in) :: lgrid !> Local grid information + type(global_grid), intent(in) :: ggrid !> Global grid information + real(dp),dimension(:,:), intent(in) :: global !> Global field (input) + real(sp),dimension(:,:),optional,intent(out) :: localsp !> Local field on projected grid (output) sp + real(dp),dimension(:,:),optional,intent(out) :: localdp !> Local field on projected grid (output) dp + real(dp),optional, external :: global_fn !> Function returning values in global field. This + !> may be used as an alternative to passing the + !> whole array in \texttt{global} if, for instance the + !> data-set is in a large file, being accessed point by point. + !> In these circumstances, \texttt{global} + !> may be of any size, and its contents are irrelevant. + + integer :: i,j,xbox,ybox + real(dp) :: lat,lon,x,y + real(dp),dimension(lgrid%size%pt(1),lgrid%size%pt(2)) :: temp_out + real(dp),dimension(lgrid%size%pt(1),lgrid%size%pt(2)) :: mean_count + + if (.not.present(global_fn)) then + if ((lgrid%size%pt(1)/=size(ggrid%lons)).or.(lgrid%size%pt(2)/=size(ggrid%lats))) then + call write_log('Size mismatch in interp_to_local',GM_FATAL,__FILE__,__LINE__) + end if + end if + + ! check we have one output at least... + + if (.not. (present(localsp) .or. present(localdp))) then + call write_log('mean_to_local has no output',GM_WARNING,__FILE__,__LINE__) + endif + + ! Zero some things + + mean_count = 0 + temp_out = 0.d0 + + ! Loop over all global points + + do i=1,lgrid%size%pt(1) + + lon=ggrid%lons(i) + + do j=1,lgrid%size%pt(2) + + ! Find location in local coordinates + + lat=ggrid%lats(j) ! (Have already found lat above) + call glimmap_ll_to_xy(lon,lat,x,y,proj,lgrid) + xbox=nint(x) + ybox=nint(y) + + ! Add to appropriate location and update count + + if (xbox >= 1.and.xbox <= lgrid%size%pt(1).and. & + ybox >= 1.and.ybox <= lgrid%size%pt(2)) then + if (present(global_fn)) then + temp_out(xbox,ybox)=temp_out(xbox,ybox)+global_fn(i,j)*ggrid%box_areas(xbox,ybox) + else + temp_out(xbox,ybox)=temp_out(xbox,ybox)+global(i,j)*ggrid%box_areas(xbox,ybox) + end if + mean_count(xbox,ybox)=mean_count(xbox,ybox)+ggrid%box_areas(xbox,ybox) + end if + + end do + end do + + ! Divide by number of contributing points and copy to output + + if (present(localsp)) localsp = temp_out/real(mean_count,sp) + if (present(localdp)) localdp = temp_out/real(mean_count,dp) + + end subroutine mean_to_local + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine pointwise_to_global(proj,lgrid,local,lons,lats,global) + + ! Upscale to global domain by pointwise sampling. + ! + ! Note that this is the mathematically inverse process of the + ! \texttt{interp\_to\_local} routine. + ! + ! This probably doesn't work correctly with multiple tasks. + + use glimmer_coordinates + use glimmer_map_trans + + ! Arguments + + type(glimmap_proj), intent(in) :: proj !> Projection to use + type(coordsystem_type), intent(in) :: lgrid !> Local grid + real(dp),dimension(:,:),intent(in) :: local !> Local field (input) + real(dp),dimension(:,:),intent(out) :: global !> Global field (output) + real(dp),dimension(:), intent(in) :: lats !> Latitudes of grid-points (degrees) + real(dp),dimension(:), intent(in) :: lons !> Longitudes of grid-points (degrees) + + ! Internal variables + + real(dp),dimension(2,2) :: f + integer :: nxg,nyg,nxl,nyl,i,j,xx,yy + real(dp) :: x,y + real(dp),dimension(size(local,1),size(local,2)) :: tempmask + + nxg=size(global,1) ; nyg=size(global,2) + nxl=size(local,1) ; nyl=size(local,2) + + do i=1,nxg + do j=1,nyg + call glimmap_ll_to_xy(lons(i),lats(j),x,y,proj,lgrid) + xx = int(x) + yy = int(y) + if (nint(x)<=1 .or. nint(x)>nxl-1 .or. nint(y)<=1 .or. nint(y)>nyl-1) then + global(i,j) = 0.d0 + else + f = local(xx:xx+1,yy:yy+1)*tempmask(xx:xx+1,yy:yy+1) + global(i,j) = bilinear_interp((x-real(xx))/1.d0,(y-real(yy))/1.d0,f) + endif + enddo + enddo + + end subroutine pointwise_to_global + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine local_to_global_avg(ups,local,global,mask) + + !> Upscale to global domain by areal averaging. + !> + !> Note that: + !> \begin{itemize} + !> \item \texttt{global} output is only valid on the main task + !> \item \texttt{ups} input only needs to be valid on the main task + !> \item \texttt{gboxx} and \texttt{gboxy} are the same size as \texttt{local_fulldomain} + !> \item \texttt{gboxn} is the same size as \texttt{global} + !> \item This method is \emph{not} the mathematical inverse of the + !> \texttt{interp\_to\_local} routine. + !> \end{itemize} + + use parallel, only : main_task, distributed_gather_var + use nan_mod , only : NaN + + ! Arguments + + type(upscale), intent(in) :: ups !> Upscaling indexing data. + real(dp),dimension(:,:),intent(in) :: local !> Data on projected grid (input). + real(dp),dimension(:,:),intent(out) :: global !> Data on global grid (output). + integer, dimension(:,:),intent(in),optional :: mask !> Mask for upscaling + + ! Internal variables + + integer :: nxl_full,nyl_full,i,j + real(dp),dimension(size(local,1),size(local,2)) :: tempmask + + ! values of 'local' and 'tempmask' spanning full domain (all tasks) + real(dp),dimension(:,:), allocatable :: local_fulldomain + real(dp),dimension(:,:), allocatable :: tempmask_fulldomain + real(dp),dimension(:,:) ,allocatable :: ncells + + ! Beginning of code + + allocate(ncells(size(global,1), size(global,2))) + + global(:,:) = NaN + + if (present(mask)) then + tempmask = mask + else + tempmask = 1.d0 + endif + + ! Gather 'local' and 'tempmask' onto main task, which is the only one that does the regridding + + call distributed_gather_var(local, local_fulldomain) + call distributed_gather_var(tempmask, tempmask_fulldomain) + + ! Main task does regridding + + if (main_task) then + + nxl_full = size(local_fulldomain,1) + nyl_full = size(local_fulldomain,2) + global(:,:) = 0.d0 + ncells(:,:) = 0.d0 + + do i=1,nxl_full + do j=1,nyl_full + if (tempmask_fulldomain(i,j) .gt. 0.) then + !accumulate values to be averaged + global(ups%gboxx(i,j),ups%gboxy(i,j)) = global(ups%gboxx(i,j),ups%gboxy(i,j)) & + + local_fulldomain(i,j)*tempmask_fulldomain(i,j) + + !accumulate counter that determines how many cells are being used in the average. + !This accumulator only counts points that are included in the mask, and as such + !avoids counting up points that are outside the 'area of interest'. + ncells(ups%gboxx(i,j),ups%gboxy(i,j)) = ncells(ups%gboxx(i,j),ups%gboxy(i,j)) + 1. + end if + enddo + enddo + + !Calculate average value. + where (ncells /= 0) + global = global / ncells + elsewhere + global(:,:) = 0.d0 + endwhere + + end if ! main_task + + if (allocated(local_fulldomain)) deallocate(local_fulldomain) + if (allocated(tempmask_fulldomain)) deallocate(tempmask_fulldomain) + if (allocated(ncells)) deallocate(ncells) + + end subroutine local_to_global_avg + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine local_to_global_sum(ups,local,global,mask) + + !> Upscale to global domain by summing local field. + !> The result is an accumulated sum, not an average. + !> + !> Note that: + !> \begin{itemize} + !> \item \texttt{global} output is only valid on the main task + !> \item \texttt{ups} input only needs to be valid on the main task + !> \item \texttt{gboxx} and \texttt{gboxy} are the same size as \texttt{local_fulldomain} + !> \item \texttt{gboxn} is the same size as \texttt{global} + !> \end{itemize} + + use parallel, only : main_task, distributed_gather_var + use nan_mod , only : NaN + + ! Arguments + + type(upscale), intent(in) :: ups !> Upscaling indexing data. + real(dp),dimension(:,:),intent(in) :: local !> Data on projected grid (input). + real(dp),dimension(:,:),intent(out) :: global !> Data on global grid (output). + integer,dimension(:,:),intent(in),optional :: mask !> Mask for upscaling + + ! Internal variables + + integer :: nxl_full,nyl_full,i,j + real(dp),dimension(size(local,1),size(local,2)) :: tempmask + + ! values of 'local' and 'tempmask' spanning full domain (all tasks) + real(dp),dimension(:,:), allocatable :: local_fulldomain + real(dp),dimension(:,:), allocatable :: tempmask_fulldomain + + ! Beginning of code + + global = NaN + + if (present(mask)) then + tempmask = mask + else + tempmask = 1.d0 + endif + + ! Gather 'local' and 'tempmask' onto main task, which is the only one that does the regridding + + call distributed_gather_var(local, local_fulldomain) + call distributed_gather_var(tempmask, tempmask_fulldomain) + + ! Main task does regridding + if (main_task) then + + nxl_full = size(local_fulldomain,1) + nyl_full = size(local_fulldomain,2) + global = 0.d0 + + do i=1,nxl_full + do j=1,nyl_full + global(ups%gboxx(i,j),ups%gboxy(i,j)) = global(ups%gboxx(i,j),ups%gboxy(i,j)) & + + local_fulldomain(i,j)*tempmask_fulldomain(i,j) + enddo + enddo + + end if ! main_task + + if (allocated(local_fulldomain)) deallocate(local_fulldomain) + if (allocated(tempmask_fulldomain)) deallocate(tempmask_fulldomain) + + end subroutine local_to_global_sum + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine local_to_global_min(ups,local,global,mask) + + !> Upscale to global domain by finding the minimum of the local field. + !> The result is an accumulated sum, not an average. + !> + !> Note that: + !> \begin{itemize} + !> \item \texttt{global} output is only valid on the main task + !> \item \texttt{ups} input only needs to be valid on the main task + !> \item \texttt{gboxx} and \texttt{gboxy} are the same size as \texttt{local_fulldomain} + !> \item \texttt{gboxn} is the same size as \texttt{global} + !> \end{itemize} + + use parallel, only : main_task, distributed_gather_var + use nan_mod , only : NaN + + ! Arguments + + type(upscale), intent(in) :: ups !> Upscaling indexing data. + real(dp),dimension(:,:),intent(in) :: local !> Data on projected grid (input). + real(dp),dimension(:,:),intent(out) :: global !> Data on global grid (output). + integer,dimension(:,:),intent(in),optional :: mask !> Mask for upscaling + + ! Internal variables + + integer :: nxl_full,nyl_full,i,j + real(dp),dimension(size(local,1),size(local,2)) :: tempmask + + ! values of 'local' and 'tempmask' spanning full domain (all tasks) + real(dp),dimension(:,:), allocatable :: local_fulldomain + real(dp),dimension(:,:), allocatable :: tempmask_fulldomain + + ! Beginning of code + + global = NaN + + if (present(mask)) then + tempmask = mask + else + tempmask = 1 + endif + + ! Gather 'local' and 'tempmask' onto main task, which is the only one that does the regridding + + call distributed_gather_var(local, local_fulldomain) + call distributed_gather_var(tempmask, tempmask_fulldomain) + + ! Main task does regridding + if (main_task) then + + nxl_full = size(local_fulldomain,1) + nyl_full = size(local_fulldomain,2) + global(:,:) = 0.d0 + + ! Set topography value in global cells for which the mask exists, to a very high value. + ! This should be reduced on the next swing through the loop. + do i=1,nxl_full + do j=1,nyl_full + if (tempmask_fulldomain(i,j) > 0.d0) then + global(ups%gboxx(i,j),ups%gboxy(i,j)) = huge(1.d0) + endif + enddo + enddo + + do i=1,nxl_full + do j=1,nyl_full + if (tempmask_fulldomain(i,j) > 0.d0) then + global(ups%gboxx(i,j),ups%gboxy(i,j)) = min ( & + global(ups%gboxx(i,j),ups%gboxy(i,j)), local_fulldomain(i,j)) + end if + enddo + enddo + + end if ! main_task + + if (allocated(local_fulldomain)) deallocate(local_fulldomain) + if (allocated(tempmask_fulldomain)) deallocate(tempmask_fulldomain) + + end subroutine local_to_global_min + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + real(dp) function bilinear_interp(xp,yp,f) + + ! Performs bilinear interpolation in a rectangular domain. + ! Note that the bilinear interpolation formula is: + ! \[f_{\mathtt{x},\mathtt{y}} = (1-X')(1-Y')f_{1} + X'(1-Y')f_{2} + X'Y'f_{3} + (1-X')Y'f_{4}\] + ! where $X'$ and $Y'$ are the fractional displacements of the target point within the domain. + ! The value of \texttt{f} at \texttt{x,y} + + ! Argument declarations + + real(dp), intent(in) :: xp !> The fractional $x$-displacement of the target. + real(dp), intent(in) :: yp !> The fractional $y$-displacement of the target. + real(dp),dimension(4),intent(in) :: f !> The interpolation domain; + !> i.e. the four points surrounding the + !> target, presented anticlockwise from bottom- + !> left + ! Apply bilinear interpolation formula + + bilinear_interp = (1.d0-xp)*(1.d0-yp)*f(1) + xp*(1.d0-yp)*f(2) + xp*yp*f(3) + (1.d0-xp)*yp*f(4) + + end function bilinear_interp + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine find_ll_index(il,jl,lon,lat,lons,lats) + + !> Find the global gridpoint at the first corner of the box surrounding + !> a given location in lat-lon space. + + use glimmer_utils + + ! Arguments + + real(dp), intent(in) :: lon !> Longitude of location to be indexed (input) + real(dp), intent(in) :: lat !> Latitude of location to be indexed (input) + real(dp),dimension(:),intent(in) :: lats !> Latitudes of global grid points + real(dp),dimension(:),intent(in) :: lons !> Longitudes of global grid points + integer, intent(out) :: il !> $x$-gridpoint index (output) + integer, intent(out) :: jl !> $y$-gridpoint index (output) + + ! Internal variables + + integer :: nx,ny,i + + nx=size(lons) ; ny=size(lats) + + il=nx + + do i=1,nx-1 + if (lon_between(lons(i),lons(i+1),lon)) then + il=i + exit + endif + enddo + + if ((lat-90.0)) then + jl=ny + return + endif + + if ((lat>lats(1)).and.(lat<90.0)) then + jl=1 + return + endif + + jl=1 + do + if (lat>lats(jl)) exit + jl=jl+1 + enddo + + end subroutine find_ll_index + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine index_local_boxes (xloc, yloc, xfrac, yfrac, ggrid, proj, lgrid, lmask) + + !> Indexes the corners of the + !> global grid box in which each local grid box sits. + + use glimmer_utils + use glint_global_grid + use glimmer_coordinates + use glimmer_map_trans + use parallel, only: main_task + + ! Arguments + + integer, dimension(:,:,:),intent(out) :: xloc,yloc !> Array of indicies (see \texttt{downscale} type) + real(dp),dimension(:,:), intent(out) :: xfrac,yfrac !> Fractional off-sets of grid points + type(global_grid), intent(in) :: ggrid !> Global grid to be used + type(glimmap_proj), intent(in) :: proj !> Projection to be used + type(coordsystem_type), intent(in) :: lgrid !> Local grid + integer, dimension(:,:), intent(out) :: lmask !> Mask of local cells for which interpolation is valid + + ! Internal variables + + integer :: i,j,il,jl,temp + real(dp) :: ilon,jlat,xa,ya,xb,yb,xc,yc,xd,yd + integer :: nx, ny, nxg, nyg + + if (GLC_DEBUG .and. main_task) then + nx = lgrid%size%pt(1) + ny = lgrid%size%pt(2) + nxg = size(ggrid%mask,1) + nyg = size(ggrid%mask,2) + + write(stdout,*) ' ' + write(stdout,*) 'nx, ny =', nx, ny + write(stdout,*) 'nxg, nyg =', nxg, nyg + write(stdout,*) 'Indexing local boxes' + end if + + do i=1,lgrid%size%pt(1) + do j=1,lgrid%size%pt(2) + + ! Find out where point i,j is in lat-lon space + + call glimmap_xy_to_ll(ilon,jlat,real(i,kind=dp),real(j,kind=dp),proj,lgrid) + + ! Index that location onto the global grid + + call find_ll_index(il,jl,ilon,jlat,ggrid%lons,ggrid%lats) + + xloc(i,j,1)=il ! This is the starting point - we now need to find + yloc(i,j,1)=jl ! three other points that enclose the interpolation target + + if (jlat>ggrid%lats(ggrid%ny)) then + + ! For all points except on the bottom row + + xloc(i,j,2)=il+1 + yloc(i,j,2)=jl + + xloc(i,j,3)=il+1 + yloc(i,j,3)=jl-1 + + xloc(i,j,4)=il + yloc(i,j,4)=jl-1 + + call fix_bcs2d(xloc(i,j,2) ,yloc(i,j,2),ggrid%nx,ggrid%ny) + call fix_bcs2d(xloc(i,j,3) ,yloc(i,j,3),ggrid%nx,ggrid%ny) + call fix_bcs2d(xloc(i,j,4) ,yloc(i,j,4),ggrid%nx,ggrid%ny) + + if (jl==1) then + temp=xloc(i,j,3) + xloc(i,j,3)=xloc(i,j,4) + xloc(i,j,4)=temp + endif + + else + + ! The bottom row + + xloc(i,j,2)=il-1 + yloc(i,j,2)=jl + + xloc(i,j,3)=il-1 + yloc(i,j,3)=jl+1 + + xloc(i,j,4)=il + yloc(i,j,4)=jl+1 + + call fix_bcs2d(xloc(i,j,2) ,yloc(i,j,2),ggrid%nx,ggrid%ny) + call fix_bcs2d(xloc(i,j,3) ,yloc(i,j,3),ggrid%nx,ggrid%ny) + call fix_bcs2d(xloc(i,j,4) ,yloc(i,j,4),ggrid%nx,ggrid%ny) + + temp=xloc(i,j,3) + xloc(i,j,3)=xloc(i,j,4) + xloc(i,j,4)=temp + + endif + + ! Now, find out where each of those points is on the projected + ! grid, and calculate fractional displacements accordingly + + call glimmap_ll_to_xy(ggrid%lons(xloc(i,j,1)),ggrid%lats(yloc(i,j,1)),xa,ya,proj,lgrid) + call glimmap_ll_to_xy(ggrid%lons(xloc(i,j,2)),ggrid%lats(yloc(i,j,2)),xb,yb,proj,lgrid) + call glimmap_ll_to_xy(ggrid%lons(xloc(i,j,3)),ggrid%lats(yloc(i,j,3)),xc,yc,proj,lgrid) + call glimmap_ll_to_xy(ggrid%lons(xloc(i,j,4)),ggrid%lats(yloc(i,j,4)),xd,yd,proj,lgrid) + + call calc_fractional(xfrac(i,j),yfrac(i,j),real(i,kind=dp),real(j,kind=dp), & + xa,ya,xb,yb,xc,yc,xd,yd) + + ! If all four global gridcells surrounding this local gridcell + ! are masked out, then mask out the local gridcell + + if ( (ggrid%mask(xloc(i,j,1),yloc(i,j,1)) == 0) .and. & + (ggrid%mask(xloc(i,j,2),yloc(i,j,2)) == 0) .and. & + (ggrid%mask(xloc(i,j,3),yloc(i,j,3)) == 0) .and. & + (ggrid%mask(xloc(i,j,4),yloc(i,j,4)) == 0) ) then + lmask(i,j) = 0 + else + lmask(i,j) = 1 + endif + + enddo + enddo + + end subroutine index_local_boxes + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine calc_grid_angle(downs,proj,lgrid) + + !> Calculates the angle the projected + !> grid makes with north at each point and stores the cos + !> and sin of that angle in the relevant arrays in \texttt{proj}. + + use glimmer_coordinates + use glimmer_map_trans + + type(downscale),intent(inout) :: downs !> The projection to be used + type(glimmap_proj),intent(in) :: proj + type(coordsystem_type),intent(in) :: lgrid + + integer :: i,j + real(dp) :: latn,lonn,lats,lons,lat,lon,dlat,dlon,temp + + do i=1,lgrid%size%pt(1) + + ! Main, central block + + do j=2,lgrid%size%pt(2)-1 + call glimmap_xy_to_ll(lonn,latn,real(i,kind=dp),real(j+1,kind=dp),proj,lgrid) + call glimmap_xy_to_ll(lon,lat,real(i,kind=dp),real(j,kind=dp),proj,lgrid) + call glimmap_xy_to_ll(lons,lats,real(i,kind=dp),real(j-1,kind=dp),proj,lgrid) + dlat=latn-lats + dlon=lonn-lons + if (dlon<-90) dlon=dlon+360 + temp=atan(dlon/dlat) + downs%sintheta(i,j)=sin(temp) + downs%costheta(i,j)=cos(temp) + enddo + + ! bottom row + + call glimmap_xy_to_ll(lonn,latn,real(i,kind=dp),real(2,kind=dp),proj,lgrid) + call glimmap_xy_to_ll(lon,lat,real(i,kind=dp),real(1,kind=dp),proj,lgrid) + dlat=latn-lat + dlon=lonn-lon + if (dlon<-90) dlon=dlon+360 + temp=atan(dlon/dlat) + downs%sintheta(i,1)=sin(temp) + downs%costheta(i,1)=cos(temp) + + ! top row + + call glimmap_xy_to_ll(lon,lat,real(i,kind=dp),real(lgrid%size%pt(2),kind=dp),proj,lgrid) + call glimmap_xy_to_ll(lons,lats,real(i,kind=dp),real(lgrid%size%pt(2)-1,kind=dp),proj,lgrid) + dlat=lat-lats + dlon=lon-lons + if (dlon<-90) dlon=dlon+360 + temp=atan(dlon/dlat) + downs%sintheta(i,lgrid%size%pt(2))=sin(temp) + downs%costheta(i,lgrid%size%pt(2))=cos(temp) + + enddo + + end subroutine calc_grid_angle + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine new_upscale(ups,ggrid,proj,mask,lgrid) + + use glint_global_grid + use glimmer_log + use glimmer_map_trans + use glimmer_coordinates + + !> Compiles an index of which global grid box contains a given + !> grid box on the projected grid, and sets derived type \texttt{ups} + !> accordingly. + + ! Arguments + + type(upscale), intent(out) :: ups !> Upscaling type to be set + type(global_grid), intent(in) :: ggrid !> Global grid to be used + type(glimmap_proj), intent(in) :: proj !> Projection being used + integer,dimension(:,:),intent(in) :: mask !> Upscaling mask to be used + type(coordsystem_type),intent(in) :: lgrid !> local grid + + ! Internal variables + + integer :: i,j,ii,jj,nx,ny,gnx,gny + real(dp) :: plon,plat + + ! Beginning of code + + if (associated(ups%gboxx)) deallocate(ups%gboxx) + if (associated(ups%gboxy)) deallocate(ups%gboxy) + if (associated(ups%gboxn)) deallocate(ups%gboxn) + + allocate(ups%gboxx(lgrid%size%pt(1),lgrid%size%pt(2))) + allocate(ups%gboxy(lgrid%size%pt(1),lgrid%size%pt(2))) + allocate(ups%gboxn(ggrid%nx,ggrid%ny)) + + gnx=ggrid%nx ; gny=ggrid%ny + nx =lgrid%size%pt(1) ; ny =lgrid%size%pt(2) + + ups%gboxx=0 ; ups%gboxy=0 + + do i=1,nx + do j=1,ny + call glimmap_xy_to_ll(plon,plat,real(i,kind=dp),real(j,kind=dp),proj,lgrid) + ii=1 ; jj=1 + do + ups%gboxx(i,j)=ii + if (ii>gnx) then + call write_log('global index failure',GM_FATAL,__FILE__,__LINE__) + endif + if (lon_between(ggrid%lon_bound(ii),ggrid%lon_bound(ii+1),plon)) exit + ii=ii+1 + enddo + + jj=1 + + do + ups%gboxy(i,j)=jj + if (jj>gny) then + call write_log('global index failure',GM_FATAL,__FILE__,__LINE__) + endif + if ((ggrid%lat_bound(jj)>=plat).and.(plat>ggrid%lat_bound(jj+1))) exit + jj=jj+1 + enddo + + enddo + enddo + + ups%gboxn=0 + + do i=1,nx + do j=1,ny + ups%gboxn(ups%gboxx(i,j),ups%gboxy(i,j))=ups%gboxn(ups%gboxx(i,j),ups%gboxy(i,j))+mask(i,j) + enddo + enddo + + ups%set=.true. + + end subroutine new_upscale + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine copy_upscale(in,out) + + use glimmer_log + + type(upscale),intent(in) :: in + type(upscale),intent(out) :: out + + if (.not.in%set) then + call write_log('Attempt to copy un-initialised upscale type',GM_FATAL,& + __FILE__,__LINE__) + endif + + if (associated(out%gboxx)) deallocate(out%gboxx) + if (associated(out%gboxy)) deallocate(out%gboxy) + if (associated(out%gboxn)) deallocate(out%gboxn) + + allocate(out%gboxx(size(in%gboxx,1),size(in%gboxx,2))) + allocate(out%gboxy(size(in%gboxy,1),size(in%gboxy,2))) + allocate(out%gboxn(size(in%gboxn,1),size(in%gboxn,2))) + + out%gboxx=in%gboxx + out%gboxy=in%gboxy + out%gboxn=in%gboxn + + out%set=.true. + + end subroutine copy_upscale + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + logical function lon_between(a,b,x) + + !> Checks to see whether a + !> longitudinal coordinate is between two bounds, + !> taking into account the periodic boundary conditions. + !*RV Returns \texttt{.true.} if $\mathtt{x}\geq \mathtt{a}$ and $\mathtt{x}<\mathtt{b}$. + + ! Arguments + + real(dp),intent(in) :: a !> Lower bound on interval for checking + real(dp),intent(in) :: b !> Upper bound on interval for checking + real(dp),intent(in) :: x !> Test value (degrees) + + ! Internal variables + + real(dp) :: ta,tb + + ! Beginning of code + + if (a=a).and.(x=ta).and.(x Performs a coordinate transformation to locate the point + !> $(X',Y')$ fractionally within an arbitrary quadrilateral, + !> defined by the points $(x_A,y_A)$, $(x_B,y_B)$, + !> $(x_C,y_C)$ and $(x_D,y_D)$, which are ordered + !> anticlockwise. + + real(dp),intent(out) :: x !> The fractional $x$ location. + real(dp),intent(out) :: y !> The fractional $y$ location. + real(dp),intent(in) :: xp,yp,xa,ya,xb,yb,xc,yc,xd,yd + + real(dp) :: a,b,c + real(dp),parameter :: small=1d-8 + + a=(yb-ya)*(xc-xd)-(yc-yd)*(xb-xa) + + b=xp*(yc-yd)-yp*(xc-xd) & + +xd*(yb-ya)-yd*(xb-xa) & + -xp*(yb-ya)+yp*(xb-xa) & + -xa*(yc-yd)+ya*(xc-xd) + + c=xp*(yd-ya)+yp*(xa-xd)+ya*xd-xa*yd + + if (abs(a)>small) then + x=(-b-sqrt(b**2-4*a*c))/(2*a) + else + x=-c/b + endif + + y=(yp-ya-x*(yb-ya))/(yd+x*(yc-yd-yb+ya)-ya) + + if (GLC_DEBUG) then +! Could use the following code if points are degenerate (a=b, c=d, etc.) +! if (abs(a) > small) then +! x=(-b-sqrt(b**2-4*a*c))/(2*a) +! elseif (abs(b) > small) then +! x=-c/b +! else +! x=0.d0 +! endif +! +! if (abs(yd+x*(yc-yd-yb+ya)-ya) > small) then +! y=(yp-ya-x*(yb-ya))/(yd+x*(yc-yd-yb+ya)-ya) +! else +! y=0.d0 +! endif + end if + + end subroutine calc_fractional + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_interp diff --git a/components/cism/glimmer-cism/libglint/glint_io.F90.default b/components/cism/glimmer-cism/libglint/glint_io.F90.default new file mode 100644 index 0000000000..eefa249d91 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_io.F90.default @@ -0,0 +1,1248 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! WARNING: this file was automatically generated on +! Fri, 03 Apr 2015 18:33:13 +0000 +! from ncdf_template.F90.in +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + + +module glint_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use glint_type + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in glint_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine glint_io_createall(model,data,outfiles) + ! open all netCDF files for output + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(glint_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in glint_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call glint_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine glint_io_createall + + subroutine glint_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glint_instance) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glint_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call glint_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glint_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine glint_io_writeall + + subroutine glint_io_create(outfile,model,data) + use parallel + use glide_types + use glint_type + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(glint_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + integer :: time_dimid + integer :: x1_dimid + integer :: y1_dimid + + ! defining dimensions + status = parallel_inq_dimid(NCO%id,'time',time_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'x1',x1_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'y1',y1_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,"_tavg") + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in glint_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + ! ablt -- ablation + pos = index(NCO%vars,' ablt ') + status = parallel_inq_varid(NCO%id,'ablt',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%ablt)) then + call write_log('Creating variable ablt') + status = parallel_def_var(NCO%id,'ablt',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'ablation') + status = parallel_put_att(NCO%id, varid, 'units', 'meter (water)/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable ablt was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! arng -- air temperature half-range + pos = index(NCO%vars,' arng ') + status = parallel_inq_varid(NCO%id,'arng',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%arng)) then + call write_log('Creating variable arng') + status = parallel_def_var(NCO%id,'arng',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'air temperature half-range') + status = parallel_put_att(NCO%id, varid, 'units', 'degreeC') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable arng was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! global_orog -- orographic elevation provided by global model + pos = index(NCO%vars,' global_orog ') + status = parallel_inq_varid(NCO%id,'global_orog',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+11) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%global_orog)) then + call write_log('Creating variable global_orog') + status = parallel_def_var(NCO%id,'global_orog',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'orographic elevation provided by global model') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_altitude') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable global_orog was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! hflx_tavg -- heat flux to ice surface + pos = index(NCO%vars,' hflx_tavg ') + status = parallel_inq_varid(NCO%id,'hflx_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%hflx_tavg)) then + call write_log('Creating variable hflx_tavg') + status = parallel_def_var(NCO%id,'hflx_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'heat flux to ice surface') + status = parallel_put_att(NCO%id, varid, 'units', 'W m-2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable hflx_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! inmask -- downscaling mask + pos = index(NCO%vars,' inmask ') + status = parallel_inq_varid(NCO%id,'inmask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+6) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%downs%lmask)) then + call write_log('Creating variable inmask') + status = parallel_def_var(NCO%id,'inmask',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'downscaling mask') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable inmask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! local_orog -- orographic elevation provided by local model + pos = index(NCO%vars,' local_orog ') + status = parallel_inq_varid(NCO%id,'local_orog',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+10) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%local_orog)) then + call write_log('Creating variable local_orog') + status = parallel_def_var(NCO%id,'local_orog',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'orographic elevation provided by local model') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_altitude') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable local_orog was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! outmask -- upscaling mask + pos = index(NCO%vars,' outmask ') + status = parallel_inq_varid(NCO%id,'outmask',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+7) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%out_mask)) then + call write_log('Creating variable outmask') + status = parallel_def_var(NCO%id,'outmask',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'upscaling mask') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable outmask was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! prcp -- precipitation + pos = index(NCO%vars,' prcp ') + status = parallel_inq_varid(NCO%id,'prcp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+4) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%prcp)) then + call write_log('Creating variable prcp') + status = parallel_def_var(NCO%id,'prcp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'precipitation') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'lwe_precipitation_rate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter (water)/year') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable prcp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rofi_tavg -- solid calving flux + pos = index(NCO%vars,' rofi_tavg ') + status = parallel_inq_varid(NCO%id,'rofi_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%rofi_tavg)) then + call write_log('Creating variable rofi_tavg') + status = parallel_def_var(NCO%id,'rofi_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'solid calving flux') + status = parallel_put_att(NCO%id, varid, 'units', 'kg m-2 s-1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable rofi_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! rofl_tavg -- liquid runoff flux + pos = index(NCO%vars,' rofl_tavg ') + status = parallel_inq_varid(NCO%id,'rofl_tavg',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+9) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%rofl_tavg)) then + call write_log('Creating variable rofl_tavg') + status = parallel_def_var(NCO%id,'rofl_tavg',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'liquid runoff flux') + status = parallel_put_att(NCO%id, varid, 'units', 'kg m-2 s-1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable rofl_tavg was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! siced -- superimposed ice depth + pos = index(NCO%vars,' siced ') + status = parallel_inq_varid(NCO%id,'siced',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%siced)) then + call write_log('Creating variable siced') + status = parallel_def_var(NCO%id,'siced',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'superimposed ice depth') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable siced was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! snowd -- snow depth + pos = index(NCO%vars,' snowd ') + status = parallel_inq_varid(NCO%id,'snowd',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+5) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%snowd)) then + call write_log('Creating variable snowd') + status = parallel_def_var(NCO%id,'snowd',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'snow depth') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'surface_snow_thickness') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable snowd was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + end subroutine glint_io_create + + subroutine glint_io_write(outfile,data) + use parallel + use glint_type + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + status = parallel_inq_varid(NCO%id,'ablt',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%ablt, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'arng',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%arng, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'global_orog',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%global_orog, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'hflx_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%hflx_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'inmask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%downs%lmask, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'local_orog',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%local_orog, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'outmask',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%out_mask, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'prcp',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%prcp, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rofi_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%rofi_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'rofl_tavg',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%rofl_tavg, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'siced',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%siced, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'snowd',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%snowd, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + end subroutine glint_io_write + + + subroutine glint_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to glint restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine glint_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in glint_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine glint_io_readall(data, model, filetype) + ! read from netCDF file + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glint_instance) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call glint_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine glint_io_readall + + + subroutine glint_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(glint_instance) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call glint_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine glint_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine glint_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use glint_type + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + status = parallel_inq_varid(NCI%id,'hflx_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%hflx_tavg)) then + call write_log(' Loading hflx_tavg') + status = distributed_get_var(NCI%id, varid, & + data%hflx_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling hflx_tavg",GM_DIAGNOSTIC) + data%hflx_tavg = data%hflx_tavg*scaling_factor + end if + else + call write_log('Variable hflx_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'outmask',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%out_mask)) then + call write_log(' Loading outmask') + status = distributed_get_var(NCI%id, varid, & + data%out_mask, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling outmask",GM_DIAGNOSTIC) + data%out_mask = data%out_mask*scaling_factor + end if + else + call write_log('Variable outmask was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'rofi_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%rofi_tavg)) then + call write_log(' Loading rofi_tavg') + status = distributed_get_var(NCI%id, varid, & + data%rofi_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling rofi_tavg",GM_DIAGNOSTIC) + data%rofi_tavg = data%rofi_tavg*scaling_factor + end if + else + call write_log('Variable rofi_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'rofl_tavg',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%rofl_tavg)) then + call write_log(' Loading rofl_tavg') + status = distributed_get_var(NCI%id, varid, & + data%rofl_tavg, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling rofl_tavg",GM_DIAGNOSTIC) + data%rofl_tavg = data%rofl_tavg*scaling_factor + end if + else + call write_log('Variable rofl_tavg was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'siced',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%siced)) then + call write_log(' Loading siced') + status = distributed_get_var(NCI%id, varid, & + data%siced, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling siced",GM_DIAGNOSTIC) + data%siced = data%siced*scaling_factor + end if + else + call write_log('Variable siced was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + status = parallel_inq_varid(NCI%id,'snowd',varid) + if (status .eq. nf90_noerr) then + if (is_enabled(data%snowd)) then + call write_log(' Loading snowd') + status = distributed_get_var(NCI%id, varid, & + data%snowd, (/1,1,infile%current_time/)) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_get_att(NCI%id, varid,'scale_factor',scaling_factor) + if (status.ne.NF90_NOERR) then + scaling_factor = 1.0d0 + end if + if (abs(scaling_factor-1.0d0).gt.1.d-17) then + call write_log("scaling snowd",GM_DIAGNOSTIC) + data%snowd = data%snowd*scaling_factor + end if + else + call write_log('Variable snowd was specified for input but it is inappropriate for your config settings. It will be excluded from the input.', GM_WARNING) + end if + + end if + + end subroutine glint_io_read + + subroutine glint_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glint_type + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glint_instance), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + end subroutine glint_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine glint_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use glint_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glint_instance) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + end subroutine glint_avg_accumulate + + subroutine glint_avg_reset(outfile,data) + use parallel + use glint_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + end subroutine glint_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + subroutine glint_get_ablt(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%ablt + end subroutine glint_get_ablt + + subroutine glint_set_ablt(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%ablt = inarray + end subroutine glint_set_ablt + + subroutine glint_get_arng(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%arng + end subroutine glint_get_arng + + subroutine glint_set_arng(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%arng = inarray + end subroutine glint_set_arng + + subroutine glint_get_global_orog(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%global_orog + end subroutine glint_get_global_orog + + subroutine glint_set_global_orog(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%global_orog = inarray + end subroutine glint_set_global_orog + + subroutine glint_get_inmask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%downs%lmask + end subroutine glint_get_inmask + + subroutine glint_set_inmask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%downs%lmask = inarray + end subroutine glint_set_inmask + + subroutine glint_get_local_orog(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%local_orog + end subroutine glint_get_local_orog + + subroutine glint_set_local_orog(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%local_orog = inarray + end subroutine glint_set_local_orog + + subroutine glint_get_outmask(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%out_mask + end subroutine glint_get_outmask + + subroutine glint_set_outmask(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%out_mask = inarray + end subroutine glint_set_outmask + + subroutine glint_get_prcp(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%prcp + end subroutine glint_get_prcp + + subroutine glint_set_prcp(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%prcp = inarray + end subroutine glint_set_prcp + + subroutine glint_get_siced(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%siced + end subroutine glint_get_siced + + subroutine glint_set_siced(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%siced = inarray + end subroutine glint_set_siced + + subroutine glint_get_snowd(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%snowd + end subroutine glint_get_snowd + + subroutine glint_set_snowd(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%snowd = inarray + end subroutine glint_set_snowd + + +end module glint_io diff --git a/components/cism/glimmer-cism/libglint/glint_main.F90 b/components/cism/glimmer-cism/libglint/glint_main.F90 new file mode 100644 index 0000000000..1bf9076ede --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_main.F90 @@ -0,0 +1,2219 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_main.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_main + + !> This is the main glimmer module, which contains the top-level + !> subroutines and derived types comprising the glimmer ice model. + + use glimmer_global, only: dp, fname_length + use glint_type + use glint_global_grid + use glad_constants + use glint_anomcouple + + use glimmer_paramets, only: stdout, GLC_DEBUG + + implicit none + + ! ------------------------------------------------------------ + ! glint_params derived type definition + ! This is where default values are set. + ! ------------------------------------------------------------ + + type glint_params + + !> Derived type containing parameters relevant to all instances of + !> the model - i.e. those parameters which pertain to the global model. + + ! Global grids used ---------------------------------------- + + type(global_grid) :: g_grid !> The main global grid, used for + !> input and most outputs + type(global_grid) :: g_grid_orog !> Global grid used for orography output. + + ! Ice model instances -------------------------------------- + + integer :: ninstances = 1 !> Number of ice model instances + type(glint_instance),pointer,dimension(:) :: instances => null() !> Array of glimmer\_instances + + ! Global model parameters ---------------------------------- + + integer :: tstep_mbal = 1 !> Mass-balance timestep (hours) + integer :: start_time !> Time of first call to glint (hours) + integer :: time_step !> Calling timestep of global model (hours) + + ! Parameters that can be set by the GCM calling Glint + + logical :: gcm_smb = .false. !> If true, receive surface mass balance from the GCM + logical :: gcm_restart = .false. !> If true, restart the model from a GCM restart file + character(fname_length) :: gcm_restart_file !> Name of restart file + integer :: gcm_fileunit = 99 !> Fileunit specified by GCM for reading config files + + ! Averaging parameters ------------------------------------- + + integer :: av_start_time = 0 !> Holds the value of time from + !> the last occasion averaging was restarted (hours) + integer :: av_steps = 0 !> Holds the number of times glimmer has + !> been called in current round of averaging. + integer :: next_av_start = 0 !> Time when we expect next averaging to start + logical :: new_av = .true. !> Set to true if the next correct call starts a new averaging round + + ! Averaging arrays ----------------------------------------- + + real(dp),pointer,dimension(:,:) :: g_av_precip => null() !> globally averaged precip + real(dp),pointer,dimension(:,:) :: g_av_temp => null() !> globally averaged temperature + real(dp),pointer,dimension(:,:) :: g_max_temp => null() !> global maximum temperature + real(dp),pointer,dimension(:,:) :: g_min_temp => null() !> global minimum temperature + real(dp),pointer,dimension(:,:) :: g_temp_range => null() !> global temperature range + real(dp),pointer,dimension(:,:) :: g_av_zonwind => null() !> globally averaged zonal wind + real(dp),pointer,dimension(:,:) :: g_av_merwind => null() !> globally averaged meridional wind + real(dp),pointer,dimension(:,:) :: g_av_humid => null() !> globally averaged humidity (%) + real(dp),pointer,dimension(:,:) :: g_av_lwdown => null() !> globally averaged downwelling longwave (W/m$^2$) + real(dp),pointer,dimension(:,:) :: g_av_swdown => null() !> globally averaged downwelling shortwave (W/m$^2$) + real(dp),pointer,dimension(:,:) :: g_av_airpress => null() !> globally averaged surface air pressure (Pa) + real(dp),pointer,dimension(:,:,:) :: g_av_qsmb => null() ! globally averaged surface mass balance (kg m-2 s-1) + real(dp),pointer,dimension(:,:,:) :: g_av_tsfc => null() ! globally averaged surface temperature (deg C) + real(dp),pointer,dimension(:,:,:) :: g_av_topo => null() ! globally averaged surface elevation (m) + + ! Fractional coverage information -------------------------- + ! Note: these are only valid on the main task + real(dp),pointer,dimension(:,:) :: total_coverage => null() !> Fractional coverage by + !> all ice model instances. + real(dp),pointer,dimension(:,:) :: total_cov_orog => null() !> Fractional coverage by + !> all ice model instances (orog). + logical :: coverage_calculated = .false. !> Have we calculated the + !> coverage map yet? + ! File information ----------------------------------------- + + character(fname_length) :: paramfile !> Name of global parameter file + + ! Accumulation/averaging flags ----------------------------- + + logical :: need_winds=.false. !> Set if we need the winds to be accumulated/downscaled + logical :: enmabal=.false. !> Set if we're using the energy balance mass balance model anywhere + + ! Anomaly coupling for global climate ------------------------------------------ + + type(anomaly_coupling) :: anomaly_params !> Parameters for anomaly coupling + + end type glint_params + + ! Private names ----------------------------------------------- + + private glint_allocate_arrays + private glint_readconfig, calc_bounds, check_init_args + private compute_ice_sheet_grid_mask + private compute_icemask_coupled_fluxes + + !--------------------------------------------------------------------------------------- + ! Some notes on coupling to the Community Earth System Model (CESM). These may be applicable + ! for coupling to other GCMs: + ! + ! When coupled to CESM, Glint receives three fields from the coupler on a global grid + ! in each of several elevation classes: + ! qsmb = surface mass balance (kg/m^2/s) + ! tsfc = surface ground temperature (deg C) + ! topo = surface elevation (m) + ! Both qsmb and tsfc are computed in the CESM land model. + ! Five fields are returned to CESM on the global grid. + ! gfrac = fractional ice coverage + ! gtopo = surface elevation (m) + ! ghflx = heat flux from the ice interior to the surface (W/m^2) + ! grofi = ice runoff (i.e., calving) (kg/m^2/s) + ! grofl = liquid runoff (i.e., basal melting; the land model handles sfc runoff) (kg/m^2/s) + ! The first three (gfrac, gtopo, ghflx) are returned for each elevation class of each grid cell; + ! the last two are returned only for the full gridcell. + ! The land model has the option to update its ice coverage and surface elevation, given + ! the fields returned from Glint. + ! + ! There are two driver subroutines in this module for CESM coupling: + ! initialise_glint_gcm (for initialization) and glint_gcm (for timestepping). + ! These drivers loop over the ice sheet model instances (just Greenland for now, + ! but will simulate Antarctica and other ice sheets later). + ! + ! The other driver subroutines, based on the original Glint code in Glimmer version 1, + ! are initialise_glint and glint. + ! These subroutines are usually run with temp (= 2-m air temperature) and precip as input. + ! The surface mass balance is computed using a daily or annual PDD scheme. + ! It would be possible to call these subroutines from CESM and use the PDD scheme, + ! but this option has not been tested. + ! + !--------------------------------------------------------------------------------------- + +contains + + !TODO - Try calling subroutine initialise_glint from CESM to estimate SMB in PDD mode? + ! We would have only one elevation class per grid cell and would not return upscaled fields. + + subroutine initialise_glint(params, & + lats, longs, & + time_step, paramfile, & + latb, lonb, & + orog, albedo, & + ice_frac, veg_frac, & + snowice_frac, snowveg_frac, & + snow_depth, & + orog_lats, orog_longs, & + orog_latb, orog_lonb, & + output_flag, daysinyear, & + snow_model, ice_dt, & + extraconfigs, start_time, & + gmask, & + gcm_restart, gcm_restart_file, & + gcm_debug, gcm_fileunit) + + !> Initialises the model + !> For a multi-processor run, the main task should specify lats & longs spanning + !> the full global domain; the other tasks should give 0-size lats & longs arrays + !> Output arrays on the global grid are only valid on the main task + + use glimmer_config + use glint_initialise + use glimmer_log + use glimmer_filenames + use glint_upscale, only: glint_upscaling + use parallel, only: main_task + implicit none + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glint_params), intent(inout) :: params !> parameters to be set + real(dp),dimension(:), intent(in) :: lats,longs !> location of gridpoints + !> in global data. + integer, intent(in) :: time_step !> Timestep of calling model (hours) + character(*),dimension(:), intent(in) :: paramfile !> array of configuration filenames. + real(dp),dimension(:), optional,intent(in) :: latb !> Locations of the latitudinal + !> boundaries of the grid-boxes. + real(dp),dimension(:), optional,intent(in) :: lonb !> Locations of the longitudinal + !> boundaries of the grid-boxes. + real(dp),dimension(:,:),optional,intent(out) :: orog !> Initial global orography + real(dp),dimension(:,:),optional,intent(out) :: albedo !> Initial albedo + real(dp),dimension(:,:),optional,intent(out) :: ice_frac !> Initial ice fraction + real(dp),dimension(:,:),optional,intent(out) :: veg_frac !> Initial veg fraction + real(dp),dimension(:,:),optional,intent(out) :: snowice_frac !> Initial snow-covered ice fraction + real(dp),dimension(:,:),optional,intent(out) :: snowveg_frac !> Initial snow-covered veg fraction + real(dp),dimension(:,:),optional,intent(out) :: snow_depth !> Initial snow depth + real(dp),dimension(:), optional,intent(in) :: orog_lats !> Latitudinal location of gridpoints + !> for global orography output. + real(dp),dimension(:), optional,intent(in) :: orog_longs !> Longitudinal location of gridpoints + !> for global orography output. + real(dp),dimension(:), optional,intent(in) :: orog_latb !> Locations of the latitudinal + !> boundaries of the grid-boxes (orography). + real(dp),dimension(:), optional,intent(in) :: orog_lonb !> Locations of the longitudinal + !> boundaries of the grid-boxes (orography). + logical, optional,intent(out) :: output_flag !> Flag to show output set (provided for + !> consistency) + integer, optional,intent(in) :: daysinyear !> Number of days in the year + logical, optional,intent(out) :: snow_model !> Set if the mass-balance scheme has a snow-depth model + integer, optional,intent(out) :: ice_dt !> Ice dynamics time-step in hours + type(ConfigData),dimension(:),optional :: extraconfigs !> Additional configuration information - overwrites + !> config data read from files + integer, optional,intent(in) :: start_time !> Time of first call to glint (hours) + integer, dimension(:,:), optional,intent(in) :: gmask !> mask = 1 where global data are valid + logical, optional,intent(in) :: gcm_restart ! logical flag to restart from a GCM restart file + character(*), optional, intent(in) :: gcm_restart_file ! restart filename for a GCM restart + ! (currently assumed to be CESM) + logical, optional,intent(in) :: gcm_debug ! logical flag from GCM to output debug information + integer, optional,intent(in) :: gcm_fileunit! fileunit for reading config files + + ! Internal variables ----------------------------------------------------------------------- + + type(ConfigSection), pointer :: global_config, instance_config, section ! configuration stuff + character(len=100) :: message ! For log-writing + character(fname_length),dimension(:),pointer :: config_fnames=>null() ! array of config filenames + + integer :: i, j + real(dp),dimension(:,:),allocatable :: orog_temp, if_temp, vf_temp, sif_temp, & + svf_temp, sd_temp, alb_temp ! Temporary output arrays + integer,dimension(:),allocatable :: mbts,idts ! Array of mass-balance and ice dynamics timesteps + logical :: anomaly_check ! Set if we've already initialised anomaly coupling + + if (present(gcm_debug)) then + GLC_DEBUG = gcm_debug + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Starting initialise_glint' + end if + + ! Initialise start time and calling model time-step ---------------------------------------- + ! We ignore t=0 by default + + params%time_step = time_step + + if (present(start_time)) then + params%start_time = start_time + else + params%start_time = time_step + end if + + params%next_av_start = params%start_time + + ! Initialisation for runs coupled to a GCM + + params%gcm_restart = .false. + if (present(gcm_restart)) then + params%gcm_restart = gcm_restart + endif + + params%gcm_restart_file = '' + if (present(gcm_restart_file)) then + params%gcm_restart_file = gcm_restart_file + endif + + params%gcm_fileunit = 99 + if (present(gcm_fileunit)) then + params%gcm_fileunit = gcm_fileunit + endif + +! nec = 1 +! if (present(gcm_nec)) then +! nec = gcm_nec +! endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'time_step =', params%time_step + write(stdout,*) 'start_time =', params%start_time + write(stdout,*) 'next_av_start =', params%next_av_start + end if + + ! Initialise year-length ------------------------------------------------------------------- + + if (present(daysinyear)) then + call glad_set_year_length(daysinyear) + end if + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Initialize global grid' + write(stdout,*) 'present =', present(gmask) + end if + + ! Initialise main global grid -------------------------------------------------------------- + + if (present(gmask)) then + call new_global_grid(params%g_grid, longs, lats, lonb=lonb, latb=latb, mask=gmask) + else + call new_global_grid(params%g_grid, longs, lats, lonb=lonb, latb=latb) + endif + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) ' ' + write (stdout,*) 'time_step (hr) =', params%time_step + write (stdout,*) 'start_time (hr) =', params%start_time + write (stdout,*) 'Called new_global_grid ' + write (stdout,*) 'g_grid%nx =', params%g_grid%nx + write (stdout,*) 'g_grid%ny =', params%g_grid%ny + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lons =', params%g_grid%lons + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lats =', params%g_grid%lats + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lon_bound =', params%g_grid%lon_bound + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lat_bound =', params%g_grid%lat_bound + do j = 5, 10 + write (stdout,*) + write (stdout,*) 'j, g_grid%mask =', j, params%g_grid%mask(:,j) + enddo + end if + + ! Initialise orography grid ------------------------------------ + + call check_init_args(orog_lats, orog_longs, orog_latb, orog_lonb) + + if (present(orog_lats) .and. present(orog_longs)) then + call new_global_grid(params%g_grid_orog, orog_longs, orog_lats, & + lonb=orog_lonb, latb=orog_latb) + else + call copy_global_grid(params%g_grid, params%g_grid_orog) + end if + + ! Allocate arrays ----------------------------------------------- + + call glint_allocate_arrays(params) + + ! Initialise arrays --------------------------------------------- + + params%g_av_precip = 0.d0 + params%g_av_temp = 0.d0 + params%g_max_temp = -1000.d0 + params%g_min_temp = 1000.d0 + params%g_temp_range = 0.d0 + params%g_av_zonwind = 0.d0 + params%g_av_merwind = 0.d0 + params%g_av_humid = 0.d0 + params%g_av_lwdown = 0.d0 + params%g_av_swdown = 0.d0 + params%g_av_airpress= 0.d0 + + ! --------------------------------------------------------------- + ! Zero coverage maps and normalisation fields for main grid and + ! orography grid + ! --------------------------------------------------------------- + + params%total_coverage = 0.d0 + params%total_cov_orog = 0.d0 + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Read paramfile' + write(stdout,*) 'paramfile =', paramfile + end if + + ! --------------------------------------------------------------- + ! Determine how many instances there are, according to what + ! configuration files we've been provided with + ! --------------------------------------------------------------- + + if (size(paramfile) == 1) then + ! Load the configuration file into the linked list + call ConfigRead(process_path(paramfile(1)), global_config, params%gcm_fileunit) + call glint_readconfig(global_config, params%ninstances, config_fnames, paramfile) ! Parse the list + else + params%ninstances = size(paramfile) + allocate(config_fnames(params%ninstances)) + config_fnames = paramfile + end if + + allocate(params%instances(params%ninstances)) + allocate(mbts(params%ninstances), idts(params%ninstances)) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Number of instances =', params%ninstances + write(stdout,*) 'Read config files and initialize each instance' + end if + + ! --------------------------------------------------------------- + ! Read config files, and initialise instances accordingly + ! --------------------------------------------------------------- + + call write_log('Reading instance configurations') + call write_log('-------------------------------') + + anomaly_check = .false. + + do i = 1, params%ninstances + + call ConfigRead(process_path(config_fnames(i)),instance_config, params%gcm_fileunit) + if (present(extraconfigs)) then + if (size(extraconfigs)>=i) then + call ConfigCombine(instance_config,extraconfigs(i)) + end if + end if + + call glint_i_initialise(instance_config, params%instances(i), & + params%g_grid, params%g_grid_orog, & + mbts(i), idts(i), & + params%need_winds, params%enmabal, & + params%start_time, params%time_step, & + params%gcm_restart, params%gcm_restart_file, & + params%gcm_fileunit ) + + params%total_coverage = params%total_coverage + params%instances(i)%frac_coverage + params%total_cov_orog = params%total_cov_orog + params%instances(i)%frac_cov_orog + + ! Initialise anomaly coupling + if (.not.anomaly_check) then + call anomaly_init(params%anomaly_params, instance_config) + if (params%anomaly_params%enabled .and. & + (params%anomaly_params%nx/=params%g_grid%nx .or. & + params%anomaly_params%ny/=params%g_grid%ny) ) then + call write_log("Anomaly coupling grids have different "// & + "sizes to GLINT coupling grids",GM_FATAL,__FILE__,__LINE__) + end if + if (params%anomaly_params%enabled) anomaly_check=.true. + end if + + end do + + ! Check that all mass-balance time-steps are the same length and + ! assign that value to the top-level variable + + params%tstep_mbal = check_mbts(mbts) + if (present(ice_dt)) then + ice_dt = check_mbts(idts) + end if + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'tstep_mbal =', params%tstep_mbal + write(stdout,*) 'start_time =', params%start_time + write(stdout,*) 'time_step =', params%time_step + if (present(ice_dt)) write(stdout,*) 'ice_dt =', ice_dt + end if + + ! Check time-steps divide into one another appropriately. + + if (.not.(mod(params%tstep_mbal,params%time_step)==0)) then + print*,params%tstep_mbal,params%time_step + call write_log('The mass-balance timestep must be an integer multiple of the forcing time-step', & + GM_FATAL,__FILE__,__LINE__) + end if + + ! Check we don't have coverage greater than one at any point. + + where (params%total_coverage > 1.d0) params%total_coverage = 1.d0 + where (params%total_cov_orog > 1.d0) params%total_cov_orog = 1.d0 + params%coverage_calculated=.true. + + ! Zero optional outputs, if present + + if (present(orog)) orog = 0.d0 + if (present(albedo)) albedo = 0.d0 + if (present(ice_frac)) ice_frac = 0.d0 + if (present(veg_frac)) veg_frac = 0.d0 + if (present(snowice_frac)) snowice_frac = 0.d0 + if (present(snowveg_frac)) snowveg_frac = 0.d0 + if (present(snow_depth)) snow_depth = 0.d0 + + ! Allocate arrays + + allocate(orog_temp(params%g_grid_orog%nx, params%g_grid_orog%ny)) + allocate(alb_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(if_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(vf_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(sif_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(svf_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(sd_temp (params%g_grid%nx, params%g_grid%ny)) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Upscale and splice the initial fields' + end if + + ! Get initial fields from instances, splice together and return + + do i=1,params%ninstances + + call glint_upscaling(params%instances(i), & + orog_temp, alb_temp, & + if_temp, vf_temp, & + sif_temp, svf_temp, & + sd_temp) + + ! Add this contribution to the global output + ! Only the main task has valid values for the global output fields + ! + ! TODO: Consider whether area_weighting should be true or false for these... + ! arbitrarily setting them as true for now (I think that preserves their old + ! behavior). But more generally: do we need the upscaling at all for this non-gcm + ! case? + if (main_task) then + + if (present(orog)) & + orog = splice_field(orog, orog_temp, params%instances(i)%frac_cov_orog,& + area_weighting=.true.) + + if (present(albedo)) & + albedo = splice_field(albedo, alb_temp, params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(ice_frac)) & + ice_frac = splice_field(ice_frac, if_temp, params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(veg_frac)) & + veg_frac = splice_field(veg_frac, vf_temp, params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snowice_frac)) & + snowice_frac = splice_field(snowice_frac,sif_temp,params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snowveg_frac)) & + snowveg_frac = splice_field(snowveg_frac,svf_temp,params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snow_depth)) & + snow_depth = splice_field(snow_depth,sd_temp,params%instances(i)%frac_coverage,& + area_weighting=.true.) + + end if + + end do ! ninstances + + ! Deallocate + + deallocate(orog_temp, alb_temp, if_temp, vf_temp, sif_temp, svf_temp,sd_temp) + + ! Sort out snow_model flag + + if (present(snow_model)) then + snow_model = .false. + do i=1, params%ninstances + snow_model = (snow_model .or. glint_has_snow_model(params%instances(i))) + end do + end if + + ! Set output flag + + if (present(output_flag)) output_flag = .true. + + end subroutine initialise_glint + + !================================================================================ + + subroutine initialise_glint_gcm(params, & + lats, longs, & + time_step, paramfile, & + daysinyear, start_time, & + ice_dt, output_flag, & + glc_nec, & + gfrac, gtopo, & + grofi, grofl, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + ghflx, gmask, & + gcm_restart, gcm_restart_file, & + gcm_debug, gcm_fileunit) + + ! Initialise the model for runs coupled to a GCM. + ! For a multi-processor run, the main task should specify lats & longs spanning + ! the full global domain; the other tasks should give 0-size lats & longs arrays + ! Output arrays on the global grid are only valid on the main task + ! + ! Note about ice_sheet_grid_mask and icemask_coupled_fluxes: ice_sheet_grid_mask is + ! non-zero wherever CISM is operating - i.e., grid cells with icesheet or bare land + ! (but not ocean). icemask_coupled_fluxes is similar, but is 0 for icesheet instances + ! that have zero_gcm_fluxes = .true. Thus, icemask_coupled_fluxes can be used to + ! determine the regions of the world in which CISM is operating and potentially + ! sending non-zero fluxes to the climate model. + + use glimmer_config + use glint_initialise + use glimmer_log + use glimmer_filenames + use glimmer_physcon, only: rearth + use glint_upscale, only: glint_upscaling_gcm + use parallel, only: main_task + + implicit none + + ! Subroutine argument declarations -------------------------------------------------------- + + type(glint_params), intent(inout) :: params !> parameters to be set + real(dp),dimension(:), intent(in) :: lats,longs !> location of gridpoints + !> in global data. + integer, intent(in) :: time_step !> Timestep of calling model (hours) + character(*),dimension(:), intent(in) :: paramfile !> array of configuration filenames. + integer, optional,intent(in) :: daysinyear !> Number of days in the year + integer, optional,intent(in) :: start_time !> Time of first call to glint (hours) + integer, optional,intent(out) :: ice_dt !> Ice dynamics time-step in hours + logical, optional,intent(out) :: output_flag !> Flag to show output set (provided for consistency) + integer, optional,intent(in) :: glc_nec !> number of elevation classes for GCM input + real(dp),dimension(:,:,0:),optional,intent(out) :: gfrac !> ice+bare land fractional area [0,1] + real(dp),dimension(:,:,0:),optional,intent(out) :: gtopo !> surface elevation (m) + real(dp),dimension(:,:,0:),optional,intent(out) :: ghflx !> heat flux (W/m^2, positive down) + real(dp),dimension(:,:), optional,intent(out) :: grofi !> ice runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:), optional,intent(out) :: grofl !> liquid runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:), optional,intent(out) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + real(dp),dimension(:,:), optional,intent(out) :: icemask_coupled_fluxes !mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + integer, dimension(:,:), optional,intent(in) :: gmask !> mask = 1 where global data are valid + logical, optional,intent(in) :: gcm_restart ! logical flag to restart from a GCM restart file + character(*), optional,intent(in) :: gcm_restart_file ! restart filename for a GCM restart + ! (currently assumed to be CESM) + logical, optional,intent(in) :: gcm_debug ! logical flag from GCM to output debug information + integer, optional,intent(in) :: gcm_fileunit! fileunit for reading config files + + ! Internal variables ----------------------------------------------------------------------- + + type(ConfigSection), pointer :: global_config, instance_config, section ! configuration stuff + + character(len=100) :: message ! For log-writing + character(fname_length),dimension(:),pointer :: config_fnames=>null() ! array of config filenames + + integer :: i, j + + integer,dimension(:),allocatable :: mbts,idts ! Array of mass-balance and ice dynamics timesteps + + real(dp),dimension(:,:,:),allocatable :: & + gfrac_temp, gtopo_temp, ghflx_temp ! Temporary output arrays + + real(dp),dimension(:,:),allocatable :: & + grofi_temp, grofl_temp, ice_sheet_grid_mask_temp, icemask_coupled_fluxes_temp ! Temporary output arrays + + integer :: n + integer :: nec ! number of elevation classes + + if (present(gcm_debug)) then + GLC_DEBUG = gcm_debug + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Initializing glint' + end if + + ! Initialise start time and calling model time-step (time_step = integer number of hours) + ! We ignore t=0 by default + + params%time_step = time_step + + ! Note: start_time = nhour_glint = 0 for an initial run. + ! Does this create problems given that Glint convention is to ignore t = 0? + + if (present(start_time)) then + params%start_time = start_time + else + params%start_time = time_step + end if + + params%next_av_start = params%start_time + + params%gcm_restart = .false. + if (present(gcm_restart)) then + params%gcm_restart = gcm_restart + endif + + params%gcm_restart_file = '' + if (present(gcm_restart_file)) then + params%gcm_restart_file = gcm_restart_file + endif + + params%gcm_fileunit = 99 + if (present(gcm_fileunit)) then + params%gcm_fileunit = gcm_fileunit + endif + + nec = 1 + if (present(glc_nec)) then + nec = glc_nec + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'time_step =', params%time_step + write(stdout,*) 'start_time =', params%start_time + write(stdout,*) 'next_av_start =', params%next_av_start + end if + + ! Initialise year-length ------------------------------------------------------------------- + + if (present(daysinyear)) then + call glad_set_year_length(daysinyear) + end if + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Initialize global grid: present(gmask) =', present(gmask) + end if + + ! Initialise main global grid -------------------------------------------------------------- + + if (present(gmask)) then + call new_global_grid(params%g_grid, longs, lats, nec=nec, mask=gmask, radius=rearth) + else + call new_global_grid(params%g_grid, longs, lats, nec=nec, radius=rearth) + endif + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) ' ' + write (stdout,*) 'time_step (hr) =', params%time_step + write (stdout,*) 'start_time (hr) =', params%start_time + write (stdout,*) 'Called new_global_grid ' + write (stdout,*) 'g_grid%nx =', params%g_grid%nx + write (stdout,*) 'g_grid%ny =', params%g_grid%ny + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lons =', params%g_grid%lons + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lats =', params%g_grid%lats + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lon_bound =', params%g_grid%lon_bound + write (stdout,*) ' ' + write (stdout,*) 'g_grid%lat_bound =', params%g_grid%lat_bound + do j = 5, 10 + write (stdout,*) + write (stdout,*) 'j, g_grid%mask =', j, params%g_grid%mask(:,j) + enddo + end if + + ! Allocate arrays ----------------------------------------------- + + allocate(params%total_coverage(params%g_grid%nx, params%g_grid%ny)) + + allocate(params%g_av_qsmb (params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(params%g_av_tsfc (params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(params%g_av_topo (params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + + ! Initialise arrays --------------------------------------------- + + params%g_av_qsmb(:,:,:) = 0.d0 + params%g_av_tsfc(:,:,:) = 0.d0 + params%g_av_topo(:,:,:) = 0.d0 + + ! --------------------------------------------------------------- + ! Zero coverage maps and normalisation fields for main grid + ! (Not using orography grid for GCM coupling) + ! --------------------------------------------------------------- + + params%total_coverage = 0.d0 + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Read paramfile' + write(stdout,*) 'paramfile =', paramfile + end if + + ! --------------------------------------------------------------- + ! Determine how many instances there are, according to what + ! configuration files we've been provided with + ! --------------------------------------------------------------- + + if (size(paramfile) == 1) then + ! Load the configuration file into the linked list + call ConfigRead(process_path(paramfile(1)), global_config, params%gcm_fileunit) + call glint_readconfig(global_config, params%ninstances, config_fnames, paramfile) ! Parse the list + else + params%ninstances = size(paramfile) + allocate(config_fnames(params%ninstances)) + config_fnames = paramfile + end if + + allocate(params%instances(params%ninstances)) + + allocate(mbts(params%ninstances), idts(params%ninstances)) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Number of instances =', params%ninstances + write(stdout,*) 'Read config files and initialize each instance' + end if + + ! --------------------------------------------------------------- + ! Read config files, and initialise instances accordingly + ! --------------------------------------------------------------- + + call write_log('Reading instance configurations') + call write_log('-------------------------------') + + do i=1,params%ninstances + + call ConfigRead(process_path(config_fnames(i)),instance_config, params%gcm_fileunit) + + !WHL - I don't think this will be needed; commented out for now +!! if (present(extraconfigs)) then +!! if (size(extraconfigs)>=i) then +!! call ConfigCombine(instance_config,extraconfigs(i)) +!! end if +!! end if + + call glint_i_initialise_gcm(instance_config, params%instances(i), & + params%g_grid, & + mbts(i), idts(i), & + params%start_time, params%time_step, & + params%gcm_restart, params%gcm_restart_file, & + params%gcm_fileunit ) + + params%total_coverage = params%total_coverage + params%instances(i)%frac_coverage + + end do ! ninstances + + ! Check that all mass-balance time-steps are the same length and + ! assign that value to the top-level variable + + params%tstep_mbal = check_mbts(mbts) + + if (present(ice_dt)) then + ice_dt = check_mbts(idts) + end if + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'tstep_mbal =', params%tstep_mbal + write(stdout,*) 'start_time =', params%start_time + write(stdout,*) 'time_step =', params%time_step + if (present(ice_dt)) write(stdout,*) 'ice_dt =', ice_dt + end if + + ! Check time-steps divide into one another appropriately. + + if (.not. (mod (params%tstep_mbal, params%time_step) == 0)) then + call write_log('The mass-balance timestep must be an integer multiple of the forcing time-step', & + GM_FATAL,__FILE__,__LINE__) + end if + + ! Make sure we don't have coverage greater than one at any point. + + where (params%total_coverage > 1.d0) params%total_coverage = 1.d0 + params%coverage_calculated = .true. + + ! Zero optional outputs, if present + + if (present(gfrac)) gfrac(:,:,:) = 0.d0 + if (present(gtopo)) gtopo(:,:,:) = 0.d0 + if (present(ghflx)) ghflx(:,:,:) = 0.d0 + if (present(grofi)) grofi(:,:) = 0.d0 + if (present(grofl)) grofl(:,:) = 0.d0 + if (present(ice_sheet_grid_mask)) ice_sheet_grid_mask(:,:) = 0.d0 + if (present(icemask_coupled_fluxes)) icemask_coupled_fluxes(:,:) = 0.d0 + + ! Allocate arrays + + allocate(gfrac_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(gtopo_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(ghflx_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(grofi_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(grofl_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(ice_sheet_grid_mask_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(icemask_coupled_fluxes_temp(params%g_grid%nx, params%g_grid%ny)) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Upscale and splice the initial fields' + end if + + ! Get initial fields from instances, splice together and return + + do i = 1, params%ninstances + + ! Upscale the output fields for this instance + + if (GLC_DEBUG .and. main_task) then + print*, 'Do initial upscaling, i =', i + endif + + call glint_upscaling_gcm(params%instances(i), params%g_grid%nec, & + params%instances(i)%lgrid%size%pt(1), & + params%instances(i)%lgrid%size%pt(2), & + params%g_grid%nx, params%g_grid%ny, & + params%g_grid%box_areas, & + gfrac_temp, gtopo_temp, & + grofi_temp, grofl_temp, & + ghflx_temp, & + init_call = .true.) + + call compute_ice_sheet_grid_mask(ice_sheet_grid_mask_temp, gfrac_temp) + call compute_icemask_coupled_fluxes(icemask_coupled_fluxes_temp, & + ice_sheet_grid_mask_temp, & + params%instances(i)) + + ! Splice together with the global output + + if (GLC_DEBUG .and. main_task) then + print*, 'Spliced, i =', i + endif + + call splice_fields_gcm(gfrac_temp, gtopo_temp, & + grofi_temp, grofl_temp, & + ghflx_temp, & + ice_sheet_grid_mask_temp, & + icemask_coupled_fluxes_temp, & + gfrac, gtopo, & + grofi, grofl, & + ghflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + params%g_grid%nec, & + params%instances(i)%frac_coverage) + + end do ! ninstances + + ! Deallocate + + deallocate(gfrac_temp, gtopo_temp, grofi_temp, grofl_temp, ghflx_temp) + deallocate(ice_sheet_grid_mask_temp, icemask_coupled_fluxes_temp) + + ! Set output flag + if (present(output_flag)) output_flag = .true. + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Done in initialise_glint_gcm' + endif + + end subroutine initialise_glint_gcm + + !================================================================================ + + subroutine glint(params, time, & + rawtemp, rawprecip, & + orog, & + zonwind, merwind, & + humid, lwdown, & + swdown, airpress, & + output_flag, & + orog_out, albedo, & + ice_frac, veg_frac, & + snowice_frac, snowveg_frac, & + snow_depth, & + water_in, water_out, & + total_water_in, total_water_out, & + ice_volume, ice_tstep) + + !> Main Glint subroutine. + !> + !> This should be called daily or hourly, depending on + !> the mass-balance scheme being used. It does all necessary + !> spatial and temporal averaging, and calls the dynamics + !> part of the model when required. + !> + !> Input fields should be taken as means over the period since the last call. + !> See the user documentation for more information. + !> + !> Global output fields are only valid on the main task. Fields that are integrated + !> over the whole domain (total_water_in, total_water_out, ice_volume) are only + !> valid in single-task runs; trying to compute these in multi-task runs will generate a + !> fatal error. + !> + !> Note that the total ice volume returned is the total at the end of the time-step; + !> the water fluxes are valid over the duration of the timestep. Thus the difference + !> between \texttt{total\_water\_in} and \texttt{total\_water\_out} should be equal + !> to the change in \texttt{ice\_volume}, after conversion between m$^3$ and kg. + + use glimmer_utils + use glint_interp + use glint_timestep, only: glint_i_tstep + use glint_downscale, only: glint_downscaling + use glint_upscale, only: glint_upscaling + use glimmer_log + use glimmer_paramets, only: scyr + use parallel, only: main_task, tasks + implicit none + + ! Subroutine argument declarations ------------------------------------------------------------- + + type(glint_params), intent(inout) :: params !> parameters for this run + integer, intent(in) :: time !> Current model time (hours) + real(dp),dimension(:,:),target, intent(in) :: rawtemp !> Surface temperature field (deg C) + real(dp),dimension(:,:),target, intent(in) :: rawprecip !> Precipitation rate (mm/s) + real(dp),dimension(:,:), intent(in) :: orog !> The large-scale orography (m) + real(dp),dimension(:,:),optional,intent(in) :: zonwind,merwind !> Zonal and meridional components + !> of the wind field (m/s) + real(dp),dimension(:,:),optional,intent(in) :: humid !> Surface humidity (%) + real(dp),dimension(:,:),optional,intent(in) :: lwdown !> Downwelling longwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: swdown !> Downwelling shortwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: airpress !> surface air pressure (Pa) + logical, optional,intent(out) :: output_flag !> Set true if outputs set + real(dp),dimension(:,:),optional,intent(inout) :: orog_out !> The fed-back, output orography (m) + real(dp),dimension(:,:),optional,intent(inout) :: albedo !> surface albedo + real(dp),dimension(:,:),optional,intent(inout) :: ice_frac !> grid-box ice-fraction + real(dp),dimension(:,:),optional,intent(inout) :: veg_frac !> grid-box veg-fraction + real(dp),dimension(:,:),optional,intent(inout) :: snowice_frac !> grid-box snow-covered ice fraction + real(dp),dimension(:,:),optional,intent(inout) :: snowveg_frac !> grid-box snow-covered veg fraction + real(dp),dimension(:,:),optional,intent(inout) :: snow_depth !> grid-box mean snow depth (m water equivalent) + real(dp),dimension(:,:),optional,intent(inout) :: water_in !> Input water flux (mm) + real(dp),dimension(:,:),optional,intent(inout) :: water_out !> Output water flux (mm) + real(dp), optional,intent(inout) :: total_water_in !> Area-integrated water flux in (kg) + real(dp), optional,intent(inout) :: total_water_out !> Area-integrated water flux out (kg) + real(dp), optional,intent(inout) :: ice_volume !> Total ice volume (m$^3$) + logical, optional,intent(out) :: ice_tstep !> Set when an ice-timestep has been done, and + !> water balance information is available + + ! Internal variables ---------------------------------------------------------------------------- + + integer :: i, j + real(dp),dimension(:,:),allocatable :: albedo_temp, if_temp, vf_temp, sif_temp, svf_temp, & + sd_temp, wout_temp, orog_out_temp, win_temp + real(dp) :: twin_temp,twout_temp,icevol_temp + type(output_flags) :: out_f + logical :: icets + character(250) :: message + real(dp),dimension(size(rawprecip,1),size(rawprecip,2)),target :: anomprecip + real(dp),dimension(size(rawtemp,1), size(rawtemp,2)), target :: anomtemp + real(dp),dimension(:,:),pointer :: precip + real(dp),dimension(:,:),pointer :: temp + real(dp) :: yearfrac + + if (GLC_DEBUG .and. main_task) then +! write (stdout,*) 'In subroutine glint, current time (hr) =', time +! write (stdout,*) 'av_start_time =', params%av_start_time +! write (stdout,*) 'next_av_start =', params%next_av_start +! write (stdout,*) 'new_av =', params%new_av +! write (stdout,*) 'tstep_mbal =', params%tstep_mbal + end if + + ! Check we're expecting a call now -------------------------------------------------------------- + + if (params%new_av) then + if (time == params%next_av_start) then + params%av_start_time = time + params%new_av = .false. + else + write(message,*) 'Unexpected calling of GLINT at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + else + if (mod(time-params%av_start_time,params%time_step) /= 0) then + write(message,*) 'Unexpected calling of GLINT at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + end if + + ! Check input fields are correct ---------------------------------------------------------------- + + call check_input_fields(params, humid, lwdown, swdown, airpress, zonwind, merwind) + + ! Reset output flag + + if (present(output_flag)) output_flag = .false. + if (present(ice_tstep)) ice_tstep = .false. + + ! Sort out anomaly coupling + + if (params%anomaly_params%enabled) then + yearfrac = real(mod(time,days_in_year),dp)/real(days_in_year,dp) + call anomaly_calc(params%anomaly_params, yearfrac, rawtemp, rawprecip, anomtemp, anomprecip) + precip => anomprecip + temp => anomtemp + else + precip => rawprecip + temp => rawtemp + end if + + ! Do averaging and so on... + + call accumulate_averages(params, & + temp, precip, & + zonwind, merwind, & + humid, lwdown, & + swdown, airpress) + + ! Increment step counter + + params%av_steps = params%av_steps + 1 + + ! --------------------------------------------------------- + ! If this is a mass balance timestep, prepare global fields, and do a timestep + ! for each model instance + ! --------------------------------------------------------- + + if (time - params%av_start_time + params%time_step > params%tstep_mbal) then + + write(message,*) & + 'Incomplete forcing of GLINT mass-balance time-step detected at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + + else if (time - params%av_start_time + params%time_step == params%tstep_mbal) then + + ! Set output_flag + + ! At present, outputs are done for each mass-balance timestep, since + ! that involved least change to the code. However, it might be good + ! to change the output to occur with user-specified frequency. + + if (present(output_flag)) output_flag = .true. + + ! Allocate output fields + + if (present(orog_out)) then + allocate(orog_out_temp(size(orog_out,1),size(orog_out,2))) + else + allocate(orog_out_temp(params%g_grid_orog%nx, params%g_grid_orog%ny)) + end if + allocate(albedo_temp(size(orog,1),size(orog,2))) + allocate(if_temp(size(orog,1),size(orog,2))) + allocate(vf_temp(size(orog,1),size(orog,2))) + allocate(sif_temp(size(orog,1),size(orog,2))) + allocate(svf_temp(size(orog,1),size(orog,2))) + allocate(sd_temp(size(orog,1),size(orog,2))) + allocate(wout_temp(size(orog,1),size(orog,2))) + allocate(win_temp(size(orog,1),size(orog,2))) + + ! Populate output flag derived type + + call populate_output_flags(out_f, & + orog_out, albedo, & + ice_frac, veg_frac, & + snowice_frac, snowveg_frac, & + snow_depth, & + water_in, water_out, & + total_water_in, total_water_out, & + ice_volume) + + ! Zero outputs if present + + if (present(orog_out)) orog_out = 0.d0 + if (present(albedo)) albedo = 0.d0 + if (present(ice_frac)) ice_frac = 0.d0 + if (present(veg_frac)) veg_frac = 0.d0 + if (present(snowice_frac)) snowice_frac = 0.d0 + if (present(snowveg_frac)) snowveg_frac = 0.d0 + if (present(snow_depth)) snow_depth = 0.d0 + if (present(water_out)) water_out = 0.d0 + if (present(water_in)) water_in = 0.d0 + if (present(total_water_in)) total_water_in = 0.d0 + if (present(total_water_out)) total_water_out = 0.d0 + if (present(ice_volume)) ice_volume = 0.d0 + + ! Calculate averages by dividing by number of steps elapsed + ! since last model timestep. + + call calculate_averages(params) + + ! Calculate total accumulated precipitation - multiply + ! by time since last model timestep + + params%g_av_precip = params%g_av_precip*params%tstep_mbal*hours2seconds + + ! Calculate temperature half-range + + params%g_temp_range = (params%g_max_temp-params%g_min_temp)/2.0 + + write(stdout,*) 'Take a mass balance timestep, time (hr) =', time + write(stdout,*) 'av_steps =', real(params%av_steps,dp) + write(stdout,*) 'tstep_mbal (hr) =', params%tstep_mbal + + ! Do a timestep for each instance + + do i = 1,params%ninstances + + !WHL - Moved some code here from start of glint_i_tstep + + ! Check whether we're doing anything this time + + if (time == params%instances(i)%next_time) then + + params%instances(i)%next_time = params%instances(i)%next_time + params%instances(i)%mbal_tstep + + ! Downscale input fields from global to local grid + + call glint_downscaling(params%instances(i), & + params%g_av_temp, params%g_temp_range, & + params%g_av_precip, orog, & + params%g_av_zonwind, params%g_av_merwind, & + params%g_av_humid, params%g_av_lwdown, & + params%g_av_swdown, params%g_av_airpress, & + .true.) ! orogflag = .true. + + call glint_i_tstep(time, params%instances(i), & + orog_out_temp, & + albedo_temp, if_temp, & + vf_temp, sif_temp, & + svf_temp, sd_temp, & + win_temp, wout_temp, & + twin_temp, twout_temp, & + icevol_temp, out_f, & + icets) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Finished glc_glint_ice tstep, instance =', i + write(stdout,*) 'Upscale fields to global grid' + end if + + ! Add this contribution to the global output + ! Only the main task has valid values for the global output fields + ! + ! TODO: Consider whether area_weighting should be true or false for these... + ! arbitrarily setting them as true for now (I think that preserves their old + ! behavior). But more generally: do we need the upscaling at all for this + ! non-gcm case? + if (main_task) then + + if (present(orog_out)) & + orog_out = splice_field(orog_out,orog_out_temp, & + params%instances(i)%frac_cov_orog,& + area_weighting=.true.) + + if (present(albedo)) & + albedo = splice_field(albedo,albedo_temp, & + params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(ice_frac)) & + ice_frac = splice_field(ice_frac,if_temp, & + params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(veg_frac)) & + veg_frac = splice_field(veg_frac,vf_temp, & + params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snowice_frac)) & + snowice_frac = splice_field(snowice_frac,sif_temp, & + params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snowveg_frac)) & + snowveg_frac = splice_field(snowveg_frac, & + svf_temp,params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(snow_depth)) & + snow_depth = splice_field(snow_depth, & + sd_temp,params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(water_in)) & + water_in = splice_field(water_in,win_temp, & + params%instances(i)%frac_coverage,& + area_weighting=.true.) + + if (present(water_out)) & + water_out = splice_field(water_out, & + wout_temp, params%instances(i)%frac_coverage,& + area_weighting=.true.) + + end if + + ! Add total water variables to running totals + ! WJS (1-15-13): These fields are only valid in single-task runs; multi-task + ! runs should generate an error in glint_i_tstep if you try to compute any of + ! these. But to be safe, we check here, too + + if (present(total_water_in)) then + if (tasks > 1) call write_log('total_water_in is only valid when running with a single task', & + GM_FATAL, __FILE__, __LINE__) + + total_water_in = total_water_in + twin_temp + end if + + if (present(total_water_out)) then + if (tasks > 1) call write_log('total_water_out is only valid when running with a single task', & + GM_FATAL, __FILE__, __LINE__) + + total_water_out = total_water_out + twout_temp + end if + + if (present(ice_volume)) then + if (tasks > 1) call write_log('ice_volume is only valid when running with a single task', & + GM_FATAL, __FILE__, __LINE__) + + ice_volume = ice_volume + icevol_temp + end if + + ! Set flag + if (present(ice_tstep)) then + ice_tstep = (ice_tstep .or. icets) + end if + + endif ! time = next_time + + enddo ! ninstances + + ! Scale output water fluxes to be in mm/s + + if (present(water_in)) water_in = water_in/ & + (params%tstep_mbal*hours2seconds) + + if (present(water_out)) water_out = water_out/ & + (params%tstep_mbal*hours2seconds) + + ! --------------------------------------------------------- + ! Reset averaging fields, flags and counters + ! --------------------------------------------------------- + + params%g_av_temp = 0.d0 + params%g_av_precip = 0.d0 + params%g_av_zonwind = 0.d0 + params%g_av_merwind = 0.d0 + params%g_av_humid = 0.d0 + params%g_av_lwdown = 0.d0 + params%g_av_swdown = 0.d0 + params%g_av_airpress= 0.d0 + params%g_temp_range = 0.d0 + params%g_max_temp = -1000.d0 + params%g_min_temp = 1000.d0 + + params%av_steps = 0 + params%new_av = .true. + params%next_av_start = time+params%time_step + + deallocate(albedo_temp,if_temp,vf_temp,sif_temp,svf_temp,sd_temp,wout_temp,win_temp,orog_out_temp) + + endif ! time - params%av_start_time + params%time_step = params%tstep_mbal + + end subroutine glint + + !=================================================================== + + subroutine glint_gcm(params, time, & + qsmb, tsfc, & + topo, & + output_flag, ice_tstep, & + gfrac, gtopo, & + grofi, grofl, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + ghflx) + + ! Main Glint subroutine for GCM coupling. + ! + ! It does all necessary spatial and temporal averaging, + ! and calls the dynamic ice sheet model when required. + ! + ! Input fields should be taken as means over the period since the last call. + ! See the user documentation for more information. + ! + ! Global output fields are only valid on the main task. Fields that are integrated + ! over the whole domain are only valid in single-task runs; trying to compute these + ! in multi-task runs will generate a fatal error. + ! + ! Note about ice_sheet_grid_mask and icemask_coupled_fluxes: ice_sheet_grid_mask is + ! non-zero wherever CISM is operating - i.e., grid cells with icesheet or bare land + ! (but not ocean). icemask_coupled_fluxes is similar, but is 0 for icesheet instances + ! that have zero_gcm_fluxes = .true. Thus, icemask_coupled_fluxes can be used to + ! determine the regions of the world in which CISM is operating and potentially + ! sending non-zero fluxes to the climate model. + + use glimmer_utils + use glint_interp + use glint_timestep, only: glint_i_tstep_gcm + use glint_downscale, only: glint_downscaling_gcm + use glint_upscale, only: glint_upscaling_gcm + use glimmer_log + use glimmer_paramets, only: scyr + use parallel, only: main_task, tasks + + implicit none + + ! Subroutine argument declarations ------------------------------------------------------------- + + type(glint_params), intent(inout) :: params !> parameters for this run + integer, intent(in) :: time !> Current model time (hours) + + real(dp),dimension(:,:,0:),intent(in) :: qsmb ! input surface mass balance of glacier ice (kg/m^2/s) + real(dp),dimension(:,:,0:),intent(in) :: tsfc ! input surface ground temperature (deg C) + real(dp),dimension(:,:,0:),intent(in) :: topo ! input surface elevation (m) + + logical, optional,intent(out) :: output_flag ! Set true if outputs are set + logical, optional,intent(out) :: ice_tstep ! Set when an ice dynamic timestep has been done + ! and new output is available + + real(dp),dimension(:,:,:),optional,intent(inout) :: gfrac ! output ice fractional area [0,1] + real(dp),dimension(:,:,:),optional,intent(inout) :: gtopo ! output surface elevation (m) + real(dp),dimension(:,:,:),optional,intent(inout) :: ghflx ! output heat flux (W/m^2, positive down) + real(dp),dimension(:,:), optional,intent(inout) :: grofi ! output ice runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:), optional,intent(inout) :: grofl ! output liquid runoff (kg/m^2/s = mm H2O/s) + real(dp),dimension(:,:), optional,intent(inout) :: ice_sheet_grid_mask !mask of ice sheet grid coverage + real(dp),dimension(:,:), optional,intent(inout) :: icemask_coupled_fluxes !mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + ! Internal variables ---------------------------------------------------------------------------- + + integer :: i + + logical :: icets + character(250) :: message + + real(dp), dimension(:,:,:), allocatable :: & + gfrac_temp ,&! gfrac for a single instance + gtopo_temp ,&! gtopo for a single instance + ghflx_temp ! ghflx for a single instance + + real(dp), dimension(:,:), allocatable :: & + grofi_temp ,&! grofi for a single instance + grofl_temp ,&! grofl for a single instance + ice_sheet_grid_mask_temp, & ! ice_sheet_grid_mask for a single instance + icemask_coupled_fluxes_temp ! icemask_coupled_fluxes for a single instance + + if (GLC_DEBUG .and. main_task) then + if (params%new_av) then + write (stdout,*) 'In subroutine glint_gcm, current time (hr) =', time + write (stdout,*) 'av_start_time =', params%av_start_time + write (stdout,*) 'next_av_start =', params%next_av_start + write (stdout,*) 'new_av =', params%new_av + write (stdout,*) 'tstep_mbal =', params%tstep_mbal + endif + end if + + ! Check we're expecting a call now -------------------------------------------------------------- + + if (params%new_av) then + if (time == params%next_av_start) then + params%av_start_time = time + params%new_av = .false. + else + write(message,*) 'Unexpected calling of GLINT at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + else + if (mod (time - params%av_start_time, params%time_step) /= 0) then + write(message,*) 'Unexpected calling of GLINT at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + end if + + ! Check input fields are correct ---------------------------------------------------------------- + + ! Reset output flag + + if (present(output_flag)) output_flag = .false. + if (present(ice_tstep)) ice_tstep = .false. + + ! Accumulate input fields for later averaging + + call accumulate_averages_gcm(params, qsmb, tsfc, topo) + + ! Increment step counter + + params%av_steps = params%av_steps + 1 + + ! --------------------------------------------------------- + ! If this is a mass balance timestep, prepare global fields, and do a timestep + ! for each model instance + ! --------------------------------------------------------- + + if (time - params%av_start_time + params%time_step > params%tstep_mbal) then + + write(message,*) & + 'Incomplete forcing of GLINT mass-balance time-step detected at time ', time + call write_log(message,GM_FATAL,__FILE__,__LINE__) + + else if (time - params%av_start_time + params%time_step == params%tstep_mbal) then + + ! Set output_flag + + ! At present, outputs are done for each mass-balance timestep, since + ! that involved least change to the code. However, it might be good + ! to change the output to occur with user-specified frequency. + + if (present(output_flag)) output_flag = .true. + + ! Allocate output fields + ! Each *_temp field contains the output for one ice sheet instance. + ! If there are multiple instances, the various *_temp fields are spliced together. + + allocate(gfrac_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(gtopo_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(ghflx_temp(params%g_grid%nx, params%g_grid%ny, 0:params%g_grid%nec)) + allocate(grofi_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(grofl_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(ice_sheet_grid_mask_temp(params%g_grid%nx, params%g_grid%ny)) + allocate(icemask_coupled_fluxes_temp(params%g_grid%nx, params%g_grid%ny)) + + ! Zero global outputs if present + + if (present(gfrac)) gfrac(:,:,:) = 0.d0 + if (present(gtopo)) gtopo(:,:,:) = 0.d0 + if (present(ghflx)) ghflx(:,:,:) = 0.d0 + if (present(grofi)) grofi(:,:) = 0.d0 + if (present(grofl)) grofl(:,:) = 0.d0 + if (present(ice_sheet_grid_mask)) ice_sheet_grid_mask(:,:) = 0.d0 + if (present(icemask_coupled_fluxes)) icemask_coupled_fluxes(:,:) = 0.d0 + + ! Calculate averages by dividing by number of steps elapsed + ! since last model timestep. + + call calculate_averages_gcm(params) + + ! Calculate total surface mass balance - multiply by time since last model timestep + ! Note on units: We want g_av_qsmb to have units of meters w.e. (accumulated over mass balance time step) + ! Initial units are kg m-2 s-1 = mm s-1 + ! Divide by 1000 to convert from mm to m + ! Multiply by hours2seconds = 3600 to convert from 1/s to 1/hr. (tstep_mbal has units of hours) + + !TODO - Modify code so that qsmb and acab are always in kg m-2 s-1 water equivalent? + params%g_av_qsmb(:,:,:) = params%g_av_qsmb(:,:,:) * params%tstep_mbal * hours2seconds / 1000.d0 + + ! Do a timestep for each instance + + do i = 1, params%ninstances + + if (time == params%instances(i)%next_time) then + + params%instances(i)%next_time = params%instances(i)%next_time + params%instances(i)%mbal_tstep + + ! Downscale input fields from global to local grid + ! This subroutine computes instance%acab and instance%artm, the key inputs to Glide. + + if (GLC_DEBUG .and. main_task) write(stdout,*) 'Downscale fields to local grid, time (hr) =', time + call glint_downscaling_gcm (params%instances(i), & + params%g_av_qsmb, & + params%g_av_tsfc, & + params%g_av_topo, & + params%g_grid%mask) + + if (GLC_DEBUG .and. main_task) write(stdout,*) 'Take a glint time step, instance', i + call glint_i_tstep_gcm(time, & + params%instances(i), & + icets) + + + ! Set flag + if (present(ice_tstep)) then + ice_tstep = (ice_tstep .or. icets) + end if + + ! Upscale the output to elevation classes on the global grid + + if (GLC_DEBUG .and. main_task) write(stdout,*) 'Upscale fields to global grid, time(hr) =', time + call glint_upscaling_gcm(params%instances(i), params%g_grid%nec, & + params%instances(i)%lgrid%size%pt(1), & + params%instances(i)%lgrid%size%pt(2), & + params%g_grid%nx, params%g_grid%ny, & + params%g_grid%box_areas, & + gfrac_temp, gtopo_temp, & + grofi_temp, grofl_temp, & + ghflx_temp ) + + call compute_ice_sheet_grid_mask(ice_sheet_grid_mask_temp, gfrac_temp) + call compute_icemask_coupled_fluxes(icemask_coupled_fluxes_temp, & + ice_sheet_grid_mask_temp, & + params%instances(i)) + + ! Add the contribution from this instance to the global output + + call splice_fields_gcm(gfrac_temp, gtopo_temp, & !gfrac_temp here is fractional area, for each elevation level, + grofi_temp, grofl_temp, & ! of the total land+ice area + ghflx_temp, & + ice_sheet_grid_mask_temp, & + icemask_coupled_fluxes_temp, & + gfrac, gtopo, & !gfrac here is the fractional area, for each elevation level, + grofi, grofl, & ! of the fractional area of the total grid cell that is covered by CISM-owned land + ghflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + params%g_grid%nec, & + params%instances(i)%frac_coverage) + + endif ! time = next_time + + enddo ! ninstances + + ! --------------------------------------------------------- + ! Reset averaging fields, flags and counters + ! --------------------------------------------------------- + + params%g_av_qsmb(:,:,:) = 0.d0 + params%g_av_tsfc(:,:,:) = 0.d0 + params%g_av_topo(:,:,:) = 0.d0 + + params%av_steps = 0 + params%new_av = .true. + params%next_av_start = time + params%time_step + + deallocate(gfrac_temp, gtopo_temp, grofi_temp, grofl_temp, ghflx_temp) + deallocate(ice_sheet_grid_mask_temp, icemask_coupled_fluxes_temp) + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Done in glint_gcm' + endif + + endif ! time - params%av_start_time + params%time_step > params%tstep_mbal + + end subroutine glint_gcm + + !=================================================================== + + subroutine end_glint(params,close_logfile) + + !> tidy-up operations for Glint + use glint_initialise + use glimmer_log + implicit none + + type(glint_params),intent(inout) :: params ! parameters for this run + logical, intent(in), optional :: close_logfile ! if true, then close the log file + ! (GCM may do this elsewhere) + integer :: i + + ! end individual instances + + do i = 1, params%ninstances + call glint_i_end(params%instances(i)) + enddo + + if (present(close_logfile)) then + if (close_logfile) call close_log + else + call close_log + endif + + end subroutine end_glint + + !===================================================== + + integer function glint_coverage_map(params, coverage, cov_orog) + + !> Retrieve ice model fractional coverage map. + !> This function is provided so that glimmer may + !> be restructured without altering the interface. + !> This is currently only valid on the main task. + !*RV Three return values are possible: + !*RV \begin{description} + !*RV \item[0 ---] Successful return + !*RV \item[1 ---] Coverage map not calculated yet (fail) + !*RV \item[2 ---] Coverage array is the wrong size (fail) + !*RV \end{description} + + implicit none + + type(glint_params),intent(in) :: params !> ice model parameters + real(dp),dimension(:,:),intent(out) :: coverage !> array to hold coverage map + real(dp),dimension(:,:),intent(out),optional :: cov_orog !> Orography coverage + + if (.not. params%coverage_calculated) then + glint_coverage_map = 1 + return + endif + + if ( size(coverage,1) /= params%g_grid%nx .or. & + size(coverage,2) /= params%g_grid%ny) then + glint_coverage_map = 2 + return + endif + + glint_coverage_map = 0 + coverage = params%total_coverage + if (present(cov_orog)) cov_orog = params%total_cov_orog + + end function glint_coverage_map + + !===================================================== + + !---------------------------------------------------------------------- + ! PRIVATE INTERNAL GLIMMER SUBROUTINES FOLLOW............. + !---------------------------------------------------------------------- + + subroutine glint_allocate_arrays(params) + + !> allocates glimmer arrays + + implicit none + + type(glint_params),intent(inout) :: params !> ice model parameters + + allocate(params%g_av_precip (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_max_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_min_temp (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_temp_range(params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_zonwind(params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_merwind(params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_humid (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_lwdown (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_swdown (params%g_grid%nx, params%g_grid%ny)) + allocate(params%g_av_airpress(params%g_grid%nx,params%g_grid%ny)) + + allocate(params%total_coverage(params%g_grid%nx, params%g_grid%ny)) + allocate(params%total_cov_orog(params%g_grid_orog%nx, params%g_grid_orog%ny)) + + end subroutine glint_allocate_arrays + + !======================================================== + + subroutine splice_fields_gcm(gfrac_temp, gtopo_temp, & + grofi_temp, grofl_temp, & + ghflx_temp, & + ice_sheet_grid_mask_temp, & + icemask_coupled_fluxes_temp, & + gfrac, gtopo, & + grofi, grofl, & + ghflx, & + ice_sheet_grid_mask, & + icemask_coupled_fluxes, & + nec, & + frac_coverage) + + use parallel, only: main_task + + ! Add the output for this instance to the global output + + real(dp), dimension(:,:,0:), intent(in) :: gfrac_temp ! output fields for this instance + real(dp), dimension(:,:,0:), intent(in) :: gtopo_temp ! output fields for this instance + real(dp), dimension(:,:,0:), intent(in) :: ghflx_temp ! output fields for this instance + real(dp), dimension(:,:), intent(in) :: grofi_temp ! output fields for this instance + real(dp), dimension(:,:), intent(in) :: grofl_temp ! output fields for this instance + real(dp), dimension(:,:), intent(in) :: ice_sheet_grid_mask_temp ! output fields for this instance + real(dp), dimension(:,:), intent(in) :: icemask_coupled_fluxes_temp ! output fields for this instance + + real(dp), dimension(:,:,0:), intent(inout) :: gfrac ! spliced global output field + real(dp), dimension(:,:,0:), intent(inout) :: gtopo ! spliced global output field + real(dp), dimension(:,:,0:), intent(inout) :: ghflx ! spliced global output field + real(dp), dimension(:,:), intent(inout) :: grofi ! spliced global output field + real(dp), dimension(:,:), intent(inout) :: grofl ! spliced global output field + real(dp), dimension(:,:), intent(inout) :: ice_sheet_grid_mask ! spliced global output field + real(dp), dimension(:,:), intent(inout) :: icemask_coupled_fluxes ! spliced global output field + + integer, intent(in) :: nec ! number of elevation classes + + real(dp), dimension(:,:), intent(in) :: frac_coverage ! map of fractional coverage of global gridcells + ! by local gridcells + + integer :: n + + ! Only the main task has valid values for the global output fields + + if (main_task) then + + do n = 0, nec + + gfrac(:,:,n) = splice_field(gfrac(:,:,n), & + gfrac_temp(:,:,n), & + frac_coverage, & + area_weighting=.true.) + + gtopo(:,:,n) = splice_field(gtopo(:,:,n), & + gtopo_temp(:,:,n), & + frac_coverage, & + area_weighting=.false.) + + ! TODO: No thought has been given to whether area_weighting should be true or false for ghflx... + ! This needs to be considered once ghflx is hooked up to CLM. + + ghflx(:,:,n) = splice_field(ghflx(:,:,n), & + ghflx_temp(:,:,n), & + frac_coverage, & + area_weighting=.true.) + + enddo ! nec + + ! area_weighting is false for grofi and grofl, because they are computed as sums + ! per unit area of the GLOBAL grid (as opposed to averages per unit area of the + ! icesheet grid). So the normalization done by the area_weighting option has, in + ! effect, already been done. + + grofi(:,:) = splice_field(grofi(:,:), & + grofi_temp(:,:), & + frac_coverage, & + area_weighting=.false.) + + grofl(:,:) = splice_field(grofl(:,:), & + grofl_temp(:,:), & + frac_coverage, & + area_weighting=.false.) + + ! area_weighting for ice_sheet_grid_mask agrees with area_weighting for gfrac, + ! since they are similar variables + + ice_sheet_grid_mask(:,:) = splice_field(ice_sheet_grid_mask(:,:), & + ice_sheet_grid_mask_temp(:,:), & + frac_coverage, & + area_weighting = .true.) + + icemask_coupled_fluxes(:,:) = splice_field(icemask_coupled_fluxes(:,:), & + icemask_coupled_fluxes_temp(:,:), & + frac_coverage, & + area_weighting = .true.) + + endif ! main_task + + end subroutine splice_fields_gcm + + !======================================================== + + function splice_field(global, local, coverage, area_weighting) + + !> Splices an upscaled field into a global field + + ! Note that this does not handle multiple overlapping ice sheet instances + + real(dp),dimension(:,:),intent(in) :: global !> Field to receive the splice + real(dp),dimension(:,:),intent(in) :: local !> The field to be spliced in + real(dp),dimension(:,:),intent(in) :: coverage !> The coverage fraction of the ice sheet grid on the global grid cell + logical,intent(in) :: area_weighting !> Do/not do area weighting + real(dp),dimension(size(global,1),size(global,2)) :: splice_field + + where (coverage == 0.d0) splice_field = global + + if (area_weighting) then + where (coverage > 0.d0) + !Spliced field = area-weighted average of the local field and existing global field. + splice_field = (global*(1.d0-coverage)) + (local*coverage) + end where + else + where (coverage > 0.d0) + !Spliced field is straight addition of local to global + splice_field = global+local + end where + endif + + end function splice_field + + !======================================================== + + !TODO - Move subroutine glint_readconfig to a glint_setup module, in analogy to glide_setup? + + subroutine glint_readconfig(config, ninstances, fnames, infnames) + + !> Determine whether a given config file is a + !> top-level glint config file, and return parameters + !> accordingly. + + use glimmer_config + use glimmer_log + implicit none + + ! Arguments ------------------------------------------- + + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + integer, intent(out) :: ninstances !> Number of instances to create + character(fname_length),dimension(:),pointer :: fnames !> list of filenames (output) + character(fname_length),dimension(:) :: infnames !> list of filenames (input) + + ! Internal variables ---------------------------------- + + type(ConfigSection), pointer :: section + character(len=100) :: message + integer :: i + + if (associated(fnames)) nullify(fnames) + + call GetSection(config,section,'GLINT') + if (associated(section)) then + call GetValue(section,'n_instance',ninstances) + allocate(fnames(ninstances)) + do i=1,ninstances + call GetSection(section%next,section,'GLINT instance') + if (.not.associated(section)) then + write(message,*) 'Must specify ',ninstances,' instance config files' + call write_log(message,GM_FATAL,__FILE__,__LINE__) + end if + call GetValue(section,'name',fnames(i)) + end do + else + ninstances=1 + allocate(fnames(1)) + fnames=infnames + end if + + ! Print some configuration information + +!!$ call write_log('GLINT global') +!!$ call write_log('------------') +!!$ write(message,*) 'number of instances :',params%ninstances +!!$ call write_log(message) +!!$ call write_log('') + + end subroutine glint_readconfig + + !======================================================== + + subroutine calc_bounds(lon, lat, lonb, latb) + + !> Calculates the boundaries between global grid-boxes. + !> Note that we assume that the boundaries lie half-way between the + !> points, both latitudinally and longitudinally, although + !> this isn't strictly true for a Gaussian grid. + + use glimmer_map_trans, only: loncorrect + + implicit none + + real(dp),dimension(:),intent(in) :: lon,lat !> locations of global grid-points (degrees) + real(dp),dimension(:),intent(out) :: lonb,latb !> boundaries of grid-boxes (degrees) + + real(dp) :: dlon + + integer :: nxg,nyg,i,j + + nxg = size(lon) ; nyg = size(lat) + + ! Latitudes first - we assume the boundaries of the first and + ! last boxes coincide with the poles. Not sure how to + ! handle it if they don't... + + latb(1) = 90.d0 + latb(nyg+1) = -90.d0 + + do j = 2,nyg + latb(j) = lat(j-1) - (lat(j-1)-lat(j))/2.0 + enddo + + ! Longitudes + + if (lon(1) < lon(nxg)) then + dlon = lon(1) - lon(nxg) + 360.d0 + else + dlon = lon(1) - lon(nxg) + endif + lonb(1) = lon(nxg) + dlon/2.d0 + lonb(1) = loncorrect(lonb(1),0.d0) + + lonb(nxg+1)=lonb(1) + + do i = 2,nxg + if (lon(i) < lon(i-1)) then + dlon = lon(i) - lon(i-1) + 360.d0 + else + dlon = lon(i) - lon(i-1) + endif + lonb(i) = lon(i-1) + dlon/2.d0 + lonb(i) = loncorrect(lonb(i),0.d0) + enddo + + end subroutine calc_bounds + + !======================================================== + + integer function check_mbts(timesteps) + + !> Checks to see that all mass-balance time-steps are + !> the same. Flags a fatal error if not, else assigns that + !> value to the output + + use glimmer_log + + implicit none + + integer,dimension(:) :: timesteps !> Array of mass-balance timsteps + + integer :: n,i + + n = size(timesteps) + if (n==0) then + check_mbts = 0 + return + endif + + check_mbts = timesteps(1) + + do i = 2,n + if (timesteps(i) /= check_mbts) then + call write_log('All instances must have the same mass-balance and ice timesteps', & + GM_FATAL,__FILE__,__LINE__) + endif + enddo + + end function check_mbts + + !======================================================== + + subroutine check_init_args(orog_lats, orog_longs, orog_latb, orog_lonb) + + !> Checks which combination arguments have been supplied to + !> define the global grid, and rejects unsuitable combinations + + use glimmer_log + + real(dp),dimension(:),optional,intent(in) :: orog_lats + real(dp),dimension(:),optional,intent(in) :: orog_longs + real(dp),dimension(:),optional,intent(in) :: orog_latb + real(dp),dimension(:),optional,intent(in) :: orog_lonb + + integer :: args + integer,dimension(5) :: allowed=(/0,3,7,11,15/) + + args = 0 + + if (present(orog_lats)) args = args + 1 + if (present(orog_longs)) args = args + 2 + if (present(orog_latb)) args = args + 4 + if (present(orog_lonb)) args = args + 8 + + if (.not.any(args==allowed)) then + call write_log('Unexpected combination of arguments to initialise_glint', & + GM_FATAL,__FILE__,__LINE__) + end if + + end subroutine check_init_args + + !======================================================== + + subroutine check_input_fields(params, humid, lwdown, swdown, airpress, zonwind, merwind) + + use glimmer_log + + type(glint_params), intent(inout) :: params !> parameters for this run + real(dp),dimension(:,:),optional,intent(in) :: humid !> Surface humidity (%) + real(dp),dimension(:,:),optional,intent(in) :: lwdown !> Downwelling longwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: swdown !> Downwelling shortwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: airpress !> surface air pressure (Pa) + real(dp),dimension(:,:),optional,intent(in) :: zonwind !> Zonal component of the wind field (m/s) + real(dp),dimension(:,:),optional,intent(in) :: merwind !> Meridional component of the wind field (m/s) + + if (params%enmabal) then + if (.not.(present(humid) .and. present(lwdown) .and. & + present(swdown) .and. present(airpress).and. & + present(zonwind).and. present(merwind))) & + call write_log('Necessary fields not supplied for Energy Balance Mass Balance model',GM_FATAL, & + __FILE__,__LINE__) + end if + + if (params%need_winds) then + if (.not.(present(zonwind).and.present(merwind))) & + call write_log('Need to supply zonal and meridional wind fields to GLINT',GM_FATAL, & + __FILE__,__LINE__) + end if + + end subroutine check_input_fields + + !======================================================== + + subroutine accumulate_averages(params, temp, precip, zonwind, merwind, humid, lwdown, swdown, airpress) + + type(glint_params), intent(inout) :: params !> parameters for this run + real(dp),dimension(:,:), intent(in) :: temp !> Surface temperature field (celsius) + real(dp),dimension(:,:), intent(in) :: precip !> Precipitation rate (mm/s) + real(dp),dimension(:,:),optional,intent(in) :: zonwind !> Zonal component of the wind field (m/s) + real(dp),dimension(:,:),optional,intent(in) :: merwind !> Meridional component of the wind field (m/s) + real(dp),dimension(:,:),optional,intent(in) :: humid !> Surface humidity (%) + real(dp),dimension(:,:),optional,intent(in) :: lwdown !> Downwelling longwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: swdown !> Downwelling shortwave (W/m$^2$) + real(dp),dimension(:,:),optional,intent(in) :: airpress !> surface air pressure (Pa) + + params%g_av_temp = params%g_av_temp + temp + params%g_av_precip = params%g_av_precip + precip + + if (params%need_winds) params%g_av_zonwind = params%g_av_zonwind + zonwind + if (params%need_winds) params%g_av_merwind = params%g_av_merwind + merwind + + if (params%enmabal) then + params%g_av_humid = params%g_av_humid + humid + params%g_av_lwdown = params%g_av_lwdown + lwdown + params%g_av_swdown = params%g_av_swdown + swdown + params%g_av_airpress = params%g_av_airpress + airpress + endif + + ! Ranges of temperature + + where (temp > params%g_max_temp) params%g_max_temp = temp + where (temp < params%g_min_temp) params%g_min_temp = temp + + end subroutine accumulate_averages + + !======================================================== + + subroutine accumulate_averages_gcm(params, qsmb, tsfc, topo) + + type(glint_params), intent(inout) :: params ! model parameters + + real(dp),dimension(:,:,0:),intent(in) :: qsmb ! flux of glacier ice (kg/m^2/s) + real(dp),dimension(:,:,0:),intent(in) :: tsfc ! surface ground temperature (C) + real(dp),dimension(:,:,0:),intent(in) :: topo ! surface elevation (m) + + integer :: nec + + nec=params%g_grid%nec + + params%g_av_qsmb(:,:,0:nec) = params%g_av_qsmb(:,:,0:nec) + qsmb(:,:,0:nec) + params%g_av_tsfc(:,:,0:nec) = params%g_av_tsfc(:,:,0:nec) + tsfc(:,:,0:nec) + params%g_av_topo(:,:,0:nec) = params%g_av_topo(:,:,0:nec) + topo(:,:,0:nec) + !Topo accumulation and averaging is redundant, but retained for consistency with other input fields from GCM + + end subroutine accumulate_averages_gcm + + !======================================================== + + subroutine calculate_averages(params) + + type(glint_params), intent(inout) :: params !> parameters for this run + + params%g_av_temp = params%g_av_temp / real(params%av_steps,dp) + params%g_av_precip = params%g_av_precip / real(params%av_steps,dp) + if (params%need_winds) params%g_av_zonwind = params%g_av_zonwind / real(params%av_steps,dp) + if (params%need_winds) params%g_av_merwind = params%g_av_merwind / real(params%av_steps,dp) + if (params%enmabal) then + params%g_av_humid = params%g_av_humid /real(params%av_steps,dp) + params%g_av_lwdown = params%g_av_lwdown /real(params%av_steps,dp) + params%g_av_swdown = params%g_av_swdown /real(params%av_steps,dp) + params%g_av_airpress = params%g_av_airpress/real(params%av_steps,dp) + endif + + end subroutine calculate_averages + + !======================================================== + + subroutine calculate_averages_gcm(params) + + type(glint_params), intent(inout) :: params !> parameters for this run + + integer :: nec + + nec=params%g_grid%nec + + params%g_av_qsmb(:,:,0:nec) = params%g_av_qsmb(:,:,0:nec) / real(params%av_steps,dp) + params%g_av_tsfc(:,:,0:nec) = params%g_av_tsfc(:,:,0:nec) / real(params%av_steps,dp) + params%g_av_topo(:,:,0:nec) = params%g_av_topo(:,:,0:nec) / real(params%av_steps,dp) + + end subroutine calculate_averages_gcm + + !======================================================== + + subroutine populate_output_flags(out_f, & + orog_out, albedo, & + ice_frac, veg_frac, & + snowice_frac, snowveg_frac, & + snow_depth, & + water_in, water_out, & + total_water_in, total_water_out, & + ice_volume) + + type(output_flags),intent(inout) :: out_f + + real(dp),dimension(:,:),optional,intent(inout) :: orog_out !> The fed-back, output orography (m) + real(dp),dimension(:,:),optional,intent(inout) :: albedo !> surface albedo + real(dp),dimension(:,:),optional,intent(inout) :: ice_frac !> grid-box ice-fraction + real(dp),dimension(:,:),optional,intent(inout) :: veg_frac !> grid-box veg-fraction + real(dp),dimension(:,:),optional,intent(inout) :: snowice_frac !> grid-box snow-covered ice fraction + real(dp),dimension(:,:),optional,intent(inout) :: snowveg_frac !> grid-box snow-covered veg fraction + real(dp),dimension(:,:),optional,intent(inout) :: snow_depth !> grid-box mean snow depth (m water equivalent) + real(dp),dimension(:,:),optional,intent(inout) :: water_in !> Input water flux (mm) + real(dp),dimension(:,:),optional,intent(inout) :: water_out !> Output water flux (mm) + real(dp), optional,intent(inout) :: total_water_in !> Area-integrated water flux in (kg) + real(dp), optional,intent(inout) :: total_water_out !> Area-integrated water flux out (kg) + real(dp), optional,intent(inout) :: ice_volume !> Total ice volume (m$^3$) + + + out_f%orog = present(orog_out) + out_f%albedo = present(albedo) + out_f%ice_frac = present(ice_frac) + out_f%veg_frac = present(veg_frac) + out_f%snowice_frac = present(snowice_frac) + out_f%snowveg_frac = present(snowveg_frac) + out_f%snow_depth = present(snow_depth) + out_f%water_out = present(water_out) + out_f%water_in = present(water_in) + out_f%total_win = present(total_water_in) + out_f%total_wout = present(total_water_out) + out_f%ice_vol = present(ice_volume) + + end subroutine populate_output_flags + + !======================================================== + + subroutine compute_ice_sheet_grid_mask(ice_sheet_grid_mask, gfrac) + + !Calculate an array that contains the fractional area of ice+land. + !This will ultimately be upscaled and sent to CLM, to indicate where + !ice sheet can potentially exist. For example, in the case of Greenland, + !This mask is meant to define the contiguous island of Greenland, but not + !define ocean, or any other land points (e.g. Iceland) that fall within the + !ice sheet grid, but are not represented by the ice sheet model. + + real(dp) ,dimension(:,:,0:),intent(in) :: gfrac ! ice+bare land fractional area [0,1] + real(dp) ,dimension(:,:), intent(out) :: ice_sheet_grid_mask ! mask of ice sheet grid coverage + + + !The following line sums gfrac over all exposed bare land (0-indexed) and ice + !elevation bins. Thus, it includes the contribution of bare exposed land to the + !total fraction. + ice_sheet_grid_mask=sum(gfrac,3) + + end subroutine compute_ice_sheet_grid_mask + + !======================================================== + + subroutine compute_icemask_coupled_fluxes(icemask_coupled_fluxes, ice_sheet_grid_mask, instance) + + ! Given an already-computed ice_sheet_grid_mask array, compute + ! icemask_coupled_fluxes. The latter is similar to the former, but is 0 for icesheet + ! instances that have zero_gcm_fluxes = .true. Thus, icemask_coupled_fluxes can be + ! used to determine the regions of the world in which CISM is operating and + ! potentially sending non-zero fluxes to the climate model. + + real(dp) ,dimension(:,:), intent(out) :: icemask_coupled_fluxes ! mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + real(dp), dimension(:,:), intent(in) :: ice_sheet_grid_mask ! mask of ice sheet grid coverage + type(glint_instance), intent(in) :: instance ! the model instance + + + if (instance%zero_gcm_fluxes == ZERO_GCM_FLUXES_TRUE) then + icemask_coupled_fluxes(:,:) = 0.d0 + else + icemask_coupled_fluxes(:,:) = ice_sheet_grid_mask(:,:) + end if + + end subroutine compute_icemask_coupled_fluxes + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_main + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_mbal.F90 b/components/cism/glimmer-cism/libglint/glint_mbal.F90 new file mode 100644 index 0000000000..0da3782b89 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_mbal.F90 @@ -0,0 +1,189 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_mbal.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_mbal + + use glimmer_global, only: dp + use glint_pdd + use glint_daily_pdd + +#ifdef USE_ENMABAL ! This option is *not* suppported + use smb_mecons ! might exist somewhere, but not part of a Glint release +#else + use glint_ebm ! dummy wrapper +#endif + + implicit none + + ! Unified wrapper for different mass-balance codes + + type glint_mbal_params + type(glint_pdd_params), pointer :: annual_pdd => null() ! Pointer to annual PDD params + type(glint_daily_pdd_params),pointer :: daily_pdd => null() ! Pointer to daily PDD params + type(ebm_params), pointer :: ebm => null() ! Pointer to EBM params + integer :: which ! Flag for chosen mass-balance type + integer :: tstep ! Timestep of mass-balance scheme in hours + end type glint_mbal_params + + integer, parameter :: MASS_BALANCE_GCM = 0 ! receive mass balance from global climate model + integer, parameter :: MASS_BALANCE_PDD = 1 ! compute mass balance using positive-degree-day scheme + integer, parameter :: MASS_BALANCE_ACCUM = 2 ! accumulation only + integer, parameter :: MASS_BALANCE_EBM = 3 ! compute mass balance using energy-balance model + integer, parameter :: MASS_BALANCE_DAILY_PDD = 4 ! compute mass balance using daily PDD model +! Note: Option 3 is not presently supported. + +contains + + subroutine glint_mbal_init(params,config,whichacab,nx,ny,dxr) + + use glimmer_config + use glimmer_log + use glad_constants + + ! Initialise mass-balance schemes + + type(glint_mbal_params) :: params ! parameters to be initialised + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + integer,intent(in) :: whichacab ! selector for mass balance type + integer :: nx,ny ! grid dimensions (for EBM) + real(dp) :: dxr !* Grid length (for EBM) + + ! Copy selector + + params%which=whichacab + + ! Deallocate if necessary + + if (associated(params%annual_pdd)) deallocate(params%annual_pdd) + if (associated(params%daily_pdd)) deallocate(params%daily_pdd) + if (associated(params%ebm)) deallocate(params%ebm) + + ! Allocate desired type and initialise + ! Also check we have a valid value of which + + select case(whichacab) + ! Note: Mass balance timestep and accum time are typically assumed to be one year. + case(MASS_BALANCE_GCM) + params%tstep = nint(years2hours) ! mbal tstep = 1 year + case(MASS_BALANCE_PDD) + allocate(params%annual_pdd) + call glint_pdd_init(params%annual_pdd,config) + params%tstep = nint(years2hours) + case(MASS_BALANCE_ACCUM) + params%tstep = nint(years2hours) + case(MASS_BALANCE_EBM) + allocate(params%ebm) + params%tstep = 6 + call EBMInitWrapper(params%ebm,nx,ny,nint(dxr),params%tstep*60,'/data/ggdagw/src/ebm/ebm_config/online') + case(MASS_BALANCE_DAILY_PDD) + allocate(params%daily_pdd) + call glint_daily_pdd_init(params%daily_pdd,config) + params%tstep = nint(days2hours) + case default + call write_log('Invalid value of whichacab',GM_FATAL,__FILE__,__LINE__) + end select + + end subroutine glint_mbal_init + + ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_mbal_calc(params, & + artm, arng, & + prcp, landsea, & + snowd, siced, & + ablt, acab, & + thck, & + U10m, V10m, & + humidity, SWdown, & + LWdown, Psurf) + + use glimmer_log + + type(glint_mbal_params) :: params ! parameters to be initialised + real(dp), dimension(:,:), intent(in) :: artm ! Mean air-temperature ($^{\circ}$C) + real(dp), dimension(:,:), intent(in) :: arng ! Temperature half-range ($^{\circ}$C) + real(dp), dimension(:,:), intent(in) :: prcp ! Accumulated precipitation (m) + logical, dimension(:,:), intent(in) :: landsea ! Land-sea mask (land is TRUE) + real(dp), dimension(:,:), intent(inout) :: snowd ! Snow depth (m) + real(dp), dimension(:,:), intent(inout) :: siced ! Superimposed ice depth (m) + real(dp), dimension(:,:), intent(out) :: ablt ! Ablation (m) + real(dp), dimension(:,:), intent(out) :: acab ! Mass-balance (m) + real(dp), dimension(:,:), intent(in) :: thck ! Ice thickness (m) + real(dp), dimension(:,:), intent(in) :: U10m ! Ten-metre x-wind (m/s) + real(dp), dimension(:,:), intent(in) :: V10m ! Ten-metre y-wind (m/s) + real(dp), dimension(:,:), intent(in) :: humidity ! Relative humidity (%) + real(dp), dimension(:,:), intent(in) :: SWdown ! Downwelling shortwave (W/m^2) + real(dp), dimension(:,:), intent(in) :: LWdown ! Downwelling longwave (W/m^2) + real(dp), dimension(:,:), intent(in) :: Psurf ! Surface pressure (Pa) + + real(dp),dimension(size(acab,1),size(acab,2)) :: acab_temp + + select case(params%which) + case(MASS_BALANCE_PDD) + call glint_pdd_mbal(params%annual_pdd,artm,arng,prcp,ablt,acab,landsea) + case(MASS_BALANCE_ACCUM) + acab = prcp + case(MASS_BALANCE_EBM) + ! The energy-balance model will go here... + ! NB SLM will be thickness array... + call EBMStepWrapper(params%ebm,acab_temp,thck,real(artm,dp),real(prcp*1000.d0,dp),U10m,V10m,humidity,SWdown,LWdown,Psurf) + acab = acab_temp + acab = acab/1000.d0 ! Convert to meters + ablt = prcp-acab ! Construct ablation field (in m) + ! Fix according to land-sea mask + where (.not.landsea) + ablt = prcp + acab = 0.d0 + snowd= 0.d0 + siced= 0.d0 + end where + case(MASS_BALANCE_DAILY_PDD) + call glint_daily_pdd_mbal(params%daily_pdd,artm,arng,prcp,snowd,siced,ablt,acab,landsea) + end select + + end subroutine glint_mbal_calc + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + logical function mbal_has_snow_model(params) + + type(glint_mbal_params) :: params + + if (params%which==MASS_BALANCE_DAILY_PDD) then + mbal_has_snow_model=.true. + else + mbal_has_snow_model=.false. + end if + + end function mbal_has_snow_model + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_mbal diff --git a/components/cism/glimmer-cism/libglint/glint_mbal_coupling.F90 b/components/cism/glimmer-cism/libglint/glint_mbal_coupling.F90 new file mode 100644 index 0000000000..e22d6b8f6f --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_mbal_coupling.F90 @@ -0,0 +1,249 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_mbal_coupling.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_mbal_coupling + + use glint_mbal + use glimmer_config + + implicit none + + ! Module to handle the accumulation of inputs and calculation of mass-balance + + type glint_mbc + real(dp),dimension(:,:),pointer :: prcp_save => null() ! used to accumulate precip + real(dp),dimension(:,:),pointer :: ablt_save => null() ! used to accumulate ablation + real(dp),dimension(:,:),pointer :: acab_save => null() ! used to accumulate mass-balance + real(dp),dimension(:,:),pointer :: artm_save => null() ! used to average air-temperature + real(dp),dimension(:,:),pointer :: snowd => null() ! Keeps track of snow depth + real(dp),dimension(:,:),pointer :: siced => null() ! Keeps track of superimposed ice depth + real(dp),dimension(:,:),pointer :: prcp => null() ! Instantaneous precip + real(dp),dimension(:,:),pointer :: ablt => null() ! Instantaneous ablation + real(dp),dimension(:,:),pointer :: acab => null() ! Instantaneous mass-balance + real(dp),dimension(:,:),pointer :: artm => null() ! Instantaneous air temperature + real(dp),dimension(:,:),pointer :: xwind => null() ! Instantaneous x-wind + real(dp),dimension(:,:),pointer :: ywind => null() ! Instantaneous y-wind + real(dp),dimension(:,:),pointer :: humidity => null() ! Instantaneous humidity + real(dp),dimension(:,:),pointer :: SWdown => null() ! Instantaneous sw down + real(dp),dimension(:,:),pointer :: LWdown => null() ! Instantaneous lw down + real(dp),dimension(:,:),pointer :: Psurf => null() ! Instantaneous psurf + real(dp),dimension(:,:),pointer :: snowd_save => null() ! Saves snow depth + real(dp),dimension(:,:),pointer :: siced_save => null() ! Saves superimposed ice depth + integer :: av_count = 0 ! Counter for averaging temperature input + logical :: new_accum = .true. + integer :: start_time ! the time we started averaging (hours) + type(glint_mbal_params) :: mbal + end type glint_mbc + +contains + + subroutine glint_mbc_init(params,lgrid,config,whichacab,snowd,siced,nx,ny,dx) + + use glimmer_coordinates + + type(glint_mbc) :: params + type(coordsystem_type) :: lgrid + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + integer :: whichacab + real(dp),dimension(:,:),intent(in) :: snowd ! Initial snow-depth field + real(dp),dimension(:,:),intent(in) :: siced ! Initial superimposed ice field + integer :: nx,ny ! grid dimensions (for SMB) + real(dp) :: dx !* Grid length (for SMB) + + ! Deallocate if necessary + + if (associated(params%prcp_save)) deallocate(params%prcp_save) + if (associated(params%ablt_save)) deallocate(params%ablt_save) + if (associated(params%acab_save)) deallocate(params%acab_save) + if (associated(params%artm_save)) deallocate(params%artm_save) + if (associated(params%snowd)) deallocate(params%snowd) + if (associated(params%siced)) deallocate(params%siced) + if (associated(params%prcp)) deallocate(params%prcp) + if (associated(params%ablt)) deallocate(params%ablt) + if (associated(params%acab)) deallocate(params%acab) + if (associated(params%artm)) deallocate(params%artm) + if (associated(params%xwind)) deallocate(params%xwind) + if (associated(params%ywind)) deallocate(params%ywind) + if (associated(params%humidity)) deallocate(params%humidity) + if (associated(params%SWdown)) deallocate(params%SWdown) + if (associated(params%LWdown)) deallocate(params%LWdown) + if (associated(params%Psurf)) deallocate(params%Psurf) + if (associated(params%snowd_save)) deallocate(params%snowd_save) + if (associated(params%siced_save)) deallocate(params%siced_save) + + ! Allocate arrays and zero + + call coordsystem_allocate(lgrid,params%prcp_save); params%prcp_save = 0.d0 + call coordsystem_allocate(lgrid,params%ablt_save); params%ablt_save = 0.d0 + call coordsystem_allocate(lgrid,params%acab_save); params%acab_save = 0.d0 + call coordsystem_allocate(lgrid,params%artm_save); params%artm_save = 0.d0 + call coordsystem_allocate(lgrid,params%snowd); params%snowd = 0.d0 + call coordsystem_allocate(lgrid,params%siced); params%siced = 0.d0 + call coordsystem_allocate(lgrid,params%prcp); params%prcp = 0.d0 + call coordsystem_allocate(lgrid,params%ablt); params%ablt = 0.d0 + call coordsystem_allocate(lgrid,params%acab); params%acab = 0.d0 + call coordsystem_allocate(lgrid,params%artm); params%artm = 0.d0 + call coordsystem_allocate(lgrid,params%xwind); params%xwind = 0.d0 + call coordsystem_allocate(lgrid,params%ywind); params%ywind = 0.d0 + call coordsystem_allocate(lgrid,params%humidity); params%humidity = 0.d0 + call coordsystem_allocate(lgrid,params%SWdown); params%SWdown = 0.d0 + call coordsystem_allocate(lgrid,params%LWdown); params%LWdown = 0.d0 + call coordsystem_allocate(lgrid,params%Psurf); params%Psurf = 0.d0 + call coordsystem_allocate(lgrid,params%snowd_save); params%snowd_save = 0.d0 + call coordsystem_allocate(lgrid,params%siced_save); params%siced_save = 0.d0 + + ! Initialise the mass-balance scheme and other components + + call glint_mbal_init(params%mbal,config,whichacab,nx,ny,dx) + + ! Copy snow and ice depths if relevant + + if (mbal_has_snow_model(params%mbal)) then + params%snowd = snowd + params%siced = siced + end if + + end subroutine glint_mbc_init + + ! +++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_accumulate_mbal(params, time, artm, arng, prcp, & + snowd, siced, xwind, ywind, local_orog, & + thck, humidity, SWdown, LWdown, Psurf) + + type(glint_mbc) :: params + integer :: time + real(dp),dimension(:,:),intent(inout) :: artm ! Mean air temperature (degC) + real(dp),dimension(:,:),intent(in) :: arng ! Air temperature half-range (degC) + real(dp),dimension(:,:),intent(inout) :: prcp ! Precipitation (m) + real(dp),dimension(:,:),intent(in) :: snowd ! Snow depth (m) + real(dp),dimension(:,:),intent(in) :: siced ! Superimposed ice depth (m) + real(dp),dimension(:,:),intent(in) :: xwind ! $x$-component of surface winds (m/s) + real(dp),dimension(:,:),intent(in) :: ywind ! $y$-component of surface winds (m/s) + real(dp),dimension(:,:),intent(in) :: local_orog ! Local orography (m) + real(dp),dimension(:,:),intent(in) :: thck ! Ice thickness (m) + real(dp),dimension(:,:),intent(in) :: humidity ! Relative humidity (%) + real(dp),dimension(:,:),intent(in) :: SWdown ! Downwelling shortwave (W/m^2) + real(dp),dimension(:,:),intent(in) :: LWdown ! Downwelling longwave (W/m^2) + real(dp),dimension(:,:),intent(in) :: Psurf ! Surface pressure (Pa) + + real(dp),dimension(size(artm,1),size(artm,2)) :: ablt,acab + + ! Things to do the first time + + if (params%new_accum) then + + params%new_accum = .false. + params%av_count = 0 + + ! Initialise + + params%snowd = snowd + params%siced = siced + + params%prcp_save = 0.d0 + params%ablt_save = 0.d0 + params%acab_save = 0.d0 + params%artm_save = 0.d0 + + params%start_time = time + + end if + + params%av_count = params%av_count+1 + + call glint_mbal_calc(params%mbal, & + artm, arng, prcp, & + (local_orog>0.d0 .or. thck>0.d0), & + params%snowd, params%siced, & + ablt, acab, thck, & + xwind, ywind, humidity, & + SWdown,LWdown,Psurf) + + ! Accumulate + + params%prcp_save = params%prcp_save + prcp + params%ablt_save = params%ablt_save + ablt + params%acab_save = params%acab_save + acab + params%artm_save = params%artm_save + artm + + ! Copy instantaneous fields + + params%prcp = prcp + params%ablt = ablt + params%acab = acab + params%artm = artm + params%xwind = xwind + params%ywind = ywind + params%humidity = humidity + params%SWdown = SWdown + params%LWdown = LWdown + params%Psurf = Psurf + + end subroutine glint_accumulate_mbal + + ! +++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_average_mbal(params,artm,prcp,ablt,acab,snowd,siced,dt) + + use glad_constants, only: hours2years + + type(glint_mbc) :: params + real(dp),dimension(:,:),intent(out) :: artm ! Mean air temperature (degC) + real(dp),dimension(:,:),intent(out) :: prcp ! Precipitation (m/yr) + real(dp),dimension(:,:),intent(out) :: ablt ! Ablation (m/yr) + real(dp),dimension(:,:),intent(out) :: acab ! Mass-balance (m/yr) + real(dp),dimension(:,:),intent(inout) :: snowd ! Snow depth (m) + real(dp),dimension(:,:),intent(inout) :: siced ! Superimposed ice depth (m) + integer, intent(in) :: dt ! accumulation time in hours + + if (.not. params%new_accum) then + params%artm_save = params%artm_save / real(params%av_count,dp) + end if + + params%new_accum=.true. + + artm = params%artm_save + prcp = params%prcp_save/real(dt*hours2years,dp) + ablt = params%ablt_save/real(dt*hours2years,dp) + acab = params%acab_save/real(dt*hours2years,dp) + snowd = params%snowd + siced = params%siced + + where (snowd < 0.d0) snowd = 0.d0 + where (siced < 0.d0) siced = 0.d0 + + end subroutine glint_average_mbal + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_mbal_coupling + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_mbal_io.F90.default b/components/cism/glimmer-cism/libglint/glint_mbal_io.F90.default new file mode 100644 index 0000000000..895623212b --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_mbal_io.F90.default @@ -0,0 +1,1388 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! WARNING: this file was automatically generated on +! Fri, 03 Apr 2015 18:33:13 +0000 +! from ncdf_template.F90.in +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! ncdf_template.F90.in - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#define NCO outfile%nc +#define NCI infile%nc + + +module glint_mbal_io + ! template for creating subsystem specific I/O routines + ! written by Magnus Hagdorn, 2004 + + use glint_type + + implicit none + + private :: get_xtype, is_enabled, is_enabled_0dint, is_enabled_1dint, is_enabled_2dint, is_enabled_0dreal, is_enabled_1dreal, is_enabled_2dreal, is_enabled_3dreal + + character(310), save :: restart_variable_list='' ! list of variables needed for a restart +!TODO change 310 to a variable - see glimmer_ncdf.F90 in the definition for type glimmer_nc_stat for other instances of this value. + + interface is_enabled ! MJH 10/21/13: Interface needed for determining if arrays have been enabled. See notes below in glint_mbal_io_create. + module procedure is_enabled_0dint + module procedure is_enabled_1dint + module procedure is_enabled_2dint + module procedure is_enabled_0dreal + module procedure is_enabled_1dreal + module procedure is_enabled_2dreal + module procedure is_enabled_3dreal + end interface is_enabled + +contains + + !***************************************************************************** + ! netCDF output + !***************************************************************************** + subroutine glint_mbal_io_createall(model,data,outfiles) + ! open all netCDF files for output + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glide_global_type) :: model + type(glint_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See notes below in glint_mbal_io_create + type(glimmer_nc_output),optional,pointer :: outfiles + + ! local variables + type(glimmer_nc_output), pointer :: oc + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + do while(associated(oc)) + call glint_mbal_io_create(oc,model,data) + oc=>oc%next + end do + end subroutine glint_mbal_io_createall + + subroutine glint_mbal_io_writeall(data,model,atend,outfiles,time) + ! if necessary write to netCDF files + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glint_instance) :: data + type(glide_global_type) :: model + logical, optional :: atend + type(glimmer_nc_output),optional,pointer :: outfiles + real(dp),optional :: time + + ! local variables + type(glimmer_nc_output), pointer :: oc + logical :: forcewrite=.false. + + if (present(outfiles)) then + oc => outfiles + else + oc=>model%funits%out_first + end if + + if (present(atend)) then + forcewrite = atend + end if + + do while(associated(oc)) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glint_mbal_avg_accumulate(oc,data,model) + end if +#endif + call glimmer_nc_checkwrite(oc,model,forcewrite,time) + if (oc%nc%just_processed) then + ! write standard variables + call glint_mbal_io_write(oc,data) +#ifdef HAVE_AVG + if (oc%do_averages) then + call glint_mbal_avg_reset(oc,data) + end if +#endif + end if + oc=>oc%next + end do + end subroutine glint_mbal_io_writeall + + subroutine glint_mbal_io_create(outfile,model,data) + use parallel + use glide_types + use glint_type + use glimmer_ncdf + use glimmer_ncio + use glimmer_map_types + use glimmer_log + use glimmer_paramets + use glimmer_scales + use glimmer_log + implicit none + type(glimmer_nc_output), pointer :: outfile + type(glide_global_type) :: model + type(glint_instance) :: data ! MJH 10/21/13: Making 'data' mandatory. See note below + + integer status,varid,pos + + ! MJH 10/21/13: Local variables needed for checking if a variable is enabled. + real(dp) :: tavgf + integer :: up + + integer :: level_dimid + integer :: lithoz_dimid + integer :: staglevel_dimid + integer :: stagwbndlevel_dimid + integer :: time_dimid + integer :: x0_dimid + integer :: x1_dimid + integer :: y0_dimid + integer :: y1_dimid + + ! defining dimensions + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'level',model%general%upn,level_dimid) + else + status = parallel_inq_dimid(NCO%id,'level',level_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'lithoz',model%lithot%nlayer,lithoz_dimid) + else + status = parallel_inq_dimid(NCO%id,'lithoz',lithoz_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'staglevel',model%general%upn-1,staglevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'staglevel',staglevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'stagwbndlevel',model%general%upn+1,stagwbndlevel_dimid) + else + status = parallel_inq_dimid(NCO%id,'stagwbndlevel',stagwbndlevel_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_inq_dimid(NCO%id,'time',time_dimid) + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x0',global_ewn-1,x0_dimid) + else + status = parallel_inq_dimid(NCO%id,'x0',x0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'x1',global_ewn,x1_dimid) + else + status = parallel_inq_dimid(NCO%id,'x1',x1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y0',global_nsn-1,y0_dimid) + else + status = parallel_inq_dimid(NCO%id,'y0',y0_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + if (.not.outfile%append) then + status = parallel_def_dim(NCO%id,'y1',global_nsn,y1_dimid) + else + status = parallel_inq_dimid(NCO%id,'y1',y1_dimid) + endif + call nc_errorhandle(__FILE__,__LINE__,status) + + ! Expanding restart variables: if 'restart' or 'hot' is present, we remove that + ! word from the variable list, and flip the restartfile flag. + ! In CISM 2.0, 'restart' is the preferred name to represent restart variables, + ! but 'hot' is supported for backward compatibility. Thus, we check for both. + NCO%vars = ' '//trim(adjustl(NCO%vars))//' ' ! Need to maintain a space at beginning and end of list + ! expanding restart variables + pos = index(NCO%vars,' restart ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+8:) + NCO%restartfile = .true. + end if + pos = index(NCO%vars,' hot ') + if (pos.ne.0) then + NCO%vars = NCO%vars(:pos)//NCO%vars(pos+4:) + NCO%restartfile = .true. + end if + ! Now apply necessary changes if the file is a restart file. + if (NCO%restartfile) then + if ((len_trim(NCO%vars) + len_trim(restart_variable_list) + 2) >= len(NCO%vars) ) then + call write_log('Adding restart variables has made the list of output variables too long for file ' // NCO%filename, GM_FATAL) + else + ! Expand the restart variable list + ! Need to maintain a space at beginning and end of list + NCO%vars = trim(NCO%vars) // ' ' // trim(restart_variable_list) // ' ' ! (a module variable) + ! Set the xtype to be double (required for an exact restart) + outfile%default_xtype = NF90_DOUBLE + endif + end if + + ! Convert temp and flwa to versions on stag grid, if needed + ! Note: this check must occur after restart variables are expanded which happens in glimmer_nc_readparams + call check_for_tempstag(model%options%whichdycore,NCO) + + ! checking if we need to handle time averages + pos = index(NCO%vars,"_tavg") + if (pos.ne.0) then + outfile%do_averages = .True. + end if + + ! Now that the output variable list is finalized, make sure we aren't truncating what the user intends to be output. + ! Note: this only checks that the text in the variable list does not extend to within one character of the end of the variable. + ! It does not handle the case where the user exactly fills the allowable length with variables or has a too-long list with more than one space between variable names. + if ((len_trim(NCO%vars) + 1 ) >= len(NCO%vars)) then + call write_log('The list of output variables is too long for file ' // NCO%filename, GM_FATAL) + endif + + + ! MJH, 10/21/13: In the auto-generated code below, the creation of each output variable is wrapped by a check if the data for that + ! variable has a size greater than 0. This is because of recently added checks in glide_types.F90 that don't fully allocate + ! some variables if certain model options are disabled. This is to lower memory requirements while running the model. + ! The reason they have to be allocated with size zero rather than left unallocated is because the data for + ! some netCDF output variables is defined with math, which causes an error if the operands are unallocated. + ! Note that if a variable is not created, then it will not be subsequently written to. + ! Also note that this change requires that data be a mandatory argument to this subroutine. + + ! Some output variables will need tavgf. The value does not matter, but it must exist. + ! Nonetheless, for completeness give it the proper value that it has in glint_mbal_io_write. + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + ! Similarly, some output variables use the variable up. Give it value of 0 here. + up = 0 + + ! level -- sigma layers + if (.not.outfile%append) then + call write_log('Creating variable level') + status = parallel_def_var(NCO%id,'level',get_xtype(outfile,NF90_FLOAT),(/level_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'formula_terms', 'sigma: level topo: topg thick: thk') + status = parallel_put_att(NCO%id, varid, 'long_name', 'sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! lithoz -- vertical coordinate of lithosphere layer + if (.not.outfile%append) then + call write_log('Creating variable lithoz') + status = parallel_def_var(NCO%id,'lithoz',get_xtype(outfile,NF90_FLOAT),(/lithoz_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'vertical coordinate of lithosphere layer') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! staglevel -- stag sigma layers + if (.not.outfile%append) then + call write_log('Creating variable staglevel') + status = parallel_def_var(NCO%id,'staglevel',get_xtype(outfile,NF90_FLOAT),(/staglevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! stagwbndlevel -- stag sigma layers with boundaries + if (.not.outfile%append) then + call write_log('Creating variable stagwbndlevel') + status = parallel_def_var(NCO%id,'stagwbndlevel',get_xtype(outfile,NF90_FLOAT),(/stagwbndlevel_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'positive', 'down') + status = parallel_put_att(NCO%id, varid, 'long_name', 'stag sigma layers with boundaries') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'land_ice_stag_sigma_coordinate_with_bnd') + status = parallel_put_att(NCO%id, varid, 'units', '1') + end if + + ! x0 -- Cartesian x-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable x0') + status = parallel_def_var(NCO%id,'x0',get_xtype(outfile,NF90_FLOAT),(/x0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_x_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! x1 -- Cartesian x-coordinate + if (.not.outfile%append) then + call write_log('Creating variable x1') + status = parallel_def_var(NCO%id,'x1',get_xtype(outfile,NF90_FLOAT),(/x1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian x-coordinate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_x_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! y0 -- Cartesian y-coordinate, velocity grid + if (.not.outfile%append) then + call write_log('Creating variable y0') + status = parallel_def_var(NCO%id,'y0',get_xtype(outfile,NF90_FLOAT),(/y0_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate, velocity grid') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_y_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! y1 -- Cartesian y-coordinate + if (.not.outfile%append) then + call write_log('Creating variable y1') + status = parallel_def_var(NCO%id,'y1',get_xtype(outfile,NF90_FLOAT),(/y1_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'Cartesian y-coordinate') + status = parallel_put_att(NCO%id, varid, 'standard_name', 'projection_y_coordinate') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + end if + + ! instant_ablt -- instantaneous ablation + pos = index(NCO%vars,' instant_ablt ') + status = parallel_inq_varid(NCO%id,'instant_ablt',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%ablt)) then + call write_log('Creating variable instant_ablt') + status = parallel_def_var(NCO%id,'instant_ablt',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous ablation') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_ablt was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_acab -- instantaneous mass-balance + pos = index(NCO%vars,' instant_acab ') + status = parallel_inq_varid(NCO%id,'instant_acab',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%acab)) then + call write_log('Creating variable instant_acab') + status = parallel_def_var(NCO%id,'instant_acab',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous mass-balance') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_acab was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_artm -- instantaneous air temperature + pos = index(NCO%vars,' instant_artm ') + status = parallel_inq_varid(NCO%id,'instant_artm',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%artm)) then + call write_log('Creating variable instant_artm') + status = parallel_def_var(NCO%id,'instant_artm',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous air temperature') + status = parallel_put_att(NCO%id, varid, 'units', 'degC') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_artm was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_humidity -- instantaneous humidity + pos = index(NCO%vars,' instant_humidity ') + status = parallel_inq_varid(NCO%id,'instant_humidity',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+16) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%humidity)) then + call write_log('Creating variable instant_humidity') + status = parallel_def_var(NCO%id,'instant_humidity',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous humidity') + status = parallel_put_att(NCO%id, varid, 'units', '1') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_humidity was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_lwdown -- instantaneous lw down + pos = index(NCO%vars,' instant_lwdown ') + status = parallel_inq_varid(NCO%id,'instant_lwdown',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+14) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%lwdown)) then + call write_log('Creating variable instant_lwdown') + status = parallel_def_var(NCO%id,'instant_lwdown',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous lw down') + status = parallel_put_att(NCO%id, varid, 'units', 'W/m2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_lwdown was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_prcp -- instantaneous precip + pos = index(NCO%vars,' instant_prcp ') + status = parallel_inq_varid(NCO%id,'instant_prcp',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+12) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%prcp)) then + call write_log('Creating variable instant_prcp') + status = parallel_def_var(NCO%id,'instant_prcp',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous precip') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_prcp was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_psurf -- instantaneous surface pressure + pos = index(NCO%vars,' instant_psurf ') + status = parallel_inq_varid(NCO%id,'instant_psurf',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+13) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%psurf)) then + call write_log('Creating variable instant_psurf') + status = parallel_def_var(NCO%id,'instant_psurf',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous surface pressure') + status = parallel_put_att(NCO%id, varid, 'units', 'Pa') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_psurf was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_siced -- superimposed ice depth + pos = index(NCO%vars,' instant_siced ') + status = parallel_inq_varid(NCO%id,'instant_siced',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+13) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%siced)) then + call write_log('Creating variable instant_siced') + status = parallel_def_var(NCO%id,'instant_siced',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'superimposed ice depth') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_siced was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_snowd -- snow depth + pos = index(NCO%vars,' instant_snowd ') + status = parallel_inq_varid(NCO%id,'instant_snowd',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+13) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%snowd)) then + call write_log('Creating variable instant_snowd') + status = parallel_def_var(NCO%id,'instant_snowd',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'snow depth') + status = parallel_put_att(NCO%id, varid, 'units', 'meter') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_snowd was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_swdown -- instantaneous sw down + pos = index(NCO%vars,' instant_swdown ') + status = parallel_inq_varid(NCO%id,'instant_swdown',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+14) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%swdown)) then + call write_log('Creating variable instant_swdown') + status = parallel_def_var(NCO%id,'instant_swdown',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous sw down') + status = parallel_put_att(NCO%id, varid, 'units', 'W/m2') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_swdown was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_xwind -- instantaneous x-wind + pos = index(NCO%vars,' instant_xwind ') + status = parallel_inq_varid(NCO%id,'instant_xwind',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+13) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%xwind)) then + call write_log('Creating variable instant_xwind') + status = parallel_def_var(NCO%id,'instant_xwind',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous x-wind') + status = parallel_put_att(NCO%id, varid, 'units', 'm/s') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_xwind was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + ! instant_ywind -- instantaneous y-wind + pos = index(NCO%vars,' instant_ywind ') + status = parallel_inq_varid(NCO%id,'instant_ywind',varid) + if (pos.ne.0) then + NCO%vars(pos+1:pos+13) = ' ' + end if + if (pos.ne.0 .and. status.eq.nf90_enotvar) then + if (is_enabled(data%mbal_accum%ywind)) then + call write_log('Creating variable instant_ywind') + status = parallel_def_var(NCO%id,'instant_ywind',get_xtype(outfile,NF90_FLOAT),(/x1_dimid, y1_dimid, time_dimid/),varid) + call nc_errorhandle(__FILE__,__LINE__,status) + status = parallel_put_att(NCO%id, varid, 'long_name', 'instantaneous y-wind') + status = parallel_put_att(NCO%id, varid, 'units', 'm/s') + if (glimmap_allocated(model%projection)) then + status = parallel_put_att(NCO%id, varid, 'grid_mapping',glimmer_nc_mapvarname) + status = parallel_put_att(NCO%id, varid, 'coordinates', 'lon lat') + end if + else + call write_log('Variable instant_ywind was specified for output but it is inappropriate for your config settings. It will be excluded from the output.', GM_WARNING) + end if + end if + + end subroutine glint_mbal_io_create + + subroutine glint_mbal_io_write(outfile,data) + use parallel + use glint_type + use glimmer_ncdf + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + ! the model instance + + ! local variables + real(dp) :: tavgf + integer status, varid + integer up + + tavgf = outfile%total_time + if (tavgf.ne.0.d0) then + tavgf = 1.d0/tavgf + end if + + ! write variables + status = parallel_inq_varid(NCO%id,'instant_ablt',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%ablt, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_acab',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%acab, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_artm',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%artm, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_humidity',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%humidity, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_lwdown',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%lwdown, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_prcp',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%prcp, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_psurf',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%psurf, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_siced',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%siced, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_snowd',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%snowd, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_swdown',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%swdown, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_xwind',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%xwind, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = parallel_inq_varid(NCO%id,'instant_ywind',varid) + if (status .eq. nf90_noerr) then + status = distributed_put_var(NCO%id, varid, & + data%mbal_accum%ywind, (/1,1,outfile%timecounter/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + end subroutine glint_mbal_io_write + + + subroutine glint_mbal_add_to_restart_variable_list(vars_to_add) + ! This subroutine adds variables to the list of variables needed for a restart. + ! It is a public subroutine that allows other parts of the model to modify the list, + ! which is a module level variable. MJH 1/17/2013 + + use glimmer_log + implicit none + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + character(len=*), intent (in) :: vars_to_add ! list of variable(s) to be added to the list of restart variables + !character(*), intent (inout) :: restart_variable_list ! list of variables needed to perform an exact restart - module variable + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------------ + + ! Add the variables to the list so long as they don't make the list too long. + if ( (len_trim(restart_variable_list) + 1 + len_trim(vars_to_add)) > len(restart_variable_list)) then + call write_log('Adding restart variables has made the restart variable list too long.',GM_FATAL) + else + restart_variable_list = trim(adjustl(restart_variable_list)) // ' ' // trim(vars_to_add) + !call write_log('Adding to glint_mbal restart variable list: ' // trim(vars_to_add) ) + endif + + end subroutine glint_mbal_add_to_restart_variable_list + + + ! Functions for the interface 'is_enabled'. These are needed by the auto-generated code in glint_mbal_io_create + ! to determine if a variable is 'turned on', and should be written. + + function is_enabled_0dint(var) + integer, intent(in) :: var + logical :: is_enabled_0dint + is_enabled_0dint = .true. ! scalars are always enabled + return + end function is_enabled_0dint + + function is_enabled_1dint(var) + integer, dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dint + if (associated(var)) then + is_enabled_1dint = .true. + else + is_enabled_1dint = .false. + endif + return + end function is_enabled_1dint + + function is_enabled_2dint(var) + integer, dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dint + if (associated(var)) then + is_enabled_2dint = .true. + else + is_enabled_2dint = .false. + endif + return + end function is_enabled_2dint + + function is_enabled_0dreal(var) + real(dp), intent(in) :: var + logical :: is_enabled_0dreal + is_enabled_0dreal = .true. ! scalars are always enabled + return + end function is_enabled_0dreal + + function is_enabled_1dreal(var) + real(dp), dimension(:), pointer, intent(in) :: var + logical :: is_enabled_1dreal + if (associated(var)) then + is_enabled_1dreal = .true. + else + is_enabled_1dreal = .false. + endif + return + end function is_enabled_1dreal + + function is_enabled_2dreal(var) + real(dp), dimension(:,:), pointer, intent(in) :: var + logical :: is_enabled_2dreal + if (associated(var)) then + is_enabled_2dreal = .true. + else + is_enabled_2dreal = .false. + endif + return + end function is_enabled_2dreal + + function is_enabled_3dreal(var) + real(dp), dimension(:,:,:), pointer, intent(in) :: var + logical :: is_enabled_3dreal + if (associated(var)) then + is_enabled_3dreal = .true. + else + is_enabled_3dreal = .false. + endif + return + end function is_enabled_3dreal + + + !***************************************************************************** + ! netCDF input + !***************************************************************************** + subroutine glint_mbal_io_readall(data, model, filetype) + ! read from netCDF file + use glint_type + use glide_types + use glimmer_ncdf + use glimmer_ncio + implicit none + type(glint_instance) :: data + type(glide_global_type) :: model + integer, intent(in), optional :: filetype ! 0 for input, 1 for forcing; defaults to input + + ! local variables + type(glimmer_nc_input), pointer :: ic + integer :: filetype_local + + if (present(filetype)) then + filetype_local = filetype + else + filetype_local = 0 ! default to input type + end if + + if (filetype_local == 0) then + ic=>model%funits%in_first + else + ic=>model%funits%frc_first + endif + do while(associated(ic)) + call glimmer_nc_checkread(ic,model) + if (ic%nc%just_processed) then + call glint_mbal_io_read(ic,data) + end if + ic=>ic%next + end do + end subroutine glint_mbal_io_readall + + + subroutine glint_mbal_read_forcing(data, model) + ! Read data from forcing files + use glimmer_log + use glide_types + use glimmer_ncdf + + implicit none + type(glint_instance) :: data + type(glide_global_type), intent(inout) :: model + + ! Locals + type(glimmer_nc_input), pointer :: ic + integer :: t + real(dp) :: eps ! a tolerance to use for stepwise constant forcing + + ! Make eps a fraction of the time step. + eps = model%numerics%tinc * 1.0d-4 + + ! read forcing files + ic=>model%funits%frc_first + do while(associated(ic)) + + !print *, 'possible forcing times', ic%times + + ! Find the current time in the file + do t = ic%nt, 1, -1 ! look through the time array backwards + if ( ic%times(t) <= model%numerics%time + eps) then + ! use the largest time that is smaller or equal to the current time (stepwise forcing) + + ! Set the desired time to be read + ic%current_time = t + !print *, 'time, forcing index, forcing time', model%numerics%time, ic%current_time, ic%times(ic%current_time) + exit ! once we find the time, exit the loop + endif + end do + + ! read all forcing fields present in this file for the time specified above + ic%nc%just_processed = .false. ! set this to false so it will be re-processed every time through - this ensures info gets written to the log, and that time levels don't get skipped. + call glint_mbal_io_readall(data, model, filetype=1) + + ! move on to the next forcing file + ic=>ic%next + end do + + end subroutine glint_mbal_read_forcing + + +!------------------------------------------------------------------------------ + + + subroutine glint_mbal_io_read(infile,data) + ! read variables from a netCDF file + use parallel + use glimmer_log + use glimmer_ncdf + use glint_type + use glimmer_paramets + use glimmer_scales + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + ! the model instance + + ! local variables + integer status,varid + integer up + real(dp) :: scaling_factor + + ! read variables + end subroutine glint_mbal_io_read + + subroutine glint_mbal_io_checkdim(infile,model,data) + ! check if dimension sizes in file match dims of model + use parallel + use glimmer_log + use glimmer_ncdf + use glide_types + use glint_type + implicit none + type(glimmer_nc_input), pointer :: infile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glint_instance), optional :: data + + integer status,dimid,dimsize + character(len=150) message + + ! check dimensions + status = parallel_inq_dimid(NCI%id,'level',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size level does not match: ', & + model%general%upn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'lithoz',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%lithot%nlayer) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size lithoz does not match: ', & + model%lithot%nlayer + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'staglevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size staglevel does not match: ', & + model%general%upn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'stagwbndlevel',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.model%general%upn+1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size stagwbndlevel does not match: ', & + model%general%upn+1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x0 does not match: ', & + global_ewn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'x1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_ewn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size x1 does not match: ', & + global_ewn + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y0',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn-1) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y0 does not match: ', & + global_nsn-1 + call write_log(message,GM_FATAL) + end if + end if + status = parallel_inq_dimid(NCI%id,'y1',dimid) + if (dimid.gt.0) then + status = parallel_inquire_dimension(NCI%id,dimid,len=dimsize) + if (dimsize.ne.global_nsn) then + write(message,*) 'Error, reading file ',trim(NCI%filename),' size y1 does not match: ', & + global_nsn + call write_log(message,GM_FATAL) + end if + end if + end subroutine glint_mbal_io_checkdim + + !***************************************************************************** + ! calculating time averages + !***************************************************************************** +#ifdef HAVE_AVG + subroutine glint_mbal_avg_accumulate(outfile,data,model) + use parallel + use glide_types + use glint_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glide_global_type) :: model + type(glint_instance) :: data + + ! local variables + real(dp) :: factor + integer status, varid + + ! increase total time + outfile%total_time = outfile%total_time + model%numerics%tinc + factor = model%numerics%tinc + + end subroutine glint_mbal_avg_accumulate + + subroutine glint_mbal_avg_reset(outfile,data) + use parallel + use glint_type + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile + ! structure containg output netCDF descriptor + type(glint_instance) :: data + + ! local variables + integer status, varid + + ! reset total time + outfile%total_time = 0.d0 + + end subroutine glint_mbal_avg_reset +#endif + + !********************************************************************* + ! some private procedures + !********************************************************************* + + !> apply default type to be used in netCDF file + integer function get_xtype(outfile,xtype) + use glimmer_ncdf + implicit none + type(glimmer_nc_output), pointer :: outfile !< derived type holding information about output file + integer, intent(in) :: xtype !< the external netCDF type + + get_xtype = xtype + + if (xtype.eq.NF90_REAL .and. outfile%default_xtype.eq.NF90_DOUBLE) then + get_xtype = NF90_DOUBLE + end if + if (xtype.eq.NF90_DOUBLE .and. outfile%default_xtype.eq.NF90_REAL) then + get_xtype = NF90_REAL + end if + end function get_xtype + + !********************************************************************* + ! lots of accessor subroutines follow + !********************************************************************* + subroutine glint_mbal_get_instant_ablt(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%ablt + end subroutine glint_mbal_get_instant_ablt + + subroutine glint_mbal_set_instant_ablt(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%ablt = inarray + end subroutine glint_mbal_set_instant_ablt + + subroutine glint_mbal_get_instant_acab(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%acab + end subroutine glint_mbal_get_instant_acab + + subroutine glint_mbal_set_instant_acab(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%acab = inarray + end subroutine glint_mbal_set_instant_acab + + subroutine glint_mbal_get_instant_artm(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%artm + end subroutine glint_mbal_get_instant_artm + + subroutine glint_mbal_set_instant_artm(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%artm = inarray + end subroutine glint_mbal_set_instant_artm + + subroutine glint_mbal_get_instant_humidity(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%humidity + end subroutine glint_mbal_get_instant_humidity + + subroutine glint_mbal_set_instant_humidity(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%humidity = inarray + end subroutine glint_mbal_set_instant_humidity + + subroutine glint_mbal_get_instant_lwdown(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%lwdown + end subroutine glint_mbal_get_instant_lwdown + + subroutine glint_mbal_set_instant_lwdown(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%lwdown = inarray + end subroutine glint_mbal_set_instant_lwdown + + subroutine glint_mbal_get_instant_prcp(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%prcp + end subroutine glint_mbal_get_instant_prcp + + subroutine glint_mbal_set_instant_prcp(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%prcp = inarray + end subroutine glint_mbal_set_instant_prcp + + subroutine glint_mbal_get_instant_psurf(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%psurf + end subroutine glint_mbal_get_instant_psurf + + subroutine glint_mbal_set_instant_psurf(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%psurf = inarray + end subroutine glint_mbal_set_instant_psurf + + subroutine glint_mbal_get_instant_siced(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%siced + end subroutine glint_mbal_get_instant_siced + + subroutine glint_mbal_set_instant_siced(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%siced = inarray + end subroutine glint_mbal_set_instant_siced + + subroutine glint_mbal_get_instant_snowd(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%snowd + end subroutine glint_mbal_get_instant_snowd + + subroutine glint_mbal_set_instant_snowd(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%snowd = inarray + end subroutine glint_mbal_set_instant_snowd + + subroutine glint_mbal_get_instant_swdown(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%swdown + end subroutine glint_mbal_get_instant_swdown + + subroutine glint_mbal_set_instant_swdown(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%swdown = inarray + end subroutine glint_mbal_set_instant_swdown + + subroutine glint_mbal_get_instant_xwind(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%xwind + end subroutine glint_mbal_get_instant_xwind + + subroutine glint_mbal_set_instant_xwind(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%xwind = inarray + end subroutine glint_mbal_set_instant_xwind + + subroutine glint_mbal_get_instant_ywind(data,outarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(out) :: outarray + + outarray = data%mbal_accum%ywind + end subroutine glint_mbal_get_instant_ywind + + subroutine glint_mbal_set_instant_ywind(data,inarray) + use glimmer_scales + use glimmer_paramets + use glint_type + implicit none + type(glint_instance) :: data + real(dp), dimension(:,:), intent(in) :: inarray + + data%mbal_accum%ywind = inarray + end subroutine glint_mbal_set_instant_ywind + + +end module glint_mbal_io diff --git a/components/cism/glimmer-cism/libglint/glint_mbal_vars.def b/components/cism/glimmer-cism/libglint/glint_mbal_vars.def new file mode 100644 index 0000000000..c781e3d3ad --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_mbal_vars.def @@ -0,0 +1,164 @@ +#[] +#dimensions: time, y1, x1 +#units: +#long_name: +#data: +#factor: + +# setup for code generator +[VARSET] +# prefix of the generated module +name: glint_mbal +# f90 type containing all necessary data +datatype: glint_instance +# module where type is defined +datamod: glint_type + +[x0] +dimensions: x0 +units: meter +long_name: Cartesian x-coordinate, velocity grid +standard_name: projection_x_coordinate +dimlen: global_ewn-1 + +[y0] +dimensions: y0 +units: meter +long_name: Cartesian y-coordinate, velocity grid +standard_name: projection_y_coordinate +dimlen: global_nsn-1 + +[x1] +dimensions: x1 +units: meter +long_name: Cartesian x-coordinate +standard_name: projection_x_coordinate +dimlen: global_ewn + +[y1] +dimensions: y1 +units: meter +long_name: Cartesian y-coordinate +standard_name: projection_y_coordinate +dimlen: global_nsn + +# --- MJH 8/29/2014 ----------------------------------------------- +# Because glint is calling glide_nc_fillall() these glide dimension variables +# need to be included here even though they are not used by glint, otherwise +# a fatal error occurs (at least on some builds). +# A more appropriate fix might be to create a glint_nc_fillall() that would not +# try to write these variables to the output file. +[level] +dimensions: level +units: 1 +long_name: sigma layers +standard_name: land_ice_sigma_coordinate +formula_terms: sigma: level topo: topg thick: thk +dimlen: model%general%upn + +[staglevel] +dimensions: staglevel +units: 1 +long_name: stag sigma layers +standard_name: land_ice_stag_sigma_coordinate +positive: down +dimlen: model%general%upn-1 + +[stagwbndlevel] +dimensions: stagwbndlevel +units: 1 +long_name: stag sigma layers with boundaries +standard_name: land_ice_stag_sigma_coordinate_with_bnd +positive: down +dimlen: model%general%upn+1 + +[lithoz] +dimensions: lithoz +units: meter +long_name: vertical coordinate of lithosphere layer +dimlen: model%lithot%nlayer +# ------------------------------------------------------------------ + +[instant_snowd] +dimensions: time, y1, x1 +units: meter +long_name: snow depth +data: data%mbal_accum%snowd +coordinates: lon lat + +[instant_siced] +dimensions: time, y1, x1 +units: meter +long_name: superimposed ice depth +data: data%mbal_accum%siced +coordinates: lon lat + +[instant_acab] +dimensions: time, y1, x1 +units: meter +long_name: instantaneous mass-balance +data: data%mbal_accum%acab +coordinates: lon lat + +[instant_ablt] +dimensions: time, y1, x1 +units: meter +long_name: instantaneous ablation +data: data%mbal_accum%ablt +coordinates: lon lat + +[instant_prcp] +dimensions: time, y1, x1 +units: meter +long_name: instantaneous precip +data: data%mbal_accum%prcp +coordinates: lon lat + +[instant_artm] +dimensions: time, y1, x1 +units: degC +long_name: instantaneous air temperature +data: data%mbal_accum%artm +coordinates: lon lat + +[instant_xwind] +dimensions: time, y1, x1 +units: m/s +long_name: instantaneous x-wind +data: data%mbal_accum%xwind +coordinates: lon lat + +[instant_ywind] +dimensions: time, y1, x1 +units: m/s +long_name: instantaneous y-wind +data: data%mbal_accum%ywind +coordinates: lon lat + +[instant_humidity] +dimensions: time, y1, x1 +units: 1 +long_name: instantaneous humidity +data: data%mbal_accum%humidity +coordinates: lon lat + +[instant_swdown] +dimensions: time, y1, x1 +units: W/m2 +long_name: instantaneous sw down +data: data%mbal_accum%swdown +coordinates: lon lat + +[instant_lwdown] +dimensions: time, y1, x1 +units: W/m2 +long_name: instantaneous lw down +data: data%mbal_accum%lwdown +coordinates: lon lat + +[instant_psurf] +dimensions: time, y1, x1 +units: Pa +long_name: instantaneous surface pressure +data: data%mbal_accum%psurf +coordinates: lon lat diff --git a/components/cism/glimmer-cism/libglint/glint_mpinterp.F90 b/components/cism/glimmer-cism/libglint/glint_mpinterp.F90 new file mode 100644 index 0000000000..cd81c3ba44 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_mpinterp.F90 @@ -0,0 +1,361 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_mpinterp.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_mpinterp + + ! Uses SLAP to calculate the field needed to perform + ! mean-preserving interpolation on a sphere + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + implicit none + + type mpinterp + integer :: nx,ny ! Grid sizes + integer :: lenw,leniw ! Lengths of work arrays + ! Column vectors + real(dp),dimension(:), pointer :: rhs => null() ! Right-hand side + real(dp),dimension(:), pointer :: answ => null() ! Answer + ! Sparse matrix storage + integer, dimension(:), pointer :: row => null() ! Row indicies + integer, dimension(:), pointer :: col => null() ! Column indices + real(dp),dimension(:), pointer :: arr => null() ! Array elements + ! Work arrays + real(dp),dimension(:), pointer :: rwork => null() ! Real work array + integer, dimension(:), pointer :: iwork => null() ! Int work array + ! Grid-box areas + real(dp),dimension(:,:),pointer :: areas => null() ! Grid-box areas + end type mpinterp + + private + public mpinterp,new_mpinterp,mean_preserve_interp + +contains + + subroutine new_mpinterp(params,grid) + + use glint_global_grid + + type(mpinterp), intent(inout) :: params + type(global_grid),intent(in) :: grid + + real(dp),dimension(:),allocatable :: dx1,dx2,dx3,dx4 + real(dp),dimension(:),allocatable :: dy1,dy2,dy3,dy4 + + real(dp),dimension(:,:),allocatable :: fa,ga,ha,ja + real(dp),dimension(:,:),allocatable :: fb,gb,hb,jb + real(dp),dimension(:,:),allocatable :: fc,gc,hc,jc + real(dp),dimension(:,:),allocatable :: fd,gd,hd,jd + real(dp),dimension(:,:),allocatable :: xta,xtb,xtc,xtd + real(dp),dimension(:,:),allocatable :: yta,ytb,ytc,ytd + real(dp),dimension(:,:),allocatable :: xyta,xytb,xytc,xytd + real(dp),dimension(:,:),allocatable :: ph1,ph2,ph3,ph4 + real(dp),dimension(:,:),allocatable :: ph5,ph6,ph7,ph8,ph9 + + real(dp),dimension(:),allocatable :: lons,lonb,lats,latb + + integer :: i,j,ii + + params%nx = grid%nx + params%ny = grid%ny + + ! Allocate derived type elements + if (associated(params%rhs)) deallocate(params%rhs) + if (associated(params%answ)) deallocate(params%answ) + if (associated(params%row)) deallocate(params%row) + if (associated(params%col)) deallocate(params%col) + if (associated(params%arr)) deallocate(params%arr) + if (associated(params%rwork)) deallocate(params%rwork) + if (associated(params%iwork)) deallocate(params%iwork) + if (associated(params%areas)) deallocate(params%areas) + + allocate(params%rhs (params%nx*params%ny)) + allocate(params%answ (params%nx*params%ny)) + allocate(params%row (params%nx*params%ny*9)) + allocate(params%col (params%nx*params%ny*9)) + allocate(params%arr (params%nx*params%ny*9)) + allocate(params%areas(params%nx,params%ny)) + + ! Allocate temporary work arrays + ! 1D arrays + allocate(dx1(params%nx),dx2(params%nx),dx3(params%nx),dx4(params%nx)) + allocate(dy1(params%ny),dy2(params%ny),dy3(params%ny),dy4(params%ny)) + + ! 2D arrays + allocate(fa(params%nx,params%ny),ga(params%nx,params%ny)) + allocate(ha(params%nx,params%ny),ja(params%nx,params%ny)) + allocate(fb(params%nx,params%ny),gb(params%nx,params%ny)) + allocate(hb(params%nx,params%ny),jb(params%nx,params%ny)) + allocate(fc(params%nx,params%ny),gc(params%nx,params%ny)) + allocate(hc(params%nx,params%ny),jc(params%nx,params%ny)) + allocate(fd(params%nx,params%ny),gd(params%nx,params%ny)) + allocate(hd(params%nx,params%ny),jd(params%nx,params%ny)) + + allocate(xta(params%nx,params%ny),xtb(params%nx,params%ny)) + allocate(xtc(params%nx,params%ny),xtd(params%nx,params%ny)) + allocate(yta(params%nx,params%ny),ytb(params%nx,params%ny)) + allocate(ytc(params%nx,params%ny),ytd(params%nx,params%ny)) + allocate(xyta(params%nx,params%ny),xytb(params%nx,params%ny)) + allocate(xytc(params%nx,params%ny),xytd(params%nx,params%ny)) + + allocate(ph1(params%nx,params%ny),ph2(params%nx,params%ny)) + allocate(ph3(params%nx,params%ny),ph4(params%nx,params%ny)) + allocate(ph5(params%nx,params%ny),ph6(params%nx,params%ny)) + allocate(ph7(params%nx,params%ny),ph8(params%nx,params%ny)) + allocate(ph9(params%nx,params%ny)) + + ! Local copy of grid data + ! (necessary because we deal in radians) + allocate(lons(params%nx),lonb(0:params%nx)) + allocate(lats(params%ny),latb(0:params%ny)) + +! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! + + +! + xls.f90 - part of the CISM ice model + +! + + +! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! + dy2(params%ny) = latb(params%ny-1)-lats(params%ny) + dy3(params%ny) = lats(params%ny) -latb(params%ny) + dy4(params%ny) = latb(params%ny) +pi+lats(params%ny) + + ! Quadrant constants + do i=1,params%nx + do j=1,params%ny + ! F constants + fa(i,j) = dx2(i) * (sin(latb(j)+dy3(j)) - sin(latb(j))) + fb(i,j) = dx3(i) * (sin(latb(j)+dy3(j)) - sin(latb(j))) + fc(i,j) = dx3(i) * (sin(lats(j)+dy2(j)) - sin(lats(j))) + fd(i,j) = dx2(i) * (sin(lats(j)+dy2(j)) - sin(lats(j))) + ! G constants + ga(i,j) = (dx2(i)**2/2.0) * (sin(latb(j)+dy3(j)) - sin(latb(j))) + gb(i,j) = (dx3(i)**2/2.0) * (sin(latb(j)+dy3(j)) - sin(latb(j))) + gc(i,j) = (dx3(i)**2/2.0) * (sin(lats(j)+dy2(j)) - sin(lats(j))) + gd(i,j) = (dx2(i)**2/2.0) * (sin(lats(j)+dy2(j)) - sin(lats(j))) + ! H constants + ha(i,j) = dx2(i) * (dy3(j)*sin(latb(j)+dy3(j)) + cos(latb(j)+dy3(j)) - cos(latb(j))) + hb(i,j) = dx3(i) * (dy3(j)*sin(latb(j)+dy3(j)) + cos(latb(j)+dy3(j)) - cos(latb(j))) + hc(i,j) = dx3(i) * (dy2(j)*sin(lats(j)+dy2(j)) + cos(lats(j)+dy2(j)) - cos(lats(j))) + hd(i,j) = dx2(i) * (dy2(j)*sin(lats(j)+dy2(j)) + cos(lats(j)+dy2(j)) - cos(lats(j))) + ! J constants + ja(i,j) = (dx2(i)**2/2.0) * (dy3(j)*sin(latb(j)+dy3(j)) + cos(latb(j)+dy3(j)) - cos(latb(j))) + jb(i,j) = (dx3(i)**2/2.0) * (dy3(j)*sin(latb(j)+dy3(j)) + cos(latb(j)+dy3(j)) - cos(latb(j))) + jc(i,j) = (dx3(i)**2/2.0) * (dy2(j)*sin(lats(j)+dy2(j)) + cos(lats(j)+dy2(j)) - cos(lats(j))) + jd(i,j) = (dx2(i)**2/2.0) * (dy2(j)*sin(lats(j)+dy2(j)) + cos(lats(j)+dy2(j)) - cos(lats(j))) + end do + end do + params%areas = fa+fb+fc+fd + + do i=1,params%nx + do j=1,params%ny + xta(i,j) = (ga(i,j)+fa(i,j)*dx1(i))/(dx1(i)+dx2(i)) + xtb(i,j) = (gb(i,j)) /(dx3(i)+dx4(i)) + xtc(i,j) = (gc(i,j)) /(dx3(i)+dx4(i)) + xtd(i,j) = (gd(i,j)+fd(i,j)*dx1(i))/(dx1(i)+dx2(i)) + + yta(i,j) = (ha(i,j)+fa(i,j)*dy4(j))/(dy3(j)+dy4(j)) + ytb(i,j) = (hb(i,j)+fb(i,j)*dy4(j))/(dy3(j)+dy4(j)) + ytc(i,j) = (hc(i,j)) /(dy1(j)+dy2(j)) + ytd(i,j) = (hd(i,j)) /(dy1(j)+dy2(j)) + + xyta(i,j) = (ja(i,j)+ha(i,j)*dx1(i)+ga(i,j)*dy4(j)+fa(i,j)*dx1(i)*dy4(j))/ & + ((dx1(i)+dx2(i))*(dy3(j)+dy4(j))) + xytb(i,j) = (jb(i,j)+gb(i,j)*dy4(j))/((dx3(i)+dx4(i))*(dy3(j)+dy4(j))) + xytc(i,j) = jc(i,j) /((dx3(i)+dx4(i))*(dy1(j)+dy2(j))) + xytd(i,j) = (jd(i,j)+hd(i,j)*dx1(i))/((dx1(i)+dx2(i))*(dy1(j)+dy2(j))) + end do + end do + + ! Calculate PHIs (main part) + ph1 = fa - xta - yta + xyta + ph2 = xta - xyta + fb - xtb - ytb + xytb + ph3 = xtb - xytb + ph4 = yta - xyta + fd - xtd - ytd + xytd + ph5 = xyta + ytb - xytb + xtd - xytd + fc - xtc - ytc + xytc + ph6 = xytb + xtc - xytc + ph7 = ytd - xytd + ph8 = ytc - xytc + xytd + ph9 = xytc + + params%row=0 + params%col=0 + params%arr=0.0 + + ! Matrix main body + ii=1 + do i=1,params%nx + do j=1,params%ny + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i-1,j+1,params%nx,params%ny) + params%arr(ii) = ph1(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i,j+1,params%nx,params%ny) + params%arr(ii) = ph2(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i+1,j+1,params%nx,params%ny) + params%arr(ii) = ph3(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i-1,j,params%nx,params%ny) + params%arr(ii) = ph4(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i,j,params%nx,params%ny) + params%arr(ii) = ph5(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i+1,j,params%nx,params%ny) + params%arr(ii) = ph6(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i-1,j-1,params%nx,params%ny) + params%arr(ii) = ph7(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i,j-1,params%nx,params%ny) + params%arr(ii) = ph8(i,j) + ii=ii+1 + params%row(ii) = linloc(i,j,params%nx,params%ny) + params%col(ii) = linloc(i+1,j-1,params%nx,params%ny) + params%arr(ii) = ph9(i,j) + ii=ii+1 + end do + end do + + params%lenw = 10*params%nx*params%ny+8*params%nx*params%ny + params%leniw = 10*params%nx*params%ny+4*params%nx*params%ny+12 + allocate(params%rwork(params%lenw),params%iwork(params%leniw)) + + deallocate(dx1,dx2,dx3,dx4) + deallocate(dy1,dy2,dy3,dy4) + deallocate(fa,ga,ha,ja) + deallocate(fb,gb,hb,jb) + deallocate(fc,gc,hc,jc) + deallocate(fd,gd,hd,jd) + deallocate(xta,xtb,xtc,xtd) + deallocate(yta,ytb,ytc,ytd) + deallocate(xyta,xytb,xytc,xytd) + deallocate(ph1,ph2,ph3,ph4) + deallocate(ph5,ph6,ph7,ph8,ph9) + deallocate(lons,lonb,lats,latb) + + end subroutine new_mpinterp + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine mean_preserve_interp(params,in,out,zeros) + + type(mpinterp), intent(inout) :: params + real(dp),dimension(:,:),intent(in) :: in + real(dp),dimension(:,:),intent(out) :: out + logical, dimension(:,:),intent(out) :: zeros + + integer :: i,j + + integer :: iter,ierr + real(dp) :: err + + ! Copy right-hand side + do i=1,params%nx + do j=1,params%ny + params%rhs(linloc(i,j,params%nx,params%ny)) = in(i,j)*params%areas(i,j) + end do + end do + + params%answ = params%rhs + + call dslucs(params%nx*params%ny, & ! n ... order of matrix a (in) + params%rhs, & ! b ... right hand side vector (in) + params%answ, & ! x ... initial quess/final solution vector (in/out) + params%nx*params%ny*9, & ! nelt ... number of non-zeroes in A (in) + params%row, & ! ia ... sparse matrix format of A (in) + params%col, & ! ja ... sparse matrix format of A (in) + params%arr, & ! a ... matrix (in) + 0, & ! isym ... storage method (0 is complete) (in) + 2, & ! itol ... convergence criteria (2 recommended) (in) + 1.0d-12, & ! tol ... criteria for convergence (in) + 101, & ! itmax ... maximum number of iterations (in) + iter, & ! iter ... returned number of iterations (out) + err, & ! err ... error estimate of solution (out) + ierr, & ! ierr ... returned error message (0 is ok) (out) + 0, & ! iunit ... unit for error writes during iteration (0 no write) (in) + params%rwork, & ! rwork ... workspace for SLAP routines (in) + params%lenw, & ! lenw + params%iwork, & ! iwork ... workspace for SLAP routines (in) + params%leniw) ! leniw + + ! Rejig answer back into 2d array + do i=1,params%nx + do j=1,params%ny + out(i,j)=params%answ(linloc(i,j,params%nx,params%ny)) + end do + end do + + ! Check for zeros + zeros = (in==0.0) + + end subroutine mean_preserve_interp + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + integer function linloc(i,j,nx,ny) + + integer :: i,j + integer :: nx,ny + integer :: ii,jj + + ii=i + jj=j + + do + if (jj>=1.and.jj<=ny) exit + if (jj==0) then + jj=1 + ii=ii+nx/2 + end if + if (jj==ny+1) then + jj=ny + ii=ii+nx/2 + end if + end do + + do + if (ii>=1.and.ii<=nx) exit + if (ii<1) ii=ii+nx + if (ii>nx) ii=ii-nx + end do + + linloc = (ii-1)*ny+jj + + end function linloc + +end module glint_mpinterp diff --git a/components/cism/glimmer-cism/libglint/glint_pdd.F90 b/components/cism/glimmer-cism/libglint/glint_pdd.F90 new file mode 100644 index 0000000000..9ebb9b3a16 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_pdd.F90 @@ -0,0 +1,456 @@ + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_pdd.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_pdd + + ! The Glint annual poe degree day mass-balance scheme. + ! Based on the original pdd mass-balance code from Tony's model. + ! + ! {\bf N.B.} the module variables in this module are used for back-door + ! message passing, to make the integration of the PDD table look more + ! comprehensible, and avoid the need to have two customised copies of + ! the integration code. + ! + ! Note also that this code now deals in {\it unscaled} variables. + ! + ! All precip and mass-balance amounts are as meters of water equivalent. PDD + ! factors are no longer converted in the code. + + use glimmer_global, only : dp + + implicit none + + private :: dp + + type glint_pdd_params + + ! Holds parameters for positive-degree-day mass-balance + ! calculation. The table has two axes - the $x$ axis is the + ! difference between mean annual and July temps, while the + ! $y$- axis is the mean annual temp + + integer :: dx = 1 ! Spacing of values in x-direction ($^{\circ}$C) + integer :: dy = 1 ! Spacing of values in y-direction ($^{\circ}$C) + integer :: ix = 0 ! Lower bound of $x$-axis ($^{\circ}$C) + integer :: iy = -50 ! Lower bound of $y$-axis ($^{\circ}$C) + integer :: nx = 31 ! Number of values in x-direction + integer :: ny = 71 ! Number of values in y-direction + real(dp) :: dailytemp = 0.d0 + real(dp) :: tma = 0.d0 + real(dp) :: tmj = 0.d0 + real(dp) :: dtmj = 0.d0 + real(dp) :: dd_sigma = 5.d0 ! Standard deviation of daily temperature (K) + + ! The actual PDD table --------------------------------------------- + + real(dp),dimension(:,:),pointer :: pddtab => null() + + ! PDD table - must be allocated with dimensions nx,ny. + + ! Parameters for the PDD calculation + + real(dp) :: wmax = 0.6d0 ! Fraction of melted snow that refreezes +!WHL real(dp) :: pddfac_ice = 0.008 ! PDD factor for ice (m water day$^{-1}$ $^{\circ}C$^{-1}$) +! real(dp) :: pddfac_snow = 0.003 ! PDD factor for snow (m water day$^{-1}$ $^{\circ}C$^{-1}$) + real(dp) :: pddfac_ice = 8.0d-3 ! PDD factor for ice (m water day$^{-1}$ $^{\circ}C$^{-1}$) + real(dp) :: pddfac_snow = 3.0d-3 ! PDD factor for snow (m water day$^{-1}$ $^{\circ}C$^{-1}$) + + end type glint_pdd_params + + ! Module parameters use for back-door message-passing + + real(dp) :: dd_sigma ! The value of $\sigma$ in the PDD integral + real(dp) :: t_a_prime ! The value of $T'_{a}$ in the PDD integral + real(dp) :: mean_annual_temp ! Mean annual temperature + real(dp) :: mean_july_temp ! Mean july temperature + + private + public :: glint_pdd_params, glint_pdd_init, glint_pdd_mbal + +contains + +!------------------------------------------------------------------------------- +! PUBLIC subroutines +!------------------------------------------------------------------------------- + + subroutine glint_pdd_init(params,config) + + use glimmer_config + + type(glint_pdd_params),intent(inout) :: params ! The positive-degree-day parameters + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! Read the config file and output to log + + call pdd_readconfig(params,config) + call pdd_printconfig(params) + + ! Deallocate arrays + + if (associated(params%pddtab)) deallocate(params%pddtab) + + ! Allocate pdd table + + allocate(params%pddtab(params%nx,params%ny)) + call pddtabgrn(params) + + end subroutine glint_pdd_init + +!------------------------------------------------------------------------------- + + subroutine glint_pdd_mbal(params,artm,arng,prcp,ablt,acab,landsea) + + ! Calculates mass-balance over the ice model domain, by the + ! positive-degree-day method. + + implicit none + + type(glint_pdd_params), intent(inout) :: params ! The positive-degree-day parameters + real(dp), dimension(:,:), intent(in) :: artm ! Annual mean air-temperature + ! ($^{\circ}$C) + real(dp), dimension(:,:), intent(in) :: arng ! Annual temperature half-range ($^{\circ}$C) + real(dp), dimension(:,:), intent(in) :: prcp ! Annual accumulated precipitation + ! (m water equivalent) + real(dp), dimension(:,:), intent(out) :: ablt ! Annual ablation (m water equivalent) + real(dp), dimension(:,:), intent(out) :: acab ! Annual mass-balance (m water equivalent) + logical, dimension(:,:), intent(in) :: landsea ! Land-sea mask (land is TRUE) + + ! Internal variables + + real(dp) :: wfrac, pablt, tx, ty, pdd + integer :: ns,ew,nsn,ewn,kx,ky,jx,jy + + ! Get size of arrays. All arrays should be the same size as this. + + ewn=size(artm,1) ; nsn=size(artm,2) + + !----------------------------------------------------------------------- + ! Main loop + !----------------------------------------------------------------------- + + do ns = 1, nsn + do ew = 1, ewn + + if (landsea(ew,ns)) then + ! Only calculate mass-balance over 'land' + ! Find the no. of pdd from the mean annual temp and its range + + ky = int((artm(ew,ns)-params%iy)/params%dy) + kx = int((arng(ew,ns)-params%ix)/params%dx) + + ! Check to see if indicies are in range + + if ( kx < 0 ) then + tx = 0 + jx = 2 + kx = 1 + else if ( kx > params%nx-2 ) then + tx = 1.0 + jx = params%nx + kx = params%nx-1 + else + tx = arng(ew,ns) - kx * params%dx - params%ix + jx = kx + 2 + kx = kx + 1 + end if + + if ( ky < 0 ) then + ty = 0.0 + jy = 2 + ky = 1 + else if ( ky > params%ny-2 ) then + ty = 1.0 + jy = params%ny + ky = params%ny-1 + else + ty = artm(ew,ns) - ky * params%dy - params%iy; + jy = ky + 2 + ky = ky + 1 + end if + + ! this is done using a look-up table constructed earlier + + pdd = params%pddtab(kx,ky)*(1.d0-tx)*(1.d0-ty) + & + params%pddtab(jx,ky) * tx * (1.d0 - ty) + & + params%pddtab(jx,jy) * tx * ty + & + params%pddtab(kx,jy) * (1.d0 - tx) * ty + + ! this is the depth of superimposed ice that would need to be + ! melted before runoff can occur + + wfrac = params%wmax * prcp(ew,ns) + + ! this is the total potential ablation of SNOW + + pablt = pdd * params%pddfac_snow + + ! if the total snow ablation is less than the depth of + ! superimposed ice - no runoff occurs + + ! else if the total snow ablation is more than the depth + ! of superimposed ice BUT less than the total amount of + ! prcpitation - runoff occurs (at a rate equal to the + ! total potential snowmelt minus that which forms superimposed ice) + + ! else if the total snow ablation is more than the amount + ! of prcpitation - all snow that is not superimposed ice is lost + ! and the potential ablation not used on snow is used on ice + ! (including the superimposed ice) + + ! there is a change in the pddfi term, replaced wfrac with prcp + ! error spotted by jonathan 18-04-00 + + if ( pablt <= wfrac ) then + ablt(ew,ns) = 0.d0 + else if(pablt > wfrac .and.pablt <= prcp(ew,ns)) then + ablt(ew,ns) = pablt - wfrac + else + ablt(ew,ns) = prcp(ew,ns) - wfrac + params%pddfac_ice*(pdd-prcp(ew,ns)/params%pddfac_snow) + end if + + ! Finally, mass-balance is difference between accumulation and + ! ablation. + + acab(ew,ns) = prcp(ew,ns) - ablt(ew,ns) + else + ablt(ew,ns) = prcp(ew,ns) + acab(ew,ns) = 0.d0 + endif + end do + end do + + end subroutine glint_pdd_mbal + +!------------------------------------------------------------------------------- +! PRIVATE subroutines and functions +!------------------------------------------------------------------------------- + + subroutine pdd_readconfig(params,config) + + ! Reads in configuration data for the annual PDD scheme. + + use glimmer_config + + type(glint_pdd_params),intent(inout) :: params ! The positive-degree-day parameters + type(ConfigSection), pointer :: config ! structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + + call GetSection(config,section,'GLINT annual pdd') + if (associated(section)) then + call GetValue(section,'dx',params%dx) + call GetValue(section,'dy',params%dy) + call GetValue(section,'ix',params%ix) + call GetValue(section,'iy',params%iy) + call GetValue(section,'nx',params%nx) + call GetValue(section,'ny',params%ny) + call GetValue(section,'wmax',params%wmax) + call GetValue(section,'pddfac_ice',params%pddfac_ice) + call GetValue(section,'pddfac_snow',params%pddfac_snow) + call GetValue(section,'dd_sigma',params%dd_sigma) + end if + + end subroutine pdd_readconfig + +!------------------------------------------------------------------------------- + + subroutine pdd_printconfig(params) + + use glimmer_log + + type(glint_pdd_params),intent(inout) :: params ! The positive-degree-day parameters + character(len=100) :: message + + call write_log_div + + call write_log('GLINT annual PDD scheme parameters:') + call write_log('-----------------------------------') + write(message,*) 'x-spacing of pdd table',params%dx,' degC' + call write_log(message) + write(message,*) 'y-spacing of pdd table',params%dy,' degC' + call write_log(message) + write(message,*) 'Lower bound of x-axis',params%ix,' degC' + call write_log(message) + write(message,*) 'Lower bound of y-axis',params%iy,' degC' + call write_log(message) + write(message,*) 'Number of points in x',params%nx + call write_log(message) + write(message,*) 'Number of points in y',params%ny + call write_log(message) + write(message,*) 'Snow refreezing fraction',params%wmax + call write_log(message) + write(message,*) 'PDD factor for ice',params%pddfac_ice + call write_log(message) + write(message,*) 'PDD factor for snow',params%pddfac_snow + call write_log(message) + write(message,*) 'Standard deviation of temperature cycle',params%dd_sigma,' degC' + call write_log(message) + call write_log('') + + end subroutine pdd_printconfig + +!------------------------------------------------------------------------------- + + subroutine pddtabgrn(params) + + ! Initialises the positive-degree-day-table. + + use glimmer_global, only: dp + use glimmer_physcon, only: pi + use glimmer_log + use glint_integrate + + implicit none + + type(glint_pdd_params),intent(inout) :: params ! PDD parameters + + ! Internal variables + + real(dp) :: tma,dtmj + + !WHL - Note: By using a more accurate value of pi, instead of 3.1416, + ! we change answers in around the fifth decimal place +! real(sp),parameter :: twopi = 3.1416 * 2.0 ! old sp value + real(dp),parameter :: twopi = pi * 2.d0 + + integer :: kx,ky, i,j + + !-------------------------------------------------------------------- + ! Main loops: + ! tma -- the mean annual temperature (y-axis of pdd table) + ! dtmj -- difference from mean july temperature (x-axis of table) + ! tmj -- the actual july temperature + !-------------------------------------------------------------------- + + call write_log('Calculating PDD table...',GM_DIAGNOSTIC) + + do j=0,params%ny-1 + tma=params%iy + j*params%dy + + ky = findgrid(tma, real(params%iy,dp), real(params%dy,dp)) + + do i=0,params%nx-1 + dtmj = params%ix + i*params%dx + + mean_july_temp = tma + dtmj + kx = findgrid(dtmj, real(params%ix,dp), real(params%dx,dp)) + + ! need these lines to take account of the backdoor message passing used here + + mean_annual_temp = tma + dd_sigma = params%dd_sigma + + params%pddtab(kx,ky)=(1.d0/(dd_sigma*sqrt(twopi)))*romberg_int(inner_integral,0.d0,twopi) + + ! convert to days + + params%pddtab(kx,ky) = 365.d0 * params%pddtab(kx,ky) / twopi + + end do + end do + + call write_log(' ...done.',GM_DIAGNOSTIC) + + end subroutine pddtabgrn + +!------------------------------------------------------------------------------- + + real(dp) function inner_integral(day) + + ! Calculates the value of the inner integral, i.e. + ! \begin{equation} + ! \int^{T_{a}'+2.5\sigma}_{0}T_{a}\times + ! \exp\left(\frac{-(T_a-T_{a}')^2}{2\sigma^2}\right)\,dT + ! \end{equation} + use glint_integrate + + implicit none + + real(dp), intent(in) :: day ! The `day', in radians, so that a year is $2\pi$ long. + + real(dp) :: upper_limit + + t_a_prime = mean_annual_temp+(mean_july_temp-mean_annual_temp)*cos(day) + + upper_limit=t_a_prime+2.5*dd_sigma + + if (upper_limit <= 0.d0) then + inner_integral = 0.d0 + else + inner_integral = romberg_int(pdd_integrand,0.d0,upper_limit) + endif + + end function inner_integral + +!------------------------------------------------------------------------------- + + real(dp) function pdd_integrand(artm) + + ! The expression to be integrated in the calculation of the PDD table. The whole + ! integral is: + ! \begin{equation} + ! D=\frac{1}{\sigma\sqrt{2\pi}}\int^{A}_{0}\int^{T_{a}'+2.5\sigma}_{0}T_{a}\times + ! \exp\left(\frac{-(T_a-T_{a}')^2}{2\sigma^2}\right)\,dTdt + ! \end{equation} + + implicit none + + real(dp), intent(in) :: artm ! The annual mean air temperature (degC) + + pdd_integrand = artm * exp(- (artm - t_a_prime)**2 / (2.d0 * dd_sigma**2)) + + end function pdd_integrand + +!------------------------------------------------------------------------------- + + integer function findgrid(rin,init,step) + + ! Calculates which row or column of the pdd table corresponds + ! to a given value on the appropriate axis, so that: + ! \[ + ! \mathtt{findgrid}=\frac{\mathtt{rin}-\mathtt{init}}{\mathtt{step}+1} + ! \] + !*RV The relevant array index. + + use glimmer_global, only : dp + + implicit none + + real(dp), intent(in) :: rin ! Value of axis variable at current point. + real(dp), intent(in) :: init ! Value of axis variable at first point. + real(dp), intent(in) :: step ! Grid spacing. + + findgrid = (rin - init) / step + 1 + + end function findgrid + +end module glint_pdd diff --git a/components/cism/glimmer-cism/libglint/glint_precip_param.F90 b/components/cism/glimmer-cism/libglint/glint_precip_param.F90 new file mode 100644 index 0000000000..b5178631f8 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_precip_param.F90 @@ -0,0 +1,294 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_precip_param.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_precip_param + + ! The Roe/Lindzen precip downscaling parameterization + + ! Author: Ian Rutt + ! Date: 19/11/03 + + use glimmer_global, only: dp + + implicit none + + private satvap,calc_w0,error_func + +contains + + subroutine glint_precip(precip,xwind,ywind,temp,topo,dx,dy,fixed_a) + + ! Calculates the precipitation field over + ! the ice sheet using the parameterization given in + ! Roe (2002)\footnote{{\em J. Glaciol.} {\bf 48,} no.160 pp.70--80} + ! Note that: + ! \begin{itemize} + ! \item All arrays are on the ice model grid, and must have the same shape. + ! \item There is some confusion in the lit between Roe (2002) and Roe and Lindzen (2001) + ! over the dimensions of some quantities. I have used the combination + ! that is most consistent. + ! \item For the value of a, which R\&L take to be $2.5\times 10^{-11} + ! \mathrm{m}^2\,\mathrm{s\,kg}^{-1}$, I use + ! the precip rate divided by the saturated vapour pressure, unless + ! \texttt{fixed\_a} is set. + ! \item The equation used is: + ! \[P=be_{\mathrm{sat}}(T_\mathrm{s})\left[\frac{|x_0|}{2}+\frac{|x_0|}{2} + ! \mathrm{erf}(|x_0|/\alpha)+\frac{\alpha}{2\sqrt{\pi}}\exp(-(1/\alpha)^2x_0^2)\right]\] + ! with $x_0=\frac{a}{b}-w_0$, + ! $w_0$ is the mean vertical velocity + ! $b=5.9\times 10^{-9}\,\mathrm{kg\,m\,s^2}$, + ! $\alpha=0.0115\,\mathrm{ms^{-1}}$, + ! and either $a=2.5\times 10^{-11}\,\mathrm{m^2\,s\,kg^{-1}}$, or + ! $a=P/e_{\mathrm{sat}}(T)$, depending on the value of \texttt{fixed\_a}. + ! \end{itemize} + + use glimmer_physcon, only: pi + implicit none + + ! Arguments + + real(dp),dimension(:,:),intent(inout) :: precip ! Precipitation field (mm/a) + ! used for input and output. on + ! input it contains the large-scale + ! field calculated by interpolation. + ! On output, it contains the field calculated by + ! this subroutine and used for the mass-balance. + real(dp), dimension(:,:),intent(in) :: xwind ! Annual mean wind field: $x$-component (m/s) + real(dp), dimension(:,:),intent(in) :: ywind ! Annual mean wind field: $y$-component (m/s) + real(dp), dimension(:,:),intent(in) :: topo ! Surface topography (m) + real(dp),dimension(:,:), intent(in) :: temp ! Mean annual surface temperature field, + ! corrected for height ($^{\circ}$C) + real(dp), intent(in) :: dx ! $x$ grid spacing (m) + real(dp), intent(in) :: dy ! $y$ grid spacing (m) + logical,optional, intent(in) :: fixed_a ! Set to fix $\mathtt{a}=2.5\times 10^{-11} + ! \mathrm{m}^2\,\mathrm{s\,kg}^{-1}$ over the + ! whole domain, else scale \texttt{a} as described below. + ! If not present, assumed \texttt{.false.}. + + ! Internal variables + + integer :: nx,ny,i,j + real(dp),dimension(size(precip,1),size(precip,2)) :: w0 +!! real(dp),parameter :: pi=3.141592654 ! use value from glimmer_physcon + real(dp),parameter :: b = 5.9d-9 ! m s^2 kg (these are Roe and Lindzens dims) + real(dp),parameter :: alpha = 0.0115d0 ! ms^-1 + real(dp),parameter :: pc = 3.17098d-11 ! precipitation conversion factor: mm/a -> m/s + real(dp) :: x0,a + logical :: fa ! ever-present proxy for fixed_a + + ! Beginning of code + + nx=size(precip,1) ; ny=size(precip,2) + + if (present(fixed_a)) then + fa = fixed_a + else + fa = .false. + endif + + w0 = calc_w0(xwind,ywind,topo,dx,dy) ! calculate the mean vertical velocity + + do i=1,nx + do j=1,ny + if (fa) then + a = 2.5d-11 ! fixed a + else + a = precip(i,j)*pc/satvap(real(temp(i,j),dp)) ! calculate a from the precip and satvap + endif + x0 = a/b + w0(i,j) ! for convenience, calc x0 + precip(i,j) = b*satvap(real(temp(i,j),dp))* & ! the function from Roe and Lindzen (corrected) + (0.5d0*abs(x0)+(x0**2/2.d0*abs(x0))*error_func((1.d0/alpha)*abs(x0)) & + +(alpha/(2.d0*sqrt(pi)))*exp(-(1.d0/alpha)**2*x0**2)) + a = a + enddo + enddo + + precip = precip/pc ! convert back to mm/a + + end subroutine glint_precip + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Private subroutines and functions follow + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + real(dp) function satvap(temp,kelvin) + + ! Calculates the saturated vapour pressure using the + ! Clausius-Clapyron equation (from Roe 2002) + ! Note that by default the units of temperature are degC, + ! unless the kelvin flag is present and set, in which + ! case they are Kelvin. + !*RV Saturated vapour pressure in Pascals. + + use glimmer_physcon, only: trpt + implicit none + + ! Arguments + + real(dp), intent(in) :: temp ! Temperature ($^{\circ}$C or K) + logical,optional,intent(in) :: kelvin ! Set if temperature is in Kelvin + + ! Internal variables + + real(dp) :: ts + real(dp),parameter :: e0 = 6.112d0 ! This is in millibars, but multiplied by 100 below. + real(dp),parameter :: c1 = 17.67, c2=243.5d0 ! These names from Roe(2002) + + ! Beginning of code + + ! First check to see if kelvin is present and adjust accordingly + + if (present(kelvin)) then + if (kelvin) then + ts = temp - trpt !trpt = 273.15 + else + ts = temp + endif + else + ts = temp + endif + + ! finally, the function itself + + satvap = 100.d0 * e0 * exp(c1*ts/(c2+ts)) + + end function satvap + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + function calc_w0(u,v,h0,dx,dy) + + ! Calculates the mean vertical velocity field, + ! based on the horizontal flow, and the topography. + ! + ! Note that: + ! \begin{itemize} + ! \item All input arrays must be of the same rank and size. + ! \item The vertical velocity is calculated from the divergence + ! of the horizontal wind over the topography. + ! \[w_0=u\frac{\partial h_0}{\partial x}+ + ! v\frac{\partial h_0}{\partial y} \] + ! \item Differentiation is done with conventional centred-differences, + ! except at the corners, where uncentred differences are employed. + ! \end{itemize} + + !*RV An array of the same size as \texttt{u} is + !*RV returned. The units are m/s. + + implicit none + + ! Arguments + + real(dp),dimension(:,:),intent(in) :: u ! The $x$ component of the mean wind field (m/s) + real(dp),dimension(:,:),intent(in) :: v ! The $y$ component of the mean wind field (m/s) + real(dp),dimension(:,:),intent(in) :: h0 ! The topography (m) + real(dp), intent(in) :: dx ! The $x$ grid-spacing (m) + real(dp), intent(in) :: dy ! The $y$ grid-spacing (m) + + ! Returned array + + real(dp),dimension(size(u,1),size(u,2)) :: calc_w0 + + ! Internal variables + + integer :: i,j,nx,ny + + ! Beginning of code + + nx=size(u,1) ; ny=size(u,2) + + ! main block loop + + do i=2,nx-1 + do j=2,ny-1 + calc_w0(i,j) = u(i,j)*(h0(i+1,j)-h0(i-1,j))/(2*dx) +v(i,j)*(h0(i,j+1)-h0(i,j-1))/(2.d0*dy) + enddo + enddo + + ! top and bottom rows + + do i=2,nx-1 + calc_w0(i,1) = u(i,1) *(h0(i+1,1) -h0(i-1,1)) /(2*dx) +v(i,1) *(h0(i,2) -h0(i,1)) /dy + calc_w0(i,ny) = u(i,ny)*(h0(i+1,ny)-h0(i-1,ny))/(2*dx) +v(i,ny)*(h0(i,ny)-h0(i,ny-1))/dy + enddo + + ! left and right columns + + do j=2,ny-1 + calc_w0(1,j) = u(1,j) *(h0(2,j) -h0(1,j)) /dx +v(1,j) *(h0(1,j+1) -h0(1,j-1)) /(2*dy) + calc_w0(nx,j) = u(nx,j)*(h0(nx,j)-h0(nx-1,j))/dx +v(nx,j)*(h0(nx,j+1)-h0(nx,j-1))/(2*dy) + enddo + + ! corners + + calc_w0(1,1) = u(1,1) *(h0(2,1) -h0(1,1)) /dx +v(1,1) *(h0(1,2) -h0(1,1)) /dy + calc_w0(1,ny) = u(1,ny) *(h0(2,ny) -h0(1,ny)) /dx +v(1,ny) *(h0(1,ny) -h0(1,ny-1)) /dy + calc_w0(nx,1) = u(nx,1) *(h0(nx,1) -h0(nx-1,1)) /dx +v(nx,1) *(h0(nx,2) -h0(nx,1)) /dy + calc_w0(nx,ny)= u(nx,ny)*(h0(nx,ny)-h0(nx-1,ny))/dx +v(nx,ny)*(h0(nx,ny)-h0(nx,ny-1))/dy + + end function calc_w0 + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + real(dp) function error_func(y) + + ! The error function + ! + ! The error function may be approximated by: + ! \[ \mathrm{erf}(y)=1-(\gamma_1 t+\gamma_2 t^2+\gamma_3 t^3)\exp(-y^2)\] + ! with + ! \[t=\frac{1}{1+\gamma_0 y}\] + ! and + ! \[\gamma_0 = 0.47047, \] + ! \[\gamma_1 = 0.3480242, \] + ! \[\gamma_2 = -0.0958798, \] + ! \[\gamma_3 = 0.7478556 \] + ! (from Abramowitz and Stegun 1965) + ! However, this doesn't seem to be right for $\mathtt{y}<0$, but ok for $\mathtt{y}\geq 0$. + ! Since the input is always $>0$, this isn't a problem here. + !*RV The value of the error function at \texttt{y}. + + implicit none + + real(dp),intent(in) :: y ! The independent variable + + real(dp) :: t + real(dp),parameter :: g0 = 0.47047d0 + real(dp),parameter :: g1 = 0.3480242d0 + real(dp),parameter :: g2 = -0.0958798d0 + real(dp),parameter :: g3 = 0.7478556d0 + + t = 1.d0 / (1.d0 + g0*y) + + error_func = 1.d0 - (g1*t + g2*t**2 + g3*t**3)*exp(-y**2) + + end function error_func + +end module glint_precip_param diff --git a/components/cism/glimmer-cism/libglint/glint_routing.F90 b/components/cism/glimmer-cism/libglint/glint_routing.F90 new file mode 100644 index 0000000000..e3131ab7a2 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_routing.F90 @@ -0,0 +1,380 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_routing.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +module glint_routing + + use glimmer_global,only: dp + + implicit none + + private + public flow_router + +contains + + subroutine flow_router(surface,input,output,mask,dx,dy) + + ! Routes water from input field to its destination, + ! according to a surface elevation field. The method used + ! is by Quinn et. al. (1991) + + !NOTE: This subroutine will *not* work for multiple tasks. + + real(dp),dimension(:,:),intent(in) :: surface ! Surface elevation + real(dp),dimension(:,:),intent(in) :: input ! Input water field + real(dp),dimension(:,:),intent(out) :: output ! Output water field + integer, dimension(:,:),intent(in) :: mask ! Masked points + real(dp), intent(in) :: dx ! $x$ grid-length + real(dp), intent(in) :: dy ! $y$ grid-length + + ! Internal variables -------------------------------------- + + integer :: nx,ny,k,nn,cx,cy,px,py,x,y + integer, dimension(:,:),allocatable :: sorted + real(dp),dimension(:,:),allocatable :: flats,surfcopy + real(dp),dimension(-1:1,-1:1) :: slopes + real(dp),dimension(-1:1,-1:1) :: dists + logical :: flag + + ! Set up grid dimensions ---------------------------------- + + nx=size(surface,1) ; ny=size(surface,2) + nn=nx*ny + + dists(-1,:)= (/4.d0, 2.d0*dx/dy, 4.d0/) + dists(0,:) = (/2.d0*dy/dx, 0.d0, 2.d0*dy/dx/) + dists(1,:) = dists(-1,:) + + ! Allocate internal arrays and copy data ------------------ + + allocate(sorted(nn,2),flats(nx,ny),surfcopy(nx,ny)) + surfcopy=surface + + ! Fill holes in data, and sort heights -------------------- + + call fillholes(surfcopy,flats,mask) + call heights_sort(surfcopy,sorted) + + ! Initialise output with input, which will then be redistributed + + output=input + + ! Begin loop over points, highest first ------------------- + + do k=nn,1,-1 + + ! Get location of current point ------------------------- + + x=sorted(k,1) + y=sorted(k,2) + + ! Reset flags and slope arrays -------------------------- + + flag=.true. + slopes=0.d0 + + ! Loop over adjacent points, and calculate slopes ------- + + do cx=-1,1,1 + do cy=-1,1,1 + ! If this is the centre point, ignore + if (cx == 0 .and. cy == 0) then + continue + else + ! Otherwise do slope calculation + px=x+cx ; py=y+cy + if (px > 0 .and. px <= nx .and. py > 0 .and. py <= ny) then + if (surfcopy(px,py)= pivot) .and. (ll < rr))) exit + rr=rr-1 + enddo + + if (ll /= rr) then + index(ll) = index(rr) + ll=ll+1 + endif + + do + if (.not.((numbers(index(ll)) <= pivot) .and. (ll < rr))) exit + ll=ll+1 + enddo + + if (ll /= rr) then + index(rr) = index(ll) + rr=rr-1 + endif + enddo + + index(ll) = pivpos + pv_int = ll + ll = l_hold + rr = r_hold + if (ll < pv_int) call q_sort_index(numbers, index,ll, pv_int-1) + if (rr > pv_int) call q_sort_index(numbers, index,pv_int+1, rr) + + end subroutine q_sort_index + +end module glint_routing + diff --git a/components/cism/glimmer-cism/libglint/glint_timestep.F90 b/components/cism/glimmer-cism/libglint/glint_timestep.F90 new file mode 100644 index 0000000000..118120e03b --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_timestep.F90 @@ -0,0 +1,857 @@ +#ifdef CPRIBM +@PROCESS ALIAS_SIZE(107374182) +#endif +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_timestep.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glint_timestep + !> timestep of a GLINT instance + + use glint_type + use glad_constants + use glimmer_global, only: dp + implicit none + + private + public glint_i_tstep, glint_i_tstep_gcm + +contains + + subroutine glint_i_tstep(time, instance, & + g_orog_out, g_albedo, & + g_ice_frac, g_veg_frac, & + g_snowice_frac, g_snowveg_frac, & + g_snow_depth, & + g_water_in, g_water_out, & + t_win, t_wout, & + ice_vol, out_f, & + ice_tstep) + + !> Performs time-step of an ice model instance. + !> Note that input quantities here are accumulated/average totals since the last call. + !> Global output arrays are only valid on the main task. + ! + + use glimmer_paramets + use glimmer_physcon, only: rhow,rhoi + use glimmer_log + use glimmer_coordinates, only: coordsystem_allocate + use glide + use glissade + use glide_io + use glint_upscale, only: glint_upscaling + use glint_mbal_coupling + use glint_io + use glint_mbal_io + use glint_routing + use glide_diagnostics + use parallel, only: tasks, main_task + + implicit none + + ! ------------------------------------------------------------------------ + ! Arguments + ! ------------------------------------------------------------------------ + + integer, intent(in) :: time !> Current time in hours + type(glint_instance), intent(inout) :: instance !> Model instance + real(dp),dimension(:,:),intent(out) :: g_orog_out !> Output orography (m) + real(dp),dimension(:,:),intent(out) :: g_albedo !> Output surface albedo + real(dp),dimension(:,:),intent(out) :: g_ice_frac !> Output ice fraction + real(dp),dimension(:,:),intent(out) :: g_veg_frac !> Output veg fraction + real(dp),dimension(:,:),intent(out) :: g_snowice_frac !> Output snow-ice fraction + real(dp),dimension(:,:),intent(out) :: g_snowveg_frac !> Output snow-veg fraction + real(dp),dimension(:,:),intent(out) :: g_snow_depth !> Output snow depth (m) + real(dp),dimension(:,:),intent(out) :: g_water_in !> Input water flux (m) + real(dp),dimension(:,:),intent(out) :: g_water_out !> Output water flux (m) + real(dp), intent(out) :: t_win !> Total water input (kg) + real(dp), intent(out) :: t_wout !> Total water output (kg) + real(dp), intent(out) :: ice_vol !> Output ice volume (m$^3$) + type(output_flags), intent(in) :: out_f !> Flags to tell us whether to do output + logical, intent(out) :: ice_tstep !> Set if we have done an ice time step + + ! ------------------------------------------------------------------------ + ! Internal variables + ! ------------------------------------------------------------------------ + + real(dp),dimension(:,:),pointer :: upscale_temp => null() ! temporary array for upscaling + real(dp),dimension(:,:),pointer :: routing_temp => null() ! temporary array for flow routing + real(dp),dimension(:,:),pointer :: accum_temp => null() ! temporary array for accumulation + real(dp),dimension(:,:),pointer :: ablat_temp => null() ! temporary array for ablation + integer, dimension(:,:),pointer :: fudge_mask => null() ! temporary array for fudging + real(dp),dimension(:,:),pointer :: thck_temp => null() ! temporary array for volume calcs + real(dp),dimension(:,:),pointer :: calve_temp => null() ! temporary array for calving flux + real(dp) :: start_volume,end_volume,flux_fudge ! note: only valid for single-task runs + + integer :: i, il, jl + + logical :: gcm_smb ! true if getting sfc mass balance from a GCM + + ice_tstep = .false. + + ! Assume we always need this, as it's too complicated to work out when we do and don't + + call coordsystem_allocate(instance%lgrid, thck_temp) + call coordsystem_allocate(instance%lgrid, calve_temp) + + ! ------------------------------------------------------------------------ + ! Sort out some local orography and remove bathymetry. This relies on the + ! point 1,1 being underwater. However, it's a better method than just + ! setting all points < 0.0 to zero + ! ------------------------------------------------------------------------ + + call glide_get_usurf(instance%model, instance%local_orog) + call glint_remove_bath(instance%local_orog,1,1) + + ! ------------------------------------------------------------------------ + ! Adjust the surface temperatures using the lapse-rate, by reducing to + ! sea-level and then back up to high-res orography + ! ------------------------------------------------------------------------ + + call glint_lapserate(instance%artm, real(instance%global_orog,dp), real(-instance%data_lapse_rate,dp)) + call glint_lapserate(instance%artm, real(instance%local_orog, dp), real( instance%lapse_rate,dp)) + + ! Process the precipitation field if necessary --------------------------- + ! and convert from mm/s to m/s + + call glint_calc_precip(instance) + + ! Get ice thickness ---------------------------------------- + + call glide_get_thk(instance%model,thck_temp) + + ! Accumulate mass balance fields ----------------------------------------- + + call glint_accumulate_mbal(instance%mbal_accum, time, instance%artm, instance%arng, instance%prcp, & + instance%snowd, instance%siced, instance%xwind, instance%ywind, & + instance%local_orog, real(thck_temp,dp), instance%humid, & + instance%swdown, instance%lwdown, instance%airpress) + + ! Initialise water budget quantities to zero. These will be over-ridden if + ! there's an ice-model time-step + + t_win = 0.d0 ; t_wout = 0.d0 + g_water_out = 0.d0 ; g_water_in = 0.d0 + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) ' ' + write(stdout,*) 'In glint_i_tstep, time =', time + write(stdout,*) 'next_time =', instance%next_time + write(stdout,*) 'Check for ice dynamics timestep' + write(stdout,*) 'start_time =', instance%mbal_accum%start_time + write(stdout,*) 'mbal_step =', instance%mbal_tstep + write(stdout,*) 'mbal_accum_time =', instance%mbal_accum_time + write(stdout,*) 'time-start_time+mbal_tstep =', time - instance%mbal_accum%start_time + instance%mbal_tstep + write(stdout,*) 'ice_tstep =', instance%ice_tstep + write(stdout,*) 'n_icetstep =', instance%n_icetstep + end if + + ! ------------------------------------------------------------------------ + ! ICE TIMESTEP begins HERE *********************************************** + ! ------------------------------------------------------------------------ + + if (time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time) then + + if (instance%mbal_accum_time < instance%ice_tstep) then + instance%next_time = instance%next_time + instance%ice_tstep - instance%mbal_tstep + end if + + ice_tstep = .true. + + ! Prepare arrays for water budgeting + + if (out_f%water_out .or. out_f%total_wout .or. out_f%water_in .or. out_f%total_win) then + call coordsystem_allocate(instance%lgrid, accum_temp) + call coordsystem_allocate(instance%lgrid, ablat_temp) + accum_temp = 0.d0 + ablat_temp = 0.d0 + end if + + ! Calculate the initial ice volume (scaled and converted to water equivalent) + ! start_volume is only valid for single-task runs (this is checked in the place + ! where it is used) + + call glide_get_thk(instance%model, thck_temp) + thck_temp = thck_temp * rhoi/rhow + start_volume = sum(thck_temp) + + ! --------------------------------------------------------------------- + ! Timestepping for the dynamic ice sheet model + ! --------------------------------------------------------------------- + + do i = 1, instance%n_icetstep + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) 'Ice sheet timestep, iteration =', i + end if + + ! Calculate the initial ice volume (scaled and converted to water equivalent) + call glide_get_thk(instance%model,thck_temp) + thck_temp = thck_temp * rhoi/rhow + + ! Get latest upper-surface elevation (needed for masking) + call glide_get_usurf(instance%model, instance%local_orog) + + call glint_remove_bath(instance%local_orog,1,1) + + ! Get the average mass-balance, as m water/year + call glint_average_mbal(instance%mbal_accum, & + instance%artm, instance%prcp, & + instance%ablt, instance%acab, & + instance%snowd, instance%siced, & + instance%mbal_accum_time) + + ! Mask out non-accumulation in ice-free areas + + where(thck_temp <= 0.d0 .and. instance%acab < 0.d0) + instance%acab = 0.d0 + instance%ablt = instance%prcp + end where + + ! Set acab to zero for ocean cells (bed below sea level, no ice present) + + where (GLIDE_IS_OCEAN(instance%model%geometry%thkmask)) + instance%acab = 0.d0 + endwhere + + ! Put climate inputs in the appropriate places, with conversion ---------- + + ! Note on units: + ! For this subroutine, input acab is in m/yr; this value is divided + ! by scale_acab = scyr*thk0/tim0 and copied to data%climate%acab. + ! Input artm is in deg C; this value is copied to data%climate%artm (no unit conversion). + + call glide_set_acab(instance%model, instance%acab * rhow/rhoi) + call glide_set_artm(instance%model, instance%artm) + + ! This will work only for single-processor runs + if (GLC_DEBUG .and. tasks==1) then + il = instance%model%numerics%idiag + jl = instance%model%numerics%jdiag + write (stdout,*) ' ' + write (stdout,*) 'After glide_set_acab, glide_set_artm: i, j =', il, jl + write (stdout,*) 'acab (m/y), artm (C) =', instance%acab(il,jl)*rhow/rhoi, instance%artm(il,jl) + end if + + ! Adjust glint acab and ablt for output + + where (instance%acab < -thck_temp .and. thck_temp > 0.d0) + instance%acab = -thck_temp + instance%ablt = thck_temp + end where + + instance%glide_time = instance%glide_time + instance%model%numerics%tinc + + ! call the dynamic ice sheet model (provided the ice is allowed to evolve) + + if (instance%evolve_ice == EVOLVE_ICE_TRUE) then + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then + + call glide_tstep_p1(instance%model,instance%glide_time) + + call glide_tstep_p2(instance%model) + + call glide_tstep_p3(instance%model) + + else ! glam/glissade dycore + + call glissade_tstep(instance%model,instance%glide_time) + + endif + + endif ! evolve_ice + + ! Add the calved ice to the ablation field + + call glide_get_calving(instance%model, calve_temp) + calve_temp = calve_temp * rhoi/rhow + + instance%ablt = instance%ablt + calve_temp/instance%model%numerics%tinc + instance%acab = instance%acab - calve_temp/instance%model%numerics%tinc + + ! Accumulate for water-budgeting + if (out_f%water_out .or. out_f%total_wout .or. out_f%water_in .or. out_f%total_win) then + accum_temp = accum_temp + instance%prcp*instance%model%numerics%tinc + ablat_temp = ablat_temp + instance%ablt*instance%model%numerics%tinc + endif + + ! write ice sheet diagnostics at specified interval + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! write netCDf output + + call glide_io_writeall(instance%model,instance%model) + call glint_io_writeall(instance,instance%model) + + end do ! n_icestep + + ! Calculate flux fudge factor -------------------------------------------- + + if (out_f%water_out .or. out_f%total_wout .or. out_f%water_in .or. out_f%total_win) then + + ! WJS (1-15-13): I am pretty sure (but not positive) that the stuff in this + ! conditional will only work right with a single task + if (tasks > 1) then + call write_log('The sums in the computation of a flux fudge factor only work with a single task', & + GM_FATAL, __FILE__, __LINE__) + end if + + call coordsystem_allocate(instance%lgrid,fudge_mask) + + call glide_get_thk(instance%model,thck_temp) + end_volume = sum(thck_temp) + + where (thck_temp > 0.d0) + fudge_mask = 1 + elsewhere + fudge_mask = 0 + endwhere + + flux_fudge = (start_volume + sum(accum_temp) - sum(ablat_temp) - end_volume) / sum(fudge_mask) + + ! Apply fudge_factor + + where(thck_temp > 0.d0) + ablat_temp = ablat_temp + flux_fudge + endwhere + + deallocate(fudge_mask) + fudge_mask => null() + + endif + + ! Upscale water flux fields ---------------------------------------------- + ! First water input (i.e. mass balance + ablation) + + if (out_f%water_in) then + + call coordsystem_allocate(instance%lgrid, upscale_temp) + + where (thck_temp > 0.d0) + upscale_temp = accum_temp + elsewhere + upscale_temp = 0.d0 + endwhere + + call local_to_global_avg(instance%ups, & + upscale_temp, & + g_water_in, & + instance%out_mask) + deallocate(upscale_temp) + upscale_temp => null() + endif + + ! Now water output (i.e. ablation) - and do routing + + if (out_f%water_out) then + + ! WJS (1-15-13): The flow_router routine (called bolew) currently seems to + ! assume that it's working on the full (non-decomposed) domain. I'm not sure + ! what the best way is to fix this, so for now we only allow this code to be + ! executed if tasks==1. + if (tasks > 1) then + call write_log('water_out computation assumes a single task', & + GM_FATAL, __FILE__, __LINE__) + end if + + call coordsystem_allocate(instance%lgrid, upscale_temp) + call coordsystem_allocate(instance%lgrid, routing_temp) + + where (thck_temp > 0.d0) + upscale_temp = ablat_temp + elsewhere + upscale_temp = 0.d0 + endwhere + + call glide_get_usurf(instance%model, instance%local_orog) + call flow_router(instance%local_orog, & + upscale_temp, & + routing_temp, & + instance%out_mask, & + real(instance%lgrid%delta%pt(1),dp), & + real(instance%lgrid%delta%pt(2),dp)) + + call local_to_global_avg(instance%ups, & + routing_temp, & + g_water_out, & + instance%out_mask) + + deallocate(upscale_temp,routing_temp) + upscale_temp => null() + routing_temp => null() + + endif + + ! Sum water fluxes and convert if necessary ------------------------------ + + if (out_f%total_win) then + if (tasks > 1) call write_log('t_win sum assumes a single task', & + GM_FATAL, __FILE__, __LINE__) + + t_win = sum(accum_temp) * instance%lgrid%delta%pt(1)* & + instance%lgrid%delta%pt(2) + endif + + if (out_f%total_wout) then + if (tasks > 1) call write_log('t_wout sum assumes a single task', & + GM_FATAL, __FILE__, __LINE__) + + t_wout = sum(ablat_temp) * instance%lgrid%delta%pt(1)* & + instance%lgrid%delta%pt(2) + endif + + end if ! time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time + + ! Output instantaneous values + + call glint_mbal_io_writeall(instance, instance%model, & + outfiles = instance%out_first, & + time = time*hours2years) + + ! ------------------------------------------------------------------------ + ! Upscaling of output + ! ------------------------------------------------------------------------ + + ! We now upscale all fields at once... + + call glint_upscaling(instance, g_orog_out, g_albedo, g_ice_frac, g_veg_frac, & + g_snowice_frac, g_snowveg_frac, g_snow_depth) + + ! Calculate ice volume --------------------------------------------------- + + if (out_f%ice_vol) then + if (tasks > 1) call write_log('ice_vol sum assumes a single task', & + GM_FATAL, __FILE__, __LINE__) + + call glide_get_thk(instance%model, thck_temp) + ice_vol = sum(thck_temp) * instance%lgrid%delta%pt(1)* & + instance%lgrid%delta%pt(2) + endif + + ! Tidy up ---------------------------------------------------------------- + + if (associated(accum_temp)) then + deallocate(accum_temp) + accum_temp => null() + end if + + if (associated(ablat_temp)) then + deallocate(ablat_temp) + ablat_temp => null() + end if + + if (associated(calve_temp)) then + deallocate(calve_temp) + calve_temp => null() + end if + + if (associated(thck_temp)) then + deallocate(thck_temp) + thck_temp => null() + endif + + end subroutine glint_i_tstep + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_tstep_gcm(time, instance, & + ice_tstep) + + ! Performs time-step of an ice model instance. + ! Input quantities here are accumulated/average totals since the last call. + ! Global output arrays are only valid on the main task. + ! + use glimmer_paramets + use glimmer_physcon, only: rhow, rhoi + use glimmer_log + use glimmer_coordinates, only: coordsystem_allocate + use glide + use glissade + use glide_io + use glint_downscale, only: glint_accumulate_input_gcm, glint_average_input_gcm + use glint_upscale, only: glint_accumulate_output_gcm + use glint_io + use glint_mbal_io + use glide_diagnostics + use parallel, only: tasks, main_task, this_rank + + implicit none + + ! ------------------------------------------------------------------------ + ! Arguments + ! ------------------------------------------------------------------------ + + integer, intent(in) :: time ! Current time in hours + type(glint_instance), intent(inout) :: instance ! Model instance + logical, intent(out) :: ice_tstep ! Set if we have done an ice time step + + ! ------------------------------------------------------------------------ + ! Internal variables + ! ------------------------------------------------------------------------ + + real(dp),dimension(:,:),pointer :: thck_temp => null() ! temporary array for volume calcs + + integer :: i, il, jl + + if (GLC_DEBUG .and. main_task) then + print*, 'In glint_i_tstep_gcm' + endif + + ice_tstep = .false. + + call coordsystem_allocate(instance%lgrid, thck_temp) + + ! ------------------------------------------------------------------------ + ! Sort out some local orography and remove bathymetry. This relies on the + ! point 1,1 being underwater. However, it's a better method than just + ! setting all points < 0.0 to zero + ! ------------------------------------------------------------------------ + + !Note: Call to glint_remove_bath is commented out for now. Not sure if it is needed in GCM runs. +!! call glide_get_usurf(instance%model, instance%local_orog) +!! call glint_remove_bath(instance%local_orog,1,1) + + ! Get ice thickness ---------------------------------------- + + call glide_get_thk(instance%model,thck_temp) + + ! Accumulate Glide input fields, acab and artm + ! Note: At this point, instance%acab has units of m + ! Upon averaging (in glint_mbal_gcm), units are converted to m/yr + + call glint_accumulate_input_gcm(instance%mbal_accum, time, & + instance%acab, instance%artm) + + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) ' ' + write(stdout,*) 'In glint_i_tstep_gcm, time =', time + write(stdout,*) 'next_time =', instance%next_time + write(stdout,*) 'Check for ice dynamics timestep' + write(stdout,*) 'time =', time + write(stdout,*) 'start_time =', instance%mbal_accum%start_time + write(stdout,*) 'mbal_step =', instance%mbal_tstep + write(stdout,*) 'mbal_accum_time =', instance%mbal_accum_time + write(stdout,*) 'time-start_time+mbal_tstep =', time - instance%mbal_accum%start_time + instance%mbal_tstep + write(stdout,*) 'ice_tstep =', instance%ice_tstep + write(stdout,*) 'n_icetstep =', instance%n_icetstep + end if + + ! ------------------------------------------------------------------------ + ! ICE TIMESTEP begins HERE *********************************************** + ! ------------------------------------------------------------------------ + + if (time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time) then + + if (instance%mbal_accum_time < instance%ice_tstep) then + instance%next_time = instance%next_time + instance%ice_tstep - instance%mbal_tstep + end if + + ice_tstep = .true. + + ! --------------------------------------------------------------------- + ! Timestepping for ice sheet model + ! --------------------------------------------------------------------- + + do i = 1, instance%n_icetstep + + if (GLC_DEBUG .and. main_task) then + write (stdout,*) 'Ice sheet timestep, iteration =', i + end if + + ! Get average values of acab and artm during mbal_accum_time + ! instance%acab has units of m/yr w.e. after averaging + + call glint_average_input_gcm(instance%mbal_accum, instance%mbal_accum_time, & + instance%acab, instance%artm) + + ! Calculate the initial ice volume (scaled and converted to water equivalent) + call glide_get_thk(instance%model,thck_temp) + thck_temp = thck_temp * rhoi/rhow + + !Note: Call to glint_remove_bath is commented out for now. Not sure if it is needed in GCM runs. + ! Get latest upper-surface elevation (needed for masking) +!! call glide_get_usurf(instance%model, instance%local_orog) +!! call glint_remove_bath(instance%local_orog,1,1) + + ! Mask out non-accumulation in ice-free areas + + where(thck_temp <= 0.d0 .and. instance%acab < 0.d0) + instance%acab = 0.d0 + end where + + ! Set acab to zero for ocean cells (bed below sea level, no ice present) + + where (GLIDE_IS_OCEAN(instance%model%geometry%thkmask)) + instance%acab = 0.d0 + endwhere + + ! Put climate inputs in the appropriate places, with conversion ---------- + + ! Note on units: + ! For subroutine glide_set_acab, input acab is in m/yr ice; this value is multiplied + ! by tim0/(scyr*thk0) and copied to data%climate%acab. + ! Input artm is in deg C; this value is copied to data%climate%artm (no unit conversion). + + !TODO - It is confusing to have units of m/yr w.e. for instance%acab, compared to units m/yr ice for Glide. + ! Change to use the same units consistently? E.g., switch to w.e. in Glide + + call glide_set_acab(instance%model, instance%acab * rhow/rhoi) + call glide_set_artm(instance%model, instance%artm) + + ! This will work only for single-processor runs + if (GLC_DEBUG .and. tasks==1) then + il = instance%model%numerics%idiag + jl = instance%model%numerics%jdiag + write (stdout,*) ' ' + write (stdout,*) 'After glide_set_acab, glide_set_artm: i, j =', il, jl + write (stdout,*) 'acab (m/y), artm (C) =', instance%acab(il,jl)*rhow/rhoi, instance%artm(il,jl) + end if + + ! Adjust glint acab and ablt for output + + where (instance%acab < -thck_temp .and. thck_temp > 0.d0) + instance%acab = -thck_temp + end where + + instance%glide_time = instance%glide_time + instance%model%numerics%tinc + + ! call the dynamic ice sheet model (provided the ice is allowed to evolve) + + if (instance%evolve_ice == EVOLVE_ICE_TRUE) then + + if (instance%model%options%whichdycore == DYCORE_GLIDE) then + + call glide_tstep_p1(instance%model, instance%glide_time) + + call glide_tstep_p2(instance%model) + + call glide_tstep_p3(instance%model) + + else ! glam/glissade dycore + +!WHL - debug + print*, 'call glissade_tstep' + + call glissade_tstep(instance%model, instance%glide_time) + + endif + + endif ! evolve_ice + +!WHL - debug + print*, 'write diagnostics' + + ! write ice sheet diagnostics at specified interval (model%numerics%dt_diag) + + call glide_write_diagnostics(instance%model, & + instance%model%numerics%time, & + tstep_count = instance%model%numerics%timecounter) + + ! write netCDF output + + call glide_io_writeall(instance%model,instance%model) + call glint_io_writeall(instance,instance%model) + + ! Accumulate Glide output fields to be sent to GCM + + call glint_accumulate_output_gcm(instance%model, & + instance%av_count_output, & + instance%new_tavg_output, & + instance%rofi_tavg, & + instance%rofl_tavg, & + instance%hflx_tavg ) + + end do ! instance%n_icetstep + + end if ! time - instance%mbal_accum%start_time + instance%mbal_tstep == instance%mbal_accum_time + +!WHL - debug + print*, 'output instantaneous values' + + ! Output instantaneous values + + call glint_mbal_io_writeall(instance, instance%model, & + outfiles = instance%out_first, & + time = time*hours2years) + + ! Deallocate + + if (associated(thck_temp)) then + deallocate(thck_temp) + thck_temp => null() + endif + + if (GLC_DEBUG .and. main_task) then + write(stdout,*) 'Done in glint_i_tstep_gcm' + endif + + end subroutine glint_i_tstep_gcm + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Rewrite glint_remove_bath to support multiple tasks? + ! Calls to this subroutine are currently commented out. + + subroutine glint_remove_bath(orog,x,y) + + ! Sets ocean areas to zero height, working recursively from + ! a known ocean point. + + use glimmer_log + use parallel, only : tasks + + real(dp),dimension(:,:),intent(inout) :: orog !> Orography --- used for input and output + integer, intent(in) :: x,y !> Location of starting point (index) + + integer :: nx,ny + + ! Currently, this routine is called assuming point 1,1 is ocean... this won't be true + ! when running on multiple processors, with a distributed grid + ! This can't be made a fatal error, because this is currently called even if we have + ! more than one task... the hope is just that the returned data aren't needed in CESM. + if (tasks > 1) then + call write_log('Use of glint_remove_bath currently assumes the use of only one task', & + GM_WARNING, __FILE__, __LINE__) + end if + + nx=size(orog,1) ; ny=size(orog,2) + + if (orog(x,y) < 0.d0) orog(x,y) = 0.d0 + call glint_find_bath(orog,x,y,nx,ny) + + end subroutine glint_remove_bath + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + recursive subroutine glint_find_bath(orog,x,y,nx,ny) + + !> Recursive subroutine called by {\tt glimmer\_remove\_bath}. + + real(dp),dimension(:,:),intent(inout) :: orog !> Orography --- used for input and output + integer, intent(in) :: x,y !> Starting point + integer, intent(in) :: nx,ny !> Size of array {\tt orography} + + integer,dimension(4) :: xi = (/ -1,1,0,0 /) + integer,dimension(4) :: yi = (/ 0,0,-1,1 /) + integer :: ns = 4 + integer :: i + + do i=1,ns + if (x+xi(i) <= nx .and. x+xi(i) > 0 .and. & + y+yi(i) <= ny .and. y+yi(i) > 0) then + if (orog(x+xi(i),y+yi(i)) < 0.d0) then + orog(x+xi(i),y+yi(i)) = 0.d0 + call glint_find_bath(orog,x+xi(i),y+yi(i),nx,ny) + endif + endif + enddo + + end subroutine glint_find_bath + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!WHL - This used to be called glint_lapserate_dp + + subroutine glint_lapserate(temp,topo,lr) + + !> Corrects the temperature field + !> for height, using a constant lapse rate. + !> + !> This is the double-precision version, aliased as \texttt{glimmer\_lapserate}. + + implicit none + + real(dp),dimension(:,:), intent(inout) :: temp !> temperature at sea-level in $^{\circ}$C + !> used for input and output + real(dp),dimension(:,:), intent(in) :: topo !> topography field (m above msl) + real(dp), intent(in) :: lr !> Lapse rate ($^{\circ}\mathrm{C\,km}^{-1}$). + !> + !> NB: the lapse rate is positive for + !> falling temp with height\ldots + + temp = temp-(lr*topo/1000.d0) ! The lapse rate calculation. + + end subroutine glint_lapserate + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!WHL - Removed subroutine glint_lapserate_sp + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_calc_precip(instance) + + use glint_precip_param + use glimmer_log + + !> Process precip if necessary + + type(glint_instance) :: instance + + select case (instance%whichprecip) + + case(PRECIP_STANDARD) + ! Do nothing to the precip field + + case(PRECIP_RL) + ! Use the Roe/Lindzen parameterisation + call glint_precip(instance%prcp, & + instance%xwind, & + instance%ywind, & + instance%artm, & + instance%local_orog, & + real(instance%lgrid%delta%pt(1),dp), & + real(instance%lgrid%delta%pt(2),dp), & + fixed_a=.true.) + + case default + + call write_log('Invalid value of whichprecip',GM_FATAL,__FILE__,__LINE__) + + end select + + ! Convert from mm/s to m/s - very important! + + instance%prcp = instance%prcp * 1.d-3 + + end subroutine glint_calc_precip + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +end module glint_timestep + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_type.F90 b/components/cism/glimmer-cism/libglint/glint_type.F90 new file mode 100644 index 0000000000..d9d25b45c8 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_type.F90 @@ -0,0 +1,563 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_type.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCO outfile%nc +#define NCI infile%nc + +module glint_type + + !> contains type definitions for GLINT + + use glimmer_global, only: dp + use glint_interp + use glide_types + use glint_mbal_coupling, only: glint_mbc, mbal_has_snow_model + use glint_mbal + + implicit none + + ! Constants that describe the options available + + ! basic Glint options + + integer, parameter :: EVOLVE_ICE_FALSE = 0 ! do not let the ice sheet evolve + ! (hold the ice state fixed at initial condition) + integer, parameter :: EVOLVE_ICE_TRUE = 1 ! let the ice sheet evolve + +! These are defined in glint_mbal to avoid a circular dependency +! integer, parameter :: MASS_BALANCE_GCM = 0 ! receive mass balance from global climate model +! integer, parameter :: MASS_BALANCE_PDD = 1 ! compute mass balance using positive-degree-day scheme +! integer, parameter :: MASS_BALANCE_ACCUM = 2 ! accumulation only +! integer, parameter :: MASS_BALANCE_EBM = 3 ! compute mass balance using energy-balance model +! integer, parameter :: MASS_BALANCE_DAILY_PDD = 4 ! compute mass balance using daily PDD model +! Note: Option 3 is not presently supported. + + integer, parameter :: PRECIP_STANDARD = 1 ! use large-scale precip field as is + integer, parameter :: PRECIP_RL = 2 ! use Roe-Lindzen paramterization + + integer, parameter :: ZERO_GCM_FLUXES_FALSE = 0 ! send true fluxes to the GCM + integer, parameter :: ZERO_GCM_FLUXES_TRUE = 1 ! zero out all fluxes sent to the GCM + + !TODO - Add other Glint options here to avoid hardwiring of case numbers? + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - glint_instance includes information that is not needed if the SMB is received from a GCM. + ! Maybe we should create a new derived type (glint_instance_gcm?) without the extra information. + + type glint_instance + + !> Derived type holding information about ice model instance. + !> Note that variables used for downscaling & upscaling are only valid on the main task, + !> since all downscaling and upscaling is done there. + + type(coordsystem_type) :: lgrid !> Local grid for interfacing with glide (grid on this task) + !> (WJS: Note that origin may be incorrect with multiple tasks; + !> as far as I can tell, this isn't currently a problem) + type(coordsystem_type) :: lgrid_fulldomain !> Local grid on the full domain (across all tasks), + !> used for downscaling & upscaling + !> (ONLY VALID ON MAIN TASK) + type(downscale) :: downs !> Downscaling parameters. + !> (ONLY VALID ON MAIN TASK) + type(upscale) :: ups !> Upscaling parameters + !> (ONLY VALID ON MAIN TASK) + type(upscale) :: ups_orog !> Upscaling parameters for orography (to cope + !> with need to convert to spectral form). + !> (ONLY VALID ON MAIN TASK) + type(glide_global_type) :: model !> The instance and all its arrays. + character(fname_length) :: paramfile !> The name of the configuration file. + integer :: ice_tstep !> Ice timestep in hours + integer :: mbal_tstep !> Mass-balance timestep in hours + integer :: mbal_accum_time !> Accumulation time for mass-balance (hours) + !> (defaults to ice time-step) + integer :: ice_tstep_multiply=1 !> Ice time multiplier (non-dimensional) + integer :: n_icetstep !> Number of ice time-steps per mass-balance accumulation + real(dp) :: glide_time !> Time as seen by glide (years) + integer :: next_time !> The next time we expect to be called (hours) + + ! Climate inputs from global model -------------------------- + + real(dp),dimension(:,:),pointer :: artm => null() !> Annual mean air temperature + real(dp),dimension(:,:),pointer :: arng => null() !> Annual air temperature half-range + real(dp),dimension(:,:),pointer :: prcp => null() !> Precipitation (mm or m) + real(dp),dimension(:,:),pointer :: snowd => null() !> Snow depth (m) + real(dp),dimension(:,:),pointer :: siced => null() !> Superimposed ice depth (m) + real(dp),dimension(:,:),pointer :: xwind => null() !> $x$-component of surface winds (m/s) + real(dp),dimension(:,:),pointer :: ywind => null() !> $y$-component of surface winds (m/s) + real(dp),dimension(:,:),pointer :: humid => null() !> Surface humidity (%) + real(dp),dimension(:,:),pointer :: lwdown => null() !> Downwelling longwave (W/m^2) + real(dp),dimension(:,:),pointer :: swdown => null() !> Downwelling shortwave (W/m^2) + real(dp),dimension(:,:),pointer :: airpress => null() !> Surface air pressure (Pa) + real(dp),dimension(:,:),pointer :: global_orog => null() !> Global orography (m) + real(dp),dimension(:,:),pointer :: local_orog => null() !> Local orography (m) + + ! Locally calculated climate/mass-balance fields ------------ + + real(dp),dimension(:,:),pointer :: ablt => null() !> Annual ablation (m/y water equiv) + real(dp),dimension(:,:),pointer :: acab => null() !> Annual mass balance (m/y water equiv) + + ! Arrays to accumulate mass-balance quantities -------------- + + type(glint_mbc) :: mbal_accum + + ! Fractional coverage information --------------------------- + + real(dp) ,dimension(:,:),pointer :: frac_coverage => null() + !> Fractional coverage of each global gridbox by the projected grid. + !> (ONLY VALID ON MAIN TASK) + + real(dp) ,dimension(:,:),pointer :: frac_cov_orog => null() + !> Fractional coverage of each global gridbox by the projected grid (orography). + !> (ONLY VALID ON MAIN TASK) + + ! Output masking -------------------------------------------- + + integer, dimension(:,:),pointer :: out_mask => null() + + !> Array indicating whether a point should be considered or ignored + !> when upscaling data for output. 1 means use, 0 means ignore. + + ! Climate options ------------------------------------------- + + integer :: evolve_ice = 1 + + !> Whether the ice sheet can evolve: + !> \begin{description} + !> \item[0] The ice sheet cannot evolve; hold fixed at initial state + !> \item[1] The ice sheet can evolve + + integer :: whichacab = 1 + + !> Which mass-balance scheme: + !> \begin{description} + !> \item[0] Receive surface mass balance from climate model + !> \item[1] PDD mass-balance model + !> \item[2] Accumulation only + !> \item[3] RAPID energy balance model + !> \item[4] daily PDD mass-balance model + !> \end{description} + + integer :: whichprecip = 1 + + !> Source of precipitation: + !> \begin{description} + !> \item[1] Use large-scale precip as is + !> \item[2] Use parameterization of Roe and Lindzen + !> \end{description} + + logical :: test_coupling = .false. + + integer :: use_mpint = 0 + + !> Flag to control if mean-preserving interpolation is used + + integer :: zero_gcm_fluxes = ZERO_GCM_FLUXES_FALSE + + !> Whether to zero out the fluxes (e.g., calving flux) sent to the GCM + !> \begin{description} + !> \item[0] send true fluxes to the GCM + !> \item[1] zero out all fluxes sent to the GCM + !> \end{description} + + ! Climate parameters ---------------------------------------------------------- + + real(dp) :: ice_albedo = 0.4d0 !> Ice albedo. (fraction) + real(dp) :: lapse_rate = 8.d0 !> Uniform lapse rate in deg C/km + !> (N.B. This should be \emph{positive} for temperature falling with height!) + real(dp) :: data_lapse_rate = 8.d0 !> Implied lapse rate in large-scale data (used for + !> tuning). Set equal to lapse\_rate if not supplied. + + ! Counter for averaging temperature input -------------------------------------- + + integer :: av_count = 0 !> Counter for averaging temperature input + + !WHL - added these for upscaling + ! Counters and fields for averaging dycore output + + integer :: av_count_output = 0 ! step counter + logical :: new_tavg_output = .true. ! if true, start new averaging + real(dp), dimension(:,:), pointer :: hflx_tavg => null() ! conductive heat flux at top surface (W m-2) + real(dp), dimension(:,:), pointer :: rofi_tavg => null() ! solid ice runoff (kg m-2 s-1) + real(dp), dimension(:,:), pointer :: rofl_tavg => null() ! liquid runoff from basal/interior melting (kg m-2 s-1) + + ! Pointers to file input and output + + type(glimmer_nc_output),pointer :: out_first => null() !> first element of linked list defining netCDF outputs + type(glimmer_nc_input), pointer :: in_first => null() !> first element of linked list defining netCDF inputs + + end type glint_instance + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + type output_flags + !> A derived type used internally to communicate the outputs which need + !> to be upscaled, thus avoiding unnecessary calculation + + logical :: orog !> Set if we need to upscale the orography + logical :: albedo !> Set if we need to upscale the albedo + logical :: ice_frac !> Set if we need to upscale the ice fraction + logical :: veg_frac !> Set if we need to upscale the veg fraction + logical :: snowice_frac !> Set if we need to upscale the snow-covered ice fraction + logical :: snowveg_frac !> Set if we need to upscale the snow-covered veg fraction + logical :: snow_depth !> Set if we need to upscale the snow depth + logical :: water_in !> Set if we need to upscale the input water flux + logical :: water_out !> Set if we need to upscale the output water flux + logical :: total_win !> Set if we need to sum the total water taken up by ice sheet + logical :: total_wout !> Set if we need to sum the total ablation by the ice sheet + logical :: ice_vol !> Set if we need to calculate the total ice volume + end type output_flags + + !TODO - These diagnostic points are grid-specific. For GCM coupling, they should be set based on the global GCM grid. + + ! diagnostic points on global grid, useful for debugging + + integer, parameter :: iglint_global = 56 ! SW Greenland point on 64 x 32 glint_example global grid (mostly ice covered) +! integer, parameter :: iglint_global = 57 ! SW Greenland point on 64 x 32 glint_example global grid (totally ice covered) + integer, parameter :: jglint_global = 4 ! j increases from north to south + +contains + + subroutine glint_i_allocate(instance,nxg,nyg,nxgo,nygo) + + !> Allocate top-level arrays in the model instance, and ice model arrays. + + implicit none + + type(glint_instance),intent(inout) :: instance !> Instance whose elements are to be allocated. + integer, intent(in) :: nxg !> Longitudinal size of global grid (grid-points). + integer, intent(in) :: nyg !> Latitudinal size of global grid (grid-points). + integer, intent(in) :: nxgo !> Longitudinal size of global orog grid (grid-points). + integer, intent(in) :: nygo !> Latitudinal size of global orog grid (grid-points). + + integer ewn,nsn + + ewn=get_ewn(instance%model) + nsn=get_nsn(instance%model) + + ! First deallocate if necessary + ! Downscaled global arrays + + if (associated(instance%artm)) deallocate(instance%artm) + if (associated(instance%arng)) deallocate(instance%arng) + if (associated(instance%prcp)) deallocate(instance%prcp) + if (associated(instance%snowd)) deallocate(instance%snowd) + if (associated(instance%siced)) deallocate(instance%siced) + if (associated(instance%xwind)) deallocate(instance%xwind) + if (associated(instance%ywind)) deallocate(instance%ywind) + if (associated(instance%humid)) deallocate(instance%humid) + if (associated(instance%lwdown)) deallocate(instance%lwdown) + if (associated(instance%swdown)) deallocate(instance%swdown) + if (associated(instance%airpress)) deallocate(instance%airpress) + if (associated(instance%global_orog)) deallocate(instance%global_orog) + if (associated(instance%local_orog)) deallocate(instance%local_orog) + + ! Local climate arrays + + if (associated(instance%ablt)) deallocate(instance%ablt) + if (associated(instance%acab)) deallocate(instance%acab) + + ! Fractional coverage + + if (associated(instance%frac_coverage)) deallocate(instance%frac_coverage) + if (associated(instance%frac_cov_orog)) deallocate(instance%frac_cov_orog) + + ! Output mask + + if (associated(instance%out_mask)) deallocate(instance%out_mask) + + ! Then reallocate and zero... + ! Global input fields + + allocate(instance%artm(ewn,nsn)); instance%artm = 0.d0 + allocate(instance%arng(ewn,nsn)); instance%arng = 0.d0 + allocate(instance%prcp(ewn,nsn)); instance%prcp = 0.d0 + allocate(instance%snowd(ewn,nsn)); instance%snowd = 0.d0 + allocate(instance%siced(ewn,nsn)); instance%siced = 0.d0 + allocate(instance%xwind(ewn,nsn)); instance%xwind = 0.d0 + allocate(instance%ywind(ewn,nsn)); instance%ywind = 0.d0 + allocate(instance%humid(ewn,nsn)); instance%humid = 0.d0 + allocate(instance%lwdown(ewn,nsn)); instance%lwdown = 0.d0 + allocate(instance%swdown(ewn,nsn)); instance%swdown = 0.d0 + allocate(instance%airpress(ewn,nsn)); instance%airpress = 0.d0 + allocate(instance%global_orog(ewn,nsn)); instance%global_orog = 0.d0 + allocate(instance%local_orog(ewn,nsn)); instance%local_orog = 0.d0 + + ! Local fields + + allocate(instance%ablt(ewn,nsn)); instance%ablt = 0.d0 + allocate(instance%acab(ewn,nsn)); instance%acab = 0.d0 + + ! Fractional coverage map + + allocate(instance%frac_coverage(nxg,nyg)); instance%frac_coverage = 0.d0 + allocate(instance%frac_cov_orog(nxgo,nygo)); instance%frac_cov_orog = 0.d0 + + ! Output mask + + allocate(instance%out_mask(ewn,nsn)); instance%out_mask = 1 + + end subroutine glint_i_allocate + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_allocate_gcm(instance,nxg,nyg) + + ! Allocate top-level arrays in the model instance, and ice model arrays. + + implicit none + + type(glint_instance),intent(inout) :: instance !> Instance whose elements are to be allocated. + integer, intent(in) :: nxg !> Longitudinal size of global grid (grid-points). + integer, intent(in) :: nyg !> Latitudinal size of global grid (grid-points). + + integer :: ewn,nsn ! dimensions of local grid + + ewn = get_ewn(instance%model) + nsn = get_nsn(instance%model) + + ! First deallocate if necessary + + if (associated(instance%frac_coverage)) deallocate(instance%frac_coverage) + if (associated(instance%out_mask)) deallocate(instance%out_mask) + + if (associated(instance%artm)) deallocate(instance%artm) + if (associated(instance%acab)) deallocate(instance%acab) + + if (associated(instance%rofi_tavg)) deallocate(instance%rofi_tavg) + if (associated(instance%rofl_tavg)) deallocate(instance%rofl_tavg) + if (associated(instance%hflx_tavg)) deallocate(instance%hflx_tavg) + + + ! Then reallocate and zero... + + allocate(instance%frac_coverage(nxg,nyg)); instance%frac_coverage = 0.d0 + allocate(instance%out_mask(ewn,nsn)); instance%out_mask = 1 + + allocate(instance%artm(ewn,nsn)); instance%artm = 0.d0 + allocate(instance%acab(ewn,nsn)); instance%acab = 0.d0 + + allocate(instance%rofi_tavg(ewn,nsn)); instance%rofi_tavg = 0.d0 + allocate(instance%rofl_tavg(ewn,nsn)); instance%rofl_tavg = 0.d0 + allocate(instance%hflx_tavg(ewn,nsn)); instance%hflx_tavg = 0.d0 + + end subroutine glint_i_allocate_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Move the next two subroutines to a new module called glint_setup? + ! This would be analogous to the organization of Glide. + + subroutine glint_i_readconfig(instance,config) + + !> read glint configuration + + use glimmer_config + use glimmer_log + use glad_constants, only: years2hours + + implicit none + + ! Arguments + + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + type(glint_instance),intent(inout) :: instance !> The instance being initialised. + + ! Internals + + type(ConfigSection), pointer :: section + real(dp) :: mbal_time_temp ! Accumulation time in years + + mbal_time_temp = -1.d0 + + call GetSection(config,section,'GLINT climate') + if (associated(section)) then + call GetValue(section,'evolve_ice',instance%evolve_ice) + call GetValue(section,'precip_mode',instance%whichprecip) + call GetValue(section,'acab_mode',instance%whichacab) + call GetValue(section,'test_coupling',instance%test_coupling) + call GetValue(section,'ice_albedo',instance%ice_albedo) + call GetValue(section,'lapse_rate',instance%lapse_rate) + instance%data_lapse_rate=instance%lapse_rate + call GetValue(section,'data_lapse_rate',instance%data_lapse_rate) + call GetValue(section,'mbal_accum_time',mbal_time_temp) + call GetValue(section,'ice_tstep_multiply',instance%ice_tstep_multiply) + call GetValue(section,'mean_preserving',instance%use_mpint) + call GetValue(section,'zero_gcm_fluxes',instance%zero_gcm_fluxes) + end if + + if (mbal_time_temp > 0.0) then + instance%mbal_accum_time = mbal_time_temp * years2hours + else + instance%mbal_accum_time = -1 + end if + + call glint_nc_readparams(instance,config) + + end subroutine glint_i_readconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_nc_readparams(instance,config) + + !> read netCDF I/O related configuration file + !> based on glimmer_ncparams + + use glimmer_config + use glimmer_ncparams, only: handle_output, handle_input, configstring + implicit none + + type(glint_instance) :: instance !> GLINT instance + type(ConfigSection), pointer :: config !> structure holding sections of configuration file + + ! local variables + type(ConfigSection), pointer :: section + type(glimmer_nc_output), pointer :: output + type(glimmer_nc_input), pointer :: input + + ! Initialise local pointers + output => null() + input => null() + + ! setup outputs + call GetSection(config,section,'GLINT output') + do while(associated(section)) + output => handle_output(section,output,0.d0,configstring) + if (.not.associated(instance%out_first)) then + instance%out_first => output + end if + call GetSection(section%next,section,'GLINT output') + end do + + ! setup inputs + call GetSection(config,section,'GLINT input') + do while(associated(section)) + input => handle_input(section,input) + if (.not.associated(instance%in_first)) then + instance%in_first => input + end if + call GetSection(section%next,section,'GLINT input') + end do + + output => null() + input => null() + + end subroutine glint_nc_readparams + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_i_printconfig(instance) + + use glimmer_log + use glad_constants, only: hours2years + use parallel, only: tasks + + implicit none + + ! Argument + + type(glint_instance),intent(inout) :: instance !> The instance to be printed + + ! Internal + + character(len=100) :: message + + call write_log(' ') + call write_log('GLINT climate') + call write_log('-------------') + write(message,*) 'evolve_ice (0=fixed, 1=evolve): ',instance%evolve_ice + call write_log(message) + write(message,*) 'precip mode (1=standard): ',instance%whichprecip + call write_log(message) + write(message,*) 'acab_mode (0 = GCM SMB, 1 = PDD):',instance%whichacab + call write_log(message) + write(message,*) 'test_coupling: ',instance%test_coupling + call write_log(message) + + if (instance%evolve_ice == EVOLVE_ICE_FALSE) then + call write_log('The ice sheet state will not evolve after initialization') + endif + + if (instance%whichacab /= MASS_BALANCE_GCM) then ! not getting SMB from GCM + + !TODO - Get the PDD scheme to work with multiple task? + if (tasks > 1) then + call write_log('GLINT: Must use GCM mass balance option to run on more than one processor', GM_FATAL) + endif + + write(message,*) 'ice_albedo ',instance%ice_albedo + call write_log(message) + write(message,*) 'lapse_rate ',instance%lapse_rate + call write_log(message) + write(message,*) 'data_lapse_rate',instance%data_lapse_rate + call write_log(message) + endif + + if (instance%mbal_accum_time == -1) then + call write_log('Mass-balance accumulation time will be set to max(ice timestep, mbal timestep)') + else + write(message,*) 'Mass-balance accumulation time:',instance%mbal_accum_time * hours2years,' years' + call write_log(message) + end if + + write(message,*) 'ice_tstep_multiply:',instance%ice_tstep_multiply + call write_log(message) + + select case(instance%use_mpint) + case(1) + write(message,*) 'Using mean-preserving interpolation' + call write_log(message) + case(0) + write(message,*) 'Using normal interpolation' + call write_log(message) + case default + write(message,*) 'Unrecognised value of instance%use_mpint' + call write_log(message,GM_FATAL) + end select + + write(message,*) 'zero_gcm_fluxes: ', instance%zero_gcm_fluxes + call write_log(message) + + end subroutine glint_i_printconfig + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !TODO - Can we remove function glint_has_snow_model and only use mbal_has_snow_model? + + logical function glint_has_snow_model(instance) + + use glint_mbal, only: mbal_has_snow_model + + type(glint_instance), intent(in) :: instance + + glint_has_snow_model = mbal_has_snow_model(instance%mbal_accum%mbal) + + end function glint_has_snow_model + +end module glint_type diff --git a/components/cism/glimmer-cism/libglint/glint_upscale.F90 b/components/cism/glimmer-cism/libglint/glint_upscale.F90 new file mode 100644 index 0000000000..ae02f575f3 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_upscale.F90 @@ -0,0 +1,577 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glint_upscale.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + + module glint_upscale + + ! This module contains subroutines for upscaling fields from the local to the global grid. + ! Much of the actual work is done at a lower level, in glint_interp.F90. + + use glint_type + use glad_constants + use glimmer_global, only: dp + implicit none + + private + public glint_upscaling, glint_upscaling_gcm, & + glint_accumulate_output_gcm + +contains + + subroutine glint_upscaling(instance, & + orog, albedo, & + ice_frac, veg_frac, & + snowice_frac, snowveg_frac, & + snow_depth) + + !> Upscales and returns certain fields + !> Output fields are only valid on the main task + !> + !> \begin{itemize} + !> \item \texttt{orog} --- the orographic elevation (m) + !> \item \texttt{albedo} --- the albedo of ice/snow (this is only a notional value --- need to do + !> some work here) + !> \item \texttt{ice\_frac} --- The fraction covered by ice + !> \item \texttt{veg\_frac} --- The fraction of exposed vegetation + !> \item \texttt{snowice\_frac} --- The fraction of snow-covered ice + !> \item \texttt{snowveg\_frac} --- The fraction of snow-covered vegetation + !> \item \texttt{snow_depth} --- The mean snow-depth over those parts covered in snow (m w.e.) + !> \end{itemize} + + use glimmer_paramets + use glimmer_coordinates, only: coordsystem_allocate + + ! Arguments ---------------------------------------------------------------------------------------- + + type(glint_instance), intent(in) :: instance !> the model instance + + real(dp),dimension(:,:),intent(out) :: orog !> the orographic elevation (m) + real(dp),dimension(:,:),intent(out) :: albedo !> the albedo of ice/snow + real(dp),dimension(:,:),intent(out) :: ice_frac !> The fraction covered by ice + real(dp),dimension(:,:),intent(out) :: veg_frac !> The fraction of exposed vegetation + real(dp),dimension(:,:),intent(out) :: snowice_frac !> The fraction of snow-covered ice + real(dp),dimension(:,:),intent(out) :: snowveg_frac !> The fraction of snow-covered vegetation + real(dp),dimension(:,:),intent(out) :: snow_depth !> The mean snow-depth over those + !> parts covered in snow (m w.e.) + + ! Internal variables ------------------------------------------------------------------------------- + + real(dp),dimension(:,:),pointer :: temp => null() + + ! -------------------------------------------------------------------------------------------------- + ! Orography + + call local_to_global_avg(instance%ups_orog, & + instance%model%geometry%usrf, & + orog, & + instance%out_mask) + orog=thk0*orog + + call coordsystem_allocate(instance%lgrid,temp) + + ! Ice-no-snow fraction + where (instance%mbal_accum%snowd == 0.d0 .and. instance%model%geometry%thck > 0.d0) + temp = 1.d0 + elsewhere + temp = 0.d0 + endwhere + + call local_to_global_avg(instance%ups, & + temp, & + ice_frac, & + instance%out_mask) + + ! Ice-with-snow fraction + where (instance%mbal_accum%snowd > 0.d0 .and. instance%model%geometry%thck > 0.d0) + temp = 1.d0 + elsewhere + temp = 0.d0 + endwhere + call local_to_global_avg(instance%ups, & + temp, & + snowice_frac, & + instance%out_mask) + + ! Veg-with-snow fraction (if ice <10m thick) + where (instance%mbal_accum%snowd > 0.d0 .and. instance%model%geometry%thck <= (10.d0/thk0)) + temp = 1.d0 + elsewhere + temp = 0.d0 + endwhere + call local_to_global_avg(instance%ups, & + temp, & + snowveg_frac, & + instance%out_mask) + + ! Remainder is veg only + veg_frac = 1.d0 - ice_frac - snowice_frac - snowveg_frac + + ! Snow depth + + call local_to_global_avg(instance%ups, & + instance%mbal_accum%snowd, & + snow_depth, & + instance%out_mask) + + ! Albedo + + where ((ice_frac+snowice_frac) > 0.d0) + albedo = instance%ice_albedo + elsewhere + albedo = 0.d0 + endwhere + + deallocate(temp) + temp => null() + + end subroutine glint_upscaling + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_upscaling_gcm(instance, nec, & + nxl, nyl, & + nxg, nyg, & + box_areas, & + gfrac, gtopo, & + grofi, grofl, & + ghflx, & + init_call) + + ! Upscale fields from the local grid to the global grid (with multiple elevation classes). + ! Output fields are only valid on the main task. + ! The upscaled fields are passed to the GCM land surface model, which has the option + ! of updating the fractional area and surface elevation of glaciated gridcells. + ! If instance%zero_gcm_fluxes is true, then the upscaled versions of grofi, grofl and + ! ghflx are zeroed out + + use glimmer_paramets, only: thk0, GLC_DEBUG + use glimmer_log + use parallel, only: tasks, main_task + + ! Arguments ---------------------------------------------------------------------------- + + type(glint_instance), intent(inout) :: instance ! the model instance + integer, intent(in) :: nec ! number of elevation classes + integer, intent(in) :: nxl,nyl ! local grid dimensions + integer, intent(in) :: nxg,nyg ! local grid dimensions + real(dp),dimension(nxg,nyg), intent(in) :: box_areas ! global grid cell areas (m^2) + real(dp),dimension(nxg,nyg,0:nec),intent(out) :: gfrac ! ice/land-covered fraction [0,1] + real(dp),dimension(nxg,nyg,0:nec),intent(out) :: gtopo ! surface elevation (m) + real(dp),dimension(nxg,nyg,0:nec),intent(out) :: ghflx ! heat flux (m) + real(dp),dimension(nxg,nyg), intent(out) :: grofi ! ice runoff (calving) flux (kg/m^2/s) + real(dp),dimension(nxg,nyg), intent(out) :: grofl ! liquid runoff (basal melt) flux (kg/m^2/s) + + logical, intent(in), optional :: init_call ! true if called during initialization + + ! Internal variables ---------------------------------------------------------------------- + + integer :: i, j, n ! indices + + character(len=100) :: message + real(dp) :: dew, dns ! gridcell dimensions + real(dp) :: usrf, thck, topg ! surface elevation, ice thickness, bed elevation (m) + + real(dp), dimension(nxl,nyl) :: & + area_l, &! local gridcell area + area_rofi_l, &! area*rofi on local grid + area_rofl_l ! area*rofl on local grid + + real(dp), dimension(nxg,nyg) :: & + area_g ! global gridcell area (including ocean) + + real(dp), dimension(nxl,nyl,0:nec) :: & + area_frac_l, &! area*frac per elevation class on local grid + area_topo_l, &! area*topo per elevation class on local grid + area_hflx_l ! area*hflx per elevation class on local grid + + integer, dimension(nxl,nyl,0:nec) :: & + area_mask_l ! binary mask, defined at all elevation classes, + ! that defines whether some ice elevation is present. + ! For the 0-indexed bed information, area_mask_l = 1 + ! for all land points (ice or ice-free). + + real(dp), dimension(0:nec) :: topomax ! upper elevation limit of each class + + logical :: first_call ! if calling the first time, then do not average the accumulated fluxes + ! use values from restart file if available + + first_call = .false. + if (present(init_call)) then + if (init_call) first_call = .true. + endif + + dew = get_dew(instance%model) + dns = get_dns(instance%model) + + !TODO - Pass in topomax as an argument instead of hardwiring it here? + ! Note: Values must be consistent with the values in the GCM. + + ! Given the value of nec, specify the upper and lower elevation boundaries of each class. + + if (nec == 1) then + topomax = (/ 0._dp, 10000._dp, 10000._dp, 10000._dp, 10000._dp, 10000._dp, & + 10000._dp, 10000._dp, 10000._dp, 10000._dp, 10000._dp /) + elseif (nec == 3) then + topomax = (/ 0._dp, 1000._dp, 2000._dp, 10000._dp, 10000._dp, 10000._dp, & + 10000._dp, 10000._dp, 10000._dp, 10000._dp, 10000._dp /) + elseif (nec == 5) then + topomax = (/ 0._dp, 500._dp, 1000._dp, 1500._dp, 2000._dp, 10000._dp, & + 10000._dp, 10000._dp, 10000._dp, 10000._dp, 10000._dp /) + elseif (nec == 10) then + topomax = (/ 0._dp, 200._dp, 400._dp, 700._dp, 1000._dp, 1300._dp, & + 1600._dp, 2000._dp, 2500._dp, 3000._dp, 10000._dp /) + elseif (nec == 36) then + topomax = (/ 0._dp, 200._dp, 400._dp, 600._dp, 800._dp, & + 1000._dp, 1200._dp, 1400._dp, 1600._dp, 1800._dp, & + 2000._dp, 2200._dp, 2400._dp, 2600._dp, 2800._dp, & + 3000._dp, 3200._dp, 3400._dp, 3600._dp, 3800._dp, & + 4000._dp, 4200._dp, 4400._dp, 4600._dp, 4800._dp, & + 5000._dp, 5200._dp, 5400._dp, 5600._dp, 5800._dp, & + 6000._dp, 6200._dp, 6400._dp, 6600._dp, 6800._dp, & + 7000._dp, 10000._dp /) + else + if (GLC_DEBUG .and. main_task) then + write(message,'(a6,i3)') 'nec =', nec + call write_log(trim(message), GM_DIAGNOSTIC) + end if + call write_log('ERROR: Current supported values of nec (no. of elevation classes) are 1, 3, 5, 10, or 36', & + GM_FATAL,__FILE__,__LINE__) + endif + + gfrac(:,:,0:nec) = 0.d0 + gtopo(:,:,0:nec) = 0.d0 + ghflx(:,:,0:nec) = 0.d0 + grofi(:,:) = 0.d0 + grofl(:,:) = 0.d0 + area_l(:,:) = 0.d0 + area_g(:,:) = 0.d0 + area_mask_l(:,:,0:nec) = 0 + area_frac_l(:,:,0:nec) = 0.d0 + area_topo_l(:,:,0:nec) = 0.d0 + area_hflx_l(:,:,0:nec) = 0.d0 + area_rofi_l(:,:) = 0.d0 + area_rofl_l(:,:) = 0.d0 + + ! Compute time-average fluxes (unless called during initialization) + if (first_call) then + ! do nothing; use values from restart file if restarting + else + if (instance%av_count_output > 0) then + instance%rofi_tavg(:,:) = instance%rofi_tavg(:,:) / real(instance%av_count_output,dp) + instance%rofl_tavg(:,:) = instance%rofl_tavg(:,:) / real(instance%av_count_output,dp) + instance%hflx_tavg(:,:) = instance%hflx_tavg(:,:) / real(instance%av_count_output,dp) + else + instance%rofi_tavg(:,:) = 0.d0 + instance%rofl_tavg(:,:) = 0.d0 + instance%hflx_tavg(:,:) = 0.d0 + endif + endif + + ! Reset the logical variable for averaging output + + instance%new_tavg_output = .true. + + ! To account for the potential for variable grid sizes, multiply all values by the area of each grid + ! cell, upscale, then divide by the upscaled area afterwards. + ! Note that this is redundant for the current, constant-sized grid. + ! Also in this loop: bin ice sheet grid cell values by elevation. + + do j = 1, nyl + do i = 1, nxl + + usrf = thk0 * instance%model%geometry%usrf(i,j) + thck = thk0 * instance%model%geometry%thck(i,j) + topg = thk0 * instance%model%geometry%topg(i,j) + + if (usrf > 0.d0) then ! if not at sea level (assume a land point)... + if (thck <= min_thck) then ! and is not ice-covered... + area_frac_l(i,j,0) = dew*dns ! accumulate bare land area fraction in 0-indexed cell + else ! and is ice-covered... + do n = 1, nec + if (usrf >= topomax(n-1) .and. usrf < topomax(n)) then ! local cell is in elev class n + area_frac_l(i,j,n) = dew*dns ! accumulate ice area fraction + area_topo_l(i,j,n) = dew*dns * usrf ! accumulate topography + ! Setting hflx to 0 for now to avoid giving the impression that it's + ! being used, since currently CLM doesn't handle it +! area_hflx_l(i,j,n) = dew*dns * instance%hflx_tavg(i,j) ! accumulate heat flux + area_hflx_l(i,j,n) = 0.d0 + area_mask_l(i,j,n) = 1 ! accumulate ice area + exit + endif + enddo ! nec + endif + ! For upscaled bed topographies and heat fluxes, include values under ice. + ! The rationale for topography is that it gets hard to analyze / explain + ! results if bare land topography changes whenever ice expands or retreats - + ! so we're using a formulation that results in bare land topography being + ! constant in time (as long as topg is constant - i.e., neglecting isostasy). + area_topo_l(i,j,0) = dew*dns * topg + ! Setting hflx to 0 for now to avoid giving the impression that it's + ! being used, since currently CLM doesn't handle it +! area_hflx_l(i,j,0) = dew*dns * instance%hflx_tavg(i,j) + area_hflx_l(i,j,0) = 0.d0 + area_mask_l(i,j,0) = 1 + area_l(i,j) = dew*dns + else ! usrf <= 0; grid cell is presumed ocean point + ! Ocean points are unglaciated, so we treat this as a 0-area point. We + ! eventually want to handle this by keeping CLM consistent with CISM in terms + ! of its breakdown into land vs "ocean" (e.g., wetland in CLM). In that case, + ! if CISM says a point is ocean, then it would tell CLM that that point is + ! ocean, and so CLM wouldn't try to generate SMB there. + + area_l(i,j) = 0.d0 + endif + + ! Runoff fluxes (note, these fluxes can be nonzero for cells with no ice in current timestep) + area_rofi_l(i,j) = dew*dns * instance%rofi_tavg(i,j) + area_rofl_l(i,j) = dew*dns * instance%rofl_tavg(i,j) + + enddo + enddo + + ! Map the area-weighted local values to the global grid. Note that there are three ways to do this. + ! Ensure that your choice makes physical sense. + ! 1) Sum up all values of 'children' ice sheet grid points, for each 'parent' climate grid cell. + ! Example usage: get total volume of ice associated with each parent climate grid cell, + ! 2) Average all values of 'children' ice sheet grid points, for each 'parent' climate grid cell. + ! Example: get average surface elevation of children ice sheet points, for each parent climate grid cell. + ! 3) Minimum of all values of 'children' ice sheet grid points, for each 'parent' climate grid cell. + + ! Total area of non-ocean ice cells within global grid cell + call local_to_global_sum(instance%ups, & + area_l, & + area_g) + + !Total solid ice flux + call local_to_global_sum(instance%ups, & + area_rofi_l(:,:), & + grofi(:,:)) + + !Total basal runoff + call local_to_global_sum(instance%ups, & + area_rofl_l(:,:), & + grofl(:,:)) + + ! Loop over elevation classes to generate global-grid-based gfrac, gtopo, ghflx fields. + ! Note the values in the zero index refer to bare-land values. + do n = 0, nec + + call local_to_global_sum(instance%ups, & + area_frac_l(:,:,n), & + gfrac(:,:,n)) + + if (n==0) then ! for bare land topography, use minimum elevation of child grid cell as the value for the parent grid cell + + call local_to_global_min(instance%ups, & + area_topo_l(:,:,n), & + gtopo(:,:,n), & + area_mask_l(:,:,n)) + + else ! use average elevation of child grid cell as the value for the parent grid cell + + call local_to_global_avg(instance%ups, & + area_topo_l(:,:,n), & + gtopo(:,:,n), & + area_mask_l(:,:,n)) + endif + + call local_to_global_avg(instance%ups, & + area_hflx_l(:,:,n), & + ghflx(:,:,n), & + area_mask_l(:,:,n)) + + do j = 1, nyg + do i = 1, nxg + if (area_g(i,j) > 0.d0) then + gfrac(i,j,n) = gfrac(i,j,n) / area_g(i,j) ! fractional area of elevation class, relative to total land area + else + gfrac(i,j,n) = 0.d0 + endif + if (n==0) then ! non-ice-class values: use model-derived ice-free topography/heat flux, regardless of whether ice exists + gtopo(i,j,n) = gtopo(i,j,n) / (dew*dns) + gtopo(i,j,n) = max(0.d0,gtopo(i,j,n)) ! keep elevations >= sea level + ghflx(i,j,n) = ghflx(i,j,n) / (dew*dns) + else ! ice-class values + if (gfrac(i,j,n) > 0.d0) then !ice ice area exists, use model-derived topography/heat flux values + gtopo(i,j,n) = gtopo(i,j,n) / (dew*dns) + ghflx(i,j,n) = ghflx(i,j,n) / (dew*dns) + else ! use prescribed, idealized topography/heat flux values + gtopo(i,j,n) = mean_elevation_virtual(n, nec, topomax) + ghflx(i,j,n) = 0.d0 + endif + endif + enddo ! i + enddo ! j + + enddo ! nec + + do j = 1, nyg + do i = 1, nxg + ! Find mean ice runoff from calving + ! Note: Here we divide by box_areas (the area of the global grid cell), which in general is not equal + ! to area_g (the sum over area of the local non-ocean grid cells associated with the global cell). + ! We do this to ensure conservation of ice mass (=flux*area) when multiplying later by the + ! area of the global grid cell. + if (box_areas(i,j) > 0.d0) then + grofi(i,j) = grofi(i,j) / box_areas(i,j) + grofl(i,j) = grofl(i,j) / box_areas(i,j) + endif + enddo + enddo + + if (instance%zero_gcm_fluxes == ZERO_GCM_FLUXES_TRUE) then + ghflx(:,:,0:nec) = 0.d0 + grofi(:,:) = 0.d0 + grofl(:,:) = 0.d0 + end if + + end subroutine glint_upscaling_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + subroutine glint_accumulate_output_gcm(model, & + av_count_output, & + new_tavg_output, & + rofi_tavg, & + rofl_tavg, & + hflx_tavg) + + ! Given the calving, basal melting, and conductive heat flux fields from the dycore, + ! accumulate contributions to the rofi, rofl, and hflx fields to be sent to the coupler. + + use glimmer_paramets, only: thk0, tim0 + + use glimmer_scales, only: scale_acab ! for testing + + type(glide_global_type), intent(in) :: model + + integer, intent(inout) :: av_count_output ! step counter + logical, intent(inout) :: new_tavg_output ! if true, start new averaging + real(dp), dimension(:,:), intent(inout) :: rofi_tavg ! solid ice runoff (kg m-2 s-1) + real(dp), dimension(:,:), intent(inout) :: rofl_tavg ! liquid runoff from basal/interior melting (kg m-2 s-1) + real(dp), dimension(:,:), intent(inout) :: hflx_tavg ! conductive heat flux at top surface (W m-2) + + ! things to do the first time + + if (new_tavg_output) then + + new_tavg_output = .false. + av_count_output = 0 + + ! Initialise + rofi_tavg(:,:) = 0.d0 + rofl_tavg(:,:) = 0.d0 + hflx_tavg(:,:) = 0.d0 + + end if + + av_count_output = av_count_output + 1 + + !-------------------------------------------------------------------- + ! Accumulate solid runoff (calving) + !-------------------------------------------------------------------- + + ! Note on units: model%climate%calving has dimensionless ice thickness units + ! Multiply by thk0 to convert to meters of ice + ! Multiply by rhoi to convert to kg/m^2 water equiv. + ! Divide by (dt*tim0) to convert to kg/m^2/s + + ! Convert to kg/m^2/s + rofi_tavg(:,:) = rofi_tavg(:,:) & + + model%climate%calving(:,:) * thk0 * rhoi / (model%numerics%dt * tim0) + + !-------------------------------------------------------------------- + ! Accumulate liquid runoff (basal melting) + !-------------------------------------------------------------------- + !TODO - Add internal melting for enthalpy case + + ! Note on units: model%temper%bmlt has dimensionless units of ice thickness per unit time + ! Multiply by thk0/tim0 to convert to meters ice per second + ! Multiply by rhoi to convert to kg/m^2/s water equiv. + + ! Convert to kg/m^2/s + rofl_tavg(:,:) = rofl_tavg(:,:) & + + model%temper%bmlt(:,:) * thk0/tim0 * rhoi + + !-------------------------------------------------------------------- + ! Accumulate basal heat flux + !-------------------------------------------------------------------- + + ! Note on units: model%temper%ucondflx has units of W/m^2, positive down + ! Flip the sign so that hflx_tavg is positive up. + + hflx_tavg(:,:) = hflx_tavg(:,:) & + - model%temper%ucondflx(:,:) + + end subroutine glint_accumulate_output_gcm + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + real(dp) function mean_elevation_virtual(ec, nec, topomax) + + ! For a "virtual" elevation class (that is, an elevation class that has 0 area), + ! return the "mean" elevation of the given elevation class. + + use glimmer_log + + ! Arguments ---------------------------------------------------------------------------- + + integer , intent(in) :: ec ! elevation class + integer , intent(in) :: nec ! number of elevation classes + real(dp) , intent(in) :: topomax(0:) ! upper elevation limit of each class + + ! TODO: replace this with a call to shr_assert, if/when glimmer-cism pulls in csm_share + if (ubound(topomax, 1) /= nec) then + call write_log('ERROR: upper bound of topomax does not match nec', & + GM_FATAL, __FILE__, __LINE__) + end if + + if (ec < nec) then + mean_elevation_virtual = (topomax(ec-1) + topomax(ec))/2.d0 + else if (ec == nec) then + ! In the top elevation class; in this case, assignment of a "mean" elevation is + ! somewhat arbitrary + + if (nec > 1) then + mean_elevation_virtual = 2.d0 * topomax(ec-1) - topomax(ec-2) + else + ! entirely arbitrary + mean_elevation_virtual = 1000.d0 + end if + else + call write_log('ERROR: elevation class out of bounds', GM_FATAL, __FILE__, __LINE__) + end if + + end function mean_elevation_virtual + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + end module glint_upscale + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglint/glint_vars.def b/components/cism/glimmer-cism/libglint/glint_vars.def new file mode 100644 index 0000000000..5bf197bfe5 --- /dev/null +++ b/components/cism/glimmer-cism/libglint/glint_vars.def @@ -0,0 +1,111 @@ +#[] +#dimensions: time, y1, x1 +#units: +#long_name: +#data: +#factor: + +# setup for code generator +[VARSET] +# prefix of the generated module +name: glint +# f90 type containing all necessary data +datatype: glint_instance +# module where type is defined +datamod: glint_type + +#lipscomb mod: Changed mask to outmask +[outmask] +dimensions: time, y1, x1 +units: 1 +long_name: upscaling mask +data: data%out_mask +load: 1 +coordinates: lon lat + +#lipscomb mod: Added inmask +[inmask] +dimensions: time, y1, x1 +units: 1 +long_name: downscaling mask +data: data%downs%lmask +coordinates: lon lat + +[arng] +dimensions: time, y1, x1 +units: degreeC +long_name: air temperature half-range +data: data%arng +coordinates: lon lat + +[prcp] +dimensions: time, y1, x1 +units: meter (water)/year +long_name: precipitation +data: data%prcp +standard_name: lwe_precipitation_rate +coordinates: lon lat + +[ablt] +dimensions: time, y1, x1 +units: meter (water)/year +long_name: ablation +data: data%ablt +coordinates: lon lat + +[global_orog] +dimensions: time, y1, x1 +units: meter +long_name: orographic elevation provided by global model +data: data%global_orog +standard_name: surface_altitude +coordinates: lon lat + +[local_orog] +dimensions: time, y1, x1 +units: meter +long_name: orographic elevation provided by local model +standard_name: surface_altitude +data: data%local_orog +coordinates: lon lat + +[snowd] +dimensions: time, y1, x1 +units: meter +long_name: snow depth +data: data%snowd +standard_name: surface_snow_thickness +load: 1 +coordinates: lon lat + +[siced] +dimensions: time, y1, x1 +units: meter +long_name: superimposed ice depth +data: data%siced +load: 1 +coordinates: lon lat + +[rofi_tavg] +dimensions: time, y1, x1 +units: kg m-2 s-1 +long_name: solid calving flux +data: data%rofi_tavg +load: 1 +coordinates: lon lat + +[rofl_tavg] +dimensions: time, y1, x1 +units: kg m-2 s-1 +long_name: liquid runoff flux +data: data%rofl_tavg +load: 1 +coordinates: lon lat + +[hflx_tavg] +dimensions: time, y1, x1 +units: W m-2 +long_name: heat flux to ice surface +data: data%hflx_tavg +load: 1 +coordinates: lon lat diff --git a/components/cism/glimmer-cism/libglissade/glissade.F90 b/components/cism/glimmer-cism/libglissade/glissade.F90 new file mode 100644 index 0000000000..92a43eeb1a --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade.F90 @@ -0,0 +1,1195 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +! WJS (1-30-12): The following (turning optimization off) is needed as a workaround for an +! xlf compiler bug, at least in IBM XL Fortran for AIX, V12.1 on bluefire +#ifdef CPRIBM +@PROCESS OPT(0) +#endif + +!CLEANUP - glissade.F90 +! +! NOTE: MJH Lines that start with !### are ones I have identified to be deleted. +! +! This is a new module, originally copied from glide.F90 (William Lipscomb, June 2012) +! Removed SIA-specific code, leaving only the HO code with remapping transport +! Whenever possible, parallel_halo updates should go in this module rather +! than at lower levels. +! +! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! + + +! + glissade.f90 - part of the CISM ice model + +! + + +! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glissade + + ! Driver for Glissade (parallel, higher-order) dynamical core + + use glimmer_global, only: dp + use glimmer_log + use glide_types + use glide_io + use glide_lithot + use glimmer_config + use glissade_test, only: glissade_test_halo, glissade_test_transport + + implicit none + + integer, private, parameter :: dummyunit=99 + + logical, parameter :: verbose_glissade = .false. + + ! Change either of the following logical parameters to true to carry out simple tests + logical, parameter :: test_transport = .false. ! if true, call test_transport subroutine + real(dp), parameter :: thk_init = 500.d0 ! initial thickness (m) for test_transport + logical, parameter :: test_halo = .false. ! if true, call test_halo subroutine + + !WHL - for trying glissade_therm in place of glissade_temp +!! logical, parameter :: call_glissade_therm = .false. + logical, parameter :: call_glissade_therm = .true. + +contains + +!======================================================================= + +! Note: There is no glissade_config subroutine; glide_config works for all dycores. + +!======================================================================= + + subroutine glissade_initialise(model) + + ! initialise Glissade model instance + + use parallel + use glide_stop, only: register_model + use glide_setup + use glimmer_ncio + use glide_velo, only: init_velo !TODO - Remove call to init_velo? + !TODO - Remove glissade_temp + use glissade_temp, only: glissade_init_temp + use glissade_therm, only: glissade_init_therm + use glimmer_scales + use glide_mask + use isostasy + use glimmer_map_init + use glide_ground + use glide_thck, only : glide_calclsrf + use glam_strs2, only : glam_velo_init + use glimmer_coordinates, only: coordsystem_new + use glide_grid_operators, only: stagvarb + use glissade_velo_higher, only: glissade_velo_higher_init + use glide_diagnostics, only: glide_init_diag + use felix_dycore_interface, only: felix_velo_init + use glide_bwater + use glimmer_paramets, only: thk0 + + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + + !TODO - Is glimmer_version_char sitll needed? + character(len=100), external :: glimmer_version_char + + integer :: i, j + + call write_log(trim(glimmer_version_char())) + + ! initialise scales + call glimmer_init_scales + + ! scale parameters + call glide_scale_params(model) + + ! set up coordinate systems, and change to the parallel values of ewn and nsn + + ! With outflow BCs, scalars in the halos are set to zero. + if (model%general%global_bc == GLOBAL_BC_OUTFLOW) then + call distributed_grid(model%general%ewn,model%general%nsn,outflow_bc_in=.true.) + else + call distributed_grid(model%general%ewn,model%general%nsn) + endif + + model%general%ice_grid = coordsystem_new(0.d0, 0.d0, & + model%numerics%dew, model%numerics%dns, & + model%general%ewn, model%general%nsn) + + model%general%velo_grid = coordsystem_new(model%numerics%dew/2.d0, model%numerics%dns/2.d0, & + model%numerics%dew, model%numerics%dns, & + model%general%ewn-1, model%general%nsn-1) + + ! allocate arrays + call glide_allocarr(model) + + ! set uniform basal heat flux (positive down) + model%temper%bheatflx = model%paramets%geot + + ! compute sigma levels or load from external file + ! (if not already read from config file) + call glide_load_sigma(model,dummyunit) + + ! open all input files + call openall_in(model) + + ! read first time slice + call glide_io_readall(model,model) + + ! Write projection info to log + call glimmap_printproj(model%projection) + + ! handle relaxed/equilibrium topo + ! Initialise isostasy first + call init_isostasy(model) + + select case(model%options%whichrelaxed) + case(RELAXED_TOPO_INPUT) ! supplied topography is relaxed + model%isostasy%relx = model%geometry%topg + case(RELAXED_TOPO_COMPUTE) ! supplied topography is in equilibrium + !TODO - Test the case RELAXED_TOPO_COMPUTE + call not_parallel(__FILE__,__LINE__) + call isos_relaxed(model) + end select + + ! open all output files + call openall_out(model) + + ! create glide variables + call glide_io_createall(model, model) + + ! If a 2D bheatflx field is present in the input file, it will have been written + ! to model%temper%bheatflx. For the case model%options%gthf = 0, we want to use + ! a uniform heat flux instead. + ! If no bheatflx field is present in the input file, then we default to the + ! prescribed uniform value, model%paramets%geot. + + if (model%options%gthf == GTHF_UNIFORM) then + + ! Check to see if this flux was present in the input file + ! (by checking whether the flux is nonuniform over the domain) + if (abs(maxval(model%temper%bheatflx) - minval(model%temper%bheatflx)) > 1.d-6) then + call write_log('Setting uniform prescribed geothermal flux') + call write_log('(Set gthf = 1 to read geothermal flux field from input file)') + endif + + ! set uniform basal heat flux (positive down) + model%temper%bheatflx = model%paramets%geot + + endif + + ! initialise glissade components + + ! Update some variables in halo cells + ! Note: We need thck and artm in halo cells so that temperature will be initialized correctly (if not read from input file). + ! We do an update here for temp in case temp is read from an input file. + ! If temp is computed in glissade_init_therm (based on the value of options%temp_init), + ! then the halos will receive the correct values. + !TODO - Does anything else need an initial halo update? + call parallel_halo(model%geometry%thck) + call parallel_halo(model%climate%artm) + call parallel_halo(model%temper%temp) + + !TODO - Remove call to init_velo in glissade_initialise? + ! Most of what's done in init_velo is needed for SIA only, but still need velowk for call to wvelintg + call init_velo(model) + + !TODO - Remove glissade_init_temp option + if (call_glissade_therm) then + call glissade_init_therm(model%options%temp_init, model%options%is_restart, & + model%general%ewn, model%general%nsn, & + model%general%upn, & + model%numerics%sigma, model%numerics%stagsigma, & + model%geometry%thck*thk0, & ! m + model%climate%artm, & ! deg C + model%temper%temp) ! deg C + else + call glissade_init_temp(model) + endif + + ! Initialize basal hydrology model, if enabled + call bwater_init(model) + + if (model%options%gthf == GTHF_COMPUTE) then + call not_parallel(__FILE__,__LINE__) + call init_lithot(model) + end if + + ! Dycore-specific velocity solver initialization + select case (model%options%whichdycore) + case ( DYCORE_GLAM ) ! glam finite-difference + + call glam_velo_init(model%general%ewn, model%general%nsn, & + model%general%upn, & + model%numerics%dew, model%numerics%dns, & + model%numerics%sigma) + + case ( DYCORE_GLISSADE ) ! glissade finite-element + + call glissade_velo_higher_init + + case ( DYCORE_ALBANYFELIX) + + call felix_velo_init(model) + + end select + + !TODO - Add halo updates of state variables here? + + ! If unstagbeta (i.e., beta on the scalar ice grid) was read from an input file, + ! then interpolate it to beta on the staggered grid. + ! NOTE: unstagbeta is initialized to unphys_val = -999.d0, so its maxval will be > 0 only if + ! the field is read in. + ! We can make an exception for ISHOM case C; for greater accuracy we set beta in + ! subroutine calcbeta instead of interpolating from unstagbeta (one processor only). + + if (maxval(model%velocity%unstagbeta) > 0.d0 .and. & + model%options%which_ho_babc /= HO_BABC_ISHOMC) then ! interpolate to staggered grid + call write_log('Interpolating beta from unstaggered (unstagbeta) to staggered grid (beta)') + if (maxval(model%velocity%beta) > 0.0d0 ) then + call write_log('Warning: the input "beta" field will be overwritten with values interpolated from the input "unstagbeta" field!') + endif + + call parallel_halo(model%velocity%unstagbeta) ! fill in halo values + call stagvarb(model%velocity%unstagbeta, & ! interpolate + model%velocity%beta, & + model%general%ewn, & + model%general%nsn) + + endif ! unstagbeta > 0 + + ! Note: The basal process option is currently disabled. + ! initialize basal process module +!! if (model%options%which_bmod == BAS_PROC_FULLCALC .or. & +!! model%options%which_bmod == BAS_PROC_FASTCALC) then +!! call Basal_Proc_init (model%general%ewn, model%general%nsn,model%basalproc, & +!! model%numerics%dttem) +!! end if + + ! calculate mask + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + + ! and calculate lower and upper ice surface + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, model%climate%eus,model%geometry%lsrf) + model%geometry%usrf = model%geometry%thck + model%geometry%lsrf + + ! register the newly created model so that it can be finalised in the case + ! of an error without needing to pass the whole thing around to every + ! function that might cause an error + call register_model(model) + + ! initialise model diagnostics \ + + call glide_init_diag(model) + + ! optional unit tests + + if (test_halo) then + call glissade_test_halo (model) + call parallel_finalise + endif + + if (test_transport) then + where (model%geometry%thck > model%numerics%thklim) + model%geometry%thck = thk_init/thk0 + elsewhere + model%geometry%thck = 0.d0 + endwhere + endif + + ! Initial solve of calcbwat + ! TODO: Should call to calcbwat go here or in diagnostic solve routine? Make sure consistent with Glide. + call calcbwat(model, & + model%options%whichbwat, & + model%temper%bmlt, & + model%temper%bwat, & + model%temper%bwatflx, & + model%geometry%thck, & + model%geometry%topg, & + model%temper%temp(model%general%upn,:,:), & + GLIDE_IS_FLOAT(model%geometry%thkmask), & + model%tempwk%wphi) + + end subroutine glissade_initialise + +!======================================================================= + + subroutine glissade_tstep(model, time) + + ! Perform time-step of an ice model instance with the Glissade dycore + + use parallel + + use glimmer_paramets, only: tim0, len0, vel0, thk0 + use glimmer_scales, only: scale_acab + use glimmer_physcon, only: scyr + !TODO - Remove glissade_temp option + use glissade_temp, only: glissade_temp_driver + use glissade_therm, only: glissade_therm_driver, glissade_temp2enth, glissade_enth2temp + use glide_mask, only: glide_set_mask, calc_iareaf_iareag + use glide_ground, only: glide_marinlim + use glide_grid_operators + use isostasy + use glissade_enthalpy + use glissade_transport, only: glissade_transport_driver, glissade_check_cfl, ntracer + use glissade_grid_operators + use glide_thck, only: glide_calclsrf + use glide_bwater + + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + real(dp), intent(in) :: time ! current time in years + + ! --- Local variables --- + + integer :: sc ! subcycling index + + ! temporary thck and acab arrays in SI units + real(dp), dimension(model%general%ewn,model%general%nsn) :: & + thck_unscaled, &! ice thickness (m) + acab_unscaled ! surface mass balance (m/s) + + ! temporary variables needed to reset geometry for the EVOL_NO_THICKNESS option + real(dp), dimension(model%general%ewn,model%general%nsn) :: thck_old + real(dp), dimension(model%general%ewn-1,model%general%nsn-1) :: stagthck_old + + ! temporary bmlt array + real(dp), dimension(model%general%ewn,model%general%nsn) :: & + bmlt_continuity ! = bmlt if basal mass balance is included in continuity equation + ! else = 0 + + logical :: do_upwind_transport ! logical for whether transport code should do upwind transport or incremental remapping + ! set to true for EVOL_UPWIND, else = false + + integer :: i, j, k + integer :: nx, ny + integer :: ewn, nsn, upn + + !WHL - debug + real(dp) :: thck_west, thck_east, dthck, u_west, u_east + + ewn = model%general%ewn + nsn = model%general%nsn + upn = model%general%upn + + ! ======================== + + ! Update internal clock + model%numerics%time = time + model%numerics%timecounter = model%numerics%timecounter + 1 + model%temper%newtemps = .false. + + ! optional transport test + ! code execution will end when this is done + if (test_transport) then + call glissade_test_transport (model) + return + endif + + ! ------------------------------------------------------------------------ + ! calculate geothermal heat flux + ! ------------------------------------------------------------------------ + !TODO Not sure if this is in the right place. G1=f(G0,T0) and T1=g(G0,T0) + ! If we update G1 now, then we will be doing T1=g(G1,T0). + if (model%options%gthf == GTHF_COMPUTE) then + call not_parallel(__FILE__,__LINE__) + call calc_lithot(model) + end if + + ! ------------------------------------------------------------------------ + ! Calculate temperature evolution and Glen's A, if necessary + ! Vertical diffusion and strain heating only; no advection + ! ------------------------------------------------------------------------ + + ! Note: These times have units of years + ! dttem has scaled units, so multiply by tim0/scyr to convert to years + + if ( model%numerics%tinc > mod(model%numerics%time,model%numerics%dttem*tim0/scyr)) then + + call t_startf('glissade_therm_driver') + + !TODO - Remove glissade_temp option + if (call_glissade_therm) then + + if (main_task .and. verbose_glissade) print*, 'Call glissade_therm_driver' + + ! Note: glissade_therm_driver uses SI units + ! Output arguments are temp, waterfrac and bmlt + call glissade_therm_driver (model%options%whichtemp, & + model%numerics%dttem*tim0, & ! s + model%general%ewn, model%general%nsn, & + model%general%upn, & + model%numerics%idiag_local, model%numerics%jdiag_local, & + model%numerics%rdiag_local, & + model%numerics%sigma, model%numerics%stagsigma, & + model%numerics%thklim*thk0, model%numerics%thklim_temp*thk0, & ! m + model%geometry%thck*thk0, & ! m + model%geometry%topg*thk0, model%climate%eus*thk0, & ! m + model%climate%artm, & ! deg C + model%temper%bheatflx, model%temper%bfricflx, & ! W/m2 + model%temper%dissip, & ! deg/s + model%temper%bwat*thk0, & ! m + model%temper%temp, & ! deg C + model%temper%waterfrac, & ! unitless + model%temper%bmlt) ! m/s on output + + ! convert bmlt from m/s to scaled model units + model%temper%bmlt = model%temper%bmlt * tim0/thk0 + + else + if (main_task .and. verbose_glissade) print*, 'Call glissade_temp_driver' + call glissade_temp_driver(model, model%options%whichtemp) + endif + call t_stopf('glissade_therm_driver') + + model%temper%newtemps = .true. + + ! Update basal hydrology, if needed + call calcbwat( model, & + model%options%whichbwat, & + model%temper%bmlt, & + model%temper%bwat, & + model%temper%bwatflx, & + model%geometry%thck, & + model%geometry%topg, & + model%temper%temp(model%general%upn,:,:), & + GLIDE_IS_FLOAT(model%geometry%thkmask), & + model%tempwk%wphi) + + end if ! take a temperature time step + + !------------------------------------------------------------------------ + ! Halo updates + !------------------------------------------------------------------------ + + call parallel_halo(model%temper%bwat) !TODO: not sure halo update is needed for bwat + + ! ------------------------------------------------------------------------ + ! Calculate flow evolution by various different methods + ! ------------------------------------------------------------------------ + ! MJH: This now uses velocity from the previous time step, which is appropriate for a Forward Euler time-stepping scheme + ! WHL: We used to have EVOL_NO_THICKNESS = -1 as a Glide option, used to hold the ice surface elevation fixed during CESM runs. + ! This option has been replaced by a Glint option, evolve_ice. + ! We now have EVOL_NO_THICKESS = 5 as a glam/glissade option. It is used to hold the ice surface elevation fixed + ! while allowing temperature to evolve, which can be useful for model spinup. This option might need more testing. + + select case(model%options%whichevol) + + case(EVOL_INC_REMAP, EVOL_UPWIND, EVOL_NO_THICKNESS) + + if (model%options%whichevol == EVOL_UPWIND) then + do_upwind_transport = .true. + else + do_upwind_transport = .false. + endif + + ! Use incremental remapping scheme to transport ice thickness (and temperature too, if whichtemp = TEMP_PROGNOSTIC). + ! MJH: I put the no thickness evolution option here so that it is still possible + ! (but not required) to use IR to advect temperature when thickness evolution is turned off. + + ! TODO MJH If we really want to support no evolution, then we may want to implement it so that IR does not occur + ! at all - right now a run can fail because of a CFL violation in IR even if evolution is turned off. Do we want + ! to support temperature evolution without thickness evolution? If so, then the current implementation may be preferred approach. + + if (model%options%whichevol == EVOL_NO_THICKNESS) then + ! store old thickness + thck_old = model%geometry%thck + stagthck_old = model%geomderv%stagthck + endif + + call t_startf('inc_remap_driver') + + if (main_task) then + print *, 'Compute dH/dt' + endif + + ! Halo updates for velocities, thickness and tracers + ! Velocity update might be needed if velo was not updated in halo at the end of the previous diagnostic solve + ! (just to be on the safe side). + + call t_startf('new_remap_halo_upds') + + call staggered_parallel_halo(model%velocity%uvel) + call staggered_parallel_halo(model%velocity%vvel) + + call parallel_halo(model%geometry%thck) + call parallel_halo(model%temper%temp) + + if (model%options%whichtemp == TEMP_ENTHALPY) then + call parallel_halo(model%temper%waterfrac) + endif + + call t_stopf('new_remap_halo_upds') + + call t_startf('glissade_transport_driver') + + if (model%options%basal_mbal == BASAL_MBAL_CONTINUITY) then ! include bmlt in continuity equation + bmlt_continuity(:,:) = model%temper%bmlt(:,:) * thk0/tim0 ! convert to m/s + else ! do not include bmlt in continuity equation + bmlt_continuity(:,:) = 0.d0 + endif + + ! --- First determine CFL limits --- + ! Note we are using the subcycled dt here (if subcycling is on). + ! (see note above about the EVOL_NO_THICKNESS option and how it is affected by a CFL violation) + ! stagthck, dusrfdew/ns and u/vvel need to be from the previous time step (and are at this point) + call glissade_check_cfl(model%general%ewn, model%general%nsn, model%general%upn-1, & + model%numerics%dew * len0, model%numerics%dns * len0, model%numerics%sigma, & + model%geomderv%stagthck * thk0, & + model%geomderv%dusrfdew*thk0/len0, model%geomderv%dusrfdns*thk0/len0, & + model%velocity%uvel * scyr * vel0, model%velocity%vvel * scyr * vel0, & + model%numerics%dt_transport * tim0 / scyr, & + model%numerics%adv_cfl_dt, model%numerics%diff_cfl_dt ) + + ! Call the transport driver. + ! Note: This subroutine assumes SI units: + ! * dt (s) + ! * dew, dns, thck (m) + ! * uvel, vvel, acab, blmt (m/s) + ! Since thck has intent(inout), we create and pass a temporary array with units of m. + ! TODO - Pass ice age as tracer 2 + + do sc = 1, model%numerics%subcyc + if (model%numerics%subcyc > 1 .and. main_task) write(*,*) 'Subcycling transport: Cycle ',sc + + ! temporary in/out arrays in SI units (m) + thck_unscaled(:,:) = model%geometry%thck(:,:) * thk0 + acab_unscaled(:,:) = model%climate%acab(:,:) * thk0/tim0 + + if (model%options%whichtemp == TEMP_PROGNOSTIC) then ! Use IR to transport thickness, temperature + ! (and other tracers, if present) + ! Note: We are passing arrays in SI units. + + call glissade_transport_driver(model%numerics%dt_transport * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + ntracer, & + model%velocity%uvel(:,:,:) * vel0, & + model%velocity%vvel(:,:,:) * vel0, & + thck_unscaled(:,:), & + acab_unscaled(:,:), & + bmlt_continuity(:,:), & + model%temper%temp(:,:,:), & + upwind_transport_in = do_upwind_transport ) + + ! convert thck and acab back to scaled units + model%geometry%thck(:,:) = thck_unscaled(:,:) / thk0 + model%climate%acab(:,:) = acab_unscaled(:,:) / (thk0/tim0) + + elseif (model%options%whichtemp == TEMP_ENTHALPY) then ! Use IR to transport thickness and enthalpy + + ! Derive enthalpy from temperature and waterfrac + ! Note: glissade_temp2enth expects SI units + do j = 1, model%general%nsn + do i = 1, model%general%ewn + call glissade_temp2enth (model%numerics%stagsigma(1:upn-1), & + model%temper%temp(0:upn,i,j), model%temper%waterfrac(1:upn-1,i,j), & + model%geometry%thck(i,j)*thk0, model%temper%enthalpy(0:upn,i,j)) + enddo + enddo + + ! Transport fields, with enthalpy as a tracer instead of temperature + call glissade_transport_driver(model%numerics%dt_transport * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + ntracer, & + model%velocity%uvel(:,:,:) * vel0, & + model%velocity%vvel(:,:,:) * vel0, & + thck_unscaled(:,:), & + acab_unscaled(:,:), & + bmlt_continuity(:,:), & + model%temper%enthalpy(:,:,:), & + upwind_transport_in = do_upwind_transport ) + + else ! Use IR to transport thickness only + ! Note: In glissade_transport_driver, the ice thickness is transported layer by layer, + ! which is inefficient if no tracers are being transported. (It would be more + ! efficient to transport thickness in one layer only, using a vertically + ! averaged velocity.) + ! Not sure if this option will be used in practice. + + call glissade_transport_driver(model%numerics%dt_transport * tim0, & + model%numerics%dew * len0, model%numerics%dns * len0, & + model%general%ewn, model%general%nsn, & + model%general%upn-1, model%numerics%sigma, & + ntracer, & + model%velocity%uvel(:,:,:) * vel0, & + model%velocity%vvel(:,:,:) * vel0, & + thck_unscaled(:,:), & + acab_unscaled(:,:), & + bmlt_continuity(:,:) , & + upwind_transport_in = do_upwind_transport ) + + endif ! whichtemp + + ! convert thck and acab back to scaled units + model%geometry%thck(:,:) = thck_unscaled(:,:) / thk0 + model%climate%acab(:,:) = acab_unscaled(:,:) / (thk0/tim0) + + if (verbose_glissade) then + print*, ' ' + print*, 'After glissade_transport_driver:' + print*, 'max, min thck (m)=', maxval(model%geometry%thck)*thk0, minval(model%geometry%thck)*thk0 + print*, 'max, min acab (m/yr) =', maxval(model%climate%acab)*scale_acab, minval(model%climate%acab)*scale_acab + print*, 'max, min artm =', maxval(model%climate%artm), minval(model%climate%artm) + print*, 'thklim =', model%numerics%thklim * thk0 + print*, 'max, min temp =', maxval(model%temper%temp), minval(model%temper%temp) + print*, ' ' + print*, 'thck:' + do j = model%general%nsn, 1, -1 + do i = 1, model%general%ewn + write(6,'(f6.0)',advance='no') model%geometry%thck(i,j) * thk0 + enddo + write(6,*) ' ' + enddo + endif + + ! Update halos of modified fields + + call t_startf('after_remap_haloupds') + + call parallel_halo(model%geometry%thck) + + if (model%options%whichtemp == TEMP_ENTHALPY) then + + ! Update enthalpy in halo cells + call parallel_halo(model%temper%enthalpy) + + ! Derive new temperature and waterfrac from enthalpy (will be correct in halo cells) + ! Note: glissade_enth2temp expects SI units + do j = 1, model%general%nsn + do i = 1, model%general%ewn + call glissade_enth2temp(model%numerics%stagsigma(1:upn-1), & + model%geometry%thck(i,j)*thk0, model%temper%enthalpy(0:upn,i,j), & + model%temper%temp(0:upn,i,j), model%temper%waterfrac(1:upn-1,i,j)) + enddo + enddo + + else ! update temperature in halo cells + + call parallel_halo(model%temper%temp) + + endif ! TEMP_ENTHALPY + + ! NOTE: Halo updates of other tracers, if present, should go here + + call t_stopf('after_remap_haloupds') + + enddo ! subcycling + + call t_stopf('glissade_transport_driver') + + call t_stopf('inc_remap_driver') + + if (model%options%whichevol == EVOL_NO_THICKNESS) then + ! restore old thickness + model%geometry%thck = thck_old + model%geomderv%stagthck = stagthck_old + endif + + end select + + ! TODO: Not sure topg should be updated here; should be updated after isostasy + ! if the isostasy is turned on. + call parallel_halo(model%geometry%topg) + + !------------------------------------------------------------------------ + ! Update the upper and lower ice surface + ! Note that glide_calclsrf loops over all cells, including halos, + ! so halo updates are not needed for lsrf and usrf. + !------------------------------------------------------------------------ + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%geometry%lsrf) + + model%geometry%usrf(:,:) = max(0.d0, model%geometry%thck(:,:) + model%geometry%lsrf(:,:)) + + ! --- Calculate updated mask because marinlim calculation needs a mask. + + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask) + + !TODO - Look at marinlim more carefully and see which halo updates are necessary. + ! It appears that marinlim only needs the halo of thkmask for case 5 (which was removed). + ! + ! glide_set_mask includes a halo update of model%geometry%thkmask; remove this one? + ! Do we need a halo update for relx? If so, should this be done at initialization? + + call parallel_halo(model%geometry%thkmask) + call parallel_halo(model%isostasy%relx) + + ! ------------------------------------------------------------------------ + ! Remove ice which is either floating, or is present below prescribed depth, + ! depending on value of whichmarn + ! ------------------------------------------------------------------------ + + call glide_marinlim(model%options%whichmarn, & + model%geometry%thck, & + model%isostasy%relx, & + model%geometry%topg, & + model%geometry%thkmask, & + model%numerics%mlimit, & + model%numerics%calving_fraction, & + model%climate%eus, & + model%climate%calving, & + model%ground, & + model%numerics%dew, & + model%numerics%dns, & + model%general%nsn, & + model%general%ewn) + + !TODO: Think about what halo updates are needed after glide_marinlim. Just thck and thkmask? + + ! halo updates + call parallel_halo(model%geometry%thck) ! Updated halo values of thck are needed below in calc_lsrf + + !TODO - Remove this call to glide_set_mask? + ! This subroutine is called at the beginning of glissade_velo_driver, + ! so a call here is not needed for the velo diagnostic solve. + ! The question is whether it is needed for the isostasy. + + ! --- marinlim adjusts thickness for calved ice. Therefore the mask needs to be recalculated. + ! --- This time we want to calculate the optional arguments iarea and ivol because thickness + ! --- will not change further during this time step. + + call glide_set_mask(model%numerics, & + model%geometry%thck, model%geometry%topg, & + model%general%ewn, model%general%nsn, & + model%climate%eus, model%geometry%thkmask, & + model%geometry%iarea, model%geometry%ivol) + + !Note: glide_set_mask includes a halo update of model%geometry%thkmask at end of call + ! call parallel_halo(model%geometry%thkmask) + + ! --- Calculate global area of ice that is floating and grounded. + !TODO May want to calculate iareaf and iareag in glide_write_diag and remove those calculations here. + + call calc_iareaf_iareag(model%numerics%dew, model%numerics%dns, & + model%geometry%thkmask, & + model%geometry%iareaf, model%geometry%iareag) + + !TODO - Are these isostasy calls in the right place? + ! Consider for a forward Euler time step: + ! With a relaxing mantle model, topg is a prognostic (time-evolving) variable (I think): + ! topg1 = f(topg0, thk0, ...) + ! However, for a fluid mantle where the adjustment is instantaneous, topg is a diagnostic variable + !(comparable to calculating floatation height of ice in the ocean): + ! topg1 = f(thk1) + ! In either case, the topg update should be separate from the thickness evolution (because thk1 = f(thk0, vel0=g(topg0,...)). + ! However, if the isostasy calculation needs topg0, the icewaterload call should be made BEFORE thck is updated. + ! If the isostasy calculation needs topg1, the icewaterload call should be made AFTER thck is updated. + ! Also, we should think about when marinlim, usrf, lsrf, derivatives should be calculated relative to the topg update via isostasy. + + ! ------------------------------------------------------------------------ + ! update ice/water load if necessary + ! ------------------------------------------------------------------------ + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + if (model%numerics%time >= model%isostasy%next_calc) then + model%isostasy%next_calc = model%isostasy%next_calc + model%isostasy%period + call isos_icewaterload(model) + model%isostasy%new_load = .true. + end if + end if + + ! calculate isostatic adjustment and upper and lower ice surface + + ! ------------------------------------------------------------------------ + ! Calculate isostasy + ! ------------------------------------------------------------------------ + + !TODO - Test the local isostasy schemes in the parallel model. + ! The elastic lithosphere scheme is not expected to work in parallel. + + if (model%options%isostasy == ISOSTASY_COMPUTE) then + call isos_compute(model) + end if + + ! ------------------------------------------------------------------------ + ! Calculate diagnostic variables, including velocity + ! ------------------------------------------------------------------------ + + call glissade_diagnostic_variable_solve(model) + + !TODO - Any halo updates needed at the end of glissade_tstep? + + end subroutine glissade_tstep + +!======================================================================= + + subroutine glissade_diagnostic_variable_solve(model) + + ! Solve diagnostic (not time-dependent) variables, in particular the ice velocity. + ! This is needed at the end of each time step once the prognostic variables (thickness, tracers) have been updated. + ! It is also needed to fill out the initial state from the fields that have been read in. + + use parallel + + use glimmer_paramets, only: tim0, len0, vel0, thk0, vis0, tau0, evs0 + use glimmer_physcon, only: scyr + use glide_thck, only: glide_calclsrf + use glissade_temp, only: glissade_calcflwa + use glam_velo, only: glam_velo_driver, glam_basal_friction + use glissade_velo, only: glissade_velo_driver + use glide_velo, only: wvelintg + use glissade_masks, only: glissade_get_masks + use glissade_therm, only: glissade_interior_dissipation_sia, & + glissade_interior_dissipation_first_order, & + glissade_flow_factor + use glam_grid_operators, only: glam_geometry_derivs + use felix_dycore_interface, only: felix_velo_driver + + implicit none + + type(glide_global_type), intent(inout) :: model ! model instance + + ! Local variables + + integer :: i, j, k + integer, dimension(model%general%ewn, model%general%nsn) :: & + ice_mask, &! = 1 where thck > thklim, else = 0 + floating_mask ! = 1 where ice is floating, else = 0 + + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + ! 1. First part of diagnostic solve: + ! Now that advection is done, update geometry- and temperature-related + ! diagnostic fields that are needed for the velocity solve. + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------ + ! Halo updates for ice topography and thickness + ! + ! NOTE: There is an optional argument periodic_offset_ew for topg. + ! This is for ismip-hom experiments. A positive EW offset means that + ! the topography in west halo cells will be raised, and the topography + ! in east halo cells will be lowered. This ensures that the topography + ! and upper surface elevation are continuous between halo cells + ! and locally owned cells at the edge of the global domain. + ! In other cases (anything but ismip-hom), periodic_offset_ew = periodic_offset_ns = 0, + ! and this argument will have no effect. + ! ------------------------------------------------------------------------ + + call parallel_halo(model%geometry%thck) + call parallel_halo(model%geometry%topg, periodic_offset_ew = model%numerics%periodic_offset_ew) + + ! ------------------------------------------------------------------------ + ! Update the upper and lower ice surface + ! Note that glide_calclsrf loops over all cells, including halos, + ! so halo updates are not needed for lsrf and usrf. + ! ------------------------------------------------------------------------ + + call glide_calclsrf(model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%geometry%lsrf) + + model%geometry%usrf(:,:) = max(0.d0, model%geometry%thck(:,:) + model%geometry%lsrf(:,:)) + + ! ------------------------------------------------------------------------ + ! Update some geometry derivatives + ! ------------------------------------------------------------------------ + !Note - The fields computed by glam_geometry_derivs are not required by + ! the Glissade velocity solver (which computes them internally). + ! However, some of the fields (stagthck, dusrfdew and dusrfdns) + ! are needed during the next timestep by glissade_temp + ! if we're doing shallow-ice dissipation. + !TODO - Replace this glam_geometry_derivs call with calls to Glissade subroutines? + ! (The glam_velo driver includes its own call to glam_geometry_derivs.) + + call glam_geometry_derivs(model) + + ! ------------------------------------------------------------------------ + ! Update some masks that are used by Glissade subroutines + ! ------------------------------------------------------------------------ + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%numerics%thklim, & + ice_mask, floating_mask) + + ! ------------------------------------------------------------------------ + ! Calculate Glen's A + ! + ! Notes: + ! (1) Because flwa is not a restart variable in Glissade, no check is included + ! here for whether to calculate it on initial time (as is done in Glide). + ! (2) We are passing in only vertical elements (1:upn-1) of the temp array, + ! so that it has the same vertical dimensions as flwa. + ! (3) The flow enhancement factor is 1 by default. + ! (4) The waterfrac field is ignored unless whichtemp = TEMP_ENTHALPY. + ! (5) Inputs and outputs of glissade_flow_factor should have SI units. + ! ------------------------------------------------------------------------ + + call glissade_flow_factor(model%options%whichflwa, & + model%options%whichtemp, & + model%numerics%stagsigma, & + model%geometry%thck * thk0, & ! scale to m + ice_mask, & + model%temper%temp(1:model%general%upn-1,:,:), & + model%temper%flwa, & ! Pa^{-n} s^{-1} + model%paramets%default_flwa / scyr, & ! scale to Pa^{-n} s^{-1} + model%paramets%flow_enhancement_factor, & + model%temper%waterfrac(:,:,:)) + + ! Change flwa to model units (glissade_flow_factor assumes SI units of Pa{-n} s^{-1}) + model%temper%flwa(:,:,:) = model%temper%flwa(:,:,:) / vis0 + + !TODO - flwa halo update not needed? + ! Halo update for flwa + call parallel_halo(model%temper%flwa) + + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + ! 2. Second part of diagnostic solve: + ! Now that geometry- and temperature-related diagnostic fields are updated, + ! solve velocity. + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + + ! Do not solve velocity for initial time on a restart because that breaks an exact restart. + + if ( (model%options%is_restart == RESTART_TRUE) .and. & + (model%numerics%time == model%numerics%tstart) ) then + + call write_log('Using uvel, vvel from restart file at initial time') + + else + + ! If this is not a restart or we are not at the initial time, then proceed normally. + + if ( (model%numerics%time == model%numerics%tstart) .and. & + ( (maxval(abs(model%velocity%uvel)) /= 0.0d0) .or. & + (maxval(abs(model%velocity%vvel)) /= 0.0d0) ) ) then + ! If velocity was input and this is NOT a restart, then use the input field as the first guess at the initial time. + ! This happens automatically, but let the user know. + ! Using this value will change the answer only within the tolerance of the nonlinear solve. + ! If a user already has a good guess from a previous run, they may wish to start things off with it to speed the initial solution. + call write_log('Using uvel, vvel from input file as initial guess at initial time.') + call write_log('If this is not desired, please remove those fields from the input file.') + endif + + if (main_task) then + print *, ' ' + print *, 'Compute ice velocities, time =', model%numerics%time + endif + + !! extrapolate value of mintauf into halos to enforce periodic lateral bcs (only if field covers entire domain) + if (model%options%which_ho_babc == HO_BABC_YIELD_PICARD) then + call staggered_parallel_halo_extrapolate(model%basalproc%mintauf) + endif + + ! Call the appropriate velocity solver + + select case (model%options%whichdycore) + case ( DYCORE_GLAM ) ! glam finite-difference + + call t_startf('glam_velo_driver') + call glam_velo_driver(model) + call t_stopf('glam_velo_driver') + + case ( DYCORE_GLISSADE ) ! glissade finite-element + + call t_startf('glissade_velo_driver') + call glissade_velo_driver(model) + call t_stopf('glissade_velo_driver') + + case ( DYCORE_ALBANYFELIX) + + call t_startf('felix_velo_driver') + call felix_velo_driver(model) + call t_stopf('felix_velo_driver') + + end select + + ! Compute internal heat dissipation + ! This is used in the prognostic temperature calculation during the next time step. + ! Note: These glissade subroutines assume SI units on input and output + + model%temper%dissip(:,:,:) = 0.d0 + + if (model%options%which_ho_disp == HO_DISP_SIA) then + + call glissade_interior_dissipation_sia(model%general%ewn, & + model%general%nsn, & + model%general%upn, & + model%numerics%stagsigma(:), & + ice_mask, & +! model%geomderv%stagthck, & +! model%temper%flwa, & +! model%geomderv%dusrfdew, & +! model%geomderv%dusrfdns, & + model%geomderv%stagthck * thk0, & ! scale to m + model%temper%flwa * vis0, & ! scale to Pa^{-n} s^{-1} + model%geomderv%dusrfdew * thk0/len0, & ! scale to m/m + model%geomderv%dusrfdns * thk0/len0, & ! scale to m/m + model%temper%dissip) + + else ! first-order dissipation + call glissade_interior_dissipation_first_order(model%general%ewn, & + model%general%nsn, & + model%general%upn, & + ice_mask, & + model%stress%tau%scalar * tau0, & ! scale to Pa + model%stress%efvs * evs0, & ! scale to Pa s + model%temper%dissip) + + endif ! which_ho_disp + + ! If running Glam, compute the basal friction heat flux + ! (Glissade computes this flux as part of the velocity solution.) + + if (model%options%whichdycore == DYCORE_GLAM) then + call glam_basal_friction(model%general%ewn, & + model%general%nsn, & + ice_mask, & + floating_mask, & + model%velocity%uvel(model%general%upn,:,:), & + model%velocity%vvel(model%general%upn,:,:), & + model%velocity%btraction(:,:,:), & + model%temper%bfricflx(:,:) ) + endif + + if (this_rank==model%numerics%rdiag_local .and. verbose_glissade) then + i = model%numerics%idiag_local + j = model%numerics%jdiag_local + print*, 'k, dissip (deg/yr):' + do k = 1, model%general%upn-1 + print*, k, model%temper%dissip(k,i,j)*scyr + enddo + print*, 'ubas, vbas =', model%velocity%uvel(model%general%upn,i,j), & + model%velocity%vvel(model%general%upn,i,j) + print*, 'btraction =', model%velocity%btraction(:,i,j) + print*, 'bfricflx =', model%temper%bfricflx(i,j) + endif + + if (main_task .and. verbose_glissade) then + print*, ' ' + print*, 'After glissade velocity solve: uvel, k = 1:' + do i = 1, model%general%ewn-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f8.2)',advance='no') model%velocity%uvel(1,i,j) * (vel0*scyr) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'After glissade velocity solve: vvel, k = 1:' + do i = 1, model%general%ewn-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = model%general%nsn-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, model%general%ewn-1 + write(6,'(f8.2)',advance='no') model%velocity%vvel(1,i,j) * (vel0*scyr) + enddo + print*, ' ' + enddo + endif ! main_task & verbose_glissade + + endif ! is_restart + + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + ! 3. Third part of diagnostic solve: + ! Now that velocity is solved, calculate any diagnostic fields that are + ! a function of velocity. + ! ------------------------------------------------------------------------ + ! ------------------------------------------------------------------------ + + ! compute the velocity norm and basal velocity (for diagnostic output) + + k = model%general%upn + model%velocity%ubas(:,:) = model%velocity%uvel(k,:,:) + model%velocity%vbas(:,:) = model%velocity%vvel(k,:,:) + model%velocity%velnorm(:,:,:) = sqrt(model%velocity%uvel(:,:,:)**2 + model%velocity%vvel(:,:,:)**2) + + ! Copy uvel and vvel to arrays uvel_extend and vvel_extend. + ! These arrays have horizontal dimensions (nx,ny) instead of (nx-1,ny-1). + ! Thus they are better suited for I/O if we have periodic BC, + ! where the velocity field we are solving for has global dimensions (nx,ny). + ! Since uvel and vvel are not defined for i = nx or j = ny, the + ! uvel_extend and vvel_extend arrays will have values of zero at these points. + ! But these are halo points, so when we write netCDF I/O it shouldn't matter; + ! we should have the correct values at physical points. + + model%velocity%uvel_extend(:,:,:) = 0.d0 + model%velocity%vvel_extend(:,:,:) = 0.d0 + + do j = 1, model%general%nsn-1 + do i = 1, model%general%ewn-1 + model%velocity%uvel_extend(:,i,j) = model%velocity%uvel(:,i,j) + model%velocity%vvel_extend(:,i,j) = model%velocity%vvel(:,i,j) + enddo + enddo + + ! Calculate wvel, assuming grid velocity is 0. + ! This is calculated relative to ice sheet base, rather than a fixed reference location + ! Note: This current implementation for wvel only supports whichwvel=VERTINT_STANDARD + call wvelintg(model%velocity%uvel, & + model%velocity%vvel, & + model%geomderv, & + model%numerics, & + model%velowk, & + model%geometry%thck * 0.0d0, & ! Just need a 2d array of all 0's for wgrd + model%geometry%thck, & + model%temper%bmlt, & + model%velocity%wvel_ho) + ! Note: halos may be wrong for wvel_ho, but since it is currently only used as an output diagnostic variable, that is OK. + + !TODO - I don't think we need to update ubas, vbas, or velnorm, since these are diagnostic only + ! Also, I don't think efvs is needed in the halo. + call staggered_parallel_halo(model%velocity%velnorm) + call staggered_parallel_halo(model%velocity%ubas) + call staggered_parallel_halo(model%velocity%vbas) + call parallel_halo(model%stress%efvs) + + end subroutine glissade_diagnostic_variable_solve + +!======================================================================= + +end module glissade + +!======================================================================= diff --git a/components/cism/glimmer-cism/libglissade/glissade_basal_traction.F90 b/components/cism/glimmer-cism/libglissade/glissade_basal_traction.F90 new file mode 100644 index 0000000000..4ec967f1f3 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_basal_traction.F90 @@ -0,0 +1,356 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_basal_traction.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#include "glide_mask.inc" +#include "config.inc" + + module glissade_basal_traction + + !----------------------------------------------------------------------------- + ! Compute or prescribe the basal traction coefficient 'beta' as required by + ! the higher-order velocity solver. + ! + ! Note that beta is assumed to be a positive constant. In earlier versions of + ! the code it was called 'betasquared'. + ! + ! The units are Pa/(m/yr) if we assume a linear sliding law of the form + ! taub_x = -beta * u, taub_y = -beta * v + ! + ! However, the units are Pa if beta is treated as a till yield stress. + ! + ! Current options are as follows: + ! + ! [0] constant value of 10 Pa/(m/yr) (useful for debugging) + ! [1] simple hard-coded pattern (useful for debugging) + ! [2] treat beta value as a till yield stress (in Pa) using Picard iteration + ! [3] linear (inverse) function of basal water depth (bwat) + ! [4] very large value for beta to enforce no slip everywhere + ! [5] beta field passed in from .nc input file as part of standard i/o + ! [6] no slip everywhere (using Dirichlet BC rather than large beta) + ! [7] treat beta value as till yield stress (in Pa) using Newton-type iteration (in devel.) + ! [8] set beta as prescribed for ISMIP-HOM test C (serial only) + ! [9] power law that used effective pressure + ! [10] Coulomb friction law + + ! TODO - Renumber HO_BABC options so that, for example, the no-slip options have small numbers? + !----------------------------------------------------------------------------- + + use glimmer_paramets, only : dp + use glimmer_physcon, only : scyr + use glimmer_paramets, only : vel0, tau0 + use glimmer_log + use glide_types + use parallel, only : staggered_parallel_halo + use glissade_grid_operators + + implicit none + +!*********************************************************************** + +contains + +!*********************************************************************** + + subroutine calcbeta (whichbabc, & + dew, dns, & + ewn, nsn, & + thisvel, othervel, & + bwat, beta_const, & + mintauf, basal_physics, & + flwa_basal, thck, & + mask, beta) + + ! subroutine to calculate map of beta sliding parameter, based on + ! user input ("whichbabc" flag, from config file as "which_ho_babc"). + + ! NOTE: Previously, the input arguments were assumed to be dimensionless + ! and were rescaled in this routine. Now the input arguments are + ! assumed to have the units given below. + + use glimmer_paramets, only: len0 + use glimmer_physcon, only: gn + use parallel, only: nhalo + + implicit none + + ! Input/output arguments + + integer, intent(in) :: whichbabc + integer, intent(in) :: ewn, nsn + + real(dp), intent(in) :: dew, dns ! m + real(dp), intent(in), dimension(:,:) :: thisvel, othervel ! basal velocity components (m/yr) + real(dp), intent(in), dimension(:,:) :: bwat ! basal water depth (m) + real(dp), intent(in), dimension(:,:) :: mintauf ! till yield stress (Pa) + real(dp), intent(in) :: beta_const ! spatially uniform beta (Pa yr/m) + type(glide_basal_physics), intent(in) :: basal_physics ! basal physics object + real(dp), intent(in), dimension(:,:) :: flwa_basal ! flwa for the basal ice layer + real(dp), intent(in), dimension(:,:) :: thck ! ice thickness + integer, intent(in), dimension(:,:) :: mask ! staggered grid mask + real(dp), intent(inout), dimension(:,:) :: beta ! (Pa yr/m) + +!WHL - These masks are no longer used +! logical, intent(in), dimension(:,:), optional :: & +! floating_mask, &! = 1 for cells where ice is present and is floating +! ocean_mask ! = 1 for cells where topography is below sea level and ice is absent +! ! Note: These masks live on the scalar grid; beta lives on the staggered grid + + ! Local variables + + real(dp) :: smallnum = 1.0d-2 ! m/yr + + integer :: ew, ns + + ! SFP added for making beta a function of basal water flux + real(dp), dimension(:,:), allocatable :: unstagbeta + real(dp) :: C, m + + real(dp) :: Ldomain ! size of full domain + real(dp) :: omega ! frequency of beta field + real(dp) :: dx, dy + integer :: ilo, ihi, jlo, jhi ! limits of beta field for ISHOM C case + integer :: i, j + + ! variables for power law + real(dp) :: p, q + + ! variables for Coulomb friction law + real(dp) :: Coulomb_C ! friction coefficient + real(dp) :: lambda_max ! wavelength of bedrock bumps at subgrid scale + real(dp) :: m_max ! maximum bed obstacle slope + real(dp), dimension(size(beta,1), size(beta,2)) :: big_lambda ! bed rock characteristics + integer, dimension(size(thck,1), size(thck,2)) :: imask ! ice grid mask 1=ice, 0=no ice + real(dp), dimension(size(beta,1), size(beta,2)) :: flwa_basal_stag ! flwa for the basal ice layer on the staggered grid + + + select case(whichbabc) + + case(HO_BABC_CONSTANT) ! spatially uniform value; useful for debugging and test cases + +! beta(:,:) = 10.d0 ! This is the default value (Pa yr/m) + beta(:,:) = beta_const ! Pa yr/m + + ! If floating and ocean masks are passed in, then set beta to zero for shelf/ocean nodes, + ! overriding the constant value set above. This allows us to model large regions + ! (e.g., a whole ice sheet) in a simple but physically sensible way without specifying + ! a 2D beta field. + ! + ! Note: A node must be surrounded by four floating or ocean cells to be considered + ! a shelf/ocean node. Nodes along the grounding line retain previous values of beta. + + !if (present(floating_mask) .and. present(ocean_mask)) then + ! do ns = 1, nsn-1 + ! do ew = 1, ewn-1 + ! if ( (floating_mask(ew,ns ) ==1 .or. ocean_mask(ew,ns) ==1) .and. & + ! (floating_mask(ew,ns+1) ==1 .or. ocean_mask(ew,ns+1) ==1) .and. & + ! (floating_mask(ew+1,ns) ==1 .or. ocean_mask(ew+1,ns) ==1) .and. & + ! (floating_mask(ew+1,ns+1)==1 .or. ocean_mask(ew+1,ns+1)==1) ) then + ! beta(ew,ns) = 0.d0 + ! endif + ! enddo + ! enddo + !endif + + case(HO_BABC_SIMPLE) ! simple pattern; also useful for debugging and test cases + ! (here, a strip of weak bed surrounded by stronger bed to simulate an ice stream) + + beta(:,:) = 1.d4 ! Pa yr/m + + !TODO - Change this loop to work in parallel (set beta on the global grid and scatter to local) + do ns=5, nsn-5 + do ew=1, ewn-1 + beta(ew,ns) = 100.d0 ! Pa yr/m + end do + end do + + case(HO_BABC_YIELD_PICARD) ! take input value for till yield stress and force beta to be implemented such + ! that plastic-till sliding behavior is enforced (see additional notes in documentation). + + !!! NOTE: Eventually, this option will provide the till yield stress as calculate from the basal processes + !!! submodel. Currently, to enable sliding over plastic till, simple specify the value of "beta" as + !!! if it were the till yield stress (in units of Pascals). + + beta(:,:) = mintauf(:,:) & ! plastic yield stress (Pa) + / dsqrt( thisvel(:,:)**2 + othervel(:,:)**2 + (smallnum)**2 ) ! velocity components (m/yr) + + !!! since beta is updated here, communicate that info to halos + call staggered_parallel_halo(beta) + + case(HO_BABC_BETA_BWAT) ! set value of beta as proportional to value of bwat + + !NOTE: This parameterization has not been scientifically tested. + !TODO - Test option HO_BABC_BETA_BWAT + ! Where do these constants come from? + C = 10.d0 ! Does this assume that bwat is in units of m or dimensionless? + m = 1.d0 + + allocate(unstagbeta(ewn,nsn)) + + unstagbeta(:,:) = 200.d0 ! Pa yr/m + ! This setting ensures that the parameterization does nothing. Remove it? + + where ( bwat > 0.d0 .and. unstagbeta > 200.d0 ) + unstagbeta = C / ( bwat**m ) + endwhere + + ! average beta from unstag grid onto stag grid + beta = 0.5d0 * ( unstagbeta(1:ewn-1,:) + unstagbeta(2:ewn,:) ) + beta = 0.5d0 * ( unstagbeta(:,1:nsn-1) + unstagbeta(:,2:nsn) ) + + deallocate(unstagbeta) + + !Note: This is redundant in that it could be implemented by using HO_BETA_CONST with beta_const = 1.d10 + ! But keeping it for historical reasons since many config files use it + + case(HO_BABC_LARGE_BETA) ! frozen (u=v=0) ice-bed interface + + beta(:,:) = 1.d10 ! Pa yr/m + + case(HO_BABC_ISHOMC) ! prescribe according to ISMIP-HOM test C + + !Note: Ideally, beta would be read in from an external netCDF file. + ! However, this is not possible given that the global velocity grid is smaller + ! than the ice grid and hence not able to fit the full beta field. + ! The following code sets beta on the full grid as prescribed by Pattyn et al. (2008). + !NOTE: This works only in serial! + + Ldomain = (ewn-2*nhalo) * dew ! size of full domain (must be square) + omega = 2.d0*pi / Ldomain + + ilo = nhalo + ihi = ewn-nhalo + jlo = nhalo + jhi = nsn-nhalo + + ! Prescribe beta as in Pattyn et al., The Cryosphere, 2008 + beta(:,:) = 0.d0 + do j = jlo, jhi + do i = ilo, ihi + dx = dew * (i-ilo) + dy = dns * (j-jlo) + beta(i,j) = 1000.d0 + 1000.d0 * sin(omega*dx) * sin(omega*dy) + enddo + enddo + + case(HO_BABC_EXTERNAL_BETA) ! use value passed in externally from CISM + + ! scale CISM input value to dimensional units of (Pa yr/m) + + ! beta is initialized to a negative value; we can use that fact to check whether + ! it has been read correctly from the file + if (maxval(beta) <= 0.d0) then + call write_log('ERROR: Trying to use HO_BABC_EXTERNAL_BETA, but all beta values are <= 0,') + call write_log('which implies that beta could not be read from the input file.') + call write_log('Make sure that beta is in the cism input file,') + call write_log('or change which_ho_babc to a different option.') + call write_log('Invalid value for beta. See log file for details.', GM_FATAL) + end if + +!! beta(:,:) = beta(:,:) * ( tau0 / vel0 / scyr ) ! already dimensional + + ! this is a check for NaNs, which indicate, and are replaced by no slip + + do ns=1, nsn-1 + do ew=1, ewn-1 + if( beta(ew,ns) /= beta(ew,ns) )then + beta(ew,ns) = 1.d10 ! Pa yr/m + endif + end do + end do + + case(HO_BABC_POWERLAW) ! A power law that uses effective pressure + ! See Cuffey & Paterson, Physics of Glaciers, 4th Ed. (2010), p. 240, eq. 7.17 + ! This is based on Weertman's classic sliding relation (1957) augmented by the bed-separation index described by Bindschadler (1983) + ! ub = k Taub^p N^-q + ! rearranging for Taub gives: + ! Taub = k^(-1/p) ub^(1/p) N^(q/p) + + ! p and q should be _positive_ exponents + ! TODO: p, q could be turned into config parameters instead of hard-coded + ! If p/=1, this is nonlinear in velocity + ! Cuffey & Paterson recommend p=3 and q=1, and k dependent on thermal & mechanical properties of ice and inversely on bed roughness. + p = 3.0d0; q = 1.0d0 + + beta = basal_physics%friction_powerlaw_k**(-1.0d0/p) * basal_physics%effecpress_stag**(q/p) & + * dsqrt( thisvel(:,:)**2 + othervel(:,:)**2 )**(1.0d0/p-1.0d0) + + case(HO_BABC_COULOMB_FRICTION) + + ! Basal stress representation using coulomb friction law + ! Coulomb sliding law: Schoof 2005 PRS, eqn. 6.2 (see also Pimentel, Flowers & Schoof 2010 JGR) + + ! Need flwa of the basal layer on the staggered grid + where (thck > 0.0) + imask = 1 + elsewhere + imask = 0 + end where + call glissade_stagger(ewn, nsn, & + flwa_basal, flwa_basal_stag, & + imask, stagger_margin_in = 1) + ! TODO Not sure if a halo update is needed on flwa_basal_stag! I don't think so if nhalo>=2. + + ! Setup parameters needed for the friction law + m_max = basal_physics%Coulomb_Bump_max_slope !maximum bed obstacle slope(unitless) + lambda_max = basal_physics%Coulomb_bump_wavelength ! wavelength of bedrock bumps (m) + ! biglambda = wavelength of bedrock bumps [m] * flwa [Pa^-n yr^-1] / max bed obstacle slope [dimensionless] + big_lambda = lambda_max / m_max * flwa_basal_stag + Coulomb_C = basal_physics%Coulomb_C ! Basal shear stress factor (Pa (m^-1 y)^1/3) + !gn ! Glen's flaw law from parameter module + + beta = Coulomb_C * basal_physics%effecpress_stag * & + (dsqrt(thisvel**2 + othervel**2 + smallnum**2))**(1.0d0/gn - 1.0d0) * & + ( & + dsqrt(thisvel**2 + othervel**2 + smallnum**2) + & + basal_physics%effecpress_stag**gn * big_lambda & + )**(-1.0d0/gn) + + ! for numerical stability purposes + where (beta>1.0d8) + beta = 1.0d8 + end where + + case default + ! do nothing + + end select + + ! check for areas where ice is floating and make sure beta in these regions is 0 + do ns=1, nsn-1 + do ew=1, ewn-1 + if( GLIDE_IS_FLOAT( mask(ew,ns) ) )then + beta(ew,ns) = 0.d0 + endif + end do + end do + + end subroutine calcbeta + +!*********************************************************************** + +end module glissade_basal_traction + +!*********************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_enthalpy.F90 b/components/cism/glimmer-cism/libglissade/glissade_enthalpy.F90 new file mode 100644 index 0000000000..945158a860 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_enthalpy.F90 @@ -0,0 +1,681 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_enthalpy.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module computes temperature diffusion, strain heating, and local +! melting and refreezing in each ice column using enthalpy as the +! primary state variable. + +#include "glide_mask.inc" + +!TODO - The glissade_enthalpy module needs to be tested. +! Also, we may want to reorganize a bit to reduce the amount of duplicate code. +module glissade_enthalpy + + use glimmer_global, only : dp + use glide_types + use glimmer_log + + implicit none + + private + public :: glissade_init_enthalpy, glissade_enthalpy_findvtri, & + enth2temp, temp2enth, glissade_enthalpy_calcbmlt + + !WHL - debug + integer :: itest, jtest, rtest + +!-------------------------------------------------------------------------------- + +contains + +!-------------------------------------------------------------------------------- + + subroutine glissade_init_enthalpy (model) + + ! initialization for the enthalpy scheme + use glimmer_physcon, only : rhoi, shci, coni, scyr, grav, gn, lhci, rhow, trpt + use glimmer_paramets, only : thk0, tim0 + + type(glide_global_type),intent(inout) :: model ! ice model parameters + + !BDM - dups(1) and dups(2) are done in glissade_init_temp + + ! write out cons(1) which is coefficient before diffusion terms + ! thk0 is just a scaling parameter, not actual thickness at ew, ns + model%tempwk%cons(1) = tim0 * model%numerics%dttem/ (2.0d0 * thk0**2) + + end subroutine glissade_init_enthalpy + +!-------------------------------------------------------------------------------- + + subroutine glissade_enthalpy_findvtri (model, ew, ns, & + subd, diag, supd, rhsd, & + float, alpha_enth) + + ! solve for tridiagonal entries of sparse matrix + use glimmer_physcon, only : rhoi, shci, lhci, rhow, grav, coni + use glimmer_paramets, only : thk0, tim0 + + !WHL - debug + use parallel, only: this_rank + + ! Note: Matrix elements (subd, supd, diag, rhsd) are indexed from 1 to upn+1, + ! whereas temperature/enthalpy is indexed from 0 to upn. + ! The first row of the matrix is the equation for enthalpy(0,ew,ns), + ! the last row is the equation for enthalpy(upn,ew,ns), and so on. + + !I/O variables + type(glide_global_type), intent(inout) :: model + integer, intent(in) :: ew, ns + real(dp), dimension(:), intent(out) :: subd, diag, supd, rhsd + logical, intent(in) :: float + real(dp), dimension(:), intent(out) :: alpha_enth ! half-node diffusivity (m^2/s) for enthalpy + ! located halfway between temperature points + ! local variables + real(dp) :: dsigbot ! bottom layer thicknes in sigma coords. + real(dp) :: alphai ! cold ice diffusivity + real(dp) :: alpha0 ! temperate ice diffusivity + real(dp) :: fact ! coefficient in tridiag + integer :: up, k + real(dp), dimension(0:model%general%upn) :: enthalpy ! specific enthalpy (J/m^3) + real(dp), dimension(0:model%general%upn) :: pmptemp ! pmptemp all nodes (deg C) +!! real(dp), dimension(1:model%general%upn) :: alpha_half ! half-node diffusivity (m^2/s) + real(dp), dimension(0:model%general%upn) :: enth_T ! specific enthalpy (J/m^3) + real(dp) :: denth ! enthalpy difference between adjacent layers + real(dp) :: denth_T ! difference in temperature component of enthalpy between adjacent layers + real(dp) :: alpha_fact ! factor for averaging diffusivity, 0 <= fact <= 1 + + logical, parameter :: & + alpha_harmonic_avg = .false. ! if true, take harmonic average of alpha in adjacent layers + ! if false, take arithmetic average + + !WHL - debug + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + ! define diffusivities alpha_i and alpha_0 + alphai = coni / rhoi / shci + alpha0 = alphai / 100.0d0 + + !WHL - Moved temp2enth call to temperature driver + ! Convert model%temper%temp and model%temper%waterfrac to enthalpy + ! using temp and waterfrac from last timestep. For interior and boundary nodes. + ! BDM enthalpy will be size 0:upn +! call temp2enth(enthalpy(0:model%general%upn), & +! model%temper%temp(0:model%general%upn,ew,ns), & +! model%temper%waterfrac(1:model%general%upn-1,ew,ns), & +! model%geometry%thck(ew,ns), & +! model%numerics%stagsigma(1:model%general%upn-1)) + + !WHL - Copy enthalpy to model derived type so that it's available on output + + ! Set local 1D enthalpy variable + enthalpy(:) = model%temper%enthalpy(:,ew,ns) + + ! find pmptemp for this column (interior nodes and boundary) + pmptemp(0) = 0.0d0 + call glissade_calcpmpt(pmptemp(1:model%general%upn-1), model%geometry%thck(ew,ns), & + model%numerics%stagsigma(1:model%general%upn-1)) + + call glissade_calcpmpt_bed(pmptemp(model%general%upn), model%geometry%thck(ew,ns)) + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'Starting enthalpy calc, i, j =', ew, ns + print*, 'k, temp, wfrac, enthalpy/(rhoi*ci), pmpt:' + k = 0 + print*, k, model%temper%temp(k,ew,ns), 0.d0, enthalpy(k)/(rhoi*shci) + do k = 1, model%general%upn-1 + print*, k, model%temper%temp(k,ew,ns), model%temper%waterfrac(k,ew,ns), & + enthalpy(k)/(rhoi*shci), pmptemp(k) + enddo + k = model%general%upn + print*, k, model%temper%temp(k,ew,ns), 0.d0, enthalpy(k)/(rhoi*shci), pmptemp(k) + endif + + !WHL - Commenting out the following and replacing it with a new way of computing alpha. + ! The commented-out code can result in sudden large changes in alpha that + ! lead to oscillations in the thickness, temperature and velocity fields. + ! These oscillations have a period of ~1 yr or more, spatial scale of + ! many grid cells, and amplitude of ~10 m in thickness, 1 deg in temperature, + ! and 2 m/s in velocity. + + ! create a column vector of size (0:upn) of diffusivity based on + ! previous timestep's temp. Boundary nodes need a value so half-node + ! diffusivity can be calculated at interior nodes (1:upn-1) + +! do up = 0,model%general%upn +! if (model%temper%temp(up,ew,ns) < pmptemp(up)) then +! alpha(up) = alphai +! else +! alpha(up) = alpha0 +! endif +! end do + + ! Find half-node diffusivity using harmonic average between nodes. + ! The vector will be size (1:upn) - the first value is the half-node + ! between nodes 0 and 1, the last value is the half-node between + ! nodes upn-1 and upn. + +! do up = 1,model%general%upn +! alpha_enth(up) = 2.d0 / ((1.d0/alpha(up-1)) + (1.d0/alpha(up))) +! end do + + !-------------------------------------------------------------------- + !WHL - Trying a different approach to the diffusivity at layer interfaces. + ! Let d(enth)/dz = the gradient of enthalpy + ! Can write + ! d(enth)/dz = d(enth_T)/dz + d(enth_w)/dz, + ! where + ! enth_T = (1-phi_w) * rhoi*ci*T + ! enth_w = phi_w * rhow*(L + ci*Tpmp) + ! + ! Now let f = d(enth_T)/z / d(enth)/dz + ! (f -> 0 if f is computed to be negative) + ! For cold ice, f = 1 and alpha = alphai + ! For temperate ice, f ~ 0 and alpha = alpha0 + ! At the interface between cold and temperate ice, + ! f ~ 0 if the temperate ice has large phi_w, but + ! f ~ 1 if the temperate ice has close to zero phi_w. + ! Two ways to average: + ! (1) arithmetic average: alpha = f*alphai + (1-f)*alpha0 + ! (2) harmonic average: alpha = 1 / (f/alphai + (1-f)/alpha0). + ! Both methods have the same asymptotic values at f = 0 or 1, + ! but the arithmetic average gives greater diffusivity for + ! intermediate values. + ! + ! Still to be determined which is more accurate. + ! The harmonic average allows large temperature gradients between the + ! bottom layer and the next layer up; the arithmetic average gives + ! smoother gradients. + !-------------------------------------------------------------------- + ! + ! At each temperature point, compute the temperature part of the enthalpy. + ! enth_T = enth for cold ice, enth_T < enth for temperate ice + + do up = 0, model%general%upn + enth_T(up) = (1.d0 - model%temper%waterfrac(up,ew,ns)) * rhoi*shci*model%temper%temp(up,ew,ns) + enddo + +!WHL - debug + if (ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'k, denth_T/(rhoi*shci), denth/(rhoi*shci), alpha_fact, alpha_enth(up):' + endif + + ! Compute factors relating the temperature gradient to the total enthalpy gradient. + ! Use these factors to average the diffusivity between adjacent temperature points. + do up = 1,model%general%upn + denth = enthalpy(up) - enthalpy(up-1) + denth_T = enth_T(up) - enth_T(up-1) ! = denth in cold ice, < denth in temperate ice + if (abs(denth) > 1.d-20 * rhow*lhci) then + alpha_fact = max(0.d0, denth_T/denth) + alpha_fact = min(1.d0, alpha_fact) + else + alpha_fact = 0.d0 + endif + + if (alpha_harmonic_avg) then ! take a harmonic average + ! This gives slower cooling of temperate layers and allows + ! large temperature gradients between cold and temperate layers + alpha_enth(up) = 1.d0 / ((alpha_fact/alphai) + (1.d0-alpha_fact)/alpha0) + else ! take an arithmetic average + ! This gives faster cooling of temperate layers and smaller gradients + alpha_enth(up) = alpha_fact*alphai + (1.d0-alpha_fact)*alpha0 + endif + +!WHL - debug + if (ew==itest .and. ns==jtest) then + print*, up, denth_T/(rhoi*shci), denth/(rhoi*shci), alpha_fact, alpha_enth(up) + endif + + end do + + !WHL - debug + if (ew==itest .and. ns==jtest) then +! print*, ' ' +! print*, 'alphai, alpha0 =', alphai, alpha0 +! print*, ' ' +! print*, 'k, alpha_enth(up), alpha(up-1), alpha(up), i, j =', ew, ns +! do up = 1, model%general%upn +! print*, up, alpha_enth(up), alpha(up-1), alpha(up) +! enddo + endif + + ! Compute subdiagonal, diagonal, and superdiagonal matrix elements + + ! upper boundary: set to surface air temperature + supd(1) = 0.0d0 + subd(1) = 0.0d0 + diag(1) = 1.0d0 + rhsd(1) = dmin1(0.0d0,dble(model%climate%artm(ew,ns))) * rhoi * shci + + ! RJH - Multiplied fact by a factor of 2 to become EB coefficients + ! cons(1) is (dt * tim0) / (2 * thk0^2) + ! fact is (dt * tim0) / (2 * H^2 * thk0^2) + fact = 2 * model%tempwk%cons(1) / model%geometry%thck(ew,ns)**2 + + ! RJH - Altered rhsd to become fully implicit (backward Euler). + ! This included deleting subd and supd terms and dropping enthalpy(1:model%general%upn-1) coefficient + + ! ice interior. layers 1:upn-1 (matrix elements 2:upn) + subd(2:model%general%upn) = -fact * alpha_enth(1:model%general%upn-1) & + * model%tempwk%dups(1:model%general%upn-1,1) + supd(2:model%general%upn) = -fact * alpha_enth(2:model%general%upn) & + * model%tempwk%dups(1:model%general%upn-1,2) + diag(2:model%general%upn) = 1.0d0 - subd(2:model%general%upn) & + - supd(2:model%general%upn) + rhsd(2:model%general%upn) = enthalpy(1:model%general%upn-1) & + + model%temper%dissip(1:model%general%upn-1,ew,ns) * rhoi * shci + + ! BDM I'm assuming that model%temper%dissip has units of phi/rhoi/shci. + ! For an enthalpy calc, we want just phi, so model%temper%dissip * rhoi * shci + + ! basal boundary: + ! for grounded ice, a heat flux is applied + ! for floating ice, the basal temperature is held constant + + !NOTE: This lower BC is different from the one in standard glide_temp. + ! If T(upn) < T_pmp, then require dT/dsigma = H/k * (G + taub*ubas) + ! That is, net heat flux at lower boundary must equal zero. + ! If T(upn) >= Tpmp, then set T(upn) = Tpmp + + if (float) then + supd(model%general%upn+1) = 0.0d0 + subd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + rhsd(model%general%upn+1) = enthalpy(model%general%upn) + + else ! grounded ice + + !WHL - debug + if (ew==itest .and. ns==jtest) then + up = model%general%upn-1 + print*, 'temp(upn-1), pmptemp(upn-1):', model%temper%temp(up,ew,ns), pmptemp(up) + up = model%general%upn + print*, 'temp(upn), pmptemp(upn):', model%temper%temp(up,ew,ns), pmptemp(up) + endif + + !Positive-Thickness Basal Temperate Boundary Layer + + !WHL - Not sure whether this condition is right. + ! It implies that the enthalpy at the bed (upn) = enthalpy in layer (upn-1). + if (abs(model%temper%temp(model%general%upn-1,ew,ns) - & + pmptemp(model%general%upn-1)) < 0.001d0) then + + subd(model%general%upn+1) = -1.0d0 + supd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + rhsd(model%general%upn+1) = 0.0d0 + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, 'basal BC: branch 1 (finite-thck BL)' + endif + + !Zero-Thickness Basal Temperate Boundary Layer + elseif (abs(model%temper%temp(model%general%upn,ew,ns) - & + pmptemp(model%general%upn)) < 0.001d0) then ! melting + + ! hold basal temperature at pressure melting point + supd(model%general%upn+1) = 0.0d0 + subd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + rhsd(model%general%upn+1) = pmptemp(model%general%upn) * rhoi * shci + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, 'basal BC: branch 2 (zero-thck BL)' + endif + + else + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, 'basal BC: branch 3 (cold ice)' + endif + + ! frozen at bed + ! maintain balance of heat sources and sinks + ! (conductive flux, geothermal flux, and basal friction) + ! Note: Heat fluxes are positive down, so slterm <= 0 and bheatflx <= 0. + + ! Note: The heat source due to basal sliding (bfricflx) is computed in subroutine calcbfric. + ! Also note that bheatflx is generally <= 0, since defined as positive down. + + ! calculate dsigma for the bottom layer between the basal boundary and the temp. point above + dsigbot = (1.0d0 - model%numerics%stagsigma(model%general%upn-1)) + + ! =====Backward Euler flux basal boundary condition===== + ! MJH: If Crank-Nicolson is desired for the b.c., it is necessary to + ! ensure that the i.c. temperature for the boundary satisfies the + ! b.c. - otherwise oscillations will occur because the C-N b.c. only + ! specifies the basal flux averaged over two consecutive time steps. + subd(model%general%upn+1) = -1.0d0 + supd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + rhsd(model%general%upn+1) = (model%temper%bfricflx(ew,ns) - & + model%temper%bheatflx(ew,ns)) * & + dsigbot * model%geometry%thck(ew,ns) * & + thk0 * rhoi * shci / coni + ! BDM temp approach should work out to be dT/dsigma, so enthalpy approach + ! should just need dT/dsigma * rhoi * shci for correct units + + ! =====Basal boundary using heat equation with specified flux==== + ! MJH: These coefficients are based on those used in the old temperature code + ! (eqns. 3.60-3.62 in the documentation). + ! The implementation assumes the basal fluxes are the same at both time steps (lagged). + ! The flux b.c. above was determined to be preferable, but this is left + ! as an alternative. It gives similar, but slightly different results. + ! Because this formulation uses C-N time averaging, it results + ! in a slight oscillation. + !subd(model%general%upn+1) = -fact / dsigbot**2 + !supd(model%general%upn+1) = 0.0d0 + !diag(model%general%upn+1) = 1.0d0 + fact / dsigbot**2 + !model%tempwk%inittemp(model%general%upn,ew,ns) = & + ! model%temper%temp(model%general%upn-1,ew,ns) * fact / dsigbot**2 & + ! + model%temper%temp(model%general%upn, ew,ns) & + ! * (1.0d0 - fact/dsigbot**2) & + ! - fact *2.0d0 * & + ! model%geometry%thck(ew,ns) * thk0 / coni / dsigbot * & + ! (model%temper%bheatflx(ew,ns) & ! geothermal (H/k)*G + ! - model%temper%bfricflx(ew,ns) ) ! sliding (H/k)*taub*ub. + !rhsd(model%general%upn+1) = model%tempwk%inittemp(model%general%upn,ew,ns) + + endif ! melting or frozen + + end if ! floating or grounded + + end subroutine glissade_enthalpy_findvtri + +!-------------------------------------------------------------------------------- + + subroutine enth2temp (enthalpy, temp, waterfrac, thck, stagsigma) + + ! BDM convert from specific enthalpy to ice temperature and water content + ! takes a vertical column of size enthalpy(dup-1,1,1) and converts to + ! temp(1:dup-1,1,1) and waterfrac(1:dup-1,1,1) + ! enthalpy(1:dup-1,1,1) + ! temp(1:dup-1,1,1) + ! waterfrac(1:dup-1,1,1) + ! thck(1,1,1) + ! stagsigma(1:dup-1,1,1) + + use glimmer_physcon, only : rhoi, shci, lhci, rhow + + ! I/O variables + real(dp), dimension(0:), intent(inout) :: enthalpy !enthalpy is (0:upn) + real(dp), intent(in) :: thck + real(dp), dimension(:), intent(in) :: stagsigma !stagsigma is (1:upn-1) + real(dp), dimension(0:size(enthalpy)-1), intent(out) :: temp !temp is (0:upn) + real(dp), dimension(1:size(enthalpy)-2), intent(out) :: waterfrac !waterfrac is (1:upn-1) + + ! local variables + real(dp), dimension(0:size(enthalpy)-1) :: pmptemp ! (0:upn) + real(dp), dimension(0:size(enthalpy)-1) :: pmpenthalpy ! (0:upn) + integer :: upn !used for convenience + integer :: up + + upn = size(enthalpy)-1 + + ! Find pmpenthalpy(0:upn) + pmptemp(0) = 0.0d0 + call glissade_calcpmpt(pmptemp(1:upn-1), thck, stagsigma(1:upn-1)) + call glissade_calcpmpt_bed(pmptemp(upn), thck) + + pmpenthalpy = pmptemp * rhoi * shci + + !solve for temp and waterfrac + if(enthalpy(0) >= pmpenthalpy(0)) then ! temperate ice + temp(0) = pmptemp(0) ! temperate ice + !WHL - Resetting enthalpy so that it's consistent with the new temperature + ! This is consistent with energy conservation because the top surface + ! is infinitesimally thin. + enthalpy(0) = pmpenthalpy(0) + else + temp(0) = enthalpy(0) / (rhoi*shci) ! temp is cold + endif + + do up = 1, upn-1 + if(enthalpy(up) >= pmpenthalpy(up)) then ! temperate ice + temp(up) = pmptemp(up) ! temp = pmptemp + waterfrac(up) = (enthalpy(up)-pmpenthalpy(up)) / & + ((rhow-rhoi) * shci * pmptemp(up) + rhow * lhci) + else ! cold ice + + !WHL - debug + if (waterfrac(up) > 0.d0) then + print*, 'Zeroing out waterfrac: k, waterfrac =', up, waterfrac(up) + endif + + temp(up) = enthalpy(up) / (rhoi*shci) ! temp is cold + waterfrac(up) = 0.0d0 ! waterfrac = 0 + endif + end do + + if(enthalpy(upn) >= pmpenthalpy(upn)) then ! temperate ice + temp(upn) = pmptemp(upn) ! temp = pmptemp + else + temp(upn) = enthalpy(upn) / (rhoi*shci) ! temp is cold + !WHL - Resetting enthalpy so that it's consistent with the new temperature + ! This is consistent with energy conservation because the top surface + ! is infinitesimally thin. + enthalpy(upn) = pmpenthalpy(upn) + endif + + end subroutine enth2temp + +!-------------------------------------------------------------------------------- + + subroutine temp2enth (enthalpy, temp, waterfrac, thck, stagsigma) + + ! BDM convert from temperature and water content and converts to specific enthalpy + ! takes a vertical column of size temp(0:dup) and converts to enthalpy(0:dup,1,1) + ! waterfrac is only size(1:dup-1), so will assume no waterfrac at boundaries + + use glimmer_physcon, only : rhoi, shci, lhci, rhow + + ! I/O variables + real(dp), dimension(0:), intent(out) :: enthalpy !enthalpy is (0:upn) + real(dp), intent(in) :: thck + real(dp), dimension(:), intent(in) :: stagsigma !stagsigma is (1:upn-1) + real(dp), dimension(0:), intent(in) :: temp !temp is (0:upn) + real(dp), dimension(:), intent(in) :: waterfrac !waterfrac is (1:upn-1) + + ! local variables + real(dp), dimension(0:size(temp)-1) :: pmptemp !(0:upn) + real(dp), dimension(0:size(temp)-1) :: pmpenthalpy !(0:upn) + integer :: up + integer :: upn !used for convenience + + upn = size(temp)-1 + + ! Find pmpenthalpy(0:dup,1,1) + pmptemp(0) = 0.0d0 + call glissade_calcpmpt(pmptemp(1:upn-1), thck, stagsigma(1:upn-1)) + call glissade_calcpmpt_bed(pmptemp(upn), thck) + + !WHL - This variable is not used below + pmpenthalpy = rhoi * shci * pmptemp + + ! solve for enthalpy + ! assume waterfrac = 0 at upper and lower ice surfaces + enthalpy(0) = temp(0) * rhoi * shci + do up = 1, upn-1 + enthalpy(up) = ((1 - waterfrac(up)) * rhoi * shci * temp(up)) & + + waterfrac(up) * rhow * ((shci * pmptemp(up)) + lhci) + end do + enthalpy(upn) = temp(upn) * rhoi * shci + + end subroutine temp2enth + +!-------------------------------------------------------------------------------- + + subroutine glissade_enthalpy_calcbmlt(model, & + temp, waterfrac, & + stagsigma, thck, & + bmlt, floater) + + ! Compute the amount of basal melting. + ! The basal melting computed here is applied to the ice thickness + ! by glissade_transport_driver, conserving mass and energy. + ! + ! This is done with the enthalpy formulation by taking any internal + ! water content above 1% and draining it to the bed + + use glimmer_physcon, only: shci, rhoi, lhci + use glimmer_paramets, only : thk0, tim0 + + type(glide_global_type) :: model + + real(dp), dimension(0:,:,:), intent(inout) :: temp + real(dp), dimension(1:,:,:), intent(inout) :: waterfrac + real(dp), dimension(0:), intent(in) :: stagsigma + real(dp), dimension(:,:), intent(in) :: thck + real(dp), dimension(:,:), intent(out):: bmlt ! scaled melt rate (m/s * tim0/thk0) + ! > 0 for melting, < 0 for freeze-on + logical, dimension(:,:), intent(in) :: floater + + real(dp), dimension(size(stagsigma)) :: pmptemp ! pressure melting point temperature + real(dp) :: bflx ! heat flux available for basal melting (W/m^2) + real(dp) :: hmlt ! depth of internal melting (m) + real(dp) :: internal_melt_rate ! rate of internal melt sent to the bed (m/s) + integer :: up, ew, ns + + bmlt(:,:) = 0.0d0 + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + + if (thck(ew,ns) > model%numerics%thklim_temp .and. .not. floater(ew,ns)) then + + ! Basal friction term is computed above in subroutine glissade_calcbfric + + ! Compute basal melting + ! Note: bmlt > 0 for melting, < 0 for freeze-on + ! bfricflx >= 0 by definition + ! bheatflx is positive down, so usually bheatflx < 0 (with negative values contributing to melt) + ! lcondflx is positive down, so lcondflx < 0 for heat is flowing from the bed toward the surface + + !TODO - This equation allows for freeze-on (bmlt < 0) if the conductive term + ! (lcondflx, positive down) is carrying enough heat away from the boundary. + ! But freeze-on requires a local water supply, bwat > 0. + ! What should we do if bwat = 0? + + bflx = model%temper%bfricflx(ew,ns) + model%temper%lcondflx(ew,ns) - model%temper%bheatflx(ew,ns) + bmlt(ew,ns) = bflx * model%tempwk%f(2) ! f(2) = tim0 / (thk0 * lhci * rhoi) + + ! Add internal melting associated with waterfrac > waterfrac_max (1%) + ! Note: glissade_calcpmpt does not compute pmpt at the top surface or the bed. + + call glissade_calcpmpt(pmptemp(:), thck(ew,ns), & + stagsigma(:) ) + + !WHL - Any correction for rhoi/rhow here? + do up = 1, model%general%upn-1 + if (waterfrac(up,ew,ns) > 0.01d0) then + hmlt = (waterfrac(up,ew,ns) - 0.01d0) * (model%geometry%thck(ew,ns) * thk0) & + * (model%numerics%sigma(up+1) - model%numerics%sigma(up)) ! m + internal_melt_rate = hmlt / (model%numerics%dttem * tim0) ! m/s + bmlt(ew,ns) = bmlt(ew,ns) + internal_melt_rate * tim0/thk0 + waterfrac(up,ew,ns) = 0.01d0 + endif + enddo + + ! Reset basal temp to pmptemp, if necessary + !WHL - Is this necessary for enthalpy code? + + up = model%general%upn + call glissade_calcpmpt_bed(pmptemp(up), thck(ew,ns)) + temp(up,ew,ns) = min (temp(up,ew,ns), pmptemp(up)) + + ! If freeze-on was computed above (bmlt < 0) and Tbed = Tpmp but no basal water is present, then set T(upn) < Tpmp. + ! Note: In subroutine findvtri, we solve for Tbed (instead of holding it at Tpmp) when Tbed < 0.001. + ! With an offset here of 0.01, we will solve for T_bed at the next timestep. + ! Note: Energy is not exactly conserved here. + + up = model%general%upn ! basal level + if (bmlt(ew,ns) < 0.d0 .and. model%temper%bwat(ew,ns)==0.d0 .and. temp(up,ew,ns) >= pmptemp(up)) then + temp(up,ew,ns) = pmptemp(up) - 0.01d0 + endif + + endif ! thk > thklim_temp + + enddo + enddo + + end subroutine glissade_enthalpy_calcbmlt + +!----------------------------------------------------------------------------------- + + !TODO - Remove or inline these subroutines? They are copies of subroutines in glissade_temp.F90. + subroutine glissade_calcpmpt(pmptemp, thck, stagsigma) + + ! Compute the pressure melting point temperature in the column + ! (but not at the surface or bed). + ! Note: pmptemp and stagsigma should have dimensions (1:upn-1). + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), dimension(:), intent(out) :: pmptemp ! pressure melting point temperature (deg C) + real(dp), intent(in) :: thck ! ice thickness + real(dp), intent(in), dimension(:) :: stagsigma ! staggered vertical coordinate + ! (defined at layer midpoints) + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp(:) = fact * thck * stagsigma(:) + + end subroutine glissade_calcpmpt + +!----------------------------------------------------------------------- + + subroutine glissade_calcpmpt_bed(pmptemp_bed, thck) + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), intent(out) :: pmptemp_bed ! pressure melting point temp at bed (deg C) + real(dp), intent(in) :: thck ! ice thickness + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp_bed = fact * thck + + end subroutine glissade_calcpmpt_bed + +!------------------------------------------------------------------- + +end module glissade_enthalpy + +!-------------------------------------------------------------------------------- diff --git a/components/cism/glimmer-cism/libglissade/glissade_grid_operators.F90 b/components/cism/glimmer-cism/libglissade/glissade_grid_operators.F90 new file mode 100644 index 0000000000..623fe46db8 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_grid_operators.F90 @@ -0,0 +1,826 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_grid_operators.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains various grid operators for the Glissade dycore, including routines +! for computing gradients and interpolating between staggered and unstaggered grids. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module glissade_grid_operators + + use glimmer_global, only: dp + use glimmer_log + use glide_types ! HO_GRADIENT_MARGIN_* + use parallel + + implicit none + + private + public :: glissade_stagger, glissade_unstagger, & + glissade_centered_gradient, glissade_upstream_gradient, & + glissade_edge_gradient, glissade_vertical_average + + logical, parameter :: verbose_gradient = .false. + +contains + +!---------------------------------------------------------------------------- + + subroutine glissade_stagger(nx, ny, & + var, stagvar, & + ice_mask, stagger_margin_in) + + ! Given a variable on the unstaggered grid (dimension nx, ny), interpolate + ! to find values on the staggered grid (dimension nx-1, ny-1). + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + real(dp), dimension(nx,ny), intent(in) :: & + var ! unstaggered field, defined at cell centers + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + stagvar ! staggered field, defined at cell vertices + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 where values are included in the average, else = 0 + ! Typically ice_mask = 1 where ice is present (or thck > thklim), else = 0 + + integer, intent(in), optional :: & + stagger_margin_in ! 0 = use all values when interpolating (including zeroes where ice is absent) + ! may be appropriate when computing stagusrf and stagthck on land + ! 1 = use only values where ice is present + ! preferable for tracers (e.g., temperature, flwa) and ocean margins + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer :: i, j + real(dp) :: sumvar, summask + integer :: stagger_margin + + if (present(stagger_margin_in)) then + stagger_margin = stagger_margin_in + else + stagger_margin = 1 ! default is to average only over the cells with ice present + endif + + stagvar(:,:) = 0.d0 + + if (stagger_margin == 0) then + + ! Average over all four neighboring cells + + do j = 1, ny-1 ! all vertices + do i = 1, nx-1 + stagvar(i,j) = (var(i,j+1) + var(i+1,j+1) + var(i,j) + var(i+1,j)) / 4.d0 + enddo + enddo + + elseif (stagger_margin == 1) then + + ! Average over cells with ice present (ice_mask = 1) + + do j = 1, ny-1 ! all vertices + do i = 1, nx-1 + sumvar = ice_mask(i,j+1)*var(i,j+1) + ice_mask(i+1,j+1)*var(i+1,j+1) & + + ice_mask(i,j) *var(i,j) + ice_mask(i+1,j) *var(i+1,j) + summask = real(ice_mask(i,j+1) + ice_mask(i+1,j+1) + ice_mask(i,j) + ice_mask(i+1,j), dp) + if (summask > 0.d0) stagvar(i,j) = sumvar / summask + enddo + enddo + + endif + + end subroutine glissade_stagger + +!---------------------------------------------------------------------------- + + subroutine glissade_unstagger(nx, ny, & + stagvar, unstagvar, & + vmask, stagger_margin_in) + + ! Given a variable on the staggered grid (dimension nx-1, ny-1), interpolate + ! to find values on the staggered grid (dimension nx, ny). + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagvar ! staggered field, defined at cell vertices + + real(dp), dimension(nx,ny), intent(out) :: & + unstagvar ! unstaggered field, defined at cell centers + + integer, dimension(nx-1,ny-1), intent(in) :: & + vmask ! = 1 for vertices where the value is used in the average, else = 0 + ! Note: The user needs to compute this mask in the calling subroutine. + ! It will likely be based on the scalar ice mask, but the details are left open. + + integer, intent(in), optional :: & + stagger_margin_in ! 0 = use all values when interpolating + ! 1 = use only values where vmask = 1 + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer :: i, j + real(dp) :: sumvar, summask + integer :: stagger_margin + + if (present(stagger_margin_in)) then + stagger_margin = stagger_margin_in + else + stagger_margin = 1 ! default is to average over cells where vmask = 1 + endif + + unstagvar(:,:) = 0.d0 + + if (stagger_margin == 0) then + + ! Average over all four neighboring cells + + do j = 2, ny-1 ! loop does not include outer row of cells + do i = 2, nx-1 + unstagvar(i,j) = (stagvar(i,j) + stagvar(i-1,j) + stagvar(i,j-1) + stagvar(i-1,j-1)) / 4.d0 + enddo + enddo + + elseif (stagger_margin == 1) then + + ! Average over vertices with vmask = 1 + + do j = 2, ny-1 ! loop does not include outer row of cells + do i = 2, nx-1 + sumvar = vmask(i-1,j) *stagvar(i-1,j) + vmask(i,j) *stagvar(i,j) & + + vmask(i-1,j-1)*stagvar(i-1,j-1) + vmask(i,j-1)*stagvar(i,j-1) + summask = real(vmask(i-1,j) + vmask(i,j) + vmask(i-1,j-1) + vmask(i,j-1), dp) + if (summask > 0.d0) unstagvar(i,j) = sumvar / summask + enddo + enddo + + endif + + ! Fill in halo values + call parallel_halo(unstagvar) + + end subroutine glissade_unstagger + +!**************************************************************************** + + subroutine glissade_centered_gradient(nx, ny, & + dx, dy, & + f, & + df_dx, df_dy, & + ice_mask, & + gradient_margin_in, & + land_mask) + + !---------------------------------------------------------------- + ! Given a scalar variable f on the unstaggered grid (dimension nx, ny), + ! compute its gradient (df_dx, df_dy) on the staggered grid (dimension nx-1, ny-1). + ! The gradient is evaluated at the four neighboring points and is second-order accurate. + ! + ! There are several choices for computing gradients at the ice margin: + ! HO_MARGIN_GRADIENT_ALL = 0: All neighbor values are used to compute the gradient, including + ! values in ice-free cells. This convention is used by Glide, but performs poorly for + ! ice shelves with a sudden drop in ice thickness and surface elevation at the margin. + ! HO_MARGIN_GRADIENT_ICE_LAND = 1: Values in ice-covered and/or land cells are used to compute + ! the gradient, but values in ice-free ocean cells are ignored. Where required values are + ! missing, the gradient is set to zero. This reduces to option (0) for land-based problems + ! and (2) for ocean-based problems. + ! HO_MARGIN_GRADIENT_ICE_ONLY = 2: Only values in ice-covered cells (i.e., cells with thck > thklim) + ! are used to compute gradients. Where required values are missing, the gradient is set to zero. + ! This option works well at shelf margins but less well for land margins (e.g., the Halfar test case). + ! Since option (1) generally works well at both land and shelf boundaries, it is the default. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + ! assumed to have the same value for each grid cell + + real(dp), dimension(nx,ny), intent(in) :: & + f ! scalar field, defined at cell centers + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + df_dx, df_dy ! gradient components, defined at cell vertices + + integer, intent(in), optional :: & + gradient_margin_in ! 0: use all values when computing gradient (including zeroes where ice is absent) + ! 1: use values in ice-covered and/or land cells (but not ocean cells) + ! if one or more values is masked out, construct df_fx and df_dy from the others + ! 2: use values in ice-covered cells only + ! if one or more values is masked out, construct df_fx and df_dy from the others + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 where ice is present, else = 0 + + integer, dimension(nx,ny), intent(in), optional :: & + land_mask ! = 1 for land cells, else = 0 + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer, dimension(nx,ny) :: mask + integer :: summask, gradient_margin + integer :: i, j + + ! Gradient at vertex(i,j) is based on f(i:i+1,j:j+1) + ! + ! (i,j+1) | (i+1,j+1) + ! -------(i,j)---------- + ! (i,j) | (i+1,j) + + + if (present(gradient_margin_in)) then + gradient_margin = gradient_margin_in + else + gradient_margin = HO_GRADIENT_MARGIN_ICE_LAND + endif + + ! Initialize gradients to zero + df_dx(:,:) = 0.d0 + df_dy(:,:) = 0.d0 + + ! Set integer mask based on gradient_margin. + + if (gradient_margin == HO_GRADIENT_MARGIN_ALL) then + + mask(:,:) = 1 ! = 1 for all cells + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_LAND) then + + if (present(land_mask)) then + mask(:,:) = max(ice_mask(:,:),land_mask(:,:)) ! = 1 if ice_mask = 1 .or. land_mask = 1 + else + call write_log('Must pass in land mask to compute centered gradient with gradient_margin = 1', GM_FATAL) + endif + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_ONLY) then + + mask(:,:) = ice_mask(:,:) ! = 1 for ice-covered cells + endif + + ! Compute the gradients using info in cells with mask = 1 + + do j = 1, ny-1 + do i = 1, nx-1 + + summask = mask(i,j) + mask(i+1,j) + mask(i,j+1) + mask(i+1,j+1) + + if (summask == 4) then ! use info in all four neighbor cells + df_dx(i,j) = (f(i+1,j) + f(i+1,j+1) - f(i,j) - f(i,j+1)) / (2.d0 * dx) + df_dy(i,j) = (f(i,j+1) + f(i+1,j+1) - f(i,j) - f(i+1,j)) / (2.d0 * dy) + + else ! use info only in cells with mask = 1 + ! if info is not available, gradient component = 0 + + ! df_dx + if (mask(i,j)==1 .and. mask(i+1,j)==1) then + df_dx(i,j) = (f(i+1,j) - f(i,j)) / dx + elseif (mask(i,j+1)==1 .and. mask(i+1,j+1)==1) then + df_dx(i,j) = (f(i+1,j+1) - f(i,j+1)) / dx + endif + + ! df_dy + if (mask(i,j)==1 .and. mask(i,j+1)==1) then + df_dy(i,j) = (f(i,j+1) - f(i,j)) / dy + elseif (mask(i+1,j)==1 .and. mask(i+1,j+1)==1) then + df_dy(i,j) = (f(i+1,j+1) - f(i+1,j)) / dy + endif + + endif + + enddo ! i + enddo ! j + + if (verbose_gradient .and. main_task) then + print*, ' ' + print*, 'Centered gradient:' + print*, ' ' + print*, 'df_dx:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f8.4)',advance='no') df_dx(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'df_dy:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f8.4)',advance='no') df_dy(i,j) + enddo + print*, ' ' + enddo + endif + + end subroutine glissade_centered_gradient + +!**************************************************************************** + + subroutine glissade_upstream_gradient(nx, ny, & + dx, dy, & + f, & + df_dx, df_dy, & + ice_mask, & + gradient_margin_in, & + accuracy_flag_in, & + land_mask) + + ! Given a scalar variable f on the unstaggered grid (dimension nx, ny), + ! compute its gradient (df_dx, df_dy) on the staggered grid (dimension nx-1, ny-1). + ! The gradient can be evaluated at two upstream points (for first-order accuracy) + ! or at four upstream points (for second-order accuracy). + ! Note: Upstream is defined by the direction of higher surface elevation + ! rather than the direction the flow is coming from (though these are + ! usually the same). + ! + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + ! assumed to have the same value for each grid cell + + real(dp), dimension(nx,ny), intent(in) :: & + f ! scalar field, defined at cell centers + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + df_dx, df_dy ! gradient components, defined at cell vertices + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 where ice is present, else = 0 + + integer, intent(in), optional :: & + accuracy_flag_in ! = 1 for 1st order, 2 for 2nd order + + integer, intent(in), optional :: & + gradient_margin_in ! 0: use all values when computing gradient (including zeroes where ice is absent) + ! 1: use values in ice-covered and/or land cells (but not ocean cells) + ! if one or more values is masked out, construct df_fx and df_dy from the others + ! 2: use values in ice-covered cells only + ! if one or more values is masked out, construct df_fx and df_dy from the others + + integer, dimension(nx,ny), intent(in), optional :: & + land_mask ! = 1 for land cells, else = 0 + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer, dimension(nx,ny) :: mask + integer :: i, j + real(dp) :: sum1, sum2 + integer :: gradient_margin, accuracy_flag, summask + + ! First-order upstream gradient at vertex(i,j) is based on two points out of f(i:i+1,j:j+1) + ! + ! (i,j+1) | (i+1,j+1) + ! -------(i,j)---------- + ! (i,j) | (i+1,j) + ! + ! Second-order gradient is based on four points in the upstream direction + + if (present(accuracy_flag_in)) then + accuracy_flag = accuracy_flag_in + else + accuracy_flag = 2 ! default to second-order + endif + + if (present(gradient_margin_in)) then + gradient_margin = gradient_margin_in + else + gradient_margin = HO_GRADIENT_MARGIN_ICE_LAND + endif + + ! Initialize gradients to zero + df_dx(:,:) = 0.d0 + df_dy(:,:) = 0.d0 + + ! Set integer mask based on gradient_margin. + + if (gradient_margin == HO_GRADIENT_MARGIN_ALL) then + + mask(:,:) = 1 ! = 1 for all cells + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_LAND) then + + if (present(land_mask)) then + mask(:,:) = max(ice_mask(:,:),land_mask(:,:)) ! = 1 if ice_mask = 1 .or. land_mask = 1 + else + call write_log('Must pass in land mask to compute upstream gradient with gradient_margin = 1', GM_FATAL) + endif + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_ONLY) then + + mask(:,:) = ice_mask(:,:) ! = 1 for ice-covered cells + + endif + + if (accuracy_flag == 1) then ! first-order accurate + + do j = 1, ny-1 + do i = 1, nx-1 + + ! Compute gradient only if at least one neighbor is ice-covered + summask = ice_mask(i,j) + ice_mask(i+1,j) + ice_mask(i,j+1) + ice_mask(i+1,j+1) + + if (summask > 0) then + + ! Compute df_dx by taking upstream gradient + + sum1 = f(i+1,j+1) + f(i,j+1) + sum2 = f(i+1,j) + f(i,j) + + if (sum1 > sum2 .and. mask(i+1,j+1)==1 .and. mask(i,j+1)==1) then + df_dx(i,j) = (f(i+1,j+1) - f(i,j+1)) / dx + elseif (sum1 <= sum2 .and. mask(i+1,j)==1 .and. mask(i,j)==1) then + df_dx(i,j) = (f(i+1,j) - f(i,j)) / dx + endif + + ! Compute df_dy by taking upstream gradient + + sum1 = f(i+1,j+1) + f(i+1,j) + sum2 = f(i,j+1) + f(i,j) + + if (sum1 > sum2 .and. mask(i+1,j+1)==1 .and. mask(i+1,j)==1) then + df_dy(i,j) = (f(i+1,j+1) - f(i+1,j)) / dy + elseif (sum1 <= sum2 .and. mask(i,j+1)==1 .and. mask(i,j)==1) then + df_dy(i,j) = (f(i,j+1) - f(i,j)) / dy + else + df_dy(i,j) = 0.d0 + endif + + endif ! summask > 0 (mask = 1 in at least one neighbor cell) + + enddo + enddo + + else ! second-order accurate + + do j = 2, ny-2 ! loop does not include all of halo + do i = 2, nx-2 + + ! Compute gradient only if at least one neighbor is ice-covered + summask = ice_mask(i,j) + ice_mask(i+1,j) + ice_mask(i,j+1) + ice_mask(i+1,j+1) + + if (summask > 0) then + + ! Compute df_dx by taking upstream gradient + + ! determine upstream direction + + sum1 = f(i+1,j+1) + f(i,j+1) + f(i+1,j+2) + f(i,j+2) + sum2 = f(i+1,j) + f(i,j) + f(i+1,j-1) + f(i,j-1) + + if (sum1 > sum2) then + + summask = mask(i+1,j+1) + mask(i,j+1) + mask(i+1,j+2) + mask(i,j+2) + + if (summask == 4) then ! use info in all four upstream neighbor cells + df_dx(i,j) = (1.5d0 * (f(i+1,j+1) - f(i,j+1)) & + - 0.5d0 * (f(i+1,j+2) - f(i,j+2))) / dx + elseif (mask(i+1,j+1)==1 .and. mask(i,j+1)==1) then ! revert to 1st order, using upstream info + print*, 'df_dx: i, j, summask =', i, j, summask + df_dx(i,j) = (f(i+1,j+1) - f(i,j+1)) / dx + endif + + else ! sum1 <= sum2 + + summask = mask(i+1,j) + mask(i,j) + mask(i+1,j-1) + mask(i,j-1) + + if (summask == 4) then ! use info in all four upstream neighbor cells + df_dx(i,j) = (1.5d0 * (f(i+1,j) - f(i,j)) & + - 0.5d0 * (f(i+1,j-1) - f(i,j-1))) / dx + elseif (mask(i+1,j)==1 .and. mask(i,j)==1) then ! revert to 1st order, using upstream info + print*, 'df_dx: i, j, summask =', i, j, summask + df_dx(i,j) = (f(i+1,j) - f(i,j)) / dx + endif + + endif ! sum1 > sum2 + + ! Compute df_dy by taking upstream gradient + + ! determine upstream direction + + sum1 = f(i+1,j+1) + f(i+1,j) + f(i+2,j+1) + f(i+2,j) + sum2 = f(i,j+1) + f(i,j) + f(i-1,j+1) + f(i-1,j) + + if (sum1 > sum2) then + + summask = mask(i+1,j+1) + mask(i+1,j) + mask(i+2,j+1) + mask(i+2,j) + + if (summask == 4) then ! use info in all four upstream neighbor cells + df_dy(i,j) = (1.5d0 * (f(i+1,j+1) - f(i+1,j)) & + - 0.5d0 * (f(i+2,j+1) - f(i+2,j))) / dy + elseif (mask(i+1,j+1)==1 .and. mask(i+1,j)==1) then ! revert to 1st order, using upstream info + print*, 'df_dy: i, j, summask =', i, j, summask + df_dy(i,j) = (f(i+1,j+1) - f(i+1,j)) / dy + endif + + else ! sum1 <= sum2 + + summask = mask(i,j+1) + mask(i,j) + mask(i-1,j+1) + mask(i-1,j) + + if (summask == 4) then ! use info in all four upstream neighbor cells + df_dy(i,j) = (1.5d0 * (f(i,j+1) - f(i,j)) & + - 0.5d0 * (f(i-1,j+1) - f(i-1,j))) / dy + elseif (mask(i+1,j+1)==1 .and. mask(i+1,j)==1) then ! revert to 1st order, using upstream info + print*, 'df_dy: i, j, summask =', i, j, summask + df_dy(i,j) = (f(i,j+1) - f(i,j)) / dy + endif + + endif ! sum1 > sum2 + + endif ! summask > 0 (mask = 1 in at least one neighbor cell) + + enddo ! i + enddo ! j + + ! fill in halo values + call staggered_parallel_halo(df_dx) + call staggered_parallel_halo(df_dy) + + endif ! 1st or 2nd order accurate + + if (verbose_gradient .and. main_task) then + print*, ' ' + print*, 'upstream df_dx:' + do j = ny-2, 2, -1 + do i = 1, nx-1 + write(6,'(f7.4)',advance='no') df_dx(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'upstream df_dy:' + do j = ny-2, 2, -1 + do i = 1, nx-1 + write(6,'(f7.4)',advance='no') df_dy(i,j) + enddo + print*, ' ' + enddo + + endif + + end subroutine glissade_upstream_gradient + +!**************************************************************************** + + subroutine glissade_edge_gradient(nx, ny, & + dx, dy, & + f, & + df_dx, df_dy, & + gradient_margin_in, & + ice_mask, land_mask) + + ! Given a scalar variable f on the unstaggered grid (dimension nx, ny), + ! compute its gradient (df_dx, df_dy) at cell edges (i.e., the C grid): + ! df_dx at the midpoint of the east edge and df_dy at the midpoint of + ! the north edge. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + ! assumed to have the same value for each grid cell + + real(dp), dimension(nx,ny), intent(in) :: & + f ! scalar field, defined at cell centers + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + df_dx, df_dy ! gradient components, defined at cell edges + + integer, intent(in), optional :: & + gradient_margin_in ! 0: use all values when computing gradient (including zeroes where ice is absent) + ! 1: use values in ice-covered and/or land cells (but not ocean cells) + ! if one or more values is masked out, set gradient to zero + ! 2: use values in ice-covered cells only + ! if one or more values is masked out, set gradient to zero + + integer, dimension(nx,ny), intent(in), optional :: & + ice_mask, & ! = 1 where ice is present, else = 0 + land_mask ! = 1 for land cells, else = 0 + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer, dimension(nx,ny) :: mask + integer :: gradient_margin + integer :: i, j + + ! Gradient at east edge(i,j) is based on f(i:i+1,j) + ! Gradient at north edge(i,j) is based on f(i,j:j+1) + ! + ! | | + ! | (i,j+1) | + ! | | + ! | | + ! ----df_dy------------------ + ! | | + ! | | + ! | (i,j) df_dx (i+1,j) + ! | | + ! | | + ! |-------------- + + if (present(gradient_margin_in)) then + gradient_margin = gradient_margin_in + else + gradient_margin = HO_GRADIENT_MARGIN_ICE_LAND + endif + + ! Initialize gradients to zero + df_dx(:,:) = 0.d0 + df_dy(:,:) = 0.d0 + + ! Set integer mask based on gradient_margin. + + if (gradient_margin == HO_GRADIENT_MARGIN_ALL) then + + mask(:,:) = 1 ! = 1 for all cells + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_LAND) then + + if (present(land_mask) .and. present(ice_mask)) then + mask(:,:) = max(ice_mask(:,:),land_mask(:,:)) ! = 1 if ice_mask = 1 .or. land_mask = 1 + else + call write_log('Must pass in land and ice masks to compute edge gradient with gradient_margin = 1', GM_FATAL) + endif + + elseif (gradient_margin == HO_GRADIENT_MARGIN_ICE_ONLY) then + + if (present(ice_mask)) then + mask(:,:) = ice_mask(:,:) ! = 1 for ice-covered cells + else + call write_log('Must pass in ice mask to compute edge gradient with gradient_margin = 2', GM_FATAL) + endif + + endif + + ! Compute the gradients using info in cells with mask = 1 + + do j = 1, ny-1 + do i = 1, nx-1 + + ! df_dx + + if (mask(i,j)==1 .and. mask(i+1,j)==1) then + df_dx(i,j) = (f(i+1,j) - f(i,j)) / dx + endif + + ! df_dy + + if (mask(i,j)==1 .and. mask(i,j+1)==1) then + df_dy(i,j) = (f(i,j+1) - f(i,j)) / dy + endif + + enddo ! i + enddo ! j + + if (verbose_gradient .and. main_task) then + print*, ' ' + print*, 'Edge gradient:' + print*, ' ' + print*, 'df_dx:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f8.4)',advance='no') df_dx(i,j) + enddo + print*, ' ' + enddo + print*, ' ' + print*, 'df_dy:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f8.4)',advance='no') df_dy(i,j) + enddo + print*, ' ' + enddo + endif + + end subroutine glissade_edge_gradient + +!---------------------------------------------------------------------------- + + subroutine glissade_vertical_average(nx, ny, & + nz, sigma, & + mask, & + var, var_2d) + + !---------------------------------------------------------------- + ! Compute the vertical average of a given variable. + ! Note: It is assumed that the variable is defined at layer midpoints, + ! and hence has vertical dimension (nz-1). + ! Note: This subroutine will work for variables on the staggered + ! horizontal grid if stagthck is passed in place of thck. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz ! number of vertical levels + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx, ny), intent(in) :: & + mask ! compute var_2d where mask = .true. + + real(dp), dimension(nz-1,nx, ny), intent(in) :: & + var ! 3D field to be averaged vertically + + real(dp), dimension(nx, ny), intent(out) :: & + var_2d ! 2D vertically averaged field + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer :: i, j, k + + do j = 1, ny + do i = 1, nx + + var_2d(i,j) = 0.d0 + + if (mask(i,j)) then + do k = 1, nz-1 + var_2d(i,j) = var_2d(i,j) + var(k,i,j) * (sigma(k+1) - sigma(k)) + enddo + endif + + enddo + enddo + + end subroutine glissade_vertical_average + +!**************************************************************************** + + end module glissade_grid_operators + +!**************************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_masks.F90 b/components/cism/glimmer-cism/libglissade/glissade_masks.F90 new file mode 100644 index 0000000000..8b015476d7 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_masks.F90 @@ -0,0 +1,697 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_masks.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains routines for computing various masks used by the Glissade +! velocity solver. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + module glissade_masks + + use glimmer_global, only: dp + use glimmer_physcon, only: rhoi, rhoo + use glissade_grid_operators + use glide_types ! grounding line options +! use parallel + + implicit none + + private + public :: glissade_get_masks, glissade_grounded_fraction + + contains + +!**************************************************************************** + + subroutine glissade_get_masks(nx, ny, & + thck, topg, & + eus, thklim, & + ice_mask, floating_mask, & + ocean_mask, land_mask) + + + !---------------------------------------------------------------- + ! Compute various masks for Glissade dycore. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + ! Default dimensions are meters, but this subroutine will work for + ! any units as long as thck, topg, eus and thklim have the same units. + + real(dp), dimension(nx,ny), intent(in) :: & + thck, &! ice thickness (m) + topg ! elevation of topography (m) + + real(dp), intent(in) :: & + eus, &! eustatic sea level (m), = 0. by default + thklim ! minimum ice thickness for active cells (m) + + integer, dimension(nx,ny), intent(out) :: & + ice_mask ! = 1 if thck > thklim, else = 0 + + integer, dimension(nx,ny), intent(out), optional :: & + floating_mask, &! = 1 if thck > thklim and ice is floating, else = 0 + ocean_mask, &! = 1 if topg is below sea level and thk <= thklim, else = 0 + land_mask ! = 1 if topg is at or above sea level + + !---------------------------------------------------------------- + ! Local arguments + !---------------------------------------------------------------- + + integer :: i, j + + !---------------------------------------------------------------- + ! Compute masks in cells + !---------------------------------------------------------------- + + do j = 1, ny + do i = 1, nx + + if (thck(i,j) > thklim) then + ice_mask(i,j) = 1 + else + ice_mask(i,j) = 0 + endif + + if (present(ocean_mask)) then + if (topg(i,j) < eus .and. thck(i,j) <= thklim) then + ocean_mask(i,j) = 1 + else + ocean_mask(i,j) = 0 + endif + endif + + if (present(floating_mask)) then + if (topg(i,j) - eus < (-rhoi/rhoo)*thck(i,j) .and. thck(i,j) > thklim) then + floating_mask(i,j) = 1 + else + floating_mask(i,j) = 0 + endif + endif + + if (present(land_mask)) then + if (topg(i,j) >= eus) then + land_mask(i,j) = 1 + else + land_mask(i,j) = 0 + endif + endif + + enddo + enddo + + end subroutine glissade_get_masks + +!**************************************************************************** + + subroutine glissade_grounded_fraction(nx, ny, & + thck, topg, & + eus, ice_mask, & + whichground, f_ground) + + !---------------------------------------------------------------- + ! Compute fraction of ice that is grounded. + ! This fraction is computed at vertices based on the thickness and + ! topography of the four neighboring cell centers. + ! + ! Three cases, based on the value of whichground: + ! (0) HO_GROUND_NO_GLP: f_ground = 0 or 1 based on flotation criterion + ! (1) HO_GROUND_GLP: 0 <= f_ground <= 1 based on grounding-line parameterization + ! (similar to that of Pattyn 2006) + ! (2) HO_GROUND_ALL: f_ground = 1 for all cells with ice + !---------------------------------------------------------------- + + !TODO: Apply this subroutine in MISMIP test cases + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + ! Default dimensions are meters, but this subroutine will work for + ! any units as long as thck and topg have the same units. + + real(dp), dimension(nx,ny), intent(in) :: & + thck, &! ice thickness (m) + topg ! elevation of topography (m) + + real(dp), intent(in) :: & + eus ! eustatic sea level (= 0 by default) + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 for cells where ice is present (thk > thklim), else = 0 + + integer, intent(in) :: & + whichground ! option for computing f_ground + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + f_ground ! grounded ice fraction at vertex, 0 <= f_ground <= 1 + ! set to -1 where vmask = 0 + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j + + integer, dimension(nx-1,ny-1) :: & + vmask ! = 1 for vertices of cells where ice is present (thk > thklim), else = 0 + + real(dp), dimension(nx,ny) :: & + fpat ! Pattyn function, -rhoo*(topg-eus) / (rhoi*thck) + + real(dp), dimension(nx-1,ny-1) :: & + stagfpat ! fpat interpolated to staggered grid + + real(dp) :: a, b, c, d ! coefficients in bilinear interpolation + ! f(x,y) = a + b*x + c*y + d*x*y + + real(dp) :: f1, f2, f3, f4 ! fpat at different cell centers + + real(dp) :: & + var, &! combination of fpat terms that determines regions to be integrated + fpat_v ! fpat interpolated to vertex + + integer :: nfloat ! number of grounded vertices of a cell (0 to 4) + + logical, dimension(nx,ny) :: & + cfloat ! true if fpat > 1 at cell center, else = false + + logical, dimension(2,2) :: & + logvar ! set locally to float or .not.float, depending on nfloat + + real(dp) :: & + f_corner, & ! fractional area in a corner region of the cell + f_corner1, f_corner2, & + f_trapezoid ! fractional area in a trapezoidal region of the cell + + logical :: adjacent ! true if two grounded vertices are adjacent (rather than opposite) + + real(dp), parameter :: & + eps10 = 1.d-10 ! small number + + !WHL - debug + integer, parameter :: it = 15, jt = 15 + + !---------------------------------------------------------------- + ! Compute ice mask at vertices (= 1 if any surrounding cells have ice) + !---------------------------------------------------------------- + + do j = 1, ny-1 + do i = 1, nx-1 + if (ice_mask(i,j+1)==1 .or. ice_mask(i+1,j+1)==1 .or. & + ice_mask(i,j) ==1 .or. ice_mask(i+1,j) ==1 ) then + vmask(i,j) = 1 + else + vmask(i,j) = 0 + endif + enddo + enddo + + + ! initialize f_ground + ! Choose a special non-physical value; this value will be overwritten in all cells with ice + !TODO Choose a different special value? +! f_ground(:,:) = -1.d0 + f_ground(:,:) = 9.d0 + + select case(whichground) + + case(HO_GROUND_NO_GLP) ! default: no grounding-line parameterization + ! f_ground = 1 if fpat <=1, f_ground = 0 if fpat > 1 + ! Note: Ice is considered grounded at the GL. + + ! Compute Pattyn function at cell centers + + do j = 1, ny + do i = 1, nx + if (ice_mask(i,j) == 1) then + fpat(i,j) = -rhoo*(topg(i,j) - eus) / (rhoi*thck(i,j)) + else + fpat(i,j) = 0.d0 + endif + enddo + enddo + + ! Interpolate to staggered mesh + + ! For stagger_margin_in = 1, only ice-covered cells are included in the interpolation. + ! Will return stagfpat = 0. in ice-free regions + + call glissade_stagger(nx, ny, & + fpat, stagfpat, & + ice_mask, stagger_margin_in = 1) + + ! Assume grounded if stagfpat <= 1, else floating + + do j = 1, ny-1 + do i = 1, nx-1 + if (vmask(i,j)==1) then + if (stagfpat(i,j) <= 1.d0) then + f_ground(i,j) = 1.d0 + else + f_ground(i,j) = 0.d0 + endif + endif + enddo + enddo + + case(HO_GROUND_GLP) ! grounding-line parameterization based on Pattyn (2006, JGR) + + ! Compute Pattyn function at grid cell centers + + do j = 1, ny + do i = 1, nx + if (ice_mask(i,j) == 1) then ! thck > thklim + fpat(i,j) = -rhoo*(topg(i,j) - eus) / (rhoi*thck(i,j)) + else + fpat(i,j) = 0.d0 ! this value is never used + endif + enddo + enddo + + ! Interpolate Pattyn function to staggered mesh + ! For stagger_margin_in = 1, only ice-covered cells are included in the interpolation. + ! Returns stagfpat = 0. in ice-free regions + + call glissade_stagger(nx, ny, & + fpat, stagfpat, & + ice_mask, stagger_margin_in = 1) + + ! Identify cell centers that are floating + + do j = 1, ny + do i = 1, nx + if (fpat(i,j) > 1.d0) then + cfloat(i,j) = .true. + else + cfloat(i,j) = .false. + endif + enddo + enddo + + !WHL - debug + i = it; j = jt + print*, 'i, j =', i, j + print*, 'fpat(i:i+1,j+1):', fpat(i:i+1,j+1) + print*, 'fpat(i:i+1,j) :', fpat(i:i+1,j) + print*, 'cfloat(i:i+1,j+1):', cfloat(i:i+1,j+1) + print*, 'cfloat(i:i+1,j) :', cfloat(i:i+1,j) + + ! Loop over vertices, computing f_ground for each vertex with vmask = 1 + + do j = 1, ny-1 + do i = 1, nx-1 + + if (vmask(i,j) == 1) then ! ice is present in at least one neighboring cell + + if (ice_mask(i,j+1)==1 .and. ice_mask(i+1,j+1)==1 .and. & + ice_mask(i,j) ==1 .and. ice_mask(i+1,j) ==1) then + + ! ice is present in all 4 neighboring cells; interpolate fpat to find f_ground + + ! Count the number of floating cells surrounding this vertex + + nfloat = 0 + if (cfloat(i,j)) nfloat = nfloat + 1 + if (cfloat(i+1,j)) nfloat = nfloat + 1 + if (cfloat(i+1,j+1)) nfloat = nfloat + 1 + if (cfloat(i,j+1)) nfloat = nfloat + 1 + + !WHL - debug + if (i==it .and. j==jt) then + print*, ' ' + print*, 'nfloat =', nfloat + endif + + ! Given nfloat, compute f_ground for each vertex + ! First the easy cases... + + if (nfloat == 0) then + + f_ground(i,j) = 1.d0 ! fully grounded + + elseif (nfloat == 4) then + + f_ground(i,j) = 0.d0 ! fully floating + + ! For the other cases the grounding line runs through the rectangular region + ! around this vertex. + ! Using the values at the 4 neighboring cells, we approximate fpat(x,y) as + ! a bilinear function f(x,y) = a + bx + cy + dxy over the region. + ! To find f_ground, we integrate over the region with f(x,y) <= 1 + ! (or alternatively, we find f_float = 1 - f_ground by integrating + ! over the region with f(x,y) > 1). + ! + ! There are 3 patterns to consider: + ! (1) nfloat = 1 or nfloat = 3 (one cell neighbor is not like the others) + ! (2) nfloat = 2 and adjacent cells are floating + ! (3) nfloat = 2 and diagonally opposite cells are floating + + elseif (nfloat == 1 .or. nfloat == 3) then + + if (nfloat==1) then + logvar(1:2,1:2) = cfloat(i:i+1,j:j+1) + else ! nfloat = 3 + logvar(1:2,1:2) = .not.cfloat(i:i+1,j:j+1) + endif + + ! Identify the cell that is not like the others + ! (i.e., the only floating cell if nfloat = 1, or the only + ! grounded cell if nfloat = 3) + ! + ! Diagrams below are for the case nfloat = 1. + ! If nfloat = 3, the F and G labels are switched. + + if (logvar(1,1)) then ! no rotation + f1 = fpat(i,j) ! G-----G + f2 = fpat(i+1,j) ! | | + f3 = fpat(i+1,j+1) ! | | + f4 = fpat(i,j+1) ! F-----G + + elseif (logvar(2,1)) then ! rotate by 90 degrees + f4 = fpat(i,j) ! G-----G + f1 = fpat(i+1,j) ! | | + f2 = fpat(i+1,j+1) ! | | + f3 = fpat(i,j+1) ! G-----F + + elseif (logvar(2,2)) then ! rotate by 180 degrees + f3 = fpat(i,j) ! G-----F + f4 = fpat(i+1,j) ! | | + f1 = fpat(i+1,j+1) ! | | + f2 = fpat(i,j+1) ! G-----G + + elseif (logvar(1,2)) then ! rotate by 270 degrees + f2 = fpat(i,j) ! F-----G + f3 = fpat(i+1,j) ! | | + f4 = fpat(i+1,j+1) ! | | + f1 = fpat(i,j+1) ! G-----G + endif + + ! Compute coefficients in f(x,y) = a + b*x + c*y + d*x*y + ! Note: x is to the right and y is up if the southwest cell is not like the others. + ! For the other cases we solve the same problem with x and y rotated. + ! The rotations are handled by rotating f1, f2, f3 and f4 above. + + a = f1 + b = f2 - f1 + c = f4 - f1 + d = f1 + f3 - f2 - f4 + + !WHL - debug + if (i==it .and. j==jt) then + print*, 'f1, f2, f3, f4 =', f1, f2, f3, f4 + print*, 'a, b, c, d =', a, b, c, d + endif + + ! Compute the fractional area of the corner region + ! (floating if nfloat = 1, grounded if nfloat = 3) + ! + ! Here are the relevant integrals: + ! + ! (1) d /= 0: + ! integral_0^x0 {y(x) dx}, where x0 = (1-a)/b + ! y(x) = (1 - (a+b*x)) / (c+d*x) + ! = [bc - ad + d) ln(1 + d(1-a)/(bc)) - (1-a)d] / d^2 + ! + ! (2) d = 0: + ! integral_0^x0 {y(x) dx}, where x0 = (1-a)/b + ! y(x) = (1 - (a+b*x)) / c + ! = (a-1)(a-1) / (2bc) + ! + ! Note: We cannot have bc = 0, because fpat varies in both x and y + + if (abs(d) > eps10) then + f_corner = ((b*c - a*d + d) * log(1.d0 + d*(1.d0 - a)/(b*c)) - (1.d0 - a)*d) / (d*d) + else + f_corner = (a - 1.d0)*(a - 1.d0) / (2.d0*b*c) + endif + + if (nfloat==1) then ! f_corner is the floating area + f_ground(i,j) = 1.d0 - f_corner + else ! f_corner is the grounded area + f_ground(i,j) = f_corner + endif + + !WHL - debug + if (i==it .and. j==jt) then + print*, 'f_corner =', f_corner + print*, 'f_ground =', f_ground(i,j) + endif + + elseif (nfloat == 2) then + + ! first the 4 cases where the 2 grounded cells are adjacent + ! We integrate over the trapezoid in the floating part of the cell + + if (cfloat(i,j) .and. cfloat(i+1,j)) then ! no rotation + adjacent = .true. ! G-----G + f1 = fpat(i,j) ! | | + f2 = fpat(i+1,j) ! | | + f3 = fpat(i+1,j+1) ! | | + f4 = fpat(i,j+1) ! F-----F + + elseif (cfloat(i+1,j) .and. cfloat(i+1,j+1)) then ! rotate by 90 degrees + adjacent = .true. ! G-----F + f4 = fpat(i,j) ! | | + f1 = fpat(i+1,j) ! | | + f2 = fpat(i+1,j+1) ! | | + f3 = fpat(i,j+1) ! G-----F + + elseif (cfloat(i+1,j+1) .and. cfloat(i,j+1)) then ! rotate by 180 degrees + adjacent = .true. ! F-----F + f3 = fpat(i,j) ! | | + f4 = fpat(i+1,j) ! | | + f1 = fpat(i+1,j+1) ! | | + f2 = fpat(i,j+1) ! G-----G + + elseif (cfloat(i,j+1) .and. cfloat(i,j)) then ! rotate by 270 degrees + adjacent = .true. ! F-----G + f2 = fpat(i,j) ! | | + f3 = fpat(i+1,j) ! | | + f4 = fpat(i+1,j+1) ! | | + f1 = fpat(i,j+1) ! F-----G + + else ! the 2 grounded cells are diagonally opposite + + ! We will integrate assuming the two corner regions lie in the lower left + ! and upper right, i.e. one of these patterns: + ! + ! F-----G G-----F + ! | | | | + ! | F | | G | + ! | | | | + ! G-----F F-----G + ! + ! Two other patterns are possible, with corner regions in the lower right + ! and upper left; these require a rotation before integrating: + + ! G-----F F-----G + ! | | | | + ! | F | | G | + ! | | | | + ! F-----G G-----F + ! + var = fpat(i+1,j)*fpat(i,j+1) - fpat(i,j)*fpat(i+1,j+1) & + + fpat(i,j) + fpat(i+1,j+1) - fpat(i+1,j) - fpat(i,j+1) + if (var >= 0.d0) then ! we have one of the top two patterns + f1 = fpat(i,j) + f2 = fpat(i+1,j) + f3 = fpat(i+1,j+1) + f4 = fpat(i,j+1) + else ! we have one of the bottom two patterns; rotate coordinates by 90 degrees + f4 = fpat(i,j) + f1 = fpat(i+1,j) + f2 = fpat(i+1,j+1) + f3 = fpat(i,j+1) + endif + endif ! grounded cells are adjacent + + ! Compute coefficients in f(x,y) = a + b*x + c*y + d*x*y + a = f1 + b = f2 - f1 + c = f4 - f1 + d = f1 + f3 - f2 - f4 + + ! Integrate the corner areas + + !WHL - debug + if (i==it .and. j==jt) then + print*, 'adjacent =', adjacent + print*, 'f1, f2, f3, f4 =', f1, f2, f3, f4 + print*, 'a, b, c, d =', a, b, c, d + endif + + if (adjacent) then + + ! Compute the area of the floating part of the cell + ! Here are the relevant integrals: + ! + ! (1) d /= 0: + ! integral_0^1 {y(x) dx}, where y(x) = (1 - (a+b*x)) / (c+d*x) + ! + ! = [bc - ad + d) ln(1 + d/c) - bd] / d^2 + ! + ! (2) d = 0: + ! integral_0^1 {y(x) dx}, where y(x) = (1 - (a+b*x)) / c + ! + ! = -(2a + b - 2) / (2c) + ! + ! Note: We cannot have c = 0, because the passage of the GL + ! through the region from left to right implies variation in y. + + if (abs(d) > eps10) then + f_trapezoid = ((b*c - a*d + d) * log(1 + d/c) - b*d) / (d*d) + else + f_trapezoid = -(2.d0*a + b - 2.d0) / (2.d0*c) + endif + + f_ground(i,j) = 1.d0 - f_trapezoid + + !WHL - debug + if (i==it .and. j==jt) then + print*, 'f_trapezoid =', f_trapezoid + print*, 'f_ground =', f_ground(i,j) + endif + + else ! grounded vertices are diagonally opposite + + ! bug check: make sure some signs are positive as required by the formulas + if (b*c - d*(1.d0-a) < 0.d0) then + print*, 'Grounding line error: bc - d(1-a) < 0' + stop + elseif (b*c < 0.d0) then + print*, 'Grounding line error: bc < 0' + stop + elseif ((b+d)*(c+d) < 0.d0) then + print*, 'Grounding line error: (b+d)(c+d) < 0' + stop + endif + + ! Compute the combined areas of the two corner regions. + ! For the lower left region, the integral is the same as above + ! (for the case nfloat = 1 or nfloat = 3, with d /= 0). + ! For the upper right region, here is the integral: + ! + ! integral_x1^1 {(1-y(x)) dx}, where x1 = (1-a-c)/(b+d) + ! y(x) = (1 - (a+b*x)) / (c+d*x) + ! = {(bc - ad + d) ln[(bc + d(1-a))/((b+d)(c+d))] + d(a + b + c + d - 1)} / d^2 + ! + ! The above integral is valid only if (bc + d(1-a)) > 0. + ! If this quantity = 0, then the grounding line lies along two lines, + ! x0 = (1-a)/b and y0 = (1-a)/c. + ! The lower left area is x0*y0 = (1-a)^2 / (bc). + ! The upper right area is (1-x0)*(1-y0) = (a+b-1)(a+c-1) / (bc) + ! + ! Note that this pattern is not possible with d = 0 + + !WHL - debug + print*, 'Pattern 3: i, j, bc + d(1-a) =', i, j, b*c + d*(1.d0-a) + + if (abs(b*c + d*(1.d0-a)) > eps10) then ! the usual case + f_corner1 = ((b*c - a*d + d) * log(1.d0 + d*(1.d0-a)/(b*c)) - (1.d0-a)*d) / (d*d) + f_corner2 = ((b*c - a*d + d) * log((b*c + d*(1.d0-a))/((b+d)*(c+d))) & + + d*(a + b + c + d - 1)) / (d*d) + else + f_corner1 = (1.d0 - a)*(1.d0 - a) / (b*c) + f_corner2 = (a + b - 1.d0)*(a + c - 1.d0) / (b*c) + endif + + ! Determine whether the central point (1/2,1/2) is grounded or floating. + ! (Note: fpat_v /= stagfpat(i,j)) + ! Then compute the grounded area. + ! If the central point is floating, the corner regions are grounded; + ! if the central point is grounded, the corner regions are floating. + + fpat_v = a + 0.5d0*b + 0.5d0*c + 0.25d0*d + if (fpat_v > 1.d0) then ! the central point is floating; corners are grounded + f_ground(i,j) = f_corner1 + f_corner2 + else ! the central point is grounded; corners are floating + f_ground(i,j) = 1.d0 - (f_corner1 + f_corner2) + endif + + !WHL - debug + if (i==it .and. j==jt) then + print*, 'fpat_v =', fpat_v + print*, 'f_corner1 =', f_corner1 + print*, 'f_corner2 =', f_corner2 + print*, 'f_ground =', f_ground(i,j) + endif + + endif ! adjacent or opposite + + endif ! nfloat + + else ! one or more neighboring cells is ice-free, so bilinear interpolation is not possible + ! In this case, set f_ground = 0 or 1 based on stagfpat at vertex + + if (stagfpat(i,j) <= 1.d0) then + f_ground(i,j) = 1.d0 + else + f_ground(i,j) = 0.d0 + endif + + endif ! ice_mask = 1 in all 4 neighboring cells + endif ! vmask = 1 + enddo ! i + enddo ! j + + case(HO_GROUND_ALL) ! all vertices with ice-covered neighbors are assumed grounded, + ! regardless of thck and topg + + do j = 1, ny-1 + do i = 1, nx-1 + if (vmask(i,j) == 1) then + f_ground(i,j) = 1.d0 + endif + enddo + enddo + + end select + + end subroutine glissade_grounded_fraction + +!**************************************************************************** + + end module glissade_masks + +!**************************************************************************** + diff --git a/components/cism/glimmer-cism/libglissade/glissade_remap.F90 b/components/cism/glimmer-cism/libglissade/glissade_remap.F90 new file mode 100644 index 0000000000..6a9efd4d44 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_remap.F90 @@ -0,0 +1,3185 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_remap.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains subroutines to transport 2D fields using the second-order +! incremental remapping scheme developed by John Dukowicz and John Baumgardner +! (DB) and modified for sea ice by William Lipscomb and Elizabeth Hunke. +! +! Further modified for ice sheets by William Lipscomb. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! References: +! +! Dukowicz, J. K., and J. R. Baumgardner, 2000: Incremental +! remapping as a transport/advection algorithm, J. Comput. Phys., +! 160, 318-335. +! +! Lipscomb, W. H., and E. C. Hunke, 2004: Modeling sea ice +! transport using incremental remapping, Mon. Wea. Rev., 132, +! 1341-1354. +! +! This version was created from ice_transport_remap in CICE, revision 313, 6 Jan. 2011. +! The repository is here: http://oceans11.lanl.gov/svn/CICE +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +module glissade_remap + + use glimmer_global, only: dp + use glimmer_log + use parallel + + implicit none + save + private + public :: glissade_horizontal_remap, make_remap_mask, puny + + integer, parameter :: & + ngroups = 6 ,&! number of groups of triangles that + ! contribute transports across each edge + nvert = 3 ! number of vertices in a triangle + + real(dp), parameter :: & + puny = 1.e-11 ! small number + + !Note: The code will run a bit faster if bugcheck = .false. + logical, parameter :: bugcheck = .true. + + !======================================================================= + ! Here is some information about how the incremental remapping scheme + ! works in CICE and how it can be adapted for use in other models. + ! + ! The remapping routine is designed to transport a generic mass-like + ! field (in CICE, the ice fractional area) along with an arbitrary number + ! of tracers in two dimensions. The velocity components are assumed + ! to lie at grid cell corners and the transported scalars at cell centers. + ! Incremental remapping has the following desirable properties: + ! + ! (1) Tracer monotonicity is preserved. That is, no new local + ! extrema are produced in fields like ice thickness or internal + ! energy. + ! (2) The reconstructed mass and tracer fields vary linearly in x and y. + ! This means that remapping is second-order accurate in space, + ! except where horizontal gradients are limited to preserve + ! monotonicity. + ! (3) There are economies of scale. Transporting a single field + ! is rather expensive, but additional fields have a relatively + ! low marginal cost. + ! + ! The following generic conservation equations may be solved: + ! + ! dm/dt = del*(u*m) (0) + ! d(m*T1)/dt = del*(u*m*T1) (1) + ! d(m*T1*T2)/dt = del*(u*m*T1*T2) (2) + ! + ! where d is a partial derivative, del is the 2D divergence operator, + ! u is the horizontal velocity, m is the mass density field, and + ! T1, T2, and T3 are tracers. + ! + ! In CICE, these equations have the form + ! + ! da/dt = del*(u*a) (3) + ! dv/dt = d(a*h)/dt = del*(u*a*h) (4) + ! de/dt = d(a*h*q)/dt = del*(u*a*h*q) (5) + ! + ! where a = fractional ice area, v = ice/snow volume, h = v/a = thickness, + ! e = ice/snow internal energy (J/m^2), q = e/v = internal energy per + ! unit volume (J/m^3), and T is a tracer. These equations express + ! conservation of ice area, volume, internal energy, and area-weighted + ! tracer, respectively. + ! + ! (Note: In CICE, a, v and e are prognostic quantities from which + ! h and q are diagnosed. The remapping routine works with tracers, + ! which means that h and q must be derived from a, v, and e before + ! calling the remapping routine.) + ! + ! Tracers satisfying equations of the form (1) are called "type 1." + ! In CICE the paradigmatic type 1 tracers are hi and hs (ice/snow thickness). + ! + ! Tracers satisfying equations of the form (2) are called "type 2". + ! The paradigmatic type 2 tracers are qi and qs (ice/snow enthalpy). + ! + ! The fields a, T1, and T2 are reconstructed in each grid cell with + ! 2nd-order accuracy. + ! + ! The mass-like field lives in the array "mass" and the tracers fields + ! in the array "trcr". + ! In order to transport tracers correctly, the remapping routine + ! needs to know the tracers types and relationships. This is done + ! as follows: + ! + ! Each field in the "trcr" array is assigned an index, 1:max_ntrace. + ! (Note: max_ntrace is not the same as max_ntrcr, the number of tracers + ! in the trcrn state variable array. For remapping purposes we + ! have additional tracers hi, hs, qi and qs.) + ! For CICE with ntrcr = 1, nilyr = 4, and nslyr = 1, the + ! indexing is as follows: + ! 1 = hi + ! 2 = hs + ! 3 = Ts + ! 4-7 = qi + ! 8 = qs + ! + ! The tracer types (1,2) are contained in the "tracer_type" array. + ! For standard CICE: + ! + ! tracer_type = (1 1 1 2 2 2 2 2) + ! + ! Type 2 tracers are said to depend on type 1 tracers. + ! For instance, qi depends on hi, which is to say that + ! there is a conservation equation of the form (2) or (5). + ! Thus we define a "depend" array. For standard CICE: + ! + ! depend = (0 0 0 1 1 1 1 2) + ! + ! which implies that elements 1-3 (hi, hs, Ts) are type 1, + ! elements 4-7 (qi) depend on element 1 (hi), and element 8 (qs) + ! depends on element 2 (hs). + ! + ! We also define a logical array "has_dependents". In standard CICE: + ! + ! has_dependents = (T T F F F F F F), + ! + ! which means that only elements 1 and 2 (hi and hs) have dependent tracers. + ! + ! Tracers added to the ntrcr array are handled automatically + ! by the remapping with little extra coding. It is necessary + ! only to provide the correct type and dependency information. + ! + ! When using this routine in other models (e.g., CISM), the tracer dependency + ! apparatus may be irrelevant. In a layered ocean model, for example, + ! the transported fields are the layer thickness h (the mass density + ! field) and two or more tracers (T, S, and various trace species). + ! Suppose there are just two tracers, T and S. Then the tracer arrays + ! have the values: + ! + ! tracer_type = (1 1) + ! depend = (0 0) + ! has_dependents = (F F) + ! + ! which is to say that all tracer transport equations are of the form (1). + ! + ! The tracer dependency arrays are optional input arguments for the + ! main remapping subroutine. If these arrays are not passed in, they + ! take on the default values tracer_type(:) = 1, depend(:) = 0, and + ! has_dependents(:) = F, which are appropriate for most purposes. + ! + ! Another optional argument is integral_order. If integral_order = 1, + ! then the triangle integrals are exact for linear functions of x and y. + ! If integral_order = 2, these integrals are exact for both linear and + ! quadratic functions. If integral_order = 3, integrals are exact for + ! cubic functions as well. If all tracers are of type 1, then the + ! integrals of mass*tracer are quadratic, and integral_order = 2 is + ! sufficient. In CICE, where there are type 2 tracers, we integrate + ! functions of the form mass*tracer1*tracer2. Thus integral_order = 3 + ! is required for exactness, though integral_order = 2 may be good enough + ! in practice. + ! + ! Finally, a few words about the edgearea fields: + ! + ! In earlier versions of this scheme, the divergence of the velocity + ! field implied by the remapping was, in general, different from the + ! value of del*u computed in the dynamics. For energetic consistency + ! (in CICE as well as in layered ocean models such as HYPOP), + ! these two values should agree. This can be ensured by setting + ! prescribed_area = T and specifying the area transported across each grid + ! cell edge in the arrays edgearea_e and edgearea_n. The departure + ! regions are then tweaked, following an idea by Mats Bentsen, such + ! that they have the desired area. If prescribed_area = F, these regions + ! are not tweaked, and the edgearea arrays are output variables. + ! + ! Notes on the adaptation to CISM: + ! + ! We assume that all tracers are type 1, so the above arrays, + ! if defined, would have the following values: + ! + ! tracer_type = (1 1 ...) + ! depend = (0 0 ...) + ! has_dependents = (F F ...) + ! + ! But to simplify the code, these arrays have been removed throughout. + ! + ! Also, CISM assumes that the U grid (for velocity) is smaller than the + ! T grid (for scalars). If the T grid has dimensions (nx,ny), then the + ! U grid has dimensions (nx-1,ny-1). + ! + ! For nghost = 2, the U grid has two halo rows to the south and west, but + ! only one halo row to the north and east. + ! + ! For both the T and U grids, the local cells have dimensions (ilo:ihi,jlo:jhi), + ! where ilo = 1+nhalo, ihi = nx-nhalo + ! jlo = 1+nhalo, jhi = ny-nhalo + ! + !======================================================================= + + contains + + !======================================================================= + + subroutine glissade_horizontal_remap (dt, & + dx, dy, & + nx_block, ny_block, & + ntracer, nghost, & + mmask, icells, & + indxi, indxj, & + uvel, vvel, & + mass, trcr, & + edgearea_e, edgearea_n, & + prescribed_area_in, & + integral_order_in, dp_midpt_in) + + ! Solve the transport equations for one timestep using the incremental + ! remapping scheme developed by John Dukowicz and John Baumgardner (DB) + ! and modified for sea ice by William Lipscomb and Elizabeth Hunke. + ! + ! This scheme preserves monotonicity of mass and tracers. That is, + ! it does not produce new extrema. It is second-order accurate in space, + ! except where gradients are limited to preserve monotonicity. + ! + ! This version of the remapping allows the user to specify the areal + ! flux across each edge, based on an idea developed by Mats Bentsen. + ! + + use parallel + + ! input/output arguments + + real(dp), intent(in) :: & + dt ! time step + + real(dp), intent(in) :: & + dx, dy ! x and y gridcell dimensions + + integer, intent(in) :: & + nx_block ,&! number of cells in x direction + ny_block ,&! number of cells in y direction + ntracer ,&! number of tracers to be transported + nghost ,&! number of ghost rows/columns (= nhalo) + icells ! number of cells with nonzero mass + + integer, intent(in), dimension(nx_block*ny_block) :: & + indxi, indxj ! compressed i/j indices + + ! Note dimensions of uvel and vvel + ! This is the CISM convention: U grid is smaller than T grid + real(dp), intent(in), dimension(nx_block-1,ny_block-1) :: & + uvel ,&! x-component of velocity (m/s) + vvel ! y-component of velocity (m/s) + + real(dp), intent(inout), dimension (nx_block,ny_block) :: & + mass ,&! mean mass values in each grid cell + mmask ! = 1. if mass is present, = 0. otherwise + + real(dp), intent(inout), dimension (nx_block,ny_block,ntracer) :: & + trcr ! mean tracer values in each grid cell + + !------------------------------------------------------------------- + ! If prescribed_area is true, the area of each departure region is + ! computed in advance (e.g., by taking the divergence of the + ! velocity field) and passed to locate_triangles. The departure + ! regions are adjusted to obtain the desired area. + ! If false, edgearea_e and edgearea_n are computed in locate_triangles and passed out. + !------------------------------------------------------------------- + + real(dp), dimension(nx_block,ny_block), intent(inout) :: & + edgearea_e ,&! area of departure regions for east edges + edgearea_n ! area of departure regions for north edges + + logical, intent(in), optional :: & + prescribed_area_in ! if true, edgearea_e and edgearea_n are prescribed + ! if false, edgearea is computed here and passed out + + integer, intent(in), optional :: & + integral_order_in ! polynomial order for triangle integrals + ! 1 = exact for linear functions + ! 2 = exact for quadratic functions + + logical, intent(in), optional :: & + dp_midpt_in ! if true, find departure points using + ! corrected midpoint velocity + + ! local variables + + logical :: & + prescribed_area, dp_midpt ! defined above + + integer :: integral_order ! defined above + + integer :: & + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + real(dp), dimension (nx_block-1,ny_block-1) :: & + dpx ,&! x coordinates of departure points at cell corners + dpy ! y coordinates of departure points at cell corners + + real(dp), dimension(nx_block,ny_block) :: & + mc ,&! mass at geometric center of cell + mx, my ! limited derivative of mass wrt x and y + + real(dp), dimension (nx_block,ny_block,ntracer) :: & + tc ,&! tracer values at geometric center of cell + tx, ty ! limited derivative of tracer wrt x and y + + real(dp), dimension (nx_block,ny_block) :: & + mflxe, mflxn ! mass transports across E and N cell edges + + real(dp), dimension (nx_block,ny_block,ntracer) :: & + mtflxe, mtflxn ! mass*tracer transports across E and N cell edges + + real(dp), dimension (nx_block,ny_block,ngroups) :: & + triarea ! area of east-edge departure triangle + + real(dp), dimension (nx_block,ny_block,0:nvert,ngroups) :: & + xp, yp ! x and y coordinates of special triangle points + + integer, dimension (nx_block,ny_block,ngroups) :: & + iflux ,&! i index of cell contributing transport + jflux ! j index of cell contributing transport + + integer, dimension(ngroups) :: & + icellsng ! number of cells with contribution from a given group + + integer, dimension(nx_block*ny_block,ngroups) :: & + indxing, indxjng ! compressed i/j indices + + logical :: & + l_stop ! if true, abort the model + + character (len=5) :: & + edge ! 'north' or 'east' + + real(dp), dimension(nx_block,ny_block) :: & + worka, workb, workc, workd + + !Note - Could save some computations by passing in the following or assuming they are + ! the same for all grid cells + + real(dp), dimension (nx_block,ny_block) :: & + domain_mask ,&! domain mask, = 1 wherever ice is allowed to be present + ! (typically = 1 everywhere) + ! used for gradient-limiting of mass field + dxt ,&! T-cell width (m) + dyt ,&! T-cell height (m) + dxu ,&! U-cell width (m) + dyu ,&! U-cell height (m) + htn ,&! length of north cell edge (m) + hte ! length of east cell edge (m) + + real(dp) :: & + tarear ! reciprocal grid cell area + + real(dp), dimension (nx_block,ny_block) :: & + xav, yav ,&! gridcell avg values of x, y + xxav, xyav, yyav ! gridcell avg values of xx, xy, yy + + character(len=200) :: message + + !------------------------------------------------------------------- + ! Initialize various grid quantities and code options + !------------------------------------------------------------------- + + ! Assume that ice can exist everywhere on the domain + ! May need to pass this in as an argument if parts of the domain are masked out, + ! e.g. Ellesmere Island for a Greenland ice sheet simulation. + + domain_mask(:,:) = 1.d0 + + ! Assume gridcells are rectangular, in which case dxt = dxu = htn + ! and dyt = dyu = hte. + + dxt(:,:) = dx + dxu(:,:) = dx + htn(:,:) = dx + + dyt(:,:) = dy + dyu(:,:) = dy + hte(:,:) = dy + + if (dx*dy > 0.d0) then + tarear = 1.d0 / (dx*dy) + else + tarear = 0.d0 + endif + + xav(:,:) = 0.d0 + yav(:,:) = 0.d0 + xxav(:,:) = 1.d0 / 12.d0 ! These are the scaled values, valid if dxt = dyt = 1 + yyav(:,:) = 1.d0 / 12.d0 +!! xxav(:,:) = dxt(:,:)**2 / 12.d0 ! These would be used if dimensional values +!! yyav(:,:) = dyt(:,:)**2 / 12.d0 ! of dxt and dyt were passed to construct_fields + xyav(:,:) = 0.d0 + + l_stop = .false. + + if (present(integral_order_in)) then + integral_order = integral_order_in + else + integral_order = 2 ! exact for integrating quadratic functions + endif + + if (present(dp_midpt_in)) then + dp_midpt = dp_midpt_in + else + dp_midpt = .true. + endif + + if (present(prescribed_area_in)) then + prescribed_area = prescribed_area_in + else + prescribed_area = .false. + endif + + ! These arrays are passed to construct_fields in lieu of the dimensional + ! values of dxt, dyt, htn, and hte. + ! + worka(:,:) = 1.d0 + workb(:,:) = 1.d0 + workc(:,:) = 1.d0 + workd(:,:) = 1.d0 + + ! Compute lower and upper indices for locally owned cells + ilo = 1 + nghost + ihi = nx_block - nghost + jlo = 1 + nghost + jhi = ny_block - nghost + + !------------------------------------------------------------------- + ! Construct linear fields, limiting gradients to preserve monotonicity. + ! Note: Pass in unit arrays instead of true distances hte, htn, etc. + ! The resulting gradients are in scaled coordinates. + !------------------------------------------------------------------- + + call construct_fields(nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, ntracer, & + icells, & + indxi (:), indxj(:), & +! htn (:,:), hte (:,:), & + worka (:,:), workb (:,:), & + domain_mask(:,:), xav (:,:), & + yav (:,:), xxav (:,:), & + xyav (:,:), yyav (:,:), & +! dxt (:,:), dyt (:,:), & + workc (:,:), workd (:,:), & + mass (:,:), mc (:,:), & + mx (:,:), my (:,:), & + mmask (:,:), & + trcr (:,:,:), tc (:,:,:), & + tx (:,:,:), ty (:,:,:)) + + !------------------------------------------------------------------- + ! Given velocity field at cell corners, compute departure points + ! of trajectories. + !------------------------------------------------------------------- + + call departure_points(nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, dt, & + uvel (:,:), vvel(:,:), & + dxu (:,:), dyu (:,:), & + htn (:,:), hte (:,:), & + dpx (:,:), dpy (:,:), & + dp_midpt, l_stop) + + if (l_stop) then + write(message,*) 'Aborting (task = ',this_rank,')' + call write_log(message) + write(message,*) 'Incremental remapping scheme failed. A CFL violation has likely occurred. See the log file for more information.' + call write_log(message,GM_FATAL) + endif + + !------------------------------------------------------------------- + ! Ghost cell updates + ! If nghost >= 2, these calls are not needed + !------------------------------------------------------------------- + + if (nghost==1) then + + ! mass field + call parallel_halo(mc) + call parallel_halo(mx) + call parallel_halo(my) + + ! tracer fields + call parallel_halo(tc) + call parallel_halo(tx) + call parallel_halo(ty) + + ! departure points + call parallel_halo(dpx) + call parallel_halo(dpy) + + endif ! nghost + + !------------------------------------------------------------------- + ! Transports for east cell edges. + !------------------------------------------------------------------- + + !------------------------------------------------------------------- + ! Compute areas and vertices of departure triangles. + !------------------------------------------------------------------- + + edge = 'east' + call locate_triangles(nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + edge, icellsng (:), & + indxing(:,:), indxjng(:,:), & + dpx (:,:), dpy (:,:), & + dxu (:,:), dyu (:,:), & + xp(:,:,:,:), yp(:,:,:,:), & + iflux(:,:,:), jflux(:,:,:), & + triarea(:,:,:), & + prescribed_area, edgearea_e(:,:)) + + !------------------------------------------------------------------- + ! Given triangle vertices, compute coordinates of triangle points + ! needed for transport integrals. + !------------------------------------------------------------------- + + call triangle_coordinates (nx_block, ny_block, & + icellsng (:), & + indxing(:,:), indxjng(:,:), & + xp, yp, & + integral_order) + + !------------------------------------------------------------------- + ! Compute the transport across east cell edges by summing contributions + ! from each triangle. + !------------------------------------------------------------------- + + call transport_integrals(nx_block, ny_block, & + ntracer, icellsng (:), & + indxing(:,:), indxjng(:,:), & + triarea(:,:,:), integral_order, & + iflux(:,:,:), jflux(:,:,:), & + xp(:,:,:,:), yp(:,:,:,:), & + mc(:,:), mx (:,:), & + my(:,:), mflxe(:,:), & + tc(:,:,:), tx (:,:,:), & + ty(:,:,:), mtflxe(:,:,:)) + + !------------------------------------------------------------------- + ! Repeat for north edges + !------------------------------------------------------------------- + + edge = 'north' + call locate_triangles(nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + edge, icellsng (:), & + indxing(:,:), indxjng(:,:), & + dpx (:,:), dpy (:,:), & + dxu (:,:), dyu (:,:), & + xp(:,:,:,:), yp(:,:,:,:), & + iflux(:,:,:), jflux(:,:,:), & + triarea(:,:,:), & + prescribed_area, edgearea_n(:,:)) + + call triangle_coordinates (nx_block, ny_block, & + icellsng (:), & + indxing(:,:), indxjng(:,:), & + xp, yp, & + integral_order) + + call transport_integrals(nx_block, ny_block, & + ntracer, icellsng (:), & + indxing(:,:), indxjng(:,:), & + triarea(:,:,:), integral_order, & + iflux(:,:,:), jflux(:,:,:), & + xp(:,:,:,:), yp(:,:,:,:), & + mc(:,:), mx (:,:), & + my(:,:), mflxn (:,:), & + tc(:,:,:), tx (:,:,:), & + ty(:,:,:), mtflxn(:,:,:)) + + !------------------------------------------------------------------- + ! Update the ice area and tracers. + !------------------------------------------------------------------- + + call update_fields (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + ntracer, & + tarear, l_stop, & + mflxe (:,:), mflxn (:,:), & + mass (:,:), & + mtflxe(:,:,:), mtflxn(:,:,:), & + trcr (:,:,:) ) + + if (l_stop) then + write(message,*) 'Aborting (task = ',this_rank,')' + call write_log(message,GM_FATAL) + endif + + end subroutine glissade_horizontal_remap + +!======================================================================= +! + subroutine make_remap_mask (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, icells, & + indxi, indxj, & + mass, mmask) + ! + ! Make ice mask; identify cells where ice is present. + ! + ! If a gridcell is massless (mass < puny), then the values of tracers + ! in that grid cell are assumed to have no physical meaning. + !WHL - Changed this condition from 'mass < puny' to 'mass < 0.d0' + ! to preserve monotonicity in grid cells with very small thickness + ! + ! author William H. + + !input/output arguments + + integer, intent(in) :: & + nx_block, ny_block ,&! block dimensions + ilo,ihi,jlo,jhi ,&! beginning and end of physical domain + nghost ! number of ghost cells + + integer, intent(out) :: & + icells ! number of cells with ice + + integer, dimension(nx_block*ny_block), intent(out) :: & + indxi ,&! compressed i/j indices + indxj + + real(dp), dimension (nx_block,ny_block), & + intent(in) :: & + mass ! mean ice thickness in each grid cell + + real(dp), dimension (nx_block,ny_block), & + intent(out) :: & + mmask ! = 1. if ice is present, else = 0. +! + integer :: & + i, j, ij ! indices + + !------------------------------------------------------------------- + ! ice mask + !------------------------------------------------------------------- + + !WHL - Changed this condition from 'mass(i,j) < puny' to 'mass(i,j) < 0.d0' + ! to preserve monotonicity in grid cells with very small thickness + do j = 1, ny_block + do i = 1, nx_block +!! if (mass(i,j) > puny) then + if (mass(i,j) > 0.d0) then + mmask(i,j) = 1.d0 + else + mmask(i,j) = 0.d0 + endif + enddo + enddo + + !------------------------------------------------------------------- + ! Tag grid cells where ice is present + ! For nghost = 1, exclude ghost cells + ! For nghost = 2, include one layer of ghost cells + !------------------------------------------------------------------- + + icells = 0 + do ij = 1, nx_block*ny_block + indxi(ij) = 0 + indxj(ij) = 0 + enddo + + do j = jlo-nghost+1, jhi+nghost-1 + do i = ilo-nghost+1, ihi+nghost-1 + !WHL - Changed this condition from 'mass(i,j) > puny' to 'mass(i,j) > 0.d0' + ! to preserve monotonicity in grid cells with very small thickness +!! if (mass(i,j) > puny) then + if (mass(i,j) > 0.d0) then + icells = icells + 1 + ij = icells + indxi(ij) = i + indxj(ij) = j + endif + enddo + enddo + + end subroutine make_remap_mask + +!======================================================================= +! + subroutine construct_fields (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, ntracer, & + icells, & + indxi, indxj, & + htn, hte, & + hm, xav, & + yav, xxav, & + xyav, yyav, & + dxt, dyt, & + mass, mc, & + mx, my, & + mmask, & + trcr, tc, & + tx, ty) + + ! Construct fields of ice mass and tracers. + ! + ! authors William H. Lipscomb, LANL + ! John R. Baumgardner, LANL + ! + ! input/output arguments + ! + integer, intent(in) :: & + nx_block, ny_block ,&! block dimensions + ilo,ihi,jlo,jhi ,&! beginning and end of physical domain + nghost ,&! number of ghost cell layers + ntracer ,&! number of tracers in use + icells ! number of cells with mass + + integer, dimension(nx_block*ny_block), intent(in) :: & + indxi ,&! compressed i/j indices + indxj + + real(dp), dimension (nx_block,ny_block), intent(in) :: & + hm ,&! domain mask + htn ,&! length of northern edge of T-cell (m) + hte ,&! length of eastern edge of T-cell (m) + xav, yav ,&! mean T-cell values of x, y + xxav, xyav, yyav ,&! mean T-cell values of xx, xy, yy + dxt ,&! grid cell width (m) + dyt ! grid cell height (m) + + real(dp), dimension (nx_block,ny_block), intent(in) :: & + mass ,&! mean value of mass field + mmask ! = 1. if ice is present, = 0. otherwise + + real(dp), dimension (nx_block,ny_block), intent(out) :: & + mc ,&! mass value at geometric center of cell + mx, my ! limited derivative of mass wrt x and y + + real(dp), dimension (nx_block,ny_block,ntracer), & + intent(in), optional :: & + trcr ! mean tracer + + real(dp), dimension (nx_block,ny_block,ntracer), & + intent(out), optional :: & + tc ,&! tracer at geometric center of cell + tx, ty ! limited derivative of tracer wrt x and y + + integer :: & + i, j, &! horizontal indices + nt, &! tracer index + ij ! combined i/j horizontal index + + real(dp), dimension (nx_block,ny_block) :: & + mxav ,&! x coordinate of center of mass + myav ! y coordinate of center of mass + + !------------------------------------------------------------------- + ! Compute field values at the geometric center of each grid cell, + ! and compute limited gradients in the x and y directions. + ! + ! For second order accuracy, each state variable is approximated as + ! a field varying linearly over x and y within each cell. For each + ! category, the integrated value of m(x,y) over the cell must + ! equal mass(i,j,n)*tarea(i,j), where tarea(i,j) is the cell area. + ! Similarly, the integrated value of m(x,y)*t(x,y) must equal + ! the total mass*tracer, mass(i,j,n)*trcr(i,j,n)*tarea(i,j). + ! + ! These integral conditions are satisfied for linear fields if we + ! stipulate the following: + ! (1) The mean mass is equal to the mass at the cell centroid. + ! (2) The mean value trcr1 of type 1 tracers is equal to the value + ! at the center of mass. + ! (3) The mean value trcr2 of type 2 tracers is equal to the value + ! at the center of mass*trcr1, where trcr2 depends on trcr1. + ! (See comments at the top of the module.) + ! + ! We want to find the value of each state variable at a standard + ! reference point, which we choose to be the geometric center of + ! the cell. The geometric center is located at the intersection + ! of the line joining the midpoints of the north and south edges + ! with the line joining the midpoints of the east and west edges. + ! To find the value at the geometric center, we must know the + ! location of the cell centroid/center of mass, along with the + ! mean value and the gradients with respect to x and y. + ! + ! The cell gradients are first computed from the difference between + ! values in the neighboring cells, then limited by requiring that + ! no new extrema are created within the cell. + ! + ! For rectangular coordinates the centroid and the geometric + ! center coincide, which means that some of the equations in this + ! subroutine could be simplified. However, the full equations + ! are retained for generality. + !------------------------------------------------------------------- + + !------------------------------------------------------------------- + ! Initialize + !------------------------------------------------------------------- + + do j = 1, ny_block + do i = 1, nx_block + mc(i,j) = 0.d0 + mx(i,j) = 0.d0 + my(i,j) = 0.d0 + mxav(i,j) = 0.d0 + myav(i,j) = 0.d0 + enddo + enddo + + if (present(trcr)) then + do nt = 1, ntracer + do j = 1, ny_block + do i = 1, nx_block + tc(i,j,nt) = 0.d0 + tx(i,j,nt) = 0.d0 + ty(i,j,nt) = 0.d0 + enddo + enddo + enddo + endif + + ! limited gradient of mass field in each cell (except masked cells) + ! Note: The gradient is computed in scaled coordinates with + ! dxt = dyt = hte = htn = 1. + + call limited_gradient (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, & + mass, hm, & + xav, yav, & + htn, hte, & + dxt, dyt, & + mx, my) + + do ij = 1,icells ! ice is present + i = indxi(ij) + j = indxj(ij) + + ! mass field at geometric center + mc(i,j) = mass(i,j) - xav(i,j)*mx(i,j) & + - yav(i,j)*my(i,j) + + enddo ! ij + + ! tracers + + if (present(trcr)) then + + do ij = 1,icells ! cells with mass + i = indxi(ij) + j = indxj(ij) + + ! center of mass (mxav,myav) for each cell + mxav(i,j) = (mx(i,j)*xxav(i,j) & + + my(i,j)*xyav(i,j) & + + mc(i,j)*xav (i,j)) / mass(i,j) + myav(i,j) = (mx(i,j)*xyav(i,j) & + + my(i,j)*yyav(i,j) & + + mc(i,j)*yav (i,j)) / mass(i,j) + enddo + + do nt = 1, ntracer + + call limited_gradient(nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, & + trcr(:,:,nt), mmask, & + mxav, myav, & + htn, hte, & + dxt, dyt, & + tx(:,:,nt), ty(:,:,nt)) + + do ij = 1, icells ! mass is present + i = indxi(ij) + j = indxj(ij) + + ! tracer value at geometric center + tc(i,j,nt) = trcr(i,j,nt) - tx(i,j,nt)*mxav(i,j) & + - ty(i,j,nt)*myav(i,j) + enddo ! ij + + enddo ! ntracer + + endif ! present (trcr) + + end subroutine construct_fields + +!======================================================================= + + subroutine limited_gradient (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, & + phi, phimask, & + cnx, cny, & + htn, hte, & + dxt, dyt, & + gx, gy) + + ! Compute a limited gradient of the scalar field phi in scaled coordinates. + ! "Limited" means that we do not create new extrema in phi. For + ! instance, field values at the cell corners can neither exceed the + ! maximum of phi(i,j) in the cell and its eight neighbors, nor fall + ! below the minimum. + ! + ! + ! authors William H. Lipscomb, LANL + ! John R. Baumgardner, LANL + ! + ! input/output arguments + ! + integer, intent(in) :: & + nx_block, ny_block,&! block dimensions + ilo,ihi,jlo,jhi ,&! beginning and end of physical domain + nghost ! number of ghost cell layers + + real(dp), dimension (nx_block,ny_block), & + intent (in) :: & + phi ,&! input tracer field (mean values in each grid cell) + cnx ,&! x-coordinate of phi relative to geometric center of cell + cny ,&! y-coordinate of phi relative to geometric center of cell + dxt ,&! grid cell width (m) + dyt ,&! grid cell height (m) + phimask ,& + ! phimask(i,j) = 1 if phi(i,j) has physical meaning, = 0 otherwise. + ! For instance, aice has no physical meaning in land cells, + ! and hice no physical meaning where aice = 0. + htn ,&! length of northern edge of T-cell (m) + hte ! length of eastern edge of T-cell (m) + + real(dp), dimension (nx_block,ny_block), & + intent(out) :: & + gx ,&! limited x-direction gradient + gy ! limited y-direction gradient + + integer :: & + i, j, ij ,&! standard indices + icells ! number of cells to limit + + integer, dimension(nx_block*ny_block) :: & + indxi, indxj ! combined i/j horizontal indices + + real(dp) :: & + phi_nw, phi_n, phi_ne ,&! values of phi in 8 neighbor cells + phi_w, phi_e ,& + phi_sw, phi_s, phi_se ,& + qmn, qmx ,&! min and max value of phi within grid cell + pmn, pmx ,&! min and max value of phi among neighbor cells + w1, w2, w3, w4 ! work variables + + real(dp) :: & + gxtmp, gytmp ! temporary term for x- and y- limited gradient + + gx(:,:) = 0.d0 + gy(:,:) = 0.d0 + + ! For nghost = 1, loop over physical cells and update ghost cells later + ! For nghost = 2, loop over a layer of ghost cells and skip the update + + icells = 0 + do j = jlo-nghost+1, jhi+nghost-1 + do i = ilo-nghost+1, ihi+nghost-1 + if (phimask(i,j) > puny) then + icells = icells + 1 + indxi(icells) = i + indxj(icells) = j + endif ! phimask > puny + enddo + enddo + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + ! Store values of phi in the 8 neighbor cells. + ! Note: phimask = 1. or 0. If phimask = 1., use the true value; + ! if phimask = 0., use the home cell value so that non-physical + ! values of phi do not contribute to the gradient. + phi_nw = phimask(i-1,j+1) * phi(i-1,j+1) & + + (1.d0-phimask(i-1,j+1))* phi(i,j) + phi_n = phimask(i,j+1) * phi(i,j+1) & + + (1.d0-phimask(i,j+1)) * phi(i,j) + phi_ne = phimask(i+1,j+1) * phi(i+1,j+1) & + + (1.d0-phimask(i+1,j+1))* phi(i,j) + phi_w = phimask(i-1,j) * phi(i-1,j) & + + (1.d0-phimask(i-1,j)) * phi(i,j) + phi_e = phimask(i+1,j) * phi(i+1,j) & + + (1.d0-phimask(i+1,j)) * phi(i,j) + phi_sw = phimask(i-1,j-1) * phi(i-1,j-1) & + + (1.d0-phimask(i-1,j-1))* phi(i,j) + phi_s = phimask(i,j-1) * phi(i,j-1) & + + (1.d0-phimask(i,j-1)) * phi(i,j) + phi_se = phimask(i+1,j-1) * phi(i+1,j-1) & + + (1.d0-phimask(i+1,j-1))* phi(i,j) + + ! unlimited gradient components + ! (factors of two cancel out) + + gxtmp = (phi_e - phi(i,j)) / (dxt(i,j) + dxt(i+1,j)) & + + (phi(i,j) - phi_w) / (dxt(i-1,j) + dxt(i,j) ) + gytmp = (phi_n - phi(i,j)) / (dyt(i,j) + dyt(i,j+1)) & + + (phi(i,j) - phi_s) / (dyt(i,j-1) + dyt(i,j) ) + + ! minimum and maximum among the nine local cells + pmn = min (phi_nw, phi_n, phi_ne, phi_w, phi(i,j), & + phi_e, phi_sw, phi_s, phi_se) + pmx = max (phi_nw, phi_n, phi_ne, phi_w, phi(i,j), & + phi_e, phi_sw, phi_s, phi_se) + + pmn = pmn - phi(i,j) + pmx = pmx - phi(i,j) + + ! minimum and maximum deviation of phi within the cell + + w1 = (0.5d0*htn(i,j) - cnx(i,j)) * gxtmp & + + (0.5d0*hte(i,j) - cny(i,j)) * gytmp + w2 = (0.5d0*htn(i,j-1) - cnx(i,j)) * gxtmp & + - (0.5d0*hte(i,j) + cny(i,j)) * gytmp + w3 = -(0.5d0*htn(i,j-1) + cnx(i,j)) * gxtmp & + - (0.5d0*hte(i-1,j) + cny(i,j)) * gytmp + w4 = (0.5d0*hte(i-1,j) - cny(i,j)) * gytmp & + - (0.5d0*htn(i,j) + cnx(i,j)) * gxtmp + + qmn = min (w1, w2, w3, w4) + qmx = max (w1, w2, w3, w4) + + ! the limiting coefficient + if (abs(qmn) > 0.d0) then ! 'abs(qmn) > puny' not sufficient + w1 = max(0.d0, pmn/qmn) + else + w1 = 1.d0 + endif + + if (abs(qmx) > 0.d0) then + w2 = max(0.d0, pmx/qmx) + else + w2 = 1.d0 + endif + + w1 = min(1.d0, w1, w2) + + ! Limit the gradient components + gx(i,j) = w1 * gxtmp + gy(i,j) = w1 * gytmp + + enddo ! ij + + end subroutine limited_gradient + +!======================================================================= +! + subroutine departure_points (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + nghost, dt, & + uvel, vvel, & + dxu, dyu, & + htn, hte, & + dpx, dpy, & + dp_midpt, l_stop) + ! + ! Given velocity fields on cell corners, compute departure points + ! of back trajectories in nondimensional coordinates. + ! + ! author William H. Lipscomb, LANL + ! + ! input/output arguments + + integer, intent(in) :: & + nx_block, ny_block,&! block dimensions + ilo,ihi,jlo,jhi, &! beginning and end of physical domain + nghost ! number of ghost cell layers + + real(dp), intent(in) :: & + dt ! time step (s) + + real(dp), dimension (nx_block-1,ny_block-1), intent(in) :: & + uvel ,&! x-component of velocity (m/s) + vvel ! y-component of velocity (m/s) + + real(dp), dimension (nx_block-1,ny_block-1), intent(out) :: & + dpx ,&! coordinates of departure points (m) + dpy ! coordinates of departure points (m) + + real(dp), dimension (nx_block,ny_block), intent(in) :: & + dxu ,&! E-W dimensions of U-cell (m) + dyu ,&! N-S dimensions of U-cell (m) + htn ,&! length of north face of T-cell (m) + hte ! length of east face of T-cell (m) + + logical, intent(in) :: & + dp_midpt ! if true, find departure points using + ! corrected midpoint velocity + + logical, intent(inout) :: & + l_stop ! if true, abort on return + + ! local variables + + integer :: & + i, j, i2, j2 ! horizontal indices + + real(dp) :: & + mpx, mpy ,&! coordinates of midpoint of back trajectory, + ! relative to cell corner + mpxt, mpyt ,&! midpoint coordinates relative to cell center + ump, vmp ! corrected velocity at midpoint + + integer :: & + istop, jstop ! indices of grid cell where model aborts + + character(len=100) :: message + + !------------------------------------------------------------------- + ! Estimate departure points. + ! This estimate is 1st-order accurate in time; improve accuracy by + ! using midpoint approximation (to add later). + ! For nghost = 1, loop over physical cells and update ghost cells later. + ! For nghost = 2, loop over a layer of ghost cells and skip update. + !------------------------------------------------------------------- + + dpx(:,:) = 0.d0 + dpy(:,:) = 0.d0 + + ! Note: If nghost = 1, then this loop will include all vertices of all locally owned cells, + ! including halo values along the west and south edges of the domain. + ! If nghost = 2, then this loop includes an additional layer of cells around the domain, + ! as needed if we are using the midpoint correction method. + + do j = jlo-nghost, jhi+nghost-1 + do i = ilo-nghost, ihi+nghost-1 + + dpx(i,j) = -dt*uvel(i,j) + dpy(i,j) = -dt*vvel(i,j) + + ! Check for values out of bounds (more than one grid cell away) + if (dpx(i,j) < -htn(i,j) .or. dpx(i,j) > htn(i+1,j) .or. & + dpy(i,j) < -hte(i,j) .or. dpy(i,j) > hte(i,j+1)) then + + !WHL - debug +! print*, ' ' +! print*, 'dt =', dt +! print*, 'i, j =', i, j +! print*, 'dpx, dpy =', dpx(i,j), dpy(i,j) +! print*, 'hte, htn =', hte(i,j), htn(i,j) +! print*, 'bad departure points' + + l_stop = .true. + istop = i + jstop = j + endif + + enddo + enddo + + !TODO - Write error message to the log file. + ! I think this will require broadcasting istop and jstop to main_task. + ! For now, just print an error message locally. + + if (l_stop) then + i = istop + j = jstop +! write (message,*) 'Process:',this_rank +! call write_log(message) +! write (message,*) 'Remap, departure points out of bounds:, i, j =', i, j +! call write_log(message) +! write (message,*) 'dpx, dpy =', dpx(i,j), dpy(i,j) +! call write_log(message) +! write (message,*) 'uvel, vvel =', uvel(i,j), vvel(i,j) +! call write_log(message) +! write (message,*) 'htn(i,j), htn(i+1,j) =', htn(i,j), htn(i+1,j) +! call write_log(message) +! write (message,*) 'hte(i,j), hte(i,j+1) =', hte(i,j), hte(i,j+1) +! call write_log(message) + write (6,*) 'Process:', this_rank + write (6,*) 'Remap, departure points out of bounds:, local i, j =', i, j + write (6,*) 'dpx, dpy =', dpx(i,j), dpy(i,j) + write (6,*) 'uvel, vvel =', uvel(i,j), vvel(i,j) + write (6,*) 'htn(i,j), htn(i+1,j) =', htn(i,j), htn(i+1,j) + write (6,*) 'hte(i,j), hte(i,j+1) =', hte(i,j), hte(i,j+1) + return + endif + + !Note: Need nghost >= 2 to do this correction, which requires velocities + ! for vertices with indices (ilo-2) and (jlo-2). + + if (dp_midpt .and. nghost>= 2) then ! find dep pts using corrected midpt velocity + + do j = jlo-1, jhi + do i = ilo-1, ihi + + if (uvel(i,j)/=0.d0 .or. vvel(i,j)/=0.d0) then + + !------------------------------------------------------------------- + ! Scale departure points to coordinate system in which grid cells + ! have sides of unit length. + !------------------------------------------------------------------- + + dpx(i,j) = dpx(i,j) / dxu(i,j) + dpy(i,j) = dpy(i,j) / dyu(i,j) + + !------------------------------------------------------------------- + ! Estimate midpoint of backward trajectory relative to corner (i,j). + !------------------------------------------------------------------- + + mpx = 0.5d0 * dpx(i,j) + mpy = 0.5d0 * dpy(i,j) + + !------------------------------------------------------------------- + ! Determine the indices (i2,j2) of the cell where the trajectory lies. + ! Compute the coordinates of the midpoint of the backward trajectory + ! relative to the cell center in a stretched coordinate system + ! with vertices at (1/2, 1/2), (1/2, -1/2), etc. + !------------------------------------------------------------------- + + if (mpx >= 0.d0 .and. mpy >= 0.d0) then ! cell (i+1,j+1) + i2 = i+1 + j2 = j+1 + mpxt = mpx - 0.5d0 + mpyt = mpy - 0.5d0 + elseif (mpx < 0.d0 .and. mpy < 0.d0) then ! cell (i,j) + i2 = i + j2 = j + mpxt = mpx + 0.5d0 + mpyt = mpy + 0.5d0 + elseif (mpx >= 0.d0 .and. mpy < 0.d0) then ! cell (i+1,j) + i2 = i+1 + j2 = j + mpxt = mpx - 0.5d0 + mpyt = mpy + 0.5d0 + elseif (mpx < 0.d0 .and. mpy >= 0.d0) then ! cell (i,j+1) + i2 = i + j2 = j+1 + mpxt = mpx + 0.5d0 + mpyt = mpy - 0.5d0 + endif + + !------------------------------------------------------------------- + ! Using a bilinear approximation, estimate the velocity at the + ! trajectory midpoint in the (i2,j2) reference frame. + !------------------------------------------------------------------- + + ump = uvel(i2-1,j2-1)*(mpxt-0.5d0)*(mpyt-0.5d0) & + - uvel(i2, j2-1)*(mpxt+0.5d0)*(mpyt-0.5d0) & + + uvel(i2, j2 )*(mpxt+0.5d0)*(mpyt+0.5d0) & + - uvel(i2-1,j2 )*(mpxt-0.5d0)*(mpyt+0.5d0) + + vmp = vvel(i2-1,j2-1)*(mpxt-0.5d0)*(mpyt-0.5d0) & + - vvel(i2, j2-1)*(mpxt+0.5d0)*(mpyt-0.5d0) & + + vvel(i2, j2 )*(mpxt+0.5d0)*(mpyt+0.5d0) & + - vvel(i2-1,j2 )*(mpxt-0.5d0)*(mpyt+0.5d0) + + !------------------------------------------------------------------- + ! Use the midpoint velocity to estimate the coordinates of the + ! departure point relative to corner (i,j). + !------------------------------------------------------------------- + + dpx(i,j) = -dt * ump + dpy(i,j) = -dt * vmp + + endif ! nonzero velocity + + enddo ! i + enddo ! j + + endif ! dp_midpt + + end subroutine departure_points + +!======================================================================= +! + subroutine locate_triangles (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + edge, icells, & + indxi, indxj, & + dpx, dpy, & + dxu, dyu, & + xp, yp, & + iflux, jflux, & + triarea, & + prescribed_area, edgearea) + ! + ! Compute areas and vertices of transport triangles for north or + ! east cell edges. + ! + ! authors William H. Lipscomb, LANL + ! John R. Baumgardner, LANL + ! + ! input/output arguments + + integer, intent(in) :: & + nx_block, ny_block,&! block dimensions + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + character (len=5), intent(in) :: & + edge ! 'north' or 'east' + + real(dp), dimension(nx_block-1,ny_block-1), intent(in) :: & + dpx ,&! x coordinates of departure points at cell corners + dpy ! y coordinates of departure points at cell corners + + real(dp), dimension(nx_block,ny_block), intent(in) :: & + dxu ,&! E-W dimension of U-cell (m) + dyu ! N-S dimension of U-cell (m) + + real(dp), dimension (nx_block,ny_block,0:nvert,ngroups), & + intent(out) :: & + xp, yp ! coordinates of triangle vertices + + real(dp), dimension (nx_block,ny_block,ngroups), & + intent(out) :: & + triarea ! area of departure triangle + + integer, dimension (nx_block,ny_block,ngroups), intent(out) :: & + iflux ,&! i index of cell contributing transport + jflux ! j index of cell contributing transport + + integer, dimension (ngroups), intent(out) :: & + icells ! number of cells where triarea > puny + + integer, dimension (nx_block*ny_block,ngroups), & + intent(out) :: & + indxi ,&! compressed index in i-direction + indxj ! compressed index in j-direction + + logical, intent(in) :: & + prescribed_area ! if true, the area of each departure region is + ! passed in as edgearea + ! if false, edgearea if determined internally + ! and is passed out + + real(dp), dimension(nx_block,ny_block), intent(inout) :: & + edgearea ! area of departure region for each edge + ! edgearea > 0 for eastward/northward flow + + ! local variables + + integer :: & + i, j, ij, ic ,&! horizontal indices + ib, ie, jb, je ,&! limits for loops over edges + ng, nv ,&! triangle indices + ishift, jshift ! differences between neighbor cells + + integer :: & + icellsd ! number of cells where departure area > 0. + + integer, dimension (nx_block*ny_block) :: & + indxid ,&! compressed index in i-direction + indxjd ! compressed index in j-direction + + real(dp), dimension(nx_block,ny_block) :: & + dx, dy ,&! scaled departure points + areafac_c ,&! area scale factor at center of edge + areafac_l ,&! area scale factor at left corner + areafac_r ! area scale factor at right corner + + real(dp) :: & + xcl, ycl ,&! coordinates of left corner point + ! (relative to midpoint of edge) + xdl, ydl ,&! left departure point + xil, yil ,&! left intersection point + xcr, ycr ,&! right corner point + xdr, ydr ,&! right departure point + xir, yir ,&! right intersection point + xic, yic ,&! x-axis intersection point + xicl, yicl ,&! left-hand x-axis intersection point + xicr, yicr ,&! right-hand x-axis intersection point + xdm, ydm ,&! midpoint of segment connecting DL and DR; + ! shifted if prescribed_area = T + md ,&! slope of line connecting DL and DR + mdl ,&! slope of line connecting DL and DM + mdr ,&! slope of line connecting DR and DM + area1, area2 ,&! temporary triangle areas + area3, area4 ,&! + area_c ,&! center polygon area + w1, w2 ! work variables + + integer :: & + ishift_tl, jshift_tl ,&! i,j indices of TL cell relative to edge + ishift_bl, jshift_bl ,&! i,j indices of BL cell relative to edge + ishift_tr, jshift_tr ,&! i,j indices of TR cell relative to edge + ishift_br, jshift_br ,&! i,j indices of BR cell relative to edge + ishift_tc, jshift_tc ,&! i,j indices of TC cell relative to edge + ishift_bc, jshift_bc ! i,j indices of BC cell relative to edge + + real(dp), dimension (nx_block,ny_block,ngroups) :: & + areafact ! = 1 for positive flux, -1 for negative + + real(dp), dimension(nx_block,ny_block) :: & + areasum ! sum of triangle areas for a given edge + + !------------------------------------------------------------------- + ! Triangle notation: + ! For each edge, there are 20 triangles that can contribute, + ! but many of these are mutually exclusive. It turns out that + ! at most 5 triangles can contribute to transport integrals at once. + ! + ! See Figure 3 in DB for pictures of these triangles. + ! See Table 1 in DB for logical conditions. + ! + ! For the north edge, DB refer to these triangles as: + ! (1) NW, NW1, W, W2 + ! (2) NE, NE1, E, E2 + ! (3) NW2, W1, NE2, E1 + ! (4) H1a, H1b, N1a, N1b + ! (5) H2a, H2b, N2a, N2b + ! + ! For the east edge, DB refer to these triangles as: + ! (1) NE, NE1, N, N2 + ! (2) SE, SE1, S, S2 + ! (3) NE2, N1, SE2, S1 + ! (4) H1a, H1b, E1a, E2b + ! (5) H2a, H2b, E2a, E2b + ! + ! The code below works for either north or east edges. + ! The respective triangle labels are: + ! (1) TL, TL1, BL, BL2 + ! (2) TR, TR1, BR, BR2 + ! (3) TL2, BL1, TR2, BR1 + ! (4) BC1a, BC1b, TC1a, TC1b + ! (5) BC2a, BC2b, TC2a, TC2b + ! + ! where the cell labels are: + ! + ! | | + ! TL | TC | TR (top left, center, right) + ! | | + ! ------------------------ + ! | | + ! BL | BC | BR (bottom left, center, right) + ! | | + ! + ! and the transport is across the edge between cells TC and BC. + ! + ! Departure points are scaled to a local coordinate system + ! whose origin is at the midpoint of the edge. + ! In this coordinate system, the lefthand corner CL = (-0.5,0) + ! and the righthand corner CR = (0.5, 0). + !------------------------------------------------------------------- + + !------------------------------------------------------------------- + ! Initialize + !------------------------------------------------------------------- + + dx(:,:) = 0.d0 + dy(:,:) = 0.d0 + areafac_c(:,:) = 0.d0 + areafac_l(:,:) = 0.d0 + areafac_r(:,:) = 0.d0 + do ng = 1, ngroups + do j = 1, ny_block + do i = 1, nx_block + triarea (i,j,ng) = 0.d0 + areafact(i,j,ng) = 0.d0 + iflux (i,j,ng) = i + jflux (i,j,ng) = j + enddo + enddo + do nv = 0, nvert + do j = 1, ny_block + do i = 1, nx_block + xp(i,j,nv,ng) = 0.d0 + yp(i,j,nv,ng) = 0.d0 + enddo + enddo + enddo + enddo + + if (trim(edge) == 'north') then + + ! loop size + ! Note: The loop is over all north edges that border one or more locally owned grid + ! cells. This includes the north edges of cells with index (jlo-1), which are the south + ! edges of cells with index (jlo). + + ib = ilo + ie = ihi + jb = jlo - 1 ! lowest j index is a ghost cell + je = jhi + + ! index shifts for neighbor cells + + ishift_tl = -1 + jshift_tl = 1 + ishift_bl = -1 + jshift_bl = 0 + ishift_tr = 1 + jshift_tr = 1 + ishift_br = 1 + jshift_br = 0 + ishift_tc = 0 + jshift_tc = 1 + ishift_bc = 0 + jshift_bc = 0 + + ! area scale factor + + do j = jb, je + do i = ib, ie + areafac_l(i,j) = dxu(i-1,j)*dyu(i-1,j) + areafac_r(i,j) = dxu(i,j)*dyu(i,j) + areafac_c(i,j) = 0.5d0*(areafac_l(i,j) + areafac_r(i,j)) + enddo + enddo + + else ! east edge + + ! loop size + ! Note: The loop is over all east edges that border one or more locally owned grid + ! cells. This includes the east edges of cells with index (ilo-1), which are the west + ! edges of cells with index (ilo). + + ib = ilo - 1 ! lowest i index is a ghost cell + ie = ihi + jb = jlo + je = jhi + + ! index shifts for neighbor cells + + ishift_tl = 1 + jshift_tl = 1 + ishift_bl = 0 + jshift_bl = 1 + ishift_tr = 1 + jshift_tr = -1 + ishift_br = 0 + jshift_br = -1 + ishift_tc = 1 + jshift_tc = 0 + ishift_bc = 0 + jshift_bc = 0 + + ! area scale factors + + do j = jb, je + do i = ib, ie + areafac_l(i,j) = dxu(i,j)*dyu(i,j) + areafac_r(i,j) = dxu(i,j-1)*dyu(i,j-1) + areafac_c(i,j) = 0.5d0 * (areafac_l(i,j) + areafac_r(i,j)) + enddo + enddo + + endif + + !------------------------------------------------------------------- + ! Compute mask for edges with nonzero departure areas + !------------------------------------------------------------------- + + if (prescribed_area) then + icellsd = 0 + do j = jb, je + do i = ib, ie + if (edgearea(i,j) /= 0.d0) then + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif + enddo + enddo + else + icellsd = 0 + if (trim(edge) == 'north') then + do j = jb, je ! jb = jlo - 1 + do i = ib, ie ! ib = ilo + if (dpx(i-1,j)/=0.d0 .or. dpy(i-1,j)/=0.d0 & + .or. & + dpx(i,j)/=0.d0 .or. dpy(i,j)/=0.d0) then + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif + enddo + enddo + else ! east edge + do j = jb, je ! jb = jlo + do i = ib, ie ! ib = ilo - 1 + if (dpx(i,j-1)/=0.d0 .or. dpy(i,j-1)/=0.d0 & + .or. & + dpx(i,j)/=0.d0 .or. dpy(i,j)/=0.d0) then + icellsd = icellsd + 1 + indxid(icellsd) = i + indxjd(icellsd) = j + endif + enddo + enddo + endif ! edge = north/east + endif ! prescribed_area + + !------------------------------------------------------------------- + ! Scale the departure points. + ! Note: This loop must include all vertices of all edges for which + ! fluxes are computed. + !------------------------------------------------------------------- + + do j = jlo-1, jhi + do i = ilo-1, ihi + dx(i,j) = dpx(i,j) / dxu(i,j) + dy(i,j) = dpy(i,j) / dyu(i,j) + enddo + enddo + + !------------------------------------------------------------------- + ! Compute departure regions, divide into triangles, and locate + ! vertices of each triangle. + ! Work in a nondimensional coordinate system in which lengths are + ! scaled by the local metric coefficients (dxu and dyu). + ! Note: The do loop includes north faces of the j = 1 ghost cells + ! when edge = 'north'. The loop includes east faces of i = 1 + ! ghost cells when edge = 'east'. + !------------------------------------------------------------------- + + do ij = 1, icellsd + i = indxid(ij) + j = indxjd(ij) + + xcl = -0.5d0 + ycl = 0.d0 + + xcr = 0.5d0 + ycr = 0.d0 + + ! Departure points + + if (trim(edge) == 'north') then ! north edge + xdl = xcl + dx(i-1,j) + ydl = ycl + dy(i-1,j) + xdr = xcr + dx(i,j) + ydr = ycr + dy(i,j) + else ! east edge; rotate trajectory by pi/2 + xdl = xcl - dy(i,j) + ydl = ycl + dx(i,j) + xdr = xcr - dy(i,j-1) + ydr = ycr + dx(i,j-1) + endif + + xdm = 0.5d0 * (xdr + xdl) + ydm = 0.5d0 * (ydr + ydl) + + ! Intersection points + + xil = xcl + yil = (xcl*(ydm-ydl) + xdm*ydl - xdl*ydm) / (xdm - xdl) + + xir = xcr + yir = (xcr*(ydr-ydm) - xdm*ydr + xdr*ydm) / (xdr - xdm) + + md = (ydr - ydl) / (xdr - xdl) + + if (abs(md) > puny) then + xic = xdl - ydl/md + else + xic = 0.d0 + endif + yic = 0.d0 + + xicl = xic + yicl = yic + xicr = xic + yicr = yic + + !------------------------------------------------------------------- + ! Locate triangles in TL cell (NW for north edge, NE for east edge) + ! and BL cell (W for north edge, N for east edge). + !------------------------------------------------------------------- + + if (yil > 0.d0 .and. xdl < xcl .and. ydl >= 0.d0) then + + ! TL (group 1) + + ng = 1 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xil + yp (i,j,2,ng) = yil + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tl + jflux (i,j,ng) = j + jshift_tl + areafact(i,j,ng) = -areafac_l(i,j) + + elseif (yil < 0.d0 .and. xdl < xcl .and. ydl < 0.d0) then + + ! BL (group 1) + + ng = 1 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xil + yp (i,j,3,ng) = yil + iflux (i,j,ng) = i + ishift_bl + jflux (i,j,ng) = j + jshift_bl + areafact(i,j,ng) = areafac_l(i,j) + + elseif (yil < 0.d0 .and. xdl < xcl .and. ydl >= 0.d0) then + + ! TL1 (group 1) + + ng = 1 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xic + yp (i,j,3,ng) = yic + iflux (i,j,ng) = i + ishift_tl + jflux (i,j,ng) = j + jshift_tl + areafact(i,j,ng) = areafac_l(i,j) + + ! BL1 (group 3) + + ng = 3 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xic + yp (i,j,2,ng) = yic + xp (i,j,3,ng) = xil + yp (i,j,3,ng) = yil + iflux (i,j,ng) = i + ishift_bl + jflux (i,j,ng) = j + jshift_bl + areafact(i,j,ng) = areafac_l(i,j) + + elseif (yil > 0.d0 .and. xdl < xcl .and. ydl < 0.d0) then + + ! TL2 (group 3) + + ng = 3 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xil + yp (i,j,2,ng) = yil + xp (i,j,3,ng) = xic + yp (i,j,3,ng) = yic + iflux (i,j,ng) = i + ishift_tl + jflux (i,j,ng) = j + jshift_tl + areafact(i,j,ng) = -areafac_l(i,j) + + ! BL2 (group 1) + + ng = 1 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xic + yp (i,j,2,ng) = yic + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_bl + jflux (i,j,ng) = j + jshift_bl + areafact(i,j,ng) = -areafac_l(i,j) + + endif ! TL and BL triangles + + !------------------------------------------------------------------- + ! Locate triangles in TR cell (NE for north edge, SE for east edge) + ! and in BR cell (E for north edge, S for east edge). + !------------------------------------------------------------------- + + if (yir > 0.d0 .and. xdr >= xcr .and. ydr >= 0.d0) then + + ! TR (group 2) + + ng = 2 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xir + yp (i,j,3,ng) = yir + iflux (i,j,ng) = i + ishift_tr + jflux (i,j,ng) = j + jshift_tr + areafact(i,j,ng) = -areafac_r(i,j) + + elseif (yir < 0.d0 .and. xdr >= xcr .and. ydr < 0.d0) then + + ! BR (group 2) + + ng = 2 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xir + yp (i,j,2,ng) = yir + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_br + jflux (i,j,ng) = j + jshift_br + areafact(i,j,ng) = areafac_r(i,j) + + elseif (yir < 0.d0 .and. xdr >= xcr .and. ydr >= 0.d0) then + + ! TR1 (group 2) + + ng = 2 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xic + yp (i,j,2,ng) = yic + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_tr + jflux (i,j,ng) = j + jshift_tr + areafact(i,j,ng) = areafac_r(i,j) + + ! BR1 (group 3) + + ng = 3 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xir + yp (i,j,2,ng) = yir + xp (i,j,3,ng) = xic + yp (i,j,3,ng) = yic + iflux (i,j,ng) = i + ishift_br + jflux (i,j,ng) = j + jshift_br + areafact(i,j,ng) = areafac_r(i,j) + + elseif (yir > 0.d0 .and. xdr >= xcr .and. ydr < 0.d0) then + + ! TR2 (group 3) + + ng = 3 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xic + yp (i,j,2,ng) = yic + xp (i,j,3,ng) = xir + yp (i,j,3,ng) = yir + iflux (i,j,ng) = i + ishift_tr + jflux (i,j,ng) = j + jshift_tr + areafact(i,j,ng) = -areafac_r(i,j) + + ! BR2 (group 2) + + ng = 2 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xic + yp (i,j,3,ng) = yic + iflux (i,j,ng) = i + ishift_br + jflux (i,j,ng) = j + jshift_br + areafact(i,j,ng) = -areafac_r(i,j) + + endif ! TR and BR triangles + + !------------------------------------------------------------------- + ! Redefine departure points if not located in central cells (TC or BC) + !------------------------------------------------------------------- + + if (xdl < xcl) then + xdl = xil + ydl = yil + endif + + if (xdr > xcr) then + xdr = xir + ydr = yir + endif + + !------------------------------------------------------------------- + ! For prescribed_area = T, shift the midpoint so that the departure + ! region has the prescribed area + !------------------------------------------------------------------- + + if (prescribed_area) then + + ! Sum the areas of the left and right triangles. + ! Note that yp(i,j,1,ng) = 0 for all triangles, so we can + ! drop those terms from the area formula. + + ng = 1 + area1 = 0.5d0 * ( (xp(i,j,2,ng)-xp(i,j,1,ng)) * & + yp(i,j,3,ng) & + - yp(i,j,2,ng) * & + (xp(i,j,3,ng)-xp(i,j,1,ng)) ) & + * areafact(i,j,ng) + + ng = 2 + area2 = 0.5d0 * ( (xp(i,j,2,ng)-xp(i,j,1,ng)) * & + yp(i,j,3,ng) & + - yp(i,j,2,ng) * & + (xp(i,j,3,ng)-xp(i,j,1,ng)) ) & + * areafact(i,j,ng) + + ng = 3 + area3 = 0.5d0 * ( (xp(i,j,2,ng)-xp(i,j,1,ng)) * & + yp(i,j,3,ng) & + - yp(i,j,2,ng) * & + (xp(i,j,3,ng)-xp(i,j,1,ng)) ) & + * areafact(i,j,ng) + + !----------------------------------------------------------- + ! Check whether the central triangles lie in one grid cell or two. + ! If all are in one grid cell, then adjust the area of the central + ! region so that the sum of all triangle areas is equal to the + ! prescribed value. + ! If two triangles are in one grid cell and one is in the other, + ! then compute the area of the lone triangle using an area factor + ! corresponding to the adjacent corner. This is necessary to prevent + ! negative masses in some rare cases on curved grids. Then adjust + ! the area of the remaining two-triangle region so that the sum of + ! all triangle areas has the prescribed value. + !----------------------------------------------------------- + + if (ydl*ydr >= 0.d0) then ! Both DPs lie on same side of x-axis + + ! compute required area of central departure region + area_c = edgearea(i,j) - area1 - area2 - area3 + + ! shift midpoint so that the area of remaining triangles = area_c + w1 = 2.d0*area_c/areafac_c(i,j) & + + (xdr-xcl)*ydl + (xcr-xdl)*ydr + w2 = (xdr-xdl)**2 + (ydr-ydl)**2 + w1 = w1/w2 + xdm = xdm + (ydr - ydl) * w1 + ydm = ydm - (xdr - xdl) * w1 + + ! compute left and right intersection points + mdl = (ydm - ydl) / (xdm - xdl) + mdr = (ydr - ydm) / (xdr - xdm) + + if (abs(mdl) > puny) then + xicl = xdl - ydl/mdl + else + xicl = 0.d0 + endif + yicl = 0.d0 + + if (abs(mdr) > puny) then + xicr = xdr - ydr/mdr + else + xicr = 0.d0 + endif + yicr = 0.d0 + + elseif (xic < 0.d0) then ! fix ICL = IC + + xicl = xic + yicl = yic + + ! compute midpoint between ICL and DR + xdm = 0.5d0 * (xdr + xicl) + ydm = 0.5d0 * ydr + + ! compute area of triangle adjacent to left corner + area4 = 0.5d0 * (xcl - xic) * ydl * areafac_l(i,j) + area_c = edgearea(i,j) - area1 - area2 - area3 - area4 + + ! shift midpoint so that area of remaining triangles = area_c + w1 = 2.d0*area_c/areafac_c(i,j) + (xcr-xic)*ydr + w2 = (xdr-xic)**2 + ydr**2 + w1 = w1/w2 + xdm = xdm + ydr*w1 + ydm = ydm - (xdr - xic) * w1 + + ! compute ICR + mdr = (ydr - ydm) / (xdr - xdm) + if (abs(mdr) > puny) then + xicr = xdr - ydr/mdr + else + xicr = 0.d0 + endif + yicr = 0.d0 + + elseif (xic >= 0.d0) then ! fix ICR = IR + + xicr = xic + yicr = yic + + ! compute midpoint between ICR and DL + xdm = 0.5d0 * (xicr + xdl) + ydm = 0.5d0 * ydl + + area4 = 0.5d0 * (xic - xcr) * ydr * areafac_r(i,j) + area_c = edgearea(i,j) - area1 - area2 - area3 - area4 + + ! shift midpoint so that area of remaining triangles = area_c + w1 = 2.d0*area_c/areafac_c(i,j) + (xic-xcl)*ydl + w2 = (xic-xdl)**2 + ydl**2 + w1 = w1/w2 + xdm = xdm - ydl*w1 + ydm = ydm - (xic - xdl) * w1 + + ! compute ICL + + mdl = (ydm - ydl) / (xdm - xdl) + if (abs(mdl) > puny) then + xicl = xdl - ydl/mdl + else + xicl = 0.d0 + endif + yicl = 0.d0 + + endif ! ydl*ydr >= 0.d0 + + endif ! prescribed_area + + !------------------------------------------------------------------- + ! Locate triangles in BC cell (H for both north and east edges) + ! and TC cell (N for north edge and E for east edge). + !------------------------------------------------------------------- + + ! Start with cases where both DPs lie in the same grid cell + + if (ydl >= 0.d0 .and. ydr >= 0.d0 .and. ydm >= 0.d0) then + + ! T1.d0a (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xcr + yp (i,j,2,ng) = ycr + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! TC2a (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! TC3a (group 6) + ng = 6 + xp (i,j,1,ng) = xdl + yp (i,j,1,ng) = ydl + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + elseif (ydl >= 0.d0 .and. ydr >= 0.d0 .and. ydm < 0.d0) then ! rare + + ! TC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! TC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xicr + yp (i,j,3,ng) = yicr + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! BC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicr + yp (i,j,1,ng) = yicr + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr < 0.d0 .and. ydm < 0.d0) then + + ! BC1a (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xcr + yp (i,j,3,ng) = ycr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! BC2a (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! BC3a (group 6) + + ng = 6 + xp (i,j,1,ng) = xdl + yp (i,j,1,ng) = ydl + xp (i,j,2,ng) = xdm + yp (i,j,2,ng) = ydm + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr < 0.d0 .and. ydm >= 0.d0) then ! rare + + ! BC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xicl + yp (i,j,3,ng) = yicl + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! BC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! TC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicl + yp (i,j,1,ng) = yicl + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! Now consider cases where the two DPs lie in different grid cells. + ! For these cases, one triangle is given the area factor associated + ! with the adjacent corner, to avoid rare negative masses on curved grids. + + elseif (ydl >= 0.d0 .and. ydr < 0.d0 .and. xic >= 0.d0 & + .and. ydm >= 0.d0) then + + ! TC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! BC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_r(i,j) + + ! TC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xdl + yp (i,j,1,ng) = ydl + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + elseif (ydl >= 0.d0 .and. ydr < 0.d0 .and. xic >= 0.d0 & + .and. ydm < 0.d0 ) then ! less common + + ! TC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! BC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_r(i,j) + + ! BC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicr + yp (i,j,1,ng) = yicr + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl >= 0.d0 .and. ydr < 0.d0 .and. xic < 0.d0 & + .and. ydm < 0.d0) then + + ! TC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_l(i,j) + + ! BC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! BC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xdr + yp (i,j,1,ng) = ydr + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl >= 0.d0 .and. ydr < 0.d0 .and. xic < 0.d0 & + .and. ydm >= 0.d0) then ! less common + + ! TC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdl + yp (i,j,3,ng) = ydl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_l(i,j) + + ! BC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdr + yp (i,j,3,ng) = ydr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! TC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicl + yp (i,j,1,ng) = yicl + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr >= 0.d0 .and. xic < 0.d0 & + .and. ydm >= 0.d0) then + + ! BC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xicl + yp (i,j,3,ng) = yicl + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_l(i,j) + + ! TC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xicl + yp (i,j,3,ng) = yicl + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! TC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicl + yp (i,j,1,ng) = yicl + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr >= 0.d0 .and. xic < 0.d0 & + .and. ydm < 0.d0) then ! less common + + ! BC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xicl + yp (i,j,3,ng) = yicl + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_l(i,j) + + ! TC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xicr + yp (i,j,3,ng) = yicr + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + ! BC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicr + yp (i,j,1,ng) = yicr + xp (i,j,2,ng) = xicl + yp (i,j,2,ng) = yicl + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr >= 0.d0 .and. xic >= 0.d0 & + .and. ydm < 0.d0) then + + ! BC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xicr + yp (i,j,3,ng) = yicr + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! TC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xicr + yp (i,j,3,ng) = yicr + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_r(i,j) + + ! BC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicr + yp (i,j,1,ng) = yicr + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + elseif (ydl < 0.d0 .and. ydr >= 0.d0 .and. xic >= 0.d0 & + .and. ydm >= 0.d0) then ! less common + + ! BC1b (group 4) + + ng = 4 + xp (i,j,1,ng) = xcl + yp (i,j,1,ng) = ycl + xp (i,j,2,ng) = xdl + yp (i,j,2,ng) = ydl + xp (i,j,3,ng) = xicl + yp (i,j,3,ng) = yicl + iflux (i,j,ng) = i + ishift_bc + jflux (i,j,ng) = j + jshift_bc + areafact(i,j,ng) = areafac_c(i,j) + + ! TC2b (group 5) + + ng = 5 + xp (i,j,1,ng) = xcr + yp (i,j,1,ng) = ycr + xp (i,j,2,ng) = xdr + yp (i,j,2,ng) = ydr + xp (i,j,3,ng) = xicr + yp (i,j,3,ng) = yicr + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_r(i,j) + + ! TC3b (group 6) + + ng = 6 + xp (i,j,1,ng) = xicl + yp (i,j,1,ng) = yicl + xp (i,j,2,ng) = xicr + yp (i,j,2,ng) = yicr + xp (i,j,3,ng) = xdm + yp (i,j,3,ng) = ydm + iflux (i,j,ng) = i + ishift_tc + jflux (i,j,ng) = j + jshift_tc + areafact(i,j,ng) = -areafac_c(i,j) + + endif ! TC and BC triangles + + enddo ! ij + + !------------------------------------------------------------------- + ! Compute triangle areas with appropriate sign. + ! These are found by computing the area in scaled coordinates and + ! multiplying by a scale factor (areafact). + ! Note that the scale factor is positive for fluxes out of the cell + ! and negative for fluxes into the cell. + ! + ! Note: The triangle area formula below gives A >=0 iff the triangle + ! points x1, x2, and x3 are taken in counterclockwise order. + ! These points are defined above in such a way that the + ! order is nearly always CCW. + ! In rare cases, we may compute A < 0. In this case, + ! the quadrilateral departure area is equal to the + ! difference of two triangle areas instead of the sum. + ! The fluxes work out correctly in the end. + ! + ! Also compute the cumulative area transported across each edge. + ! If prescribed_area = T, this area is compared to edgearea as a bug check. + ! If prescribed_area = F, this area is passed as an output array. + !------------------------------------------------------------------- + + areasum(:,:) = 0.d0 + + do ng = 1, ngroups + icells(ng) = 0 + + do ij = 1, icellsd + i = indxid(ij) + j = indxjd(ij) + + triarea(i,j,ng) = 0.5d0 * ( (xp(i,j,2,ng)-xp(i,j,1,ng)) * & + (yp(i,j,3,ng)-yp(i,j,1,ng)) & + - (yp(i,j,2,ng)-yp(i,j,1,ng)) * & + (xp(i,j,3,ng)-xp(i,j,1,ng)) ) & + * areafact(i,j,ng) + + if (abs(triarea(i,j,ng)) < 1.e-16*areafac_c(i,j)) then + triarea(i,j,ng) = 0.d0 + else + icells(ng) = icells(ng) + 1 + ic = icells(ng) + indxi(ic,ng) = i + indxj(ic,ng) = j + endif + + areasum(i,j) = areasum(i,j) + triarea(i,j,ng) + + enddo ! ij + enddo ! ng + + if (prescribed_area) then + if (bugcheck) then ! set bugcheck = F to speed up code + do ij = 1, icellsd + i = indxid(ij) + j = indxjd(ij) + if (abs(areasum(i,j) - edgearea(i,j)) > 1.e-13*areafac_c(i,j)) then + print*, '' + print*, 'Areas do not add up: i, j, edge =', & + i, j, trim(edge) + print*, 'edgearea =', edgearea(i,j) + print*, 'areasum =', areasum(i,j) + print*, 'areafac_c =', areafac_c(i,j) + print*, '' + print*, 'Triangle areas:' + do ng = 1, ngroups + if (abs(triarea(i,j,ng)) > 1.e-16*abs(areafact(i,j,ng))) then + print*, ng, triarea(i,j,ng) + endif + enddo + endif + enddo + endif ! bugcheck + + else ! prescribed_area = F + do ij = 1, icellsd + i = indxid(ij) + j = indxjd(ij) + edgearea(i,j) = areasum(i,j) + enddo + endif ! prescribed_area + + !------------------------------------------------------------------- + ! Transform triangle vertices to a scaled coordinate system centered + ! in the cell containing the triangle. + !------------------------------------------------------------------- + + if (trim(edge) == 'north') then + do ng = 1, ngroups + do nv = 1, nvert + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + ishift = iflux(i,j,ng) - i + jshift = jflux(i,j,ng) - j + xp(i,j,nv,ng) = xp(i,j,nv,ng) - 1.d0*ishift + yp(i,j,nv,ng) = yp(i,j,nv,ng) + 0.5d0 - 1.d0*jshift + enddo ! ij + enddo ! nv + enddo ! ng + else ! east edge + do ng = 1, ngroups + do nv = 1, nvert + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + ishift = iflux(i,j,ng) - i + jshift = jflux(i,j,ng) - j + ! Note rotation of pi/2 here + w1 = xp(i,j,nv,ng) + xp(i,j,nv,ng) = yp(i,j,nv,ng) + 0.5d0 - 1.d0*ishift + yp(i,j,nv,ng) = -w1 - 1.d0*jshift + enddo ! ij + enddo ! nv + enddo ! ng + endif + + if (bugcheck) then + do ng = 1, ngroups + do nv = 1, nvert + do j = jb, je + do i = ib, ie + if (abs(triarea(i,j,ng)) > puny) then + if (abs(xp(i,j,nv,ng)) > 0.5d0+puny) then + print*, '' + print*, 'WARNING: xp =', xp(i,j,nv,ng) + print*, 'i, j, ng, nv =', i, j, ng, nv +! print*, 'yil,xdl,xcl,ydl=',yil,xdl,xcl,ydl +! print*, 'yir,xdr,xcr,ydr=',yir,xdr,xcr,ydr +! print*, 'ydm=',ydm +! stop + endif + if (abs(yp(i,j,nv,ng)) > 0.5d0+puny) then + print*, '' + print*, 'WARNING: yp =', yp(i,j,nv,ng) + print*, 'i, j, ng, nv =', i, j, ng, nv + endif + endif ! triarea + enddo + enddo + enddo + enddo + endif ! bugcheck + + end subroutine locate_triangles + +!======================================================================= +! + subroutine triangle_coordinates (nx_block, ny_block, & + icells, & + indxi, indxj, & + xp, yp, & + integral_order) + ! + ! For each triangle, find the coordinates of the quadrature points needed + ! to compute integrals of linear, quadratic, or cubic polynomials, + ! using formulas from A.H. Stroud, Approximate Calculation of Multiple + ! Integrals, Prentice-Hall, 1971. (Section 8.8, formula 3.1.) + ! Linear functions can be integrated exactly by evaluating the function + ! at just one point (the midpoint). Quadratic functions require + ! 3 points, and cubics require 4 points. + ! The default is cubic, but the code can be sped up slightly using + ! linear or quadratic integrals, usually with little loss of accuracy. + ! + ! The formulas are as follows: + ! + ! I1 = integral of f(x,y)*dA + ! = A * f(x0,y0) + ! where A is the traingle area and (x0,y0) is the midpoint. + ! + ! I2 = A * (f(x1,y1) + f(x2,y2) + f(x3,y3)) + ! where these three points are located halfway between the midpoint + ! and the three vertics of the triangle. + ! + ! I3 = A * [ -9/16 * f(x0,y0) + ! + 25/48 * (f(x1,y1) + f(x2,y2) + f(x3,y3))] + ! where (x0,y0) is the midpoint, and the other three points are + ! located 2/5 of the way from the midpoint to the three vertices. + ! + ! + ! author William H. Lipscomb, LANL + ! + ! + ! input/output arguments + + integer, intent(in) :: & + nx_block, ny_block ! block dimensions + + integer, dimension (ngroups), intent(in) :: & + icells ! number of cells where triarea > puny + + integer, dimension (nx_block*ny_block,ngroups), & + intent(in) :: & + indxi ,&! compressed index in i-direction + indxj ! compressed index in j-direction + + real(dp), intent(inout), & + dimension (nx_block, ny_block, 0:nvert, ngroups) :: & + xp, yp ! coordinates of triangle points + + integer, intent(in) :: & + integral_order ! 1 = linear, 2 = quadratic + + ! local variables + + integer :: & + i, j, ij ,&! horizontal indices + ng ! triangle index + + if (integral_order == 1) then ! linear (1-point formula) + + do ng = 1, ngroups + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + + ! coordinates of midpoint + xp(i,j,0,ng) = (xp(i,j,1,ng) + xp(i,j,2,ng) + xp(i,j,3,ng)) / 3.d0 + yp(i,j,0,ng) = (yp(i,j,1,ng) + yp(i,j,2,ng) + yp(i,j,3,ng)) / 3.d0 + + enddo ! ij + enddo ! ng + + elseif (integral_order == 2) then ! quadratic (3-point formula) + + do ng = 1, ngroups + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + + ! coordinates of midpoint + xp(i,j,0,ng) = (xp(i,j,1,ng) + xp(i,j,2,ng) + xp(i,j,3,ng)) / 3.d0 + yp(i,j,0,ng) = (yp(i,j,1,ng) + yp(i,j,2,ng) + yp(i,j,3,ng)) / 3.d0 + + ! coordinates of the 3 points needed for integrals + + xp(i,j,1,ng) = 0.5d0*xp(i,j,1,ng) + 0.5d0*xp(i,j,0,ng) + yp(i,j,1,ng) = 0.5d0*yp(i,j,1,ng) + 0.5d0*yp(i,j,0,ng) + + xp(i,j,2,ng) = 0.5d0*xp(i,j,2,ng) + 0.5d0*xp(i,j,0,ng) + yp(i,j,2,ng) = 0.5d0*yp(i,j,2,ng) + 0.5d0*yp(i,j,0,ng) + + xp(i,j,3,ng) = 0.5d0*xp(i,j,3,ng) + 0.5d0*xp(i,j,0,ng) + yp(i,j,3,ng) = 0.5d0*yp(i,j,3,ng) + 0.5d0*yp(i,j,0,ng) + + enddo ! ij + enddo ! ng + + endif + + end subroutine triangle_coordinates + +!======================================================================= +! + subroutine transport_integrals (nx_block, ny_block, & + ntracer, icells, & + indxi, indxj, & + triarea, integral_order, & + iflux, jflux, & + xp, yp, & + mc, mx, & + my, mflx, & + tc, tx, & + ty, mtflx) + + ! Compute the transports across each edge by integrating the mass + ! and tracers over each departure triangle. + ! Input variables have the same meanings as in the main subroutine. + ! Repeated use of certain sums makes the calculation more efficient. + ! Integral formulas are described in triangle_coordinates subroutine. + ! + ! author William H. Lipscomb, LANL + ! + ! + ! input/output arguments + + integer, intent(in) :: & + nx_block, ny_block ,&! block dimensions + ntracer ! number of tracers in use + + integer, dimension (ngroups), intent(in) :: & + icells ! number of cells where triarea > puny + + integer, dimension (nx_block*ny_block,ngroups), & + intent(in) :: & + indxi ,&! compressed index in i-direction + indxj ! compressed index in j-direction + + real(dp), intent(in), & + dimension (nx_block, ny_block, 0:nvert, ngroups) :: & + xp, yp ! coordinates of triangle points + + real(dp), intent(in), & + dimension (nx_block, ny_block, ngroups) :: & + triarea ! triangle area + + integer, intent(in) :: & + integral_order ! 1 = linear, 2 = quadratic + + integer, intent(in), & + dimension (nx_block, ny_block, ngroups) :: & + iflux ,& + jflux + + real(dp), intent(in), & + dimension (nx_block, ny_block) :: & + mc, mx, my + + real(dp), intent(out), & + dimension (nx_block, ny_block) :: & + mflx + + real(dp), intent(in), & + dimension (nx_block, ny_block, ntracer), optional :: & + tc, tx, ty + + real(dp), intent(out), & + dimension (nx_block, ny_block, ntracer), optional :: & + mtflx + + ! local variables + + integer :: & + i, j, ij ,&! horizontal indices of edge + i2, j2 ,&! horizontal indices of cell contributing transport + ng ,&! triangle index + nt ! tracer index + + real(dp) :: & + m0, m1, m2, m3 ,&! mass field at internal points + w1, w2, w3 ! work variables + + real(dp), dimension (nx_block, ny_block) :: & + msum, mxsum, mysum ,&! sum of mass, mass*x, and mass*y + mxxsum, mxysum, myysum ! sum of mass*x*x, mass*x*y, mass*y*y + + real(dp), dimension (nx_block, ny_block, ntracer) :: & + mtsum ! sum of mass*tracer + + !------------------------------------------------------------------- + ! Initialize + !------------------------------------------------------------------- + + mflx(:,:) = 0.d0 + if (present(mtflx)) then + do nt = 1, ntracer + mtflx(:,:,nt) = 0.d0 + enddo + endif + + !------------------------------------------------------------------- + ! Main loop + !------------------------------------------------------------------- + + do ng = 1, ngroups + + if (integral_order == 1) then ! linear (1-point formula) + + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + + i2 = iflux(i,j,ng) + j2 = jflux(i,j,ng) + + ! mass transports + + m0 = mc(i2,j2) + xp(i,j,0,ng)*mx(i2,j2) & + + yp(i,j,0,ng)*my(i2,j2) + msum(i,j) = m0 + + mflx(i,j) = mflx(i,j) + triarea(i,j,ng)*msum(i,j) + + ! quantities needed for tracer transports + mxsum(i,j) = m0*xp(i,j,0,ng) + mxxsum(i,j) = mxsum(i,j)*xp(i,j,0,ng) + mxysum(i,j) = mxsum(i,j)*yp(i,j,0,ng) + mysum(i,j) = m0*yp(i,j,0,ng) + myysum(i,j) = mysum(i,j)*yp(i,j,0,ng) + enddo ! ij + + elseif (integral_order == 2) then ! quadratic (3-point formula) + + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + + i2 = iflux(i,j,ng) + j2 = jflux(i,j,ng) + + ! mass transports + ! Weighting factor of 1/3 is incorporated into the ice + ! area terms m1, m2, and m3. + m1 = (mc(i2,j2) + xp(i,j,1,ng)*mx(i2,j2) & + + yp(i,j,1,ng)*my(i2,j2)) / 3.d0 + m2 = (mc(i2,j2) + xp(i,j,2,ng)*mx(i2,j2) & + + yp(i,j,2,ng)*my(i2,j2)) / 3.d0 + m3 = (mc(i2,j2) + xp(i,j,3,ng)*mx(i2,j2) & + + yp(i,j,3,ng)*my(i2,j2)) / 3.d0 + msum(i,j) = m1 + m2 + m3 + mflx(i,j) = mflx(i,j) + triarea(i,j,ng)*msum(i,j) + + ! quantities needed for mass_tracer transports + w1 = m1 * xp(i,j,1,ng) + w2 = m2 * xp(i,j,2,ng) + w3 = m3 * xp(i,j,3,ng) + + mxsum(i,j) = w1 + w2 + w3 + + mxxsum(i,j) = w1*xp(i,j,1,ng) + w2*xp(i,j,2,ng) & + + w3*xp(i,j,3,ng) + + mxysum(i,j) = w1*yp(i,j,1,ng) + w2*yp(i,j,2,ng) & + + w3*yp(i,j,3,ng) + + w1 = m1 * yp(i,j,1,ng) + w2 = m2 * yp(i,j,2,ng) + w3 = m3 * yp(i,j,3,ng) + + mysum(i,j) = w1 + w2 + w3 + + myysum(i,j) = w1*yp(i,j,1,ng) + w2*yp(i,j,2,ng) & + + w3*yp(i,j,3,ng) + enddo ! ij + + endif ! integral_order + + ! mass * tracer transports + + if (present(mtflx)) then + + do nt = 1, ntracer + + do ij = 1, icells(ng) + i = indxi(ij,ng) + j = indxj(ij,ng) + + i2 = iflux(i,j,ng) + j2 = jflux(i,j,ng) + + mtsum(i,j,nt) = msum(i,j) * tc(i2,j2,nt) & + + mxsum(i,j) * tx(i2,j2,nt) & + + mysum(i,j) * ty(i2,j2,nt) + + mtflx(i,j,nt) = mtflx(i,j,nt) & + + triarea(i,j,ng) * mtsum(i,j,nt) + + enddo ! ij + + enddo ! ntracer + endif ! present(mtflx) + enddo ! ng + + end subroutine transport_integrals + +!======================================================================= +! + subroutine update_fields (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + ntracer, & + tarear, l_stop, & + mflxe, mflxn, & + mass, & + mtflxe, mtflxn, & + trcr) + + ! Given transports through cell edges, compute new area and tracers. + ! + ! author William H. Lipscomb, LANL + ! + ! input/output arguments + + integer, intent(in) :: & + nx_block, ny_block,&! block dimensions + ilo,ihi,jlo,jhi ,&! beginning and end of physical domain + ntracer ! number of tracers in use + + real(dp), dimension (nx_block, ny_block), intent(in) :: & + mflxe, mflxn ! mass transport across east and north cell edges + + real(dp), intent(in) :: & + tarear ! 1/tarea + + real(dp), dimension (nx_block, ny_block), & + intent(inout) :: & + mass ! mass field (mean) + + real(dp), dimension (nx_block, ny_block, ntracer), & + intent(in), optional :: & + mtflxe, mtflxn ! mass*tracer transport across E and N cell edges + + real(dp), dimension (nx_block, ny_block, ntracer), & + intent(inout), optional :: & + trcr ! tracer fields + + logical, intent(inout) :: & + l_stop ! if true, abort on return + + ! local variables + + integer :: & + i, j ,&! horizontal indices + nt ! tracer index + + real(dp), dimension(nx_block,ny_block,ntracer) :: & + mtold ! old mass*tracer + + real(dp) :: & + w1 ! work variable + + integer, dimension(nx_block*ny_block) :: & + indxi ,&! compressed indices in i and j directions + indxj + + integer :: & + icells ,&! number of cells with mass > 0. + ij ! combined i/j horizontal index + + character(len=100) :: message + + integer :: & + istop, jstop ! indices of grid cell where model aborts + + !------------------------------------------------------------------- + ! Save starting values of mass*tracer + !------------------------------------------------------------------- + + if (present(trcr)) then + do nt = 1, ntracer + do j = jlo, jhi + do i = ilo, ihi + mtold(i,j,nt) = mass(i,j) * trcr(i,j,nt) + enddo ! i + enddo ! j + enddo ! nt + endif ! present(trcr) + + !------------------------------------------------------------------- + ! Update mass field + !------------------------------------------------------------------- + + do j = jlo, jhi + do i = ilo, ihi + + w1 = mflxe(i,j) - mflxe(i-1,j) & + + mflxn(i,j) - mflxn(i,j-1) + mass(i,j) = mass(i,j) - w1*tarear + + if (mass(i,j) < -puny) then ! abort with negative value + l_stop = .true. + istop = i + jstop = j + elseif (mass(i,j) < 0.d0) then ! set to zero + mass(i,j) = 0.d0 + endif + + enddo + enddo + + !TODO - Write error message to log file. + ! For now, just print out an error message. + + if (l_stop) then + i = istop + j = jstop + w1 = mflxe(i,j) - mflxe(i-1,j) & + + mflxn(i,j) - mflxn(i,j-1) +! write (message,*) 'Process:',this_rank +! call write_log(message) +! write (message,*) 'Remap, negative ice thickness, i, j =', i, j +! call write_log(message) +! write (message,*) 'Old thickness =', mass(i,j) + w1*tarear +! call write_log(message) +! write (message,*) 'New thickness =', mass(i,j) +! call write_log(message) +! write (message,*) 'Net transport =', -w1*tarear +! call write_log(message) + write (6,*) 'Process:',this_rank + write (6,*) 'Remap, negative ice thickness, i, j =', i, j + write (6,*) 'Old thickness =', mass(i,j) + w1*tarear + write (6,*) 'New thickness =', mass(i,j) + write (6,*) 'Net transport =', -w1*tarear + return + endif + + !------------------------------------------------------------------- + ! Update tracers + !------------------------------------------------------------------- + + if (present(trcr)) then + + icells = 0 + do j = jlo, jhi + do i = ilo, ihi + if (mass(i,j) > 0.d0) then ! grid cells with positive areas + icells = icells + 1 + indxi(icells) = i + indxj(icells) = j + endif + enddo ! i + enddo ! j + + do nt = 1, ntracer + + do j = jlo, jhi + do i = ilo, ihi + trcr(i,j,nt) = 0.d0 + enddo + enddo + + do ij = 1, icells + i = indxi(ij) + j = indxj(ij) + + w1 = mtflxe(i,j,nt) - mtflxe(i-1,j,nt) & + + mtflxn(i,j,nt) - mtflxn(i,j-1,nt) + trcr(i,j,nt) = (mtold(i,j,nt) - w1*tarear) & + / mass(i,j) + enddo ! ij + + enddo ! nt + endif ! present(trcr) + + end subroutine update_fields + +!======================================================================= + + end module glissade_remap + +!======================================================================= diff --git a/components/cism/glimmer-cism/libglissade/glissade_temp.F90 b/components/cism/glimmer-cism/libglissade/glissade_temp.F90 new file mode 100644 index 0000000000..5b46edd786 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_temp.F90 @@ -0,0 +1,1767 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_temp.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + ! This module is based on glide_temp.F90, but has been modified for Glissade + ! by William Lipscomb (LANL). + ! It computes temperature diffusion and strain heating in a local column + ! without doing horizontal or vertical advection. + ! Temperature advection is done separately, e.g. using the incremental + ! remapping transport scheme. + ! It is assumed here that temperature values are staggered in the + ! vertical compared to the velocity. That is, the temperature lives + ! at the midpoint of each layer instead of at layer interfaces. + ! The temperature is also defined at the upper and lower surfaces with + ! appropriate boundary conditions. + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glissade_temp + + use glimmer_global, only : dp + use glide_types + use glimmer_log + use parallel, only: this_rank + + implicit none + + private + public :: glissade_init_temp, glissade_temp_driver, glissade_calcflwa, glissade_calcbpmp + + ! time stepping scheme + + !NOTE: For the dome test case, the Crank-Nicolson scheme can give unstable + ! temperature fluctuations for thin ice immediately after the ice + ! becomes thick enough for the temperature calculation. + ! The fully implicit scheme has been stable for all cases (but is only + ! first-order accurate in time). + + logical, parameter:: & + crank_nicolson = .false. ! if true, use Crank-Nicolson time-stepping + ! if false, use fully implicit + + ! max and min allowed temperatures + ! Temperatures sometimes go below -100 for cases where Crank-Nicholson is unstable + real(dp), parameter :: & + maxtemp_threshold = 1.d11, & + mintemp_threshold = -100.d0 + + !WHL - debug + integer :: itest, jtest, rtest + +contains + +!**************************************************** + + subroutine glissade_init_temp (model) + + ! initialization subroutine for the case that temperature lives on the + ! vertically staggered grid (i.e., at layer centers) + + use glimmer_physcon, only : rhoi, shci, coni, scyr, grav, gn, lhci, rhow, trpt + use glimmer_paramets, only : tim0, thk0, len0, vis0, vel0, tau0, unphys_val + use parallel, only: lhalo, uhalo + use glissade_enthalpy, only: glissade_init_enthalpy + + type(glide_global_type),intent(inout) :: model !> Ice model parameters. + + integer, parameter :: p1 = gn + 1 + integer up, ns, ew + + !TODO - Should these allocations be done in glide_allocarr? + + ! Note vertical dimensions here. Dissipation is computed for each of (upn-1) layers. + ! Temperature is defined at midpoint of each layer, plus upper and lower surfaces. + !TODO - Allocate dissip in glide_types? + allocate(model%tempwk%dups(model%general%upn+1,2)) + allocate(model%tempwk%inittemp(model%general%upn+1,model%general%ewn,model%general%nsn)) + !WHL - Moved dissip to model%temper and allocated in glide_types +!! allocate(model%tempwk%dissip (model%general%upn-1,model%general%ewn,model%general%nsn)) + allocate(model%tempwk%compheat(model%general%upn-1,model%general%ewn,model%general%nsn)) + model%tempwk%compheat = 0.0d0 + + allocate(model%tempwk%c1(model%general%upn-1)) ! upn-1 for staggered grid + + allocate(model%tempwk%dupa(model%general%upn)) + allocate(model%tempwk%dupb(model%general%upn)) + allocate(model%tempwk%dupc(model%general%upn)) + + model%tempwk%dups = 0.0d0 + + !Note: The 'dups' grid coefficients are not the same as for unstaggered temperatures. + up = 1 + model%tempwk%dups(up,1) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up)) * & + (model%numerics%stagsigma(up) - model%numerics%sigma(up)) ) + do up = 2, model%general%upn-1 + model%tempwk%dups(up,1) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up)) * & + (model%numerics%stagsigma(up) - model%numerics%stagsigma(up-1)) ) + enddo + + do up = 1, model%general%upn-2 + model%tempwk%dups(up,2) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up)) * & + (model%numerics%stagsigma(up+1) - model%numerics%stagsigma(up)) ) + end do + up = model%general%upn-1 + model%tempwk%dups(up,2) = 1.d0/((model%numerics%sigma(up+1) - model%numerics%sigma(up)) * & + (model%numerics%sigma(up+1) - model%numerics%stagsigma(up)) ) + + model%tempwk%zbed = 1.0d0 / thk0 + model%tempwk%dupn = model%numerics%sigma(model%general%upn) - model%numerics%sigma(model%general%upn-1) + + !WHL - We need only two of these (cons(1) and cons(5)) for the staggered case with no advection. +!! model%tempwk%cons = (/ 2.0d0 * tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2), & +!! model%numerics%dttem / 2.0d0, & +!! VERT_DIFF*2.0d0 * tim0 * model%numerics%dttem / (thk0 * rhoi * shci), & +!! VERT_ADV*tim0 * acc0 * model%numerics%dttem / coni, & +!! 0.0d0, & !WHL - no vertical advection +!! ( tau0 * vel0 / len0 ) / ( rhoi * shci ) * ( model%numerics%dttem * tim0 ) /) + !*sfp* added last term to vector above for use in HO & SSA dissip. cacl + +!WHL - The factor of 2 in the numerator in the original code can be traced to a missing factor of 0.5 +! in the denominator of the dups coefficients. On the vertically staggered grid, there is no +! factor of 0.5 in the dups coefficients, so there is no factor of 2 here. +!WHL - The factor of 2 in the denominator is a Crank-Nicolson averaging factor. +! If doing fully implicit timestepping, model%tempwk%cons(1) is multiplied by 2 below. +!! model%tempwk%cons(1) = 2.0d0 * tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2) + model%tempwk%cons(1) = tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2) + model%tempwk%cons(5) = (tau0 * vel0 / len0 ) / (rhoi * shci) * (model%numerics%dttem * tim0) + + !Note: stagsigma here instead of sigma + model%tempwk%c1(1:model%general%upn-1) = & + (model%numerics%stagsigma(1:model%general%upn-1) & + * rhoi * grav * thk0**2 / len0)**p1 * 2.0d0 * vis0 & + * model%numerics%dttem * tim0 / (16.0d0 * rhoi * shci) + + model%tempwk%f = (/ tim0 * coni / (thk0**2 * lhci * rhoi), & + tim0 / (thk0 * lhci * rhoi), & + tim0 * thk0 * rhoi * shci / (thk0 * tim0 * model%numerics%dttem * lhci * rhoi), & + tim0 * thk0**2 * vel0 * grav * rhoi / (4.0d0 * thk0 * len0 * rhoi * lhci), & + tim0 * vel0 * tau0 / (4.0d0 * thk0 * rhoi * lhci) /) + !*sfp* added the last term in the vect above for HO and SSA dissip. calc. + + + !==== Initialize ice temperature.============ + !This block of code is similar to that in glide_init_temp + + ! Five possibilities: + ! (1) Set ice temperature to 0 C everywhere in column (TEMP_INIT_ZERO) + ! (2) Set ice temperature to surface air temperature everywhere in column (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + ! (4) Read ice temperature from an initial input file. + ! (5) Read ice temperature from a restart file. + ! + ! If restarting, we always do (5). + ! If not restarting and the temperature field is present in the input file, we do (4). + ! If (4) or (5), then the temperature field should already have been read from a file, + ! and the rest of this subroutine will do nothing. + ! Otherwise, the initial temperature is controlled by model%options%temp_init, + ! which can be read from the config file. + ! + !TODO - When reading temperature from restart or input file, make sure that halo values are correct. + + if (model%options%is_restart == RESTART_TRUE) then + + ! Temperature has already been initialized from a restart file. + ! (Temperature is always a restart variable.) + + call write_log('Initializing ice temperature from the restart file') + + elseif ( minval(model%temper%temp(1:model%general%upn, & + 1+lhalo:model%general%ewn-lhalo, 1+uhalo:model%general%nsn-uhalo)) > & + (-1.0d0 * trpt) ) then ! trpt = 273.15 K + ! Default initial temps in glide_types are unphys_val = -999 + + !TODO - Verify vertical dimension here (should be 0 or upn?) + if ( (maxval(model%temper%temp(model%general%upn, & + 1+lhalo:model%general%ewn-lhalo, 1+uhalo:model%general%nsn-uhalo)) == unphys_val) .and. & + (model%options%whichdycore /= DYCORE_BISICLES) )then + ! Throw a fatal error if we think the user has supplied temp instead of tempstag + ! (We don't want to implicitly shift the vertical layers from one coordinate system + ! to another without the user knowing.) + ! This case will look like good data in all the layers except the top layer. + ! MJH: Letting BISICLES run with this situation as per Dan Martin's request. + call write_log("The variable 'temp' has been read from an input file, but it only is appropriate " & + // "for the Glide dycore. Use the 'tempstag' variable with higher-order dycores instead.", GM_FATAL) + else + ! Temperature has already been initialized from an input file. + ! (We know this because the default initial temps of unphys_val = -999 have been overwritten.) + + call write_log('Initializing ice temperature from an input file') + endif + + else ! not reading temperature from restart or input file + ! initialize it here based on model%options%temp_init + + ! First set T = 0 C everywhere + + model%temper%temp(:,:,:) = 0.0d0 + + if (model%options%temp_init == TEMP_INIT_ZERO) then + + call write_log('Initializing ice temperature to 0 deg C') + + ! No call is needed to glissade_init_temp_column because the + ! ice temperature has been set to zero above + + elseif (model%options%temp_init == TEMP_INIT_ARTM) then + + ! Initialize ice column temperature to min(artm, 0 C). + + !Note: Old glide sets temp = artm everywhere without regard to whether ice exists in a column. + + call write_log('Initializing ice temperature to the surface air temperature') + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + call glissade_init_temp_column(model%options%temp_init, & + model%numerics%stagsigma(:), & + dble(model%climate%artm(ew,ns)), & + model%geometry%thck(ew,ns), & + model%temper%temp(:,ew,ns) ) + end do + end do + + elseif (model%options%temp_init == TEMP_INIT_LINEAR) then + + ! Initialize ice column temperature with a linear profile: + ! T = artm at the surface, and T <= Tpmp at the bed. + + call write_log('Initializing ice temperature to a linear profile in each column') + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + call glissade_init_temp_column(model%options%temp_init, & + model%numerics%stagsigma(:), & + dble(model%climate%artm(ew,ns)), & + model%geometry%thck(ew,ns), & + model%temper%temp(:,ew,ns) ) + + end do + end do + + endif ! model%options%temp_init + + endif ! restart file, input file, or other options + + !BDM - make call to glissade_enthalpy_init if using enthalpy approach + if (model%options%whichtemp == TEMP_ENTHALPY) then + call glissade_init_enthalpy(model) + end if + + end subroutine glissade_init_temp + +!**************************************************** + + subroutine glissade_init_temp_column(temp_init, & + stagsigma, artm, & + thck, temp) + + ! Initialize temperatures in a column based on the value of temp_init. + ! Three possibilities: + ! (1) Set ice temperature in column to 0 C (TEMP_INIT_ZERO) + ! (2) Set ice temperature in column to surface air temperature (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A local parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + ! + ! This subroutine is functionally equivalent to glide_init_temp_column. + ! The only difference is that temperature is staggered in the vertical + ! (i.e., located at layer midpoints as well as the top and bottom surfaces). + + ! In/out arguments + + integer, intent(in) :: temp_init ! option for temperature initialization + + real(dp), dimension(:), intent(in) :: stagsigma ! staggered vertical coordinate + ! includes layer midpoints, but not top and bottom surfaces + real(dp), intent(in) :: artm ! surface air temperature (deg C) + ! Note: artm should be passed in as double precision + real(dp), intent(in) :: thck ! ice thickness + real(dp), dimension(0:), intent(inout) :: temp ! ice column temperature (deg C) + ! Note first index of zero + + ! Local variables and parameters + + real(dp) :: pmptb ! pressure melting point temp at the bed + real(dp), dimension(size(stagsigma)) :: pmpt ! pressure melting point temp thru the column + integer :: upn ! number of vertical levels (deduced from temp array) + + !TODO - Define pmpt_offset elsewhere? + real(dp), parameter :: pmpt_offset = 2.d0 ! offset of initial Tbed from pressure melting point temperature (deg C) + ! Note: pmtp_offset is positive for T < Tpmp + + upn = size(temp) - 1 ! temperature array has dimension (0:model%general%upn) + + ! Set the temperature in the column + + select case(temp_init) + + case(TEMP_INIT_ZERO) ! set T = 0 C + + temp(:) = 0.d0 + + case(TEMP_INIT_ARTM) ! initialize ice-covered areas to the min of artm and 0 C + ! set ice-free areas to T = 0 C + + if (thck > 0.0d0) then + temp(:) = min(0.0d0, artm) + else + temp(:) = 0.d0 + endif + + case(TEMP_INIT_LINEAR) + + ! Tsfc = artm, Tbed = Tpmp = pmpt_offset, linear profile in between + + temp(0) = artm + + call glissade_calcpmpt_bed (pmptb, thck) + temp(upn) = pmptb - pmpt_offset + + temp(1:upn-1) = temp(0) + (temp(upn) - temp(0))*stagsigma(:) + + ! Make sure T <= Tpmp - pmpt_offset in column interior + ! TODO: Change condition to T <= Tpmp? + + call glissade_calcpmpt(pmpt(:), thck, stagsigma(:)) + temp(1:upn-1) = min(temp(1:upn-1), pmpt(1:upn-1) - pmpt_offset) + + end select + + end subroutine glissade_init_temp_column + +!**************************************************** + + subroutine glissade_temp_driver(model, whichtemp) + + ! Calculates the new ice temperature + + use glimmer_utils, only : tridiag + use glimmer_paramets, only : thk0, tim0 + use glimmer_physcon, only: shci, coni, rhoi + use glide_mask + use glissade_enthalpy + use glissade_grid_operators, only: glissade_stagger + use glissade_masks, only: glissade_get_masks + + !TODO - Modify glissade_temp_driver to compute over locally owned cells only? + ! This would make the module a bit cheaper but would require halo updates at the end. + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + + type(glide_global_type),intent(inout) :: model ! Ice model parameters + integer, intent(in) :: whichtemp ! Flag to choose method + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + integer :: ew, ns, up, upn + character(len=100) :: message + + ! These arrays have the same size as the vertical dimension of temperature: + ! upn+1 on the staggered grid. + real(dp), dimension(size(model%temper%temp,1)) :: subd, diag, supd, rhsd + + ! These have the same dimensions as staggered temperature + real(dp),dimension(0:model%general%upn) :: Tstagsigma, prevtemp_stag, enthalpy + + ! for energy conservation check + real(dp) :: einit, efinal, delta_e, dTtop, dTbot, denth_top, denth_bot + + real(dp) :: maxtemp, mintemp ! max and min temps in column + + real(dp), dimension(0:model%general%upn) :: pmptemp ! pressure melting pt temperature + + real(dp), dimension(1:model%general%upn) :: alpha_enth ! diffusivity at interfaces (m2/s) for enthalpy solver + ! = coni / (rhoi*shci) for cold ice + + integer, dimension(model%general%ewn,model%general%nsn) :: & + ice_mask ! = 1 where thck > thklim_temp, else = 0 + +!! logical, parameter:: verbose_temp = .false. + logical, parameter:: verbose_temp = .true. + integer :: k + + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + upn = model%general%upn + + select case(whichtemp) + + case(TEMP_SURFACE_AIR_TEMP) ! Set column to surface air temperature ------------------ + + do ns = 1,model%general%nsn + do ew = 1,model%general%ewn + model%temper%temp(:,ew,ns) = dmin1(0.0d0,dble(model%climate%artm(ew,ns))) + end do + end do + + case(TEMP_PROGNOSTIC) ! Local column calculation (with advection done elsewhere) + + ! No horizontal or vertical advection; vertical diffusion and strain heating only. + ! Temperatures are vertically staggered relative to velocities. + ! That is, the temperature is defined at the midpoint of each layer + ! (and at the top and bottom surfaces). + + !TODO - Change Tstagsigma to stagwbndsigma + ! Change model%general%upn to upn + Tstagsigma(0) = 0.d0 + Tstagsigma(1:model%general%upn-1) = model%numerics%stagsigma(1:model%general%upn-1) + Tstagsigma(model%general%upn) = 1.d0 + + model%tempwk%inittemp = 0.0d0 + + ! Calculate interior heat dissipation ------------------------------------- + + call glissade_finddisp( model, & + model%geometry%thck, & + model%options%which_ho_disp,& + model%stress%efvs, & + model%geomderv%stagthck, & + model%geomderv%dusrfdew, & + model%geomderv%dusrfdns, & + model%temper%flwa) + + ! Calculate heating from basal friction (if not already computed by the Glissade velocity solver) + + call glissade_calcbfric( model, & + model%options%whichdycore, & + model%geometry%thck, & + model%velocity%btraction, & + model%velocity%ubas, & + model%velocity%vbas, & + GLIDE_IS_FLOAT(model%geometry%thkmask), & + model%temper%bfricflx ) + + ! Note: No iteration is needed here since we are doing a local tridiagonal solve without advection. + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + + if(model%geometry%thck(ew,ns) > model%numerics%thklim_temp) then + + if (verbose_temp .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'Before prognostic temp, i, j =', ew, ns + print*, 'thck =', model%geometry%thck(ew,ns)*thk0 + print*, 'Temp:' + do k = 0, upn + print*, k, model%temper%temp(k,ew,ns) + enddo + endif + + ! compute initial internal energy in column (for energy conservation check) + einit = 0.0d0 + do up = 1, upn-1 + einit = einit + model%temper%temp(up,ew,ns) * & + (model%numerics%sigma(up+1) - & + model%numerics%sigma(up) ) + enddo + einit = einit * rhoi * shci * model%geometry%thck(ew,ns)*thk0 + + ! compute matrix elements + + call glissade_findvtri( model, ew, ns, & + subd, diag, supd, rhsd, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns))) + + if (verbose_temp .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + print*, 'After glissade_findvtri, i, j =', ew,ns + print*, 'k, subd, diag, supd, rhsd:' + do k = 1, upn+1 + print*, k, subd(k), diag(k), supd(k), rhsd(k) + enddo + endif + + prevtemp_stag(:) = model%temper%temp(:,ew,ns) + + ! solve the tridiagonal system + + ! Note: Temperature is indexed from 0 to upn, with indices 1 to upn-1 colocated + ! with stagsigma values of the same index. + ! However, the matrix elements are indexed 1 to upn+1, with the first row + ! corresponding to the surface temperature, temp(0,:,:). + + call tridiag(subd(1:model%general%upn+1), & + diag(1:model%general%upn+1), & + supd(1:model%general%upn+1), & + model%temper%temp(0:model%general%upn,ew,ns), & + rhsd(1:model%general%upn+1)) + + if (verbose_temp .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'After prognostic temp, i, j =', ew, ns + print*, 'Temp:' + do k = 0, upn + print*, k, model%temper%temp(k,ew,ns) + enddo + endif + + ! Check that the net input of energy to the column is equal to the difference + ! between the initial and final internal energy. + !TODO - Make this energy check optional and/or move it to a subroutine? + + ! compute the final internal energy + + efinal = 0.0d0 + do up = 1, upn-1 + efinal = efinal + model%temper%temp(up,ew,ns) * & + (model%numerics%sigma(up+1) - model%numerics%sigma(up)) + enddo + efinal = efinal * rhoi*shci * model%geometry%thck(ew,ns)*thk0 + + ! compute net heat flux to the column + + ! conductive flux = (k/H * dT/dsigma) at upper and lower surfaces; positive down + + if (crank_nicolson) then + ! average temperatures between start and end of timestep + dTtop = 0.5d0 * ( model%temper%temp(1,ew,ns) - model%temper%temp(0,ew,ns) & + + prevtemp_stag(1) - prevtemp_stag(0) ) + dTbot = 0.5d0 * ( model%temper%temp(upn,ew,ns) - model%temper%temp(upn-1,ew,ns) & + + prevtemp_stag(upn) - prevtemp_stag(upn-1) ) + else ! fully implicit + ! use temperatures at end of timestep + dTtop = model%temper%temp(1,ew,ns) - model%temper%temp(0,ew,ns) + dTbot = model%temper%temp(upn,ew,ns) - model%temper%temp(upn-1,ew,ns) + endif + + model%temper%ucondflx(ew,ns) = (-coni / (model%geometry%thck(ew,ns)*thk0) ) & + * dTtop / (Tstagsigma(1) - Tstagsigma(0)) + + model%temper%lcondflx(ew,ns) = (-coni / (model%geometry%thck(ew,ns)*thk0) ) & + * dTbot / (Tstagsigma(upn) - Tstagsigma(upn-1)) + + ! total dissipation in column (W/m^2) + + model%temper%dissipcol(ew,ns) = 0.0d0 + do up = 1, upn-1 + model%temper%dissipcol(ew,ns) = model%temper%dissipcol(ew,ns) + & + model%temper%dissip(up,ew,ns) & + * (model%numerics%sigma(up+1) - model%numerics%sigma(up)) + enddo + model%temper%dissipcol(ew,ns) = model%temper%dissipcol(ew, ns) & + * thk0*model%geometry%thck(ew,ns)*rhoi*shci / (tim0*model%numerics%dttem) + + ! Verify that the net input of energy into the column is equal to the change in + ! internal energy. + + delta_e = (model%temper%ucondflx(ew,ns) - model%temper%lcondflx(ew,ns) & + + model%temper%dissipcol(ew,ns)) * tim0*model%numerics%dttem + + if ( abs((efinal-einit-delta_e)/(tim0*model%numerics%dttem)) > 1.0d-8 ) then + + if (verbose_temp) then + print*, 'Ice thickness:', thk0*model%geometry%thck(ew,ns) + print*, 'thklim_temp:', thk0*model%numerics%thklim_temp + print*, ' ' + print*, 'Interior fluxes:' + print*, 'ftop (pos up)=', -model%temper%ucondflx(ew,ns) + print*, 'fbot (pos up)=', -model%temper%lcondflx(ew,ns) + print*, 'fdissip =', model%temper%dissipcol(ew,ns) + print*, 'Net flux =', delta_e/(tim0*model%numerics%dttem) + print*, ' ' + print*, 'delta_e =', delta_e + print*, 'einit =', einit + print*, 'efinal =', efinal + print*, 'einit + delta_e =', einit + delta_e + print*, ' ' + print*, 'Energy imbalance =', efinal - einit - delta_e + print*, ' ' + print*, 'Basal fluxes:' + print*, 'ffric =', model%temper%bfricflx(ew,ns) + print*, 'fgeo =', -model%temper%bheatflx(ew,ns) + print*, 'flux for bottom melting =', model%temper%bfricflx(ew,ns) & + - model%temper%bheatflx(ew,ns) & + + model%temper%lcondflx(ew,ns) + endif ! verbose_temp + + write(message,*) 'WARNING: Energy conservation error, ew, ns =', ew, ns + call write_log(message,GM_FATAL) + endif + + !WHL - No call here to corrpmpt. Temperatures above pmpt are set to pmpt + ! in glissade_calcbmlt (conserving energy). + + endif ! thck > thklim_temp + end do ! ew + end do ! ns + + ! set temperature of thin ice to the air temperature and set ice-free nodes to zero + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + +! if (GLIDE_IS_THIN(model%geometry%thkmask(ew,ns))) then +! model%temper%temp(:,ew,ns) = min(0.0d0, dble(model%climate%artm(ew,ns))) +! else if (model%geometry%thkmask(ew,ns) < 0) then +! model%temper%temp(:,ew,ns) = min(0.0d0, dble(model%climate%artm(ew,ns))) +! !else if (model%geometry%thkmask(ew,ns) < -1) then +! ! model%temper%temp(:,ew,ns) = 0.0d0 +! end if + + !WHL - Changed threshold from thklim to thklim_temp + if (model%geometry%thck(ew,ns) <= model%numerics%thklim_temp) then + model%temper%temp(:,ew,ns) = min(0.d0, model%climate%artm(ew,ns)) + endif + + !TODO - Maybe it should be done in the following way, so that the temperature profile for thin ice + ! is consistent with the temp_init option, with T = 0 for ice-free cells. + + ! NOTE: Calling this subroutine will maintain a sensible temperature profile + ! for thin ice, but in general does *not* conserve energy. + ! To conserve energy, we need either thklim_temp = 0, or some additional + ! energy accounting and correction. + +! if (model%geometry%thck(ew,ns) <= model%numerics%thklim_temp) then +! call glissade_init_temp_column(model%options%temp_init, & +! model%numerics%stagsigma(:), & +! dble(model%climate%artm(ew,ns)), & +! model%geometry%thck(ew,ns), & +! model%temper%temp(:,ew,ns) ) +! else if (model%geometry%thkmask(ew,ns) < 0) then +! model%temper%temp(:,ew,ns) = 0.d0 +! end if + + end do + end do + + ! Calculate basal melt rate + ! Temperature above the pressure melting point are reset to Tpmp, + ! with excess heat contributing to melting. + + call glissade_calcbmlt( model, & + model%temper%temp, & + Tstagsigma, & + model%geometry%thck, & + model%temper%bmlt, & + GLIDE_IS_FLOAT(model%geometry%thkmask)) + + ! Interpolate basal temperature and pressure melting point onto velocity grid + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%numerics%thklim_temp, & + ice_mask) + + call glissade_stagger(model%general%ewn, model%general%nsn, & + model%temper%temp(model%general%upn,:,:), & + model%temper%stagbtemp(:,:), & + ice_mask(:,:), & + stagger_margin_in = 1) + + call glissade_stagger(model%general%ewn, model%general%nsn, & + model%temper%bpmp(:,:), & + model%temper%stagbpmp(:,:), & + ice_mask(:,:), & + stagger_margin_in = 1) + + case(TEMP_STEADY)! do nothing + + case(TEMP_ENTHALPY)! BDM Local column calculation (with advection done elsewhere) + + !WHL - debug + print*, 'Starting enthalpy calculation' + + !TODO - Modify enthalpy code to use a backward Euler timestep. + ! With a Crank-Nicolson timestep, the ice in thin cells can become excessively cold, and the code aborts. + ! To allow the code to keep running, set thklim_temp to a larger value (e.g., 100 m) + !TODO - Rearrange prognostic/enthalpy code to avoid duplication of many calls. + + ! No horizontal or vertical advection; vertical diffusion and strain heating only. + ! Enthalpy is vertically staggered relative to velocities. + ! That is, enthalpy is defined at the midpoint of each layer + ! (and at the top and bottom surfaces). + + ! BDM Enthalpy Gradient Method is used here to solve for temp. and water content. + + !TODO - If I'm using TEMP_ENTHALPY, should I make a call to glissade_init_enthalpy here? + + !TODO - Change Tstagsigma to stagwbndsigma + Tstagsigma(0) = 0.d0 + Tstagsigma(1:model%general%upn-1) = model%numerics%stagsigma(1:model%general%upn-1) + Tstagsigma(model%general%upn) = 1.d0 + + !WHL - Commenting out the next two calls because dissip and bfricflx are now + ! computed at the end of the previous time step + + ! Calculate interior heat dissipation ------------------------------------- + +! call glissade_finddisp( model, & +! model%geometry%thck, & +! model%options%which_ho_disp,& +! model%stress%efvs, & +! model%geomderv%stagthck, & +! model%geomderv%dusrfdew, & +! model%geomderv%dusrfdns, & +! model%temper%flwa) + + ! Calculate heating from basal friction ----------------------------------- + +! call glissade_calcbfric( model, & +! model%options%whichdycore, & +! model%geometry%thck, & +! model%velocity%btraction, & +! model%velocity%ubas, & +! model%velocity%vbas, & +! GLIDE_IS_FLOAT(model%geometry%thkmask), & +! model%temper%bfricflx ) + + ! Note: No iteration is needed here since we are doing a local tridiagonal solve without advection. + + do ns = 2,model%general%nsn-1 + do ew = 2,model%general%ewn-1 + if (model%geometry%thck(ew,ns) > model%numerics%thklim_temp) then + + ! Convert model%temper%temp and model%temper%waterfrac to enthalpy (dimension 0:upn). + ! For interior and boundary nodes; assume waterfrac = 0 at boundaries. + ! BDM enthalpy will be size 0:upn + call temp2enth(model%temper%enthalpy(0:model%general%upn,ew,ns), & + model%temper%temp(0:model%general%upn,ew,ns), & + model%temper%waterfrac(1:model%general%upn-1,ew,ns), & + model%geometry%thck(ew,ns), & + model%numerics%stagsigma(1:model%general%upn-1)) + + if (verbose_temp .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'Before prognostic enthalpy, i, j =', ew, ns + print*, 'thck =', model%geometry%thck(ew,ns)*thk0 + print*, 'Temp, waterfrac, enthalpy:' + k = 0 + print*, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns) + do k = 1, upn-1 + print*, k, model%temper%temp(k,ew,ns), model%temper%waterfrac(k,ew,ns), model%temper%enthalpy(k,ew,ns) + enddo + k = upn + print*, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns) + endif + + ! compute initial internal energy in column (for energy conservation check) + einit = 0.0d0 + do up = 1, upn-1 + einit = einit + model%temper%enthalpy(up,ew,ns) * & + (model%numerics%sigma(up+1) - model%numerics%sigma(up) ) + enddo + einit = einit * model%geometry%thck(ew,ns)*thk0 + + ! BDM compute matrix elements using Enthalpy Gradient Method + + call glissade_enthalpy_findvtri(model, ew, ns, & + subd, diag, supd, rhsd, & + GLIDE_IS_FLOAT(model%geometry%thkmask(ew,ns)), & + alpha_enth) + + ! BDM leave as prevtemp because it's only used for dT/dsigma at top and bottom boundaries, + ! we don't want this as enthalpy + prevtemp_stag(:) = model%temper%temp(:,ew,ns) + + ! solve the tridiagonal system + ! Note: Temperature is indexed from 0 to upn, with indices 1 to upn-1 colocated + ! with stagsigma values of the same index. + ! However, the matrix elements are indexed 1 to upn+1, with the first row + ! corresponding to the surface temperature, temp(0,:,:). + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'After vtri, i, j =', ew, ns + print*, 'k, subd, diag, supd, rhs/(rhoi*ci):' + do k = 1, upn+1 + print*, k-1, subd(k), diag(k), supd(k), rhsd(k)/(rhoi*shci) + enddo + endif + + call tridiag(subd(1:upn+1), & + diag(1:upn+1), & + supd(1:upn+1), & + enthalpy(0:upn), & + rhsd(1:upn+1)) + + ! Copy the local enthalpy array into the global derived type + model%temper%enthalpy(:,ew,ns) = enthalpy(:) + + ! BDM convert back to temperature and water content + call enth2temp(model%temper%enthalpy(0:upn,ew,ns), & + model%temper%temp(0:upn,ew,ns), & + model%temper%waterfrac(1:upn-1,ew,ns), & + model%geometry%thck(ew,ns), & + model%numerics%stagsigma(1:upn-1)) + + if (verbose_temp .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + print*, ' ' + print*, 'After prognostic enthalpy, i, j =', ew, ns + print*, 'thck =', model%geometry%thck(ew,ns)*thk0 + print*, 'Temp, waterfrac, enthalpy:' + k = 0 + print*, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns) + do k = 1, upn-1 + print*, k, model%temper%temp(k,ew,ns), model%temper%waterfrac(k,ew,ns), model%temper%enthalpy(k,ew,ns) + enddo + k = upn + print*, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns) + endif + + ! Check that the net input of energy to the column is equal to the difference + ! between the initial and final internal energy. + + ! compute the final internal energy + + efinal = 0.0d0 + do up = 1, upn-1 + efinal = efinal + model%temper%enthalpy(up,ew,ns) * & + (model%numerics%sigma(up+1) - model%numerics%sigma(up) ) + enddo + efinal = efinal * model%geometry%thck(ew,ns)*thk0 + + ! compute net heat flux to the column + + ! conductive flux = (alpha/H * denth/dsigma) at upper and lower surfaces; positive down. + ! Here alpha = coni / (rhoi*shci) for cold ice, with a smaller value for temperate ice. + ! Assume fully implicit backward Euler time step + + denth_top = enthalpy(1) - enthalpy(0) + denth_bot = enthalpy(upn) - enthalpy(upn-1) + + model%temper%ucondflx(ew,ns) = -alpha_enth(1) / (model%geometry%thck(ew,ns)*thk0) & + * denth_top / (Tstagsigma(1) - Tstagsigma(0)) + + model%temper%lcondflx(ew,ns) = -alpha_enth(upn) / (model%geometry%thck(ew,ns)*thk0) & + * denth_bot / (Tstagsigma(upn) - Tstagsigma(upn-1)) + + !TODO - From here on, the energy conservation check is the same as for temperature. + ! total dissipation in column (W/m^2) + + model%temper%dissipcol(ew,ns) = 0.0d0 + do up = 1, upn-1 + model%temper%dissipcol(ew,ns) = model%temper%dissipcol(ew,ns) + & + model%temper%dissip(up,ew,ns) & + * (model%numerics%sigma(up+1) - model%numerics%sigma(up)) + enddo + model%temper%dissipcol(ew,ns) = model%temper%dissipcol(ew,ns) & + * thk0*model%geometry%thck(ew,ns)*rhoi*shci / (tim0*model%numerics%dttem) + + ! Verify that the net input of energy into the column is equal to the change in internal energy. + + delta_e = (model%temper%ucondflx(ew,ns) - model%temper%lcondflx(ew,ns) & + + model%temper%dissipcol(ew,ns)) * tim0*model%numerics%dttem + + if ( abs((efinal-einit-delta_e)/(tim0*model%numerics%dttem)) > 1.0d-8 ) then + + if (verbose_temp) then + print*, 'Ice thickness:', thk0*model%geometry%thck(ew,ns) + print*, 'thklim_temp:', thk0*model%numerics%thklim_temp + print*, ' ' + print*, 'Interior fluxes:' + print*, 'ftop (pos up)=', -model%temper%ucondflx(ew,ns) + print*, 'fbot (pos up)=', -model%temper%lcondflx(ew,ns) + print*, 'fdissip =', model%temper%dissipcol(ew,ns) + print*, 'Net flux =', delta_e/(tim0*model%numerics%dttem) + print*, ' ' + print*, 'delta_e =', delta_e + print*, 'einit =', einit + print*, 'efinal =', efinal + print*, 'einit + delta_e =', einit + delta_e + print*, ' ' + print*, 'Energy imbalance =', efinal - einit - delta_e + print*, ' ' + print*, 'Basal fluxes:' + print*, 'ffric =', model%temper%bfricflx(ew,ns) + print*, 'fgeo =', -model%temper%bheatflx(ew,ns) + print*, 'flux for bottom melting =', model%temper%bfricflx(ew,ns) & + - model%temper%bheatflx(ew,ns) & + + model%temper%lcondflx(ew,ns) + endif ! verbose_temp + + write(message,*) 'WARNING: Energy conservation error, ew, ns =', ew, ns + call write_log(message,GM_FATAL) + endif + + !WHL - No call here to corrpmpt. Temperatures above pmpt are set to pmpt + ! in glissade_calcbmlt (conserving energy). + + !WHL - debug + if (ew==itest .and. ns==jtest) then + print*, 'k/(rho*c) =', coni/(rhoi*shci) + print*, 'alpha_enth(upn) =', alpha_enth(upn) + print*, ' ' + print*, 'After enthalpy calc, i, j =', ew, ns + print*, 'k, temp, wfrac, enthalpy/(rhoi*ci):' + k = 0 + print*, k, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns)/(rhoi*shci) + do k = 1, model%general%upn-1 + print*, k, model%temper%temp(k,ew,ns), model%temper%waterfrac(k,ew,ns), & + model%temper%enthalpy(k,ew,ns)/(rhoi*shci) + enddo + k = model%general%upn + print*, k, model%temper%temp(k,ew,ns), 0.d0, model%temper%enthalpy(k,ew,ns)/(rhoi*shci) + print*, ' ' + print*, 'bheatflx, bfricflx, lcondflx, sum:', & + -model%temper%bheatflx(ew,ns), model%temper%bfricflx(ew,ns), model%temper%lcondflx(ew,ns), & + -model%temper%bheatflx(ew,ns)+ model%temper%bfricflx(ew,ns)+ model%temper%lcondflx(ew,ns) + endif + + endif ! thck > thklim_temp + end do ! ew + end do ! ns + + ! set temperature of thin ice to the air temperature and set ice-free nodes to zero + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + +! if (GLIDE_IS_THIN(model%geometry%thkmask(ew,ns))) then +! model%temper%temp(:,ew,ns) = min(0.0d0, dble(model%climate%artm(ew,ns))) +! else if (model%geometry%thkmask(ew,ns) < 0) then +! model%temper%temp(:,ew,ns) = min(0.0d0, dble(model%climate%artm(ew,ns))) +! !else if (model%geometry%thkmask(ew,ns) < -1) then +! ! model%temper%temp(:,ew,ns) = 0.0d0 +! end if + + !WHL - Changed threshold to thklim_temp + if (model%geometry%thck(ew,ns) <= model%numerics%thklim_temp) then + + !WHL - Make sure T <= T_pmp + !TODO - Impose this condition for standard temperature calculation too? + pmptemp(0) = 0.0d0 + call glissade_calcpmpt(pmptemp(1:upn-1), model%geometry%thck(ew,ns), & + model%numerics%stagsigma(1:upn-1)) + call glissade_calcpmpt_bed(pmptemp(upn), model%geometry%thck(ew,ns)) + model%temper%temp(:,ew,ns) = min(pmptemp(:), dble(model%climate%artm(ew,ns))) + endif + + !NOTE - See comments above about setting temperature in thin ice + + end do !ew + end do !ns + + ! BDM since there will be no temps above PMP, need new subroutine to calculate basal melt + ! and basal water depth + call glissade_enthalpy_calcbmlt(model, & + model%temper%temp, & + model%temper%waterfrac, & + Tstagsigma, & + model%geometry%thck, & + model%temper%bmlt, & + GLIDE_IS_FLOAT(model%geometry%thkmask)) + + + !WHL - debug + ew = itest + ns = jtest + k = model%general%upn + print*, ' ' + print*, 'After calcbmlt, i, j, basal temp =', ew, ns, model%temper%temp(k,ew,ns) + + ! Interpolate basal temperature and pressure melting point onto velocity grid + !WHL - Replaced calls to stagvarb (an old Glide routine) with calls to glissade_stagger. + ! stagger_margin_in = 1 implies that ice-free cells (where the basal temperature has + ! no physical meaning) are not included in the average. + ! With stagvarb, values in ice-free cells are (erroneously) included. + + call glissade_get_masks(model%general%ewn, model%general%nsn, & + model%geometry%thck, model%geometry%topg, & + model%climate%eus, model%numerics%thklim_temp, & + ice_mask) + + call glissade_stagger(model%general%ewn, model%general%nsn, & + model%temper%temp(model%general%upn,:,:), & + model%temper%stagbtemp(:,:), & + ice_mask(:,:), & + stagger_margin_in = 1) + + call glissade_stagger(model%general%ewn, model%general%nsn, & + model%temper%bpmp(:,:), & + model%temper%stagbpmp(:,:), & + ice_mask(:,:), & + stagger_margin_in = 1) + + end select ! whichtemp + + ! Check for temperatures that are physically unrealistic. + ! Thresholds are set at the top of this module. + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + maxtemp = maxval(model%temper%temp(:,ew,ns)) + mintemp = minval(model%temper%temp(:,ew,ns)) + + if (maxtemp > maxtemp_threshold) then + write(message,*) 'maxtemp > 0: i, j, maxtemp =', ew, ns, maxtemp + call write_log(message,GM_FATAL) + endif + + if (mintemp < mintemp_threshold) then + !uncommment these line to get more info +! print*, 'thck =', model%geometry%thck(ew,ns) * thk0 +! print*, 'temp:' +! do k = 1, model%general%upn +! print*, k, model%temper%temp(k,ew,ns) +! enddo + write(message,*) 'mintemp < mintemp_threshold: i, j, mintemp =', ew, ns, mintemp + call write_log(message,GM_FATAL) + endif + + enddo + enddo + + ! Rescale dissipation term to deg C/s (instead of deg C) + !WHL - Treat dissip above as a rate (deg C/s) instead of deg C + model%temper%dissip(:,:,:) = model%temper%dissip(:,:,:) / (model%numerics%dttem*tim0) + + end subroutine glissade_temp_driver + + !------------------------------------------------------------------------- + + subroutine glissade_findvtri (model, ew, ns, & + subd, diag, supd, rhsd, & + float) + + ! compute matrix elements for the tridiagonal solve + + use glimmer_paramets, only : thk0 + use glimmer_physcon, only : rhoi, grav, coni + + ! Note: Matrix elements (subd, supd, diag, rhsd) are indexed from 1 to upn+1, + ! whereas temperature is indexed from 0 to upn. + ! The first row of the matrix is the equation for temp(0,ew,ns), + ! the second row is the equation for temp(1,ew,ns), and so on. + + type(glide_global_type), intent(inout) :: model + integer, intent(in) :: ew, ns + real(dp), dimension(:), intent(out) :: subd, diag, supd, rhsd + logical, intent(in) :: float + + ! local variables + + real(dp) :: pmptempb ! pressure melting temp at bed + real(dp) :: fact + real(dp) :: dsigbot ! bottom layter thicknes in sigma coords. + + ! set surface temperature + + model%temper%temp(0,ew,ns) = dble(model%climate%artm(ew,ns)) + + ! Compute subdiagonal, diagonal, and superdiagonal matrix elements + + ! upper boundary: set to surface air temperature + + supd(1) = 0.0d0 + subd(1) = 0.0d0 + diag(1) = 1.0d0 + rhsd(1) = model%temper%temp(0,ew,ns) + + ! ice interior. layers 1:upn-1 (matrix elements 2:upn) + + ! model%tempwk%cons(1) = tim0 * model%numerics%dttem * coni / (2.0d0 * rhoi * shci * thk0**2) + + if (crank_nicolson) then + + fact = model%tempwk%cons(1) / model%geometry%thck(ew,ns)**2 + subd(2:model%general%upn) = -fact * model%tempwk%dups(1:model%general%upn-1,1) + supd(2:model%general%upn) = -fact * model%tempwk%dups(1:model%general%upn-1,2) + diag(2:model%general%upn) = 1.0d0 - subd(2:model%general%upn) & + - supd(2:model%general%upn) + + model%tempwk%inittemp(1:model%general%upn-1,ew,ns) = & + model%temper%temp(1:model%general%upn-1,ew,ns) * (2.0d0 - diag(2:model%general%upn)) & + - model%temper%temp(0:model%general%upn-2,ew,ns) * subd(2:model%general%upn) & + - model%temper%temp(2:model%general%upn, ew,ns) * supd(2:model%general%upn) & + + model%temper%dissip(1:model%general%upn-1,ew,ns) + + rhsd(2:model%general%upn) = model%tempwk%inittemp(1:model%general%upn-1,ew,ns) + + else ! fully implicit + + fact = 2.d0 * model%tempwk%cons(1) / model%geometry%thck(ew,ns)**2 ! Remove factor of 2 in denominator + subd(2:model%general%upn) = -fact * model%tempwk%dups(1:model%general%upn-1,1) + supd(2:model%general%upn) = -fact * model%tempwk%dups(1:model%general%upn-1,2) + diag(2:model%general%upn) = 1.0d0 - subd(2:model%general%upn) & + - supd(2:model%general%upn) + + model%tempwk%inittemp(1:model%general%upn-1,ew,ns) = & + model%temper%temp(1:model%general%upn-1,ew,ns) & + + model%temper%dissip(1:model%general%upn-1,ew,ns) + + rhsd(2:model%general%upn) = model%tempwk%inittemp(1:model%general%upn-1,ew,ns) + + endif ! crank_nicolson + + ! basal boundary: + ! for grounded ice, a heat flux is applied + ! for floating ice, the basal temperature is held constant + + !NOTE: This lower BC is different from the one in glide_temp. + ! If T(upn) < T_pmp, then require dT/dsigma = H/k * (G + taub*ubas) + ! That is, net heat flux at lower boundary must equal zero. + ! If T(upn) >= Tpmp, then set T(upn) = Tpmp + + if (float) then + + supd(model%general%upn+1) = 0.0d0 + subd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + + model%tempwk%inittemp(model%general%upn,ew,ns) = model%temper%temp(model%general%upn,ew,ns) + rhsd(model%general%upn+1) = model%temper%temp(model%general%upn,ew,ns) + + else ! grounded ice + + call glissade_calcpmpt_bed(pmptempb, model%geometry%thck(ew,ns)) + + if (abs(model%temper%temp(model%general%upn,ew,ns) - pmptempb) < 0.001d0) then ! melting + + ! hold basal temperature at pressure melting point + + supd(model%general%upn+1) = 0.0d0 + subd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + + model%tempwk%inittemp(model%general%upn,ew,ns) = pmptempb + rhsd(model%general%upn+1) = pmptempb + + else ! frozen at bed + ! maintain balance of heat sources and sinks + ! (conductive flux, geothermal flux, and basal friction) + ! Note: Heat fluxes are positive down, so slterm <= 0 and bheatflx <= 0. + + ! Note: The heat source due to basal sliding (bfricflx) is computed in subroutine calcbfric. + ! Also note that bheatflx is generally <= 0, since defined as positive down. + + ! calculate dsigma for the bottom layer between the basal boundary and the temp. point above + dsigbot = (1.0d0 - model%numerics%stagsigma(model%general%upn-1)) + + ! =====Backward Euler flux basal boundary condition===== + ! MJH: If Crank-Nicolson is desired for the b.c., it is necessary to + ! ensure that the i.c. temperature for the boundary satisfies the + ! b.c. - otherwise oscillations will occur because the C-N b.c. only + ! specifies the basal flux averaged over two consecutive time steps. + subd(model%general%upn+1) = -1.0d0 + supd(model%general%upn+1) = 0.0d0 + diag(model%general%upn+1) = 1.0d0 + + model%tempwk%inittemp(model%general%upn,ew,ns) = & + (model%temper%bfricflx(ew,ns) - model%temper%bheatflx(ew,ns)) & + * dsigbot * model%geometry%thck(ew,ns) * thk0 / coni + rhsd(model%general%upn+1) = model%tempwk%inittemp(model%general%upn,ew,ns) + + ! =====Basal boundary using heat equation with specified flux==== + ! MJH: These coefficients are based on those used in the old temperature code + ! (eqns. 3.60-3.62 in the documentation). + ! The implementation assumes the basal fluxes are the same at both time steps (lagged). + ! The flux b.c. above was determined to be preferable, but this is left + ! as an alternative. It gives similar, but slightly different results. + ! Because this formulation uses C-N time averaging, it results + ! in a slight oscillation. + !subd(model%general%upn+1) = -fact / dsigbot**2 + !supd(model%general%upn+1) = 0.0d0 + !diag(model%general%upn+1) = 1.0d0 + fact / dsigbot**2 + !model%tempwk%inittemp(model%general%upn,ew,ns) = & + ! model%temper%temp(model%general%upn-1,ew,ns) * fact / dsigbot**2 & + ! + model%temper%temp(model%general%upn, ew,ns) & + ! * (1.0d0 - fact/dsigbot**2) & + ! - fact *2.0d0 * & + ! model%geometry%thck(ew,ns) * thk0 / coni / dsigbot * & + ! (model%temper%bheatflx(ew,ns) & ! geothermal (H/k)*G + ! - model%temper%bfricflx(ew,ns) ) ! sliding (H/k)*taub*ub. + !rhsd(model%general%upn+1) = model%tempwk%inittemp(model%general%upn,ew,ns) + + endif ! melting or frozen + + end if ! floating or grounded + + end subroutine glissade_findvtri + + !----------------------------------------------------------------------- + + subroutine glissade_calcbfric (model, whichdycore, & + thck, btraction, & + ubas, vbas, & + float, bfricflx) + + ! compute frictional heat source due to sliding at the bed + + use glimmer_physcon, only: rhoi, grav + use glimmer_paramets, only: thk0, vel0, vel_scale + + type(glide_global_type) :: model + integer, intent(in) :: whichdycore ! 1 = Glam, 2 = Glissade + real(dp), dimension(:,:), intent(in) :: thck + real(dp), dimension(:,:), intent(in) :: ubas, vbas + real(dp), dimension(:,:,:), intent(in) :: btraction + logical, dimension(:,:), intent(in) :: float + ! Note: bfricflx needs to have intent (inout) in case it has already been computed by Glissade. + real(dp), dimension(:,:), intent(inout) :: bfricflx + + real(dp) :: slterm ! sliding friction + + integer :: ewp, nsp, ew, ns + integer :: slide_count ! number of neighbor cells with nonzero sliding + + if (whichdycore == DYCORE_GLISSADE) then + + ! basal friction heat flux (model%temper%bfricflx) already computed in velocity solver + ! do nothing and return + + else ! Glam dycore + + ! compute heat source due to basal friction + ! Note: slterm and bfricflx are defined to be >= 0 + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + + slterm = 0.d0 + slide_count = 0 + + !WHL - copied Steve Price's formulation from calcbmlt + ! btraction is computed in glam_strs2.F90 + + !WHL - Using thklim instead of thklim_temp because ice thinner than thklim + ! is assumed to be at rest. + + if (thck(ew,ns) > model%numerics%thklim .and. .not. float(ew,ns)) then + do nsp = ns-1,ns + do ewp = ew-1,ew + + !SCALING - WHL: Multiplied ubas by vel0/vel_scale so we get the same result in these two cases: + ! (1) With scaling: vel0 = vel_scale = 500/scyr, and ubas is non-dimensional + ! (2) Without scaling: vel0 = 1, vel_scale = 500/scyr, and ubas is in m/s. + +!!! if (abs(model%velocity%ubas(ewp,nsp)) > 1.0d-6 .or. & +!!! abs(model%velocity%vbas(ewp,nsp)) > 1.0d-6) then + if ( abs(model%velocity%ubas(ewp,nsp))*(vel0/vel_scale) > 1.0d-6 .or. & + abs(model%velocity%vbas(ewp,nsp))*(vel0/vel_scale) > 1.0d-6 ) then + slide_count = slide_count + 1 + slterm = slterm + model%velocity%btraction(1,ewp,nsp) * & + model%velocity%uvel(model%general%upn,ewp,nsp) & + + model%velocity%btraction(2,ewp,nsp) * & + model%velocity%vvel(model%general%upn,ewp,nsp) + end if + end do + end do + + endif ! thk > thklim, not floating + + ! include sliding contrib only if temperature node is surrounded by sliding velo nodes + !NOTE - The following logic may result in non-conservation of energy. Include all nonzero terms? + + if (slide_count >= 4) then + slterm = 0.25d0 * slterm + else + slterm = 0.0d0 + end if + + bfricflx(ew,ns) = slterm + + enddo ! ns + enddo ! ew + + endif ! whichdycore + + end subroutine glissade_calcbfric + + !----------------------------------------------------------------------------------- + + subroutine glissade_calcbmlt( model, & + temp, stagsigma, & + thck, & + bmlt, floater) + + ! Compute the amount of basal melting. + ! The basal melting computed here is applied to the ice thickness + ! by glissade_transport_driver, conserving mass and energy. + ! + ! Any internal temperatures above the pressure melting point are reset to the + ! pmp temperature, with excess energy applied toward basal melting. + ! Hopefully this is rare. + ! TODO: Moving all internal melting to the basal surface is not very realistic + ! and should be revisited. + + use glimmer_physcon, only: shci, rhoi, lhci + use glimmer_paramets, only : thk0, tim0 + + type(glide_global_type) :: model + + real(dp), dimension(0:,:,:), intent(inout) :: temp + real(dp), dimension(0:), intent(in) :: stagsigma !WHL - This is Tstagsigma, (0:upn) + real(dp), dimension(:,:), intent(in) :: thck + real(dp), dimension(:,:), intent(out):: bmlt ! scaled melt rate (m/s * tim0/thk0) + ! > 0 for melting, < 0 for freeze-on + logical, dimension(:,:), intent(in) :: floater + + real(dp), dimension(size(stagsigma)) :: pmptemp ! pressure melting point temperature + real(dp) :: bflx ! heat flux available for basal melting (W/m^2) + integer :: up, ew, ns + + real(dp) :: layer_thck ! layer thickness (m) + real(dp) :: melt_energy ! energy available for internal melting (J/m^2) + real(dp) :: internal_melt_rate ! internal melt rate, transferred to bed (m/s) + + real(dp), parameter :: eps11 = 1.d-11 ! small number + + bmlt(:,:) = 0.0d0 + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + + if (thck(ew,ns) > model%numerics%thklim_temp .and. .not. floater(ew,ns)) then + + ! Basal friction term is computed above in subroutine glissade_calcbfric, + ! or in the Glissade velocity solver. + ! + ! Compute basal melting + ! Note: bmlt > 0 for melting, < 0 for freeze-on + ! bfricflx >= 0 by definition + ! bheatflx is positive down, so usually bheatflx < 0 (with negative values contributing to melt) + ! lcondflx is positive down, so lcondflx < 0 for heat is flowing from the bed toward the surface + + !TODO - This equation allows for freeze-on (bmlt < 0) if the conductive term + ! (lcondflx, positive down) is carrying enough heat away from the boundary. + ! But freeze-on requires a local water supply, bwat > 0. + ! What should we do if bwat = 0? + + bflx = model%temper%bfricflx(ew,ns) + model%temper%lcondflx(ew,ns) - model%temper%bheatflx(ew,ns) ! W/m^2 + + ! bflx might be slightly different from zero because of rounding errors; if so, then set bflx = 0 + if (abs(bflx) < eps11) bflx = 0.d0 + + bmlt(ew,ns) = bflx * model%tempwk%f(2) ! f(2) = tim0 / (thk0 * lhci * rhoi) + + ! Add internal melting associated with temp > pmptemp + ! Note: glissade_calcpmpt does not compute pmpt at the top surface or the bed. + + call glissade_calcpmpt(pmptemp(1:model%general%upn-1), thck(ew,ns), stagsigma(1:model%general%upn-1)) + + do up = 1, model%general%upn-1 + if (temp(up,ew,ns) > pmptemp(up)) then + ! compute excess energy available for melting + layer_thck = thck(ew,ns) * (model%numerics%sigma(up+1) - model%numerics%sigma(up)) * thk0 ! m + melt_energy = rhoi * shci * (temp(up,ew,ns) - pmptemp(up)) * layer_thck ! J/m^2 + ! compute melt rate + internal_melt_rate = melt_energy / (rhoi * lhci * model%numerics%dttem * tim0) ! m/s + ! transfer internal melting to the bed + bmlt(ew,ns) = bmlt(ew,ns) + internal_melt_rate * tim0/thk0 ! m/s * tim0/thk0 + ! reset T to Tpmp + temp(up,ew,ns) = pmptemp(up) + endif + enddo + + ! Cap basal temp at pmptemp, if necessary + + up = model%general%upn + call glissade_calcpmpt_bed(pmptemp(up), thck(ew,ns)) + temp(up,ew,ns) = min (temp(up,ew,ns), pmptemp(up)) + + ! If freeze-on was computed above (bmlt < 0) and Tbed = Tpmp but no basal water is present, then set T(upn) < Tpmp. + ! Note: In subroutine findvtri, we solve for Tbed (instead of holding it at Tpmp) when Tbed < 0.001. + ! With an offset here of 0.01, we will solve for T_bed at the next timestep. + ! Note: Energy is not exactly conserved here. + + up = model%general%upn ! basal level + if (bmlt(ew,ns) < 0.d0 .and. model%temper%bwat(ew,ns)==0.d0 .and. temp(up,ew,ns) >= pmptemp(up)) then + temp(up,ew,ns) = pmptemp(up) - 0.01d0 + endif + + endif ! thk > thklim_temp + + enddo + enddo + + end subroutine glissade_calcbmlt + +!------------------------------------------------------------------- + + subroutine glissade_finddisp (model, & + thck, & + whichdisp, & + efvs, & + stagthck, & + dusrfdew, & + dusrfdns, & + flwa) + + ! Compute the dissipation source term associated with strain heating. + ! Note that the dissipation is computed in the same way on either a staggered or an + ! unstaggered vertical grid. + ! Note also that dissip and flwa must have the same vertical dimension + ! (1:upn on an unstaggered vertical grid, or 1:upn-1 on a staggered vertical grid). + + use glimmer_physcon, only : gn ! Glen's n + + type(glide_global_type) :: model + real(dp), dimension(:,:), intent(in) :: thck, stagthck, dusrfdew, dusrfdns + real(dp), dimension(:,:,:), intent(in) :: flwa, efvs + integer, intent(in) :: whichdisp + + integer, parameter :: p1 = gn + 1 + integer :: ew, ns + + real(dp) :: c2 + real(dp), dimension(model%general%upn-1) :: c5 + + model%temper%dissip(:,:,:) = 0.0d0 + + select case( whichdisp ) + + case(HO_DISP_NONE) + + ! do nothing; return dissip = 0 everywhere + + case(HO_DISP_SIA) ! required for whichapprox = HO_APPROX_LOCAL_SIA + + !*sfp* 0-order SIA case only + ! two methods of doing this: + ! 1. find dissipation at u-pts and then average + ! 2. find dissipation at H-pts by averaging quantities from u-pts + ! (2) works best for eismint divide (symmetry) but I likely to be better for full expts + + do ns = 2, model%general%nsn-1 + do ew = 2, model%general%ewn-1 + + !WHL - Using thklim instead of thklim_temp because ice thinner than thklim + ! is assumed to be at rest. + if (thck(ew,ns) > model%numerics%thklim) then + + c2 = (0.25d0*sum(stagthck(ew-1:ew,ns-1:ns)) * dsqrt((0.25d0*sum(dusrfdew(ew-1:ew,ns-1:ns)))**2 & + + (0.25d0*sum(dusrfdns(ew-1:ew,ns-1:ns)))**2))**p1 + + model%temper%dissip(:,ew,ns) = c2 * model%tempwk%c1(:) * ( & + flwa(:,ew-1,ns-1) + flwa(:,ew-1,ns+1) + flwa(:,ew+1,ns+1) + flwa(:,ew+1,ns-1) + & + 2*(flwa(:,ew-1,ns)+flwa(:,ew+1,ns)+flwa(:,ew,ns-1)+flwa(:,ew,ns+1)) + & + 4*flwa(:,ew,ns)) + + end if + end do + end do + + case(HO_DISP_FIRSTORDER) + + ! 3D, 1st-order case + ! Note: Glissade computes efvs and tau%scalar using the strain rate terms appropriate for the approximation. + ! E.g, the SIA quantities are computed based on (du_dz, dv_dz) only, and the SSA quantities + ! are computed based on (du_dx, du_dy, dv_dx, dv_dy) only. + ! So this computation should give the appropriate heating for whichapprox = HO_APPROX_SIA, + ! HO_APPROX_SSA, HO_APPROX_L1L2 or HO_APPROX_BP. + ! + ! NOTE (SFP): For simplicity, tau can be calculated from: tau = 2*efvs*eps_eff, + ! where eps_eff is the eff. strain rate. Further, eps_eff can be calculated from the efvs according to a + ! re-arrangement of: efvs = 1/2 * ( 1 / A(T) )^(1/n) * eps_eff^((1-n)/n), in which case only the efvs and rate + ! factor arrays need to be passed in for this calculation. + + if (size(model%temper%dissip,1) /= model%general%upn-1) then ! staggered vertical grid + !TODO - Write an error message and exit gracefully + endif + + do ns = 1, model%general%nsn + do ew = 1, model%general%ewn + + !WHL - Using thklim instead of thklim_temp because ice thinner than thklim + ! is assumed to be at rest. + if (thck(ew,ns) > model%numerics%thklim) then + + c5(:) = 0.0d0 + + if ( sum( efvs(:,ew,ns) ) /= 0.0d0) then + + ! Use space in c5 vector to store dissip terms that apply at layer midpoints + ! (i.e. on staggered vertical grid). No vertical averaging is needed, since + ! temp and dissip are colocated with eff stress and eff viscosity. + + c5(:) = model%stress%tau%scalar(:,ew,ns)**2 / efvs(:,ew,ns) + endif + + !Note: model%tempwk%cons(5) = (tau0*vel0/len0) / (rhoi*shci) * (model%numerics%dttem*tim0) + + model%temper%dissip(:,ew,ns) = c5(:) * model%tempwk%cons(5) + + endif + enddo + enddo + + end select + + end subroutine glissade_finddisp + + !----------------------------------------------------------------------------------- + + !TODO - Inline glissade_calcpmpt and glissade_calcbpmp above? + + subroutine glissade_calcpmpt(pmptemp, thck, stagsigma) + + ! Compute the pressure melting point temperature in the column + ! (but not at the surface or bed). + ! Note: pmptemp and stagsigma should have dimensions (1:upn-1). + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), dimension(:), intent(out) :: pmptemp ! pressure melting point temperature (deg C) + real(dp), intent(in) :: thck ! ice thickness + real(dp), intent(in), dimension(:) :: stagsigma ! staggered vertical coordinate + ! (defined at layer midpoints) + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp(:) = fact * thck * stagsigma(:) + + end subroutine glissade_calcpmpt + + !----------------------------------------------------------------------- + + subroutine glissade_calcbpmp(ewn, nsn, & + thck, bpmp) + + ! Calculate the pressure melting point at the base of the ice sheet + + integer, intent(in) :: ewn, nsn ! grid dimensions + + real(dp), dimension(:,:), intent(in) :: thck ! ice thickness (dimensionless) + real(dp), dimension(:,:), intent(out) :: bpmp ! bed pressure melting point (deg C) + + integer :: ew,ns + + bpmp(:,:) = 0.d0 + + do ns = 1, nsn + do ew = 1, ewn + call glissade_calcpmpt_bed(bpmp(ew,ns),thck(ew,ns)) + end do + end do + + end subroutine glissade_calcbpmp + + !------------------------------------------------------------------- + + subroutine glissade_calcpmpt_bed(pmptemp_bed, thck) + + use glimmer_physcon, only : rhoi, grav, pmlt + use glimmer_paramets, only : thk0 + + real(dp), intent(out) :: pmptemp_bed ! pressure melting point temp at bed (deg C) + real(dp), intent(in) :: thck ! ice thickness + + real(dp), parameter :: fact = - grav * rhoi * pmlt * thk0 + + pmptemp_bed = fact * thck + + end subroutine glissade_calcpmpt_bed + + !------------------------------------------------------------------- + + subroutine glissade_calcflwa(stagsigma, thklim, & + flwa, temp, & + thck, flow_enhancement_factor, & + default_flwa_arg, & + flag, waterfrac) + + ! Calculates Glen's $A$ over the three-dimensional domain, + ! using one of three possible methods. + ! + ! The primary method is to use this equation from \emph{Paterson and Budd} [1982]: + ! \[ + ! A(T^{*})=a \exp \left(\frac{-Q}{RT^{*}}\right) + ! \] + ! This is equation 9 in {\em Payne and Dongelmans}. $a$ is a constant of proportionality, + ! $Q$ is the activation energy for for ice creep, and $R$ is the universal gas constant. + ! The pressure-corrected temperature, $T^{*}$ is given by: + ! \[ + ! T^{*}=T-T_{\mathrm{pmp}}+T_0 + ! \] + ! \[ + ! T_{\mathrm{pmp}}=T_0-\sigma \rho g H \Phi + ! \] + ! $T$ is the ice temperature, $T_{\mathrm{pmp}}$ is the pressure melting point + ! temperature, $T_0$ is the triple point of water, $\rho$ is the ice density, and + ! $\Phi$ is the (constant) rate of change of melting point temperature with pressure. + + use glimmer_physcon + use glimmer_paramets, only : thk0, vis0 + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + +! Note: The flwa, temp, and stagsigma arrays should have the same vertical dimension +! (1:upn-1 on the staggered vertical grid). + + real(dp),dimension(:), intent(in) :: stagsigma ! vertical coordinate at layer midpoints + real(dp), intent(in) :: thklim ! thickness threshold + real(dp),dimension(:,:,:), intent(in) :: temp ! 3D temperature field + real(dp),dimension(:,:), intent(in) :: thck ! ice thickness + real(dp) :: flow_enhancement_factor ! flow enhancement factor in Arrhenius relationship + real(dp), intent(in) :: default_flwa_arg ! Glen's A to use in isothermal case + ! Units: Pa^{-n} yr^{-1} + integer, intent(in) :: flag !> Flag to select the method of calculation + real(dp),dimension(:,:,:), intent(out) :: flwa !> The calculated values of $A$ + real(dp),dimension(:,:,:), intent(in), optional :: waterfrac !> internal water content fraction, 0 to 1 + + !> \begin{description} + !> \item[0] {\em Paterson and Budd} relationship. + !> \item[1] {\em Paterson and Budd} relationship, with temperature set to -5$^{\circ}$C. + !> \item[2] Set to prescribed constant value. + !> \end{description} + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp) :: default_flwa + integer :: ew, ns, up, ewn, nsn, uflwa + real(dp) :: tempcor + + real(dp), parameter :: fact = grav * rhoi * pmlt * thk0 + + real(dp),dimension(4), parameter :: & + arrfact = (/ arrmlh / vis0, & ! Value of A when T* is above -263K + arrmll / vis0, & ! Value of A when T* is below -263K + -actenh / gascon, & ! Value of -Q/R when T* is above -263K + -actenl / gascon/) ! Value of -Q/R when T* is below -263K + + real(dp), parameter :: const_temp = -5.0d0 + real(dp), parameter :: flwa_waterfrac_enhance_factor = 181.25d0 + + !------------------------------------------------------------------------------------ + + uflwa=size(flwa,1) ; ewn=size(flwa,2) ; nsn=size(flwa,3) + + ! Check that the temperature array has the desired vertical dimension + + if (size(temp,1) /= size(flwa,1)) then + call write_log('glissade_calcflwa: temp and flwa must have the same vertical dimensions', GM_FATAL) + endif + + ! Scale the default rate factor (default value has units Pa^{-n} yr^{-1}). + ! Also multiply by flow enhancement factor + + default_flwa = flow_enhancement_factor * default_flwa_arg / (vis0*scyr) + !write(*,*)"Default flwa = ",default_flwa + + select case(flag) + + case(FLWA_PATERSON_BUDD) + + ! This is the Paterson and Budd relationship + ! BDM added waterfrac relationship for whichtemp=TEMP_ENTHALPY case + + do ns = 1,nsn + do ew = 1,ewn + + if (thck(ew,ns) > thklim) then + + do up = 1, uflwa ! uflwa = upn - 1 (values at layer midpoints) + + ! Calculate the corrected temperature + + tempcor = min(0.0d0, temp(up,ew,ns) + thck(ew,ns)*fact*stagsigma(up)) + tempcor = max(-50.0d0, tempcor) + + ! Calculate Glen's A (including flow enhancement factor) + + if (tempcor >= -10.d0) then + flwa(up,ew,ns) = flow_enhancement_factor * arrfact(1) * exp(arrfact(3)/(tempcor + trpt)) + else + flwa(up,ew,ns) = flow_enhancement_factor * arrfact(2) * exp(arrfact(4)/(tempcor + trpt)) + endif + + ! BDM added correction for a liquid water fraction + ! Using Greve and Blatter, 2009 formulation for Glen's A flow rate factor: + ! A = A(theta_PMP) * (1 + 181.25 * waterfrac) + ! RJH - commenting out waterfrac correction to explore causes of + ! oscillations in thk and vel for EISMINT-2 test cases + if (present(waterfrac)) then + if (waterfrac(up,ew,ns) > 0.0d0) then + flwa(up,ew,ns) = flwa(up,ew,ns) * (1.d0 + flwa_waterfrac_enhance_factor * waterfrac(up,ew,ns)) + endif + endif + + enddo ! up + + else ! thck < thklim + + flwa(:,ew,ns) = default_flwa + + end if + + end do + end do + + case(FLWA_PATERSON_BUDD_CONST_TEMP) + + ! This is the Paterson and Budd relationship, but with the temperature held constant + ! at -5 deg C + + do ns = 1,nsn + do ew = 1,ewn + + if (thck(ew,ns) > thklim) then + + ! Calculate Glen's A with a fixed temperature (including flow enhancement factor) + + if (const_temp >= -10.d0) then + flwa(:,ew,ns) = flow_enhancement_factor * arrfact(1) * exp(arrfact(3)/(const_temp + trpt)) + else + flwa(:,ew,ns) = flow_enhancement_factor * arrfact(2) * exp(arrfact(4)/(const_temp + trpt)) + endif + + else + + flwa(:,ew,ns) = default_flwa + + end if + + end do + end do + + case(FLWA_CONST_FLWA) + + flwa(:,:,:) = default_flwa + + end select + + end subroutine glissade_calcflwa + +!------------------------------------------------------------------------------------ + +end module glissade_temp + +!------------------------------------------------------------------------------------ diff --git a/components/cism/glimmer-cism/libglissade/glissade_test.F90 b/components/cism/glimmer-cism/libglissade/glissade_test.F90 new file mode 100644 index 0000000000..09c9b1816e --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_test.F90 @@ -0,0 +1,571 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_test.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module holds some test subroutines for the Glissade dynamical core +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +module glissade_test + + use glimmer_global, only: dp + use glimmer_log + use glide_types + + implicit none + + private + public :: glissade_test_halo, glissade_test_transport + +contains + +!======================================================================= + + subroutine glissade_test_halo(model) + + use parallel + + ! various tests of parallel halo updates + + ! print statements are formatted for a 30x30 global array of scalars + ! (34x34 with nhalo = 2), as for the standard dome problem + + type(glide_global_type), intent(inout) :: model ! model instance + + integer, dimension (:,:), allocatable :: pgID ! unique global ID for parallel runs + real(dp), dimension (:,:), allocatable :: pgIDr4 ! unique global ID for parallel runs + real(dp), dimension (:,:), allocatable :: pgIDr8 ! unique global ID for parallel runs + real(dp), dimension (:,:,:), allocatable :: pgIDr8_3d ! unique global ID for parallel runs + + integer, dimension (:,:), allocatable :: pgIDstagi ! unique global ID for parallel runs + real(dp), dimension (:,:), allocatable :: pgIDstagr ! unique global ID for parallel runs + real(dp), dimension (:,:,:), allocatable :: pgIDstagr3 ! unique global ID for parallel runs + + logical, dimension(:,:), allocatable :: logvar + integer, dimension(:,:), allocatable :: intvar + real, dimension(:,:), allocatable :: r4var + real(dp), dimension(:,:), allocatable :: r8var + real(dp), dimension(:,:,:), allocatable :: r8var_3d + + integer :: i, j, k + integer :: nx, ny, nz + + integer, parameter :: rdiag = 0 ! rank for diagnostic prints + + print*, ' ' + print*, 'In glissade_test_halo, this_rank =', this_rank + + nx = model%general%ewn + ny = model%general%nsn + nz = model%general%upn + + allocate(logvar(nx,ny)) + allocate(intvar(nx,ny)) + allocate(r4var(nx,ny)) + allocate(r8var(nx,ny)) + allocate(r8var_3d(nz,nx,ny)) + + allocate(pgID(nx,ny)) + allocate(pgIDr4(nx,ny)) + allocate(pgIDr8(nx,ny)) + allocate(pgIDr8_3d(nz,nx,ny)) + allocate(pgIDstagi(nx-1,ny-1)) + allocate(pgIDstagr(nx-1,ny-1)) + allocate(pgIDstagr3(nz,nx-1,ny-1)) + + if (main_task) then + print*, ' ' + print*, 'nx, ny, nz =', nx, ny, nz + print*, 'uhalo, lhalo =', uhalo, lhalo + print*, 'global_ewn, global_nsn =', global_ewn, global_nsn + print*, ' ' + endif + + print*, 'this_rank, global_row/col offset =', this_rank, global_row_offset, global_col_offset + + ! Test the 5 standard parallel_halo routines for scalars: logical_2d, integer_2d, real4_2d, real8_2d, real8_3d + + ! logical 2D field + + logvar(:,:) = .false. + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + logvar(i,j) = .true. + enddo + enddo + + if (this_rank == rdiag) then + write(6,*) ' ' + print*, 'logvar: this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34l3)') logvar(:,j) + enddo + endif + + call parallel_halo(logvar) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After parallel_halo_update, this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34l3)') logvar(:,j) + enddo + endif + + ! The next part of the code concerns parallel global IDs + + ! Compute parallel global ID for each grid cell + + pgID(:,:) = 0 ! integer + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + pgID(i,j) = parallel_globalID_scalar(i,j,nz) ! function in parallel_mpi.F90 + enddo + enddo + + if (this_rank == rdiag) then + write(6,*) ' ' + print*, 'Parallel global ID (integer), this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34i5)') pgID(:,j) + enddo + endif + + call parallel_halo(pgID) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After parallel_halo_update, this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34i5)') pgID(:,j) + enddo + endif + + ! real 2D + + pgIDr4(:,:) = 0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + pgIDr4(i,j) = real(parallel_globalID_scalar(i,j,nz)) + enddo + enddo + + if (this_rank == rdiag) then + write(6,*) ' ' + print*, 'Parallel global ID (r4 2D), this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr4(:,j) + enddo + endif + + call parallel_halo(pgIDr4) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After parallel_halo_update, this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr4(:,j) + enddo + endif + + ! double 2D + + pgIDr8(:,:) = 0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + pgIDr8(i,j) = real(parallel_globalID_scalar(i,j,nz), dp) + enddo + enddo + + if (this_rank == rdiag) then + write(6,*) ' ' + print*, 'Parallel global ID (r8 2D), this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr8(:,j) + enddo + endif + + call parallel_halo(pgIDr8) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After parallel_halo_update, this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr8(:,j) + enddo + endif + + ! double 3D + + pgIDr8_3d(:,:,:) = 0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + do k = 1, nz + pgIDr8_3d(k,i,j) = real(parallel_globalID_scalar(i,j,nz),dp) + real(k,dp) ! function in parallel_mpi.F90 + enddo + enddo + enddo + + k = 1 + + if (this_rank == rdiag) then + write(6,*) ' ' + print*, 'Parallel global ID (real 3D), this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr8_3d(k,:,j) + enddo + endif + + call parallel_halo(pgIDr8_3d) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After parallel_halo_update, this_rank =', this_rank + do j = ny, 1, -1 + write(6,'(34f6.0)') pgIDr8_3d(k,:,j) + enddo + endif + + ! Repeat for staggered variables + + ! First for an integer 2D field + + pgIDstagi(:,:) = 0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + pgIDstagi(i,j) = parallel_globalID_scalar(i,j,nz) ! function in parallel_mpi.F90 + enddo + enddo + + ! Print + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'Staggered parallel global ID (integer), this_rank =', this_rank + do j = ny-1, 1, -1 + write(6,'(33i5)') pgIDstagi(:,j) + enddo + endif + + call staggered_parallel_halo(pgIDstagi) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After staggered_parallel_halo_update, this_rank =', this_rank + do j = ny-1, 1, -1 + write(6,'(33i5)') pgIDstagi(:,j) + enddo + endif + + ! Then for a real 2D field + + pgIDstagr(:,:) = 0.d0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + pgIDstagr(i,j) = real(parallel_globalID_scalar(i,j,nz),dp) ! function in parallel_mpi.F90 + enddo + enddo + + ! Print + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'Staggered parallel global ID (real 2D), this_rank =', this_rank + do j = ny-1, 1, -1 + write(6,'(33f6.0)') pgIDstagr(:,j) + enddo + endif + + call staggered_parallel_halo(pgIDstagr) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After staggered_parallel_halo_update, this_rank =', this_rank + do j = ny-1, 1, -1 + write(6,'(33f6.0)') pgIDstagr(:,j) + enddo + endif + + ! Then for a real 3D field + + pgIDstagr3(:,:,:) = 0.d0 + + do j = 1+lhalo, ny-uhalo + do i = 1+lhalo, nx-uhalo + do k = 1, nz + pgIDstagr3(k,i,j) = real(parallel_globalID_scalar(i,j,nz),dp) + real(k,dp) ! function in parallel_mpi.F90 + enddo + enddo + enddo + + k = 1 + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'Staggered parallel global ID (real 3D), k, this_rank =', k, this_rank + do j = ny-1, 1, -1 + write(6,'(33f6.0)') pgIDstagr3(k,:,j) + enddo + endif + + call staggered_parallel_halo(pgIDstagr3) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'After staggered_parallel_halo_update, this_rank =', this_rank + do j = ny-1, 1, -1 + write(6,'(33f6.0)') pgIDstagr3(k,:,j) + enddo + endif + + deallocate(logvar) + deallocate(intvar) + deallocate(r4var) + deallocate(r8var) + deallocate(r8var_3d) + deallocate(pgID) + deallocate(pgIDr4) + deallocate(pgIDr8) + deallocate(pgIDr8_3d) + deallocate(pgIDstagi) + deallocate(pgIDstagr) + deallocate(pgIDstagr3) + + end subroutine glissade_test_halo + +!======================================================================= + + subroutine glissade_test_transport(model) + + use parallel + use glissade_transport, only: glissade_transport_driver, ntracer + use glimmer_paramets, only: len0, thk0, tim0 + use glimmer_physcon, only: pi, scyr + + use glide_diagnostics + + !------------------------------------------------------------------- + ! Test transport of a cylinder or block of ice once around the domain and + ! back to the starting point, assuming uniform motion in a straight line. + ! + ! Instructions for use: + ! (1) At the top of this module, set test_transport = .true. and choose a + ! value for thk_init. + ! (2) Set the config file to run with the glissade dycore for one timestep, + ! with CF output written every timestep. + ! Note: Whatever the initial ice geometry in the config file + ! (e.g., the dome test case), the ice extent will be preserved, but + ! the thickness will be set everywhere to thk_init, giving a steep + ! front at the ice margin that is challenging for transport schemes. + ! (3) Comment out the call to glissade_diagnostic_variable_solve in + ! cism_driver or simple_glide. (It probable won't hurt to + ! have it turned on, but will just use extra cycles.) + ! + ! During the run, the following will happen: + ! (1) During glissade_initialise, the ice thickness will be set to + ! thk_init (everywhere there is ice). + ! (2) During the first call to glissade_tstep, this subroutine + ! (glissade_test_transport) will be called. The ice will be transported + ! around to its initial starting point (assuming periodic BCs). + ! (3) Then the model will return from glissade_tstep before doing any + ! other computations. Output will be written to netCDF and the code + ! will complete. + ! + ! There should be two time slices in the output netCDF file. + ! Compare the ice geometry at these two slices to see how diffusive + ! and/or dispersive the transport scheme is. A perfect scheme + ! would leave the geometry unchanged. + !------------------------------------------------------------------- + + type(glide_global_type), intent(inout) :: model ! model instance + + real(dp), dimension(:,:,:), allocatable :: uvel, vvel ! uniform velocity field (m/yr) + + integer :: i, j, k, n + integer :: nx, ny, nz + real(dp) :: dx, dy + + integer, parameter :: rdiag = 0 ! rank for diagnostic prints + + real(dp), parameter :: umag = 100. ! uniform speed (m/yr) + + ! Set angle of motion + !WHL - Tested all of these angles (eastward, northward, and northeastward) + real(dp), parameter :: theta = 0.d0 ! eastward +! real(dp), parameter :: theta = pi/2.d0 ! northward +! real(dp), parameter :: theta = pi/4.d0 ! northeastward + + real(dp), parameter :: thk = 500.d0 + + real(dp) :: dt ! time step in yr + + integer :: ntstep ! run for this number of timesteps + real(dp) :: theta_c ! angle dividing paths through EW walls from paths thru NS walls + real(dp) :: lenx ! length of shortest path thru EW walls + real(dp) :: leny ! length of shortest path thru NS walls + real(dp) :: len_path ! length of path back to starting point + real(dp) :: adv_cfl ! advective CFL number + + logical :: do_upwind_transport ! if true, do upwind transport + + ! Initialize + + dx = model%numerics%dew * len0 + dy = model%numerics%dns * len0 + + nx = model%general%ewn + ny = model%general%nsn + nz = model%general%upn + + allocate(uvel(nz,nx-1,ny-1)) + allocate(vvel(nz,nx-1,ny-1)) + + ! Find the length of the path around the domain and back to the starting point + + lenx = global_ewn * dx + leny = global_nsn * dy + theta_c = atan(leny/lenx) ! 0 <= theta_c <= pi/2 + + if ( (theta >= -theta_c .and. theta <= theta_c) .or. & + (theta >= pi-theta_c .and. theta <= pi+theta_c) ) then + ! path will cross east/west wall + len_path = lenx / abs(cos(theta)) + else + ! path will cross north/south wall + len_path = leny / abs(sin(theta)) + endif + + ! Choose the number of time steps such that the ice will travel + ! less than one grid cell per time step + + ntstep = nint(len_path/dx) + 10 ! 10 is arbitrary + + ! Choose the time step such that the ice will go around the domain + ! exactly once in the chosen number of time steps. + + dt = len_path / (umag*ntstep) + + ! CFL check, just to be sure + + adv_cfl = max (dt*umag*cos(theta)/dx, dt*umag*sin(theta)/dy) + + if (adv_cfl >= 1.d0) then + print*, 'dt is too big for advective CFL; increase ntstep to', ntstep * adv_cfl + stop + endif + + ! Print some diagnostics + + if (main_task) then + print*, ' ' + print*, 'In glissade_test_transport' + print*, 'nx, ny, nz =', nx, ny, nz + print*, 'len_path =', len_path + print*, 'umag (m/yr) =', umag + print*, 'dt (yr) =', dt + print*, 'ntstep =', ntstep + print*, 'theta (deg) =', theta * 180.d0/pi + endif + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'Initial thck' + do j = ny, 1, -1 + write(6,'(19f7.2)') model%geometry%thck(1:19,j) * thk0 + enddo + endif + + ! Set uniform ice speed everywhere + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + uvel(k,i,j) = umag * cos(theta) + vvel(k,i,j) = umag * sin(theta) + enddo + enddo + enddo + + ! Determine which transport scheme + + if (model%options%whichevol == EVOL_UPWIND) then + do_upwind_transport = .true. + else + do_upwind_transport = .false. + endif + + ! Transport the ice around the domain + + do n = 1, ntstep + + ! call transport scheme + ! Note: glissade_transport_driver expects dt in seconds, uvel/vvel in m/s + + call glissade_transport_driver(dt*scyr, & + dx, dy, & + nx, ny, & + nz-1, model%numerics%sigma, & + ntracer, & + uvel(:,:,:)/scyr, vvel(:,:,:)/scyr, & + model%geometry%thck(:,:), & + model%climate%acab(:,:), & + model%temper%bmlt(:,:), & + model%temper%temp(:,:,:), & + upwind_transport_in = do_upwind_transport) + + if (this_rank == rdiag) then + write(6,*) ' ' + write(6,*) 'New thck, n =', n + do j = ny, 1, -1 + write(6,'(19f7.2)') model%geometry%thck(1:19,j) * thk0 + enddo + endif + + enddo ! ntstep + + if (main_task) print*, 'Done in glissade_test_parallel' + + deallocate(uvel) + deallocate(vvel) + + end subroutine glissade_test_transport + +!======================================================================= + + end module glissade_test + +!======================================================================= diff --git a/components/cism/glimmer-cism/libglissade/glissade_therm.F90 b/components/cism/glimmer-cism/libglissade/glissade_therm.F90 new file mode 100644 index 0000000000..cdeaea9d38 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_therm.F90 @@ -0,0 +1,1824 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_therm.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !----------------------------------------------------------------------------- + ! This module combines two previous modules: glissade_temp.F90 and glissade_enthalpy.F90. + ! It was created in Nov. 2014 by William Lipscomb (LANL). + ! It is functionally equivalent to the two previous modules, but with modified data structures, + ! streamlined organization, and exclusively SI units. + ! + ! The module computes temperature diffusion and strain heating in a local column + ! without doing horizontal or vertical advection. + ! Temperature advection is done separately, e.g. using the incremental remapping transport scheme. + ! It is assumed here that temperature (and enthalpy) values are staggered in the + ! vertical compared to the velocity. That is, the temperature lives at layer midpoints + ! instead of layer interfaces (as in Glide). + ! Temperature and enthalpy are also defined at the upper and lower surfaces with + ! appropriate boundary conditions. + ! + ! The glissade_temp.F90 module was based on glide_temp.F90, with modifications for Glissade. + ! The glissade_enthalpy.F90 module contained modifications for a new enthalpy option; + ! it was originally written by Brian Macpherson (CU) under the supervision of Hari Rajaram. + ! + ! NOTE: SI units are used throughout this module. + !----------------------------------------------------------------------------- + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#include "glide_mask.inc" + +module glissade_therm + + use glimmer_global, only : dp + use glide_types + use glimmer_log + use parallel, only: this_rank + + implicit none + + private + public :: glissade_init_therm, glissade_therm_driver, glissade_flow_factor, glissade_pressure_melting_point, & + glissade_interior_dissipation_sia, glissade_interior_dissipation_first_order, & + glissade_enth2temp, glissade_temp2enth + + ! time-stepping scheme + + !NOTE: For the dome test case, the Crank-Nicolson scheme can give unstable + ! temperature fluctuations for thin ice immediately after the ice + ! becomes thick enough for the temperature calculation. + ! The fully implicit scheme has been stable for all cases (but is only + ! first-order accurate in time). + !NOTE: Crank-Nicolson is not supported for the enthalpy scheme. + + logical, parameter:: & + crank_nicolson = .false. ! if true, use Crank-Nicolson time-stepping + ! if false, use fully implicit + + ! max and min allowed temperatures + ! Temperatures sometimes go below -100 for cases where Crank-Nicholson is unstable + real(dp), parameter :: & + maxtemp_threshold = 1.d11, & + mintemp_threshold = -100.d0 + + real(dp), dimension(:,:), allocatable :: dups ! vertical grid quantities + + contains + +!**************************************************** + + subroutine glissade_init_therm (temp_init, is_restart, & + ewn, nsn, upn, & + sigma, stagsigma, & + thck, artm, & + temp) + + ! initialization subroutine for higher-order dycores, where temperature is defined at + ! the midpoint of each layer plus the upper and lower surfaces + + use glimmer_physcon, only : trpt + use glimmer_paramets, only : unphys_val + + ! In/out arguments + + integer, intent(in) :: & + temp_init, &! method for initializing the temperature + is_restart ! = 1 if restarting, else = 0 + + integer, intent(in) :: ewn, nsn, upn ! grid dimensions + + real(dp), dimension(:), intent(in) :: & + sigma, &! vertical coordinate, located at layer interfaces + stagsigma ! staggered vertical coordinate, located at the center of each layer + + real(dp), dimension(:,:), intent(in) :: & + thck, &! ice thickness (m) + artm ! surface air temperature (deg C) + + real(dp), dimension(0:,:,:), intent(inout) :: & + temp ! ice temperature + ! intent(inout) because it might have been read already from an input file, + ! but otherwise is set in this subroutine + + ! Local variables + + integer :: up, ns, ew + + ! Precompute some grid quantities used in the vertical temperature solve + + allocate(dups(upn+1,2)) + dups(:,:) = 0.0d0 + + up = 1 + dups(up,1) = 1.d0/((sigma(up+1) - sigma(up)) * (stagsigma(up) - sigma(up)) ) + + do up = 2, upn-1 + dups(up,1) = 1.d0/((sigma(up+1) - sigma(up)) * (stagsigma(up) - stagsigma(up-1)) ) + enddo + + do up = 1, upn-2 + dups(up,2) = 1.d0/((sigma(up+1) - sigma(up)) * (stagsigma(up+1) - stagsigma(up)) ) + end do + + up = upn-1 + dups(up,2) = 1.d0/((sigma(up+1) - sigma(up)) * (sigma(up+1) - stagsigma(up)) ) + + ! Check for a possible input error. If the user supplies a file with the 'temp' field, which has + ! vertical dimension (1:upn), then the temperature in layers 1:upn may appear correct (though + ! staggered incorrectly), but the temperature in layer 0 will remain at an unphysical value. + ! Let the user know if this has happened. + !WHL - Nov. 2014 - I verified that the code aborts here if temp (rather than tempstag) is in the restart file. + + if (minval(temp(0,:,:)) < (-1.d0*trpt) .and. minval(temp(1:upn,:,:)) > (-1.d0*trpt)) then + call write_log('Error, temperature field has been read incorrectly. Note that the ' & + // 'Glissade dycore must be initialized with tempstag, not temp.', GM_FATAL) + endif + + !==== Initialize ice temperature.============ + ! Five possibilities: + ! (1) Set ice temperature to 0 C everywhere in column (TEMP_INIT_ZERO) + ! (2) Set ice temperature to surface air temperature everywhere in column (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + ! (4) Read ice temperature from an initial input file. + ! (5) Read ice temperature from a restart file. + ! + ! The default is (2). + ! If restarting, we always do (5). + ! If not restarting and the temperature field is present in the input file, we do (4). + ! If (4) or (5), then the temperature field should already have been read from a file, + ! and the rest of this subroutine will do nothing. + ! Otherwise, the initial temperature is controlled by model%options%temp_init, + ! which can be read from the config file. + + if (is_restart == RESTART_TRUE) then + + ! Temperature has already been initialized from a restart file. + ! (Temperature is always a restart variable.) + + call write_log('Initializing ice temperature from the restart file') + + elseif ( minval(temp) > (-1.0d0 * trpt) ) then ! temperature has been read from an input file + ! Note: trpt = 273.15 K + + ! Temperature has already been initialized from an input file. + ! (We know this because the default initial temps of unphys_val -999 have been overwritten.) + + call write_log('Initializing ice temperature from an input file') + + else ! not reading temperature from restart or input file + ! initialize it here based on temp_init + + ! initialize T = 0 C everywhere + temp(:,:,:) = 0.0d0 + + ! set temperature in each column based on the value of temp_init + + if (temp_init == TEMP_INIT_ZERO) then + call write_log('Initializing ice temperature to 0 deg C') + elseif (temp_init==TEMP_INIT_ARTM) then ! initialize ice column temperature to min(artm, 0 C) + call write_log('Initializing ice temperature to the surface air temperature') + elseif (temp_init == TEMP_INIT_LINEAR) then ! initialize ice column temperature with a linear profile: + ! T = artm at the surface, and T <= Tpmp at the bed + call write_log('Initializing ice temperature to a linear profile in each column') + else + call write_log('Error: invalid temp_init option in glissade_init_therm. It is possible that the temperature' & + // 'was not read correctly from the input file, resulting in unphysical values', GM_FATAL) + endif + + do ns = 1, nsn + do ew = 1, ewn + call glissade_init_temp_column(temp_init, stagsigma(:), & + artm(ew,ns), thck(ew,ns), & + temp(:,ew,ns) ) + end do + end do + + endif ! restart file, input file, or other options + + end subroutine glissade_init_therm + +!======================================================================= + + subroutine glissade_init_temp_column(temp_init, & + stagsigma, artm, & + thck, temp) + + ! Initialize temperatures in a column based on the value of temp_init. + ! Three possibilities: + ! (1) Set ice temperature in column to 0 C (TEMP_INIT_ZERO) + ! (2) Set ice temperature in column to surface air temperature (TEMP_INIT_ARTM) + ! (3) Set up a linear temperature profile, with T = artm at the surface and T <= Tpmp + ! at the bed (TEMP_INIT_LINEAR). + ! A local parameter (pmpt_offset) controls how far below Tpmp the initial bed temp is set. + ! + ! In/out arguments + + integer, intent(in) :: temp_init ! option for temperature initialization + + real(dp), dimension(:), intent(in) :: stagsigma ! staggered vertical coordinate + ! includes layer midpoints, but not top and bottom surfaces + real(dp), intent(in) :: artm ! surface air temperature (deg C) + real(dp), intent(in) :: thck ! ice thickness + real(dp), dimension(0:), intent(inout) :: temp ! ice column temperature (deg C) + ! Note first index of zero + + ! Local variables and parameters + + real(dp) :: pmptemp_bed ! pressure melting point temp at the bed + real(dp), dimension(size(stagsigma)) :: pmptemp ! pressure melting point temp thru the column + integer :: upn ! number of vertical levels (deduced from temp array) + + real(dp), parameter :: pmpt_offset = 2.d0 ! offset of initial Tbed from pressure melting point temperature (deg C) + ! Note: pmtp_offset is positive for T < Tpmp + + upn = size(temp) - 1 ! temperature array has dimension (0:model%general%upn) + + ! Set the temperature in the column + + if (temp_init == TEMP_INIT_ZERO) then ! set T = 0 C + + temp(:) = 0.d0 + + elseif (temp_init == TEMP_INIT_ARTM) then ! initialize ice-covered areas to the min of artm and 0 C + ! set ice-free areas to T = 0 C + if (thck > 0.0d0) then + temp(:) = min(0.0d0, artm) + else + temp(:) = 0.d0 + endif + + elseif (temp_init == TEMP_INIT_LINEAR) then ! Tsfc = artm, Tbed = Tpmp - pmpt_offset, linear profile in between + + temp(0) = artm + + call glissade_pressure_melting_point(thck, pmptemp_bed) + temp(upn) = pmptemp_bed - pmpt_offset + + temp(1:upn-1) = temp(0) + (temp(upn) - temp(0))*stagsigma(:) + + ! Make sure T <= Tpmp - pmpt_offset in column interior + + call glissade_pressure_melting_point_column(thck, stagsigma(1:upn-1), pmptemp(1:upn-1)) + temp(1:upn-1) = min(temp(1:upn-1), pmptemp(1:upn-1) - pmpt_offset) + + endif + + end subroutine glissade_init_temp_column + +!======================================================================= + + subroutine glissade_therm_driver(whichtemp, dttem, & + ewn, nsn, upn, & + itest, jtest, rtest, & + sigma, stagsigma, & + thklim, thklim_temp, & + thck, & + topg, eus, & + artm, & + bheatflx, bfricflx, & + dissip, bwat, & + temp, waterfrac, & + bmlt) + + ! Calculate the new ice temperature by one of several methods: + ! (0) set to surface air temperature + ! (1) standard prognostic temperature solve + ! (2) hold temperature steady + ! (3) prognostic solve for enthalpy (a function of temperature and waterfrac) + + ! Note: SI units are used throughout this subroutine + + use glimmer_utils, only : tridiag + use glimmer_physcon, only: shci, coni, rhoi, tocnfrz_sfc, dtocnfrz_dh + use glide_mask + use glissade_grid_operators, only: glissade_stagger + use glissade_masks, only: glissade_get_masks + + !------------------------------------------------------------------------------------ + ! Input/output arguments + !------------------------------------------------------------------------------------ + + integer, intent(in) :: & + whichtemp ! option for computing temperature + + integer, intent(in) :: & + ewn, nsn, upn, & ! grid dimensions + itest, jtest, rtest ! coordinates of diagnostic point + + real(dp), intent(in) :: & + dttem, &! time step for temperature solve (s) + thklim, &! minimum ice thickness (m) for velocity calculation + thklim_temp, &! minimum ice thickness (m) for thickness calculation + eus ! eustatic sea level (m), = 0. by default + + real(dp), dimension(:), intent(in) :: & + sigma, &! vertical coordinate, located at layer interfaces + stagsigma ! staggered vertical coordinate, located at the center of each layer + + real(dp), dimension(:,:), intent(in) :: & + thck, &! ice thickness (m) + topg, &! basal topography (m) + artm, &! surface air temperature (deg C) + bwat, &! basal water depth (m) + bheatflx, &! geothermal flux (W m-2), positive down + bfricflx ! basal friction heat flux (W m-2), >= 0 + + real(dp), dimension(:,:,:), intent(in) :: & + dissip ! interior heat dissipation (deg/s) + + real(dp), dimension(0:,:,:), intent(out) :: & + temp ! ice temperature (deg C) + + real(dp), dimension(:,:,:), intent(out) :: & + waterfrac ! internal water fraction (unitless) + + real(dp), dimension(:,:), intent(out) :: & + bmlt ! basal melt rate + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + character(len=100) :: message + + real(dp), dimension(0:upn,ewn,nsn) :: & + enthalpy ! specific enthalpy (J m-3) + + real(dp), dimension(upn+1) :: subd, diag, supd, rhsd ! matrix coefficients + + real(dp),dimension(0:upn) :: prevtemp ! previous temperature in column + + real(dp) :: & + einit, efinal, &! initial and final internal energy + delta_e, &! net energy input to ice + dTtop, dTbot, &! temperature differences + denth_top, denth_bot, &! enthalpy differences + maxtemp, mintemp, &! max and min temps in column + depth ! depth at base of ice shelf (m) + + real(dp), dimension(1:upn) :: alpha_enth ! diffusivity at interfaces (m2/s) for enthalpy solver + ! = coni / (rhoi*shci) for cold ice + + integer, dimension(ewn,nsn) :: & + ice_mask, &! = 1 where ice velocity is computed (thck > thklim), else = 0 + ice_mask_temp, &! = 1 where ice temperature is computed (thck > thklim_temp), else = 0 + floating_mask ! = 1 where ice is floating, else = 0 + + real(dp), dimension(ewn,nsn) :: & + ucondflx, & ! conductive heat flux (W/m^2) at upper sfc (positive down) + lcondflx, & ! conductive heat flux (W/m^2) at lower sfc (positive down) + dissipcol ! total heat dissipation rate (W/m^2) in column (>= 0) + + integer :: ew, ns, up + integer :: i, j, k + + logical, parameter:: verbose_therm = .false. ! set to true for diagnostic column output + logical :: verbose_column + + !------------------------------------------------------------------------------------ + ! Compute the new temperature profile in each column + !------------------------------------------------------------------------------------ + + select case(whichtemp) + + case(TEMP_SURFACE_AIR_TEMP) ! Set column to surface air temperature ------------------ + + do ns = 1, nsn + do ew = 1, ewn + temp(:,ew,ns) = min(0.0d0, artm(ew,ns)) + end do + end do + + case(TEMP_STEADY) ! do nothing + + case(TEMP_PROGNOSTIC, TEMP_ENTHALPY) ! Local column calculation + + ! No horizontal or vertical advection; vertical diffusion and strain heating only. + ! Temperatures are vertically staggered relative to velocities. + ! That is, the temperature is defined at the midpoint of each layer + ! (and at the top and bottom surfaces). + + ! Compute masks: ice_mask = 1 where thck > thklim; floating_mask = 1 where ice is floating + + call glissade_get_masks(ewn, nsn, & + thck, topg, & + eus, thklim, & + ice_mask, floating_mask) + + ! Compute ice mask for temperature: ice_mask_temp = 1 where thck > thklim_temp + + call glissade_get_masks(ewn, nsn, & + thck, topg, & + eus, thklim_temp, & + ice_mask_temp) + + !Note: Interior heat dissipation used to be calculated here. + ! Now it is computed at the end of the previous time step, after solving for velocity. + ! + ! Basal frictional heating also was calculated here. + ! Now it is computed in the velocity solver (for Glissade) or just after + ! the velocity solution (for Glam). + + do ns = 1, nsn + do ew = 1, ewn + + if (verbose_therm .and. this_rank==rtest .and. ew==itest .and. ns==jtest) then + verbose_column = .true. + else + verbose_column = .false. + endif + + if (ice_mask_temp(ew,ns) == 1) then + + ! Set surface temperature + + temp(0,ew,ns) = min(0.d0, artm(ew,ns)) + + ! For floating ice, set the basal temperature to the freezing temperature of seawater + ! Values based on Ocean Water Freezing Point Calculator with S = 35 PSU + if (floating_mask(ew,ns) == 1) then + depth = thck(ew,ns) * (rhoi/rhow) + temp(upn,ew,ns) = tocnfrz_sfc + dtocnfrz_dh * depth + endif + + if (whichtemp == TEMP_ENTHALPY) then + + ! Given temperature and waterfrac, compute enthalpy (dimension 0:upn). + ! Assume waterfrac = 0 at upper and lower surfaces. + + call glissade_temp2enth(stagsigma(1:upn-1), & + temp(0:upn,ew,ns), waterfrac(1:upn-1,ew,ns), & + thck(ew,ns), enthalpy(0:upn,ew,ns)) + + if (verbose_column) then + print*, ' ' + print*, 'Before prognostic enthalpy, i, j =', ew, ns + print*, 'thck =', thck(ew,ns) + print*, 'Temp, waterfrac, enthalpy/(rhoi*shci):' + k = 0 + print*, k, temp(k,ew,ns), 0.d0, enthalpy(k,ew,ns)/(rhoi*shci) + do k = 1, upn-1 + print*, k, temp(k,ew,ns), waterfrac(k,ew,ns), enthalpy(k,ew,ns)/(rhoi*shci) + enddo + k = upn + print*, k, temp(k,ew,ns), 0.d0, enthalpy(k,ew,ns)/(rhoi*shci) + endif + + ! compute initial internal energy in column (for energy conservation check) + einit = 0.0d0 + do up = 1, upn-1 + einit = einit + enthalpy(up,ew,ns) * (sigma(up+1) - sigma(up)) + enddo + einit = einit * thck(ew,ns) + + ! compute matrix elements using enthalpy gradient method + + call glissade_enthalpy_matrix_elements(dttem, & + upn, stagsigma, & + subd, diag, & + supd, rhsd, & + dups(:,:), & + floating_mask(ew,ns), & + thck(ew,ns), & + temp(:,ew,ns), & + waterfrac(:,ew,ns), & + enthalpy(0:upn,ew,ns), & + dissip(:,ew,ns), & + bheatflx(ew,ns), & + bfricflx(ew,ns), & + alpha_enth, & + verbose_column) + + !WHL - debug + if (verbose_column) then + print*, ' ' + print*, 'After matrix elements, i, j =', ew, ns + print*, 'k, subd, diag, supd, rhs/(rhoi*ci):' + do k = 1, upn+1 + print*, k-1, subd(k), diag(k), supd(k), rhsd(k)/(rhoi*shci) + enddo + endif + + ! solve the tridiagonal system + ! Note: Enthalpy is indexed from 0 to upn, with indices 1 to upn-1 colocated + ! with stagsigma values of the same index. + ! However, the matrix elements are indexed 1 to upn+1, with the first row + ! corresponding to the surface enthalpy, enthalpy(0). + + call tridiag(subd(1:upn+1), & + diag(1:upn+1), & + supd(1:upn+1), & + enthalpy(0:upn,ew,ns), & + rhsd(1:upn+1)) + + ! Compute conductive fluxes = (alpha/H * denth/dsigma) at upper and lower surfaces; positive down. + ! Here alpha = coni / (rhoi*shci) for cold ice, with a smaller value for temperate ice. + ! Assume fully implicit backward Euler time step. + ! Note: These fluxes should be computed before calling glissade_enth2temp (which might reset the bed enthalpy). + + denth_top = enthalpy(1,ew,ns) - enthalpy(0,ew,ns) + denth_bot = enthalpy(upn,ew,ns) - enthalpy(upn-1,ew,ns) + + ucondflx(ew,ns) = -alpha_enth(1) /thck(ew,ns) * denth_top/( stagsigma(1)) + lcondflx(ew,ns) = -alpha_enth(upn)/thck(ew,ns) * denth_bot/(1.d0 - stagsigma(upn-1)) + + ! convert enthalpy back to temperature and water content + call glissade_enth2temp(stagsigma(1:upn-1), & + thck(ew,ns), enthalpy(0:upn,ew,ns), & + temp(0:upn,ew,ns), waterfrac(1:upn-1,ew,ns)) + + if (verbose_column) then + print*, ' ' + print*, 'After prognostic enthalpy, i, j =', ew, ns + print*, 'thck =', thck(ew,ns) + print*, 'Temp, waterfrac, enthalpy/(rhoi*shci):' + k = 0 + print*, k, temp(k,ew,ns), 0.d0, enthalpy(k,ew,ns)/(rhoi*shci) + do k = 1, upn-1 + print*, k, temp(k,ew,ns), waterfrac(k,ew,ns), enthalpy(k,ew,ns)/(rhoi*shci) + enddo + k = upn + print*, k, temp(k,ew,ns), 0.d0, enthalpy(k,ew,ns)/(rhoi*shci) + endif + + ! compute the final internal energy + + efinal = 0.0d0 + do up = 1, upn-1 + efinal = efinal + enthalpy(up,ew,ns) * (sigma(up+1) - sigma(up) ) + enddo + efinal = efinal * thck(ew,ns) + + else ! whichtemp = TEMP_PROGNOSTIC + + if (verbose_column) then + print*, ' ' + print*, 'Before prognostic temp, i, j =', ew, ns + print*, 'thck =', thck(ew,ns) + print*, 'Temp:' + do k = 0, upn + print*, k, temp(k,ew,ns) + enddo + endif + + ! compute initial internal energy in column (for energy conservation check) + einit = 0.0d0 + do up = 1, upn-1 + einit = einit + temp(up,ew,ns) * (sigma(up+1) - sigma(up)) + enddo + einit = einit * rhoi * shci * thck(ew,ns) + + ! compute matrix elements + + call glissade_temperature_matrix_elements(dttem, & + upn, stagsigma, & + subd, diag, & + supd, rhsd, & + floating_mask(ew,ns), & + thck(ew,ns), & + temp(:,ew,ns), & + dissip(:,ew,ns), & + bheatflx(ew,ns), & + bfricflx(ew,ns)) + + if (verbose_column) then + print*, 'After matrix elements, i, j =', ew,ns + print*, 'k, subd, diag, supd, rhsd:' + do k = 1, upn+1 + print*, k, subd(k), diag(k), supd(k), rhsd(k) + enddo + endif + + prevtemp(:) = temp(:,ew,ns) + + ! solve the tridiagonal system + + ! Note: Temperature is indexed from 0 to upn, with indices 1 to upn-1 colocated + ! with stagsigma values of the same index. + ! However, the matrix elements are indexed 1 to upn+1, with the first row + ! corresponding to the surface temperature, temp(0,:,:). + + call tridiag(subd(1:upn+1), & + diag(1:upn+1), & + supd(1:upn+1), & + temp(0:upn,ew,ns), & + rhsd(1:upn+1)) + + ! conductive flux = (k/H * dT/dsigma) at upper and lower surfaces; positive down + + if (crank_nicolson) then + ! average temperatures between start and end of timestep + dTtop = 0.5d0 * (temp(1,ew,ns) - temp(0,ew,ns) + prevtemp(1) - prevtemp(0)) + dTbot = 0.5d0 * (temp(upn,ew,ns) - temp(upn-1,ew,ns) + prevtemp(upn) - prevtemp(upn-1)) + else ! fully implicit + ! use temperatures at end of timestep + dTtop = temp(1,ew,ns) - temp(0,ew,ns) + dTbot = temp(upn,ew,ns) - temp(upn-1,ew,ns) + endif + + ucondflx(ew,ns) = (-coni/thck(ew,ns) ) * dTtop / (stagsigma(1)) + lcondflx(ew,ns) = (-coni/thck(ew,ns) ) * dTbot / (1.d0 - stagsigma(upn-1)) + + if (verbose_column) then + print*, ' ' + print*, 'After prognostic temp, i, j =', ew, ns + print*, 'Temp:' + do k = 0, upn + print*, k, temp(k,ew,ns) + enddo + endif + + ! compute the final internal energy + + efinal = 0.0d0 + do up = 1, upn-1 + efinal = efinal + temp(up,ew,ns) * (sigma(up+1) - sigma(up)) + enddo + efinal = efinal * rhoi*shci * thck(ew,ns) + + endif ! whichtemp + + ! Compute total dissipation rate in column (W/m^2) + + dissipcol(ew,ns) = 0.0d0 + do up = 1, upn-1 + dissipcol(ew,ns) = dissipcol(ew,ns) + dissip(up,ew,ns) * (sigma(up+1) - sigma(up)) + enddo + dissipcol(ew,ns) = dissipcol(ew,ns) * thck(ew,ns)*rhoi*shci + + ! Verify that the net input of energy into the column is equal to the change in + ! internal energy. + + delta_e = (ucondflx(ew,ns) - lcondflx(ew,ns) + dissipcol(ew,ns)) * dttem + + if (abs((efinal-einit-delta_e)/dttem) > 1.0d-8) then + + if (verbose_column) then + print*, 'Ice thickness:', thck(ew,ns) + print*, 'thklim_temp:', thklim_temp + print*, ' ' + print*, 'Interior fluxes:' + print*, 'ftop (pos up)=', -ucondflx(ew,ns) + print*, 'fbot (pos up)=', -lcondflx(ew,ns) + print*, 'fdissip =', dissipcol(ew,ns) + print*, 'Net flux =', delta_e/dttem + print*, ' ' + print*, 'delta_e =', delta_e + print*, 'einit =', einit + print*, 'efinal =', efinal + print*, 'einit + delta_e =', einit + delta_e + print*, ' ' + print*, 'Energy imbalance =', efinal - einit - delta_e + print*, ' ' + print*, 'Basal fluxes:' + print*, 'ffric =', bfricflx(ew,ns) + print*, 'fgeo =', -bheatflx(ew,ns) + print*, 'flux for bottom melting =', bfricflx(ew,ns) - bheatflx(ew,ns) + lcondflx(ew,ns) + endif ! verbose_column + + write(message,*) 'WARNING: Energy conservation error, ew, ns =', ew, ns + call write_log(message,GM_FATAL) + endif + + endif ! thck > thklim_temp + end do ! ew + end do ! ns + + ! Set temperature of thin ice to the air temperature and set ice-free nodes to zero + + do ns = 1, nsn + do ew = 1, ewn + + if (thck(ew,ns) <= thklim_temp) then + temp(:,ew,ns) = min(0.d0, artm(ew,ns)) + endif + + !TODO - Maybe it should be done in the following way, so that the temperature profile for thin ice + ! is consistent with the temp_init option, with T = 0 for ice-free cells. + + ! NOTE: Calling this subroutine will maintain a sensible temperature profile + ! for thin ice, but in general does *not* conserve energy. + ! To conserve energy, we need either thklim_temp = 0, or some additional + ! energy accounting and correction. + +! if (thck(ew,ns) <= thklim_temp) then +! call glissade_init_temp_column(temp_init, & +! stagsigma(:), & +! artm(ew,ns)), & +! thck(ew,ns), & +! temp(:,ew,ns) ) +! else if (model%geometry%thkmask(ew,ns) < 0) then +! temp(:,ew,ns) = 0.d0 +! end if + + end do + end do + + ! Calculate basal melt rate + ! For the standard temperature scheme, temperatures above the pressure melting point + ! are reset to Tpmp, with excess heat contributing to basal melt. + ! For the enthalpy scheme, internal meltwater in excess of the prescribed maximum + ! fraction (0.01 by default) is drained to the bed. + + call glissade_basal_melting(whichtemp, dttem, & + ewn, nsn, upn, & + sigma, stagsigma, & + ice_mask_temp, floating_mask, & + thck, temp, & + waterfrac, enthalpy, & + bfricflx, bheatflx, & + lcondflx, bwat, & + bmlt) + + end select ! whichtemp + + ! Check for temperatures that are physically unrealistic. + ! Thresholds are set at the top of this module. + + do ns = 1, nsn + do ew = 1, ewn + + maxtemp = maxval(temp(:,ew,ns)) + mintemp = minval(temp(:,ew,ns)) + + if (maxtemp > maxtemp_threshold) then + write(message,*) 'maxtemp > 0: i, j, maxtemp =', ew, ns, maxtemp + call write_log(message,GM_FATAL) + endif + + if (mintemp < mintemp_threshold) then + !uncommment these lines to get more info +! print*, 'thck =', thck(ew,ns) +! print*, 'temp:' +! do k = 1, upn +! print*, k, temp(k,ew,ns) +! enddo + write(message,*) 'mintemp < mintemp_threshold: i, j, mintemp =', ew, ns, mintemp + call write_log(message,GM_FATAL) + endif + + enddo + enddo + + end subroutine glissade_therm_driver + +!======================================================================= + + subroutine glissade_temperature_matrix_elements(dttem, & + upn, stagsigma, & + subd, diag, & + supd, rhsd, & + floating_mask, & + thck, temp, & + dissip, & + bheatflx, bfricflx) + + ! compute matrix elements for the tridiagonal solve + + use glimmer_physcon, only : rhoi, grav, coni + + ! Note: Matrix elements (subd, supd, diag, rhsd) are indexed from 1 to upn+1, + ! whereas temperature is indexed from 0 to upn. + ! The first row of the matrix is the equation for temp(0,ew,ns), + ! the second row is the equation for temp(1,ew,ns), and so on. + + real(dp), intent(in) :: dttem ! time step (s) + integer, intent(in) :: upn ! number of layer interfaces + real(dp), dimension(upn-1), intent(in) :: stagsigma ! sigma coordinate at temp nodes + real(dp), dimension(:), intent(out) :: subd, diag, supd, rhsd + integer, intent(in) :: floating_mask + real(dp), intent(in) :: thck ! ice thickness (m) + real(dp), dimension(0:upn), intent(in) :: temp ! ice temperature (deg C) + real(dp), dimension(upn-1), intent(in) :: dissip ! interior heat dissipation (deg/s) + real(dp), intent(in) :: bheatflx ! geothermal flux (W m-2), positive down + real(dp), intent(in) :: bfricflx ! basal friction heat flux (W m-2), >= 0 + + ! local variables + + real(dp) :: pmptemp_bed ! pressure melting temp at bed + real(dp) :: fact + real(dp) :: dsigbot ! bottom layer thicknes in sigma coords + + ! Compute subdiagonal, diagonal, and superdiagonal matrix elements + + ! upper boundary: set to surface air temperature + + supd(1) = 0.0d0 + subd(1) = 0.0d0 + diag(1) = 1.0d0 + rhsd(1) = temp(0) + + ! ice interior, layers 1:upn-1 (matrix elements 2:upn) + + if (crank_nicolson) then ! C-N can lead to oscillations in thin ice; currently deprecated + + fact = dttem * coni / (2.d0 * rhoi*shci) / thck**2 + subd(2:upn) = -fact * dups(1:upn-1,1) + supd(2:upn) = -fact * dups(1:upn-1,2) + diag(2:upn) = 1.0d0 - subd(2:upn) - supd(2:upn) + rhsd(2:upn) = temp(1:upn-1) * (2.0d0 - diag(2:upn)) & + - temp(0:upn-2) * subd(2:upn) & + - temp(2:upn ) * supd(2:upn) & + + dissip(1:upn-1) + + else ! fully implicit + + fact = dttem * coni / (rhoi*shci) / thck**2 + subd(2:upn) = -fact * dups(1:upn-1,1) + supd(2:upn) = -fact * dups(1:upn-1,2) + diag(2:upn) = 1.0d0 - subd(2:upn) - supd(2:upn) + rhsd(2:upn) = temp(1:upn-1) + dissip(1:upn-1)*dttem + + endif ! crank_nicolson + + ! basal boundary: + ! for grounded ice, a heat flux is applied + ! for floating ice, the basal temperature is held constant + + !NOTE: This lower BC is different from the one in glide_temp. + ! If T(upn) < T_pmp, then require dT/dsigma = H/k * (G + taub*ubas) + ! That is, net heat flux at lower boundary must equal zero. + ! If T(upn) >= Tpmp, then set T(upn) = Tpmp + + if (floating_mask == 1) then + + supd(upn+1) = 0.0d0 + subd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = temp(upn) + + else ! grounded ice + + call glissade_pressure_melting_point(thck, pmptemp_bed) + + if (abs(temp(upn) - pmptemp_bed) < 0.001d0) then + + ! hold basal temperature at pressure melting point + + supd(upn+1) = 0.0d0 + subd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = pmptemp_bed + + else ! frozen at bed + ! maintain balance of heat sources and sinks + ! (conductive flux, geothermal flux, and basal friction) + ! Note: Heat fluxes are positive down, so slterm <= 0 and bheatflx <= 0. + + ! Note: bheatflx is generally <= 0, since defined as positive down. + + ! calculate dsigma for the bottom layer between the basal boundary and the temp. point above + dsigbot = (1.0d0 - stagsigma(upn-1)) + + ! =====Backward Euler flux basal boundary condition===== + ! MJH: If Crank-Nicolson is desired for the b.c., it is necessary to + ! ensure that the i.c. temperature for the boundary satisfies the + ! b.c. - otherwise oscillations will occur because the C-N b.c. only + ! specifies the basal flux averaged over two consecutive time steps. + subd(upn+1) = -1.0d0 + supd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = (bfricflx - bheatflx) * dsigbot*thck / coni + + endif ! melting or frozen + + end if ! floating or grounded + + end subroutine glissade_temperature_matrix_elements + +!======================================================================= + + subroutine glissade_enthalpy_matrix_elements(dttem, & + upn, stagsigma, & + subd, diag, & + supd, rhsd, & + dups, floating_mask, & + thck, & + temp, waterfrac, & + enthalpy, dissip, & + bheatflx, bfricflx, & + alpha_enth, & + verbose_column_in) + + ! solve for tridiagonal entries of sparse matrix + + use glimmer_physcon, only : rhoi, shci, lhci, rhow, coni + + ! Note: Matrix elements (subd, supd, diag, rhsd) are indexed from 1 to upn+1, + ! whereas temperature/enthalpy is indexed from 0 to upn. + ! The first row of the matrix is the equation for enthalpy(0), + ! the last row is the equation for enthalpy(upn), and so on. + + !I/O variables + real(dp), intent(in) :: dttem ! time step (s) + integer, intent(in) :: upn ! number of layer interfaces + real(dp), dimension(upn-1), intent(in) :: stagsigma ! sigma coordinate at temp/enthalpy nodes + real(dp), dimension(:,:), intent(in) :: dups ! vertical grid quantities + real(dp), dimension(:), intent(out) :: subd, diag, supd, rhsd + integer, intent(in) :: floating_mask + real(dp), intent(in) :: thck ! ice thickness (m) + real(dp), dimension(0:upn), intent(in) :: temp ! temperature (deg C) + real(dp), dimension(upn-1), intent(in) :: waterfrac ! water fraction (unitless) + real(dp), dimension(0:upn), intent(in) :: enthalpy ! specific enthalpy (J/m^3) + real(dp), dimension(upn-1), intent(in) :: dissip ! interior heat dissipation (deg/s) + real(dp), intent(in) :: bheatflx ! geothermal flux (W m-2), positive down + real(dp), intent(in) :: bfricflx ! basal friction heat flux (W m-2), >= 0 + real(dp), dimension(:), intent(out) :: alpha_enth ! half-node diffusivity (m^2/s) for enthalpy + ! located halfway between temperature points + + logical, intent(in), optional :: verbose_column_in ! if true, print debug statements for this column + + ! local variables + real(dp) :: dsigbot ! bottom layer thicknes in sigma coords. + real(dp) :: alphai ! cold ice diffusivity + real(dp) :: alpha0 ! temperate ice diffusivity + real(dp) :: fact ! coefficient in tridiag + integer :: up + real(dp), dimension(1:upn-1) :: pmptemp ! pressure melting point temp in interior (deg C) + real(dp) :: pmptemp_bed ! pressure melting point temp at bed (deg C) + real(dp), dimension(0:upn) :: enth_T ! temperature part of specific enthalpy (J/m^3) + real(dp) :: denth ! enthalpy difference between adjacent layers + real(dp) :: denth_T ! difference in temperature component of enthalpy between adjacent layers + real(dp) :: alpha_fact ! factor for averaging diffusivity, 0 <= fact <= 1 + logical :: verbose_column ! if true, print debug statements for this column + + logical, parameter :: & + alpha_harmonic_avg = .false. ! if true, take harmonic average of alpha in adjacent layers + ! if false, take arithmetic average + + if (present(verbose_column_in)) then + verbose_column = verbose_column_in + else + verbose_column = .false. + endif + + ! define diffusivities alpha_i and alpha_0 + alphai = coni / rhoi / shci + alpha0 = alphai / 100.0d0 + + ! find pmptemp for this column (interior nodes and boundary) + call glissade_pressure_melting_point_column(thck, stagsigma(1:upn-1), pmptemp(1:upn-1)) + call glissade_pressure_melting_point(thck, pmptemp_bed) + + !WHL - debug + if (verbose_column) then + print*, ' ' + print*, 'Computing enthalpy matrix elements' + print*, 'k, temp, wfrac, enthalpy/(rhoi*ci), pmpt:' + up = 0 + print*, up, temp(up), 0.d0, enthalpy(up)/(rhoi*shci) + do up = 1, upn-1 + print*, up, temp(up), waterfrac(up), & + enthalpy(up)/(rhoi*shci), pmptemp(up) + enddo + up = upn + print*, up, temp(up), 0.d0, enthalpy(up)/(rhoi*shci), pmptemp_bed + endif + + !WHL - Commenting out the following and replacing it with a new way of computing alpha. + ! The commented-out code can result in sudden large changes in alpha that + ! lead to oscillations in the thickness, temperature and velocity fields. + ! These oscillations have a period of ~1 yr or more, spatial scale of + ! many grid cells, and amplitude of ~10 m in thickness, 1 deg in temperature, + ! and 2 m/s in velocity. + + ! create a column vector of size (0:upn) of diffusivity based on + ! previous timestep's temp. Boundary nodes need a value so half-node + ! diffusivity can be calculated at interior nodes (1:upn-1) + +! do up = 0,upn +! if (temp(up) < pmptemp(up)) then +! alpha(up) = alphai +! else +! alpha(up) = alpha0 +! endif +! end do + + ! Find half-node diffusivity using harmonic average between nodes. + ! The vector will be size (1:upn) - the first value is the half-node + ! between nodes 0 and 1, the last value is the half-node between + ! nodes upn-1 and upn. + +! do up = 1,upn +! alpha_enth(up) = 2.d0 / ((1.d0/alpha(up-1)) + (1.d0/alpha(up))) +! end do + + !-------------------------------------------------------------------- + !WHL - Trying a different approach to the diffusivity at layer interfaces. + ! Let d(enth)/dz = the gradient of enthalpy + ! Can write + ! d(enth)/dz = d(enth_T)/dz + d(enth_w)/dz, + ! where + ! enth_T = (1-phi_w) * rhoi*ci*T + ! enth_w = phi_w * rhow*(L + ci*Tpmp) + ! + ! Now let f = d(enth_T)/z / d(enth)/dz + ! (f -> 0 if f is computed to be negative) + ! For cold ice, f = 1 and alpha = alphai + ! For temperate ice, f ~ 0 and alpha = alpha0 + ! At the interface between cold and temperate ice, + ! f ~ 0 if the temperate ice has large phi_w, but + ! f ~ 1 if the temperate ice has close to zero phi_w. + ! Two ways to average: + ! (1) arithmetic average: alpha = f*alphai + (1-f)*alpha0 + ! (2) harmonic average: alpha = 1 / (f/alphai + (1-f)/alpha0). + ! Both methods have the same asymptotic values at f = 0 or 1, + ! but the arithmetic average gives greater diffusivity for + ! intermediate values. + ! + ! Still to be determined which is more accurate. + ! The harmonic average allows large temperature gradients between the + ! bottom layer and the next layer up; the arithmetic average gives + ! smoother gradients. + !-------------------------------------------------------------------- + ! + ! At each temperature point, compute the temperature part of the enthalpy. + ! enth_T = enth for cold ice, enth_T < enth for temperate ice + + do up = 0, upn + enth_T(up) = (1.d0 - waterfrac(up)) * rhoi*shci*temp(up) + enddo + +!WHL - debug + if (verbose_column) then + print*, ' ' + print*, 'k, denth_T/(rhoi*shci), denth/(rhoi*shci), alpha_fact, alpha_enth(up):' + endif + + ! Compute factors relating the temperature gradient to the total enthalpy gradient. + ! Use these factors to average the diffusivity between adjacent temperature points. + do up = 1,upn + denth = enthalpy(up) - enthalpy(up-1) + denth_T = enth_T(up) - enth_T(up-1) ! = denth in cold ice, < denth in temperate ice + if (abs(denth) > 1.d-20 * rhow*lhci) then + alpha_fact = max(0.d0, denth_T/denth) + alpha_fact = min(1.d0, alpha_fact) + else + alpha_fact = 0.d0 + endif + + if (alpha_harmonic_avg) then ! take a harmonic average + ! This gives slower cooling of temperate layers and allows + ! large temperature gradients between cold and temperate layers + alpha_enth(up) = 1.d0 / ((alpha_fact/alphai) + (1.d0-alpha_fact)/alpha0) + else ! take an arithmetic average + ! This gives faster cooling of temperate layers and smaller gradients + alpha_enth(up) = alpha_fact*alphai + (1.d0-alpha_fact)*alpha0 + endif + +!WHL - debug + if (verbose_column) then + print*, up, denth_T/(rhoi*shci), denth/(rhoi*shci), alpha_fact, alpha_enth(up) + endif + + end do + + ! Compute subdiagonal, diagonal, and superdiagonal matrix elements + ! Assume backward Euler time stepping + + ! upper boundary: set to surface air temperature + supd(1) = 0.0d0 + subd(1) = 0.0d0 + diag(1) = 1.0d0 + rhsd(1) = min(0.0d0,temp(0)) * rhoi*shci + + ! ice interior. layers 1:upn-1 (matrix elements 2:upn) + + fact = dttem / thck**2 + + subd(2:upn) = -fact * alpha_enth(1:upn-1) * dups(1:upn-1,1) + supd(2:upn) = -fact * alpha_enth(2:upn) * dups(1:upn-1,2) + diag(2:upn) = 1.0d0 - subd(2:upn) - supd(2:upn) + rhsd(2:upn) = enthalpy(1:upn-1) + dissip(1:upn-1)*dttem * rhoi * shci + + ! BDM I'm assuming that dissip has units of phi/rhoi/shci. + ! For an enthalpy calc, we want just phi, hence dissip * rhoi * shci + + ! basal boundary: + ! for grounded ice, a heat flux is applied + ! for floating ice, the basal temperature is held constant + + !NOTE: This lower BC is different from the one in glide_temp. + ! If T(upn) < T_pmp, then require dT/dsigma = H/k * (G + taub*ubas) + ! That is, net heat flux at lower boundary must equal zero. + ! If T(upn) >= Tpmp, then set T(upn) = Tpmp + + if (floating_mask == 1) then + + supd(upn+1) = 0.0d0 + subd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = enthalpy(upn) + + else ! grounded ice + + !WHL - debug + if (verbose_column) then + up = upn-1 + print*, 'temp(upn-1), pmptemp(upn-1):', temp(up), pmptemp(up) + up = upn + print*, 'temp(upn), pmptemp(upn):', temp(up), pmptemp_bed + endif + + ! Positive-Thickness Basal Temperate Boundary Layer + + !WHL - Not sure whether this condition is ideal. + ! It implies that the enthalpy at the bed (upn) = enthalpy in layer (upn-1). + if (abs(temp(upn-1) - pmptemp(upn-1)) < 0.001d0) then + + subd(upn+1) = -1.0d0 + supd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = 0.0d0 + + !WHL - debug + if (verbose_column) then + print*, 'basal BC: branch 1 (finite-thck BL)' + endif + + !Zero-Thickness Basal Temperate Boundary Layer + elseif (abs(temp(upn) - pmptemp_bed) < 0.001d0) then ! melting + + ! hold basal temperature at pressure melting point + supd(upn+1) = 0.0d0 + subd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = pmptemp_bed * rhoi * shci + + !WHL - debug + if (verbose_column) then + print*, 'basal BC: branch 2 (zero-thck BL)' + endif + + else + + !WHL - debug + if (verbose_column) then + print*, 'basal BC: branch 3 (cold ice)' + endif + + ! frozen at bed + ! maintain balance of heat sources and sinks + ! (conductive flux, geothermal flux, and basal friction) + ! Note: Heat fluxes are positive down, so slterm <= 0 and bheatflx <= 0. + + ! Note: The heat source due to basal sliding (bfricflx) is computed in subroutine calcbfric. + ! Also note that bheatflx is generally <= 0, since defined as positive down. + + ! calculate dsigma for the bottom layer between the basal boundary and the temp. point above + dsigbot = (1.0d0 - stagsigma(upn-1)) + + ! =====Backward Euler flux basal boundary condition===== + ! MJH: If Crank-Nicolson is desired for the b.c., it is necessary to + ! ensure that the i.c. temperature for the boundary satisfies the + ! b.c. - otherwise oscillations will occur because the C-N b.c. only + ! specifies the basal flux averaged over two consecutive time steps. + subd(upn+1) = -1.0d0 + supd(upn+1) = 0.0d0 + diag(upn+1) = 1.0d0 + rhsd(upn+1) = (bfricflx - bheatflx) * dsigbot*thck * rhoi*shci/coni + ! BDM temp approach should work out to be dT/dsigma, so enthalpy approach + ! should just need dT/dsigma * rhoi * shci for correct units + + endif ! melting or frozen + + end if ! floating or grounded + + end subroutine glissade_enthalpy_matrix_elements + +!======================================================================= + + subroutine glissade_basal_melting(whichtemp, dttem, & + ewn, nsn, & + upn, & + sigma, stagsigma, & + ice_mask, floating_mask, & + thck, temp, & + waterfrac, enthalpy, & + bfricflx, bheatflx, & + lcondflx, & + bwat, bmlt) + + ! Compute the rate of basal melting. + ! The basal melting computed here is applied to the ice thickness + ! by glissade_transport_driver, conserving mass and energy. + ! + ! For the standard prognostic temperature scheme, any internal temperatures + ! above the pressure melting point are reset to Tpmp. Excess energy + ! is applied toward melting with immediate drainage to the bed. + ! For the enthalpy scheme, any meltwater in excess of the maximum allowed + ! meltwater fraction (0.01 by default) is drained to the bed. + ! + !TODO - Deal with basal melting for floating ice + + use glimmer_physcon, only: shci, rhoi, lhci + + !----------------------------------------------------------------- + ! Input/output arguments + !----------------------------------------------------------------- + + integer, intent(in) :: whichtemp ! temperature method (TEMP_PROGNOSTIC or TEMP_ENTHALPY) + real(dp), intent(in) :: dttem ! time step (s) + integer, intent(in) :: ewn, nsn, upn ! grid dimensions + real(dp), dimension(upn), intent(in) :: sigma ! vertical sigma coordinate + real(dp), dimension(upn-1), intent(in) :: stagsigma ! staggered vertical coordinate for temperature + real(dp), dimension(0:,:,:), intent(inout) :: temp ! temperature (deg C) + real(dp), dimension(:,:,:), intent(inout) :: waterfrac ! water fraction + real(dp), dimension(0:,:,:), intent(in) :: enthalpy ! enthalpy + real(dp), dimension(:,:), intent(in) :: & + thck, & ! ice thickness (m) + bfricflx, & ! basal frictional heating flux (W m-2), >= 0 + bheatflx, & ! geothermal heating flux (W m-2), positive down + lcondflx, & ! heat conducted from ice interior to bed (W m-2), positive down + bwat ! depth of basal water (m) + + integer, dimension(:,:), intent(in) :: & + ice_mask, &! = 1 where ice exists (thck > thklim_temp), else = 0 + floating_mask ! = 1 where ice is floating, else = 0 + + real(dp), dimension(:,:), intent(out):: bmlt ! melt rate (m/s) + ! > 0 for melting, < 0 for freeze-on + + !----------------------------------------------------------------- + ! Local variables + !----------------------------------------------------------------- + + integer :: up, ew, ns + real(dp), dimension(upn-1) :: pmptemp ! pressure melting point temp in ice interior + real(dp) :: pmptemp_bed ! pressure melting point temp at bed + real(dp) :: bflx ! heat flux available for basal melting (W/m^2) + real(dp) :: layer_thck ! layer thickness (m) + real(dp) :: melt_energy ! energy available for internal melting (J/m^2) + real(dp) :: internal_melt_rate ! internal melt rate, transferred to bed (m/s) + real(dp) :: melt_fact ! factor for bmlt calculation + real(dp) :: hmlt ! melt thickness associated with excess meltwater + + real(dp), parameter :: max_waterfrac = 0.01d0 ! maximum allowed water fraction + ! excess water drains to the bed + real(dp), parameter :: eps11 = 1.d-11 ! small number + + bmlt(:,:) = 0.0d0 + melt_fact = 1.0d0 / (lhci * rhoi) + + do ns = 1, nsn + do ew = 1, ewn + + if (ice_mask(ew,ns)==1 .and. floating_mask(ew,ns)==0) then + + ! Basal friction term is computed above in subroutine glissade_calcbfric, + ! or in the Glissade velocity solver. + ! + ! Compute basal melting + ! Note: bmlt > 0 for melting, < 0 for freeze-on + ! bfricflx >= 0 by definition + ! bheatflx is positive down, so usually bheatflx < 0 (with negative values contributing to melt) + ! lcondflx is positive down, so lcondflx < 0 for heat is flowing from the bed toward the surface + ! + ! This equation allows for freeze-on (bmlt < 0) if the conductive term + ! (lcondflx, positive down) is carrying enough heat away from the boundary. + ! But freeze-on requires a local water supply, bwat > 0. + ! When bwat = 0, we reset the bed temperature to a value slightly below the melting point. + ! + !TODO - For the enthalpy scheme, deal with the rare case that the bottom layer melts completely + ! and overlying layers with a different enthalpy also melt. + + bflx = bfricflx(ew,ns) + lcondflx(ew,ns) - bheatflx(ew,ns) ! W/m^2 + + if (abs(bflx) < eps11) then ! bflx might be slightly different from zero because of rounding errors; if so, then zero out + bflx = 0.d0 + endif + + if (whichtemp == TEMP_ENTHALPY) then + bmlt(ew,ns) = bflx / (lhci*rhoi - enthalpy(upn,ew,ns)) + else + bmlt(ew,ns) = bflx * melt_fact ! m/s + endif + + ! Add internal melting + + if (whichtemp == TEMP_ENTHALPY) then + + ! Add internal melting associated with waterfrac > max_waterfrac (1%) + + !TODO - Any correction for rhoi/rhow here? Or melting ice that is already partly melted? + do up = 1, upn-1 + if (waterfrac(up,ew,ns) > max_waterfrac) then + ! compute melt rate associated with excess water + hmlt = (waterfrac(up,ew,ns) - max_waterfrac) * thck(ew,ns) * (sigma(up+1) - sigma(up)) ! m + internal_melt_rate = hmlt / dttem ! m/s + ! transfer meltwater to the bed + bmlt(ew,ns) = bmlt(ew,ns) + internal_melt_rate ! m/s + ! reset waterfrac to max value + waterfrac(up,ew,ns) = max_waterfrac + endif + enddo + + else ! whichtemp = TEMP_PROGNOSTIC + + ! Add internal melting associated with T > Tpmp + + call glissade_pressure_melting_point_column(thck(ew,ns), stagsigma(:), pmptemp(:)) + + do up = 1, upn-1 + if (temp(up,ew,ns) > pmptemp(up)) then + ! compute excess energy available for melting + layer_thck = thck(ew,ns) * (sigma(up+1) - sigma(up)) ! m + melt_energy = rhoi * shci * (temp(up,ew,ns) - pmptemp(up)) * layer_thck ! J/m^2 + internal_melt_rate = melt_energy / (rhoi * lhci * dttem) ! m/s + ! transfer internal melting to the bed + bmlt(ew,ns) = bmlt(ew,ns) + internal_melt_rate ! m/s + ! reset T to Tpmp + temp(up,ew,ns) = pmptemp(up) + endif + enddo + + endif ! whichtemp + + ! Cap basal temp at pressure melting point, if necessary + + call glissade_pressure_melting_point(thck(ew,ns), pmptemp_bed) + temp(upn,ew,ns) = min (temp(upn,ew,ns), pmptemp_bed) + + ! If freeze-on was computed above (bmlt < 0) and Tbed = Tpmp but no basal water is present, then set T(upn) < Tpmp. + ! Note: In the matrix element subroutines, we solve for Tbed (instead of holding it at Tpmp) when Tbed < -0.001. + ! With an offset here of 0.01, we will solve for T_bed at the next timestep. + ! Note: I don't think energy conservation is violated here, because no energy is associated with + ! the infinitesimally thin layer at the bed. + + if (bmlt(ew,ns) < 0.d0 .and. bwat(ew,ns)==0.d0 .and. temp(upn,ew,ns) >= pmptemp_bed) then + temp(upn,ew,ns) = pmptemp_bed - 0.01d0 + endif + + endif ! thk > thklim_temp + + enddo + enddo + + end subroutine glissade_basal_melting + +!======================================================================= + + subroutine glissade_pressure_melting_point(depth, pmptemp) + + ! Compute the pressure melting point temperature at a given depth + + use glimmer_physcon, only : rhoi, grav, pmlt + + real(dp), intent(in) :: depth ! depth in column (model thickness units) + real(dp), intent(out) :: pmptemp ! pressure melting point temp (deg C) + + real(dp), parameter :: pmpfact = - rhoi * grav * pmlt + + pmptemp = pmpfact * depth + + end subroutine glissade_pressure_melting_point + +!======================================================================= + + subroutine glissade_pressure_melting_point_column(thck, stagsigma, pmptemp) + + ! Compute the pressure melting point temperature in a column + ! Note: pmptemp and stagsigma should have the same dimension + + use glimmer_physcon, only : rhoi, grav, pmlt + + real(dp), intent(in) :: thck ! ice thickness (m) + real(dp), dimension(:), intent(in) :: stagsigma ! staggered vertical sigma coordinate + ! (defined at layer midpoints) + real(dp), dimension(:), intent(out) :: pmptemp ! pressure melting point temperature (deg C) + + real(dp), parameter :: pmpfact = - rhoi * grav * pmlt + + pmptemp(:) = pmpfact * thck * stagsigma(:) + + end subroutine glissade_pressure_melting_point_column + +!======================================================================= + + subroutine glissade_enth2temp (stagsigma, & + thck, enthalpy, & + temp, waterfrac) + + ! Convert from specific enthalpy to ice temperature and water content + + use glimmer_physcon, only : rhoi, shci, lhci, rhow + + ! I/O variables + real(dp), dimension(:), intent(in) :: stagsigma ! (1:upn-1) + real(dp), intent(in) :: thck + real(dp), dimension(0:size(stagsigma)+1), intent(inout) :: enthalpy ! (0:upn) + real(dp), dimension(0:size(stagsigma)+1), intent(out) :: temp ! (0:upn) + real(dp), dimension(size(stagsigma)), intent(out) :: waterfrac ! (1:upn-1) + + ! local variables + real(dp), dimension(size(stagsigma)) :: pmptemp ! (1:upn-1) + real(dp) :: pmptemp_bed + real(dp), dimension(0:size(stagsigma)+1) :: pmpenthalpy ! (0:upn) + integer :: up, upn + + upn = size(stagsigma) + 1 + + ! find pmpenthalpy(0:upn) + call glissade_pressure_melting_point_column(thck, stagsigma(1:upn-1), pmptemp(1:upn-1)) + call glissade_pressure_melting_point(thck, pmptemp_bed) + pmpenthalpy(0) = 0.d0 + pmpenthalpy(1:upn-1) = pmptemp(1:upn-1) * rhoi*shci + pmpenthalpy(upn) = pmptemp_bed * rhoi*shci + + ! solve for temp and waterfrac + if (enthalpy(0) >= pmpenthalpy(0)) then ! temperate ice + temp(0) = 0.d0 ! temperate ice + ! Reset enthalpy to be consistent with the surface temperature. + ! This is consistent with energy conservation because the top surface + ! is infinitesimally thin. + enthalpy(0) = pmpenthalpy(0) + else + temp(0) = enthalpy(0) / (rhoi*shci) ! cold ice + endif + + do up = 1, upn-1 + if (enthalpy(up) >= pmpenthalpy(up)) then ! temperate ice + temp(up) = pmptemp(up) + waterfrac(up) = (enthalpy(up)-pmpenthalpy(up)) / & + ((rhow-rhoi) * shci * pmptemp(up) + rhow * lhci) + else ! cold ice + temp(up) = enthalpy(up) / (rhoi*shci) + waterfrac(up) = 0.0d0 + endif + end do + + if (enthalpy(upn) >= pmpenthalpy(upn)) then ! temperate ice + temp(upn) = pmptemp_bed + ! Reset enthalpy to be consistent with the bed temperature. + ! This is consistent with energy conservation because the basal surface + ! is infinitesimally thin. + enthalpy(upn) = pmpenthalpy(upn) + else + temp(upn) = enthalpy(upn) / (rhoi*shci) ! cold ice + endif + + end subroutine glissade_enth2temp + +!======================================================================= + + subroutine glissade_temp2enth (stagsigma, & + temp, waterfrac, & + thck, enthalpy) + + ! Convert from temperature and water fraction to specific enthalpy + + use glimmer_physcon, only : rhoi, shci, lhci, rhow + + ! I/O variables + real(dp), dimension(:), intent(in) :: stagsigma ! (1:upn-1) + real(dp), dimension(0:size(stagsigma)+1), intent(in) :: temp ! (0:upn) + real(dp), dimension(1:size(stagsigma)), intent(in) :: waterfrac ! (1:upn-1) + real(dp), intent(in) :: thck + real(dp), dimension(0:size(stagsigma)+1), intent(out) :: enthalpy ! (0:upn) + + ! local variables + real(dp), dimension(size(stagsigma)) :: pmptemp !(1:upn-1) + integer :: up, upn + + upn = size(stagsigma) + 1 + + ! find pmptemp in column + call glissade_pressure_melting_point_column (thck, stagsigma(1:upn-1), pmptemp(1:upn-1)) + + ! solve for enthalpy + ! assume waterfrac = 0 at upper and lower ice surfaces + enthalpy(0) = temp(0) * rhoi * shci + do up = 1, upn-1 + enthalpy(up) = ((1.d0 - waterfrac(up)) * rhoi * shci * temp(up)) & + + waterfrac(up) * rhow * ((shci * pmptemp(up)) + lhci) + end do + enthalpy(upn) = temp(upn) * rhoi * shci + + end subroutine glissade_temp2enth + +! The remaining subroutines are called from glissade.F90 +!======================================================================= + + subroutine glissade_interior_dissipation_sia(ewn, nsn, & + upn, stagsigma, & + ice_mask, & + stagthck, flwa, & + dusrfdew, dusrfdns, & + dissip) + + ! Compute the dissipation source term associated with strain heating, + ! based on the shallow-ice approximation. + + use glimmer_physcon, only : gn ! Glen's n + + integer, intent(in) :: ewn, nsn, upn ! grid dimensions + + real(dp), dimension(upn-1), intent(in) :: stagsigma ! staggered vertical grid for temperature + + real(dp), dimension(:,:), intent(in) :: stagthck, dusrfdew, dusrfdns + + integer, dimension(:,:), intent(in) :: ice_mask ! = 1 where ice is present (thck > thklim), else = 0 + + real(dp), dimension(:,:,:), intent(in) :: & + flwa ! flow factor, Pa^(-n) yr^(-1) + + real(dp), dimension(:,:,:), intent(out) :: & + dissip ! interior heat dissipation (deg/s) + + integer, parameter :: p1 = gn + 1 + + integer :: ew, ns + real(dp), dimension(upn-1) :: sia_dissip_fact ! factor in SIA dissipation calculation + real(dp) :: geom_fact ! geometric factor + + ! Two methods of doing this calculation: + ! 1. find dissipation at u-pts and then average + ! 2. find dissipation at H-pts by averaging quantities from u-pts + ! (2) works best for eismint divide (symmetry) but (1) may be better for full expts + ! This subroutine uses (2). + + if (size(dissip,1) /= upn-1) then ! staggered vertical grid + call write_log('Error, glissade SIA dissipation: dissip has the wrong vertical dimension', GM_FATAL) + endif + + dissip(:,:,:) = 0.0d0 + + ! Note: Factor of 16 is for averaging flwa + sia_dissip_fact(1:upn-1) = (stagsigma(1:upn-1) * rhoi * grav)**p1 * 2.0d0 / (16.0d0 * rhoi * shci) + + do ns = 2, nsn-1 + do ew = 2, ewn-1 + !Note: ice_mask = 1 where thck > thcklim. Elsewhere, dissipation is assumed to be zero. + if (ice_mask(ew,ns) == 1) then + geom_fact = (0.25d0*sum(stagthck(ew-1:ew,ns-1:ns)) * sqrt((0.25d0*sum(dusrfdew(ew-1:ew,ns-1:ns)))**2 & + + (0.25d0*sum(dusrfdns(ew-1:ew,ns-1:ns)))**2))**p1 + dissip(:,ew,ns) = geom_fact * sia_dissip_fact * & + (flwa(:,ew-1,ns-1) + flwa(:,ew-1,ns+1) + flwa(:,ew+1,ns+1) + flwa(:,ew+1,ns-1) + & + 2.d0*(flwa(:,ew-1,ns)+flwa(:,ew+1,ns)+flwa(:,ew,ns-1)+flwa(:,ew,ns+1)) + & + 4.d0*flwa(:,ew,ns)) + end if + end do + end do + + end subroutine glissade_interior_dissipation_sia + +!======================================================================= + + subroutine glissade_interior_dissipation_first_order(ewn, nsn, & + upn, & + ice_mask, & + tau_eff, efvs, & + dissip) + + ! Compute the dissipation source term associated with strain heating. + ! Note that the dissipation is computed in the same way on either a staggered or an + ! unstaggered vertical grid. + ! Note also that dissip and flwa must have the same vertical dimension + ! (1:upn on an unstaggered vertical grid, or 1:upn-1 on a staggered vertical grid). + + integer, intent(in) :: ewn, nsn, upn ! grid dimensions + integer, dimension(:,:), intent(in) :: ice_mask ! = 1 where ice is present (thck > thklim), else = 0 + + real(dp), dimension(:,:,:), intent(in) :: & + tau_eff, & ! effective stress, Pa + efvs ! effective viscosity, Pa s + + real(dp), dimension(:,:,:), intent(out) :: & + dissip ! interior heat dissipation (deg/s) + + integer :: ew, ns, k + real(dp) :: ho_dissip_fact ! factor in higher-order dissipation calculation + + ! 3D, 1st-order case + ! Note: Glissade computes efvs and tau%scalar using the strain rate terms appropriate for the approximation. + ! E.g, the SIA quantities are computed based on (du_dz, dv_dz) only, and the SSA quantities + ! are computed based on (du_dx, du_dy, dv_dx, dv_dy) only. + ! So this computation should give the appropriate heating for whichapprox = HO_APPROX_SIA, + ! HO_APPROX_SSA, HO_APPROX_L1L2 or HO_APPROX_BP. + ! + if (size(dissip,1) /= upn-1) then ! staggered vertical grid + call write_log('Error, glissade 1st order dissipation: dissip has the wrong vertical dimension',GM_FATAL) + endif + + dissip(:,:,:) = 0.0d0 + ho_dissip_fact = 1.d0 / (rhoi*shci) + + do ns = 1, nsn + do ew = 1, ewn + !Note: ice_mask = 1 where thck > thcklim. Elsewhere, dissipation is assumed to be zero. + if (ice_mask(ew,ns) == 1) then + do k = 1, upn-1 + if (efvs(k,ew,ns) /= 0.d0) then + dissip(k,ew,ns) = (tau_eff(k,ew,ns)**2 / efvs(k,ew,ns)) * ho_dissip_fact + endif + enddo + endif + enddo + enddo + + end subroutine glissade_interior_dissipation_first_order + +!======================================================================= + + subroutine glissade_flow_factor(whichflwa, whichtemp, & + stagsigma, & + thck, ice_mask, & + temp, flwa, & + default_flwa_arg, & + flow_enhancement_factor, waterfrac) + + ! Calculate Glen's $A$ over the 3D domain, using one of three possible methods. + ! + ! The primary method is to use this equation from \emph{Paterson and Budd} [1982]: + ! \[ + ! A(T^{*})=a \exp \left(\frac{-Q}{RT^{*}}\right) + ! \] + ! This is equation 9 in {\em Payne and Dongelmans}. $a$ is a constant of proportionality, + ! $Q$ is the activation energy for for ice creep, and $R$ is the universal gas constant. + ! The pressure-corrected temperature, $T^{*}$ is given by: + ! \[ + ! T^{*} = T - T_{\mathrm{pmp}} + T_0 + ! \] + ! \[ + ! T_{\mathrm{pmp}} = T_0- \sigma \rho g H \Phi + ! \] + ! $T$ is the ice temperature, $T_{\mathrm{pmp}}$ is the pressure melting point + ! temperature, $T_0$ is the triple point of water, $\rho$ is the ice density, and + ! $\Phi$ is the (constant) rate of change of melting point temperature with pressure. + + use glimmer_physcon, only: scyr, arrmlh, arrmll, actenh, actenl, gascon, trpt + + !------------------------------------------------------------------------------------ + ! Subroutine arguments + !------------------------------------------------------------------------------------ + +! Note: The flwa, temp, and stagsigma arrays should have vertical dimension 1:upn-1. +! The temperatures at the upper surface (k=1) and bed (k=upn) are not included in the input array. + + integer, intent(in) :: whichflwa !> which method of calculating A + integer, intent(in) :: whichtemp !> which method of calculating temperature; + !> include waterfrac in calculation if using enthalpy method + real(dp),dimension(:), intent(in) :: stagsigma !> vertical coordinate at layer midpoints + real(dp),dimension(:,:), intent(in) :: thck !> ice thickness (m) + integer, dimension(:,:), intent(in) :: ice_mask !> = 1 where ice is present (thck > thklim), else = 0 + real(dp),dimension(:,:,:), intent(in) :: temp !> 3D temperature field (deg C) + real(dp),dimension(:,:,:), intent(out) :: flwa !> output $A$, in units of Pa^{-n} s^{-1} + real(dp), intent(in) :: default_flwa_arg !> Glen's A to use in isothermal case + !> Units: Pa^{-n} s^{-1} + real(dp), intent(in), optional :: flow_enhancement_factor !> flow enhancement factor in Arrhenius relationship + real(dp),dimension(:,:,:), intent(in), optional :: waterfrac !> internal water content fraction, 0 to 1 + + !> \begin{description} + !> \item[0] Set to prescribed constant value. + !> \item[1] {\em Paterson and Budd} relationship, with temperature set to -5$^{\circ}$C. + !> \item[2] {\em Paterson and Budd} relationship. + !> \end{description} + + !------------------------------------------------------------------------------------ + ! Internal variables + !------------------------------------------------------------------------------------ + + real(dp) :: default_flwa ! Glen's A for isothermal case, in units of Pa{-n} s^{-1} + integer :: ew, ns, up, ewn, nsn, nlayers + real(dp), dimension(size(stagsigma)) :: pmptemp ! pressure melting point temperature + real(dp) :: enhancement_factor ! flow enhancement factor in Arrhenius relationship + real(dp) :: tempcor ! temperature relative to pressure melting point + + real(dp),dimension(4), parameter :: & + arrfact = (/ arrmlh, & ! Value of a when T* is above -263K, Pa^{-n} s^{-1} + arrmll, & ! Value of a when T* is below -263K, Pa^{-n} s^{-1} + -actenh / gascon, & ! Value of -Q/R when T* is above -263K + -actenl / gascon/) ! Value of -Q/R when T* is below -263K + + real(dp), parameter :: const_temp = -5.0d0 ! deg C + real(dp), parameter :: flwa_waterfrac_enhance_factor = 181.25d0 + + !------------------------------------------------------------------------------------ + + nlayers = size(flwa,1) ! upn - 1 + ewn = size(flwa,2) + nsn = size(flwa,3) + + if (present(flow_enhancement_factor)) then + enhancement_factor = flow_enhancement_factor + else + enhancement_factor = 1.d0 + endif + + ! Check that the temperature array has the desired vertical dimension + + if (size(temp,1) /= size(flwa,1)) then + call write_log('glissade_flow_factor: temp and flwa must have the same vertical dimensions', GM_FATAL) + endif + + ! Multiply the default rate factor by the enhancement factor if applicable + ! Note: Here, default_flwa is assumed to have units of Pa^{-n} s^{-1}, + ! whereas model%paramets%default_flwa has units of Pa^{-n} yr^{-1}. + + default_flwa = enhancement_factor * default_flwa_arg + + ! initialize + flwa(:,:,:) = default_flwa + + select case(whichflwa) + + case(FLWA_PATERSON_BUDD) + + ! This is the Paterson and Budd relationship + + do ns = 1,nsn + do ew = 1,ewn + if (ice_mask(ew,ns) == 1) then + + call glissade_pressure_melting_point_column (thck(ew,ns), stagsigma, pmptemp) + + do up = 1, nlayers ! nlayers = upn - 1 + + ! Calculate the corrected temperature + tempcor = min(0.0d0, temp(up,ew,ns) - pmptemp(up)) ! pmptemp < 0 + tempcor = max(-50.0d0, tempcor) + + ! Calculate Glen's A (including flow enhancement factor) + + if (tempcor >= -10.d0) then + flwa(up,ew,ns) = enhancement_factor * arrfact(1) * exp(arrfact(3)/(tempcor + trpt)) + else + flwa(up,ew,ns) = enhancement_factor * arrfact(2) * exp(arrfact(4)/(tempcor + trpt)) + endif + + ! BDM added correction for a liquid water fraction + ! Using Greve and Blatter (2009) formulation for Glen's A flow rate factor: + ! A = A(theta_PMP) * (1 + 181.25 * waterfrac) + if (whichtemp == TEMP_ENTHALPY .and. present(waterfrac)) then + if (waterfrac(up,ew,ns) > 0.0d0) then + flwa(up,ew,ns) = flwa(up,ew,ns) * (1.d0 + flwa_waterfrac_enhance_factor * waterfrac(up,ew,ns)) + endif + endif + + enddo ! up + end if ! ice_mask + end do ! ew + end do ! ns + + case(FLWA_PATERSON_BUDD_CONST_TEMP) + + ! This is the Paterson and Budd relationship, but with the temperature held constant at -5 deg C + !WHL - If we are assuming a constant temperature of -5 deg C, then I think we should always use + ! the Arrhenius factors appropriate for a warm temperature (T > -10). + ! I changed the code accordingly by commenting out some lines below. + + do ns = 1,nsn + do ew = 1,ewn + if (ice_mask(ew,ns) == 1) then + + ! Calculate Glen's A with a fixed temperature (including flow enhancement factor) + +!! if (const_temp >= -10.d0) then + flwa(:,ew,ns) = enhancement_factor * arrfact(1) * exp(arrfact(3)/(const_temp + trpt)) +!! else +!! flwa(:,ew,ns) = enhancement_factor * arrfact(2) * exp(arrfact(4)/(const_temp + trpt)) +!! endif + + end if + end do + end do + + case(FLWA_CONST_FLWA) + + ! do nothing (flwa is initialized to default_flwa above) + + end select + + end subroutine glissade_flow_factor + +!======================================================================= + +end module glissade_therm + +!======================================================================= diff --git a/components/cism/glimmer-cism/libglissade/glissade_transport.F90 b/components/cism/glimmer-cism/libglissade/glissade_transport.F90 new file mode 100644 index 0000000000..28fe3d8c29 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_transport.F90 @@ -0,0 +1,1365 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_transport.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains drivers for incremental remapping and upwind ice transport. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This version was created from ice_transport_driver in CICE, revision 313, 6 Jan. 2011. +! The repository is here: http://oceans11.lanl.gov/svn/CICE + + module glissade_transport + + use glimmer_global, only: dp + use glimmer_log + use glissade_remap, only: glissade_horizontal_remap, make_remap_mask, puny + use parallel + + implicit none + save + private + public :: glissade_transport_driver, glissade_check_cfl, ntracer + + logical, parameter :: & + prescribed_area = .false. ! if true, prescribe the area fluxed across each edge + + integer :: & + ntracer = 1 ! number of tracers to transport (just temperature if ntracer = 1) + ! can be set to a different value in glissade.F90 + +!======================================================================= + + contains + +!======================================================================= +! + subroutine glissade_transport_driver(dt, & + dx, dy, & + nx, ny, & + nlyr, sigma, & + ntracer, & + uvel, vvel, & + thck, & + acab, bmlt, & + temp, age, & + upwind_transport_in) + + + ! This subroutine solves the transport equations for one timestep + ! using the conservative remapping scheme developed by John Dukowicz + ! and John Baumgardner and modified for sea ice by William + ! Lipscomb and Elizabeth Hunke. + ! + ! This scheme preserves monotonicity of ice area and tracers. That is, + ! it does not produce new extrema. It is second-order accurate in space, + ! except where gradients are limited to preserve monotonicity. + ! + ! Optionally, the remapping scheme can be replaced with a simple + ! first-order upwind scheme. + ! + ! author William H. Lipscomb, LANL + ! + ! input/output arguments + + real(dp), intent(in) :: & + dt, &! time step (s) + dx, dy ! gridcell dimensions (m) + ! (cells assumed to be rectangular) + + integer, intent(in) :: & + nx, ny, &! horizontal array size + nlyr, &! number of vertical layers + ntracer ! number of tracers + + real(dp), intent(in), dimension(nlyr+1) :: & + sigma ! layer interfaces in sigma coordinates + ! top sfc = 0, bottom sfc = 1 + + real(dp), intent(in), dimension(nlyr+1,nx-1,ny-1) :: & + uvel, vvel ! horizontal velocity components (m/s) + ! (defined at horiz cell corners, vertical interfaces) + + real(dp), intent(inout), dimension(nx,ny) :: & + thck ! ice thickness (m), defined at horiz cell centers + + real(dp), intent(in), dimension(nx,ny) :: & + acab, & ! surface mass balance (m/s) + ! (defined at horiz cell centers) + bmlt ! basal melt rate (m/s) + ! positive for melting, negative for freeze-on + ! (defined at horiz cell centers) + + !NOTE: For the enthalpy scheme, the variable called temp is really the enthalpy. + ! Note vertical dimension; includes surface and bed. + ! (Surface and bed values are not transported.) + real(dp), intent(inout), dimension(0:nlyr+1,nx,ny), optional :: & + temp ! ice temperature (or enthalpy) + ! (defined at horiz cell centers, vertical layer midpts) + + + !TODO - Compute the ice age tracer; currently ice age = 0 + real(dp), intent(inout), dimension(nlyr,nx,ny), optional :: & + age ! ice age + + logical, intent(in), optional :: & + upwind_transport_in ! if true, do first-order upwind transport + + ! local variables + + integer :: & + i, j, k ,&! cell indices + ilo,ihi,jlo,jhi ,&! beginning and end of physical domain + nt ! tracer index + + real(dp), dimension (nx,ny) :: & + thck_mask ! = 1. if ice is present, = 0. otherwise + + real(dp), dimension (nx-1,ny-1) :: & + uvel_layer ,&! uvel averaged to layer midpoint (m/s) + vvel_layer ! vvel averaged to layer midpoint (m/s) + + real(dp), dimension (nx,ny,nlyr) :: & + thck_layer ! ice layer thickness (m) + + real(dp), dimension (nx,ny,ntracer,nlyr) :: & + tracer ! tracer values + + real(dp), dimension (nx,ny) :: & + tsfc, &! surface temperature, temp(0,:,:) + tbed ! basal temperature, temp(nlyr+1,:,:) + + integer :: & + icells ! number of cells with ice + + integer, dimension(nx*ny) :: & + indxi, indxj ! compressed i/j indices + + real(dp) :: & + sum_acab, &! total accumulation/ablation + sum_bmlt ! total basal melting + + !------------------------------------------------------------------- + ! If prescribed_area is true, the area of each departure region is + ! computed in advance (e.g., by taking the divergence of the + ! velocity field and passed to locate_triangles. The departure + ! regions are adjusted to obtain the desired area. + ! If false, edgearea is computed in locate_triangles and passed out. + !------------------------------------------------------------------- + + real(dp), dimension(nx,ny) :: & + edgearea_e ,&! area of departure regions for east edges + edgearea_n ! area of departure regions for north edges + + logical, parameter :: & + conservation_check = .true. ! if true, check global conservation + + real(dp) :: & + msum_init, &! initial global ice mass + msum_final ! final global ice mass + + real(dp), dimension(ntracer) :: & + mtsum_init, &! initial global ice mass*tracer + mtsum_final ! final global ice mass*tracer + + real(dp) :: & + melt_potential ! total thickness (m) of additional ice that could be melted + ! by available acab/bmlt in columns that are completely melted + + logical :: & + errflag ! true if energy is not conserved + + character(len=100) :: message + + real(dp), dimension (:,:,:), allocatable :: & + worku ! work array + + real(dp), dimension(nx,ny) :: & + uee, vnn ! cell edge velocities for upwind transport + + logical :: & + upwind_transport ! if true, do first-order upwind transport + + !------------------------------------------------------------------- + ! Initialize + !------------------------------------------------------------------- + + if (present(upwind_transport_in)) then + upwind_transport = upwind_transport_in + else + upwind_transport = .false. + endif + + errflag = .false. + melt_potential = 0.d0 + + !Note: (ilo,ihi) and (jlo,jhi) are the lower and upper bounds of the local domain + ! (i.e., grid cells owned by this processor). + + ilo = nhalo + 1 + ihi = nx - nhalo + jlo = nhalo + 1 + jhi = ny - nhalo + + !------------------------------------------------------------------- + ! NOTE: Mass and tracer arrays (thck, temp, etc.) must be updated in + ! halo cells before this subroutine is called. + !------------------------------------------------------------------- + + !------------------------------------------------------------------- + ! Fill thickness and tracer arrays. + ! Assume that temperature (if present) is tracer 1, and age (if present) + ! is tracer 2. Add more tracers as needed. + ! If no tracers are present, then only the ice thickness is transported. + ! In this case we define a dummy tracer array, since glissade_horizontal_remap + ! requires that a tracer array be passed in. + !------------------------------------------------------------------- + + do k = 1, nlyr + + thck_layer(:,:,k) = thck(:,:) * (sigma(k+1) - sigma(k)) + + if (present(temp)) then + tracer(:,:,1,k) = temp(k,:,:) + else + tracer(:,:,1,k) = 0.d0 ! dummy array + endif + + if (present(age) .and. ntracer >= 2) then + tracer(:,:,2,k) = age(k,:,:) + endif + + ! Other tracer fields could be added here + + enddo + + !------------------------------------------------------------------- + ! Set surface and basal temperatures. + ! Note: If the enthalpy is passed in, then tsfc and tbed are enthalpy values. + !------------------------------------------------------------------- + + if (present(temp)) then + tsfc(:,:) = temp(0,:,:) + tbed(:,:) = temp(nlyr+1,:,:) + else + tsfc(:,:) = 0.d0 + tbed(:,:) = 0.d0 + endif + + !------------------------------------------------------------------- + ! Compute initial values of globally conserved quantities (optional) + !------------------------------------------------------------------- + + if (conservation_check) then + + call sum_mass_and_tracers(nx, ny, & + nlyr, ntracer, & + nhalo, & + thck_layer(:,:,:), msum_init, & + tracer(:,:,:,:), mtsum_init(:)) + endif + + if (upwind_transport) then + + allocate (worku(nx,ny,0:ntracer)) + + do k = 1, nlyr + + ! Average corner velocities at layer interfaces to + ! edge velocities at layer midpoints. + + do j = jlo, jhi + do i = ilo-1, ihi ! include west edge of local domain + uee(i,j) = 0.25d0 * (uvel(k, i,j) + uvel(k, i,j-1) & + + uvel(k+1,i,j) + uvel(k+1,i,j-1)) + enddo + enddo + + + do j = jlo-1, jhi ! include south edge of local domain + do i = ilo, ihi + vnn(i,j) = 0.25d0 * (vvel(k, i,j) + vvel(k, i-1,j) & + + vvel(k+1,i,j) + vvel(k+1,i-1,j)) + enddo + enddo + + ! Fill work array for transport + + worku(:,:,0) = thck_layer(:,:,k) + do nt = 1, ntracer + worku(:,:,nt) = thck_layer(:,:,k) * tracer(:,:,nt,k) + enddo + + !----------------------------------------------------------------- + ! Upwind transport + !----------------------------------------------------------------- + + do nt = 0, ntracer + call upwind_field (nx, ny, & + ilo, ihi, jlo, jhi, & + dx, dy, & + dt, worku(:,:,nt), & + uee(:,:), vnn (:,:)) + enddo ! ntracer + + ! Recompute thickness and tracers + + thck_layer(:,:,k) = worku(:,:,0) + do nt = 1, ntracer + do j = jlo, jhi + do i = ilo, ihi + if (thck_layer(i,j,k) > puny) then + tracer(i,j,nt,k) = worku(i,j,nt) / thck_layer(i,j,k) + else + tracer(i,j,nt,k) = 0.d0 + endif + enddo ! i + enddo ! j + enddo ! ntracer + + enddo ! nlyr + + deallocate (worku) + + else ! remapping transport + + !------------------------------------------------------------------- + ! Define a mask: = 1 where ice is present (thck > 0), = 0 otherwise + ! The mask is used to prevent tracer values in cells without ice from + ! being used to compute tracer gradients. + !------------------------------------------------------------------- + + call make_remap_mask (nx, ny, & + ilo, ihi, jlo, jhi, & + nhalo, icells, & + indxi(:), indxj(:), & + thck(:,:), thck_mask(:,:)) + + !------------------------------------------------------------------- + ! Remap ice thickness and tracers; loop over layers + !------------------------------------------------------------------- + + do k = 1, nlyr + + ! Average velocities to the midpoint of the layer + + uvel_layer(:,:) = 0.5d0 * (uvel(k,:,:) + uvel(k+1,:,:)) + vvel_layer(:,:) = 0.5d0 * (vvel(k,:,:) + vvel(k+1,:,:)) + + edgearea_e(:,:) = 0.d0 + edgearea_n(:,:) = 0.d0 + + ! If prescribed_area is true, compute edgearea by taking the divergence + ! of the velocity field. + + if (prescribed_area) then + + do j = jlo, jhi + do i = ilo-1, ihi + edgearea_e(i,j) = (uvel_layer(i,j) + uvel_layer(i,j-1)) & + * 0.5d0 * dy * dt + enddo + enddo + + do j = jlo-1, jhi + do i = ilo, ihi + edgearea_n(i,j) = (vvel_layer(i,j) + vvel_layer(i-1,j)) & + * 0.5d0 * dx * dt + enddo + enddo + + endif + + !------------------------------------------------------------------- + ! Main remapping routine: Step ice thickness and tracers forward in time. + !------------------------------------------------------------------- + + call glissade_horizontal_remap (dt, & + dx, dy, & + nx, ny, & + ntracer, nhalo, & + thck_mask(:,:), icells, & + indxi(:), indxj(:), & + uvel_layer(:,:), vvel_layer(:,:), & + thck_layer(:,:,k), tracer(:,:,:,k), & + edgearea_e(:,:), edgearea_n(:,:)) + + enddo ! nlyr + + endif ! remapping v. upwind transport + + !------------------------------------------------------------------- + ! Check that mass and mass*tracers are exactly conserved by transport. + ! Note: Conservation errors will occur if the global domain is open + ! and ice has left the domain. So depending on the application, + ! there may or may not be a problem when ice is not conserved. + !------------------------------------------------------------------- + + if (conservation_check) then + + ! Compute new values of globally conserved quantities. + ! Assume gridcells of equal area, ice of uniform density. + + call sum_mass_and_tracers(nx, ny, & + nlyr, ntracer, & + nhalo, & + thck_layer(:,:,:), msum_final, & + tracer(:,:,:,:), mtsum_final(:)) + + ! Check conservation + + if (main_task) then + call global_conservation (msum_init, msum_final, & + errflag, melt_potential, & + ntracer, & + mtsum_init, mtsum_final) + if (errflag) then + write(message,*) 'WARNING: Conservation error in glissade_horizontal_remap' +! call write_log(message,GM_FATAL) ! uncomment if conservation errors should never happen + call write_log(message,GM_DIAGNOSTIC) ! uncomment for debugging + write(message,*) 'May be OK if global domain is open' + call write_log(message,GM_DIAGNOSTIC) ! uncomment for debugging + endif + + endif ! main_task + + endif ! conservation_check + + !------------------------------------------------------------------- + ! Add the mass balance at the surface and bed. + ! The reason to do this now rather than at the beginning of the + ! subroutine is that the velocity was computed for the old geometry, + ! before the addition or loss of new mass at the surface and bed. + ! TODO: Rethink this ordering if we move to implicit or semi-implicit + ! timestepping, where the velocity depends on the new geometry. + ! + ! We assume here that new ice arrives at the surface with the same + ! temperature as the surface. + ! TODO: Make sure this assumption is consistent with energy + ! conservation for coupled simulations. + ! TODO: Pass the melt potential back to the climate model as a heat flux? + !------------------------------------------------------------------- + + call glissade_add_smb(nx, ny, & + nlyr, ntracer, & + nhalo, dt, & + thck_layer(:,:,:), & + tracer(:,:,:,:), & + acab(:,:), & + tsfc(:,:), & + bmlt(:,:), & + tbed(:,:), & + melt_potential ) + + !------------------------------------------------------------------- + ! Next conservation check: Check that mass is conserved, allowing + ! for mass gain/loss due to acab/bmlt and for any unused melt potential. + ! + ! NOTE: There is no tracer conservation check here, because there is no + ! easy way to correct initial mass*tracer values for acab and bmlt. + ! + !------------------------------------------------------------------- + + if (conservation_check) then + + ! Correct initial global mass for acab and bmlt + + sum_acab = sum(acab(1+lhalo:nx-uhalo,1+lhalo:ny-uhalo)) + sum_bmlt = sum(bmlt(1+lhalo:nx-uhalo,1+lhalo:ny-uhalo)) + call global_sum(sum_acab) + call global_sum(sum_bmlt) + + msum_init = msum_init + (sum_acab - sum_bmlt)*dt + + ! Compute new global mass and mass*tracer + + call sum_mass_and_tracers(nx, ny, & + nlyr, ntracer, & + nhalo, & + thck_layer(:,:,:), msum_final, & + tracer(:,:,:,:), mtsum_final(:)) + + ! Check mass conservation + + if (main_task) then + call global_conservation (msum_init, msum_final, & + errflag, melt_potential) + + if (errflag) then + write(message,*) 'WARNING: Conservation error in glissade_add_smb' +! call write_log(message,GM_FATAL) ! uncomment if conservation errors should never happen + call write_log(message,GM_DIAGNOSTIC) ! uncomment for debugging + endif + + endif ! main_task + + endif ! conservation_check + + !------------------------------------------------------------------- + ! Interpolate tracers back to sigma coordinates + !------------------------------------------------------------------- + + call glissade_vertical_remap(nx, ny, & + nlyr, ntracer, & + sigma(:), & + thck_layer(:,:,:), & + tracer(:,:,:,:) ) + + !------------------------------------------------------------------- + ! Final conservation check: Check that mass and mass*tracers are exactly + ! conserved by vertical remapping.. + !------------------------------------------------------------------- + + if (conservation_check) then + + ! Compute new values of globally conserved quantities. + ! Assume gridcells of equal area, ice of uniform density. + + msum_init = msum_final ! msum_final computed above after glissade_add_smb + mtsum_init(:) = mtsum_final(:) ! mtsum_final computed above after glissade_add_smb + + call sum_mass_and_tracers(nx, ny, & + nlyr, ntracer, & + nhalo, & + thck_layer(:,:,:), msum_final, & + tracer(:,:,:,:), mtsum_final(:)) + + ! Check conservation + + if (main_task) then + call global_conservation (msum_init, msum_final, & + errflag, 0.d0, & ! ignore melt potential for this check + ntracer, & + mtsum_init, mtsum_final) + if (errflag) then + write(message,*) 'WARNING: Conservation error in glissade_vertical_remap' +! call write_log(message,GM_FATAL) ! uncomment if conservation errors should never happen + call write_log(message,GM_DIAGNOSTIC) ! uncomment for debugging + endif + + endif ! main_task + + endif ! conservation_check + + !------------------------------------------------------------------- + ! Halo updates for thickness and tracer arrays + ! + ! Note: Cannot pass the full 3D array to parallel_halo, because that + ! subroutine assumes that k is the first rather than third index. + !------------------------------------------------------------------- + + do k = 1, nlyr + + call parallel_halo(thck_layer(:,:,k)) + + do nt = 1, ntracer + call parallel_halo(tracer(:,:,nt,k)) + enddo + + enddo + + !------------------------------------------------------------------- + ! Recompute thickness, temperature and other tracers. + !------------------------------------------------------------------- + + thck(:,:) = 0.d0 + + do k = 1, nlyr + + thck(:,:) = thck(:,:) + thck_layer(:,:,k) + + if (present(temp)) temp(k,:,:) = tracer(:,:,1,k) + if (present(age) .and. ntracer >= 2) age(k,:,:) = tracer(:,:,2,k) + + ! Could add more tracer fields here + + enddo + + end subroutine glissade_transport_driver + +!======================================================================= + + subroutine glissade_check_cfl(ewn, nsn, nlyr, & + dew, dns, sigma, & + stagthk, dusrfdew, dusrfdns, & + uvel, vvel, deltat, & + allowable_dt_adv, allowable_dt_diff) + + ! Calculate maximum allowable time step based on both + ! advective and diffusive CFL limits. + ! + ! author Matt Hoffman, LANL, March 2014 + ! + ! input/output arguments + + integer, intent(in) :: & + ewn, nsn ! number of cells in the x, y dimensions + + integer, intent(in) :: & + nlyr ! number of vertical layers (layer centers) + + real(dp), intent(in) :: & + dew, dns ! grid spacing in x, y (not assumed to be equal here), dimensional m + + real(dp), dimension(:), intent(in) :: & + sigma ! vertical coordinate spacing + + real(dp), dimension(:,:), intent(in) :: & + stagthk ! thickness on the staggered grid, dimensional m + + real(dp), dimension(:,:), intent(in) :: & + dusrfdew, dusrfdns ! slope in x,y directions on the staggered grid, dimensionless m/m + + real(dp), dimension(:,:,:), intent(in) :: & + uvel, vvel ! 3-d x,y velocity components on the staggered grid, dimensional m/yr + + real(dp), intent(in) :: & + deltat ! model deltat (yrs) + + real(dp), intent(out) :: & + allowable_dt_adv ! maximum allowable dt (yrs) based on advective CFL + + real(dp), intent(out) :: & + allowable_dt_diff ! maximum allowable dt (yrs) based on diffusive CFL + + ! Local variables + integer :: k + integer :: xs, xe, ys, ye ! start and end indices for locally owned cells on the staggered grid in the x and y directions + real(dp), dimension(nlyr, ewn-1, nsn-1) :: uvel_layer, vvel_layer ! velocities at layer midpoints, stag. grid + real(dp), dimension(nlyr, ewn-1, nsn-1) :: flux_layer_ew, flux_layer_ns ! flux for each layer, stag. grid + real(dp), dimension(ewn-1, nsn-1) :: flux_ew, flux_ns ! flux for entire thickness, stag. grid + + real(dp) :: maxuvel, maxvvel, maxvel ! maximum velocity in either direction and in both + real(dp) :: allowable_dt_diff_here ! temporary calculation at each cell of allowable_dt_diff + integer :: i, j + real(dp) :: slopemag ! the magnitude of the surface slope + real(dp) :: slopedirx, slopediry ! the unit vector of the slope direction + real(dp) :: flux_downslope ! The component of the flux in the downslope direction + integer :: ierr ! flag for CFL violation + integer :: procnum ! processor on which minimum allowable time step occurs + integer, dimension(3) :: indices_adv ! z,x,y indices (stag. grid) of where the min. allow. time step occurs for the advective CFL + integer, dimension(2) :: indices_diff ! x and y indices (stag. grid) of where the min. allow. time step occurs for the diffusive CFL + character(len=12) :: dt_string, xpos_string, ypos_string + character(len=300) :: message + ierr = 0 + + ! Setup some mesh information - start and end indices for locally owned cells on the staggered grid in the x and y directions + xs = 1+staggered_lhalo + xe = ewn - 1 - staggered_uhalo + ys = 1+staggered_lhalo + ye = nsn - 1 - staggered_uhalo + + ! ------------------------------------------------------------------------ + ! Advective CFL + ! TODO use depth-averaged velocity or layer-by-layer (top layer only?), or something else (BB09)? + ! For now check all layers + + ! Calculate depth-averaged flux and velocity on the B-grid. + ! The IR code basically uses a B-grid, the FO-Upwind method uses a C-grid. + ! The B-grid calculation should be more conservative because that is where the + ! velocities are calculated so there will be no averaging. + ! (Also, IR is the primary advection method, so make this check most appropriate for that.) + + do k = 1, nlyr + ! Average velocities to the midpoint of the layer + uvel_layer(k,:,:) = 0.5d0 * (uvel(k,:,:) + uvel(k+1,:,:)) + vvel_layer(k,:,:) = 0.5d0 * (vvel(k,:,:) + vvel(k+1,:,:)) + ! calculate flux components for this layer + flux_layer_ew(k,:,:) = uvel_layer(k,:,:) * stagthk(:,:) * (sigma(k+1) - sigma(k)) + flux_layer_ns(k,:,:) = vvel_layer(k,:,:) * stagthk(:,:) * (sigma(k+1) - sigma(k)) + enddo + flux_ew(:,:) = sum(flux_layer_ew, 1) + flux_ns(:,:) = sum(flux_layer_ns, 1) + + ! Advective CFL calculation - using all layers. Check locally owned cells only! + maxuvel = maxval(abs(uvel_layer(:,xs:xe,ys:ye))) + maxvvel = maxval(abs(vvel_layer(:,xs:xe,ys:ye))) + ! Determine in which direction the max velocity is - Assuming dx=dy here! + if (maxuvel > maxvvel) then +! print *, 'max vel is in uvel' + maxvel = maxuvel + indices_adv = maxloc(abs(uvel_layer(:,xs:xe,ys:ye))) + else +! print *, 'max vel is in vvel' + maxvel = maxvvel + indices_adv = maxloc(abs(vvel_layer(:,xs:xe,ys:ye))) + endif + indices_adv(2:3) = indices_adv(2:3) + staggered_lhalo ! want the i,j coordinates WITH the halo present - we got indices into the slice of owned cells + ! Finally, determine maximum allowable time step based on advectice CFL condition. + allowable_dt_adv = dew / (maxvel + 1.0d-20) + + ! ------------------------------------------------------------------------ + ! Diffusive CFL + ! Estimate diffusivity using the relation that the 2-d flux Q=-D grad h and Q=UH, + ! where h is surface elevation, D is diffusivity, U is 2-d velocity vector, and H is thickness + ! Solving for D = UH/-grad h + + allowable_dt_diff = 1.0d20 ! start with a huge value + indices_diff(:) = 1 ! Initialize these to something, on the off-chance they never get set... (e.g., no ice on this processor) + ! Loop over locally-owned cells only! + do j = ys, ye + do i = xs, xe + if (stagthk(i,j) > 0.0d0) then ! don't bother doing all this for non-ice cells + ! Find downslope vector + slopemag = dsqrt(dusrfdew(i,j)**2 + dusrfdns(i,j)**2 + 1.0d-20) + slopedirx = dusrfdew(i,j) / slopemag + slopediry = dusrfdns(i,j) / slopemag + ! Estimate flux in the downslope direction (Flux /dot -slopedir) + flux_downslope = flux_ew(i,j) * (-1.0d0) * slopedirx + flux_ns(i,j) * (-1.0d0) * slopediry ! TODO check signs here - they seem ok + !!! Estimate diffusivity in the downslope direction only + !!diffu = flux_downslope / slopemag + !!allowable_dt_diff = 0.5d0 * dew**2 / (diffu + 1.0e-20) ! Note: assuming diffu is isotropic here. + ! DCFL: dt = 0.5 * dx**2 / D = 0.5 * dx**2 * slopemag / flux_downslope + allowable_dt_diff_here = 0.5d0 * dew**2 * slopemag / (flux_downslope + 1.0e-20) ! Note: assuming diffu is isotropic here. assuming dx=dy + if (allowable_dt_diff_here < 0.0d0) allowable_dt_diff_here = 1.0d20 ! ignore negative dt's (upgradient flow due to membrane stresses) + if (allowable_dt_diff_here < allowable_dt_diff) then + allowable_dt_diff = allowable_dt_diff_here + indices_diff(1) = i + indices_diff(2) = j + endif + endif + enddo + enddo + + ! Determine location limiting the DCFL +! print *, 'diffu dt', allowable_dt_diff, indices_diff(1), indices_diff(2) + + ! Optional print of local limiting dt on each procesor + !print *,'LOCAL ADV DT, POSITION', allowable_dt_adv, indices_adv(2), indices_adv(3) + !print *,'LOCAL DIFF DT, POSITION', allowable_dt_diff, indices_diff(1), indices_diff(2) + + ! ------------------------------------------------------------------------ + ! Now check for errors + + ! Perform global reduce for advective time step and determine where in the domain it occurs + call parallel_reduce_minloc(xin=allowable_dt_adv, xout=allowable_dt_adv, xprocout=procnum) + + if (deltat > allowable_dt_adv) then + ierr = 1 ! Advective CFL violation is a fatal error + + ! Get position of the limiting location - do this only if an error message is needed to avoid 2 MPI comms + call parallel_globalindex(indices_adv(2), indices_adv(3), indices_adv(2), indices_adv(3)) + ! Note: This subroutine assumes the scalar grid, but should work fine for the stag grid too + ! indices_adv now has i,j on the global grid for this proc's location + call broadcast(indices_adv(2), proc=procnum) + call broadcast(indices_adv(3), proc=procnum) + ! indices_adv now has i,j on the global grid for the limiting proc's location + + write(dt_string,'(f12.5)') allowable_dt_adv + write(xpos_string,'(i12)') indices_adv(2) + write(ypos_string,'(i12)') indices_adv(3) + write(message,*) 'Advective CFL violation! Maximum allowable time step for advective CFL condition is ' & + // trim(adjustl(dt_string)) // ' yr, limited by global position i=' // trim(adjustl(xpos_string)) // ' j=' //trim(adjustl(ypos_string)) + ! Write a warning first before throwing a fatal error so we can also check the diffusive CFL before aborting + call write_log(trim(message),GM_WARNING) + endif + + ! Perform global reduce for diffusive time step and determine where in the domain it occurs + call parallel_reduce_minloc(xin=allowable_dt_diff, xout=allowable_dt_diff, xprocout=procnum) + + if (deltat > allowable_dt_diff) then + ! Get position of the limiting location - do this only if an error message is needed to avoid 2 MPI comms + call parallel_globalindex(indices_diff(1), indices_diff(2), indices_diff(1), indices_diff(2)) + ! Note: this subroutine assumes the scalar grid, but should work fine for the stag grid too + ! indices_diff now has i,j on the global grid for this proc's location + call broadcast(indices_diff(1), proc=procnum) + call broadcast(indices_diff(2), proc=procnum) + ! indices_diff now has i,j on the global grid for the limiting proc's location + + write(dt_string,'(f12.5)') allowable_dt_diff + write(xpos_string,'(i12)') indices_diff(1) + write(ypos_string,'(i12)') indices_diff(2) + write(message,*) 'Diffusive CFL violation! Maximum allowable time step for diffusive CFL condition is ' & + // trim(adjustl(dt_string)) // ' yr, limited by global position i=' // trim(adjustl(xpos_string)) // ' j=' //trim(adjustl(ypos_string)) + ! Diffusive CFL violation is just a warning (because it may be overly restrictive as currently formulated) + call write_log(trim(message),GM_WARNING) + write(message,*) '(Note the currently implemented diffusive CFL calculation may be overly restrictive for higher-order dycores.)' + call write_log(trim(message)) + endif + + ! TODO enable this fatal error after more testing! + ! Now that we have checked both, throw a fatal error for an ACFL violation + !if (ierr == 1) then + ! call write_log('Advective CFL violation is a fatal error. See log for details.', GM_FATAL) + !endif + + end subroutine glissade_check_cfl + +!======================================================================= + + subroutine sum_mass_and_tracers(nx, ny, & + nlyr, ntracer, & + nhalo, & + thck_layer, msum, & + tracer, mtsum) + + ! Compute values of globally conserved quantities., + ! Assume gridcells of equal area (dx*dy), ice of uniform density. + + ! Input/output arguments + + integer, intent(in) :: & + nx, ny, &! horizontal array size + nlyr, &! number of vertical layers + ntracer, &! number of tracers + nhalo ! number of halo rows + + real(dp), dimension (nx,ny,nlyr), intent(in) :: & + thck_layer ! ice layer thickness + + real(dp), intent(out) :: & + msum ! total mass (actually thickness, measured in m) + + real(dp), dimension (nx,ny,ntracer,nlyr), intent(in), optional :: & + tracer ! tracer values + + real(dp), dimension(ntracer), intent(out), optional :: & + mtsum ! total mass*tracer + + ! Local arguments + + integer :: i, j, nt + + msum = 0.d0 + if (present(mtsum)) mtsum(:) = 0.d0 + + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + + ! accumulate ice mass and mass*tracers + ! (actually, accumulate thickness, assuming rhoi*dx*dy is the same for each cell) + + msum = msum + sum(thck_layer(i,j,:)) + + if (present(mtsum)) then + do nt = 1, ntracer + mtsum(nt) = mtsum(nt) + sum(tracer(i,j,nt,:)*thck_layer(i,j,:)) + enddo + endif + + enddo ! i + enddo ! j + + call global_sum(msum) + if (present(mtsum)) call global_sum(mtsum) + + end subroutine sum_mass_and_tracers + +!======================================================================= +! + subroutine global_conservation (msum_init, msum_final, & + errflag, melt_potential_in, & + ntracer, & + mtsum_init, mtsum_final) + ! + ! Check whether values of conserved quantities have changed. + ! An error probably means that ghost cells are treated incorrectly. + ! + ! author William H. Lipscomb, LANL + ! + ! input/output arguments + + real(dp), intent(in) :: & + msum_init ,&! initial global ice mass + msum_final ! final global ice mass + + logical, intent(out) :: & + errflag ! true if there is a conservation error + + real(dp), intent(in), optional :: & + melt_potential_in ! total thickness (m) of additional ice that could be melted + ! by available acab/bmlt in columns that are completely melted + + integer, intent(in), optional :: & + ntracer ! number of tracers + + real(dp), dimension(:), intent(in), optional :: & + mtsum_init ,&! initial global ice mass*tracer + mtsum_final ! final global ice mass*tracer + + character(len=100) :: message + + integer :: & + nt ! tracer index + + real(dp) :: & + melt_potential, &! melt_potential_in (if present), else = 0 + diff ! difference between initial and final values + + if (present(melt_potential_in)) then + melt_potential = melt_potential_in + else + melt_potential = 0.d0 + endif + + errflag = .false. + + if (msum_init > puny) then + diff = (msum_final - melt_potential) - msum_init + if (abs(diff/msum_init) > puny) then + errflag = .true. + write (message,*) 'glissade_transport: ice mass conservation error' + call write_log(message) + write (message,*) 'Initial global mass =', msum_init + call write_log(message) +! write (message,*) 'Final global mass =', msum_final +! call write_log(message) +! write (message,*) 'Melt potential =', melt_potential +! call write_log(message) + write (message,*) 'Final global mass (adjusted for melt potential) =', msum_final - melt_potential + call write_log(message) + write (message,*) 'Fractional error =', abs(diff)/msum_init + call write_log(message) + endif + endif + + if (present(mtsum_init)) then + do nt = 1, ntracer + if (abs(mtsum_init(nt)) > puny) then + diff = mtsum_final(nt) - mtsum_init(nt) + if (abs(diff/mtsum_init(nt)) > puny) then + errflag = .true. + write (message,*) 'glissade_transport: mass*tracer conservation error' + call write_log(message) + write (message,*) 'tracer index =', nt + call write_log(message) + write (message,*) 'Initial global mass*tracer =', mtsum_init(nt) + call write_log(message) + write (message,*) 'Final global mass*tracer =', mtsum_final(nt) + call write_log(message) + write (message,*) 'Fractional difference =', abs(diff)/mtsum_init(nt) + call write_log(message) + endif + endif + enddo + endif ! present(mtsum_init) + + end subroutine global_conservation + +!---------------------------------------------------------------------- + + subroutine glissade_add_smb(nx, ny, & + nlyr, ntracer, & + nhalo, dt, & + thck_layer, tracer, & + acab, tsfc, & + bmlt, tbed, & + melt_potential) + + ! Adjust the layer thickness based on the surface and basal mass balance + + ! Input/output arguments + + integer, intent(in) :: & + nx, ny, &! horizontal array size + nlyr, &! number of vertical layers + ntracer, &! number of tracers + nhalo ! number of halo rows + + real(dp), intent(in) :: & + dt ! time step (s) + + real(dp), dimension (nx,ny,nlyr), intent(inout) :: & + thck_layer ! ice layer thickness + + real(dp), dimension (nx,ny,ntracer,nlyr), intent(inout) :: & + tracer ! tracer values + + real(dp), intent(in), dimension(nx,ny) :: & + acab ! surface mass balance (m/s) + + real(dp), intent(in), dimension(nx,ny) :: & + bmlt ! basal melt rate (m/s) + ! > 0 for melting, < 0 for freeze-on + + real(dp), intent(out) :: & + melt_potential ! total thickness (m) of additional ice that could be melted + ! by available acab/bmlt in columns that are completely melted + + ! Note: If enthalpy is passed in, then tsfc and tbed are enthalpies. + + real(dp), intent(in), dimension(nx,ny) :: & + tsfc ! surface temperature (deg C) + + real(dp), intent(in), dimension(nx,ny) :: & + tbed ! basal temperature (deg C) + + ! Local variables + + real(dp), dimension(nx,ny,ntracer,nlyr) :: & + thck_tracer ! thck_layer * tracer + + real(dp) :: sfc_accum, sfc_ablat ! surface accumulation/ablation, from acab + real(dp) :: bed_accum, bed_ablat ! bed accumulation/ablation, from bmlt + + integer :: i, j, k + + character(len=100) :: message + + melt_potential = 0.d0 + + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + + ! initialize accumulation/ablation terms + sfc_accum = 0.d0 + sfc_ablat = 0.d0 + bed_accum = 0.d0 + bed_ablat = 0.d0 + + ! Add surface accumulation/ablation to ice thickness + ! Also modify tracers conservatively. + ! Assume tracer(:,:,1,:) is temperature and is always present + ! Asumme tracer(:,:,2,:) is ice age and is optionally present + + if (acab(i,j) > 0.d0) then ! accumulation, added to layer 1 + + sfc_accum = acab(i,j)*dt + + ! temperature of top layer + if (ntracer >= 1) then + thck_tracer(i,j,1,1) = thck_layer(i,j,1) * tracer(i,j,1,1) & + + sfc_accum * tsfc(i,j) + endif + + ! ice age (= 0 for new accumulation) + if (ntracer >= 2) then + thck_tracer(i,j,2,1) = thck_layer(i,j,1) * tracer(i,j,2,1) + ! + sfc_accum * 0.d0 + + !TODO - Add other tracers here, as needed + + endif + + ! new top layer thickess + thck_layer(i,j,1) = thck_layer(i,j,1) + sfc_accum + + ! new tracer values in top layer + tracer(i,j,:,1) = thck_tracer(i,j,:,1) / thck_layer(i,j,1) + + elseif (acab(i,j) < 0.d0) then ! ablation in one or mor layers + + ! reduce ice thickness (tracer values will not change) + + sfc_ablat = -acab(i,j)*dt ! positive by definition + + do k = 1, nlyr + if (sfc_ablat > thck_layer(i,j,k)) then + sfc_ablat = sfc_ablat - thck_layer(i,j,k) + thck_layer(i,j,k) = 0.d0 + tracer(i,j,:,k) = 0.d0 + else + thck_layer(i,j,k) = thck_layer(i,j,k) - sfc_ablat + sfc_ablat = 0.d0 + exit + endif + enddo + + if (sfc_ablat > 0.d0) then + melt_potential = melt_potential + sfc_ablat + endif + + endif ! acab > 0 + + !TODO - Figure out how to handle excess energy given by melt_potential. + ! Include in the heat flux passed back to CLM? + + ! Note: It is theoretically possible that we could have residual energy remaining for surface + ! ablation while ice is freezing on at the bed, in which case the surface ablation should + ! be subtracted from the bed accumulation. We ignore this possibility for now. + + if (bmlt(i,j) < 0.d0) then ! freeze-on, added to lowest layer + + bed_accum = -bmlt(i,j)*dt + + ! temperature of bottom layer + if (ntracer >= 1) then + thck_tracer(i,j,1,nlyr) = thck_layer(i,j,nlyr) * tracer(i,j,1,nlyr) & + + bed_accum * tbed(i,j) + endif + + ! ice age (= 0 for new accumulation) + if (ntracer >= 2) then + thck_tracer(i,j,2,nlyr) = thck_layer(i,j,nlyr) * tracer(i,j,2,nlyr) + ! + bed_accum * 0.d0 + + !TODO - Add other tracers here, as needed + endif + + ! new bottom layer thickess + thck_layer(i,j,nlyr) = thck_layer(i,j,nlyr) + bed_accum + + ! new tracer values in bottom layer + tracer(i,j,:,nlyr) = thck_tracer(i,j,:,nlyr) / thck_layer(i,j,nlyr) + + elseif (bmlt(i,j) > 0.d0) then ! basal melting in one or more layers + + ! reduce ice thickness (tracer values will not change) + + bed_ablat = bmlt(i,j)*dt ! positive by definition + + do k = nlyr, 1, -1 + if (bed_ablat > thck_layer(i,j,k)) then + bed_ablat = bed_ablat - thck_layer(i,j,k) + thck_layer(i,j,k) = 0.d0 + tracer(i,j,:,k) = 0.d0 + else + thck_layer(i,j,k) = thck_layer(i,j,k) - bed_ablat + bed_ablat = 0.d0 + exit + endif + enddo + + if (bed_ablat > 0.d0) then + melt_potential = melt_potential + bed_ablat + endif + + endif ! bmlt < 0 + + enddo ! i + enddo ! j + + call global_sum(melt_potential) + + end subroutine glissade_add_smb + +!---------------------------------------------------------------------- + + subroutine glissade_vertical_remap(nx, ny, & + nlyr, ntracer, & + sigma, hlyr, & + trcr) + + ! Conservative remapping of tracer fields from one set of vertical + ! coordinates to another. The remapping is first-order accurate. + ! + ! Note: The cost of this subroutine scales as nlyr; + ! a previous version scaled as nlyr^2. + ! + ! TODO - Add a 2nd-order accurate vertical remapping scheme? + ! + ! Author: William Lipscomb, LANL + + implicit none + + ! in-out arguments + + integer, intent(in) :: & + nx, ny, &! number of cells in EW and NS directions + nlyr, &! number of vertical layers + ntracer ! number of tracer fields + + real(dp), dimension (nx, ny, nlyr), intent(inout) :: & + hlyr ! layer thickness + + real(dp), dimension (nlyr+1), intent(in) :: & + sigma ! sigma vertical coordinate (at layer interfaces) + + real(dp), dimension (nx, ny, ntracer, nlyr), intent(inout) :: & + trcr ! tracer field to be remapped + ! tracer(k) = value at midpoint of layer k + + ! local variables + + integer :: i, j, k, k1, k2, nt + + real(dp), dimension (nlyr+1) :: & + z1, &! layer interfaces in old coordinate system + ! z1(1) = 0. = value at top surface + ! z1(k) = value at top of layer k + ! z1(nlyr+1) = value at bottom surface (= 1 in sigma coordinates) + z2 ! layer interfaces in new coordinate system + + real(dp) :: & + thck, &! total thickness + rthck ! reciprocal of total thickness + + real(dp), dimension(ntracer,nlyr) :: & + htsum ! sum of thickness*tracer in a layer + + real(dp) :: zlo, zhi, hovlp + + do j = 1, ny + do i = 1, nx + + !----------------------------------------------------------------- + ! Compute total thickness and reciprocal thickness + !----------------------------------------------------------------- + + thck = 0.d0 + do k = 1, nlyr + thck = thck + hlyr(i,j,k) + enddo + + if (thck > 0.d0) then + rthck = 1.d0/thck + else + rthck = 0.d0 + endif + + !----------------------------------------------------------------- + ! Determine vertical coordinate z1, given input layer thicknesses. + ! These are the coordinates from which we start. + !----------------------------------------------------------------- + + z1(1) = 0.d0 + do k = 2, nlyr + z1(k) = z1(k-1) + hlyr(i,j,k-1)*rthck + enddo + z1(nlyr+1) = 1.d0 + + !----------------------------------------------------------------- + ! Set vertical coordinate z2, given sigma. + ! These are the coordinates to which we remap in the vertical. + !----------------------------------------------------------------- + + z2(1) = 0.d0 + do k = 2, nlyr + z2(k) = sigma(k) + enddo + z2(nlyr+1) = 1.d0 + + !----------------------------------------------------------------- + ! Compute new layer thicknesses (z2 coordinates) + !----------------------------------------------------------------- + + do k = 1, nlyr + hlyr(i,j,k) = (z2(k+1) - z2(k)) * thck + enddo + + !----------------------------------------------------------------- + ! Compute sum of h*T for each new layer (k2) by integrating + ! over the regions of overlap with old layers (k1). + !----------------------------------------------------------------- + + htsum(:,:) = 0.d0 + k1 = 1 + k2 = 1 + do while (k1 <= nlyr .and. k2 <= nlyr) + zhi = min (z1(k1+1), z2(k2+1)) + zlo = max (z1(k1), z2(k2)) + hovlp = max (zhi-zlo, 0.d0) * thck + htsum(:,k2) = htsum(:,k2) + trcr(i,j,:,k1) * hovlp + if (z1(k1+1) > z2(k2+1)) then + k2 = k2 + 1 + else + k1 = k1 + 1 + endif + enddo + + do k = 1, nlyr + if (hlyr(i,j,k) > 0.d0) then + trcr(i,j,:,k) = htsum(:,k) / hlyr(i,j,k) + else + trcr(i,j,:,k) = 0.d0 + endif + enddo ! k + + enddo ! i + enddo ! j + + end subroutine glissade_vertical_remap + +!======================================================================= + + subroutine upwind_field (nx, ny, & + ilo, ihi, jlo, jhi, & + dx, dy, & + dt, phi, & + uee, vnn) + ! + ! first-order upwind transport algorithm + ! + ! + ! Authors: Elizabeth Hunke and William Lipscomb, LANL + ! + ! input/output arguments + + integer, intent (in) :: & + nx, ny ,&! block dimensions + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + real(dp), intent(in) :: & + dx, dy ,&! x and y gridcell dimensions + dt ! time step + + real(dp), dimension(nx,ny), & + intent(inout) :: & + phi ! scalar field + + real(dp), dimension(nx,ny), & + intent(in):: & + uee, vnn ! cell edge velocities + + ! local variables + + integer :: & + i, j ! standard indices + + real(dp) :: & + upwind, y1, y2, a, h ! function + + real(dp), dimension(nx,ny) :: & + worka, workb + + !------------------------------------------------------------------- + ! Define upwind function + !------------------------------------------------------------------- + + upwind(y1,y2,a,h) = 0.5d0*dt*h*((a+abs(a))*y1+(a-abs(a))*y2) + + !------------------------------------------------------------------- + ! upwind transport + !------------------------------------------------------------------- + + do j = jlo-1, jhi + do i = ilo-1, ihi + worka(i,j)= upwind(phi(i,j),phi(i+1,j),uee(i,j),dy) + workb(i,j)= upwind(phi(i,j),phi(i,j+1),vnn(i,j),dx) + enddo + enddo + + do j = jlo, jhi + do i = ilo, ihi + phi(i,j) = phi(i,j) - ( worka(i,j)-worka(i-1,j) & + + workb(i,j)-workb(i,j-1) ) & + / (dx*dy) + enddo + enddo + + end subroutine upwind_field + +!======================================================================= + + end module glissade_transport + +!======================================================================= diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo.F90 new file mode 100644 index 0000000000..6054195b38 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo.F90 @@ -0,0 +1,127 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +!TODO - Are all these includes needed? +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif +#include "glide_nan.inc" +#include "glide_mask.inc" + +module glissade_velo + + use parallel + + ! Driver for Glissade velocity solvers + + implicit none + +contains + + subroutine glissade_velo_driver(model) + + ! Glissade higher-order velocity driver + + use glimmer_global, only : dp + use glimmer_physcon, only: gn, scyr + use glimmer_paramets, only: thk0, len0, vel0, vis0, tau0, evs0 + use glimmer_log + use glide_types + use glissade_velo_higher, only: glissade_velo_higher_solve + use glissade_velo_sia, only: glissade_velo_sia_solve + use glide_mask + + type(glide_global_type),intent(inout) :: model + + integer :: i, j + + !------------------------------------------------------------------- + ! Call the velocity solver. + ! The standard glissade higher-order solver is glissade_velo_higher_solve. + ! There is an additional local shallow-ice solver, glissade_velo_sia_solve. + !------------------------------------------------------------------- + + if (model%options%which_ho_approx == HO_APPROX_LOCAL_SIA) then + + call glissade_velo_sia_solve (model, & + model%general%ewn, model%general%nsn, & + model%general%upn) + + else ! standard higher-order solve + ! can be BP, L1L2, SSA or SIA, depending on model%options%which_ho_approx + + !------------------------------------------------------------------- + ! Compute mask for staggered grid. This is needed as an input to calcbeta + ! (which used to be called here but now is called from glissade_velo_higher_solve). + !------------------------------------------------------------------- + + call glide_set_mask(model%numerics, & + model%geomderv%stagthck, model%geomderv%stagtopg, & + model%general%ewn-1, model%general%nsn-1, & + model%climate%eus, model%geometry%stagmask) + + if (model%options%which_ho_nonlinear == HO_NONLIN_PICARD ) then ! Picard (standard solver) + + ! Note: The geometry fields (thck, topg, and usrf) must be updated in halos + ! before calling glissade_velo_higher_solve. + ! These updates are done in subroutine glissade_diagnostic_variable_solve + ! in module glissade.F90. + + ! Note: Instead of assuming that kinbcmask is periodic, we extrapolate + ! the kinbcmask into the global halo region + ! (and also into the north and east rows of the global domain, + ! which are not included on the global staggered grid). + !TODO - Move this call to glissade_velo_higher_solve? + + call staggered_parallel_halo_extrapolate (model%velocity%kinbcmask) ! = 1 for Dirichlet BCs + + call t_startf('glissade_velo_higher_solver') + call glissade_velo_higher_solve(model, & + model%general%ewn, model%general%nsn, & + model%general%upn) + call t_stopf('glissade_velo_higher_solver') + + else if (model%options%which_ho_nonlinear == HO_NONLIN_JFNK) then + + !TODO - Create a JFNK solver? + + call write_log('JFNK not supported for Glissade velocity solver', GM_FATAL) + + else + + call write_log('Invalid which_ho_nonlinear option.', GM_FATAL) + + end if ! which_ho_nonlinear + + endif ! which_ho_approx + + end subroutine glissade_velo_driver + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + end module glissade_velo + +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo_higher.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo_higher.F90 new file mode 100644 index 0000000000..c176b165d3 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo_higher.F90 @@ -0,0 +1,8000 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo_higher.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains routines for computing the ice velocity using a +! variational finite-element approach. It solves the higher-order Blatter-Pattyn +! approximation for Stokes flow, as well as several simpler approximations +! (L1L2, shallow-shelf approximation, and shallow-ice approximation). +! +! See these papers for details: +! +! J.K. Dukowicz, S.F. Price and W.H. Lipscomb, 2010: Consistent +! approximations and boundary conditions for ice-sheet dynamics +! using a principle of least action. J. Glaciology, 56 (197), +! 480-495. +! +! F. Pattyn, 2003: A new three-dimensional higher-order thermomechanical +! ice sheet model: Basic sensitivity, ice stream development, and +! ice flow across subglacial lakes. J. Geophys. Res., 108 (B8), +! 2382, doi:10.1029/2002JB002329. +! +! M. Perego, M. Gunzburger, and J. Burkardt, 2012: Parallel +! finite-element implementation for higher-order ice-sheet models. +! J. Glaciology, 58 (207), 76-88. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + module glissade_velo_higher + + use glimmer_global, only: dp + use glimmer_physcon, only: gn, rhoi, rhoo, grav, scyr, pi + use glimmer_paramets, only: thk0, len0, tim0, tau0, vel0, vis0, evs0 + use glimmer_paramets, only: vel_scale, len_scale ! used for whichefvs = HO_EFVS_FLOWFACT + use glimmer_log + use glimmer_sparse_type + use glimmer_sparse + use glissade_grid_operators + use glissade_masks, only: glissade_get_masks, glissade_grounded_fraction + + use glide_types + + use glissade_velo_higher_slap, only: & + slap_preprocess_3d, slap_preprocess_2d, & + slap_postprocess_3d, slap_postprocess_2d, & + slap_compute_residual_vector, slap_solve_test_matrix + + use glissade_velo_higher_pcg, only: & + pcg_solver_standard_3d, pcg_solver_standard_2d, & + pcg_solver_chrongear_3d, pcg_solver_chrongear_2d + +#ifdef TRILINOS + use glissade_velo_higher_trilinos, only: & + trilinos_fill_pattern_3d, trilinos_fill_pattern_2d, & + trilinos_global_id_3d, trilinos_global_id_2d, & + trilinos_assemble_3d, trilinos_assemble_2d, & + trilinos_init_velocity_3d, trilinos_init_velocity_2d, & + trilinos_extract_velocity_3d, trilinos_extract_velocity_2d, & + trilinos_test +#endif + + use parallel + + implicit none + + private + public :: glissade_velo_higher_init, glissade_velo_higher_solve + + !---------------------------------------------------------------- + ! Here are some definitions: + ! + ! The horizontal mesh is composed of cells and vertices. + ! The cells are rectangular with uniform dimensions dx and dy. + ! Each cell can be extruded to form a column with a specified number of layers. + ! + ! An element is a layer of a cell, and a node is a corner of an element. + ! Elements and nodes live in 3D space, whereas cells and vertices live in + ! the horizontal plane. + ! + ! Locally owned cells and vertices have indices (nhalo+1:nx-nhalo, nhalo+1,ny-nhalo). + ! Active cells are cells that (1) contain ice and (2) border locally owned vertices. + ! Active vertices are all vertices of active cells. + ! Active nodes are all nodes in the columns associated with active vertices. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Finite element properties + ! Assume 3D hexahedral elements. + !---------------------------------------------------------------- + + integer, parameter :: & + nNodesPerElement_3d = 8, & ! 8 nodes for hexahedral elements + nQuadPoints_3d = 8, & ! number of quadrature points per hexahedral element + ! These live at +- 1/sqrt(3) for reference hexahedron + nNodeNeighbors_3d = 27 ! number of nearest node neighbors in 3D (including the node itself) + + integer, parameter :: & + nNodesPerElement_2d = 4, & ! 4 nodes for faces of hexahedral elements + nQuadPoints_2d = 4, & ! number of quadrature points per element face + ! These live at +- 1/sqrt(3) for reference square + nNodeNeighbors_2d = 9 ! number of nearest node neighbors in 2D (including the node itself) + + real(dp), parameter :: & + rsqrt3 = 1.d0/sqrt(3.d0) ! for quadrature points + + !---------------------------------------------------------------- + ! Arrays used for finite-element calculations + ! + ! Most integals are done over 3D hexahedral elements. + ! Surface integrals are done over 2D faces of these elements. + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_3d, nQuadPoints_3d) :: & + phi_3d, & ! trilinear basis function, evaluated at quad pts + dphi_dxr_3d, & ! dphi/dx for reference hexehedral element, evaluated at quad pts + dphi_dyr_3d, & ! dphi/dy for reference hexahedral element, evaluated at quad pts + dphi_dzr_3d ! dphi/dy for reference hexahedral element, evaluated at quad pts + + real(dp), dimension(nQuadPoints_3d) :: & + xqp_3d, yqp_3d, zqp_3d, &! quad pt coordinates in reference element + wqp_3d ! quad pt weights + + real(dp), dimension(nNodesPerElement_2d, nQuadPoints_2d) :: & + phi_2d, & ! bilinear basis function, evaluated at quad pts + dphi_dxr_2d, & ! dphi/dx for reference rectangular element, evaluated at quad pts + dphi_dyr_2d ! dphi/dy for reference rectangular element, evaluated at quad pts + + real(dp), dimension(nNodesPerElement_2d) :: & + phi_2d_ctr, &! bilinear basis function, evaluated at cell ctr + dphi_dxr_2d_ctr, &! dphi/dx for reference rectangular element, evaluated at cell ctr + dphi_dyr_2d_ctr ! dphi/dy for reference rectangular element, evaluated at cell ctr + + real(dp), dimension(nQuadPoints_2d) :: & + xqp_2d, yqp_2d, & ! quad pt coordinates in reference square + wqp_2d ! quad pt weights + + integer, dimension(nNodesPerElement_3d, nNodesPerElement_3d) :: & + ishift, jshift, kshift ! matrices describing relative indices of nodes in an element + + integer, dimension(-1:1,-1:1,-1:1) :: & + indxA_3d ! maps relative (x,y,z) coordinates to an index between 1 and 27 + ! index order is (i,j,k) + + integer, dimension(-1:1,-1:1) :: & + indxA_2d ! maps relative (x,y) coordinates to an index between 1 and 9 + ! index order is (i,j) + + real(dp), dimension(3,3) :: & + identity3 ! 3 x 3 identity matrix + + real(dp), parameter :: & + eps08 = 1.d-08, &! small number + eps10 = 1.d-10 ! smaller number + + real(dp) :: vol0 ! volume scale (m^3), used to scale 3D matrix values + + logical, parameter :: & + check_symmetry = .true. ! if true, then check symmetry of assembled matrix + + ! various options for turning diagnostic prints on and off + logical :: verbose = .false. +! logical :: verbose = .true. + logical :: verbose_init = .false. +! logical :: verbose_init = .true. + logical :: verbose_Jac = .false. +! logical :: verbose_Jac = .true. + logical :: verbose_residual = .false. +! logical :: verbose_residual = .true. + logical :: verbose_state = .false. +! logical :: verbose_state = .true. + logical :: verbose_id = .false. +! logical :: verbose_id = .true. + logical :: verbose_load = .false. +! logical :: verbose_load = .true. + logical :: verbose_shelf = .false. +! logical :: verbose_shelf = .true. + logical :: verbose_matrix = .false. +! logical :: verbose_matrix = .true. + logical :: verbose_basal = .false. +! logical :: verbose_basal = .true. + logical :: verbose_bfric = .false. +! logical :: verbose_bfric = .true. + logical :: verbose_trilinos = .false. +! logical :: verbose_trilinos = .true. + logical :: verbose_beta = .false. +! logical :: verbose_beta = .true. + logical :: verbose_efvs = .false. +! logical :: verbose_efvs = .true. + logical :: verbose_tau = .false. +! logical :: verbose_tau = .true. + logical :: verbose_gridop = .false. +! logical :: verbose_gridop= .true. + logical :: verbose_dirichlet = .false. +! logical :: verbose_dirichlet= .true. + logical :: verbose_L1L2 = .false. +! logical :: verbose_L1L2 = .true. + + integer :: itest, jtest ! coordinates of diagnostic point + integer :: rtest ! task number for processor containing diagnostic point + + integer, parameter :: ktest = 1 ! vertical level of diagnostic point + integer, parameter :: ptest = 1 ! diagnostic quadrature point + + ! option for writing matrix entries to text files + logical, parameter :: write_matrix = .false. +! logical, parameter :: write_matrix = .true. + character(*), parameter :: matrix_label = 'label_here' ! choose an appropriate label + + contains + +!**************************************************************************** + + subroutine glissade_velo_higher_init + + !---------------------------------------------------------------- + ! Initial calculations for glissade higher-order solver. + !---------------------------------------------------------------- + + integer :: i, j, k, m, n, p + real(dp) :: xctr, yctr + real(dp) :: sumx, sumy, sumz + + !---------------------------------------------------------------- + ! Initialize some time-independent finite element arrays + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Trilinear basis set for reference hexahedron, x=(-1,1), y=(-1,1), z=(-1,1) + ! Indexing is counter-clockwise from SW corner, with 1-4 on lower surface + ! and 5-8 on upper surface + ! The code uses "phi_3d" to denote these basis functions. + ! + ! N1 = (1-x)*(1-y)*(1-z)/8 N4----N3 + ! N2 = (1+x)*(1-y)*(1-z)/8 | | Lower layer + ! N3 = (1+x)*(1+y)*(1-z)/8 | | + ! N4 = (1-x)*(1+y)*(1-z)/8 N1----N2 + + ! N5 = (1-x)*(1-y)*(1+z)/8 N8----N7 + ! N6 = (1+x)*(1-y)*(1+z)/8 | | Upper layer + ! N7 = (1+x)*(1+y)*(1+z)/8 | | + ! N8 = (1-x)*(1+y)*(1+z)/8 N5----N6 + !---------------------------------------------------------------- + + ! Set coordinates and weights of quadrature points for reference hexahedral element. + ! Numbering is counter-clockwise from southwest, lower face (1-4) followed by + ! upper face (5-8). + + xqp_3d(1) = -rsqrt3; yqp_3d(1) = -rsqrt3; zqp_3d(1) = -rsqrt3 + wqp_3d(1) = 1.d0 + + xqp_3d(2) = rsqrt3; yqp_3d(2) = -rsqrt3; zqp_3d(2) = -rsqrt3 + wqp_3d(2) = 1.d0 + + xqp_3d(3) = rsqrt3; yqp_3d(3) = rsqrt3; zqp_3d(3) = -rsqrt3 + wqp_3d(3) = 1.d0 + + xqp_3d(4) = -rsqrt3; yqp_3d(4) = rsqrt3; zqp_3d(4) = -rsqrt3 + wqp_3d(4) = 1.d0 + + xqp_3d(5) = -rsqrt3; yqp_3d(5) = -rsqrt3; zqp_3d(5) = rsqrt3 + wqp_3d(5) = 1.d0 + + xqp_3d(6) = rsqrt3; yqp_3d(6) = -rsqrt3; zqp_3d(6) = rsqrt3 + wqp_3d(6) = 1.d0 + + xqp_3d(7) = rsqrt3; yqp_3d(7) = rsqrt3; zqp_3d(7) = rsqrt3 + wqp_3d(7) = 1.d0 + + xqp_3d(8) = -rsqrt3; yqp_3d(8) = rsqrt3; zqp_3d(8) = rsqrt3 + wqp_3d(8) = 1.d0 + + if (verbose_init) then + print*, ' ' + print*, 'Hexahedral elements, quad points, x, y, z:' + sumx = 0.d0; sumy = 0.d0; sumz = 0.d0 + do p = 1, nQuadPoints_3d + print*, p, xqp_3d(p), yqp_3d(p), zqp_3d(p) + sumx = sumx + xqp_3d(p); sumy = sumy + yqp_3d(p); sumz = sumz + zqp_3d(p) + enddo + print*, ' ' + print*, 'sums:', sumx, sumy, sumz + endif + + ! Evaluate trilinear basis functions and their derivatives at each quad pt + + do p = 1, nQuadPoints_3d + + phi_3d(1,p) = (1.d0 - xqp_3d(p)) * (1.d0 - yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + phi_3d(2,p) = (1.d0 + xqp_3d(p)) * (1.d0 - yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + phi_3d(3,p) = (1.d0 + xqp_3d(p)) * (1.d0 + yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + phi_3d(4,p) = (1.d0 - xqp_3d(p)) * (1.d0 + yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + phi_3d(5,p) = (1.d0 - xqp_3d(p)) * (1.d0 - yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + phi_3d(6,p) = (1.d0 + xqp_3d(p)) * (1.d0 - yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + phi_3d(7,p) = (1.d0 + xqp_3d(p)) * (1.d0 + yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + phi_3d(8,p) = (1.d0 - xqp_3d(p)) * (1.d0 + yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + + dphi_dxr_3d(1,p) = -(1.d0 - yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dxr_3d(2,p) = (1.d0 - yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dxr_3d(3,p) = (1.d0 + yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dxr_3d(4,p) = -(1.d0 + yqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dxr_3d(5,p) = -(1.d0 - yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dxr_3d(6,p) = (1.d0 - yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dxr_3d(7,p) = (1.d0 + yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dxr_3d(8,p) = -(1.d0 + yqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + + dphi_dyr_3d(1,p) = -(1.d0 - xqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dyr_3d(2,p) = -(1.d0 + xqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dyr_3d(3,p) = (1.d0 + xqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dyr_3d(4,p) = (1.d0 - xqp_3d(p)) * (1.d0 - zqp_3d(p)) / 8.d0 + dphi_dyr_3d(5,p) = -(1.d0 - xqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dyr_3d(6,p) = -(1.d0 + xqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dyr_3d(7,p) = (1.d0 + xqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + dphi_dyr_3d(8,p) = (1.d0 - xqp_3d(p)) * (1.d0 + zqp_3d(p)) / 8.d0 + + dphi_dzr_3d(1,p) = -(1.d0 - xqp_3d(p)) * (1.d0 - yqp_3d(p)) / 8.d0 + dphi_dzr_3d(2,p) = -(1.d0 + xqp_3d(p)) * (1.d0 - yqp_3d(p)) / 8.d0 + dphi_dzr_3d(3,p) = -(1.d0 + xqp_3d(p)) * (1.d0 + yqp_3d(p)) / 8.d0 + dphi_dzr_3d(4,p) = -(1.d0 - xqp_3d(p)) * (1.d0 + yqp_3d(p)) / 8.d0 + dphi_dzr_3d(5,p) = (1.d0 - xqp_3d(p)) * (1.d0 - yqp_3d(p)) / 8.d0 + dphi_dzr_3d(6,p) = (1.d0 + xqp_3d(p)) * (1.d0 - yqp_3d(p)) / 8.d0 + dphi_dzr_3d(7,p) = (1.d0 + xqp_3d(p)) * (1.d0 + yqp_3d(p)) / 8.d0 + dphi_dzr_3d(8,p) = (1.d0 - xqp_3d(p)) * (1.d0 + yqp_3d(p)) / 8.d0 + + if (verbose_init) then + print*, ' ' + print*, 'Quad point, p =', p + print*, 'n, phi_3d, dphi_dxr_3d, dphi_dyr_3d, dphi_dzr_3d:' + do n = 1, 8 + print*, n, phi_3d(n,p), dphi_dxr_3d(n,p), dphi_dyr_3d(n,p), dphi_dzr_3d(n,p) + enddo + print*, ' ' + print*, 'sum(phi_3d)', sum(phi_3d(:,p)) ! verified that sum = 1 + print*, 'sum(dphi/dx)', sum(dphi_dxr_3d(:,p)) ! verified that sum = 0 (within roundoff) + print*, 'sum(dphi/dy)', sum(dphi_dyr_3d(:,p)) ! verified that sum = 0 (within roundoff) + print*, 'sum(dphi/dz)', sum(dphi_dzr_3d(:,p)) ! verified that sum = 0 (within roundoff) + endif + + enddo ! nQuadPoints_3d + + ! Identity matrix + identity3(1,:) = (/ 1.d0, 0.d0, 0.d0 /) + identity3(2,:) = (/ 0.d0, 1.d0, 0.d0 /) + identity3(3,:) = (/ 0.d0, 0.d0, 1.d0 /) + + ! Initialize some matrices that describe how the i, j and k indices of each node + ! in each element are related to one another. + + ! The ishift matrix describes how the i indices of the 8 nodes are related to one another. + ! E.g, if ishift (1,2) = 1, this means that node 2 has an i index + ! one greater than the i index of node 1. + + ishift(1,:) = (/ 0, 1, 1, 0, 0, 1, 1, 0/) + ishift(2,:) = (/-1, 0, 0, -1, -1, 0, 0, -1/) + ishift(3,:) = ishift(2,:) + ishift(4,:) = ishift(1,:) + ishift(5,:) = ishift(1,:) + ishift(6,:) = ishift(2,:) + ishift(7,:) = ishift(2,:) + ishift(8,:) = ishift(1,:) + + ! The jshift matrix describes how the j indices of the 8 nodes are related to one another. + ! E.g, if jshift (1,4) = 1, this means that node 4 has a j index + ! one greater than the j index of node 1. + + jshift(1,:) = (/ 0, 0, 1, 1, 0, 0, 1, 1/) + jshift(2,:) = jshift(1,:) + jshift(3,:) = (/-1, -1, 0, 0, -1, -1, 0, 0/) + jshift(4,:) = jshift(3,:) + jshift(5,:) = jshift(1,:) + jshift(6,:) = jshift(1,:) + jshift(7,:) = jshift(3,:) + jshift(8,:) = jshift(3,:) + + ! The kshift matrix describes how the k indices of the 8 nodes are related to one another. + ! E.g, if kshift (1,5) = -1, this means that node 5 has a k index + ! one less than the k index of node 1. (Assume that k increases downward.) + + kshift(1,:) = (/ 0, 0, 0, 0, -1, -1, -1, -1/) + kshift(2,:) = kshift(1,:) + kshift(3,:) = kshift(1,:) + kshift(4,:) = kshift(1,:) + kshift(5,:) = (/ 1, 1, 1, 1, 0, 0, 0, 0/) + kshift(6,:) = kshift(5,:) + kshift(7,:) = kshift(5,:) + kshift(8,:) = kshift(5,:) + + if (verbose_init) then + print*, ' ' + print*, 'ishift:' + do n = 1, 8 + write (6,'(8i4)') ishift(n,:) + enddo + print*, ' ' + print*, 'jshift:' + do n = 1, 8 + write (6,'(8i4)') jshift(n,:) + enddo + print*, ' ' + print*, 'kshift:' + do n = 1, 8 + write (6,'(8i4)') kshift(n,:) + enddo + endif + + !---------------------------------------------------------------- + ! Bilinear basis set for reference square, x=(-1,1), y=(-1,1) + ! Indexing is counter-clockwise from SW corner + ! The code uses "phi_2d" to denote these basis functions. + ! + ! N1 = (1-x)*(1-y)/4 N4----N3 + ! N2 = (1+x)*(1-y)/4 | | + ! N3 = (1+x)*(1+y)/4 | | + ! N4 = (1-x)*(1+y)/4 N1----N2 + !---------------------------------------------------------------- + + ! Set coordinates and weights of quadrature points for reference square. + ! Numbering is counter-clockwise from southwest + + xqp_2d(1) = -rsqrt3; yqp_2d(1) = -rsqrt3 + wqp_2d(1) = 1.d0 + + xqp_2d(2) = rsqrt3; yqp_2d(2) = -rsqrt3 + wqp_2d(2) = 1.d0 + + xqp_2d(3) = rsqrt3; yqp_2d(3) = rsqrt3 + wqp_2d(3) = 1.d0 + + xqp_2d(4) = -rsqrt3; yqp_2d(4) = rsqrt3 + wqp_2d(4) = 1.d0 + + if (verbose_init) then + print*, ' ' + print*, ' ' + print*, 'Quadrilateral elements, quad points, x, y:' + sumx = 0.d0; sumy = 0.d0; sumz = 0.d0 + do p = 1, nQuadPoints_2d + print*, p, xqp_2d(p), yqp_2d(p) + sumx = sumx + xqp_2d(p); sumy = sumy + yqp_2d(p) + enddo + print*, ' ' + print*, 'sumx, sumy:', sumx, sumy + endif + + ! Evaluate bilinear basis functions and their derivatives at each quad pt + + do p = 1, nQuadPoints_2d + + phi_2d(1,p) = (1.d0 - xqp_2d(p)) * (1.d0 - yqp_2d(p)) / 4.d0 + phi_2d(2,p) = (1.d0 + xqp_2d(p)) * (1.d0 - yqp_2d(p)) / 4.d0 + phi_2d(3,p) = (1.d0 + xqp_2d(p)) * (1.d0 + yqp_2d(p)) / 4.d0 + phi_2d(4,p) = (1.d0 - xqp_2d(p)) * (1.d0 + yqp_2d(p)) / 4.d0 + + dphi_dxr_2d(1,p) = -(1.d0 - yqp_2d(p)) / 4.d0 + dphi_dxr_2d(2,p) = (1.d0 - yqp_2d(p)) / 4.d0 + dphi_dxr_2d(3,p) = (1.d0 + yqp_2d(p)) / 4.d0 + dphi_dxr_2d(4,p) = -(1.d0 + yqp_2d(p)) / 4.d0 + + dphi_dyr_2d(1,p) = -(1.d0 - xqp_2d(p)) / 4.d0 + dphi_dyr_2d(2,p) = -(1.d0 + xqp_2d(p)) / 4.d0 + dphi_dyr_2d(3,p) = (1.d0 + xqp_2d(p)) / 4.d0 + dphi_dyr_2d(4,p) = (1.d0 - xqp_2d(p)) / 4.d0 + + if (verbose_init) then + print*, ' ' + print*, 'Quad point, p =', p + print*, 'n, phi_2d, dphi_dxr_2d, dphi_dyr_2d:' + do n = 1, 4 + print*, n, phi_2d(n,p), dphi_dxr_2d(n,p), dphi_dyr_2d(n,p) + enddo + print*, 'sum(phi_2d)', sum(phi_2d(:,p)) ! verified that sum = 1 + print*, 'sum(dphi/dx_2d)', sum(dphi_dxr_2d(:,p)) ! verified that sum = 0 (within roundoff) + print*, 'sum(dphi/dy_2d)', sum(dphi_dyr_2d(:,p)) ! verified that sum = 0 (within roundoff) + endif + + enddo ! nQuadPoints_2d + + ! Evaluate bilinear basis functions and their derivatives at cell center + ! Full formulas are not really needed at (x,y) = (0,0), but are included for completeness + + xctr = 0.d0 + yctr = 0.d0 + + phi_2d_ctr(1) = (1.d0 - xctr) * (1.d0 - yctr) / 4.d0 + phi_2d_ctr(2) = (1.d0 + xctr) * (1.d0 - yctr) / 4.d0 + phi_2d_ctr(3) = (1.d0 + xctr) * (1.d0 + yctr) / 4.d0 + phi_2d_ctr(4) = (1.d0 - xctr) * (1.d0 + yctr) / 4.d0 + + dphi_dxr_2d_ctr(1) = -(1.d0 - yctr) / 4.d0 + dphi_dxr_2d_ctr(2) = (1.d0 - yctr) / 4.d0 + dphi_dxr_2d_ctr(3) = (1.d0 + yctr) / 4.d0 + dphi_dxr_2d_ctr(4) = -(1.d0 + yctr) / 4.d0 + + dphi_dyr_2d_ctr(1) = -(1.d0 - xctr) / 4.d0 + dphi_dyr_2d_ctr(2) = -(1.d0 + xctr) / 4.d0 + dphi_dyr_2d_ctr(3) = (1.d0 + xctr) / 4.d0 + dphi_dyr_2d_ctr(4) = (1.d0 - xctr) / 4.d0 + + !---------------------------------------------------------------- + ! Compute indxA_3d; maps displacements i,j,k = (-1,0,1) onto an index from 1 to 27 + ! Numbering starts in SW corner of layers k-1, finishes in NE corner of layer k+1 + ! Diagonal term has index 14 + !---------------------------------------------------------------- + + ! Layer k-1: Layer k: Layer k+1: + ! + ! 7 8 9 16 17 18 25 26 27 + ! 4 5 6 13 14 15 22 23 24 + ! 1 2 3 10 11 12 19 20 21 + + m = 0 + do k = -1,1 + do j = -1,1 + do i = -1,1 + m = m + 1 + indxA_3d(i,j,k) = m + enddo + enddo + enddo + + !---------------------------------------------------------------- + ! Compute indxA_2d; maps displacements i,j = (-1,0,1) onto an index from 1 to 9 + ! Same as indxA_3d, but for a single layer + !---------------------------------------------------------------- + + m = 0 + do j = -1,1 + do i = -1,1 + m = m + 1 + indxA_2d(i,j) = m + enddo + enddo + + end subroutine glissade_velo_higher_init + +!**************************************************************************** + + subroutine glissade_velo_higher_solve(model, & + nx, ny, nz) + + !TODO - Remove nx, ny, nz from argument list? + ! Would then have to allocate many local arrays. + + !---------------------------------------------------------------- + ! Solve the ice sheet flow equations for the horizontal velocity (uvel, vvel) + ! at each node of each grid cell where ice is present. + ! The standard solver is based on the Blatter-Pattyn first-order approximation + ! of Stokes flow (which_ho_approx = HO_APPROX_BP). + ! There are also options to solve the shallow-ice equations (HO_APPROX_SIA), + ! shallow-shelf equations (HO_APPROX_SIA), or L1L2 equations (HO_APPROX_L1L2). + ! Note: The SIA solver does a full matrix solution and is much slower than + ! the local SIA solver (HO_APPROX_LOCAL_SIA) in glissade_velo_sia.F90. + !---------------------------------------------------------------- + + use glissade_basal_traction, only: calcbeta + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + type(glide_global_type), intent(inout) :: model ! derived type holding ice-sheet info + + !---------------------------------------------------------------- + ! Note that the glissade solver uses SI units. + ! Thus we have grid cell dimensions and ice thickness in meters, + ! velocity in m/s, and the rate factor in Pa^(-n) s(-1). + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Note: nx and ny are the horizontal dimensions of scalar arrays (e.g., thck and temp). + ! The velocity arrays have horizontal dimensions (nx-1, ny-1). + ! nz is the number of levels at which uvel and vvel are computed. + ! The scalar variables generally live at layer midpoints and have + ! vertical dimension nz-1. + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each horizontal direction + nz ! number of vertical levels where velocity is computed + ! (same as model%general%upn) + + !---------------------------------------------------------------- + ! Local variables and pointers set to components of model derived type + !---------------------------------------------------------------- + + real(dp) :: & + dx, dy ! grid cell length and width (m) + ! assumed to have the same value for each grid cell + + real(dp), dimension(:), pointer :: & + sigma ! vertical sigma coordinate, [0,1] + + real(dp) :: & + thklim, & ! minimum ice thickness for active cells (m) + eus, & ! eustatic sea level (m), = 0. by default + ho_beta_const, & ! constant beta value (Pa/(m/yr)) for whichbabc = HO_BABC_CONSTANT + efvs_constant ! constant efvs value (Pa yr) for whichefvs = HO_EFVS_CONSTANT + + real(dp), dimension(:,:), pointer :: & + thck, & ! ice thickness (m) + usrf, & ! upper surface elevation (m) + topg, & ! elevation of topography (m) + bwat, & ! basal water depth (m) + mintauf, & ! till yield stress (Pa) + beta, & ! basal traction parameter (Pa/(m/yr)) + bfricflx, & ! basal heat flux from friction (W/m^2) + f_ground ! grounded ice fraction, 0 <= f_ground <= 1 + + integer, dimension(:,:), pointer :: & + stagmask ! mask on staggered grid + + real(dp), dimension(:,:,:), pointer :: & + uvel, vvel, & ! velocity components (m/yr) + flwa, & ! flow factor in units of Pa^(-n) yr^(-1) + efvs, & ! effective viscosity (Pa yr) + resid_u, resid_v, & ! u and v components of residual Ax - b (Pa/m) + bu, bv ! right-hand-side vector b, divided into 2 parts + + real(dp), dimension(:,:), pointer :: & + btractx, btracty ! components of basal traction (Pa) + + real(dp), dimension(:,:,:), pointer :: & + tau_xz, tau_yz, &! vertical components of stress tensor (Pa) + tau_xx, tau_yy, tau_xy, &! horizontal components of stress tensor (Pa) + tau_eff ! effective stress (Pa) + + integer, dimension(:,:), pointer :: & + kinbcmask ! = 1 at vertices where u = v = 0 (Dirichlet BC) + ! = 0 elsewhere + + integer :: & + whichbabc, & ! option for basal boundary condition + whichefvs, & ! option for effective viscosity calculation + ! (calculate it or make it uniform) + whichresid, & ! option for method of calculating residual + whichsparse, & ! option for method of doing elliptic solve + ! (BiCG, GMRES, standalone Trilinos, etc.) + whichapprox, & ! option for which Stokes approximation to use + ! 0 = SIA, 1 = SSA, 2 = Blatter-Pattyn HO, 3 = L1L2 + ! default = 2 + whichprecond, & ! option for which preconditioner to use with + ! structured PCG solver + ! 0 = none, 1 = diag, 2 = SIA-based + whichgradient, & ! option for gradient operator when computing grad(s) + ! 0 = centered, 1 = upstream + whichgradient_margin, & ! option for computing gradient at ice margin + ! 0 = include all neighbor cells in gradient calculation + ! 1 = include ice-covered and/or land cells + ! 2 = include ice-covered cells only + whichassemble_beta, & ! 0 = standard finite element assembly + ! 1 = apply local beta value at each vertex + whichground, & ! option for computing grounded fraction of each cell + maxiter_nonlinear ! maximum number of nonlinear iterations + + !-------------------------------------------------------- + ! Local parameters + !-------------------------------------------------------- + + real(dp), parameter :: resid_target = 1.0d-04 ! assume velocity fields have converged below this resid + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + real(dp), dimension(nx-1,ny-1) :: & + xVertex, yVertex ! x and y coordinates of each vertex (m) + + real(dp), dimension(nx-1,ny-1) :: & + stagusrf, & ! upper surface averaged to vertices (m) + stagthck, & ! ice thickness averaged to vertices (m) + dusrf_dx, dusrf_dy ! gradient of upper surface elevation (m/m) + + integer, dimension(nx,ny) :: & + ice_mask, &! = 1 for cells where ice is present (thk > thklim), else = 0 + floating_mask, &! = 1 for cells where ice is present and is floating + ocean_mask, &! = 1 for cells where topography is below sea level and ice is absent + land_mask ! = 1 for cells where topography is above sea level + + logical, dimension(nx,ny) :: & + active_cell ! true for active cells (thck > thklim and border locally owned vertices) + + logical, dimension(nx-1,ny-1) :: & + active_vertex ! true for vertices of active cells + + real(dp), dimension(nz-1,nx,ny) :: & + flwafact ! temperature-based flow factor, 0.5 * A^(-1/n), + ! used to compute effective viscosity + ! units: Pa yr^(1/n) + + real(dp), dimension(nz,nx-1,ny-1) :: & + usav, vsav, &! previous guess for velocity solution + loadu, loadv ! assembled load vector, divided into 2 parts + ! Note: loadu and loadv are computed only once per nonlinear solve, + ! whereas bu and bv can be set each nonlinear iteration to account + ! for inhomogeneous Dirichlet BC + + logical, dimension(nz,nx-1,ny-1) :: & + umask_dirichlet ! Dirichlet mask for velocity (if true, u = v = 0) + + real(dp) :: & + resid_velo, & ! quantity related to velocity convergence + L2_norm, & ! L2 norm of residual, |Ax - b| + L2_target, & ! nonlinear convergence target for residual + L2_norm_relative, & ! L2 norm of residual relative to rhs, |Ax - b| / |b| + L2_target_relative, & ! nonlinear convergence target for relative residual + err, & ! solution error from sparse_easy_solve + outer_it_criterion, & ! current value of outer (nonlinear) loop converence criterion + outer_it_target ! target value for outer-loop convergence + + logical, save :: & + converged_soln = .false. ! true if we get a converged solution for velocity + + integer :: & + counter, & ! outer (nonlinear) iteration counter + niters ! linear iteration count from sparse_easy_solve + + integer :: nNonzeros ! number of nonzero matrix entries + + ! The following large matrix arrays are allocated for a 3D solve (SIA or BP) + + real(dp), dimension(:,:,:,:), allocatable :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (k,i,j) + + ! The following are used for the SLAP and Trilinos solvers + + integer :: & + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension(nz,nx-1,ny-1) :: & + nodeID ! local ID for each node where we solve for velocity + ! For periodic BCs (as in ISMIP-HOM), halo node IDs will be copied + ! from the other side of the grid + + integer, dimension((nx-1)*(ny-1)*nz) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + ! The following are used for the Trilinos solver only + + integer, dimension(nx-1,ny-1) :: & + global_vertex_id ! unique global IDs for vertices on this processor + + integer, dimension(nz,nx-1,ny-1) :: & + global_node_id ! unique global IDs for nodes on this processor + + integer, dimension(:), allocatable :: & + active_owned_unknown_map ! maps owned active unknowns (u and v at each active node) to global IDs + + logical, dimension(:,:,:,:), allocatable :: & + Afill ! true wherever the matrix value is potentially nonzero + + real(dp), dimension(:), allocatable :: & + velocityResult ! velocity solution vector from Trilinos + + ! The following are used for the SLAP solver only + + type(sparse_matrix_type) :: & + matrix ! sparse matrix for SLAP solver, defined in glimmer_sparse_types + ! includes nonzeroes, order, col, row, val + + real(dp), dimension(:), allocatable :: & ! for SLAP solver + rhs, & ! right-hand-side (b) in Ax = b + answer, & ! answer (x) in Ax = b + resid_vec ! residual vector Ax - b + + integer :: & + matrix_order, & ! order of matrix = number of rows + max_nonzeros ! upper bound for number of nonzero entries in sparse matrix + + ! The following arrays are used for a 2D matrix solve + ! (which_ho_approx = HO_APPROX_SSA or HO_APPROX_L1L2) + + logical :: & + solve_2d ! if true, solve 2D matrix (SSA or L1L2) + ! else solve 3D matrix (SIA or BP) + + integer :: & + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension(nx-1,ny-1) :: & + vertexID ! local ID for each vertex where we solve for velocity (in 2d) + + integer, dimension((nx-1)*(ny-1)) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + real(dp), dimension(nx-1,ny-1) :: & + uvel_2d, vvel_2d ! components of 2D velocity solution + ! (= basal velocity, for the 3D solution) + + real(dp), dimension(:,:,:), allocatable :: & + Auu_2d, Auv_2d, &! assembled stiffness matrix, divided into 4 parts + Avu_2d, Avv_2d ! 1st dimension = 9 (node and its nearest neighbors in x and y direction) + ! other dimensions = (i,j) + + real(dp), dimension(:,:), allocatable :: & + bu_2d, bv_2d, &! right-hand-side vector b, divided into 2 parts + loadu_2d, loadv_2d ! assembled load vector, divided into 2 parts + + real(dp), dimension(:,:), allocatable :: & + usav_2d, vsav_2d + + real(dp), dimension(:,:), allocatable :: & + resid_u_2d, resid_v_2d ! components of 2D solution residual + + logical, dimension(:,:,:), allocatable :: & + Afill_2d ! true wherever the matrix value is potentially nonzero + ! 2D Trilinos only + + real(dp) :: maxbeta, minbeta + integer :: i, j, k, m, n, r + integer :: iA, jA, kA + real(dp) :: maxthck, maxusrf + logical, parameter :: test_matrix = .false. +! logical, parameter :: test_matrix = .true. + integer, parameter :: test_order = 4 + + ! for trilinos test problem + logical, parameter :: test_trilinos = .false. +! logical, parameter :: test_trilinos = .true. + + call t_startf('glissade_vhs_init') + rtest = -999 + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + if (verbose .and. this_rank==rtest) then + print*, 'In glissade_velo_higher_solve' + print*, 'rank, itest, jtest, ktest =', rtest, itest, jtest, ktest + endif + +#ifdef TRILINOS + if (test_trilinos) then + call trilinos_test + stop + endif +#endif + + !-------------------------------------------------------- + ! Assign local pointers and variables to derived type components + !-------------------------------------------------------- + +! nx = model%general%ewn ! currently passed in +! ny = model%general%nsn +! nz = model%general%upn + + dx = model%numerics%dew + dy = model%numerics%dns + + sigma => model%numerics%sigma(:) + thck => model%geometry%thck(:,:) + usrf => model%geometry%usrf(:,:) + topg => model%geometry%topg(:,:) + f_ground => model%geometry%f_ground(:,:) + stagmask => model%geometry%stagmask(:,:) + + flwa => model%temper%flwa(:,:,:) + efvs => model%stress%efvs(:,:,:) + beta => model%velocity%beta(:,:) + bfricflx => model%temper%bfricflx(:,:) + bwat => model%temper%bwat(:,:) + mintauf => model%basalproc%mintauf(:,:) + + uvel => model%velocity%uvel(:,:,:) + vvel => model%velocity%vvel(:,:,:) + + resid_u => model%velocity%resid_u(:,:,:) + resid_v => model%velocity%resid_v(:,:,:) + bu => model%velocity%rhs_u(:,:,:) + bv => model%velocity%rhs_v(:,:,:) + + btractx => model%stress%btractx(:,:) + btracty => model%stress%btracty(:,:) + tau_xz => model%stress%tau%xz(:,:,:) + tau_yz => model%stress%tau%yz(:,:,:) + tau_xx => model%stress%tau%xx(:,:,:) + tau_yy => model%stress%tau%yy(:,:,:) + tau_xy => model%stress%tau%xy(:,:,:) + tau_eff => model%stress%tau%scalar(:,:,:) + + kinbcmask => model%velocity%kinbcmask(:,:) + + thklim = model%numerics%thklim + eus = model%climate%eus + ho_beta_const = model%paramets%ho_beta_const + efvs_constant = model%paramets%efvs_constant + + whichbabc = model%options%which_ho_babc + whichefvs = model%options%which_ho_efvs + whichresid = model%options%which_ho_resid + whichsparse = model%options%which_ho_sparse + whichapprox = model%options%which_ho_approx + whichprecond = model%options%which_ho_precond + whichgradient = model%options%which_ho_gradient + whichgradient_margin = model%options%which_ho_gradient_margin + whichassemble_beta = model%options%which_ho_assemble_beta + whichground = model%options%which_ho_ground + maxiter_nonlinear = model%options%glissade_maxiter + + !-------------------------------------------------------- + ! Convert input variables to appropriate units for this solver. + ! (Mainly SI, except that time units in flwa, velocities, + ! and beta are years instead of seconds) + !-------------------------------------------------------- + +!pw call t_startf('glissade_velo_higher_scale_input') + call glissade_velo_higher_scale_input(dx, dy, & + thck, usrf, & + topg, & + eus, thklim, & + flwa, efvs, & + bwat, mintauf, & + beta, ho_beta_const, & + uvel, vvel) +!pw call t_stopf('glissade_velo_higher_scale_input') + + ! Set volume scale + ! This is not strictly necessary, but dividing by this scale gives matrix coefficients + ! that are ~1. + + vol0 = 1.0d9 ! volume scale (m^3) + + if (whichapprox == HO_APPROX_SIA) then ! SIA +!! if (verbose .and. main_task) print*, 'Solving shallow-ice approximation' + if (main_task) print*, 'Solving shallow-ice approximation' + + elseif (whichapprox == HO_APPROX_SSA) then ! SSA +!! if (verbose .and. main_task) print*, 'Solving shallow-shelf approximation' + if (main_task) print*, 'Solving shallow-shelf approximation' + + elseif (whichapprox == HO_APPROX_L1L2) then ! L1L2 +!! if (verbose .and. main_task) print*, 'Solving shallow-shelf approximation' + if (main_task) print*, 'Solving depth-integrated L1L2 approximation' + + else ! Blatter-Pattyn higher-order +!! if (verbose .and. main_task) print*, 'Solving Blatter-Pattyn higher-order approximation' + if (main_task) print*, 'Solving Blatter-Pattyn higher-order approximation' + endif + + ! initialize 2D velocity to basal 3D velocity + uvel_2d(:,:) = uvel(nz,:,:) + vvel_2d(:,:) = vvel(nz,:,:) + + if (whichapprox == HO_APPROX_SSA .or. whichapprox == HO_APPROX_L1L2) then ! 2D assemble/solve + solve_2d = .true. + else ! 3D assemble/solve + solve_2d = .false. + endif + + if (solve_2d) then + ! allocate 2D arrays needed for the SSA or L1L2 solve + allocate(Auu_2d(nNodeNeighbors_2d,nx-1,ny-1)) + allocate(Auv_2d(nNodeNeighbors_2d,nx-1,ny-1)) + allocate(Avu_2d(nNodeNeighbors_2d,nx-1,ny-1)) + allocate(Avv_2d(nNodeNeighbors_2d,nx-1,ny-1)) + allocate(bu_2d(nx-1,ny-1)) + allocate(bv_2d(nx-1,ny-1)) + allocate(loadu_2d(nx-1,ny-1)) + allocate(loadv_2d(nx-1,ny-1)) + allocate(usav_2d(nx-1,ny-1)) + allocate(vsav_2d(nx-1,ny-1)) + allocate(resid_u_2d(nx-1,ny-1)) + allocate(resid_v_2d(nx-1,ny-1)) + endif + + if (.not.solve_2d) then + ! These are big, so do not allocate them for a 2D solve + allocate(Auu(nNodeNeighbors_3d,nz,nx-1,ny-1)) + allocate(Auv(nNodeNeighbors_3d,nz,nx-1,ny-1)) + allocate(Avu(nNodeNeighbors_3d,nz,nx-1,ny-1)) + allocate(Avv(nNodeNeighbors_3d,nz,nx-1,ny-1)) + endif + + if (test_matrix) then + if (whichsparse <= HO_SPARSE_GMRES) then ! this test works for SLAP solver only + call slap_solve_test_matrix(test_order, whichsparse) + else + print*, 'Invalid value for whichsparse with test_matrix subroutine' + stop + endif + endif + + ! Make sure that the geometry and flow factor are correct in halo cells. + ! These calls are commented out, since the halo updates are done in + ! module glissade.F90, before calling glissade_velo_higher_solve. + +! call parallel_halo(thck) +! call parallel_halo(topg) +! call parallel_halo(usrf) +! call parallel_halo(flwa) + +! if (whichbabc == HO_BABC_YIELD_PICARD) then +! call staggered_parallel_halo(mintauf) +! call staggered_parallel_halo_extrapolate(mintauf) +! endif + + !------------------------------------------------------------------------------ + ! Setup for higher-order solver: Compute nodal geometry, allocate storage, etc. + ! These are quantities that do not change during the outer nonlinear loop. + !------------------------------------------------------------------------------ + + if (verbose_state) then + maxthck = maxval(thck(:,:)) + maxthck = parallel_reduce_max(maxthck) + maxusrf = maxval(usrf(:,:)) + maxusrf = parallel_reduce_max(maxusrf) + + if (this_rank==rtest) then + + print*, ' ' + print*, 'nx, ny, nz:', nx, ny, nz + print*, 'vol0:', vol0 + print*, 'thklim:', thklim + print*, 'max thck, usrf:', maxthck, maxusrf + + print*, 'sigma coordinate:' + do k = 1, nz + print*, k, sigma(k) + enddo + + print*, ' ' + print*, 'Thickness field, rank =', rtest + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f6.0)',advance='no') thck(i,j) + enddo + write(6,*) ' ' + enddo + + print*, ' ' + print*, 'Topography field, rank =', rtest + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f6.0)',advance='no') topg(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + + print*, 'Upper surface field, rank =', rtest + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f6.0)',advance='no') usrf(i,j) + enddo + write(6,*) ' ' + enddo + + print*, ' ' + print*, 'flwa (Pa-3 yr-1), k = 1, rank =', rtest + do j = ny, 1, -1 + do i = 1, nx + write(6,'(e12.5)',advance='no') flwa(1,i,j) + enddo + write(6,*) ' ' + enddo + + endif ! this_rank + endif ! verbose_state + + !------------------------------------------------------------------------------ + ! Specify Dirichlet boundary conditions (prescribed uvel and vvel) + !------------------------------------------------------------------------------ + + ! initialize + umask_dirichlet(:,:,:) = .false. + + if (whichbabc == HO_BABC_NO_SLIP) then + ! Impose zero sliding everywhere at the bed. + umask_dirichlet(nz,:,:) = .true. ! u = v = 0 at bed + endif + + ! set mask in columns identified in kinbcmask, typically read from file at initialization + do j = 1,ny-1 + do i = 1, nx-1 + if (kinbcmask(i,j) == 1) then + umask_dirichlet(:,i,j) = .true. + endif + enddo + enddo + + if (verbose_dirichlet .and. this_rank==rtest) then + print*, ' ' + print*, 'umask_dirichlet, k = 1 and nz, j =', jtest + j = jtest + do i = 1, nx-1 + write(6,'(i4,2L3)') i, umask_dirichlet(1,i,j), umask_dirichlet(nz,i,j) + enddo + + print*, ' ' + print*, 'uvel, k = 1 and nz, j =', jtest + do i = 1, nx-1 + write(6,'(i4,2f12.6)') i, uvel(1,i,j), uvel(nz,i,j) + enddo + + print*, ' ' + print*, 'vvel, k = 1 and nz, j =', jtest + do i = 1, nx-1 + write(6,'(i4,2f12.6)') i, vvel(1,i,j), vvel(nz,i,j) + enddo + endif ! verbose_dirichlet + + !------------------------------------------------------------------------------ + ! Compute masks: + ! (1) ice mask = 1 in cells where ice is present (thck > thklim), = 0 elsewhere + ! (2) floating mask = 1 in cells where ice is present and is floating + ! (3) ocean mask = = 1 in cells where topography is below sea level and ice is absent + ! (4) land mask = 1 in cells where topography is at or above sea level + !------------------------------------------------------------------------------ + + call glissade_get_masks(nx, ny, & + thck, topg, & + eus, thklim, & + ice_mask, floating_mask, & + ocean_mask, land_mask) + + !------------------------------------------------------------------------------ + ! Compute fraction of grounded ice in each cell + ! (requires that thck and topg are up to date in halo cells). + ! This is used below to compute the basal stress BC. + ! + ! Three cases for whichground: + ! (0) HO_GROUND_NO_GLP: f_ground = 0 or 1 based on flotation criterion + ! (1) HO_GROUND_GLP: 0 <= f_ground <= 1 based on grounding-line parameterization + ! (2) HO_GROUND_ALL: f_ground = 1 for all cells with ice + ! + ! f_ground is set to a non-physical value of -1 in cells without ice + ! + ! NOTE: The grounding line scheme is not yet scientifically supported; + ! fground is computed here but is not used in matrix assembly. + ! TODO - Incorporate fground in matrix assembly. + !------------------------------------------------------------------------------ + + call glissade_grounded_fraction(nx, ny, & + thck, topg, & + eus, ice_mask, & + whichground, f_ground) + + if (verbose_state .and. this_rank==rtest) then + print*, ' ' + print*, 'f_ground, rank =', rtest + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f5.2)',advance='no') f_ground(i,j) + enddo + print*, ' ' + enddo + endif + + !------------------------------------------------------------------------------ + ! Compute ice thickness and upper surface on staggered grid + ! (requires that thck and usrf are up to date in halo cells). + ! For stagger_margin_in = 0, all cells (including ice-free) are included in interpolation. + ! For stagger_margin_in = 1, only ice-covered cells are included. + !------------------------------------------------------------------------------ + +!pw call t_startf('glissade_stagger') + call glissade_stagger(nx, ny, & + thck, stagthck, & + ice_mask, stagger_margin_in = 1) + + call glissade_stagger(nx, ny, & + usrf, stagusrf, & + ice_mask, stagger_margin_in = 1) +!pw call t_stopf('glissade_stagger') + + !------------------------------------------------------------------------------ + ! Compute surface gradient on staggered grid + ! (requires that usrf is up to date in halo cells) + ! + ! Setting gradient_margin_in = 0 takes the gradient over all neighboring cells, + ! including ice-free cells. This is what Glide does, but is not appropriate + ! if we have ice-covered floating cells next to ice-free ocean cells, + ! because the gradient will be too big. + ! Setting gradient_margin_in = 1 uses any available ice-covered cells + ! and/or land cells to compute the gradient. Requires a land mask. + ! This is appropriate for both land-based problems and problems + ! with ice shelves. It is the default setting. + ! Setting gradient_margin_in = 2 uses only ice-covered cells to compute + ! the gradient. This is appropriate for problems with ice shelves, but is + ! is less accurate than options 0 or 1 for land-based problems (e.g., Halfar SIA). + ! + ! Both the centered and upstream gradients are 2nd order accurate in space. + ! The upstream gradient may be preferable for evolution problems using + ! whichapprox = HO_APPROX_BP or HO_APPROX_SIA, because in these cases + ! the centered gradient fails to cancel checkerboard noise. + ! The L1L2 solver computes 3D velocities in a way that damps checkerboard noise, + ! so a centered difference works well (and for the Halfar problem is more + ! accurate than upstream). + !------------------------------------------------------------------------------ + +!pw call t_startf('glissade_gradient') + + if (whichgradient == HO_GRADIENT_CENTERED) then ! 2nd order centered + + call glissade_centered_gradient(nx, ny, & + dx, dy, & + usrf, & + dusrf_dx, dusrf_dy, & + ice_mask, & + gradient_margin_in = whichgradient_margin, & + land_mask = land_mask) + + else ! 2nd order upstream + + call glissade_upstream_gradient(nx, ny, & + dx, dy, & + usrf, & + dusrf_dx, dusrf_dy, & + ice_mask, & + accuracy_flag_in = 2, & + gradient_margin_in = whichgradient_margin, & + land_mask = land_mask) + + endif ! whichgradient + +!pw call t_stopf('glissade_gradient') + + if (verbose_gridop .and. this_rank==rtest) then + + print*, ' ' + print*, 'thck:' + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f7.0)',advance='no') thck(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'stagthck, rank =',rtest + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f7.0)',advance='no') stagthck(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'usrf:' + do j = ny, 1, -1 + do i = 1, nx + write(6,'(f7.0)',advance='no') usrf(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'dusrf_dx:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f7.3)',advance='no') dusrf_dx(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'dusrf_dy:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(f7.3)',advance='no') dusrf_dy(i,j) + enddo + print*, ' ' + enddo + + endif ! verbose_gridop + + !------------------------------------------------------------------------------ + ! Compute the vertices of each element. + ! Identify the active cells (i.e., cells with thck > thklim, + ! bordering a locally owned vertex) and active vertices (all vertices + ! of active cells). + ! Count the number of owned active nodes on this processor, and assign a + ! unique local ID to each such node. + !TODO - Move Trilinos- and SLAP-specific computations to a different subroutine? + !------------------------------------------------------------------------------ + +!pw call t_startf('glissade_get_vertex_geom') + call get_vertex_geometry(nx, ny, & + nz, nhalo, & + dx, dy, & + ice_mask, & + xVertex, yVertex, & + active_cell, active_vertex, & + nNodesSolve, nVerticesSolve, & + nodeID, vertexID, & + iNodeIndex, jNodeIndex, kNodeIndex, & + iVertexIndex, jVertexIndex) +!pw call t_stopf('glissade_get_vertex_geom') + + ! Assign the appropriate local ID to vertices and nodes in the halo. + ! NOTE: This works for single-processor runs with periodic BCs + ! (e.g., ISMIP-HOM), but not for multiple processors. + + call t_startf('glissade_halo_nodeID') + call staggered_parallel_halo(nodeID) + call staggered_parallel_halo(vertexID) + call t_stopf('glissade_halo_nodeID') + + if (verbose_id .and. this_rank==rtest) then + print*, ' ' + print*, 'vertexID before after halo update:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(i5)',advance='no') vertexID(i,j) + enddo + print*, ' ' + enddo + print*, ' ' + print*, 'nodeID after halo update, k = 1:' + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(i5)',advance='no') nodeID(1,i,j) + enddo + print*, ' ' + enddo + endif + + ! Initialization for the Trilinos solver + ! Allocate arrays, initialize the velocity solution, compute an array + ! that maps the local index for owned active nodes to a unique global ID, + ! and communicate this array to Trilinos + +#ifdef TRILINOS + if (whichsparse == HO_SPARSE_TRILINOS) then + + if (solve_2d) then + + allocate(active_owned_unknown_map(2*nVerticesSolve)) + allocate(velocityResult(2*nVerticesSolve)) + allocate(Afill_2d(nNodeNeighbors_2d,nx-1,ny-1)) + + !---------------------------------------------------------------- + ! Compute global IDs needed to initialize the Trilinos solver + !---------------------------------------------------------------- + + call t_startf('glissade_trilinos_glbid') + call trilinos_global_id_2d(nx, ny, & + nVerticesSolve, & + iVertexIndex, jVertexIndex, & + global_vertex_id, & + active_owned_unknown_map) + call t_stopf('glissade_trilinos_glbid') + + !---------------------------------------------------------------- + ! Send this information to Trilinos (trilinosGlissadeSolver.cpp) + !---------------------------------------------------------------- + + call t_startf('glissade_init_tgs') + call initializetgs(2*nVerticesSolve, active_owned_unknown_map, comm) + call t_stopf('glissade_init_tgs') + + !---------------------------------------------------------------- + ! If this is the first outer iteration, then save the pattern of matrix + ! values that are potentially nonzero and should be sent to Trilinos. + ! Trilinos requires that this pattern remains fixed during the outer loop. + !---------------------------------------------------------------- + + call t_startf('glissade_trilinos_fill_pattern') + call trilinos_fill_pattern_2d(nx, ny, & + active_vertex, nVerticesSolve, & + iVertexIndex, jVertexIndex, & + indxA_2d, Afill_2d) + call t_stopf('glissade_trilinos_fill_pattern') + + !---------------------------------------------------------------- + ! Initialize the solution vector from uvel/vvel. + !---------------------------------------------------------------- + + call trilinos_init_velocity_2d(nx, ny, & + nVerticesSolve, & + iNodeIndex, jNodeIndex, & + uvel_2d, vvel_2d, & + velocityResult) + + else ! 3D solve + + allocate(active_owned_unknown_map(2*nNodesSolve)) + allocate(velocityResult(2*nNodesSolve)) + allocate(Afill(nNodeNeighbors_3d,nz,nx-1,ny-1)) + + !---------------------------------------------------------------- + ! Compute global IDs needed to initialize the Trilinos solver + !---------------------------------------------------------------- + + call t_startf('glissade_trilinos_glbid') + call trilinos_global_id_3d(nx, ny, nz, & + nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + global_node_id, & + active_owned_unknown_map) + call t_stopf('glissade_trilinos_glbid') + + !---------------------------------------------------------------- + ! Send this information to Trilinos (trilinosGlissadeSolver.cpp) + !---------------------------------------------------------------- + + call t_startf('glissade_init_tgs') + call initializetgs(2*nNodesSolve, active_owned_unknown_map, comm) + call t_stopf('glissade_init_tgs') + + !---------------------------------------------------------------- + ! If this is the first outer iteration, then save the pattern of matrix + ! values that are potentially nonzero and should be sent to Trilinos. + ! Trilinos requires that this pattern remains fixed during the outer loop. + !---------------------------------------------------------------- + + call t_startf('glissade_trilinos_fill_pattern') + call trilinos_fill_pattern_3d(nx, ny, nz, & + active_vertex, nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + indxA_3d, Afill) + + call t_stopf('glissade_trilinos_fill_pattern') + + !---------------------------------------------------------------- + ! Initialize the solution vector from uvel/vvel. + !---------------------------------------------------------------- + + call trilinos_init_velocity_3d(nx, ny, & + nz, nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + uvel, vvel, & + velocityResult) + + endif ! whichapprox + endif ! whichsparse +#endif + + !------------------------------------------------------------------------------ + ! Initialize the basal traction parameter beta. + ! Note: beta is either read from an external file, or computed by calling calcbeta below. + ! For external beta (HO_BABC_EXTERNAL_BETA), we should not reinitialize here. + ! For a no-slip boundary condition (HO_BABC_NO_SLIP), beta is not computed, + ! so beta = 0 will be written to output. + !------------------------------------------------------------------------------ + + if (whichbabc /= HO_BABC_EXTERNAL_BETA) then + beta(:,:) = 0.d0 + endif + + !------------------------------------------------------------------------------ + ! Compute the factor A^(-1/n) appearing in the expression for effective viscosity. + ! This factor is often denoted as B in the literature. + ! Note: The rate factor (flwa = A) is assumed to have units of Pa^(-n) yr^(-1). + ! Thus flwafact = 0.5 * A^(-1/n) has units Pa yr^(1/n). + !------------------------------------------------------------------------------ + + flwafact(:,:,:) = 0.d0 + + ! Loop over all cells that border locally owned vertices + !TODO - Simply compute for all cells? We should have flwa for all cells. + + do j = 1+nhalo, ny-nhalo+1 + do i = 1+nhalo, nx-nhalo+1 + if (active_cell(i,j)) then + ! gn = exponent in Glen's flow law (= 3 by default) + flwafact(:,i,j) = 0.5d0 * flwa(:,i,j)**(-1.d0/real(gn,dp)) + endif + enddo + enddo + + !------------------------------------------------------------------------------ + ! If using SLAP solver, then allocate space for the sparse matrix (A), rhs (b), + ! answer (x), and residual vector (Ax-b). + !------------------------------------------------------------------------------ + + if (whichsparse <= HO_SPARSE_GMRES) then ! using SLAP solver + + if (solve_2d) then + matrix_order = 2*nVerticesSolve + max_nonzeros = matrix_order*2*nNodeNeighbors_2d ! nNodeNeighbors_2d = 9 + ! 18 = 2 * 9 (since solving for both u and v) + else ! 3D solve + matrix_order = 2*nNodesSolve + max_nonzeros = matrix_order*2*nNodeNeighbors_3d ! nNodeNeighbors_3d = 27 + ! 54 = 2 * 27 (since solving for both u and v) + endif + + allocate(matrix%row(max_nonzeros), matrix%col(max_nonzeros), matrix%val(max_nonzeros)) + allocate(rhs(matrix_order), answer(matrix_order), resid_vec(matrix_order)) + + answer(:) = 0.d0 + rhs(:) = 0.d0 + resid_vec(:) = 0.d0 + + if (verbose_matrix) then + print*, 'matrix_order =', matrix_order + print*, 'max_nonzeros = ', max_nonzeros + endif + + endif ! SLAP solver + + !--------------------------------------------------------------- + ! Print some diagnostic info + !--------------------------------------------------------------- + + if (main_task) then + print *, ' ' + print *, 'Running Glissade higher-order dynamics solver' + print *, ' ' + if (whichresid == HO_RESID_L2NORM) then ! use L2 norm of residual + print *, 'iter # resid (L2 norm) target resid' + elseif (whichresid == HO_RESID_L2NORM_RELATIVE) then ! relative residual, |Ax-b|/|b| + print *, 'iter # resid, |Ax-b|/|b| target resid' + else ! residual based on velocity + print *, 'iter # velo resid target resid' + end if + print *, ' ' + endif + + !------------------------------------------------------------------------------ + ! Set initial solver values + !------------------------------------------------------------------------------ + + counter = 0 + resid_velo = 1.d0 + + L2_norm = 1.0d20 ! arbitrary large value + L2_target = 1.0d-4 + + !WHL: For standard test cases (dome, circular shelf), a relative target of 1.0d-7 is + ! roughly as stringent as an absolute target of 1.0d-4. + ! + L2_norm_relative = 1.0d20 + L2_target_relative = 1.0d-7 + + outer_it_criterion = 1.0d10 ! guarantees at least one loop + outer_it_target = 1.0d-12 + + !------------------------------------------------------------------------------ + ! Assemble the load vector b + ! This goes before the outer loop because the load vector + ! does not change from one nonlinear iteration to the next. + !------------------------------------------------------------------------------ + + loadu(:,:,:) = 0.d0 + loadv(:,:,:) = 0.d0 + + !------------------------------------------------------------------------------ + ! Gravitational forcing + !------------------------------------------------------------------------------ + + call t_startf('glissade_load_vector_gravity') + + call load_vector_gravity(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + dusrf_dx, dusrf_dy, & + loadu, loadv) + + call t_stopf('glissade_load_vector_gravity') + + !------------------------------------------------------------------------------ + ! Lateral pressure at vertical ice edge + !------------------------------------------------------------------------------ + + call t_startf('glissade_load_vector_lateral_bc') + call load_vector_lateral_bc(nx, ny, & + nz, sigma, & + nhalo, & + floating_mask, ocean_mask, & + active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + loadu, loadv) + call t_stopf('glissade_load_vector_lateral_bc') + + call t_stopf('glissade_vhs_init') + + !------------------------------------------------------------------------------ + ! If solving a 2D problem (e.g., SSA at one level), sum the load vector over columns. + ! Note: It would be slightly more efficient to compute the load vector at a single level + ! using custom 2D subroutines. However, this would require extra code and would + ! save little work, since the load vector is computed only once per timestep. + !------------------------------------------------------------------------------ + + if (solve_2d) then + + loadu_2d(:,:) = 0.d0 + loadv_2d(:,:) = 0.d0 + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + loadu_2d(i,j) = loadu_2d(i,j) + loadu(k,i,j) + loadv_2d(i,j) = loadv_2d(i,j) + loadv(k,i,j) + enddo + enddo + enddo + + endif + + !------------------------------------------------------------------------------ + ! Main outer loop: Iterate to solve the nonlinear problem + !------------------------------------------------------------------------------ + + call t_startf('glissade_vhs_nonlinear_loop') + do while (outer_it_criterion >= outer_it_target .and. counter < maxiter_nonlinear) + + ! Advance the iteration counter + + counter = counter + 1 + + !--------------------------------------------------------------------------- + ! Compute or prescribe the basal traction field 'beta'. + ! + ! Note: We could compute beta before the main outer loop if beta + ! were assumed to be independent of velocity. Computing beta here, + ! however, allows for more general sliding laws. + ! Note: The input value of model%velocity%beta can change depending on + ! the value of model%options%which_ho_babc. + ! Note: The units of the input arguments in calcbeta are assumed to be the + ! same as the Glissade units. + !------------------------------------------------------------------- + + ! For 3D solve, copy basal velocity into uvel_2d and vvel_2d + if (.not. solve_2d) then + uvel_2d(:,:) = uvel(nz,:,:) + vvel_2d(:,:) = vvel(nz,:,:) + endif + + call calcbeta (whichbabc, & + dx, dy, & + nx, ny, & + uvel_2d, vvel_2d, & + bwat, ho_beta_const, & + mintauf, & + model%basal_physics, & + flwa(nz-1,:,:), & ! basal flwa layer + thck, & + stagmask, beta) + + call staggered_parallel_halo(beta) + + if (verbose_beta) then + maxbeta = maxval(beta(:,:)) + maxbeta = parallel_reduce_max(maxbeta) + minbeta = minval(beta(:,:)) + minbeta = parallel_reduce_min(minbeta) + endif + + if (verbose_beta .and. main_task) then + print*, ' ' + print*, 'beta field, rank =', rtest + do j = ny-1, 1, -1 + do i = 1, nx-1 + write(6,'(e10.3)',advance='no') beta(i,j) + enddo + write(6,*) ' ' + enddo + print*, ' ' + print*, 'max, min beta (Pa/(m/yr)) =', maxbeta, minbeta + endif + + !------------------------------------------------------------------- + ! Assemble the linear system Ax = b + ! + ! Depending on the value of whichapprox, we can assemble either a 2D system + ! (to solve for uvel and vvel at one level) or a 3D system (to solve for + ! uvel and vvel at all levels). + !------------------------------------------------------------------- + + if (solve_2d) then ! assemble 2D matrix + + ! save current velocity + usav_2d(:,:) = uvel_2d(:,:) + vsav_2d(:,:) = vvel_2d(:,:) + + call assemble_stiffness_matrix_2d(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel_2d, vvel_2d, & + stagusrf, stagthck, & + dusrf_dx, dusrf_dy, & + flwa, flwafact, & + whichapprox, & + whichefvs, efvs_constant, & + efvs, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d) + + if (verbose_matrix .and. this_rank==rtest) print*, 'Assembled the stiffness matrix' + + !--------------------------------------------------------------------------- + ! Incorporate basal sliding boundary conditions + !--------------------------------------------------------------------------- + + call basal_sliding_bc(nx, ny, & + nNodeNeighbors_2d, nhalo, & + active_cell, beta, & + xVertex, yVertex, & + whichassemble_beta, & + Auu_2d, Avv_2d) + + !--------------------------------------------------------------------------- + ! Set rhs to the load vector + ! The rhs can be adjusted below to account for inhomogeneous Dirichlet BC + !--------------------------------------------------------------------------- + + bu_2d(:,:) = loadu_2d(:,:) + bv_2d(:,:) = loadv_2d(:,:) + + !--------------------------------------------------------------------------- + ! Incorporate Dirichlet boundary conditions (prescribed uvel and vvel) + !--------------------------------------------------------------------------- + + if (verbose_dirichlet .and. main_task) then + print*, 'Call Dirichlet_bc' + endif + + call dirichlet_boundary_conditions_2d(nx, ny, & + nhalo, & + active_vertex, umask_dirichlet(nz,:,:), & + uvel_2d, vvel_2d, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d) + + !--------------------------------------------------------------------------- + ! Halo updates for matrices + ! + ! These updates are not strictly necessary unless we're concerned about + ! roundoff errors. See comments below under 3D assembly. + !--------------------------------------------------------------------------- + + call t_startf('glissade_halo_Axxs') + call staggered_parallel_halo(Auu_2d(:,:,:)) + call staggered_parallel_halo(Auv_2d(:,:,:)) + call staggered_parallel_halo(Avu_2d(:,:,:)) + call staggered_parallel_halo(Avv_2d(:,:,:)) + call t_stopf('glissade_halo_Axxs') + + !--------------------------------------------------------------------------- + ! Halo updates for rhs vectors + ! (Not sure if these are necessary, but leaving them for now) + !--------------------------------------------------------------------------- + + call t_startf('glissade_halo_bxxs') + call staggered_parallel_halo(bu_2d(:,:)) + call staggered_parallel_halo(bv_2d(:,:)) + call t_stopf('glissade_halo_bxxs') + + !--------------------------------------------------------------------------- + ! Check symmetry of assembled matrix + ! + ! There may be small differences from perfect symmetry due to roundoff errors. + ! If sufficiently small, these differences are fixed by averaging the two values + ! that should be symmetric. Otherwise the code aborts. + !--------------------------------------------------------------------------- + + if (check_symmetry) then + + call t_startf('glissade_chk_symmetry') + call check_symmetry_assembled_matrix_2d(nx, ny, & + nhalo, & + active_vertex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d) + call t_stopf('glissade_chk_symmetry') + + endif + + !--------------------------------------------------------------------------- + ! Count the total number of nonzero entries on all processors. + !--------------------------------------------------------------------------- + + call count_nonzeros_2d(nx, ny, & + nhalo, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + active_vertex, & + nNonzeros) + + if (write_matrix) then + if (counter == 1) then ! first outer iteration only + + call t_startf('glissade_wrt_mat') + call write_matrix_elements_2d(nx, ny, & + nVerticesSolve, vertexID, & + iVertexIndex, jVertexIndex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d) + call t_stopf('glissade_wrt_mat') + + endif + endif ! write_matrix + + if (verbose_matrix .and. this_rank==rtest) then + i = itest + j = jtest + r = rtest + print*, ' ' + print*, 'i,j =', i, j + print*, 'Auu_2d sum =', sum(Auu_2d(:,i,j)) + print*, 'Auv_2d sum =', sum(Auv_2d(:,i,j)) + print*, 'Avu_2d sum =', sum(Avu_2d(:,i,j)) + print*, 'Avv_2d sum =', sum(Avv_2d(:,i,j)) + + print*, ' ' + print*, 'iA, jA, Auu_2d, Auv_2d, Avu_2d, Avv_2d:' + do jA = -1, 1 + do iA = -1, 1 + m = indxA_2d(iA,jA) + print*, iA, jA, Auu_2d(m,i,j), Auv_2d(m,i,j), Avu_2d(m,i,j), Avv_2d(m,i,j) + enddo + enddo + + print*, 'bu_2d =', bu_2d(i,j) + print*, 'bv_2d =', bv_2d(i,j) + + j = jtest + m = indxA_2d(0,0) ! diag entry + print*, ' ' + print*, 'Matrix row properties, j =', j + print*, ' ' + print*, 'i, diag, max, min, sum:' + do i = 1, nx-1 + print*, ' ' + write(6,'(a4, i4, 4f16.8)') 'Auu_2d:', i, Auu_2d(m,i,j), maxval(Auu_2d(:,i,j)), & + minval(Auu_2d(:,i,j)), sum(Auu_2d(:,i,j)) + write(6,'(a4, i4, 4f16.8)') 'Auv_2d:', i, Auv_2d(m,i,j), maxval(Auv_2d(:,i,j)), & + minval(Auv_2d(:,i,j)), sum(Auv_2d(:,i,j)) + enddo + + endif ! verbose_matrix + + else ! assemble 3D matrix + + ! save current velocity + usav(:,:,:) = uvel(:,:,:) + vsav(:,:,:) = vvel(:,:,:) + + !--------------------------------------------------------------------------- + ! Assemble the stiffness matrix A + !--------------------------------------------------------------------------- + + call t_startf('glissade_assemble_stiffness_mat') + + call assemble_stiffness_matrix_3d(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel, vvel, & + stagusrf, stagthck, & + flwafact, whichapprox, & + efvs, whichefvs, & + efvs_constant, & + Auu, Auv, & + Avu, Avv) + + call t_stopf('glissade_assemble_stiffness_mat') + + if (verbose_matrix .and. this_rank==rtest) print*, 'Assembled the stiffness matrix' + + !--------------------------------------------------------------------------- + ! Incorporate basal sliding boundary conditions + !--------------------------------------------------------------------------- + + if (whichbabc /= HO_BABC_NO_SLIP) then + + call basal_sliding_bc(nx, ny, & + nNodeNeighbors_3d, nhalo, & + active_cell, beta, & + xVertex, yVertex, & + whichassemble_beta, & + Auu(:,nz,:,:), Avv(:,nz,:,:)) + + endif ! whichbabc + + !--------------------------------------------------------------------------- + ! Set rhs to the load vector + ! The rhs can be adjusted below to account for inhomogeneous Dirichlet BC + !--------------------------------------------------------------------------- + + bu(:,:,:) = loadu(:,:,:) + bv(:,:,:) = loadv(:,:,:) + + !--------------------------------------------------------------------------- + ! Incorporate Dirichlet boundary conditions (prescribed uvel and vvel) + !--------------------------------------------------------------------------- + + if (verbose_dirichlet .and. main_task) print*, 'Call Dirichlet_bc' + + call dirichlet_boundary_conditions_3d(nx, ny, & + nz, nhalo, & + active_vertex, umask_dirichlet, & + uvel, vvel, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + !--------------------------------------------------------------------------- + ! Halo updates for matrices + ! + ! These updates are not strictly necessary unless we're concerned about + ! roundoff errors. + ! But suppose we are comparing two entries that are supposed to be equal + ! (e.g., to preserve symmetry), where entry 1 is owned by processor A and + ! entry 2 is owned by processor B. + ! Processor A might compute a local version of entry 2 in its halo, with + ! entry 2 = entry 1 locally. But processor B's entry 2 might be different + ! because of roundoff. Then we need to make sure that processor B's value + ! is communicated to processor A. If these values are slightly different, + ! they will be reconciled by the subroutine check_symmetry_assembled_matrix. + !--------------------------------------------------------------------------- + + call t_startf('glissade_halo_Axxs') + call staggered_parallel_halo(Auu(:,:,:,:)) + call staggered_parallel_halo(Auv(:,:,:,:)) + call staggered_parallel_halo(Avu(:,:,:,:)) + call staggered_parallel_halo(Avv(:,:,:,:)) + call t_stopf('glissade_halo_Axxs') + + !--------------------------------------------------------------------------- + ! Halo updates for rhs vectors + ! (Not sure if these are necessary, but leaving them for now) + !--------------------------------------------------------------------------- + + call t_startf('glissade_halo_bxxs') + call staggered_parallel_halo(bu(:,:,:)) + call staggered_parallel_halo(bv(:,:,:)) + call t_stopf('glissade_halo_bxxs') + + !--------------------------------------------------------------------------- + ! Check symmetry of assembled matrix + ! + ! There may be small differences from perfect symmetry due to roundoff errors. + ! If sufficiently small, these differences are fixed by averaging the two values + ! that should be symmetric. Otherwise the code aborts. + ! + ! Note: It might be OK to skip this check for production code. However, + ! small violations of symmetry are not tolerated well by some solvers. + ! For example, the SLAP PCG solver with incomplete Cholesky preconditioning + ! can crash if symmetry is not perfect. + !--------------------------------------------------------------------------- + + if (check_symmetry) then + + call t_startf('glissade_chk_symmetry') + call check_symmetry_assembled_matrix_3d(nx, ny, & + nz, nhalo, & + active_vertex, & + Auu, Auv, & + Avu, Avv) + call t_stopf('glissade_chk_symmetry') + + endif + + !--------------------------------------------------------------------------- + ! Count the total number of nonzero entries on all processors. + !--------------------------------------------------------------------------- + + call count_nonzeros_3d(nx, ny, & + nz, nhalo, & + Auu, Auv, & + Avu, Avv, & + active_vertex, & + nNonzeros) + + if (write_matrix) then + if (counter == 1) then ! first outer iteration only + + call t_startf('glissade_wrt_mat') + call write_matrix_elements_3d(nx, ny, nz, & + nNodesSolve, nodeID, & + iNodeIndex, jNodeIndex, kNodeIndex, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + call t_stopf('glissade_wrt_mat') + + endif + endif ! write_matrix + + if (verbose_matrix .and. this_rank==rtest) then + i = itest + j = jtest + k = ktest + + print*, ' ' + print*, 'i,j,k =', i, j, k + print*, 'Auu sum =', sum(Auu(:,k,i,j)) + print*, 'Auv sum =', sum(Auv(:,k,i,j)) + print*, 'Avu sum =', sum(Avu(:,k,i,j)) + print*, 'Avv sum =', sum(Avv(:,k,i,j)) + + print*, ' ' + print*, 'iA, jA, kA, Auu, Auv, Avu, Avv:' + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + m = indxA_3d(iA,jA,kA) + print*, iA, jA, kA, Auu(m,k,i,j), Auv(m,k,i,j), Avu(m,k,i,j), Avv(m,k,i,j) + enddo + enddo + enddo + + print*, 'i, j, k: ', i, j, k + print*, 'bu =', bu(k,i,j) + print*, 'bv =', bv(k,i,j) + + j = jtest + k = ktest + m = indxA_3d(0,0,0) ! diag entry + print*, ' ' + print*, 'Matrix row properties, j, k =', j, k + print*, ' ' + print*, 'i, diag, max, min, sum:' + do i = 1, nx-1 + print*, ' ' + write(6,'(a4, i4, 4f16.8)') 'Auu:', i, Auu(m,k,i,j), maxval(Auu(:,k,i,j)), minval(Auu(:,k,i,j)), sum(Auu(:,k,i,j)) + write(6,'(a4, i4, 4f16.8)') 'Auv:', i, Auv(m,k,i,j), maxval(Auv(:,k,i,j)), minval(Auv(:,k,i,j)), sum(Auv(:,k,i,j)) + enddo + + endif ! verbose_matrix + + endif ! whichapprox + + !--------------------------------------------------------------------------- + ! If the matrix has no nonzero entries, then set velocities to zero and exit the solver. + !--------------------------------------------------------------------------- + + if (verbose_matrix .and. main_task) print*, 'nNonzeros in matrix =', nNonzeros + + if (nNonzeros == 0) then ! clean up and return + + resid_u(:,:,:) = 0.d0 + resid_v(:,:,:) = 0.d0 + bu(:,:,:) = 0.d0 + bv(:,:,:) = 0.d0 + uvel(:,:,:) = 0.d0 + vvel(:,:,:) = 0.d0 + + call t_startf('glissade_velo_higher_scale_outp') + call glissade_velo_higher_scale_output(thck, usrf, & + topg, & + flwa, efvs, & + bwat, mintauf, & + beta, & + resid_u, resid_v, & + bu, bv, & + uvel, vvel, & + btractx, btracty, & + tau_xz, tau_yz, & + tau_xx, tau_yy, & + tau_xy, tau_eff) + call t_stopf('glissade_velo_higher_scale_outp') + + if (main_task) print*, 'No nonzeros in matrix; exit glissade_velo_higher_solve' + return + + endif ! nNonzeros = 0 + + !--------------------------------------------------------------------------- + ! Solve the 2D or 3D matrix system. + !--------------------------------------------------------------------------- + + ! First handle a possible problem case: + ! Set uvel_2d = vvel_2d = 0 for the case of a Dirichlet no-slip basal BC and a 2D solve. + ! (This could be the case if solving a no-slip problem with L1L2.) + + if (whichbabc == HO_BABC_NO_SLIP .and. solve_2d) then + + ! zero out + uvel_2d(:,:) = 0.d0 + vvel_2d(:,:) = 0.d0 + resid_u_2d(:,:) = 0.d0 + resid_v_2d(:,:) = 0.d0 + L2_norm = 0.d0 ! to force convergence on first step + L2_norm_relative = 0.d0 + + elseif (whichsparse == HO_SPARSE_PCG_STANDARD .or. & + whichsparse == HO_SPARSE_PCG_CHRONGEAR) then ! native PCG solver + ! works for both serial and parallel runs + + !------------------------------------------------------------------------ + ! Compute the residual vector and its L2 norm + !------------------------------------------------------------------------ + + if (verbose_residual .and. main_task) then + print*, 'Compute residual vector' + endif + + if (solve_2d) then + + call t_startf('glissade_resid_vec') + call compute_residual_vector_2d(nx, ny, & + nhalo, & + active_vertex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d, & + uvel_2d, vvel_2d, & + resid_u_2d, resid_v_2d, & + L2_norm, L2_norm_relative) + call t_stopf('glissade_resid_vec') + + !------------------------------------------------------------------------ + ! Call linear PCG solver, compute uvel and vvel on local processor + !------------------------------------------------------------------------ + + !WHL - Passing itest, jtest, rtest for debugging + + call t_startf('glissade_pcg_slv_struct') + + if (whichsparse == HO_SPARSE_PCG_CHRONGEAR) then ! use Chronopoulos-Gear PCG algorithm + ! (better scaling for large problems) + call pcg_solver_chrongear_2d(nx, ny, & + nhalo, & + indxA_2d, active_vertex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d, & + uvel_2d, vvel_2d, & + whichprecond, err, & + niters, & + itest, jtest, rtest) + + else ! use standard PCG algorithm + + call pcg_solver_standard_2d(nx, ny, & + nhalo, & + indxA_2d, active_vertex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d, & + uvel_2d, vvel_2d, & + whichprecond, err, & + niters, & + itest, jtest, rtest) + + endif ! whichsparse + + else ! 3D solve + + call t_startf('glissade_resid_vec') + call compute_residual_vector_3d(nx, ny, & + nz, nhalo, & + active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + resid_u, resid_v, & + L2_norm, L2_norm_relative) + call t_stopf('glissade_resid_vec') + + !------------------------------------------------------------------------ + ! Call linear PCG solver, compute uvel and vvel on local processor + !------------------------------------------------------------------------ + + !WHL - Passing itest, jtest, rtest for debugging + + call t_startf('glissade_pcg_slv_struct') + + if (whichsparse == HO_SPARSE_PCG_CHRONGEAR) then ! use Chronopoulos-Gear PCG algorithm + ! (better scaling for large problems) + + call pcg_solver_chrongear_3d(nx, ny, & + nz, nhalo, & + indxA_3d, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + whichprecond, err, & + niters, & + itest, jtest, rtest) + + else ! use standard PCG algorithm + + call pcg_solver_standard_3d(nx, ny, & + nz, nhalo, & + indxA_3d, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + whichprecond, err, & + niters, & + itest, jtest, rtest) + + endif ! whichsparse + + endif ! whichapprox + + call t_stopf('glissade_pcg_slv_struct') + + if (verbose .and. main_task) then + print*, 'Solved the linear system, niters, err =', niters, err + endif + +#ifdef TRILINOS + elseif (whichsparse == HO_SPARSE_TRILINOS) then ! solve with Trilinos + + !------------------------------------------------------------------------ + ! Compute the residual vector and its L2 norm + !------------------------------------------------------------------------ + + if (solve_2d) then + + if (verbose_residual .and. main_task) print*, 'Compute 2D residual vector' + + call t_startf('glissade_resid_vec') + call compute_residual_vector_2d(nx, ny, & + nhalo, & + active_vertex, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d, & + uvel_2d, vvel_2d, & + resid_u_2d, resid_v_2d, & + L2_norm, L2_norm_relative) + call t_stopf('glissade_resid_vec') + + !------------------------------------------------------------------------ + ! Given Auu, bu, etc., assemble the matrix and RHS in a form + ! suitable for Trilinos + !------------------------------------------------------------------------ + + if (verbose_trilinos .and. main_task) then + print*, 'L2_norm, L2_target =', L2_norm, L2_target + print*, 'Assemble matrix for Trilinos' + endif + + call t_startf('glissade_trilinos_assemble') + call trilinos_assemble_2d(nx, ny, & + nVerticesSolve, global_vertex_id, & + iVertexIndex, jVertexIndex, & + indxA_2d, Afill_2d, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d) + call t_stopf('glissade_trilinos_assemble') + + !------------------------------------------------------------------------ + ! Solve the linear matrix problem + !------------------------------------------------------------------------ + + if (verbose_trilinos .and. main_task) print*, 'Solve the matrix using Trilinos' + + call t_startf('glissade_vel_tgs') + call solvevelocitytgs(velocityResult) + call t_stopf('glissade_vel_tgs') + + !------------------------------------------------------------------------ + ! Put the velocity solution back into 2D arrays + !------------------------------------------------------------------------ + + call t_startf('glissade_trilinos_post') + call trilinos_extract_velocity_2d(nx, ny, & + nVerticesSolve, & + iVertexIndex, jVertexIndex, & + velocityResult, & + uvel_2d, vvel_2d) + call t_stopf('glissade_trilinos_post') + + else ! 3D solve + + if (verbose_residual .and. main_task) print*, 'Compute 3D residual vector' + + call t_startf('glissade_resid_vec') + call compute_residual_vector_3d(nx, ny, & + nz, nhalo, & + active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + resid_u, resid_v, & + L2_norm, L2_norm_relative) + call t_stopf('glissade_resid_vec') + + !------------------------------------------------------------------------ + ! Given Auu, bu, etc., assemble the matrix and RHS in a form + ! suitable for Trilinos + !------------------------------------------------------------------------ + + if (verbose_trilinos .and. main_task) then + print*, 'L2_norm, L2_target =', L2_norm, L2_target + print*, 'Assemble matrix for Trilinos' + endif + + call t_startf('glissade_trilinos_assemble') + call trilinos_assemble_3d(nx, ny, nz, & + nNodesSolve, global_node_id, & + iNodeIndex, jNodeIndex, kNodeIndex, & + indxA_3d, Afill, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + call t_stopf('glissade_trilinos_assemble') + + !------------------------------------------------------------------------ + ! Solve the linear matrix problem + !------------------------------------------------------------------------ + + if (verbose_trilinos .and. main_task) print*, 'Solve the matrix using Trilinos' + + call t_startf('glissade_vel_tgs') + call solvevelocitytgs(velocityResult) + call t_stopf('glissade_vel_tgs') + + !------------------------------------------------------------------------ + ! Put the velocity solution back into 3D arrays + !------------------------------------------------------------------------ + + call t_startf('glissade_trilinos_post') + call trilinos_extract_velocity_3d(nx, ny, nz, & + nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + velocityResult, & + uvel, vvel) + call t_stopf('glissade_trilinos_post') + + endif ! whichapprox +#endif + + else ! one-processor SLAP solve + + !------------------------------------------------------------------------ + ! Given the stiffness matrices (Auu, etc.) and rhs vector (bu, bv) in + ! structured format, form the global matrix and rhs in SLAP format. + !------------------------------------------------------------------------ + + if (verbose) print*, 'Form global matrix in SLAP sparse format' + + matrix%order = matrix_order + matrix%nonzeros = max_nonzeros + matrix%symmetric = .false. ! Although the matrix is symmetric, we don't pass it to SLAP in symmetric form + + call t_startf('glissade_slap_preprocess') + if (solve_2d) then + + call slap_preprocess_2d(nx, ny, & + nVerticesSolve, vertexID, & + iVertexIndex, jVertexIndex, & + indxA_2d, & + Auu_2d, Auv_2d, & + Avu_2d, Avv_2d, & + bu_2d, bv_2d, & + uvel_2d, vvel_2d, & + matrix_order, & + matrix, rhs, & + answer) + + else ! 3D solve + + call slap_preprocess_3d(nx, ny, nz, & + nNodesSolve, nodeID, & + iNodeIndex, jNodeIndex, & + kNodeIndex, indxA_3d, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + matrix_order, & + matrix, rhs, & + answer) + + endif ! whichapprox + call t_stopf('glissade_slap_preprocess') + + !------------------------------------------------------------------------ + ! Compute the residual vector and its L2_norm + !------------------------------------------------------------------------ + + call t_startf('glissade_slap_resid_vec') + call slap_compute_residual_vector(matrix, answer, & + rhs, resid_vec, & + L2_norm, L2_norm_relative) + call t_stopf('glissade_slap_resid_vec') + + if (verbose_residual .and. main_task) then + print*, 'L2_norm of residual =', L2_norm + endif + + !------------------------------------------------------------------------ + ! Solve the linear matrix problem + !------------------------------------------------------------------------ + + call t_startf('glissade_easy_slv') + call sparse_easy_solve(matrix, rhs, answer, & + err, niters, whichsparse) + call t_stopf('glissade_easy_slv') + + if (main_task) then + print*, 'Solved the linear system using SLAP, niters, err =', niters, err + endif + + !------------------------------------------------------------------------ + ! Put the velocity solution back into the uvel and vvel arrays + !------------------------------------------------------------------------ + + call t_startf('glissade_slap_post') + + if (solve_2d) then + + call slap_postprocess_2d(nVerticesSolve, & + iVertexIndex, jVertexIndex, & + answer, resid_vec, & + uvel_2d, vvel_2d, & + resid_u_2d, resid_v_2d) + + else ! 3D solve + + call slap_postprocess_3d(nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + answer, resid_vec, & + uvel, vvel, & + resid_u, resid_v) + + endif ! whichapprox + + call t_stopf('glissade_slap_post') + + endif ! whichsparse + + if (solve_2d) then + + !------------------------------------------------------------------------ + ! Halo updates for uvel and vvel + !------------------------------------------------------------------------ + + call t_startf('glissade_halo_xvel') + call staggered_parallel_halo(uvel_2d) + call staggered_parallel_halo(vvel_2d) + call t_stopf('glissade_halo_xvel') + + if (verbose_state .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'rank, i, j, uvel_2d, vvel_2d (m/yr):', & + this_rank, i, j, uvel_2d(i,j), vvel_2d(i,j) + endif + + !--------------------------------------------------------------------------- + ! Compute residual quantities based on the velocity solution + !--------------------------------------------------------------------------- + + call t_startf('glissade_resid_vec2') + call compute_residual_velocity_2d(nhalo, whichresid, & + uvel_2d, vvel_2d, & + usav_2d, vsav_2d, & + resid_velo) + call t_stopf('glissade_resid_vec2') + + else ! 3D solve + + !------------------------------------------------------------------------ + ! Halo updates for uvel and vvel + !------------------------------------------------------------------------ + + call t_startf('glissade_halo_xvel') + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + call t_stopf('glissade_halo_xvel') + + if (verbose_state .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'rank, i, j:', this_rank, i, j + print*, 'k, uvel, vvel:' + do k = 1, nz + print*, uvel(k,i,j), vvel(k,i,j) + enddo + print*, ' ' + endif + + !--------------------------------------------------------------------------- + ! Compute residual quantities based on the velocity solution + !--------------------------------------------------------------------------- + + call t_startf('glissade_resid_vec2') + call compute_residual_velocity_3d(nhalo, whichresid, & + uvel, vvel, & + usav, vsav, & + resid_velo) + call t_stopf('glissade_resid_vec2') + + endif ! 2D or 3D solve + + !--------------------------------------------------------------------------- + ! Write diagnostics (iteration number, max residual, and location of max residual. + !--------------------------------------------------------------------------- + + if (main_task) then + if (whichresid == HO_RESID_L2NORM) then + print '(i4,2g20.6)', counter, L2_norm, L2_target + elseif (whichresid == HO_RESID_L2NORM_RELATIVE) then + print '(i4,2g20.6)', counter, L2_norm_relative, L2_target_relative + else + print '(i4,2g20.6)', counter, resid_velo, resid_target + end if + endif + + !--------------------------------------------------------------------------- + ! Update the outer loop stopping criterion + !--------------------------------------------------------------------------- + + if (whichresid == HO_RESID_L2NORM) then + outer_it_criterion = L2_norm + outer_it_target = L2_target ! L2_target is currently set to 1.d-4 and held constant + elseif (whichresid == HO_RESID_L2NORM_RELATIVE) then + outer_it_criterion = L2_norm_relative + outer_it_target = L2_target_relative ! L2_target_relative is currently set to 1.d-7 and held constant + else + outer_it_criterion = resid_velo + outer_it_target = resid_target ! resid_target is currently a parameter = 1.d-4 + end if + + enddo ! while (outer_it_criterion >= outer_it_target .and. counter < maxiter_nonlinear) + + call t_stopf('glissade_vhs_nonlinear_loop') + + if (counter < maxiter_nonlinear) converged_soln = .true. + + if (verbose .and. converged_soln) then + if (main_task) then + print*, ' ' + print*, 'GLISSADE SOLUTION HAS CONVERGED, outer counter =', counter + endif + endif + + !------------------------------------------------------------------------------ + ! After a 2D solve, fill in the full 3D velocity arrays. + ! This is a simple copy for SSA, but a fairly complex calculation for L1L2. + ! Note: We store redundant 3D residual info rather than creating a separate 2D residual array. + !------------------------------------------------------------------------------ + + if (whichapprox == HO_APPROX_SSA) then ! fill the 3D velocity and residual arrays with the 2D values + + do k = 1, nz + uvel(k,:,:) = uvel_2d(:,:) + vvel(k,:,:) = vvel_2d(:,:) + resid_u(k,:,:) = resid_u_2d(:,:) + resid_v(k,:,:) = resid_v_2d(:,:) + enddo + + elseif (whichapprox == HO_APPROX_L1L2) then + + if (verbose_L1L2 .and. main_task) print*, 'Compute 3D velocity, L1L2' + + uvel(nz,:,:) = uvel_2d(:,:) + vvel(nz,:,:) = vvel_2d(:,:) + do k = 1, nz + resid_u(k,:,:) = resid_u_2d(:,:) + resid_v(k,:,:) = resid_v_2d(:,:) + enddo + + call compute_3d_velocity_L1L2(nx, ny, & + nz, sigma, & + dx, dy, & + nhalo, & + ice_mask, land_mask, & + active_cell, active_vertex, & + xVertex, yVertex, & + thck, stagthck, & + usrf, & + dusrf_dx, dusrf_dy, & + flwa, efvs, & + whichgradient_margin, & + uvel, vvel) + + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + + endif ! whichapprox + + !------------------------------------------------------------------------------ + ! Compute the components of the 3D stress tensor. + ! These are diagnostic, except that tau_eff is used in the temperature calculation. + !------------------------------------------------------------------------------ + + call compute_internal_stress(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + flwafact, efvs, & + whichefvs, efvs_constant, & + whichapprox, & + uvel, vvel, & + tau_xz, tau_yz, & + tau_xx, tau_yy, & + tau_xy, tau_eff) + + !------------------------------------------------------------------------------ + ! Compute the heat flux due to basal friction for each grid cell. + !------------------------------------------------------------------------------ + + call compute_basal_friction_heatflx(nx, ny, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel(nz,:,:), vvel(nz,:,:), & + beta, bfricflx) + + !------------------------------------------------------------------------------ + ! Compute the components of basal traction. + !------------------------------------------------------------------------------ + + btractx(:,:) = beta(:,:) * uvel(nz,:,:) + btracty(:,:) = beta(:,:) * vvel(nz,:,:) + + if (verbose_state .and. this_rank==rtest) then + print*, ' ' + print*, 'uvel, k=1 (m/yr):' + do j = ny-nhalo, nhalo+1, -1 + do i = nhalo+1, nx-nhalo + write(6,'(f12.7)',advance='no') uvel(1,i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'vvel, k=1 (m/yr):' + do j = ny-nhalo, nhalo+1, -1 + do i = nhalo+1, nx-nhalo + write(6,'(f12.7)',advance='no') vvel(1,i,j) + enddo + print*, ' ' + enddo + print*, ' ' + print*, 'max(uvel, vvel) =', maxval(uvel), maxval(vvel) + print*, ' ' + + i = itest + j = jtest + print*, 'New velocity: rank, i, j =', this_rank, i, j + print*, 'k, uvel, vvel:' + do k = 1, nz + print*, k, uvel(k,i,j), vvel(k,i,j) + enddo + endif + + !------------------------------------------------------------------------------ + ! Clean up + !------------------------------------------------------------------------------ + + call t_startf('glissade_vhs_cleanup') + if (whichsparse <= HO_SPARSE_GMRES) then ! using SLAP solver + deallocate(matrix%row, matrix%col, matrix%val) + deallocate(rhs, answer, resid_vec) + endif + +#ifdef TRILINOS + if (whichsparse == HO_SPARSE_TRILINOS) then + deallocate(active_owned_unknown_map) + deallocate(velocityResult) + if (solve_2d) then + deallocate(Afill_2d) + else + deallocate(Afill) + endif + endif +#endif + + if (solve_2d) then + deallocate(Auu_2d, Auv_2d, Avu_2d, Avv_2d) + deallocate(bu_2d, bv_2d) + deallocate(loadu_2d, loadv_2d) + deallocate(usav_2d, vsav_2d) + deallocate(resid_u_2d, resid_v_2d) + else + deallocate(Auu, Auv, Avu, Avv) + endif + + !------------------------------------------------------------------------------ + ! Convert output variables to appropriate CISM units (generally dimensionless). + ! Note: bfricflx already has the desired units (W/m^2). + !------------------------------------------------------------------------------ + +!pw call t_startf('glissade_velo_higher_scale_output') + call glissade_velo_higher_scale_output(thck, usrf, & + topg, & + flwa, efvs, & + bwat, mintauf, & + beta, & + resid_u, resid_v, & + bu, bv, & + uvel, vvel, & + btractx, btracty, & + tau_xz, tau_yz, & + tau_xx, tau_yy, & + tau_xy, tau_eff) +!pw call t_stopf('glissade_velo_higher_scale_output') + call t_stopf('glissade_vhs_cleanup') + + end subroutine glissade_velo_higher_solve + +!**************************************************************************** + + subroutine glissade_velo_higher_scale_input(dx, dy, & + thck, usrf, & + topg, & + eus, thklim, & + flwa, efvs, & + bwat, mintauf, & + beta, ho_beta_const, & + uvel, vvel) + + !-------------------------------------------------------- + ! Convert input variables (generally dimensionless) + ! to appropriate units for the Glissade solver. + !-------------------------------------------------------- + + real(dp), intent(inout) :: & + dx, dy ! grid cell length and width + + real(dp), dimension(:,:), intent(inout) :: & + thck, & ! ice thickness + usrf, & ! upper surface elevation + topg ! elevation of topography + + real(dp), intent(inout) :: & + eus, & ! eustatic sea level (= 0 by default) + thklim, & ! minimum ice thickness for active cells + ho_beta_const ! constant beta value (Pa/(m/yr)) for whichbabc = HO_BABC_CONSTANT + + real(dp), dimension(:,:,:), intent(inout) :: & + flwa, & ! flow factor in units of Pa^(-n) yr^(-1) + efvs ! effective viscosity (Pa yr) + + real(dp), dimension(:,:), intent(inout) :: & + bwat, & ! basal water depth (m) + mintauf, & ! till yield stress (Pa) + beta ! basal traction parameter (Pa/(m/yr)) + + real(dp), dimension(:,:,:), intent(inout) :: & + uvel, vvel ! velocity components (m/yr) + + ! grid cell dimensions: rescale from dimensionless to m + dx = dx * len0 + dy = dy * len0 + + ! ice geometry: rescale from dimensionless to m + thck = thck * thk0 + usrf = usrf * thk0 + topg = topg * thk0 + eus = eus * thk0 + thklim = thklim * thk0 + + ! rate factor: rescale from dimensionless to Pa^(-n) yr^(-1) + flwa = flwa * (vis0*scyr) + + ! effective viscosity: rescale from dimensionless to Pa yr + efvs = efvs * (evs0/scyr) + + ! bwat: rescale from dimensionless to m + bwat = bwat * thk0 + + ! mintauf: rescale from dimensionless to Pa + mintauf = mintauf * tau0 + + ! beta: rescale from dimensionless to Pa/(m/yr) + beta = beta * tau0/(vel0*scyr) + ho_beta_const = ho_beta_const * tau0/(vel0*scyr) + + ! ice velocity: rescale from dimensionless to m/yr + uvel = uvel * (vel0*scyr) + vvel = vvel * (vel0*scyr) + + end subroutine glissade_velo_higher_scale_input + +!**************************************************************************** + + subroutine glissade_velo_higher_scale_output(thck, usrf, & + topg, & + flwa, efvs, & + bwat, mintauf, & + beta, & + resid_u, resid_v, & + bu, bv, & + uvel, vvel, & + btractx, btracty, & + tau_xz, tau_yz, & + tau_xx, tau_yy, & + tau_xy, tau_eff) + + !-------------------------------------------------------- + ! Convert output variables to appropriate CISM units + ! (generally dimensionless) + !-------------------------------------------------------- + + real(dp), dimension(:,:), intent(inout) :: & + thck, & ! ice thickness + usrf, & ! upper surface elevation + topg ! elevation of topography + + real(dp), dimension(:,:,:), intent(inout) :: & + flwa, & ! flow factor in units of Pa^(-n) yr^(-1) + efvs ! effective viscosity (Pa yr) + + real(dp), dimension(:,:), intent(inout) :: & + bwat, & ! basal water depth (m) + mintauf, & ! till yield stress (Pa) + beta ! basal traction parameter (Pa/(m/yr)) + + real(dp), dimension(:,:,:), intent(inout) :: & + uvel, vvel, & ! velocity components (m/yr) + resid_u, resid_v, & ! components of residual Ax - b (Pa/m) + bu, bv ! components of b in Ax = b (Pa/m) + + real(dp), dimension(:,:), intent(inout) :: & + btractx, btracty ! components of basal traction (Pa) + + real(dp), dimension(:,:,:), intent(inout) :: & + tau_xz, tau_yz, &! vertical components of stress tensor (Pa) + tau_xx, tau_yy, tau_xy, &! horizontal components of stress tensor (Pa) + tau_eff ! effective stress (Pa) + + ! Convert geometry variables from m to dimensionless units + thck = thck / thk0 + usrf = usrf / thk0 + topg = topg / thk0 + + ! Convert flow factor from Pa^(-n) yr^(-1) to dimensionless units + flwa = flwa / (vis0*scyr) + + ! Convert effective viscosity from Pa yr to dimensionless units + efvs = efvs / (evs0/scyr) + + ! Convert bwat from m to dimensionless units + bwat = bwat / thk0 + + ! Convert mintauf from Pa to dimensionless units + mintauf = mintauf / tau0 + + ! Convert beta from Pa/(m/yr) to dimensionless units + beta = beta / (tau0/(vel0*scyr)) + + ! Convert velocity from m/yr to dimensionless units + uvel = uvel / (vel0*scyr) + vvel = vvel / (vel0*scyr) + + ! Convert residual and rhs from Pa/m to dimensionless units + resid_u = resid_u / (tau0/len0) + resid_v = resid_v / (tau0/len0) + bu = bu / (tau0/len0) + bv = bv / (tau0/len0) + + ! Convert stresses from Pa to dimensionless units + btractx = btractx/tau0 + btracty = btracty/tau0 + tau_xz = tau_xz/tau0 + tau_yz = tau_yz/tau0 + tau_xx = tau_xx/tau0 + tau_yy = tau_yy/tau0 + tau_xy = tau_xy/tau0 + tau_eff = tau_eff/tau0 + + end subroutine glissade_velo_higher_scale_output + +!**************************************************************************** + + subroutine get_vertex_geometry(nx, ny, & + nz, nhalo, & + dx, dy, & + ice_mask, & + xVertex, yVertex, & + active_cell, active_vertex, & + nNodesSolve, nVerticesSolve, & + nodeID, vertexID, & + iNodeIndex, jNodeIndex, kNodeIndex, & + iVertexIndex, jVertexIndex) + + !---------------------------------------------------------------- + ! Compute coordinates for each vertex. + ! Identify and count the active cells and vertices for the finite-element calculations. + ! Active cells include all cells that contain ice (thck > thklin) and border locally owned vertices. + ! Active vertices include all vertices of active cells. + ! + ! Also compute some indices needed for the SLAP and Trilinos solvers. + !TODO - Move SLAP/Trilinos part to a different subroutine? + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width (m) + ! assumed to have the same value for each grid cell + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 for cells where ice is present (thk > thklim), else = 0 + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + xVertex, yVertex ! x and y coordinates of each vertex + + logical, dimension(nx,ny), intent(out) :: & + active_cell ! true for active cells + ! (thck > thklim, bordering a locally owned vertex) + + logical, dimension(nx-1,ny-1), intent(out) :: & + active_vertex ! true for vertices of active cells + + ! The remaining input/output arguments are for the SLAP and Trilinos solvers + + integer, intent(out) :: & + nNodesSolve, & ! number of locally owned nodes where we solve for velocity + nVerticesSolve ! number of locally owned vertices where we solve for velocity + + integer, dimension(nz,nx-1,ny-1), intent(out) :: & + nodeID ! local ID for each node where we solve for velocity + + integer, dimension(nx-1,ny-1), intent(out) :: & + vertexID ! local ID for each vertex where we solve for velocity + + integer, dimension((nx-1)*(ny-1)*nz), intent(out) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + integer, dimension((nx-1)*(ny-1)), intent(out) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + !--------------------------------------------------------- + ! Local variables + !--------------------------------------------------------- + + integer :: i, j, k + + !---------------------------------------------------------------- + ! Compute the x and y coordinates of each vertex. + ! By convention, vertex (i,j) lies at the NE corner of cell(i,j). + !---------------------------------------------------------------- + + xVertex(:,:) = 0.d0 + yVertex(:,:) = 0.d0 + do j = 1, ny-1 + do i = 1, nx-1 + xVertex(i,j) = dx * i + yVertex(i,j) = dy * j + enddo + enddo + + ! Identify the active cells. + ! Include all cells that border locally owned vertices and contain ice. + + active_cell(:,:) = .false. + + do j = 1+nhalo, ny-nhalo+1 + do i = 1+nhalo, nx-nhalo+1 + if (ice_mask(i,j) == 1) then + active_cell(i,j) = .true. + endif + enddo + enddo + + ! Identify the active vertices + ! Include all vertices of active cells + + active_vertex(:,:) = .false. + + do j = 1+nhalo, ny-nhalo+1 ! include east and north layer of halo cells + do i = 1+nhalo, nx-nhalo+1 + if (active_cell(i,j)) then + active_vertex(i-1:i, j-1:j) = .true. ! all vertices of this cell + endif + enddo + enddo + + ! Identify and count the nodes where we must solve for the velocity. + ! This indexing is used for pre- and post-processing of the assembled matrix + ! when we call the SLAP or Trilinos solver (one processor only). + ! It is not required by the native PCG solver. + + nVerticesSolve = 0 + vertexID(:,:) = 0 + iVertexIndex(:) = 0 + jVertexIndex(:) = 0 + + nNodesSolve = 0 + nodeID(:,:,:) = 0 + iNodeIndex(:) = 0 + jNodeIndex(:) = 0 + kNodeIndex(:) = 0 + + do j = nhalo+1, ny-nhalo ! locally owned vertices only + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then ! all nodes in column are active + nVerticesSolve = nVerticesSolve + 1 + vertexID(i,j) = nVerticesSolve ! unique local index for each vertex + iVertexIndex(nVerticesSolve) = i + jVertexIndex(nVerticesSolve) = j + do k = 1, nz + nNodesSolve = nNodesSolve + 1 + nodeID(k,i,j) = nNodesSolve ! unique local index for each node + iNodeIndex(nNodesSolve) = i + jNodeIndex(nNodesSolve) = j + kNodeIndex(nNodesSolve) = k + enddo ! k + endif ! active vertex + enddo ! i + enddo ! j + + if (verbose .and. this_rank==rtest) then + print*, ' ' + print*, 'nVerticesSolve, nNodesSolve =', nVerticesSolve, nNodesSolve + endif + + end subroutine get_vertex_geometry + +!**************************************************************************** + + subroutine load_vector_gravity(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + dusrf_dx, dusrf_dy, & + loadu, loadv) + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + ! Note: the number of elements per column is nz-1 + nhalo ! number of halo layers + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + dusrf_dx, & ! upper surface elevation gradient on staggered grid (m/m) + dusrf_dy + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + loadu, loadv ! load vector, divided into u and v components + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_3d) :: & + x, y, z, & ! Cartesian coordinates of nodes + dsdx, dsdy ! upper surface elevation gradient at nodes + + real(dp) :: & + detJ ! determinant of Jacobian for the transformation + ! between the reference element and true element + + !Note - These are not currently used except as dummy arguments + real(dp), dimension(nNodesPerElement_3d) :: & + dphi_dx_3d, dphi_dy_3d, dphi_dz_3d ! derivatives of basis functions, evaluated at quad pts + + real(dp) :: & + dsdx_qp, dsdy_qp ! upper surface elevation gradient at quad pt + + integer :: i, j, k, n, p + + integer :: iNode, jNode, kNode + + if (verbose_load) then + print*, ' ' + print*, 'In load_vector_gravity: itest, jtest, ktest, rtest =', itest, jtest, ktest, rtest + endif + + ! Sum over elements in active cells + ! Loop over all cells that border locally owned vertices + + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 + + if (active_cell(i,j)) then + + do k = 1, nz-1 ! loop over elements in this column + ! assume k increases from upper surface to bed + + ! compute spatial coordinates and upper surface elevation gradient for each node + + do n = 1, nNodesPerElement_3d + + ! Determine (k,i,j) for this node + ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). + ! Indices for other nodes are computed relative to this node. + iNode = i + ishift(7,n) + jNode = j + jshift(7,n) + kNode = k + kshift(7,n) + + x(n) = xVertex(iNode,jNode) + y(n) = yVertex(iNode,jNode) + z(n) = stagusrf(iNode,jNode) - sigma(kNode)*stagthck(iNode,jNode) + dsdx(n) = dusrf_dx(iNode,jNode) + dsdy(n) = dusrf_dy(iNode,jNode) + + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'i, j, k, n, x, y, z, dsdx, dsdy:', i, j, k, n, x(n), y(n), z(n), dsdx(n), dsdy(n) + endif + + enddo ! nodes per element + + ! Loop over quadrature points for this element + + do p = 1, nQuadPoints_3d + + ! Evaluate detJ at the quadrature point. + ! TODO: The derivatives are not used. Make these optional arguments? + !WHL - debug - Pass in i, j, k, and p for now + + call get_basis_function_derivatives_3d(x(:), y(:), z(:), & + dphi_dxr_3d(:,p), dphi_dyr_3d(:,p), dphi_dzr_3d(:,p), & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + detJ , i, j, k, p ) + + ! Evaluate dsdx and dsdy at this quadrature point + + dsdx_qp = 0.d0 + dsdy_qp = 0.d0 + + do n = 1, nNodesPerElement_3d + dsdx_qp = dsdx_qp + phi_3d(n,p) * dsdx(n) + dsdy_qp = dsdy_qp + phi_3d(n,p) * dsdy(n) + enddo + + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'Increment load vector, i, j, k, p =', i, j, k, p + print*, 'ds/dx, ds/dy =', dsdx_qp, dsdy_qp + print*, 'detJ/vol0 =', detJ/vol0 + print*, 'detJ/vol0* (ds/dx, ds/dy) =', detJ/vol0*dsdx_qp, detJ/vol0*dsdy_qp + endif + + ! Increment the load vector with the gravitational contribution from this quadrature point + + do n = 1, nNodesPerElement_3d + + ! Determine (k,i,j) for this node + iNode = i + ishift(7,n) + jNode = j + jshift(7,n) + kNode = k + kshift(7,n) + + loadu(kNode,iNode,jNode) = loadu(kNode,iNode,jNode) - rhoi*grav * wqp_3d(p) * detJ/vol0 * dsdx_qp * phi_3d(n,p) + loadv(kNode,iNode,jNode) = loadv(kNode,iNode,jNode) - rhoi*grav * wqp_3d(p) * detJ/vol0 * dsdy_qp * phi_3d(n,p) + + if (verbose_load .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest .and. p==ptest) then + print*, ' ' + print*, 'n, phi_3d(n), delta(loadu), delta(loadv):', n, phi_3d(n,p), & + rhoi*grav*wqp_3d(p)*detJ/vol0 * dsdx_qp * phi_3d(n,p), & + rhoi*grav*wqp_3d(p)*detJ/vol0 * dsdy_qp * phi_3d(n,p) + endif + + enddo ! nNodesPerElement_3d + + enddo ! nQuadPoints_3d + + enddo ! k + + endif ! active cell + + enddo ! i + enddo ! j + + end subroutine load_vector_gravity + +!**************************************************************************** + + subroutine load_vector_lateral_bc(nx, ny, & + nz, sigma, & + nhalo, & + floating_mask, ocean_mask, & + active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + loadu, loadv) + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + ! Note: the number of elements per column is nz-1 + nhalo ! number of halo layers + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + integer, dimension(nx,ny), intent(in) :: & + floating_mask, &! = 1 if ice is present and is floating + ocean_mask ! = 1 if topography is below sea level and ice is absent + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + loadu, loadv ! load vector, divided into u and v components + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j + + ! Sum over elements in active cells + ! Loop over cells that contain locally owned vertices + ! NOTE: Lateral shelf BCs are currently applied only to floating ice. + ! I tested them for land-terminating ice, including an outward pressure term from the ice + ! (with no compensating ocean pressure). This gave excessive margin velocities. + ! + ! TODO: Generalize to include marine-based ice that borders the ocean but is not floating? + + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 + + if (verbose_shelf .and. i==itest .and. j==jtest .and. this_rank==rtest) then + print*, 'i, j =', i, j + print*, 'active =', active_cell(i,j) + print*, 'floating_mask =', floating_mask(i,j) + print*, 'ocean_mask (i-1:i,j) =', ocean_mask(i-1:i, j) + print*, 'ocean_mask (i-1:i,j-1)=', ocean_mask(i-1:i, j-1) + endif + + if (floating_mask(i,j) == 1) then ! ice is present and is floating + + if (ocean_mask(i-1,j) == 1) then ! compute lateral BC for west face + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'west', & + i, j, & + stagusrf, stagthck, & + xVertex, yVertex, & + loadu, loadv) + endif + + if (ocean_mask(i+1,j) == 1) then ! compute lateral BC for east face + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'east', & + i, j, & + stagusrf, stagthck, & + xVertex, yVertex, & + loadu, loadv) + endif + + if (ocean_mask(i,j-1) == 1) then ! compute lateral BC for south face + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'south', & + i, j, & + stagusrf, stagthck, & + xVertex, yVertex, & + loadu, loadv) + endif + + if (ocean_mask(i,j+1) == 1) then ! compute lateral BC for north face + call lateral_shelf_bc(nx, ny, & + nz, sigma, & + 'north', & + i, j, & + stagusrf, stagthck, & + xVertex, yVertex, & + loadu, loadv) + endif + + endif ! floating_mask + + enddo ! i + enddo ! j + + end subroutine load_vector_lateral_bc + +!**************************************************************************** + + subroutine lateral_shelf_bc(nx, ny, & + nz, sigma, & + face, & + iCell, jCell, & + stagusrf, stagthck, & + xVertex, yVertex, & + loadu, loadv) + + !---------------------------------------------------------------------------------- + ! Determine the contribution to the load vector from ice and water pressure at the + ! vertical boundary between ice and ocean (or alternatively, from ice pressure alone + ! at a vertical boundary between ice and air). + ! + ! This subroutine computes the vertically averaged hydrostatic pressure at a vertical face + ! associated with the grid cell column (iCell, jCell). + ! + ! At a given point, this pressure is proportional to the difference between + ! (1) the vertically averaged pressure exerted outward (toward the ocean) by the ice front + ! (2) the vertically averaged pressure exerted by the ocean back toward the ice + ! + ! (1) is given by p_out = 0.5*rhoi*grav*H + ! (2) is given by p_in = 0.5*rhoi*grav*H*(rhoi/rhoo) for a floating shelf + ! = 0.5*rhoo*grav*H*(1 - s/H)^2 for s <= H but ice not necessarily afloat + ! + ! The second term goes to zero for a land-terminating cliff. + ! The two pressure terms are opposite in sign, so the net vertically averaged pressure, + ! directed toward the ocean (or air), is given by + ! + ! p_av = 0.5*rhoi*grav*H*(1 - rhoi/rhoo) for a floating shelf + ! 0.5*rhoi*grav*H - 0.5*rhoo*grav*H * (1 - min((s/H),1)^2 for ice not necessarily afloat + ! + ! Here we sum over quadrature points for each ocean-bordering face of each element. + ! The contribution from each quadrature point to node N is proportional to the product + ! + ! p_av(s,H) * detJ * phi(n,p) + ! + ! where s and H are the surface elevation and ice thickness evaluated at that point, + ! detJ is the determinant of the transformation linking the reference 2D element coordinates + ! to the true coordinates at that point, and phi(n,p) is the basis function evaluated at that point. + ! + !----------------------------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + ! Note: the number of elements per column is nz-1 + iCell, jCell ! i and j indices for this cell + + character(len=*), intent(in) :: & + face ! 'north', 'south', 'east', or 'west' + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + loadu, loadv ! load vector, divided into u and v components + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_2d) :: & + x, y, & ! local coordinates of nodes + s, & ! upper surface elevation at nodes + h ! ice thickness at nodes + + integer, dimension(nNodesPerElement_2d) :: & + iNode, jNode, kNode ! global indices of each node + + !Note: These are not currently used except as dummy arguments + real(dp), dimension(nNodesPerElement_2d) :: & + dphi_dx_2d, dphi_dy_2d ! derivatives of basis functions, evaluated at quad pts + + real(dp) :: & + h_qp, & ! ice thickness at a given quadrature point (m) + s_qp, & ! ice surface elevation at a given quadrature point (m) + p_av, & ! net outward pressure from ice, p_out - p_in + detJ ! determinant of Jacobian for the transformation + ! between the reference element and true element + + integer :: k, n, p + + ! Compute nodal geometry in a local xy reference system + ! Note: The local y direction is really the vertical direction + ! The local x direction depends on the face (N/S/E/W) + ! The diagrams below show the node indexing convention, along with the true + ! directions for each face. The true directions are mapped to local (x,y). + + iNode(:) = 0 + jNode(:) = 0 + + if (face=='west') then + + ! 4-----3 z + ! | | ^ + ! | | | + ! 1-----2 ---> -y + + iNode(1) = iCell-1 + jNode(1) = jCell + + iNode(2) = iCell-1 + jNode(2) = jCell-1 + + x(1) = yvertex(iNode(1), jNode(1)) + x(2) = yvertex(iNode(2), jNode(2)) + + elseif (face=='east') then + + ! 4-----3 z + ! | | ^ + ! | | | + ! 1-----2 ---> y + + iNode(1) = iCell + jNode(1) = jCell-1 + + iNode(2) = iCell + jNode(2) = jCell + + x(1) = yvertex(iNode(1), jNode(1)) + x(2) = yvertex(iNode(2), jNode(2)) + + elseif (face=='south') then + + ! 4-----3 z + ! | | ^ + ! | | | + ! 1-----2 ---> x + + iNode(1) = iCell-1 + jNode(1) = jCell-1 + + iNode(2) = iCell + jNode(2) = jCell-1 + + x(1) = xvertex(iNode(1), jNode(1)) + x(2) = xvertex(iNode(2), jNode(2)) + + elseif (face=='north') then + + ! 4-----3 z + ! | | ^ + ! | | | + ! 1-----2 ---> -x + + iNode(1) = iCell + jNode(1) = jCell + + iNode(2) = iCell-1 + jNode(2) = jCell + + x(1) = xvertex(iNode(1), jNode(1)) + x(2) = xvertex(iNode(2), jNode(2)) + + endif + + iNode(3) = iNode(2) + jNode(3) = jNode(2) + + iNode(4) = iNode(1) + jNode(4) = jNode(1) + + x(3) = x(2) + x(4) = x(1) + + s(1) = stagusrf(iNode(1), jNode(1)) + s(2) = stagusrf(iNode(2), jNode(2)) + s(3) = s(2) + s(4) = s(1) + + h(1) = stagthck(iNode(1), jNode(1)) + h(2) = stagthck(iNode(2), jNode(2)) + h(3) = h(2) + h(4) = h(1) + + ! loop over element faces in column + ! assume k increases from upper surface to bottom + + do k = 1, nz-1 + + ! Compute the local y coordinate (i.e., the actual z coordinate) + y(1) = s(1) - sigma(k+1)*h(1) ! lower left + y(2) = s(2) - sigma(k+1)*h(2) ! lower right + y(3) = s(3) - sigma(k) *h(3) ! upper right + y(4) = s(4) - sigma(k) *h(4) ! upper left + + ! Set the k index for each node + kNode(1) = k+1 + kNode(2) = k+1 + kNode(3) = k + kNode(4) = k + + ! loop over quadrature points + + do p = 1, nQuadPoints_2d + + ! Compute basis function derivatives and det(J) for this quadrature point + ! For now, pass in i, j, k, p for debugging + !TODO - Modify this subroutine to return only detJ, and not the derivatives? + + if (verbose_shelf .and. this_rank==rtest .and. iCell==itest .and. jCell==jtest .and. k==ktest) then + print*, ' ' + print*, 'Get detJ, i, j, k, p =', iCell, jCell, k, p + print*, 'x =', x(:) + print*, 'y =', y(:) + print*, 'dphi_dxr_2d =', dphi_dxr_2d(:,p) + print*, 'dphi_dyr_2d =', dphi_dyr_2d(:,p) + endif + + call get_basis_function_derivatives_2d(x(:), y(:), & + dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & + dphi_dx_2d(:), dphi_dy_2d(:), & + detJ, iCell, jCell, p) + + ! For some faces, detJ is computed to be a negative number because the face is + ! oriented opposite the x or y axis. Fix this by taking the absolute value. + + detJ = abs(detJ) + + ! Evaluate the ice thickness and surface elevation at this quadrature point + + h_qp = 0.d0 + s_qp = 0.d0 + do n = 1, nNodesPerElement_2d + h_qp = h_qp + phi_2d(n,p) * h(n) + s_qp = s_qp + phi_2d(n,p) * s(n) + enddo + + if (verbose_shelf .and. this_rank==rtest .and. iCell==itest .and. jCell==jtest .and. k==ktest) then + print*, ' ' + print*, 'Increment shelf load vector, i, j, face, k, p =', iCell, jCell, trim(face), k, p + print*, 'h_qp, s_qp =', h_qp, s_qp + print*, 'detJ/vol0 =', detJ/vol0 + print*, 'grav =', grav + endif + + ! Increment the load vector with the shelf water pressure contribution from + ! this quadrature point. + ! Increment loadu for east/west faces and loadv for north/south faces. + + ! This formula works for ice that either is floating or is partially submerged without floating +!! p_av = 0.5d0*rhoi*grav*h_qp & ! p_out +!! - 0.5d0*rhoo*grav*h_qp * (1.d0 - min(s_qp/h_qp,1.d0))**2 ! p_in + + ! This formula works for floating ice. + p_av = 0.5d0*rhoi*grav*h_qp * (1.d0 - rhoi/rhoo) + + if (trim(face) == 'west') then ! net force in -x direction + + do n = 1, nNodesPerElement_2d + loadu(kNode(n),iNode(n),jNode(n)) = loadu(kNode(n),iNode(n),jNode(n)) & + - p_av * wqp_2d(p) * detJ/vol0 * phi_2d(n,p) + enddo + + elseif (trim(face) == 'east') then ! net force in x direction + + do n = 1, nNodesPerElement_2d + loadu(kNode(n),iNode(n),jNode(n)) = loadu(kNode(n),iNode(n),jNode(n)) & + + p_av * wqp_2d(p) * detJ/vol0 * phi_2d(n,p) + enddo + + elseif (trim(face) == 'south') then ! net force in -y direction + + do n = 1, nNodesPerElement_2d + loadv(kNode(n),iNode(n),jNode(n)) = loadv(kNode(n),iNode(n),jNode(n)) & + - p_av * wqp_2d(p) * detJ/vol0 * phi_2d(n,p) + enddo + + elseif (trim(face) == 'north') then ! net force in y direction + + do n = 1, nNodesPerElement_2d + loadv(kNode(n),iNode(n),jNode(n)) = loadv(kNode(n),iNode(n),jNode(n)) & + + p_av * wqp_2d(p) * detJ/vol0 * phi_2d(n,p) + enddo + + endif ! face = N/S/E/W + + enddo ! nQuadPoints_2d + + enddo ! k (element faces in column) + + end subroutine lateral_shelf_bc + +!**************************************************************************** + + subroutine assemble_stiffness_matrix_3d(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel, vvel, & + stagusrf, stagthck, & + flwafact, whichapprox, & + efvs, whichefvs, & + efvs_constant, & + Auu, Auv, & + Avu, Avv) + + !---------------------------------------------------------------- + ! Assemble the stiffness matrix A in the linear system Ax = b. + ! This subroutine is called for each nonlinear iteration if + ! we are iterating on the effective viscosity. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + ! Note: the number of elements per column is nz-1 + nhalo ! number of halo layers + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! velocity components (m/yr) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + real(dp), dimension(nz-1,nx,ny), intent(in) :: & + flwafact ! temperature-based flow factor, 0.5 * A^(-1/n), + ! used to compute the effective viscosity + ! units: Pa yr^(1/n) + + integer, intent(in) :: & + whichapprox, & ! option for Stokes approximation (BP, SSA, SIA) + whichefvs ! option for effective viscosity calculation + + real(dp), intent(in) :: & + efvs_constant ! constant value of effective viscosity (Pa yr) + + real(dp), dimension(nz-1,nx,ny), intent(out) :: & + efvs ! effective viscosity (Pa yr) + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(out) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + !--------------------------------------------------------- + ! Local variables + !--------------------------------------------------------- + + real(dp), dimension(nQuadPoints_3d) :: & + detJ ! determinant of J + + real(dp), dimension(nNodesPerElement_3d) :: & + dphi_dx_3d, dphi_dy_3d, dphi_dz_3d ! derivatives of basis function, evaluated at quad pt + + !---------------------------------------------------------------- + ! Note: Kuu, Kuv, Kvu, and Kvv are 8x8 components of the stiffness matrix + ! for the local element. (The combined stiffness matrix is 16x16.) + ! + ! Once these matrices are formed, their coefficients are summed into the assembled + ! matrices Auu, Auv, Avu, Avv. The A matrices each have as many rows as there are + ! active nodes, but only 27 columns, corresponding to the 27 vertices that belong to + ! the 8 elements sharing a given node. + ! + ! The native structured PCG solver works with the dense A matrices in the form + ! computed here. For the SLAP solver, the terms of the A matrices are put + ! in a sparse matrix during preprocessing. For the Trilinos solver, the terms + ! of the A matrices are passed to Trilinos one row at a time. + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_3d, nNodesPerElement_3d) :: & ! + Kuu, & ! element stiffness matrix, divided into 4 parts as shown below + Kuv, & ! + Kvu, & ! + Kvv ! Kuu | Kuv + ! _____|____ + ! | + ! Kvu | Kvv + ! + ! Kvu may not be needed if matrix is symmetric, but is included for now + + real(dp), dimension(nNodesPerElement_3d) :: & + x, y, z, & ! Cartesian coordinates of nodes + u, v, & ! u and v at nodes + s ! upper surface elevation at nodes + + real(dp), dimension(nQuadPoints_3d) :: & + efvs_qp ! effective viscosity at a quad pt + + logical, parameter :: & + check_symmetry_element = .true. ! if true, then check symmetry of element matrix + !Note: Can speed up assembly a bit by setting to false for production + + integer :: i, j, k, n, p + integer :: iNode, jNode, kNode + + if (verbose_matrix .and. main_task) then + print*, ' ' + print*, 'In assemble_stiffness_matrix_3d' + print*, 'itest, jtest, ktest, rtest =', itest, jtest, ktest, rtest + endif + + ! Initialize effective viscosity + efvs(:,:,:) = 0.d0 + + ! Initialize global stiffness matrix + + Auu(:,:,:,:) = 0.d0 + Auv(:,:,:,:) = 0.d0 + Avu(:,:,:,:) = 0.d0 + Avv(:,:,:,:) = 0.d0 + + ! Sum over elements in active cells + ! Loop over all cells that border locally owned vertices. + + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 + + if (active_cell(i,j)) then + + do k = 1, nz-1 ! loop over elements in this column + ! assume k increases from upper surface to bed + + ! Initialize element stiffness matrix + Kuu(:,:) = 0.d0 + Kuv(:,:) = 0.d0 + Kvu(:,:) = 0.d0 + Kvv(:,:) = 0.d0 + + ! compute spatial coordinates, velocity, and upper surface elevation for each node + + do n = 1, nNodesPerElement_3d + + ! Determine (k,i,j) for this node + ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). + ! Indices for other nodes are computed relative to this node. + iNode = i + ishift(7,n) + jNode = j + jshift(7,n) + kNode = k + kshift(7,n) + + x(n) = xVertex(iNode,jNode) + y(n) = yVertex(iNode,jNode) + z(n) = stagusrf(iNode,jNode) - sigma(kNode)*stagthck(iNode,jNode) + u(n) = uvel(kNode,iNode,jNode) + v(n) = vvel(kNode,iNode,jNode) + s(n) = stagusrf(iNode,jNode) + + if (verbose_matrix .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'i, j, k, n, x, y, z:', i, j, k, n, x(n), y(n), z(n) + print*, 's, u, v:', s(n), u(n), v(n) + endif + + enddo ! nodes per element + + ! Loop over quadrature points for this element + + do p = 1, nQuadPoints_3d + + ! Evaluate the derivatives of the element basis functions at this quadrature point. + !WHL - Pass in i, j, k, and p to the following subroutines for debugging. + + call get_basis_function_derivatives_3d(x(:), y(:), z(:), & + dphi_dxr_3d(:,p), dphi_dyr_3d(:,p), dphi_dzr_3d(:,p), & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + detJ(p) , i, j, k, p ) + +! call t_startf('glissade_effective_viscosity') + call compute_effective_viscosity(whichefvs, whichapprox, & + efvs_constant, nNodesPerElement_3d, & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + u(:), v(:), & + flwafact(k,i,j), efvs_qp(p), & + i, j, k, p ) +! call t_stopf('glissade_effective_viscosity') + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. p==ptest) then + print*, 'i, j, k, p, efvs (Pa yr):', i, j, k, p, efvs_qp(p) + endif + + ! Increment the element stiffness matrix with the contribution from each quadrature point. + +! call t_startf('glissade_compute_element_matrix') + call compute_element_matrix(whichapprox, nNodesPerElement_3d, & + wqp_3d(p), detJ(p), efvs_qp(p), & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + Kuu(:,:), Kuv(:,:), & + Kvu(:,:), Kvv(:,:), & + i, j, k, p ) +! call t_stopf('glissade_compute_element_matrix') + + enddo ! nQuadPoints_3d + + ! Compute average of effective viscosity over quad pts + efvs(k,i,j) = 0.d0 + + do p = 1, nQuadPoints_3d + efvs(k,i,j) = efvs(k,i,j) + efvs_qp(p) + enddo + efvs(k,i,j) = efvs(k,i,j) / nQuadPoints_3d + + if (check_symmetry_element) then + call check_symmetry_element_matrix(nNodesPerElement_3d, & + Kuu, Kuv, Kvu, Kvv) + endif + + ! Sum terms of element matrix K into dense assembled matrix A + + call element_to_global_matrix_3d(nx, ny, nz, & + i, j, k, & + Kuu, Kuv, & + Kvu, Kvv, & + Auu, Auv, & + Avu, Avv) + + enddo ! nz (loop over elements in this column) + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'i, j =', i, j + print*, 'k, efvs:' + do k = 1, nz-1 + print*, k, efvs(k,i,j) + enddo + endif + + endif ! active cell + + enddo ! i + enddo ! j + + end subroutine assemble_stiffness_matrix_3d + +!**************************************************************************** + + subroutine assemble_stiffness_matrix_2d(nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel, vvel, & + stagusrf, stagthck, & + dusrf_dx, dusrf_dy, & + flwa, flwafact, & + whichapprox, & + whichefvs, efvs_constant, & + efvs, & + Auu, Auv, & + Avu, Avv) + + !---------------------------------------------------------------- + ! Assemble the stiffness matrix A in the linear system Ax = b. + ! This subroutine is called for each nonlinear iteration if + ! we are iterating on the effective viscosity. + ! A can be based on either the shallow-shelf approximation or + ! the higher-order, vertically integrated L1L2 approximation + ! (Schoof and Hindmarsh, 2010). The main difference between SSA and + ! L1L2 is in the computation of the effective viscosity. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + ! (used for flwafact) + nhalo ! number of halo layers + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel ! velocity components (m/yr) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + dusrf_dx, & ! upper surface elevation gradient on staggered grid (m/m) + dusrf_dy ! needed for L1L2 only + + !TODO - Pass in flwa and compute flwafact here? + real(dp), dimension(nz-1,nx,ny), intent(in) :: & + flwa, &! temperature-based flow factor A, Pa^{-n} yr^{-1} + flwafact ! temperature-based flow factor, 0.5 * A^(-1/n), Pa yr^(1/n) + ! used to compute the effective viscosity + + integer, intent(in) :: & + whichapprox, & ! option for Stokes approximation (BP, L1L2, SSA, SIA) + whichefvs ! option for effective viscosity calculation + + real(dp), intent(in) :: & + efvs_constant ! constant value of effective viscosity (Pa yr) + + real(dp), dimension(nz-1,nx,ny), intent(out) :: & + efvs ! effective viscosity (Pa yr) + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(out) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + !--------------------------------------------------------- + ! Local variables + !--------------------------------------------------------- + + real(dp), dimension(nQuadPoints_2d) :: & + detJ ! determinant of J + + real(dp), dimension(nNodesPerElement_2d) :: & + dphi_dx_2d, dphi_dy_2d, dphi_dz_2d ! derivatives of basis function, evaluated at quad pts + ! set dphi_dz = 0 for 2D problem + + !---------------------------------------------------------------- + ! Note: Kuu, Kuv, Kvu, and Kvv are 4x4 components of the stiffness matrix + ! for the local element. (The combined stiffness matrix is 8x8.) + ! + ! Once these matrices are formed, their coefficients are summed into the global + ! matrices Auu_2d, Auv_2d, Avu_2d, Avv_2d. The global matrices each have as + ! many rows as there are active vertices, but only 9 columns, corresponding to + ! the 9 vertices of the 4 elements sharing a given node. + ! + ! The native structured PCG solver works with the dense A matrices in the form + ! computed here. For the SLAP solver, the terms of the A matrices are put + ! in a sparse matrix format during preprocessing. For the Trilinos solver, + ! the terms of the A matrices are passed to Trilinos one row at a time. + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_2d, nNodesPerElement_2d) :: & ! + Kuu, & ! element stiffness matrix, divided into 4 parts as shown below + Kuv, & ! + Kvu, & ! + Kvv ! Kuu | Kuv + ! _____|____ + ! | + ! Kvu | Kvv + ! + ! Kvu may not be needed if matrix is symmetric, but is included for now + + real(dp), dimension(nNodesPerElement_2d) :: & + x, y, & ! Cartesian coordinates of nodes + u, v, & ! u and v at nodes + h, & ! thickness at nodes + s, & ! upper surface elevation at nodes + dsdx, dsdy ! upper surface elevation gradient at nodes (L1L2 only) + + real(dp), dimension(nQuadPoints_2d) :: & + efvs_qp_vertavg ! vertically averaged effective viscosity at a quad pt + + ! these are for L1L2 only + real(dp), dimension(nz-1,nQuadPoints_2d) :: & + efvs_qp ! effective viscosity at each layer in a cell column + ! corresponding to a quad pt + + real(dp) :: & + h_qp ! thickness at a quad pt + + logical, parameter :: & + check_symmetry_element = .true. ! if true, then check symmetry of element matrix + + real(dp), dimension(nx,ny) :: & + flwafact_2d ! vertically averaged flow factor + + integer :: i, j, k, n, p + integer :: iVertex, jVertex + + if (verbose_matrix .and. main_task) then + print*, ' ' + print*, 'In assemble_stiffness_matrix_2d' + endif + + ! Initialize effective viscosity + efvs(:,:,:) = 0.d0 + + ! Initialize global stiffness matrix + + Auu(:,:,:) = 0.d0 + Auv(:,:,:) = 0.d0 + Avu(:,:,:) = 0.d0 + Avv(:,:,:) = 0.d0 + + ! Compute vertical average of flow factor (SSA only) + if (whichapprox == HO_APPROX_SSA) then + call glissade_vertical_average(nx, ny, & + nz, sigma, & + active_cell, & + flwafact, flwafact_2d) + endif + + ! Sum over elements in active cells + ! Loop over all cells that border locally owned vertices. + + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 + + if (active_cell(i,j)) then + + ! Initialize element stiffness matrix + Kuu(:,:) = 0.d0 + Kuv(:,:) = 0.d0 + Kvu(:,:) = 0.d0 + Kvv(:,:) = 0.d0 + + ! compute spatial coordinates, velocity, and upper surface elevation for each node + + do n = 1, nNodesPerElement_2d + + ! Determine (i,j) for this vertex + ! The reason for the '3' is that node 3, in the NE corner of the grid cell, has index (i,j). + ! Indices for other nodes are computed relative to this vertex. + iVertex = i + ishift(3,n) + jVertex = j + jshift(3,n) + + x(n) = xVertex(iVertex,jVertex) + y(n) = yVertex(iVertex,jVertex) + u(n) = uvel(iVertex,jVertex) + v(n) = vvel(iVertex,jVertex) + s(n) = stagusrf(iVertex,jVertex) + h(n) = stagthck(iVertex,jVertex) + dsdx(n) = dusrf_dx(iVertex,jVertex) + dsdy(n) = dusrf_dy(iVertex,jVertex) + + if (verbose_matrix .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'i, j, n, x, y:', i, j, n, x(n), y(n) + print*, 's, u, v:', s(n), u(n), v(n) + endif + + enddo ! vertices per element + + ! Loop over quadrature points for this element + + do p = 1, nQuadPoints_2d + + ! Evaluate the derivatives of the element basis functions at this quadrature point. + + !WHL - Pass in i, j and p to the following subroutines for debugging + +! call t_startf('glissade_basis_function_derivs') + call get_basis_function_derivatives_2d(x(:), y(:), & + dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & + dphi_dx_2d(:), dphi_dy_2d(:), & + detJ(p) , i, j, p) + dphi_dz_2d(:) = 0.d0 +! call t_stopf('glissade_basis_function_derivs') + +! call t_startf('glissade_effective_viscosity') + + if (whichapprox == HO_APPROX_L1L2) then + + ! Compute effective viscosity for each layer at this quadrature point + call compute_effective_viscosity_L1L2(whichefvs, efvs_constant, & + nz, sigma, & + nNodesPerElement_2d, phi_2d(:,p), & + dphi_dx_2d(:), dphi_dy_2d(:), & + u(:), v(:), & + h(:), & + dsdx(:), dsdy(:), & + flwa(:,i,j), flwafact(:,i,j), & + efvs_qp(:,p), & + i, j, p) + + ! Compute vertical average of effective viscosity + efvs_qp_vertavg(p) = 0.d0 + do k = 1, nz-1 + efvs_qp_vertavg(p) = efvs_qp_vertavg(p) + efvs_qp(k,p) * (sigma(k+1) - sigma(k)) + enddo + + else ! SSA + + ! Compute vertically averaged effective viscosity at this quadrature point + call compute_effective_viscosity(whichefvs, whichapprox, & + efvs_constant, nNodesPerElement_2d, & + dphi_dx_2d(:), dphi_dy_2d(:), dphi_dz_2d(:), & + u(:), v(:), & + flwafact_2d(i,j), efvs_qp_vertavg(p), & + i, j, 1, p) + + ! Copy vertically averaged value to all levels + efvs_qp(:,p) = efvs_qp_vertavg(p) + + endif ! whichapprox + +! call t_stopf('glissade_effective_viscosity') + + ! Compute ice thickness at this quadrature point + + h_qp = 0.d0 + do n = 1, nNodesPerElement_2d + h_qp = h_qp + phi_2d(n,p) * h(n) + enddo + + ! Increment the element stiffness matrix with the contribution from each quadrature point. + ! Note: The effective viscosity is multiplied by thickness since the equation to be solved + ! is vertically integrated. + +! call t_startf('glissade_increment_element_stiffness') + call compute_element_matrix(whichapprox, nNodesPerElement_2d, & + wqp_2d(p), detJ(p), & + h_qp*efvs_qp_vertavg(p), & + dphi_dx_2d(:), dphi_dy_2d(:), dphi_dz_2d(:), & + Kuu(:,:), Kuv(:,:), & + Kvu(:,:), Kvv(:,:), & + i, j, 1, p ) +! call t_stopf('glissade_increment_element_stiffness') + + enddo ! nQuadPoints_2d + + ! Compute average of effective viscosity over quad points + ! For L1L2 there is a different efvs in each layer. + ! For SSA, simply write the vertical average value to each layer. + + efvs(:,i,j) = 0.d0 + do p = 1, nQuadPoints_2d + do k = 1, nz-1 + efvs(k,i,j) = efvs(k,i,j) + efvs_qp(k,p) + enddo + enddo + efvs(:,i,j) = efvs(:,i,j) / nQuadPoints_2d + + if (check_symmetry_element) then + call check_symmetry_element_matrix(nNodesPerElement_2d, & + Kuu, Kuv, Kvu, Kvv) + endif + +! call t_startf('glissade_element_to_global') + + ! Sum the terms of element matrix K into the dense assembled matrix A + + call element_to_global_matrix_2d(nx, ny, & + i, j, & + Kuu, Kuv, & + Kvu, Kvv, & + Auu, Auv, & + Avu, Avv) + +! call t_stopf('glissade_element_to_global') + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'i, j =', i, j + print*, 'k, efvs:' + do k = 1, nz-1 + print*, k, efvs(k,i,j) + enddo + endif + + endif ! active cell + + enddo ! i + enddo ! j + + end subroutine assemble_stiffness_matrix_2d + +!**************************************************************************** + + subroutine compute_3d_velocity_L1L2(nx, ny, & + nz, sigma, & + dx, dy, & + nhalo, & + ice_mask, land_mask, & + active_cell, active_vertex, & + xVertex, yVertex, & + thck, stagthck, & + usrf, & + dusrf_dx, dusrf_dy, & + flwa, efvs, & + whichgradient_margin, & + uvel, vvel) + + !---------------------------------------------------------------- + ! Given the basal velocity and the 3D profile of effective viscosity + ! and horizontal-plane stresses, construct the 3D stress and velocity + ! profiles for the L1L2 approximation. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + nhalo ! number of halo layers + + real(dp), intent(in) :: & + dx, dy ! grid cell length and width + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 for cells where ice is present (thk > thklim), else = 0 + land_mask ! = 1 for cells where topography is above sea level + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for vertices of active cells + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + real(dp), dimension(nx,ny), intent(in) :: & + thck, &! ice thickness at cell centers (m) + usrf ! upper surface elevation at cell centers (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagthck, & ! ice thickness at vertices (m) + dusrf_dx, & ! upper surface elevation gradient at cell vertices (m/m) + dusrf_dy + + real(dp), dimension(nz-1,nx,ny), intent(in) :: & + flwa, & ! temperature-based flow factor A, Pa^{-n} yr^{-1} + efvs ! effective viscosity, Pa yr + + integer, intent(in) :: & + whichgradient_margin ! option for computing gradient at ice margin + ! 0 = include all neighbor cells in gradient calculation + ! 1 = include ice-covered and/or land cells + ! 2 = include ice-covered cells only + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + uvel, vvel ! velocity components (m/yr) + ! on input, only the basal component (index nz) is known + ! on output, the full 3D velocity field is known + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: iVertex, jVertex ! indices of element vertices + + real(dp), dimension(nNodesPerElement_2d) :: & + x, y, &! x and y coordinates of element vertices + u, v, &! basal velocity components at element vertices + dphi_dx_2d, dphi_dy_2d ! derivatives of basis functions, evaluated at cell center + + real(dp) :: & + detJ ! determinant of J (never used in calculation) + + real(dp), dimension(nx,ny) :: & + du_dx, du_dy, &! basal strain rate components, evaluated at cell centers + dv_dx, dv_dy, &! + work1, work2, work3 ! work arrays for computing tau_xz and tau_yz; located at cell centers + + real(dp), dimension(nz-1,nx,ny) :: & + tau_parallel, &! tau_parallel, evaluated at cell centers + efvs_integral_z_to_s ! integral of effective viscosity from base of layer k + ! to the upper surface (Pa yr m) + + ! Note: These L1L2 stresses are located at nodes. + ! The diagnostic stresses (model%stress%tau%xz, etc.) are located at cell centers. + real(dp), dimension(nz-1,nx-1,ny-1) :: & + tau_xz, tau_yz ! vertical shear stress components at layer midpoints for each vertex + + real(dp), dimension(nx-1,ny-1) :: & + dwork1_dx, dwork1_dy, &! derivatives of work arrays; located at vertices + dwork2_dx, dwork2_dy, &! + dwork3_dx, dwork3_dy, &! + stagtau_parallel_sq, &! tau_parallel^2, interpolated to staggered grid + stagflwa ! flwa, interpolated to staggered grid + + real(dp) :: & + depth, &! distance from upper surface to midpoint of a given layer + eps_parallel, &! parallel effective strain rate, evaluated at cell centers + tau_eff_sq, &! square of effective stress (Pa^2) + ! = tau_parallel^2 + tau_perp^2 for L1L2 + fact ! factor in velocity integral + + real(dp), dimension(nx-1,ny-1) :: & + dusrf_dx_edge, & ! upper surface elevation gradient at cell edges (m/m) + dusrf_dy_edge + + integer :: i, j, k, n + + !----------------------------------------------------------------------------------------------- + !WHL: I tried two ways to compute the 3D velocity, given tau_perp, tau_xz and tau_yz in each layer: + ! (1) Compute velocity at vertices using + ! u(z) = u_b + 2 * integral_b_to_z [A*tau_eff^(n-1)*tau_xz dz] + ! v(z) = v_b + 2 * integral_b_to_z [A*tau_eff^(n-1)*tau_yz dz] + ! (2) Compute velocity at edges using + ! uedge(z) = (vintfact(i,j) + vintfact(i,j-1))/2.d0 * dsdx_edge + ! vedge(z) = (vintfact(i,j) + vintfact(i-1,j))/2.d0 * dsdy_edge + ! where vintfact = 2*A*tau_eff^(n-1)*(rho*g*|grad(s)| + ! Average uedge and vedge to vertices and add to u_b to get 3D uvel and vvel. + ! + ! Method 2 resembles the methods used by Glide and by the Glissade local SIA solver. + ! For the no-slip case, method 2 gives the same answers (within roundoff) as the local SIA solver. + ! However, method 2 does not include the gradient of membrane stresses in the tau_xz and tau_yz terms + ! (Perego et al. Eq. 27). It does include tau_parallel in tau_eff. + ! For the Halfar test, method 1 is slightly more accurate but can give rise to checkerboard noise. + ! Checkerboard noise can be damped by using an upstream gradient for grad(s), but this + ! reduces the accuracy for the Halfar test. (Method 2 with centered gradients is more + ! accurate than method 1 with upstream gradients.) + !----------------------------------------------------------------------------------------------- + + logical, parameter :: edge_velocity = .false. ! if false, use method 1 as discussed above + ! if true, use method 2 + + real(dp), dimension(nx,ny) :: & + uedge, vedge ! velocity components at edges of a layer, relative to bed (m/yr) + ! u on E edge, v on N edge (C grid) + + real(dp), dimension(nz,nx-1,ny-1) :: & + vintfact ! vertical integration factor at vertices + + ! Initialize + efvs_integral_z_to_s(:,:,:) = 0.d0 + tau_parallel(:,:,:) = 0.d0 + du_dx(:,:) = 0.d0 + du_dy(:,:) = 0.d0 + dv_dx(:,:) = 0.d0 + dv_dy(:,:) = 0.d0 + + ! Compute viscosity integral and strain rates in elements. + ! Loop over all cells that border locally owned vertices. + + do j = 1+nhalo, ny-nhalo+1 + do i = 1+nhalo, nx-nhalo+1 + + if (active_cell(i,j)) then + + ! Load x and y coordinates and basal velocity at cell vertices + + do n = 1, nNodesPerElement_2d + + ! Determine (i,j) for this vertex + ! The reason for the '3' is that node 3, in the NE corner of the grid cell, has index (i,j). + ! Indices for other nodes are computed relative to this vertex. + iVertex = i + ishift(3,n) + jVertex = j + jshift(3,n) + + x(n) = xVertex(iVertex,jVertex) + y(n) = yVertex(iVertex,jVertex) + + u(n) = uvel(nz,iVertex,jVertex) ! basal velocity + v(n) = vvel(nz,iVertex,jVertex) + + enddo + + ! Compute dphi_dx and dphi_dy at cell center + + call get_basis_function_derivatives_2d(x(:), y(:), & + dphi_dxr_2d_ctr(:), dphi_dyr_2d_ctr(:), & + dphi_dx_2d(:), dphi_dy_2d(:), & + detJ, i, j, 1) + + ! Compute basal strain rate components at cell center + + do n = 1, nNodesPerElement_2d + du_dx(i,j) = du_dx(i,j) + dphi_dx_2d(n)*u(n) + du_dy(i,j) = du_dy(i,j) + dphi_dy_2d(n)*u(n) + + dv_dx(i,j) = dv_dx(i,j) + dphi_dx_2d(n)*v(n) + dv_dy(i,j) = dv_dy(i,j) + dphi_dy_2d(n)*v(n) + enddo + + ! Compute effective strain rate (squared) at cell centers + ! See Perego et al. eq. 17: + ! eps_parallel^2 = eps_xx^2 + eps_yy^2 + eps_xx*eps_yy + eps_xy^2 + + eps_parallel = sqrt(du_dx(i,j)**2 + dv_dy(i,j)**2 + du_dx(i,j)*dv_dy(i,j) & + + 0.25d0*(dv_dx(i,j) + du_dy(i,j))**2) + + ! For each layer k, compute tau_parallel at cell centers + do k = 1, nz-1 + tau_parallel(k,i,j) = 2.d0 * efvs(k,i,j) * eps_parallel + enddo + + ! For each layer k, compute the integral of the effective viscosity from + ! the base of layer k to the upper surface. + + efvs_integral_z_to_s(1,i,j) = efvs(1,i,j) * (sigma(2) - sigma(1))*thck(i,j) + + do k = 2, nz-1 + efvs_integral_z_to_s(k,i,j) = efvs_integral_z_to_s(k-1,i,j) & + + efvs(k,i,j) * (sigma(k+1) - sigma(k))*thck(i,j) + enddo ! k + + endif ! active_cell + + enddo ! i + enddo ! j + + !-------------------------------------------------------------------------------- + ! For each active vertex, compute the vertical shear stresses tau_xz and tau_yz + ! in each layer of the column. + ! + ! These stresses are given by (PGB eq. 27) + ! + ! tau_xz(z) = -rhoi*grav*ds_dx*(s-z) + 2*d/dx[efvs_int(z) * (2*du_dx + dv_dy)] + ! + 2*d/dy[efvs_int(z) * (du_dy + dv_dx)] + ! + ! tau_yz(z) = -rhoi*grav*ds_dy*(s-z) + 2*d/dx[efvs_int(z) * (du_dy + dv_dx)] + ! + 2*d/dy[efvs_int(z) * (2*dv_dy + du_dx)] + ! + ! where efvs_int is the integral of efvs from z to s computed above; + ! the strain rate components of basal velocity are also as computed above. + ! + ! There is not a clean way to compute these stresses using finite-element techniques, + ! because strain rates are discontinuous at cell edges and vertices. Instead, we use + ! a standard centered finite difference method to evaluate d/dx and d/dy of the + ! bracketed terms. + !-------------------------------------------------------------------------------- + + tau_xz(:,:,:) = 0.d0 + tau_yz(:,:,:) = 0.d0 + + do k = 1, nz-1 ! loop over layers + + ! Evaluate centered finite differences of bracketed terms above. + ! We need dwork1_dx, dwork2_dx, dwork2_dy and dwork3_dx. + ! The calls to glissade_centered_gradient compute a couple of extraneous derivatives, + ! but these calls are simpler than inlining the gradient code. + ! Setting gradient_margin_in = HO_GRADIENT_MARGIN_ICE_ONLY uses only ice-covered cells to + ! compute the gradient. This is the appropriate flag for these + ! calls, because efvs and strain rates have no meaning in ice-free cells. + + work1(:,:) = efvs_integral_z_to_s(k,:,:) * (2.d0*du_dx(:,:) + dv_dy(:,:)) + work2(:,:) = efvs_integral_z_to_s(k,:,:) * (du_dy(:,:) + dv_dx(:,:)) + work3(:,:) = efvs_integral_z_to_s(k,:,:) * (2.d0*dv_dy(:,:) + du_dx(:,:)) + + call glissade_centered_gradient(nx, ny, & + dx, dy, & + work1, & + dwork1_dx, dwork1_dy, & + ice_mask, & + gradient_margin_in = HO_GRADIENT_MARGIN_ICE_ONLY) + + call glissade_centered_gradient(nx, ny, & + dx, dy, & + work2, & + dwork2_dx, dwork2_dy, & + ice_mask, & + gradient_margin_in = HO_GRADIENT_MARGIN_ICE_ONLY) + + call glissade_centered_gradient(nx, ny, & + dx, dy, & + work3, & + dwork3_dx, dwork3_dy, & + ice_mask, & + gradient_margin_in = HO_GRADIENT_MARGIN_ICE_ONLY) + + ! Loop over locally owned active vertices, evaluating tau_xz and tau_yz for this layer + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + if (active_vertex(i,j)) then + depth = 0.5d0*(sigma(k) + sigma(k+1)) * stagthck(i,j) ! depth at layer midpoint + tau_xz(k,i,j) = -rhoi*grav*depth*dusrf_dx(i,j) & + + 2.d0*dwork1_dx(i,j) + dwork2_dy(i,j) + tau_yz(k,i,j) = -rhoi*grav*depth*dusrf_dy(i,j) & + + dwork2_dx(i,j) + 2.d0*dwork3_dy(i,j) + endif + enddo ! i + enddo ! j + + enddo ! k + + if ((verbose_L1L2 .or. verbose_tau) .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'L1L2: k, -rho*g*(s-z)*ds/dx, -rho*g*(s-z)*ds/dy:' + do k = 1, nz-1 + depth = 0.5d0*(sigma(k) + sigma(k+1)) * stagthck(i,j) + print*, k, -rhoi*grav*depth*dusrf_dx(i,j), -rhoi*grav*depth*dusrf_dy(i,j) + enddo + print*, ' ' + print*, 'L1L2: k, tau_xz, tau_yz, tau_parallel:' + do k = 1, nz-1 + print*, k, tau_xz(k,i,j), tau_yz(k,i,j), tau_parallel(k,i,j) + enddo + endif + + !-------------------------------------------------------------------------------- + ! Given the vertical shear stresses tau_xz and tau_yz for each layer k, + ! compute the velocity components at each level. + ! + ! These are given by (PGB eq. 30) + ! + ! u(z) = u_b + 2 * integral_b_to_z [A*tau_eff^(n-1)*tau_xz dz] + ! v(z) = v_b + 2 * integral_b_to_z [A*tau_eff^(n-1)*tau_yz dz] + ! + ! where tau_eff^2 = tau_parallel^2 + tau_perp^2 + ! + ! tau_parallel^2 = (2 * efvs * eps_parallel)^2 + ! tau_perp ^2 = tau_xz^2 + tau_yz^2 + ! + ! See comments above about method 2, with edge_velocity = .true. + !-------------------------------------------------------------------------------- + + ! initialize uvel = vvel = 0 except at bed + + uvel(1:nz-1,:,:) = 0.d0 + vvel(1:nz-1,:,:) = 0.d0 + vintfact(:,:,:) = 0.d0 + + ! Compute surface elevation gradient on cell edges. + ! Setting gradient_margin_in = 0 takes the gradient over both neighboring cells, + ! including ice-free cells. + ! Setting gradient_margin_in = 1 computes a gradient if both neighbor cells are + ! either ice-covered cells or land cells; else gradient = 0. + ! Setting gradient_margin_in = 2 computes a gradient only if both neighbor cells + ! are ice-covered. + ! At a land margin, either 0 or 1 is appropriate, but 2 is inaccurate. + ! At a shelf margin, either 1 or 2 is appropriate, but 0 is inaccurate. + ! So HO_GRADIENT_MARGIN_ICE_LAND = 1 is the safest value. + + if (edge_velocity) then + + uedge(:,:) = 0.d0 + vedge(:,:) = 0.d0 + + call glissade_edge_gradient(nx, ny, & + dx, dy, & + usrf, & + dusrf_dx_edge, dusrf_dy_edge, & + gradient_margin_in = whichgradient_margin, & + ice_mask = ice_mask, & + land_mask = land_mask) + endif + + if (verbose_L1L2 .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'i, j =', itest, jtest + print*, 'k, uvel, vvel:' + endif + + do k = nz-1, 1, -1 ! loop over velocity levels above the bed + + ! Average tau_parallel and flwa to vertices + ! With stagger_margin_in = 1, only cells with ice are included in the average. + + call glissade_stagger(nx, ny, & + tau_parallel(k,:,:), stagtau_parallel_sq(:,:), & + ice_mask, stagger_margin_in = 1) + stagtau_parallel_sq(:,:) = stagtau_parallel_sq(:,:)**2 + + call glissade_stagger(nx, ny, & + flwa(k,:,:), stagflwa(:,:), & + ice_mask, stagger_margin_in = 1) + + if (edge_velocity) then ! compute velocity at edges and interpolate to vertices + ! (method 2) + + ! Compute vertical integration factor at each active vertex + ! This is int_b_to_z{-2 * A * tau^2 * rho*g*(s-z) * dz}, + ! similar to the factor computed in Glide and glissade_velo_sia.. + ! Note: tau_xz ~ rho*g*(s-z)*ds_dx; ds_dx term is computed on edges below + + do j = 1, ny-1 + do i = 1, nx-1 + if (active_vertex(i,j)) then + + tau_eff_sq = stagtau_parallel_sq(i,j) & + + tau_xz(k,i,j)**2 + tau_yz(k,i,j)**2 + + depth = 0.5d0*(sigma(k) + sigma(k+1)) * stagthck(i,j) + + vintfact(k,i,j) = vintfact(k+1,i,j) & + - 2.d0 * stagflwa(i,j) * tau_eff_sq * rhoi*grav*depth & + * (sigma(k+1) - sigma(k))*stagthck(i,j) + + endif + enddo + enddo + + ! Need to have vintfact at halo nodes to compute uvel/vvel at locally owned nodes + call staggered_parallel_halo(vintfact(k,:,:)) + + ! loop over cells, skipping outer halo rows + + ! u at east edges + do j = 2, ny-1 + do i = 1, nx-1 + if (active_vertex(i,j) .and. active_vertex(i,j-1)) then + uedge(i,j) = (vintfact(k,i,j) + vintfact(k,i,j-1))/2.d0 * dusrf_dx_edge(i,j) + endif + enddo + enddo + + ! v at north edges + do j = 1, ny-1 + do i = 2, nx-1 + if (active_vertex(i,j) .and. active_vertex(i-1,j)) then + vedge(i,j) = (vintfact(k,i,j) + vintfact(k,i-1,j))/2.d0 * dusrf_dy_edge(i,j) + endif + enddo + enddo + + ! Average edge velocities to vertices and add to ubas + ! Do this for locally owned vertices only + ! (Halo update is done at a higher level after returning) + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + uvel(k,i,j) = uvel(nz,i,j) + (uedge(i,j) + uedge(i,j+1)) / 2.d0 + vvel(k,i,j) = vvel(nz,i,j) + (vedge(i,j) + vedge(i+1,j)) / 2.d0 + + if (verbose_L1L2 .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, k, uvel(k,i,j), vvel(k,i,j) + endif + enddo + enddo + + else ! compute velocity at vertices (method 1) + + ! loop over locally owned active vertices + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + + if (active_vertex(i,j)) then + + ! compute velocity components at this level + + tau_eff_sq = stagtau_parallel_sq(i,j) & + + tau_xz(k,i,j)**2 + tau_yz(k,i,j)**2 + + ! Note: This formula is correct for any value of Glen's n, but currently efvs is computed + ! only for gn = 3 (in which case (n-1)/2 = 1). + fact = 2.d0 * stagflwa(i,j) * tau_eff_sq**((gn-1.d0)/2.d0) * (sigma(k+1) - sigma(k))*stagthck(i,j) + + uvel(k,i,j) = uvel(k+1,i,j) + fact * tau_xz(k,i,j) + vvel(k,i,j) = vvel(k+1,i,j) + fact * tau_yz(k,i,j) + + if (verbose_L1L2 .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, k, uvel(k,i,j), vvel(k,i,j) + endif + + endif + + enddo ! i + enddo ! j + + endif ! edge_velocity + + enddo ! k + + end subroutine compute_3d_velocity_L1L2 + +!**************************************************************************** + + subroutine get_basis_function_derivatives_3d(xNode, yNode, zNode, & + dphi_dxr_3d, dphi_dyr_3d, dphi_dzr_3d, & + dphi_dx_3d, dphi_dy_3d, dphi_dz_3d, & + detJ, i, j, k, p) + + !------------------------------------------------------------------ + ! Evaluate the x, y and z derivatives of the element basis functions + ! at a particular quadrature point. + ! + ! Also determine the Jacobian of the transformation between the + ! reference element and the true element. + ! + ! This subroutine should work for any 3D element with any number of nodes. + !------------------------------------------------------------------ + + real(dp), dimension(nNodesPerElement_3d), intent(in) :: & + xNode, yNode, zNode, &! nodal coordinates + dphi_dxr_3d, dphi_dyr_3d, dphi_dzr_3d ! derivatives of basis functions at quad pt + ! wrt x, y and z in reference element + + real(dp), dimension(nNodesPerElement_3d), intent(out) :: & + dphi_dx_3d, dphi_dy_3d, dphi_dz_3d ! derivatives of basis functions at quad pt + ! wrt x, y and z in true Cartesian coordinates + + real(dp), intent(out) :: & + detJ ! determinant of Jacobian matrix + + real(dp), dimension(3,3) :: & + Jac, &! Jacobian matrix + Jinv, &! inverse Jacobian matrix + cofactor ! matrix of cofactors + + integer, intent(in) :: i, j, k, p ! indices passed in for debugging + + integer :: n, row, col + + logical, parameter :: Jac_bug_check = .false. ! set to true for debugging + real(dp), dimension(3,3) :: prod ! Jac * Jinv (should be identity matrix) + + !------------------------------------------------------------------ + ! Compute the Jacobian for the transformation from the reference + ! coordinates to the true coordinates: + ! + ! | | + ! | sum_n{dphi_n/dxr * xn} sum_n{dphi_n/dxr * yn} sum_n{dphi_n/dxr * zn} | + ! J(xr,yr,zr) = | | + ! | sum_n{dphi_n/dyr * xn} sum_n{dphi_n/dyr * yn} sum_n{dphi_n/dyr * zn} | + ! | | + ! | sum_n{dphi_n/dzr * xn} sum_n{dphi_n/dzr * yn} sum_n{dphi_n/dzr * zn} | + ! ! | + ! + ! where (xn,yn,zn) are the true Cartesian nodal coordinates, + ! (xr,yr,zr) are the coordinates of the quad point in the reference element, + ! and sum_n denotes a sum over nodes. + !------------------------------------------------------------------ + + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'In get_basis_function_derivatives_3d: i, j, k, p =', i, j, k, p + endif + + Jac(:,:) = 0.d0 + + do n = 1, nNodesPerElement_3d + Jac(1,1) = Jac(1,1) + dphi_dxr_3d(n) * xNode(n) + Jac(1,2) = Jac(1,2) + dphi_dxr_3d(n) * yNode(n) + Jac(1,3) = Jac(1,3) + dphi_dxr_3d(n) * zNode(n) + Jac(2,1) = Jac(2,1) + dphi_dyr_3d(n) * xNode(n) + Jac(2,2) = Jac(2,2) + dphi_dyr_3d(n) * yNode(n) + Jac(2,3) = Jac(2,3) + dphi_dyr_3d(n) * zNode(n) + Jac(3,1) = Jac(3,1) + dphi_dzr_3d(n) * xNode(n) + Jac(3,2) = Jac(3,2) + dphi_dzr_3d(n) * yNode(n) + Jac(3,3) = Jac(3,3) + dphi_dzr_3d(n) * zNode(n) + enddo + + !------------------------------------------------------------------ + ! Compute the determinant and inverse of J + !------------------------------------------------------------------ + + cofactor(1,1) = Jac(2,2)*Jac(3,3) - Jac(2,3)*Jac(3,2) + cofactor(1,2) = -(Jac(2,1)*Jac(3,3) - Jac(2,3)*Jac(3,1)) + cofactor(1,3) = Jac(2,1)*Jac(3,2) - Jac(2,2)*Jac(3,1) + cofactor(2,1) = -(Jac(1,2)*Jac(3,3) - Jac(1,3)*Jac(3,2)) + cofactor(2,2) = Jac(1,1)*Jac(3,3) - Jac(1,3)*Jac(3,1) + cofactor(2,3) = -(Jac(1,1)*Jac(3,2) - Jac(1,2)*Jac(3,1)) + cofactor(3,1) = Jac(1,2)*Jac(2,3) - Jac(1,3)*Jac(2,2) + cofactor(3,2) = -(Jac(1,1)*Jac(2,3) - Jac(1,3)*Jac(2,1)) + cofactor(3,3) = Jac(1,1)*Jac(2,2) - Jac(1,2)*Jac(2,1) + + detJ = Jac(1,1)*cofactor(1,1) + Jac(1,2)*cofactor(1,2) + Jac(1,3)*cofactor(1,3) + + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'detJ1:', Jac(1,1)*cofactor(1,1) + Jac(1,2)*cofactor(1,2) + Jac(1,3)*cofactor(1,3) + print*, 'detJ2:', Jac(2,1)*cofactor(2,1) + Jac(2,2)*cofactor(2,2) + Jac(2,3)*cofactor(2,3) + print*, 'detJ3:', Jac(3,1)*cofactor(3,1) + Jac(3,2)*cofactor(3,2) + Jac(3,3)*cofactor(3,3) + endif + + if (abs(detJ) > 0.d0) then + do col = 1, 3 + do row = 1, 3 + Jinv(row,col) = cofactor(col,row) + enddo + enddo + Jinv(:,:) = Jinv(:,:) / detJ + else + print*, 'stopping, det J = 0' + print*, 'i, j, k, p:', i, j, k, p + print*, 'Jacobian matrix:' + print*, Jac(1,:) + print*, Jac(2,:) + print*, Jac(3,:) + call write_log('Jacobian matrix is singular', GM_FATAL) + endif + + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'Jacobian calc, p =', p + print*, 'det J =', detJ + print*, ' ' + print*, 'Jacobian matrix:' + print*, Jac(1,:) + print*, Jac(2,:) + print*, Jac(3,:) + print*, ' ' + print*, 'cofactor matrix:' + print*, cofactor(1,:) + print*, cofactor(2,:) + print*, cofactor(3,:) + print*, ' ' + print*, 'Inverse matrix:' + print*, Jinv(1,:) + print*, Jinv(2,:) + print*, Jinv(3,:) + print*, ' ' + prod = matmul(Jac, Jinv) + print*, 'Jac*Jinv:' + print*, prod(1,:) + print*, prod(2,:) + print*, prod(3,:) + endif + + ! Optional bug check: Verify that J * Jinv = I + + if (Jac_bug_check) then + prod = matmul(Jac,Jinv) + do col = 1, 3 + do row = 1, 3 + if (abs(prod(row,col) - identity3(row,col)) > 1.d-11) then + print*, 'stopping, Jac * Jinv /= identity' + print*, 'i, j, k, p:', i, j, k, p + print*, 'Jac*Jinv:' + print*, prod(1,:) + print*, prod(2,:) + print*, prod(3,:) + call write_log('Jacobian matrix was not correctly inverted', GM_FATAL) + endif + enddo + enddo + endif ! Jac_bug_check + + !------------------------------------------------------------------ + ! Compute the contribution of this quadrature point to dphi/dx and dphi/dy + ! for each basis function. + ! + ! | dphi_n/dx | | dphi_n/dxr | + ! | | | | + ! | dphi_n/dy | = Jinv * | dphi_n/dyr | + ! | | | | + ! | dphi_n/dz | | dphi_n/dzr | + ! + !------------------------------------------------------------------ + + dphi_dx_3d(:) = 0.d0 + dphi_dy_3d(:) = 0.d0 + dphi_dz_3d(:) = 0.d0 + + do n = 1, nNodesPerElement_3d + dphi_dx_3d(n) = Jinv(1,1)*dphi_dxr_3d(n) & + + Jinv(1,2)*dphi_dyr_3d(n) & + + Jinv(1,3)*dphi_dzr_3d(n) + dphi_dy_3d(n) = Jinv(2,1)*dphi_dxr_3d(n) & + + Jinv(2,2)*dphi_dyr_3d(n) & + + Jinv(2,3)*dphi_dzr_3d(n) + dphi_dz_3d(n) = Jinv(3,1)*dphi_dxr_3d(n) & + + Jinv(3,2)*dphi_dyr_3d(n) & + + Jinv(3,3)*dphi_dzr_3d(n) + enddo + + if (Jac_bug_check) then + + ! Check that the sum of dphi_dx, etc. is close to zero + + if (abs( sum(dphi_dx_3d)/maxval(dphi_dx_3d) ) > 1.d-11) then + print*, 'stopping, sum over basis functions of dphi_dx > 0' + print*, 'dphi_dx_3d =', dphi_dx_3d(:) + print*, 'sum =', sum(dphi_dx_3d) + print*, 'i, j, k, p =', i, j, k, p + call write_log('Sum over basis functions of dphi_dx /= 0', GM_FATAL) + endif + + if (abs( sum(dphi_dy_3d)/maxval(dphi_dy_3d) ) > 1.d-11) then + print*, 'stopping, sum over basis functions of dphi_dy > 0' + print*, 'dphi_dy_3d =', dphi_dy_3d(:) + print*, 'sum =', sum(dphi_dy_3d) + print*, 'i, j, k, p =', i, j, k, p + call write_log('Sum over basis functions of dphi_dy /= 0', GM_FATAL) + endif + + if (abs( sum(dphi_dz_3d)/maxval(dphi_dz_3d) ) > 1.d-11) then + print*, 'stopping, sum over basis functions of dphi_dz > 0' + print*, 'dphi_dz_3d =', dphi_dz_3d(:) + print*, 'sum =', sum(dphi_dz_3d) + print*, 'i, j, k, p =', i, j, k, p + call write_log('Sum over basis functions of dphi_dz /= 0', GM_FATAL) + endif + + endif ! Jac_bug_check + + end subroutine get_basis_function_derivatives_3d + +!**************************************************************************** + + subroutine get_basis_function_derivatives_2d(xNode, yNode, & + dphi_dxr_2d, dphi_dyr_2d, & + dphi_dx_2d, dphi_dy_2d, & + detJ, i, j, p) + + !------------------------------------------------------------------ + ! Evaluate the x and y derivatives of 2D element basis functions + ! at a particular quadrature point. + ! + ! Also determine the Jacobian of the transformation between the + ! reference element and the true element. + ! + ! This subroutine should work for any 2D element with any number of nodes. + !------------------------------------------------------------------ + + real(dp), dimension(nNodesPerElement_2d), intent(in) :: & + xNode, yNode, &! nodal coordinates + dphi_dxr_2d, dphi_dyr_2d ! derivatives of basis functions at quad pt + ! wrt x and y in reference element + + real(dp), dimension(nNodesPerElement_2d), intent(out) :: & + dphi_dx_2d, dphi_dy_2d ! derivatives of basis functions at quad pt + ! wrt x and y in true Cartesian coordinates + + real(dp), intent(out) :: & + detJ ! determinant of Jacobian matrix + + real(dp), dimension(2,2) :: & + Jac, &! Jacobian matrix + Jinv ! inverse Jacobian matrix + + integer, intent(in) :: i, j, p + + integer :: n, row, col + + logical, parameter :: Jac_bug_check = .false. ! set to true for debugging + real(dp), dimension(2,2) :: prod ! Jac * Jinv (should be identity matrix) + + !------------------------------------------------------------------ + ! Compute the Jacobian for the transformation from the reference + ! coordinates to the true coordinates: + ! + ! | | + ! | sum_n{dphi_n/dxr * xn} sum_n{dphi_n/dxr * yn} | + ! J(xr,yr) = | | + ! | sum_n{dphi_n/dyr * xn} sum_n{dphi_n/dyr * yn} | + ! | | + ! + ! where (xn,yn) are the true Cartesian nodal coordinates, + ! (xr,yr) are the coordinates of the quad point in the reference element, + ! and sum_n denotes a sum over nodes. + !------------------------------------------------------------------ + + Jac(:,:) = 0.d0 + + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'In get_basis_function_derivatives_2d: i, j, p =', i, j, p + endif + + do n = 1, nNodesPerElement_2d + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'n, x, y:', n, xNode(n), yNode(n) + print*, 'dphi_dxr_2d, dphi_dyr_2d:', dphi_dxr_2d(n), dphi_dyr_2d(n) + endif + Jac(1,1) = Jac(1,1) + dphi_dxr_2d(n) * xNode(n) + Jac(1,2) = Jac(1,2) + dphi_dxr_2d(n) * yNode(n) + Jac(2,1) = Jac(2,1) + dphi_dyr_2d(n) * xNode(n) + Jac(2,2) = Jac(2,2) + dphi_dyr_2d(n) * yNode(n) + enddo + + !------------------------------------------------------------------ + ! Compute the determinant and inverse of J + !------------------------------------------------------------------ + + detJ = Jac(1,1)*Jac(2,2) - Jac(1,2)*Jac(2,1) + + if (abs(detJ) > 0.d0) then + Jinv(1,1) = Jac(2,2)/detJ + Jinv(1,2) = -Jac(1,2)/detJ + Jinv(2,1) = -Jac(2,1)/detJ + Jinv(2,2) = Jac(1,1)/detJ + else + print*, 'stopping, det J = 0' + print*, 'i, j, p:', i, j, p + print*, 'Jacobian matrix:' + print*, Jac(1,:) + print*, Jac(2,:) + call write_log('Jacobian matrix is singular', GM_FATAL) + endif + + if (verbose_Jac .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Jacobian calc, p =', p + print*, 'det J =', detJ + print*, ' ' + print*, 'Jacobian matrix:' + print*, Jac(1,:) + print*, Jac(2,:) + print*, ' ' + print*, 'Inverse matrix:' + print*, Jinv(1,:) + print*, Jinv(2,:) + print*, ' ' + prod = matmul(Jac, Jinv) + print*, 'Jac*Jinv:' + print*, prod(1,:) + print*, prod(2,:) + endif + + ! Optional bug check - Verify that J * Jinv = I + + if (Jac_bug_check) then + prod = matmul(Jac,Jinv) + do col = 1, 2 + do row = 1, 2 + if (abs(prod(row,col) - identity3(row,col)) > 1.d-12) then + print*, 'stopping, Jac * Jinv /= identity' + print*, 'i, j, p:', i, j, p + print*, 'Jac*Jinv:' + print*, prod(1,:) + print*, prod(2,:) + call write_log('Jacobian matrix was not correctly inverted', GM_FATAL) + endif + enddo + enddo + endif + + !------------------------------------------------------------------ + ! Compute the contribution of this quadrature point to dphi/dx and dphi/dy + ! for each basis function. + ! + ! | dphi_n/dx | | dphi_n/dxr | + ! | | = Jinv * | | + ! | dphi_n/dy | | dphi_n/dyr | + ! + !------------------------------------------------------------------ + + dphi_dx_2d(:) = 0.d0 + dphi_dy_2d(:) = 0.d0 + + do n = 1, nNodesPerElement_2d + dphi_dx_2d(n) = dphi_dx_2d(n) + Jinv(1,1)*dphi_dxr_2d(n) & + + Jinv(1,2)*dphi_dyr_2d(n) + dphi_dy_2d(n) = dphi_dy_2d(n) + Jinv(2,1)*dphi_dxr_2d(n) & + + Jinv(2,2)*dphi_dyr_2d(n) + enddo + + if (Jac_bug_check) then + + ! Check that the sum of dphi_dx, etc. is close to zero + if (abs( sum(dphi_dx_2d)/maxval(dphi_dx_2d) ) > 1.d-11) then + print*, 'stopping, sum over basis functions of dphi_dx > 0' + print*, 'dphi_dx_2d =', dphi_dx_2d(:) + print*, 'i, j, p =', i, j, p + call write_log('Sum over basis functions of dphi_dx /= 0', GM_FATAL) + endif + + if (abs( sum(dphi_dy_2d)/maxval(dphi_dy_2d) ) > 1.d-11) then + print*, 'stopping, sum over basis functions of dphi_dy > 0' + print*, 'dphi_dy =', dphi_dy_2d(:) + print*, 'i, j, p =', i, j, p + call write_log('Sum over basis functions of dphi_dy /= 0', GM_FATAL) + endif + + endif + + end subroutine get_basis_function_derivatives_2d + +!**************************************************************************** + + subroutine compute_basal_friction_heatflx(nx, ny, & + nhalo, active_cell, & + xVertex, yVertex, & + uvel, vvel, & + beta, bfricflx) + + !---------------------------------------------------------------- + ! Compute the heat flux due to basal friction, given the 2D basal + ! velocity and beta fields. + ! + ! Assume a sliding law of the form: + ! tau_x = -beta*u + ! tau_y = -beta*v + ! where beta and (u,v) are defined at vertices. + ! + ! The frictional heat flux (W/m^2) is given by q_b = tau_b * u_b, + ! where tau_b and u_b are the magnitudes of the basal stress + ! and velocity (e.g., Cuffey & Paterson, p. 418). + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nhalo ! number of halo layers + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of each vertex (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel, & ! basal velocity components at each vertex (m/yr) + beta ! basal traction parameter (Pa/(m/yr)) + + real(dp), dimension(nx,ny), intent(out) :: & + bfricflx ! basal heat flux from friction (W/m^2) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, n, p + integer :: iVertex, jVertex + + real(dp), dimension(nNodesPerElement_2d) :: & + x, y, & ! spatial coordinates of nodes + u, v, & ! velocity components at nodes + b ! beta at nodes + + real(dp) :: & + u_qp, v_qp, & ! u and v at quadrature points + beta_qp, & ! beta at quadrature points + sum_wqp ! sum of weighting factors + + ! initialize + bfricflx(:,:) = 0.d0 + + ! Loop over local cells + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + if (active_cell(i,j)) then ! ice is present + + ! Load x and y coordinates, basal velocity, and beta at cell vertices + + do n = 1, nNodesPerElement_2d + + ! Determine (i,j) for this vertex + ! The reason for the '3' is that node 3, in the NE corner of the grid cell, has index (i,j). + ! Indices for other nodes are computed relative to this vertex. + iVertex = i + ishift(3,n) + jVertex = j + jshift(3,n) + + x(n) = xVertex(iVertex,jVertex) + y(n) = yVertex(iVertex,jVertex) + u(n) = uvel(iVertex,jVertex) + v(n) = vvel(iVertex,jVertex) + b(n) = beta(iVertex,jVertex) + + enddo + + sum_wqp = 0.d0 + + ! loop over quadrature points + do p = 1, nQuadPoints_2d + + ! Evaluate u, v and beta at this quadrature point + + u_qp = 0.d0 + v_qp = 0.d0 + beta_qp = 0.d0 + do n = 1, nNodesPerElement_2d + u_qp = u_qp + phi_2d(n,p) * u(n) + v_qp = v_qp + phi_2d(n,p) * v(n) + beta_qp = beta_qp + phi_2d(n,p) * b(n) + enddo + + ! Increment basal frictional heating + + bfricflx(i,j) = bfricflx(i,j) + wqp_2d(p) * beta_qp * (u_qp**2 + v_qp**2) + sum_wqp = sum_wqp + wqp_2d(p) + + if (verbose_bfric .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Increment basal friction heating, i, j, p =', i, j, p + print*, 'u, v, beta_qp =', u_qp, v_qp, beta_qp + print*, 'local increment =', beta_qp * (u_qp**2 + v_qp**2) / scyr + endif + + enddo ! nQuadPoints_2d + + ! Scale the result: + ! Divide by sum_wqp to get average of beta*(u^2 + v^2) over cell + ! Divide by scyr to convert Pa m/yr to Pa m/s = W/m^2 + + bfricflx(i,j) = bfricflx(i,j) / (sum_wqp * scyr) + + if (verbose_bfric .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'i, j, bfricflx:', i, j, bfricflx(i,j) + endif + + endif ! active_cell + + enddo ! i + enddo ! j + + ! halo update + call parallel_halo(bfricflx) + + end subroutine compute_basal_friction_heatflx + +!**************************************************************************** + + subroutine compute_internal_stress (nx, ny, & + nz, sigma, & + nhalo, active_cell, & + xVertex, yVertex, & + stagusrf, stagthck, & + flwafact, efvs, & + whichefvs, efvs_constant, & + whichapprox, & + uvel, vvel, & + tau_xz, tau_yz, & + tau_xx, tau_yy, & + tau_xy, tau_eff) + + !---------------------------------------------------------------- + ! Compute internal ice stresses at the center of each element, + ! given the 3D velocity field and flow factor. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + nhalo ! number of halo layers + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of each vertex (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagusrf, & ! upper surface elevation on staggered grid (m) + stagthck ! ice thickness on staggered grid (m) + + integer, intent(in) :: & + whichapprox, & ! option for Stokes approximation (BP, L1L2, SSA, SIA) + whichefvs ! option for effective viscosity calculation + + real(dp), intent(in) :: & + efvs_constant ! constant value of effective viscosity (Pa yr) + + real(dp), dimension(nz-1,nx,ny), intent(in) :: & + efvs, & ! precomputed effective viscosity + ! used for L1L2 only; efvs is recomputed at QPs for other approximations + flwafact ! temperature-based flow factor, 0.5 * A^(-1/n), Pa yr^(1/n) + ! used to compute the effective viscosity + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! velocity components at each node (m/yr) + + ! stress tensor components, co-located with efvs at the center of each element + real(dp), dimension(nz-1,nx,ny), intent(out) :: & + tau_xz, tau_yz, &! vertical components of stress tensor (Pa) + tau_xx, tau_yy, tau_xy, &! horizontal components of stress tensor (Pa) + tau_eff ! effective stress (Pa) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp), dimension(nNodesPerElement_3d) :: & + dphi_dx_3d, dphi_dy_3d, dphi_dz_3d ! derivatives of 3D nodal basis functions at a quadrature point + + real(dp) :: & + detJ, & ! determinant of Jacobian at a quad pt + ! not used but part of interface to get_basis_function_derivatives + du_dx, du_dy, du_dz, & ! strain rate components + dv_dx, dv_dy, dv_dz, & + efvs_qp ! effective viscosity at a quad pt (Pa yr) + + real(dp), dimension(nNodesPerElement_3d) :: & + x, y, z, & ! spatial coordinates of nodes + u, v ! velocity components at nodes + + integer :: i, j, k, n, p + integer :: iNode, jNode, kNode + + ! initialize stresses + tau_xz (:,:,:) = 0.d0 + tau_yz (:,:,:) = 0.d0 + tau_xx (:,:,:) = 0.d0 + tau_yy (:,:,:) = 0.d0 + tau_xy (:,:,:) = 0.d0 + tau_eff(:,:,:) = 0.d0 + + ! Loop over cells that border locally owned vertices + + do j = 1+nhalo, ny-nhalo+1 + do i = 1+nhalo, nx-nhalo+1 + + if (active_cell(i,j)) then + + ! Loop over layers + do k = 1, nz-1 + + ! compute spatial coordinates and velocity for each node of this element + do n = 1, nNodesPerElement_3d + + ! Determine (k,i,j) for this node + ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). + ! Indices for other nodes are computed relative to this node. + iNode = i + ishift(7,n) + jNode = j + jshift(7,n) + kNode = k + kshift(7,n) + + x(n) = xVertex(iNode,jNode) + y(n) = yVertex(iNode,jNode) + z(n) = stagusrf(iNode,jNode) - sigma(kNode)*stagthck(iNode,jNode) + u(n) = uvel(kNode,iNode,jNode) + v(n) = vvel(kNode,iNode,jNode) + + enddo ! nodes per element + + ! Loop over quadrature points + do p = 1, nQuadPoints_3d + + ! Compute derivative of basis functions at this quad pt + call get_basis_function_derivatives_3d(x(:), y(:), z(:), & + dphi_dxr_3d(:,p), dphi_dyr_3d(:,p), dphi_dzr_3d(:,p), & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + detJ, i, j, k, p ) + + ! Compute strain rates at this quadrature point, looping over nodes of element + du_dx = 0.d0 + du_dy = 0.d0 + du_dz = 0.d0 + dv_dx = 0.d0 + dv_dy = 0.d0 + dv_dz = 0.d0 + + if (whichapprox == HO_APPROX_SIA) then + + do n = 1, nNodesPerElement_3d + du_dz = du_dz + dphi_dz_3d(n)*u(n) + dv_dz = dv_dz + dphi_dz_3d(n)*v(n) + enddo + + elseif (whichapprox == HO_APPROX_SSA) then + + do n = 1, nNodesPerElement_3d + du_dx = du_dx + dphi_dx_3d(n)*u(n) + du_dy = du_dy + dphi_dy_3d(n)*u(n) + dv_dx = dv_dx + dphi_dx_3d(n)*v(n) + dv_dy = dv_dy + dphi_dy_3d(n)*v(n) + enddo + + else ! 3D higher-order (BP or L1L2) + + do n = 1, nNodesPerElement_3d + du_dx = du_dx + dphi_dx_3d(n)*u(n) + du_dy = du_dy + dphi_dy_3d(n)*u(n) + du_dz = du_dz + dphi_dz_3d(n)*u(n) + dv_dx = dv_dx + dphi_dx_3d(n)*v(n) + dv_dy = dv_dy + dphi_dy_3d(n)*v(n) + dv_dz = dv_dz + dphi_dz_3d(n)*v(n) + enddo + + endif ! whichapprox + + if (whichapprox == HO_APPROX_L1L2) then + + ! efvs is computed in a complicated way for L1L2. + ! Instead of recomputing it here for each QP, simply assume that the value at each QP + ! is equal to the average efvs in the element. This will give a small averaging error. + + efvs_qp = efvs(k,i,j) + + else ! other approximations (SIA, SSA, BP) + + ! Compute the effective viscosity at this quadrature point. + + call compute_effective_viscosity(whichefvs, whichapprox, & + efvs_constant, nNodesPerElement_3d, & + dphi_dx_3d(:), dphi_dy_3d(:), dphi_dz_3d(:), & + u(:), v(:), & + flwafact(k,i,j), efvs_qp, & + i, j, k, p) + + endif + + ! Increment stresses, adding the value at this quadrature point + + tau_xz(k,i,j) = tau_xz(k,i,j) + efvs_qp * du_dz ! 2 * efvs * eps_xz + tau_yz(k,i,j) = tau_yz(k,i,j) + efvs_qp * dv_dz ! 2 * efvs * eps_yz + tau_xx(k,i,j) = tau_xx(k,i,j) + 2.d0 * efvs_qp * du_dx ! 2 * efvs * eps_xx + tau_yy(k,i,j) = tau_yy(k,i,j) + 2.d0 * efvs_qp * dv_dy ! 2 * efvs * eps_yy + tau_xy(k,i,j) = tau_xy(k,i,j) + efvs_qp * (dv_dx + du_dy) ! 2 * efvs * eps_xy + + enddo ! p + + ! Final stress tensor components, averaged over quad pts + tau_xz(k,i,j) = tau_xz(k,i,j) / nQuadPoints_3d + tau_yz(k,i,j) = tau_yz(k,i,j) / nQuadPoints_3d + tau_xx(k,i,j) = tau_xx(k,i,j) / nQuadPoints_3d + tau_yy(k,i,j) = tau_yy(k,i,j) / nQuadPoints_3d + tau_xy(k,i,j) = tau_xy(k,i,j) / nQuadPoints_3d + + ! Effective stress + tau_eff(k,i,j) = sqrt(tau_xx(k,i,j)**2 + tau_yy(k,i,j)**2 & + + tau_xx(k,i,j)*tau_yy(k,i,j) + tau_xy(k,i,j)**2 & + + tau_xz(k,i,j)**2 + tau_yz(k,i,j)**2) + + enddo ! k + + if (verbose_tau .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'i, j =', i, j + print*, 'k, tau_xz, tau_yz, tau_xx, tau_yy, tau_xy, tau_eff:' + do k = 1, nz-1 + print*, k, tau_xz(k,i,j), tau_yz(k,i,j), tau_xx(k,i,j), & + tau_yy(k,i,j), tau_xy(k,i,j), tau_eff(k,i,j) + enddo + endif ! verbose_tau + + endif ! active cell + enddo ! i + enddo ! j + + end subroutine compute_internal_stress + +!**************************************************************************** + + subroutine compute_effective_viscosity (whichefvs, whichapprox, & + efvs_constant, nNodesPerElement, & + dphi_dx, dphi_dy, dphi_dz, & + uvel, vvel, & + flwafact, efvs, & + i, j, k, p ) + + ! Compute effective viscosity at a quadrature point, based on the latest + ! guess for the velocity field + ! Note: Elements can be either 2D or 3D + + integer, intent(in) :: i, j, k, p + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + whichefvs ! method for computing effective viscosity + ! 0 = constant value + ! 1 = proportional to flow factor + ! 2 = nonlinear function of effective strain rate + + integer, intent(in) :: & + whichapprox ! option for Stokes approximation (BP, SSA, SIA) + + real(dp), intent(in) :: & + efvs_constant ! constant value of effective viscosity (Pa yr) + + integer, intent(in) :: nNodesPerElement ! number of nodes per element + ! = 4 for 2D, = 8 for 3D + + real(dp), dimension(nNodesPerElement), intent(in) :: & + dphi_dx, dphi_dy, dphi_dz ! derivatives of basis functions at this quadrature point + ! dphi_dz = 0 for 2D SSA + + real(dp), dimension(nNodesPerElement), intent(in) :: & + uvel, vvel ! current guess for velocity at each node of element (m/yr) + + real(dp), intent(in) :: & + flwafact ! temperature-based flow factor for this element, 0.5 * A^{-1/n} + ! units: Pa yr^{1/n} + + real(dp), intent(out) :: & + efvs ! effective viscosity at this quadrature point (Pa yr) + ! computed as 0.5 * A^{-1/n) * effstrain^{(1-n)/n)} + + !---------------------------------------------------------------- + ! Local parameters + !---------------------------------------------------------------- + + !TODO - Test sensitivity of model convergence to effstrain_min + real(dp), parameter :: & +!! effstrain_min = 1.d-20*scyr, &! minimum value of effective strain rate, yr^{-1} + ! GLAM uses 1.d-20 s^{-1} for minimum effective strain rate + effstrain_min = 1.d-8, &! minimum value of effective strain rate, yr^{-1} + ! Mauro Perego suggests 1.d-8 yr^{-1} + p_effstr = (1.d0 - real(gn,dp)) / real(gn,dp) ! exponent (1-n)/n in effective viscosity relation + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp) :: & + du_dx, du_dy, du_dz, & ! strain rate components + dv_dx, dv_dy, dv_dz, & + effstrain, & ! effective strain rate, yr^{-1} + effstrainsq ! square of effective strain rate + + integer :: n + + select case(whichefvs) + + case(HO_EFVS_CONSTANT) + + ! Steve Price recommends 10^6 to 10^7 Pa yr + ! ISMIP-HOM Test F requires 2336041.42829 Pa yr; this is the default value set in glide_types.F90 + efvs = efvs_constant + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, 'Set efvs = constant (Pa yr):', efvs + endif + + case(HO_EFVS_FLOWFACT) ! set the effective viscosity to a multiple of the flow factor, 0.5*A^(-1/n) + + ! Units: flwafact has units Pa yr^{1/n} + ! effstrain has units yr^{-1} + ! p_effstr = (1-n)/n + ! = -2/3 for n=3 + ! Thus efvs has units Pa yr + + !TODO - Test HO_EFVS_FLOWFACT option and make sure the units and scales are OK + + effstrain = vel_scale/len_scale * scyr ! typical strain rate, yr^{-1} + efvs = flwafact * effstrain**p_effstr + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, 'flwafact, effstrain (yr-1), efvs (Pa yr)=', flwafact, effstrain, efvs + endif + + case(HO_EFVS_NONLINEAR) ! compute effective viscosity based on effective strain rate + + ! initialize strain rates + du_dx = 0.d0 + du_dy = 0.d0 + du_dz = 0.d0 + dv_dx = 0.d0 + dv_dy = 0.d0 + dv_dz = 0.d0 + + ! Compute effective strain rate (squared) at this quadrature point (PGB 2012, eq. 3 and 9) + ! Units are yr^(-1) + + if (whichapprox == HO_APPROX_SIA) then + + do n = 1, nNodesPerElement + du_dz = du_dz + dphi_dz(n)*uvel(n) + dv_dz = dv_dz + dphi_dz(n)*vvel(n) + enddo + + effstrainsq = effstrain_min**2 & + + 0.25d0 * (du_dz**2 + dv_dz**2) + + elseif (whichapprox == HO_APPROX_SSA) then + + do n = 1, nNodesPerElement + + du_dx = du_dx + dphi_dx(n)*uvel(n) + du_dy = du_dy + dphi_dy(n)*uvel(n) + + dv_dx = dv_dx + dphi_dx(n)*vvel(n) + dv_dy = dv_dy + dphi_dy(n)*vvel(n) + + enddo + + effstrainsq = effstrain_min**2 & + + (du_dx**2 + dv_dy**2 + du_dx*dv_dy + 0.25d0*(dv_dx + du_dy)**2) + + else ! 3D higher-order + + do n = 1, nNodesPerElement + + du_dx = du_dx + dphi_dx(n)*uvel(n) + du_dy = du_dy + dphi_dy(n)*uvel(n) + du_dz = du_dz + dphi_dz(n)*uvel(n) + + dv_dx = dv_dx + dphi_dx(n)*vvel(n) + dv_dy = dv_dy + dphi_dy(n)*vvel(n) + dv_dz = dv_dz + dphi_dz(n)*vvel(n) + + enddo + + effstrainsq = effstrain_min**2 & + + (du_dx**2 + dv_dy**2 + du_dx*dv_dy + 0.25d0*(dv_dx + du_dy)**2) & + + 0.25d0*(du_dz**2 + dv_dz**2) + + endif ! whichapprox + + ! Compute effective viscosity (PGB 2012, eq. 4) + ! Units: flwafact has units Pa yr^{1/n} + ! effstrain has units yr^{-1} + ! p_effstr = (1-n)/n + ! = -2/3 for n=3 + ! Thus efvs has units Pa yr + + efvs = flwafact * effstrainsq**(0.5d0*p_effstr) + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest .and. p==ptest) then + print*, ' ' + print*, 'i, j, k, p =', i, j, k, p + print*, 'flwafact, effstrain (yr-1), efvs(Pa yr) =', flwafact, effstrain, efvs + endif + + end select + + end subroutine compute_effective_viscosity + +!**************************************************************************** + + subroutine compute_effective_viscosity_L1L2(whichefvs, efvs_constant, & + nz, sigma, & + nNodesPerElement, phi, & + dphi_dx, dphi_dy, & + uvel, vvel, & + stagthck, & + dsdx, dsdy, & + flwa, flwafact, & + efvs, & + i, j, p ) + + ! Compute the effective viscosity at each layer of an ice column corresponding + ! to a particular quadrature point, based on the L1L2 formulation. + ! See PGB(2012), section 2.3 + + integer, intent(in) :: i, j, p + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + whichefvs ! method for computing effective viscosity + ! 0 = constant value + ! 1 = proportional to flow factor + ! 2 = nonlinear function of effective strain rate + + real(dp), intent(in) :: & + efvs_constant ! constant value of effective viscosity (Pa yr) + ! (used for option HO_EFVS_CONSTANT) + + integer, intent(in) :: & + nz, &! number of vertical levels at which velocity is computed + ! Note: The number of layers (or elements in a column) is nz-1 + nNodesPerElement ! number of nodes per element, = 4 for 2D rectangular faces + + real(dp), dimension(nz), intent(in) :: & + sigma ! sigma vertical coordinate + + real(dp), dimension(nNodesPerElement), intent(in) :: & + phi, & ! basic functions at this quadrature point + dphi_dx, dphi_dy ! derivatives of basis functions at this quadrature point + + real(dp), dimension(nNodesPerElement), intent(in) :: & + uvel, vvel, &! current guess for basal velocity at cell vertices (m/yr) + dsdx, dsdy, &! upper surface elevation gradient at vertices (m/m) + stagthck ! ice thickness at vertices + + real(dp), dimension(nz-1), intent(in) :: & + flwa, &! temperature-based flow factor A at each layer of this cell column + ! units: Pa^{-n} yr^{-1} + flwafact ! temperature-based flow factor for this element, 0.5 * A^{-1/n} + ! units: Pa yr^{1/n} (used for option HO_EFVS_FLOWFACT) + + real(dp), dimension(nz-1), intent(out) :: & + efvs ! effective viscosity of each layer corresponding to this quadrature point (Pa yr) + ! computed as 1 / (2*A*tau_eff^{(n-1)/2}) + ! = 1 / (2*A*tau_eff^2) given n = 3 + ! where tau_eff^2 = tau_parallel^2 + tau_perp^2 + + !---------------------------------------------------------------- + ! Local parameters + !---------------------------------------------------------------- + + real(dp), parameter :: & +!! effstrain_min = 1.d-20*scyr, &! minimum value of effective strain rate, yr^{-1} + ! GLAM uses 1.d-20 s^{-1} for minimum effective strain rate + effstrain_min = 1.d-8, &! minimum value of effective strain rate, yr^{-1} + ! Mauro Perego suggests 1.d-8 yr^{-1} + p_effstr = (1.d0 - real(gn,dp)) / real(gn,dp) ! exponent (1-n)/n in effective viscosity relation + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp) :: & + du_dx, du_dy, & ! horizontal strain rate components at this quadrature point, yr^{-1} + dv_dx, dv_dy, & + ds_dx, ds_dy, & ! gradient of upper surface elevation at this QP (m/m) + thck, & ! ice thickness (m) at this QP + effstrain, & ! effective strain rate at QP, yr^{-1} + effstrainsq, & ! square of effective strain rate + tau_parallel, & ! norm of tau_parallel at each layer of this cell column, + ! where |tau_parallel|^2 = tau_xx^2 + tau_yy^2 + tau_xx*tau_yy + tau_xy^2 + ! See PGB(2012), eq. 17 and 20 + tau_perp, & ! norm of tau_perp at a given layer of a cell column, + ! where |tau_perp|^2 = [rhoi*grav*(s-z)*|grad(s)|]^2 + grads, & ! norm of sfc elevation gradient at this QP, sqrt(ds_dx^2 + ds_dy^2) + depth ! distance (m) from surface to level k at this QP + + real(dp) :: a, b, c, rootA, rootB ! terms in cubic equation + + integer :: n, k + + select case(whichefvs) + + case(HO_EFVS_CONSTANT) + + ! Steve Price recommends 10^6 to 10^7 Pa yr + ! ISMIP-HOM Test F requires 2336041.42829 Pa yr; this is the default value set in glide_types.F90 + efvs(:) = efvs_constant + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'Set efvs = constant (Pa yr):', efvs + endif + + case(HO_EFVS_FLOWFACT) ! set the effective viscosity to a multiple of the flow factor, 0.5*A^(-1/n) + + ! Set the effective strain rate (s^{-1}) based on typical velocity and length scales + ! + ! Units: flwafact has units Pa yr^{1/n} + ! effstrain has units yr^{-1} + ! p_effstr = (1-n)/n + ! = -2/3 for n=3 + ! Thus efvs has units Pa yr + + effstrain = vel_scale/len_scale * scyr ! typical strain rate, yr^{-1} + efvs(:) = flwafact(:) * effstrain**p_effstr + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, 'flwafact, effstrain (yr-1), efvs (Pa yr)=', flwafact, effstrain, efvs + endif + + case(HO_EFVS_NONLINEAR) ! compute effective viscosity based on effective strain rate + + du_dx = 0.d0 + du_dy = 0.d0 + dv_dx = 0.d0 + dv_dy = 0.d0 + ds_dx = 0.d0 + ds_dy = 0.d0 + thck = 0.d0 + + do n = 1, nNodesPerElement + + du_dx = du_dx + dphi_dx(n)*uvel(n) + du_dy = du_dy + dphi_dy(n)*uvel(n) + + dv_dx = dv_dx + dphi_dx(n)*vvel(n) + dv_dy = dv_dy + dphi_dy(n)*vvel(n) + + ds_dx = ds_dx + phi(n)*dsdx(n) + ds_dy = ds_dy + phi(n)*dsdy(n) + + thck = thck + phi(n)*stagthck(n) + + enddo + + ! Compute effective strain rate at this quadrature point (PGB 2012, eq. 17) + + effstrainsq = effstrain_min**2 & + + du_dx**2 + dv_dy**2 + du_dx*dv_dy + 0.25d0*(dv_dx + du_dy)**2 + effstrain = sqrt(effstrainsq) + + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. p==ptest) then + print*, 'effstrain (yr-1) =', effstrain + print*, 'du_dx, du_dy =', du_dx, du_dy + print*, 'dv_dx, dv_dy =', dv_dx, dv_dy + print*, 'ds_dx, ds_dy =', ds_dx, ds_dy + print*, 'n, phi, dphi_dx, dphi_dy:' + do n = 1, nNodesPerElement_2d + print*, n, phi(n), dphi_dx(n), dphi_dy(n) + enddo + endif + + !--------------------------------------------------------------------------- + ! Solve for tau_parallel in the relation (PGB 2012, eq. 22) + ! + ! effstrain = A * (tau_parallel^2 + tau_perp^2)^{(n-1)/2} * tau_parallel + ! + ! where tau_perp^2 = [(pg)*(s-z)*|grad(s)|]^2 = SIA stress + ! grad(s) = sqrt(ds_dx^2 + ds_dy^2) + ! n = 3, so we have a cubic equation + ! + ! This relation can be written as a cubic equation of the form + ! + ! x^3 + a*x + b = 0, + ! + ! where for this problem, x = tau_parallel > 0, + ! a = tau_perp^2 >= 0, + ! b = -effstrain/A < 0. + ! + ! If (b^2)/4 + (a^3)/27 > 0, then there is one real root A + B, where + ! + ! A = [-b/2 + sqrt((b^2)/4 + (a^3)/27)]^(1/3) + ! B = -[b/2 + sqrt((b^2)/4 + (a^3)/27)]^(1/3) + ! + ! There is also a pair of complex conjugate roots that are not of interest here. + ! + ! Note: If a^3/27 << b^2/4 (as can happen if |grad(s)| is small), then the + ! bracketed term in B is given to a good approximation by + ! + ! b/2 + (|b|/2)*(1 + 2a^3/(27b^2)) = a^3 / (27|b|). + ! + ! Hence B = -a / (3 * |b|^(1/3)). + ! + ! We use the alternate expression for B when a^3/27 < 1.d-6 * b^2/4, + ! so as to avoid roundoff error from subtracting two large numbers of nearly + ! the same size. + !--------------------------------------------------------------------------- + !TODO - Code an iterative solution for tau_parallel, for n /= 3. + + do k = 1, nz-1 ! loop over layers + depth = thck * sigma(k+1) + grads = sqrt(ds_dx**2 + ds_dy**2) + tau_perp = rhoi*grav*depth*grads + a = tau_perp**2 + b = -effstrain / flwa(k) + c = sqrt(b**2/4.d0 + a**3/27.d0) + rootA = (-b/2.d0 + c)**(1.d0/3.d0) + if (a**3/(27.d0) > 1.d-6 * (b**2/4.d0)) then + rootB = -(b/2.d0 + c)**(1.d0/3.d0) + else ! b/2 + c is small; compute solution to first order without subtracting two large, nearly equal numbers + rootB = -a / (3.d0*(abs(b))**(1.d0/3.d0)) + endif + tau_parallel = rootA + rootB + efvs(k) = 1.d0 / (2.d0 * flwa(k) * (tau_parallel**2 + tau_perp**2)) ! given n = 3 + + !WHL - debug + if (verbose_efvs .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest .and. p==ptest) then + print*, 'i, j, k, p =', i, j, k, p +! print*, 'a, b, c:', a, b, c +! print*, '-b/2 + c, -b/2 - c:', -b/2 + c, -b/2 - c +! print*, 'roots A, B:', rootA, rootB +! print*, 'tau_perp, tau_parallel:', tau_perp, tau_parallel +! print*, 'flwa:', flwa(k) + print*, 'flwafact, effstrain, efvs_BP, efvs:', 0.5d0*flwa(k)**(-1.d0/3.d0), effstrain, & + 0.5d0*flwa(k)**(-1.d0/3.d0) * effstrain**(-2.d0/3.d0), efvs(k) + endif + + enddo ! k + + end select + + end subroutine compute_effective_viscosity_L1L2 + +!**************************************************************************** + + subroutine compute_element_matrix(whichapprox, nNodesPerElement, & + wqp, detJ, & + efvs, & + dphi_dx, dphi_dy, dphi_dz, & + Kuu, Kuv, & + Kvu, Kvv, & + i, j, k, p) + + !------------------------------------------------------------------ + ! Increment the stiffness matrices Kuu, Kuv, Kvu, Kvv with the + ! contribution from a particular quadrature point, + ! based on the Blatter-Pattyn first-order equations. + ! + ! Note: Elements can be either 2D or 3D + !------------------------------------------------------------------ + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: i, j, k, p + + integer, intent(in) :: & + whichapprox ! which Stokes approximation to use (BP, SIA, SSA) + + integer, intent(in) :: nNodesPerElement ! number of nodes per element + + real(dp), intent(in) :: & + wqp, &! weight for this quadrature point + detJ, &! determinant of Jacobian for the transformation + ! between the reference element and true element + efvs ! effective viscosity at this quadrature point + + real(dp), dimension(nNodesPerElement), intent(in) :: & + dphi_dx, dphi_dy, dphi_dz ! derivatives of basis functions, + ! evaluated at this quadrature point + + real(dp), dimension(nNodesPerElement,nNodesPerElement), intent(inout) :: & + Kuu, Kuv, Kvu, Kvv ! components of element stiffness matrix + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp) :: efvs_factor + integer :: nr, nc + + if (verbose_matrix .and. this_rank==rtest .and. i==itest .and. j==jtest .and. k==ktest) then + print*, ' ' + print*, 'Increment element matrix, i, j, k, p =', i, j, k, p + endif + + ! Increment the element stiffness matrices for the appropriate approximation. + + !Note: Scaling by volume such that detJ/vol0 is close to unity + efvs_factor = efvs * wqp * detJ/vol0 + + if (verbose_matrix .and. this_rank==rtest .and. i==itest .and. j==jtest .and. & + k==ktest .and. p==ptest) then + print*, ' ' + print*, 'i, j, k, p:', i, j, k, p + print*, 'efvs, wqp, detJ/vol0 =', efvs, wqp, detJ/vol0 + print*, 'dphi_dz(1) =', dphi_dz(1) + print*, 'dphi_dx(1) =', dphi_dx(1) + print*, 'Kuu dphi/dz increment(1,1) =', efvs_factor*dphi_dz(1)*dphi_dz(1) + print*, 'Kuu dphi/dx increment(1,1) =', efvs_factor*4.d0*dphi_dx(1)*dphi_dx(1) + endif + + if (whichapprox == HO_APPROX_SIA) then + + do nc = 1, nNodesPerElement ! columns of K + do nr = 1, nNodesPerElement ! rows of K + + Kuu(nr,nc) = Kuu(nr,nc) + efvs_factor * (dphi_dz(nr)*dphi_dz(nc)) + Kvv(nr,nc) = Kvv(nr,nc) + efvs_factor * (dphi_dz(nr)*dphi_dz(nc)) + + enddo ! row + enddo ! column + + elseif (whichapprox == HO_APPROX_SSA) then + + do nc = 1, nNodesPerElement ! columns of K + do nr = 1, nNodesPerElement ! rows of K + + Kuu(nr,nc) = Kuu(nr,nc) + efvs_factor * (4.d0*dphi_dx(nr)*dphi_dx(nc) + dphi_dy(nr)*dphi_dy(nc)) + Kuv(nr,nc) = Kuv(nr,nc) + efvs_factor * (2.d0*dphi_dx(nr)*dphi_dy(nc) + dphi_dy(nr)*dphi_dx(nc)) + Kvu(nr,nc) = Kvu(nr,nc) + efvs_factor * (2.d0*dphi_dy(nr)*dphi_dx(nc) + dphi_dx(nr)*dphi_dy(nc)) + Kvv(nr,nc) = Kvv(nr,nc) + efvs_factor * (4.d0*dphi_dy(nr)*dphi_dy(nc) + dphi_dx(nr)*dphi_dx(nc)) + + enddo + enddo + + else ! Blatter-Pattyn higher-order + ! The terms in parentheses can be derived from PGB 2012, eq. 13 and 15. + ! The factor of 2 in front of efvs has been absorbed into the quantities in parentheses. + + do nc = 1, nNodesPerElement ! columns of K + do nr = 1, nNodesPerElement ! rows of K + + Kuu(nr,nc) = Kuu(nr,nc) + efvs_factor * & + ( 4.d0*dphi_dx(nr)*dphi_dx(nc) + dphi_dy(nr)*dphi_dy(nc) & + + dphi_dz(nr)*dphi_dz(nc) ) + + Kuv(nr,nc) = Kuv(nr,nc) + efvs_factor * & + (2.d0*dphi_dx(nr)*dphi_dy(nc) + dphi_dy(nr)*dphi_dx(nc)) + + Kvu(nr,nc) = Kvu(nr,nc) + efvs_factor * & + (2.d0*dphi_dy(nr)*dphi_dx(nc) + dphi_dx(nr)*dphi_dy(nc)) + + Kvv(nr,nc) = Kvv(nr,nc) + efvs_factor * & + ( 4.d0*dphi_dy(nr)*dphi_dy(nc) + dphi_dx(nr)*dphi_dx(nc) & + + dphi_dz(nr)*dphi_dz(nc) ) + + enddo ! nr (rows) + enddo ! nc (columns) + + endif ! whichapprox + + end subroutine compute_element_matrix + +!**************************************************************************** + + subroutine element_to_global_matrix_3d(nx, ny, nz, & + iElement, jElement, kElement, & + Kuu, Kuv, & + Kvu, Kvv, & + Auu, Auv, & + Avu, Avv) + + ! Sum terms of element matrix K into dense assembled matrix A + ! K is partitioned into Kuu, Kuv, Kvu, and Kvv, and similarly for A. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + iElement, jElement, kElement ! i, j and k indices for this element + + real(dp), dimension(nNodesPerElement_3d,nNodesPerElement_3d), intent(in) :: & + Kuu, Kuv, Kvu, Kvv ! element matrix + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(inout) :: & + Auu, Auv, Avu, Avv ! assembled matrix + + integer :: i, j, k, m + integer :: iA, jA, kA + integer :: n, nr, nc + + if (verbose_matrix .and. this_rank==rtest .and. iElement==itest .and. jElement==jtest .and. kElement==ktest) then + print*, 'Element i, j, k:', iElement, jElement, kElement + print*, 'Rows of Kuu:' + do n = 1, nNodesPerElement_3d + write(6, '(8e12.4)') Kuu(n,:) + enddo + endif + + !WHL - On a Mac I tried switching the loops to put nc on the outside, but + ! the one with nr on the outside is faster. + do nr = 1, nNodesPerElement_3d ! rows of K + + ! Determine row of A to be incremented by finding (k,i,j) for this node + ! The reason for the '7' is that node 7, in the NE corner of the upper layer, has index (k,i,j). + ! Indices for other nodes are computed relative to this node. + i = iElement + ishift(7,nr) + j = jElement + jshift(7,nr) + k = kElement + kshift(7,nr) + + do nc = 1, nNodesPerElement_3d ! columns of K + + ! Determine column of A to be incremented + kA = kshift(nr,nc) ! k index of A into which K(m,n) is summed + iA = ishift(nr,nc) ! similarly for i and j indices + jA = jshift(nr,nc) ! these indices can take values -1, 0 and 1 + m = indxA_3d(iA,jA,kA) + + ! Increment A + Auu(m,k,i,j) = Auu(m,k,i,j) + Kuu(nr,nc) + Auv(m,k,i,j) = Auv(m,k,i,j) + Kuv(nr,nc) + Avu(m,k,i,j) = Avu(m,k,i,j) + Kvu(nr,nc) + Avv(m,k,i,j) = Avv(m,k,i,j) + Kvv(nr,nc) + + enddo ! nc + + enddo ! nr + + end subroutine element_to_global_matrix_3d + +!**************************************************************************** + + subroutine element_to_global_matrix_2d(nx, ny, & + iElement, jElement, & + Kuu, Kuv, & + Kvu, Kvv, & + Auu, Auv, & + Avu, Avv) + + ! Sum terms of element matrix K into dense assembled matrix A + ! K is partitioned into Kuu, Kuv, Kvu, and Kvv, and similarly for A. + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions + + integer, intent(in) :: & + iElement, jElement ! i and j indices for this element + + real(dp), dimension(nNodesPerElement_2d,nNodesPerElement_2d), intent(in) :: & + Kuu, Kuv, Kvu, Kvv ! element matrix + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(inout) :: & + Auu, Auv, Avu, Avv ! assembled matrix + + integer :: i, j, m + integer :: iA, jA + integer :: n, nr, nc + + if (verbose_matrix .and. this_rank==rtest .and. iElement==itest .and. jElement==jtest) then + print*, 'Element i, j:', iElement, jElement + print*, 'Rows of Kuu:' + do n = 1, nNodesPerElement_2d + write(6, '(8e12.4)') Kuu(n,:) + enddo + endif + + do nr = 1, nNodesPerElement_2d ! rows of K + + ! Determine row of A to be incremented by finding (i,j) for this node + ! The reason for the '3' is that node 3, in the NE corner of this gridcell, has index (i,j). + ! Indices for other nodes are computed relative to this node. + i = iElement + ishift(3,nr) + j = jElement + jshift(3,nr) + + do nc = 1, nNodesPerElement_2d ! columns of K + + ! Determine column of A to be incremented + iA = ishift(nr,nc) ! similarly for i and j indices + jA = jshift(nr,nc) ! these indices can take values -1, 0 and 1 + m = indxA_2d(iA,jA) + + ! Increment A + Auu(m,i,j) = Auu(m,i,j) + Kuu(nr,nc) + Auv(m,i,j) = Auv(m,i,j) + Kuv(nr,nc) + Avu(m,i,j) = Avu(m,i,j) + Kvu(nr,nc) + Avv(m,i,j) = Avv(m,i,j) + Kvv(nr,nc) + + enddo ! nc + enddo ! nr + + end subroutine element_to_global_matrix_2d + +!**************************************************************************** + + subroutine basal_sliding_bc(nx, ny, & + nNeighbors, nhalo, & + active_cell, beta, & + xVertex, yVertex, & + whichassemble_beta, & + Auu, Avv) + + !------------------------------------------------------------------------ + ! Increment the Auu and Avv matrices with basal traction terms. + ! Do a surface integral over all basal faces that contain at least one node with a stress BC. + ! (Not Dirichlet or free-slip) + ! Note: Basal Dirichlet BCs are enforced after matrix assembly. + ! + ! Assume a sliding law of the form: + ! tau_x = -beta*u + ! tau_y = -beta*v + ! where beta is defined at vertices. + !------------------------------------------------------------------------ + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nNeighbors, & ! number of neighbors of each node (used for first dimension of Auu/Avv) + ! = 27 for 3D solve, = 9 for 2D solve + nhalo ! number of halo layers + + logical, dimension(nx,ny), intent(in) :: & + active_cell ! true if cell contains ice and borders a locally owned vertex + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + beta ! basal traction field (Pa/(m/yr)) at cell vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xVertex, yVertex ! x and y coordinates of vertices + + integer, intent(in) :: & + whichassemble_beta ! = 0 for standard finite element computation of basal forcing terms + ! = 1 for computation that uses only the local value of beta at each node + + real(dp), dimension(nNeighbors,nx-1,ny-1), intent(inout) :: & + Auu, Avv ! parts of stiffness matrix (basal layer only) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, n, p, nr, nc, iA, jA, m, ii, jj + + real(dp), dimension(nNodesPerElement_2d) :: & + x, y, & ! Cartesian coordinates of basal nodes + b ! beta at basal nodes + + !TODO - These are not currently used except as dummy arguments + real(dp), dimension(nNodesPerElement_2d) :: & + dphi_dx_2d, dphi_dy_2d ! derivatives of basis functions, evaluated at quad pts + + real(dp) :: & + beta_qp, & ! beta evaluated at quadrature point + detJ ! determinant of Jacobian for the transformation + ! between the reference element and true element + + real(dp), dimension(nNodesPerElement_2d, nNodesPerElement_2d) :: & + Kuu, Kvv ! components of element matrix associated with basal sliding + + if (verbose_basal .and. this_rank==rtest) then + print*, 'In basal_sliding_bc: itest, jtest, rank =', itest, jtest, rtest + endif + + ! Sum over elements in active cells + ! Loop over all cells that contain locally owned vertices + do j = nhalo+1, ny-nhalo+1 + do i = nhalo+1, nx-nhalo+1 + + !TODO - Should we exclude cells that have Dirichlet basal BCs for all vertices? + + if (active_cell(i,j)) then ! ice is present + + ! Set x and y for each node + + ! 4-----3 y + ! | | ^ + ! | | | + ! 1-----2 ---> x + + x(1) = xVertex(i-1,j-1) + x(2) = xVertex(i,j-1) + x(3) = xVertex(i,j) + x(4) = xVertex(i-1,j) + + y(1) = yVertex(i-1,j-1) + y(2) = yVertex(i,j-1) + y(3) = yVertex(i,j) + y(4) = yVertex(i-1,j) + + !TODO - For GLP, let b = beta * fground, where fground is the fractional area for the node in question + b(1) = beta(i-1,j-1) + b(2) = beta(i,j-1) + b(3) = beta(i,j) + b(4) = beta(i-1,j) + + ! loop over quadrature points + + do p = 1, nQuadPoints_2d + + ! Compute basis function derivatives and det(J) for this quadrature point + ! For now, pass in i, j, k, p for debugging + !TODO - Modify this subroutine so that the output derivatives are optional? + + call get_basis_function_derivatives_2d(x(:), y(:), & + dphi_dxr_2d(:,p), dphi_dyr_2d(:,p), & + dphi_dx_2d(:), dphi_dy_2d(:), & + detJ, i, j, p) + + ! Evaluate beta at this quadrature point + ! Standard finite-element treatment is to take a phi-weighted sum over neighboring vertices. + ! For local beta, use the value at the nearest vertex. + ! (Note that vertex numbering is the same as QP numbering, CCW from 1 to 4 starting at SW corner.) + + if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then + beta_qp = b(p) + else + beta_qp = 0.d0 + do n = 1, nNodesPerElement_2d + beta_qp = beta_qp + phi_2d(n,p) * b(n) + enddo + endif + + if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'Increment basal traction, i, j, p =', i, j, p + print*, 'beta_qp =', beta_qp + print*, 'detJ/vol0 =', detJ/vol0 + endif + + ! Compute the element matrix for this quadrature point + ! (Note volume scaling) + + Kuu(:,:) = 0.d0 + + if (whichassemble_beta == HO_ASSEMBLE_BETA_LOCAL) then ! Use the value at the nearest vertex + ! Then Kuu is diagonal, so friction at a vertex depends only on beta at that vertex + Kuu(p,p) = beta_qp * (detJ/vol0) + + else + + do nc = 1, nNodesPerElement_2d ! columns of K + do nr = 1, nNodesPerElement_2d ! rows of K + Kuu(nr,nc) = Kuu(nr,nc) + beta_qp * wqp_2d(p) * detJ/vol0 * phi_2d(nr,p)*phi_2d(nc,p) + enddo ! m (rows) + enddo ! n (columns) + + endif ! local beta + + !Note: Is this true for all sliding laws? + Kvv(:,:) = Kuu(:,:) + + ! Insert terms of basal element matrices into global matrices Auu and Avv + + do nr = 1, nNodesPerElement_2d ! rows of K + + ! Determine (i,j) for this node + ! The reason for the '3' is that node 3, in the NE corner of the cell, has horizontal indices (i,j). + ! Indices for other nodes are computed relative to this node. + + ii = i + ishift(3,nr) + jj = j + jshift(3,nr) + + do nc = 1, nNodesPerElement_2d ! columns of K + + iA = ishift(nr,nc) ! iA index of A into which K(nr,nc) is summed + jA = jshift(nr,nc) ! similarly for jA + + if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem + m = indxA_3d(iA,jA,0) + else ! 2D problem + m = indxA_2d(iA,jA) + endif + + Auu(m,ii,jj) = Auu(m,ii,jj) + Kuu(nr,nc) + Avv(m,ii,jj) = Avv(m,ii,jj) + Kvv(nr,nc) + + enddo ! nc + enddo ! nr + + if (verbose_basal .and. this_rank==rtest .and. i==itest .and. j==jtest) then + print*, ' ' + print*, 'i, j =', i, j + print*, 'Kuu:' + do nr = 1, nNodesPerElement_2d + print*, nr, Kuu(nr,:) + enddo + print*, ' ' + print*, 'rowsum(Kuu):' + do nr = 1, nNodesPerElement_2d + print*, nr, sum(Kuu(nr,:)) + enddo + print*, ' ' + print*, 'sum(Kuu):', sum(Kuu(:,:)) + endif + + enddo ! nQuadPoints_2d + + endif ! active_cell + + enddo ! i + enddo ! j + + if (verbose_basal .and. this_rank==rtest) then + i = itest + j = jtest + if (nNeighbors == nNodeNeighbors_3d) then ! 3D problem + m = indxA_3d(0,0,0) + print*, 'Diagonal index =', m + else + m = indxA_2d(0,0) + print*, 'Diagonal index =', m + endif + print*, ' ' + print*, 'New Auu diagonal:', Auu(m,i,j) + print*, 'New Avv diagonal:', Avv(m,i,j) + endif + + end subroutine basal_sliding_bc + +!**************************************************************************** + + subroutine dirichlet_boundary_conditions_3d(nx, ny, & + nz, nhalo, & + active_vertex, umask_dirichlet, & + uvel, vvel, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + !---------------------------------------------------------------- + ! Modify the global matrix and RHS for Dirichlet boundary conditions, + ! where uvel and vvel are prescribed at certain nodes. + ! For each such node, we zero out the row, except for setting the diagonal term to 1. + ! We also zero out the column, moving terms containing uvel/vvel to the rhs. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for active vertices (vertices of active cells) + + logical, dimension(nz,nx-1,ny-1), intent(in) :: & + umask_dirichlet ! Dirichlet mask for velocity (if true, u is prescribed) + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! velocity components + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(inout) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + bu, bv ! assembled load vector, divided into 2 parts + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k ! Cartesian indices of nodes + integer :: iA, jA, kA ! i, j, and k offsets of neighboring nodes + integer :: m + + ! Loop over all vertices that border locally owned vertices. + ! Locally owned vertices are (nhalo+1:nx-nhalo, nhalo+1:ny-nhalo) + !Note: Need nhalo >= 2 so as not to step out of bounds. + + do j = nhalo, ny-nhalo+1 + do i = nhalo, nx-nhalo+1 + if (active_vertex(i,j)) then + do k = 1, nz + if (umask_dirichlet(k,i,j)) then + + ! loop through matrix values in the rows associated with this node + ! (Auu/Auv contain one row, Avu/Avv contain a second row) + do kA = -1,1 + do jA = -1,1 + do iA = -1,1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + if (iA==0 .and. jA==0 .and. kA==0) then ! main diagonal + + ! Set Auu = Avv = 1 on the main diagonal + m = indxA_3d(0,0,0) + Auu(m,k,i,j) = 1.d0 + Auv(m,k,i,j) = 0.d0 + Avu(m,k,i,j) = 0.d0 + Avv(m,k,i,j) = 1.d0 + + ! Set the rhs to the prescribed velocity + ! This will force u = uvel, v = vvel for this node + bu(k,i,j) = uvel(k,i,j) + bv(k,i,j) = vvel(k,i,j) + + else ! not on the diagonal + + ! Zero out non-diagonal matrix terms in the rows associated with this node + m = indxA_3d(iA,jA,kA) + Auu(m, k, i, j) = 0.d0 + Auv(m, k, i, j) = 0.d0 + Avu(m, k, i, j) = 0.d0 + Avv(m, k, i, j) = 0.d0 + + ! Shift terms associated with this velocity to the rhs. + ! Note: The remaining operations do not change the answer, but do restore symmetry to the matrix. + m = indxA_3d(-iA,-jA,-kA) + + if (.not. umask_dirichlet(k+kA, i+iA, j+jA)) then + bu(k+kA, i+iA, j+jA) = bu(k+kA, i+iA, j+jA) & + - Auu(m, k+kA, i+iA, j+jA) * uvel(k,i,j) & + - Auv(m, k+kA, i+iA, j+jA) * vvel(k,i,j) + bv(k+kA, i+iA, j+jA) = bv(k+kA, i+iA, j+jA) & + - Avu(m, k+kA, i+iA, j+jA) * uvel(k,i,j) & + - Avv(m, k+kA, i+iA, j+jA) * vvel(k,i,j) + + ! Zero out non-diagonal matrix terms in the columns associated with this node + m = indxA_3d(-iA,-jA,-kA) + Auu(m, k+kA, i+iA, j+jA) = 0.d0 + Auv(m, k+kA, i+iA, j+jA) = 0.d0 + Avu(m, k+kA, i+iA, j+jA) = 0.d0 + Avv(m, k+kA, i+iA, j+jA) = 0.d0 + endif + + endif ! on the diagonal + + endif ! i+iA, j+jA, and k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + endif ! umask_dirichlet + enddo ! k + endif ! active_vertex + enddo ! i + enddo ! j + + end subroutine dirichlet_boundary_conditions_3d + +!**************************************************************************** + + subroutine dirichlet_boundary_conditions_2d(nx, ny, & + nhalo, & + active_vertex, umask_dirichlet, & + uvel, vvel, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + !---------------------------------------------------------------- + ! Modify the global matrix and RHS for Dirichlet boundary conditions, + ! where uvel and vvel are prescribed at certain nodes. + ! For each such node, we zero out the row, except for setting the diagonal term to 1. + ! We also zero out the column, moving terms containing uvel/vvel to the rhs. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for active vertices (vertices of active cells) + + logical, dimension(nx-1,ny-1), intent(in) :: & + umask_dirichlet ! Dirichlet mask for velocity (if true, u is prescribed) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel ! velocity components + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(inout) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + real(dp), dimension(nx-1,ny-1), intent(inout) :: & + bu, bv ! assembled load vector, divided into 2 parts + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j ! Cartesian indices of nodes + integer :: iA, jA ! i and j offsets of neighboring nodes + integer :: m + + ! Loop over all vertices that border locally owned vertices. + ! Locally owned vertices are (nhalo+1:nx-nhalo, nhalo+1:ny-nhalo) + !Note: Need nhalo >= 2 so as not to step out of bounds. + + do j = nhalo, ny-nhalo+1 + do i = nhalo, nx-nhalo+1 + if (active_vertex(i,j)) then + if (umask_dirichlet(i,j)) then + + ! loop through matrix values in the rows associated with this node + ! (Auu/Auv contain one row, Avu/Avv contain a second row) + do jA = -1,1 + do iA = -1,1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + if (iA==0 .and. jA==0) then ! main diagonal + + ! Set Auu = Avv = 1 on the main diagonal + m = indxA_2d(0,0) + Auu(m,i,j) = 1.d0 + Auv(m,i,j) = 0.d0 + Avu(m,i,j) = 0.d0 + Avv(m,i,j) = 1.d0 + + ! Set the rhs to the prescribed velocity + ! This will force u = uvel, v = vvel for this node + bu(i,j) = uvel(i,j) + bv(i,j) = vvel(i,j) + + else ! not on the diagonal + + ! Zero out non-diagonal matrix terms in the rows associated with this node + m = indxA_2d(iA,jA) + Auu(m, i, j) = 0.d0 + Auv(m, i, j) = 0.d0 + Avu(m, i, j) = 0.d0 + Avv(m, i, j) = 0.d0 + + ! Shift terms associated with this velocity to the rhs. + ! Note: The remaining operations do not change the answer, but do restore symmetry to the matrix. + m = indxA_2d(-iA,-jA) + + if (.not. umask_dirichlet(i+iA, j+jA)) then + bu(i+iA, j+jA) = bu(i+iA, j+jA) & + - Auu(m, i+iA, j+jA) * uvel(i,j) & + - Auv(m, i+iA, j+jA) * vvel(i,j) + bv(i+iA, j+jA) = bv(i+iA, j+jA) & + - Avu(m, i+iA, j+jA) * uvel(i,j) & + - Avv(m, i+iA, j+jA) * vvel(i,j) + + ! Zero out non-diagonal matrix terms in the columns associated with this node + m = indxA_2d(-iA,-jA) + Auu(m, i+iA, j+jA) = 0.d0 + Auv(m, i+iA, j+jA) = 0.d0 + Avu(m, i+iA, j+jA) = 0.d0 + Avv(m, i+iA, j+jA) = 0.d0 + endif + + endif ! on the diagonal + + endif ! i+iA and j+jA in bounds + + enddo ! iA + enddo ! jA + + endif ! umask_dirichlet + endif ! active_vertex + enddo ! i + enddo ! j + + end subroutine dirichlet_boundary_conditions_2d + +!**************************************************************************** + + subroutine compute_residual_vector_3d(nx, ny, & + nz, nhalo, & + active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + resid_u, resid_v, & + L2_norm, L2_norm_relative) + + ! Compute the residual vector Ax - b and its L2 norm. + ! This subroutine assumes that the matrix is stored in structured (x/y/z) format. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 3 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity (m/yr) + + real(dp), dimension(nz,nx-1,ny-1), intent(out) :: & + resid_u, & ! residual vector, divided into 2 parts + resid_v + + real(dp), intent(out) :: & + L2_norm ! L2 norm of residual vector, |Ax - b| + + real(dp), intent(out), optional :: & + L2_norm_relative ! L2 norm of residual vector relative to rhs, |Ax - b| / |b| + + integer :: i, j, k, iA, jA, kA, m + + real(dp) :: L2_norm_rhs ! L2 norm of rhs vector, |b| + + ! Compute u and v components of A*x + + resid_u(:,:,:) = 0.d0 + resid_v(:,:,:) = 0.d0 + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + if (active_vertex(i,j)) then + + do k = 1, nz + + do kA = -1,1 + do jA = -1,1 + do iA = -1,1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA_3d(iA,jA,kA) + + resid_u(k,i,j) = resid_u(k,i,j) & + + Auu(m,k,i,j)*uvel(k+kA,i+iA,j+jA) & + + Auv(m,k,i,j)*vvel(k+kA,i+iA,j+jA) + + resid_v(k,i,j) = resid_v(k,i,j) & + + Avu(m,k,i,j)*uvel(k+kA,i+iA,j+jA) & + + Avv(m,k,i,j)*vvel(k+kA,i+iA,j+jA) + + endif ! in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + enddo ! k + + endif ! active_vertex + + enddo ! i + enddo ! j + + ! Subtract b to get A*x - b + ! Sum up squared L2 norm as we go + + L2_norm = 0.d0 + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + do k = 1, nz + resid_u(k,i,j) = resid_u(k,i,j) - bu(k,i,j) + resid_v(k,i,j) = resid_v(k,i,j) - bv(k,i,j) + L2_norm = L2_norm + resid_u(k,i,j)*resid_u(k,i,j) & + + resid_v(k,i,j)*resid_v(k,i,j) + enddo ! k + endif ! active vertex + enddo ! i + enddo ! j + + ! Take global sum, then take square root + L2_norm = parallel_reduce_sum(L2_norm) + L2_norm = sqrt(L2_norm) + + if (verbose_residual .and. this_rank==rtest) then + i = itest + j = jtest + k = ktest + print*, 'In compute_residual_vector_3d: i, j, k =', i, j, k + print*, 'u, v :', uvel(k,i,j), vvel(k,i,j) + print*, 'bu, bv:', bu(k,i,j), bv(k,i,j) + print*, 'resid_u, resid_v:', resid_u(k,i,j), resid_v(k,i,j) + endif + + if (present(L2_norm_relative)) then ! compute L2_norm relative to rhs + + L2_norm_rhs = 0.d0 + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + do k = 1, nz + L2_norm_rhs = L2_norm_rhs + bu(k,i,j)*bu(k,i,j) + bv(k,i,j)*bv(k,i,j) + enddo ! k + endif ! active vertex + enddo ! i + enddo ! j + + ! Take global sum, then take square root + L2_norm_rhs = parallel_reduce_sum(L2_norm_rhs) + L2_norm_rhs = sqrt(L2_norm_rhs) + + if (L2_norm_rhs > 0.d0) then + L2_norm_relative = L2_norm / L2_norm_rhs + else + L2_norm_relative = 0.d0 + endif + + endif + + end subroutine compute_residual_vector_3d + +!**************************************************************************** + + subroutine compute_residual_vector_2d(nx, ny, & + nhalo, & + active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + resid_u, resid_v, & + L2_norm, L2_norm_relative) + + ! Compute the residual vector Ax - b and its L2 norm. + ! This subroutine assumes that the matrix is stored in structured (x/y/z) format. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 3 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity (m/yr) + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + resid_u, & ! residual vector, divided into 2 parts + resid_v + + real(dp), intent(out) :: & + L2_norm ! L2 norm of residual vector, |Ax - b| + + real(dp), intent(out), optional :: & + L2_norm_relative ! L2 norm of residual vector relative to rhs, |Ax - b| / |b| + + integer :: i, j, iA, jA, m + + real(dp) :: L2_norm_rhs ! L2 norm of rhs vector, |b| + + ! Compute u and v components of A*x + + resid_u(:,:) = 0.d0 + resid_v(:,:) = 0.d0 + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + if (active_vertex(i,j)) then + + do jA = -1,1 + do iA = -1,1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA_2d(iA,jA) + + resid_u(i,j) = resid_u(i,j) & + + Auu(m,i,j)*uvel(i+iA,j+jA) & + + Auv(m,i,j)*vvel(i+iA,j+jA) + + resid_v(i,j) = resid_v(i,j) & + + Avu(m,i,j)*uvel(i+iA,j+jA) & + + Avv(m,i,j)*vvel(i+iA,j+jA) + + endif ! in bounds + + enddo ! iA + enddo ! jA + + endif ! active_vertex + + enddo ! i + enddo ! j + + ! Subtract b to get A*x - b + ! Sum up squared L2 norm as we go + + L2_norm = 0.d0 + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + resid_u(i,j) = resid_u(i,j) - bu(i,j) + resid_v(i,j) = resid_v(i,j) - bv(i,j) + L2_norm = L2_norm + resid_u(i,j)*resid_u(i,j) & + + resid_v(i,j)*resid_v(i,j) + endif ! active vertex + enddo ! i + enddo ! j + + ! Take global sum, then take square root + + L2_norm = parallel_reduce_sum(L2_norm) + L2_norm = sqrt(L2_norm) + + if (verbose_residual .and. this_rank==rtest) then + i = itest + j = jtest + print*, 'In compute_residual_vector_2d: i, j =', i, j + print*, 'u, v :', uvel(i,j), vvel(i,j) + print*, 'bu, bv:', bu(i,j), bv(i,j) + print*, 'resid_u, resid_v:', resid_u(i,j), resid_v(i,j) + endif + + if (present(L2_norm_relative)) then ! compute L2_norm relative to rhs + + L2_norm_rhs = 0.d0 + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + L2_norm_rhs = L2_norm_rhs + bu(i,j)*bu(i,j) + bv(i,j)*bv(i,j) + endif ! active vertex + enddo ! i + enddo ! j + + ! Take global sum, then take square root + L2_norm_rhs = parallel_reduce_sum(L2_norm_rhs) + L2_norm_rhs = sqrt(L2_norm_rhs) + + if (L2_norm_rhs > 0.d0) then + L2_norm_relative = L2_norm / L2_norm_rhs + else + L2_norm_relative = 0.d0 + endif + + endif + + end subroutine compute_residual_vector_2d + +!**************************************************************************** + + subroutine compute_residual_velocity_3d(nhalo, whichresid, & + uvel, vvel, & + usav, vsav, & + resid_velo) + + integer, intent(in) :: & + nhalo, & ! number of layers of halo cells + whichresid ! option for method to use when calculating residual + + real(dp), dimension(:,:,:), intent(in) :: & + uvel, vvel, & ! current guess for velocity + usav, vsav ! previous guess for velocity + + real(dp), intent(out) :: & + resid_velo ! quantity related to velocity convergence + + + integer :: & + imaxdiff, jmaxdiff, kmaxdiff ! location of maximum speed difference + ! currently computed but not used + + integer :: i, j, k, count + + real(dp) :: & + speed, & ! current guess for ice speed + oldspeed, & ! previous guess for ice speed + diffspeed ! abs(speed-oldspeed) + + + ! Compute a residual quantity based on convergence of the velocity field. + !TODO - Remove some of these velocity residual methods? They are rarely if ever used. + + ! options for residual calculation method, as specified in configuration file + ! case(0): use max of abs( vel_old - vel ) / vel ) + ! case(1): use max of abs( vel_old - vel ) / vel ) but ignore basal vels + ! case(2): use mean of abs( vel_old - vel ) / vel ) + ! case(3): use max of abs( vel_old - vel ) / vel ) (in addition to L2 norm) + + resid_velo = 0.d0 + imaxdiff = 0 + jmaxdiff = 0 + kmaxdiff = 0 + + select case (whichresid) + + case(HO_RESID_MAXU_NO_UBAS) ! max speed difference, excluding the bed + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,3)-nhalo + do i = 1+nhalo, size(uvel,2)-nhalo + do k = 1, size(uvel,1) - 1 ! ignore bed velocity + speed = sqrt(uvel(k,i,j)**2 + vvel(k,i,j)**2) + if (speed /= 0.d0) then + oldspeed = sqrt(usav(k,i,j)**2 + vsav(k,i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + if (diffspeed > resid_velo) then + resid_velo = diffspeed + imaxdiff = i + jmaxdiff = j + kmaxdiff = k + endif + endif + enddo + enddo + enddo + + ! take global max + resid_velo = parallel_reduce_max(resid_velo) + + case(HO_RESID_MEANU) ! mean relative speed difference + + count = 0 + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,3)-nhalo + do i = 1+nhalo, size(uvel,2)-nhalo + do k = 1, size(uvel,1) - 1 ! ignore bed velocity + speed = sqrt(uvel(k,i,j)**2 + vvel(k,i,j)**2) + if (speed /= 0.d0) then + count = count+1 + oldspeed = sqrt(usav(k,i,j)**2 + vsav(k,i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + resid_velo = resid_velo + diffspeed + endif + enddo + enddo + enddo + + if (count > 0) resid_velo = resid_velo / count + + !TODO - Need to convert the mean residual to a global value. + ! (Or simply remove this case, which is rarely if ever used) + call not_parallel(__FILE__, __LINE__) + + case default ! max speed difference, including basal speeds + ! (case HO_RESID_MAXU or HO_RESID_L2NORM or HO_RESID_L2NORM_RELATIVE) + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,3)-nhalo + do i = 1+nhalo, size(uvel,2)-nhalo + do k = 1, size(uvel,1) + speed = sqrt(uvel(k,i,j)**2 + vvel(k,i,j)**2) + if (speed /= 0.d0) then + oldspeed = sqrt(usav(k,i,j)**2 + vsav(k,i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + if (diffspeed > resid_velo) then + resid_velo = diffspeed + imaxdiff = i + jmaxdiff = j + kmaxdiff = k + endif + endif + enddo + enddo + enddo + + resid_velo = parallel_reduce_max(resid_velo) + + end select + + end subroutine compute_residual_velocity_3d + +!**************************************************************************** + + subroutine compute_residual_velocity_2d(nhalo, whichresid, & + uvel, vvel, & + usav, vsav, & + resid_velo) + + integer, intent(in) :: & + nhalo, & ! number of layers of halo cells + whichresid ! option for method to use when calculating residual + + real(dp), dimension(:,:), intent(in) :: & + uvel, vvel, & ! current guess for velocity + usav, vsav ! previous guess for velocity + + real(dp), intent(out) :: & + resid_velo ! quantity related to velocity convergence + + + integer :: & + imaxdiff, jmaxdiff ! location of maximum speed difference + ! currently computed but not used + + integer :: i, j, count + + real(dp) :: & + speed, & ! current guess for ice speed + oldspeed, & ! previous guess for ice speed + diffspeed ! abs(speed-oldspeed) + + + ! Compute a residual quantity based on convergence of the velocity field. + + ! options for residual calculation method, as specified in configuration file + ! case(0): use max of abs( vel_old - vel ) / vel ) + ! case(1): use max of abs( vel_old - vel ) / vel ) but ignore basal vels + ! case(2): use mean of abs( vel_old - vel ) / vel ) + ! case(3): use max of abs( vel_old - vel ) / vel ) (in addition to L2 norm) + + resid_velo = 0.d0 + imaxdiff = 0 + jmaxdiff = 0 + + select case (whichresid) + + case(HO_RESID_MAXU_NO_UBAS) ! max speed difference, excluding the bed + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,2)-nhalo + do i = 1+nhalo, size(uvel,1)-nhalo + speed = sqrt(uvel(i,j)**2 + vvel(i,j)**2) + if (speed /= 0.d0) then + oldspeed = sqrt(usav(i,j)**2 + vsav(i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + if (diffspeed > resid_velo) then + resid_velo = diffspeed + imaxdiff = i + jmaxdiff = j + endif + endif + enddo + enddo + + ! take global max + resid_velo = parallel_reduce_max(resid_velo) + + case(HO_RESID_MEANU) ! mean relative speed difference + + count = 0 + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,2)-nhalo + do i = 1+nhalo, size(uvel,1)-nhalo + speed = sqrt(uvel(i,j)**2 + vvel(i,j)**2) + if (speed /= 0.d0) then + count = count+1 + oldspeed = sqrt(usav(i,j)**2 + vsav(i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + resid_velo = resid_velo + diffspeed + endif + enddo + enddo + + if (count > 0) resid_velo = resid_velo / count + + !TODO - Need to convert the mean residual to a global value. + ! (Or simply remove this case, which is rarely if ever used) + call not_parallel(__FILE__, __LINE__) + + case default ! max speed difference, including basal speeds + ! (case HO_RESID_MAXU or HO_RESID_L2NORM) + + ! Loop over locally owned vertices + + do j = 1+nhalo, size(uvel,2)-nhalo + do i = 1+nhalo, size(uvel,1)-nhalo + speed = sqrt(uvel(i,j)**2 + vvel(i,j)**2) + if (speed /= 0.d0) then + oldspeed = sqrt(usav(i,j)**2 + vsav(i,j)**2) + diffspeed = abs((oldspeed - speed)/speed) + if (diffspeed > resid_velo) then + resid_velo = diffspeed + imaxdiff = i + jmaxdiff = j + endif + endif + enddo + enddo + + resid_velo = parallel_reduce_max(resid_velo) + + end select + + end subroutine compute_residual_velocity_2d + +!**************************************************************************** + + subroutine count_nonzeros_3d(nx, ny, & + nz, nhalo, & + Auu, Auv, & + Avu, Avv, & + active_vertex, & + nNonzeros) + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for vertices of active cells + + integer, intent(out) :: & + nNonzeros ! number of nonzero matrix elements + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k, iA, jA, kA, m + + nNonzeros = 0 + do j = nhalo+1, ny-nhalo ! loop over locally owned vertices + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + do k = 1, nz + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + m = indxA_3d(iA,jA,kA) + if (Auu(m,k,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Auv(m,k,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Avu(m,k,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Avv(m,k,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + enddo + enddo + enddo + enddo ! k + endif ! active_vertex + enddo ! i + enddo ! j + + nNonzeros = parallel_reduce_sum(nNonzeros) + + end subroutine count_nonzeros_3d + +!**************************************************************************** + + subroutine count_nonzeros_2d(nx, ny, & + nhalo, & + Auu, Auv, & + Avu, Avv, & + active_vertex, & + nNonzeros) + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nhalo ! number of halo layers + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! true for vertices of active cells + + integer, intent(out) :: & + nNonzeros ! number of nonzero matrix elements + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, iA, jA, m + + nNonzeros = 0 + do j = nhalo+1, ny-nhalo ! loop over locally owned vertices + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + do jA = -1, 1 + do iA = -1, 1 + m = indxA_2d(iA,jA) + if (Auu(m,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Auv(m,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Avu(m,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + if (Avv(m,i,j) /= 0.d0) nNonzeros = nNonzeros + 1 + enddo + enddo + endif ! active_vertex + enddo ! i + enddo ! j + + nNonzeros = parallel_reduce_sum(nNonzeros) + + end subroutine count_nonzeros_2d + +!**************************************************************************** + + subroutine check_symmetry_element_matrix(nNodesPerElement, & + Kuu, Kuv, Kvu, Kvv) + + !------------------------------------------------------------------ + ! Check that the element stiffness matrix is symmetric. + ! This is true provided that (1) Kuu = (Kuu)^T + ! (2) Kvv = (Kvv)^T + ! (3) Kuv = (Kvu)^T + ! This subroutine works for either 2D or 3D elements. + ! A symmetry check should not be needed for production runs with a well-tested code, + ! but is included for now to help with debugging. + !------------------------------------------------------------------ + + integer, intent(in) :: nNodesPerElement ! number of nodes per element + + real(dp), dimension(nNodesPerElement, nNodesPerElement), intent(in) :: & + Kuu, Kuv, Kvu, Kvv ! component of element stiffness matrix + ! + ! Kuu | Kuv + ! _____|____ + ! Kvu | Kvv + ! | + + integer :: i, j + + ! make sure Kuu = (Kuu)^T + + do j = 1, nNodesPerElement + do i = j, nNodesPerElement + if (abs(Kuu(i,j) - Kuu(j,i)) > eps10) then + print*, 'Kuu is not symmetric' + print*, 'i, j, Kuu(i,j), Kuu(j,i):', i, j, Kuu(i,j), Kuu(j,i) + stop + endif + enddo + enddo + + ! check that Kvv = (Kvv)^T + + do j = 1, nNodesPerElement + do i = j, nNodesPerElement + if (abs(Kvv(i,j) - Kvv(j,i)) > eps10) then + print*, 'Kvv is not symmetric' + print*, 'i, j, Kvv(i,j), Kvv(j,i):', i, j, Kvv(i,j), Kvv(j,i) + stop + endif + enddo + enddo + + ! Check that Kuv = (Kvu)^T + + do j = 1, nNodesPerElement + do i = 1, nNodesPerElement + if (abs(Kuv(i,j) - Kvu(j,i)) > eps10) then + print*, 'Kuv /= (Kvu)^T' + print*, 'i, j, Kuv(i,j), Kvu(j,i):', i, j, Kuv(i,j), Kvu(j,i) + stop + endif + enddo + enddo + + end subroutine check_symmetry_element_matrix + +!**************************************************************************** + + subroutine check_symmetry_assembled_matrix_3d(nx, ny, nz, nhalo, & + active_vertex, & + Auu, Auv, Avu, Avv) + + !------------------------------------------------------------------ + ! Check that the assembled stiffness matrix is symmetric. + ! This is true provided that (1) Auu = (Auu)^T + ! (2) Avv = (Avv)^T + ! (3) Auv = (Avu)^T + ! The A matrices are assembled in a dense fashion to save storage + ! and preserve the i/j/k structure of the grid. + ! + ! There can be small differences from perfect symmetry due to roundoff error. + ! These differences are fixed provided they are small enough. + !------------------------------------------------------------------ + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(inout) :: & + Auu, Auv, Avu, Avv ! components of assembled stiffness matrix + ! + ! Auu | Auv + ! _____|____ + ! | + ! Avu | Avv + + integer :: i, j, k, iA, jA, kA, m, mm + + real(dp) :: val1, val2 ! values of matrix coefficients + + real(dp) :: maxdiff, diag_entry, avg_val + + ! Check matrix for symmetry + + ! Here we correct for small differences from symmetry due to roundoff error. + ! The maximum departure from symmetry is set to be a small fraction + ! of the diagonal entry for the row. + ! If the departure from symmetry is larger than this, then the model prints a warning + ! and/or aborts. + + maxdiff = 0.d0 + + ! Loop over locally owned vertices. + ! Each active vertex is associate with 2*nz matrix rows belonging to this processor. + ! Locally owned vertices are (nhalo+1:ny-nhalo, nhalo+1:nx-nhalo) + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + do k = 1, nz + + ! Check Auu and Auv for symmetry + + m = indxA_3d(0,0,0) + diag_entry = Auu(m,k,i,j) + + do jA = -1, 1 + do iA = -1, 1 + do kA = -1, 1 + + if (k+kA >= 1 .and. k+kA <=nz) then ! to keep k index in bounds + + m = indxA_3d( iA, jA, kA) + mm = indxA_3d(-iA,-jA,-kA) + + ! Check that Auu = Auu^T + + val1 = Auu( m, k, i, j ) ! value of Auu(row,col) + val2 = Auu(mm, k+kA, i+iA, j+jA) ! value of Auu(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Auu( m, k, i, j ) = avg_val + Auu(mm, k+kA,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Auu is not symmetric: i, j, k, iA, jA, kA =', i, j, k, iA, jA, kA + print*, 'Auu(row,col), Auu(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + ! Check that Auv = (Avu)^T + + val1 = Auv( m, k, i, j) ! value of Auv(row,col) + val2 = Avu(mm, k+kA, i+iA, j+jA) ! value of Avu(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Auv( m, k, i, j ) = avg_val + Avu(mm, k+kA,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Auv is not equal to (Avu)^T, i, j, k, iA, jA, kA =', i, j, k, iA, jA, kA + print*, 'Auv(row,col), Avu(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + endif ! k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + ! Now check Avu and Avv + + m = indxA_3d(0,0,0) + diag_entry = Avv(m,k,i,j) + + ! check that Avv = (Avv)^T + + do jA = -1, 1 + do iA = -1, 1 + do kA = -1, 1 + + if (k+kA >= 1 .and. k+kA <=nz) then ! to keep k index in bounds + + m = indxA_3d( iA, jA, kA) + mm = indxA_3d(-iA,-jA,-kA) + + val1 = Avv( m, k, i, j) ! value of Avv(row,col) + val2 = Avv(mm, k+kA, i+iA, j+jA) ! value of Avv(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Avv( m, k, i, j ) = avg_val + Avv(mm, k+kA,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Avv is not symmetric: i, j, k, iA, jA, kA =', i, j, k, iA, jA, kA + print*, 'Avv(row,col), Avv(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + ! Check that Avu = (Auv)^T + + val1 = Avu( m, k, i, j) ! value of Avu(row,col) + val2 = Auv(mm, k+kA, i+iA, j+jA) ! value of Auv(col,row) + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + if (val2 /= val1) then + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Avu( m, k, i, j ) = avg_val + Auv(mm, k+kA,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Avu is not equal to (Auv)^T, i, j, k, iA, jA, kA =', i, j, k, iA, jA, kA + print*, 'Avu(row,col), Auv(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + endif ! k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + enddo ! k + endif ! active_vertex + enddo ! i + enddo ! j + + if (verbose_matrix) maxdiff = parallel_reduce_max(maxdiff) + + if (verbose_matrix .and. main_task) then + print*, ' ' + print*, 'Max difference from symmetry =', maxdiff + endif + + end subroutine check_symmetry_assembled_matrix_3d + +!**************************************************************************** + + subroutine check_symmetry_assembled_matrix_2d(nx, ny, nhalo, & + active_vertex, & + Auu, Auv, Avu, Avv) + + !------------------------------------------------------------------ + ! Check that the assembled stiffness matrix is symmetric. + ! This is true provided that (1) Auu = (Auu)^T + ! (2) Avv = (Avv)^T + ! (3) Auv = (Avu)^T + ! The A matrices are assembled in a dense fashion to save storage + ! and preserve the i/j/k structure of the grid. + ! + ! There can be small differences from perfect symmetry due to roundoff error. + ! These differences are fixed provided they are small enough. + !------------------------------------------------------------------ + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nhalo ! number of halo layers + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(inout) :: & + Auu, Auv, Avu, Avv ! components of assembled stiffness matrix + ! + ! Auu | Auv + ! _____|____ + ! | + ! Avu | Avv + + integer :: i, j, iA, jA, m, mm + + real(dp) :: val1, val2 ! values of matrix coefficients + + real(dp) :: maxdiff, diag_entry, avg_val + + ! Check matrix for symmetry + + ! Here we correct for small differences from symmetry due to roundoff error. + ! The maximum departure from symmetry is set to be a small fraction + ! of the diagonal entry for the row. + ! If the departure from symmetry is larger than this, then the model prints a warning + ! and/or aborts. + + maxdiff = 0.d0 + + ! Loop over locally owned vertices. + ! Each active vertex is associate with 2*nz matrix rows belonging to this processor. + ! Locally owned vertices are (nhalo+1:ny-nhalo, nhalo+1:nx-nhalo) + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + if (active_vertex(i,j)) then + + ! Check Auu and Auv for symmetry + + m = indxA_2d(0,0) + diag_entry = Auu(m,i,j) + + do jA = -1, 1 + do iA = -1, 1 + + m = indxA_2d( iA, jA) + mm = indxA_2d(-iA,-jA) + + ! Check that Auu = Auu^T + + val1 = Auu( m, i, j ) ! value of Auu(row,col) + val2 = Auu(mm, i+iA, j+jA) ! value of Auu(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Auu( m, i, j ) = avg_val + Auu(mm, i+iA,j+jA) = avg_val + else + print*, 'WARNING: Auu is not symmetric: this_rank, i, j, iA, jA =', this_rank, i, j, iA, jA + print*, 'Auu(row,col), Auu(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + ! Check that Auv = (Avu)^T + + val1 = Auv( m, i, j) ! value of Auv(row,col) + val2 = Avu(mm, i+iA, j+jA) ! value of Avu(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Auv( m, i, j) = avg_val + Avu(mm,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Auv is not equal to (Avu)^T, i, j, iA, jA =', i, j, iA, jA + print*, 'Auv(row,col), Avu(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + enddo ! iA + enddo ! jA + + ! Now check Avu and Avv + + m = indxA_2d(0,0) + diag_entry = Avv(m,i,j) + + ! check that Avv = (Avv)^T + + do jA = -1, 1 + do iA = -1, 1 + + m = indxA_2d( iA, jA) + mm = indxA_2d(-iA,-jA) + + val1 = Avv( m, i, j) ! value of Avv(row,col) + val2 = Avv(mm, i+iA, j+jA) ! value of Avv(col,row) + + if (val2 /= val1) then + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Avv( m, i, j) = avg_val + Avv(mm,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Avv is not symmetric: i, j, iA, jA =', i, j, iA, jA + print*, 'Avv(row,col), Avv(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + ! Check that Avu = (Auv)^T + + val1 = Avu( m, i, j) ! value of Avu(row,col) + val2 = Auv(mm, i+iA, j+jA) ! value of Auv(col,row) + + if (abs(val2 - val1) > maxdiff) maxdiff = abs(val2 - val1) + + if (val2 /= val1) then + + ! if difference is small, then fix the asymmetry by averaging values + ! else print a warning and abort + + if ( abs(val2-val1) < eps08*abs(diag_entry) ) then + avg_val = 0.5d0 * (val1 + val2) + Avu( m, i, j) = avg_val + Auv(mm,i+iA,j+jA) = avg_val + else + print*, 'WARNING: Avu is not equal to (Auv)^T, i, j, iA, jA =', i, j, iA, jA + print*, 'Avu(row,col), Auv(col,row), diff/diag:', val1, val2, (val2 - val1)/diag_entry +!! stop + endif + + endif ! val2 /= val1 + + enddo ! iA + enddo ! jA + + endif ! active_vertex + enddo ! i + enddo ! j + + if (verbose_matrix) maxdiff = parallel_reduce_max(maxdiff) + + if (verbose_matrix .and. main_task) then + print*, ' ' + print*, 'Max difference from symmetry =', maxdiff + endif + + end subroutine check_symmetry_assembled_matrix_2d + +!**************************************************************************** + + subroutine write_matrix_elements_3d(nx, ny, nz, & + nNodesSolve, nodeID, & + iNodeIndex, jNodeIndex, & + kNodeIndex, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension(nz,nx-1,ny-1), intent(in) :: & + nodeID ! ID for each node + + integer, dimension(:), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of active nodes + + real(dp), dimension(nNodeNeighbors_3d,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = node and its nearest neighbors in x, y and z direction + ! other dimensions = (k,i,j) indices + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + ! Local variables + + integer :: rowA, colA + integer :: i, j, k, m, iA, jA, kA + + real(dp), dimension(nNodesSolve, nNodesSolve) :: & + Auu_val, Auv_val, Avu_val, Avv_val ! dense matrices + + real(dp), dimension(nNodesSolve) :: nonzeros + + Auu_val(:,:) = 0.d0 + Auv_val(:,:) = 0.d0 + Avu_val(:,:) = 0.d0 + Avv_val(:,:) = 0.d0 + + do rowA = 1, nNodesSolve + + i = iNodeIndex(rowA) + j = jNodeIndex(rowA) + k = kNodeIndex(rowA) + + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = nodeID(k+kA, i+iA, j+jA) ! ID for neighboring node + m = indxA_3d(iA,jA,kA) + + if (colA > 0) then + Auu_val(rowA, colA) = Auu(m,k,i,j) + Auv_val(rowA, colA) = Auv(m,k,i,j) + Avu_val(rowA, colA) = Avu(m,k,i,j) + Avv_val(rowA, colA) = Avv(m,k,i,j) + endif + + endif ! i+iA, j+jA, and k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + enddo ! rowA + + !WHL - bug check + print*, ' ' + print*, 'nonzeros per row:' + do rowA = 1, nNodesSolve + nonzeros(rowA) = 0 + do colA = 1, nNodesSolve + if (abs(Auu_val(rowA,colA)) > 1.d-11) then + nonzeros(rowA) = nonzeros(rowA) + 1 + endif + enddo +! print*, rowA, nonzeros(rowA) + enddo + + print*, 'Write matrix elements to file, label =', matrix_label + + ! Write matrices to file (one line of file corresponding to each row of matrix) + + open(unit=10, file='Auu.'//matrix_label, status='unknown') + open(unit=11, file='Auv.'//matrix_label, status='unknown') + open(unit=12, file='Avu.'//matrix_label, status='unknown') + open(unit=13, file='Avv.'//matrix_label, status='unknown') + + do rowA = 1, nNodesSolve + write(10,'(i6)',advance='no') rowA + write(11,'(i6)',advance='no') rowA + write(12,'(i6)',advance='no') rowA + write(13,'(i6)',advance='no') rowA + do colA = 1, nNodesSolve + write(10,'(e16.8)',advance='no') Auu_val(rowA,colA) + write(11,'(e16.8)',advance='no') Auv_val(rowA,colA) + write(12,'(e16.8)',advance='no') Avu_val(rowA,colA) + write(13,'(e16.8)',advance='no') Avv_val(rowA,colA) + enddo + write(10,*) ' ' + write(11,*) ' ' + write(12,*) ' ' + write(13,*) ' ' + enddo + + close(10) + close(11) + close(12) + close(13) + + print*, 'Done writing matrix elements' + + ! write load vectors to file + open(unit=14, file='bu.'//matrix_label, status='unknown') + open(unit=15, file='bv.'//matrix_label, status='unknown') + do rowA = 1, nNodesSolve + i = iNodeIndex(rowA) + j = jNodeIndex(rowA) + k = kNodeIndex(rowA) + write(14,'(i6, e16.8)') rowA, bu(k,i,j) + write(15,'(i6, e16.8)') rowA, bv(k,i,j) + enddo + close(14) + close(15) + + end subroutine write_matrix_elements_3d + +!**************************************************************************** + + subroutine write_matrix_elements_2d(nx, ny, & + nVerticesSolve, vertexID, & + iVertexIndex, jVertexIndex, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension(nx-1,ny-1), intent(in) :: & + vertexID ! ID for each vertex + + integer, dimension(:), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of active vertices + + real(dp), dimension(nNodeNeighbors_2d,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = vertex and its nearest neighbors in x and y direction + ! other dimensions = (i,j) indices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + ! Local variables + + integer :: rowA, colA + integer :: i, j, m, iA, jA + + real(dp), dimension(nVerticesSolve, nVerticesSolve) :: & + Auu_val, Auv_val, Avu_val, Avv_val ! dense matrices + + real(dp), dimension(nVerticesSolve) :: nonzeros + + Auu_val(:,:) = 0.d0 + Auv_val(:,:) = 0.d0 + Avu_val(:,:) = 0.d0 + Avv_val(:,:) = 0.d0 + + do rowA = 1, nVerticesSolve + + i = iVertexIndex(rowA) + j = jVertexIndex(rowA) + do jA = -1, 1 + do iA = -1, 1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = vertexID(i+iA, j+jA) ! ID for neighboring vertex + m = indxA_2d(iA,jA) + + if (colA > 0) then + Auu_val(rowA, colA) = Auu(m,i,j) + Auv_val(rowA, colA) = Auv(m,i,j) + Avu_val(rowA, colA) = Avu(m,i,j) + Avv_val(rowA, colA) = Avv(m,i,j) + endif + + endif ! i+iA and j+jA in bounds + + enddo ! iA + enddo ! jA + + enddo ! rowA + + !WHL - bug check + print*, ' ' + print*, 'nonzeros per row:' + do rowA = 1, nVerticesSolve + nonzeros(rowA) = 0 + do colA = 1, nVerticesSolve + if (abs(Auu_val(rowA,colA)) > 1.d-11) then + nonzeros(rowA) = nonzeros(rowA) + 1 + endif + enddo +! print*, rowA, nonzeros(rowA) + enddo + + print*, 'Write matrix elements to file, label =', matrix_label + + ! Write matrices to file (one line of file corresponding to each row of matrix) + + open(unit=10, file='Auu.'//matrix_label, status='unknown') + open(unit=11, file='Auv.'//matrix_label, status='unknown') + open(unit=12, file='Avu.'//matrix_label, status='unknown') + open(unit=13, file='Avv.'//matrix_label, status='unknown') + + do rowA = 1, nVerticesSolve + write(10,'(i6)',advance='no') rowA + write(11,'(i6)',advance='no') rowA + write(12,'(i6)',advance='no') rowA + write(13,'(i6)',advance='no') rowA + do colA = 1, nVerticesSolve + write(10,'(e16.8)',advance='no') Auu_val(rowA,colA) + write(11,'(e16.8)',advance='no') Auv_val(rowA,colA) + write(12,'(e16.8)',advance='no') Avu_val(rowA,colA) + write(13,'(e16.8)',advance='no') Avv_val(rowA,colA) + enddo + write(10,*) ' ' + write(11,*) ' ' + write(12,*) ' ' + write(13,*) ' ' + enddo + + close(10) + close(11) + close(12) + close(13) + + print*, 'Done writing matrix elements' + + ! write load vectors to file + open(unit=14, file='bu.'//matrix_label, status='unknown') + open(unit=15, file='bv.'//matrix_label, status='unknown') + do rowA = 1, nVerticesSolve + i = iVertexIndex(rowA) + j = jVertexIndex(rowA) + write(14,'(i6, e16.8)') rowA, bu(i,j) + write(15,'(i6, e16.8)') rowA, bv(i,j) + enddo + close(14) + close(15) + + end subroutine write_matrix_elements_2d + +!**************************************************************************** + + end module glissade_velo_higher + +!**************************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo_higher_pcg.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_pcg.F90 new file mode 100644 index 0000000000..fd6835806d --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_pcg.F90 @@ -0,0 +1,2943 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo_higher_pcg.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains subroutines called from glissade_velo_higher.F90 and used +! to solve the problem Ax = b using the preconditioned conjugate gradient method. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + + module glissade_velo_higher_pcg + + use glimmer_global, only: dp + use glide_types ! for preconditioning options + use glimmer_log + use profile + use parallel + + implicit none + + private + public :: pcg_solver_standard_3d, pcg_solver_standard_2d, & + pcg_solver_chrongear_3d, pcg_solver_chrongear_2d + + logical :: verbose_pcg + + interface global_sum_staggered + module procedure global_sum_staggered_3d_real8 + module procedure global_sum_staggered_3d_real8_nvar + module procedure global_sum_staggered_2d_real8 + module procedure global_sum_staggered_2d_real8_nvar + end interface + + contains + +!**************************************************************************** + + subroutine pcg_solver_standard_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + xu, xv, & + precond, err, & + niters, & + itest_in, jtest_in, rtest_in, & + verbose) + + !--------------------------------------------------------------- + ! This subroutine uses a standard preconditioned conjugate-gradient algorithm + ! to solve the equation $Ax=b$. + ! Convergence is checked every {\em solv_ncheck} steps. + ! + ! It is based on the barotropic solver in the POP ocean model + ! (author Phil Jones, LANL). Input and output arrays are located + ! on a structured (i,j,k) grid as defined in the glissade_velo_higher + ! module. The global matrix is sparse, but its nonzero elements + ! are stored in four dense matrices called Auu, Avv, Auv, and Avu. + ! Each matrix has 3x3x3 = 27 potential nonzero elements per + ! node (i,j,k). + ! + ! The current preconditioning options are + ! (0) no preconditioning + ! (1) diagonal preconditioning + ! (2) preconditioning using a physics-based SIA solver + ! + ! For the dome test case with higher-order dynamics, option (2) is best. + ! + ! Here is a schematic of the method implemented below for solving Ax = b: + ! + ! halo_update(x0) + ! r0 = b - A*x0 + ! d0 = 0 + ! eta0 = 1 + ! + ! while (not converged) + ! solve Mz = r for z + ! eta1 = (r,z) + ! beta = eta1/eta0 + ! d = z + beta*d + ! halo_update(d) + ! eta0 = eta1 + ! q = Ad + ! eta2 = (d,q) + ! alpha = eta1/eta2 + ! x = x + alpha*d + ! r = r - alpha*q (or occasionally, r = b - Ax) + ! Check for convergence: err = sqrt(r,r)/sqrt(b,b) < tolerance + ! end while + ! + ! where x = solution (initial value = x0) + ! d = conjugate direction vector (initial value = d0) + ! r = residual vector (initial value = r0) + ! M = preconditioning matrix + ! (r,z) = dot product of vectors r and z + ! and similarly for (d,q) + ! + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + xu, xv ! u and v components of solution (i.e., uvel and vvel) + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning (best option for SSA-dominated flow) + ! = 2 for preconditioning with SIA solver (works well for SIA-dominated flow) + + real(dp), intent(out) :: & + err ! error (L2 norm of residual) in final solution + + integer, intent(out) :: & + niters ! iterations needed to solution + + integer, intent(in), optional :: & + itest_in, jtest_in, rtest_in ! point for debugging diagnostics + + logical, intent(in), optional :: & + verbose ! if true, print diagnostic output + + !--------------------------------------------------------------- + ! Local variables and parameters + !--------------------------------------------------------------- + + integer :: i, j, k ! grid indices + integer :: iA, jA, kA ! grid offsets ranging from -1 to 1 + integer :: m ! matrix element index + integer :: n ! iteration counter + + real(dp) :: & + eta0, eta1, eta2, &! scalar inner product results + alpha, &! eta1/eta2 = term in expression for new residual and solution + beta ! eta1/eta0 = term in expression for new direction vector + + ! vectors (each of these is split into u and v components) + real(dp), dimension(nz,nx-1,ny-1) :: & + Adiagu, Adiagv, &! diagonal terms of matrices Auu and Avv + ru, rv, &! residual vector (b-Ax) + du, dv, &! conjugate direction vector + qu, qv, &! A*d + zu, zv, &! solution of Mz = r (also used as a temporary vector) + work0u, work0v ! cg intermediate results + + real(dp) :: & + L2_resid, &! L2 norm of residual vector Ax-b + L2_rhs ! L2 norm of rhs vector b + ! solver converges when L2_resid/L2_rhs < tolerance + + real(dp), dimension(-1:1,nz,nx-1,ny-1) :: & + Muu, Mvv ! simplified SIA matrices for preconditioning + + integer :: itest, jtest, rtest + + !--------------------------------------------------------------- + ! Solver parameters + ! TODO: Pass in PCG solver parameters as arguments? (Here and below) + !--------------------------------------------------------------- + + real(dp), parameter :: & +!! tolerance = 1.d-11 ! tolerance for linear solver (old value; more stringent than necessary) + tolerance = 1.d-08 ! tolerance for linear solver + + integer, parameter :: & + maxiters = 200 ! max number of linear iterations before quitting + + integer, parameter :: & + solv_ncheck = 5 ! check for convergence every solv_ncheck iterations + + if (present(itest_in)) then + itest = itest_in + else + itest = nx/2 + endif + + if (present(itest_in)) then + jtest = jtest_in + else + jtest = ny/2 + endif + + if (present(itest_in)) then + rtest = rtest_in + else + rtest = 0 + endif + + if (present(verbose)) then + verbose_pcg = verbose + else + verbose_pcg = .false. ! for debugging + endif + + if (verbose_pcg .and. main_task) then + print*, 'Using native PCG solver (standard)' + print*, 'tolerance, maxiters, precond =', tolerance, maxiters, precond + endif + + ! Set up matrices for preconditioning + + call t_startf("pcg_precond_init") + call setup_preconditioner_3d(nx, ny, & + nz, & + precond, indxA, & + Auu, Avv, & + Adiagu, Adiagv, & + Muu, Mvv) + call t_stopf("pcg_precond_init") + + ! Compute initial residual and initialize the direction vector d + ! Note: The matrix A must be complete for all rows corresponding to locally + ! owned vertices, and x must have the correct values in + ! halo vertices bordering the locally owned vertices. + ! Then y = Ax will be correct for locally owned vertices. + + ! Halo update for x (initial guess for velocity solution) + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_init") + + ! Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_init") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_init") + + ! Compute the initial residual r(0) = b - Ax(0) + ! This will be correct for locally owned vertices. + + call t_startf("pcg_vecupdate_init") + ru(:,:,:) = bu(:,:,:) - zu(:,:,:) + rv(:,:,:) = bv(:,:,:) - zv(:,:,:) + call t_stopf("pcg_vecupdate_init") + + ! Initialize scalars and vectors + + niters = maxiters + eta0 = 1.d0 + + du(:,:,:) = 0.d0 + dv(:,:,:) = 0.d0 + + zu(:,:,:) = 0.d0 + zv(:,:,:) = 0.d0 + + ! Compute the L2 norm of the RHS vectors + ! (Goal is to obtain L2_resid/L2_rhs < tolerance) + + call t_startf("pcg_dotprod") + work0u(:,:,:) = bu(:,:,:)*bu(:,:,:) ! terms of dot product (b, b) + work0v(:,:,:) = bv(:,:,:)*bv(:,:,:) + call t_stopf("pcg_dotprod") + + ! find global sum of the squared L2 norm + + call t_startf("pcg_glbsum_init") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + L2_rhs, & + work0u, work0v) + call t_stopf("pcg_glbsum_init") + + ! take square root + + L2_rhs = sqrt(L2_rhs) ! L2 norm of RHS + + ! iterate to solution + + iter_loop: do n = 1, maxiters + + call t_startf("pcg_precond") + + ! Compute PC(r) = solution z of Mz = r + + if (precond == 0) then ! no preconditioning + + zu(:,:,:) = ru(:,:,:) ! PC(r) = r + zv(:,:,:) = rv(:,:,:) ! PC(r) = r + + elseif (precond == 1 ) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + if (Adiagu(k,i,j) /= 0.d0) then + zu(k,i,j) = ru(k,i,j) / Adiagu(k,i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(k,i,j) = 0.d0 + endif + if (Adiagv(k,i,j) /= 0.d0) then + zv(k,i,j) = rv(k,i,j) / Adiagv(k,i,j) + else + zv(k,i,j) = 0.d0 + endif + enddo ! k + enddo ! i + enddo ! j + + elseif (precond == 2) then ! local vertical shallow-ice solver for preconditioning + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Muu, ru, zu) ! solve Muu*zu = ru for zu + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Mvv, rv, zv) ! solve Mvv*zv = rv for zv + + endif ! precond + + call t_stopf("pcg_precond") + + ! Compute the dot product eta1 = (r, PC(r)) + + call t_startf("pcg_dotprod") + work0u(:,:,:) = ru(:,:,:)*zu(:,:,:) ! terms of dot product (r, PC(r)) + work0v(:,:,:) = rv(:,:,:)*zv(:,:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + eta1, & + work0u, work0v) + call t_stopf("pcg_glbsum_iter") + + !WHL - If the SIA solver has failed due to singular matrices, + ! then eta1 will be NaN. + + if (eta1 /= eta1) then ! eta1 is NaN + call write_log('PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + ! Update the conjugate direction vector d + + beta = eta1/eta0 + + call t_startf("pcg_vecupdate") + du(:,:,:) = zu(:,:,:) + beta*du(:,:,:) ! d_(i+1) = PC(r_(i+1)) + beta_(i+1)*d_i + dv(:,:,:) = zv(:,:,:) + beta*dv(:,:,:) ! + ! (r_(i+1), PC(r_(i+1))) + ! where beta_(i+1) = -------------------- + ! (r_i, PC(r_i)) + ! Initially eta0 = 1 + ! For n >=2, eta0 = old eta1 + call t_stopf("pcg_vecupdate") + + ! Halo update for d + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(du) + call staggered_parallel_halo(dv) + call t_stopf("pcg_halo_iter") + + ! Compute q = A*d + ! This is the one matvec multiply required for each iteration + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + du, dv, & + qu, qv) + call t_stopf("pcg_matmult_iter") + + ! Copy old eta1 = (r, PC(r)) to eta0 + + eta0 = eta1 ! (r_(i+1), PC(r_(i+1))) --> (r_i, PC(r_i)) + + ! Compute the dot product eta2 = (d, A*d) + + call t_startf("pcg_dotprod") + work0u(:,:,:) = du(:,:,:) * qu(:,:,:) ! terms of dot product (d, Ad) + work0v(:,:,:) = dv(:,:,:) * qv(:,:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + eta2, & + work0u, work0v) + call t_stopf("pcg_glbsum_iter") + + ! Compute alpha + ! (r, PC(r)) + alpha = eta1/eta2 ! alpha = ---------- + ! (d, A*d) + + !WHL - If eta2 = 0 (e.g., because all matrix entries are zero), then alpha = NaN + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'eta1, eta2, alpha:', eta1, eta2, alpha + call write_log('PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + ! Compute the new solution and residual + + call t_startf("pcg_vecupdate") + xu(:,:,:) = xu(:,:,:) + alpha * du(:,:,:) ! new solution, x_(i+1) = x_i + alpha*d + xv(:,:,:) = xv(:,:,:) + alpha * dv(:,:,:) + + ru(:,:,:) = ru(:,:,:) - alpha * qu(:,:,:) ! new residual, r_(i+1) = r_i - alpha*(Ad) + rv(:,:,:) = rv(:,:,:) - alpha * qv(:,:,:) + call t_stopf("pcg_vecupdate") + + ! Check for convergence every solv_ncheck iterations + ! For convergence check, use r = b - Ax + + if (mod(n,solv_ncheck) == 0) then + + ! Halo update for x + + call t_startf("pcg_halo_resid") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_resid") + + ! Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_resid") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_resid") + + ! Compute residual r = b - Ax + + call t_startf("pcg_vecupdate") + ru(:,:,:) = bu(:,:,:) - zu(:,:,:) + rv(:,:,:) = bv(:,:,:) - zv(:,:,:) + call t_stopf("pcg_vecupdate") + + ! Compute squared L2 norm of (r, r) + + call t_startf("pcg_dotprod") + work0u(:,:,:) = ru(:,:,:)*ru(:,:,:) ! terms of dot product (r, r) + work0v(:,:,:) = rv(:,:,:)*rv(:,:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_resid") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + L2_resid, & + work0u, work0v) + call t_stopf("pcg_glbsum_resid") + + ! take square root + L2_resid = sqrt(L2_resid) ! L2 norm of residual + + ! compute normalized error + err = L2_resid/L2_rhs + + if (verbose_pcg .and. main_task) then +! print*, ' ' +! print*, 'iter, L2_resid, error =', n, L2_resid, err + endif + + if (err < tolerance) then + niters = n + exit iter_loop + endif + + endif ! solv_ncheck + + enddo iter_loop + +!WHL - Without good preconditioning, convergence can be slow, but the solution after maxiters might be good enough. + + if (niters == maxiters) then + if (main_task) then + print*, 'WARNING: Glissade PCG solver not converged' + print*, 'niters, err, tolerance:', niters, err, tolerance + endif +!!! stop + endif + + end subroutine pcg_solver_standard_3d + +!**************************************************************************** + + subroutine pcg_solver_standard_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + xu, xv, & + precond, err, & + niters, & + itest_in, jtest_in, rtest_in, & + verbose) + + !--------------------------------------------------------------- + ! This subroutine uses a standard preconditioned conjugate-gradient algorithm + ! to solve the equation $Ax=b$. + ! Convergence is checked every {\em solv_ncheck} steps. + ! + ! It is similar to subroutine pcg_solver_standard_3d, but modified + ! to solve for x and y at a single horizontal level, as in the + ! shallow-shelf approximation. See the comments in that subroutine + ! (above) for more details on data structure and solver methods. + ! + ! Input and output arrays are located on a structured (i,j) grid + ! as defined in the glissade_velo_higher module. The global matrix + ! is sparse, but its nonzero element are stored in four dense matrices + ! called Auu, Avv, Auv, and Avu. Each matrix has 3x3 = 9 potential + ! nonzero elements per node (i,j). + ! + ! The current preconditioning options are + ! (0) no preconditioning + ! (1) diagonal preconditioning + ! + ! The SIA-based preconditioning optional is not available for a 2D solve. + ! + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y) coordinates to an index between 1 and 9 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for vertices (i,j) where velocity is computed, else F + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 9 (node and its nearest neighbors in x and y direction) + ! other dimensions = (x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nx-1,ny-1), intent(inout) :: & + xu, xv ! u and v components of solution (i.e., uvel and vvel) + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning (best option for SSA-dominated flow) + + real(dp), intent(out) :: & + err ! error (L2 norm of residual) in final solution + + integer, intent(out) :: & + niters ! iterations needed to solution + + integer, intent(in), optional :: & + itest_in, jtest_in, rtest_in ! point for debugging diagnostics + + logical, intent(in), optional :: & + verbose ! if true, print diagnostic output + + !--------------------------------------------------------------- + ! Local variables and parameters + !--------------------------------------------------------------- + + integer :: i, j ! grid indices + integer :: n ! iteration counter + + real(dp) :: & + eta0, eta1, eta2, &! scalar inner product results + alpha, &! eta1/eta2 = term in expression for new residual and solution + beta ! eta1/eta0 = term in expression for new direction vector + + ! vectors (each of these is split into u and v components) + real(dp), dimension(nx-1,ny-1) :: & + Adiagu, Adiagv, &! diagonal terms of matrices Auu and Avv + ru, rv, &! residual vector (b-Ax) + du, dv, &! conjugate direction vector + qu, qv, &! A*d + zu, zv, &! solution of Mz = r (also used as a temporary vector) + work0u, work0v ! cg intermediate results + + real(dp) :: & + L2_resid, &! L2 norm of residual vector Ax-b + L2_rhs ! L2 norm of rhs vector b + ! solver converges when L2_resid/L2_rhs < tolerance + + integer :: itest, jtest, rtest + + !--------------------------------------------------------------- + ! Solver parameters + !--------------------------------------------------------------- + + real(dp), parameter :: & +!! tolerance = 1.d-11 ! tolerance for linear solver (old value; more stringent than necessary) + tolerance = 1.d-08 ! tolerance for linear solver + + integer, parameter :: & + maxiters = 200 ! max number of linear iterations before quitting + + integer, parameter :: & + solv_ncheck = 5 ! check for convergence every solv_ncheck iterations + + if (present(itest_in)) then + itest = itest_in + else + itest = nx/2 + endif + + if (present(itest_in)) then + jtest = jtest_in + else + jtest = ny/2 + endif + + if (present(itest_in)) then + rtest = rtest_in + else + rtest = 0 + endif + + if (present(verbose)) then + verbose_pcg = verbose + else + verbose_pcg = .false. ! for debugging + endif + + if (verbose_pcg .and. main_task) then + print*, 'Using native PCG solver (standard)' + print*, 'tolerance, maxiters, precond =', tolerance, maxiters, precond + endif + + ! Set up matrices for preconditioning + + call t_startf("pcg_precond_init") + call setup_preconditioner_2d(nx, ny, & + precond, indxA, & + Auu, Avv, & + Adiagu, Adiagv) + call t_stopf("pcg_precond_init") + + ! Compute initial residual and initialize the direction vector d + ! Note: The matrix A must be complete for all rows corresponding to locally + ! owned vertices, and x must have the correct values in + ! halo vertices bordering the locally owned vertices. + ! Then y = Ax will be correct for locally owned vertices. + + ! Halo update for x (initial guess for velocity solution) + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_init") + + ! Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_init") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_init") + + ! Compute the initial residual r(0) = b - Ax(0) + ! This will be correct for locally owned vertices. + + call t_startf("pcg_vecupdate_init") + ru(:,:) = bu(:,:) - zu(:,:) + rv(:,:) = bv(:,:) - zv(:,:) + call t_stopf("pcg_vecupdate_init") + + ! Initialize scalars and vectors + + niters = maxiters + eta0 = 1.d0 + + du(:,:) = 0.d0 + dv(:,:) = 0.d0 + + zu(:,:) = 0.d0 + zv(:,:) = 0.d0 + + ! Compute the L2 norm of the RHS vectors + ! (Goal is to obtain L2_resid/L2_rhs < tolerance) + + call t_startf("pcg_dotprod") + work0u(:,:) = bu(:,:)*bu(:,:) ! terms of dot product (b, b) + work0v(:,:) = bv(:,:)*bv(:,:) + call t_stopf("pcg_dotprod") + + ! find global sum of the squared L2 norm + + call t_startf("pcg_glbsum_init") + call global_sum_staggered(nx, ny, & + nhalo, L2_rhs, & + work0u, work0v) + call t_stopf("pcg_glbsum_init") + + ! take square root + + L2_rhs = sqrt(L2_rhs) ! L2 norm of RHS + + ! iterate to solution + + iter_loop: do n = 1, maxiters + + call t_startf("pcg_precond") + + ! Compute PC(r) = solution z of Mz = r + + if (precond == 0) then ! no preconditioning + + zu(:,:) = ru(:,:) ! PC(r) = r + zv(:,:) = rv(:,:) ! PC(r) = r + + elseif (precond == 1) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + if (Adiagu(i,j) /= 0.d0) then + zu(i,j) = ru(i,j) / Adiagu(i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(i,j) = 0.d0 + endif + if (Adiagv(i,j) /= 0.d0) then + zv(i,j) = rv(i,j) / Adiagv(i,j) + else + zv(i,j) = 0.d0 + endif + enddo ! i + enddo ! j + + endif ! precond + + call t_stopf("pcg_precond") + + ! Compute the dot product eta1 = (r, PC(r)) + + call t_startf("pcg_dotprod") + work0u(:,:) = ru(:,:)*zu(:,:) ! terms of dot product (r, PC(r)) + work0v(:,:) = rv(:,:)*zv(:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nhalo, eta1, & + work0u, work0v) + call t_stopf("pcg_glbsum_iter") + + !WHL - If the SIA solver has failed due to singular matrices, + ! then eta1 will be NaN. + + if (eta1 /= eta1) then ! eta1 is NaN + call write_log('PCG solver has failed, eta1 = NaN', GM_FATAL) + endif + + ! Update the conjugate direction vector d + + beta = eta1/eta0 + + call t_startf("pcg_vecupdate") + du(:,:) = zu(:,:) + beta*du(:,:) ! d_(i+1) = PC(r_(i+1)) + beta_(i+1)*d_i + dv(:,:) = zv(:,:) + beta*dv(:,:) ! + ! (r_(i+1), PC(r_(i+1))) + ! where beta_(i+1) = -------------------- + ! (r_i, PC(r_i)) + ! Initially eta0 = 1 + ! For n >=2, eta0 = old eta1 + call t_stopf("pcg_vecupdate") + + ! Halo update for d + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(du) + call staggered_parallel_halo(dv) + call t_stopf("pcg_halo_iter") + + ! Compute q = A*d + ! This is the one matvec multiply required for each iteration + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + du, dv, & + qu, qv) + call t_stopf("pcg_matmult_iter") + + ! Copy old eta1 = (r, PC(r)) to eta0 + + eta0 = eta1 ! (r_(i+1), PC(r_(i+1))) --> (r_i, PC(r_i)) + + ! Compute the dot product eta2 = (d, A*d) + + call t_startf("pcg_dotprod") + work0u(:,:) = du(:,:) * qu(:,:) ! terms of dot product (d, Ad) + work0v(:,:) = dv(:,:) * qv(:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nhalo, eta2, & + work0u, work0v) + call t_stopf("pcg_glbsum_iter") + + ! Compute alpha + ! (r, PC(r)) + alpha = eta1/eta2 ! alpha = ---------- + ! (d, A*d) + + !WHL - If eta2 = 0 (e.g., because all matrix entries are zero), then alpha = NaN + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'eta1, eta2, alpha:', eta1, eta2, alpha + call write_log('PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + ! Compute the new solution and residual + + call t_startf("pcg_vecupdate") + xu(:,:) = xu(:,:) + alpha * du(:,:) ! new solution, x_(i+1) = x_i + alpha*d + xv(:,:) = xv(:,:) + alpha * dv(:,:) + + ru(:,:) = ru(:,:) - alpha * qu(:,:) ! new residual, r_(i+1) = r_i - alpha*(Ad) + rv(:,:) = rv(:,:) - alpha * qv(:,:) + call t_stopf("pcg_vecupdate") + + ! Check for convergence every solv_ncheck iterations + ! For convergence check, use r = b - Ax + + if (mod(n,solv_ncheck) == 0) then + + ! Halo update for x + + call t_startf("pcg_halo_resid") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_resid") + + ! Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_resid") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_resid") + + ! Compute residual r = b - Ax + + call t_startf("pcg_vecupdate") + ru(:,:) = bu(:,:) - zu(:,:) + rv(:,:) = bv(:,:) - zv(:,:) + call t_stopf("pcg_vecupdate") + + ! Compute squared L2 norm of (r, r) + + call t_startf("pcg_dotprod") + work0u(:,:) = ru(:,:)*ru(:,:) ! terms of dot product (r, r) + work0v(:,:) = rv(:,:)*rv(:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_resid") + call global_sum_staggered(nx, ny, & + nhalo, L2_resid, & + work0u, work0v) + call t_stopf("pcg_glbsum_resid") + + ! take square root + L2_resid = sqrt(L2_resid) ! L2 norm of residual + + ! compute normalized error + err = L2_resid/L2_rhs + + if (err < tolerance) then + niters = n + exit iter_loop + endif + + endif ! solv_ncheck + + enddo iter_loop + +!WHL - Without good preconditioning, convergence can be slow, but the solution after maxiters might be good enough. + + if (niters == maxiters) then + if (main_task) then + print*, 'Glissade PCG solver not converged' + print*, 'niters, err, tolerance:', niters, err, tolerance + endif + endif + + end subroutine pcg_solver_standard_2d + +!**************************************************************************** + + subroutine pcg_solver_chrongear_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + xu, xv, & + precond, err, & + niters, & + itest_in, jtest_in, rtest_in, & + verbose) + + !--------------------------------------------------------------- + ! This subroutine uses a Chronopoulos-Gear preconditioned conjugate-gradient + ! algorithm to solve the equation $Ax=b$. + ! + ! It is based on the Chronopoulos-Gear PCG solver in the POP ocean model + ! (author Frank Bryan, NCAR). It is a rearranged conjugate gradient solver + ! that reduces the number of global reductions per iteration from two to one + ! (not counting the convergence check). Convergence is checked every + ! {\em solv_ncheck} steps. + ! + ! References are: + ! + ! Chronopoulos, A.T., and C.W. Gear. S-step iterative methods + ! for symmetric linear systems. J. Comput. Appl. Math., 25(2), + ! 153-168, 1989. + ! + ! Dongarra, J. and V. Eijkhout. LAPACK Working Note 159. + ! Finite-choice algorithm optimization in conjugate gradients. + ! Tech. Rep. ut-cs-03-502. Computer Science Department. + ! University of Tennessee, Knoxville. 2003. + ! + ! D Azevedo, E.F., V.L. Eijkhout, and C.H. Romine. LAPACK Working + ! Note 56. Conjugate gradient algorithms with reduced + ! synchronization overhead on distributed memory multiprocessors. + ! Tech. Rep. CS-93-185. Computer Science Department. + ! University of Tennessee, Knoxville. 1993. + !--------------------------------------------------------------- + ! + ! The input and output arrays are located on a structured (i,j,k) grid + ! as defined in the glissade_velo_higher module. + ! The global matrix is sparse, but its nonzero elements are stored in + ! four dense matrices called Auu, Avv, Auv, and Avu. + ! Each matrix has 3x3x3 = 27 potential nonzero elements per node (i,j,k). + ! + ! The current preconditioning options are + ! (0) no preconditioning + ! (1) diagonal preconditioning + ! (2) preconditioning using a physics-based SIA solver + ! + ! For the dome test case with higher-order dynamics, option (2) is best. + ! + ! Here is a schematic of the method implemented below for solving Ax = b: + ! + ! Set up preconditioner M + ! work0 = (b,b) + ! bb = global_sum(work0) + ! + ! First pass of algorithm: + ! halo_update(x) + ! r = b - A*x + ! halo_update(r) + ! solve Mz = r for z + ! work(1) = (r,z) + ! d = z + ! q = A*d + ! work(2) = (d,q) + ! halo_update(q) + ! rho_old = global_sum(work(1)) + ! sigma = global_sum(work(2)) + ! alpha = rho_old/sigma + ! x = x + alpha*d + ! r = r - alpha*q + ! + ! Iterative loop: + ! while (not converged) + ! solve Mz = r for z + ! Az = A*z + ! work(1) = (r,z) + ! work(2) = (Az,z) + ! halo_update(Az) + ! rho = global_sum(work(1)) + ! delta = global_sum(work(2)) + ! beta = rho/rho_old + ! sigma = delta - beta^2 * sigma + ! alpha = rho/sigma + ! rho_old = rho + ! d = z + beta*d + ! q = Az + beta*q + ! x = x + alpha*d + ! r = r - alpha*q + ! if (time to check convergence) then + ! r = b - A*x + ! work0 = (r,r) + ! halo_update(r) + ! rr = global_sum(work0) + ! if (sqrt(r,r)/sqrt(b,b) < tolerance) exit + ! endif + ! end while + ! + ! where x = solution vector + ! d = conjugate direction vector + ! r = residual vector + ! M = preconditioning matrix + ! (r,z) = dot product of vectors r and z + ! and similarly for (Az,z), etc. + ! + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + nz, & ! number of vertical levels where velocity is computed + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + xu, xv ! u and v components of solution (i.e., uvel and vvel) + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning (best option for SSA-dominated flow) + ! = 2 for preconditioning with SIA solver (works well for SIA-dominated flow) + + real(dp), intent(out) :: & + err ! error (L2 norm of residual) in final solution + + integer, intent(out) :: & + niters ! iterations needed to solution + + integer, intent(in), optional :: & + itest_in, jtest_in, rtest_in ! point for debugging diagnostics + + logical, intent(in), optional :: & + verbose ! if true, print diagnostic output + + !--------------------------------------------------------------- + ! Local variables and parameters + !--------------------------------------------------------------- + + integer :: i, j, k ! grid indices + integer :: n ! iteration counter + + real(dp) :: & + alpha, &! rho/sigma = term in expression for new residual and solution + beta, &! eta1/eta0 = term in expression for new direction vector + rho, &! global sum of (r,z) + rho_old, &! old value of rho + delta, &! global sum of (s,z) + sigma ! delta - beta^2 * sigma + + real(dp), dimension(2) :: & + gsum ! result of global sum for dot products + + ! vectors (each of these is split into u and v components) + real(dp), dimension(nz,nx-1,ny-1) :: & + Adiagu, Adiagv, &! diagonal terms of matrices Auu and Avv + ru, rv, &! residual vector (b-Ax) + du, dv, &! conjugate direction vector + zu, zv, &! solution of Mz = r + qu, qv, &! vector used to adjust residual, r -> r - alpha*q + Azu, Azv, &! result of matvec multiply A*z + worku, workv ! intermediate results + + real(dp), dimension(nz,nx-1,ny-1,2) :: & + work2u, work2v ! intermediate results + + real(dp) :: & + rr, &! dot product (r,r) + bb, &! dot product (b,b) + L2_resid, &! L2 norm of residual = sqrt(r,r) + L2_rhs ! L2 norm of rhs vector = sqrt(b,b) + ! solver is converged when L2_resid/L2_rhs < tolerance + + real(dp), dimension(-1:1,nz,nx-1,ny-1) :: & + Muu, Mvv ! simplified SIA matrices for preconditioning + + !--------------------------------------------------------------- + ! Solver parameters + !--------------------------------------------------------------- + + real(dp), parameter :: & +!! tolerance = 1.d-11 ! tolerance for linear solver (old value; more stringent than necessary) + tolerance = 1.d-08 ! tolerance for linear solver + + integer, parameter :: & + maxiters = 200 ! max number of linear iterations before quitting + + integer, parameter :: & + solv_ncheck = 5 ! check for convergence every solv_ncheck iterations + + integer :: itest, jtest, rtest + + if (present(itest_in)) then + itest = itest_in + else + itest = nx/2 + endif + + if (present(itest_in)) then + jtest = jtest_in + else + jtest = ny/2 + endif + + if (present(itest_in)) then + rtest = rtest_in + else + rtest = 0 + endif + + if (present(verbose)) then + verbose_pcg = verbose + else + verbose_pcg = .false. ! for debugging + endif + + if (verbose_pcg .and. main_task) then + print*, 'Using native PCG solver (Chronopoulos-Gear)' + print*, 'tolerance, maxiters, precond =', tolerance, maxiters, precond + endif + + !---- Set up matrices for preconditioning + + call t_startf("pcg_precond_init") + call setup_preconditioner_3d(nx, ny, & + nz, & + precond, indxA, & + Auu, Avv, & + Adiagu, Adiagv, & + Muu, Mvv) + call t_stopf("pcg_precond_init") + + !---- Initialize scalars and vectors + + niters = maxiters + ru(:,:,:) = 0.d0 + rv(:,:,:) = 0.d0 + du(:,:,:) = 0.d0 + dv(:,:,:) = 0.d0 + zu(:,:,:) = 0.d0 + zv(:,:,:) = 0.d0 + qu(:,:,:) = 0.d0 + qv(:,:,:) = 0.d0 + Azu(:,:,:) = 0.d0 + Azv(:,:,:) = 0.d0 + worku(:,:,:) = 0.d0 + workv(:,:,:) = 0.d0 + work2u(:,:,:,:) = 0.d0 + work2v(:,:,:,:) = 0.d0 + + !---- Compute the L2 norm of the RHS vectors + !---- (Goal is to obtain L2_resid/L2_rhs < tolerance) + + call t_startf("pcg_dotprod") + worku(:,:,:) = bu(:,:,:)*bu(:,:,:) ! terms of dot product (b, b) + workv(:,:,:) = bv(:,:,:)*bv(:,:,:) + call t_stopf("pcg_dotprod") + + ! find global sum of the squared L2 norm + + call t_startf("pcg_glbsum_init") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + bb, & + worku, workv) + call t_stopf("pcg_glbsum_init") + + ! take square root + + L2_rhs = sqrt(bb) ! L2 norm of RHS + + !--------------------------------------------------------------- + ! First pass of algorithm + !--------------------------------------------------------------- + + ! Note: The matrix A must be complete for all rows corresponding to locally + ! owned nodes, and x must have the correct values in + ! halo nodes bordering the locally owned nodes. + ! Then z = Ax will be correct for locally owned nodes. + + !---- Halo update for x (initial guess for velocity solution) + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_init") + + !---- Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_init") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_init") + + !---- Compute the initial residual r = b - A*x + !---- This is correct for locally owned nodes. + + call t_startf("pcg_vecupdate") + ru(:,:,:) = bu(:,:,:) - zu(:,:,:) + rv(:,:,:) = bv(:,:,:) - zv(:,:,:) + call t_stopf("pcg_vecupdate") + + !---- Halo update for residual + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(ru) + call staggered_parallel_halo(rv) + call t_stopf("pcg_halo_init") + + !---- Compute (PC)r = solution z of Mz = r + !---- Since r was just updated in halo, z is correct in halo + + ! From here on, call timers with 'iter' suffix because this can be considered the first iteration + call t_startf("pcg_precond_iter") + + if (precond == 0) then ! no preconditioning + + zu(:,:,:) = ru(:,:,:) ! PC(r) = r + zv(:,:,:) = rv(:,:,:) ! PC(r) = r + + elseif (precond == 1 ) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + if (Adiagu(k,i,j) /= 0.d0) then + zu(k,i,j) = ru(k,i,j) / Adiagu(k,i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(k,i,j) = 0.d0 + endif + if (Adiagv(k,i,j) /= 0.d0) then + zv(k,i,j) = rv(k,i,j) / Adiagv(k,i,j) + else + zv(k,i,j) = 0.d0 + endif + enddo ! k + enddo ! i + enddo ! j + + elseif (precond == 2) then ! local vertical shallow-ice solver for preconditioning + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Muu, ru, zu) ! solve Muu*zu = ru for zu + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Mvv, rv, zv) ! solve Mvv*zv = rv for zv + + endif ! precond + + call t_stopf("pcg_precond_iter") + + !---- Compute intermediate result for dot product (r,z) + + call t_startf("pcg_dotprod") + work2u(:,:,:,1) = ru(:,:,:) * zu(:,:,:) + work2v(:,:,:,1) = rv(:,:,:) * zv(:,:,:) + call t_stopf("pcg_dotprod") + + !---- Compute the conjugate direction vector d + !---- Since z is correct in halo, so is d + + du(:,:,:) = zu(:,:,:) + dv(:,:,:) = zv(:,:,:) + + !---- Compute q = A*d + !---- q is correct for locally owned nodes + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + du, dv, & + qu, qv) + call t_stopf("pcg_matmult_iter") + + !---- Compute intermediate result for dot product (d,q) = (d,Ad) + + call t_startf("pcg_dotprod") + work2u(:,:,:,2) = du(:,:,:) * qu(:,:,:) + work2v(:,:,:,2) = dv(:,:,:) * qv(:,:,:) + call t_stopf("pcg_dotprod") + + !---- Find global sums of (r,z) and (d,q) + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + gsum, & + work2u, work2v) + call t_stopf("pcg_glbsum_iter") + + !---- Halo update for q + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(qu) + call staggered_parallel_halo(qv) + call t_stopf("pcg_halo_iter") + + rho_old = gsum(1) ! (r,z) = (r, (PC)r) + sigma = gsum(2) ! (d,q) = (d, Ad) + + alpha = rho_old/sigma + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'rho_old, sigma, alpha:', rho_old, sigma, alpha + call write_log('Chron_Gear PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + !---- Update solution and residual + !---- These are correct in halo + + call t_startf("pcg_vecupdate") + xu(:,:,:) = xu(:,:,:) + alpha*du(:,:,:) + xv(:,:,:) = xv(:,:,:) + alpha*dv(:,:,:) + + ru(:,:,:) = ru(:,:,:) - alpha*qu(:,:,:) ! q = A*d + rv(:,:,:) = rv(:,:,:) - alpha*qv(:,:,:) + call t_stopf("pcg_vecupdate") + + !--------------------------------------------------------------- + ! Iterate to solution + !--------------------------------------------------------------- + + iter_loop: do n = 2, maxiters ! first iteration done above + + !---- Compute PC(r) = solution z of Mz = r + !---- z is correct in halo + + call t_startf("pcg_precond_iter") + + if (precond == 0) then ! no preconditioning + + zu(:,:,:) = ru(:,:,:) ! PC(r) = r + zv(:,:,:) = rv(:,:,:) ! PC(r) = r + + elseif (precond == 1 ) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + if (Adiagu(k,i,j) /= 0.d0) then + zu(k,i,j) = ru(k,i,j) / Adiagu(k,i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(k,i,j) = 0.d0 + endif + if (Adiagv(k,i,j) /= 0.d0) then + zv(k,i,j) = rv(k,i,j) / Adiagv(k,i,j) + else + zv(k,i,j) = 0.d0 + endif + enddo ! k + enddo ! i + enddo ! j + + elseif (precond == 2) then ! local vertical shallow-ice solver for preconditioning + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Muu, ru, zu) ! solve Muu*zu = ru for zu + + call easy_sia_solver(nx, ny, nz, & + active_vertex, & + Mvv, rv, zv) ! solve Mvv*zv = rv for zv + + endif ! precond + + call t_stopf("pcg_precond_iter") + + !---- Compute Az = A*z + !---- This is the one matvec multiply required per iteration + !---- Az is correct for local owned nodes and needs a halo update (below) + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + zu, zv, & + Azu, Azv) + call t_stopf("pcg_matmult_iter") + + !---- Compute intermediate results for the dot products (r,z) and (Az,z) + + call t_startf("pcg_dotprod") + work2u(:,:,:,1) = ru(:,:,:)*zu(:,:,:) ! terms of dot product (r,z) + work2v(:,:,:,1) = rv(:,:,:)*zv(:,:,:) + + work2u(:,:,:,2) = Azu(:,:,:)*zu(:,:,:) ! terms of dot product (A*z,z) + work2v(:,:,:,2) = Azv(:,:,:)*zv(:,:,:) + call t_stopf("pcg_dotprod") + + ! Take the global sums of (r,z) and (Az,z) + ! Two sums are combined here for efficiency; + ! this is the one MPI global reduction per iteration. + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + gsum, & + work2u, work2v) + call t_stopf("pcg_glbsum_iter") + + !---- Halo update for Az + !---- This is the one halo update required per iteration + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(Azu) + call staggered_parallel_halo(Azv) + call t_stopf("pcg_halo_iter") + + !---- Compute some scalars + + rho = gsum(1) ! (r,z) + delta = gsum(2) ! (Az,z) + + beta = rho / rho_old + sigma = delta - beta*rho/alpha + alpha = rho / sigma + rho_old = rho ! (r_(i+1), PC(r_(i+1))) --> (r_i, PC(r_i)) + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'rho, sigma, alpha:', rho, sigma, alpha + call write_log('Chron-Gear PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + !---- Update d and q + !---- These are correct in halo + + call t_startf("pcg_vecupdate") + + du(:,:,:) = zu(:,:,:) + beta*du(:,:,:) ! d_(i+1) = PC(r_(i+1)) + beta_(i+1)*d_i + dv(:,:,:) = zv(:,:,:) + beta*dv(:,:,:) ! + ! (r_(i+1), PC(r_(i+1))) + ! where beta_(i+1) = -------------------- + ! (r_i, PC(r_i)) + qu(:,:,:) = Azu(:,:,:) + beta*qu(:,:,:) + qv(:,:,:) = Azv(:,:,:) + beta*qv(:,:,:) + + !---- Update solution and residual + !---- These are correct in halo + + xu(:,:,:) = xu(:,:,:) + alpha*du(:,:,:) + xv(:,:,:) = xv(:,:,:) + alpha*dv(:,:,:) + + ru(:,:,:) = ru(:,:,:) - alpha*qu(:,:,:) + rv(:,:,:) = rv(:,:,:) - alpha*qv(:,:,:) + + call t_stopf("pcg_vecupdate") + + !--------------------------------------------------------------- + ! Convergence check every solv_ncheck iterations + !--------------------------------------------------------------- + + if (mod(n,solv_ncheck) == 0) then ! use r = b - Ax + + !---- Compute z = A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_resid") + call matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_resid") + + !---- Compute residual r = b - A*x + + call t_startf("pcg_vecupdate") + ru(:,:,:) = bu(:,:,:) - zu(:,:,:) + rv(:,:,:) = bv(:,:,:) - zv(:,:,:) + call t_stopf("pcg_vecupdate") + + !---- Compute dot product (r, r) + + call t_startf("pcg_dotprod") + worku(:,:,:) = ru(:,:,:)*ru(:,:,:) + workv(:,:,:) = rv(:,:,:)*rv(:,:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_resid") + call global_sum_staggered(nx, ny, & + nz, nhalo, & + rr, & + worku, workv) + call t_stopf("pcg_glbsum_resid") + + L2_resid = sqrt(rr) ! L2 norm of residual + err = L2_resid/L2_rhs ! normalized error + + if (verbose_pcg .and. main_task) then +! print*, ' ' +! print*, 'iter, L2_resid, error =', n, L2_resid, err + endif + + if (err < tolerance) then + niters = n + exit iter_loop + endif + + !---- Update residual in halo for next iteration + + call t_startf("pcg_halo_resid") + call staggered_parallel_halo(ru) + call staggered_parallel_halo(rv) + call t_stopf("pcg_halo_resid") + + endif ! solv_ncheck + + enddo iter_loop + + !WHL - Without good preconditioning, convergence can be slow, but the solution after maxiters might be good enough. + + if (niters == maxiters) then + if (main_task) then + print*, 'Glissade PCG solver not converged' + print*, 'niters, err, tolerance:', niters, err, tolerance + endif + endif + + end subroutine pcg_solver_chrongear_3d + +!**************************************************************************** + + subroutine pcg_solver_chrongear_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + xu, xv, & + precond, err, & + niters, & + itest_in, jtest_in, rtest_in, & + verbose) + + !--------------------------------------------------------------- + ! This subroutine uses a Chronopoulos-Gear preconditioned conjugate-gradient + ! algorithm to solve the equation $Ax=b$. + ! + ! It is similar to subroutine pcg_solver_chrongear_3d, but modified + ! to solve for x and y at a single horizontal level, as in the + ! shallow-shelf approximation. See the comments in that subroutine + ! (above) for more details on data structure and solver methods. + ! + ! Input and output arrays are located on a structured (i,j) grid + ! as defined in the glissade_velo_higher module. The global matrix + ! is sparse, but its nonzero element are stored in four dense matrices + ! called Auu, Avv, Auv, and Avu. Each matrix has 3x3 = 9 potential + ! nonzero elements per node (i,j). + ! + ! The current preconditioning options are + ! (0) no preconditioning + ! (1) diagonal preconditioning + ! + ! The SIA-based preconditioning optional is not available for a 2D solve. + ! + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y) coordinates to an index between 1 and 9 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 9 (node and its nearest neighbors in x and y direction) + ! other dimensions = (x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nx-1,ny-1), intent(inout) :: & + xu, xv ! u and v components of solution (i.e., uvel and vvel) + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning (best option for SSA-dominated flow) + + real(dp), intent(out) :: & + err ! error (L2 norm of residual) in final solution + + integer, intent(out) :: & + niters ! iterations needed to solution + + integer, intent(in), optional :: & + itest_in, jtest_in, rtest_in ! point for debugging diagnostics + + logical, intent(in), optional :: & + verbose ! if true, print diagnostic output + + !--------------------------------------------------------------- + ! Local variables and parameters + !--------------------------------------------------------------- + + integer :: i, j ! grid indices + integer :: m ! matrix element index + integer :: n ! iteration counter + + real(dp) :: & + alpha, &! rho/sigma = term in expression for new residual and solution + beta, &! eta1/eta0 = term in expression for new direction vector + rho, &! global sum of (r,z) + rho_old, &! old value of rho + delta, &! global sum of (s,z) + sigma ! delta - beta^2 * sigma + + real(dp), dimension(2) :: & + gsum ! result of global sum for dot products + + ! vectors (each of these is split into u and v components) + real(dp), dimension(nx-1,ny-1) :: & + Adiagu, Adiagv, &! diagonal terms of matrices Auu and Avv + ru, rv, &! residual vector (b-Ax) + du, dv, &! conjugate direction vector + zu, zv, &! solution of Mz = r + qu, qv, &! vector used to adjust residual, r -> r - alpha*q + Azu, Azv, &! result of matvec multiply A*z + worku, workv ! intermediate results + + real(dp), dimension(nx-1,ny-1,2) :: & + work2u, work2v ! intermediate results + + real(dp) :: & + rr, &! dot product (r,r) + bb, &! dot product (b,b) + L2_resid, &! L2 norm of residual = sqrt(r,r) + L2_rhs ! L2 norm of rhs vector = sqrt(b,b) + ! solver is converged when L2_resid/L2_rhs < tolerance + + !--------------------------------------------------------------- + ! Solver parameters + !--------------------------------------------------------------- + + real(dp), parameter :: & +!! tolerance = 1.d-11 ! tolerance for linear solver (old value; more stringent than necessary) + tolerance = 1.d-08 ! tolerance for linear solver + + integer, parameter :: & + maxiters = 200 ! max number of linear iterations before quitting + + integer, parameter :: & + solv_ncheck = 5 ! check for convergence every solv_ncheck iterations + + integer :: itest, jtest, rtest + + if (present(itest_in)) then + itest = itest_in + else + itest = nx/2 + endif + + if (present(itest_in)) then + jtest = jtest_in + else + jtest = ny/2 + endif + + if (present(itest_in)) then + rtest = rtest_in + else + rtest = 0 + endif + + if (present(verbose)) then + verbose_pcg = verbose + else + verbose_pcg = .false. ! for debugging + endif + + if (verbose_pcg .and. main_task) then + print*, 'Using native PCG solver (Chronopoulos-Gear)' + print*, 'tolerance, maxiters, precond =', tolerance, maxiters, precond + endif + + !---- Set up matrices for preconditioning + + call t_startf("pcg_precond_init") + call setup_preconditioner_2d(nx, ny, & + precond, indxA, & + Auu, Avv, & + Adiagu, Adiagv) + call t_stopf("pcg_precond_init") + + !---- Initialize scalars and vectors + + niters = maxiters + ru(:,:) = 0.d0 + rv(:,:) = 0.d0 + du(:,:) = 0.d0 + dv(:,:) = 0.d0 + zu(:,:) = 0.d0 + zv(:,:) = 0.d0 + qu(:,:) = 0.d0 + qv(:,:) = 0.d0 + Azu(:,:) = 0.d0 + Azv(:,:) = 0.d0 + worku(:,:) = 0.d0 + workv(:,:) = 0.d0 + work2u(:,:,:) = 0.d0 + work2v(:,:,:) = 0.d0 + + !---- Compute the L2 norm of the RHS vectors + !---- (Goal is to obtain L2_resid/L2_rhs < tolerance) + + call t_startf("pcg_dotprod") + worku(:,:) = bu(:,:)*bu(:,:) ! terms of dot product (b, b) + workv(:,:) = bv(:,:)*bv(:,:) + call t_stopf("pcg_dotprod") + + ! find global sum of the squared L2 norm + + call t_startf("pcg_glbsum_init") + call global_sum_staggered(nx, ny, & + nhalo, bb, & + worku, workv) + call t_stopf("pcg_glbsum_init") + + ! take square root + + L2_rhs = sqrt(bb) ! L2 norm of RHS + + !--------------------------------------------------------------- + ! First pass of algorithm + !--------------------------------------------------------------- + + ! Note: The matrix A must be complete for all rows corresponding to locally + ! owned nodes, and x must have the correct values in + ! halo nodes bordering the locally owned nodes. + ! Then z = Ax will be correct for locally owned nodes. + + !---- Halo update for x (initial guess for velocity solution) + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(xu) + call staggered_parallel_halo(xv) + call t_stopf("pcg_halo_init") + + !---- Compute A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_init") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_init") + + !---- Compute the initial residual r = b - A*x + !---- This is correct for locally owned nodes. + + call t_startf("pcg_vecupdate") + ru(:,:) = bu(:,:) - zu(:,:) + rv(:,:) = bv(:,:) - zv(:,:) + call t_stopf("pcg_vecupdate") + + !---- Halo update for residual + + call t_startf("pcg_halo_init") + call staggered_parallel_halo(ru) + call staggered_parallel_halo(rv) + call t_stopf("pcg_halo_init") + + !---- Compute (PC)r = solution z of Mz = r + !---- Since r was just updated in halo, z is correct in halo + + ! From here on, call timers with 'iter' suffix because this can be considered the first iteration + call t_startf("pcg_precond_iter") + + if (precond == 0) then ! no preconditioning + + zu(:,:) = ru(:,:) ! PC(r) = r + zv(:,:) = rv(:,:) ! PC(r) = r + + elseif (precond == 1 ) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + if (Adiagu(i,j) /= 0.d0) then + zu(i,j) = ru(i,j) / Adiagu(i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(i,j) = 0.d0 + endif + if (Adiagv(i,j) /= 0.d0) then + zv(i,j) = rv(i,j) / Adiagv(i,j) + else + zv(i,j) = 0.d0 + endif + enddo ! i + enddo ! j + + endif ! precond + + call t_stopf("pcg_precond_iter") + + !---- Compute intermediate result for dot product (r,z) + + call t_startf("pcg_dotprod") + work2u(:,:,1) = ru(:,:) * zu(:,:) + work2v(:,:,1) = rv(:,:) * zv(:,:) + call t_stopf("pcg_dotprod") + + !---- Compute the conjugate direction vector d + !---- Since z is correct in halo, so is d + + du(:,:) = zu(:,:) + dv(:,:) = zv(:,:) + + !---- Compute q = A*d + !---- q is correct for locally owned nodes + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + du, dv, & + qu, qv) + call t_stopf("pcg_matmult_iter") + + !---- Compute intermediate result for dot product (d,q) = (d,Ad) + + call t_startf("pcg_dotprod") + work2u(:,:,2) = du(:,:) * qu(:,:) + work2v(:,:,2) = dv(:,:) * qv(:,:) + call t_stopf("pcg_dotprod") + + !---- Find global sums of (r,z) and (d,q) + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nhalo, gsum, & + work2u, work2v) + call t_stopf("pcg_glbsum_iter") + + !---- Halo update for q + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(qu) + call staggered_parallel_halo(qv) + call t_stopf("pcg_halo_iter") + + rho_old = gsum(1) ! (r,z) = (r, (PC)r) + sigma = gsum(2) ! (d,q) = (d, Ad) + + alpha = rho_old/sigma + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'rho_old, sigma, alpha:', rho_old, sigma, alpha + call write_log('Chron_Gear PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + !---- Update solution and residual + !---- These are correct in halo + + call t_startf("pcg_vecupdate") + xu(:,:) = xu(:,:) + alpha*du(:,:) + xv(:,:) = xv(:,:) + alpha*dv(:,:) + + ru(:,:) = ru(:,:) - alpha*qu(:,:) ! q = A*d + rv(:,:) = rv(:,:) - alpha*qv(:,:) + call t_stopf("pcg_vecupdate") + + !--------------------------------------------------------------- + ! Iterate to solution + !--------------------------------------------------------------- + + iter_loop: do n = 2, maxiters ! first iteration done above + + !---- Compute PC(r) = solution z of Mz = r + !---- z is correct in halo + + call t_startf("pcg_precond_iter") + + if (precond == 0) then ! no preconditioning + + zu(:,:) = ru(:,:) ! PC(r) = r + zv(:,:) = rv(:,:) ! PC(r) = r + + elseif (precond == 1 ) then ! diagonal preconditioning + + do j = 1, ny-1 + do i = 1, nx-1 + if (Adiagu(i,j) /= 0.d0) then + zu(i,j) = ru(i,j) / Adiagu(i,j) ! PC(r), where PC is formed from diagonal elements of A + else + zu(i,j) = 0.d0 + endif + if (Adiagv(i,j) /= 0.d0) then + zv(i,j) = rv(i,j) / Adiagv(i,j) + else + zv(i,j) = 0.d0 + endif + enddo ! i + enddo ! j + + endif ! precond + + call t_stopf("pcg_precond_iter") + + !---- Compute Az = A*z + !---- This is the one matvec multiply required per iteration + !---- Az is correct for local owned nodes and needs a halo update (below) + + call t_startf("pcg_matmult_iter") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + zu, zv, & + Azu, Azv) + call t_stopf("pcg_matmult_iter") + + !---- Compute intermediate results for the dot products (r,z) and (Az,z) + + call t_startf("pcg_dotprod") + work2u(:,:,1) = ru(:,:)*zu(:,:) ! terms of dot product (r,z) + work2v(:,:,1) = rv(:,:)*zv(:,:) + + work2u(:,:,2) = Azu(:,:)*zu(:,:) ! terms of dot product (A*z,z) + work2v(:,:,2) = Azv(:,:)*zv(:,:) + call t_stopf("pcg_dotprod") + + ! Take the global sums of (r,z) and (Az,z) + ! Two sums are combined here for efficiency; + ! this is the one MPI global reduction per iteration. + + call t_startf("pcg_glbsum_iter") + call global_sum_staggered(nx, ny, & + nhalo, gsum, & + work2u, work2v) + call t_stopf("pcg_glbsum_iter") + + !---- Halo update for Az + !---- This is the one halo update required per iteration + + call t_startf("pcg_halo_iter") + call staggered_parallel_halo(Azu) + call staggered_parallel_halo(Azv) + call t_stopf("pcg_halo_iter") + + !---- Compute some scalars + + rho = gsum(1) ! (r,z) + delta = gsum(2) ! (Az,z) + + beta = rho / rho_old + sigma = delta - beta*rho/alpha + alpha = rho / sigma + rho_old = rho ! (r_(i+1), PC(r_(i+1))) --> (r_i, PC(r_i)) + + if (alpha /= alpha) then ! alpha is NaN +!! write(6,*) 'rho, sigma, alpha:', rho, sigma, alpha + call write_log('Chron_Gear PCG solver has failed, alpha = NaN', GM_FATAL) + endif + + !---- Update d and q + !---- These are correct in halo + + call t_startf("pcg_vecupdate") + + du(:,:) = zu(:,:) + beta*du(:,:) ! d_(i+1) = PC(r_(i+1)) + beta_(i+1)*d_i + dv(:,:) = zv(:,:) + beta*dv(:,:) ! + ! (r_(i+1), PC(r_(i+1))) + ! where beta_(i+1) = -------------------- + ! (r_i, PC(r_i)) + qu(:,:) = Azu(:,:) + beta*qu(:,:) + qv(:,:) = Azv(:,:) + beta*qv(:,:) + + !---- Update solution and residual + !---- These are correct in halo + + xu(:,:) = xu(:,:) + alpha*du(:,:) + xv(:,:) = xv(:,:) + alpha*dv(:,:) + + ru(:,:) = ru(:,:) - alpha*qu(:,:) + rv(:,:) = rv(:,:) - alpha*qv(:,:) + + call t_stopf("pcg_vecupdate") + + !--------------------------------------------------------------- + ! Convergence check every solv_ncheck iterations + !--------------------------------------------------------------- + + if (mod(n,solv_ncheck) == 0) then ! use r = b - Ax + + !---- Compute z = A*x (use z as a temp vector for A*x) + + call t_startf("pcg_matmult_resid") + call matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + zu, zv) + call t_stopf("pcg_matmult_resid") + + !---- Compute residual r = b - A*x + + call t_startf("pcg_vecupdate") + ru(:,:) = bu(:,:) - zu(:,:) + rv(:,:) = bv(:,:) - zv(:,:) + call t_stopf("pcg_vecupdate") + + !---- Compute dot product (r, r) + + call t_startf("pcg_dotprod") + worku(:,:) = ru(:,:)*ru(:,:) + workv(:,:) = rv(:,:)*rv(:,:) + call t_stopf("pcg_dotprod") + + call t_startf("pcg_glbsum_resid") + call global_sum_staggered(nx, ny, & + nhalo, rr, & + worku, workv) + call t_stopf("pcg_glbsum_resid") + + L2_resid = sqrt(rr) ! L2 norm of residual + err = L2_resid/L2_rhs ! normalized error + + if (verbose_pcg .and. main_task) then +! print*, ' ' +! print*, 'iter, L2_resid, error =', n, L2_resid, err + endif + + if (err < tolerance) then + niters = n + exit iter_loop + endif + + !---- Update residual in halo for next iteration + + call t_startf("pcg_halo_resid") + call staggered_parallel_halo(ru) + call staggered_parallel_halo(rv) + call t_stopf("pcg_halo_resid") + + endif ! solv_ncheck + + enddo iter_loop + + !WHL - Without good preconditioning, convergence can be slow, but the solution after maxiters might be good enough. + + if (niters == maxiters) then + if (main_task) then + print*, 'Glissade PCG solver not converged' + print*, 'niters, err, tolerance:', niters, err, tolerance + endif + endif + + end subroutine pcg_solver_chrongear_2d + +!**************************************************************************** + + subroutine setup_preconditioner_3d(nx, ny, & + nz, & + precond, indxA, & + Auu, Avv, & + Adiagu, Adiagv, & + Muu, Mvv) + + ! Set up preconditioning matrices using one of several options + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning + ! = 2 for preconditioning with SIA solver (works well for SIA-dominated flow) + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Avv ! two out of the four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nz,nx-1,ny-1), intent(out) :: & + Adiagu, Adiagv ! matrices for diagonal preconditioning + + real(dp), dimension(-1:1,nz,nx-1,ny-1), intent(out) :: & + Muu, Mvv ! preconditioning matrices based on shallow-ice approximation + + !--------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------- + + integer :: i, j, k, m + + ! Initialize + + Adiagu(:,:,:) = 0.d0 + Adiagv(:,:,:) = 0.d0 + Muu (:,:,:,:) = 0.d0 + Mvv (:,:,:,:) = 0.d0 + + if (precond == HO_PRECOND_DIAG) then ! form diagonal matrix for preconditioning + + if (verbose_pcg .and. main_task) then + print*, 'Using diagonal matrix for preconditioning' + endif ! verbose_pcg + + m = indxA(0,0,0) + Adiagu(:,:,:) = Auu(m,:,:,:) + Adiagv(:,:,:) = Avv(m,:,:,:) + + elseif (precond == HO_PRECOND_SIA) then ! form SIA matrices Muu and Mvv with vertical coupling only + + if (verbose_pcg .and. main_task) then + print*, 'Using shallow-ice preconditioner' + endif ! verbose_pcg + + do j = 1, ny-1 + do i = 1, nx-1 + do k = 1, nz + ! Remove horizontal coupling by using only the iA=0, jA=0 term in each layer. + + !WHL - Summing over the terms in each layer does not work for simple shelf problems + ! because the matrix can be singular. +! Muu(-1,k,i,j) = sum(Auu(1:9,k,i,j)) +! Mvv(-1,k,i,j) = sum(Avv(1:9,k,i,j)) + +! Muu( 0,k,i,j) = sum(Auu(10:18,k,i,j)) +! Mvv( 0,k,i,j) = sum(Avv(10:18,k,i,j)) + +! Muu( 1,k,i,j) = sum(Auu(19:27,k,i,j)) +! Mvv( 1,k,i,j) = sum(Avv(19:27,k,i,j)) + + ! WHL: Taking the (0,0) term in each layer does not give singular matrices for + ! the confined-shelf and circular-shelf problems. + ! The solution converges for these problems even though the preconditioner + ! is not expected to be very good. + + m = indxA(0,0,-1) + Muu(-1,k,i,j) = Auu(m,k,i,j) + Mvv(-1,k,i,j) = Avv(m,k,i,j) + + m = indxA(0,0,0) + Muu( 0,k,i,j) = Auu(m,k,i,j) + Mvv( 0,k,i,j) = Avv(m,k,i,j) + + m = indxA(0,0,1) + Muu( 1,k,i,j) = Auu(m,k,i,j) + Mvv( 1,k,i,j) = Avv(m,k,i,j) + enddo + enddo + enddo + + else ! no preconditioning + + if (verbose_pcg .and. main_task) then + print*, 'Using no preconditioner' + endif + + endif ! precond + + end subroutine setup_preconditioner_3d + +!**************************************************************************** + + subroutine setup_preconditioner_2d(nx, ny, & + precond, indxA_2d, & + Auu, Avv, & + Adiagu, Adiagv) + + ! Set up preconditioning matrices for 2D SSA-type solve + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! horizontal grid dimensions (for scalars) + ! velocity grid has dimensions (nx-1,ny-1) + + integer, intent(in) :: & + precond ! = 0 for no preconditioning + ! = 1 for diagonal preconditioning + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA_2d ! maps relative (x,y) coordinates to an index between 1 and 9 + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Avv ! two out of the four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + Adiagu, Adiagv ! matrices for diagonal preconditioning + + integer :: m + + ! Initialize + + Adiagu(:,:) = 0.d0 + Adiagv(:,:) = 0.d0 + + if (precond == HO_PRECOND_DIAG) then ! form diagonal matrix for preconditioning + + if (verbose_pcg .and. main_task) then + print*, 'Using diagonal matrix for preconditioning' + endif ! verbose_pcg + + m = indxA_2d(0,0) + Adiagu(:,:) = Auu(m,:,:) + Adiagv(:,:) = Avv(m,:,:) + + else ! no preconditioning + + if (verbose_pcg .and. main_task) then + print*, 'Using no preconditioner' + endif + + endif ! precond + + end subroutine setup_preconditioner_2d + +!**************************************************************************** + + subroutine global_sum_staggered_3d_real8(nx, ny, & + nz, nhalo, & + global_sum, & + work1, work2) + + ! Sum one or two local arrays on the staggered grid, then take the global sum. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nz, & ! number of vertical layers at which velocity is computed + nhalo ! number of halo layers (for scalars) + + real(dp), intent(out) :: global_sum ! global sum + + real(dp), intent(in), dimension(nz,nx-1,ny-1) :: work1 ! local array + real(dp), intent(in), dimension(nz,nx-1,ny-1), optional :: work2 ! local array + + integer :: i, j, k + real(dp) :: local_sum + + local_sum = 0.d0 + + ! sum over locally owned velocity points + + if (present(work2)) then + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + do k = 1, nz + local_sum = local_sum + work1(k,i,j) + work2(k,i,j) + enddo + enddo + enddo + else + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + do k = 1, nz + local_sum = local_sum + work1(k,i,j) + enddo + enddo + enddo + endif + + ! take the global sum + + global_sum = parallel_reduce_sum(local_sum) + + end subroutine global_sum_staggered_3d_real8 + +!**************************************************************************** + + subroutine global_sum_staggered_3d_real8_nvar(nx, ny, & + nz, nhalo, & + global_sum, & + work1, work2) + + ! Sum one or two local arrays on the staggered grid, then take the global sum. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nz, & ! number of vertical layers at which velocity is computed + nhalo ! number of halo layers (for scalars) + + real(dp), intent(out), dimension(:) :: global_sum ! global sum + + real(dp), intent(in), dimension(nz,nx-1,ny-1,size(global_sum)) :: work1 ! local array + real(dp), intent(in), dimension(nz,nx-1,ny-1,size(global_sum)), optional :: work2 ! local array + + integer :: i, j, k, n, nvar + real(dp), dimension(size(global_sum)) :: local_sum + + nvar = size(global_sum) + + local_sum(:) = 0.d0 + + do n = 1, nvar + + ! sum over locally owned velocity points + + if (present(work2)) then + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + do k = 1, nz + local_sum(n) = local_sum(n) + work1(k,i,j,n) + work2(k,i,j,n) + enddo + enddo + enddo + else + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + do k = 1, nz + local_sum(n) = local_sum(n) + work1(k,i,j,n) + enddo + enddo + enddo + endif + + enddo ! nvar + + ! take the global sum + + global_sum(:) = parallel_reduce_sum(local_sum(:)) + + end subroutine global_sum_staggered_3d_real8_nvar + +!**************************************************************************** + + subroutine global_sum_staggered_2d_real8(nx, ny, & + nhalo, global_sum, & + work1, work2) + + ! Sum one or two local arrays on the staggered grid, then take the global sum. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nhalo ! number of halo layers (for scalars) + + real(dp), intent(out) :: global_sum ! global sum + + real(dp), intent(in), dimension(nx-1,ny-1) :: work1 ! local array + real(dp), intent(in), dimension(nx-1,ny-1), optional :: work2 ! local array + + integer :: i, j + real(dp) :: local_sum + + local_sum = 0.d0 + + ! sum over locally owned velocity points + + if (present(work2)) then + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + local_sum = local_sum + work1(i,j) + work2(i,j) + enddo + enddo + else + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + local_sum = local_sum + work1(i,j) + enddo + enddo + endif + + ! take the global sum + + global_sum = parallel_reduce_sum(local_sum) + + end subroutine global_sum_staggered_2d_real8 + +!**************************************************************************** + + subroutine global_sum_staggered_2d_real8_nvar(nx, ny, & + nhalo, global_sum, & + work1, work2) + + ! Sum one or two local arrays on the staggered grid, then take the global sum. + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nhalo ! number of halo layers (for scalars) + + real(dp), intent(out), dimension(:) :: global_sum ! global sum + + real(dp), intent(in), dimension(nx-1,ny-1,size(global_sum)) :: work1 ! local array + real(dp), intent(in), dimension(nx-1,ny-1,size(global_sum)), optional :: work2 ! local array + + integer :: i, j, n, nvar + real(dp), dimension(size(global_sum)) :: local_sum + + nvar = size(global_sum) + + local_sum(:) = 0.d0 + + do n = 1, nvar + + ! sum over locally owned velocity points + + if (present(work2)) then + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + local_sum(n) = local_sum(n) + work1(i,j,n) + work2(i,j,n) + enddo + enddo + else + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + local_sum(n) = local_sum(n) + work1(i,j,n) + enddo + enddo + endif + + enddo ! nvar + + ! take the global sum + + global_sum(:) = parallel_reduce_sum(local_sum(:)) + + end subroutine global_sum_staggered_2d_real8_nvar + +!**************************************************************************** + + subroutine matvec_multiply_structured_3d(nx, ny, & + nz, nhalo, & + indxA, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + yu, yv) + + !--------------------------------------------------------------- + ! Compute the matrix-vector product $y = Ax$. + ! + ! The A matrices should have complete matrix elements for all + ! rows corresponding to locally owned vertices. + ! The terms of x should be correct for all locally owned vertices + ! and also for all halo vertices adjacent to locally owned vertices. + ! The resulting y will then be correct for locally owned vertices. + ! + ! TODO: Are the matvec_multiply routines as efficient as possible? + ! E.g., could use the active_vertex array to set up indirect addressing and avoid an 'if' + ! Could replace the three short iA/jA/kA loops with long multadds + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nz, & ! number of vertical layers at which velocity is computed + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + xu, xv ! current guess for solution + + + real(dp), dimension(nz,nx-1,ny-1), intent(out) :: & + yu, yv ! y = Ax + + !--------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------- + + integer :: i, j, k, m + integer :: iA, jA, kA + + ! Initialize the result vector. + + yu(:,:,:) = 0.d0 + yv(:,:,:) = 0.d0 + + ! Compute y = Ax + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + if (active_vertex(i,j)) then + + do k = 1, nz + + do kA = -1,1 + do jA = -1,1 + do iA = -1,1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA(iA,jA,kA) + + yu(k,i,j) = yu(k,i,j) & + + Auu(m,k,i,j)*xu(k+kA,i+iA,j+jA) & + + Auv(m,k,i,j)*xv(k+kA,i+iA,j+jA) + + yv(k,i,j) = yv(k,i,j) & + + Avu(m,k,i,j)*xu(k+kA,i+iA,j+jA) & + + Avv(m,k,i,j)*xv(k+kA,i+iA,j+jA) + + endif ! k+kA, i+iA, j+jA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + enddo ! k + + endif ! active_vertex + + enddo ! i + enddo ! j + + end subroutine matvec_multiply_structured_3d + +!**************************************************************************** + + subroutine matvec_multiply_structured_2d(nx, ny, & + nhalo, & + indxA_2d, active_vertex, & + Auu, Auv, & + Avu, Avv, & + xu, xv, & + yu, yv) + + !--------------------------------------------------------------- + ! Compute the matrix-vector product $y = Ax$. + ! + ! This subroutine is similar to subroutine matrix_vector_structured, + ! but modified to solve for x and y at a single horizontal level, + ! as in the shallow-shelf approximation. + ! + ! The A matrices should have complete matrix elements for all + ! rows corresponding to locally owned vertices. + ! The terms of x should be correct for all locally owned vertices + ! and also for all halo vertices adjacent to locally owned vertices. + ! The resulting y will then be correct for locally owned vertices. + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nhalo ! number of halo layers (for scalars) + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA_2d ! maps relative (x,y) coordinates to an index between 1 and 9 + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Auv, Avu, Avv ! four components of assembled matrix + ! 1st dimension = 27 (node and its nearest neighbors in x, y and z direction) + ! other dimensions = (z,x,y) indices + ! + ! Auu | Auv + ! _____|____ + ! Avu | Avv + ! | + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + xu, xv ! current guess for solution + + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + yu, yv ! y = Ax + + !--------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------- + + integer :: i, j, m + integer :: iA, jA + + ! Initialize the result vector. + + yu(:,:) = 0.d0 + yv(:,:) = 0.d0 + + ! Compute y = Ax + + ! Loop over locally owned vertices + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + + if (active_vertex(i,j)) then + + do jA = -1,1 + do iA = -1,1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA_2d(iA,jA) + + yu(i,j) = yu(i,j) & + + Auu(m,i,j)*xu(i+iA,j+jA) & + + Auv(m,i,j)*xv(i+iA,j+jA) + + yv(i,j) = yv(i,j) & + + Avu(m,i,j)*xu(i+iA,j+jA) & + + Avv(m,i,j)*xv(i+iA,j+jA) + + endif ! i+iA, j+jA in bounds + + enddo ! iA + enddo ! jA + + endif ! active_vertex + + enddo ! i + enddo ! j + + end subroutine matvec_multiply_structured_2d + +!**************************************************************************** + + subroutine easy_sia_solver(nx, ny, nz, & + active_vertex, & + A, b, x) + + !--------------------------------------------------------------- + ! Solve the problem Ax = b where A is a local shallow-ice matrix, + ! with coupling in the vertical but not the horizontal. + ! We simply solve a tridiagonal matrix for each column. + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions (for scalars) + nz ! number of vertical levels + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + real(dp), dimension(-1:1,nz,nx-1,ny-1), intent(in) :: & + A ! matrix with vertical coupling only + ! 1st dimension = node and its upper and lower neighbors + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + b ! right-hand side + + real(dp), dimension(nz,nx-1,ny-1), intent(inout) :: & + x ! solution + + !--------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------- + + real(dp), dimension(nz) :: & + sbdiag, & ! subdiagonal matrix entries + diag, & ! diagonal matrix entries + spdiag, & ! superdiagonal matrix entries + rhs, & ! right-hand side + soln ! tridiagonal solution + + integer :: i, j, k + + do j = 1, ny-1 + do i = 1, nx-1 + + if (active_vertex(i,j)) then + + ! initialize rhs and solution + + rhs(:) = b(:,i,j) + soln(:) = x(:,i,j) + + ! top layer + + k = 1 + sbdiag(k) = 0.d0 + diag(k) = A(0,k,i,j) + spdiag(k) = A(1,k,i,j) + + ! intermediate layers + + do k = 2, nz-1 + sbdiag(k) = A(-1,k,i,j) + diag(k) = A( 0,k,i,j) + spdiag(k) = A( 1,k,i,j) + enddo + + ! bottom layer + + k = nz + sbdiag(k) = A(-1,k,i,j) + diag(k) = A( 0,k,i,j) + spdiag(k) = 0.d0 + + ! solve + + call tridiag_solver(nz, sbdiag, & + diag, spdiag, & + rhs, soln) + + x(:,i,j) = soln(:) + + endif ! active_vertex + + enddo ! i + enddo ! j + + end subroutine easy_sia_solver + +!**************************************************************************** + + subroutine tridiag_solver(order, sbdiag, & + diag, spdiag, & + rhs, soln) + + !--------------------------------------------------------------- + ! Solve a 1D tridiagonal matrix problem. + !--------------------------------------------------------------- + + !--------------------------------------------------------------- + ! input-output arguments + !--------------------------------------------------------------- + + integer, intent(in) :: & + order ! matrix dimension + + real(dp), dimension(order), intent(in) :: & + sbdiag, & ! sub-diagonal matrix elements + diag, & ! diagonal matrix elements + spdiag, & ! super-diagonal matrix elements + rhs ! right-hand side + + real(dp), dimension(order), intent(inout) :: & + soln ! solution vector + + !--------------------------------------------------------------- + ! local variables + !--------------------------------------------------------------- + + integer :: & + k ! row counter + + real(dp) :: & + beta ! temporary matrix variable + + real(dp), dimension(order) :: & + gamma ! temporary matrix variable + + ! Solve + + beta = diag(1) + soln(1) = rhs(1) / beta + + do k = 2, order + gamma(k) = spdiag(k-1) / beta + beta = diag(k) - sbdiag(k)*gamma(k) + soln(k) = (rhs(k) - sbdiag(k)*soln(k-1)) / beta + enddo + + do k = order-1, 1, -1 + soln(k) = soln(k) - gamma(k+1)*soln(k+1) + enddo + + end subroutine tridiag_solver + +!**************************************************************************** + +end module glissade_velo_higher_pcg + +!**************************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo_higher_slap.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_slap.F90 new file mode 100644 index 0000000000..c519e1100d --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_slap.F90 @@ -0,0 +1,753 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo_higher_slap.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains subroutines called from glissade_velo_higher.F90 +! and used to process data before and after linking to SLAP solver routines. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + module glissade_velo_higher_slap + + use glimmer_global, only: dp + use glimmer_sparse_type + use glimmer_sparse, only: sparse_easy_solve + + implicit none + + private + public :: slap_preprocess_3d, slap_preprocess_2d, & + slap_postprocess_3d, slap_postprocess_2d, & + slap_compute_residual_vector, slap_solve_test_matrix + + contains + +!**************************************************************************** + + subroutine slap_preprocess_3d(nx, ny, nz, & + nNodesSolve, NodeID, & + iNodeIndex, jNodeIndex, & + kNodeIndex, indxA, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + matrix_order, & + matrix, rhs, & + answer) + + !---------------------------------------------------------------- + ! Using the intermediate matrices (Auu, Auv, Avu, Avv), load vectors (bu, bv), + ! and velocity components (uvel, vvel), form the matrix and the rhs and answer + ! vectors in the desired sparse matrix format. + ! + ! The matrix is formed in ascending row order, so it can easily be transformed + ! to compressed sparse row (CSR) format without further sorting. + ! + ! Note: This works only for single-processor runs with the SLAP solver. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nz, & ! number of vertical levels at which velocity is computed + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension(nz,nx-1,ny-1), intent(in) :: & + NodeID ! local ID for each node + + integer, dimension(:), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of active nodes + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + ! index order is (i,j,k) + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = node and its nearest neighbors in x, y and z direction + ! other dimensions = (k,i,j) indices + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity + + integer, intent(in) :: & + matrix_order ! order of matrix = number of rows + + type(sparse_matrix_type), intent(inout) :: & + matrix ! sparse matrix, defined in glimmer_sparse_type + ! includes nonzeroes, order, col, row, val + + real(dp), dimension(:), intent(out) :: & + rhs, & ! right-hand-side (b) in Ax = b + answer ! answer (x) in Ax = b + + !--------------------------------------------------------- + ! Local variables + !--------------------------------------------------------- + + integer :: i, j, k, iA, jA, kA, m, mm, n, ct + + integer :: rowA, colA ! row and column of A submatrices (order = nNodesSolve) + integer :: row, col ! row and column of sparse matrix (order = 2*nNodesSolve) + + real(dp) :: val ! value of matrix coefficient + + ! Set the nonzero coefficients of the sparse matrix + + ct = 0 + + do rowA = 1, nNodesSolve + + i = iNodeIndex(rowA) + j = jNodeIndex(rowA) + k = kNodeIndex(rowA) + + ! Load the nonzero values associated with Auu and Auv + ! These are assigned a value of matrix%row = 2*rowA - 1 + + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = NodeID(k+kA, i+iA, j+jA) ! local ID for neighboring node + m = indxA(iA,jA,kA) + + ! Auu + val = Auu(m,k,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA - 1 + matrix%col(ct) = 2*colA - 1 + matrix%val(ct) = val + endif + + ! Auv + val = Auv(m,k,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA - 1 + matrix%col(ct) = 2*colA + matrix%val(ct) = val + endif + + endif ! i+iA, j+jA, and k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + ! Load the nonzero values associated with Avu and Avv + ! These are assigned a value of matrix%row = 2*rowA + + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = NodeID(k+kA, i+iA, j+jA) ! ID for neighboring node + m = indxA( iA, jA, kA) + + ! Avu + val = Avu(m,k,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA + matrix%col(ct) = 2*colA - 1 + matrix%val(ct) = val + endif + + ! Avv + val = Avv(m,k,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA + matrix%col(ct) = 2*colA + matrix%val(ct) = val + endif + + endif ! i+iA, j+jA, and k+kA in bounds + + enddo ! kA + enddo ! iA + enddo ! jA + + enddo ! rowA + + ! Set basic matrix parameters. + + matrix%order = matrix_order + matrix%nonzeros = ct + matrix%symmetric = .false. + + ! Initialize the answer vector + ! For efficiency, put the u and v terms for a given node adjacent in storage. + + do n = 1, nNodesSolve + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + + answer(2*n-1) = uvel(k,i,j) + answer(2*n) = vvel(k,i,j) + + enddo + + ! Set the rhs vector + ! For efficiency, put the u and v terms for a given node adjacent in storage. + + do n = 1, nNodesSolve + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + + rhs(2*n-1) = bu(k,i,j) + rhs(2*n) = bv(k,i,j) + + enddo + + end subroutine slap_preprocess_3d + +!**************************************************************************** + + subroutine slap_preprocess_2d(nx, ny, & + nVerticesSolve, vertexID, & + iVertexIndex, jVertexIndex, & + indxA, & + Auu, Auv, & + Avu, Avv, & + bu, bv, & + uvel, vvel, & + matrix_order, & + matrix, rhs, & + answer) + + !---------------------------------------------------------------- + ! This subroutine is analogous to slap_preprocess above, but for a 2D SSA solve + ! + ! Using the intermediate matrices (Auu, Auv, Avu, Avv), load vectors (bu, bv), + ! and velocity components (uvel, vvel), form the matrix and the rhs and answer + ! vectors in the desired sparse matrix format. + ! + ! The matrix is formed in ascending row order, so it can easily be transformed + ! to compressed sparse row (CSR) format without further sorting. + ! + ! Note: This works only for single-processor runs with the SLAP solver. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension(nx-1,ny-1), intent(in) :: & + vertexID ! local ID for each vertex + + integer, dimension(:), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of active vertices + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 9 + ! index order is (i,j) + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = vertex and its nearest neighbors in x and y direction + ! other dimensions = (i,j) indices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity for 2D solve + + integer, intent(in) :: & + matrix_order ! order of matrix = number of rows + + type(sparse_matrix_type), intent(inout) :: & + matrix ! sparse matrix, defined in glimmer_sparse_types + ! includes nonzeros, order, col, row, val + + real(dp), dimension(:), intent(out) :: & + rhs, & ! right-hand-side (b) in Ax = b + answer ! answer (x) in Ax = b + + !--------------------------------------------------------- + ! Local variables + !--------------------------------------------------------- + + integer :: i, j, iA, jA, m, mm, n, ct + + integer :: rowA, colA ! row and column of A submatrices (order = nVerticesSolve) + + real(dp) :: val ! value of matrix coefficient + + ! Set the nonzero coefficients of the sparse matrix + + ct = 0 + + do rowA = 1, nVerticesSolve + + i = iVertexIndex(rowA) + j = jVertexIndex(rowA) + + ! Load the nonzero values associated with Auu and Auv + ! These are assigned a value of matrix%row = 2*rowA - 1 + + do jA = -1, 1 + do iA = -1, 1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = vertexID(i+iA, j+jA) ! local ID for neighboring vertex + m = indxA(iA,jA) + + ! Auu + val = Auu(m,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA - 1 + matrix%col(ct) = 2*colA - 1 + matrix%val(ct) = val + endif + + ! Auv + val = Auv(m,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA - 1 + matrix%col(ct) = 2*colA + matrix%val(ct) = val + endif + + endif ! i+iA and j+jA in bounds + + enddo ! iA + enddo ! jA + + ! Load the nonzero values associated with Avu and Avv + ! These are assigned a value of matrix%row = 2*rowA + + do jA = -1, 1 + do iA = -1, 1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + colA = vertexID(i+iA, j+jA) ! ID for neighboring vertex + m = indxA(iA, jA) + + ! Avu + val = Avu(m,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA + matrix%col(ct) = 2*colA - 1 + matrix%val(ct) = val + endif + + ! Avv + val = Avv(m,i,j) + if (val /= 0.d0) then + ct = ct + 1 + matrix%row(ct) = 2*rowA + matrix%col(ct) = 2*colA + matrix%val(ct) = val + endif + + endif ! i+iA and j+jA in bounds + + enddo ! iA + enddo ! jA + + enddo ! rowA + + ! Set basic matrix parameters. + + matrix%order = matrix_order + matrix%nonzeros = ct + matrix%symmetric = .false. + + ! Set the answer vector + ! For efficiency, put the u and v terms for a given node adjacent in storage. + + do n = 1, nVerticesSolve + i = iVertexIndex(n) + j = jVertexIndex(n) + + answer(2*n-1) = uvel(i,j) + answer(2*n) = vvel(i,j) + + enddo + + ! Set the rhs vector + ! For efficiency, put the u and v terms for a given node adjacent in storage. + + do n = 1, nVerticesSolve + i = iVertexIndex(n) + j = jVertexIndex(n) + + rhs(2*n-1) = bu(i,j) + rhs(2*n) = bv(i,j) + + enddo + + end subroutine slap_preprocess_2d + +!**************************************************************************** + + subroutine slap_postprocess_3d(nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + answer, resid_vec, & + uvel, vvel, & + resid_u, resid_v) + + ! Extract the velocities from the SLAP solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: nNodesSolve ! number of nodes where we solve for velocity + + real(dp), dimension(:), intent(in) :: & + answer, &! velocity solution vector + resid_vec ! residual vector + + integer, dimension(:), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of active nodes + + real(dp), dimension(:,:,:), intent(inout) :: & + uvel, vvel, &! u and v components of velocity + resid_u, resid_v ! u and v components of residual + + integer :: i, j, k, n + + do n = 1, nNodesSolve + + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + + uvel(k,i,j) = answer(2*n-1) + vvel(k,i,j) = answer(2*n) + + resid_u(k,i,j) = resid_vec(2*n-1) + resid_v(k,i,j) = resid_vec(2*n) + + enddo + + end subroutine slap_postprocess_3d + +!**************************************************************************** + + subroutine slap_postprocess_2d(nVerticesSolve, & + iVertexIndex, jVertexIndex, & + answer, resid_vec, & + uvel, vvel, & + resid_u, resid_v) + + ! Extract the velocities from the SLAP solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: nVerticesSolve ! number of vertices where we solve for velocity + + real(dp), dimension(:), intent(in) :: & + answer, &! velocity solution vector + resid_vec ! residual vector + + integer, dimension(:), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of active vertices + + real(dp), dimension(:,:), intent(inout) :: & + uvel, vvel, &! u and v components of velocity + resid_u, resid_v ! u and v components of residual + + integer :: i, j, n + + do n = 1, nVerticesSolve + + i = iVertexIndex(n) + j = jVertexIndex(n) + + uvel(i,j) = answer(2*n-1) + vvel(i,j) = answer(2*n) + + resid_u(i,j) = resid_vec(2*n-1) + resid_v(i,j) = resid_vec(2*n) + + enddo + + end subroutine slap_postprocess_2d + +!**************************************************************************** + + subroutine slap_compute_residual_vector(matrix, answer, & + rhs, resid_vec, & + L2_norm, L2_norm_relative) + + ! Compute the residual vector Ax - b and its L2 norm. + ! This subroutine assumes that the matrix is stored in triad (row/col/val) format. + + type(sparse_matrix_type), intent(in) :: & + matrix ! sparse matrix, defined in glimmer_sparse_types + ! includes nonzeros, order, col, row, val + + real(dp), dimension(:), intent(in) :: & + rhs, & ! right-hand-side (b) in Ax = b + answer ! answer (x) in Ax = b + + real(dp), dimension(:), intent(out) :: & + resid_vec ! residual vector + + real(dp), intent(out) :: & + L2_norm ! L2 norm of residual vector, |Ax - b| + + real(dp), intent(out), optional :: & + L2_norm_relative ! L2 norm of residual vector relative to rhs, |Ax - b| / |b| + + integer :: n, r, c + + real(dp) :: L2_norm_rhs ! L2 norm of rhs vector, |b| + + resid_vec(:) = 0.d0 + + do n = 1, matrix%nonzeros + r = matrix%row(n) + c = matrix%col(n) + resid_vec(r) = resid_vec(r) + matrix%val(n)*answer(c) + enddo + + L2_norm = 0.d0 + do r = 1, matrix%order + resid_vec(r) = resid_vec(r) - rhs(r) + L2_norm = L2_norm + resid_vec(r)*resid_vec(r) + enddo + + L2_norm = sqrt(L2_norm) + + if (present(L2_norm_relative)) then + + L2_norm_rhs = 0.d0 + + do r = 1, matrix%order + L2_norm_rhs = L2_norm_rhs + rhs(r)*rhs(r) + enddo + + L2_norm_rhs = sqrt(L2_norm_rhs) + + if (L2_norm_rhs > 0.d0) then + L2_norm_relative = L2_norm / L2_norm_rhs + else + L2_norm_relative = 0.d0 + endif + + endif ! present(L2_norm_relative) + + end subroutine slap_compute_residual_vector + +!**************************************************************************** + + subroutine slap_solve_test_matrix (matrix_order, whichsparse) + + ! solve a small test matrix + + integer, intent(in) :: & + matrix_order, & ! matrix order + whichsparse ! solution method (0=BiCG, 1=GMRES, 2==PCG_INCH) + + logical :: verbose_test = .true. + + type(sparse_matrix_type) :: & + matrix ! sparse matrix, defined in glimmer_sparse_types + + real(dp), dimension(:), allocatable :: & + rhs, & ! right-hand-side (b) in Ax = b + answer ! answer (x) in Ax = b + + real(dp), dimension(:,:), allocatable :: Atest + + real(dp) :: err + + integer :: niters, nNonzero_max + + integer :: i, j, n + + print*, 'Solving test matrix, order =', matrix_order + + nNonzero_max = matrix_order*matrix_order ! not sure how big this must be + + allocate(Atest(matrix_order,matrix_order)) + Atest(:,:) = 0.d0 + + allocate(matrix%row(nNonzero_max), matrix%col(nNonzero_max), matrix%val(nNonzero_max)) + allocate(rhs(matrix_order), answer(matrix_order)) + + rhs(:) = 0.d0 + answer(:) = 0.d0 + matrix%row(:) = 0 + matrix%col(:) = 0 + matrix%val(:) = 0.d0 + + matrix%order = matrix_order + matrix%symmetric = .false. + + if (matrix%order == 2) then ! symmetric 2x2 + Atest(1,1:2) = (/3.d0, 2.d0 /) + Atest(2,1:2) = (/2.d0, 6.d0 /) + rhs(1:2) = (/2.d0, -8.d0 /) ! answer = (2 -2) + + elseif (matrix%order == 3) then + + ! symmetric + Atest(1,1:3) = (/ 7.d0, -2.d0, 0.d0 /) + Atest(2,1:3) = (/-2.d0, 6.d0, -2.d0 /) + Atest(3,1:3) = (/ 0.d0, -2.d0, 5.d0 /) + rhs(1:3) = (/ 3.d0, 8.d0, 1.d0 /) ! answer = (1 2 1) + + ! non-symmetric +! Atest(1,1:3) = (/3.d0, 1.d0, 1.d0 /) +! Atest(2,1:3) = (/2.d0, 2.d0, 5.d0 /) +! Atest(3,1:3) = (/1.d0, -3.d0, -4.d0 /) +! rhs(1:3) = (/ 6.d0, 11.d0, -9.d0 /) ! answer = (1 2 1) + + else if (matrix%order == 4) then + + ! symmetric + + Atest(1,1:4) = (/ 2.d0, -1.d0, 0.d0, 0.d0 /) + Atest(2,1:4) = (/-1.d0, 2.d0, -1.d0, 0.d0 /) + Atest(3,1:4) = (/ 0.d0, -1.d0, 2.d0, -1.d0 /) + Atest(4,1:4) = (/ 0.d0, 0.d0, -1.d0, 2.d0 /) + rhs(1:4) = (/ 0.d0, 1.d0, -1.d0, 4.d0 /) ! answer = (1 2 2 3) + + ! non-symmetric +! Atest(1,1:4) = (/3.d0, 0.d0, 2.d0, -1.d0 /) +! Atest(2,1:4) = (/1.d0, 2.d0, 0.d0, 2.d0 /) +! Atest(3,1:4) = (/4.d0, 0.d0, 6.d0, -3.d0 /) +! Atest(4,1:4) = (/5.d0, 0.d0, 2.d0, 0.d0 /) +! rhs(1:4) = (/ 6.d0, 7.d0, 13.d0, 9.d0 /) ! answer = (1 2 2 1) + + elseif (matrix%order > 4) then + + Atest(:,:) = 0.d0 + do n = 1, matrix%order + Atest(n,n) = 2.d0 + if (n > 1) Atest(n,n-1) = -1.d0 + if (n < matrix%order) Atest(n,n+1) = -1.d0 + enddo + + rhs(1) = 1.d0 + rhs(matrix%order) = 1.d0 + rhs(2:matrix%order-1) = 0.d0 ! answer = (1 1 1 ... 1 1 1) + + endif + + if (verbose_test) then + print*, ' ' + print*, 'Atest =', Atest + print*, 'rhs =', rhs + endif + + ! Put in SLAP triad format (column ascending order) + + n = 0 + do j = 1, matrix%order + do i = 1, matrix%order + if (Atest(i,j) /= 0.d0) then + n = n + 1 + matrix%row(n) = i + matrix%col(n) = j + matrix%val(n) = Atest(i,j) + endif + enddo + enddo + + ! Set number of nonzero values + matrix%nonzeros = n + + if (verbose_test) then + print*, ' ' + print*, 'row, col, val:' + do n = 1, matrix%nonzeros + print*, matrix%row(n), matrix%col(n), matrix%val(n) + enddo + print*, 'Call sparse_easy_solve, whichsparse =', whichsparse + endif + + ! Solve the linear matrix problem + + call sparse_easy_solve(matrix, rhs, answer, & + err, niters, whichsparse) + + if (verbose_test) then + print*, ' ' + print*, 'answer =', answer + print*, 'err =', err + print*, 'niters =', niters + endif + + stop + + end subroutine slap_solve_test_matrix + +!**************************************************************************** + +end module glissade_velo_higher_slap + +!**************************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo_higher_trilinos.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_trilinos.F90 new file mode 100644 index 0000000000..b73ccbf2a9 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo_higher_trilinos.F90 @@ -0,0 +1,1145 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo_higher_trilinos.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains subroutines called from glissade_velo_higher.F90 +! and used to process data before and after linking to Trilinos solver routines. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + module glissade_velo_higher_trilinos + + use glimmer_global, only: dp +! use glimmer_log, only: write_log + use parallel + + implicit none + private + +#ifdef TRILINOS + + public :: trilinos_global_id_3d, trilinos_global_id_2d, & + trilinos_fill_pattern_3d, trilinos_fill_pattern_2d, & + trilinos_assemble_3d, trilinos_assemble_2d, & + trilinos_init_velocity_3d, trilinos_init_velocity_2d, & + trilinos_extract_velocity_3d, trilinos_extract_velocity_2d, & + trilinos_test + + contains + +!**************************************************************************** + + subroutine trilinos_global_id_3d(nx, ny, nz, & + nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + global_node_id, & + active_owned_unknown_map) + + !---------------------------------------------------------------- + ! Compute global IDs needed to initialize the Trilinos solver + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension((nx-1)*(ny-1)*nz), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + integer, dimension(nz,nx-1,ny-1), intent(out) :: & + global_node_id ! unique global ID for nodes on this processor + + integer, dimension(2*nNodesSolve), intent(out) :: & + active_owned_unknown_map + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer, dimension(nx-1,ny-1) :: & + global_vertex_id ! unique global ID for vertices on this processor + + integer :: gnx, gny + + integer :: i, j, k, n + + !---------------------------------------------------------------- + ! Compute unique global IDs for nodes. + !---------------------------------------------------------------- + + global_vertex_id(:,:) = 0 + + do j = nhalo+1, ny-nhalo ! locally owned vertices only + do i = nhalo+1, nx-nhalo + gnx = ewlb + i - 1 ! global x index + gny = nslb + j - 1 ! global y index + global_vertex_id(i,j) = (gny-1)*global_ewn + gnx + enddo + enddo + + call staggered_parallel_halo(global_vertex_id) + + do j = 1, ny-1 ! loop over all vertices, including halo + do i = 1, nx-1 + do k = 1, nz + global_node_id(k,i,j) = (global_vertex_id(i,j)-1)*nz + k + enddo + enddo + enddo + + !---------------------------------------------------------------- + ! Associate a unique global index with each unknown on the active nodes + ! owned by this processor. + !---------------------------------------------------------------- + + do n = 1, nNodesSolve + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + active_owned_unknown_map(2*n-1) = 2*global_node_id(k,i,j) - 1 ! u unknowns + active_owned_unknown_map(2*n) = 2*global_node_id(k,i,j) ! v unknowns + enddo + + end subroutine trilinos_global_id_3d + +!**************************************************************************** + + subroutine trilinos_global_id_2d(nx, ny, & + nVerticesSolve, & + iVertexIndex, jVertexIndex, & + global_vertex_id, & + active_owned_unknown_map) + + !---------------------------------------------------------------- + ! Compute global IDs needed to initialize the Trilinos solver + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + integer, intent(in) :: & + nVerticesSolve ! number of nodes where we solve for velocity + + integer, dimension((nx-1)*(ny-1)), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + integer, dimension(nx-1,ny-1), intent(out) :: & + global_vertex_id ! unique global ID for nodes on this processor + + integer, dimension(2*nVerticesSolve), intent(out) :: & + active_owned_unknown_map + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: gnx, gny + + integer :: i, j, n + + !---------------------------------------------------------------- + ! Compute unique global IDs for vertices. + !---------------------------------------------------------------- + + global_vertex_id(:,:) = 0 + + do j = nhalo+1, ny-nhalo ! locally owned vertices only + do i = nhalo+1, nx-nhalo + gnx = ewlb + i - 1 ! global x index + gny = nslb + j - 1 ! global y index + global_vertex_id(i,j) = (gny-1)*global_ewn + gnx + enddo + enddo + + call staggered_parallel_halo(global_vertex_id) + + !---------------------------------------------------------------- + ! Associate a unique global index with each unknown on the active vertices + ! owned by this processor. + !---------------------------------------------------------------- + + do n = 1, nVerticesSolve + i = iVertexIndex(n) + j = jVertexIndex(n) + active_owned_unknown_map(2*n-1) = 2*global_vertex_id(i,j) - 1 ! u unknowns + active_owned_unknown_map(2*n) = 2*global_vertex_id(i,j) ! v unknowns + enddo + + end subroutine trilinos_global_id_2d + +!**************************************************************************** + + subroutine trilinos_fill_pattern_3d(nx, ny, nz, & + active_vertex, nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + indxA, Afill) + + !------------------------------------------------------------------------ + ! Construct logical arrays identifying which matrix elements are nonzero. + ! For the Trilinos solver, the number of matrix entries must be held fixed + ! from one iteration to the next. The logical arrays are used to + ! satisfy this requirement. + ! For now we simply set A**_fill = .true. everywhere in the row corresponding + ! to each active node. + ! Later, we could use boundary logic to set A**_fill = .false for some + ! columns, to avoid including matrix values that are always zero. + !------------------------------------------------------------------------ + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + integer, intent(in) :: nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension(:), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of active nodes + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + ! index order is (i,j,k) + + logical, dimension(27,nz,nx-1,ny-1), intent(out) :: & + Afill ! true wherever the matrix value is potentially nonzero + ! and should be sent to Trilinos + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k, m, n, iA, jA, kA + + Afill(:,:,:,:) = .false. + + ! Loop over active nodes + + do n = 1, nNodesSolve + + i = iNodeIndex(n) + j = jNodeIndex(n) + + if (active_vertex(i,j)) then + + k = kNodeIndex(n) + + do kA = -1,1 + do jA = -1,1 + do iA = -1,1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + if (active_vertex(i+iA,j+jA)) then + + m = indxA(iA,jA,kA) + Afill(m,k,i,j) = .true. + + endif ! active_vertex(i+iA,j+jA) + + endif ! neighbor node is in bounds + + enddo ! iA + enddo ! jA + enddo ! kA + + endif ! active_vertex(i,j) + + enddo ! n + + end subroutine trilinos_fill_pattern_3d + +!**************************************************************************** + + subroutine trilinos_fill_pattern_2d(nx, ny, & + active_vertex, nVerticesSolve, & + iVertexIndex, jVertexIndex, & + indxA, Afill) + + !------------------------------------------------------------------------ + ! Construct logical arrays identifying which matrix elements are nonzero. + ! + ! This subroutine is similar to trilinos_fill_pattern_3d, but modified + ! to solve for x and y at a single horizontal level, as in the + ! shallow-shelf approximation. + !------------------------------------------------------------------------ + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + logical, dimension(nx-1,ny-1), intent(in) :: & + active_vertex ! T for columns (i,j) where velocity is computed, else F + + integer, intent(in) :: nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension(:), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of active vertices + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 9 + ! index order is (i,j) + + logical, dimension(9,nx-1,ny-1), intent(out) :: & + Afill ! true wherever the matrix value is potentially nonzero + ! and should be sent to Trilinos + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, m, n, iA, jA + + Afill(:,:,:) = .false. + + ! Loop over active vertices + + do n = 1, nVerticesSolve + + i = iVertexIndex(n) + j = jVertexIndex(n) + + if (active_vertex(i,j)) then + + do jA = -1,1 + do iA = -1,1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + if (active_vertex(i+iA,j+jA)) then + + m = indxA(iA,jA) + Afill(m,i,j) = .true. + + endif ! active_vertex(i+iA,j+jA) + + endif ! neighbor node is in bounds + + enddo ! iA + enddo ! jA + + endif ! active_vertex(i,j) + + enddo ! n + + end subroutine trilinos_fill_pattern_2d + +!**************************************************************************** + + subroutine trilinos_assemble_3d(nx, ny, nz, & + nNodesSolve, global_node_id, & + iNodeIndex, jNodeIndex, kNodeIndex, & + indxA, Afill, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + !------------------------------------------------------------------------ + ! Given Auu, bu, etc., assemble the matrix and RHS in a form + ! suitable for Trilinos. + ! + ! Note: Trilinos requires that the matrix fill pattern is unchanged from + ! one outer iteration to the next. This requirement is currently enforced + ! by sending all 54 columns to Trilinos for each row (since A**_fill + ! is true everywhere), even though some columns may always equal zero. + ! With some more work, we should be able to remove some of these columns + ! for nodes at the boundary. + !------------------------------------------------------------------------ + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension(nz,nx-1,ny-1), intent(in) :: & + global_node_id ! unique global ID for nodes on this processor + + integer, dimension((nx-1)*(ny-1)*nz), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + integer, dimension(-1:1,-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y,z) coordinates to an index between 1 and 27 + ! index order is (i,j,k) + + logical, dimension(27,nz,nx-1,ny-1), intent(in) :: & + Afill ! true for matrix values to be sent to Trilinos + + real(dp), dimension(27,nz,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = node and its nearest neighbors in x, y and z direction + ! other dimensions = (k,i,j) indices + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: global_row ! global ID for this matrix row + + integer :: ncol ! number of columns with nonzero entries in this row + + integer, dimension(54) :: & + global_column ! global ID for this column + ! 54 is max number of columns with nonzero entries + + real(dp), dimension(54) :: & + matrix_value ! matrix value for this column + + real(dp) :: rhs_value ! right-hand side value (bu or bv) + + integer :: i, j, k, m, n, iA, jA, kA + +!WHL - debug + integer :: nc + + do n = 1, nNodesSolve + + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + + ! uvel equation for this node + + global_row = 2*global_node_id(k,i,j) - 1 + +!WHL - debug +! print*, ' ' +! print*, 'n, i, j, k', n, i, j, k +! print*, 'global_node_id, global_row:', global_node_id(k,i,j), global_row + + ncol = 0 + global_column(:) = 0 + matrix_value(:) = 0.d0 + + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA(iA,jA,kA) + + if (Afill(m,k,i,j)) then + + ncol = ncol + 1 + global_column(ncol) = 2*global_node_id(k+kA,i+iA,j+jA) - 1 + matrix_value(ncol) = Auu(m,k,i,j) + + ncol = ncol + 1 + global_column(ncol) = 2*global_node_id(k+kA,i+iA,j+jA) + matrix_value(ncol) = Auv(m,k,i,j) + + endif + + endif ! i+iA, j+jA, k+kA in bounds + enddo ! iA + enddo ! jA + enddo ! kA + + rhs_value = bu(k,i,j) + + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! vvel equation for this node + + global_row = 2*global_node_id(k,i,j) + + ncol = 0 + global_column(:) = 0 + matrix_value(:) = 0.d0 + + do kA = -1, 1 + do jA = -1, 1 + do iA = -1, 1 + + if ( (k+kA >= 1 .and. k+kA <= nz) & + .and. & + (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA(iA,jA,kA) + + if (Afill(m,k,i,j)) then + + ncol = ncol + 1 + global_column(ncol) = 2*global_node_id(k+kA,i+iA,j+jA) - 1 + matrix_value(ncol) = Avu(m,k,i,j) + + ncol = ncol + 1 + global_column(ncol) = 2*global_node_id(k+kA,i+iA,j+jA) + matrix_value(ncol) = Avv(m,k,i,j) + + endif + + endif ! i+iA, j+jA, k+kA in bounds + enddo ! iA + enddo ! jA + enddo ! kA + + rhs_value = bv(k,i,j) + + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + enddo ! nNodesSolve + + end subroutine trilinos_assemble_3d + +!**************************************************************************** + + subroutine trilinos_assemble_2d(nx, ny, & + nVerticesSolve, global_vertex_id, & + iVertexIndex, jVertexIndex, & + indxA, Afill, & + Auu, Auv, & + Avu, Avv, & + bu, bv) + + !------------------------------------------------------------------------ + ! Given Auu, bu, etc., assemble the matrix and RHS in a form + ! suitable for Trilinos. + ! + ! Note: Trilinos requires that the matrix fill pattern is unchanged from + ! one outer iteration to the next. This requirement is currently enforced + ! by sending all 18 columns to Trilinos for each row, even though some + ! column entries may always equal zero. + ! With some more work, we could remove some of these columns + ! for nodes at the boundary. + !------------------------------------------------------------------------ + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + integer, intent(in) :: & + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension(nx-1,ny-1), intent(in) :: & + global_vertex_id ! unique global ID for vertices on this processor + + integer, dimension((nx-1)*(ny-1)), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + integer, dimension(-1:1,-1:1), intent(in) :: & + indxA ! maps relative (x,y) coordinates to an index between 1 and 9 + ! index order is (i,j) + + logical, dimension(9,nx-1,ny-1), intent(in) :: & + Afill ! true for matrix values to be sent to Trilinos + + real(dp), dimension(9,nx-1,ny-1), intent(in) :: & + Auu, Auv, & ! assembled stiffness matrix, divided into 4 parts + Avu, Avv ! 1st dimension = node and its nearest neighbors in x, y and z direction + ! other dimensions = (i,j) indices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + bu, bv ! assembled load (rhs) vector, divided into 2 parts + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: global_row ! global ID for this matrix row + + integer :: ncol ! number of columns with nonzero entries in this row + + integer, dimension(18) :: & + global_column ! global ID for this column + ! 18 is max number of columns with nonzero entries + + real(dp), dimension(18) :: & + matrix_value ! matrix value for this column + + real(dp) :: rhs_value ! right-hand side value (bu or bv) + + integer :: i, j, m, n, iA, jA + + do n = 1, nVerticesSolve + + i = iVertexIndex(n) + j = jVertexIndex(n) + + ! uvel equation for this node + + global_row = 2*global_vertex_id(i,j) - 1 + + ncol = 0 + global_column(:) = 0 + matrix_value(:) = 0.d0 + + do jA = -1, 1 + do iA = -1, 1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA(iA,jA) + + if (Afill(m,i,j)) then + + ncol = ncol + 1 + global_column(ncol) = 2*global_vertex_id(i+iA,j+jA) - 1 + matrix_value(ncol) = Auu(m,i,j) + + ncol = ncol + 1 + global_column(ncol) = 2*global_vertex_id(i+iA,j+jA) + matrix_value(ncol) = Auv(m,i,j) + + endif + + endif ! i+iA, j+jA in bounds + enddo ! iA + enddo ! jA + + rhs_value = bu(i,j) + + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! vvel equation for this node + + global_row = 2*global_vertex_id(i,j) + + ncol = 0 + global_column(:) = 0 + matrix_value(:) = 0.d0 + + do jA = -1, 1 + do iA = -1, 1 + + if ( (i+iA >= 1 .and. i+iA <= nx-1) & + .and. & + (j+jA >= 1 .and. j+jA <= ny-1) ) then + + m = indxA(iA,jA) + + if (Afill(m,i,j)) then + + ncol = ncol + 1 + global_column(ncol) = 2*global_vertex_id(i+iA,j+jA) - 1 + matrix_value(ncol) = Avu(m,i,j) + + ncol = ncol + 1 + global_column(ncol) = 2*global_vertex_id(i+iA,j+jA) + matrix_value(ncol) = Avv(m,i,j) + + endif + + endif ! i+iA, j+jA in bounds + enddo ! iA + enddo ! jA + + rhs_value = bv(i,j) + + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + enddo ! nVerticesSolve + + end subroutine trilinos_assemble_2d + +!**************************************************************************** + + subroutine trilinos_init_velocity_3d(nx, ny, & + nz, nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + uvel, vvel, & + velocityResult) + + ! Copy the initial velocities into the Trilinos solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension((nx-1)*(ny-1)*nz), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + real(dp), dimension(nz,nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity + + real(dp), dimension(2*nNodesSolve), intent(out) :: & + velocityResult ! initial velocity solution vector for Trilinos + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k, n + + velocityResult(:) = 0.d0 + + do n = 1, nNodesSolve + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + velocityResult(2*n-1) = uvel(k,i,j) + velocityResult(2*n) = vvel(k,i,j) + enddo + + end subroutine trilinos_init_velocity_3d + +!**************************************************************************** + + subroutine trilinos_init_velocity_2d(nx, ny, & + nVerticesSolve, & + iVertexIndex, jVertexIndex, & + uvel, vvel, & + velocityResult) + + ! Copy the initial velocities into the Trilinos solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + integer, intent(in) :: & + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension((nx-1)*(ny-1)), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel ! u and v components of velocity + + real(dp), dimension(2*nVerticesSolve), intent(out) :: & + velocityResult ! initial velocity solution vector for Trilinos + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, n + + velocityResult(:) = 0.d0 + + do n = 1, nVerticesSolve + i = iVertexIndex(n) + j = jVertexIndex(n) + velocityResult(2*n-1) = uvel(i,j) + velocityResult(2*n) = vvel(i,j) + enddo + + end subroutine trilinos_init_velocity_2d + +!**************************************************************************** + + subroutine trilinos_extract_velocity_3d(nx, ny, & + nz, nNodesSolve, & + iNodeIndex, jNodeIndex, kNodeIndex, & + velocityResult, & + uvel, vvel) + + ! Extract the velocities from the Trilinos solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + integer, intent(in) :: & + nNodesSolve ! number of nodes where we solve for velocity + + integer, dimension((nx-1)*(ny-1)*nz), intent(in) :: & + iNodeIndex, jNodeIndex, kNodeIndex ! i, j and k indices of nodes + + real(dp), dimension(2*nNodesSolve), intent(in) :: & + velocityResult ! velocity solution vector from Trilinos + + real(dp), dimension(nz,nx-1,ny-1), intent(out) :: & + uvel, vvel ! u and v components of velocity + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k, n + + uvel(:,:,:) = 0.d0 + vvel(:,:,:) = 0.d0 + + do n = 1, nNodesSolve + i = iNodeIndex(n) + j = jNodeIndex(n) + k = kNodeIndex(n) + uvel(k,i,j) = velocityResult(2*n-1) + vvel(k,i,j) = velocityResult(2*n) + enddo + + end subroutine trilinos_extract_velocity_3d + +!**************************************************************************** + + subroutine trilinos_extract_velocity_2d(nx, ny, & + nVerticesSolve, & + iVertexIndex, jVertexIndex, & + velocityResult, & + uvel, vvel) + + ! Extract the velocities from the Trilinos solution vector. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + integer, intent(in) :: & + nVerticesSolve ! number of vertices where we solve for velocity + + integer, dimension((nx-1)*(ny-1)), intent(in) :: & + iVertexIndex, jVertexIndex ! i and j indices of vertices + + real(dp), dimension(2*nVerticesSolve), intent(in) :: & + velocityResult ! velocity solution vector from Trilinos + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + uvel, vvel ! u and v components of velocity + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, n + + uvel(:,:) = 0.d0 + vvel(:,:) = 0.d0 + + do n = 1, nVerticesSolve + i = iVertexIndex(n) + j = jVertexIndex(n) + uvel(i,j) = velocityResult(2*n-1) + vvel(i,j) = velocityResult(2*n) + enddo + + end subroutine trilinos_extract_velocity_2d + +!**************************************************************************** + + subroutine trilinos_test + + !-------------------------------------------------------- + ! Small test matrices for Trilinos solver + !-------------------------------------------------------- + + use parallel + + !-------------------------------------------------------- + ! Local variables + !-------------------------------------------------------- + + integer :: nNodesSolve + integer, dimension(:), allocatable :: & + active_owned_unknown_map ! map of global IDs + integer :: global_row ! global ID for this matrix row + integer :: ncol ! number of columns with nonzero entries in this row + integer, dimension(:), allocatable :: & + global_column ! global ID for this column + real(dp), dimension(:), allocatable :: & + matrix_value ! matrix value for this column + real(dp) :: rhs_value ! right-hand side value (bu or bv) + real(dp), dimension(:), allocatable :: & + velocityResult ! velocity solution vector from Trilinos + + if (main_task) then + print*, ' ' + print*, 'Solve trilinos test matrix, tasks =', tasks + endif + + if (tasks == 1) then + + ! Set up 2x2 matrix problem on 1 processor + + ! Here is the problem: + ! | 1 2 | | 1 | | 3 | + ! | 3 4 | | 1 | = | 7 | + + nNodesSolve = 1 + allocate(active_owned_unknown_map(2*nNodesSolve)) + active_owned_unknown_map(:) = (/ 1,2 /) + print*, 'initializetgs, rank =', this_rank + call initializetgs(2*nNodesSolve, active_owned_unknown_map, comm) + + ! insert rows + + allocate(global_column(2)) + allocate(matrix_value(2)) + + ! row 1 (global ID = 1) + global_row = 1 + ncol = 2 + global_column(:) = (/ 1,2 /) + matrix_value(:) = (/ 1,2 /) + rhs_value = 3 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! row 2 (global ID = 2) + global_row = 2 + ncol = 2 + global_column(:) = (/ 1,2 /) + matrix_value(:) = (/ 3,4 /) + rhs_value = 7 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! solve + allocate(velocityResult(2*nNodesSolve)) + print*, 'solvevelocitytgs, rank =', this_rank + call solvevelocitytgs(velocityResult) + + ! print solution + print*, 'rank, solution:', this_rank, velocityResult(:) + + elseif (tasks == 2) then + + ! Set up a 4x4 matrix problem on 2 processors + ! This one has 16 active unknowns + + ! Here is the problem: + ! | 1 2 0 3 | | 1 | | 7 | + ! | 4 5 6 0 | | 0 | | 10 | + ! | 7 8 9 10 | | 1 | = | 36 | + ! | 0 11 12 13 | | 2 | | 38 | + + ! initialize + + allocate(global_column(4)) + allocate(matrix_value(4)) + + nNodesSolve = 1 + allocate(active_owned_unknown_map(2*nNodesSolve)) + if (this_rank==0) then + active_owned_unknown_map(:) = (/ 1,3 /) + elseif (this_rank==1) then + active_owned_unknown_map(:) = (/ 4,6 /) + endif + print*, 'initializetgs, rank =', this_rank + call initializetgs(2*nNodesSolve, active_owned_unknown_map, comm) + + ! insert rows + + if (this_rank==0) then + + ! row 1 (global ID = 1) + global_row = 1 + ncol = 3 + global_column(:) = (/ 1,3,6,0 /) + matrix_value(:) = (/ 1,2,3,0 /) + rhs_value = 7 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! row 2 (global ID = 3) + global_row = 3 + ncol = 3 + global_column(:) = (/ 1,3,4,0 /) + matrix_value(:) = (/ 4,5,6,0 /) + rhs_value = 10 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + elseif (this_rank==1) then + + ! row 1 (global ID = 4) + global_row = 4 + ncol = 4 + global_column(:) = (/ 1,3,4,6 /) + matrix_value(:) = (/ 7,8,9,10 /) + rhs_value = 36 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! row 2 (global ID = 6) + global_row = 6 + ncol = 3 + global_column(:) = (/ 3,4,6,0 /) + matrix_value(:) = (/ 11,12,13,0 /) + rhs_value = 38 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + endif + + ! solve + allocate(velocityResult(2*nNodesSolve)) + print*, 'solvevelocitytgs, rank =', this_rank + call solvevelocitytgs(velocityResult) + + ! print solution + print*, 'rank, solution:', this_rank, velocityResult(:) + + deallocate(active_owned_unknown_map) + deallocate(velocityResult) + + ! Set up 4x4 matrix problem on 2 processors + ! This one has 12 active unknowns + + ! Here is the problem: + ! | 1 2 3 0 | | 1 | | 4 | + ! | 0 4 5 6 | | 0 | | 17 | + ! | 7 8 9 0 | | 1 | = | 16 | + ! | 0 10 11 12 | | 2 | | 35 | + + ! initialize + + nNodesSolve = 1 + allocate(active_owned_unknown_map(2*nNodesSolve)) + if (this_rank==0) then + active_owned_unknown_map(:) = (/ 1,3 /) + elseif (this_rank==1) then + active_owned_unknown_map(:) = (/ 4,6 /) + endif + print*, 'initializetgs, rank =', this_rank + call initializetgs(2*nNodesSolve, active_owned_unknown_map, comm) + + ! insert rows + + if (this_rank==0) then + + ! row 1 (global ID = 1) + global_row = 1 + ncol = 3 + global_column(:) = (/ 1,3,4,0 /) + matrix_value(:) = (/ 1,2,3,0 /) + rhs_value = 4 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! row 2 (global ID = 3) + global_row = 3 + ncol = 3 + global_column(:) = (/ 3,4,6,0 /) + matrix_value(:) = (/ 4,5,6,0 /) + rhs_value = 17 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + elseif (this_rank==1) then + + ! row 1 (global ID = 4) + global_row = 4 + ncol = 3 + global_column(:) = (/ 1,3,4,0 /) + matrix_value(:) = (/ 7,8,9,0 /) + rhs_value = 16 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + ! row 2 (global ID = 6) + global_row = 6 + ncol = 3 + global_column(:) = (/ 3,4,6,0 /) + matrix_value(:) = (/ 10,11,12,0 /) + rhs_value = 35 + print*, 'insertrowtgs, rank, row =', this_rank, global_row + call insertrowtgs(global_row, ncol, global_column, matrix_value, rhs_value) + + endif + + ! solve + allocate(velocityResult(2*nNodesSolve)) + print*, 'solvevelocitytgs, rank =', this_rank + call solvevelocitytgs(velocityResult) + + ! print solution + print*, 'rank, solution:', this_rank, velocityResult(:) + + deallocate(active_owned_unknown_map) + deallocate(velocityResult) + + else + print*, 'Error: Trilinos test requires 1 or 2 processors' + stop + endif + + end subroutine trilinos_test + +#endif + +!**************************************************************************** + + end module glissade_velo_higher_trilinos + +!**************************************************************************** diff --git a/components/cism/glimmer-cism/libglissade/glissade_velo_sia.F90 b/components/cism/glimmer-cism/libglissade/glissade_velo_sia.F90 new file mode 100644 index 0000000000..d28623fd09 --- /dev/null +++ b/components/cism/glimmer-cism/libglissade/glissade_velo_sia.F90 @@ -0,0 +1,1070 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! glissade_velo_sia.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! This module contains routines for computing the ice velocity using the shallow-ice approximation. +! +! It is roughly based on module glissade_velo_higher but is much simpler, +! computing only the SIA velocities. +! It is called with whichdycore = DYCORE_GLISSADE, which_ho_approx = HO_APPROX_LOCAL_SIA. +! +! The calculation is similar to the one in Glide, except that it +! computes only the SIA velocity profile and does not evolve thickness. +! Thickness evolves separately using the glissade_transport module. +! +! Unlike the Glide SIA calculation, this calculation is fully parallel. +! +! The function of the module is to allow a parallel SIA calculation using an +! explicit transport scheme, instead of an implicit diffusion calculation as in Glide. +! This can also be done using glissade_velo_higher, setting which_ho_approx = HO_APPROX_SIA. +! That method uses the same numerical techniques as the higher-order solve but with only the +! SIA matrix elements. However, HO_APPROX_SIA is much more expensive than HO_APPROX_LOCAL_SIA, +! and is somewhat less accurate for the Halfar test problem. +! +! Author: William Lipscomb +! Los Alamos National Laboratory +! Group T-3, MS B216 +! Los Alamos, NM 87545 +! USA +! +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + module glissade_velo_sia + + use glimmer_global, only: dp + use glimmer_physcon, only: gn, rhoi, grav, scyr + use glimmer_paramets, only: thk0, len0, vel0, vis0, tau0 +! use glimmer_log, only: write_log + + use glide_types + use glissade_grid_operators, only: glissade_stagger, glissade_centered_gradient, & + glissade_edge_gradient + use parallel + + implicit none + + private + public :: glissade_velo_sia_solve + + logical, parameter :: verbose = .false. + logical, parameter :: verbose_geom = .false. + logical, parameter :: verbose_bed = .false. + logical, parameter :: verbose_interior = .false. + logical, parameter :: verbose_bfric = .false. + + integer :: itest, jtest ! coordinates of diagnostic point + integer :: rtest ! task number for processor containing diagnostic point + + contains + +!**************************************************************************** + + subroutine glissade_velo_sia_solve(model, & + nx, ny, nz) + + use glissade_masks, only: glissade_get_masks + use glissade_therm, only: glissade_pressure_melting_point + + !TODO - Remove nx, ny, nz from argument list? + ! Would then have to allocate some local arrays. + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + type(glide_global_type), intent(inout) :: model ! derived type holding ice-sheet info + + !---------------------------------------------------------------- + ! Note that the glissade solver uses SI units. + ! Thus we have grid cell dimensions and ice thickness in meters, + ! velocity in m/s, and the rate factor in Pa^(-n) s(-1). + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Note: nx and ny are the horizontal dimensions of scalar arrays (e.g., thck and temp). + ! The velocity arrays have horizontal dimensions (nx-1, ny-1). + ! nz is the number of levels at which uvel and vvel are computed. + ! The scalar variables generally live at layer midpoints and have + ! vertical dimension nz-1. + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + ! (same as model%general%upn) + + !---------------------------------------------------------------- + ! Local variables and pointers set to components of model derived type + !---------------------------------------------------------------- + + real(dp) :: & + dx, dy ! grid cell length and width (m) + ! assumed to have the same value for each grid cell + + real(dp), dimension(:), pointer :: & + sigma ! vertical sigma coordinate, [0,1] + + real(dp) :: & + thklim, & ! minimum ice thickness for active cells (m) + eus, & ! eustatic sea level (m), = 0. by default + btrc_const ! constant basal traction ((m/yr)/Pa) for whichbtrc options + + integer :: & + whichbtrc, &! basal traction option for SIA + ! Note: Several, but not all, of the Glide options are supported + whichgradient_margin ! option for computing gradient at ice margin + ! 0 = include all neighbor cells in gradient calculation + ! 1 = include ice-covered and/or land cells + ! 2 = include ice-covered cells only + + real(dp), dimension(:,:), pointer :: & + thck, & ! ice thickness (m) + usrf, & ! upper surface elevation (m) + topg, & ! elevation of topography (m) + bwat, & ! basal water depth (m) + btrc, & ! basal traction parameter (m/yr)/Pa), = 1/beta + bfricflx ! basal heat flux from friction (W/m^2) + + real(dp), dimension(:,:,:), pointer :: & + uvel, vvel, & ! velocity components (m/yr) + temp, & ! temperature (deg C) + flwa ! flow factor in units of Pa^(-n) yr^(-1) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp), dimension(nx,ny) :: & + bpmp ! basal pressure melting point temperature (deg C) + + real(dp), dimension(nx-1,ny-1) :: & + stagthck, & ! ice thickness averaged to vertices (m) + dusrf_dx, dusrf_dy, & ! gradient of upper surface elevation (m/m) + stagbwat, & ! basal water depth averaged to vertices (m) + stagbtemp, & ! basal ice temperature averaged to vertices (deg C) + stagbpmp, & ! bpmp averaged to vertices (deg C) + ubas, vbas ! basal velocity components (m/yr) + + real(dp), dimension(nz-1,nx-1,ny-1) :: & + stagflwa ! flwa averaged to staggered grid, Pa^(-n) yr^(-1) + + integer, dimension(nx,ny) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + land_mask ! = 1 for cells where topography is above sea level + + integer :: i, j, k + + !-------------------------------------------------------- + ! Assign local pointers and variables to derived type components + !-------------------------------------------------------- + +! nx = model%general%ewn ! passed in +! ny = model%general%nsn +! nz = model%general%upn + + dx = model%numerics%dew + dy = model%numerics%dns + + thklim = model%numerics%thklim + eus = model%climate%eus + btrc_const = model%velowk%btrac_const + whichbtrc = model%options%whichbtrc + whichgradient_margin = model%options%which_ho_gradient_margin + + sigma => model%numerics%sigma(:) + thck => model%geometry%thck(:,:) + usrf => model%geometry%usrf(:,:) + topg => model%geometry%topg(:,:) + + bwat => model%temper%bwat(:,:) + btrc => model%velocity%btrc(:,:) + bfricflx => model%temper%bfricflx(:,:) + temp => model%temper%temp(:,:,:) + flwa => model%temper%flwa(:,:,:) + + uvel => model%velocity%uvel(:,:,:) + vvel => model%velocity%vvel(:,:,:) + + rtest = -999 + itest = 1 + jtest = 1 + if (this_rank == model%numerics%rdiag_local) then + rtest = model%numerics%rdiag_local + itest = model%numerics%idiag_local + jtest = model%numerics%jdiag_local + endif + + if (verbose .and. this_rank==rtest) then + print*, 'In glissade_velo_sia_solve' + print*, 'rank, itest, jtest =', rtest, itest, jtest + endif + + !-------------------------------------------------------- + ! Convert input variables to appropriate units for this solver. + ! (Mainly SI, except that time units in flwa, velocities, + ! and btrc are years instead of seconds) + !-------------------------------------------------------- + + call glissade_velo_sia_scale_input(dx, dy, & + thck, usrf, & + topg, & + eus, thklim, & + flwa, & + bwat, btrc_const, & + uvel, vvel) + + !------------------------------------------------------------------------------ + ! Compute masks: + ! (1) ice mask = 1 in cells where ice is present (thck > thklim), = 0 elsewhere + ! (2) land mask = 1 in cells where topography is at or above sea level + !------------------------------------------------------------------------------ + + call glissade_get_masks(nx, ny, & + thck, topg, & + eus, thklim, & + ice_mask, & + land_mask = land_mask) + + !------------------------------------------------------------------------------ + ! Compute staggered variables + ! + ! stagger_margin_in = 0 gives Glide-style averaging + ! (ice-free cells are included in the average) + ! stagger_margin_in = 1 omits ice-free cells from the average + ! + ! Setting stagger_margin = 1 for stagthck gives slightly more accurate results + ! for the Halfar SIA test than does stagger_margin = 0. + ! + ! Note: Glide in effect has stagger_margin_in = 0 for all staggered variables. + ! This seems wrong for temp, bwat, bpmp and flwa. + !------------------------------------------------------------------------------ + + call glissade_stagger(nx, ny, & + thck, stagthck, & + ice_mask, stagger_margin_in = 1) + + do k = 1, nz-1 + call glissade_stagger(nx, ny, & + flwa(k,:,:), stagflwa(k,:,:), & + ice_mask, stagger_margin_in = 1) + enddo + + if (whichbtrc == BTRC_CONSTANT_BWAT) then + + ! stagger_margin_in = 1 omits empty cells from the average + + call glissade_stagger(nx, ny, & + bwat(:,:), stagbwat(:,:), & + ice_mask, stagger_margin_in = 1) + + elseif (whichbtrc == BTRC_CONSTANT_TPMP) then + + call glissade_stagger(nx, ny, & + temp(nz,:,:), stagbtemp, & + ice_mask, stagger_margin_in = 1) + + ! Compute pressure melting point temp at bed + do j = 1, ny + do i = 1, nx + call glissade_pressure_melting_point(thck(i,j), bpmp(i,j)) + enddo + enddo + + call glissade_stagger(nx, ny, & + bpmp(:,:), stagbpmp(:,:), & + ice_mask, stagger_margin_in = 1) + + endif ! whichbtrc + + ! Compute surface elevation gradient + ! + ! Here a centered gradient is OK because the interior velocities + ! are computed along cell edges, so checkerboard noise is damped + ! (unlike Glissade finite-element calculations). + ! gradient_margin_in = 0 (HO_GRADIENT_MARGIN_ALL) gives a Glide-style gradient + ! (ice-free cells included in the gradient). This works well for shallow-ice problems. + ! gradient_margin_in = 1 (HO_GRADIENT_MARGIN_ICE_LAND) computes the gradient + ! using ice-covered and/or land points. It is equivalent to HO_GRADIENT_MARGIN_ALL + ! for the land-based problems where an SIA solver would usually be applied, and is the + ! default value. + ! gradient_margin_in = 2 (HO_GRADIENT_MARGIN_ICE) computes the gradient + ! using ice-covered points only. This scheme is very inaccurate for the + ! Halfar problem because it underestimates margin velocities. + + call glissade_centered_gradient(nx, ny, & + dx, dy, & + usrf, & + dusrf_dx, dusrf_dy, & + ice_mask, & + gradient_margin_in = whichgradient_margin, & + land_mask = land_mask) + + if (verbose .and. main_task) then + print*, ' ' + print*, 'In glissade_velo_sia_solve' + endif + + if (verbose_geom .and. main_task) then + + print*, ' ' + print*, 'stagthck (m):' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.2)',advance='no') stagthck(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'dusrf_dx:' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.4)',advance='no') dusrf_dx(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'dusrf_dy:' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.4)',advance='no') dusrf_dy(i,j) + enddo + print*, ' ' + enddo + + endif + + ! Compute velocity at the bed (ubas, vbas) + + call glissade_velo_sia_bed(nx, ny, & + stagthck, thklim, & + dusrf_dx, dusrf_dy, & + whichbtrc, stagbwat, & + stagbtemp, stagbpmp, & + btrc, btrc_const, & + ubas, vbas) + + if (verbose_bed .and. main_task) then + + print*, ' ' + print*, 'whichbtrc, btrc_const =', whichbtrc, btrc_const + + print*, ' ' + print*, 'btrc:' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.4)',advance='no') btrc(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'ubas:' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.2)',advance='no') ubas(i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'vbas:' + do i = 1, nx-1 + write(6,'(i7)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f7.2)',advance='no') vbas(i,j) + enddo + print*, ' ' + enddo + + endif ! verbose_bed + + ! Compute velocity in the ice interior + + call glissade_velo_sia_interior(nx, ny, nz, & + dx, dy, & + sigma, thklim, & + usrf, stagthck, & + dusrf_dx, dusrf_dy, & + stagflwa, & + ice_mask, land_mask, & + whichgradient_margin, & + ubas, vbas, & + uvel, vvel) + + if (verbose_interior .and. main_task) then + + print*, ' ' + print*, 'stagthck:' + do i = 1, nx-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f8.2)',advance='no') stagthck(i,j) + enddo + print*, ' ' + enddo + + k = 1 + print*, ' ' + print*, 'uvel, k = 1:' + do i = 1, nx-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f8.0)',advance='no') uvel(k,i,j) + enddo + print*, ' ' + enddo + + print*, ' ' + print*, 'vvel, k = 1:' + do i = 1, nx-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i4)',advance='no') j + do i = 1, nx-1 + write(6,'(f8.0)',advance='no') vvel(k,i,j) + enddo + print*, ' ' + enddo + + print*, 'Computed new velocity' + i = itest + j = jtest + print*, 'i, j =', i, j + print*, 'k, uvel, vvel:' + do k = 1, nz + print*, k, uvel(k,i,j), vvel(k,i,j) + enddo + + endif ! verbose_interior + + !------------------------------------------------------------------------------ + ! Compute the heat flux due to basal friction for each grid cell. + !------------------------------------------------------------------------------ + + call glissade_velo_sia_bfricflx(nx, ny, & + nhalo, ice_mask, & + uvel(nz,:,:), vvel(nz,:,:), & + btrc, bfricflx) + + ! Convert back to dimensionless units before returning + ! Note: bfricflx already has the desired units (W/m^2). + + call glissade_velo_sia_scale_output(thck, usrf, & + topg, flwa, & + bwat, btrc, & + uvel, vvel) + + end subroutine glissade_velo_sia_solve + +!********************************************************************* + + subroutine glissade_velo_sia_scale_input(dx, dy, & + thck, usrf, & + topg, & + eus, thklim, & + flwa, & + bwat, btrc_const, & + uvel, vvel) + + !-------------------------------------------------------- + ! Convert input variables (generally dimensionless) + ! to appropriate units for the glissade_velo_sia solver. + !-------------------------------------------------------- + + real(dp), intent(inout) :: & + dx, dy ! grid cell length and width + + real(dp), dimension(:,:), intent(inout) :: & + thck, & ! ice thickness + usrf, & ! upper surface elevation + topg ! elevation of topography + + real(dp), intent(inout) :: & + eus, & ! eustatic sea level (= 0 by default) + thklim, & ! minimum ice thickness for active cells + btrc_const ! constant basal traction ((m/yr)/Pa) for whichbtrc options + + real(dp), dimension(:,:,:), intent(inout) :: & + flwa ! flow factor in units of Pa^(-n) yr^(-1) + + real(dp), dimension(:,:), intent(inout) :: & + bwat ! basal water depth (m) + + real(dp), dimension(:,:,:), intent(inout) :: & + uvel, vvel ! velocity components (m/yr) + + ! grid cell dimensions: rescale from dimensionless to m + dx = dx * len0 + dy = dy * len0 + + ! ice geometry: rescale from dimensionless to m + thck = thck * thk0 + usrf = usrf * thk0 + topg = topg * thk0 + eus = eus * thk0 + thklim = thklim * thk0 + + ! rate factor: rescale from dimensionless to Pa^(-n) yr^(-1) + flwa = flwa * (vis0*scyr) + + ! bwat: rescale from dimensionless to m + bwat = bwat * thk0 + + ! btrc: rescale from dimensionless to (m/yr)/Pa +! btrc_const = btrc_const * (vel0*scyr) / tau0 + btrc_const = btrc_const * (vel0*scyr) * len0 / thk0**2 + + ! ice velocity: rescale from dimensionless to m/yr + uvel = uvel * (vel0*scyr) + vvel = vvel * (vel0*scyr) + + end subroutine glissade_velo_sia_scale_input + +!********************************************************************* + + subroutine glissade_velo_sia_scale_output(thck, usrf, & + topg, flwa, & + bwat, btrc, & + uvel, vvel) + + !-------------------------------------------------------- + ! Convert output variables to appropriate CISM units + ! (generally dimensionless) + !-------------------------------------------------------- + + real(dp), dimension(:,:), intent(inout) :: & + thck, & ! ice thickness + usrf, & ! upper surface elevation + topg ! elevation of topography + + real(dp), dimension(:,:,:), intent(inout) :: & + flwa ! flow factor in units of Pa^(-n) yr^(-1) + + real(dp), dimension(:,:), intent(inout) :: & + bwat, & ! basal water depth (m) + btrc ! basal traction parameter ((m/yr)/Pa) + + real(dp), dimension(:,:,:), intent(inout) :: & + uvel, vvel ! velocity components (m/yr) + + ! Convert geometry variables from m to dimensionless units + thck = thck / thk0 + usrf = usrf / thk0 + topg = topg / thk0 + + ! Convert flow factor from Pa^(-n) yr^(-1) to dimensionless units + flwa = flwa / (vis0*scyr) + + ! Convert bwat from m to dimensionless units + bwat = bwat / thk0 + + ! Convert btrc from (m/yr)/Pa to dimensionless units + btrc = btrc / ((vel0*scyr)/tau0) + + ! Convert velocity from m/yr to dimensionless units + uvel = uvel / (vel0*scyr) + vvel = vvel / (vel0*scyr) + + end subroutine glissade_velo_sia_scale_output + +!********************************************************************* + + subroutine glissade_velo_sia_bed(nx, ny, & + stagthck, thklim, & + dusrf_dx, dusrf_dy, & + whichbtrc, stagbwat, & + stagbtemp, stagbpmp, & + btrc, btrc_const, & + ubas, vbas) + + !---------------------------------------------------------------- + ! Compute the basal traction coefficient (btrc = 1/beta) and + ! the resulting basal velocities, assuming these velocities are + ! a linear function of the gravitational driving stress. + ! + ! Note: Not all the Glide whichbtrc options are supported, but + ! we support the ones needed for the EISMINT tests. + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny ! number of grid cells in each direction + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagthck, & ! ice thickness averaged to vertices (m) + dusrf_dx, dusrf_dy, & ! gradient of upper surface elevation (m/m) + stagbwat, & ! basal water depth averaged to vertices (m) + stagbtemp, & ! basal temperature averaged to vertices (deg C) + stagbpmp ! basal pressure melting point temperature averaged to vertices (deg C) + + real(dp), intent(in) :: & + thklim ! minimum ice thickness for active cells + + integer, intent(in) :: & + whichbtrc ! basal traction option for SIA + ! Note: Several, but not all, of the Glide options are supported + ! We support the ones used for EISMINT + + real(dp), intent(inout) :: & + btrc_const ! constant basal traction ((m/yr)/Pa) for whichbtrc options + + real(dp), dimension(nx-1,ny-1), intent(out) :: & + btrc, & ! basal traction parameter ((m/yr)/Pa), = 1/beta + ubas, vbas ! basal velocity components (m/yr) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j + + ! Compute basal velocity at cell vertices, as in Glide. + + do j = 1, ny-1 + do i = 1, nx-1 + + if (stagthck(i,j) > thklim) then + + ! Compute basal traction coefficient, btrc = 1/beta + + select case(whichbtrc) + + case(BTRC_CONSTANT) + + btrc(i,j) = btrc_const + + case(BTRC_CONSTANT_BWAT) + + ! btrc is constant where basal melt water is present, else no slip + ! This option can be used for EISMINT-2 experiment H, provided that + ! basal water is present where T = Tpmp (e.g., BWATER_LOCAL) + + if (stagbwat(i,j) > 0.d0) then + btrc(i,j) = btrc_const + else + btrc(i,j) = 0.d0 + end if + + case(BTRC_CONSTANT_TPMP) + + ! constant where basal temperature equal to pressure melting point, else = 0 + ! This is the actual condition for EISMINT-2 experiment H, which may not be + ! the same as case BTRC_CONSTANT_BWAT above, depending on the hydrology + + if (abs(stagbpmp(i,j) - stagbtemp(i,j)) < 1.d-3) then + btrc(i,j) = btrc_const + else + btrc(i,j) = 0.d0 + end if + + case default ! includes BTRC_ZERO + + ! no sliding + ! This is used for EISMINT-2 experiments A to F + + btrc(i,j) = 0.d0 + + end select + + ! Compute basal velocity as a linear function of gravitational driving stress + + ubas(i,j) = -btrc(i,j) * rhoi * grav * stagthck(i,j) * dusrf_dx(i,j) + vbas(i,j) = -btrc(i,j) * rhoi * grav * stagthck(i,j) * dusrf_dy(i,j) + + else ! stagthck <= thklim + + btrc(i,j) = 0.d0 + ubas(i,j) = 0.d0 + vbas(i,j) = 0.d0 + + endif + + end do + end do + + end subroutine glissade_velo_sia_bed + +!********************************************************************* + + subroutine glissade_velo_sia_interior(nx, ny, nz, & + dx, dy, & + sigma, thklim, & + usrf, stagthck, & + dusrf_dx, dusrf_dy, & + stagflwa, & + ice_mask, land_mask, & + whichgradient_margin, & + ubas, vbas, & + uvel, vvel) + + use parallel + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! number of grid cells in each direction + nz ! number of vertical levels where velocity is computed + + real(dp), intent(in) :: & + dx, dy, & ! grid cell length and width (m) + thklim ! minimum ice thickness for active cells + + real(dp), dimension(nz) :: & + sigma ! vertical sigma coordinate, [0,1] + + real(dp), dimension(nx,ny), intent(in) :: & + usrf ! upper surface elevation (m) + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + stagthck, & ! ice thickness averaged to vertices (m) + dusrf_dx, dusrf_dy, & ! gradient of upper surface elevation at vertices (m/m) + ubas, vbas ! basal velocity components at vertices (m/yr) + + real(dp), dimension(nz-1, nx-1,ny-1), intent(in) :: & + stagflwa ! flwa averaged to vertices (Pa^(-n) yr^(-1)) + + integer, dimension(nx,ny), intent(in) :: & + ice_mask, & ! = 1 where ice is present, else = 0 + land_mask ! = 1 for cells where topography is above sea level + + integer, intent(in) :: & + whichgradient_margin ! option for computing gradient at ice margin + ! 0 = include all neighbor cells in gradient calculation + ! 1 = include ice-covered and/or land cells + ! 2 = include ice-covered cells only + + real(dp), dimension(nz, nx-1,ny-1), intent(out) :: & + uvel, vvel ! velocity components at vertices (m/yr) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + integer :: i, j, k + + real(dp) :: & + siafact ! factor in SIA velocity calculation + + real(dp), dimension(nz,nx-1,ny-1) :: & + vintfact ! vertically integrated SIA factor at vertices + + real(dp), dimension(nx,ny) :: & + uedge, vedge ! velocity components at cell edges (m/yr) + ! u on E edge, v on N edge (C grid) + real(dp), dimension(nx-1,ny-1) :: & + dusrf_dx_edge, & ! upper surface elevation gradient at cell edges (m/m) + dusrf_dy_edge + + real(dp), dimension(nx-1,ny-1) :: diffu + + ! Initialize + uvel(nz,:,:) = ubas(:,:) + vvel(nz,:,:) = vbas(:,:) + uvel(1:nz-1,:,:) = 0.d0 + vvel(1:nz-1,:,:) = 0.d0 + + ! Compute vertically integrated factor for velocity calculation. + ! As in Glide, this factor is located at cell vertices and is < 0 by definition. + + ! Loop over all vertices + do j = 1, ny-1 + do i = 1, nx-1 + + if (stagthck(i,j) > thklim) then + + siafact = 2.d0 * (rhoi*grav)**gn * stagthck(i,j)**(gn+1) & + * (dusrf_dx(i,j)**2 + dusrf_dy(i,j)**2) ** ((gn-1)/2) + + vintfact(nz,i,j) = 0.d0 + + do k = nz-1, 1, -1 + + vintfact(k,i,j) = vintfact(k+1,i,j) - & + siafact * stagflwa(k,i,j) & + * ((sigma(k) + sigma(k+1))/2.d0) ** gn & + * (sigma(k+1) - sigma(k)) + + enddo ! k + + else ! stagthck <= thklim + + vintfact(:,i,j) = 0.d0 + + endif + + enddo ! i + enddo ! j + + if (verbose_interior .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'i, j =', itest, jtest + print*, 'k, vintfact, stagthck, dusrf_dx:' + do k = nz-1, 1, -1 + print*, k, vintfact(k,i,j), stagthck(i,j), dusrf_dx(i,j) + enddo + endif + + ! Optionally, compute diffusivitity (as defined by Glide) at vertex(i,j) + if (verbose_interior .and. main_task) then + do j = 1, ny-1 + do i = 1, nx-1 + diffu(i,j) = 0.d0 + do k = 1, nz-1 + diffu(i,j) = diffu(i,j) - (vintfact(k,i,j) + vintfact(k+1,i,j))/2.d0 * (sigma(k+1) - sigma(k)) * stagthck(i,j) + enddo + enddo ! i + enddo ! j + endif + + ! Compute ice velocity components at cell edges (u at E edge, v at N edge; relative to bed). + ! Then interpolate the edge velocities to cell vertices. + ! Note: By default, whichgradient_margin = HO_GRADIENT_MARGIN_ICE_LAND = 1, which generally + ! works well for shallow-ice problems. Using HO_GRADIENT_MARGIN_ALL = 0 gives + ! identical results for land-based problems. Using HO_GRADIENT_MARGIN_ICE_ONLY = 2 + ! is likely to give less accurate results. + ! See comments above the call to glissade_centered_gradient. + + call glissade_edge_gradient(nx, ny, & + dx, dy, & + usrf, & + dusrf_dx_edge, dusrf_dy_edge, & + gradient_margin_in = whichgradient_margin, & + ice_mask = ice_mask, & + land_mask = land_mask) + + do k = nz-1, 1, -1 + + uedge(:,:) = 0.d0 + vedge(:,:) = 0.d0 + + ! Loop over cells, skipping outer halo rows to stay in bounds + + ! east edges + do j = 2, ny-1 + do i = 1, nx-1 + if (stagthck(i,j) > thklim .and. stagthck(i,j-1) > thklim) then + uedge(i,j) = (vintfact(k,i,j) + vintfact(k,i,j-1))/2.d0 * dusrf_dx_edge(i,j) + endif + enddo ! i + enddo ! j + + ! north edges + do j = 1, ny-1 + do i = 2, nx-1 + if (stagthck(i,j) > thklim .and. stagthck(i-1,j) > thklim) then + vedge(i,j) = (vintfact(k,i,j) + vintfact(k,i-1,j))/2.d0 * dusrf_dy_edge(i,j) + endif + enddo ! i + enddo ! j + + ! halo update not needed provided nhalo >= 2 +! call parallel_halo(uedge) +! call parallel_halo(vedge) + + ! Do this for locally owned vertices only, then do halo update + + do j = nhalo+1, ny-nhalo + do i = nhalo+1, nx-nhalo + uvel(k,i,j) = ubas(i,j) + (uedge(i,j) + uedge(i,j+1)) / 2.d0 + vvel(k,i,j) = vbas(i,j) + (vedge(i,j) + vedge(i+1,j)) / 2.d0 + enddo + enddo + + enddo ! k + + call staggered_parallel_halo(uvel) + call staggered_parallel_halo(vvel) + + if (verbose_interior .and. main_task) then + print*, ' ' + print*, 'diffu (m^2/yr):' + do i = 1, nx-1 + write(6,'(i8)',advance='no') i + enddo + print*, ' ' + do j = ny-1, 1, -1 + write(6,'(i3)',advance='no') j + do i = 1, nx-1 + write(6,'(f8.0)',advance='no') diffu(i,j) + enddo + print*, ' ' + enddo + endif ! verbose_interior + + end subroutine glissade_velo_sia_interior + +!**************************************************************************** + + subroutine glissade_velo_sia_bfricflx(nx, ny, & + nhalo, ice_mask, & + uvel, vvel, & + btrc, bfricflx) + + !---------------------------------------------------------------- + ! Compute the heat flux due to basal friction, given the 2D basal + ! velocity and traction fields. + ! + ! Assume a sliding law of the form: + ! tau_x = -u / btrc (assuming btrc > 0) + ! tau_y = -v / btrc + ! where btrc and (u,v) are defined at vertices. + ! + ! The frictional heat flux (W/m^2) is given by q_b = tau_b * u_b, + ! where tau_b and u_b are the magnitudes of the basal stress + ! and velocity (e.g., Cuffey & Paterson, p. 418). + !---------------------------------------------------------------- + + !---------------------------------------------------------------- + ! Input-output arguments + !---------------------------------------------------------------- + + integer, intent(in) :: & + nx, ny, & ! horizontal grid dimensions + nhalo ! number of halo layers + + integer, dimension(nx,ny), intent(in) :: & + ice_mask ! = 1 where ice is present, else = 0 + + real(dp), dimension(nx-1,ny-1), intent(in) :: & + uvel, vvel, & ! basal velocity components at each vertex (m/yr) + btrc ! basal traction parameter ((m/yr)/Pa), = 1/beta + + real(dp), dimension(nx,ny), intent(out) :: & + bfricflx ! basal heat flux from friction (W/m^2) + + !---------------------------------------------------------------- + ! Local variables + !---------------------------------------------------------------- + + real(dp), dimension(nx-1,ny-1) :: & + stagbfricflx ! basal heat flux on staggered mesh + + integer :: i, j + + ! initialize + bfricflx(:,:) = 0.d0 + + ! Compute basal frictional heating at each vertex + ! Divide by scyr to convert Pa m/yr to Pa m/s = W/m^2 + do j = 1, ny-1 + do i = 1, nx-1 + if (btrc(i,j) > 0.d0) then + stagbfricflx(i,j) = (uvel(i,j)**2 + vvel(i,j)**2) / btrc(i,j) / scyr + else + stagbfricflx(i,j) = 0.d0 + endif + enddo ! i + enddo ! j + + if (verbose_bfric .and. this_rank==rtest) then + i = itest + j = jtest + print*, 'i, j:', i, j + print*, ' ' + print*, 'speed:' + do j = jtest+1, jtest, -1 + print*, j, sqrt(uvel(i:i+1,j)**2 + vvel(i:i+1,j)**2) + enddo + print*, 'stagbfricflx:' + do j = jtest+1, jtest, -1 + print*, j, stagbfricflx(i:i+1,j) + enddo + endif + + ! Compute basal frictional heating in cells. + do j = 1+nhalo, ny-nhalo + do i = 1+nhalo, nx-nhalo + if (ice_mask(i,j)==1) then + bfricflx(i,j) = 0.25d0 * (stagbfricflx(i,j+1) + stagbfricflx(i+1,j+1) & + + stagbfricflx(i,j) + stagbfricflx(i+1,j)) + endif + enddo + enddo + + call parallel_halo(bfricflx) + + if (verbose_bfric .and. this_rank==rtest) then + i = itest + j = jtest + print*, ' ' + print*, 'i, j, bfricflx:', i, j, bfricflx(i,j) + endif + + end subroutine glissade_velo_sia_bfricflx + +!********************************************************************* + + end module glissade_velo_sia + +!********************************************************************* diff --git a/components/cism/glimmer-cism/utils/README b/components/cism/glimmer-cism/utils/README new file mode 100644 index 0000000000..f5ffe8a40c --- /dev/null +++ b/components/cism/glimmer-cism/utils/README @@ -0,0 +1,4 @@ +The various subdirectories in this directory hold utilities that may be useful for working with CISM. +The 'build' subdirectory holds scripts that are used by the cmake build system when building the code +and is necessary for successful compiling. The other subdirectories hold miscellaneous tools that are +not required, but may be useful. See the individual README files in each subdirectory for details. diff --git a/components/cism/glimmer-cism/utils/compare-netcdf-files/Makefile b/components/cism/glimmer-cism/utils/compare-netcdf-files/Makefile new file mode 100644 index 0000000000..20fac6ae5a --- /dev/null +++ b/components/cism/glimmer-cism/utils/compare-netcdf-files/Makefile @@ -0,0 +1,12 @@ +# Set the environment variable NETCDF to the path of your NETCDF installation. + +CXX=g++ +CXXFLAGS= -O3 -m64 +CXXLIBS = -I$(NETCDF)/include -L$(NETCDF)/lib -lnetcdf_c++ + +all: + $(CXX) compare.cpp $(CXXLIBS) $(CXXFLAGS) -o compare + +clean: + rm compare + diff --git a/components/cism/glimmer-cism/utils/compare-netcdf-files/README b/components/cism/glimmer-cism/utils/compare-netcdf-files/README new file mode 100644 index 0000000000..07df6a0716 --- /dev/null +++ b/components/cism/glimmer-cism/utils/compare-netcdf-files/README @@ -0,0 +1,5 @@ +This directory contains a C++ program to compare any variables common to two netcdf files. +See compare.cpp for more details. + +The code must be compiled manually using the included Makefile. It may need to be modified to work with your system, but is quite simple, so any changes will probably be minor. + diff --git a/components/cism/glimmer-cism/utils/compare-netcdf-files/compare.cpp b/components/cism/glimmer-cism/utils/compare-netcdf-files/compare.cpp new file mode 100644 index 0000000000..5bc7a6b2ea --- /dev/null +++ b/components/cism/glimmer-cism/utils/compare-netcdf-files/compare.cpp @@ -0,0 +1,355 @@ +// $Id: compare.cpp 5181 2009-07-14 11:09:04Z martin-johnson $ + +// Program to compare any variables common to two netcdf files. +// Optional tolerances:- +// Absolute: +// if the difference between values A and B is less than the +// absolute tolerance, then it is small enough to ignore. +// Relative: +// If the difference between values A and B is less than or +// equal to the given number of Ulps, then they are close +// enough. + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#if !defined(WIN32) +#include +#else +// unistd is a UNIX specific library so we must provide an alternate getopt() function +// Prototype the getopt function provided in the NetCDF distribution (src/win32/NET) +extern int optind; +extern int getopt(int argc, char *const argv[], const char *opts); +extern char *optarg; +#endif + +using namespace std; + +// option parsing +// -v for verbose +// -s for silent +// -z to fail if either file contains no variables +#define OPTIONS "vszr:a:" +bool verbose = false; +bool silent = false; +bool zerocheck = false; + +// Define some error types +#define ERRDIMNUM 1 +#define ERRTYPE 2 +#define ERRSIZE 3 +#define ERRVALS 4 + +// Prototype comparison functions +int varComp(NcVar *A, NcVar *B, double dMinAbs, int iMaxUlps); +bool AlmostEqual2sComplement(float A, float B, int maxUlps); +int twosComplementDiff(float A, float B); + +int main(int argc, char **argv) +{ + + int iMaxUlps = 0; // max num of Ulps allowed between floats A and B + double dMinAbs = DBL_MIN; // min absolute difference between floats allowed + + NcToken* namesAP; + NcToken* namesBP; + int namesCommon; + + bool bErrFound = false; // flag if at least one comparison error has been found + + // Parse options + char c; + while ((c = getopt(argc, argv, OPTIONS)) != -1) + switch (c) { + case 'v': + verbose=true; + break; + case 's': + silent=true; + break; + case 'z': + zerocheck=true; + break; + case 'r': + iMaxUlps = atoi(optarg); + break; + case 'a': + dMinAbs = atof(optarg); + break; + } + + if (silent) verbose=false; + + // check we have some options left for filenames and tolerance + if (argc-optind != 2) { + cout << "Usage: compare [options] " << endl; + cout << "Options:" << endl; + cout << " -v\t\t\tVerbose mode" << endl; + cout << " -s\t\t\tSilent mode" << endl; + cout << " -z\t\t\tFail for empty files" << endl; + cout << " -r \t\tRelative tolerance threshold in ulps" << endl; + cout << " -a \t\tAbsolute tolerance threshold--ignore smaller numbers" << endl; + exit(1); + } + + const char *fileA = argv[optind]; + const char *fileB = argv[1+optind]; + + // --------------------------------------------------------------- + // Verify the threshold options, if supplied + // --------------------------------------------------------------- + + if(iMaxUlps<0) { + fprintf(stderr,"Error: Cannot specify a -ve relative tolerance\n"); + exit(EXIT_FAILURE); + } + if(dMinAbs<0.0) { + fprintf(stderr,"Error: Cannot specify a -ve absolute tolerance\n"); + exit(EXIT_FAILURE); + } + + // error handling class + NcError err_handler; + + // --------------------------------------------------------------- + // Load the two files and their variable names + // --------------------------------------------------------------- + + // == NC file A == + // Check existance + NcFile fpA(fileA); + if(!fpA.is_valid()) { + fprintf(stderr,"Error: Could not open file: %s, or it is not a valid NetCDF file\n", fileA); + exit(EXIT_FAILURE); + } + // get number of variables + const int numVarsA = fpA.num_vars(); + + // check there are variables + if (zerocheck && (numVarsA==0)) { + fprintf(stderr,"File %s contains no variables\n",fileA); + exit(EXIT_FAILURE); + } + + // allocate space to store variable names + namesAP = (NcToken*)malloc(sizeof(NcToken)*numVarsA); + + // get variable names + for(int ii=0; iiname(); + } + + // == NC file B == + // Check existance + NcFile fpB(fileB); + if(!fpB.is_valid()) { + fprintf(stderr,"Error: Could not open file: %s, or it is not a valid NetCDF file\n", fileB); + exit(EXIT_FAILURE); + } + // get number of variables + const int numVarsB = fpB.num_vars(); + + // check there are variables + if (zerocheck && (numVarsB==0)) { + fprintf(stderr,"File %s contains no variables\n",fileB); + exit(EXIT_FAILURE); + } + + // allocate space to store variable names + namesBP = (NcToken*)malloc(sizeof(NcToken)*numVarsB); + + // get variable names + for(int ii=0; iiname(); + } + + // Change the error behavior of the netCDF C++ API by creating an + // NcError object. Until it is destroyed, this NcError object will + // ensure that the netCDF C++ API silently returns error codes on + // any failure, and leaves any other error handling to the calling + // program. In the case of this example, we just exit with an + // NC_ERR error code. + NcError err(NcError::silent_nonfatal); + + // ------------------------------------------------------------- + // Determine which variables in A are also + // present in B, then for those that are, compare them + // ------------------------------------------------------------- + + for(int ii=0; iinum_dims()!=B->num_dims()) + return ERRDIMNUM; + if (A->type()!=B->type()) + return ERRTYPE; + + // Get all the values + NcValues* AvalsP=A->values(); + NcValues* BvalsP=B->values(); + + // Check sizes of variables + long numValsA=AvalsP->num(); + long numValsB=BvalsP->num(); + + if (numValsA!=numValsB) + return ERRSIZE; + + // Check if variables are scaled + double ScaleA = 1.0; + NcAtt* ScaleFactorA; + if ((ScaleFactorA=A->get_att("scale_factor"))) + ScaleA = ScaleFactorA->as_double(0); + double ScaleB = 1.0; + NcAtt* ScaleFactorB; + if ((ScaleFactorB=B->get_att("scale_factor"))) + ScaleB = ScaleFactorB->as_double(0); + + // Compare individual values + int errcatch=0; + for (int ii=0; iias_double(ii); + double Bval = ScaleB*BvalsP->as_double(ii); + // if equal, then happy days + if (Aval == Bval) { + continue; + } + else { + // if an absolute threshold is specified for ignoring + if (dMinAbs > DBL_MIN) { + if (fabs(Aval - Bval) < dMinAbs) { + if (verbose) { + cout << Aval << " - " << Bval << " < " << dMinAbs << " (absolute threshold) and so skipping" << endl; + } + continue; + } + } + // if a relative threhold is specified for comparing + if (iMaxUlps > 0) { + if (AlmostEqual2sComplement(Aval,Bval,iMaxUlps)) { + if (verbose) { + cout << Aval << " - " << Bval << " has an AlmostEqual2sComplement <= " << iMaxUlps + << " (relative threshold) and so skipping" << endl; + } + continue; + } + } + // catch all is that Aval != Bval and so we have a problem + errcatch=(errcatch || 1); + if (verbose) + cout << Aval << " - " << Bval << " = " << Aval-Bval << "\t(" + << twosComplementDiff(Aval,Bval) << " Ulps difference)" << endl; + break; + } + } + + free(AvalsP); + free(BvalsP); + free(ScaleFactorA); + free(ScaleFactorB); + + return errcatch*ERRVALS; +} + +// Usable AlmostEqual function +bool AlmostEqual2sComplement(float A, float B, int maxUlps) +{ + // Make sure maxUlps is non-negative and small enough that the + // default NAN won't compare as equal to anything. + assert(maxUlps > 0 && maxUlps < 4 * 1024 * 1024); + int aInt = *(int*)&A; + + // Make aInt lexicographically ordered as a twos-complement int + if (aInt < 0) + aInt = 0x80000000 - aInt; + + // Make bInt lexicographically ordered as a twos-complement int + int bInt = *(int*)&B; + if (bInt < 0) + bInt = 0x80000000 - bInt; + int intDiff = abs(aInt - bInt); + if (intDiff <= maxUlps) + return true; + return false; +} + +// Just the raw 2sComplement difference +int twosComplementDiff(float A, float B) +{ + int aInt = *(int*)&A; + + // Make aInt lexicographically ordered as a twos-complement int + if (aInt < 0) + aInt = 0x80000000 - aInt; + + // Make bInt lexicographically ordered as a twos-complement int + int bInt = *(int*)&B; + if (bInt < 0) + bInt = 0x80000000 - bInt; + int intDiff = abs(aInt - bInt); + + return intDiff; +} diff --git a/components/cism/glimmer-cism/utils/f90_dependency_tool/README b/components/cism/glimmer-cism/utils/f90_dependency_tool/README new file mode 100644 index 0000000000..0895891ee8 --- /dev/null +++ b/components/cism/glimmer-cism/utils/f90_dependency_tool/README @@ -0,0 +1,2 @@ +This file has a python script that can be used to evaluate file dependencies in Fortran 90 code. It is no longer actively used, but has been retained in the repository in case it may be of use in the future. + diff --git a/components/cism/glimmer-cism/utils/f90_dependency_tool/f90_dependencies.py b/components/cism/glimmer-cism/utils/f90_dependency_tool/f90_dependencies.py new file mode 100755 index 0000000000..0884d0d188 --- /dev/null +++ b/components/cism/glimmer-cism/utils/f90_dependency_tool/f90_dependencies.py @@ -0,0 +1,212 @@ +#! /usr/bin/env python + +# Copyright (C) 2004, 2007, 2008, 2009 +# Glimmer-CISM contributors - see AUTHORS file for list of contributors +# +# This file is part of Glimmer-CISM. +# +# Glimmer-CISM is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or (at +# your option) any later version. +# +# Glimmer-CISM is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Glimmer-CISM. If not, see . +# +# Glimmer-CISM is hosted on BerliOS.de: +# https://developer.berlios.de/projects/glimmer-cism/ + +# python script for analysing module dependencies of a number of f90/f95 programs + +import string, getopt, sys, os, os.path + +external_mod = ['f95_lapack','netcdf','blas_dense'] +external_inc = ['config.inc'] + +def search_file(name): + "function searching a f90/95 file if it contains module information and/or uses modules and/or includes files" + + n = os.path.basename(name) + result = {} + result['name'] = string.replace(n,'.','_') + result['realname'] = n + result['modname'] = [] + result['includes'] = [] + result['uses'] = [] + result['prog'] = 0 + result['process'] = 1 + + # open file + file = open(name,'r') + + # parsing file + for l in file.readlines(): + l = string.lower(l) + # searching for comments and stripping them + pos = string.find(l,'!') + if pos is not -1: + l = l[:pos] + # finding use statement + pos = string.find(l,'use') + if pos is not -1: + pos = pos+len('use') + pos2 = string.find(l,',') + if pos2==-1: + module = string.strip(l[pos:]) + else: + module = string.strip(l[pos:pos2]) + if module not in result['uses'] and module not in external_mod: + result['uses'].append(module) + continue + # finding include statements + pos = string.find(l,'include ') + if pos is not -1: + pos = pos+len('include ') + include = string.strip(l[pos:]) + if string.find(include,'<') is not -1: + continue + include = string.replace(include,'\"','') + include = string.replace(include,'\'','') + if include not in result['includes'] and include not in external_inc: + result['includes'].append(include) + continue + # finding module statement + pos = string.find(l,'end module') + if pos is not -1: + pos = pos + len('end module') + result['modname'].append(string.strip(l[pos:])) + continue + if string.find(l,'end program') is not -1: + result['prog'] = 1 + + file.close() + return result + +def reduce(names,files,modules): + "reduce list to be processed to names + dependencies" + + for r in files: + r['process']=0 + + for n in names: + recurse_mark(n,files,modules) + +def recurse_mark(name,files,modules): + "recursively mark used ones" + + for r in files: + if name == r['realname']: + r['process'] = 1 + for mod in r['uses']: + if mod in modules.keys(): + recurse_mark(modules[mod],files,modules) + break + +def print_dot(out,files,modules,onlymod=0): + "print dot file to out" + + out.write( 'digraph G {\n') + out.write( '\toverlap=false\n') + out.write( '\tspline=true\n') + for r in files: + flags = '[label="%s"'%r['realname'] + if len(r['modname']) > 0: + flags = flags + ',shape=box' + if r['prog'] is 1: + flags = flags + ',color=red' + flags = flags + ']' + if (onlymod is 1 and len(r['modname']) > 0) or onlymod is 0: + if r['process'] is 1: + out.write( '\t%s %s;\n'%(r['name'],flags)) + for r in files: + if (onlymod is 1 and len(r['modname']) > 0) or onlymod is 0: + if r['process'] is 1: + for mod in r['uses']: + if mod in modules.keys(): + out.write( '\t%s -> %s ;\n'%(r['name'],modules[mod])) + out.write( '}\n' ) + +def print_makefile(out,files,modules,obj_ext): + "print Makefile dependencies" + + for r in files: + out.write("%s%s:\t\t"%(os.path.splitext(r['realname'])[0],obj_ext)) + for mod in r['uses']: + if mod in modules.keys(): + if modules[mod] != r['realname']: + out.write("%s%s "%(os.path.splitext(modules[mod])[0],obj_ext)) + for inc in r['includes']: + out.write("%s "%inc) + out.write("%s\n"%r['realname']) + +def usage(): + "short help message" + print 'Usage: f90_dependencies [OPTIONS] f90files' + print 'extract module dependencies from set of f90/95 files' + print '' + print ' -h, --help\n\tthis message' + print ' -d, --dot\n\tchange output format to dot (default is Makefile dependencies)' + print ' -p file, --process=file\n\tonly processes dependencies for file (more than one can be specified)' + print ' -m, --mod\n\tonly process modules (only honour when producing dot)' + print ' -l, --libtool\n\tproduce output to be used by libtool' + print ' -o file, --output=file\n\twrite to file (default: stdout' + +if __name__ == '__main__': + + try: + opts, args = getopt.getopt(sys.argv[1:],'hdmo:p:l',['help','dot','mod','output=','process=','libtool']) + except getopt.GetoptError: + # print usage and exit + usage() + sys.exit(2) + + if len(args) < 1: + # print usage and exit + usage() + sys.exit(2) + + dot = 0 + mod = 0 + outfile = sys.stdout + process = [] + obj_ext = '.o' + for o,a in opts: + if o in ('-h', '--help'): + usage() + sys.exit(0) + if o in ('-d','--dot'): + dot = 1 + if o in ('-m', '--mod'): + mod = 1 + if o in ('-p', '--process'): + process.append(a) + if o in ('-o', '--output'): + outfile = open(a,'w') + if o in ('-l', '--libtool'): + obj_ext = '.lo' + + f90files = [] + modnames = {} + modrnames = {} + for arg in args: + r = search_file(arg) + f90files.append(r) + for m in r['modname']: + if m not in modnames.keys(): + modnames[m] = r['name'] + modrnames[m] = r['realname'] + + if dot is 1: + if len(process)>0: + reduce(process,f90files,modrnames) + mod = 0 + print_dot(outfile,f90files,modnames,mod) + else: + print_makefile(outfile,f90files,modrnames,obj_ext) + + outfile.close() diff --git a/components/cism/glimmer-cism/utils/isostasy/README b/components/cism/glimmer-cism/utils/isostasy/README new file mode 100644 index 0000000000..a645e150cc --- /dev/null +++ b/components/cism/glimmer-cism/utils/isostasy/README @@ -0,0 +1,4 @@ +This directory contains the file relaxed.F90, from the original Glimmer release. +This is a utility to add relaxed bedrock topography to netCDF input files. +It has not been tested recently, but is retained in case it may be useful in the future. + diff --git a/components/cism/glimmer-cism/utils/isostasy/relaxed_topo.F90 b/components/cism/glimmer-cism/utils/isostasy/relaxed_topo.F90 new file mode 100644 index 0000000000..dd1079bdac --- /dev/null +++ b/components/cism/glimmer-cism/utils/isostasy/relaxed_topo.F90 @@ -0,0 +1,379 @@ +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! relaxed_topo.F90 - part of the Community Ice Sheet Model (CISM) +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! +! Copyright (C) 2005-2014 +! CISM contributors - see AUTHORS file for list of contributors +! +! This file is part of CISM. +! +! CISM is free software: you can redistribute it and/or modify it +! under the terms of the Lesser GNU General Public License as published +! by the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! CISM is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! Lesser GNU General Public License for more details. +! +! You should have received a copy of the Lesser GNU General Public License +! along with CISM. If not, see . +! +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +#ifdef HAVE_CONFIG_H +#include "config.inc" +#endif + +#define NCI infile%nc +#define NCO outfile%nc + +program relaxed_topo + + ! utility to add relaxed bedrock topography to netcdf input files + + use glimmer_global, only: dp + use glimmer_ncdf + use glimmer_ncinfile + use glimmer_ncfile + use glimmer_types + use glimmer_setup + use glimmer_cfproj + use netcdf + use glimmer_paramets, only: len0 + implicit none + + ! File-handling stuff + + integer unit, status + type(glimmer_nc_input), pointer :: infile + type(glimmer_nc_output), pointer :: outfile + type(glimmer_global_type) :: model + + ! Array + + real(dp),dimension(:,:),allocatable :: depr + + ! Densities of ice, ocean and mantle + + real(dp), parameter :: rhoi = 910.0d0 + real(dp), parameter :: rhoo = 1028.0d0 + real(dp), parameter :: rhom = 3300.0d0 + + ! Other parameters + + integer :: nx,ny,i,j,dimsize + logical :: flex = .true. + + ! Allocate pointer variables + + allocate(infile,outfile) + + ! Get some input parameters + + Print*,'relaxed_topo - utility to add relaxed bedrock topography to netcdf input files' + Print*,'Name of input file:' + Read*,NCI%filename + Print*,'Name of output file:' + Read*,NCO%filename + + ! Open an input file and retrieve parameters + status = nf90_open(NCI%filename,NF90_NOWRITE,NCI%id) + ! getting ids + status = nf90_inq_dimid(NCI%id, 'x1', NCI%x1dim) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_inq_dimid(NCI%id, 'y1', NCI%y1dim) + call nc_errorhandle(__FILE__,__LINE__,status) + ! getting dimensions + status = nf90_inquire_dimension(NCI%id,NCI%x1dim,len=model%general%ewn) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_inquire_dimension(NCI%id,NCI%y1dim,len=model%general%nsn) + call nc_errorhandle(__FILE__,__LINE__,status) + ! close file + status = nf90_close(NCI%id) + + ! Allocate necessary arrays + + model%general%upn=1 + call allocarr(model) + allocate(depr(model%general%ewn,model%general%nsn)) + + ! Reopen file + + call glimmer_nc_openfile(infile,model) + + ! Read data + + call glimmer_nc_read(infile,model,.false.) + + ! Get projection data + + model%projection=CFproj_GetProj(NCI%id) + + ! Calculate thickness + + where (model%climate%out_mask == 1.d0) + model%geometry%thck = max(0.d0, (model%climate%presusrf - model%geometry%topg) ) + elsewhere + model%geometry%thck = 0.d0 + end where + + ! Do flexure of some kind + + if (flex) then + + ! calculate present-day load (ice plus ocean) + call flextopg(0,depr,model%geometry%thck,model%geometry%topg,rhoo,rhoi,rhom,model%numerics%dew,model%numerics%dns) + + ! rebound the bedrock + model%geometry%relx = model%geometry%topg - depr + + ! calculate load from ocean + call flextopg(1,depr,model%geometry%thck,model%geometry%relx,rhoo,rhoi,rhom,model%numerics%dew,model%numerics%dns) + + ! depress bedrock using this load + model%geometry%relx = model%geometry%relx + depr + + ! Flatten masked areas + + where (model%climate%out_mask==0.d0) + model%geometry%relx=min(-1.0,model%geometry%relx) + end where + + else + + where (model%geometry%thck > 0.d0) + model%geometry%relx = model%geometry%topg + model%geometry%thck * rhoi / rhom + elsewhere + model%geometry%relx = model%geometry%topg + end where + + where (model%geometry%relx < 0.d0 .and. model%geometry%thck > 0.d0) + model%geometry%relx = model%geometry%relx * rhom / (rhom - rhoo) + end where + + end if + + + ! Copy some data to the output structure + + NCO%do_var= NCI%do_var + + ! Create new file + model%numerics%dew = model%numerics%dew / len0 + model%numerics%dns = model%numerics%dns / len0 + call glimmer_nc_createfile(outfile, model) + + status = nf90_put_var(NCO%id, NCO%varids(NC_B_TOPG), model%geometry%topg, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + + status = nf90_put_var(NCO%id, NCO%timevar, 0.d0, (/1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + + if (NCI%do_var(NC_B_LAT)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_LAT), model%climate%lati, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + if (NCI%do_var(NC_B_RELX)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_RELX), model%geometry%relx, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + if (NCI%do_var(NC_B_USURF)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_USURF), model%geometry%usrf, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + if (NCI%do_var(NC_B_PRESPRCP)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_PRESPRCP), model%climate%presprcp, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + if (NCI%do_var(NC_B_PRESUSRF)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_PRESUSRF), model%climate%presusrf, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + if (NCI%do_var(NC_B_MASK)) then + status = nf90_put_var(NCO%id, NCO%varids(NC_B_MASK), model%climate%out_mask, (/1,1,1/)) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + status = nf90_close(NCO%id) + +contains + + subroutine flextopg(flag,flex,thck,topg,rhoo,rhoi,rhom,dew,dns) + + use glimmer_physcon, only: grav, pi + implicit none + + ! Arguments + + integer, intent(in) :: flag + real(dp), dimension(:,:), intent(out) :: flex + real(dp), dimension(:,:), intent(in) :: thck + real(dp), dimension(:,:), intent(in) :: topg + real(dp), intent(in) :: rhoo + real(dp), intent(in) :: rhoi + real(dp), intent(in) :: rhom + real(dp), intent(in) :: dew + real(dp), intent(in) :: dns + + integer :: ew, ns,nsn,ewn + + real(dp), save :: thklim = 100.0d0 +!! real(dp), parameter :: grav = 9.81 +!! real(dp), parameter :: pi = 3.1416 + + integer :: ewpt, nspt, ewflx, nsflx, ikelv + integer, save :: nflx + + integer, parameter :: nkelv = 82 + + ! ** constants used in calc + + ! ** Young's modulus (Nm^-2) + ! ** thickness of lithosphere (m) + ! ** radius of lithosphere (m) + ! ** Poisson's ratio + + real(dp), parameter :: youngs = 8.35d10 + real(dp), parameter :: thklith = 110.0d3 + real(dp), parameter :: radlith = 6.244d6 + real(dp), parameter :: poiss = 0.25d0 + real(dp), parameter :: dkelv = 0.1d0 + + ! ** zero order kelvin function (for every dkelv from 0.0 to 8.0) + + real(dp), parameter, dimension(nkelv) :: & + kelvin0 = (/ -0.785, -0.777, -0.758, -0.733, -0.704, & + -0.672, -0.637, -0.602, -0.566, -0.531, & + -0.495, -0.460, -0.426, -0.393, -0.362, & + -0.331, -0.303, -0.275, -0.249, -0.225, & + -0.202, -0.181, -0.161, -0.143, -0.126, & + -0.111, -0.096, -0.083, -0.072, -0.061, & + -0.051, -0.042, -0.035, -0.028, -0.021, & + -0.016, -0.011, -0.007, -0.003, 0.000, & + 0.002, 0.004, 0.006, 0.008, 0.009, & + 0.010, 0.010, 0.011, 0.011, 0.011, & + 0.011, 0.011, 0.011, 0.011, 0.010, & + 0.010, 0.009, 0.009, 0.008, 0.008, & + 0.007, 0.007, 0.006, 0.006, 0.005, & + 0.005, 0.004, 0.004, 0.003, 0.003, & + 0.003, 0.002, 0.002, 0.002, 0.002, & + 0.001, 0.001, 0.001, 0.001, 0.001, & + 0.000, 0.000 /) + + real(dp), dimension(:,:), allocatable, save :: dflct + + ! ** quantities calculated + + ! ** flexural rigidity + ! ** radius of stiffness + ! ** multiplier for loads + + real(dp) :: rigid, alpha, multi, dist, load + + logical, save :: first = .true. + + ! ******* CODE STARTS HERE ******** + + nsn=size(flex,2) ; ewn=size(flex,1) + + if (first) then + + rigid = (youngs * thklith**3) / (12.d0 * (1.d0 - poiss**2)) + + alpha = (rigid / ((youngs * thklith / radlith**2) + rhom * grav))**0.25d0 + + multi = grav * dew**2 * alpha**2 / (2.d0 * pi * rigid) + + nflx = 7 * int(alpha / dew) + 1 + + allocate(dflct(nflx,nflx)) + + do nsflx = 1,nflx + do ewflx = 1,nflx + + dist = dew * sqrt(real(ewflx-1)**2 + real(nsflx-1)**2) / alpha + + ikelv = min(nkelv-1,int(dist/dkelv) + 1) + + dflct(ewflx,nsflx) = multi * & + (kelvin0(ikelv) + & + (dist - dkelv * (ikelv-1)) * & + (kelvin0(ikelv+1)- kelvin0(ikelv)) / dkelv) + + end do + end do + + first = .false. + + end if + + flex = 0.0 + + ! ** now loop through all of the points on the model grid + + do ns = 1,nsn + do ew = 1,ewn + + ! ** for each point find the load it is imposing which + ! ** depends on whether there it is ice covered or ocean + ! ** covered + + ! flag == 0 + ! calculate present-day load from ice and ocean water + ! flag == 1 + ! calculate past load from ocean alone + + if (flag == 0) then + + load = rhoi * thck(ew,ns) + + else + + if (thck(ew,ns) > 0.0d0 .and. topg(ew,ns) < 0.0d0) then + load = - rhoo * topg(ew,ns) + else + load = 0.0d0 + end if + + end if + + ! ** now apply the calculated deflection field using the + ! ** ice/ocean load at that point and the function of + ! ** how it will affect its neighbours + + ! ** the effect is linear so that we can sum the deflection + ! ** from all imposed loads + + ! ** only do this if there is a load to impose and + ! ** be careful not to extend past grid domain + + do nsflx = max(1,ns-nflx+1), min(nsn,ns+nflx-1) + do ewflx = max(1,ew-nflx+1), min(ewn,ew+nflx-1) + + ! ** find the correct function value to use + ! ** the array dflct is one quadrant of the a square + ! ** centered at the point imposing the load + + nspt = abs(ns - nsflx) + 1 + ewpt = abs(ew - ewflx) + 1 + + flex(ewflx,nsflx) = load * dflct(ewpt,nspt) + flex(ewflx,nsflx) + + end do + end do + + end do + end do + + end subroutine flextopg + +end program relaxed_topo diff --git a/components/cism/glimmer-cism/utils/libgptl/COPYING b/components/cism/glimmer-cism/utils/libgptl/COPYING new file mode 100644 index 0000000000..94a9ed024d --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/components/cism/glimmer-cism/utils/libgptl/ChangeLog b/components/cism/glimmer-cism/utils/libgptl/ChangeLog new file mode 100644 index 0000000000..81bb3d4b50 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/ChangeLog @@ -0,0 +1,150 @@ +timing_130827: added routines supporting non-null terminated timer labels, for use with + with C++ std:string (and more efficient usage with Fortran); also CMake + logic fixes + [Patrick Worley] +timing_130506: Copy all modules to the include directory on install +timing_130417: Made nano time the default timer if available. +timing_130316: Changed declarations of functions used in qsort in gptl.c, to eliminate + error with Cray compiler (and warnings from other compilers) + [Patrick Worley] +timing_130214: NAG port: Put mpif.h include before "save", and don't use + "abort" and "flush" extensions for NAG. [Sean Patrick Santos] +timing_120921: Add code for cmake build, should not have any affect otherwise +timing_120731: Correction in Makefile for serial build [Jim Edwards] +timing_120728: Replace process subset optional parameter in t_prf with + outpe_thispe optional parameter. Change def_perf_outpe_num to 0. + [Patrick Worley] +timing_120717: Retain timestamp on cp in Makefile [Jim Edwards] +timing_120710: Correct issue in Makefile [Jim Edwards] +timing_120709: Change for BGP to measure on compute nodes rather than IO nodes only, + minor Change in Makefile so that gptl can build seperate from csm_share + in cesm [Jim Edwards] +timing_120512: Bug fix in global statistics logic for when a thread has no events + to contribute to the merge (mods to gptl.c) + [Patrick Worley] +timing_120419: Minor changes for mpi-serial compile (jedwards) +timing_120408: Make HAVE_COMM_F2C default to true. (jedwards) +timing_120110: Update to GPTL 4.1 source (mods to gptl.c and GPTLprint_memusage) + [Jim Rosinski (GPTL 4.1), Patrick Worley] +timing_120109: Bug fix (adding shr_kind_i8 to shr_kind_mod list) +timing_111205: Update to gptl 4.0 (introducing CESM customizations); + support for handles in t_startf/t_stopf; + support for restricting output to explicitly named process subsets + [Jim Rosinski (gptl 4.0), Patrick Worley] +timing_111101: Workaround for mpi_rsend issue on cray/gemini +timing_110928: Add a Makefile and build as a library usable by mct and pio +timing_101215: No changes from previous tag other than updating Changelog +timing_101210: Fix interface to cesm build system, add workaround for xlf bug +timing_101202: updated get_memusage and print_memusage from GPTL version 3.7; adds + improved support for MacOS and SLASHPROC + [Jim Rosinski, Chuck Bardeen (integrated by P. Worley)] +timing_091021: update to GPTL version 3.5; rewrite of GPTLpr_summary: much faster, merging + events from all processes and all threads (not just process 0/thread 0); + miscellaneous fixes + [Jim Rosinski (gptl 3.5), Joseph Singh, Patrick Worley] +timing_090929: added explicit support for the GPTL-native token HAVE_MPI (indicating + presence of MPI library) + [Patrick Worley] +timing_081221: restore default assumption that gettimeofday available +timing_081028: bug fix in include order in gptl_papi.c +timing_081026: change in output format to make postprocessing simpler +timing_081024: support for up to one million processes and writing timing files to + subdirectories +timing_081017: updated to gptl version 3_4_2. Changed some defaults. + [Jim Rosinski, Patrick Worley] +timing_080629: added optional parameters perf_outpe_num and perf_outpe_stride to t_prf. + These are used to override the user specified values for timing data + written out before the end of a simulation. + [Patrick Worley] +timing_071213: changed default to disable inline keyword; changed global statistics + logic to avoid problems at scale; moved shr and CAM routine equivalencies + to a new module (in perf_utils.F90); added t_getLogUnit/t_setLogUnit + routines to control Log output in same way as shr_file_get/setLogUnit; + modified GPTLpr logic to support output of timing data during a run + [Patrick Worley] +timing_071023: updated to gptl version 2.16, added support for output of global + statistics; removed dependencies on shr and CAM routines; renamed + gptlutil.c to GPTLutil.c + [Patrick Worley, Jim Rosinski] +timing_071019: modified namelist logic to abort if try to set unknown namelist parameters; + changed default number of reporting processes to 1; + reversed meaning and changed names of CPP tokens to NO_C99_INLINE and NO_VPRINTF + [Patrick Worley] +timing_071010: modified gptl.c to remove the 'inline' specification unless the + CPP token C99 is defined. + [Patrick Worley] +timing_070810: added ChangeLog + updated to latest version of GPTL (from Jim Rosinski) + modified perf_mod.F90: + - added perf_outpe_num and perf_outpe_stride to perf_inparm + namelist to control which processes output timing data + - added perf_papi_enable to perf_inparm namelist to enable + PAPI counters + - added papi_inparm namelist and papi_ctr1,2,3,4 namelist + parameters to specify PAPI counters + [Patrick Worley, Jim Rosinski] +timing_070525: bug fix in gptl.c + - unitialized pointer, testing for null pter + before traversing + [Patrick Worley] +timing_070328: modified perf_mod.F90 + - deleted HIDE_MPI cpp token + [Erik Kluzek] +timing_070327: bug fixes in gptl.c + - testing for null pters before traversing + links; added missing type declaration to GPTLallocate for sum + bug fixes in perf_mod.F90 + - fixed OMP-related logic, modified settings reporting, + modified to work when namelist input is + missing; moved timer depth logic back into gptl.c + [Patrick Worley] +timing_070308: added perf_mod.F90 + - defines all t_xxx entry points - calling gptlxxx directly + and removing all external gptlxxx dependencies, + added detail option as an alternative way to disable + event timing, added runtime selection of timing_disable, + perf_timer, timer_depth_limit, timing_detail_limit, + timing_barrier, perf_single_file via namelist parameters + modified f_wrappers.c + - replaced all t_xxx entry points with gptlxxx entry points, + added new gptlxxx entry points, deleted _fcd support + modified gptl.c + - deleted DISABLE_TIMERS cpp token, modified GPTLpr call + and logic to move some of support for concatenating timing + output into a single file to perf_mod.F90 + modified gptl.h + - exposed gptlxxx entry points and to add support for choice + of GPTL timer + modified gptl.inc + - removed t_xxx entry points and expose gptlxxx entry points + [Patrick Worley] +timing_061207: modified gptl.c + - improved event output ordering + [Jim Edwards] +timing_061124: modified gptl.c + - modified GPTLpr to add option to concatenate + all timing data in a single output file, added GPTL_enable + and GPTL_disable as runtime control of event timing, + process 0-only reporting of timing options - unless DEBUG + cpp token defined + modified gptl.h + - redefined GPTLpr parameters + modified f_wrappers.c + - added t_enablef and t_disablef to call GPTL_enable and + GPTL_disable, added t_pr_onef, added string.h include + bug fix in f_wrappers.c + - changed character string size declaration from int to size_t + bug fix in gptl_papi.c + - modified error message - from Jim Edwards + modified private.h + - increased maximum event name length + [Patrick Worley] +timing_061028: modified f_wrappers.c + - deleted dependency on cfort.h + [Patrick Worley] +timing_060524: modified f_wrappers.c + - added support for CRAY cpp token and fixed routine + type declarations + [Patrick Worley] +timing_051212: original subversion version + - see CAM ChangeLog for earlier history diff --git a/components/cism/glimmer-cism/utils/libgptl/GPTLget_memusage.c b/components/cism/glimmer-cism/utils/libgptl/GPTLget_memusage.c new file mode 100644 index 0000000000..4ccdef8b2a --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/GPTLget_memusage.c @@ -0,0 +1,160 @@ +/* +** $Id: get_memusage.c,v 1.10 2010-11-09 19:08:53 rosinski Exp $ +** +** Author: Jim Rosinski +** Credit to Chuck Bardeen for MACOS section (__APPLE__ ifdef) +** +** get_memusage: +** +** Designed to be called from Fortran, returns information about memory +** usage in each of 5 input int* args. On Linux read from the /proc +** filesystem because getrusage() returns placebos (zeros). Return -1 for +** values which are unavailable or ambiguous on a particular architecture. +** +** Return value: 0 = success +** -1 = failure +*/ + +#include +#include "gptl.h" /* additional cpp defs and function prototypes */ + +/* _AIX is automatically defined when using the AIX C compilers */ +#ifdef _AIX +#include +#endif + +#ifdef IRIX64 +#include +#endif + +#ifdef HAVE_SLASHPROC + +#include +#include +#include +#include + +#elif (defined __APPLE__) + +#include +#include +#include + +#endif + +#ifdef BGP + +#include +#include +#include +#include +#define Personality _BGP_Personality_t + +#endif + + +int GPTLget_memusage (int *size, int *rss, int *share, int *text, int *datastack) +{ +#ifdef BGP + + long long alloc; + struct mallinfo m; + Personality pers; + + long long total; + int node_config; + + /* memory available */ + Kernel_GetPersonality(&pers, sizeof(pers)); + total = BGP_Personality_DDRSizeMB(&pers); + + node_config = BGP_Personality_processConfig(&pers); + if (node_config == _BGP_PERS_PROCESSCONFIG_VNM) total /= 4; + else if (node_config == _BGP_PERS_PROCESSCONFIG_2x2) total /= 2; + total *= 1024*1024; + + *size = total; + + /* total memory used - heap only (not static memory)*/ + + m = mallinfo(); + alloc = m.hblkhd + m.uordblks; + + *rss = alloc; + *share = -1; + *text = -1; + *datastack = -1; + + +#elif (defined HAVE_SLASHPROC) + FILE *fd; /* file descriptor for fopen */ + int pid; /* process id */ + static char *head = "/proc/"; /* part of path */ + static char *tail = "/statm"; /* part of path */ + char file[19]; /* full path to file in /proc */ + int dum; /* placeholder for unused return arguments */ + int ret; /* function return value */ + + /* + ** The file we want to open is /proc//statm + */ + + pid = (int) getpid (); + if (pid > 999999) { + fprintf (stderr, "get_memusage: pid %d is too large\n", pid); + return -1; + } + + sprintf (file, "%s%d%s", head, pid, tail); + if ((fd = fopen (file, "r")) < 0) { + fprintf (stderr, "get_memusage: bad attempt to open %s\n", file); + return -1; + } + + /* + ** Read the desired data from the /proc filesystem directly into the output + ** arguments, close the file and return. + */ + + ret = fscanf (fd, "%d %d %d %d %d %d %d", + size, rss, share, text, datastack, &dum, &dum); + ret = fclose (fd); + return 0; + +#elif (defined __APPLE__) + + FILE *fd; + char cmd[60]; + int pid = (int) getpid (); + + sprintf (cmd, "ps -o vsz -o rss -o tsiz -p %d | grep -v RSS", pid); + fd = popen (cmd, "r"); + + if (fd) { + fscanf (fd, "%d %d %d", size, rss, text); + *share = -1; + *datastack = -1; + (void) pclose (fd); + } + + return 0; + +#else + + struct rusage usage; /* structure filled in by getrusage */ + + if (getrusage (RUSAGE_SELF, &usage) < 0) + return -1; + + *size = -1; + *rss = usage.ru_maxrss; + *share = -1; + *text = -1; + *datastack = -1; +#ifdef IRIX64 + *datastack = usage.ru_idrss + usage.ru_isrss; +#endif + return 0; + +#endif +} diff --git a/components/cism/glimmer-cism/utils/libgptl/GPTLprint_memusage.c b/components/cism/glimmer-cism/utils/libgptl/GPTLprint_memusage.c new file mode 100644 index 0000000000..5ab873dccb --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/GPTLprint_memusage.c @@ -0,0 +1,120 @@ +/* +** $Id: print_memusage.c,v 1.13 2010-11-09 19:08:54 rosinski Exp $ +** +** Author: Jim Rosinski +** +** print_memusage: +** +** Prints info about memory usage of this process by calling get_memusage. +** +** Return value: 0 = success +** -1 = failure +*/ + +#include "gptl.h" +#include +#include +#include + +static int nearest_powerof2 (const int); +static int convert_to_mb = 1; /* true */ + +int GPTLprint_memusage (const char *str) +{ + int size, size2; /* process size (returned from OS) */ + int rss, rss2; /* resident set size (returned from OS) */ + int share, share2; /* shared data segment size (returned from OS) */ + int text, text2; /* text segment size (returned from OS) */ + int datastack, datastack2; /* data/stack size (returned from OS) */ + static int bytesperblock = -1; /* convert to bytes (init to invalid) */ + static const int nbytes = 1024*1024*10; /* allocate 10 MB */ + static double blockstomb; /* convert blocks to MB */ + void *space; /* allocated space */ + + if (GPTLget_memusage (&size, &rss, &share, &text, &datastack) < 0) + return -1; + +#if (defined HAVE_SLASHPROC || defined __APPLE__) + /* + ** Determine size in bytes of memory usage info presented by the OS. Method: allocate a + ** known amount of memory and see how much bigger the process becomes. + */ + + if (convert_to_mb && bytesperblock == -1 && (space = malloc (nbytes))) { + memset (space, 0, nbytes); /* ensure the space is really allocated */ + if (GPTLget_memusage (&size2, &rss2, &share2, &text2, &datastack2) == 0) { + if (size2 > size) { + /* + ** Estimate bytes per block, then refine to nearest power of 2. + ** The assumption is that the OS presents memory usage info in + ** units that are a power of 2. + */ + bytesperblock = (int) ((nbytes / (double) (size2 - size)) + 0.5); + bytesperblock = nearest_powerof2 (bytesperblock); + blockstomb = bytesperblock / (1024.*1024.); + printf ("GPTLprint_memusage: Using bytesperblock=%d\n", bytesperblock); + } + } + free (space); + } + + if (bytesperblock > 0) + printf ("%s size=%.1f MB rss=%.1f MB share=%.1f MB text=%.1f MB datastack=%.1f MB\n", + str, size*blockstomb, rss*blockstomb, share*blockstomb, + text*blockstomb, datastack*blockstomb); + else + printf ("%s size=%d rss=%d share=%d text=%d datastack=%d\n", + str, size, rss, share, text, datastack); + +#else + + /* + ** Use max rss as returned by getrusage. If someone knows how to + ** get the process size under AIX please tell me. + */ + + bytesperblock = 1024; + blockstomb = bytesperblock / (1024.*1024.); + if (convert_to_mb) + printf ("%s max rss=%.1f MB\n", str, rss*blockstomb); + else + printf ("%s max rss=%d\n", str, rss); +#endif + + return 0; +} + +/* +** nearest_powerof2: +** Determine nearest integer which is a power of 2. +** Note: algorithm can't use anything that requires -lm because this is a library, +** and we don't want to burden the user with having to add extra libraries to the +** link line. +** +** Input arguments: +** val: input integer +** +** Return value: nearest integer to val which is a power of 2 +*/ + +static int nearest_powerof2 (const int val) +{ + int lower; /* power of 2 which is just less than val */ + int higher; /* power of 2 which is just more than val */ + int delta1; /* difference between val and lower */ + int delta2; /* difference between val and higher */ + + if (val < 2) + return 0; + + for (higher = 1; higher < val; higher *= 2) + lower = higher; + + delta1 = val - lower; + delta2 = higher - val; + + if (delta1 < delta2) + return lower; + else + return higher; +} diff --git a/components/cism/glimmer-cism/utils/libgptl/GPTLutil.c b/components/cism/glimmer-cism/utils/libgptl/GPTLutil.c new file mode 100644 index 0000000000..b1c7cf80df --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/GPTLutil.c @@ -0,0 +1,82 @@ +/* +** $Id: util.c,v 1.13 2010-01-01 01:34:07 rosinski Exp $ +*/ + +#include +#include +#include + +#include "private.h" + +static bool abort_on_error = false; /* flag says to abort on any error */ +static int max_error = 500; /* max number of error print msgs */ + +/* +** GPTLerror: error return routine to print a message and return a failure +** value. +** +** Input arguments: +** fmt: format string +** variable list of additional arguments for vfprintf +** +** Return value: -1 (failure) +*/ + +int GPTLerror (const char *fmt, ...) +{ + va_list args; + + va_start (args, fmt); + static int num_error = 0; + + if (fmt != NULL && num_error < max_error) { +#ifndef NO_VPRINTF + (void) vfprintf (stderr, fmt, args); +#else + (void) fprintf (stderr, "GPTLerror: no vfprintf: fmt is %s\n", fmt); +#endif + if (num_error == max_error) + (void) fprintf (stderr, "Truncating further error print now after %d msgs", + num_error); + ++num_error; + } + + va_end (args); + + if (abort_on_error) + exit (-1); + + return (-1); +} + +/* +** GPTLset_abort_on_error: User-visible routine to set abort_on_error flag +** +** Input arguments: +** val: true (abort on error) or false (don't) +*/ + +void GPTLset_abort_on_error (bool val) +{ + abort_on_error = val; +} + +/* +** GPTLallocate: wrapper utility for malloc +** +** Input arguments: +** nbytes: size to allocate +** +** Return value: pointer to the new space (or NULL) +*/ + +void *GPTLallocate (const int nbytes) +{ + void *ptr; + + if ( nbytes <= 0 || ! (ptr = malloc (nbytes))) + (void) GPTLerror ("GPTLallocate: malloc failed for %d bytes\n", nbytes); + + return ptr; +} + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile.aix b/components/cism/glimmer-cism/utils/libgptl/Makefile.aix new file mode 100644 index 0000000000..c9706fd038 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile.aix @@ -0,0 +1,39 @@ +.SUFFIXES: +.SUFFIXES: .F .F90 .c .o + +CPPDEF := -DAIX -DSPMD -DHAVE_COMM_F2C + +FC := mpxlf90_r +CC := mpcc_r +FFLAGS := $(CPPDEF) -q64 -qarch=auto +CFLAGS := $(CPPDEF) -q64 -qkeyword=inline +FREEFLAGS := -qsuffix=f=f90:cpp=F90 +FIXEDFLAGS := -qfixed=132 + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) -I. $< +.F.o: + $(FC) -c $(FIXEDFLAGS) $(FFLAGS) -I. $< +.c.o: + $(CC) -c $(CFLAGS) -I. $< + +#------------------------------------------------------------------------ +# Targets/rules that depend on architecture specific variables. +#------------------------------------------------------------------------ + +OBJS := GPTLget_memusage.o GPTLprint_memusage.o GPTLutil.o f_wrappers.o \ + gptl.o gptl_papi.o perf_utils.o perf_mod.o +RM := rm +AR := ar +ARFLAGS := -rc +RANLIB := ranlib + +all: libgptl.a + +libgptl.a : $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + $(RANLIB) $@ + +clean: + $(RM) -f *.o *.mod *.a + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl new file mode 100644 index 0000000000..7ddffd5212 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl @@ -0,0 +1,38 @@ +.SUFFIXES: +.SUFFIXES: .F .F90 .c .o + +CPPDEF := -DLINUX -DFORTRANUNDERSCORE -DSPMD -DHAVE_NANOTIME -DBIT64 -DHAVE_COMM_F2C + +FC := ftn -mp +CC := cc -mp +FFLAGS := -i4 -Mdalign -Mextend -byteswapio $(CPPDEF) +CFLAGS := $(CPPDEF) +FREEFLAGS := -Mfree + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) -I. $< +.F.o: + $(FC) -c $(FFLAGS) -I. $< +.c.o: + $(CC) -c $(CFLAGS) -I. $< + +#------------------------------------------------------------------------ +# Targets/rules that depend on architecture specific variables. +#------------------------------------------------------------------------ + +OBJS := GPTLget_memusage.o GPTLprint_memusage.o GPTLutil.o f_wrappers.o \ + gptl.o gptl_papi.o perf_utils.o perf_mod.o +RM := rm +AR := ar +ARFLAGS := -rc +RANLIB := ranlib + +all: libgptl.a + +libgptl.a : $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + $(RANLIB) $@ + +clean: + $(RM) -f *.o *.mod *.a + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_gnu b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_gnu new file mode 100644 index 0000000000..e8b96fb7e7 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_gnu @@ -0,0 +1,40 @@ +.SUFFIXES: +.SUFFIXES: .F .F90 .c .o + +CPPDEF := -DLINUX -DFORTRANUNDERSCORE -DSPMD -DHAVE_NANOTIME -DBIT64 -DHAVE_COMM_F2C + +FC := ftn -fopenmp +CC := cc -fopenmp +# FFLAGS := -i4 -Mdalign -Mextend -byteswapio $(CPPDEF) +FFLAGS := $(CPPDEF) +CFLAGS := $(CPPDEF) +# FREEFLAGS := -Mfree +FREEFLAGS := + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) -I. $< +.F.o: + $(FC) -c $(FFLAGS) -I. $< +.c.o: + $(CC) -c $(CFLAGS) -I. $< + +#------------------------------------------------------------------------ +# Targets/rules that depend on architecture specific variables. +#------------------------------------------------------------------------ + +OBJS := GPTLget_memusage.o GPTLprint_memusage.o GPTLutil.o f_wrappers.o \ + gptl.o gptl_papi.o perf_utils.o perf_mod.o +RM := rm +AR := ar +ARFLAGS := -rc +RANLIB := ranlib + +all: libgptl.a + +libgptl.a : $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + $(RANLIB) $@ + +clean: + $(RM) -f *.o *.mod *.a + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_wpapi b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_wpapi new file mode 100644 index 0000000000..a4fb2d4ec9 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile.crayxt_cnl_wpapi @@ -0,0 +1,38 @@ +.SUFFIXES: +.SUFFIXES: .F .F90 .c .o + +CPPDEF := -DLINUX -DFORTRANUNDERSCORE -DSPMD -DHAVE_PAPI -DHAVE_NANOTIME -DBIT64 -DHAVE_COMM_F2C + +FC := ftn -mp +CC := cc -mp +FFLAGS := -i4 -Mdalign -Mextend -byteswapio $(CPPDEF) +CFLAGS := $(CPPDEF) +FREEFLAGS := -Mfree + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) -I. $< +.F.o: + $(FC) -c $(FFLAGS) -I. $< +.c.o: + $(CC) -c $(CFLAGS) -I. $< + +#------------------------------------------------------------------------ +# Targets/rules that depend on architecture specific variables. +#------------------------------------------------------------------------ + +OBJS := GPTLget_memusage.o GPTLprint_memusage.o GPTLutil.o f_wrappers.o \ + gptl.o gptl_papi.o perf_utils.o perf_mod.o +RM := rm +AR := ar +ARFLAGS := -rc +RANLIB := ranlib + +all: libgptl_wpapi.a + +libgptl_wpapi.a : $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + $(RANLIB) $@ + +clean: + $(RM) -f *.o *.mod *.a + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile.mac b/components/cism/glimmer-cism/utils/libgptl/Makefile.mac new file mode 100644 index 0000000000..bc66e831dc --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile.mac @@ -0,0 +1,40 @@ +.SUFFIXES: +.SUFFIXES: .F .F90 .c .o + +CPPDEF := -DFORTRANUNDERSCORE -DSPMD -DBIT64 -DHAVE_COMM_F2C -I/opt/local/include/openmpi +#-DHAVE_NANOTIME +FC := mpif90 +CC := mpicc +# FFLAGS := -i4 -Mdalign -Mextend -byteswapio $(CPPDEF) +FFLAGS := $(CPPDEF) +CFLAGS := $(CPPDEF) +# FREEFLAGS := -Mfree +FREEFLAGS := + +.F90.o: + $(FC) -c $(FREEFLAGS) $(FFLAGS) -I. $< +.F.o: + $(FC) -c $(FFLAGS) -I. $< +.c.o: + $(CC) -c $(CFLAGS) -I. $< + +#------------------------------------------------------------------------ +# Targets/rules that depend on architecture specific variables. +#------------------------------------------------------------------------ + +OBJS := GPTLget_memusage.o GPTLprint_memusage.o GPTLutil.o f_wrappers.o \ + gptl.o gptl_papi.o perf_utils.o perf_mod.o +RM := rm +AR := ar +ARFLAGS := -rc +RANLIB := ranlib + +all: libgptl.a + +libgptl.a : $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + $(RANLIB) $@ + +clean: + $(RM) -f *.o *.mod *.a + diff --git a/components/cism/glimmer-cism/utils/libgptl/Makefile_cesm b/components/cism/glimmer-cism/utils/libgptl/Makefile_cesm new file mode 100644 index 0000000000..5dd37693fa --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/Makefile_cesm @@ -0,0 +1,54 @@ +.SUFFIXES: +.SUFFIXES: .F90 .o .c .f90 +# name of macros file - but default this is generic + +VPATH := $(GPTL_DIR) + +ifeq ($(strip $(MACFILE)),) + MACFILE := Macros +endif + +# Machine specific macros file +# This must be included before any settings are overwritten +# But must be AFTER any definitions it uses are defined. +# So be careful if moving this either earlier or later in the makefile!!! +include $(MACFILE) + + +OBJS = gptl.o GPTLutil.o GPTLget_memusage.o GPTLprint_memusage.o \ + gptl_papi.o f_wrappers.o perf_mod.o perf_utils.o + + +libgptl.a: $(OBJS) + $(AR) ruv $@ $(OBJS) + + + +.c.o: + $(CC) -c $(INCLDIR) $(INCS) $(CFLAGS) $(CPPDEFS) $< +.F.o: + $(FC) -c $(INCLDIR) $(INCS) $(FFLAGS) $(FPPDEFS) $(FIXEDFLAGS) $< +.f90.o: + $(FC) -c $(INCLDIR) $(INCS) $(FFLAGS) $(FREEFLAGS) $< +.F90.o: + $(FC) -c $(INCLDIR) $(INCS) $(FFLAGS) $(FPPDEFS) $(FREEFLAGS) $< + +mostlyclean: + $(RM) -f *.f *.f90 + +clean: + $(RM) -f *.f *.f90 *.d *.$(MOD_SUFFIX) $(OBJS) + + +install: libgptl.a + cp perf_mod.$(MOD_SUFFIX) $(INCROOT) + cp libgptl.a $(LIBROOT) + + +perf_mod.o: perf_utils.o +f_wrappers.o: gptl.h private.h +f_wrappers_pmpi.o: gptl.h private.h +gptl.o: gptl.h private.h +util.o: gptl.h private.h +gptl_papi.o: gptl.h private.h +pmpi.o: gptl.h private.h diff --git a/components/cism/glimmer-cism/utils/libgptl/README b/components/cism/glimmer-cism/utils/libgptl/README new file mode 100644 index 0000000000..2f0991da21 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/README @@ -0,0 +1,143 @@ +This file contains information about using GPTL. For information on building +and installing GPTL, see the file INSTALL. + +GPTL is the "General Purpose Timing Library". It can be used to manually +instrument application codes with an arbitrary set of "regions" (or "timers") +over which statistics such as wallclock time and CPU time are gathered and +subsequently printed. If the target application is built with the GNU +compilers (gcc or gfortran) or Pathscale (pathcc or pathf95), GPTL can also be +used to automatically instrument regions which are defined by function entry +and exit points. This is an easy way to generate a dynamic call tree. See +Auto-Instrumentation below for a description of how to use this feature. + +If the PAPI library is installed (http://icl.cs.utk.edu/papi), GPTL +also provides a convenient mechanism to access all available PAPI events. In +addtion to PAPI preset and native events, GPTL defines derived events which +are based on PAPI counters. See gptl.h for a list of available derived events. +Of course these events can only be enabled if the PAPI counters they require +are available on the target architecture. + + +Using GPTL +---------- + +C codes making GPTL library calls should #include . Fortran codes +should #include or Fortran include 'gptl.inc'. The C and Fortran interfaces +are identical, except that the C interface uses mixed case. All +user-accessible functions return either 0 (success) or -1 (failure). Example +codes that use the library can be found in subdirectories ctests/ and ftests/. + +Code instrumentation to utilize GPTL involves zero or more calls to +GPTLsetoption(), then a single call to GPTLinitialize(), then an arbitrary +sequence of calls to GPTLstart() and GPTLstop(), and finally a call to +GPTLpr() or GPTLpr_file(). See "Example" below for a sample calling +sequence. Calls to GPTLstart() and GPTLstop() are thread-safe, with per-thread +statistics printed by GPTLpr() or GPTLpr_file(). + +The purpose of GPTLsetoption() is to enable or disable various library +options. For example, to enable the PAPI counter for total cycles, do this: + +ret = GPTLsetoption (PAPI_TOT_CYC, 1); + +The "1" says "enable". Use "0" for "disable". See the man pages for complete +documentation on function usage and arguments. The list of available GPTL +options is contained in gptl.h, and a complete list of available PAPI-based +events can be found by running "ctests/avail". + +GPTLinitialize() initializes the GPTL library. + +There can be an arbitrary number of start/stop pairs before GPTLpr() or +GPTLpr_file() is called to print the results. And an arbitrary amount of +nesting of regions is also allowed. The printed results will be indented to +indicate the level of nesting for each region. + +GPTLpr() prints the results to a file named timing., where the single +argument is an integer. For MPI jobs, it is most convenient to use +the MPI rank of the invoking task for . Equivalently, function +GPTLpr_file() can be called. Its input argument is a character string +indicating the output file name to be written. It is up to the user to ensure +that these print functions write to uniquely-named files, in order to avoid +name-space collisions. + +GPTLfinalize() can be called to clean up the GPTL environment. All space +malloc'ed by the GPTL library will be freed by this call. + + +Example +------- + +From "man GPTLstart", a simple example calling sequence to time a couple of +code regions and print the results is: + +(void) GPTLsetoption (GPTLcpu, 1); /* enable cpu timings */ +(void) GPTLsetoption (GPTLwall, 0); /* disable wallclock timings */ +(void) GPTLsetoption (PAPI_TOT_CYC, 1); /* enable counting of total cycles */ +... +(void) GPTLinitialize(); /* initialize the GPTL library */ +(void) GPTLstart ("total"); /* start a timer */ +... +(void) GPTLstart ("do_work"); /* start another timer */ + +do_work(); /* do some work */ + +(void) GPTLstop ("do_work"); /* stop a timer */ +(void) GPTLstop ("total"); /* stop a timer */ +... +(void) GPTLpr (mympitaskid); /* print the results to timing. */ + + +Auto-instrumentation +-------------------- + +If the regions to be timed are defined by function entry and exit points, and +the application to be profiled is built with either the GNU or Pathscale +compilers, you might find it convenient to use the auto-instrumentation +feature of GPTL. Here's how: + +1) Add the flag -finstrument-functions when compiling the routines you'd like +to profile. + +2) Add calls to GPTLsetoption() (if desired), and GPTLinitialize() to the main +program before any other routines are invoked. + +3) Add a call to GPTLpr() or GPTLpr_file() wherever appropriate prior to where +the code terminates. + +4) Link with -lgptl (and -lpapi if PAPI is enabled). + +5) Run the code. + +6) Run "hex2name.pl | less", where + is the name of the executable, and is the name of the +timing file to be converted. + +The result should be a dynamic call tree with timings and (if enabled) PAPI +counts and derived event statistics for each region, where regions are defined +by function entry and exit points. + +Here's what's happening under the covers: + +The -finstrument-functions flag tells the compiler to insert calls to +__cyg_profile_func_enter (void *this_fn, void *call_site) at function start, +and __cyg_profile_func_exit (void *this_fn, void *call_site) at function +exit. GPTL defines these functions as calls to (effectively) GPTLstart() and +GPTLstop(), where the address of the function is used as the input sentinel to +these routines. + +Running hex2name.pl converts the function addresses back to human-readable +function names. It uses the UNIX "nm" utility to do this. + + +Multi-processor instrumented codes +---------------------------------- + +For instrumented codes which make use of threading and/or MPI, a +post-processing script is provided to analyze GPTL output files and gather +max/min/average stats on a per-region basis. The script is parsegptlout.pl. It +might be invoked as, for example: + +parsegptlout.pl sub1 + +The script will look through all files in the current directory named timing.* +for regions named "sub1", then gather and print various statistics. Numerous +options are available. See "man parsegptlout" for more in-depth information. diff --git a/components/cism/glimmer-cism/utils/libgptl/README.CISM b/components/cism/glimmer-cism/utils/libgptl/README.CISM new file mode 100644 index 0000000000..f9e326c96e --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/README.CISM @@ -0,0 +1,14 @@ +General Purpose Timing Library (GPTL) is a third-party library for performing timing. It is included as an optional library that can be built into CISM. This version of GPTL is modified from the version in CESM, which is at least a year behind the official version. Documentation for the official version can be found at this link: http://jmrosinski.github.io/GPTL/ + +To use GPTL with CISM, one first must build the GPTL libraries, and then build CISM with the GPTL libraries linked. + +Building GPTL is completely separate from the CISM build system. To do so, use one of the included Makefiles. Makefile.mac is a generic build for a Mac that may require some adjusting for your system. It could also be modified to work with a Linux machine fairly easily. + +To build CISM with GPTL, add the following flags to your cmake build script: + -D CISM_USE_GPTL_INSTRUMENTATION:BOOL=ON \ + -D CISM_GPTL_DIR=/your/path/to/libgptl \ +Then re-source your build script and re-run make. + +When running with a GPTL-enabled CISM executable, you will see the following additional output files in your run directory that include timing information per processor and overall timing statistics: + cism_timing.N where N is the processor number + cism_timing_stats diff --git a/components/cism/glimmer-cism/utils/libgptl/f_wrappers.c b/components/cism/glimmer-cism/utils/libgptl/f_wrappers.c new file mode 100644 index 0000000000..a823660cd0 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/f_wrappers.c @@ -0,0 +1,545 @@ +/* +** $Id: f_wrappers.c,v 1.56 2010-12-29 18:46:42 rosinski Exp $ +** +** Author: Jim Rosinski +** +** Fortran wrappers for timing library routines +*/ + +#include +#include +#include "private.h" /* MAX_CHARS, bool */ +#include "gptl.h" /* function prototypes and HAVE_MPI logic*/ + +#if ( defined FORTRANCAPS ) + +#define gptlinitialize GPTLINITIALIZE +#define gptlfinalize GPTLFINALIZE +#define gptlpr_set_append GPTLPR_SET_APPEND +#define gptlpr_query_append GPTLPR_QUERY_APPEND +#define gptlpr_set_write GPTLPR_SET_WRITE +#define gptlpr_query_write GPTLPR_QUERY_WRITE +#define gptlpr GPTLPR +#define gptlpr_file GPTLPR_FILE +#define gptlpr_summary GPTLPR_SUMMARY +#define gptlpr_summary_FILE GPTLPR_SUMMARY_FILE +#define gptlbarrier GPTLBARRIER +#define gptlreset GPTLRESET +#define gptlstamp GPTLSTAMP +#define gptlstart GPTLSTART +#define gptlstart_handle GPTLSTART_HANDLE +#define gptlstop GPTLSTOP +#define gptlstop_handle GPTLSTOP_HANDLE +#define gptlsetoption GPTLSETOPTION +#define gptlenable GPTLENABLE +#define gptldisable GPTLDISABLE +#define gptlsetutr GPTLSETUTR +#define gptlquery GPTLQUERY +#define gptlquerycounters GPTLQUERYCOUNTERS +#define gptlget_wallclock GPTLGET_WALLCLOCK +#define gptlget_eventvalue GPTLGET_EVENTVALUE +#define gptlget_nregions GPTLGET_NREGIONS +#define gptlget_regionname GPTLGET_REGIONNAME +#define gptlget_memusage GPTLGET_MEMUSAGE +#define gptlprint_memusage GPTLPRINT_MEMUSAGE +#define gptl_papilibraryinit GPTL_PAPILIBRARYINIT +#define gptlevent_name_to_code GPTLEVENT_NAME_TO_CODE +#define gptlevent_code_to_name GPTLEVENT_CODE_TO_NAME + +#elif ( defined INCLUDE_CMAKE_FCI ) + +#define gptlinitialize FCI_GLOBAL(gptlinitialize,GPTLINITIALIZE) +#define gptlfinalize FCI_GLOBAL(gptlfinalize,GPTLFINALIZE) +#define gptlpr_set_append FCI_GLOBAL(gptlpr_set_append,GPTLPR_SET_APPEND) +#define gptlpr_query_append FCI_GLOBAL(gptlpr_query_append,GPTLPR_QUERY_APPEND) +#define gptlpr_set_write FCI_GLOBAL(gptlpr_set_write,GPTLPR_SET_WRITE) +#define gptlpr_query_write FCI_GLOBAL(gptlpr_query_write,GPTLPR_QUERY_WRITE) +#define gptlpr FCI_GLOBAL(gptlpr,GPTLPR) +#define gptlpr_file FCI_GLOBAL(gptlpr_file,GPTLPR_FILE) +#define gptlpr_summary FCI_GLOBAL(gptlpr_summary,GPTLPR_SUMMARY) +#define gptlpr_summary_file FCI_GLOBAL(gptlpr_summary_file,GPTLPR_SUMMARY_FILE) +#define gptlbarrier FCI_GLOBAL(gptlbarrier,GPTLBARRIER) +#define gptlreset FCI_GLOBAL(gptlreset,GPTLRESET) +#define gptlstamp FCI_GLOBAL(gptlstamp,GPTLSTAMP) +#define gptlstart FCI_GLOBAL(gptlstart,GPTLSTART) +#define gptlstart_handle FCI_GLOBAL(gptlstart_handle,GPTLSTART_HANDLE) +#define gptlstop FCI_GLOBAL(gptlstop,GPTLSTOP) +#define gptlstop_handle FCI_GLOBAL(gptlstop_handle,GPTLSTOP_HANDLE) +#define gptlsetoption FCI_GLOBAL(gptlsetoption,GPTLSETOPTION) +#define gptlenable FCI_GLOBAL(gptlenable,GPTLENABLE) +#define gptldisable FCI_GLOBAL(gptldisable,GPTLDISABLE) +#define gptlsetutr FCI_GLOBAL(gptlsetutr,GPTLSETUTR) +#define gptlquery FCI_GLOBAL(gptlquery,GPTLQUERY) +#define gptlquerycounters FCI_GLOBAL(gptlquerycounters,GPTLQUERYCOUNTERS) +#define gptlget_wallclock FCI_GLOBAL(gptlget_wallclock,GPTLGET_WALLCLOCK) +#define gptlget_eventvalue FCI_GLOBAL(gptlget_eventvalue,GPTLGET_EVENTVALUE) +#define gptlget_nregions FCI_GLOBAL(gptlget_nregions,GPTLGET_NREGIONS) +#define gptlget_regionname FCI_GLOBAL(gptlget_regionname,GPTLGET_REGIONNAME) +#define gptlget_memusage FCI_GLOBAL(gptlget_memusage,GPTLGET_MEMUSAGE) +#define gptlprint_memusage FCI_GLOBAL(gptlprint_memusage,GPTLPRINT_MEMUSAGE) +#define gptl_papilibraryinit FCI_GLOBAL(gptl_papilibraryinit,GPTL_PAPILIBRARYINIT) +#define gptlevent_name_to_code FCI_GLOBAL(gptlevent_name_to_code,GPTLEVENT_NAME_TO_CODE) +#define gptlevent_code_to_name FCI_GLOBAL(gptlevent_code_to_name,GPTLEVENT_CODE_TO_NAME) + +#elif ( defined FORTRANUNDERSCORE ) + +#define gptlinitialize gptlinitialize_ +#define gptlfinalize gptlfinalize_ +#define gptlpr_set_append gptlpr_set_append_ +#define gptlpr_query_append gptlpr_query_append_ +#define gptlpr_set_write gptlpr_set_write_ +#define gptlpr_query_write gptlpr_query_write_ +#define gptlpr gptlpr_ +#define gptlpr_file gptlpr_file_ +#define gptlpr_summary gptlpr_summary_ +#define gptlpr_summary_file gptlpr_summary_file_ +#define gptlbarrier gptlbarrier_ +#define gptlreset gptlreset_ +#define gptlstamp gptlstamp_ +#define gptlstart gptlstart_ +#define gptlstart_handle gptlstart_handle_ +#define gptlstop gptlstop_ +#define gptlstop_handle gptlstop_handle_ +#define gptlsetoption gptlsetoption_ +#define gptlenable gptlenable_ +#define gptldisable gptldisable_ +#define gptlsetutr gptlsetutr_ +#define gptlquery gptlquery_ +#define gptlquerycounters gptlquerycounters_ +#define gptlget_wallclock gptlget_wallclock_ +#define gptlget_eventvalue gptlget_eventvalue_ +#define gptlget_nregions gptlget_nregions_ +#define gptlget_regionname gptlget_regionname_ +#define gptlget_memusage gptlget_memusage_ +#define gptlprint_memusage gptlprint_memusage_ +#define gptl_papilibraryinit gptl_papilibraryinit_ +#define gptlevent_name_to_code gptlevent_name_to_code_ +#define gptlevent_code_to_name gptlevent_code_to_name_ + +#elif ( defined FORTRANDOUBLEUNDERSCORE ) + +#define gptlinitialize gptlinitialize__ +#define gptlfinalize gptlfinalize__ +#define gptlpr_set_append gptlpr_set_append__ +#define gptlpr_query_append gptlpr_query_append__ +#define gptlpr_set_write gptlpr_set_write__ +#define gptlpr_query_write gptlpr_query_write__ +#define gptlpr gptlpr__ +#define gptlpr_file gptlpr_file__ +#define gptlpr_summary gptlpr_summary__ +#define gptlpr_summary_file gptlpr_summary_file__ +#define gptlbarrier gptlbarrier__ +#define gptlreset gptlreset__ +#define gptlstamp gptlstamp__ +#define gptlstart gptlstart__ +#define gptlstart_handle gptlstart_handle__ +#define gptlstop gptlstop__ +#define gptlstop_handle gptlstop_handle__ +#define gptlsetoption gptlsetoption__ +#define gptlenable gptlenable__ +#define gptldisable gptldisable__ +#define gptlsetutr gptlsetutr__ +#define gptlquery gptlquery__ +#define gptlquerycounters gptlquerycounters__ +#define gptlget_wallclock gptlget_wallclock__ +#define gptlget_eventvalue gptlget_eventvalue__ +#define gptlget_nregions gptlget_nregions__ +#define gptlget_regionname gptlget_regionname__ +#define gptlget_memusage gptlget_memusage__ +#define gptlprint_memusage gptlprint_memusage__ +#define gptl_papilibraryinit gptl_papilibraryinit__ +#define gptlevent_name_to_code gptlevent_name_to_code__ +#define gptlevent_code_to_name gptlevent_code_to_name__ + +#endif + +/* +** Local function prototypes +*/ + +int gptlinitialize (void); +int gptlfinalize (void); +int gptlpr_set_append (void); +int gptlpr_query_append (void); +int gptlpr_set_write (void); +int gptlpr_query_write (void); +int gptlpr (int *procid); +int gptlpr_file (char *file, int nc1); +int gptlpr_summary (int *fcomm); +int gptlpr_summary_file (int *fcomm, char *name, int nc1); +int gptlbarrier (int *fcomm, char *name, int nc1); +int gptlreset (void); +int gptlstamp (double *wall, double *usr, double *sys); +int gptlstart (char *name, int nc1); +int gptlstart_handle (char *name, void **, int nc1); +int gptlstop (char *name, int nc1); +int gptlstop_handle (char *name, void **, int nc1); +int gptlsetoption (int *option, int *val); +int gptlenable (void); +int gptldisable (void); +int gptlsetutr (int *option); +int gptlquery (const char *name, int *t, int *count, int *onflg, double *wallclock, + double *usr, double *sys, long long *papicounters_out, int *maxcounters, + int nc); +int gptlquerycounters (const char *name, int *t, long long *papicounters_out, int nc); +int gptlget_wallclock (const char *name, int *t, double *value, int nc); +int gptlget_eventvalue (const char *timername, const char *eventname, int *t, double *value, + int nc1, int nc2); +int gptlget_nregions (int *t, int *nregions); +int gptlget_regionname (int *t, int *region, char *name, int nc); +int gptlget_memusage (int *size, int *rss, int *share, int *text, int *datastack); +int gptlprint_memusage (const char *str, int nc); +#ifdef HAVE_PAPI +int gptl_papilibraryinit (void); +int gptlevent_name_to_code (const char *str, int *code, int nc); +int gptlevent_code_to_name (int *code, char *str, int nc); +#endif + +/* +** Fortran wrapper functions start here +*/ + +int gptlinitialize (void) +{ + return GPTLinitialize (); +} + +int gptlfinalize (void) +{ + return GPTLfinalize (); +} + +int gptlpr_set_append (void) +{ + return GPTLpr_set_append (); +} + +int gptlpr_query_append (void) +{ + return GPTLpr_set_append (); +} + +int gptlpr_set_write (void) +{ + return GPTLpr_set_append (); +} + +int gptlpr_query_write (void) +{ + return GPTLpr_set_append (); +} + +int gptlpr (int *procid) +{ + return GPTLpr (*procid); +} + +int gptlpr_file (char *file, int nc1) +{ + char *locfile; + int ret; + + if ( ! (locfile = (char *) malloc (nc1+1))) + return GPTLerror ("gptlpr_file: malloc error\n"); + + snprintf (locfile, nc1+1, "%s", file); + + ret = GPTLpr_file (locfile); + free (locfile); + return ret; +} + +int gptlpr_summary (int *fcomm) +{ +#ifdef HAVE_MPI + MPI_Comm ccomm; +#ifdef HAVE_COMM_F2C + ccomm = MPI_Comm_f2c (*fcomm); +#else + /* Punt and try just casting the Fortran communicator */ + ccomm = (MPI_Comm) *fcomm; +#endif +#else + int ccomm = 0; +#endif + + return GPTLpr_summary (ccomm); +} + +int gptlpr_summary_file (int *fcomm, char *file, int nc1) +{ + char *locfile; + int ret; + +#ifdef HAVE_MPI + MPI_Comm ccomm; +#ifdef HAVE_COMM_F2C + ccomm = MPI_Comm_f2c (*fcomm); +#else + /* Punt and try just casting the Fortran communicator */ + ccomm = (MPI_Comm) *fcomm; +#endif +#else + int ccomm = 0; +#endif + + if ( ! (locfile = (char *) malloc (nc1+1))) + return GPTLerror ("gptlpr_summary_file: malloc error\n"); + + snprintf (locfile, nc1+1, "%s", file); + + ret = GPTLpr_summary_file (ccomm, locfile); + free (locfile); + return ret; +} + +int gptlbarrier (int *fcomm, char *name, int nc1) +{ + char cname[MAX_CHARS+1]; + int numchars; +#ifdef HAVE_MPI + MPI_Comm ccomm; +#ifdef HAVE_COMM_F2C + ccomm = MPI_Comm_f2c (*fcomm); +#else + /* Punt and try just casting the Fortran communicator */ + ccomm = (MPI_Comm) *fcomm; +#endif +#else + int ccomm = 0; +#endif + + numchars = MIN (nc1, MAX_CHARS); + strncpy (cname, name, numchars); + cname[numchars] = '\0'; + return GPTLbarrier (ccomm, cname); +} + +int gptlreset (void) +{ + return GPTLreset(); +} + +int gptlstamp (double *wall, double *usr, double *sys) +{ + return GPTLstamp (wall, usr, sys); +} + +int gptlstart (char *name, int nc1) +{ + /* char cname[MAX_CHARS+1]; */ + /* int numchars; */ + + /* numchars = MIN (nc1, MAX_CHARS);*/ + /* strncpy (cname, name, numchars);*/ + /* cname[numchars] = '\0';*/ + /* return GPTLstart (cname);*/ + return GPTLstartf (name, nc1); +} + +int gptlstart_handle (char *name, void **handle, int nc1) +{ + /* char cname[MAX_CHARS+1];*/ + /* int numchars;*/ + + /* if (*handle) {*/ + /* cname[0] = '\0';*/ + /* } else {*/ + /* numchars = MIN (nc1, MAX_CHARS);*/ + /* strncpy (cname, name, numchars);*/ + /* cname[numchars] = '\0';*/ + /* }*/ + /* return GPTLstart_handle (cname, handle);*/ + return GPTLstartf_handle (name, nc1, handle); +} + +int gptlstop (char *name, int nc1) +{ + /* char cname[MAX_CHARS+1];*/ + /* int numchars;*/ + + /* numchars = MIN (nc1, MAX_CHARS);*/ + /* strncpy (cname, name, numchars);*/ + /* cname[numchars] = '\0';*/ + /* return GPTLstop (cname);*/ + return GPTLstopf (name, nc1); +} + +int gptlstop_handle (char *name, void **handle, int nc1) +{ + /* char cname[MAX_CHARS+1];*/ + /* int numchars;*/ + + /* if (*handle) {*/ + /* cname[0] = '\0';*/ + /* } else {*/ + /* numchars = MIN (nc1, MAX_CHARS);*/ + /* strncpy (cname, name, numchars);*/ + /* cname[numchars] = '\0';*/ + /* }*/ + /* return GPTLstop_handle (cname, handle);*/ + return GPTLstopf_handle (name, nc1, handle); +} + +int gptlsetoption (int *option, int *val) +{ + return GPTLsetoption (*option, *val); +} + +int gptlenable (void) +{ + return GPTLenable (); +} + +int gptldisable (void) +{ + return GPTLdisable (); +} + +int gptlsetutr (int *option) +{ + return GPTLsetutr (*option); +} + +int gptlquery (const char *name, int *t, int *count, int *onflg, double *wallclock, + double *usr, double *sys, long long *papicounters_out, int *maxcounters, + int nc) +{ + char cname[MAX_CHARS+1]; + int numchars; + + numchars = MIN (nc, MAX_CHARS); + strncpy (cname, name, numchars); + cname[numchars] = '\0'; + return GPTLquery (cname, *t, count, onflg, wallclock, usr, sys, papicounters_out, *maxcounters); +} + +int gptlquerycounters (const char *name, int *t, long long *papicounters_out, int nc) +{ + char cname[MAX_CHARS+1]; + int numchars; + + numchars = MIN (nc, MAX_CHARS); + strncpy (cname, name, numchars); + cname[numchars] = '\0'; + return GPTLquerycounters (cname, *t, papicounters_out); +} + +int gptlget_wallclock (const char *name, int *t, double *value, int nc) +{ + char cname[MAX_CHARS+1]; + int numchars; + + numchars = MIN (nc, MAX_CHARS); + strncpy (cname, name, numchars); + cname[numchars] = '\0'; + + return GPTLget_wallclock (cname, *t, value); +} + +int gptlget_eventvalue (const char *timername, const char *eventname, int *t, double *value, + int nc1, int nc2) +{ + char ctimername[MAX_CHARS+1]; + char ceventname[MAX_CHARS+1]; + int numchars; + + numchars = MIN (nc1, MAX_CHARS); + strncpy (ctimername, timername, numchars); + ctimername[numchars] = '\0'; + + numchars = MIN (nc2, MAX_CHARS); + strncpy (ceventname, eventname, numchars); + ceventname[numchars] = '\0'; + + return GPTLget_eventvalue (ctimername, ceventname, *t, value); +} + +int gptlget_nregions (int *t, int *nregions) +{ + return GPTLget_nregions (*t, nregions); +} + +int gptlget_regionname (int *t, int *region, char *name, int nc) +{ + int n; + int ret; + + ret = GPTLget_regionname (*t, *region, name, nc); + /* Turn nulls into spaces for fortran */ + for (n = 0; n < nc; ++n) + if (name[n] == '\0') + name[n] = ' '; + return ret; +} + +int gptlget_memusage (int *size, int *rss, int *share, int *text, int *datastack) +{ + return GPTLget_memusage (size, rss, share, text, datastack); +} + +int gptlprint_memusage (const char *str, int nc) +{ + char cname[128+1]; + int numchars = MIN (nc, 128); + + strncpy (cname, str, numchars); + cname[numchars] = '\0'; + return GPTLprint_memusage (cname); +} + +#ifdef HAVE_PAPI +#include + +int gptl_papilibraryinit (void) +{ + return GPTL_PAPIlibraryinit (); +} + +int gptlevent_name_to_code (const char *str, int *code, int nc) +{ + char cname[PAPI_MAX_STR_LEN+1]; + int numchars = MIN (nc, PAPI_MAX_STR_LEN); + + strncpy (cname, str, numchars); + cname[numchars] = '\0'; + + /* "code" is an int* and is an output variable */ + + return GPTLevent_name_to_code (cname, code); +} + +int gptlevent_code_to_name (int *code, char *str, int nc) +{ + int i; + + if (nc < PAPI_MAX_STR_LEN) + return GPTLerror ("gptl_event_code_to_name: output name must hold at least %d characters\n", + PAPI_MAX_STR_LEN); + + if (GPTLevent_code_to_name (*code, str) == 0) { + for (i = strlen(str); i < nc; ++i) + str[i] = ' '; + } else { + return GPTLerror (""); + } + return 0; +} +#else + +int gptl_papilibraryinit (void) +{ + return GPTL_PAPIlibraryinit (); +} + +int gptlevent_name_to_code (const char *str, int *code, int nc) +{ + return GPTLevent_name_to_code (str, code); +} + +int gptlevent_code_to_name (const int *code, char *str, int nc) +{ + return GPTLevent_code_to_name (*code, str); +} + +#endif diff --git a/components/cism/glimmer-cism/utils/libgptl/gptl.c b/components/cism/glimmer-cism/utils/libgptl/gptl.c new file mode 100644 index 0000000000..651f4c6855 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/gptl.c @@ -0,0 +1,4834 @@ +/* +** $Id: gptl.c,v 1.157 2011-03-28 20:55:18 rosinski Exp $ +** +** Author: Jim Rosinski +** +** Main file contains most user-accessible GPTL functions +*/ + +#include /* malloc */ +#include /* gettimeofday */ +#include /* times */ +#include /* gettimeofday, syscall */ +#include +#include /* memset, strcmp (via STRMATCH), strncmp (via STRNMATCH) */ +#include /* isdigit */ +#include /* u_int8_t, u_int16_t */ +#include + +#ifndef HAVE_C99_INLINE +#define inline +#endif + +#ifdef HAVE_PAPI +#include /* PAPI_get_real_usec */ +#endif + +#ifdef HAVE_LIBRT +#include +#endif + +#ifdef _AIX +#include +#endif + +#include "private.h" +#include "gptl.h" + +static Timer **timers = 0; /* linked list of timers */ +static Timer **last = 0; /* last element in list */ +static int *max_depth; /* maximum indentation level encountered */ +static int *max_name_len; /* max length of timer name */ +static volatile int nthreads = -1; /* num threads. Init to bad value */ +static volatile int maxthreads = -1; /* max threads (=nthreads for OMP). Init to bad value */ +static int depthlimit = 99999; /* max depth for timers (99999 is effectively infinite) */ +static volatile bool disabled = false; /* Timers disabled? */ +static volatile bool initialized = false; /* GPTLinitialize has been called */ +static volatile bool pr_has_been_called = false; /* GPTLpr_file has been called */ +static Entry eventlist[MAX_AUX]; /* list of PAPI-based events to be counted */ +static int nevents = 0; /* number of PAPI events (init to 0) */ +static bool dousepapi = false; /* saves a function call if stays false */ +static bool verbose = false; /* output verbosity */ +static bool percent = false; /* print wallclock also as percent of 1st timers[0] */ +static bool dopr_preamble = true; /* whether to print preamble info */ +static bool dopr_threadsort = true; /* whether to print sorted thread stats */ +static bool dopr_multparent = true; /* whether to print multiple parent info */ +static bool dopr_collision = true; /* whether to print hash collision info */ +static bool pr_append = false; /* whether to append to output file */ + +static time_t ref_gettimeofday = -1; /* ref start point for gettimeofday */ +static time_t ref_clock_gettime = -1;/* ref start point for clock_gettime */ +#ifdef _AIX +static time_t ref_read_real_time = -1; /* ref start point for read_real_time */ +#endif +static long long ref_papitime = -1; /* ref start point for PAPI_get_real_usec */ + +#if ( defined THREADED_OMP ) + +#include +static volatile int *threadid_omp = 0; /* array of thread ids */ + +#elif ( defined THREADED_PTHREADS ) + +#include + +#define MUTEX_API +#ifdef MUTEX_API +static volatile pthread_mutex_t t_mutex; +#else +static volatile pthread_mutex_t t_mutex = PTHREAD_MUTEX_INITIALIZER; +#endif +static volatile pthread_t *threadid = 0; /* array of thread ids */ +static int lock_mutex (void); /* lock a mutex for entry into a critical region */ +static int unlock_mutex (void); /* unlock a mutex for exit from a critical region */ + +#else + +/* Unthreaded case */ +static int threadid = -1; + +#endif + +typedef struct { + const Option option; /* wall, cpu, etc. */ + const char *str; /* descriptive string for printing */ + bool enabled; /* flag */ +} Settings; + +/* For Summary stats */ + +typedef struct { + double wallmax; + double wallmin; + double walltotal; + int processes; + int threads; +#ifdef HAVE_PAPI + double papimax[MAX_AUX]; + double papimin[MAX_AUX]; + double papitotal[MAX_AUX]; +#endif + unsigned long count; + int wallmax_p; /* over processes */ + int wallmax_t; /* over threads */ + int wallmin_p; + int wallmin_t; +#ifdef HAVE_PAPI + int papimax_p[MAX_AUX]; /* over processes */ + int papimax_t[MAX_AUX]; /* over threads */ + int papimin_p[MAX_AUX]; + int papimin_t[MAX_AUX]; +#endif +} Summarystats; + +/* Options, print strings, and default enable flags */ + +static Settings cpustats = {GPTLcpu, "Usr sys usr+sys ", false}; +static Settings wallstats = {GPTLwall, " Wallclock max min", true }; +static Settings overheadstats = {GPTLoverhead, " UTR Overhead " , true }; + +static Hashentry **hashtable; /* table of entries */ +static long ticks_per_sec; /* clock ticks per second */ +static char **timerlist; /* list of all timers */ + +typedef struct { + int val; /* depth in calling tree */ + int padding[31]; /* padding is to mitigate false cache sharing */ +} Nofalse; +static Timer ***callstack; /* call stack */ +static Nofalse *stackidx; /* index into callstack: */ + +static Method method = GPTLmost_frequent; /* default parent/child printing mechanism */ + +/* Local function prototypes */ + +static void printstats (const Timer *, FILE *, const int, const int, const bool, double); +static void add (Timer *, const Timer *); + +static void get_threadstats (const int, const char *, Summarystats *); +static void get_summarystats (Summarystats *, const Summarystats *); +#ifdef HAVE_MPI +static int collect_data( const int, MPI_Comm, int *, Summarystats ** ); +#else +static int collect_data( const int, const int, int *, Summarystats ** ); +#endif +static int merge_thread_data(); + +static void print_multparentinfo (FILE *, Timer *); +static inline int get_cpustamp (long *, long *); +static int newchild (Timer *, Timer *); +static int get_max_depth (const Timer *, const int); +static int num_descendants (Timer *); +static int is_descendant (const Timer *, const Timer *); +static int show_descendant (const int, const Timer *, const Timer *); +static char *methodstr (Method); + +/* Prototypes from previously separate file threadutil.c */ + +static int threadinit (void); /* initialize threading environment */ +static void threadfinalize (void); /* finalize threading environment */ +static void print_threadmapping (FILE *); /* print mapping of thread ids */ +static inline int get_thread_num (void); /* get 0-based thread number */ + +/* These are the (possibly) supported underlying wallclock timers */ + +static inline double utr_nanotime (void); +static inline double utr_mpiwtime (void); +static inline double utr_clock_gettime (void); +static inline double utr_papitime (void); +static inline double utr_read_real_time (void); +static inline double utr_gettimeofday (void); + +static int init_nanotime (void); +static int init_mpiwtime (void); +static int init_clock_gettime (void); +static int init_papitime (void); +static int init_read_real_time (void); +static int init_gettimeofday (void); + +static double utr_getoverhead (void); +static inline Timer *getentry_instr (const Hashentry *, void *, unsigned int *); +static inline Timer *getentry (const Hashentry *, const char *, unsigned int *); +static inline Timer *getentryf (const Hashentry *, const char *, const int, unsigned int *); +static void printself_andchildren (const Timer *, FILE *, const int, const int, const double); +static inline int update_parent_info (Timer *, Timer **, int); +static inline int update_stats (Timer *, const double, const long, const long, const int); +static int update_ll_hash (Timer *, const int, const unsigned int); +static inline int update_ptr (Timer *, const int); +static int construct_tree (Timer *, Method); + +static int cmp (const void *, const void *); +static int ncmp (const void *, const void *); +static int get_index ( const char *, const char *); + +typedef struct { + const Funcoption option; + double (*func)(void); + int (*funcinit)(void); + const char *name; +} Funcentry; + +static Funcentry funclist[] = { + {GPTLgettimeofday, utr_gettimeofday, init_gettimeofday, "gettimeofday"}, + {GPTLnanotime, utr_nanotime, init_nanotime, "nanotime"}, + {GPTLmpiwtime, utr_mpiwtime, init_mpiwtime, "MPI_Wtime"}, + {GPTLclockgettime, utr_clock_gettime, init_clock_gettime, "clock_gettime"}, + {GPTLpapitime, utr_papitime, init_papitime, "PAPI_get_real_usec"}, + {GPTLread_real_time, utr_read_real_time, init_read_real_time,"read_real_time"} /* AIX only */ +}; +static const int nfuncentries = sizeof (funclist) / sizeof (Funcentry); + +static double (*ptr2wtimefunc)() = 0; /* init to invalid */ +static int funcidx = 0; /* default timer is gettimeofday */ + +#ifdef HAVE_NANOTIME +static float cpumhz = -1.; /* init to bad value */ +static double cyc2sec = -1; /* init to bad value */ +static unsigned inline long long nanotime (void); /* read counter (assembler) */ +static float get_clockfreq (void); /* cycles/sec */ +#endif + +static int tablesize = 1024; /* per-thread size of hash table (settable parameter) */ +static char *outdir = 0; /* dir to write output files to (currently unused) */ + +/* VERBOSE is a debugging ifdef local to the rest of this file */ +#undef VERBOSE + +/* +** GPTLsetoption: set option value to true or false. +** +** Input arguments: +** option: option to be set +** val: value to which option should be set (nonzero=true, zero=false) +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLsetoption (const int option, /* option */ + const int val) /* value */ +{ + static const char *thisfunc = "GPTLsetoption"; + + if (initialized) + return GPTLerror ("%s: must be called BEFORE GPTLinitialize\n", thisfunc); + + if (option == GPTLabort_on_error) { + GPTLset_abort_on_error ((bool) val); + if (verbose) + printf ("%s: boolean abort_on_error = %d\n", thisfunc, val); + return 0; + } + + switch (option) { + case GPTLcpu: +#ifdef HAVE_TIMES + cpustats.enabled = (bool) val; + if (verbose) + printf ("%s: cpustats = %d\n", thisfunc, val); +#else + if (val) + return GPTLerror ("%s: times() not available\n", thisfunc); +#endif + return 0; + case GPTLwall: + wallstats.enabled = (bool) val; + if (verbose) + printf ("%s: boolean wallstats = %d\n", thisfunc, val); + return 0; + case GPTLoverhead: + overheadstats.enabled = (bool) val; + if (verbose) + printf ("%s: boolean overheadstats = %d\n", thisfunc, val); + return 0; + case GPTLdepthlimit: + depthlimit = val; + if (verbose) + printf ("%s: depthlimit = %d\n", thisfunc, val); + return 0; + case GPTLverbose: + verbose = (bool) val; +#ifdef HAVE_PAPI + (void) GPTL_PAPIsetoption (GPTLverbose, val); +#endif + if (verbose) + printf ("%s: boolean verbose = %d\n", thisfunc, val); + return 0; + case GPTLpercent: + percent = (bool) val; + if (verbose) + printf ("%s: boolean percent = %d\n", thisfunc, val); + return 0; + case GPTLdopr_preamble: + dopr_preamble = (bool) val; + if (verbose) + printf ("%s: boolean dopr_preamble = %d\n", thisfunc, val); + return 0; + case GPTLdopr_threadsort: + dopr_threadsort = (bool) val; + if (verbose) + printf ("%s: boolean dopr_threadsort = %d\n", thisfunc, val); + return 0; + case GPTLdopr_multparent: + dopr_multparent = (bool) val; + if (verbose) + printf ("%s: boolean dopr_multparent = %d\n", thisfunc, val); + return 0; + case GPTLdopr_collision: + dopr_collision = (bool) val; + if (verbose) + printf ("%s: boolean dopr_collision = %d\n", thisfunc, val); + return 0; + case GPTLprint_method: + method = (Method) val; + if (verbose) + printf ("%s: print_method = %s\n", thisfunc, methodstr (method)); + return 0; + case GPTLtablesize: + if (val < 1) + return GPTLerror ("%s: tablesize must be positive. %d is invalid\n", thisfunc, val); + + tablesize = val; + if (verbose) + printf ("%s: tablesize = %d\n", thisfunc, tablesize); + return 0; + case GPTLsync_mpi: +#ifdef ENABLE_PMPI + if (GPTLpmpi_setoption (option, val) != 0) + fprintf (stderr, "%s: GPTLpmpi_setoption failure\n", thisfunc); +#endif + if (verbose) + printf ("%s: boolean sync_mpi = %d\n", thisfunc, val); + return 0; + + /* + ** Allow GPTLmultiplex to fall through because it will be handled by + ** GPTL_PAPIsetoption() + */ + + case GPTLmultiplex: + default: + break; + } + +#ifdef HAVE_PAPI + if (GPTL_PAPIsetoption (option, val) == 0) { + if (val) + dousepapi = true; + return 0; + } +#else + /* Make GPTLnarrowprint a placebo if PAPI not enabled */ + + if (option == GPTLnarrowprint) + return 0; +#endif + + return GPTLerror ("%s: faiure to enable option %d\n", thisfunc, option); +} + +/* +** GPTLsetutr: set underlying timing routine. +** +** Input arguments: +** option: index which sets function +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLsetutr (const int option) +{ + int i; /* index over number of underlying timer */ + static const char *thisfunc = "GPTLsetutr"; + + if (initialized) + return GPTLerror ("%s: must be called BEFORE GPTLinitialize\n", thisfunc); + + for (i = 0; i < nfuncentries; i++) { + if (option == (int) funclist[i].option) { + if (verbose) + printf ("%s: underlying wallclock timer = %s\n", thisfunc, funclist[i].name); + funcidx = i; + + /* + ** Return an error condition if the function is not available. + ** OK for the user code to ignore: GPTLinitialize() will reset to gettimeofday + */ + + if ((*funclist[i].funcinit)() < 0) + return GPTLerror ("%s: utr=%s not available\n", thisfunc, funclist[i].name); + else + return 0; + } + } + return GPTLerror ("%s: unknown option %d\n", thisfunc, option); +} + +/* +** GPTLinitialize (): Initialization routine must be called from single-threaded +** region before any other timing routines may be called. The need for this +** routine could be eliminated if not targetting timing library for threaded +** capability. +** +** return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLinitialize (void) +{ + int i; /* loop index */ + int t; /* thread index */ + double t1, t2; /* returned from underlying timer */ + static const char *thisfunc = "GPTLinitialize"; + + if (initialized) + return GPTLerror ("%s: has already been called\n", thisfunc); + + if (threadinit () < 0) + return GPTLerror ("%s: bad return from threadinit\n", thisfunc); + + if ((ticks_per_sec = sysconf (_SC_CLK_TCK)) == -1) + return GPTLerror ("%s: failure from sysconf (_SC_CLK_TCK)\n", thisfunc); + + /* Allocate space for global arrays */ + + callstack = (Timer ***) GPTLallocate (maxthreads * sizeof (Timer **)); + stackidx = (Nofalse *) GPTLallocate (maxthreads * sizeof (Nofalse)); + timers = (Timer **) GPTLallocate (maxthreads * sizeof (Timer *)); + last = (Timer **) GPTLallocate (maxthreads * sizeof (Timer *)); + max_depth = (int *) GPTLallocate (maxthreads * sizeof (int)); + max_name_len = (int *) GPTLallocate (maxthreads * sizeof (int)); + hashtable = (Hashentry **) GPTLallocate (maxthreads * sizeof (Hashentry *)); + + /* Initialize array values */ + + for (t = 0; t < maxthreads; t++) { + max_depth[t] = -1; + max_name_len[t] = 0; + callstack[t] = (Timer **) GPTLallocate (MAX_STACK * sizeof (Timer *)); + hashtable[t] = (Hashentry *) GPTLallocate (tablesize * sizeof (Hashentry)); + for (i = 0; i < tablesize; i++) { + hashtable[t][i].nument = 0; + hashtable[t][i].entries = 0; + } + + /* + ** Make a timer "GPTL_ROOT" to ensure no orphans, and to simplify printing. + */ + + timers[t] = (Timer *) GPTLallocate (sizeof (Timer)); + memset (timers[t], 0, sizeof (Timer)); + strcpy (timers[t]->name, "GPTL_ROOT"); + timers[t]->onflg = true; + last[t] = timers[t]; + + stackidx[t].val = 0; + callstack[t][0] = timers[t]; + for (i = 1; i < MAX_STACK; i++) + callstack[t][i] = 0; + } + +#ifdef HAVE_PAPI + if (GPTL_PAPIinitialize (maxthreads, verbose, &nevents, eventlist) < 0) + return GPTLerror ("%s: Failure from GPTL_PAPIinitialize\n", thisfunc); +#endif + + /* + ** Call init routine for underlying timing routine. + */ + + if ((*funclist[funcidx].funcinit)() < 0) { + fprintf (stderr, "%s: Failure initializing %s. Reverting underlying timer to %s\n", + thisfunc, funclist[funcidx].name, funclist[0].name); + funcidx = 0; + } + + ptr2wtimefunc = funclist[funcidx].func; + + if (verbose) { + t1 = (*ptr2wtimefunc) (); + t2 = (*ptr2wtimefunc) (); + if (t1 > t2) + fprintf (stderr, "%s: negative delta-t=%g\n", thisfunc, t2-t1); + + printf ("Per call overhead est. t2-t1=%g should be near zero\n", t2-t1); + printf ("Underlying wallclock timing routine is %s\n", funclist[funcidx].name); + } + + initialized = true; + return 0; +} + +/* +** GPTLfinalize (): Finalization routine must be called from single-threaded +** region. Free all malloc'd space +** +** return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLfinalize (void) +{ + int t; /* thread index */ + int n; /* array index */ + Timer *ptr, *ptrnext; /* ll indices */ + static const char *thisfunc = "GPTLfinalize"; + + if ( ! initialized) + return GPTLerror ("%s: initialization was not completed\n", thisfunc); + + for (t = 0; t < maxthreads; ++t) { + for (n = 0; n < tablesize; ++n) { + if (hashtable[t][n].nument > 0) + free (hashtable[t][n].entries); + } + free (hashtable[t]); + hashtable[t] = NULL; + free (callstack[t]); + for (ptr = timers[t]; ptr; ptr = ptrnext) { + ptrnext = ptr->next; + if (ptr->nparent > 0) { + free (ptr->parent); + free (ptr->parent_count); + } + if (ptr->nchildren > 0) + free (ptr->children); + free (ptr); + } + } + + free (callstack); + free (stackidx); + free (timers); + free (last); + free (max_depth); + free (max_name_len); + free (hashtable); + + threadfinalize (); + +#ifdef HAVE_PAPI + GPTL_PAPIfinalize (maxthreads); +#endif + + /* Reset initial values */ + + timers = 0; + last = 0; + max_depth = 0; + max_name_len = 0; + nthreads = -1; + maxthreads = -1; + depthlimit = 99999; + disabled = false; + initialized = false; + pr_has_been_called = false; + dousepapi = false; + verbose = false; + percent = false; + dopr_preamble = true; + dopr_threadsort = true; + dopr_multparent = true; + dopr_collision = true; + pr_append = false; + ref_gettimeofday = -1; + ref_clock_gettime = -1; +#ifdef _AIX + ref_read_real_time = -1; +#endif + ref_papitime = -1; + funcidx = 0; +#ifdef HAVE_NANOTIME + cpumhz= 0; + cyc2sec = -1; +#endif + outdir = 0; + tablesize = 1024; + + return 0; +} + +/* +** GPTLstart_instr: start a timer (auto-instrumented) +** +** Input arguments: +** self: function address +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstart_instr (void *self) +{ + Timer *ptr; /* linked list pointer */ + int t; /* thread index (of this thread) */ + unsigned int indx; /* hash table index */ + static const char *thisfunc = "GPTLstart_instr"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s self=%p: GPTLinitialize has not been called\n", thisfunc, self); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** increment and return + */ + + if (stackidx[t].val >= depthlimit) { + ++stackidx[t].val; + return 0; + } + + ptr = getentry_instr (hashtable[t], self, &indx); + + /* + ** Recursion => increment depth in recursion and return. We need to return + ** because we don't want to restart the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr && ptr->onflg) { + ++ptr->recurselvl; + return 0; + } + + /* + ** Increment stackidx[t] unconditionally. This is necessary to ensure the correct + ** behavior when GPTLstop_instr decrements stackidx[t] unconditionally. + */ + + if (++stackidx[t].val > MAX_STACK-1) + return GPTLerror ("%s: stack too big\n", thisfunc); + + if ( ! ptr) { /* Add a new entry and initialize */ + ptr = (Timer *) GPTLallocate (sizeof (Timer)); + memset (ptr, 0, sizeof (Timer)); + + /* + ** Need to save the address string for later conversion back to a real + ** name by an offline tool. + */ + + snprintf (ptr->name, MAX_CHARS+1, "%lx", (unsigned long) self); + ptr->address = self; + + if (update_ll_hash (ptr, t, indx) != 0) + return GPTLerror ("%s: update_ll_hash error\n", thisfunc); + } + + if (update_parent_info (ptr, callstack[t], stackidx[t].val) != 0) + return GPTLerror ("%s: update_parent_info error\n", thisfunc); + + if (update_ptr (ptr, t) != 0) + return GPTLerror ("%s: update_ptr error\n", thisfunc); + + return (0); +} + +/* +** GPTLstart: start a timer +** +** Input arguments: +** name: timer name +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstart (const char *name) /* timer name */ +{ + Timer *ptr; /* linked list pointer */ + int t; /* thread index (of this thread) */ + int numchars; /* number of characters to copy */ + unsigned int indx; /* hash table index */ + static const char *thisfunc = "GPTLstart"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s name=%s: GPTLinitialize has not been called\n", thisfunc, name); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** increment and return + */ + + if (stackidx[t].val >= depthlimit) { + ++stackidx[t].val; + return 0; + } + + /* + ** ptr will point to the requested timer in the current list, + ** or NULL if this is a new entry + */ + + ptr = getentry (hashtable[t], name, &indx); + + /* + ** Recursion => increment depth in recursion and return. We need to return + ** because we don't want to restart the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr && ptr->onflg) { + ++ptr->recurselvl; + return 0; + } + + /* + ** Increment stackidx[t] unconditionally. This is necessary to ensure the correct + ** behavior when GPTLstop decrements stackidx[t] unconditionally. + */ + + if (++stackidx[t].val > MAX_STACK-1) + return GPTLerror ("%s: stack too big\n", thisfunc); + + if ( ! ptr) { /* Add a new entry and initialize */ + ptr = (Timer *) GPTLallocate (sizeof (Timer)); + memset (ptr, 0, sizeof (Timer)); + + numchars = MIN (strlen (name), MAX_CHARS); + strncpy (ptr->name, name, numchars); + ptr->name[numchars] = '\0'; + + if (update_ll_hash (ptr, t, indx) != 0) + return GPTLerror ("%s: update_ll_hash error\n", thisfunc); + } + + if (update_parent_info (ptr, callstack[t], stackidx[t].val) != 0) + return GPTLerror ("%s: update_parent_info error\n", thisfunc); + + if (update_ptr (ptr, t) != 0) + return GPTLerror ("%s: update_ptr error\n", thisfunc); + + return (0); +} + +/* +** GPTLstart_handle: start a timer based on a handle +** +** Input arguments: +** name: timer name (required when on input, handle=0) +** handle: pointer to timer matching "name" +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstart_handle (const char *name, /* timer name */ + void **handle) /* handle (output if input value is 0) */ +{ + Timer *ptr; /* linked list pointer */ + int t; /* thread index (of this thread) */ + int numchars; /* number of characters to copy */ + unsigned int indx = (unsigned int) -1; /* hash table index: init to bad value */ + static const char *thisfunc = "GPTLstart_handle"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s name=%s: GPTLinitialize has not been called\n", thisfunc, name); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** increment and return + */ + + if (stackidx[t].val >= depthlimit) { + ++stackidx[t].val; + return 0; + } + + /* + ** If on input, handle references a non-zero value, assume it's a previously returned Timer* + ** passed in by the user. If zero, generate the hash entry and return it to the user. + */ + + if (*handle) { + ptr = (Timer *) *handle; + } else { + ptr = getentry (hashtable[t], name, &indx); + } + + /* + ** Recursion => increment depth in recursion and return. We need to return + ** because we don't want to restart the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr && ptr->onflg) { + ++ptr->recurselvl; + return 0; + } + + /* + ** Increment stackidx[t] unconditionally. This is necessary to ensure the correct + ** behavior when GPTLstop decrements stackidx[t] unconditionally. + */ + + if (++stackidx[t].val > MAX_STACK-1) + return GPTLerror ("%s: stack too big\n", thisfunc); + + if ( ! ptr) { /* Add a new entry and initialize */ + ptr = (Timer *) GPTLallocate (sizeof (Timer)); + memset (ptr, 0, sizeof (Timer)); + + numchars = MIN (strlen (name), MAX_CHARS); + strncpy (ptr->name, name, numchars); + ptr->name[numchars] = '\0'; + + if (update_ll_hash (ptr, t, indx) != 0) + return GPTLerror ("%s: update_ll_hash error\n", thisfunc); + } + + if (update_parent_info (ptr, callstack[t], stackidx[t].val) != 0) + return GPTLerror ("%s: update_parent_info error\n", thisfunc); + + if (update_ptr (ptr, t) != 0) + return GPTLerror ("%s: update_ptr error\n", thisfunc); + + /* + ** If on input, *handle was 0, return the pointer to the timer for future input + */ + + if ( ! *handle) + *handle = (void *) ptr; + + return (0); +} + +/* +** GPTLstartf: start a timer when the timer name may not be null terminated +** +** Input arguments: +** name: timer name +** namelen: number of characters in timer name +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstartf (const char *name, const int namelen) /* timer name and length */ +{ + Timer *ptr; /* linked list pointer */ + int t; /* thread index (of this thread) */ + int numchars; /* number of characters to copy */ + unsigned int indx; /* hash table index */ + char strname[MAX_CHARS+1]; /* null terminated version of name */ + static const char *thisfunc = "GPTLstartf"; + + if (disabled) + return 0; + + if ( ! initialized){ + numchars = MIN (namelen, MAX_CHARS); + strncpy (strname, name, numchars); + strname[numchars] = '\0'; + return GPTLerror ("%s name=%s: GPTLinitialize has not been called\n", thisfunc, strname); + } + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** increment and return + */ + + if (stackidx[t].val >= depthlimit) { + ++stackidx[t].val; + return 0; + } + + /* + ** ptr will point to the requested timer in the current list, + ** or NULL if this is a new entry + */ + + ptr = getentryf (hashtable[t], name, namelen, &indx); + + /* + ** Recursion => increment depth in recursion and return. We need to return + ** because we don't want to restart the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr && ptr->onflg) { + ++ptr->recurselvl; + return 0; + } + + /* + ** Increment stackidx[t] unconditionally. This is necessary to ensure the correct + ** behavior when GPTLstop decrements stackidx[t] unconditionally. + */ + + if (++stackidx[t].val > MAX_STACK-1) + return GPTLerror ("%s: stack too big\n", thisfunc); + + if ( ! ptr) { /* Add a new entry and initialize */ + ptr = (Timer *) GPTLallocate (sizeof (Timer)); + memset (ptr, 0, sizeof (Timer)); + + numchars = MIN (namelen, MAX_CHARS); + strncpy (ptr->name, name, numchars); + ptr->name[numchars] = '\0'; + + if (update_ll_hash (ptr, t, indx) != 0) + return GPTLerror ("%s: update_ll_hash error\n", thisfunc); + } + + if (update_parent_info (ptr, callstack[t], stackidx[t].val) != 0) + return GPTLerror ("%s: update_parent_info error\n", thisfunc); + + if (update_ptr (ptr, t) != 0) + return GPTLerror ("%s: update_ptr error\n", thisfunc); + + return (0); +} + +/* +** GPTLstartf_handle: start a timer based on a handle +** when the timer name may not be null terminated +** +** Input arguments: +** name: timer name (required when on input, handle=0) +** namelen: number of characters in timer name +** handle: pointer to timer matching "name" +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstartf_handle (const char *name, /* timer name */ + const int namelen, /* timer name length */ + void **handle) /* handle (output if input value is 0) */ +{ + Timer *ptr; /* linked list pointer */ + int t; /* thread index (of this thread) */ + int numchars; /* number of characters to copy */ + unsigned int indx = (unsigned int) -1; /* hash table index: init to bad value */ + char strname[MAX_CHARS+1]; /* null terminated version of name */ + static const char *thisfunc = "GPTLstartf_handle"; + + if (disabled) + return 0; + + if ( ! initialized){ + numchars = MIN (namelen, MAX_CHARS); + strncpy (strname, name, numchars); + strname[numchars] = '\0'; + return GPTLerror ("%s name=%s: GPTLinitialize has not been called\n", thisfunc, strname); + } + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** increment and return + */ + + if (stackidx[t].val >= depthlimit) { + ++stackidx[t].val; + return 0; + } + + /* + ** If on input, handle references a non-zero value, assume it's a previously returned Timer* + ** passed in by the user. If zero, generate the hash entry and return it to the user. + */ + + if (*handle) { + ptr = (Timer *) *handle; + } else { + ptr = getentryf (hashtable[t], name, namelen, &indx); + } + + /* + ** Recursion => increment depth in recursion and return. We need to return + ** because we don't want to restart the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr && ptr->onflg) { + ++ptr->recurselvl; + return 0; + } + + /* + ** Increment stackidx[t] unconditionally. This is necessary to ensure the correct + ** behavior when GPTLstop decrements stackidx[t] unconditionally. + */ + + if (++stackidx[t].val > MAX_STACK-1) + return GPTLerror ("%s: stack too big\n", thisfunc); + + if ( ! ptr) { /* Add a new entry and initialize */ + ptr = (Timer *) GPTLallocate (sizeof (Timer)); + memset (ptr, 0, sizeof (Timer)); + + numchars = MIN (namelen, MAX_CHARS); + strncpy (ptr->name, name, numchars); + ptr->name[numchars] = '\0'; + + if (update_ll_hash (ptr, t, indx) != 0) + return GPTLerror ("%s: update_ll_hash error\n", thisfunc); + } + + if (update_parent_info (ptr, callstack[t], stackidx[t].val) != 0) + return GPTLerror ("%s: update_parent_info error\n", thisfunc); + + if (update_ptr (ptr, t) != 0) + return GPTLerror ("%s: update_ptr error\n", thisfunc); + + /* + ** If on input, *handle was 0, return the pointer to the timer for future input + */ + + if ( ! *handle) + *handle = (void *) ptr; + + return (0); +} + +/* +** update_ll_hash: Update linked list and hash table. +** Called by GPTLstart(f), GPTLstart_instr and GPTLstart(f)_handle +** +** Input arguments: +** ptr: pointer to timer +** t: thread index +** indx: hash index +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static int update_ll_hash (Timer *ptr, const int t, const unsigned int indx) +{ + int nchars; /* number of chars */ + int nument; /* number of entries */ + Timer **eptr; /* for realloc */ + + nchars = strlen (ptr->name); + if (nchars > max_name_len[t]) + max_name_len[t] = nchars; + + last[t]->next = ptr; + last[t] = ptr; + ++hashtable[t][indx].nument; + nument = hashtable[t][indx].nument; + + eptr = (Timer **) realloc (hashtable[t][indx].entries, nument * sizeof (Timer *)); + if ( ! eptr) + return GPTLerror ("update_ll_hash: realloc error\n"); + + hashtable[t][indx].entries = eptr; + hashtable[t][indx].entries[nument-1] = ptr; + + return 0; +} + +/* +** update_ptr: Update timer contents. +** Called by GPTLstart(f) and GPTLstart_instr and GPTLstart(f)_handle +** +** Input arguments: +** ptr: pointer to timer +** t: thread index +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static inline int update_ptr (Timer *ptr, const int t) +{ + double tp2; /* time stamp */ + + ptr->onflg = true; + + if (cpustats.enabled && get_cpustamp (&ptr->cpu.last_utime, &ptr->cpu.last_stime) < 0) + return GPTLerror ("update_ptr: get_cpustamp error"); + + if (wallstats.enabled) { + tp2 = (*ptr2wtimefunc) (); + ptr->wall.last = tp2; + } + +#ifdef HAVE_PAPI + if (dousepapi && GPTL_PAPIstart (t, &ptr->aux) < 0) + return GPTLerror ("update_ptr: error from GPTL_PAPIstart\n"); +#endif + return 0; +} + +/* +** update_parent_info: update info about parent, and in the parent about this child +** +** Arguments: +** ptr: pointer to timer +** callstackt: callstack for this thread +** stackidxt: stack index for this thread +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static inline int update_parent_info (Timer *ptr, + Timer **callstackt, + int stackidxt) +{ + int n; /* loop index through known parents */ + Timer *pptr; /* pointer to parent in callstack */ + Timer **pptrtmp; /* for realloc parent pointer array */ + int nparent; /* number of parents */ + int *parent_count; /* number of times parent invoked this child */ + static const char *thisfunc = "update_parent_info"; + + if ( ! ptr ) + return -1; + + if (stackidxt < 0) + return GPTLerror ("%s: called with negative stackidx\n", thisfunc); + + callstackt[stackidxt] = ptr; + + /* + ** If the region has no parent, bump its orphan count + ** (should never happen since "GPTL_ROOT" added). + */ + + if (stackidxt == 0) { + ++ptr->norphan; + return 0; + } + + pptr = callstackt[stackidxt-1]; + + /* If this parent occurred before, bump its count */ + + for (n = 0; n < ptr->nparent; ++n) { + if (ptr->parent[n] == pptr) { + ++ptr->parent_count[n]; + break; + } + } + + /* If this is a new parent, update info */ + + if (n == ptr->nparent) { + ++ptr->nparent; + nparent = ptr->nparent; + pptrtmp = (Timer **) realloc (ptr->parent, nparent * sizeof (Timer *)); + if ( ! pptrtmp) + return GPTLerror ("%s: realloc error pptrtmp nparent=%d\n", thisfunc, nparent); + + ptr->parent = pptrtmp; + ptr->parent[nparent-1] = pptr; + parent_count = (int *) realloc (ptr->parent_count, nparent * sizeof (int)); + if ( ! parent_count) + return GPTLerror ("%s: realloc error parent_count nparent=%d\n", thisfunc, nparent); + + ptr->parent_count = parent_count; + ptr->parent_count[nparent-1] = 1; + } + + return 0; +} + +/* +** GPTLstop_instr: stop a timer (auto-instrumented) +** +** Input arguments: +** self: function address +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstop_instr (void *self) +{ + double tp1 = 0.0; /* time stamp */ + Timer *ptr; /* linked list pointer */ + int t; /* thread number for this process */ + unsigned int indx; /* index into hash table */ + long usr = 0; /* user time (returned from get_cpustamp) */ + long sys = 0; /* system time (returned from get_cpustamp) */ + static const char *thisfunc = "GPTLstop_instr"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* Get the timestamp */ + + if (wallstats.enabled) { + tp1 = (*ptr2wtimefunc) (); + } + + if (cpustats.enabled && get_cpustamp (&usr, &sys) < 0) + return GPTLerror ("%s: bad return from get_cpustamp\n", thisfunc); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** decrement and return + */ + + if (stackidx[t].val > depthlimit) { + --stackidx[t].val; + return 0; + } + + ptr = getentry_instr (hashtable[t], self, &indx); + + if ( ! ptr) + return GPTLerror ("%s: timer for %p had not been started.\n", thisfunc, self); + + if ( ! ptr->onflg ) + return GPTLerror ("%s: timer %s was already off.\n", thisfunc, ptr->name); + + ++ptr->count; + + /* + ** Recursion => decrement depth in recursion and return. We need to return + ** because we don't want to stop the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr->recurselvl > 0) { + ++ptr->nrecurse; + --ptr->recurselvl; + return 0; + } + + if (update_stats (ptr, tp1, usr, sys, t) != 0) + return GPTLerror ("%s: error from update_stats\n", thisfunc); + + return 0; +} + +/* +** GPTLstop: stop a timer +** +** Input arguments: +** name: timer name +** +** Return value: 0 (success) or -1 (failure) +*/ + +int GPTLstop (const char *name) /* timer name */ +{ + double tp1 = 0.0; /* time stamp */ + Timer *ptr; /* linked list pointer */ + int t; /* thread number for this process */ + unsigned int indx; /* index into hash table */ + long usr = 0; /* user time (returned from get_cpustamp) */ + long sys = 0; /* system time (returned from get_cpustamp) */ + static const char *thisfunc = "GPTLstop"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* Get the timestamp */ + + if (wallstats.enabled) { + tp1 = (*ptr2wtimefunc) (); + } + + if (cpustats.enabled && get_cpustamp (&usr, &sys) < 0) + return GPTLerror ("%s: get_cpustamp error", thisfunc); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** decrement and return + */ + + if (stackidx[t].val > depthlimit) { + --stackidx[t].val; + return 0; + } + + if ( ! (ptr = getentry (hashtable[t], name, &indx))) + return GPTLerror ("%s thread %d: timer for %s had not been started.\n", thisfunc, t, name); + + if ( ! ptr->onflg ) + return GPTLerror ("%s: timer %s was already off.\n", thisfunc, ptr->name); + + ++ptr->count; + + /* + ** Recursion => decrement depth in recursion and return. We need to return + ** because we don't want to stop the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr->recurselvl > 0) { + ++ptr->nrecurse; + --ptr->recurselvl; + return 0; + } + + if (update_stats (ptr, tp1, usr, sys, t) != 0) + return GPTLerror ("%s: error from update_stats\n", thisfunc); + + return 0; +} + +/* +** GPTLstop_handle: stop a timer based on a handle +** +** Input arguments: +** name: timer name (used only for diagnostics) +** handle: pointer to timer +** +** Return value: 0 (success) or -1 (failure) +*/ + +int GPTLstop_handle (const char *name, /* timer name */ + void **handle) /* handle (output if input value is 0) */ +{ + double tp1 = 0.0; /* time stamp */ + Timer *ptr; /* linked list pointer */ + int t; /* thread number for this process */ + unsigned int indx; /* index into hash table */ + long usr = 0; /* user time (returned from get_cpustamp) */ + long sys = 0; /* system time (returned from get_cpustamp) */ + static const char *thisfunc = "GPTLstop_handle"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* Get the timestamp */ + + if (wallstats.enabled) { + tp1 = (*ptr2wtimefunc) (); + } + + if (cpustats.enabled && get_cpustamp (&usr, &sys) < 0) + return GPTLerror (0); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** decrement and return + */ + + if (stackidx[t].val > depthlimit) { + --stackidx[t].val; + return 0; + } + + /* + ** If on input, handle references a non-zero value, assume it's a previously returned Timer* + ** passed in by the user. If zero, generate the hash entry and return it to the user. + */ + + if (*handle) { + ptr = (Timer *) *handle; + } else { + if ( ! (ptr = getentry (hashtable[t], name, &indx))) + return GPTLerror ("%s thread %d: timer for %s had not been started.\n", thisfunc, t, name); + } + + if ( ! ptr->onflg ) + return GPTLerror ("%s: timer %s was already off.\n", thisfunc, ptr->name); + + ++ptr->count; + + /* + ** Recursion => decrement depth in recursion and return. We need to return + ** because we don't want to stop the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr->recurselvl > 0) { + ++ptr->nrecurse; + --ptr->recurselvl; + return 0; + } + + if (update_stats (ptr, tp1, usr, sys, t) != 0) + return GPTLerror ("%s: error from update_stats\n", thisfunc); + + /* + ** If on input, *handle was 0, return the pointer to the timer for future input + */ + + if ( ! *handle) + *handle = (void *) ptr; + + return 0; +} + +/* +** GPTLstopf: stop a timer when the timer name may not be null terminated +** +** Input arguments: +** name: timer name +** namelen: number of characters in timer name +** +** Return value: 0 (success) or -1 (failure) +*/ + +int GPTLstopf (const char *name, const int namelen) /* timer name and length */ +{ + double tp1 = 0.0; /* time stamp */ + Timer *ptr; /* linked list pointer */ + int t; /* thread number for this process */ + unsigned int indx; /* index into hash table */ + long usr = 0; /* user time (returned from get_cpustamp) */ + long sys = 0; /* system time (returned from get_cpustamp) */ + int numchars; /* number of characters to copy */ + char strname[MAX_CHARS+1]; /* null terminated version of name */ + static const char *thisfunc = "GPTLstopf"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* Get the timestamp */ + + if (wallstats.enabled) { + tp1 = (*ptr2wtimefunc) (); + } + + if (cpustats.enabled && get_cpustamp (&usr, &sys) < 0) + return GPTLerror ("%s: get_cpustamp error", thisfunc); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** decrement and return + */ + + if (stackidx[t].val > depthlimit) { + --stackidx[t].val; + return 0; + } + + if ( ! (ptr = getentryf (hashtable[t], name, namelen, &indx))){ + numchars = MIN (namelen, MAX_CHARS); + strncpy (strname, name, numchars); + strname[numchars] = '\0'; + return GPTLerror ("%s thread %d: timer for %s had not been started.\n", thisfunc, t, strname); + } + + if ( ! ptr->onflg ) + return GPTLerror ("%s: timer %s was already off.\n", thisfunc, ptr->name); + + ++ptr->count; + + /* + ** Recursion => decrement depth in recursion and return. We need to return + ** because we don't want to stop the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr->recurselvl > 0) { + ++ptr->nrecurse; + --ptr->recurselvl; + return 0; + } + + if (update_stats (ptr, tp1, usr, sys, t) != 0) + return GPTLerror ("%s: error from update_stats\n", thisfunc); + + return 0; +} + +/* +** GPTLstopf_handle: stop a timer based on a handle +** when the timer name may not be null terminated +** +** Input arguments: +** name: timer name (used only for diagnostics) +** namelen: number of characters in timer name +** handle: pointer to timer +** +** Return value: 0 (success) or -1 (failure) +*/ + +int GPTLstopf_handle (const char *name, /* timer name */ + const int namelen, /* timer name length */ + void **handle) /* handle (output if input value is 0) */ +{ + double tp1 = 0.0; /* time stamp */ + Timer *ptr; /* linked list pointer */ + int t; /* thread number for this process */ + unsigned int indx; /* index into hash table */ + long usr = 0; /* user time (returned from get_cpustamp) */ + long sys = 0; /* system time (returned from get_cpustamp) */ + int numchars; /* number of characters to copy */ + char strname[MAX_CHARS+1]; /* null terminated version of name */ + static const char *thisfunc = "GPTLstopf_handle"; + + if (disabled) + return 0; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* Get the timestamp */ + + if (wallstats.enabled) { + tp1 = (*ptr2wtimefunc) (); + } + + if (cpustats.enabled && get_cpustamp (&usr, &sys) < 0) + return GPTLerror (0); + + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + + /* + ** If current depth exceeds a user-specified limit for print, just + ** decrement and return + */ + + if (stackidx[t].val > depthlimit) { + --stackidx[t].val; + return 0; + } + + /* + ** If on input, handle references a non-zero value, assume it's a previously returned Timer* + ** passed in by the user. If zero, generate the hash entry and return it to the user. + */ + + if (*handle) { + ptr = (Timer *) *handle; + } else { + if ( ! (ptr = getentryf (hashtable[t], name, namelen, &indx))){ + numchars = MIN (namelen, MAX_CHARS); + strncpy (strname, name, numchars); + strname[numchars] = '\0'; + return GPTLerror ("%s thread %d: timer for %s had not been started.\n", thisfunc, t, strname); + } + } + + if ( ! ptr->onflg ) + return GPTLerror ("%s: timer %s was already off.\n", thisfunc, ptr->name); + + ++ptr->count; + + /* + ** Recursion => decrement depth in recursion and return. We need to return + ** because we don't want to stop the timer. We want the reported time for + ** the timer to reflect the outermost layer of recursion. + */ + + if (ptr->recurselvl > 0) { + ++ptr->nrecurse; + --ptr->recurselvl; + return 0; + } + + if (update_stats (ptr, tp1, usr, sys, t) != 0) + return GPTLerror ("%s: error from update_stats\n", thisfunc); + + /* + ** If on input, *handle was 0, return the pointer to the timer for future input + */ + + if ( ! *handle) + *handle = (void *) ptr; + + return 0; +} + +/* +** update_stats: update stats inside ptr. Called by GPTLstop(f), GPTLstop_instr, +** GPTLstop(f)_handle +** +** Input arguments: +** ptr: pointer to timer +** tp1: input time stapm +** usr: user time +** sys: system time +** t: thread index +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static inline int update_stats (Timer *ptr, + const double tp1, + const long usr, + const long sys, + const int t) +{ + double delta; /* difference */ + static const char *thisfunc = "update_stats"; + + ptr->onflg = false; + --stackidx[t].val; + if (stackidx[t].val < -1) { + stackidx[t].val = -1; + return GPTLerror ("%s: tree depth has become negative.\n", thisfunc); + } + +#ifdef HAVE_PAPI + if (dousepapi && GPTL_PAPIstop (t, &ptr->aux) < 0) + return GPTLerror ("%s: error from GPTL_PAPIstop\n", thisfunc); +#endif + + if (wallstats.enabled) { + delta = tp1 - ptr->wall.last; + ptr->wall.accum += delta; + + if (delta < 0.) { + fprintf (stderr, "%s: negative delta=%g\n", thisfunc, delta); + } + + if (ptr->count == 1) { + ptr->wall.max = delta; + ptr->wall.min = delta; + } else { + if (delta > ptr->wall.max) + ptr->wall.max = delta; + if (delta < ptr->wall.min) + ptr->wall.min = delta; + } + } + + if (cpustats.enabled) { + ptr->cpu.accum_utime += usr - ptr->cpu.last_utime; + ptr->cpu.accum_stime += sys - ptr->cpu.last_stime; + ptr->cpu.last_utime = usr; + ptr->cpu.last_stime = sys; + } + return 0; +} + +/* +** GPTLenable: enable timers +** +** Return value: 0 (success) +*/ + +int GPTLenable (void) +{ + disabled = false; + return (0); +} + +/* +** GPTLdisable: disable timers +** +** Return value: 0 (success) +*/ + +int GPTLdisable (void) +{ + disabled = true; + return (0); +} + +/* +** GPTLstamp: Compute timestamp of usr, sys, and wallclock time (seconds) +** +** Output arguments: +** wall: wallclock +** usr: user time +** sys: system time +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLstamp (double *wall, double *usr, double *sys) +{ + struct tms buf; /* argument to times */ + + if ( ! initialized) + return GPTLerror ("GPTLstamp: GPTLinitialize has not been called\n"); + +#ifdef HAVE_TIMES + *usr = 0; + *sys = 0; + + if (times (&buf) == -1) + return GPTLerror ("GPTLstamp: times() failed. Results bogus\n"); + + *usr = buf.tms_utime / (double) ticks_per_sec; + *sys = buf.tms_stime / (double) ticks_per_sec; +#endif + *wall = (*ptr2wtimefunc) (); + return 0; +} + +/* +** GPTLreset: reset all timers to 0 +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLreset (void) +{ + int t; /* index over threads */ + Timer *ptr; /* linked list index */ + static const char *thisfunc = "GPTLreset"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + for (t = 0; t < nthreads; t++) { + for (ptr = timers[t]; ptr; ptr = ptr->next) { + ptr->onflg = false; + ptr->count = 0; + memset (&ptr->wall, 0, sizeof (ptr->wall)); + memset (&ptr->cpu, 0, sizeof (ptr->cpu)); +#ifdef HAVE_PAPI + memset (&ptr->aux, 0, sizeof (ptr->aux)); +#endif + } + } + + if (verbose) + printf ("%s: accumulators for all timers set to zero\n", thisfunc); + + return 0; +} + +/* +** GPTLpr_set_append: set GPTLpr_file and GPTLpr_summary_file +** to use append mode +*/ + +int GPTLpr_set_append (void) +{ + pr_append = true; + return 0; +} + +/* +** GPTLpr_query_append: query whether GPTLpr_file and GPTLpr_summary_file +** use append mode +*/ + +int GPTLpr_query_append (void) +{ + if (pr_append) + return 1; + else + return 0; +} + +/* +** GPTLpr_set_write: set GPTLpr_file and GPTLpr_summary_file +** to use write mode +*/ + +int GPTLpr_set_write (void) +{ + pr_append = false; + return 0; +} + +/* +** GPTLpr_query_write: query whether GPTLpr_file and GPTLpr_summary_file +** use write mode +*/ + +int GPTLpr_query_write (void) +{ + if (pr_append) + return 0; + else + return 1; +} + +/* +** GPTLpr: Print values of all timers +** +** Input arguments: +** id: integer to append to string "timing." +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLpr (const int id) /* output file will be named "timing." */ +{ + char outfile[14]; /* name of output file: timing.xxxxxx */ + static const char *thisfunc = "GPTLpr"; + + if (id < 0 || id > 999999) + return GPTLerror ("%s: bad id=%d for output file. Must be >= 0 and < 1000000\n", thisfunc, id); + + sprintf (outfile, "timing.%d", id); + + if (GPTLpr_file (outfile) != 0) + return GPTLerror ("%s: Error in GPTLpr_file\n", thisfunc); + + return 0; +} + +/* +** GPTLpr_file: Print values of all timers +** +** Input arguments: +** outfile: Name of output file to write +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLpr_file (const char *outfile) /* output file to write */ +{ + FILE *fp; /* file handle to write to */ + Timer *ptr; /* walk through master thread linked list */ + Timer *tptr; /* walk through slave threads linked lists */ + Timer sumstats; /* sum of same timer stats over threads */ + int i, ii, n, t; /* indices */ + int totent; /* per-thread collision count (diagnostic) */ + int nument; /* per-index collision count (diagnostic) */ + int totlen; /* length for malloc */ + unsigned long totcount; /* total timer invocations */ + char *outpath; /* path to output file: outdir/timing.xxxxxx */ + float *sum; /* sum of overhead values (per thread) */ + float osum; /* sum of overhead over threads */ + double utr_overhead; /* overhead of calling underlying timing routine */ + double tot_overhead; /* utr_overhead + papi overhead */ + double papi_overhead = 0; /* overhead of reading papi counters */ + bool found; /* jump out of loop when name found */ + bool foundany; /* whether summation print necessary */ + bool first; /* flag 1st time entry found */ + /* + ** Diagnostics for collisions and GPTL memory usage + */ + int num_zero; /* number of buckets with 0 collisions */ + int num_one; /* number of buckets with 1 collision */ + int num_two; /* number of buckets with 2 collisions */ + int num_more; /* number of buckets with more than 2 collisions */ + int most; /* biggest collision count */ + int numtimers = 0; /* number of timers */ + float hashmem; /* hash table memory usage */ + float regionmem; /* timer memory usage */ + float papimem; /* PAPI stats memory usage */ + float pchmem; /* parent/child array memory usage */ + float gptlmem; /* total per-thread GPTL memory usage estimate */ + float totmem; /* sum of gptlmem across threads */ + + static const char *thisfunc = "GPTLpr_file"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize() has not been called\n", thisfunc); + + /* 2 is for "/" plus null */ + if (outdir) + totlen = strlen (outdir) + strlen (outfile) + 2; + else + totlen = strlen (outfile) + 2; + + outpath = (char *) GPTLallocate (totlen); + + if (outdir) { + strcpy (outpath, outdir); + strcat (outpath, "/"); + strcat (outpath, outfile); + } else { + strcpy (outpath, outfile); + } + + if (pr_append){ + if ( ! (fp = fopen (outpath, "a"))) + fp = stderr; + } + else{ + if ( ! (fp = fopen (outpath, "w"))) + fp = stderr; + } + + free (outpath); + + fprintf (fp, "$Id: gptl.c,v 1.157 2011-03-28 20:55:18 rosinski Exp $\n"); + + /* + ** A set of nasty ifdefs to tell important aspects of how GPTL was built + */ + +#ifdef HAVE_NANOTIME + if (funclist[funcidx].option == GPTLnanotime) { + fprintf (fp, "Clock rate = %f MHz\n", cpumhz); +#ifdef BIT64 + fprintf (fp, " BIT64 was true\n"); +#else + fprintf (fp, " BIT64 was false\n"); +#endif + } +#endif + +#if ( defined THREADED_OMP ) + fprintf (fp, "GPTL was built with THREADED_OMP\n"); +#elif ( defined THREADED_PTHREADS ) + fprintf (fp, "GPTL was built with THREADED_PTHREADS\n"); +#else + fprintf (fp, "GPTL was built without threading\n"); +#endif + +#ifdef HAVE_MPI + fprintf (fp, "HAVE_MPI was true\n"); + +#ifdef HAVE_COMM_F2C + fprintf (fp, " HAVE_COMM_F2C was true\n"); +#else + fprintf (fp, " HAVE_COMM_F2C was false\n"); +#endif + +#ifdef ENABLE_PMPI + fprintf (fp, " ENABLE_PMPI was true\n"); +#else + fprintf (fp, " ENABLE_PMPI was false\n"); +#endif + +#else + fprintf (fp, "HAVE_MPI was false\n"); +#endif + +#ifdef HAVE_PAPI + fprintf (fp, "HAVE_PAPI was true\n"); + if (dousepapi) { + if (GPTL_PAPIis_multiplexed ()) + fprintf (fp, " PAPI event multiplexing was ON\n"); + else + fprintf (fp, " PAPI event multiplexing was OFF\n"); + GPTL_PAPIprintenabled (fp); + } +#else + fprintf (fp, "HAVE_PAPI was false\n"); +#endif + + /* + ** Estimate underlying timing routine overhead + */ + + utr_overhead = utr_getoverhead (); + fprintf (fp, "Underlying timing routine was %s.\n", funclist[funcidx].name); + fprintf (fp, "Per-call utr overhead est: %g sec.\n", utr_overhead); +#ifdef HAVE_PAPI + if (dousepapi) { + double t1, t2; + t1 = (*ptr2wtimefunc) (); + read_counters100 (); + t2 = (*ptr2wtimefunc) (); + papi_overhead = 0.01 * (t2 - t1); + fprintf (fp, "Per-call PAPI overhead est: %g sec.\n", papi_overhead); + } +#endif + tot_overhead = utr_overhead + papi_overhead; + if (dopr_preamble) { + fprintf (fp, "If overhead stats are printed, roughly half the estimated number is\n" + "embedded in the wallclock stats for each timer.\n" + "Print method was %s.\n", methodstr (method)); +#ifdef ENABLE_PMPI + fprintf (fp, "If a AVG_MPI_BYTES field is present, it is an estimate of the per-call " + "average number of bytes handled by that process.\n" + "If timers beginning with sync_ are present, it means MPI synchronization " + "was turned on.\n"); +#endif + fprintf (fp, "If a \'%%_of\' field is present, it is w.r.t. the first timer for thread 0.\n" + "If a \'e6_per_sec\' field is present, it is in millions of PAPI counts per sec.\n\n" + "A '*' in column 1 below means the timer had multiple parents, though the\n" + "values printed are for all calls.\n" + "Further down the listing may be more detailed information about multiple\n" + "parents. Look for 'Multiple parent info'\n\n"); + } + + sum = (float *) GPTLallocate (nthreads * sizeof (float)); + + for (t = 0; t < nthreads; ++t) { + + /* + ** Construct tree for printing timers in parent/child form. get_max_depth() must be called + ** AFTER construct_tree() because it relies on the per-parent children arrays being complete. + */ + + if (construct_tree (timers[t], method) != 0) + printf ("GPTLpr_file: failure from construct_tree: output will be incomplete\n"); + max_depth[t] = get_max_depth (timers[t], 0); + + if (t > 0) + fprintf (fp, "\n"); + fprintf (fp, "Stats for thread %d:\n", t); + + for (n = 0; n < max_depth[t]+1; ++n) /* +1 to always indent timer name */ + fprintf (fp, " "); + for (n = 0; n < max_name_len[t]; ++n) /* longest timer name */ + fprintf (fp, " "); + + fprintf (fp, " On Called Recurse"); + + /* Print strings for enabled timer types */ + + if (cpustats.enabled) + fprintf (fp, "%s", cpustats.str); + if (wallstats.enabled) { + fprintf (fp, "%s", wallstats.str); + if (percent && timers[0]->next) + fprintf (fp, "%%_of_%5.5s ", timers[0]->next->name); + if (overheadstats.enabled) + fprintf (fp, "%s", overheadstats.str); + } + +#ifdef ENABLE_PMPI + fprintf (fp, "AVG_MPI_BYTES "); +#endif + +#ifdef HAVE_PAPI + GPTL_PAPIprstr (fp); +#endif + + fprintf (fp, "\n"); /* Done with titles, now print stats */ + + /* + ** Print call tree and stats via recursive routine. "-1" is flag to + ** avoid printing dummy outermost timer, and initialize the depth. + */ + + printself_andchildren (timers[t], fp, t, -1, tot_overhead); + + /* + ** Sum of overhead across timers is meaningful. + ** Factor of 2 is because there are 2 utr calls per start/stop pair. + */ + + sum[t] = 0; + totcount = 0; + for (ptr = timers[t]->next; ptr; ptr = ptr->next) { + sum[t] += ptr->count * 2 * tot_overhead; + totcount += ptr->count; + } + if (wallstats.enabled && overheadstats.enabled) + fprintf (fp, "\n"); + fprintf (fp, "Overhead sum = %9.3g wallclock seconds\n", sum[t]); + if (totcount < PRTHRESH) + fprintf (fp, "Total calls = %lu\n", totcount); + else + fprintf (fp, "Total calls = %9.3e\n", (float) totcount); + } + + /* Print per-name stats for all threads */ + + if (dopr_threadsort && nthreads > 1) { + fprintf (fp, "\nSame stats sorted by timer for threaded regions (for timers active on thread 0):\n"); + fprintf (fp, "Thd "); + + for (n = 0; n < max_name_len[0]; ++n) /* longest timer name */ + fprintf (fp, " "); + + fprintf (fp, " On Called Recurse"); + + if (cpustats.enabled) + fprintf (fp, "%s", cpustats.str); + if (wallstats.enabled) { + fprintf (fp, "%s", wallstats.str); + if (percent && timers[0]->next) + fprintf (fp, "%%_of_%5.5s ", timers[0]->next->name); + if (overheadstats.enabled) + fprintf (fp, "%s", overheadstats.str); + } + +#ifdef HAVE_PAPI + GPTL_PAPIprstr (fp); +#endif + + fprintf (fp, "\n"); + + /* Start at next to skip dummy */ + + for (ptr = timers[0]->next; ptr; ptr = ptr->next) { + + /* + ** To print sum stats, first create a new timer then copy thread 0 + ** stats into it. then sum using "add", and finally print. + */ + + foundany = false; + first = true; + sumstats = *ptr; + for (t = 1; t < nthreads; ++t) { + found = false; + for (tptr = timers[t]->next; tptr && ! found; tptr = tptr->next) { + if (STRMATCH (ptr->name, tptr->name)) { + + /* Only print thread 0 when this timer found for other threads */ + + if (first) { + first = false; + fprintf (fp, "%3.3d ", 0); + printstats (ptr, fp, 0, 0, false, tot_overhead); + } + + found = true; + foundany = true; + fprintf (fp, "%3.3d ", t); + printstats (tptr, fp, 0, 0, false, tot_overhead); + add (&sumstats, tptr); + } + } + } + + if (foundany) { + fprintf (fp, "SUM "); + printstats (&sumstats, fp, 0, 0, false, tot_overhead); + fprintf (fp, "\n"); + } + } + + /* Repeat overhead print in loop over threads */ + + if (wallstats.enabled && overheadstats.enabled) { + osum = 0.; + for (t = 0; t < nthreads; ++t) { + fprintf (fp, "OVERHEAD.%3.3d (wallclock seconds) = %9.3g\n", t, sum[t]); + osum += sum[t]; + } + fprintf (fp, "OVERHEAD.SUM (wallclock seconds) = %9.3g\n", osum); + } + } + + /* Print info about timers with multiple parents */ + + if (dopr_multparent) { + for (t = 0; t < nthreads; ++t) { + bool some_multparents = false; /* thread has entries with multiple parents? */ + for (ptr = timers[t]->next; ptr; ptr = ptr->next) { + if (ptr->nparent > 1) { + some_multparents = true; + break; + } + } + + if (some_multparents) { + fprintf (fp, "\nMultiple parent info for thread %d:\n", t); + if (dopr_preamble && t == 0) { + fprintf (fp, "Columns are count and name for the listed child\n" + "Rows are each parent, with their common child being the last entry, " + "which is indented.\n" + "Count next to each parent is the number of times it called the child.\n" + "Count next to child is total number of times it was called by the " + "listed parents.\n\n"); + } + + for (ptr = timers[t]->next; ptr; ptr = ptr->next) + if (ptr->nparent > 1) + print_multparentinfo (fp, ptr); + } + } + } + + /* Print hash table stats */ + + if (dopr_collision) { + for (t = 0; t < nthreads; t++) { + first = true; + totent = 0; + num_zero = 0; + num_one = 0; + num_two = 0; + num_more = 0; + most = 0; + numtimers= 0; + + for (i = 0; i < tablesize; i++) { + nument = hashtable[t][i].nument; + if (nument > 1) { + totent += nument-1; + if (first) { + first = false; + fprintf (fp, "\nthread %d had some hash collisions:\n", t); + } + fprintf (fp, "hashtable[%d][%d] had %d entries:", t, i, nument); + for (ii = 0; ii < nument; ii++) + fprintf (fp, " %s", hashtable[t][i].entries[ii]->name); + fprintf (fp, "\n"); + } + switch (nument) { + case 0: + ++num_zero; + break; + case 1: + ++num_one; + break; + case 2: + ++num_two; + break; + default: + ++num_more; + break; + } + most = MAX (most, nument); + numtimers += nument; + } + + if (totent > 0) { + fprintf (fp, "Total collisions thread %d = %d\n", t, totent); + fprintf (fp, "Entry information:\n"); + fprintf (fp, "num_zero = %d num_one = %d num_two = %d num_more = %d\n", + num_zero, num_one, num_two, num_more); + fprintf (fp, "Most = %d\n", most); + } + } + } + + /* Stats on GPTL memory usage */ + + totmem = 0.; + for (t = 0; t < nthreads; t++) { + hashmem = (float) sizeof (Hashentry) * tablesize; + regionmem = (float) numtimers * sizeof (Timer); +#ifdef HAVE_PAPI + papimem = (float) numtimers * sizeof (Papistats); +#else + papimem = 0.; +#endif + pchmem = 0.; + for (ptr = timers[t]->next; ptr; ptr = ptr->next) + pchmem += (float) (sizeof (Timer *)) * (ptr->nchildren + ptr->nparent); + + gptlmem = hashmem + regionmem + pchmem; + totmem += gptlmem; + fprintf (fp, "\n"); + fprintf (fp, "Thread %d total memory usage = %g KB\n", t, gptlmem*.001); + fprintf (fp, " Hashmem = %g KB\n" + " Regionmem = %g KB (papimem portion = %g KB)\n" + " Parent/child arrays = %g KB\n", + hashmem*.001, regionmem*.001, papimem*.001, pchmem*.001); + } + fprintf (fp, "\n"); + fprintf (fp, "Total memory usage all threads = %g KB\n", totmem*0.001); + + print_threadmapping (fp); + free (sum); + + if (fclose (fp) != 0) + fprintf (stderr, "Attempt to close %s failed\n", outfile); + + pr_has_been_called = true; + return 0; +} + +/* +** construct_tree: Build the parent->children tree starting with knowledge of +** parent list for each child. +** +** Input arguments: +** timerst: Linked list of timers +** method: method to be used to define the links +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int construct_tree (Timer *timerst, Method method) +{ + Timer *ptr; /* loop through linked list */ + Timer *pptr = 0; /* parent (init to NULL to avoid compiler warning) */ + int nparent; /* number of parents */ + int maxcount; /* max calls by a single parent */ + int n; /* loop over nparent */ + + /* + ** Walk the linked list to build the parent-child tree, using whichever + ** mechanism is in place. newchild() will prevent loops. + */ + + for (ptr = timerst; ptr; ptr = ptr->next) { + switch (method) { + case GPTLfirst_parent: + if (ptr->nparent > 0) { + pptr = ptr->parent[0]; + if (newchild (pptr, ptr) != 0); + } + break; + case GPTLlast_parent: + if (ptr->nparent > 0) { + nparent = ptr->nparent; + pptr = ptr->parent[nparent-1]; + if (newchild (pptr, ptr) != 0); + } + break; + case GPTLmost_frequent: + maxcount = 0; + for (n = 0; n < ptr->nparent; ++n) { + if (ptr->parent_count[n] > maxcount) { + pptr = ptr->parent[n]; + maxcount = ptr->parent_count[n]; + } + } + if (maxcount > 0) { /* not an orphan */ + if (newchild (pptr, ptr) != 0); + } + break; + case GPTLfull_tree: + /* + ** Careful: this one can create *lots* of output! + */ + for (n = 0; n < ptr->nparent; ++n) { + pptr = ptr->parent[n]; + if (newchild (pptr, ptr) != 0); + } + break; + default: + return GPTLerror ("construct_tree: method %d is not known\n", method); + } + } + return 0; +} + +/* +** methodstr: Return a pointer to a string which represents the method +** +** Input arguments: +** method: method type +*/ + +static char *methodstr (Method method) +{ + if (method == GPTLfirst_parent) + return "first_parent"; + else if (method == GPTLlast_parent) + return "last_parent"; + else if (method == GPTLmost_frequent) + return "most_frequent"; + else if (method == GPTLfull_tree) + return "full_tree"; + else + return "Unknown"; +} + +/* +** newchild: Add an entry to the children list of parent. Use function +** is_descendant() to prevent infinite loops. +** +** Input arguments: +** parent: parent node +** child: child to be added +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static int newchild (Timer *parent, Timer *child) +{ + int nchildren; /* number of children (temporary) */ + Timer **chptr; /* array of pointers to children */ + int n; /* loop over nchildren */ + + static const char *thisfunc = "newchild"; + + if (parent == child) + return GPTLerror ("%s: child %s can't be a parent of itself\n", thisfunc, child->name); + + /* + ** To allow construct_tree to be called multiple times, check that proposed child + ** is not a known child + */ + + for (n = 0; n < parent->nchildren; ++n) { + if (parent->children[n] == child){ + n = parent->nchildren + 1; + } + } + if (n > parent->nchildren){ + return 0; + } + + /* + ** To guarantee no loops, ensure that proposed parent isn't already a descendant of + ** proposed child + */ + + if (is_descendant (child, parent)) { + show_descendant (0, child, parent); + return GPTLerror ("%s: loop detected: NOT adding %s to descendant list of %s. " + "Proposed parent is in child's descendant path.\n", + thisfunc, child->name, parent->name); + } + + /* Safe to add the child to the parent's list of children */ + + ++parent->nchildren; + nchildren = parent->nchildren; + chptr = (Timer **) realloc (parent->children, nchildren * sizeof (Timer *)); + if ( ! chptr) + return GPTLerror ("%s: realloc error\n", thisfunc); + parent->children = chptr; + parent->children[nchildren-1] = child; + + return 0; +} + +/* +** get_max_depth: Determine the maximum call tree depth by traversing the +** tree recursively +** +** Input arguments: +** ptr: Starting timer +** startdepth: current depth when function invoked +** +** Return value: maximum depth +*/ + +static int get_max_depth (const Timer *ptr, const int startdepth) +{ + int maxdepth = startdepth; + int depth; + int n; + + for (n = 0; n < ptr->nchildren; ++n) + if ((depth = get_max_depth (ptr->children[n], startdepth+1)) > maxdepth) + maxdepth = depth; + + return maxdepth; +} + +/* +** num_descendants: Determine the number of descendants of a timer by traversing +** the tree recursively. This function is not currently used. It could be +** useful in a pruning algorithm +** +** Input arguments: +** ptr: Starting timer +** +** Return value: number of descendants +*/ + +static int num_descendants (Timer *ptr) +{ + int n; + + ptr->num_desc = ptr->nchildren; + for (n = 0; n < ptr->nchildren; ++n) { + ptr->num_desc += num_descendants (ptr->children[n]); + } + return ptr->num_desc; +} + +/* +** is_descendant: Determine whether node2 is in the descendant list for +** node1 +** +** Input arguments: +** node1: starting node for recursive search +** node2: node to be searched for +** +** Return value: true or false +*/ + +static int is_descendant (const Timer *node1, const Timer *node2) +{ + int n; + + /* Breadth before depth for efficiency */ + + for (n = 0; n < node1->nchildren; ++n) + if (node1->children[n] == node2) + return 1; + + for (n = 0; n < node1->nchildren; ++n) + if (is_descendant (node1->children[n], node2)) + return 1; + + return 0; +} + +/* +** show_descendant: list descendants, breadth first, stopping early +** if a particular node is discovered (e.g. the parent) +** +** Input arguments: +** level: current level in recursion, should be 0 when first called +** node1: starting node for recursive listing +** node2: node defining the early stopping criterion +** +** Return value: true (listed all descendants) or false (stopped early) +*/ + +static int show_descendant (const int level, const Timer *node1, const Timer *node2) +{ + int n; + + /* Breadth before depth for efficiency */ + + for (n = 0; n < node1->nchildren; ++n){ + printf ("node1: %-32s level: %d child: %d label: %-32s\n", node1->name, level, n, node1->children[n]->name); + if (node1->children[n] == node2) + return 1; + } + + for (n = 0; n < node1->nchildren; ++n) + if (show_descendant (level+1, node1->children[n], node2)) + return 1; + + return 0; +} + +/* +** printstats: print a single timer +** +** Input arguments: +** timer: timer for which to print stats +** fp: file descriptor to write to +** t: thread number +** depth: depth to indent timer +** doindent: whether indenting will be done +** tot_overhead: underlying timing routine overhead +*/ + +static void printstats (const Timer *timer, + FILE *fp, + const int t, + const int depth, + const bool doindent, + const double tot_overhead) +{ + int i; /* index */ + int indent; /* index for indenting */ + int extraspace; /* for padding to length of longest name */ + float fusr; /* user time as float */ + float fsys; /* system time as float */ + float usrsys; /* usr + sys */ + float elapse; /* elapsed time */ + float wallmax; /* max wall time */ + float wallmin; /* min wall time */ + float ratio; /* percentage calc */ + + /* Flag regions having multiple parents with a "*" in column 1 */ + + if (doindent) { + if (timer->nparent > 1) + fprintf (fp, "* "); + else + fprintf (fp, " "); + + /* Indent to depth of this timer */ + + for (indent = 0; indent < depth; ++indent) + fprintf (fp, " "); + } + + fprintf (fp, "%s", timer->name); + + /* Pad to length of longest name */ + + extraspace = max_name_len[t] - strlen (timer->name); + for (i = 0; i < extraspace; ++i) + fprintf (fp, " "); + + /* Pad to max indent level */ + + if (doindent) + for (indent = depth; indent < max_depth[t]; ++indent) + fprintf (fp, " "); + + if (timer->onflg) + fprintf (fp, " y "); + else + fprintf (fp, " - "); + + if (timer->count < PRTHRESH) { + if (timer->nrecurse > 0) + fprintf (fp, "%8lu %6lu ", timer->count, timer->nrecurse); + else + fprintf (fp, "%8lu - ", timer->count); + } else { + if (timer->nrecurse > 0) + fprintf (fp, "%8.1e %6.0e ", (float) timer->count, (float) timer->nrecurse); + else + fprintf (fp, "%8.1e - ", (float) timer->count); + } + + if (cpustats.enabled) { + fusr = timer->cpu.accum_utime / (float) ticks_per_sec; + fsys = timer->cpu.accum_stime / (float) ticks_per_sec; + usrsys = fusr + fsys; + fprintf (fp, "%9.3f %9.3f %9.3f ", fusr, fsys, usrsys); + } + + if (wallstats.enabled) { + elapse = timer->wall.accum; + wallmax = timer->wall.max; + wallmin = timer->wall.min; + fprintf (fp, "%12.6f %12.6f %12.6f ", elapse, wallmax, wallmin); + + if (percent && timers[0]->next) { + ratio = 0.; + if (timers[0]->next->wall.accum > 0.) + ratio = (timer->wall.accum * 100.) / timers[0]->next->wall.accum; + fprintf (fp, " %9.2f ", ratio); + } + + /* + ** Factor of 2 is because there are 2 utr calls per start/stop pair. + */ + + if (overheadstats.enabled) { + fprintf (fp, "%16.6f ", timer->count * 2 * tot_overhead); + } + } + +#ifdef ENABLE_PMPI + if (timer->nbytes == 0.) + fprintf (fp, " - "); + else + fprintf (fp, "%13.3e ", timer->nbytes / timer->count); +#endif + +#ifdef HAVE_PAPI + GPTL_PAPIpr (fp, &timer->aux, t, timer->count, timer->wall.accum); +#endif + + fprintf (fp, "\n"); +} + +/* +** print_multparentinfo: +** +** Input arguments: +** Input/output arguments: +*/ +void print_multparentinfo (FILE *fp, + Timer *ptr) +{ + int n; + + if (ptr->norphan > 0) { + if (ptr->norphan < PRTHRESH) + fprintf (fp, "%8u %-32s\n", ptr->norphan, "ORPHAN"); + else + fprintf (fp, "%8.1e %-32s\n", (float) ptr->norphan, "ORPHAN"); + } + + for (n = 0; n < ptr->nparent; ++n) { + if (ptr->parent_count[n] < PRTHRESH) + fprintf (fp, "%8d %-32s\n", ptr->parent_count[n], ptr->parent[n]->name); + else + fprintf (fp, "%8.1e %-32s\n", (float) ptr->parent_count[n], ptr->parent[n]->name); + } + + if (ptr->count < PRTHRESH) + fprintf (fp, "%8lu %-32s\n\n", ptr->count, ptr->name); + else + fprintf (fp, "%8.1e %-32s\n\n", (float) ptr->count, ptr->name); +} + +/* +** add: add the contents of tin to tout +** +** Input arguments: +** tin: input timer +** Input/output arguments: +** tout: output timer summed into +*/ + +static void add (Timer *tout, + const Timer *tin) +{ + tout->count += tin->count; + + if (wallstats.enabled) { + tout->wall.accum += tin->wall.accum; + + tout->wall.max = MAX (tout->wall.max, tin->wall.max); + tout->wall.min = MIN (tout->wall.min, tin->wall.min); + } + + if (cpustats.enabled) { + tout->cpu.accum_utime += tin->cpu.accum_utime; + tout->cpu.accum_stime += tin->cpu.accum_stime; + } +#ifdef HAVE_PAPI + GPTL_PAPIadd (&tout->aux, &tin->aux); +#endif +} + +/* +** GPTLpr_summary: Gather and print summary stats across +** threads and MPI tasks +** +** Input arguments: +** comm: commuicator (e.g. MPI_COMM_WORLD). If zero, use MPI_COMM_WORLD +*/ + +#ifdef HAVE_MPI +int GPTLpr_summary (MPI_Comm comm) +#else +int GPTLpr_summary (int comm) +#endif +{ + const char *outfile = "timing.summary"; + int ret; + + ret = GPTLpr_summary_file(comm, outfile); + return 0; +} + +#ifdef HAVE_MPI +int GPTLpr_summary_file (MPI_Comm comm, + const char *outfile) +#else +int GPTLpr_summary_file (int comm, + const char *outfile) +#endif +{ + int iam = 0; /* MPI rank: default master */ + int n; /* index */ + int extraspace; /* for padding to length of longest name */ + int totlen; /* length for malloc */ + char *outpath; /* path to output file: outdir/outfile */ + FILE *fp = 0; /* output file */ + + int count; /* number of timers */ + Summarystats *storage; /* storage for data from all timers */ + + int x; /* pointer increment */ + int k; /* counter */ + char *tempname; /* event name workspace */ + int max_name_length; + int len; + float temp; + int ret; /* return code */ + + static const char *thisfunc = "GPTLpr_summary_file"; + +#ifdef HAVE_MPI + int nproc; /* number of procs in MPI communicator */ + + char name[MAX_CHARS+1]; /* timer name requested by master */ + + if (((int) comm) == 0) + comm = MPI_COMM_WORLD; + + if ((ret = MPI_Comm_rank (comm, &iam)) != MPI_SUCCESS) + return GPTLerror ("%s: Bad return from MPI_Comm_rank=%d\n", thisfunc, ret); + + if ((ret = MPI_Comm_size (comm, &nproc)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Comm_size=%d\n", thisfunc, iam, ret); + +#endif + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize() has not been called\n", thisfunc); + + /* + ** Each process gathers stats for its threads. + ** Binary tree used combine results. + ** Master prints results. + */ + + if (iam == 0) { + + /* 2 is for "/" plus null */ + if (outdir) + totlen = strlen (outdir) + strlen (outfile) + 2; + else + totlen = strlen (outfile) + 2; + + outpath = (char *) GPTLallocate (totlen); + + if (outdir) { + strcpy (outpath, outdir); + strcat (outpath, "/"); + strcat (outpath, outfile); + } else { + strcpy (outpath, outfile); + } + + if (pr_append){ + if ( ! (fp = fopen (outpath, "a"))) + fp = stderr; + } + else{ + if ( ! (fp = fopen (outpath, "w"))) + fp = stderr; + } + + free (outpath); + + fprintf (fp, "$Id: gptl.c,v 1.157 2011-03-28 20:55:18 rosinski Exp $\n"); + fprintf (fp, "'count' is cumulative. All other stats are max/min\n"); +#ifndef HAVE_MPI + fprintf (fp, "NOTE: GPTL was built WITHOUT MPI: Only task 0 stats will be printed.\n"); + fprintf (fp, "This is even for MPI codes.\n"); +#endif + + count = merge_thread_data(); /*merges events from all threads*/ + + if( !( tempname = (char*)malloc((MAX_CHARS + 1) * sizeof(char) ) ) ) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + /* allocate storage for data for all timers */ + if( !( storage = malloc( sizeof(Summarystats) * count ) ) && count ) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + if ( (ret = collect_data( iam, comm, &count, &storage) ) != 0 ) + return GPTLerror ("%s: master collect_data failed\n", thisfunc); + + x = 0; /*finds max timer name length*/ + max_name_length = 0; + for( k = 0; k < count; k++ ) { + len = strlen( timerlist[0] + x ); + if( len > max_name_length ) + max_name_length = len; + x += MAX_CHARS + 1; + } + + /* Print heading */ + + fprintf (fp, "name"); + extraspace = max_name_length - strlen ("name"); + for (n = 0; n < extraspace; ++n) + fprintf (fp, " "); + fprintf (fp, " processes threads count"); + fprintf (fp, " walltotal wallmax (proc thrd ) wallmin (proc thrd )"); + + for (n = 0; n < nevents; ++n) { + fprintf (fp, " %8.8stotal", eventlist[n].str8); + fprintf (fp, " %8.8smax (proc thrd )", eventlist[n].str8); + fprintf (fp, " %8.8smin (proc thrd )", eventlist[n].str8); + } + + fprintf (fp, "\n"); + + x = 0; + for( k = 0; k < count; k++ ) { + + /* Print the results for this timer */ + memset( tempname, 0, (MAX_CHARS + 1) * sizeof(char) ); + memcpy( tempname, timerlist[0] + x, (MAX_CHARS + 1) * sizeof(char) ); + + x += (MAX_CHARS + 1); + fprintf (fp, "%s", tempname); + extraspace = max_name_length - strlen (tempname); + for (n = 0; n < extraspace; ++n) + fprintf (fp, " "); + temp = storage[k].count; + fprintf(fp, " %8d %8d %12.6e ", + storage[k].processes, storage[k].threads, temp); + fprintf (fp, " %12.6e %9.3f (%6d %6d) %9.3f (%6d %6d)", + storage[k].walltotal, + storage[k].wallmax, storage[k].wallmax_p, storage[k].wallmax_t, + storage[k].wallmin, storage[k].wallmin_p, storage[k].wallmin_t); +#ifdef HAVE_PAPI + for (n = 0; n < nevents; ++n) { + fprintf (fp, " %12.6e", storage[k].papitotal[n]); + + fprintf (fp, " %9.3e (%6d %6d)", + storage[k].papimax[n], storage[k].papimax_p[n], + storage[k].papimax_t[n]); + + fprintf (fp, " %9.3e (%6d %6d)", + storage[k].papimin[n], storage[k].papimin_p[n], + storage[k].papimin_t[n]); + } +#endif + fprintf (fp, "\n"); + } + + fprintf (fp, "\n"); + free(tempname); + + } + else { /* iam != 0 (slave) */ +#ifdef HAVE_MPI + /* count number of timers from linked list */ + count = merge_thread_data(); + + /*allocate storage for data for all timers */ + if( !( storage = malloc( sizeof(Summarystats) * count ) ) && count ) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + if ( (ret = collect_data( iam, comm, &count, &storage ) ) != 0 ) + return GPTLerror ("%s: slave collect_data failed\n", thisfunc); +#endif + } + + free(timerlist[0]); + free(timerlist); + free(storage); + if (iam == 0 && fclose (fp) != 0) + fprintf (stderr, "%s: Attempt to close %s failed\n", thisfunc, outfile); + return 0; +} + +/* +** merge_thread_data: returns number of events in merged list +*/ + +static int merge_thread_data() +{ + int n, k, x; /*counters*/ + int t; /*current thread*/ + int num_newtimers; + int compare; + int *count; + int max_count; /* largest number of timers among non-thread-0 threads */ + char **newtimers; + int length = MAX_CHARS + 1; + char ***sort; + int count_r; /* count to be returned, allows *count to be free()ed */ + Timer *ptr; + + static const char *thisfunc = "merge_thread_data"; + + if( nthreads == 1 ) { /* merging is not needed since only 1 thread */ + + /* count timers for thread 0 */ + count_r = 0; + for (ptr = timers[0]->next; ptr; ptr = ptr->next) count_r++; + + timerlist = (char **) GPTLallocate( sizeof (char *)); + if( !( timerlist[0] = (char *)malloc( count_r * length * sizeof (char)) ) && count_r) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + x = 0; + for (ptr = timers[0]->next; ptr; ptr = ptr->next) { + strcpy((timerlist[0] + x), ptr->name); + x += length; + } + + return count_r; + + } + + timerlist = (char **) GPTLallocate( nthreads * sizeof (char *)); + count = (int *) GPTLallocate( nthreads * sizeof (int)); + sort = (char ***) GPTLallocate( nthreads * sizeof (void *)); + + max_count = 0; + for (t = 0; t < nthreads; t++) { + + /* count timers for thread */ + count[t] = 0; + for (ptr = timers[t]->next; ptr; ptr = ptr->next) count[t]++; + + if( count[t] > max_count || max_count == 0 ) max_count = count[t]; + + if( !( sort[t] = (char **)malloc( count[t] * sizeof (char *)) ) && count[t]) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + /* allocate memory to hold list of timer names */ + if( !( timerlist[t] = (char *)malloc( length * count[t] * sizeof (char)) ) && count[t]) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + memset( timerlist[t], length * count[t] * sizeof (char), 0 ); + + x = 0; + for (ptr = timers[t]->next; ptr; ptr = ptr->next) { + strcpy((timerlist[t] + x), ptr->name); + x += length; + } + + x = 0; + for (k = 0; k < count[t]; k++) { + sort[t][k] = timerlist[t] + x; + x += length; + } + + qsort( sort[t], count[t], sizeof (char *), cmp ); + + } + + if( !( newtimers = (char **)malloc( max_count * sizeof (char *)) ) && max_count) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + for (t = 1; t < nthreads; t++) { + memset( newtimers, max_count * sizeof (char *), 0 ); + k = 0; + n = 0; + num_newtimers = 0; + while( k < count[0] && n < count[t] ) { + /* linear comparison of timers */ + compare = strcmp( sort[0][k], sort[t][n] ); + + if( compare == 0 ) { + /* both have, nothing needs to be done */ + k++; + n++; + continue; + } + + if( compare < 0 ) { + /* event that only master has, nothing needs to be done */ + k++; + continue; + } + + if( compare > 0 ) { + /* event that only slave thread has, need to add */ + newtimers[num_newtimers] = sort[t][n]; + n++; + num_newtimers++; + } + } + + while( n < count[t] ) { + /* adds any remaining timers, since we know that all the rest + are new since have checked all master thread timers */ + newtimers[num_newtimers] = sort[t][n]; + num_newtimers++; + n++; + } + + if( num_newtimers ) { + /* sorts by memory address to restore original order */ + qsort( newtimers, num_newtimers, sizeof(char*), ncmp ); + + /* reallocate memory to hold additional timers */ + if( !( sort[0] = realloc( sort[0], (count[0] + num_newtimers) * sizeof (char *)) ) ) + return GPTLerror ("%s: memory reallocation failed\n", thisfunc); + if( !(timerlist[0] = realloc(timerlist[0], length * (count[0] + num_newtimers) * sizeof (char)) ) ) + return GPTLerror ("%s: memory reallocation failed\n", thisfunc); + + k = count[0]; + for (n = 0; n < num_newtimers; n++) { + /* add new found timers */ + memcpy( timerlist[0] + (count[0] + n) * length, newtimers[n], length * sizeof (char) ); + } + + count[0] += num_newtimers; + + /* reassign pointers in sort since realloc will have broken them if it moved the memory. */ + x = 0; + for (k = 0; k < count[0]; k++) { + sort[0][k] = timerlist[0] + x; + x += length; + } + + qsort( sort[0], count[0], sizeof (char *), cmp ); + } + } + + free(sort[0]); + /* don't free timerlist[0], since needed for subsequent steps in gathering global statistics */ + for (t = 1; t < nthreads; t++) { + free(sort[t]); + free(timerlist[t]); + } + + free(sort); + count_r = count[0]; + free(count); + + return count_r; +} + +/* +** collect data: compute global stats using tree reduction algorithm +** returns pointer to new summarystats list +** +** Input arguments: +** iam: process id +** comm: MPI communicator +** Input/Output arguments: +** summarystats: max/min/etc stats over all processes and threads +** count: number of events +** timerlist: list of all timer names (global variable) +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +#ifdef HAVE_MPI +static int collect_data(const int iam, + MPI_Comm comm, + int *count, + Summarystats **summarystats_cumul ) +#else +static int collect_data(const int iam, + int comm, + int *count, + Summarystats **summarystats_cumul ) +#endif +{ + int step; /* spacing beween active processes */ + int mstep; /* spacing between active masters */ + int procid; /* process to communicate with */ + int ret; + int nproc; + int signal = 1; + int x, k, n; /* counters */ + char *tempname; + int s = (MAX_CHARS + 1 ); /* spacing between timer names */ + int length = MAX_CHARS + 1; + int compare; + int num_newtimers; + int count_slave; + char *timers_slave; /* slave timerlist */ + char **newtimers; + char **sort_slave; /* slave sorted list */ + char **sort_master; /* master sorted list */ + int m_index, s_index; + Summarystats *summarystats; /* stats collected on master */ + + static const char *thisfunc = "collect_data"; + +#ifdef HAVE_MPI + Summarystats *summarystats_slave; /* stats sent to master */ + const int taga = 99; + const int tagb = 100; + const int tagc = 101; + MPI_Status status; + MPI_Request rcvreq1; + MPI_Request rcvreq2; + MPI_Request rcvreq3; + + if ((ret = MPI_Comm_size (comm, &nproc)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Comm_size=%d\n", thisfunc, iam, ret); + +#endif + + summarystats = *summarystats_cumul; + + if (!( tempname = (char*)malloc((MAX_CHARS +1) * sizeof(char) ) )) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + x = 0; + for (k = 0; k < *count; k++) { + memcpy( tempname, timerlist[0] + x, (MAX_CHARS + 1) * sizeof (char) ); + /* calculate individual stats */ + get_threadstats( iam, tempname, &summarystats[k]); + x += (MAX_CHARS + 1); + } + +#ifdef HAVE_MPI + step = 1; + mstep = 2; + while( step < nproc ) { + + if ((iam % mstep) == 0) { + /* find new masters at the current level, which are at every n*step starting with 0 */ + + procid = iam + step; + if (procid < nproc) { + /* prevent lone master wanting data from nonexistent process problem */ + + /* prepare for receive */ + if ((ret = MPI_Irecv (&count_slave, 1, MPI_INTEGER, procid, taga, comm, &rcvreq2)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Irecv=%d\n", thisfunc, iam, ret); + + /* handshake with slave */ + if ((ret = MPI_Send (&signal, 1, MPI_INTEGER, procid, taga, comm)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Send=%d\n", thisfunc, iam, ret); + + /* wait for message from slave */ + if ((ret = MPI_Wait (&rcvreq2, MPI_STATUS_IGNORE)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Wait=%d\n", thisfunc, iam, ret); + + if (count_slave != 0) { /* if slave had no events, then nothing needs to be done*/ + + if (!(sort_master = (char **) malloc( (*count) * sizeof (char *) ) ) && (*count)) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + if (!(newtimers = (char **) malloc( count_slave * sizeof (char *) ) )) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + if (!(sort_slave = (char **) malloc( count_slave * sizeof (char *) ) )) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + if (!(summarystats_slave = (Summarystats *) malloc( count_slave * sizeof (Summarystats) ) )) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + if (!(timers_slave = (char *) malloc( count_slave * (MAX_CHARS + 1) * sizeof (char) ) )) + return GPTLerror ("%s: memory allocation failed\n", thisfunc); + + if ((ret = MPI_Irecv (timers_slave, count_slave * (MAX_CHARS + 1), MPI_CHAR, procid, tagb, comm, &rcvreq3)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Irecv=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Irecv (summarystats_slave, count_slave * sizeof(Summarystats), MPI_BYTE, procid, tagc, comm, &rcvreq1)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Irecv=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Send (&signal, 1, MPI_INT, procid, tagb, comm)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Send=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Wait (&rcvreq1, MPI_STATUS_IGNORE)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Wait=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Wait (&rcvreq3, MPI_STATUS_IGNORE)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Wait=%d\n", thisfunc, iam, ret); + + x = 0; + for (k = 0; k < count_slave; k++) { + sort_slave[k] = timers_slave + x; + x += MAX_CHARS + 1; + } + x = 0; + for (k = 0; k < *count; k++) { + sort_master[k] = timerlist[0] + x; + x += MAX_CHARS + 1; + } + + qsort(sort_master, *count, sizeof(char*), cmp); + qsort(sort_slave, count_slave, sizeof(char*), cmp); + + num_newtimers = 0; + n = 0; + k = 0; + while (k < *count && n < count_slave) + { + compare = strcmp(sort_master[k], sort_slave[n]); + + if (compare == 0) { + /* matching timers found */ + + /* find element number of the name in original timerlist so that it can be matched with its summarystats */ + m_index = get_index( timerlist[0], sort_master[k] ); + + s_index = get_index( timers_slave, sort_slave[n] ); + get_summarystats (&summarystats[m_index], &summarystats_slave[s_index]); + k++; + n++; + continue; + } + + if (compare > 0) { + /* s1 >s2 . slave has event; master does not */ + newtimers[num_newtimers] = sort_slave[n]; + num_newtimers++; + n++; + continue; + } + + if (compare < 0) /* only master has event; nothing needs to be done */ + k++; + } + + while (n < count_slave) { + /* add all remaining timers which only the slave has */ + newtimers[num_newtimers] = sort_slave[n]; + num_newtimers++; + n++; + } + + /* sort by memory address to get original order */ + qsort (newtimers, num_newtimers, sizeof(char*), ncmp); + + /* reallocate to hold new timer names and summary stats from slave */ + if (!(timerlist[0] = realloc( timerlist[0], length * (*count + num_newtimers) * sizeof (char) ) )) + return GPTLerror ("%s: memory reallocation failed\n", thisfunc); + if (!(summarystats = realloc( summarystats, (*count + count_slave ) * sizeof (Summarystats) ) )) + return GPTLerror ("%s: memory reallocation failed\n", thisfunc); + + k = *count; + x = *count * (MAX_CHARS + 1); + for (n = 0; n < num_newtimers; n++) { + /* copy new timers names and new timer data */ + memcpy(timerlist[0] + x, newtimers[n], length * sizeof (char)); + s_index = get_index( timers_slave, newtimers[n] ); + memcpy(&summarystats[k], &summarystats_slave[s_index], sizeof (Summarystats)); + k++; + x += MAX_CHARS + 1; + } + *count += num_newtimers; + + free(timers_slave); + free(summarystats_slave); + free(newtimers); + free(sort_slave); + free(sort_master); + } + + } + + } + else if ( (iam % step) == 0 ) { + /* non masters send data */ + + procid = iam - step; + + /* wait for ready signal from master */ + if ((ret = MPI_Recv (&signal, 1, MPI_INTEGER, procid, taga, comm, MPI_STATUS_IGNORE)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Recv=%d\n", thisfunc, iam, ret); + + if ((ret = MPI_Send (count, 1, MPI_INTEGER, procid, taga, comm)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Send=%d\n", thisfunc, iam, ret); + + if ( count != 0) { + if ((ret = MPI_Recv (&signal, 1, MPI_INTEGER, procid, tagb, comm, MPI_STATUS_IGNORE)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Recv=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Send (timerlist[0], (*count) * (MAX_CHARS + 1), MPI_CHAR, procid, tagb, comm)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Send=%d\n", thisfunc, iam, ret); + if ((ret = MPI_Send (summarystats, (*count) * sizeof(Summarystats), MPI_BYTE, procid, tagc, comm)) != MPI_SUCCESS) + return GPTLerror ("%s rank %d: Bad return from MPI_Send=%d\n", thisfunc, iam, ret); + } + free(tempname); + *summarystats_cumul = summarystats; + return 0; + + } + + step = mstep; + mstep = 2 * mstep; + + } + +#endif + + free(tempname); + *summarystats_cumul = summarystats; + return 0; +} + +/* +** get_index: calculates the index number of an element in a list +** based on the start memory address and memory address of the element +** where each element is MAX_CHARS+1 long +** +** Input arguments: +** list: start address of list +** element: start address of element +** +** Return value: index of element in list +*/ + +int get_index( const char * list, + const char * element ) +{ + return (( element - list ) / ( MAX_CHARS + 1 )); +} + + +/* +** cmp: returns value from strcmp. for use with qsort +*/ + +static int cmp(const void *pa, const void *pb) +{ + const char** x = (const char**)pa; + const char** y = (const char**)pb; + return strcmp(*x, *y); +} + + +/* +** ncmp: compares values of memory adresses pointed to by a pointer. for use with qsort +*/ + +static int ncmp( const void *pa, const void *pb ) +{ + static const char *thisfunc = "GPTLsetoption"; + const char** x = (const char**)pa; + const char** y = (const char**)pb; + + if( *x > *y ) + return 1; + if( *x < *y ) + return -1; + if( *x == *y ) + GPTLerror("%s: shared memory address between timers\n", thisfunc); +} + +/* +** get_threadstats: gather stats for timer "name" over all threads +** +** Input arguments: +** iam: MPI process id +** name: timer name +** Output arguments: +** summarystats: max/min stats over all threads +*/ + +void get_threadstats (const int iam, + const char *name, + Summarystats *summarystats) +{ +#ifdef HAVE_PAPI + int n; /* event index */ +#endif + int t; /* thread index */ + unsigned int indx; /* returned from getentry() */ + Timer *ptr; /* timer */ + + /* + ** This memset fortuitiously initializes the process values (_p) to master (0) + */ + + memset (summarystats, 0, sizeof (Summarystats)); + + summarystats->wallmax_p = iam; + summarystats->wallmin_p = iam; + + for (t = 0; t < nthreads; ++t) { + if ((ptr = getentry (hashtable[t], name, &indx))) { + + if (ptr->count > 0) { + summarystats->threads++; + summarystats->walltotal += ptr->wall.accum; + } + summarystats->count += ptr->count; + + if (ptr->wall.accum > summarystats->wallmax) { + summarystats->wallmax = ptr->wall.accum; + summarystats->wallmax_t = t; + } + + if (ptr->wall.accum < summarystats->wallmin || summarystats->wallmin == 0.) { + summarystats->wallmin = ptr->wall.accum; + summarystats->wallmin_t = t; + } +#ifdef HAVE_PAPI + for (n = 0; n < nevents; ++n) { + double value; + if (GPTL_PAPIget_eventvalue (eventlist[n].namestr, &ptr->aux, &value) != 0) { + fprintf (stderr, "Bad return from GPTL_PAPIget_eventvalue\n"); + return; + } + summarystats->papimax_p[n] = iam; + summarystats->papimin_p[n] = iam; + + if (value > summarystats->papimax[n]) { + summarystats->papimax[n] = value; + summarystats->papimax_t[n] = t; + } + + if (value < summarystats->papimin[n] || summarystats->papimin[n] == 0.) { + summarystats->papimin[n] = value; + summarystats->papimin_t[n] = t; + } + summarystats->papitotal[n] += value; + } +#endif + } + } + if ( summarystats->count ) summarystats->processes = 1; +} + +/* +** get_summarystats: write max/min stats into mpistats based on comparison +** with summarystats_slave +** +** Input arguments: +** summarystats_slave: stats from a slave process +** Input/Output arguments: +** summarystats: stats (starts out as master stats) +*/ + +void get_summarystats (Summarystats *summarystats, + const Summarystats *summarystats_slave) +{ + if (summarystats_slave->count == 0) return; + + if (summarystats_slave->wallmax > summarystats->wallmax) { + summarystats->wallmax = summarystats_slave->wallmax; + summarystats->wallmax_p = summarystats_slave->wallmax_p; + summarystats->wallmax_t = summarystats_slave->wallmax_t; + } + + if ((summarystats_slave->wallmin < summarystats->wallmin) || + (summarystats->count == 0)){ + summarystats->wallmin = summarystats_slave->wallmin; + summarystats->wallmin_p = summarystats_slave->wallmin_p; + summarystats->wallmin_t = summarystats_slave->wallmin_t; + } + +#ifdef HAVE_PAPI + { + int n; + for (n = 0; n < nevents; ++n) { + if (summarystats_slave->papimax[n] > summarystats->papimax[n]) { + summarystats->papimax[n] = summarystats_slave->papimax[n]; + summarystats->papimax_p[n] = summarystats_slave->papimax_p[n]; + summarystats->papimax_t[n] = summarystats_slave->papimax_t[n]; + } + + if ((summarystats_slave->papimin[n] < summarystats->papimin[n]) || + (summarystats->count == 0)){ + summarystats->papimin[n] = summarystats_slave->papimin[n]; + summarystats->papimin_p[n] = summarystats_slave->papimin_p[n]; + summarystats->papimin_t[n] = summarystats_slave->papimin_t[n]; + } + summarystats->papitotal[n] += summarystats_slave->papitotal[n]; + } + } +#endif + + summarystats->count += summarystats_slave->count; + summarystats->walltotal += summarystats_slave->walltotal; + summarystats->processes += summarystats_slave->processes; + summarystats->threads += summarystats_slave->threads; +} + +/* +** GPTLbarrier: When MPI enabled, set and time an MPI barrier +** +** Input arguments: +** comm: commuicator (e.g. MPI_COMM_WORLD). If zero, use MPI_COMM_WORLD +** name: region name +** +** Return value: 0 (success) +*/ + +#ifdef HAVE_MPI +int GPTLbarrier (MPI_Comm comm, const char *name) +#else +int GPTLbarrier (int comm, const char *name) +#endif +{ + int ret; + static const char *thisfunc = "GPTLbarrier"; + + ret = GPTLstart (name); +#ifdef HAVE_MPI + if ((ret = MPI_Barrier (comm)) != MPI_SUCCESS) + return GPTLerror ("%s: Bad return from MPI_Barrier=%d", thisfunc, ret); +#endif + ret = GPTLstop (name); + return 0; +} + +/* +** get_cpustamp: Invoke the proper system timer and return stats. +** +** Output arguments: +** usr: user time +** sys: system time +** +** Return value: 0 (success) +*/ + +static inline int get_cpustamp (long *usr, long *sys) +{ +#ifdef HAVE_TIMES + struct tms buf; + + (void) times (&buf); + *usr = buf.tms_utime; + *sys = buf.tms_stime; + return 0; +#else + return GPTLerror ("get_cpustamp: times() not available\n"); +#endif +} + +/* +** GPTLquery: return current status info about a timer. If certain stats are not +** enabled, they should just have zeros in them. If PAPI is not enabled, input +** counter info is ignored. +** +** Input args: +** name: timer name +** maxcounters: max number of PAPI counters to get info for +** t: thread number (if < 0, the request is for the current thread) +** +** Output args: +** count: number of times this timer was called +** onflg: whether timer is currently on +** wallclock: accumulated wallclock time +** usr: accumulated user CPU time +** sys: accumulated system CPU time +** papicounters_out: accumulated PAPI counters +*/ + +int GPTLquery (const char *name, + int t, + int *count, + int *onflg, + double *wallclock, + double *dusr, + double *dsys, + long long *papicounters_out, + const int maxcounters) +{ + Timer *ptr; /* linked list pointer */ + unsigned int indx; /* linked list index returned from getentry (unused) */ + static const char *thisfunc = "GPTLquery"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: get_thread_num failure\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + ptr = getentry (hashtable[t], name, &indx); + if ( !ptr) + return GPTLerror ("%s: requested timer %s does not have a name hash\n", thisfunc, name); + + *onflg = ptr->onflg; + *count = ptr->count; + *wallclock = ptr->wall.accum; + *dusr = ptr->cpu.accum_utime / (double) ticks_per_sec; + *dsys = ptr->cpu.accum_stime / (double) ticks_per_sec; +#ifdef HAVE_PAPI + GPTL_PAPIquery (&ptr->aux, papicounters_out, maxcounters); +#endif + return 0; +} + +/* +** GPTLquerycounters: return current PAPI counters for a timer. +** THIS ROUTINE ID DEPRECATED. USE GPTLget_eventvalue() instead +** +** Input args: +** name: timer name +** t: thread number (if < 0, the request is for the current thread) +** +** Output args: +** papicounters_out: accumulated PAPI counters +*/ + +int GPTLquerycounters (const char *name, + int t, + long long *papicounters_out) +{ + Timer *ptr; /* linked list pointer */ + unsigned int indx; /* hash index returned from getentry */ + static const char *thisfunc = "GPTLquery_counters"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: get_thread_num failure\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + ptr = getentry (hashtable[t], name, &indx); + if ( !ptr) + return GPTLerror ("%s: requested timer %s does not have a name hash\n", thisfunc, name); + +#ifdef HAVE_PAPI + /* The 999 is a hack to say "give me all the counters" */ + GPTL_PAPIquery (&ptr->aux, papicounters_out, 999); +#endif + return 0; +} + +/* +** GPTLget_wallclock: return wallclock accumulation for a timer. +** +** Input args: +** timername: timer name +** t: thread number (if < 0, the request is for the current thread) +** +** Output args: +** value: current wallclock accumulation for the timer +*/ + +int GPTLget_wallclock (const char *timername, + int t, + double *value) +{ + void *self; /* timer address when hash entry generated with *_instr */ + Timer *ptr; /* linked list pointer */ + unsigned int indx; /* hash index returned from getentry (unused) */ + static const char *thisfunc = "GPTLget_wallclock"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + if ( ! wallstats.enabled) + return GPTLerror ("%s: wallstats not enabled\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + /* + ** Don't know whether hashtable entry for timername was generated with + ** *_instr() or not, so try both possibilities + */ + + ptr = getentry (hashtable[t], timername, &indx); + if ( !ptr) { + if (sscanf (timername, "%lx", (unsigned long *) &self) < 1) + return GPTLerror ("%s: requested timer %s does not exist\n", thisfunc, timername); + ptr = getentry_instr (hashtable[t], self, &indx); + if ( !ptr) + return GPTLerror ("%s: requested timer %s does not exist\n", thisfunc, timername); + } + + *value = ptr->wall.accum; + return 0; +} + +/* +** GPTLget_eventvalue: return PAPI-based event value for a timer. All values will be +** returned as doubles, even if the event is not derived. +** +** Input args: +** timername: timer name +** eventname: event name (must be currently enabled) +** t: thread number (if < 0, the request is for the current thread) +** +** Output args: +** value: current value of the event for this timer +*/ + +int GPTLget_eventvalue (const char *timername, + const char *eventname, + int t, + double *value) +{ + void *self; /* timer address when hash entry generated with *_instr */ + Timer *ptr; /* linked list pointer */ + unsigned int indx; /* hash index returned from getentry (unused) */ + static const char *thisfunc = "GPTLget_eventvalue"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: get_thread_num failure\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + /* + ** Don't know whether hashtable entry for timername was generated with + ** *_instr() or not, so try both possibilities + */ + + ptr = getentry (hashtable[t], timername, &indx); + if ( !ptr) { + if (sscanf (timername, "%lx", (unsigned long *) &self) < 1) + return GPTLerror ("%s: requested timer %s does not exist\n", thisfunc, timername); + ptr = getentry_instr (hashtable[t], self, &indx); + if ( !ptr) + return GPTLerror ("%s: requested timer %s does not exist\n", thisfunc, timername); + } + +#ifdef HAVE_PAPI + return GPTL_PAPIget_eventvalue (eventname, &ptr->aux, value); +#else + return GPTLerror ("%s: PAPI not enabled\n", thisfunc); +#endif +} + +/* +** GPTLget_nregions: return number of regions (i.e. timer names) for this thread +** +** Input args: +** t: thread number (if < 0, the request is for the current thread) +** +** Output args: +** nregions: number of regions +*/ + +int GPTLget_nregions (int t, + int *nregions) +{ + Timer *ptr; /* walk through linked list */ + static const char *thisfunc = "GPTLget_nregions"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: get_thread_num failure\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + *nregions = 0; + for (ptr = timers[t]->next; ptr; ptr = ptr->next) + ++*nregions; + + return 0; +} + +/* +** GPTLget_regionname: return region name for this thread +** +** Input args: +** t: thread number (if < 0, the request is for the current thread) +** region: region number +** nc: max number of chars to put in name +** +** Output args: +** name region name +*/ + +int GPTLget_regionname (int t, /* thread number */ + int region, /* region number (0-based) */ + char *name, /* output region name */ + int nc) /* number of chars in name (free form Fortran) */ +{ + int ncpy; /* number of characters to copy */ + int i; /* index */ + Timer *ptr; /* walk through linked list */ + static const char *thisfunc = "GPTLget_regionname"; + + if ( ! initialized) + return GPTLerror ("%s: GPTLinitialize has not been called\n", thisfunc); + + /* + ** If t is < 0, assume the request is for the current thread + */ + + if (t < 0) { + if ((t = get_thread_num ()) < 0) + return GPTLerror ("%s: get_thread_num failure\n", thisfunc); + } else { + if (t >= maxthreads) + return GPTLerror ("%s: requested thread %d is too big\n", thisfunc, t); + } + + ptr = timers[t]->next; + for (i = 0; i < region; i++) { + if ( ! ptr) + return GPTLerror ("%s: timer number %d does not exist in thread %d\n", thisfunc, region, t); + ptr = ptr->next; + } + + if (ptr) { + ncpy = MIN (nc, strlen (ptr->name)); + strncpy (name, ptr->name, ncpy); + + /* + ** Adding the \0 is only important when called from C + */ + + if (ncpy < nc) + name[ncpy] = '\0'; + } else { + return GPTLerror ("%s: timer number %d does not exist in thread %d\n", thisfunc, region, t); + } + return 0; +} + +/* +** GPTLis_initialized: Return whether GPTL has been initialized +*/ + +int GPTLis_initialized (void) +{ + return (int) initialized; +} + +/* +** getentry_instr: find hash table entry and return a pointer to it +** +** Input args: +** hashtable: the hashtable (array) +** self: input address (from -finstrument-functions) +** Output args: +** indx: hashtable index +** +** Return value: pointer to the entry, or NULL if not found +*/ + +static inline Timer *getentry_instr (const Hashentry *hashtable, /* hash table */ + void *self, /* address */ + unsigned int *indx) /* hash index */ +{ + int i; + Timer *ptr = 0; /* return value when entry not found */ + + /* + ** Hash index is timer address modulo the table size + ** On most machines, right-shifting the address helps because linkers often + ** align functions on even boundaries + */ + + *indx = (((unsigned long) self) >> 4) % tablesize; + for (i = 0; i < hashtable[*indx].nument; ++i) { + if (hashtable[*indx].entries[i]->address == self) { + ptr = hashtable[*indx].entries[i]; + break; + } + } + return ptr; +} + +/* +** getentry: find the entry in the hash table and return a pointer to it. +** +** Input args: +** hashtable: the hashtable (array) +** name: string to be hashed on (specifically, summed) +** Output args: +** indx: hashtable index +** +** Return value: pointer to the entry, or NULL if not found +*/ + +static inline Timer *getentry (const Hashentry *hashtable, /* hash table */ + const char *name, /* name to hash */ + unsigned int *indx) /* hash index */ +{ + int i; /* multiplier for hashing; loop index */ + const unsigned char *c; /* pointer to elements of "name" */ + Timer *ptr = 0; /* return value when entry not found */ + + /* + ** Hash value is sum of: chars times their 1-based position index, modulo tablesize + */ + + *indx = 0; + c = (unsigned char *) name; + for (i = 1; *c && i < MAX_CHARS+1; ++c, ++i) { + *indx += (*c) * i; + } + + *indx %= tablesize; + + /* + ** If nument exceeds 1 there was a hash collision and we must search + ** linearly through an array for a match + */ + + for (i = 0; i < hashtable[*indx].nument; i++) { + if (STRMATCH (name, hashtable[*indx].entries[i]->name)) { + ptr = hashtable[*indx].entries[i]; + break; + } + } + return ptr; +} + +/* +** getentryf: find the entry in the hash table and return a pointer to it. +** (variant of getentry where string length is included because string +** may not be null terminated) +** +** Input args: +** hashtable: the hashtable (array) +** name: string to be hashed on (specifically, summed) +** namelen: number of characters in string +** Output args: +** indx: hashtable index +** +** Return value: pointer to the entry, or NULL if not found +*/ + +static inline Timer *getentryf (const Hashentry *hashtable, /* hash table */ + const char *name, /* name to hash */ + const int namelen, /* length of name */ + unsigned int *indx) /* hash index */ +{ + int i; /* multiplier for hashing; loop index */ + int numchars; /* maximum number of characters to examine */ + const unsigned char *c; /* pointer to elements of "name" */ + Timer *ptr = 0; /* return value when entry not found */ + + numchars = MIN (namelen, MAX_CHARS); + + /* + ** Hash value is sum of: chars times their 1-based position index, modulo tablesize + */ + + *indx = 0; + c = (unsigned char *) name; + for (i = 1; i < numchars+1; ++c, ++i) { + *indx += (*c) * i; + } + + *indx %= tablesize; + + /* + ** If nument exceeds 1 there was a hash collision and we must search + ** linearly through an array for a match + */ + + for (i = 0; i < hashtable[*indx].nument; i++) { + if (STRNMATCH (name, hashtable[*indx].entries[i]->name,numchars)) { + ptr = hashtable[*indx].entries[i]; + break; + } + } + return ptr; +} + +/* +** Add entry points for auto-instrumented codes +** Auto instrumentation flags for various compilers: +** +** gcc, pathcc, icc: -finstrument-functions +** pgcc: -Minstrument:functions +** xlc: -qdebug=function_trace +*/ + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef _AIX +void __func_trace_enter (const char *function_name, + const char *file_name, + int line_number, + void **const user_data) +{ + (void) GPTLstart (function_name); +} + +void __func_trace_exit (const char *function_name, + const char *file_name, + int line_number, + void **const user_data) +{ + (void) GPTLstop (function_name); +} + +#else + +void __cyg_profile_func_enter (void *this_fn, + void *call_site) +{ + (void) GPTLstart_instr (this_fn); +} + +void __cyg_profile_func_exit (void *this_fn, + void *call_site) +{ + (void) GPTLstop_instr (this_fn); +} +#endif + +#ifdef __cplusplus +}; +#endif + +#ifdef HAVE_NANOTIME +#ifdef BIT64 +/* 64-bit code copied from PAPI library */ +static inline unsigned long long nanotime (void) +{ + unsigned long long val; + do { + unsigned int a,d; + asm volatile("rdtsc" : "=a" (a), "=d" (d)); + (val) = ((unsigned long)a) | (((unsigned long)d)<<32); + } while(0); + + return (val); +} +#else +static inline unsigned long long nanotime (void) +{ + unsigned long long val; + __asm__ __volatile__("rdtsc" : "=A" (val) : ); + return (val); +} +#endif + +#define LEN 4096 + +static float get_clockfreq () +{ + FILE *fd = 0; + char buf[LEN]; + int is; + + if ( ! (fd = fopen ("/proc/cpuinfo", "r"))) { + fprintf (stderr, "get_clockfreq: can't open /proc/cpuinfo\n"); + return -1.; + } + + while (fgets (buf, LEN, fd)) { + if (strncmp (buf, "cpu MHz", 7) == 0) { + for (is = 7; buf[is] != '\0' && !isdigit (buf[is]); is++); + if (isdigit (buf[is])) + return (float) atof (&buf[is]); + } + } + + return -1.; +} +#endif + +/* +** The following are the set of underlying timing routines which may or may +** not be available. And their accompanying init routines. +** NANOTIME is currently only available on x86. +*/ + +static int init_nanotime () +{ + static const char *thisfunc = "init_nanotime"; +#ifdef HAVE_NANOTIME + if ((cpumhz = get_clockfreq ()) < 0) + return GPTLerror ("%s: Can't get clock freq\n", thisfunc); + + if (verbose) + printf ("%s: Clock rate = %f MHz\n", thisfunc, cpumhz); + + cyc2sec = 1./(cpumhz * 1.e6); + return 0; +#else + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_nanotime () +{ +#ifdef HAVE_NANOTIME + double timestamp; + timestamp = nanotime () * cyc2sec; + return timestamp; +#else + static const char *thisfunc = "utr_nanotime"; + (void) GPTLerror ("%s: not enabled\n", thisfunc); + return -1.; +#endif +} + +/* +** MPI_Wtime requires the MPI lib. +*/ + +static int init_mpiwtime () +{ +#ifdef HAVE_MPI + return 0; +#else + static const char *thisfunc = "init_mpiwtime"; + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_mpiwtime () +{ +#ifdef HAVE_MPI + return MPI_Wtime (); +#else + static const char *thisfunc = "utr_mpiwtime"; + (void) GPTLerror ("%s: not enabled\n", thisfunc); + return -1.; +#endif +} + +/* +** PAPI_get_real_usec requires the PAPI lib. +*/ + +static int init_papitime () +{ + static const char *thisfunc = "init_papitime"; +#ifdef HAVE_PAPI + ref_papitime = PAPI_get_real_usec (); + if (verbose) + printf ("%s: ref_papitime=%ld\n", thisfunc, (long) ref_papitime); + return 0; +#else + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_papitime () +{ +#ifdef HAVE_PAPI + return (PAPI_get_real_usec () - ref_papitime) * 1.e-6; +#else + static const char *thisfunc = "utr_papitime"; + (void) GPTLerror ("%s: not enabled\n", thisfunc); + return -1.; +#endif +} + +/* +** Probably need to link with -lrt for this one to work +*/ + +static int init_clock_gettime () +{ + static const char *thisfunc = "init_clock_gettime"; +#ifdef HAVE_LIBRT + struct timespec tp; + (void) clock_gettime (CLOCK_REALTIME, &tp); + ref_clock_gettime = tp.tv_sec; + if (verbose) + printf ("%s: ref_clock_gettime=%ld\n", thisfunc, (long) ref_clock_gettime); + return 0; +#else + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_clock_gettime () +{ +#ifdef HAVE_LIBRT + struct timespec tp; + (void) clock_gettime (CLOCK_REALTIME, &tp); + return (tp.tv_sec - ref_clock_gettime) + 1.e-9*tp.tv_nsec; +#else + static const char *thisfunc = "utr_clock_gettime"; + (void) GPTLerror ("%s: not enabled\n", thisfunc); + return -1.; +#endif +} + +/* +** High-res timer on AIX: read_real_time +*/ + +static int init_read_real_time () +{ + static const char *thisfunc = "init_read_real_time"; +#ifdef _AIX + timebasestruct_t ibmtime; + (void) read_real_time (&ibmtime, TIMEBASE_SZ); + (void) time_base_to_time (&ibmtime, TIMEBASE_SZ); + ref_read_real_time = ibmtime.tb_high; + if (verbose) + printf ("%s: ref_read_real_time=%ld\n", thisfunc, (long) ref_read_real_time); + return 0; +#else + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_read_real_time () +{ +#ifdef _AIX + timebasestruct_t ibmtime; + (void) read_real_time (&ibmtime, TIMEBASE_SZ); + (void) time_base_to_time (&ibmtime, TIMEBASE_SZ); + return (ibmtime.tb_high - ref_read_real_time) + 1.e-9*ibmtime.tb_low; +#else + static const char *thisfunc = "utr_read_real_time"; + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +/* +** Default available most places: gettimeofday +*/ + +static int init_gettimeofday () +{ + static const char *thisfunc = "init_gettimeofday"; +#ifdef HAVE_GETTIMEOFDAY + struct timeval tp; + (void) gettimeofday (&tp, 0); + ref_gettimeofday = tp.tv_sec; + if (verbose) + printf ("%s: ref_gettimeofday=%ld\n", thisfunc, (long) ref_gettimeofday); + return 0; +#else + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +static inline double utr_gettimeofday () +{ +#ifdef HAVE_GETTIMEOFDAY + struct timeval tp; + (void) gettimeofday (&tp, 0); + return (tp.tv_sec - ref_gettimeofday) + 1.e-6*tp.tv_usec; +#else + static const char *thisfunc = "utr_gettimeofday"; + return GPTLerror ("%s: not enabled\n", thisfunc); +#endif +} + +/* +** Determine underlying timing routine overhead: call it 1000 times. +*/ + +static double utr_getoverhead () +{ + double val2[1001]; + int i; + + val2[0] = (*ptr2wtimefunc)(); + for (i = 1; i < 1001; ++i) { + val2[i] = (*ptr2wtimefunc)(); + } + return 0.001 * (val2[1000] - val2[0]); +} + +/* +** printself_andchildren: Recurse through call tree, printing stats for self, then children +*/ + +static void printself_andchildren (const Timer *ptr, + FILE *fp, + const int t, + const int depth, + const double tot_overhead) +{ + int n; + + if (depth > -1) /* -1 flag is to avoid printing stats for dummy outer timer */ + printstats (ptr, fp, t, depth, true, tot_overhead); + + for (n = 0; n < ptr->nchildren; n++) + printself_andchildren (ptr->children[n], fp, t, depth+1, tot_overhead); +} + +#ifdef ENABLE_PMPI +/* +** GPTLgetentry: called ONLY from pmpi.c (i.e. not a public entry point). Returns a pointer to the +** requested timer name by calling internal function getentry() +** +** Return value: 0 (NULL) or the return value of getentry() +*/ + +Timer *GPTLgetentry (const char *name) +{ + int t; /* thread number */ + unsigned int indx; /* returned from getentry (unused) */ + static const char *thisfunc = "GPTLgetentry"; + + if ( ! initialized) { + (void) GPTLerror ("%s: initialization was not completed\n", thisfunc); + return 0; + } + + if ((t = get_thread_num ()) < 0) { + (void) GPTLerror ("%s: bad return from get_thread_num\n", thisfunc); + return 0; + } + + return (getentry (hashtable[t], name, &indx)); +} + +/* +** GPTLpr_file_has_been_called: Called ONLY from pmpi.c (i.e. not a public entry point). Return +** whether GPTLpr_file has been called. MPI_Finalize wrapper needs +** to know whether it needs to call GPTLpr. +*/ + +int GPTLpr_has_been_called (void) +{ + return (int) pr_has_been_called; +} + +#endif + +/*************************************************************************************/ + +/* +** Contents of inserted threadutil.c starts here. +** Moved to gptl.c to enable inlining +*/ + +/* +** $Id: gptl.c,v 1.157 2011-03-28 20:55:18 rosinski Exp $ +** +** Author: Jim Rosinski +** +** Utility functions handle thread-based GPTL needs. +*/ + +/* Max allowable number of threads (used only when THREADED_PTHREADS is true) */ +#define MAX_THREADS 128 + +/**********************************************************************************/ +/* +** 3 sets of routines: OMP threading, PTHREADS, unthreaded +*/ + +#if ( defined THREADED_OMP ) + +/* +** threadinit: Allocate and initialize threadid_omp; set max number of threads +** +** Output results: +** maxthreads: max number of threads +** +** threadid_omp[] is allocated and initialized to -1 +** +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static int threadinit (void) +{ + int t; /* loop index */ + static const char *thisfunc = "threadinit"; + + if (omp_get_thread_num () != 0) + return GPTLerror ("OMP %s: MUST only be called by the master thread\n", thisfunc); + + /* + ** Allocate the threadid array which maps physical thread IDs to logical IDs + ** For OpenMP this will be just threadid_omp[iam] = iam; + */ + + if (threadid_omp) + return GPTLerror ("OMP %s: has already been called.\nMaybe mistakenly called by multiple threads?", + thisfunc); + + maxthreads = MAX ((1), (omp_get_max_threads ())); + if ( ! (threadid_omp = (int *) GPTLallocate (maxthreads * sizeof (int)))) + return GPTLerror ("OMP %s: malloc failure for %d elements of threadid_omp\n", thisfunc, maxthreads); + + /* + ** Initialize threadid array to flag values for use by get_thread_num(). + ** get_thread_num() will fill in the values on first use. + */ + + for (t = 0; t < maxthreads; ++t) + threadid_omp[t] = -1; + +#ifdef VERBOSE + printf ("OMP %s: Set maxthreads=%d\n", thisfunc, maxthreads); +#endif + + return 0; +} + +/* +** Threadfinalize: clean up +** +** Output results: +** threadid_omp array is freed and array pointer nullified +*/ + +static void threadfinalize () +{ + free ((void *) threadid_omp); + threadid_omp = 0; +} + +/* +** get_thread_num: Determine thread number of the calling thread +** Start PAPI counters if enabled and first call for this thread. +** +** Output results: +** nthreads: Number of threads (=maxthreads) +** threadid_omp: Our thread id added to list on 1st call +** +** Return value: thread number (success) or GPTLerror (failure) +*/ + +static inline int get_thread_num (void) +{ + int t; /* thread number */ + static const char *thisfunc = "get_thread_num"; + + if ((t = omp_get_thread_num ()) >= maxthreads) + return GPTLerror ("OMP %s: returned id=%d exceeds maxthreads=%d\n", thisfunc, t, maxthreads); + + /* + ** If our thread number has already been set in the list, we are done + */ + + if (t == threadid_omp[t]) + return t; + + /* + ** Thread id not found. Modify threadid_omp with our ID, then start PAPI events if required. + ** Due to the setting of threadid_omp, everything below here will only execute once per thread. + */ + + threadid_omp[t] = t; + +#ifdef VERBOSE + printf ("OMP %s: 1st call t=%d\n", thisfunc, t); +#endif + +#ifdef HAVE_PAPI + + /* + ** When HAVE_PAPI is true, if 1 or more PAPI events are enabled, + ** create and start an event set for the new thread. + */ + + if (GPTLget_npapievents () > 0) { +#ifdef VERBOSE + printf ("OMP %s: Starting EventSet t=%d\n", thisfunc, t); +#endif + + if (GPTLcreate_and_start_events (t) < 0) + return GPTLerror ("OMP %s: error from GPTLcreate_and_start_events for thread %d\n", thisfunc, t); + } +#endif + + /* + ** nthreads = maxthreads based on setting in threadinit + */ + + nthreads = maxthreads; +#ifdef VERBOSE + printf ("OMP %s: nthreads=%d\n", thisfunc, nthreads); +#endif + + return t; +} + +static void print_threadmapping (FILE *fp) +{ + int n; + + fprintf (fp, "\n"); + fprintf (fp, "Thread mapping:\n"); + for (n = 0; n < nthreads; ++n) + fprintf (fp, "threadid_omp[%d] = %d\n", n, threadid_omp[n]); +} + +/**********************************************************************************/ +/* +** PTHREADS +*/ + +#elif ( defined THREADED_PTHREADS ) + +/* +** threadinit: Allocate threadid and initialize to -1; set max number of threads; +** Initialize the mutex for later use; Initialize nthreads to 0 +** +** Output results: +** nthreads: number of threads (init to zero here, increment later in get_thread_num) +** maxthreads: max number of threads (MAX_THREADS) +** +** threadid[] is allocated and initialized to -1 +** mutex is initialized for future use +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +static int threadinit (void) +{ + int t; /* thread number */ + int ret; /* return code */ + static const char *thisfunc = "threadinit"; + + /* + ** The following test is not rock-solid, but it's pretty close in terms of guaranteeing that + ** threadinit gets called by only 1 thread. Problem is, mutex hasn't yet been initialized + ** so we can't use it. + */ + + if (nthreads == -1) + nthreads = 0; + else + return GPTLerror ("PTHREADS %s: has already been called.\n" + "Maybe mistakenly called by multiple threads?\n", thisfunc); + + /* + ** Initialize the mutex required for critical regions. + ** Previously, t_mutex = PTHREAD_MUTEX_INITIALIZER on the static declaration line was + ** adequate to initialize the mutex. But this failed in programs that invoked + ** GPTLfinalize() followed by GPTLinitialize(). + ** "man pthread_mutex_init" indicates that passing NULL as the second argument to + ** pthread_mutex_init() should appropriately initialize the mutex, assuming it was + ** properly destroyed by a previous call to pthread_mutex_destroy(); + */ + +#ifdef MUTEX_API + if ((ret = pthread_mutex_init ((pthread_mutex_t *) &t_mutex, NULL)) != 0) + return GPTLerror ("PTHREADS %s: mutex init failure: ret=%d\n", thisfunc, ret); +#endif + + /* + ** Allocate the threadid array which maps physical thread IDs to logical IDs + */ + + if (threadid) + return GPTLerror ("PTHREADS %s: threadid not null\n", thisfunc); + else if ( ! (threadid = (pthread_t *) GPTLallocate (MAX_THREADS * sizeof (pthread_t)))) + return GPTLerror ("PTHREADS %s: malloc failure for %d elements of threadid\n", thisfunc, MAX_THREADS); + + maxthreads = MAX_THREADS; + + /* + ** Initialize threadid array to flag values for use by get_thread_num(). + ** get_thread_num() will fill in the values on first use. + */ + + for (t = 0; t < maxthreads; ++t) + threadid[t] = (pthread_t) -1; + +#ifdef VERBOSE + printf ("PTHREADS %s: Set maxthreads=%d nthreads=%d\n", thisfunc, maxthreads, nthreads); +#endif + + return 0; +} + +/* +** threadfinalize: Clean up +** +** Output results: +** threadid array is freed and array pointer nullified +** mutex is destroyed +*/ + +static void threadfinalize () +{ + int ret; + +#ifdef MUTEX_API + if ((ret = pthread_mutex_destroy ((pthread_mutex_t *) &t_mutex)) != 0) + printf ("threadfinalize: failed attempt to destroy t_mutex: ret=%d\n", ret); +#endif + free ((void *) threadid); + threadid = 0; +} + +/* +** get_thread_num: Determine zero-based thread number of the calling thread. +** Update nthreads and maxthreads if necessary. +** Start PAPI counters if enabled and first call for this thread. +** +** Output results: +** nthreads: Updated number of threads +** threadid: Our thread id added to list on 1st call +** +** Return value: thread number (success) or GPTLerror (failure) +*/ + +static inline int get_thread_num (void) +{ + int t; /* logical thread number, defined by array index of found threadid */ + pthread_t mythreadid; /* thread id from pthreads library */ + int retval; /* value to return to caller */ + bool foundit = false; /* thread id found in list */ + static const char *thisfunc = "get_thread_num"; + + mythreadid = pthread_self (); + + /* + ** If our thread number has already been set in the list, we are done + ** VECTOR code should run a bit faster on vector machines. + */ +#define VECTOR +#ifdef VECTOR + for (t = 0; t < nthreads; ++t) + if (pthread_equal (mythreadid, threadid[t])) { + foundit = true; + retval = t; + } + + if (foundit) + return retval; +#else + for (t = 0; t < nthreads; ++t) + if (pthread_equal (mythreadid, threadid[t])) + return t; +#endif + + /* + ** Thread id not found. Define a critical region, then start PAPI counters if + ** necessary and modify threadid[] with our id. + */ + + if (lock_mutex () < 0) + return GPTLerror ("PTHREADS %s: mutex lock failure\n", thisfunc); + + /* + ** If our thread id is not in the known list, add to it after checking that + ** we do not have too many threads. + */ + + if (nthreads >= MAX_THREADS) { + if (unlock_mutex () < 0) + fprintf (stderr, "PTHREADS %s: mutex unlock failure\n", thisfunc); + + return GPTLerror ("PTHREADS %s: nthreads=%d is too big. Recompile " + "with larger value of MAX_THREADS\n", thisfunc, nthreads); + } + + threadid[nthreads] = mythreadid; + +#ifdef VERBOSE + printf ("PTHREADS %s: 1st call threadid=%lu maps to location %d\n", + thisfunc, (unsigned long) mythreadid, nthreads); +#endif + +#ifdef HAVE_PAPI + + /* + ** When HAVE_PAPI is true, if 1 or more PAPI events are enabled, + ** create and start an event set for the new thread. + */ + + if (GPTLget_npapievents () > 0) { +#ifdef VERBOSE + printf ("PTHREADS get_thread_num: Starting EventSet threadid=%lu location=%d\n", + (unsigned long) mythreadid, nthreads); +#endif + if (GPTLcreate_and_start_events (nthreads) < 0) { + if (unlock_mutex () < 0) + fprintf (stderr, "PTHREADS %s: mutex unlock failure\n", thisfunc); + + return GPTLerror ("PTHREADS %s: error from GPTLcreate_and_start_events for thread %d\n", + thisfunc, nthreads); + } + } +#endif + + /* + ** IMPORTANT to set return value before unlocking the mutex!!!! + ** "return nthreads-1" fails occasionally when another thread modifies + ** nthreads after it gets the mutex! + */ + + retval = nthreads++; + +#ifdef VERBOSE + printf ("PTHREADS get_thread_num: nthreads bumped to %d\n", nthreads); +#endif + + if (unlock_mutex () < 0) + return GPTLerror ("PTHREADS %s: mutex unlock failure\n", thisfunc); + + return retval; +} + +/* +** lock_mutex: lock a mutex for private access +*/ + +static int lock_mutex () +{ + static const char *thisfunc = "lock_mutex"; + + if (pthread_mutex_lock ((pthread_mutex_t *) &t_mutex) != 0) + return GPTLerror ("%s: failure from pthread_lock_mutex\n", thisfunc); + + return 0; +} + +/* +** unlock_mutex: unlock a mutex from private access +*/ + +static int unlock_mutex () +{ + static const char *thisfunc = "unlock_mutex"; + + if (pthread_mutex_unlock ((pthread_mutex_t *) &t_mutex) != 0) + return GPTLerror ("%s: failure from pthread_unlock_mutex\n", thisfunc); + return 0; +} + +static void print_threadmapping (FILE *fp) +{ + int t; + + fprintf (fp, "\n"); + fprintf (fp, "Thread mapping:\n"); + for (t = 0; t < nthreads; ++t) + fprintf (fp, "threadid[%d] = %lu\n", t, (unsigned long) threadid[t]); +} + +/**********************************************************************************/ +/* +** Unthreaded case +*/ + +#else + +static int threadinit (void) +{ + static const char *thisfunc = "threadinit"; + + if (nthreads != -1) + return GPTLerror ("Unthreaded %s: MUST only be called once", thisfunc); + + nthreads = 0; + maxthreads = 1; + return 0; +} + +void threadfinalize () +{ + threadid = -1; +} + +static inline int get_thread_num () +{ + static const char *thisfunc = "get_thread_num"; +#ifdef HAVE_PAPI + /* + ** When HAVE_PAPI is true, if 1 or more PAPI events are enabled, + ** create and start an event set for the new thread. + */ + + if (threadid == -1 && GPTLget_npapievents () > 0) { + if (GPTLcreate_and_start_events (0) < 0) + return GPTLerror ("Unthreaded %s: error from GPTLcreate_and_start_events for thread %0\n", thisfunc); + + threadid = 0; + } +#endif + + nthreads = 1; + return 0; +} + +static void print_threadmapping (FILE *fp) +{ + fprintf (fp, "\n"); + fprintf (fp, "threadid[0] = 0\n"); +} + +#endif diff --git a/components/cism/glimmer-cism/utils/libgptl/gptl.h b/components/cism/glimmer-cism/utils/libgptl/gptl.h new file mode 100644 index 0000000000..1f69bf6d4e --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/gptl.h @@ -0,0 +1,162 @@ +/* +** $Id: gptl.h,v 1.59 2011-03-28 20:55:19 rosinski Exp $ +** +** Author: Jim Rosinski +** +** GPTL header file to be included in user code +*/ + +#ifndef GPTL_H +#define GPTL_H + +#ifdef INCLUDE_CMAKE_FCI +#include "cmake_fortran_c_interface.h" +#endif + +/* following block for camtimers only */ +#ifndef NO_GETTIMEOFDAY +#define HAVE_GETTIMEOFDAY +#endif + +#ifdef SPMD +#define HAVE_MPI +#endif + +#ifdef _OPENMP +#ifndef THREADED_PTHREADS +#define THREADED_OMP +#endif +#endif +/* above block for camtimers only */ + +#ifdef HAVE_MPI +#include +#endif + +/* +** Options settable by a call to GPTLsetoption() (default in parens) +** These numbers need to be small integers because GPTLsetoption can +** be passed PAPI counters, and we need to avoid collisions in that +** integer space. PAPI presets are big negative integers, and PAPI +** native events are big positive integers. +*/ + +typedef enum { + GPTLsync_mpi = 0, /* Synchronize before certain MPI calls (PMPI-mode only) */ + GPTLwall = 1, /* Collect wallclock stats (true) */ + GPTLcpu = 2, /* Collect CPU stats (false)*/ + GPTLabort_on_error = 3, /* Abort on failure (false) */ + GPTLoverhead = 4, /* Estimate overhead of underlying timing routine (true) */ + GPTLdepthlimit = 5, /* Only print timers this depth or less in the tree (inf) */ + GPTLverbose = 6, /* Verbose output (false) */ + GPTLnarrowprint = 7, /* Print PAPI and derived stats in 8 columns not 16 (true) */ + GPTLpercent = 9, /* Add a column for percent of first timer (false) */ + GPTLpersec = 10, /* Add a PAPI column that prints "per second" stats (true) */ + GPTLmultiplex = 11, /* Allow PAPI multiplexing (false) */ + GPTLdopr_preamble = 12, /* Print preamble info (true) */ + GPTLdopr_threadsort = 13, /* Print sorted thread stats (true) */ + GPTLdopr_multparent = 14, /* Print multiple parent info (true) */ + GPTLdopr_collision = 15, /* Print hastable collision info (true) */ + GPTLprint_method = 16, /* Tree print method: first parent, last parent + most frequent, or full tree (most frequent) */ + GPTLtablesize = 50, /* per-thread size of hash table (1024) */ + /* + ** These are derived counters based on PAPI counters. All default to false + */ + GPTL_IPC = 17, /* Instructions per cycle */ + GPTL_CI = 18, /* Computational intensity */ + GPTL_FPC = 19, /* FP ops per cycle */ + GPTL_FPI = 20, /* FP ops per instruction */ + GPTL_LSTPI = 21, /* Load-store instruction fraction */ + GPTL_DCMRT = 22, /* L1 miss rate (fraction) */ + GPTL_LSTPDCM = 23, /* Load-stores per L1 miss */ + GPTL_L2MRT = 24, /* L2 miss rate (fraction) */ + GPTL_LSTPL2M = 25, /* Load-stores per L2 miss */ + GPTL_L3MRT = 26 /* L3 read miss rate (fraction) */ +} Option; + +/* +** Underlying wallclock timer: optimize for best granularity with least overhead. +** These numbers need not be distinct from the above because these are passed +** to GPTLsetutr() and the above are passed to GPTLsetoption() +*/ + +typedef enum { + GPTLgettimeofday = 1, /* the default */ + GPTLnanotime = 2, /* only available on x86 */ + GPTLmpiwtime = 4, /* MPI_Wtime */ + GPTLclockgettime = 5, /* clock_gettime */ + GPTLpapitime = 6, /* only if PAPI is available */ + GPTLread_real_time = 3 /* AIX only */ +} Funcoption; + +/* +** How to report parent/child relationships at print time (for children with multiple parents) +*/ + +typedef enum { + GPTLfirst_parent = 1, /* first parent found */ + GPTLlast_parent = 2, /* last parent found */ + GPTLmost_frequent = 3, /* most frequent parent (default) */ + GPTLfull_tree = 4 /* complete call tree */ +} Method; + +/* +** Function prototypes +*/ + +#ifdef __cplusplus +extern "C" { +#endif + +extern int GPTLsetoption (const int, const int); +extern int GPTLinitialize (void); +extern int GPTLstart (const char *); +extern int GPTLstart_handle (const char *, void **); +extern int GPTLstartf (const char *, const int); +extern int GPTLstartf_handle (const char *, const int, void **); +extern int GPTLstop (const char *); +extern int GPTLstopf (const char *, const int); +extern int GPTLstop_handle (const char *, void **); +extern int GPTLstopf_handle (const char *, const int, void **); +extern int GPTLstamp (double *, double *, double *); +extern int GPTLpr_set_append (void); +extern int GPTLpr_query_append (void); +extern int GPTLpr_set_write (void); +extern int GPTLpr_query_write (void); +extern int GPTLpr (const int); +extern int GPTLpr_file (const char *); + +#ifdef HAVE_MPI +extern int GPTLpr_summary (MPI_Comm comm); +extern int GPTLpr_summary_file (MPI_Comm, const char *); +extern int GPTLbarrier (MPI_Comm comm, const char *); +#else +extern int GPTLpr_summary (int); +extern int GPTLpr_summary_file (int, const char *); +extern int GPTLbarrier (int, const char *); +#endif + +extern int GPTLreset (void); +extern int GPTLfinalize (void); +extern int GPTLget_memusage (int *, int *, int *, int *, int *); +extern int GPTLprint_memusage (const char *); +extern int GPTLenable (void); +extern int GPTLdisable (void); +extern int GPTLsetutr (const int); +extern int GPTLquery (const char *, int, int *, int *, double *, double *, double *, + long long *, const int); +extern int GPTLquerycounters (const char *, int, long long *); +extern int GPTLget_wallclock (const char *, int, double *); +extern int GPTLget_eventvalue (const char *, const char *, int, double *); +extern int GPTLget_nregions (int, int *); +extern int GPTLget_regionname (int, int, char *, int); +extern int GPTL_PAPIlibraryinit (void); +extern int GPTLevent_name_to_code (const char *, int *); +extern int GPTLevent_code_to_name (const int, char *); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/components/cism/glimmer-cism/utils/libgptl/gptl.inc b/components/cism/glimmer-cism/utils/libgptl/gptl.inc new file mode 100644 index 0000000000..70f47f1402 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/gptl.inc @@ -0,0 +1,166 @@ +! +! $Id: gptl.inc,v 1.44 2011-03-28 20:55:19 rosinski Exp $ +! +! Author: Jim Rosinski +! +! GPTL header file to be included in user code. Values match +! their counterparts in gptl.h. See that file or man pages +! or web-based documenation for descriptions of each value +! + integer GPTLsync_mpi + integer GPTLwall + integer GPTLcpu + integer GPTLabort_on_error + integer GPTLoverhead + integer GPTLdepthlimit + integer GPTLverbose + integer GPTLnarrowprint + integer GPTLpercent + integer GPTLpersec + integer GPTLmultiplex + integer GPTLdopr_preamble + integer GPTLdopr_threadsort + integer GPTLdopr_multparent + integer GPTLdopr_collision + integer GPTLprint_method + integer GPTLtablesize + + integer GPTL_IPC + integer GPTL_CI + integer GPTL_FPC + integer GPTL_FPI + integer GPTL_LSTPI + integer GPTL_DCMRT + integer GPTL_LSTPDCM + integer GPTL_L2MRT + integer GPTL_LSTPL2M + integer GPTL_L3MRT + + integer GPTLnanotime + integer GPTLmpiwtime + integer GPTLclockgettime + integer GPTLgettimeofday + integer GPTLpapitime + integer GPTLread_real_time + + integer GPTLfirst_parent + integer GPTLlast_parent + integer GPTLmost_frequent + integer GPTLfull_tree + + parameter (GPTLsync_mpi = 0) + parameter (GPTLwall = 1) + parameter (GPTLcpu = 2) + parameter (GPTLabort_on_error = 3) + parameter (GPTLoverhead = 4) + parameter (GPTLdepthlimit = 5) + parameter (GPTLverbose = 6) + parameter (GPTLnarrowprint = 7) + parameter (GPTLpercent = 9) + parameter (GPTLpersec = 10) + parameter (GPTLmultiplex = 11) + parameter (GPTLdopr_preamble = 12) + parameter (GPTLdopr_threadsort= 13) + parameter (GPTLdopr_multparent= 14) + parameter (GPTLdopr_collision = 15) + parameter (GPTLprint_method = 16) + parameter (GPTLtablesize = 50) + + parameter (GPTL_IPC = 17) + parameter (GPTL_CI = 18) + parameter (GPTL_FPC = 19) + parameter (GPTL_FPI = 20) + parameter (GPTL_LSTPI = 21) + parameter (GPTL_DCMRT = 22) + parameter (GPTL_LSTPDCM = 23) + parameter (GPTL_L2MRT = 24) + parameter (GPTL_LSTPL2M = 25) + parameter (GPTL_L3MRT = 26) + + parameter (GPTLgettimeofday = 1) + parameter (GPTLnanotime = 2) + parameter (GPTLmpiwtime = 4) + parameter (GPTLclockgettime = 5) + parameter (GPTLpapitime = 6) + parameter (GPTLread_real_time = 3) + + parameter (GPTLfirst_parent = 1) + parameter (GPTLlast_parent = 2) + parameter (GPTLmost_frequent = 3) + parameter (GPTLfull_tree = 4) + +! Externals + + integer gptlsetoption + integer gptlinitialize + integer gptlstart + integer gptlstart_handle + integer gptlstartf + integer gptlstartf_handle + integer gptlstop + integer gptlstop_handle + integer gptlstopf + integer gptlstopf_handle + integer gptlstamp + integer gptlpr_set_append + integer gptlpr_query_append + integer gptlpr_set_write + integer gptlpr_query_write + integer gptlpr + integer gptlpr_file + integer gptlpr_summary + integer gptlpr_summary_file + integer gptlbarrier + integer gptlreset + integer gptlfinalize + integer gptlget_memusage + integer gptlprint_memusage + integer gptlenable + integer gptldisable + integer gptlsetutr + integer gptlquery + integer gptlquerycounters + integer gptlget_wallclock + integer gptlget_eventvalue + integer gptlget_nregions + integer gptlget_regionname + integer gptl_papilibraryinit + integer gptlevent_name_to_code + integer gptlevent_code_to_name + + external gptlsetoption + external gptlinitialize + external gptlstart + external gptlstart_handle + external gptlstartf + external gptlstartf_handle + external gptlstop + external gptlstop_handle + external gptlstopf + external gptlstopf_handle + external gptlstamp + external gptlpr_set_append + external gptlpr_query_append + external gptlpr_set_write + external gptlpr_query_write + external gptlpr + external gptlpr_file + external gptlpr_summary + external gptlpr_summary_file + external gptlbarrier + external gptlreset + external gptlfinalize + external gptlget_memusage + external gptlprint_memusage + external gptlenable + external gptldisable + external gptlsetutr + external gptlquery + external gptlquerycounters + external gptlget_wallclock + external gptlget_eventvalue + external gptlget_nregions + external gptlget_regionname + external gptl_papilibraryinit + external gptlevent_name_to_code + external gptlevent_code_to_name diff --git a/components/cism/glimmer-cism/utils/libgptl/gptl_papi.c b/components/cism/glimmer-cism/utils/libgptl/gptl_papi.c new file mode 100644 index 0000000000..a8e42fd132 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/gptl_papi.c @@ -0,0 +1,1326 @@ +/* +** $Id: gptl_papi.c,v 1.79 2011-03-28 20:55:19 rosinski Exp $ +** +** Author: Jim Rosinski +** +** Contains routines which interface to PAPI library +*/ + +#include "private.h" +#include "gptl.h" + +#ifdef HAVE_PAPI + +#include +#include +#include +#include + +#if ( defined THREADED_OMP ) +#include +#elif ( defined THREADED_PTHREADS ) +#include +#endif + +/* Mapping of PAPI counters to short and long printed strings */ + +static const Entry papitable [] = { + {PAPI_L1_DCM, "PAPI_L1_DCM", "L1_DCM ", "L1_Dcache_miss ", "Level 1 data cache misses"}, + {PAPI_L1_ICM, "PAPI_L1_ICM", "L1_ICM ", "L1_Icache_miss ", "Level 1 instruction cache misses"}, + {PAPI_L2_DCM, "PAPI_L2_DCM", "L2_DCM ", "L2_Dcache_miss ", "Level 2 data cache misses"}, + {PAPI_L2_ICM, "PAPI_L2_ICM", "L2_ICM ", "L2_Icache_miss ", "Level 2 instruction cache misses"}, + {PAPI_L3_DCM, "PAPI_L3_DCM", "L3_DCM ", "L3_Dcache_miss ", "Level 3 data cache misses"}, + {PAPI_L3_ICM, "PAPI_L3_ICM", "L3_ICM ", "L3_Icache_miss ", "Level 3 instruction cache misses"}, + {PAPI_L1_TCM, "PAPI_L1_TCM", "L1_TCM ", "L1_cache_miss ", "Level 1 total cache misses"}, + {PAPI_L2_TCM, "PAPI_L2_TCM", "L2_TCM ", "L2_cache_miss ", "Level 2 total cache misses"}, + {PAPI_L3_TCM, "PAPI_L3_TCM", "L3_TCM ", "L3_cache_miss ", "Level 3 total cache misses"}, + {PAPI_CA_SNP, "PAPI_CA_SNP", "CA_SNP ", "Snoops ", "Snoops "}, + {PAPI_CA_SHR, "PAPI_CA_SHR", "CA_SHR ", "PAPI_CA_SHR ", "Request for shared cache line (SMP)"}, + {PAPI_CA_CLN, "PAPI_CA_CLN", "CA_CLN ", "PAPI_CA_CLN ", "Request for clean cache line (SMP)"}, + {PAPI_CA_INV, "PAPI_CA_INV", "CA_INV ", "PAPI_CA_INV ", "Request for cache line Invalidation (SMP)"}, + {PAPI_CA_ITV, "PAPI_CA_ITV", "CA_ITV ", "PAPI_CA_ITV ", "Request for cache line Intervention (SMP)"}, + {PAPI_L3_LDM, "PAPI_L3_LDM", "L3_LDM ", "L3_load_misses ", "Level 3 load misses"}, + {PAPI_L3_STM, "PAPI_L3_STM", "L3_STM ", "L3_store_misses ", "Level 3 store misses"}, + {PAPI_BRU_IDL,"PAPI_BRU_IDL","BRU_IDL ", "PAPI_BRU_IDL ", "Cycles branch units are idle"}, + {PAPI_FXU_IDL,"PAPI_FXU_IDL","FXU_IDL ", "PAPI_FXU_IDL ", "Cycles integer units are idle"}, + {PAPI_FPU_IDL,"PAPI_FPU_IDL","FPU_IDL ", "PAPI_FPU_IDL ", "Cycles floating point units are idle"}, + {PAPI_LSU_IDL,"PAPI_LSU_IDL","LSU_IDL ", "PAPI_LSU_IDL ", "Cycles load/store units are idle"}, + {PAPI_TLB_DM, "PAPI_TLB_DM" "TLB_DM ", "Data_TLB_misses ", "Data translation lookaside buffer misses"}, + {PAPI_TLB_IM, "PAPI_TLB_IM", "TLB_IM ", "Inst_TLB_misses ", "Instr translation lookaside buffer misses"}, + {PAPI_TLB_TL, "PAPI_TLB_TL", "TLB_TL ", "Tot_TLB_misses ", "Total translation lookaside buffer misses"}, + {PAPI_L1_LDM, "PAPI_L1_LDM", "L1_LDM ", "L1_load_misses ", "Level 1 load misses"}, + {PAPI_L1_STM, "PAPI_L1_STM", "L1_STM ", "L1_store_misses ", "Level 1 store misses"}, + {PAPI_L2_LDM, "PAPI_L2_LDM", "L2_LDM ", "L2_load_misses ", "Level 2 load misses"}, + {PAPI_L2_STM, "PAPI_L2_STM", "L2_STM ", "L2_store_misses ", "Level 2 store misses"}, + {PAPI_BTAC_M, "PAPI_BTAC_M", "BTAC_M ", "BTAC_miss ", "BTAC miss"}, + {PAPI_PRF_DM, "PAPI_PRF_DM", "PRF_DM ", "PAPI_PRF_DM ", "Prefetch data instruction caused a miss"}, + {PAPI_L3_DCH, "PAPI_L3_DCH", "L3_DCH ", "L3_DCache_Hit ", "Level 3 Data Cache Hit"}, + {PAPI_TLB_SD, "PAPI_TLB_SD", "TLB_SD ", "PAPI_TLB_SD ", "Xlation lookaside buffer shootdowns (SMP)"}, + {PAPI_CSR_FAL,"PAPI_CSR_FAL","CSR_FAL ", "PAPI_CSR_FAL ", "Failed store conditional instructions"}, + {PAPI_CSR_SUC,"PAPI_CSR_SUC","CSR_SUC ", "PAPI_CSR_SUC ", "Successful store conditional instructions"}, + {PAPI_CSR_TOT,"PAPI_CSR_TOT","CSR_TOT ", "PAPI_CSR_TOT ", "Total store conditional instructions"}, + {PAPI_MEM_SCY,"PAPI_MEM_SCY","MEM_SCY ", "Cyc_Stalled_Mem ", "Cycles Stalled Waiting for Memory Access"}, + {PAPI_MEM_RCY,"PAPI_MEM_RCY","MEM_RCY ", "Cyc_Stalled_MemR", "Cycles Stalled Waiting for Memory Read"}, + {PAPI_MEM_WCY,"PAPI_MEM_WCY","MEM_WCY ", "Cyc_Stalled_MemW", "Cycles Stalled Waiting for Memory Write"}, + {PAPI_STL_ICY,"PAPI_STL_ICY","STL_ICY ", "Cyc_no_InstrIss ", "Cycles with No Instruction Issue"}, + {PAPI_FUL_ICY,"PAPI_FUL_ICY","FUL_ICY ", "Cyc_Max_InstrIss", "Cycles with Maximum Instruction Issue"}, + {PAPI_STL_CCY,"PAPI_STL_CCY","STL_CCY ", "Cyc_No_InstrComp", "Cycles with No Instruction Completion"}, + {PAPI_FUL_CCY,"PAPI_FUL_CCY","FUL_CCY ", "Cyc_Max_InstComp", "Cycles with Maximum Instruction Completion"}, + {PAPI_HW_INT, "PAPI_HW_INT", "HW_INT ", "HW_interrupts ", "Hardware interrupts"}, + {PAPI_BR_UCN, "PAPI_BR_UCN", "BR_UCN ", "Uncond_br_instr ", "Unconditional branch instructions executed"}, + {PAPI_BR_CN, "PAPI_BR_CN", "BR_CN ", "Cond_br_instr_ex", "Conditional branch instructions executed"}, + {PAPI_BR_TKN, "PAPI_BR_TKN", "BR_TKN ", "Cond_br_instr_tk", "Conditional branch instructions taken"}, + {PAPI_BR_NTK, "PAPI_BR_NTK", "BR_NTK ", "Cond_br_instrNtk", "Conditional branch instructions not taken"}, + {PAPI_BR_MSP, "PAPI_BR_MSP", "BR_MSP ", "Cond_br_instrMPR", "Conditional branch instructions mispred"}, + {PAPI_BR_PRC, "PAPI_BR_PRC", "BR_PRC ", "Cond_br_instrCPR", "Conditional branch instructions corr. pred"}, + {PAPI_FMA_INS,"PAPI_FMA_INS","FMA_INS ", "FMA_instr_comp ", "FMA instructions completed"}, + {PAPI_TOT_IIS,"PAPI_TOT_IIS","TOT_IIS ", "Total_instr_iss ", "Total instructions issued"}, + {PAPI_TOT_INS,"PAPI_TOT_INS","TOT_INS ", "Total_instr_ex ", "Total instructions executed"}, + {PAPI_INT_INS,"PAPI_INT_INS","INT_INS ", "Int_instr_ex ", "Integer instructions executed"}, + {PAPI_FP_INS, "PAPI_FP_INS", "FP_INS ", "FP_instr_ex ", "Floating point instructions executed"}, + {PAPI_LD_INS, "PAPI_LD_INS", "LD_INS ", "Load_instr_ex ", "Load instructions executed"}, + {PAPI_SR_INS, "PAPI_SR_INS", "SR_INS ", "Store_instr_ex ", "Store instructions executed"}, + {PAPI_BR_INS, "PAPI_BR_INS", "BR_INS ", "br_instr_ex ", "Total branch instructions executed"}, + {PAPI_VEC_INS,"PAPI_VEC_INS","VEC_INS ", "Vec/SIMD_instrEx", "Vector/SIMD instructions executed"}, + {PAPI_RES_STL,"PAPI_RES_STL","RES_STL ", "Cyc_proc_stalled", "Cycles processor is stalled on resource"}, + {PAPI_FP_STAL,"PAPI_FP_STAL","FP_STAL ", "Cyc_any_FP_stall", "Cycles any FP units are stalled"}, + {PAPI_TOT_CYC,"PAPI_TOT_CYC","TOT_CYC ", "Total_cycles ", "Total cycles"}, + {PAPI_LST_INS,"PAPI_LST_INS","LST_INS ", "Tot_L/S_inst_ex ", "Total load/store inst. executed"}, + {PAPI_SYC_INS,"PAPI_SYC_INS","SYC_INS ", "Sync._inst._ex ", "Sync. inst. executed"}, + {PAPI_L1_DCH, "PAPI_L1_DCH", "L1_DCH ", "L1_D_Cache_Hit ", "L1 D Cache Hit"}, + {PAPI_L2_DCH, "PAPI_L2_DCH", "L2_DCH ", "L2_D_Cache_Hit ", "L2 D Cache Hit"}, + {PAPI_L1_DCA, "PAPI_L1_DCA", "L1_DCA ", "L1_D_Cache_Acc ", "L1 D Cache Access"}, + {PAPI_L2_DCA, "PAPI_L2_DCA", "L2_DCA ", "L2_D_Cache_Acc ", "L2 D Cache Access"}, + {PAPI_L3_DCA, "PAPI_L3_DCA", "L3_DCA ", "L3_D_Cache_Acc ", "L3 D Cache Access"}, + {PAPI_L1_DCR, "PAPI_L1_DCR", "L1_DCR ", "L1_D_Cache_Read ", "L1 D Cache Read"}, + {PAPI_L2_DCR, "PAPI_L2_DCR", "L2_DCR ", "L2_D_Cache_Read ", "L2 D Cache Read"}, + {PAPI_L3_DCR, "PAPI_L3_DCR", "L3_DCR ", "L3_D_Cache_Read ", "L3 D Cache Read"}, + {PAPI_L1_DCW, "PAPI_L1_DCW", "L1_DCW ", "L1_D_Cache_Write", "L1 D Cache Write"}, + {PAPI_L2_DCW, "PAPI_L2_DCW", "L2_DCW ", "L2_D_Cache_Write", "L2 D Cache Write"}, + {PAPI_L3_DCW, "PAPI_L3_DCW", "L3_DCW ", "L3_D_Cache_Write", "L3 D Cache Write"}, + {PAPI_L1_ICH, "PAPI_L1_ICH", "L1_ICH ", "L1_I_cache_hits ", "L1 instruction cache hits"}, + {PAPI_L2_ICH, "PAPI_L2_ICH", "L2_ICH ", "L2_I_cache_hits ", "L2 instruction cache hits"}, + {PAPI_L3_ICH, "PAPI_L3_ICH", "L3_ICH ", "L3_I_cache_hits ", "L3 instruction cache hits"}, + {PAPI_L1_ICA, "PAPI_L1_ICA", "L1_ICA ", "L1_I_cache_acc ", "L1 instruction cache accesses"}, + {PAPI_L2_ICA, "PAPI_L2_ICA", "L2_ICA ", "L2_I_cache_acc ", "L2 instruction cache accesses"}, + {PAPI_L3_ICA, "PAPI_L3_ICA", "L3_ICA ", "L3_I_cache_acc ", "L3 instruction cache accesses"}, + {PAPI_L1_ICR, "PAPI_L1_ICR", "L1_ICR ", "L1_I_cache_reads", "L1 instruction cache reads"}, + {PAPI_L2_ICR, "PAPI_L2_ICR", "L2_ICR ", "L2_I_cache_reads", "L2 instruction cache reads"}, + {PAPI_L3_ICR, "PAPI_L3_ICR", "L3_ICR ", "L3_I_cache_reads", "L3 instruction cache reads"}, + {PAPI_L1_ICW, "PAPI_L1_ICW", "L1_ICW ", "L1_I_cache_write", "L1 instruction cache writes"}, + {PAPI_L2_ICW, "PAPI_L2_ICW", "L2_ICW ", "L2_I_cache_write", "L2 instruction cache writes"}, + {PAPI_L3_ICW, "PAPI_L3_ICW", "L3_ICW ", "L3_I_cache_write", "L3 instruction cache writes"}, + {PAPI_L1_TCH, "PAPI_L1_TCH", "L1_TCH ", "L1_cache_hits ", "L1 total cache hits"}, + {PAPI_L2_TCH, "PAPI_L2_TCH", "L2_TCH ", "L2_cache_hits ", "L2 total cache hits"}, + {PAPI_L3_TCH, "PAPI_L3_TCH", "L3_TCH ", "L3_cache_hits ", "L3 total cache hits"}, + {PAPI_L1_TCA, "PAPI_L1_TCA", "L1_TCA ", "L1_cache_access ", "L1 total cache accesses"}, + {PAPI_L2_TCA, "PAPI_L2_TCA", "L2_TCA ", "L2_cache_access ", "L2 total cache accesses"}, + {PAPI_L3_TCA, "PAPI_L3_TCA", "L3_TCA ", "L3_cache_access ", "L3 total cache accesses"}, + {PAPI_L1_TCR, "PAPI_L1_TCR", "L1_TCR ", "L1_cache_reads ", "L1 total cache reads"}, + {PAPI_L2_TCR, "PAPI_L2_TCR", "L2_TCR ", "L2_cache_reads ", "L2 total cache reads"}, + {PAPI_L3_TCR, "PAPI_L3_TCR", "L3_TCR ", "L3_cache_reads ", "L3 total cache reads"}, + {PAPI_L1_TCW, "PAPI_L1_TCW", "L1_TCW ", "L1_cache_writes ", "L1 total cache writes"}, + {PAPI_L2_TCW, "PAPI_L2_TCW", "L2_TCW ", "L2_cache_writes ", "L2 total cache writes"}, + {PAPI_L3_TCW, "PAPI_L3_TCW", "L3_TCW ", "L3_cache_writes ", "L3 total cache writes"}, + {PAPI_FML_INS,"PAPI_FML_INS","FML_INS ", "FM_ins ", "FM ins"}, + {PAPI_FAD_INS,"PAPI_FAD_INS","FAD_INS ", "FA_ins ", "FA ins"}, + {PAPI_FDV_INS,"PAPI_FDV_INS","FDV_INS ", "FD_ins ", "FD ins"}, + {PAPI_FSQ_INS,"PAPI_FSQ_INS","FSQ_INS ", "FSq_ins ", "FSq ins"}, + {PAPI_FNV_INS,"PAPI_FNV_INS","FNV_INS ", "Finv_ins ", "Finv ins"}, + {PAPI_FP_OPS, "PAPI_FP_OPS", "FP_OPS ", "FP_ops_executed ", "Floating point operations executed"} +}; + +static const int npapientries = sizeof (papitable) / sizeof (Entry); +static int papieventlist[MAX_AUX]; /* list of PAPI events to be counted */ +static Pr_event pr_event[MAX_AUX]; /* list of events (PAPI or derived) */ + +/* Derived events */ +static const Entry derivedtable [] = { + {GPTL_IPC, "GPTL_IPC", "IPC ", "Instr_per_cycle ", "Instructions per cycle"}, + {GPTL_CI, "GPTL_CI", "CI ", "Comp_Intensity ", "Computational intensity"}, + {GPTL_FPC, "GPTL_FPC", "Flop/Cyc", "FP_Ops_per_cycle", "Floating point ops per cycle"}, + {GPTL_FPI, "GPTL_FPI", "Flop/Ins", "FP_Ops_per_instr", "Floating point ops per instruction"}, + {GPTL_LSTPI, "GPTL_LSTPI", "LST_frac", "LST_fraction ", "Load-store instruction fraction"}, + {GPTL_DCMRT, "GPTL_DCMRT", "DCMISRAT", "L1_Miss_Rate ", "L1 miss rate (fraction)"}, + {GPTL_LSTPDCM,"GPTL_LSTPDCM", "LSTPDCM ", "LST_per_L1_miss ", "Load-store instructions per L1 miss"}, + {GPTL_L2MRT, "GPTL_L2MRT", "L2MISRAT", "L2_Miss_Rate ", "L2 miss rate (fraction)"}, + {GPTL_LSTPL2M,"GPTL_LSTPL2M", "LSTPL2M ", "LST_per_L2_miss ", "Load-store instructions per L2 miss"}, + {GPTL_L3MRT, "GPTL_L3MRT", "L3MISRAT", "L3_Miss_Rate ", "L3 read miss rate (fraction)"} +}; +static const int nderivedentries = sizeof (derivedtable) / sizeof (Entry); + +static int npapievents = 0; /* number of PAPI events: initialize to 0 */ +static int nevents = 0; /* number of events: initialize to 0 */ +static int *EventSet; /* list of events to be counted by PAPI */ +static long_long **papicounters; /* counters returned from PAPI */ + +static const int BADCOUNT = -999999; /* Set counters to this when they are bad */ +static bool is_multiplexed = false; /* whether multiplexed (always start false)*/ +static bool narrowprint = true; /* only use 8 digits not 16 for counter prints */ +static bool persec = true; /* print PAPI stats per second */ +static bool enable_multiplexing = false; /* whether to try multiplexing */ +static bool verbose = false; /* output verbosity */ + +/* Function prototypes */ + +static int canenable (int); +static int canenable2 (int, int); +static int papievent_is_enabled (int); +static int already_enabled (int); +static int enable (int); +static int getderivedidx (int); + +/* +** GPTL_PAPIsetoption: enable or disable PAPI event defined by "counter". Called +** from GPTLsetoption. Since all events are off by default, val=false degenerates +** to a no-op. Coded this way to be consistent with the rest of GPTL +** +** Input args: +** counter: PAPI counter +** val: true or false for enable or disable +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTL_PAPIsetoption (const int counter, /* PAPI counter (or option) */ + const int val) /* true or false for enable or disable */ +{ + int n; /* loop index */ + int ret; /* return code */ + int numidx; /* numerator index */ + int idx; /* derived counter index */ + char eventname[PAPI_MAX_STR_LEN]; /* returned from PAPI_event_code_to_name */ + + /* + ** First, check for option which is not an actual counter + */ + + switch (counter) { + case GPTLverbose: + /* don't printf here--that'd duplicate what's in gptl.c */ + verbose = (bool) val; + return 0; + case GPTLmultiplex: + enable_multiplexing = (bool) val; + if (verbose) + printf ("GPTL_PAPIsetoption: boolean enable_multiplexing = %d\n", val); + return 0; + case GPTLnarrowprint: + narrowprint = (bool) val; + if (verbose) + printf ("GPTL_PAPIsetoption: boolean narrowprint = %d\n", val); + return 0; + case GPTLpersec: + persec = (bool) val; + if (verbose) + printf ("GPTL_PAPIsetoption: boolean persec = %d\n", val); + return 0; + default: + break; + } + + /* + ** If val is false, return an error if the event has already been enabled. + ** Otherwise just warn that attempting to disable a PAPI-based event + ** that has already been enabled doesn't work--for now it's just a no-op + */ + + if (! val) { + if (already_enabled (counter)) + return GPTLerror ("GPTL_PAPIsetoption: already enabled counter %d cannot be disabled\n", + counter); + else + if (verbose) + printf ("GPTL_PAPIsetoption: 'disable' %d currently is just a no-op\n", counter); + return 0; + } + + /* If the event has already been enabled for printing, exit */ + + if (already_enabled (counter)) + return GPTLerror ("GPTL_PAPIsetoption: counter %d has already been enabled\n", + counter); + + /* + ** Initialize PAPI if it hasn't already been done. + ** From here on down we can assume the intent is to enable (not disable) an option + */ + + if (GPTL_PAPIlibraryinit () < 0) + return GPTLerror ("GPTL_PAPIsetoption: PAPI library init error\n"); + + /* Ensure max nevents won't be exceeded */ + + if (nevents+1 > MAX_AUX) + return GPTLerror ("GPTL_PAPIsetoption: %d is too many events. Can be increased in private.h\n", + nevents+1); + + /* Check derived events */ + + switch (counter) { + case GPTL_IPC: + if ( ! canenable2 (PAPI_TOT_INS, PAPI_TOT_CYC)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_IPC unavailable\n"); + + idx = getderivedidx (GPTL_IPC); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_TOT_INS); + pr_event[nevents].denomidx = enable (PAPI_TOT_CYC); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_TOT_INS / PAPI_TOT_CYC\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + case GPTL_CI: + idx = getderivedidx (GPTL_CI); + if (canenable2 (PAPI_FP_OPS, PAPI_LST_INS)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_FP_OPS); + pr_event[nevents].denomidx = enable (PAPI_LST_INS); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_FP_OPS / PAPI_LST_INS\n", + pr_event[nevents].event.namestr); + } else if (canenable2 (PAPI_FP_OPS, PAPI_L1_DCA)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_FP_OPS); + pr_event[nevents].denomidx = enable (PAPI_L1_DCA); +#ifdef DEBUG + printf ("GPTL_PAPIsetoption: pr_event %d is derived and will be PAPI event %d / %d\n", + nevents, pr_event[nevents].numidx, pr_event[nevents].denomidx); +#endif + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_FP_OPS / PAPI_L1_DCA\n", + pr_event[nevents].event.namestr); + } else { + return GPTLerror ("GPTL_PAPIsetoption: GPTL_CI unavailable\n"); + } + ++nevents; + return 0; + case GPTL_FPC: + if ( ! canenable2 (PAPI_FP_OPS, PAPI_TOT_CYC)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_FPC unavailable\n"); + + idx = getderivedidx (GPTL_FPC); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_FP_OPS); + pr_event[nevents].denomidx = enable (PAPI_TOT_CYC); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_FP_OPS / PAPI_TOT_CYC\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + case GPTL_FPI: + if ( ! canenable2 (PAPI_FP_OPS, PAPI_TOT_INS)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_FPI unavailable\n"); + + idx = getderivedidx (GPTL_FPI); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_FP_OPS); + pr_event[nevents].denomidx = enable (PAPI_TOT_INS); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_FP_OPS / PAPI_TOT_INS\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + case GPTL_LSTPI: + idx = getderivedidx (GPTL_LSTPI); + if (canenable2 (PAPI_LST_INS, PAPI_TOT_INS)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_LST_INS); + pr_event[nevents].denomidx = enable (PAPI_TOT_INS); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_LST_INS / PAPI_TOT_INS\n", + pr_event[nevents].event.namestr); + } else if (canenable2 (PAPI_L1_DCA, PAPI_TOT_INS)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L1_DCA); + pr_event[nevents].denomidx = enable (PAPI_TOT_INS); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L1_DCA / PAPI_TOT_INS\n", + pr_event[nevents].event.namestr); + } else { + return GPTLerror ("GPTL_PAPIsetoption: GPTL_LSTPI unavailable\n"); + } + ++nevents; + return 0; + case GPTL_DCMRT: + if ( ! canenable2 (PAPI_L1_DCM, PAPI_L1_DCA)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_DCMRT unavailable\n"); + + idx = getderivedidx (GPTL_DCMRT); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L1_DCM); + pr_event[nevents].denomidx = enable (PAPI_L1_DCA); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L1_DCM / PAPI_L1_DCA\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + case GPTL_LSTPDCM: + idx = getderivedidx (GPTL_LSTPDCM); + if (canenable2 (PAPI_LST_INS, PAPI_L1_DCM)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_LST_INS); + pr_event[nevents].denomidx = enable (PAPI_L1_DCM); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_LST_INS / PAPI_L1_DCM\n", + pr_event[nevents].event.namestr); + } else if (canenable2 (PAPI_L1_DCA, PAPI_L1_DCM)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L1_DCA); + pr_event[nevents].denomidx = enable (PAPI_L1_DCM); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L1_DCA / PAPI_L1_DCM\n", + pr_event[nevents].event.namestr); + } else { + return GPTLerror ("GPTL_PAPIsetoption: GPTL_LSTPDCM unavailable\n"); + } + ++nevents; + return 0; + /* + ** For L2 counts, use TC* instead of DC* to avoid PAPI derived events + */ + case GPTL_L2MRT: + if ( ! canenable2 (PAPI_L2_TCM, PAPI_L2_TCA)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_L2MRT unavailable\n"); + + idx = getderivedidx (GPTL_L2MRT); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L2_TCM); + pr_event[nevents].denomidx = enable (PAPI_L2_TCA); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L2_TCM / PAPI_L2_TCA\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + case GPTL_LSTPL2M: + idx = getderivedidx (GPTL_LSTPL2M); + if (canenable2 (PAPI_LST_INS, PAPI_L2_TCM)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_LST_INS); + pr_event[nevents].denomidx = enable (PAPI_L2_TCM); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_LST_INS / PAPI_L2_TCM\n", + pr_event[nevents].event.namestr); + } else if (canenable2 (PAPI_L1_DCA, PAPI_L2_TCM)) { + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L1_DCA); + pr_event[nevents].denomidx = enable (PAPI_L2_TCM); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L1_DCA / PAPI_L2_TCM\n", + pr_event[nevents].event.namestr); + } else { + return GPTLerror ("GPTL_PAPIsetoption: GPTL_LSTPL2M unavailable\n"); + } + ++nevents; + return 0; + case GPTL_L3MRT: + if ( ! canenable2 (PAPI_L3_TCM, PAPI_L3_TCR)) + return GPTLerror ("GPTL_PAPIsetoption: GPTL_L3MRT unavailable\n"); + + idx = getderivedidx (GPTL_L3MRT); + pr_event[nevents].event = derivedtable[idx]; + pr_event[nevents].numidx = enable (PAPI_L3_TCM); + pr_event[nevents].denomidx = enable (PAPI_L3_TCR); + if (verbose) + printf ("GPTL_PAPIsetoption: enabling derived event %s = PAPI_L3_TCM / PAPI_L3_TCR\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + default: + break; + } + + /* Check PAPI presets */ + + for (n = 0; n < npapientries; n++) { + if (counter == papitable[n].counter) { + if ((numidx = papievent_is_enabled (counter)) >= 0) { + pr_event[nevents].event = papitable[n]; + pr_event[nevents].numidx = numidx; + pr_event[nevents].denomidx = -1; /* flag says not derived (no denominator) */ + } else if (canenable (counter)) { + pr_event[nevents].event = papitable[n]; + pr_event[nevents].numidx = enable (counter); + pr_event[nevents].denomidx = -1; /* flag says not derived (no denominator) */ + } else { + return GPTLerror ("GPTL_PAPIsetoption: Can't enable event \n", + papitable[n].longstr); + } + if (verbose) + printf ("GPTL_PAPIsetoption: enabling PAPI preset event %s\n", + pr_event[nevents].event.namestr); + ++nevents; + return 0; + } + } + + /* + ** Check native events last: If PAPI_event_code_to_name fails, give up + */ + + if ((ret = PAPI_event_code_to_name (counter, eventname)) != PAPI_OK) + return GPTLerror ("GPTL_PAPIsetoption: name not found for counter %d: PAPI_strerror: %s\n", + counter, PAPI_strerror (ret)); + + /* + ** A table with predefined names of various lengths does not exist for + ** native events. Just truncate eventname. + */ + + if ((numidx = papievent_is_enabled (counter)) >= 0) { + pr_event[nevents].event.counter = counter; + + pr_event[nevents].event.namestr = (char *) GPTLallocate (12+1); + strncpy (pr_event[nevents].event.namestr, eventname, 12); + pr_event[nevents].event.namestr[12] = '\0'; + + pr_event[nevents].event.str16 = (char *) GPTLallocate (16+1); + strncpy (pr_event[nevents].event.str16, eventname, 16); + pr_event[nevents].event.str16[16] = '\0'; + + pr_event[nevents].event.longstr = (char *) GPTLallocate (PAPI_MAX_STR_LEN); + strncpy (pr_event[nevents].event.longstr, eventname, PAPI_MAX_STR_LEN); + + pr_event[nevents].numidx = numidx; + pr_event[nevents].denomidx = -1; /* flag says not derived (no denominator) */ + } else if (canenable (counter)) { + pr_event[nevents].event.counter = counter; + + pr_event[nevents].event.namestr = (char *) GPTLallocate (12+1); + strncpy (pr_event[nevents].event.namestr, eventname, 12); + pr_event[nevents].event.namestr[12] = '\0'; + + pr_event[nevents].event.str16 = (char *) GPTLallocate (16+1); + strncpy (pr_event[nevents].event.str16, eventname, 16); + pr_event[nevents].event.str16[16] = '\0'; + + pr_event[nevents].event.longstr = (char *) GPTLallocate (PAPI_MAX_STR_LEN); + strncpy (pr_event[nevents].event.longstr, eventname, PAPI_MAX_STR_LEN); + + pr_event[nevents].numidx = enable (counter); + pr_event[nevents].denomidx = -1; /* flag says not derived (no denominator) */ + } else { + return GPTLerror ("GPTL_PAPIsetoption: Can't enable event %s\n", eventname); + } + + if (verbose) + printf ("GPTL_PAPIsetoption: enabling native event %s\n", pr_event[nevents].event.longstr); + + ++nevents; + return 0; +} + +/* +** canenable: determine whether a PAPI counter can be enabled +** +** Input args: +** counter: PAPI counter +** +** Return value: 0 (success) or non-zero (failure) +*/ + +int canenable (int counter) +{ + char eventname[PAPI_MAX_STR_LEN]; /* returned from PAPI_event_code_to_name */ + + if (npapievents+1 > MAX_AUX) + return false; + + if (PAPI_query_event (counter) != PAPI_OK) { + (void) PAPI_event_code_to_name (counter, eventname); + fprintf (stderr, "canenable: event %s not available on this arch\n", eventname); + return false; + } + + return true; +} + +/* +** canenable2: determine whether 2 PAPI counters can be enabled +** +** Input args: +** counter1: PAPI counter +** counter2: PAPI counter +** +** Return value: 0 (success) or non-zero (failure) +*/ + +int canenable2 (int counter1, int counter2) +{ + char eventname[PAPI_MAX_STR_LEN]; /* returned from PAPI_event_code_to_name */ + + if (npapievents+2 > MAX_AUX) + return false; + + if (PAPI_query_event (counter1) != PAPI_OK) { + (void) PAPI_event_code_to_name (counter1, eventname); + return false; + } + + if (PAPI_query_event (counter2) != PAPI_OK) { + (void) PAPI_event_code_to_name (counter2, eventname); + return false; + } + + return true; +} + +/* +** papievent_is_enabled: determine whether a PAPI counter has already been +** enabled. Used internally to keep track of PAPI counters enabled. A given +** PAPI counter may occur in the computation of multiple derived events, as +** well as output directly. E.g. PAPI_FP_OPS is used to compute +** computational intensity, and floating point ops per instruction. +** +** Input args: +** counter: PAPI counter +** +** Return value: index into papieventlist (success) or negative (not found) +*/ + +int papievent_is_enabled (int counter) +{ + int n; + + for (n = 0; n < npapievents; ++n) + if (papieventlist[n] == counter) + return n; + return -1; +} + +/* +** already_enabled: determine whether a PAPI-based event has already been +** enabled for printing. +** +** Input args: +** counter: PAPI or derived counter +** +** Return value: 1 (true) or 0 (false) +*/ + +int already_enabled (int counter) +{ + int n; + + for (n = 0; n < nevents; ++n) + if (pr_event[n].event.counter == counter) + return 1; + return 0; +} + +/* +** enable: enable a PAPI event. ASSUMES that canenable() has already determined +** that the event can be enabled. +** +** Input args: +** counter: PAPI counter +** +** Return value: index into papieventlist +*/ + +int enable (int counter) +{ + int n; + + /* If the event is already enabled, return its index */ + + for (n = 0; n < npapievents; ++n) { + if (papieventlist[n] == counter) { +#ifdef DEBUG + printf ("enable: PAPI event %d is %d\n", n, counter); +#endif + return n; + } + } + + /* New event */ + + papieventlist[npapievents++] = counter; + return npapievents-1; +} + +/* +** getderivedidx: find the table index of a derived counter +** +** Input args: +** counter: derived counter +** +** Return value: index into derivedtable (success) or GPTLerror (failure) +*/ + +int getderivedidx (int dcounter) +{ + int n; + + for (n = 0; n < nderivedentries; ++n) { + if (derivedtable[n].counter == dcounter) + return n; + } + return GPTLerror ("getderivedidx: failed to find derived counter %d\n", dcounter); +} + +/* +** GPTL_PAPIlibraryinit: Call PAPI_library_init if necessary +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTL_PAPIlibraryinit () +{ + int ret; + + if ((ret = PAPI_is_initialized ()) == PAPI_NOT_INITED) { + if ((ret = PAPI_library_init (PAPI_VER_CURRENT)) != PAPI_VER_CURRENT) { + fprintf (stderr, "GPTL_PAPIlibraryinit: ret=%d PAPI_VER_CURRENT=%d\n", + ret, (int) PAPI_VER_CURRENT); + return GPTLerror ("GPTL_PAPIlibraryinit: PAPI_library_init failure:%s\n", + PAPI_strerror (ret)); + } + } + return 0; +} + +/* +** GPTL_PAPIinitialize(): Initialize the PAPI interface. Called from GPTLinitialize. +** PAPI_library_init must be called before any other PAPI routines. +** PAPI_thread_init is called subsequently if threading is enabled. +** Finally, allocate space for PAPI counters and start them. +** +** Input args: +** maxthreads: number of threads +** +** Return value: 0 (success) or GPTLerror or -1 (failure) +*/ + +int GPTL_PAPIinitialize (const int maxthreads, /* number of threads */ + const bool verbose_flag, /* output verbosity */ + int *nevents_out, /* nevents needed by gptl.c */ + Entry *pr_event_out) /* events needed by gptl.c */ +{ + int ret; /* return code */ + int n; /* loop index */ + int t; /* thread index */ + + verbose = verbose_flag; + + if (maxthreads < 1) + return GPTLerror ("GPTL_PAPIinitialize: maxthreads = %d\n", maxthreads); + + /* Ensure that PAPI_library_init has already been called */ + + if ((ret = GPTL_PAPIlibraryinit ()) < 0) + return GPTLerror ("GPTL_PAPIinitialize: GPTL_PAPIlibraryinit failure\n"); + + /* PAPI_thread_init needs to be called if threading enabled */ + +#if ( defined THREADED_OMP ) + if (PAPI_thread_init ((unsigned long (*)(void)) (omp_get_thread_num)) != PAPI_OK) + return GPTLerror ("GPTL_PAPIinitialize: PAPI_thread_init failure\n"); +#elif ( defined THREADED_PTHREADS ) + if (PAPI_thread_init ((unsigned long (*)(void)) (pthread_self)) != PAPI_OK) + return GPTLerror ("GPTL_PAPIinitialize: PAPI_thread_init failure\n"); +#endif + + /* allocate and initialize static local space */ + + EventSet = (int *) GPTLallocate (maxthreads * sizeof (int)); + papicounters = (long_long **) GPTLallocate (maxthreads * sizeof (long_long *)); + + for (t = 0; t < maxthreads; t++) { + EventSet[t] = PAPI_NULL; + papicounters[t] = (long_long *) GPTLallocate (MAX_AUX * sizeof (long_long)); + } + + *nevents_out = nevents; + for (n = 0; n < nevents; ++n) { + pr_event_out[n].counter = pr_event[n].event.counter; + pr_event_out[n].namestr = pr_event[n].event.namestr; + pr_event_out[n].str8 = pr_event[n].event.str8; + pr_event_out[n].str16 = pr_event[n].event.str16; + pr_event_out[n].longstr = pr_event[n].event.longstr; + } + return 0; +} + +/* +** GPTLcreate_and_start_events: Create and start the PAPI eventset. +** Threaded routine to create the "event set" (PAPI terminology) and start +** the counters. This is only done once, and is called from get_thread_num +** for the first time for the thread. +** +** Input args: +** t: thread number +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLcreate_and_start_events (const int t) /* thread number */ +{ + int ret; /* return code */ + int n; /* loop index over events */ + char eventname[PAPI_MAX_STR_LEN]; /* returned from PAPI_event_code_to_name */ + + /* Create the event set */ + + if ((ret = PAPI_create_eventset (&EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: thread %d failure creating eventset: %s\n", + t, PAPI_strerror (ret)); + + if (verbose) + printf ("GPTLcreate_and_start_events: successfully created eventset for thread %d\n", t); + + /* Add requested events to the event set */ + + for (n = 0; n < npapievents; n++) { + if ((ret = PAPI_add_event (EventSet[t], papieventlist[n])) != PAPI_OK) { + if (verbose) { + fprintf (stderr, "%s\n", PAPI_strerror (ret)); + ret = PAPI_event_code_to_name (papieventlist[n], eventname); + fprintf (stderr, "GPTLcreate_and_start_events: failure adding event:%s\n", + eventname); + } + + if (enable_multiplexing) { + if (verbose) + printf ("Trying multiplexing...\n"); + is_multiplexed = true; + break; + } else + return GPTLerror ("enable_multiplexing is false: giving up\n"); + } + } + + if (is_multiplexed) { + + /* Cleanup the eventset for multiplexing */ + + if ((ret = PAPI_cleanup_eventset (EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: %s\n", PAPI_strerror (ret)); + + if ((ret = PAPI_destroy_eventset (&EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: %s\n", PAPI_strerror (ret)); + + if ((ret = PAPI_create_eventset (&EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: failure creating eventset: %s\n", + PAPI_strerror (ret)); + + if ((ret = PAPI_multiplex_init ()) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: failure from PAPI_multiplex_init%s\n", + PAPI_strerror (ret)); + + if ((ret = PAPI_set_multiplex (EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: failure from PAPI_set_multiplex: %s\n", + PAPI_strerror (ret)); + + for (n = 0; n < npapievents; n++) { + if ((ret = PAPI_add_event (EventSet[t], papieventlist[n])) != PAPI_OK) { + ret = PAPI_event_code_to_name (papieventlist[n], eventname); + return GPTLerror ("GPTLcreate_and_start_events: failure adding event:%s\n" + " Error was: %s\n", eventname, PAPI_strerror (ret)); + } + } + } + + /* Start the event set. It will only be read from now on--never stopped */ + + if ((ret = PAPI_start (EventSet[t])) != PAPI_OK) + return GPTLerror ("GPTLcreate_and_start_events: failed to start event set: %s\n", + PAPI_strerror (ret)); + + return 0; +} + +/* +** GPTL_PAPIstart: Start the PAPI counters (actually they are just read). +** Called from GPTLstart. +** +** Input args: +** t: thread number +** +** Output args: +** aux: struct containing the counters +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTL_PAPIstart (const int t, /* thread number */ + Papistats *aux) /* struct containing PAPI stats */ +{ + int ret; /* return code from PAPI lib calls */ + int n; /* loop index */ + + /* If no events are to be counted just return */ + + if (npapievents == 0) + return 0; + + /* Read the counters */ + + if ((ret = PAPI_read (EventSet[t], papicounters[t])) != PAPI_OK) + return GPTLerror ("GPTL_PAPIstart: %s\n", PAPI_strerror (ret)); + + /* + ** Store the counter values. When GPTL_PAPIstop is called, the counters + ** will again be read, and differenced with the values saved here. + */ + + for (n = 0; n < npapievents; n++) + aux->last[n] = papicounters[t][n]; + + return 0; +} + +/* +** GPTL_PAPIstop: Stop the PAPI counters (actually they are just read). +** Called from GPTLstop. +** +** Input args: +** t: thread number +** +** Input/output args: +** aux: struct containing the counters +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTL_PAPIstop (const int t, /* thread number */ + Papistats *aux) /* struct containing PAPI stats */ +{ + int ret; /* return code from PAPI lib calls */ + int n; /* loop index */ + long_long delta; /* change in counters from previous read */ + + /* If no events are to be counted just return */ + + if (npapievents == 0) + return 0; + + /* Read the counters */ + + if ((ret = PAPI_read (EventSet[t], papicounters[t])) != PAPI_OK) + return GPTLerror ("GPTL_PAPIstop: %s\n", PAPI_strerror (ret)); + + /* + ** Accumulate the difference since timer start in aux. + ** Negative accumulation can happen when multiplexing is enabled, so don't + ** set count to BADCOUNT in that case. + */ + + for (n = 0; n < npapievents; n++) { +#ifdef DEBUG + printf ("GPTL_PAPIstop: event %d counter value is %ld\n", n, (long) papicounters[t][n]); +#endif + delta = papicounters[t][n] - aux->last[n]; + if ( ! is_multiplexed && delta < 0) + aux->accum[n] = BADCOUNT; + else + aux->accum[n] += delta; + } + return 0; +} + +/* +** GPTL_PAPIprstr: Print the descriptive string for all enabled PAPI events. +** Called from GPTLpr. +** +** Input args: +** fp: file descriptor +*/ + +void GPTL_PAPIprstr (FILE *fp) +{ + int n; + + if (narrowprint) { + for (n = 0; n < nevents; n++) { + fprintf (fp, "%8.8s ", pr_event[n].event.str8); + + /* Test on < 0 says it's a PAPI preset */ + + if (persec && pr_event[n].event.counter < 0) + fprintf (fp, "e6_/_sec "); + } + } else { + for (n = 0; n < nevents; n++) { + fprintf (fp, "%16.16s ", pr_event[n].event.str16); + + /* Test on < 0 says it's a PAPI preset */ + + if (persec && pr_event[n].event.counter < 0) + fprintf (fp, "e6_/_sec "); + } + } +} + +/* +** GPTL_PAPIpr: Print PAPI counter values for all enabled events, including +** derived events. Called from GPTLpr. +** +** Input args: +** fp: file descriptor +** aux: struct containing the counters +*/ + +void GPTL_PAPIpr (FILE *fp, /* file descriptor to write to */ + const Papistats *aux, /* stats to write */ + const int t, /* thread number */ + const int count, /* number of invocations */ + const double wcsec) /* wallclock time (sec) */ +{ + const char *shortintfmt = "%8ld "; + const char *longintfmt = "%16ld "; + const char *shortfloatfmt = "%8.2e "; + const char *longfloatfmt = "%16.10e "; + const char *intfmt; /* integer format */ + const char *floatfmt; /* floating point format */ + + int n; /* loop index */ + int numidx; /* index pointer to appropriated (derived) numerator */ + int denomidx; /* index pointer to appropriated (derived) denominator */ + double val; /* value to be printed */ + + intfmt = narrowprint ? shortintfmt : longintfmt; + floatfmt = narrowprint ? shortfloatfmt : longfloatfmt; + + for (n = 0; n < nevents; n++) { + numidx = pr_event[n].numidx; + if (pr_event[n].denomidx > -1) { /* derived event */ + denomidx = pr_event[n].denomidx; + +#ifdef DEBUG + printf ("GPTL_PAPIpr: derived event: numidx=%d denomidx=%d values = %ld %ld\n", + numidx, denomidx, (long) aux->accum[numidx], (long) aux->accum[denomidx]); +#endif + /* Protect against divide by zero */ + + if (aux->accum[denomidx] > 0) + val = (double) aux->accum[numidx] / (double) aux->accum[denomidx]; + else + val = 0.; + fprintf (fp, floatfmt, val); + + } else { /* Raw PAPI event */ + +#ifdef DEBUG + printf ("GPTL_PAPIpr: raw event: numidx=%d value = %ld\n", + numidx, (long) aux->accum[numidx]); +#endif + if (aux->accum[numidx] < PRTHRESH) + fprintf (fp, intfmt, (long) aux->accum[numidx]); + else + fprintf (fp, floatfmt, (double) aux->accum[numidx]); + + if (persec) { + if (wcsec > 0.) + fprintf (fp, "%8.2f ", aux->accum[numidx] * 1.e-6 / wcsec); + else + fprintf (fp, "%8.2f ", 0.); + } + } + } +} + +/* +** GPTL_PAPIprintenabled: Print list of enabled timers +** +** Input args: +** fp: file descriptor +*/ + +void GPTL_PAPIprintenabled (FILE *fp) +{ + int n, nn; + PAPI_event_info_t info; /* returned from PAPI_get_event_info */ + char eventname[PAPI_MAX_STR_LEN]; /* returned from PAPI_event_code_to_name */ + + if (nevents > 0) { + fprintf (fp, "Description of printed events (PAPI and derived):\n"); + for (n = 0; n < nevents; n++) { + if (strncmp (pr_event[n].event.namestr, "GPTL", 4) == 0) { + fprintf (fp, " %s: %s\n", pr_event[n].event.namestr, pr_event[n].event.longstr); + } else { + nn = pr_event[n].event.counter; + if (PAPI_get_event_info (nn, &info) == PAPI_OK) { + fprintf (fp, " %s\n", info.short_descr); + fprintf (fp, " %s\n", info.note); + } + } + } + fprintf (fp, "\n"); + + fprintf (fp, "PAPI events enabled (including those required for derived events):\n"); + for (n = 0; n < npapievents; n++) + if (PAPI_event_code_to_name (papieventlist[n], eventname) == PAPI_OK) + fprintf (fp, " %s\n", eventname); + fprintf (fp, "\n"); + } +} + +/* +** GPTL_PAPIadd: Accumulate PAPI counters. Called from add. +** +** Input/Output args: +** auxout: auxout = auxout + auxin +** +** Input args: +** auxin: counters to be summed into auxout +*/ + +void GPTL_PAPIadd (Papistats *auxout, /* output struct */ + const Papistats *auxin) /* input struct */ +{ + int n; + + for (n = 0; n < npapievents; n++) + if (auxin->accum[n] == BADCOUNT || auxout->accum[n] == BADCOUNT) + auxout->accum[n] = BADCOUNT; + else + auxout->accum[n] += auxin->accum[n]; +} + +/* +** GPTL_PAPIfinalize: finalization routine must be called from single-threaded +** region. Free all malloc'd space +*/ + +void GPTL_PAPIfinalize (int maxthreads) +{ + int t; /* thread index */ + int ret; /* return code */ + + for (t = 0; t < maxthreads; t++) { + ret = PAPI_stop (EventSet[t], papicounters[t]); + free (papicounters[t]); + ret = PAPI_cleanup_eventset (EventSet[t]); + ret = PAPI_destroy_eventset (&EventSet[t]); + } + + free (EventSet); + free (papicounters); + + /* Reset initial values */ + + npapievents = 0; + nevents = 0; + is_multiplexed = false; + narrowprint = true; + persec = true; + enable_multiplexing = false; + verbose = false; +} + +/* +** GPTL_PAPIquery: return current PAPI counter info. Return into a long for best +** compatibility possibilities with Fortran. +** +** Input args: +** aux: struct containing the counters +** ncounters: max number of counters to return +** +** Output args: +** papicounters_out: current value of PAPI counters +*/ + +void GPTL_PAPIquery (const Papistats *aux, + long long *papicounters_out, + int ncounters) +{ + int n; + + if (ncounters > 0) { + for (n = 0; n < ncounters && n < npapievents; n++) { + papicounters_out[n] = (long long) aux->accum[n]; + } + } +} + +/* +** GPTL_PAPIget_eventvalue: return current value for an enabled event. +** +** Input args: +** eventname: event name to check (whether derived or raw PAPI counter) +** aux: struct containing the counter(s) for the event +** +** Output args: +** value: current value of the event +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTL_PAPIget_eventvalue (const char *eventname, + const Papistats *aux, + double *value) +{ + int n; /* loop index through enabled events */ + int numidx; /* numerator index into papicounters */ + int denomidx; /* denominator index into papicounters */ + + for (n = 0; n < nevents; ++n) { + if (STRMATCH (eventname, pr_event[n].event.namestr)) { + numidx = pr_event[n].numidx; + if (pr_event[n].denomidx > -1) { /* derived event */ + denomidx = pr_event[n].denomidx; + if (aux->accum[denomidx] > 0) /* protect against divide by zero */ + *value = (double) aux->accum[numidx] / (double) aux->accum[denomidx]; + else + *value = 0.; + } else { /* Raw PAPI event */ + *value = (double) aux->accum[numidx]; + } + break; + } + } + if (n == nevents) + return GPTLerror ("GPTL_PAPIget_eventvalue: event %s not enabled\n", eventname); + return 0; +} + +/* +** GPTL_PAPIis_multiplexed: return status of whether events are being multiplexed +*/ + +bool GPTL_PAPIis_multiplexed () +{ + return is_multiplexed; +} + +/* +** The following functions are publicly available +*/ + +void read_counters100 () +{ + int i; + int ret; + long_long counters[MAX_AUX]; + + for (i = 0; i < 10; ++i) { + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + ret = PAPI_read (EventSet[0], counters); + } + return; +} + +/* +** GPTLevent_name_to_code: convert a string to a PAPI code +** or derived event code. +** +** Input arguments: +** arg: string to convert +** +** Output arguments: +** code: PAPI or GPTL derived code +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLevent_name_to_code (const char *name, int *code) +{ + int ret; /* return code */ + int n; /* loop over derived entries */ + + /* + ** First check derived events + */ + + for (n = 0; n < nderivedentries; ++n) { + if (STRMATCH (name, derivedtable[n].namestr)) { + *code = derivedtable[n].counter; + return 0; + } + } + + /* + ** Next check PAPI events--note that PAPI must be initialized before the + ** name_to_code function can be invoked. + */ + + if ((ret = GPTL_PAPIlibraryinit ()) < 0) + return GPTLerror ("GPTL_event_name_to_code: GPTL_PAPIlibraryinit failure\n"); + + if ((PAPI_event_name_to_code ((char *) name, code)) != PAPI_OK) + return GPTLerror ("GPTL_event_name_to_code: PAPI_event_name_to_code failure\n"); + + return 0; +} + +/* +** GPTLevent_code_to_name: convert a string to a PAPI code +** or derived event code. +** +** Input arguments: +** code: event code (PAPI or derived) +** +** Output arguments: +** name: string corresponding to code +** +** Return value: 0 (success) or GPTLerror (failure) +*/ + +int GPTLevent_code_to_name (const int code, char *name) +{ + int ret; /* return code */ + int n; /* loop over derived entries */ + + /* + ** First check derived events + */ + + for (n = 0; n < nderivedentries; ++n) { + if (code == derivedtable[n].counter) { + strcpy (name, derivedtable[n].namestr); + return 0; + } + } + + /* + ** Next check PAPI events--note that PAPI must be initialized before the + ** code_to_name function can be invoked. + */ + + if ((ret = GPTL_PAPIlibraryinit ()) < 0) + return GPTLerror ("GPTL_event_code_to_name: GPTL_PAPIlibraryinit failure\n"); + + if (PAPI_event_code_to_name (code, name) != PAPI_OK) + return GPTLerror ("GPTL_event_code_to_name: PAPI_event_code_to_name failure\n"); + + return 0; +} + +int GPTLget_npapievents (void) +{ + return npapievents; +} + +#else + +/* +** HAVE_PAPI not defined branch: "Should not be called" entry points for public routines +*/ + +int GPTL_PAPIlibraryinit () +{ + return GPTLerror ("GPTL_PAPIlibraryinit: PAPI not enabled\n"); +} + +int GPTLevent_name_to_code (const char *name, int *code) +{ + return GPTLerror ("GPTLevent_name_to_code: PAPI not enabled\n"); +} + +int GPTLevent_code_to_name (int code, char *name) +{ + return GPTLerror ("GPTLevent_code_to_name: PAPI not enabled\n"); +} + +#endif /* HAVE_PAPI */ + diff --git a/components/cism/glimmer-cism/utils/libgptl/perf_mod.F90 b/components/cism/glimmer-cism/utils/libgptl/perf_mod.F90 new file mode 100644 index 0000000000..95660635b6 --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/perf_mod.F90 @@ -0,0 +1,1436 @@ +module perf_mod + +!----------------------------------------------------------------------- +! +! Purpose: This module is responsible for controlling the performance +! timer logic. +! +! Author: P. Worley, January 2007 +! +! $Id$ +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!- Uses ---------------------------------------------------------------- +!----------------------------------------------------------------------- + +#ifndef USE_CSM_SHARE + use perf_utils +#else + use shr_sys_mod, only: shr_sys_abort + use shr_kind_mod, only: shr_kind_cl, shr_kind_r8, shr_kind_i8 + use shr_mpi_mod, only: shr_mpi_barrier, shr_mpi_bcast + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit + use namelist_utils, only: find_group_name +#endif + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + private ! Make the default access private +#include + save + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- + public t_initf + public t_setLogUnit + public t_getLogUnit + public t_profile_onf + public t_barrier_onf + public t_single_filef + public t_stampf + public t_startf + public t_stopf + public t_enablef + public t_disablef + public t_adj_detailf + public t_barrierf + public t_prf + public t_finalizef + +!----------------------------------------------------------------------- +! Private interfaces (local) ------------------------------------------- +!----------------------------------------------------------------------- + private perf_defaultopts + private perf_setopts + private papi_defaultopts + private papi_setopts + +!----------------------------------------------------------------------- +!- include statements -------------------------------------------------- +!----------------------------------------------------------------------- +#include "gptl.inc" + +!----------------------------------------------------------------------- +! Private data --------------------------------------------------------- +!----------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! perf_mod options + !---------------------------------------------------------------------------- + integer, parameter :: def_p_logunit = 6 ! default + integer, private :: p_logunit = def_p_logunit + ! unit number for log output + + logical, parameter :: def_timing_initialized = .false. ! default + logical, private :: timing_initialized = def_timing_initialized + ! flag indicating whether timing library has + ! been initialized + + logical, parameter :: def_timing_disable = .false. ! default + logical, private :: timing_disable = def_timing_disable + ! flag indicating whether timers are disabled + + logical, parameter :: def_timing_barrier = .false. ! default + logical, private :: timing_barrier = def_timing_barrier + ! flag indicating whether the mpi_barrier in + ! t_barrierf should be called + + integer, parameter :: def_timer_depth_limit = 99999 ! default + integer, private :: timer_depth_limit = def_timer_depth_limit + ! integer indicating maximum number of levels of + ! timer nesting + + integer, parameter :: def_timing_detail_limit = 1 ! default + integer, private :: timing_detail_limit = def_timing_detail_limit + ! integer indicating maximum detail level to + ! profile + + integer, parameter :: init_timing_disable_depth = 0 ! init + integer, private :: timing_disable_depth = init_timing_disable_depth + ! integer indicating depth of t_disablef calls + + integer, parameter :: init_timing_detail = 0 ! init + integer, private :: cur_timing_detail = init_timing_detail + ! current timing detail level + + logical, parameter :: def_perf_single_file = .false. ! default + logical, private :: perf_single_file = def_perf_single_file + ! flag indicating whether the performance timer + ! output should be written to a single file + ! (per component communicator) or to a + ! separate file for each process + + integer, parameter :: def_perf_outpe_num = 0 ! default + integer, private :: perf_outpe_num = def_perf_outpe_num + ! maximum number of processes writing out + ! timing data (for this component communicator) + + integer, parameter :: def_perf_outpe_stride = 1 ! default + integer, private :: perf_outpe_stride = def_perf_outpe_stride + ! separation between process ids for processes + ! that are writing out timing data + ! (for this component communicator) + + logical, parameter :: def_perf_global_stats = .true. ! default + logical, private :: perf_global_stats = def_perf_global_stats + ! collect and print out global performance statistics + ! (for this component communicator) +#ifdef HAVE_NANOTIME + integer, parameter :: def_perf_timer = GPTLnanotime ! default +#else +#ifdef HAVE_MPI + integer, parameter :: def_perf_timer = GPTLmpiwtime ! default +#else +#ifdef CPRIBM + integer,parameter :: def_perf_timer = GPTLread_real_time +#else + integer,parameter :: def_perf_timer = GPTLgettimeofday +#endif +#endif +#endif + + + integer, private :: perf_timer = def_perf_timer ! default + ! integer indicating which timer to use + ! (as defined in gptl.inc) + +#ifdef HAVE_PAPI + logical, parameter :: def_perf_papi_enable = .false. ! default +#else + logical, parameter :: def_perf_papi_enable = .false. ! default +#endif + logical, private :: perf_papi_enable = def_perf_papi_enable + ! flag indicating whether the PAPI namelist + ! should be read and HW performance counters + ! used in profiling + + ! PAPI counter ids + integer, parameter :: PAPI_NULL = -1 + + integer, parameter :: def_papi_ctr1 = PAPI_NULL ! default + integer, private :: papi_ctr1 = def_papi_ctr1 + + integer, parameter :: def_papi_ctr2 = PAPI_NULL ! default + integer, private :: papi_ctr2 = def_papi_ctr2 + + integer, parameter :: def_papi_ctr3 = PAPI_NULL ! default + integer, private :: papi_ctr3 = def_papi_ctr3 + + integer, parameter :: def_papi_ctr4 = PAPI_NULL ! default + integer, private :: papi_ctr4 = def_papi_ctr4 + +!======================================================================= +contains +!======================================================================= + +! +!======================================================================== +! + subroutine t_getLogUnit(LogUnit) +!----------------------------------------------------------------------- +! Purpose: Get log unit number. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + integer(SHR_KIND_IN), intent(OUT) :: LogUnit ! Unit number for log output +!----------------------------------------------------------------------- + + LogUnit = p_logunit + + return + end subroutine t_getLogUnit +! +!======================================================================== +! + subroutine t_setLogUnit(LogUnit) +!----------------------------------------------------------------------- +! Purpose: Set log unit number. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + integer(SHR_KIND_IN), intent(IN) :: LogUnit ! Unit number for log output +!----------------------------------------------------------------------- + + p_logunit = LogUnit +#ifndef USE_CSM_SHARE + call perfutils_setunit(p_logunit) +#endif + + return + end subroutine t_setLogUnit +! +!======================================================================== +! + subroutine perf_defaultopts(timing_disable_out, & + perf_timer_out, & + timer_depth_limit_out, & + timing_detail_limit_out, & + timing_barrier_out, & + perf_outpe_num_out, & + perf_outpe_stride_out, & + perf_single_file_out, & + perf_global_stats_out, & + perf_papi_enable_out ) +!----------------------------------------------------------------------- +! Purpose: Return default runtime options +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- + ! timers disable/enable option + logical, intent(out), optional :: timing_disable_out + ! performance timer option + integer, intent(out), optional :: perf_timer_out + ! timer depth limit option + integer, intent(out), optional :: timer_depth_limit_out + ! timer detail limit option + integer, intent(out), optional :: timing_detail_limit_out + ! timing barrier enable/disable option + logical, intent(out), optional :: timing_barrier_out + ! number of processes writing out timing data + integer, intent(out), optional :: perf_outpe_num_out + ! separation between process ids for processes that are writing out timing data + integer, intent(out), optional :: perf_outpe_stride_out + ! timing single / multple output file option + logical, intent(out), optional :: perf_single_file_out + ! collect and output global performance statistics option + logical, intent(out), optional :: perf_global_stats_out + ! calling PAPI to read HW performance counters option + logical, intent(out), optional :: perf_papi_enable_out +!----------------------------------------------------------------------- + if ( present(timing_disable_out) ) then + timing_disable_out = def_timing_disable + endif + if ( present(perf_timer_out) ) then + perf_timer_out = def_perf_timer + endif + if ( present(timer_depth_limit_out) ) then + timer_depth_limit_out = def_timer_depth_limit + endif + if ( present(timing_detail_limit_out) ) then + timing_detail_limit_out = def_timing_detail_limit + endif + if ( present(timing_barrier_out) ) then + timing_barrier_out = def_timing_barrier + endif + if ( present(perf_outpe_num_out) ) then + perf_outpe_num_out = def_perf_outpe_num + endif + if ( present(perf_outpe_stride_out) ) then + perf_outpe_stride_out = def_perf_outpe_stride + endif + if ( present(perf_single_file_out) ) then + perf_single_file_out = def_perf_single_file + endif + if ( present(perf_global_stats_out) ) then + perf_global_stats_out = def_perf_global_stats + endif + if ( present(perf_papi_enable_out) ) then + perf_papi_enable_out = def_perf_papi_enable + endif +! + return + end subroutine perf_defaultopts +! +!======================================================================== +! + subroutine perf_setopts(mastertask, & + LogPrint, & + timing_disable_in, & + perf_timer_in, & + timer_depth_limit_in, & + timing_detail_limit_in, & + timing_barrier_in, & + perf_outpe_num_in, & + perf_outpe_stride_in, & + perf_single_file_in, & + perf_global_stats_in, & + perf_papi_enable_in ) +!----------------------------------------------------------------------- +! Purpose: Set runtime options +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments---------------------------- +! + ! master process? + logical, intent(in) :: mastertask + ! Print out to log file? + logical, intent(IN) :: LogPrint + ! timers disable/enable option + logical, intent(in), optional :: timing_disable_in + ! performance timer option + integer, intent(in), optional :: perf_timer_in + ! timer depth limit option + integer, intent(in), optional :: timer_depth_limit_in + ! timer detail limit option + integer, intent(in), optional :: timing_detail_limit_in + ! timing barrier enable/disable option + logical, intent(in), optional :: timing_barrier_in + ! number of processes writing out timing data + integer, intent(in), optional :: perf_outpe_num_in + ! separation between process ids for processes that are writing out timing data + integer, intent(in), optional :: perf_outpe_stride_in + ! timing single / multple output file option + logical, intent(in), optional :: perf_single_file_in + ! collect and output global performance statistics option + logical, intent(in), optional :: perf_global_stats_in + ! calling PAPI to read HW performance counters option + logical, intent(in), optional :: perf_papi_enable_in +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! error return +!----------------------------------------------------------------------- + if ( .not. timing_initialized ) then + + if ( present(timing_disable_in) ) then + timing_disable = timing_disable_in + if (timing_disable) then + ierr = GPTLdisable() + else + ierr = GPTLenable() + endif + endif + if ( present(perf_timer_in) ) then + if ((perf_timer_in .eq. GPTLgettimeofday) .or. & + (perf_timer_in .eq. GPTLnanotime) .or. & + (perf_timer_in .eq. GPTLread_real_time) .or. & + (perf_timer_in .eq. GPTLmpiwtime) .or. & + (perf_timer_in .eq. GPTLclockgettime) .or. & + (perf_timer_in .eq. GPTLpapitime)) then + perf_timer = perf_timer_in + else + if (mastertask) then + write(p_logunit,*) 'PERF_SETOPTS: illegal timer requested=',& + perf_timer_in, '. Request ignored.' + endif + endif + endif + if ( present(timer_depth_limit_in) ) then + timer_depth_limit = timer_depth_limit_in + endif + if ( present(timing_detail_limit_in) ) then + timing_detail_limit = timing_detail_limit_in + endif + if ( present(timing_barrier_in) ) then + timing_barrier = timing_barrier_in + endif + if ( present(perf_outpe_num_in) ) then + perf_outpe_num = perf_outpe_num_in + endif + if ( present(perf_outpe_stride_in) ) then + perf_outpe_stride = perf_outpe_stride_in + endif + if ( present(perf_single_file_in) ) then + perf_single_file = perf_single_file_in + endif + if ( present(perf_global_stats_in) ) then + perf_global_stats = perf_global_stats_in + endif + if ( present(perf_papi_enable_in) ) then +#ifdef HAVE_PAPI + perf_papi_enable = perf_papi_enable_in +#else + if (perf_papi_enable_in) then + if (mastertask) then + write(p_logunit,*) 'PERF_SETOPTS: PAPI library not linked in. ',& + 'Request to enable PAPI ignored.' + endif + endif + perf_papi_enable = .false. +#endif + endif +! + if (mastertask .and. LogPrint) then + write(p_logunit,*) '(t_initf) Using profile_disable=', timing_disable, & + ' profile_timer=', perf_timer + write(p_logunit,*) '(t_initf) profile_depth_limit=', timer_depth_limit, & + ' profile_detail_limit=', timing_detail_limit + write(p_logunit,*) '(t_initf) profile_barrier=', timing_barrier, & + ' profile_outpe_num=', perf_outpe_num + write(p_logunit,*) '(t_initf) profile_outpe_stride=', perf_outpe_stride , & + ' profile_single_file=', perf_single_file + write(p_logunit,*) '(t_initf) profile_global_stats=', perf_global_stats , & + ' profile_papi_enable=', perf_papi_enable + endif +! +#ifdef DEBUG + else + write(p_logunit,*) 'PERF_SETOPTS: timing library already initialized. Request ignored.' +#endif + endif +! + return + end subroutine perf_setopts + +! +!======================================================================== +! + subroutine papi_defaultopts(papi_ctr1_out, & + papi_ctr2_out, & + papi_ctr3_out, & + papi_ctr4_out ) +!----------------------------------------------------------------------- +! Purpose: Return default runtime PAPI counter options +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- + ! PAPI counter option #1 + integer, intent(out), optional :: papi_ctr1_out + ! PAPI counter option #2 + integer, intent(out), optional :: papi_ctr2_out + ! PAPI counter option #3 + integer, intent(out), optional :: papi_ctr3_out + ! PAPI counter option #4 + integer, intent(out), optional :: papi_ctr4_out +!----------------------------------------------------------------------- + if ( present(papi_ctr1_out) ) then + papi_ctr1_out = def_papi_ctr1 + endif + if ( present(papi_ctr2_out) ) then + papi_ctr2_out = def_papi_ctr2 + endif + if ( present(papi_ctr3_out) ) then + papi_ctr3_out = def_papi_ctr3 + endif + if ( present(papi_ctr4_out) ) then + papi_ctr4_out = def_papi_ctr4 + endif +! + return + end subroutine papi_defaultopts +! +!======================================================================== +! + subroutine papi_setopts(papi_ctr1_in, & + papi_ctr2_in, & + papi_ctr3_in, & + papi_ctr4_in ) +!----------------------------------------------------------------------- +! Purpose: Set runtime PAPI counter options +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments---------------------------- +! + ! performance counter option + integer, intent(in), optional :: papi_ctr1_in + ! performance counter option + integer, intent(in), optional :: papi_ctr2_in + ! performance counter option + integer, intent(in), optional :: papi_ctr3_in + ! performance counter option + integer, intent(in), optional :: papi_ctr4_in +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! error return +!----------------------------------------------------------------------- + if ( .not. timing_initialized ) then + + if ( present(papi_ctr1_in) ) then + if (papi_ctr1_in < 0) then + papi_ctr1 = papi_ctr1_in + else + papi_ctr1 = PAPI_NULL + endif + endif + if ( present(papi_ctr2_in) ) then + if (papi_ctr2_in < 0) then + papi_ctr2 = papi_ctr2_in + else + papi_ctr2 = PAPI_NULL + endif + endif + if ( present(papi_ctr3_in) ) then + if (papi_ctr3_in < 0) then + papi_ctr3 = papi_ctr3_in + else + papi_ctr3 = PAPI_NULL + endif + endif + if ( present(papi_ctr4_in) ) then + if (papi_ctr4_in < 0) then + papi_ctr4 = papi_ctr4_in + else + papi_ctr4 = PAPI_NULL + endif + endif +! +#ifdef DEBUG + else + write(p_logunit,*) 'PAPI_SETOPTS: timing library already initialized. Request ignored.' +#endif + endif +! + return + end subroutine papi_setopts +! +!======================================================================== +! + logical function t_profile_onf() +!----------------------------------------------------------------------- +! Purpose: Return flag indicating whether profiling is currently active. +! Part of workaround to implement FVbarrierclock before +! communicators exposed in Pilgrim. Does not check level of +! event nesting. +! Author: P. Worley +!----------------------------------------------------------------------- + + if ((.not. timing_initialized) .or. & + (timing_disable_depth > 0) .or. & + (cur_timing_detail > timing_detail_limit)) then + t_profile_onf = .false. + else + t_profile_onf = .true. + endif + + end function t_profile_onf +! +!======================================================================== +! + logical function t_barrier_onf() +!----------------------------------------------------------------------- +! Purpose: Return timing_barrier. Part of workaround to implement +! FVbarrierclock before communicators exposed in Pilgrim. +! Author: P. Worley +!----------------------------------------------------------------------- + + t_barrier_onf = timing_barrier + + end function t_barrier_onf +! +!======================================================================== +! + logical function t_single_filef() +!----------------------------------------------------------------------- +! Purpose: Return perf_single_file. Used to control output of other +! performance data, only spmdstats currently. +! Author: P. Worley +!----------------------------------------------------------------------- + + t_single_filef = perf_single_file + + end function t_single_filef +! +!======================================================================== +! + subroutine t_stampf(wall, usr, sys) +!----------------------------------------------------------------------- +! Purpose: Record wallclock, user, and system times (seconds). +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Output arguments----------------------------- +! + real(shr_kind_r8), intent(out) :: wall ! wallclock time + real(shr_kind_r8), intent(out) :: usr ! user time + real(shr_kind_r8), intent(out) :: sys ! system time +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!----------------------------------------------------------------------- +! + if ((.not. timing_initialized) .or. & + (timing_disable_depth > 0)) then + wall = 0.0 + usr = 0.0 + sys = 0.0 + else + ierr = GPTLstamp(wall, usr, sys) + endif + + return + end subroutine t_stampf +! +!======================================================================== +! + subroutine t_startf(event, handle) +!----------------------------------------------------------------------- +! Purpose: Start an event timer +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + ! performance timer event name + character(len=*), intent(in) :: event +! +!---------------------------Input/Output arguments---------------------- +! + ! GPTL event handle + integer(shr_kind_i8), optional :: handle +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!----------------------------------------------------------------------- +! + if ((timing_initialized) .and. & + (timing_disable_depth .eq. 0) .and. & + (cur_timing_detail .le. timing_detail_limit)) then + + if ( present (handle) ) then + ierr = GPTLstart_handle(event, handle) + else + ierr = GPTLstart(event) + endif + + endif + + return + end subroutine t_startf +! +!======================================================================== +! + subroutine t_stopf(event, handle) +!----------------------------------------------------------------------- +! Purpose: Stop an event timer +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + ! performance timer event name + character(len=*), intent(in) :: event +! +!---------------------------Input/Output arguments---------------------- +! + ! GPTL event handle + integer(shr_kind_i8), optional :: handle +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!----------------------------------------------------------------------- +! + if ((timing_initialized) .and. & + (timing_disable_depth .eq. 0) .and. & + (cur_timing_detail .le. timing_detail_limit)) then + + if ( present (handle) ) then + ierr = GPTLstop_handle(event, handle) + else + ierr = GPTLstop(event) + endif + + endif + + return + end subroutine t_stopf +! +!======================================================================== +! + subroutine t_enablef() +!----------------------------------------------------------------------- +! Purpose: Enable t_startf, t_stopf, t_stampf, and t_barrierf. Ignored +! in threaded regions. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!---------------------------Externals----------------------------------- +! +#if ( defined _OPENMP ) + logical omp_in_parallel + external omp_in_parallel +#endif +! +!----------------------------------------------------------------------- +! + if (.not. timing_initialized) return + +#if ( defined _OPENMP ) + if (omp_in_parallel()) return +#endif + + if (timing_disable_depth > 0) then + if (timing_disable_depth .eq. 1) then + ierr = GPTLenable() + endif + timing_disable_depth = timing_disable_depth - 1 + endif + + return + end subroutine t_enablef +! +!======================================================================== +! + subroutine t_disablef() +!----------------------------------------------------------------------- +! Purpose: Disable t_startf, t_stopf, t_stampf, and t_barrierf. Ignored +! in threaded regions. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!---------------------------Externals----------------------------------- +! +#if ( defined _OPENMP ) + logical omp_in_parallel + external omp_in_parallel +#endif +! +!----------------------------------------------------------------------- +! + if (.not. timing_initialized) return + +#if ( defined _OPENMP ) + if (omp_in_parallel()) return +#endif + + if (timing_disable_depth .eq. 0) then + ierr = GPTLdisable() + endif + timing_disable_depth = timing_disable_depth + 1 + + return + end subroutine t_disablef +! +!======================================================================== +! + subroutine t_adj_detailf(detail_adjustment) +!----------------------------------------------------------------------- +! Purpose: Modify current detail level. Ignored in threaded regions. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + integer, intent(in) :: detail_adjustment ! user defined increase or + ! decrease in detail level +! +!---------------------------Externals----------------------------------- +! +#if ( defined _OPENMP ) + logical omp_in_parallel + external omp_in_parallel +#endif +! +!----------------------------------------------------------------------- +! + if (.not. timing_initialized) return + +#if ( defined _OPENMP ) + if (omp_in_parallel()) return +#endif + + cur_timing_detail = cur_timing_detail + detail_adjustment + + return + end subroutine t_adj_detailf +! +!======================================================================== +! + subroutine t_barrierf(event, mpicom) +!----------------------------------------------------------------------- +! Purpose: Call (and time) mpi_barrier. Ignored inside OpenMP +! threaded regions. Note that barrier executed even if +! event not recorded because of level of timer event nesting. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- + ! mpi communicator id + integer, intent(in), optional :: mpicom + ! performance timer event name + character(len=*), intent(in), optional :: event +! +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!---------------------------Externals----------------------------------- +! +#if ( defined _OPENMP ) + logical omp_in_parallel + external omp_in_parallel +#endif +! +!----------------------------------------------------------------------- +! +#if ( defined _OPENMP ) + if (omp_in_parallel()) return +#endif + if ((timing_initialized) .and. & + (timing_disable_depth .eq. 0) .and. & + (cur_timing_detail .le. timing_detail_limit)) then + + if (timing_barrier) then + + if ( present (event) ) then + ierr = GPTLstart(event) + endif + + if ( present (mpicom) ) then + call shr_mpi_barrier(mpicom, 'T_BARRIERF: bad mpi communicator') + else + call shr_mpi_barrier(MPI_COMM_WORLD, 'T_BARRIERF: bad mpi communicator') + endif + + if ( present (event) ) then + ierr = GPTLstop(event) + endif + + endif + + endif + + return + end subroutine t_barrierf +! +!======================================================================== +! + subroutine t_prf(filename, mpicom, num_outpe, stride_outpe, & + single_file, global_stats, output_thispe) +!----------------------------------------------------------------------- +! Purpose: Write out performance timer data +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + ! performance timer output file name + character(len=*), intent(in), optional :: filename + ! mpi communicator id + integer, intent(in), optional :: mpicom + ! maximum number of processes writing out timing data + integer, intent(in), optional :: num_outpe + ! separation between process ids for processes writing out data + integer, intent(in), optional :: stride_outpe + ! enable/disable the writing of data to a single file + logical, intent(in), optional :: single_file + ! enable/disable the collection of global statistics + logical, intent(in), optional :: global_stats + ! output timing data for this process + logical, intent(in), optional :: output_thispe +! +!---------------------------Local workspace----------------------------- +! + logical one_file ! flag indicting whether to write + ! all data to a single file + logical glb_stats ! flag indicting whether to compute + ! global statistics + logical pr_write ! flag indicating whether the current + ! GPTL output mode is write + logical write_data ! flag indicating whether this process + ! should output its timing data + integer i ! loop index + integer mpicom2 ! local copy of MPI communicator + integer me ! communicator local process id + integer npes ! local communicator group size + integer gme ! global process id + integer ierr ! MPI error return + integer outpe_num ! max number of processes writing out + ! timing data (excluding output_thispe) + integer outpe_stride ! separation between process ids for + ! processes writing out timing data + integer max_outpe ! max process id for processes + ! writing out timing data + integer signal ! send/recv variable for single + ! output file logic + integer str_length ! string length + integer unitn ! file unit number + integer cme_adj ! length of filename suffix + integer status (MPI_STATUS_SIZE) ! Status of message + character(len=7) cme ! string representation of process id + character(len=SHR_KIND_CX+14) fname ! timing output filename +!----------------------------------------------------------------------- +! + if (.not. timing_initialized) return + + call t_startf("t_prf") +!$OMP MASTER + call mpi_comm_rank(MPI_COMM_WORLD, gme, ierr) + if ( present(mpicom) ) then + mpicom2 = mpicom + call mpi_comm_size(mpicom2, npes, ierr) + if (ierr .eq. MPI_ERR_COMM) then + call shr_sys_abort('T_PRF: bad mpi communicator') + endif + call mpi_comm_rank(mpicom2, me, ierr) + else + call mpi_comm_size(MPI_COMM_WORLD, npes, ierr) + mpicom2 = MPI_COMM_WORLD + me = gme + endif + + do i=1,SHR_KIND_CX+14 + fname(i:i) = " " + enddo + + unitn = shr_file_getUnit() + + ! determine what the current output mode is (append or write) + if (GPTLpr_query_write() == 1) then + pr_write = .true. + ierr = GPTLpr_set_append() + else + pr_write=.false. + endif + + ! Determine whether to write all data to a single fie + if (present(single_file)) then + one_file = single_file + else + one_file = perf_single_file + endif + + ! Determine whether to compute global statistics + if (present(global_stats)) then + glb_stats = global_stats + else + glb_stats = perf_global_stats + endif + + ! Determine which processes are writing out timing data + write_data = .false. + + if (present(num_outpe)) then + if (num_outpe < 0) then + outpe_num = npes + else + outpe_num = num_outpe + endif + else + if (perf_outpe_num < 0) then + outpe_num = npes + else + outpe_num = perf_outpe_num + endif + endif + + if (present(stride_outpe)) then + if (stride_outpe < 1) then + outpe_stride = 1 + else + outpe_stride = stride_outpe + endif + else + if (perf_outpe_stride < 1) then + outpe_stride = 1 + else + outpe_stride = perf_outpe_stride + endif + endif + + max_outpe = min(outpe_num*outpe_stride, npes) - 1 + + if ((mod(me, outpe_stride) .eq. 0) .and. (me .le. max_outpe)) & + write_data = .true. + + if (present(output_thispe)) then + write_data = output_thispe + endif + + ! If a single timing output file, take turns writing to it. + if (one_file) then + + if ( present(filename) ) then + str_length = min(SHR_KIND_CX,len_trim(filename)) + fname(1:str_length) = filename(1:str_length) + else + fname(1:10) = "timing_all" + endif + + signal = 0 + if (me .eq. 0) then + + if (glb_stats) then + open( unitn, file=trim(fname), status='UNKNOWN' ) + write( unitn, 100) npes + 100 format(/,"***** GLOBAL STATISTICS (",I6," MPI TASKS) *****",/) + close( unitn ) + + ierr = GPTLpr_summary_file(mpicom2, trim(fname)) + endif + + if (write_data) then + if (glb_stats) then + open( unitn, file=trim(fname), status='OLD', position='APPEND' ) + else + open( unitn, file=trim(fname), status='UNKNOWN' ) + endif + + write( unitn, 101) me, gme + 101 format(/,"************ PROCESS ",I6," (",I6,") ************",/) + close( unitn ) + + ierr = GPTLpr_file(trim(fname)) + endif + + else + + if (glb_stats) then + ierr = GPTLpr_summary_file(mpicom2, trim(fname)) + endif + + call mpi_recv (signal, 1, mpi_integer, me-1, me-1, mpicom2, status, ierr) + if (ierr /= mpi_success) then + write(p_logunit,*) 'T_PRF: mpi_recv failed ierr=',ierr + call shr_sys_abort() + end if + + if (write_data) then + open( unitn, file=trim(fname), status='OLD', position='APPEND' ) + write( unitn, 101) me, gme + close( unitn ) + + ierr = GPTLpr_file(trim(fname)) + endif + + endif + + if (me+1 < npes) & + call mpi_send (signal, 1, mpi_integer, me+1, me, mpicom2, ierr) + + else + + if (glb_stats) then + if ( present(filename) ) then + str_length = min(SHR_KIND_CX-6,len_trim(filename)) + fname(1:str_length) = filename(1:str_length) + else + str_length = 6 + fname(1:10) = "timing" + endif + fname(str_length+1:str_length+6) = '_stats' + + if (me .eq. 0) then + open( unitn, file=trim(fname), status='UNKNOWN' ) + write( unitn, 100) npes + close( unitn ) + endif + + ierr = GPTLpr_summary_file(mpicom2, trim(fname)) + fname(str_length+1:str_length+6) = ' ' + endif + + if (write_data) then + if (npes .le. 10) then + write(cme,'(i1.1)') me + cme_adj = 2 + elseif (npes .le. 100) then + write(cme,'(i2.2)') me + cme_adj = 3 + elseif (npes .le. 1000) then + write(cme,'(i3.3)') me + cme_adj = 4 + elseif (npes .le. 10000) then + write(cme,'(i4.4)') me + cme_adj = 5 + elseif (npes .le. 100000) then + write(cme,'(i5.5)') me + cme_adj = 6 + else + write(cme,'(i6.6)') me + cme_adj = 7 + endif + + if ( present(filename) ) then + str_length = min(SHR_KIND_CX-cme_adj,len_trim(filename)) + fname(1:str_length) = filename(1:str_length) + else + str_length = 6 + fname(1:10) = "timing" + endif + fname(str_length+1:str_length+1) = '.' + fname(str_length+2:str_length+cme_adj) = cme + + open( unitn, file=trim(fname), status='UNKNOWN' ) + write( unitn, 101) me, gme + close( unitn ) + + ierr = GPTLpr_file(trim(fname)) + endif + + endif + + call shr_file_freeUnit( unitn ) + + ! reset GPTL output mode + if (pr_write) then + ierr = GPTLpr_set_write() + endif + +!$OMP END MASTER + call t_stopf("t_prf") + + return + end subroutine t_prf +! +!======================================================================== +! + subroutine t_initf(NLFilename, LogPrint, LogUnit, mpicom, MasterTask) +!----------------------------------------------------------------------- +! Purpose: Set default values of runtime timing options +! before namelists prof_inparm and papi_inparm are read, +! read namelists (and broadcast, if SPMD), +! then initialize timing library. +! Author: P. Worley (based on shr_inputinfo_mod and runtime_opts) +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + character(len=*), intent(IN) :: NLFilename ! Name-list filename + logical, optional, intent(IN) :: LogPrint ! If print out to log file + integer, optional, intent(IN) :: LogUnit ! Unit number for log output + integer, optional, intent(IN) :: mpicom ! MPI communicator + logical, optional, intent(IN) :: MasterTask ! If MPI master task +! +!---------------------------Local workspace----------------------------- +! + character(len=*), parameter :: subname = '(T_INITF) ' + logical :: MasterTask2 ! If MPI master task + logical :: LogPrint2 ! If print to log + + integer me ! communicator local process id + integer ierr ! error return + integer unitn ! file unit number + integer papi_ctr1_id ! PAPI counter id + integer papi_ctr2_id ! PAPI counter id + integer papi_ctr3_id ! PAPI counter id + integer papi_ctr4_id ! PAPI counter id +! +!---------------------------Namelists ---------------------------------- +! + logical profile_disable + logical profile_barrier + logical profile_single_file + logical profile_global_stats + integer profile_depth_limit + integer profile_detail_limit + integer profile_outpe_num + integer profile_outpe_stride + integer profile_timer + logical profile_papi_enable + namelist /prof_inparm/ profile_disable, profile_barrier, & + profile_single_file, profile_global_stats, & + profile_depth_limit, & + profile_detail_limit, profile_outpe_num, & + profile_outpe_stride, profile_timer, & + profile_papi_enable + + character(len=16) papi_ctr1_str + character(len=16) papi_ctr2_str + character(len=16) papi_ctr3_str + character(len=16) papi_ctr4_str + namelist /papi_inparm/ papi_ctr1_str, papi_ctr2_str, & + papi_ctr3_str, papi_ctr4_str +!----------------------------------------------------------------------- + if ( timing_initialized ) then +#ifdef DEBUG + write(p_logunit,*) 'T_INITF: timing library already initialized. Request ignored.' +#endif + return + endif + +!$OMP MASTER + if ( present(LogUnit) ) then + call t_setLogUnit(LogUnit) + else + call t_setLogUnit(def_p_logunit) + endif + + if ( present(MasterTask) .and. present(mpicom) )then + call mpi_comm_rank(mpicom, me, ierr) + if (ierr .eq. MPI_ERR_COMM) then + call shr_sys_abort('T_INITF: bad mpi communicator') + endif + if (me .eq. 0) then + MasterTask2 = .true. + else + MasterTask2 = .false. + endif + else + MasterTask2 = .true. + end if + + if ( present(LogPrint) ) then + LogPrint2 = LogPrint + else + LogPrint2 = .true. + endif + + ! Set PERF defaults, then override with user-specified input + call perf_defaultopts(timing_disable_out=profile_disable, & + perf_timer_out=profile_timer, & + timer_depth_limit_out=profile_depth_limit, & + timing_detail_limit_out=profile_detail_limit, & + timing_barrier_out=profile_barrier, & + perf_outpe_num_out = profile_outpe_num, & + perf_outpe_stride_out = profile_outpe_stride, & + perf_single_file_out=profile_single_file, & + perf_global_stats_out=profile_global_stats, & + perf_papi_enable_out=profile_papi_enable ) + if ( MasterTask2 ) then + + ! Read in the prof_inparm namelist from NLFilename if it exists + + write(p_logunit,*) '(t_initf) Read in prof_inparm namelist from: '//trim(NLFilename) + unitn = shr_file_getUnit() + + ierr = 1 + open( unitn, file=trim(NLFilename), status='old', iostat=ierr ) + if (ierr .eq. 0) then + + ! Look for prof_inparm group name in the input file. + ! If found, leave the file positioned at that namelist group. + call find_group_name(unitn, 'prof_inparm', status=ierr) + + if (ierr == 0) then ! found prof_inparm + read(unitn, nml=prof_inparm, iostat=ierr) + if (ierr /= 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' error condition for prof_inparm' ) + end if + end if + + close(unitn) + + endif + call shr_file_freeUnit( unitn ) + + endif + + ! This logic assumes that there will be only one MasterTask + ! per communicator, and that this MasterTask is process 0. + if ( present(MasterTask) .and. present(mpicom) )then + call shr_mpi_bcast( profile_disable, MPICom ) + call shr_mpi_bcast( profile_barrier, MPICom ) + call shr_mpi_bcast( profile_single_file, MPICom ) + call shr_mpi_bcast( profile_global_stats, MPICom ) + call shr_mpi_bcast( profile_papi_enable, MPICom ) + call shr_mpi_bcast( profile_depth_limit, MPICom ) + call shr_mpi_bcast( profile_detail_limit, MPICom ) + call shr_mpi_bcast( profile_outpe_num, MPICom ) + call shr_mpi_bcast( profile_outpe_stride, MPICom ) + call shr_mpi_bcast( profile_timer, MPICom ) + end if + call perf_setopts (MasterTask2, LogPrint2, & + timing_disable_in=profile_disable, & + perf_timer_in=profile_timer, & + timer_depth_limit_in=profile_depth_limit, & + timing_detail_limit_in=profile_detail_limit, & + timing_barrier_in=profile_barrier, & + perf_outpe_num_in=profile_outpe_num, & + perf_outpe_stride_in=profile_outpe_stride, & + perf_single_file_in=profile_single_file, & + perf_global_stats_in=profile_global_stats, & + perf_papi_enable_in=profile_papi_enable ) + + ! Set PAPI defaults, then override with user-specified input + if (perf_papi_enable) then + call papi_defaultopts(papi_ctr1_out=papi_ctr1_id, & + papi_ctr2_out=papi_ctr2_id, & + papi_ctr3_out=papi_ctr3_id, & + papi_ctr4_out=papi_ctr4_id ) + + if ( MasterTask2 ) then + papi_ctr1_str = "PAPI_NO_CTR" + papi_ctr2_str = "PAPI_NO_CTR" + papi_ctr3_str = "PAPI_NO_CTR" + papi_ctr4_str = "PAPI_NO_CTR" + + + ! Read in the papi_inparm namelist from NLFilename if it exists + + write(p_logunit,*) '(t_initf) Read in papi_inparm namelist from: '//trim(NLFilename) + unitn = shr_file_getUnit() + + ierr = 1 + open( unitn, file=trim(NLFilename), status='old', iostat=ierr ) + if (ierr .eq. 0) then + ! Look for papi_inparm group name in the input file. + ! If found, leave the file positioned at that namelist group. + call find_group_name(unitn, 'papi_inparm', status=ierr) + + if (ierr == 0) then ! found papi_inparm + read(unitn, nml=papi_inparm, iostat=ierr) + if (ierr /= 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' error condition for papi_inparm' ) + end if + end if + + close(unitn) + + endif + call shr_file_freeUnit( unitn ) + + ! if enabled and nothing set, use "defaults" + if ((papi_ctr1_str(1:11) .eq. "PAPI_NO_CTR") .and. & + (papi_ctr2_str(1:11) .eq. "PAPI_NO_CTR") .and. & + (papi_ctr3_str(1:11) .eq. "PAPI_NO_CTR") .and. & + (papi_ctr4_str(1:11) .eq. "PAPI_NO_CTR")) then +!pw papi_ctr1_str = "PAPI_TOT_CYC" +!pw papi_ctr2_str = "PAPI_TOT_INS" +!pw papi_ctr3_str = "PAPI_FP_OPS" +!pw papi_ctr4_str = "PAPI_FP_INS" + papi_ctr1_str = "PAPI_FP_OPS" + endif + + if (papi_ctr1_str(1:11) /= "PAPI_NO_CTR") then + ierr = gptlevent_name_to_code(trim(papi_ctr1_str), papi_ctr1_id) + endif + if (papi_ctr2_str(1:11) /= "PAPI_NO_CTR") then + ierr = gptlevent_name_to_code(trim(papi_ctr2_str), papi_ctr2_id) + endif + if (papi_ctr3_str(1:11) /= "PAPI_NO_CTR") then + ierr = gptlevent_name_to_code(trim(papi_ctr3_str), papi_ctr3_id) + endif + if (papi_ctr4_str(1:11) /= "PAPI_NO_CTR") then + ierr = gptlevent_name_to_code(trim(papi_ctr4_str), papi_ctr4_id) + endif + + endif + ! This logic assumes that there will be only one MasterTask + ! per communicator, and that this MasterTask is process 0. + if ( present(MasterTask) .and. present(mpicom) )then + call shr_mpi_bcast( papi_ctr1_id, MPICom ) + call shr_mpi_bcast( papi_ctr2_id, MPICom ) + call shr_mpi_bcast( papi_ctr3_id, MPICom ) + call shr_mpi_bcast( papi_ctr4_id, MPICom ) + end if + + call papi_setopts (papi_ctr1_in=papi_ctr1_id, & + papi_ctr2_in=papi_ctr2_id, & + papi_ctr3_in=papi_ctr3_id, & + papi_ctr4_in=papi_ctr4_id ) + endif +!$OMP END MASTER +!$OMP BARRIER + + if (timing_disable) return + +!$OMP MASTER + ! + ! Set options and initialize timing library. + ! + ! Set timer + if (gptlsetutr (perf_timer) < 0) call shr_sys_abort (subname//':: gptlsetutr') + ! + ! For logical settings, 2nd arg 0 + ! to gptlsetoption means disable, non-zero means enable + ! + ! Turn off CPU timing (expensive) + ! + if (gptlsetoption (gptlcpu, 0) < 0) call shr_sys_abort (subname//':: gptlsetoption') + ! + ! Set max timer depth + ! + if (gptlsetoption (gptldepthlimit, timer_depth_limit) < 0) & + call shr_sys_abort (subname//':: gptlsetoption') + ! + ! Next 2 calls only work if PAPI is enabled. These examples enable counting + ! of total cycles and floating point ops, respectively + ! + if (perf_papi_enable) then + if (papi_ctr1 /= PAPI_NULL) then + if (gptlsetoption (papi_ctr1, 1) < 0) call shr_sys_abort (subname//':: gptlsetoption') + endif + if (papi_ctr2 /= PAPI_NULL) then + if (gptlsetoption (papi_ctr2, 1) < 0) call shr_sys_abort (subname//':: gptlsetoption') + endif + if (papi_ctr3 /= PAPI_NULL) then + if (gptlsetoption (papi_ctr3, 1) < 0) call shr_sys_abort (subname//':: gptlsetoption') + endif + if (papi_ctr4 /= PAPI_NULL) then + if (gptlsetoption (papi_ctr4, 1) < 0) call shr_sys_abort (subname//':: gptlsetoption') + endif + endif + ! + ! Initialize the timing lib. This call must occur after all gptlsetoption + ! calls and before all other timing lib calls. + ! + if (gptlinitialize () < 0) call shr_sys_abort (subname//':: gptlinitialize') + timing_initialized = .true. +!$OMP END MASTER +!$OMP BARRIER + + return + end subroutine t_initf +! +!======================================================================== +! + subroutine t_finalizef() +!----------------------------------------------------------------------- +! Purpose: shut down timing library +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Local workspace----------------------------- +! + integer ierr ! GPTL error return +! +!----------------------------------------------------------------------- +! + if (.not. timing_initialized) return + +!$OMP MASTER + ierr = GPTLfinalize() + timing_initialized = .false. +!$OMP END MASTER +!$OMP BARRIER + + return + end subroutine t_finalizef + +!=============================================================================== + +end module perf_mod diff --git a/components/cism/glimmer-cism/utils/libgptl/perf_utils.F90 b/components/cism/glimmer-cism/utils/libgptl/perf_utils.F90 new file mode 100644 index 0000000000..8998d9159b --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/perf_utils.F90 @@ -0,0 +1,533 @@ +module perf_utils + +!----------------------------------------------------------------------- +! +! Purpose: This module supplies the csm_share and CAM utilities +! needed by perf_mod.F90 (when the csm_share and CAM utilities +! are not available). +! +! Author: P. Worley, October 2007 +! +! $Id$ +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!- module boilerplate -------------------------------------------------- +!----------------------------------------------------------------------- + implicit none + private ! Make the default access private +#include + save + +!----------------------------------------------------------------------- +! Public interfaces ---------------------------------------------------- +!----------------------------------------------------------------------- + public perfutils_setunit + public shr_sys_abort + public shr_mpi_barrier + public shr_file_getUnit + public shr_file_freeUnit + public find_group_name + public to_lower + public shr_mpi_bcast + + interface shr_mpi_bcast ; module procedure & + shr_mpi_bcastl0, & + shr_mpi_bcasti0 + end interface + +!----------------------------------------------------------------------- +! Private interfaces --------------------------------------------------- +!----------------------------------------------------------------------- + private shr_sys_flush + private shr_mpi_chkerr + private shr_mpi_abort + +!----------------------------------------------------------------------- +!- include statements -------------------------------------------------- +!----------------------------------------------------------------------- +#include "gptl.inc" + +!----------------------------------------------------------------------- +! Public data --------------------------------------------------------- +!----------------------------------------------------------------------- + + !---------------------------------------------------------------------------- + ! precision/kind constants (from csm_share/shr/shr_kind_mod.F90) + !---------------------------------------------------------------------------- + integer,parameter,public :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter,public :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter,public :: SHR_KIND_IN = kind(1) ! native integer + integer,parameter,public :: SHR_KIND_CL = 256 ! long char + integer,parameter,public :: SHR_KIND_CX = 512 ! extra-long char + +!----------------------------------------------------------------------- +! Private data --------------------------------------------------------- +!----------------------------------------------------------------------- + + integer, parameter :: def_pu_logunit = 6 ! default + integer, private :: pu_logunit = def_pu_logunit + ! unit number for log output + +!======================================================================= +contains +!======================================================================= + +! +!======================================================================== +! + subroutine perfutils_setunit(LogUnit) +!----------------------------------------------------------------------- +! Purpose: Set log unit number. +! Author: P. Worley +!----------------------------------------------------------------------- +!---------------------------Input arguments----------------------------- +! + integer(SHR_KIND_IN), intent(IN) :: LogUnit ! Unit number for log output +!----------------------------------------------------------------------- + pu_logunit = LogUnit +! + return +! + end subroutine perfutils_setunit + +!============== Routines from csm_share/shr/shr_sys_mod.F90 ============ +!======================================================================= + +SUBROUTINE shr_sys_abort(string) + + IMPLICIT none + + character(*) ,optional :: string ! error message string + + !----- local ----- + integer(SHR_KIND_IN) :: ierr + logical :: flag + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_abort) ' + character(*),parameter :: F00 = "('(shr_sys_abort) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: consistent stopping mechanism +! (dumbed down from original shr_sys_mod.F90 version for use in perf_mod) +!------------------------------------------------------------------------------- + + call shr_sys_flush(pu_logunit) + + if ( present(string) ) then + if (len_trim(string) > 0) then + write(pu_logunit,*) trim(subName),' ERROR: ',trim(string) + else + write(pu_logunit,*) trim(subName),' ERROR ' + endif + else + write(pu_logunit,*) trim(subName),' ERROR ' + endif + + write(pu_logunit,F00) 'WARNING: calling mpi_abort() and stopping' + call shr_sys_flush(pu_logunit) + call mpi_abort(MPI_COMM_WORLD,0,ierr) + call shr_sys_flush(pu_logunit) +#ifndef CPRNAG + call abort() +#endif + + stop + +END SUBROUTINE shr_sys_abort + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_flush(unit) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_flush) ' + character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + +#if (defined IRIX64 || defined CRAY || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX || defined UNICOSMP) +#ifdef CPRNAG + flush(unit) +#else + call flush(unit) +#endif +#endif +#if (defined AIX) + call flush_(unit) +#endif + +END SUBROUTINE shr_sys_flush + +!=============================================================================== + +!================== Routines from csm_share/shr/shr_mpi_mod.F90 =============== +!=============================================================================== + +SUBROUTINE shr_mpi_chkerr(rcode,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: rcode ! input MPI error code + character(*), intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_chkerr) ' + character(MPI_MAX_ERROR_STRING) :: lstring + integer(SHR_KIND_IN) :: len + integer(SHR_KIND_IN) :: ierr + +!------------------------------------------------------------------------------- +! PURPOSE: layer on MPI error checking +!------------------------------------------------------------------------------- + + if (rcode /= MPI_SUCCESS) then + call MPI_ERROR_STRING(rcode,lstring,len,ierr) + write(pu_logunit,*) trim(subName),":",lstring(1:len) + call shr_mpi_abort(string,rcode) + endif + +END SUBROUTINE shr_mpi_chkerr + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_abort(string,rcode) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + integer,optional,intent(in) :: rcode ! optional code + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_abort) ' + integer(SHR_KIND_IN) :: ierr + +!------------------------------------------------------------------------------- +! PURPOSE: MPI abort +!------------------------------------------------------------------------------- + + if ( present(string) .and. present(rcode) ) then + write(pu_logunit,*) trim(subName),":",trim(string),rcode + endif + call MPI_ABORT(MPI_COMM_WORLD,rcode,ierr) + +END SUBROUTINE shr_mpi_abort + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_barrier(comm,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_barrier) ' + integer(SHR_KIND_IN) :: ierr + +!------------------------------------------------------------------------------- +! PURPOSE: MPI barrier +!------------------------------------------------------------------------------- + + call MPI_BARRIER(comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + +END SUBROUTINE shr_mpi_barrier + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti0(vec,comm,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast an integer +!------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_BCAST(vec,lsize,MPI_INTEGER,0,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + +END SUBROUTINE shr_mpi_bcasti0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastl0(vec,comm,string) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl0) ' + integer(SHR_KIND_IN) :: ierr + integer(SHR_KIND_IN) :: lsize + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a logical +!------------------------------------------------------------------------------- + + lsize = 1 + + call MPI_BCAST(vec,lsize,MPI_LOGICAL,0,comm,ierr) + if (present(string)) then + call shr_mpi_chkerr(ierr,subName//trim(string)) + else + call shr_mpi_chkerr(ierr,subName) + endif + +END SUBROUTINE shr_mpi_bcastl0 + +!=============================================================================== + +!================== Routines from csm_share/shr/shr_file_mod.F90 =============== +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getUnit -- Get a free FORTRAN unit number +! +! !DESCRIPTION: Get the next free FORTRAN unit number. +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! 2007-Oct-21 - P. Worley - dumbed down for use in perf_mod +! +! !INTERFACE: ------------------------------------------------------------------ + +INTEGER FUNCTION shr_file_getUnit () + + implicit none + +!EOP + + !----- local parameters ----- + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + + !----- local variables ----- + integer(SHR_KIND_IN) :: n ! loop index + logical :: opened ! If unit opened or not + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_getUnit) ' + character(*),parameter :: F00 = "('(shr_file_getUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + ! --- Choose first available unit other than 0, 5, or 6 ------ + do n=shr_file_minUnit, shr_file_maxUnit + inquire( n, opened=opened ) + if (n == 5 .or. n == 6 .or. opened) then + cycle + end if + shr_file_getUnit = n + return + end do + + call shr_sys_abort( subName//': Error: no available units found' ) + +END FUNCTION shr_file_getUnit +!=============================================================================== + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_freeUnit -- Free up a FORTRAN unit number +! +! !DESCRIPTION: Free up the given unit number +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! 2007-Oct-21 - P. Worley - dumbed down for use in perf_mod +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_freeUnit ( unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! unit number to be freed + +!EOP + + !----- local parameters ----- + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + + !----- formats ----- + character(*), parameter :: subName = '(shr_file_freeUnit) ' + character(*), parameter :: F00 = "('(shr_file_freeUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (unit < 0 .or. unit > shr_file_maxUnit) then +!pw if (s_loglev > 0) write(pu_logunit,F00) 'invalid unit number request:', unit + else if (unit == 0 .or. unit == 5 .or. unit == 6) then + call shr_sys_abort( subName//': Error: units 0, 5, and 6 must not be freed' ) + end if + + return + +END SUBROUTINE shr_file_freeUnit +!=============================================================================== + +!============= Routines from atm/cam/src/utils/namelist_utils.F90 ============== +!=============================================================================== + +subroutine find_group_name(unit, group, status) + +!--------------------------------------------------------------------------------------- +! Purpose: +! Search a file that contains namelist input for the specified namelist group name. +! Leave the file positioned so that the current record is the first record of the +! input for the specified group. +! +! Method: +! Read the file line by line. Each line is searched for an '&' which may only +! be preceded by blanks, immediately followed by the group name which is case +! insensitive. If found then backspace the file so the current record is the +! one containing the group name and return success. Otherwise return -1. +! +! Author: B. Eaton, August 2007 +!--------------------------------------------------------------------------------------- + + integer, intent(in) :: unit ! fortran unit attached to file + character(len=*), intent(in) :: group ! namelist group name + integer, intent(out) :: status ! 0 for success, -1 if group name not found + + ! Local variables + + integer :: len_grp + integer :: ios ! io status + character(len=80) :: inrec ! first 80 characters of input record + character(len=80) :: inrec2 ! left adjusted input record + character(len=len(group)) :: lc_group + + !--------------------------------------------------------------------------- + + len_grp = len_trim(group) + lc_group = to_lower(group) + + ios = 0 + do while (ios <= 0) + + read(unit, '(a)', iostat=ios, end=102) inrec + + if (ios <= 0) then ! ios < 0 indicates an end of record condition + + ! look for group name in this record + + ! remove leading blanks + inrec2 = to_lower(adjustl(inrec)) + + ! check for leading '&' + if (inrec2(1:1) == '&') then + + ! check for case insensitive group name + if (trim(lc_group) == inrec2(2:len_grp+1)) then + + ! found group name. backspace to leave file position at this record + backspace(unit) + status = 0 + return + + end if + end if + end if + + end do + + 102 continue ! end of file processing + status = -1 + +end subroutine find_group_name +!=============================================================================== + +!================ Routines from atm/cam/src/utils/string_utils.F90 ============= +!=============================================================================== + +function to_lower(str) + +!----------------------------------------------------------------------- +! Purpose: +! Convert character string to lower case. +! +! Method: +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! Author: B. Eaton, July 2001 +! +! $Id$ +!----------------------------------------------------------------------- + implicit none + + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: to_lower + +! Local variables + + integer :: i ! Index + integer :: aseq ! ascii collating sequence + integer :: upper_to_lower ! integer to convert case + character(len=1) :: ctmp ! Character temporary +!----------------------------------------------------------------------- + upper_to_lower = iachar("a") - iachar("A") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + upper_to_lower) + to_lower(i:i) = ctmp + end do + +end function to_lower +!=============================================================================== + +end module perf_utils diff --git a/components/cism/glimmer-cism/utils/libgptl/private.h b/components/cism/glimmer-cism/utils/libgptl/private.h new file mode 100644 index 0000000000..a527f6eb6f --- /dev/null +++ b/components/cism/glimmer-cism/utils/libgptl/private.h @@ -0,0 +1,158 @@ +/* +** $Id: private.h,v 1.74 2011-03-28 20:55:19 rosinski Exp $ +** +** Author: Jim Rosinski +** +** Contains definitions private to GPTL and inaccessible to invoking user environment +*/ + +#include +#include + +#ifndef NO_COMM_F2C +#define HAVE_COMM_F2C +#endif + +#ifndef MIN +#define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) +#endif + +#ifndef MAX +#define MAX(X,Y) ((X) > (Y) ? (X) : (Y)) +#endif + +#define STRMATCH(X,Y) (strcmp((X),(Y)) == 0) + +#define STRNMATCH(X,Y,N) (strncmp((X),(Y),(N)) == 0) + +/* Output counts less than PRTHRESH will be printed as integers */ +#define PRTHRESH 1000000L + +/* Maximum allowed callstack depth */ +#define MAX_STACK 128 + +/* longest timer name allowed (probably safe to just change) */ +#define MAX_CHARS 127 + +/* +** max allowable number of PAPI counters, or derived events. For convenience, +** set to max (# derived events, # papi counters required) so "avail" lists +** all available options. +*/ +#define MAX_AUX 9 + +#ifndef __cplusplus +typedef enum {false = 0, true = 1} bool; /* mimic C++ */ +#endif + +typedef struct { + long last_utime; /* saved usr time from "start" */ + long last_stime; /* saved sys time from "start" */ + long accum_utime; /* accumulator for usr time */ + long accum_stime; /* accumulator for sys time */ +} Cpustats; + +typedef struct { + double last; /* timestamp from last call */ + double accum; /* accumulated time */ + float max; /* longest time for start/stop pair */ + float min; /* shortest time for start/stop pair */ +} Wallstats; + +typedef struct { + long long last[MAX_AUX]; /* array of saved counters from "start" */ + long long accum[MAX_AUX]; /* accumulator for counters */ +} Papistats; + +typedef struct { + int counter; /* PAPI or Derived counter */ + char *namestr; /* PAPI or Derived counter as string */ + char *str8; /* print string for output timers (8 chars) */ + char *str16; /* print string for output timers (16 chars) */ + char *longstr; /* long descriptive print string */ +} Entry; + +typedef struct { + Entry event; + int numidx; /* derived event: PAPI counter array index for numerator */ + int denomidx; /* derived event: PAPI counter array index for denominator */ +} Pr_event; + +typedef struct TIMER { + char name[MAX_CHARS+1]; /* timer name (user input) */ + bool onflg; /* timer currently on or off */ +#ifdef ENABLE_PMPI + double nbytes; /* number of bytes for MPI call */ +#endif +#ifdef HAVE_PAPI + Papistats aux; /* PAPI stats */ +#endif + Wallstats wall; /* wallclock stats */ + Cpustats cpu; /* cpu stats */ + unsigned long count; /* number of start/stop calls */ + unsigned long nrecurse; /* number of recursive start/stop calls */ + void *address; /* address of timer: used only by _instr routines */ + struct TIMER *next; /* next timer in linked list */ + struct TIMER **parent; /* array of parents */ + struct TIMER **children; /* array of children */ + int *parent_count; /* array of call counts, one for each parent */ + unsigned int recurselvl; /* recursion level */ + unsigned int nchildren; /* number of children */ + unsigned int nparent; /* number of parents */ + unsigned int norphan; /* number of times this timer was an orphan */ + int num_desc; /* number of descendants */ +} Timer; + +typedef struct { + Timer **entries; /* array of timers hashed to the same value */ + unsigned int nument; /* number of entries hashed to the same value */ +} Hashentry; + +/* Function prototypes */ + +extern int GPTLerror (const char *, ...); /* print error msg and return */ +extern void GPTLset_abort_on_error (bool val); /* set flag to abort on error */ +extern void *GPTLallocate (const int); /* malloc wrapper */ + +extern int GPTLstart_instr (void *); /* auto-instrumented start */ +extern int GPTLstop_instr (void *); /* auto-instrumented stop */ +extern int GPTLis_initialized (void); /* needed by MPI_Init wrapper */ + +#ifdef __cplusplus +extern "C" { +#endif + +extern void __cyg_profile_func_enter (void *, void *); +extern void __cyg_profile_func_exit (void *, void *); + +#ifdef __cplusplus +}; +#endif + +/* +** These are needed for communication between gptl.c and gptl_papi.c +*/ + +#ifdef HAVE_PAPI +extern int GPTL_PAPIsetoption (const int, const int); +extern int GPTL_PAPIinitialize (const int, const bool, int *, Entry *); +extern int GPTL_PAPIstart (const int, Papistats *); +extern int GPTL_PAPIstop (const int, Papistats *); +extern void GPTL_PAPIprstr (FILE *); +extern void GPTL_PAPIpr (FILE *, const Papistats *, const int, const int, const double); +extern void GPTL_PAPIadd (Papistats *, const Papistats *); +extern void GPTL_PAPIfinalize (int); +extern void GPTL_PAPIquery (const Papistats *, long long *, int); +extern int GPTL_PAPIget_eventvalue (const char *, const Papistats *, double *); +extern bool GPTL_PAPIis_multiplexed (void); +extern void GPTL_PAPIprintenabled (FILE *); +extern void read_counters100 (void); +extern int GPTLget_npapievents (void); +extern int GPTLcreate_and_start_events (const int); +#endif + +#ifdef ENABLE_PMPI +extern Timer *GPTLgetentry (const char *); +extern int GPTLpmpi_setoption (const int, const int); +extern int GPTLpr_has_been_called (void); /* needed by MPI_Finalize wrapper*/ +#endif diff --git a/components/cism/glimmer-cism/utils/parallel_config_eval/README b/components/cism/glimmer-cism/utils/parallel_config_eval/README new file mode 100644 index 0000000000..94ba6b0a43 --- /dev/null +++ b/components/cism/glimmer-cism/utils/parallel_config_eval/README @@ -0,0 +1,2 @@ +This directory includes a Fortran 90 program for evaluating possible decompositions for a CISM grid (dimensions of which are entered manually at run-time). +It must be compiled manually. diff --git a/components/cism/glimmer-cism/utils/parallel_config_eval/parallel_config_eval.F90 b/components/cism/glimmer-cism/utils/parallel_config_eval/parallel_config_eval.F90 new file mode 100644 index 0000000000..d5fede72d3 --- /dev/null +++ b/components/cism/glimmer-cism/utils/parallel_config_eval/parallel_config_eval.F90 @@ -0,0 +1,244 @@ +program parallel_config_eval + implicit none + integer :: ewn, nsn, lhalo, uhalo, l_npe, u_npe, stride_npe + integer :: i, maxsize, maxdiff, config_cnt + + read (5,*) ewn, nsn, lhalo, uhalo, l_npe, u_npe, stride_npe + if (stride_npe < 1) stride_npe = 1 + do i=l_npe,u_npe,stride_npe + write(6,*) + call flush(6) + call distributed_grid(ewn,nsn,lhalo,uhalo,i,maxsize,maxdiff,config_cnt) + if (maxsize > 1) then + write(6,1) ewn,nsn,lhalo,uhalo,i,maxsize,maxdiff,config_cnt + else + write(6,2) ewn,nsn,lhalo,uhalo,i + endif + call flush(6) +1 format("WORKED: Grid: (", I6, ",", I6, ") Halo: (", I2, ",", I2, ") Tasks:", I6, " Max Block Size:", I6, " Max Side Diff:", I2, " Config Cnt:", I2) +2 format("FAILED: Grid: (", I6, ",", I6, ") Halo: (", I2, ",", I2, ") Tasks:", I6) + enddo +end + +!pw subroutine distributed_grid(ewn,nsn) +!pw++ + subroutine distributed_grid(ewn,nsn,lhalo,uhalo,tasks,maxsize,maxdiff,config_cnt) +!pw-- + implicit none + integer :: ewn,nsn + +!pw++ + integer, intent(in) :: lhalo,uhalo,tasks + integer, intent(out) :: maxsize,maxdiff,config_cnt + integer :: global_ewn,global_nsn + integer :: ProcsEW, this_rank + integer :: global_col_offset, global_row_offset + integer :: ewlb, ewub, nslb, nsub + integer :: local_ewn, local_nsn + integer :: own_ewn, own_nsn + integer :: west, east, south, north + integer :: l_ewn(0:tasks-1), l_nsn(0:tasks-1) +!pw-- + + integer :: best,i,j,metric + integer :: ewrank,ewtasks,nsrank,nstasks + real(8) :: rewtasks,rnstasks + + ! begin + + maxsize = 1 + maxdiff = max(ewn,nsn) + global_ewn = ewn + global_nsn = nsn + + ewtasks = 0 + nstasks = 0 + best = huge(best) + do i = 1,min(tasks,global_ewn) + j = tasks/i + if (j<=global_nsn.and.i*j==tasks) then ! try to use all tasks + metric = abs(i*global_nsn-j*global_ewn) ! zero if ewn/nsn == i/j + if (metricthis_rank/ewtasks) east = east-ewtasks + south = this_rank-ewtasks + if (south<0) south = south+tasks + north = this_rank+ewtasks + if (north>=tasks) north = north-tasks + + ! Check that haven't split up the problem too much. Idea is that do not want halos overlapping in either dimension. + ! local_* - lhalo - uhalo is the actual number of non-halo cells on a processor. + if ((local_nsn - lhalo - uhalo) .lt. (lhalo + uhalo + 1)) then +!pw write(*,*) "NS halos overlap on processor ", this_rank +!pw call parallel_stop(__FILE__, __LINE__) +!pw++ +!pw + write(*,*) "FAILED: NS halos overlap (pocessor,own_nsn):", this_rank, own_nsn + return +!pw-- + endif + + if ((local_ewn - lhalo - uhalo) .lt. (lhalo + uhalo + 1)) then +!pw write(*,*) "EW halos overlap on processor ", this_rank +!pw call parallel_stop(__FILE__, __LINE__) +!pw++ + write(*,*) "FAILED: EW halos overlap (processor,own_ewn):", this_rank, own_ewn + return +!pw-- + endif +!pw++ + l_ewn(this_rank) = own_ewn + l_nsn(this_rank) = own_nsn + enddo +!pw-- + + ! Print grid geometry + !write(*,*) "Process ", this_rank, " Total = ", tasks, " ewtasks = ", ewtasks, " nstasks = ", nstasks + !write(*,*) "Process ", this_rank, " ewrank = ", ewrank, " nsrank = ", nsrank + !write(*,*) "Process ", this_rank, " l_ewn = ", local_ewn, " o_ewn = ", own_ewn + !write(*,*) "Process ", this_rank, " l_nsn = ", local_nsn, " o_nsn = ", own_nsn + !write(*,*) "Process ", this_rank, " ewlb = ", ewlb, " ewub = ", ewub + !write(*,*) "Process ", this_rank, " nslb = ", nslb, " nsub = ", nsub + !write(*,*) "Process ", this_rank, " east = ", east, " west = ", west + !write(*,*) "Process ", this_rank, " north = ", north, " south = ", south + !write(*,*) "Process ", this_rank, " ew_vars = ", own_ewn, " ns_vars = ", own_nsn +!pw call distributed_print_grid(own_ewn, own_nsn) +!pw++ + call distributed_print_grid(l_ewn, l_nsn, tasks, maxsize, maxdiff, config_cnt) +!pw-- + end subroutine distributed_grid + +!pw subroutine distributed_print_grid(l_ewn,l_nsn) +!pw++ + subroutine distributed_print_grid(l_ewn,l_nsn,tasks,maxsize,maxdiff,config_cnt) +!pw-- + ! Gathers and prints the overall grid layout by processor counts. + implicit none + +!pw integer :: l_ewn, l_nsn +!pw++ + integer, intent(in) :: l_ewn(0:tasks-1), l_nsn(0:tasks-1) + integer, intent(in) :: tasks + integer, intent(out) :: maxsize, maxdiff, config_cnt +!pw-- + integer :: i,j,curr_count +!pw integer,dimension(2) :: mybounds + integer,dimension(:,:),allocatable :: bounds + + ! begin +!pw mybounds(1) = l_ewn +!pw mybounds(2) = l_nsn + +!pw if (main_task) then + allocate(bounds(2,tasks)) +!pw else +!pw allocate(bounds(1,1)) +!pw end if +!pw call fc_gather_int(mybounds,2,mpi_integer,bounds,2,mpi_integer,main_rank,comm) +!pw++ + do i=1,tasks + bounds(1,i) = l_ewn(i-1) + bounds(2,i) = l_nsn(i-1) + enddo +!pw-- +!pw if (main_task) then + do i = 1,tasks + if (bounds(1,i) .ne. -1) then + ! total up number of processors with matching distribution + curr_count = 1 + do j = i+1,tasks + if ((bounds(1,i) .eq. bounds(1,j)) .and. (bounds(2,i) .eq. bounds(2,j))) then + ! if matching current distribution, increment counter + curr_count = curr_count + 1 + bounds(1,j) = -1 ! mark so not counted later + bounds(2,j) = -1 + endif + enddo + write(*,*) "Layout(EW,NS) = ", bounds(1,i), bounds(2,i), " total procs = ", curr_count + endif + end do +!pw++ + maxsize = 1 + maxdiff = 0 + config_cnt = 0 + do i = 1,tasks + if (bounds(1,i) .ne. -1) then + if (bounds(1,i)*bounds(2,i) > maxsize) then + maxsize = bounds(1,i)*bounds(2,i) + endif + if (abs(bounds(1,i)-bounds(2,i)) > maxdiff) then + maxdiff = abs(bounds(1,i)-bounds(2,i)) + endif + config_cnt = config_cnt + 1 + endif + enddo + return +!pw-- +!pw end if + ! automatic deallocation + end subroutine distributed_print_grid + diff --git a/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/README b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/README new file mode 100644 index 0000000000..db7b4efb74 --- /dev/null +++ b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/README @@ -0,0 +1,5 @@ +This directory holds example do-configure scripts for building Trilinos for use with CISM. +Refer to comments in the scripts and the CISM Documentation for details. +Note that these scripts should NOT be run in the location, but moved to your Trilinos +build location after downloading Trilinos source code from http://trilinos.sandia.gov/. +They are provided as examples with the required Trilinos packages and settings enabled. diff --git a/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-Trilinos-11.10.2-for-Mac-10.9.4 b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-Trilinos-11.10.2-for-Mac-10.9.4 new file mode 100755 index 0000000000..cb66f78863 --- /dev/null +++ b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-Trilinos-11.10.2-for-Mac-10.9.4 @@ -0,0 +1,85 @@ +# This do-configure script is an example for configuring Trilinos 11.10.2 +# on a 'typical' Mac OSX setup. This script is also likely to work for other +# versions of Trilinos, but minor adjustments may be needed. +# See CISM documentation for details of how to obtain, configure, and build +# Trilinos for use with CISM. +# +# Modify these lines below to point to the appropriate places on your system: +# -D CMAKE_INSTALL_PREFIX:PATH=/usr/local/trilinos-11.10.2-Install \ # <-- this is where you want Trilinos to be installed +# /usr/local/trilinos-11.10.2-Source # <-- this is the location of the Trilinos source code (where you unarchived it after downloading it from http://trilinos.sandia.gov/) +# +# Also, you may need to modify your compiler locations and flags. +# The values below will likely work for a 'typical' Mac installation using Macports, +# so if you aren't sure what to use, try the current values first. +# +# This script should be executed from a build directory that is separate +# from the source and install directories, e.g., in this example: +# /usr/local/trilinos-11.10.2-Build +# (Do NOT run it from its present location!) +# The script can be run with "source do-configure-trilinos-11.10.2-mac" +# Then run "make -j 4" (or specify a different number of processors after the -j) +# +# Note that this particular script has been designed to work directly with the current Mac OS X +# build instructions provide in the CISM2.0 documentation (Chapter 2). For example, following +# those instructions, the only information below that should need to be altered are the paths to +# your Trilinos source code and installation directories. + + +rm CMakeCache.txt +rm –rf CMakeFiles + +EXTRA_ARGS=$@ +cmake \ +-D CMAKE_BUILD_TYPE:STRING=RELEASE \ +-D TPL_ENABLE_MPI:STRING=ON \ +\ +-D MPI_BASE_DIR:PATH="/opt/local" \ +-D MPI_BIN_DIR:PATH="/opt/local/bin" \ +-D MPI_C_COMPILER:FILEPATH="/opt/local/bin/mpicc" \ +-D MPI_CXX_COMPILER:FILEPATH="/opt/local/bin/mpicxx" \ +-D MPI_Fortran_COMPILER:FILEPATH="/opt/local/bin/mpif90" \ +-D MPI_EXEC:FILEPATH="/opt/local/bin/mpirun" \ +-D TPL_MPI_INCLUDE_DIRS:PATH="/opt/local/include/mpich-devel-gcc46" \ +\ +-D BUILD_SHARED_LIBS:BOOL=OFF \ +\ +\ +-D Trilinos_ENABLE_ALL_PACKAGES:BOOL=OFF \ +\ + -D Trilinos_ENABLE_Fortran:BOOL=OFF \ + -D Trilinos_ENABLE_Teuchos:BOOL=ON \ + -D Trilinos_ENABLE_Epetra:BOOL=ON \ + -D Trilinos_ENABLE_EpetraExt:BOOL=ON \ + -D Trilinos_ENABLE_Ifpack:BOOL=ON \ + -D Trilinos_ENABLE_AztecOO:BOOL=ON \ + -D Trilinos_ENABLE_Amesos:BOOL=ON \ + -D Trilinos_ENABLE_Anasazi:BOOL=ON \ + -D Trilinos_ENABLE_Belos:BOOL=ON \ + -D Trilinos_ENABLE_ML:BOOL=ON \ + -D Trilinos_ENABLE_NOX:BOOL=ON \ + -D Trilinos_ENABLE_Stratimikos:BOOL=ON \ + -D Trilinos_ENABLE_Thyra:BOOL=ON \ + -D Trilinos_ENABLE_Piro:BOOL=ON \ +\ + -D Belos_ENABLE_TEUCHOS_TIME_MONITOR:BOOL=ON \ + -D Stratimikos_ENABLE_TEUCHOS_TIME_MONITOR:BOOL=ON \ +\ + -D Trilinos_ENABLE_TESTS:BOOL=ON \ + -D Trilinos_ENABLE_EXAMPLES:BOOL=OFF \ + -D Piro_ENABLE_TESTS:BOOL=ON \ + -D Trilinos_VERBOSE_CONFIGURE:BOOL=OFF \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=OFF \ + -D Trilinos_ENABLE_Export_Makefiles:BOOL=ON \ +\ +-D CMAKE_Fortran_FLAGS:STRING="-m64" \ +-D CMAKE_CXX_FLAGS:STRING="-m64" \ +-D CMAKE_C_FLAGS:STRING="-m64" \ +-D CMAKE_INSTALL_PREFIX:PATH=/path/to/your/trilinos-11.10.2-Install \ +\ +\ +-D Trilinos_EXTRA_LINK_FLAGS:STRING="-L/opt/local/lib -L/opt/local/lib/mpich-devel-gcc46 -lmpi -lmpicxx -L/usr/lib -llapack -lblas -lpthread" \ +\ +\ +$EXTRA_ARGS \ +/path/to/your/trilinos-11.10.2-Source + diff --git a/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-trilinos-11.4.3-linux b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-trilinos-11.4.3-linux new file mode 100644 index 0000000000..52baa99441 --- /dev/null +++ b/components/cism/glimmer-cism/utils/trilinos_config_scripts_examples/do-configure-trilinos-11.4.3-linux @@ -0,0 +1,78 @@ +# This do-configure script is an example for configuring Trilinos 11.4.3 +# on a 'typical' Linux setup. This script is also likely to work for other +# versions of Trilinos, but minor adjustments may be needed. +# See CISM documentation for details of how to obtain, configure, and build +# Trilinos for use with CISM. +# +# Modify these lines below to point to the appropriate places on your system: +# -D CMAKE_INSTALL_PREFIX:PATH=/usr/local/trilinos-11.4.3-Install \ # <-- this is where you want Trilinos to be installed +# /usr/local/trilinos-11.4.3-Source # <-- this is the location of the Trilinos source code (where you unarchived it after downloading it from http://trilinos.sandia.gov/) +# +# Also, you may need to modify your compiler locations and flags. +# The values below will likely work for a 'typical' Linux installation, +# so if you aren't sure what to use, try the current values first. +# +# This script should be executed from a build directory that is separate +# from the source and install directories, e.g., in this example: +# /usr/local/trilinos-11.4.3-Build +# (Do NOT run it from its present location!) +# The script can be run with "source do-configure-trilinos-11.4.3-linux" +# Then run "make -j 4" (or specify a different number of processors after the -j) + + + +EXTRA_ARGS=$@ +cmake \ +-D CMAKE_BUILD_TYPE:STRING=RELEASE \ +-D TPL_ENABLE_MPI:STRING=ON \ +\ +-D MPI_BASE_DIR:PATH="/usr" \ +-D MPI_BIN_DIR:PATH="/usr/bin" \ +-D MPI_C_COMPILER:FILEPATH="/usr/bin/mpicc" \ +-D MPI_CXX_COMPILER:FILEPATH="/usr/bin/mpic++" \ +-D MPI_Fortran_COMPILER:FILEPATH="/usr/bin/mpif90" \ +-D MPI_EXEC:FILEPATH="/usr/bin/mpirun" \ +-D TPL_MPI_INCLUDE_DIRS:PATH="/usr/include" \ +\ +-D BUILD_SHARED_LIBS:BOOL=ON \ +\ +\ +-D Trilinos_ENABLE_ALL_PACKAGES:BOOL=OFF \ +\ + -D Trilinos_ENABLE_Teuchos:BOOL=ON \ + -D Trilinos_ENABLE_Epetra:BOOL=ON \ + -D Trilinos_ENABLE_EpetraExt:BOOL=ON \ + -D Trilinos_ENABLE_Ifpack:BOOL=ON \ + -D Trilinos_ENABLE_AztecOO:BOOL=ON \ + -D Trilinos_ENABLE_Amesos:BOOL=ON \ + -D Trilinos_ENABLE_Anasazi:BOOL=ON \ + -D Trilinos_ENABLE_Belos:BOOL=ON \ + -D Trilinos_ENABLE_ML:BOOL=ON \ + -D Trilinos_ENABLE_NOX:BOOL=ON \ + -D Trilinos_ENABLE_Stratimikos:BOOL=ON \ + -D Trilinos_ENABLE_Thyra:BOOL=ON \ + -D Trilinos_ENABLE_Piro:BOOL=ON \ +\ + -D Belos_ENABLE_TEUCHOS_TIME_MONITOR:BOOL=ON \ + -D Stratimikos_ENABLE_TEUCHOS_TIME_MONITOR:BOOL=ON \ +\ + -D Trilinos_ENABLE_TESTS:BOOL=ON \ + -D Trilinos_ENABLE_EXAMPLES:BOOL=OFF \ + -D Piro_ENABLE_TESTS:BOOL=ON \ + -D Trilinos_VERBOSE_CONFIGURE:BOOL=OFF \ + -D CMAKE_VERBOSE_MAKEFILE:BOOL=OFF \ + -D Trilinos_ENABLE_Export_Makefiles:BOOL=ON \ +\ +\ +-D CMAKE_Fortran_FLAGS:STRING="" \ +-D CMAKE_CXX_FLAGS:STRING="" \ +-D CMAKE_C_FLAGS:STRING="" \ +-D CMAKE_INSTALL_PREFIX:PATH=/usr/local/trilinos-11.4.3-Install \ +\ +\ +-D Trilinos_EXTRA_LINK_FLAGS:STRING="-L/usr/lib -lmpi -lmpi_f77 -lmpi_f90 -lmpi_cxx -L/usr/lib -llapack -lblas -lpthread" \ +\ +\ +$EXTRA_ARGS \ +/usr/local/trilinos-11.4.3-Source + diff --git a/components/cism/mpi/README b/components/cism/mpi/README new file mode 100644 index 0000000000..ad4a2323ac --- /dev/null +++ b/components/cism/mpi/README @@ -0,0 +1,6 @@ +These files have been adapted from the mpi communication routines in CICE, +which in turn are based on the communication routines in POP2.0, which +were written by Phil Jones. + +These modules need to be tested further when we run in parallel. + diff --git a/components/cism/mpi/glc_broadcast.F90 b/components/cism/mpi/glc_broadcast.F90 new file mode 100644 index 0000000000..ab3f9c6baf --- /dev/null +++ b/components/cism/mpi/glc_broadcast.F90 @@ -0,0 +1,1029 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_broadcast + +!BOP +! !MODULE: glc_broadcast +! !DESCRIPTION: +! This module contains all the broadcast routines. This +! particular version contains MPI versions of these routines. +! +! !REVISION HISTORY: +! SVN:$Id: ice_broadcast.F90 20 2006-09-01 17:09:49Z $ +! +! author: Phil Jones, LANL +! Adapted from POP version by William Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + use glc_communicate + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: broadcast_scalar, & + broadcast_array + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! generic interfaces for module procedures +! +!----------------------------------------------------------------------- + + interface broadcast_scalar + module procedure broadcast_scalar_dbl, & + broadcast_scalar_real, & + broadcast_scalar_int, & + broadcast_scalar_log, & + broadcast_scalar_char + end interface + + interface broadcast_array + module procedure broadcast_array_dbl_1d, & + broadcast_array_real_1d, & + broadcast_array_int_1d, & + broadcast_array_log_1d, & + broadcast_array_dbl_2d, & + broadcast_array_real_2d, & + broadcast_array_int_2d, & + broadcast_array_log_2d, & + broadcast_array_dbl_3d, & + broadcast_array_real_3d, & + broadcast_array_int_3d, & + broadcast_array_log_3d + end interface + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_dbl +! !INTERFACE: + + subroutine broadcast_scalar_dbl(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar dbl variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + call MPI_BCAST(scalar, 1, MPI_DBL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + +end subroutine broadcast_scalar_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_real +! !INTERFACE: + +subroutine broadcast_scalar_real(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar real variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module +! +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + call MPI_BCAST(scalar, 1, MPI_REAL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_real + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_int +! !INTERFACE: + +subroutine broadcast_scalar_int(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar integer variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + call MPI_BCAST(scalar, 1, MPI_INTEGER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_int + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_log +! !INTERFACE: + +subroutine broadcast_scalar_log(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar logical variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + itmp, &! local temporary + ierr ! MPI error flag + +!----------------------------------------------------------------------- + + if (scalar) then + itmp = 1 + else + itmp = 0 + endif + + call MPI_BCAST(itmp, 1, MPI_INTEGER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + + if (itmp == 1) then + scalar = .true. + else + scalar = .false. + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_log + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_char +! !INTERFACE: + +subroutine broadcast_scalar_char(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar character variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + character (*), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + clength, &! length of character + ierr ! MPI error flag + +!----------------------------------------------------------------------- + + clength = len(scalar) + + call MPI_BCAST(scalar, clength, MPI_CHARACTER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!-------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_char + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_1d +! !INTERFACE: + +subroutine broadcast_array_dbl_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a vector dbl variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_DBL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_1d +! !INTERFACE: + +subroutine broadcast_array_real_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_REAL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_1d +! !INTERFACE: + +subroutine broadcast_array_int_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts an integer vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_1d +! !INTERFACE: + +subroutine broadcast_array_log_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:), allocatable :: & + array_int ! temporary array for MPI bcast + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + allocate(array_int(nelements)) + + where (array) + array_int = 1 + elsewhere + array_int = 0 + end where + + call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, & + MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + + where (array_int == 1) + array = .true. + elsewhere + array = .false. + end where + + deallocate(array_int) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_2d +! !INTERFACE: + + subroutine broadcast_array_dbl_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a dbl 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_DBL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_2d +! !INTERFACE: + + subroutine broadcast_array_real_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_REAL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_2d +! !INTERFACE: + + subroutine broadcast_array_int_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a 2d integer array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_2d +! !INTERFACE: + + subroutine broadcast_array_log_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:), allocatable :: & + array_int ! temporary array for MPI bcast + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + allocate(array_int(size(array,dim=1),size(array,dim=2))) + + where (array) + array_int = 1 + elsewhere + array_int = 0 + end where + + call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, & + MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + + where (array_int == 1) + array = .true. + elsewhere + array = .false. + end where + + deallocate(array_int) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_3d +! !INTERFACE: + + subroutine broadcast_array_dbl_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a double 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_DBL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_3d +! !INTERFACE: + + subroutine broadcast_array_real_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_REAL, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_3d +! !INTERFACE: + + subroutine broadcast_array_int_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts an integer 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + + call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_3d +! !INTERFACE: + + subroutine broadcast_array_log_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), allocatable :: & + array_int ! temporary array for MPI bcast + + integer (int_kind) :: & + nelements, &! size of array to be broadcast + ierr ! local MPI error flag + +!----------------------------------------------------------------------- + + nelements = size(array) + allocate(array_int(size(array,dim=1), & + size(array,dim=2), & + size(array,dim=3))) + + where (array) + array_int = 1 + elsewhere + array_int = 0 + end where + + call MPI_BCAST(array_int, nelements, MPI_INTEGER, root_pe, & + MPI_COMM_GLC, ierr) + call MPI_BARRIER(MPI_COMM_GLC, ierr) + + where (array_int == 1) + array = .true. + elsewhere + array = .false. + end where + + deallocate(array_int) + +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_3d + +!*********************************************************************** + + end module glc_broadcast + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/mpi/glc_communicate.F90 b/components/cism/mpi/glc_communicate.F90 new file mode 100644 index 0000000000..7d33947d85 --- /dev/null +++ b/components/cism/mpi/glc_communicate.F90 @@ -0,0 +1,313 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP + + module glc_communicate + +! !MODULE: glc_communicate +! !DESCRIPTION: +! This module contains the necessary routines and variables for +! communicating between processors. +! +! WJS (11-19-12): some information here is redundant with information in glimmer-cism's +! parallel module - e.g., my_task (redundant with this_rank) and the get_num_procs +! routine. However, I am keeping this redundant information here, looking to the future: +! When we have multiple instances of cism, and/or GIC, all within a single GLC: the +! information here will tell us about the MPI information relative to the whole GLC +! communicator, whereas the information in CISM's parallel module will tell us about the +! MPI information relative to CISM's MPI communicator, which could theoretically be a +! sub-communicator of MPI_COMM_GLC. +! +! !REVISION HISTORY: +! SVN:$Id: ice_communicate.F90 66 2007-05-02 16:52:51Z dbailey $ +! +! author: Phil Jones, LANL +! Oct. 2004: Adapted from POP version by William H. Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + use shr_sys_mod, only : shr_sys_abort + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_communicate, & + exit_message_environment, & + abort_message_environment, & + get_num_procs, & + create_communicator + +! !PUBLIC DATA MEMBERS: + + integer (int_kind), public :: & + MPI_COMM_GLC, &! MPI communicator for glc comms + mpi_dbl, &! MPI type for dbl_kind + my_task, &! MPI task number for this task + master_task ! task number of master task + + integer (int_kind), parameter, public :: & + mpitag_bndy_2d = 1, &! MPI tags for various + mpitag_bndy_3d = 2, &! communication patterns + mpitag_gs = 1000 ! + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_communicate +! !INTERFACE: + + subroutine init_communicate(mpicom) + +! !DESCRIPTION: +! This routine sets up MPI environment and defines glc communicator. +! +! !REVISION HISTORY: +! same as module +! +! !USES: + use parallel, only : parallel_set_info + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: mpicom ! MPI communicator + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + include 'mpif.h' ! MPI Fortran include file + + integer (int_kind) :: ierr ! MPI error flag + +!----------------------------------------------------------------------- +! +! initiate mpi environment and create communicator for internal +! ocean communications +! +!----------------------------------------------------------------------- + + MPI_COMM_GLC = mpicom + master_task = 0 + call MPI_COMM_RANK (MPI_COMM_GLC, my_task, ierr) + + call parallel_set_info(MPI_COMM_GLC, master_task) + +!----------------------------------------------------------------------- +! +! On some 64-bit machines where real_kind and dbl_kind are +! identical, the MPI implementation uses MPI_REAL for both. +! In these cases, set MPI_DBL to MPI_REAL. +! +!----------------------------------------------------------------------- + + MPI_DBL = MPI_DOUBLE_PRECISION + +!----------------------------------------------------------------------- +!EOC + + end subroutine init_communicate + +!*********************************************************************** +!BOP +! !IROUTINE: get_num_procs +! !INTERFACE: + + function get_num_procs() + +! !DESCRIPTION: +! This function returns the number of processor assigned to +! MPI_COMM_GLC +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: get_num_procs + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr + +!----------------------------------------------------------------------- + + call MPI_COMM_SIZE(MPI_COMM_GLC, get_num_procs, ierr) + +!----------------------------------------------------------------------- +!EOC + + end function get_num_procs + +!*********************************************************************** +!BOP +! !IROUTINE: exit_message_environment +! !INTERFACE: + + subroutine exit_message_environment(ierr) + +! !DESCRIPTION: +! This routine exits the message environment properly when model +! stops. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + + return + +!----------------------------------------------------------------------- +!EOC + + end subroutine exit_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: abort_message_environment +! !INTERFACE: + + subroutine abort_message_environment(ierr) + +! !DESCRIPTION: +! This routine aborts the message environment when model stops. +! It will attempt to abort the entire MPI COMM WORLD. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + +! call MPI_BARRIER(MPI_COMM_GLC,ierr) +! ierr = 13 +! call MPI_ABORT(0,ierr) + call shr_sys_abort('glc_communicate.F90: abort_message_environment') + +!----------------------------------------------------------------------- +!EOC + + end subroutine abort_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: create_communicator +! !INTERFACE: + + subroutine create_communicator(new_comm, num_procs) + +! !DESCRIPTION: +! This routine creates a separate communicator for a subset of +! processors under default ocean communicator. +! +! this routine should be called from init_domain1 when the +! domain configuration (e.g. nprocs_btrop) has been determined +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + num_procs ! num of procs in new distribution + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + new_comm ! new communicator for this distribution + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + MPI_GROUP_GLC, &! group of processors assigned to glc + MPI_GROUP_NEW ! group of processors assigned to new dist + + integer (int_kind) :: & + ierr ! error flag for MPI comms + + integer (int_kind), dimension(3) :: & + range ! range of tasks assigned to new dist + ! (assumed 0,num_procs-1) + +!----------------------------------------------------------------------- +! +! determine group of processes assigned to distribution +! +!----------------------------------------------------------------------- + + call MPI_COMM_GROUP (MPI_COMM_GLC, MPI_GROUP_GLC, ierr) + + range(1) = 0 + range(2) = num_procs-1 + range(3) = 1 + +!----------------------------------------------------------------------- +! +! create subroup and communicator for new distribution +! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_GLC +! +!----------------------------------------------------------------------- + + call MPI_GROUP_RANGE_INCL(MPI_GROUP_GLC, 1, range, & + MPI_GROUP_NEW, ierr) + + call MPI_COMM_CREATE (MPI_COMM_GLC, MPI_GROUP_NEW, & + new_comm, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine create_communicator + +!*********************************************************************** + + end module glc_communicate + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/mpi/glc_communicate.F90.original b/components/cism/mpi/glc_communicate.F90.original new file mode 100644 index 0000000000..3cf160e539 --- /dev/null +++ b/components/cism/mpi/glc_communicate.F90.original @@ -0,0 +1,538 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP + + module glc_communicate + +! !MODULE: glc_communicate +! !DESCRIPTION: +! This module contains the necessary routines and variables for +! communicating between processors. +! +! !REVISION HISTORY: +! SVN:$Id: ice_communicate.F90 66 2007-05-02 16:52:51Z dbailey $ +! +! author: Phil Jones, LANL +! Oct. 2004: Adapted from POP version by William H. Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod +#if (defined CCSM) || (defined SEQ_MCT) + use cpl_interface_mod, only : cpl_interface_init + use cpl_fields_mod, only : cpl_fields_icename +#endif + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_communicate, & + exit_message_environment, & + abort_message_environment, & + get_num_procs, & + create_communicator + +! !PUBLIC DATA MEMBERS: + + integer (int_kind), public :: & + MPI_COMM_GLC, &! MPI communicator for glc comms + mpi_dbl, &! MPI type for dbl_kind + my_task, &! MPI task number for this task + master_task ! task number of master task + + integer (int_kind), parameter, public :: & + mpitag_bndy_2d = 1, &! MPI tags for various + mpitag_bndy_3d = 2, &! communication patterns + mpitag_gs = 1000 ! + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_communicate +! !INTERFACE: + + subroutine init_communicate + +! !DESCRIPTION: +! This routine sets up MPI environment and defines glc communicator. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + include 'mpif.h' ! MPI Fortran include file + + integer (int_kind) :: ierr ! MPI error flag + +!----------------------------------------------------------------------- +! +! initiate mpi environment and create communicator for internal +! ocean communications +! +!----------------------------------------------------------------------- + +#if (defined CCSM) || (defined SEQ_MCT) + + ! CCSM standard coupled mode + call cpl_interface_init(cpl_fields_glcname, MPI_COMM_GLC) + +#else + call MPI_INIT(ierr) + call create_glc_communicator + +#endif + + master_task = 0 + call MPI_COMM_RANK (MPI_COMM_GLC, my_task, ierr) + +!----------------------------------------------------------------------- +! +! On some 64-bit machines where real_kind and dbl_kind are +! identical, the MPI implementation uses MPI_REAL for both. +! In these cases, set MPI_DBL to MPI_REAL. +! +!----------------------------------------------------------------------- + + MPI_DBL = MPI_DOUBLE_PRECISION + +!----------------------------------------------------------------------- +!EOC + + end subroutine init_communicate + +!*********************************************************************** +!BOP +! !IROUTINE: get_num_procs +! !INTERFACE: + + function get_num_procs() + +! !DESCRIPTION: +! This function returns the number of processor assigned to +! MPI_COMM_GLC +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: get_num_procs + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr + +!----------------------------------------------------------------------- + + call MPI_COMM_SIZE(MPI_COMM_GLC, get_num_procs, ierr) + +!----------------------------------------------------------------------- +!EOC + + end function get_num_procs + +!*********************************************************************** +!BOP +! !IROUTINE: exit_message_environment +! !INTERFACE: + + subroutine exit_message_environment(ierr) + +! !DESCRIPTION: +! This routine exits the message environment properly when model +! stops. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + +#ifdef coupled + call cpl_interface_finalize(cpl_fields_ocnname) +#else + call MPI_FINALIZE(ierr) +#endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine exit_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: abort_message_environment +! !INTERFACE: + + subroutine abort_message_environment(ierr) + +! !DESCRIPTION: +! This routine aborts the message environment when model stops. +! It will attempt to abort the entire MPI COMM WORLD. +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + +#ifdef coupled + call MPI_BARRIER(MPI_COMM_GLC,ierr) + ierr = 13 + call MPI_ABORT(0,ierr) + call cpl_interface_finalize(cpl_fields_ocnname) +#else + call MPI_BARRIER(MPI_COMM_GLC, ierr) + call MPI_ABORT(MPI_COMM_WORLD, ierr) + call MPI_FINALIZE(ierr) +#endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine abort_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: create_glc_communicator +! !INTERFACE: + + subroutine create_glc_communicator + +! !DESCRIPTION: +! This routine queries all the tasks in MPI_COMM_WORLD to see +! which belong to the land ice (glc). In standalone mode, this should +! be all tasks, but in coupled mode we need to determine +! which tasks are assigned to the land ice component. +! +! this routine should be called after mpi_init, but before +! setting up any internal mpi setups (since these will require +! the internal communicators returned by this routine) +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (3) :: cmodel ! model name temporary + + integer (int_kind) :: & + MPI_GROUP_WORLD, &! group id for MPI_COMM_WORLD + MPI_GROUP_ATM, &! group of processors assigned to atm + MPI_GROUP_OCN, &! group of processors assigned to ocn + MPI_GROUP_ICE, &! group of processors assigned to ice + MPI_GROUP_LND, &! group of processors assigned to lnd + MPI_GROUP_GLC, &! group of processors assigned to glc + MPI_GROUP_CPL, &! group of processors assigned to cpl + MPI_COMM_ATM, &! group of processors assigned to atm + MPI_COMM_OCN, &! group of processors assigned to ocn + MPI_COMM_LND, &! group of processors assigned to lnd + MPI_COMM_ICE, &! group of processors assigned to ice + MPI_COMM_CPL ! group of processors assigned to cpl + + integer (int_kind) :: & + n, &! dummy loop counter + ierr, &! error flag for MPI comms + nprocs_all, &! total processor count + my_task_all, &! rank of process in coupled domain + ntasks_atm, &! num tasks assigned to atm + ntasks_ocn, &! num tasks assigned to ocn + ntasks_ice, &! num tasks assigned to ice + ntasks_lnd, &! num tasks assigned to lnd + ntasks_glc, &! num tasks assigned to glc + ntasks_cpl ! num tasks assigned to cpl + + integer (int_kind), dimension(3) :: & + range_ocn, &! range of tasks assigned to ocn + range_atm, &! range of tasks assigned to atm + range_ice, &! range of tasks assigned to ice + range_lnd, &! range of tasks assigned to lnd + range_glc, &! range of tasks assigned to glc + range_cpl ! range of tasks assigned to cpl + +!----------------------------------------------------------------------- +! +! determine processor rank in full (coupled) domain +! +!----------------------------------------------------------------------- + + call MPI_COMM_RANK (MPI_COMM_WORLD, my_task_all, ierr) + +!----------------------------------------------------------------------- +! +! determine which group of processes assigned to each model +! assume the first processor assigned to a model is the task that +! will communicate coupled model messages +! +!----------------------------------------------------------------------- + + call MPI_COMM_SIZE (MPI_COMM_WORLD, nprocs_all, ierr) + + ntasks_atm = 0 + ntasks_ocn = 0 + ntasks_ice = 0 + ntasks_lnd = 0 + ntasks_glc = 0 + ntasks_cpl = 0 + range_ocn(1) = nprocs_all + range_atm(1) = nprocs_all + range_ice(1) = nprocs_all + range_lnd(1) = nprocs_all + range_glc(1) = nprocs_all + range_cpl(1) = nprocs_all + range_ocn(2) = 0 + range_atm(2) = 0 + range_ice(2) = 0 + range_lnd(2) = 0 + range_glc(2) = 0 + range_cpl(2) = 0 + range_ocn(3) = 1 + range_atm(3) = 1 + range_ice(3) = 1 + range_lnd(3) = 1 + range_glc(3) = 1 + range_cpl(3) = 1 + + !*** + !*** each processor broadcasts its model to all the processors + !*** in the coupled domain + !*** + + do n=0,nprocs_all-1 + if (n == my_task_all) then + cmodel = 'glc' + else + cmodel = 'unk' + endif + + call MPI_BCAST(cmodel, 3, MPI_CHARACTER, n, MPI_COMM_WORLD, ierr) + + select case(cmodel) + case ('ocn') + ntasks_ocn = ntasks_ocn + 1 + range_ocn(1) = min(n,range_ocn(1)) + range_ocn(2) = max(n,range_ocn(2)) + case ('atm') + ntasks_atm = ntasks_atm + 1 + range_atm(1) = min(n,range_atm(1)) + range_atm(2) = max(n,range_atm(2)) + case ('ice') + ntasks_ice = ntasks_ice + 1 + range_ice(1) = min(n,range_ice(1)) + range_ice(2) = max(n,range_ice(2)) + case ('lnd') + ntasks_lnd = ntasks_lnd + 1 + range_lnd(1) = min(n,range_lnd(1)) + range_lnd(2) = max(n,range_lnd(2)) + case ('glc') + ntasks_glc = ntasks_glc + 1 + range_glc(1) = min(n,range_glc(1)) + range_glc(2) = max(n,range_glc(2)) + case ('cpl') + ntasks_cpl = ntasks_cpl + 1 + range_cpl(1) = min(n,range_cpl(1)) + range_cpl(2) = max(n,range_cpl(2)) + case default + stop 'Unknown model name in comm setup' + end select + + end do + +!----------------------------------------------------------------------- +! +! create subroup and communicator for each models internal +! communciations, note that MPI_COMM_CREATE must be called by +! all processes in MPI_COMM_WORLD so this must be done by all +! models consistently and in the same order. +! +!----------------------------------------------------------------------- + + call MPI_COMM_GROUP(MPI_COMM_WORLD, MPI_GROUP_WORLD, ierr) + + if (ntasks_atm > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_atm, & + MPI_GROUP_ATM, ierr) + + if (ntasks_ocn > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_ocn, & + MPI_GROUP_OCN, ierr) + + if (ntasks_ice > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_ice, & + MPI_GROUP_ICE, ierr) + + if (ntasks_lnd > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_lnd, & + MPI_GROUP_LND, ierr) + + if (ntasks_glc > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_glc, & + MPI_GROUP_GLC, ierr) + + if (ntasks_cpl > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_cpl, & + MPI_GROUP_CPL, ierr) + + if (ntasks_atm > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_ATM, & + MPI_COMM_ATM, ierr) + + if (ntasks_ocn > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_OCN, & + MPI_COMM_OCN, ierr) + + if (ntasks_ice > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_ICE, & + MPI_COMM_ICE, ierr) + + if (ntasks_lnd > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_LND, & + MPI_COMM_LND, ierr) + + if (ntasks_glc > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_GLC, & + MPI_COMM_GLC, ierr) + + if (ntasks_cpl > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_CPL, & + MPI_COMM_CPL, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine create_glc_communicator + +!*********************************************************************** +!BOP +! !IROUTINE: create_communicator +! !INTERFACE: + + subroutine create_communicator(new_comm, num_procs) + +! !DESCRIPTION: +! This routine creates a separate communicator for a subset of +! processors under default ocean communicator. +! +! this routine should be called from init_domain1 when the +! domain configuration (e.g. nprocs_btrop) has been determined +! +! !REVISION HISTORY: +! same as module + +! !INCLUDES: + + include 'mpif.h' + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + num_procs ! num of procs in new distribution + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + new_comm ! new communicator for this distribution + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + MPI_GROUP_GLC, &! group of processors assigned to glc + MPI_GROUP_NEW ! group of processors assigned to new dist + + integer (int_kind) :: & + ierr ! error flag for MPI comms + + integer (int_kind), dimension(3) :: & + range ! range of tasks assigned to new dist + ! (assumed 0,num_procs-1) + +!----------------------------------------------------------------------- +! +! determine group of processes assigned to distribution +! +!----------------------------------------------------------------------- + + call MPI_COMM_GROUP (MPI_COMM_GLC, MPI_GROUP_GLC, ierr) + + range(1) = 0 + range(2) = num_procs-1 + range(3) = 1 + +!----------------------------------------------------------------------- +! +! create subroup and communicator for new distribution +! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_GLC +! +!----------------------------------------------------------------------- + + call MPI_GROUP_RANGE_INCL(MPI_GROUP_GLC, 1, range, & + MPI_GROUP_NEW, ierr) + + call MPI_COMM_CREATE (MPI_COMM_GLC, MPI_GROUP_NEW, & + new_comm, ierr) + +!----------------------------------------------------------------------- +!EOC + + end subroutine create_communicator + +!*********************************************************************** + + end module glc_communicate + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/README b/components/cism/serial/README new file mode 100644 index 0000000000..0bbaf7416c --- /dev/null +++ b/components/cism/serial/README @@ -0,0 +1,6 @@ +These files have been adapted from the serial communication routines in CICE, +which in turn are based on the communication routines in POP2.0, which +were written by Phil Jones. + +These modules need to be tested further when we run in parallel. + diff --git a/components/cism/serial/glc_boundary.F90 b/components/cism/serial/glc_boundary.F90 new file mode 100644 index 0000000000..ff6ebf2eb1 --- /dev/null +++ b/components/cism/serial/glc_boundary.F90 @@ -0,0 +1,2285 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! !MODULE: glc_boundary + + module glc_boundary + +! !DESCRIPTION: +! This module contains data types and routines for updating ghost cell +! boundaries using MPI calls +! +! !REVISION HISTORY: +! +! author: Phil Jones, LANL +! Oct. 2004: Adapted from POP version by William Lipscomb, LANL +! (1) Modified create_boundary so that ghost cell updates can be +! neglected for N, S, E, and/or W boundaries. +! (2) Modified boundary_2d_dbl and boundary_3d_dbl to allow blocks +! to have no EW and/or NS communications with other blocks. +! (3) Minor changes for consistency with CICE +! +! Feb. 2007: debugged by Elizabeth Hunke. Numerous changes included +! removing destroy_boundary and the NE/SW boundary types, debugging +! the tripole grid apparatus, and reworking the Neumann boundary +! conditions. + +! !USES: + + use glc_kinds_mod + use glc_communicate + use glc_constants + use glc_blocks + use glc_distribution + use glc_exit_mod + + implicit none + private + save + +! !PUBLIC TYPES: + + type, public :: bndy + integer (int_kind) :: & + communicator ,&! communicator to use for update messages + nlocal_ew ,&! num local copies for east-west bndy update + nlocal_ns ! num local copies for east-west bndy update + + integer (int_kind), dimension(:), pointer :: & + local_ew_src_block ,&! source block for each local east-west copy + local_ew_dst_block ,&! dest block for each local east-west copy + local_ns_src_block ,&! source block for each local north-south copy + local_ns_dst_block ! dest block for each local north-south copy + + integer (int_kind), dimension(:,:), pointer :: & + local_ew_src_add ,&! starting source address for local e-w copies + local_ew_dst_add ,&! starting dest address for local e-w copies + local_ns_src_add ,&! starting source address for local n-s copies + local_ns_dst_add ! starting dest address for local n-s copies + + end type bndy + +! !PUBLIC MEMBER FUNCTIONS: + + public :: create_boundary, & + destroy_boundary, & + update_ghost_cells + + interface update_ghost_cells ! generic interface + module procedure boundary_2d_dbl, & + boundary_2d_real, & + boundary_2d_int, & + boundary_3d_dbl, & + boundary_3d_real, & + boundary_3d_int, & + boundary_4d_dbl, & + boundary_4d_real, & + boundary_4d_int + end interface + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! global boundary buffers for tripole boundary +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:), allocatable :: & + tripole_ibuf, & + tripole_ighost + + real (r4), dimension(:,:), allocatable :: & + tripole_rbuf, & + tripole_rghost + + real (r8), dimension(:,:), allocatable :: & + tripole_dbuf, & + tripole_dghost + + real (r8), dimension(:,:,:), allocatable :: & + tripole_dbuf_3d, & + tripole_dghost_3d + + integer (int_kind) :: & + index_check + +!EOC +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: create_boundary +! !INTERFACE: + + subroutine create_boundary(newbndy, dist, & + ns_bndy_type, ew_bndy_type, & + nx_global, ny_global, & + l_north, l_south, & + l_east, l_west) + +! !DESCRIPTION: +! This routine creates a boundary type with info necessary for +! performing a boundary (ghost cell) update based on the input block +! distribution. +! +! !REVISION HISTORY: +! same as module +! +! Modified Sept. 2004 by William Lipscomb: +! Added optional arguments so that ghost cell updates can be +! limited to fewer than four boundaries; this reduces the +! cost of boundary updates in the EVP dynamics. + +! !INPUT PARAMETERS: + + type (distrb), intent(in) :: & + dist ! distribution of blocks across procs + + character (*), intent(in) :: & + ns_bndy_type, &! type of boundary to use in ns dir + ew_bndy_type ! type of boundary to use in ew dir + + integer (int_kind), intent(in) :: & + nx_global, ny_global ! global extents of domain + + logical (log_kind), intent(in), optional :: & + l_north, l_south ,&! true if N and S ghost cells updated + l_east, l_west ! true if E and W ghost cells updated + +! !OUTPUT PARAMETERS: + + type (bndy), intent(out) :: & + newbndy ! a new boundary type with info for updates + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,n, &! dummy counters + iblock_src , jblock_src , &! i,j index of source block + iblock_dst , jblock_dst , &! i,j index of dest block + iblock_north, jblock_north, &! i,j index of north neighbor block + iblock_south, jblock_south, &! i,j index of south neighbor block + iblock_east , jblock_east , &! i,j index of east neighbor block + iblock_west , jblock_west , &! i,j index of west neighbor block + src_block_loc, &! local block location of source + dst_block_loc, &! local block location of dest + nprocs, &! num of processors involved + nblocks, &! total number of blocks + iloc_ew, iloc_ns, &! + src_proc, dst_proc ! src,dst processor for message + + logical (log_kind) :: & + lalloc_tripole ! flag for allocating tripole buffers + + type (block) :: & + src_block, &! block info for source block + dst_block ! block info for destination block + + logical (log_kind) :: & + go_north, go_south ,&! true if messages passed to N and S + go_east, go_west ! true if messages passed to E and W + +!----------------------------------------------------------------------- +! +! Initialize some useful variables and return if this task not +! in the current distribution. +! +!----------------------------------------------------------------------- + + nprocs = dist%nprocs + + if (my_task >= nprocs) return + + nblocks = size(dist%proc(:)) + lalloc_tripole = .false. + newbndy%communicator = dist%communicator + +!----------------------------------------------------------------------- +! Set logical variables that determine directions to pass messages. +! Default is to pass messages in all directions. +! Note sign convention. If l_east is false, that means we do not +! update ghost cells along the east boundary of blocks, which means +! we do not pass messages from east to west, which means go_west +! is false. +!----------------------------------------------------------------------- + + go_west = .true. + if (present(l_east)) then + if (.not.l_east) go_west = .false. + endif + + go_east = .true. + if (present(l_west)) then + if (.not.l_west) go_east = .false. + endif + + go_north = .true. + if (present(l_south)) then + if (.not.l_south) go_north = .false. + endif + + go_south = .true. + if (present(l_north)) then + if (.not.l_north) go_south = .false. + endif + +!----------------------------------------------------------------------- +! +! Count the number of messages to send/recv from each processor +! and number of blocks in each message. These quantities are +! necessary for allocating future arrays. +! +!----------------------------------------------------------------------- + iloc_ew = 0 + iloc_ns = 0 + + block_loop1: do n=1,nblocks + src_proc = dist%proc(n) + src_block = get_block(n,n) + + iblock_src = src_block%iblock ! i,j index of this block in + jblock_src = src_block%jblock ! block cartesian decomposition + + !*** compute cartesian i,j block indices for each neighbor + !*** use zero if off the end of closed boundary + !*** use jnorth=nblocks_y and inorth < 0 for tripole boundary + !*** to make sure top boundary communicated to all top + !*** boundary blocks + + select case(ew_bndy_type) + case ('cyclic') + iblock_east = mod(iblock_src,nblocks_x) + 1 + iblock_west = iblock_src - 1 + if (iblock_west == 0) iblock_west = nblocks_x + jblock_east = jblock_src + jblock_west = jblock_src + case ('closed') + iblock_east = iblock_src + 1 + iblock_west = iblock_src - 1 + if (iblock_east > nblocks_x) iblock_east = 0 + if (iblock_west < 1 ) iblock_west = 0 + jblock_east = jblock_src + jblock_west = jblock_src + case default + call exit_glc(sigAbort, 'Unknown east-west boundary type') + end select + + select case(ns_bndy_type) + case ('cyclic') + jblock_north = mod(jblock_src,nblocks_y) + 1 + jblock_south = jblock_src - 1 + if (jblock_south == 0) jblock_south = nblocks_y + iblock_north = iblock_src + iblock_south = iblock_src + case ('closed') + jblock_north = jblock_src + 1 + jblock_south = jblock_src - 1 + if (jblock_north > nblocks_y) jblock_north = 0 + if (jblock_south < 1 ) jblock_south = 0 + iblock_north = iblock_src + iblock_south = iblock_src + case ('tripole') + lalloc_tripole = .true. + jblock_north = jblock_src + 1 + jblock_south = jblock_src - 1 + iblock_north = iblock_src + iblock_south = iblock_src + if (jblock_south < 1 ) jblock_south = 0 + if (jblock_north > nblocks_y) then + jblock_north = nblocks_y + iblock_north = -iblock_src + endif + case default + call exit_glc(sigAbort, 'Unknown north-south boundary type') + end select + + !*** + !*** if any neighbors are closed boundaries, must + !*** create a local pseudo-message to zero ghost cells + !*** + + if (src_proc /= 0) then + if (iblock_east == 0) iloc_ew = iloc_ew + 1 + if (iblock_west == 0) iloc_ew = iloc_ew + 1 + if (jblock_north == 0) iloc_ns = iloc_ns + 1 + if (jblock_south == 0) iloc_ns = iloc_ns + 1 + endif + + !*** + !*** now look through all the blocks for the neighbors + !*** of the source block and check whether a message is + !*** required for communicating with the neighbor + !*** + + do k=1,nblocks + dst_block = get_block(k,k) + + iblock_dst = dst_block%iblock !*** i,j block index of + jblock_dst = dst_block%jblock !*** potential neighbor block + + dst_proc = dist%proc(k) ! processor that holds dst block + + !*** + !*** if this block is an eastern neighbor + !*** increment message counter + !*** + + if (iblock_dst == iblock_east .and. & + jblock_dst == jblock_east) then + + if (dst_proc/= 0) then + iloc_ew = iloc_ew + 1 + endif + + endif + + !*** + !*** if this block is an western neighbor + !*** increment message counter + !*** + + if (iblock_dst == iblock_west .and. & + jblock_dst == jblock_west) then + + if (dst_proc/= 0) then + iloc_ew = iloc_ew + 1 + endif + + endif + + !*** + !*** if this block is an northern neighbor + !*** find out whether a message is required + !*** for tripole, must communicate with all + !*** north row blocks (triggered by iblock_dst <0) + !*** + + if ((iblock_dst == iblock_north .or. iblock_north < 0) .and. & + jblock_dst == jblock_north) then + + if (dst_proc/= 0) then + iloc_ns = iloc_ns + 1 + endif + + endif + + !*** + !*** if this block is an southern neighbor + !*** find out whether a message is required + !*** + + if (iblock_dst == iblock_south .and. & + jblock_dst == jblock_south) then + + if (dst_proc/= 0) then + iloc_ns = iloc_ns + 1 + endif + + endif + + end do ! search for dest blocks + end do block_loop1 + + !*** + !*** in this serial version, all messages are local copies + !*** + + newbndy%nlocal_ew = iloc_ew + newbndy%nlocal_ns = iloc_ns + +!----------------------------------------------------------------------- +! +! allocate buffers and arrays necessary for boundary comms +! +!----------------------------------------------------------------------- + + allocate (newbndy%local_ew_src_block(newbndy%nlocal_ew), & + newbndy%local_ew_dst_block(newbndy%nlocal_ew), & + newbndy%local_ns_src_block(newbndy%nlocal_ns), & + newbndy%local_ns_dst_block(newbndy%nlocal_ns), & + newbndy%local_ew_src_add(2,newbndy%nlocal_ew), & + newbndy%local_ew_dst_add(2,newbndy%nlocal_ew), & + newbndy%local_ns_src_add(2,newbndy%nlocal_ns), & + newbndy%local_ns_dst_add(2,newbndy%nlocal_ns)) + + newbndy%local_ew_src_block = 0 + newbndy%local_ew_dst_block = 0 + newbndy%local_ns_src_block = 0 + newbndy%local_ns_dst_block = 0 + newbndy%local_ew_src_add = 0 + newbndy%local_ew_dst_add = 0 + newbndy%local_ns_src_add = 0 + newbndy%local_ns_dst_add = 0 + +!----------------------------------------------------------------------- +! +! now set up indices into buffers and address arrays +! +!----------------------------------------------------------------------- + + iloc_ew = 0 + iloc_ns = 0 + +!----------------------------------------------------------------------- +! +! repeat loop through blocks but this time, determine all the +! required message information for each message or local copy +! +!----------------------------------------------------------------------- + + block_loop2: do n=1,nblocks + + src_proc = dist%proc(n) ! processor location for this block + src_block = get_block(n,n) ! block info for this block + + iblock_src = src_block%iblock ! i,j index of this block in + jblock_src = src_block%jblock ! block cartesian decomposition + + if (src_proc /= 0) then + src_block_loc = dist%local_block(n) ! local block location + else + src_block_loc = 0 ! block is a land block + endif + + !*** compute cartesian i,j block indices for each neighbor + !*** use zero if off the end of closed boundary + !*** use jnorth=nblocks_y and inorth < 0 for tripole boundary + !*** to make sure top boundary communicated to all top + !*** boundary blocks + + select case(ew_bndy_type) + case ('cyclic') + iblock_east = mod(iblock_src,nblocks_x) + 1 + iblock_west = iblock_src - 1 + if (iblock_west == 0) iblock_west = nblocks_x + jblock_east = jblock_src + jblock_west = jblock_src + case ('closed') + iblock_east = iblock_src + 1 + iblock_west = iblock_src - 1 + if (iblock_east > nblocks_x) iblock_east = 0 + if (iblock_west < 1 ) iblock_west = 0 + jblock_east = jblock_src + jblock_west = jblock_src + case default + call exit_glc(sigAbort, 'Unknown east-west boundary type') + end select + + select case(ns_bndy_type) + case ('cyclic') + jblock_north = mod(jblock_src,nblocks_y) + 1 + jblock_south = jblock_src - 1 + if (jblock_south == 0) jblock_south = nblocks_y + iblock_north = iblock_src + iblock_south = iblock_src + case ('closed') + jblock_north = jblock_src + 1 + jblock_south = jblock_src - 1 + if (jblock_north > nblocks_y) jblock_north = 0 + if (jblock_south < 1 ) jblock_south = 0 + iblock_north = iblock_src + iblock_south = iblock_src + case ('tripole') + jblock_north = jblock_src + 1 + jblock_south = jblock_src - 1 + iblock_north = iblock_src + iblock_south = iblock_src + if (jblock_south < 1 ) jblock_south = 0 + if (jblock_north > nblocks_y) then + jblock_north = nblocks_y + iblock_north = -iblock_src + endif + case default + call exit_glc(sigAbort, 'Unknown north-south boundary type') + end select + + !*** + !*** if any boundaries are closed boundaries, set up + !*** pseudo-message to zero ghost cells + !*** + + if (src_block_loc /= 0) then + + if (iblock_east == 0 .or. .not.go_west) then + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = 0 + newbndy%local_ew_src_add(1,iloc_ew) = 0 + newbndy%local_ew_src_add(2,iloc_ew) = 0 + newbndy%local_ew_dst_block(iloc_ew) = src_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = src_block%ihi + 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + endif + + if (iblock_west == 0 .or. .not.go_east) then + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = 0 + newbndy%local_ew_src_add(1,iloc_ew) = 0 + newbndy%local_ew_src_add(2,iloc_ew) = 0 + newbndy%local_ew_dst_block(iloc_ew) = src_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + endif + + if (jblock_north == 0 .or. .not.go_south) then + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = 0 + newbndy%local_ns_src_add(1,iloc_ns) = 0 + newbndy%local_ns_src_add(2,iloc_ns) = 0 + newbndy%local_ns_dst_block(iloc_ns) = src_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = src_block%jhi + 1 + endif + + if (jblock_south == 0 .or. .not.go_north) then + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = 0 + newbndy%local_ns_src_add(1,iloc_ns) = 0 + newbndy%local_ns_src_add(2,iloc_ns) = 0 + newbndy%local_ns_dst_block(iloc_ns) = src_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = 1 + endif + + endif + + !*** + !*** now search through blocks looking for neighbors to + !*** the source block + !*** + + do k=1,nblocks + + dst_proc = dist%proc(k) ! processor holding dst block + + !*** + !*** compute the rest only if this block is not a land block + !*** + + if (dst_proc /= 0) then + + dst_block = get_block(k,k) ! block info for this block + + iblock_dst = dst_block%iblock ! i,j block index in + jblock_dst = dst_block%jblock ! Cartesian block decomposition + + dst_block_loc = dist%local_block(k) ! local block location + + !*** + !*** if this block is an eastern neighbor + !*** determine send/receive addresses + !*** + + if (iblock_dst == iblock_east .and. & + jblock_dst == jblock_east .and. go_east) then + + if (src_proc /= 0) then + !*** local copy from one block to another + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = src_block_loc + newbndy%local_ew_src_add(1,iloc_ew) = src_block%ihi - & + nghost + 1 + newbndy%local_ew_src_add(2,iloc_ew) = 1 + newbndy%local_ew_dst_block(iloc_ew) = dst_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + else + !*** source block is all land so treat as local copy + !*** with source block zero to fill ghost cells with + !*** zeroes + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = 0 + newbndy%local_ew_src_add(1,iloc_ew) = 0 + newbndy%local_ew_src_add(2,iloc_ew) = 0 + newbndy%local_ew_dst_block(iloc_ew) = dst_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + endif + + endif ! east neighbor + + !*** + !*** if this block is a western neighbor + !*** determine send/receive addresses + !*** + + if (iblock_dst == iblock_west .and. & + jblock_dst == jblock_west .and. go_west) then + + if (src_proc /= 0) then + !*** perform a local copy + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = src_block_loc + newbndy%local_ew_src_add(1,iloc_ew) = nghost + 1 + newbndy%local_ew_src_add(2,iloc_ew) = 1 + newbndy%local_ew_dst_block(iloc_ew) = dst_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = dst_block%ihi + 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + else + !*** neighbor is a land block so zero ghost cells + iloc_ew = iloc_ew + 1 + newbndy%local_ew_src_block(iloc_ew) = 0 + newbndy%local_ew_src_add(1,iloc_ew) = 0 + newbndy%local_ew_src_add(2,iloc_ew) = 0 + newbndy%local_ew_dst_block(iloc_ew) = dst_block_loc + newbndy%local_ew_dst_add(1,iloc_ew) = dst_block%ihi + 1 + newbndy%local_ew_dst_add(2,iloc_ew) = 1 + endif + + endif ! west neighbor + + !*** + !*** if this block is a northern neighbor + !*** compute send/recv addresses + !*** for tripole, must communicate with all + !*** north row blocks (triggered by iblock_north <0) + !*** + + if ((iblock_dst == iblock_north .or. iblock_north < 0) .and. & + jblock_dst == jblock_north .and. go_north) then + + if (src_proc /= 0) then + !*** local copy + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = src_block_loc + newbndy%local_ns_src_add(1,iloc_ns) = 1 + newbndy%local_ns_src_add(2,iloc_ns) = src_block%jhi - & + nghost + 1 + newbndy%local_ns_dst_block(iloc_ns) = dst_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = 1 + + if (iblock_north < 0) then !*** tripole boundary + + newbndy%local_ns_dst_block(iloc_ns) = -dst_block_loc + !*** copy nghost+1 northern rows of physical + !*** domain into global north tripole buffer + newbndy%local_ns_src_add(1,iloc_ns) = & + src_block%i_glob(nghost+1) + newbndy%local_ns_src_add(2,iloc_ns) = & + dst_block%jhi - nghost + + !*** copy out of tripole ghost cell buffer + !*** over-write the last row of the destination + !*** block to enforce for symmetry for fields + !*** located on domain boundary + newbndy%local_ns_dst_add(1,iloc_ns) = & + dst_block%i_glob(nghost+1) + newbndy%local_ns_dst_add(2,iloc_ns) = & + dst_block%jhi + endif + else + !*** source is land block so zero ghost cells + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = 0 + newbndy%local_ns_src_add(1,iloc_ns) = 0 + newbndy%local_ns_src_add(2,iloc_ns) = 0 + newbndy%local_ns_dst_block(iloc_ns) = dst_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = 1 + if (iblock_north < 0) then !*** tripole boundary + newbndy%local_ns_dst_block(iloc_ns) = -dst_block_loc + !*** replace i addresses with global i location + !*** for copies into and out of global buffer + newbndy%local_ns_dst_add(1,iloc_ns) = & + dst_block%i_glob(nghost+1) + newbndy%local_ns_dst_add(2,iloc_ns) = dst_block%jhi + endif + endif + + endif ! north neighbor + + !*** + !*** if this block is a southern neighbor + !*** determine send/receive addresses + !*** + + if (iblock_dst == iblock_south .and. & + jblock_dst == jblock_south .and. go_south) then + + if (src_proc /= 0) then + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = src_block_loc + newbndy%local_ns_src_add(1,iloc_ns) = 1 + newbndy%local_ns_src_add(2,iloc_ns) = nghost + 1 + newbndy%local_ns_dst_block(iloc_ns) = dst_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = dst_block%jhi + 1 + else + !*** neighbor is a land block so zero ghost cells + iloc_ns = iloc_ns + 1 + newbndy%local_ns_src_block(iloc_ns) = 0 + newbndy%local_ns_src_add(1,iloc_ns) = 0 + newbndy%local_ns_src_add(2,iloc_ns) = 0 + newbndy%local_ns_dst_block(iloc_ns) = dst_block_loc + newbndy%local_ns_dst_add(1,iloc_ns) = 1 + newbndy%local_ns_dst_add(2,iloc_ns) = dst_block%jhi + 1 + endif + endif ! south neighbor + + endif ! not a land block + + end do + end do block_loop2 + +!----------------------------------------------------------------------- +! +! if necessary, create tripole boundary buffers for each +! common data type. the ghost cell buffer includes an +! extra row for the last physical row in order to enforce +! symmetry conditions on variables at U points. the other buffer +! contains an extra row for handling y-offset for north face or +! northeast corner points. +! +!----------------------------------------------------------------------- + + if (lalloc_tripole .and. .not. allocated(tripole_ibuf)) then + allocate(tripole_ibuf (nx_global,nghost+1), & + tripole_rbuf (nx_global,nghost+1), & + tripole_dbuf (nx_global,nghost+1), & + tripole_ighost(nx_global,nghost+1), & + tripole_rghost(nx_global,nghost+1), & + tripole_dghost(nx_global,nghost+1)) + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine create_boundary + +!*********************************************************************** +!BOP +! !IROUTINE: destroy_boundary +! !INTERFACE: + + subroutine destroy_boundary(in_bndy) + +! !DESCRIPTION: +! This routine destroys a boundary by deallocating all memory +! associated with the boundary and nullifying pointers. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(inout) :: & + in_bndy ! boundary structure to be destroyed + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! reset all scalars +! +!----------------------------------------------------------------------- + + in_bndy%communicator = 0 + in_bndy%nlocal_ew = 0 + in_bndy%nlocal_ns = 0 + +!----------------------------------------------------------------------- +! +! deallocate all pointers +! +!----------------------------------------------------------------------- + + deallocate(in_bndy%local_ew_src_block, & + in_bndy%local_ew_dst_block, & + in_bndy%local_ns_src_block, & + in_bndy%local_ns_dst_block, & + in_bndy%local_ew_src_add, & + in_bndy%local_ew_dst_add, & + in_bndy%local_ns_src_add, & + in_bndy%local_ns_dst_add ) + +!----------------------------------------------------------------------- +!EOC + + end subroutine destroy_boundary + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + + subroutine boundary_2d_dbl(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 2d horizontal arrays of double precision. +! +! !REVISION HISTORY: +! same as module +! +! Sept. 2004: Modified by William Lipscomb to allow for cases where +! blocks have no EW and/or NS communications with other +! blocks. E.g., do not allocate arrays with dimension 0. + +! !USER: + +! !INPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,m,n, &! dummy loop indices + ib_src,ie_src,jb_src,je_src, &! beg,end indices for bndy cells + ib_dst,ie_dst,jb_dst,je_dst, &! + nx_global, &! global domain size in x + src_block, &! local block number for source + dst_block, &! local block number for destination + xoffset, yoffset, &! address shifts for tripole + isign, &! sign factor for tripole grids + bcflag ! boundary condition flag + + real (r8) :: & + xavg ! scalar for enforcing symmetry at U pts + + !call glc_timer_start(timer_bound) ! boundary updates + +!----------------------------------------------------------------------- +! +! set nx_global for tripole +! +!----------------------------------------------------------------------- + + if (allocated(tripole_dbuf)) nx_global = size(tripole_dbuf,dim=1) + +!----------------------------------------------------------------------- +! +! do local copies for east-west ghost cell updates +! also initialize ghost cells to zero +! +!----------------------------------------------------------------------- + + !call timer_start(bndy_2d_local) + do n=1,in_bndy%nlocal_ew + src_block = in_bndy%local_ew_src_block(n) + dst_block = in_bndy%local_ew_dst_block(n) + + ib_src = in_bndy%local_ew_src_add(1,n) + ie_src = ib_src + nghost - 1 + ib_dst = in_bndy%local_ew_dst_add(1,n) + ie_dst = ib_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(ib_dst:ie_dst,:,dst_block) = & + ARRAY(ib_src:ie_src,:,src_block) + else + ARRAY(ib_dst:ie_dst,:,dst_block) = c0 + if (present(bc)) then + if (bc == 'Neumann') then + if (ib_dst == 1) then ! west boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ie_dst+1,:,dst_block) + enddo + elseif (ib_dst == nx_block-nghost+1) then ! east boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ib_dst-1,:,dst_block) + enddo + endif + endif + endif + endif + + end do + +!----------------------------------------------------------------------- +! +! now exchange north-south boundary info +! +!----------------------------------------------------------------------- + + if (allocated(tripole_dbuf)) tripole_dbuf = c0 + + do n=1,in_bndy%nlocal_ns + src_block = in_bndy%local_ns_src_block(n) + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block > 0) then ! straight local copy + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost - 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(:,jb_dst:je_dst,dst_block) = & + ARRAY(:,jb_src:je_src,src_block) + else + ARRAY(:,jb_dst:je_dst,dst_block) = c0 + if (present(bc)) then + if (bc == 'Neumann') then + if (jb_dst == 1) then ! south boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,je_dst+1,dst_block) + enddo + elseif (jb_dst == ny_block-nghost+1) then ! north boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,jb_dst-1,dst_block) + enddo + endif + endif + endif + endif + + else !north boundary tripole grid - copy into global north buffer + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost ! need nghost+1 rows for tripole + + !*** determine start, end addresses of physical domain + !*** for both global buffer and local block + +!echmod - bug ib_dst = in_bndy%local_ns_src_add(1,n) + ib_dst = in_bndy%local_ns_dst_add(1,n) !echmod + ie_dst = ib_dst + (nx_block-2*nghost) - 1 +!echmod if (ie_dst > nx_global) ie_dst = nx_global + ie_dst = min(ie_dst, nx_global) !echmod + ib_src = nghost + 1 + ie_src = ib_src + ie_dst - ib_dst +!echmod - fill buffer with Neumann conditions first, then overwrite where needed + if (src_block == 0 .and. dst_block /= 0) then ! echmod + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + ie_src = ib_src + ie_dst - ib_dst + tripole_dbuf(ib_dst:ie_dst,m) = & + ARRAY(ib_src:ie_src,jb_dst-1,-dst_block) + enddo + endif + endif + else if (src_block /= 0 .and. dst_block == -src_block) then ! echmod +!maltrud - debug if (src_block /= 0) then +!echmod if (dst_block /= 0) then + tripole_dbuf(ib_dst:ie_dst,:) = & + ARRAY(ib_src:ie_src,jb_src:je_src,src_block) + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + do i = 1, nghost + if (ib_dst > i) then + if (tripole_dbuf(ib_dst-i,m) == c0) & + tripole_dbuf(ib_dst-i,m) = tripole_dbuf(ib_dst,m) + endif + if (ie_dst < nx_global-i) then + if (tripole_dbuf(ie_dst+i,m) == c0) & + tripole_dbuf(ie_dst+i,m) = tripole_dbuf(ie_dst,m) + endif + enddo + enddo + endif + endif + endif + + endif + end do + +!----------------------------------------------------------------------- +! +! take care of northern boundary in tripole case +! +!----------------------------------------------------------------------- + + if (allocated(tripole_dbuf)) then + + tripole_dghost(:,:) = c0 !echmod + + select case (grid_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_dghost(:,1) = tripole_dbuf(:,nghost+1) + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global - i + xavg = p5*(abs(tripole_dbuf(i ,nghost+1)) + & + abs(tripole_dbuf(ib_dst,nghost+1))) + tripole_dghost(i ,1) = sign(xavg, & + tripole_dbuf(i,nghost+1)) + tripole_dghost(ib_dst,1) = sign(xavg, & + tripole_dbuf(ib_dst,nghost+1)) + end do + !*** catch nx_global case (should be land anyway...) + tripole_dghost(nx_global,1) = tripole_dbuf(nx_global,nghost+1) + tripole_dbuf(:,nghost+1) = tripole_dghost(:,1) + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_dghost(:,1) = tripole_dbuf(:,nghost+1) + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global + 1 - i + xavg = p5*(abs(tripole_dbuf(i ,nghost+1)) + & + abs(tripole_dbuf(ib_dst,nghost+1))) + tripole_dghost(i ,1) = sign(xavg, & + tripole_dbuf(i,nghost+1)) + tripole_dghost(ib_dst,1) = sign(xavg, & + tripole_dbuf(ib_dst,nghost+1)) + end do + tripole_dbuf(:,nghost+1) = tripole_dghost(:,1) + case default + call exit_glc(sigAbort, 'Unknown location in boundary_2d') + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case default + call exit_glc(sigAbort, 'Unknown field type in boundary') + end select + + !*** copy source (physical) cells into ghost cells + !*** global source addresses are: + !*** nx_global + xoffset - i + !*** ny_global + yoffset - j + !*** in the actual tripole buffer, the indices are: + !*** nx_global + xoffset - i = ib_src - i + !*** ny_global + yoffset - j - (ny_global - nghost) + 1 = + !*** nghost + yoffset +1 - j = jb_src - j + + ib_src = nx_global + xoffset + jb_src = nghost + yoffset + 1 + + bcflag = 0 + if (present(bc)) then + if (bc == 'Neumann') then + bcflag = 1 + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + if (tripole_dbuf(index_check, jb_src-j) /= c0) then !echmod + tripole_dghost(i,1+j) = isign* & + tripole_dbuf(index_check, jb_src-j) + else + tripole_dghost(i,1+j) = tripole_dbuf(i, jb_src-j) + endif + end do + end do + endif + endif + + if (bcflag == 0) then + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + tripole_dghost(i,1+j) = isign* & + tripole_dbuf(index_check, jb_src-j) + end do + end do + endif ! bcflag = 0 + + !*** copy out of global ghost cell buffer into local + !*** ghost cells + + do n=1,in_bndy%nlocal_ns + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block < 0) then + dst_block = -dst_block + + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost + ib_src = in_bndy%local_ns_dst_add(1,n) + !*** ib_src is glob address of 1st point in physical + !*** domain. must now adjust to properly copy + !*** east-west ghost cell info in the north boundary + + if (ib_src == 1) then ! western boundary + !*** impose cyclic conditions at western boundary + !*** then set up remaining indices to copy rest + !*** of domain from tripole ghost cell buffer + do i=1,nghost + ARRAY(i,jb_dst:je_dst,dst_block) = & + tripole_dghost(nx_global-nghost+i,:) + end do + ie_src = ib_src + nx_block - nghost - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = nghost + 1 + ie_dst = ib_dst + (ie_src - ib_src) + else + ib_src = ib_src - nghost + ie_src = ib_src + nx_block - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = 1 + ie_dst = ib_dst + (ie_src - ib_src) + endif + if (ie_src == nx_global) then ! eastern boundary + !*** impose cyclic conditions in ghost cells + do i=1,nghost + ARRAY(ie_dst+i,jb_dst:je_dst,dst_block) = & + tripole_dghost(i,:) + end do + endif + + !*** now copy the remaining ghost cell values + + ARRAY(ib_dst:ie_dst,jb_dst:je_dst,dst_block) = & + tripole_dghost(ib_src:ie_src,:) + endif + + end do + + endif + + !call timer_stop(bndy_2d_local) + !call glc_timer_stop(timer_bound) + +!----------------------------------------------------------------------- + + end subroutine boundary_2d_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + + subroutine boundary_2d_real(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 2d horizontal arrays of single precision. +! +! !REVISION HISTORY: +! same as module + +! !USES: + +! !INPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,m,n, &! dummy loop indices + ib_src,ie_src,jb_src,je_src, &! beg,end indices for bndy cells + ib_dst,ie_dst,jb_dst,je_dst, &! + nx_global, &! global domain size in x + src_block, &! local block number for source + dst_block, &! local block number for destination + xoffset, yoffset, &! address shifts for tripole + isign, &! sign factor for tripole grids + bcflag ! boundary condition flag + + real (r4) :: & + xavg ! scalar for enforcing symmetry at U pts + + !call glc_timer_start(timer_bound) + +!----------------------------------------------------------------------- +! +! set nx_global for tripole +! +!----------------------------------------------------------------------- + + if (allocated(tripole_rbuf)) nx_global = size(tripole_rbuf,dim=1) + +!----------------------------------------------------------------------- +! +! do local copies for east-west ghost cell updates +! also initialize ghost cells to zero +! +!----------------------------------------------------------------------- + + do n=1,in_bndy%nlocal_ew + src_block = in_bndy%local_ew_src_block(n) + dst_block = in_bndy%local_ew_dst_block(n) + + ib_src = in_bndy%local_ew_src_add(1,n) + ie_src = ib_src + nghost - 1 + ib_dst = in_bndy%local_ew_dst_add(1,n) + ie_dst = ib_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(ib_dst:ie_dst,:,dst_block) = & + ARRAY(ib_src:ie_src,:,src_block) + else + ARRAY(ib_dst:ie_dst,:,dst_block) = c0 + if (present(bc)) then + if (bc == 'Neumann') then + if (ib_dst == 1) then ! west boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ie_dst+1,:,dst_block) + enddo + elseif (ib_dst == nx_block-nghost+1) then ! east boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ib_dst-1,:,dst_block) + enddo + endif + endif + endif + endif + + end do + +!----------------------------------------------------------------------- +! +! now exchange north-south boundary info +! +!----------------------------------------------------------------------- + + if (allocated(tripole_rbuf)) tripole_rbuf = c0 + + do n=1,in_bndy%nlocal_ns + src_block = in_bndy%local_ns_src_block(n) + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block > 0) then ! straight local copy + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost - 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(:,jb_dst:je_dst,dst_block) = & + ARRAY(:,jb_src:je_src,src_block) + else + ARRAY(:,jb_dst:je_dst,dst_block) = c0 + if (present(bc)) then + if (bc == 'Neumann') then + if (jb_dst == 1) then ! south boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,je_dst+1,dst_block) + enddo + elseif (jb_dst == ny_block-nghost+1) then ! north boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,jb_dst-1,dst_block) + enddo + endif + endif + endif + endif + + else !north boundary tripole grid - copy into global north buffer + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost ! need nghost+1 rows for tripole + + !*** determine start, end addresses of physical domain + !*** for both global buffer and local block + +!echmod - bug ib_dst = in_bndy%local_ns_src_add(1,n) + ib_dst = in_bndy%local_ns_dst_add(1,n) + ie_dst = ib_dst + (nx_block-2*nghost) - 1 +!echmod if (ie_dst > nx_global) ie_dst = nx_global + ie_dst = min(ie_dst, nx_global) !echmod + ib_src = nghost + 1 + ie_src = ib_src + ie_dst - ib_dst +!echmod - fill buffer with Neumann conditions first, then overwrite where needed + if (src_block == 0 .and. dst_block /= 0) then ! echmod + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + ie_src = ib_src + ie_dst - ib_dst + tripole_rbuf(ib_dst:ie_dst,m) = & + ARRAY(ib_src:ie_src,jb_dst-1,-dst_block) + enddo + endif + endif + else if (src_block /= 0 .and. dst_block == -src_block) then ! echmod +!maltrud - debug if (src_block /= 0) then +!echmod if (dst_block /= 0) then + tripole_rbuf(ib_dst:ie_dst,:) = & + ARRAY(ib_src:ie_src,jb_src:je_src,src_block) + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + do i = 1, nghost + if (ib_dst > i) then + if (tripole_rbuf(ib_dst-i,m) == c0) & + tripole_rbuf(ib_dst-i,m) = tripole_rbuf(ib_dst,m) + endif + if (ie_dst < nx_global-i) then + if (tripole_rbuf(ie_dst+i,m) == c0) & + tripole_rbuf(ie_dst+i,m) = tripole_rbuf(ie_dst,m) + endif + enddo + enddo + endif + endif + endif + + endif + end do + +!----------------------------------------------------------------------- +! +! take care of northern boundary in tripole case +! +!----------------------------------------------------------------------- + + if (allocated(tripole_rbuf)) then + + tripole_rghost(:,:) = c0 !echmod + + select case (grid_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_rghost(:,1) = tripole_rbuf(:,nghost+1) + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global - i + xavg = p5*(abs(tripole_rbuf(i ,nghost+1)) + & + abs(tripole_rbuf(ib_dst,nghost+1))) + tripole_rghost(i ,1) = sign(xavg, & + tripole_rbuf(i,nghost+1)) + tripole_rghost(ib_dst,1) = sign(xavg, & + tripole_rbuf(ib_dst,nghost+1)) + end do + !*** catch nx_global case (should be land anyway...) + tripole_rghost(nx_global,1) = tripole_rbuf(nx_global,nghost+1) + tripole_rbuf(:,nghost+1) = tripole_rghost(:,1) + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_rghost(:,1) = tripole_rbuf(:,nghost+1) + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global + 1 - i + xavg = p5*(abs(tripole_rbuf(i ,nghost+1)) + & + abs(tripole_rbuf(ib_dst,nghost+1))) + tripole_rghost(i ,1) = sign(xavg, & + tripole_rbuf(i,nghost+1)) + tripole_rghost(ib_dst,1) = sign(xavg, & + tripole_rbuf(ib_dst,nghost+1)) + end do + tripole_rbuf(:,nghost+1) = tripole_rghost(:,1) + case default + call exit_glc(sigAbort, 'Unknown location in boundary_2d') + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case default + call exit_glc(sigAbort, 'Unknown field type in boundary') + end select + + !*** copy source (physical) cells into ghost cells + !*** global source addresses are: + !*** nx_global + xoffset - i + !*** ny_global + yoffset - j + !*** in the actual tripole buffer, the indices are: + !*** nx_global + xoffset - i = ib_src - i + !*** ny_global + yoffset - j - (ny_global - nghost) + 1 = + !*** nghost + yoffset +1 - j = jb_src - j + + ib_src = nx_global + xoffset + jb_src = nghost + yoffset + 1 + + bcflag = 0 + if (present(bc)) then + if (bc == 'Neumann') then + bcflag = 1 + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + if (tripole_rbuf(index_check, jb_src-j) /= c0) then !echmod + tripole_rghost(i,1+j) = isign* & + tripole_rbuf(index_check, jb_src-j) + else + tripole_rghost(i,1+j) = tripole_rbuf(i, jb_src-j) + endif + end do + end do + endif + endif + + if (bcflag == 0) then + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + tripole_rghost(i,1+j) = isign* & + tripole_rbuf(index_check, jb_src-j) + end do + end do + endif ! bcflag = 0 + + !*** copy out of global ghost cell buffer into local + !*** ghost cells + + do n=1,in_bndy%nlocal_ns + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block < 0) then + dst_block = -dst_block + + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost + ib_src = in_bndy%local_ns_dst_add(1,n) + !*** ib_src is glob address of 1st point in physical + !*** domain. must now adjust to properly copy + !*** east-west ghost cell info in the north boundary + + if (ib_src == 1) then ! western boundary + !*** impose cyclic conditions at western boundary + !*** then set up remaining indices to copy rest + !*** of domain from tripole ghost cell buffer + do i=1,nghost + ARRAY(i,jb_dst:je_dst,dst_block) = & + tripole_rghost(nx_global-nghost+i,:) + end do + ie_src = ib_src + nx_block - nghost - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = nghost + 1 + ie_dst = ib_dst + (ie_src - ib_src) + else + ib_src = ib_src - nghost + ie_src = ib_src + nx_block - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = 1 + ie_dst = ib_dst + (ie_src - ib_src) + endif + if (ie_src == nx_global) then ! eastern boundary + !*** impose cyclic conditions in ghost cells + do i=1,nghost + ARRAY(ie_dst+i,jb_dst:je_dst,dst_block) = & + tripole_rghost(i,:) + end do + endif + + !*** now copy the remaining ghost cell values + + ARRAY(ib_dst:ie_dst,jb_dst:je_dst,dst_block) = & + tripole_rghost(ib_src:ie_src,:) + endif + + end do + + endif + + + !call glc_timer_stop(timer_bound) + +!----------------------------------------------------------------------- + +end subroutine boundary_2d_real + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + + subroutine boundary_2d_int(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 2d horizontal arrays of double precision. +! +! !REVISION HISTORY: +! same as module + +! !USES: + +! !INPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,m,n, &! dummy loop indices + ib_src,ie_src,jb_src,je_src, &! beg,end indices for bndy cells + ib_dst,ie_dst,jb_dst,je_dst, &! + nx_global, &! global domain size in x + src_block, &! local block number for source + dst_block, &! local block number for destination + xoffset, yoffset, &! address shifts for tripole + isign, &! sign factor for tripole grids + bcflag ! boundary condition flag + + integer (int_kind) :: & + xavg ! scalar for enforcing symmetry at U pts + + !call glc_timer_start(timer_bound) + +!----------------------------------------------------------------------- +! +! set nx_global for tripole +! +!----------------------------------------------------------------------- + + if (allocated(tripole_ibuf)) nx_global = size(tripole_ibuf,dim=1) + +!----------------------------------------------------------------------- +! +! do local copies for east-west ghost cell updates +! also initialize ghost cells to zero +! +!----------------------------------------------------------------------- + + do n=1,in_bndy%nlocal_ew + src_block = in_bndy%local_ew_src_block(n) + dst_block = in_bndy%local_ew_dst_block(n) + + ib_src = in_bndy%local_ew_src_add(1,n) + ie_src = ib_src + nghost - 1 + ib_dst = in_bndy%local_ew_dst_add(1,n) + ie_dst = ib_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(ib_dst:ie_dst,:,dst_block) = & + ARRAY(ib_src:ie_src,:,src_block) + else + ARRAY(ib_dst:ie_dst,:,dst_block) = 0 + if (present(bc)) then + if (bc == 'Neumann') then + if (ib_dst == 1) then ! west boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ie_dst+1,:,dst_block) + enddo + elseif (ib_dst == nx_block-nghost+1) then ! east boundary + do i = ib_dst, ie_dst + ARRAY(i,:,dst_block) = ARRAY(ib_dst-1,:,dst_block) + enddo + endif + endif + endif + endif + + end do + +!----------------------------------------------------------------------- +! +! now exchange north-south boundary info +! +!----------------------------------------------------------------------- + + if (allocated(tripole_ibuf)) tripole_ibuf = c0 + + do n=1,in_bndy%nlocal_ns + src_block = in_bndy%local_ns_src_block(n) + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block > 0) then ! straight local copy + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost - 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost - 1 + + if (src_block /= 0) then + ARRAY(:,jb_dst:je_dst,dst_block) = & + ARRAY(:,jb_src:je_src,src_block) + else + ARRAY(:,jb_dst:je_dst,dst_block) = 0 + if (present(bc)) then + if (bc == 'Neumann') then + if (jb_dst == 1) then ! south boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,je_dst+1,dst_block) + enddo + elseif (jb_dst == ny_block-nghost+1) then ! north boundary + do j = jb_dst, je_dst + ARRAY(:,j,dst_block) = ARRAY(:,jb_dst-1,dst_block) + enddo + endif + endif + endif + endif + + else !north boundary tripole grid - copy into global north buffer + + jb_src = in_bndy%local_ns_src_add(2,n) + je_src = jb_src + nghost ! need nghost+1 rows for tripole + + !*** determine start, end addresses of physical domain + !*** for both global buffer and local block + +!echmod - bug ib_dst = in_bndy%local_ns_src_add(1,n) + ib_dst = in_bndy%local_ns_dst_add(1,n) + ie_dst = ib_dst + (nx_block-2*nghost) - 1 +!echmod if (ie_dst > nx_global) ie_dst = nx_global + ie_dst = min(ie_dst, nx_global) !echmod + ib_src = nghost + 1 + ie_src = ib_src + ie_dst - ib_dst +!echmod - fill buffer with Neumann conditions first, then overwrite where needed + if (src_block == 0 .and. dst_block /= 0) then ! echmod + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + jb_dst = in_bndy%local_ns_dst_add(2,n) + ie_src = ib_src + ie_dst - ib_dst + tripole_ibuf(ib_dst:ie_dst,m) = & + ARRAY(ib_src:ie_src,jb_dst-1,-dst_block) + enddo + endif + endif + else if (src_block /= 0 .and. dst_block == -src_block) then ! echmod +!maltrud - debug if (src_block /= 0) then +!echmod if (dst_block /= 0) then + tripole_ibuf(ib_dst:ie_dst,:) = & + ARRAY(ib_src:ie_src,jb_src:je_src,src_block) + if (present(bc)) then + if (bc == 'Neumann') then + do m = 1, nghost + 1 + do i = 1, nghost + if (ib_dst > i) then + if (tripole_ibuf(ib_dst-i,m) == c0) & + tripole_ibuf(ib_dst-i,m) = tripole_ibuf(ib_dst,m) + endif + if (ie_dst < nx_global-i) then + if (tripole_ibuf(ie_dst+i,m) == c0) & + tripole_ibuf(ie_dst+i,m) = tripole_ibuf(ie_dst,m) + endif + enddo + enddo + endif + endif + endif + + endif + end do + +!----------------------------------------------------------------------- +! +! take care of northern boundary in tripole case +! +!----------------------------------------------------------------------- + + if (allocated(tripole_ibuf)) then + + tripole_ighost(:,:) = c0 !echmod + + select case (grid_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_ighost(:,1) = tripole_ibuf(:,nghost+1) + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global - i + xavg = p5*(abs(tripole_ibuf(i ,nghost+1)) + & + abs(tripole_ibuf(ib_dst,nghost+1))) + tripole_ighost(i ,1) = sign(xavg, & + tripole_ibuf(i,nghost+1)) + tripole_ighost(ib_dst,1) = sign(xavg, & + tripole_ibuf(ib_dst,nghost+1)) + end do + !*** catch nx_global case (should be land anyway...) + tripole_ighost(nx_global,1) = tripole_ibuf(nx_global,nghost+1) + tripole_ibuf(:,nghost+1) = tripole_ighost(:,1) + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain (mostly for symmetry enforcement) + tripole_ighost(:,1) = tripole_ibuf(:,nghost+1) + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + !*** enforce symmetry + !*** first row of ghost cell buffer is actually the last + !*** row of physical domain + do i = 1, nx_global/2 + ib_dst = nx_global + 1 - i + xavg = p5*(abs(tripole_ibuf(i ,nghost+1)) + & + abs(tripole_ibuf(ib_dst,nghost+1))) + tripole_ighost(i ,1) = sign(xavg, & + tripole_ibuf(i,nghost+1)) + tripole_ighost(ib_dst,1) = sign(xavg, & + tripole_ibuf(ib_dst,nghost+1)) + end do + tripole_ibuf(:,nghost+1) = tripole_ighost(:,1) + case default + call exit_glc(sigAbort, 'Unknown location in boundary_2d') + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case default + call exit_glc(sigAbort, 'Unknown field type in boundary') + end select + + !*** copy source (physical) cells into ghost cells + !*** global source addresses are: + !*** nx_global + xoffset - i + !*** ny_global + yoffset - j + !*** in the actual tripole buffer, the indices are: + !*** nx_global + xoffset - i = ib_src - i + !*** ny_global + yoffset - j - (ny_global - nghost) + 1 = + !*** nghost + yoffset +1 - j = jb_src - j + + ib_src = nx_global + xoffset + jb_src = nghost + yoffset + 1 + + bcflag = 0 + if (present(bc)) then + if (bc == 'Neumann') then + bcflag = 1 + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + if (tripole_ibuf(index_check, jb_src-j) /= c0) then !echmod + tripole_ighost(i,1+j) = isign* & + tripole_ibuf(index_check, jb_src-j) + else + tripole_ighost(i,1+j) = tripole_ibuf(i, jb_src-j) + endif + end do + end do + endif + endif + + if (bcflag == 0) then + do j=1,nghost + do i=1,nx_global + index_check = max(ib_src-i,1) + tripole_ighost(i,1+j) = isign* & + tripole_ibuf(index_check, jb_src-j) + end do + end do + endif ! bcflag = 0 + + !*** copy out of global ghost cell buffer into local + !*** ghost cells + + do n=1,in_bndy%nlocal_ns + dst_block = in_bndy%local_ns_dst_block(n) + + if (dst_block < 0) then + dst_block = -dst_block + + jb_dst = in_bndy%local_ns_dst_add(2,n) + je_dst = jb_dst + nghost + ib_src = in_bndy%local_ns_dst_add(1,n) + !*** ib_src is glob address of 1st point in physical + !*** domain. must now adjust to properly copy + !*** east-west ghost cell info in the north boundary + + if (ib_src == 1) then ! western boundary + !*** impose cyclic conditions at western boundary + !*** then set up remaining indices to copy rest + !*** of domain from tripole ghost cell buffer + do i=1,nghost + ARRAY(i,jb_dst:je_dst,dst_block) = & + tripole_ighost(nx_global-nghost+i,:) + end do + ie_src = ib_src + nx_block - nghost - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = nghost + 1 + ie_dst = ib_dst + (ie_src - ib_src) + else + ib_src = ib_src - nghost + ie_src = ib_src + nx_block - 1 +!echmod if (ie_src > nx_global) ie_src = nx_global + ie_src = min(ie_src, nx_global) !echmod + ib_dst = 1 + ie_dst = ib_dst + (ie_src - ib_src) + endif + if (ie_src == nx_global) then ! eastern boundary + !*** impose cyclic conditions in ghost cells + do i=1,nghost + ARRAY(ie_dst+i,jb_dst:je_dst,dst_block) = & + tripole_ighost(i,:) + end do + endif + + !*** now copy the remaining ghost cell values + + ARRAY(ib_dst:ie_dst,jb_dst:je_dst,dst_block) = & + tripole_ighost(ib_src:ie_src,:) + endif + + end do + + endif + + !call glc_timer_stop(timer_bound) + +!----------------------------------------------------------------------- + +end subroutine boundary_2d_int + +!*********************************************************************** +! +!BOP + !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_3d_dbl(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of double precision. +! +! !REVISION HISTORY: +! same as module + +! !USES: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + real (r8), dimension(:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,m ! dummy loop indices + +!----------------------------------------------------------------------- + +!lipscomb - This subroutine could be sped up by modeling it after the +! mpi version of boundary_3d_dbl, so as to pass fewer and +! longer messages. But when running in serial mode, +! speed is likely not an issue. + + m = size(ARRAY,3) + do k = 1, m + call boundary_2d_dbl(ARRAY(:,:,k,:),in_bndy,grid_loc,field_type, bc) + end do + +!----------------------------------------------------------------------- + + end subroutine boundary_3d_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_3d_real(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of single precision. +! +! !REVISION HISTORY: +! same as module + +! !USER: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + real (r4), dimension(:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,m ! dummy loop indices + +!----------------------------------------------------------------------- + + m = size(ARRAY,3) + do k = 1, m + call boundary_2d_real(ARRAY(:,:,k,:),in_bndy,grid_loc,field_type, bc) + end do + +!----------------------------------------------------------------------- + +end subroutine boundary_3d_real + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_3d_int(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of integer. +! +! !REVISION HISTORY: +! same as module + +! !USER: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + integer (int_kind), dimension(:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,m ! dummy loop indices + +!----------------------------------------------------------------------- + + m = size(ARRAY,3) + do k = 1, m + call boundary_2d_int(ARRAY(:,:,k,:),in_bndy,grid_loc,field_type, bc) + end do + +!----------------------------------------------------------------------- + +end subroutine boundary_3d_int + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_4d_dbl(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of double precision. +! +! !REVISION HISTORY: +! same as module + +! !USER: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + real (r8), dimension(:,:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,l,m,n ! dummy loop indices + +!----------------------------------------------------------------------- + + l = size(ARRAY,dim=3) + n = size(ARRAY,dim=4) + do k=1,l + do m=1,n + call boundary_2d_dbl(ARRAY(:,:,k,m,:),in_bndy,grid_loc,field_type, bc) + end do + end do + +!----------------------------------------------------------------------- + +end subroutine boundary_4d_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_4d_real(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of single precision. +! +! !REVISION HISTORY: +! same as module + +! !USER: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + real (r4), dimension(:,:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,l,m,n ! dummy loop indices + +!----------------------------------------------------------------------- + + l = size(ARRAY,dim=3) + n = size(ARRAY,dim=4) + do k=1,l + do m=1,n + call boundary_2d_real(ARRAY(:,:,k,m,:),in_bndy,grid_loc,field_type, bc) + end do + end do + +!----------------------------------------------------------------------- + +end subroutine boundary_4d_real + +!*********************************************************************** +!BOP +! !IROUTINE: update_ghost_cells +! !INTERFACE: + +subroutine boundary_4d_int(ARRAY, in_bndy, grid_loc, field_type, bc) + +! !DESCRIPTION: +! This routine updates ghost cells for an input array and is a +! member of a group of routines under the generic interface +! update\_ghost\_cells. This routine is the specific interface +! for 3d horizontal arrays of double precision. +! +! !REVISION HISTORY: +! same as module + +! !USER: + +! !INPUT/OUTPUT PARAMETERS: + + type (bndy), intent(in) :: & + in_bndy ! boundary update structure for the array + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + grid_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + + character (char_len), intent(in), optional :: & + bc ! boundary condition type (Dirichlet, Neumann) + + integer (int_kind), dimension(:,:,:,:,:), intent(inout) :: & + ARRAY ! array containing horizontal slab to update + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k,l,m,n ! dummy loop indices + +!----------------------------------------------------------------------- + + l = size(ARRAY,dim=3) + n = size(ARRAY,dim=4) + + do k=1,l + do m=1,n + call boundary_2d_int(ARRAY(:,:,k,m,:),in_bndy,grid_loc,field_type, bc) + end do + end do + +!----------------------------------------------------------------------- + +end subroutine boundary_4d_int + +!EOC +!*********************************************************************** + +end module glc_boundary + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/glc_broadcast.F90 b/components/cism/serial/glc_broadcast.F90 new file mode 100644 index 0000000000..323af81bc7 --- /dev/null +++ b/components/cism/serial/glc_broadcast.F90 @@ -0,0 +1,684 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! !MODULE: broadcast + + module glc_broadcast + +! !DESCRIPTION: +! This module contains all the broadcast routines. This +! particular version contains serial versions of these routines +! which typically perform no operations since there is no need +! to broadcast what is already known. +! +! !REVISION HISTORY: +! +! author: Phil Jones, LANL +! Adapted from POP version by William H. Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + use glc_communicate + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: broadcast_scalar, & + broadcast_array + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! generic interfaces for module procedures +! +!----------------------------------------------------------------------- + + interface broadcast_scalar + module procedure broadcast_scalar_dbl, & + broadcast_scalar_real, & + broadcast_scalar_int, & + broadcast_scalar_log, & + broadcast_scalar_char + end interface + + interface broadcast_array + module procedure broadcast_array_dbl_1d, & + broadcast_array_real_1d, & + broadcast_array_int_1d, & + broadcast_array_log_1d, & + broadcast_array_dbl_2d, & + broadcast_array_real_2d, & + broadcast_array_int_2d, & + broadcast_array_log_2d, & + broadcast_array_dbl_3d, & + broadcast_array_real_3d, & + broadcast_array_int_3d, & + broadcast_array_log_3d + end interface + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_dbl +! !INTERFACE: + + subroutine broadcast_scalar_dbl(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar dbl variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_real +! !INTERFACE: + + subroutine broadcast_scalar_real(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar real variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module +! +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_real + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_int +! !INTERFACE: + + subroutine broadcast_scalar_int(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar integer variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_int + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_log +! !INTERFACE: + + subroutine broadcast_scalar_log(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar logical variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_log + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_scalar_char +! !INTERFACE: + + subroutine broadcast_scalar_char(scalar, root_pe) + +! !DESCRIPTION: +! Broadcasts a scalar character variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_scalar interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + character (*), intent(inout) :: & + scalar ! scalar to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_scalar_char + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_1d +! !INTERFACE: + + subroutine broadcast_array_dbl_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a vector dbl variable from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_1d +! !INTERFACE: + + subroutine broadcast_array_real_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_1d +! !INTERFACE: + + subroutine broadcast_array_int_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts an integer vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_1d +! !INTERFACE: + + subroutine broadcast_array_log_1d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical vector from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_1d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_2d +! !INTERFACE: + + subroutine broadcast_array_dbl_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a dbl 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_2d +! !INTERFACE: + + subroutine broadcast_array_real_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_2d +! !INTERFACE: + + subroutine broadcast_array_int_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a 2d integer array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_2d +! !INTERFACE: + + subroutine broadcast_array_log_2d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical 2d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_2d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_dbl_3d +! !INTERFACE: + + subroutine broadcast_array_dbl_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a double 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_dbl_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_real_3d +! !INTERFACE: + + subroutine broadcast_array_real_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a real 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_real_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_int_3d +! !INTERFACE: + + subroutine broadcast_array_int_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts an integer 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_int_3d + +!*********************************************************************** +!BOP +! !IROUTINE: broadcast_array_log_3d +! !INTERFACE: + + subroutine broadcast_array_log_3d(array, root_pe) + +! !DESCRIPTION: +! Broadcasts a logical 3d array from one processor (root_pe) +! to all other processors. This is a specific instance of the generic +! broadcast\_array interface. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + root_pe ! processor number to broadcast from + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), dimension(:,:,:), intent(inout) :: & + array ! array to be broadcast + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! for serial codes, nothing is required +! +!----------------------------------------------------------------------- +!EOC + + end subroutine broadcast_array_log_3d + +!*********************************************************************** + + end module glc_broadcast + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/glc_communicate.F90 b/components/cism/serial/glc_communicate.F90 new file mode 100644 index 0000000000..9542217813 --- /dev/null +++ b/components/cism/serial/glc_communicate.F90 @@ -0,0 +1,538 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP + + module glc_communicate + +! !MODULE: glc_communicate +! !DESCRIPTION: +! This module contains the necessary routines and variables for +! communicating between processors. This instance of the module +! is for serial execution so not much is done. +! +! !REVISION HISTORY: +! +! author: Phil Jones, LANL +! Adapted from POP version by William H. Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_communicate, & + exit_message_environment, & + abort_message_environment, & + get_num_procs, & + create_communicator + +! !PUBLIC DATA MEMBERS: + + integer (int_kind), public :: & + MPI_COMM_GLC, &! MPI communicator for glc comms + mpi_dbl, &! MPI type for dbl_kind + my_task, &! MPI task number for this task + master_task ! task number of master task + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_communicate +! !INTERFACE: + + subroutine init_communicate + +! !DESCRIPTION: +! This routine sets up MPI environment and defines ice communicator. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + +#ifdef coupled + include 'mpif.h' ! MPI Fortran include file + + integer (int_kind) :: ierr ! MPI error flag +#endif + +!----------------------------------------------------------------------- +! +! initiate mpi environment and create communicator for internal +! ocean communications +! +!----------------------------------------------------------------------- + +#ifdef coupled + call MPI_INIT(ierr) + call create_glc_communicator + call MPI_COMM_RANK (MPI_COMM_GLC, my_task, ierr) +#else + my_task = 0 +#endif + + master_task = 0 + +#ifdef coupled +!----------------------------------------------------------------------- +! +! On some 64-bit machines where real_kind and dbl_kind are +! identical, the MPI implementation uses MPI_REAL for both. +! In these cases, set MPI_DBL to MPI_REAL. +! +!----------------------------------------------------------------------- + + MPI_DBL = MPI_DOUBLE_PRECISION + +#endif +!----------------------------------------------------------------------- +!EOC + + end subroutine init_communicate + +!*********************************************************************** +!BOP +! !IROUTINE: get_num_procs +! !INTERFACE: + + function get_num_procs() + +! !DESCRIPTION: +! This function returns the number of processor assigned to +! the ocean model. +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: get_num_procs + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! serial execution, must be only 1 +! +!----------------------------------------------------------------------- + + get_num_procs = 1 + +!----------------------------------------------------------------------- +!EOC + + end function get_num_procs + +!*********************************************************************** +!BOP +! !IROUTINE: exit_message_environment +! !INTERFACE: + + subroutine exit_message_environment(ierr) + +! !DESCRIPTION: +! This routine exits the message environment properly when model +! stops. +! +! !REVISION HISTORY: +! same as module + +#ifdef coupled +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +#endif +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + +#ifdef coupled + call MPI_FINALIZE(ierr) +#else + ierr = 0 +#endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine exit_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: abort_message_environment +! !INTERFACE: + + subroutine abort_message_environment(ierr) + +! !DESCRIPTION: +! This routine aborts the message environment when model stops. +! In coupled mode, it attempts to abort the entire coupled system. +! +! !REVISION HISTORY: +! same as module + +#ifdef coupled +! !INCLUDES: + + include 'mpif.h' ! MPI Fortran include file + +#endif +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: ierr ! MPI error flag + +!EOP +!BOC +!----------------------------------------------------------------------- + +#ifdef coupled + call MPI_BARRIER(MPI_COMM_GLC, ierr) + call MPI_ABORT(MPI_COMM_WORLD, ierr) + call MPI_FINALIZE(ierr) +#else + ierr = 0 +#endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine abort_message_environment + +!*********************************************************************** +!BOP +! !IROUTINE: create_glc_communicator +! !INTERFACE: + + subroutine create_glc_communicator + +! !DESCRIPTION: +! This routine queries all the tasks in MPI_COMM_WORLD to see +! which belong to the land-ice (glc) model. In standalone mode, this +! should be all tasks, but in coupled mode CICE needs to determine +! which tasks are assigned to the ice component. +! +! this routine should be called after mpi_init, but before +! setting up any internal mpi setups (since these will require +! the internal communicators returned by this routine) +! +! !REVISION HISTORY: +! same as module + +#ifdef coupled +! !INCLUDES: + + include 'mpif.h' + +#endif +!EOP +!BOC +#ifdef coupled +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (3) :: cmodel ! model name temporary + + integer (int_kind) :: & + MPI_GROUP_WORLD, &! group id for MPI_COMM_WORLD + MPI_GROUP_ATM, &! group of processors assigned to atm + MPI_GROUP_OCN, &! group of processors assigned to ocn + MPI_GROUP_ICE, &! group of processors assigned to ice + MPI_GROUP_LND, &! group of processors assigned to lnd + MPI_GROUP_GLC, &! group of processors assigned to glc + MPI_GROUP_CPL, &! group of processors assigned to cpl + MPI_COMM_ATM, &! group of processors assigned to atm + MPI_COMM_ICE, &! group of processors assigned to ice + MPI_COMM_LND, &! group of processors assigned to lnd + MPI_COMM_GLC, &! group of processors assigned to glc + MPI_COMM_CPL ! group of processors assigned to cpl + + integer (int_kind) :: & + n, &! dummy loop counter + ierr, &! error flag for MPI comms + nprocs_all, &! total processor count + my_task_all, &! rank of process in coupled domain + ntasks_atm, &! num tasks assigned to atm + ntasks_ocn, &! num tasks assigned to ocn + ntasks_ice, &! num tasks assigned to ice + ntasks_lnd, &! num tasks assigned to lnd + ntasks_glc, &! num tasks assigned to glc + ntasks_cpl ! num tasks assigned to cpl + + integer (int_kind), dimension(3) :: & + range_ocn, &! range of tasks assigned to ocn + range_atm, &! range of tasks assigned to atm + range_ice, &! range of tasks assigned to ice + range_lnd, &! range of tasks assigned to lnd + range_glc, &! range of tasks assigned to glc + range_cpl ! range of tasks assigned to cpl + +!----------------------------------------------------------------------- +! +! determine processor rank in full (coupled) domain +! +!----------------------------------------------------------------------- + + call MPI_COMM_RANK (MPI_COMM_WORLD, my_task_all, ierr) + +!----------------------------------------------------------------------- +! +! determine which group of processes assigned to each model +! assume the first processor assigned to a model is the task that +! will communicate coupled model messages +! +!----------------------------------------------------------------------- + + call MPI_COMM_SIZE (MPI_COMM_WORLD, nprocs_all, ierr) + + ntasks_atm = 0 + ntasks_ocn = 0 + ntasks_ice = 0 + ntasks_lnd = 0 + ntasks_glc = 0 + ntasks_cpl = 0 + range_ocn(1) = nprocs_all + range_atm(1) = nprocs_all + range_ice(1) = nprocs_all + range_lnd(1) = nprocs_all + range_glc(1) = nprocs_all + range_cpl(1) = nprocs_all + range_ocn(2) = 0 + range_atm(2) = 0 + range_ice(2) = 0 + range_lnd(2) = 0 + range_glc(2) = 0 + range_cpl(2) = 0 + range_ocn(3) = 1 + range_atm(3) = 1 + range_ice(3) = 1 + range_lnd(3) = 1 + range_glc(3) = 1 + range_cpl(3) = 1 + + !*** + !*** each processor broadcasts its model to all the processors + !*** in the coupled domain + !*** + + do n=0,nprocs_all-1 + if (n == my_task_all) then + cmodel = 'glc' + else + cmodel = 'unk' + endif + + call MPI_BCAST(cmodel, 3, MPI_CHARACTER, n, MPI_COMM_WORLD, ierr) + + select case(cmodel) + case ('ocn') + ntasks_ocn = ntasks_ocn + 1 + range_ocn(1) = min(n,range_ocn(1)) + range_ocn(2) = max(n,range_ocn(2)) + case ('atm') + ntasks_atm = ntasks_atm + 1 + range_atm(1) = min(n,range_atm(1)) + range_atm(2) = max(n,range_atm(2)) + case ('ice') + ntasks_ice = ntasks_ice + 1 + range_ice(1) = min(n,range_ice(1)) + range_ice(2) = max(n,range_ice(2)) + case ('lnd') + ntasks_lnd = ntasks_lnd + 1 + range_lnd(1) = min(n,range_lnd(1)) + range_lnd(2) = max(n,range_lnd(2)) + case ('glc') + ntasks_glc = ntasks_lnd + 1 + range_glc(1) = min(n,range_glc(1)) + range_glc(2) = max(n,range_glc(2)) + case ('cpl') + ntasks_cpl = ntasks_cpl + 1 + range_cpl(1) = min(n,range_cpl(1)) + range_cpl(2) = max(n,range_cpl(2)) + case default + stop 'Unknown model name in comm setup' + end select + + end do + +!----------------------------------------------------------------------- +! +! create subroup and communicator for each models internal +! communciations, note that MPI_COMM_CREATE must be called by +! all processes in MPI_COMM_WORLD so this must be done by all +! models consistently and in the same order. +! +!----------------------------------------------------------------------- + + call MPI_COMM_GROUP(MPI_COMM_WORLD, MPI_GROUP_WORLD, ierr) + + if (ntasks_atm > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_atm, & + MPI_GROUP_ATM, ierr) + + if (ntasks_ocn > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_ocn, & + MPI_GROUP_OCN, ierr) + + if (ntasks_ice > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_ice, & + MPI_GROUP_ICE, ierr) + + if (ntasks_lnd > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_lnd, & + MPI_GROUP_LND, ierr) + + if (ntasks_glc > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_glc, & + MPI_GROUP_GLC, ierr) + + if (ntasks_cpl > 0) & + call MPI_GROUP_RANGE_INCL(MPI_GROUP_WORLD, 1, range_cpl, & + MPI_GROUP_CPL, ierr) + + if (ntasks_atm > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_ATM, & + MPI_COMM_ATM, ierr) + + if (ntasks_ocn > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_OCN, & + MPI_COMM_OCN, ierr) + + if (ntasks_ice > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_ICE, & + MPI_COMM_ICE, ierr) + + if (ntasks_lnd > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_LND, & + MPI_COMM_LND, ierr) + + if (ntasks_glc > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_GLC, & + MPI_COMM_GLC, ierr) + + if (ntasks_cpl > 0) & + call MPI_COMM_CREATE (MPI_COMM_WORLD, MPI_GROUP_CPL, & + MPI_COMM_CPL, ierr) + +#else + MPI_COMM_GLC = 0 +#endif +!----------------------------------------------------------------------- +!EOC + + end subroutine create_glc_communicator + +!*********************************************************************** +!BOP +! !IROUTINE: create_communicator +! !INTERFACE: + + subroutine create_communicator(new_comm, num_procs) + +! !DESCRIPTION: +! This routine creates a separate communicator for a subset of +! processors under default ocean communicator. +! +! this routine should be called from init_domain1 when the +! domain configuration (e.g. nprocs_btrop) has been determined +! +! !REVISION HISTORY: +! same as module + +#ifdef coupled +! !INCLUDES: + + include 'mpif.h' + +#endif +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + num_procs ! num of procs in new distribution + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + new_comm ! new communicator for this distribution + +!EOP +!BOC +#ifdef coupled +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + MPI_GROUP_GLC, &! group of processors assigned to glc + MPI_GROUP_NEW ! group of processors assigned to new dist + + integer (int_kind) :: & + ierr ! error flag for MPI comms + + integer (int_kind), dimension(3) :: & + range ! range of tasks assigned to new dist + ! (assumed 0,num_procs-1) + +!----------------------------------------------------------------------- +! +! determine group of processes assigned to distribution +! +!----------------------------------------------------------------------- + + call MPI_COMM_GROUP (MPI_COMM_GLC, MPI_GROUP_GLC, ierr) + + range(1) = 0 + range(2) = num_procs-1 + range(3) = 1 + +!----------------------------------------------------------------------- +! +! create subroup and communicator for new distribution +! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_GLC +! +!----------------------------------------------------------------------- + + call MPI_GROUP_RANGE_INCL(MPI_GROUP_GLC, 1, range, & + MPI_GROUP_NEW, ierr) + + call MPI_COMM_CREATE (MPI_COMM_GLC, MPI_GROUP_NEW, & + new_comm, ierr) + +#else + new_comm = MPI_COMM_GLC +#endif +!----------------------------------------------------------------------- +!EOC + + end subroutine create_communicator + +!*********************************************************************** + + end module glc_communicate + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/glc_gather_scatter.F90 b/components/cism/serial/glc_gather_scatter.F90 new file mode 100644 index 0000000000..6af2eb9328 --- /dev/null +++ b/components/cism/serial/glc_gather_scatter.F90 @@ -0,0 +1,879 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! !MODULE: glc_gather_scatter + + module glc_gather_scatter + +! !DESCRIPTION: +! This module contains routines for gathering data to a single +! processor from a distributed array, and scattering data from a +! single processor to a distributed array. +! +! !REVISION HISTORY: +! +! author: Phil Jones, LANL +! Adapted from POP version by William Lipscomb, LANL + +! !USES: + + use glc_kinds_mod + use glc_communicate + use glc_constants + use glc_blocks + use glc_distribution + use glc_domain + use glc_domain_size + use glc_exit_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: gather_global, & + scatter_global + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! overload module functions +! +!----------------------------------------------------------------------- + + interface gather_global + module procedure gather_global_dbl, & + gather_global_real, & + gather_global_int + end interface + + interface scatter_global + module procedure scatter_global_dbl, & + scatter_global_real, & + scatter_global_int + end interface + +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: gather_global +! !INTERFACE: + + subroutine gather_global_dbl(ARRAY_G, ARRAY, dst_task, src_dist) + +! !DESCRIPTION: +! This subroutine gathers a distributed array to a global-sized +! array on the processor dst_task. +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is the specific inteface for double precision arrays +! corresponding to the generic interface gather_global. It is shown +! to provide information on the generic interface (the generic +! interface is identical, but chooses a specific inteface based +! on the data type of the input argument). + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + dst_task ! task to which array should be gathered + + type (distrb), intent(in) :: & + src_dist ! distribution of blocks in the source array + + real (r8), dimension(:,:,:), intent(in) :: & + ARRAY ! array containing horizontal slab of distributed field + +! !OUTPUT PARAMETERS: + + real (r8), dimension(:,:), intent(inout) :: & + ARRAY_G ! array containing global horizontal field on dst_task + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n ,&! dummy loop counters + src_block ! local block index in source distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! copy local array into block decomposition +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + this_block = get_block(n,n) + + !*** copy local blocks + + if (src_dist%proc(n) /= 0) then + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = & + ARRAY(i,j,src_dist%local_block(n)) + end do + end do + + else !*** fill land blocks with zeroes + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = c0 + end do + end do + + endif + + end do + +!----------------------------------------------------------------------- + + end subroutine gather_global_dbl + +!*********************************************************************** + + subroutine gather_global_real(ARRAY_G, ARRAY, dst_task, src_dist) + +!----------------------------------------------------------------------- +! +! This subroutine gathers a distributed array to a global-sized +! array on the processor dst_task. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + dst_task ! task to which array should be gathered + + type (distrb), intent(in) :: & + src_dist ! distribution of blocks in the source array + + real (r4), dimension(:,:,:), intent(in) :: & + ARRAY ! array containing distributed field + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:), intent(inout) :: & + ARRAY_G ! array containing global field on dst_task + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n ,&! dummy loop counters + src_block ! local block index in source distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! copy local array into block decomposition +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + this_block = get_block(n,n) + + !*** copy local blocks + + if (src_dist%proc(n) /= 0) then + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = & + ARRAY(i,j,src_dist%local_block(n)) + end do + end do + + else !*** fill land blocks with zeroes + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = c0 + end do + end do + + endif + + end do + +!----------------------------------------------------------------------- + + end subroutine gather_global_real + +!*********************************************************************** + + subroutine gather_global_int(ARRAY_G, ARRAY, dst_task, src_dist) + +!----------------------------------------------------------------------- +! +! This subroutine gathers a distributed array to a global-sized +! array on the processor dst_task. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + dst_task ! task to which array should be gathered + + type (distrb), intent(in) :: & + src_dist ! distribution of blocks in the source array + + integer (int_kind), dimension(:,:,:), intent(in) :: & + ARRAY ! array containing distributed field + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:), intent(inout) :: & + ARRAY_G ! array containing global field on dst_task + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n, &! dummy loop counters + src_block ! local block index in source distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! copy local array into block decomposition +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + this_block = get_block(n,n) + + !*** copy local blocks + + if (src_dist%proc(n) /= 0) then + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = & + ARRAY(i,j,src_dist%local_block(n)) + end do + end do + + else !*** fill land blocks with zeroes + + do j=this_block%jlo,this_block%jhi + do i=this_block%ilo,this_block%ihi + ARRAY_G(this_block%i_glob(i), & + this_block%j_glob(j)) = c0 + end do + end do + + endif + + end do + +!----------------------------------------------------------------------- + + end subroutine gather_global_int + +!EOC +!*********************************************************************** +!BOP +! !IROUTINE: scatter_global +! !INTERFACE: + + subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & + field_loc, field_type) + +! !DESCRIPTION: +! This subroutine scatters a global-sized array on the processor +! src\_task to a distribution of blocks given by dst\_dist. +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is the specific interface for double precision arrays +! corresponding to the generic interface scatter_global. It is shown +! to provide information on the generic interface (the generic +! interface is identical, but chooses a specific interface based +! on the data type of the input argument). + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + src_task ! task from which array should be scattered + + type (distrb), intent(in) :: & + dst_dist ! distribution of resulting blocks + + real (r8), dimension(:,:), intent(in) :: & + ARRAY_G ! array containing global field on src_task + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + field_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + +! !OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing distributed field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, &! dummy loop indices + isrc, jsrc, &! source addresses + xoffset, yoffset, &! offsets for tripole boundary conditions + isign, &! sign factor for tripole boundary conditions + dst_block ! local block index in dest distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! initialize return array to zero and set up tripole quantities +! +!----------------------------------------------------------------------- + + ARRAY = c0 + + select case (field_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + case (field_loc_noupdate) ! ghost cells not needed - use cell center + xoffset = 1 + yoffset = 1 + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case (field_type_noupdate) ! ghost cells not needed - use cell center + isign = 1 + case default + call abort_glc('Unknown field type in scatter') + end select + +!----------------------------------------------------------------------- +! +! copy blocks of global array into local block distribution +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + if (dst_dist%proc(n) /= 0) then + + this_block = get_block(n,n) + dst_block = dst_dist%local_block(n) + + !*** if this is an interior block, then there is no + !*** padding or update checking required + + if (this_block%iblock > 1 .and. & + this_block%iblock < nblocks_x .and. & + this_block%jblock > 1 .and. & + this_block%jblock < nblocks_y) then + + do j=1,ny_block + do i=1,nx_block + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + end do + end do + + !*** if this is an edge block but not a northern edge + !*** we only need to check for closed boundaries and + !*** padding (global index = 0) + + else if (this_block%jblock /= nblocks_y) then + + do j=1,ny_block + if (this_block%j_glob(j) /= 0) then + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + endif + end do + + !*** if this is a northern edge block, we need to check + !*** for and properly deal with tripole boundaries + + else + + do j=1,ny_block + if (this_block%j_glob(j) > 0) then ! normal boundary + + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + + else if (this_block%j_glob(j) < 0) then ! tripole + + jsrc = ny_global + yoffset + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + endif + end do + + endif + end do + + endif + endif ! dst block not land + end do ! block loop + +!----------------------------------------------------------------------- + + end subroutine scatter_global_dbl + +!*********************************************************************** + + subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & + field_loc, field_type) + +!----------------------------------------------------------------------- +! +! This subroutine scatters a global-sized array on the processor +! src\_task to a distribution of blocks given by dst\_dist. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + src_task ! task from which array should be scattered + + type (distrb), intent(in) :: & + dst_dist ! distribution of resulting blocks + + real (r4), dimension(:,:), intent(in) :: & + ARRAY_G ! array containing global field on src_task + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + field_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing distributed field + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, &! dummy loop indices + isrc, jsrc, &! source addresses + xoffset, yoffset, &! offsets for tripole boundary conditions + isign, &! sign factor for tripole boundary conditions + dst_block ! local block index in dest distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! initialize return array to zero and set up tripole quantities +! +!----------------------------------------------------------------------- + + ARRAY = c0 + + select case (field_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + case (field_loc_noupdate) ! ghost cells not needed - use cell center + xoffset = 1 + yoffset = 1 + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case (field_type_noupdate) ! ghost cells not needed - use cell center + isign = 1 + case default + call abort_glc('Unknown field type in scatter') + end select + +!----------------------------------------------------------------------- +! +! copy blocks of global array into local block distribution +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + if (dst_dist%proc(n) /= 0) then + + this_block = get_block(n,n) + dst_block = dst_dist%local_block(n) + + !*** if this is an interior block, then there is no + !*** padding or update checking required + + if (this_block%iblock > 1 .and. & + this_block%iblock < nblocks_x .and. & + this_block%jblock > 1 .and. & + this_block%jblock < nblocks_y) then + + do j=1,ny_block + do i=1,nx_block + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + end do + end do + + !*** if this is an edge block but not a northern edge + !*** we only need to check for closed boundaries and + !*** padding (global index = 0) + + else if (this_block%jblock /= nblocks_y) then + + do j=1,ny_block + if (this_block%j_glob(j) /= 0) then + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + endif + end do + + !*** if this is a northern edge block, we need to check + !*** for and properly deal with tripole boundaries + + else + + do j=1,ny_block + if (this_block%j_glob(j) > 0) then ! normal boundary + + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + + else if (this_block%j_glob(j) < 0) then ! tripole + + jsrc = ny_global + yoffset + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + endif + end do + + endif + end do + + endif + endif ! dst block not land + end do ! block loop + +!----------------------------------------------------------------------- + + end subroutine scatter_global_real + +!*********************************************************************** + + subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & + field_loc, field_type) + +!----------------------------------------------------------------------- +! +! This subroutine scatters a global-sized array on the processor +! src\_task to a distribution of blocks given by dst\_dist. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + src_task ! task from which array should be scattered + + type (distrb), intent(in) :: & + dst_dist ! distribution of resulting blocks + + integer (int_kind), dimension(:,:), intent(in) :: & + ARRAY_G ! array containing global field on src_task + + integer (int_kind), intent(in) :: & + field_type, &! id for type of field (scalar, vector, angle) + field_loc ! id for location on horizontal grid + ! (center, NEcorner, Nface, Eface) + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), intent(inout) :: & + ARRAY ! array containing distributed field + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, &! dummy loop indices + isrc, jsrc, &! source addresses + xoffset, yoffset, &! offsets for tripole boundary conditions + isign, &! sign factor for tripole boundary conditions + dst_block ! local block index in dest distribution + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! initialize return array to zero and set up tripole quantities +! +!----------------------------------------------------------------------- + + ARRAY = c0 + + select case (field_loc) + case (field_loc_center) ! cell center location + xoffset = 1 + yoffset = 1 + case (field_loc_NEcorner) ! cell corner (velocity) location + xoffset = 0 + yoffset = 0 + case (field_loc_Eface) ! cell center location + xoffset = 0 + yoffset = 1 + case (field_loc_Nface) ! cell corner (velocity) location + xoffset = 1 + yoffset = 0 + case (field_loc_noupdate) ! ghost cells not needed - use cell center + xoffset = 1 + yoffset = 1 + end select + + select case (field_type) + case (field_type_scalar) + isign = 1 + case (field_type_vector) + isign = -1 + case (field_type_angle) + isign = -1 + case (field_type_noupdate) ! ghost cells not needed - use cell center + isign = 1 + case default + call abort_glc('Unknown field type in scatter') + end select + +!----------------------------------------------------------------------- +! +! copy blocks of global array into local block distribution +! +!----------------------------------------------------------------------- + + do n=1,nblocks_tot + + if (dst_dist%proc(n) /= 0) then + + this_block = get_block(n,n) + dst_block = dst_dist%local_block(n) + + !*** if this is an interior block, then there is no + !*** padding or update checking required + + if (this_block%iblock > 1 .and. & + this_block%iblock < nblocks_x .and. & + this_block%jblock > 1 .and. & + this_block%jblock < nblocks_y) then + + do j=1,ny_block + do i=1,nx_block + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + end do + end do + + !*** if this is an edge block but not a northern edge + !*** we only need to check for closed boundaries and + !*** padding (global index = 0) + + else if (this_block%jblock /= nblocks_y) then + + do j=1,ny_block + if (this_block%j_glob(j) /= 0) then + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + endif + end do + + !*** if this is a northern edge block, we need to check + !*** for and properly deal with tripole boundaries + + else + + do j=1,ny_block + if (this_block%j_glob(j) > 0) then ! normal boundary + + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + ARRAY(i,j,dst_block) = ARRAY_G(this_block%i_glob(i),& + this_block%j_glob(j)) + endif + end do + + else if (this_block%j_glob(j) < 0) then ! tripole + + jsrc = ny_global + yoffset + & + (this_block%j_glob(j) + ny_global) + do i=1,nx_block + if (this_block%i_glob(i) /= 0) then + isrc = nx_global + xoffset - this_block%i_glob(i) + if (isrc < 1) isrc = isrc + nx_global + if (isrc > nx_global) isrc = isrc - nx_global + ARRAY(i,j,dst_block) = ARRAY_G(isrc,jsrc) + endif + end do + + endif + end do + + endif + endif ! dst block not land + end do ! block loop + +!----------------------------------------------------------------------- + + end subroutine scatter_global_int + +!EOC +!*********************************************************************** + + end module glc_gather_scatter + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/glc_global_reductions.F90 b/components/cism/serial/glc_global_reductions.F90 new file mode 100644 index 0000000000..9449f838d0 --- /dev/null +++ b/components/cism/serial/glc_global_reductions.F90 @@ -0,0 +1,1723 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + +!BOP +! !MODULE: glc_global_reductions + + module glc_global_reductions + +! !DESCRIPTION: +! This module contains all the routines for performing global +! reductions like global sums, minvals, maxvals, etc. +! +! !REVISION HISTORY: +! +! author: Phil Jones, LANL +! Adapted from POP version by William Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + use glc_communicate + use glc_constants + use glc_blocks + use glc_distribution + use glc_domain_size + !use glc_domain ! commented out because it gives circular dependence + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: global_sum, & + global_sum_prod, & + global_maxval, & + global_minval, & + init_global_reductions + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! generic interfaces for module procedures +! +!----------------------------------------------------------------------- + + interface global_sum + module procedure global_sum_dbl, & + global_sum_real, & + global_sum_int, & + global_sum_scalar_dbl, & + global_sum_scalar_real, & + global_sum_scalar_int + end interface + + interface global_sum_prod + module procedure global_sum_prod_dbl, & + global_sum_prod_real, & + global_sum_prod_int + end interface + + interface global_maxval + module procedure global_maxval_dbl, & + global_maxval_real, & + global_maxval_int, & + global_maxval_scalar_dbl, & + global_maxval_scalar_real, & + global_maxval_scalar_int + end interface + + interface global_minval + module procedure global_minval_dbl, & + global_minval_real, & + global_minval_int, & + global_minval_scalar_dbl, & + global_minval_scalar_real, & + global_minval_scalar_int + end interface + +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + !integer (int_kind) :: timer_local, timer_mpi + logical(log_kind) :: ltripole_grid ! in lieu of use domain + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_global_reductions +! !INTERFACE: + + subroutine init_global_reductions(tripole_flag) + +! !DESCRIPTION: +! Initializes necessary buffers for global reductions. +! +! !REVISION HISTORY: +! same as module +! !INPUT PARAMETERS: +! + logical(log_kind), intent(in) :: tripole_flag +! +!EOP +!BOC + + ltripole_grid = tripole_flag + +!EOC + + end subroutine init_global_reductions + +!*********************************************************************** +!BOP +! !IROUTINE: global_sum +! !INTERFACE: + + function global_sum_dbl(X, dist, field_loc, MASK) + +! !DESCRIPTION: +! computes the global sum of the _physical domain_ of a 2-d +! array. +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic global_sum +! function corresponding to double precision arrays. The generic +! interface is identical but will handle real and integer 2-d slabs +! and real, integer, and double precision scalars. + +! !INPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(in) :: & + X ! array to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), dimension(size(X,dim=1), & + size(X,dim=2), & + size(X,dim=3)), intent(in), optional :: & + MASK ! real multiplicative mask + +! !OUTPUT PARAMETERS: + + real (r8) :: & + global_sum_dbl ! resulting global sum + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_dbl = c0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = & + local_block_sum + X(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + X(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_dbl = global_sum_dbl + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_dbl = global_sum_dbl + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_dbl + +!*********************************************************************** + + function global_sum_real(X, dist, field_loc, MASK) + +!----------------------------------------------------------------------- +! +! computes the global sum of the _physical domain_ of a 2-d +! array. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:,:), intent(in) :: & + X ! array to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), dimension(size(X,dim=1), & + size(X,dim=2), & + size(X,dim=3)), intent(in), optional :: & + MASK ! real multiplicative mask + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + real (r4) :: & + global_sum_real ! resulting global sum + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_real = c0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = & + local_block_sum + X(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + X(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_real = global_sum_real + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_real = global_sum_real + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_real + +!*********************************************************************** + + function global_sum_int(X, dist, field_loc, MASK) + +!----------------------------------------------------------------------- +! +! computes the global sum of the _physical domain_ of a 2-d +! array. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), intent(in) :: & + X ! array to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), dimension(size(X,dim=1), & + size(X,dim=2), & + size(X,dim=3)), intent(in), optional :: & + MASK ! real multiplicative mask + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + global_sum_int ! resulting global sum + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_int = 0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = & + local_block_sum + X(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + X(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_int = global_sum_int + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid) + end do + end do + endif + global_sum_int = global_sum_int + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_int + +!*********************************************************************** + + function global_sum_scalar_dbl(local_scalar, dist) + +!----------------------------------------------------------------------- +! +! this function returns the sum of scalar value across processors +! +!----------------------------------------------------------------------- + + type (distrb), intent(in) :: & + dist ! distribution from which this is called + + real (r8), intent(in) :: & + local_scalar ! local scalar to be compared + + real (r8) :: & + global_sum_scalar_dbl ! sum of scalars across processors + +!----------------------------------------------------------------------- +! +! no operation needed for serial execution +! +!----------------------------------------------------------------------- + + global_sum_scalar_dbl = local_scalar + +!----------------------------------------------------------------------- + + end function global_sum_scalar_dbl + +!*********************************************************************** + + function global_sum_scalar_real(local_scalar, dist) + +!----------------------------------------------------------------------- +! +! this function returns the sum of scalar value across processors +! +!----------------------------------------------------------------------- + + real (r4), intent(in) :: & + local_scalar ! local scalar to be compared + + type (distrb), intent(in) :: & + dist ! distribution from which this is called + + real (r4) :: & + global_sum_scalar_real ! sum of scalars across processors + +!----------------------------------------------------------------------- +! +! no operation needed for serial execution +! +!----------------------------------------------------------------------- + + global_sum_scalar_real = local_scalar + +!----------------------------------------------------------------------- + + end function global_sum_scalar_real + +!*********************************************************************** + + function global_sum_scalar_int(local_scalar, dist) + +!----------------------------------------------------------------------- +! +! this function returns the sum of scalar value across processors +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + local_scalar ! local scalar to be compared + + type (distrb), intent(in) :: & + dist ! distribution from which this is called + + integer (int_kind) :: & + global_sum_scalar_int ! sum of scalars across processors + +!----------------------------------------------------------------------- +! +! no operation needed for serial execution +! +!----------------------------------------------------------------------- + + global_sum_scalar_int = local_scalar + +!----------------------------------------------------------------------- + + end function global_sum_scalar_int + +!EOC +!*********************************************************************** +!BOP +! !IROUTINE: global_sum_prod +! !INTERFACE: + + function global_sum_prod_dbl (X, Y, dist, field_loc, MASK) + +! !DESCRIPTION: +! this routine performs a global sum over the physical domain +! of a product of two 2-d arrays. +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic +! global_sum_prod function corresponding to double precision arrays. +! The generic interface is identical but will handle real and integer +! 2-d slabs. + +! !INPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(in) :: & + X, &! first array in product to be summed + Y ! second array in product to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X,Y + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + MASK ! real multiplicative mask + +! !OUTPUT PARAMETERS: + + real (r8) :: & + global_sum_prod_dbl ! resulting global sum of X*Y + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_prod_dbl = c0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_dbl = global_sum_prod_dbl + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_dbl = global_sum_prod_dbl + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_prod_dbl + +!*********************************************************************** + + function global_sum_prod_real (X, Y, dist, field_loc, MASK) + +!----------------------------------------------------------------------- +! +! this routine performs a global sum over the physical domain +! of a product of two 2-d arrays. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:,:), intent(in) :: & + X, &! first array in product to be summed + Y ! second array in product to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X,Y + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + MASK ! real multiplicative mask + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + real (r4) :: & + global_sum_prod_real ! resulting global sum of X*Y + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_prod_real = c0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_real = global_sum_prod_real + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_real = global_sum_prod_real + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_prod_real + +!*********************************************************************** + + function global_sum_prod_int (X, Y, dist, field_loc, MASK) + +!----------------------------------------------------------------------- +! +! this routine performs a global sum over the physical domain +! of a product of two 2-d arrays. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), intent(in) :: & + X, &! first array in product to be summed + Y ! second array in product to be summed + + type (distrb), intent(in) :: & + dist ! block distribution for array X,Y + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + real (r8), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + MASK ! real multiplicative mask + +!----------------------------------------------------------------------- +! +! output variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + global_sum_prod_int ! resulting global sum of X*Y + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + local_block_sum ! sum of local block domain + + integer (int_kind) :: & + i,j,n, &! local counters + ib,ie,jb,je, &! beg,end of physical domain + bid ! block location + + type (block) :: & + this_block ! block information for local block + +!----------------------------------------------------------------------- + + global_sum_prod_int = 0 + + if (ltripole_grid .and. (field_loc == field_loc_Nface .or. & + field_loc == field_loc_NEcorner)) then + !*** must exclude redundant points + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + this_block = get_block(n,bid) + ib = this_block%ilo + ie = this_block%ihi + jb = this_block%jlo + je = this_block%jhi + local_block_sum = c0 + if (this_block%jblock == nblocks_y) then + !*** for the topmost row, half the points are + !*** redundant so sum only the first half + if (present(MASK)) then + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid)*MASK(i,je,bid) + end do + else ! no mask + do i=ib,ie + if (this_block%i_glob(i) <= nx_global/2) & + local_block_sum = local_block_sum + & + X(i,je,bid)*Y(i,je,bid) + end do + endif + je = je - 1 + endif + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_int = global_sum_prod_int + local_block_sum + endif + end do + else ! normal global sum + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + local_block_sum = c0 + if (present(MASK)) then + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid)*MASK(i,j,bid) + end do + end do + else + do j=jb,je + do i=ib,ie + local_block_sum = & + local_block_sum + X(i,j,bid)*Y(i,j,bid) + end do + end do + endif + global_sum_prod_int = global_sum_prod_int + local_block_sum + endif + end do + endif + +!----------------------------------------------------------------------- + + end function global_sum_prod_int + +!EOC +!*********************************************************************** +!BOP +! !IROUTINE: global_maxval +! !INTERFACE: + + function global_maxval_dbl (X, dist, field_loc, LMASK) + +! !DESCRIPTION: +! This function computes the global maxval of the physical domain +! of a 2-d field +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic global_maxval +! function corresponding to double precision arrays. The generic +! interface is identical but will handle real and integer 2-d slabs. + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + real (r8), dimension(:,:,:), intent(in) :: & + X ! array containing field for which max required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + real (r8) :: & + global_maxval_dbl ! resulting max val of global domain + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_maxval_dbl = -bignum + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_maxval_dbl = max(global_maxval_dbl, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_maxval_dbl = max(global_maxval_dbl, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- + + end function global_maxval_dbl + +!*********************************************************************** + + function global_maxval_real (X, dist, field_loc, LMASK) + +!----------------------------------------------------------------------- +! +! this function computes the global maxval of the physical domain +! of a 2-d field +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:,:), intent(in) :: & + X ! array containing field for which max required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + real (r4) :: & + global_maxval_real ! resulting max val of global domain + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_maxval_real = -bignum + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_maxval_real = max(global_maxval_real, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_maxval_real = max(global_maxval_real, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- + + end function global_maxval_real + +!*********************************************************************** + + function global_maxval_int (X, dist, field_loc, LMASK) + +!----------------------------------------------------------------------- +! +! this function computes the global maxval of the physical domain +! of a 2-d field +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), intent(in) :: & + X ! array containing field for which max required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + global_maxval_int ! resulting max val of global domain + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_maxval_int = -1000000 + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_maxval_int = max(global_maxval_int, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_maxval_int = max(global_maxval_int, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- +!EOC + + end function global_maxval_int + +!*********************************************************************** +!BOP +! !IROUTINE: global_minval +! !INTERFACE: + + function global_minval_dbl (X, dist, field_loc, LMASK) + +! !DESCRIPTION: +! This function computes the global minval of the physical domain +! of a 2-d field +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic global_minval +! function corresponding to double precision arrays. The generic +! interface is identical but will handle real and integer 2-d slabs. + +! !INPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(in) :: & + X ! array containing field for which min required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +! !OUTPUT PARAMETERS: + + real (r8) :: & + global_minval_dbl ! resulting min val of global domain + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_minval_dbl = bignum + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_minval_dbl = min(global_minval_dbl, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_minval_dbl = min(global_minval_dbl, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- + + end function global_minval_dbl + +!*********************************************************************** + + function global_minval_real (X, dist, field_loc, LMASK) + +!----------------------------------------------------------------------- +! +! this function computes the global minval of the physical domain +! of a 2-d field +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:,:), intent(in) :: & + X ! array containing field for which min required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + real (r4) :: & + global_minval_real ! resulting min val of global domain + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_minval_real = bignum + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_minval_real = min(global_minval_real, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_minval_real = min(global_minval_real, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- + + end function global_minval_real + +!*********************************************************************** + + function global_minval_int (X, dist, field_loc, LMASK) + +!----------------------------------------------------------------------- +! +! this function computes the global minval of the physical domain +! of a 2-d field +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input vars +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(:,:,:), intent(in) :: & + X ! array containing field for which min required + + type (distrb), intent(in) :: & + dist ! block distribution for array X + + integer (int_kind), intent(in) :: & + field_loc ! location of field on staggered grid + + logical (log_kind), & + dimension(size(X,dim=1),size(X,dim=2),size(X,dim=3)), & + intent(in), optional :: & + LMASK ! mask for excluding parts of domain + +!----------------------------------------------------------------------- +! +! output result +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + global_minval_int ! resulting min val of global domain + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n,bid, & + ib, ie, jb, je ! start,end of physical domain + +!----------------------------------------------------------------------- + + global_minval_int = 1000000 + + do n=1,nblocks_tot + if (dist%proc(n) /= 0) then + bid = dist%local_block(n) + call get_block_parameter(n,ilo=ib,ihi=ie,jlo=jb,jhi=je) + if (present(LMASK)) then + do j=jb,je + do i=ib,ie + if (LMASK(i,j,bid)) then + global_minval_int = min(global_minval_int, & + X(i,j,bid)) + endif + end do + end do + else + do j=jb,je + do i=ib,ie + global_minval_int = min(global_minval_int, & + X(i,j,bid)) + end do + end do + endif + endif + end do + +!----------------------------------------------------------------------- + + end function global_minval_int + +!*********************************************************************** + + function global_maxval_scalar_dbl (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the maximum scalar value across processors +! +!----------------------------------------------------------------------- + + real (r8), intent(inout) :: & + local_scalar ! local scalar to be compared + + real (r8) :: & + global_maxval_scalar_dbl ! resulting global max + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_maxval_scalar_dbl = local_scalar + +!----------------------------------------------------------------------- + + end function global_maxval_scalar_dbl + +!*********************************************************************** + + function global_maxval_scalar_real (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the maximum scalar value across processors +! +!----------------------------------------------------------------------- + + real (r4), intent(inout) :: & + local_scalar ! local scalar to be compared + + real (r4) :: & + global_maxval_scalar_real ! resulting global max + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_maxval_scalar_real = local_scalar + +!----------------------------------------------------------------------- + + end function global_maxval_scalar_real + +!*********************************************************************** + + function global_maxval_scalar_int (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the maximum scalar value across processors +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(inout) :: & + local_scalar ! local scalar to be compared + + integer (int_kind) :: & + global_maxval_scalar_int ! resulting global max + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_maxval_scalar_int = local_scalar + +!----------------------------------------------------------------------- + + end function global_maxval_scalar_int + +!*********************************************************************** + + function global_minval_scalar_dbl (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the minimum scalar value across processors +! +!----------------------------------------------------------------------- + + real (r8), intent(inout) :: & + local_scalar ! local scalar to be compared + + real (r8) :: & + global_minval_scalar_dbl ! resulting global min + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_minval_scalar_dbl = local_scalar + +!----------------------------------------------------------------------- + + end function global_minval_scalar_dbl + +!*********************************************************************** + + function global_minval_scalar_real (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the minimum scalar value across processors +! +!----------------------------------------------------------------------- + + real (r4), intent(inout) :: & + local_scalar ! local scalar to be compared + + real (r4) :: & + global_minval_scalar_real ! resulting global min + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_minval_scalar_real = local_scalar + +!----------------------------------------------------------------------- + + end function global_minval_scalar_real + +!*********************************************************************** + + function global_minval_scalar_int (local_scalar) + +!----------------------------------------------------------------------- +! +! this function returns the minimum scalar value across processors +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(inout) :: & + local_scalar ! local scalar to be compared + + integer (int_kind) :: & + global_minval_scalar_int ! resulting global min + +!----------------------------------------------------------------------- +! +! no operations required for serial execution - return input value +! +!----------------------------------------------------------------------- + + global_minval_scalar_int = local_scalar + +!----------------------------------------------------------------------- + + end function global_minval_scalar_int + +!*********************************************************************** + + end module glc_global_reductions + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/serial/glc_timers.F90 b/components/cism/serial/glc_timers.F90 new file mode 100644 index 0000000000..1452abd614 --- /dev/null +++ b/components/cism/serial/glc_timers.F90 @@ -0,0 +1,926 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_timers + +!BOP +! !MODULE: glc_timers +! +! !DESCRIPTION: +! This module contains routine for supporting multiple CPU timers +! and accumulates time for each individual block and node (task). +! +! !REVISION HISTORY: +! SVN:$Id: ice_timers.F90 20 2006-09-01 17:09:49Z $ +! +! 2005: Adapted from POP by William Lipscomb +! Replaced 'stdout' by 'nu_diag' +! +! !USES: + + use glc_kinds_mod + use glc_constants + use glc_domain + use glc_global_reductions + use glc_exit_mod + use glc_fileunits, only: nu_diag + use glc_communicate, only: my_task, master_task + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_glc_timers, & + get_glc_timer, & + release_glc_timer, & + glc_timer_clear, & + glc_timer_start, & + glc_timer_stop, & + glc_timer_print, & + glc_timer_print_all, & + glc_timer_check + +!EOP +!BOC + +!----------------------------------------------------------------------- +! public timers +!lipscombmod - Timers are defined here instead of in individual modules. +! CICE modules commented out. Add timers as desired. +!----------------------------------------------------------------------- + + integer (int_kind), public :: & + timer_total, &! total time + timer_step, &! time stepping +!lipscomb - uncomment ifdef? +!!!#if (defined CCSM) || (defined SEQ_MCT) + timer_send_to_recv, &! time from send to receive + timer_recv_to_send, &! time from receive to send + timer_send_to_cpl, &! time sending to cpl + timer_recv_from_cpl, &! time receiving from cpl +!!!#endif + timer_out ! output +! timer_readwrite, &! read/write +! timer_bound ! boundary updates +! timer_tmp ! for temporary timings + +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + integer (int_kind), parameter :: & + max_timers = 50 ! max number of timers + + type timer_data + character (char_len) :: & + name ! timer name + + logical (log_kind) :: & + in_use, &! true if timer initialized + node_started ! true if any thread has started timer + + integer (int_kind) :: & + num_blocks, &! number of blocks using this timer + num_nodes, &! number of nodes using this timer + num_starts, &! number of start requests + num_stops ! number of stop requests + + real (dbl_kind) :: & + node_cycles1, &! cycle number at start for node timer + node_cycles2 ! cycle number at stop for node timer + + real (r8) :: & + node_accum_time ! accumulated time for node timer + + logical (log_kind), dimension(:), pointer :: & + block_started ! true if block timer started + + real (dbl_kind), dimension(:), pointer :: & + block_cycles1, &! cycle number at start for block timers + block_cycles2 ! cycle number at stop for block timers + + real (r8), dimension(:), pointer :: & + block_accum_time ! accumulated time for block timers + + end type + + type (timer_data), dimension(max_timers) :: & + all_timers ! timer data for all timers + + integer (int_kind) :: & + cycles_max ! max clock cycles allowed by system + + real (r8) :: & + clock_rate ! clock rate in seconds for each cycle + + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_glc_timers +! !INTERFACE: + + subroutine init_glc_timers + +! !DESCRIPTION: +! This routine initializes machine parameters and timer structures +! for computing cpu time from F90 intrinsic timer functions. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy loop counters + cycles ! count rate returned by sys_clock + +!----------------------------------------------------------------------- +! +! Call F90 intrinsic system_clock to determine clock rate +! and maximum cycles for single-processor runs. If no clock +! available, print message. +! +!----------------------------------------------------------------------- + + cycles = 0 + + call system_clock(count_rate=cycles, count_max=cycles_max) + + if (cycles /= 0) then + clock_rate = c1/real(cycles,kind=dbl_kind) + else + clock_rate = c0 + write(nu_diag,'(/,a33,/)') '--- No system clock available ---' + endif + +!----------------------------------------------------------------------- +! +! initialize timer structures +! +!----------------------------------------------------------------------- + + do n=1,max_timers + all_timers(n)%name = 'unknown_timer_name' + + all_timers(n)%in_use = .false. + all_timers(n)%node_started = .false. + + all_timers(n)%num_blocks = 0 + all_timers(n)%num_nodes = 0 + all_timers(n)%num_starts = 0 + all_timers(n)%num_stops = 0 + all_timers(n)%node_cycles1 = c0 + all_timers(n)%node_cycles2 = c0 + + all_timers(n)%node_accum_time = c0 + + nullify(all_timers(n)%block_started) + nullify(all_timers(n)%block_cycles1) + nullify(all_timers(n)%block_cycles2) + nullify(all_timers(n)%block_accum_time) + end do + +!lipscomb - CICE timers commented out. Add timers as desired. + call get_glc_timer(timer_total, 'Total', nblocks,distrb_info%nprocs) + call get_glc_timer(timer_step, 'Step', nblocks,distrb_info%nprocs) +!lipscomb - uncomment ifdef? +!!!#if (defined CCSM) || (defined SEQ_MCT) + call get_glc_timer(timer_send_to_cpl, 'Cpl-send', nblocks,distrb_info%nprocs) + call get_glc_timer(timer_recv_from_cpl,'Cpl-recv', nblocks,distrb_info%nprocs) + call get_glc_timer(timer_recv_to_send, 'Rcv->snd', nblocks,distrb_info%nprocs) + call get_glc_timer(timer_send_to_recv, 'Snd->rcv', nblocks,distrb_info%nprocs) +!!!#endif + call get_glc_timer(timer_total, 'Output', nblocks,distrb_info%nprocs) +! call get_glc_timer(timer_readwrite,'ReadWrite',nblocks,distrb_info%nprocs) +! call get_glc_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) +! call get_glc_timer(timer_tmp, ' ',nblocks,distrb_info%nprocs) + +!----------------------------------------------------------------------- +!EOC + + end subroutine init_glc_timers + +!*********************************************************************** +!BOP +! !IROUTINE: get_glc_timer +! !INTERFACE: + + subroutine get_glc_timer(timer_id, name_choice, num_blocks, num_nodes) + +! !DESCRIPTION: +! This routine initializes a timer with a given name and returns a +! timer id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + name_choice ! input name for this timer + + integer (int_kind), intent(in) :: & + num_nodes, &! number of nodes(tasks) using this timer + num_blocks ! number of blocks using this timer + ! (can be =1 if timer called outside + ! threaded region) + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + timer_id ! timer number assigned to this timer + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy loop index + srch_error ! error flag for search + +!----------------------------------------------------------------------- +! +! search for next free timer +! +!----------------------------------------------------------------------- + + srch_error = 1 + + srch_loop: do n=1,max_timers + if (.not. all_timers(n)%in_use) then + srch_error = 0 + timer_id = n + + all_timers(n)%name = ' ' + all_timers(n)%name = name_choice + all_timers(n)%in_use = .true. + all_timers(n)%num_blocks = num_blocks + all_timers(n)%num_nodes = num_nodes + + allocate(all_timers(n)%block_started (num_blocks), & + all_timers(n)%block_cycles1 (num_blocks), & + all_timers(n)%block_cycles2 (num_blocks), & + all_timers(n)%block_accum_time(num_blocks)) + + all_timers(n)%block_started = .false. + all_timers(n)%block_cycles1 = c0 + all_timers(n)%block_cycles2 = c0 + all_timers(n)%block_accum_time = c0 + + exit srch_loop + endif + end do srch_loop + + if (srch_error /= 0) & + call exit_glc(sigAbort, & + 'get_glc_timer: Exceeded maximum number of timers') + + +!----------------------------------------------------------------------- +!EOC + + end subroutine get_glc_timer + +!*********************************************************************** +!BOP +! !IROUTINE: release_glc_timer +! !INTERFACE: + + subroutine release_glc_timer(timer_id) + +! !DESCRIPTION: +! This routine frees up a timer which is no longer used. +! NOTE: This routine must be called from outside a threaded +! region. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if the timer has been defined, mark as not in use and re-initialize +! values. otherwise exit with an error +! +!----------------------------------------------------------------------- + + if (all_timers(timer_id)%in_use) then + + all_timers(timer_id)%name = 'unknown_timer_name' + + all_timers(timer_id)%in_use = .false. + all_timers(timer_id)%node_started = .false. + + all_timers(timer_id)%num_blocks = 0 + all_timers(timer_id)%num_nodes = 0 + all_timers(timer_id)%num_starts = 0 + all_timers(timer_id)%num_stops = 0 + all_timers(timer_id)%node_cycles1 = c0 + all_timers(timer_id)%node_cycles2 = c0 + + all_timers(timer_id)%node_accum_time = c0 + + nullify(all_timers(timer_id)%block_started) + nullify(all_timers(timer_id)%block_cycles1) + nullify(all_timers(timer_id)%block_cycles2) + nullify(all_timers(timer_id)%block_accum_time) + + else + call exit_glc (sigAbort, & + 'release_glc_timer: attempt to reset undefined timer') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine release_glc_timer + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_clear +! !INTERFACE: + + subroutine glc_timer_clear(timer_id) + +! !DESCRIPTION: +! This routine resets the time for a timer which has already been +! defined. NOTE: This routine must be called from outside a threaded +! region to ensure correct reset of block timers. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if the timer has been defined, reset all times to 0 +! otherwise exit with an error +! +!----------------------------------------------------------------------- + + if (all_timers(timer_id)%in_use) then + all_timers(timer_id)%node_started = .false. + all_timers(timer_id)%num_starts = 0 + all_timers(timer_id)%num_stops = 0 + all_timers(timer_id)%node_cycles1 = c0 + all_timers(timer_id)%node_cycles2 = c0 + + all_timers(timer_id)%node_accum_time = c0 + + all_timers(timer_id)%block_started(:) = .false. + all_timers(timer_id)%block_cycles1(:) = c0 + all_timers(timer_id)%block_cycles2(:) = c0 + all_timers(timer_id)%block_accum_time(:) = c0 + else + call exit_glc (sigAbort, & + 'glc_timer_clear: attempt to reset undefined timer') + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_clear + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_start +! !INTERFACE: + + subroutine glc_timer_start(timer_id, block_id) + +! !DESCRIPTION: +! This routine starts a given node timer if it has not already +! been started by another thread. If block information is available, +! the appropriate block timer is also started. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + + integer (int_kind), intent(in), optional :: & + block_id ! optional block id for this block + ! this must be the actual local address + ! of the block in the distribution + ! from which it is called + ! (if timer called outside of block + ! region, no block info required) + + integer (int_kind) :: & + cycles ! count rate return by sys_clock + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if timer is defined, start it up +! +!----------------------------------------------------------------------- + + if (all_timers(timer_id)%in_use) then + + !*** + !*** if called from within a block loop, start block timers + !*** + + if (present(block_id)) then + + !*** if block timer already started, stop it first + + if (all_timers(timer_id)%block_started(block_id)) & + call glc_timer_stop(timer_id, block_id) + + !*** start block timer + + all_timers(timer_id)%block_started(block_id) = .true. + call system_clock(count=cycles) + all_timers(timer_id)%block_cycles1(block_id) = real(cycles,kind=dbl_kind) + + !*** start node timer if not already started by + !*** another thread. if already started, keep track + !*** of number of start requests in order to match + !*** start and stop requests + + !$OMP CRITICAL + + if (.not. all_timers(timer_id)%node_started) then + all_timers(timer_id)%node_started = .true. + all_timers(timer_id)%num_starts = 1 + all_timers(timer_id)%num_stops = 0 + call system_clock(count=cycles) + all_timers(timer_id)%node_cycles1 = real(cycles,kind=dbl_kind) + else + all_timers(timer_id)%num_starts = & + all_timers(timer_id)%num_starts + 1 + endif + + !$OMP END CRITICAL + + !*** + !*** if called from outside a block loop, start node timer + !*** + + else + + !*** stop timer if already started + if (all_timers(timer_id)%node_started) & + call glc_timer_stop(timer_id) + + !*** start node timer + + all_timers(timer_id)%node_started = .true. + call system_clock(count=cycles) + all_timers(timer_id)%node_cycles1 = real(cycles,kind=dbl_kind) + + endif + else + call exit_glc (sigAbort, & + 'glc_timer_start: attempt to start undefined timer') + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_start + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_stop +! !INTERFACE: + + subroutine glc_timer_stop(timer_id, block_id) + +! !DESCRIPTION: +! This routine stops a given node timer if appropriate. If block +! information is available the appropriate block timer is also stopped. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + + integer (int_kind), intent(in), optional :: & + block_id ! optional block id for this block + ! this must be the actual local address + ! of the block in the distribution + ! from which it is called + ! (if timer called outside of block + ! region, no block info required) + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (dbl_kind) :: & + cycles1, cycles2 ! temps to hold cycle info before correction + + integer (int_kind) :: & + cycles ! count rate returned by sys_clock + +!----------------------------------------------------------------------- +! +! get end cycles +! +!----------------------------------------------------------------------- + + call system_clock(count=cycles) + cycles2 = real(cycles,kind=dbl_kind) + +!----------------------------------------------------------------------- +! +! if timer is defined, stop it +! +!----------------------------------------------------------------------- + + if (all_timers(timer_id)%in_use) then + + !*** + !*** if called from within a block loop, stop block timer + !*** + + if (present(block_id)) then + + all_timers(timer_id)%block_started(block_id) = .false. + + !*** correct for cycle wraparound and accumulate time + + cycles1 = all_timers(timer_id)%block_cycles1(block_id) + if (cycles2 >= cycles1) then + all_timers(timer_id)%block_accum_time(block_id) = & + all_timers(timer_id)%block_accum_time(block_id) + & + clock_rate*(cycles2 - cycles1) + else + all_timers(timer_id)%block_accum_time(block_id) = & + all_timers(timer_id)%block_accum_time(block_id) + & + clock_rate*(cycles_max + cycles2 - cycles1) + endif + + !*** stop node timer if number of requested stops + !*** matches the number of starts (to avoid stopping + !*** a node timer started by multiple threads) + + cycles1 = all_timers(timer_id)%node_cycles1 + + !$OMP CRITICAL + + all_timers(timer_id)%num_stops = & + all_timers(timer_id)%num_stops + 1 + + if (all_timers(timer_id)%num_starts == & + all_timers(timer_id)%num_stops) then + + all_timers(timer_id)%node_started = .false. + if (cycles2 >= cycles1) then + all_timers(timer_id)%node_accum_time = & + all_timers(timer_id)%node_accum_time + & + clock_rate*(cycles2 - cycles1) + else + all_timers(timer_id)%node_accum_time = & + all_timers(timer_id)%node_accum_time + & + clock_rate*(cycles_max + cycles2 - cycles1) + endif + + all_timers(timer_id)%num_starts = 0 + all_timers(timer_id)%num_stops = 0 + + endif + + !$OMP END CRITICAL + + !*** + !*** if called from outside a block loop, stop node timer + !*** + + else + + !*** correct for wraparound and accumulate time + + all_timers(timer_id)%node_started = .false. + cycles1 = all_timers(timer_id)%node_cycles1 + + if (cycles2 >= cycles1) then + all_timers(timer_id)%node_accum_time = & + all_timers(timer_id)%node_accum_time + & + clock_rate*(cycles2 - cycles1) + else + all_timers(timer_id)%node_accum_time = & + all_timers(timer_id)%node_accum_time + & + clock_rate*(cycles_max + cycles2 - cycles1) + endif + + endif + else + call exit_glc (sigAbort, & + 'glc_timer_start: attempt to start undefined timer') + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_stop + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_print +! !INTERFACE: + + subroutine glc_timer_print(timer_id,stats) + +! !DESCRIPTION: +! Prints the accumulated time for a given timer and optional +! statistics for that timer. It is assumed that this routine +! is called outside of a block loop. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + + logical (log_kind), intent(in), optional :: & + stats ! if true, print statistics for node + ! and block times for this timer + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n,icount ! dummy loop index and counter + + logical (log_kind) :: & + lrestart_timer ! flag to restart timer if timer is running + ! when this routine is called + + real (r8) :: & + local_time, &! temp space for holding local timer results + min_time, &! minimum accumulated time + max_time, &! maximum accumulated time + mean_time ! mean accumulated time + + character (41), parameter :: & + timer_format = "('Timer ',i3,': ',a9,f11.2,' seconds')" + + character (49), parameter :: & + stats_fmt1 = "(' Timer stats (node): min = ',f11.2,' seconds')",& + stats_fmt2 = "(' max = ',f11.2,' seconds')",& + stats_fmt3 = "(' mean= ',f11.2,' seconds')",& + stats_fmt4 = "(' Timer stats(block): min = ',f11.2,' seconds')" + +!----------------------------------------------------------------------- +! +! if timer has been defined, check to see whether it is currently +! running. If it is, stop the timer and print the info. +! +!----------------------------------------------------------------------- + + if (all_timers(timer_id)%in_use) then + if (all_timers(timer_id)%node_started) then + call glc_timer_stop(timer_id) + lrestart_timer = .true. + else + lrestart_timer = .false. + endif + + !*** Find max node time and print that time as default timer + !*** result + + if (my_task < all_timers(timer_id)%num_nodes) then + local_time = all_timers(timer_id)%node_accum_time + else + local_time = c0 + endif + max_time = global_maxval(local_time) + + if (my_task == master_task) then + write (nu_diag,timer_format) timer_id, & + trim(all_timers(timer_id)%name),max_time + endif + + if (present(stats)) then + if (stats) then + + !*** compute and print statistics for node timer + + min_time = global_minval(local_time) + mean_time = global_sum(local_time,distrb_info)/ & + real(all_timers(timer_id)%num_nodes,kind=dbl_kind) + if (my_task == master_task) then + write (nu_diag,stats_fmt1) min_time + write (nu_diag,stats_fmt2) max_time + write (nu_diag,stats_fmt3) mean_time + endif + + !*** compute and print statistics for block timers + !*** min block time + + local_time = bignum + do n=1,all_timers(timer_id)%num_blocks + local_time = min(local_time, & + all_timers(timer_id)%block_accum_time(n)) + end do + min_time = global_minval(local_time) + if (min_time == bignum) min_time = c0 + + !*** max block time + + local_time = -bignum + do n=1,all_timers(timer_id)%num_blocks + local_time = max(local_time, & + all_timers(timer_id)%block_accum_time(n)) + end do + max_time = global_maxval(local_time) + if (max_time == -bignum) min_time = c0 + + !*** mean block time + + local_time = c0 + do n=1,all_timers(timer_id)%num_blocks + local_time = local_time + & + all_timers(timer_id)%block_accum_time(n) + end do + icount = global_sum(all_timers(timer_id)%num_blocks, & + distrb_info) + if (icount > 0) mean_time=global_sum(local_time,distrb_info)& + /real(icount,kind=dbl_kind) + + if (my_task == master_task) then + write (nu_diag,stats_fmt4) min_time + write (nu_diag,stats_fmt2) max_time + write (nu_diag,stats_fmt3) mean_time + endif + + endif + endif + + if (lrestart_timer) call glc_timer_start(timer_id) + else + call exit_glc (sigAbort, & + 'glc_timer_print: attempt to print undefined timer') + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_print + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_print_all +! !INTERFACE: + + subroutine glc_timer_print_all(stats) + +! !DESCRIPTION: +! Prints the accumulated time for a all timers and optional +! statistics for that timer. It is assumed that this routine +! is called outside of a block loop. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + logical (log_kind), intent(in), optional :: & + stats ! if true, print statistics for node + ! and block times for this timer + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy loop index + +!----------------------------------------------------------------------- +! +! loop through timers anc call timer_print for each defined timer +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(nu_diag,'(/,a19,/)') 'Timing information:' + endif + + do n=1,max_timers + if (all_timers(n)%in_use) then + if (present(stats)) then + call glc_timer_print(n,stats) + else + call glc_timer_print(n) + endif + endif + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_print_all + +!*********************************************************************** +!BOP +! !IROUTINE: glc_timer_check +! !INTERFACE: + + subroutine glc_timer_check(timer_id,block_id) + +! !DESCRIPTION: +! This routine checks a given timer by stopping and restarting the +! timer. This is primarily used to periodically accumulate time in +! the timer to prevent timer cycles from wrapping around max_cycles. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + timer_id ! timer number + + integer (int_kind), intent(in), optional :: & + block_id ! optional block id for this block + ! this must be the actual local address + ! of the block in the distribution + ! from which it is called + ! (if timer called outside of block + ! region, no block info required) + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! stop and restart the requested timer +! +!----------------------------------------------------------------------- + + if (present(block_id)) then + call glc_timer_stop (timer_id,block_id) + call glc_timer_start(timer_id,block_id) + else + call glc_timer_stop (timer_id) + call glc_timer_start(timer_id) + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_timer_check + +!*********************************************************************** + + end module glc_timers + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP.F90 b/components/cism/source_glc/POP_files/POP.F90 new file mode 100644 index 0000000000..edab8836df --- /dev/null +++ b/components/cism/source_glc/POP_files/POP.F90 @@ -0,0 +1,167 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! !ROUTINE: POP +! !INTERFACE: + +#ifdef SINGLE_EXEC + subroutine ccsm_ocn() +#else + program POP +#endif + +! !DESCRIPTION: +! This is the main driver for the Parallel Ocean Program (POP). +! +! !REVISION HISTORY: +! SVN:$Id: POP.F90 2290 2006-10-25 18:23:10Z njn01 $ + +! !USES: + +#ifdef SINGLE_EXEC + use MPH_module, only : MPH_get_argument +#endif + use POP_KindsMod + use POP_ErrorMod + use POP_InitMod + use POP_FinalMod + use kinds_mod, only: int_kind, r8 + use communicate, only: my_task, master_task + use exit_mod + use domain, only: distrb_clinic + use timers, only: timer_print_all, get_timer, timer_start, timer_stop + use time_management, only: init_time_flag, check_time_flag, sigAbort, & + nsteps_run, stdout, sigExit, exit_pop, set_time_flag + use step_mod, only: step + use initial, only: initialize_pop + use diagnostics, only: check_KE + use output, only: output_driver + use solvers, only: solv_sum_iters + use forcing_coupled, only: lcoupled + + implicit none + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + timer_total, &! timer number for total time + timer_step, &! timer number for step + timer_out, &! timer number for output driver + ierr, &! error flag + fstop_now, &! flag id for stop_now flag + nscan + + integer (POP_i4) :: & + errorCode ! error code + +#ifdef SINGLE_EXEC + integer (int_kind) :: & + nThreads + + call MPH_get_argument("THREADS", nThreads, "ocn") +#ifdef _OPENMP + call OMP_SET_NUM_THREADS(nThreads) +#endif +#endif + +!----------------------------------------------------------------------- +! +! initialize the model run +! +!----------------------------------------------------------------------- + + errorCode = POP_Success + + call POP_Initialize(errorCode) + + fstop_now = init_time_flag('stop_now') + nscan = 0 + +!----------------------------------------------------------------------- +! +! start up the main timer +! +!----------------------------------------------------------------------- + + call get_timer(timer_step,'STEP',1,distrb_clinic%nprocs) + call get_timer(timer_out,'OUTPUT',1,distrb_clinic%nprocs) + + call get_timer(timer_total,'TOTAL',1,distrb_clinic%nprocs) + call timer_start(timer_total) + + +!----------------------------------------------------------------------- +! +! advance the model in time +! +!----------------------------------------------------------------------- + + advance: do while (.not. check_time_flag(fstop_now)) + + call timer_start(timer_step) + call step + call timer_stop(timer_step) + + if (lcoupled .and. check_time_flag(fstop_now)) exit advance + + nscan = nscan + solv_sum_iters + + !*** + !*** exit if energy is blowing + !*** + + if (check_KE(100.0_r8)) then + call set_time_flag(fstop_now,.true.) + call output_driver + call exit_POP(sigAbort,'ERROR: k.e. > 100 ') + endif + +!----------------------------------------------------------------------- +! +! write restart dumps and archiving +! +!----------------------------------------------------------------------- + + call timer_start(timer_out) + call output_driver + call timer_stop (timer_out) + + enddo advance + +!----------------------------------------------------------------------- +! +! write an end restart if we are through the stepping loop +! without an error +! +!----------------------------------------------------------------------- + + nscan = nscan/nsteps_run + if (my_task == master_task) & + write(stdout,*) ' average # scans =', nscan + +!----------------------------------------------------------------------- +! +! print timing information and clean up various environments if +! they have been used +! +!----------------------------------------------------------------------- + + call timer_stop(timer_total) + + call POP_Final(errorCode) + +!----------------------------------------------------------------------- +!EOC + +#ifdef SINGLE_EXEC + end subroutine ccsm_ocn +#else + end program POP +#endif + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP_ErrorMod.F90 b/components/cism/source_glc/POP_files/POP_ErrorMod.F90 new file mode 100644 index 0000000000..1400dc241a --- /dev/null +++ b/components/cism/source_glc/POP_files/POP_ErrorMod.F90 @@ -0,0 +1,247 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module POP_ErrorMod + +!BOP +! !MODULE: POP_ErrorMod +! !DESCRIPTION: +! This module contains POP error flags and facilities for logging and +! printing error messages. Note that error flags are local to a +! process and there is no synchronization of error flags across +! processes. As routines trap error flags, they may add a message +! to the error log to aid in tracking the call sequence. +! +! !USERDOC: +! Users should not need to change any values in this module. +! +! !REFDOC: +! All routines in POP which encounter an error should return to +! the calling routine with the POP\_Fail error code set and a message +! added to the error log using the POP\_ErrorSet function. Also, +! routines in POP should check error codes returned by called routines +! and add a message to the error log to help users track the calling +! sequence that generated the error. This process +! enables the error code to be propagated to the highest level or +! to a coupler for a proper call to the POP finalize method. +! +! !REVISION HISTORY: +! SVN:$Id: POP_ErrorMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! +! !USES: + + use POP_KindsMod + !use POP_CommMod + use communicate + use constants + use POP_IOUnitsMod + + implicit none + private + save + +! !DEFINED PARAMETERS: + + integer (POP_i4), parameter, public :: & + POP_Success = 0, & ! standard POP error flags + POP_Fail = -1 + +! !PUBLIC MEMBER FUNCTIONS: + + public :: POP_ErrorSet, & + POP_ErrorPrint + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + integer (POP_i4), parameter :: & + POP_ErrorLogDepth = 20 ! Max depth of call tree to properly + ! size the error log array + + integer (POP_i4) :: & + POP_ErrorMsgCount = 0 ! tracks current number of log messages + + character (POP_CharLength), dimension(POP_ErrorLogDepth) :: & + POP_ErrorLog ! list of error messages to be output + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: POP_ErrorSet -- sets error code and logs error message +! !INTERFACE: + + subroutine POP_ErrorSet(ErrorCode, ErrorMsg) + +! !DESCRIPTION: +! This routine sets an error code to POP\_Fail and adds a message to +! the error log for later printing. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (POP_i4), intent(out) :: & + ErrorCode ! Error code to set to fail + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + ErrorMsg ! message to add to error log for printing + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! Set error code to fail +! +!----------------------------------------------------------------------- + + ErrorCode = POP_Fail + +!----------------------------------------------------------------------- +! +! Add error message to error log +! +!----------------------------------------------------------------------- + + POP_ErrorMsgCount = POP_ErrorMsgCount + 1 + + if (POP_ErrorMsgCount <= POP_ErrorLogDepth) then + POP_ErrorLog(POP_ErrorMsgCount) = ErrorMsg + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_ErrorSet + +!*********************************************************************** +!BOP +! !IROUTINE: POP_ErrorPrint -- prints the error log +! !INTERFACE: + + subroutine POP_ErrorPrint(ErrorCode, PrintTask) + +! !DESCRIPTION: +! This routine prints all messages in the error log. If a PrintTask +! is specified, only the log on that task will be printed. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (POP_i4), intent(in) :: & + ErrorCode ! input error code to check success/fail + + integer (POP_i4), intent(in), optional :: & + PrintTask ! Task from which to print error log + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (POP_i4) :: n + +!----------------------------------------------------------------------- +! +! Print all error messages to stdout +! +!----------------------------------------------------------------------- + + if (present(PrintTask)) then + + if (my_Task == PrintTask) then + !if (POP_myTask == PrintTask) then + + write(POP_stdout,blank_fmt) + write(POP_stdout,'(a34)') '----------------------------------' + + if (POP_ErrorMsgCount == 0) then ! no errors + + write(POP_stdout,'(a34)') & + 'Successful completion of POP model' + + else + + write(POP_stdout,'(a14)') 'POP Exiting...' + do n=1,min(POP_ErrorMsgCount,POP_ErrorLogDepth) + write(POP_stderr,'(a)') trim(POP_ErrorLog(n)) + if (POP_stdout /= POP_stderr) then + write(POP_stdout,'(a)') trim(POP_ErrorLog(n)) + endif + end do + if (POP_ErrorMsgCount > POP_ErrorLogDepth) then + write(POP_stderr,'(a)') 'Too many error messages' + if (POP_stdout /= POP_stderr) then + write(POP_stdout,'(a)') 'Too many error messages' + endif + endif + + endif + + write(POP_stdout,'(a34)') '----------------------------------' + + endif + + else + + write(POP_stdout,'(a34)') '----------------------------------' + + if (POP_ErrorMsgCount == 0) then ! no errors + + write(POP_stdout,'(a34)') 'Successful completion of POP model' + + else + + write(POP_stdout,'(a14)') 'POP Exiting...' + do n=1,min(POP_ErrorMsgCount,POP_ErrorLogDepth) + write(POP_stderr,'(a)') trim(POP_ErrorLog(n)) + if (POP_stdout /= POP_stderr) then + write(POP_stdout,'(a)') trim(POP_ErrorLog(n)) + endif + end do + if (POP_ErrorMsgCount > POP_ErrorLogDepth) then + write(POP_stderr,'(a)') 'Too many error messages' + if (POP_stdout /= POP_stderr) then + write(POP_stdout,'(a)') 'Too many error messages' + endif + endif + + endif + + write(POP_stdout,'(a34)') '----------------------------------' + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_ErrorPrint + +!*********************************************************************** + + end module POP_ErrorMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP_FinalMod.F90 b/components/cism/source_glc/POP_files/POP_FinalMod.F90 new file mode 100644 index 0000000000..39a4f0e1f1 --- /dev/null +++ b/components/cism/source_glc/POP_files/POP_FinalMod.F90 @@ -0,0 +1,126 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module POP_FinalMod + +!BOP +! !MODULE: POP_FinalMod +! !DESCRIPTION: +! This module contains the POP finalization method that shuts down POP +! gracefully (we hope). It exits the message environment and checks +! for successful execution. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! SVN:$Id: POP_FinalMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! +! !USES: + + use POP_KindsMod + use POP_ErrorMod + use POP_IOUnitsMod, only: POP_stdout + use communicate + use timers, only: timer_print_all + use xdisplay, only: lxdisplay, clear_display + !use POP_CommMod + !use esmf_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: POP_Final + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: POP_Final +! !INTERFACE: + + subroutine POP_Final(ErrorCode) + +! !DESCRIPTION: +! This routine shuts down POP by exiting all relevent environments. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + integer (POP_i4), intent(inout) :: & + ErrorCode ! On input, error code from Init,Run method + ! On output, status of this routine + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! call Error Logging to print any error messages. +! +!----------------------------------------------------------------------- + + call POP_ErrorPrint(ErrorCode) + +!----------------------------------------------------------------------- +! +! clear any open displays and print all timers with statistics +! +!----------------------------------------------------------------------- + + call timer_print_all(stats=.true.) + if (lxdisplay) call clear_display + +!----------------------------------------------------------------------- +! +! write final message to pop output log +! +!----------------------------------------------------------------------- + write(POP_stdout,*) '===================' + write(POP_stdout,*) 'completed POP_Final' + write(POP_stdout,*) '===================' + +!----------------------------------------------------------------------- +! +! exit the communication environment +! +!----------------------------------------------------------------------- + + !call POP_CommExitEnvironment(ErrorCode) + call exit_message_environment(ErrorCode) + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_Final + +!*********************************************************************** + + end module POP_FinalMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP_IOUnitsMod.F90 b/components/cism/source_glc/POP_files/POP_IOUnitsMod.F90 new file mode 100644 index 0000000000..4486113557 --- /dev/null +++ b/components/cism/source_glc/POP_files/POP_IOUnitsMod.F90 @@ -0,0 +1,283 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module POP_IOUnitsMod + +!BOP +! +! !MODULE: POP_IOUnitsMod +! +! !DESCRIPTION: +! This module contains an I/O unit manager for tracking, assigning +! and reserving I/O unit numbers. +! +! !USERDOC: +! There are three reserved I/O units set as parameters in this +! module. The default units for standard input (stdin), standard +! output (stdout) and standard error (stderr). These are currently +! set as units 5,6,6, respectively as that is the most commonly +! used among vendors. However, the user may change these if those +! default units are conflicting with other models or if the +! vendor is using different values. +! +! The maximum number of I/O units per node is currently set by +! the parameter POP\_IOMaxUnits. +! +! !REFDOC: +! +! !REVISION HISTORY: +! SVN:$Id: POP_IOUnitsMod.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: + + use POP_KindsMod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: POP_IOUnitsGet, & + POP_IOUnitsRelease, & + POP_IOUnitsReserve + +! !PUBLIC DATA MEMBERS: + + integer (POP_i4), parameter, public :: & + POP_stdin = 5, &! reserved unit for standard input + POP_stdout = 6, &! reserved unit for standard output + POP_stderr = 6 ! reserved unit for standard error + + ! common formats for writing to stdout, stderr + + character (9), parameter, public :: & + POP_delimFormat = "(72('-'))" + + character (5), parameter, public :: & + POP_blankFormat = "(' ')" + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! io unit manager variables +! +!----------------------------------------------------------------------- + + integer (POP_i4), parameter :: & + POP_IOUnitsMinUnits = 11, & ! do not use unit numbers below this + POP_IOUnitsMaxUnits = 99 ! maximum number of open units + + logical (POP_Logical) :: & + POP_IOUnitsInitialized = .false. + + logical (POP_Logical), dimension(POP_IOUnitsMaxUnits) :: & + POP_IOUnitsInUse ! flag=.true. if unit currently open + +!EOC +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: POP_IOUnitsGet +! !INTERFACE: + + subroutine POP_IOUnitsGet(iunit) + +! !DESCRIPTION: +! This routine returns the next available i/o unit and marks it as +! in use to prevent any later use. +! Note that {\em all} processors must call this routine even if only +! the master task is doing the i/o. This is necessary insure that +! the units remains synchronized for other parallel I/O functions. +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (POP_i4), intent(out) :: & + iunit ! next free i/o unit + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (POP_i4) :: n ! dummy loop index + + logical (POP_Logical) :: alreadyInUse + +!----------------------------------------------------------------------- +! +! check to see if units initialized and initialize if necessary +! +!----------------------------------------------------------------------- + + if (.not. POP_IOUnitsInitialized) then + POP_IOUnitsInUse = .false. + POP_IOUnitsInUse(POP_stdin) = .true. + POP_IOUnitsInUse(POP_stdout) = .true. + POP_IOUnitsInUse(POP_stderr) = .true. + + POP_IOUnitsInitialized = .true. + endif + +!----------------------------------------------------------------------- +! +! find next free unit +! +!----------------------------------------------------------------------- + + srch_units: do n=POP_IOUnitsMinUnits, POP_IOUnitsMaxUnits + if (.not. POP_IOUnitsInUse(n)) then ! I found one, I found one + + !*** make sure not in use by library routines + INQUIRE (unit=n,OPENED=alreadyInUse) + + if (.not. alreadyInUse) then + iunit = n + POP_IOUnitsInUse(iunit) = .true. ! mark iunit as being in use + exit srch_units + endif + endif + end do srch_units + + if (iunit > POP_IOUnitsMaxUnits) stop 'POP_IOUnitsGet: No free units' + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_IOUnitsGet + +!*********************************************************************** +!BOP +! !IROUTINE: POP_IOUnitsRelease +! !INTERFACE: + + subroutine POP_IOUnitsRelease(iunit) + +! !DESCRIPTION: +! This routine releases an i/o unit (marks it as available). +! Note that {\em all} processors must call this routine even if only +! the master task is doing the i/o. This is necessary insure that +! the units remain synchronized for other parallel I/O functions. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETER: + + integer (POP_i4), intent(in) :: & + iunit ! i/o unit to be released + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper unit number +! +!----------------------------------------------------------------------- + + if (iunit < 1 .or. iunit > POP_IOUnitsMaxUnits) then + stop 'POP_IOUnitsRelease: bad unit' + endif + +!----------------------------------------------------------------------- +! +! mark the unit as not in use +! +!----------------------------------------------------------------------- + + POP_IOUnitsInUse(iunit) = .false. ! that was easy... + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_IOUnitsRelease + +!*********************************************************************** +!BOP +! !IROUTINE: POP_IOUnitsReserve +! !INTERFACE: + + subroutine POP_IOUnitsReserve(iunit) + +! !DESCRIPTION: +! This routine releases an i/o unit (marks it as available). +! Note that {\em all} processors must call this routine even if only +! the master task is doing the i/o. This is necessary insure that +! the units remains synchronized for other parallel I/O functions. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETER: + + integer (POP_i4), intent(in) :: & + iunit ! i/o unit to be released + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (POP_Logical) :: alreadyInUse + +!----------------------------------------------------------------------- +! +! check for proper unit number +! +!----------------------------------------------------------------------- + + if (iunit < POP_IOUnitsMinUnits .or. iunit > POP_IOUnitsMaxUnits) then + stop 'POP_IOUnitsReserve: invalid unit' + endif + +!----------------------------------------------------------------------- +! +! check to see if POP already using this unit +! +!----------------------------------------------------------------------- + + if (POP_IOUnitsInUse(iunit)) then + stop 'POP_IOUnitsReserve: unit already in use by POP' + endif + +!----------------------------------------------------------------------- +! +! check to see if others already using this unit +! +!----------------------------------------------------------------------- + + INQUIRE (unit=iunit, OPENED=alreadyInUse) + if (alreadyInUse) then + stop 'POP_IOUnitsReserve: unit already in use by others' + endif + +!----------------------------------------------------------------------- +! +! mark the unit as in use +! +!----------------------------------------------------------------------- + + POP_IOUnitsInUse(iunit) = .true. ! that was easy... + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_IOUnitsReserve + +!*********************************************************************** + + end module POP_IOUnitsMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP_InitMod.F90 b/components/cism/source_glc/POP_files/POP_InitMod.F90 new file mode 100644 index 0000000000..3e51a50a33 --- /dev/null +++ b/components/cism/source_glc/POP_files/POP_InitMod.F90 @@ -0,0 +1,102 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module POP_InitMod + +!BOP +! !MODULE: POP_InitMod +! !DESCRIPTION: +! This module contains the POP initialization method and initializes +! everything needed by a POP simulation. Primarily it is a driver +! that calls individual initialization routines for each POP module. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! SVN:$Id: POP_InitMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! +! !USES: + + use POP_KindsMod + use POP_ErrorMod + use initial + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: POP_Initialize + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: POP_Initialize +! !INTERFACE: + + subroutine POP_Initialize(errorCode) + +! !DESCRIPTION: +! This routine is the initialization driver that initializes a POP run +! by calling individual module initialization routines. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + integer (POP_i4), intent(inout) :: & + errorCode ! Returns an error code if any init fails + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! initialize return flag +! +!----------------------------------------------------------------------- + + ErrorCode = POP_Success + +!----------------------------------------------------------------------- +! +! call pop initialization routine +! +!----------------------------------------------------------------------- + + call initialize_POP + +!----------------------------------------------------------------------- +!EOC + + end subroutine POP_Initialize + +!*********************************************************************** + + end module POP_InitMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/POP_KindsMod.F90 b/components/cism/source_glc/POP_files/POP_KindsMod.F90 new file mode 100644 index 0000000000..1e4e91b373 --- /dev/null +++ b/components/cism/source_glc/POP_files/POP_KindsMod.F90 @@ -0,0 +1,53 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module POP_KindsMod + +!BOP +! !MODULE: POP_KindsMod +! +! !DESCRIPTION: +! This module defines default numerical data types for all common data +! types like integer, character, logical, real4 and real8. +! +! !USERDOC: +! Users should not need to adjust anything in this module. If various +! character strings like long paths to files exceed the default +! character length, the default value may be increased. +! +! !REFDOC: +! This module is supplied to provide consistent data representation +! across machine architectures. It is meant to replace the old +! Fortran double precision and real *X declarations that were +! implementation-specific. +! Users should not need to adjust anything in this module. If various +! character strings like long paths to files exceed the default +! character length, the default value may be increased. +! +! !REVISION HISTORY: +! SVN:$Id: POP_KindsMod.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: +! uses no other modules + + implicit none + private + save + +! !DEFINED PARAMETERS: + + integer, parameter, public :: & + POP_CharLength = 100 ,& + POP_Logical = kind(.true.) ,& + POP_i4 = selected_int_kind(6) ,& + POP_i8 = selected_int_kind(13) ,& + POP_r4 = selected_real_kind(6) ,& + POP_r8 = selected_real_kind(13) + +!EOP +!BOC +!EOC +!*********************************************************************** + + end module POP_KindsMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/exit_mod.F90 b/components/cism/source_glc/POP_files/exit_mod.F90 new file mode 100644 index 0000000000..6d32b7cca0 --- /dev/null +++ b/components/cism/source_glc/POP_files/exit_mod.F90 @@ -0,0 +1,155 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module exit_mod + +!BOP +! !MODULE: exit_mod +! +! !DESCRIPTION: +! This module provides a means for a graceful exit from POP when +! encountering an error. it contains only the routines exit\_POP +! and flushm +! +! !REVISION HISTORY: +! SVN:$Id: exit_mod.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: + + use kinds_mod + use communicate + use constants + use shr_sys_mod + + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: exit_POP, flushm + +! !DEFINED PARAMETERS: + + integer (int_kind), parameter, public :: & + sigExit = 0, &! signal for normal exit + sigAbort = -1 ! signal for aborting (exit due to error) + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: exit_POP +! !INTERFACE: + + subroutine exit_POP(exit_mode, exit_message) + +! !DESCRIPTION: +! This routine prints a message, exits any message environment +! and cleans up before stopping + +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + exit_mode ! method for exiting (normal exit or abort) + + character (*), intent(in) :: & + exit_message ! message to print before stopping + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr ! error flag + +!----------------------------------------------------------------------- +! +! print message - must use unit 6 in place of stdout to +! prevent circular dependence with io module +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write (6,delim_fmt) + write (6,blank_fmt) + call shr_sys_flush(6) + + select case(exit_mode) + case(sigExit) + write (6,'(a14)') 'POP exiting...' + case(sigAbort) + write (6,'(a15)') 'POP aborting...' + case default + write (6,'(a37)') 'POP exiting with unknown exit mode...' + end select + + write (6,*) exit_message + write (6,blank_fmt) + write (6,delim_fmt) + call shr_sys_flush(6) + endif + +!----------------------------------------------------------------------- +! +! exit or abort the message-passing environment if required +! +!----------------------------------------------------------------------- + + select case(exit_mode) + case(sigExit) + call exit_message_environment(ierr) + case(sigAbort) + call abort_message_environment(ierr) + case default + end select + +!----------------------------------------------------------------------- +! +! now we can stop +! +!----------------------------------------------------------------------- + + stop + +!----------------------------------------------------------------------- +!EOC + + end subroutine exit_POP + +!*********************************************************************** +!BOP +! !IROUTINE: flushm (iunit) +! !INTERFACE: + + subroutine flushm (iunit) + +! !DESCRIPTION: +! This routine flushes the stdout buffer for the master_task only +! +! !REVISION HISTORY: +! same as module + integer (int_kind), intent(in) :: iunit + + if (my_task == master_task) then + call shr_sys_flush (iunit) + endif + + end subroutine flushm + +!*********************************************************************** + + end module exit_mod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/forcing_coupled.F90 b/components/cism/source_glc/POP_files/forcing_coupled.F90 new file mode 100644 index 0000000000..5a3ae42ff6 --- /dev/null +++ b/components/cism/source_glc/POP_files/forcing_coupled.F90 @@ -0,0 +1,1932 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module forcing_coupled + +!BOP +!MODULE: forcing_coupled + +! !DESCRIPTION: +! This module contains all the routines necessary for coupling POP to +! atmosphere and sea ice models using the NCAR CCSM flux coupler. To +! enable the routines in this module, the coupled ifdef option must +! be specified during the make process. +! +! !REVISION HISTORY: +! SVN:$Id: forcing_coupled.F90 901 2006-05-08 20:47:20Z njn01 $ +! +! !USES: + + use kinds_mod + use blocks, only: nx_block, ny_block, block, get_block + use domain_size + use domain + use communicate + use global_reductions + use boundary + use constants + use io + use time_management + use grid + use prognostic + use exit_mod + use ice, only: tfreez, tmelt, liceform,QFLUX, QICE, AQICE, tlast_ice + use forcing_shf + use forcing_sfwf + use timers + + !*** ccsm + use ms_balance + use tavg + use cpl_contract_mod + use cpl_interface_mod + use cpl_fields_mod + use registry + use shr_sys_mod + + implicit none + save + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + lcoupled, &! flag for coupled forcing + ldiag_cpl = .false. ,& + lccsm ! flag to denote ccsm-specific code + + + integer (int_kind) :: & + coupled_freq_iopt, &! coupler frequency option + coupled_freq ! frequency of coupling + +!----------------------------------------------------------------------- +! +! ids for tavg diagnostics computed from forcing_coupled +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + tavg_EVAP_F, &! tavg id for evaporation flux + tavg_PREC_F, &! tavg id for precipitation flux (rain + snow) + tavg_SNOW_F, &! tavg id for snow flux + tavg_MELT_F, &! tavg id for melt flux + tavg_ROFF_F, &! tavg id for river runoff flux + tavg_SALT_F, &! tavg id for salt flux + tavg_SENH_F, &! tavg id for sensible heat flux + tavg_LWUP_F, &! tavg id for longwave heat flux up + tavg_LWDN_F, &! tavg id for longwave heat flux dn + tavg_MELTH_F ! tavg id for melt heat flux + +!----------------------------------------------------------------------- +! +! diurnal cycle switch for the net shortwave heat flux +! +! qsw_diurnal_cycle = .T. diurnal cycle is ON +! = .F. diurnal cycle is OFF +! +!----------------------------------------------------------------------- + + logical (log_kind) :: qsw_diurnal_cycle + + real (r8), dimension(:), allocatable :: & + diurnal_cycle_factor + + +#if coupled + + integer (int_kind) :: & + timer_send_to_cpl, & + timer_recv_from_cpl, & + timer_recv_to_send, & + timer_send_to_recv + + integer (int_kind), private :: & + cpl_stop_now, &! flag id for stop_now flag + cpl_ts, &! flag id for coupled_ts flag + cpl_write_restart, &! flag id for write restart + cpl_write_history, &! flag id for write history + cpl_write_tavg, &! flag id for write tavg + cpl_diag_global, &! flag id for computing diagnostics + cpl_diag_transp ! flag id for computing diagnostics + + integer (int_kind), dimension(cpl_fields_ibuf_total) :: & + isbuf, &! integer control buffer for sends + irbuf ! integer control buffer for receives + + type(cpl_contract) :: & + contractS, &! contract for sends to coupler + contractR ! contract for receives from coupler + + real (r8), dimension(:,:), allocatable :: & + sbuf ! temporary send/recv buffer + +!----------------------------------------------------------------------- +! The following variables are used in the exchange of +! information between cpl6 and the ocean code. +! +! ocn --> cpl6 +! ============ +! cpl_fields_ibuf_total -- length of integer ocean "send buffer" vector (isbuf) +! nsend -- total number of 2D fields sent to cpl6 from ocn +! +! integer send buffer indices (isbuf in subroutine init_coupled): +! +! o cpl_fields_ibuf_cdate -- ocean's character date string (yyyymmdd) +! o cpl_fields_ibuf_sec -- ocean's character time string (seconds) +! o cpl_fields_ibuf_precadj -- precipitation adjustment factor*1e6 +! o cpl_fields_ibuf_lsize -- (iphys_e-iphys_b+1)*(jphys_e-jphys_b+1) +! o cpl_fields_ibuf_lisize -- (iphys_e-iphys_b+1) +! o cpl_fields_ibuf_ljsize -- (jphys_e-jphys_b+1) +! o cpl_fields_ibuf_gsize -- nx_global*ny_global +! o cpl_fields_ibuf_gisize -- nx_global +! o cpl_fields_ibuf_gjsize -- ny_global +! o cpl_fields_ibuf_ncpl -- ncouple_per_day +! o cpl_fields_ibuf_nfields -- cpl_fields_grid_total +! o cpl_fields_ibuf_dead -- 0 ==> not a "dead" model +! +! real send buffer indices (sbuf in subroutine init_coupled): +! +! o cpl_fields_grid_lon -- radian*TLON(i,j) +! o cpl_fields_grid_lat -- radian*TLAT(i,j) +! o cpl_fields_grid_area -- TAREA(i,j)/(radius*radius) +! o cpl_fields_grid_mask -- float(REGION_MASK(i,j)) +! o cpl_fields_grid_index -- (j_global(j)-1)*(nx_global)+i_global(i) +! +! real send buffer indices (sbuf in subroutine send_to_coupler): +! +! o index_o2c_So_u -- surface u velocity +! o index_o2c_So_v -- surface v velocity +! o index_o2c_So_t -- surface temperature +! o index_o2c_So_s -- surface salinity +! o index_o2c_So_dhdx -- e,w surface slope +! o index_o2c_So_dhdy -- n,s surface slope +! o index_o2c_Fioo_q -- qflux +! +! +! cpl6 --> ocn +! ============ +! +! cpl_fields_ibuf_total -- length of integer ocean "receive buffer" vector (irbuf) +! +! integer receive buffer indices (irbuf in subroutine recv_from_coupler): +! +! o cpl_fields_ibuf_stopnow -- stop ocean integration now +! o cpl_fields_ibuf_infobug -- write ocean/coupler diagnostics now +! o cpl_fields_ibuf_resteod -- write ocean restart files at end of day +! o cpl_fields_ibuf_histeod -- write ocean history files at end of day +! o cpl_fields_ibuf_histtavg -- write ocean "tavg" files at end of day +! o cpl_fields_ibuf_diageod -- write ocean diagnostics at end of day +! +! real receive buffer indices (sbuf in subroutine recv_from_coupler): +! +! o index_c2o_Foxx_taux -- zonal wind stress (taux) +! o index_c2o_Foxx_tauy -- meridonal wind stress (tauy) +! o index_c2o_Foxx_snow -- water flux due to snow +! o index_c2o_Foxx_rain -- water flux due to rain +! o index_c2o_Foxx_evap -- evaporation flux +! o index_c2o_Foxx_meltw -- snow melt flux +! o index_c2o_Foxx_salt -- salt +! o index_c2o_Foxx_swnet -- net short-wave heat flux +! o index_c2o_Foxx_sen -- sensible heat flux +! o index_c2o_Foxx_lwup -- longwave radiation (up) +! o index_c2o_Foxx_lwdn -- longwave radiation (down) +! o index_c2o_Foxx_melth -- heat flux from snow&ice melt +! o index_c2o_Si_ifrac -- ice fraction +! o index_c2o_Sa_pslv -- sea-level pressure +! o index_c2o_Faoc_duu10n -- 10m wind speed squared +! o index_c2o_Forr_roff -- river runoff flux +! +! +!----------------------------------------------------------------------- + + integer(kind=int_kind) :: index_o2c_So_t ! temperature + integer(kind=int_kind) :: index_o2c_So_u ! velocity, zonal + integer(kind=int_kind) :: index_o2c_So_v ! velocity, meridional + integer(kind=int_kind) :: index_o2c_So_s ! salinity + integer(kind=int_kind) :: index_o2c_So_dhdx ! surface slope, zonal + integer(kind=int_kind) :: index_o2c_So_dhdy ! surface slope, meridional + integer(kind=int_kind) :: index_o2c_Fioo_q ! heat of fusion (q>0) melt pot (q<0) + + integer(kind=int_kind) :: index_c2o_Si_ifrac ! state: ice fraction + integer(kind=int_kind) :: index_c2o_Sa_pslv ! state: sea level pressure + integer(kind=int_kind) :: index_c2o_Faoc_duu10n ! state: 10m wind speed squared + integer(kind=int_kind) :: index_c2o_Foxx_taux ! wind stress: zonal + integer(kind=int_kind) :: index_c2o_Foxx_tauy ! wind stress: meridional + integer(kind=int_kind) :: index_c2o_Foxx_swnet ! heat flux: shortwave net + integer(kind=int_kind) :: index_c2o_Foxx_lat ! heat flux: latent + integer(kind=int_kind) :: index_c2o_Foxx_sen ! heat flux: sensible + integer(kind=int_kind) :: index_c2o_Foxx_lwup ! heat flux: long-wave up + integer(kind=int_kind) :: index_c2o_Foxx_lwdn ! heat flux: long-wave dow + integer(kind=int_kind) :: index_c2o_Foxx_melth ! heat flux: melt + integer(kind=int_kind) :: index_c2o_Foxx_salt ! salt flux + integer(kind=int_kind) :: index_c2o_Foxx_prec ! water flux: rain+snow + integer(kind=int_kind) :: index_c2o_Foxx_snow ! water flux: snow + integer(kind=int_kind) :: index_c2o_Foxx_rain ! water flux: rain + integer(kind=int_kind) :: index_c2o_Foxx_evap ! water flux: evap + integer(kind=int_kind) :: index_c2o_Foxx_meltw ! water flux: melt + integer(kind=int_kind) :: index_c2o_Forr_roff ! water flux: runoff + + real (r8) :: & + tlast_coupled + + real (r8), & + dimension(:,:,:,:), allocatable :: & + SBUFF_SUM ! accumulated sum of send buffer quantities + ! for averaging before being sent + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + EVAP_F = c0, &! evaporation flux from cpl (kg/m2/s) + PREC_F = c0, &! precipitation flux from cpl (kg/m2/s) + ! (rain + snow) + SNOW_F = c0, &! snow flux from cpl (kg/m2/s) + MELT_F = c0, &! melt flux from cpl (kg/m2/s) + ROFF_F = c0, &! river runoff flux from cpl (kg/m2/s) + SALT_F = c0, &! salt flux from cpl (kg(salt)/m2/s) + SENH_F = c0, &! sensible heat flux from cpl (W/m2 ) + LWUP_F = c0, &! longwave heat flux up from cpl (W/m2 ) + LWDN_F = c0, &! longwave heat flux dn from cpl (W/m2 ) + MELTH_F= c0 ! melt heat flux from cpl (W/m2 ) + + +#endif +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** + +!BOP +! !IROUTINE: init_coupled +! !INTERFACE: + + subroutine init_coupled(SMF, SMFT, STF, SHF_QSW, lsmft_avail) + +! !DESCRIPTION: +! This routine sets up everything necessary for coupling with +! the CCSM2 flux coupler, version 6 (cpl6) +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,2,max_blocks_clinic), & + intent(out) :: & + SMF, &! surface momentum fluxes (wind stress) + SMFT ! surface momentum fluxes at T points + + real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & + intent(out) :: & + STF ! surface tracer fluxes + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(out) :: & + SHF_QSW ! penetrative solar heat flux + + logical (log_kind), intent(out) :: & + lsmft_avail ! true if SMFT is an available field + +!EOP +!BOC + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: & + coupled_freq_opt + + namelist /coupled_nml/ coupled_freq_opt, coupled_freq, & + qsw_diurnal_cycle, lccsm + + integer (int_kind) :: & + k, iblock, nsend, & + ncouple_per_day, &! num of coupler comms per day + nml_error ! namelist i/o error flag + + type (block) :: & + this_block ! block information for current block + +!----------------------------------------------------------------------- +! +! variables associated with the solar diurnal cycle +! +!----------------------------------------------------------------------- + + real (r8) :: & + time_for_forcing, &! time of day for surface forcing + frac_day_forcing, &! fraction of day based on time_for_forcing + cycle_function, &! intermediate result of the diurnal cycle function + weight_forcing, &! forcing weights + sum_forcing ! sum of forcing weights + + integer (int_kind) :: & + count_forcing ! time step counter (== nsteps_this_interval+1) + + integer (int_kind) :: & + i,j,n + +!----------------------------------------------------------------------- +! for now: +! ONLY ALLOW 1 BLOCK PER PROCEESOR +!----------------------------------------------------------------------- + + if (nblocks_clinic /= 1) then + call exit_POP(sigAbort,'ERROR init_coupled requires nblocks_clinic = 1') + endif + +!----------------------------------------------------------------------- +! +! read coupled_nml namelist to start coupling and determine +! coupling frequency +! +!----------------------------------------------------------------------- + + lcoupled = .false. + lccsm = .false. + coupled_freq_opt = 'never' + coupled_freq_iopt = freq_opt_never + coupled_freq = 100000 + qsw_diurnal_cycle = .false. + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=coupled_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_POP(sigAbort,'ERROR reading coupled_nml') + endif + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' Coupling:' + write(stdout,blank_fmt) + write(stdout,*) ' coupled_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout, coupled_nml) + write(stdout,blank_fmt) + endif + + if (my_task == master_task) then + select case (coupled_freq_opt) + + case ('nyear') + coupled_freq_iopt = -1000 + + case ('nmonth') + coupled_freq_iopt = -1000 + + case ('nday') + if (coupled_freq == 1) then + lcoupled = .true. + coupled_freq_iopt = freq_opt_nday + ncouple_per_day = 1 + else + coupled_freq_iopt = -1000 + endif + + case ('nhour') + if (coupled_freq <= 24) then + lcoupled = .true. + coupled_freq_iopt = freq_opt_nhour + ncouple_per_day = 24/coupled_freq + else + coupled_freq_iopt = -1000 + endif + + case ('nsecond') + if (coupled_freq <= seconds_in_day) then + lcoupled = .true. + coupled_freq_iopt = freq_opt_nsecond + ncouple_per_day = seconds_in_day/coupled_freq + else + coupled_freq_iopt = -1000 + endif + + case ('nstep') + if (coupled_freq <= nsteps_per_day) then + lcoupled = .true. + coupled_freq_iopt = freq_opt_nstep + ncouple_per_day = nsteps_per_day/coupled_freq + else + coupled_freq_iopt = -1000 + endif + + case ('never') + lcoupled = .false. + + case default + coupled_freq_iopt = -2000 + end select + + endif + + call broadcast_scalar(lcoupled, master_task) + call broadcast_scalar(lccsm, master_task) + call broadcast_scalar(coupled_freq_iopt, master_task) + call broadcast_scalar(coupled_freq , master_task) + call broadcast_scalar(qsw_diurnal_cycle, master_task) + + if (coupled_freq_iopt == -1000) then + call exit_POP(sigAbort, & + 'ERROR: Coupling frequency must be at least once per day') + else if (coupled_freq_iopt == -2000) then + call exit_POP(sigAbort, & + 'ERROR: Unknown option for coupling frequency') + endif + +!----------------------------------------------------------------------- +! +! register lcoupled if running with the flux coupler +! +!----------------------------------------------------------------------- + + if (lcoupled) call register_string('lcoupled') + call register_string('init_coupled') + +!----------------------------------------------------------------------- +! +! check consistency of the qsw_diurnal_cycle option with various +! time manager options +! +!----------------------------------------------------------------------- + + if ( qsw_diurnal_cycle ) then + if ( tmix_iopt /= tmix_avgfit ) & + call exit_POP(sigAbort, & + 'ERROR: time_mix_opt must be set to avgfit for solar diurnal cycle') + + if ( dttxcel(1) /= c1 .or. dtuxcel /= c1 ) & + call exit_POP(sigAbort, & + 'ERROR: using the specified accelerated integration '/& + &/ ' technique may not be appropriate for solar diurnal cycle') + endif + +!----------------------------------------------------------------------- +! +! allocate and compute the short wave heat flux multiplier for the +! diurnal cycle +! +!----------------------------------------------------------------------- + + allocate ( diurnal_cycle_factor(nsteps_per_interval)) + + diurnal_cycle_factor = c1 + if ( qsw_diurnal_cycle ) then + +! mimic a day + + time_for_forcing = c0 + count_forcing = 1 + sum_forcing = c0 + + do n=1,nsteps_per_interval + frac_day_forcing = time_for_forcing / seconds_in_day + cycle_function = cos( pi * ( c2 * frac_day_forcing - c1 ) ) + diurnal_cycle_factor(n) = c2 * ( cycle_function & + + abs(cycle_function) ) & + * cycle_function + weight_forcing = c1 + if ( count_forcing == 2 .or. & + mod(count_forcing,time_mix_freq) == 0 ) & + weight_forcing = p5 + time_for_forcing = time_for_forcing + weight_forcing * dt(1) + sum_forcing = sum_forcing & + + weight_forcing * dt(1) * diurnal_cycle_factor(n) + count_forcing = count_forcing + 1 + enddo + + diurnal_cycle_factor = diurnal_cycle_factor * seconds_in_day & + / sum_forcing + +! check the final integral + + count_forcing = 1 + sum_forcing = c0 + + do n=1,nsteps_per_interval + weight_forcing = c1 + if ( count_forcing == 2 .or. & + mod(count_forcing,time_mix_freq) == 0 ) & + weight_forcing = p5 + sum_forcing = sum_forcing & + + weight_forcing * dt(1) * diurnal_cycle_factor(n) + count_forcing = count_forcing + 1 + enddo + + if ( sum_forcing < (seconds_in_day - 1.0e-5_r8) .or. & + sum_forcing > (seconds_in_day + 1.0e-5_r8) ) & + call exit_POP (sigAbort, & + 'ERROR: qsw diurnal cycle temporal integral is incorrect') + + endif + +#if coupled + if (.not. lcoupled) then + call exit_POP(sigAbort, & + 'ERROR: Coupled ifdef option enabled but lcoupled=false') + endif + + +!----------------------------------------------------------------------- +! +! define tavg fields computed from forcing_coupled routines +! +!----------------------------------------------------------------------- + + call define_tavg_field(tavg_EVAP_F,'EVAP_F',2, & + long_name='Evaporation Flux from Coupler', & + units='kg/m^2/s', grid_loc='2110', & + missing_value=undefined_nf_r4, & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_PREC_F,'PREC_F',2, & + long_name='Precipitation Flux from Cpl (rain+snow)', & + missing_value=undefined_nf_r4, & + units='kg/m^2/s', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_SNOW_F,'SNOW_F',2, & + long_name='Snow Flux from Coupler', & + missing_value=undefined_nf_r4, & + units='kg/m^2/s', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_MELT_F,'MELT_F',2, & + long_name='Melt Flux from Coupler', & + missing_value=undefined_nf_r4, & + units='kg/m^2/s', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_ROFF_F,'ROFF_F',2, & + long_name='Runoff Flux from Coupler', & + missing_value=undefined_nf_r4, & + units='kg/m^2/s', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_SALT_F,'SALT_F',2, & + long_name='Salt Flux from Coupler (kg of salt/m^2/s)',& + missing_value=undefined_nf_r4, & + units='kg/m^2/s', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_SENH_F,'SENH_F',2, & + long_name='Sensible Heat Flux from Coupler', & + missing_value=undefined_nf_r4, & + units='watt/m^2', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_LWUP_F,'LWUP_F',2, & + long_name='Longwave Heat Flux (up) from Coupler', & + missing_value=undefined_nf_r4, & + units='watt/m^2', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_LWDN_F,'LWDN_F',2, & + long_name='Longwave Heat Flux (dn) from Coupler', & + missing_value=undefined_nf_r4, & + units='watt/m^2', grid_loc='2110', & + coordinates='TLONG TLAT time') + call define_tavg_field(tavg_MELTH_F,'MELTH_F',2, & + long_name='Melt Heat Flux from Coupler', & + missing_value=undefined_nf_r4, & + units='watt/m^2', grid_loc='2110', & + coordinates='TLONG TLAT time') + + +!----------------------------------------------------------------------- +! +! Initialize flags and shortwave absorption profile +! Note that the cpl_write_xxx flags have _no_ default value; +! therefore, they must be explicitly set .true. and .false. +! at the appropriate times +! +!----------------------------------------------------------------------- + + cpl_stop_now = init_time_flag('stop_now',default=.false.) + cpl_ts = init_time_flag('coupled_ts', & + freq_opt = coupled_freq_iopt, & + freq = coupled_freq) + cpl_write_restart = init_time_flag('cpl_write_restart') + cpl_write_history = init_time_flag('cpl_write_history') + cpl_write_tavg = init_time_flag('cpl_write_tavg' ) + cpl_diag_global = init_time_flag('cpl_diag_global') + cpl_diag_transp = init_time_flag('cpl_diag_transp') + + lsmft_avail = .true. + tlast_coupled = c0 + + +!----------------------------------------------------------------------- +! +! initialize and send buffer +! +!----------------------------------------------------------------------- + + isbuf = 0 + + isbuf(cpl_fields_ibuf_cdate ) = iyear*10000 + imonth*100 + iday + isbuf(cpl_fields_ibuf_sec ) = & + ihour*seconds_in_hour + iminute*seconds_in_minute + isecond + +!maltrud ASSUME NBLOCKS_CLINIC = 1 + iblock = 1 + this_block = get_block(blocks_clinic(iblock),iblock) + + isbuf(cpl_fields_ibuf_lsize ) = (this_block%ie-this_block%ib+1)* & + (this_block%je-this_block%jb+1) + isbuf(cpl_fields_ibuf_lisize ) = (this_block%ie-this_block%ib+1) + isbuf(cpl_fields_ibuf_ljsize ) = (this_block%je-this_block%jb+1) + isbuf(cpl_fields_ibuf_gsize ) = nx_global*ny_global + isbuf(cpl_fields_ibuf_gisize ) = nx_global + isbuf(cpl_fields_ibuf_gjsize ) = ny_global + isbuf(cpl_fields_ibuf_ncpl ) = ncouple_per_day + isbuf(cpl_fields_ibuf_nfields) = cpl_fields_grid_total + isbuf(cpl_fields_ibuf_dead ) = 0 ! not a dead model + + allocate(sbuf((this_block%ie-this_block%ib+1)*(this_block%je-this_block%jb+1) & + , cpl_fields_grid_total)) + sbuf = -888.0 + n=0 + + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n=n+1 + sbuf(n,cpl_fields_grid_lon ) = radian*TLON(i,j,iblock) + sbuf(n,cpl_fields_grid_lat ) = radian*TLAT(i,j,iblock) + sbuf(n,cpl_fields_grid_area ) = TAREA(i,j,iblock)/(radius*radius) + sbuf(n,cpl_fields_grid_mask ) = float(REGION_MASK(i,j,iblock)) + sbuf(n,cpl_fields_grid_index) = & + (this_block%j_glob(j)-1)*(nx_global) + this_block%i_glob(i) + enddo + enddo + enddo + +!----------------------------------------------------------------------- +! initialize the contracts +!----------------------------------------------------------------------- + + call cpl_interface_contractInit(contractS,cpl_fields_ocnname, & + cpl_fields_cplname,cpl_fields_o2c_fields,isbuf,sbuf) + call cpl_interface_contractInit(contractR,cpl_fields_ocnname, & + cpl_fields_cplname,cpl_fields_c2o_fields,isbuf,sbuf) + + write(stdout,*) '(ocn) Initialized contracts with coupler' + call shr_sys_flush(stdout) + + deallocate(sbuf) + + !--- allocate SBUFF_SUM + nsend = cpl_interface_contractNumatt(contractS) + allocate (SBUFF_SUM(nx_block,ny_block,max_blocks_clinic,nsend)) + + !--- determine send indices + index_o2c_So_u = cpl_interface_contractIndex(contractS,'So_u') + index_o2c_So_v = cpl_interface_contractIndex(contractS,'So_v') + index_o2c_So_t = cpl_interface_contractIndex(contractS,'So_t') + index_o2c_So_s = cpl_interface_contractIndex(contractS,'So_s') + index_o2c_So_dhdx = cpl_interface_contractIndex(contractS,'So_dhdx') + index_o2c_So_dhdy = cpl_interface_contractIndex(contractS,'So_dhdy') + index_o2c_Fioo_q = cpl_interface_contractIndex(contractS,'Fioo_q') + + !--- determine receive indices + index_c2o_Foxx_taux = cpl_interface_contractIndex(contractR,'Foxx_taux') + index_c2o_Foxx_tauy = cpl_interface_contractIndex(contractR,'Foxx_tauy') + index_c2o_Foxx_snow = cpl_interface_contractIndex(contractR,'Foxx_snow') + index_c2o_Foxx_rain = cpl_interface_contractIndex(contractR,'Foxx_rain') + index_c2o_Foxx_evap = cpl_interface_contractIndex(contractR,'Foxx_evap') + index_c2o_Foxx_meltw = cpl_interface_contractIndex(contractR,'Foxx_meltw') + index_c2o_Foxx_salt = cpl_interface_contractIndex(contractR,'Foxx_salt') + index_c2o_Foxx_swnet = cpl_interface_contractIndex(contractR,'Foxx_swnet') + index_c2o_Foxx_sen = cpl_interface_contractIndex(contractR,'Foxx_sen') + index_c2o_Foxx_lwup = cpl_interface_contractIndex(contractR,'Foxx_lwup') + index_c2o_Foxx_lwdn = cpl_interface_contractIndex(contractR,'Foxx_lwdn') + index_c2o_Foxx_melth = cpl_interface_contractIndex(contractR,'Foxx_melth') + index_c2o_Si_ifrac = cpl_interface_contractIndex(contractR,'Si_ifrac') + index_c2o_Sa_pslv = cpl_interface_contractIndex(contractR,'Sa_pslv') + index_c2o_Faoc_duu10n = cpl_interface_contractIndex(contractR,'Faoc_duu10n') + index_c2o_Forr_roff = cpl_interface_contractIndex(contractR,'Forr_roff') + + !--- receive initial message from coupler + call cpl_interface_ibufRecv(cpl_fields_cplname,irbuf) + +!----------------------------------------------------------------------- +! +! send initial state info to coupler +! +!----------------------------------------------------------------------- + + call sum_buffer + + call send_to_coupler + +!----------------------------------------------------------------------- +! +! initialize timers for coupled model +! +!----------------------------------------------------------------------- + + call get_timer (timer_send_to_cpl , 'SEND' , 1, & + distrb_clinic%nprocs) + call get_timer (timer_recv_from_cpl, 'RECV' , 1, & + distrb_clinic%nprocs) + call get_timer (timer_recv_to_send , 'RECV to SEND', 1, & + distrb_clinic%nprocs) + call get_timer (timer_send_to_recv , 'SEND to RECV', 1, & + distrb_clinic%nprocs) + +#endif +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + end subroutine init_coupled + +!*********************************************************************** + +!BOP +! !IROUTINE: set_coupled_forcing +! !INTERFACE: + + subroutine set_coupled_forcing(SMF,SMFT,STF,SHF_QSW,FW,TFW,IFRAC, & + ATM_PRESS, U10_SQR) + + +! !DESCRIPTION: +! This routine call coupler communication routines to set +! surface forcing data +! Note: We are using intent "inout" for SMF,SMFT, STF, SHF_QSW +! and IFRAC in order to preserve their values inbetween +! coupling timesteps. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,2,max_blocks_clinic), & + intent(inout) :: & + SMF, &! surface momentum fluxes (wind stress) + SMFT ! surface momentum fluxes at T points + + real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & + intent(inout) :: & + STF, &! surface tracer fluxes + TFW ! tracer concentration in water flux + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(inout) :: & + SHF_QSW, &! penetrative solar heat flux + FW, &! fresh water flux + IFRAC, &! fractional ice coverage + ATM_PRESS, &! atmospheric pressure forcing + U10_SQR ! 10m wind speed squared + +!EOP +!BOC + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n, iblock + + + +#if coupled +!----------------------------------------------------------------------- +! +! if it is time to couple, exchange data with flux coupler +! be sure to trigger communication on very first time step +! +!----------------------------------------------------------------------- + + if (nsteps_run /= 0) call sum_buffer + + if (check_time_flag(cpl_ts) .or. nsteps_run == 0) then + + !*** send state variables at end of coupling interval + + + if (nsteps_run /= 0) then + call timer_stop (timer_recv_to_send) + + call timer_start (timer_send_to_cpl) + call send_to_coupler + call timer_stop (timer_send_to_cpl) + endif + + call timer_start (timer_send_to_recv) + call timer_stop (timer_send_to_recv) + + !*** recv data to advance next time step + + call timer_start (timer_recv_from_cpl) + call recv_from_coupler(SMF,SMFT,STF,SHF_QSW,FW,TFW,IFRAC,ATM_PRESS, & + U10_SQR) + call timer_stop (timer_recv_from_cpl) + + call timer_start (timer_recv_to_send) + + !$OMP PARALLEL DO PRIVATE(iblock,n) + + do iblock = 1, nblocks_clinic + if ( shf_formulation == 'partially-coupled' ) then + SHF_COMP(:,:,iblock,shf_comp_cpl) = STF(:,:,1,iblock) + if ( .not. lms_balance ) then + SHF_COMP(:,:,iblock,shf_comp_cpl) = & + SHF_COMP(:,:,iblock,shf_comp_cpl) * MASK_SR(:,:,iblock) + SHF_QSW(:,:,iblock) = SHF_QSW(:,:,iblock) * MASK_SR(:,:,iblock) + endif + endif + + SHF_COMP(:,:,iblock,shf_comp_qsw) = SHF_QSW(:,:,iblock) + + if ( sfwf_formulation == 'partially-coupled' ) then + + if (sfc_layer_type == sfc_layer_varthick .and. & + .not. lfw_as_salt_flx) then + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & + FW(:,:,iblock) * MASK_SR(:,:,iblock) + do n=1,nt + TFW_COMP(:,:,n,iblock,tfw_comp_cpl) = & + TFW(:,:,n,iblock) * MASK_SR(:,:,iblock) + enddo + else + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = & + STF(:,:,2,iblock) * MASK_SR(:,:,iblock) + endif + + else + + if ( sfc_layer_type == sfc_layer_varthick .and. & + .not. lfw_as_salt_flx .and. liceform ) then + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) = FW(:,:,iblock) + TFW_COMP (:,:,:,iblock,tfw_comp_cpl) = TFW(:,:,:,iblock) + endif + + endif + + if ( luse_cpl_ifrac ) then + OCN_WGT(:,:,iblock) = (c1-IFRAC(:,:,iblock)) * RCALCT(:,:,iblock) + endif + + + enddo + !$OMP END PARALLEL DO + + endif + +#endif +!----------------------------------------------------------------------- +!EOC + + end subroutine set_coupled_forcing + +!*********************************************************************** + +!BOP +! !IROUTINE: set_combined_forcing +! !INTERFACE: + + subroutine set_combined_forcing (STF,FW,TFW) + +! !DESCRIPTION: +! +! This routine combines terms when the "partially-coupled" +! has been selected +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), & + intent(inout) :: & + STF, &! surface tracer fluxes at current timestep + TFW ! tracer concentration in water flux + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(inout) :: & + FW ! fresh water flux + + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + iblock, &! local address of current block + n ! index + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + WORK1, WORK2 ! local work arrays + +#if coupled + + if ( shf_formulation == 'partially-coupled' ) then + !$OMP PARALLEL DO PRIVATE(iblock) + do iblock=1,nblocks_clinic + STF(:,:,1,iblock) = SHF_COMP(:,:,iblock,shf_comp_wrest) & + + SHF_COMP(:,:,iblock,shf_comp_srest) & + + SHF_COMP(:,:,iblock,shf_comp_cpl) + enddo + !$OMP END PARALLEL DO + endif + + if ( sfwf_formulation == 'partially-coupled' ) then + if (sfc_layer_type == sfc_layer_varthick .and. & + .not. lfw_as_salt_flx) then + !$OMP PARALLEL DO PRIVATE(iblock,n) + do iblock=1,nblocks_clinic + STF(:,:,2,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_wrest) & + + SFWF_COMP(:,:, iblock,sfwf_comp_srest) + FW(:,:,iblock) = SFWF_COMP(:,:, iblock,sfwf_comp_cpl) & + + SFWF_COMP(:,:, iblock,sfwf_comp_flxio) + TFW(:,:,:,iblock) = TFW_COMP(:,:,:,iblock, tfw_comp_cpl) & + + TFW_COMP(:,:,:,iblock, tfw_comp_flxio) + enddo + !$OMP END PARALLEL DO + else + if ( lms_balance ) then + + !$OMP PARALLEL DO PRIVATE(iblock,WORK1,WORK2) + do iblock=1,nblocks_clinic + WORK1(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_flxio) / & + salinity_factor + WORK2(:,:,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_cpl) + enddo + !$OMP END PARALLEL DO + + call ms_balancing (WORK2, EVAP_F,PREC_F, MELT_F, ROFF_F, & + SALT_F, QFLUX, 'salt', ICEOCN_F=WORK1) + + !$OMP PARALLEL DO PRIVATE(iblock,WORK2) + do iblock=1,nblocks_clinic + STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + + WORK2(:,:,iblock) & + + SFWF_COMP(:,:,iblock,sfwf_comp_flxio)* & + MASK_SR(:,:,iblock) + enddo + !$OMP END PARALLEL DO + + else + + !$OMP PARALLEL DO PRIVATE(iblock) + do iblock=1,nblocks_clinic + STF(:,:,2,iblock) = SFWF_COMP(:,:,iblock,sfwf_comp_wrest) & + + SFWF_COMP(:,:,iblock,sfwf_comp_srest) & + + SFWF_COMP(:,:,iblock,sfwf_comp_cpl) & + + SFWF_COMP(:,:,iblock,sfwf_comp_flxio) + enddo + !$OMP END PARALLEL DO + + endif + endif + endif + + +#endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_combined_forcing + +#if coupled +!*********************************************************************** + +!BOP +! !IROUTINE: recv_from_coupler +! !INTERFACE: + + subroutine recv_from_coupler(SMF,SMFT,STF,SHF_QSW,FW,TFW, & + IFRAC,ATM_PRESS,U10_SQR) + +! !DESCRIPTION: +! This routine receives message from coupler with surface flux data +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,2,max_blocks_clinic), intent(out) :: & + SMF, &! surface momentum fluxes (wind stress) + SMFT ! surface momentum fluxes at T points + + real (r8), dimension(nx_block,ny_block,nt,max_blocks_clinic), intent(out) :: & + STF, &! surface tracer fluxes + TFW ! tracer concentration in water flux + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), intent(out) :: & + SHF_QSW, &! penetrative solar heat flux + FW, &! fresh water flux + IFRAC, &! fractional ice coverage + ATM_PRESS, &! atmospheric pressure forcing + U10_SQR ! 10m wind speed squared + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: label + + integer (int_kind) :: & + nrecv, & + i,j,k,n,iblock + + real (r8), dimension(nx_block,ny_block) :: & + WORKB + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + WORK1, WORK2, &! local work space + WORK3, WORK4, &! local work space + WORK5 ! local work space + + real (r8) :: & + m2percm2, & + gsum + + type (block) :: this_block ! local block info + +!----------------------------------------------------------------------- +! +! receive message from coupler and check for terminate signal +! +!----------------------------------------------------------------------- + + nrecv = cpl_interface_contractNumatt(contractR) + +!maltrud ASSUME NBLOCKS_CLINIC = 1 + iblock = 1 + this_block = get_block(blocks_clinic(iblock),iblock) + + allocate(sbuf((this_block%ie-this_block%ib+1)*(this_block%je-this_block%jb+1), & + nrecv)) + call cpl_interface_contractRecv(cpl_fields_cplname,contractR, & + irbuf,sbuf) + +!----------------------------------------------------------------------- +! +! check all coupler flags and respond appropriately +! +!----------------------------------------------------------------------- + + if (irbuf(cpl_fields_ibuf_stopnow) == 1) then + call set_time_flag(cpl_stop_now,.true.) + if (my_task == master_task) then + call int_to_char (4,iyear , cyear ) + call int_to_char (2,imonth , cmonth ) + call int_to_char (2,iday , cday ) + call int_to_char (2,ihour , chour ) + call int_to_char (2,iminute , cminute) + call int_to_char (2,isecond , csecond) + write(stdout,*) '(recv_from_coupler) ', & + 'cpl requests termination now: ', & + cyear,'/',cmonth,'/',cday,' ', chour,':',cminute,':',csecond + endif + RETURN + endif + + + if (irbuf(cpl_fields_ibuf_infobug) >= 2) then + ldiag_cpl = .true. + else + ldiag_cpl = .false. + endif + + if (irbuf(cpl_fields_ibuf_resteod) == 1) then + call set_time_flag(cpl_write_restart,.true.) + if (my_task == master_task) then + write(stdout,*) '(recv_from_coupler) ', & + 'cpl requests restart file at eod ',cyear,'/',cmonth,'/',cday + endif + endif + +! if (irbuf(cpl_fields_ibuf_histeod) == 1) then +! ignore for now +! call set_time_flag(cpl_write_history,.true.) +! call int_to_char (4,iyear , cyear ) +! call int_to_char (2,imonth ,cmonth ) +! call int_to_char (2,iday ,cday ) +! call int_to_char (2,ihour ,chour ) +! call int_to_char (2,iminute ,cminute) +! call int_to_char (2,isecond ,csecond) +! if (my_task == master_task) then +! write(stdout,*) ' cpl requests history file at eod ' & +! , ' ', cyear,'/',cmonth,'/',cday, ' ' +! endif +! endif + + +! if (irbuf(cpl_fields_ibuf_histtavg) == 1) then +! ignore for now +! call set_time_flag(cpl_write_tavg, .true.) +! call int_to_char (4,iyear , cyear ) +! call int_to_char (2,imonth ,cmonth ) +! call int_to_char (2,iday ,cday ) +! call int_to_char (2,ihour ,chour ) +! call int_to_char (2,iminute ,cminute) +! call int_to_char (2,isecond ,csecond) +! if (my_task == master_task) then +! write(stdout,*) ' cpl requests tavg file at eod ' & +! , ' ', cyear,'/',cmonth,'/',cday, ' ' +! endif +! endif + + if (irbuf(cpl_fields_ibuf_diageod) == 1) then + call set_time_flag(cpl_diag_global,.true.) + call set_time_flag(cpl_diag_transp,.true.) + + call int_to_char (4,iyear ,cyear ) + call int_to_char (2,imonth ,cmonth ) + call int_to_char (2,iday ,cday ) + call int_to_char (2,ihour ,chour ) + call int_to_char (2,iminute ,cminute) + call int_to_char (2,isecond ,csecond) + + if (my_task == master_task) then + write(stdout,*) ' cpl requests diagnostics at eod ' , & + ' ', cyear,'/',cmonth,'/',cday, ' ' + endif + endif + +!----------------------------------------------------------------------- +! +! unpack and distribute wind stress, then convert to correct units +! and rotate components to local coordinates +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + WORK1(i,j,iblock) = sbuf(n,index_c2o_Foxx_taux) + WORK2(i,j,iblock) = sbuf(n,index_c2o_Foxx_tauy) + enddo + enddo + enddo + + !*** + !*** do boundary updates now to ensure correct T->U grid + !*** + + call update_ghost_cells(WORK1, bndy_clinic, & + field_loc_center, field_type_vector) + call update_ghost_cells(WORK2, bndy_clinic, & + field_loc_center, field_type_vector) + + n = 0 + do iblock = 1, nblocks_clinic + + !*** + !*** Rotate true zonal/meridional wind stress into local + !*** coordinates and convert to dyne/cm**2 + !*** + + SMFT(:,:,1,iblock) = (WORK1(:,:,iblock)*cos(ANGLET(:,:,iblock)) + & + WORK2(:,:,iblock)*sin(ANGLET(:,:,iblock)))* & + RCALCT(:,:,iblock)*momentum_factor + SMFT(:,:,2,iblock) = (WORK2(:,:,iblock)*cos(ANGLET(:,:,iblock)) - & + WORK1(:,:,iblock)*sin(ANGLET(:,:,iblock)))* & + RCALCT(:,:,iblock)*momentum_factor + + !*** + !*** Shift SMFT to U grid + !*** + + call tgrid_to_ugrid(SMF(:,:,1,iblock),SMFT(:,:,1,iblock),iblock) + call tgrid_to_ugrid(SMF(:,:,2,iblock),SMFT(:,:,2,iblock),iblock) + +!----------------------------------------------------------------------- +! +! unpack and distribute fresh water flux and salt flux +! +!----------------------------------------------------------------------- + + this_block = get_block(blocks_clinic(iblock),iblock) + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + SNOW_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_snow) + WORKB (i,j ) = sbuf(n,index_c2o_Foxx_rain) + EVAP_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_evap) + MELT_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_meltw) + ROFF_F(i,j,iblock) = sbuf(n,index_c2o_Forr_roff) + SALT_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_salt) + + PREC_F(i,j,iblock) = WORKB(i,j) + SNOW_F(i,j,iblock) ! rain + snow + + WORKB(i,j ) = sbuf(n,index_c2o_Foxx_swnet) + SHF_QSW(i,j,iblock) = WORKB(i,j)* & + RCALCT(i,j,iblock)*hflux_factor ! convert from W/m**2 + + SENH_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_sen) + LWUP_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_lwup) + LWDN_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_lwdn) + MELTH_F(i,j,iblock) = sbuf(n,index_c2o_Foxx_melth) + + WORKB(i,j ) = sbuf(n,index_c2o_Si_ifrac) + IFRAC(i,j,iblock) = WORKB(i,j) * RCALCT(i,j,iblock) + + !*** converting from Pa to dynes/cm**2 + WORKB(i,j ) = sbuf(n,index_c2o_Sa_pslv) + ATM_PRESS(i,j,iblock) = c10 * WORKB(i,j) * RCALCT(i,j,iblock) + + !*** converting from m**2/s**2 to cm**2/s**2 + WORKB(i,j ) = sbuf(n,index_c2o_Faoc_duu10n) + U10_SQR(i,j,iblock) = cmperm * cmperm * WORKB(i,j) * RCALCT(i,j,iblock) + + enddo + enddo + + enddo + + call update_ghost_cells(SNOW_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(PREC_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(EVAP_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(MELT_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(ROFF_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(SALT_F, bndy_clinic, & + field_loc_center, field_type_scalar) + + call update_ghost_cells(SENH_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(LWUP_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(LWDN_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(MELTH_F, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(SHF_QSW, bndy_clinic, & + field_loc_center, field_type_scalar) + + call update_ghost_cells(IFRAC, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(ATM_PRESS, bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(U10_SQR, bndy_clinic, & + field_loc_center, field_type_scalar) + +!----------------------------------------------------------------------- +! +! combine heat flux components into STF array and convert from W/m**2 +! (note: latent heat flux = evaporation*latent_heat_vapor) +! (note: snow melt heat flux = - snow_f*latent_heat_fusion_mks) +! +!----------------------------------------------------------------------- + + + !$OMP PARALLEL DO PRIVATE(iblock) + do iblock = 1, nblocks_clinic + STF(:,:,1,iblock) = (EVAP_F(:,:,iblock)*latent_heat_vapor & + + SENH_F(:,:,iblock) + LWUP_F(:,:,iblock) & + + LWDN_F(:,:,iblock) + MELTH_F(:,:,iblock) & + - SNOW_F(:,:,iblock) * latent_heat_fusion_mks)* & + RCALCT(:,:,iblock)*hflux_factor + enddo + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! combine freshwater flux components +! +! for variable thickness surface layer, compute fresh water and +! salt fluxes +! +!----------------------------------------------------------------------- + + if (sfc_layer_type == sfc_layer_varthick .and. & + .not. lfw_as_salt_flx) then + + !*** compute fresh water flux (cm/s) + + !$OMP PARALLEL DO PRIVATE(iblock,n) + do iblock = 1, nblocks_clinic + + FW(:,:,iblock) = RCALCT(:,:,iblock) * & + ( PREC_F(:,:,iblock)+EVAP_F(:,:,iblock) & + +ROFF_F(:,:,iblock))*fwmass_to_fwflux + + WORK1(:,:,iblock) = RCALCT(:,:,iblock) * & + MELT_F(:,:,iblock) * fwmass_to_fwflux + + !*** compute tracer concentration in fresh water + !*** in principle, temperature of each water flux + !*** could be different. e.g. + !TFW(:,:,1,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & + ! (PREC_F(:,:,iblock)*TEMP_PREC(:,:,iblock) + & + ! EVAP_F(:,:,iblock)*TEMP_EVAP(:,:,iblock) + & + ! MELT_F(:,:,iblock)*TEMP_MELT(:,:,iblock) + & + ! ROFF_F(:,:,iblock)*TEMP_ROFF(:,:,iblock)) + !*** currently assume water comes in at sea surface temp + + call tmelt(WORK2(:,:,iblock),TRACER(:,:,1,2,curtime,iblock)) + TFW(:,:,1,iblock) = FW(:,:,iblock)*TRACER(:,:,1,1,curtime,iblock) & + + WORK1(:,:,iblock) * WORK2(:,:,iblock) + + FW(:,:,iblock) = FW(:,:,iblock) + WORK1(:,:,iblock) + + !*** compute salt flux + !*** again, salinity could be different for each + !*** component of water flux + !TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*fwmass_to_fwflux & + ! (PREC_F(:,:,iblock)*SALT_PREC(:,:,iblock) + & + ! EVAP_F(:,:,iblock)*SALT_EVAP(:,:,iblock) + & + ! MELT_F(:,:,iblock)*SALT_MELT(:,:,iblock) + & + ! ROFF_F(:,:,iblock)*SALT_ROFF(:,:,iblock)) + !*** currently assume prec, evap and roff are fresh + !*** and all salt come from ice melt + + where (MELT_F(:,:,iblock) /= c0) + WORK1(:,:,iblock) = & + SALT_F(:,:,iblock)/MELT_F(:,:,iblock) ! salinity (msu) of melt water + elsewhere + WORK1(:,:,iblock) = c0 + end where + + TFW(:,:,2,iblock) = RCALCT(:,:,iblock)*MELT_F(:,:,iblock)* & + fwmass_to_fwflux*WORK1(:,:,iblock) + ! + PREC_F(:,:,iblock)*c0 + EVAP_F(:,:,iblock)*c0 + ROFF_F(:,:,iblock)*c0 + + do n=3,nt + TFW(:,:,n,iblock) = c0 ! no additional tracers in fresh water + end do + + enddo + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! if not a variable thickness surface layer or if fw_as_salt_flx +! flag is on, convert fresh and salt inputs to a virtual salinity flux +! +!----------------------------------------------------------------------- + + else ! convert fresh water to virtual salinity flux + + !$OMP PARALLEL DO PRIVATE(iblock) + do iblock = 1, nblocks_clinic + STF(:,:,2,iblock) = RCALCT(:,:,iblock)*( & + (PREC_F(:,:,iblock)+EVAP_F(:,:,iblock)+ & + MELT_F(:,:,iblock)+ROFF_F(:,:,iblock))*salinity_factor & + + SALT_F(:,:,iblock)*sflux_factor) + enddo + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! balance salt/freshwater in marginal seas +! +!----------------------------------------------------------------------- + + if (lms_balance .and. sfwf_formulation /= 'partially-coupled' ) then + call ms_balancing (STF(:,:,2,:),EVAP_F, PREC_F, MELT_F,ROFF_F, & + SALT_F, QFLUX, 'salt') + endif + + endif + +!----------------------------------------------------------------------- +! +! diagnostics +! +!----------------------------------------------------------------------- + + if (ldiag_cpl) then + + if (my_task == master_task) then + call int_to_char (4,iyear ,cyear ) + call int_to_char (2,imonth ,cmonth ) + call int_to_char (2,iday ,cday ) + call int_to_char (2,ihour ,chour ) + call int_to_char (2,iminute ,cminute) + call int_to_char (2,isecond ,csecond) + write(stdout,*)' Global averages of fluxes received from cpl', & + ' at ', cyear,'/',cmonth ,'/',cday, & + ' ', chour,':',cminute,':',csecond + call shr_sys_flush(stdout) + endif + + m2percm2 = mpercm*mpercm + do k = 1,nrecv + + n = 0 + !$OMP PARALLEL DO PRIVATE(iblock,n) + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + WORK1(i,j,iblock) = sbuf(n,k) ! mult. by TAREA in global_sum_prod + enddo + enddo + enddo + !$OMP END PARALLEL DO + +!maltrud do we need this update +! call update_ghost_cells(WORK1, bndy_clinic, & +! field_loc_center, field_type_scalar) + gsum = global_sum_prod(WORK1 , TAREA, distrb_clinic, & + field_loc_center, RCALCT)*m2percm2 + if (my_task == master_task) then + call cpl_fields_getField(label,k,cpl_fields_c2o_fields) + write(stdout,1100)'ocn','recv', label ,gsum + endif + enddo + if (my_task == master_task) call shr_sys_flush(stdout) + endif + + deallocate(sbuf) + +1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6) + +!----------------------------------------------------------------------- +!EOC + + end subroutine recv_from_coupler + +!*********************************************************************** + +!BOP +! !IROUTINE: send_to_coupler +! !INTERFACE: + + subroutine send_to_coupler + +! !DESCRIPTION: +! This routine packs fields into a message buffer and sends the +! message to the flux coupler +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: label + + integer (int_kind) :: & + i,j,k,n,iblock, & + nsend + + real (r8), dimension(nx_block,ny_block) :: & + WORK1, WORK2, &! local work space + WORK3, WORK4 + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + WORKA ! local work space with full block dimension + + real (r8) :: & + m2percm2, & + gsum + + type (block) :: this_block ! local block info + +!----------------------------------------------------------------------- +! +! initialize control buffer +! +!----------------------------------------------------------------------- + + nsend = cpl_interface_contractNumatt(contractS) + iblock = 1 + this_block = get_block(blocks_clinic(iblock),iblock) + + allocate(sbuf((this_block%ie-this_block%ib+1)*(this_block%je-this_block%jb+1) & + , nsend)) + + isbuf = 0 + + if (check_time_flag(cpl_stop_now)) then + isbuf(cpl_fields_ibuf_stopnow) = 1 + endif + + + isbuf(cpl_fields_ibuf_cdate) = iyear*10000 + imonth*100 + iday + isbuf(cpl_fields_ibuf_sec) = & + ihour*seconds_in_hour + iminute*seconds_in_minute + isecond + + if ( lsend_precip_fact ) & ! send real as integer + isbuf(cpl_fields_ibuf_precadj) = precip_fact * 1.0e6_r8 + +!----------------------------------------------------------------------- +! +! interpolate onto T-grid points and rotate on T grid +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + + call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2c_So_u),iblock) + call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2c_So_v),iblock) + + WORK1 = (WORK3*cos(ANGLET(:,:,iblock))+WORK4*sin(-ANGLET(:,:,iblock))) & + * mpercm/tlast_coupled + WORK2 = (WORK4*cos(ANGLET(:,:,iblock))-WORK3*sin(-ANGLET(:,:,iblock))) & + * mpercm/tlast_coupled + + this_block = get_block(blocks_clinic(iblock),iblock) + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + sbuf(n,index_o2c_So_u) = WORK1(i,j) + sbuf(n,index_o2c_So_v) = WORK2(i,j) + enddo + enddo + + enddo +!----------------------------------------------------------------------- +! +! convert and pack surface temperature +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + sbuf(n,index_o2c_So_t) = & + SBUFF_SUM(i,j,iblock,index_o2c_So_t)/tlast_coupled + T0_Kelvin + enddo + enddo + enddo + +!----------------------------------------------------------------------- +! +! convert and pack salinity +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + sbuf(n,index_o2c_So_s) = & + SBUFF_SUM(i,j,iblock,index_o2c_So_s)*salt_to_ppt/tlast_coupled + enddo + enddo + enddo + +!----------------------------------------------------------------------- +! +! interpolate onto T-grid points, then rotate on T grid +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + call ugrid_to_tgrid(WORK3,SBUFF_SUM(:,:,iblock,index_o2c_So_dhdx),iblock) + call ugrid_to_tgrid(WORK4,SBUFF_SUM(:,:,iblock,index_o2c_So_dhdy),iblock) + + WORK1 = (WORK3*cos(ANGLET(:,:,iblock)) + WORK4*sin(-ANGLET(:,:,iblock))) & + /grav/tlast_coupled + WORK2 = (WORK4*cos(ANGLET(:,:,iblock)) - WORK3*sin(-ANGLET(:,:,iblock))) & + /grav/tlast_coupled + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + sbuf(n,index_o2c_So_dhdx) = WORK1(i,j) + sbuf(n,index_o2c_So_dhdy) = WORK2(i,j) + enddo + enddo + + enddo +!----------------------------------------------------------------------- +! +! pack heat flux due to freezing/melting (W/m^2) +! QFLUX computation and units conversion occurs in ice.F +! +!----------------------------------------------------------------------- + + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + sbuf(n,index_o2c_Fioo_q) = QFLUX(i,j,iblock) + enddo + enddo + enddo + + tlast_ice = c0 + AQICE = c0 + QICE = c0 + + +!----------------------------------------------------------------------- +! +! send fields to coupler +! +!----------------------------------------------------------------------- + + call cpl_interface_contractSend(cpl_fields_cplname,contractS,isbuf,sbuf) + +!----------------------------------------------------------------------- +! +! diagnostics +! +!----------------------------------------------------------------------- + + if (ldiag_cpl) then + if (my_task == master_task) then + call int_to_char (4,iyear ,cyear ) + call int_to_char (2,imonth ,cmonth ) + call int_to_char (2,iday ,cday ) + call int_to_char (2,ihour ,chour ) + call int_to_char (2,iminute ,cminute) + call int_to_char (2,isecond ,csecond) + write(stdout,*) ' Global averages of fluxes sent to cpl at ' & + , ' ', cyear,'/',cmonth, '/',cday & + , ' ', chour,':',cminute,':',csecond + call shr_sys_flush(stdout) + endif + + m2percm2 = mpercm*mpercm + do k = 1,nsend + n = 0 + do iblock = 1, nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + n = n + 1 + WORKA(i,j,iblock) = sbuf(n,k) + enddo + enddo + enddo + call update_ghost_cells(WORKA, bndy_clinic, & + field_loc_center, field_type_scalar) + gsum = global_sum_prod(WORKA , TAREA, distrb_clinic, & + field_loc_center, RCALCT)*m2percm2 + if (my_task == master_task) then + call cpl_fields_getField(label,k,cpl_fields_o2c_fields) + write(stdout,1100)'ocn','send', label ,gsum + endif + enddo + if (my_task == master_task) call shr_sys_flush(stdout) + endif + +1100 format ('comm_diag ', a3, 1x, a4, 1x, a8, 1x, es26.19:, 1x, a6) + + tlast_coupled = c0 + + deallocate(sbuf) + +!----------------------------------------------------------------------- +!EOC + + end subroutine send_to_coupler + +!*********************************************************************** + +!BOP +! !IROUTINE: sum_buffer +! !INTERFACE: + + subroutine sum_buffer + +! !DESCRIPTION: +! This routine accumulates sums for averaging fields to +! be sent to the coupler +! +! !REVISION HISTORY: +! same as module +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + delt ! time interval since last step + + integer (int_kind) :: iblock + +!----------------------------------------------------------------------- +! +! zero buffer if this is the first time after a coupling interval +! +!----------------------------------------------------------------------- + + if (tlast_coupled == c0) SBUFF_SUM = c0 + +!----------------------------------------------------------------------- +! +! update time since last coupling +! +!----------------------------------------------------------------------- + + if (avg_ts .or. back_to_back) then + delt = p5*dtt + else + delt = dtt + endif + tlast_coupled = tlast_coupled + delt + +!----------------------------------------------------------------------- +! +! accumulate sums of U,V,T,S and GRADP +! ice formation flux is handled separately in ice routine +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblock) + do iblock = 1, nblocks_clinic + SBUFF_SUM(:,:,iblock,index_o2c_So_u) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_u) + delt* & + UVEL(:,:,1,curtime,iblock) + + SBUFF_SUM(:,:,iblock,index_o2c_So_v) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_v) + delt* & + VVEL(:,:,1,curtime,iblock) + + SBUFF_SUM(:,:,iblock,index_o2c_So_t ) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_t ) + delt* & + TRACER(:,:,1,1,curtime,iblock) + + SBUFF_SUM(:,:,iblock,index_o2c_So_s ) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_s ) + delt* & + TRACER(:,:,1,2,curtime,iblock) + + SBUFF_SUM(:,:,iblock,index_o2c_So_dhdx) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_dhdx) + delt* & + GRADPX(:,:,curtime,iblock) + + SBUFF_SUM(:,:,iblock,index_o2c_So_dhdy) = & + SBUFF_SUM(:,:,iblock,index_o2c_So_dhdy) + delt* & + GRADPY(:,:,curtime,iblock) + enddo + !$OMP END PARALLEL DO + + end subroutine sum_buffer + + +!----------------------------------------------------------------------- +!EOC + +!*********************************************************************** +!BOP +! !IROUTINE: tavg_coupled_forcing +! !INTERFACE: + + subroutine tavg_coupled_forcing + +! !DESCRIPTION: +! This routine accumulates tavg diagnostics related to forcing_coupled +! forcing. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + iblock ! block loop index + + type (block) :: & + this_block ! block information for current block + + real (r8), dimension(nx_block,ny_block) :: & + WORK ! local temp space for tavg diagnostics + +!----------------------------------------------------------------------- +! +! compute and accumulate tavg forcing diagnostics +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblock,this_block,WORK) + + do iblock = 1,nblocks_clinic + + this_block = get_block(blocks_clinic(iblock),iblock) + + if (tavg_requested(tavg_EVAP_F)) then + call accumulate_tavg_field(EVAP_F(:,:,iblock), & + tavg_EVAP_F,iblock,1) + endif + + if (tavg_requested(tavg_PREC_F)) then + call accumulate_tavg_field(PREC_F(:,:,iblock), & + tavg_PREC_F,iblock,1) + endif + + if (tavg_requested(tavg_SNOW_F)) then + call accumulate_tavg_field(SNOW_F(:,:,iblock), & + tavg_SNOW_F,iblock,1) + endif + + if (tavg_requested(tavg_MELT_F)) then + call accumulate_tavg_field(MELT_F(:,:,iblock), & + tavg_MELT_F,iblock,1) + endif + + if (tavg_requested(tavg_ROFF_F)) then + call accumulate_tavg_field(ROFF_F(:,:,iblock), & + tavg_ROFF_F,iblock,1) + endif + + if (tavg_requested(tavg_SALT_F)) then + call accumulate_tavg_field(SALT_F(:,:,iblock), & + tavg_SALT_F,iblock,1) + endif + + if (tavg_requested(tavg_SENH_F)) then + call accumulate_tavg_field(SENH_F(:,:,iblock), & + tavg_SENH_F,iblock,1) + endif + + if (tavg_requested(tavg_LWUP_F)) then + call accumulate_tavg_field(LWUP_F(:,:,iblock), & + tavg_LWUP_F,iblock,1) + endif + + if (tavg_requested(tavg_LWDN_F)) then + call accumulate_tavg_field(LWDN_F(:,:,iblock), & + tavg_LWDN_F,iblock,1) + endif + + if (tavg_requested(tavg_MELTH_F)) then + call accumulate_tavg_field(MELTH_F(:,:,iblock), & + tavg_MELTH_F,iblock,1) + endif + + + + end do + + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +!EOC + + end subroutine tavg_coupled_forcing +#endif + +!*********************************************************************** + + end module forcing_coupled + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + diff --git a/components/cism/source_glc/POP_files/grid.F90 b/components/cism/source_glc/POP_files/grid.F90 new file mode 100644 index 0000000000..e879508b38 --- /dev/null +++ b/components/cism/source_glc/POP_files/grid.F90 @@ -0,0 +1,2860 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module grid + +!BOP +! !MODULE: grid +! +! !DESCRIPTION: +! This module contains grid info and routines for setting up the +! POP grid quantities. +! +! !REVISION HISTORY: +! SVN:$Id: grid.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: + + use kinds_mod + use communicate + use blocks + use distribution + use domain_size + use domain + use constants + use io + use broadcast + use gather_scatter + use global_reductions + use boundary + use exit_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_grid1, & + init_grid2, & + tgrid_to_ugrid, & + ugrid_to_tgrid, & + fill_points + +! !PUBLIC DATA MEMBERS: + + real (r8), public :: & + area_u, area_t ,&! total ocean area of U,T cells + volume_u, volume_t ,&! total ocean volume of U,T cells + volume_t_marg ,&! volume of marginal seas (T cells) + area_t_marg ,&! area of marginal seas (T cells) + uarea_equator ! area of equatorial cell + + real (r8), dimension(km), public :: & + area_t_k ,&! total ocean area (T cells) at each dpth + volume_t_k ,&! total ocean volume (T cells) at each dpth + volume_t_marg_k ! tot marginal seas vol (T cells) at each dpth + + integer (int_kind), public :: & + sfc_layer_type ! choice for type of surface layer + + integer (int_kind), parameter, public :: & + sfc_layer_varthick = 1, &! variable thickness surface layer + sfc_layer_rigid = 2, &! rigid lid surface layer + sfc_layer_oldfree = 3 ! old free surface form + + logical (log_kind), public :: & + topo_smooth, &! flag to smooth topography + partial_bottom_cells ! flag for partial bottom cells + + integer (int_kind), dimension(:,:), allocatable, public :: & + KMT_G ! k index of deepest grid cell on global T grid + ! for use in performing work distribution + +!----------------------------------------------------------------------- +! +! grid information for all local blocks +! the local blocks are by default in baroclinic distribution +! +!----------------------------------------------------------------------- + + !*** dimension(1:km) + + real (r8), dimension(km), public :: & + dz ,&! thickness of layer k + c2dz ,&! 2*dz + dzr, dz2r ,&! reciprocals of dz, c2dz + zt ,&! vert dist from sfc to midpoint of layer + zw ! vert dist from sfc to bottom of layer + + !*** dimension(0:km) + + real (r8), dimension(0:km), public :: & + dzw, dzwr ! midpoint of k to midpoint of k+1 + ! and its reciprocal + + !*** geometric 2d arrays + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), public :: & + DXU, DYU ,&! {x,y} spacing centered at U points + DXT, DYT ,&! {x,y} spacing centered at T points + DXUR, DYUR ,&! reciprocals of DXU, DYU + DXTR, DYTR ,&! reciprocals of DXT, DYT + HTN, HTE ,&! cell widths on {N,E} sides of T cell + HUS, HUW ,&! cell widths on {S,W} sides of U cell + ULAT, ULON ,&! {latitude,longitude} of U points + TLAT, TLON ,&! {latitude,longitude} of U points + ANGLE, ANGLET ,&! angle grid makes with latitude line + FCOR, FCORT ,&! coriolis parameter at U,T points + UAREA, TAREA ,&! area of U,T cells + UAREA_R, TAREA_R ,&! reciprocal of area of U,T cells + HT, HU, HUR ! ocean depth at T,U points + + !*** 3d depth fields for partial bottom cells + + real (r8), dimension(:,:,:,:), allocatable, public :: & + DZU, DZT ! thickness of U,T cell for pbc + + !*** 2d landmasks + + integer (int_kind), dimension(nx_block,ny_block,max_blocks_clinic), & + public :: & + KMT ,&! k index of deepest grid cell on T grid + KMU ,&! k index of deepest grid cell on U grid + KMTOLD ! KMT field before smoothing + + logical (log_kind), dimension(nx_block,ny_block,max_blocks_clinic), & + public :: & + CALCT ,&! flag=true if point is an ocean point + CALCU ! at the surface + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), public :: & + RCALCT ,&! real equiv of CALCT,U to use as more + RCALCU ! efficient multiplicative mask + + integer (int_kind), dimension(nx_block,ny_block,max_blocks_clinic), & + public :: & + KMTN,KMTS,KMTE,KMTW ,&! KMT field at neighbor points + KMUN,KMUS,KMUE,KMUW ! KMU field at neighbor points + + integer (int_kind), dimension(nx_block,ny_block,max_blocks_clinic), & + public :: & + KMTEE,KMTNN ! KMT field 2 cells away for upwind stencil + ! allocated and computed in advection module + + integer (int_kind), dimension(:,:,:), allocatable, public :: & + REGION_MASK ! mask defining regions, marginal seas + +!----------------------------------------------------------------------- +! +! define types used with region masks and marginal seas balancing +! +!----------------------------------------------------------------------- + integer (int_kind), parameter, public :: & + max_regions = 15, & ! max no. ocean regions + max_ms = 7 ! max no. marginal seas + + integer (int_kind), public :: & + num_regions, & + num_ms + + type, public :: ms_bal + real (r8) :: lat ! transport latitude + real (r8) :: lon ! transport longitude + real (r8) :: area ! total distribution area + real (r8) :: transport ! total excess/deficit (E+P+M+R) + integer (int_kind) :: mask_index ! index of m-s balancing mask + end type ms_bal + + type, public :: regions ! region-mask info + integer (int_kind) :: number + character (char_len) :: name + logical (log_kind) :: marginal_sea + real (r8 ) :: area + real (r8 ) :: volume + type (ms_bal) :: ms_bal + end type regions + + type (regions),dimension(max_regions), public :: region_info + + integer (int_kind),public :: & + nocean_u, nocean_t, &! num of ocean U,T points + nsurface_u, nsurface_t ! num of ocean U,T points at surface + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module private data +! +!----------------------------------------------------------------------- + + !*** geometric scalars + + integer (int_kind) :: & + jeq ! j index of equatorial cell + + logical (log_kind) :: & + flat_bottom, &! flag for flat-bottom topography + lremove_points ! flag for removing isolated points + + real (r8), dimension(:,:), allocatable :: & + ULAT_G, ULON_G ! {latitude,longitude} of U points + ! in global-sized array + +!----------------------------------------------------------------------- +! +! area-weighted averaging coefficients +! AT{0,S,W,SW} = {central,s,w,sw} coefficients for area-weighted +! averaging of four U points surrounding a T point +! AU{0,N,E,NE} = {central,n,e,ne} coefficients for area-weighted +! averaging of four T points surrounding a U point +! +!----------------------------------------------------------------------- + + real (r8), dimension (nx_block,ny_block,max_blocks_clinic) :: & + AT0,ATS,ATW,ATSW,AU0,AUN,AUE,AUNE + +!----------------------------------------------------------------------- +! +! variables which are shared between init_grid1,init_grid2 +! +!----------------------------------------------------------------------- + + character (char_len) :: & + horiz_grid_opt, &! horizontal grid option + vert_grid_opt, &! vertical grid option + sfc_layer_opt, &! choice for surface layer type + topography_opt, &! topography (KMT) option + horiz_grid_file, &! input file for reading horiz grid info + vert_grid_file, &! input file for reading horiz grid info + topography_file, &! input file for reading horiz grid info + region_mask_file, &! input file for region mask + region_info_file, &! input file with region identification + bottom_cell_file ! input file for thickness of pbc + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_grid1 +! !INTERFACE: + + subroutine init_grid1 + +! !DESCRIPTION: +! Initializes only grid quantities necessary for completing +! decomposition setup (ULAT, ULON, KMT). +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + namelist /grid_nml/horiz_grid_opt, vert_grid_opt, topography_opt, & + horiz_grid_file, vert_grid_file, topography_file,& + topo_smooth, flat_bottom, lremove_points, & + region_mask_file, region_info_file,sfc_layer_opt,& + partial_bottom_cells, bottom_cell_file + + integer (int_kind) :: & + nml_error ! namelist i/o error flag + +!----------------------------------------------------------------------- +! +! read input namelist for grid setup options +! +!----------------------------------------------------------------------- + + horiz_grid_opt = 'internal' + vert_grid_opt = 'internal' + sfc_layer_opt = 'varthick' + topography_opt = 'internal' + horiz_grid_file = 'unknown_horiz_grid_file' + vert_grid_file = 'unknown_vert_grid_file' + topography_file = 'unknown_topography_file' + region_mask_file = 'unknown_region_mask' + region_info_file = 'unknown_region_info' + topo_smooth = .false. + flat_bottom = .false. + lremove_points = .false. + partial_bottom_cells = .false. + bottom_cell_file = 'unknown_bottom_cell_file' + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=grid_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_POP(sigAbort,'ERROR reading grid_nml') + endif + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' Grid:' + write(stdout,blank_fmt) + write(stdout,*) ' grid_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout, grid_nml) + endif + + call broadcast_scalar(horiz_grid_opt, master_task) + call broadcast_scalar(vert_grid_opt , master_task) + call broadcast_scalar(sfc_layer_opt , master_task) + call broadcast_scalar(topography_opt, master_task) + call broadcast_scalar(topo_smooth, master_task) + call broadcast_scalar(flat_bottom, master_task) + call broadcast_scalar(lremove_points, master_task) + call broadcast_scalar(region_mask_file, master_task) + call broadcast_scalar(region_info_file, master_task) + call broadcast_scalar(partial_bottom_cells, master_task) + + if (partial_bottom_cells) then + call broadcast_scalar(bottom_cell_file, master_task) + endif + +!----------------------------------------------------------------------- +! +! get global ULAT,ULON +! +!----------------------------------------------------------------------- + + select case (horiz_grid_opt) + case ('internal') + call horiz_grid_internal(.true.) + case ('file') + call broadcast_scalar(horiz_grid_file, master_task) + call read_horiz_grid(horiz_grid_file,.true.) + case default + call exit_POP(sigAbort,'ERROR: unknown horizontal grid option') + end select + +!----------------------------------------------------------------------- +! +! set up topography by getting global KMT field (used for +! creating a load balanced block distribution). +! +!----------------------------------------------------------------------- + + select case (topography_opt) + case ('internal') + call topography_internal(.true.) + flat_bottom = .true. + case ('file') + call broadcast_scalar(topography_file, master_task) + call read_topography(topography_file,.true.) + case default + call exit_POP(sigAbort,'ERROR: unknown topography option') + end select + +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + + end subroutine init_grid1 + +!*********************************************************************** +!BOP +! !IROUTINE: init_grid2 +! !INTERFACE: + + subroutine init_grid2 + +! !DESCRIPTION: +! Initializes all grid quantities +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,n,iblock, &! dummy loop index variables + range_count ! counter for angle out of range + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + WORK ! local temp space + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + DZBC ! thickness of bottom T cell for pbc + + character (*), parameter :: &! output formats + vgrid_fmt1 = "(3x,' k ',3x,'Thickness (cm)',3x,' Depth (cm) ')", & + vgrid_fmt2 = "(3x,'---',3x,'--------------',3x,'------------')", & + vgrid_fmt3 = "(3x,i3,4x,1pe12.5,4x,1pe12.5)" , & + topo_fmt1 = "(' # surface (T,U) points',2x,i10,2x,i10)" , & + topo_fmt2 = "(' # ocean (T,U) points',2x,i10,2x,i10)" , & + topo_fmt3 = "(' T-area, U-area (km^2)',2(2x,1pe23.15))" , & + topo_fmt4 = "(' T-volume, U-volume (km^3)',2(2x,1pe23.15))" + + type (block) :: & + this_block ! block info for current block + + real (r8) :: & + angle_0, angle_w, &! temporaries for computing angle at T points + angle_s, angle_sw + +!----------------------------------------------------------------------- +! +! output grid setup options to log file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(stdout,delim_fmt) + write(stdout,blank_fmt) + write(stdout,'(a13)') ' Grid options' + write(stdout,blank_fmt) + endif + +!----------------------------------------------------------------------- +! +! set up horizontal grid +! +!----------------------------------------------------------------------- + + select case (horiz_grid_opt) + case ('internal') + if (my_task == master_task) then + write(stdout,'(a36)') ' Creating horizontal grid internally' + endif + call horiz_grid_internal(.false.) + case ('file') + if (my_task == master_task) then + write(stdout,*) ' Reading horizontal grid from file:', & + trim(horiz_grid_file) + endif + call broadcast_scalar(horiz_grid_file, master_task) + call read_horiz_grid(horiz_grid_file,.false.) + case default + call exit_POP(sigAbort,'ERROR: unknown horizontal grid option') + end select + +!----------------------------------------------------------------------- +! +! if boundaries are closed, extend physical domain values into ghost +! cells +! compute other derived quantities like areas and reciprocals +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(i,j,this_block) + do iblock=1,nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + + if (this_block%i_glob(1) == 0) then ! closed western bndy + do j=1,ny_block + do i=1,this_block%ib-1 + DXU(i,j,iblock) = DXU(this_block%ib,j,iblock) + DYU(i,j,iblock) = DYU(this_block%ib,j,iblock) + DXT(i,j,iblock) = DXT(this_block%ib,j,iblock) + DYT(i,j,iblock) = DYT(this_block%ib,j,iblock) + end do + end do + endif + + if (this_block%i_glob(this_block%ie+1) == 0) then ! closed east bndy + do j=1,ny_block + do i=this_block%ie+1,nx_block + DXU(i,j,iblock) = DXU(this_block%ie,j,iblock) + DYU(i,j,iblock) = DYU(this_block%ie,j,iblock) + DXT(i,j,iblock) = DXT(this_block%ie,j,iblock) + DYT(i,j,iblock) = DYT(this_block%ie,j,iblock) + end do + end do + endif + + if (this_block%j_glob(1) == 0) then ! closed southern bndy + do j=1,this_block%jb-1 + do i=1,nx_block + DXU(i,j,iblock) = DXU(i,this_block%jb,iblock) + DYU(i,j,iblock) = DYU(i,this_block%jb,iblock) + DXT(i,j,iblock) = DXT(i,this_block%jb,iblock) + DYT(i,j,iblock) = DYT(i,this_block%jb,iblock) + end do + end do + endif + + if (this_block%j_glob(this_block%je+1) == 0) then ! closed north bndy + do j=this_block%je+1,ny_block + do i=1,nx_block + DXU(i,j,iblock) = DXU(i,this_block%je,iblock) + DYU(i,j,iblock) = DYU(i,this_block%je,iblock) + DXT(i,j,iblock) = DXT(i,this_block%je,iblock) + DYT(i,j,iblock) = DYT(i,this_block%je,iblock) + end do + end do + endif + + DXUR(:,:,iblock) = c1/DXU(:,:,iblock) + DYUR(:,:,iblock) = c1/DYU(:,:,iblock) + + UAREA(:,:,iblock) = DXU(:,:,iblock)*DYU(:,:,iblock) + UAREA_R(:,:,iblock) = c1/UAREA(:,:,iblock) + + DXTR(:,:,iblock) = c1/DXT(:,:,iblock) + DYTR(:,:,iblock) = c1/DYT(:,:,iblock) + + TAREA(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) + TAREA_R(:,:,iblock) = c1/TAREA(:,:,iblock) + + end do + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! calculate stencil coefficients for area-averaging +! +!----------------------------------------------------------------------- + + call cf_area_avg ! coefficients for area-weighted averages + +!----------------------------------------------------------------------- +! +! calculate lat/lon of T points and calculate ANGLET from ANGLE +! +!----------------------------------------------------------------------- + + call calc_tpoints + + !*** + !*** first, ensure that -pi <= ANGLE <= pi + !*** + + range_count = global_count ((ANGLE < - pi .or. ANGLE > pi), & + distrb_clinic, field_loc_NEcorner) + + if (range_count > 0) call exit_POP(sigAbort, & + 'ERROR: ANGLE is outside its expected range') + + !*** + !*** compute ANGLE on T-grid + !*** + + !$OMP PARALLEL DO PRIVATE (i,j,angle_0,angle_w,angle_s,angle_sw, & + !$OMP this_block) + + do n=1,nblocks_clinic + this_block = get_block(blocks_clinic(n),n) + + do j=this_block%jb,this_block%je + do i=this_block%ib,this_block%ie + + angle_0 = ANGLE(i, j ,n) + angle_w = ANGLE(i-1,j ,n) + angle_s = ANGLE(i, j-1,n) + angle_sw = ANGLE(i-1,j-1,n) + + if ( angle_0 < c0 ) then + if ( abs(angle_w -angle_0) > pi ) & + angle_w = angle_w - pi2 + if ( abs(angle_s -angle_0) > pi ) & + angle_s = angle_s - pi2 + if ( abs(angle_sw-angle_0) > pi ) & + angle_sw = angle_sw - pi2 + endif + + ANGLET(i,j,n) = angle_0 *AT0 (i,j,n) + & + angle_w *ATW (i,j,n) + & + angle_s *ATS (i,j,n) + & + angle_sw*ATSW(i,j,n) + + enddo + + !*** + !*** set ANGLET to zero for all of (global) j=1 row + !*** (bottom row of ANGLET is not used, but is written to file) + !*** + + if (this_block%j_glob(j) == 1) ANGLET(:,j,n) = c0 + + enddo + enddo + !$OMP END PARALLEL DO + + call update_ghost_cells(ANGLET, bndy_clinic, field_loc_center, & + field_type_angle) + +!----------------------------------------------------------------------- +! +! set up vertical grid +! +!----------------------------------------------------------------------- + + if (my_task == master_task) write(stdout,blank_fmt) + + select case (trim(sfc_layer_opt)) + case ('varthick') ! variable thickness sfc layer + if (my_task == master_task) write(stdout,'(a39)') & + ' Using variable thickness surface layer' + sfc_layer_type = sfc_layer_varthick + case ('rigid') ! rigid lid + if (my_task == master_task) write(stdout,'(a30)') & + ' Using rigid lid approximation' + sfc_layer_type = sfc_layer_rigid + case ('oldfree') ! old free surface implementation + if (my_task == master_task) write(stdout,'(a40)') & + ' Using original free surface formulation' + sfc_layer_type = sfc_layer_oldfree + case default + call exit_POP(sigAbort,'ERROR: unknown surface layer option') + end select + + select case (vert_grid_opt) + case ('internal') + if (my_task == master_task) then + write(stdout,'(a34)') ' Creating vertical grid internally' + endif + call vert_grid_internal + case ('file') + if (my_task == master_task) then + write(stdout,*) ' Reading vertical grid from file:', & + trim(vert_grid_file) + endif + call broadcast_scalar(vert_grid_file, master_task) + call read_vert_grid(vert_grid_file) + case default + call exit_POP(sigAbort,'ERROR: unknown vertical grid option') + end select + + !*** + !*** calculate other vertical grid quantities + !*** + + dzw(0) = p5*dz(1) + dzw(km) = p5*dz(km) + dzwr(0) = c1/dzw(0) + zw(1) = dz(1) + zt(1) = dzw(0) + + do k = 1,km-1 + dzw(k) = p5*(dz(k) + dz(k+1)) + zw(k+1) = zw(k) + dz(k+1) + zt(k+1) = zt(k) + dzw(k) + enddo + + do k = 1,km + c2dz(k) = c2*dz(k) + dzr(k) = c1/dz(k) + dz2r(k) = c1/c2dz(k) + dzwr(k) = c1/dzw(k) + enddo + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,'(a15)') ' Vertical grid:' + write(stdout,vgrid_fmt1) + write(stdout,vgrid_fmt2) + do k=1,km + write(stdout,vgrid_fmt3) k,dz(k),zt(k) + end do + write(stdout,blank_fmt) + endif + +!----------------------------------------------------------------------- +! +! set up topography +! +!----------------------------------------------------------------------- + + select case (topography_opt) + case ('internal') + if (my_task == master_task) write(stdout,'(a33)') & + ' Generating topography internally' + call topography_internal(.false.) + flat_bottom = .true. + case ('file') + if (my_task == master_task) write(stdout,'(a30,a)') & + ' Reading topography from file:', trim(topography_file) + call broadcast_scalar(topography_file, master_task) + call read_topography(topography_file,.false.) + case default + call exit_POP(sigAbort,'ERROR: unknown topography option') + end select + + !*** + !*** remove isolated lakes and disconnected points from grid + !*** + + if (lremove_points) then + if (my_task == master_task) write(stdout,'(a58)') & + ' Removing isolated lakes and disconnected points from grid' + call remove_points + endif + + !*** + !*** smooth topography + !*** + + if (topo_smooth) then + if (my_task == master_task) write(stdout,'(a21)') & + ' Smoothing topography' + call smooth_topography + endif + + !*** + !*** flat bottom + !*** + + if (flat_bottom) then + if (my_task == master_task) write(stdout,'(a33)') & + ' Enforcing flat-bottom topography' + where (KMT /= 0) KMT = km + endif + + !*** + !*** set up partial bottom cells + !*** + + if (partial_bottom_cells) then + + if (my_task == master_task) then + write(stdout,'(a30)') ' Partial bottom cells enabled' + write(stdout,'(a27,a)') ' Reading bottom cell file: ', & + trim(bottom_cell_file) + endif + call read_bottom_cell(DZBC,bottom_cell_file) + allocate (DZT(nx_block,ny_block,km,max_blocks_clinic), & + DZU(nx_block,ny_block,km,max_blocks_clinic)) + + !$OMP PARALLEL DO PRIVATE(k,i,j) + do n=1,nblocks_clinic + do k=1,km + do j=1,ny_block + do i=1,nx_block + if (KMT(i,j,n) == k) then + DZT(i,j,k,n) = DZBC(i,j,n) + else + DZT(i,j,k,n) = dz(k) + end if + end do + end do + + !*** DZU = min of surrounding DZTs + + do j=1,ny_block-1 + do i=1,nx_block-1 + DZU(i,j,k,n) = min(DZT(i ,j ,k,n), & + DZT(i+1,j ,k,n), & + DZT(i ,j+1,k,n), & + DZT(i+1,j+1,k,n)) + end do + end do + end do + end do + !$OMP END PARALLEL DO + call update_ghost_cells(DZU, bndy_clinic, field_loc_NEcorner, & + field_type_scalar) + + else + if (my_task == master_task) write(stdout,'(a30)') & + ' Partial bottom cells disabled' + endif + + !*** + !*** calculate number of levels at U points (KMU field) + !*** KMU = minimum of surrounding KMTs + !*** + + do n=1,nblocks_clinic + do j=1,ny_block-1 + do i=1,nx_block-1 + KMU(i,j,n) = min(KMT(i,j ,n),KMT(i+1,j ,n), & + KMT(i,j+1,n),KMT(i+1,j+1,n)) + end do + end do + end do + call update_ghost_cells(KMU, bndy_clinic, field_loc_NEcorner, & + field_type_scalar) + + !*** + !*** calculate depth field at T,U points + !*** + + if (partial_bottom_cells) then + !$OMP PARALLEL DO PRIVATE(k,i,j) + do n=1,nblocks_clinic + HT (:,:,n) = c0 + HU (:,:,n) = c0 + HUR(:,:,n) = c0 + + do k=1,km + do j=1,ny_block + do i=1,nx_block + if (k == KMT(i,j,n)) HT(i,j,n) = zw(k-1) + DZT(i,j,k,n) + if (k == KMU(i,j,n)) then + HU(i,j,n) = zw(k-1) + DZU(i,j,k,n) + HUR(i,j,n) = c1/HU(i,j,n) + else if (k > KMU(i,j,n)) then + DZU(i,j,k,n) = dz(k) !*** to prevent divide by zero + endif + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + else + !$OMP PARALLEL DO PRIVATE(k,i,j) + do n=1,nblocks_clinic + HT (:,:,n) = c0 + HU (:,:,n) = c0 + HUR(:,:,n) = c0 + + do k=1,km + do j=1,ny_block + do i=1,nx_block + if (k == KMT(i,j,n)) HT(i,j,n) = zw(k) + if (k == KMU(i,j,n)) then + HU (i,j,n) = zw(k) + HUR(i,j,n) = c1/zw(k) + endif + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + endif + +!----------------------------------------------------------------------- +! +! landmasks +! +!----------------------------------------------------------------------- + + call landmasks + +!----------------------------------------------------------------------- +! +! calculate area, volume, # surface points, # ocean points +! +!----------------------------------------------------------------------- + + area_t = global_sum(TAREA, distrb_clinic, field_loc_center, RCALCT) + area_u = global_sum(UAREA, distrb_clinic, field_loc_NEcorner, RCALCU) + WORK = TAREA*HT + volume_t = global_sum(WORK, distrb_clinic, field_loc_center, RCALCT) + WORK = UAREA*HU + volume_u = global_sum(WORK, distrb_clinic, field_loc_NEcorner, RCALCU) + area_t_k(1) = area_t + volume_t_k(1) = global_sum(TAREA*dz(1), distrb_clinic, & + field_loc_center, RCALCT) + do k=2,km + WORK = merge(TAREA, c0, k <= KMT) + area_t_k(k) = global_sum(WORK, distrb_clinic, field_loc_center) + WORK = merge(TAREA*dz(k), c0, k <= KMT) + volume_t_k(k) = global_sum(WORK, distrb_clinic, field_loc_center) + end do + + nsurface_t = global_count(RCALCT, distrb_clinic, field_loc_center) + nsurface_u = global_count(RCALCU, distrb_clinic, field_loc_NEcorner) + nocean_t = global_sum(KMT, distrb_clinic, field_loc_center) + nocean_u = global_sum(KMU, distrb_clinic, field_loc_NEcorner) + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,topo_fmt1) nsurface_t, nsurface_u + write(stdout,topo_fmt2) nocean_t, nocean_u + write(stdout,topo_fmt3) area_t*1.0e-10_r8, & + area_u*1.0e-10_r8 + write(stdout,topo_fmt4) volume_t*1.0e-15_r8, & + volume_u*1.0e-15_r8 + write(stdout,blank_fmt) + endif + +!----------------------------------------------------------------------- +! +! set region-masks and calculate active-ocean and marginal-seas +! areas and volumes +! +!----------------------------------------------------------------------- + + if (trim(region_mask_file) /= 'unknown_region_mask') then + if (my_task == master_task) write(stdout,'(a36,a)') & + 'Region masks initialized from file: ',trim(region_mask_file) + call area_masks(region_mask_file,region_info_file) + else + if (my_task == master_task) write(stdout,'(a24)') & + ' No region masks defined' + endif + +!----------------------------------------------------------------------- +! +! compute min area of equatorial cell for use in variable_hmix +! +!----------------------------------------------------------------------- + + WORK = abs(ULAT) + uarea_equator = global_minval(WORK, distrb_clinic, field_loc_NEcorner, CALCU) + + where (WORK == uarea_equator) + WORK = UAREA + elsewhere + WORK = 1.e+20_r8 + end where + + uarea_equator = global_minval(WORK, distrb_clinic, field_loc_NEcorner, CALCU) + +!----------------------------------------------------------------------- +! +! compute coriolis parameter 2*omega*sin(true_latitude) +! +!----------------------------------------------------------------------- + + FCOR = c2*omega*sin(ULAT) ! at u-points + FCORT = c2*omega*sin(TLAT) ! at t-points + +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + end subroutine init_grid2 + +!*********************************************************************** +!BOP +! !IROUTINE: horiz_grid_internal +! !INTERFACE: + + subroutine horiz_grid_internal(latlon_only) + +! !DESCRIPTION: +! Creates a lat/lon grid with equal spacing in each direction +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + logical (log_kind), intent(in) :: & + latlon_only ! flag requesting only ULAT, ULON + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,ig,jg,jm1,n ! dummy counters + + real (r8) :: & + dlat, dlon, &! lat/lon spacing for idealized grid + lathalf, &! lat at T points + xdeg ! temporary longitude variable + + type (block) :: & + this_block ! block info for this block + +!----------------------------------------------------------------------- +! +! calculate lat/lon coords of U points +! long range (-180,180) +! +!----------------------------------------------------------------------- + + dlon = 360.0_r8/real(nx_global) + dlat = 180.0_r8/real(ny_global) + + if (latlon_only) then + + allocate (ULAT_G(nx_global, ny_global), & + ULON_G(nx_global, ny_global)) + + do i=1,nx_global + xdeg = i*dlon + if (xdeg > 180.0_r8) xdeg = xdeg - 360.0_r8 + ULON_G(i,:) = xdeg/radian + enddo + + do j = 1,ny_global + ULAT_G(:,j) = (-90.0_r8 + j*dlat)/radian + enddo + +!----------------------------------------------------------------------- +! +! calculate grid spacings and other quantities +! compute here to avoid bad ghost cell values due to dropped land +! blocks +! +!----------------------------------------------------------------------- + + else ! not latlon_only + + !$OMP PARALLEL DO PRIVATE(this_block, i, j, ig, jg, lathalf) + do n=1,nblocks_clinic + + this_block = get_block(blocks_clinic(n),n) + + do j=1,ny_block + jg = this_block%j_glob(j) + jm1 = jg - 1 + if (jm1 < 1) jm1 = ny_global + + do i=1,nx_block + !*** + !*** calculate grid lengths + !*** + + HTN(i,j,n) = dlon*radius/radian ! convert to cm + HTE(i,j,n) = dlat*radius/radian ! convert to cm + HUS(i,j,n) = dlon*radius/radian ! convert to cm + HUW(i,j,n) = dlat*radius/radian ! convert to cm + DYT(i,j,n) = dlat*radius/radian ! convert to cm + DYU(i,j,n) = dlat*radius/radian ! convert to cm + ANGLE(i,j,n) = c0 + + ig = this_block%i_glob(i) + if (ig > 0 .and. jg > 0) then + ULON(i,j,n) = ULON_G(ig,jg) + ULAT(i,j,n) = ULAT_G(ig,jg) + HTN (i,j,n) = HTN(i,j,n)*cos(ULAT(i,j,n)) + DXU (i,j,n) = HTN(i,j,n) + lathalf = (-90.0_r8 + (jg-p5)*dlat)/radian + HUS (i,j,n) = HUS(i,j,n)*cos(lathalf) + DXT (i,j,n) = dlon*radius/radian* & + p5*(cos(ULAT_G(ig,jg )) + & + cos(ULAT_G(ig,jm1))) + else + ULON(i,j,n) = c0 + ULAT(i,j,n) = c0 + HTN (i,j,n) = c1 ! to prevent divide by zero + HUS (i,j,n) = c1 ! to prevent divide by zero + DXU (i,j,n) = c1 ! fixed up later + endif + end do + enddo + enddo + !$OMP END PARALLEL DO + + deallocate(ULAT_G,ULON_G) + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine horiz_grid_internal + +!*********************************************************************** +!BOP +! !IROUTINE: read_horiz_grid +! !INTERFACE: + + subroutine read_horiz_grid(horiz_grid_file, latlon_only) + +! !DESCRIPTION: +! Reads horizontal grid information from input grid file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + horiz_grid_file ! filename of file containing grid data + + logical (log_kind), intent(in) :: & + latlon_only ! flag requesting only ULAT, ULON + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,iblock ,&! loop counters + ip1, im1, jp1, jm1,&! shift indexes + nu ,&! i/o unit number + ioerr ,&! i/o error flag + reclength ! record length + + type (block) :: & + this_block + +!----------------------------------------------------------------------- +! +! if only lat,lon are requested, read only these +! +!----------------------------------------------------------------------- + + if (latlon_only) then + + allocate (ULAT_G(nx_global,ny_global), & + ULON_G(nx_global,ny_global)) + + INQUIRE(iolength=reclength) ULAT_G + call get_unit(nu) + if (my_task == master_task) then + open(nu,file=trim(horiz_grid_file),status='old', & + form='unformatted', access='direct', recl=reclength, & + iostat=ioerr) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening horiz_grid_file') + + if (my_task == master_task) then + read(nu,rec=1,iostat=ioerr) ULAT_G + read(nu,rec=2,iostat=ioerr) ULON_G + close(nu) + endif + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading horiz_grid_file') + + call broadcast_array(ULAT_G, master_task) + call broadcast_array(ULON_G, master_task) + +!----------------------------------------------------------------------- +! +! otherwise, read everything else +! compute some derived fields here to preserve information that is +! lost once land blocks are dropped +! +!----------------------------------------------------------------------- + + else + + if (.not. allocated(ULAT_G)) then + allocate (ULAT_G(nx_global,ny_global), & + ULON_G(nx_global,ny_global)) + endif + + INQUIRE(iolength=reclength) ULAT_G + call get_unit(nu) + ioerr = 0 + if (my_task == master_task) then + open(nu,file=trim(horiz_grid_file),status='old', & + form='unformatted', access='direct', recl=reclength, & + iostat=ioerr) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening horiz_grid_file') + + if (my_task == master_task) then + read(nu,rec=1,iostat=ioerr) ULAT_G + read(nu,rec=2,iostat=ioerr) ULON_G + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading horiz_grid_file') + + call scatter_global(ULAT, ULAT_G, master_task, distrb_clinic, & + field_loc_NEcorner, field_type_scalar) + call scatter_global(ULON, ULON_G, master_task, distrb_clinic, & + field_loc_NEcorner, field_type_scalar) + + if (my_task == master_task) then + read(nu,rec=3,iostat=ioerr) ULAT_G ! holds HTN + endif + + call scatter_global(HTN, ULAT_G, master_task, distrb_clinic, & + field_loc_Nface, field_type_scalar) + + do j=1,ny_global + do i=1,nx_global + ip1 = i+1 + if (i == nx_global) ip1 = 1 ! assume cyclic. non-cyclic + ! will be handled during scatter + !DXU + ULON_G(i,j) = p5*(ULAT_G(i,j) + ULAT_G(ip1,j)) + end do + end do + call scatter_global(DXU, ULON_G, master_task, distrb_clinic, & + field_loc_NEcorner, field_type_scalar) + + do j=1,ny_global + jm1 = j-1 + if (j == 1) jm1 = ny_global ! assume cyclic. non-cyclic + ! will be handled during scatter + do i=1,nx_global + + !DXT = p5(HTN(i,j)+HTN(i,j-1)) + ULON_G(i,j) = p5*(ULAT_G(i,j) + ULAT_G(i,jm1)) + end do + end do + call scatter_global(DXT, ULON_G, master_task, distrb_clinic, & + field_loc_center, field_type_scalar) + + if (my_task == master_task) then + read(nu,rec=4,iostat=ioerr) ULAT_G ! holds HTE + endif + + call scatter_global(HTE, ULAT_G, master_task, distrb_clinic, & + field_loc_Eface, field_type_scalar) + + do j=1,ny_global + do i=1,nx_global + im1 = i-1 + if (i == 1) im1 = nx_global ! assume cyclic. non-cyclic + ! will be handled during scatter + !DYT + ULON_G(i,j) = p5*(ULAT_G(i,j) + ULAT_G(im1,j)) + end do + end do + call scatter_global(DYT, ULON_G, master_task, distrb_clinic, & + field_loc_center, field_type_scalar) + + do j=1,ny_global + jp1 = j+1 + if (j == ny_global) jp1 = 1 ! assume cyclic. non-cyclic + ! will be handled during scatter + do i=1,nx_global + + !DYU = p5(HTE(i,j)+HTN(i,j+1)) + ULON_G(i,j) = p5*(ULAT_G(i,j) + ULAT_G(i,jp1)) + end do + end do + call scatter_global(DYU, ULON_G, master_task, distrb_clinic, & + field_loc_NEcorner, field_type_scalar) + + if (my_task == master_task) then + read(nu,rec=5,iostat=ioerr) ULAT_G + read(nu,rec=6,iostat=ioerr) ULON_G + endif + + call scatter_global(HUS, ULAT_G, master_task, distrb_clinic, & + field_loc_Eface, field_type_scalar) + call scatter_global(HUW, ULON_G, master_task, distrb_clinic, & + field_loc_Nface, field_type_scalar) + + if (my_task == master_task) then + read(nu,rec=7,iostat=ioerr) ULAT_G + close(nu) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading horiz_grid_file') + + call scatter_global(ANGLE, ULAT_G, master_task, distrb_clinic, & + field_loc_NEcorner, field_type_angle) + call release_unit(nu) + deallocate(ULAT_G,ULON_G) + + where (HTN <= c0) HTN = c1 + where (HTE <= c0) HTE = c1 + where (HUS <= c0) HUS = c1 + where (HUW <= c0) HUW = c1 + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_horiz_grid + +!*********************************************************************** +!BOP +! !IROUTINE: vert_grid_internal +! !INTERFACE: + + subroutine vert_grid_internal + +! !DESCRIPTION: +! Creates vertical grid layer thicknesses based on km +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! parameters for depth function choice +! +!----------------------------------------------------------------------- + + real (r8), parameter :: & + zmax = 5500.0_r8, &! max depth in meters + dz_sfc = 25.0_r8, &! thickness of sfc layer (meters) + dz_deep = 400.0_r8 ! thick of deep ocn layers (meters) + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + depth, &! depth based on integrated thicknesses + zlength, &! adjustable parameter for thickness + d0, d1, &! depths used by midpoint search + zl0, zl1, &! parameter used by midpoint search + dzl ! zl1-zl0 + + integer (int_kind) :: k ! dummy vertical index + +!----------------------------------------------------------------------- +! +! initialize bisection search to find best value of zlength +! parameter such that integrated depth = zmax +! +!----------------------------------------------------------------------- + + zl0 = eps + zl1 = zmax + dzl = zl1 - zl0 + + call compute_dz(d0,zl0,dz_sfc,dz_deep) + call compute_dz(d1,zl1,dz_sfc,dz_deep) + + if ((d0-zmax)*(d1-zmax) > c0) then + if (my_task == master_task) write(stdout,*) d0,d1,zmax + call exit_POP(sigAbort, & + 'vert_grid: zero point not in initial interval') + endif + +!----------------------------------------------------------------------- +! +! do bisection search +! +!----------------------------------------------------------------------- + + do while ( (dzl/zmax) > eps) + + !*** + !*** compute profile at midpoint + !*** + + zlength = zl0 + p5*dzl + + call compute_dz(depth,zlength,dz_sfc,dz_deep) + + !*** + !*** find interval to use for continuing search + !*** + + if ((d0-zmax)*(depth-zmax) < c0) then + d1 = depth + zl1 = zlength + else if ((d1-zmax)*(depth-zmax) < c0) then + d0 = depth + zl0 = zlength + else + if (my_task == master_task) write(stdout,*) d0,d1,depth,zmax + call exit_POP(sigAbort,'vert_grid: zero point not in interval') + endif + + dzl = zl1 - zl0 + + end do + + dz = dz*cmperm ! convert to cm + +!----------------------------------------------------------------------- +! +! presumably, we have converged, but check to make sure +! +!----------------------------------------------------------------------- + + if (abs(depth-zmax)/zmax > 0.01_r8) then + if (my_task == master_task) then + write(stdout,*) 'Integrated depth = ',depth,' zmax = ',zmax + endif + call exit_POP(sigAbort, & + 'Unable to compute vertical grid internally') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine vert_grid_internal + +!*********************************************************************** +!BOP +! !IROUTINE: compute_dz +! !INTERFACE: + + subroutine compute_dz(depth,zlength,dz_sfc,dz_deep) + +! !DESCRIPTION: +! Computes a thickness profile and total depth given the +! parameters for the thickness function +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), intent(in) :: & + zlength, &! gaussian parameter for thickness func + dz_sfc, &! thickness of surface layer + dz_deep ! thickness of deep ocean layers + +! !OUTPUT PARAMETERS: + + real (r8), intent(out) :: & + depth ! depth based on integrated thicknesses + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: k + +!----------------------------------------------------------------------- + + depth = c0 + + do k=1,km + dz(k) = dz_deep - (dz_deep - dz_sfc)*exp(-(depth/zlength)**2) + depth = depth + dz(k) + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine compute_dz + +!*********************************************************************** +!BOP +! !IROUTINE: read_vert_grid +! !INTERFACE: + + subroutine read_vert_grid(vert_grid_file) + +! !DESCRIPTION: +! Reads in layer thicknesses from grid input file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (char_len), intent(in) :: & + vert_grid_file + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k, &! vertical level index + nu, &! i/o unit number + ioerr ! i/o error flag + +!----------------------------------------------------------------------- +! +! read vertical layer thickness from file +! +!----------------------------------------------------------------------- + + call get_unit(nu) + if (my_task == master_task) then + open(nu,file=vert_grid_file,status='old',form='formatted', & + iostat=ioerr) + endif + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening vert_grid_file') + + if (my_task == master_task) then + if (ioerr == 0) then ! successful open + grid_read: do k = 1,km + read(nu,*,iostat=ioerr) dz(k) + if (ioerr /= 0) exit grid_read + end do grid_read + close(nu) + endif + endif + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading vert_grid_file') + + call broadcast_array(dz, master_task) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_vert_grid + +!*********************************************************************** +!BOP +! !IROUTINE: topography_internal +! !INTERFACE: + + subroutine topography_internal(kmt_global) + +! !DESCRIPTION: +! Generates simple KMT field with idealized land masses +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + logical(log_kind), intent(in) :: & + kmt_global ! flag for generating only global KMT field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,ig,jg,k,n,bid ! dummy counters + + real (r8) :: & + latd, lond ! lat/lon in degrees + + type (block) :: & + this_block ! block info for current block + +!----------------------------------------------------------------------- +! +! compute global KMT field (for use in setting up domain) +! +!----------------------------------------------------------------------- + + if (kmt_global) then + + allocate(KMT_G(nx_global,ny_global)) + + do j=1,ny_global + do i=1,nx_global + latd = ULAT_G(i,j)*radian + lond = ULON_G(i,j)*radian + if (lond < c0) lond = lond + 360.0_r8 + + KMT_G(i,j) = km ! flat bottom + + if ((latd > -35.0_r8) .and. & + (lond > 210.0_r8) .and. & + (lond < 250.0_r8)) KMT_G(i,j) = 0 + + if ((latd > 25.0_r8) .and. & + (lond > 210.0_r8) .and. & + (lond < 330.0_r8)) KMT_G(i,j) = 0 + + if ((latd > 60.0_r8) .and. & + (lond > 210.0_r8) .and. & + (lond < 150.0_r8)) KMT_G(i,j) = 0 + + if ((latd > -60.0_r8) .and. & + (lond > 110.0_r8) .and. & + (lond < 150.0_r8)) KMT_G(i,j) = 0 + + if (abs(latd) > 75.0_r8) KMT_G(i,j) = 0 + + end do + end do + +!----------------------------------------------------------------------- +! +! otherwise, set up local KMT field +! +!----------------------------------------------------------------------- + + else + + do n=1,nblocks_clinic + this_block = get_block(blocks_clinic(n),n) + + do j=1,ny_block + jg = this_block%j_glob(j) + if (jg > 0) then + do i=1,nx_block + ig = this_block%i_glob(i) + if (ig /= 0) then + KMT(i,j,n) = KMT_G(ig,jg) + else + KMT(i,j,n) = 0 + endif + end do + else + KMT(:,j,n) = 0 + endif + end do + end do + + deallocate(KMT_G) + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine topography_internal + +!*********************************************************************** +!BOP +! !IROUTINE: read_topography +! !INTERFACE: + + subroutine read_topography(topography_file,kmt_global) + +! !DESCRIPTION: +! Reads in KMT field from file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (char_len), intent(in) :: & + topography_file ! input file containing KMT field + + logical(log_kind), intent(in) :: & + kmt_global ! flag for generating only global KMT field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nu ,&! i/o unit number + ioerr ,&! i/o error flag + reclength ! record length + +!----------------------------------------------------------------------- +! +! read global KMT field (for use in setting up domain) +! +!----------------------------------------------------------------------- + + if (kmt_global) then + + allocate(KMT_G(nx_global,ny_global)) + + INQUIRE(iolength=reclength) KMT_G + call get_unit(nu) + if (my_task == master_task) then + open(nu, file=topography_file,status='old',form='unformatted', & + access='direct', recl=reclength, iostat=ioerr) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening topography_file') + + if (my_task == master_task) then + read(nu, rec=1, iostat=ioerr) KMT_G + close(nu) + endif + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading topography_file') + + call broadcast_array(KMT_G, master_task) + +!----------------------------------------------------------------------- +! +! otherwise read KMT field from file +! +!----------------------------------------------------------------------- + + else + call scatter_global(KMT, KMT_G, master_task, distrb_clinic, & + field_loc_center, field_type_scalar) + deallocate(KMT_G) + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_topography + +!*********************************************************************** +!BOP +! !IROUTINE: read_bottom_cell +! !INTERFACE: + + subroutine read_bottom_cell(DZBC,bottom_cell_file) + +! !DESCRIPTION: +! Reads bottom cell information from input bottom cell file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + bottom_cell_file ! filename of file containing cell thickness + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(inout) :: & + DZBC ! thickness of bottom cell in each column + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8), dimension(:,:), allocatable :: & + DZBC_G ! global bottom layer thickness (cm) + + integer (int_kind) :: & + nu ,&! i/o unit number + ioerr ! i/o error flag + +!----------------------------------------------------------------------- +! +! open a file and read thickness field +! +!----------------------------------------------------------------------- + + call get_unit(nu) + if (my_task == master_task) then + open(nu, file=bottom_cell_file,status='old',form='unformatted', & + access='direct', recl=8*nx_global*ny_global, & + iostat=ioerr) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening bottom_cell_file') + + if (my_task == master_task) then + allocate(DZBC_G(nx_global,ny_global)) + read(nu, rec=1, iostat=ioerr) DZBC_G + close(nu) + endif + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading bottom_cell_file') + + call scatter_global(DZBC, DZBC_G, master_task, distrb_clinic, & + field_loc_center, field_type_scalar) + if (my_task == master_task) deallocate(DZBC_G) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_bottom_cell + +!*********************************************************************** +!BOP +! !IROUTINE: remove_points +! !INTERFACE: + + subroutine remove_points + +! !DESCRIPTION: +! Removes isolated points from grid (KMT field) +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n, &! dummy loop indices + npoints_removed ! number of points removed + + integer(int_kind),dimension(nx_block,ny_block,max_blocks_clinic) ::& + ICOUNT ! record of points removed + + character (*), parameter :: & + rmpts_fmt = "(' points removed from grid:',2x,i10)" + +!----------------------------------------------------------------------- +! +! calculate number of levels at U points +! (KMU field before modifying KMT field) +! +!----------------------------------------------------------------------- + + do n=1,nblocks_clinic + do j=1,ny_block-1 + do i=1,nx_block-1 + KMU(i,j,n) = min(KMT(i,j ,n),KMT(i+1,j ,n), & + KMT(i,j+1,n),KMT(i+1,j+1,n)) + end do + end do + end do + +!----------------------------------------------------------------------- +! +! remove disconnected points from grid. +! if all KMUs surrounding a T point are zero, set KMT = 0. +! +!----------------------------------------------------------------------- + + do n=1,nblocks_clinic + do j=2,ny_block + do i=2,nx_block + if ((KMU(i,j ,n) + KMU(i-1,j ,n) + & + KMU(i,j-1,n) + KMU(i-1,j-1,n)) == 0) then + ICOUNT(i,j,n) = 1 + KMT (i,j,n) = 0 + else + ICOUNT(i,j,n) = 0 + endif + end do + end do + end do + + call update_ghost_cells(KMT, bndy_clinic, field_loc_center, & + field_type_scalar) + + npoints_removed = global_count(ICOUNT, distrb_clinic, field_loc_center) + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,rmpts_fmt) npoints_removed + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine remove_points + +!*********************************************************************** +!BOP +! !IROUTINE: smooth_topography +! !INTERFACE: + + subroutine smooth_topography + +! !DESCRIPTION: +! This routine smooths topography to create new KMT, depth fields +! The depth field HT is constructed from the KMT field and +! depth profile dz, HT is smoothed by by application of a +! 9-point averaging stencil: +! \begin{verbatim} +! 1 -- 2 -- 1 +! | | | +! 2 -- 4 -- 2 +! | | | +! 1 -- 2 -- 1 +! \end{verbatim} +! Land points are not included in the smoothing, and the +! stencil is modified to include only ocean points in the +! averaging. Once the depth field has been smoothed, +! a new KMT field is constructed from it. +! +! !REVISION HISTORY: +! same as module +! +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables: +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,n ! dummy loop indices + + integer(int_kind),dimension(nx_block,ny_block,max_blocks_clinic) ::& + NB, &! num points contributing to 9pt avg + IWORK ! local work space + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + HTNEW, &! smoothed depth field at T points + WORK ! local work space + +!----------------------------------------------------------------------- +! +! old depth field in T columns +! +!----------------------------------------------------------------------- + + HT = c0 + do k = 1,km + where (k == KMT) HT = zw(k) + enddo + +!----------------------------------------------------------------------- +! +! smooth topography +! +!----------------------------------------------------------------------- + + where (KMT > 0) + NB = 1 + HTNEW = HT + elsewhere + NB = 0 + HTNEW = c0 + endwhere + + do n=1,nblocks_clinic + do j=2,ny_block-1 + do i=2,nx_block-1 + + WORK(i,j,n) = c4*HTNEW(i,j,n) + & + c2*HTNEW(i+1,j,n) + c2*HTNEW(i-1,j,n) + & + c2*HTNEW(i,j+1,n) + HTNEW(i+1,j+1,n) + HTNEW(i-1,j+1,n) + & + c2*HTNEW(i,j-1,n) + HTNEW(i+1,j-1,n) + HTNEW(i-1,j-1,n) + + IWORK(i,j,n) = c4*NB(i,j,n) + & + c2*NB(i+1,j,n) + c2*NB(i-1,j,n) + & + c2*NB(i,j+1,n) + NB(i+1,j+1,n) + NB(i-1,j+1,n) + & + c2*NB(i,j-1,n) + NB(i+1,j-1,n) + NB(i-1,j-1,n) + + end do + end do + end do + +!----------------------------------------------------------------------- +! +! new depth field +! +!----------------------------------------------------------------------- + + where ((KMT /= 0) .and. (IWORK /= 0)) + HTNEW = WORK/float(IWORK) + elsewhere + HTNEW = c0 + endwhere + +!----------------------------------------------------------------------- +! +! new KMT field +! +!----------------------------------------------------------------------- + + KMTOLD = KMT + do k = 1,km-1 + where (HTNEW > zt(k) .and. HTNEW <= zt(k+1)) KMT = k + enddo + where (HTNEW > zt(k)) KMT = km + + call update_ghost_cells(KMT, bndy_clinic, field_loc_center, & + field_type_scalar) + +!----------------------------------------------------------------------- +!EOC + + end subroutine smooth_topography + +!*********************************************************************** +!BOP +! !IROUTINE: landmasks +! !INTERFACE: + + subroutine landmasks + +! !DESCRIPTION: +! Calculates additional masks for land points at each depth level. +! These include real masks for applying multiplicative masks +! instead of logical masks and also KMT arrays for neighbor points. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! masks for surface ocean T or U points +! +!----------------------------------------------------------------------- + + where (KMT >= 1) + CALCT = .true. + RCALCT = c1 + elsewhere + CALCT = .false. + RCALCT = c0 + endwhere + + where (KMU >= 1) + CALCU = .true. + RCALCU = c1 + elsewhere + CALCU = .false. + RCALCU = c0 + endwhere + +!----------------------------------------------------------------------- +! +! depth level fields (KMT,KMU) to north,south,east,west +! +!----------------------------------------------------------------------- + + KMTN = eoshift(KMT,dim=2,shift=+1) + KMTS = eoshift(KMT,dim=2,shift=-1) + KMTE = eoshift(KMT,dim=1,shift=+1) + KMTW = eoshift(KMT,dim=1,shift=-1) + + KMUN = eoshift(KMU,dim=2,shift=+1) + KMUS = eoshift(KMU,dim=2,shift=-1) + KMUE = eoshift(KMU,dim=1,shift=+1) + KMUW = eoshift(KMU,dim=1,shift=-1) + + KMTEE = eoshift(KMT,dim=1,shift=2) + KMTNN = eoshift(KMT,dim=2,shift=2) + + !call update_ghost_cells(KMTN, bndy_clinic, field_loc_center, & + ! field_type_scalar) + !call update_ghost_cells(KMTS, bndy_clinic, field_loc_center, & + ! field_type_scalar) + !call update_ghost_cells(KMTE, bndy_clinic, field_loc_center, & + ! field_type_scalar) + !call update_ghost_cells(KMTW, bndy_clinic, field_loc_center, & + ! field_type_scalar) + !call update_ghost_cells(KMUN, bndy_clinic, field_loc_NEcorner, & + ! field_type_scalar) + !call update_ghost_cells(KMUS, bndy_clinic, field_loc_NEcorner, & + ! field_type_scalar) + !call update_ghost_cells(KMUE, bndy_clinic, field_loc_NEcorner, & + ! field_type_scalar) + !call update_ghost_cells(KMUW, bndy_clinic, field_loc_NEcorner, & + ! field_type_scalar) + !call update_ghost_cells(KMTEE, bndy_clinic, field_loc_center, & + ! field_type_scalar) + !call update_ghost_cells(KMTNN, bndy_clinic, field_loc_center, & + ! field_type_scalar) + +!----------------------------------------------------------------------- +!EOC + + end subroutine landmasks + +!*********************************************************************** +!BOP +! !IROUTINE: area_masks +! !INTERFACE: + + subroutine area_masks(mask_filename,info_filename) + +! !DESCRIPTION: +! This subroutine reads in file with regional area mask and +! marginal seas defined +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character(*), intent(in) :: & + mask_filename ,&! name of file containing region masks + info_filename ! name of file containing region names + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k, n, &! loop counters + nu, &! i/o unit number + reclength, &! record length of file + ioerr, &! i/o error flag + region ! region counter + + real (r8) :: & + tmp_vol, &! temporary volume + sea_area, &! total volume of a particular sea + sea_vol ! total volume of a particular sea + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + WORK ! temporary space + + integer (int_kind), dimension(:,:), allocatable :: & + REGION_G ! global-sized region mask + +!----------------------------------------------------------------------- +! +! read in regional area masks, including marginal seas. then +! calculate related variables. +! +!----------------------------------------------------------------------- + + allocate(REGION_MASK(nx_block,ny_block,max_blocks_clinic)) + + call get_unit(nu) + if (my_task == master_task) then + allocate(REGION_G(nx_global,ny_global)) + inquire (iolength=reclength) REGION_G + open(nu, file=mask_filename,status='old',form='unformatted', & + access='direct', recl=reclength, iostat=ioerr) + endif + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error opening region mask file') + + if (my_task == master_task) then + read(nu, rec=1, iostat=ioerr) REGION_G + close(nu) + endif + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading region mask file') + + call scatter_global(REGION_MASK, REGION_G, master_task,distrb_clinic, & + field_loc_center, field_type_scalar) + if (my_task == master_task) deallocate(REGION_G) + + num_regions = global_maxval(abs(REGION_MASK), & + distrb_clinic, field_loc_center) + +!--------------------------------------------------------------------- +! +! open and read file which contains region names and marginal- +! seas balancing information +! +!--------------------------------------------------------------------- + + if(info_filename == 'unknown_region_info') then + call exit_POP (sigAbort,'ERROR: unknown region_info_filename') + endif + + region_info(:)%name = 'unknown_region_name' + region_info(:)%area = c0 + region_info(:)%volume = c0 + + call get_unit(nu) + + if (my_task == master_task) then + + open(nu,file=info_filename,form='formatted', & + status='unknown', iostat=ioerr) + + do n = 1,num_regions + read (nu,*) region_info(n)%number , & + region_info(n)%name , & + region_info(n)%ms_bal%lat , & + region_info(n)%ms_bal%lon , & + region_info(n)%ms_bal%area + enddo + + close(nu) + + endif + + call release_unit(nu) + + call broadcast_scalar(ioerr, master_task) + if (ioerr /= 0) call exit_POP(sigAbort, & + 'Error reading region name file') + + do n = 1,num_regions + call broadcast_scalar(region_info(n)%name ,master_task) + call broadcast_scalar(region_info(n)%number ,master_task) + call broadcast_scalar(region_info(n)%ms_bal%lat ,master_task) + call broadcast_scalar(region_info(n)%ms_bal%lon ,master_task) + call broadcast_scalar(region_info(n)%ms_bal%area,master_task) + enddo + + +!--------------------------------------------------------------------- +! +! determine if region is a marginal sea +! +!--------------------------------------------------------------------- + num_ms = 0 + do n = 1,num_regions + if (region_info(n)%number < 0 ) then + num_ms = num_ms + 1 + region_info(n)%marginal_sea = .true. + else + region_info(n)%marginal_sea = .false. + endif + enddo + + if (num_ms > max_ms) then + if (my_task == master_task) then + write(stdout,*)'area_masks: maximum number of marginal seas exceeded' + endif + call exit_POP(sigAbort, & + 'ERROR: must increase max_ms in module grid.F') + endif + + +!----------------------------------------------------------------------- +! +! a negative value of REGION_MASK designates a marginal sea. if +! a region is a marginal sea, calculate the area and volume +! +!----------------------------------------------------------------------- + + area_t_marg = c0 + volume_t_marg = c0 + volume_t_marg_k = c0 + + do region = 1, num_regions + + WORK = merge(TAREA, c0, 1 <= KMT .and. REGION_MASK == -region) + sea_area = global_sum(WORK, distrb_clinic, field_loc_center) + area_t_marg = area_t_marg + sea_area + + sea_vol = c0 + do k = 1, km + WORK = merge(TAREA*dz(k), c0, & + k <= KMT .and. REGION_MASK == -region) + tmp_vol = global_sum(WORK, distrb_clinic, field_loc_center) + sea_vol = sea_vol + tmp_vol + volume_t_marg_k(k) = volume_t_marg_k(k) + tmp_vol + enddo + volume_t_marg = volume_t_marg + sea_vol + + if(sea_area /= c0) then + if (.not. region_info(region)%marginal_sea) then + call exit_POP (sigAbort,'ERROR: marginal-sea mismatch') + endif + region_info(region)%area = sea_area + region_info(region)%volume = sea_vol + endif + + if (my_task == master_task .and. sea_area /= c0) then + write(stdout,"('Region #',i2,' is a marginal sea')") region + write(stdout, & + "(' area (km^2) = ',e12.5, ' volume (km^3) = ',e12.5)") & + sea_area*1.0e-10_r8, sea_vol*1.0e-15_r8 + endif + + enddo + + +!--------------------------------------------------------------------- +! +! document regional information +! +!--------------------------------------------------------------------- + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,1003) + + do n = 1,num_regions + if (region_info(n)%marginal_sea) then + write(stdout,1004) region_info(n)%number , & + trim(region_info(n)%name) , & + region_info(n)%area *1.0e-10_r8 , & + region_info(n)%volume*1.0e-15_r8 + else + write(stdout,1004) region_info(n)%number, trim(region_info(n)%name) + endif + enddo + + write(stdout,blank_fmt) + write(stdout,1005) + + do n = 1,num_regions + if (region_info(n)%marginal_sea) then + write(stdout,1006) region_info(n)%number , & + trim(region_info(n)%name) , & + region_info(n)%ms_bal%lat , & + region_info(n)%ms_bal%lon , & + region_info(n)%ms_bal%area + endif + enddo + + endif + + if (my_task == master_task) then + write(stdout,blank_fmt) + endif + + do n = 1,num_regions + if (region_info(n)%marginal_sea) then + region_info(n)%area =region_info(n)%area *1.0e-4_r8 + region_info(n)%volume=region_info(n)%volume*1.0e-6_r8 + endif + enddo + + +1003 format ( 30x, '+', 23('-'),'+' , & + /,30x, '|', 2x, 'Marginal Seas Only |' , & + /,2x,'Region', 8x, 'Region ', 7x, '|', 2x,'Area' , & + 8x,'Volume |' , & + /,2x,'Number', 8x, 'Name',10x, '| (km^2)', 7x, '(km^3)' , & + 3x, '|' , & + /, 2x,6('-'), 1x,19('-'),2x,11('-'),2x , & + 11('-') ) +1004 format (2x, i4, a22, 2(1pe13.5) ) +1005 format (/,3x, ' Marginal Sea (E+P+M+R) Balancing Information' , & + /,2x,'Region', 8x, 'Region ', 8x, 'Bal.' , & + 4x,'Bal.', 4x, 'Search' , & + /,2x,'Number', 8x, 'Name',11x, 'Lat' , 5x, 'Lon' , & + 5x, 'Area' , & + /,47x, '(cm^2)' , & + /, 2x,6('-'), 1x,19('-'),2x, 6('-'),2x , & + 6('-'), 2x, 11('-') ) +1006 format (1x, i4, a20, 3x,2(0pf8.2), 1pe13.5 ) +!----------------------------------------------------------------------- +!EOC + + end subroutine area_masks + +!*********************************************************************** + + subroutine cf_area_avg + +!----------------------------------------------------------------------- +! +! calculate the coefficients of the 4-point stencils for +! area-weighted averaging at T and U points +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! calculate {central,s,w,sw} coefficients for area-averaging +! to T points. +! +!----------------------------------------------------------------------- + +! AT0 = UAREA +! call s_shift(ATS,UAREA) +! call w_shift(ATW,UAREA) +! call s_shift(ATSW,ATW) + +! AT0 = AT0 *p25*TAREA_R +! ATS = ATS *p25*TAREA_R +! ATW = ATW *p25*TAREA_R +! ATSW = ATSW*p25*TAREA_R + + AT0 = p25 + ATS = p25 + ATW = p25 + ATSW = p25 + +!----------------------------------------------------------------------- +! +! calculate {central,n,e,ne} coefficients for area-averaging +! to U points. +! +!----------------------------------------------------------------------- + + AU0 = TAREA + AUN = eoshift(TAREA,dim=2,shift=+1) + AUE = eoshift(TAREA,dim=1,shift=+1) + AUNE = eoshift(AUE ,dim=2,shift=+1) + + AU0 = AU0 *p25*UAREA_R + AUN = AUN *p25*UAREA_R + AUE = AUE *p25*UAREA_R + AUNE = AUNE*p25*UAREA_R + +!----------------------------------------------------------------------- + + end subroutine cf_area_avg + +!*********************************************************************** +!BOP +! !IROUTINE: calc_tpoints +! !INTERFACE: + + subroutine calc_tpoints + +! !DESCRIPTION: +! Calculates lat/lon coordinates of T points from U points +! using a simple average of four neighbors in Cartesian 3d space. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: i,j,n + + real (r8) :: & + xc,yc,zc,xs,ys,zs,xw,yw,zw, &! Cartesian coordinates for + xsw,ysw,zsw,tx,ty,tz,da ! nbr points + + type (block) :: & + this_block ! block info for this block + +!----------------------------------------------------------------------- +! +! TLAT, TLON are southwest 4-point averages of ULAT,ULON +! for general grids, must drop into 3-d Cartesian space to prevent +! problems near the pole +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(i,j,xsw,ysw,zsw,xw,yw,zw,xs,ys,zs,xc,yc,zc, & + !$OMP tx,ty,tz,da) + + do n=1,nblocks_clinic + this_block = get_block(blocks_clinic(n),n) + + do j=2,ny_block + do i=2,nx_block + + !*** + !*** set up averaging weights + !*** + + !wt0 = AT0 (i,j,n) + !wts = ATS (i,j,n) + !wtw = ATW (i,j,n) + !wtsw = ATSW(i,j,n) + + !*** + !*** convert neighbor U-cell coordinates to 3-d Cartesian coordinates + !*** to prevent problems with averaging near the pole + !*** + + zsw = cos(ULAT(i-1,j-1,n)) + xsw = cos(ULON(i-1,j-1,n))*zsw + ysw = sin(ULON(i-1,j-1,n))*zsw + zsw = sin(ULAT(i-1,j-1,n)) + + zs = cos(ULAT(i ,j-1,n)) + xs = cos(ULON(i ,j-1,n))*zs + ys = sin(ULON(i ,j-1,n))*zs + zs = sin(ULAT(i ,j-1,n)) + + zw = cos(ULAT(i-1,j ,n)) + xw = cos(ULON(i-1,j ,n))*zw + yw = sin(ULON(i-1,j ,n))*zw + zw = sin(ULAT(i-1,j ,n)) + + zc = cos(ULAT(i ,j ,n)) + xc = cos(ULON(i ,j ,n))*zc + yc = sin(ULON(i ,j ,n))*zc + zc = sin(ULAT(i ,j ,n)) + + !*** + !*** straight 4-point average to T-cell Cartesian coords + !*** + + tx = p25*(xc + xs + xw + xsw) + ty = p25*(yc + ys + yw + ysw) + tz = p25*(zc + zs + zw + zsw) + + !*** + !*** convert to lat/lon in radians + !*** + + da = sqrt(tx**2 + ty**2 + tz**2) + + TLAT(i,j,n) = asin(tz/da) + + if (tx /= c0 .or. ty /= c0) then + TLON(i,j,n) = atan2(ty,tx) + else + TLON(i,j,n) = c0 + endif + + end do + end do + + !*** + !*** for bottom row of domain where sw 4pt average is not valid, + !*** extrapolate from interior + !*** NOTE: THIS ASSUMES A CLOSED SOUTH BOUNDARY - WILL NOT + !*** WORK CORRECTLY FOR CYCLIC OPTION + !*** + + if (this_block%j_glob(this_block%jb) == 1) then + do i=this_block%ib,this_block%ie + TLON(i,this_block%jb,n) = TLON(i,this_block%jb+1,n) + TLAT(i,this_block%jb,n) = c2*TLAT(i,this_block%jb+1,n) - & + TLAT(i,this_block%jb+2,n) + end do + endif + + where (TLON(:,:,n) > pi2) TLON(:,:,n) = TLON(:,:,n) - pi2 + where (TLON(:,:,n) < c0 ) TLON(:,:,n) = TLON(:,:,n) + pi2 + + end do + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! Update boundaries +! +!----------------------------------------------------------------------- + + call update_ghost_cells(TLAT, bndy_clinic, field_loc_center, & + field_type_scalar) + call update_ghost_cells(TLON, bndy_clinic, field_loc_center, & + field_type_scalar) + +!----------------------------------------------------------------------- + + end subroutine calc_tpoints + +!*********************************************************************** + + subroutine fill_points(k,F) + +!----------------------------------------------------------------------- +! +! if the depth-level field KMT has been smoothed, fill in +! values of a 2-d field at new ocean points that have appeared +! due to the smoothing using averaged values from nearby points. +! +!* given the smoothed KMT field and the original unsmoothed field +! KMTOLD, values at new points of the field F (defined at level k) +! are filled in with averaged values of F defined at nearby points. +! the averaging is done using a 9-point averaging stencil like +! the one used in 'smooth_topography': +! +! 9-point averaging stencil: +! +! 1 -- 2 -- 1 +! | | | +! 2 -- 4 -- 2 +! | | | +! 1 -- 2 -- 1 +! +! the stencil is modified to include only old ocean points in the +! averaging. +! +!* since only those new points which have neighboring old points +! will be filled in, this procedure must be applied several times +! until all points are filled in. +! +!* if an area weighted average is desired, multiply the field F +! by the cell area before calling the routine, then divide by +! the cell area after the field is returned. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! input variables: +! +!----------------------------------------------------------------------- + + integer (int_kind), intent(in) :: & + k ! depth level at which field is defined + ! (k = 1 for sfc or vert-avg fields) + +!----------------------------------------------------------------------- +! +! input/output: +! +!----------------------------------------------------------------------- + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(inout) :: & + F ! input as field well-defined at old ocean points + ! output as field with new points filled in + +!----------------------------------------------------------------------- +! +! local variables: +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,n, &! dummy indices + npass, &! num of passes thru grid filling points + nfill_points ! num of points left to be filled + + logical(log_kind),dimension(nx_block,ny_block,max_blocks_clinic) ::& + MASKOLD, &! true at old ocean points + MASKNEW ! true at new points not in old ocn field + + integer(int_kind),dimension(nx_block,ny_block,max_blocks_clinic) ::& + NB, &! num points contributing to 9pt avg + IWORK ! local work space + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + FNEW, &! smoothed F field after npass passes + WORK ! local work space + +!----------------------------------------------------------------------- +! +! initialize land mask and pass counter +! +!----------------------------------------------------------------------- + + MASKOLD = (k <= KMTOLD) + npass = 0 + nfill_points = 100 + +!----------------------------------------------------------------------- +! +! pass through grid until all points are filled +! +!----------------------------------------------------------------------- + + do while (nfill_points /= 0) + + npass = npass + 1 + + if (npass > nx_global) then + call exit_POP(sigAbort,'error (fill_points): too many passes') + endif + +!----------------------------------------------------------------------- +! +! find new ocean points not in old ocean field +! +!----------------------------------------------------------------------- + + MASKNEW = (k <= KMT) .and. (.not. MASKOLD) + +!----------------------------------------------------------------------- +! +! find smoothed field: fill all points in this field with +! the (9-point) average of the surrounding neighboring points, +! including in the average only old ocean points. +! +!----------------------------------------------------------------------- + + where (MASKOLD) + WORK = F + IWORK = 1 + elsewhere + IWORK = 0 + WORK = c0 + endwhere + + do n=1,nblocks_clinic + do j=2,ny_block-1 + do i=2,nx_block-1 + + FNEW(i,j,n) = c4*WORK(i,j,n) + & + c2*WORK(i+1,j,n) + c2*WORK(i-1,j,n) + & + c2*WORK(i,j+1,n) + WORK(i+1,j+1,n) + WORK(i-1,j+1,n) + & + c2*WORK(i,j-1,n) + WORK(i+1,j-1,n) + WORK(i-1,j-1,n) + + NB(i,j,n) = 4*IWORK(i,j,n) + & + 2*IWORK(i+1,j,n) + 2*IWORK(i-1,j,n) + & + 2*IWORK(i,j+1,n) + IWORK(i+1,j+1,n) + IWORK(i-1,j+1,n) + & + 2*IWORK(i,j-1,n) + IWORK(i+1,j-1,n) + IWORK(i-1,j-1,n) + + end do + end do + end do + +!----------------------------------------------------------------------- +! +! fill in F at new ocean points with the smoothed field, +! only fill in points which have neighboring old ocean points. +! +!----------------------------------------------------------------------- + + where (MASKNEW .and. (NB /= 0)) + F = FNEW/float(NB) + MASKOLD = .true. ! update for next pass + endwhere + + call update_ghost_cells(F, bndy_clinic, field_loc_center, & + field_type_scalar) + +!----------------------------------------------------------------------- +! +! return for another pass if more points remain to be filled. +! +!----------------------------------------------------------------------- + + nfill_points = global_count((MASKNEW .and. (IWORK == 0)), & + distrb_clinic, field_loc_center) + enddo + +!----------------------------------------------------------------------- + + end subroutine fill_points + +!*********************************************************************** +!BOP +! !IROUTINE: ugrid_to_tgrid +! !INTERFACE: + + subroutine ugrid_to_tgrid(ARRAY_TGRID, ARRAY_UGRID, iblock) + +! !DESCRIPTION: +! Interpolates values at U points on a B grid to T points. +! Note that ghost cells are not updated. +! Also note that the input array is assumed to be in the baroclinic +! distribution (where the stencil weights are defined). +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iblock ! index for block in baroclinic distrb + + real (r8), dimension(nx_block,ny_block), intent(in) :: & + ARRAY_UGRID ! field on U points + +! !OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block), intent(out) :: & + ARRAY_TGRID ! field on T points + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j ! dummy indices + +!----------------------------------------------------------------------- +! +! southwest 4pt average +! +!----------------------------------------------------------------------- + + do j=2,ny_block + do i=2,nx_block + + ARRAY_TGRID(i,j) = AT0 (i,j,iblock)*ARRAY_UGRID(i ,j ) + & + ATS (i,j,iblock)*ARRAY_UGRID(i ,j-1) + & + ATW (i,j,iblock)*ARRAY_UGRID(i-1,j ) + & + ATSW(i,j,iblock)*ARRAY_UGRID(i-1,j-1) + + end do + end do + + ARRAY_TGRID(:,1) = c0 + ARRAY_TGRID(1,:) = c0 + +!----------------------------------------------------------------------- +!EOC + + end subroutine ugrid_to_tgrid + +!*********************************************************************** +!BOP +! !IROUTINE: tgrid_to_ugrid +! !INTERFACE: + + subroutine tgrid_to_ugrid(ARRAY_UGRID, ARRAY_TGRID, iblock) + +! !DESCRIPTION: +! Interpolates values at T points on a B grid to U points. +! Note that ghost cells are not updated. +! Also note that the input array is assumed to be in the baroclinic +! distribution (where the stencil weights are defined). +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iblock ! index for block in baroclinic distrb + + real (r8), dimension(nx_block,ny_block), intent(in) :: & + ARRAY_TGRID ! field on T points + +! !OUTPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block), intent(out) :: & + ARRAY_UGRID ! field on U points + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j ! dummy indices + +!----------------------------------------------------------------------- +! +! northeast 4pt average +! +!----------------------------------------------------------------------- + + do j=1,ny_block-1 + do i=1,nx_block-1 + + ARRAY_UGRID(i,j) = AU0 (i,j,iblock)*ARRAY_TGRID(i ,j ) + & + AUN (i,j,iblock)*ARRAY_TGRID(i ,j+1) + & + AUE (i,j,iblock)*ARRAY_TGRID(i+1,j ) + & + AUNE(i,j,iblock)*ARRAY_TGRID(i+1,j+1) + + end do + end do + + ARRAY_UGRID(:,ny_block) = c0 + ARRAY_UGRID(nx_block,:) = c0 + +!----------------------------------------------------------------------- +!EOC + + end subroutine tgrid_to_ugrid + +!*********************************************************************** + + end module grid + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + diff --git a/components/cism/source_glc/POP_files/io.F90 b/components/cism/source_glc/POP_files/io.F90 new file mode 100644 index 0000000000..6174da954a --- /dev/null +++ b/components/cism/source_glc/POP_files/io.F90 @@ -0,0 +1,206 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io + +!BOP +! !MODULE: io +! +! !DESCRIPTION: +! This module provides a generic parallel input/output interface +! for writing arrays. +! +! !REVISION HISTORY: +! SVN:$Id: io.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: + + use kinds_mod + use blocks + use communicate + use broadcast + use exit_mod + use domain + use constants + use io_netcdf + use io_binary + use io_types + + implicit none + public ! to get io_types without having to explicitly use io_types + ! module directly + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: data_set + +!EOP +!BOC +!EOC +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: data_set +! !INTERFACE: + + subroutine data_set (data_file, operation, io_field) + +! !DESCRIPTION: +! This routine is the main interface for array and file io functions, +! including read, write, open, close. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent (in) :: operation + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: data_file + type (io_field_desc), intent (inout), optional :: io_field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +! +! select operation to perform +! +!----------------------------------------------------------------------- + + select case (trim(operation)) + +!----------------------------------------------------------------------- +! +! open for reading +! +!----------------------------------------------------------------------- + + case ('open_read') + + if (data_file%data_format=='bin') then + call open_read_binary(data_file) + else if (data_file%data_format=='nc') then + call open_read_netcdf(data_file) + endif + +!----------------------------------------------------------------------- +! +! Open means open for write. We also at this time write any global +! attributes. +! +!----------------------------------------------------------------------- + + case ('open') + + if (data_file%data_format=='bin') then + call open_binary(data_file) + else if (data_file%data_format=='nc') then + call open_netcdf(data_file) + endif + +!----------------------------------------------------------------------- +! +! close a data file +! +!----------------------------------------------------------------------- + + case ('close') + + if (data_file%data_format=='bin') then + call close_binary(data_file) + else if (data_file%data_format=='nc') then + call close_netcdf(data_file) + endif + +!----------------------------------------------------------------------- +! +! define an io field +! +!----------------------------------------------------------------------- + + case ('define') + + if (.not.present(io_field)) then + call exit_POP(sigAbort, & + 'data_file define: missing io_field arg') + end if + + if (data_file%data_format=='bin') then + call define_field_binary(data_file,io_field) + else if (data_file%data_format=='nc') then + call define_field_netcdf(data_file,io_field) + endif + +!----------------------------------------------------------------------- +! +! write an io field +! +!----------------------------------------------------------------------- + + case ('write') + + if (.not.present(io_field)) then + call exit_POP(sigAbort,'data_file write: missing io_field arg') + end if + + if (data_file%data_format=='bin') then + call write_field_binary(data_file,io_field) + else if (data_file%data_format=='nc') then + call write_field_netcdf(data_file,io_field) + endif + +!----------------------------------------------------------------------- +! +! read an io field +! +!----------------------------------------------------------------------- + + case ('read') + + if (.not.present(io_field)) then + call exit_POP(sigAbort,'data_file read: missing io_field arg') + end if + + if (data_file%data_format=='bin') then + call read_field_binary(data_file,io_field) + else if (data_file%data_format=='nc') then + call read_field_netcdf(data_file,io_field) + endif + +!----------------------------------------------------------------------- +! +! unknown operation +! +!----------------------------------------------------------------------- + + case default + + if (my_task == master_task) & + write(stdout,*) 'data_set operation: ',trim(operation) + call exit_POP(sigAbort,'data_set: Unknown operation') + + end select + +!----------------------------------------------------------------------- +!EOC + + end subroutine data_set + +!*********************************************************************** + + + end module io + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/io_binary.F90 b/components/cism/source_glc/POP_files/io_binary.F90 new file mode 100644 index 0000000000..843584c200 --- /dev/null +++ b/components/cism/source_glc/POP_files/io_binary.F90 @@ -0,0 +1,2151 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io_binary + +!BOP +! !MODULE: io_binary +! !DESCRIPTION: +! This module provides a binary parallel input/output interface +! for writing fields. +! +! !REVISION HISTORY: +! SVN:$Id: io_binary.F90 923 2006-05-10 22:25:10Z njn01 $ + +! !USES: + + use kinds_mod + use domain_size + use domain + use constants + use boundary + use communicate + use broadcast + use gather_scatter + use exit_mod + use io_types + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: open_read_binary, & + open_binary, & + close_binary, & + define_field_binary, & + read_field_binary, & + write_field_binary + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + character (1), parameter :: & + attrib_separator=':' ! character separating attrib name and value + +!----------------------------------------------------------------------- +! +! binary interfaces for i/o routines +! +!----------------------------------------------------------------------- + + interface write_array + module procedure write_int_2d, & + write_real4_2d, & + write_real8_2d, & + write_int_3d, & + write_real4_3d, & + write_real8_3d + end interface + + interface read_array + module procedure read_int_2d, & + read_real4_2d, & + read_real8_2d, & + read_int_3d, & + read_real4_3d, & + read_real8_3d + end interface + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: open_read_binary +! !INTERFACE: + + subroutine open_read_binary(data_file) + +! !DESCRIPTION: +! This routine opens a binary data file (and header file if it +! exists) for reading. It also reads global file attributes. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file to be opened + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: & + path, &! filename to read + work_line, &! temporary to use for parsing file lines + comp_line, &! temporary to use for parsing file lines + data_type, &! temporary to use for data type + att_name ! attribute name + + integer (i4) :: & + n, &! loop index + att_ival, &! value for integer attribute + hdr_error, &! error for reading header file + cindx1,cindx2 ! indices for unpacking character strings + + logical (log_kind) :: & + att_lval ! value for logical attribute + + real (r4) :: & + att_rval ! value for real attribute + + real (r8) :: & + att_dval ! value for double attribute + + logical (log_kind) :: & + header_exists, &! flag to check existence of header file + lmatch ! flag to use for attribute search + +!----------------------------------------------------------------------- +! +! set the readonly flag in the data file descriptor +! +!----------------------------------------------------------------------- + + data_file%readonly = .true. + +!----------------------------------------------------------------------- +! +! if unit not assigned already, assign a unit (id) to this file +! +!----------------------------------------------------------------------- + + if (data_file%id(1) == 0) then + call get_unit(data_file%id(1)) + call get_unit(data_file%id(2)) + endif + +!----------------------------------------------------------------------- +! +! check to see whether a header file exists +! if so, open it +! if not, set the unit to -unit so it can be released later +! +!----------------------------------------------------------------------- + + header_exists = .false. + + if (my_task == master_task) then + path = trim(data_file%full_name)/& + &/'.hdr' + + inquire(file=path, exist=header_exists) + + if (header_exists) then + open (unit=data_file%id(2), file=path, status='old') + else + write(stdout,*) 'WARNING: Input header file does not exist' + write(stdout,*) 'for file: ',trim(path) + write(stdout,*) & + 'Assuming fields will be read in sequential order' + endif + endif + + call broadcast_scalar(header_exists, master_task) + + if (.not. header_exists) then + data_file%id(2) = -data_file%id(2) + data_file%current_record = 1 + endif + +!----------------------------------------------------------------------- +! +! now open data file +! +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) then + path = trim(data_file%full_name) + open (unit=data_file%id(1),action='read',status='unknown', & + file=trim(path), form='unformatted',access='direct', & + recl=data_file%record_length) + endif + +!----------------------------------------------------------------------- +! +! if the header file exists read file attributes from header file +! +!----------------------------------------------------------------------- + + if (header_exists) then + + work_line = char_blank + hdr_error = 0 + + if (my_task == master_task) then + !*** first read until hit beginning of global attribute + !*** definition section + + do while (hdr_error == 0 .and. work_line(1:7) /= '&GLOBAL') + read(data_file%id(2),'(a80)',iostat=hdr_error) comp_line + work_line = adjustl(comp_line) + end do + end if + + !*** now read until hit end of global attribute definition + + att_loop: do while (hdr_error == 0) + + work_line = char_blank + if (my_task == master_task) then + read(data_file%id(2),'(a80)',iostat=hdr_error) comp_line + work_line = adjustl(comp_line) + endif + + call broadcast_scalar(work_line, master_task) + call broadcast_scalar(hdr_error, master_task) + + if (work_line(1:1) == '/') exit att_loop + + !*** find location of separator in the string + !*** to determine name of attribute and extract + !*** attribute name from beginning of string + + cindx1 = index(work_line,attrib_separator) + att_name = char_blank + att_name(1:cindx1-1) = work_line(1:cindx1-1) + + comp_line = work_line + do n=1,cindx1 + comp_line(n:n) = ' ' + end do + work_line = adjustl(comp_line) + + !*** now find location of separator in the string + !*** to determine data type of attribute and extract + !*** data type from beginning of string + + cindx1 = index(work_line,attrib_separator) + data_type = char_blank + data_type(1:cindx1-1) = work_line(1:cindx1-1) + + comp_line = work_line + do n=1,cindx1 + comp_line(n:n) = ' ' + end do + work_line = adjustl(comp_line) + + !*** check for standard file attributes + + select case(trim(att_name)) + case ('title','TITLE') + data_file%title = trim(work_line) + case ('history','HISTORY') + data_file%history = trim(work_line) + case ('conventions','CONVENTIONS') + data_file%conventions = trim(work_line) + case default + + !*** if additional attributes exist, add them as + !*** additional attributes + !*** note that if they are already defined, the + !*** call to add_attrib will overwrite value + + select case (trim(data_type)) + case('char','CHAR') + call add_attrib_file(data_file, trim(att_name), & + trim(work_line)) + case('log','LOG','logical','LOGICAL') + read(work_line,*) att_lval + call add_attrib_file(data_file, trim(att_name), att_lval) + case('int','INT','i4','I4') + read(work_line,*) att_ival + call add_attrib_file(data_file, trim(att_name), att_ival) + case('r4','R4','REAL','real','float','FLOAT') + read(work_line,*) att_rval + call add_attrib_file(data_file, trim(att_name), att_rval) + case('r8','R8','dbl','DBL','double','DOUBLE') + read(work_line,*) att_dval + call add_attrib_file(data_file, trim(att_name), att_dval) + end select + + end select + end do att_loop + + endif ! header exists + +!----------------------------------------------------------------------- +!EOC + + end subroutine open_read_binary + +!*********************************************************************** +!BOP +! !IROUTINE: open_binary +! !INTERFACE: + + subroutine open_binary(data_file) + +! !DESCRIPTION: +! This routine opens a binary data file and header file for writing +! and writes global file attributes to the header file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file to open + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (255) :: path + + character (char_len) :: & + work_line ! temp space for manipulating strings + + character (5), parameter :: & + hdr_fmt = '(a80)' + + integer (i4) :: & + n, &! loop index + cindx1, cindx2, &! indices for character strings + hdr_unit ! unit number for header file + +!----------------------------------------------------------------------- +! +! assign units to file if not assigned already +! +!----------------------------------------------------------------------- + + if (data_file%id(1) == 0) then + call get_unit(data_file%id(1)) + call get_unit(data_file%id(2)) + endif + +!----------------------------------------------------------------------- +! +! open data and header files for writing +! +!----------------------------------------------------------------------- + + !*** open header file from one task only + + if (my_task == master_task) then + path = trim(data_file%full_name)/& + &/'.hdr' + open (unit=data_file%id(2), file=path, status='unknown') + hdr_unit = data_file%id(2) + end if + + path = trim(data_file%full_name) + + !*** open data file from all io tasks + + if (my_task < data_file%num_iotasks) then + open(data_file%id(1), file=path, access='direct', & + form='unformatted', recl=data_file%record_length, & + status='unknown') + endif + + !*** initialize record number + + data_file%current_record = 1 + +!----------------------------------------------------------------------- +! +! write attributes to header file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + + work_line = char_blank + work_line(1:7) = '&GLOBAL' + write(hdr_unit,hdr_fmt) work_line + + work_line = char_blank + work_line(1:5) = 'title' + work_line(6:6) = attrib_separator + work_line(7:10) = 'char' + work_line(11:11) = attrib_separator + write(work_line(12:),*) trim(data_file%title) + write(hdr_unit,hdr_fmt) work_line + + work_line = char_blank + work_line(1:7) = 'history' + work_line(8:8) = attrib_separator + work_line(9:12) = 'char' + work_line(13:13) = attrib_separator + write(work_line(14:),*) trim(data_file%history) + write(hdr_unit,hdr_fmt) work_line + + work_line = char_blank + work_line(1:11) = 'conventions' + work_line(12:12) = attrib_separator + work_line(11:14) = 'char' + work_line(15:15) = attrib_separator + write(work_line(16:),*) trim(data_file%conventions) + write(hdr_unit,hdr_fmt) work_line + + !*** if additional attributes are defined in the + !*** file definition, write these as well + + if (associated(data_file%add_attrib_cval)) then + do n=1,size(data_file%add_attrib_cval) + + work_line = char_blank + cindx1 = 1 + cindx2 = len_trim(data_file%add_attrib_cname(n)) + work_line(cindx1:cindx2) = trim(data_file%add_attrib_cname(n)) + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + cindx2 = cindx1 + 3 + work_line(cindx1:cindx2) = 'char' + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + write(work_line(cindx1:),*) trim(data_file%add_attrib_cval(n)) + write(hdr_unit,hdr_fmt) work_line + + end do + endif ! cval + + if (associated(data_file%add_attrib_lval)) then + do n=1,size(data_file%add_attrib_lval) + + work_line = char_blank + cindx1 = 1 + cindx2 = len_trim(data_file%add_attrib_lname(n)) + work_line(cindx1:cindx2)=trim(data_file%add_attrib_lname(n)) + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + cindx2 = cindx1 + 2 + work_line(cindx1:cindx2) = 'log' + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + write(work_line(cindx1:),*) data_file%add_attrib_lval(n) + write(hdr_unit,hdr_fmt) work_line + + end do + endif ! lval + + if (associated(data_file%add_attrib_ival)) then + do n=1,size(data_file%add_attrib_ival) + + work_line = char_blank + cindx1 = 1 + cindx2 = len_trim(data_file%add_attrib_iname(n)) + work_line(cindx1:cindx2)=trim(data_file%add_attrib_iname(n)) + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + cindx2 = cindx1 + 2 + work_line(cindx1:cindx2) = 'int' + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + write(work_line(cindx1:),*) data_file%add_attrib_ival(n) + write(hdr_unit,hdr_fmt) work_line + + end do + endif ! ival + + if (associated(data_file%add_attrib_rval)) then + do n=1,size(data_file%add_attrib_rval) + + work_line = char_blank + cindx1 = 1 + cindx2 = len_trim(data_file%add_attrib_rname(n)) + work_line(cindx1:cindx2) = & + trim(data_file%add_attrib_rname(n)) + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + cindx2 = cindx1 + 1 + work_line(cindx1:cindx2) = 'r4' + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + write(work_line(cindx1:),*) data_file%add_attrib_rval(n) + write(hdr_unit,hdr_fmt) work_line + + end do + endif ! rval + + if (associated(data_file%add_attrib_dval)) then + do n=1,size(data_file%add_attrib_dval) + + work_line = char_blank + cindx1 = 1 + cindx2 = len_trim(data_file%add_attrib_dname(n)) + work_line(cindx1:cindx2)=trim(data_file%add_attrib_dname(n)) + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + cindx2 = cindx1 + 1 + work_line(cindx1:cindx2) = 'r8' + cindx1 = cindx2 + 1 + cindx2 = cindx1 + work_line(cindx1:cindx2) = attrib_separator + cindx1 = cindx2 + 1 + write(work_line(cindx1:),*) data_file%add_attrib_dval(n) + write(hdr_unit,hdr_fmt) work_line + + end do + endif ! dval + + endif ! master task + +!----------------------------------------------------------------------- +!EOC + + end subroutine open_binary + +!*********************************************************************** +!BOP +! !IROUTINE: close_binary +! !INTERFACE: + + subroutine close_binary(data_file) + +! !DESCRIPTION: +! This routine closes an open binary data file and the associated +! header file if it exists. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: data_file + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! close a data file +! +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) close(data_file%id(1)) + + if (my_task == master_task .and. data_file%id(2) > 0) & + close(data_file%id(2)) + +!----------------------------------------------------------------------- +!EOC + + end subroutine close_binary + +!*********************************************************************** +!BOP +! !IROUTINE: define_field_binary +! !INTERFACE: + + subroutine define_field_binary(data_file, io_field) + +! !DESCRIPTION: +! This routine defines an io field. When writing a file, this means +! computing the starting record number for the field and then writing +! the field information to the header file. When reading a file, +! the define routine will attempt to fill an io field with information +! from the header file; if a header file does not exist, it will leave +! the io field mostly undefined and will rely on an input record from +! the read routine to locate the field in the file (this latter is +! provided for compatibility with forcing and grid files). +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file + + type (io_field_desc), intent (inout) :: & + io_field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (80) :: & + work_line, &! workspace for manipulating input string + comp_line, &! comparison string + att_name, &! attribute name string + ctype ! attribute data type + + integer (i4) :: & + n, &! loop index + att_ival, &! temp value for integer attribute + hdr_error, &! io error status for header file + cindx1, &! character string index + cindx2, &! character string index + unit ! unit for header file + + logical (log_kind) :: & + att_lval ! temp value for logical attribute + + real (r4) :: & + att_rval ! temp value for real attribute + + real (r8) :: & + att_dval ! temp value for double attribute + +!----------------------------------------------------------------------- +! +! for output files, set id to current record number and write +! field attributes to header file. +! +!----------------------------------------------------------------------- + + if (.not. data_file%readonly) then + + !*** define id as current record + + io_field%id = data_file%current_record + + !*** increment record counter for next field + + if (io_field%nfield_dims == 2) then + + data_file%current_record = data_file%current_record + 1 + + else if (io_field%nfield_dims == 3) then + + if (associated(io_field%field_i_3d)) then + n = size(io_field%field_i_3d,dim=3) + else if (associated(io_field%field_r_3d)) then + n = size(io_field%field_r_3d,dim=3) + else if (associated(io_field%field_d_3d)) then + n = size(io_field%field_d_3d,dim=3) + endif + + data_file%current_record = data_file%current_record + n + + endif + + !*** + !*** now write attributes to header file + !*** + + unit = data_file%id(2) + + if (my_task == master_task) then + + !*** first write variable name header + + write(unit,'(a1,a)') '&',trim(io_field%short_name) + + !*** write standard attributes to header file + + if (io_field%long_name /= char_blank) & + write(unit,'(a9,a1,a4,a1,a)') 'long_name', attrib_separator, & + 'char', attrib_separator, & + trim(io_field%long_name) + + if (io_field%units /= char_blank) & + write(unit,'(a5,a1,a4,a1,a)') 'units', attrib_separator, & + 'char' , attrib_separator, & + trim(io_field%units) + + if (io_field%coordinates /= char_blank) & + write(unit,'(a5,a1,a4,a1,a)') 'coordinates', attrib_separator, & + 'char' , attrib_separator, & + trim(io_field%coordinates) + + if (io_field%grid_loc /= ' ') & + write(unit,'(a8,a1,a4,a1,a4)') 'grid_loc', attrib_separator, & + 'char' , attrib_separator, & + io_field%grid_loc + + if (io_field%missing_value /= undefined) then + work_line = char_blank + work_line( 1:13) = 'missing_value' + work_line(14:14) = attrib_separator + work_line(15:16) = 'r8' + work_line(17:17) = attrib_separator + write(work_line(18:),*) io_field%missing_value + write(unit,'(a)') trim(work_line) + endif + + if (any(io_field%valid_range(:) /= undefined)) then + work_line = char_blank + work_line( 1:11) = 'valid_range' + work_line(12:12) = attrib_separator + work_line(13:14) = 'r8' + work_line(15:15) = attrib_separator + write(work_line(16:),*) io_field%valid_range(:) + write(unit,'(a)') trim(work_line) + endif + + work_line = char_blank + work_line(1:2) = 'id' + work_line(3:3) = attrib_separator + work_line(4:6) = 'int' + work_line(7:7) = attrib_separator + write(work_line(8:),*) io_field%id + write(unit,'(a)') trim(work_line) + + !**** number of dimensions and dimension info + + work_line = char_blank + work_line( 1:11) = 'nfield_dims' + work_line(12:12) = attrib_separator + work_line(13:15) = 'int' + work_line(16:16) = attrib_separator + write(work_line(17:),*) io_field%nfield_dims + write(unit,'(a)') trim(work_line) + + !**** not sure what to do about dimension info + + ! write field_dim stuff + + !*** write additional attributes to header file + + if (associated(io_field%add_attrib_cval)) then + do n=1,size(io_field%add_attrib_cval) + + work_line = char_blank + cindx1 = len_trim(io_field%add_attrib_cname(n)) + cindx2 = cindx1 + 7 + work_line(1:cindx1) = trim(io_field%add_attrib_cname(n)) + work_line(cindx1+1:cindx1+1) = attrib_separator + work_line(cindx1+2:cindx2-2) = 'char' + work_line(cindx2-1:cindx2-1) = attrib_separator + cindx1 = cindx2 + len_trim(io_field%add_attrib_cval(n)) + work_line(cindx2:cindx2) = trim(io_field%add_attrib_cval(n)) + write(unit,'(a)') trim(work_line) + end do + endif + + if (associated(io_field%add_attrib_lval)) then + do n=1,size(io_field%add_attrib_lval) + + work_line = char_blank + cindx1 = len_trim(io_field%add_attrib_lname(n)) + cindx2 = cindx1 + 6 + work_line(1:cindx1) = trim(io_field%add_attrib_lname(n)) + work_line(cindx1+1:cindx1+1) = attrib_separator + work_line(cindx1+2:cindx2-2) = 'log' + work_line(cindx2-1:cindx2-1) = attrib_separator + write(work_line(cindx2:),*) io_field%add_attrib_lval(n) + write(unit,'(a)') trim(work_line) + end do + endif + + if (associated(io_field%add_attrib_ival)) then + do n=1,size(io_field%add_attrib_ival) + + work_line = char_blank + cindx1 = len_trim(io_field%add_attrib_iname(n)) + cindx2 = cindx1 + 6 + work_line(1:cindx1) = trim(io_field%add_attrib_iname(n)) + work_line(cindx1+1:cindx1+1) = attrib_separator + work_line(cindx1+2:cindx2-2) = 'int' + work_line(cindx2-1:cindx2-1) = attrib_separator + write(work_line(cindx2:),*) io_field%add_attrib_ival(n) + write(unit,'(a)') trim(work_line) + end do + endif + + if (associated(io_field%add_attrib_rval)) then + do n=1,size(io_field%add_attrib_rval) + + work_line = char_blank + cindx1 = len_trim(io_field%add_attrib_rname(n)) + cindx2 = cindx1 + 5 + work_line(1:cindx1) = trim(io_field%add_attrib_rname(n)) + work_line(cindx1+1:cindx1+1) = attrib_separator + work_line(cindx1+2:cindx2-2) = 'r4' + work_line(cindx2-1:cindx2-1) = attrib_separator + write(work_line(cindx2:),*) io_field%add_attrib_rval(n) + write(unit,'(a)') trim(work_line) + end do + endif + + if (associated(io_field%add_attrib_dval)) then + do n=1,size(io_field%add_attrib_dval) + + work_line = char_blank + cindx1 = len_trim(io_field%add_attrib_dname(n)) + cindx2 = cindx1 + 5 + work_line(1:cindx1) = trim(io_field%add_attrib_dname(n)) + work_line(cindx1+1:cindx1+1) = attrib_separator + work_line(cindx1+2:cindx2-2) = 'r8' + work_line(cindx2-1:cindx2-1) = attrib_separator + write(work_line(cindx2:),*) io_field%add_attrib_dval(n) + write(unit,'(a)') work_line + write(unit,'(a)') trim(work_line) + end do + endif + + !*** end variable attribute section with a delimiter + + write(unit,'(a1)') '/' + + endif ! master task + +!----------------------------------------------------------------------- +! +! attempt to define an io field from an input header file +! +!----------------------------------------------------------------------- + + else ! this is an input file + + unit = data_file%id(2) + if (unit <= 0) then ! no header file, assume fields are defined + ! in the order they exist in input file + ! set id as current record and increment + + io_field%id = data_file%current_record + + if (associated(io_field%field_i_2d)) then + data_file%current_record = data_file%current_record + 1 + else if (associated(io_field%field_i_3d)) then + data_file%current_record = data_file%current_record + & + size(io_field%field_i_3d, dim=3) + else if (associated(io_field%field_r_2d)) then + data_file%current_record = data_file%current_record + 1 + else if (associated(io_field%field_r_3d)) then + data_file%current_record = data_file%current_record + & + size(io_field%field_r_3d, dim=3) + else if (associated(io_field%field_d_2d)) then + data_file%current_record = data_file%current_record + 1 + else if (associated(io_field%field_d_3d)) then + data_file%current_record = data_file%current_record + & + size(io_field%field_d_3d, dim=3) + else + call exit_POP(sigAbort, & + 'define: No known binary field descriptor associated') + end if + + + else ! header exists: read all attributes from header file + + if (my_task == master_task) then + hdr_error = 0 + rewind (unit) + cindx1 = len_trim(io_field%short_name) + 1 + comp_line(1:1) = '&' + comp_line(2:cindx1) = trim(io_field%short_name) + + srch_loop: do while (hdr_error == 0) ! look for field in file + + read(unit,'(a80)',iostat=hdr_error) work_line + work_line = adjustl(work_line) + if (work_line(1:cindx1) == comp_line(1:cindx1)) & + exit srch_loop + end do srch_loop + endif ! master_task + + call broadcast_scalar(hdr_error, master_task) + if (hdr_error /= 0) call exit_POP(sigAbort,& + 'could not find field in binary header file') + + !*** found io_field definition - now extract field attributes + + att_loop: do + + if (my_task == master_task) then + read(unit,'(a80)',iostat=hdr_error) work_line + work_line = adjustl(work_line) + endif + + call broadcast_scalar(hdr_error, master_task) + call broadcast_scalar(work_line, master_task) + + !*** exit if error reading or reached end of definition + + if (hdr_error /= 0 .or. work_line(1:1) == '/') & + exit att_loop + + !*** extract attribute name + + cindx1 = index(work_line,attrib_separator) + att_name = char_blank + att_name(1:cindx1-1) = work_line(1:cindx1-1) + + !*** strip attribute name from input line + + comp_line = work_line + do n=1,cindx1 + comp_line(n:n) = ' ' + end do + work_line = adjustl(comp_line) + + !*** extract attribute data type + + cindx1 = index(work_line,attrib_separator) + ctype = char_blank + ctype(1:cindx1-1) = work_line(1:cindx1-1) + + !*** strip data type from input line + + comp_line = work_line + do n=1,cindx1 + comp_line(n:n) = ' ' + end do + work_line = adjustl(comp_line) + + !*** if this attribute matches a standard attribute + !*** set attribute value. otherwise, define an + !*** additional attribute + + select case (trim(att_name)) + + case('long_name','LONG_NAME') + io_field%long_name = char_blank + io_field%long_name = trim(work_line) + + case('units','UNITS') + io_field%units = char_blank + io_field%units = trim(work_line) + + case('coordinates','COORDINATES') + io_field%coordinates = char_blank + io_field%coordinates = trim(work_line) + + case('grid_loc','GRID_LOC') + io_field%grid_loc = char_blank + io_field%grid_loc = trim(work_line) + + case('missing_value','MISSING_VALUE') + read(work_line,*) io_field%missing_value + + case('valid_range','VALID_RANGE') + read(work_line,*) io_field%valid_range(:) + + case('id','ID') + read(work_line,*) io_field%id + + case('field_dim','FIELD_DIM') + !**** do not know what to do about dimensions yet + + case('nfield_dims','NFIELD_DIMS') + read(work_line,*) io_field%nfield_dims + + case default + + !*** add attribute to io field + + select case (ctype) + case ('char','CHAR','character','CHARACTER') + call add_attrib_io_field(io_field, trim(att_name), & + trim(work_line)) + + case ('log','LOG','logical','LOGICAL') + read(work_line,*) att_lval + call add_attrib_io_field(io_field, trim(att_name), & + att_lval) + + case ('int','INT','i4','I4','integer','INTEGER') + read(work_line,*) att_ival + call add_attrib_io_field(io_field, trim(att_name), & + att_ival) + + case ('r4','R4','real','REAL','float','FLOAT') + read(work_line,*) att_rval + call add_attrib_io_field(io_field, trim(att_name), & + att_rval) + + case ('r8','R8','dbl','DBL','double','DOUBLE') + read(work_line,*) att_dval + call add_attrib_io_field(io_field, trim(att_name), & + att_dval) + + case default + call exit_POP(sigAbort, & + 'define_io_field: unknown data type') + end select + + end select ! att_name + + end do att_loop + + if (hdr_error /= 0) call exit_POP(sigAbort, & + 'define_io_field: error reading attribute from header') + + endif ! unit > 0 (header exists) + + endif !readonly + +!----------------------------------------------------------------------- +!EOC + + end subroutine define_field_binary + +!*********************************************************************** +!BOP +! !IROUTINE: write_field_binary +! !INTERFACE: + + subroutine write_field_binary(data_file, io_field) + +! !INPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file ! file to which data will be written + + type (io_field_desc), intent (in) :: & + io_field ! field to be written + +! !DESCRIPTION: +! This routine writes a binary field to the data file. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + record ! starting record for writing array + +!----------------------------------------------------------------------- +! +! extract the starting record from the io field +! +!----------------------------------------------------------------------- + + record = io_field%id + +!----------------------------------------------------------------------- +! +! write the io field +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_i_2d)) then + call write_array(data_file,io_field%field_i_2d,record) + else if (associated(io_field%field_i_3d)) then + call write_array(data_file,io_field%field_i_3d,record) + else if (associated(io_field%field_r_2d)) then + call write_array(data_file,io_field%field_r_2d,record) + else if (associated(io_field%field_r_3d)) then + call write_array(data_file,io_field%field_r_3d,record) + else if (associated(io_field%field_d_2d)) then + call write_array(data_file,io_field%field_d_2d,record) + else if (associated(io_field%field_d_3d)) then + call write_array(data_file,io_field%field_d_3d,record) + else + call exit_POP(sigAbort, & + 'write: No known binary field descriptor associated') + end if + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_field_binary + +!*********************************************************************** +!BOP +! !IROUTINE: read_field_binary +! !INTERFACE: + + subroutine read_field_binary(data_file, io_field) + +! !DESCRIPTION: +! This routine reads a field from a binary input file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file from which to read data + + type (io_field_desc), intent (inout) :: & + io_field ! data to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if the field location parameters undefined, assume center scalar +! +!----------------------------------------------------------------------- + + if (io_field%field_loc == field_loc_unknown) then + io_field%field_loc = field_loc_center + io_field%field_type = field_type_scalar + endif + +!----------------------------------------------------------------------- +! +! read an io field +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_i_2d)) then + call read_array(data_file,io_field%field_i_2d,io_field%id, & + io_field%field_loc, io_field%field_type) + else if (associated(io_field%field_i_3d)) then + call read_array(data_file,io_field%field_i_3d,io_field%id, & + io_field%field_loc, io_field%field_type) + else if (associated(io_field%field_r_2d)) then + call read_array(data_file,io_field%field_r_2d,io_field%id, & + io_field%field_loc, io_field%field_type) + else if (associated(io_field%field_r_3d)) then + call read_array(data_file,io_field%field_r_3d,io_field%id, & + io_field%field_loc, io_field%field_type) + else if (associated(io_field%field_d_2d)) then + call read_array(data_file,io_field%field_d_2d,io_field%id, & + io_field%field_loc, io_field%field_type) + else if (associated(io_field%field_d_3d)) then + call read_array(data_file,io_field%field_d_3d,io_field%id, & + io_field%field_loc, io_field%field_type) + else + call exit_POP(sigAbort,'read_field: field not associated') + end if + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_field_binary + +!*********************************************************************** +!BOP +! !IROUTINE: read_int_2d +! !INTERFACE: + + subroutine read_int_2d(data_file, INT2D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 2-d horizontal slice of integers from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info about data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + integer (i4), dimension(:,:,:), intent(inout) :: & + INT2D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4), dimension(:,:), allocatable :: & + IOBUFI ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! read in global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + allocate(IOBUFI(nx_global,ny_global)) + read(data_file%id(1),rec=start_record) IOBUFI + endif + +!----------------------------------------------------------------------- +! +! send chunks to processors who own them +! +!----------------------------------------------------------------------- + + call scatter_global(INT2D, IOBUFI, master_task, distrb_clinic, & + field_loc, field_type) + + if (my_task == master_task) deallocate(IOBUFI) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_int_2d + +!*********************************************************************** +!BOP +! !IROUTINE: read_real4_2d +! !INTERFACE: + + subroutine read_real4_2d(data_file, REAL2D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 2-d horizontal slice of reals from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info about data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:,:), intent(inout) :: & + REAL2D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:), allocatable :: & + IOBUFR ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! read in global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + allocate(IOBUFR(nx_global,ny_global)) + read(data_file%id(1),rec=start_record) IOBUFR + endif + +!----------------------------------------------------------------------- +! +! send chunks to processors who own them +! +!----------------------------------------------------------------------- + + call scatter_global(REAL2D, IOBUFR, master_task, distrb_clinic, & + field_loc, field_type) + + if (my_task == master_task) deallocate(IOBUFR) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_real4_2d + +!*********************************************************************** +!BOP +! !IROUTINE: read_real8_2d +! !INTERFACE: + + subroutine read_real8_2d(data_file, DBL2D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 2-d horizontal slice of 64-bit reals from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info about data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:), intent(inout) :: & + DBL2D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8), dimension(:,:), allocatable :: & + IOBUFD ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! read in global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + allocate(IOBUFD(nx_global,ny_global)) + read(data_file%id(1),rec=start_record) IOBUFD + endif + +!----------------------------------------------------------------------- +! +! send chunks to processors who own them +! +!----------------------------------------------------------------------- + + call scatter_global(DBL2D, IOBUFD, master_task, distrb_clinic, & + field_loc, field_type) + + if (my_task == master_task) deallocate(IOBUFD) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_real8_2d + +!*********************************************************************** +!BOP +! !IROUTINE: read_int_3d +! !INTERFACE: + + subroutine read_int_3d(data_file, INT3D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 3-d integer array from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on input data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + integer (i4), dimension(:,:,:,:), intent(inout) :: & + INT3D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) k,n,krecs,klvl,nz + + integer (i4), dimension(:,:), allocatable :: & + IOBUFI ! global-sized array buffer + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must read to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(INT3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFI(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! each i/o process reads a horizontal slab from a record and sends +! the data to processors who own it. read and distribute num_iotasks +! records at a time to keep the messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + read(data_file%id(1), rec=start_record+klvl-1) IOBUFI + endif + endif + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call scatter_global(INT3D(:,:,klvl,:), IOBUFI, n-1, & + distrb_clinic, field_loc, field_type) + endif + end do + + end do + + if (my_task < data_file%num_iotasks) deallocate(IOBUFI) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_int_3d + +!*********************************************************************** +!BOP +! !IROUTINE: read_real4_3d +! !INTERFACE: + + subroutine read_real4_3d(data_file, REAL3D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 3-d real array from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on input data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + real (r4), dimension(:,:,:,:), intent(inout) :: & + REAL3D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) k,n,krecs,klvl,nz + + real (r4), dimension(:,:), allocatable :: & + IOBUFR ! global-sized array buffer + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must read to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(REAL3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFR(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! each i/o process reads a horizontal slab from a record and sends +! the data to processors who own it. read and distribute num_iotasks +! records at a time to keep the messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + read(data_file%id(1), rec=start_record+klvl-1) IOBUFR + endif + endif + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call scatter_global(REAL3D(:,:,klvl,:), IOBUFR, n-1, & + distrb_clinic, field_loc, field_type) + endif + end do + + end do + + if (my_task < data_file%num_iotasks) deallocate(IOBUFR) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_real4_3d + +!*********************************************************************** +!BOP +! !IROUTINE: read_real8_3d +! !INTERFACE: + + subroutine read_real8_3d(data_file, DBL3D, start_record, & + field_loc, field_type) + +! !DESCRIPTION: +! Reads a 3-d 64-bit real array from a binary file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on input data file + + integer (i4), intent(in) :: & + start_record, &! starting record of field in file + field_loc, &! loc of field on horiz grid + field_type ! type of field (scalar, vector, angle) + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), dimension(:,:,:,:), intent(inout) :: & + DBL3D ! array to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) k,n,krecs,klvl,nz + + real (r8), dimension(:,:), allocatable :: & + IOBUFD ! global-sized array buffer + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must read to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(DBL3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFD(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! each i/o process reads a horizontal slab from a record and sends +! the data to processors who own it. read and distribute num_iotasks +! records at a time to keep the messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + read(data_file%id(1), rec=start_record+klvl-1) IOBUFD + endif + endif + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call scatter_global(DBL3D(:,:,klvl,:), IOBUFD, n-1, & + distrb_clinic, field_loc, field_type) + endif + end do + + end do + + if (my_task < data_file%num_iotasks) deallocate(IOBUFD) + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_real8_3d + +!*********************************************************************** +!BOP +! !IROUTINE: write_int_2d +! !INTERFACE: + + subroutine write_int_2d(data_file,INT2D,start_record) + +! !DESCRIPTION: +! Writes a 2-d slab of integers to a binary file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! file information + + integer (i4), intent(in) :: & + start_record ! starting record of array in file + + integer (i4), dimension(:,:,:), intent(in) :: & + INT2D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4), dimension(:,:), allocatable :: & + IOBUFI ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! receive chunks from processors who own them +! +!----------------------------------------------------------------------- + + if (my_task == master_task) allocate(IOBUFI(nx_global,ny_global)) + + call gather_global(IOBUFI, INT2D, master_task, distrb_clinic) + +!----------------------------------------------------------------------- +! +! write global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(data_file%id(1),rec=start_record) IOBUFI + deallocate(IOBUFI) + endif + +!----------------------------------------------------------------------- +!EOC + end subroutine write_int_2d + +!*********************************************************************** +!BOP +! !IROUTINE: write_real4_2d +! !INTERFACE: + + subroutine write_real4_2d(data_file,REAL2D,start_record) + +! !DESCRIPTION: +! Writes a 2-d slab of reals to a binary file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! file information + + integer (i4), intent(in) :: & + start_record ! starting record of array in file + + real (r4), dimension(:,:,:), intent(in) :: & + REAL2D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r4), dimension(:,:), allocatable :: & + IOBUFR ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! receive chunks from processors who own them +! +!----------------------------------------------------------------------- + + if (my_task == master_task) allocate(IOBUFR(nx_global,ny_global)) + call gather_global(IOBUFR, REAL2D, master_task, distrb_clinic) + +!----------------------------------------------------------------------- +! +! write global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(data_file%id(1),rec=start_record) IOBUFR + deallocate(IOBUFR) + endif + +!----------------------------------------------------------------------- +!EOC + end subroutine write_real4_2d + +!*********************************************************************** +!BOP +! !IROUTINE: write_real8_2d +! !INTERFACE: + + subroutine write_real8_2d(data_file,DBL2D,start_record) + +! !DESCRIPTION: +! Writes a 2-d slab of doubles to a binary file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! file information + + integer (i4), intent(in) :: & + start_record ! starting record of array in file + + real (r8), dimension(:,:,:), intent(in) :: & + DBL2D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8), dimension(:,:), allocatable :: & + IOBUFD ! local global-sized buffer + +!----------------------------------------------------------------------- +! +! receive chunks from processors who own them +! +!----------------------------------------------------------------------- + + if (my_task == master_task) allocate(IOBUFD(nx_global,ny_global)) + call gather_global(IOBUFD, DBL2D, master_task, distrb_clinic) + +!----------------------------------------------------------------------- +! +! write global 2-d slice from one processor +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(data_file%id(1),rec=start_record) IOBUFD + deallocate(IOBUFD) + endif + +!----------------------------------------------------------------------- +!EOC + end subroutine write_real8_2d + +!*********************************************************************** +!BOP +! !IROUTINE: write_int_3d +! !INTERFACE: + + subroutine write_int_3d(data_file,INT3D,start_record) + +! !DESCRIPTION: +! Writes a 3-d integer array as a series of 2-d slabs to a binary +! output file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on output data file + + integer (i4), intent(in) :: & + start_record ! starting position of array in file + + integer (i4), dimension(:,:,:,:), intent(in) :: & + INT3D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + k, n, & ! dummy counters + krecs, & ! number of records each iotask must write + klvl, & ! k index corresponding to current record + nz ! size of 3rd dimension of 3-d array to be written + + integer (i4), dimension(:,:), allocatable :: & + IOBUFI ! global-sized buffer array + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must write to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(INT3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFI(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! gather and write num_iotasks records at a time to keep the +! messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + +!----------------------------------------------------------------------- +! +! gather a global slice on each iotask +! +!----------------------------------------------------------------------- + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call gather_global(IOBUFI, INT3D(:,:,klvl,:), & + n-1, distrb_clinic) + endif + end do + +!----------------------------------------------------------------------- +! +! iotasks wait for the gather to be complete and write global +! slabs to the file +! +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + write(data_file%id(1), rec=start_record+klvl-1) IOBUFI + endif + endif + + end do + +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) deallocate(IOBUFI) + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_int_3d + +!*********************************************************************** +!BOP +! !IROUTINE: write_real4_3d +! !INTERFACE: + + subroutine write_real4_3d(data_file,REAL3D,start_record) + +! !DESCRIPTION: +! Writes a 3-d real array as a series of 2-d slabs to a binary +! output file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on output data file + + integer (i4), intent(in) :: & + start_record ! starting position of array in file + + real (r4), dimension(:,:,:,:), intent(in) :: & + REAL3D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + k, n, & ! dummy counters + krecs, & ! number of records each iotask must write + klvl, & ! k index corresponding to current record + nz ! size of 3rd dimension of 3-d array to be written + + real (r4), dimension(:,:), allocatable :: & + IOBUFR ! global-sized buffer array + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must write to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(REAL3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFR(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! gather and write num_iotasks records at a time to keep the +! messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + +!----------------------------------------------------------------------- +! +! gather a global slice on each iotask +! +!----------------------------------------------------------------------- + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call gather_global(IOBUFR, REAL3D(:,:,klvl,:), & + n-1, distrb_clinic) + endif + end do + +!----------------------------------------------------------------------- +! +! iotasks wait for the gather to be complete and write global +! slabs to the file +! +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + write(data_file%id(1), rec=start_record+klvl-1) IOBUFR + endif + endif + + end do + +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) deallocate(IOBUFR) + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_real4_3d + +!*********************************************************************** +!BOP +! !IROUTINE: write_real8_3d +! !INTERFACE: + + subroutine write_real8_3d(data_file,DBL3D,start_record) + +! !DESCRIPTION: +! Writes a 3-d 64-bit real array as a series of 2-d slabs to a binary +! output file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent(in) :: & + data_file ! info on output data file + + integer (i4), intent(in) :: & + start_record ! starting position of array in file + + real (r8), dimension(:,:,:,:), intent(in) :: & + DBL3D ! array to be written + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + k, n, & ! dummy counters + krecs, & ! number of records each iotask must write + klvl, & ! k index corresponding to current record + nz ! size of 3rd dimension of 3-d array to be written + + real (r8), dimension(:,:), allocatable :: & + IOBUFD ! global-sized buffer array + +!----------------------------------------------------------------------- +! +! determine the number of records each i/o process must write to +! get all the records +! +!----------------------------------------------------------------------- + + nz = size(DBL3D, DIM=3) + + if (mod(nz,data_file%num_iotasks) == 0) then + krecs = nz/data_file%num_iotasks + else + krecs = nz/data_file%num_iotasks + 1 + endif + + if (my_task < data_file%num_iotasks) & + allocate(IOBUFD(nx_global,ny_global)) + +!----------------------------------------------------------------------- +! +! gather and write num_iotasks records at a time to keep the +! messages from getting mixed up. +! +!----------------------------------------------------------------------- + + do k=1,krecs + +!----------------------------------------------------------------------- +! +! gather a global slice on each iotask +! +!----------------------------------------------------------------------- + + do n=1,data_file%num_iotasks + klvl = (k-1)*data_file%num_iotasks + n + if (klvl <= nz) then + call gather_global(IOBUFD, DBL3D(:,:,klvl,:), & + n-1, distrb_clinic) + endif + end do + +!----------------------------------------------------------------------- +! +! iotasks wait for the gather to be complete and write global +! slabs to the file +! +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) then + klvl = (k-1)*data_file%num_iotasks + my_task + 1 + if (klvl <= nz) then + write(data_file%id(1), rec=start_record+klvl-1) IOBUFD + endif + endif + + end do + +!----------------------------------------------------------------------- + + if (my_task < data_file%num_iotasks) deallocate(IOBUFD) + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_real8_3d + +!*********************************************************************** + + end module io_binary + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/io_ccsm.F90 b/components/cism/source_glc/POP_files/io_ccsm.F90 new file mode 100644 index 0000000000..23d8ac4a9f --- /dev/null +++ b/components/cism/source_glc/POP_files/io_ccsm.F90 @@ -0,0 +1,235 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io_ccsm + +!BOP +! !MODULE: io_ccsm +! +! !DESCRIPTION: +! This module provides a kludge interface for writing nonstandard +! ccsm fields (eg, variables that are not on lat/lon grids and +! thus are unable to be defined via the construct_io_field function) +! to ccsm netCDF output files +! +! !REVISION HISTORY: +! SVN:$Id: io_ccsm.F90 808 2006-04-28 17:06:38Z njn01 $ +! +! + +! !USES: + + use kinds_mod + use blocks + use communicate + use broadcast + use exit_mod + use domain + use constants + use io_netcdf + use io_binary + use io_types + use io_tools + + implicit none + public ! to get io_types without having to explicitly use io_types + ! module directly + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: & + data_set_nstd_ccsm + +!EOP +!BOC + + +!EOC +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: data_set_nstd_ccsm +! !INTERFACE: + + subroutine data_set_nstd_ccsm (data_file,operation,field_id, & + ndims,io_dims,nftype, & + short_name,long_name,units, & + coordinates,missing_value, & + fill_value, & + implied_time_dim, & + data_1d_r8, & + data_2d_r8, & + data_2d_r4, & + data_3d_r4, & + data_4d_r4, & + data_1d_ch, & + data_2d_ch ) + +! !DESCRIPTION: +! This routine is kludge interface to defining and writing the nonstandard +! ccsm fields (eg, those not constructed via construct_io_field) +! to a netCDF file +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + ndims + + character (*), intent(in) :: & + operation, & + short_name, & + long_name, & + units, & + coordinates, & + nftype + + real (r4), dimension (:,:,:,:), intent(in) :: & + data_4d_r4 + real (r4), dimension (:,:,:), intent(in) :: & + data_3d_r4 + real (r4), dimension (:,:), intent(in) :: & + data_2d_r4 + + real (r8), dimension (:,:), intent(in) :: & + data_2d_r8 + real (r8), dimension (:), intent(in) :: & + data_1d_r8 + + character (*), dimension (:,:), intent(in) :: & + data_2d_ch + character (*), dimension (:), intent(in) :: & + data_1d_ch + + + real (r4), intent(in) :: & + fill_value, & + missing_value + + type (datafile),intent(inout) :: & + data_file + +! !INPUT/OUTPUT PARAMETERS: + integer (i4), intent(inout) :: & + field_id + + type (io_dim), intent(inout) :: & + io_dims(:) + + logical (log_kind), intent(inout) :: & + implied_time_dim + + optional :: & + implied_time_dim, & + short_name, & + long_name, & + units, & + coordinates, & + missing_value, & + fill_value, & + data_1d_r8, & + data_2d_r8, & + data_2d_r4, & + data_3d_r4, & + data_4d_r4, & + data_1d_ch, & + data_2d_ch + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: num_writes ! place-holder until more than one + ! time level written to a single file + + logical (log_kind) :: supported + +!----------------------------------------------------------------------- +! +! Must be netCDF format -- binary version does not exist +! +!----------------------------------------------------------------------- + + if (data_file%data_format=='bin') then + call exit_POP(sigAbort, & + '(data_set_nstd_ccsm) ERROR: cannot call this routine with bin format') + endif + +!----------------------------------------------------------------------- +! +! select operation to perform +! +!----------------------------------------------------------------------- + + select case (trim(operation)) + +!----------------------------------------------------------------------- +! +! define an io field +! +!----------------------------------------------------------------------- + + case ('define') + + call define_nstd_netcdf(data_file, ndims, io_dims, field_id, & + short_name, long_name, units, & + coordinates=coordinates, & + missing_value=missing_value, & + fill_value=fill_value, & + nftype=nftype ) + +!----------------------------------------------------------------------- +! +! write an io field +! +!----------------------------------------------------------------------- + + case ('write') + + num_writes = 1 ! for now, only support one time value per output file + + call write_nstd_netcdf( & + data_file, field_id,num_writes, & + ndims, io_dims,nftype, & + implied_time_dim=implied_time_dim, & + indata_1d_r8=data_1d_r8, & ! pass all data arrays + indata_2d_r8=data_2d_r8, & ! to write_nstd_netcdf + indata_2d_r4=data_2d_r4, & + indata_3d_r4=data_3d_r4, & + indata_4d_r4=data_4d_r4, & + indata_1d_ch=data_1d_ch, & + indata_2d_ch=data_2d_ch ) + +!----------------------------------------------------------------------- +! +! unknown operation +! +!----------------------------------------------------------------------- + + case default + + if (my_task == master_task) & + write(stdout,*) 'data_set_nstd_ccsm operation: ',trim(operation) + call exit_POP(sigAbort,'data_set_nstd_ccsm: Unknown operation') + + end select + +!----------------------------------------------------------------------- +!EOC + + end subroutine data_set_nstd_ccsm + +!*********************************************************************** + + end module io_ccsm + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/io_netcdf.F90 b/components/cism/source_glc/POP_files/io_netcdf.F90 new file mode 100644 index 0000000000..2859769593 --- /dev/null +++ b/components/cism/source_glc/POP_files/io_netcdf.F90 @@ -0,0 +1,2955 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io_netcdf + +!BOP +! !MODULE: io_netcdf +! !DESCRIPTION: +! This module provides a generic input/output interface +! for writing arrays in netCDF format. +! +! !REVISION HISTORY: +! SVN:$Id: io_netcdf.F90 2337 2006-10-30 21:54:07Z njn01 $ + +! !USES: + + use kinds_mod + use domain_size + use domain + use constants + use communicate + use boundary + use broadcast + use gather_scatter + use exit_mod + use io_types + use netcdf + use shr_sys_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: open_read_netcdf, & + open_netcdf, & + close_netcdf, & + define_field_netcdf, & + read_field_netcdf, & + write_field_netcdf, & + define_nstd_netcdf, & + write_nstd_netcdf + +!EOP +!BOC + + +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: open_read_netcdf +! !INTERFACE: + + subroutine open_read_netcdf(data_file) + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: data_file + +! !DESCRIPTION: +! This routine opens a netcdf data file and extracts global file +! attributes. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + + character (char_len) :: & + path ! filename to read + + character (80) :: & + work_line, &! temporary to use for parsing file lines + att_name ! temporary to use for attribute names + + integer (i4) :: & + iostat, &! status flag + ncid, &! netCDF file id + nsize, &! size parameter returned by inquire function + n, &! loop index + itype, &! netCDF data type + att_ival, &! netCDF data type + num_atts ! number of global attributes + + logical (log_kind) :: & + att_lval ! temp space for logical attribute + + real (r4) :: & + att_rval ! temp space for real attribute + + real (r8) :: & + att_dval ! temp space for double attribute + + logical (log_kind) :: & + attrib_error ! error flag for reading attributes + +!----------------------------------------------------------------------- +! +! set the readonly flag in the data file descriptor +! +!----------------------------------------------------------------------- + + data_file%readonly = .true. + +!----------------------------------------------------------------------- +! +! open the netCDF file +! +!----------------------------------------------------------------------- + + + iostat = nf90_noerr + data_file%id = 0 + + if (my_task == master_task) then + path = trim(data_file%full_name) + iostat = nf90_open(path=trim(path), mode=nf90_nowrite, ncid=ncid) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort,'error opening netCDF file for reading') + + call broadcast_scalar(ncid, master_task) + data_file%id(1) = ncid + +!----------------------------------------------------------------------- +! +! determine number of global file attributes +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + iostat = nf90_Inquire(ncid, nAttributes = num_atts) + end if + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort, & + 'error getting number of netCDF global attributes') + + call broadcast_scalar(num_atts, master_task) + +!----------------------------------------------------------------------- +! +! now read each attribute and set attribute values +! +!----------------------------------------------------------------------- + + do n=1,num_atts + + !*** + !*** get attribute name + !*** + + att_name = char_blank + if (my_task == master_task) then + iostat = nf90_inq_attname(ncid, NF90_GLOBAL, n, att_name) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort, & + 'error getting netCDF global attribute name') + + call broadcast_scalar(att_name, master_task) + + !*** + !*** check to see if name matches any of the standard file + !*** attributes + !*** + + select case(trim(att_name)) + + case('title') + + data_file%title = char_blank + + if (my_task == master_task) then + iostat = nf90_inquire_attribute(ncid, NF90_GLOBAL, & + name='title', len=nsize) + + if (iostat == nf90_noerr) then + iostat = nf90_get_att(ncid=ncid, varid=NF90_GLOBAL, & + name='title',values=data_file%title(1:nsize)) + call check_status(iostat) + endif + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading title from netCDF file') + endif + + call broadcast_scalar(data_file%title, master_task) + + case('history') + + data_file%history = char_blank + if (my_task == master_task) then + iostat = nf90_inquire_attribute(ncid, NF90_GLOBAL, & + 'history',len=nsize) + if (iostat == nf90_noerr) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, 'history', & + data_file%history(1:nsize)) + call check_status(iostat) + endif + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading history from netCDF file') + endif + + call broadcast_scalar(data_file%history, master_task) + + case('conventions') + + data_file%conventions = char_blank + if (my_task == master_task) then + iostat = nf90_inquire_attribute(ncid, NF90_GLOBAL, & + 'conventions',len=nsize) + if (iostat == nf90_noerr) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, 'conventions', & + data_file%conventions(1:nsize)) + call check_status(iostat) + endif + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading conventions from netCDF file') + endif + + call broadcast_scalar(data_file%conventions, master_task) + + case default + + !*** + !*** if does not match any of the standard file attributes + !*** add the attribute to the datafile + !*** + + if (my_task == master_task) then + iostat = nf90_Inquire_Attribute(ncid, NF90_GLOBAL, & + trim(att_name), & + xtype = itype, & + len = nsize) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(itype, master_task) + + select case (itype) + + case (NF90_CHAR) + work_line = char_blank + call broadcast_scalar(nsize, master_task) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, trim(att_name),& + work_line(1:nsize)) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(work_line, master_task) + call add_attrib_file(data_file, trim(att_name), & + trim(work_line)) + + case (NF90_INT) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, & + trim(att_name), att_ival) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_ival, master_task) + if (att_name(1:4) == 'LOG_') then !*** attribute logical + work_line = att_name + work_line(1:4) = ' ' + att_name = adjustl(work_line) + + if (att_ival == 1) then + att_lval = .true. + else + att_lval = .false. + endif + call add_attrib_file(data_file, trim(att_name), att_lval) + + else + call add_attrib_file(data_file, trim(att_name), att_ival) + endif + + case (NF90_FLOAT) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, & + trim(att_name), att_rval) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_rval, master_task) + call add_attrib_file(data_file, trim(att_name), att_rval) + + + case (NF90_DOUBLE) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, NF90_GLOBAL, & + trim(att_name), att_dval) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_dval, master_task) + call add_attrib_file(data_file, trim(att_name), att_dval) + + + end select + + end select + + end do ! num_atts + +!----------------------------------------------------------------------- +!EOC + + end subroutine open_read_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: open_netcdf +! !INTERFACE: + + subroutine open_netcdf(data_file) + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: data_file + +! !DESCRIPTION: +! This routine opens a data file for writing and +! writes global file attributes. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: & + path ! temp to use for filename + + character (255) :: & + work_line ! temp to use for character manipulation + + integer (i4) :: & + ncid, &! netCDF id for file + iostat, &! status flag for netCDF function calls + itmp, &! integer temp for equivalent logical attribute + n, &! loop index + ncvals, &! counter for number of character attributes + nlvals, &! counter for number of logical attributes + nivals, &! counter for number of integer attributes + nrvals, &! counter for number of real attributes + ndvals ! counter for number of double attributes + + logical (log_kind) :: & + attrib_error ! error flag for reading attributes + +!----------------------------------------------------------------------- +! +! open the netCDF file +! +!----------------------------------------------------------------------- + + iostat = nf90_noerr + data_file%id = 0 + + if (my_task==master_task) then + path = trim(data_file%full_name) + iostat = nf90_create(path=trim(path), cmode=nf90_write, ncid=ncid) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) call exit_POP(sigAbort, & + 'Error opening file') + + call broadcast_scalar(ncid, master_task) + data_file%id(1) = ncid + data_file%ldefine = .true. ! file in netCDF define mode + +!----------------------------------------------------------------------- +! +! define global file attributes +! +!----------------------------------------------------------------------- + + attrib_error = .false. + + if (my_task == master_task) then + + !*** standard attributes + + iostat = nf90_put_att(ncid, NF90_GLOBAL, 'title', & + trim(data_file%title)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing TITLE to netCDF file' + attrib_error = .true. + endif + + iostat = nf90_put_att(ncid, NF90_GLOBAL, 'history', & + trim(data_file%history)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing HISTORY to netCDF file' + attrib_error = .true. + endif + + iostat = nf90_put_att(ncid, NF90_GLOBAL, 'conventions', & + trim(data_file%conventions)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing CONVENTIONS to netCDF file' + attrib_error = .true. + endif + + !*** additional attributes + + if (associated(data_file%add_attrib_cval)) then + ncvals = size(data_file%add_attrib_cval) + else + ncvals = 0 + endif + if (associated(data_file%add_attrib_lval)) then + nlvals = size(data_file%add_attrib_lval) + else + nlvals = 0 + endif + if (associated(data_file%add_attrib_ival)) then + nivals = size(data_file%add_attrib_ival) + else + nivals = 0 + endif + if (associated(data_file%add_attrib_rval)) then + nrvals = size(data_file%add_attrib_rval) + else + nrvals = 0 + endif + if (associated(data_file%add_attrib_dval)) then + ndvals = size(data_file%add_attrib_dval) + else + ndvals = 0 + endif + + do n=1,ncvals + work_line = data_file%add_attrib_cname(n) + + iostat = nf90_put_att(ncid, NF90_GLOBAL, trim(work_line), & + trim(data_file%add_attrib_cval(n))) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing ',trim(work_line) + attrib_error = .true. + endif + end do + + do n=1,nlvals + work_line = 'LOG_'/& + &/data_file%add_attrib_lname(n) + if (data_file%add_attrib_lval(n)) then + itmp = 1 + else + itmp = 0 + endif + + iostat = nf90_put_att(ncid, NF90_GLOBAL, trim(work_line), & + itmp) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing ',trim(work_line) + attrib_error = .true. + endif + end do + + do n=1,nivals + work_line = data_file%add_attrib_iname(n) + + iostat = nf90_put_att(ncid, NF90_GLOBAL, trim(work_line), & + data_file%add_attrib_ival(n)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing ',trim(work_line) + attrib_error = .true. + endif + end do + + do n=1,nrvals + work_line = data_file%add_attrib_rname(n) + + iostat = nf90_put_att(ncid, NF90_GLOBAL, trim(work_line), & + data_file%add_attrib_rval(n)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing ',trim(work_line) + attrib_error = .true. + endif + end do + + do n=1,ndvals + work_line = data_file%add_attrib_dname(n) + + iostat = nf90_put_att(ncid, NF90_GLOBAL, trim(work_line), & + data_file%add_attrib_dval(n)) + call check_status(iostat) + if (iostat /= nf90_noerr) then + write(stdout,*) 'Error writing ',trim(work_line) + attrib_error = .true. + endif + end do + + endif ! master task + + call broadcast_scalar(attrib_error, master_task) + if (attrib_error) call exit_POP(sigAbort, & + 'Error writing file attributes') + +!----------------------------------------------------------------------- +!EOC + + end subroutine open_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: close_netcdf +! !INTERFACE: + + subroutine close_netcdf(data_file) + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: data_file + +! !DESCRIPTION: +! This routine closes an open netcdf data file. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! close a data file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + call check_status(nf90_close(data_file%id(1))) + end if + +!----------------------------------------------------------------------- +!EOC + + end subroutine close_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: define_field_netcdf +! !INTERFACE: + + subroutine define_field_netcdf(data_file, io_field) + +! !DESCRIPTION: +! This routine defines an io field for a netCDF file. +! When reading a file, the define routine will attempt to fill an +! io field structure with meta-data information from the netCDF file. +! When writing a file, it calls the appropriate netCDF routines +! to define all the field attributes and assign a field id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! data file in which field contained + + type (io_field_desc), intent (inout) :: & + io_field ! field descriptor for this field + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (80) :: & + work_line, &! workspace for manipulating input string + comp_line, &! comparison string + att_name ! attribute name + + integer (i4) :: & + iostat, &! status flag for netCDF calls + ncid, &! file id for netcdf file + varid, &! variable id for field + ndims, &! number of dimensions + dimid, &! dimension id + n, &! loop index + ncount, &! num additional attributes + nsize, &! length of character strings + itype, &! netCDF data type + num_atts, &! number of variable attributes + att_ival, &! temp for integer attribute + ncvals, &! counter for number of character attributes + nlvals, &! counter for number of logical attributes + nivals, &! counter for number of integer attributes + nrvals, &! counter for number of real attributes + ndvals ! counter for number of double attributes + + logical (log_kind) :: & + att_lval ! temp for logical attribute + + real (r4) :: & + att_rval ! temp for real attribute + + real (r8) :: & + att_dval ! temp for double attribute + + logical (log_kind) :: & + define_error ! error flag + + + define_error = .false. + ncid = data_file%id(1) + +!----------------------------------------------------------------------- +! +! make sure file has been opened +! +!----------------------------------------------------------------------- + + call check_file_open(data_file, 'define_field_netcdf') + +!----------------------------------------------------------------------- +! +! for input files, get the variable id and determine number of field +! attributes +! +!----------------------------------------------------------------------- + + if (data_file%readonly) then + if (my_task == master_task) then + iostat = NF90_INQ_VARID(ncid, trim(io_field%short_name), & + io_field%id) + call check_status(iostat) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort, & + 'Error finding field in netCDF input file') + + call broadcast_scalar(io_field%id, master_task) + + if (my_task == master_task) then + iostat = NF90_Inquire_Variable(ncid,io_field%id,nAtts=num_atts) + call check_status(iostat) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort, & + 'Error getting attribute count for netCDF field') + + call broadcast_scalar(num_atts, master_task) + + !*** + !*** for each attribute, define standard attributes or add + !*** attribute to io_field + !*** + + do n=1,num_atts + + !*** + !*** get attribute name + !*** + + att_name = char_blank + if (my_task == master_task) then + iostat = nf90_inq_attname(ncid, io_field%id, n, att_name) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) & + call exit_POP(sigAbort, & + 'error getting netCDF field attribute name') + + call broadcast_scalar(att_name, master_task) + + !*** + !*** check to see if name matches any of the standard field + !*** attributes + !*** + + select case(trim(att_name)) + + case('long_name') + + io_field%long_name = char_blank + + if (my_task == master_task) then + iostat = nf90_inquire_attribute(ncid, io_field%id, & + 'long_name', len=nsize) + + if (iostat == nf90_noerr) then + iostat = nf90_get_att(ncid, io_field%id, 'long_name',& + io_field%long_name(1:nsize)) + call check_status(iostat) + endif + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading long_name from netCDF file') + endif + + call broadcast_scalar(io_field%long_name, master_task) + + case('units') + + io_field%units = char_blank + + if (my_task == master_task) then + iostat = nf90_inquire_attribute(ncid, io_field%id, & + 'units', len=nsize) + + if (iostat == nf90_noerr) then + iostat = nf90_get_att(ncid, io_field%id, 'units', & + io_field%units(1:nsize)) + call check_status(iostat) + endif + endif + + call broadcast_scalar(io_field%units, master_task) + + case('coordinates') + + io_field%coordinates = char_blank + + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, 'coordinates', & + io_field%coordinates) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading coordinates from netCDF file') + endif + + call broadcast_scalar(io_field%coordinates, master_task) + + case('grid_loc') + + io_field%grid_loc = ' ' + + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, 'grid_loc', & + io_field%grid_loc) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading grid_loc from netCDF file') + endif + + call broadcast_scalar(io_field%grid_loc, master_task) + + + case('missing_value') + + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + 'missing_value', & + io_field%missing_value) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading missing_value from netCDF file') + endif + + call broadcast_scalar(io_field%missing_value, master_task) + + case('missing_value_i') + + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + 'missing_value_i', & + io_field%missing_value_i) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading missing_value_i from netCDF file') + endif + + call broadcast_scalar(io_field%missing_value_i, master_task) + + + case('valid_range') + + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + 'valid_range', & + io_field%valid_range) + call check_status(iostat) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading valid_range from netCDF file') + endif + + call broadcast_array(io_field%valid_range, master_task) + + + case default + + !*** + !*** if does not match any of the standard file attributes + !*** add the attribute to the datafile + !*** + + if (my_task == master_task) then + iostat = nf90_Inquire_Attribute(ncid, io_field%id, & + trim(att_name), & + xtype = itype, & + len = nsize) + endif + + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(itype, master_task) + + select case (itype) + + case (NF90_CHAR) + work_line = char_blank + call broadcast_scalar(nsize, master_task) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + trim(att_name), & + work_line(1:nsize)) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(work_line, master_task) + call add_attrib_io_field(io_field, trim(att_name), & + trim(work_line)) + + case (NF90_INT) !*** both integer and logical attributes + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + trim(att_name), att_ival) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_ival, master_task) + if (att_name(1:4) == 'LOG_') then !*** attribute logical + work_line = att_name + work_line(1:4) = ' ' + att_name = adjustl(work_line) + + if (att_ival == 1) then + att_lval = .true. + else + att_lval = .false. + endif + call add_attrib_file(data_file, trim(att_name), & + att_lval) + + else + call add_attrib_file(data_file, trim(att_name), & + att_ival) + endif + + case (NF90_FLOAT) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + trim(att_name), att_rval) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_rval, master_task) + call add_attrib_io_field(io_field, trim(att_name), & + att_rval) + + case (NF90_DOUBLE) + if (my_task == master_task) then + iostat = nf90_get_att(ncid, io_field%id, & + trim(att_name), att_dval) + endif + call broadcast_scalar(iostat, master_task) + if (iostat /= nf90_noerr) then + call exit_POP(sigAbort, & + 'Error reading netCDF file attribute') + endif + + call broadcast_scalar(att_dval, master_task) + call add_attrib_io_field(io_field, trim(att_name), & + att_dval) + + end select + + end select + + end do ! num_atts + +!----------------------------------------------------------------------- +! +! for output files, need to define everything +! make sure file is in define mode +! +!----------------------------------------------------------------------- + + else ! output file + + if (.not. data_file%ldefine) & + call exit_POP(sigAbort, & + 'attempt to define field but not in define mode') + +!----------------------------------------------------------------------- +! +! define the dimensions +! +!----------------------------------------------------------------------- + + ndims = io_field%nfield_dims + + if (my_task == master_task) then + do n = 1,ndims + dimid = 0 + + !*** check to see whether already defined + + iostat = NF90_INQ_DIMID(ncid=ncid, & + name=trim(io_field%field_dim(n)%name),& + dimid=dimid) + + if (iostat /= NF90_NOERR) then ! dimension not yet defined + iostat = NF90_DEF_DIM (ncid=ncid, & + name=trim(io_field%field_dim(n)%name), & + len=io_field%field_dim(n)%length, & + dimid=io_field%field_dim(n)%id) + else + io_field%field_dim(n)%id = dimid + end if + end do + +!----------------------------------------------------------------------- +! +! now define the field +! +!----------------------------------------------------------------------- + + !*** check to see whether field of this name already defined. + + iostat = NF90_INQ_VARID(ncid, trim(io_field%short_name), varid) + + if (iostat /= NF90_NOERR) then ! variable was not yet defined + + if (associated (io_field%field_r_1d).or. & + associated (io_field%field_r_2d).or. & + associated (io_field%field_r_3d)) then + iostat = NF90_DEF_VAR (ncid=ncid, & + name=trim(io_field%short_name), & + xtype=NF90_FLOAT, & + dimids=(/ (io_field%field_dim(n)%id, n=1,ndims) /),& + varid=io_field%id) + + else if ( io_field%nfield_dims == c0) then + ! do not supply optional dimids for scalars + iostat = NF90_DEF_VAR (ncid=ncid, & + name=trim(io_field%short_name), & + xtype=NF90_DOUBLE, & + varid=io_field%id) + else if (associated (io_field%field_d_1d).or. & + associated (io_field%field_d_2d).or. & + associated (io_field%field_d_3d)) then + iostat = NF90_DEF_VAR (ncid=ncid, & + name=trim(io_field%short_name), & + xtype=NF90_DOUBLE, & + dimids=(/ (io_field%field_dim(n)%id, n=1,ndims) /),& + varid=io_field%id) + else if (associated (io_field%field_i_1d).or. & + associated (io_field%field_i_2d).or. & + associated (io_field%field_i_3d)) then + iostat = NF90_DEF_VAR (ncid=ncid, & + name=trim(io_field%short_name), & + xtype=NF90_INT, & + dimids=(/ (io_field%field_dim(n)%id, n=1,ndims) /),& + varid=io_field%id) + else + define_error = .true. + end if + call check_status(iostat) + if (iostat /= nf90_noerr) define_error = .true. + varid = io_field%id + else ! Variable was previously defined, OK to use it + io_field%id = varid + end if + end if ! master task + + call broadcast_scalar(define_error, master_task) + if (define_error) then + write(stdout,*) '(define_field_netcdf) ', trim(io_field%short_name) + call exit_POP(sigAbort, 'Error defining netCDF field') + endif + +!----------------------------------------------------------------------- +! +! Now define the field attributes +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + + !*** long_name + + if (io_field%long_name /= char_blank) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='long_name') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='long_name', & + values=trim(io_field%long_name)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** units + + if (io_field%units /= char_blank) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='units') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='units', & + values=trim(io_field%units)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** coordinates + + if (io_field%coordinates /= char_blank) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='coordinates') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='coordinates', & + values=trim(io_field%coordinates)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** grid_loc + + if (io_field%grid_loc /= ' ') then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='grid_loc') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='grid_loc', & + values=io_field%grid_loc) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + + !*** missing_value + + if (io_field%missing_value /= undefined) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='missing_value') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='missing_value', & + values=io_field%missing_value) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** missing_value_i + + if (io_field%missing_value_i == undefined_nf_int) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='missing_value') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='missing_value', & + values=io_field%missing_value_i) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + + + !*** valid_range(1:2) + + if (any(io_field%valid_range /= undefined)) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=varid, & + name='valid_range') + if (iostat /= NF90_NOERR) then ! attrib probably not yet defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name='valid_range', & + values=io_field%valid_range(:)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** additional attributes if defined + + ncvals = 0 + nlvals = 0 + nivals = 0 + nrvals = 0 + ndvals = 0 + if (associated(io_field%add_attrib_cval)) & + ncvals = size(io_field%add_attrib_cval) + if (associated(io_field%add_attrib_lval)) & + nlvals = size(io_field%add_attrib_lval) + if (associated(io_field%add_attrib_ival)) & + nivals = size(io_field%add_attrib_ival) + if (associated(io_field%add_attrib_rval)) & + nrvals = size(io_field%add_attrib_rval) + if (associated(io_field%add_attrib_dval)) & + ndvals = size(io_field%add_attrib_dval) + + do n=1,ncvals + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name=trim(io_field%add_attrib_cname(n)), & + values=trim(io_field%add_attrib_cval(n))) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end do + + do n=1,nlvals + work_line = 'LOG_'/& + &/trim(io_field%add_attrib_lname(n)) + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name=trim(work_line), & + values=io_field%add_attrib_ival(n)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end do + + do n=1,nivals + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name=trim(io_field%add_attrib_iname(n)), & + values=io_field%add_attrib_ival(n)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end do + + do n=1,nrvals + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name=trim(io_field%add_attrib_rname(n)), & + values=io_field%add_attrib_rval(n)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end do + + do n=1,ndvals + iostat = NF90_PUT_ATT(ncid=NCID, varid=varid, & + name=trim(io_field%add_attrib_dname(n)), & + values=io_field%add_attrib_dval(n)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end do + + endif ! master_task + + call broadcast_scalar(define_error, master_task) + if (define_error) call exit_POP(sigAbort, & + 'Error adding attributes to field') + + endif ! input/output file + +!----------------------------------------------------------------------- +!EOC + + end subroutine define_field_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: write_field_netcdf +! !INTERFACE: + + subroutine write_field_netcdf(data_file, io_field) + +! !DESCRIPTION: +! This routine writes a field to a netCDF data file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file to which field will be written + + type (io_field_desc), intent (inout) :: & + io_field ! field to write to file + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4), dimension(:,:), allocatable :: global_i_2d + real (r4), dimension(:,:), allocatable :: global_r_2d + real (r8), dimension(:,:), allocatable :: global_d_2d + + integer (i4), dimension(:), allocatable :: & + start,length ! dimension quantities for netCDF + + integer (i4) :: & + iostat, &! netCDF status flag + k,n ! loop counters + + logical (log_kind) :: & + write_error ! error flag + +!----------------------------------------------------------------------- +! +! exit define mode if necessary +! +!----------------------------------------------------------------------- + + write_error = .false. + + if (my_task == master_task) then + if (data_file%ldefine) then + iostat = nf90_enddef(data_file%id(1)) + data_file%ldefine = .false. + call check_status(iostat) + if (iostat /= nf90_noerr) write_error = .true. + endif + endif + + call broadcast_scalar(write_error, master_task) + if (write_error) then + write(stdout,*) '(write_field_netcdf) filename = ', & + trim(data_file%full_name) + call exit_POP(sigAbort, & + 'Error exiting define mode in netCDF write') + endif + +!----------------------------------------------------------------------- +! +! make sure field has been defined +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + if (io_field%id == 0) write_error = .true. + endif + + call broadcast_scalar(write_error, master_task) + if (write_error) & + call exit_POP(sigAbort, & + 'Attempt to write undefined field in netCDF write') + +!----------------------------------------------------------------------- +! +! allocate dimension start,stop quantities +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + + if (associated(io_field%field_r_3d) .or. & + associated(io_field%field_d_3d) .or. & + associated(io_field%field_i_3d) ) then + allocate(start(3), length(3) ) + endif + +!----------------------------------------------------------------------- +! +! allocate global arrays - these are for 2-d slices of data which +! are gathered to the master task +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_r_3d) .or. & + associated(io_field%field_r_2d)) then + allocate(global_r_2d(nx_global,ny_global)) + else if (associated(io_field%field_d_3d) .or. & + associated(io_field%field_d_2d)) then + allocate(global_d_2d(nx_global,ny_global)) + else if (associated(io_field%field_i_3d) .or. & + associated(io_field%field_i_2d)) then + allocate(global_i_2d(nx_global,ny_global)) + endif + + endif ! master task + +!----------------------------------------------------------------------- +! +! write data based on type +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! real 3d array +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_r_3d)) then + + do k = 1,size(io_field%field_r_3d,dim=3) + call gather_global(global_r_2d, io_field%field_r_3d(:,:,k,:), & + master_task, distrb_clinic) + if (my_task == master_task) then + + !*** tell netCDF to only write slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,3 + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_r_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + end do ! slice loop + +!----------------------------------------------------------------------- +! +! real 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_r_2d)) then + + call gather_global(global_r_2d, io_field%field_r_2d, & + master_task, distrb_clinic) + if (my_task == master_task) then + + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_r_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + +!----------------------------------------------------------------------- +! +! real 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_r_1d)) then + + if (my_task == master_task) then + ! 1d vectors are not distributed to blocks; no need for gather_global + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_r_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + +!----------------------------------------------------------------------- +! +! real 0d array +! +!----------------------------------------------------------------------- +! deferred + +!----------------------------------------------------------------------- +! +! double 3d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_3d)) then + + do k = 1,size(io_field%field_d_3d,dim=3) + call gather_global(global_d_2d, io_field%field_d_3d(:,:,k,:), & + master_task, distrb_clinic) + if (my_task == master_task) then + + !*** tell netCDF to only write slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,io_field%nfield_dims + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_d_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + end do ! slice loop + +!----------------------------------------------------------------------- +! +! double 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_2d)) then + + call gather_global(global_d_2d, io_field%field_d_2d, & + master_task, distrb_clinic) + if (my_task == master_task) then + + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_d_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + +!----------------------------------------------------------------------- +! +! double 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_1d)) then + + if (my_task == master_task) then + ! 1d vectors are not distributed to blocks; no need for gather_global + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_d_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + +!----------------------------------------------------------------------- +! +! double 0d array +! +!----------------------------------------------------------------------- + + else if ( io_field%nfield_dims == c0) then + + if (my_task == master_task) then + ! scalars are not distributed to blocks; no need for gather_global + ! for now, all scalars are r8 and are not pointers or targets + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_d_0d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + + +!----------------------------------------------------------------------- +! +! integer 3d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_3d)) then + + do k = 1,size(io_field%field_i_3d,dim=3) + call gather_global(global_i_2d, io_field%field_i_3d(:,:,k,:), & + master_task, distrb_clinic) + if (my_task == master_task) then + + !*** tell netCDF to only write slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,io_field%nfield_dims + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_i_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + end do ! slice loop + +!----------------------------------------------------------------------- +! +! integer 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_2d)) then + + call gather_global(global_i_2d, io_field%field_i_2d, & + master_task, distrb_clinic) + if (my_task == master_task) then + + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_i_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + + +!----------------------------------------------------------------------- +! +! integer 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_1d)) then + + if (my_task == master_task) then + ! 1d vectors are not distributed to blocks; no need for gather_global + iostat = NF90_PUT_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_i_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + endif ! master task + +!----------------------------------------------------------------------- +! +! check for write errors +! +!----------------------------------------------------------------------- + + else + call exit_POP(sigAbort, & + 'No field associated for writing to netCDF') + end if + + call broadcast_scalar(write_error, master_task) + if (write_error) call exit_POP(sigAbort, & + 'Error writing field to netCDF file') + +!----------------------------------------------------------------------- +! +! deallocate quantities +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + if (allocated(start)) deallocate(start) + if (allocated(length)) deallocate(length) + if (allocated(global_r_2d)) deallocate(global_r_2d) + if (allocated(global_d_2d)) deallocate(global_d_2d) + if (allocated(global_i_2d)) deallocate(global_i_2d) + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_field_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: read_field_netcdf +! !INTERFACE: + + subroutine read_field_netcdf(data_file, io_field) + +! !DESCRIPTION: +! This routine reads a field from a netcdf input file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file from which to read field + + type (io_field_desc), intent (inout) :: & + io_field ! field to be read + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4), dimension(:,:), allocatable :: global_i_2d + real (r4), dimension(:,:), allocatable :: global_r_2d + real (r8), dimension(:,:), allocatable :: global_d_2d + + integer (i4), dimension(:), allocatable :: & + start,length ! dimension quantities for netCDF + + integer (i4) :: & + iostat, &! netCDF status flag + k,n ! loop counters + + logical (log_kind) :: & + read_error ! error flag + +!----------------------------------------------------------------------- +! +! make sure field has been defined +! +!----------------------------------------------------------------------- + + + read_error = .false. + if (my_task == master_task) then + if (io_field%id == 0) read_error = .true. + endif + + call broadcast_scalar(read_error, master_task) + if (read_error) & + call exit_POP(sigAbort, & + 'Attempt to read undefined field in netCDF read') + +!----------------------------------------------------------------------- +! +! if no boundary update type defined, assume center location scalar +! +!----------------------------------------------------------------------- + + if (io_field%field_loc == field_loc_unknown) then + io_field%field_loc = field_loc_center + io_field%field_type = field_type_scalar + endif + +!----------------------------------------------------------------------- +! +! allocate dimension start,stop quantities +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + if (associated(io_field%field_r_3d) .or. & + associated(io_field%field_d_3d) .or. & + associated(io_field%field_i_3d) ) then + allocate(start(3), length(3) ) + endif +!----------------------------------------------------------------------- +! +! allocate global arrays - these are for 2-d slices of data which +! are gathered to the master task +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_r_3d) .or. & + associated(io_field%field_r_2d)) then + allocate(global_r_2d(nx_global,ny_global)) + else if (associated(io_field%field_d_3d) .or. & + associated(io_field%field_d_2d)) then + allocate(global_d_2d(nx_global,ny_global)) + else if (associated(io_field%field_i_3d) .or. & + associated(io_field%field_i_2d)) then + allocate(global_i_2d(nx_global,ny_global)) + endif + + endif ! master task + +!----------------------------------------------------------------------- +! +! read data based on type +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! real 3d array +! +!----------------------------------------------------------------------- + + if (associated(io_field%field_r_3d)) then + + do k = 1,size(io_field%field_r_3d,dim=3) + if (my_task == master_task) then + + !*** tell netCDF to only read slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,io_field%nfield_dims + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_r_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) & + call scatter_global(io_field%field_r_3d(:,:,k,:), & + global_r_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + + end do ! slice loop + +!----------------------------------------------------------------------- +! +! real 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_r_2d)) then + + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_r_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) then + call scatter_global(io_field%field_r_2d, & + global_r_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + endif + +!----------------------------------------------------------------------- +! +! real 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_r_1d)) then + + ! 1d vectors are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_r_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + +!----------------------------------------------------------------------- +! +! real 0d array (scalar) +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_r_1d)) then + + ! scalars are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_r_0d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + + +!----------------------------------------------------------------------- +! +! double 3d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_3d)) then + + do k = 1,size(io_field%field_d_3d,dim=3) + if (my_task == master_task) then + + !*** tell netCDF to only read slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,io_field%nfield_dims + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_d_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) & + call scatter_global(io_field%field_d_3d(:,:,k,:), & + global_d_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + + end do ! slice loop + +!----------------------------------------------------------------------- +! +! double 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_2d)) then + + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_d_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) then + call scatter_global(io_field%field_d_2d, & + global_d_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + endif + +!----------------------------------------------------------------------- +! +! double 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_1d)) then + + ! 1d vectors are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_d_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + +!----------------------------------------------------------------------- +! +! double 0d array (scalar) +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_d_1d)) then + + ! scalars are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_d_0d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + +!----------------------------------------------------------------------- +! +! integer 3d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_3d)) then + + do k = 1,size(io_field%field_i_3d,dim=3) + if (my_task == master_task) then + + !*** tell netCDF to only read slice n + io_field%field_dim(3)%start = k + io_field%field_dim(3)%stop = k + + do n=1,io_field%nfield_dims + start (n) = io_field%field_dim(n)%start + length(n) = io_field%field_dim(n)%stop - start(n) + 1 + end do + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_i_2d, & + start=start(:), count=length(:)) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) & + call scatter_global(io_field%field_i_3d(:,:,k,:), & + global_i_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + + end do ! slice loop + +!----------------------------------------------------------------------- +! +! integer 2d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_2d)) then + + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=global_i_2d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + if (.not. read_error) then + call scatter_global(io_field%field_i_2d, & + global_i_2d, master_task, distrb_clinic, & + io_field%field_loc, io_field%field_type) + endif + +!----------------------------------------------------------------------- +! +! integer 1d array +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_1d)) then + + ! 1d vectors are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_i_1d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + +!----------------------------------------------------------------------- +! +! integer 0d array (scalar) +! +!----------------------------------------------------------------------- + + else if (associated(io_field%field_i_1d)) then + + ! scalars are not distributed to blocks; therefore, no scatter_global needed + if (my_task == master_task) then + + iostat = NF90_GET_VAR (ncid=data_file%id(1), & + varid=io_field%id, & + values=io_field%field_i_0d) + if (iostat /= nf90_noerr) then + call check_status(iostat) + read_error = .true. + endif + endif ! master task + + call broadcast_scalar(read_error, master_task) + +!----------------------------------------------------------------------- +! +! check for read errors +! +!----------------------------------------------------------------------- + + else + call exit_POP(sigAbort, & + 'No field associated for reading from netCDF') + end if + + call broadcast_scalar(read_error, master_task) + if (read_error) & + call exit_POP(sigAbort,'Error reading field from netCDF file') + +!----------------------------------------------------------------------- +! +! deallocate quantities +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + if (allocated(start)) deallocate(start) + if (allocated(length)) deallocate(length) + if (allocated(global_r_2d)) deallocate(global_r_2d) + if (allocated(global_d_2d)) deallocate(global_d_2d) + if (allocated(global_i_2d)) deallocate(global_i_2d) + endif + + +!----------------------------------------------------------------------- +!EOC + + end subroutine read_field_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: check_status +! !INTERFACE: + + subroutine check_status(status) + +! !DESCRIPTION: +! This exception handler subroutine can be used to check error status +! after a netcdf call. It prints out a text message assigned to +! an error code but does not exit because this routine is typically +! only called from a single process. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (i4), intent (in) :: & + status ! status returned by netCDF call + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! call netCDF routine to return error message +! +!----------------------------------------------------------------------- + + if (status /= nf90_noerr) then + write(stdout,*) trim(nf90_strerror(status)) + call shr_sys_flush(stdout) + end if + +!----------------------------------------------------------------------- +!EOC + + end subroutine check_status + +!*********************************************************************** +!BOP +! !IROUTINE: define_nstd_netcdf +! !INTERFACE: + + subroutine define_nstd_netcdf(data_file,ndims,io_dims,field_id, & + short_name,long_name,units,coordinates, & + fill_value,missing_value,nftype) + +! !DESCRIPTION: +! This routine defines the nonstandard CCSM time-averaged diagnostic fields +! on nonstandard grids: MOC, N_HEAT, and N_SALT +! This routine is totally CCSM-specific +! +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file ! data file in which field contained + + real (r4), intent (in) :: & + fill_value, & + missing_value + + integer (int_kind), intent(in) :: & + ndims ! number of dimensions for nonstandard field + + character (*), intent (in) :: & + short_name, & + long_name, & + units, & + coordinates, & + nftype + +! !INPUT/OUTPUT PARAMETERS: + + type (io_dim), dimension(:), intent (inout) :: & + io_dims + + integer (i4), intent (inout) :: & + field_id ! variable id + + optional :: coordinates,fill_value,missing_value,nftype + +!EOP +!BOP +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + iostat, &! status flag for netCDF calls + ncid, &! file id for netcdf file + n, &! loop index + xtype + + logical (log_kind) :: & + define_error ! error flag + + define_error = .false. + ncid = data_file%id(1) + +!----------------------------------------------------------------------- +! +! make sure file has been opened and is in define mode +! +!----------------------------------------------------------------------- + + call check_file_open (data_file, 'define_nstd_netcdf') + call check_definemode (data_file, 'define_nstd_netcdf') + + +!----------------------------------------------------------------------- +! +! define the dimensions +! +!----------------------------------------------------------------------- + + call define_dimensions(data_file,ndims,io_dims) + +!----------------------------------------------------------------------- +! +! define the field +! +!----------------------------------------------------------------------- + + if (present(nftype)) then + select case (trim(nftype)) + case ('float','FLOAT') + xtype = NF90_FLOAT + case ('double','DOUBLE') + xtype = NF90_DOUBLE + case ('integer','INTEGER') + xtype = NF90_INT + case ('char','CHAR','character', 'CHARACTER') + xtype = NF90_CHAR + case default + call exit_POP(sigAbort,'unknown nftype') + end select + else + xtype = NF90_FLOAT + endif + + call define_var (data_file,trim(short_name),ndims,io_dims, & + xtype,field_id) + +!----------------------------------------------------------------------- +! +! Now define the field attributes +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + + !*** long_name + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=field_id, & + name='long_name') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=field_id, & + name='long_name', & + values=trim(long_name)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + + !*** units + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=field_id, & + name='units') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=field_id, & + name='units', & + values=trim(units)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + + !*** coordinates + if (present(coordinates)) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=field_id, & + name='coordinates') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=field_id, & + name='coordinates', & + values=trim(coordinates)) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + !*** missing_value + if (present(missing_value)) then + iostat = NF90_INQUIRE_ATTRIBUTE(ncid=NCID, varid=field_id, & + name='missing_value') + if (iostat /= NF90_NOERR) then ! attrib probably not defined + iostat = NF90_PUT_ATT(ncid=NCID, varid=field_id, & + name='missing_value', & + values=missing_value) + call check_status(iostat) + if (iostat /= NF90_NOERR) define_error = .true. + end if + endif + + endif ! master_task + + call broadcast_scalar(define_error, master_task) + if (define_error) call exit_POP(sigAbort, & + '(define_nstd_netcdf) Error adding attributes to field') + + +!----------------------------------------------------------------------- +!EOC + + end subroutine define_nstd_netcdf + +!*********************************************************************** +!BOP +! !IROUTINE: write_nstd_netcdf +! !INTERFACE: + + subroutine write_nstd_netcdf(data_file,field_id,num_writes, & + ndims, io_dims, & + nftype, & + implied_time_dim, & + indata_1d_r8, & + indata_2d_r8, & + indata_2d_r4, & + indata_3d_r4 , & + indata_4d_r4, & + indata_1d_ch, & + indata_2d_ch ) + +! !DESCRIPTION: +! This is a specialized, CCSM-speicific routine to write any desired +! output field that cannot presently be defined through construct_io_field +! to the CCSM version of the netCDF time-averaged history output files +! +! !REVISION HISTORY: +! same as module + + +! !INPUT PARAMETERS: + + character (*), intent (in) :: & + nftype + + integer (i4), intent (in) :: & + field_id ! netCDF id for the nonstandard variables + + integer (int_kind), intent (in) :: & + num_writes, & + ndims + + type (io_dim), dimension(:), intent (in) :: & + io_dims + + real (r8), dimension(:,:),intent (in) :: & + indata_2d_r8 + real (r8), dimension(:), intent (in) :: & + indata_1d_r8 + + real (r4), dimension(:,:,:,:), intent (in) :: & + indata_4d_r4 + real (r4), dimension(:,:,:), intent (in) :: & + indata_3d_r4 + real (r4), dimension(:,:), intent (in) :: & + indata_2d_r4 + + character (*), dimension(:,:), intent (in) :: & + indata_2d_ch + character (*), dimension(:), intent (in) :: & + indata_1d_ch + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (inout) :: & + data_file ! file to which field will be written + + logical (log_kind), intent(inout) :: & + implied_time_dim + + optional :: & + implied_time_dim, & + indata_1d_r8, & + indata_2d_r8, & + indata_2d_r4, & + indata_3d_r4, & + indata_4d_r4, & + indata_1d_ch, & + indata_2d_ch + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer , dimension(2) :: & + start,count ! dimension quantities for netCDF + + integer :: & + iostat, &! netCDF status flag + n ! index + + integer :: ncid, nout(5) + + logical (log_kind) :: & + write_error, &! error flag + supported + + real (r4), allocatable, dimension (:,:,:,:,:) :: & + outdata_5d_r4 + + real (r4), allocatable, dimension (:,:,:,:) :: & + outdata_4d_r4 + + real (r4), allocatable, dimension (:,:,:) :: & + outdata_3d_r4 + + real (r4), allocatable, dimension (:,:) :: & + outdata_2d_r4 + + real (r8), allocatable, dimension (:) :: & + outdata_1d_r8 + real (r8), allocatable, dimension (:,:) :: & + outdata_2d_r8 + + character(char_len), allocatable, dimension (:,:) :: & + outdata_2d_ch + +!----------------------------------------------------------------------- +! +! exit define mode if necessary +! +!----------------------------------------------------------------------- + + + write_error = .false. + + if (my_task == master_task) then + if (data_file%ldefine) then + iostat = nf90_enddef(data_file%id(1)) + data_file%ldefine = .false. + call check_status(iostat) + if (iostat /= nf90_noerr) write_error = .true. + endif + endif + + call broadcast_scalar(write_error, master_task) + if (write_error) then + write(stdout,*) '(write_nstd_netcdf) filename = ', & + trim(data_file%full_name) + call exit_POP(sigAbort, & + '(write_nstd_netcdf) Error exiting define mode in netCDF write') + endif + +!----------------------------------------------------------------------- +! +! make sure field has been defined +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + if (field_id == 0) write_error = .true. + endif + + call broadcast_scalar(write_error, master_task) + if (write_error) & + call exit_POP(sigAbort, & + '(write_nstd_netcdf) Attempt to write undefined field in netCDF write') + +!----------------------------------------------------------------------- +! +! determine if the variable has the unlimited time dimension +! as an implicit dimension; if so, it must be made explicit +! in the outdata array +! +!----------------------------------------------------------------------- + + if (.not. present(implied_time_dim)) then + implied_time_dim = .false. + endif + + +!----------------------------------------------------------------------- +! NOTE: this version does not yet support multiple writes to the same +! netCDF file, but neither does basic pop2... +!----------------------------------------------------------------------- + + supported = .true. + + if (my_task == master_task) then + + ncid = data_file%id(1) + + select case (trim(nftype)) + + case('double','DOUBLE') + select case (implied_time_dim) + case (.true.) + select case (ndims) + case(2) + nout(1) = size(indata_1d_r8,DIM=1) + allocate (outdata_2d_r8(nout(1),1)) + outdata_2d_r8(:,1) = indata_1d_r8(:) + iostat = NF90_PUT_VAR (ncid, field_id, outdata_2d_r8 ) + deallocate (outdata_2d_r8) + case default + supported = .false. + end select ! ndims + case (.false.) + select case (ndims) + case(1) + iostat = NF90_PUT_VAR (ncid, field_id, indata_1d_r8 ) + case(2) + iostat = NF90_PUT_VAR (ncid, field_id, indata_2d_r8 ) + case default + supported = .false. + end select ! ndims + end select ! implied_time_dim + + case('float','FLOAT') + select case (implied_time_dim) + case (.true.) + select case (ndims) + case(1) + supported = .false. + case(2) + supported = .false. + case(3) + nout(1) = size(indata_3d_r4,DIM=1) + nout(2) = size(indata_3d_r4,DIM=2) + allocate (outdata_3d_r4(nout(1),nout(2),1)) + outdata_3d_r4(:,:,1) = indata_2d_r4(:,:) + iostat = NF90_PUT_VAR (ncid, field_id, outdata_3d_r4 ) + deallocate (outdata_3d_r4) + case(4) + nout(1) = size(indata_3d_r4,DIM=1) + nout(2) = size(indata_3d_r4,DIM=2) + nout(3) = size(indata_3d_r4,DIM=3) + allocate (outdata_4d_r4(nout(1),nout(2),nout(3),1)) + outdata_4d_r4(:,:,:,1) = indata_3d_r4(:,:,:) + iostat = NF90_PUT_VAR (ncid, field_id, outdata_4d_r4 ) + deallocate (outdata_4d_r4) + case(5) + nout(1) = size(indata_4d_r4,DIM=1) + nout(2) = size(indata_4d_r4,DIM=2) + nout(3) = size(indata_4d_r4,DIM=3) + nout(4) = size(indata_4d_r4,DIM=4) + allocate (outdata_5d_r4(nout(1),nout(2),nout(3),nout(4),1)) + outdata_5d_r4(:,:,:,:,1) = indata_4d_r4(:,:,:,:) + iostat = NF90_PUT_VAR (ncid, field_id, outdata_5d_r4 ) + deallocate (outdata_5d_r4) + case default + supported = .false. + end select ! ndims + case (.false.) + select case (ndims) + case(1) + supported = .false. + case(2) + iostat = NF90_PUT_VAR (ncid, field_id, indata_2d_r4 ) + case(3) + iostat = NF90_PUT_VAR (ncid, field_id, indata_3d_r4 ) + case(4) + iostat = NF90_PUT_VAR (ncid, field_id, indata_4d_r4 ) + case default + supported = .false. + end select ! ndims + end select ! implied_time_dim + + case('char','character','CHAR','CHARACTER') + select case (implied_time_dim) + case (.true.) + select case (ndims) + case default + supported = .false. + end select ! ndims + case (.false.) + select case (ndims) + case(2) + do n=1,io_dims(2)%length + start(1) = 1 + start(2) = n + count(1)=len_trim(indata_1d_ch(n)) + count(2)=1 + iostat = NF90_PUT_VAR (ncid, field_id, & + trim(indata_1d_ch(n)), & + start=start,count=count) + enddo + case default + supported = .false. + end select ! ndims + end select ! implied_time_dim + case default + end select ! nftype + + + if (iostat /= nf90_noerr) then + call check_status(iostat) + write_error = .true. + endif + + endif ! master task + +!----------------------------------------------------------------------- +! +! check for errors +! +!----------------------------------------------------------------------- + + call broadcast_scalar(write_error, master_task) + if (write_error) call exit_POP(sigAbort, & + '(write_nstd_netcdf) Error writing field to netCDF file') + + call broadcast_scalar(supported, master_task) + if (.not. supported) call exit_POP(sigAbort, & + '(write_nstd_netcdf) option not supported') + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_nstd_netcdf + + +!*********************************************************************** +!BOP +! !IROUTINE: define_dimensions +! !INTERFACE: + + subroutine define_dimensions(data_file,ndims,io_dims) + +! !DESCRIPTION: +! This routine defines dimensions, if they are not already defined +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file + + integer (int_kind), intent (in) :: & + ndims + +! !INPUT/OUTPUT PARAMETERS: + + type (io_dim), dimension(ndims), intent(inout) :: & + io_dims + + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer :: & + iostat, & ! netCDF status flag + dimid, & + ncid, & + n + + ncid = data_file%id(1) + +!----------------------------------------------------------------------- +! +! define the dimensions +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + do n = 1,ndims + dimid = 0 + + !*** check to see whether dimension is already defined + iostat = NF90_INQ_DIMID(ncid=ncid, name=trim(io_dims(n)%name),& + dimid=dimid) + if (iostat /= NF90_NOERR) then ! dimension not yet defined + iostat = NF90_DEF_DIM (ncid=ncid, name=trim(io_dims(n)%name), & + len=io_dims(n)%length, dimid=io_dims(n)%id) + else + io_dims(n)%id = dimid + end if + end do + endif ! master_task + + +!----------------------------------------------------------------------- +!EOC + + end subroutine define_dimensions + + +!*********************************************************************** +!BOP +! !IROUTINE: define_var +! !INTERFACE: + + subroutine define_var (data_file,short_name,ndims,io_dims, & + xtype,field_id) + +! !DESCRIPTION: +! This routine defines a netCDF variable +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file + + character(*), intent (in) :: & + short_name + + integer (int_kind), intent (in) :: & + ndims, & + xtype + +! !INPUT/OUTPUT PARAMETERS: + + type (io_dim), dimension(ndims) :: & + io_dims + +! !OUTPUT PARAMETERS: + + integer (i4), intent(out) :: & + field_id + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer :: & + iostat ! netCDF status flag + + integer :: & + ncid, & + dimid, & + n + + logical (log_kind) :: & + define_error ! error flag +!----------------------------------------------------------------------- +! +! define the field +! +!----------------------------------------------------------------------- + + define_error = .false. + ncid = data_file%id(1) + + if (my_task == master_task) then + !*** check to see whether field of this name already defined. + + iostat = NF90_INQ_VARID(ncid, trim(short_name), field_id) + + if (iostat /= NF90_NOERR) then ! variable was not yet defined + + iostat = NF90_DEF_VAR (ncid=ncid,name=trim(short_name), & + xtype=xtype, & + dimids=(/ (io_dims(n)%id, n=1,ndims) /),& + varid=field_id) + call check_status(iostat) + if (iostat /= nf90_noerr) define_error = .true. + end if + end if ! master task + + call broadcast_scalar(define_error, master_task) + + if (define_error) then + write(stdout,*) '(define_var) Error for field = ', trim(short_name) + call exit_POP(sigAbort, 'Error defining nonstandard CCSM netCDF field') + endif + + + end subroutine define_var + +!*********************************************************************** +!BOP +! !IROUTINE: check_file_open +! !INTERFACE: + + subroutine check_file_open(data_file, name) + +! !DESCRIPTION: +! This utility routine checks if the data file has been opened +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file + + character(*),intent (in) :: name + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer :: & + iostat ! netCDF status flag + + logical (log_kind) :: & + define_error ! error flag + + character (char_len) :: string + + +!----------------------------------------------------------------------- +! +! make sure file has been opened +! +!----------------------------------------------------------------------- + + define_error = .false. + + if (data_file%id(1) <= 0) then + define_error = .true. + endif + + call broadcast_scalar(define_error, master_task) + if (define_error) & + call exit_POP(sigAbort, & + '('//trim(name)//') attempt to define field without opening file first') + + +!----------------------------------------------------------------------- +!EOC + + end subroutine check_file_open + + +!*********************************************************************** +!BOP +! !IROUTINE: check_definemode +! !INTERFACE: + + subroutine check_definemode (data_file, name) + +! !DESCRIPTION: +! This utility routine checks if the data file is in define mode +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent (in) :: & + data_file + + character(*),intent (in):: name + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer :: & + iostat ! netCDF status flag + + logical (log_kind) :: & + write_error ! error flag + + character (char_len) :: string + + +!----------------------------------------------------------------------- +! +! make sure file is in define mode +! +!----------------------------------------------------------------------- + + + if (.not. data_file%ldefine) & + call exit_POP(sigAbort, & + '('//trim(name)//') attempt to define field but not in define mode') + +!----------------------------------------------------------------------- +!EOC + + end subroutine check_definemode + + +!*********************************************************************** + end module io_netcdf + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/io_tools.F90 b/components/cism/source_glc/POP_files/io_tools.F90 new file mode 100644 index 0000000000..caa192d325 --- /dev/null +++ b/components/cism/source_glc/POP_files/io_tools.F90 @@ -0,0 +1,230 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io_tools + +!BOP +! +! !MODULE: io_tools +! +! !DESCRIPTION: +! This module contains routines intended to facilitate io +! Presently, only routines used to document output are included +! +! !REVISION HISTORY: +! SVN:$Id: io_tools.F90 923 2006-05-10 22:25:10Z njn01 $ +! +! !USES + use kinds_mod + use grid + use io + use shr_sys_mod + + implicit none + save +!EOP +!BOC + +!----------------------------------------------------------------------- +! interfaces +!----------------------------------------------------------------------- + + interface document + module procedure document_char, & + document_int, & + document_log, & + document_dbl, & + document_real + end interface + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: document +! !INTERFACE: + + subroutine document_char (sub_name,message,char_val) + +! !DESCRIPTION: +! This routine writes out the calling subroutine name and two +! associated messages +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic document +! routine corresponding to a character string + +! !INPUT PARAMETERS: + character (*) :: sub_name, message + character (*), optional :: char_val + +!EOP +!BOC + + character(*),parameter :: fmt1 = "( 5x, '(',a,') ',a)" + character(*),parameter :: fmt2 = "( 5x, '(',a,') ',a,' = ',a)" + + if (my_task == master_task) then + if (present(char_val)) then + write(stdout,fmt2) sub_name, message, trim(char_val) + else + write(stdout,fmt1) sub_name, trim(message) + endif + call shr_sys_flush (stdout) + endif + +!EOC + + end subroutine document_char + +!*********************************************************************** +!BOP +! !IROUTINE: document +! !INTERFACE: + subroutine document_int (sub_name,message,ival) + +! !DESCRIPTION: +! This routine writes out the calling subroutine name and an +! associated message +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic document +! routine corresponding to an integer + +! !INPUT PARAMETERS: + character (*) :: sub_name, message + integer (int_kind) :: ival + +!EOP +!BOC + + character(*),parameter :: fmt = "( 5x, '(',a,') ',a,' = ',i10)" + + if (my_task == master_task) then + write(stdout,fmt) sub_name, message, ival + call shr_sys_flush (stdout) + endif + +!EOC + + end subroutine document_int + +!*********************************************************************** +!BOP +! !IROUTINE: document +! !INTERFACE: + subroutine document_log (sub_name,message,lval) + + +! !DESCRIPTION: +! This routine writes out the calling subroutine name and an +! associated message +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic document +! routine corresponding to a logical variable + +! !INPUT PARAMETERS: + character (*) :: sub_name, message + logical (log_kind) :: lval + +!EOP +!BOC + + character(*),parameter :: fmt = "( 5x, '(',a,') ',a,' = ',L3)" + + if (my_task == master_task) then + write(stdout,fmt) sub_name, message, lval + call shr_sys_flush (stdout) + endif + +!EOC + + end subroutine document_log + +!*********************************************************************** +!BOP +! !IROUTINE: document +! !INTERFACE: + subroutine document_dbl (sub_name,message,dval) + +! !DESCRIPTION: +! This routine writes out the calling subroutine name and an +! associated message +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic document +! routine corresponding to a r8 variable + +! !INPUT PARAMETERS: + character (*) :: sub_name, message + real (r8) :: dval + +!EOP +!BOC + + character(*),parameter :: fmt = "( 5x, '(',a,') ',a,' = ',1pe23.16)" + + if (my_task == master_task) then + write(stdout,fmt) sub_name, message, dval + call shr_sys_flush (stdout) + endif + +!EOC + + end subroutine document_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: document +! !INTERFACE: + subroutine document_real (sub_name,message,rval) + + +! !DESCRIPTION: +! This routine writes out the calling subroutine name and an +! associated message +! +! !REVISION HISTORY: +! same as module +! +! !REMARKS: +! This is actually the specific interface for the generic document +! routine corresponding to a r8 variable + +! !INPUT PARAMETERS: + character (*) :: sub_name, message + real(r4) :: rval + +!EOP +!BOC + + character(*),parameter :: fmt = "( 5x, '(',a,') ',a,' = ',1pe23.16)" + + if (my_task == master_task) then + write(stdout,fmt) sub_name, message, rval + call shr_sys_flush (stdout) + endif + +!EOC + + end subroutine document_real + + + end module io_tools + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/io_types.F90 b/components/cism/source_glc/POP_files/io_types.F90 new file mode 100644 index 0000000000..9a8277cc90 --- /dev/null +++ b/components/cism/source_glc/POP_files/io_types.F90 @@ -0,0 +1,3436 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module io_types + +!BOP +! +! !MODULE: io_types +! +! !DESCRIPTION: +! This module contains the declarations for all required io +! data types and several operators for those data types. It also +! contains several global parameters used by various io operations +! and an io unit manager. +! +! !REVISION HISTORY: +! SVN:$Id: io_types.F90 923 2006-05-10 22:25:10Z njn01 $ + +! !USES: + + use kinds_mod + use constants + use communicate + use broadcast + use exit_mod + use shr_sys_mod + + implicit none + private + save + +! !PUBLIC TYPES: + + type, public :: io_dim + integer(i4) :: id + integer(i4) :: length ! 1 to n, but 0 means unlimited + integer(i4) :: start, stop, stride ! For slicing and dicing + logical(log_kind) :: active + character(char_len) :: name + character(char_len) :: units + end type + + ! Generic IO field descriptor + + type, public :: io_field_desc + character(char_len) :: short_name + character(char_len) :: long_name + character(char_len) :: units + character(char_len) :: coordinates + character(4) :: grid_loc + real(r4) :: missing_value + real(r4), dimension(2) :: valid_range + integer(i4) :: id + integer(i4) :: nfield_dims + integer(i4) :: field_loc + integer(i4) :: field_type + integer(int_kind) :: missing_value_i + type (io_dim), dimension(4) :: field_dim + character(char_len), dimension(:), pointer :: add_attrib_cname + character(char_len), dimension(:), pointer :: add_attrib_cval + character(char_len), dimension(:), pointer :: add_attrib_lname + logical (log_kind), dimension(:), pointer :: add_attrib_lval + character(char_len), dimension(:), pointer :: add_attrib_iname + integer (i4), dimension(:), pointer :: add_attrib_ival + character(char_len), dimension(:), pointer :: add_attrib_rname + real (r4), dimension(:), pointer :: add_attrib_rval + character(char_len), dimension(:), pointer :: add_attrib_dname + real (r8), dimension(:), pointer :: add_attrib_dval + ! Only one of these next 12 pointers can be associated. + ! The others must be nullified. For convenience in + ! initialization, these declarations are the last listed + ! in this type. + integer(i4) :: field_i_0d + integer(i4), dimension(:), pointer :: field_i_1d + integer(i4), dimension(:,:,:), pointer :: field_i_2d + integer(i4), dimension(:,:,:,:), pointer :: field_i_3d + real(r4) :: field_r_0d + real(r4), dimension(:), pointer :: field_r_1d + real(r4), dimension(:,:,:), pointer :: field_r_2d + real(r4), dimension(:,:,:,:), pointer :: field_r_3d + real(r8) :: field_d_0d + real(r8), dimension(:), pointer :: field_d_1d + real(r8), dimension(:,:,:), pointer :: field_d_2d + real(r8), dimension(:,:,:,:), pointer :: field_d_3d + end type + + ! Generic data file descriptor + + type, public :: datafile + character(char_len) :: full_name + character(char_len) :: data_format ! .bin or + ! .nc + character(char_len) :: root_name + character(char_len) :: file_suffix + integer(i4), dimension (2) :: id ! LUN (binary) or + ! NCID (netcdf) + character(char_len) :: title + character(char_len) :: history + character(char_len) :: conventions + character(char_len), dimension(:), pointer :: add_attrib_cname + character(char_len), dimension(:), pointer :: add_attrib_cval + character(char_len), dimension(:), pointer :: add_attrib_lname + logical (log_kind), dimension(:), pointer :: add_attrib_lval + character(char_len), dimension(:), pointer :: add_attrib_iname + integer (i4), dimension(:), pointer :: add_attrib_ival + character(char_len), dimension(:), pointer :: add_attrib_rname + real (r4), dimension(:), pointer :: add_attrib_rval + character(char_len), dimension(:), pointer :: add_attrib_dname + real (r8), dimension(:), pointer :: add_attrib_dval + integer(i4) :: num_iotasks + integer(i4) :: record_length + integer(i4) :: current_record ! bin + logical(log_kind) :: readonly + logical(log_kind) :: ldefine + end type + +! !PUBLIC MEMBER FUNCTIONS: + + public :: get_unit, & + release_unit, & + construct_file, & + destroy_file, & + add_attrib_file, & + extract_attrib_file, & + construct_io_field, & + destroy_io_field, & + construct_io_dim, & + add_attrib_io_field, & + extract_attrib_io_field, & + init_io + +! !PUBLIC DATA MEMBERS: + + integer (i4), parameter, public :: & + nml_in = 10, &! reserved unit for namelist input + stdin = 5, &! reserved unit for standard input + stdout = 6, &! reserved unit for standard output + stderr = 6 ! reserved unit for standard error + + integer (i4), parameter, public :: & + rec_type_int = -1, &! ids to use for inquiring the + rec_type_real = -2, &! record length to use for binary files + rec_type_dbl = -3 ! + + character (7), parameter, public :: & + nml_filename = 'pop2_in' ! namelist input file name + + integer (i4), public :: & + num_iotasks ! num of procs to use for parallel io + ! if output format is 'netcdf'. Then it is 1. + + logical (log_kind), public :: & + luse_pointer_files ! use files to point to location of restarts + + character (char_len), public :: & + pointer_filename ! filename to use for pointer files +!EOP +!BOC +!----------------------------------------------------------------------- +! +! io unit manager variables +! +!----------------------------------------------------------------------- + + integer (i4), parameter, private :: & + max_units = 99 ! maximum number of open units + + logical (log_kind), dimension(max_units), private :: & + in_use ! flag=.true. if unit currently open + +!----------------------------------------------------------------------- +! +! other module variables +! +!----------------------------------------------------------------------- + + logical (log_kind), private :: & + lredirect_stdout ! redirect stdout to log file + + character (char_len), private :: & + log_filename ! root name for log file + +!----------------------------------------------------------------------- +! +! generic interface definitions +! +!----------------------------------------------------------------------- + + interface add_attrib_file + module procedure add_attrib_file_char, & + add_attrib_file_log, & + add_attrib_file_int, & + add_attrib_file_real, & + add_attrib_file_dbl + end interface + + interface extract_attrib_file + module procedure extract_attrib_file_char, & + extract_attrib_file_log, & + extract_attrib_file_int, & + extract_attrib_file_real, & + extract_attrib_file_dbl + end interface + + interface add_attrib_io_field + module procedure add_attrib_io_field_char, & + add_attrib_io_field_log, & + add_attrib_io_field_int, & + add_attrib_io_field_real, & + add_attrib_io_field_dbl + end interface + + interface extract_attrib_io_field + module procedure extract_attrib_io_field_char, & + extract_attrib_io_field_log, & + extract_attrib_io_field_int, & + extract_attrib_io_field_real, & + extract_attrib_io_field_dbl + end interface + +!EOC +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: construct_file +! !INTERFACE: + + function construct_file ( & + data_format, & + ! Optional arguments begin here + full_name, & + root_name, & + file_suffix, & + id, & + title, & + history, & + conventions, & + record_length, & + recl_words, & + current_record, & + input_num_iotasks & + ) & + result (descriptor) + +! !DESCRIPTION: +! This routine constructs a file descriptor for use in io routines. +! It fills in every field to guarantee that the descriptor +! will contain no illegal field values upon exit. The data format +! is required together with either a full name or root name. +! If full name is supplied, that name will be used in all file +! operations. If root name is supplied, the full name will be +! constructed using rootname.suffix.dataformat. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character(*), intent(in) :: & + data_format ! bin (binary) or nc (netCDF) + + character(*), intent(in), optional :: & + full_name, &! name (and path) for file + root_name, &! file name root + file_suffix, &! suffix (eg model day, step) + title, &! descriptive name for the file + history, &! file history string + conventions ! conventions for file + + integer (i4), dimension (2), intent(in), optional :: & + id ! unit numbers for binary file & hdr + ! netCDF id for netCDF file + + integer (i4), intent(in), optional :: & + input_num_iotasks, &! to override default iotasks + record_length, &! record length type for binary files + recl_words, &! num words per record for binary files + current_record ! current record number in binary file + +! !OUTPUT PARAMETERS: + + type (datafile) :: descriptor ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + io_record_length ! actual record length + + integer (i4), dimension(:), allocatable :: work_i + real (r4), dimension(:), allocatable :: work_r + real (r8), dimension(:), allocatable :: work_d + +!----------------------------------------------------------------------- +! +! define data format +! +!----------------------------------------------------------------------- + + descriptor%data_format = char_blank + descriptor%data_format = trim(data_format) + +!----------------------------------------------------------------------- +! +! file naming stuff +! if full name is present, use that as filename +! if root name and suffix supplied, construct file name from those +! +!----------------------------------------------------------------------- + + if (present(full_name)) then + descriptor%full_name = char_blank + descriptor%full_name = trim(full_name) + + else if (present(root_name)) then + descriptor%root_name = char_blank + if (present(root_name)) then + descriptor%root_name = trim(root_name) + else + descriptor%root_name = 'root' + end if + descriptor%file_suffix = char_blank + if (present(file_suffix)) then + descriptor%file_suffix = trim(file_suffix)/& + &/'.'/& + &/trim(data_format) + else + descriptor%file_suffix = trim(data_format) + end if + + descriptor%full_name = char_blank + descriptor%full_name = trim(descriptor%root_name)/& + &/'.'/& + &/trim(descriptor%file_suffix) + + else + call exit_POP(sigAbort, & + 'construct_file: can not determine file name') + endif + +!----------------------------------------------------------------------- +! +! parameters specific to binary files +! +!----------------------------------------------------------------------- + + if (descriptor%data_format=='bin') then + + !*** assign unit numbers as file id + !*** if not assigned as input, assign later during file open + + if (present(id)) then + descriptor%id = id + else + descriptor%id = 0 + endif + + !*** number of io tasks for parallel io + + if (present(input_num_iotasks)) then + !*** override namelist input - useful if you need + !*** to serial i/o for a particular file in binary mode + descriptor%num_iotasks = input_num_iotasks + else + descriptor%num_iotasks = num_iotasks ! namelist input + endif + + !*** compute record length + + if (present(record_length)) then + if (.not. present(recl_words)) & + call exit_POP(sigAbort, & + 'construct_file: must supply recl_words') + select case (record_length) + case (rec_type_int) + allocate (work_i(recl_words)) + inquire (iolength=io_record_length) work_i + deallocate (work_i) + case (rec_type_real) + allocate (work_r(recl_words)) + inquire (iolength=io_record_length) work_r + deallocate (work_r) + case (rec_type_dbl) + allocate (work_d(recl_words)) + inquire (iolength=io_record_length) work_d + deallocate (work_d) + case default + io_record_length = 0 + end select + else + io_record_length = 0 + endif + descriptor%record_length = io_record_length + + !*** initialize first record + if (present(current_record)) then + descriptor%current_record = current_record + else + descriptor%current_record = 1 + endif + +!----------------------------------------------------------------------- +! +! parameters specific to netCDF files +! +!----------------------------------------------------------------------- + else + + !*** set id if already known, otherwise defined during file open + + if (present(id)) then + descriptor%id = id + else + descriptor%id = 0 ! to be defined during open + endif + + descriptor%num_iotasks = 1 ! netCDF can only do serial i/o + descriptor%record_length = 0 ! not used for netCDF + descriptor%current_record = 0 ! not used for netCDF + endif + +!----------------------------------------------------------------------- +! +! general descriptive info for files +! +!----------------------------------------------------------------------- + + descriptor%title = char_blank + if (present(title)) then + descriptor%title = trim(title) + else + descriptor%title = 'none' + endif + + descriptor%history = char_blank + if (present(history)) then + descriptor%history = trim(history) + else + descriptor%history = 'none' + endif + + descriptor%conventions = char_blank + if (present(conventions)) then + descriptor%conventions = trim(conventions) + else + descriptor%conventions = 'none' + endif + +!----------------------------------------------------------------------- +! +! initialize global file attributes - these must be set separately +! in the routine add_attrib_file. +! +!----------------------------------------------------------------------- + + descriptor%readonly = .false. ! reset later if necessary + + nullify (descriptor%add_attrib_cname) + nullify (descriptor%add_attrib_cval) + nullify (descriptor%add_attrib_lname) + nullify (descriptor%add_attrib_lval) + nullify (descriptor%add_attrib_iname) + nullify (descriptor%add_attrib_ival) + nullify (descriptor%add_attrib_rname) + nullify (descriptor%add_attrib_rval) + nullify (descriptor%add_attrib_dname) + nullify (descriptor%add_attrib_dval) + +!----------------------------------------------------------------------- +!EOC + + end function construct_file + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_file_char +! !INTERFACE: + + subroutine add_attrib_file_char(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a global file attribute to an io file. This +! particular instantiation adds a character attribute, but is aliased +! to the generic routine name add\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name, &! name of attribute to be added + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: & + file_descr ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp, &! temp space for resizing attrib name array + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(file_descr%add_attrib_cval)) then + + allocate(file_descr%add_attrib_cval(1), & + file_descr%add_attrib_cname(1)) + + file_descr%add_attrib_cval (1) = char_blank + file_descr%add_attrib_cname(1) = char_blank + file_descr%add_attrib_cval (1) = trim(att_value) + file_descr%add_attrib_cname(1) = trim(att_name) + +!----------------------------------------------------------------------- +! +! if not the first, see if it already exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(file_descr%add_attrib_cval(:)) + att_search: do n=1,num_attribs + if (trim(file_descr%add_attrib_cname(n)) == trim(att_name)) then + file_descr%add_attrib_cval(n) = char_blank + file_descr%add_attrib_cval(n) = trim(att_value) + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + name_tmp(:) = file_descr%add_attrib_cname(:) + val_tmp (:) = file_descr%add_attrib_cval (:) + + deallocate(file_descr%add_attrib_cname) + deallocate(file_descr%add_attrib_cval ) + num_attribs = num_attribs + 1 + allocate(file_descr%add_attrib_cname(num_attribs), & + file_descr%add_attrib_cval (num_attribs)) + + file_descr%add_attrib_cname(:) = char_blank + file_descr%add_attrib_cval (:) = char_blank + do n=1,num_attribs-1 + file_descr%add_attrib_cname(n) = trim(name_tmp(n)) + file_descr%add_attrib_cval (n) = trim( val_tmp(n)) + end do + file_descr%add_attrib_cname(num_attribs) = trim(att_name) + file_descr%add_attrib_cval (num_attribs) = trim(att_value) + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_file_char + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_file_log +! !INTERFACE: + + subroutine add_attrib_file_log(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a global file attribute to an io file. This +! particular instantiation adds a logical attribute, but is aliased +! to the generic routine name add\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + logical (log_kind), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: & + file_descr ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + logical (log_kind), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(file_descr%add_attrib_lval)) then + + allocate(file_descr%add_attrib_lval(1), & + file_descr%add_attrib_lname(1)) + + file_descr%add_attrib_lval (1) = att_value + file_descr%add_attrib_lname(1) = char_blank + file_descr%add_attrib_lname(1) = trim(att_name) + +!----------------------------------------------------------------------- +! +! if not the first, see if it already exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(file_descr%add_attrib_lval(:)) + att_search: do n=1,num_attribs + if (trim(file_descr%add_attrib_lname(n)) == trim(att_name)) then + file_descr%add_attrib_lval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = file_descr%add_attrib_lname(:) + val_tmp (:) = file_descr%add_attrib_lval (:) + + deallocate(file_descr%add_attrib_lname, & + file_descr%add_attrib_lval ) + + num_attribs = num_attribs + 1 + + allocate(file_descr%add_attrib_lname(num_attribs), & + file_descr%add_attrib_lval (num_attribs)) + + file_descr%add_attrib_lname(:) = char_blank + do n=1,num_attribs-1 + file_descr%add_attrib_lname(n) = trim(name_tmp(n)) + file_descr%add_attrib_lval (n) = val_tmp(n) + end do + file_descr%add_attrib_lname(num_attribs) = trim(att_name) + file_descr%add_attrib_lval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_file_log + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_file_int +! !INTERFACE: + + subroutine add_attrib_file_int(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a global file attribute to an io file. This +! particular instantiation adds an integer attribute, but is aliased +! to the generic routine name add\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + integer (i4), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: & + file_descr ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + integer (i4), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(file_descr%add_attrib_ival)) then + + allocate(file_descr%add_attrib_ival(1), & + file_descr%add_attrib_iname(1)) + + file_descr%add_attrib_ival (1) = att_value + file_descr%add_attrib_iname(1) = char_blank + file_descr%add_attrib_iname(1) = trim(att_name) + +!----------------------------------------------------------------------- +! +! if not the first, see if it already exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(file_descr%add_attrib_ival(:)) + att_search: do n=1,num_attribs + if (trim(file_descr%add_attrib_iname(n)) == trim(att_name)) then + file_descr%add_attrib_ival(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = file_descr%add_attrib_iname(:) + val_tmp (:) = file_descr%add_attrib_ival (:) + + deallocate(file_descr%add_attrib_iname, & + file_descr%add_attrib_ival ) + + num_attribs = num_attribs + 1 + + allocate(file_descr%add_attrib_iname(num_attribs), & + file_descr%add_attrib_ival (num_attribs)) + + file_descr%add_attrib_iname(:) = char_blank + do n=1,num_attribs-1 + file_descr%add_attrib_iname(n) = trim(name_tmp(n)) + file_descr%add_attrib_ival (n) = val_tmp(n) + end do + file_descr%add_attrib_iname(num_attribs) = trim(att_name) + file_descr%add_attrib_ival (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_file_int + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_file_real +! !INTERFACE: + + subroutine add_attrib_file_real(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a global file attribute to an io file. This +! particular instantiation adds a real attribute, but is aliased +! to the generic routine name add\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + real (r4), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: & + file_descr ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + real (r4), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(file_descr%add_attrib_rval)) then + + allocate(file_descr%add_attrib_rval(1), & + file_descr%add_attrib_rname(1)) + + file_descr%add_attrib_rval (1) = att_value + file_descr%add_attrib_rname(1) = char_blank + file_descr%add_attrib_rname(1) = trim(att_name) + +!----------------------------------------------------------------------- +! +! if not the first, see if it already exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(file_descr%add_attrib_rval(:)) + att_search: do n=1,num_attribs + if (trim(file_descr%add_attrib_rname(n)) == trim(att_name)) then + file_descr%add_attrib_rval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = file_descr%add_attrib_rname(:) + val_tmp (:) = file_descr%add_attrib_rval (:) + + deallocate(file_descr%add_attrib_rname, & + file_descr%add_attrib_rval ) + + num_attribs = num_attribs + 1 + + allocate(file_descr%add_attrib_rname(num_attribs), & + file_descr%add_attrib_rval (num_attribs)) + + file_descr%add_attrib_rname(:) = char_blank + do n=1,num_attribs-1 + file_descr%add_attrib_rname(n) = trim(name_tmp(n)) + file_descr%add_attrib_rval (n) = val_tmp(n) + end do + file_descr%add_attrib_rname(num_attribs) = trim(att_name) + file_descr%add_attrib_rval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_file_real + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_file_dbl +! !INTERFACE: + + subroutine add_attrib_file_dbl(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a global file attribute to an io file. This +! particular instantiation adds a double precision attribute, but is +! aliased to the generic routine name add\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + real (r8), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: & + file_descr ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + real (r8), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(file_descr%add_attrib_dval)) then + + allocate(file_descr%add_attrib_dval(1), & + file_descr%add_attrib_dname(1)) + + file_descr%add_attrib_dval (1) = att_value + file_descr%add_attrib_dname(1) = char_blank + file_descr%add_attrib_dname(1) = trim(att_name) + +!----------------------------------------------------------------------- +! +! if not the first, see if it already exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(file_descr%add_attrib_dval(:)) + att_search: do n=1,num_attribs + if (trim(file_descr%add_attrib_dname(n)) == trim(att_name)) then + file_descr%add_attrib_dval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = file_descr%add_attrib_dname(:) + val_tmp (:) = file_descr%add_attrib_dval (:) + + deallocate(file_descr%add_attrib_dname, & + file_descr%add_attrib_dval ) + + num_attribs = num_attribs + 1 + + allocate(file_descr%add_attrib_dname(num_attribs), & + file_descr%add_attrib_dval (num_attribs)) + + file_descr%add_attrib_dname(:) = char_blank + do n=1,num_attribs-1 + file_descr%add_attrib_dname(n) = trim(name_tmp(n)) + file_descr%add_attrib_dval (n) = val_tmp(n) + end do + file_descr%add_attrib_dname(num_attribs) = trim(att_name) + file_descr%add_attrib_dval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_file_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_file_char +! !INTERFACE: + + subroutine extract_attrib_file_char(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts a global file attribute from an io file +! descriptor based on the attribute name. This particular +! instantiation extracts a character attribute, but is aliased +! to the generic routine name extract\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (datafile), intent(in) :: & + file_descr ! data file descriptor + +! !OUTPUT PARAMETERS: + + character (*), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case(trim(att_name)) + case('full_name','FULL_NAME') + att_exists = .true. + att_value = file_descr%full_name + + case('data_format','DATA_FORMAT') + att_exists = .true. + att_value = file_descr%data_format + + case('root_name','ROOT_NAME') + att_exists = .true. + att_value = file_descr%root_name + + case('file_suffix','FILE_SUFFIX') + att_exists = .true. + att_value = file_descr%file_suffix + + case('title','TITLE') + att_exists = .true. + att_value = file_descr%title + + case('history','HISTORY') + att_exists = .true. + att_value = file_descr%history + + case('conventions','CONVENTIONS') + att_exists = .true. + att_value = file_descr%conventions + + end select + +!----------------------------------------------------------------------- +! +! if attribute array exists, search for attribute +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. & + associated(file_descr%add_attrib_cval)) then + + att_search: do n=1,size(file_descr%add_attrib_cval) + + if (trim(file_descr%add_attrib_cname(n))==trim(att_name)) then + + !*** found the attribute - assign the value + + att_value = file_descr%add_attrib_cval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with an error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown file attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_file_char + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_file_log +! !INTERFACE: + + subroutine extract_attrib_file_log(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts a global file attribute from an io file +! descriptor based on the attribute name. This particular +! instantiation extracts a logical attribute, but is aliased +! to the generic routine name extract\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (datafile), intent(in) :: & + file_descr ! data file descriptor + +! !OUTPUT PARAMETERS: + + logical (log_kind), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case(trim(att_name)) + case('readonly','READONLY') + att_exists = .true. + att_value = file_descr%readonly + + case('ldefine','LDEFINE') + att_exists = .true. + att_value = file_descr%ldefine + + end select + +!----------------------------------------------------------------------- +! +! if attribute array exists, search for attribute +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. & + associated(file_descr%add_attrib_lval)) then + + att_search: do n=1,size(file_descr%add_attrib_lval) + + if (trim(file_descr%add_attrib_lname(n))==trim(att_name)) then + + !*** found the attribute - assign the value + + att_value = file_descr%add_attrib_lval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with an error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown file attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_file_log + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_file_int +! !INTERFACE: + + subroutine extract_attrib_file_int(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts a global file attribute from an io file +! descriptor based on the attribute name. This particular +! instantiation extracts an integer attribute, but is aliased +! to the generic routine name extract\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (datafile), intent(in) :: & + file_descr ! data file descriptor + +! !OUTPUT PARAMETERS: + + integer (i4), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case(trim(att_name)) + case('id','ID') + att_exists = .true. + att_value = file_descr%id(1) + + case('num_iotasks','NUM_IOTASKS') + att_exists = .true. + att_value = file_descr%num_iotasks + + case('record_length','RECORD_LENGTH') + att_exists = .true. + att_value = file_descr%record_length + + case('current_record','CURRENT_RECORD') + att_exists = .true. + att_value = file_descr%current_record + + end select + +!----------------------------------------------------------------------- +! +! if attribute array exists, search for attribute +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. & + associated(file_descr%add_attrib_ival)) then + + att_search: do n=1,size(file_descr%add_attrib_ival) + + if (trim(file_descr%add_attrib_iname(n))==trim(att_name)) then + + !*** found the attribute - assign the value + + att_value = file_descr%add_attrib_ival(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with an error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown file attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_file_int + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_file_real +! !INTERFACE: + + subroutine extract_attrib_file_real(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts a global file attribute from an io file +! descriptor based on the attribute name. This particular +! instantiation extracts a real attribute, but is aliased +! to the generic routine name extract\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (datafile), intent(in) :: & + file_descr ! data file descriptor + +! !OUTPUT PARAMETERS: + + real (r4), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + !*** no standard real attributes + +!----------------------------------------------------------------------- +! +! if attribute array exists, search for attribute +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. & + associated(file_descr%add_attrib_rval)) then + + att_search: do n=1,size(file_descr%add_attrib_rval) + + if (trim(file_descr%add_attrib_rname(n))==trim(att_name)) then + + !*** found the attribute - assign the value + + att_value = file_descr%add_attrib_rval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with an error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown file attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_file_real + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_file_dbl +! !INTERFACE: + + subroutine extract_attrib_file_dbl(file_descr, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts a global file attribute from an io file +! descriptor based on the attribute name. This particular +! instantiation extracts a double precision attribute, but is aliased +! to the generic routine name extract\_attrib\_file. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (datafile), intent(in) :: & + file_descr ! data file descriptor + +! !OUTPUT PARAMETERS: + + real (r8), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + !*** no standard real attributes + +!----------------------------------------------------------------------- +! +! if attribute array exists, search for attribute +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. & + associated(file_descr%add_attrib_dval)) then + + att_search: do n=1,size(file_descr%add_attrib_dval) + + if (trim(file_descr%add_attrib_dname(n))==trim(att_name)) then + + !*** found the attribute - assign the value + + att_value = file_descr%add_attrib_dval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with an error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown file attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_file_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: destroy_file +! !INTERFACE: + + subroutine destroy_file(descriptor) + +! !DESCRIPTION: +! This routine destroys a file descriptor in order to free up units +! and memory. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + type (datafile), intent(inout) :: descriptor ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! release units if they have been assigned +! +!----------------------------------------------------------------------- + + if (descriptor%data_format == 'bin') then + call release_unit(descriptor%id(1)) + !*** if a header file was absent, the sign of the unit was changed + call release_unit(abs(descriptor%id(2))) + else + descriptor%id = 0 + endif + +!----------------------------------------------------------------------- +! +! clear data fields +! +!----------------------------------------------------------------------- + + descriptor%full_name = char_blank + descriptor%data_format = char_blank + descriptor%root_name = char_blank + descriptor%file_suffix = char_blank + descriptor%num_iotasks = 0 + descriptor%record_length = 0 + descriptor%current_record = 0 + descriptor%title = char_blank + descriptor%history = char_blank + descriptor%conventions = char_blank + descriptor%readonly = .false. ! reset later if necessary + +!----------------------------------------------------------------------- +! +! free up memory in additional attribute fields +! +!----------------------------------------------------------------------- + + if (associated(descriptor%add_attrib_cname)) & + deallocate(descriptor%add_attrib_cname) + + if (associated(descriptor%add_attrib_cval)) & + deallocate(descriptor%add_attrib_cval) + + if (associated(descriptor%add_attrib_lname)) & + deallocate(descriptor%add_attrib_lname) + + if (associated(descriptor%add_attrib_lval)) & + deallocate(descriptor%add_attrib_lval) + + if (associated(descriptor%add_attrib_iname)) & + deallocate(descriptor%add_attrib_iname) + + if (associated(descriptor%add_attrib_ival)) & + deallocate(descriptor%add_attrib_ival) + + if (associated(descriptor%add_attrib_rname)) & + deallocate(descriptor%add_attrib_rname) + + if (associated(descriptor%add_attrib_rval)) & + deallocate(descriptor%add_attrib_rval) + + if (associated(descriptor%add_attrib_dname)) & + deallocate(descriptor%add_attrib_dname) + + if (associated(descriptor%add_attrib_dval)) & + deallocate(descriptor%add_attrib_dval) + + nullify (descriptor%add_attrib_cname) + nullify (descriptor%add_attrib_cval) + nullify (descriptor%add_attrib_lname) + nullify (descriptor%add_attrib_lval) + nullify (descriptor%add_attrib_iname) + nullify (descriptor%add_attrib_ival) + nullify (descriptor%add_attrib_rname) + nullify (descriptor%add_attrib_rval) + nullify (descriptor%add_attrib_dname) + nullify (descriptor%add_attrib_dval) + +!----------------------------------------------------------------------- +!EOC + + end subroutine destroy_file + +!*********************************************************************** +!BOP +! !IROUTINE: construct_io_field +! !INTERFACE: + + function construct_io_field ( & + short_name, & + dim1, dim2, & + dim3, & + time_dim, & + long_name, & + units, & + coordinates, & + grid_loc, & + missing_value, & + missing_value_i, & + valid_range, & + field_loc, & + field_type, & + i0d_array, & + i1d_array, & + i2d_array, & + i3d_array, & + r0d_array, & + r1d_array, & + r2d_array, & + r3d_array, & + d0d_array, & + d1d_array, & + d2d_array, & + d3d_array) & + result (descriptor) + +! !DESCRIPTION: +! Constructs a new io\_field descriptor for a field which will +! be read/written. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character(*), intent(in) :: & + short_name ! short (one word) name for field + + type (io_dim), intent(in), optional :: & + dim1, &! dimension data type for 1st dim + dim2, &! dimension data type for 2nd dim + dim3, &! dimension data type for 3rd dim + time_dim ! dimension data type for (unlimited) time dim + + character(*), intent(in), optional :: & + long_name, &! longer descriptive name for field + units, &! units for field + coordinates ! CF-1.0 required attribute + + character(4), intent(in), optional :: & + grid_loc ! position of field in staggered grid + + real (r4), intent(in), optional :: & + missing_value ! value for missing points (eg land) + + real (r4), intent(in), dimension(2), optional :: & + valid_range ! valid range (min,max) for field + + integer (int_kind), intent(in), optional :: & + missing_value_i ! missing value for integer arrays + + integer (i4), intent(in), optional :: & ! for ghost cell updates + field_loc, &! staggering location + field_type ! field type (scalar,vector,angle) + + !*** + !*** one (and only one) of these must be present + !*** the extra dimension on 2d,3d arrays corresponds to block index + !*** + + integer (i4), intent(in), optional :: & + i0d_array + integer (i4), dimension(:), intent(in), optional, target :: & + i1d_array + integer (i4), dimension(:,:,:), intent(in), optional, target :: & + i2d_array + integer (i4), dimension(:,:,:,:), intent(in), optional, target :: & + i3d_array + real (r4), intent(in), optional :: & + r0d_array + real (r4), dimension(:), intent(in), optional, target :: & + r1d_array + real (r4), dimension(:,:,:), intent(in), optional, target :: & + r2d_array + real (r4), dimension(:,:,:,:), intent(in), optional, target :: & + r3d_array + real (r8), intent(in), optional :: & + d0d_array + real (r8), dimension(:), intent(in), optional, target :: & + d1d_array + real (r8), dimension(:,:,:), intent(in), optional, target :: & + d2d_array + real (r8), dimension(:,:,:,:), intent(in), optional, target :: & + d3d_array + +! !OUTPUT PARAMETERS: + + type (io_field_desc) :: descriptor ! descriptor to be created + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + lactive_time_dim + + +!----------------------------------------------------------------------- +! +! variables to describe the field +! +!----------------------------------------------------------------------- + + descriptor%short_name = char_blank + descriptor%short_name = trim(short_name) + + descriptor%long_name = char_blank + if (present(long_name)) then + descriptor%long_name = trim(long_name) + endif + + descriptor%coordinates = char_blank + if (present(coordinates)) then + descriptor%coordinates = trim(coordinates) + endif + + descriptor%units = char_blank + if (present(units)) then + descriptor%units = trim(units) + endif + + descriptor%grid_loc = ' ' + if (present(grid_loc)) then + descriptor%grid_loc = grid_loc + endif + + descriptor%missing_value = undefined + if (present(missing_value)) then + descriptor%missing_value = missing_value + endif + + descriptor%missing_value_i = undefined + if (present(missing_value_i)) then + descriptor%missing_value_i = missing_value_i + endif + + descriptor%valid_range = undefined + if (present(valid_range)) then + descriptor%valid_range = valid_range + endif + + descriptor%field_loc = field_loc_unknown + if (present(field_loc)) then + descriptor%field_loc = field_loc + endif + + descriptor%field_type = field_type_unknown + if (present(field_type)) then + descriptor%field_type = field_type + endif + +!----------------------------------------------------------------------- +! +! initialize id and dimension info (primarily for netCDF files) +! +!----------------------------------------------------------------------- + + if (present (time_dim)) then + if (time_dim%active) then + lactive_time_dim = .true. + else + lactive_time_dim = .false. + endif + else + lactive_time_dim = .false. + endif + + + descriptor%id = 0 + + if (present(i3d_array) .or. present(r3d_array) .or. & + present(d3d_array)) then + if (lactive_time_dim) then + descriptor%nfield_dims = 4 + else + descriptor%nfield_dims = 3 + endif + if (present(dim1)) then + descriptor%field_dim(1) = dim1 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply dim1') + endif + if (present(dim2)) then + descriptor%field_dim(2) = dim2 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply dim2') + endif + if (present(dim3)) then + descriptor%field_dim(3) = dim3 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply 3d dim') + endif + if (lactive_time_dim) then + descriptor%field_dim(4) = time_dim + endif + + + else if (present(i2d_array) .or. present(r2d_array) .or. & + present(d2d_array)) then + if (lactive_time_dim) then + descriptor%nfield_dims = 3 + else + descriptor%nfield_dims = 2 + endif + if (present(dim1)) then + descriptor%field_dim(1) = dim1 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply dim1') + endif + if (present(dim2)) then + descriptor%field_dim(2) = dim2 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply dim2') + endif + if (lactive_time_dim) then + descriptor%field_dim(3) = time_dim + endif + + + else if (present(i1d_array) .or. present(r1d_array) .or. & + present(d1d_array)) then + descriptor%nfield_dims = 1 + + if (present(dim1)) then + descriptor%field_dim(1) = dim1 + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply dim1') + endif + + else + descriptor%nfield_dims = 0 + ! field_dim is not used for scalars + + end if + + nullify (descriptor%field_i_1d) + nullify (descriptor%field_i_2d) + nullify (descriptor%field_i_3d) + + nullify (descriptor%field_r_1d) + nullify (descriptor%field_r_2d) + nullify (descriptor%field_r_3d) + + nullify (descriptor%field_d_1d) + nullify (descriptor%field_d_2d) + nullify (descriptor%field_d_3d) + + if (present(r0d_array)) then + descriptor%field_r_0d = r0d_array + else if (present(r1d_array)) then + descriptor%field_r_1d => r1d_array + else if (present(r2d_array)) then + descriptor%field_r_2d => r2d_array + else if (present(r3d_array)) then + descriptor%field_r_3d => r3d_array + else if (present(d0d_array)) then + descriptor%field_d_0d = d0d_array + else if (present(d1d_array)) then + descriptor%field_d_1d => d1d_array + else if (present(d2d_array)) then + descriptor%field_d_2d => d2d_array + else if (present(d3d_array)) then + descriptor%field_d_3d => d3d_array + else if (present(i0d_array)) then + descriptor%field_i_0d = i0d_array + else if (present(i1d_array)) then + descriptor%field_i_1d => i1d_array + else if (present(i2d_array)) then + descriptor%field_i_2d => i2d_array + else if (present(i3d_array)) then + descriptor%field_i_3d => i3d_array + else + call exit_POP(sigAbort, & + 'construct_io_field: must supply data array') + end if + +!----------------------------------------------------------------------- +! +! nullify additional field attributes +! +!----------------------------------------------------------------------- + + nullify (descriptor%add_attrib_cname) + nullify (descriptor%add_attrib_cval) + nullify (descriptor%add_attrib_lname) + nullify (descriptor%add_attrib_lval) + nullify (descriptor%add_attrib_iname) + nullify (descriptor%add_attrib_ival) + nullify (descriptor%add_attrib_rname) + nullify (descriptor%add_attrib_rval) + nullify (descriptor%add_attrib_dname) + nullify (descriptor%add_attrib_dval) + +!----------------------------------------------------------------------- +!EOC + + end function construct_io_field + +!*********************************************************************** +!BOP +! !IROUTINE: destroy_io_field +! !INTERFACE: + + subroutine destroy_io_field (descriptor) + +! !DESCRIPTION: +! Clears all fields of an io\_field structure and dereference all +! pointers. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + descriptor ! descriptor to be destroyed + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! clear all fields +! +!----------------------------------------------------------------------- + + descriptor%short_name = char_blank + descriptor%long_name = char_blank + descriptor%units = char_blank + descriptor%coordinates= char_blank + descriptor%grid_loc = ' ' + + descriptor%missing_value = undefined + descriptor%missing_value_i = undefined + descriptor%valid_range = undefined + descriptor%id = 0 + descriptor%nfield_dims = 4 + descriptor%field_loc = field_loc_unknown + descriptor%field_type = field_type_unknown + +!----------------------------------------------------------------------- +! +! deallocate and dereference pointers +! +!----------------------------------------------------------------------- + + + nullify (descriptor%field_i_2d) + nullify (descriptor%field_i_2d) + nullify (descriptor%field_i_3d) + + nullify (descriptor%field_r_1d) + nullify (descriptor%field_r_2d) + nullify (descriptor%field_r_3d) + + nullify (descriptor%field_d_1d) + nullify (descriptor%field_d_2d) + nullify (descriptor%field_d_3d) + + if (associated(descriptor%add_attrib_cname)) then + deallocate (descriptor%add_attrib_cname) + deallocate (descriptor%add_attrib_cval) + endif + if (associated(descriptor%add_attrib_lname)) then + deallocate (descriptor%add_attrib_lname) + deallocate (descriptor%add_attrib_lval) + endif + if (associated(descriptor%add_attrib_iname)) then + deallocate (descriptor%add_attrib_iname) + deallocate (descriptor%add_attrib_ival) + endif + if (associated(descriptor%add_attrib_rname)) then + deallocate (descriptor%add_attrib_rname) + deallocate (descriptor%add_attrib_rval) + endif + if (associated(descriptor%add_attrib_dname)) then + deallocate (descriptor%add_attrib_dname) + deallocate (descriptor%add_attrib_dval) + endif + + nullify (descriptor%add_attrib_cname) + nullify (descriptor%add_attrib_cval) + nullify (descriptor%add_attrib_iname) + nullify (descriptor%add_attrib_ival) + nullify (descriptor%add_attrib_rname) + nullify (descriptor%add_attrib_rval) + nullify (descriptor%add_attrib_dname) + nullify (descriptor%add_attrib_dval) + +!----------------------------------------------------------------------- +!EOC + + end subroutine destroy_io_field + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_io_field_char +! !INTERFACE: + + subroutine add_attrib_io_field_char(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine adds an attribute to an io field. This +! particular instantiation adds a character attribute, but is aliased +! to the generic routine name add\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name, &! name of attribute to be added + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + iofield ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp, &! temp space for resizing attrib name array + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(iofield%add_attrib_cval)) then + + allocate(iofield%add_attrib_cval(1), & + iofield%add_attrib_cname(1)) + + iofield%add_attrib_cval (1) = att_value + iofield%add_attrib_cname(1) = att_name + +!----------------------------------------------------------------------- +! +! if not the first, see if it exists and over-write value +! if does not exist, resize the attribute array and store the +! attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(iofield%add_attrib_cval(:)) + att_search: do n=1,num_attribs + if (trim(iofield%add_attrib_cname(n)) == trim(att_name)) then + iofield%add_attrib_cval(n) = char_blank + iofield%add_attrib_cval(n) = trim(att_value) + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + name_tmp(:) = iofield%add_attrib_cname(:) + val_tmp (:) = iofield%add_attrib_cval (:) + + deallocate(iofield%add_attrib_cname) + deallocate(iofield%add_attrib_cval ) + num_attribs = num_attribs + 1 + allocate(iofield%add_attrib_cname(num_attribs), & + iofield%add_attrib_cval (num_attribs)) + + iofield%add_attrib_cname(1:num_attribs-1) = name_tmp + iofield%add_attrib_cval (1:num_attribs-1) = val_tmp + iofield%add_attrib_cname(num_attribs) = att_name + iofield%add_attrib_cval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_io_field_char + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_io_field_log +! !INTERFACE: + + subroutine add_attrib_io_field_log(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a field attribute to an io field. This +! particular instantiation adds a logical attribute, but is aliased +! to the generic routine name add\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + logical (log_kind), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + iofield ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + logical (log_kind), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(iofield%add_attrib_lval)) then + + allocate(iofield%add_attrib_lval(1), & + iofield%add_attrib_lname(1)) + + iofield%add_attrib_lval (1) = att_value + iofield%add_attrib_lname(1) = att_name + +!----------------------------------------------------------------------- +! +! otherwise, check to see if the attribute already is defined +! if yes, store the value +! if no, resize the attribute array and store the attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(iofield%add_attrib_lval(:)) + att_search: do n=1,num_attribs + if (trim(iofield%add_attrib_lname(n)) == trim(att_name)) then + iofield%add_attrib_lval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = iofield%add_attrib_lname(:) + val_tmp (:) = iofield%add_attrib_lval (:) + + deallocate(iofield%add_attrib_lname, & + iofield%add_attrib_lval ) + + num_attribs = num_attribs + 1 + + allocate(iofield%add_attrib_lname(num_attribs), & + iofield%add_attrib_lval (num_attribs)) + + iofield%add_attrib_lname(1:num_attribs-1) = name_tmp + iofield%add_attrib_lval (1:num_attribs-1) = val_tmp + iofield%add_attrib_lname(num_attribs) = att_name + iofield%add_attrib_lval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_io_field_log + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_io_field_int +! !INTERFACE: + + subroutine add_attrib_io_field_int(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a field attribute to an io field. This +! particular instantiation adds an integer attribute, but is aliased +! to the generic routine name add\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + integer (i4), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + iofield ! data file descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + integer (i4), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(iofield%add_attrib_ival)) then + + allocate(iofield%add_attrib_ival(1), & + iofield%add_attrib_iname(1)) + + iofield%add_attrib_ival (1) = att_value + iofield%add_attrib_iname(1) = att_name + +!----------------------------------------------------------------------- +! +! otherwise, check to see if the attribute already is defined +! if yes, store the value +! if no, resize the attribute array and store the attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(iofield%add_attrib_ival(:)) + att_search: do n=1,num_attribs + if (trim(iofield%add_attrib_iname(n)) == trim(att_name)) then + iofield%add_attrib_ival(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = iofield%add_attrib_iname(:) + val_tmp (:) = iofield%add_attrib_ival (:) + + deallocate(iofield%add_attrib_iname, & + iofield%add_attrib_ival ) + + num_attribs = num_attribs + 1 + + allocate(iofield%add_attrib_iname(num_attribs), & + iofield%add_attrib_ival (num_attribs)) + + iofield%add_attrib_iname(1:num_attribs-1) = name_tmp + iofield%add_attrib_ival (1:num_attribs-1) = val_tmp + iofield%add_attrib_iname(num_attribs) = att_name + iofield%add_attrib_ival (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_io_field_int + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_io_field_real +! !INTERFACE: + + subroutine add_attrib_io_field_real(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a field attribute to an io field. This +! particular instantiation adds a real attribute, but is aliased +! to the generic routine name add\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + real (r4), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + iofield ! io field descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + real (r4), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(iofield%add_attrib_rval)) then + + allocate(iofield%add_attrib_rval(1), & + iofield%add_attrib_rname(1)) + + iofield%add_attrib_rval (1) = att_value + iofield%add_attrib_rname(1) = att_name + +!----------------------------------------------------------------------- +! +! otherwise, check to see if the attribute already is defined +! if yes, store the value +! if no, resize the attribute array and store the attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(iofield%add_attrib_rval(:)) + att_search: do n=1,num_attribs + if (trim(iofield%add_attrib_rname(n)) == trim(att_name)) then + iofield%add_attrib_rval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = iofield%add_attrib_rname(:) + val_tmp (:) = iofield%add_attrib_rval (:) + + deallocate(iofield%add_attrib_rname, & + iofield%add_attrib_rval ) + + num_attribs = num_attribs + 1 + + allocate(iofield%add_attrib_rname(num_attribs), & + iofield%add_attrib_rval (num_attribs)) + + iofield%add_attrib_rname(1:num_attribs-1) = name_tmp + iofield%add_attrib_rval (1:num_attribs-1) = val_tmp + iofield%add_attrib_rname(num_attribs) = att_name + iofield%add_attrib_rval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_io_field_real + +!*********************************************************************** +!BOP +! !IROUTINE: add_attrib_io_field_dbl +! !INTERFACE: + + subroutine add_attrib_io_field_dbl(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine adds a field attribute to an io field. This +! particular instantiation adds a double precision attribute, but is +! aliased to the generic routine name add\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be added + + real (r8), intent(in) :: & + att_value ! value of attribute to be added + +! !INPUT/OUTPUT PARAMETERS: + + type (io_field_desc), intent(inout) :: & + iofield ! io field descriptor + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n, &! loop index + num_attribs ! current number of attributes defined + + character (char_len), dimension(:), allocatable :: & + name_tmp ! temp space for resizing attrib name array + + real (r8), dimension(:), allocatable :: & + val_tmp ! temp space for resizing attrib value array + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! if this is the first attribute, allocate space and set the attribute +! +!----------------------------------------------------------------------- + + if (.not. associated(iofield%add_attrib_dval)) then + + allocate(iofield%add_attrib_dval(1), & + iofield%add_attrib_dname(1)) + + iofield%add_attrib_dval (1) = att_value + iofield%add_attrib_dname(1) = att_name + +!----------------------------------------------------------------------- +! +! otherwise, check to see if the attribute already is defined +! if yes, store the value +! if no, resize the attribute array and store the attributes +! +!----------------------------------------------------------------------- + + else + + att_exists = .false. + num_attribs = size(iofield%add_attrib_dval(:)) + att_search: do n=1,num_attribs + if (trim(iofield%add_attrib_dname(n)) == trim(att_name)) then + iofield%add_attrib_dval(n) = att_value + att_exists = .true. + exit att_search + endif + end do att_search + + if (.not. att_exists) then + + allocate(name_tmp(num_attribs), val_tmp(num_attribs)) + + name_tmp(:) = iofield%add_attrib_dname(:) + val_tmp (:) = iofield%add_attrib_dval (:) + + deallocate(iofield%add_attrib_dname, & + iofield%add_attrib_dval ) + + num_attribs = num_attribs + 1 + + allocate(iofield%add_attrib_dname(num_attribs), & + iofield%add_attrib_dval (num_attribs)) + + iofield%add_attrib_dname(1:num_attribs-1) = name_tmp + iofield%add_attrib_dval (1:num_attribs-1) = val_tmp + iofield%add_attrib_dname(num_attribs) = att_name + iofield%add_attrib_dval (num_attribs) = att_value + + deallocate(name_tmp,val_tmp) + endif + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine add_attrib_io_field_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_io_field_char +! !INTERFACE: + + subroutine extract_attrib_io_field_char(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts an attribute from an io field. This +! particular instantiation extracts a character attribute, but is +! aliased to the generic routine name extract\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (io_field_desc), intent(in) :: & + iofield ! data file descriptor + +! !OUTPUT PARAMETERS: + + character (*), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case (trim(att_name)) + case ('short_name','SHORT_NAME') + att_value = iofield%short_name + att_exists = .true. + + case ('long_name','LONG_NAME') + att_exists = .true. + att_value = iofield%long_name + + case ('units','UNITS') + att_exists = .true. + att_value = iofield%units + + case ('grid_loc','GRID_LOC') + att_exists = .true. + att_value = iofield%grid_loc + + case ('coordinates','COORDINATES') + att_exists = .true. + att_value = iofield%coordinates + + end select + +!----------------------------------------------------------------------- +! +! if not a standard attribute, check additional attributes +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. associated(iofield%add_attrib_cval)) then + + att_search: do n=1,size(iofield%add_attrib_cval) + if (trim(att_name) == trim(iofield%add_attrib_cname(n))) then + att_value = iofield%add_attrib_cval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown iofield attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_io_field_char + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_io_field_log +! !INTERFACE: + + subroutine extract_attrib_io_field_log(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts an attribute from an io field. This +! particular instantiation extracts a logical attribute, but is +! aliased to the generic routine name extract\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (io_field_desc), intent(in) :: & + iofield ! data file descriptor + +! !OUTPUT PARAMETERS: + + logical (log_kind), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + !*** no standard logical attributes + +!----------------------------------------------------------------------- +! +! if not a standard attribute, check additional attributes +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. associated(iofield%add_attrib_lval)) then + + att_search: do n=1,size(iofield%add_attrib_lval) + if (trim(att_name) == trim(iofield%add_attrib_lname(n))) then + att_value = iofield%add_attrib_lval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown iofield attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_io_field_log + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_io_field_int +! !INTERFACE: + + subroutine extract_attrib_io_field_int(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts an attribute from an io field. This +! particular instantiation extracts an integer attribute, but is +! aliased to the generic routine name extract\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (io_field_desc), intent(in) :: & + iofield ! data file descriptor + +! !OUTPUT PARAMETERS: + + integer (i4), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case (trim(att_name)) + case ('id','ID') + att_exists = .true. + att_value = iofield%id + + case ('nfield_dims','NFIELD_DIMS') + att_exists = .true. + att_value = iofield%nfield_dims + + end select + +!----------------------------------------------------------------------- +! +! if not a standard attribute, check additional attributes +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. associated(iofield%add_attrib_ival)) then + + att_search: do n=1,size(iofield%add_attrib_ival) + if (trim(att_name) == trim(iofield%add_attrib_iname(n))) then + att_value = iofield%add_attrib_ival(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown iofield attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_io_field_int + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_io_field_real +! !INTERFACE: + + subroutine extract_attrib_io_field_real(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts an attribute from an io field. This +! particular instantiation extracts a real attribute, but is +! aliased to the generic routine name extract\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (io_field_desc), intent(in) :: & + iofield ! data file descriptor + +! !OUTPUT PARAMETERS: + + real (r4), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + select case (trim(att_name)) + + case ('missing_value','MISSING_VALUE') + att_value = iofield%missing_value + att_exists = .true. + + case ('missing_value_i','MISSING_VALUE_I') + att_value = iofield%missing_value_i + att_exists = .true. + + case ('valid_range','VALID_RANGE') + att_exists = .true. + !att_value = iofield%valid_range + + end select + +!----------------------------------------------------------------------- +! +! if not a standard attribute, check additional attributes +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. associated(iofield%add_attrib_rval)) then + + att_search: do n=1,size(iofield%add_attrib_rval) + if (trim(att_name) == trim(iofield%add_attrib_rname(n))) then + att_value = iofield%add_attrib_rval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown iofield attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_io_field_real + +!*********************************************************************** +!BOP +! !IROUTINE: extract_attrib_io_field_dbl +! !INTERFACE: + + subroutine extract_attrib_io_field_dbl(iofield, att_name, att_value) + +! !DESCRIPTION: +! This routine extracts an attribute from an io field. This +! particular instantiation extracts a double precision attribute, but +! is aliased to the generic routine name extract\_attrib\_io\_field. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + att_name ! name of attribute to be extracted + + type (io_field_desc), intent(in) :: & + iofield ! data file descriptor + +! !OUTPUT PARAMETERS: + + real (r8), intent(out) :: & + att_value ! value of attribute to be extracted + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + n ! loop index + + logical (log_kind) :: & + att_exists ! attribute already defined + +!----------------------------------------------------------------------- +! +! first check standard attributes +! +!----------------------------------------------------------------------- + + att_exists = .false. + + !*** no standard dbl attributes + +!----------------------------------------------------------------------- +! +! if not a standard attribute, check additional attributes +! +!----------------------------------------------------------------------- + + if (.not. att_exists .and. associated(iofield%add_attrib_dval)) then + + att_search: do n=1,size(iofield%add_attrib_dval) + if (trim(att_name) == trim(iofield%add_attrib_dname(n))) then + att_value = iofield%add_attrib_dval(n) + att_exists = .true. + exit att_search + endif + end do att_search + endif + +!----------------------------------------------------------------------- +! +! if attribute not found, exit with error +! +!----------------------------------------------------------------------- + + if (.not. att_exists) then + if (my_task == master_task) then + write(stdout,*) 'Attribute name: ',trim(att_name) + endif + call exit_POP(sigAbort,'Unknown iofield attribute') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine extract_attrib_io_field_dbl + +!*********************************************************************** +!BOP +! !IROUTINE: construct_io_dim +! !INTERFACE: + + function construct_io_dim(name, length, start, stop, stride, active) + +! !DESCRIPTION: +! Constructs a dimension for use in defining fields for io. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character(*), intent(in) :: & + name ! name of dimension + + integer(i4), intent(in) :: & + length ! size of dimension (1 to n, but 0 means unlimited) + + integer(i4), intent(in), optional :: & + start, stop, stride ! For slicing and dicing + + logical(log_kind),intent(in), optional :: & + active + + +! !OUTPUT PARAMETERS: + + type (io_dim) :: construct_io_dim + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! build data structure using input values +! +!----------------------------------------------------------------------- + + construct_io_dim%name = char_blank + construct_io_dim%name = trim(name) + + construct_io_dim%id = 0 ! will be set later using netCDF routine + construct_io_dim%length = length + + if (present(start)) then + construct_io_dim%start = start + else + construct_io_dim%start = 1 + endif + + if (present(stop)) then + construct_io_dim%stop = stop + else + construct_io_dim%stop = length + endif + + if (present(stride)) then + construct_io_dim%stride = stride + else + construct_io_dim%stride = 1 + endif + + if (present(active)) then + construct_io_dim%active = active + else + construct_io_dim%active = .true. + endif + + +!----------------------------------------------------------------------- +!EOC + + end function construct_io_dim + +!*********************************************************************** +!BOP +! !IROUTINE: init_io +! !INTERFACE: + + subroutine init_io + +! !DESCRIPTION: +! This routine initializes some i/o arrays and checks the validity +! of the i/o processor number. It also sets up netcdf datasets. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: & + nml_error ! namelist i/o error flag + + character (8) :: & + logdate ! actual date at model startup + ! (not simulation date) + + character (10) :: & + logtime ! wallclock time at model startup + + character (char_len) :: & + char_tmp ! temp character string for filenames + + namelist /io_nml/ num_iotasks, & + lredirect_stdout, log_filename, & + luse_pointer_files, pointer_filename + +!----------------------------------------------------------------------- +! +! initialize io unit manager +! +!----------------------------------------------------------------------- + + in_use = .false. ! no unit in use + + in_use(stdin) = .true. ! reserved units + in_use(stdout) = .true. + in_use(stderr) = .true. + in_use(nml_in) = .true. + +!----------------------------------------------------------------------- +! +! read and define namelist inputs +! +!----------------------------------------------------------------------- + + lredirect_stdout = .false. + log_filename = 'pop.out' + luse_pointer_files = .false. + pointer_filename = 'pop2_pointer' + num_iotasks = 1 ! set default num io tasks + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + + + do while (nml_error > 0) + read(nml_in, nml=io_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_POP(sigAbort,'ERROR reading io_nml') + endif + + call broadcast_scalar(num_iotasks, master_task) + call broadcast_scalar(lredirect_stdout, master_task) + call broadcast_scalar(log_filename, master_task) + call broadcast_scalar(luse_pointer_files, master_task) + call broadcast_scalar(pointer_filename, master_task) + + +!----------------------------------------------------------------------- +! +! redirect stdout to a log file if requested +! +!----------------------------------------------------------------------- + + if (lredirect_stdout .and. my_task == master_task) then + + open (stdout,file=trim(log_filename),form='formatted',position='append') + + end if + + +!----------------------------------------------------------------------- +! +! document namelist after stdout redirection +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*)' I/O:' + write(stdout,blank_fmt) + write(stdout,*) 'io_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout,io_nml) + write(stdout,blank_fmt) + call shr_sys_flush(stdout) + endif + +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + + end subroutine init_io + +!*********************************************************************** +!BOP +! !IROUTINE: get_unit +! !INTERFACE: + + subroutine get_unit(iunit) + +! !DESCRIPTION: +! This routine returns the next available i/o unit. +! Note that {\em all} processors must call get\_unit (even if only +! the master task is doing the i/o) to insure that +! the in\_use array remains synchronized. +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (i4), intent(out) :: & + iunit ! next free i/o unit + +!EOP +!BOC +!----------------------------------------------------------------------- + + integer (i4) :: n ! dummy loop index + +!----------------------------------------------------------------------- +! +! find next free unit +! +!----------------------------------------------------------------------- + + srch_units: do n=1,max_units + if (.not. in_use(n)) then ! I found one, I found one + iunit = n + exit srch_units + endif + end do srch_units + + in_use(iunit) = .true. ! mark iunit as being in use + +!----------------------------------------------------------------------- +!EOC + + end subroutine get_unit + +!*********************************************************************** +!BOP +! !IROUTINE: release_unit +! !INTERFACE: + + subroutine release_unit(iunit) + +! !DESCRIPTION: +! This routine releases an i/o unit (marks it as available). +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETER: + + integer (i4), intent(in) :: & + iunit ! i/o unit to be released + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! mark the unit as not in use +! +!----------------------------------------------------------------------- + + in_use(iunit) = .false. ! that was easy... + +!----------------------------------------------------------------------- +!EOC + + end subroutine release_unit + +!*********************************************************************** + + end module io_types + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/output.F90 b/components/cism/source_glc/POP_files/output.F90 new file mode 100644 index 0000000000..0da71aafdc --- /dev/null +++ b/components/cism/source_glc/POP_files/output.F90 @@ -0,0 +1,165 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module output + +!BOP +! !MODULE: output +! !DESCRIPTION: +! Contains necessary routines, variables for large model output +! files - restart, history, movies, drifter, time average files. +! This module is primarily a driver for the individual output +! modules. +! +! !REVISION HISTORY: +! SVN:$Id: output.F90 2290 2006-10-25 18:23:10Z njn01 $ +! +! !USES: + + use kinds_mod + use domain +! use constants, only: +! use time_management, only: + use restart, only: write_restart, init_restart + use history, only: write_history, init_history + use movie, only: write_movie, init_movie + use tavg, only: write_tavg, init_tavg + use timers, only: get_timer, timer_start, timer_stop + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: output_driver, & + init_output + + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: output_driver +! !INTERFACE: + + subroutine output_driver + +! !DESCRIPTION: +! This is the main driver routine for all large model output routines. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (char_len) :: & + restart_type ! type of restart being written - used + ! to pass restart info to tavg routines + + integer (int_kind), save :: & + timer_tavg, &! timer for tavg + timer_rest ! timer for restart + + logical (log_kind), save :: & + first_call = .true. ! flag for initializing timers + + +!----------------------------------------------------------------------- +! +! if this is the first call to output_driver, start some timers +! +!----------------------------------------------------------------------- + + if (first_call) then + call get_timer(timer_tavg,'OUTPUT TAVG',nblocks_clinic,distrb_clinic%nprocs) + call get_timer(timer_rest,'OUTPUT REST',nblocks_clinic,distrb_clinic%nprocs) + first_call = .false. + endif + +!----------------------------------------------------------------------- +! +! write history, movie files - the decision when to write +! is internal to each routine +! write these first so that if I/O fails, no restart is written +! +!----------------------------------------------------------------------- + + call write_history + call write_movie + +!----------------------------------------------------------------------- +! +! check for restart and write restart if required +! +!----------------------------------------------------------------------- + + call timer_start(timer_rest) + call write_restart(restart_type) + call timer_stop (timer_rest) + +!----------------------------------------------------------------------- +! +! write tavg - the decision when to write +! is internal to routine except for notifying tavg that a +! restart must be written +! +!----------------------------------------------------------------------- + + call timer_start(timer_tavg) + call write_tavg(restart_type) + call timer_stop (timer_tavg) + +!----------------------------------------------------------------------- +!EOC + + end subroutine output_driver + +!*********************************************************************** +!BOP +! !IROUTINE: init_output +! !INTERFACE: + + subroutine init_output + +! !DESCRIPTION: +! Initializes frequency of output and filenames for +! various files by calling individual initialization routines +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! call individual init routines +! +!----------------------------------------------------------------------- + + call init_restart + call init_history + call init_movie + call init_tavg + +!----------------------------------------------------------------------- +!EOC + + end subroutine init_output + + +!*********************************************************************** + + end module output + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/registry.F90 b/components/cism/source_glc/POP_files/registry.F90 new file mode 100644 index 0000000000..d3eb6cd642 --- /dev/null +++ b/components/cism/source_glc/POP_files/registry.F90 @@ -0,0 +1,224 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module registry + +!BOP +! !MODULE: registry +! +! !DESCRIPTION: +! This module provides a means for registering, checking, and +! recording events that have occurred in CCSM POP +! +! !REVISION HISTORY: +! SVN:$Id: registry.F90 923 2006-05-10 22:25:10Z njn01 $ + +! !USES: + + use kinds_mod + use shr_sys_mod + use exit_mod + use io_tools + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public :: & + init_registry, & + registry_match, & + register_string, & + registry_err_check, & + trap_registry_failure + +!EOP +!BOC + + integer (int_kind), parameter :: & + max_registry_size = 200 ! maximum size of registry + + integer (int_kind) :: & + registry_failure_count, & + registry_size + + character (char_len), dimension (max_registry_size) :: & + registry_storage + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** + subroutine init_registry + +!----------------------------------------------------------------------- +! +! This routine initializes the registry storage array and +! sets the failure counter to zero +!----------------------------------------------------------------------- + + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n ! dummy loop index + + + call reset_registry_failure_count + registry_size = 0 + + do n=1,max_registry_size + registry_storage(n) = ' ' + end do + + end subroutine init_registry + + + function registry_match (string) + +!----------------------------------------------------------------------- +! This function checks to see if a string has already been registered +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! input variables +!----------------------------------------------------------------------- + + character (*), intent(in) :: string + +!----------------------------------------------------------------------- +! output variables +!----------------------------------------------------------------------- + + logical (log_kind) :: registry_match ! T ==> string is registered + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy loop index + +!----------------------------------------------------------------------- +! +! search to determine if string has already been registered +! +!----------------------------------------------------------------------- + + registry_match = .false. + + string_search: do n=1,max_registry_size + if ( registry_storage(n) == string) then + registry_match = .true. + exit string_search + endif + end do string_search + + end function registry_match + + + subroutine reset_registry_failure_count + registry_failure_count = 0 + end subroutine reset_registry_failure_count + + + subroutine register_string (string) + +!----------------------------------------------------------------------- +! this routine registers a character string in registry_storage +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! input variables +!----------------------------------------------------------------------- + + character (*), intent(in) :: string ! string added to registry + + + +!----------------------------------------------------------------------- +! if string is not already defined, add string to registry +!----------------------------------------------------------------------- + + if (.not. registry_match(string) ) then + registry_size = registry_size + 1 + registry_storage(registry_size) = string + endif + + end subroutine register_string + + + subroutine registry_err_check (string,string_present,caller) + +!----------------------------------------------------------------------- +! This routine complains if a string is in the registry but +! shouldn't be, or is not in the registry but should be. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! input variables +!----------------------------------------------------------------------- + + character (*), intent(in) :: & + string, & ! test string + caller ! calling routine name + + logical (log_kind),intent(in) :: & + string_present ! T ==> want string to be IN the registry + +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- + + character (char_len) :: message ! error message + + +!----------------------------------------------------------------------- +! check for error conditions; if error exits, print message and +! increment registry_failure_count +!----------------------------------------------------------------------- + + + if ((registry_match(string) .neqv. string_present)) then + + if (string_present) then + write(message,1100) 'registry_error:', trim(string), & + 'has NOT been registered -- calling routine is ', & + trim(caller) + else + write(message,1100) 'registry_error:', trim(string), & + 'has ALREADY been registered -- calling routine is ', & + trim(caller) + endif + + 1100 format(1x, 4a) + + call document('registry_err_check',message) + + registry_failure_count = registry_failure_count + 1 + else + + endif ! registry_match + + end subroutine registry_err_check + + + subroutine trap_registry_failure +!----------------------------------------------------------------------- +! +! This subroutine checks to see if there have been any registry +! failures. If any have occurred, then the model will stop. +!----------------------------------------------------------------------- + + if (registry_failure_count /= 0) then + call exit_POP (sigAbort, & + 'Registry failure count > 0 ; search output for "registry_error" for info') + endif + + end subroutine trap_registry_failure + + + end module registry + diff --git a/components/cism/source_glc/POP_files/step_mod.F90 b/components/cism/source_glc/POP_files/step_mod.F90 new file mode 100644 index 0000000000..971b6f934e --- /dev/null +++ b/components/cism/source_glc/POP_files/step_mod.F90 @@ -0,0 +1,681 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module step_mod + +!BOP +! !MODULE: step_mod + +! !DESCRIPTION: +! Contains the routine for stepping the model forward one timestep +! +! !REVISION HISTORY: +! SVN:$Id: step_mod.F90 2019 2006-09-29 22:00:15Z njn01 $ +! +! !USES: + + use kinds_mod, only: int_kind, r8, log_kind + use blocks, only: nx_block, ny_block, block, get_block +! use distribution, only: + use domain_size + use domain, only: distrb_clinic, nblocks_clinic, bndy_clinic, & + blocks_clinic + use constants, only: c2, field_loc_NEcorner, field_type_vector, & + field_type_scalar, c3, p5, grav, salt_to_ppt + use prognostic, only: max_blocks_clinic, mixtime, newtime, & + field_loc_center, km, curtime, UBTROP, VBTROP, UVEL, VVEL, RHO, & + TRACER, oldtime, PGUESS, GRADPX, GRADPY, PSURF, nt +! use solvers, only: +! use broadcast, only: + use boundary, only: update_ghost_cells + use timers, only: get_timer, timer_start, timer_stop + use grid, only: KMU, sfc_layer_type, sfc_layer_varthick, dz, hu, & + ugrid_to_tgrid +! use io, only: + use diagnostics, only: diag_global_preupdate, diag_global_afterupdate, & + diag_print, diag_transport, diag_init_sums, tracer_mean_initial, & + volume_t_initial, diag_velocity + use state_mod, only: state + use time_management, only: mix_pass, matsuno_ts, leapfrogts, beta, & + alpha, c2dtt, c2dtu, c2dtp, dtp, c2dtq, theta, avg_ts, back_to_back, & + time_to_do, freq_opt_nstep, dt, dtu, time_manager, check_time_flag, & + init_time_flag, check_time_flag_freq, check_time_flag_freq_opt, eod + use xdisplay, only: lxdisplay, nstep_xdisplay, display + use baroclinic, only: baroclinic_driver, baroclinic_correct_adjust + use barotropic, only: barotropic_driver + use surface_hgt, only: dhdt + use tavg, only: tavg_set_flag, accumulate_tavg_field, ltavg_on, tavg_id + use forcing, only: FW_OLD, FW, set_surface_forcing, tavg_forcing, STF + use forcing_coupled, only: lcoupled + use ice, only: liceform, ice_cpl_flag, ice_flx_to_coupler, QFLUX, tlast_ice + use passive_tracers, only : tavg_passive_tracers_sflux + use shr_sys_mod + use communicate, only: my_task, master_task + use io_types, only: stdout + use budget_diagnostics, only: ldiag_global_tracer_budgets, diag_for_tracer_budgets, & + tracer_budgets + + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: step + +!---------------------------------------------------------------------- +! +! module variables +! +!---------------------------------------------------------------------- + integer (int_kind), private :: & + cpl_stop_now, &! flag id for stop_now flag + tavg_flag ! flag to access tavg frequencies + + + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: step +! !INTERFACE: + + subroutine step + +! !DESCRIPTION: +! This routine advances the simulation on timestep. +! It controls logic for leapfrog and/or Matsuno timesteps and performs +! time-averaging if necessary. Prognostic variables are updated for +! the next timestep near the end of the routine. +! On Matsuno steps, the time (n) velocity and tracer arrays +! UBTROP,VBTROP,UVEL,VVEL,TRACER contain the predicted new +! velocities from the 1st pass for use in the 2nd pass. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local or common variables: +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + i,j,k,n, &! loop indices + tmptime, &! temp space for time index swapping + iblock, &! block counter + ipass, &! pass counter + num_passes ! number of passes through time step + ! (Matsuno requires two) + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: & + ZX,ZY, &! vertically integrated forcing terms + DH,DHU ! time change of surface height minus + ! freshwater flux at T, U points + + logical (log_kind), save :: & + first_call = .true., &! flag for initializing timers + first_global_budget = .true. + + integer (int_kind), save :: & + timer_baroclinic, &! timer for baroclinic parts of step + timer_barotropic ! timer for barotropic part of step + + type (block) :: & + this_block ! block information for current block + +!----------------------------------------------------------------------- +! +! if this is the first call to step, start some timers +! +!----------------------------------------------------------------------- + + + if (first_call) then + cpl_stop_now = init_time_flag('stop_now',default=.false.) + tavg_flag = init_time_flag('tavg') + + call get_timer(timer_baroclinic,'BAROCLINIC',1, & + distrb_clinic%nprocs) + call get_timer(timer_barotropic,'BAROTROPIC',1, & + distrb_clinic%nprocs) + first_call = .false. + endif + +!----------------------------------------------------------------------- +! +! Gather data for comparison with hydrographic data +! +!----------------------------------------------------------------------- +! +! if(newday) call data_stations +! if(newday .and. (mod(iday-1,3).eq.0) ) call data_slices +! +!----------------------------------------------------------------------- +! +! Gather data for comparison with current meter data +! THIS SECTION NOT FUNCTIONAL AT THIS TIME +! +!----------------------------------------------------------------------- +! +! if(newday) call data_cmeters +! + +!----------------------------------------------------------------------- +! +! initialize the global budget arrays +! +!----------------------------------------------------------------------- + + if ( first_global_budget .and. ldiag_global_tracer_budgets .and. & + ltavg_on ) then + call diag_for_tracer_budgets (tracer_mean_initial,volume_t_initial) + + if ( my_task == master_task ) then + write (stdout,1001) volume_t_initial,tracer_mean_initial(1), & + salt_to_ppt*tracer_mean_initial(2) + endif + + first_global_budget = .false. + endif + +!----------------------------------------------------------------------- +! +! read fields for surface forcing +! +!----------------------------------------------------------------------- + + + call set_surface_forcing + + +!----------------------------------------------------------------------- +! +! return if coupler has sent "stop now" signal +! +!----------------------------------------------------------------------- + + if (lcoupled .and. check_time_flag(cpl_stop_now) ) RETURN + +!----------------------------------------------------------------------- +! +! update timestep counter, set corresponding model time, set +! time-dependent logical switches to determine program flow. +! +!----------------------------------------------------------------------- + + + call time_manager(lcoupled, liceform) + +!----------------------------------------------------------------------- +! +! compute and initialize some time-average diagnostics +! +!----------------------------------------------------------------------- + + call tavg_set_flag + call tavg_forcing + if (nt > 2) call tavg_passive_tracers_sflux(STF) + + +!----------------------------------------------------------------------- +! +! set timesteps and time-centering parameters for leapfrog or +! matsuno steps. +! +!----------------------------------------------------------------------- + + mix_pass = 0 + if (matsuno_ts) then + num_passes = 2 + else + num_passes = 1 + endif + + + do ipass = 1,num_passes + + + + if (matsuno_ts) mix_pass = mix_pass + 1 + + if (leapfrogts) then ! leapfrog (and averaging) timestep + mixtime = oldtime + beta = alpha + do k = 1,km + c2dtt(k) = c2*dt(k) + enddo + c2dtu = c2*dtu + c2dtp = c2*dtp ! barotropic timestep = baroclinic timestep + c2dtq = c2*dtu ! turbulence timestep = mean flow timestep + else + mixtime = curtime + beta = theta + do k = 1,km + c2dtt(k) = dt(k) + enddo + c2dtu = dtu + c2dtp = dtp ! barotropic timestep = baroclinic timestep + c2dtq = dtu ! turbulence timestep = mean flow timestep + endif + +!----------------------------------------------------------------------- +! +! on 1st pass of matsuno, set time (n-1) variables equal to +! time (n) variables. +! +!----------------------------------------------------------------------- + + + if (mix_pass == 1) then + + !$OMP PARALLEL DO + do iblock = 1,nblocks_clinic + UBTROP(:,:,oldtime,iblock) = UBTROP(:,:,curtime,iblock) + VBTROP(:,:,oldtime,iblock) = VBTROP(:,:,curtime,iblock) + UVEL(:,:,:,oldtime,iblock) = UVEL(:,:,:,curtime,iblock) + VVEL(:,:,:,oldtime,iblock) = VVEL(:,:,:,curtime,iblock) + RHO (:,:,:,oldtime,iblock) = RHO (:,:,:,curtime,iblock) + TRACER(:,:,:,:,oldtime,iblock) = & + TRACER(:,:,:,:,curtime,iblock) + end do + !$OMP END PARALLEL DO + + endif + + +!----------------------------------------------------------------------- +! +! initialize diagnostic flags and sums +! +!----------------------------------------------------------------------- + + call diag_init_sums + +!----------------------------------------------------------------------- +! +! calculate change in surface height dh/dt from surface pressure +! +!----------------------------------------------------------------------- + + call dhdt(DH,DHU) + +!----------------------------------------------------------------------- +! +! Integrate baroclinic equations explicitly to find tracers and +! baroclinic velocities at new time. Update ghost cells for +! forcing terms leading into the barotropic solver. +! +!----------------------------------------------------------------------- + + call timer_start(timer_baroclinic) + call baroclinic_driver(ZX,ZY,DH,DHU) + call timer_stop(timer_baroclinic) + + + call update_ghost_cells(ZX, bndy_clinic, field_loc_NEcorner, & + field_type_vector) + call update_ghost_cells(ZY, bndy_clinic, field_loc_NEcorner, & + field_type_vector) + + + +!----------------------------------------------------------------------- +! +! Solve barotropic equations implicitly to find surface pressure +! and barotropic velocities. +! +!----------------------------------------------------------------------- + + call timer_start(timer_barotropic) + call barotropic_driver(ZX,ZY) + call timer_stop(timer_barotropic) + + +!----------------------------------------------------------------------- +! +! update tracers using surface height at new time +! also peform adjustment-like physics (convection, ice formation) +! +!----------------------------------------------------------------------- + + call timer_start(timer_baroclinic) + call baroclinic_correct_adjust + call timer_stop(timer_baroclinic) + + + call update_ghost_cells(UBTROP(:,: ,newtime,:), bndy_clinic, & + field_loc_NEcorner, field_type_vector) + call update_ghost_cells(VBTROP(:,: ,newtime,:), bndy_clinic, & + field_loc_NEcorner, field_type_vector) + call update_ghost_cells(UVEL (:,:,: ,newtime,:), bndy_clinic, & + field_loc_NEcorner, field_type_vector) + call update_ghost_cells(VVEL (:,:,: ,newtime,:), bndy_clinic, & + field_loc_NEcorner, field_type_vector) + call update_ghost_cells(RHO (:,:,: ,newtime,:), bndy_clinic, & + field_loc_center, field_type_scalar) + call update_ghost_cells(TRACER(:,:,:,:,newtime,:), bndy_clinic, & + field_loc_center, field_type_scalar) + +!----------------------------------------------------------------------- +! +! add barotropic to baroclinic velocities at new time +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblock, k) + do iblock = 1,nblocks_clinic + +!CDIR NOVECTOR + do k=1,km + do j=1,ny_block + do i=1,nx_block + if (k <= KMU(i,j,iblock)) then + UVEL(i,j,k,newtime,iblock) = & + UVEL(i,j,k,newtime,iblock) + UBTROP(i,j,newtime,iblock) + VVEL(i,j,k,newtime,iblock) = & + VVEL(i,j,k,newtime,iblock) + VBTROP(i,j,newtime,iblock) + endif + enddo + enddo + enddo + +!----------------------------------------------------------------------- +! +! on matsuno mixing steps update variables and cycle for 2nd pass +! note: first step is forward only. +! +!----------------------------------------------------------------------- + + if (mix_pass == 1) then + + UBTROP(:,:,curtime,iblock) = UBTROP(:,:,newtime,iblock) + VBTROP(:,:,curtime,iblock) = VBTROP(:,:,newtime,iblock) + UVEL(:,:,:,curtime,iblock) = UVEL(:,:,:,newtime,iblock) + VVEL(:,:,:,curtime,iblock) = VVEL(:,:,:,newtime,iblock) + RHO (:,:,:,curtime,iblock) = RHO (:,:,:,newtime,iblock) + TRACER(:,:,:,:,curtime,iblock) = & + TRACER(:,:,:,:,newtime,iblock) + + endif + enddo ! block loop + !$OMP END PARALLEL DO + + end do ! ipass: cycle for 2nd pass in matsuno step + +!----------------------------------------------------------------------- +! +! extrapolate next guess for pressure from three known time levels +! +!----------------------------------------------------------------------- + + !$OMP PARALLEL DO + do iblock = 1,nblocks_clinic + PGUESS(:,:,iblock) = c3*(PSURF(:,:,newtime,iblock) - & + PSURF(:,:,curtime,iblock)) + & + PSURF(:,:,oldtime,iblock) + end do + !$OMP END PARALLEL DO + +!----------------------------------------------------------------------- +! +! compute some global diagnostics +! before updating prognostic variables +! +!----------------------------------------------------------------------- + + call diag_global_preupdate(DH,DHU) + +!----------------------------------------------------------------------- +! +! update prognostic variables for next timestep: +! on normal timesteps +! (n) -> (n-1) +! (n+1) -> (n) +! on averaging timesteps +! [(n) + (n-1)]/2 -> (n-1) +! [(n+1) + (n)]/2 -> (n) +! +!----------------------------------------------------------------------- + + if (avg_ts .or. back_to_back) then ! averaging step + + !$OMP PARALLEL DO PRIVATE(iblock, k, n, this_block) + + do iblock = 1,nblocks_clinic + this_block = get_block(blocks_clinic(iblock),iblock) + + !*** avg 2-d fields + + UBTROP(:,:,oldtime,iblock) = p5*(UBTROP(:,:,oldtime,iblock) + & + UBTROP(:,:,curtime,iblock)) + VBTROP(:,:,oldtime,iblock) = p5*(VBTROP(:,:,oldtime,iblock) + & + VBTROP(:,:,curtime,iblock)) + UBTROP(:,:,curtime,iblock) = p5*(UBTROP(:,:,curtime,iblock) + & + UBTROP(:,:,newtime,iblock)) + VBTROP(:,:,curtime,iblock) = p5*(VBTROP(:,:,curtime,iblock) + & + VBTROP(:,:,newtime,iblock)) + GRADPX(:,:,oldtime,iblock) = p5*(GRADPX(:,:,oldtime,iblock) + & + GRADPX(:,:,curtime,iblock)) + GRADPY(:,:,oldtime,iblock) = p5*(GRADPY(:,:,oldtime,iblock) + & + GRADPY(:,:,curtime,iblock)) + GRADPX(:,:,curtime,iblock) = p5*(GRADPX(:,:,curtime,iblock) + & + GRADPX(:,:,newtime,iblock)) + GRADPY(:,:,curtime,iblock) = p5*(GRADPY(:,:,curtime,iblock) + & + GRADPY(:,:,newtime,iblock)) + FW_OLD(:,:,iblock) = p5*(FW(:,:,iblock) + FW_OLD(:,:,iblock)) + + !*** avg 3-d fields + + UVEL(:,:,:,oldtime,iblock) = p5*(UVEL(:,:,:,oldtime,iblock) + & + UVEL(:,:,:,curtime,iblock)) + VVEL(:,:,:,oldtime,iblock) = p5*(VVEL(:,:,:,oldtime,iblock) + & + VVEL(:,:,:,curtime,iblock)) + UVEL(:,:,:,curtime,iblock) = p5*(UVEL(:,:,:,curtime,iblock) + & + UVEL(:,:,:,newtime,iblock)) + VVEL(:,:,:,curtime,iblock) = p5*(VVEL(:,:,:,curtime,iblock) + & + VVEL(:,:,:,newtime,iblock)) + + do n=1,nt + + do k=2,km + TRACER(:,:,k,n,oldtime,iblock) = & + p5*(TRACER(:,:,k,n,oldtime,iblock) + & + TRACER(:,:,k,n,curtime,iblock)) + TRACER(:,:,k,n,curtime,iblock) = & + p5*(TRACER(:,:,k,n,curtime,iblock) + & + TRACER(:,:,k,n,newtime,iblock)) + end do + end do + + if (sfc_layer_type == sfc_layer_varthick) then + + do n = 1,nt + + TRACER(:,:,1,n,oldtime,iblock) = & + p5*((dz(1) + PSURF(:,:,oldtime,iblock)/grav)* & + TRACER(:,:,1,n,oldtime,iblock) + & + (dz(1) + PSURF(:,:,curtime,iblock)/grav)* & + TRACER(:,:,1,n,curtime,iblock) ) + TRACER(:,:,1,n,curtime,iblock) = & + p5*((dz(1) + PSURF(:,:,curtime,iblock)/grav)* & + TRACER(:,:,1,n,curtime,iblock) + & + (dz(1) + PSURF(:,:,newtime,iblock)/grav)* & + TRACER(:,:,1,n,newtime,iblock) ) + end do ! nt + + PSURF(:,:,oldtime,iblock) = p5*(PSURF(:,:,oldtime,iblock) + & + PSURF(:,:,curtime,iblock)) + PSURF(:,:,curtime,iblock) = p5*(PSURF(:,:,curtime,iblock) + & + PSURF(:,:,newtime,iblock)) + do n = 1,nt + + TRACER(:,:,1,n,oldtime,iblock) = & + TRACER(:,:,1,n,oldtime,iblock)/(dz(1) + & + PSURF(:,:,oldtime,iblock)/grav) + TRACER(:,:,1,n,curtime,iblock) = & + TRACER(:,:,1,n,curtime,iblock)/(dz(1) + & + PSURF(:,:,curtime,iblock)/grav) + enddo + + else + + do n=1,nt + + TRACER(:,:,1,n,oldtime,iblock) = & + p5*(TRACER(:,:,1,n,oldtime,iblock) + & + TRACER(:,:,1,n,curtime,iblock)) + TRACER(:,:,1,n,curtime,iblock) = & + p5*(TRACER(:,:,1,n,curtime,iblock) + & + TRACER(:,:,1,n,newtime,iblock)) + end do + + PSURF (:,:,oldtime,iblock) = & + p5*(PSURF (:,:,oldtime,iblock) + & + PSURF (:,:,curtime,iblock)) + PSURF (:,:,curtime,iblock) = & + p5*(PSURF (:,:,curtime,iblock) + & + PSURF (:,:,newtime,iblock)) + + endif + + do k = 1,km ! recalculate densities from averaged tracers + call state(k,k,TRACER(:,:,k,1,oldtime,iblock), & + TRACER(:,:,k,2,oldtime,iblock), & + this_block, & + RHOOUT=RHO(:,:,k,oldtime,iblock)) + call state(k,k,TRACER(:,:,k,1,curtime,iblock), & + TRACER(:,:,k,2,curtime,iblock), & + this_block, & + RHOOUT=RHO(:,:,k,curtime,iblock)) + enddo + + !*** correct after avg + PGUESS(:,:,iblock) = p5*(PGUESS(:,:,iblock) + & + PSURF(:,:,newtime,iblock)) + end do ! block loop + !$OMP END PARALLEL DO + + + else ! non-averaging step + + !$OMP PARALLEL DO + do iblock = 1,nblocks_clinic + + if (mix_pass == 2) then ! reset time n variables on 2nd pass matsuno + + UBTROP(:,:,curtime,iblock) = UBTROP(:,:,oldtime,iblock) + VBTROP(:,:,curtime,iblock) = VBTROP(:,:,oldtime,iblock) + UVEL(:,:,:,curtime,iblock) = UVEL(:,:,:,oldtime,iblock) + VVEL(:,:,:,curtime,iblock) = VVEL(:,:,:,oldtime,iblock) + TRACER(:,:,:,:,curtime,iblock) = & + TRACER(:,:,:,:,oldtime,iblock) + RHO(:,:,:,curtime,iblock) = RHO(:,:,:,oldtime,iblock) + + endif + + FW_OLD(:,:,iblock) = FW(:,:,iblock) + + end do ! block loop + !$OMP END PARALLEL DO + + + tmptime = oldtime + oldtime = curtime + curtime = newtime + newtime = tmptime + + endif + + +!----------------------------------------------------------------------- +! +! end of timestep, all variables updated +! compute and print some more diagnostics +! +!----------------------------------------------------------------------- + + if ( liceform .and. check_time_flag(ice_cpl_flag) ) then + !$OMP PARALLEL DO + do iblock = 1,nblocks_clinic + call ice_flx_to_coupler(TRACER(:,:,:,:,curtime,iblock),iblock) + call accumulate_tavg_field(QFLUX(:,:,iblock), tavg_id('QFLUX'), & + iblock,1,const=tlast_ice) + + end do ! block loop + !$OMP END PARALLEL DO +!----------------------------------------------------------------------- +! time-averaging for ice formation related quantities +!----------------------------------------------------------------------- +!!!! if (nt > 2) call tavg_FvICE_compute + endif + + call diag_global_afterupdate + call diag_print + call diag_transport + + if ( eod ) then + call diag_velocity + endif + + if ( ldiag_global_tracer_budgets .and. & + time_to_do(check_time_flag_freq_opt(tavg_flag), & + check_time_flag_freq(tavg_flag) )) then + call tracer_budgets + endif + + +!----------------------------------------------------------------------- +! +! display vertically integrated velocity and surface height in +! X window if requested (use DHU, DH as temp arrays to store these). +! +!----------------------------------------------------------------------- + + if (lxdisplay .and. & + time_to_do(freq_opt_nstep,nstep_xdisplay)) then + + do iblock = 1,nblocks_clinic + + !*** store integrated velocity in DHU + + DH(:,:,iblock) = HU(:,:,iblock)* & + sqrt(UBTROP(:,:,curtime,iblock)**2 + & + VBTROP(:,:,curtime,iblock)**2) + + !*** integrated velocity at t-pts + call ugrid_to_tgrid(DHU(:,:,iblock),DH(:,:,iblock),iblock) + + DH(:,:,iblock) = PSURF(:,:,curtime,iblock)/grav ! surface height + end do ! block loop + + call display(DHU, field_loc_NEcorner, & + DH , field_loc_center) + + endif ! xdisplay + + 1001 format (/, 10x, 'VOLUME AND TRACER BUDGET INITIALIZATION:', & + /, 10x, '========================================', & + /, 5x, ' volume_t (cm^3) = ', e18.12, & + /, 5x, ' SUM [volume*T] (C cm^3) = ', e18.12, & + /, 5x, ' SUM [volume*S] (ppt cm^3) = ', e18.12 ) + + +!----------------------------------------------------------------------- +!EOC + + end subroutine step + +!*********************************************************************** + + end module step_mod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/time_management.F90 b/components/cism/source_glc/POP_files/time_management.F90 new file mode 100644 index 0000000000..ed8b11a32f --- /dev/null +++ b/components/cism/source_glc/POP_files/time_management.F90 @@ -0,0 +1,4656 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module time_management + +!BOP +! !MODULE: time_management + +! !DESCRIPTION: +! This module contains a large number of routines for calendar, time +! flags and other functions related to model time. +! +! !REVISION HISTORY: +! SVN:$Id: time_management.F90 923 2006-05-10 22:25:10Z njn01 $ +! +! !USES: + + use kinds_mod + use constants + use blocks + use domain_size + use domain + use broadcast + use grid + use io + use io_tools + use exit_mod + use registry + use shr_sys_mod + + implicit none + public + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_time1, & + init_time2, & + time_manager, & + init_time_flag, & + set_time_flag, & + set_time_flag_last, & + check_time_flag, & + check_time_flag_freq_opt, & + check_time_flag_freq, & + time_to_do, & + time_to_start, & + time_stamp, & + int_to_char, & + ccsm_date_stamp + + +! !PUBLIC DATA TYPES: + + type time_flag + + character (char_len) :: & + name ! name for flag + + logical (log_kind) :: & + value, &! logical state of flag + old_value, &! last state of flag + default, &! default state of flag + has_default ! T if default defined, F if no default + + integer (int_kind) :: & + freq_opt, &! frequency units for switching flag on + freq ! freq in above units for switching flag + + end type + +! !PUBLIC DATA MEMBERS: + +!----------------------------------------------------------------------- +! +! variables for run control +! +!----------------------------------------------------------------------- + + character (char_len) :: & + stop_option ,&! specify how to determine stopping time + runid ,&! an identifier for the run + dt_option ! method to determine tracer timestep size + + integer (int_kind) :: & + stop_count ,&! num of stop_option intervals before stop + ! OR date (yyyymmdd) at which model stops + stop_iopt ,&! integer value for stop_option + nsteps_total ,&! steps (full&half) since beginning of run sequence + nsteps_run ,&! steps taken since beginning of this run + nsteps_per_day ,&! integer number of steps per day + len_runid ! length of character runid + + integer (int_kind) :: &! variables used with avgfit + fit_freq , &! num of intervals/day into which full & + ! half timesteps must exactly "fit" + fullsteps_per_interval, &! num of full timesteps per fitting interval + halfsteps_per_interval, &! num of half timesteps per fitting interval + fullsteps_per_day , &! num of full timesteps per day + halfsteps_per_day , &! num of half timesteps per day + nsteps_per_interval , &! number of steps in each 'fit' interval + nsteps_this_interval ! number of steps in current 'fit' interval + + integer (int_kind), private :: & + stop_now ,&! time_flag id for stopping + coupled_ts ! time_flag id for a coupled timestep + + logical (log_kind) :: &! this timestep is: + adjust_year ,&! step at which year values updated + eod ,&! at the end of the day + eom ,&! at the end of the month + eoy ,&! at the end of the year + avg_ts ,&! an averaging timestep + back_to_back ,&! the second of two avg timesteps in row + f_euler_ts ,&! a forward Euler timestep (first ts) + first_step ,&! first time step + leapfrogts ,&! a leapfrog timestep + matsuno_ts ,&! an Euler-backward timestep + midnight ,&! at midnight + ice_ts ,&! an ice-formation timestep + sample_qflux_ts ! time to sample qflux for time avg + + logical (log_kind) :: &! the last timestep was: + eod_last ,&! at the end of the day + eom_last ,&! at the end of the month + eoy_last ,&! at the end of the year + midnight_last ! at midnight + + logical (log_kind) :: &! the next timestep is: + adjust_year_next ,&! step at which year values updated + eom_next ,&! at the end of the month + midnight_next ,&! at midnight + avg_ts_next ,&! an averaging ts? + back_to_back_next ,&! a second avg step in a row + end_run_at_midnight ,&! does model run end at midnight + new_dtt_value ! does restart have a new step size + + real (r8) :: & + steps_per_year ,& ! number of timesteps in one year + steps_per_day ,& ! number of timesteps in one day + dt_tol ,& ! used to determine close enough + dt_tol_year ! used to determine if seconds_this_year + ! is close enough to seconds_in_year + +!----------------------------------------------------------------------- +! +! quantities related to date +! +!----------------------------------------------------------------------- + + character (1) :: & + date_separator ! character to separate year-month-day + + integer (int_kind) :: & + iyear ,&! year [0,inf) for present timestep + imonth ,&! month [1,12] | + iday ,&! day [1,31] | + ihour ,&! hour [0,23] | + iminute ,&! minute [0,59] | + isecond ,&! second [0,59] | + iday_of_year ! day no. [1,365/6] V + + integer (int_kind) :: & + imonth_next ,&! month [1,12] for next timestep + iday_next ,&! day [1,31] | + ihour_next ,&! hour [0,23] | + iminute_next ,&! minute [0,59] | + isecond_next ,&! second [0,59] | + iday_of_year_next ! day no. [1,365/6] V + + integer (int_kind) :: & + iyear_last ,&! year [0,inf) from previous timestep + imonth_last ,&! month [1,12] | + iday_last ,&! day [1,31] | + ihour_last ,&! hour [0,23] | + iday_of_year_last ! day no. [1,365/6] V + + integer (int_kind) :: & + iyear0 ,&! initial start date and time + imonth0 ,&! for complete run + iday0 ,&! + ihour0 ,&! + iminute0 ,&! + isecond0 ! + + + integer (int_kind) :: & + iyear_start_run ,&! initial start date and time + imonth_start_run ,&! for this run + iday_start_run ,&! + ihour_start_run ,&! + iminute_start_run ,&! + isecond_start_run ,&! + iday_of_year_start_run ! + + integer (int_kind) :: & + iyear_end_run ,&! final date for this run + imonth_end_run ,&! + iday_end_run ! + + integer (int_kind) :: &! number of: + days_in_year ,&! days in present year + days_in_prior_year ,&! days in prior year + elapsed_days ,&! full days elapsed since 01-01-0000 + elapsed_days0 ,&! full days elapsed between 01-01-0000 + ! and day0 + elapsed_days_jan1 ,&! full days elapsed prior to 01-01-iyear + elapsed_days_this_run ,&! full days elapsed since beginning of + ! this segment of run + elapsed_days_this_year ,&! full days elapsed since beginning of yr + elapsed_days_init_date ,&! full days elapsed since initial time + elapsed_days_end_run ,&! full days elapsed from 01-01-0000 to end + ! of this run + elapsed_days_max ,&! maximum number of full days allowed + elapsed_months ,&! full months elapsed since 01-01-0000 + elapsed_months_this_run ,&! full months elapsed since beginning of + ! this segment of run + elapsed_months_init_date,&! full months elapsed since initial time + elapsed_years ,&! full years elapsed since 01-01-0000 + elapsed_years_this_run ,&! full years elapsed since beginning of + ! this segment of run + elapsed_years_init_date ! full years elapsed since initial time + + integer (int_kind), parameter :: & + days_in_leap_year = 366, & ! days in a leap year + days_in_norm_year = 365 ! days in a non-leap year + + integer (int_kind), dimension(12) :: & + days_in_prior_months, &! cumulative num days in preceeding months + days_in_month = &! number of days in each calendar month + (/31,28,31, 30,31,30, 31,31,30, 31,30,31/) + ! J F M A M J J A S O N D + + real (r8) :: & + seconds_this_year ,&! seconds elapsed since beginning of year + seconds_this_day ,&! seconds elapsed this day + seconds_this_day_next ,&! seconds elapsed this day at next timestep + seconds_this_year_next ,&! seconds elapsed this year at next timestep + seconds_in_year ,&! seconds in one year -- this varies, + ! if leap years are allowed + hours_in_year ! hours in one year + + real (r8) :: & + frac_day ,&! fraction of the day elapsed today + tyear ,&! decimal elapsed time in years + tmonth ,&! decimal elapsed time in months + tday ,&! decimal elapsed time in days + thour ,&! decimal elapsed time in hours + tsecond ,&! decimal elapsed time in seconds + tsecond_old ! tsecond from previous timestep + + logical (log_kind) :: & + newday ,&! + newhour ,&! + allow_leapyear ,&! allow leap years? + leapyear ! is this a leapyear? + + character (4) :: & + cyear ! character version of year + + character (2) :: & + cmonth ,&! character version of month + cday ,&! character version of day + chour ,&! character version of hour + cminute ,&! character version of minute + csecond ! character version of second + + character (3) :: & + cmonth3 ! character month in 3-letter form + + character (3), dimension(12), parameter :: & + month3_all = (/'jan','feb','mar','apr','may','jun', & + 'jul','aug','sep','oct','nov','dec'/) + + character (2), dimension(12), parameter :: & + cmonths = (/'01','02','03','04','05','06', & + '07','08','09','10','11','12'/) + + character (2), dimension(31), parameter :: & + cdays = (/'01','02','03','04','05','06','07','08','09','10', & + '11','12','13','14','15','16','17','18','19','20', & + '21','22','23','24','25','26','27','28','29','30', & + '31'/) + + real (r8), parameter :: & + seconds_in_minute = 60.0_r8, & + seconds_in_hour = 3600.0_r8, & + seconds_in_day = 86400.0_r8, & + minutes_in_hour = 60.0_r8 + + !*** for forcing calendar + + real (r8), public :: & + tyear00 ,&! + tsecond00 ,&! + tday00 ,&! + thour00 ,&! + thour00_begin_this_year + + real (r8), dimension(12) :: & + thour00_midmonth_calendar,&! num hours to middle of calendar month + thour00_endmonth_calendar,&! num hours to end of calendar month + thour00_midmonth_equal ,&! num hours to middle of equal-spaced month + thour00_endmonth_equal ! num hours to end of equal-spaced month + +!----------------------------------------------------------------------- +! +! parameters for time frequency and start options +! +!----------------------------------------------------------------------- + + integer (int_kind), parameter :: &! integer choices for freq option + freq_opt_never = 0, & + freq_opt_nyear = 1, & + freq_opt_nmonth = 2, & + freq_opt_nday = 3, & + freq_opt_nhour = 4, & + freq_opt_nsecond = 5, & + freq_opt_nstep = 6 + + integer (int_kind), parameter :: &! integer choices for start options + start_opt_nstep = 1, & + start_opt_nday = 2, & + start_opt_nyear = 3, & + start_opt_date = 4 + + integer (int_kind), parameter :: & + next_opt_day = 1, & + next_opt_month = 2, & + next_opt_year = 3, & + stop_opt_never = 0, & + stop_opt_sometime = 1 + +!----------------------------------------------------------------------- +! +! user defined time flags +! +!----------------------------------------------------------------------- + + integer (int_kind), parameter :: & + max_time_flags=99 ! max number of user-defined flags + + type (time_flag), dimension(max_time_flags) :: & + time_flags ! array containing user-defined flags + + integer (int_kind) :: & + num_time_flags = 0 + +!----------------------------------------------------------------------- +! +! time-step related constants and variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + laccel ! flag for acceleration + + real (r8) :: & + dt_count ,&! input count to determine dtt + dtt ,&! tracer timestep (sec) + dtt_input ,&! tracer timestep (sec) as specified in namelist + ! input; may be different from restart value + dtu ,&! momentum timestep (sec) + dtp ,&! barotropic timestep (sec) + c2dtu ,&! + c2dtp ,&! + c2dtq ,&! + dtuxcel ,&! factor to multiply MOMENTUM timestep + stepsize ,&! size of present timestep (sec) + stepsize_next ! size of next timestep (sec) + + real (r8), dimension(km) :: & + dttxcel ,&! array for depth-dependent acceleration + dt ,&! time step at each level + c2dtt ,& + dztxcel ,& + dzwxcel + +!----------------------------------------------------------------------- +! +! time-centering and mixing variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + impcor ! implicit treatment of Coriolis terms + + integer (int_kind), parameter :: & + tmix_matsuno = 1, &! use matsuno step for time mixing + tmix_avg = 2, &! use averaging step for time mixing + tmix_avgbb = 3, &! use averaging step for time mixing, with + ! back_to_back option to keep time boundaries + tmix_avgfit = 4 ! use averaging step for time mixing, + ! selecting the timestep size in such + ! a way as to force the end of the day + ! (or interval) to coincide with the end of + ! a timestep + + integer (int_kind) :: & + tmix_iopt, &! option for which time mixing to use + time_mix_freq, &! frequency of mixing + mix_pass ! number of passes to perform mixing + + real (r8) :: & + beta ! = {alpha,theta} on {leapfrog,Matsuno} steps + + real (r8), parameter :: & + alpha = c1/c3, &! leapfrog grap(ps) time-centering param + theta = p5, &! Matsuno grap(ps) time-centering param + gamma = c1 - c2*alpha ! for geostrophic balance, otherwise + ! coriolis and surface-pressure gradient + ! are not time centered + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! a few private variables used only internally +! +!----------------------------------------------------------------------- + + real (r8), private :: & + rhour_next, &! rhour for next timestep + rminute_next, &! rminute for next timestep + rsecond_next ! rsecond for next timestep + + logical (kind=log_kind),private :: & + debug_time_management = .false. + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_time1 +! !INTERFACE: + + subroutine init_time1 + +! !DESCRIPTION: +! Initializes some time manager variables from namelist inputs +! and sets time step. Remaining time manager variables are +! initialized after restart files are read. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k, &! vertical level index + nu, &! i/o unit number + nm ! month index + +!----------------------------------------------------------------------- +! +! namelist input +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nml_error ! namelist i/o error flag + + character (char_len) :: & + time_mix_opt, &! option for time mixing (Matsuno,averaging) + accel_file, &! file containing acceleration factors + message + + namelist /time_manager_nml/ & + runid, time_mix_opt, time_mix_freq, & + impcor, laccel, accel_file, & + dtuxcel, iyear0, imonth0, & + iday0, ihour0, iminute0, & + isecond0, dt_option, dt_count, & + stop_option, stop_count, date_separator, & + allow_leapyear, fit_freq + + + +!----------------------------------------------------------------------- +! +! Set logical flags to default values. +! +!----------------------------------------------------------------------- + + stop_now = init_time_flag('stop_now' ,default=.false.) + coupled_ts = init_time_flag('coupled_ts') + + call reset_switches + +!----------------------------------------------------------------------- +! +! set initial values for namelist inputs +! +!----------------------------------------------------------------------- + + runid = 'unknown_runid' + impcor = .true. + time_mix_opt = 'avgfit' + fit_freq = 1 + time_mix_freq = 17 + dtuxcel = c1 + laccel = .false. + accel_file = 'unknown_accel_file' + allow_leapyear = .false. + stop_option = 'unknown_stop_option' + stop_count = -1 + dt_option = 'auto_dt' + dt_count = 1 + + dt_tol = 1.0e-6 + dt_tol_year= 100.0*dt_tol + + iyear0 = 0 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + + date_separator = ' ' + +!----------------------------------------------------------------------- +! +! read options from namelist input file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=time_manager_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_POP(sigAbort,'ERROR reading time_manager_nml') + endif + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' Time Management:' + write(stdout,blank_fmt) + write(stdout,*) ' time_manager_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout,time_manager_nml) + write(stdout,blank_fmt) + endif + + if (my_task == master_task) then + select case (time_mix_opt) + case ('matsuno') + tmix_iopt = tmix_matsuno + case ('avg') + tmix_iopt = tmix_avg + case ('avgbb') + tmix_iopt = tmix_avgbb + case ('avgfit') + tmix_iopt = tmix_avgfit + case default + tmix_iopt = -1000 + end select + endif + + call broadcast_scalar (runid , master_task) + call broadcast_scalar (tmix_iopt , master_task) + call broadcast_scalar (fit_freq , master_task) + call broadcast_scalar (time_mix_freq , master_task) + call broadcast_scalar (impcor , master_task) + call broadcast_scalar (laccel , master_task) + call broadcast_scalar (dtuxcel , master_task) + call broadcast_scalar (iyear0 , master_task) + call broadcast_scalar (imonth0 , master_task) + call broadcast_scalar (iday0 , master_task) + call broadcast_scalar (ihour0 , master_task) + call broadcast_scalar (iminute0 , master_task) + call broadcast_scalar (isecond0 , master_task) + call broadcast_scalar (dt_option , master_task) + call broadcast_scalar (dt_count , master_task) + call broadcast_scalar (stop_option , master_task) + call broadcast_scalar (stop_count , master_task) + call broadcast_scalar (allow_leapyear , master_task) + call broadcast_scalar (date_separator , master_task) + + +!----------------------------------------------------------------------- +! +! error checking +! +!----------------------------------------------------------------------- + + if (tmix_iopt == -1000) then + call exit_POP(sigAbort,'unknown option for time mixing') + endif + + if (tmix_iopt == tmix_matsuno) then + message = ' matsuno time-mixing option is not supported in CCSM; ' /& + &/' budget diagnostics are incorrect with matsuno and tavg may be incorrect' + call exit_POP(sigAbort,message) + endif + + + len_runid = len_trim(runid) + +!----------------------------------------------------------------------- +! +! determine the value for dtt, based upon model input parameters +! +!----------------------------------------------------------------------- + + select case (dt_option) + + case('auto_dt') + !*** scale tracer timestep dt = 1 hr at dx = 2 degrees + dtt = seconds_in_hour*(180.0_r8/float(nx_global)) + steps_per_day = seconds_in_day/dtt + steps_per_year = steps_per_day*days_in_norm_year + + case('steps_per_year') + steps_per_year = dt_count + steps_per_day = steps_per_year/days_in_norm_year + dtt = seconds_in_day/steps_per_day + + case('steps_per_day') + steps_per_day = dt_count + steps_per_year = steps_per_day*days_in_norm_year + dtt = seconds_in_day/steps_per_day + + case('seconds') + dtt = dt_count + steps_per_day = seconds_in_day/dtt + steps_per_year = steps_per_day *days_in_norm_year + + case('hours' ) + dtt = dt_count*seconds_in_hour + steps_per_day = seconds_in_day/dtt + steps_per_year = steps_per_day*days_in_norm_year + + case default + call exit_POP(sigAbort,'unknown dt_option') + end select + +!----------------------------------------------------------------------- +! +! modify dtt value, if using avgfit option +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_avgfit) then + + !*** determine the number of full, half, and total number of + !*** steps in each interval. an interval is typically one day, + !*** unless fit_freq is greater than one (eg, coupling + !*** frequency > 1x/day) + + nsteps_per_day = steps_per_day + fullsteps_per_interval = nsteps_per_day/fit_freq + if (fullsteps_per_interval < 1) fullsteps_per_interval = 1 + halfsteps_per_interval = 1 + & + nsteps_per_day/(fit_freq*time_mix_freq) + nsteps_per_interval = fullsteps_per_interval + & + halfsteps_per_interval + + !*** is an adjustment to the number of half and full steps in + !*** each interval needed? + + if ((fullsteps_per_interval/time_mix_freq) < & + (nsteps_per_interval /time_mix_freq) ) then + halfsteps_per_interval = halfsteps_per_interval + 1 + nsteps_per_interval = nsteps_per_interval + 1 + endif + + !*** determine the number of half, full, and total steps in + !*** each day + + fullsteps_per_day = fit_freq*fullsteps_per_interval + halfsteps_per_day = fit_freq*halfsteps_per_interval + nsteps_per_day = fullsteps_per_day + halfsteps_per_day + + !*** compute modified dtt value + + dtt = seconds_in_day/(fullsteps_per_day + 0.5*halfsteps_per_day) + steps_per_day = seconds_in_day/dtt + + else + nsteps_per_interval = steps_per_day + endif + + dtt_input = dtt + dtp = dtt + dtu = dtt + +!----------------------------------------------------------------------- +! +! multiply tracer timestep by acceleration factor(s) +! for depth varying acceleration factors, create several arrays +! to store the variable timestep (dt) and some +! combination dz/dttxcel arrays for use in convective adjustment. +! +!----------------------------------------------------------------------- + + if (laccel) then + + call get_unit(nu) + if (my_task == master_task) then + + open(nu, file=accel_file, status = 'old') + do k = 1,km + read(nu,*) dttxcel(k) + end do + + if (dttxcel(1) /= c1) then ! make sure no accel in top layer + write(stdout,'(a36)') 'no acceleration allowed in top layer' + write(stdout,'(a36)') 'resetting acceleration factor to 1.0' + dttxcel(1) = c1 + endif + + close(nu) + endif + call release_unit(nu) + + call broadcast_array(dttxcel, master_task) + + else + + dttxcel = c1 + + endif + + do k = 1,km + dt(k) = dtt*dttxcel(k) + dztxcel(k) = dz(k)/dttxcel(k) + enddo + do k = 1,km-1 + dzwxcel(k) = c1/(dztxcel(k) + dztxcel(k+1)) + enddo + dzwxcel(km) = c0 + + dtu = dtu*dtuxcel + dtp = dtp*dtuxcel + if (dtuxcel /= c1 .and. my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,'(a39)') ' MOMENTUM TIMESTEP ACCELERATION ACTIVE' + endif + +!----------------------------------------------------------------------- +! +! set initial values; some of these may be overwritten by +! restart input +! +!----------------------------------------------------------------------- + + eom_next = .false. + eom_last = .false. + eod_last = .false. + eoy_last = .false. + midnight_last = .false. + + iyear = iyear0 + imonth = imonth0 + iday = iday0 + ihour = ihour0 + iminute = iminute0 + isecond = isecond0 + + nsteps_total = 0 + + seconds_this_day = ihour0 *seconds_in_hour + & + iminute0*seconds_in_minute + & + isecond0 + +!----------------------------------------------------------------------- +! +! define days_in_prior_months; leap-year adjustments are made in +! subroutine init_timemanager_2 +! +!----------------------------------------------------------------------- + + call prior_days (days_in_prior_months, days_in_month) + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! Register init_time1 +! +!----------------------------------------------------------------------- + call register_string('init_time1') + + call flushm (stdout) +!EOC + + end subroutine init_time1 + +!*********************************************************************** +!BOP +! !IROUTINE: init_time2 +! !INTERFACE: + + subroutine init_time2 + +! !DESCRIPTION: +! Completes initialization of time manager quantities now that +! information from restart files is known +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nm, &! month index + days_in_month_temp, &! temp for days in month + days_in_year_end_run, &! temp for days in last year of run + ndays_temp ! temp for number of days + + logical (log_kind) :: & + leapyear_test ! test for leap year + + character (4) :: & + cyear_end_run ! character version of ending year + + character (2) :: & + cmonth_end_run, &! character version of ending month + cday_end_run ! character version of ending day + + character (*), parameter :: & + date_fmt = "(a17, 2x, a4,'-',a2,'-',a2)" + +!----------------------------------------------------------------------- +! +! register init_time2, then determine if both init_time1 +! and init_ts have been registered +! +!----------------------------------------------------------------------- + call register_string ('init_time2') + call registry_err_check('init_time1', .true., & + caller='init_time2' ) + call registry_err_check('init_ts', .true., & + caller= 'init_time2' ) + +!----------------------------------------------------------------------- +! +! determine the number of days, months, and years elapsed since +! 01-01-0000 and number of days and months elapsed this year +! +!----------------------------------------------------------------------- + + call ymd2eday (iyear , imonth , iday , elapsed_days ) + call ymd2eday (iyear , 1 , 1 , elapsed_days_jan1) + call ymd2eday (iyear0, imonth0, iday0, elapsed_days0 ) + + elapsed_days_this_year = elapsed_days - elapsed_days_jan1 + + elapsed_years = iyear + elapsed_months = iyear*12 + imonth - 1 + elapsed_days_this_run = 0 + elapsed_years_this_run = 0 + elapsed_months_this_run = 0 + elapsed_days_init_date = elapsed_days - elapsed_days0 + elapsed_years_init_date = iyear - iyear0 + elapsed_months_init_date = elapsed_years_init_date*12 - & + imonth0 + imonth + + seconds_this_year = elapsed_days_this_year*seconds_in_day + & + seconds_this_day + iday_of_year = elapsed_days_this_year + 1 + +!----------------------------------------------------------------------- +! +! determine tsecond, the number of seconds elapsed since beginning +! of complete simulation. +! +!----------------------------------------------------------------------- + + tsecond = elapsed_days_init_date*seconds_in_day + seconds_this_day + +!----------------------------------------------------------------------- +! +! compare the value of dtt selected for this run via namelist input +! with that from the previous run. if different, time_manager +! will execute as if it were not a restart. +! +!----------------------------------------------------------------------- + + if (dtt /= dtt_input ) then + new_dtt_value = .true. + dtt = dtt_input + endif + +!----------------------------------------------------------------------- +! +! determine if this is a leap year; set days_in_year and +! days_in_prior_months, regardless of value of allow_leapyear +! +!----------------------------------------------------------------------- + + call leap_adjust + + if (iyear > 0 .and. is_leapyear(iyear-1) ) then + days_in_prior_year = days_in_leap_year + else + days_in_prior_year = days_in_norm_year + endif + +!----------------------------------------------------------------------- +! +! check initial iday, imonth, etc values for reasonableness +! +!----------------------------------------------------------------------- + + if ( .not. valid_ymd_hms () ) then + call exit_POP(sigAbort,'invalid ymd_hms') + endif + +!----------------------------------------------------------------------- +! +! Compute decimal time in days, months, years, etc +! NOTE: newhour is not set initially +! +!----------------------------------------------------------------------- + + call get_tday + + call int_to_char(4,iyear,cyear) + cday = cdays (iday) + cmonth = cmonths (imonth) + cmonth3 = month3_all(imonth) + + nsteps_this_interval = 0 + nsteps_run = 0 + +!----------------------------------------------------------------------- +! +! thour00_begin_this_year, thour00_midmonth_{equal,calendar} and +! thour00_endmonth_{equal,calendar} are used in forcing routines +! with the 'monthly-equal' or 'monthly-calendar' option for +! forcing_data_freq, where 'monthly-equal' designates 12 equally +! spaced months of length 365/12 days and 'monthly-calendar' uses +! the non-leapyear calendar. +! +! thour00_midmonth_{equal,calendar} and +! thour00_endmonth_{equal,calendar} +! are relative to the beginning of the year, so vary between +! 0 and 365*24. +! +!----------------------------------------------------------------------- + + thour00_begin_this_year = thour00 - & + (seconds_this_year/seconds_in_hour) + + thour00_midmonth_calendar(1) = 24.0_r8*p5*days_in_month(1) + thour00_endmonth_calendar(1) = 24.0_r8*days_in_month(1) + + thour00_endmonth_equal(1) = hours_in_year/12.0_r8 + thour00_midmonth_equal(1) = p5*thour00_endmonth_equal(1) + + do nm = 2,12 + + thour00_endmonth_calendar(nm) = thour00_endmonth_calendar(nm-1) & + + 24.0_r8*days_in_month(nm) + thour00_midmonth_calendar(nm) = thour00_endmonth_calendar(nm-1) & + + 24.0_r8*p5*days_in_month(nm) + + thour00_endmonth_equal(nm) = thour00_endmonth_equal(1)*nm + thour00_midmonth_equal(nm) = thour00_midmonth_equal(nm-1) + & + thour00_endmonth_equal(1) + + enddo + +!----------------------------------------------------------------------- +! +! set midnight +! +!----------------------------------------------------------------------- + + if (ihour == 0 .and. iminute == 0 .and. isecond == 0) then + midnight = .true. + else + midnight = .false. + endif + +!----------------------------------------------------------------------- +! +! save iyear, imonth, etc from the beginning of this run +! +!----------------------------------------------------------------------- + + iyear_start_run = iyear + imonth_start_run = imonth + iday_start_run = iday + ihour_start_run = ihour + iminute_start_run = iminute + isecond_start_run = isecond + + iday_of_year_start_run = iday_of_year + +!----------------------------------------------------------------------- +! +! error checking -- after restart file has been read +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_avgfit) then + if (.not. midnight) then + call exit_POP(sigAbort, & + 'model run must start at day boundary '/& + &/'when using avgfit option') + endif + endif + +!----------------------------------------------------------------------- +! +! will this run end exactly at midnight? +! (this tests only obvious possibilities) +! +!----------------------------------------------------------------------- + + if ( is_near (mod (seconds_in_day, dtt),c0,dt_tol) .and. & + is_near (seconds_this_day, c0,dt_tol) ) then + end_run_at_midnight = .true. + else + end_run_at_midnight = .false. + endif + + if (tmix_iopt == tmix_avgfit) end_run_at_midnight = .true. + +!----------------------------------------------------------------------- +! +! determine iyear, imonth, and iday for the end of this run +! +!----------------------------------------------------------------------- + + stop_iopt = stop_opt_sometime + + select case (stop_option) + + case ('never') !*** coupler or signal catcher stops POP + + stop_iopt = stop_opt_never + iyear_end_run = 9999 + imonth_end_run = 1 + iday_end_run = 1 + elapsed_days_max = 1e9 + + case ('eoy') !*** stop at end of stop_count years + + if (end_run_at_midnight) then + iyear_end_run = iyear + stop_count + imonth_end_run = 1 + iday_end_run = 1 + else + if (imonth == 12 .and. iday == 31) then + iyear_end_run = iyear + stop_count + else + iyear_end_run = iyear + stop_count - 1 + endif + imonth_end_run = 12 + iday_end_run = 31 + endif + + case ('eom') !*** stop at end of stop_count months + + iyear_end_run = iyear + imonth_end_run = imonth + stop_count + + call reduce_months (imonth_end_run, iyear_end_run ) + + if (end_run_at_midnight) then + iday_end_run = 1 + else + iday_end_run = days_in_month(imonth_end_run) + endif + + case ('eod') !*** stop at end of stop_count days + + if (end_run_at_midnight) then + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count + else + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count - 1 + endif + + case ('nyear', 'nyears') !*** stop after stop_count years + !*** need not be end of year + + iyear_end_run = iyear + stop_count + imonth_end_run = imonth + iday_end_run = iday + if (allow_leapyear .and. is_leapyear(iyear_end_run)) then + days_in_year_end_run = days_in_leap_year + else + days_in_year_end_run = days_in_norm_year + endif + if (is_near(mod(seconds_in_day*days_in_year_end_run, dtt), & + c0, dt_tol) ) then + end_run_at_midnight = .true. + else + end_run_at_midnight = .false. + endif + + case ('nmonth', 'nmonths') !*** stop after stop_count months + !*** need not be end of month + iyear_end_run = iyear + imonth_end_run = imonth + stop_count + iday_end_run = iday + + call reduce_months (imonth_end_run, iyear_end_run ) + + case ('nday', 'ndays') !*** stop after stop_count days + !*** identical to 'eod' + + if (end_run_at_midnight) then + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count + else + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count - 1 + endif + + case ('nstep', 'nsteps') !*** stop after stop_count steps + + ndays_temp = stop_count/steps_per_day + iday_end_run = iday + ndays_temp + iyear_end_run = iyear + imonth_end_run = imonth + + case ('date') + + call date2ymd (stop_count, iyear_end_run, & + imonth_end_run, iday_end_run) + + case default + call exit_POP(sigAbort,'Invalid stop_option: '/& + &/stop_option) + end select + +!----------------------------------------------------------------------- +! +! if necessary, adjust iyear_end_run, imonth_end_run, iday_end_run +! +!----------------------------------------------------------------------- + + if (is_leapyear(iyear_end_run)) then + leapyear_test = .true. + else + leapyear_test = .false. + endif + + if (imonth_end_run == 2 .and. stop_option == 'eom' ) then + + if (end_run_at_midnight) then + imonth_end_run = 3 + iday_end_run = 1 + else if (leapyear_test) then + imonth_end_run = 2 + iday_end_run = 29 + else + imonth_end_run = 2 + iday_end_run = 28 + endif + + else if (imonth_end_run == 2 .and. iday_end_run == 29) then + + if (.not. leapyear_test) then + if (end_run_at_midnight) then + imonth_end_run = 3 + iday_end_run = 1 + else + imonth_end_run = 2 + iday_end_run = 28 + endif + endif + + else + + if (imonth_end_run == 2 .and. leapyear_test) then + days_in_month_temp = 29 + else + days_in_month_temp = days_in_month(imonth_end_run) + endif + + do while (iday_end_run > days_in_month_temp) + + iday_end_run = iday_end_run - days_in_month_temp + imonth_end_run = imonth_end_run + 1 + + call reduce_months (imonth_end_run, iyear_end_run ) + + if (allow_leapyear .and. is_leapyear(iyear_end_run)) then + leapyear_test = .true. + else + leapyear_test = .false. + endif + + if (imonth_end_run == 2 .and. is_leapyear(iyear_end_run)) then + days_in_month_temp = 29 + else + days_in_month_temp = days_in_month(imonth_end_run) + endif + + enddo + + endif + + + call ymd2eday (iyear_end_run, imonth_end_run, iday_end_run, & + elapsed_days_end_run) + + if (stop_iopt /= stop_opt_never) & + elapsed_days_max = elapsed_days_end_run + & + (dtt+dt_tol)/seconds_in_day + + if (elapsed_days_end_run < elapsed_days ) then + call int_to_char(4, iyear_end_run, cyear_end_run) + cmonth_end_run = cmonths(imonth_end_run) + cday_end_run = cdays (iday_end_run ) + if (my_task == master_task) then + write(stdout,'(a50)') & + ' Cannot end at a date earlier than starting date.' + write(stdout,date_fmt) ' Starting date: ', cyear,cmonth,cday + if (stop_iopt /= stop_opt_never) then + write(stdout,date_fmt) ' Ending date: ', & + cyear_end_run, cmonth_end_run, & + cday_end_run + else + write(stdout,'(a17)') ' No ending date.' + write(stdout,'(a47)') & + ' Model relies on external signal for stopping.' + endif + endif + call exit_POP(sigAbort,'invalid end date') + endif + +!----------------------------------------------------------------------- +! +! print various time manager options to log (stdout) +! +!----------------------------------------------------------------------- + + call write_time_manager_options + +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + end subroutine init_time2 + +!*********************************************************************** +!BOP +! !IROUTINE: time_manager +! !INTERFACE: + + subroutine time_manager (lcoupled, liceform) + +! !DESCRIPTION: +! This routine updates various time-related variables to their +! end-of-step values. It is called once at the beginning of each +! timestep. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + logical (log_kind), intent(in) :: & + lcoupled, &! flag for when model is coupled + liceform ! flag to determine when ice formation is on + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! save previous values of tsecond, isec, imin, ihour, etc +! +!----------------------------------------------------------------------- + + tsecond_old = tsecond + + iyear_last = iyear + imonth_last = imonth + iday_last = iday + iday_of_year_last = iday_of_year + ihour_last = ihour + + eod_last = eod + eom_last = eom + eoy_last = eoy + + midnight_last = midnight + +!----------------------------------------------------------------------- +! +! set logical switches to default values +! +!----------------------------------------------------------------------- + + call reset_switches + +!----------------------------------------------------------------------- +! +! increment the timestep counters +! +!----------------------------------------------------------------------- + + nsteps_run = nsteps_run + 1 + nsteps_total = nsteps_total + 1 + + if (tmix_iopt == tmix_avgfit) then + nsteps_this_interval = nsteps_this_interval + 1 + if (nsteps_this_interval > nsteps_per_interval) & + nsteps_this_interval = 1 + endif + +!----------------------------------------------------------------------- +! +! activate logical switches which depend on nsteps_run, nsteps_total +! +!----------------------------------------------------------------------- + + call set_switches + +!----------------------------------------------------------------------- +! +! determine size of this timestep +! +!----------------------------------------------------------------------- + + if (avg_ts .or. back_to_back) then + stepsize = p5*dtt + else + stepsize = dtt + endif + +!----------------------------------------------------------------------- +! +! compute seconds_this_year and seconds_the_day for this timestep +! +!----------------------------------------------------------------------- + + if (nsteps_total == 1 .or. new_dtt_value) then + seconds_this_year = seconds_this_year + stepsize + seconds_this_day = seconds_this_day + stepsize + else + seconds_this_year = seconds_this_year_next + seconds_this_day = seconds_this_day_next + endif + +!----------------------------------------------------------------------- +! +! determine the size of the next timestep +! +!----------------------------------------------------------------------- + + if ( avg_ts_next .or. back_to_back_next ) then + stepsize_next = p5*dtt + else + stepsize_next = dtt + endif + +!----------------------------------------------------------------------- +! +! compute seconds_this_year and seconds_the_day for next timestep +! +!----------------------------------------------------------------------- + + seconds_this_year_next = seconds_this_year + stepsize_next + seconds_this_day_next = seconds_this_day + stepsize_next + +!----------------------------------------------------------------------- +! +! adjust seconds counters if necessary +! +!----------------------------------------------------------------------- + + if (nsteps_total == 1 .or. new_dtt_value) then + call reduce_seconds (seconds_this_day , & + seconds_this_year , adjust_year) + call reduce_seconds (seconds_this_day_next , & + seconds_this_year_next, adjust_year_next) + else + adjust_year = adjust_year_next + call reduce_seconds (seconds_this_day_next , & + seconds_this_year_next, adjust_year_next) + endif + +!----------------------------------------------------------------------- +! +! compute present year, month, day, hour, minute, and second +! +!----------------------------------------------------------------------- + + call model_date + +!----------------------------------------------------------------------- +! +! compute decimal days, months, and years +! +!----------------------------------------------------------------------- + + call get_tday + if (ihour /= ihour_last) newhour = .true. + +!----------------------------------------------------------------------- +! +! reset thour00_begin_this_year to be the current time if new year. +! +!----------------------------------------------------------------------- + + if (eoy) thour00_begin_this_year = thour00 + +!----------------------------------------------------------------------- +! +! set all user-defined time flags +! +!----------------------------------------------------------------------- + + call set_time_flag_all + +!----------------------------------------------------------------------- +! +! ice formation or sample qflux this timestep? +! this section must follow call set_time_flag_all +! +!----------------------------------------------------------------------- + + if (liceform) then + if (lcoupled) then + + if (check_time_flag(coupled_ts) ) then + if (tmix_iopt == tmix_matsuno .or. & + tmix_iopt == tmix_avgfit ) then + ice_ts = .true. + else + call exit_POP(sigAbort, & + 'Cannot use tmix_avg or tmix_avgbb '/& + &/'with lcoupled and liceform') + endif + + if (avg_ts) call exit_POP (sigAbort, & + 'Cannot have coupled timestep '/& + &/'be an averaging timestep') + endif + + if ( tmix_iopt == tmix_avgfit ) then + if (mod(nsteps_this_interval+1,nsteps_per_interval) == 0) & + ice_ts = .true. + endif + + else ! .not. lcoupled + + if (tmix_iopt == tmix_matsuno) then + if (mod(nsteps_total,time_mix_freq) == time_mix_freq-1) & + ice_ts = .true. + else if (tmix_iopt == tmix_avgfit .or. & + tmix_iopt == tmix_avg ) then + ice_ts = .true. + else + call exit_POP (sigAbort, & + 'tmix_avgbb option is inconsistent with ice_ts') + endif + + endif ! coupled + + if (ice_ts) sample_qflux_ts = .true. + + endif ! liceform + +!----------------------------------------------------------------------- +! +! if using Matsuno with a coupled model, take a Matsuno step +! after a coupling step to guarantee conservation of integrated fluxes +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_matsuno) then + if (check_time_flag_last(coupled_ts) .and. nsteps_run > 1 ) then + matsuno_ts = .true. + leapfrogts = .false. + endif + endif + +!----------------------------------------------------------------------- +! +! stop after this timestep? +! +!----------------------------------------------------------------------- + + if (stop_option == 'nstep' .or. stop_option == 'nsteps') then + if (nsteps_run == stop_count) call set_time_flag(stop_now,.true.) + + else if (stop_iopt /= stop_opt_never .and. eod) then + + if (iyear == iyear_end_run .and. imonth == imonth_end_run & + .and. iday == iday_end_run) then + + call set_time_flag(stop_now,.true.) + + if (stop_option == 'eoy' .and. .not. eoy) then + call set_time_flag(stop_now,.false.) + endif + if (stop_option == 'eom' .and. .not. eom) then + call set_time_flag(stop_now,.false.) + endif + + else if (elapsed_days > elapsed_days_max ) then + + call set_time_flag(stop_now,.true.) + + endif + + if (stop_option == 'eoy' .and. eoy .and. & + elapsed_years_this_run == stop_count) & + call set_time_flag(stop_now,.true.) + + if (stop_option == 'eom' .and. eom .and. & + elapsed_months_this_run == stop_count) & + call set_time_flag(stop_now,.true.) + + endif + + new_dtt_value = .false. + +!----------------------------------------------------------------------- +! report ocn model time daily +!----------------------------------------------------------------------- + + if (eod) then + if (my_task == master_task) then + write(stdout,1000) iyear, cmonth3, iday, seconds_this_day + call shr_sys_flush(stdout) + endif + endif +1000 format (' (time_manager)', ' ocn date ', i4.4, '-', a3, '-', & + i2.2,', ', 1pe12.6, ' sec') + +!----------------------------------------------------------------------- +!EOC + + end subroutine time_manager + +!*********************************************************************** +!BOP +! !IROUTINE: reset_switches +! !INTERFACE: + + subroutine reset_switches + +! !DESCRIPTION: +! Sets most logical switches to default values. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- + + eod = .false. ! not end-of-day + eom = .false. ! not end-of-month + eoy = .false. ! not end-of-year + + newday = .false. ! not new day + newhour = .false. ! not new hour + + leapfrogts = .true. ! a leapfrog timestep + f_euler_ts = .false. ! not a forward Euler timestep + matsuno_ts = .false. ! not an Euler-backward timestep + avg_ts = .false. ! not a time-averaging timestep + avg_ts_next = .false. ! not the step before avg step + back_to_back = .false. ! not a second time-averaging step + back_to_back_next = .false. ! not the step before 2nd avg step + ice_ts = .false. ! not an ice timestep + sample_qflux_ts = .false. ! do not sample qflux + + call reset_time_flag_all + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_switches + +!*********************************************************************** +!BOP +! !IROUTINE: set_switches +! !INTERFACE: + + subroutine set_switches + +! !DESCRIPTION: +! Determine if logical switches should be set to non-default values +! for this timestep. The switches set in this subroutine must depend +! ONLY on nsteps\_run, or nsteps\_total. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if first step, take Euler step +! +!----------------------------------------------------------------------- + + if (first_step) then + leapfrogts = .false. + f_euler_ts = .true. + newday = .true. + first_step = .false. + endif + +!----------------------------------------------------------------------- +! +! set avg_ts flags (avg or avgbb options) +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_avg .or. tmix_iopt == tmix_avgbb) then + + if (mod(nsteps_total+1,time_mix_freq) == 0) avg_ts_next = .true. + if (mod(nsteps_total ,time_mix_freq) == 0) avg_ts = .true. + + endif + +!----------------------------------------------------------------------- +! +! set back-to-back flags (avgbb option) +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_avgbb) then + if (avg_ts) back_to_back_next = .true. + if (nsteps_total > 1 .and. & + mod(nsteps_total-1,time_mix_freq) == 0) back_to_back = .true. + endif + +!----------------------------------------------------------------------- +! +! set avg_ts flags (avgfit option) +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_avgfit) then + + if (nsteps_this_interval == 1) then + avg_ts_next = .true. + else if (nsteps_this_interval == 2) then + avg_ts = .true. + else if (mod(nsteps_this_interval+1,time_mix_freq) == 0) then + avg_ts_next = .true. + else if (mod(nsteps_this_interval ,time_mix_freq) == 0) then + avg_ts = .true. + endif + + !*** no averaging step in the first step of an interval + + if (nsteps_this_interval == nsteps_per_interval) then + avg_ts_next = .false. + endif + + endif + +!----------------------------------------------------------------------- +! +! use Euler backward timestep this timestep? +! +!----------------------------------------------------------------------- + + if (tmix_iopt == tmix_matsuno .and. nsteps_total /= 1) then + if (mod(nsteps_total,time_mix_freq) == 0 .or. & + time_mix_freq == 1) then + matsuno_ts = .true. + leapfrogts = .false. + endif + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_switches + +!*********************************************************************** +!BOP +! !IROUTINE: init_time_flag +! !INTERFACE: + + function init_time_flag(flag_name, default, freq_opt, freq) + +! !DESCRIPTION: +! Creates a user-defined time flag with optional default values +! and frequency. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + flag_name ! name for this flag + + logical (log_kind), intent(in), optional :: & + default ! default state for this flag + + integer (int_kind), intent(in), optional :: & + freq_opt, &! optional freq option for setting flag + freq ! freq in above units for setting flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + init_time_flag ! flag id which also is integer index + ! into time flag array + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy loop index + isearch ! index of flag during search + +!----------------------------------------------------------------------- +! +! search to determine if flag already exists +! +!----------------------------------------------------------------------- + + isearch = 0 + flag_search: do n=1,num_time_flags + if (trim(time_flags(n)%name) == flag_name) then + isearch = n + exit flag_search + endif + end do flag_search + +!----------------------------------------------------------------------- +! +! if no flag defined, define new flag and initialize +! +!----------------------------------------------------------------------- + + if (isearch == 0) then ! no flag exists - define new flag + + num_time_flags = num_time_flags + 1 + isearch = num_time_flags + + time_flags(isearch)%name = flag_name + + time_flags(isearch)%has_default = .false. + time_flags(isearch)%default = .false. + time_flags(isearch)%freq_opt = freq_opt_never + time_flags(isearch)%freq = 0 + time_flags(isearch)%value = .false. + time_flags(isearch)%old_value = .false. + endif + +!----------------------------------------------------------------------- +! +! set default if requested +! +! NOTE: If flag previously defined and optional arguments are +! present, this will override any previous definition of +! optional arguments. user must make sure calls do not +! contain optional arguments or else that the last call to +! this routine for a specific flag contains desired values. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! set default value of flag +! +!----------------------------------------------------------------------- + + if (present(default)) then + time_flags(isearch)%has_default = .true. + time_flags(isearch)%default = default + time_flags(isearch)%value = default + time_flags(isearch)%old_value = default + endif + +!----------------------------------------------------------------------- +! +! define optional frequency for setting flag +! +!----------------------------------------------------------------------- + + if (present(freq_opt)) then + time_flags(isearch)%freq_opt = freq_opt + time_flags(isearch)%freq = freq + endif + +!----------------------------------------------------------------------- +! +! print time_flag information for debugging purposes +! +!----------------------------------------------------------------------- + + if (debug_time_management .and. my_task == master_task) then + write(stdout,*) ' initialize time_flag(',isearch,')' + write(stdout,*) ' name = ' & + , trim(time_flags(isearch)%name) + write(stdout,*) ' has_default = ' & + , time_flags(isearch)%has_default + write(stdout,*) ' default = ' & + , time_flags(isearch)%default + write(stdout,*) ' freq_opt = ' & + , time_flags(isearch)%freq_opt + write(stdout,*) ' freq = ' & + , time_flags(isearch)%freq + write(stdout,*) ' value = ' & + , time_flags(isearch)%value + write(stdout,*) ' old_value = ' & + , time_flags(isearch)%old_value + write(stdout,*) ' ' + endif + +!----------------------------------------------------------------------- +! +! return array index as integer flag id +! +!----------------------------------------------------------------------- + + init_time_flag = isearch + +!----------------------------------------------------------------------- +!EOC + + end function init_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag +! !INTERFACE: + + subroutine set_time_flag(flag_id, value) + +! !DESCRIPTION: +! Sets the time flag given by flag\_id to the value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + + logical (log_kind), intent(in) :: & + value ! value requested for flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'set_time_flag: invalid flag_id') + + time_flags(flag_id)%value = value + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag_last +! !INTERFACE: + + subroutine set_time_flag_last(flag_id, old_value) + +! !DESCRIPTION: +! Sets the old value of time flag given by flag\_id to old\_value. +! +! !REVISION HISTORY: + +! !INPUT VARIABLES: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + + logical (log_kind), intent(in) :: & + old_value ! old value requested for flag + +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'set_time_flag: invalid flag_id') + + time_flags(flag_id)%old_value = old_value + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_time_flag_last + +!*********************************************************************** +!BOP +! !IROUTINE: reset_time_flag +! !INTERFACE: + + subroutine reset_time_flag(flag_id) + +! !DESCRIPTION: +! Sets the time flag given by flag\_id to default value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'reset_time_flag: invalid flag_id') + + if (time_flags(flag_id)%has_default) then + time_flags(flag_id)%value = time_flags(flag_id)%default + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: reset_time_flag_all +! !INTERFACE: + + subroutine reset_time_flag_all + +! !DESCRIPTION: +! Sets all time flags to default value (if exists). +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy index + +!----------------------------------------------------------------------- +! +! check all flags for default value and set value if default exists +! +!----------------------------------------------------------------------- + + do n=1,num_time_flags + if (time_flags(n)%has_default) then + time_flags(n)%value = time_flags(n)%default + endif + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_time_flag_all + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag +! !INTERFACE: + + function check_time_flag(flag_id) + +! !DESCRIPTION: +! Returns the current value of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + check_time_flag ! current value of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'check_time_flag: invalid flag_id') + + check_time_flag = time_flags(flag_id)%value + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_freq_opt +! !INTERFACE: + + function check_time_flag_freq_opt(flag_id) + +! !DESCRIPTION: +! Returns the current frequency of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + check_time_flag_freq_opt ! current freqeuncy option of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'check_time_flag: invalid flag_id') + + check_time_flag_freq_opt = time_flags(flag_id)%freq_opt + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_freq_opt + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_freq +! !INTERFACE: + + function check_time_flag_freq(flag_id) + +! !DESCRIPTION: +! Returns the current frequency of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + check_time_flag_freq ! current freqeuncy option of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'check_time_flag_freq: invalid flag_id') + + check_time_flag_freq = time_flags(flag_id)%freq + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_freq + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_last +! !INTERFACE: + + function check_time_flag_last(flag_id) + +! !DESCRIPTION: +! Returns the value of time flag given by flag\_id at previous +! time step +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + check_time_flag_last ! value of time flag at last timestep + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return old flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_POP(sigAbort,'check_time_flag_last: invalid flag_id') + + check_time_flag_last = time_flags(flag_id)%old_value + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_last + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag_all +! !INTERFACE: + + subroutine set_time_flag_all + +! !DESCRIPTION: +! Sets all time flags based on frequency options. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy index + +!----------------------------------------------------------------------- +! +! if it is time, set time flag and save value from old time +! +!----------------------------------------------------------------------- + + do n=1,num_time_flags + + if (time_flags(n)%freq_opt /= freq_opt_never) then + + time_flags(n)%old_value = time_flags(n)%value + time_flags(n)%value = time_to_do(time_flags(n)%freq_opt, & + time_flags(n)%freq) + + endif + + end do + +!----------------------------------------------------------------------- + + end subroutine set_time_flag_all + +!*********************************************************************** +!BOP +! !IROUTINE: time_to_do +! !INTERFACE: + + function time_to_do (in_freq_opt, in_freq) + +! !DESCRIPTION: +! Determines whether it is time to take a particular action based on +! input frequency options. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + in_freq_opt, &! frequency option for this action + in_freq ! frequency in above intervals for action + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + time_to_do ! true if current timestep matches input + ! frequency conditions + +!EOP +!BOC +!----------------------------------------------------------------------- + + time_to_do = .false. + + select case (in_freq_opt) + + case (freq_opt_nyear) + if (eoy .and. mod(elapsed_years_init_date,in_freq) == 0) & + time_to_do = .true. + + case (freq_opt_nmonth) + if (eom .and. mod(elapsed_months_init_date,in_freq) == 0) & + time_to_do = .true. + + case (freq_opt_nday) + if (eod) then + if (midnight) then + if (mod(elapsed_days_init_date ,in_freq) == 0) & + time_to_do = .true. + else + if (mod(elapsed_days_init_date+1,in_freq) == 0) & + time_to_do = .true. + endif + endif + + case (freq_opt_nhour) + if (newhour .and. mod(ihour,in_freq) == 0) time_to_do = .true. + + case (freq_opt_nsecond) + if (mod(isecond,in_freq) == 0) time_to_do = .true. + + case (freq_opt_nstep) + if (mod(nsteps_total,in_freq) == 0) time_to_do = .true. + + case default + end select + +!----------------------------------------------------------------------- +!EOC + + end function time_to_do + +!*********************************************************************** +!BOP +! !IROUTINE: time_to_start +! !INTERFACE: + + function time_to_start (in_start_opt, in_start) + +! !DESCRIPTION: +! Determines whether it is time to start a particular function based +! on input start options. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + in_start_opt, &! start option for this action + in_start ! start after value + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + time_to_start ! true if current timestep matches input + ! start conditions + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + eday_loc ! temporary value for elapsed days + +!----------------------------------------------------------------------- +! +! check start conditions - do not start if called from initial +! (nsteps_run == 0) and the condition matches exactly - the +! start will instead be triggered during the time step. This +! avoids looking for restarts that do not yet exist. +! +!----------------------------------------------------------------------- + + time_to_start = .false. + + select case (in_start_opt) + + case (start_opt_nstep) + if (nsteps_total > in_start) then + time_to_start = .true. + else if (nsteps_total == in_start .and. nsteps_run /= 0) then + time_to_start = .true. + endif + + case (start_opt_nday) + if (elapsed_days_init_date > in_start) then + time_to_start = .true. + else if (elapsed_days_init_date == in_start .and. & + nsteps_run /= 0) then + time_to_start = .true. + endif + + case (start_opt_nyear) + if (elapsed_years_init_date > in_start) then + time_to_start = .true. + else if (elapsed_years_init_date == in_start .and. & + nsteps_run /= 0) then + time_to_start = .true. + else if (elapsed_years_init_date == in_start .and. & + elapsed_days_this_year > 1) then + time_to_start = .true. + endif + + case (start_opt_date) + call date2eday (in_start, eday_loc) + if (elapsed_days > eday_loc) then + time_to_start = .true. + else if (elapsed_days == eday_loc .and. nsteps_run /= 0) then + time_to_start = .true. + endif + + case default + call exit_POP(sigAbort,'unknown start option in time_to_start') + end select + +!----------------------------------------------------------------------- +!EOC + + end function time_to_start + +!*********************************************************************** +!BOP +! !IROUTINE: model_date +! !INTERFACE: + + subroutine model_date + +! !DESCRIPTION: +! Determines iyear, imonth, iday, ihour, iminute, isecond, as +! well as elapsed days, months, and years +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + rhour, &! number of hours elapsed today + rminute, &! number of minutes beyond the hour + rsecond, &! number of seconds beyond the minute + seconds_today ! number of seconds elapsed today + + integer (int_kind) :: & + day_inc ! change in the number of days elapsed + ! between timesteps + + logical (log_kind), save :: & + increment_elapsed_months_next = .false., & + increment_elapsed_years_next = .false. + +!----------------------------------------------------------------------- +! +! determine iyear +! +!----------------------------------------------------------------------- + + if (adjust_year) then + iyear = iyear + 1 + days_in_prior_year = days_in_year + if (allow_leapyear) call leap_adjust + adjust_year_next = .false. + endif + +!----------------------------------------------------------------------- +! +! determine iday_of_year, imonth, iday, ihour, iminute, isecond +! rhour, rminute, rsecond +! +!----------------------------------------------------------------------- + + if (nsteps_run == 1) then + call ymd_hms( seconds_this_year, seconds_this_day, & + iday_of_year, & + imonth, iday , iday_last, & + ihour , iminute, isecond, & + rhour , rminute, rsecond, & + midnight , adjust_year) + else + iday_of_year = iday_of_year_next + imonth = imonth_next + iday = iday_next + ihour = ihour_next + iminute = iminute_next + isecond = isecond_next + rhour = rhour_next + rminute = rminute_next + rsecond = rsecond_next + midnight = midnight_next + endif + +!----------------------------------------------------------------------- +! +! determine iday_of_year, imonth, iday, etc, for next timestep +! +!----------------------------------------------------------------------- + + call ymd_hms(seconds_this_year_next, & + seconds_this_day_next, & + iday_of_year_next, & + imonth_next , iday_next , iday, & + ihour_next , iminute_next, isecond_next, & + rhour_next , rminute_next, rsecond_next, & + midnight_next, adjust_year_next) + +!----------------------------------------------------------------------- +! +! end of day? +! +!----------------------------------------------------------------------- + + if (iday_of_year_next /= iday_of_year) then + if (.not. midnight_next) eod = .true. + if (stepsize_next + dt_tol > seconds_in_day) eod = .true. + endif + + if (midnight) eod = .true. + +!----------------------------------------------------------------------- +! +! newday? (a timestep can be both eod and newday for dt > 24hrs) +! +!----------------------------------------------------------------------- + + if (iday_of_year > iday_of_year_last .and. .not. midnight) & + newday = .true. + if (eod_last ) newday = .true. + +!----------------------------------------------------------------------- +! +! end of month? +! +!----------------------------------------------------------------------- + + if (eod) then + + if (eom_next) then + eom = .true. + eom_next = .false. + else + + if (imonth_next > imonth_last .or. & + imonth_next == 1 .and. imonth_last == 12) then + + if (iday <= days_in_month(imonth_last) .and. & + midnight_next .and. iday_next == 1 ) then + eom = .false. + eom_next = .true. + + elseif (iday <= days_in_month(imonth_last) .and. & + iday_next >= 1 ) then + eom = .true. + eom_next = .false. + + elseif (midnight .and. midnight_next .and. & + midnight_last) then + eom = .false. + eom_next = .true. + else + eom = .true. + eom_next = .false. + endif + + endif + endif + + endif ! eod + +!----------------------------------------------------------------------- +! +! elapsed months (integer) +! +!----------------------------------------------------------------------- + + if ((eom .and. midnight) .or. increment_elapsed_months_next) then + elapsed_months = elapsed_months + 1 + elapsed_months_this_run = elapsed_months_this_run + 1 + elapsed_months_init_date = elapsed_months_init_date + 1 + if (increment_elapsed_months_next) & + increment_elapsed_months_next = .false. + else if (eom) then + increment_elapsed_months_next = .true. + else + increment_elapsed_months_next = .false. + endif + + if (eom_last) eom = .false. + +!----------------------------------------------------------------------- +! +! end of year? +! +!----------------------------------------------------------------------- + + if (eom .and. imonth_next == 1 .and. imonth_last == 12) eoy = .true. + +!----------------------------------------------------------------------- +! +! adjust elapsed years and elapsed days in the year (integer) +! +!----------------------------------------------------------------------- + + if ((eoy .and. midnight) .or. increment_elapsed_years_next) then + + elapsed_years = elapsed_years + 1 + elapsed_years_this_run = elapsed_years_this_run + 1 + elapsed_years_init_date = elapsed_years_init_date + 1 + + call ymd2eday (iyear , 1, 1, elapsed_days_jan1) + elapsed_days_this_year = elapsed_days - elapsed_days_jan1 + + if (increment_elapsed_years_next) & + increment_elapsed_years_next = .false. + + else if (eoy) then + increment_elapsed_years_next = .true. + else + increment_elapsed_years_next = .false. + endif + + if (eoy_last) eoy = .false. + +!----------------------------------------------------------------------- +! +! character values for iyear, imonth, iday +! +!----------------------------------------------------------------------- + + if (iyear /= iyear_last ) call int_to_char(4, iyear, cyear) + + if (imonth /= imonth_last) then + cmonth = cmonths (imonth) + cmonth3 = month3_all(imonth) + endif + + if (iday /= iday_last) cday = cdays(iday) + +!----------------------------------------------------------------------- +! +! elapsed number of days (integer) +! +!----------------------------------------------------------------------- + + if (iday_of_year >= iday_of_year_last) then + day_inc = iday_of_year - iday_of_year_last + else + day_inc = iday_of_year - iday_of_year_last + days_in_prior_year + endif + + elapsed_days = elapsed_days + day_inc + elapsed_days_this_run = elapsed_days_this_run + day_inc + elapsed_days_this_year = elapsed_days_this_year + day_inc + elapsed_days_init_date = elapsed_days_init_date + day_inc + +!----------------------------------------------------------------------- +! +! has a valid date been selected? +! +!----------------------------------------------------------------------- + + if (.not. valid_ymd_hms()) then + call exit_POP(sigAbort,'invalid ymd_hms') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine model_date + +!*********************************************************************** +!BOP +! !IROUTINE: get_tday +! !INTERFACE: + + subroutine get_tday + +! !DESCRIPTION: +! Computes decimal day, month, year, etc. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: +! !OUTPUT PARAMETERS: +!EOP +!BOC +!----------------------------------------------------------------------- +! +! creating floating point values for elapsed time in various units +! +!----------------------------------------------------------------------- + + frac_day= seconds_this_day/seconds_in_day + + tsecond = elapsed_days_init_date*seconds_in_day + seconds_this_day + + tday = tsecond/seconds_in_day + + tmonth = real(elapsed_months_init_date,kind=r8) + & + (real(iday,kind=r8)-c1+frac_day)/days_in_month(imonth) + + tyear = elapsed_years_init_date + seconds_this_year/seconds_in_year + + thour = tday*24.0_r8 + +!----------------------------------------------------------------------- +! +! define tday00 and thour00 for use in forcing routines. +! these are the time in days/hours since 01-01-0000. +! +!----------------------------------------------------------------------- + + tyear00 = elapsed_years + seconds_this_year/seconds_in_year + tday00 = elapsed_days + frac_day + thour00 = tday00*24.0_r8 + tsecond00 = tday00*seconds_in_day + +!----------------------------------------------------------------------- +!EOC + + end subroutine get_tday + +!*********************************************************************** +!BOP +! !IROUTINE: ymd_hms +! !INTERFACE: + + subroutine ymd_hms(seconds_this_year_loc , seconds_this_day_loc, & + iday_of_year_loc, & + imonth_loc , iday_loc , iday_compare, & + ihour_loc , iminute_loc, isecond_loc, & + rhour_loc , rminute_loc, rsecond_loc, & + midnight_loc, adjust_year_loc) + +! !DESCRIPTION: +! Computes integer values iday\_of\_year, iyear, imonth, iday, ihour, +! iminute, isecond. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iday_compare ! day to compare to check day change + +! !INPUT/OUTPUT PARAMETERS: + + logical (log_kind), intent(inout) :: & + adjust_year_loc ! year adjustment flag + + real (r8), intent(inout) :: & + seconds_this_year_loc ,&! number of seconds in year + seconds_this_day_loc ! number of seconds in day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + imonth_loc, &! local value of imonth + iday_loc, &! local value of iday + ihour_loc, &! local value of ihour + iminute_loc, &! local value of iminute + isecond_loc, &! local value of isecond + iday_of_year_loc ! local value of iday_of_year + + real (r8), intent(out) :: & + rhour_loc, &! real value for hour + rminute_loc, &! real value for minute + rsecond_loc ! real value for second + + logical (log_kind), intent(out) :: & + midnight_loc ! midnight flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + itest, & + nm, & + ntest + + real (r8) :: & + test_seconds, & + rtest, & + r_ntest + +!----------------------------------------------------------------------- +! +! determine day number [1,days_in_year] +! +!----------------------------------------------------------------------- + + rtest = seconds_this_year_loc/seconds_in_day + itest = int (rtest) + ntest = nint (rtest) + r_ntest = ntest + + if (is_near(rtest, r_ntest, dt_tol)) then + iday_of_year_loc = ntest + 1 + else + iday_of_year_loc = itest + 1 + endif + +!----------------------------------------------------------------------- +! +! determine month number [1,12] +! +!----------------------------------------------------------------------- + + imonth_loc = 12 + + do nm = 1,11 + if (iday_of_year_loc > days_in_prior_months(nm) .and. & + iday_of_year_loc <= days_in_prior_months(nm+1)) & + imonth_loc = nm + enddo + +!----------------------------------------------------------------------- +! +! determine day-of-month number [1,31] +! +!----------------------------------------------------------------------- + + iday_loc = iday_of_year_loc - days_in_prior_months(imonth_loc) + +!----------------------------------------------------------------------- +! +! determine integer hour, minute, and second +! +!----------------------------------------------------------------------- + + call hms (seconds_this_day_loc, & + ihour_loc, iminute_loc, isecond_loc, & + rhour_loc, rminute_loc, rsecond_loc) + +!----------------------------------------------------------------------- +! +! midnight? +! +!----------------------------------------------------------------------- + + if (ihour_loc == 0 .and. iminute_loc == 0 .and. & + isecond_loc == 0) then + midnight_loc = .true. + else + midnight_loc = .false. + endif + +!----------------------------------------------------------------------- +! +! if midnight, increment iday +! +!----------------------------------------------------------------------- + + if (iday_loc == iday_compare .and. midnight_loc) & + iday_loc = iday_loc + 1 + +!----------------------------------------------------------------------- +! +! if necessary, adjust month value and year-adjustment indicator +! +!----------------------------------------------------------------------- + + if (iday_loc > days_in_month(imonth_loc)) then + iday_loc = iday_loc - days_in_month(imonth_loc) + imonth_loc = imonth_loc + 1 + if (imonth_loc == 13 ) then + imonth_loc = 1 + adjust_year_loc = .true. + endif + endif + + iday_of_year_loc = days_in_prior_months(imonth_loc) + iday_loc + +!----------------------------------------------------------------------- +!EOC + + end subroutine ymd_hms + +!*********************************************************************** +!BOP +! !IROUTINE: hms +! !INTERFACE: + + subroutine hms (seconds_loc, & + ihour_loc , iminute_loc, isecond_loc, & + rhour_loc , rminute_loc, rsecond_loc) + +! !DESCRIPTION: +! Determines present hour, minute, and second. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), intent(inout) :: & + seconds_loc ! elapsed seconds in current day + +! !OUTPUT PARAMETERS: + + integer(log_kind), intent(out) :: & + ihour_loc, &! hour in current day + iminute_loc, &! minute in current hour + isecond_loc ! seconds in current minute + + real (r8), intent(out) :: & + rhour_loc, &! real values for the above quantities + rminute_loc, & + rsecond_loc + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! compute present hour, minute, and second +! +!----------------------------------------------------------------------- + + rhour_loc = seconds_loc/seconds_in_hour + ihour_loc = rhour_loc + + rminute_loc = (rhour_loc - ihour_loc)*minutes_in_hour + iminute_loc = rminute_loc + + rsecond_loc = (rminute_loc - iminute_loc)*seconds_in_minute + isecond_loc = nint (rsecond_loc) + +!----------------------------------------------------------------------- +! +! corrections to second, minute, and/or hour +! +!----------------------------------------------------------------------- + + if (isecond_loc == 60) then + isecond_loc = 0 + iminute_loc = iminute_loc+ 1 + endif + + if (iminute_loc == 60) then + iminute_loc = 0 + ihour_loc = ihour_loc + 1 + endif + + if (ihour_loc == 24) then + ihour_loc = 0 + endif + +!----------------------------------------------------------------------- +! +! if h:m:s == 0:00:00, then adjust seconds +! +!----------------------------------------------------------------------- + + if (ihour_loc == 0 .and. iminute_loc == 0 .and. & + isecond_loc == 0) seconds_loc = c0 + +!----------------------------------------------------------------------- +!EOC + + end subroutine hms + +!*********************************************************************** +!BOP +! !IROUTINE: reduce_months +! !INTERFACE: + + subroutine reduce_months (imonth_loc, iyear_loc) + +! !DESCRIPTION: +! Reduces imonth such that it never exceeds 12 and +! increments iyear accordingly. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), intent (inout) :: & + imonth_loc, &! current value of imonth + iyear_loc ! current value of iyear + +!EOP +!BOC +!----------------------------------------------------------------------- + + do while (imonth_loc > 12) + imonth_loc = imonth_loc - 12 + iyear_loc = iyear_loc + 1 + enddo + +!----------------------------------------------------------------------- +!EOC + + end subroutine reduce_months + +!*********************************************************************** +!BOP +! !IROUTINE: reduce_seconds +! !INTERFACE: + + subroutine reduce_seconds (seconds_this_day_loc, & + seconds_this_year_loc, adjust_year_loc) + +! !DESCRIPTION: +! Reduce seconds\_this\_day and seconds\_this year, if either +! exceeds their bounds (eg due to roundoff). +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), intent(inout) :: & + seconds_this_day_loc, &! current value of seconds_this_day + seconds_this_year_loc ! current value of seconds_this_year + +! !OUTPUT PARAMETERS: + + logical (log_kind), intent(out) :: & + adjust_year_loc ! flag to signal year adjustment + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ns, ns_end + +!----------------------------------------------------------------------- +! +! if seconds_this_day exceeds the number of seconds in a day, then +! reset seconds_this_day +! +!----------------------------------------------------------------------- + + if (seconds_this_day_loc >= seconds_in_day) then + + ns_end = nint(seconds_this_day_loc/seconds_in_day) + do ns = 1, ns_end + if (seconds_this_day_loc + dt_tol >= seconds_in_day) & + seconds_this_day_loc = seconds_this_day_loc - & + seconds_in_day + enddo + + endif + +!----------------------------------------------------------------------- +! +! if seconds_this_year exceeds the number of seconds in a year, then +! reset seconds_this_year +! +!----------------------------------------------------------------------- + + if (seconds_this_year_loc >= seconds_in_year - stepsize .and. & + (seconds_this_year_loc >= seconds_in_year .or. & + is_near(seconds_this_year_loc,seconds_in_year,dt_tol_year))) & + then + + seconds_this_year_loc = seconds_this_year_loc - seconds_in_year + + if (is_near(seconds_this_year_loc, c0, dt_tol)) then + seconds_this_year_loc = c0 + seconds_this_day_loc = c0 + endif + + adjust_year_loc = .true. + else + adjust_year_loc = .false. + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine reduce_seconds + +!*********************************************************************** +!BOP +! !IROUTINE: leap_adjust +! !INTERFACE: + + subroutine leap_adjust + +! !DESCRIPTION: +! Sets leap-year related variables +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!--------------------------------------------------------------------- +! +! local variables +! +!--------------------------------------------------------------------- + + integer (int_kind) :: nm ! dummy month index + +!----------------------------------------------------------------------- +! +! is iyear a leap year? +! +!----------------------------------------------------------------------- + + leapyear = is_leapyear (iyear) + +!----------------------------------------------------------------------- +! +! adjust the number of days in February and in the year +! +!----------------------------------------------------------------------- + + if (leapyear) then + days_in_month(2) = 29 + days_in_year = days_in_leap_year + else + days_in_month(2) = 28 + days_in_year = days_in_norm_year + endif + + seconds_in_year = days_in_year*seconds_in_day + hours_in_year = days_in_year*24.0_r8 + +!----------------------------------------------------------------------- +! +! reset the values of days_in_prior_months(imonth) +! +!----------------------------------------------------------------------- + + call prior_days (days_in_prior_months, days_in_month) + +!----------------------------------------------------------------------- +!EOC + + end subroutine leap_adjust + +!*********************************************************************** +!BOP +! !IROUTINE: date2ymd +! !INTERFACE: + + subroutine date2ymd (date,year,month,day) + +! !DESCRIPTION: +! Decode the calendar date. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! Calendar date (integer) in yyyymmdd format + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + year, &! Calendar year + month, &! Calendar month + day ! Calendar day + +!EOP +!BOC +!----------------------------------------------------------------------- + + if (.not. valid_date(date)) call exit_POP(sigAbort, & + 'date2ymd:invalid date') + + year = int( date /10000) + month = int( mod(date,10000)/ 100) + day = mod(date, 100) + +!----------------------------------------------------------------------- +!EOC + + end subroutine date2ymd + +!*********************************************************************** +!BOP +! !IROUTINE: ymd2date +! !INTERFACE: + + subroutine ymd2date (year,month,day,date) + +! !DESCRIPTION: +! Encodes the calendar date. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + year, &! Calendar year + month, &! Calendar month + day ! Calendar day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + date ! Calendar date (integer) in yyyymmdd format + +!EOP +!BOC +!----------------------------------------------------------------------- + + date = 10000*year + 100*month + day + +!----------------------------------------------------------------------- +!EOC + + end subroutine ymd2date + +!*********************************************************************** +!BOP +! !IROUTINE: eday2ymd +! !INTERFACE: + + subroutine eday2ymd (eday,year,month,day) + +! !DESCRIPTION: +! Determines the year, month, and day number from elapsed days +! since 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + eday ! elapsed day since 01-01-0000 + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + year, &! calendar year + month, &! calendar month + day ! calendar day + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(0:3) :: & + days_each_year ! days in year for 4-year cycle + + integer (int_kind), dimension(12) :: & + tdays_in_prior_months, &! temporary days in prior months + tdays_in_month ! temporary days in each month + + integer (int_kind) :: & + nm, &! dummy month index + test_day, &! + nnorm, &! normal year counters + nnorm_new, &! normal year counters + nleap, &! leap year counters + nleap_new, &! leap year counters + cycleindex, &! year index for 4-year cycle + days, &! day counter + ny, &! year index + max_ny ! max possible number of years + + character (char_len) :: & + err_string ! output string if error encountered + +!----------------------------------------------------------------------- +! +! If leap years are not allowed, then compute number of elapsed +! years and the number of days in the most recent year +! +!----------------------------------------------------------------------- + + if (.not. allow_leapyear) then + + nnorm = eday/days_in_norm_year + 1 + nleap = 0 + days = eday -nnorm*days_in_norm_year + tdays_in_prior_months = days_in_prior_months + +!----------------------------------------------------------------------- +! +! Compute number of elapsed leap years and "normal" years, and +! the number of days elapsed in the most recent year +! +!----------------------------------------------------------------------- + + else + + !*** First, initialize arrays used to determine date + + days_each_year = days_in_norm_year + days_each_year(0) = days_in_leap_year + + tdays_in_month = days_in_month + tdays_in_month(2) = 29 ! year 0 value + + call prior_days (tdays_in_prior_months, tdays_in_month) + + days = 0 + nleap = 0 + nnorm = 0 + nleap_new = 0 + nnorm_new = 0 + + max_ny = eday/days_in_norm_year + 1 + + !*** Determine the number of elapsed years and the day number of + !*** the present year [1,days_in_norm_year] + + year_loop: do ny = 0, max_ny + + cycleindex = mod(ny,4) + year = nleap + nnorm + + if (cycleindex == 0 .and. & + (mod(ny,100) /= 0 .or. mod(ny,400) == 0)) then + nleap_new = nleap + 1 + tdays_in_month(2) = 29 + else + nnorm_new = nnorm + 1 + tdays_in_month(2) = 28 + endif + + !*** Update Tdays_in_prior_months for the most recent year + + call prior_days (tdays_in_prior_months, tdays_in_month) + + test_day = eday - nnorm*days_in_norm_year - & + nleap*days_in_leap_year + + if (test_day <= days_each_year(cycleindex) ) then + days = test_day + exit year_loop + endif + + nnorm = nnorm_new + nleap = nleap_new + + enddo year_loop + + endif ! .not. allow_leapyear + +!----------------------------------------------------------------------- +! +! Was the number of days this year properly determined? +! +!----------------------------------------------------------------------- + + if (days <= 0 .or. days > days_in_leap_year ) then + err_string = char_blank + write (err_string,'(a,i6)') & + 'eday2ymd: days undetermined, days = ', days + call exit_POP(sigAbort,trim(err_string)) + endif + +!----------------------------------------------------------------------- +! +! Determine the day- and month-numbers for this year +! +!----------------------------------------------------------------------- + + month = 0 + day = 0 + + month_loop: do nm = 1,11 + + test_day = days - tdays_in_prior_months(nm+1) + if (test_day < 0) then + day = days - tdays_in_prior_months(nm) + 1 + month = nm + exit month_loop + endif + enddo month_loop + + if (month == 0) then + day = days - tdays_in_prior_months(12) + 1 + month = 12 + if (day == 32) then + day = 1 + month = 1 + year = year + 1 + endif + endif + + if (day == 0) day = 1 + +!----------------------------------------------------------------------- +!EOC + + end subroutine eday2ymd + +!*********************************************************************** +!BOP +! !IROUTINE: ymd2eday +! !INTERFACE: + + subroutine ymd2eday (year, month, day, eday) + +! !DESCRIPTION: +! Converts calendar date (year, month, day) to elapsed days since +! 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + year, &! calendar year + month, &! calendar month + day ! calendar day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + eday ! elapsed days since 01-01-0000 + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(0:3) :: & + days_each_year ! days in year for 4-year cycle + + integer (int_kind), dimension(12) :: & + tdays_in_prior_months, &! temporary days in prior months + tdays_in_month ! temporary days in each month + + integer (int_kind) :: & + nm, &! dummy month index + num_leapyears ! leap year counters + +!--------------------------------------------------------------------- +! +! If leap years are not allowed, eday computation is straightforward +! +!--------------------------------------------------------------------- + + if (.not. allow_leapyear) then + eday = year*days_in_norm_year + & + days_in_prior_months(month) + day - 1 + +!--------------------------------------------------------------------- +! +! If leap years are allowed, compute the number of days elapsed +! in prior months for *this* year and the number of elapsed +! leap years prior to this year +! +!--------------------------------------------------------------------- + + else + + tdays_in_month = days_in_month + + num_leapyears = 1 + year/4 - year/100 + year/400 + + if (is_leapyear(year)) then + tdays_in_month(2) = 29 + num_leapyears = num_leapyears - 1 + else + tdays_in_month(2) = 28 + endif + + call prior_days (tdays_in_prior_months, tdays_in_month) + + !*** Compute elapsed days for this date + + eday = num_leapyears *days_in_leap_year + & + (year - num_leapyears )*days_in_norm_year + & + tdays_in_prior_months(month) + day - 1 + + endif ! .not. allow_leapyear + +!--------------------------------------------------------------------- +!EOC + + end subroutine ymd2eday + +!*********************************************************************** +!BOP +! !IROUTINE: date2eday +! !INTERFACE: + + subroutine date2eday (date,eday) + +! !DESCRIPTION: +! Determine number of elapsed days since 01-01-0000 from the +! calendar date in (integer) yyyymmdd format. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! date in yyyymmdd format + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + eday ! elapsed days since 01-01-0000 + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! use existing routines for the conversion +! +!----------------------------------------------------------------------- + + if (.not. valid_date(date)) & + call exit_POP(sigAbort,'date2eday: invalid date') + + call date2ymd (date, year, month, day) + call ymd2eday (year, month, day, eday) + +!----------------------------------------------------------------------- +!EOC + + end subroutine date2eday + +!*********************************************************************** +!BOP +! !IROUTINE: eday2date +! !INTERFACE: + + subroutine eday2date (eday,date) + +! !DESCRIPTION: +! Determines calendar date in (integer) yyyymmdd format from the +! number of elapsed days since 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + eday ! elapsed days since 01-01-0000 + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + date ! date in yyyymmdd format + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! use existing routines for the conversion +! +!----------------------------------------------------------------------- + + call eday2ymd (eday, year, month, day) + call ymd2date (year, month, day, date) + +!----------------------------------------------------------------------- +!EOC + + end subroutine eday2date + +!*********************************************************************** +!BOP +! !IROUTINE: prior_days +! !INTERFACE: + + subroutine prior_days (days_in_prior_months_loc,days_in_month_loc) + +! !DESCRIPTION: +! Defines or resets the total number of days in prior months; +! if leap years are allowed, this routine will be called once per +! year. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), dimension(12), intent(in) :: & + days_in_month_loc ! current num of days in each month + +! !OUTPUT PARAMETERS: + + integer (int_kind), dimension(12), intent(out) :: & + days_in_prior_months_loc ! number of days in prior months + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nm ! local month index + +!----------------------------------------------------------------------- + + days_in_prior_months_loc(1) = 0 + + do nm=2,12 + days_in_prior_months_loc(nm) = & + days_in_prior_months_loc(nm-1) + days_in_month_loc(nm-1) + enddo + +!----------------------------------------------------------------------- +!EOC + + end subroutine prior_days + +!*********************************************************************** +!BOP +! !IROUTINE: time_stamp +! !INTERFACE: + + subroutine time_stamp (option, order, date_string, time_string, beg_date) + +! !DESCRIPTION: +! Writes character strings containing the date and time stamps +! mm/dd/yyyy and hh:mm:ss +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + option, &! string with option for time stamp, 'now', 'last', 'range' + order ! string requesting the order of the date stamp ('ymd' or 'mdy') + +! !INPUT/OUTPUT PARAMETERS: + + character (*), intent(inout), optional :: & + date_string, &! a string to fill with date stamp + time_string, &! a string to fill with time stamp + beg_date ! date string to use as first date in + ! 'range' option + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (1), parameter :: & + time_separator=':' + + character (16), parameter :: &! format strings + ymd_date_fmt1 = '(i4.4,2(a,i2.2))', & + ymd_date_fmt2 = '(i4.4,2(i2.2)) ', & + mdy_date_fmt1 = '(2(i2.2,a),i4.4)', & + mdy_date_fmt2 = '(2(i2.2),i4.4) ', & + time_fmt = '(i2.2,2(a,i2.2))' + + logical (log_kind) :: & + ymd, & + mdy + + integer (int_kind) :: date_len ! length of date string + +!----------------------------------------------------------------------- +! +! initialize strings +! +!----------------------------------------------------------------------- + + if (present(date_string)) then + date_string = ' ' + endif + + if (present(time_string)) then + time_string = ' ' + endif + + ymd = .false. + mdy = .false. + +!----------------------------------------------------------------------- +! +! check options +! +!----------------------------------------------------------------------- + + select case (trim(order)) + case ('ymd') + ymd = .true. + case ('mdy') + mdy = .true. + case default + call exit_POP(sigAbort,'ERROR selecting order in subroutine time_stamp') + end select + + select case (trim(option)) + +!----------------------------------------------------------------------- +! +! present time +! +!----------------------------------------------------------------------- + + case ('now') + + if (present(date_string)) then + if (date_separator /= ' ') then + if (ymd) then + write (date_string,ymd_date_fmt1) iyear , date_separator, & + imonth, date_separator, & + iday + else if (mdy) then + write (date_string,mdy_date_fmt1) imonth , date_separator, & + iday, date_separator, & + iyear + endif + else + if (ymd) then + write (date_string,ymd_date_fmt2) iyear, imonth, iday + else if (mdy) then + write (date_string,mdy_date_fmt2) imonth, iday, iyear + endif + endif + endif + + if (present(time_string)) then + write (time_string,time_fmt) ihour , time_separator, & + iminute, time_separator, & + isecond + endif + +!----------------------------------------------------------------------- +! +! last timestep +! +!----------------------------------------------------------------------- + + case ('last') + + if (present(date_string)) then + if (mdy) & + call exit_POP(sigAbort,'ERROR time_stamp not supported with option=last & mdy order') + + if (date_separator /= ' ') then + write (date_string,ymd_date_fmt1) iyear_last ,date_separator, & + imonth_last,date_separator, & + iday_last + else + write (date_string,ymd_date_fmt2) iyear, imonth, iday + endif + endif + + if (present(time_string)) then + call exit_POP(sigAbort,'ERROR time_stamp not supported with option=last') + +! write (time_string,time_fmt) ihour_last, time_separator, & +! iminute , time_separator, & +! isecond + endif + +!----------------------------------------------------------------------- +! +! time range +! +!----------------------------------------------------------------------- + + case ('range') + + if (.not. present(beg_date)) & + call exit_POP(sigAbort, & + 'time_stamp: cannot compute range w/o beg date') + + if (present(date_string)) then + date_string = trim(beg_date)/& + &/'-' + date_len = len_trim(date_string) + 1 + if (date_separator /= ' ') then + write (date_string(date_len:),ymd_date_fmt1) & + iyear , date_separator, & + imonth, date_separator, & + iday + else + write (date_string(date_len:),ymd_date_fmt2) iyear, imonth, iday + endif + endif + + if (present(time_string)) then + call exit_POP(sigAbort,'ERROR time_stamp not supported with option=last') +! write (time_string,time_fmt) ihour , time_separator, & +! iminute, time_separator, & +! isecond + endif + +!----------------------------------------------------------------------- + + end select + +!----------------------------------------------------------------------- +!EOC + + end subroutine time_stamp + + + +!*********************************************************************** +!BOP +! !IROUTINE: ccsm_date_stamp +! !INTERFACE: + subroutine ccsm_date_stamp (date_string, ymds) + +! !DESCRIPTION: +!----------------------------------------------------------------------- +! +! write a character string containing the date stamp +! yyyy-mm-dd, yyyy-mm, or yyyy +! +!----------------------------------------------------------------------- +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: ymds ! a string indicating date stamp format + +! !OUTPUT PARAMETERS: + character (*), intent(out) :: date_string ! a string to fill with date stamp + + +!EOP +!BOC + + character (4) :: ccsm_cyear + character (2) :: ccsm_cmonth + character (2) :: ccsm_cday + character (5) :: ccsm_csecond + + integer (kind=int_kind) :: & + iyear_stamp ,& + imonth_stamp ,& + iday_stamp ,& + itotal_second + + date_string = char_blank + +!--------------------------------------------------------------------- +! set ixxxx_stamp variables to conform to the ccsm standard +!--------------------------------------------------------------------- + if (midnight) then + if (eoy) then + iyear_stamp = iyear_last + imonth_stamp = 12 + iday_stamp = 31 + elseif (eom) then + iyear_stamp = iyear + imonth_stamp = imonth_last + iday_stamp = iday_last + elseif (eod) then + iyear_stamp = iyear + imonth_stamp = imonth + iday_stamp = iday_last + endif + else + iyear_stamp = iyear + imonth_stamp = imonth + iday_stamp = iday + endif + + select case (trim(ymds)) + case ('ymds') +!--------------------------------------------------------------------- +! use unmodified ixxx variables if printing ymds information +!--------------------------------------------------------------------- + itotal_second = isecond + 60*iminute + 3600*ihour + call int_to_char (4,iyear , ccsm_cyear ) + call int_to_char (2,imonth , ccsm_cmonth ) + call int_to_char (2,iday , ccsm_cday ) + call int_to_char (5,itotal_second, ccsm_csecond) + write (date_string,1000) ccsm_cyear, ccsm_cmonth, ccsm_cday, & + ccsm_csecond + + case ('ymd') + call int_to_char (4,iyear_stamp , ccsm_cyear ) + call int_to_char (2,imonth_stamp , ccsm_cmonth) + call int_to_char (2,iday_stamp , ccsm_cday ) + write (date_string,1000) ccsm_cyear, ccsm_cmonth, ccsm_cday + + case ('ym') + call int_to_char (4,iyear_stamp , ccsm_cyear ) + call int_to_char (2,imonth_stamp , ccsm_cmonth) + write (date_string,1000) ccsm_cyear, ccsm_cmonth + + case ('y') + call int_to_char (4,iyear_stamp , ccsm_cyear) + write (date_string,1000) ccsm_cyear + + case default + call exit_POP(sigAbort,'(ccsm_date_stamp)') + + end select + + + 1000 format (a4,:,'-',a2:,'-',a2,:,'-',a5) + +!EOC + +!----------------------------------------------------------------------- + + end subroutine ccsm_date_stamp + +!*********************************************************************** +!BOP +! !IROUTINE: is_near +! !INTERFACE: + + function is_near (test_value, target, tol) + +! !DESCRIPTION: +! Determines if test\_value is ``near'' the target value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), intent(in) :: & + test_value, &! value to test + target, &! value to test against + tol ! tolerance for determining nearness + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + is_near ! result (T or F) of nearness test + +!----------------------------------------------------------------------- +! +! just a simple test... +! +!----------------------------------------------------------------------- + + if (abs(test_value - target) <= tol) then + is_near = .true. + else + is_near = .false. + endif + +!----------------------------------------------------------------------- +!EOC + + end function is_near + +!*********************************************************************** +!BOP +! !IROUTINE: is_leapyear +! !INTERFACE: + + function is_leapyear (iyear_loc) + +! !DESCRIPTION: +! Determines if test\_year is a leapyear. +! +! Assumptions: +! \begin{itemize} +! \item year = 0 is the first year of the integration +! \item standard calendar has 28 days in February, a leap year has 29 +! \end{itemize} +! +! Algorithm: a year is a leap year if it is: +! \begin{itemize} +! \item divisible by 4, +! \item NOT divisible by 100, except if +! \item also divisible by 400 +! \end{itemize} +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iyear_loc ! input year to test for leapyear + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + is_leapyear ! logical result with true if test year is leapyear + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for leap year +! +!----------------------------------------------------------------------- + + is_leapyear = .false. + + if (allow_leapyear .and. mod(iyear_loc,4) == 0 .and. & + (mod(iyear_loc,100) /= 0 .or. mod(iyear_loc,400) == 0 ) ) & + is_leapyear = .true. + +!----------------------------------------------------------------------- +!EOC + + end function is_leapyear + +!*********************************************************************** +!BOP +! !IROUTINE: valid_date +! !INTERFACE: + + function valid_date (date) + +! !DESCRIPTION: +! Determines if a valid year, month & day can be decoded +! from the calendar date in (integer) yyyymmdd format. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! calendar date in yyyymmdd format + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + valid_date ! logical return value = true if valid date + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! check a variety of possible error conditions +! +!----------------------------------------------------------------------- + + year = int( date /10000) + month = int( mod(date,10000)/ 100) + day = mod(date, 100) + + valid_date = .true. + + if (year < 0) valid_date = .false. + if (month < 1) valid_date = .false. + if (month > 12) valid_date = .false. + if (day < 1) valid_date = .false. + if (day > days_in_month(month)) valid_date = .false. + +!----------------------------------------------------------------------- +!EOC + + end function valid_date + +!*********************************************************************** +!BOP +! !IROUTINE: valid_ymd_hms() +! !INTERFACE: + + function valid_ymd_hms() + +! !DESCRIPTION: +! Determines if the computed values of iyear,imonth,iday, +! ihour, iminute, and isecond are within reasonable bounds. +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + valid_ymd_hms ! logical return value = true if current + ! year, month, day, hour, minute, second + ! are withing valid ranges + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + valid_year, &! flags to determine validity of + valid_month, &! specific values + valid_day_b, &! + valid_day_e, &! + valid_hour, &! + valid_minute, &! + valid_second, &! + valid_eday_run, &! + valid_eday_year, &! + valid_feb_day ! + + character (char_len) :: err_string ! string for error message + + character (*), parameter :: & + err_fmt = '(a,i6)' ! format for error string + +!----------------------------------------------------------------------- +! +! set default condition of true for all flags +! +!----------------------------------------------------------------------- + + valid_ymd_hms = .true. + valid_year = .true. + valid_month = .true. + valid_day_b = .true. + valid_day_e = .true. + valid_hour = .true. + valid_minute = .true. + valid_second = .true. + valid_eday_run = .true. + valid_eday_year = .true. + valid_feb_day = .true. + +!----------------------------------------------------------------------- +! +! check a variety of possible error conditions +! +!----------------------------------------------------------------------- + + if (iyear < 0) then + valid_ymd_hms = .false. + valid_year = .false. + endif + + if (imonth < 0 .or. imonth > 12) then + valid_ymd_hms = .false. + valid_month = .false. + endif + + if (iday < 1) then + valid_ymd_hms = .false. + valid_day_b = .false. + endif + + if (valid_ymd_hms) then ! prevents out-of-range reference + if (iday > days_in_month(imonth)) then + valid_ymd_hms = .false. + valid_day_e = .false. + endif + endif + + if (ihour < 0 .or. ihour > 24) then + valid_ymd_hms = .false. + valid_hour = .false. + endif + + if (iminute < 0 .or. iminute > 60) then + valid_ymd_hms = .false. + valid_minute = .false. + endif + + if (isecond < 0 .or. isecond > 60) then + valid_ymd_hms = .false. + valid_second = .false. + endif + + if (elapsed_days_this_year < 0) then + valid_ymd_hms = .false. + valid_eday_year = .false. + endif + + if (elapsed_days_init_date < 0) then + valid_ymd_hms = .false. + valid_eday_run = .false. + endif + + if (.not. allow_leapyear .and. imonth == 2 .and. iday == 29) then + valid_ymd_hms = .false. + valid_feb_day = .false. + endif + +!----------------------------------------------------------------------- +! +! if errors detected, write out message and quit +! +!----------------------------------------------------------------------- + + if (.not. valid_ymd_hms) then + + err_string = char_blank + + if (.not. valid_year) & + write(err_string,err_fmt) & + 'Invalid date (iyear must be > 0 ): iyear = ', iyear + + if (.not. valid_month) & + write(err_string,err_fmt) & + 'Invalid date ( imonth must be in [1,12] ): imonth = ', & + imonth + + if (.not. valid_day_b) & + write(err_string,err_fmt) & + 'Invalid date (iday must be greater than 1): iday = ',iday + + if (.not. valid_day_e) & + write(err_string,err_fmt) & + 'Invalid date (iday must be less than days_in_month):'/& + &/' iday = ',iday + + if (.not. valid_hour) & + write(err_string,err_fmt) & + 'Invalid date (ihour must be in [0,23] ): ihour = ', ihour + + if (.not. valid_minute) & + write(err_string,err_fmt) & + 'Invalid date (iminute must be in [0,59] ): iminute = ', & + iminute + + if (.not. valid_second) & + write(err_string,err_fmt) & + 'Invalid date (isecond must be in [0,59] ): isecond = ', & + isecond + + if (.not. valid_eday_run) & + write(err_string,err_fmt) & + 'Invalid date (elapsed_days_init_date must be > 0 ) ', & + elapsed_days_init_date + + if (.not. valid_eday_year) & + write(err_string,err_fmt) & + 'Invalid date (elapsed_days_this_year must be > 0) ', & + elapsed_days_this_year + + if (.not. valid_feb_day) & + write(err_string,*) & + ' Error: initial date contains leap day '/& + &/' but no leap years are allowed.', iday + + call exit_POP(sigAbort,trim(err_string)) + + endif ! valid_ymd_hms + +!----------------------------------------------------------------------- +!EOC + + end function valid_ymd_hms + +!*********************************************************************** +!BOP +! !IROUTINE: write_time_manager_options +! !INTERFACE: + + subroutine write_time_manager_options + +! !DESCRIPTION: +! Writes all time manager options to stdout. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: +! !OUTPUT PARAMETERS: +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k, ind, nn + + character (1) :: & + suffix + + character (2) :: & + cmonth_end_run, &! + cday_end_run, &! + cmonth0, &! + cday0 ! + + character (3) :: & + mix_step + + character (4) :: & + cyear0, &! + cyear_end_run ! + + character (char_len) :: & + mix_steps + + character (*), parameter :: &! output formats + out_fmt1 = "(' date(month-day-year):',2x,2(a2,'-'),a4)", & + out_fmt2 = "(' ',a7,2x,i10)", & + out_fmt3 = "('This run will terminate ',/,a)", & + out_fmt4 = "(a, :i7, a,a)", & + out_fmt5 = "(' ',a8,2x,f16.3)", & + out_fmt6 = "('Averaging time steps every ',i6,' steps',a)", & + out_fmt7 = & +"('Averaging time steps at the 2nd and ',i5,a2,' step of every day or coupled interval ')",& + out_fmt8 = "('Surface ',a10,' time step = ',1pe12.6, ' seconds')",& + out_fmt9 = "('There are ', i3, a6,' steps each day')" + +!----------------------------------------------------------------------- +! +! write only from master task +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + +!----------------------------------------------------------------------- +! +! write start/current time data +! +!----------------------------------------------------------------------- + + call int_to_char(4, iyear0 , cyear0) + cmonth0 = cmonths(imonth0) + cday0 = cdays (iday0) + + call int_to_char(4, iyear_end_run , cyear_end_run ) + cmonth_end_run = cmonths(imonth_end_run) + cday_end_run = cdays (iday_end_run) + + write (stdout,blank_fmt) + write (stdout,ndelim_fmt) + write (stdout,blank_fmt) + write (stdout,'(a23)') 'Time Information' + write (stdout,blank_fmt) + write (stdout,delim_fmt) + + write (stdout,blank_fmt) + write (stdout,'(a8,a)') 'Run id: ',trim(runid) + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'This simulation started from' + write (stdout,out_fmt1) cmonth0, cday0, cyear0 + write (stdout,out_fmt2) ' hour:', ihour0 + write (stdout,out_fmt2) 'minute:', iminute0 + write (stdout,out_fmt2) 'second:', isecond0 + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'This run started from' + write (stdout,out_fmt1) cmonth, cday, cyear + write (stdout,out_fmt2) ' hour:', ihour + write (stdout,out_fmt2) 'minute:', iminute + write (stdout,out_fmt2) 'second:', isecond + + if (nsteps_total /= 0) & + write (stdout,out_fmt2) ' step:', nsteps_total + + write (stdout,blank_fmt) + + if (end_run_at_midnight) then + write (stdout,out_fmt3) 'at 00:00:00 on' + else if (dtt > seconds_in_day) then + write (stdout,out_fmt3) 'at the end of the day on or after' + else + write (stdout,out_fmt3) 'at the end of the day on' + endif + + if (stop_count == 1) then + suffix = ' ' + else + suffix = 's' + endif + + write (stdout,out_fmt1) cmonth_end_run,cday_end_run,cyear_end_run + + select case (stop_option) + + case ('never') + write (stdout,out_fmt4) 'upon receipt of stop signal' /& + &/ ' from external source (eg, cpl)' + case ('nyear') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' year', suffix + case ('nmonth') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' month', suffix + case ('nday') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' day', suffix + case ('eoy') + write(stdout,out_fmt4) 'at the end of the year after ', & + stop_count, ' year', suffix + case ('eom') + write(stdout,out_fmt4) 'at the end of the month after', & + stop_count, ' month', suffix + case ('eod') + write (stdout,out_fmt4) 'at the end of the day' + case ('nstep','nsteps') + write (stdout,out_fmt4) 'after ', stop_count,' timestep', & + suffix + case ('date') + write (stdout,out_fmt4) 'after reaching the specified date' + case default + end select + write (stdout,'(a63)') 'unless a stop signal is received'/& + &/' from external source (eg, cpl)' + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'Starting elapsed time in ' + write (stdout,out_fmt5) ' years:', tyear + write (stdout,out_fmt5) ' months:', tmonth + write (stdout,out_fmt5) ' days:', tday + write (stdout,out_fmt5) ' hours:', thour + write (stdout,out_fmt5) 'seconds:', tsecond + +!----------------------------------------------------------------------- +! +! timestep information +! +!----------------------------------------------------------------------- + + write (stdout,blank_fmt) + if (dt_option == 'auto_dt') then + write (stdout,'(a45)') & + 'Automatic time step option (auto_dt) enabled' + else + write (stdout,'(a45)') & + 'Automatic time step option (auto_dt) disabled' + endif + + write (stdout,blank_fmt) + write (stdout,'(a11,1pe12.6)') 'dt_count = ',dt_count + + if (tmix_iopt == tmix_avgfit) then + write(stdout,out_fmt9) fullsteps_per_day,' full ' + write(stdout,out_fmt9) halfsteps_per_day,' half ' + write(stdout,out_fmt9) nsteps_per_day, ' total' + endif + + write (stdout,blank_fmt) + write (stdout,'(a16,i6)') 'time_mix_freq = ', time_mix_freq + + write (stdout,'(a19)') 'Time mixing option:' + select case (tmix_iopt) + + case (tmix_avg) + write (stdout,'(a23)') ' avg -- time averaging' + + case (tmix_avgbb) + write (stdout,'(a59)') ' avgbb -- time averaging'/& + &/' with back-to-back averaging steps' + + case (tmix_avgfit) + write (stdout,'(a26)') ' avgfit -- time averaging' + write (stdout,'(a71)') ' with timestep chosen to fit'/& + &/' exactly into one day or coupling'/& + &/' interval' + if (time_mix_freq > fullsteps_per_interval + 1) then + if (fit_freq == 1) then + write (stdout,'(a50)') & + 'Averaging time steps are at step number 2 each day' + else + write (stdout,'(a55)') & + 'Averaging time steps are at step number 2 each interval' + endif + else + ind = 1 + mix_steps = '2' + + do nn = 3, nsteps_per_interval + if (mod(nn,time_mix_freq) == 0) then + write(mix_step,'(i2)' ) nn + mix_steps = trim(mix_steps)/& + &/',' /& + &/ trim(mix_step) + endif + enddo + + if (fit_freq == 1) then + write (stdout,'(a40,a,a9)') & + 'Averaging time steps are at step numbers', & + trim(mix_steps), ' each day' + else + write (stdout,'(a40,a,a14)') & + 'Averaging time steps are at step numbers', & + trim(mix_steps), ' each interval' + endif + endif + + case (tmix_matsuno) + write (stdout,'(a25,i6,a6)') & + 'Matsuno time steps every ',time_mix_freq,' steps' + end select + + write (stdout,blank_fmt) + select case (tmix_iopt) + case (tmix_avg) + write (stdout,out_fmt6) time_mix_freq, ' ' + case (tmix_avgbb) + write (stdout,out_fmt6) time_mix_freq, & + ' with back-to-back averaging steps' + case (tmix_avgfit) + if (time_mix_freq == 1 .or. & + (mod(time_mix_freq,10) == 1 .and. & + time_mix_freq /= 11)) then + write (stdout,out_fmt7) time_mix_freq, 'st' + elseif (time_mix_freq == 2 .or. & + (mod(time_mix_freq,10) == 2 .and. & + time_mix_freq /= 12)) then + write (stdout,out_fmt7) time_mix_freq, 'nd' + elseif (time_mix_freq == 3 .or. & + (mod(time_mix_freq,10) == 3 .and. & + time_mix_freq /= 13)) then + write (stdout,out_fmt7) time_mix_freq, 'rd' + else + write (stdout,out_fmt7) time_mix_freq, 'th' + endif + case (tmix_matsuno) + write (stdout,'(a25,i6,a6)') & + 'Matsuno time steps every ',time_mix_freq,' steps' + end select + + write (stdout,blank_fmt) + write (stdout,out_fmt8) 'tracer ',dtt + write (stdout,out_fmt8) 'momentum ',dtu + write (stdout,out_fmt8) 'barotropic',dtp + + write (stdout,blank_fmt) + if (laccel) then + write (stdout,'(a28)') 'Tracer acceleration enabled' + write (stdout,'(a22)') ' k accel factor' + write (stdout,'(a22)') ' --- ------------' + do k=1,km + write (stdout,'(2x,i3,7x,f8.3)') k, dttxcel(k) + end do + else + write (stdout,'(a28)') 'Tracer acceleration disabled' + endif + +!----------------------------------------------------------------------- +! +! other options +! +!----------------------------------------------------------------------- + + write (stdout,blank_fmt) + if (allow_leapyear) then + write (stdout,'(a22)') 'Leap years allowed' + else + write (stdout,'(a22)') 'Leap years not allowed' + endif + + write (stdout,blank_fmt) + if (impcor) then + write (stdout,'(a50)') & + 'Implicit treatment of Coriolis terms (impcor): ON' + else + write (stdout,'(a50)') & + 'Implicit treatment of Coriolis terms (impcor): OFF' + endif + +!----------------------------------------------------------------------- +! +! end of writes +! +!----------------------------------------------------------------------- + + endif ! (my_task == master_task) + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_time_manager_options + +!*********************************************************************** +!BOP +! !IROUTINE: int_to_char +! !INTERFACE: + + subroutine int_to_char(string_length, int_in, char_out) + +! !DESCRIPTION: +! Converts an integer into a character with a requested length and +! pads spaces with zeroes. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + string_length, &! length of desired output character string + int_in ! input integer to be converted + +! !OUTPUT PARAMETERS: + + character(string_length), intent(out) :: & + char_out ! character equivalent of input integer + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy counter + ifact, &! factor of 10 for picking off digits + iquot, iremaind ! quotient, remainder for division by ifact + +!----------------------------------------------------------------------- +! +! convert to string by picking off one digit at a time and writing +! it into a character string +! +!----------------------------------------------------------------------- + + iremaind = int_in + + do n=1,string_length + ifact = 10**(string_length - n) ! power of 10 for leftmost + iquot = iremaind/ifact ! compute leftmost digit + iremaind = iremaind - iquot*ifact ! remove digit for next pass + + write(char_out(n:n),'(i1)') iquot ! write digit to string + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine int_to_char + +!*********************************************************************** + + end module time_management + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/POP_files/xdisplay.F90 b/components/cism/source_glc/POP_files/xdisplay.F90 new file mode 100644 index 0000000000..f0eba61b62 --- /dev/null +++ b/components/cism/source_glc/POP_files/xdisplay.F90 @@ -0,0 +1,216 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module xdisplay + +!BOP +! !MODULE: xdisplay +! +! !DESCRIPTION: +! This is a dummy version of an unsupported module containing +! routines for opening an xdisplay and viewing a field while +! the simulation is running. The actual sort-of-working version +! relies on an unsupported library called fix (fortran interface +! to X). +! +! The purpose of this dummy version is to allow the makefiles +! to be portable to systems which may not have X windows. If +! you have X windows on your system and you want to try this, +! then overwrite this file, xdisplay.F, with +! +! cp ../input_templates/xdisplay.F90.unsupported ./xdisplay.F90 +! +! and do +! +! cp ../input_templates/fix_64.C.unsupported ./fix_64.C +! +! !REVISION HISTORY: +! SVN:$Id: xdisplay.F90 808 2006-04-28 17:06:38Z njn01 $ + +! !USES: + + use kinds_mod, only: log_kind, int_kind, r8 + use blocks, only: nx_block, ny_block, block + use domain_size + use domain, only: + use constants, only: delim_fmt, blank_fmt, c1, c0 + use communicate, only: my_task, master_task + use io_types, only: nml_in, nml_filename, stdin, stdout + use broadcast, only: broadcast_scalar + use prognostic, only: max_blocks_clinic + use grid, only: + use exit_mod, only: sigAbort, exit_pop + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_xdisplay, & + clear_display, & + display + +! !PUBLIC DATA MEMBERS: + + logical (log_kind), public :: & + lxdisplay ! logical flag to turn on xdisplay + + integer (int_kind), public :: & + nstep_xdisplay ! display image every nstep timesteps + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_xdisplay +! !INTERFACE: + + subroutine init_xdisplay + +! !DESCRIPTION: +! This routine initializes an xwindow for displaying a 2-d field +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + namelist /xdisplay_nml/lxdisplay, nstep_xdisplay + + integer (int_kind) :: & + nml_error ! namelist i/o error flag + +!----------------------------------------------------------------------- +! +! read input namelist to see if xdisplay required +! +!----------------------------------------------------------------------- + + lxdisplay = .false. + nstep_xdisplay = 1 + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=xdisplay_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_POP(sigAbort,'ERROR reading xdisplay_nml') + endif + + if (my_task == master_task) then + write(stdout,delim_fmt) + write(stdout,blank_fmt) + write(stdout,'(a17)') ' Xdisplay options' + write(stdout,blank_fmt) + write(stdout,delim_fmt) + + if (lxdisplay) then + write(stdout,'(a17)') ' Xdisplay enabled' + write(stdout,'(a23,i6,a7)') ' Display changes every ', & + nstep_xdisplay, ' steps.' + else + write(stdout,'(a18)') ' Xdisplay disabled' + endif + endif + + call broadcast_scalar(lxdisplay, master_task) + +!----------------------------------------------------------------------- +! +! if xdisplay requested, exit with error +! +!----------------------------------------------------------------------- + + if (lxdisplay) call exit_POP(sigAbort, & + 'X display requested when only dummy routines linked') + +!----------------------------------------------------------------------- +!EOC + + end subroutine init_xdisplay + +!*********************************************************************** +!BOP +! !IROUTINE: clear_display +! !INTERFACE: + + subroutine clear_display + +! !DESCRIPTION: +! Clears the display and closes the X window +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- + + call exit_POP(sigAbort, & + 'X display requested when only dummy routines linked') + +!----------------------------------------------------------------------- +!EOC + + end subroutine clear_display + +!*********************************************************************** +!BOP +! !IROUTINE: display +! !INTERFACE: + + subroutine display(FIELD1, field1_loc, FIELD2, field2_loc) + +! !DESCRIPTION: +! Computes image from two input fields and sends it to the +! FIX routine for display. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), dimension(nx_block,ny_block,max_blocks_clinic), & + intent(in) :: & + FIELD1, FIELD2 ! two fields to stack and display + + integer (int_kind), intent(in) :: & + field1_loc, field2_loc ! grid locations for each field +!EOP +!BOC +!----------------------------------------------------------------------- + + call exit_POP(sigAbort, & + 'X display requested when only dummy routines linked') + +!----------------------------------------------------------------------- +!EOC + + end subroutine display + +!*********************************************************************** + + end module xdisplay + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/README b/components/cism/source_glc/README new file mode 100644 index 0000000000..2c1ccd0c0e --- /dev/null +++ b/components/cism/source_glc/README @@ -0,0 +1,3 @@ +This directory contains source code needed to run the GLIMMER +ice sheet model in CCSM, chiefly drivers and utilities. + diff --git a/components/cism/source_glc/glc_ErrorMod.F90 b/components/cism/source_glc/glc_ErrorMod.F90 new file mode 100644 index 0000000000..50bd83f3bc --- /dev/null +++ b/components/cism/source_glc/glc_ErrorMod.F90 @@ -0,0 +1,247 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_ErrorMod + +!BOP +! !MODULE: glc_ErrorMod +! !DESCRIPTION: +! This module contains glc error flags and facilities for logging and +! printing error messages. Note that error flags are local to a +! process and there is no synchronization of error flags across +! processes. As routines trap error flags, they may add a message +! to the error log to aid in tracking the call sequence. +! +! !USERDOC: +! Users should not need to change any values in this module. +! +! !REFDOC: +! All routines in glc which encounter an error should return to +! the calling routine with the glc\_Fail error code set and a message +! added to the error log using the glc\_ErrorSet function. Also, +! routines in glc should check error codes returned by called routines +! and add a message to the error log to help users track the calling +! sequence that generated the error. This process +! enables the error code to be propagated to the highest level or +! to a coupler for a proper call to the glc finalize method. +! +! !REVISION HISTORY: +! SVN:$Id: POP_ErrorMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! Adapted by William Lipscomb from POP_ErrorMod.F90 +! +! !USES: + + use glc_kinds_mod + !use glc_CommMod + use glc_communicate + use glc_constants + + implicit none + private + save + +! !DEFINED PARAMETERS: + + integer (i4), parameter, public :: & + glc_Success = 0, & ! standard glc error flags + glc_Fail = -1 + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glc_ErrorSet, & + glc_ErrorPrint + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + + integer (i4), parameter :: & + glc_ErrorLogDepth = 20 ! Max depth of call tree to properly + ! size the error log array + + integer (i4) :: & + glc_ErrorMsgCount = 0 ! tracks current number of log messages + + character (char_len), dimension(glc_ErrorLogDepth) :: & + glc_ErrorLog ! list of error messages to be output + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_ErrorSet -- sets error code and logs error message +! !INTERFACE: + + subroutine glc_ErrorSet(ErrorCode, ErrorMsg) + +! !DESCRIPTION: +! This routine sets an error code to glc\_Fail and adds a message to +! the error log for later printing. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + integer (i4), intent(out) :: & + ErrorCode ! Error code to set to fail + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + ErrorMsg ! message to add to error log for printing + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! Set error code to fail +! +!----------------------------------------------------------------------- + + ErrorCode = glc_Fail + +!----------------------------------------------------------------------- +! +! Add error message to error log +! +!----------------------------------------------------------------------- + + glc_ErrorMsgCount = glc_ErrorMsgCount + 1 + + if (glc_ErrorMsgCount <= glc_ErrorLogDepth) then + glc_ErrorLog(glc_ErrorMsgCount) = ErrorMsg + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_ErrorSet + +!*********************************************************************** +!BOP +! !IROUTINE: glc_ErrorPrint -- prints the error log +! !INTERFACE: + + subroutine glc_ErrorPrint(ErrorCode, PrintTask) + +! !DESCRIPTION: +! This routine prints all messages in the error log. If a PrintTask +! is specified, only the log on that task will be printed. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (i4), intent(in) :: & + ErrorCode ! input error code to check success/fail + + integer (i4), intent(in), optional :: & + PrintTask ! Task from which to print error log + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (i4) :: n + +!----------------------------------------------------------------------- +! +! Print all error messages to stdout +! +!----------------------------------------------------------------------- + + if (present(PrintTask)) then + + if (my_Task == PrintTask) then + !if (glc_myTask == PrintTask) then + + write(stdout,blank_fmt) + write(stdout,'(a34)') '----------------------------------' + + if (glc_ErrorMsgCount == 0) then ! no errors + + write(stdout,'(a34)') & + 'Successful completion of glc model' + + else + + write(stdout,'(a14)') 'glc Exiting...' + do n=1,min(glc_ErrorMsgCount,glc_ErrorLogDepth) + write(stderr,'(a)') trim(glc_ErrorLog(n)) + if (stdout /= stderr) then + write(stdout,'(a)') trim(glc_ErrorLog(n)) + endif + end do + if (glc_ErrorMsgCount > glc_ErrorLogDepth) then + write(stderr,'(a)') 'Too many error messages' + if (stdout /= stderr) then + write(stdout,'(a)') 'Too many error messages' + endif + endif + + endif + + write(stdout,'(a34)') '----------------------------------' + + endif + + else + + write(stdout,'(a34)') '----------------------------------' + + if (glc_ErrorMsgCount == 0) then ! no errors + + write(stdout,'(a34)') 'Successful completion of glc model' + + else + + write(stdout,'(a14)') 'glc Exiting...' + do n=1,min(glc_ErrorMsgCount,glc_ErrorLogDepth) + write(stderr,'(a)') trim(glc_ErrorLog(n)) + if (stdout /= stderr) then + write(stdout,'(a)') trim(glc_ErrorLog(n)) + endif + end do + if (glc_ErrorMsgCount > glc_ErrorLogDepth) then + write(stderr,'(a)') 'Too many error messages' + if (stdout /= stderr) then + write(stdout,'(a)') 'Too many error messages' + endif + endif + + endif + + write(stdout,'(a34)') '----------------------------------' + + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_ErrorPrint + +!*********************************************************************** + + end module glc_ErrorMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_FinalMod.F90 b/components/cism/source_glc/glc_FinalMod.F90 new file mode 100644 index 0000000000..f2025b0adf --- /dev/null +++ b/components/cism/source_glc/glc_FinalMod.F90 @@ -0,0 +1,124 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_FinalMod + +!BOP +! !MODULE: glc_FinalMod +! !DESCRIPTION: +! This module contains the glc finalization method that shuts down glc +! gracefully (we hope). It exits the message environment and checks +! for successful execution. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! SVN:$Id: POP_FinalMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! Adapted by William Lipscomb from POP_FinalMod.F90 +! +! !USES: + + use glc_kinds_mod + use glc_ErrorMod + use glc_communicate, only: exit_message_environment + use glc_fields, only: ice_sheet + use glad_main, only: end_glad + use glc_constants, only: stdout + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glc_final + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_final +! !INTERFACE: + + subroutine glc_final(ErrorCode) + +! !DESCRIPTION: +! This routine shuts down glc by exiting all relevent environments. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + integer (i4), intent(inout) :: & + ErrorCode ! On input, error code from Init,Run method + ! On output, status of this routine + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! exit glad gracefully +! +!----------------------------------------------------------------------- + + call end_glad(ice_sheet, close_logfile=.false.) + +!----------------------------------------------------------------------- +! +! call Error Logging to print any error messages. +! +!----------------------------------------------------------------------- + + call glc_ErrorPrint(ErrorCode) + +!----------------------------------------------------------------------- +! +! write final message to glc output log +! +!----------------------------------------------------------------------- + write(stdout,*) '===================' + write(stdout,*) 'completed glc_final' + write(stdout,*) '===================' + +!----------------------------------------------------------------------- +! +! exit the communication environment +! +!----------------------------------------------------------------------- + + !call glc_CommExitEnvironment(ErrorCode) + call exit_message_environment(ErrorCode) + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_final + +!*********************************************************************** + + end module glc_FinalMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_InitMod.F90 b/components/cism/source_glc/glc_InitMod.F90 new file mode 100644 index 0000000000..b6a681ea74 --- /dev/null +++ b/components/cism/source_glc/glc_InitMod.F90 @@ -0,0 +1,357 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_InitMod + +!BOP +! !MODULE: glc_InitMod +! !DESCRIPTION: +! This module contains the glc initialization method and initializes +! everything needed by a glc simulation. Primarily it is a driver +! that calls individual initialization routines for each glc module. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! SVN:$Id: POP_InitMod.F90 808 2006-04-28 17:06:38Z njn01 $ +! Adapted by William Lipscomb from POP_InitMod.F90 + +! !USES: + + use glc_kinds_mod + use glc_ErrorMod + use glc_communicate, only: my_task, master_task + use glc_broadcast, only: broadcast_scalar, broadcast_array + use glc_time_management, only: iyear0, imonth0, iday0, elapsed_days0, & + iyear, imonth, iday, elapsed_days, & + ihour, iminute, isecond, nsteps_total, & + ymd2eday, eday2ymd, runtype + use glc_constants, only: nml_in, stdout + use glc_io, only: glc_io_read_restart_time + use glc_files, only: nml_filename + use glc_exit_mod + use shr_kind_mod, only: CL=>SHR_KIND_CL + use shr_sys_mod, only: shr_sys_flush + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glc_initialize + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! module variables +! +!----------------------------------------------------------------------- + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_initialize +! !INTERFACE: + + subroutine glc_initialize(errorCode) + +! !DESCRIPTION: +! This routine is the initialization driver that initializes a glc run +! by calling individual module initialization routines. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !USES: + use glad_main + + use glc_fields, only: glc_allocate_fields, ice_sheet, & + tsfc, qsmb, & + ice_covered, topo, rofi, rofl, hflx, & + ice_sheet_grid_mask, icemask_coupled_fluxes + + use glc_override_frac, only: init_glc_frac_overrides + use glc_constants + use glc_communicate, only: init_communicate + use glc_time_management, only: init_time1, init_time2, dtt, ihour + use glimmer_log + use glc_route_ice_runoff, only: set_routing + use glc_history, only : glc_history_init + use glc_indexing_info, only : glc_indexing_init, nx, ny + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + +! !INPUT/OUTPUT PARAMETERS: + + integer (i4), intent(inout) :: & + errorCode ! Returns an error code if any init fails + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character(fname_length) :: & + paramfile ! Name of the top-level configuration file + + character(fname_length) :: & + cesm_restart_file ! Name of the hotstart file to be used for a restart + + character(CL) :: & + ice_flux_routing ! Code for how solid ice should be routed to ocean or sea ice + + ! Scalars which hold information about the global grid -------------- + + integer (i4) :: & + i,j ! Array index counters + + integer (i4) :: & + nml_error ! namelist i/o error flag + + integer (i4) :: & + nhour_glad ! number of hours since start of complete glad/glimmer run + + logical :: & + cesm_restart = .false. ! Logical flag to pass to glimmer, telling it to hotstart + ! from a CESM restart + + logical :: & + cism_debug = .false. ! Logical flag to pass to glimmer, telling it to output extra + ! debug diagnostics + + integer :: unit ! fileunit passed to Glimmer + + integer :: climate_tstep ! climate time step (hours) + + integer, parameter :: days_in_year = 365 + + namelist /cism_params/ paramfile, cism_debug, ice_flux_routing + +!----------------------------------------------------------------------- +! initialize return flag +!----------------------------------------------------------------------- + + ErrorCode = glc_Success + +! TODO - Write version info? +!----------------------------------------------------------------------- +! write version information to output log after output redirection +!----------------------------------------------------------------------- +!! if (my_task == master_task) then +!! write(stdout,blank_fmt) +!! write(stdout,ndelim_fmt) +!! write(stdout,blank_fmt) +!! write(stdout,'(a)') ' GLC version xxx ' +!! write(stdout,blank_fmt) +!! call shr_sys_flush(stdout) +!! endif + +!----------------------------------------------------------------------- +! +! compute time step and initialize time-related quantities +! +!----------------------------------------------------------------------- + + call init_time1 + +!----------------------------------------------------------------------- +! +! output delimiter to log file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + call shr_sys_flush (stdout) + endif + +!-------------------------------------------------------------------- +! Initialize ice sheet model, grid, and coupling. +! The following code is largely based on GLIMMER. +!----------------------------------------------------------------------- + + paramfile = 'unknown_paramfile' + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=cism_params,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_glc(sigAbort,'ERROR reading cism_params nml') + endif + + call broadcast_scalar(paramfile, master_task) + call broadcast_scalar(cism_debug, master_task) + call broadcast_scalar(ice_flux_routing, master_task) + call set_routing(ice_flux_routing) + + if (verbose .and. my_task==master_task) then + write (stdout,*) 'paramfile = ', paramfile + write (stdout,*) 'dtt =', dtt + call shr_sys_flush(stdout) + endif + + ! Set climate time step + + climate_tstep = nint(dtt/3600._r8) ! convert from sec to integer hours + + if (verbose .and. my_task==master_task) then + write (stdout,*) 'climate_tstep (hr) =', climate_tstep + write (stdout,*) 'Set glimmer_unit =', stdout + write (stdout,*) 'Initialize glad' + endif + + ! Set glimmer_unit for diagnostic output from Glimmer. (Log file is already open) +! call open_log(unit=101) + + call set_glimmer_unit(stdout) + + ! Initialize the ice sheet model + + nhour_glad = 0 ! number of hours glad has run since start of complete simulation + ! must be set to correct value if reading from a restart file + + call init_glc_frac_overrides() + + ! if this is a continuation run, then set up to read restart file and get the restart time + if (runtype == 'continue') then + cesm_restart = .true. + call glc_io_read_restart_time(nhour_glad, cesm_restart_file) + call ymd2eday (iyear0, imonth0, iday0, elapsed_days0) + elapsed_days = elapsed_days0 + nhour_glad/24 + call eday2ymd(elapsed_days, iyear, imonth, iday) + ihour = 0 + iminute = 0 + isecond = 0 + nsteps_total = nhour_glad / climate_tstep + if (verbose .and. my_task==master_task) then + write(stdout,*) 'Successfully read restart, nhour_glad =', nhour_glad + write(stdout,*) 'Initial eday/y/m/d:', elapsed_days0, iyear0, imonth0, iday0 + write(stdout,*) 'eday/y/m/d after restart:', elapsed_days, iyear, imonth, iday + write(stdout,*) 'nsteps_total =', nsteps_total + write(stdout,*) 'Initialize glad:' + endif + endif + + if (verbose .and. my_task==master_task) then + write(stdout,*) 'Initialize glad, nhour_glad =', nhour_glad + endif + + unit = shr_file_getUnit() + + call glad_initialize(ice_sheet, & + climate_tstep, & + (/paramfile/), & + daysinyear = days_in_year, & + start_time = nhour_glad, & + gcm_restart = cesm_restart, & + gcm_restart_file = cesm_restart_file, & + gcm_debug = cism_debug, & + gcm_fileunit = unit) + + ! TODO(wjs, 2015-03-24) We will need a loop over instances, either here or around the + ! call to glc_initialize + + call glad_initialize_instance(ice_sheet, instance_index = 1) + + call glc_indexing_init(ice_sheet, instance_index = 1) + + call glc_allocate_fields(nx, ny) + + tsfc(:,:) = 0._r8 + qsmb(:,:) = 0._r8 + + call glad_get_initial_outputs(ice_sheet, instance_index = 1, & + ice_covered = ice_covered, & + topo = topo, & + rofi = rofi, & + rofl = rofl, & + hflx = hflx, & + ice_sheet_grid_mask = ice_sheet_grid_mask, & + icemask_coupled_fluxes = icemask_coupled_fluxes) + + call glad_initialization_wrapup(ice_sheet) + +!TODO - Implement PDD option + + call shr_file_freeunit(unit) + +! Do the following: +! For each instance, convert ice_sheet%instances(i)%glide_time to hours and compare to nhour_glad. +! If different: Reset params%instances(i)%next_time, params%start_time, params%next_av_start +! Do this here or in initialise_glad? + + ! If restarting (nhour_glad > 0), recompute the year, month, and day + ! By default, iyear0 = imonth0 = iday0 = 1 (set in namelist file) + ! Assume that ihour0 = iminute0 = isecond0 = 0 + ! Note that glad does not handle leap years + + ! Set the message level (1 is the default - only fatal errors) + ! N.B. Must do this after initialization + + call glimmer_set_msg_level(6) + +!----------------------------------------------------------------------- +! +! finish computing time-related quantities after restart info +! available (including iyear, imonth, and iday) +! +!----------------------------------------------------------------------- + + call init_time2 + +!----------------------------------------------------------------------- +! +! initialize history output +! +!----------------------------------------------------------------------- + + call glc_history_init() + +!----------------------------------------------------------------------- +! +! output delimiter to log file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,'(" End of GLC initialization")') + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + call shr_sys_flush (stdout) + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_initialize + +!*********************************************************************** + + end module glc_InitMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_RunMod.F90 b/components/cism/source_glc/glc_RunMod.F90 new file mode 100644 index 0000000000..c454af7d83 --- /dev/null +++ b/components/cism/source_glc/glc_RunMod.F90 @@ -0,0 +1,183 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_RunMod + +!BOP +! !MODULE: glc_RunMod + +! !DESCRIPTION: +! Contains the routine for stepping the model forward one timestep +! +! !REVISION HISTORY: +! SVN:$Id: step_mod.F90 2019 2006-09-29 22:00:15Z njn01 $ +! Adapted by William Lipscomb from step_mod.F90 in POP 2.0 and from +! glint_example.F90 in GLIMMER +! +! !USES: + + use glc_kinds_mod + use glc_time_management, only: thour, time_manager, check_time_flag, init_time_flag + use shr_sys_mod + use glc_communicate, only: my_task, master_task + use glc_constants, only: verbose, stdout, glc_smb + use glc_exit_mod, only : exit_glc, sigAbort + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glc_run + +!---------------------------------------------------------------------- +! +! module variables +! +!---------------------------------------------------------------------- + + integer (i4) :: & + cpl_stop_now ,&! flag id for stop_now flag + tavg_flag ! flag to access tavg frequencies + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_run +! !INTERFACE: + + subroutine glc_run(EClock) + +! !DESCRIPTION: +! This routine advances the simulation one timestep. +! +! !REVISION HISTORY: +! same as module + +! !USES: + + use glad_main + use glimmer_log + use glc_fields + use glc_history, only : glc_history_write + use esmf, only : ESMF_Clock + +! !ARGUMENTS: + type(ESMF_Clock), intent(in) :: EClock + + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local or common variables: +! +!----------------------------------------------------------------------- + + logical, save :: first_call = .true. ! flag for initializing timers + + character(fname_length) :: & + paramfile ! Name of the top-level configuration file + + ! Scalars which hold information about the global grid + + integer (i4) :: & + nx,ny ! Size of global glc_grid + + ! Scalar model outputs + + ! Other variables + + !TODO - Remove? Currently not used + logical :: & + ice_tstep ,&! true if ice timestep was done + outflag ! output flag + + integer (i4) :: & + i,j,n ! indices + +!----------------------------------------------------------------------- +! things to do on first call +!----------------------------------------------------------------------- + + if (first_call) then + write(stdout,*) 'In glc_run, first_call =', first_call + ! this line should set cpl_stop_now = 1 (flag id index) + cpl_stop_now = init_time_flag('stop_now',default=.false.) + tavg_flag = init_time_flag('tavg') + first_call = .false. + endif + +!----------------------------------------------------------------------- +! +! Take one GLAD time step +! Note: For SMB scheme, tsfc = ground surface temperature (Celsius) +! qsmb = flux of new glacier ice (kg/m^2s) +! +! For PDD scheme, tsfc = 2m reference temperature (Celsius) +! qsmb = precipitation (kg/m^2/s) +!----------------------------------------------------------------------- + + if (glc_smb) then + + if (verbose .and. my_task==master_task) then + write(stdout,*) ' ' + write(stdout,*) 'Call glad, thour =', thour + write(stdout,*) ' ' + endif + + ! TODO(wjs, 2015-03-23) We will need a loop over instances, either here or + ! around the call to glc_run + + call glad_gcm (params = ice_sheet, instance_index = 1, & + time = nint(thour), & + qsmb = qsmb, tsfc = tsfc, & + ice_covered = ice_covered, topo = topo, & + rofi = rofi, rofl = rofl, hflx = hflx, & + ice_sheet_grid_mask=ice_sheet_grid_mask, & + icemask_coupled_fluxes=icemask_coupled_fluxes, & + ice_tstep = ice_tstep) + + else ! use PDD scheme + +!TODO - Implement and test PDD option + call exit_glc(sigAbort, 'ERROR: attempt to use PDD scheme, which has not been implemented') + + endif ! glc_smb + +!----------------------------------------------------------------------- +! +! update timestep counter, set corresponding model time, set +! time-dependent logical switches to determine program flow. +! +!----------------------------------------------------------------------- + + call time_manager + + if (verbose .and. my_task==master_task) then + write(stdout,*) 'Called time manager: new hour =', thour + endif + + !----------------------------------------------------------------------- + ! Write a history file if it's time to do so + !----------------------------------------------------------------------- + + ! TODO loop over instances + call glc_history_write(ice_sheet%instances(1), EClock) + +!----------------------------------------------------------------------- +!EOC + + end subroutine glc_run + +!*********************************************************************** + + end module glc_RunMod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_constants.F90 b/components/cism/source_glc/glc_constants.F90 new file mode 100644 index 0000000000..8c13815421 --- /dev/null +++ b/components/cism/source_glc/glc_constants.F90 @@ -0,0 +1,93 @@ +!======================================================================= +!BOP +! +! !MODULE: glc_constants - constants used by glc modules +! + module glc_constants + +! !DESCRIPTION: +! +! This module contains constants used by glc modules. +! +! Note that many of the required parameters are contained +! in glimmer_physcon and glimmer_params. +! Many of the parameters defined here are standard constants in POP. +! +! !REVISION HISTORY: +! Author: William Lipscomb, LANL + +! !USES: + + use glc_kinds_mod + use shr_const_mod, only: radius=> SHR_CONST_REARTH,& + tkfrz=> SHR_CONST_TKFRZ + +!lipscomb - Previously, stdout was defined in glc_constants. +! Moved to glimmer_paramets so that it can be accessed from +! glimmer source code as well as glc source code. +! Glimmer does most of its standard output by calling the +! write_log subroutine, which has a private output index +! called glimmer_unit, but it is convenient sometimes to +! write diagnostics directly to stdout. +! In CESM runs, glimmer_unit is set to stdout at initialization. + + use glimmer_paramets, only: stdout +!EOP +!======================================================================= + + implicit none + public + + include 'netcdf.inc' + + !----------------------------------------------------------------- + ! elevation class info + !----------------------------------------------------------------- + + logical, parameter :: verbose = .false. + + logical :: & + glc_smb ! if true, get surface mass balance from CLM via coupler + ! (in multiple elevation classes) + ! if false, use PDD scheme in GLIMMER + ! set in glc_cpl_indices_set + + !----------------------------------------------------------------- + ! common formats for formatted output + !----------------------------------------------------------------- + + integer (i4), public :: & + nml_in, &! reserved unit for namelist input +!! stdout, &! reserved unit for standard output + ! see note above + stderr ! reserved unit for standard error + + character (1), parameter, public :: & + char_delim = ',' + + character (9), parameter, public :: & + delim_fmt = "(72('-'))", & + ndelim_fmt = "(72('='))" + + character (5), parameter, public :: & + blank_fmt = "(' ')" + + character (char_len), public :: & + char_blank ! empty character string + + !----------------------------------------------------------------- + ! numbers + !----------------------------------------------------------------- + + real (r8), parameter, public :: & + c0 = 0.0_r8 ,& + c1 = 1.0_r8 + +!EOP +! + +!------------------------------------------------------------------------ + + end module glc_constants + +!------------------------------------------------------------------------ diff --git a/components/cism/source_glc/glc_ensemble.F90 b/components/cism/source_glc/glc_ensemble.F90 new file mode 100644 index 0000000000..e6476f85c7 --- /dev/null +++ b/components/cism/source_glc/glc_ensemble.F90 @@ -0,0 +1,186 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_ensemble + +!BOP +! !MODULE: glc_ensemble + +! !DESCRIPTION: +! Contains data and routines for running an ensemble with multiple, independent +! instances of GLC. This module is also used in the standard (non-ensemble) case. +! +! This should not be confused with the ability to have multiple instances of cism +! running in different places (e.g., Greenland & Antarctica). +! +! !REVISION HISTORY: +! Created by Bill Sacks +! +! !USES: + + use shr_kind_mod, only : IN=>SHR_KIND_IN + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: set_inst_vars + public :: write_inst_vars + public :: get_inst_suffix + public :: get_inst_name + +! !PRIVATE DATA MEMBERS: + + integer , private :: inst_index ! number of current instance (e.g., 1) + character(len=16), private :: inst_name ! full name of current instance (e.g., GLC_0001) + character(len=16), private :: inst_suffix ! character string associated with instance number + ! (e.g., "_0001", or "" for the single-instance case) + + logical, private :: initialized = .false. ! has the module data been initialized? + +!EOP + +!*********************************************************************** +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: set_inst_vars +! !INTERFACE: + subroutine set_inst_vars(COMPID) +! +! !DESCRIPTION: +! Set instance variables; this should be done in model initialization +! +! !USES: + use seq_comm_mct, only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use shr_sys_mod , only : shr_sys_abort +! +! !ARGUMENTS: + integer(IN), intent(in) :: COMPID ! component ID for this instance +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'set_inst_vars' +!EOP +!----------------------------------------------------------------------- + + if (initialized) then + ! Need to write to unit=* because stdout hasn't necessarily been initialized yet + write(*,*) subname, ' ERROR: module data have already been initialized' + call shr_sys_abort() + end if + + inst_name = seq_comm_name(COMPID) + inst_index = seq_comm_inst(COMPID) + inst_suffix = seq_comm_suffix(COMPID) + + initialized = .true. + + end subroutine set_inst_vars + +!*********************************************************************** +!BOP +! !IROUTINE: get_inst_suffix +! !INTERFACE: + subroutine get_inst_suffix(inst_suffix_out) +! +! !DESCRIPTION: +! Return the instance suffix +! +! !USES: + use glc_constants, only : stdout + use shr_sys_mod , only : shr_sys_abort +! +! !ARGUMENTS: + character(len=*), intent(out) :: inst_suffix_out ! instance suffix +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'get_inst_suffix' +!EOP +!----------------------------------------------------------------------- + + if (.not. initialized) then + write(stdout,*) subname, ' ERROR: instance variables have not been initialized' + call shr_sys_abort() + end if + + if (len_trim(inst_suffix) > len(inst_suffix_out)) then + write(stdout,*) subname, ' ERROR: output argument too small to hold inst_suffix' + call shr_sys_abort() + end if + + inst_suffix_out = inst_suffix + end subroutine get_inst_suffix + +!*********************************************************************** +!BOP +! !IROUTINE: get_inst_name +! !INTERFACE: + subroutine get_inst_name(inst_name_out) +! +! !DESCRIPTION: +! Return the instance name +! +! !USES: + use glc_constants, only : stdout + use shr_sys_mod , only : shr_sys_abort +! +! !ARGUMENTS: + character(len=*), intent(out) :: inst_name_out ! instance name +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'get_inst_name' +!EOP +!----------------------------------------------------------------------- + + if (.not. initialized) then + write(stdout,*) subname, ' ERROR: instance variables have not been initialized' + call shr_sys_abort() + end if + + if (len_trim(inst_name) > len(inst_name_out)) then + write(stdout,*) subname, ' ERROR: output argument too small to hold inst_name' + call shr_sys_abort() + end if + + inst_name_out = inst_name + end subroutine get_inst_name + +!*********************************************************************** +!BOP +! !IROUTINE: write_inst_vars +! !INTERFACE: + subroutine write_inst_vars +! +! !DESCRIPTION: +! Write instance variables to stdout +! +! !USES: + use glc_constants, only : stdout + use shr_sys_mod , only : shr_sys_abort + +! +! !ARGUMENTS: +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'write_inst_vars' +!EOP +!----------------------------------------------------------------------- + + if (.not. initialized) then + write(stdout,*) subname, ' ERROR: instance variables have not been initialized' + call shr_sys_abort() + end if + + write(stdout,*) 'inst_name: ', inst_name + write(stdout,*) 'inst_index: ', inst_index + write(stdout,*) 'inst_suffix: ', inst_suffix + + end subroutine write_inst_vars + +!*********************************************************************** + + end module glc_ensemble diff --git a/components/cism/source_glc/glc_exit_mod.F90 b/components/cism/source_glc/glc_exit_mod.F90 new file mode 100644 index 0000000000..3cfb10614d --- /dev/null +++ b/components/cism/source_glc/glc_exit_mod.F90 @@ -0,0 +1,151 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_exit_mod + +!BOP +! !MODULE: glc_exit_mod +! +! !DESCRIPTION: +! This module provides a means for a graceful exit from glc when +! encountering an error. it contains only the routines exit\_glc +! and flushm +! +! !REVISION HISTORY: +! SVN:$Id: exit_mod.F90 808 2006-04-28 17:06:38Z njn01 $ +! Adapted by William Lipscomb from exit_mod.F90 in POP + +! !USES: + + use glc_kinds_mod + use glc_communicate + use glc_constants + use shr_sys_mod + + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: exit_glc, flushm + +! !DEFINED PARAMETERS: + + integer (int_kind), parameter, public :: & + sigExit = 0, &! signal for normal exit + sigAbort = -1 ! signal for aborting (exit due to error) + +!EOP +!BOC +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: exit_glc +! !INTERFACE: + + subroutine exit_glc(exit_mode, exit_message) + +! !DESCRIPTION: +! This routine prints a message, exits any message environment +! and cleans up before stopping + +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + exit_mode ! method for exiting (normal exit or abort) + + character (*), intent(in) :: & + exit_message ! message to print before stopping + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: ierr ! error flag + +!----------------------------------------------------------------------- + + if (my_task == master_task) then + write (stdout,delim_fmt) + write (stdout,blank_fmt) + call shr_sys_flush(stdout) + + select case(exit_mode) + case(sigExit) + write (stdout,'(a14)') 'glc exiting...' + case(sigAbort) + write (stdout,'(a15)') 'glc aborting...' + case default + write (stdout,'(a37)') 'glc exiting with unknown exit mode...' + end select + + write (stdout,*) exit_message + write (stdout,blank_fmt) + write (stdout,delim_fmt) + call shr_sys_flush(stdout) + endif + +!----------------------------------------------------------------------- +! +! exit or abort the message-passing environment if required +! +!----------------------------------------------------------------------- + + select case(exit_mode) + case(sigExit) + call exit_message_environment(ierr) + case(sigAbort) + call abort_message_environment(ierr) + case default + end select + +!----------------------------------------------------------------------- +! +! now we can stop +! +!----------------------------------------------------------------------- + + stop + +!----------------------------------------------------------------------- +!EOC + + end subroutine exit_glc + +!*********************************************************************** +!BOP +! !IROUTINE: flushm (iunit) +! !INTERFACE: + + subroutine flushm (iunit) + +! !DESCRIPTION: +! This routine flushes the stdout buffer for the master_task only +! +! !REVISION HISTORY: +! same as module + integer (int_kind), intent(in) :: iunit + + if (my_task == master_task) then + call shr_sys_flush (iunit) + endif + + end subroutine flushm + +!*********************************************************************** + + end module glc_exit_mod + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_fields.F90 b/components/cism/source_glc/glc_fields.F90 new file mode 100644 index 0000000000..3df42571b5 --- /dev/null +++ b/components/cism/source_glc/glc_fields.F90 @@ -0,0 +1,159 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + +module glc_fields + +!BOP +! !MODULE: glc_fields + +! !DESCRIPTION: +! Holds coupling fields and other important data +! +! !REVISION HISTORY: +! +! Author: William Lipscomb, LANL +! +! !USES: + + use glc_kinds_mod + use glad_main, only: glad_params + + implicit none + save + +! !PUBLIC MEMBER FUNCTIONS: + +!---------------------------------------------------------------------- +! +! module variables +! +!---------------------------------------------------------------------- + + ! Fields received from CESM coupler + + real(r8),dimension(:,:), allocatable :: & + tsfc ,&! surface temperature (Celsius) + ! received from coupler in Kelvin, must be converted + qsmb ! flux of new glacier ice (kg/m^2/s) + + ! output to coupler + + ! the following need to be targets for the sake of the override code in glc_export + real(r8),dimension(:,:), allocatable, target :: & + ice_covered,& ! whether each grid cell is ice-covered [0,1] + topo ! glacier surface elevation (m) + + real(r8),dimension(:,:), allocatable :: & + rofi ,&! ice runoff (calving) flux (kg/m^2/s) + rofl ,&! ice runoff (calving) flux (kg/m^2/s) + hflx ! heat flux from glacier interior, positive down (W/m^2) + + ! Note that there are two separate mask fields. Both of them provide information about + ! where CISM is running. The difference is that ice_sheet_grid_mask includes icesheet + ! areas that are diagtostic-only, whereas icemask_coupled_fluxes excludes icesheet + ! areas where we are zeroing the fluxes sent to the coupler (thus, icesheets that are + ! "diagnostic" in some sense). We need two separate maps, as opposed to a single map + ! plus a scalar logical variable, in case we're running with multiple icesheet + ! instances (e.g., Greenland & Antarctica), one of which is fully prognostic and one of + ! which is diagnostic-only: in that case, ice_sheet_grid_mask would be non-zero over + ! both Greenland and Antarctica, whereas icemask_coupled_fluxes would be non-zero over + ! (e.g.) Greenland, but 0 over Antarctica. + real(r8),dimension(:,:), allocatable :: & + ice_sheet_grid_mask, & ! mask of ice sheet grid coverage + icemask_coupled_fluxes ! mask of ice sheet grid coverage where we are potentially sending non-zero fluxes + + type(glad_params) :: ice_sheet ! Parameters relevant to all model instances + +!EOP +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_allocate_fields +! !INTERFACE: + + subroutine glc_allocate_fields (nx, ny) + +! !DESCRIPTION: +! Allocate fields declared here +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !USES: + use glc_kinds_mod + +! !INPUT/OUTPUT PARAMETERS: + + integer (i4), intent(in) :: & + nx, ny ! grid dimensions + +!EOP +!BOC + + ! from coupler + allocate(tsfc(nx,ny)) + allocate(qsmb(nx,ny)) + + ! to coupler + allocate(ice_covered(nx,ny)) + allocate(topo(nx,ny)) + allocate(rofi(nx,ny)) + allocate(rofl(nx,ny)) + allocate(hflx(nx,ny)) + allocate(ice_sheet_grid_mask(nx,ny)) + allocate(icemask_coupled_fluxes(nx,ny)) + + end subroutine glc_allocate_fields + +!*********************************************************************** + +!BOP +! !IROUTINE: glc_deallocate_fields +! !INTERFACE: + + subroutine glc_deallocate_fields + +! !DESCRIPTION: +! Deallocate global arrays on glc grid. +! +! !USERDOC: +! +! !REFDOC: +! +! !REVISION HISTORY: +! same as module + +! !USES: + +! !INPUT/OUTPUT PARAMETERS: + + +!EOP +!BOC + + ! from coupler + deallocate(tsfc) + deallocate(qsmb) + + ! to coupler + deallocate(ice_covered) + deallocate(topo) + deallocate(rofi) + deallocate(rofl) + deallocate(hflx) + deallocate(ice_sheet_grid_mask) + deallocate(icemask_coupled_fluxes) + + end subroutine glc_deallocate_fields + +!*********************************************************************** + + end module glc_fields + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_files.F90 b/components/cism/source_glc/glc_files.F90 new file mode 100644 index 0000000000..8b755a970d --- /dev/null +++ b/components/cism/source_glc/glc_files.F90 @@ -0,0 +1,75 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_files + +!BOP +! !MODULE: glc_files + +! !DESCRIPTION: +! Manage file names of some special files: namelists, restart pointer file, etc. +! +! !REVISION HISTORY: +! +! !USES: + + use shr_kind_mod, only: CL=>SHR_KIND_CL + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: set_filenames + + +!---------------------------------------------------------------------- +! +! module variables +! +!---------------------------------------------------------------------- + + character(CL), public :: & + nml_filename , & ! namelist input file name + ionml_filename, & ! model IO namelist file name + ptr_filename ! restart pointer file name + +!EOP +!BOC +!EOC +!*********************************************************************** +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: set_filenames +! !INTERFACE: + subroutine set_filenames +! +! !DESCRIPTION: +! Set module variables that give various file names +! +! This should be done in model initialization, after the ensemble-related variables are +! initialized. +! +! !USES: + use glc_ensemble, only : get_inst_suffix +! +! !ARGUMENTS: +! +! !LOCAL VARIABLES: + character(len=16) :: inst_suffix +!EOP +!----------------------------------------------------------------------- + + call get_inst_suffix(inst_suffix) + + nml_filename = 'cism_in'//trim(inst_suffix) + ionml_filename = 'glc_modelio.nml'//trim(inst_suffix) + ptr_filename = 'rpointer.glc'//trim(inst_suffix) + + end subroutine set_filenames + +end module glc_files diff --git a/components/cism/source_glc/glc_history.F90 b/components/cism/source_glc/glc_history.F90 new file mode 100644 index 0000000000..4008d3cb5b --- /dev/null +++ b/components/cism/source_glc/glc_history.F90 @@ -0,0 +1,195 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + +module glc_history + + !BOP + ! !MODULE: glc_history + + ! !DESCRIPTION: + ! Contains routines for handling history output. + ! + ! Usage: + ! + ! - In initialization, call glc_history_init + ! + ! - Every time through the run loop, call glc_history_write + ! + ! !USES: + use glc_kinds_mod + use history_tape_base , only : history_tape_base_type, len_history_vars + use shr_kind_mod , only : CL=>SHR_KIND_CL, CXX=>SHR_KIND_CXX + use glc_exit_mod , only : exit_glc, sigAbort + use glc_constants , only : nml_in, stdout, blank_fmt, ndelim_fmt + + implicit none + private + save + + ! !PUBLIC ROUTINES: + public :: glc_history_init ! initialize the history_tape instance + public :: glc_history_write ! write to history file, if it's time to do so + + ! !PRIVATE ROUTINES: + private :: read_namelist + + ! !PRIVATE MODULE VARIABLES: + + ! TODO(wjs, 2015-02-18) Eventually, we may want to allow for multiple history tapes. In + ! that case, we should replace this scalar variable with an array. We would also need + ! to modify the code in this module to read namelist options for all history tapes, and + ! then have a loop that creates all history tape objects. Note that the history tape + ! index should be come a field in teh history tape class; this is needed to create + ! unique time flags for each history tape (and possibly other things). + class(history_tape_base_type), allocatable :: history_tape + + ! max character lengths + integer, parameter :: len_history_option = CL +contains + + !------------------------------------------------------------------------ + ! PUBLIC ROUTINES + !------------------------------------------------------------------------ + + !----------------------------------------------------------------------- + subroutine glc_history_init + ! + ! !DESCRIPTION: + ! Initialize the history_tape instance + ! + ! Should be called once, in model initialization + ! + ! !USES: + use glc_time_management, only : freq_opt_nyear + use history_tape_standard, only : history_tape_standard_type + use history_tape_coupler, only : history_tape_coupler_type + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + character(len=len_history_vars) :: cesm_history_vars + character(len=len_history_option) :: history_option + integer(int_kind) :: history_frequency + + character(len=*), parameter :: subname = 'glc_history_init' + !----------------------------------------------------------------------- + + call read_namelist(cesm_history_vars, history_option, history_frequency) + + select case (history_option) + case ('nyears') + allocate(history_tape, source = history_tape_standard_type( & + history_vars = cesm_history_vars, freq_opt = freq_opt_nyear, & + freq = history_frequency)) + case ('coupler') + allocate(history_tape, source = history_tape_coupler_type( & + history_vars = cesm_history_vars)) + case default + write(stdout,*) subname//' ERROR: Unhandled history_option: ', trim(history_option) + call exit_glc(sigAbort, subname//' ERROR: Unhandled history_option') + end select + + end subroutine glc_history_init + + !----------------------------------------------------------------------- + subroutine glc_history_write(instance, EClock) + ! + ! !DESCRIPTION: + ! Write a CISM history file, if it's time to do so. + ! + ! This routine should be called every time step. It will return without doing + ! anything if it isn't yet time to write a history file. + ! + ! !USES: + use glad_type, only : glad_instance + use esmf, only: ESMF_Clock + ! + ! !ARGUMENTS: + type(glad_instance), intent(inout) :: instance + type(ESMF_Clock), intent(in) :: EClock + !----------------------------------------------------------------------- + + call history_tape%write_history(instance, EClock) + + end subroutine glc_history_write + + + !------------------------------------------------------------------------ + ! PRIVATE ROUTINES + !------------------------------------------------------------------------ + + !----------------------------------------------------------------------- + subroutine read_namelist(cesm_history_vars, history_option, history_frequency) + ! + ! !DESCRIPTION: + ! Reads the namelist containing history options + ! + ! !USES: + use glc_communicate , only: my_task, master_task + use glc_files , only: nml_filename + use glc_broadcast , only: broadcast_scalar + ! + ! !ARGUMENTS: + character(len=len_history_vars), intent(out) :: cesm_history_vars + character(len=len_history_option), intent(out) :: history_option + integer(int_kind), intent(out) :: history_frequency + ! + ! !LOCAL VARIABLES: + + integer :: nml_error + + character(len=*), parameter :: subname = 'read_namelist' + !----------------------------------------------------------------------- + + namelist /cism_history/ cesm_history_vars, history_option, history_frequency + + ! Set default values + cesm_history_vars = ' ' + history_option = ' ' + history_frequency = 1 + + if (my_task == master_task) then + open(nml_in, file=nml_filename, status='old', iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + end if + do while (nml_error > 0) + read(nml_in, nml=cism_history, iostat=nml_error) + end do + if (nml_error == 0) then + close(nml_in) + end if + end if + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_glc(sigAbort,'ERROR reading cism_history namelist') + end if + + ! Write namelist settings + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' cism_history namelist settings:' + write(stdout,blank_fmt) + write(stdout, cism_history) + end if + + ! Send namelist settings to all procs + call broadcast_scalar(cesm_history_vars, master_task) + call broadcast_scalar(history_option, master_task) + call broadcast_scalar(history_frequency, master_task) + + if ((len_trim(cesm_history_vars)+3) >= len(cesm_history_vars)) then + ! Assume that if we get within 3 spaces of the variable legth (excluding spaces) + ! then we may be truncating the intended value + call exit_glc(sigAbort, subname// & + ' ERROR: The value of cesm_history_vars is too long for the variable') + end if + + end subroutine read_namelist + + +end module glc_history diff --git a/components/cism/source_glc/glc_indexing_info.F90 b/components/cism/source_glc/glc_indexing_info.F90 new file mode 100644 index 0000000000..7524440b7e --- /dev/null +++ b/components/cism/source_glc/glc_indexing_info.F90 @@ -0,0 +1,66 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + +module glc_indexing_info + + !BOP + ! !MODULE: glc_indexing_info + + ! !DESCRIPTION: + ! Contains information about the indexing of the points owned by each processor. + ! + ! This includes local indices (translation between (i,j) and a scalar 1..n) and global + ! indices (unique indices across all procs). + + implicit none + private + save + + ! !PUBLIC ROUTINES: + public :: glc_indexing_init + + ! !PUBLIC MODULE VARIABLES: + integer, public :: nx ! number of columns owned by this proc + integer, public :: ny ! number of rows owned by this proc + integer, public :: npts ! total number of points owned by this proc + integer, public :: nx_tot ! total number of columns in full grid (all procs) + integer, public :: ny_tot ! total number of rows in full grid (all procs) + integer, public :: npts_tot ! total number of points in full grid (all procs) + + integer, allocatable, public :: local_indices(:,:) ! mapping from (i,j) to 1..npts + integer, allocatable, public :: global_indices(:,:) ! unique indices across all procs (matches indexing on mapping files) + +contains + + !----------------------------------------------------------------------- + subroutine glc_indexing_init(params, instance_index) + ! + ! !DESCRIPTION: + ! Initialize indices stored here. + ! + ! Note that the global indexing needs to match the indexing on the SCRIP grid file + ! that is used to generate GLC mapping files for the coupler. + ! + ! !USES: + use glad_main, only : glad_params, glad_get_grid_size, glad_get_grid_indices + ! + ! !ARGUMENTS: + type(glad_params), intent(in) :: params + integer, intent(in) :: instance_index ! index of current ice sheet index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_indexing_init' + !----------------------------------------------------------------------- + + call glad_get_grid_size(params, instance_index, & + ewn = nx, nsn = ny, npts = npts, & + ewn_tot = nx_tot, nsn_tot = ny_tot, npts_tot = npts_tot) + + allocate(local_indices(nx, ny)) + allocate(global_indices(nx, ny)) + + call glad_get_grid_indices(params, instance_index, global_indices, local_indices) + + end subroutine glc_indexing_init + +end module glc_indexing_info diff --git a/components/cism/source_glc/glc_io.F90 b/components/cism/source_glc/glc_io.F90 new file mode 100644 index 0000000000..9a847f7676 --- /dev/null +++ b/components/cism/source_glc/glc_io.F90 @@ -0,0 +1,462 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_io + +!BOP +! !MODULE: glc_io + +! !DESCRIPTION: +! Contains routines for specialized glc IO +! +! !REVISION HISTORY: +! +! !USES: + + use glc_time_management, only: iyear, imonth, iday, ihour, iminute, isecond, & + runtype, cesm_date_stamp, elapsed_days, elapsed_days0 + use glc_communicate, only: my_task, master_task + use glimmer_ncdf, only: add_output, delete_output, nc_errorhandle + use glc_broadcast, only: broadcast_scalar + use glimmer_ncio, only: glimmer_nc_checkwrite, & + glimmer_nc_createfile + use glimmer_global, only: fname_length + use glc_constants + use glc_kinds_mod + use esmf, only: ESMF_Clock + use seq_timemgr_mod, only: seq_timemgr_EClockGetData + use shr_sys_mod + use shr_kind_mod, only: CL=>SHR_KIND_CL, CX=>SHR_KIND_CX, & + IN=>SHR_KIND_IN + use shr_file_mod, only: shr_file_getunit, shr_file_freeunit + use netcdf + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: glc_io_read_restart_time, & + glc_io_write_history, & + glc_io_write_restart + +!EOP +!BOC +!EOC +!*********************************************************************** +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: glc_io_read_restart_time +! !INTERFACE: + + subroutine glc_io_read_restart_time(nhour_glad, filename) + + use glc_files, only : ptr_filename + + implicit none + integer(IN), intent(inout) :: nhour_glad + character(fname_length), intent(inout) :: filename + + ! local variables + character(fname_length) :: filename0 + integer(IN) :: cesmYMD ! cesm model date + integer(IN) :: cesmTOD ! cesm model sec + integer(IN) :: glcYMD ! glc model date + integer(IN) :: glcTOD ! glc model sec + integer(IN) :: rst_elapsed_days ! + integer(IN) :: ptr_unit ! unit for pointer file + integer(IN) :: rst_unit ! unit for restart file + integer(IN) :: status ! + +!----------------------------------------------------------------------- + + if (my_task == master_task) then + + ! get restart filename from rpointer file + ptr_unit = shr_file_getUnit() + open(ptr_unit,file=ptr_filename) + read(ptr_unit,'(a)') filename0 + filename = trim(filename0) + close(ptr_unit) + write(stdout,*) & + 'glc_io_read_restart_time: using dumpfile for restart = ', filename + call shr_sys_flush(stdout) + call shr_file_freeunit(ptr_unit) + + ! read time from the restart file, since glimmer needs this to initialize + rst_unit = shr_file_getUnit() + status = nf90_open(filename,0,rst_unit) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_get_att(rst_unit, NF90_GLOBAL, 'cesmYMD', cesmYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_get_att(rst_unit, NF90_GLOBAL, 'cesmTOD', cesmTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_get_att(rst_unit, NF90_GLOBAL, 'glcYMD', glcYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_get_att(rst_unit, NF90_GLOBAL, 'glcTOD', glcTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_get_att(rst_unit, NF90_GLOBAL, 'elapsed_days', rst_elapsed_days) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_close(rst_unit) + call nc_errorhandle(__FILE__,__LINE__,status) + + end if + + call broadcast_scalar (cesmYMD , master_task) + call broadcast_scalar (cesmTOD , master_task) + call broadcast_scalar (glcYMD , master_task) + call broadcast_scalar (glcTOD , master_task) + call broadcast_scalar (rst_elapsed_days, master_task) + + ! calculate nhour_glad for return + nhour_glad = rst_elapsed_days * 24 + + end subroutine glc_io_read_restart_time + +!*********************************************************************** +!BOP +! !IROUTINE: glc_io_write_history +! !INTERFACE: + + subroutine glc_io_write_history(instance, EClock, history_vars, history_frequency_metadata) + + use glad_type + use glide_io, only : glide_io_create, glide_io_write + use glad_io, only : glad_io_create, glad_io_write + use glide_nc_custom, only: glide_nc_filldvars + implicit none + type(glad_instance), intent(inout) :: instance + type(ESMF_Clock), intent(in) :: EClock + character(len=*), intent(in) :: history_vars + character(len=*), intent(in) :: history_frequency_metadata + + ! local variables + type(glimmer_nc_output), pointer :: oc => null() + character(CL) :: filename + integer(IN) :: cesmYMD ! cesm model date + integer(IN) :: cesmTOD ! cesm model sec + integer(IN) :: cesmYR ! cesm model year + integer(IN) :: cesmMON ! cesm model month + integer(IN) :: cesmDAY ! cesm model day + integer(IN) :: glcYMD ! cism model date + integer(IN) :: glcTOD ! cism model sec + integer(IN) :: rst_elapsed_days ! + integer(IN) :: ptr_unit ! unit for pointer file + integer(IN) :: status ! + +!----------------------------------------------------------------------- + + ! figure out history filename + call seq_timemgr_EClockGetData(EClock, curr_ymd=cesmYMD, curr_tod=cesmTOD, & + curr_yr=cesmYR, curr_mon=cesmMON, curr_day=cesmDAY) + filename = glc_filename(cesmYR, cesmMON, cesmDAY, cesmTOD, 'history') + + if (my_task == master_task) then + write(stdout,*) & + 'glc_io_write_history: calling dumpfile for history filename= ', filename + call shr_sys_flush(stdout) + endif + + allocate(oc) + oc%freq = 1 + oc%append = .false. + oc%default_xtype = NF90_DOUBLE + oc%nc%filename = '' + oc%nc%filename = trim(filename) +!jw oc%nc%vars = ' acab artm thk usurf uvel vvel uflx vflx temp ' + oc%nc%vars = trim(history_vars) + oc%nc%vars_copy = oc%nc%vars +!jw TO DO: fill out the rest of the metadata +!jw oc%metadata%title = +!jw oc%metadata%institution = +!jw oc%metadata%source = +!jw oc%metadata%history = +!jw oc%metadata%references = +!jw oc%metadata%comment = + + ! create the output unit + call glimmer_nc_createfile(oc, instance%model) + call glide_io_create(oc, instance%model, instance%model) + call glad_io_create(oc, instance%model, instance) + + if (my_task == master_task) then + ! write time to the file + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'cesmYMD', cesmYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'cesmTOD', cesmTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'glcYMD', glcYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'glcTOD', glcTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + rst_elapsed_days = elapsed_days - elapsed_days0 + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'elapsed_days', rst_elapsed_days) + call nc_errorhandle(__FILE__,__LINE__,status) + + ! The following piece of metadata is needed to follow a CESM convention + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'time_period_freq', & + history_frequency_metadata) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + call glide_nc_filldvars(oc, instance%model) + call glimmer_nc_checkwrite(oc, instance%model, forcewrite=.true., & + time=instance%glide_time) + call glide_io_write(oc, instance%model) + call glad_io_write(oc, instance) + + if (my_task == master_task) then + status = nf90_close(oc%nc%id) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + oc => null() +!jw TO DO: figure out why deallocate statement crashes the code +!jw deallocate(oc) + + end subroutine glc_io_write_history + +!*********************************************************************** +!BOP +! !IROUTINE: glc_io_write_restart +! !INTERFACE: + + subroutine glc_io_write_restart(instance, EClock) + + use glc_files, only : ptr_filename + use glad_type + use glide_io, only : glide_io_create, glide_io_write + use glad_io, only : glad_io_create, glad_io_write + use glide_nc_custom, only: glide_nc_filldvars + implicit none + type(glad_instance), intent(inout) :: instance + type(ESMF_Clock), intent(in) :: EClock + + ! local variables + type(glimmer_nc_output), pointer :: oc => null() + character(CL) :: filename + integer(IN) :: cesmYMD ! cesm model date + integer(IN) :: cesmTOD ! cesm model sec + integer(IN) :: cesmYR ! cesm model year + integer(IN) :: cesmMON ! cesm model month + integer(IN) :: cesmDAY ! cesm model day + integer(IN) :: glcYMD ! cism model date + integer(IN) :: glcTOD ! cism model sec + integer(IN) :: rst_elapsed_days ! + integer(IN) :: ptr_unit ! unit for pointer file + integer(IN) :: status ! + +!----------------------------------------------------------------------- + + ! figure out restart filename + call seq_timemgr_EClockGetData(EClock, curr_ymd=cesmYMD, curr_tod=cesmTOD, & + curr_yr=cesmYR, curr_mon=cesmMON, curr_day=cesmDAY) + filename = glc_filename(cesmYR, cesmMON, cesmDAY, cesmTOD, 'restart') + + if (my_task == master_task) then + write(stdout,*) & + 'glc_io_write_restart: calling dumpfile for restart filename= ', filename + call shr_sys_flush(stdout) + endif + + allocate(oc) + oc%freq = 1 + oc%append = .false. + oc%default_xtype = NF90_DOUBLE + oc%nc%filename = '' + oc%nc%filename = trim(filename) + oc%nc%vars = ' restart ' + oc%nc%vars_copy = oc%nc%vars +!jw TO DO: fill out the rest of the metadata +!jw oc%metadata%title = +!jw oc%metadata%institution = +!jw oc%metadata%source = +!jw oc%metadata%history = +!jw oc%metadata%references = +!jw oc%metadata%comment = + + ! create the output unit + call glimmer_nc_createfile(oc, instance%model) + call glide_io_create(oc, instance%model, instance%model) + call glad_io_create(oc, instance%model, instance) + + if (my_task == master_task) then + ! write time to the file + glcYMD = iyear*10000 + imonth*100 + iday + glcTOD = ihour*3600 + iminute*60 + isecond + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'cesmYMD', cesmYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'cesmTOD', cesmTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'glcYMD', glcYMD) + call nc_errorhandle(__FILE__,__LINE__,status) + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'glcTOD', glcTOD) + call nc_errorhandle(__FILE__,__LINE__,status) + rst_elapsed_days = elapsed_days - elapsed_days0 + status = nf90_put_att(oc%nc%id, NF90_GLOBAL, 'elapsed_days', rst_elapsed_days) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + call glide_nc_filldvars(oc, instance%model) + call glimmer_nc_checkwrite(oc, instance%model, forcewrite=.true., & + time=instance%glide_time) + call glide_io_write(oc, instance%model) + call glad_io_write(oc, instance) + + if (my_task == master_task) then + status = nf90_close(oc%nc%id) + call nc_errorhandle(__FILE__,__LINE__,status) + end if + + oc => null() +!jw TO DO: figure out why deallocate statement crashes the code +!jw deallocate(oc) + + ! write pointer to restart file + if (my_task == master_task) then + ptr_unit = shr_file_getUnit() + open(ptr_unit,file=ptr_filename) + write(ptr_unit,'(a)') filename + close(ptr_unit) + call shr_file_freeunit(ptr_unit) + endif + + end subroutine glc_io_write_restart + +!*********************************************************************** +! BOP +! +! !ROUTINE: glc_filename +! +! !INTERFACE: + character(CL) function glc_filename( yr_spec, mon_spec, day_spec, sec_spec, file_type ) +! +! !DESCRIPTION: Create a filename from a filename specifier. Interpret filename specifier +! string with: +! %c for case +! %i for instance suffix +! %y for year +! %m for month +! %d for day +! %s for second +! %% for the "%" character +! If the filename specifier has spaces " ", they will be trimmed out +! of the resulting filename. +! +! !USES: + use glc_time_management, only: runid + use glc_ensemble , only: get_inst_suffix +! +! !INPUT/OUTPUT PARAMETERS: + integer, intent(in) :: yr_spec ! Simulation year + integer, intent(in) :: mon_spec ! Simulation month + integer, intent(in) :: day_spec ! Simulation day + integer, intent(in) :: sec_spec ! Seconds into current simulation day + character(7), intent(in) :: file_type ! file type, either history or restart +! +! EOP +! + integer :: i, n ! Loop variables + integer :: year ! Simulation year + integer :: month ! Simulation month + integer :: day ! Simulation day + integer :: ncsec ! Seconds into current simulation day + character(CX) :: string ! Temporary character string + character(CL) :: format ! Format character string + character(CL) :: filename_spec ! cism filename specifier + + !--------------------------------------------------------------------------- + ! Determine what the file tpye is and set the filename specifier accordingly + !--------------------------------------------------------------------------- + + filename_spec = ' ' + if (file_type.eq.'history') then + filename_spec = '%c.cism%i.h.%y-%m-%d-%s' + else if (file_type.eq.'restart') then + filename_spec = '%c.cism%i.r.%y-%m-%d-%s' + else + call shr_sys_abort ('glc_filename: file_type specifier is invalid') + endif + + !----------------------------------------------------------------- + ! Determine year, month, day and sec to put in filename + !----------------------------------------------------------------- + + if ( len_trim(filename_spec) == 0 )then + call shr_sys_abort ('glc_filename: filename specifier is empty') + end if + if ( index(trim(filename_spec)," ") /= 0 )then + call shr_sys_abort ('glc_filename: filename specifier can not contain a space:'//trim(filename_spec)) + end if + + year = yr_spec + month = mon_spec + day = day_spec + ncsec = sec_spec + + ! Go through each character in the filename specifier and interpret if special string + + i = 1 + glc_filename = '' + string = '' + do while ( i <= len_trim(filename_spec) ) + if ( filename_spec(i:i) == "%" )then + i = i + 1 + select case( filename_spec(i:i) ) + case( 'c' ) ! runid + string = trim(runid) + case( 'i' ) ! instance suffix + call get_inst_suffix(string) + case( 'y' ) ! year + if ( year > 99999 ) then + format = '(i6.6)' + else if ( year > 9999 ) then + format = '(i5.5)' + else + format = '(i4.4)' + end if + write(string,format) year + case( 'm' ) ! month + write(string,'(i2.2)') month + case( 'd' ) ! day + write(string,'(i2.2)') day + case( 's' ) ! second + write(string,'(i5.5)') ncsec + case( '%' ) ! percent character + string = "%" + case default + call shr_sys_abort ('glc_filename: Invalid expansion character: '//filename_spec(i:i)) + end select + else + n = index( filename_spec(i:), "%" ) + if ( n == 0 ) n = len_trim( filename_spec(i:) ) + 1 + if ( n == 0 ) exit + string = filename_spec(i:n+i-2) + i = n + i - 2 + end if + if ( len_trim(glc_filename) == 0 )then + glc_filename = trim(string) + else + if ( (len_trim(glc_filename)+len_trim(string)) >= CL )then + call shr_sys_abort ('glc_filename Resultant filename too long') + end if + glc_filename = trim(glc_filename) // trim(string) + end if + i = i + 1 + end do + if ( len_trim(glc_filename) == 0 )then + call shr_sys_abort ('glc_filename: Resulting filename is empty') + end if + + ! add ".nc" to tail end + glc_filename = trim(glc_filename) // '.nc' + +end function glc_filename + +end module glc_io diff --git a/components/cism/source_glc/glc_kinds_mod.F90 b/components/cism/source_glc/glc_kinds_mod.F90 new file mode 100644 index 0000000000..62bd8318ed --- /dev/null +++ b/components/cism/source_glc/glc_kinds_mod.F90 @@ -0,0 +1,43 @@ +!======================================================================= +!BOP +! +! !MODULE: glc_kinds_mod - defines variable precision +! +! !DESCRIPTION: +! +! Defines variable precision for all common data types +! +! !REVISION HISTORY: +! Adapted by William Lipscomb from ice_kinds_mod.F90 in CICE +! +! !INTERFACE: +! + module glc_kinds_mod +! +! !USES: +! +!EOP +!======================================================================= + + implicit none + save + + integer, parameter :: i4 = selected_int_kind(6), & + i8 = selected_int_kind(13), & + r4 = selected_real_kind(6), & + r8 = selected_real_kind(13), & + r16 = selected_real_kind(20) + + integer, parameter :: char_len = 80, & + char_len_long = 256, & + int_kind = kind(1), & + log_kind = kind(.true.), & + real_kind = selected_real_kind(6), & + dbl_kind = selected_real_kind(13), & + quad_kind = selected_real_kind(20) + +!======================================================================= + + end module glc_kinds_mod + +!======================================================================= diff --git a/components/cism/source_glc/glc_override_frac.F90 b/components/cism/source_glc/glc_override_frac.F90 new file mode 100644 index 0000000000..297675f92b --- /dev/null +++ b/components/cism/source_glc/glc_override_frac.F90 @@ -0,0 +1,316 @@ +module glc_override_frac + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! This module provides functionality to allow overriding the ice fractions (i.e., the + ! ice_covered field) and topographic heights that are sent to the coupler + + ! !USES: + + use glc_kinds_mod + + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public :: init_glc_frac_overrides ! initialize stuff in this module, including reading the namelist + public :: frac_overrides_enabled ! return true if overrides are enabled, false otherwise + public :: do_frac_overrides ! do all overrides + + ! !PRIVATE MEMBER FUNCTIONS: + private :: read_namelist ! read namelist setting options in this module + private :: apply_increase_frac + private :: apply_decrease_frac + private :: apply_rearrange_freq + private :: time_since_baseline ! return time (days) since the baseline for adjustments + + + ! !PRIVATE DATA MEMBERS: + logical(log_kind) :: enable_frac_overrides ! whether the overrides in this module are enabled for this run + integer(int_kind) :: override_delay ! time delay before beginning any overrides (days) + real(r8) :: decrease_frac ! fractional decrease per day (should be positive) + real(r8) :: increase_frac ! fractional increase per day + integer(int_kind) :: rearrange_freq ! frequency (days) at which we rearrange elevation classes + + ! Assumed maximum topographic height. It's okay for heights to go above this value, but + ! they may not be handled exactly as desired by the overrides here. + real(r8), parameter :: max_height = 3500._r8 + !--------------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine init_glc_frac_overrides + ! + ! !DESCRIPTION: + ! Initialize stuff in this module, including reading the namelist + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init_glc_frac_overrides' + !----------------------------------------------------------------------- + + call read_namelist + + end subroutine init_glc_frac_overrides + + + !----------------------------------------------------------------------- + subroutine read_namelist + ! + ! !DESCRIPTION: + ! Read namelist setting options in this module + ! + ! !USES: + use glc_files , only : nml_filename + use glc_constants , only : stdout, nml_in, blank_fmt, ndelim_fmt + use glc_communicate, only : my_task, master_task + use glc_broadcast , only : broadcast_scalar + use glc_exit_mod , only : exit_glc, sigAbort + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer(int_kind) :: nml_error ! namelist i/o error flag + + namelist /glc_override_nml/ enable_frac_overrides, override_delay, decrease_frac, & + increase_frac, rearrange_freq + + character(len=*), parameter :: subname = 'read_namelist' + !----------------------------------------------------------------------- + + ! Initialize namelist inputs + enable_frac_overrides = .false. + override_delay = 0 + decrease_frac = 0._r8 + increase_frac = 0._r8 + rearrange_freq = 0 + + ! Read namelist + if (my_task == master_task) then + open(nml_in, file=nml_filename, status='old', iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=glc_override_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + end if + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + call exit_glc(sigAbort,'ERROR reading glc_override_nml') + end if + + ! Write namelist settings + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' GLC Override Frac:' + write(stdout,blank_fmt) + write(stdout,*) ' glc_override_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout, glc_override_nml) + end if + + ! Send namelist settings to all procs + call broadcast_scalar(enable_frac_overrides, master_task) + call broadcast_scalar(override_delay, master_task) + call broadcast_scalar(decrease_frac, master_task) + call broadcast_scalar(increase_frac, master_task) + call broadcast_scalar(rearrange_freq, master_task) + + end subroutine read_namelist + + !----------------------------------------------------------------------- + function frac_overrides_enabled() result(enabled) + ! + ! !DESCRIPTION: + ! Return true if glc fraction overrides are enabled in this run + ! + ! !USES: + ! + ! !ARGUMENTS: + logical :: enabled ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'frac_overrides_enabled' + !----------------------------------------------------------------------- + + enabled = enable_frac_overrides + + end function frac_overrides_enabled + + !----------------------------------------------------------------------- + subroutine do_frac_overrides(ice_covered, topo, ice_sheet_grid_mask) + ! + ! !DESCRIPTION: + ! Do all overrides of glc fraction + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + real(r8), intent(inout) :: ice_covered(:,:) + real(r8), intent(inout) :: topo(:,:) + real(r8), intent(in) :: ice_sheet_grid_mask(:,:) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'do_frac_overrides' + !----------------------------------------------------------------------- + + call apply_increase_frac(ice_covered, topo, ice_sheet_grid_mask) + call apply_decrease_frac(ice_covered, topo, ice_sheet_grid_mask) + call apply_rearrange_freq(topo, ice_sheet_grid_mask) + + end subroutine do_frac_overrides + + !----------------------------------------------------------------------- + subroutine apply_increase_frac(ice_covered, topo, ice_sheet_grid_mask) + ! + ! !DESCRIPTION: + ! Apply increase_frac to ice_covered + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(inout) :: ice_covered(:,:) + real(r8), intent(in) :: topo(:,:) + real(r8), intent(in) :: ice_sheet_grid_mask(:,:) + ! + ! !LOCAL VARIABLES: + real(r8) :: increase_topo_threshold + + character(len=*), parameter :: subname = 'apply_increase_frac' + !----------------------------------------------------------------------- + + if (time_since_baseline() > 0) then + ! When time_since_baseline * increase_frac is 0, we'll set elevations >= max_height + ! to ice_covered = 1 + ! When time_since_baseline * increase_frac is 1, we'll set all elevations >= 0 to + ! ice_covered = 1 + ! In between those times, we'll use an intermediate threshold + increase_topo_threshold = (1._r8 - time_since_baseline() * increase_frac) * max_height + increase_topo_threshold = max(increase_topo_threshold, 0._r8) + increase_topo_threshold = min(increase_topo_threshold, max_height) + + where (ice_sheet_grid_mask > 0._r8 .and. topo >= increase_topo_threshold) + ice_covered = 1._r8 + end where + end if + + end subroutine apply_increase_frac + + !----------------------------------------------------------------------- + subroutine apply_decrease_frac(ice_covered, topo, ice_sheet_grid_mask) + ! + ! !DESCRIPTION: + ! Apply decrease_frac to ice_covered + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(inout) :: ice_covered(:,:) + real(r8), intent(in) :: topo(:,:) + real(r8), intent(in) :: ice_sheet_grid_mask(:,:) + ! + ! !LOCAL VARIABLES: + real(r8) :: decrease_topo_threshold + + character(len=*), parameter :: subname = 'apply_decrease_frac' + !----------------------------------------------------------------------- + + if (time_since_baseline() > 0) then + ! When time_since_baseline * decrease_frac is 0, we'll set elevations < 0 to + ! ice_covered = 0 + ! When time_since_baseline * decrease_frac is 1, we'll set all elevations < max_height + ! to ice_covered = 0 + ! In between those times, we'll use an intermediate threshold + decrease_topo_threshold = (time_since_baseline() * decrease_frac) * max_height + decrease_topo_threshold = max(decrease_topo_threshold, 0._r8) + decrease_topo_threshold = min(decrease_topo_threshold, max_height) + + where (ice_sheet_grid_mask > 0._r8 .and. topo < decrease_topo_threshold) + ice_covered = 0._r8 + end where + end if + + end subroutine apply_decrease_frac + + !----------------------------------------------------------------------- + subroutine apply_rearrange_freq(topo, ice_sheet_grid_mask) + ! + ! !DESCRIPTION: + ! Apply rearrange_freq to topographic heights. + ! + ! Example: if rearrange_freq = 3, then for the first 3 days, there will be no + ! rearrangement, for the next 3 days (days 4-6) the topographic heights will be + ! rearranged, for the next 3 days (days 7-9) the topographic heights will be back to + ! normal, etc. + ! + ! If rearrange_frac is <= 0, no rearrangement is done. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(inout) :: topo(:,:) + real(r8), intent(in) :: ice_sheet_grid_mask(:,:) + ! + ! !LOCAL VARIABLES: + integer(int_kind) :: num_intervals ! number of intervals of rearrange_freq + + character(len=*), parameter :: subname = 'apply_rearrange_freq' + !----------------------------------------------------------------------- + + if (time_since_baseline() > 0 .and. rearrange_freq > 0) then + ! num_intervals will be 0 in the first interval, 1 in the second, etc. + num_intervals = time_since_baseline() / rearrange_freq + + ! Rearrange topographic heights half the time + if (modulo(num_intervals, 2) == 1) then + where(ice_sheet_grid_mask > 0._r8) + topo = max(0._r8, max_height - topo) + end where + end if + end if + + end subroutine apply_rearrange_freq + + + !----------------------------------------------------------------------- + integer(int_kind) function time_since_baseline() + ! + ! !DESCRIPTION: + ! Return time (days) since the baseline for adjustments (based on override_delay) + ! + ! !USES: + use glc_time_management, only : elapsed_days_init_date + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'time_since_baseline' + !----------------------------------------------------------------------- + + time_since_baseline = elapsed_days_init_date - override_delay + + end function time_since_baseline + + + + +end module glc_override_frac diff --git a/components/cism/source_glc/glc_route_ice_runoff.F90 b/components/cism/source_glc/glc_route_ice_runoff.F90 new file mode 100644 index 0000000000..b443b5e28c --- /dev/null +++ b/components/cism/source_glc/glc_route_ice_runoff.F90 @@ -0,0 +1,199 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +!BOP +! +! !MODULE: glc_route_ice_runoff - route ice runoff to ocean or sea ice +! +module glc_route_ice_runoff + +! !DESCRIPTION: +! +! This module handles the routing of the solid ice runoff flux (i.e., calving) to either +! the ocean or sea ice, depending on a control flag. +! +! !REVISION HISTORY: +! Author: Bill Sacks + +! !USES: + + use glc_kinds_mod + use glc_constants, only: stdout + use glc_exit_mod + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: set_routing + public :: route_ice_runoff + public :: ice_needs_ocean_coupling + public :: ice_needs_sea_ice_coupling + +!EOP + + ! Define possible routing settings + integer(int_kind), parameter :: ROUTING_NULL = 0 + integer(int_kind), parameter :: ROUTING_TO_OCEAN = 1 + integer(int_kind), parameter :: ROUTING_TO_SEA_ICE = 2 + + ! the routing used for this run + integer(int_kind) :: routing = ROUTING_NULL + +!*********************************************************************** + +contains + +!*********************************************************************** +!BOP +! !IROUTINE: set_routing +! !INTERFACE: + + subroutine set_routing(routing_code) + +! !DESCRIPTION: +! Sets the routing type, given a routing code. +! Possible routing codes are: +! 'ocn': all ice runoff goes to ocean +! 'ice': all ice runoff goes to sea ice + +! !INPUT PARAMETERS: + + character(len=*), intent(in) :: routing_code ! name of the destination for ice runoff + +!EOP +!----------------------------------------------------------------------- + +! Local variables + + character(len=*), parameter :: subname = 'set_routing' + +!----------------------------------------------------------------------- + + select case (routing_code) + case ('ocn') + routing = ROUTING_TO_OCEAN + case ('ice') + routing = ROUTING_TO_SEA_ICE + case default + write (stdout,*) subname, ' ERROR: Unknown routing: ', trim(routing_code) + call exit_glc(sigAbort, ' ') + end select + + end subroutine set_routing + + +!*********************************************************************** +!BOP +! !IROUTINE: route_ice_runoff +! !INTERFACE: + + subroutine route_ice_runoff(rofi, rofi_to_ocn, rofi_to_ice) + +! !DESCRIPTION: +! Routes solid ice runoff to the appropriate destination(s). +! Assumes that set_routing has already been called + +! !INPUT PARAMETERS: + + real(r8), intent(in) :: rofi ! total solid ice runoff computed by glc for one grid cell + +! !OUTPUT PARAMETERS: + + real(r8), intent(out) :: rofi_to_ocn ! ice runoff to send to ocean + real(r8), intent(out) :: rofi_to_ice ! ice runoff to send to sea ice + +!EOP +!----------------------------------------------------------------------- + +! Local variables + + character(len=*), parameter :: subname = 'route_ice_runoff' + +!----------------------------------------------------------------------- + + select case (routing) + case (ROUTING_TO_OCEAN) + rofi_to_ocn = rofi + rofi_to_ice = 0._r8 + case (ROUTING_TO_SEA_ICE) + rofi_to_ocn = 0._r8 + rofi_to_ice = rofi + case default + write (stdout,*) subname, ' ERROR: Unknown routing: ', routing + call exit_glc(sigAbort, ' ') + end select + + end subroutine route_ice_runoff + +!*********************************************************************** + +!*********************************************************************** +!BOP +! !IROUTINE: ice_needs_ocean_coupling +! !INTERFACE: + + logical function ice_needs_ocean_coupling() + +! !DESCRIPTION: +! Returns true if the ice runoff requires ocn coupling, false otherwise + +!EOP +!----------------------------------------------------------------------- + +! Local variables + + character(len=*), parameter :: subname = 'ice_needs_ocean_coupling' + +!----------------------------------------------------------------------- + + select case (routing) + case (ROUTING_TO_OCEAN) + ice_needs_ocean_coupling = .true. + case (ROUTING_TO_SEA_ICE) + ice_needs_ocean_coupling = .false. + case default + write (stdout,*) subname, ' ERROR: Unknown routing: ', routing + call exit_glc(sigAbort, ' ') + end select + + end function ice_needs_ocean_coupling + +!*********************************************************************** + +!*********************************************************************** +!BOP +! !IROUTINE: ice_needs_sea_ice_coupling +! !INTERFACE: + + logical function ice_needs_sea_ice_coupling() + +! !DESCRIPTION: +! Returns true if the ice runoff requires ice coupling, false otherwise + +!EOP +!----------------------------------------------------------------------- + +! Local variables + + character(len=*), parameter :: subname = 'ice_needs_sea_ice_coupling' + +!----------------------------------------------------------------------- + + select case (routing) + case (ROUTING_TO_OCEAN) + ice_needs_sea_ice_coupling = .false. + case (ROUTING_TO_SEA_ICE) + ice_needs_sea_ice_coupling = .true. + case default + write (stdout,*) subname, ' ERROR: Unknown routing: ', routing + call exit_glc(sigAbort, ' ') + end select + + end function ice_needs_sea_ice_coupling + +!*********************************************************************** + +end module glc_route_ice_runoff + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/glc_time_management.F90 b/components/cism/source_glc/glc_time_management.F90 new file mode 100644 index 0000000000..a7093f01f1 --- /dev/null +++ b/components/cism/source_glc/glc_time_management.F90 @@ -0,0 +1,4096 @@ +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| + + module glc_time_management + +!BOP +! !MODULE: glc_time_management + +! !DESCRIPTION: +! This module contains a large number of routines for calendar, time +! flags and other functions related to model time. +! +! !REVISION HISTORY: +! SVN:$Id: time_management.F90 923 2006-05-10 22:25:10Z njn01 $ +! Adapted by William Lipscomb from time_management.F90 in POP. +! Much of the original POP code deleted because not needed here. + +!USES: + + use glc_kinds_mod + use glc_constants + use glc_communicate, only: my_task, master_task + use glc_broadcast, only: broadcast_scalar + use glc_exit_mod + use shr_sys_mod + + implicit none + public + save + +! !PUBLIC MEMBER FUNCTIONS: + + public :: init_time1, & + init_time2, & + time_manager, & + init_time_flag, & + set_time_flag, & + set_time_flag_last, & + check_time_flag, & + check_time_flag_freq_opt, & + check_time_flag_freq, & + time_to_do, & + time_to_start, & + time_stamp, & + int_to_char, & + cesm_date_stamp + +! !PUBLIC DATA TYPES: + + type time_flag + + character (char_len) :: & + name ! name for flag + + logical (log_kind) :: & + value, &! logical state of flag + old_value, &! last state of flag + default, &! default state of flag + has_default ! T if default defined, F if no default + + integer (int_kind) :: & + freq_opt, &! frequency units for switching flag on + freq ! freq in above units for switching flag + + end type + +! !PUBLIC DATA MEMBERS: + +!----------------------------------------------------------------------- +! +! variables for run control +! +!----------------------------------------------------------------------- + + character (char_len) :: & + stop_option ,&! specify how to determine stopping time + runtype ,&! type of cesm run (initial, continue, branch or hybrid) + dt_option ! method to determine tracer timestep size + + character (char_len_long) :: & + runid ! an identifier for the run + + integer (int_kind) :: & + stop_count ,&! num of stop_option intervals before stop + ! OR date (yyyymmdd) at which model stops + stop_iopt ,&! integer value for stop_option + nsteps_total ,&! steps (full&half) since beginning of run sequence + nsteps_run ,&! steps taken since beginning of this run + nsteps_per_day ! integer number of steps per day + + integer (int_kind), private :: & + stop_now ,&! time_flag id for stopping + coupled_ts ! time_flag id for a coupled timestep + + logical (log_kind) :: &! this timestep is: + eod ,&! at the end of the day + eom ,&! at the end of the month + eoy ,&! at the end of the year + first_step ,&! first time step + midnight ! at midnight + integer (int_kind) :: & + adjust_nyears ! number of years that we need to increment + + logical (log_kind) :: &! the next timestep is: + midnight_next ,&! at midnight + new_dtt_value ,&! does restart have a new step size + end_run_at_midnight ! does model run end at midnight + integer (int_kind) :: & + adjust_nyears_next ! number of years that we need to increment + + real (r8) :: & + steps_per_year ,& ! number of timesteps in one year + steps_per_day ,& ! number of timesteps in one day + dt_tol ,& ! used to determine close enough + dt_tol_year ! used to determine if seconds_this_year + ! is close enough to seconds_in_year + +!----------------------------------------------------------------------- +! +! quantities related to date +! +!----------------------------------------------------------------------- + + character (1) :: & + date_separator ! character to separate year-month-day + + integer (int_kind) :: & + iyear ,&! year [0,inf) for present timestep + imonth ,&! month [1,12] | + iday ,&! day [1,31] | + ihour ,&! hour [0,23] | + iminute ,&! minute [0,59] | + isecond ,&! second [0,59] | + iday_of_year ! day no. [1,365/6] V + + integer (int_kind) :: & + imonth_next ,&! month [1,12] for next timestep + iday_next ,&! day [1,31] | + ihour_next ,&! hour [0,23] | + iminute_next ,&! minute [0,59] | + isecond_next ,&! second [0,59] | + iday_of_year_next ! day no. [1,365/6] V + + integer (int_kind) :: & + iyear_last ,&! year [0,inf) from previous timestep + imonth_last ,&! month [1,12] | + iday_last ,&! day [1,31] | + ihour_last ,&! hour [0,23] | + iday_of_year_last ! day no. [1,365/6] V + + integer (int_kind) :: & + iyear0 ,&! initial start date and time + imonth0 ,&! for complete run + iday0 ,&! + ihour0 ,&! + iminute0 ,&! + isecond0 ! + + integer (int_kind) :: & + iyear_start_run ,&! initial start date and time + imonth_start_run ,&! for this run + iday_start_run ,&! + ihour_start_run ,&! + iminute_start_run ,&! + isecond_start_run ,&! + iday_of_year_start_run ! + + integer (int_kind) :: & + iyear_end_run ,&! final date for this run + imonth_end_run ,&! + iday_end_run ! + + integer (int_kind) :: &! number of: + days_in_year ,&! days in present year + elapsed_days ,&! full days elapsed since 01-01-0000 + elapsed_days0 ,&! full days elapsed between 01-01-0000 + ! and day0 + elapsed_days_jan1 ,&! full days elapsed prior to 01-01-iyear + elapsed_days_this_run ,&! full days elapsed since beginning of + ! this segment of run + elapsed_days_this_year ,&! full days elapsed since beginning of yr + elapsed_days_init_date ,&! full days elapsed since initial time + elapsed_days_end_run ,&! full days elapsed from 01-01-0000 to end + ! of this run + elapsed_days_max ,&! maximum number of full days allowed + elapsed_months ,&! full months elapsed since 01-01-0000 + elapsed_months_this_run ,&! full months elapsed since beginning of + ! this segment of run + elapsed_months_init_date,&! full months elapsed since initial time + elapsed_years ,&! full years elapsed since 01-01-0000 + elapsed_years_this_run ,&! full years elapsed since beginning of + ! this segment of run + elapsed_years_init_date ! full years elapsed since initial time + + integer (int_kind), parameter :: & + days_in_leap_year = 366, & ! days in a leap year + days_in_norm_year = 365 ! days in a non-leap year + + integer (int_kind), dimension(12) :: & + days_in_prior_months, &! cumulative num days in preceeding months + days_in_month = &! number of days in each calendar month + (/31,28,31, 30,31,30, 31,31,30, 31,30,31/) + ! J F M A M J J A S O N D + + real (r8) :: & + seconds_this_year ,&! seconds elapsed since beginning of year + seconds_this_day ,&! seconds elapsed this day + seconds_this_day_next ,&! seconds elapsed this day at next timestep + seconds_this_year_next ,&! seconds elapsed this year at next timestep + seconds_in_year ,&! seconds in one year -- this varies, + ! if leap years are allowed + hours_in_year ! hours in one year + + real (r8) :: & + frac_day ,&! fraction of the day elapsed today + tyear ,&! decimal elapsed time in years + tmonth ,&! decimal elapsed time in months + tday ,&! decimal elapsed time in days + thour ,&! decimal elapsed time in hours + tsecond ,&! decimal elapsed time in seconds + tsecond_old ! tsecond from previous timestep + + logical (log_kind) :: & + newhour ,&! + allow_leapyear ,&! allow leap years? + leapyear ! is this a leapyear? + + character (4) :: & + cyear ! character version of year + + character (2) :: & + cmonth ,&! character version of month + cday ,&! character version of day + chour ,&! character version of hour + cminute ,&! character version of minute + csecond ! character version of second + + character (3) :: & + cmonth3 ! character month in 3-letter form + + character (3), dimension(12), parameter :: & + month3_all = (/'jan','feb','mar','apr','may','jun', & + 'jul','aug','sep','oct','nov','dec'/) + + character (2), dimension(12), parameter :: & + cmonths = (/'01','02','03','04','05','06', & + '07','08','09','10','11','12'/) + + character (2), dimension(31), parameter :: & + cdays = (/'01','02','03','04','05','06','07','08','09','10', & + '11','12','13','14','15','16','17','18','19','20', & + '21','22','23','24','25','26','27','28','29','30', & + '31'/) + + real (r8), parameter :: & + seconds_in_minute = 60.0_r8, & + seconds_in_hour = 3600.0_r8, & + seconds_in_day = 86400.0_r8, & + minutes_in_hour = 60.0_r8 + + !*** for forcing calendar + + real (r8), public :: & + tyear00 ,&! + tsecond00 ,&! + tday00 ,&! + thour00 + +!----------------------------------------------------------------------- +! +! parameters for time frequency and start options +! +!----------------------------------------------------------------------- + + integer (int_kind), parameter :: &! integer choices for freq option + freq_opt_never = 0, & + freq_opt_nyear = 1, & + freq_opt_nmonth = 2, & + freq_opt_nday = 3, & + freq_opt_nhour = 4, & + freq_opt_nsecond = 5, & + freq_opt_nstep = 6 + + integer (int_kind), parameter :: &! integer choices for start options + start_opt_nstep = 1, & + start_opt_nday = 2, & + start_opt_nyear = 3, & + start_opt_date = 4 + + integer (int_kind), parameter :: & + next_opt_day = 1, & + next_opt_month = 2, & + next_opt_year = 3, & + stop_opt_never = 0, & + stop_opt_sometime = 1 + +!----------------------------------------------------------------------- +! +! user defined time flags +! +!----------------------------------------------------------------------- + + integer (int_kind), parameter :: & + max_time_flags=99 ! max number of user-defined flags + + type (time_flag), dimension(max_time_flags) :: & + time_flags ! array containing user-defined flags + + integer (int_kind) :: & + num_time_flags = 0 + +!----------------------------------------------------------------------- +! +! time-step related constants and variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + dt_count ,&! input count to determine dtt + dtt ,&! tracer timestep (sec) + dtt_input ,&! tracer timestep (sec) as specified in namelist + ! input; may be different from restart value + stepsize ,&! size of present timestep (sec) + stepsize_next ! size of next timestep (sec) + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! a few private variables used only internally +! +!----------------------------------------------------------------------- + + real (r8), private :: & + rhour_next, &! rhour for next timestep + rminute_next, &! rminute for next timestep + rsecond_next ! rsecond for next timestep + + logical (kind=log_kind),private :: & + debug_time_management = .false. + + ! WJS (12-21-11): xlf has been generating internal compiler errors + ! for this module, when building on bluefire; adding this unused + ! variable resolves them + ! (these errors were generated using IBM XL Fortran for AIX, + ! V12.1; Version: 12.01.0000.0008) + logical (log_kind),private :: dummy_to_make_xlf_happy + +!EOC +!*********************************************************************** + + contains + +!*********************************************************************** +!BOP +! !IROUTINE: init_time1 +! !INTERFACE: + + subroutine init_time1 + +! !DESCRIPTION: +! Initializes some time manager variables from namelist inputs +! and sets time step. Remaining time manager variables are +! initialized after restart files are read. +! +! !USES: + use glc_files, only : nml_filename +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nu, &! i/o unit number + nm ! month index + +!----------------------------------------------------------------------- +! +! namelist input +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nml_error ! namelist i/o error flag + + character (char_len) :: & + message + + namelist /time_manager_nml/ & + runid, dt_count, dt_option, & + iyear0, imonth0, iday0, & + ihour0, iminute0, isecond0, & + stop_option, stop_count, date_separator, & + allow_leapyear + +!----------------------------------------------------------------------- +! +! Set logical flags to default values. +! +!----------------------------------------------------------------------- + + stop_now = init_time_flag('stop_now' ,default=.false.) + coupled_ts = init_time_flag('coupled_ts') + + call reset_switches + +!----------------------------------------------------------------------- +! +! set initial values for namelist inputs +! +!----------------------------------------------------------------------- + + runid = 'unknown_runid' + allow_leapyear = .false. + stop_option = 'unknown_stop_option' + stop_count = -1 + dt_option = 'steps_per_day' + dt_count = 1 + + dt_tol = 1.0e-6 + dt_tol_year= 100.0*dt_tol + + iyear0 = 0 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + + date_separator = ' ' + +!----------------------------------------------------------------------- +! +! read options from namelist input file +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + open (nml_in, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nml_in, nml=time_manager_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nml_in) + endif + + call broadcast_scalar(nml_error, master_task) + + if (nml_error /= 0) then + call exit_glc(sigAbort,'ERROR reading time_manager_nml') + endif + + if (my_task == master_task) then + write(stdout,blank_fmt) + write(stdout,ndelim_fmt) + write(stdout,blank_fmt) + write(stdout,*) ' Time Management:' + write(stdout,blank_fmt) + write(stdout,*) ' time_manager_nml namelist settings:' + write(stdout,blank_fmt) + write(stdout,time_manager_nml) + write(stdout,blank_fmt) + endif + + call broadcast_scalar (runid , master_task) + call broadcast_scalar (iyear0 , master_task) + call broadcast_scalar (imonth0 , master_task) + call broadcast_scalar (iday0 , master_task) + call broadcast_scalar (ihour0 , master_task) + call broadcast_scalar (iminute0 , master_task) + call broadcast_scalar (isecond0 , master_task) + call broadcast_scalar (dt_option , master_task) + call broadcast_scalar (dt_count , master_task) + call broadcast_scalar (stop_option , master_task) + call broadcast_scalar (stop_count , master_task) + call broadcast_scalar (allow_leapyear , master_task) + call broadcast_scalar (date_separator , master_task) + + +!----------------------------------------------------------------------- +! +! error checking +! +!----------------------------------------------------------------------- + + ! If the trimmed runid takes up the entire allowed length, there is a good chance that + ! the intended runid was longer than the allowed length, so abort + if (len_trim(runid) >= len(runid)) then + call exit_glc(sigAbort,'runid exceeds max length: '//runid) + end if + +!----------------------------------------------------------------------- +! +! determine the value for dtt, based upon model input parameters +! +!----------------------------------------------------------------------- + + select case (dt_option) + + case('steps_per_year') + ! WJS (11-22-11): steps_per_year is currently incompatible with allow_leapyear= + ! .true., since that would require the time step (dtt) to vary each year; this + ! functionality doesn't exist + if (allow_leapyear) then + call exit_glc(sigAbort,'steps_per_year dt option incompatible with allow_leapyear') + end if + + steps_per_year = dt_count + steps_per_day = steps_per_year/days_in_norm_year + dtt = seconds_in_day/steps_per_day + + case('steps_per_day') + steps_per_day = dt_count + steps_per_year = steps_per_day*days_in_norm_year + dtt = seconds_in_day/steps_per_day + + case('seconds') + dtt = dt_count + steps_per_day = seconds_in_day/dtt + steps_per_year = steps_per_day *days_in_norm_year + + case('hours' ) + dtt = dt_count*seconds_in_hour + steps_per_day = seconds_in_day/dtt + steps_per_year = steps_per_day*days_in_norm_year + + case default + call exit_glc(sigAbort,'unknown dt_option') + end select + + if (verbose .and. my_task==master_task) then + write(stdout,*) 'dt_option =', trim(dt_option) + write(stdout,*) 'dt_count =', dt_count + write(stdout,*) 'seconds_in_day =', seconds_in_day + write(stdout,*) 'dtt =', dtt + call shr_sys_flush(stdout) + endif + + dtt_input = dtt + +!----------------------------------------------------------------------- +! +! check for incompatibility between dtt and allow_leapyear +! +!----------------------------------------------------------------------- + + ! WJS (11-22-11): allow_leapyear = .true. doesn't work with stepsize greater than 1 + ! year, because reduce_seconds doesn't handle this case + if (allow_leapyear .and. dtt > (seconds_in_day * days_in_norm_year)) then + call exit_glc(sigAbort,'dt > 1 year incompatible with allow_leapyear') + end if + +!----------------------------------------------------------------------- +! +! set initial values; some of these may be overwritten by +! restart input +! +!----------------------------------------------------------------------- + + iyear = iyear0 + imonth = imonth0 + iday = iday0 + ihour = ihour0 + iminute = iminute0 + isecond = isecond0 + + nsteps_total = 0 + + seconds_this_day = ihour0 *seconds_in_hour + & + iminute0*seconds_in_minute + & + isecond0 + +!----------------------------------------------------------------------- +! +! define days_in_prior_months; leap-year adjustments are made in +! subroutine init_timemanager_2 +! +!----------------------------------------------------------------------- + + call prior_days (days_in_prior_months, days_in_month) + +!----------------------------------------------------------------------- + + call flushm (stdout) +!EOC + + end subroutine init_time1 + +!*********************************************************************** +!BOP +! !IROUTINE: init_time2 +! !INTERFACE: + + subroutine init_time2 + +! !DESCRIPTION: +! Completes initialization of time manager quantities now that +! information from restart files is known +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nm, &! month index + days_in_month_temp, &! temp for days in month + days_in_year_end_run, &! temp for days in last year of run + ndays_temp ! temp for number of days + + logical (log_kind) :: & + leapyear_test ! test for leap year + + character (4) :: & + cyear_end_run ! character version of ending year + + character (2) :: & + cmonth_end_run, &! character version of ending month + cday_end_run ! character version of ending day + + character (*), parameter :: & + date_fmt = "(a17, 2x, a4,'-',a2,'-',a2)" + +!----------------------------------------------------------------------- +! +! determine the number of days, months, and years elapsed since +! 01-01-0000 and number of days and months elapsed this year +! +!----------------------------------------------------------------------- + + call ymd2eday (iyear , imonth , iday , elapsed_days ) + call ymd2eday (iyear , 1 , 1 , elapsed_days_jan1) + call ymd2eday (iyear0, imonth0, iday0, elapsed_days0 ) + + elapsed_days_this_year = elapsed_days - elapsed_days_jan1 + + elapsed_years = iyear + elapsed_months = iyear*12 + imonth - 1 + elapsed_days_this_run = 0 + elapsed_years_this_run = 0 + elapsed_months_this_run = 0 + elapsed_days_init_date = elapsed_days - elapsed_days0 + elapsed_years_init_date = iyear - iyear0 + elapsed_months_init_date = elapsed_years_init_date*12 - & + imonth0 + imonth + + seconds_this_year = elapsed_days_this_year*seconds_in_day + & + seconds_this_day + iday_of_year = elapsed_days_this_year + 1 + +!----------------------------------------------------------------------- +! +! determine if this is a leap year; set days_in_year and +! days_in_prior_months, regardless of value of allow_leapyear +! +!----------------------------------------------------------------------- + + call leap_adjust + +!----------------------------------------------------------------------- +! +! compare the value of dtt selected for this run via namelist input +! with that from the previous run. if different, time_manager +! will execute as if it were not a restart. +! +!----------------------------------------------------------------------- + +!lipscomb - TO DO - This may not be needed + if (dtt /= dtt_input ) then + new_dtt_value = .true. + dtt = dtt_input + endif + +!----------------------------------------------------------------------- +! +! compute seconds_this_year and seconds_the_day for next timestep +! +!----------------------------------------------------------------------- + + stepsize = dtt + stepsize_next = dtt + seconds_this_year_next = seconds_this_year + stepsize_next + seconds_this_day_next = seconds_this_day + stepsize_next + call reduce_seconds (seconds_this_day_next , & + seconds_this_year_next, adjust_nyears_next) + +!----------------------------------------------------------------------- +! +! determine tsecond, the number of seconds elapsed since beginning +! of complete simulation. +! +!----------------------------------------------------------------------- + + tsecond = elapsed_days_init_date*seconds_in_day + seconds_this_day + +!----------------------------------------------------------------------- +! +! check initial iday, imonth, etc values for reasonableness +! +!----------------------------------------------------------------------- + + if ( .not. valid_ymd_hms () ) then + call exit_glc(sigAbort,'invalid ymd_hms') + endif + +!----------------------------------------------------------------------- +! +! Compute decimal time in days, months, years, etc +! NOTE: newhour is not set initially +! +!----------------------------------------------------------------------- + + call get_tday + + call int_to_char(4,iyear,cyear) + cday = cdays (iday) + cmonth = cmonths (imonth) + cmonth3 = month3_all(imonth) + + nsteps_run = 0 + +!----------------------------------------------------------------------- +! +! set midnight +! +!----------------------------------------------------------------------- + + if (ihour == 0 .and. iminute == 0 .and. isecond == 0) then + midnight = .true. + else + midnight = .false. + endif + +!----------------------------------------------------------------------- +! +! save iyear, imonth, etc from the beginning of this run +! +!----------------------------------------------------------------------- + + iyear_start_run = iyear + imonth_start_run = imonth + iday_start_run = iday + ihour_start_run = ihour + iminute_start_run = iminute + isecond_start_run = isecond + + iday_of_year_start_run = iday_of_year + +!----------------------------------------------------------------------- +! +! will this run end exactly at midnight? +! (this tests only obvious possibilities) +! +!----------------------------------------------------------------------- + + if ( is_near (mod (seconds_in_day, dtt),c0,dt_tol) .and. & + is_near (seconds_this_day, c0,dt_tol) ) then + end_run_at_midnight = .true. + else + end_run_at_midnight = .false. + endif + +!----------------------------------------------------------------------- +! +! determine iyear, imonth, and iday for the end of this run +! +!----------------------------------------------------------------------- + + stop_iopt = stop_opt_sometime + + select case (stop_option) + + case ('never') !*** coupler or signal catcher stops glc + + stop_iopt = stop_opt_never + iyear_end_run = 9999 + imonth_end_run = 1 + iday_end_run = 1 + elapsed_days_max = 1e9 + + case ('eoy') !*** stop at end of stop_count years + + if (end_run_at_midnight) then + iyear_end_run = iyear + stop_count + imonth_end_run = 1 + iday_end_run = 1 + else + if (imonth == 12 .and. iday == 31) then + iyear_end_run = iyear + stop_count + else + iyear_end_run = iyear + stop_count - 1 + endif + imonth_end_run = 12 + iday_end_run = 31 + endif + + case ('eom') !*** stop at end of stop_count months + + iyear_end_run = iyear + imonth_end_run = imonth + stop_count + + call reduce_months (imonth_end_run, iyear_end_run ) + + if (end_run_at_midnight) then + iday_end_run = 1 + else + iday_end_run = days_in_month(imonth_end_run) + endif + + case ('eod') !*** stop at end of stop_count days + + if (end_run_at_midnight) then + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count + else + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count - 1 + endif + + case ('nyear', 'nyears') !*** stop after stop_count years + !*** need not be end of year + + iyear_end_run = iyear + stop_count + imonth_end_run = imonth + iday_end_run = iday + if (allow_leapyear .and. is_leapyear(iyear_end_run)) then + days_in_year_end_run = days_in_leap_year + else + days_in_year_end_run = days_in_norm_year + endif + if (is_near(mod(seconds_in_day*days_in_year_end_run, dtt), & + c0, dt_tol) ) then + end_run_at_midnight = .true. + else + end_run_at_midnight = .false. + endif + + case ('nmonth', 'nmonths') !*** stop after stop_count months + !*** need not be end of month + iyear_end_run = iyear + imonth_end_run = imonth + stop_count + iday_end_run = iday + + call reduce_months (imonth_end_run, iyear_end_run ) + + case ('nday', 'ndays') !*** stop after stop_count days + !*** identical to 'eod' + + if (end_run_at_midnight) then + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count + else + iyear_end_run = iyear + imonth_end_run = imonth + iday_end_run = iday + stop_count - 1 + endif + + case ('nstep', 'nsteps') !*** stop after stop_count steps + + ndays_temp = stop_count/steps_per_day + iday_end_run = iday + ndays_temp + iyear_end_run = iyear + imonth_end_run = imonth + + case ('date') + + call date2ymd (stop_count, iyear_end_run, & + imonth_end_run, iday_end_run) + + case default + call exit_glc(sigAbort,'Invalid stop_option: '/& + &/stop_option) + end select + +!----------------------------------------------------------------------- +! +! if necessary, adjust iyear_end_run, imonth_end_run, iday_end_run +! +!----------------------------------------------------------------------- + + if (is_leapyear(iyear_end_run)) then + leapyear_test = .true. + else + leapyear_test = .false. + endif + + if (imonth_end_run == 2 .and. stop_option == 'eom' ) then + + if (end_run_at_midnight) then + imonth_end_run = 3 + iday_end_run = 1 + else if (leapyear_test) then + imonth_end_run = 2 + iday_end_run = 29 + else + imonth_end_run = 2 + iday_end_run = 28 + endif + + else if (imonth_end_run == 2 .and. iday_end_run == 29) then + + if (.not. leapyear_test) then + if (end_run_at_midnight) then + imonth_end_run = 3 + iday_end_run = 1 + else + imonth_end_run = 2 + iday_end_run = 28 + endif + endif + + else + + if (imonth_end_run == 2 .and. leapyear_test) then + days_in_month_temp = 29 + else + days_in_month_temp = days_in_month(imonth_end_run) + endif + + do while (iday_end_run > days_in_month_temp) + + iday_end_run = iday_end_run - days_in_month_temp + imonth_end_run = imonth_end_run + 1 + + call reduce_months (imonth_end_run, iyear_end_run ) + + if (allow_leapyear .and. is_leapyear(iyear_end_run)) then + leapyear_test = .true. + else + leapyear_test = .false. + endif + + if (imonth_end_run == 2 .and. is_leapyear(iyear_end_run)) then + days_in_month_temp = 29 + else + days_in_month_temp = days_in_month(imonth_end_run) + endif + + enddo + + endif + + call ymd2eday (iyear_end_run, imonth_end_run, iday_end_run, & + elapsed_days_end_run) + + if (stop_iopt /= stop_opt_never) & + elapsed_days_max = elapsed_days_end_run + & + (dtt+dt_tol)/seconds_in_day + + if (elapsed_days_end_run < elapsed_days ) then + call int_to_char(4, iyear_end_run, cyear_end_run) + cmonth_end_run = cmonths(imonth_end_run) + cday_end_run = cdays (iday_end_run ) + if (my_task == master_task) then + write(stdout,'(a50)') & + ' Cannot end at a date earlier than starting date.' + write(stdout,date_fmt) ' Starting date: ', cyear,cmonth,cday + if (stop_iopt /= stop_opt_never) then + write(stdout,date_fmt) ' Ending date: ', & + cyear_end_run, cmonth_end_run, & + cday_end_run + else + write(stdout,'(a17)') ' No ending date.' + write(stdout,'(a47)') & + ' Model relies on external signal for stopping.' + endif + endif + call exit_glc(sigAbort,'invalid end date') + endif + +!----------------------------------------------------------------------- +! +! print various time manager options to log (stdout) +! +!----------------------------------------------------------------------- + + call write_time_manager_options + +!----------------------------------------------------------------------- +!EOC + + call flushm (stdout) + + end subroutine init_time2 + +!*********************************************************************** +!BOP +! !IROUTINE: time_manager +! !INTERFACE: + + subroutine time_manager + +! !DESCRIPTION: +! This routine updates various time-related variables to their +! end-of-step values. It is called once at the beginning of each +! timestep. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC + +!----------------------------------------------------------------------- +! +! save previous values of tsecond, isec, imin, ihour, etc +! +!----------------------------------------------------------------------- + + tsecond_old = tsecond + + iyear_last = iyear + imonth_last = imonth + iday_last = iday + iday_of_year_last = iday_of_year + ihour_last = ihour + +!----------------------------------------------------------------------- +! +! set logical switches to default values +! +!----------------------------------------------------------------------- + + call reset_switches + +!----------------------------------------------------------------------- +! +! increment the timestep counters +! +!----------------------------------------------------------------------- + + nsteps_run = nsteps_run + 1 + nsteps_total = nsteps_total + 1 + +!----------------------------------------------------------------------- +! +! activate logical switches which depend on nsteps_run, nsteps_total +! +!----------------------------------------------------------------------- + + call set_switches + +!----------------------------------------------------------------------- +! +! determine size of this timestep +! +!----------------------------------------------------------------------- + + stepsize = dtt + + if (verbose) then + write (stdout,*) 'New nsteps_run =', nsteps_run + write (stdout,*) 'New nsteps_total =', nsteps_total + write (stdout,*) 'stepsize =', stepsize + call shr_sys_flush(stdout) + endif + +!----------------------------------------------------------------------- +! +! compute seconds_this_year and seconds_the_day for this timestep, +! and adjust seconds counters if necessary +! +!----------------------------------------------------------------------- + + if (nsteps_total == 1 .or. new_dtt_value) then + seconds_this_year = seconds_this_year + stepsize + seconds_this_day = seconds_this_day + stepsize + call reduce_seconds (seconds_this_day , & + seconds_this_year , adjust_nyears) + else + seconds_this_year = seconds_this_year_next + seconds_this_day = seconds_this_day_next + adjust_nyears = adjust_nyears_next + endif + +!----------------------------------------------------------------------- +! +! if everything is working correctly, then seconds_this_year and +! seconds_this_day should be their reduced values, regardless of which +! path was followed in the above conditional; check for this +! +!----------------------------------------------------------------------- + + if (seconds_this_day >= seconds_in_day) then + call exit_glc(sigAbort,'too large value of seconds_this_day in time_manager') + end if + if (seconds_this_year >= seconds_in_year) then + call exit_glc(sigAbort,'too large value of seconds_this_year in time_manager') + end if + +!----------------------------------------------------------------------- +! +! determine the size of the next timestep +! +!----------------------------------------------------------------------- + + stepsize_next = dtt + +!----------------------------------------------------------------------- +! +! compute seconds_this_year and seconds_the_day for next timestep, +! and adjust seconds counters if necessary +! +!----------------------------------------------------------------------- + + seconds_this_year_next = seconds_this_year + stepsize_next + seconds_this_day_next = seconds_this_day + stepsize_next + + call reduce_seconds (seconds_this_day_next , & + seconds_this_year_next, adjust_nyears_next) + +!----------------------------------------------------------------------- +! +! compute present year, month, day, hour, minute, and second +! +!----------------------------------------------------------------------- + + call model_date + +!----------------------------------------------------------------------- +! +! compute decimal days, months, and years +! +!----------------------------------------------------------------------- + + call get_tday + if (ihour /= ihour_last) newhour = .true. + +!----------------------------------------------------------------------- +! +! set all user-defined time flags +! +!----------------------------------------------------------------------- + + call set_time_flag_all + +!----------------------------------------------------------------------- +! +! stop after this timestep? +! +!----------------------------------------------------------------------- + + if (stop_option == 'nstep' .or. stop_option == 'nsteps') then + if (nsteps_run == stop_count) call set_time_flag(stop_now,.true.) + + else if (stop_iopt /= stop_opt_never .and. eod) then + + if (iyear == iyear_end_run .and. imonth == imonth_end_run & + .and. iday == iday_end_run) then + + call set_time_flag(stop_now,.true.) + + if (stop_option == 'eoy' .and. .not. eoy) then + call set_time_flag(stop_now,.false.) + endif + if (stop_option == 'eom' .and. .not. eom) then + call set_time_flag(stop_now,.false.) + endif + + else if (elapsed_days > elapsed_days_max ) then + + call set_time_flag(stop_now,.true.) + + endif + + if (stop_option == 'eoy' .and. eoy .and. & + elapsed_years_this_run == stop_count) & + call set_time_flag(stop_now,.true.) + + if (stop_option == 'eom' .and. eom .and. & + elapsed_months_this_run == stop_count) & + call set_time_flag(stop_now,.true.) + + endif + + if (verbose .and. check_time_flag(stop_now)) then + write(stdout,*) 'Time manager, stop_now =', check_time_flag(stop_now) + write(stdout,*) 'stop_option, stop_count =', trim(stop_option), stop_count + endif + + new_dtt_value = .false. + +!----------------------------------------------------------------------- +! report gkc model time daily +!----------------------------------------------------------------------- + + if (eod) then + if (my_task == master_task) then + write(stdout,1000) iyear, cmonth3, iday, seconds_this_day + call shr_sys_flush(stdout) + endif + endif +1000 format (' (time_manager)', ' glc date ', i4.4, '-', a3, '-', & + i2.2,', ', 1pe12.6, ' sec') + +!----------------------------------------------------------------------- +!EOC + + end subroutine time_manager + +!*********************************************************************** +!BOP +! !IROUTINE: reset_switches +! !INTERFACE: + + subroutine reset_switches + +! !DESCRIPTION: +! Sets most logical switches to default values. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- + + eod = .false. ! not end-of-day + eom = .false. ! not end-of-month + eoy = .false. ! not end-of-year + + newhour = .false. ! not new hour + + call reset_time_flag_all + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_switches + +!*********************************************************************** +!BOP +! !IROUTINE: set_switches +! !INTERFACE: + + subroutine set_switches + +! !DESCRIPTION: +! Determine if logical switches should be set to non-default values +! for this timestep. The switches set in this subroutine must depend +! ONLY on nsteps\_run, or nsteps\_total. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! if first step, take Euler step +! +!----------------------------------------------------------------------- + + if (first_step) then + first_step = .false. + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_switches + +!*********************************************************************** +!BOP +! !IROUTINE: init_time_flag +! !INTERFACE: + + function init_time_flag(flag_name, default, freq_opt, freq) + +! !DESCRIPTION: +! Creates a user-defined time flag with optional default values +! and frequency. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + flag_name ! name for this flag + + logical (log_kind), intent(in), optional :: & + default ! default state for this flag + + integer (int_kind), intent(in), optional :: & + freq_opt, &! optional freq option for setting flag + freq ! freq in above units for setting flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + init_time_flag ! flag id which also is integer index + ! into time flag array + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy loop index + isearch ! index of flag during search + +!----------------------------------------------------------------------- +! +! search to determine if flag already exists +! +!----------------------------------------------------------------------- + + isearch = 0 + flag_search: do n=1,num_time_flags + if (trim(time_flags(n)%name) == flag_name) then + isearch = n + exit flag_search + endif + end do flag_search + +!----------------------------------------------------------------------- +! +! if no flag defined, define new flag and initialize +! +!----------------------------------------------------------------------- + + if (isearch == 0) then ! no flag exists - define new flag + + num_time_flags = num_time_flags + 1 + isearch = num_time_flags + + time_flags(isearch)%name = flag_name + + time_flags(isearch)%has_default = .false. + time_flags(isearch)%default = .false. + time_flags(isearch)%freq_opt = freq_opt_never + time_flags(isearch)%freq = 0 + time_flags(isearch)%value = .false. + time_flags(isearch)%old_value = .false. + endif + +!----------------------------------------------------------------------- +! +! set default if requested +! +! NOTE: If flag previously defined and optional arguments are +! present, this will override any previous definition of +! optional arguments. user must make sure calls do not +! contain optional arguments or else that the last call to +! this routine for a specific flag contains desired values. +! +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +! +! set default value of flag +! +!----------------------------------------------------------------------- + + if (present(default)) then + time_flags(isearch)%has_default = .true. + time_flags(isearch)%default = default + time_flags(isearch)%value = default + time_flags(isearch)%old_value = default + endif + +!----------------------------------------------------------------------- +! +! define optional frequency for setting flag +! +!----------------------------------------------------------------------- + + if (present(freq_opt)) then + time_flags(isearch)%freq_opt = freq_opt + time_flags(isearch)%freq = freq + endif + +!----------------------------------------------------------------------- +! +! print time_flag information for debugging purposes +! +!----------------------------------------------------------------------- + + if (debug_time_management .and. my_task == master_task) then + write(stdout,*) ' initialize time_flag(',isearch,')' + write(stdout,*) ' name = ' & + , trim(time_flags(isearch)%name) + write(stdout,*) ' has_default = ' & + , time_flags(isearch)%has_default + write(stdout,*) ' default = ' & + , time_flags(isearch)%default + write(stdout,*) ' freq_opt = ' & + , time_flags(isearch)%freq_opt + write(stdout,*) ' freq = ' & + , time_flags(isearch)%freq + write(stdout,*) ' value = ' & + , time_flags(isearch)%value + write(stdout,*) ' old_value = ' & + , time_flags(isearch)%old_value + write(stdout,*) ' ' + endif + +!----------------------------------------------------------------------- +! +! return array index as integer flag id +! +!----------------------------------------------------------------------- + + init_time_flag = isearch + +!----------------------------------------------------------------------- +!EOC + + end function init_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag +! !INTERFACE: + + subroutine set_time_flag(flag_id, value) + +! !DESCRIPTION: +! Sets the time flag given by flag\_id to the value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + + logical (log_kind), intent(in) :: & + value ! value requested for flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'set_time_flag: invalid flag_id') + + time_flags(flag_id)%value = value + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag_last +! !INTERFACE: + + subroutine set_time_flag_last(flag_id, old_value) + +! !DESCRIPTION: +! Sets the old value of time flag given by flag\_id to old\_value. +! +! !REVISION HISTORY: + +! !INPUT VARIABLES: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + + logical (log_kind), intent(in) :: & + old_value ! old value requested for flag + +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'set_time_flag: invalid flag_id') + + time_flags(flag_id)%old_value = old_value + +!----------------------------------------------------------------------- +!EOC + + end subroutine set_time_flag_last + +!*********************************************************************** +!BOP +! !IROUTINE: reset_time_flag +! !INTERFACE: + + subroutine reset_time_flag(flag_id) + +! !DESCRIPTION: +! Sets the time flag given by flag\_id to default value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then set flag +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'reset_time_flag: invalid flag_id') + + if (time_flags(flag_id)%has_default) then + time_flags(flag_id)%value = time_flags(flag_id)%default + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: reset_time_flag_all +! !INTERFACE: + + subroutine reset_time_flag_all + +! !DESCRIPTION: +! Sets all time flags to default value (if exists). +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy index + +!----------------------------------------------------------------------- +! +! check all flags for default value and set value if default exists +! +!----------------------------------------------------------------------- + + do n=1,num_time_flags + if (time_flags(n)%has_default) then + time_flags(n)%value = time_flags(n)%default + endif + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine reset_time_flag_all + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag +! !INTERFACE: + + function check_time_flag(flag_id) + +! !DESCRIPTION: +! Returns the current value of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + check_time_flag ! current value of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) then + call exit_glc(sigAbort,'check_time_flag: invalid flag_id') + endif + + check_time_flag = time_flags(flag_id)%value + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_freq_opt +! !INTERFACE: + + function check_time_flag_freq_opt(flag_id) + +! !DESCRIPTION: +! Returns the current frequency of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + check_time_flag_freq_opt ! current freqeuncy option of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'check_time_flag: invalid flag_id') + + check_time_flag_freq_opt = time_flags(flag_id)%freq_opt + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_freq_opt + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_freq +! !INTERFACE: + + function check_time_flag_freq(flag_id) + +! !DESCRIPTION: +! Returns the current frequency of time flag given by flag\_id. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + integer (int_kind) :: & + check_time_flag_freq ! current freqeuncy option of time flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'check_time_flag_freq: invalid flag_id') + + check_time_flag_freq = time_flags(flag_id)%freq + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_freq + +!*********************************************************************** +!BOP +! !IROUTINE: check_time_flag_last +! !INTERFACE: + + function check_time_flag_last(flag_id) + +! !DESCRIPTION: +! Returns the value of time flag given by flag\_id at previous +! time step +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + flag_id ! index of flag array identifying flag + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + check_time_flag_last ! value of time flag at last timestep + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for proper flag id and then return old flag value +! +!----------------------------------------------------------------------- + + if (flag_id < 1 .or. flag_id > num_time_flags) & + call exit_glc(sigAbort,'check_time_flag_last: invalid flag_id') + + check_time_flag_last = time_flags(flag_id)%old_value + +!----------------------------------------------------------------------- +!EOC + + end function check_time_flag_last + +!*********************************************************************** +!BOP +! !IROUTINE: set_time_flag_all +! !INTERFACE: + + subroutine set_time_flag_all + +! !DESCRIPTION: +! Sets all time flags based on frequency options. +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: n ! dummy index + +!----------------------------------------------------------------------- +! +! if it is time, set time flag and save value from old time +! +!----------------------------------------------------------------------- + + do n=1,num_time_flags + + if (time_flags(n)%freq_opt /= freq_opt_never) then + + time_flags(n)%old_value = time_flags(n)%value + time_flags(n)%value = time_to_do(time_flags(n)%freq_opt, & + time_flags(n)%freq) + + endif + + end do + +!----------------------------------------------------------------------- + + end subroutine set_time_flag_all + +!*********************************************************************** +!BOP +! !IROUTINE: time_to_do +! !INTERFACE: + + function time_to_do (in_freq_opt, in_freq) + +! !DESCRIPTION: +! Determines whether it is time to take a particular action based on +! input frequency options. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + in_freq_opt, &! frequency option for this action + in_freq ! frequency in above intervals for action + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + time_to_do ! true if current timestep matches input + ! frequency conditions + +!EOP +!BOC +!----------------------------------------------------------------------- + + time_to_do = .false. + + select case (in_freq_opt) + + case (freq_opt_nyear) + if (eoy .and. mod(elapsed_years_init_date,in_freq) == 0) & + time_to_do = .true. + + case (freq_opt_nmonth) + if (eom .and. mod(elapsed_months_init_date,in_freq) == 0) & + time_to_do = .true. + + case (freq_opt_nday) + if (eod) then + if (midnight) then + if (mod(elapsed_days_init_date ,in_freq) == 0) & + time_to_do = .true. + else + if (mod(elapsed_days_init_date+1,in_freq) == 0) & + time_to_do = .true. + endif + endif + + case (freq_opt_nhour) + if (newhour .and. mod(ihour,in_freq) == 0) time_to_do = .true. + + case (freq_opt_nsecond) + if (mod(isecond,in_freq) == 0) time_to_do = .true. + + case (freq_opt_nstep) + if (mod(nsteps_total,in_freq) == 0) time_to_do = .true. + + case default + end select + +!----------------------------------------------------------------------- +!EOC + + end function time_to_do + +!*********************************************************************** +!BOP +! !IROUTINE: time_to_start +! !INTERFACE: + + function time_to_start (in_start_opt, in_start) + +! !DESCRIPTION: +! Determines whether it is time to start a particular function based +! on input start options. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + in_start_opt, &! start option for this action + in_start ! start after value + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + time_to_start ! true if current timestep matches input + ! start conditions + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + eday_loc ! temporary value for elapsed days + +!----------------------------------------------------------------------- +! +! check start conditions - do not start if called from initial +! (nsteps_run == 0) and the condition matches exactly - the +! start will instead be triggered during the time step. This +! avoids looking for restarts that do not yet exist. +! +!----------------------------------------------------------------------- + + time_to_start = .false. + + select case (in_start_opt) + + case (start_opt_nstep) + if (nsteps_total > in_start) then + time_to_start = .true. + else if (nsteps_total == in_start .and. nsteps_run /= 0) then + time_to_start = .true. + endif + + case (start_opt_nday) + if (elapsed_days_init_date > in_start) then + time_to_start = .true. + else if (elapsed_days_init_date == in_start .and. & + nsteps_run /= 0) then + time_to_start = .true. + endif + + case (start_opt_nyear) + if (elapsed_years_init_date > in_start) then + time_to_start = .true. + else if (elapsed_years_init_date == in_start .and. & + nsteps_run /= 0) then + time_to_start = .true. + else if (elapsed_years_init_date == in_start .and. & + elapsed_days_this_year > 1) then + time_to_start = .true. + endif + + case (start_opt_date) + call date2eday (in_start, eday_loc) + if (elapsed_days > eday_loc) then + time_to_start = .true. + else if (elapsed_days == eday_loc .and. nsteps_run /= 0) then + time_to_start = .true. + endif + + case default + call exit_glc(sigAbort,'unknown start option in time_to_start') + end select + +!----------------------------------------------------------------------- +!EOC + + end function time_to_start + +!*********************************************************************** +!BOP +! !IROUTINE: model_date +! !INTERFACE: + + subroutine model_date + +! !DESCRIPTION: +! Determines iyear, imonth, iday, ihour, iminute, isecond, as +! well as elapsed days, months, and years +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + real (r8) :: & + rhour, &! number of hours elapsed today + rminute, &! number of minutes beyond the hour + rsecond, &! number of seconds beyond the minute + seconds_today ! number of seconds elapsed today + + integer (int_kind) :: & + i, &! counter + days_in_prior_years,&! total days in years whose boundaries we have crossed + ! in this timestep + day_inc, &! change in the number of days elapsed between timesteps + month_inc, &! change in the number of months elapsed between timesteps + year_inc ! change in the number of years elapsed between timesteps + + + logical (log_kind) :: & + next_is_different_day, &! true if the next timestep is a different day from the current timestep + next_is_different_month, &! true if the next timestep is a different month from the current timestep + next_is_month_plus_1 ! true if the next timestep is in the month immediately + ! following the month of the current timestep + +!----------------------------------------------------------------------- +! +! determine iyear +! +!----------------------------------------------------------------------- + + days_in_prior_years = 0 + + ! We do the following adjustment in a loop to allow the leap year adjustment to be + ! done properly for each year that we're incrementing (needed for correct + ! adjustment of days_in_prior_years) + do i = 1, adjust_nyears + days_in_prior_years = days_in_prior_years + days_in_year + iyear = iyear + 1 + + ! the following sets days_in_year appropriately, among other things + if (allow_leapyear) call leap_adjust + end do + +!----------------------------------------------------------------------- +! +! determine iday_of_year, imonth, iday, ihour, iminute, isecond +! rhour, rminute, rsecond +! +!----------------------------------------------------------------------- + + if (nsteps_run == 1) then + call ymd_hms( seconds_this_year, seconds_this_day, & + iday_of_year, & + imonth, iday , iday_of_year_last, & + ihour , iminute, isecond, & + rhour , rminute, rsecond, & + midnight , adjust_nyears) + else + iday_of_year = iday_of_year_next + imonth = imonth_next + iday = iday_next + ihour = ihour_next + iminute = iminute_next + isecond = isecond_next + rhour = rhour_next + rminute = rminute_next + rsecond = rsecond_next + midnight = midnight_next + endif + +!----------------------------------------------------------------------- +! +! determine iday_of_year, imonth, iday, etc, for next timestep +! +!----------------------------------------------------------------------- + + call ymd_hms(seconds_this_year_next, & + seconds_this_day_next, & + iday_of_year_next, & + imonth_next , iday_next , iday_of_year, & + ihour_next , iminute_next, isecond_next, & + rhour_next , rminute_next, rsecond_next, & + midnight_next, adjust_nyears_next) + +!----------------------------------------------------------------------- +! +! end of day? +! +!----------------------------------------------------------------------- + + next_is_different_day = (adjust_nyears_next > 0 .or. iday_of_year_next /= iday_of_year) + if (next_is_different_day) then + if (.not. midnight_next) eod = .true. + if (stepsize_next + dt_tol > seconds_in_day) eod = .true. + endif + + if (midnight) eod = .true. + +!----------------------------------------------------------------------- +! +! end of month? +! +!----------------------------------------------------------------------- + + next_is_different_month = (adjust_nyears_next > 0 .or. imonth_next /= imonth) + if (midnight .and. iday == 1) then + eom = .true. + + else if (next_is_different_month) then + next_is_month_plus_1 = (adjust_nyears_next == 0 .and. imonth_next == imonth+1) .or. & + (adjust_nyears_next == 1 .and. imonth == 12 .and. & + imonth_next == 1) + if (midnight_next .and. iday_next == 1 .and. next_is_month_plus_1) then + ! the NEXT timestep is considered to be the end of the month + eom = .false. + else + eom = .true. + end if + + else + eom = .false. + end if + +!----------------------------------------------------------------------- +! +! elapsed months (integer) +! +!----------------------------------------------------------------------- + + month_inc = adjust_nyears*12 + imonth - imonth_last + elapsed_months = elapsed_months + month_inc + elapsed_months_this_run = elapsed_months_this_run + month_inc + elapsed_months_init_date = elapsed_months_init_date + month_inc + +!----------------------------------------------------------------------- +! +! end of year? +! +!----------------------------------------------------------------------- + + if (midnight .and. iday_of_year == 1) then + eoy = .true. + else if (adjust_nyears_next == 0) then + eoy = .false. + else if (adjust_nyears_next == 1) then + if (midnight_next .and. iday_of_year_next == 1) then + ! the NEXT timestep is considered to be the end of the year + eoy = .false. + else + eoy = .true. + end if + else if (adjust_nyears_next > 1) then + eoy = .true. + else + call exit_glc(sigAbort,'Unexpected value for adjust_nyears_next in model_date') + end if + +!----------------------------------------------------------------------- +! +! adjust elapsed years and elapsed days in the year (integer) +! +!----------------------------------------------------------------------- + + year_inc = adjust_nyears + elapsed_years = elapsed_years + year_inc + elapsed_years_this_run = elapsed_years_this_run + year_inc + elapsed_years_init_date = elapsed_years_init_date + year_inc + + if (year_inc > 0) then + call ymd2eday (iyear , 1, 1, elapsed_days_jan1) + elapsed_days_this_year = elapsed_days - elapsed_days_jan1 + end if + +!----------------------------------------------------------------------- +! +! character values for iyear, imonth, iday +! +!----------------------------------------------------------------------- + + if (iyear /= iyear_last ) call int_to_char(4, iyear, cyear) + + if (imonth /= imonth_last) then + cmonth = cmonths (imonth) + cmonth3 = month3_all(imonth) + endif + + if (iday /= iday_last) cday = cdays(iday) + +!----------------------------------------------------------------------- +! +! elapsed number of days (integer) +! +!----------------------------------------------------------------------- + + day_inc = iday_of_year - iday_of_year_last + days_in_prior_years + + elapsed_days = elapsed_days + day_inc + elapsed_days_this_run = elapsed_days_this_run + day_inc + elapsed_days_this_year = elapsed_days_this_year + day_inc + elapsed_days_init_date = elapsed_days_init_date + day_inc + +!----------------------------------------------------------------------- +! +! has a valid date been selected? +! +!----------------------------------------------------------------------- + + if (.not. valid_ymd_hms()) then + call exit_glc(sigAbort,'invalid ymd_hms') + endif + +!----------------------------------------------------------------------- +!EOC + + end subroutine model_date + +!*********************************************************************** +!BOP +! !IROUTINE: get_tday +! !INTERFACE: + + subroutine get_tday + +! !DESCRIPTION: +! Computes decimal day, month, year, etc. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: +! !OUTPUT PARAMETERS: +!EOP +!BOC +!----------------------------------------------------------------------- +! +! creating floating point values for elapsed time in various units +! +!----------------------------------------------------------------------- + + frac_day= seconds_this_day/seconds_in_day + + tsecond = elapsed_days_init_date*seconds_in_day + seconds_this_day + + tday = tsecond/seconds_in_day + + tmonth = real(elapsed_months_init_date,r8) + & + (real(iday,r8)-c1+frac_day)/days_in_month(imonth) + + tyear = elapsed_years_init_date + seconds_this_year/seconds_in_year + + thour = tday*24.0_r8 + +!----------------------------------------------------------------------- +! +! define tday00 and thour00 for use in forcing routines. +! these are the time in days/hours since 01-01-0000. +! +!----------------------------------------------------------------------- + + tyear00 = elapsed_years + seconds_this_year/seconds_in_year + tday00 = elapsed_days + frac_day + thour00 = tday00*24.0_r8 + tsecond00 = tday00*seconds_in_day + +!----------------------------------------------------------------------- +!EOC + + end subroutine get_tday + +!*********************************************************************** +!BOP +! !IROUTINE: ymd_hms +! !INTERFACE: + + subroutine ymd_hms(seconds_this_year_loc , seconds_this_day_loc, & + iday_of_year_loc, & + imonth_loc , iday_loc , iday_of_year_compare,& + ihour_loc , iminute_loc, isecond_loc, & + rhour_loc , rminute_loc, rsecond_loc, & + midnight_loc, adjust_nyears_loc) + +! !DESCRIPTION: +! Computes integer values iday\_of\_year, iyear, imonth, iday, ihour, +! iminute, isecond. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iday_of_year_compare, &! day of year to compare to check day change + adjust_nyears_loc ! number of years that we need to increment + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), intent(inout) :: & + seconds_this_year_loc ,&! number of seconds in year + seconds_this_day_loc ! number of seconds in day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + imonth_loc, &! local value of imonth + iday_loc, &! local value of iday + ihour_loc, &! local value of ihour + iminute_loc, &! local value of iminute + isecond_loc, &! local value of isecond + iday_of_year_loc ! local value of iday_of_year + + real (r8), intent(out) :: & + rhour_loc, &! real value for hour + rminute_loc, &! real value for minute + rsecond_loc ! real value for second + + logical (log_kind), intent(out) :: & + midnight_loc ! midnight flag + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + itest, & + nm, & + ntest + + real (r8) :: & + test_seconds, & + rtest, & + r_ntest + +!----------------------------------------------------------------------- +! +! determine day number [1,days_in_year] +! +!----------------------------------------------------------------------- + + rtest = seconds_this_year_loc/seconds_in_day + itest = int (rtest) + ntest = nint (rtest) + r_ntest = ntest + + if (is_near(rtest, r_ntest, dt_tol)) then + iday_of_year_loc = ntest + 1 + else + iday_of_year_loc = itest + 1 + endif + +!----------------------------------------------------------------------- +! +! determine month number [1,12] +! +!----------------------------------------------------------------------- + + imonth_loc = 12 + + do nm = 1,11 + if (iday_of_year_loc > days_in_prior_months(nm) .and. & + iday_of_year_loc <= days_in_prior_months(nm+1)) & + imonth_loc = nm + enddo + +!----------------------------------------------------------------------- +! +! determine day-of-month number [1,31] +! +!----------------------------------------------------------------------- + + iday_loc = iday_of_year_loc - days_in_prior_months(imonth_loc) + +!----------------------------------------------------------------------- +! +! determine integer hour, minute, and second +! +!----------------------------------------------------------------------- + + call hms (seconds_this_day_loc, & + ihour_loc, iminute_loc, isecond_loc, & + rhour_loc, rminute_loc, rsecond_loc) + +!----------------------------------------------------------------------- +! +! midnight? +! +!----------------------------------------------------------------------- + + if (ihour_loc == 0 .and. iminute_loc == 0 .and. & + isecond_loc == 0) then + midnight_loc = .true. + else + midnight_loc = .false. + endif + +!----------------------------------------------------------------------- +! +! check for unhandled conditions +! +!----------------------------------------------------------------------- + + ! WJS (11-16-11): These conditions used to be handled, by adjusting iday_loc, + ! imonth_loc, adjust_year_loc and iday_of_year_loc appropriately. However, I am + ! concerned that the interactions between these adjustments (in particular, the + ! adjustment to adjust_year_loc - which is now adjust_nyears_loc) and my change of + ! adjust_year_loc (logical) to adjust_nyears_loc (integer) weren't being handled + ! correctly. Furthermore, I can't see any situation where these conditions will be + ! triggered. So rather than trying to handle them properly, I am treating them as error + ! conditions. + + ! Something similar to this condition used to increment iday_loc + if (iday_of_year_loc == iday_of_year_compare .and. adjust_nyears_loc == 0 .and. & + midnight_loc) then + call exit_glc(sigAbort,'Unhandled condition in ymd_hms: midnight condition') + end if + + ! This condition used to adjust iday_loc, imonth_loc, and adjust_nyears_loc; but I + ! think it was only necessary because of the possible increase in iday_loc due to the + ! above, now-unhandled condition + if (iday_loc > days_in_month(imonth_loc)) then + call exit_glc(sigAbort,'Unhandled condition in ymd_hms: iday > days_in_month') + end if + +!----------------------------------------------------------------------- +!EOC + + end subroutine ymd_hms + +!*********************************************************************** +!BOP +! !IROUTINE: hms +! !INTERFACE: + + subroutine hms (seconds_loc, & + ihour_loc , iminute_loc, isecond_loc, & + rhour_loc , rminute_loc, rsecond_loc) + +! !DESCRIPTION: +! Determines present hour, minute, and second. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), intent(inout) :: & + seconds_loc ! elapsed seconds in current day + +! !OUTPUT PARAMETERS: + + integer(log_kind), intent(out) :: & + ihour_loc, &! hour in current day + iminute_loc, &! minute in current hour + isecond_loc ! seconds in current minute + + real (r8), intent(out) :: & + rhour_loc, &! real values for the above quantities + rminute_loc, & + rsecond_loc + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! compute present hour, minute, and second +! +!----------------------------------------------------------------------- + + rhour_loc = seconds_loc/seconds_in_hour + ihour_loc = rhour_loc + + rminute_loc = (rhour_loc - ihour_loc)*minutes_in_hour + iminute_loc = rminute_loc + + rsecond_loc = (rminute_loc - iminute_loc)*seconds_in_minute + isecond_loc = nint (rsecond_loc) + +!----------------------------------------------------------------------- +! +! corrections to second, minute, and/or hour +! +!----------------------------------------------------------------------- + + if (isecond_loc == 60) then + isecond_loc = 0 + iminute_loc = iminute_loc+ 1 + endif + + if (iminute_loc == 60) then + iminute_loc = 0 + ihour_loc = ihour_loc + 1 + endif + + if (ihour_loc == 24) then + ihour_loc = 0 + endif + +!----------------------------------------------------------------------- +! +! if h:m:s == 0:00:00, then adjust seconds +! +!----------------------------------------------------------------------- + + if (ihour_loc == 0 .and. iminute_loc == 0 .and. & + isecond_loc == 0) seconds_loc = c0 + +!----------------------------------------------------------------------- +!EOC + + end subroutine hms + +!*********************************************************************** +!BOP +! !IROUTINE: reduce_months +! !INTERFACE: + + subroutine reduce_months (imonth_loc, iyear_loc) + +! !DESCRIPTION: +! Reduces imonth such that it never exceeds 12 and +! increments iyear accordingly. +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + integer (int_kind), intent (inout) :: & + imonth_loc, &! current value of imonth + iyear_loc ! current value of iyear + +!EOP +!BOC +!----------------------------------------------------------------------- + + do while (imonth_loc > 12) + imonth_loc = imonth_loc - 12 + iyear_loc = iyear_loc + 1 + enddo + +!----------------------------------------------------------------------- +!EOC + + end subroutine reduce_months + +!*********************************************************************** +!BOP +! !IROUTINE: reduce_seconds +! !INTERFACE: + + subroutine reduce_seconds (seconds_this_day_loc, & + seconds_this_year_loc, adjust_nyears_loc) + +! !DESCRIPTION: +! Reduce seconds\_this\_day and seconds\_this year, if either +! exceeds their bounds (eg due to roundoff). +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + real (r8), intent(inout) :: & + seconds_this_day_loc, &! current value of seconds_this_day + seconds_this_year_loc ! current value of seconds_this_year + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + adjust_nyears_loc ! number of years that we need to increment + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ns, ns_end + +!----------------------------------------------------------------------- +! +! if seconds_this_day exceeds the number of seconds in a day, then +! reset seconds_this_day +! +!----------------------------------------------------------------------- + + if (seconds_this_day_loc >= seconds_in_day) then + + ns_end = nint(seconds_this_day_loc/seconds_in_day) + do ns = 1, ns_end + if (seconds_this_day_loc + dt_tol >= seconds_in_day) & + seconds_this_day_loc = seconds_this_day_loc - & + seconds_in_day + enddo + + endif + +!----------------------------------------------------------------------- +! +! if seconds_this_year exceeds the number of seconds in a year, then +! reset seconds_this_year +! +!----------------------------------------------------------------------- + + adjust_nyears_loc = 0 + + do while (seconds_this_year_loc >= seconds_in_year - stepsize .and. & + (seconds_this_year_loc >= seconds_in_year .or. & + is_near(seconds_this_year_loc,seconds_in_year,dt_tol_year))) + + seconds_this_year_loc = seconds_this_year_loc - seconds_in_year + + if (is_near(seconds_this_year_loc, c0, dt_tol)) then + seconds_this_year_loc = c0 + seconds_this_day_loc = c0 + endif + + adjust_nyears_loc = adjust_nyears_loc + 1 + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine reduce_seconds + +!*********************************************************************** +!BOP +! !IROUTINE: leap_adjust +! !INTERFACE: + + subroutine leap_adjust + +! !DESCRIPTION: +! Sets leap-year related variables +! +! !REVISION HISTORY: +! same as module + +!EOP +!BOC +!--------------------------------------------------------------------- +! +! local variables +! +!--------------------------------------------------------------------- + + integer (int_kind) :: nm ! dummy month index + +!----------------------------------------------------------------------- +! +! is iyear a leap year? +! +!----------------------------------------------------------------------- + + leapyear = is_leapyear (iyear) + +!----------------------------------------------------------------------- +! +! adjust the number of days in February and in the year +! +!----------------------------------------------------------------------- + + if (leapyear) then + days_in_month(2) = 29 + days_in_year = days_in_leap_year + else + days_in_month(2) = 28 + days_in_year = days_in_norm_year + endif + + seconds_in_year = days_in_year*seconds_in_day + hours_in_year = days_in_year*24.0_r8 + +!----------------------------------------------------------------------- +! +! reset the values of days_in_prior_months(imonth) +! +!----------------------------------------------------------------------- + + call prior_days (days_in_prior_months, days_in_month) + +!----------------------------------------------------------------------- +!EOC + + end subroutine leap_adjust + +!*********************************************************************** +!BOP +! !IROUTINE: date2ymd +! !INTERFACE: + + subroutine date2ymd (date,year,month,day) + +! !DESCRIPTION: +! Decode the calendar date. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! Calendar date (integer) in yyyymmdd format + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + year, &! Calendar year + month, &! Calendar month + day ! Calendar day + +!EOP +!BOC +!----------------------------------------------------------------------- + + if (.not. valid_date(date)) call exit_glc(sigAbort, & + 'date2ymd:invalid date') + + year = int( date /10000) + month = int( mod(date,10000)/ 100) + day = mod(date, 100) + +!----------------------------------------------------------------------- +!EOC + + end subroutine date2ymd + +!*********************************************************************** +!BOP +! !IROUTINE: ymd2date +! !INTERFACE: + + subroutine ymd2date (year,month,day,date) + +! !DESCRIPTION: +! Encodes the calendar date. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + year, &! Calendar year + month, &! Calendar month + day ! Calendar day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + date ! Calendar date (integer) in yyyymmdd format + +!EOP +!BOC +!----------------------------------------------------------------------- + + date = 10000*year + 100*month + day + +!----------------------------------------------------------------------- +!EOC + + end subroutine ymd2date + +!*********************************************************************** +!BOP +! !IROUTINE: eday2ymd +! !INTERFACE: + + subroutine eday2ymd (eday,year,month,day) + +! !DESCRIPTION: +! Determines the year, month, and day number from elapsed days +! since 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + eday ! elapsed day since 01-01-0000 + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + year, &! calendar year + month, &! calendar month + day ! calendar day + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(0:3) :: & + days_each_year ! days in year for 4-year cycle + + integer (int_kind), dimension(12) :: & + tdays_in_prior_months, &! temporary days in prior months + tdays_in_month ! temporary days in each month + + integer (int_kind) :: & + nm, &! dummy month index + test_day, &! + nnorm, &! normal year counters + nnorm_new, &! normal year counters + nleap, &! leap year counters + nleap_new, &! leap year counters + cycleindex, &! year index for 4-year cycle + days, &! day counter + ny, &! year index + max_ny ! max possible number of years + + character (char_len) :: & + err_string ! output string if error encountered + +!----------------------------------------------------------------------- +! +! If leap years are not allowed, then compute number of elapsed +! years and the number of days in the most recent year +! +!----------------------------------------------------------------------- + + if (.not. allow_leapyear) then + +!lipscomb - This section of code appears not to work. Commented out and rewrote. +! nnorm = eday/days_in_norm_year + 1 +! nleap = 0 +! days = eday -nnorm*days_in_norm_year +! tdays_in_prior_months = days_in_prior_months + + year = eday/days_in_norm_year + days = eday - year*days_in_norm_year + tdays_in_prior_months = days_in_prior_months + +!----------------------------------------------------------------------- +! +! Compute number of elapsed leap years and "normal" years, and +! the number of days elapsed in the most recent year +! +!----------------------------------------------------------------------- + + else + + write(stdout,*) 'WARNING: GLINT will not handle leap years correctly!!!' + + !*** First, initialize arrays used to determine date + + days_each_year = days_in_norm_year + days_each_year(0) = days_in_leap_year + + tdays_in_month = days_in_month + tdays_in_month(2) = 29 ! year 0 value + + call prior_days (tdays_in_prior_months, tdays_in_month) + + days = 0 + nleap = 0 + nnorm = 0 + nleap_new = 0 + nnorm_new = 0 + + max_ny = eday/days_in_norm_year + 1 + + !*** Determine the number of elapsed years and the day number of + !*** the present year [1,days_in_norm_year] + + year_loop: do ny = 0, max_ny + + cycleindex = mod(ny,4) + year = nleap + nnorm + + if (cycleindex == 0 .and. & + (mod(ny,100) /= 0 .or. mod(ny,400) == 0)) then + nleap_new = nleap + 1 + tdays_in_month(2) = 29 + else + nnorm_new = nnorm + 1 + tdays_in_month(2) = 28 + endif + + !*** Update Tdays_in_prior_months for the most recent year + + call prior_days (tdays_in_prior_months, tdays_in_month) + + test_day = eday - nnorm*days_in_norm_year - & + nleap*days_in_leap_year + + if (test_day <= days_each_year(cycleindex) ) then + days = test_day + exit year_loop + endif + + nnorm = nnorm_new + nleap = nleap_new + + enddo year_loop + + endif ! .not. allow_leapyear + +!----------------------------------------------------------------------- +! +! Was the number of days this year properly determined? +! +!----------------------------------------------------------------------- + +!lipscomb - Modified so that code does not abort when days = 0 + +!! if (days <= 0 .or. days > days_in_leap_year ) then + if (days < 0 .or. days > days_in_leap_year ) then + err_string = char_blank + write (err_string,'(a,i6)') & + 'eday2ymd: days undetermined, days = ', days + call exit_glc(sigAbort,trim(err_string)) + endif + +!----------------------------------------------------------------------- +! +! Determine the day- and month-numbers for this year +! +!----------------------------------------------------------------------- + + month = 0 + day = 0 + + month_loop: do nm = 1,11 + + test_day = days - tdays_in_prior_months(nm+1) + if (test_day < 0) then + day = days - tdays_in_prior_months(nm) + 1 + month = nm + exit month_loop + endif + enddo month_loop + + if (month == 0) then + day = days - tdays_in_prior_months(12) + 1 + month = 12 + if (day == 32) then + day = 1 + month = 1 + year = year + 1 + endif + endif + + if (day == 0) day = 1 + +!----------------------------------------------------------------------- +!EOC + + end subroutine eday2ymd + +!*********************************************************************** +!BOP +! !IROUTINE: ymd2eday +! !INTERFACE: + + subroutine ymd2eday (year, month, day, eday) + +! !DESCRIPTION: +! Converts calendar date (year, month, day) to elapsed days since +! 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + year, &! calendar year + month, &! calendar month + day ! calendar day + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + eday ! elapsed days since 01-01-0000 + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind), dimension(0:3) :: & + days_each_year ! days in year for 4-year cycle + + integer (int_kind), dimension(12) :: & + tdays_in_prior_months, &! temporary days in prior months + tdays_in_month ! temporary days in each month + + integer (int_kind) :: & + nm, &! dummy month index + num_leapyears ! leap year counters + +!--------------------------------------------------------------------- +! +! If leap years are not allowed, eday computation is straightforward +! +!--------------------------------------------------------------------- + + if (.not. allow_leapyear) then + eday = year*days_in_norm_year + & + days_in_prior_months(month) + day - 1 + +!--------------------------------------------------------------------- +! +! If leap years are allowed, compute the number of days elapsed +! in prior months for *this* year and the number of elapsed +! leap years prior to this year +! +!--------------------------------------------------------------------- + + else + + tdays_in_month = days_in_month + + num_leapyears = 1 + year/4 - year/100 + year/400 + + if (is_leapyear(year)) then + tdays_in_month(2) = 29 + num_leapyears = num_leapyears - 1 + else + tdays_in_month(2) = 28 + endif + + call prior_days (tdays_in_prior_months, tdays_in_month) + + !*** Compute elapsed days for this date + + eday = num_leapyears *days_in_leap_year + & + (year - num_leapyears )*days_in_norm_year + & + tdays_in_prior_months(month) + day - 1 + + endif ! .not. allow_leapyear + +!--------------------------------------------------------------------- +!EOC + + end subroutine ymd2eday + +!*********************************************************************** +!BOP +! !IROUTINE: date2eday +! !INTERFACE: + + subroutine date2eday (date,eday) + +! !DESCRIPTION: +! Determine number of elapsed days since 01-01-0000 from the +! calendar date in (integer) yyyymmdd format. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! date in yyyymmdd format + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + eday ! elapsed days since 01-01-0000 + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! use existing routines for the conversion +! +!----------------------------------------------------------------------- + + if (.not. valid_date(date)) & + call exit_glc(sigAbort,'date2eday: invalid date') + + call date2ymd (date, year, month, day) + call ymd2eday (year, month, day, eday) + +!----------------------------------------------------------------------- +!EOC + + end subroutine date2eday + +!*********************************************************************** +!BOP +! !IROUTINE: eday2date +! !INTERFACE: + + subroutine eday2date (eday,date) + +! !DESCRIPTION: +! Determines calendar date in (integer) yyyymmdd format from the +! number of elapsed days since 01-01-0000. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + eday ! elapsed days since 01-01-0000 + +! !OUTPUT PARAMETERS: + + integer (int_kind), intent(out) :: & + date ! date in yyyymmdd format + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! use existing routines for the conversion +! +!----------------------------------------------------------------------- + + call eday2ymd (eday, year, month, day) + call ymd2date (year, month, day, date) + +!----------------------------------------------------------------------- +!EOC + + end subroutine eday2date + +!*********************************************************************** +!BOP +! !IROUTINE: prior_days +! !INTERFACE: + + subroutine prior_days (days_in_prior_months_loc,days_in_month_loc) + +! !DESCRIPTION: +! Defines or resets the total number of days in prior months; +! if leap years are allowed, this routine will be called once per +! year. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), dimension(12), intent(in) :: & + days_in_month_loc ! current num of days in each month + +! !OUTPUT PARAMETERS: + + integer (int_kind), dimension(12), intent(out) :: & + days_in_prior_months_loc ! number of days in prior months + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + nm ! local month index + +!----------------------------------------------------------------------- + + days_in_prior_months_loc(1) = 0 + + do nm=2,12 + days_in_prior_months_loc(nm) = & + days_in_prior_months_loc(nm-1) + days_in_month_loc(nm-1) + enddo + +!----------------------------------------------------------------------- +!EOC + + end subroutine prior_days + +!*********************************************************************** +!BOP +! !IROUTINE: time_stamp +! !INTERFACE: + + subroutine time_stamp (option, order, date_string, time_string, beg_date) + +! !DESCRIPTION: +! Writes character strings containing the date and time stamps +! mm/dd/yyyy and hh:mm:ss +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: & + option, &! string with option for time stamp, 'now', 'last', 'range' + order ! string requesting the order of the date stamp ('ymd' or 'mdy') + +! !INPUT/OUTPUT PARAMETERS: + + character (*), intent(inout), optional :: & + date_string, &! a string to fill with date stamp + time_string, &! a string to fill with time stamp + beg_date ! date string to use as first date in + ! 'range' option + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + character (1), parameter :: & + time_separator=':' + + character (16), parameter :: &! format strings + ymd_date_fmt1 = '(i4.4,2(a,i2.2))', & + ymd_date_fmt2 = '(i4.4,2(i2.2)) ', & + mdy_date_fmt1 = '(2(i2.2,a),i4.4)', & + mdy_date_fmt2 = '(2(i2.2),i4.4) ', & + time_fmt = '(i2.2,2(a,i2.2))' + + logical (log_kind) :: & + ymd, & + mdy + + integer (int_kind) :: date_len ! length of date string + +!----------------------------------------------------------------------- +! +! initialize strings +! +!----------------------------------------------------------------------- + + if (present(date_string)) then + date_string = ' ' + endif + + if (present(time_string)) then + time_string = ' ' + endif + + ymd = .false. + mdy = .false. + +!----------------------------------------------------------------------- +! +! check options +! +!----------------------------------------------------------------------- + + select case (trim(order)) + case ('ymd') + ymd = .true. + case ('mdy') + mdy = .true. + case default + call exit_glc(sigAbort,'ERROR selecting order in subroutine time_stamp') + end select + + select case (trim(option)) + +!----------------------------------------------------------------------- +! +! present time +! +!----------------------------------------------------------------------- + + case ('now') + + if (present(date_string)) then + if (date_separator /= ' ') then + if (ymd) then + write (date_string,ymd_date_fmt1) iyear , date_separator, & + imonth, date_separator, & + iday + else if (mdy) then + write (date_string,mdy_date_fmt1) imonth , date_separator, & + iday, date_separator, & + iyear + endif + else + if (ymd) then + write (date_string,ymd_date_fmt2) iyear, imonth, iday + else if (mdy) then + write (date_string,mdy_date_fmt2) imonth, iday, iyear + endif + endif + endif + + if (present(time_string)) then + write (time_string,time_fmt) ihour , time_separator, & + iminute, time_separator, & + isecond + endif + +!----------------------------------------------------------------------- +! +! last timestep +! +!----------------------------------------------------------------------- + + case ('last') + + if (present(date_string)) then + if (mdy) & + call exit_glc(sigAbort,'ERROR time_stamp not supported with option=last & mdy order') + + if (date_separator /= ' ') then + write (date_string,ymd_date_fmt1) iyear_last ,date_separator, & + imonth_last,date_separator, & + iday_last + else + write (date_string,ymd_date_fmt2) iyear, imonth, iday + endif + endif + + if (present(time_string)) then + call exit_glc(sigAbort,'ERROR time_stamp not supported with option=last') + +! write (time_string,time_fmt) ihour_last, time_separator, & +! iminute , time_separator, & +! isecond + endif + +!----------------------------------------------------------------------- +! +! time range +! +!----------------------------------------------------------------------- + + case ('range') + + if (.not. present(beg_date)) & + call exit_glc(sigAbort, & + 'time_stamp: cannot compute range w/o beg date') + + if (present(date_string)) then + date_string = trim(beg_date)/& + &/'-' + date_len = len_trim(date_string) + 1 + if (date_separator /= ' ') then + write (date_string(date_len:),ymd_date_fmt1) & + iyear , date_separator, & + imonth, date_separator, & + iday + else + write (date_string(date_len:),ymd_date_fmt2) iyear, imonth, iday + endif + endif + + if (present(time_string)) then + call exit_glc(sigAbort,'ERROR time_stamp not supported with option=last') +! write (time_string,time_fmt) ihour , time_separator, & +! iminute, time_separator, & +! isecond + endif + +!----------------------------------------------------------------------- + + end select + +!----------------------------------------------------------------------- +!EOC + + end subroutine time_stamp + + + +!*********************************************************************** +!BOP +! !IROUTINE: cesm_date_stamp +! !INTERFACE: + subroutine cesm_date_stamp (date_string, ymds) + +! !DESCRIPTION: +!----------------------------------------------------------------------- +! +! write a character string containing the date stamp +! yyyy-mm-dd, yyyy-mm, or yyyy +! +!----------------------------------------------------------------------- +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + character (*), intent(in) :: ymds ! a string indicating date stamp format + +! !OUTPUT PARAMETERS: + character (*), intent(out) :: date_string ! a string to fill with date stamp + + +!EOP +!BOC + + character (4) :: cesm_cyear + character (2) :: cesm_cmonth + character (2) :: cesm_cday + character (5) :: cesm_csecond + + integer (kind=int_kind) :: & + iyear_stamp ,& + imonth_stamp ,& + iday_stamp ,& + itotal_second + + date_string = char_blank + +!--------------------------------------------------------------------- +! set ixxxx_stamp variables to conform to the cesm standard +!--------------------------------------------------------------------- + if (midnight) then + if (eoy) then + iyear_stamp = iyear_last + imonth_stamp = 12 + iday_stamp = 31 + elseif (eom) then + iyear_stamp = iyear + imonth_stamp = imonth_last + iday_stamp = iday_last + elseif (eod) then + iyear_stamp = iyear + imonth_stamp = imonth + iday_stamp = iday_last + endif + else + iyear_stamp = iyear + imonth_stamp = imonth + iday_stamp = iday + endif + + select case (trim(ymds)) + case ('ymds') +!--------------------------------------------------------------------- +! use unmodified ixxx variables if printing ymds information +!--------------------------------------------------------------------- + itotal_second = isecond + 60*iminute + 3600*ihour + call int_to_char (4,iyear , cesm_cyear ) + call int_to_char (2,imonth , cesm_cmonth ) + call int_to_char (2,iday , cesm_cday ) + call int_to_char (5,itotal_second, cesm_csecond) + write (date_string,1000) cesm_cyear, cesm_cmonth, cesm_cday, & + cesm_csecond + + case ('ymd') + call int_to_char (4,iyear_stamp , cesm_cyear ) + call int_to_char (2,imonth_stamp , cesm_cmonth) + call int_to_char (2,iday_stamp , cesm_cday ) + write (date_string,1000) cesm_cyear, cesm_cmonth, cesm_cday + + case ('ym') + call int_to_char (4,iyear_stamp , cesm_cyear ) + call int_to_char (2,imonth_stamp , cesm_cmonth) + write (date_string,1000) cesm_cyear, cesm_cmonth + + case ('y') + call int_to_char (4,iyear_stamp , cesm_cyear) + write (date_string,1000) cesm_cyear + + case default + call exit_glc(sigAbort,'(cesm_date_stamp)') + + end select + + + 1000 format (a4,:,'-',a2:,'-',a2,:,'-',a5) + +!EOC + +!----------------------------------------------------------------------- + + end subroutine cesm_date_stamp + +!*********************************************************************** +!BOP +! !IROUTINE: is_near +! !INTERFACE: + + function is_near (test_value, target, tol) + +! !DESCRIPTION: +! Determines if test\_value is ``near'' the target value. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + real (r8), intent(in) :: & + test_value, &! value to test + target, &! value to test against + tol ! tolerance for determining nearness + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + is_near ! result (T or F) of nearness test + +!----------------------------------------------------------------------- +! +! just a simple test... +! +!----------------------------------------------------------------------- + + if (abs(test_value - target) <= tol) then + is_near = .true. + else + is_near = .false. + endif + +!----------------------------------------------------------------------- +!EOC + + end function is_near + +!*********************************************************************** +!BOP +! !IROUTINE: is_leapyear +! !INTERFACE: + + function is_leapyear (iyear_loc) + +! !DESCRIPTION: +! Determines if test\_year is a leapyear. +! +! Assumptions: +! \begin{itemize} +! \item year = 0 is the first year of the integration +! \item standard calendar has 28 days in February, a leap year has 29 +! \end{itemize} +! +! Algorithm: a year is a leap year if it is: +! \begin{itemize} +! \item divisible by 4, +! \item NOT divisible by 100, except if +! \item also divisible by 400 +! \end{itemize} +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + iyear_loc ! input year to test for leapyear + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + is_leapyear ! logical result with true if test year is leapyear + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! check for leap year +! +!----------------------------------------------------------------------- + + is_leapyear = .false. + + if (allow_leapyear .and. mod(iyear_loc,4) == 0 .and. & + (mod(iyear_loc,100) /= 0 .or. mod(iyear_loc,400) == 0 ) ) & + is_leapyear = .true. + +!----------------------------------------------------------------------- +!EOC + + end function is_leapyear + +!*********************************************************************** +!BOP +! !IROUTINE: valid_date +! !INTERFACE: + + function valid_date (date) + +! !DESCRIPTION: +! Determines if a valid year, month & day can be decoded +! from the calendar date in (integer) yyyymmdd format. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + date ! calendar date in yyyymmdd format + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + valid_date ! logical return value = true if valid date + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + year, month, day ! year month day indices + +!----------------------------------------------------------------------- +! +! check a variety of possible error conditions +! +!----------------------------------------------------------------------- + + year = int( date /10000) + month = int( mod(date,10000)/ 100) + day = mod(date, 100) + + valid_date = .true. + + if (year < 0) valid_date = .false. + if (month < 1) valid_date = .false. + if (month > 12) valid_date = .false. + if (day < 1) valid_date = .false. + if (day > days_in_month(month)) valid_date = .false. + +!----------------------------------------------------------------------- +!EOC + + end function valid_date + +!*********************************************************************** +!BOP +! !IROUTINE: valid_ymd_hms() +! !INTERFACE: + + function valid_ymd_hms() + +! !DESCRIPTION: +! Determines if the computed values of iyear,imonth,iday, +! ihour, iminute, and isecond are within reasonable bounds. +! +! !REVISION HISTORY: +! same as module + +! !OUTPUT PARAMETERS: + + logical (log_kind) :: & + valid_ymd_hms ! logical return value = true if current + ! year, month, day, hour, minute, second + ! are withing valid ranges + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + logical (log_kind) :: & + valid_year, &! flags to determine validity of + valid_month, &! specific values + valid_day_b, &! + valid_day_e, &! + valid_hour, &! + valid_minute, &! + valid_second, &! + valid_eday_run, &! + valid_eday_year, &! + valid_feb_day ! + + character (char_len) :: err_string ! string for error message + + character (*), parameter :: & + err_fmt = '(a,i6)' ! format for error string + +!----------------------------------------------------------------------- +! +! set default condition of true for all flags +! +!----------------------------------------------------------------------- + + valid_ymd_hms = .true. + valid_year = .true. + valid_month = .true. + valid_day_b = .true. + valid_day_e = .true. + valid_hour = .true. + valid_minute = .true. + valid_second = .true. + valid_eday_run = .true. + valid_eday_year = .true. + valid_feb_day = .true. + +!----------------------------------------------------------------------- +! +! check a variety of possible error conditions +! +!----------------------------------------------------------------------- + + if (iyear < 0) then + valid_ymd_hms = .false. + valid_year = .false. + endif + + if (imonth < 0 .or. imonth > 12) then + valid_ymd_hms = .false. + valid_month = .false. + endif + + if (iday < 1) then + valid_ymd_hms = .false. + valid_day_b = .false. + endif + + if (valid_ymd_hms) then ! prevents out-of-range reference + if (iday > days_in_month(imonth)) then + valid_ymd_hms = .false. + valid_day_e = .false. + endif + endif + + if (ihour < 0 .or. ihour > 24) then + valid_ymd_hms = .false. + valid_hour = .false. + endif + + if (iminute < 0 .or. iminute > 60) then + valid_ymd_hms = .false. + valid_minute = .false. + endif + + if (isecond < 0 .or. isecond > 60) then + valid_ymd_hms = .false. + valid_second = .false. + endif + + if (elapsed_days_this_year < 0) then + valid_ymd_hms = .false. + valid_eday_year = .false. + endif + + if (elapsed_days_init_date < 0) then + valid_ymd_hms = .false. + valid_eday_run = .false. + endif + + if (.not. allow_leapyear .and. imonth == 2 .and. iday == 29) then + valid_ymd_hms = .false. + valid_feb_day = .false. + endif + +!----------------------------------------------------------------------- +! +! if errors detected, write out message and quit +! +!----------------------------------------------------------------------- + + if (.not. valid_ymd_hms) then + + err_string = char_blank + + if (.not. valid_year) & + write(err_string,err_fmt) & + 'Invalid date (iyear must be > 0 ): iyear = ', iyear + + if (.not. valid_month) & + write(err_string,err_fmt) & + 'Invalid date ( imonth must be in [1,12] ): imonth = ', & + imonth + + if (.not. valid_day_b) & + write(err_string,err_fmt) & + 'Invalid date (iday must be greater than 1): iday = ',iday + + if (.not. valid_day_e) & + write(err_string,err_fmt) & + 'Invalid date (iday must be less than days_in_month):'/& + &/' iday = ',iday + + if (.not. valid_hour) & + write(err_string,err_fmt) & + 'Invalid date (ihour must be in [0,23] ): ihour = ', ihour + + if (.not. valid_minute) & + write(err_string,err_fmt) & + 'Invalid date (iminute must be in [0,59] ): iminute = ', & + iminute + + if (.not. valid_second) & + write(err_string,err_fmt) & + 'Invalid date (isecond must be in [0,59] ): isecond = ', & + isecond + + if (.not. valid_eday_run) & + write(err_string,err_fmt) & + 'Invalid date (elapsed_days_init_date must be > 0 ) ', & + elapsed_days_init_date + + if (.not. valid_eday_year) & + write(err_string,err_fmt) & + 'Invalid date (elapsed_days_this_year must be > 0) ', & + elapsed_days_this_year + + if (.not. valid_feb_day) & + write(err_string,*) & + ' Error: initial date contains leap day '/& + &/' but no leap years are allowed.', iday + + call exit_glc(sigAbort,trim(err_string)) + + endif ! valid_ymd_hms + +!----------------------------------------------------------------------- +!EOC + + end function valid_ymd_hms + +!*********************************************************************** +!BOP +! !IROUTINE: write_time_manager_options +! !INTERFACE: + + subroutine write_time_manager_options + +! !DESCRIPTION: +! Writes all time manager options to stdout. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: +! !OUTPUT PARAMETERS: +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + k, ind, nn + + character (1) :: & + suffix + + character (2) :: & + cmonth_end_run, &! + cday_end_run, &! + cmonth0, &! + cday0 ! + + character (4) :: & + cyear0, &! + cyear_end_run ! + + character (*), parameter :: &! output formats + out_fmt1 = "(' date(month-day-year):',2x,2(a2,'-'),a4)", & + out_fmt2 = "(' ',a7,2x,i10)", & + out_fmt3 = "('This run will terminate ',/,a)", & + out_fmt4 = "(a, :i7, a,a)", & + out_fmt5 = "(' ',a8,2x,f16.3)", & + out_fmt6 = "('GLC time step = ',1pe12.6, ' seconds')" + +!----------------------------------------------------------------------- +! +! write only from master task +! +!----------------------------------------------------------------------- + + if (my_task == master_task) then + +!----------------------------------------------------------------------- +! +! write start/current time data +! +!----------------------------------------------------------------------- + + call int_to_char(4, iyear0 , cyear0) + cmonth0 = cmonths(imonth0) + cday0 = cdays (iday0) + + call int_to_char(4, iyear_end_run , cyear_end_run ) + cmonth_end_run = cmonths(imonth_end_run) + cday_end_run = cdays (iday_end_run) + + write (stdout,blank_fmt) + write (stdout,ndelim_fmt) + write (stdout,blank_fmt) + write (stdout,'(a23)') 'Time Information' + write (stdout,blank_fmt) + write (stdout,delim_fmt) + + write (stdout,blank_fmt) + write (stdout,'(a8,a)') 'Run id: ',trim(runid) + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'This simulation started from' + write (stdout,out_fmt1) cmonth0, cday0, cyear0 + write (stdout,out_fmt2) ' hour:', ihour0 + write (stdout,out_fmt2) 'minute:', iminute0 + write (stdout,out_fmt2) 'second:', isecond0 + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'This run started from' + write (stdout,out_fmt1) cmonth, cday, cyear + write (stdout,out_fmt2) ' hour:', ihour + write (stdout,out_fmt2) 'minute:', iminute + write (stdout,out_fmt2) 'second:', isecond + + if (nsteps_total /= 0) & + write (stdout,out_fmt2) ' step:', nsteps_total + + write (stdout,blank_fmt) + + if (end_run_at_midnight) then + write (stdout,out_fmt3) 'at 00:00:00 on' + else if (dtt > seconds_in_day) then + write (stdout,out_fmt3) 'at the end of the day on or after' + else + write (stdout,out_fmt3) 'at the end of the day on' + endif + + if (stop_count == 1) then + suffix = ' ' + else + suffix = 's' + endif + + write (stdout,out_fmt1) cmonth_end_run,cday_end_run,cyear_end_run + + select case (stop_option) + + case ('never') + write (stdout,out_fmt4) 'upon receipt of stop signal' /& + &/ ' from external source (eg, cpl)' + case ('nyear') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' year', suffix + case ('nmonth') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' month', suffix + case ('nday') + write(stdout,out_fmt4) 'after running for ',stop_count, & + ' day', suffix + case ('eoy') + write(stdout,out_fmt4) 'at the end of the year after ', & + stop_count, ' year', suffix + case ('eom') + write(stdout,out_fmt4) 'at the end of the month after', & + stop_count, ' month', suffix + case ('eod') + write (stdout,out_fmt4) 'at the end of the day' + case ('nstep','nsteps') + write (stdout,out_fmt4) 'after ', stop_count,' timestep', & + suffix + case ('date') + write (stdout,out_fmt4) 'after reaching the specified date' + case default + end select + write (stdout,'(a63)') 'unless a stop signal is received'/& + &/' from external source (eg, cpl)' + + write (stdout,blank_fmt) + write (stdout,'(a28)') 'Starting elapsed time in ' + write (stdout,out_fmt5) ' years:', tyear + write (stdout,out_fmt5) ' months:', tmonth + write (stdout,out_fmt5) ' days:', tday + write (stdout,out_fmt5) ' hours:', thour + write (stdout,out_fmt5) 'seconds:', tsecond + +!----------------------------------------------------------------------- +! +! timestep information +! +!----------------------------------------------------------------------- + + write (stdout,blank_fmt) + if (dt_option == 'auto_dt') then + write (stdout,'(a45)') & + 'Automatic time step option (auto_dt) enabled' + else + write (stdout,'(a45)') & + 'Automatic time step option (auto_dt) disabled' + endif + + write (stdout,blank_fmt) + write (stdout,'(a11,1pe12.6)') 'dt_count = ',dt_count + + write (stdout,blank_fmt) + write (stdout,out_fmt6) dtt + +!----------------------------------------------------------------------- +! +! other options +! +!----------------------------------------------------------------------- + + write (stdout,blank_fmt) + if (allow_leapyear) then + write (stdout,'(a22)') 'Leap years allowed' + else + write (stdout,'(a22)') 'Leap years not allowed' + endif + +!----------------------------------------------------------------------- +! +! end of writes +! +!----------------------------------------------------------------------- + + endif ! (my_task == master_task) + +!----------------------------------------------------------------------- +!EOC + + end subroutine write_time_manager_options + +!*********************************************************************** +!BOP +! !IROUTINE: int_to_char +! !INTERFACE: + + subroutine int_to_char(string_length, int_in, char_out) + +! !DESCRIPTION: +! Converts an integer into a character with a requested length and +! pads spaces with zeroes. +! +! !REVISION HISTORY: +! same as module + +! !INPUT PARAMETERS: + + integer (int_kind), intent(in) :: & + string_length, &! length of desired output character string + int_in ! input integer to be converted + +! !OUTPUT PARAMETERS: + + character(string_length), intent(out) :: & + char_out ! character equivalent of input integer + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + n, &! dummy counter + ifact, &! factor of 10 for picking off digits + iquot, iremaind ! quotient, remainder for division by ifact + +!----------------------------------------------------------------------- +! +! convert to string by picking off one digit at a time and writing +! it into a character string +! +!----------------------------------------------------------------------- + + iremaind = int_in + + do n=1,string_length + ifact = 10**(string_length - n) ! power of 10 for leftmost + iquot = iremaind/ifact ! compute leftmost digit + iremaind = iremaind - iquot*ifact ! remove digit for next pass + + write(char_out(n:n),'(i1)') iquot ! write digit to string + end do + +!----------------------------------------------------------------------- +!EOC + + end subroutine int_to_char + +!*********************************************************************** + + end module glc_time_management + +!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/components/cism/source_glc/history_tape_base.F90 b/components/cism/source_glc/history_tape_base.F90 new file mode 100644 index 0000000000..c76c7e2219 --- /dev/null +++ b/components/cism/source_glc/history_tape_base.F90 @@ -0,0 +1,124 @@ +module history_tape_base + + ! This module defines an abstract base class to implement a single history tape. + + use shr_kind_mod, only : CXX => SHR_KIND_CXX + + implicit none + private + save + + ! max character length + integer, parameter, public :: len_history_vars = CXX + + public :: history_tape_base_type + type, abstract :: history_tape_base_type + private + + ! Names of CISM variables to be output in cesm history files + ! + ! COMPILER_BUG(wjs, 2015-02-19, pgi 14.7) Ideally, this would be an allocatable + ! character variable. But when written that way, it gets filled with garbage by pgi + ! 14.7. So for now, I'm using a declared maximum length together with a check that + ! it's not being set to greater than its length. + character(len=len_history_vars) :: history_vars + + contains + ! ------------------------------------------------------------------------ + ! Public methods + ! ------------------------------------------------------------------------ + procedure :: write_history ! write history, if it's time to do so + procedure :: set_history_vars ! set the list of history variables + + ! ------------------------------------------------------------------------ + ! The following are public simply because they need to be overridden by derived + ! classes. They should not be called directly by clients. + ! ------------------------------------------------------------------------ + ! Logical function saying whether it's time to write a history file + procedure(is_time_to_write_hist_interface), deferred :: is_time_to_write_hist + + ! Function returning a string describing the history frequency + procedure(history_frequency_string_interface), deferred :: history_frequency_string + end type history_tape_base_type + + abstract interface + + logical function is_time_to_write_hist_interface(this, EClock) + use esmf, only : ESMF_Clock + import :: history_tape_base_type + + class(history_tape_base_type), intent(in) :: this + type(ESMF_Clock), intent(in) :: EClock + end function is_time_to_write_hist_interface + + function history_frequency_string_interface(this) + import :: history_tape_base_type + + character(len=:), allocatable :: history_frequency_string_interface + class(history_tape_base_type), intent(in) :: this + end function history_frequency_string_interface + + end interface + +contains + + !----------------------------------------------------------------------- + subroutine write_history(this, instance, EClock) + ! + ! !DESCRIPTION: + ! Write a CISM history file, if it's time to do so. + ! + ! This routine should be called every time step. It will return without doing + ! anything if it isn't yet time to write a history file. + ! + ! !USES: + use glc_io, only : glc_io_write_history + use glad_type, only : glad_instance + use esmf, only: ESMF_Clock + ! + ! !ARGUMENTS: + class(history_tape_base_type), intent(in) :: this + type(glad_instance), intent(inout) :: instance + type(ESMF_Clock), intent(in) :: EClock + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'write_history' + !----------------------------------------------------------------------- + + if (this%is_time_to_write_hist(EClock)) then + call glc_io_write_history(instance, EClock, & + this%history_vars, this%history_frequency_string()) + end if + + end subroutine write_history + + !----------------------------------------------------------------------- + subroutine set_history_vars(this, history_vars) + ! + ! !DESCRIPTION: + ! Set the list of history variables + ! + ! !USES: + use glc_exit_mod, only : exit_glc, sigAbort + use glc_constants, only : stdout + ! + ! !ARGUMENTS: + class(history_tape_base_type), intent(inout) :: this + character(len=*), intent(in) :: history_vars + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_history_vars' + !----------------------------------------------------------------------- + + if (len_trim(history_vars) > len(this%history_vars)) then + write(stdout,*) subname//' ERROR: too-long history vars: <', trim(history_vars), '>' + call exit_glc(sigAbort, subname//' ERROR: too-long history vars') + end if + + this%history_vars = trim(history_vars) + + end subroutine set_history_vars + +end module history_tape_base diff --git a/components/cism/source_glc/history_tape_coupler.F90 b/components/cism/source_glc/history_tape_coupler.F90 new file mode 100644 index 0000000000..4d746043b1 --- /dev/null +++ b/components/cism/source_glc/history_tape_coupler.F90 @@ -0,0 +1,89 @@ +module history_tape_coupler + + ! Defines a class for controlling history frequency based on the coupler's history + ! frequency. + + use history_tape_base, only : history_tape_base_type + + implicit none + private + save + + public :: history_tape_coupler_type + type, extends(history_tape_base_type) :: history_tape_coupler_type + private + contains + ! Logical function saying whether it's time to write a history file + procedure :: is_time_to_write_hist + + ! Function returning a string describing the history frequency + procedure :: history_frequency_string + end type history_tape_coupler_type + + interface history_tape_coupler_type + module procedure constructor + end interface history_tape_coupler_type + +contains + + !----------------------------------------------------------------------- + function constructor(history_vars) + ! + ! !DESCRIPTION: + ! Creates a history_tape_coupler_type object + ! + ! !USES: + ! + ! !ARGUMENTS: + type(history_tape_coupler_type) :: constructor ! function result + + ! List of variables to write to file + character(len=*), intent(in) :: history_vars + + !----------------------------------------------------------------------- + + call constructor%set_history_vars(history_vars) + end function constructor + + !----------------------------------------------------------------------- + logical function is_time_to_write_hist(this, EClock) + ! + ! !DESCRIPTION: + ! Returns true if it is time to write the history tape associated with this controller. + ! + ! !USES: + use esmf, only: ESMF_Clock + use seq_timemgr_mod, only : seq_timemgr_HistoryAlarmIsOn + ! + ! !ARGUMENTS: + class(history_tape_coupler_type), intent(in) :: this + type(ESMF_Clock), intent(in) :: EClock + + !----------------------------------------------------------------------- + + is_time_to_write_hist = seq_timemgr_HistoryAlarmIsOn(EClock) + + end function is_time_to_write_hist + + !----------------------------------------------------------------------- + function history_frequency_string(this) + ! + ! !DESCRIPTION: + ! Returns a string representation of this history frequency + ! + ! TODO(wjs, 2015-02-17) This needs to be implemented. It is currently difficult (or + ! impossible) to extract the frequency information from the coupler. Hopefully this + ! will become easier once the coupler implements the necessary functionality for + ! metadata on its own history files. + ! + ! !ARGUMENTS: + character(len=:), allocatable :: history_frequency_string ! function result + class(history_tape_coupler_type), intent(in) :: this + + !----------------------------------------------------------------------- + + history_frequency_string = '(matches coupler history frequency)' + + end function history_frequency_string + +end module history_tape_coupler diff --git a/components/cism/source_glc/history_tape_standard.F90 b/components/cism/source_glc/history_tape_standard.F90 new file mode 100644 index 0000000000..425c122329 --- /dev/null +++ b/components/cism/source_glc/history_tape_standard.F90 @@ -0,0 +1,149 @@ +module history_tape_standard + + ! Defines a class for a standard history tape. This class writes history files at a + ! specified frequency (e.g., every N years). + + use history_tape_base, only : history_tape_base_type + use glc_kinds_mod + use glc_time_management, only : init_time_flag, check_time_flag + + implicit none + private + save + + public :: history_tape_standard_type + type, extends(history_tape_base_type) :: history_tape_standard_type + private + integer(int_kind) :: freq_opt ! frequency option (as defined in glc_time_management) + integer(int_kind) :: freq ! frequency (e.g., number of years for freq_opt=freq_opt_nyear) + integer(int_kind) :: time_flag ! reference to a time flag in glc_time_management + contains + ! Logical function saying whether it's time to write a history file + procedure :: is_time_to_write_hist + + ! Function returning a string describing the history frequency + procedure :: history_frequency_string + end type history_tape_standard_type + + interface history_tape_standard_type + module procedure constructor + end interface history_tape_standard_type + +contains + + !----------------------------------------------------------------------- + function constructor(history_vars, freq_opt, freq) + ! + ! !DESCRIPTION: + ! Creates a history_tape_standard_type object + ! + ! !USES: + ! + ! !ARGUMENTS: + type(history_tape_standard_type) :: constructor ! function result + + ! List of variables to write to file + character(len=*), intent(in) :: history_vars + + ! Frequency option; should be one of the options defined in glc_time_management + ! (e.g., freq_opt_nyear) + integer(int_kind), intent(in) :: freq_opt + + ! Frequency; e.g., for freq_opt = freq_opt_nyear, history files will be written every + ! freq years + integer(int_kind), intent(in) :: freq + + !----------------------------------------------------------------------- + + call constructor%set_history_vars(history_vars) + constructor%freq_opt = freq_opt + constructor%freq = freq + + ! TODO(wjs, 2015-02-18) If we allow multiple history tapes, we should construct a time + ! flag name that includes the history tape index, so that we have unique time flags + ! for each history tape. In that case, the history tape index should be passed into + ! the constructor, and stored as a component of the class. + constructor%time_flag = init_time_flag('do_hist', freq_opt = freq_opt, freq = freq) + + end function constructor + + !----------------------------------------------------------------------- + logical function is_time_to_write_hist(this, EClock) + ! + ! !DESCRIPTION: + ! Returns true if it is time to write the history tape associated with this + ! controller. + ! + ! Note that EClock is unused in this implementation; it is simply included for + ! compatibility with the generic interface. + ! + ! !USES: + use esmf, only: ESMF_Clock + ! + ! !ARGUMENTS: + class(history_tape_standard_type), intent(in) :: this + type(ESMF_Clock), intent(in) :: EClock + + !----------------------------------------------------------------------- + + is_time_to_write_hist = check_time_flag(this%time_flag) + + end function is_time_to_write_hist + + !----------------------------------------------------------------------- + function history_frequency_string(this) + ! + ! !DESCRIPTION: + ! Returns a string representation of this history frequency + ! + ! This string representation is based on the convention for the time_period_freq + ! metadata defined here: + ! http://www.cesm.ucar.edu/models/cesm2.0/filename_conventions_cesm.html + ! + ! NOTE(wjs, 2015-02-17) Design note: Really, this functionality should be delegated to + ! a method on a time frequency class; this class would contain the various time + ! frequency methods defined in glc_time_management, as well as this to_string + ! method. However, I don't want to go to the effort of making a new class for that + ! right now, so for now I'm putting this behavior here. + ! + ! !USES: + use glc_exit_mod, only : exit_glc, sigAbort + use glc_constants, only : stdout + use glc_time_management, only : freq_opt_nyear, freq_opt_nmonth, freq_opt_nday, & + freq_opt_nhour, freq_opt_nsecond + ! + ! !ARGUMENTS: + character(len=:), allocatable :: history_frequency_string ! function result + class(history_tape_standard_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + character(len=:), allocatable :: freq_opt_string + integer, parameter :: max_digits = 20 + + character(len=*), parameter :: subname = 'history_frequency_string' + !----------------------------------------------------------------------- + + select case (this%freq_opt) + case (freq_opt_nyear) + freq_opt_string = 'year_' + case (freq_opt_nmonth) + freq_opt_string = 'month_' + case (freq_opt_nday) + freq_opt_string = 'day_' + case (freq_opt_nhour) + freq_opt_string = 'hour_' + case (freq_opt_nsecond) + freq_opt_string = 'second_' + case default + write(stdout,*) subname//' ERROR: Unhandled freq_opt: ', this%freq_opt + call exit_glc(sigAbort, subname//' ERROR: Unhandled freq_opt') + end select + + allocate(character(len = len(freq_opt_string) + max_digits) :: & + history_frequency_string) + + write(history_frequency_string, '(a, i0)') freq_opt_string, this%freq + + end function history_frequency_string + +end module history_tape_standard diff --git a/components/cism/test/unit/time_management/Filepath b/components/cism/test/unit/time_management/Filepath new file mode 100644 index 0000000000..f3242399c8 --- /dev/null +++ b/components/cism/test/unit/time_management/Filepath @@ -0,0 +1,6 @@ +. +../unit_test_shr +../unit_test_replacements +../../../source_glc +../../../source_glimmer-cism +../../../../../csm_share/shr diff --git a/components/cism/test/unit/time_management/Makefile b/components/cism/test/unit/time_management/Makefile new file mode 100644 index 0000000000..1c30a6676b --- /dev/null +++ b/components/cism/test/unit/time_management/Makefile @@ -0,0 +1,6 @@ +# Makefile for glc time management testing + +EXENAME = time_management_test + +include ../unit_test_shr/Makefile.common + diff --git a/components/cism/test/unit/time_management/README b/components/cism/test/unit/time_management/README new file mode 100644 index 0000000000..d357642e94 --- /dev/null +++ b/components/cism/test/unit/time_management/README @@ -0,0 +1,57 @@ +This directory contains code for testing the glc time manager. + +To build the test program, run the following from this directory: + + gmake OPT=FALSE + +This will create the time_management_test program. + +To run the program: + +First copy a set of inputs to this directory; for example: + + cp inputs/oneyear/*_in . + +Then modify cism_in and time_management_test_in, if desired + +Then run: + + ./time_management_test > test_output + +You can then examine the output and/or compare it to output from a +previous version of the code. + + +--- NOTES ABOUT RESTART TESTS --- + +For some cases, there are three similar directories in the inputs +directory: , .restart1, and .restart2. + +These sets of directories are for doing restart tests, to make sure +that the sequence of times is the same for (a) a run that goes all the +way through, and (b) the same run broken up into two pieces. + +To run the restart test, do: + + restart_test testname + +If the test succeeds (i.e., the restart case gives the same time +sequence as the run all the way through), then there will be no output +from this script. If there are some differences, these differences +will be output to stdout. + +For regression testing, you should test and +.restart2, but it is not necessary to test +.restart1, since that just gives a subset of the run done by +. (Note that you can run .restart2 without running +.restart1 -- for this time management test driver, a restart +file is not necessary -- it just simulates what would happen if there +were a restart file.) + + +--- TEST LISTS --- + +testlist: list of tests in the 'inputs' directory that should be run +for complete regression testing + +restart_testlist: list of tests that should be run with 'restart_test' diff --git a/components/cism/test/unit/time_management/Srcfiles b/components/cism/test/unit/time_management/Srcfiles new file mode 100644 index 0000000000..76223d00b2 --- /dev/null +++ b/components/cism/test/unit/time_management/Srcfiles @@ -0,0 +1,16 @@ +glc_time_management_test.F90 +glc_time_management_test_mod.F90 +writevar_mod.F90 +glc_time_management.F90 +glc_communicate.F90 +glc_kinds_mod.F90 +glc_constants.F90 +glc_files.F90 +glc_exit_mod.F90 +glimmer_paramets.F90 +glimmer_global.F90 +glimmer_physcon.F90 +shr_const_mod.F90 +shr_sys_mod.F90 +shr_kind_mod.F90 +shr_log_mod.F90 diff --git a/components/cism/test/unit/time_management/glc_time_management_test.F90 b/components/cism/test/unit/time_management/glc_time_management_test.F90 new file mode 100644 index 0000000000..d9b1d6982b --- /dev/null +++ b/components/cism/test/unit/time_management/glc_time_management_test.F90 @@ -0,0 +1,39 @@ +! This program is a test driver for the glc_time_management module. +! +! It allows you to run the time manager for a given set of options, printing the internal +! state of the time manager at each time step. +! +! You can then look at this output to make sure the time manager is working correctly, or +! you can compare it with output from a previous tag for regression testing. + +program glc_time_management_test + + use glc_time_management_test_mod + use glc_time_management, only : time_manager + use glimmer_paramets, only : stdout + + implicit none + + integer :: n + + call read_time_management_test_namelist + + call init_time_manager + call report_time_init + call report_time + + ! cism isn't currently set up to access time flags like 'stop_now', as far as I can + ! tell (it relies on the coupler telling it when to stop) -- for example, the + ! access_time_flag subroutine has been removed. So rather than using all the stopping + ! functionality of the time manager, I am simply requiring that the user specify the + ! desired number of time steps. + do n = 1, nsteps_test + call time_manager + call report_time + end do + + write(stdout,'(a,a)') write_prefix, 'SUCCESSFUL TERMINATION OF GLC_TIME_MANAGEMENT_TEST' + +end program glc_time_management_test + + diff --git a/components/cism/test/unit/time_management/glc_time_management_test_mod.F90 b/components/cism/test/unit/time_management/glc_time_management_test_mod.F90 new file mode 100644 index 0000000000..4b3129ac4a --- /dev/null +++ b/components/cism/test/unit/time_management/glc_time_management_test_mod.F90 @@ -0,0 +1,278 @@ +! This module contains data and subroutines used by the glc_time_management_test program + +module glc_time_management_test_mod + use glc_constants, only : nml_in + use glc_kinds_mod + use glc_communicate, only : my_task, master_task + use glc_time_management + use glimmer_paramets, only : stdout + use writevar_mod + + implicit none + save + + private + + ! --- parameters --- + character(len=*), parameter :: test_nml_filename='time_management_test_in' + integer, parameter :: test_nml_in = 10 ! unit for namelist reads + + ! prefix to write on any line written by the test program + character(len=*), parameter :: write_prefix = '(time_management_test) ' + + ! --- variables read from the time management test namelist --- + character(len=16) :: runtype_test ! 'initial', 'continue' or 'branch' + integer :: elapsed_days_test ! for runtype_test=='continue', the elapsed days at + ! which this run starts + integer :: nsteps_test ! number of steps to run for + real(r8) :: dtt_test ! if > 0, then use this value for dtt rather than + ! using dt_option & dt_count + + ! --- other module variables --- + integer :: climate_tstep ! in the actual code, this is a member of a derived type + + ! --- public variables --- + public :: write_prefix, nsteps_test + + ! --- public subroutines --- + public :: read_time_management_test_namelist, & + init_time_manager, & + report_time_init, & + report_time + +contains + +!*********************************************************************** + subroutine read_time_management_test_namelist + ! This subroutine reads the namelist that controls the test program + + namelist /time_management_test_nml/ & + runtype_test, elapsed_days_test, nsteps_test, dtt_test + + open(test_nml_in, file=test_nml_filename, status='old') + read(test_nml_in, nml=time_management_test_nml) + close(test_nml_in) + + end subroutine read_time_management_test_namelist + + + +!*********************************************************************** + subroutine init_time_manager + ! Do initialization needed for the time manager. + ! This includes the relevant code from glc_initMod: glc_initialize + + nml_in = test_nml_in + runtype = runtype_test + + call init_time1 + + ! Allow user to specify their own dtt value, so they're not constrained by the + ! standard way to specify dtt. If dtt_test <= 0, we use the value of dtt determined + ! from dt_option / dt_count. + ! Note that this relies on dtt not having any effect on any other variables in + ! init_time1 + if (dtt_test > 0) then + dtt = dtt_test + dtt_input = dtt_test + + ! steps_per_day and steps_per_year are also set in init_time1 depending on dtt, + ! but these variables are not important to us for this test driver, so we're not + ! resetting them here (and note that, for arbitrary dtt, these variables might + ! be hard to specify) + end if + + if (my_task==master_task) then + write(stdout,'(a,a,X,f0.6)') write_prefix, 'dtt =', dtt + end if + + climate_tstep = nint(dtt/3600._r8) ! convert from sec to integer hours + + call update_for_restart + + call init_time2 + + end subroutine init_time_manager + + +!*********************************************************************** + subroutine update_for_restart + ! If we are testing a restart run, then update time management variables + ! appropriately, as is done for runtype=='continue' in glc_InitMod: glc_initialize + + integer :: nhour_glint + + nhour_glint = 0 ! number of hours glint has run since start of complete simulation + ! must be set to correct value if reading from a restart file + + if (runtype_test == 'continue') then + nhour_glint = elapsed_days_test * 24 + call ymd2eday (iyear0, imonth0, iday0, elapsed_days0) + elapsed_days = elapsed_days0 + nhour_glint/24 + call eday2ymd(elapsed_days, iyear, imonth, iday) + ihour = 0 + iminute = 0 + isecond = 0 + nsteps_total = nhour_glint / climate_tstep + + + if (my_task == master_task) then + write(stdout,'(a,a,X,i0)') write_prefix, 'Successfully read restart, nhour_glint =', nhour_glint + write(stdout,'(a,a,X,i0,X,i0,X,i0,X,i0)') write_prefix, 'Initial eday/y/m/d:', elapsed_days0, iyear0, imonth0, iday0 + write(stdout,'(a,a,X,i0,X,i0,X,i0,X,i0)') write_prefix, 'eday/y/m/d after restart:', elapsed_days, iyear, imonth, iday + write(stdout,'(a,a,X,i0)') write_prefix, 'nsteps_total =', nsteps_total + write(stdout,'(a,a)') write_prefix, 'Initialize glint:' + endif + endif + + if (my_task==master_task) then + write(stdout,'(a,a,X,i0)') write_prefix, 'Initialize glint, nhour_glint =', nhour_glint + endif + end subroutine update_for_restart + + +!*********************************************************************** + subroutine report_time_init + ! Write out extra reporting information that is done after initialization + + write(stdout,'(a,a)') write_prefix, '----- BEGIN REPORT_TIME_INIT -----' + call writevar(stop_option, "stop_option", write_prefix, stdout) + call writevar(runid, "runid", write_prefix, stdout) + call writevar(runtype, "runtype", write_prefix, stdout) + call writevar(dt_option, "dt_option", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(stop_count, "stop_count", write_prefix, stdout) + call writevar(stop_iopt, "stop_iopt", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(end_run_at_midnight, "end_run_at_midnight", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(steps_per_year, "steps_per_year", write_prefix, stdout) + call writevar(steps_per_day, "steps_per_day", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(iyear0, "iyear0", write_prefix, stdout) + call writevar(imonth0, "imonth0", write_prefix, stdout) + call writevar(iday0, "iday0", write_prefix, stdout) + call writevar(ihour0, "ihour0", write_prefix, stdout) + call writevar(iminute0, "iminute0", write_prefix, stdout) + call writevar(isecond0, "isecond0", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(iyear_start_run, "iyear_start_run", write_prefix, stdout) + call writevar(imonth_start_run, "imonth_start_run", write_prefix, stdout) + call writevar(iday_start_run, "iday_start_run", write_prefix, stdout) + call writevar(ihour_start_run, "ihour_start_run", write_prefix, stdout) + call writevar(iminute_start_run, "iminute_start_run", write_prefix, stdout) + call writevar(isecond_start_run, "isecond_start_run", write_prefix, stdout) + call writevar(iday_of_year_start_run, "iday_of_year_start_run", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(iyear_end_run, "iyear_end_run", write_prefix, stdout) + call writevar(imonth_end_run, "imonth_end_run", write_prefix, stdout) + call writevar(iday_end_run, "iday_end_run", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(elapsed_days_end_run, "elapsed_days_end_run", write_prefix, stdout) + call writevar(elapsed_days_max, "elapsed_days_max", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(allow_leapyear, "allow_leapyear", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(dtt, "dtt", write_prefix, stdout) + call writevar(dtt_input, "dtt_input", write_prefix, stdout) + write(stdout,'(a,a)') write_prefix, '----- END REPORT_TIME_INIT -----' + + end subroutine report_time_init + + + +!*********************************************************************** + subroutine report_time + ! Write out current time information + + write(stdout,'(a,a)') write_prefix, '----- BEGIN REPORT_TIME -----' + call writevar(nsteps_total, "nsteps_total", write_prefix, stdout) + call writevar(nsteps_run, "nsteps_run", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(eod, "eod", write_prefix, stdout) + call writevar(eom, "eom", write_prefix, stdout) + call writevar(eoy, "eoy", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(first_step, "first_step", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(midnight, "midnight", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(adjust_nyears, "adjust_nyears", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(new_dtt_value, "new_dtt_value", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(midnight_next, "midnight_next", write_prefix, stdout) + call writevar(adjust_nyears_next, "adjust_nyears_next", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(iyear, "iyear", write_prefix, stdout) + call writevar(imonth, "imonth", write_prefix, stdout) + call writevar(iday, "iday", write_prefix, stdout) + call writevar(ihour, "ihour", write_prefix, stdout) + call writevar(iminute, "iminute", write_prefix, stdout) + call writevar(isecond, "isecond", write_prefix, stdout) + call writevar(iday_of_year, "iday_of_year", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(imonth_next, "imonth_next", write_prefix, stdout) + call writevar(iday_next, "iday_next", write_prefix, stdout) + call writevar(ihour_next, "ihour_next", write_prefix, stdout) + call writevar(iminute_next, "iminute_next", write_prefix, stdout) + call writevar(isecond_next, "isecond_next", write_prefix, stdout) + call writevar(iday_of_year_next, "iday_of_year_next", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(iyear_last, "iyear_last", write_prefix, stdout) + call writevar(imonth_last, "imonth_last", write_prefix, stdout) + call writevar(iday_last, "iday_last", write_prefix, stdout) + call writevar(ihour_last, "ihour_last", write_prefix, stdout) + call writevar(iday_of_year_last, "iday_of_year_last", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(days_in_year, "days_in_year", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(elapsed_days, "elapsed_days", write_prefix, stdout) + call writevar(elapsed_days0, "elapsed_days0", write_prefix, stdout) + call writevar(elapsed_days_jan1, "elapsed_days_jan1", write_prefix, stdout) + call writevar(elapsed_days_this_run, "elapsed_days_this_run", write_prefix, stdout) + call writevar(elapsed_days_this_year, "elapsed_days_this_year", write_prefix, stdout) + call writevar(elapsed_days_init_date, "elapsed_days_init_date", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(elapsed_months, "elapsed_months", write_prefix, stdout) + call writevar(elapsed_months_this_run, "elapsed_months_this_run", write_prefix, stdout) + call writevar(elapsed_months_init_date, "elapsed_months_init_date", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(elapsed_years, "elapsed_years", write_prefix, stdout) + call writevar(elapsed_years_this_run, "elapsed_years_this_run", write_prefix, stdout) + call writevar(elapsed_years_init_date, "elapsed_years_init_date", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(seconds_this_year, "seconds_this_year", write_prefix, stdout) + call writevar(seconds_this_day, "seconds_this_day", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(seconds_this_year_next, "seconds_this_year_next", write_prefix, stdout) + call writevar(seconds_this_day_next, "seconds_this_day_next", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(seconds_in_year, "seconds_in_year", write_prefix, stdout) + call writevar(hours_in_year, "hours_in_year", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(frac_day, "frac_day", write_prefix, stdout) + call writevar(tyear, "tyear", write_prefix, stdout) + call writevar(tmonth, "tmonth", write_prefix, stdout) + call writevar(tday, "tday", write_prefix, stdout) + call writevar(thour, "thour", write_prefix, stdout) + call writevar(tsecond, "tsecond", write_prefix, stdout) + call writevar(tsecond_old, "tsecond_old", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(newhour, "newhour", write_prefix, stdout) + call writevar(leapyear, "leapyear", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(tyear00, "tyear00", write_prefix, stdout) + call writevar(tsecond00, "tsecond00", write_prefix, stdout) + call writevar(tday00, "tday00", write_prefix, stdout) + call writevar(thour00, "thour00", write_prefix, stdout) + write(stdout,'(a)') write_prefix + call writevar(stepsize, "stepsize", write_prefix, stdout) + call writevar(stepsize_next, "stepsize_next", write_prefix, stdout) + write(stdout,'(a,a)') write_prefix, '----- END REPORT_TIME -----' + + end subroutine report_time + +!*********************************************************************** + +end module glc_time_management_test_mod diff --git a/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/cism_in b/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/cism_in new file mode 100644 index 0000000000..7b24b7fa42 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 3 + imonth0 = 12 + iday0 = 25 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/time_management_test_in b/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/time_management_test_in new file mode 100644 index 0000000000..cf171f9ad4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/100day_leap_start00031225/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 8640000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/cism_in b/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/cism_in new file mode 100644 index 0000000000..fff9fffd9b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 4 + imonth0 = 12 + iday0 = 25 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/time_management_test_in b/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/time_management_test_in new file mode 100644 index 0000000000..cf171f9ad4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/100day_leap_start00041225/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 8640000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/cism_in new file mode 100644 index 0000000000..74cdef21bb --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/time_management_test_in new file mode 100644 index 0000000000..5430248cea --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 18 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/cism_in new file mode 100644 index 0000000000..74cdef21bb --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/time_management_test_in new file mode 100644 index 0000000000..0c07d40df8 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 360 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/cism_in new file mode 100644 index 0000000000..74cdef21bb --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/time_management_test_in new file mode 100644 index 0000000000..410ff84ace --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 23 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/cism_in new file mode 100644 index 0000000000..b78835e559 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/time_management_test_in new file mode 100644 index 0000000000..5430248cea --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 18 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/cism_in new file mode 100644 index 0000000000..b78835e559 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/time_management_test_in new file mode 100644 index 0000000000..0c07d40df8 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 360 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/cism_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/cism_in new file mode 100644 index 0000000000..b78835e559 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 4 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/time_management_test_in new file mode 100644 index 0000000000..410ff84ace --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_forRestart_stopEndOfYear_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 23 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/cism_in b/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/cism_in new file mode 100644 index 0000000000..7b24b7fa42 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 3 + imonth0 = 12 + iday0 = 25 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/time_management_test_in new file mode 100644 index 0000000000..0d10327b0d --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_leap_start00031225/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/cism_in b/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/cism_in new file mode 100644 index 0000000000..fff9fffd9b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 4 + imonth0 = 12 + iday0 = 25 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/time_management_test_in b/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/time_management_test_in new file mode 100644 index 0000000000..0d10327b0d --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/20day_leap_start00041225/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 1728000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/219day/cism_in b/components/cism/test/unit/time_management/inputs/219day/cism_in new file mode 100644 index 0000000000..35beb022ba --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/219day/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/219day/time_management_test_in b/components/cism/test/unit/time_management/inputs/219day/time_management_test_in new file mode 100644 index 0000000000..43aef6b48c --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/219day/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 15 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 18921600 + +/ diff --git a/components/cism/test/unit/time_management/inputs/219day_leap/cism_in b/components/cism/test/unit/time_management/inputs/219day_leap/cism_in new file mode 100644 index 0000000000..7802ca1e8b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/219day_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/219day_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/219day_leap/time_management_test_in new file mode 100644 index 0000000000..43aef6b48c --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/219day_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 15 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 18921600 + +/ diff --git a/components/cism/test/unit/time_management/inputs/511day/cism_in b/components/cism/test/unit/time_management/inputs/511day/cism_in new file mode 100644 index 0000000000..35beb022ba --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/511day/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/511day/time_management_test_in b/components/cism/test/unit/time_management/inputs/511day/time_management_test_in new file mode 100644 index 0000000000..7039d6312a --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/511day/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 10 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 44150400 + +/ diff --git a/components/cism/test/unit/time_management/inputs/511day_leap/cism_in b/components/cism/test/unit/time_management/inputs/511day_leap/cism_in new file mode 100644 index 0000000000..7802ca1e8b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/511day_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/511day_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/511day_leap/time_management_test_in new file mode 100644 index 0000000000..7039d6312a --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/511day_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 10 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 44150400 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/time_management_test_in new file mode 100644 index 0000000000..f177a2fe86 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/time_management_test_in new file mode 100644 index 0000000000..3b48e345a5 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1.restart2/time_management_test_in @@ -0,0 +1,20 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + ! NOTE: Setting this to 1824 rather than 1825 to trigger failure of the restart test + elapsed_days_test = 1824 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/time_management_test_in new file mode 100644 index 0000000000..f941812094 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3650 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/time_management_test_in new file mode 100644 index 0000000000..f177a2fe86 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/cism_in new file mode 100644 index 0000000000..cb4f1d0c5f --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 2 ! NOTE: using 2 rather than 1 to trigger failure of the restart test + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/time_management_test_in new file mode 100644 index 0000000000..de7d87a457 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 1825 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/cism_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/time_management_test_in b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/time_management_test_in new file mode 100644 index 0000000000..f941812094 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/FAIL_oneday_2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3650 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/README b/components/cism/test/unit/time_management/inputs/README new file mode 100644 index 0000000000..ed2b452d55 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/README @@ -0,0 +1,116 @@ +This directory contains inputs for the time_management test driver for +a number of test cases. + +To run with a given set of inputs, copy the files in one of the +sub-directories to the parent time_management directory. + +For example, to run the oneyear test, do the following: + + cp oneyear/*_in .. + cd .. + ./time_management_test > oneyear_output + + +--- NOTE ABOUT DIRECTORIES WITH NAME FAIL_* --- + +Directories with the name *_FAIL (or *_FAIL_restart1 and +*_FAIL_restart2) are expected to fail. For example, these are used to +make sure that the restart_test script successfully catches failures +to restart exactly. + +--- DOCUMENTATION OF INPUTS CONTAINED HERE --- + +Tests that should fail: + +- FAIL_oneday_1, FAIL_oneday_1.restart1, FAIL_oneday_1.restart2: + Restart test with one-day time step expected to fail + +- FAIL_oneday_2, FAIL_oneday_2.restart1, FAIL_oneday_2.restart2: + Restart test with one-day time step expected to fail + + +Tests that should succeed: + +The following is generally ordered from short to long time steps: + +- sixhour: Test 6-hour time step + +- sixhour.restart1: Test six-hour time step with restart: first + portion of run. Note that this stops in the middle of a year. + +- sixhour.restart2: Test six-hour time step with restart: second + portion of run. + +- sixhour_leap: Test 6-hour time step, with leap years + +- sevenhour: Test 7-hour time step, for the sake of testing a time step + that doesn't divide a day + +- oneday: Test one-day time step + +- oneday.restart1: Test one-day time step with restart: first portion + of run + +- oneday.restart2: Test one-day time step with restart: second portion + of run + +- oneday_leap: Test one-day time step, with leap years + +- 20day_leap_start00031225: Short run starting near the end of a year, + where first time step brings us to the next year + +- 20day_leap_start00041225: Similar to 20day_leap_start00031225, but + now starting in a leap year + +- 20day_forRestart_stopEndOfYear, + 20day_forRestart_stopEndOfYear.restart1, + 20day_forRestart_stopEndOfYear.restart2: Restart test with a run + with a 20-day timestep, where the first run of the restart test + stops at the end of the year, so the first timestep of the continue + case crosses a year boundary. + +- 20day_forRestart_stopEndOfYear_leap, + 20day_forRestart_stopEndOfYear_leap.restart1, + 20day_forRestart_stopEndOfYear_leap.restart2: Similar to + 20day_forRestart_stopEndOfYear, but with leap years active. + +- 100day_leap_start00031225: Short run starting near the end of a + year, where first time step brings us to the next year and crosses + the Feb 29 border + +- 100day_leap_start00041225: Similar to 100day_leap_start00031225, but + now starting in a leap year + +- 219day: Test with 219-day time step, for the sake of testing a time + step that doesn't divide a year (but divides 5 years) + +- 219day_leap: Test with 219-day time step, with leap years + +- oneyear: Test one-year time step + +- oneyear.restart1: Test one-year time step with restart: first +portion of run + +- oneyear.restart2: Test one-year time step with restart: second +portion of run + +- oneyear_leap: Test 365-day time step, with leap years + +- 511day: Test with 511-day time step, for the sake of testing a time + step greater than a year, but not an exact number of years (but note + that 5 timesteps = 7 years) + +- 511day_leap: Test with 511-day time step, with leap years + +- twoyear: Test 2-year time step, specified as 0.5 steps_per_year + (purpose is to test fractional steps_per_year) + +- twoyear.restart1: Test 2-year time step with restart: first portion + of run + +- twoyear.restart2: Test 2-year time step with restart: second portion + of run + +- threeyear: Test 3-year time step + +- threeyear_leap: Test 1095-day time step, with leap years diff --git a/components/cism/test/unit/time_management/inputs/oneday.restart1/cism_in b/components/cism/test/unit/time_management/inputs/oneday.restart1/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneday.restart1/time_management_test_in new file mode 100644 index 0000000000..f177a2fe86 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday.restart2/cism_in b/components/cism/test/unit/time_management/inputs/oneday.restart2/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneday.restart2/time_management_test_in new file mode 100644 index 0000000000..de7d87a457 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 1825 + + ! number of time steps to run the test for + nsteps_test = 1825 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday/cism_in b/components/cism/test/unit/time_management/inputs/oneday/cism_in new file mode 100644 index 0000000000..242e60a3d1 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneday/time_management_test_in new file mode 100644 index 0000000000..f941812094 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3650 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday_leap/cism_in b/components/cism/test/unit/time_management/inputs/oneday_leap/cism_in new file mode 100644 index 0000000000..0c474cab6b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneday_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneday_leap/time_management_test_in new file mode 100644 index 0000000000..f941812094 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneday_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3650 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear.restart1/cism_in b/components/cism/test/unit/time_management/inputs/oneyear.restart1/cism_in new file mode 100644 index 0000000000..dd86b0f307 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneyear.restart1/time_management_test_in new file mode 100644 index 0000000000..af7e7d0c60 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear.restart2/cism_in b/components/cism/test/unit/time_management/inputs/oneyear.restart2/cism_in new file mode 100644 index 0000000000..dd86b0f307 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneyear.restart2/time_management_test_in new file mode 100644 index 0000000000..9d56d296b7 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 1825 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear/cism_in b/components/cism/test/unit/time_management/inputs/oneyear/cism_in new file mode 100644 index 0000000000..dd86b0f307 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneyear/time_management_test_in new file mode 100644 index 0000000000..8c74f64cb4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 10 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear_leap/cism_in b/components/cism/test/unit/time_management/inputs/oneyear_leap/cism_in new file mode 100644 index 0000000000..7802ca1e8b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/oneyear_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/oneyear_leap/time_management_test_in new file mode 100644 index 0000000000..291f0e9bb8 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/oneyear_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 10 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 31536000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/sevenhour/cism_in b/components/cism/test/unit/time_management/inputs/sevenhour/cism_in new file mode 100644 index 0000000000..4395111623 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sevenhour/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 1 ! this will be overwritten + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/sevenhour/time_management_test_in b/components/cism/test/unit/time_management/inputs/sevenhour/time_management_test_in new file mode 100644 index 0000000000..f36808c9dc --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sevenhour/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 8760 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 25200 + +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour.restart1/cism_in b/components/cism/test/unit/time_management/inputs/sixhour.restart1/cism_in new file mode 100644 index 0000000000..4732f8e464 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 4 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/sixhour.restart1/time_management_test_in new file mode 100644 index 0000000000..f34cb9ec11 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 1540 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour.restart2/cism_in b/components/cism/test/unit/time_management/inputs/sixhour.restart2/cism_in new file mode 100644 index 0000000000..4732f8e464 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 4 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/sixhour.restart2/time_management_test_in new file mode 100644 index 0000000000..7e455e6b47 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 385 + + ! number of time steps to run the test for + nsteps_test = 13060 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour/cism_in b/components/cism/test/unit/time_management/inputs/sixhour/cism_in new file mode 100644 index 0000000000..4732f8e464 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 4 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour/time_management_test_in b/components/cism/test/unit/time_management/inputs/sixhour/time_management_test_in new file mode 100644 index 0000000000..8935df7c18 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 14600 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour_leap/cism_in b/components/cism/test/unit/time_management/inputs/sixhour_leap/cism_in new file mode 100644 index 0000000000..723d9e7f54 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' + dt_count = 4 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/sixhour_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/sixhour_leap/time_management_test_in new file mode 100644 index 0000000000..8935df7c18 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/sixhour_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 14600 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/threeyear/cism_in b/components/cism/test/unit/time_management/inputs/threeyear/cism_in new file mode 100644 index 0000000000..35beb022ba --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/threeyear/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/threeyear/time_management_test_in b/components/cism/test/unit/time_management/inputs/threeyear/time_management_test_in new file mode 100644 index 0000000000..af798a8ead --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/threeyear/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 94608000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/threeyear_leap/cism_in b/components/cism/test/unit/time_management/inputs/threeyear_leap/cism_in new file mode 100644 index 0000000000..7802ca1e8b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/threeyear_leap/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_day' ! this will be overwritten, so it doesn't matter + dt_count = 1 + allow_leapyear = .true. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/threeyear_leap/time_management_test_in b/components/cism/test/unit/time_management/inputs/threeyear_leap/time_management_test_in new file mode 100644 index 0000000000..af798a8ead --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/threeyear_leap/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 3 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = 94608000 + +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear.restart1/cism_in b/components/cism/test/unit/time_management/inputs/twoyear.restart1/cism_in new file mode 100644 index 0000000000..e75625e1c4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear.restart1/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 0.5 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear.restart1/time_management_test_in b/components/cism/test/unit/time_management/inputs/twoyear.restart1/time_management_test_in new file mode 100644 index 0000000000..a7e9067e77 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear.restart1/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 2 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear.restart2/cism_in b/components/cism/test/unit/time_management/inputs/twoyear.restart2/cism_in new file mode 100644 index 0000000000..e75625e1c4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear.restart2/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 0.5 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear.restart2/time_management_test_in b/components/cism/test/unit/time_management/inputs/twoyear.restart2/time_management_test_in new file mode 100644 index 0000000000..8310e5d56b --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear.restart2/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'continue' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 1460 + + ! number of time steps to run the test for + nsteps_test = 3 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear/cism_in b/components/cism/test/unit/time_management/inputs/twoyear/cism_in new file mode 100644 index 0000000000..e75625e1c4 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear/cism_in @@ -0,0 +1,14 @@ +&time_manager_nml + runid = 'time_management_test' + dt_option = 'steps_per_year' + dt_count = 0.5 + allow_leapyear = .false. + iyear0 = 1 + imonth0 = 1 + iday0 = 1 + ihour0 = 0 + iminute0 = 0 + isecond0 = 0 + date_separator = '-' + stop_option = 'never' +/ diff --git a/components/cism/test/unit/time_management/inputs/twoyear/time_management_test_in b/components/cism/test/unit/time_management/inputs/twoyear/time_management_test_in new file mode 100644 index 0000000000..af7e7d0c60 --- /dev/null +++ b/components/cism/test/unit/time_management/inputs/twoyear/time_management_test_in @@ -0,0 +1,19 @@ +&time_management_test_nml + + ! type of run to test ('initial', 'continue' or 'branch') + runtype_test = 'initial' + + ! if runtype_test == 'continue', then this gives the number of + ! elapsed days at which the run starts; ignored for other values of + ! runtype_test + elapsed_days_test = 0 + + ! number of time steps to run the test for + nsteps_test = 5 + + ! if dtt_test > 0, then we overwrite the value of dtt with this + ! value (specified in seconds), rather than using dt_option and + ! dt_count; ignored if dtt_test <= 0 + dtt_test = -1 + +/ diff --git a/components/cism/test/unit/time_management/restart_test b/components/cism/test/unit/time_management/restart_test new file mode 100755 index 0000000000..f1763a7ed6 --- /dev/null +++ b/components/cism/test/unit/time_management/restart_test @@ -0,0 +1,107 @@ +#!/bin/bash + +# Run a restart test with the time manager, to make sure that the +# sequence of times is the same for (a) a run that goes all the way +# through, and (b) the same run broken up into two pieces. +# +# If the test succeeds (i.e., the restart case gives the same time +# sequence as the run all the way through), then there will be no +# output from this script. If there are some differences, these +# differences will be output to stdout. +# +# This requires that the namelists are already set up for three cases: +# (1) the run all the way through +# (2) the first ('initial') run of the restart test +# (3) the second ('continue') run of the restart test +# +# Usage: restart_test testname +# where testname is the name of a directory in the inputs directory +# The following directories must be set up in the inputs directory: +# (1) testname: inputs for the run that goes all the way through +# (2) testname.restart1: inputs for the first ('initial') run of the +# restart test +# (3) testname.restart2: inputs for the second ('continue') run of the +# restart test + +# ---------------------------------------------------------------------- +# SET PARAMETERS HERE +# ---------------------------------------------------------------------- + +testprog=./time_management_test + +# ---------------------------------------------------------------------- +# DONE SETTING PARAMETERS +# ---------------------------------------------------------------------- + + +if [[ $# -ne 1 ]]; then + echo "Expect one argument: testname" + exit 1 +fi + +testname=$1 + +# ---------------------------------------------------------------------- +# RUN TEST DRIVER ON THE THREE CASES +# ---------------------------------------------------------------------- + +cp inputs/$testname/*_in . +$testprog > test_output.full.$$ + +cp inputs/${testname}.restart1/*_in . +$testprog > test_output.r1.$$ + +cp inputs/${testname}.restart2/*_in . +$testprog > test_output.r2.$$ + + +# ---------------------------------------------------------------------- +# REMOVE SOME VARIABLES ENDING WITH '_run' +# (we expect differences in these variables)' +# ---------------------------------------------------------------------- + +for fl in test_output.full.$$ test_output.r1.$$ test_output.r2.$$; do + cat $fl | grep -v 'nsteps_run *=' | grep -v 'elapsed_days_this_run *=' | grep -v 'elapsed_months_this_run *=' | grep -v 'elapsed_years_this_run *=' > ${fl}_noRun +done + +# ---------------------------------------------------------------------- +# PROCESS THE R1 & R2 OUTPUT TO REMOVE DUPLICATE INFO +# this includes the initialization section from r2, for example +# ---------------------------------------------------------------------- + +# Delete the last line (saying "SUCCESSFUL TERMINATION...") from the +# r1 ('initial') case +sed -e '$ d' test_output.r1.$$_noRun > test_output.r1.$$_finalRemoved + +# Create an awk script that will print everything after the first +# instance of "END REPORT_TIME " (note the trailing space so we don't +# catch "END REPORT_TIME_INIT"). This will be run on the output of the +# r2 ('continue') case, to throw out the output from initialization. +cat > awk_cmds.$$ <= 1 {print \$0} +/END REPORT_TIME / {found = found+1} +EOF + +awk -f awk_cmds.$$ test_output.r2.$$_noRun > test_output.r2.$$_initialRemoved + +# ---------------------------------------------------------------------- +# COMPARE OUTPUT +# ---------------------------------------------------------------------- + +# Concatenate the processed output from r1 & r2 +cat test_output.r1.$$_finalRemoved test_output.r2.$$_initialRemoved > test_output.rFull.$$ + +# Compare with the full run +diff test_output.full.$$_noRun test_output.rFull.$$ + +# ---------------------------------------------------------------------- +# CLEANUP +# ---------------------------------------------------------------------- + +rm test_output.full.$$ test_output.r1.$$ test_output.r2.$$ +rm test_output.full.$$_noRun test_output.r1.$$_noRun test_output.r2.$$_noRun +rm test_output.r1.$$_finalRemoved +rm test_output.r2.$$_initialRemoved +rm test_output.rFull.$$ +rm awk_cmds.$$ \ No newline at end of file diff --git a/components/cism/test/unit/time_management/restart_testlist b/components/cism/test/unit/time_management/restart_testlist new file mode 100644 index 0000000000..fc14ff8fa4 --- /dev/null +++ b/components/cism/test/unit/time_management/restart_testlist @@ -0,0 +1,6 @@ +20day_forRestart_stopEndOfYear +20day_forRestart_stopEndOfYear_leap +oneday +oneyear +twoyear +sixhour diff --git a/components/cism/test/unit/time_management/testlist b/components/cism/test/unit/time_management/testlist new file mode 100644 index 0000000000..e4f6c7f1b6 --- /dev/null +++ b/components/cism/test/unit/time_management/testlist @@ -0,0 +1,26 @@ +100day_leap_start00031225 +100day_leap_start00041225 +20day_forRestart_stopEndOfYear +20day_forRestart_stopEndOfYear.restart2 +20day_forRestart_stopEndOfYear_leap +20day_forRestart_stopEndOfYear_leap.restart2 +20day_leap_start00031225 +20day_leap_start00041225 +219day +219day_leap +511day +511day_leap +oneday +oneday.restart2 +oneday_leap +oneyear +oneyear.restart2 +oneyear_leap +twoyear +twoyear.restart2 +sevenhour +sixhour +sixhour.restart2 +sixhour_leap +threeyear +threeyear_leap \ No newline at end of file diff --git a/components/cism/test/unit/unit_test_replacements/README b/components/cism/test/unit/unit_test_replacements/README new file mode 100644 index 0000000000..beacd095ca --- /dev/null +++ b/components/cism/test/unit/unit_test_replacements/README @@ -0,0 +1,13 @@ +This directory contains trimmed-down versions of various modules that +remove a lot of dependencies. When unit tests are compiled, the +versions here have precedence over the versions in the main source +directories. However, the versions here can themselves be replaced by +files with the same name in the source directory of a particular unit +test. + +That is, the precedence is: + +(1) source directory of unit test +(2) unit_test_shr +(2) unit_test_replacements +(4) main source directories diff --git a/components/cism/test/unit/unit_test_replacements/glc_communicate.F90 b/components/cism/test/unit/unit_test_replacements/glc_communicate.F90 new file mode 100644 index 0000000000..1588b589d4 --- /dev/null +++ b/components/cism/test/unit/unit_test_replacements/glc_communicate.F90 @@ -0,0 +1,30 @@ +! Trimmed-down version of glc_communicate including just what is needed for cism unit tests, +! in order to avoid dependencies + +module glc_communicate + + use glc_kinds_mod + use shr_sys_mod, only : shr_sys_abort + + implicit none + public + save + + integer(int_kind), parameter :: my_task = 0 + integer(int_kind), parameter :: master_task = 0 + +contains + + subroutine exit_message_environment(ierr) + integer (int_kind), intent(out) :: ierr + + return + end subroutine exit_message_environment + + subroutine abort_message_environment(ierr) + integer (int_kind), intent(out) :: ierr + + call shr_sys_abort('glc_communicate.F90: abort_message_environment') + end subroutine abort_message_environment + +end module glc_communicate diff --git a/components/cism/test/unit/unit_test_replacements/glc_files.F90 b/components/cism/test/unit/unit_test_replacements/glc_files.F90 new file mode 100644 index 0000000000..5e3ca68feb --- /dev/null +++ b/components/cism/test/unit/unit_test_replacements/glc_files.F90 @@ -0,0 +1,11 @@ +! Trimmed-down version of glc_files including just what is needed for cism unit tests, +! in order to avoid dependencies + +module glc_files + + implicit none + public + save + + character(len=*), parameter :: nml_filename = 'cism_in' +end module glc_files diff --git a/components/cism/test/unit/unit_test_replacements/shr_sys_mod.F90 b/components/cism/test/unit/unit_test_replacements/shr_sys_mod.F90 new file mode 100644 index 0000000000..c7ec62af53 --- /dev/null +++ b/components/cism/test/unit/unit_test_replacements/shr_sys_mod.F90 @@ -0,0 +1,87 @@ +! Trimmed-down version of shr_sys_mod including just what is needed for cism unit tests, +! in order to avoid dependencies + +module shr_sys_mod + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + + private + + public :: shr_sys_abort ! abort a program + public :: shr_sys_flush ! flush an i/o buffer + + +contains + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_abort(string,rc) + + IMPLICIT none + + character(*) ,optional :: string ! error message string + integer(SHR_KIND_IN),optional :: rc ! error code + + !----- local ----- + integer(SHR_KIND_IN) :: ierr + logical :: flag + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_abort) ' + character(*),parameter :: F00 = "('(shr_sys_abort) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: consistent stopping mechanism +!------------------------------------------------------------------------------- + + call shr_sys_flush(s_logunit) + if (len_trim(string) > 0) write(s_logunit,F00) 'ERROR: '//trim(string) + write(s_logunit,F00) 'WARNING: calling shr_mpi_abort() and stopping' + call shr_sys_flush(s_logunit) + +! WJS (12-6-11): Removed some mpi-related stuff that is here in the real version of this +! subroutine + + call abort() + stop + +END SUBROUTINE shr_sys_abort + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_flush(unit) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_flush) ' + character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + +! WJS (12-6-11): I have reworked this from the real version, in order to allow +! reassonable behavior when the sysstem is not defined + +#if (defined AIX) + call flush_(unit) +#else + call flush(unit) +#endif + +END SUBROUTINE shr_sys_flush + +!=============================================================================== +!=============================================================================== + +end module shr_sys_mod diff --git a/components/cism/test/unit/unit_test_shr/Makefile.common b/components/cism/test/unit/unit_test_shr/Makefile.common new file mode 100644 index 0000000000..3148851168 --- /dev/null +++ b/components/cism/test/unit/unit_test_shr/Makefile.common @@ -0,0 +1,351 @@ +#----------------------------------------------------------------------- +# This file contains variable definitions, etc. that are needed by the +# makefiles for all of the unit testers. Thus, this file should be +# included in those makefiles. +# +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# These macros can be changed by setting environment variables: +# +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#----------------------------------------------------------------------- + +# Set up special characters +null := + +RM = rm + +# Check for the netcdf library and include directories +ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include +endif + +ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) +endif + +# Set user specified Fortran compiler +ifneq ($(USER_FC),$(null)) + FC := $(USER_FC) +endif +# Set user specified C compiler +ifneq ($(USER_CC),$(null)) + CC := $(USER_CC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(INC_MPI) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +VPATH := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +VPATH := $(subst $(space),:,$(VPATH)) + +#Primary Target: build the tool +all: $(EXENAME) + +# Get list of files and build dependency file for all .o files +# using perl script Mkdepends + +SOURCES := $(shell cat Srcfiles) + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +# Set path to mkDepends script +mkDepends := ../../../../../../scripts/ccsm_utils/Machines/mkDepends + +# WJS (12-7-11): TODO: I think this Depends file should really be +# remade any time a source file changes, since the dependencies +# potentially change whenever source files change. However, I don't +# know an easy way to write that rule. Alternatively, we could just +# remake the Depends file whenever make is run, if that doesn't take +# too long. +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + $(mkDepends) Filepath Srcfiles > $@ + + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +CPPDEF += -DAIX -DFORTRAN_SAME +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(CPPDEF)) +LIB_NETCDF := /usr/local/lib64/r4i4 +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90 -qsuffix=f=f90:cpp=F90 \ + $(FPPFLAGS) -g -qfullpath +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdf +ifneq ($(OPT),TRUE) + FFLAGS += -qinitauto=FF911299 -qflttrap=ov:zero:inv:en -C +else + FFLAGS += -O2 -qmaxmem=-1 -Q + LDFLAGS += -Q +endif +CFLAGS := -q64 -g $(CPPDEF) -O2 +FFLAGS += $(cpp_path) +CFLAGS += $(cpp_path) + +ifeq ($(SMP),TRUE) + FC = xlf90_r + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp +else + FC = xlf90 +endif + +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + +# Set the default Fortran compiler +ifeq ($(USER_FC),$(null)) + FC := g95 +endif +ifeq ($(USER_CC),$(null)) + CC := gcc +endif + +CFLAGS := -g -O2 +CPPDEF += -DSYSDARWIN -DDarwin -DLINUX +LDFLAGS := + +ifeq ($(FC),g95) + + CPPDEF += -DFORTRAN_SAME + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),gfortran) + + CPPDEF += -DG95 + CPPDEF += -DFORTRAN_SAME + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) \ + -fno-range-check + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),ifort) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c -ftz -g -fp-model precise $(CPPDEF) $(cpp_path) \ + -convert big_endian -assume byterecl -traceback -FR + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + LDFLAGS += -openmp + endif +endif + +ifeq ($(FC),pgf90) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c $(CPPDEF) $(cpp_path) + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + +endif + +ifeq ($(CC),icc) + CFLAGS += -m64 -g + ifeq ($(SMP),TRUE) + CFLAGS += -openmp + endif +endif +ifeq ($(CC),pgcc) + CFLAGS += -g -fast +endif + +CFLAGS += $(CPPDEF) $(cpp_path) +LDFLAGS += -L$(LIB_NETCDF) -lnetcdf -lSystemStubs -lSystemStubs_profile + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := pgf90 + FCTYP := pgf90 + else + ifeq ($(USER_FC),ftn) + ifneq ($(USER_FCTYP),$(null)) + FCTYP := $(USER_FCTYP) + else + FCTYP := pgf90 + endif + else + FCTYP := $(USER_FC) + endif + endif + CPPDEF += -DLINUX -DFORTRANUNDERSCORE + CFLAGS := $(CPPDEF) + LDFLAGS = -L$(LIB_NETCDF) -lnetcdf + FFLAGS = + + ifeq ($(FCTYP),pgf90) + CC := pgcc + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + CFLAGS += -fast + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + + endif + + ifeq ($(FCTYP),lf95) + ifneq ($(OPT),TRUE) + FFLAGS += -g --chk a,e,s,u -O0 + else + FFLAGS += -O + endif + # Threading only works by putting thread memory on the heap rather than the stack + # (--threadheap). + # As of lf95 version 6.2 the thread stacksize limits are (still) too small to run + # even small + # resolution problems (FV at 10x15 res fails). + ifeq ($(SMP),TRUE) + FFLAGS += --openmp --threadheap 4096 + LDFLAGS += --openmp --threadheap 4096 + endif + endif + ifeq ($(FCTYP),pathf90) + FFLAGS += -extend_source -ftpp -fno-second-underscore + ifneq ($(OPT),TRUE) + FFLAGS += -g -O0 + else + FFLAGS += -O + endif + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + endif + ifeq ($(FCTYP),ifort) + + FFLAGS += -ftz -g -fp-model precise -convert big_endian -assume byterecl -traceback -FR + CFLAGS += -m64 -g + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + CFLAGS += -openmp + LDFLAGS += -openmp + endif + endif + FFLAGS += -c -I$(INC_NETCDF) $(CPPDEF) $(cpp_path) + CFLAGS += $(cpp_path) +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifeq ($(USER_LINKER),$(null)) + LINKER := $(FC) +else + LINKER := $(USER_LINKER) +endif + +.F90.o: + $(FC) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod Depends + +include $(CURDIR)/Depends diff --git a/components/cism/test/unit/unit_test_shr/README b/components/cism/test/unit/unit_test_shr/README new file mode 100644 index 0000000000..924d4575a2 --- /dev/null +++ b/components/cism/test/unit/unit_test_shr/README @@ -0,0 +1,2 @@ +This directory contains modules, portions of a makefile, etc. that are +shared between a number of unit tests. diff --git a/components/cism/test/unit/unit_test_shr/writevar_mod.F90 b/components/cism/test/unit/unit_test_shr/writevar_mod.F90 new file mode 100644 index 0000000000..087c8ca9c7 --- /dev/null +++ b/components/cism/test/unit/unit_test_shr/writevar_mod.F90 @@ -0,0 +1,76 @@ +! This module contains subroutines for writing variables in a compiler and machine- +! independent way, so that we can diff output that has been created with different +! compilers / machines. + +module writevar_mod + use shr_kind_mod + + implicit none + save + + private + + + ! public interfaces + public :: writevar + + interface writevar + module procedure writevar_char + module procedure writevar_int + module procedure writevar_real + module procedure writevar_double + module procedure writevar_logical + end interface writevar + +contains + + subroutine writevar_char(var, name, prefix, unit) + character(len=*), intent(in) :: var ! variable whose value we are outputting + character(len=*), intent(in) :: name ! name of the variable + character(len=*), intent(in) :: prefix ! prefix to write at the start of the line + ! (we do NOT trim this) + integer , intent(in) :: unit ! output unit + + write(unit, '(a, a, " = ", a)') prefix, trim(name), trim(var) + end subroutine writevar_char + + subroutine writevar_int(var, name, prefix, unit) + integer , intent(in) :: var ! variable whose value we are outputting + character(len=*), intent(in) :: name ! name of the variable + character(len=*), intent(in) :: prefix ! prefix to write at the start of the line + ! (we do NOT trim this) + integer , intent(in) :: unit ! output unit + + write(unit, '(a, a, " = ", i0)') prefix, trim(name), var + end subroutine writevar_int + + subroutine writevar_real(var, name, prefix, unit) + real(SHR_KIND_R4), intent(in) :: var ! variable whose value we are outputting + character(len=*), intent(in) :: name ! name of the variable + character(len=*), intent(in) :: prefix ! prefix to write at the start of the line + ! (we do NOT trim this) + integer , intent(in) :: unit ! output unit + + write(unit, '(a, a, " = ", f0.6)') prefix, trim(name), var + end subroutine writevar_real + + subroutine writevar_double(var, name, prefix, unit) + real(SHR_KIND_R8), intent(in) :: var ! variable whose value we are outputting + character(len=*), intent(in) :: name ! name of the variable + character(len=*), intent(in) :: prefix ! prefix to write at the start of the line + ! (we do NOT trim this) + integer , intent(in) :: unit ! output unit + + write(unit, '(a, a, " = ", f0.12)') prefix, trim(name), var + end subroutine writevar_double + + subroutine writevar_logical(var, name, prefix, unit) + logical , intent(in) :: var ! variable whose value we are outputting + character(len=*), intent(in) :: name ! name of the variable + character(len=*), intent(in) :: prefix ! prefix to write at the start of the line + ! (we do NOT trim this) + integer , intent(in) :: unit ! output unit + + write(unit, '(a, a, " = ", l7)') prefix, trim(name), var + end subroutine writevar_logical +end module writevar_mod diff --git a/components/cism/tools/README.glc_overlap_tools b/components/cism/tools/README.glc_overlap_tools new file mode 100644 index 0000000000..3f9cb645ee --- /dev/null +++ b/components/cism/tools/README.glc_overlap_tools @@ -0,0 +1,211 @@ + DOCUMENTATION OF TOOLS TO MAKE A CLM OVERLAP FILE FROM A GLC NATIVE GRID + + +OVERVIEW + +The process of creating a CLM overlap file from a native GLC grid takes three +steps, and three separate tools: + +1. Convert the GLC grid from its native format to one understood by SCRIP. + + The tool created for this step is an NCL script called glc2scripConvert.ncl. + + Note that small differences in the extent of different GLC grids (e.g., 4km + vs. 5km vs. 10km CISM grid) are not important for the final glcmask file, + since these differences (currently) occur outside of the ice sheet area. So, + in general, this step only needs to be done once for a given icesheet (e.g., + once for Greenland, once for Antarctica). + +2. Create an ESMF interpolation weights file from the GLC SCRIP file made in + step 1. + + For this, there is a general-purpose CESM tool, in + tools/mapping/gen_mapping_files/gen_ESMF_mapping_file. + +3. Create a CLM overlap file which contains a mask representing the list of CLM + cells that overlap the GLC domain. + + For this, there is a tool that compares the list of points on the CLM grid + required for any interpolation with the GLC grid. The tool created for this + step is called scrip2CLMoverlap.ncl. + + +TOOLS + +Documentation for each tool follows below: + +** glc2scripConvert.ncl ** + +Description: +This script is written in NCL, and its basic function is to read in a native +GLC grid file and write out the same grid in a format understood by SCRIP, +CCSM's interpolation tool. SCRIP requires that cell-center lats and lons be +written out in 1D arrays whose length is the grid size, and that cell-corner +lats and lons be output as 2D arrays with the grid size as the first dimension +and the number of corners per cell as the second dimension. + +This script assumes that the GLC grid file has lats and lons as 2D arrays of +cell corner locations, and then assumes that cell centers are located at the +midpoints of the corners. In actuality, the grid files we use have lats and lons +of the CENTERS rather than the corners, but for the purposes of this toolchain, +this small difference is generally not important. + +This script then does some simple transformations before outputting the same +grid in the SCRIP format. + +Input: +The script requires a user-specified GLC grid file with lats and lons in +degrees. + +This file can be obtained and linked to the current directory, as: + +ln -s /glade/p/cesmdata/cseg/inputdata/glc/cism/gland5.input.nc gland5km.nc + +User Modifications: +The script is not commandline driven, so the script itself has to be modified +in several places to set the correct input file name, output file name, and +a corresponding output file attribute. In the script, these variables are +called, respectively: infile, outfile, and globalAtt@title. + + variable name variable description +______________________________________________________________________ + + infile input file name (GLC native grid file) + outfile output file name + globalAtt@title output file title attribute + +Output: +The script outputs the GLC grid in SCRIP format, with a user-specified file name. + +Usage: +ncl glc2scripConvert.ncl + + +** gen_ESMF_mapping_file ** + +Description: +This is a general-purpose CESM tool for generating ESMF mapping files between +two grids, based on two SCRIP-format files. + +Input: +The script requires two user-specified grid files in SCRIP format. + +Location of tool: +From a CESM checkout, this tool can be found at: +tools/mapping/gen_mapping_files/gen_ESMF_mapping_file + +(Note: for the files generated Nov 5, 2014, I used this version: +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_140702b) + +Running the tool on yellowstone: +The above tool can be run on yellowstone with a modified version of the +regridbatch.yellowstone.sh script. The version I have used looked like: + + #!/bin/bash + # + # + # Batch script to submit to create ESMF mapping file + # + # Set up for yellowstone + # + # yellowstone-specific batch commands: + #BSUB -P P93300601 # project number + #BSUB -n 8 # number of processors + #BSUB -R "span[ptile=16]" + #BSUB -W 1:00 # wall-clock limit + #BSUB -q caldera # queue + #BSUB -o regrid.%J.out # ouput filename + #BSUB -e regrid.%J.err # error filename + #BSUB -J create_ESMF_map # job name + #BSUB -N # send email upon job completion + + #---------------------------------------------------------------------- + + #---------------------------------------------------------------------- + # Set user-defined parameters here + #---------------------------------------------------------------------- + + filesrc="$CESMDATAROOT/inputdata/lnd/clm2/mappingdata/grids/0.9x1.25_c110307.nc" + filedst="/glade/p/work/sacks/cesm_code/cism_trunk/tools/gland5km_scrip.nc" + namesrc='fv0.9x1.25' + namedst='gland' + + typesrc='global' + typedst='regional' + maptype='aave' + + #---------------------------------------------------------------------- + # Done setting user-defined parameters + #---------------------------------------------------------------------- + + #---------------------------------------------------------------------- + # Stuff done in a machine-specific way + #---------------------------------------------------------------------- + + # Determine number of processors we're running on + host_array=($LSB_HOSTS) + REGRID_PROC=${#host_array[@]} + + #---------------------------------------------------------------------- + # Begin general script + #---------------------------------------------------------------------- + + cmdargs="--filesrc $filesrc --filedst $filedst --namesrc $namesrc --namedst $namedst --typesrc $typesrc --typedst $typedst --maptype $maptype --batch" + env REGRID_PROC=$REGRID_PROC ./create_ESMF_map.sh $cmdargs + +For 1.9x2.5, I used: +filesrc="$CESMDATAROOT/inputdata/lnd/clm2/mappingdata/grids/1.9x2.5_c110308.nc" + +and for 48x96 (T31), I used: +filesrc="$CESMDATAROOT/inputdata/lnd/clm2/mappingdata/grids/SCRIPgrid_48x96_nomask_c110308.nc" + + +This can be run with: + +bsub < regridbatch.yellowstone.sh + + +** scrip2CLMoverlap.ncl ** + +Description: +This script is written in NCL, and its basic function is to read in an ESMF +interpolation weight file (between a CLM grid and a GLC grid) as well as a CLM +fracdata file and output a CLM "overlap" file that contains a field for the +GLCMASK representing which CLM grid cells might have data required by GLC during +a coupled GLC run. Note that the CLM fracdata MUST be on the same grid used to +calculate the SCRIP interpolation file. The main functionality of this script +involves determining the list of CLM source points that overlap with a GLC +point, and creating a GLCMASK field that is set to one for such points. The +script then outputs the GLCMASK in a netcdf file in a CLM format, with a +user-specified name. A CLM fracdata file is used to determine the format of the +output file, including the longxy and latixy variables. + +Input: +The script requires a user-specified ESMF interpolation weight file and a +user-specified CLM fracdata file. + +Note that, in my workflow, I first moved the created map file into the current +directory, as in: +mv /glade/p/work/sacks/cesm_code/clm_glc_misc_updates_nov2014/tools/mapping/gen_mapping_files/gen_ESMF_mapping_file/map_fv0.9x1.25_TO_gland_aave.141105.nc . + +User Modifications: +The script is not commandline driven, so the script itself has to be modified +in several places to set the correct input file names, output file name, and +a corresponding output file attribute. These variables are described below, +with their script variable name and corresponding description. In the script, +each variable has an example name. + + variable name variable description +______________________________________________________________________ + + infileS input SCRIP interpolation weight file name + infileF input CLM fracdata file name + outfile output file name + globalAtt@title output file title attribute + +Output: +The script outputs the GLCMASK data in CLM format (similar to a LANDMASK +data file), with a user-specified file name. + +Usage: +ncl scrip2CLMoverlap.ncl diff --git a/components/cism/tools/README.glc_tools b/components/cism/tools/README.glc_tools new file mode 100644 index 0000000000..a8ad0cadbb --- /dev/null +++ b/components/cism/tools/README.glc_tools @@ -0,0 +1,11 @@ + LIST OF TOOLS IN THE GLC_TOOLS DIRECTORY AND THEIR USES + +********************************* +** Tools to make overlap files ** +********************************* + +* glc2scripConvert.ncl - converts GLC native grids to SCRIP + formatted grid files +* scrip2CLMoverlap.ncl - creates a GLC overlap file from an ESMF + interpolation weight file and a CLM + fracdata file diff --git a/components/cism/tools/glc2scripConvert.ncl b/components/cism/tools/glc2scripConvert.ncl new file mode 100644 index 0000000000..cdeb5a6f47 --- /dev/null +++ b/components/cism/tools/glc2scripConvert.ncl @@ -0,0 +1,118 @@ +; *********************************************** +; glc2scripConvert.ncl +; *********************************************** +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" +;************************************************ +begin +;************************************************ +; read in glimmer grid file +;************************************************ + +infile = addfile ("gland5km.nc","r") + +lat = infile->lat +lon = infile->lon +dims2D = dimsizes(lat) +nx = dims2D(2) +ny = dims2D(1) + +delete(infile) + +; ------------------------------------- +; calculate 1-D arrays of lats and lons +; ------------------------------------- + +; This code assumes that the grid file provides lats and lons of the grid cell +; corners. In actuality, the grid files we use give lats and lons of the grid +; cell CENTERS. But, for the sake of this tool-chain, this small difference is +; not important. + +grid_size = (nx-1)*(ny-1) +grid_corners = 4 +grid_rank = 2 +grid_dims = new((/grid_rank/), "integer") +grid_imask = new((/grid_size/), "integer") +lat1D_center = new((/grid_size/),typeof(lat)) +lon1D_center = new((/grid_size/),typeof(lon)) +lat1D_corner = new((/grid_size, grid_corners/),typeof(lat)) +lon1D_corner = new((/grid_size, grid_corners/),typeof(lon)) + +grid_dims(0) = nx-1 +grid_dims(1) = ny-1 + +do iy=0,ny-2 + do ix=0,nx-2 + npt = (iy*(nx-1)) + ix + grid_imask(npt) = 1 + lat1D_center(npt) = 0.25*(lat(0,iy ,ix ) + lat(0,iy+1,ix ) + \ + lat(0,iy ,ix+1) + lat(0,iy+1,ix+1)) + lon1D_center(npt) = 0.25*(lon(0,iy ,ix ) + lon(0,iy+1,ix ) + \ + lon(0,iy ,ix+1) + lon(0,iy+1,ix+1)) + lat1D_corner(npt,0) = lat(0,iy ,ix ) + lat1D_corner(npt,1) = lat(0,iy ,ix+1) + lat1D_corner(npt,2) = lat(0,iy+1,ix+1) + lat1D_corner(npt,3) = lat(0,iy+1,ix ) + lon1D_corner(npt,0) = lon(0,iy ,ix ) + lon1D_corner(npt,1) = lon(0,iy ,ix+1) + lon1D_corner(npt,2) = lon(0,iy+1,ix+1) + lon1D_corner(npt,3) = lon(0,iy+1,ix ) + end do +end do + +; --------------------------------------- +; write out lats and lons in SCRIP format +; --------------------------------------- + +outfile = "gland5km_scrip.nc" +system("/bin/rm -f " + outfile) + +fout1 = addfile(outfile,"c") + +globalAtt = True +globalAtt@title = "Glimmer Greenland 5 km Grid" +globalAtt@history = "GLC_to_SCRIP conversion " + systemfunc("date") +fileattdef( fout1, globalAtt ) + +dimNames = (/"grid_size", "grid_corners", "grid_rank" /) +dimSizes = (/ grid_size , 4, 2 /) +dimUnlim = (/ False , False, False /) +filedimdef(fout1, dimNames , dimSizes, dimUnlim ) + +filevardef (fout1, "grid_dims", "integer", "grid_rank" ) + +filevardef (fout1, "grid_center_lat", typeof(lat1D_center), "grid_size" ) +grid_center_latAtt=0 +grid_center_latAtt@units = "degrees" +filevarattdef(fout1, "grid_center_lat", grid_center_latAtt) + +filevardef (fout1, "grid_center_lon", typeof(lon1D_center), "grid_size") +grid_center_lonAtt=0 +grid_center_lonAtt@units = "degrees" +filevarattdef(fout1, "grid_center_lon", grid_center_lonAtt) + +filevardef (fout1, "grid_imask", "integer", "grid_size") +grid_imaskAtt=0 +grid_imaskAtt@units = "unitless" +filevarattdef(fout1, "grid_imask", grid_imaskAtt) + +filevardef (fout1, "grid_corner_lat", typeof(lat1D_corner), (/ "grid_size", "grid_corners" /)) +grid_corner_latAtt=0 +grid_corner_latAtt@units = "degrees" +filevarattdef(fout1, "grid_corner_lat", grid_corner_latAtt) + +filevardef (fout1, "grid_corner_lon", typeof(lon1D_corner), (/ "grid_size", "grid_corners" /)) +grid_corner_lonAtt=0 +grid_corner_lonAtt@units = "degrees" +filevarattdef(fout1, "grid_corner_lon", grid_corner_lonAtt) + +fout1->grid_dims = (/grid_dims/) +fout1->grid_center_lat = (/lat1D_center/) +fout1->grid_center_lon = (/lon1D_center/) +fout1->grid_imask = (/grid_imask/) +fout1->grid_corner_lat = (/lat1D_corner/) +fout1->grid_corner_lon = (/lon1D_corner/) + +end + diff --git a/components/cism/tools/scrip2CLMoverlap.ncl b/components/cism/tools/scrip2CLMoverlap.ncl new file mode 100644 index 0000000000..e38ac858ae --- /dev/null +++ b/components/cism/tools/scrip2CLMoverlap.ncl @@ -0,0 +1,114 @@ +; *********************************************** +; xy_1.ncl +; *********************************************** +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" +;************************************************ +begin +; ------------------------------------------------------------- +; read in scrip weight file -- +; must contain regrid information from a CLM grid to a GLC grid +; ------------------------------------------------------------- + +infileS = addfile("map_fv0.9x1.25_TO_gland_aave.141105.nc","r") + +; --------------------------------------- +; read in corresponding CLM fracdata file +; --------------------------------------- + +; infileF = addfile ("$CESMDATAROOT/inputdata/lnd/clm2/griddata/fracdata_48x96_gx3v7_c090915.nc","r") +; infileF = addfile ("$CESMDATAROOT/inputdata/lnd/clm2/griddata/fracdata_1.9x2.5_gx1v6_c090206.nc","r") +infileF = addfile ("$CESMDATAROOT/inputdata/lnd/clm2/griddata/fracdata_0.9x1.25_gx1v6_c090317.nc","r") + +; ------------------------------------------------ +; read in necessary information from the two files +; ------------------------------------------------ + +src_grid_dims = infileS->src_grid_dims +nlon_map = src_grid_dims(0) +nlat_map = src_grid_dims(1) +pts_map = infileS->col +dims1D = dimsizes(pts_map) +nwgts = dims1D(0) + +longxy = infileF->LONGXY +latixy = infileF->LATIXY +landmask = infileF->LANDMASK +dims2D = dimsizes(landmask) +nlat_frac = dims2D(0) +nlon_frac = dims2D(1) + +; ---------------------------------------------------------------- +; first order check to make sure the two land grids are consistent +; ---------------------------------------------------------------- + +if (nlat_map .ne. nlat_frac) then + print ("Number of latitudes not the same for both grids. Stopping.") + exit +end if + +if (nlon_map .ne. nlon_frac) then + print ("Number of longitudes not the same for both grids. Stopping.") + exit +end if + +delete(infileS) +delete(infileF) + +; --------------------------------------------------- +; calculate new 2-D array of GLCMASKs on the CLM grid +; --------------------------------------------------- + +glcmask1D = new((/ nlon_map*nlat_map /), "integer") +glcmask2D = new((/ nlat_frac, nlon_frac /), "integer") + +do ij=0,nlat_map*nlon_map-1 + glcmask1D(ij) = 0 +end do + +do ij=0,nwgts-1 + npt = pts_map(ij)-1 + glcmask1D(npt) = 1 +end do + +do j=0,nlon_map-1 + do i=0,nlat_map-1 + ij = (i*nlon_map) + j + glcmask2D(i,j) = 0 + if( (glcmask1D(ij) .eq. 1) ) then + glcmask2D(i,j) = 1 + end if + end do +end do + +; ------------------------------------------ +; write out GLCMASKs to new glcmaskdata file +; ------------------------------------------ + +outfile = "glcmaskdata_0.9x1.25_gland_c141105.nc" +system("/bin/rm -f " + outfile) + +fout1 = addfile(outfile,"c") + +globalAtt = True +globalAtt@title = "GLCMASK file for fv0.9x1.25, for Greenland" +globalAtt@history = "SCRIP to GLCMASK conversion, using models/glc/cism/tools/scrip2CLMoverlap.nc " + systemfunc("date") +fileattdef( fout1, globalAtt ) + +dimNames = (/"lsmlon", "lsmlat" /) +dimSizes = (/ nlon_frac, nlat_frac /) +dimUnlim = (/ False , False /) +filedimdef(fout1, dimNames , dimSizes, dimUnlim ) + +filevardef (fout1, "GLCMASK", "integer", (/ "lsmlat", "lsmlon" /)) +GLCMASKAtt=0 +GLCMASKAtt@longname = "land/glc mask" +GLCMASKAtt@units = "0=no glc source and 1=glc source" +filevarattdef(fout1, "GLCMASK", GLCMASKAtt) + +fout1->LONGXY = longxy +fout1->LATIXY = latixy +fout1->GLCMASK = (/glcmask2D/) + +end diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm new file mode 100755 index 0000000000..d70e50c1b4 --- /dev/null +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -0,0 +1,3463 @@ +#----------------------------------------------------------------------------------------------- +# +# build-namelist +# +# This script builds the namelists for CLM +# +# The simplest use of build-namelist is to execute it from the build directory where configure +# was run. By default it will use the config_cache.xml file that was written by configure to +# determine the build time properties of the executable, and will write the files that contain +# the output namelists in that same directory. But if multiple runs are to made using the +# same executable, successive invocations of build-namelist will overwrite previously generated +# namelist files. So generally the best strategy is to invoke build-namelist from the run +# directory and use the -config option to provide the filepath of the config_cache.xml file. +# +# +# Date Contributor Modification +# ------------------------------------------------------------------------------------------- +# 2009-01-20 Vertenstein Original version +# 2010-04-27 Kluzek Add ndep streams capability +# 2011-07-25 Kluzek Add multiple ensemble's of namelists +# 2012-03-23 Kluzek Add megan namelist and do checking on it +# 2012-07-01 Kluzek Add some common CESM namelist options +# 2013-12 Andre Refactor everything into subroutines +# 2013-12 Muszala Add Ecosystem Demography functionality +#-------------------------------------------------------------------------------------------- + +package CLMBuildNamelist; + +require 5; + +use strict; +#use warnings; +#use diagnostics; + +use Cwd qw(getcwd abs_path); +use File::Basename qw(dirname); +use English; +use Getopt::Long; +use IO::File; +use File::Glob ':glob'; + +#------------------------------------------------------------------------------- +# +# Define a small number of global variables +# +#------------------------------------------------------------------------------- + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; +$ProgName = "CLM " . "$ProgName"; + +my $cwd = abs_path(getcwd()); # absolute path of the current working directory + +my $verbosity = 1; # Define print level +my $print_verbose = 2; + +# Some regular expressions... +###my $TRUE = qr/\.true\./i; +###my $FALSE = qr/\.false\./i; +# **N.B.** the use of qr// for precompiling regexps isn't supported until perl 5.005. +my $TRUE = '\.true\.'; +my $FALSE = '\.false\.'; + +#------------------------------------------------------------------------------- + +sub usage { + die < Glacier number of elevation classes [0 | 3 | 5 | 10 | 36] + (default is 0) (standard option with land-ice model is 10) + -glc_smb Only used if glc_nec > 0 + If .true., pass surface mass balance info to GLC + If .false., pass positive-degree-day info to GLC + Default: true + -help [or -h] Print usage to STDOUT. + -ignore_ic_date Ignore the date on the initial condition files + when determining what input initial condition file to use. + -ignore_ic_year Ignore just the year part of the date on the initial condition files + when determining what input initial condition file to use. + -infile "filepath" Specify a file (or list of files) containing namelists to + read values from. + + If used with a CLM build with multiple ensembles (ninst_lnd>1) + and the filename entered is a directory to files of the + form filepath/filepath and filepath/filepath_\$n where \$n + is the ensemble member number. the "filepath/filepath" + input namelist file is the master input namelist file + that is applied to ALL ensemble members. + + (by default for CESM this is setup for files of the + form \$CASEDIR/user_nl_clm/user_nl_clm_????) + -inputdata "filepath" Writes out a list containing pathnames for required input datasets in + file specified. + -irrig "value" If .true. turn irrigation on with namelist logical irrigate (for CLM4.5 physics) + (requires use_crop to be true in the clm configuration) + Seek surface datasets with irrigation turned on. (for CLM4.0 physics) + Default: .false. + -l_ncpl "LND_NCPL" Number of CLM coupling time-steps in a day. + -mask "landmask" Type of land-mask (default, navy, gx3v5, gx1v5 etc.) + "-mask list" to list valid land masks. + -namelist "namelist" Specify namelist settings directly on the commandline by supplying + a string containing FORTRAN namelist syntax, e.g., + -namelist "&clm_inparm dt=1800 /" + -no-megan DO NOT PRODUCE a megan_emis_nl namelist that will go into the + "drv_flds_in" file for the driver to pass VOCs to the atm. + MEGAN (Model of Emissions of Gases and Aerosols from Nature) + (Note: buildnml copies the file for use by the driver) + -[no-]note Add note to output namelist [do NOT add note] about the + arguments to build-namelist. + -rcp "value" Representative concentration pathway (rcp) to use for + future scenarios. + "-rcp list" to list valid rcp settings. + -s Turns on silent mode - only fatal messages issued. + -test Enable checking that input datasets exist on local filesystem. + -use_case "case" Specify a use case which will provide default values. + "-use_case list" to list valid use-cases. + -verbose [or -v] Turn on verbose echoing of informational messages. + -version Echo the SVN tag name used to check out this CLM distribution. + -vichydro Toggle to turn on VIC hydrologic parameterizations (default is off) + This turns on the namelist variable: use_vichydro + + +Note: The precedence for setting the values of namelist variables is (highest to lowest): + 0. namelist values set by specific command-line options, like, -d, -sim_year + (i.e. compset choice and CLM_BLDNML_OPTS env_run variable) + (NOTE: If you try to contradict these settings by methods below, an error will be triggered) + 1. values set on the command-line using the -namelist option, + (i.e. CLM_NAMELIST_OPTS env_run variable) + 2. values read from the file(s) specified by -infile, + (i.e. user_nl_clm files) + 3. datasets from the -clm_usr_name option, + (i.e. CLM_USRDAT_NAME env_run variable) + 4. values set from a use-case scenario, e.g., -use_case + (i.e. CLM_NML_USE_CASE env_run variable) + 5. values from the namelist defaults file. +EOF +} + +#------------------------------------------------------------------------------- + +sub process_commandline { + # Process command-line options and return the hash + my ($nl_flags) = @_; + + # Save the command line arguments to the script. NOTE: this must be + # before GetOptions() is called because items are removed from from + # the array! + $nl_flags->{'cmdline'} = "@ARGV"; + + my %opts = ( config => "config_cache.xml", + csmdata => undef, + clm_usr_name => undef, + co2_type => undef, + co2_ppmv => undef, + clm_demand => "null", + help => 0, + glc_nec => "default", + glc_present => 0, + glc_smb => "default", + l_ncpl => undef, + lnd_frac => undef, + dir => "$cwd", + rcp => "default", + sim_year => "default", + bgc_spinup => "default", + chk_res => undef, + note => undef, + drydep => 0, + megan => 1, + irrig => "default", + res => "default", + silent => 0, + mask => "default", + test => 0, + bgc => "default", + crop => 0, + dynamic_vegetation => 0, + ed_mode => 0, + envxml_dir => ".", + vichydro => 0, + maxpft => "default", + ); + + GetOptions( + "clm_demand=s" => \$opts{'clm_demand'}, + "co2_ppmv=f" => \$opts{'co2_ppmv'}, + "co2_type=s" => \$opts{'co2_type'}, + "config=s" => \$opts{'config'}, + "csmdata=s" => \$opts{'csmdata'}, + "clm_usr_name=s" => \$opts{'clm_usr_name'}, + "envxml_dir=s" => \$opts{'envxml_dir'}, + "drydep!" => \$opts{'drydep'}, + "chk_res!" => \$opts{'chk_res'}, + "note!" => \$opts{'note'}, + "megan!" => \$opts{'megan'}, + "glc_nec=i" => \$opts{'glc_nec'}, + "glc_present!" => \$opts{'glc_present'}, + "glc_smb=s" => \$opts{'glc_smb'}, + "irrig=s" => \$opts{'irrig'}, + "d:s" => \$opts{'dir'}, + "h|help" => \$opts{'help'}, + "ignore_ic_date" => \$opts{'ignore_ic_date'}, + "ignore_ic_year" => \$opts{'ignore_ic_year'}, + "infile=s" => \$opts{'infile'}, + "lnd_frac=s" => \$opts{'lnd_frac'}, + "l_ncpl=i" => \$opts{'l_ncpl'}, + "inputdata=s" => \$opts{'inputdata'}, + "mask=s" => \$opts{'mask'}, + "namelist=s" => \$opts{'namelist'}, + "res=s" => \$opts{'res'}, + "rcp=s" => \$opts{'rcp'}, + "s|silent" => \$opts{'silent'}, + "sim_year=s" => \$opts{'sim_year'}, + "bgc_spinup=s" => \$opts{'bgc_spinup'}, + "clm_start_type=s" => \$opts{'clm_start_type'}, + "test" => \$opts{'test'}, + "use_case=s" => \$opts{'use_case'}, + "bgc=s" => \$opts{'bgc'}, + "crop" => \$opts{'crop'}, + "dynamic_vegetation" => \$opts{'dynamic_vegetation'}, + "ed_mode" => \$opts{'ed_mode'}, + "vichydro" => \$opts{'vichydro'}, + "maxpft=i" => \$opts{'maxpft'}, + "v|verbose" => \$opts{'verbose'}, + "version" => \$opts{'version'}, + ) or usage(); + + # Give usage message. + usage() if $opts{'help'}; + + # Check for unparsed arguments + if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); + } + return %opts; +} + +#------------------------------------------------------------------------------- + +sub set_print_level { + # Define print levels: + # 0 - only issue fatal error messages + # 1 - only informs what files are created (default) + # 2 - verbose + my %opts = %{shift()}; + if ($opts{'silent'}) { $verbosity = 0; } + if ($opts{'verbose'}) { $verbosity = 2; } +} + +#------------------------------------------------------------------------------- + +sub check_for_perl_utils { + + my $cfgdir = shift; + + # Determine CESM root directory and perl5lib root directory + my $cesmroot = abs_path( "$cfgdir/../../../"); + my $perl5lib_dir = "$cesmroot/cime/utils/perl5lib"; + + # The root diretory for the perl SetupTools.pm module + my $SetupTools_dir = "$cesmroot/cime/scripts/Tools"; + (-f "$SetupTools_dir/SetupTools.pm") or + fatal_error("Cannot find perl module \"SetupTools.pm\" in directory\n" . + "\"$SetupTools_dir\" \n"); + + # The XML::Lite module is required to parse the XML files. + (-f "$perl5lib_dir/XML/Lite.pm") or + fatal_error("Cannot find perl module \"XML/Lite.pm\" in directory\n" . + "\"$perl5lib_dir\""); + + # The Build::Config module provides utilities to access the configuration information + # in the config_cache.xml file + (-f "$perl5lib_dir/Build/Config.pm") or + fatal_error("Cannot find perl module \"Build/Config.pm\" in directory\n" . + "\"$perl5lib_dir\""); + + # The Build::NamelistDefinition module provides utilities to validate that the output + # namelists are consistent with the namelist definition file + (-f "$perl5lib_dir/Build/NamelistDefinition.pm") or + fatal_error("Cannot find perl module \"Build/NamelistDefinition.pm\" in directory\n" . + "\"$perl5lib_dir\""); + + # The Build::NamelistDefaults module provides a utility to obtain default values of namelist + # variables based on finding a best fit with the attributes specified in the defaults file. + (-f "$perl5lib_dir/Build/NamelistDefaults.pm") or + fatal_error("Cannot find perl module \"Build/NamelistDefaults.pm\" in directory\n" . + "\"$perl5lib_dir\""); + + # The Build::Namelist module provides utilities to parse input namelists, to query and modify + # namelists, and to write output namelists. + (-f "$perl5lib_dir/Build/Namelist.pm") or + fatal_error("Cannot find perl module \"Build/Namelist.pm\" in directory\n" . + "\"$perl5lib_dir\""); + + #----------------------------------------------------------------------------- + # Add $perl5lib_dir to the list of paths that Perl searches for modules + my @dirs = ( $ProgDir, $cfgdir, "$perl5lib_dir", "$SetupTools_dir"); + unshift @INC, @dirs; + + # required cesm perl modules + require XML::Lite; + require Build::Config; + require Build::NamelistDefinition; + require Build::NamelistDefaults; + require Build::Namelist; + require config_files::clm_phys_vers; + require SetupTools; +} + +#------------------------------------------------------------------------------- + +sub read_configure_definition { + # Read the configure definition and specific config_cache file for this case + # configure are the build-time settings for CLM + my ($cfgdir, $opts) = @_; + + verbose_message("Setting CLM configuration script directory to $cfgdir"); + + # Create a configuration object from the default config_definition file + my $configfile; + if ( -f $opts->{'config'} ) { + $configfile = $opts->{'config'}; + } else { + $configfile = "$cfgdir/config_files/config_definition.xml"; + } + + # Check that configuration cache file exists. + verbose_message("Using CLM configuration cache file $opts->{'config'}"); + if ( $configfile ne $opts->{'config'} ) { + fatal_error("Cannot find configuration cache file: \"$opts->{'config'}\"\n"); + } + + my $cfg = Build::Config->new("$configfile"); + + return $cfg; +} + +#----------------------------------------------------------------------------------------------- + +sub read_namelist_definition { + my ($drvblddir, $opts, $nl_flags, $physv) = @_; + + # The namelist definition file contains entries for all namelist + # variables that can be output by build-namelist. + my $phys = $physv->as_filename( ); + my @nl_definition_files = ( "$drvblddir/namelist_files/namelist_definition_drv.xml", + "$drvblddir/namelist_files/namelist_definition_modio.xml", + "$nl_flags->{'cfgdir'}/namelist_files/namelist_definition_$phys.xml" ); + foreach my $nl_defin_file ( @nl_definition_files ) { + (-f "$nl_defin_file") or fatal_error("Cannot find namelist definition file \"$nl_defin_file\"\n"); + + verbose_message("Using namelist definition file $nl_defin_file"); + } + + # Create a namelist definition object. This object provides a + # method for verifying that the output namelist variables are in the + # definition file, and are output in the correct namelist groups. + my $definition = Build::NamelistDefinition->new( shift(@nl_definition_files) ); + foreach my $nl_defin_file ( @nl_definition_files ) { + $definition->add( "$nl_defin_file" ); + } + + return $definition; +} + +#----------------------------------------------------------------------------------------------- + +sub read_envxml_case_files { + # read the contents of the env*.xml files in the case directory + my ($opts) = @_; + + my %envxml = (); + if ( defined($opts->{'envxml_dir'}) ) { + (-d $opts->{'envxml_dir'}) or fatal_error( "envxml_dir is not a directory" ); + my @files = glob( $opts->{'envxml_dir'}."/env_*xml" ); + ($#files >= 0) or fatal_error( "there are no env_*xml files in the envxml_dir" ); + foreach my $file (@files) { + verbose_message( "Open env.xml file: $file" ); + my $xml = XML::Lite->new( "$file" ); + my @e = $xml->elements_by_name('entry'); + while ( my $e = shift @e ) { + my %a = $e->get_attributes(); + $envxml{$a{'id'}} = $a{'value'}; + } + } + foreach my $attr (keys %envxml) { + if ( $envxml{$attr} =~ m/\$/ ) { + $envxml{$attr} = SetupTools::expand_xml_var( $envxml{$attr}, \%envxml ); + } + } + } else { + fatal_error( "The -envxml_dir option was NOT given and it is a REQUIRED option" ); + } + return( %envxml ); +} + +#----------------------------------------------------------------------------------------------- + +sub read_namelist_defaults { + my ($drvblddir, $opts, $nl_flags, $cfg, $physv) = @_; + + my $phys = $physv->as_filename( ); + # The namelist defaults file contains default values for all required namelist variables. + my @nl_defaults_files = ( "$nl_flags->{'cfgdir'}/namelist_files/namelist_defaults_overall.xml", + "$nl_flags->{'cfgdir'}/namelist_files/namelist_defaults_$phys.xml", + "$drvblddir/namelist_files/namelist_defaults_drv.xml", + "$nl_flags->{'cfgdir'}/namelist_files/namelist_defaults_drydep.xml" ); + + # Add the location of the use case defaults files to the options hash + $opts->{'use_case_dir'} = "$nl_flags->{'cfgdir'}/namelist_files/use_cases"; + + if (defined $opts->{'use_case'}) { + if ( $opts->{'use_case'} ne "list" ) { + unshift( @nl_defaults_files, "$opts->{'use_case_dir'}/$opts->{'use_case'}.xml" ); + } + } + + foreach my $nl_defaults_file ( @nl_defaults_files ) { + (-f "$nl_defaults_file") or fatal_error("Cannot find namelist defaults file \"$nl_defaults_file\"\n"); + + verbose_message("Using namelist defaults file $nl_defaults_file"); + } + + # Create a namelist defaults object. This object provides default + # values for variables contained in the input defaults file. The + # configuration object provides attribute values that are relevent + # for the CLM executable for which the namelist is being produced. + my $defaults = Build::NamelistDefaults->new( shift( @nl_defaults_files ), $cfg); + foreach my $nl_defaults_file ( @nl_defaults_files ) { + $defaults->add( "$nl_defaults_file" ); + } + return $defaults; +} + +#------------------------------------------------------------------------------- + +sub check_cesm_inputdata { + # Check that the CESM inputdata root directory has been specified. This must be + # a local or nfs mounted directory. + + my ($opts, $nl_flags) = @_; + + $nl_flags->{'inputdata_rootdir'} = undef; + if (defined($opts->{'csmdata'})) { + $nl_flags->{'inputdata_rootdir'} = $opts->{'csmdata'}; + } + elsif (defined $ENV{'CSMDATA'}) { + $nl_flags->{'inputdata_rootdir'} = $ENV{'CSMDATA'}; + } + else { + fatal_error("CESM inputdata root directory must be specified by either -csmdata\n" . + "argument or by the CSMDATA environment variable.\n"); + } + if ( ! defined($ENV{'DIN_LOC_ROOT'}) ) { + $ENV{'DIN_LOC_ROOT'} = $nl_flags->{'inputdata_rootdir'}; + } + + if ($opts->{'test'}) { + (-d $nl_flags->{'inputdata_rootdir'}) or fatal_error("CESM inputdata root is not a directory: \"$nl_flags->{'inputdata_rootdir'}\"\n"); + } + + verbose_message("CESM inputdata root directory: $nl_flags->{'inputdata_rootdir'}"); +} + +#------------------------------------------------------------------------------- + +sub process_namelist_user_input { + # Process the user input in general by order of precedence. At each point + # we'll only add new values to the namelist and not overwrite + # previously specified specified values which have higher + # precedence. The one exception to this rule are the specifc command-line + # options which are done last as if the user contradicts these settings + # CLM build-namelist will abort with an error. + # + # 1. values set on the command-line using the -namelist option, + # (i.e. CLM_NAMELIST_OPTS env_run variable) + # 2. values read from the file(s) specified by -infile, + # (i.e. user_nl_clm files) + # After the above are done the command line options are processed and they + # are made sure the user hasn't contradicted any of their settings with + # anything above. Because of this they are condsidered to have the highest + # precedence. + # 0. namelist values set by specific command-line options, like, -d, -sim_year + # (i.e. CLM_BLDNML_OPTS env_run variable) + # The results of these are needed for the final two user input + # 3. datasets from the -clm_usr_name option, + # (i.e. CLM_USRDAT_NAME env_run variable) + # 4. values set from a use-case scenario, e.g., -use_case + # (i.e. CLM_NML_USE_CASE env_run variable) + # + # Finally after all the above is done, the defaults are found from the + # namelist defaults file (outside of this routine). + # + + + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_; + + # Get the inputs that will be coming from the user... + process_namelist_commandline_namelist($opts, $definition, $nl, $envxml_ref); + process_namelist_commandline_infile($opts, $definition, $nl, $envxml_ref); + + # Apply the commandline options and make sure the user didn't change it above + process_namelist_commandline_options($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv); + + # The last two process command line arguments for usr_name and use_case + # They require that process_namelist_commandline_options was called before this + process_namelist_commandline_clm_usr_name($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref); + process_namelist_commandline_use_case($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv); + + # Set the start_type by the command line setting for clm_start_type + process_namelist_commandline_clm_start_type($opts->{'test'}, $nl_flags, $definition, $defaults, $nl); + +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_options { + # First process the commandline args that provide specific namelist values. + # + # First get the command-line specified overall values or their defaults + # Obtain default values for the following build-namelist input arguments + # : res, mask, rcp, sim_year, sim_year_range, and bgc_spinup. + # + # NOTE: cfg only needs to be passed to functions that work with + # clm4_0 compile time functionality! + + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_; + + setup_cmdl_chk_res($opts, $defaults); + setup_cmdl_resolution($opts, $nl_flags, $definition, $defaults); + setup_cmdl_mask($opts, $nl_flags, $definition, $defaults, $nl); + setup_cmdl_bgc($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv); + setup_cmdl_crop($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv); + setup_cmdl_maxpft($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv); + setup_cmdl_glc_nec($opts, $nl_flags, $definition, $defaults, $nl); + setup_cmdl_irrigation($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_cmdl_rcp($opts, $nl_flags, $definition, $defaults, $nl); + setup_cmdl_bgc_spinup($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv); + setup_cmdl_simulation_year($opts, $nl_flags, $definition, $defaults, $nl); + setup_cmdl_run_type($opts, $nl_flags, $definition, $defaults, $nl); + setup_cmdl_dynamic_vegetation($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_cmdl_ed_mode($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_cmdl_vichydro($opts, $nl_flags, $definition, $defaults, $nl, $physv); +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_chk_res { + my ($opts, $defaults) = @_; + + my $var = "chk_res"; + if ( ! defined($opts->{$var}) ) { + $opts->{$var} = $defaults->get_value($var); + } +} + +sub setup_cmdl_resolution { + my ($opts, $nl_flags, $definition, $defaults) = @_; + + my $var = "res"; + my $val; + + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + $val= $defaults->get_value($var); + } + + $nl_flags->{'res'} = $val; + verbose_message("CLM atm resolution is $nl_flags->{'res'}"); + $opts->{$var} = $val; + if ( $opts->{'chk_res'} ) { + $val = "e_string( $nl_flags->{'res'} ); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + if ( ! defined($opts->{'clm_usr_name'}) || $nl_flags->{'res'} ne $opts->{'clm_usr_name'} ) { + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_mask { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + my $var = "mask"; + my $val; + + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + my %tmp = ( 'hgrid'=>$nl_flags->{'res'} ); + $val = $defaults->get_value($var, \%tmp ); + } + + $nl_flags->{'mask'} = $val; + $opts->{'mask'} = $nl_flags->{'mask'}; + if ( $opts->{'chk_res'} ) { + $val = "e_string( $val ); + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } + verbose_message("CLM land mask is $nl_flags->{'mask'}"); +} + +#------------------------------------------------------------------------------- +sub setup_cmdl_ed_mode { + # + # call this at least after crop check is called + # + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $val; + my $var = "ed_mode"; + + $val = $opts->{$var}; + $nl_flags->{'ed_mode'} = $val; + + if ( $physv->as_long() == $physv->as_long("clm4_0") || $nl_flags->{'crop'} eq "on" ) { + if ( $nl_flags->{'ed_mode'} == 1 ) { + # ED is not a clm4_0 option and should not be used with crop and not with clm4_0 + fatal_error("** Cannot turn ed mode on with crop or with clm4_0 physics.\n" ); + } + } else { + + $var = "use_ed"; + $nl_flags->{$var} = ".false."; + if ($nl_flags->{'ed_mode'} eq 1) { + message("Using ED (Ecosystem Demography)."); + $val = ".true."; + $nl_flags->{$var} = $val; + } + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -ed_mode"); + } + if ( $nl_flags->{$var} eq ".true." ) { + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + + $var = "use_ed_spit_fire"; + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value($var, $val) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } else { + $var = "use_ed_spit_fire"; + if ( defined($nl->get_value($var)) ) { + fatal_error("$var is being set, but can ONLY be set when -ed_mode option is used.\n"); + } + } + } +} + +#------------------------------------------------------------------------------- +sub setup_cmdl_bgc { + # BGC - alias for group of biogeochemistry related use_XXX namelists + + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_; + + my $val; + my $var = "bgc"; + + $val = $opts->{$var}; + $nl_flags->{'bgc_mode'} = $val; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + if ( $nl_flags->{'bgc_mode'} ne "default" ) { + fatal_error("-bgc option used with clm4_0 physics. -bgc can ONLY be used with clm4_5/clm5_0 physics"); + } + $nl_flags->{'bgc_mode'} = $cfg->get($var); + } else { + my $var = "bgc_mode"; + if ( $nl_flags->{$var} eq "default" ) { + $nl_flags->{$var} = $defaults->get_value($var); + } + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, quote_string( $nl_flags->{$var} ) ); + if ( ! $definition->is_valid_value( $var, quote_string( $nl_flags->{$var}) ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value (".$nl_flags->{$var}.") that is NOT valid. Valid values are: @valid_values\n"); + } + verbose_message("Using $nl_flags->{$var} for bgc."); + + # now set the actual name list variables based on the bgc alias + my $setting = ".false."; + if ($nl_flags->{$var} eq "cn") { + $nl_flags->{'use_cn'} = ".true."; + } elsif ($nl_flags->{$var} eq "bgc") { + $nl_flags->{'use_cn'} = ".true."; + $setting = ".true."; + } else { + $nl_flags->{'use_cn'} = ".false."; + } + if ( defined($nl->get_value("use_cn")) && ($nl_flags->{'use_cn'} ne $nl->get_value("use_cn")) ) { + fatal_error("The namelist variable use_cn is inconsistent with the -bgc option"); + } + # If the variable has already been set use it, if not set to the value defined by the bgc_mode + my @list = ( "use_lch4", "use_nitrif_denitrif", "use_vertsoilc", "use_century_decomp" ); + my $ndiff = 0; + foreach my $var ( @list ) { + if ( ! defined($nl->get_value($var)) ) { + $nl_flags->{$var} = $setting; + } else { + if ( $nl->get_value($var) ne $setting ) { + $ndiff += 1; + } + $nl_flags->{$var} = $nl->get_value($var); + } + $val = $nl_flags->{$var}; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } + # If all the variables are different report it as an error + if ( $ndiff == ($#list + 1) ) { + fatal_error("You are contradicting the -bgc setting with the namelist variables: @list" ); + } + + # Now set use_cn + $var = "use_cn"; + $val = $nl_flags->{'use_cn'}; + $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } +} # end bgc + +#------------------------------------------------------------------------------- + +sub setup_cmdl_crop { + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_; + + $nl_flags->{'use_crop'} = ".false."; + my $val; + my $var = "crop"; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + $nl_flags->{'crop'} = $cfg->get($var); + if ( $nl_flags->{'crop'} eq "on" ) { + $nl_flags->{'use_crop'} = ".true."; + } + } else { + $val = $opts->{$var}; + $nl_flags->{'crop'} = $val; + if ( $nl_flags->{'crop'} eq 1 ) { + $nl_flags->{'use_crop'} = ".true."; + } + if ( defined($nl->get_value("use_crop")) && ($nl_flags->{'use_crop'} ne $nl->get_value("use_crop")) ) { + fatal_error("Namelist item use_crop contradicts the command-line option -crop, use the command line option"); + } + if ( ($nl_flags->{'crop'} eq 1 ) && ($nl_flags->{'bgc_mode'} eq "sp") ) { + fatal_error("** Cannot turn crop mode on mode bgc=sp\n" . + "**\n" . + "** Set the bgc mode to 'cn' or 'bgc' by the following means from highest to lowest precedence:\n" . + "** * by the command-line options -bgc cn\n" . + "** * by a default configuration file, specified by -defaults\n"); + } + + $var = "use_crop"; + $val = ".false."; + if ($nl_flags->{'crop'} eq 1) { + $val = ".true."; + } + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_maxpft { + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_; + + my $val; + my $var = "maxpft"; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + $nl_flags->{'maxpft'} = $cfg->get($var); + # NOTE: maxpatchpft sizes already checked for clm4_0 by configure. + } else { + my %maxpatchpft; + $maxpatchpft{'.true.'} = 79; + $maxpatchpft{'.false.'} = 17; + if ( $opts->{$var} ne "default") { + $val = $opts->{$var}; + } else { + $val = $maxpatchpft{$nl_flags->{'use_crop'}}; + } + $nl_flags->{'maxpft'} = $val; + + if ( ($nl_flags->{'bgc_mode'} ne "sp") && ($nl_flags->{'maxpft'} != $maxpatchpft{$nl_flags->{'use_crop'}}) ) { + fatal_error("** For CN or BGC mode you MUST set max patch PFT's to $maxpatchpft{$nl_flags->{'use_crop'}}\n" . + "**\n" . + "** When the crop model is on then it must be set to $maxpatchpft{'crop'} otherwise to $maxpatchpft{'nocrop'}\n" . + "** Set the bgc mode, crop and maxpft by the following means from highest to lowest precedence:\n" . + "** * by the command-line options -bgc, -crop and -maxpft\n" . + "** * by a default configuration file, specified by -defaults\n" . + "**\n"); + } + if ( $nl_flags->{'maxpft'} > $maxpatchpft{$nl_flags->{'use_crop'}} ) { + fatal_error("** Max patch PFT's can NOT exceed $maxpatchpft{$nl_flags->{'use_crop'}}\n" . + "**\n" . + "** Set maxpft by the following means from highest to lowest precedence:\n" . + "** * by the command-line options -maxpft\n" . + "** * by a default configuration file, specified by -defaults\n" . + "**\n"); + } + if ( $nl_flags->{'maxpft'} != $maxpatchpft{$nl_flags->{'use_crop'}} ) { + warning("running with maxpft NOT equal to $maxpatchpft{$nl_flags->{'use_crop'}} is " . + "NOT validated / scientifically supported.\n"); + } + verbose_message("Using $nl_flags->{'maxpft'} for maxpft."); + + $var = "maxpatch_pft"; + $val = $nl_flags->{'maxpft'}; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_glc_nec { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + my $val; + my $var = "glc_nec"; + + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + $val = $defaults->get_value($var); + } + + $nl_flags->{'glc_nec'} = $val; + $opts->{'glc_nec'} = $val; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + verbose_message("Glacier number of elevation classes is $val"); +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_irrigation { + # Must be after setup_cmdl_crop + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $var = "irrig"; + + if ( $opts->{$var} eq "default" ) { + $nl_flags->{$var} = $defaults->get_value($var); + } else { + $nl_flags->{$var} = $opts->{$var}; + } + my $val = $nl_flags->{$var}; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + verbose_message("Irrigation $val"); + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + if ( $nl_flags->{'irrig'} =~ /$TRUE/i && $nl_flags->{'use_crop'} eq ".true." ) { + fatal_error("You've turned on both irrigation and crop.\n" . + "Irrigation is only applied to generic crop currently,\n" . + "which negates it's practical usage.\n." . + "We also have a known problem when both are on " . + "(see bug 1326 in the components/clm/doc/KnownBugs file)\n" . + "both irrigation and crop can NOT be on.\n"); + } + } else { + if ( $nl_flags->{'irrig'} =~ /$TRUE/i && $nl_flags->{'use_crop'} =~ /$FALSE/i ) { + fatal_error("The -irrig=.true. option requires -crop"); + } + if ( defined($nl->get_value("irrigate")) && $nl->get_value("irrigate") ne $nl_flags->{'irrig'} ) { + my $irrigate = $nl->get_value("irrigate"); + fatal_error("The namelist value 'irrigate=$irrigate' contradicts the command line option '-irrig=$val'"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_rcp { + # representative concentration pathway + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + my $val; + my $var = "rcp"; + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + $val = $defaults->get_value($var); + } + $nl_flags->{'rcp'} = $val; + $opts->{'rcp'} = $nl_flags->{'rcp'}; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + verbose_message("CLM future scenario representative concentration is $nl_flags->{'rcp'}"); +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_bgc_spinup { + # CLM 4.0 --> spinup mode controlled from "spinup" in configure + # CLM 4.5 --> spinup mode controlled from "bgc_spinup" in build-namelist + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $physv) = @_; + + my $val; + my $var; + $nl_flags->{'spinup'} = undef; + $nl_flags->{'bgc_spinup'} = undef; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + $nl_flags->{'spinup'} = $cfg->get('spinup'); + if ($opts->{"bgc_spinup"} ne "default") { + fatal_error("bgc_spinup can not be controlled from the namelist in CLM 4.0. Try configure using CLM_CONFIG_OPTS (-spinup)."); + } + } elsif ( $physv->as_long() >= $physv->as_long("clm4_5")) { + $var = "bgc_spinup"; + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + $val = $defaults->get_value($var); + } + $nl_flags->{$var} = $val; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, quote_string($val) ); + if ( ! $definition->is_valid_value( $var, $val , 'noquotes' => 1) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has an invalid value ($val). Valid values are: @valid_values\n"); + } + if ( $nl_flags->{'bgc_spinup'} eq "on" && $nl_flags->{'use_cn'} ne ".true.") { + fatal_error("$var can not be '$nl_flags->{'bgc_spinup'}' if CN is turned off (use_cn=$nl_flags->{'use_cn'})."); + } + if ( $nl->get_value("spinup_state") eq 0 && $nl_flags->{'bgc_spinup'} eq "on" ) { + fatal_error("Namelist spinup_state contradicts the command line option bgc_spinup" ); + } + if ( $nl->get_value("spinup_state") eq 1 && $nl_flags->{'bgc_spinup'} eq "off" ) { + fatal_error("Namelist spinup_state contradicts the command line option bgc_spinup" ); + } + } + + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + $val = $nl_flags->{'spinup'}; + } else { + $val = $nl_flags->{'bgc_spinup'}; + } + verbose_message("CLM CN bgc_spinup mode is $val"); +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_simulation_year { + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg) = @_; + + my $val; + my $var = "sim_year"; + if ( $opts->{$var} ne "default" ) { + $val = $opts->{$var}; + } else { + $val = $defaults->get_value($var); + } + + $nl_flags->{'sim_year_range'} = $defaults->get_value("sim_year_range"); + $nl_flags->{'sim_year'} = $val; + if ( $val =~ /([0-9]+)-([0-9]+)/ ) { + $nl_flags->{'sim_year'} = $1; + $nl_flags->{'sim_year_range'} = $val; + } + $val = $nl_flags->{'sim_year'}; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val ); + if ( ! $definition->is_valid_value( $var, $val, 'noquotes'=>1 ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var of $val is NOT valid. Valid values are: @valid_values\n"); + } + $nl->set_variable_value($group, $var, $val ); + verbose_message("CLM sim_year is $nl_flags->{'sim_year'}"); + + $var = "sim_year_range"; + $val = $nl_flags->{'sim_year_range'}; + if ( $val ne "constant" ) { + $opts->{$var} = $val; + $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val ); + if ( ! $definition->is_valid_value( $var, $val, 'noquotes'=>1 ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var of $val is NOT valid. Valid values are: @valid_values\n"); + } + $val = "'".$defaults->get_value($var)."'"; + $nl->set_variable_value($group, $var, $val ); + verbose_message("CLM sim_year_range is $nl_flags->{'sim_year_range'}"); + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_run_type { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + my $val; + my $var = "clm_start_type"; + if (defined $opts->{$var}) { + if ($opts->{$var} eq "default" ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var ); + } else { + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, quote_string( $opts->{$var} ) ); + } + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var ); + } + $nl_flags->{'clm_start_type'} = $nl->get_value($var); +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_dynamic_vegetation { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $val; + my $var = "dynamic_vegetation"; + $val = $opts->{$var}; + $nl_flags->{'dynamic_vegetation'} = $val; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + # not applicable + if ( $nl_flags->{'dynamic_vegetation'}eq 1) { + fatal_error("** Turn dynamic_vegetation mode on with CLM_CONFIG_OPTS (-bgc cndv) for clm4_0 physics.\n" ); + } + } else { + if ( ($nl_flags->{'dynamic_vegetation'} eq 1 ) && ($nl_flags->{'bgc_mode'} eq "sp") ) { + fatal_error("** Cannot turn dynamic_vegetation mode on with bgc=sp.\n" . + "**\n" . + "** Set the bgc mode to 'cn' or 'bgc' by the following means from highest to lowest precedence:\n" . + "** * by the command-line options -bgc cn\n"); + } + + $var = "use_cndv"; + $nl_flags->{$var} = ".false."; + if ($nl_flags->{'dynamic_vegetation'} eq 1) { + $val = ".true."; + $nl_flags->{$var} = $val; + } + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -dynamic_vegetation"); + } + if ( $nl_flags->{$var} eq ".true." ) { + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_cmdl_vichydro { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $val; + my $var = "vichydro"; + $val = $opts->{$var}; + $nl_flags->{'vichydro'} = $val; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + # not relevant in clm4_0 + if ( $nl_flags->{'vichydro'}eq 1) { + fatal_error("** Cannot turn vichydro on with clm4_0 physics.\n" ); + } + } else { + if ($nl_flags->{'vichydro'} eq 1) { + message("Using VIC hydrology for runoff calculations."); + } + + $var = "use_vichydro"; + $val = $nl->get_value($var); + if ($nl_flags->{'vichydro'} eq 1) { + my $group = $definition->get_group_name($var); + my $set = ".true."; + if ( defined($val) && $set ne $val ) { + fatal_error("$var contradicts the command-line -vichydro option" ); + } + $nl->set_variable_value($group, $var, $set); + if ( ! $definition->is_valid_value($var, $val) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_namelist { + # Process the commandline '-namelist' arg. + my ($opts, $definition, $nl, $envxml_ref) = @_; + + if (defined $opts->{'namelist'}) { + # Parse commandline namelist + my $nl_arg = Build::Namelist->new($opts->{'namelist'}); + + # Validate input namelist -- trap exceptions + my $nl_arg_valid; + eval { $nl_arg_valid = $definition->validate($nl_arg); }; + if ($@) { + fatal_error("Invalid namelist variable in commandline arg '-namelist'.\n $@"); + } + # Go through all variables and expand any XML env settings in them + expand_xml_variables_in_namelist( $nl_arg_valid, $envxml_ref ); + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_arg_valid); + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_infile { + # Process the commandline '-infile' arg. + my ($opts, $definition, $nl, $envxml_ref) = @_; + + if (defined $opts->{'infile'}) { + my @infiles = split( /,/, $opts->{'infile'} ); + foreach my $infile ( @infiles ) { + # Make sure a valid file was found + if ( -f "$infile" ) { + # Otherwise abort as a valid file doesn't exist + } else { + fatal_error("input namelist file does NOT exist $infile.\n $@"); + } + # Parse namelist input from the next file + my $nl_infile = Build::Namelist->new($infile); + + # Validate input namelist -- trap exceptions + my $nl_infile_valid; + eval { $nl_infile_valid = $definition->validate($nl_infile); }; + if ($@) { + fatal_error("Invalid namelist variable in '-infile' $infile.\n $@"); + } + # Go through all variables and expand any XML env settings in them + expand_xml_variables_in_namelist( $nl_infile_valid, $envxml_ref ); + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_infile_valid); + } + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_clm_usr_name { + # Process the -clm_usr_name argument + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref) = @_; + + if (defined $opts->{'clm_usr_name'}) { + # The user files definition is contained in an xml file with the same format as the defaults file. + + # The one difference is that variables are expanded. + # Create a new NamelistDefaults object. + my $nl_defaults_file = "$nl_flags->{'cfgdir'}/namelist_files/namelist_defaults_usr_files.xml"; + my $uf_defaults = Build::NamelistDefaults->new("$nl_defaults_file", $cfg ); + # Loop over the variables specified in the user files + # Add each one to the namelist. + my @vars = $uf_defaults->get_variable_names(); + my %settings; + $settings{'mask'} = $nl_flags->{'mask'}; + $settings{'sim_year'} = $nl_flags->{'sim_year'}; + $settings{'rcp'} = $nl_flags->{'rcp'}; + $settings{'sim_year_range'} = $nl_flags->{'sim_year_range'}; + $settings{'bgc_spinup'} = $nl_flags->{'bgc_spinup'}; + $settings{'clm_usr_name'} = $opts->{'clm_usr_name'}; + + if ( $nl_flags->{'inputdata_rootdir'} eq "\$DIN_LOC_ROOT" ) { + $settings{'csmdata'} = $ENV{'DIN_LOC_ROOT'}; + } else { + $settings{'csmdata'} = $nl_flags->{'inputdata_rootdir'}; + } + + my $nvars = 0; + my $nl_usrfile = Build::Namelist->new(); + foreach my $var (@vars) { + my $val = $uf_defaults->get_usr_file($var, $definition, \%settings); + + if ($val) { + message("adding clm user file defaults for var $var with val $val"); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl_usrfile, $var, 'val'=>$val); + $nvars++; + } + } + if ( $nvars == 0 ) { + warning("setting clm_usr_name -- but did NOT find any user datasets: $opts->{'clm_usr_name'}\n"); + } + # 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 + # and are not overwritten. + $nl->merge_nl($nl_usrfile); + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_use_case { + # Now process the -use_case arg. + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_; + + if (defined $opts->{'use_case'}) { + + # The use case definition is contained in an xml file with the same format as the defaults file. + # Create a new NamelistDefaults object. + my $uc_defaults = Build::NamelistDefaults->new("$opts->{'use_case_dir'}/$opts->{'use_case'}.xml", $cfg); + + my %settings; + $settings{'res'} = $nl_flags->{'res'}; + $settings{'rcp'} = $nl_flags->{'rcp'}; + $settings{'mask'} = $nl_flags->{'mask'}; + $settings{'sim_year'} = $nl_flags->{'sim_year'}; + $settings{'sim_year_range'} = $nl_flags->{'sim_year_range'}; + $settings{'phys'} = $nl_flags->{'phys'}; + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + $settings{'use_cn'} = $nl_flags->{'use_cn'}; + } else { + $settings{'bgc'} = $nl_flags->{'bgc_mode'}; + } + # Loop over the variables specified in the use case. + # Add each one to the namelist. + my @vars = $uc_defaults->get_variable_names(); + my $nl_usecase = Build::Namelist->new(); + foreach my $var (@vars) { + my $val = $uc_defaults->get_value($var, \%settings ); + + if ( defined($val) ) { + message("CLM adding use_case $opts->{'use_case'} defaults for var '$var' with val '$val'"); + + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl_usecase, $var, 'val'=>$val); + } + } + # Go through all variables and expand any XML env settings in them + expand_xml_variables_in_namelist( $nl_usecase, $envxml_ref ); + + # Merge input values into namelist. Previously specified values have higher precedence + # and are not overwritten. + $nl->merge_nl($nl_usecase); + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_commandline_clm_start_type { + # Set the start_type according to the command line clm_start_type option + + my ($test_files, $nl_flags, $definition, $defaults, $nl) = @_; + + # Run type for driver namelist - note that arb_ic implies that the run is startup + my $var = "start_type"; + if ($nl_flags->{'clm_start_type'} eq "'cold'" || $nl_flags->{'clm_start_type'} eq "'arb_ic'") { + # Add default is used here, but the value is explicitly set + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>'startup' ); + } else { + # Add default is used here, but the value is explicitly set + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$nl_flags->{'clm_start_type'} ); + } +} + +#------------------------------------------------------------------------------- + +sub process_namelist_inline_logic { + # Use the namelist default object to add default values for required + # namelist variables that have not been previously set. + my ($opts, $nl_flags, $definition, $defaults, $nl, $cfg, $envxml_ref, $physv) = @_; + + ############################## + # namelist group: clm_inparm # + ############################## + setup_logic_site_specific($nl_flags, $definition, $nl, $physv); + setup_logic_lnd_frac($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref); + setup_logic_co2_type($opts, $nl_flags, $definition, $defaults, $nl); + setup_logic_irrigate($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_start_type($nl_flags, $nl); + setup_logic_delta_time($opts, $nl_flags, $definition, $defaults, $nl); + setup_logic_decomp_performance($opts->{'test'}, $nl_flags, $definition, $defaults, $nl); + setup_logic_snow($opts->{'test_files'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_glacier($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref, $physv); + setup_logic_dynamic_plant_nitrogen_alloc($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_luna($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_params_file($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_create_crop_landunit($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_soilstate($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_demand($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_surface_dataset($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_initial_conditions($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_dynamic_subgrid($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_bgc_spinup($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_supplemental_nitrogen($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_snowpack($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_atm_forcing($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ######################################### + # namelist group: clm_humanindex_inparm # + ######################################### + setup_logic_humanindex($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ####################################################################### + # namelist groups: clm_hydrology1_inparm and clm_soilhydrology_inparm # + ####################################################################### + setup_logic_hydrology_switches($nl); + + ############################### + # namelist group: clmu_inparm # + ############################### + setup_logic_urban($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ############################### + # namelist group: ch4par_in # + ############################### + setup_logic_methane($opts->{'test'}, $nl_flags, $definition, $defaults, $nl); + setup_logic_c_isotope($nl_flags, $definition, $defaults, $nl); + + ############################### + # namelist group: ndepdyn_nml # + ############################### + setup_logic_nitrogen_deposition($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ################################# + # namelist group: popd_streams # + ################################# + setup_logic_popd_streams($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ################################## + # namelist group: light_streams # + ################################## + setup_logic_lightning_streams($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); + + ################################# + # namelist group: drydep_inparm # + ################################# + setup_logic_dry_deposition($opts, $nl_flags, $definition, $defaults, $nl); + + ################################# + # namelist group: megan_emis_nl # + ################################# + setup_logic_megan($opts, $nl_flags, $definition, $defaults, $nl); + + ################################## + # namelist group: lai_streams # + ################################## + setup_logic_lai_streams($opts->{'test'}, $nl_flags, $definition, $defaults, $nl, $physv); +} + +#------------------------------------------------------------------------------- + +sub setup_logic_site_specific { + # site specific requirements + my ($nl_flags, $definition, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + # res check prevents polluting the namelist with an unnecessary + # false variable for every run + if ($nl_flags->{'res'} eq "1x1_vancouverCAN") { + my $var = "use_vancouver"; + my $val = ".true."; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + } + } + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + # res check prevents polluting the namelist with an unnecessary + # false variable for every run + if ($nl_flags->{'res'} eq "1x1_mexicocityMEX") { + my $var = "use_mexicocity"; + my $val = ".true."; + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + } + } + + if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'res'} eq "1x1_smallvilleIA") { + if ($nl_flags->{'use_cn'} ne ".true." || $nl_flags->{'use_crop'} ne ".true.") { + fatal_error("1x1_smallvilleIA grids must use a compset with CN and CROP turned on.\n"); + } + } + + if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'res'} eq "1x1_numaIA") { + if ($nl_flags->{'use_cn'} ne ".true." || $nl_flags->{'use_crop'} ne ".true.") { + fatal_error("1x1_numaIA grids must use a compset with CN and CROP turned on.\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_lnd_frac { + + my ($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref) = @_; + + my $var = "lnd_frac"; + if ( defined($opts->{$var}) ) { + if ( defined($nl->get_value('fatmlndfrc')) ) { + fatal_error("Can NOT set both -lnd_frac option (set via LND_DOMAIN_PATH/LND_DOMAIN_FILE " . + "env variables) AND fatmlndfrac on namelist\n"); + } + my $lnd_frac = SetupTools::expand_xml_var( $opts->{$var}, $envxml_ref); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fatmlndfrc','val'=>$lnd_frac ); + } + + # Get the fraction file + if (defined $nl->get_value('fatmlndfrc')) { + # do nothing - use value provided by config_grid.xml and clm.cpl7.template + } else { + fatal_error("fatmlndfrc was NOT sent into CLM build-namelist.\n"); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_co2_type { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + my $var = "co2_type"; + if ( defined($opts->{$var}) ) { + if ( ! defined($nl->get_value($var)) ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'co2_type','val'=>"$opts->{'co2_type'}"); + } else { + fatal_error("co2_type set on namelist as well as -co2_type option.\n"); + } + } + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'co2_type'); + if ( $nl->get_value('co2_type') =~ /constant/ ) { + my $var = 'co2_ppmv'; + if ( defined($opts->{$var}) ) { + if ( $opts->{$var} <= 0.0 ) { + fatal_error("co2_ppmv can NOT be less than or equal to zero."); + } + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $opts->{$var}); + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'sim_year'=>$nl_flags->{'sim_year'} ); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_irrigate { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + if ( $nl_flags->{'use_crop'} eq ".true." ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'irrigate', 'val'=>$nl_flags->{'irrig'}); + } + elsif ( defined($nl->get_value('irrigate')) ) { + if ($nl->get_value('irrigate') =~ /$TRUE/i ) { + fatal_error("irrigate TRUE needs crop TRUE but it is not\n"); + } + } + $nl_flags->{'irrigate'} = lc($nl->get_value('irrigate')); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_start_type { + my ($nl_flags, $nl) = @_; + + my $var = "start_type"; + my $drv_start_type = $nl->get_value($var); + my $my_start_type = $nl_flags->{'clm_start_type'}; + my $nsrest = $nl->get_value('override_nsrest'); + + if ( defined($nsrest) ) { + if ( $nsrest == 0 ) { $my_start_type = "startup"; } + if ( $nsrest == 1 ) { $my_start_type = "continue"; } + if ( $nsrest == 3 ) { $my_start_type = "branch"; } + if ( "$my_start_type" eq "$drv_start_type" ) { + fatal_error("no need to set override_nsrest to same as start_type.\n"); + } + if ( "$drv_start_type" !~ /startup/ ) { + fatal_error("can NOT set override_nsrest if driver is NOT a startup type.\n"); + } + } + + if ( $my_start_type =~ /branch/ ) { + if (not defined $nl->get_value('nrevsn')) { + fatal_error("nrevsn is required for a branch type.\n"); + } + } else { + if (defined $nl->get_value('nrevsn')) { + fatal_error("nrevsn should ONLY be set for a branch type.\n"); + } + } +} + +#------------------------------------------------------------------------------- + +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 ) { + fatal_error("bad value for -l_ncpl option.\n"); + } + my $val = ( 3600 * 24 ) / $l_ncpl; + my $dtime = $nl->get_value('dtime'); + if ( ! defined($dtime) ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'val'=>$val); + } elsif ( $dtime ne $val ) { + fatal_error("can NOT set both -l_ncpl option (via LND_NCPL env variable) AND dtime namelist variable.\n"); + } + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dtime', 'hgrid'=>$nl_flags->{'res'}); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_decomp_performance { + my ($test_files, $nl_flags, $definition, $defaults, $nl) = @_; + + # Set the number of segments per clump + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nsegspc', 'hgrid'=>$nl_flags->{'res'}); +} + +#------------------------------------------------------------------------------- + +sub setup_logic_snow { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snowveg_flag', 'phys'=>$nl_flags->{'phys'} ); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics' ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowaging' ); +} + +#------------------------------------------------------------------------------- + +sub setup_logic_glacier { + # + # Glacier multiple elevation class options + # + my ($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref, $physv) = @_; + + my $clm_upvar = "GLC_TWO_WAY_COUPLING"; + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + # glc_do_dynglacier is set via GLC_TWO_WAY_COUPLING; it cannot be set via + # user_nl_clm (this is because we might eventually want the coupler and glc + # to also respond to GLC_TWO_WAY_COUPLING, by not bothering to send / map + # these fields - so we want to ensure that CLM is truly listening to this + # shared xml variable and not overriding it) + my $var = "glc_do_dynglacier"; + my $val = logical_to_fortran($envxml_ref->{$clm_upvar}); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$val); + if (lc($nl->get_value($var)) ne lc($val)) { + fatal_error("glc_do_dynglacier can only be set via the env variable $clm_upvar: it can NOT be set in user_nl_clm\n"); + } + + } else { + # Otherwise if CLM4.0 physics and GLC_TWO_WAY_COUPLING is TRUE -- trigger an error + if ( logical_to_fortran($envxml_ref->{$clm_upvar}) =~ /$TRUE/i ) { + fatal_error( "clm4_0 physics are being used, but $clm_upvar variable is set to true. $clm_upvar can ONLY be set for physics after clm4_5" ); + } + } + + my $var = "maxpatch_glcmec"; + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$nl_flags->{'glc_nec'} ); + + my $val = $nl->get_value($var); + if ( $val != $nl_flags->{'glc_nec'} ) { + fatal_error("$var set to $val does NOT agree with -glc_nec argument of $nl_flags->{'glc_nec'} (set with GLC_NEC env variable)\n"); + } + if ( $nl_flags->{'glc_nec'} > 0 ) { + if (! $opts->{'glc_present'}) { + fatal_error("glc_nec is non-zero, but glc_present is not set (probably due to trying to use a stub glc model)"); + } + + foreach my $var ( "glc_smb" ) { + if ( $opts->{$var} ne "default" ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$opts->{$var} ); + $val = $nl->get_value($var); + $val =~ s/['"]//g; + my $ucvar = $var; + $ucvar =~ tr/a-z/A-Z/; + if ( $val ne $opts->{$var} ) { + fatal_error("$var set to $val does NOT agree with -$var argument of $opts->{$var} (set with $ucvar env variable)\n"); + } + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'glc_nec'=>$nl_flags->{'glc_nec'} ); + } + $val = $nl->get_value($var); + verbose_message("Glacier model $var is $val"); + if ( ! defined($val) ) { + fatal_error("$var is NOT set, but glc_nec is positive"); + } + } + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'flndtopo' , 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'} ); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fglcmask' , 'hgrid'=>$nl_flags->{'res'}); + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glcmec_downscale_longwave'); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glc_snow_persistence_max_days'); + } + + } else { + if ($opts->{'glc_present'}) { + fatal_error("glc_present is set (e.g., due to use of CISM), but glc_nec is zero"); + } + + # Error checking for glacier multiple elevation class options when glc_mec off + # Make sure various glc_mec-specific logicals are not true, and fglcmask is not set + my $create_glcmec = $nl->get_value('create_glacier_mec_landunit'); + if ( defined($create_glcmec) ) { + if ( $create_glcmec =~ /$TRUE/i ) { + fatal_error("create_glacer_mec_landunit is true, but glc_nec is equal to zero"); + } + } + my $glc_smb = $nl->get_value('glc_smb'); + if ( defined($glc_smb) ) { + if ( $glc_smb =~ /$TRUE/i ) { + fatal_error("glc_smb is true, but glc_nec is equal to zero"); + } + } + my $glc_dyntopo= $nl->get_value('glc_dyntopo'); + if ( defined($glc_dyntopo) ) { + if ( $glc_dyntopo =~ /$TRUE/i ) { + fatal_error("glc_dyntopo is true, but glc_nec is equal to zero"); + } + } + my $glc_do_dynglacier= $nl->get_value('glc_do_dynglacier'); + if ( defined($glc_do_dynglacier) ) { + if ( $glc_do_dynglacier =~ /$TRUE/i ) { + fatal_error("glc_do_dynglacier (set from GLC_TWO_WAY_COUPLING env variable) is true, but glc_nec is equal to zero"); + } + } + my $fglcmask = $nl->get_value('fglcmask'); + if ( defined($fglcmask) ) { + fatal_error("fglcmask is set, but glc_nec is equal to zero"); + } + } + + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'albice', 'glc_nec'=>$nl_flags->{'glc_nec'}); +} + +#------------------------------------------------------------------------------- + +sub setup_logic_params_file { + # get param data. For 4_0, pft-physiology, for 4_5 old + # pft-physiology was used but now now includes CN and BGC century + # parameters. + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'paramfile', + 'use_ed'=>$nl_flags->{'use_ed'}, + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + } else { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fpftcon'); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_create_crop_landunit { + # Create crop land unit + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + if ( $nl_flags->{'crop'} eq "on" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'create_crop_landunit' ); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'create_crop_landunit', 'irrig'=>$nl_flags->{'irrig'} ); + } else { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'create_crop_landunit', 'use_crop'=>$nl_flags->{'use_crop'}); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_humanindex { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'calc_human_stress_indices'); + } else { + if ( defined($nl->get_value('calc_human_stress_indices')) ) { + fatal_error( "calc_human_stress_indices can NOT be set, for physics versions less than clm4_5" ); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_urban { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'building_temp_method'); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'urban_hac'); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'urban_traffic'); +} + +#------------------------------------------------------------------------------- + +sub setup_logic_soilstate { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'more_vertlayers', 'hgrid'=>$nl_flags->{'res'} ); + $nl_flags->{'more_vert'} = $nl->get_value('more_vertlayers'); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'organic_frac_squared' ); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_demand { + # + # Deal with options that the user has said are required... + # + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my %settings; + $settings{'hgrid'} = $nl_flags->{'res'}; + $settings{'sim_year'} = $nl_flags->{'sim_year'}; + $settings{'sim_year_range'} = $nl_flags->{'sim_year_range'}; + $settings{'mask'} = $nl_flags->{'mask'}; + $settings{'crop'} = $nl_flags->{'crop'}; + $settings{'irrig'} = $nl_flags->{'irrig'}; + $settings{'rcp'} = $nl_flags->{'rcp'}; + $settings{'glc_nec'} = $nl_flags->{'glc_nec'}; + if ( $physv->as_long() >= $physv->as_long("clm4_5")) { + # necessary for demand to be set correctly (flanduse_timeseries requires + # use_crop, maybe other options require other flags?)! + $settings{'use_cn'} = $nl_flags->{'use_cn'}; + $settings{'use_cndv'} = $nl_flags->{'use_cndv'}; + $settings{'use_lch4'} = $nl_flags->{'use_lch4'}; + $settings{'use_nitrif_denitrif'} = $nl_flags->{'use_nitrif_denitrif'}; + $settings{'use_vertsoilc'} = $nl_flags->{'use_vertsoilc'}; + $settings{'use_century_decomp'} = $nl_flags->{'use_century_decomp'}; + $settings{'use_crop'} = $nl_flags->{'use_crop'}; + } + + my $demand = $nl->get_value('clm_demand'); + if (defined($demand)) { + $demand =~ s/\'//g; # Remove quotes + if ( $demand =~ /.+/ ) { + $opts->{'clm_demand'} .= ",$demand"; + } + } + + $demand = $defaults->get_value('clm_demand', \%settings); + if (defined($demand)) { + $demand =~ s/\'//g; # Remove quotes + if ( $demand =~ /.+/ ) { + $opts->{'clm_demand'} .= ",$demand"; + } + } + + my @demandlist = split( ",", $opts->{'clm_demand'} ); + foreach my $item ( @demandlist ) { + if ( $item eq "null" ) { + next; + } + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $item, %settings ); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_surface_dataset { + # + # Get surface dataset after flanduse_timeseries so that we can get surface data + # consistent with it + # MUST BE AFTER: setup_logic_demand which is where flanduse_timeseries is set + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + $nl_flags->{'flanduse_timeseries'} = "null"; + my $flanduse_timeseries = $nl->get_value('flanduse_timeseries'); + if (defined($flanduse_timeseries)) { + $flanduse_timeseries =~ s!(.*)/!!; + $flanduse_timeseries =~ s/\'//; + $flanduse_timeseries =~ s/\"//; + if ( $flanduse_timeseries ne "" ) { + $nl_flags->{'flanduse_timeseries'} = $flanduse_timeseries; + } + } + $flanduse_timeseries = $nl_flags->{'flanduse_timeseries'}; + + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + if ($flanduse_timeseries ne "null" && $nl_flags->{'bgc_mode'} eq "cndv" ) { + fatal_error( "dynamic PFT's (setting flanduse_timeseries) are incompatible with dynamic vegetation ('-bgc cndv' in CLM_CONFIG_OPTS)." ); + } + + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsurdat', + 'hgrid'=>$nl_flags->{'res'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'irrig'=>$nl_flags->{'irrig'}, + 'crop'=>$nl_flags->{'crop'}, 'glc_nec'=>$nl_flags->{'glc_nec'}); + } else{ + if ($flanduse_timeseries ne "null" && $nl_flags->{'use_cndv'} =~ /$TRUE/i ) { + fatal_error( "dynamic PFT's (setting flanduse_timeseries) are incompatible with dynamic vegetation (use_cndv=.true)." ); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsurdat', + 'hgrid'=>$nl_flags->{'res'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'irrig'=>$nl_flags->{'irrig'}, + 'use_crop'=>$nl_flags->{'use_crop'}, 'glc_nec'=>$nl_flags->{'glc_nec'}); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_initial_conditions { + # Initial conditions + # The initial date is an attribute in the defaults file which should be matched unless + # the user explicitly requests to ignore the initial date via the -ignore_ic_date option, + # or just ignore the year of the initial date via the -ignore_ic_year option. + # + # MUST BE AFTER: setup_logic_demand which is where flanduse_timeseries is set + # AFTER: setup_logic_irrigate which is where irrigate is set + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $nl_flags->{'clm_start_type'} =~ /cold/ ) { + if (defined $nl->get_value('finidat')) { + fatal_error("setting finidat is incomptable with using start_type=cold."); + } + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'finidat', 'val'=>"' '", 'no_abspath'=>1); + } + + if (not defined $nl->get_value('finidat')) { + my $ic_date = $nl->get_value('start_ymd'); + my $nofail = 1; + my $var = "finidat"; + if ( $nl_flags->{'clm_start_type'} =~ /startup/ ) { $nofail = 0; } + if ($opts->{'ignore_ic_date'}) { + if ( $nl_flags->{'use_crop'} eq ".true." ) { + fatal_error("using ignore_ic_date is incompatable with crop!"); + } + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, + 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_cndv'=>$nl_flags->{'use_cndv'}, + 'use_nitrif_denitrif'=>$nl_flags->{'use_nitrif_denitrif'}, + 'use_vertsoilc'=>$nl_flags->{'use_vertsoilc'}, + 'use_century_decomp'=>$nl_flags->{'use_century_decomp'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'more_vertlayers'=>$nl_flags->{'more_vert'}, + 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'irrigate'=>$nl_flags->{'irrigate'} ); + } + } elsif ($opts->{'ignore_ic_year'}) { + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'ic_md'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, + 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'ic_md'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_cndv'=>$nl_flags->{'use_cndv'}, + 'use_nitrif_denitrif'=>$nl_flags->{'use_nitrif_denitrif'}, + 'use_vertsoilc'=>$nl_flags->{'use_vertsoilc'}, + 'use_century_decomp'=>$nl_flags->{'use_century_decomp'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'more_vertlayers'=>$nl_flags->{'more_vert'}, + 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'irrigate'=>$nl_flags->{'irrigate'} ); + } + } else { + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'ic_ymd'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'irrig'=>$nl_flags->{'irrig'}, 'glc_nec'=>$nl_flags->{'glc_nec'}, + 'crop'=>$nl_flags->{'crop'}, 'bgc'=>$nl_flags->{'bgc_mode'} ); + } else { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'hgrid'=>$nl_flags->{'res'}, 'mask'=>$nl_flags->{'mask'}, + 'ic_ymd'=>$ic_date, 'nofail'=>$nofail, 'flanduse_timeseries'=>$nl_flags->{'flanduse_timeseries'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_cndv'=>$nl_flags->{'use_cndv'}, + 'use_nitrif_denitrif'=>$nl_flags->{'use_nitrif_denitrif'}, + 'use_vertsoilc'=>$nl_flags->{'use_vertsoilc'}, + 'use_century_decomp'=>$nl_flags->{'use_century_decomp'}, + 'sim_year'=>$nl_flags->{'sim_year'}, 'maxpft'=>$nl_flags->{'maxpft'}, + 'more_vertlayers'=>$nl_flags->{'more_vert'}, + 'glc_nec'=>$nl_flags->{'glc_nec'}, 'use_crop'=>$nl_flags->{'use_crop'}, + 'irrigate'=>$nl_flags->{'irrigate'} ); + } + } + my $finidat = $nl->get_value($var); + if ( (not defined $finidat ) || $finidat =~ /null/ ) { + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, "' '" ); + } + } +} # end initial conditions + +#------------------------------------------------------------------------------- + +sub setup_logic_dynamic_subgrid { + # + # Options controlling which parts of flanduse_timeseries to use + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + setup_logic_do_transient_pfts($test_files, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_do_transient_crops($test_files, $nl_flags, $definition, $defaults, $nl, $physv); + setup_logic_do_harvest($test_files, $nl_flags, $definition, $defaults, $nl, $physv); + +} + +sub setup_logic_do_transient_pfts { + # + # Set do_transient_pfts default value, and perform error checking on do_transient_pfts + # + # Assumes the following are already set in the namelist (although it's okay + # for them to be unset if that will be their final state): + # - flanduse_timeseries + # - use_cndv + # - use_ed + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $var = 'do_transient_pfts'; + + if ($physv->as_long() >= $physv->as_long("clm4_5")) { + # Start by assuming a default value of '.true.'. Then check a number of + # conditions under which do_transient_pfts cannot be true. Under these + # conditions: (1) set default value to '.false.'; (2) make sure that the + # value is indeed false (e.g., that the user didn't try to set it to true). + + my $default_val = ".true."; + + # cannot_be_true will be set to a non-empty string in any case where + # do_transient_pfts should not be true; if it turns out that + # do_transient_pfts IS true in any of these cases, a fatal error will be + # generated + my $cannot_be_true = ""; + + if (string_is_undef_or_empty($nl->get_value('flanduse_timeseries'))) { + $cannot_be_true = "$var can only be set to true when running a transient case (flanduse_timeseries non-blank)"; + } + elsif (value_is_true($nl->get_value('use_cndv'))) { + $cannot_be_true = "$var cannot be combined with use_cndv"; + } + elsif (value_is_true($nl->get_value('use_ed'))) { + $cannot_be_true = "$var cannot be combined with use_ed"; + } + + if ($cannot_be_true) { + $default_val = ".false."; + } + + if (!$cannot_be_true) { + # Note that, if the variable cannot be true, we don't call add_default + # - so that we don't clutter up the namelist with variables that don't + # matter for this case + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, val=>$default_val); + } + + # Make sure the value is false when it needs to be false - i.e., that the + # user hasn't tried to set a true value at an inappropriate time. + + if (value_is_true($nl->get_value($var)) && $cannot_be_true) { + fatal_error($cannot_be_true); + } + + } +} + +sub setup_logic_do_transient_crops { + # + # Set do_transient_crops default value, and perform error checking on do_transient_crops + # + # Assumes the following are already set in the namelist (although it's okay + # for them to be unset if that will be their final state): + # - flanduse_timeseries + # - use_crop + # - use_ed + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $var = 'do_transient_crops'; + + if ($physv->as_long() >= $physv->as_long("clm4_5")) { + # Start by assuming a default value of '.true.'. Then check a number of + # conditions under which do_transient_crops cannot be true. Under these + # conditions: (1) set default value to '.false.'; (2) make sure that the + # value is indeed false (e.g., that the user didn't try to set it to true). + + my $default_val = ".true."; + + # cannot_be_true will be set to a non-empty string in any case where + # do_transient_crops should not be true; if it turns out that + # do_transient_crops IS true in any of these cases, a fatal error will be + # generated + my $cannot_be_true = ""; + + if (string_is_undef_or_empty($nl->get_value('flanduse_timeseries'))) { + $cannot_be_true = "$var can only be set to true when running a transient case (flanduse_timeseries non-blank)"; + } + elsif (!value_is_true($nl->get_value('use_crop'))) { + $cannot_be_true = "$var can only be set to true when running with use_crop = true"; + } + elsif (value_is_true($nl->get_value('use_ed'))) { + # In principle, use_ed should be compatible with + # do_transient_crops. However, this hasn't been tested, so to be safe, + # we are not allowing this combination for now. + $cannot_be_true = "$var has not been tested with ED, so for now these two options cannot be combined"; + } + + if ($cannot_be_true) { + $default_val = ".false."; + } + + if (!$cannot_be_true) { + # Note that, if the variable cannot be true, we don't call add_default + # - so that we don't clutter up the namelist with variables that don't + # matter for this case + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, val=>$default_val); + } + + # Make sure the value is false when it needs to be false - i.e., that the + # user hasn't tried to set a true value at an inappropriate time. + + if (value_is_true($nl->get_value($var)) && $cannot_be_true) { + fatal_error($cannot_be_true); + } + + } +} + +sub setup_logic_do_harvest { + # + # Set do_harvest default value, and perform error checking on do_harvest + # + # Assumes the following are already set in the namelist (although it's okay + # for them to be unset if that will be their final state): + # - flanduse_timeseries + # - use_cn + # - use_ed + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $var = 'do_harvest'; + + if ($physv->as_long() >= $physv->as_long("clm4_5")) { + # Start by assuming a default value of '.true.'. Then check a number of + # conditions under which do_harvest cannot be true. Under these + # conditions: (1) set default value to '.false.'; (2) make sure that the + # value is indeed false (e.g., that the user didn't try to set it to true). + + my $default_val = ".true."; + + # cannot_be_true will be set to a non-empty string in any case where + # do_harvest should not be true; if it turns out that do_harvest IS true + # in any of these cases, a fatal error will be generated + my $cannot_be_true = ""; + + if (string_is_undef_or_empty($nl->get_value('flanduse_timeseries'))) { + $cannot_be_true = "$var can only be set to true when running a transient case (flanduse_timeseries non-blank)"; + } + elsif (!value_is_true($nl->get_value('use_cn'))) { + $cannot_be_true = "$var can only be set to true when running with CN (use_cn = true)"; + } + elsif (value_is_true($nl->get_value('use_ed'))) { + $cannot_be_true = "$var currently doesn't work with ED"; + } + + if ($cannot_be_true) { + $default_val = ".false."; + } + + if (!$cannot_be_true) { + # Note that, if the variable cannot be true, we don't call add_default + # - so that we don't clutter up the namelist with variables that don't + # matter for this case + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, val=>$default_val); + } + + # Make sure the value is false when it needs to be false - i.e., that the + # user hasn't tried to set a true value at an inappropriate time. + + if (value_is_true($nl->get_value($var)) && $cannot_be_true) { + fatal_error($cannot_be_true); + } + + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_bgc_spinup { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5")) { + if ( $nl_flags->{'bgc_mode'} ne "sp" ) { + # only set bgc_spinup state if CN is on. + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'spinup_state', 'bgc_spinup'=>$nl_flags->{'bgc_spinup'} ); + } + + if ( $nl_flags->{'bgc_mode'} eq "sp" && defined($nl->get_value('override_bgc_restart_mismatch_dump'))) { + fatal_error("CN must be on if override_bgc_restart_mismatch_dump is set.\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_supplemental_nitrogen { + # + # Supplemental Nitrogen for prognostic crop cases + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $nl_flags->{'bgc_mode'} ne "sp" && $nl_flags->{'use_crop'} eq ".true." ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'suplnitro', 'use_cn'=>$nl_flags->{'use_cn'}, 'use_crop'=>$nl_flags->{'use_crop'}); + } + + # + # Error checking for suplnitro + # + my $suplnitro = $nl->get_value('suplnitro'); + if ( defined($suplnitro) ) { + if ( $nl_flags->{'bgc_mode'} eq "sp" ) { + fatal_error("supplemental Nitrogen (suplnitro) is set, but neither CN nor CNDV is active!\n"); + } + if ( $nl_flags->{'use_crop'} ne ".true." && $suplnitro =~ /PROG_CROP_ONLY/i ) { + fatal_error("supplemental Nitrogen is set to run over prognostic crops, but prognostic crop is NOT active!\n"); + } + + if ( $suplnitro =~ /ALL/i ) { + if ( $physv->as_long() == $physv->as_long("clm4_0") && $nl_flags->{'spinup'} ne "normal" ) { + fatal_error("There is no need to use a spinup mode when supplemental Nitrogen is on for all PFT's, as these modes spinup Nitrogen\n" . + "when spinup != normal you can NOT set supplemental Nitrogen (suplnitro) to ALL\n"); + } + if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_spinup'} ne "off" ) { + warning("There is no need to use a bgc_spinup mode when supplemental Nitrogen is on for all PFT's, as these modes spinup Nitrogen\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_hydrology_switches { + # + # Check on Switches for hydrology + # + my ($nl) = @_; + + my $subgrid = $nl->get_value('subgridflag' ) || 0; + my $origflag = $nl->get_value('origflag' ) || 0; + my $h2osfcflag = $nl->get_value('h2osfcflag' ) || 0; + if ( $origflag == 1 && $subgrid == 1 ) { + fatal_error("if origflag is ON, subgridflag can NOT also be on!"); + } + if ( $h2osfcflag == 1 && $subgrid != 1 ) { + fatal_error("if h2osfcflag is ON, subgridflag can NOT be off!"); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_methane { + # + # CH4 model if bgc=CN or CNDV + # + my ($test_files, $nl_flags, $definition, $defaults, $nl) = @_; + + if ( $nl_flags->{'use_lch4'} eq '.true.' ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fin_use_fsat' ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_aereoxid_prog' ); + # + # Check if use_aereoxid_prog is set. If no, then read value of aereoxid from + # parameters file + # + my $use_aereoxid_prog = $nl->get_value('use_aereoxid_prog'); + if ( defined($use_aereoxid_prog) && $use_aereoxid_prog =~ /$FALSE/i ) { + warning("Using aereoxid value from parameters file.\n"); + } + } else { + my @vars = $nl->get_variable_names('ch4par_in'); + if ( $#vars >= 0 ) { + fatal_error("ch4par_in namelist variables were set, but Methane model NOT defined in the configuration (use_lch4)"); + } + } + + # + # Ch4 namelist checking + # + if ( $nl_flags->{'use_lch4'} eq ".true." ) { + my $allowlakeprod = $nl->get_value('allowlakeprod'); + if ( ! defined($allowlakeprod) || + (defined($allowlakeprod) && $allowlakeprod =~ /$FALSE/i) ) { + if ( defined($nl->get_value('lake_decomp_fact')) ) { + fatal_error("lake_decomp_fact set without allowlakeprod=.true.\n"); + } + } + my $anoxia = $nl->get_value('anoxia'); + if ( ! defined($anoxia) || + (defined($anoxia) && $anoxia =~ /$FALSE/i) ) { + if ( defined($nl->get_value('anoxia_wtsat')) ) { + fatal_error("anoxia_wtsat set without anoxia=.true.\n"); + } + } + my $pftspec_rootprof = $nl->get_value('pftspecific_rootingprofile'); + if ( ! defined($pftspec_rootprof) || + (defined($pftspec_rootprof) && $pftspec_rootprof =~ /$TRUE/i) ) { + if ( defined($nl->get_value('rootprof_exp')) ) { + fatal_error("rootprof_exp set without pftspecific_rootingprofile=.false.\n"); + } + } + } else { + my @vars = ( "allowlakeprod", "anoxia", "anoxia_wtsat", "pftspecific_rootingprofile" ); + foreach my $var ( @vars ) { + if ( defined($nl->get_value($var)) ) { + fatal_error("$var set without methane model configuration on (use_lch4)\n"); + } + } + } +} # end methane + +#------------------------------------------------------------------------------- + +sub setup_logic_dynamic_plant_nitrogen_alloc { + # + # dynamic plant nitrogen allocation model, bgc=bgc + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") && + $nl_flags->{'bgc_mode'} eq "bgc" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_flexibleCN' ); + $nl_flags->{'use_flexibleCN'} = $nl->get_value('use_flexibleCN'); + + if ( $nl_flags->{'use_flexibleCN'} eq '.true.' ) { + # TODO(bja, 2015-04) make this depend on > clm 5.0 and bgc mode at some point. + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'MM_Nuptake_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'dynamic_plant_alloc_opt' , + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'downreg_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'plant_ndemand_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'substrate_term_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nscalar_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'temp_scalar_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CNratio_floating', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lnc_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'reduce_dayl_factor', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'vcmax_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_residual_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_partition_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'carbon_excess_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'carbon_storage_excess_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'CN_evergreen_phenology_opt', + 'use_flexibleCN'=>$nl_flags->{'use_flexibleCN'} ); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_luna { + # + # LUNA model to calculate photosynthetic capacities based on environmental conditions + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + $nl_flags->{'use_luna'} = $nl->get_value('use_luna'); + # TODO(bja, 2015-04) make this depend on > clm 5.0 and bgc mode at some point. + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_luna' ); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_c_isotope { + # + # Error checking for C-isotope options + # + my ($nl_flags, $definition, $defaults, $nl) = @_; + + my $use_c13 = $nl->get_value('use_c13'); + my $use_c14 = $nl->get_value('use_c14'); + if ( $nl_flags->{'bgc_mode'} ne "sp" ) { + if ( $nl_flags->{'use_crop'} eq ".true." ) { + if ( defined($use_c13) || + defined($use_c14) || + defined($nl->get_value('use_c14_bombspike')) || + defined($nl->get_value('atm_c14_filename')) ) { + fatal_error("CROP is on and C isotope namelist variables were set, both can't be used at the same time"); + } + } + if ( $nl_flags->{'bgc_mode'} ne "bgc" ) { + if ( defined($use_c13) && $use_c13 =~ /$TRUE/i ) { + warning("use_c13 is ONLY scientifically validated with the bgc=BGC configuration\n"); + } + if ( defined($use_c14) && $use_c14 =~ /$TRUE/i ) { + warning("use_c14 is ONLY scientifically validated with the bgc=BGC configuration\n"); + } + } + if ( defined($use_c14) ) { + if ( $use_c14 =~ /$TRUE/i ) { + my $use_c14_bombspike = $nl->get_value('use_c14_bombspike'); + if ( defined($use_c14_bombspike) && $use_c14_bombspike =~ /$TRUE/i && + ! defined($nl->get_value('atm_c14_filename')) ) { + fatal_error("use_c14_bombspike TRUE but atm_c14_filename NOT set\n"); + } + } else { + if ( defined($nl->get_value('use_c14_bombspike')) || + defined($nl->get_value('atm_c14_filename')) ) { + fatal_error("use_c14 is FALSE and use_c14_bombspike or atm_c14_filename set\n"); + } + } + } else { + if ( defined($nl->get_value('use_c14_bombspike')) || + defined($nl->get_value('atm_c14_filename')) ) { + fatal_error("use_c14 NOT set to .true., but use_c14_bompspike/atm_c14_filename defined.\n"); + } + } + } else { + if ( defined($use_c13) || + defined($use_c14) || + defined($nl->get_value('use_c14_bombspike')) || + defined($nl->get_value('atm_c14_filename')) ) { + fatal_error("bgc=sp and C isotope namelist variables were set, both can't be used at the same time"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_nitrogen_deposition { + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + # + # Nitrogen deposition for bgc=CN + # + + if ( $physv->as_long() == $physv->as_long("clm4_0") && $nl_flags->{'bgc_mode'} ne "none" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndepmapalgo', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep') != $nl->get_value('stream_year_last_ndep') ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'rcp'=>$nl_flags->{'rcp'}, + 'hgrid'=>"1.9x2.5" ); + + } elsif ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} ne "sp" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndepmapalgo', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep') != $nl->get_value('stream_year_last_ndep') ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'rcp'=>$nl_flags->{'rcp'}, + 'hgrid'=>"1.9x2.5" ); + } else { + # If bgc is NOT CN/CNDV then make sure none of the ndep settings are set! + if ( defined($nl->get_value('stream_year_first_ndep')) || + defined($nl->get_value('stream_year_last_ndep')) || + defined($nl->get_value('model_year_align_ndep')) || + defined($nl->get_value('stream_fldfilename_ndep')) + ) { + fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_ndep," . + "stream_year_last_ndep, model_year_align_ndep, nor stream_fldfilename_ndep" . + " can be set!\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_popd_streams { + # population density streams require clm4_5/clm5_0 and CN/BGC + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + if ( $nl_flags->{'bgc_mode'} ne "sp" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'popdensmapalgo', 'hgrid'=>$nl_flags->{'res'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_popdens', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_popdens', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_popdens') != + $nl->get_value('stream_year_last_popdens') ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_popdens', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_popdens', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>"0.5x0.5" ); + } else { + # If bgc is NOT CN/CNDV then make sure none of the popdens settings are set + if ( defined($nl->get_value('stream_year_first_popdens')) || + defined($nl->get_value('stream_year_last_popdens')) || + defined($nl->get_value('model_year_align_popdens')) || + defined($nl->get_value('stream_fldfilename_popdens')) ) { + fatal_error("When bgc is SP (NOT CN or BGC) none of: stream_year_first_popdens,\n" . + "stream_year_last_popdens, model_year_align_popdens, nor\n" . + "stream_fldfilename_popdens can be set!\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_lightning_streams { + # lightning streams require clm4_5/clm5_0 and CN/BGC + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + if ( $nl_flags->{'bgc_mode'} ne "sp" ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lightngmapalgo', 'use_cn'=>$nl_flags->{'use_cn'}, + 'hgrid'=>$nl_flags->{'res'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_lightng', 'use_cn'=>$nl_flags->{'use_cn'}, + 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_lightng', 'use_cn'=>$nl_flags->{'use_cn'}, + 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_lightng') != + $nl->get_value('stream_year_last_lightng') ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_lightng', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_lightng', 'use_cn'=>$nl_flags->{'use_cn'}, + 'hgrid'=>"94x192" ); + } else { + # If bgc is NOT CN/CNDV then make sure none of the Lightng settings are set + if ( defined($nl->get_value('stream_year_first_lightng')) || + defined($nl->get_value('stream_year_last_lightng')) || + defined($nl->get_value('model_year_align_lightng')) || + defined($nl->get_value('stream_fldfilename_lightng')) ) { + fatal_error("When bgc is SP (NOT CN or BGC) none of: stream_year_first_lightng,\n" . + "stream_year_last_lightng, model_year_align_lightng, nor\n" . + "stream_fldfilename_lightng can be set!\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_dry_deposition { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + if ($opts->{'drydep'} ) { + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'drydep_list'); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'drydep_method'); + } else { + if ( defined($nl->get_value('drydep_list')) || + defined($nl->get_value('drydep_method')) ) { + fatal_error("drydep_list or drydep_method defined, but drydep option NOT set\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_megan { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + if ($opts->{'megan'} ) { + if ( value_is_true( $nl_flags->{'use_ed'} ) ) { + fatal_error("MEGAN can NOT be on when ED is also on.\n" . + " Use the '-no-megan' option when '-ed_mode' is activated"); + } + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'megan_specifier'); + check_megan_spec( $nl, $definition ); + add_default($opts->{'test'}, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'megan_factors_file'); + } else { + if ( defined($nl->get_value('megan_specifier')) || + defined($nl->get_value('megan_factors_file')) ) { + fatal_error("megan_specifier or megan_factors_file defined, but megan option NOT set\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_lai_streams { + # lai streams require clm4_5/clm5_0 + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + if ( $nl_flags->{'use_crop'} eq ".true." && $nl_flags->{'use_lai_streams'} eq ".true." ) { + fatal_error("turning use_lai_streams on is incompatable with use_crop set to true."); + } + if ( $nl_flags->{'bgc_mode'} eq "sp" ) { + + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_lai_streams'); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'lai_mapalgo', + 'hgrid'=>$nl_flags->{'res'} ); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_lai', + 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_lai', + 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_lai') != + $nl->get_value('stream_year_last_lai') ) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, + 'model_year_align_lai', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_lai', + 'hgrid'=>"360x720cru" ); + } else { + # If bgc is CN/CNDV then make sure none of the LAI settings are set + if ( defined($nl->get_value('stream_year_first_lai')) || + defined($nl->get_value('stream_year_last_lai')) || + defined($nl->get_value('model_year_align_lai')) || + defined($nl->get_value('stream_fldfilename_lai')) ) { + fatal_error("When bgc is NOT SP none of the following can be set: stream_year_first_lai,\n" . + "stream_year_last_lai, model_year_align_lai, nor\n" . + "stream_fldfilename_lai (eg. don't use this option with BGC,CN,CNDV nor BGDCV).\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_snowpack { + # + # Snowpack related options + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ($physv->as_long() >= $physv->as_long("clm4_5")) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nlevsno'); + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'h2osno_max'); + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_atm_forcing { + # + # Options related to atmospheric forcings + # + my ($test_files, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ($physv->as_long() >= $physv->as_long("clm4_5")) { + add_default($test_files, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'repartition_rain_snow'); + } +} + +#------------------------------------------------------------------------------- + +sub write_output_files { + my ($opts, $nl_flags, $defaults, $nl, $physv) = @_; + + my $note = ""; + my $var = "note"; + if ( ! defined($opts->{$var}) ) { + $opts->{$var} = $defaults->get_value($var); + } + if ( $opts->{$var} ) { + $note = "Comment:\n" . + "This namelist was created using the following command-line:\n" . + " $nl_flags->{'cfgdir'}/$ProgName $nl_flags->{'cmdline'}\n" . + "For help on options use: $nl_flags->{'cfgdir'}/$ProgName -help"; + } + + # CLM component + my @groups; + if ( $physv->as_long() == $physv->as_long("clm4_0") ) { + @groups = qw(clm_inparm); + # Eventually only list namelists that are actually used when CN on + #if ( $nl_flags->{'bgc_mode'} eq "cn" ) { + push @groups, "ndepdyn_nml"; + #} + } else { + @groups = qw(clm_inparm ndepdyn_nml popd_streams light_streams lai_streams clm_canopyhydrology_inparm + clm_soilhydrology_inparm dynamic_subgrid finidat_consistency_checks dynpft_consistency_checks + clmu_inparm clm_soilstate_inparm clm_nitrogen ); + #@groups = qw(clm_inparm clm_canopyhydrology_inparm clm_soilhydrology_inparm + # finidat_consistency_checks dynpft_consistency_checks); + # Eventually only list namelists that are actually used when CN on + #if ( $nl_flags->{'bgc_mode'} eq "cn" ) { + # push @groups, qw(ndepdyn_nml popd_streams light_streams); + #} + if ( $nl_flags->{'use_lch4'} eq ".true." ) { + push @groups, "ch4par_in"; + } + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + push @groups, "clm_humanindex_inparm"; + } + } + + my $outfile; + $outfile = "$opts->{'dir'}/lnd_in"; + $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); + verbose_message("Writing clm namelist to $outfile"); + + # Drydep or MEGAN namelist + if ($opts->{'drydep'} || $opts->{'megan'} ) { + @groups = qw(drydep_inparm megan_emis_nl); + $outfile = "$opts->{'dir'}/drv_flds_in"; + $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); + verbose_message("Writing @groups namelists to $outfile"); + } +} + +#------------------------------------------------------------------------------- + +sub add_default { + +# Add a value for the specified variable to the specified namelist object. The variables +# already in the object have the higher precedence, so if the specified variable is already +# defined in the object then don't overwrite it, just return. +# +# This method checks the definition file and adds the variable to the correct +# namelist group. +# +# The value can be provided by using the optional argument key 'val' in the +# calling list. Otherwise a default value is obtained from the namelist +# defaults object. If no default value is found this method throws an exception +# unless the 'nofail' option is set true. +# +# Example 1: Specify the default value $val for the namelist variable $var in namelist +# object $nl: +# +# add_default($inputdata_rootdir, $definition, $defaults, $nl, $var, 'val'=>$val) +# +# Example 2: Add a default for variable $var if an appropriate value is found. Otherwise +# don't add the variable +# +# add_default($inputdata_rootdir, $definition, $defaults, $nl, $var, 'nofail'=>1) +# +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object +# $defaults -- the namelist defaults object +# $inputdata_rootdir -- CESM inputdata root directory + + my $test_files = shift; + my $inputdata_rootdir = shift; + my $definition = shift; + my $defaults = shift; + my $nl = shift; + my $var = shift; + my %settings = @_; + + #my $nl = shift; # namelist object + #my $var = shift; # name of namelist variable + #my %settings = @_; # options + + # If variable has quotes around it + if ( $var =~ /'(.+)'/ ) { + $var = $1; + } + # Query the definition to find which group the variable belongs to. Exit if not found. + my $group = $definition->get_group_name($var); + unless ($group) { + my $fname = $definition->get_file_name(); + fatal_error("variable \"$var\" not found in namelist definition file $fname.\n"); + } + + # check whether the variable has a value in the namelist object -- if so then skip to end + my $val = $nl->get_variable_value($group, $var); + if (! defined $val) { + + # Look for a specified value in the options hash + + if (defined $settings{'val'}) { + $val = $settings{'val'}; + } + # or else get a value from namelist defaults object. + # Note that if the 'val' key isn't in the hash, then just pass anything else + # in %settings to the get_value method to be used as attributes that are matched + # when looking for default values. + else { + $val = $defaults->get_value($var, \%settings); + + # Truncate model_version appropriately + + if ( $var eq "model_version" ) { + $val =~ /(URL: https:\/\/[a-zA-Z0-9._-]+\/)([a-zA-Z0-9\/._-]+)(\/bld\/.+)/; + $val = $2; + } + } + + # if no value is found then exit w/ error (unless 'nofail' option set) + unless ( defined($val) ) { + unless ($settings{'nofail'}) { + if ($var eq 'finidat') { + warning("No default value found for $var.\n" . + " Are defaults provided for this resolution and land mask?\n"); + } else { + fatal_error("No default value found for $var.\n" . + " Are defaults provided for this resolution and land mask?\n"); + } + } + else { + return; + } + } + + # query the definition to find out if the variable is an input pathname + my $is_input_pathname = $definition->is_input_pathname($var); + + # The default values for input pathnames are relative. If the namelist + # variable is defined to be an absolute pathname, then prepend + # the CESM inputdata root directory. + if (not defined $settings{'no_abspath'}) { + if (defined $settings{'set_abspath'}) { + $val = set_abs_filepath($val, $settings{'set_abspath'}); + } else { + if ($is_input_pathname eq 'abs') { + $val = set_abs_filepath($val, $inputdata_rootdir); + if ( $test_files and ($val !~ /null/) and (! -f "$val") ) { + fatal_error("file not found: $var = $val"); + } + } + } + } + + # query the definition to find out if the variable takes a string value. + # The returned string length will be >0 if $var is a string, and 0 if not. + my $str_len = $definition->get_str_len($var); + + # If the variable is a string, then add quotes if they're missing + if ($str_len > 0) { + $val = quote_string($val); + } + + # set the value in the namelist + $nl->set_variable_value($group, $var, $val); + } + +} + +#------------------------------------------------------------------------------- + +sub expand_xml_variables_in_namelist { + # Go through all variables in the namelist and expand any XML env settings in them + my ($nl, $xmlvar_ref) = @_; + + foreach my $group ( $nl->get_group_names() ) { + foreach my $var ( $nl->get_variable_names($group) ) { + my $val = $nl->get_variable_value($group, $var); + my $newval = SetupTools::expand_xml_var( $val, $xmlvar_ref ); + if ( $newval ne $val ) { + $nl->set_variable_value($group, $var, $newval); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub check_input_files { + +# For each variable in the namelist which is an input dataset, check to see if it +# exists locally. +# +# ***** N.B. ***** This routine assumes the following variables are in package main:: +# $definition -- the namelist definition object +# $nl -- namelist object +# $inputdata_rootdir -- if false prints test, else creates inputdata file + + my ($nl, $inputdata_rootdir, $outfile, $definition) = @_; + + open(OUTFILE, ">>$outfile") if defined $inputdata_rootdir; + + # Look through all namelist groups + my @groups = $nl->get_group_names(); + foreach my $group (@groups) { + + # Look through all variables in each group + my @vars = $nl->get_variable_names($group); + foreach my $var (@vars) { + + # Is the variable an input dataset? + my $input_pathname_type = $definition->is_input_pathname($var); + + # If it is, check whether it exists locally and print status + if ($input_pathname_type) { + + # Get pathname of input dataset + my $pathname = $nl->get_variable_value($group, $var); + # Need to strip the quotes + $pathname =~ s/['"]//g; + + if ($input_pathname_type eq 'abs') { + if ($inputdata_rootdir) { + #MV $pathname =~ s:$inputdata_rootdir::; + print OUTFILE "$var = $pathname\n"; + } + else { + if (-e $pathname) { # use -e rather than -f since the absolute pathname + # might be a directory + print "OK -- found $var = $pathname\n"; + } + else { + print "NOT FOUND: $var = $pathname\n"; + } + } + } + elsif ($input_pathname_type =~ m/rel:(.+)/o) { + # The match provides the namelist variable that contains the + # root directory for a relative filename + my $rootdir_var = $1; + my $rootdir = $nl->get_variable_value($group, $rootdir_var); + $rootdir =~ s/['"]//g; + if ($inputdata_rootdir) { + $pathname = "$rootdir/$pathname"; + #MV $pathname =~ s:$inputdata_rootdir::; + print OUTFILE "$var = $pathname\n"; + } + else { + if (-f "$rootdir/$pathname") { + print "OK -- found $var = $rootdir/$pathname\n"; + } + else { + print "NOT FOUND: $var = $rootdir/$pathname\n"; + } + } + } + } + } + } + close OUTFILE if defined $inputdata_rootdir; + return 0 if defined $inputdata_rootdir; +} + +#------------------------------------------------------------------------------- + +sub set_abs_filepath { + +# check whether the input filepath is an absolute path, and if it isn't then +# prepend a root directory + + my ($filepath, $rootdir) = @_; + + # strip any leading/trailing whitespace and quotes + $filepath = trim($filepath); + $filepath = remove_leading_and_trailing_quotes($filepath); + $rootdir = trim($rootdir); + $rootdir = remove_leading_and_trailing_quotes($rootdir); + + my $out = $filepath; + unless ( $filepath =~ /^\// ) { # unless $filepath starts with a / + $out = "$rootdir/$filepath"; # prepend the root directory + } + return $out; +} + +#------------------------------------------------------------------------------- + +sub valid_option { + + my ($val, @expect) = @_; + + my $expect; + + $val = trim($val); + + foreach $expect (@expect) { + if ($val =~ /^$expect$/i) { return $expect; } + } + return undef; +} + +#------------------------------------------------------------------------------- + +sub check_use_case_name { +# +# Check the use-case name and ensure it follows the naming convention. +# + my ($use_case) = @_; + + my $diestring = "bad use_case name $use_case, follow the conventions " . + "in namelist_files/use_cases/README\n"; + my $desc = "[a-zA-Z0-9]*"; + my $rcp = "rcp[0-9\.]+"; + if ( $use_case =~ /^[0-9]+-[0-9]+([a-zA-Z0-9_\.]*)_transient$/ ) { + my $string = $1; + if ( $string =~ /^_($rcp)_*($desc)$/ ) { + # valid name + } elsif ( $string =~ /^_*($desc)$/ ) { + # valid name + } else { + fatal_error($diestring); + } + } elsif ( $use_case =~ /^20thC([a-zA-Z0-9_\.]*)_transient$/ ) { + my $string = $1; + if ( $string =~ /^_($rcp)_*($desc)$/ ) { + # valid name + } elsif ( $string =~ /^_*($desc)$/ ) { + # valid name + } else { + fatal_error($diestring); + } + } elsif ( $use_case =~ /^([0-9]+)_*($desc)_control$/ ) { + # valid name + } elsif ( $use_case =~ /^($desc)_pd$/ ) { + # valid name + } else { + fatal_error($diestring); + } +} + +#------------------------------------------------------------------------------- + +sub validate_options { + +# $source -- text string declaring the source of the options being validated +# $cfg -- configure object +# $opts -- reference to hash that contains the options + + my ($source, $cfg, $opts) = @_; + + my ($opt, $old, @expect); + + # use_case + $opt = 'use_case'; + if (defined $opts->{$opt}) { + + if ( $opts->{$opt} ne "list" ) { + # create the @expect array by listing the files in $use_case_dir + # and strip off the ".xml" part of the filename + @expect = (); + my @files = glob("$opts->{'use_case_dir'}/*.xml"); + foreach my $file (@files) { + $file =~ m{.*/(.*)\.xml}; + &check_use_case_name( $1 ); + push @expect, $1; + } + + $old = $opts->{$opt}; + $opts->{$opt} = valid_option($old, @expect) + or fatal_error("invalid value of $opt ($old) specified in $source\n" . + "expected one of: @expect"); + } else { + print "Use cases are:...\n\n"; + my @ucases; + foreach my $file( sort( glob($opts->{'use_case_dir'}."/*.xml") ) ) { + my $use_case; + if ( $file =~ /\/([^\/]+)\.xml$/ ) { + &check_use_case_name( $1 ); + $use_case = $1; + } else { + fatal_error("Bad name for use case file = $file"); + } + my $uc_defaults = Build::NamelistDefaults->new("$file", $cfg); + printf "%15s = %s\n", $use_case, $uc_defaults->get_value("use_case_desc"); + push @ucases, $use_case; + } + exit_message("use cases : @ucases"); + } + } +} + +#------------------------------------------------------------------------------- + +sub list_options { +# +# List the options for different command line values if asked for +# + my ($opts_cmdl, $definition, $defaults) = @_; + + # options to list values that are in the defaults files + my @opts_list = ( "res", "mask", "sim_year", "rcp" ); + my %opts_local; + foreach my $var ( "res", "mask", "sim_year", "rcp" ) { + my $val; + if ( $opts_cmdl->{$var} eq "list" ) { + $val = "default"; + } elsif ( $opts_cmdl->{$var} eq "default" ) { + $val = $defaults->get_value($var, \%opts_local ); + } else { + $val = $opts_cmdl->{$var}; + } + my $vname = $var; + if ( $vname eq "res" ) { $vname = "hgrid"; } + $opts_local{$vname} = $val; + } + foreach my $var ( @opts_list ) { + if (defined $opts_cmdl->{$var}) { + + if ( $opts_cmdl->{$var} eq "list" ) { + my @valid_values = $definition->get_valid_values( $var ); + if ( $var eq "sim_year" ) { + unshift( @valid_values, + $definition->get_valid_values( "sim_year_range" ) ); + } + unshift( @valid_values, "default" ); + # Strip out quotes and the constant value + for( my $i = 0; $i <= $#valid_values; $i++ ) { + $valid_values[$i] =~ s/('|')//g; + if ( $valid_values[$i] eq "constant" ) { $valid_values[$i] = undef; } + } + my $val= $defaults->get_value($var, \%opts_local); + my $doc = $definition->get_var_doc( $var ); + $doc =~ s/\n//; + chomp( $doc ); + exit_message("valid values for $var ($doc) :\n" . + " Values: @valid_values\n" . + " Default = $val\n" . + " (NOTE: resolution and mask and other settings may influence what the default is)"); + } + } + } + # clm_demand + my $var = 'clm_demand'; + if (defined $opts_cmdl->{$var}) { + + if ( $opts_cmdl->{$var} eq "list" ) { + my @vars = $definition->get_var_names( ); + my @demands = ( "null" ); + foreach my $var ( @vars ) { + if ( $definition->get_group_name( $var ) ne "clm_inparm" ) { next; } + if ( defined($defaults->get_value($var, $opts_cmdl ) ) ) { + push( @demands, $var ); + } + } + my $doc = $definition->get_var_doc( 'clm_demand' ); + $doc =~ s/\n//; + chomp( $doc ); + exit_message("valid values for $var ($doc) :\n" . + "Namelist options to require: @demands\n" . + "any valid namelist item for clm_inparm can be set. However, not all are\n" . + "available in the clm defaults file. The defaults are also dependent on\n" . + "resolution and landmask, as well as other settings. Hence, the list above\n" . + "will vary depending on what you set for resolution and landmask.\n"); + } + } +} + +#------------------------------------------------------------------------------- + +sub check_megan_spec { +# +# Check the megan specifier setting +# + my ($nl, $definition) = @_; + + my $megan_spec = $nl->get_value('megan_specifier'); + my @megan_spec_list = split( /\s*,\s*/, $megan_spec ); + foreach $megan_spec ( @megan_spec_list ) { + if ( $megan_spec =~ /^['"]+[A-Za-z0-9]+\s*\=\s*([\sA-Za-z0-9+_-]+)["']+$/ ) { + my $megan_list = $1; + my @megan_cmpds = split( /\s*\+\s*/, $megan_list ); + my $var = "megan_cmpds"; + my $warn = 0; + foreach my $megan_cmpd ( @megan_cmpds ) { + if ( ! $definition->is_valid_value( $var, $megan_cmpd, 'noquotes'=>1 ) ) { + warning("megan_compound $megan_cmpd NOT found in list"); + $warn++; + } + } + if ( $warn > 0 ) { + my @valid_values = $definition->get_valid_values( $var, 'noquotes'=>1 ); + warning("list of megan compounds includes:\n" . + "@valid_values\n" . + "Does your megan_factors_file include more coumpounds?\n" . + "If NOT your simulation will fail.\n"); + } + } else { + fatal_error("Bad format for megan_specifier = $megan_spec"); + } + } +} + +#------------------------------------------------------------------------------- + +sub trim { + # remove leading and trailing whitespace from a string. + my ($str) = @_; + $str =~ s/^\s+//; + $str =~ s/\s+$//; + return $str; +} + +#------------------------------------------------------------------------------- + +sub quote_string { + # Add quotes around a string, unless they are already there + my ($str) = @_; + $str = trim($str); + unless ($str =~ /^['"]/) { #"' + $str = "\'$str\'"; + } + return $str; + } + +#------------------------------------------------------------------------------- + +sub remove_leading_and_trailing_quotes { + # Remove leading and trailing single and double quotes from a string. Also + # removes leading spaces before the leading quotes, and trailing spaces after + # the trailing quotes. + + my ($str) = @_; + + $str = trim($str); + + # strip any leading/trailing quotes + $str =~ s/^['"]+//; + $str =~ s/["']+$//; + + return $str; +} + +#------------------------------------------------------------------------------- + +sub logical_to_fortran { + # Given a logical variable ('true' / 'false'), convert it to a fortran-style logical ('.true.' / '.false.') + # The result will be lowercase, regardless of the case of the input. + my ($var) = @_; + my $result; + + if (lc($var) eq 'true') { + $result = ".true."; + } + elsif (lc($var) eq 'false') { + $result = ".false."; + } + else { + fatal_error("Unexpected value in logical_to_fortran: $var\n"); + } + + return $result; +} + +#------------------------------------------------------------------------------- + +sub string_is_undef_or_empty { + # Return true if the given string is undefined or only spaces, false otherwise. + # A quoted empty string (' ' or " ") is treated as being empty. + my ($str) = @_; + if (!defined($str)) { + return 1; + } + else { + $str = remove_leading_and_trailing_quotes($str); + if ($str =~ /^\s*$/) { + return 1; + } + else { + return 0; + } + } +} + +#------------------------------------------------------------------------------- + +sub value_is_true { + # Return true if the given namelist value is .true. + # An undefined value is treated as false (with the assumption that false is the default in the code) + my ($val) = @_; + my $is_true = 0; + if (defined($val)) { + if ($val =~ /$TRUE/i) { + $is_true = 1; + } + } + + return $is_true; +} + +#------------------------------------------------------------------------------- + +sub version { +# The version is found in CLM ChangeLog file. +# $cfgdir is set by the configure script to the name of its directory. + + my ($cfgdir) = @_; + + my $logfile = "$cfgdir/../doc/ChangeLog"; + + my $fh = IO::File->new($logfile, '<') or fatal_error("can't open ChangeLog file: $logfile"); + + while (my $line = <$fh>) { + + if ($line =~ /^Tag name:\s*([a-zA-Z0-9_. -]*[clmcesm0-9_.-]+)$/ ) { + exit_message("$1\n"); + } + } +} + +#------------------------------------------------------------------------------- +# Some simple subroutines to print messages out + +sub message { + my ($message) = @_; + print "$message\n"; +} + +sub verbose_message { + my ($message) = @_; + if ($verbosity >= $print_verbose) { + print "$message\n"; + } +} + +#------------------------------------------------------------------------------- +# Some simple subroutines to do a clean exit, print warning, or a fatal error + +sub exit_message { + my ($message) = @_; + print "${ProgName} : $message\n"; + exit; +} + +#------------------------------------------------------------------------------- + +sub warning { + my ($message) = @_; + my $func_name = (caller(1))[3]; + print "Warning : ${ProgName}::${func_name}() : $message\n"; +} + +#------------------------------------------------------------------------------- + +sub fatal_error { + my ($message) = @_; + my $func_name = (caller(1))[3]; + die "ERROR : ${ProgName}::${func_name}() : $message\n"; +} + +#------------------------------------------------------------------------------- + +sub main { + my %nl_flags; + $nl_flags{'cfgdir'} = dirname(abs_path($0)); + + my %opts = process_commandline(\%nl_flags); + + version($nl_flags{'cfgdir'}) if $opts{'version'}; + set_print_level(\%opts); + + check_for_perl_utils($nl_flags{'cfgdir'}); + my $cfg = read_configure_definition($nl_flags{'cfgdir'}, \%opts); + + my $physv = config_files::clm_phys_vers->new( $cfg->get('phys') ); + my $cesmroot = abs_path( "$nl_flags{'cfgdir'}/../../../"); + my $drvblddir = "$cesmroot/cime/driver_cpl/bld"; + my $definition = read_namelist_definition($drvblddir, \%opts, \%nl_flags, $physv); + my $defaults = read_namelist_defaults($drvblddir, \%opts, \%nl_flags, $cfg, $physv); + + # List valid values if asked for + list_options(\%opts, $definition, $defaults); + + # Validate some of the commandline option values. + validate_options("commandline", $cfg, \%opts); + + # Create an empty namelist object. + my $nl = Build::Namelist->new(); + + check_cesm_inputdata(\%opts, \%nl_flags); + + # Read in the env_*.xml files + my %env_xml = read_envxml_case_files( \%opts ); + + # Process the user inputs + process_namelist_user_input(\%opts, \%nl_flags, $definition, $defaults, $nl, $cfg, \%env_xml, $physv ); + # Get any other defaults needed from the namelist defaults file + process_namelist_inline_logic(\%opts, \%nl_flags, $definition, $defaults, $nl, $cfg, \%env_xml, $physv); + + # Validate that the entire resultant namelist is valid + $definition->validate($nl); + write_output_files(\%opts, \%nl_flags, $defaults, $nl, $physv); + + if ($opts{'inputdata'}) { + check_input_files($nl, $nl_flags{'inputdata_rootdir'}, $opts{'inputdata'}, $definition); + } +} + +#------------------------------------------------------------------------------- + +1; diff --git a/components/clm/bld/README b/components/clm/bld/README new file mode 100644 index 0000000000..1ebdb00901 --- /dev/null +++ b/components/clm/bld/README @@ -0,0 +1,56 @@ +components/clm/bld/README May/26/2011 + +CLM build and configure directory and scripts. Scripts to help +you prepare to build CLM as a component within CESM, and setup +a namelist for it. There is also functionality only used for CLM +stand-alone testing to build and run the complete system (in conjuction +with the scripts in the components/clm/test/system directory). + +Important files/directories: + +--------- Configure and build scripts +--------- (These scripts are also used by the cpl7 scripts) + +configure ---------------- Configure script -- sets up the CPP Macro's needed to be + defined to build CLM + ----- configure --help - Configure help mode -- sends information on all configure options +config_files/config_defaults.xml ----- XML file of defaults for CLM +config_files/config_defaults_*.xml --- XML file of defaults for CLM for a specific site +config_files/config_definition.xml --- XML file definining all CLM configuration items + +--------- Scripts to build the namelists +--------- (These scripts are also used by the cpl7 scripts) +build-namelist --- Build the namelists needed + +--------- Scripts to query namelist defaults +listDefaultNamelist.pl -- List the files needed, for a list of resolutions, + to run CLM that are currently NOT on your machine. + This file can then be used by + scripts/Tools/check_input_data + to retreive them from the inputdata repository. + Setting up cases with create_newcase also does + this -- but only for the exact configuration + given. This tries to get all the files need + for several different resolutions and configurations + at once. +queryDefaultNamelist.pl - Query default namelist for settings of variables +queryDefaultXML.pm ------ Subroutines needed by queryDefaultNamelist.pl script +query-xFail ------------- Queries the xFail file (in unit_testers/xFail/expectedClmTestFails.xml) + + +--------- Test scripts directory +unit_testers --- Directory of scripts to test scipts in this directory + (most notably build-namelist and possibly configure) + +---------- XML Files describing namelists in namelist_files +namelist_files/namelist_defaults_clm4_0.xml ------- List of default values for the clm4_0 namelist +namelist_files/namelist_defaults_clm4_0_tools.xml - List of default values for the clm4_0 tools. +namelist_files/namelist_defaults_clm4_5.xml ------- List of default values for the clm4_5 namelist +namelist_files/namelist_defaults_clm4_5_tools.xml - List of default values for the clm4_5 tools. +namelist_files/namelist_defaults_overall.xml ------ List of default values for overall settings +namelist_files/namelist_defaults_usr_files.xml ---- List of default values for the user-files +namelist_files/namelist_definition_clm4_0.xml ----- Definition of all namelist items for clm4_0 +namelist_files/namelist_definition_clm4_5.xml ----- Definition of all namelist items for clm4_5 +namelist_files/namelist_definition.xsl ------------ Describes how to view the xml file as html +namelist_files/namelist_defaults_drydep.xml ------- List of default values for the dry deposition module. +namelist_files/use_cases -------------------------- Specific configurations that build-namelist uses diff --git a/components/clm/bld/build-namelist b/components/clm/bld/build-namelist new file mode 100755 index 0000000000..46e485d17c --- /dev/null +++ b/components/clm/bld/build-namelist @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# clm build-namelist driver +# +# Placing all of build-namelist into CLMBuildNamelist.pm means we can unit test the module. +# +require 5; + +use strict; + +BEGIN { + # ensure that the cesm create_X scripts can find CLMBuildNamelist.pm + use File::Basename qw(dirname); + use Cwd qw(abs_path); + my $dirname = dirname(abs_path($0)); + my @dirs = ($dirname, ); + unshift @INC, @dirs; +} + +use CLMBuildNamelist qw(main); + +CLMBuildNamelist::main(); diff --git a/components/clm/bld/clm.buildlib b/components/clm/bld/clm.buildlib new file mode 100755 index 0000000000..d7a5069ebf --- /dev/null +++ b/components/clm/bld/clm.buildlib @@ -0,0 +1,57 @@ +#! /usr/bin/env perl +use strict; +use File::Compare; + +if ($#ARGV == -1) { + die " ERROR clm.buildlib: must specify at least a caseroot input argument"; +} +my ($CASEROOT, $bldpath, $phys) = @ARGV; +chdir "$CASEROOT"; + +my $CASEBUILD = `./xmlquery CASEBUILD -value`; +my $CASETOOLS = `./xmlquery CASETOOLS -value`; +my $OBJROOT = `./xmlquery OBJROOT -value`; +my $LIBROOT = `./xmlquery LIBROOT -value`; +my $GMAKE_J = `./xmlquery GMAKE_J -value`; +my $GMAKE = `./xmlquery GMAKE -value`; + +if (! defined($phys)){ + $phys = 'lnd'; + $bldpath = $OBJROOT; +} +chdir "$bldpath/$phys/obj"; + +if (-f "$CASEBUILD/clmconf/Filepath") { + my $sysmod = "cp $CASEBUILD/clmconf/Filepath ./tmp_filepath "; + system($sysmod) == 0 or die "ERROR: clm.buidlib $sysmod failed: $?\n"; +} else { + die "ERROR clm.buildlib - missing $CASEBUILD/clmconf/Filepath"; +} + +foreach my $file ( "Filepath", "CESM_cppdefs" ) { + if (-f "$CASEBUILD/clmconf/$file") { + my $sysmod = "cp $CASEBUILD/clmconf/$file ./tmp_$file"; + system($sysmod) == 0 or die "ERROR: clm.buidlib $sysmod failed: $?\n"; + } else { + die "clm.buildlib ERROR - missing $CASEBUILD/clmconf/$file" + } + if (-f "$file") { + if (compare("tmp_$file", "$file") != 0) { + my $sysmod = "mv -f tmp_$file $file "; + system($sysmod) == 0 or die "ERROR: clm.buidlib $sysmod failed: $?\n"; + } + } else { + my $sysmod = "mv -f tmp_$file $file"; + system($sysmod) == 0 or die "ERROR: clm.buidexe $sysmod failed: $?\n"; + } +} + +my $clmdefs = `cat $CASEBUILD/clmconf/CESM_cppdefs`; +chomp($clmdefs); +my $sysmod = "$GMAKE complib -j ${GMAKE_J} MODEL=clm COMPLIB=${bldpath}/lib/lib${phys}.a USER_CPPDEFS=\"${clmdefs}\" -f ${CASETOOLS}/Makefile"; +system($sysmod) == 0 or die "ERROR: clm.buildlib $sysmod failed: $?\n"; + +exit(0); + + + diff --git a/components/clm/bld/clm.buildnml b/components/clm/bld/clm.buildnml new file mode 100755 index 0000000000..2b249d39d0 --- /dev/null +++ b/components/clm/bld/clm.buildnml @@ -0,0 +1,199 @@ +#! /usr/bin/env perl +use strict; +use Cwd; + +if ($#ARGV == -1) { + die " ERROR clm.buildexe: must specify a caseroot input argument"; +} +my ($CASEROOT) = @ARGV; +chdir "${CASEROOT}"; + +my @dirs = ("$CASEROOT/Tools"); +unshift @INC, @dirs; +require SetupTools; +my $sysmod; + +my $CASEBUILD = `./xmlquery CASEBUILD -value`; +my $CCSM_COMPSET = `./xmlquery CCSM_COMPSET -value`; +my $CCSM_CO2_PPMV = `./xmlquery CCSM_CO2_PPMV -value`; +my $CLM_CO2_TYPE = `./xmlquery CLM_CO2_TYPE -value`; +my $CLM_USRDAT_NAME = `./xmlquery CLM_USRDAT_NAME -value`; +my $CLM_CONFIG_OPTS = `./xmlquery CLM_CONFIG_OPTS -value`; +my $CLM_NAMELIST_OPTS = `./xmlquery CLM_NAMELIST_OPTS -value`; +my $CLM_BLDNML_OPTS = `./xmlquery CLM_BLDNML_OPTS -value`; +my $CLM_NML_USE_CASE = `./xmlquery CLM_NML_USE_CASE -value`; +my $CLM_FORCE_COLDSTART = `./xmlquery CLM_FORCE_COLDSTART -value`; +my $CCSMROOT = `./xmlquery CCSMROOT -value`; +my $COMP_INTERFACE = `./xmlquery COMP_INTERFACE -value`; +my $COMP_GLC = `./xmlquery COMP_GLC -value`; +my $DEBUG = `./xmlquery DEBUG -value`; +my $DIN_LOC_ROOT = `./xmlquery DIN_LOC_ROOT -value`; +my $GLC_NEC = `./xmlquery GLC_NEC -value`; +my $LND_GRID = `./xmlquery LND_GRID -value`; +my $LND_NCPL = `./xmlquery LND_NCPL -value`; +my $LND_DOMAIN_PATH = `./xmlquery LND_DOMAIN_PATH -value`; +my $LND_DOMAIN_FILE = `./xmlquery LND_DOMAIN_FILE -value`; +my $MASK_GRID = `./xmlquery MASK_GRID -value`; +my $NTHRDS_LND = `./xmlquery NTHRDS_LND -value`; +my $NTASKS_LND = `./xmlquery NTASKS_LND -value`; +my $NINST_LND = `./xmlquery NINST_LND -value`; +my $RUNDIR = `./xmlquery RUNDIR -value`; +my $RUN_TYPE = `./xmlquery RUN_TYPE -value`; +my $RUN_STARTDATE = `./xmlquery RUN_STARTDATE -value`; +my $RUN_REFCASE = `./xmlquery RUN_REFCASE -value`; +my $RUN_REFDATE = `./xmlquery RUN_REFDATE -value`; +my $RUN_REFTOD = `./xmlquery RUN_REFTOD -value`; +my $UTILROOT = `./xmlquery UTILROOT -value`; +my $GLC_SMB = `./xmlquery GLC_SMB -value`; + +if (! -d "$CASEBUILD/clmconf" ) { + $sysmod = "mkdir $CASEBUILD/clmconf"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; +} +chdir "$CASEBUILD/clmconf"; + +#-------------------------------------------------------------------- +# Invoke clm configure - output will go in CASEBUILD/clmconf +#-------------------------------------------------------------------- + +my $config_opts; +my $resolution; +my $clmusr; +if ($MASK_GRID ne "reg") { + $config_opts = " "; + $resolution = $LND_GRID; + $clmusr = ""; +} +if (($MASK_GRID eq "reg") && ($LND_GRID ne "CLM_USRDAT" )) { + $config_opts = "-sitespf_pt $LND_GRID"; + $resolution = $LND_GRID ; + $clmusr = ""; +} +if ( $LND_GRID eq "CLM_USRDAT" ) { + $config_opts=" "; + $resolution = $CLM_USRDAT_NAME; + $clmusr = " -clm_usr_name $CLM_USRDAT_NAME"; +} +if ("$CCSM_COMPSET" =~ /1PT.*/ ) { + $config_opts = " -sitespf_pt reg"; +} + +$sysmod = "$CCSMROOT/components/clm/bld/configure"; +$sysmod = "$sysmod $config_opts -comp_intf $COMP_INTERFACE "; +$sysmod = "$sysmod $CLM_CONFIG_OPTS "; +$sysmod = "$sysmod -usr_src $CASEROOT/SourceMods/src.clm"; +system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + +#-------------------------------------------------------------------- +# Invoke clm build-namelist - output will go in $CASEBUILD/clmconf +#-------------------------------------------------------------------- + +my $startfiletype = "finidat"; +my $start_type = "default"; +if ($RUN_TYPE eq "startup" ) { + if ($CLM_FORCE_COLDSTART eq "on") {$start_type = "cold";} +} else { + if ($RUN_TYPE eq "hybrid" ) { + $start_type = "startup"; + } else { + $start_type = $RUN_TYPE; + } +} +if ($RUN_TYPE eq "branch" ) {$startfiletype = "nrevsn";} + +my $inst_string; +my $inst_counter = 1; +while ($inst_counter <= $NINST_LND) { + + # ----------------------------------------------------- + # determine instance string + # ----------------------------------------------------- + + $inst_string = ""; + if ($NINST_LND > 1) { + $inst_string = `printf _%04d $inst_counter`; + + # If multi-instance case does not have restart file, use single-case restart + # for each instance + if ( (! -e "$RUNDIR/rpointer.lnd${inst_string}") && (-e "$RUNDIR/rpointer.lnd") ) { + $sysmod = "cp -v $RUNDIR/rpointer.lnd $RUNDIR/rpointer.lnd${inst_string}"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + } + } + + # ----------------------------------------------------- + # create clmconf/cesm_namelist + # ----------------------------------------------------- + + if ( -e "$CASEBUILD/clm.input_data_list" ) { + $sysmod = "rm $CASEBUILD/clm.input_data_list"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + } + my $clmicfile; + my $clm_startfile; + if (( $RUN_TYPE eq "hybrid") || ($RUN_TYPE eq "branch" )) { + $clm_startfile = "${RUN_REFCASE}.clm2${inst_string}.r.${RUN_REFDATE}-${RUN_REFTOD}.nc"; + if ( -e "$RUNDIR/$clm_startfile") { + $clm_startfile = "$clm_startfile"; + } else { + $clm_startfile = "${RUN_REFCASE}.clm2.r.${RUN_REFDATE}-${RUN_REFTOD}.nc"; + } + $clmicfile = " $startfiletype = \'$clm_startfile\'"; + } + + my $infile_text = ""; + if ($clmicfile) {$infile_text .= "$startfiletype = \'$clm_startfile\' \n"; } + + SetupTools::create_namelist_infile("$CASEROOT", + "$CASEROOT/user_nl_clm${inst_string}", + "$CASEBUILD/clmconf/cesm_namelist", + "$infile_text"); + + # ----------------------------------------------------- + # call build-namelist + # ----------------------------------------------------- + + my $glc_opts = ""; + if ("$COMP_GLC" ne "sglc" ) {$glc_opts = "-glc_present -glc_smb .$GLC_SMB. ";} + + my $usecase = " "; + if ($CLM_NML_USE_CASE ne "UNSET") {$usecase = "-use_case $CLM_NML_USE_CASE";} + + my $start_ymd = `echo $RUN_STARTDATE | sed s/-//g`; + my $ignore = "-ignore_ic_date"; + if (($RUN_STARTDATE =~ /.*-01-01.*/) || ($RUN_STARTDATE =~ /.*-09-01.*/)) { $ignore = "-ignore_ic_year";} + + $sysmod = "$CCSMROOT/components/clm/bld/build-namelist -infile $CASEBUILD/clmconf/cesm_namelist "; + $sysmod = "$sysmod -csmdata $DIN_LOC_ROOT -inputdata $CASEBUILD/clm.input_data_list $ignore"; + $sysmod = "$sysmod -namelist \" \&clm_inparm start_ymd=$start_ymd $CLM_NAMELIST_OPTS \/\""; + $sysmod = "$sysmod $usecase $glc_opts -res $resolution $clmusr -clm_start_type $start_type"; + $sysmod = "$sysmod -envxml_dir $CASEROOT -l_ncpl $LND_NCPL -lnd_frac ${LND_DOMAIN_PATH}/${LND_DOMAIN_FILE}"; + $sysmod = "$sysmod -glc_nec $GLC_NEC -co2_ppmv $CCSM_CO2_PPMV -co2_type $CLM_CO2_TYPE "; + $sysmod = "$sysmod -config $CASEBUILD/clmconf/config_cache.xml $CLM_BLDNML_OPTS"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + + # ----------------------------------------------------- + # move lnd_in to $RUNDIR + # ----------------------------------------------------- + + if ( -d ${RUNDIR} ) { + $sysmod = "cp $CASEBUILD/clmconf/lnd_in ${RUNDIR}/lnd_in${inst_string}"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + + # Only copy drv_flds_in namelist file if one doesn't already exist + if ( ! -f "${RUNDIR}/drv_flds_in" && -f "$CASEBUILD/clmconf/drv_flds_in" ) { + $sysmod = "cp $CASEBUILD/clmconf/drv_flds_in ${RUNDIR}/. >& /dev/null"; + system($sysmod) == 0 or die "ERROR clm.buildnml: $sysmod failed: $?\n"; + } + } + + # ----------------------------------------------------- + # increment instance counter + # ----------------------------------------------------- + + $inst_counter = $inst_counter + 1; +} + +exit (0); + + diff --git a/components/clm/bld/config_files/clm_phys_vers.pm b/components/clm/bld/config_files/clm_phys_vers.pm new file mode 100755 index 0000000000..af6d63a887 --- /dev/null +++ b/components/clm/bld/config_files/clm_phys_vers.pm @@ -0,0 +1,198 @@ +package config_files::clm_phys_vers; +my $pkg_nm = 'config_files::clm_phys_vers'; +#----------------------------------------------------------------------------------------------- +# +# SYNOPSIS +# +# require config_files::clm_phys_vers; +# +# my $phys = config_files::clm_phys_vers->new("clm4_0"); +# print $phys->as_float(); +# print $phys->as_long(); +# print $phys->as_string(); +# print $phys->as_filename(); +# +# DESCRIPTION +# +# Enter the physics version as a string, with a list of valid versions, and have the ability to convert it to +# different formats. +# +# COLLABORATORS: None +# +#----------------------------------------------------------------------------------------------- +# +# Date Author Modification +# 03/06/2014 Erik Kluzek creation +# +#-------------------------------------------------------------------------------------------- + +use strict; +use bigint; +#use warnings; +#use diagnostics; + +my $major_mask = 1000000; +my $minor_mask = 1000; +my @version_strings = ( "clm4_0", "clm4_5", "clm5_0" ); +my @version_long = ( 4*$major_mask, 4*$major_mask+5*$minor_mask, 5*$major_mask ); + +#------------------------------------------------------------------------------- + +sub new { + # Constructor, enter version string as argument + my $class = shift; + my $vers_string = shift; + + my $nm = "$class\:\:new"; + my $self = {}; + bless($self, $class); + $self->__validate_vers__( $vers_string ); + $self->{'vers_string'} = $vers_string; + return( $self ); +} + +#------------------------------------------------------------------------------- + +sub __validate_vers__ { + # Make sure the version string is a valid one + my $class = shift; + my $vers_string = shift; + + my $found = undef; + foreach my $i (0..$#version_strings) { + if ( $vers_string eq $version_strings[$i] ) { + $found = 1; + last; + } + } + if ( ! defined($found) ) { + die "NOT a valid CLM version: $vers_string\n"; + } +} + +#------------------------------------------------------------------------------- + +sub as_long { +# Return the physics version as a long + my $self = shift; + my $vers = shift; + + if ( ! defined($vers) ) { + $vers = $self->{'vers_string'}; + } else { + $self->__validate_vers__( $vers ); + } + my $phys = undef; + for( my $i = 0; $i <= $#version_strings; $i++ ) { + if ( $vers eq $version_strings[$i] ) { + $phys = $version_long[$i]; + last; + } + } + return( $phys ); +} + +#------------------------------------------------------------------------------- + +sub as_float { +# Return the physics version as a float + my $self = shift; + + my $long = $self->as_long(); + my $major = int($long / $major_mask); + my $minor = int(($long - $major*$major_mask)/ $minor_mask); + my $rev = $long - $major*$major_mask - $minor*$minor_mask; + { + no bigint; + use bignum; + + my $phys = $major*1.0 + $minor/10.0 + $rev / 10000.0; + return( $phys ); + } +} + +#------------------------------------------------------------------------------- + +sub as_string { +# Return the physics version as a string + my $self = shift; + + my $phys = $self->{'vers_string'}; + return( $phys ); +} + +#------------------------------------------------------------------------------- + +sub as_filename { +# Return the physics version string with clm4_5 and clm5_0 pointing to the same name + my $self = shift; + + my $phys = undef; + if ( $self->as_long() < 5*$major_mask ) { + $phys = $self->as_string(); + } else { + $phys = "clm4_5"; + } + return( $phys ); +} + +#----------------------------------------------------------------------------------------------- +# Unit testing of above +#----------------------------------------------------------------------------------------------- +if ( ! defined(caller) && $#ARGV == -1 ) { + package phys_vers_unit_tester; + + require Test::More; + Test::More->import( ); + + plan( tests=>13 ); + + sub testit { + print "unit tester\n"; + my %lastv; + my @vers_list = ( "clm4_0", "clm4_5", "clm5_0" ); + foreach my $vers ( @vers_list ) { + my $phys = config_files::clm_phys_vers->new($vers); + isa_ok($phys, "config_files::clm_phys_vers", "created clm_phys_vers object"); + print "$vers: long: ".$phys->as_long()." float: ".$phys->as_float()." string: ".$phys->as_string()." file: ".$phys->as_filename()."\n"; + if ( exists($lastv{"long"}) ) { + is( $phys->as_long() > $lastv{'long'}, 1, "Definition of long is not increasing\n" ); + } + if ( exists($lastv{"float"}) ) { + is( $phys->as_float() > $lastv{'float'}, 1, "Definition of float is not increasing\n" ); + } + # Check that also can get results of any valid value for long + foreach my $chvers ( @vers_list ) { + my $lvalue = $phys->as_long($chvers); + print "Long value of $chvers = $lvalue\n"; + } + # Check that a bad value gives an error + eval { $phys->as_long('xxx'); }; + like( $@, qr/NOT a valid CLM version:/, "check that a bad version fails" ); + # Save last values to make sure increasing + $lastv{'long'} = $phys->as_long(); + $lastv{'float'} = $phys->as_float(); + } + my $phys = config_files::clm_phys_vers->new("clm4_0"); + is( 4.0, $phys->as_float(), "Make sure clm4_0 correct float value" ); + $phys = config_files::clm_phys_vers->new("clm4_5"); + no bigint; + use bignum; + is( 4.5, $phys->as_float(), "Make sure clm4_5 correct float value" ); + no bignum; + use bigint; + $phys = config_files::clm_phys_vers->new("clm5_0"); + is( 5.0, $phys->as_float(), "Make sure clm5_0 correct float value" ); + print "\nSuccessfully ran all tests\n"; + } +} + +#----------------------------------------------------------------------------------------------- +# Determine if you should run the unit test or if this is being called from a require statement +#----------------------------------------------------------------------------------------------- + +if ( defined(caller) ) { + 1 # to make use or require happy +} elsif ( $#ARGV == -1 ) { + &phys_vers_unit_tester::testit(); +} diff --git a/components/clm/bld/config_files/config_defaults.xml b/components/clm/bld/config_files/config_defaults.xml new file mode 100644 index 0000000000..09d5634bb7 --- /dev/null +++ b/components/clm/bld/config_files/config_defaults.xml @@ -0,0 +1,7 @@ + + + + + + + diff --git a/components/clm/bld/config_files/config_defaults_1x1_mexicocityMEX.xml b/components/clm/bld/config_files/config_defaults_1x1_mexicocityMEX.xml new file mode 100644 index 0000000000..660c16715b --- /dev/null +++ b/components/clm/bld/config_files/config_defaults_1x1_mexicocityMEX.xml @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/components/clm/bld/config_files/config_defaults_1x1_numaIA.xml b/components/clm/bld/config_files/config_defaults_1x1_numaIA.xml new file mode 100644 index 0000000000..b4813d0211 --- /dev/null +++ b/components/clm/bld/config_files/config_defaults_1x1_numaIA.xml @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/components/clm/bld/config_files/config_defaults_1x1_smallvilleIA.xml b/components/clm/bld/config_files/config_defaults_1x1_smallvilleIA.xml new file mode 100644 index 0000000000..b4813d0211 --- /dev/null +++ b/components/clm/bld/config_files/config_defaults_1x1_smallvilleIA.xml @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/components/clm/bld/config_files/config_defaults_1x1_vancouverCAN.xml b/components/clm/bld/config_files/config_defaults_1x1_vancouverCAN.xml new file mode 100644 index 0000000000..49d9a54afb --- /dev/null +++ b/components/clm/bld/config_files/config_defaults_1x1_vancouverCAN.xml @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/components/clm/bld/config_files/config_definition.xsl b/components/clm/bld/config_files/config_definition.xsl new file mode 100644 index 0000000000..f2f88609ef --- /dev/null +++ b/components/clm/bld/config_files/config_definition.xsl @@ -0,0 +1,72 @@ + + + + + + + + + + + + + CLM Configuration Definition + + +

CLM Configuration Definition

+ + + + + + + + + + + + +
CLM Physics Configurations
NameValueDescription
Valid Values
+ + + + + + + + + + + + +
CLM Biogeochemistry Configurations
NameValueDescription
Valid Value
+ + + + + + + + + + + + +
Configuration Directories
NameValueDescription
Valid Value
+ + + + + + + + + + + + Valid values: + + + + + diff --git a/components/clm/bld/config_files/config_definition_clm4_0.xml b/components/clm/bld/config_files/config_definition_clm4_0.xml new file mode 100644 index 0000000000..aeb78d387a --- /dev/null +++ b/components/clm/bld/config_files/config_definition_clm4_0.xml @@ -0,0 +1,115 @@ + + + + + + + +Specifies either clm4_0, clm4_5, or clm5_0 physics + + + +CLM 4.0 Only. For CLM 4.5/5.0, spinup is controlled from build-namelist. +Spinup mode for the CN Carbon Nitrogen BGC model + AD turn on accelerated decomposition spinup for CN biogeochemistry model + exit jump from AD spinup mode to normal mode + normal no acceleration of decompositon (i.e. "final spinup") + + + +Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing +(SNICAR_FRC .true.is EXPERIMENTAL NOT SUPPORTED!) + + + +Flag to turn on site specific special configuration flags for supported single +point resolutions. See the specific config_defaults_*.xml file for the special +settings that are set for a particular site. + + + +CLM Biogeochemistry mode + none = Satellite Phenology (SP) + cn = Carbon Nitrogen model (CN) + (or CLM45BGC if phys=clm4_5/clm5_0, vsoilc_centbgc='on', and clm4me='on') + cndv = Carbon Nitrogen with Dynamic Global Vegetation Model (CNDV) + (or CLM45BGCDV if phys=clm4_5/clm5_0, vsoilc_centbgc='on', and clm4me='on') + + +Toggle to turn on the prognostic crop model + + + +Root directory of CLM source distribution (directory above CLM configure). + + + +Component framework interface to use +(Model Coupling Toolkit, or Earth System Modeling Framework) + + + +User source directories to prepend to the filepath. Multiple directories +are specified as a comma separated list with no embedded white space. +Normally this is SourceMods/src.clm in your case. + + + +User specified CPP defines to append to Makefile defaults. +Note: It's recommended to use configure options to set standard CPP values rather +than defining them here. + + + +Maximum number of plant function types (PFT) per gridcell +(Setting maxpft to anything other than 17 (or 25 for clm4_5/clm5_0 CROP or 21 for clm4_0 CROP) +is EXPERIMENTAL AND NOT SUPPORTED!) +(Either 17 for a standard vegetated case or +21 for prognostic clm4_0 CROP or 25 +for prognostic clm4_5/clm5_0 CROP) + + + +Toggle to make wild-fires inactive for biogeochemistry=CN mode + + + +Toggle to turn all history output completely OFF (possibly used for testing) + + + diff --git a/components/clm/bld/config_files/config_definition_clm4_5.xml b/components/clm/bld/config_files/config_definition_clm4_5.xml new file mode 100644 index 0000000000..8f57fd1844 --- /dev/null +++ b/components/clm/bld/config_files/config_definition_clm4_5.xml @@ -0,0 +1,45 @@ + + + + + + + +Specifies either clm4_0, clm4_5, or clm5_0 physics + + + +Root directory of CLM source distribution (directory above CLM configure). + + + +Component framework interface to use +(Model Coupling Toolkit, or Earth System Modeling Framework) + + + +User source directories to prepend to the filepath. Multiple directories +are specified as a comma separated list with no embedded white space. +Normally this is SourceMods/src.clm in your case. + + + +User specified CPP defines to append to Makefile defaults. +Note: It's recommended to use configure options to set standard CPP values rather +than defining them here. + + + diff --git a/components/clm/bld/configure b/components/clm/bld/configure new file mode 100755 index 0000000000..2f45c12f3a --- /dev/null +++ b/components/clm/bld/configure @@ -0,0 +1,739 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# configure +# +# +# This utility allows the CLM user to specify compile-time configuration +# options via a commandline interface. The output from configure is a +# Makefile and a cache file that contains all configuration parameters +# required to produce the Makefile. A subsequent invocation of configure +# can use the cache file as input (via the -defaults argument) to reproduce +# the CLM configuration contained in it. Note that when a cache file is +# used to set default values only the model parameters are used. The +# parameters that are platform dependent (e.g., compiler options, library +# locations, etc) are ignored. +# +# As the build time configurable options of CLM are changed, this script +# must also be changed. Thus configure is maintained under revision +# control in the CLM source tree and it is assumed that only the version of +# configure in the source tree will be used to build CLM. Thus we assume +# that the root of the source tree can be derived from the location of this +# script. +# +#----------------------------------------------------------------------------------------------- + +use strict; +#use warnings; +#use diagnostics; +use Cwd qw(getcwd abs_path); +use English; +use Getopt::Long; +use IO::File; +use IO::Handle; +use File::Copy; + +#----------------------------------------------------------------------------------------------- + +sub usage { + die <). Any value that contains + white-space must be quoted. Long option names may be supplied with either single + or double leading dashes. A consequence of this is that single letter options may + NOT be bundled. + + -bgc Build CLM with BGC package [ none | cn | cndv ] + (default is none). + -cache Name of output cache file (default: config_cache.xml). + -cachedir Name of directory where output cache file is written + (default: CLM build directory). + -clm_root Root directory of clm source code + (default: directory above location of this script) + -cppdefs A string of user specified CPP defines. Appended to + Makefile defaults. e.g. -cppdefs '-DVAR1 -DVAR2' + -crop Toggle for prognostic crop model. [on | off] (default is off) + (can ONLY be turned on when BGC type is CN or CNDV) + -comp_intf Component interface to use (ESMF or MCT) (default MCT) + -defaults Specify full path to a configuration file which will be used + to supply defaults instead of the defaults in bld/config_files. + This file is used to specify model configuration parameters only. + Parameters relating to the build which are system dependent will + be ignored. + -help [or -h] Print usage to STDOUT. + -nofire Turn off wildfires for BGC setting of CN + (default includes fire for CN) + -noio Turn history output completely off (typically for testing). + -phys Value of clm4_0, clm4_5, or clm5_0 (default is clm4_0) + -silent [or -s] Turns on silent mode - only fatal messages issued. + -sitespf_pt Setup for the given site specific single-point resolution. + -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] + (default is off) + -spinup CLM 4.0 Only. For CLM 4.5, spinup is controlled from build-namelist. + Turn on given spinup mode for BGC setting of CN (level) + AD Turn on Accelerated Decomposition from (2) + bare-soil + exit Jump directly from AD spinup to normal mode (1) + normal Normal decomposition ("final spinup mode") (0) + (default) + The recommended sequence is 2-1-0 + -usr_src [,[,[...]]] + Directories containing user source code. + -verbose [or -v] Turn on verbose echoing of settings made by configure. + -version Echo the SVN tag name used to check out this CLM distribution. +EOF +} + +#----------------------------------------------------------------------------------------------- +# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging. It forces the test +# descriptions to be printed to STDOUT before the error messages start. + +*STDOUT->autoflush(); + +#----------------------------------------------------------------------------------------------- +# Set the directory that contains the CLM configuration scripts. If the configure command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script is in + # the user's PATH +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +if ($ProgDir) { + $cfgdir = abs_path($ProgDir); +} else { + $cfgdir = $cwd; +} + +#----------------------------------------------------------------------------------------------- +# Save commandline +my $commandline = "$cfgdir/configure @ARGV"; + +#----------------------------------------------------------------------------------------------- +# Parse command-line options. +my %opts = ( + cache => "config_cache.xml", + phys => "clm4_0", + nofire => undef, + noio => undef, + clm_root => undef, + spinup => "normal", + ); +GetOptions( + "spinup=s" => \$opts{'spinup'}, + "bgc=s" => \$opts{'bgc'}, + "cache=s" => \$opts{'cache'}, + "cachedir=s" => \$opts{'cachedir'}, + "snicar_frc=s" => \$opts{'snicar_frc'}, + "clm_root=s" => \$opts{'clm_root'}, + "cppdefs=s" => \$opts{'cppdefs'}, + "comp_intf=s" => \$opts{'comp_intf'}, + "defaults=s" => \$opts{'defaults'}, + "clm4me=s" => \$opts{'clm4me'}, + "h|help" => \$opts{'help'}, + "nofire" => \$opts{'nofire'}, + "noio" => \$opts{'noio'}, + "phys=s" => \$opts{'phys'}, + "snicar_frc=s" => \$opts{'snicar_frc'}, + "s|silent" => \$opts{'silent'}, + "sitespf_pt=s" => \$opts{'sitespf_pt'}, + "usr_src=s" => \$opts{'usr_src'}, + "v|verbose" => \$opts{'verbose'}, + "version" => \$opts{'version'}, + "crop=s" => \$opts{'crop'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Echo version info. +version($cfgdir) if $opts{'version'}; + +# Check for unparsed arguments +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +# Define 3 print levels: +# 0 - only issue fatal error messages +# 1 - only informs what files are created (default) +# 2 - verbose +my $print = 1; +if ($opts{'silent'}) { $print = 0; } +if ($opts{'verbose'}) { $print = 2; } +my $eol = "\n"; + +my %cfg = (); # build configuration + +#----------------------------------------------------------------------------------------------- +# Make sure we can find required perl modules and configuration files. +# Look for them in the directory that contains the configure script. + +my $cesmroot = abs_path( "$cfgdir/../../../"); +my $casecfgdir = "$cesmroot/cime/scripts/Tools"; +my $perl5lib = "$cesmroot/cime/utils/perl5lib/"; + +# The Build::Config module provides utilities to store and manipulate the configuration. +my $file = "$perl5lib/Build/Config.pm"; +(-f "$file") or die <<"EOF"; +** Cannot find perl module \"Build/Config.pm\" in path + \"$file\" ** +EOF +#----------------------------------------------------------------------------------------------- +# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules +my @dirs = ( $cfgdir, "$perl5lib", $casecfgdir); +unshift @INC, @dirs; +require Build::Config; +require config_files::clm_phys_vers; + +# Get the physics version +my $phys = config_files::clm_phys_vers->new($opts{'phys'}); + +# Check for the physics specific configuration definition file. +my $phys_string = $phys->as_filename(); + +my $config_def_file = "config_definition_$phys_string.xml"; +(-f "$cfgdir/config_files/$config_def_file") or die <<"EOF"; +** Cannot find configuration definition file \"$config_def_file\" in directory + \"$cfgdir/config_files\" ** +EOF + +# The configuration defaults file modifies the generic defaults in the configuration +# definition file. Note that the -defaults option has precedence over all other options. +my $config_defaults_file; +my $std_config_defaults_file = "$cfgdir/config_files/config_defaults.xml"; +if ($opts{'defaults'}) { + $config_defaults_file = $opts{'defaults'}; +} elsif (defined($opts{'sitespf_pt'}) and $phys->as_long() == $phys->as_long( "clm4_0" ) ) { + $config_defaults_file = "$cfgdir/config_files/config_defaults_$opts{'sitespf_pt'}.xml"; + if ( ! -f $config_defaults_file ) { + $config_defaults_file = "$std_config_defaults_file"; + } +} else { + $config_defaults_file = "$std_config_defaults_file"; +} +(-f "$config_defaults_file") or die <<"EOF"; +** Cannot find configuration defaults file \"$config_defaults_file\" ** +EOF + +if ($print>=2) { print "Setting CLM configuration script directory to $cfgdir$eol"; } +if ($print>=2) { print "Using configuration defaults file $config_defaults_file$eol"; } + +# Initialize the configuration. The $config_def_file provides the definition of a CLM +# configuration, and the $config_defaults_file provides default values for a specific CLM +# configuration. $cfg_ref is a reference to the new configuration object. +my $cfg_ref = Build::Config->new("$cfgdir/config_files/$config_def_file", + "$config_defaults_file"); + +#----------------------------------------------------------------------------------------------- +# CLM root directory. +my $clm_root; + +if ( ! defined($opts{'clm_root'} ) ) { + $clm_root = abs_path("$cfgdir/.."); +} else { + $clm_root = $opts{'clm_root'}; +} + +if ( &is_valid_directory( "$clm_root/src", allowEnv=>0 ) ) { + $cfg_ref->set('clm_root', $clm_root); +} else { + die <<"EOF"; +** Invalid CLM root directory: $clm_root +** +** The CLM root directory must contain the subdirectory /src/. +** clm_root can be entered on the command line or it will be derived +** from the location of this script. +EOF +} + +if ($print>=2) { print "Setting CLM root directory to $clm_root$eol"; } + +#----------------------------------------------------------------------------------------------- +# CLM build directory is current directory +my $clm_bld = `pwd`; +chomp( $clm_bld ); + +# Make sure directory is valid +if ( ! &is_valid_directory( $clm_bld ) and ! mkdirp($clm_bld)) { + die <<"EOF"; +** Could not create the specified CLM build directory: $clm_bld +EOF +} + +if ($print>=2) { print "Setting CLM build directory to $clm_bld$eol"; } + +#----------------------------------------------------------------------------------------------- +# User source directories. +my $usr_src = ''; +if (defined $opts{'usr_src'}) { + my @dirs = split ',', $opts{'usr_src'}; + my @adirs; + while ( my $dir = shift @dirs ) { + if (&is_valid_directory( "$dir", allowEnv=>0 ) ) { + push @adirs, $dir; + } else { + die "** User source directory does not exist: $dir\n"; + } + } + $usr_src = join ',', @adirs; + $cfg_ref->set('usr_src', $usr_src); +} + +if ($print>=2) { print "Setting user source directories to $usr_src$eol"; } + +#----------------------------------------------------------------------------------------------- +# configuration cache directory and file. +my $config_cache_dir; +my $config_cache_file; +if (defined $opts{'cachedir'}) { + $config_cache_dir = abs_path($opts{'cachedir'}); +} +else { + $config_cache_dir = $clm_bld; +} + +if (&is_valid_directory( $config_cache_dir, allowEnv=>0 ) or mkdirp($config_cache_dir)) { + $config_cache_file = "$config_cache_dir/$opts{'cache'}"; +} else { + die <<"EOF"; +** Could not create the specified directory for configuration cache file: $config_cache_dir +EOF +} + +if ($print>=2) { print "The configuration cache file will be created in $config_cache_file$eol"; } + + +#----------------------------------------------------------------------------------------------- +# physics + +$cfg_ref->set('phys', $opts{'phys'}); +my $phys_string = $phys->as_string(); +if ($print>=2) { + if( defined($opts{'phys'}) ) { + print "Using version $phys_string physics.$eol"; + } +} + +#----------------------------------------------------------------------------------------------- +# supported single point configurations +my $sitespf_pt = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if( defined($opts{'sitespf_pt'}) ) { + $cfg_ref->set('sitespf_pt', $opts{'sitespf_pt'}); + } + $sitespf_pt = $cfg_ref->get('sitespf_pt'); + if ($print>=2) { + if( defined($opts{'sitespf_pt'}) ) { + print "Using $sitespf_pt for supported single point configuration.$eol"; + } + } +} + +#----------------------------------------------------------------------------------------------- +# NOIO option +my $noio = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'noio'}) { + $cfg_ref->set('noio', "on" ); + } + $noio = $cfg_ref->get('noio'); + if ($print>=2) { + if ( $noio eq "on") { print "ALL history output is turned OFF.$eol"; } + } +} +#----------------------------------------------------------------------------------------------- +# BGC option +my $bgc_mode = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'bgc'}) { + $cfg_ref->set('bgc', $opts{'bgc'}); + } + $bgc_mode = $cfg_ref->get('bgc'); + if ($print>=2) { print "Using $bgc_mode for bgc.$eol"; } + if ( $bgc_mode eq "casa" ) { + print "Warning:: bgc=casa is NOT validated / scientifically supported.$eol"; + } +} + +# NOFIRE option -- currently only in bgc=CN +my $nofire = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'nofire'}) { + $cfg_ref->set('nofire', "on" ); + } + $nofire = $cfg_ref->get('nofire'); + if ( ($nofire eq "on") && ($bgc_mode ne "cn") ) { + die <<"EOF"; +** Cannot turn nofire mode on -- without cn for bgc mode** +EOF + } + if ($print>=2 && $bgc_mode =~ /^cn/ ) { + if ( $nofire eq "off") { print "Wildfires are active as normal.$eol"; } + else { print "Wildfires are turned off.$eol"; } + } +} + +#----------------------------------------------------------------------------------------------- +# SPINUP option for BGC/CN mode only +my $spinup = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'spinup'}) { + $cfg_ref->set('spinup', $opts{'spinup'}); + } + $spinup = $cfg_ref->get('spinup'); + if ( ($spinup ne "normal" ) && ($bgc_mode ne "cn") ) { + die <<"EOF"; +** Cannot turn spinup mode on -- without cn for bgc mode** +** +** Set the bgc mode by the following means from highest to lowest precedence: +** * by the command-line option -bgc cn +** * by a default configuration file, specified by -defaults +EOF + } + if ($print>=2) { print "Using $spinup for spinup for cn mode.$eol"; } +} else { + if ($opts{'spinup'} ne "normal") { + die <<"EOF"; +** Spinup mode can only be controlled with configure for CLM 4.0. +** For CLM 4.5 use the bgc_spinup option to build-namelist +EOF + } +} + +#----------------------------------------------------------------------------------------------- +# comp_intf option +if (defined $opts{'comp_intf'}) { + $cfg_ref->set('comp_intf', $opts{'comp_intf'}); +} +my $comp_intf = $cfg_ref->get('comp_intf'); +if ($print>=2) { print "Using $comp_intf for comp_intf.$eol"; } + + +#----------------------------------------------------------------------------------------------- +# CROP option +my $crpmode = undef; +my $crop = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'crop'}) { + $cfg_ref->set('crop', $opts{'crop'}); + } + $crpmode = "nocrop"; + $crop = $cfg_ref->get('crop'); + if ( $crop eq "on" ) { + $crpmode = "crop"; + } + if ( ($crop eq "on" ) && ($bgc_mode ne "cn") && ($bgc_mode ne "cndv") ) { + die <<"EOF"; +** Cannot turn crop mode on -- without some form of cn for bgc mode** +** +** Set the bgc mode by the following means from highest to lowest precedence: +** * by the command-line options -bgc cn +** * by a default configuration file, specified by -defaults +EOF + } +} + +#----------------------------------------------------------------------------------------------- +# MAXPFT option + +my %maxpatchpft; +my $maxpft = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + $maxpatchpft{'crop'} = 21; + $maxpatchpft{'nocrop'} = 17; + + $cfg_ref->set('maxpft', $maxpatchpft{$crpmode} ); + $maxpft = $cfg_ref->get('maxpft'); + if ( (($bgc_mode eq "cn") || ($bgc_mode eq "cndv")) && ($maxpft != $maxpatchpft{$crpmode}) ) { + die <<"EOF"; +** For CN or CNDV BGC mode you MUST set max patch PFT's to $maxpatchpft{$crpmode} +** +** When the crop model is on then it must be set to $maxpatchpft{'crop'} otherwise to $maxpatchpft{'nocrop'} +** Set the bgc mode, crop and maxpft by the following means from highest to lowest precedence: +** * by the command-line options -bgc, -crop and -maxpft +** * by a default configuration file, specified by -defaults +** +EOF + } + if ( $maxpft > $maxpatchpft{$crpmode} ) { + die <<"EOF"; +** Max patch PFT's can NOT exceed $maxpatchpft{$crpmode} +** +** Set maxpft by the following means from highest to lowest precedence: +** * by the command-line options -maxpft +** * by a default configuration file, specified by -defaults +** +EOF + } + if ( $maxpft != $maxpatchpft{$crpmode} ) { + print "Warning:: running with maxpft NOT equal to $maxpatchpft{$crpmode} is " . + "NOT validated / scientifically supported.$eol"; + } + if ($print>=2) { print "Using $maxpft for maxpft.$eol"; } +} +#----------------------------------------------------------------------------------------------- +# SNICAR_FRC option +my $snicar_frc = undef; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + if (defined $opts{'snicar_frc'}) { + $cfg_ref->set('snicar_frc', $opts{'snicar_frc'}); + } + $snicar_frc = $cfg_ref->get('snicar_frc'); + if ($print>=2) { print "Using $snicar_frc for snicar_frc.$eol"; } +} + +#----------------------------------------------------------------------------------------------- +# Makefile configuration ####################################################################### +#----------------------------------------------------------------------------------------------- + +#----------------------------------------------------------------------------------------------- +# Name of CLM executable. +my $clm_exe = "clm"; + +if ($print>=2) { print "Name of CLM executable: $clm_exe.$eol"; } + +#----------------------------------------------------------------------------------------------- +# For the CPP tokens, start with the defaults (from defaults file) and append the specifications +# from the commandline. That way the user can override defaults since the commandline versions +# occur last. +my $usr_cppdefs = $cfg_ref->get('cppdefs'); +if (defined $opts{'cppdefs'}) { + $usr_cppdefs .= " $opts{'cppdefs'}"; + print "Warning:: running with user defined cppdefs is NOT validated / " . + "scientifically supported.$eol"; +} +$cfg_ref->set('cppdefs', $usr_cppdefs); + +if ($usr_cppdefs and $print>=2) { print "Default and user CPP definitions: \'$usr_cppdefs\'$eol";} + +# The following CPP macro definitions are used to implement the compile-time options. They are +# determined by the configuration parameters that have been set above. They will be appended to +# the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. +my $cfg_cppdefs = ''; +if ($phys->as_long() == $phys->as_long("clm4_0") ) { + $cfg_cppdefs .= " -DMAXPATCH_PFT=$maxpft"; + + if ($bgc_mode eq 'cn') { + $cfg_cppdefs .= " -DCN"; + } + if ($crop eq 'on') { + $cfg_cppdefs .= " -DCROP"; + } + if ($bgc_mode eq 'cndv') { + $cfg_cppdefs .= " -DCNDV -DCN"; + } + if ($nofire eq 'on') { + $cfg_cppdefs .= " -DNOFIRE"; + } + if ($noio eq 'on') { + $cfg_cppdefs .= " -D_NOIO"; + } + if ($spinup eq 'AD') { + $cfg_cppdefs .= " -DAD_SPINUP"; + } elsif ($spinup eq 'exit') { + $cfg_cppdefs .= " -DEXIT_SPINUP"; + } + if ( $snicar_frc eq 'on' ) { + $cfg_cppdefs .= " -DSNICAR_FRC"; + } +} elsif ($phys->as_long() >= $phys->as_long("clm4_5") ) { + # clm4_5 cppdefs -- SHOULD NOT BE ANY! + if ( $cfg_cppdefs ne '' ) { + die <<"EOF"; +** CPP definitions should be empty for clm5_0 and is NOT ** +EOF + } +} elsif ($phys->as_long() == $phys->as_long("clm5_0") ) { + # clm5_0 cppdefs -- SHOULD NOT BE ANY! + if ( $cfg_cppdefs ne '' ) { + die <<"EOF"; +** CPP definitions should be empty for clm5_0 and is NOT ** +EOF + } +} else { + # this should NOT happen + die <<"EOF"; +** Bad CLM physics version ** +EOF +} +# CPP defines to put on Makefile +my $make_cppdefs = "$usr_cppdefs $cfg_cppdefs"; + +if ($print>=2) { print "CPP definitions set by configure: \'$cfg_cppdefs\'$eol"; } + +#----------------------------------------------------------------------------------------------- +# Write configuration files #################################################################### +#----------------------------------------------------------------------------------------------- + +my $fp_filename = 'Filepath'; # name of output filepath file +my $cpp_filename = 'CESM_cppdefs'; # name of output file for clm's cppdefs in cesm + +# Write the filepath file for cesm. +write_filepath_cesmbld("$clm_bld/$fp_filename", $cfg_ref, $phys, allowEnv=>0 ); +if ($print>=2) { print "creating $clm_bld/$fp_filename\n"; } + +# Write the file for clm's cppdefs needed in cesm. +write_cppdefs("$clm_bld/$cpp_filename", $make_cppdefs); +if ($print>=2) { print "creating $clm_bld/$cpp_filename\n"; } + +# Write the configuration file. +$cfg_ref->write_file($config_cache_file, $commandline); +if ($print>=2) { print "creating $config_cache_file\n"; } + +#----------------------------------------------------------------------------------------------- +# Done +chdir( $cwd ) || die <<"EOF"; +** Trouble changing directory back to $cwd +** +EOF +if ($print) { print "CLM configure done.\n"; } +exit; + +#----------------------------------------------------------------------------------------------- +# FINISHED #################################################################################### +#----------------------------------------------------------------------------------------------- + +#------------------------------------------------------------------------------- + +sub write_filepath_cesmbld +{ + my ($file, $cfg_ref, $phys, %opts) = @_; + my $fh = new IO::File; + + $fh->open(">$file") or die "** can't open filepath file: $file\n"; + + # configuration parameters used to determine paths + my $usr_src = $cfg_ref->get('usr_src'); + my $clm_root = $cfg_ref->get('clm_root'); + + # User specified source directories. + if ($usr_src =~ /\S+/) { + my @dirs = split ',', $usr_src; + while ( my $dir = shift @dirs ) { + print $fh "$dir\n"; + } + } else { + print $fh "../SourceMods/src.clm\n"; + } + + if ($phys->as_long() == $phys->as_long("clm4_0") ) { + # source root + my $srcdir = "$clm_root/src_clm40"; + if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; } + + # source directories under root + my @dirs = ( "main", "biogeophys", "biogeochem" ); + foreach my $dir ( @dirs ) { + if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) { + print $fh "$srcdir/$dir\n"; + } else { + die "** source directory does not exist: $srcdir/$dir\n"; + } + } + } else { + # source root + my $srcdir = "$clm_root/src"; + if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; } + + # source directories under root + my @dirs = ( "main", + "biogeophys", + "biogeochem", + "soilbiogeochem", + "dyn_subgrid", + "ED", + "ED/main", + "ED/biogeophys", + "ED/biogeochem", + "ED/fire", + "utils", + "cpl" ); + + foreach my $dir ( @dirs ) { + if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) { + print $fh "$srcdir/$dir\n"; + } else { + die "** source directory does not exist: $srcdir/$dir\n"; + } + } + } + + + $fh->close; +} +#------------------------------------------------------------------------------- + +sub write_cppdefs +{ + my ($file, $make_cppdefs) = @_; + my $fh = new IO::File; + + $fh->open(">$file") or die "** can't open cpp defs file: $file\n"; + + print $fh "$make_cppdefs\n"; + $fh->close; +} + +#------------------------------------------------------------------------------- + +sub mkdirp { + my ($dir) = @_; + my (@dirs) = split /\//, $dir; + my (@subdirs, $path); + + # if $dir is absolute pathname then @dirs will start with "" + if ($dirs[0] eq "") { push @subdirs, shift @dirs; } + + while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't + push @subdirs, shift @dirs; + $path = join '/', @subdirs; + unless (-d $path or mkdir($path, 0777)) { return 0; } + } + return 1; +} + +#------------------------------------------------------------------------------- + +sub version { +# The version is found in CLM's ChangeLog file. +# $cfgdir is set by the configure script to the name of its directory. + + my ($cfgdir) = @_; + + my $logfile = "$cfgdir/../doc/ChangeLog"; + + my $fh = IO::File->new($logfile, '<') or die "** can't open ChangeLog file: $logfile\n"; + + while (my $line = <$fh>) { + + if ($line =~ /^Tag name:\s*[clm0-9_.-]*\s*[toin]*\s*([cesmclm0-9_.-]+)$/ ) { + print "$1\n"; + exit; + } + } + +} + +#------------------------------------------------------------------------------- + +sub is_valid_directory { +# +# Validate that the input is a valid existing directory. +# + my ($dir, %opts) = @_; + my $nm = "is_valid_directory"; + + my $valid = 0; + if ( -d $dir ) { $valid = 1; } + return( $valid ); + +} + diff --git a/components/clm/bld/env_run.xml b/components/clm/bld/env_run.xml new file mode 100644 index 0000000000..8bf59d0911 --- /dev/null +++ b/components/clm/bld/env_run.xml @@ -0,0 +1,13 @@ + + + + + + + + + diff --git a/components/clm/bld/listDefaultNamelist.pl b/components/clm/bld/listDefaultNamelist.pl new file mode 100755 index 0000000000..a4669880d8 --- /dev/null +++ b/components/clm/bld/listDefaultNamelist.pl @@ -0,0 +1,368 @@ +#!/usr/bin/env perl +#======================================================================= +# +# This is a script to list the missing files in your CESM inputdata area +# for a list of resolutions and model configurations. The list goes +# out to the file: clm.input_data_list. The check_input_data script +# can then be used to get this list of files from the SVN inputdata +# repository. +# +# Usage: +# +# listDefaultNamelist.pl [options] +# +# To get help on options and usage: +# +# listDefaultNamelist.pl -help +# +# To then get the files from the CESM SVN repository: +# +# ../../cime/scripts/Tools/check_input_data -datalistdir . -export +# +#======================================================================= + +use strict; +use Cwd qw(getcwd abs_path); +use Getopt::Long; +use English; +#use diagnostics; + +#----------------------------------------------------------------------------------------------- + +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +my $cwd = getcwd(); # current working directory +my $cfgdir; + +my $printTimes = 0; + +if ($ProgDir) { $cfgdir = $ProgDir; } +else { $cfgdir = $cwd; } + +#----------------------------------------------------------------------------------------------- +# Add $cfgdir to the list of paths that Perl searches for modules + +my @dirs = ( "$cfgdir", "../../../cime/utils/perl5lib" ); +unshift @INC, @dirs; + +require queryDefaultXML; + +# Defaults +my $cesmroot = abs_path( "$cfgdir/../../../"); +my $datmblddir = "$cesmroot/cime/components/data_comps/datm/bld"; +my $drvblddir = "$cesmroot/cime/driver_cpl/bld"; + +# The namelist defaults file contains default values for all required namelist variables. +my @nl_defaults_files = ( "$cfgdir/namelist_files/namelist_defaults_overall.xml", + "$drvblddir/namelist_files/namelist_defaults_drv.xml", + "$datmblddir/namelist_files/namelist_defaults_datm.xml" ); +my $list = "clm.input_data_list"; +my %list_of_all_files; + +sub usage { + die < undef, + silent => undef, + csmdata => "default", + list => $list, + usrdat => undef, + help => undef, + phys => "clm4_0", + ); + + my $cmdline = "@ARGV"; + GetOptions( + "d|csmdata=s" => \$opts{'csmdata'}, + "r|res=s" => \$opts{'res'}, + "s|silent" => \$opts{'silent'}, + "u|usrdat=s" => \$opts{'usrdat'}, + "h|elp" => \$opts{'help'}, + "phys=s" => \$opts{'phys'}, + ) or usage(); + + # Check for unparsed arguments + if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); + } + if ( $opts{'help'} ) { + usage(); + } + # Set if should do extra printing or not (if silent mode is not set) + my $printing = 1; + if ( defined($opts{'silent'}) ) { + $printing = 0; + } + # + # Check for required arguments + # + foreach my $req ( "res", "list" ) { + if ( ! defined($opts{$req}) ) { + print "ERROR: $req NOT set and it is a required argument\n"; + usage(); + } + } + my %inputopts; + my $datmblddir = "$cfgdir/../../../cime/components/data_comps/datm/bld"; + my @nl_definition_files = ( + "$datmblddir/namelist_files/namelist_definition_datm.xml", + "$cfgdir/namelist_files/namelist_definition_$opts{'phys'}.xml" + ); + $inputopts{'nldef_files'} = \@nl_definition_files; + $inputopts{'empty_cfg_file'} = "$cfgdir/config_files/config_definition_$opts{'phys'}.xml"; + + my $definition = Build::NamelistDefinition->new( $nl_definition_files[0] ); + foreach my $nl_defin_file ( @nl_definition_files ) { + $definition->add( "$nl_defin_file" ); + } + my $cfg = Build::Config->new( $inputopts{'empty_cfg_file'} ); + + # Resolutions... + my @resolutions; + if ( $opts{'res'} eq "all" ) { + @resolutions = $definition->get_valid_values( "res", 'noquotes'=>1 ); + } else { + @resolutions = split( /,/, $opts{'res'} ); + } + + # Input options + push @nl_defaults_files, "$cfgdir/namelist_files/namelist_defaults_$opts{'phys'}.xml"; + if ( defined($opts{'usrdat'}) ) { + push @nl_defaults_files, "$cfgdir/namelist_files/namelist_defaults_usr_files.xml"; + } + $inputopts{'files'} = \@nl_defaults_files; + $inputopts{'printing'} = $printing; + $inputopts{'ProgName'} = $ProgName; + $inputopts{'cmdline'} = $cmdline; + $inputopts{'cfgdir'} = $cfgdir; + if ( $opts{'csmdata'} eq "default" && $ENV{'CSMDATA'} ne "" ) { + $opts{'csmdata'} = $ENV{'CSMDATA'}; + } + $inputopts{'csmdata'} = $opts{'csmdata'}; + $inputopts{'config'} = "noconfig"; + my %files; + # + # Loop over all resolutions asked for: 1.9x2.5, 10x15, 64x128 etc. + # + foreach my $res ( @resolutions ) { + if ( ! $definition->is_valid_value( "res", "'$res'" ) && $res ne $opts{'usrdat'} ) { + die "ERROR: Input resolution: $res is NOT a valid resolution\n"; + } + $inputopts{'hgrid'} = $res; + print "Resolution = $res\n" if $printing; + my %settings; + if ( $res eq $opts{'usrdat'} ) { + $settings{'clm_usr_name'} = $opts{'usrdat'}; + $settings{'csmdata'} = $opts{'csmdata'}; + $settings{'notest'} = 1; + } + # + # Loop for all possible land masks: USGS, gx1v6, gx3v5 etc. + # + foreach my $mask ( $definition->get_valid_values( "mask", 'noquotes'=>1 ) ) { + print "Mask = $mask \n" if $printing; + $settings{'mask'} = $mask; + # + # Loop over all possible simulation year: 1890, 2000, 2100 etc. + # + $settings{'sim_year_range'} = "constant"; + my @rcps = $definition->get_valid_values( "rcp", 'noquotes'=>1 ); + $settings{'rcp'} = $rcps[0]; +YEAR: foreach my $sim_year ( $definition->get_valid_values( "sim_year", 'noquotes'=>1 ) ) { + print "sim_year = $sim_year\n" if $printing; + $settings{'sim_year'} = $sim_year; + if ( $sim_year ne 1850 && $sim_year ne 2000 && $sim_year > 1800 ) { next YEAR; } + + my @bgcsettings = $cfg->get_valid_values( "bgc" ); + #my @glc_meclasses = $cfg->get_valid_values( "glc_nec" ); + my @glc_meclasses = ( 0, 10 ); + print "glc_nec = @glc_meclasses bgc=@bgcsettings\n" if $printing; + # + # Loop over all possible BGC settings + # + my $phys = $opts{'phys'}; + foreach my $bgc ( @bgcsettings ) { + $settings{'bgc'} = $bgc; + my @crop_vals; + if ( $bgc =~ /^cn/ ) { + @crop_vals = ( "on", "off" ); + } else { + @crop_vals = ( "off" ); + } + # + # Loop over all possible glc_nec settings + # + foreach my $glc_nec ( @glc_meclasses ) { + $settings{'glc_nec'} = $glc_nec; + # + # Loop over all possible crop settings + # + foreach my $crop ( @crop_vals ) { + $settings{'crop'} = $crop; + if ( $crop eq "on" ) { + if ($phys eq "clm4_0") { + $settings{'maxpft'} = 21; + } else { + $settings{'maxpft'} = 25; + } + } else { + $settings{'maxpft'} = 17; + } + my @irrigset; + if ( $glc_nec == 0 && $sim_year == 2000 ) { + @irrigset= ( ".true.", ".false." ); + } else { + @irrigset= ( ".false." ); + } + # + # Loop over irrigation settings + # + foreach my $irrig ( @irrigset ) { + $settings{'irrig'} = $irrig; + $inputopts{'namelist'} = "clm_inparm"; + &GetListofNeededFiles( \%inputopts, \%settings, \%files ); + if ( $printTimes >= 1 ) { + $inputopts{'printing'} = 0; + } + } + } + } + } + } + # + # Now do sim-year ranges + # + $settings{'bgc'} = "cn"; + $settings{'irrig'} = ".false."; + $inputopts{'namelist'} = "clm_inparm"; + foreach my $sim_year_range ( $definition->get_valid_values( "sim_year_range", 'noquotes'=>1 ) ) { + $settings{'sim_year_range'} = $sim_year_range; + if ( $sim_year_range =~ /([0-9]+)-([0-9]+)/ ) { + $settings{'sim_year'} = $1; + } + # + # Loop over all possible rcp's + # + print "sim_year_range=$sim_year_range rcp=@rcps\n" if $printing; + foreach my $rcp ( @rcps ) { + $settings{'rcp'} = $rcp; + &GetListofNeededFiles( \%inputopts, \%settings, \%files ); + if ( $printTimes >= 1 ) { + $inputopts{'printing'} = 0; + } + } + } + } + } + # + # Loop over directories that need to have files copied into + # + my $hostname; + my $csmdata = $inputopts{'csmdata'}; + open( OUT, ">$list" ) || die "ERROR: trouble opening output file: $list"; + foreach my $dir ( sort(keys(%files)) ) { + if ( $dir eq "." ) { next; } + if ( $dir eq "/" ) { next; } + if ( $dir eq "\n" ) { next; } + if ( $dir eq "" ) { next; } + if ( ! defined($dir) ) { next; } + my $files_ref = $files{$dir}; + my @files = @$files_ref; + foreach my $file ( @files ) { + if ( $file !~ /\n$/ ) { $file = "$file\n"; } + print OUT "file = \$DIN_LOC_ROOT/$file"; + } + } + close( OUT ); + if ( $printing ) { + print "\n\nSuccessful\n\n" + } diff --git a/components/clm/bld/namelist_files/checkmapfiles.ncl b/components/clm/bld/namelist_files/checkmapfiles.ncl new file mode 100644 index 0000000000..79b892a887 --- /dev/null +++ b/components/clm/bld/namelist_files/checkmapfiles.ncl @@ -0,0 +1,236 @@ +; +; Check that the *_b values are the same between the mapping files +; at the same output resolution. +; +; Erik Kluzek +; Nov/18/2011 +; $Id: checkmapfiles.ncl 69990 2015-04-14 16:21:07Z erik $ +; $HeadURL; +; + + print( "Check that datm mapping files are consistent" ); + resolutions = (/ "128x256", "64x128", "48x96", "32x64", "8x16", "94x192", "0.23x0.31", "0.47x0.63", "0.9x1.25", "1.9x2.5", "2.5x3.33", "4x5", "10x15", "5x5_amazon", "1x1_tropicAtl", "1x1_camdenNJ", "1x1_vancouverCAN", "1x1_mexicocityMEX", "1x1_asphaltjungleNJ", "1x1_brazil", "1x1_urbanc_alpha", "1x1_numaIA", "1x1_smallvilleIA", "ne4np4", "ne16np4", "ne30np4", "ne60np4", "ne120np4", "ne240np4" /); + + space = " "; + badres = 0 + badresolutions = new( (/ 1000 /), string ) + chkres = 0 + chkresolutions = new( (/ 1000 /), string ) + +procedure checkit( desc:string, maxdiff:numeric, res:string, lmask:string, eps:numeric ) +; +; check that difference is within reasonable tolerance... +; +begin + reso = res+"_"+lmask; + if ( maxdiff .gt. eps )then + print( space+space+space+desc+" are off by more than tolerance for "+reso+" resolution" ); + print( space+space+space+"maximum difference = "+maxdiff ); + if ( .not. any(badresolutions .eq. reso ) )then + badresolutions(badres) = reso; + badres = badres + 1 + end if + else + print( space+space+space+"File OK for "+desc+"!" ); + end if + if ( .not. any(chkresolutions .eq. reso ) )then + chkresolutions(chkres) = reso; + chkres = chkres + 1 + end if +end + + +function checkdims( desc:string, dsizefile1 [*]:integer, dsizefile2 [*]:integer, res:string, lmask:string ) +; +; check that dimensions are the same between the file variables +; +begin + reso = res+"_"+lmask; + if ( any( dsizefile1 .ne. dsizefile2) )then + print( space+space+space+desc+" dimensions are different for "+reso+" resolution" ); + print( space+space+space+"dim first file "+dsizefile1 ); + print( space+space+space+"dim second file "+dsizefile2 ); + if ( .not. any(badresolutions .eq. reso ) )then + badresolutions(badres) = reso; + badres = badres + 1 + end if + return( False ); + else + print( space+space+space+"File dims OK for "+desc+"!" ); + return( True ); + end if + if ( .not. any(chkresolutions .eq. reso ) )then + chkresolutions(chkres) = reso; + chkres = chkres + 1 + end if +end + +begin + + csmdata = getenv("CSMDATA"); + clmroot = getenv("CLM_ROOT"); + querynml = "bld/queryDefaultNamelist.pl -silent -justvalue -namelist clmexp"; + if ( .not. ismissing(csmdata) )then + querynml = querynml+" -csmdata "+csmdata; + end if + if ( ismissing(clmroot) )then + querynml = "../../"+querynml; + else + querynml = clmroot+"/components/clm/"+querynml; + end if + + print( "query string="+querynml ) + + + mapgrids = (/"0.5x0.5_MODIS", "0.5x0.5_AVHRR", "0.5x0.5_MODIS", "5x5min_nomask", "5x5min_IGBP-GSDP", "5x5min_ISRIC-WISE", "10x10min_nomask", "3x3min_MODIS", "3x3min_LandScan2004", "3x3min_GLOBE-Gardner", "3x3min_GLOBE-Gardner-mergeGIS", "0.9x1.25_GRDC", "360x720cru_cruncep", "1km-merge-10min_HYDRO1K-merge-nomask"/); + do i = 0, dimsizes(resolutions)-1 + res = resolutions(i); + print( "Go through maps for Resolution: "+res ); + do j = 0, dimsizes(mapgrids)-1 + grid = str_get_field( mapgrids(j), 1, "_" ); + lmask = str_get_field( mapgrids(j), 2, "_" ); + print( space+"Look for maps from Grid: "+grid+"_"+lmask); + + querynmlres = querynml+" -options frm_lmask="+lmask+",frm_hgrid="+grid+",to_hgrid="+res+",to_lmask=nomask"; + ; + ; Get map filename and open it + ; + mapfile = systemfunc( querynmlres+" -var map" ); + if ( systemfunc("test -f "+mapfile+"; echo $?" ) .ne. 0 )then + delete( mapfile ); + continue; + end if + print( space+"Use mapfile: "+mapfile ); + ncm = addfile( mapfile, "r" ); + + if ( .not. isvar("ncm0") )then + ncm0 = ncm; + else + vars = (/"yc_b", "xc_b", "area_b", "xv_b", "yv_b" /); + k = 0; + if ( checkdims( vars(k), dimsizes(ncm->$vars(k)$), dimsizes(ncm0->$vars(k)$), res, "nomask" ) )then + do k = 0, dimsizes(vars)-1 + maxdiff = max( abs(ncm->$vars(k)$ - ncm0->$vars(k)$) ); + checkit( vars(k), maxdiff, res, "nomask", 1.e-12 ); + delete( maxdiff ); + end do + var = "mask_b" + imaxdiff = max( abs(ncm->$var$ - ncm0->$var$) ); + checkit( var, imaxdiff, res, "nomask", 1.e-12 ); + delete( imaxdiff ); + end if + delete( ncm ); + end if + delete( mapfile ); + + end do + + delete( grid ); + delete( lmask ); + delete( res ); + if ( isvar("ncm0") )then + delete( ncm0 ); + end if + + end do + ; + ; go the other direction now check the _a variables + ; + mksrf_files = (/"mksrf_fvegtyp", "mksrf_fglacier", "mksrf_furbtopo", "mksrf_flndtopo", "mksrf_flai", "mksrf_fsoitex", "mksrf_fsoicol", "mksrf_ffrac", "mksrf_fmax", "mksrf_ftopo", "mksrf_firrig", "mksrf_forganic", "mksrf_flakwat", "mksrf_fwetlnd", "mksrf_furban", "mksrf_fvocef"/) + do i = 0, dimsizes(mapgrids)-1 + grid = str_get_field( mapgrids(i), 1, "_" ); + lmask = str_get_field( mapgrids(i), 2, "_" ); + print( "Grid: "+grid); + print( "Mask: "+lmask); + do j = 0, dimsizes(resolutions)-1 + res = resolutions(j); + print( "res: "+res ); + + querynmlres = querynml+" -options frm_lmask="+lmask+",frm_hgrid="+grid+",to_hgrid="+res+",to_lmask=nomask"; + ; + ; Get map filename and open it + ; + mapfile = systemfunc( querynmlres+" -var map" ); + if ( systemfunc("test -f "+mapfile+"; echo $?" ) .ne. 0 )then + delete( mapfile ); + continue; + end if + print( space+"Use mapfile: "+mapfile ); + ncm = addfile( mapfile, "r" ); + + if ( .not. isvar("ncm0") )then + ncm0 = ncm; + else + vars = (/"yc_a", "xc_a", "area_a", "xv_a", "yv_a" /); + vars2 = (/"LATIXY", "LONGXY", "AREA" /); + k = 0; + if ( checkdims( vars(k), dimsizes(ncm->$vars(k)$), dimsizes(ncm0->$vars(k)$), res, "nomask" ) )then + do k = 0, dimsizes(vars)-1 + maxdiff = max( abs(ncm->$vars(k)$ - ncm0->$vars(k)$) ); + checkit( vars(k), maxdiff, res, "nomask", 1.e-12 ); + delete( maxdiff ); + end do + end if + var = "mask_a" + imaxdiff = max( abs(ncm->$var$ - ncm0->$var$) ); + checkit( var, imaxdiff, res, "nomask", 1.e-12 ); + delete( imaxdiff ); + ; + ; Get mksurfdata input datasets + ; + do k = 0, dimsizes(mksrf_files)-1 + srffile = systemfunc( querynmlres+" -var "+mksrf_files(k) ); + if ( systemfunc("test -f "+srffile+"; echo $?" ) .ne. 0 )then + delete( srffile ); + continue; + end if + print( space+"Use srffile: "+srffile ); + ncs = addfile( srffile, "r" ); + n = 0; + if ( checkdims( vars(n), dimsizes(ncm->$vars(n)$), ndtooned(dimsizes(ncs->$vars2(n)$)), res, "nomask" ) )then + do n = 0, dimsizes(vars2)-1 + maxdiff = max( abs(ncm->$vars(n)$ - ndtooned(ncs->$vars2(n)$)) ); + checkit( vars(n), maxdiff, res, "nomask", 1.e-12 ); + delete( maxdiff ); + end do + var = "mask_a" + var2 = "LANDMASK" + imaxdiff = max( abs(ncm->$var$ - ndtooned(ncs->$var2$)) ); + checkit( var, imaxdiff, res, "nomask", 1.e-12 ); + end if + delete( ncs ); + end do + delete( ncm ); + end if + delete( mapfile ); + + end do + + if ( isvar("vars") )then + delete( vars ) + end if + if ( isvar("vars2") )then + delete( vars2 ) + end if + delete( grid ); + delete( lmask ); + delete( res ); + if ( isvar("ncm0") )then + delete( ncm0 ); + end if + + end do + if ( chkres .gt. 0 )then + print( "resolutions checked = " ); + print( chkresolutions(0:chkres-1) ); + end if + if ( badres .gt. 0 )then + print( "badresolutions = " ); + print( badresolutions(0:badres-1) ); + end if + + print( "===============================" ); + print( "Successfully went through files" ); + +end + diff --git a/components/clm/bld/namelist_files/createMapEntry.pl b/components/clm/bld/namelist_files/createMapEntry.pl new file mode 100755 index 0000000000..d767eff939 --- /dev/null +++ b/components/clm/bld/namelist_files/createMapEntry.pl @@ -0,0 +1,67 @@ +#!/usr/bin/env perl +# +# July 18 2012 Muszala +# +# createMapEntry.pl - A simple script to dump a list of mappings for a specified resolution to then +# cut and paste into namelist_defaults_clm.xml. A better way is to write the output of this script +# to a file and then directly insert that file into namelist_defaults_clm.xml (using :r foo in vim for +# example). +# +# Example usage:>> ./createMapEntry.pl 1x1_brazil +# will create XML entries for maps in ../lnd/clm2/mappingdata/maps/1x1_brazil such as: +# +# lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_AVHRR_to_1x1_brazil_nomask_aave_da_c120717.nc +# +use Cwd; +use strict; +use English; +use IO::File; +use Getopt::Long; + + my $date = scalar localtime() ; + my $scriptName; + ($scriptName = $0) =~ s!(.*)/!!; # get name of script + my $cwd = getcwd(); + my $CSMDATA = "/glade/p/cesm/cseg/inputdata"; + + if ($#ARGV != 0 ) { + usage(); + exit; + } + my $grid=$ARGV[0]; + + sub usage { + die < + is the resolution to use to dump text to paste into namelist_defaults_clm.xml +EOF + } + + #~# set up directory paths + my $pathStub="lnd/clm2/mappingdata/maps"; + my $partialPath="$pathStub/$grid"; + my $fullPath = "$CSMDATA/$partialPath"; + + #~# open and read directory + opendir DIR, $fullPath or die "Cannot read dir! $fullPath"; + my @list = readdir DIR; + + #~# print a unique start string in the XML comments + print "\n"; + print "\n \n\n"; + + foreach my $foo ( @list ) { + next if ($foo =~ m/^\./); #~# skip anything in the directory with a leading or stand alone 'dot' + my @tokens = split(/_/, $foo); #~# split foo name by the underscore + #~# write out lines for namelist_defaults_clm.xml + print "$partialPath/$foo\n"; + } + + #~# print a unique end string in the XML comments + print "\n \n"; + closedir(DIR); + exit 0; diff --git a/components/clm/bld/namelist_files/history_fields.xsl b/components/clm/bld/namelist_files/history_fields.xsl new file mode 100644 index 0000000000..25c2332e9d --- /dev/null +++ b/components/clm/bld/namelist_files/history_fields.xsl @@ -0,0 +1,46 @@ + + + + + + + + + + + + + CLM History Fields + + +
+

Definition of CLM history variables

+

Included in the table are the following pieces of information:

+
    +
  • Variable name.
    • +
  • Long name description.
    • +
  • units
    • +
+ + + + + + + + + + + + + + + + +
CLM History Fields
NameLong-nameUnits
+
+ + + + + diff --git a/components/clm/bld/namelist_files/namelist_defaults.xsl b/components/clm/bld/namelist_files/namelist_defaults.xsl new file mode 100644 index 0000000000..bfebd0db89 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults.xsl @@ -0,0 +1,177 @@ + + + + + + + + CLM Namelist Defaults + + +

Default Values for Namelist Variables

+

Included in the table are the following pieces of information:

+

Table headers include:

+
    +
  • Name of variable
    • +
  • Horizontal grid resolution
    • +
  • Land ocean mask type
    • +
  • Simulation year
    • +
  • Simulation year range (for transient datasets)
    • +
+

Miscellaneous items include:

+
    +
  1. Biogeochemistry (BGC) type (none, CN, CNDV)
    2. +
  2. Initial condition date (ymd - year month day)
    3. +
  3. Initial condition time of day (tod) (sec)
    4. +
  4. Maximum number of Plant Function Types (maxpft)
    5. +
  5. Number of glacier multiple elevation classes (glc_nec)
    6. +
  6. Site specific point name (sitespf_pt)
    7. +
  7. Crop model (crop)
    8. +
  8. Irrigation model (irrig) (clm4_0 only)
    9. +
  9. Data model forcing source (forcing)
    10. +
  10. Representative concentration pathway for future scenarios (rcp)
    11. +
  11. New good wood harvest (newwoodharv)
    12. +
  12. CN Spin-up mode (spinup)
    13. +
  13. Type of file (type)
    14. +
  14. Grid mapping to (to_hgrid)
    15. +
  15. Land-mask mapping to (to_lmask)
    16. +
  16. High resolution file? (hires)
    17. +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Namelist Defaults
NameHorz. GridMaskSim yearSim year rangeMiscellaneous
Default Value for this Configuration
+ + + + + + + + + + + All res + + + + + + + + + + + + + + + MODIS + + + All masks + + + + + + + + + All yrs + + + + + + + + + All sim-yr-rng + + + + + bgc= + + + ymd= + + + tod= + + + maxpft= + + + glc_nec= + + + sitespf_pt= + + + datm_presaero= + + + crop= + + + irrig= + + + spinup= + + + forcing= + + + rcp= + + + newwoodharv= + + + type= + + + to_hgrid= + + + to_lmask= + + + hires= + +
Value:
+ + + + + + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_0.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_0.xml new file mode 100644 index 0000000000..af800382f7 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_0.xml @@ -0,0 +1,1564 @@ + + + + + + + + + + +1800 + + +379.0 +379.0 +284.7 + + +constant + + +PROG_CROP_ONLY +PROG_CROP_ONLY +NONE +NONE + + +.false. + + +0.80,0.55 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 + + +ON_WASTEHEAT + + +.false. + + + + + +lnd/clm2/pftdata/pft-physiology.clm40.c130424.nc + + +lnd/clm2/initdata/clmi.BCN.0182-01-01_0.47x0.63_g1v6_simyr1850_c120324.nc + + +lnd/clm2/initdata/clmi.BCN.0182-01-01_0.47x0.63_g1v6_simyr1850_c120324.nc + + +lnd/clm2/initdata/clmi.BCN.0182-01-01_0.47x0.63_g1v6_simyr1850_c120324.nc + + + + + + +lnd/clm2/initdata/clmi.IQirrcr_2000-01-01_1.9x2.5_gx1v6_c101115.nc + + +ccsm4_init/b40.1850.track1.2deg.003/year_401/b40.1850.track1.2deg.003.clm2.r.0401-01-01-00000.nc + + +ccsm4_init/b40.1850.track1.2deg.003/year_401/b40.1850.track1.2deg.003.clm2.r.0401-01-01-00000.nc + + +ccsm4_init/b40.1850.track1.2deg.003/year_401/b40.1850.track1.2deg.003.clm2.r.0401-01-01-00000.nc + + +lnd/clm2/initdata/clmi.IQCNDV.0201-01-01_1.9x2.5_gx1v6_simyr2000_c100316.nc + + +ccsm4_init/b40.1850.track1.1deg.006/0863-01-01/b40.1850.track1.1deg.006.clm2.r.0863-01-01-00000.nc + + +ccsm4_init/b40.1850.track1.1deg.006/0863-01-01/b40.1850.track1.1deg.006.clm2.r.0863-01-01-00000.nc + + +ccsm4_init/b40.1850.track1.1deg.006/0863-01-01/b40.1850.track1.1deg.006.clm2.r.0863-01-01-00000.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_0.9x1.25_gx1v6_simyr2000_c100303.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_0.9x1.25_gx1v6_simyr2000_c100303.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_0.9x1.25_gx1v6_simyr2000_c100303.nc + + + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_1.9x2.5_gx1v6_simyr2000_c100309.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_1.9x2.5_gx1v6_simyr2000_c100309.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_1.9x2.5_gx1v6_simyr2000_c100309.nc + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.IQCNCROPmp20_1992-01-01_1.9x2.5_gx1v6_simyr2000_c110427.nc + + + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_4x5_gx3v7_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_4x5_gx3v7_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.BCN.1949-01-01_4x5_gx3v7_simyr1850_c100322.nc + + +lnd/clm2/initdata/clmi.BCN.0507-01-01_48x96_gx3v7_simyr1850_c120929.nc + + +lnd/clm2/initdata/clmi.BCN.0507-01-01_48x96_gx3v7_simyr1850_c120929.nc + + +lnd/clm2/initdata/clmi.BCN.0507-01-01_48x96_gx3v7_simyr1850_c120929.nc + + +lnd/clm2/initdata/clmi.BCN_0051-01-01_48x96_gx3v7_simyr2000_c120930.nc + + +lnd/clm2/initdata/clmi.BCN_0051-01-01_48x96_gx3v7_simyr2000_c120930.nc + + +lnd/clm2/initdata/clmi.BCN_0051-01-01_48x96_gx3v7_simyr2000_c120930.nc + + +lnd/clm2/initdata_map/clmi.BCN.0170-01-01_ne30np4_gx1v6_simyr1850_c121001.nc + + +lnd/clm2/initdata_map/clmi.BCN.0170-01-01_ne30np4_gx1v6_simyr1850_c121001.nc + + +lnd/clm2/initdata_map/clmi.BCN.0170-01-01_ne30np4_gx1v6_simyr1850_c121001.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_ne30np4_gx1v6_simyr2000_c110328.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_ne30np4_gx1v6_simyr2000_c110328.nc + + +lnd/clm2/initdata/clmi.BCN.2000-01-01_ne30np4_gx1v6_simyr2000_c110328.nc + + + +lnd/clm2/surfdata/surfdata_10x15_USGS_070307.nc + +lnd/clm2/surfdata/surfdata_1x1_tropicAtl_testyr1000_c100527.nc + + + + + + +lnd/clm2/surfdata_map/surfdata_48x96_simyr2000_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr2000_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr2000_glcmec10_c120927.nc + + +lnd/clm2/surfdata_map/surfdata_48x96_simyr1850_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr1850_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_glcmec10_c120927.nc + + + +lnd/clm2/surfdata/surfdata_360x720_nourb_simyr2000_c120620.nc + +lnd/clm2/surfdata/surfdata_128x256_simyr2000_c100406.nc + +lnd/clm2/surfdata/surfdata_64x128_simyr2000_c090928.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr2000_c120126.nc + +lnd/clm2/surfdata/surfdata_32x64_simyr2000_c090928.nc + +lnd/clm2/surfdata/surfdata_8x16_simyr2000_c090928.nc + +lnd/clm2/surfdata/surfdata_94x192_urb3den_simyr2000_c091016.nc + + +lnd/clm2/surfdata/surfdata_0.23x0.31_simyr2000_c100406.nc + +lnd/clm2/surfdata/surfdata_0.47x0.63_simyr2000_c091023.nc + +lnd/clm2/surfdata/surfdata_0.9x1.25_simyr2000_c110921.nc + +lnd/clm2/surfdata/surfdata_1.9x2.5_simyr2000_c091005.nc + +lnd/clm2/surfdata/surfdata_2.5x3.33_simyr2000_c091023.nc + +lnd/clm2/surfdata/surfdata_4x5_simyr2000_c090928.nc + +lnd/clm2/surfdata/surfdata_10x15_simyr2000_c090928.nc + + +lnd/clm2/surfdata_map/surfdata_ne4np4_simyr2000_c120126.nc + +lnd/clm2/surfdata_map/surfdata_ne16np4_simyr2000_c120126.nc + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr2000_c110801.nc + +lnd/clm2/surfdata_map/surfdata_ne60np4_simyr2000_c120416.nc + +lnd/clm2/surfdata_map/surfdata_ne120np4_simyr2000_c130313.nc + +lnd/clm2/surfdata_map/surfdata_ne240np4_simyr2000_c130313.nc + + + + +lnd/clm2/surfdata/surfdata_1.9x2.5_mp20_simyr2000_irrcr_c110427.nc + +lnd/clm2/surfdata/surfdata_10x15_mp20_simyr2000_irrcr_c110427.nc + +lnd/clm2/surfdata/surfdata_1x1_numaIA_mp20_simyr2000_irrcr_c110427.nc + + + +lnd/clm2/surfdata/surfdata_1.9x2.5_mp20_simyr2000_c110427.nc + +lnd/clm2/surfdata/surfdata_10x15_mp20_simyr2000_c110427.nc + +lnd/clm2/surfdata/surfdata_1x1_numaIA_mp20_simyr2000_c110427.nc + +lnd/clm2/surfdata/surfdata_1x1_smallvilleIA_mp20_simyr2000_c110427.nc + + +lnd/clm2/surfdata/surfdata_5x5_amazon_simyr2000_c091026.nc + +lnd/clm2/surfdata/surfdata_1x1_brazil_simyr2000_c090928.nc + +lnd/clm2/surfdata/surfdata_1x1_tropicAtl_simyr2000_c090923.nc + + + +lnd/clm2/surfdata/surfdata_1x1_camdenNJ_simyr2000_c100407.nc + +lnd/clm2/surfdata/surfdata_1x1_vancouverCAN_simyr2000_c100409.nc + +lnd/clm2/surfdata/surfdata_1x1_mexicocityMEX_simyr2000_c100409.nc + +lnd/clm2/surfdata/surfdata_1x1_urbanc_alpha_simyr2000_c110209.nc + +lnd/clm2/surfdata/surfdata_1x1_asphaltjungleNJ_simyr2000_c100409.nc + + + +lnd/clm2/surfdata/surfdata_0.9x1.25_simyr2000_irrcr_c100916.nc + +lnd/clm2/surfdata/surfdata_1.9x2.5_simyr2000_irrcr_c100916.nc + +lnd/clm2/surfdata/surfdata_10x15_simyr2000_irrcr_c100916.nc + + + +lnd/clm2/surfdata/surfdata_512x1024_simyr1850_c100315.nc + +lnd/clm2/surfdata/surfdata_360x720_nourb_simyr1850_c120717.nc + +lnd/clm2/surfdata/surfdata_128x256_simyr1850_c100406.nc + +lnd/clm2/surfdata/surfdata_64x128_simyr1850_c090928.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr1850_c120126.nc + +lnd/clm2/surfdata/surfdata_32x64_simyr1850_c090928.nc + +lnd/clm2/surfdata/surfdata_8x16_simyr1850_c090928.nc + + +lnd/clm2/surfdata/surfdata_0.23x0.31_simyr1850_c100404.nc + +lnd/clm2/surfdata/surfdata_0.47x0.63_simyr1850_c100826.nc + +lnd/clm2/surfdata/surfdata_0.9x1.25_simyr1850_c110921.nc + +lnd/clm2/surfdata/surfdata_1.9x2.5_simyr1850_c091108.nc + +lnd/clm2/surfdata/surfdata_2.5x3.33_simyr1850_c091109.nc + +lnd/clm2/surfdata/surfdata_4x5_simyr1850_c090928.nc + +lnd/clm2/surfdata/surfdata_10x15_simyr1850_c100202.nc + + +lnd/clm2/surfdata_map/surfdata_ne4np4_simyr1850_c120126.nc + +lnd/clm2/surfdata_map/surfdata_ne16np4_simyr1850_c120126.nc + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr1850_c110727.nc + +lnd/clm2/surfdata_map/surfdata_ne60np4_simyr1850_c120416.nc + +lnd/clm2/surfdata_map/surfdata_ne120np4_simyr1850_c130311.nc + +lnd/clm2/surfdata_map/surfdata_ne240np4_simyr1850_c130313.nc + + + +lnd/clm2/surfdata/surfdata_1x1_tropicAtl_simyr1850_c090923.nc + + + + + +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_hist_simyr1850-2005_glcmec10_c120927.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_hist_simyr1850-2005_glcmec10_c120927.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_hist_simyr1850-2005_glcmec10_c120927.nc + + +lnd/clm2/surfdata/surfdata.pftdyn_10x15_USGS_070307.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.47x0.63_hist_simyr1850-2005_c100826.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_simyr1850-2005_c091008.nc +lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_simyr1850-2005_c091108.nc +lnd/clm2/surfdata/surfdata.pftdyn_2.5x3.33_simyr1850-2005_c091109.nc +lnd/clm2/surfdata/surfdata.pftdyn_10x15_simyr1850-2005_c100205.nc +lnd/clm2/surfdata/surfdata.pftdyn_1x1_tropicAtl_simyr1850-2005_c091026.nc +lnd/clm2/surfdata/surfdata.pftdyn_1x1_tropicAtl_testyr1000-1004_c100527.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_hist_simyr1850-2005_c120127.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_hist_simyr1850-2005_c120907.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne60np4_hist_simyr1850-2005_c120907.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne120np4_hist_simyr1850-2005_c130313.nc + + + + +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp2.6_simyr1850-2100_glcmec10_c120927.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp2.6_simyr1850-2100_glcmec10_c120928.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp2.6_simyr1850-2100_glcmec10_c120928.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp4.5_simyr1850-2100_glcmec10_c120927.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp4.5_simyr1850-2100_glcmec10_c120928.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp4.5_simyr1850-2100_glcmec10_c120928.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp6.0_simyr1850-2100_glcmec10_c120927.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp6.0_simyr1850-2100_glcmec10_c120928.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp6.0_simyr1850-2100_glcmec10_c120928.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_glcmec10_c120928.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp8.5_simyr1850-2100_glcmec10_c120928.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp8.5_simyr1850-2100_glcmec10_c120928.nc + + +lnd/clm2/surfdata/surfdata.pftdyn_0.47x0.63_rcp8.5_simyr1850-2100_c120224.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c130702.nc +lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_rcp8.5_simyr1850-2100_c130709.nc +lnd/clm2/surfdata/surfdata.pftdyn_10x15_rcp8.5_simyr1850-2100_c140520.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp8.5_simyr1850-2100_c140520.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp8.5_simyr1850-2100_c140520.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne120np4_rcp8.5_simyr1850-2100_c130311.nc + +lnd/clm2/surfdata/surfdata.pftdyn_0.47x0.63_rcp6.0_simyr1850-2100_c120223.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp6.0_simyr1850-2100_c130709.nc +lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_rcp6.0_simyr1850-2100_c130709.nc +lnd/clm2/surfdata/surfdata.pftdyn_10x15_rcp6.0_simyr1850-2100_c140520.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp6.0_simyr1850-2100_c140520.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp6.0_simyr1850-2100_c121001.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne120np4_rcp6.0_simyr1850-2100_c130313.nc + +lnd/clm2/surfdata/surfdata.pftdyn_0.47x0.63_rcp4.5_simyr1850-2100_c120217.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp4.5_simyr1850-2100_c100406.nc +lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_rcp4.5_simyr1850-2100_c100322.nc +lnd/clm2/surfdata/surfdata.pftdyn_10x15_rcp4.5_simyr1850-2100_c100322.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp4.5_simyr1850-2100_c120123.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp4.5_simyr1850-2100_c121001.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne120np4_rcp4.5_simyr1850-2100_c130313.nc + +lnd/clm2/surfdata/surfdata.pftdyn_0.47x0.63_rcp2.6_simyr1850-2100_c120215.nc +lnd/clm2/surfdata/surfdata.pftdyn_0.9x1.25_rcp2.6_simyr1850-2100_c100323.nc +lnd/clm2/surfdata/surfdata.pftdyn_1.9x2.5_rcp2.6_simyr1850-2100_c100322.nc +lnd/clm2/surfdata/surfdata.pftdyn_10x15_rcp2.6_simyr1850-2100_c100322.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp2.6_simyr1850-2100_c120123.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp2.6_simyr1850-2100_c121001.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne120np4_rcp2.6_simyr1850-2100_c130313.nc + + +glc/cism/griddata/glcmaskdata_48x96_gland_c141105.nc + +glc/cism/griddata/glcmaskdata_0.9x1.25_Gland5km.nc +glc/cism/griddata/glcmaskdata_1.9x2.5_gland_c141105.nc + + +lnd/clm2/griddata/topodata_0.9x1.25_USGS_070110.nc +lnd/clm2/griddata/topodata_1.9x2.5_USGS_061130.nc +lnd/clm2/griddata/topodata_48x96_USGS_070110.nc + + + +lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc +lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc + + +2000 +2000 +2000 +2000 + +1850 +1850 +1850 +1850 + +2000 +2000 +2000 +2000 + +2000 +2000 +2000 +2000 + +2000 +2000 +2000 +2000 + +1850 +2000 +1850 +2000 + +1850 +2100 +1850 +2100 + +2000 +2100 +2000 +2100 + +lnd/clm2/ndepdata/fndep_clm_hist_simyr1849-2006_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_hist_simyr1849-2006_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp8.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp8.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp6.0_simyr1849-2106_1.9x2.5_c100810.nc +lnd/clm2/ndepdata/fndep_clm_rcp6.0_simyr1849-2106_1.9x2.5_c100810.nc +lnd/clm2/ndepdata/fndep_clm_rcp4.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp4.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp2.6_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp2.6_simyr1849-2106_1.9x2.5_c100428.nc + +bilinear +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn + + +.true. +.true. +.false. + +bilinear +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn + + + + + +20 + + + + + + + +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.1x0.1_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_AVHRR_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_USGS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_10x10min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_3x3min_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_IGBP-GSDP_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_ISRIC-WISE_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne120np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_4x5_nomask_to_0.1x0.1_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_1.9x2.5_nomask_to_0.1x0.1_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne240np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_AVHRR_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_USGS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_10x10min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_USGS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_IGBP-GSDP_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_ISRIC-WISE_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_AVHRR_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_USGS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_10x10min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_USGS_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_IGBP-GSDP_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_ISRIC-WISE_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_brazil_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_AVHRR_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_USGS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_10x10min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_USGS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_IGBP-GSDP_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_ISRIC-WISE_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_AVHRR_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_USGS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_10x10min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_USGS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_IGBP-GSDP_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_ISRIC-WISE_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_AVHRR_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_USGS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_10x10min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_USGS_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_IGBP-GSDP_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_ISRIC-WISE_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_numaIA_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_AVHRR_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_USGS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_10x10min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_USGS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_IGBP-GSDP_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_ISRIC-WISE_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_AVHRR_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_USGS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_10x10min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_USGS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_IGBP-GSDP_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_ISRIC-WISE_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_AVHRR_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_USGS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_10x10min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_USGS_to_1x1_urbanc_alpha_nomask_aave_da_c120928.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_IGBP-GSDP_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_ISRIC-WISE_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_AVHRR_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_USGS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_10x10min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_USGS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_IGBP-GSDP_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_ISRIC-WISE_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc + + + +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_landuse_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_lanwat_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_fmax_to_0.9x1.25_aave_da_110725.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_10minx10min_topo_to_0.9x1.25_aave_da_110630.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_soitex_to_0.9x1.25_aave_da_110722.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_irrig_to_0.9x1.25_aave_da_110529.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5x5min_ISRIC-WISE_to_0.9x1.25_nomask_aave_da_c120525.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_MODIS_to_0.9x1.25_nomask_aave_da_c120523.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_USGS_to_0.9x1.25_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_LandScan2004_to_0.9x1.25_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner_to_0.9x1.25_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.9x1.25_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_landuse_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_lanwat_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_fmax_to_1.9x2.5_aave_da_110725.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_10minx10min_topo_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5minx5min_soitex_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_nomask_to_1.9x2.5_nomask_aave_da_c120606.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_ISRIC-WISE_to_1.9x2.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_MODIS_to_1.9x2.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_USGS_to_1.9x2.5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_LandScan2004_to_1.9x2.5_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner_to_1.9x2.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_1.9x2.5_nomask_aave_da_c120923.nc + + +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_fmax_to_10x15_aave_da_110725.nc +lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_nomask_to_10x15_nomask_aave_da_c120327.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_ISRIC-WISE_to_10x15_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS_to_10x15_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_USGS_to_10x15_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_LandScan2004_to_10x15_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner-mergeGIS_to_10x15_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_AVHRR_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_USGS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_10x10min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_IGBP-GSDP_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_ISRIC-WISE_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_USGS_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_LandScan2004_to_360x720_nomask_aave_da_c121017.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner-mergeGIS_to_360x720_nomask_aave_da_c121128.nc + + +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_MODIS_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_AVHRR_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_USGS_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_10x10min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_IGBP-GSDP_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_ISRIC-WISE_to_512x1024_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_MODIS_to_512x1024_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_USGS_to_512x1024_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_LandScan2004_to_512x1024_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner_to_512x1024_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner-mergeGIS_to_512x1024_nomask_aave_da_c120923.nc + + +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_MODIS_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_AVHRR_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_USGS_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_10x10min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_IGBP-GSDP_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_ISRIC-WISE_to_128x256_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_MODIS_to_128x256_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_USGS_to_128x256_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_LandScan2004_to_128x256_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner_to_128x256_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner-mergeGIS_to_128x256_nomask_aave_da_c120923.nc + + +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_MODIS_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_AVHRR_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_USGS_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_10x10min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_IGBP-GSDP_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_ISRIC-WISE_to_64x128_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_MODIS_to_64x128_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_USGS_to_64x128_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_LandScan2004_to_64x128_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner_to_64x128_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner-mergeGIS_to_64x128_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_MODIS_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_AVHRR_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_USGS_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_10x10min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_IGBP-GSDP_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_ISRIC-WISE_to_48x96_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_MODIS_to_48x96_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_USGS_to_48x96_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_LandScan2004_to_48x96_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner_to_48x96_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner-mergeGIS_to_48x96_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_MODIS_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_AVHRR_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_USGS_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_10x10min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_IGBP-GSDP_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_ISRIC-WISE_to_32x64_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_MODIS_to_32x64_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_USGS_to_32x64_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_LandScan2004_to_32x64_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner_to_32x64_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner-mergeGIS_to_32x64_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_MODIS_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_AVHRR_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_USGS_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_10x10min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_IGBP-GSDP_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_ISRIC-WISE_to_8x16_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_MODIS_to_8x16_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_USGS_to_8x16_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_LandScan2004_to_8x16_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner_to_8x16_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner-mergeGIS_to_8x16_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_MODIS_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_AVHRR_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_USGS_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_10x10min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_IGBP-GSDP_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_ISRIC-WISE_to_4x5_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_MODIS_to_4x5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_USGS_to_4x5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_LandScan2004_to_4x5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner_to_4x5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner-mergeGIS_to_4x5_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_MODIS_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_AVHRR_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_USGS_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_10x10min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_IGBP-GSDP_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_ISRIC-WISE_to_0.23x0.31_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_MODIS_to_0.23x0.31_nomask_aave_da_c110930.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_USGS_to_0.23x0.31_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner_to_0.23x0.31_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.23x0.31_nomask_aave_da_c120923.nc + + + + + +lnd/clm2/mappingdata/maps/0.47x0.63/map_0.1x0.1_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_AVHRR_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_MODIS_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_USGS_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_0.5x0.5_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_1.9x2.5_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_10x10min_IGBPmergeICESatGIS_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_10x10min_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_LandScan2004_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_MODIS_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_USGS_to_0.47x0.63_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_IGBP-GSDP_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_ISRIC-WISE_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_5x5min_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_ne120np4_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_ne240np4_nomask_to_0.47x0.63_nomask_aave_da_c120914.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_GLOBE-Gardner_to_0.47x0.63_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.47x0.63/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.47x0.63_nomask_aave_da_c120926.nc + + + +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_MODIS_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_AVHRR_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_USGS_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_10x10min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_IGBP-GSDP_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_ISRIC-WISE_to_2.5x3.33_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_MODIS_to_2.5x3.33_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_USGS_to_2.5x3.33_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_LandScan2004_to_2.5x3.33_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner_to_2.5x3.33_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner-mergeGIS_to_2.5x3.33_nomask_aave_da_c120923.nc + + + + +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_AVHRR_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_MODIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_USGS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_IGBPmergeICESatGIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_IGBP-GSDP_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_MODIS_to_0.5x0.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_ISRIC-WISE_to_0.5x0.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_LandScan2004_to_0.5x0.5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.1x0.1_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_4x5_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne120np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3_USGS_nomask_to_0.5x0.5_nomask_aave_da_c120912.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.47x0.63_nomask_to_0.5x0.5_nomask_aave_da_c120914.nc + + + +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_MODIS_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_AVHRR_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_USGS_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_10x10min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_IGBP-GSDP_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_ISRIC-WISE_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_MODIS_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_USGS_to_ne4np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner_to_ne4np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne4np4_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_ne4np4_nomask_to_0.5x0.5_nomask_aave_da_c110923.nc + + +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_MODIS_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_AVHRR_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_USGS_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_10x10min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_IGBP-GSDP_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_ISRIC-WISE_to_ne16np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_MODIS_to_ne16np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_USGS_to_ne16np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_LandScan2004_to_ne16np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_ne16np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_landuse_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_lanwat_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_fmax_to_ne30np4_aave_da_110725.nc +lnd/clm2/mappingdata/maps/ne30np4/map_10minx10min_topo_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_soitex_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_irrig_to_ne30np4_aave_da_110720.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5x5min_ISRIC-WISE_to_ne30np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_MODIS_to_ne30np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_USGS_to_ne30np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_LandScan2004_to_ne30np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner_to_ne30np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4_nomask_aave_da_c120924.nc + +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_MODIS_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_AVHRR_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_USGS_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_10x10min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_IGBP-GSDP_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_ISRIC-WISE_to_ne60np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_MODIS_to_ne60np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_USGS_to_ne60np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_LandScan2004_to_ne60np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_ne60np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_landuse_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_lanwat_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_fmax_to_ne120np4_aave_da_110725.nc +lnd/clm2/mappingdata/maps/ne120np4/map_10minx10min_topo_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_soitex_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_irrig_to_ne120np4_aave_da_110817.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_LandScan2004_to_ne120np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc + + + + +lnd/clm2/mappingdata/maps/ne120np4/map_0.1x0.1_nomask_to_ne120np4_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc + + + +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_MODIS_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_AVHRR_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_USGS_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_10x10min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_IGBP-GSDP_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_ISRIC-WISE_to_5x5_amazon_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_MODIS_to_5x5_amazon_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_USGS_to_5x5_amazon_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_LandScan2004_to_5x5_amazon_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner_to_5x5_amazon_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner-mergeGIS_to_5x5_amazon_nomask_aave_da_c120923.nc + +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_MODIS_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_AVHRR_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_USGS_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_10x10min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_IGBP-GSDP_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_ISRIC-WISE_to_ne240np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_MODIS_to_ne240np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_USGS_to_ne240np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_LandScan2004_to_ne240np4_nomask_aave_da_c120521.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + + + + +. +. + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml new file mode 100644 index 0000000000..67e1f74cc7 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml @@ -0,0 +1,3760 @@ + + + + + + + + + + + + +none +SCRIP + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.23x0.31_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.47x0.63_nomask_c120914.nc +lnd/clm2/mappingdata/grids/0.9x1.25_c110307.nc +lnd/clm2/mappingdata/grids/1.9x2.5_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_2.5x3.33_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_4x5_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_10x15_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_512x1024_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_128x256_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_94x192_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_64x128_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_48x96_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_32x64_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_8x16_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_ne240np4_nomask_c091227.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne120np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne60np4_nomask_c100408.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne30np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne16np4_nomask_c110512.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne4np4_nomask_c110808.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.33x0.33_navy_c111207.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.1x0.1_nomask_c110712.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_AVHRR_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_MODIS_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_USGS_c110725.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_nomask_c110530.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_IGBP-GSDP_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_ISRIC-WISE_c111114.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_10x10min_nomask_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_MODIS_c110915.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3x3_USGS_c120912.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_LandScan2004_c120517.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_GLOBE-Gardner_c120922.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_GLOBE-Gardner-mergeGIS_c120922.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_360x720_cruncep_c120830.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_360x720_nomask_c120830.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_camdenNJ_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_brazil_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_camdenNJ_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_mexicocityMEX_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_numaIA_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_smallvilleIA_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_tropicAtl_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_urbanc_alpha_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_vancouverCAN_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5pt_amazon_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.33x0.33_navy_c111207.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5_amazon_navy_c111207.nc +/glade/proj3/cseg/mapping/grids/gx1v6_090205.nc +/glade/proj3/cseg/mapping/grids/gx3v7_090903.nc +/glade/proj3/cseg/mapping/grids/tx1v1_090122.nc +/glade/proj3/cseg/mapping/grids/tx0.1v2_090127.nc + + +AVHRR +MODIS +AVHRR +AVHRR +MODIS +MODIS +MODIS +MODIS +LandScan2004 +MODIS +MODIS +ISRIC-WISE +GLOBE-Gardner +GLOBE-Gardner-mergeGIS +GLOBE-Gardner-mergeGIS +GLOBE-Gardner-mergeGIS +GLOBE-Gardner-mergeGIS +GLOBE-Gardner-mergeGIS +USGS +USGS +nomask +nomask +nomask +IGBP-GSDP + + +0.5x0.5 +3x3min +0.5x0.5 +0.5x0.5 +0.5x0.5 +0.5x0.5 +3x3min +0.5x0.5 +3x3min +0.5x0.5 +0.5x0.5 +5x5min +3x3min +0.5x0.5 +3x3min +5x5min +10x10min +10x10min +5x5min + + +mksrf_flakwat +mksrf_fwetlnd +mksrf_fvocef +mksrf_flai +mksrf_fvegtyp +mksrf_furban +mksrf_fsoicol +mksrf_forganic +mksrf_fglacier +mksrf_fmax +mksrf_firrig +mksrf_furbtopo +mksrf_flndtopo +mksrf_fsoitex + + +lnd/clm2/rawdata/mksrf_navyoro_20min.c010129.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_lai_global_c090506.nc + + +lnd/clm2/rawdata/mksrf_crop_20pft/mksrf_lai20pft_0.5x0.5_simyr1990s.c090417.nc + + + +lnd/clm2/rawdata/mksrf_irrig_2160x4320_simyr2000.c110527.nc + +lnd/clm2/rawdata/mksrf_soitex.10level.c010119.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_soilcol_global_c090324.nc + +lnd/clm2/rawdata/mksrf_organic.10level.0.5deg.081112.nc + +lnd/clm2/rawdata/mksrf_organic_10level_5x5min_ISRIC-WISE-NCSCD_nlev7_c120830.nc + +lnd/clm2/rawdata/mksrf_fmax.070406.nc + +lnd/clm2/rawdata/mksrf_fmax_3x3min_USGS_c120911.nc + + +lnd/clm2/rawdata/mksrf_lanwat.050425.nc + +lnd/clm2/rawdata/mksrf_LakePnDepth_3x3min_simyr2004_c111116.nc + +lnd/clm2/rawdata/mksrf_lanwat.050425.nc + + +lnd/clm2/rawdata/mksrf_vocef_0.5x0.5_simyr2000.c110531.nc + + +lnd/clm2/rawdata/topodata_10min_USGS_071205.nc + + +lnd/clm2/rawdata/mksrf_urban_3den_0.5x0.5_simyr2000.c090223_v1.nc +lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120418.nc + + + +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000.c120926.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc + + +lnd/clm2/rawdata/mksrf_topo.10min.c080912.nc + + + + +lnd/clm2/rawdata/mksrf_crop_20pft/mksrf_20pft_0.5x0.5_rc2000_simyr1990s.c110321.nc + + +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_1x1_tropicAtl_testyr1000_c090722.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_1x1_tropicAtl_testyr1001_c090722.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_1x1_tropicAtl_testyr1002_c090722.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_1x1_tropicAtl_testyr1003_c090722.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_1x1_tropicAtl_testyr1004_c090722.nc + +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1000_c100614.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1001_c100614.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1002_c100614.nc + +lnd/clm2/rawdata/pftlanduse.3minx3min.simyr2000.c110913/mksrf_landuse_rc2000_c110913.nc + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1851_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1852_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1853_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1854_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1855_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1856_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1857_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1858_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1859_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1860_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1861_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1862_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1863_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1864_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1865_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1866_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1867_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1868_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1869_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1870_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1871_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1872_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1873_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1874_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1875_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1876_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1877_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1878_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1879_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1880_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1881_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1882_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1883_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1884_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1885_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1886_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1887_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1888_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1889_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1890_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1891_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1892_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1893_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1894_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1895_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1896_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1897_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1898_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1899_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1900_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1901_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1902_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1903_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1904_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1905_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1906_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1907_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1908_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1909_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1910_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1911_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1912_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1913_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1914_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1915_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1916_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1917_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1918_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1919_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1920_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1921_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1922_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1923_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1924_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1925_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1926_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1927_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1928_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1929_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1930_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1931_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1932_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1933_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1934_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1935_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1936_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1937_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1938_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1939_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1940_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1941_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1942_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1943_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1944_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1945_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1946_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1947_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1948_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1949_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1950_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1951_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1952_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1953_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1954_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1955_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1956_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1957_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1958_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1959_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1960_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1961_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1962_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1963_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1964_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1965_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1966_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1967_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1968_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1969_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1970_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1971_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1972_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1973_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1974_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1975_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1976_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1977_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1978_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1979_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1980_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1981_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1982_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1983_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1984_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1985_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1986_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1987_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1988_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1989_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1990_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1991_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1992_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1993_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1994_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1995_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1996_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1997_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1998_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1999_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2000_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2001_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2002_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2003_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2004_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2005_c090630.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0850_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0851_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0852_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0853_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0854_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0855_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0856_c100519.v2.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0857_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0858_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0859_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0860_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0861_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0862_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0863_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0864_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0865_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0866_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0867_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0868_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0869_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0870_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0871_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0872_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0873_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0874_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0875_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0876_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0877_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0878_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0879_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0880_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0881_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0882_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0883_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0884_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0885_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0886_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0887_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0888_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0889_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0890_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0891_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0892_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0893_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0894_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0895_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0896_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0897_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0898_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0899_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0900_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0901_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0902_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0903_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0904_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0905_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0906_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0907_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0908_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0909_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0910_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0911_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0912_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0913_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0914_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0915_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0916_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0917_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0918_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0919_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0920_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0921_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0922_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0923_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0924_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0925_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0926_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0927_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0928_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0929_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0930_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0931_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0932_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0933_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0934_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0935_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0936_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0937_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0938_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0939_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0940_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0941_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0942_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0943_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0944_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0945_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0946_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0947_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0948_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0949_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0950_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0951_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0952_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0953_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0954_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0955_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0956_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0957_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0958_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0959_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0960_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0961_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0962_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0963_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0964_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0965_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0966_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0967_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0968_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0969_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0970_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0971_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0972_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0973_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0974_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0975_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0976_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0977_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0978_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0979_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0980_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0981_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0982_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0983_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0984_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0985_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0986_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0987_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0988_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0989_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0990_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0991_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0992_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0993_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0994_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0995_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0996_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0997_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0998_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0999_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1000_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1001_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1002_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1003_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1004_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1005_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1006_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1007_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1008_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1009_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1010_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1011_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1012_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1013_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1014_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1015_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1016_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1017_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1018_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1019_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1020_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1021_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1022_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1023_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1024_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1025_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1026_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1027_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1028_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1029_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1030_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1031_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1032_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1033_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1034_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1035_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1036_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1037_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1038_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1039_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1040_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1041_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1042_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1043_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1044_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1045_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1046_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1047_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1048_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1049_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1050_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1051_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1052_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1053_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1054_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1055_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1056_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1057_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1058_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1059_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1060_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1061_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1062_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1063_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1064_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1065_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1066_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1067_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1068_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1069_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1070_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1071_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1072_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1073_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1074_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1075_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1076_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1077_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1078_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1079_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1080_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1081_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1082_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1083_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1084_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1085_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1086_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1087_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1088_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1089_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1090_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1091_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1092_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1093_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1094_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1095_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1096_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1097_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1098_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1099_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1100_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1101_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1102_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1103_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1104_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1105_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1106_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1107_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1108_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1109_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1110_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1111_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1112_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1113_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1114_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1115_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1116_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1117_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1118_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1119_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1120_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1121_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1122_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1123_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1124_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1125_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1126_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1127_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1128_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1129_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1130_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1131_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1132_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1133_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1134_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1135_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1136_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1137_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1138_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1139_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1140_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1141_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1142_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1143_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1144_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1145_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1146_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1147_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1148_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1149_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1150_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1151_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1152_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1153_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1154_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1155_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1156_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1157_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1158_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1159_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1160_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1161_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1162_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1163_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1164_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1165_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1166_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1167_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1168_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1169_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1170_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1171_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1172_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1173_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1174_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1175_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1176_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1177_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1178_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1179_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1180_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1181_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1182_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1183_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1184_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1185_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1186_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1187_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1188_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1189_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1190_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1191_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1192_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1193_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1194_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1195_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1196_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1197_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1198_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1199_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1200_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1201_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1202_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1203_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1204_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1205_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1206_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1207_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1208_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1209_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1210_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1211_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1212_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1213_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1214_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1215_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1216_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1217_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1218_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1219_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1220_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1221_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1222_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1223_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1224_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1225_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1226_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1227_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1228_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1229_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1230_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1231_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1232_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1233_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1234_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1235_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1236_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1237_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1238_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1239_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1240_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1241_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1242_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1243_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1244_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1245_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1246_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1247_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1248_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1249_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1250_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1251_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1252_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1253_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1254_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1255_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1256_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1257_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1258_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1259_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1260_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1261_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1262_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1263_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1264_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1265_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1266_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1267_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1268_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1269_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1270_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1271_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1272_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1273_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1274_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1275_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1276_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1277_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1278_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1279_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1280_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1281_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1282_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1283_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1284_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1285_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1286_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1287_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1288_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1289_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1290_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1291_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1292_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1293_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1294_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1295_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1296_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1297_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1298_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1299_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1300_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1301_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1302_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1303_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1304_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1305_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1306_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1307_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1308_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1309_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1310_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1311_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1312_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1313_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1314_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1315_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1316_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1317_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1318_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1319_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1320_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1321_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1322_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1323_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1324_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1325_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1326_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1327_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1328_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1329_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1330_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1331_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1332_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1333_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1334_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1335_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1336_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1337_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1338_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1339_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1340_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1341_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1342_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1343_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1344_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1345_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1346_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1347_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1348_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1349_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1350_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1351_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1352_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1353_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1354_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1355_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1356_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1357_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1358_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1359_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1360_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1361_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1362_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1363_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1364_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1365_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1366_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1367_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1368_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1369_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1370_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1371_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1372_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1373_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1374_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1375_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1376_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1377_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1378_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1379_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1380_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1381_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1382_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1383_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1384_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1385_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1386_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1387_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1388_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1389_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1390_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1391_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1392_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1393_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1394_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1395_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1396_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1397_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1398_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1399_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1400_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1401_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1402_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1403_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1404_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1405_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1406_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1407_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1408_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1409_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1410_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1411_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1412_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1413_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1414_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1415_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1416_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1417_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1418_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1419_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1420_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1421_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1422_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1423_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1424_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1425_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1426_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1427_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1428_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1429_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1430_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1431_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1432_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1433_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1434_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1435_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1436_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1437_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1438_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1439_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1440_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1441_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1442_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1443_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1444_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1445_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1446_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1447_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1448_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1449_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1450_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1451_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1452_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1453_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1454_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1455_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1456_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1457_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1458_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1459_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1460_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1461_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1462_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1463_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1464_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1465_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1466_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1467_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1468_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1469_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1470_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1471_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1472_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1473_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1474_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1475_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1476_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1477_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1478_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1479_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1480_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1481_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1482_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1483_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1484_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1485_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1486_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1487_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1488_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1489_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1490_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1491_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1492_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1493_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1494_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1495_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1496_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1497_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1498_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1499_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1500_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1501_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1502_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1503_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1504_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1505_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1506_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1507_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1508_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1509_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1510_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1511_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1512_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1513_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1514_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1515_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1516_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1517_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1518_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1519_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1520_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1521_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1522_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1523_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1524_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1525_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1526_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1527_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1528_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1529_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1530_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1531_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1532_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1533_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1534_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1535_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1536_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1537_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1538_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1539_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1540_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1541_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1542_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1543_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1544_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1545_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1546_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1547_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1548_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1549_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1550_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1551_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1552_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1553_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1554_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1555_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1556_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1557_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1558_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1559_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1560_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1561_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1562_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1563_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1564_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1565_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1566_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1567_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1568_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1569_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1570_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1571_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1572_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1573_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1574_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1575_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1576_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1577_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1578_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1579_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1580_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1581_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1582_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1583_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1584_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1585_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1586_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1587_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1588_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1589_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1590_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1591_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1592_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1593_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1594_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1595_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1596_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1597_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1598_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1599_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1600_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1601_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1602_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1603_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1604_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1605_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1606_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1607_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1608_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1609_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1610_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1611_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1612_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1613_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1614_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1615_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1616_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1617_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1618_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1619_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1620_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1621_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1622_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1623_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1624_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1625_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1626_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1627_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1628_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1629_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1630_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1631_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1632_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1633_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1634_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1635_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1636_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1637_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1638_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1639_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1640_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1641_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1642_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1643_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1644_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1645_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1646_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1647_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1648_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1649_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1650_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1651_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1652_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1653_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1654_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1655_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1656_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1657_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1658_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1659_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1660_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1661_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1662_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1663_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1664_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1665_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1666_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1667_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1668_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1669_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1670_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1671_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1672_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1673_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1674_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1675_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1676_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1677_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1678_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1679_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1680_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1681_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1682_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1683_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1684_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1685_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1686_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1687_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1688_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1689_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1690_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1691_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1692_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1693_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1694_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1695_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1696_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1697_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1698_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1699_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1700_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1701_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1702_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1703_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1704_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1705_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1706_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1707_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1708_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1709_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1710_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1711_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1712_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1713_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1714_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1715_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1716_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1717_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1718_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1719_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1720_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1721_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1722_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1723_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1724_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1725_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1726_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1727_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1728_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1729_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1730_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1731_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1732_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1733_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1734_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1735_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1736_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1737_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1738_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1739_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1740_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1741_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1742_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1743_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1744_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1745_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1746_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1747_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1748_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1749_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1750_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1751_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1752_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1753_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1754_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1755_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1756_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1757_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1758_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1759_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1760_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1761_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1762_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1763_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1764_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1765_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1766_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1767_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1768_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1769_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1770_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1771_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1772_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1773_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1774_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1775_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1776_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1777_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1778_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1779_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1780_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1781_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1782_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1783_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1784_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1785_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1786_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1787_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1788_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1789_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1790_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1791_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1792_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1793_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1794_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1795_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1796_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1797_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1798_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1799_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1800_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1801_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1802_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1803_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1804_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1805_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1806_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1807_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1808_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1809_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1810_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1811_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1812_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1813_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1814_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1815_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1816_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1817_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1818_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1819_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1820_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1821_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1822_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1823_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1824_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1825_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1826_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1827_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1828_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1829_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1830_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1831_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1832_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1833_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1834_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1835_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1836_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1837_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1838_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1839_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1840_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1841_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1842_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1843_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1844_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1845_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1846_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1847_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1848_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1849_c100522.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2006_c100317.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2007_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2008_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2009_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2010_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2011_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2012_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2013_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2014_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2015_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2016_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2017_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2018_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2019_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2020_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2021_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2022_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2023_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2024_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2025_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2026_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2027_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2028_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2029_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2030_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2031_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2032_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2033_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2034_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2035_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2036_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2037_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2038_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2039_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2040_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2041_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2042_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2043_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2044_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2045_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2046_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2047_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2048_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2049_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2050_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2051_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2052_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2053_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2054_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2055_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2056_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2057_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2058_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2059_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2060_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2061_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2062_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2063_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2064_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2065_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2066_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2067_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2068_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2069_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2070_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2071_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2072_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2073_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2074_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2075_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2076_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2077_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2078_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2079_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2080_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2081_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2082_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2083_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2084_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2085_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2086_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2087_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2088_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2089_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2090_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2091_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2092_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2093_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2094_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2095_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2096_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2097_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2098_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2099_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2100_c100121.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2006_c100317.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2007_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2008_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2009_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2010_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2011_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2012_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2013_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2014_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2015_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2016_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2017_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2018_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2019_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2020_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2021_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2022_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2023_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2024_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2025_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2026_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2027_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2028_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2029_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2030_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2031_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2032_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2033_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2034_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2035_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2036_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2037_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2038_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2039_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2040_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2041_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2042_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2043_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2044_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2045_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2046_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2047_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2048_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2049_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2050_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2051_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2052_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2053_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2054_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2055_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2056_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2057_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2058_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2059_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2060_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2061_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2062_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2063_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2064_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2065_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2066_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2067_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2068_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2069_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2070_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2071_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2072_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2073_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2074_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2075_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2076_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2077_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2078_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2079_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2080_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2081_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2082_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2083_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2084_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2085_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2086_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2087_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2088_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2089_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2090_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2091_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2092_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2093_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2094_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2095_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2096_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2097_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2098_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2099_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2100_c100121.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2006_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2007_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2008_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2009_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2010_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2011_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2012_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2013_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2014_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2015_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2016_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2017_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2018_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2019_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2020_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2021_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2022_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2023_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2024_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2025_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2026_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2027_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2028_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2029_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2030_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2031_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2032_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2033_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2034_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2035_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2036_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2037_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2038_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2039_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2040_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2041_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2042_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2043_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2044_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2045_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2046_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2047_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2048_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2049_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2050_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2051_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2052_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2053_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2054_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2055_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2056_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2057_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2058_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2059_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2060_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2061_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2062_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2063_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2064_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2065_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2066_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2067_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2068_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2069_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2070_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2071_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2072_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2073_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2074_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2075_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2076_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2077_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2078_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2079_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2080_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2081_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2082_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2083_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2084_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2085_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2086_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2087_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2088_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2089_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2090_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2091_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2092_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2093_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2094_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2095_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2096_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2097_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2098_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2099_c100318.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.simyr2005-2100.c100318/mksrf_landuse_aim2100_c100318.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2006_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2007_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2008_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2009_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2010_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2011_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2012_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2013_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2014_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2015_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2016_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2017_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2018_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2019_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2020_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2021_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2022_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2023_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2024_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2025_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2026_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2027_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2028_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2029_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2030_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2031_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2032_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2033_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2034_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2035_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2036_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2037_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2038_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2039_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2040_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2041_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2042_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2043_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2044_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2045_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2046_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2047_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2048_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2049_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2050_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2051_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2052_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2053_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2054_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2055_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2056_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2057_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2058_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2059_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2060_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2061_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2062_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2063_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2064_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2065_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2066_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2067_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2068_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2069_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2070_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2071_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2072_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2073_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2074_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2075_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2076_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2077_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2078_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2079_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2080_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2081_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2082_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2083_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2084_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2085_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2086_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2087_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2088_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2089_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2090_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2091_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2092_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2093_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2094_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2095_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2096_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2097_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2098_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.simyr2005-2100.c100121/mksrf_landuse_message2099_c100121.nc + + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2006_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2007_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2008_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2009_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2010_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2011_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2012_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2013_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2014_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2015_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2016_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2017_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2018_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2019_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2020_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2021_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2022_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2023_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2024_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2025_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2026_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2027_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2028_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2029_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2030_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2031_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2032_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2033_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2034_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2035_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2036_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2037_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2038_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2039_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2040_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2041_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2042_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2043_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2044_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2045_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2046_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2047_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2048_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2049_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2050_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2051_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2052_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2053_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2054_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2055_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2056_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2057_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2058_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2059_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2060_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2061_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2062_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2063_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2064_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2065_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2066_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2067_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2068_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2069_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2070_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2071_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2072_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2073_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2074_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2075_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2076_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2077_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2078_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2079_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2080_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2081_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2082_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2083_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2084_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2085_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2086_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2087_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2088_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2089_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2090_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2091_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2092_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2093_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2094_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2095_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2096_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2097_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2098_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2099_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2100_c110602.nc + + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2006_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2007_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2008_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2009_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2010_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2011_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2012_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2013_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2014_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2015_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2016_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2017_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2018_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2019_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2020_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2021_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2022_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2023_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2024_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2025_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2026_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2027_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2028_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2029_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2030_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2031_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2032_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2033_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2034_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2035_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2036_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2037_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2038_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2039_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2040_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2041_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2042_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2043_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2044_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2045_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2046_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2047_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2048_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2049_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2050_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2051_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2052_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2053_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2054_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2055_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2056_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2057_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2058_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2059_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2060_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2061_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2062_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2063_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2064_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2065_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2066_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2067_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2068_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2069_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2070_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2071_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2072_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2073_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2074_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2075_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2076_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2077_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2078_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2079_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2080_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2081_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2082_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2083_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2084_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2085_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2086_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2087_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2088_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2089_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2090_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2091_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2092_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2093_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2094_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2095_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2096_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2097_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2098_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2099_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2100_c110602.nc + + + +atm/cam/ggas/ghg_hist_1765-2005_c091218.nc + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml new file mode 100644 index 0000000000..83bcf66d23 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -0,0 +1,1615 @@ + + + + + + + + + + + +1800 + + +379.0 +379.0 +284.7 + + +constant + + +sp + + +off + + +1 +0 + + +.true. +.false. + + +.false. + + +NONE + + +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 + + +ON_WASTEHEAT +ON + +1 +0 + +.true. +.false. + + +.false. + + +.false. +.true. + +.true. +.false. + + +OFF +ON_RAD + + +5 +5 +1000.0 +1000.0 + + +.true. + +7300 + + + + +lnd/clm2/paramdata/clm_params.c141205.nc +lnd/clm2/paramdata/clm_params_ed.c150317.nc + + + + + +lnd/clm2/paramdata/clm_params_78pft.c150605.nc + +.false. +.true. +.false. +.false. +3 +.true. +.true. +.true. +.true. +.true. +.false. +3 +1 +1 +0 +1 +1 + +.false. + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45SP.0521-01-01.0.9x1.25_g1v6_simyr1850_c141226.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.0.9x1.25_g1v6_simyr1850_c141226.nc + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45SP.2000-01-01.0.9x1.25_g1v6_simyr2000_c141226.nc + + + +lnd/clm2/initdata_map/clmi.I2000CLM45CRUBGC.2000-01-01.0.9x1.25_gx1v6_simyr2000_c141226.nc + + + + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c141226.nc + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c141226.nc + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c141226.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c141226.nc + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c141226.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c141226.nc + + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGCDV.0241-01-01.0.9x1.25_g1v6_simyr1850_c141226.nc + + + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROP.78pfts.levis_reinterp.1.9x2.5_g1v6_simyr2000_c150116.nc + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROP.78pfts.levis.10x15_USGS_simyr2000_c150116.nc + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROP.78pfts.Irrig.levis.10x15_USGS_simyr2000_c150116.nc + + + + +lnd/clm2/surfdata_map/surfdata_360x720cru_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_0.125x0.125_simyr2000_c150114.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr2000_c141219.nc + + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_4x5_16pfts_simyr2000_c150116.nc + +lnd/clm2/surfdata_map/surfdata_10x15_simyr2000_c141219.nc + + +lnd/clm2/surfdata_map/surfdata_ne120np4_simyr2000_c150121.nc + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_ne16np4_simyr2000_c150114.nc + + + + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_78pfts_simyr2000_c150116.nc + +lnd/clm2/surfdata_map/surfdata_0.125x0.125_mp24_simyr2000_c150114.nc + +lnd/clm2/surfdata_map/surfdata_10x15_78pfts_simyr2000_c150116.nc + +lnd/clm2/surfdata_map/surfdata_1x1_numaIA_78pfts_simyr2000_c150116.nc + +lnd/clm2/surfdata_map/surfdata_1x1_smallvilleIA_78pfts_simyr2000_c150116.nc + + +lnd/clm2/surfdata_map/surfdata_5x5_amazon_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_brazil_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_tropicAtl_simyr2000_c141219.nc + + + +lnd/clm2/surfdata_map/surfdata_1x1_camdenNJ_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_vancouverCAN_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_mexicocityMEX_simyr2000_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_urbanc_alpha_simyr2000_c141219.nc + + + +lnd/clm2/surfdata_map/surfdata_360x720cru_simyr1850_c141219.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr1850_c141219.nc + + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr1850_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_c141219.nc + +lnd/clm2/surfdata_map/surfdata_10x15_simyr1850_c141219.nc + + +lnd/clm2/surfdata_map/surfdata_1x1_tropicAtl_simyr1850_c141219.nc + +lnd/clm2/surfdata_map/surfdata_1x1_brazil_simyr1850_c141219.nc + + + +lnd/clm2/surfdata_map/surfdata_ne120np4_simyr1850_c150121.nc + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr1850_c141219.nc + + + + + +lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_10x15_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_48x96_rcp8.5_simyr1850-2100_c141219.nc + +lnd/clm2/surfdata_map/landuse.timeseries_1x1_tropicAtl_hist_simyr1850-2005_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_rcp8.5_simyr1850-2100_c141219.nc + +lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_rcp8.5_simyr1850-2100_c150121.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_rcp8.5_simyr1850-2100_c141219.nc + + + + +lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_10x15_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_48x96_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_rcp8.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_rcp8.5_simyr1850-2100_c150121.nc + +lnd/clm2/surfdata_map/landuse.timeseries_1x1_brazil_rcp8.5_simyr1850-2100_c141219.nc + +lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_rcp6.0_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_rcp6.0_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_rcp6.0_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_10x15_rcp6.0_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_48x96_rcp6.0_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_rcp6.0_simyr1850-2100_c141219.nc + +lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_rcp4.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_rcp4.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_rcp4.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_10x15_rcp4.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_48x96_rcp4.5_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne120np4_rcp4.5_simyr1850-2100_c150121.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_rcp4.5_simyr1850-2100_c141219.nc + +lnd/clm2/surfdata_map/landuse.timeseries_360x720cru_rcp2.6_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_0.9x1.25_rcp2.6_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_1.9x2.5_rcp2.6_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_10x15_rcp2.6_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_48x96_rcp2.6_simyr1850-2100_c141219.nc +lnd/clm2/surfdata_map/landuse.timeseries_ne30np4_rcp2.6_simyr1850-2100_c141219.nc + + +glc/cism/griddata/glcmaskdata_48x96_gland_c141105.nc +glc/cism/griddata/glcmaskdata_0.9x1.25_gland_c141105.nc +glc/cism/griddata/glcmaskdata_1.9x2.5_gland_c141105.nc + + +lnd/clm2/griddata/topodata_0.9x1.25_USGS_070110.nc +lnd/clm2/griddata/topodata_1.9x2.5_USGS_061130.nc +lnd/clm2/griddata/topodata_48x96_USGS_070110.nc + + + +lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc +lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc + + +2000 +2000 + +1850 +1850 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +1850 +2000 + +1850 +2100 + +2000 +2100 + +lnd/clm2/ndepdata/fndep_clm_hist_simyr1849-2006_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp8.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp6.0_simyr1849-2106_1.9x2.5_c100810.nc +lnd/clm2/ndepdata/fndep_clm_rcp4.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp2.6_simyr1849-2106_1.9x2.5_c100428.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +.false. +2001 +2013 +2001 + +lnd/clm2/lai_streams/MODISPFTLAI_0.5x0.5_c140711.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn +nn + + +0001 +0001 + +atm/datm7/NASA_LIS/clmforc.Li_2012_climo1995-2011.T62.lnfm_Total_c140423.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +2000 +2000 + +1850 +1850 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +1850 +2010 + +1850 +2010 + +1850 +2010 + +lnd/clm2/firedata/clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +.true. +.false. + + + + + +20 + + + + + + + +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.1x0.1_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_AVHRR_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_10x10min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_3x3min_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_IGBP-GSDP_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_ISRIC-WISE_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne120np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_4x5_nomask_to_0.1x0.1_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_1.9x2.5_nomask_to_0.1x0.1_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne240np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.9x1.25_GRDC_to_0.1x0.1_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_360x720_cruncep_to_0.1x0.1_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.1x0.1_nomask_aave_da_c130405.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_AVHRR_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_10x10min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_USGS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_LandScan2004_to_1x1_asphaltjungleNJ_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_IGBP-GSDP_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_ISRIC-WISE_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.9x1.25_GRDC_to_1x1_asphaltjungleNJ_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_360x720_cruncep_to_1x1_asphaltjungleNJ_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_AVHRR_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_10x10min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_USGS_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_LandScan2004_to_1x1_brazil_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_IGBP-GSDP_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_ISRIC-WISE_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.9x1.25_GRDC_to_1x1_brazil_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_360x720_cruncep_to_1x1_brazil_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_brazil_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_AVHRR_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_10x10min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_USGS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_LandScan2004_to_1x1_camdenNJ_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_IGBP-GSDP_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_ISRIC-WISE_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.9x1.25_GRDC_to_1x1_camdenNJ_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_360x720_cruncep_to_1x1_camdenNJ_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_camdenNJ_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_AVHRR_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_10x10min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_USGS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_LandScan2004_to_1x1_mexicocityMEX_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_IGBP-GSDP_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_ISRIC-WISE_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.9x1.25_GRDC_to_1x1_mexicocityMEX_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_360x720_cruncep_to_1x1_mexicocityMEX_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_mexicocityMEX_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_AVHRR_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_10x10min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_USGS_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_LandScan2004_to_1x1_numaIA_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_IGBP-GSDP_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_ISRIC-WISE_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.9x1.25_GRDC_to_1x1_numaIA_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_360x720_cruncep_to_1x1_numaIA_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_numaIA_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_AVHRR_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_10x10min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_USGS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_LandScan2004_to_1x1_smallvilleIA_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_IGBP-GSDP_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_ISRIC-WISE_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.9x1.25_GRDC_to_1x1_smallvilleIA_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_360x720_cruncep_to_1x1_smallvilleIA_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_smallvilleIA_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_AVHRR_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_10x10min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_USGS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_LandScan2004_to_1x1_tropicAtl_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_IGBP-GSDP_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_ISRIC-WISE_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.9x1.25_GRDC_to_1x1_tropicAtl_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_360x720_cruncep_to_1x1_tropicAtl_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_tropicAtl_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_AVHRR_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_10x10min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_USGS_to_1x1_urbanc_alpha_nomask_aave_da_c120928.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_LandScan2004_to_1x1_urbanc_alpha_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_IGBP-GSDP_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_ISRIC-WISE_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.9x1.25_GRDC_to_1x1_urbanc_alpha_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_360x720_cruncep_to_1x1_urbanc_alpha_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_urbanc_alpha_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_AVHRR_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_10x10min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_USGS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_LandScan2004_to_1x1_vancouverCAN_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_IGBP-GSDP_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_ISRIC-WISE_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.9x1.25_GRDC_to_1x1_vancouverCAN_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_360x720_cruncep_to_1x1_vancouverCAN_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_vancouverCAN_nomask_aave_da_c130403.nc + + + +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_landuse_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_lanwat_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_10minx10min_topo_to_0.9x1.25_aave_da_110630.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_soitex_to_0.9x1.25_aave_da_110722.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_irrig_to_0.9x1.25_aave_da_110529.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5x5min_ISRIC-WISE_to_0.9x1.25_nomask_aave_da_c120525.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_MODIS_to_0.9x1.25_nomask_aave_da_c120523.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_USGS_to_0.9x1.25_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_LandScan2004_to_0.9x1.25_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner_to_0.9x1.25_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.9x1.25_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.9x1.25_GRDC_to_0.9x1.25_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_360x720_cruncep_to_0.9x1.25_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.9x1.25_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_landuse_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_lanwat_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_10minx10min_topo_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5minx5min_soitex_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_nomask_to_1.9x2.5_nomask_aave_da_c120606.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_ISRIC-WISE_to_1.9x2.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_MODIS_to_1.9x2.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_USGS_to_1.9x2.5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_LandScan2004_to_1.9x2.5_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner_to_1.9x2.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_1.9x2.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.9x1.25_GRDC_to_1.9x2.5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_360x720_cruncep_to_1.9x2.5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1.9x2.5_nomask_aave_da_c130405.nc + + +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_nomask_to_10x15_nomask_aave_da_c120327.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_ISRIC-WISE_to_10x15_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS_to_10x15_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_USGS_to_10x15_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_LandScan2004_to_10x15_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner-mergeGIS_to_10x15_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/10x15/map_0.9x1.25_GRDC_to_10x15_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/10x15/map_360x720_cruncep_to_10x15_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/10x15/map_1km-merge-10min_HYDRO1K-merge-nomask_to_10x15_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_AVHRR_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_10x10min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_IGBP-GSDP_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_ISRIC-WISE_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_USGS_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_LandScan2004_to_360x720_nomask_aave_da_c121017.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner-mergeGIS_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_0.9x1.25_GRDC_to_360x720_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/360x720/map_360x720_cruncep_to_360x720_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/360x720/map_1km-merge-10min_HYDRO1K-merge-nomask_to_360x720_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_MODIS_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_AVHRR_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_10x10min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_IGBP-GSDP_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_ISRIC-WISE_to_512x1024_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_MODIS_to_512x1024_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_USGS_to_512x1024_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_LandScan2004_to_512x1024_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner_to_512x1024_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner-mergeGIS_to_512x1024_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.9x1.25_GRDC_to_512x1024_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/512x1024/map_360x720_cruncep_to_512x1024_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/512x1024/map_1km-merge-10min_HYDRO1K-merge-nomask_to_512x1024_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_MODIS_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_AVHRR_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_10x10min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_IGBP-GSDP_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_ISRIC-WISE_to_128x256_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_MODIS_to_128x256_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_USGS_to_128x256_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_LandScan2004_to_128x256_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner_to_128x256_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner-mergeGIS_to_128x256_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/128x256/map_0.9x1.25_GRDC_to_128x256_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/128x256/map_360x720_cruncep_to_128x256_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/128x256/map_1km-merge-10min_HYDRO1K-merge-nomask_to_128x256_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_MODIS_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_AVHRR_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_10x10min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_IGBP-GSDP_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_ISRIC-WISE_to_64x128_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_MODIS_to_64x128_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_USGS_to_64x128_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_LandScan2004_to_64x128_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner_to_64x128_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner-mergeGIS_to_64x128_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/64x128/map_0.9x1.25_GRDC_to_64x128_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/64x128/map_360x720_cruncep_to_64x128_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/64x128/map_1km-merge-10min_HYDRO1K-merge-nomask_to_64x128_nomask_aave_da_c130403.nc + +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_MODIS_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_AVHRR_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_10x10min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_IGBP-GSDP_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_ISRIC-WISE_to_48x96_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_MODIS_to_48x96_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_USGS_to_48x96_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_LandScan2004_to_48x96_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner_to_48x96_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner-mergeGIS_to_48x96_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/48x96/map_0.9x1.25_GRDC_to_48x96_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/48x96/map_360x720_cruncep_to_48x96_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/48x96/map_1km-merge-10min_HYDRO1K-merge-nomask_to_48x96_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_MODIS_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_AVHRR_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_10x10min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_IGBP-GSDP_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_ISRIC-WISE_to_32x64_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_MODIS_to_32x64_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_USGS_to_32x64_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_LandScan2004_to_32x64_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner_to_32x64_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner-mergeGIS_to_32x64_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/32x64/map_0.9x1.25_GRDC_to_32x64_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/32x64/map_360x720_cruncep_to_32x64_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/32x64/map_1km-merge-10min_HYDRO1K-merge-nomask_to_32x64_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_MODIS_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_AVHRR_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_10x10min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_IGBP-GSDP_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_ISRIC-WISE_to_8x16_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_MODIS_to_8x16_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_USGS_to_8x16_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_LandScan2004_to_8x16_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner_to_8x16_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner-mergeGIS_to_8x16_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/8x16/map_0.9x1.25_GRDC_to_8x16_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/8x16/map_360x720_cruncep_to_8x16_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/8x16/map_1km-merge-10min_HYDRO1K-merge-nomask_to_8x16_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_MODIS_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_AVHRR_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_10x10min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_IGBP-GSDP_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_ISRIC-WISE_to_4x5_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_MODIS_to_4x5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_USGS_to_4x5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_LandScan2004_to_4x5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner_to_4x5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner-mergeGIS_to_4x5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/4x5/map_0.9x1.25_GRDC_to_4x5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/4x5/map_360x720_cruncep_to_4x5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/4x5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_4x5_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_MODIS_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_AVHRR_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_10x10min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_IGBP-GSDP_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_ISRIC-WISE_to_0.23x0.31_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_MODIS_to_0.23x0.31_nomask_aave_da_c110930.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_USGS_to_0.23x0.31_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner_to_0.23x0.31_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.23x0.31_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.9x1.25_GRDC_to_0.23x0.31_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_360x720_cruncep_to_0.23x0.31_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.23x0.31_nomask_aave_da_c130405.nc + + +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_MODIS_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_AVHRR_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_10x10min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_IGBP-GSDP_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_ISRIC-WISE_to_2.5x3.33_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_MODIS_to_2.5x3.33_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_USGS_to_2.5x3.33_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_LandScan2004_to_2.5x3.33_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner_to_2.5x3.33_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner-mergeGIS_to_2.5x3.33_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.9x1.25_GRDC_to_2.5x3.33_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_360x720_cruncep_to_2.5x3.33_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_1km-merge-10min_HYDRO1K-merge-nomask_to_2.5x3.33_nomask_aave_da_c130405.nc + + + + +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_AVHRR_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_MODIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_IGBPmergeICESatGIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_IGBP-GSDP_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_MODIS_to_0.5x0.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_ISRIC-WISE_to_0.5x0.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_LandScan2004_to_0.5x0.5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.1x0.1_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_4x5_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne120np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3_USGS_nomask_to_0.5x0.5_nomask_aave_da_c120912.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.9x1.25_GRDC_to_0.5x0.5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_360x720_cruncep_to_0.5x0.5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.5x0.5_nomask_aave_da_c130405.nc + + + +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_MODIS_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_AVHRR_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_10x10min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_IGBP-GSDP_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_ISRIC-WISE_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_MODIS_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_USGS_to_ne4np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner_to_ne4np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne4np4_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.9x1.25_GRDC_to_ne4np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne4np4/map_360x720_cruncep_to_ne4np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne4np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne4np4_nomask_aave_da_c130411.nc +lnd/clm2/mappingdata/maps/ne4np4/map_ne4np4_nomask_to_0.5x0.5_nomask_aave_da_c110923.nc + + +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_MODIS_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_AVHRR_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_10x10min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_IGBP-GSDP_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_ISRIC-WISE_to_ne16np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_MODIS_to_ne16np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_USGS_to_ne16np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_LandScan2004_to_ne16np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.9x1.25_GRDC_to_ne16np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne16np4/map_360x720_cruncep_to_ne16np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne16np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne16np4_nomask_aave_da_c130408.nc +lnd/clm2/mappingdata/maps/ne16np4/map_ne16np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_landuse_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_lanwat_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_10minx10min_topo_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_soitex_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_irrig_to_ne30np4_aave_da_110720.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5x5min_ISRIC-WISE_to_ne30np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_MODIS_to_ne30np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_USGS_to_ne30np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_LandScan2004_to_ne30np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner_to_ne30np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.9x1.25_GRDC_to_ne30np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne30np4/map_360x720_cruncep_to_ne30np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne30np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne30np4_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc + +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_MODIS_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_AVHRR_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_10x10min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_IGBP-GSDP_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_ISRIC-WISE_to_ne60np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_MODIS_to_ne60np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_USGS_to_ne60np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_LandScan2004_to_ne60np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.9x1.25_GRDC_to_ne60np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne60np4/map_360x720_cruncep_to_ne60np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne60np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne60np4_nomask_aave_da_c130405.nc +lnd/clm2/mappingdata/maps/ne60np4/map_ne60np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_landuse_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_lanwat_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_10minx10min_topo_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_soitex_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_irrig_to_ne120np4_aave_da_110817.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_LandScan2004_to_ne120np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.9x1.25_GRDC_to_ne120np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne120np4/map_360x720_cruncep_to_ne120np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne120np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne120np4_nomask_aave_da_c130405.nc + + + + +lnd/clm2/mappingdata/maps/ne120np4/map_0.1x0.1_nomask_to_ne120np4_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc + + + +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_MODIS_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_AVHRR_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_10x10min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_IGBP-GSDP_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_ISRIC-WISE_to_5x5_amazon_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_MODIS_to_5x5_amazon_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_USGS_to_5x5_amazon_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_LandScan2004_to_5x5_amazon_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner_to_5x5_amazon_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner-mergeGIS_to_5x5_amazon_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.9x1.25_GRDC_to_5x5_amazon_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_360x720_cruncep_to_5x5_amazon_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_1km-merge-10min_HYDRO1K-merge-nomask_to_5x5_amazon_nomask_aave_da_c130403.nc + +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_MODIS_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_AVHRR_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_10x10min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_IGBP-GSDP_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_ISRIC-WISE_to_ne240np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_MODIS_to_ne240np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_USGS_to_ne240np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_LandScan2004_to_ne240np4_nomask_aave_da_c120521.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.9x1.25_GRDC_to_ne240np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne240np4/map_360x720_cruncep_to_ne240np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne240np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne240np4_nomask_aave_da_c130405.nc +lnd/clm2/mappingdata/maps/ne240np4/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + + + +lnd/clm2/mappingdata/maps/0.125x0.125/map_0.5x0.5_AVHRR_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_0.5x0.5_MODIS_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_0.9x1.25_GRDC_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_10x10min_IGBPmergeICESatGIS_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_10x10min_nomask_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_360x720cru_cruncep_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_GLOBE-Gardner_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_LandScan2004_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_MODIS_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_3x3min_USGS_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_IGBP-GSDP_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_ISRIC-WISE_to_0.125x0.125_nomask_aave_da_c140702.nc +lnd/clm2/mappingdata/maps/0.125x0.125/map_5x5min_nomask_to_0.125x0.125_nomask_aave_da_c140702.nc + + + + + + + +. +. + + + + + +.false. + +.true. + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml b/components/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml new file mode 100644 index 0000000000..fa6166f687 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml @@ -0,0 +1,3376 @@ + + + + + + + + + + + + +none +SCRIP + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.23x0.31_nomask_c110308.nc +lnd/clm2/mappingdata/grids/0.9x1.25_c110307.nc +lnd/clm2/mappingdata/grids/1.9x2.5_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_2.5x3.33_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_4x5_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_10x15_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_512x1024_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_128x256_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_94x192_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_64x128_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_48x96_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_32x64_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_8x16_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_ne240np4_nomask_c091227.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne120np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne60np4_nomask_c100408.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne30np4_nomask_c101123.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne16np4_nomask_c110512.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_ne4np4_nomask_c110808.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.33x0.33_navy_c111207.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.1x0.1_nomask_c110712.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_AVHRR_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.5x0.5_MODIS_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_nomask_c110530.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_IGBP-GSDP_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5min_ISRIC-WISE_c111114.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_10x10min_nomask_c110228.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_10x10min_IGBPmergeICESatGIS_c110818.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_MODIS_c110915.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3x3_USGS_c120912.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_LandScan2004_c120517.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_GLOBE-Gardner_c120922.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_3minx3min_GLOBE-Gardner-mergeGIS_c120922.nc +64bit_offset +lnd/clm2/mappingdata/grids/SCRIPgrid_360x720_cruncep_c120830.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_360x720_nomask_c120830.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_0.9x1.25_GRDC_c130307.nc + + + +lnd/clm2/mappingdata/grids/UGRID_1km-merge-10min_HYDRO1K-merge-nomask_c130402.nc +netcdf4 +UGRID +landmesh + + +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_camdenNJ_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_brazil_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_camdenNJ_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_mexicocityMEX_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_numaIA_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_smallvilleIA_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_tropicAtl_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_urbanc_alpha_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_1x1pt_vancouverCAN_nomask_c110308.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5pt_amazon_nomask_c110308.nc + + +lnd/clm2/mappingdata/grids/SCRIPgrid_0.33x0.33_navy_c111207.nc +lnd/clm2/mappingdata/grids/SCRIPgrid_5x5_amazon_navy_c111207.nc +/glade/proj3/cseg/mapping/grids/gx1v6_090205.nc +/glade/proj3/cseg/mapping/grids/gx3v7_090903.nc +/glade/proj3/cseg/mapping/grids/tx1v1_090122.nc +/glade/proj3/cseg/mapping/grids/tx0.1v2_090127.nc + + +MODIS +AVHRR +AVHRR +MODIS +MODIS +MODIS +LandScan2004 +MODIS +ISRIC-WISE +GLOBE-Gardner +GLOBE-Gardner-mergeGIS +USGS +nomask +nomask +nomask +IGBP-GSDP +AVHRR +AVHRR +AVHRR +HYDRO1K-merge-nomask +GRDC +cruncep + + +3x3min +0.5x0.5 +0.5x0.5 +0.5x0.5 +0.5x0.5 +3x3min +3x3min +0.5x0.5 +5x5min +3x3min +3x3min +5x5min +10x10min +10x10min +5x5min +0.5x0.5 +0.5x0.5 +0.5x0.5 +1km-merge-10min +0.9x1.25 +360x720cru + + +mksrf_flakwat +mksrf_fwetlnd +mksrf_fvocef +mksrf_flai +mksrf_fvegtyp +mksrf_furban +mksrf_fsoicol +mksrf_forganic +mksrf_fglacier +mksrf_fmax +mksrf_furbtopo +mksrf_flndtopo +mksrf_fsoitex +mksrf_fgdp +mksrf_fpeat +mksrf_fabm +mksrf_ftopostats +mksrf_fvic +mksrf_fch4 + + +lnd/clm2/rawdata/mksrf_navyoro_20min.c010129.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_lai_global_c090506.nc + + + +lnd/clm2/rawdata/mksrf_irrig_2160x4320_simyr2000.c110527.nc + +lnd/clm2/rawdata/mksrf_soitex.10level.c010119.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_soilcol_global_c090324.nc + +lnd/clm2/rawdata/mksrf_organic_10level_5x5min_ISRIC-WISE-NCSCD_nlev7_c120830.nc + +lnd/clm2/rawdata/mksrf_fmax_3x3min_USGS_c120911.nc + + +lnd/clm2/rawdata/mksrf_LakePnDepth_3x3min_simyr2004_c111116.nc + +lnd/clm2/rawdata/mksrf_lanwat.050425.nc + + +lnd/clm2/rawdata/mksrf_vocef_0.5x0.5_simyr2000.c110531.nc + + +lnd/clm2/rawdata/topodata_10min_USGS_071205.nc + + +lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120621.nc + + + +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000.c120926.nc +lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000_mergeGreenland.c120921.nc + + +lnd/clm2/rawdata/mksrf_topo.10min.c080912.nc + + +lnd/clm2/rawdata/mksrf_gdp_0.5x0.5_AVHRR_simyr2000.c130228.nc + +lnd/clm2/rawdata/mksrf_peatf_0.5x0.5_AVHRR_simyr2000.c130228.nc + +lnd/clm2/rawdata/mksrf_abm_0.5x0.5_AVHRR_simyr2000.c130201.nc + +lnd/clm2/rawdata/mksrf_topostats_1km-merge-10min_HYDRO1K-merge-nomask_simyr2000.c130402.nc + +lnd/clm2/rawdata/mksrf_vic_0.9x1.25_GRDC_simyr2000.c130307.nc + +lnd/clm2/rawdata/mksrf_ch4inversion_360x720_cruncep_simyr2000.c130322.nc + + + + +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1000_c100614.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1001_c100614.nc +lnd/clm2/rawdata/pftdyn.testing.testyr1000-1004/mksrf_pft_10x15_testyr1002_c100614.nc + +lnd/clm2/rawdata/pftlanduse.3minx3min.simyr2000.c110913/mksrf_landuse_rc2000_c110913.nc + +lnd/clm2/rawdata/pftlanduse.3minx3min.simyr2000.c110913/mksrf_78pft_landuse_rc2000_c130927.nc + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1851_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1852_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1853_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1854_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1855_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1856_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1857_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1858_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1859_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1860_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1861_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1862_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1863_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1864_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1865_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1866_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1867_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1868_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1869_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1870_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1871_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1872_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1873_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1874_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1875_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1876_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1877_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1878_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1879_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1880_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1881_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1882_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1883_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1884_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1885_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1886_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1887_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1888_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1889_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1890_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1891_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1892_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1893_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1894_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1895_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1896_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1897_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1898_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1899_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1900_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1901_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1902_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1903_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1904_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1905_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1906_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1907_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1908_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1909_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1910_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1911_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1912_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1913_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1914_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1915_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1916_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1917_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1918_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1919_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1920_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1921_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1922_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1923_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1924_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1925_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1926_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1927_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1928_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1929_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1930_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1931_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1932_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1933_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1934_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1935_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1936_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1937_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1938_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1939_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1940_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1941_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1942_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1943_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1944_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1945_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1946_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1947_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1948_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1949_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1950_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1951_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1952_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1953_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1954_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1955_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1956_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1957_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1958_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1959_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1960_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1961_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1962_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1963_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1964_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1965_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1966_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1967_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1968_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1969_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1970_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1971_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1972_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1973_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1974_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1975_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1976_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1977_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1978_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1979_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1980_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1981_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1982_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1983_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1984_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1985_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1986_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1987_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1988_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1989_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1990_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1991_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1992_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1993_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1994_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1995_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1996_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1997_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1998_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1999_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_78pft_harvest_landuse_rc2000_c150203.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2000_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2001_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2002_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2003_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2004_c090630.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2005_c090630.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0850_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0851_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0852_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0853_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0854_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0855_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0856_c100519.v2.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0857_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0858_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0859_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0860_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0861_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0862_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0863_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0864_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0865_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0866_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0867_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0868_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0869_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0870_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0871_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0872_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0873_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0874_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0875_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0876_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0877_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0878_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0879_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0880_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0881_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0882_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0883_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0884_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0885_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0886_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0887_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0888_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0889_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0890_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0891_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0892_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0893_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0894_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0895_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0896_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0897_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0898_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0899_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0900_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0901_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0902_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0903_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0904_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0905_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0906_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0907_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0908_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0909_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0910_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0911_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0912_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0913_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0914_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0915_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0916_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0917_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0918_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0919_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0920_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0921_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0922_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0923_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0924_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0925_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0926_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0927_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0928_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0929_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0930_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0931_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0932_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0933_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0934_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0935_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0936_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0937_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0938_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0939_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0940_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0941_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0942_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0943_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0944_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0945_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0946_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0947_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0948_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0949_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0950_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0951_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0952_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0953_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0954_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0955_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0956_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0957_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0958_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0959_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0960_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0961_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0962_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0963_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0964_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0965_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0966_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0967_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0968_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0969_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0970_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0971_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0972_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0973_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0974_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0975_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0976_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0977_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0978_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0979_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0980_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0981_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0982_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0983_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0984_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0985_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0986_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0987_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0988_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0989_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0990_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0991_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0992_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0993_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0994_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0995_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0996_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0997_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0998_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm0999_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1000_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1001_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1002_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1003_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1004_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1005_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1006_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1007_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1008_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1009_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1010_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1011_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1012_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1013_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1014_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1015_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1016_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1017_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1018_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1019_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1020_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1021_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1022_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1023_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1024_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1025_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1026_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1027_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1028_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1029_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1030_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1031_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1032_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1033_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1034_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1035_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1036_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1037_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1038_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1039_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1040_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1041_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1042_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1043_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1044_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1045_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1046_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1047_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1048_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1049_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1050_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1051_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1052_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1053_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1054_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1055_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1056_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1057_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1058_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1059_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1060_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1061_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1062_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1063_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1064_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1065_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1066_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1067_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1068_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1069_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1070_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1071_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1072_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1073_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1074_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1075_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1076_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1077_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1078_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1079_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1080_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1081_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1082_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1083_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1084_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1085_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1086_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1087_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1088_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1089_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1090_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1091_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1092_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1093_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1094_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1095_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1096_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1097_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1098_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1099_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1100_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1101_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1102_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1103_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1104_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1105_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1106_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1107_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1108_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1109_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1110_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1111_c100519.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1112_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1113_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1114_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1115_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1116_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1117_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1118_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1119_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1120_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1121_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1122_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1123_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1124_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1125_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1126_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1127_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1128_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1129_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1130_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1131_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1132_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1133_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1134_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1135_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1136_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1137_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1138_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1139_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1140_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1141_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1142_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1143_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1144_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1145_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1146_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1147_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1148_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1149_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1150_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1151_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1152_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1153_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1154_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1155_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1156_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1157_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1158_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1159_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1160_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1161_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1162_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1163_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1164_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1165_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1166_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1167_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1168_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1169_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1170_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1171_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1172_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1173_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1174_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1175_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1176_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1177_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1178_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1179_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1180_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1181_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1182_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1183_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1184_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1185_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1186_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1187_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1188_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1189_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1190_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1191_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1192_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1193_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1194_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1195_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1196_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1197_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1198_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1199_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1200_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1201_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1202_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1203_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1204_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1205_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1206_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1207_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1208_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1209_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1210_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1211_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1212_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1213_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1214_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1215_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1216_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1217_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1218_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1219_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1220_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1221_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1222_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1223_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1224_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1225_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1226_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1227_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1228_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1229_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1230_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1231_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1232_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1233_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1234_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1235_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1236_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1237_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1238_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1239_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1240_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1241_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1242_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1243_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1244_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1245_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1246_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1247_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1248_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1249_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1250_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1251_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1252_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1253_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1254_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1255_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1256_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1257_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1258_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1259_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1260_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1261_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1262_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1263_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1264_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1265_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1266_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1267_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1268_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1269_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1270_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1271_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1272_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1273_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1274_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1275_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1276_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1277_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1278_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1279_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1280_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1281_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1282_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1283_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1284_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1285_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1286_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1287_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1288_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1289_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1290_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1291_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1292_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1293_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1294_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1295_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1296_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1297_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1298_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1299_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1300_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1301_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1302_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1303_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1304_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1305_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1306_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1307_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1308_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1309_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1310_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1311_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1312_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1313_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1314_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1315_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1316_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1317_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1318_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1319_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1320_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1321_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1322_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1323_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1324_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1325_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1326_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1327_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1328_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1329_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1330_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1331_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1332_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1333_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1334_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1335_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1336_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1337_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1338_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1339_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1340_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1341_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1342_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1343_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1344_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1345_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1346_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1347_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1348_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1349_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1350_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1351_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1352_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1353_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1354_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1355_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1356_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1357_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1358_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1359_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1360_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1361_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1362_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1363_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1364_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1365_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1366_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1367_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1368_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1369_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1370_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1371_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1372_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1373_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1374_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1375_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1376_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1377_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1378_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1379_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1380_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1381_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1382_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1383_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1384_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1385_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1386_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1387_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1388_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1389_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1390_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1391_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1392_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1393_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1394_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1395_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1396_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1397_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1398_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1399_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1400_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1401_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1402_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1403_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1404_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1405_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1406_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1407_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1408_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1409_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1410_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1411_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1412_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1413_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1414_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1415_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1416_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1417_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1418_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1419_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1420_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1421_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1422_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1423_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1424_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1425_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1426_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1427_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1428_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1429_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1430_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1431_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1432_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1433_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1434_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1435_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1436_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1437_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1438_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1439_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1440_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1441_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1442_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1443_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1444_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1445_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1446_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1447_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1448_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1449_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1450_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1451_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1452_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1453_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1454_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1455_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1456_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1457_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1458_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1459_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1460_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1461_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1462_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1463_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1464_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1465_c100520.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1466_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1467_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1468_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1469_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1470_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1471_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1472_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1473_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1474_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1475_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1476_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1477_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1478_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1479_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1480_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1481_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1482_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1483_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1484_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1485_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1486_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1487_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1488_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1489_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1490_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1491_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1492_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1493_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1494_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1495_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1496_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1497_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1498_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1499_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1500_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1501_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1502_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1503_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1504_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1505_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1506_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1507_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1508_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1509_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1510_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1511_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1512_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1513_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1514_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1515_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1516_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1517_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1518_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1519_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1520_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1521_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1522_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1523_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1524_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1525_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1526_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1527_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1528_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1529_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1530_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1531_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1532_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1533_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1534_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1535_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1536_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1537_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1538_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1539_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1540_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1541_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1542_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1543_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1544_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1545_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1546_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1547_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1548_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1549_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1550_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1551_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1552_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1553_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1554_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1555_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1556_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1557_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1558_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1559_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1560_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1561_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1562_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1563_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1564_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1565_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1566_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1567_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1568_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1569_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1570_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1571_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1572_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1573_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1574_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1575_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1576_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1577_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1578_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1579_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1580_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1581_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1582_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1583_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1584_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1585_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1586_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1587_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1588_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1589_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1590_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1591_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1592_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1593_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1594_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1595_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1596_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1597_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1598_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1599_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1600_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1601_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1602_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1603_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1604_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1605_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1606_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1607_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1608_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1609_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1610_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1611_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1612_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1613_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1614_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1615_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1616_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1617_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1618_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1619_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1620_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1621_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1622_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1623_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1624_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1625_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1626_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1627_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1628_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1629_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1630_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1631_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1632_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1633_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1634_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1635_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1636_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1637_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1638_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1639_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1640_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1641_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1642_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1643_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1644_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1645_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1646_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1647_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1648_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1649_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1650_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1651_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1652_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1653_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1654_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1655_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1656_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1657_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1658_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1659_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1660_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1661_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1662_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1663_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1664_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1665_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1666_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1667_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1668_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1669_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1670_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1671_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1672_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1673_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1674_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1675_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1676_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1677_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1678_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1679_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1680_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1681_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1682_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1683_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1684_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1685_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1686_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1687_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1688_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1689_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1690_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1691_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1692_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1693_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1694_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1695_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1696_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1697_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1698_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1699_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1700_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1701_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1702_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1703_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1704_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1705_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1706_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1707_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1708_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1709_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1710_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1711_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1712_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1713_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1714_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1715_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1716_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1717_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1718_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1719_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1720_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1721_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1722_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1723_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1724_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1725_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1726_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1727_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1728_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1729_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1730_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1731_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1732_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1733_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1734_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1735_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1736_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1737_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1738_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1739_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1740_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1741_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1742_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1743_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1744_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1745_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1746_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1747_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1748_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1749_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1750_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1751_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1752_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1753_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1754_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1755_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1756_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1757_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1758_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1759_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1760_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1761_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1762_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1763_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1764_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1765_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1766_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1767_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1768_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1769_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1770_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1771_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1772_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1773_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1774_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1775_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1776_c100521.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1777_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1778_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1779_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1780_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1781_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1782_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1783_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1784_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1785_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1786_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1787_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1788_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1789_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1790_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1791_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1792_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1793_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1794_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1795_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1796_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1797_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1798_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1799_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1800_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1801_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1802_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1803_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1804_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1805_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1806_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1807_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1808_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1809_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1810_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1811_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1812_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1813_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1814_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1815_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1816_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1817_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1818_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1819_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1820_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1821_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1822_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1823_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1824_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1825_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1826_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1827_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1828_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1829_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1830_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1831_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1832_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1833_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1834_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1835_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1836_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1837_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1838_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1839_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1840_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1841_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1842_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1843_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1844_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1845_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1846_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1847_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1848_c100522.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.lastm.simyr0850-1850.c100522/mksrf_landuse_lastm1849_c100522.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2006_c100317.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2007_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2008_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2009_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2010_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2011_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2012_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2013_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2014_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2015_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2016_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2017_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2018_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2019_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2020_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2021_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2022_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2023_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2024_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2025_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2026_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2027_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2028_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2029_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2030_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2031_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2032_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2033_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2034_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2035_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2036_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2037_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2038_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2039_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2040_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2041_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2042_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2043_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2044_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2045_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2046_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2047_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2048_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2049_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2050_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2051_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2052_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2053_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2054_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2055_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2056_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2057_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2058_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2059_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2060_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2061_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2062_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2063_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2064_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2065_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2066_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2067_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2068_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2069_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2070_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2071_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2072_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2073_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2074_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2075_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2076_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2077_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2078_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2079_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2080_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2081_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2082_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2083_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2084_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2085_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2086_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2087_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2088_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2089_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2090_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2091_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2092_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2093_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2094_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2095_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2096_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2097_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2098_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2099_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.image.simyr2005-2100.c100121/mksrf_landuse_image2100_c100121.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2006_c100317.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2007_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2008_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2009_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2010_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2011_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2012_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2013_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2014_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2015_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2016_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2017_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2018_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2019_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2020_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2021_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2022_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2023_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2024_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2025_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2026_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2027_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2028_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2029_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2030_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2031_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2032_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2033_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2034_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2035_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2036_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2037_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2038_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2039_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2040_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2041_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2042_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2043_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2044_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2045_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2046_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2047_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2048_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2049_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2050_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2051_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2052_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2053_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2054_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2055_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2056_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2057_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2058_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2059_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2060_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2061_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2062_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2063_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2064_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2065_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2066_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2067_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2068_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2069_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2070_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2071_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2072_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2073_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2074_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2075_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2076_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2077_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2078_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2079_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2080_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2081_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2082_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2083_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2084_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2085_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2086_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2087_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2088_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2089_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2090_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2091_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2092_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2093_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2094_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2095_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2096_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2097_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2098_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2099_c100121.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.minicam.simyr2005-2100.c100121/mksrf_landuse_minicam2100_c100121.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2006_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2007_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2008_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2009_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2010_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2011_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2012_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2013_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2014_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2015_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2016_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2017_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2018_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2019_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2020_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2021_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2022_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2023_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2024_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2025_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2026_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2027_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2028_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2029_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2030_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2031_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2032_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2033_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2034_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2035_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2036_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2037_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2038_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2039_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2040_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2041_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2042_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2043_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2044_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2045_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2046_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2047_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2048_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2049_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2050_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2051_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2052_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2053_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2054_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2055_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2056_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2057_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2058_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2059_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2060_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2061_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2062_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2063_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2064_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2065_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2066_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2067_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2068_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2069_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2070_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2071_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2072_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2073_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2074_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2075_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2076_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2077_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2078_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2079_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2080_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2081_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2082_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2083_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2084_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2085_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2086_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2087_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2088_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2089_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2090_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2091_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2092_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2093_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2094_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2095_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2096_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2097_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2098_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2099_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.aim.ngwh.simyr2005-2100.c110602/mksrf_landuse_aim_2100_c110602.nc + + + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2006_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2007_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2008_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2009_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2010_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2011_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2012_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2013_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2014_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2015_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2016_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2017_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2018_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2019_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2020_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2021_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2022_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2023_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2024_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2025_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2026_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2027_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2028_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2029_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2030_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2031_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2032_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2033_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2034_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2035_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2036_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2037_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2038_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2039_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2040_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2041_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2042_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2043_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2044_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2045_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2046_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2047_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2048_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2049_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2050_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2051_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2052_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2053_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2054_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2055_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2056_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2057_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2058_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2059_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2060_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2061_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2062_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2063_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2064_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2065_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2066_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2067_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2068_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2069_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2070_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2071_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2072_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2073_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2074_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2075_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2076_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2077_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2078_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2079_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2080_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2081_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2082_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2083_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2084_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2085_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2086_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2087_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2088_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2089_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2090_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2091_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2092_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2093_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2094_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2095_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2096_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2097_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2098_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2099_c110602.nc + +lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.message.ngwh.simyr2005-2100.c110602/mksrf_landuse_message_2100_c110602.nc + + + +atm/cam/ggas/ghg_hist_1765-2005_c091218.nc +atm/cam/ggas/ghg_rcp26_1765-2500_c100405.nc +atm/cam/ggas/ghg_rcp45_1765-2500_c100405.nc +atm/cam/ggas/ghg_rcp60_1765-2500_c100901.nc +atm/cam/ggas/ghg_rcp85_1765-2500_c100203.nc + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_drydep.xml b/components/clm/bld/namelist_files/namelist_defaults_drydep.xml new file mode 100644 index 0000000000..4d9dede5e9 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_drydep.xml @@ -0,0 +1,28 @@ + + + + + + + + + + +'O3','NO2','HNO3','NO','HO2NO2','CH3OOH','CH2O','CO','H2O2','CH3COOOH','PAN','MPAN','C2H5OOH','ONIT','POOH','C3H7OOH','ROOH','CH3COCHO','CH3COCH3','Pb','ONITR','MACROOH','XOOH','ISOPOOH','CH3OH','C2H5OH','CH3CHO','GLYALD','HYAC','HYDRALD','ALKOOH','MEKOOH','TOLOOH','TERPOOH','CH3COOH','CB1','CB2','OC1','OC2','SOA','SO2','SO4','NH3','NH4NO3' + +xactive_lnd + + + +'ISOP = isoprene', 'C10H16 = pinene_a + carene_3 + thujene_a', 'CH3OH = methanol', 'C2H5OH = ethanol', 'CH2O = formaldehyde', 'CH3CHO = acetaldehyde', 'CH3COOH = acetic_acid', 'CH3COCH3 = acetone' + +atm/cam/chem/trop_mozart/emis/megan21_emis_factors_c20120313.nc + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_overall.xml b/components/clm/bld/namelist_files/namelist_defaults_overall.xml new file mode 100644 index 0000000000..fa55cf3411 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_overall.xml @@ -0,0 +1,101 @@ + + + + + + + + + +arb_ic +cold +cold + + +/fs/cgd/csm/inputdata + + +1.9x2.5 +1x1_brazil +1x1_tropicAtl +5x5_amazon +1x1_camdenNJ +1x1_vancouverCAN +1x1_mexicocityMEX +1x1_asphaltjungleNJ +1x1_urbanc_alpha +1x1_numaIA +1x1_smallvilleIA + + +2000 + + +constant + + +1 +0 + + +1 +0 + + +-999.9 + + +.false. + + +gx1v6 +gx1v6 +gx1v6 +gx1v6 +gx3v7 +gx3v7 +USGS + +cruncep +USGS +USGS +gx3v7 +USGS +USGS + +T62 + +gx1v6 +gx1v6 +gx1v6 + +navy +test +navy +navy +navy +navy +navy +test +navy +test +gx1v6 + + + +.false. +.true. +0 +1 +3 +5 +10 +36 + + diff --git a/components/clm/bld/namelist_files/namelist_defaults_usr_files.xml b/components/clm/bld/namelist_files/namelist_defaults_usr_files.xml new file mode 100644 index 0000000000..14ba49de23 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_defaults_usr_files.xml @@ -0,0 +1,36 @@ + + + + + + + + + + +lnd/clm2/initdata/clmi.${clm_usr_name}_${mask}_simyr${sim_year}.nc + + +lnd/clm2/surfdata/surfdata_${clm_usr_name}_simyr${sim_year}.nc +lnd/clm2/surfdata_map/surfdata_${clm_usr_name}_simyr${sim_year}.nc + + +null +lnd/clm2/surfdata/landuse.timeseries_${clm_usr_name}_simyr${sim_year_range}.nc +lnd/clm2/surfdata/landuse.timeseries_${clm_usr_name}_simyr1849-2006.nc +lnd/clm2/surfdata/landuse.timeseries_rcp${rcp}_${clm_usr_name}_simyr${sim_year_range}.nc +lnd/clm2/surfdata/landuse.timeseries_rcp${rcp}_${clm_usr_name}_simyr1849-2006.nc + + diff --git a/components/clm/bld/namelist_files/namelist_definition.xsl b/components/clm/bld/namelist_files/namelist_definition.xsl new file mode 100644 index 0000000000..84ec079246 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_definition.xsl @@ -0,0 +1,282 @@ + + + + + + + + + + + + + CLM Namelist Definition + + +

+

+
+

+

+

Definition of CLM namelist variables

+

We list all of the relevant namelist variables for CLM I cases. This includes + CLM Namelist items as well as CLM build-namelist settings and namelist settings + for CLM offline tools.

+
+

Definition of CLM namelist variables

+

Note, these all would go into the user_nl_clm file + before configure):

+

Included in the table are the following pieces of information:

+
    +
  • Variable name.
    • +
  • Variable type (char, integer, + real, or logical). The type + char has the length appended + following an asterisk, e.g., char*256. Variables that are + arrays have their dimension specifier appended inside parentheses. For + example char*1(6) denotes a array of six + char*1 values. +
    • +
  • Variable description (includes information on defaults).
    • +
  • Valid values (if restricted).
    • +
+ + + + + + + + + + + + +
CLM Namelist Physics Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Lake Model Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Permafrost Model Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Methane Model Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Vertical CN Model Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Carbon Isotope Model Options
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Datasets
NameTypeDescription +
Valid values
+ + + + + + + + + + + + +
CLM Namelist History output settings
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Restart settings
NameTypeDescription
Valid values
+ + + + + + + + + + + + +
CLM Namelist Performance Tuning
NameTypeDescription
Valid values
+ +

+

+
+

+

+

Command Line Options to CLM Build-namelist

+

Variables that are entered as options to build-namelist (but NOT used by + namelists in code). Most of these are options that could be added to + CLM_BLDNML_OPTS. Included in the table are the following pieces + of information:

+
    +
  • Variable name.
    • +
  • Type.
    • +
  • Valid values.
    • +
  • Variable description.
    • +
+ + + + + + + + + + + + +
CLM Namelist Default Settings
NameTypeDescription
Valid values, if restricted at all
+

+

+
+

+

+

Namelist items for CLM Tools

+

These are namelist items that appear in the CLM Tools under components/clm/tools. +

+ + + + + + + + + + + +
CLM mksurfdata
NameTypeDescription
Valid values
+ + + + + + + + + + + +
CLM mkgriddata
NameTypeDescription
Valid values
+ + + + + + + + + + + +
Miscellaneous CLM tools
NameTypeDescription
Valid values
+ +
+ +

Namelist items for Driver Dry Deposition

+ + + + + + + + + + + +
Driver Dry-Deposition Namelist Options
NameTypeDescription
Valid values, if restricted at all
+ +
+ + + + + + + + + + + + Valid Values: + + + + + diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_0.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_0.xml new file mode 100644 index 0000000000..7e2c2d1b37 --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_0.xml @@ -0,0 +1,804 @@ + + + + + + + + + + + +Full pathname of initial conditions file. If blank CLM will startup from +arbitrary initial conditions. + + + +Full pathname of master restart file for a branch run. (only used if RUN_TYPE=branch) +(Set with RUN_REFCASE and RUN_REFDATE) + + + +Full pathname of land fraction data file. + + + +Clumps per processor. + + + +Atmospheric CO2 molar ratio (by volume) only used when co2_type==constant (umol/mol) +(Set by CCSM_CO2_PPMV) + + + +Type of CO2 feedback. + constant = use the input co2_ppmv value + prognostic = use the prognostic value sent from the atmosphere + diagnostic = use the diagnostic value sent from the atmosphere + + + + +Supplemental Nitrogen mode and for what type of vegetation it's turned on for. +In this mode Nitrogen is unlimited rather than prognosed and in general vegetation is +over-productive. It does act as a proxy for fertilization for crops however. + NONE = No vegetation types get supplemental Nitrogen + PROG_CROP_ONLY = Supplemental Nitrogen is only active for prognostic Crops + ALL = Supplemental Nitrogen is active for all vegetation types + + + +If TRUE, separate the vegetated landunit into a crop landunit and a natural vegetation landunit + + + +Number of multiple elevation classes over glacier points. +Normally this is ONLY used when running CESM with the active glacier model. + + + +If TRUE, calculate surface mass balance for glacier multi-elevation class points. +If false use growing degree day information for glaciers multi-elevation class points. +Only works when glc_nec is greater than 0. +(Only tested with glc_smb=.true., setting it to .false. is NOT tested) + + + +If TRUE, dynamically change topographic height over glacier points. +Only works when glc_nec is greater than zero. +(EXPERIMENTAL AND NOT FUNCTIONAL!) + + + +Visible and Near-infrared albedo's for glacier ice + + + +Time step (seconds) + + + +Override the start type from the driver: it can only be +set to 3 meaning branch. + + + +Full pathname of land-ice mask data file (on lnd grid). + + + +Full pathname of topography data file. Only required when +land-ice model is active. + + + +Full pathname datafile with plant function type (PFT) constants + + + +Full pathname of time varying PFT data file. This causes the land-use types of +the initial surface dataset to vary over time. + + + +Full pathname of surface data file. + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name + + + +Per file averaging flag. + 'A' (average over history period) + 'I' (instantaneous) + 'X' (maximum over history period) + 'M' (minimum over history period) + + + +Averaging type of output for 1D vector output (when hist_dov2xy is false). + GRID means average all land-units up to the grid-point level + LAND means average all columns up to the land-unit level + COLS means average all PFT's up to the column level + PFTS means report everything on native PFT level + + + +If TRUE, implies output data on a 2D latitude/longitude grid. False means +output in 1D vector format. One setting per history tape series. + + + +If TRUE, indicates do NOT output any default history fields (requires you to use +hist_fincl* to set the exact output fields to use).. + + + +Fields to exclude from history tape series 1. + + + +Fields to exclude from history tape series 2. + + + +Fields to exclude from history tape series 3. + + + +Fields to exclude from history tape series 4. + + + +Fields to exclude from history tape series 5. + + + +Fields to exclude from history tape series 6. + + + +Fields to add to history tape series 1. + + + +Fields to add to history tape series 2. + + + +Fields to add to history tape series 3. + + + +Fields to add to history tape series 4. + + + +Fields to add to history tape series 5. + + + +Fields to add to history tape series 6. + + + +Per tape series maximum number of time samples. + + + +Per tape series history file density (i.e. output precision) + 1=double precision + 2=single precision +Default: 2,2,2,2,2,2 + + + +Per tape series history write frequency. + positive means in time steps + 0=monthly + negative means hours +(i.e. 5 means every 24 time-steps and -24 means every day +Default: 0,-24,-24,-24,-24,-24 + + + +number of segments per clump for decomposition +Default: 20 + + + +Perturbation limit when doing error growth test + + + +If FALSE, don't write any restart files. + + + +Turn urban air conditioning/heating ON or OFF and add wasteheat: + OFF = Air conditioning/heating is OFF in buildings, internal temperature allowed to float freely + ON = Air conditioning/heating is ON in buildings, internal temperature constrained + ON_WASTEHEAT = Air conditioning/heating is ON and waste-heat sent to urban canyon + + + +If TRUE, urban traffic flux will be activated (Currently NOT implemented). + + + +If TRUE, write diagnostic of global radiative temperature written to CLM log file. + + + + + + +SCRIP format grid data file + + + +Flag to pass to the ESMF mapping utility, telling it what kind of large +file support is needed for an output file generated with this grid as +either the source or destination ('none', '64bit_offset' or 'netcdf4'). + + + +Flag to pass to the ESMF mapping utility, telling it what kind of grid +file this is (SCRIP or UGRID). + + + +For UGRID files, flag to pass to the ESMF mapping utility, telling it the +name of the dummy variable that has all of the topology information stored +in its attributes. (Only used if scripgriddata_src_type = UGRID.) + + + + + + +Filename for mksurfdata_map to remap raw data into the output surface dataset + + + +Plant Function Type dataset for mksurfdata + + + +Dataset for percent glacier land-unit for mksurfdata + + + +Dataset for topography used to define urban threshold + + + +Dataset for land topography + + + +Leaf Area Index dataset for mksurfdata + + + +Soil texture dataset for mksurfdata + + + +Soil color dataset for mksurfdata + + + +Soil max fraction dataset for mksurfdata + + + +High resolution land mask/fraction dataset for mksurfdata +(used for glacier_mec land-units) + + + +Type of grid to create for mksurfdata + + + +Grid file at the output resolution for mksurfdata + + + +Text file with filepaths (or list of XML elements) for vegetation fractions +and harvesting for each year to run over for mksurfdata to be able to model +transient land-use change + + + +High resolution topography dataset for mksurfdata +(used for glacier_mec land-units) + + + +Irrigation dataset for mksurfdata + + + +Organic soil dataset for mksurfdata + + + +Lake water dataset for mksurfdata + + + +Wetland dataset for mksurfdata + + + +Urban dataset for mksurfdata + + + +Biogenic Volatile Organic Compounds (VOC) emissions dataset for mksurfdata + + + +If TRUE, output variables in double precision for mksurfdata + + + +If TRUE, ignore other files, and set the output percentage to 100% urban and +zero for other land-use types. + + + +Number of Plant Functional Types (excluding bare-soil) + + + +Plant Function Type index to override global file with for mksurfdata + + + +Plant Function Type fraction to override global file with for mksurfdata + + + +Soil color index to override global file with for mksurfdata + + + +Soil maximum fraction to override global file with for mksurfdata + + + +Soil percent sand to override global file with for mksurfdata + + + +Soil percent clay to override global file with for mksurfdata + + + + + + + +Orography file with surface heights and land area fraction + + + +CLM grid file + + + +CESM domain file + + + +CAM file + + + +Raw topography file + + + +CAM topography file + + + +Number of longitudes to use for a regional grid (for single-point set to 1) + + + +Number of latitudes to use for a regional grid (for single-point set to 1) + + + +Northern edge of the regional grid + + + +Southern edge of the regional grid + + + +Eastern edge of the regional grid + + + +Western edge of the regional grid + + + + + + + +Historical greenhouse gas concentrations from CAM, only used +by getco2_historical.ncl + + + + + + +Aerosol deposition file name (only used for aerdepregrid.ncl) + + + +Full pathname of CLM fraction dataset (only used for mkdatadomain). + + + +Full pathname of CLM grid dataset (only used for mkdatadomain). + + + +Full pathname of output domain dataset (only used for mkdatadomain). + + + +Type of domain file to create (ocean or atmosphere) (only used for mkdatadomain) + + + + + + + +First year to loop over for Nitrogen Deposition data + + + +Last year to loop over for Nitrogen Deposition data + + + +Simulation year that aligns with stream_year_first_ndep value + + + +Filename of input stream data for Nitrogen Deposition + + + +Mapping method from Nitrogen deposition input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + +datm input directory + + +datm output directory + + +Datm logfile name + + + + + + + +Mapping file to go from one resolution/land-mask to another resolution/land-mask + + + +Land mask description for mksurfdata input files + + + +Horizontal grid resolutions for mksurfdata input files + + + + + + + +Check that the resolution and land-mask is valid before continuing. + + + +Add a note to the output namelist about the options given to build-namelist + + + +CLM run type. + 'default' use the default type of clm_start type for this configuration + 'cold' is a run from arbitrary initial conditions + 'arb_ic' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found + 'startup' is an initial run with initial conditions provided. + 'continue' is a restart run. + 'branch' is a restart run in which properties of the output history files may be changed. + + + +Horizontal resolutions +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools + + + +Representative concentration pathway for future scenarios [radiative forcing at peak or 2100 in W/m^2] +-999.9 means do NOT use a future scenario, just use historical data. + + + +Land mask description + + + +If TRUE, irrigation will be active (find surface datasets with active irrigation). + + + +Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.) +A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year greater than 2005 corresponds to rcp scenario data +Most years are only used for clm_tools and there aren't CLM datasets that correspond to them. +CLM datasets exist for years: 1000 (for testing), 1850, and 2000 + + + +Range of years to simulate transitory datasets for (such as dynamic: land-use datasets, aerosol-deposition, Nitrogen deposition rates etc.) +Constant means simulation will be held at a constant year given in sim_year. +A sim_year_range of 1000-1002 or 1000-1004 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year_range that goes beyond 2005 corresponds to historical data until 2005 and then scenario data beyond that point. + + + +Namelist entries to demand be provided on the namelist. + + + +Description of the use case selected. + + + + + + + +Where dry deposition is calculated (from land, atmosphere, or from a table) + + + + +List of chemical constituents that dry deposition will be calculated for + + + + + + + +File containing MEGAN emissions factors. Includes the list of MEGAN compounds that can be +used in the Comp_Name variable on the file. + + + +MEGAN specifier. This is in the form of: Chem-compound = megan_compound(s) +where megan_compound(s) can be the sum of megan compounds with a "+" between them. +In each equation, the item to the left of the equal sign is a CAM chemistry compound, the +items to the right are compounds known to the MEGAN model (single or combinations). +For example, +megan_specifier = 'ISOP = isoprene', + 'C10H16 = pinene_a + carene_3 + thujene_a' + + + +MEGAN mapped isoprene emissions factors switch +If TRUE then use mapped MEGAN emissions factors for isoprene. + + + +List of possible MEGAN compounds to use + (the list used by the simulation is on the megan_factors_file as the Comp_Name) + + + + + +Enable C13 model + + + +Enable C14 model + + + diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml new file mode 100644 index 0000000000..d89038523c --- /dev/null +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml @@ -0,0 +1,1585 @@ + + + + + + + + + + + +If non-blank, then interpinic will be called to interpolate finidat_interp_source and +create output file specified by finidat_interp_dest. +For this to be used finidat MUST BE blank. + + + +If finidat_interp_source is set to non-blank, then interpinic will be called +to interpolate finidat_interp_source and create output file finidat_interp_dest. + + + +Full pathname of initial conditions file. If blank CLM will startup from +arbitrary initial conditions. + + + +Full pathname of master restart file for a branch run. (only used if RUN_TYPE=branch) +(Set with RUN_REFCASE and RUN_REFDATE) + + + +Full pathname of land fraction data file. + + + +Clumps per processor. + + + +Atmospheric CO2 molar ratio (by volume) only used when co2_type==constant (umol/mol) +(Set by CCSM_CO2_PPMV) + + + +Type of CO2 feedback. + constant = use the input co2_ppmv value + prognostic = use the prognostic value sent from the atmosphere + diagnostic = use the diagnostic value sent from the atmosphere + + + + +Supplemental Nitrogen mode and for what type of vegetation it's turned on for. +In this mode Nitrogen is unlimited rather than prognosed and in general vegetation is +over-productive. + NONE = No vegetation types get supplemental Nitrogen + ALL = Supplemental Nitrogen is active for all vegetation types + + + +If TRUE, separate the vegetated landunit into a crop landunit and a natural vegetation landunit + + + +If TRUE, make ALL pfts, columns and landunits active, even those with 0 weight. +This means that computations will be run even over these 0-weight points. + +THIS IS ONLY FOR TESTING PURPOSES - IT HAS NOT BEEN CHECKED FOR SCIENTIFIC VALIDITY. + + + +If TRUE, run with an increased number of soil layers +Interpolate the soil layers on the surface dataset to the soil layers specified in iniTimeConst +(EXPERIMENTAL) + + + +If TRUE, square the organic fraction when it's used (as was done in CLM4.5) +Otherwise use the fraction straight up (the default for CLM5.0) + + + +If TRUE, irrigation will be active. + + + +Number of multiple elevation classes over glacier points. +Normally this is ONLY used when running CESM with the active glacier model. + + + +If TRUE, calculate surface mass balance for glacier multi-elevation class points. +If false use growing degree day information for glaciers multi-elevation class points. +Only works when glc_nec is greater than 0. +(Only tested with glc_smb=.true., setting it to .false. is NOT tested) + + + +If TRUE, dynamically change areas and topographic heights over glacier points. +Only works when glc_nec is greater than zero, and when coupled to CISM. + + + +Number of days before one considers the perennially snow-covered point 'land ice' +(and thus capable of generating a positive surface mass balance for CISM). +Default: 7300 (20 years) + + + +Visible and Near-infrared albedo's for glacier ice + + + +Time step (seconds) + + + +Override the start type from the driver: it can only be +set to 3 meaning branch. + + + +Full pathname of land-ice mask data file (on lnd grid). + + + +Full pathname of topography data file. Only required when +land-ice model is active. + + + +If TRUE, downscale longwave radiation over glc_mec landunits. +This downscaling is conservative. +Default: .true. + + + + +Toggle to turn on the ED +(ED = 'on' is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn on spit fire (only relevant if ED is being used). + + + + +Toggle to turn on the LUNA model, not supporting CLM(ED) yet + + + + +Full pathname datafile with plant function type (PFT) constants combined with +constants for biogeochem modules + + + +Full pathname of surface data file. + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name + + + +Per file averaging flag. + 'A' (average over history period) + 'I' (instantaneous) + 'X' (maximum over history period) + 'M' (minimum over history period) + + + +Averaging type of output for 1D vector output (when hist_dov2xy is false). + GRID means average all land-units up to the grid-point level + LAND means average all columns up to the land-unit level + COLS means average all PFT's up to the column level + PFTS means report everything on native PFT level + + + +If TRUE, implies output data on a 2D latitude/longitude grid. False means +output in 1D vector format. One setting per history tape series. + + + +If TRUE, indicates do NOT output any default history fields (requires you to use +hist_fincl* to set the exact output fields to use).. + + + +Fields to exclude from history tape series 1. + + + +Fields to exclude from history tape series 2. + + + +Fields to exclude from history tape series 3. + + + +Fields to exclude from history tape series 4. + + + +Fields to exclude from history tape series 5. + + + +Fields to exclude from history tape series 6. + + + +Fields to add to history tape series 1. + + + +Fields to add to history tape series 2. + + + +Fields to add to history tape series 3. + + + +Fields to add to history tape series 4. + + + +Fields to add to history tape series 5. + + + +Fields to add to history tape series 6. + + + +Per tape series maximum number of time samples. + + + +Per tape series history file density (i.e. output precision) + 1=double precision + 2=single precision +Default: 2,2,2,2,2,2 + + + +Per tape series history write frequency. + positive means in time steps + 0=monthly + negative means hours +(i.e. 5 means every 24 time-steps and -24 means every day +Default: 0,-24,-24,-24,-24,-24 + + + +number of segments per clump for decomposition +Default: 20 + + + +Perturbation limit when doing error growth test + + + +If FALSE, don't write any restart files. + + + +Turn urban air conditioning/heating ON or OFF and add wasteheat: + OFF = Air conditioning/heating is OFF in buildings, internal temperature allowed to float freely + ON = Air conditioning/heating is ON in buildings, internal temperature constrained + ON_WASTEHEAT = Air conditioning/heating is ON and waste-heat sent to urban canyon + + + +If TRUE, urban traffic flux will be activated (Currently NOT implemented). + + + +0 = simpler method (clm4_5) +1 = prognostic calculation of interior building temp (clm5_0) + + + +If TRUE, human stress indices will be calculated + + + +If TRUE, write diagnostic of global radiative temperature written to CLM log file. + + + +Subgrid fluxes for snow + + + +If TRUE, repartition rain/snow from atmosphere based on temperature. + + + +Turn vegetation snow canopy ON, OFF, or ON with albedo influence (ON_RAD) + + + + + + +Toggle to make wild-fires inactive for biogeochemistry=CN mode + + + +Turn on methane model. Standard part of CLM45BGC model. + + + +CLM Biogeochemistry mode : Carbon Nitrogen model (CN) +(or CLM45BGC if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + + + +CLM Biogeochemistry mode : Carbon Nitrogen with Dynamic Global Vegetation Model (CNDV) +(or CLM45BGCDV if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + + + +Nitrification/denitrification splits the prognostic mineral N pool into two + mineral N pools: NO3 and NH4, and includes the transformations between them. +Requires the CN model to work (either CN or CNDV). + + + +Turn on vertical soil carbon. +Requires the CN model to work (either CN or CNDV). + + + +Use parameters for decomposition from the CENTURY Carbon model +Requires the CN model to work (either CN or CNDV). + + + +Toggle to use 25 lake layers instead of 10 +(extralaklayers=".true." is EXPERIMENTAL NOT SUPPORTED! Nor is it Tested!) + + + +Toggle to turn on the VIC hydrologic parameterizations +(vichydro=".true." is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn on the prognostic crop model + + + +Toggle to turn on ozone stress + + + +Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing +(snicar_frc=".true." is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn all history output completely OFF (possibly used for testing) + + + +Toggle for vancouver specific logic. + + + +Toggle for mexico city specific logic. + + + +Max number of plant functional types in naturally vegetated landunit. + + + + + + + +SCRIP format grid data file + + + +Flag to pass to the ESMF mapping utility, telling it what kind of large +file support is needed for an output file generated with this grid as +either the source or destination ('none', '64bit_offset' or 'netcdf4'). + + + +Flag to pass to the ESMF mapping utility, telling it what kind of grid +file this is (SCRIP or UGRID). + + + +For UGRID files, flag to pass to the ESMF mapping utility, telling it the +name of the dummy variable that has all of the topology information stored +in its attributes. (Only used if scripgriddata_src_type = UGRID.) + + + + + + +Filename for mksurfdata_map to remap raw data into the output surface dataset + + + +Plant Function Type dataset for mksurfdata + + + +Dataset for percent glacier land-unit for mksurfdata + + + +Dataset for topography used to define urban threshold + + + +Dataset for land topography + + + +Leaf Area Index dataset for mksurfdata + + + +Soil texture dataset for mksurfdata + + + +Soil color dataset for mksurfdata + + + +Soil max fraction dataset for mksurfdata + + + +High resolution land mask/fraction dataset for mksurfdata +(used for glacier_mec land-units) + + + +Type of grid to create for mksurfdata + + + +Grid file at the output resolution for mksurfdata + + + +Text file with filepaths (or list of XML elements) for vegetation fractions +and harvesting for each year to run over for mksurfdata to be able to model +transient land-use change + + + +High resolution topography dataset for mksurfdata +(used for glacier_mec land-units) + + + +Irrigation dataset for mksurfdata + + + +Organic soil dataset for mksurfdata + + + +Lake water dataset for mksurfdata + + + +Wetland dataset for mksurfdata + + + +Urban dataset for mksurfdata + + + +Biogenic Volatile Organic Compounds (VOC) emissions dataset for mksurfdata + + + +GDP dataset for mksurfdata + + + +Peat dataset for mksurfdata + + + +Agricultural burning dominant month dataset for mksurfdata + + + +Topography statistics dataset for mksurfdata + + + +VIC parameters dataset for mksurfdata + + + +Inversion-derived CH4 parameters dataset for mksurfdata + + + +If TRUE, output variables in double precision for mksurfdata + + + +If TRUE, ignore other files, and set the output percentage to 100% urban and +zero for other land-use types. + + + +If TRUE, set wetland to 0% over land (renormalizing other landcover types as needed); +wetland will only be used for ocean points. + + + +Number of Plant Functional Types (excluding bare-soil) + + + +Plant Function Type index to override global file with for mksurfdata + + + +Plant Function Type fraction to override global file with for mksurfdata + + + +Soil color index to override global file with for mksurfdata + + + +Soil maximum fraction to override global file with for mksurfdata + + + +Soil percent sand to override global file with for mksurfdata + + + +Soil percent clay to override global file with for mksurfdata + + + + + + + +Orography file with surface heights and land area fraction + + + +CLM grid file + + + +CESM domain file + + + +CAM file + + + +Raw topography file + + + +CAM topography file + + + +Number of longitudes to use for a regional grid (for single-point set to 1) + + + +Number of latitudes to use for a regional grid (for single-point set to 1) + + + +Northern edge of the regional grid + + + +Southern edge of the regional grid + + + +Eastern edge of the regional grid + + + +Western edge of the regional grid + + + + + + + +Historical greenhouse gas concentrations from CAM, only used +by getco2_historical.ncl + + + + + + +Aerosol deposition file name (only used for aerdepregrid.ncl) + + + +Full pathname of CLM fraction dataset (only used for mkdatadomain). + + + +Full pathname of CLM grid dataset (only used for mkdatadomain). + + + +Full pathname of output domain dataset (only used for mkdatadomain). + + + +Type of domain file to create (ocean or atmosphere) (only used for mkdatadomain) + + + + + + + +First year to loop over for Nitrogen Deposition data + + + +Last year to loop over for Nitrogen Deposition data + + + +Simulation year that aligns with stream_year_first_ndep value + + + +Filename of input stream data for Nitrogen Deposition + + + +Mapping method from Nitrogen deposition input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + + +Toggle to turn on use of LAI streams in place of the LAI on the surface dataset when using Satellite Phenology mode. +(EXPERIMENTAL and NOT tested) + + + +First year to loop over for LAI data + + + +Last year to loop over for LAI data + + + +Simulation year that aligns with stream_year_first_lai value + + + +Filename of input stream data for LAI + + + +Mapping method from LAI input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + + +First year to loop over for Lightning data + + + +Last year to loop over for Lightning data + + + +Simulation year that aligns with stream_year_first_lightng value + + + +Filename of input stream data for Lightning + + + +Mapping method from Lightning input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + + + +First year to loop over for human population density data + + + +Last year to loop over for human population density data + + + +Simulation year that aligns with stream_year_first_popdens value + + + +Filename of input stream data for human population density + + + +Mapping method from human population density input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + +datm input directory + + +datm output directory + + +Datm logfile name + + + + + + + +Mapping file to go from one resolution/land-mask to another resolution/land-mask + + + +Land mask description for mksurfdata input files + + + +Horizontal grid resolutions for mksurfdata input files + + + + + + + + +Check that the resolution and land-mask is valid before continuing. + + + +Add a note to the output namelist about the options given to build-namelist + + + +CLM run type. + 'default' use the default type of clm_start type for this configuration + 'cold' is a run from arbitrary initial conditions + 'arb_ic' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found + 'startup' is an initial run with initial conditions provided. + 'continue' is a restart run. + 'branch' is a restart run in which properties of the output history files may be changed. + + + +Horizontal resolutions +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools + + + +Representative concentration pathway for future scenarios [radiative forcing at peak or 2100 in W/m^2] +-999.9 means do NOT use a future scenario, just use historical data. + + + +Land mask description + + + +If TRUE, irrigation will be active (find surface datasets with active irrigation). + + + +Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.) +A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year greater than 2005 corresponds to rcp scenario data +Most years are only used for clm_tools and there aren't CLM datasets that correspond to them. +CLM datasets exist for years: 1000 (for testing), 1850, and 2000 + + + +Range of years to simulate transitory datasets for (such as dynamic: land-use datasets, aerosol-deposition, Nitrogen deposition rates etc.) +Constant means simulation will be held at a constant year given in sim_year. +A sim_year_range of 1000-1002 or 1000-1004 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year_range that goes beyond 2005 corresponds to historical data until 2005 and then scenario data beyond that point. + + + +Namelist entries to demand be provided on the namelist. + + + +Description of the use case selected. + + + +Command line arguement for turning on CN spinup mode. + + + +Command line arguement for biogeochemistry mode for CLM4.5 + sp = Satellitte Phenology + cn = Carbon Nitrogen model + bgc = CLM4.5 BGC model with: + CENTURY model pools + Nitrification/De-nitrification + Methane model + Vertically resolved Carbon + + + + + + + +Where dry deposition is calculated (from land, atmosphere, or from a table) + + + + +List of chemical constituents that dry deposition will be calculated for + + + + + + + +Flag for overriding the crash that should occur if user tries to start the model from a restart file made with a different version of the soil decomposition structure than is currently being used. + + + +Flag for setting the state of the Accelerated decomposition spinup state for the model. + 0 = normal model behavior; + 1 = AD spinup. +Entering and exiting spinup mode occurs automatically by comparing the namelist and restart file values for this variable. + + + + +Base advective flux (downwards) for SOM. + + + +Maximum depth to mix soils to by croturbation, in permafrost soils. + + + + +E-folding depth over which decomposition is slowed with depth in all soils. + + + +If TRUE, reduce heterotrophic respiration according to available oxygen predicted by CH4 submodel. + + + +If TRUE, weight calculation of oxygen limitation by the inundated fraction and diagnostic saturated column gas +concentration profile calculated in the CH4 submodel. Only applies if anoxia = TRUE. +(EXPERIMENTAL AND NOT FUNCTIONAL!) +(deprecated -- will be removed) + + + +separate q10 for frozen soil respiration rates. default to same as above zero rates + + + + + +If TRUE, rooting profile depends on specific PFT + + + +If true, use a single exponential function to define the profile for distributing C and N from belowground components (following Jackson et al., 1999). If False, use the default CLM rootfrac double exponential for distributing C and N from belowground components. +(EXPERIMENTAL and NOT tested) + + + +If pftspecific_rootingprofile is set to false, this sets a single exponential profile over which to distribute C and N coming from root pools (leaves, stem, grain). + + + +If TRUE, add extra diagnostics for methane model to the history files + + + +Profile over which to distribute C and N coming from surface pools (leaves, stem, grain). + + + + +If true, no denitrification or nitrification in frozen soil layers. +(EXPERIMENTAL and NOT tested) + + + +Number of days over which to use exponential relaxation of NPP in N fixation calculation + + + + +Enable C13 model + + + +Enable C14 model + + + +Flag to use the atmospheric time series of C14 concentrations from bomb fallout, rather than natural abundance C14 (nominally set as 10^-12 mol C14 / mol C) +(EXPERIMENTAL and NOT tested) + + + +Filename with time series of atmospheric Delta C14 data. variables in file are "time" and "atm_delta_c14". time variable is in format 1950.0, and time values must be monotonically increasing for interpolation, however spacing can be unequal. atm_delta_c14 variable has units of permil. +(EXPERIMENTAL and NOT tested) + + + + + + +If TRUE, weight btran (vegetation soil moisture availability) by unfrozen layers only, assuming that vegetation +will allocate roots preferentially to the active layer. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, weight btran (vegetation soil moisture availability) by the active layer, as defined by the greatest thaw depth over the current and prior years. +(EXPERIMENTAL and NOT tested) + + + + + + + +Turn on the clm 5.0 nitrogen model in clm 4.5/5.0 compsets. + + + + Michaelis Menten nitrogen uptake kinetics + clm 5.0: MM_Nuptake_opt = true + clm 4.5: MM_Nuptake_opt = false + + + + Dynamic plant allocation of nitrogen + clm 5.0: dynamic_plant_alloc_opt = false + clm 4.5: dynamic_plant_alloc_opt = false + + + + GPP downregulation + clm 5.0: downreg_opt = false + clm 4.5: downreg_opt = true + + + + Plant nitrogen demand + clm 5.0: plant_ndemand_opt = 3 + clm 4.5: plant_ndemand_opt = 0 + + + + Michaelis Menten substrate limitation + clm 5.0: substrate_term_opt = true + clm 4.5: substrate_term_opt = true + + + + Michaelis Menten nitrogen limitation + clm 5.0: nscalar_opt = true + clm 4.5: nscalar_opt = true + + + + Michaelis Menten temperature limitation + clm 5.0: temp_scalar_opt = true + clm 4.5: temp_scalar_opt = true + + + + Flexible CN ratio + clm 5.0: CNratio_floating = true + clm 4.5: CNratio_floating = false + + + + Leaf nitrogen content + clm 5.0: lnc_opt = true + clm 4.5: lnc_opt = false + + + + Reduce day length factor + clm 5.0: reduce_dayl_factor = false + clm 4.5: reduce_dayl_factor = false + + + + Vcmax calculation + clm 5.0: vcmax_opt = 3 + clm 4.5: vcmax_opt = 0 + + + + clm 5.0: CN_residual_opt = 1 + clm 4.5: CN_residual_opt = 0 + + + + clm 5.0: CN_partition_opt = 1 + clm 4.5: CN_partition_opt = 0 + + + + clm 5.0: carbon_excess_opt = 0 + clm 4.5: carbon_excess_opt = 0 + + + + clm 5.0: carbon_storage_excess_opt = 1 + clm 4.5: carbon_storage_excess_opt = 0 + + + + + clm 5.0: CN_evergreen_phenology_opt = 1 + clm 4.5: CN_evergreen_phenology_opt = 0 + + + + + + + + +Minimum lake depth to increase non-molecular thermal diffusivities by the factor deepmixing_mixfact. + + + +Factor to increase non-molecular thermal diffusivities for lakes deeper than deepmixing_depthcrit +to account for unresolved 3D processes. +Set to 1 to + + + +Visible and Near-infrared albedo values for melting lakes. Albedo will relax to these values as temperature +reaches melting when ice is present with no snow layers. Represents puddling, ice disintegration, and white ice. +Set to alblak values (0.6, 0.4) to keep albedo constant for ice-covered lakes without snow layers. + + + + + + + +Use old snow cover fraction from Niu et al. 2007 +(deprecated -- will be removed) + + + +If surface water is active or not +(deprecated -- will be removed) + + + +Use original CLM4 soil hydraulic properties +(deprecated -- will be removed) + + + + + + + +Allows user to tune the value of aereoxid. If set to FALSE, then use the value of aereoxid from +the parameter file (set to 0.0, but may be tuned with values in the range {0.0,1.0}. If set to TRUE, +then don't fix aere (see ch4Mod.F90). +Default: .true. + + + +If TRUE, turn on methane biogeochemistry model for lake columns, using a simplified version of the CH4 submodel. +(EXPERIMENTAL) + + + +If TRUE, apply a limitation to methane production based on the soil pH dataset. + + + +Michaelis-Mentin maximum methane oxidation rate (mol/m^3-water/s), in the unsaturated zone. + + + +If TRUE, maintain constant soil carbon under lakes, and use the methane submodel simply to predict the net conversion of +CO2 (via biological assimilation, decomposition, and methanogenesis) to CH4. If FALSE, transiently decompose initial +soil carbon stock based on soil carbon dataset. NOTE: if FALSE, a new transient source of C is added to the climate system, +so the coupled system will NOT conserve carbon in this mode if the methane model is coupled to the atmosphere. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, use the saturated fraction (fsat) calculated in Soil Hydrology to diagnose the inundated fraction (finundated) +for the CH4 submodel (possibly affecting soil heterotrophic respiration and denitrification depending on the configuration), +rather than using the inversion to satellite-observed inundated fraction, which requires additional surface data. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, use the fine root carbon predicted by CN when calculating the aerenchyma area, rather than the parametrization +based on annual NPP, aboveground NPP fraction, and LAI. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, run the methane submodel decoupled from the atmosphere. The atmospheric methane concentration is prescribed by +atmch4, the methane flux is not passed to the atmosphere, and the CO2 flux to the atmosphere is not adjusted for +net methane production. NOTE: Currently this must be TRUE. +(EXPERIMENTAL and NOT functional) + + + + + + + +File containing MEGAN emissions factors. Includes the list of MEGAN compounds that can be +used in the Comp_Name variable on the file. + + + +MEGAN specifier. This is in the form of: Chem-compound = megan_compound(s) +where megan_compound(s) can be the sum of megan compounds with a "+" between them. +In each equation, the item to the left of the equal sign is a CAM chemistry compound, the +items to the right are compounds known to the MEGAN model (single or combinations). +For example, +megan_specifier = 'ISOP = isoprene', + 'C10H16 = pinene_a + carene_3 + thujene_a' + + + +MEGAN mapped isoprene emissions factors switch +If TRUE then use mapped MEGAN emissions factors for isoprene. + + + +List of possible MEGAN compounds to use + (the list used by the simulation is on the megan_factors_file as the Comp_Name) + + + + + + + +Full pathname of time varying landuse data file. This causes the land-use types of +the initial surface dataset to vary over time. + + + +If TRUE, apply transient natural PFTs from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) + + + +If TRUE, apply transient crops from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) +(Also, only valid for use_crop = true.) + + + +If TRUE, apply harvest from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) +(Also, only valid for use_cn = true.) + + + + + + + +If TRUE (which is the default), check consistency between surface dataset used to create the finidat file +and the current fsurdat. This check is only done for a transient run. + + + +If TRUE (which is the default), check consistency between year on the finidat file +and the current model year. This check is only done for a transient run. + + + +If TRUE (which is the default), check consistency between pct_pft on the finidat file +and pct_pft read from the surface dataset. This check is only done for a NON-transient run. + + + + + + + +If TRUE (which is the default), check consistency between pct_nat_pft on the flanduse_timeseries file +and pct_nat_pft read from the surface dataset. + + + + + + + +Number of snow layers. +Values less than 5 are mainly useful for testing, and should not be used for science. + + + +Maximum snow depth in mm H2O equivalent. Additional mass gains will be capped when this depth +is exceeded. + + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml new file mode 100644 index 0000000000..10da2a47fb --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml @@ -0,0 +1,57 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + + +1850 + +1850-2100 + +2.6 + +flanduse_timeseries + +10 + + +.true. + +QICE +1,1 +0,-8760 + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml new file mode 100644 index 0000000000..a50664343a --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml @@ -0,0 +1,49 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP2.6 scenario from IMAGE + + +1850 + +1850-2100 + +2.6 + +flanduse_timeseries + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml new file mode 100644 index 0000000000..3347bd513f --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml @@ -0,0 +1,57 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + + +1850 + +1850-2100 + +4.5 + +flanduse_timeseries + +10 + + +.true. + +QICE +1,1 +0,-8760 + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml new file mode 100644 index 0000000000..077137a714 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml @@ -0,0 +1,49 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + + +1850 + +1850-2100 + +4.5 + +flanduse_timeseries + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml new file mode 100644 index 0000000000..e2ad58d03e --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml @@ -0,0 +1,57 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + + +1850 + +1850-2100 + +6 + +flanduse_timeseries + +10 + + +.true. + +QICE +1,1 +0,-8760 + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml new file mode 100644 index 0000000000..e6d7b9b8a3 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml @@ -0,0 +1,51 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP6 scenario from AIM + + +1850 + +1850-2100 + +6 + +flanduse_timeseries + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml new file mode 100644 index 0000000000..5cbce80495 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml @@ -0,0 +1,57 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + + +1850 + +1850-2100 + +8.5 + +flanduse_timeseries + +10 + + +.true. + +QICE +1,1 +0,-8760 + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml new file mode 100644 index 0000000000..791a02974b --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml @@ -0,0 +1,49 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + + +1850 + +1850-2100 + +8.5 + +flanduse_timeseries + +arb_ic + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2100 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850_control.xml b/components/clm/bld/namelist_files/use_cases/1850_control.xml new file mode 100644 index 0000000000..9aa99129b2 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850_control.xml @@ -0,0 +1,29 @@ + + + + +Conditions to simulate 1850 land-use + +1850 + +constant + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml b/components/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml new file mode 100644 index 0000000000..b6a4c62b01 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml @@ -0,0 +1,40 @@ + + + + + + +Running an IG case for 1850 conditions with the ice sheet model glimmer + +1850 + +constant + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + +1850 +1850 + +10 + + +.true. + +QICE +1,1 +0,-8760 + + diff --git a/components/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml b/components/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml new file mode 100644 index 0000000000..7bea625eab --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml @@ -0,0 +1,48 @@ + + + + +Simulate transient land-use, and aerosol deposition changes with historical data from 2000 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 2000 to 2005 and then with the RCP8.5 scenario from MESSAGE + +Simulate transient land-use, aerosol and Nitrogen deposition changes with historical data from 2000 to 2005 and then with the RCP8.5 scenario from MESSAGE + + +20050101 + +1850 + +2000-2100 + +8.5 + +flanduse_timeseries + +arb_ic + +2000 +2100 +2000 + +2000 +2100 +2000 + +2000 +2100 +2000 + +2000 +2100 +2000 + +2000 +2010 +2000 + +2000 +2010 +2000 + + diff --git a/components/clm/bld/namelist_files/use_cases/2000_control.xml b/components/clm/bld/namelist_files/use_cases/2000_control.xml new file mode 100644 index 0000000000..57a6ed6ea5 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/2000_control.xml @@ -0,0 +1,29 @@ + + + + +Conditions to simulate 2000 land-use + +2000 + +constant + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + + diff --git a/components/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml b/components/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml new file mode 100644 index 0000000000..9d35bbdac7 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml @@ -0,0 +1,40 @@ + + + + + + +Running an IG case for 2000 conditions with the ice sheet model glimmer + +2000 + +constant + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +10 + + +.true. + +QICE +1,1 +0,-8760 + + diff --git a/components/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml b/components/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml new file mode 100644 index 0000000000..e12f0a2433 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml @@ -0,0 +1,51 @@ + + + + +Simulate transient land-use, and aerosol deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 + +1850 + +1850-2000 + +arb_ic + +flanduse_timeseries + +10 + + +.true. + +QICE +1,1 +0,-8760 + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/20thC_transient.xml b/components/clm/bld/namelist_files/use_cases/20thC_transient.xml new file mode 100644 index 0000000000..9b905b07a1 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/20thC_transient.xml @@ -0,0 +1,42 @@ + + + + +Simulate transient land-use, and aerosol deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 +Simulate transient land-use, aerosol deposition, and Nitrogen deposition changes from 1850 to 2005 + +1850 + +1850-2000 + +arb_ic + +flanduse_timeseries + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2005 +1850 + +1850 +2010 +1850 + +1850 +2010 +1850 + + diff --git a/components/clm/bld/namelist_files/use_cases/README b/components/clm/bld/namelist_files/use_cases/README new file mode 100644 index 0000000000..f5fc5bd8b3 --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/README @@ -0,0 +1,37 @@ +Naming Convention for CLM use-cases Jan/2011 + +It's important that this naming convention be followed so that the PTCLM.py +utility can parse the use-cases appropriately. The build-namelist script also +checks for conformance with these conventions and won't work for names that +don't follow the convention. + +Ending suffix requires one of these endings: _transient, _control or _pd + +Transient cases: + + yyyy-yyyy_$rcp$desc_transient (for example 1850-2100_rcp8.5_transient) + + or + + 20thC$desc_transient (means nominal 1850-2000 although some datasets are 1850-2005) + +Control cases: + + yyyy$desc_control + + +Present day options (uses default present-day simulation year -- which right now is 2000): + + $desc_pd + +Where + +yyyy = Simulation year (such as 1850 or 2000). +yyyy-yyyy = Range of simulation years to run over (i.e.. 1850-2000). +$rcp = Representative concentration pathway (rcp) description string + for future scenarios: + rcp#.# (for example: rcp8.5, rcp6, rcp4.5, rcp2.6) + [can be blank for historical cases]. +$desc = Description of anything else -- alpha-numeric. + Should start with an underscore ("_") if not by itself + (for _transient and _control). diff --git a/components/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml b/components/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml new file mode 100644 index 0000000000..06c46bad3a --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml @@ -0,0 +1,18 @@ + + + + + + +Running an IG case with the ice sheet model glimmer + +10 + + +.true. + +QICE +1,1 +0,-8760 + + diff --git a/components/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml b/components/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml new file mode 100644 index 0000000000..90301b890d --- /dev/null +++ b/components/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml @@ -0,0 +1,21 @@ + + + + +Standard Urban Point Namelist Settings + +.true. + +.true., .false., .true. + +'TBUILD','BUILDHEAT','TRAFFICFLUX','WASTEHEAT','SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','COSZEN' + +'TG','TBOT','FIRE','FIRA','FLDS','FSDS','FSR','FSA','FGEV','FSH','FGR','TSOI','ERRSOI','BUILDHEAT','SABV','SABG','FSDSVD','FSDSND','FSDSVI','FSDSNI','FSRVD','FSRND','FSRVI','FSRNI','TSA','FCTR','FCEV','QBOT','Q2M','H2OSOI','H2OSNO','SOILLIQ','SOILICE','SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','SoilAlpha_U','ZWT','WA' + + +'SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','FSA','FIRA','TG','COSZEN','SoilAlpha_U','TBUILD','BUILDHEAT' + + +'OFF' + + diff --git a/components/clm/bld/query-xFail b/components/clm/bld/query-xFail new file mode 100755 index 0000000000..f3a25d1b2d --- /dev/null +++ b/components/clm/bld/query-xFail @@ -0,0 +1,113 @@ +#!/usr/bin/env python +"""Print human readable expected fail list to the screen. + +Author: Ben Andre + +""" + +from __future__ import print_function + +import sys + +if sys.hexversion < 0x02070000: + print(70*"*") + print("ERROR: query-xFail for CLM requires python >= 2.7.x. ") + print("It appears that you are running python {0}.{1}.{2}".format( + sys.version_info[0], sys.version_info[1], sys.version_info[2])) + print(70*"*") + sys.exit(1) + +import argparse +import os +import traceback +import xml.etree.ElementTree as ET + +def commandline_options(): + """ + Process the command line arguments. + """ + parser = argparse.ArgumentParser( + description='Dump a human readable version of the clm expected fail list.') + + parser.add_argument('--backtrace', action='store_true', + help='show exception backtraces as extra debugging ' + 'output') + + parser.add_argument('--debug', action='store_true', + help='extra debugging output') + + parser.add_argument('--xfail', default="unit_testers/xFail/expectedClmTestFails.xml", + help='path to expected fails file') + + parser.add_argument('--mach', nargs=1, required=True, + help='machine name') + + parser.add_argument('--compiler', nargs=1, required=True, + help='compiler name') + + + options = parser.parse_args() + return options + + +def get_expected_fail_list(thisdir, xfail_file, mach, compiler): + """Check if the expected fail file exists, and extract the list for + the specified machine/compiler. + + """ + xfail_path = os.path.abspath(thisdir+"/"+xfail_file) + if not os.path.isfile(xfail_path): + raise RuntimeError("Could not find expected fail file: {0}".format(xfail_path)) + + print("Expected failures from:") + print(" {0}".format(xfail_path)) + + tree = ET.parse(xfail_path) + group = "cesm/auxTests/{0}/{1}".format(mach, compiler.upper()) + + xfails = {} + xfail_aux = tree.findall(group)[0] + for test in xfail_aux.iter("entry"): + testid = test.attrib["testId"].strip() + xfails[testid] = {} + xfails[testid]['type'] = test.attrib["failType"].strip() + + return xfails + +def print_expected_fails(xfails): + for t in xfails: + print(" {0} : {1}".format(xfails[t]['type'], t)) + +def get_thisdir(): + stdout = os.popen("pwd") + cwd = os.path.abspath( stdout.read().rstrip( ) ) + dirname = os.path.dirname(sys.argv[0]) + if ( dirname == "" ): + thisdir = cwd + else: + thisdir = os.path.abspath(dirname) + + return(thisdir) + +def main(thisdir,options): + print("-"*80) + xfails = get_expected_fail_list( + thisdir,options.xfail, options.mach[0], options.compiler[0]) + print("-"*80) + print("CLM Expected fails for {0}_{1}".format(options.mach[0], options.compiler[0])) + print_expected_fails(xfails) + return 0 + + +if __name__ == "__main__": + thisdir = get_thisdir() + options = commandline_options() + try: + status = main(thisdir,options) + sys.exit(status) + except Exception as error: + print(str(error)) + if options.backtrace: + traceback.print_exc() + sys.exit(1) + diff --git a/components/clm/bld/queryDefaultNamelist.pl b/components/clm/bld/queryDefaultNamelist.pl new file mode 100755 index 0000000000..f88005aee5 --- /dev/null +++ b/components/clm/bld/queryDefaultNamelist.pl @@ -0,0 +1,320 @@ +#!/usr/bin/env perl +#======================================================================= +# +# This is a script to read the CLM namelist XML file +# +# Usage: +# +# queryDefaultNamelist.pl [options] +# +# To get help on options and usage: +# +# queryDefaultNamelist.pl -help +# +#======================================================================= + +use Cwd; +use strict; +#use diagnostics; +use Getopt::Long; +use English; + +#----------------------------------------------------------------------------------------------- + +#Figure out where configure directory is and where can use the XML/Lite module from +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +my $cwd = getcwd(); # current working directory +my $cfgdir; + +if ($ProgDir) { $cfgdir = $ProgDir; } +else { $cfgdir = $cwd; } + +#----------------------------------------------------------------------------------------------- +# Add $cfgdir to the list of paths that Perl searches for modules +my @dirs = ( $cfgdir, "$cfgdir/../../../cime/utils/perl5lib" ); +unshift @INC, @dirs; +my $result = eval "require XML::Lite"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"XML/Lite.pm\" from directories: @dirs ** +EOF +} +require Build::Config; +require Build::NamelistDefinition; +require queryDefaultXML; + +# Defaults +my $namelist = "clm_inparm"; +my $config = "config_cache.xml"; + + +sub usage { + die < $namelist, + model => "clm4_5", + var => undef, + hgrid => undef, + config => undef, + cesm => undef, + csmdata => undef, + demand => undef, + test => undef, + onlyfiles => undef, + fileonly => undef, + silent => undef, + usrname => undef, + help => undef, + options => undef, + ); + + my $cmdline = "@ARGV"; + GetOptions( + "f|file=s" => \$opts{'file'}, + "n|namelist=s" => \$opts{'namelist'}, + "v|var=s" => \$opts{'var'}, + "p|phys=s" => \$opts{'model'}, + "r|res=s" => \$opts{'hgrid'}, + "config=s" => \$opts{'config'}, + "cesm" => \$opts{'cesm'}, + "csmdata=s" => \$opts{'csmdata'}, + "demand" => \$opts{'demand'}, + "options=s" => \$opts{'options'}, + "t|test" => \$opts{'test'}, + "onlyfiles" => \$opts{'onlyfiles'}, + "filenameonly" => \$opts{'fileonly'}, + "justvalues" => \$opts{'justvalues'}, + "usrname=s" => \$opts{'usrname'}, + "s|silent" => \$opts{'silent'}, + "h|elp" => \$opts{'help'}, + ) or usage(); + + # Check for unparsed arguments + if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); + } + if ( $opts{'help'} ) { + usage(); + } + # Set if should do extra printing or not (if silent mode is not set) + my $printing = 1; + if ( defined($opts{'silent'}) ) { + $printing = 0; + } + # Get list of options from command-line into the settings hash + my %settings; + if ( defined($opts{'options'}) ) { + $opts{'options'} =~ s/\s//g; # Remove all white-space in options + my @optionlist = split( ",", $opts{'options'} ); + foreach my $item ( @optionlist ) { + my ($key,$value) = split( "=", $item ); + $settings{$key} = $value; + } + } + my $csmdata = ""; + if ( defined($opts{'fileonly'}) ) { + if ( ! defined($opts{'justvalues'}) ) { print "When -filenameonly option used, -justvalues is set as well\n" if $printing; } + if ( ! defined($opts{'onlyfiles'}) ) { print "When -filenameonly option used, -onlyfiles is set as well\n" if $printing; } + $opts{'justvalues'} = 1; + $opts{'onlyfiles'} = 1; + } + # List of input options + my %inputopts; + my $datmblddir = "$cfgdir/../../../cime/components/data_comps/datm/bld"; + my $drvblddir = "$cfgdir/../../../cime/driver_cpl/bld"; + my $model = $opts{'model'}; + my @nl_definition_files = ( "$datmblddir/namelist_files/namelist_definition_datm.xml", + "$drvblddir/namelist_files/namelist_definition_drv.xml", + "$cfgdir/namelist_files/namelist_definition_$model.xml" + ); + $inputopts{empty_cfg_file} = "$cfgdir/config_files/config_definition_$model.xml"; + $inputopts{nldef_files} = \@nl_definition_files; + $inputopts{namelist} = $opts{namelist}; + $inputopts{printing} = $printing; + $inputopts{cfgdir} = $cfgdir; + $inputopts{ProgName} = $ProgName; + $inputopts{cmdline} = $cmdline; + + my $exitearly = 0; + my $definition = Build::NamelistDefinition->new( $nl_definition_files[0] ); + foreach my $nl_defin_file ( @nl_definition_files ) { + if ( ! -f "$nl_defin_file" ) { + die "($ProgName $cmdline) ERROR:: bad namelist definition filename: $nl_defin_file.\n"; + } + $definition->add( "$nl_defin_file" ); + } + + if ( ! defined($opts{csmdata}) ) { + $inputopts{csmdata} = "default"; + } else { + $inputopts{csmdata} = $opts{csmdata}; + } + if ( defined($opts{cesm}) ) { + $inputopts{csmdata} = '$DIN_LOC_ROOT'; + } + if ( ! defined($opts{config}) ) { + $inputopts{config} = "noconfig"; + } else { + $inputopts{config} = $opts{config}; + } + if ( ! defined($opts{var}) ) { + $settings{'var'} = undef; + } elsif ( $opts{var} eq "list" ) { + print "Valid variables: " if $printing; + my @vars = $definition->get_var_names( ); + print "@vars\n"; + $exitearly = 1; + } else { + $settings{'var'} = $opts{'var'}; + } + if ( ! defined($opts{hgrid}) ) { + $inputopts{hgrid} = "any"; + } elsif ( $opts{hgrid} eq "list" ) { + print "Valid resolutions: " if $printing; + my @hgrids = $definition->get_valid_values( "res", 'noquotes'=>1 ); + print "@hgrids\n"; + $exitearly = 1; + } else { + if ( ! $definition->is_valid_value( "res", $opts{hgrid}, 'noquotes'=>1 ) ) { + if ( $opts{'hgrid'} ne $opts{'usrname'} ) { + die "($ProgName $cmdline) ERROR:: invalid resolution entered.\n"; + } + } + $inputopts{hgrid} = $opts{hgrid}; + } + # The namelist defaults file contains default values for all required namelist variables. + my @nl_defaults_files = ( "$cfgdir/namelist_files/namelist_defaults_overall.xml" ); + if ( defined($opts{'usrname'}) ) { + my $nl_defaults_file = "$cfgdir/namelist_files/namelist_defaults_usr_files.xml"; + push( @nl_defaults_files, $nl_defaults_file ); + $settings{'clm_usr_name'} = $opts{'usrname'}; + $settings{'notest'} = ! $opts{'test'}; + $settings{'csmdata'} = $inputopts{csmdata}; + } else { + my @files = ( "$cfgdir/namelist_files/namelist_defaults_${model}.xml", + "$cfgdir/namelist_files/namelist_defaults_${model}_tools.xml", + "$drvblddir/namelist_files/namelist_defaults_drv.xml", + "$cfgdir/namelist_files/namelist_defaults_drydep.xml", + "$datmblddir/namelist_files/namelist_defaults_datm.xml", + ); + push( @nl_defaults_files, @files ); + } + if ( ! $exitearly ) { + $inputopts{files} = \@nl_defaults_files; + + my $defaults_ref = &queryDefaultXML::ReadDefaultXMLFile( \%inputopts, \%settings ); + my %defaults = %$defaults_ref; + my @keys = keys(%defaults); + if ( defined($opts{'demand'}) && ($#keys == -1) ) { + die "($ProgName $cmdline) ERROR:: demand option is set and nothing was found.\n"; + } + my $print; + foreach my $var ( @keys ) { + $print = 1; + my $value = $defaults{$var}{value}; + my $isadir = $defaults{$var}{isdir}; + my $isafile = $defaults{$var}{isfile}; + my $isastr = $defaults{$var}{isstr}; + # If onlyfiles option set do NOT print if is NOT a file + if ( defined($opts{'onlyfiles'}) && (! $isafile) ) { + $print = undef; + } + # If is a directory + if ( $isadir ) { + # Test that this directory exists + if ( defined($opts{'test'}) && defined($print) ) { + print "Test that directory $value exists\n" if $printing; + if ( ! -d "$value" ) { + die "($ProgName) ERROR:: directory $value does NOT exist!\n"; + } + } + } + # If is a file + if ( $isafile ) { + # Test that this file exists + if ( defined($opts{'test'}) && defined($print) ) { + chomp( $value ); + print "Test that file $value exists\n" if $printing; + if ( ! -f "$value" ) { + die "($ProgName) ERROR:: file $value does NOT exist!\n"; + } + } + } + # If a string + if ( (! defined($opts{'justvalues'}) ) && ($isastr) ) { + $value = "\'$value\'"; + } + # if you just want the filename -- not the full path with the directory + if ( defined($opts{'fileonly'}) ) { + $value =~ s!(.*)/!!; + } + if ( defined($print) ) { + if ( ! defined($opts{'justvalues'}) ) { + print "$var = "; + } + print "$value\n"; + } + } + } + if ( $printing && defined($opts{'test'}) ) { + print "\n\nTesting was successful\n\n" + } + diff --git a/components/clm/bld/queryDefaultXML.pm b/components/clm/bld/queryDefaultXML.pm new file mode 100644 index 0000000000..85a81d8f9a --- /dev/null +++ b/components/clm/bld/queryDefaultXML.pm @@ -0,0 +1,161 @@ +#======================================================================= +# +# This is a perl module to read in a list of namelist_default files. +# +#======================================================================= +use strict; +use Build::Config; +use Build::NamelistDefinition; +use Build::NamelistDefaults; +use Build::Namelist; + +package queryDefaultXML; + +#------------------------------------------------------------------------------- + +sub read_cfg_file +# +# Read in the configuration cache XML file on the build-time configuration +# +{ + my ($file, $empty_cfg_file, $printing, $settings_ref) = @_; + + my $cfg; + my %config; + if ( $file eq "noconfig" ) { + print "No configuration cache file to read in.\n" if $printing; + $cfg = Build::Config->new( $empty_cfg_file ); + } elsif ( -f "$file" ) { + $cfg = Build::Config->new($file); + } else { + die "Bad filename entered: $file does NOT exist or can not open it.\n"; + } + # + # Make sure variables are set to valid values + # + foreach my $key ( keys( %config ) ) { + if ( $cfg->is_valid_name( $key ) ) { + $cfg->set( $key, $config{$key} ); + } + } + foreach my $key ( $cfg->get_names( ) ) { + if ( defined($$settings_ref{$key}) ) { + if ( $cfg->is_valid_name( $key ) ) { + $cfg->set( $key, $$settings_ref{$key} ); + } + } + } + return( $cfg ); +} + +#------------------------------------------------------------------------------- + +sub ReadDefaultXMLFile { +# +# Read in the default XML file for the default namelist settings +# + my $opts_ref = shift; + my $settings_ref = shift; + + # Error check that input and opts hash has the expected variables + my $ProgName = $$opts_ref{'ProgName'}; + my $nm = "${ProgName}::ReadDefaultXMLFile"; + my @required_list = ( "files", "nldef_files", "empty_cfg_file", "config", "namelist", + "csmdata", "hgrid", "printing", "ProgName", "cmdline", + "cfgdir" ); + foreach my $var ( @required_list ) { + if ( ! defined($$opts_ref{$var}) ) { + die "ERROR($nm): Required input variable $var was not found\n"; + } + } + my $printing = $$opts_ref{'printing'}; + my $cmdline = $$opts_ref{'cmdline'}; + # Initialize some local variables + my $files_ref = $$opts_ref{'files'}; + my @files = @$files_ref; + my $nldef_ref = $$opts_ref{'nldef_files'}; + my @nl_definition_files= @$nldef_ref; + my $empty_config_file = $$opts_ref{'empty_cfg_file'}; + my $namelist = $$opts_ref{'namelist'}; + + my $cfg = read_cfg_file( $$opts_ref{'config'}, $$opts_ref{'empty_cfg_file'}, + $printing, $settings_ref ); + + # + # Set up options to send to namelist defaults object + # + my %nlopts; + foreach my $var ( keys( %$settings_ref) ) { + if ( $var ne "csmdata" ) { + $nlopts{$var} = $$settings_ref{$var}; + } + } + if ( $$opts_ref{'hgrid'} ne "any" ) { + $nlopts{'hgrid'} = $$opts_ref{'hgrid'}; + } + # + # Loop through all variables in files + # + print "($nm) Read: $files[0]\n" if $printing; + my %defaults; + my $nldefaults = Build::NamelistDefaults->new($files[0], $cfg); + for ( my $i = 1; $i <= $#files; $i++ ) { + print "($nm) Read: $files[$i]\n" if $printing; + $nldefaults->add( $files[$i] ); + } + my $definition = Build::NamelistDefinition->new( $nl_definition_files[0] ); + for ( my $i = 1; $i <= $#nl_definition_files; $i++ ) { + print "($nm) Read: $nl_definition_files[$i]\n" if $printing; + $definition->add( $nl_definition_files[$i] ); + } + if ( $$opts_ref{'csmdata'} eq "default" ) { + $$opts_ref{'csmdata'} = $nldefaults->get_value( "csmdata", \%nlopts ); + } + $nlopts{'csmdata'} = $$opts_ref{'csmdata'}; + foreach my $name ( $nldefaults->get_variable_names() ) { + my $value = $nldefaults->get_value( $name, \%nlopts ); + if ( $value eq "null" ) { next; } + if ( defined($$settings_ref{'var'}) ) { + if ( $name ne $$settings_ref{'var'} ) { next; } + } + $value =~ s/\n//g; + my $isafile = 0; + if ( $definition->is_input_pathname($name) ) { + + if ( defined($$settings_ref{'clm_usr_name'}) ) { + $value = $nldefaults->get_usr_file( $name, $definition, \%nlopts ); + } + if ( $value && ($value !~ /^\/.+$/) ) { + $value = $$opts_ref{'csmdata'} . "/" . $value; + } + $isafile = 1; + } + my $isadir = 0; + my $isastr = 0; + if ( $definition->get_str_len($name) > 0 ) { + $isastr = 1; + } + # + # If is a directory (is a file and csmdata or a var with dir in name) + # + if ( $isafile && (($name eq "csmdata") || ($name =~ /dir/)) ) { + if ( $name eq "csmdata" ) { + $value = $$opts_ref{'csmdata'}; + $isadir = 1; + } else { + $isadir = 1; + } + } + # Return hash with the results + my $group = $definition->get_group_name( $name ); + if ( $group eq $namelist && $value && (! exists($defaults{$name}{'value'})) ) { + $defaults{$name}{'value'} = $value; + $defaults{$name}{'isfile'} = $isafile; + $defaults{$name}{'isdir'} = $isadir; + $defaults{$name}{'isstr'} = $isastr; + } + } + return( \%defaults ); +} + +1 # To make use or require happy diff --git a/components/clm/bld/test_build_namelist/README b/components/clm/bld/test_build_namelist/README new file mode 100644 index 0000000000..75313528cd --- /dev/null +++ b/components/clm/bld/test_build_namelist/README @@ -0,0 +1,98 @@ +Unit test directory for CLMBuildNamelist.pm +------------------------------------------- + +The goal of the unit test suite for build namelist is to have machine +independent tests that will run anywhere in seconds and have high +coverage of the critical decision making code. + +Running +======= + +To run the unit tests for CLMBuildNamelist.pm: + +$ prove test_build_namelist.pl + +The test output has been optimized to most useful when run through +prove (a standard part of all modern perl distributions). Developers +who prefer standard Test::More output can run the tests by running the +script: + +$ ./test_build_namelist.pl + + +Creating New Tests +================== + +To create a new test suite, copy the file: + +t/template_test_XXX.pm + +to t/test_what_you_want_to_test.pm + +Note: the contents of template_test_XXX.pm are valid tests and are +part of the test suite. This file should always be valid. + +New test files are picked up automatically by test_build_namelist.pl. + +Inside the new test module: + +* WWW, XXX, YYY, ZZZ are used as place holder text for things that + need to be replaced. + +* startup and shutdown - common fixtures for all tests. These methods + are only called once for each suite. The objects in these functions + should NOT BE MODIFIED by any tests, e.g. config_cache, + namelist_definition.xml, namelist_defaults.xml + +* setup and teardown - common fixtures for all tests. These methods + are called once for each test. Objects that ARE MODIFIED should be + created here. For example, the namelist object should be created + here so each test starts with a clean object. + +* Tests are automatically detected by functions starting with + 'test_'. The proposed naming conventions are 'test_XXX__YYY' where + XXX is the function or namelist variable being tested. YYY is a + descriptor of the branch (if phys==clm4_5) or condition being + tested. This will make the failure output more useful. + +* To create each test, simply create a minimal opts and nl_flags hash + and pass them into the function you want to test, then check the results. + +* Multiple tests can be placed in each function (including loops), but + this make it harder to what failed and why. By using one test per + test function, the failure messages will be more useful. + +* Rather than describing the test in comments, it should be described + in the message string. The message string should be printed to the + screen when the test fails with "... || diag($msg)". This provides a + useful failure message without duplicating information comments that + will become out of date. + +* To keep the tests machine independent, we don't want to require the + presence of the cesm input data repository. To meet this requirement + but still allow for testing of key functionality, modify or add new + mock xml files in t/input to point to mock files in the source + tree. Since build-namelist will not be reading netcdf data files, + mocks can be empty text files. + + +CPAN modules +============ + +The perl5lib directory contains the following modules from CPAN: + + * Test-Class-0.41 - test class that provides startup and shutdown methods + * Test-Exception-0.32 - allow testing for exceptions, e.g. tests that should die + * MRO-Compat-0.12 - dependency + * Sub-Uplevel-0.24 - dependency + +All modules were licensed under the same license as perl (Artistic +License or GNU GPL). As of 2014-03-17 see: + +http://search.cpan.org/~rjbs/Test-Class-0.41/lib/Test/Class.pm +http://search.cpan.org/~adie/Test-Exception-0.32/lib/Test/Exception.pm +http://search.cpan.org/~bobtfish/MRO-Compat-0.12/lib/MRO/Compat.pm +http://search.cpan.org/~dagolden/Sub-Uplevel-0.24/lib/Sub/Uplevel.pm + + + diff --git a/components/clm/bld/test_build_namelist/perl5lib/MRO/Compat.pm b/components/clm/bld/test_build_namelist/perl5lib/MRO/Compat.pm new file mode 100644 index 0000000000..be0fc803b5 --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/MRO/Compat.pm @@ -0,0 +1,411 @@ +package MRO::Compat; +use strict; +use warnings; +require 5.006_000; + +# Keep this < 1.00, so people can tell the fake +# mro.pm from the real one +our $VERSION = '0.12'; + +BEGIN { + # Alias our private functions over to + # the mro:: namespace and load + # Class::C3 if Perl < 5.9.5 + if($] < 5.009_005) { + $mro::VERSION # to fool Module::Install when generating META.yml + = $VERSION; + $INC{'mro.pm'} = __FILE__; + *mro::import = \&__import; + *mro::get_linear_isa = \&__get_linear_isa; + *mro::set_mro = \&__set_mro; + *mro::get_mro = \&__get_mro; + *mro::get_isarev = \&__get_isarev; + *mro::is_universal = \&__is_universal; + *mro::method_changed_in = \&__method_changed_in; + *mro::invalidate_all_method_caches + = \&__invalidate_all_method_caches; + require Class::C3; + if($Class::C3::XS::VERSION && $Class::C3::XS::VERSION > 0.03) { + *mro::get_pkg_gen = \&__get_pkg_gen_c3xs; + } + else { + *mro::get_pkg_gen = \&__get_pkg_gen_pp; + } + } + + # Load mro.pm and provide no-op Class::C3::.*initialize() funcs for 5.9.5+ + else { + require mro; + no warnings 'redefine'; + *Class::C3::initialize = sub { 1 }; + *Class::C3::reinitialize = sub { 1 }; + *Class::C3::uninitialize = sub { 1 }; + } +} + +=head1 NAME + +MRO::Compat - mro::* interface compatibility for Perls < 5.9.5 + +=head1 SYNOPSIS + + package PPP; use base qw/Exporter/; + package X; use base qw/PPP/; + package Y; use base qw/PPP/; + package Z; use base qw/PPP/; + + package FooClass; use base qw/X Y Z/; + + package main; + use MRO::Compat; + my $linear = mro::get_linear_isa('FooClass'); + print join(q{, }, @$linear); + + # Prints: FooClass, X, PPP, Exporter, Y, Z + +=head1 DESCRIPTION + +The "mro" namespace provides several utilities for dealing +with method resolution order and method caching in general +in Perl 5.9.5 and higher. + +This module provides those interfaces for +earlier versions of Perl (back to 5.6.0 anyways). + +It is a harmless no-op to use this module on 5.9.5+. That +is to say, code which properly uses L will work +unmodified on both older Perls and 5.9.5+. + +If you're writing a piece of software that would like to use +the parts of 5.9.5+'s mro:: interfaces that are supported +here, and you want compatibility with older Perls, this +is the module for you. + +Some parts of this code will work better and/or faster with +L installed (which is an optional prereq +of L, which is in turn a prereq of this +package), but it's not a requirement. + +This module never exports any functions. All calls must +be fully qualified with the C prefix. + +The interface documentation here serves only as a quick +reference of what the function basically does, and what +differences between L and 5.9.5+ one should +look out for. The main docs in 5.9.5's L are the real +interface docs, and contain a lot of other useful information. + +=head1 Functions + +=head2 mro::get_linear_isa($classname[, $type]) + +Returns an arrayref which is the linearized "ISA" of the given class. +Uses whichever MRO is currently in effect for that class by default, +or the given MRO (either C or C if specified as C<$type>). + +The linearized ISA of a class is a single ordered list of all of the +classes that would be visited in the process of resolving a method +on the given class, starting with itself. It does not include any +duplicate entries. + +Note that C (and any members of C's MRO) are not +part of the MRO of a class, even though all classes implicitly inherit +methods from C and its parents. + +=cut + +sub __get_linear_isa_dfs { + no strict 'refs'; + + my $classname = shift; + + my @lin = ($classname); + my %stored; + foreach my $parent (@{"$classname\::ISA"}) { + my $plin = __get_linear_isa_dfs($parent); + foreach (@$plin) { + next if exists $stored{$_}; + push(@lin, $_); + $stored{$_} = 1; + } + } + return \@lin; +} + +sub __get_linear_isa { + my ($classname, $type) = @_; + die "mro::get_mro requires a classname" if !defined $classname; + + $type ||= __get_mro($classname); + if($type eq 'dfs') { + return __get_linear_isa_dfs($classname); + } + elsif($type eq 'c3') { + return [Class::C3::calculateMRO($classname)]; + } + die "type argument must be 'dfs' or 'c3'"; +} + +=head2 mro::import + +This allows the C and +C syntaxes, providing you +L first. Please see the +L section for additional details. + +=cut + +sub __import { + if($_[1]) { + goto &Class::C3::import if $_[1] eq 'c3'; + __set_mro(scalar(caller), $_[1]); + } +} + +=head2 mro::set_mro($classname, $type) + +Sets the mro of C<$classname> to one of the types +C or C. Please see the L +section for additional details. + +=cut + +sub __set_mro { + my ($classname, $type) = @_; + + if(!defined $classname || !$type) { + die q{Usage: mro::set_mro($classname, $type)}; + } + + if($type eq 'c3') { + eval "package $classname; use Class::C3"; + die $@ if $@; + } + elsif($type eq 'dfs') { + # In the dfs case, check whether we need to undo C3 + if(defined $Class::C3::MRO{$classname}) { + Class::C3::_remove_method_dispatch_table($classname); + } + delete $Class::C3::MRO{$classname}; + } + else { + die qq{Invalid mro type "$type"}; + } + + return; +} + +=head2 mro::get_mro($classname) + +Returns the MRO of the given class (either C or C). + +It considers any Class::C3-using class to have C3 MRO +even before L is called. + +=cut + +sub __get_mro { + my $classname = shift; + die "mro::get_mro requires a classname" if !defined $classname; + return 'c3' if exists $Class::C3::MRO{$classname}; + return 'dfs'; +} + +=head2 mro::get_isarev($classname) + +Returns an arrayref of classes who are subclasses of the +given classname. In other words, classes in whose @ISA +hierarchy we appear, no matter how indirectly. + +This is much slower on pre-5.9.5 Perls with MRO::Compat +than it is on 5.9.5+, as it has to search the entire +package namespace. + +=cut + +sub __get_all_pkgs_with_isas { + no strict 'refs'; + no warnings 'recursion'; + + my @retval; + + my $search = shift; + my $pfx; + my $isa; + if(defined $search) { + $isa = \@{"$search\::ISA"}; + $pfx = "$search\::"; + } + else { + $search = 'main'; + $isa = \@main::ISA; + $pfx = ''; + } + + push(@retval, $search) if scalar(@$isa); + + foreach my $cand (keys %{"$search\::"}) { + if($cand =~ s/::$//) { + next if $cand eq $search; # skip self-reference (main?) + push(@retval, @{__get_all_pkgs_with_isas($pfx . $cand)}); + } + } + + return \@retval; +} + +sub __get_isarev_recurse { + no strict 'refs'; + + my ($class, $all_isas, $level) = @_; + + die "Recursive inheritance detected" if $level > 100; + + my %retval; + + foreach my $cand (@$all_isas) { + my $found_me; + foreach (@{"$cand\::ISA"}) { + if($_ eq $class) { + $found_me = 1; + last; + } + } + if($found_me) { + $retval{$cand} = 1; + map { $retval{$_} = 1 } + @{__get_isarev_recurse($cand, $all_isas, $level+1)}; + } + } + return [keys %retval]; +} + +sub __get_isarev { + my $classname = shift; + die "mro::get_isarev requires a classname" if !defined $classname; + + __get_isarev_recurse($classname, __get_all_pkgs_with_isas(), 0); +} + +=head2 mro::is_universal($classname) + +Returns a boolean status indicating whether or not +the given classname is either C itself, +or one of C's parents by C<@ISA> inheritance. + +Any class for which this function returns true is +"universal" in the sense that all classes potentially +inherit methods from it. + +=cut + +sub __is_universal { + my $classname = shift; + die "mro::is_universal requires a classname" if !defined $classname; + + my $lin = __get_linear_isa('UNIVERSAL'); + foreach (@$lin) { + return 1 if $classname eq $_; + } + + return 0; +} + +=head2 mro::invalidate_all_method_caches + +Increments C, which invalidates method +caching in all packages. + +Please note that this is rarely necessary, unless you are +dealing with a situation which is known to confuse Perl's +method caching. + +=cut + +sub __invalidate_all_method_caches { + # Super secret mystery code :) + @f845a9c1ac41be33::ISA = @f845a9c1ac41be33::ISA; + return; +} + +=head2 mro::method_changed_in($classname) + +Invalidates the method cache of any classes dependent on the +given class. In L on pre-5.9.5 Perls, this is +an alias for C above, as +pre-5.9.5 Perls have no other way to do this. It will still +enforce the requirement that you pass it a classname, for +compatibility. + +Please note that this is rarely necessary, unless you are +dealing with a situation which is known to confuse Perl's +method caching. + +=cut + +sub __method_changed_in { + my $classname = shift; + die "mro::method_changed_in requires a classname" if !defined $classname; + + __invalidate_all_method_caches(); +} + +=head2 mro::get_pkg_gen($classname) + +Returns an integer which is incremented every time a local +method of or the C<@ISA> of the given package changes on +Perl 5.9.5+. On earlier Perls with this L module, +it will probably increment a lot more often than necessary. + +=cut + +{ + my $__pkg_gen = 2; + sub __get_pkg_gen_pp { + my $classname = shift; + die "mro::get_pkg_gen requires a classname" if !defined $classname; + return $__pkg_gen++; + } +} + +sub __get_pkg_gen_c3xs { + my $classname = shift; + die "mro::get_pkg_gen requires a classname" if !defined $classname; + + return Class::C3::XS::_plsubgen(); +} + +=head1 USING C3 + +While this module makes the 5.9.5+ syntaxes +C and C available +on older Perls, it does so merely by passing off the work +to L. + +It does not remove the need for you to call +C, C, and/or +C at the appropriate times +as documented in the L docs. These three functions +are always provided by L, either via L +itself on older Perls, or directly as no-ops on 5.9.5+. + +=head1 SEE ALSO + +L + +L + +=head1 AUTHOR + +Brandon L. Black, Eblblack@gmail.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 Brandon L. Black Eblblack@gmail.comE + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; diff --git a/components/clm/bld/test_build_namelist/perl5lib/Sub/Uplevel.pm b/components/clm/bld/test_build_namelist/perl5lib/Sub/Uplevel.pm new file mode 100644 index 0000000000..24541af3dc --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/Sub/Uplevel.pm @@ -0,0 +1,387 @@ +package Sub::Uplevel; +use 5.006; +use strict; +# ABSTRACT: apparently run a function in a higher stack frame +our $VERSION = '0.24'; # VERSION + +# Frame check global constant +our $CHECK_FRAMES; +BEGIN { + $CHECK_FRAMES = !! $CHECK_FRAMES; +} +use constant CHECK_FRAMES => $CHECK_FRAMES; + +# We must override *CORE::GLOBAL::caller if it hasn't already been +# overridden or else Perl won't see our local override later. + +if ( not defined *CORE::GLOBAL::caller{CODE} ) { + *CORE::GLOBAL::caller = \&_normal_caller; +} + +# modules to force reload if ":aggressive" is specified +my @reload_list = qw/Exporter Exporter::Heavy/; + +sub import { + no strict 'refs'; ## no critic + my ($class, @args) = @_; + for my $tag ( @args, 'uplevel' ) { + if ( $tag eq 'uplevel' ) { + my $caller = caller(0); + *{"$caller\::uplevel"} = \&uplevel; + } + elsif( $tag eq ':aggressive' ) { + _force_reload( @reload_list ); + } + else { + die qq{"$tag" is not exported by the $class module\n} + } + } + return; +} + +sub _force_reload { + no warnings 'redefine'; + local $^W = 0; + for my $m ( @_ ) { + $m =~ s{::}{/}g; + $m .= ".pm"; + require $m if delete $INC{$m}; + } +} + + +# @Up_Frames -- uplevel stack +# $Caller_Proxy -- whatever caller() override was in effect before uplevel +our (@Up_Frames, $Caller_Proxy); + +sub _apparent_stack_height { + my $height = 1; # start above this function + while ( 1 ) { + last if ! defined scalar $Caller_Proxy->($height); + $height++; + } + return $height - 1; # subtract 1 for this function +} + +sub uplevel { + # Backwards compatible version of "no warnings 'redefine'" + my $old_W = $^W; + $^W = 0; + + # Update the caller proxy if the uplevel override isn't in effect + local $Caller_Proxy = *CORE::GLOBAL::caller{CODE} + if *CORE::GLOBAL::caller{CODE} != \&_uplevel_caller; + local *CORE::GLOBAL::caller = \&_uplevel_caller; + + # Restore old warnings state + $^W = $old_W; + + if ( CHECK_FRAMES and $_[0] >= _apparent_stack_height() ) { + require Carp; + Carp::carp("uplevel $_[0] is more than the caller stack"); + } + + local @Up_Frames = (shift, @Up_Frames ); + + my $function = shift; + return $function->(@_); +} + +sub _normal_caller (;$) { ## no critic Prototypes + my ($height) = @_; + $height++; + my @caller = CORE::caller($height); + if ( CORE::caller() eq 'DB' ) { + # Oops, redo picking up @DB::args + package DB; + @caller = CORE::caller($height); + } + + return if ! @caller; # empty + return $caller[0] if ! wantarray; # scalar context + return @_ ? @caller : @caller[0..2]; # extra info or regular +} + +sub _uplevel_caller (;$) { ## no critic Prototypes + my $height = $_[0] || 0; + + # shortcut if no uplevels have been called + # always add +1 to CORE::caller (proxy caller function) + # to skip this function's caller + return $Caller_Proxy->( $height + 1 ) if ! @Up_Frames; + + + my $saw_uplevel = 0; + my $adjust = 0; + + # walk up the call stack to fight the right package level to return; + # look one higher than requested for each call to uplevel found + # and adjust by the amount found in the Up_Frames stack for that call. + # We *must* use CORE::caller here since we need the real stack not what + # some other override says the stack looks like, just in case that other + # override breaks things in some horrible way + + for ( my $up = 0; $up <= $height + $adjust; $up++ ) { + my @caller = CORE::caller($up + 1); + if( defined $caller[0] && $caller[0] eq __PACKAGE__ ) { + # add one for each uplevel call seen + # and look into the uplevel stack for the offset + $adjust += 1 + $Up_Frames[$saw_uplevel]; + $saw_uplevel++; + } + } + + # For returning values, we pass through the call to the proxy caller + # function, just at a higher stack level + my @caller = $Caller_Proxy->($height + $adjust + 1); + if ( CORE::caller() eq 'DB' ) { + # Oops, redo picking up @DB::args + package DB; + @caller = $Sub::Uplevel::Caller_Proxy->($height + $adjust + 1); + } + + return if ! @caller; # empty + return $caller[0] if ! wantarray; # scalar context + return @_ ? @caller : @caller[0..2]; # extra info or regular +} + + +1; + +__END__ +=pod + +=head1 NAME + +Sub::Uplevel - apparently run a function in a higher stack frame + +=head1 VERSION + +version 0.24 + +=head1 SYNOPSIS + + use Sub::Uplevel; + + sub foo { + print join " - ", caller; + } + + sub bar { + uplevel 1, \&foo; + } + + #line 11 + bar(); # main - foo.plx - 11 + +=head1 DESCRIPTION + +Like Tcl's uplevel() function, but not quite so dangerous. The idea +is just to fool caller(). All the really naughty bits of Tcl's +uplevel() are avoided. + +B + +=over 4 + +=item B + + uplevel $num_frames, \&func, @args; + +Makes the given function think it's being executed $num_frames higher +than the current stack level. So when they use caller($frames) it +will actually give caller($frames + $num_frames) for them. + +C is effectively C but +you don't immediately exit the current subroutine. So while you can't +do this: + + sub wrapper { + print "Before\n"; + goto &some_func; + print "After\n"; + } + +you can do this: + + sub wrapper { + print "Before\n"; + my @out = uplevel 1, &some_func; + print "After\n"; + return @out; + } + +C has the ability to issue a warning if C<$num_frames> is more than +the current call stack depth, although this warning is disabled and compiled +out by default as the check is relatively expensive. + +To enable the check for debugging or testing, you should set the global +C<$Sub::Uplevel::CHECK_FRAMES> to true before loading Sub::Uplevel for the +first time as follows: + + #!/usr/bin/perl + + BEGIN { + $Sub::Uplevel::CHECK_FRAMES = 1; + } + use Sub::Uplevel; + +Setting or changing the global after the module has been loaded will have +no effect. + +=begin _private + +So it has to work like this: + + Call stack Actual uplevel 1 +CORE::GLOBAL::caller +Carp::short_error_loc 0 +Carp::shortmess_heavy 1 0 +Carp::croak 2 1 +try_croak 3 2 +uplevel 4 +function_that_called_uplevel 5 +caller_we_want_to_see 6 3 +its_caller 7 4 + +So when caller(X) winds up below uplevel(), it only has to use +CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X) +winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1). + +Which means I'm probably going to have to do something nasty like walk +up the call stack on each caller() to see if I'm going to wind up +before or after Sub::Uplevel::uplevel(). + +=end _private + +=begin _dagolden + +I found the description above a bit confusing. Instead, this is the logic +that I found clearer when CORE::GLOBAL::caller is invoked and we have to +walk up the call stack: + +* if searching up to the requested height in the real call stack doesn't find +a call to uplevel, then we can return the result at that height in the +call stack + +* if we find a call to uplevel, we need to keep searching upwards beyond the +requested height at least by the amount of upleveling requested for that +call to uplevel (from the Up_Frames stack set during the uplevel call) + +* additionally, we need to hide the uplevel subroutine call, too, so we search +upwards one more level for each call to uplevel + +* when we've reached the top of the search, we want to return that frame +in the call stack, i.e. the requested height plus any uplevel adjustments +found during the search + +=end _dagolden + +=back + +=head1 EXAMPLE + +The main reason I wrote this module is so I could write wrappers +around functions and they wouldn't be aware they've been wrapped. + + use Sub::Uplevel; + + my $original_foo = \&foo; + + *foo = sub { + my @output = uplevel 1, $original_foo; + print "foo() returned: @output"; + return @output; + }; + +If this code frightens you B + +=head1 BUGS and CAVEATS + +Well, the bad news is uplevel() is about 5 times slower than a normal +function call. XS implementation anyone? It also slows down every invocation +of caller(), regardless of whether uplevel() is in effect. + +Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of +each uplevel call. It does its best to work with any previously existing +CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within +each uplevel call) such as from Contextual::Return or Hook::LexWrap. + +However, if you are routinely using multiple modules that override +CORE::GLOBAL::caller, you are probably asking for trouble. + +You B load Sub::Uplevel as early as possible within your program. As +with all CORE::GLOBAL overloading, the overload will not affect modules that +have already been compiled prior to the overload. One module that often is +unavoidably loaded prior to Sub::Uplevel is Exporter. To forcibly recompile +Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the +":aggressive" tag: + + use Sub::Uplevel qw/:aggressive/; + +The private function C may be passed a list of +additional modules to reload if ":aggressive" is not aggressive enough. +Reloading modules may break things, so only use this as a last resort. + +As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater. + +=head1 HISTORY + +Those who do not learn from HISTORY are doomed to repeat it. + +The lesson here is simple: Don't sit next to a Tcl programmer at the +dinner table. + +=head1 THANKS + +Thanks to Brent Welch, Damian Conway and Robin Houston. + +See http://www.perl.com/perl/misc/Artistic.html + +=head1 SEE ALSO + +PadWalker (for the similar idea with lexicals), Hook::LexWrap, +Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders + +=head1 SUPPORT + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests through the issue tracker +at L. +You will be notified automatically of any progress on your issue. + +=head2 Source Code + +This is open source software. The code repository is available for +public review and contribution under the terms of the license. + +L + + git clone https://github.com/dagolden/sub-uplevel.git + +=head1 AUTHORS + +=over 4 + +=item * + +Michael Schwern + +=item * + +David Golden + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2012 by Michael Schwern and David Golden. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + diff --git a/components/clm/bld/test_build_namelist/perl5lib/Test/Class.pm b/components/clm/bld/test_build_namelist/perl5lib/Test/Class.pm new file mode 100644 index 0000000000..ab978f5ccf --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/Test/Class.pm @@ -0,0 +1,1841 @@ +use strict; +use warnings; +use 5.006; + +package Test::Class; + +use Attribute::Handlers; +use Carp; +use MRO::Compat; +use Storable qw(dclone); +use Test::Builder; +use Test::Class::MethodInfo; + +our $VERSION = '0.41'; + +my $Check_block_has_run; +{ + no warnings 'void'; + CHECK { $Check_block_has_run = 1 }; +} + +use constant NO_PLAN => "no_plan"; +use constant SETUP => "setup"; +use constant TEST => "test"; +use constant TEARDOWN => "teardown"; +use constant STARTUP => "startup"; +use constant SHUTDOWN => "shutdown"; + + +our $Current_method = undef; +sub current_method { $Current_method }; + + +my $Builder = Test::Builder->new; +sub builder { $Builder }; + + +my $Tests = {}; +my @Filters = (); + + +my %_Test; # inside-out object field indexed on $self + +sub DESTROY { + my $self = shift; + delete $_Test{ $self }; +}; + +sub _test_info { + my $self = shift; + return ref($self) ? $_Test{$self} : $Tests; +}; + +sub _method_info { + my ($self, $class, $method) = @_; + return( _test_info($self)->{$class}->{$method} ); +}; + +sub _methods_of_class { + my ( $self, $class ) = @_; + my $test_info = _test_info($self) + or die "Test::Class internals seem confused. Did you override " + . "new() in a sub-class or via multiple inheritence?\n"; + return values %{ $test_info->{$class} }; +}; + +sub _parse_attribute_args { + my $args = shift || ''; + my $num_tests; + my $type; + $args =~ s/\s+//sg; + foreach my $arg (split /=>/, $args) { + if (Test::Class::MethodInfo->is_num_tests($arg)) { + $num_tests = $arg; + } elsif (Test::Class::MethodInfo->is_method_type($arg)) { + $type = $arg; + } else { + die 'bad attribute args'; + }; + }; + return( $type, $num_tests ); +}; + +sub _is_public_method { + my ($class, $name) = @_; + my @parents = @{mro::get_linear_isa($class)}; + shift @parents; + foreach my $parent_class ( @parents ) { + return unless $parent_class->can( $name ); + return if _method_info( $class, $parent_class, $name ); + } + return 1; +} + +sub Test : ATTR(CODE,RAWDATA) { + my ($class, $symbol, $code_ref, $attr, $args) = @_; + if ($symbol eq "ANON") { + warn "cannot test anonymous subs - you probably loaded a Test::Class too late (after the CHECK block was run). See 'A NOTE ON LOADING TEST CLASSES' in perldoc Test::Class for more details\n"; + } else { + my $name = *{$symbol}{NAME}; + warn "overriding public method $name with a test method in $class\n" + if _is_public_method( $class, $name ); + eval { $class->add_testinfo($name, _parse_attribute_args($args)) } + || warn "bad test definition '$args' in $class->$name\n"; + }; +}; + +sub Tests : ATTR(CODE,RAWDATA) { + my ($class, $symbol, $code_ref, $attr, $args) = @_; + $args ||= 'no_plan'; + Test( $class, $symbol, $code_ref, $attr, $args ); +}; + +sub add_testinfo { + my($class, $name, $type, $num_tests) = @_; + $Tests->{$class}->{$name} = Test::Class::MethodInfo->new( + name => $name, + num_tests => $num_tests, + type => $type, + ); +} + +sub _class_of { + my $self = shift; + return ref $self ? ref $self : $self; +} + +sub new { + my $proto = shift; + my $class = _class_of( $proto ); + $proto = {} unless ref($proto); + my $self = bless {%$proto, @_}, $class; + $_Test{$self} = dclone($Tests); + return($self); +}; + +sub _get_methods { + my ( $self, @types ) = @_; + my $test_class = _class_of( $self ); + + my $test_method_regexp = $ENV{ TEST_METHOD } || '.*'; + my $method_regexp = eval { qr/\A$test_method_regexp\z/ }; + die "TEST_METHOD ($test_method_regexp) is not a valid regexp: $@" if $@; + + my %methods = (); + foreach my $class ( @{mro::get_linear_isa( $test_class )} ) { + FILTER: + foreach my $info ( _methods_of_class( $self, $class ) ) { + my $name = $info->name; + + if ( $info->type eq TEST ) { + # determine if method is filtered, true if *any* filter + # returns false. + foreach my $filter ( @Filters ) { + next FILTER unless $filter->( $class, $name ); + } + } + + foreach my $type ( @types ) { + if ( $info->is_type( $type ) ) { + $methods{ $name } = 1 + unless $type eq TEST && $name !~ $method_regexp; + } + }; + }; + }; + + my @methods = sort keys %methods; + return @methods; +}; + +sub _num_expected_tests { + my $self = shift; + if (my $reason = $self->SKIP_CLASS ) { + return $reason eq "1" ? 0 : 1; + }; + my @test_methods = _get_methods($self, TEST); + return 0 unless @test_methods; + my @startup_shutdown_methods = + _get_methods($self, STARTUP, SHUTDOWN); + my $num_startup_shutdown_methods = + _total_num_tests($self, @startup_shutdown_methods); + return(NO_PLAN) if $num_startup_shutdown_methods eq NO_PLAN; + my @fixture_methods = _get_methods($self, SETUP, TEARDOWN); + my $num_fixture_tests = _total_num_tests($self, @fixture_methods); + return(NO_PLAN) if $num_fixture_tests eq NO_PLAN; + my $num_tests = _total_num_tests($self, @test_methods); + return(NO_PLAN) if $num_tests eq NO_PLAN; + return($num_startup_shutdown_methods + $num_tests + @test_methods * $num_fixture_tests); +}; + +sub expected_tests { + my $total = 0; + foreach my $test (@_) { + if ( _isa_class( __PACKAGE__, $test ) ) { + my $n = _num_expected_tests($test); + return NO_PLAN if $n eq NO_PLAN; + $total += $n; + } elsif ( defined $test && $test =~ m/^\d+$/ ) { + $total += $test; + } else { + $test = 'undef' unless defined $test; + croak "$test is not a Test::Class or an integer"; + }; + }; + return $total; +}; + +sub _total_num_tests { + my ($self, @methods) = @_; + my $class = _class_of( $self ); + my $total_num_tests = 0; + foreach my $method (@methods) { + foreach my $class (@{mro::get_linear_isa($class)}) { + my $info = _method_info($self, $class, $method); + next unless $info; + my $num_tests = $info->num_tests; + return(NO_PLAN) if ($num_tests eq NO_PLAN); + $total_num_tests += $num_tests; + last unless $num_tests =~ m/^\+/ + }; + }; + return($total_num_tests); +}; + +sub _has_no_tests { + my ( $self, $method ) = @_; + return _total_num_tests( $self, $method ) eq '0'; +} + +sub _all_ok_from { + my ($self, $start_test) = @_; + + # The Test::Builder 1.5 way to do it + if( $Builder->can("history") ) { + return $Builder->history->can_succeed; + } + # The Test::Builder 0.x way to do it + else { + my $current_test = $Builder->current_test; + return(1) if $start_test == $current_test; + my @results = ($Builder->summary)[$start_test .. $current_test-1]; + foreach my $result (@results) { return(0) unless $result }; + return(1); + } +}; + +sub _exception_failure { + my ($self, $method, $exception, $tests) = @_; + local $Test::Builder::Level = 3; + my $message = $method; + $message .= " (for test method '$Current_method')" + if defined $Current_method && $method ne $Current_method; + _show_header($self, @$tests); + $Builder->ok(0, "$message died ($exception)"); + _threw_exception( $self, $method => 1 ); +}; + +my %threw_exception; +sub _threw_exception { + my ( $self, $method, $optional_value) = @_; + my $class = ref( $self ); + $threw_exception{ $class }{ $method } = $optional_value + if defined $optional_value; + return $threw_exception{ $class }{ $method }; +} + +sub _run_method { + my ($self, $method, $tests) = @_; + _threw_exception( $self, $method => 0 ); + my $num_start = $Builder->current_test; + my $skip_reason; + my $original_ok = \&Test::Builder::ok; + no warnings; + local *Test::Builder::ok = sub { + my ($builder, $test, $description) = @_; + local $Test::Builder::Level = $Test::Builder::Level+1; + unless ( defined($description) ) { + $description = $self->current_method; + $description =~ tr/_/ /; + }; + my $is_ok = $original_ok->($builder, $test, $description); + unless ( $is_ok ) { + my $class = ref $self; + $Builder->diag( " (in $class->$method)" ); + }; + return $is_ok; + }; + $skip_reason = eval {$self->$method}; + $skip_reason = $method unless $skip_reason; + my $exception = $@; + chomp($exception) if $exception; + my $num_done = $Builder->current_test - $num_start; + my $num_expected = _total_num_tests($self, $method); + $num_expected = $num_done if $num_expected eq NO_PLAN; + if ($num_done == $num_expected) { + _exception_failure($self, $method, $exception, $tests) + unless $exception eq ''; + } elsif ($num_done > $num_expected) { + my $class = ref $self; + $Builder->diag("expected $num_expected test(s) in $class\::$method, $num_done completed\n"); + } else { + until (($Builder->current_test - $num_start) >= $num_expected) { + if ($exception ne '') { + _exception_failure($self, $method, $exception, $tests); + $skip_reason = "$method died"; + $exception = ''; + } else { + if ($self->fail_if_returned_early) { + my $class = ref $self; + $Builder->ok(0, "($class\::$method returned before plan complete)"); + } else { + $Builder->skip( $skip_reason ); + } + }; + }; + }; + return(_all_ok_from($self, $num_start)); +}; + +sub fail_if_returned_early { 0 } + +sub _show_header { + my ($self, @tests) = @_; + return if $Builder->has_plan; + my $num_tests = Test::Class->expected_tests(@tests); + if ($num_tests eq NO_PLAN) { + $Builder->no_plan; + } else { + $Builder->expected_tests($num_tests); + }; +}; + +my %SKIP_THIS_CLASS = (); + +sub SKIP_CLASS { + my $class = shift; + $SKIP_THIS_CLASS{ $class } = shift if @_; + return $SKIP_THIS_CLASS{ $class }; +}; + +sub _isa_class { + my ( $class, $object_or_class ) = @_; + return unless defined $object_or_class; + return if $object_or_class eq 'Contextual::Return::Value'; + return eval { + $object_or_class->isa( $class ) and $object_or_class->can( 'runtests' ) + }; +} + +sub _test_classes { + my $class = shift; + return( @{mro::get_isarev($class)}, $class ); +}; + +sub runtests { + die "Test::Class was loaded too late (after the CHECK block was run). See 'A NOTE ON LOADING TEST CLASSES' in perldoc Test::Class for more details\n" + unless $Check_block_has_run; + my @tests = @_; + if (@tests == 1 && !ref($tests[0])) { + my $base_class = shift @tests; + @tests = _test_classes( $base_class ); + }; + my $all_passed = 1; + TEST_OBJECT: foreach my $t (@tests) { + # SHOULD ALSO ALLOW NO_PLAN + next if $t =~ m/^\d+$/; + croak "$t is not Test::Class or integer" + unless _isa_class( __PACKAGE__, $t ); + if (my $reason = $t->SKIP_CLASS) { + _show_header($t, @tests); + $Builder->skip( $reason ) unless $reason eq "1"; + } else { + $t = $t->new unless ref($t); + my @test_methods = _get_methods($t, TEST); + if ( @test_methods ) { + foreach my $method (_get_methods($t, STARTUP)) { + _show_header($t, @tests) unless _has_no_tests($t, $method); + my $method_passed = _run_method($t, $method, \@tests); + $all_passed = 0 unless $method_passed; + next TEST_OBJECT unless $method_passed; + }; + my $class = ref($t); + my @setup = _get_methods($t, SETUP); + my @teardown = _get_methods($t, TEARDOWN); + foreach my $test ( @test_methods ) { + local $Current_method = $test; + $Builder->diag("\n$class->$test") if $ENV{TEST_VERBOSE}; + my @methods_to_run = (@setup, $test, @teardown); + while ( my $method = shift @methods_to_run ) { + _show_header($t, @tests) unless _has_no_tests($t, $method); + $all_passed = 0 unless _run_method($t, $method, \@tests); + if ( _threw_exception( $t, $method ) ) { + my $num_to_skip = _total_num_tests($t, @methods_to_run); + $Builder->skip( "$method died" ) for ( 1 .. $num_to_skip ); + last; + }; + }; + }; + foreach my $method (_get_methods($t, SHUTDOWN)) { + _show_header($t, @tests) unless _has_no_tests($t, $method); + $all_passed = 0 unless _run_method($t, $method, \@tests); + } + } + + } + } + return($all_passed); +}; + +sub _find_calling_test_class { + my $level = 0; + while (my $class = caller(++$level)) { + next if $class eq __PACKAGE__; + return $class if _isa_class( __PACKAGE__, $class ); + }; + return(undef); +}; + +sub num_method_tests { + my ($self, $method, $n) = @_; + my $class = _find_calling_test_class( $self ) + or croak "not called in a Test::Class"; + my $info = _method_info($self, $class, $method) + or croak "$method is not a test method of class $class"; + $info->num_tests($n) if defined($n); + return( $info->num_tests ); +}; + +sub num_tests { + my $self = shift; + croak "num_tests need to be called within a test method" + unless defined $Current_method; + return( $self->num_method_tests( $Current_method, @_ ) ); +}; + +sub BAILOUT { + my ($self, $reason) = @_; + $Builder->BAILOUT($reason); +}; + +sub _last_test_if_exiting_immediately { + $Builder->expected_tests || $Builder->current_test+1 +}; + +sub FAIL_ALL { + my ($self, $reason) = @_; + my $last_test = _last_test_if_exiting_immediately(); + $Builder->expected_tests( $last_test ) unless $Builder->has_plan; + $Builder->ok(0, $reason) until $Builder->current_test >= $last_test; + my $num_failed = $Builder->can("history") + ? $Builder->history->fail_count : grep( !$_, $Builder->summary ); + exit( $num_failed < 254 ? $num_failed : 254 ); +}; + +sub SKIP_ALL { + my ($self, $reason) = @_; + $Builder->skip_all( $reason ) unless $Builder->has_plan; + my $last_test = _last_test_if_exiting_immediately(); + $Builder->skip( $reason ) + until $Builder->current_test >= $last_test; + exit(0); +} + +sub add_filter { + my ( $class, $cb ) = @_; + + if ( not ref $cb eq 'CODE' ) { + croak "Filter isn't a code-ref" + } + + push @Filters, $cb; +} + +1; + +__END__ + +=head1 NAME + +Test::Class - Easily create test classes in an xUnit/JUnit style + +=head1 SYNOPSIS + + package Example::Test; + use base qw(Test::Class); + use Test::More; + + # setup methods are run before every test method. + sub make_fixture : Test(setup) { + my $array = [1, 2]; + shift->{test_array} = $array; + }; + + # a test method that runs 1 test + sub test_push : Test { + my $array = shift->{test_array}; + push @$array, 3; + is_deeply($array, [1, 2, 3], 'push worked'); + }; + + # a test method that runs 4 tests + sub test_pop : Test(4) { + my $array = shift->{test_array}; + is(pop @$array, 2, 'pop = 2'); + is(pop @$array, 1, 'pop = 1'); + is_deeply($array, [], 'array empty'); + is(pop @$array, undef, 'pop = undef'); + }; + + # teardown methods are run after every test method. + sub teardown : Test(teardown) { + my $array = shift->{test_array}; + diag("array = (@$array) after test(s)"); + }; + +later in a nearby .t file + + #! /usr/bin/perl + use Example::Test; + + # run all the test methods in Example::Test + Test::Class->runtests; + +Outputs: + + 1..5 + ok 1 - pop = 2 + ok 2 - pop = 1 + ok 3 - array empty + ok 4 - pop = undef + # array = () after test(s) + ok 5 - push worked + # array = (1 2 3) after test(s) + + +=head1 DESCRIPTION + +Test::Class provides a simple way of creating classes and objects to test your code in an xUnit style. + +Built using L, it was designed to work with other Test::Builder based modules (L, L, L, etc.). + +I This module will make more sense, if you are already familiar with the "standard" mechanisms for testing perl code. Those unfamiliar with L, L, L and friends should go take a look at them now. L is a good starting point. + + +=head1 INTRODUCTION + +=head2 A brief history lesson + +In 1994 Kent Beck wrote a testing framework for Smalltalk called SUnit. It was popular. You can read a copy of his original paper at L. + +Later Kent Beck and Erich Gamma created JUnit for testing Java L. It was popular too. + +Now there are xUnit frameworks for every language from Ada to XSLT. You can find a list at L. + +While xUnit frameworks are traditionally associated with unit testing they are also useful in the creation of functional/acceptance tests. + +Test::Class is (yet another) implementation of xUnit style testing in Perl. + + +=head2 Why you should use Test::Class + +Test::Class attempts to provide simple xUnit testing that integrates simply with the standard perl *.t style of testing. In particular: + +=over 4 + +=item * + +All the advantages of xUnit testing. You can easily create test fixtures and isolate tests. It provides a framework that should be familiar to people who have used other xUnit style test systems. + + +=item * + +It is built with L and should co-exist happily with all other Test::Builder based modules. This makes using test classes in *.t scripts, and refactoring normal tests into test classes, much simpler because: + +=over 4 + +=item * + +You do not have to learn a new set of new test APIs and can continue using ok(), like(), etc. from L and friends. + +=item * + +Skipping tests and todo tests are supported. + +=item * + +You can have normal tests and Test::Class classes co-existing in the same *.t script. You don't have to re-write an entire script, but can use test classes as and when it proves useful. + +=back + +=item * + +You can easily package your tests as classes/modules, rather than *.t scripts. This simplifies reuse, documentation and distribution, encourages refactoring, and allows tests to be extended by inheritance. + +=item * + +You can have multiple setup/teardown methods. For example have one teardown method to clean up resources and another to check that class invariants still hold. + +=item * + +It can make running tests faster. Once you have refactored your *.t scripts into classes they can be easily run from a single script. This gains you the (often considerable) start up time that each separate *.t script takes. + +=back + + +=head2 Why you should I use Test::Class + +=over 4 + +=item * + +If your *.t scripts are working fine then don't bother with Test::Class. For simple test suites it is almost certainly overkill. Don't start thinking about using Test::Class until issues like duplicate code in your test scripts start to annoy. + +=item * + +If you are distributing your code it is yet another module that the user has to have to run your tests (unless you distribute it with your test suite of course). + +=item * + +If you are used to the TestCase/Suite/Runner class structure used by JUnit and similar testing frameworks you may find Test::Unit more familiar (but try reading L before you give up). + +=back + + +=head1 TEST CLASSES + +A test class is just a class that inherits from Test::Class. Defining a test class is as simple as doing: + + package Example::Test; + use base qw(Test::Class); + +Since Test::Class does not provide its own test functions, but uses those provided by L and friends, you will nearly always also want to have: + + use Test::More; + +to import the test functions into your test class. + +=head1 METHOD TYPES + +There are three different types of method you can define using Test::Class. + +=head2 1) Test methods + +You define test methods using the L attribute. For example: + + package Example::Test; + use base qw(Test::Class); + use Test::More; + + sub subtraction : Test { + is( 2-1, 1, 'subtraction works ); + }; + +This declares the C method as a test method that runs one test. + +If your test method runs more than one test, you should put the number of tests in brackets like this: + + sub addition : Test(2) { + is(10 + 20, 30, 'addition works'); + is(20 + 10, 30, ' both ways'); + }; + +If you don't know the number of tests at compile time you can use C like this. + + sub check_class : Test(no_plan) { + my $objects = shift->{objects}; + isa_ok($_, "Object") foreach @$objects; + }; + +or use the :Tests attribute, which acts just like C<:Test> but defaults to C if no number is given: + + sub check_class : Tests { + my $objects = shift->{objects}; + isa_ok($_, "Object") foreach @$objects; + }; + + +=head2 2) Setup and teardown methods + +Setup and teardown methods are run before and after every test. For example: + + sub before : Test(setup) { diag("running before test") }; + sub after : Test(teardown) { diag("running after test") }; + +You can use setup and teardown methods to create common objects used by all of your test methods (a test I) and store them in your Test::Class object, treating it as a hash. For example: + + sub pig : Test(setup) { + my $self = shift; + $self->{test_pig} = Pig->new; + }; + + sub born_hungry : Test { + my $pig = shift->{test_pig}; + is($pig->hungry, 'pigs are born hungry'); + }; + + sub eats : Test(3) { + my $pig = shift->{test_pig}; + ok( $pig->feed, 'pig fed okay'); + ok(! $pig->hungry, 'fed pig not hungry'); + ok(! $pig->feed, 'cannot feed full pig'); + }; + +You can also declare setup and teardown methods as running tests. For example you could check that the test pig survives each test method by doing: + + sub pig_alive : Test(teardown => 1) { + my $pig = shift->{test_pig}; + ok($pig->alive, 'pig survived tests' ); + }; + + +=head2 3) Startup and shutdown methods + +Startup and shutdown methods are like setup and teardown methods for the whole test class. All the startup methods are run once when you start running a test class. All the shutdown methods are run once just before a test class stops running. + +You can use these to create and destroy expensive objects that you don't want to have to create and destroy for every test - a database connection for example: + + sub db_connect : Test(startup) { + shift->{dbi} = DBI->connect; + }; + + sub db_disconnect : Test(shutdown) { + shift->{dbi}->disconnect; + }; + +Just like setup and teardown methods you can pass an optional number of tests to startup and shutdown methods. For example: + + sub example : Test(startup => 1) { + ok(1, 'a startup method with one test'); + }; + +If you want to run an unknown number of tests within your startup method, you need to say e.g. + + sub example : Test(startup => no_plan) { + ok(1, q{The first of many tests that don't want to have to count}); + ... + } + +as the : Tests attribute behaves exactly like : Test in this context. + +If a startup method has a failing test or throws an exception then all other tests for the current test object are ignored. + +=head1 RUNNING TESTS + +You run test methods with L. Doing: + + Test::Class->runtests + +runs all of the test methods in every loaded test class. This allows you to easily load multiple test classes in a *.t file and run them all. + + #! /usr/bin/perl + + # load all the test classes I want to run + use Foo::Test; + use Foo::Bar::Test; + use Foo::Fribble::Test; + use Foo::Ni::Test; + + # and run them all + Test::Class->runtests; + +You can use L to automatically load all the test classes in a given set of directories. + +If you need finer control you can create individual test objects with L. For example to just run the tests in the test class C you can do: + + Example::Test->new->runtests + +You can also pass L a list of test objects to run. For example: + + my $o1 = Example::Test->new; + my $o2 = Another::Test->new; + # runs all the tests in $o1 and $o2 + $o1->runtests($o2); + +Since, by definition, the base Test::Class has no tests you could also have written: + + my $o1 = Example::Test->new; + my $o2 = Another::Test->new; + Test::Class->runtests($o1, $o2); + +If you pass L class names it will automatically create test objects for you, so the above can be written more compactly as: + + Test::Class->runtests(qw( Example::Test Another::Test )) + +In all of the above examples L will look at the number of tests both test classes run and output an appropriate test header for L automatically. + +What happens if you run test classes and normal tests in the same script? For example: + + Test::Class->runtests; + ok(Example->new->foo, 'a test not in the test class'); + ok(Example->new->bar, 'ditto'); + +L will complain that it saw more tests than it expected since the test header output by L will not include the two normal tests. + +To overcome this problem you can pass an integer value to L. This is added to the total number of tests in the test header. So the problematic example can be rewritten as follows: + + Test::Class->runtests(+2); + ok(Example->new->foo, 'a test not in the test class'); + ok(Example->new->bar, 'ditto'); + +If you prefer to write your test plan explicitly you can use L to find out the number of tests a class/object is expected to run. + +Since L will not output a test plan if one has already been set the previous example can be written as: + + plan tests => Test::Class->expected_tests(+2); + Test::Class->runtests; + ok(Example->new->foo, 'a test not in the test class'); + ok(Example->new->bar, 'ditto'); + +I Test objects are just normal perl objects. Test classes are just normal perl classes. Setup, test and teardown methods are just normal methods. You are completely free to have other methods in your class that are called from your test methods, or have object specific C and C methods. + +In particular you can override the new() method to pass parameters to your test object, or re-define the number of tests a method will run. See L for an example. + + +=head1 TEST DESCRIPTIONS + +The test functions you import from L and other L based modules usually take an optional third argument that specifies the test description, for example: + + is $something, $something_else, 'a description of my test'; + +If you do not supply a test description, and the test function does not supply its own default, then Test::Class will use the name of the currently running test method, replacing all "_" characters with spaces so: + + sub one_plus_one_is_two : Test { + is 1+1, 2; + } + +will result in: + + ok 1 - one plus one is two + + +=head1 RUNNING ORDER OF METHODS + +Methods of each type are run in the following order: + +=over 4 + +=item 1. + +All of the startup methods in alphabetical order + +=item 2. + +For each test method, in alphabetical order: + +=over 2 + +=item * + +All of the setup methods in alphabetical order + +=item * + +The test method. + +=item * + +All of the teardown methods in alphabetical order + +=back + +=item 3. + +All of the shutdown methods in alphabetical order. + +=back + +Most of the time you should not care what order tests are run in, but it can occasionally be useful to force some test methods to be run early. For example: + + sub _check_new { + my $self = shift; + isa_ok(Object->new, "Object") or $self->BAILOUT('new fails!'); + }; + +The leading C<_> will force the above method to run first - allowing the entire suite to be aborted before any other test methods run. + + +=head1 HANDLING EXCEPTIONS + +If a startup, setup, test, teardown or shutdown method dies then L will catch the exception and fail any remaining test. For example: + + sub test_object : Test(2) { + my $object = Object->new; + isa_ok( $object, "Object" ) or die "could not create object\n"; + ok( $object->open, "open worked" ); + }; + +will produce the following if the first test failed: + + not ok 1 - The object isa Object + # Failed test 'The object isa Object' + # at /Users/adrianh/Desktop/foo.pl line 14. + # (in MyTest->test_object) + # The object isn't defined + not ok 2 - test_object died (could not create object) + # Failed test 'test_object died (could not create object)' + # at /Users/adrianh/Desktop/foo.pl line 19. + # (in MyTest->test_object) + +This can considerably simplify testing code that throws exceptions. + +Rather than having to explicitly check that the code exited normally (e.g. with L) the test will fail automatically - without aborting the other test methods. For example contrast: + + use Test::Exception; + + my $file; + lives_ok { $file = read_file('test.txt') } 'file read'; + is($file, "content", 'test file read'); + +with: + + sub read_file : Test { + is(read_file('test.txt'), "content", 'test file read'); + }; + +If more than one test remains after an exception then the first one is failed, and the remaining ones are skipped. + +If the setup method of a test method dies, then all of the remaining setup and shutdown methods are also skipped. + +Since startup methods will usually be creating state needed by all the other test methods an exception within a startup method will prevent all other test methods of that class running. + + +=head1 RETURNING EARLY + +If a test method returns before it has run all of its tests, by default the missing tests are deemed to have been skipped; see L<"Skipped Tests"> for more information. + +However, if the class's C method returns true, then the missing tests will be deemed to have failed. For example, + + package MyClass; + use base 'Test::Class'; + sub fail_if_returned_early { 1 } + + sub oops : Tests(8) { + for (my $n=1; $n*$n<50; ++$n) { + ok 1, "$n squared is less than fifty"; + } + } + + +=head1 SKIPPED TESTS + +You can skip the rest of the tests in a method by returning from the method before all the test have finished running (but see L<"Returning Early"> for how to change this). The value returned is used as the reason for the tests being skipped. + +This makes managing tests that can be skipped for multiple reasons very simple. For example: + + sub flying_pigs : Test(5) { + my $pig = Pig->new; + isa_ok($pig, 'Pig') or return("cannot breed pigs") + can_ok($pig, 'takeoff') or return("pigs don't fly here"); + ok($pig->takeoff, 'takeoff') or return("takeoff failed"); + ok( $pig->altitude > 0, 'Pig is airborne' ); + ok( $pig->airspeed > 0, ' and moving' ); + }; + +If you run this test in an environment where Cnew> worked and the takeoff method existed, but failed when ran, you would get: + + ok 1 - The object isa Pig + ok 2 - can takeoff + not ok 3 - takeoff + ok 4 # skip takeoff failed + ok 5 # skip takeoff failed + +You can also skip tests just as you do in Test::More or Test::Builder - see L for more information. + +I if you want to skip tests in a method with C tests then you have to explicitly skip the tests in the method - since Test::Class cannot determine how many tests (if any) should be skipped: + + sub test_objects : Tests { + my $self = shift; + my $objects = $self->{objects}; + if (@$objects) { + isa_ok($_, "Object") foreach (@$objects); + } else { + $self->builder->skip("no objects to test"); + }; + }; + +Another way of overcoming this problem is to explicitly set the number of tests for the method at run time using L or L<"num_tests">. + +You can make a test class skip all of its tests by setting L before L is called. + +=head1 TO DO TESTS + +You can create todo tests just as you do in L and L using the C<$TODO> variable. For example: + + sub live_test : Test { + local $TODO = "live currently unimplemented"; + ok(Object->live, "object live"); + }; + +See L for more information. + + +=head1 EXTENDING TEST CLASSES BY INHERITANCE + +You can extend test methods by inheritance in the usual way. For example consider the following test class for a C object. + + package Pig::Test; + use base qw(Test::Class); + use Test::More; + + sub testing_class { "Pig" }; + sub new_args { (-age => 3) }; + + sub setup : Test(setup) { + my $self = shift; + my $class = $self->testing_class; + my @args = $self->new_args; + $self->{pig} = $class->new( @args ); + }; + + sub _creation : Test { + my $self = shift; + isa_ok($self->{pig}, $self->testing_class) + or $self->FAIL_ALL('Pig->new failed'); + }; + + sub check_fields : Test { + my $pig = shift->{pig}; + is($pig->age, 3, "age accessed"); + }; + +Next consider C a subclass of C where you can give your pig a name. + +We want to make sure that all the tests for the C object still work for C. We can do this by subclassing C and overriding the C and C methods. + + package NamedPig::Test; + use base qw(Pig::Test); + use Test::More; + + sub testing_class { "NamedPig" }; + sub new_args { (shift->SUPER::new_args, -name => 'Porky') }; + +Now we need to test the name method. We could write another test method, but we also have the option of extending the existing C method. + + sub check_fields : Test(2) { + my $self = shift; + $self->SUPER::check_fields; + is($self->{pig}->name, 'Porky', 'name accessed'); + }; + +While the above works, the total number of tests for the method is dependent on the number of tests in its C. If we add a test to Ccheck_fields> we will also have to update the number of tests of Ccheck_fields>. + +Test::Class allows us to state explicitly that we are adding tests to an existing method by using the C<+> prefix. Since we are adding a single test to C it can be rewritten as: + + sub check_fields : Test(+1) { + my $self = shift; + $self->SUPER::check_fields; + is($self->{pig}->name, 'Porky', 'name accessed'); + }; + +With the above definition you can add tests to C in C without affecting C. + + +=head1 RUNNING INDIVIDUAL TESTS + +B The exact mechanism for running individual tests is likely to change in the future. + +Sometimes you just want to run a single test. Commenting out other tests or writing code to skip them can be a hassle, so you can specify the C environment variable. The value is expected to be a valid regular expression and, if present, only runs test methods whose names match the regular expression. Startup, setup, teardown and shutdown tests will still be run. + +One easy way of doing this is by specifying the environment variable I the C method is called. + +Running a test named C: + + #! /usr/bin/perl + use Example::Test; + + $ENV{TEST_METHOD} = 'customer_profile'; + Test::Class->runtests; + +Running all tests with C in their name: + + #! /usr/bin/perl + use Example::Test; + + $ENV{TEST_METHOD} = '.*customer.*'; + Test::Class->runtests; + +If you specify an invalid regular expression, your tests will not be run: + + #! /usr/bin/perl + use Example::Test; + + $ENV{TEST_METHOD} = 'C++'; + Test::Class->runtests; + +And when you run it: + + TEST_METHOD (C++) is not a valid regular expression: Search pattern \ + not terminated at (eval 17) line 1. + + +=head1 ORGANISING YOUR TEST CLASSES + +You can, of course, organise your test modules as you wish. My personal preferences is: + +=over 4 + +=item * + +Name test classes with a suffix of C<::Test> so the test class for the C module would be C. + +=item * + +Place all test classes in F. + +=back + +The L provides a simple mechanism for easily loading all of the test classes in a given set of directories. + + +=head1 A NOTE ON LOADING TEST CLASSES + +Due to its use of subroutine attributes Test::Class based modules must be loaded at compile rather than run time. This is because the :Test attribute is applied by a CHECK block. + +This can be problematic if you want to dynamically load Test::Class modules. Basically while: + + require $some_test_class; + +will break, doing: + + BEGIN { require $some_test_class }; + +will work just fine. For more information on CHECK blocks see L. + +If you still can't arrange for your classes to be loaded at runtime, you could use an alternative mechanism for adding your tests: + + # sub test_something : Test(3) {...} + # becomes + sub test_something {...} + __PACKAGE__->add_testinfo('test_something', test => 3); + +See the L method for more details. + +=head1 GENERAL FILTERING OF TESTS + +The use of $ENV{TEST_METHOD} to run just a subset of tests is useful, but +sometimes it doesn't give the level of granularity that you desire. Another +feature of this class is the ability to do filtering on other static criteria. +In order to permit this, a generic filtering method is supported. This can +be used by specifying coderefs to the 'add_filter' method of this class. + +In determining which tests should be run, all filters that have previously +been specified via the add_filter method will be run in-turn for each normal +test method. If B of these filters return a false value, the method will +not be executed, or included in the number of tests. Note that filters will +only be run for normal test methods, they are ignored for startup, shutdown, +setup, and teardown test methods. + +Note that test filters are global, and will affect all tests in all classes, +not just the one that they were defined in. + +An example of this mechanism that mostly simulates the use of TEST_METHOD +above is: + + package MyTests; + + use Test::More; + + use base qw( Test::Class ); + + my $MYTEST_METHOD = qr/^t_not_filtered$/; + + my $filter = sub { + my ( $test_class, $test_method ) = @_; + + return $test_method =~ $MYTEST_METHOD; + }; + Test::Class->add_filter( $filter ); + + sub t_filtered : Test( 1 ) { + fail( "filtered test run" ); + } + + sub t_not_filtered : Test( 1 ) { + pass( "unfiltered test run" ); + } + +=head1 METHODS + +=head2 Creating and running tests + +=over 4 + +=item B + + # test methods + sub method_name : Test { ... }; + sub method_name : Test(N) { ... }; + + # setup methods + sub method_name : Test(setup) { ... }; + sub method_name : Test(setup => N) { ... }; + + # teardown methods + sub method_name : Test(teardown) { ... }; + sub method_name : Test(teardown => N) { ... }; + + # startup methods + sub method_name : Test(startup) { ... }; + sub method_name : Test(startup => N) { ... }; + + # shutdown methods + sub method_name : Test(shutdown) { ... }; + sub method_name : Test(shutdown => N) { ... }; + +Marks a startup, setup, test, teardown or shutdown method. See L for information on how to run methods declared with the C attribute. + +N specifies the number of tests the method runs. + +=over 4 + +=item * + +If N is an integer then the method should run exactly N tests. + +=item * + +If N is an integer with a C<+> prefix then the method is expected to call its C method and extend it by running N additional tests. + +=item * + +If N is the string C then the method can run an arbitrary number of tests. + +=back + +If N is not specified it defaults to C<1> for test methods, and C<0> for startup, setup, teardown and shutdown methods. + +You can change the number of tests that a method runs using L or L. + + +=item B + + sub method_name : Tests { ... }; + sub method_name : Tests(N) { ... }; + +Acts just like the C<:Test> attribute, except that if the number of tests is not specified it defaults to C. So the following are equivalent: + + sub silly1 :Test( no_plan ) { ok(1) foreach (1 .. rand 5) }; + sub silly2 :Tests { ok(1) foreach (1 .. rand 5) }; + + +=item B + + $Tests = CLASS->new(KEY => VAL ...) + $Tests2 = $Tests->new(KEY => VAL ...) + +Creates a new test object (blessed hashref) containing the specified key/value pairs. + +If called as an object method the existing object's key/value pairs are copied into the new object. Any key/value pairs passed to C override those in the original object if duplicates occur. + +Since the test object is passed to every test method as it runs it is a convenient place to store test fixtures. For example: + + sub make_fixture : Test(setup) { + my $self = shift; + $self->{object} = Object->new(); + $self->{dbh} = Mock::DBI->new(-type => normal); + }; + + sub test_open : Test { + my $self = shift; + my ($o, $dbh) = ($self->{object}, $self->{dbh}); + ok($o->open($dbh), "opened ok"); + }; + +See L for an example of overriding C. + + +=item B + + $n = $Tests->expected_tests + $n = CLASS->expected_tests + $n = $Tests->expected_tests(TEST, ...) + $n = CLASS->expected_tests(TEST, ...) + +Returns the total number of tests that L will run on the specified class/object. This includes tests run by any setup and teardown methods. + +Will return C if the exact number of tests is undetermined (i.e. if any setup, test or teardown method has an undetermined number of tests). + +The C of an object after L has been executed will include any run time changes to the expected number of tests made by L or L. + +C can also take an optional list of test objects, test classes and integers. In this case the result is the total number of expected tests for all the test/object classes (including the one the method was applied to) plus any integer values. + +C is useful when you're integrating one or more test classes into a more traditional test script, for example: + + use Test::More; + use My::Test::Class; + + plan tests => My::Test::Class->expected_tests(+2); + + ok(whatever, 'a test'); + ok(whatever, 'another test'); + My::Test::Class->runtests; + + + +=item B + + $allok = $Tests->runtests + $allok = CLASS->runtests + $allok = $Tests->runtests(TEST, ...) + $allok = CLASS->runtests(TEST, ...) + +C is used to run test classes. At its most basic doing: + + $test->runtests + +will run the test methods of the test object $test, unless C<< $test->SKIP_CLASS >> returns a true value. + +Unless you have already specified a test plan using Test::Builder (or Test::More, et al) C will set the test plan just before the first method that runs a test is executed. + +If the environment variable C is set C will display the name of each test method before it runs like this: + + # My::Test::Class->my_test + ok 1 - fribble + # My::Test::Class->another_test + ok 2 - bar + +Just like L, C can take an optional list of test object/classes and integers. All of the test object/classes are run. Any integers are added to the total number of tests shown in the test header output by C. + +For example, you can run all the tests in test classes A, B and C, plus one additional normal test by doing: + + Test::Class->runtests(qw(A B C), +1); + ok(1==1, 'non class test'); + +Finally, if you call C on a test class without any arguments it will run all of the test methods of that class, and all subclasses of that class. For example: + + #! /usr/bin/perl + # Test all the Foo stuff + + use Foo::Test; + use Foo::Bar::Test; + use Foo::Ni::Test; + + # run all the Foo*Test modules we just loaded + Test::Class->runtests; + + +=item B + + $reason = CLASS->SKIP_CLASS; + CLASS->SKIP_CLASS( $reason ); + +Determines whether the test class CLASS should run it's tests. If SKIP_CLASS returns a true value then L will not run any of the test methods in CLASS. + +You can override the default on a class-by-class basis by supplying a new value to SKIP_CLASS. For example if you have an abstract base class that should not run just add the following to your module: + + My::Abstract::Test->SKIP_CLASS( 1 ); + +This will not affect any sub-classes of C which will run as normal. + +If the true value returned by SKIP_CLASS is anything other than "1" then a skip test is output using this value as the skip message. For example: + + My::Postgres::Test->SKIP_CLASS( + $ENV{POSTGRES_HOME} ? 0 : '$POSTGRES_HOME needs to be set' + ); + +will output something like this if C is not set + + ... other tests ... + ok 123 # skip My::Postgres::Test - $POSTGRES_HOME needs to be set + ... more tests ... + +You can also override SKIP_CLASS for a class hierarchy. For example, to prevent any subclasses of My::Postgres::Test running we could override SKIP_CLASS like this: + + sub My::Postgres::Test::SKIP_CLASS { + $ENV{POSTGRES_HOME} ? 0 : '$POSTGRES_HOME needs to be set' + }; + +=back + +=head2 Fetching and setting a method's test number + + +=over 4 + +=item B + + $n = $Tests->num_method_tests($method_name) + $Tests->num_method_tests($method_name, $n) + $n = CLASS->num_method_tests($method_name) + CLASS->num_method_tests($method_name, $n) + +Fetch or set the number of tests that the named method is expected to run. + +If the method has an undetermined number of tests then $n should be the string C. + +If the method is extending the number of tests run by the method in a superclass then $n should have a C<+> prefix. + +When called as a class method any change to the expected number of tests applies to all future test objects. Existing test objects are unaffected. + +When called as an object method any change to the expected number of tests applies to that object alone. + +C is useful when you need to set the expected number of tests at object creation time, rather than at compile time. + +For example, the following test class will run a different number of tests depending on the number of objects supplied. + + package Object::Test; + use base qw(Test::Class); + use Test::More; + + sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + my $num_objects = @{$self->{objects}}; + $self->num_method_tests('test_objects', $num_objects); + return($self); + }; + + sub test_objects : Tests { + my $self = shift; + ok($_->open, "opened $_") foreach @{$self->{objects}}; + }; + ... + # This runs two tests + Object::Test->new(objects => [$o1, $o2]); + +The advantage of setting the number of tests at object creation time, rather than using a test method without a plan, is that the number of expected tests can be determined before testing begins. This allows better diagnostics from L, L and L. + +C is a protected method and can only be called by subclasses of Test::Class. It fetches or sets the expected number of tests for the methods of the class it was I, not the methods of the object/class it was I. This allows test classes that use C to be subclassed easily. + +For example, consider the creation of a subclass of Object::Test that ensures that all the opened objects are read-only: + + package Special::Object::Test; + use base qw(Object::Test); + use Test::More; + + sub test_objects : Test(+1) { + my $self = shift; + $self->SUPER::test_objects; + my @bad_objects = grep {! $_->read_only} (@{$self->{objects}}); + ok(@bad_objects == 0, "all objects read only"); + }; + ... + # This runs three tests + Special::Object::Test->new(objects => [$o1, $o2]); + +Since the call to C in Object::Test only affects the C of Object::Test, the above works as you would expect. + + +=item B + + $n = $Tests->num_tests + $Tests->num_tests($n) + $n = CLASS->num_tests + CLASS->num_tests($n) + +Set or return the number of expected tests associated with the currently running test method. This is the same as calling L with a method name of L. + +For example: + + sub txt_files_readable : Tests { + my $self = shift; + my @files = <*.txt>; + $self->num_tests(scalar(@files)); + ok(-r $_, "$_ readable") foreach (@files); + }; + +Setting the number of expected tests at run time, rather than just having a C test method, allows L to display appropriate diagnostic messages if the method runs a different number of tests. + +=back + + +=head2 Support methods + +=over 4 + +=item B + + $Tests->builder + +Returns the underlying L object that Test::Class uses. For example: + + sub test_close : Test { + my $self = shift; + my ($o, $dbh) = ($self->{object}, $self->{dbh}); + $self->builder->ok($o->close($dbh), "closed ok"); + }; + +=item B + + $method_name = $Tests->current_method + $method_name = CLASS->current_method + +Returns the name of the test method currently being executed by L, or C if L has not been called. + +The method name is also available in the setup and teardown methods that run before and after the test method. This can be useful in producing diagnostic messages, for example: + + sub test_invarient : Test(teardown => 1) { + my $self = shift; + my $m = $self->current_method; + ok($self->invarient_ok, "class okay after $m"); + }; + + + +=item B + + $Tests->BAILOUT($reason) + CLASS->BAILOUT($reason) + +Things are going so badly all testing should terminate, including running any additional test scripts invoked by L. This is exactly the same as doing: + + $self->builder->BAILOUT + +See L for details. Any teardown and shutdown methods are I run. + + +=item B + + $Tests->FAIL_ALL($reason) + CLASS->FAIL_ALL($reason) + +Things are going so badly all the remaining tests in the current script should fail. Exits immediately with the number of tests failed, or C<254> if more than 254 tests were run. Any teardown methods are I run. + +This does not affect the running of any other test scripts invoked by L. + +For example, if all your tests rely on the ability to create objects then you might want something like this as an early test: + + sub _test_new : Test(3) { + my $self = shift; + isa_ok(Object->new, "Object") + || $self->FAIL_ALL('cannot create Objects'); + ... + }; + + + +=item B + + $Tests->SKIP_ALL($reason) + CLASS->SKIP_ALL($reason) + +Things are going so badly all the remaining tests in the current script should be skipped. Exits immediately with C<0> - teardown methods are I run. + +This does not affect the running of any other test scripts invoked by L. + +For example, if you had a test script that only applied to the darwin OS you could write: + + sub _darwin_only : Test(setup) { + my $self = shift; + $self->SKIP_ALL("darwin only") unless $^O eq "darwin"; + }; + + +=item B + + CLASS->add_testinfo($name, $type, $num_tests) + +Chiefly for use by libraries like L, which can't use the C<:Test(...)> interfaces make test methods. C informs the class about a test method that has been defined without a C, C or other attribute. + +C<$name> is the name of the method, C<$type> must be one of C, C, C, C or C, and C<$num_tests> has the same meaning as C in the description of the L attribute. + + +=item B + + CLASS->add_filter($filter_coderef); + +Adds a filtering coderef. Each filter is passed a test class and method name and returns a boolean. All filters are applied globally in the order they were added. If any filter returns false the test method is not run or included in the number of tests. + +Note that filters will only be run for normal test methods, they are ignored for startup, shutdown, setup, and teardown test methods. + +See the section on the L for more information. + +=item B + +Controls what happens if a method returns before it has run all of its tests. It is called with no arguments in boolean context; if it returns true, then the missing tests fail, otherwise, they skip. See L<"Returning Early"> and L<"Skipped Tests">. + + +=back + + + +=head1 HELP FOR CONFUSED JUNIT USERS + +This section is for people who have used JUnit (or similar) and are confused because they don't see the TestCase/Suite/Runner class framework they were expecting. Here we take each of the major classes in JUnit and compare them with their equivalent Perl testing modules. + +=over 4 + +=item B + +The test assertions provided by Assert correspond to the test functions provided by the L based modules (L, L, L, etc.) + +Unlike JUnit the test functions supplied by Test::More et al do I throw exceptions on failure. They just report the failure to STDOUT where it is collected by L. This means that where you have + + sub foo : Test(2) { + ok($foo->method1); + ok($foo->method2); + }; + +The second test I run if the first one fails. You can emulate the JUnit way of doing it by throwing an explicit exception on test failure: + + sub foo : Test(2) { + ok($foo->method1) or die "method1 failed"; + ok($foo->method2); + }; + +The exception will be caught by Test::Class and the other test automatically failed. + +=item B + +Test::Class corresponds to TestCase in JUnit. + +In Test::Class setup, test and teardown methods are marked explicitly using the L attribute. Since we need to know the total number of tests to provide a test plan for L we also state how many tests each method runs. + +Unlike JUnit you can have multiple setup/teardown methods in a class. + +=item B + +Test::Class also does the work that would be done by TestSuite in JUnit. + +Since the methods are marked with attributes Test::Class knows what is and isn't a test method. This allows it to run all the test methods without having the developer create a suite manually, or use reflection to dynamically determine the test methods by name. See the L method for more details. + +The running order of the test methods is fixed in Test::Class. Methods are executed in alphabetical order. + +Unlike JUnit, Test::Class currently does not allow you to run individual test methods. + +=item B + +L does the work of the TestRunner in JUnit. It collects the test results (sent to STDOUT) and collates the results. + +Unlike JUnit there is no distinction made by Test::Harness between errors and failures. However, it does support skipped and todo test - which JUnit does not. + +If you want to write your own test runners you should look at L. + +=back + + +=head1 OTHER MODULES FOR XUNIT TESTING IN PERL + +In addition to Test::Class there are two other distributions for xUnit testing in perl. Both have a longer history than Test::Class and might be more suitable for your needs. + +I am biased since I wrote Test::Class - so please read the following with appropriate levels of scepticism. If you think I have misrepresented the modules please let me know. + +=over 4 + +=item B + +A very simple unit testing framework. If you are looking for a lightweight single module solution this might be for you. + +The advantage of L is that it is simple! Just one module with a smallish API to learn. + +Of course this is also the disadvantage. + +It's not class based so you cannot create testing classes to reuse and extend. + +It doesn't use L so it's difficult to extend or integrate with other testing modules. If you are already familiar with L, L and friends you will have to learn a new test assertion API. It does not support L. + +=item B + +L is a port of JUnit L into perl. If you have used JUnit then the Test::Unit framework should be very familiar. + +It is class based so you can easily reuse your test classes and extend by subclassing. You get a nice flexible framework you can tweak to your heart's content. If you can run Tk you also get a graphical test runner. + +However, Test::Unit is not based on L. You cannot easily move Test::Builder based test functions into Test::Unit based classes. You have to learn another test assertion API. + +Test::Unit implements it's own testing framework separate from L. You can retrofit *.t scripts as unit tests, and output test results in the format that L expects, but things like L and L are not supported. + +=back + + +=head1 BUGS + +None known at the time of writing. + +If you find any bugs please let me know by e-mail at , or report the problem with L. + + +=head1 COMMUNITY + +=head2 perl-qa + +If you are interested in testing using Perl I recommend you visit L and join the excellent perl-qa mailing list. See L for details on how to subscribe. + +=head2 perlmonks + +You can find users of Test::Class, including the module author, on L. Feel free to ask questions on Test::Class there. + +=head2 CPAN::Forum + +The CPAN Forum is a web forum for discussing Perl's CPAN modules. The Test::Class forum can be found at L. + + +=head1 TO DO + +If you think this module should do something that it doesn't (or does something that it shouldn't) please let me know. + +You can see my current to do list at L, with an RSS feed of changes at L. + + +=head1 ACKNOWLEDGMENTS + +This is yet another implementation of the ideas from Kent Beck's Testing Framework paper L. + +Thanks to +Adam Kennedy, +agianni, +Alexander D'Archangel, +Andrew Grangaard, +Apocalypse, +Ask Bjorn Hansen, +Chris Dolan, +Chris Williams, +Corion, +Cosimo Streppone, +Daniel Berger, +Dave Evans, +Dave O'Neill, +David Cantrell, +David Wheeler, +Diab Jerius, +Emil Jansson, +Gunnar Wolf, +Hai Pham, +Hynek, +imacat, +Jeff Deifik, +Jim Brandt, +Jochen Stenzel, +Johan Lindstrom, +John West, +Jonathan R. Warden, +Joshua ben Jore, +Jost Krieger, +Ken Fox, +Kenichi Ishigaki +Lee Goddard, +Mark Morgan, +Mark Reynolds, +Mark Stosberg, +Martin Ferrari, +Mathieu Sauve-Frankel, +Matt Trout, +Matt Williamson, +Michael G Schwern, +Murat Uenalan, +Naveed Massjouni, +Nicholas Clark, +Ovid, +Piers Cawley, +Rob Kinyon, +Sam Raymer, +Scott Lanning, +Sebastien Aperghis-Tramoni, +Steve Kirkup, +Stray Toaster, +Ted Carnahan, +Terrence Brannon, +Todd W, +Tom Metro, +Tony Bowden, +Tony Edwardson, +William McKee, +various anonymous folk and all the fine people on perl-qa for their feedback, patches, suggestions and nagging. + +This module wouldn't be possible without the excellent L. Thanks to chromatic and Michael G Schwern for creating such a useful module. + + +=head1 AUTHORS + +Adrian Howard , Curtis "Ovid" Poe, , Mark Morgan . + +If you use this module, and can spare the time please let us know or rate it at L. + +=head1 SEE ALSO + +=over 4 + +=item L + +Simple way to load "Test::Class" classes automatically. + +=item L + +Delicious links on Test::Class. + +=item Perl Testing: A Developer's Notebook by Ian Langworth and chromatic + +Chapter 8 covers using Test::Class. + +=item Advanced Perl Programming, second edition by Simon Cozens + +Chapter 8 has a few pages on using Test::Class. + +=item The Perl Journal, April 2003 + +Includes the article "Test-Driven Development in Perl" by Piers Cawley that uses Test::Class. + +=item L + +Support module for building test libraries. + +=item L & L + +Basic utilities for writing tests. + +=item L + +Overview of some of the many testing modules available on CPAN. + +=item L + +Delicious links on perl testing. + +=item L + +Another approach to object oriented testing. + +=item L and L + +Alternatives to grouping sets of tests together. + +=back + +The following modules use Test::Class as part of their test suite. You might want to look at them for usage examples: + +=over 4 + +L, Bricolage (L), L, L, L, L, L, L, L, L, L, L, L, L, and L + +=back + +The following modules are not based on L, but may be of interest as alternatives to Test::Class. + +=over 4 + +=item L + +Perl unit testing framework closely modeled on JUnit. + +=item L + +A very simple unit testing framework. + +=back + +=head1 LICENCE + +Copyright 2002-2010 Adrian Howard, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/components/clm/bld/test_build_namelist/perl5lib/Test/Class/Load.pm b/components/clm/bld/test_build_namelist/perl5lib/Test/Class/Load.pm new file mode 100644 index 0000000000..fd34859683 --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/Test/Class/Load.pm @@ -0,0 +1,232 @@ +use strict; +use warnings; + +package Test::Class::Load; + +use Test::Class; +use File::Find; +use File::Spec; + +our $VERSION = '0.41'; + +# Override to get your own filter +sub is_test_class { + my ( $class, $file, $dir ) = @_; + # By default, we only care about .pm files + if ($file =~ /\.pm$/) { + return 1; + } + return; +} + +my %Added_to_INC; +sub _load { + my ( $class, $file, $dir ) = @_; + $file =~ s{\.pm$}{}; # remove .pm extension + $file =~ s{\\}{/}g; # to make win32 happy + $dir =~ s{\\}{/}g; # to make win32 happy + $file =~ s/^$dir//; + my $_package = join '::' => grep $_ => File::Spec->splitdir( $file ); + + # untaint that puppy! + my ( $package ) = $_package =~ /^([[:word:]]+(?:::[[:word:]]+)*)$/; + + # Filter out bad classes (mainly this means things in .svn and similar) + return unless defined $package; + + unshift @INC => $dir unless $Added_to_INC{ $dir }++; + eval "require $package"; ## no critic + die $@ if $@; +} + +sub import { + my ( $class, @directories ) = @_; + my @test_classes; + + foreach my $dir ( @directories ) { + $dir = File::Spec->catdir( split '/', $dir ); + find( + { no_chdir => 1, + wanted => sub { + my @args = ($File::Find::name, $dir); + if ($class->is_test_class(@args)) { + $class->_load(@args); + } + }, + }, + $dir + ); + } +} + +1; + +__END__ + +=head1 NAME + +Test::Class::Load - Load C classes automatically. + +=head1 VERSION + +Version 0.41 + +=head1 SYNOPSIS + + use Test::Class::Load qw(t/tests t/lib); + Test::Class->runtests; + +=head1 EXPORT + +None. + +=head1 DESCRIPTION + +C typically uses a helper script to load the test classes. It often looks something like this: + + #!/usr/bin/perl -T + + use strict; + use warnings; + + use lib 't/tests'; + + use MyTest::Foo; + use MyTest::Foo::Bar; + use MyTest::Foo::Baz; + + Test::Class->runtests; + +This causes a problem, though. When you're writing a test class, it's easy to forget to add it to the helper script. Then you run your huge test suite and see that all tests pass, even though you don't notice that it didn't run your new test class. Or you delete a test class and you forget to remove it from the helper script. + +C automatically finds and loads your test classes for you. There is no longer a need to list them individually. + +=head1 BASIC USAGE + +Using C is as simple as this: + + #!/usr/bin/perl -T + + use strict; + use warnings; + + use Test::Class::Load 't/tests'; + + Test::Class->runtests; + +That will search through all files in the C directory and automatically load anything which ends in C<.pm>. You should only put test classes in those directories. + +If you have test classes in more than one directory, that's OK. Just list all of them in the import list. + + use Test::Class::Load qw< + t/customer + t/order + t/inventory + >; + Test::Class->runtests; + +=head1 ADVANCED USAGE + +Here's some examples of advanced usage of C. + +=head2 FILTER LOADED CLASSES + +You can redefine the filtering criteria, that is, decide what classes are picked +up and what others are not. You do this simply by subclassing +C overriding the C method. You might want to +do this to only load modules which inherit from C, or anything else +for that matter. + +=over 4 + +=item B + + $is_test_class = $class->is_test_class( $file, $directory ) + +Returns true if C<$file> in C<$directory> should be considered a test class and be loaded by L. The default filter simply returns true if C<$file> ends with C<.pm> + +=back + +For example: + + use strict; + use warnings; + + package My::Loader; + use base qw( Test::Class::Load ); + + # Overriding this selects what test classes + # are considered by T::C::Load + sub is_test_class { + my ( $class, $file, $dir ) = @_; + + # return unless it's a .pm (the default) + return unless $class->SUPER::is_test_class( $file, $dir ); + + # and only allow .pm files with "Good" in their filename + return $file =~ m{Good}; + } + + 1; + +=head2 CUSTOMIZING TEST RUNS + +One problem with this style of testing is that you run I of the tests every time you need to test something. If you want to run only one test class, it's problematic. The easy way to do this is to change your helper script by deleting the C call: + + #!/usr/bin/perl -T + + use strict; + use warnings; + + use Test::Class::Load 't/tests'; + +Then, just make sure that all of your test classes inherit from your own base class which runs the tests for you. It might looks something like this: + + package My::Test::Class; + + use strict; + use warnings; + + use base 'Test::Class'; + + INIT { Test::Class->runtests } # here's the magic! + + 1; + +Then you can run an individual test class by using the C utility, tell it the directory of the test classes and the name of the test package you wish to run: + + prove -lv -It/tests Some::Test::Class + +You can even automate this by binding it to a key in C: + + noremap ,t :!prove -lv -It/tests % + +Then you can just type C<,t> ('comma', 'tee') and it will run the tests for your test class or the tests for your test script (if you're using a traditional C style script). + +Of course, you can still run your helper script with C, C or C<./Build test> to run all of your test classes. + +If you do that, you'll have to make sure that the C<-I> switches point to your test class directories. + +=head1 SECURITY + +C is taint safe. Because we're reading the class names from the directory structure, they're marked as tainted when running under taint mode. We use the following ultra-paranoid bit of code to untaint them. Please file a bug report if this is too restrictive. + + my ($package) = $_package =~ /^([[:word:]]+(?:::[[:word:]]+)*)$/; + +=head1 AUTHOR + +Curtis "Ovid" Poe, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 ACKNOWLEDGMENTS + +Thanks to David Wheeler for the idea and Adrian Howard for C. + +=head1 COPYRIGHT & LICENSE + +Copyright 2006 Curtis "Ovid" Poe, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/components/clm/bld/test_build_namelist/perl5lib/Test/Class/MethodInfo.pm b/components/clm/bld/test_build_namelist/perl5lib/Test/Class/MethodInfo.pm new file mode 100644 index 0000000000..e4a897e6da --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/Test/Class/MethodInfo.pm @@ -0,0 +1,121 @@ +use strict; +use warnings; + +package Test::Class::MethodInfo; +use Carp; + +our $VERSION = '0.41'; + +sub new { + my ( $class, %param ) = @_; + my $self = bless { + name => $param{ name }, + type => $param{ type } || 'test', + }, $class; + unless ( defined $param{num_tests} ) { + $param{ num_tests } = $self->is_type('test') ? 1 : 0; + }; + $self->num_tests( $param{num_tests} ); + return $self; +}; + +sub name { shift->{name} }; + +sub type { shift->{type} }; + +sub num_tests { + my ( $self, $n ) = @_; + if ( defined $n ) { + croak "$n not valid number of tests" + unless $self->is_num_tests($n); + $self->{ num_tests } = $n; + }; + return $self->{ num_tests }; +}; + +sub is_type { + my ( $self, $type ) = @_; + return $self->{ type } eq $type; +}; + +sub is_method_type { + my ( $self, $type ) = @_; + return $type =~ m/^(startup|setup|test|teardown|shutdown)$/s; +}; + +sub is_num_tests { + my ( $self, $num_tests ) = @_; + return $num_tests =~ m/^(no_plan)|(\+?\d+)$/s; +}; + +1; +__END__ + +=head1 NAME + +Test::Class::MethodInfo - the info associated with a test method + +=head1 SYNOPSIS + + # Secret internal class + # not for public use + +=head1 DESCRIPTION + +Holds info related to particular test methods. Not part of the public API and likely to change or completely disappear. If you need to rely on any of this code let me know and we'll see if we can work something out. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head1 BUGS + +None known at the time of writing. Apart from the fact this seems a bit gnarly so I'm likely to tidy it up at some point. + +If you find any please let me know by e-mail, or report the problem with L. + +=head1 TO DO + +If you think this module should do something that it doesn't (or does something that it shouldn't) please let me know. + +You can see my current to do list at L, with an RSS feed of changes at L. + +=head1 AUTHOR + +Adrian Howard + +If you can spare the time, please drop me a line if you find this module useful. + +=head1 SEE ALSO + +=over 4 + +=item L + +What you should be looking at rather than this internal stuff + +=back + +=head1 LICENCE + +Copyright 2006 Adrian Howard, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/components/clm/bld/test_build_namelist/perl5lib/Test/Exception.pm b/components/clm/bld/test_build_namelist/perl5lib/Test/Exception.pm new file mode 100644 index 0000000000..5cbd88eb1d --- /dev/null +++ b/components/clm/bld/test_build_namelist/perl5lib/Test/Exception.pm @@ -0,0 +1,504 @@ +use strict; +use warnings; + +package Test::Exception; +use Test::Builder; +use Sub::Uplevel qw( uplevel ); +use base qw( Exporter ); + +our $VERSION = '0.32'; +our @EXPORT = qw(dies_ok lives_ok throws_ok lives_and); + +my $Tester = Test::Builder->new; + +sub import { + my $self = shift; + if ( @_ ) { + my $package = caller; + $Tester->exported_to( $package ); + $Tester->plan( @_ ); + }; + $self->export_to_level( 1, $self, $_ ) foreach @EXPORT; +} + +=head1 NAME + +Test::Exception - Test exception based code + +=head1 SYNOPSIS + + use Test::More tests => 5; + use Test::Exception; + + # or if you don't need Test::More + + use Test::Exception tests => 5; + + # then... + + # Check that the stringified exception matches given regex + throws_ok { $foo->method } qr/division by zero/, 'zero caught okay'; + + # Check an exception of the given class (or subclass) is thrown + throws_ok { $foo->method } 'Error::Simple', 'simple error thrown'; + + # all Test::Exceptions subroutines are guaranteed to preserve the state + # of $@ so you can do things like this after throws_ok and dies_ok + like $@, 'what the stringified exception should look like'; + + # Check that something died - we do not care why + dies_ok { $foo->method } 'expecting to die'; + + # Check that something did not die + lives_ok { $foo->method } 'expecting to live'; + + # Check that a test runs without an exception + lives_and { is $foo->method, 42 } 'method is 42'; + + # or if you don't like prototyped functions + + throws_ok( sub { $foo->method }, qr/division by zero/, + 'zero caught okay' ); + throws_ok( sub { $foo->method }, 'Error::Simple', + 'simple error thrown' ); + dies_ok( sub { $foo->method }, 'expecting to die' ); + lives_ok( sub { $foo->method }, 'expecting to live' ); + lives_and( sub { is $foo->method, 42 }, 'method is 42' ); + + +=head1 DESCRIPTION + +This module provides a few convenience methods for testing exception based code. It is built with +L and plays happily with L and friends. + +If you are not already familiar with L now would be the time to go take a look. + +You can specify the test plan when you C in the same way as C. +See L for details. + +NOTE: Test::Exception only checks for exceptions. It will ignore other methods of stopping +program execution - including exit(). If you have an exit() in evalled code Test::Exception +will not catch this with any of its testing functions. + +=cut + +sub _quiet_caller (;$) { ## no critic Prototypes + my $height = $_[0]; + $height++; + + if ( CORE::caller() eq 'DB' ) { + # passthrough the @DB::args trick + package DB; + if( wantarray ) { + if ( !@_ ) { + return (CORE::caller($height))[0..2]; + } + else { + # If we got here, we are within a Test::Exception test, and + # something is producing a stacktrace. In case this is a full + # trace (i.e. confess() ), we have to make sure that the sub + # args are not visible. If we do not do this, and the test in + # question is throws_ok() with a regex, it will end up matching + # against itself in the args to throws_ok(). + # + # While it is possible (and maybe wise), to test if we are + # indeed running under throws_ok (by crawling the stack right + # up from here), the old behavior of Test::Exception was to + # simply obliterate @DB::args altogether in _quiet_caller, so + # we are just preserving the behavior to avoid surprises + # + my @frame_info = CORE::caller($height); + @DB::args = (); + return @frame_info; + } + } + + # fallback if nothing above returns + return CORE::caller($height); + } + else { + if( wantarray and !@_ ) { + return (CORE::caller($height))[0..2]; + } + else { + return CORE::caller($height); + } + } +} + +sub _try_as_caller { + my $coderef = shift; + + # local works here because Sub::Uplevel has already overridden caller + local *CORE::GLOBAL::caller; + { no warnings 'redefine'; *CORE::GLOBAL::caller = \&_quiet_caller; } + + eval { uplevel 3, $coderef }; + return $@; +}; + + +sub _is_exception { + my $exception = shift; + return ref $exception || $exception ne ''; +}; + + +sub _exception_as_string { + my ( $prefix, $exception ) = @_; + return "$prefix normal exit" unless _is_exception( $exception ); + my $class = ref $exception; + $exception = "$class ($exception)" + if $class && "$exception" !~ m/^\Q$class/; + chomp $exception; + return "$prefix $exception"; +}; + + +=over 4 + +=item B + +Tests to see that a specific exception is thrown. throws_ok() has two forms: + + throws_ok BLOCK REGEX, TEST_DESCRIPTION + throws_ok BLOCK CLASS, TEST_DESCRIPTION + +In the first form the test passes if the stringified exception matches the give regular expression. For example: + + throws_ok { read_file( 'unreadable' ) } qr/No file/, 'no file'; + +If your perl does not support C you can also pass a regex-like string, for example: + + throws_ok { read_file( 'unreadable' ) } '/No file/', 'no file'; + +The second form of throws_ok() test passes if the exception is of the same class as the one supplied, or a subclass of that class. For example: + + throws_ok { $foo->bar } "Error::Simple", 'simple error'; + +Will only pass if the C method throws an Error::Simple exception, or a subclass of an Error::Simple exception. + +You can get the same effect by passing an instance of the exception you want to look for. The following is equivalent to the previous example: + + my $SIMPLE = Error::Simple->new; + throws_ok { $foo->bar } $SIMPLE, 'simple error'; + +Should a throws_ok() test fail it produces appropriate diagnostic messages. For example: + + not ok 3 - simple error + # Failed test (test.t at line 48) + # expecting: Error::Simple exception + # found: normal exit + +Like all other Test::Exception functions you can avoid prototypes by passing a subroutine explicitly: + + throws_ok( sub {$foo->bar}, "Error::Simple", 'simple error' ); + +A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any). + +A description of the exception being checked is used if no optional test description is passed. + +NOTE: Rememeber when you C perl will +automatically add the current script line number, input line number and a newline. This will +form part of the string that throws_ok regular expressions match against. + + +=cut + + +sub throws_ok (&$;$) { + my ( $coderef, $expecting, $description ) = @_; + unless (defined $expecting) { + require Carp; + Carp::croak( "throws_ok: must pass exception class/object or regex" ); + } + $description = _exception_as_string( "threw", $expecting ) + unless defined $description; + my $exception = _try_as_caller( $coderef ); + my $regex = $Tester->maybe_regex( $expecting ); + my $ok = $regex + ? ( $exception =~ m/$regex/ ) + : eval { + $exception->isa( ref $expecting ? ref $expecting : $expecting ) + }; + $Tester->ok( $ok, $description ); + unless ( $ok ) { + $Tester->diag( _exception_as_string( "expecting:", $expecting ) ); + $Tester->diag( _exception_as_string( "found:", $exception ) ); + }; + $@ = $exception; + return $ok; +}; + + +=item B + +Checks that a piece of code dies, rather than returning normally. For example: + + sub div { + my ( $a, $b ) = @_; + return $a / $b; + }; + + dies_ok { div( 1, 0 ) } 'divide by zero detected'; + + # or if you don't like prototypes + dies_ok( sub { div( 1, 0 ) }, 'divide by zero detected' ); + +A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any). + +Remember: This test will pass if the code dies for any reason. If you care about the reason it might be more sensible to write a more specific test using throws_ok(). + +The test description is optional, but recommended. + +=cut + +sub dies_ok (&;$) { + my ( $coderef, $description ) = @_; + my $exception = _try_as_caller( $coderef ); + my $ok = $Tester->ok( _is_exception($exception), $description ); + $@ = $exception; + return $ok; +} + + +=item B + +Checks that a piece of code doesn't die. This allows your test script to continue, rather than aborting if you get an unexpected exception. For example: + + sub read_file { + my $file = shift; + local $/; + open my $fh, '<', $file or die "open failed ($!)\n"; + $file = ; + return $file; + }; + + my $file; + lives_ok { $file = read_file('test.txt') } 'file read'; + + # or if you don't like prototypes + lives_ok( sub { $file = read_file('test.txt') }, 'file read' ); + +Should a lives_ok() test fail it produces appropriate diagnostic messages. For example: + + not ok 1 - file read + # Failed test (test.t at line 15) + # died: open failed (No such file or directory) + +A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any). + +The test description is optional, but recommended. + +=cut + +sub lives_ok (&;$) { + my ( $coderef, $description ) = @_; + my $exception = _try_as_caller( $coderef ); + my $ok = $Tester->ok( ! _is_exception( $exception ), $description ); + $Tester->diag( _exception_as_string( "died:", $exception ) ) unless $ok; + $@ = $exception; + return $ok; +} + + +=item B + +Run a test that may throw an exception. For example, instead of doing: + + my $file; + lives_ok { $file = read_file('answer.txt') } 'read_file worked'; + is $file, "42", 'answer was 42'; + +You can use lives_and() like this: + + lives_and { is read_file('answer.txt'), "42" } 'answer is 42'; + # or if you don't like prototypes + lives_and(sub {is read_file('answer.txt'), "42"}, 'answer is 42'); + +Which is the same as doing + + is read_file('answer.txt'), "42\n", 'answer is 42'; + +unless C dies, in which case you get the same kind of error as lives_ok() + + not ok 1 - answer is 42 + # Failed test (test.t at line 15) + # died: open failed (No such file or directory) + +A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any). + +The test description is optional, but recommended. + +=cut + +sub lives_and (&;$) { + my ( $test, $description ) = @_; + { + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $ok = \&Test::Builder::ok; + no warnings; + local *Test::Builder::ok = sub { + $_[2] = $description unless defined $_[2]; + $ok->(@_); + }; + use warnings; + eval { $test->() } and return 1; + }; + my $exception = $@; + if ( _is_exception( $exception ) ) { + $Tester->ok( 0, $description ); + $Tester->diag( _exception_as_string( "died:", $exception ) ); + }; + $@ = $exception; + return; +} + +=back + + +=head1 SKIPPING TEST::EXCEPTION TESTS + +Sometimes we want to use Test::Exception tests in a test suite, but don't want to force the user to have Test::Exception installed. One way to do this is to skip the tests if Test::Exception is absent. You can do this with code something like this: + + use strict; + use warnings; + use Test::More; + + BEGIN { + eval "use Test::Exception"; + plan skip_all => "Test::Exception needed" if $@; + } + + plan tests => 2; + # ... tests that need Test::Exception ... + +Note that we load Test::Exception in a C block ensuring that the subroutine prototypes are in place before the rest of the test script is compiled. + + +=head1 BUGS + +There are some edge cases in Perl's exception handling where Test::Exception will miss exceptions +thrown in DESTROY blocks. See the RT bug L for +details, along with the t/edge-cases.t in the distribution test suite. These will be addressed in +a future Test::Exception release. + +If you find any more bugs please let me know by e-mail, or report the problem with +L. + + +=head1 COMMUNITY + +=over 4 + +=item perl-qa + +If you are interested in testing using Perl I recommend you visit L and join the excellent perl-qa mailing list. See L for details on how to subscribe. + +=item perlmonks + +You can find users of Test::Exception, including the module author, on L. Feel free to ask questions on Test::Exception there. + +=item CPAN::Forum + +The CPAN Forum is a web forum for discussing Perl's CPAN modules. The Test::Exception forum can be found at L. + +=item AnnoCPAN + +AnnoCPAN is a web site that allows community annotations of Perl module documentation. The Test::Exception annotations can be found at L. + +=back + + +=head1 TO DO + +If you think this module should do something that it doesn't (or does something that it shouldn't) please let me know. + +You can see my current to do list at L, with an RSS feed of changes at L. + + +=head1 ACKNOWLEDGMENTS + +Thanks to chromatic and Michael G Schwern for the excellent Test::Builder, without which this module wouldn't be possible. + +Thanks to +Adam Kennedy, +Andy Lester, +Aristotle Pagaltzis, +Ben Prew, +Cees Hek, +Chris Dolan, +chromatic, +Curt Sampson, +David Cantrell, +David Golden, +David Tulloh, +David Wheeler, +J. K. O'Brien, +Janek Schleicher, +Jim Keenan, +Jos I. Boumans, +Joshua ben Jore, +Jost Krieger, +Mark Fowler, +Michael G Schwern, +Nadim Khemir, +Paul McCann, +Perrin Harkins, +Peter Rabbitson, +Peter Scott, +Ricardo Signes, +Rob Muhlestein, +Scott R. Godin, +Steve Purkis, +Steve, +Tim Bunce, +and various anonymous folk for comments, suggestions, bug reports and patches. + +=head1 AUTHOR + +Adrian Howard + +If you can spare the time, please drop me a line if you find this module useful. + + +=head1 SEE ALSO + +=over 4 + +=item L + +Delicious links on Test::Exception. + +=item L & L + +Modules to help test warnings. + +=item L + +Support module for building test libraries. + +=item L & L + +Basic utilities for writing tests. + +=item L + +Overview of some of the many testing modules available on CPAN. + +=item L + +Delicious links on perl testing. + +=back + + +=head1 LICENCE + +Copyright 2002-2007 Adrian Howard, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; diff --git a/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_0_test.xml b/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_0_test.xml new file mode 100644 index 0000000000..fa0e9c005d --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_0_test.xml @@ -0,0 +1,70 @@ + + + + + +/Users/bandre/projects/clm/build-namelist-unittests/models/lnd/clm/bld/configure + + +CLM Biogeochemistry mode + none = Satellite Phenology (SP) + cn = Carbon Nitrogen model (CN) + (or CLM45BGC if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + cndv = Carbon Nitrogen with Dynamic Global Vegetation Model (CNDV) + (or CLM45BGCDV if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + + +Root directory of CLM source distribution (directory above CLM configure). + + +Component framework interface to use +(Model Coupling Toolkit, or Earth System Modeling Framework) + + +User specified CPP defines to append to Makefile defaults. +Note: It's recommended to use configure options to set standard CPP values rather +than defining them here. + + +Toggle to turn on the prognostic crop model + + +Maximum number of plant function types (PFT) per gridcell +(Setting maxpft to anything other than 17 (or 25 for clm4_5 CROP or 21 for clm4_0 CROP) +is EXPERIMENTAL AND NOT SUPPORTED!) +(Either 17 for a standard vegetated case or +21 for prognostic clm4_0 CROP or 25 +for prognostic clm4_5 CROP) + + +Toggle to make wild-fires inactive for biogeochemistry=CN mode + + +Toggle to turn all history output completely OFF (possibly used for testing) + + +Specifies either clm4_0 or clm4_5 physics + + +Flag to turn on site specific special configuration flags for supported single +point resolutions. See the specific config_defaults_*.xml file for the special +settings that are set for a particular site. + + +Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing +(SNICAR_FRC .true.is EXPERIMENTAL NOT SUPPORTED!) + + +CLM 4.0 Only. For CLM 4.5, spinup is controlled from build-namelist. +Spinup mode for the CN Carbon Nitrogen BGC model + AD turn on accelerated decomposition spinup for CN biogeochemistry model + exit jump from AD spinup mode to normal mode + normal no acceleration of decompositon (i.e. "final spinup") + + +User source directories to prepend to the filepath. Multiple directories +are specified as a comma separated list with no embedded white space. +Normally this is SourceMods/src.clm in your case. + + + diff --git a/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_5_test.xml b/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_5_test.xml new file mode 100644 index 0000000000..9f19c3fb56 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/input/config_cache_clm4_5_test.xml @@ -0,0 +1,29 @@ + + + + + +/Users/bandre/projects/clm/build-namelist-unittests/models/lnd/clm/bld/configure -phys clm4_5 + + +Root directory of CLM source distribution (directory above CLM configure). + + +Component framework interface to use +(Model Coupling Toolkit, or Earth System Modeling Framework) + + +User specified CPP defines to append to Makefile defaults. +Note: It's recommended to use configure options to set standard CPP values rather +than defining them here. + + +Specifies either clm4_0 or clm4_5 physics + + +User source directories to prepend to the filepath. Multiple directories +are specified as a comma separated list with no embedded white space. +Normally this is SourceMods/src.clm in your case. + + + diff --git a/components/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml b/components/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml new file mode 100644 index 0000000000..974f15acab --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml @@ -0,0 +1,1481 @@ + + + + + + + + + + + +1800 + + +379.0 +379.0 +284.7 + + +constant + + +sp + + +off + + +1 +0 + + +.false. + + +NONE + + +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 +0.60,0.40 + + +ON_WASTEHEAT +ON + + +.false. + + +OFF + +.false. +.true. + + +.false. +.true. + +7300 + + + + +lnd/clm2/paramdata/clm_params.c130821.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45SP.0521-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45SP.2000-01-01.0.9x1.25_g1v6_simyr2000_c140111.nc + + + +lnd/clm2/initdata_map/clmi.I2000CLM45CRUBGC.2000-01-01.0.9x1.25_gx1v6_simyr2000_c140111.nc + + + + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.1.9x2.5_g1v6_simyr1850_c140111.nc + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.360x720cru_hcru_simyr1850_c140111.nc + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c140111.nc + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGC.0241-01-01.ne30np4_g1v6_simyr1850_c140111.nc + + + + + + + +lnd/clm2/initdata_map/clmi.I1850CRUCLM45BGCDV.0241-01-01.0.9x1.25_g1v6_simyr1850_c140111.nc + + + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.1.9x2.5_g1v6_simyr2000_c140111.nc + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c131028.nc + + + + +lnd/clm2/initdata_map/clmi.ICRUCLM45BGCCROPmp24Irrig.0241-01-01.10x15_USGS_simyr2000_c140111.nc + + + + +lnd/clm2/surfdata_map/surfdata_360x720cru_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr2000_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_4x5_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_10x15_simyr2000_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr2000_c130927.nc + + + + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_mp24_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_10x15_mp24_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_numaIA_mp24_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_smallvilleIA_mp24_simyr2000_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_5x5_amazon_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_brazil_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_tropicAtl_simyr2000_c130927.nc + + + +lnd/clm2/surfdata_map/surfdata_1x1_camdenNJ_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_vancouverCAN_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_mexicocityMEX_simyr2000_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1x1_urbanc_alpha_simyr2000_c130927.nc + + + +lnd/clm2/surfdata_map/surfdata_360x720cru_simyr1850_c130927.nc + +lnd/clm2/surfdata_map/surfdata_48x96_simyr1850_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr1850_c130927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_c130927.nc + +lnd/clm2/surfdata_map/surfdata_10x15_simyr1850_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_1x1_tropicAtl_simyr1850_c130927.nc + + +lnd/clm2/surfdata_map/surfdata_ne30np4_simyr1850_c130927.nc + + + + + +lnd/clm2/surfdata_map/surfdata.pftdyn_360x720cru_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_10x15_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp8.5_simyr1850-2100_c130524.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_1x1_tropicAtl_hist_simyr1850-2005_c130627.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp8.5_simyr1850-2100_c130524.nc + + + + +lnd/clm2/surfdata_map/surfdata.pftdyn_360x720cru_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_10x15_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp8.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp8.5_simyr1850-2100_c130524.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_360x720cru_rcp6.0_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp6.0_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp6.0_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_10x15_rcp6.0_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp6.0_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp6.0_simyr1850-2100_c130524.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_360x720cru_rcp4.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp4.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp4.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_10x15_rcp4.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp4.5_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp4.5_simyr1850-2100_c130524.nc + +lnd/clm2/surfdata_map/surfdata.pftdyn_360x720cru_rcp2.6_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_0.9x1.25_rcp2.6_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_1.9x2.5_rcp2.6_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_10x15_rcp2.6_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_48x96_rcp2.6_simyr1850-2100_c130524.nc +lnd/clm2/surfdata_map/surfdata.pftdyn_ne30np4_rcp2.6_simyr1850-2100_c130524.nc + + +glc/cism/griddata/glcmaskdata_48x96_gland_c141105.nc +glc/cism/griddata/glcmaskdata_0.9x1.25_gland_c141105.nc +glc/cism/griddata/glcmaskdata_1.9x2.5_gland_c141105.nc + + +lnd/clm2/griddata/topodata_0.9x1.25_USGS_070110.nc +lnd/clm2/griddata/topodata_1.9x2.5_USGS_061130.nc +lnd/clm2/griddata/topodata_48x96_USGS_070110.nc + + + +lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc +lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc + + +2000 +2000 + +1850 +1850 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +1850 +2000 + +1850 +2100 + +2000 +2100 + +lnd/clm2/ndepdata/fndep_clm_hist_simyr1849-2006_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp8.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp6.0_simyr1849-2106_1.9x2.5_c100810.nc +lnd/clm2/ndepdata/fndep_clm_rcp4.5_simyr1849-2106_1.9x2.5_c100428.nc +lnd/clm2/ndepdata/fndep_clm_rcp2.6_simyr1849-2106_1.9x2.5_c100428.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +0001 +0001 + +atm/datm7/NASA_LIS/clmforc.Li_2012_climo1995-2011.T62.lnfm_c130327.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +2000 +2000 + +1850 +1850 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +1850 +2010 + +1850 +2010 + +1850 +2010 + +lnd/clm2/firedata/clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +.true. +.false. + + + + + +20 + + + + + + + +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.1x0.1_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_AVHRR_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.5x0.5_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_10x10min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_3x3min_MODIS_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_IGBP-GSDP_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_ISRIC-WISE_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_5x5min_nomask_to_0.1x0.1_nomask_aave_da_c120406.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne120np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_4x5_nomask_to_0.1x0.1_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_1.9x2.5_nomask_to_0.1x0.1_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_ne240np4_nomask_to_0.1x0.1_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_0.9x1.25_GRDC_to_0.1x0.1_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_360x720_cruncep_to_0.1x0.1_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.1x0.1/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.1x0.1_nomask_aave_da_c130405.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_AVHRR_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.5x0.5_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_10x10min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_MODIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_USGS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_LandScan2004_to_1x1_asphaltjungleNJ_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_IGBP-GSDP_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_ISRIC-WISE_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_5x5min_nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_asphaltjungleNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_0.9x1.25_GRDC_to_1x1_asphaltjungleNJ_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_360x720_cruncep_to_1x1_asphaltjungleNJ_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_asphaltjungleNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_asphaltjungleNJ_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_AVHRR_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.5x0.5_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_10x10min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_MODIS_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_USGS_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_LandScan2004_to_1x1_brazil_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_IGBP-GSDP_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_ISRIC-WISE_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_5x5min_nomask_to_1x1_brazil_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_brazil_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_0.9x1.25_GRDC_to_1x1_brazil_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_360x720_cruncep_to_1x1_brazil_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_brazil/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_brazil_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_AVHRR_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.5x0.5_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_10x10min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_MODIS_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_USGS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_LandScan2004_to_1x1_camdenNJ_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_IGBP-GSDP_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_ISRIC-WISE_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_5x5min_nomask_to_1x1_camdenNJ_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_camdenNJ_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_0.9x1.25_GRDC_to_1x1_camdenNJ_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_360x720_cruncep_to_1x1_camdenNJ_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_camdenNJ/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_camdenNJ_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_AVHRR_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.5x0.5_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_10x10min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_MODIS_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_USGS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_LandScan2004_to_1x1_mexicocityMEX_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_IGBP-GSDP_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_ISRIC-WISE_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_5x5min_nomask_to_1x1_mexicocityMEX_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_mexicocityMEX_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_0.9x1.25_GRDC_to_1x1_mexicocityMEX_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_360x720_cruncep_to_1x1_mexicocityMEX_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_mexicocityMEX/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_mexicocityMEX_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_AVHRR_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.5x0.5_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_10x10min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_MODIS_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_USGS_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_LandScan2004_to_1x1_numaIA_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_IGBP-GSDP_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_ISRIC-WISE_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_5x5min_nomask_to_1x1_numaIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_numaIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_0.9x1.25_GRDC_to_1x1_numaIA_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_360x720_cruncep_to_1x1_numaIA_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_numaIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_numaIA_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_AVHRR_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.5x0.5_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_10x10min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_MODIS_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_USGS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_LandScan2004_to_1x1_smallvilleIA_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_IGBP-GSDP_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_ISRIC-WISE_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_5x5min_nomask_to_1x1_smallvilleIA_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_smallvilleIA_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_0.9x1.25_GRDC_to_1x1_smallvilleIA_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_360x720_cruncep_to_1x1_smallvilleIA_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_smallvilleIA/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_smallvilleIA_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_AVHRR_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.5x0.5_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_10x10min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_MODIS_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_USGS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_LandScan2004_to_1x1_tropicAtl_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_IGBP-GSDP_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_ISRIC-WISE_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_5x5min_nomask_to_1x1_tropicAtl_nomask_aave_da_c120718.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_tropicAtl_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_0.9x1.25_GRDC_to_1x1_tropicAtl_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_360x720_cruncep_to_1x1_tropicAtl_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_tropicAtl/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_tropicAtl_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_AVHRR_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.5x0.5_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_10x10min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_MODIS_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_USGS_to_1x1_urbanc_alpha_nomask_aave_da_c120928.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_LandScan2004_to_1x1_urbanc_alpha_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_IGBP-GSDP_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_ISRIC-WISE_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_5x5min_nomask_to_1x1_urbanc_alpha_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_urbanc_alpha_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_0.9x1.25_GRDC_to_1x1_urbanc_alpha_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_360x720_cruncep_to_1x1_urbanc_alpha_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_urbanc_alpha/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_urbanc_alpha_nomask_aave_da_c130403.nc + + + + + +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_AVHRR_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.5x0.5_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_10x10min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_MODIS_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_USGS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_LandScan2004_to_1x1_vancouverCAN_nomask_aave_da_c121114.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_IGBP-GSDP_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_ISRIC-WISE_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_5x5min_nomask_to_1x1_vancouverCAN_nomask_aave_da_c120717.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_3x3min_GLOBE-Gardner-mergeGIS_to_1x1_vancouverCAN_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_0.9x1.25_GRDC_to_1x1_vancouverCAN_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_360x720_cruncep_to_1x1_vancouverCAN_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1x1_vancouverCAN/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1x1_vancouverCAN_nomask_aave_da_c130403.nc + + + +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_landuse_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.5x0.5_lanwat_to_0.9x1.25_aave_da_110307.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_10minx10min_topo_to_0.9x1.25_aave_da_110630.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_soitex_to_0.9x1.25_aave_da_110722.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5minx5min_irrig_to_0.9x1.25_aave_da_110529.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_5x5min_ISRIC-WISE_to_0.9x1.25_nomask_aave_da_c120525.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_MODIS_to_0.9x1.25_nomask_aave_da_c120523.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_USGS_to_0.9x1.25_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_LandScan2004_to_0.9x1.25_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner_to_0.9x1.25_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.9x1.25_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_0.9x1.25_GRDC_to_0.9x1.25_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_360x720_cruncep_to_0.9x1.25_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.9x1.25/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.9x1.25_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_landuse_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.5x0.5_lanwat_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_10minx10min_topo_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5minx5min_soitex_to_1.9x2.5_aave_da_110307.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_nomask_to_1.9x2.5_nomask_aave_da_c120606.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_5x5min_ISRIC-WISE_to_1.9x2.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_MODIS_to_1.9x2.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_USGS_to_1.9x2.5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_LandScan2004_to_1.9x2.5_nomask_aave_da_c120522.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner_to_1.9x2.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_1.9x2.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_0.9x1.25_GRDC_to_1.9x2.5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_360x720_cruncep_to_1.9x2.5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/1.9x2.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_1.9x2.5_nomask_aave_da_c130405.nc + + +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_nomask_to_10x15_nomask_aave_da_c120327.nc +lnd/clm2/mappingdata/maps/10x15/map_5x5min_ISRIC-WISE_to_10x15_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS_to_10x15_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_USGS_to_10x15_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_LandScan2004_to_10x15_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner-mergeGIS_to_10x15_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/10x15/map_0.9x1.25_GRDC_to_10x15_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/10x15/map_360x720_cruncep_to_10x15_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/10x15/map_1km-merge-10min_HYDRO1K-merge-nomask_to_10x15_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_0.5x0.5_AVHRR_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_10x10min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_IGBP-GSDP_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_nomask_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_5x5min_ISRIC-WISE_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_MODIS_to_360x720_nomask_aave_da_c120830.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_USGS_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_LandScan2004_to_360x720_nomask_aave_da_c121017.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_3x3min_GLOBE-Gardner-mergeGIS_to_360x720_nomask_aave_da_c121128.nc +lnd/clm2/mappingdata/maps/360x720/map_0.9x1.25_GRDC_to_360x720_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/360x720/map_360x720_cruncep_to_360x720_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/360x720/map_1km-merge-10min_HYDRO1K-merge-nomask_to_360x720_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_MODIS_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.5x0.5_AVHRR_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_10x10min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_IGBP-GSDP_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_nomask_to_512x1024_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/512x1024/map_5x5min_ISRIC-WISE_to_512x1024_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_MODIS_to_512x1024_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_USGS_to_512x1024_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_LandScan2004_to_512x1024_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner_to_512x1024_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/512x1024/map_3x3min_GLOBE-Gardner-mergeGIS_to_512x1024_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/512x1024/map_0.9x1.25_GRDC_to_512x1024_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/512x1024/map_360x720_cruncep_to_512x1024_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/512x1024/map_1km-merge-10min_HYDRO1K-merge-nomask_to_512x1024_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_MODIS_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_0.5x0.5_AVHRR_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_10x10min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_IGBP-GSDP_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_nomask_to_128x256_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/128x256/map_5x5min_ISRIC-WISE_to_128x256_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_MODIS_to_128x256_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_USGS_to_128x256_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_LandScan2004_to_128x256_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner_to_128x256_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/128x256/map_3x3min_GLOBE-Gardner-mergeGIS_to_128x256_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/128x256/map_0.9x1.25_GRDC_to_128x256_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/128x256/map_360x720_cruncep_to_128x256_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/128x256/map_1km-merge-10min_HYDRO1K-merge-nomask_to_128x256_nomask_aave_da_c130403.nc + + +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_MODIS_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_0.5x0.5_AVHRR_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_10x10min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_IGBP-GSDP_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_nomask_to_64x128_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/64x128/map_5x5min_ISRIC-WISE_to_64x128_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_MODIS_to_64x128_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_USGS_to_64x128_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_LandScan2004_to_64x128_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner_to_64x128_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/64x128/map_3x3min_GLOBE-Gardner-mergeGIS_to_64x128_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/64x128/map_0.9x1.25_GRDC_to_64x128_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/64x128/map_360x720_cruncep_to_64x128_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/64x128/map_1km-merge-10min_HYDRO1K-merge-nomask_to_64x128_nomask_aave_da_c130403.nc + +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_MODIS_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_0.5x0.5_AVHRR_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_10x10min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_IGBP-GSDP_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_nomask_to_48x96_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/48x96/map_5x5min_ISRIC-WISE_to_48x96_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_MODIS_to_48x96_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_USGS_to_48x96_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_LandScan2004_to_48x96_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner_to_48x96_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/48x96/map_3x3min_GLOBE-Gardner-mergeGIS_to_48x96_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/48x96/map_0.9x1.25_GRDC_to_48x96_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/48x96/map_360x720_cruncep_to_48x96_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/48x96/map_1km-merge-10min_HYDRO1K-merge-nomask_to_48x96_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_MODIS_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_0.5x0.5_AVHRR_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_10x10min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_IGBP-GSDP_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_nomask_to_32x64_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/32x64/map_5x5min_ISRIC-WISE_to_32x64_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_MODIS_to_32x64_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_USGS_to_32x64_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_LandScan2004_to_32x64_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner_to_32x64_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/32x64/map_3x3min_GLOBE-Gardner-mergeGIS_to_32x64_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/32x64/map_0.9x1.25_GRDC_to_32x64_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/32x64/map_360x720_cruncep_to_32x64_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/32x64/map_1km-merge-10min_HYDRO1K-merge-nomask_to_32x64_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_MODIS_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_0.5x0.5_AVHRR_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_10x10min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_IGBP-GSDP_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_nomask_to_8x16_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/8x16/map_5x5min_ISRIC-WISE_to_8x16_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_MODIS_to_8x16_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_USGS_to_8x16_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_LandScan2004_to_8x16_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner_to_8x16_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/8x16/map_3x3min_GLOBE-Gardner-mergeGIS_to_8x16_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/8x16/map_0.9x1.25_GRDC_to_8x16_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/8x16/map_360x720_cruncep_to_8x16_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/8x16/map_1km-merge-10min_HYDRO1K-merge-nomask_to_8x16_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_MODIS_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_0.5x0.5_AVHRR_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_10x10min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_IGBP-GSDP_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_nomask_to_4x5_nomask_aave_da_c110822.nc +lnd/clm2/mappingdata/maps/4x5/map_5x5min_ISRIC-WISE_to_4x5_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_MODIS_to_4x5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_USGS_to_4x5_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_LandScan2004_to_4x5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner_to_4x5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/4x5/map_3x3min_GLOBE-Gardner-mergeGIS_to_4x5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/4x5/map_0.9x1.25_GRDC_to_4x5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/4x5/map_360x720_cruncep_to_4x5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/4x5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_4x5_nomask_aave_da_c130411.nc + +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_MODIS_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.5x0.5_AVHRR_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_10x10min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_IGBP-GSDP_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_nomask_to_0.23x0.31_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_5x5min_ISRIC-WISE_to_0.23x0.31_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_MODIS_to_0.23x0.31_nomask_aave_da_c110930.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_USGS_to_0.23x0.31_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner_to_0.23x0.31_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.23x0.31_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_3x3min_LandScan2004_to_0.23x0.31_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_0.9x1.25_GRDC_to_0.23x0.31_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_360x720_cruncep_to_0.23x0.31_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.23x0.31/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.23x0.31_nomask_aave_da_c130405.nc + + +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_MODIS_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.5x0.5_AVHRR_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_10x10min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_IGBP-GSDP_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_nomask_to_2.5x3.33_nomask_aave_da_c110823.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_5x5min_ISRIC-WISE_to_2.5x3.33_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_MODIS_to_2.5x3.33_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_USGS_to_2.5x3.33_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_LandScan2004_to_2.5x3.33_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner_to_2.5x3.33_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_3x3min_GLOBE-Gardner-mergeGIS_to_2.5x3.33_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_0.9x1.25_GRDC_to_2.5x3.33_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_360x720_cruncep_to_2.5x3.33_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/2.5x3.33/map_1km-merge-10min_HYDRO1K-merge-nomask_to_2.5x3.33_nomask_aave_da_c130405.nc + + + + +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_AVHRR_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_MODIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.5x0.5_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_IGBPmergeICESatGIS_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_10x10min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_IGBP-GSDP_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_nomask_to_0.5x0.5_nomask_aave_da_c111021.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_MODIS_to_0.5x0.5_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_5x5min_ISRIC-WISE_to_0.5x0.5_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_LandScan2004_to_0.5x0.5_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3min_GLOBE-Gardner-mergeGIS_to_0.5x0.5_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.1x0.1_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_4x5_nomask_to_0.5x0.5_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120709.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_ne120np4_nomask_to_0.5x0.5_nomask_aave_da_c120711.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_3x3_USGS_nomask_to_0.5x0.5_nomask_aave_da_c120912.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_0.9x1.25_GRDC_to_0.5x0.5_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_360x720_cruncep_to_0.5x0.5_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/0.5x0.5/map_1km-merge-10min_HYDRO1K-merge-nomask_to_0.5x0.5_nomask_aave_da_c130405.nc + + + +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_MODIS_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.5x0.5_AVHRR_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_10x10min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_IGBP-GSDP_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_nomask_to_ne4np4_nomask_aave_da_c110923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_5x5min_ISRIC-WISE_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_MODIS_to_ne4np4_nomask_aave_da_c120906.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_USGS_to_ne4np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner_to_ne4np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne4np4_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/ne4np4/map_3x3min_LandScan2004_to_ne4np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne4np4/map_0.9x1.25_GRDC_to_ne4np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne4np4/map_360x720_cruncep_to_ne4np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne4np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne4np4_nomask_aave_da_c130411.nc +lnd/clm2/mappingdata/maps/ne4np4/map_ne4np4_nomask_to_0.5x0.5_nomask_aave_da_c110923.nc + + +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_MODIS_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.5x0.5_AVHRR_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_10x10min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_IGBP-GSDP_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_nomask_to_ne16np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne16np4/map_5x5min_ISRIC-WISE_to_ne16np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_MODIS_to_ne16np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_USGS_to_ne16np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_LandScan2004_to_ne16np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne16np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne16np4/map_0.9x1.25_GRDC_to_ne16np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne16np4/map_360x720_cruncep_to_ne16np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne16np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne16np4_nomask_aave_da_c130408.nc +lnd/clm2/mappingdata/maps/ne16np4/map_ne16np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_landuse_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.5x0.5_lanwat_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_10minx10min_topo_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_soitex_to_ne30np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5minx5min_irrig_to_ne30np4_aave_da_110720.nc +lnd/clm2/mappingdata/maps/ne30np4/map_5x5min_ISRIC-WISE_to_ne30np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_MODIS_to_ne30np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_USGS_to_ne30np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_LandScan2004_to_ne30np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner_to_ne30np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne30np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne30np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne30np4/map_0.9x1.25_GRDC_to_ne30np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne30np4/map_360x720_cruncep_to_ne30np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne30np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne30np4_nomask_aave_da_c130405.nc + +lnd/clm2/mappingdata/maps/ne30np4/map_ne30np4_to_0.5x0.5rtm_aave_da_110320.nc + +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_MODIS_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.5x0.5_AVHRR_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_10x10min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_IGBP-GSDP_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_nomask_to_ne60np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne60np4/map_5x5min_ISRIC-WISE_to_ne60np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_MODIS_to_ne60np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_USGS_to_ne60np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_LandScan2004_to_ne60np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne60np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne60np4/map_0.9x1.25_GRDC_to_ne60np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne60np4/map_360x720_cruncep_to_ne60np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne60np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne60np4_nomask_aave_da_c130405.nc +lnd/clm2/mappingdata/maps/ne60np4/map_ne60np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_landuse_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.5x0.5_lanwat_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_10minx10min_topo_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_soitex_to_ne120np4_aave_da_110320.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5minx5min_irrig_to_ne120np4_aave_da_110817.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_LandScan2004_to_ne120np4_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne120np4_nomask_aave_da_c120924.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_MODIS_to_ne120np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc +lnd/clm2/mappingdata/maps/ne120np4/map_5x5min_ISRIC-WISE_to_ne120np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne120np4/map_0.9x1.25_GRDC_to_ne120np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne120np4/map_360x720_cruncep_to_ne120np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne120np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne120np4_nomask_aave_da_c130405.nc + + + + +lnd/clm2/mappingdata/maps/ne120np4/map_0.1x0.1_nomask_to_ne120np4_nomask_aave_da_c120706.nc +lnd/clm2/mappingdata/maps/ne120np4/map_3x3min_USGS_to_ne120np4_nomask_aave_da_c120913.nc + + + +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_MODIS_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.5x0.5_AVHRR_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_10x10min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_IGBP-GSDP_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_nomask_to_5x5_amazon_nomask_aave_da_c110920.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_5x5min_ISRIC-WISE_to_5x5_amazon_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_MODIS_to_5x5_amazon_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_USGS_to_5x5_amazon_nomask_aave_da_c120927.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_LandScan2004_to_5x5_amazon_nomask_aave_da_c120518.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner_to_5x5_amazon_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_3x3min_GLOBE-Gardner-mergeGIS_to_5x5_amazon_nomask_aave_da_c120923.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_0.9x1.25_GRDC_to_5x5_amazon_nomask_aave_da_c130309.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_360x720_cruncep_to_5x5_amazon_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/5x5_amazon/map_1km-merge-10min_HYDRO1K-merge-nomask_to_5x5_amazon_nomask_aave_da_c130403.nc + +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_MODIS_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.5x0.5_AVHRR_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_10x10min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_IGBP-GSDP_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_nomask_to_ne240np4_nomask_aave_da_c110922.nc +lnd/clm2/mappingdata/maps/ne240np4/map_5x5min_ISRIC-WISE_to_ne240np4_nomask_aave_da_c111115.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_MODIS_to_ne240np4_nomask_aave_da_c111111.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_USGS_to_ne240np4_nomask_aave_da_c120926.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_LandScan2004_to_ne240np4_nomask_aave_da_c120521.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_3x3min_GLOBE-Gardner-mergeGIS_to_ne240np4_nomask_aave_da_c120925.nc +lnd/clm2/mappingdata/maps/ne240np4/map_0.9x1.25_GRDC_to_ne240np4_nomask_aave_da_c130308.nc +lnd/clm2/mappingdata/maps/ne240np4/map_360x720_cruncep_to_ne240np4_nomask_aave_da_c130326.nc +lnd/clm2/mappingdata/maps/ne240np4/map_1km-merge-10min_HYDRO1K-merge-nomask_to_ne240np4_nomask_aave_da_c130405.nc +lnd/clm2/mappingdata/maps/ne240np4/map_ne240np4_nomask_to_0.5x0.5_nomask_aave_da_c110922.nc + + + + + +. +. + + + + + +.true. + +.true. + + diff --git a/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml b/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml new file mode 100644 index 0000000000..2ff6609c7e --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml @@ -0,0 +1,1385 @@ + + + + + + + + + + + +If non-blank, then interpinic will be called to interpolate finidat_interp_source and +create output file specified by finidat_interp_dest. +For this to be used finidat MUST BE blank. + + + +If finidat_interp_source is set to non-blank, then interpinic will be called +to interpolate finidat_interp_source and create output file finidat_interp_dest. + + + +Full pathname of initial conditions file. If blank CLM will startup from +arbitrary initial conditions. + + + +Full pathname of master restart file for a branch run. (only used if RUN_TYPE=branch) +(Set with RUN_REFCASE and RUN_REFDATE) + + + +Full pathname of land fraction data file. + + + +Clumps per processor. + + + +Atmospheric CO2 molar ratio (by volume) only used when co2_type==constant (umol/mol) +(Set by CCSM_CO2_PPMV) + + + +Type of CO2 feedback. + constant = use the input co2_ppmv value + prognostic = use the prognostic value sent from the atmosphere + diagnostic = use the diagnostic value sent from the atmosphere + + + + +Supplemental Nitrogen mode and for what type of vegetation it's turned on for. +In this mode Nitrogen is unlimited rather than prognosed and in general vegetation is +over-productive. + NONE = No vegetation types get supplemental Nitrogen + ALL = Supplemental Nitrogen is active for all vegetation types + + + +If TRUE, separate the vegetated landunit into a crop landunit and a natural vegetation landunit + + + +If TRUE, make ALL pfts, columns and landunits active, even those with 0 weight. +This means that computations will be run even over these 0-weight points. + +THIS IS ONLY FOR TESTING PURPOSES - IT HAS NOT BEEN CHECKED FOR SCIENTIFIC VALIDITY. + + + +If TRUE, run with an increased number of soil layers +Interpolate the soil layers on the surface dataset to the soil layers specified in iniTimeConst +(EXPERIMENTAL) + + + +If TRUE, irrigation will be active. + + + +Number of multiple elevation classes over glacier points. +Normally this is ONLY used when running CESM with the active glacier model. + + + +If TRUE, calculate surface mass balance for glacier multi-elevation class points. +If false use growing degree day information for glaciers multi-elevation class points. +Only works when glc_nec is greater than 0. +(Only tested with glc_smb=.true., setting it to .false. is NOT tested) + + + +If TRUE, dynamically change areas and topographic heights over glacier points. +Only works when glc_nec is greater than zero, and when coupled to CISM. +Generally should agree with glc_dyn_runoff_routing. + + + +If TRUE, handle snow capping and runoff appropriately for dynamic glacier areas. +Only works when glc_nec is greater than zero. +Generally should agree with glc_do_dynglacier. + + + +Number of days before one considers the perennially snow-covered point 'land ice' +(and thus capable of generating a positive surface mass balance for CISM). +Default: 7300 (20 years) + + + +Visible and Near-infrared albedo's for glacier ice + + + +Time step (seconds) + + + +Override the start type from the driver: it can only be +set to 3 meaning branch. + + + +Full pathname of land-ice mask data file (on lnd grid). + + + +Full pathname of topography data file. Only required when +land-ice model is active. + + + +If TRUE, downscale precipitation division into rain vs. snow over glc_mec landunits. +WARNING: THIS BREAKS ENERGY CONSERVATION, SO SHOULD NOT BE USED IN COUPLED SIMULATIONS +Default: .false. + + + +If TRUE, downscale longwave radiation over glc_mec landunits. +This downscaling is conservative. +Default: .true. + + + +Toggle to turn on the ED +(ED = 'on' is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn on spit fire (only relevant if ED is being used). + + + +Full pathname datafile with plant function type (PFT) constants combined with +constants for biogeochem modules + + + +Full pathname of surface data file. + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name + + + +SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name + + + +Per file averaging flag. + 'A' (average over history period) + 'I' (instantaneous) + 'X' (maximum over history period) + 'M' (minimum over history period) + + + +Averaging type of output for 1D vector output (when hist_dov2xy is false). + GRID means average all land-units up to the grid-point level + LAND means average all columns up to the land-unit level + COLS means average all PFT's up to the column level + PFTS means report everything on native PFT level + + + +If TRUE, implies output data on a 2D latitude/longitude grid. False means +output in 1D vector format. One setting per history tape series. + + + +If TRUE, indicates do NOT output any default history fields (requires you to use +hist_fincl* to set the exact output fields to use).. + + + +Fields to exclude from history tape series 1. + + + +Fields to exclude from history tape series 2. + + + +Fields to exclude from history tape series 3. + + + +Fields to exclude from history tape series 4. + + + +Fields to exclude from history tape series 5. + + + +Fields to exclude from history tape series 6. + + + +Fields to add to history tape series 1. + + + +Fields to add to history tape series 2. + + + +Fields to add to history tape series 3. + + + +Fields to add to history tape series 4. + + + +Fields to add to history tape series 5. + + + +Fields to add to history tape series 6. + + + +Per tape series maximum number of time samples. + + + +Per tape series history file density (i.e. output precision) + 1=double precision + 2=single precision +Default: 2,2,2,2,2,2 + + + +Per tape series history write frequency. + positive means in time steps + 0=monthly + negative means hours +(i.e. 5 means every 24 time-steps and -24 means every day +Default: 0,-24,-24,-24,-24,-24 + + + +number of segments per clump for decomposition +Default: 20 + + + +Perturbation limit when doing error growth test + + + +If FALSE, don't write any restart files. + + + +Turn urban air conditioning/heating ON or OFF and add wasteheat: + OFF = Air conditioning/heating is OFF in buildings, internal temperature allowed to float freely + ON = Air conditioning/heating is ON in buildings, internal temperature constrained + ON_WASTEHEAT = Air conditioning/heating is ON and waste-heat sent to urban canyon + + + +If TRUE, urban traffic flux will be activated (Currently NOT implemented). + + + +If TRUE, write diagnostic of global radiative temperature written to CLM log file. + + + +Subgrid fluxes for snow + + + + + + +Toggle to make wild-fires inactive for biogeochemistry=CN mode + + + +Turn on methane model. Standard part of CLM45BGC model. + + + +CLM Biogeochemistry mode : Carbon Nitrogen model (CN) +(or CLM45BGC if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + + + +CLM Biogeochemistry mode : Carbon Nitrogen with Dynamic Global Vegetation Model (CNDV) +(or CLM45BGCDV if phys=clm4_5, vsoilc_centbgc='on', and clm4me='on') + + + +Nitrification/denitrification splits the prognostic mineral N pool into two + mineral N pools: NO3 and NH4, and includes the transformations between them. +Requires the CN model to work (either CN or CNDV). + + + +Turn on vertical soil carbon. +Requires the CN model to work (either CN or CNDV). + + + +Use parameters for decomposition from the CENTURY Carbon model +Requires the CN model to work (either CN or CNDV). + + + +Toggle to use 25 lake layers instead of 10 +(extralaklayers=".true." is EXPERIMENTAL NOT SUPPORTED! Nor is it Tested!) + + + +Toggle to turn on the VIC hydrologic parameterizations +(vichydro=".true." is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn on the prognostic crop model + + + +Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing +(snicar_frc=".true." is EXPERIMENTAL NOT SUPPORTED!) + + + +Toggle to turn all history output completely OFF (possibly used for testing) + + + +Toggle for vancouver specific logic. + + + +Toggle for mexico city specific logic. + + + +Max number of plant functional types in naturally vegetated landunit. + + + + + + + +SCRIP format grid data file + + + +Flag to pass to the ESMF mapping utility, telling it what kind of large +file support is needed for an output file generated with this grid as +either the source or destination ('none', '64bit_offset' or 'netcdf4'). + + + +Flag to pass to the ESMF mapping utility, telling it what kind of grid +file this is (SCRIP or UGRID). + + + +For UGRID files, flag to pass to the ESMF mapping utility, telling it the +name of the dummy variable that has all of the topology information stored +in its attributes. (Only used if scripgriddata_src_type = UGRID.) + + + + + + +Filename for mksurfdata_map to remap raw data into the output surface dataset + + + +Plant Function Type dataset for mksurfdata + + + +Dataset for percent glacier land-unit for mksurfdata + + + +Dataset for topography used to define urban threshold + + + +Dataset for land topography + + + +Leaf Area Index dataset for mksurfdata + + + +Soil texture dataset for mksurfdata + + + +Soil color dataset for mksurfdata + + + +Soil max fraction dataset for mksurfdata + + + +High resolution land mask/fraction dataset for mksurfdata +(used for glacier_mec land-units) + + + +Type of grid to create for mksurfdata + + + +Grid file at the output resolution for mksurfdata + + + +Text file with filepaths (or list of XML elements) for vegetation fractions +and harvesting for each year to run over for mksurfdata to be able to model +transient land-use change + + + +High resolution topography dataset for mksurfdata +(used for glacier_mec land-units) + + + +Irrigation dataset for mksurfdata + + + +Organic soil dataset for mksurfdata + + + +Lake water dataset for mksurfdata + + + +Wetland dataset for mksurfdata + + + +Urban dataset for mksurfdata + + + +Biogenic Volatile Organic Compounds (VOC) emissions dataset for mksurfdata + + + +GDP dataset for mksurfdata + + + +Peat dataset for mksurfdata + + + +Agricultural burning dominant month dataset for mksurfdata + + + +Topography statistics dataset for mksurfdata + + + +VIC parameters dataset for mksurfdata + + + +Inversion-derived CH4 parameters dataset for mksurfdata + + + +If TRUE, output variables in double precision for mksurfdata + + + +If TRUE, ignore other files, and set the output percentage to 100% urban and +zero for other land-use types. + + + +If TRUE, set wetland to 0% over land (renormalizing other landcover types as needed); +wetland will only be used for ocean points. + + + +Number of Plant Functional Types (excluding bare-soil) + + + +Plant Function Type index to override global file with for mksurfdata + + + +Plant Function Type fraction to override global file with for mksurfdata + + + +Soil color index to override global file with for mksurfdata + + + +Soil maximum fraction to override global file with for mksurfdata + + + +Soil percent sand to override global file with for mksurfdata + + + +Soil percent clay to override global file with for mksurfdata + + + + + + + +Orography file with surface heights and land area fraction + + + +CLM grid file + + + +CESM domain file + + + +CAM file + + + +Raw topography file + + + +CAM topography file + + + +Number of longitudes to use for a regional grid (for single-point set to 1) + + + +Number of latitudes to use for a regional grid (for single-point set to 1) + + + +Northern edge of the regional grid + + + +Southern edge of the regional grid + + + +Eastern edge of the regional grid + + + +Western edge of the regional grid + + + + + + + +Historical greenhouse gas concentrations from CAM, only used +by getco2_historical.ncl + + + + + + +Aerosol deposition file name (only used for aerdepregrid.ncl) + + + +Full pathname of CLM fraction dataset (only used for mkdatadomain). + + + +Full pathname of CLM grid dataset (only used for mkdatadomain). + + + +Full pathname of output domain dataset (only used for mkdatadomain). + + + +Type of domain file to create (ocean or atmosphere) (only used for mkdatadomain) + + + + + + + +First year to loop over for Nitrogen Deposition data + + + +Last year to loop over for Nitrogen Deposition data + + + +Simulation year that aligns with stream_year_first_ndep value + + + +Filename of input stream data for Nitrogen Deposition + + + +Mapping method from Nitrogen deposition input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + + +First year to loop over for Lightning data + + + +Last year to loop over for Lightning data + + + +Simulation year that aligns with stream_year_first_lightng value + + + +Filename of input stream data for Lightning + + + +Mapping method from Lightning input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + + + +First year to loop over for human population density data + + + +Last year to loop over for human population density data + + + +Simulation year that aligns with stream_year_first_popdens value + + + +Filename of input stream data for human population density + + + +Mapping method from human population density input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + +datm input directory + + +datm output directory + + +Datm logfile name + + + + + + + +Mapping file to go from one resolution/land-mask to another resolution/land-mask + + + +Land mask description for mksurfdata input files + + + +Horizontal grid resolutions for mksurfdata input files + + + + + + + + +Check that the resolution and land-mask is valid before continuing. + + + +Add a note to the output namelist about the options given to build-namelist + + + +CLM run type. + 'default' use the default type of clm_start type for this configuration + 'cold' is a run from arbitrary initial conditions + 'arb_ic' is a run using initial conditions if provided, OR arbitrary initial conditions if no files can be found + 'startup' is an initial run with initial conditions provided. + 'continue' is a restart run. + 'branch' is a restart run in which properties of the output history files may be changed. + + + +Horizontal resolutions +Note: 0.1x0.1, 0.5x0.5, 5x5min, 10x10min, 3x3min and 0.33x0.33 are only used for CLM tools + + + +Representative concentration pathway for future scenarios [radiative forcing at peak or 2100 in W/m^2] +-999.9 means do NOT use a future scenario, just use historical data. + + + +Land mask description + + + +If TRUE, irrigation will be active (find surface datasets with active irrigation). + + + +Year to simulate and to provide datasets for (such as surface datasets, initial conditions, aerosol-deposition, Nitrogen deposition rates etc.) +A sim_year of 1000 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year greater than 2005 corresponds to rcp scenario data +Most years are only used for clm_tools and there aren't CLM datasets that correspond to them. +CLM datasets exist for years: 1000 (for testing), 1850, and 2000 + + + +Range of years to simulate transitory datasets for (such as dynamic: land-use datasets, aerosol-deposition, Nitrogen deposition rates etc.) +Constant means simulation will be held at a constant year given in sim_year. +A sim_year_range of 1000-1002 or 1000-1004 corresponds to data used for testing only, NOT corresponding to any real datasets. +A sim_year_range that goes beyond 2005 corresponds to historical data until 2005 and then scenario data beyond that point. + + + +Namelist entries to demand be provided on the namelist. + + + +Description of the use case selected. + + + +Command line arguement for turning on CN spinup mode. + + + +Command line arguement for biogeochemistry mode for CLM4.5 + sp = Satellitte Phenology + cn = Carbon Nitrogen model + bgc = CLM4.5 BGC model with: + CENTURY model pools + Nitrification/De-nitrification + Methane model + Vertically resolved Carbon + + + + + + + +Where dry deposition is calculated (from land, atmosphere, or from a table) + + + + +List of chemical constituents that dry deposition will be calculated for + + + + + + + +Flag for overriding the crash that should occur if user tries to start the model from a restart file made with a different version of the soil decomposition structure than is currently being used. + + + +Flag for setting the state of the Accelerated decomposition spinup state for the model. + 0 = normal model behavior; + 1 = AD spinup. +Entering and exiting spinup mode occurs automatically by comparing the namelist and restart file values for this variable. + + + + +Base advective flux (downwards) for SOM. + + + +Maximum depth to mix soils to by croturbation, in permafrost soils. + + + + +E-folding depth over which decomposition is slowed with depth in all soils. + + + +If TRUE, reduce heterotrophic respiration according to available oxygen predicted by CH4 submodel. + + + +If TRUE, weight calculation of oxygen limitation by the inundated fraction and diagnostic saturated column gas +concentration profile calculated in the CH4 submodel. Only applies if anoxia = TRUE. +(EXPERIMENTAL AND NOT FUNCTIONAL!) +(deprecated -- will be removed) + + + +separate q10 for frozen soil respiration rates. default to same as above zero rates + + + + + +If TRUE, rooting profile depends on specific PFT + + + +If true, use a single exponential function to define the profile for distributing C and N from belowground components (following Jackson et al., 1999). If False, use the default CLM rootfrac double exponential for distributing C and N from belowground components. +(EXPERIMENTAL and NOT tested) + + + +If pftspecific_rootingprofile is set to false, this sets a single exponential profile over which to distribute C and N coming from root pools (leaves, stem, grain). + + + +If TRUE, add extra diagnostics for methane model to the history files + + + +Profile over which to distribute C and N coming from surface pools (leaves, stem, grain). + + + + +If true, no denitrification or nitrification in frozen soil layers. +(EXPERIMENTAL and NOT tested) + + + +Number of days over which to use exponential relaxation of NPP in N fixation calculation + + + + +Enable C13 model + + + +Enable C14 model + + + +Flag to use the atmospheric time series of C14 concentrations from bomb fallout, rather than natural abundance C14 (nominally set as 10^-12 mol C14 / mol C) +(EXPERIMENTAL and NOT tested) + + + +Filename with time series of atmospheric Delta C14 data. variables in file are "time" and "atm_delta_c14". time variable is in format 1950.0, and time values must be monotonically increasing for interpolation, however spacing can be unequal. atm_delta_c14 variable has units of permil. +(EXPERIMENTAL and NOT tested) + + + + + + +If TRUE, weight btran (vegetation soil moisture availability) by unfrozen layers only, assuming that vegetation +will allocate roots preferentially to the active layer. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, weight btran (vegetation soil moisture availability) by the active layer, as defined by the greatest thaw depth over the current and prior years. +(EXPERIMENTAL and NOT tested) + + + + + + + + +Minimum lake depth to increase non-molecular thermal diffusivities by the factor deepmixing_mixfact. + + + +Factor to increase non-molecular thermal diffusivities for lakes deeper than deepmixing_depthcrit +to account for unresolved 3D processes. +Set to 1 to + + + +Visible and Near-infrared albedo values for melting lakes. Albedo will relax to these values as temperature +reaches melting when ice is present with no snow layers. Represents puddling, ice disintegration, and white ice. +Set to alblak values (0.6, 0.4) to keep albedo constant for ice-covered lakes without snow layers. + + + + + + + +Use old snow cover fraction from Niu et al. 2007 +(deprecated -- will be removed) + + + +If surface water is active or not +(deprecated -- will be removed) + + + +Use original CLM4 soil hydraulic properties +(deprecated -- will be removed) + + + + + + + +Allows user to tune the value of aereoxid. If set to FALSE, then use the value of aereoxid from +the parameter file (set to 0.0, but may be tuned with values in the range {0.0,1.0}. If set to TRUE, +then don't fix aere (see ch4Mod.F90). +Default: .true. + + + +If TRUE, turn on methane biogeochemistry model for lake columns, using a simplified version of the CH4 submodel. +(EXPERIMENTAL) + + + +If TRUE, apply a limitation to methane production based on the soil pH dataset. + + + +Michaelis-Mentin maximum methane oxidation rate (mol/m^3-water/s), in the unsaturated zone. + + + +If TRUE, maintain constant soil carbon under lakes, and use the methane submodel simply to predict the net conversion of +CO2 (via biological assimilation, decomposition, and methanogenesis) to CH4. If FALSE, transiently decompose initial +soil carbon stock based on soil carbon dataset. NOTE: if FALSE, a new transient source of C is added to the climate system, +so the coupled system will NOT conserve carbon in this mode if the methane model is coupled to the atmosphere. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, use the saturated fraction (fsat) calculated in Soil Hydrology to diagnose the inundated fraction (finundated) +for the CH4 submodel (possibly affecting soil heterotrophic respiration and denitrification depending on the configuration), +rather than using the inversion to satellite-observed inundated fraction, which requires additional surface data. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, use the fine root carbon predicted by CN when calculating the aerenchyma area, rather than the parametrization +based on annual NPP, aboveground NPP fraction, and LAI. +(EXPERIMENTAL and NOT tested) + + + +If TRUE, run the methane submodel decoupled from the atmosphere. The atmospheric methane concentration is prescribed by +atmch4, the methane flux is not passed to the atmosphere, and the CO2 flux to the atmosphere is not adjusted for +net methane production. NOTE: Currently this must be TRUE. +(EXPERIMENTAL and NOT functional) + + + + + + + +File containing MEGAN emissions factors. Includes the list of MEGAN compounds that can be +used in the Comp_Name variable on the file. + + + +MEGAN specifier. This is in the form of: Chem-compound = megan_compound(s) +where megan_compound(s) can be the sum of megan compounds with a "+" between them. +In each equation, the item to the left of the equal sign is a CAM chemistry compound, the +items to the right are compounds known to the MEGAN model (single or combinations). +For example, +megan_specifier = 'ISOP = isoprene', + 'C10H16 = pinene_a + carene_3 + thujene_a' + + + +MEGAN mapped isoprene emissions factors switch +If TRUE then use mapped MEGAN emissions factors for isoprene. + + + +List of possible MEGAN compounds to use + (the list used by the simulation is on the megan_factors_file as the Comp_Name) + + + + + + + +Full pathname of time varying landuse data file. This causes the land-use types of +the initial surface dataset to vary over time. + + + +If TRUE, apply transient natural PFTs from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) + + + +If TRUE, apply transient crops from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) +(Also, only valid for use_crop = true.) + + + +If TRUE, apply harvest from flanduse_timeseries file. +(Only valid for transient runs, where there is a flanduse_timeseries file.) +(Also, only valid for use_cn = true.) + + + + + + + +If TRUE (which is the default), check consistency between surface dataset used to create the finidat file +and the current fsurdat. This check is only done for a transient run. + + + +If TRUE (which is the default), check consistency between year on the finidat file +and the current model year. This check is only done for a transient run. + + + +If TRUE (which is the default), check consistency between pct_pft on the finidat file +and pct_pft read from the surface dataset. This check is only done for a NON-transient run. + + + + + + + +If TRUE (which is the default), check consistency between pct_nat_pft on the flanduse_timeseries file +and pct_nat_pft read from the surface dataset. + + + diff --git a/components/clm/bld/test_build_namelist/t/template_test_XXX.pm b/components/clm/bld/test_build_namelist/t/template_test_XXX.pm new file mode 100644 index 0000000000..dab237ee11 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/template_test_XXX.pm @@ -0,0 +1,104 @@ +package test_XXX; + +# Unit tests for function: XXX + +use Data::Dumper; +use Test::More; +use Test::Exception; + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 3) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- +sub test_XXX__YYY : Tests { + my $self = shift; + + my $msg = "Test that the XXX is set correctly for condition YYY.\n"; + + use CLMBuildNamelist qw(message); + + my $opts = { XXX => 1, }; + my $nl_flags = { phys => "clm4_5", + }; + + CLMBuildNamelist::message($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}); + my $group = $self->{definition}->get_group_name("XXX"); + my $result = $self->{nl}->get_variable_value($group, "XXX"); + isnt($result, 12345) || diag($msg); +} + +#------------------------------------------------------------------------------- + +sub test_XXX__WWW : Tests { + my $self = shift; + + my $msg = "Test that the XXX is set correctly for condition WWW.\n"; + + use CLMBuildNamelist qw(message); + + my $opts = { XXX => 1, }; + my $nl_flags = { phys => "clm4_5", + }; + + CLMBuildNamelist::message($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}); + my $group = $self->{definition}->get_group_name("XXX"); + my $result = $self->{nl}->get_variable_value($group, "XXX"); + is($result, undef) || diag($msg); +} + +#------------------------------------------------------------------------------- +sub test_XXX__ZZZ : Tests { + my $self = shift; + + my $msg = "Test that using XXX under condition ZZZ results in a fatal error.\n"; + + use CLMBuildNamelist qw(XXX); + + my $opts = { XXX => 1, }; + my $nl_flags = { phys => "clm4_5", + ZZZ => "ZZZ", + }; + + dies_ok(sub { CLMBuildNamelist::XXX($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}) }) || diag($msg); +} + + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_do_harvest.pm b/components/clm/bld/test_build_namelist/t/test_do_harvest.pm new file mode 100644 index 0000000000..09a417a610 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_do_harvest.pm @@ -0,0 +1,198 @@ +package test_do_harvest; + +# Unit tests for function: setup_logic_do_harvest + +use strict; +use Data::Dumper; +use Test::More; +use Test::Exception; + +use CLMBuildNamelist qw(setup_logic_do_harvest); + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 4) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); + + $self->{physv} = config_files::clm_phys_vers->new( $self->{cfg}->get('phys') ); + isnt($self->{physv}, undef, (caller(0))[3] . " : phys_vers object created."); + + $self->{test_files} = 0; + $self->{nl_flags} = {}; +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); + + # Set use_ed so that it doesn't conflict with do_harvest + $self->set_value('use_ed', '.false.'); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# Other common routines +# +#------------------------------------------------------------------------------- + +sub set_value { + # Set the value of a namelist option + my ($self, $var, $value) = @_; + + my $group = $self->{definition}->get_group_name($var); + $self->{nl}->set_variable_value($group, $var, $value); +} + +sub set_nontransient { + # Set up flanduse_timeseries for a non-transient case + my $self = shift; + + # Include single quotes in the variable's value, as would be the case in practice + $self->set_value('flanduse_timeseries', "' '"); +} + +sub set_transient { + # Set up flanduse_timeseries for a transient case + my $self = shift; + + $self->set_value('flanduse_timeseries', 'foo.nc'); +} + +sub set_cn_true { + # Set use_cn to true + my $self = shift; + + $self->set_value('use_cn', '.true.'); +} + +sub set_cn_false { + # Set use_cn to false + my $self = shift; + + $self->set_value('use_cn', '.false.'); +} + +sub get_do_harvest { + my $self = shift; + + return $self->{nl}->get_value("do_harvest"); +} + +sub setup_logic_do_harvest { + my $self = shift; + + CLMBuildNamelist::setup_logic_do_harvest($self->{test_files}, $self->{nl_flags}, $self->{definition}, $self->{defaults}, $self->{nl}, $self->{physv}); +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- + +sub test_do_harvest__default_transient_cn : Tests { + my $self = shift; + + my $msg = "Test default value for do_harvest in a transient cn case.\n"; + + $self->set_transient; + $self->set_cn_true; + + $self->setup_logic_do_harvest; + my $result = $self->get_do_harvest; + is($result, '.true.') || diag($msg); +} + +sub test_do_harvest__default_nontransient_cn : Tests { + my $self = shift; + + my $msg = "Test default value for do_harvest in a non-transient cn case.\n"; + + $self->set_nontransient; + $self->set_cn_true; + + $self->setup_logic_do_harvest; + my $result = $self->get_do_harvest; + is($result, undef) || diag($msg); +} + +sub test_do_harvest__default_transient_noncn : Tests { + my $self = shift; + + my $msg = "Test default value for do_harvest in a transient non-cn case.\n"; + + $self->set_transient; + $self->set_cn_false; + + $self->setup_logic_do_harvest; + my $result = $self->get_do_harvest; + is($result, undef) || diag($msg); +} + +sub test_do_harvest__default_ed : Tests { + my $self = shift; + + my $msg = "Test default value for do_harvest in an ED case.\n"; + + $self->set_transient; + $self->set_cn_true; + $self->set_value('use_ed', '.true.'); + + $self->setup_logic_do_harvest; + my $result = $self->get_do_harvest; + is($result, undef) || diag($msg); +} + +sub test_do_harvest__override_default : Tests { + my $self = shift; + + my $msg = "Test ability to set value to false when the default is true.\n"; + + $self->set_transient; + $self->set_cn_true; + $self->set_value('do_harvest', '.false.'); + + $self->setup_logic_do_harvest; + my $result = $self->get_do_harvest; + is($result, '.false.') || diag($msg); +} + +sub test_do_harvest__override_default_not_allowed : Tests { + my $self = shift; + + my $msg = "Make sure overriding the default isn't allowed for a non-transient case.\n"; + + $self->set_nontransient; + $self->set_cn_true; + $self->set_value('do_harvest', '.true.'); + + dies_ok(sub {$self->setup_logic_do_harvest}) || diag($msg); +} + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_do_transient_crops.pm b/components/clm/bld/test_build_namelist/t/test_do_transient_crops.pm new file mode 100644 index 0000000000..1dcad39af5 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_do_transient_crops.pm @@ -0,0 +1,196 @@ +package test_do_transient_crops; + +# Unit tests for function: setup_logic_do_transient_crops + +use strict; +use Data::Dumper; +use Test::More; +use Test::Exception; + +use CLMBuildNamelist qw(setup_logic_do_transient_crops); + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 4) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); + + $self->{physv} = config_files::clm_phys_vers->new( $self->{cfg}->get('phys') ); + isnt($self->{physv}, undef, (caller(0))[3] . " : phys_vers object created."); + + $self->{test_files} = 0; + $self->{nl_flags} = {}; +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); + + # Set use_ed so that it doesn't conflict with do_transient_crops + $self->set_value('use_ed', '.false.'); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# Other common routines +# +#------------------------------------------------------------------------------- + +sub set_value { + # Set the value of a namelist option + my ($self, $var, $value) = @_; + + my $group = $self->{definition}->get_group_name($var); + $self->{nl}->set_variable_value($group, $var, $value); +} + +sub set_nontransient { + # Set up flanduse_timeseries for a non-transient case + my $self = shift; + + # Include single quotes in the variable's value, as would be the case in practice + $self->set_value('flanduse_timeseries', "' '"); +} + +sub set_transient { + # Set up flanduse_timeseries for a transient case + my $self = shift; + + $self->set_value('flanduse_timeseries', 'foo.nc'); +} + +sub set_crop_true { + # Set use_crop to true + my $self = shift; + + $self->set_value('use_crop', '.true.'); +} + +sub set_crop_false { + # Set use_crop to false + my $self = shift; + + $self->set_value('use_crop', '.false.'); +} + +sub get_do_transient_crops { + my $self = shift; + + return $self->{nl}->get_value("do_transient_crops"); +} + +sub setup_logic_do_transient_crops { + my $self = shift; + + CLMBuildNamelist::setup_logic_do_transient_crops($self->{test_files}, $self->{nl_flags}, $self->{definition}, $self->{defaults}, $self->{nl}, $self->{physv}); +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- + +sub test_do_transient_crops__default_transient_crop : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a transient crop case.\n"; + + $self->set_transient; + $self->set_crop_true; + + $self->setup_logic_do_transient_crops; + my $result = $self->get_do_transient_crops; + is($result, '.true.') || diag($msg); +} + +sub test_do_transient_crops__default_nontransient_crop : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a non-transient crop case.\n"; + + $self->set_nontransient; + $self->set_crop_true; + + $self->setup_logic_do_transient_crops; + my $result = $self->get_do_transient_crops; + is($result, undef) || diag($msg); +} + +sub test_do_transient_crops__default_transient_noncrop : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a transient non-crop case.\n"; + + $self->set_transient; + $self->set_crop_false; + + $self->setup_logic_do_transient_crops; + my $result = $self->get_do_transient_crops; + is($result, undef) || diag($msg); +} + +sub test_do_transient_crops__override_default : Tests { + my $self = shift; + + my $msg = "Test ability to set value to false when the default is true.\n"; + + $self->set_transient; + $self->set_crop_true; + $self->set_value('do_transient_crops', '.false.'); + + $self->setup_logic_do_transient_crops; + my $result = $self->get_do_transient_crops; + is($result, '.false.') || diag($msg); +} + +sub test_do_transient_crops__override_default_not_allowed_nontransient : Tests { + my $self = shift; + + my $msg = "Make sure overriding the default isn't allowed for a non-transient case.\n"; + + $self->set_nontransient; + $self->set_crop_true; + $self->set_value('do_transient_crops', '.true.'); + + dies_ok(sub {$self->setup_logic_do_transient_crops}) || diag($msg); +} + +sub test_do_transient_crops__override_default_not_allowed_noncrop : Tests { + my $self = shift; + + my $msg = "Make sure overriding the default isn't allowed for a non-crop case.\n"; + + $self->set_transient; + $self->set_crop_false; + $self->set_value('do_transient_crops', '.true.'); + + dies_ok(sub {$self->setup_logic_do_transient_crops}) || diag($msg); +} + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_do_transient_pfts.pm b/components/clm/bld/test_build_namelist/t/test_do_transient_pfts.pm new file mode 100644 index 0000000000..cadcee5019 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_do_transient_pfts.pm @@ -0,0 +1,175 @@ +package test_do_transient_pfts; + +# Unit tests for function: setup_logic_do_transient_pfts + +use strict; +use Data::Dumper; +use Test::More; +use Test::Exception; + +use CLMBuildNamelist qw(setup_logic_do_transient_pfts); + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 4) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); + + $self->{physv} = config_files::clm_phys_vers->new( $self->{cfg}->get('phys') ); + isnt($self->{physv}, undef, (caller(0))[3] . " : phys_vers object created."); + + $self->{test_files} = 0; + $self->{nl_flags} = {}; +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); + + # Set use_cndv and use_ed so that they don't conflict with do_transient_pfts + $self->set_value('use_cndv', '.false.'); + $self->set_value('use_ed', '.false.'); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# Other common routines +# +#------------------------------------------------------------------------------- + +sub set_value { + # Set the value of a namelist option + my ($self, $var, $value) = @_; + + my $group = $self->{definition}->get_group_name($var); + $self->{nl}->set_variable_value($group, $var, $value); +} + +sub set_nontransient { + # Set up flanduse_timeseries for a non-transient case + my $self = shift; + + # Include single quotes in the variable's value, as would be the case in practice + $self->set_value('flanduse_timeseries', "' '"); +} + +sub set_transient { + # Set up flanduse_timeseries for a transient case + my $self = shift; + + $self->set_value('flanduse_timeseries', 'foo.nc'); +} + +sub get_do_transient_pfts { + my $self = shift; + + return $self->{nl}->get_value("do_transient_pfts"); +} + +sub setup_logic_do_transient_pfts { + my $self = shift; + + CLMBuildNamelist::setup_logic_do_transient_pfts($self->{test_files}, $self->{nl_flags}, $self->{definition}, $self->{defaults}, $self->{nl}, $self->{physv}); +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- + +sub test_do_transient_pfts__default_transient : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a transient case.\n"; + + $self->set_transient; + $self->setup_logic_do_transient_pfts; + my $result = $self->get_do_transient_pfts; + is($result, '.true.') || diag($msg); +} + +sub test_do_transient_pfts__default_nontransient : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a non-transient case.\n"; + + $self->set_nontransient; + $self->setup_logic_do_transient_pfts; + my $result = $self->get_do_transient_pfts; + is($result, undef) || diag($msg); +} + +sub test_do_transient_pfts__default_cndv : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in a cndv case.\n"; + + $self->set_transient; + $self->set_value('use_cndv', '.true.'); + $self->setup_logic_do_transient_pfts; + my $result = $self->get_do_transient_pfts; + is($result, undef) || diag($msg); +} + +sub test_do_transient_pfts__default_ed : Tests { + my $self = shift; + + my $msg = "Test default value for do_transient_pfts in an ED case.\n"; + + $self->set_transient; + $self->set_value('use_ed', '.true.'); + $self->setup_logic_do_transient_pfts; + my $result = $self->get_do_transient_pfts; + is($result, undef) || diag($msg); +} + +sub test_do_transient_pfts__override_default : Tests { + my $self = shift; + + my $msg = "Test ability to set value to false when the default is true.\n"; + + $self->set_transient; + $self->set_value('do_transient_pfts', '.false.'); + $self->setup_logic_do_transient_pfts; + my $result = $self->get_do_transient_pfts; + is($result, '.false.') || diag($msg); +} + +sub test_do_transient_pfts__override_default_not_allowed : Tests { + my $self = shift; + + my $msg = "Make sure overriding the default is not allowed when running a non-transient case.\n"; + + $self->set_nontransient; + $self->set_value('do_transient_pfts', '.true.'); + dies_ok(sub {$self->setup_logic_do_transient_pfts}) || diag($msg); +} + + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_lnd_frac.pm b/components/clm/bld/test_build_namelist/t/test_lnd_frac.pm new file mode 100644 index 0000000000..74c75915c0 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_lnd_frac.pm @@ -0,0 +1,98 @@ +package test_lnd_frac; + +use Data::Dumper; +use Test::More; +use Test::Exception; + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 3) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); + + $self->{env_xml} = {}; +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- +sub test_setup_logic_lnd_frac__fail_if_fatmlndfrc_set : Tests { + my $self = shift; + + my $msg = "Test that opts->lnd_frac and nl->fatmlndfrc can not be set at the same time.\n"; + + use CLMBuildNamelist qw(setup_logic_lnd_frac); + + my $opts = { lnd_frac => 1, + test => 0, + }; + + # NOTE: don't set inputdata_rootdir so we can tell if the die comes from add_default + my $nl_flags = { phys => "clm4_5", + }; + + my $group = $self->{definition}->get_group_name("fatmlndfrc"); + $self->{nl}->set_variable_value($group, "fatmlndfrc", 0); + + dies_ok(sub {CLMBuildNamelist::setup_logic_lnd_frac($opts, $nl_flags, $self->{definition}, + $self->{defaults}, $self->{nl}, + $self->{env_xml});}) || diag($msg); +} + +#------------------------------------------------------------------------------- +sub test_setup_logic_lnd_frac__set_fatmlndfrc : Tests { + my $self = shift; + + my $msg = "Test that fatmlndfrc is set from the stream value supplied by\n" . + "lnd_frac command line option.\n"; + + use CLMBuildNamelist qw(setup_logic_lnd_frac); + + my $opts = { lnd_frac => "dummy_file", + test => 0, + }; + my $nl_flags = { phys => "clm4_5", + inputdata_rootdir => "/dummy/root/path", + }; + + CLMBuildNamelist::setup_logic_lnd_frac($opts, $nl_flags, $self->{definition}, $self->{defaults}, + $self->{nl}, $self->{env_xml}); + my $group = $self->{definition}->get_group_name("fatmlndfrc"); + my $result = $self->{nl}->get_variable_value($group, "fatmlndfrc"); + + is($result, "\'/dummy/root/path/dummy_file\'") || diag($msg); +} + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_setup_cmdl_run_type.pm b/components/clm/bld/test_build_namelist/t/test_setup_cmdl_run_type.pm new file mode 100644 index 0000000000..a0b369f298 --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_setup_cmdl_run_type.pm @@ -0,0 +1,106 @@ +package test_setup_cmdl_run_type; + +# Unit tests for function: setup_cmdl_run_type + +use Data::Dumper; +use Test::More; +use Test::Exception; + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 3) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- +sub test_setup_cmdl_run_type__unset : Tests { + my $self = shift; + + my $msg = "Test that not setting clm_start_type on the command line results in an error.\n"; + + use CLMBuildNamelist qw(setup_cmdl_run_type); + + my $opts = { test => 0, }; + my $nl_flags = { phys => "clm4_5", + inputdata_rootdir => 0 }; + + dies_ok(sub { CLMBuildNamelist::XXX($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}) }) || diag($msg); + +} + +#------------------------------------------------------------------------------- + +sub test_setup_cmdl_run_type__default : Tests { + my $self = shift; + + my $msg = "Test that setting clm_start_type to 'default' on the command line results in an error.\n"; + + use CLMBuildNamelist qw(setup_cmdl_run_type); + + my $opts = { test => 0, + clm_start_type => "default" }; + my $nl_flags = { phys => "clm4_5", + inputdata_rootdir => 0 }; + + + dies_ok(sub { CLMBuildNamelist::setup_cmdl_run_type($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}) }) || diag($msg); +} + +#------------------------------------------------------------------------------- + +sub test_setup_cmdl_run_type__arbitrary_string : Tests { + my $self = shift; + + my $msg = "Test that the commandline clm_start_type string is set to ". + "the namelist and nl_flags for any value except 'default'.\n"; + + use CLMBuildNamelist qw(setup_cmdl_run_type); + + my $opts = { test => 0, + clm_start_type => "foo" }; + my $nl_flags = { phys => "clm4_5", + inputdata_rootdir => 0 }; + + CLMBuildNamelist::setup_cmdl_run_type($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}); + my $group = $self->{definition}->get_group_name("clm_start_type"); + my $result = $self->{nl}->get_variable_value($group, "clm_start_type"); + is($result, "'foo'") || diag($msg); + is($nl_flags->{'clm_start_type'}, "'foo'") || diag($msg); +} + +1; diff --git a/components/clm/bld/test_build_namelist/t/test_vichydro.pm b/components/clm/bld/test_build_namelist/t/test_vichydro.pm new file mode 100644 index 0000000000..b49889b16c --- /dev/null +++ b/components/clm/bld/test_build_namelist/t/test_vichydro.pm @@ -0,0 +1,111 @@ +package test_vichydro; + +# Unit tests for function: setup_cmdl_vichydro + +use Data::Dumper; +use Test::More; +use Test::Exception; + +use parent qw(Test::Class); + +#------------------------------------------------------------------------------- +# +# Common test fixture for all tests: +# +#------------------------------------------------------------------------------- +sub startup : Test(startup => 4) { + my $self = shift; + # provide common fixture for all tests, only created once at the + # start of the tests. + $self->{cfg} = Build::Config->new("t/input/config_cache_clm4_5_test.xml"); + isnt($self->{cfg}, undef, (caller(0))[3] . " : config object created."); + + $self->{definition} = Build::NamelistDefinition->new("t/input/namelist_definition_clm4_5_test.xml"); + isnt($self->{definition}, undef, (caller(0))[3] . " : namelist_definition object created."); + + $self->{defaults} = Build::NamelistDefaults->new("t/input/namelist_defaults_clm4_5_test.xml"); + isnt($self->{defaults}, undef, (caller(0))[3] . " : namelist_defaults object created."); + + $self->{physv} = config_files::clm_phys_vers->new( $self->{cfg}->get('phys') ); + isnt($self->{physv}, undef, (caller(0))[3] . " : phys_vers object created."); +} + +sub shutdown : Test(shutdown) { + # cleanup the single instance test fixtures +} + +sub setup : Test(setup => 1) { + my $self = shift; + # provide common fixture for all tests, create fresh for each test + + $self->{nl} = Build::Namelist->new(); + isnt($self->{nl}, undef, (caller(0))[3] . " : empty namelist object created."); +} + +sub teardown : Test(teardown) { + # clean up after test +} + +#------------------------------------------------------------------------------- +# +# tests +# +#------------------------------------------------------------------------------- + +sub test_setup_cmdl_vichydro__clm4_0 : Tests { + my $self = shift; + + my $msg = "Test that the setting vichydro is a fatal error in clm4_0.\n"; + + use CLMBuildNamelist qw(setup_cmdl_vichydro); + + my $opts = { vichydro => 1, }; + my $physv40 = config_files::clm_phys_vers->new( "clm4_0" ); + + dies_ok(sub { CLMBuildNamelist::setup_cmdl_vichydro($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}), + $self->{physv} }) || diag($msg); +} + +#------------------------------------------------------------------------------- + +sub test_setup_cmdl_vichydro__nl_contradicts_cmdl : Tests { + my $self = shift; + + my $msg = "Test that the setting vichydro when use_vichydro is false is a fatal error.\n"; + + use CLMBuildNamelist qw(setup_cmdl_vichydro); + + my $opts = { vichydro => 1, }; + my $nl_flags = { + vichydro => ".false.", + }; + + my $group = $self->{definition}->get_group_name("use_vichydro"); + $self->{nl}->set_variable_value($group, "use_vichydro", '.false.' ); + + dies_ok(sub { CLMBuildNamelist::setup_cmdl_vichydro($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}, + $self->{physv}) }) || diag($msg); +} + +#------------------------------------------------------------------------------- + +sub test_setup_cmdl_vichydro__set_use_vichydro : Tests { + my $self = shift; + + my $msg = "Test that the setting vichydro on the commandline sets use_vichydro ". + "namelist variable to true.\n"; + + use CLMBuildNamelist qw(setup_cmdl_vichydro); + + my $opts = { vichydro => 1, }; + my $nl_flags = { + }; + + CLMBuildNamelist::setup_cmdl_vichydro($opts, $nl_flags, $self->{definition}, $self->{defaults}, $self->{nl}, $self->{physv}); + my $group = $self->{definition}->get_group_name("use_vichydro"); + my $result = $self->{nl}->get_variable_value($group, "use_vichydro"); + is($result, '.true.') || diag($msg); +} + + +1; diff --git a/components/clm/bld/test_build_namelist/test_build_namelist.pl b/components/clm/bld/test_build_namelist/test_build_namelist.pl new file mode 100755 index 0000000000..d7051015e0 --- /dev/null +++ b/components/clm/bld/test_build_namelist/test_build_namelist.pl @@ -0,0 +1,56 @@ +#!/usr/bin/env perl +# -*- mode: cperl -*- +#----------------------------------------------------------------------------------------------- + +require 5; + +use strict; +use warnings; +use diagnostics; + +use Test::More; + +BEGIN { + # + # setup paths for cesm and local utility modules at compile time. + # + # Assumes that we are running from clm/bld/test.... + # + use Cwd qw(getcwd abs_path); + + my $cwd = getcwd(); + my $cesmroot = abs_path("../../../../"); + + my @dirs = ("../", + "$cwd/perl5lib", + "$cesmroot/cime/utils/perl5lib", + "$cesmroot/cime/scripts/Tools"); + + unshift @INC, @dirs; + + # check for a couple of modules from the paths we added. + use_ok("CLMBuildNamelist"); + use_ok("SetupTools"); + use_ok("Test::Class"); +} + + +# ccsm perl modules +require Build::Config; +require Build::NamelistDefinition; +require Build::NamelistDefaults; +require Build::Namelist; +require config_files::clm_phys_vers; +require Streams::TemplateGeneric; +require SetupTools; + +# local perl modules +use Test::Class; +use Test::Exception; + +require CLMBuildNamelist; + +use Test::Class::Load "./t"; + +Test::Class->runtests; + diff --git a/components/clm/bld/unit_testers/NMLTest/CompFiles.pm b/components/clm/bld/unit_testers/NMLTest/CompFiles.pm new file mode 100644 index 0000000000..5a477e3670 --- /dev/null +++ b/components/clm/bld/unit_testers/NMLTest/CompFiles.pm @@ -0,0 +1,218 @@ +############################################################################### +# +# Module: NMLTest::CompFiles +# +# Created by Erik Kluzek NCAR +# +# This is a tester built on top of Test::More to compare namelist files +# (or really any ASCII text files). There is a mechanism for telling the +# test object that you should (or should NOT) expect the comparison to be +# exact or not. +# +############################################################################### + +package NMLTest::CompFiles; +use strict; +use Test::More; +use IO::File; + +=head1 NAME + +NMLTest::CompFiles - A comparision tester for namelist (or ASCII text) files + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=cut + +sub new { + my $self = {}; + my $class = shift; + my $dir = shift; + my @files = @_; + + my $nm = ref($self)."\:\:new"; + + my %diffref = { }; + $self->{'diffref'} = \%diffref; + if ( ! -d "$dir" ) { + die "ERROR::($nm) Input directory ($dir) does NOT exist!\n"; + } + $self->{'dir'} = $dir; + $self->{'files'} = \@_; + bless( $self, $class ); +} + +sub checkfilesexist { +# +# Check that files exist +# + my $self = shift; + my $type = shift; + my $mode = shift; + my $nm = ref($self)."\:\:checkfilesexist"; + + my $filesref = $self->{'files'}; + my $confdir = $self->{'dir'}; + foreach my $file ( @$filesref ) { + my $exists = ( -f "$confdir/$file" ); + ok( $exists, "$file file exists" ); + if ( $exists ) { + $self->dodiffonfile( $file, $type, $mode ); + } else { + $self->doNOTdodiffonfile( $file, $type, $mode ); + } + } +} + +sub comparefiles { +# +# Compare the resultant files to the default versions +# + my $self = shift; + my $type = shift; + my $comp_mode = shift; + my $compdir = shift; + my $nm = ref($self)."\:\:comparefiles"; + + $type =~ s/ /+/g; + $comp_mode =~ s/ /+/g; + my $confdir = $self->{'dir'}; + my $diffref = $self->{'diffref'}; + if ( ! defined($type) ) { + $type = "default"; + } + my $compare = "compare to previous tag"; + if ( ! defined($compdir) ) { + $compdir = "."; + $compare = undef; + } + if ( ! -d "$compdir" ) { + die "ERROR($nm):: Compare directory $compdir does NOT exist!\n"; + } + print "Compare files for $type type MODE=$comp_mode $compare\n"; + my $diffstat; + my %diffhas = %$diffref; + my $same = "file the same as expected"; + my $diff = "file different as expected"; + my $filesref = $self->{'files'}; + foreach my $file ( @$filesref ) { + if ( ! -f "$compdir/${file}.$comp_mode.${type}" ) { + print "WARNING($nm):: File $compdir/${file}.$comp_mode.${type} does NOT exist!\n"; + fail( "compare file $file DNE for $comp_mode and $type" ); + } else { + if ( ! exists($diffhas{$comp_mode}{$type}{$file}) ) { + die "ERROR($nm):: difference is NOT setup for $comp_mode ${type} $file!\n"; + } + system( "diff $confdir/${file} $compdir/${file}.$comp_mode.${type} > /dev/null" ); + $diffstat = $?; + if ( $diffhas{$comp_mode}{$type}{$file} ) { + ok( ! $diffstat, "$file $same for $comp_mode" ); + } else { + ok( $diffstat, "$file different as expected for $comp_mode" ); + } + } + } + +} + +sub copyfiles { +# +# Copy the namelist files to default names for comparisions +# + my $self = shift; + my $type = shift; + my $mode = shift; + my $nm = ref($self)."\:\:copyfiles"; + + $type =~ s/ /+/g; + $mode =~ s/ /+/g; + my $diffref = $self->{'diffref'}; + my $filesref = $self->{'files'}; + my $confdir = $self->{'dir'}; + foreach my $file ( @$filesref ) { + system( "/bin/cp $confdir/$file ${file}.${mode}.${type}" ); + $$diffref{${mode}}{${type}}{$file} = 1; + } + print "$type namelists for $mode\n"; + foreach my $file ( @$filesref ) { + system( "/bin/cat $file.${mode}.${type}" ); + } +} + + +sub shownmldiff { +# +# Show the differences in the namelists +# + my $self = shift; + my $type = shift; + my $comp_mode = shift; + my $nm = ref($self)."\:\:shownmldiff"; + + $type =~ s/ /+/g; + $comp_mode =~ s/ /+/g; + my $filesref = $self->{'files'}; + my $confdir = $self->{'dir'}; + foreach my $file ( @$filesref ) { + my $file1 = "$confdir/$file"; + if ( ! -f "$file1" ) { + print "$file1 does NOT exist\n"; + return; + } + my $file2 = "${file}.${comp_mode}.${type}"; + if ( ! -f "$file2" ) { + print "$file2 does NOT exist\n"; + return; + } + print "Diff in in $file to $type $comp_mode version"; + system( "diff $file1 $file2" ); + } + +} + + + +sub dodiffonfile { +# +# Set it so that it does do a difference on the given input file +# + my $self = shift; + my $file = shift; + my $type = shift; + my $mode = shift; + my $nm = ref($self)."\:\:dodiffonfile"; + + $type =~ s/ /+/g; + $mode =~ s/ /+/g; + my $diffref = $self->{'diffref'}; + if ( ! defined($type) ) { + $type = "default"; + } + $$diffref{$mode}{$type}{$file} = 1; +} + + +sub doNOTdodiffonfile { +# +# Set it so that it does NOT do a difference on the given input file +# + my $self = shift; + my $file = shift; + my $type = shift; + my $mode = shift; + my $nm = ref($self)."\:\:doNOTdodiffonfile"; + + $type =~ s/ /+/g; + $mode =~ s/ /+/g; + my $diffref = $self->{'diffref'}; + if ( ! defined($type) ) { + $type = "default"; + } + $$diffref{$mode}{$type}{$file} = 0; +} + +#----------------------------------------------------------------------------------------------- + +1 # to make use or require happy diff --git a/components/clm/bld/unit_testers/build-namelist_test.pl b/components/clm/bld/unit_testers/build-namelist_test.pl new file mode 100755 index 0000000000..c2e18af04f --- /dev/null +++ b/components/clm/bld/unit_testers/build-namelist_test.pl @@ -0,0 +1,896 @@ +#!/usr/bin/env perl + +# Test command line options of the build-namelist script. +# Try to test that all the different options at least work. +# Test that inconsistentcies are appropriately caught. + +######################### + +use Test::More; +use xFail::expectedFail; +use IO::File; + +######################### + +use strict; +use Getopt::Long; +use NMLTest::CompFiles; +use English; + +sub usage { + die < Compare namelists for this version to namelists + created by another version. + -generate Leave the namelists in place to do a later compare. + -test Use the -test option to make sure datasets exist. + -csmdata "dir" Root directory of CESM input data. + +EOF +} + +sub make_env_run { +# +# Create a env_run.xml file to read in +# + my %settings = @_; + + # Set default settings + my %env_vars = ( DIN_LOC_ROOT=>"MYDINLOCROOT", GLC_TWO_WAY_COUPLING=>"FALSE" ); + # Set any settings that came in from function call + foreach my $item ( keys(%settings) ) { + $env_vars{$item} = $settings{$item}; + } + + # Now write the file out + my $envfile = "env_run.xml"; + my $fh = IO::File->new($envfile, '>') or die "can't open file: $envfile"; + print $fh < + + + +EOF + foreach my $item ( keys(%env_vars) ) { + print $fh < +EOF + } + print $fh < +EOF + $fh->close(); +} + + +# +# Process command-line options. +# +my %opts = ( help => 0, + generate => 0, + test => 0, + compare => undef, + csmdata => undef, + ); + +GetOptions( + "h|help" => \$opts{'help'}, + "compare=s" => \$opts{'compare'}, + "generate" => \$opts{'generate'}, + "test" => \$opts{'test'}, + "csmdata=s" => \$opts{'csmdata'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Check that the CESM inputdata root directory has been specified. This must be +# a local or nfs mounted directory. +my $inputdata_rootdir = undef; +if (defined($opts{'csmdata'})) { + $inputdata_rootdir = $opts{'csmdata'}; +} elsif (defined $ENV{'CSMDATA'} ) { + $inputdata_rootdir = $ENV{'CSMDATA'}; +} else { + # use yellowstone location as default + $inputdata_rootdir="/glade/p/cesm/cseg/inputdata"; + print("WARNING: -csmdata nor CSMDATA are set, using default yellowstone location: $inputdata_rootdir\n"); +} + +################################### +#_# read in expected fail test list +################################### +my $compGen; +if ( $opts{'generate'} eq 1 && !(defined($opts{'compare'}) )) { + $compGen='generate'; +} elsif ( defined($opts{'compare'}) ) { + $compGen='compare'; +} elsif ( defined($opts{'compare'} && ($opts{'generate'} eq 1 ))) { + #_# if compare and generate are both given, use compare + $compGen='compare'; +} + +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; +my $testType="namelistTest"; + +# +# Figure out number of tests that will run +# +my $ntests = 352; +if ( defined($opts{'compare'}) ) { + $ntests += 195; +} +plan( tests=>$ntests ); + +#_# ============================================================ +#_# setup for xFail module +#_# ============================================================ +my $xFail = xFail::expectedFail->new($ProgName,$compGen,$ntests); +my $captOut=""; #_# variable to capture Test::More output +Test::More->builder->output(\$captOut); +#_# ============================================================ +#_# +#_# ============================================================ + +# Check for unparsed arguments +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} +my $mode = "standard"; +system( "../configure -s" ); + +my $DOMFILE = "$inputdata_rootdir/atm/datm7/domain.lnd.T31_gx3v7.090928.nc"; +my $bldnml = "../build-namelist -verbose -csmdata $inputdata_rootdir -lnd_frac $DOMFILE -no-note"; +if ( $opts{'test'} ) { + $bldnml .= " -test"; +} + +my $tempfile = "temp_file.txt"; +if ( -f $tempfile ) { + system( "/bin/rm $tempfile" ); +} + +my @files = ( "lnd_in", $tempfile ); +my $cwd = `pwd`; +chomp( $cwd ); +my $cfiles = NMLTest::CompFiles->new( $cwd, @files ); + +print "\n==================================================\n"; +print "Run simple tests \n"; +print "==================================================\n"; + +# Simple test -- just run build-namelist with -help option +eval{ system( "$bldnml -help > $tempfile 2>&1 " ); }; + is( $@, '', "help" ); + &cleanup(); +# Simple test -- just run build-namelist with -version option +eval{ system( "$bldnml -version > $tempfile 2>&1 " ); }; + is( $@, '', "version" ); + system( "/bin/cat $tempfile" ); + &cleanup(); +# Simple test -- just run build-namelist +&make_env_run(); +eval{ system( "$bldnml > $tempfile 2>&1 " ); }; + is( $@, '', "plain build-namelist" ); + $cfiles->checkfilesexist( "default", $mode ); + # Compare to baseline + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "default", $mode ); + $cfiles->comparefiles( "default", $mode, $opts{'compare'} ); + } + +print "\n==================================================\n"; +print "Run simple tests with all list options \n"; +print "==================================================\n"; + +$cfiles->copyfiles( "default", $mode ); +&cleanup(); +# Simple test -- run all the list options +foreach my $options ( "clm_demand", "rcp", "res", + "sim_year", "use_case" ) { + &make_env_run(); + eval{ system( "$bldnml -${options} list > $tempfile 2>&1 " ); }; + my $result = `cat $tempfile`; + my $expect; + if ( $options =~ /use_case/ ) { + $expect = "use cases :"; + } else { + $expect = "valid values for $options"; + } + $expect = "/CLM build-namelist : $expect/"; + like( $result, $expect, "$options list" ); + is( (-f "lnd_in"), undef, "Check that lnd_in file does NOT exist" ); + &cleanup(); +} + +print "\n==================================================\n"; +print "Run simple tests with additional options \n"; +print "==================================================\n"; + +# Exercise a bunch of options +my $options = "-co2_ppmv 250 -glc_nec 10 -glc_present -glc_smb .false."; + $options .= " -res 0.9x1.25 -rcp 2.6 -envxml_dir ."; + + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "options: $options" ); + $cfiles->checkfilesexist( "default", $mode ); + $cfiles->copyfiles( "most_options", $mode ); + # Compare to default + $cfiles->doNOTdodiffonfile( "lnd_in", "default", $mode ); + $cfiles->doNOTdodiffonfile( "$tempfile", "default", $mode ); + $cfiles->comparefiles( "default", $mode ); + # Compare to baseline + if ( defined($opts{'compare'}) ) { + $cfiles->dodiffonfile( "lnd_in", "most_options", $mode ); + $cfiles->doNOTdodiffonfile( "$tempfile", "most_options", $mode ); + $cfiles->comparefiles( "most_options", $mode, $opts{'compare'} ); + } + &cleanup(); + +print "\n==================================================\n"; +print "Test drydep and megan namelists \n"; +print "==================================================\n"; + +# drydep and megan namelists +my @mfiles = ( "lnd_in", "drv_flds_in", $tempfile ); +my $mfiles = NMLTest::CompFiles->new( $cwd, @mfiles ); +foreach my $options ( "-drydep", "-megan", "-drydep -megan" ) { + &make_env_run(); + eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; + is( $@, '', "options: $options" ); + $mfiles->checkfilesexist( "$options", $mode); + if ( $options ne "-drydep" ) { + $mfiles->shownmldiff( "-drydep", $mode ); + } + if ( defined($opts{'compare'}) ) { + $mfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $mfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $mfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} + +print "\n==================================================\n"; +print "Test irrig, verbose, clm_demand, rcp, test, sim_year, use_case, l_ncpl\n"; +print "==================================================\n"; + +# irrig, verbose, clm_demand, rcp, test, sim_year, use_case, l_ncpl +my $startfile = "clmrun.clm2.r.1964-05-27-00000.nc"; +foreach my $options ( "-irrig .true. ", "-verbose", "-rcp 2.6", "-test", "-sim_year 1850", + "-use_case 1850_control", "-l_ncpl 1", + "-clm_start_type startup", + "-envxml_dir . -infile myuser_nl_clm", + ) { + my $file = $startfile; + &make_env_run(); + eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; + is( $@, '', "options: $options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default" ); + $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/ ) { + 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" ); + } + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} + + +print "\n==================================================\n"; +print "Start Failure testing. These should fail \n"; +print "==================================================\n"; + +# Failure testing, do things that SHOULD fail +my $finidat = "thing.nc"; +system( "touch $finidat" ); + +my %failtest = ( + "coldstart but with IC file"=>{ options=>"-clm_start_type cold -envxml_dir .", + namelst=>"finidat='$finidat'", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "l_ncpl is zero" =>{ options=>"-l_ncpl 0 -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "l_ncpl not integer" =>{ options=>"-l_ncpl 1.0 -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "both l_ncpl and dtime" =>{ options=>"-l_ncpl 24 -envxml_dir .", + namelst=>"dtime=1800", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "use_crop without -crop" =>{ options=>" -envxml_dir .", + namelst=>"use_crop=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "CNDV with flanduse_timeseries" =>{ options=>" -envxml_dir .", + namelst=>"flanduse_timeseries='my_flanduse_timeseries_file.nc'", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-bgc cndv", + }, + "CNDV with flanduse_timeseries - clm4_5"=>{ options=>"-bgc bgc -dynamic_vegetation -envxml_dir .", + namelst=>"flanduse_timeseries='my_flanduse_timeseries_file.nc'", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "use_cndv=T without bldnml op"=>{ options=>"-bgc cn -envxml_dir .", + namelst=>"use_cndv=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "use_cndv=F with dyn_veg op"=>{ options=>"-bgc cn -dynamic_vegetation -envxml_dir .", + namelst=>"use_cndv=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "crop with use_crop false" =>{ options=>"-crop -bgc bgc -envxml_dir .", + namelst=>"use_crop=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "crop without CN" =>{ options=>"-crop -bgc sp -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "irrigate=T without -irr op"=>{ options=>"-crop -bgc cn -envxml_dir .", + namelst=>"irrigate=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "irrigate=F with -irrg op" =>{ options=>"-crop -bgc cn -irrig .true. -envxml_dir .", + namelst=>"irrigate=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "-irrig without -crop" =>{ options=>"-bgc cn -irrig .true. -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "sp and c13" =>{ options=>"-bgc sp -envxml_dir .", + namelst=>"use_c13=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "sp and c14" =>{ options=>"-bgc sp -envxml_dir .", + namelst=>"use_c14=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "crop and c13" =>{ options=>"-crop -bgc bgc -envxml_dir .", + namelst=>"use_c13=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "crop and c14" =>{ options=>"-crop -bgc cn -envxml_dir .", + namelst=>"use_c14=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "bgc=cn and bgc settings" =>{ options=>"-bgc cn -envxml_dir .", + namelst=>"use_lch4=.true.,use_nitrif_denitrif=.true.,use_vertsoilc=.true.,use_century_decomp=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "bgc=bgc and cn-only set" =>{ options=>"-bgc bgc -envxml_dir .", + namelst=>"use_lch4=.false.,use_nitrif_denitrif=.false.,use_vertsoilc=.false.,use_century_decomp=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "use_cn=true bgc=sp" =>{ options=>"-bgc sp -envxml_dir .", + namelst=>"use_cn=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "use_cn=false bgc=cn" =>{ options=>"-bgc cn -envxml_dir .", + namelst=>"use_cn=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "vichydro without clm4_5" =>{ options=>"-vichydro -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_0", + }, + "use_vic=F with -vic op" =>{ options=>"-vichydro -envxml_dir .", + namelst=>"use_vichydro=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "bgc without clm4_5" =>{ options=>"-bgc sp -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_0", + }, + "bgc_spinup without clm4_5" =>{ options=>"-bgc_spinup on -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_0", + }, + "DV without clm4_5" =>{ options=>"-dynamic_vegetation -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_0", + }, + "bgc_spinup without cn" =>{ options=>"-bgc_spinup on -bgc sp -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "spinup=1 without bldnml op"=>{ options=>"-bgc bgc -envxml_dir .", + namelst=>"spinup_state=1",, + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "spinup=0 with bldnml op" =>{ options=>"-bgc bgc -bgc_spinup on -envxml_dir .", + namelst=>"spinup_state=0", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "both co2_type and on nml" =>{ options=>"-co2_type constant -envxml_dir .", + namelst=>"co2_type='prognostic'", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "both lnd_frac and on nml" =>{ options=>"-lnd_frac domain.nc -envxml_dir .", + namelst=>"fatmlndfrc='frac.nc'", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "branch but NO nrevsn" =>{ options=>"-clm_start_type branch -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "glc_nec inconsistent" =>{ options=>"-glc_nec 10 -envxml_dir .", + namelst=>"maxpatch_glcmec=5", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "glc_smb inconsistent" =>{ options=>"-glc_nec 10 -glc_smb .true. -envxml_dir .", + namelst=>"glc_smb=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "UpdateGlcNoGLCMec" =>{ options=>"-envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"TRUE", + conopts=>"-phys clm4_5", + }, + "UpdateGlcContradict" =>{ options=>"-glc_nec 10 -glc_present -envxml_dir .", + namelst=>"glc_do_dynglacier=.false.", + GLC_TWO_WAY_COUPLING=>"TRUE", + conopts=>"-phys clm4_5", + }, + "clm40andUpdateGlc" =>{ options=>"-glc_nec 10 -glc_present -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"TRUE", + conopts=>"-phys clm4_0", + }, + "useEDContradict" =>{ options=>"-ed_mode -envxml_dir .", + namelst=>"use_ed=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "useEDContradict2" =>{ options=>"-envxml_dir .", + namelst=>"use_ed=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "useEDclm40" =>{ options=>"-ed_mode -envxml_dir .", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_0", + }, + "usespitfireButNOTED" =>{ options=>"-envxml_dir .", + namelst=>"use_ed_spit_fire=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "useMEGANwithED" =>{ options=>"-ed_mode -envxml_dir . -megan", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, + "envxml_not_dir" =>{ options=>"-envxml_dir myuser_nl_clm", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + "envxml_emptydir" =>{ options=>"-envxml_dir xFail", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"", + }, + ); +foreach my $key ( keys(%failtest) ) { + system( "../configure -s ".$failtest{$key}{"conopts"}); + my $options = $failtest{$key}{"options"}; + my $namelist = $failtest{$key}{"namelst"}; + &make_env_run( GLC_TWO_WAY_COUPLING=>$failtest{$key}{"GLC_TWO_WAY_COUPLING"} ); + eval{ system( "$bldnml $options -namelist \"&clmexp $namelist /\" > $tempfile 2>&1 " ); }; + isnt( $?, 0, $key ); + system( "cat $tempfile" ); +} + +print "\n==================================================\n"; +print "Test ALL resolutions with CLM4.0 and CN \n"; +print "==================================================\n"; + +# Check for ALL resolutions with CN +my $mode = "CN"; +system( "../configure -s -bgc cn -phys clm4_0" ); +my $reslist = `../queryDefaultNamelist.pl -res list -s`; +my @resolutions = split( / /, $reslist ); +my @regional; +foreach my $res ( @resolutions ) { + chomp($res); + print "=== Test $res === \n"; + my $options = "-res $res -envxml_dir ."; + + if ( $res eq "512x1024" ) { + $options .= " -sim_year 1850"; + } elsif ( $res =~ /^([0-9]+x[0-9]+_[a-zA-Z]+)$/ ) { + push( @regional, $res ); + next; + } elsif ( $res eq "0.5x0.5" || + $res eq "0.1x0.1" || + $res eq "3x3min" || + $res eq "5x5min" || + $res eq "10x10min" || + $res eq "0.125x0.125" || + $res eq "0.33x0.33" || + $res eq "1km-merge-10min" ) { + next; + } + + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); print "\n"; +} + +print "\n==================================================\n"; +print " Test important resolutions for CLM4.5 and BGC\n"; +print "==================================================\n"; + +system( "../configure -s -phys clm4_5" ); +my @resolutions = ( "10x15", "ne30np4", "ne120np4", "ne16np4", "0.125x0.125", "1.9x2.5", "0.9x1.25" ); +my @regional; +my $nlbgcmode = "bgc"; +my $mode = "clm45-$nlbgcmode"; +foreach my $res ( @resolutions ) { + chomp($res); + print "=== Test $res === \n"; + my $options = "-res $res -envxml_dir . -bgc $nlbgcmode"; + + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); print "\n"; +} + +print "\n==================================================\n"; +print " Test all use-cases \n"; +print "==================================================\n"; + +# Run over all use-cases... +my $list = `$bldnml -use_case list 2>&1 | grep "use case"`; +my @usecases; +if ( $list =~ /build-namelist : use cases : (.+)$/ ) { + my @usecases = split( / /, $list ); +} else { + die "ERROR:: Trouble getting list of use-cases\n"; +} +foreach my $usecase ( @usecases ) { + $options = "-use_case $usecase -envxml_dir ."; + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "options: $options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} + +print "\n==================================================\n"; +print "Test single-point regional cases \n"; +print "==================================================\n"; + +# Run over single-point regional cases +foreach my $res ( @regional ) { + $mode = "$res"; + system( "../configure -s -sitespf_pt $res" ); + &make_env_run(); + eval{ system( "$bldnml -envxml_dir . > $tempfile 2>&1 " ); }; + is( $@, '', "$res" ); + $cfiles->checkfilesexist( "$res", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$res", $mode ); + $cfiles->comparefiles( "$res", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$res", $mode ); + } + &cleanup(); +} + +print "\n==================================================\n"; +print "Test crop resolutions \n"; +print "==================================================\n"; + +# Check for crop resolutions +my $mode = "crop"; +system( "../configure -s -crop on -bgc cn" ); +my @crop_res = ( "10x15", "1.9x2.5" ); +foreach my $res ( @crop_res ) { + $options = "-res $res -envxml_dir ."; + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} +print "\n==================================================\n"; +print " Test glc_mec resolutions \n"; +print "==================================================\n"; + +# Check for glc_mec resolutions +my $mode = "standard"; +system( "../configure -s -phys clm4_5 -bgc bgc" ); +my @glc_res = ( "48x96", "0.9x1.25", "1.9x2.5" ); +my @use_cases = ( "1850-2100_rcp2.6_glacierMEC_transient", + "1850-2100_rcp4.5_glacierMEC_transient", + "1850-2100_rcp6_glacierMEC_transient", + "1850-2100_rcp8.5_glacierMEC_transient", + "1850_glacierMEC_control", + "2000_glacierMEC_control", + "20thC_glacierMEC_transient", + ); +my $GLC_NEC = 10; +foreach my $res ( @glc_res ) { + foreach my $usecase ( @usecases ) { + $options = "-glc_nec $GLC_NEC -res $res -use_case $usecase -envxml_dir . "; + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); + } +} +# Transient 20th Century simulations +my $mode = "standard"; +system( "../configure -s" ); +my @tran_res = ( "48x96", "0.9x1.25", "1.9x2.5", "ne30np4", "ne60np4", "ne120np4", "10x15", "1x1_tropicAtl" ); +my $usecase = "20thC_transient"; +my $GLC_NEC = 0; +foreach my $res ( @tran_res ) { + $options = "-res $res -use_case $usecase -envxml_dir . "; + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); +} +# Transient rcp scenarios +my $mode = "standard"; +system( "../configure -s" ); +my @tran_res = ( "48x96", "0.9x1.25", "1.9x2.5", "ne30np4", "10x15" ); +foreach my $usecase ( "1850-2100_rcp2.6_transient", "1850-2100_rcp4.5_transient", "1850-2100_rcp6_transient", "1850-2100_rcp8.5_transient" ) { + foreach my $res ( @tran_res ) { + $options = "-res $res -use_case $usecase -envxml_dir . "; + &make_env_run(); + eval{ system( "$bldnml $options > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); + } +} + +print "\n==================================================\n"; +print "Test clm4.5/clm5.0 resolutions \n"; +print "==================================================\n"; + +foreach my $phys ( "clm4_5", 'clm5_0' ) { + my $mode; + if ( $phys eq "clm4_5" ) { + $mode = "phys45"; + } else { + $mode = "phys50"; + } + system( "../configure -s -phys ".$phys ); + my $clmoptions = "-bgc bgc -envxml_dir ."; + my @clmres = ( "ne16np4", "ne120np4", "10x15", "48x96", "0.9x1.25", "1.9x2.5", "360x720cru" ); + foreach my $res ( @clmres ) { + $options = "-res $res -envxml_dir . "; + &make_env_run( ); + eval{ system( "$bldnml $options $clmoptions > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); + } + $mode .= "-crop"; + system( "../configure -s -phys ".$phys ); + my $clmoptions = "-bgc cn -crop"; + my $res = "1.9x2.5"; + $options = "-res $res -irrig .true. -crop -bgc cn -envxml_dir ."; + &make_env_run(); + eval{ system( "$bldnml $options $clmoptions > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", "$mode", $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); + # Run ED mode for several resolutions + $mode = "${phys}-ED"; + system( "../configure -s -phys ".$phys ); + my $clmoptions = "-bgc cn -envxml_dir . -ed_mode -no-megan"; + my @clmres = ( "1x1_brazil", "5x5_amazon", "10x15", "1.9x2.5" ); + foreach my $res ( @clmres ) { + $options = "-res $res"; + &make_env_run( ); + eval{ system( "$bldnml $options $clmoptions > $tempfile 2>&1 " ); }; + is( $@, '', "$options" ); + $cfiles->checkfilesexist( "$options", $mode ); + system( "diff lnd_in lnd_in.default.standard" ); + $cfiles->shownmldiff( "default", "standard" ); + if ( defined($opts{'compare'}) ) { + $cfiles->doNOTdodiffonfile( "$tempfile", "$options", $mode ); + $cfiles->comparefiles( "$options", $mode, $opts{'compare'} ); + } + if ( defined($opts{'generate'}) ) { + $cfiles->copyfiles( "$options", $mode ); + } + &cleanup(); + } +} +&cleanup(); + +system( "/bin/rm $finidat" ); + +print "\n==================================================\n"; +print " Dumping output \n"; +print "==================================================\n"; + +$xFail->parseOutput($captOut); + +print "Successfully ran all testing for build-namelist\n\n"; + +&cleanup( "config" ); +system( "/bin/rm lnd_in.default" ); +system( "/bin/rm $tempfile" ); + +sub cleanup { +# +# Cleanup files created +# + my $type = shift; + + print "Cleanup files created\n"; + system( "/bin/rm env_run.xml" ); + if ( defined($type) ) { + if ( $type eq "config" ) { + system( "/bin/rm Filepath config_cache.xml CESM_cppdefs" ); + } + } else { + system( "/bin/rm $tempfile *_in" ); + } +} + diff --git a/components/clm/bld/unit_testers/myuser_nl_clm b/components/clm/bld/unit_testers/myuser_nl_clm new file mode 100644 index 0000000000..e34958ca60 --- /dev/null +++ b/components/clm/bld/unit_testers/myuser_nl_clm @@ -0,0 +1,3 @@ +&clm_inparm +fsurdat = "$DIN_LOC_ROOT/lnd/clm2/PTCLMmydatafiles/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr2000_clm4_5_c131122.nc" +/ diff --git a/components/clm/bld/unit_testers/xFail/expectedClmTestFails.xml b/components/clm/bld/unit_testers/xFail/expectedClmTestFails.xml new file mode 100644 index 0000000000..12c954d38b --- /dev/null +++ b/components/clm/bld/unit_testers/xFail/expectedClmTestFails.xml @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + goldbach not recognized + goldbach not recognized + goldbach not recognized + + + + + + + + Doesn't check for valid values + + + + + + + + + + + + Internal compiler error + + + + + diff --git a/components/clm/bld/unit_testers/xFail/expectedFail.pm b/components/clm/bld/unit_testers/xFail/expectedFail.pm new file mode 100755 index 0000000000..04fc32726f --- /dev/null +++ b/components/clm/bld/unit_testers/xFail/expectedFail.pm @@ -0,0 +1,667 @@ +=head1 expectedFail.pm + +Documentation for expectedFail.pm + +=head1 Overview + +The module expectedFail.pm supplies the capability of checking if a failed test is expected to fail. +It is called directly from either test_driver.sh (for batch and interactive tests) or build-namelist_test.pl. +Future plans involve integrating this module into cesm tests. + +=head1 Use Case + +This is a new feature being added to the existing CLM test infrastructure. The use case would roughly be +along the lines of: + + 1) Run the test suite (CLM batch,interactive or namelist) + 2) Search for test failures + a) Fix failed tests + b) -or- Add new xFail entries to XML file if a test is supposed to fail (eg. due to some missing resolution). + 3) Check for new tests that now pass. This is for modifying the ChangeLog. + 4) Update XML file by either adding new entries or removing old ones. + 5) update the ChangeLog to reflect important changes in test behavior (Tests that now pass that failed before, tests that + are now xFail, etc... + +=head2 Public methods + +There are two public methods needed. The "new" ctor and one of the parseOutput* methods. +Everything else is private. + + xFail::expectedFail->new + parseOutput + parseOutputCLM + +=head2 Private methods + + sub _searchExpectedFail + sub _readXml + sub _testNowPassing + sub _printOutput + sub _getTestType + sub _getMachInfo + +=cut + +package xFail::expectedFail; + +our $VERSION = '1.00'; + +use Cwd; +use strict; +use Getopt::Long; +use English; +use Scalar::Util qw(looks_like_number); + +my @testList={}; +my $DEBUG=0; + +my $pass=" PASS"; +my $fail=" FAIL"; +my $xfail="xFAIL"; + +############################################################################## +# +############################################################################## + +=head1 CTOR + +Constructor for the class. Reads in three arguments: + _callingName -> name of the script creating the new object + _compareGenerate -> compare or generate option + _totTests -> total number of tests to run + +Calls _readXml which reads the file expectedClmTestFails.xml and stores it memory +for later searches. + +returns: new object ($self) + +=cut + +############################################################################## +# +############################################################################## +sub new { + my ($class_name) = @_; + my $self = { + _className => shift, + _callingName => shift, + _compareGenerate => shift, + _totTests => shift, + _foundList => undef, + _numericalTestId => undef + }; + + if ($DEBUG) { + print "$self->{_callingName}\n"; + print "$self->{_compareGenerate}\n"; + } + + bless ($self, $class_name); + + $self->{_numericalTestId}=0; + $self->{_created} = 1; + + $self->_readXml(); + + return $self; +} + +############################################################################## +# +############################################################################## + +=head1 parseOutput + +parseOutput parsese the output from the build-namelist_test.pl script. It is similar +to, but not interchangable with parseOutputCLM. + +The only argument is that of the reference variable that contains the information dumped +by Test::More. + +returns: nothing + +=cut + +############################################################################## +# +############################################################################## +sub parseOutput +{ + + + my $report; + my $testId; + my @testName={}; + my $testReason; + + my ($self, $output) = @_ ; + + #_#=========================================== + #_# keep this in for logging + #_#=========================================== + print ("captured output is :: \n $output \n"); + + #_# split the output from Test::More output on newline + my @refList = split('\n', $output); + + #_# process any buffered output which happens when a subroutine from build-namelist_test.pl + #_# itself calls some testing routines + foreach my $refSplit (@refList) { + + #_# always look at the last element of refSplit since that will have the info. from the + #_# last test run + + my @outArr=split(/ /,$refSplit); + + if ($DEBUG) { + print ("\nxFail::expectedFail::parseOutput @outArr[0] \n"); + print ("xFail::expectedFail::parseOutput @outArr[1] \n"); + print ("xFail::expectedFail::parseOutput @outArr[2] \n"); + print ("xFail::expectedFail::parseOutput @outArr[3] \n"); + print ("xFail::expectedFail::parseOutput @outArr[4] \n"); + } + + my $size = @outArr-1; + + #_# first case, we have a passed (ok) test + if (@outArr[0] eq "ok") { + $self->{_numericalTestId}++; + + $report=$pass; + $testId=@outArr[1]; + @testName=@outArr[3..$size]; + $testReason=""; + + my ($retVal,$xFailText)=$self->_searchExpectedFail($testId); + + my $testReason=$self->_testNowPassing($testId,$retVal,$xFailText); + + if($DEBUG){ + print("$testReason \n"); + } + + $self->_printOutput($report,$testId,$testReason,@testName); + + + #_# deal with the case of a failed (not ok) test + } elsif (@outArr[0] eq "not") { + $self->{_numericalTestId}++; + + $testId=@outArr[2]; + my ($retVal,$xFailText)=$self->_searchExpectedFail($testId); + + if ($DEBUG) { + print ("xFail::expectedFail::parseOutput Id $retVal,$xFailText \n"); + } + + @testName=@outArr[4..$size]; + + if ($retVal eq "TRUE"){ + #_# found an expected FAIL (xFAIL) + $report=$xfail; + $testReason= ""; + } else { + #_# print a regular FAIL + $report=$fail; + $testReason=""; + } + + $self->_printOutput($report,$testId,$testReason,@testName); + + } else { + #_# skipping line. Trying to parse error code from Test::More + } + + } + + #_# this resets the reference that points to $output (\$captOut) on the caller side + @_[1]=""; + +} + +############################################################################## +# +############################################################################## + +=head1 parseOutputCLM + +parseOutputCLM parsese the output from the test_driver.sh script. It is similar +to, but not interchangable with parseOutput. + +parseOutputCLM takes one arguments: + $statFoo-> the name of the td..status file + +returns: nothing + +=cut + +############################################################################## +# +############################################################################## +sub parseOutputCLM +{ + + my $report; + my $testId; + my @testName={}; + my $testReason; + + my ($self, $statFoo) = @_ ; + + open(FOO, "< $statFoo"); # open for input + open(FOO_OUT, "> $statFoo.xFail"); # open for input + + my(@reportLines); + + while () { + + my($line) = $_; + + my @outArr=split(/ /,$line); + if (looks_like_number(@outArr[0])) { + + $self->{_numericalTestId}++; + + my $num=sprintf("%03d", $self->{_numericalTestId}); + my $totNum=sprintf("%03d", $self->{_totTests}); + + #_# last element has the pass/fail info. + chomp(@outArr[-1]); + my $repPass=substr(@outArr[-1], -4, 4); + + if ($DEBUG) { + print ("xFail::expectedFail::parseOutput @outArr[0] \n"); + print ("xFail::expectedFail::parseOutput @outArr[1] \n"); + print ("xFail::expectedFail::parseOutput @outArr[2] \n"); + print ("xFail::expectedFail::parseOutput @outArr[3] \n"); + print ("xFail::expectedFail::parseOutput @outArr[4] \n"); + print ("xFail::expectedFail::parseOutput @outArr[5] \n"); + print ("xFail::expectedFail::parseOutput @outArr[6] \n"); + print ("xFail::expectedFail::parseOutput @outArr[-1] \n"); + print ("xFail::expectedFail::parseOutput $repPass \n"); + } + + my $size = @outArr-1; + if ($DEBUG) { + print ("size of line $size \n"); + } + my $endOfDesc=$size-1; + + if ($repPass eq "PASS") { + $report=$pass; + $testId=@outArr[1]; + @testName=@outArr[2..$endOfDesc]; + + my ($retVal,$xFailText)=$self->_searchExpectedFail($testId); + + my $testReason=$self->_testNowPassing($testId,$retVal,$xFailText); + + #_# print out the test results + print FOO_OUT ("$num/$totNum <$report> $testReason \n"); + + } else { + $testId=@outArr[1]; + my ($retVal,$xFailText)=$self->_searchExpectedFail($testId); + + if ($DEBUG) { + print ("xFail::expectedFail::parseOutput Id $retVal,$xFailText \n"); + } + + @testName=@outArr[2..$endOfDesc]; + + if ($retVal eq "TRUE"){ + #_# found an expected FAIL (xFAIL) + $report=$xfail; + $testReason= ""; + } else { + #_# print a regular FAIL + $report=$fail; + $testReason=""; + } + + #_# print out the test results + print FOO_OUT ("$num/$totNum <$report> $testReason \n"); + + } + + } else { + print FOO_OUT $line; + } + } + close(FOO); + close(FOO_OUT); +} + +############################################################################## +# +############################################################################## + +=head1 _searchExpectedFail + +searches the list of expected fails for a match with testId. + +_searchExpectedFail takes one arguments: + $testId-> the test id (numerical or string) that we want to search for + +returns: $retVal (TRUE or FALSE) if id was found + $text text from XML file + +=cut + +############################################################################## +# +############################################################################## +sub _searchExpectedFail +{ + my ( $self,$testId) = @_; + + #search through list for test ID + my $retVal="FALSE"; + + if ($DEBUG) { + print ("here 2 Id $self->{_foundList} \n"); + } + if ($self->{_foundList} eq "FALSE"){ + if ($DEBUG) { + print ("returning early Id \n"); + } + return $retVal; + } + + my $failType; + my $text; + foreach my $tL (@testList) { + my %tAtts = $tL->get_attributes(); + my $tid=$tAtts{'testId'}; + if ($DEBUG) { + print ("_seachExpectedFail Id $tid $testId \n"); + } + if ($tid eq $testId) { + if ($DEBUG) { + print ("here Id \n"); + } + #~# found the test we're looking for + $text=$tL->get_text(); + $failType=$tAtts{'failType'}; + if ($failType eq "xFail"){ + $retVal="TRUE"; + } + } + } + return ($retVal,$text); +} + +############################################################################## +# +############################################################################## + +=head1 _readXml + +reads the xml file for a particular machine, compiler, test type and (compare +| generate) setup and saves it in memory for searching by _searchExpectedFail. + +_readXml takes no arguments + +returns: nothing + +=cut + +############################################################################## +# +############################################################################## +sub _readXml +{ + my ( $self ) = @_; + + #Figure out where configure directory is and where can use the XML/Lite module from + my $ProgName; + ($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program + my $ProgDir = $1; # name of directory where program lives + + my $cwd = getcwd(); # current working directory + my $cfgdir; + + if ($ProgDir) { $cfgdir = $ProgDir; } + else { $cfgdir = $cwd; } + + #----------------------------------------------------------------------------------------------- + # Add $cfgdir to the list of paths that Perl searches for modules + my @dirs = ( $cfgdir, "$cfgdir/perl5lib", + "$cfgdir/../../../../cime/utils/perl5lib" + ); + unshift @INC, @dirs; + my $result = eval "require XML::Lite"; + if ( ! defined($result) ) { + die <<"EOF"; + ** Cannot find perl module \"XML/Lite.pm\" from directories: @dirs ** +EOF + } + + #----------------------------------------------------------------------------------------------- + + my ($machine,$compiler)=_getMachInfo(); + + my $testType=$self->_getTestType($self->{_callingName}); + + + my $xmlFile=undef; + if ($testType eq "clmInteractive" || $testType eq "clmBatch") { + $xmlFile = "$cfgdir/expectedClmTestFails.xml"; + } elsif ($testType eq "namelistTest") { + $xmlFile = "xFail/expectedClmTestFails.xml"; + } else { + $xmlFile = "xFail/expectedClmTestFails.xml"; + } + my $xml = XML::Lite->new($xmlFile); + + my $root = $xml->root_element(); + + if ($DEBUG) { + print "_readXml $self->{_callingName}\n"; + print "_readXml $self->{_compareGenerate}\n"; + print "_readXml $xmlFile \n"; + print ("_readXml Debug testType $testType \n"); + print ("_readXml Debug machine $machine \n"); + print ("_readXml Debug compiler $compiler \n"); + } + + # Check for valid root node + my $name = $root->get_name(); + $name eq "expectedFails" or die + "readExpectedFail.pm::_readXml :: $xmlFile is not a file that contains expected test failures\n"; + + my @e = $xml->elements_by_name($testType); + + $self->{_foundList}="FALSE"; + + ### populate list of tests for a specfic test type, machine and compiler + ### there's got to be a better way to write this + while ( my $e = shift @e ) { + my @mChildren = $e->get_children(); + foreach my $mChild (@mChildren) { + my $mName=$mChild->get_name(); + if ($mName eq $machine){ + my @cChildren = $mChild->get_children(); + foreach my $cChild (@cChildren) { + my $cName=$cChild->get_name(); + if ($cName eq $compiler) { + my @cgChildren=$cChild->get_children(); + foreach my $cgChild (@cgChildren) { + my $cgName=$cgChild->get_name(); + if($cgName eq $self->{_compareGenerate}){ + @testList=$cgChild->get_children(); + $self->{_foundList}="TRUE"; + last; + } + } + } + } + } + } + } + if ($DEBUG) { + print ("here 1 $self->{_foundList} \n"); + } +} + +############################################################################## +# +############################################################################## + +=head1 _testNowPassing + +reads the xml file for a particular machine, compiler, test type and (compare +| generate) setup and saves it in memory for searching by _searchExpectedFail. + +_testNowPassing takes three arguments: + $id - test id to print out + $retVal - TRUE or FALSE. Was the id found in the expected fail list + $xmlText - text from the XML notes section of the file. (Currently not used, + may be used in future). + + returns: a text string + +=cut + +############################################################################## +# +############################################################################## +sub _testNowPassing +{ + + my ($self, $id, $retVal, $xmlText) = @_ ; + my $text=undef; + + if ($retVal eq "TRUE") { + #_# found a test that passes now, but is listed as an xFail + $text = "\n"; + + } else { + #_# this test passes and was not previously listed as an xFail + #_# noOp + } + + return $text; +} + +############################################################################## +# +############################################################################## + +=head1 _printOutput + +method that prints output for status files. + +_printOutput takes four arguments: + $report - PASS,FAIL,xFAIL + $testId - test id to print out + $testReason - for xFAIL and new PASSES, additional reporting + @testName - test description from original test + + returns: a text string + +=cut + +############################################################################## +# +############################################################################## +sub _printOutput +{ + + my ($self, $report, $testId, $testReason, @testName) = @_ ; + + #_# print out the test results + my $num=sprintf("%03d", $self->{_numericalTestId}); + my $totNum=sprintf("%03d", $self->{_totTests}); + print ("$num/$totNum <$report> $testReason \n"); + +} + +############################################################################## +# +############################################################################## + +=head1 _getTestType + +method that takes the name of the calling script and returns the type of +test. Used for searching the expected fail list. + +_getTestType takes four arguments: + $name - name of calling script + + returns: $type, the type of test + +=cut + +############################################################################## +# +############################################################################## +sub _getTestType +{ + + my ($self, $name) = @_ ; + + if($DEBUG){ + print ("_getTestType $name"); + } + + my %testTypes = ( + "build-namelist_test.pl" => "namelistTest", + "test_driver.sh-i" => "clmInteractive", + "test_driver.sh" => "clmBatch", + "clm-cesm.sh" => "cesm" + ); + + my $type = $testTypes {lc $name} || "unknown"; + return $type; + +} + +############################################################################## +# +############################################################################## + +=head1 _getMachInfo + +method that figures out on what platform this is running and returns a 2 digit +machine identifier and the compiler. This will eventually contain multiple +compiler for various machines. + +_getMachInfo takes no arguments + + returns: $mach - the machine I'm running on + $comp - the compiler being used + +=cut + +############################################################################## +# +############################################################################## +sub _getMachInfo +{ + + my $name=`uname -n`; + $name = substr($name, 0, 2); + + my %machNames = ( + "ys" => "yellowstone", + "fr" => "frankfurt" + ); + + my %compNames = ( + "ys" => "INTEL", + "fr" => "INTEL" + ); + + my $mach = $machNames {lc $name} || "unknown"; + my $comp = $compNames {lc $name} || "unknown"; + + return ($mach,$comp); + +} + +# A Perl module must end with a true value or else it is considered not to +# have loaded. By convention this value is usually 1 though it can be +# any true value. A module can end with false to indicate failure but +# this is rarely used and it would instead die() (exit with an error). +1; diff --git a/components/clm/bld/unit_testers/xFail/wrapClmTests.pl b/components/clm/bld/unit_testers/xFail/wrapClmTests.pl new file mode 100755 index 0000000000..28238b9d5d --- /dev/null +++ b/components/clm/bld/unit_testers/xFail/wrapClmTests.pl @@ -0,0 +1,128 @@ +#!/usr/bin/env perl + +#-# ========================================================================================= + +=head1 wrapClmTest.pl + +=head1 Overview + +This is a wrapper script that is called from test_driver.sh for either interactive or batch +tests. It calls the CTOR for the xFail::expectedFail.pm module and also parses the td*.status +file to create a new file with xFails listed. + +It takes the following arguments: + + numberOfTests -> number of tests from test_driver.sh + statusFile -> name of the td..status file + callingScript -> name of script calling this. For test_driver.sh it may be one of: + 1) test_driver.sh-i for interactive tests + 2) test_driver.sh for batch tests + +=head1 Notes + +This script may be run standalone which is useful for testing purposes. + +=cut + +#-# ========================================================================================= + +use strict; +use Getopt::Long; +use English; +use Cwd; +use Scalar::Util qw(looks_like_number); + +my $DEBUG=0; + +sub usage { + die < 0, + numberOfTests => undef, + statusFile => undef, + callingScript => undef, + ); + +GetOptions( + "h|help" => \$opts{'help'}, + "numberOfTests=s" => \$opts{'numberOfTests'}, + "statusFile=s" => \$opts{'statusFile'}, + "callingScript=s" => \$opts{'callingScript'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +my $statFoo = undef; +my $nTests = undef; +my $script= undef; + +if (defined($opts{'statusFile'})) { + $statFoo = $opts{'statusFile'}; +} +if (defined($opts{'numberOfTests'})) { + $nTests = $opts{'numberOfTests'}; +} +if (defined($opts{'callingScript'})) { + $script = $opts{'callingScript'}; +} + +my ( $self ) = @_; + +#Figure out where configure directory is and where can use the XML/Lite module from +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +my $cwd = getcwd(); # current working directory +my $cfgdir; + +if ($ProgDir) { $cfgdir = $ProgDir; } +else { $cfgdir = $cwd; } + +#----------------------------------------------------------------------------------------------- +# Add $cfgdir to the list of paths that Perl searches for modules +#----------------------------------------------------------------------------------------------- +my @dirs = ( $cfgdir, + "$cfgdir/../", + "$cfgdir/../../../../../cime/utils/perl5lib"); +unshift @INC, @dirs; +my $result = eval "require expectedFail"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"xFail/expectedFail.pm\" from directories: @dirs ** +EOF +} + +#_# ==================================== +#_# setup work complete. Now parse file +#_# ==================================== + +if ($DEBUG) { + print (" wrapClmTests.pl:: calling script $script \n"); + print (" wrapClmTests.pl:: number of tests $nTests \n"); + print (" wrapClmTests.pl:: processing $statFoo \n"); +} + +#_# compGen not used for CLM batch or interactive tests, but we use "compare" as the default in this case +my $compGen="compare"; +my $xFail = xFail::expectedFail->new($script,$compGen,$nTests); + +$xFail->parseOutputCLM($statFoo); + +exit(0); diff --git a/components/clm/bld/user_nl_clm b/components/clm/bld/user_nl_clm new file mode 100644 index 0000000000..b52f3b6d08 --- /dev/null +++ b/components/clm/bld/user_nl_clm @@ -0,0 +1,24 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! 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 irrigate by the CLM_BLDNML_OPTS -irrig 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) +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- + diff --git a/components/clm/cimetest/ExpectedTestFails.xml b/components/clm/cimetest/ExpectedTestFails.xml new file mode 100644 index 0000000000..6f2b451dfd --- /dev/null +++ b/components/clm/cimetest/ExpectedTestFails.xml @@ -0,0 +1,42 @@ + + + + FAIL ERS_D_Mmpi-serial_Ld5.1x1_brazil.ICLM45ED.yellowstone_intel.clm-edTest + FAIL ERS_E_Ld9.f45_g37.I.yellowstone_intel.clm-default + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel + FAIL ERS_D_P112x1_Ld211.f10_f10.ICNCROP.yellowstone_intel.clm-crop + FAIL ERS_P192x1_Ld211.f19_g16.ICNDVCROP.yellowstone_intel.clm-crop + CFAIL CME_Ld5.f10_f10.ICN.yellowstone_intel + CFAIL CME_Ly4.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-monthly + FAIL NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default + RUN NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default + + RUN SMS_Ld5.f19_g16.ICLM45ED.yellowstone_gnu.clm-edTest + FAIL ERS_D_Mmpi-serial_Ld5.1x1_brazil.ICLM45ED.yellowstone_gnu.clm-edTest + RUN ERS_D_Mmpi-serial_Ld5.1x1_brazil.ICLM45ED.yellowstone_gnu.clm-edTest + + RUN ERP_P15x2_Lm36.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrig_o3_reduceOutput + FAIL ERP_P15x2_Lm36.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrig_o3_reduceOutput + FAIL ERP_P15x2_D_Ld5.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-ciso + RUN ERP_D_Ld5.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso + RUN ERP_D_Ld5.hcru_hcru.ICRUCN.yellowstone_pgi.clm-default + RUN ERI_Ld9.ne30_g16.I4804.yellowstone_pgi.clm-default + FAIL ERP_D_Ld5.f10_f10.I.yellowstone_pgi.clm-default + FAIL PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrig_o3_reduceOutput + + FAIL PET_P12x2_D.f10_f10.I1850CLM45BGC.hobart_intel.clm-ciso + + CFAIL PET_P12x2_D.f10_f10.I1850CLM45BGC.hobart_nag.clm-ciso + FAIL ERI.f19_g16.ICLM45BGC.hobart_nag.clm-reduceOutput + RUN ERS.f10_f10.I20TRCLM45BGC.hobart_nag.clm-reduceOutput + FAIL SMS.f09_g16.ICRUCLM45.hobart_nag.clm-af_bias_v5 + CFAIL PET_P12x2_D.f10_f10.I1850CLM45BGC.hobart_nag.clm-ciso + RUN SMS_D_Ld1.f10_f10.ICRUCLM45.hobart_nag.clm-af_bias_v5 + + FAIL PET_P12x2_D.f10_f10.I1850CLM45BGC.hobart_pgi.clm-ciso + + FAIL ERH_D.f19_g16.I1850CLM45CN.edison_intel.clm-default + FAIL ERI_D.ne30_g16.ICLM45BGC.edison_intel.clm-vrtlay + FAIL ERS_Ld211_D_P144x1.f10_f10.ICNCP.edison_intel.clm-crop + + diff --git a/components/clm/cimetest/testlist_clm.xml b/components/clm/cimetest/testlist_clm.xml new file mode 100644 index 0000000000..259978f76c --- /dev/null +++ b/components/clm/cimetest/testlist_clm.xml @@ -0,0 +1,1443 @@ + + + + + + yellowstone + + + null + + + + + hobart + + + + + yellowstone + + + + + edison + yellowstone + + + edison + yellowstone + yellowstone + + + + + edison + edison + edison + goldbach + goldbach + janus + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + + + + + yellowstone + + + + + + + yellowstone + + + + + null + + + + + null + + + + + null + + + + + null + + + + + edison + yellowstone + + + yellowstone + + + edison + + + + + null + + + + + null + + + + + null + + + + + null + + + + + null + + + + + + + null + + + + + hobart + + + + + hobart + + + + + yellowstone + yellowstone + + + edison + + + null + + + + + + + yellowstone + + + edison + yellowstone + + + edison + + + yellowstone + + + hobart + + + yellowstone + yellowstone + yellowstone + + + hobart + hobart + + + yellowstone + yellowstone + yellowstone + + + edison + + + + + edison + yellowstone + + + yellowstone + + + edison + goldbach + yellowstone + yellowstone + + + + + + + null + + + + + edison + edison + yellowstone + yellowstone + + + goldbach + + + + + + + goldbach + + + + + + + null + + + + + hobart + + + + + edison + yellowstone + + + yellowstone + + + edison + + + + + yellowstone + + + + + edison + hopper + + + + + + + edison + yellowstone + + + + + null + + + + + + + null + + + + + edison + yellowstone + + + + + + + null + + + + + + + null + + + + + + + hobart + janus + yellowstone + yellowstone + yellowstone + + + + + null + + + + + hobart + + + + + + + hobart + + + goldbach + + + edison + yellowstone + + + + + null + + + + + edison + yellowstone + + + yellowstone + + + hobart + + + + + edison + yellowstone + yellowstone + + + + + + + yellowstone + + + + + yellowstone + + + hobart + + + + + + + null + + + + + null + + + + + janus + yellowstone + yellowstone + yellowstone + + + + + edison + yellowstone + + + null + + + + + + + null + + + + + null + + + + + + + null + + + + + null + + + + + yellowstone + + + + + yellowstone + + + + + yellowstone + + + + + edison + yellowstone + + + + + hobart + + + yellowstone + yellowstone + + + + + hobart + yellowstone + yellowstone + + + hobart + yellowstone + yellowstone + + + goldbach + hobart + yellowstone + yellowstone + yellowstone + yellowstone + + + + + + + yellowstone + + + + + yellowstone + + + + + edison + yellowstone + yellowstone + + + edison + yellowstone + yellowstone + + + + + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + + + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + + + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + yellowstone + + + yellowstone + + + edison + yellowstone + yellowstone + yellowstone + + + hobart + + + edison + yellowstone + yellowstone + + + edison + goldbach + yellowstone + yellowstone + yellowstone + + + hobart + + + yellowstone + + + hobart + + + yellowstone + + + yellowstone + + + hobart + + + yellowstone + + + yellowstone + + + + + edison + yellowstone + + + edison + yellowstone + + + yellowstone + + + yellowstone + yellowstone + + + + + edison + edison + yellowstone + + + goldbach + + + yellowstone + + + yellowstone + + + + + + + yellowstone + + + yellowstone + + + hobart + + + + + yellowstone + + + + + yellowstone + + + yellowstone + + + yellowstone + yellowstone + yellowstone + + + edison + + + goldbach + + + yellowstone + + + + + yellowstone + + + edison + + + + + + + yellowstone + + + yellowstone + + + + + yellowstone + + + edison + + + + + yellowstone + + + edison + + + + + + + yellowstone + yellowstone + + + yellowstone + + + + + + + yellowstone + + + + + + + yellowstone + yellowstone + + + + + hobart + yellowstone + + + + + yellowstone + yellowstone + + + + + yellowstone + yellowstone + + + + + + + edison + yellowstone + + + + + + + edison + yellowstone + + + edison + yellowstone + + + + + edison + yellowstone + + + edison + yellowstone + + + + + edison + yellowstone + + + + + + + yellowstone + + + + + edison + yellowstone + + + hobart + + + + + edison + + + edison + + + yellowstone + + + yellowstone + + + + + + + hobart + + + edison + janus + yellowstone + yellowstone + yellowstone + yellowstone + + + + + edison + eos + hopper + titan + + + + + edison + + + yellowstone + + + + + edison + yellowstone + + + + + + + edison + + + yellowstone + + + + + + + null + + + + + + + yellowstone + + + + + edison + yellowstone + yellowstone + + + hobart + + + + + null + + + + + + + edison + hopper + janus + + + + + edison + yellowstone + + + yellowstone + + + null + + + + + + + edison + edison + yellowstone + + + + + + + yellowstone + yellowstone + + + edison + yellowstone + yellowstone + + + hobart + + + edison + yellowstone + yellowstone + yellowstone + + + hobart + + + + + edison + + + edison + + + yellowstone + yellowstone + + + yellowstone + yellowstone + + + + + + + edison + yellowstone + + + null + + + + + + + null + + + + + + + yellowstone + + + + + null + + + + + edison + + + yellowstone + + + edison + yellowstone + yellowstone + + + + + + + edison + yellowstone + + + + + + + null + + + + + + + null + + + + + + + null + + + + + null + + + + + + + yellowstone + + + + + null + + + + + + + null + + + + + + + null + + + + + + + null + + + + + hobart + + + + + + + null + + + + + null + + + + + + + null + + + + + null + + + + + + + null + + + + + edison + + + yellowstone + + + + + + + null + + + + + null + + + + + + + null + + + + + + + goldbach + + + + + null + + + + + null + + + + + null + + + + + null + + + + + null + + + + + null + + + + + + + null + + + + + + + yellowstone + + + yellowstone + + + yellowstone + + + + + goldbach + yellowstone + yellowstone + + + hobart + + + yellowstone + + + + + edison + + + + + + + edison + yellowstone + yellowstone + + + + + bluewaters + edison + eos + hopper + titan + + + + + null + + + + + + + yellowstone + + + edison + + + + + null + + + + + + + null + + + + + + + null + + + + + null + + + + + hobart + + + + + null + + + + + null + + + + + null + + + + + + + hobart + + + + + edison + yellowstone + yellowstone + + + + + + + null + + + + + null + + + + + hobart + + + + + edison + yellowstone + + + + + null + + + + + null + + + + + + + null + + + + + + + null + + + + + null + + + + + null + + + + + null + + + + + null + + + + + + + null + + + + + edison + yellowstone + + + + + + + null + + + + + + + null + + + + + null + + + + + edison + yellowstone + + + + + null + + + + + null + + + + + + + null + + + + + null + + + janus + yellowstone + yellowstone + yellowstone + + + + + edison + goldbach + goldbach + hopper + + + eastwind + evergreen + olympus + yellowstone + + + + + edison + hopper + janus + yellowstone + yellowstone + yellowstone + + + + + goldbach + goldbach + janus + janus + + + + diff --git a/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/user_nl_clm new file mode 100644 index 0000000000..f225dede82 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/NoVSNoNI/user_nl_clm @@ -0,0 +1,4 @@ + anoxia = .true. + use_vertsoilc = .false. + use_nitrif_denitrif = .false. + hist_wrtch4diag = .true. diff --git a/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/user_nl_clm new file mode 100644 index 0000000000..d03efa953b --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/SNICARFRC/user_nl_clm @@ -0,0 +1 @@ + use_snicar_frc = .true. diff --git a/components/clm/cimetest/testmods_dirs/clm/USUMB/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/USUMB/user_nl_clm new file mode 100644 index 0000000000..f180813b54 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/USUMB/user_nl_clm @@ -0,0 +1,8 @@ + wrtdia = .true. + hist_ndens = 1 +! user_nl_clm namelist options written by PTCLM: +! ./PTCLM.py -m yellowstone_intel -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --cesm_root /glade/p/work/erik/clm_clean_trunk/ + fsurdat = '$DIN_LOC_ROOT/lnd/clm2/PTCLMmydatafiles.c140317/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr2000_clm4_5_c140121.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 + diff --git a/components/clm/cimetest/testmods_dirs/clm/USUMB/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/USUMB/xmlchange_cmnds new file mode 100755 index 0000000000..ad182df983 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/USUMB/xmlchange_cmnds @@ -0,0 +1,16 @@ +# xmlchange commands written by PTCLM: +# ./PTCLM.py -m yellowstone_intel -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --cesm_root /glade/p/work/erik/clm_clean_trunk/ +./xmlchange CLM_USRDAT_NAME=1x1pt_US-UMB +./xmlchange DATM_CLMNCEP_YR_START=1999 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange ATM_DOMAIN_PATH='$DIN_LOC_ROOT/lnd/clm2/PTCLMmydatafiles.c140317/1x1pt_US-UMB' +./xmlchange LND_DOMAIN_PATH='$DIN_LOC_ROOT/lnd/clm2/PTCLMmydatafiles.c140317/1x1pt_US-UMB' +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140121.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140121.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1999-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1999 +./xmlchange DIN_LOC_ROOT_CLMFORC='$DIN_LOC_ROOT/lnd/clm2/PTCLMmydatafiles.c140317' diff --git a/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_clm new file mode 100644 index 0000000000..c7cfe279ee --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_clm @@ -0,0 +1 @@ +use_lai_streams = .true. diff --git a/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_datm b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_datm new file mode 100644 index 0000000000..6fb5f55ac4 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/user_nl_datm @@ -0,0 +1 @@ +bias_correct = 'BC.CRUNCEP.GPCP.Precip' diff --git a/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/xmlchange_cmnds new file mode 100644 index 0000000000..5f4b42eb3c --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/af_bias_v5/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange DATM_MODE=CLMCRUNCEP_V5 diff --git a/components/clm/cimetest/testmods_dirs/clm/allActive/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/allActive/user_nl_clm new file mode 100644 index 0000000000..8317963619 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/allActive/user_nl_clm @@ -0,0 +1,11 @@ +! This namelist tests turning all points to 'active'; the point of +! this is to make sure that all points in memory could conceivably +! become active in a dynamic landunit run without causing any +! trouble. This should be tested with a _D test. + +! Note that we don't necessarily expect this to work with an initial +! conditions file that wasn't itself generated with all_active = +! .true., so we set finidat = ' ' for this test. + +all_active = .true. +finidat = ' ' diff --git a/components/clm/cimetest/testmods_dirs/clm/ciso/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/ciso/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ciso/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/ciso/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/ciso/user_nl_clm new file mode 100644 index 0000000000..0a40cd33a8 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ciso/user_nl_clm @@ -0,0 +1,2 @@ + use_c13 = .true. + use_c14 = .true. diff --git a/components/clm/cimetest/testmods_dirs/clm/cn_conly/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/cn_conly/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/cn_conly/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/cn_conly/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/cn_conly/user_nl_clm new file mode 100644 index 0000000000..926e36cf39 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/cn_conly/user_nl_clm @@ -0,0 +1 @@ + suplnitro = 'ALL' diff --git a/components/clm/cimetest/testmods_dirs/clm/crop/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/crop/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/crop/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/crop/user_nl_clm new file mode 100644 index 0000000000..7ba5b8685b --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop/user_nl_clm @@ -0,0 +1,3 @@ + hist_fincl1 += 'GDD0', 'GDD8', 'GDD10', + 'GDD020', 'GDD820', 'GDD1020', + 'GDDPLANT', 'GDDTSOI', 'A5TMIN', 'A10TMIN' diff --git a/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/include_user_mods new file mode 100644 index 0000000000..23ea3745e6 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/include_user_mods @@ -0,0 +1 @@ +../crop diff --git a/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/user_nl_clm new file mode 100644 index 0000000000..b2a51bd5d5 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/cropMonthOutput/user_nl_clm @@ -0,0 +1,2 @@ + hist_nhtfrq = 0,-240 + hist_mfilt = 1,1 diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/README b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/README new file mode 100644 index 0000000000..cc1e484263 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/README @@ -0,0 +1,9 @@ +This directory points to datasets needed to test transient crops at f10 +resolution. + +Eventually, this testmods directory can be removed. However, it is needed for +now because we do not have an 1850 surface dataset for crops - see comment 3 in +. So, for now, we are pointing to +a year-2000 surface dataset for the transient run. This is a perfectly +acceptable thing to do, but making it work out-of-the-box would require +introducing some ugly one-off logic that I wanted to avoid. diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/include_user_mods new file mode 100644 index 0000000000..02ec13743f --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/include_user_mods @@ -0,0 +1 @@ +../cropMonthOutput diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/user_nl_clm new file mode 100644 index 0000000000..cccd9f83ad --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_f10/user_nl_clm @@ -0,0 +1,6 @@ +fsurdat = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/surfdata_10x15_78pfts_simyr2000_c150116.nc' +flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/landuse.timeseries_10x15_hist_78pfts_simyr1850-2005_c150203.nc' + +! Set check_dynpft_consistency to .false. because we currently use a year-2000 dataset rather than a year-1850 dataset. +! This setting can be removed once we use a year-1850 surface dataset, which is what is expected for transient runs. +check_dynpft_consistency = .false. diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/README b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/README new file mode 100644 index 0000000000..dfe52992b6 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/README @@ -0,0 +1,13 @@ +This directory points to datasets needed to test transient crops at the +smallville 1x1 resolution. + +Eventually, this testmods directory may be able to be removed. However, it is +needed for now because we do not have an 1850 surface dataset for crops - see +comment 3 in . So, for now, we +are pointing to a year-2000 surface dataset for the transient run. This is a +perfectly acceptable thing to do, but making it work out-of-the-box would +require introducing some ugly one-off logic that I wanted to avoid. + +However, we may need to keep this testmods directory around in order to point to +the landuse_timeseries file for this test case, which differs from typical files +in that it only goes up to year 1855 rather than 2000. diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/include_user_mods new file mode 100644 index 0000000000..02ec13743f --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/include_user_mods @@ -0,0 +1 @@ +../cropMonthOutput diff --git a/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/user_nl_clm new file mode 100644 index 0000000000..ca41a3d616 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/crop_trans_sville/user_nl_clm @@ -0,0 +1,6 @@ +fsurdat = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/surfdata_1x1_smallvilleIA_78pfts_simyr2000_c150218.nc' +flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/landuse.timeseries_1x1_smallvilleIA_hist_78pfts_simyr1850-1855_c150218.nc' + +! Set check_dynpft_consistency to .false. because we currently use a year-2000 dataset rather than a year-1850 dataset. +! This setting can be removed once we use a year-1850 surface dataset, which is what is expected for transient runs. +check_dynpft_consistency = .false. diff --git a/components/clm/cimetest/testmods_dirs/clm/decStart/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/decStart/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/decStart/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/decStart/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/decStart/xmlchange_cmnds new file mode 100755 index 0000000000..11a1ac6ce9 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/decStart/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=2001-12-30 diff --git a/components/clm/cimetest/testmods_dirs/clm/default/shell_commands b/components/clm/cimetest/testmods_dirs/clm/default/shell_commands new file mode 100644 index 0000000000..4ece44b655 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/default/shell_commands @@ -0,0 +1,12 @@ +# Apply these testmods to multi-instance tests, too (assuming there are only two instances) +# +# Doing this copy rather than explicitly including user_nl_clm_0001, etc. is +# preferable both to avoid duplication and also so that the FINAL version of +# user_nl_clm is copied in the case that there is another testmods directory +# that includes this one. +# +# Ideally, these copies would be done automatically when applying testmods in +# create_newcase. +cp user_nl_clm user_nl_clm_0001 +cp user_nl_clm user_nl_clm_0002 + diff --git a/components/clm/cimetest/testmods_dirs/clm/default/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/default/user_nl_clm new file mode 100644 index 0000000000..8a01973b43 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/default/user_nl_clm @@ -0,0 +1,23 @@ + wrtdia = .true. + hist_dov2xy = .true.,.false. +! Even though only 2 history tapes are defined here, set ndens to 1 for up to 6 history +! tapes, for the sake of mods that extend these default mods and may add other history tapes + hist_ndens = 1,1,1,1,1,1 + hist_nhtfrq =-24,-8 + hist_mfilt = 1,1 + hist_fincl1 = 'TRAFFICFLUX', 'SNOWLIQ:A','SNOWICE:A' + hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', + 'FSR','FSA','FGEV','FSH','FGR','TSOI', + 'ERRSOI','SABV','SABG', + 'FSDSVD','FSDSND','FSDSVI','FSDSNI', + 'FSRVD','FSRND','FSRVI','FSRNI', + 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', + 'H2OSNO','SOILLIQ','SOILICE', + 'TSA_U', 'TSA_R', + 'TREFMNAV_U', 'TREFMNAV_R', + 'TREFMXAV_U', 'TREFMXAV_R', + 'TG_U', 'TG_R', + 'RH2M_U', 'RH2M_R', + 'QRUNOFF_U', 'QRUNOFF_R', + 'SoilAlpha_U', + 'SWup', 'LWup', 'URBAN_AC', 'URBAN_HEAT' diff --git a/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/xmlchange_cmnds new file mode 100755 index 0000000000..ecd6d46239 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/drydepnomegan/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange CLM_BLDNML_OPTS='-drydep -no-megan' -append diff --git a/components/clm/cimetest/testmods_dirs/clm/edTest/shell_commands b/components/clm/cimetest/testmods_dirs/clm/edTest/shell_commands new file mode 100755 index 0000000000..d81ed7dbc5 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/edTest/shell_commands @@ -0,0 +1 @@ +./xmlchange CLM_BLDNML_OPTS="-no-megan" --append diff --git a/components/clm/cimetest/testmods_dirs/clm/edTest/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/edTest/user_nl_clm new file mode 100644 index 0000000000..2c11d3b5ad --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/edTest/user_nl_clm @@ -0,0 +1,10 @@ +use_cn = .false. +finidat = '' +hist_mfilt = 365 +hist_nhtfrq = -24 +hist_empty_htapes = .true. +hist_fincl1 = 'NPP','GPP','BTRAN','H2OSOI','TLAI','LITTER_IN','LITTER_OUT', + 'STORVEGC','FIRE_AREA','SCORCH_HEIGHT','FIRE_INTENSITY','FIRE_TFC_ROS','fire_fuel_mef', + 'fire_fuel_bulkd','fire_fuel_sav','FIRE_NESTEROV_INDEX','PFTbiomass', + 'PFTleafbiomass','FIRE_ROS','WIND','TFC_ROS','DISPVEGC','AREA_TREES','AREA_PLANT' + diff --git a/components/clm/cimetest/testmods_dirs/clm/flexibleCN/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/flexibleCN/user_nl_clm new file mode 100644 index 0000000000..30fd9e0678 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/flexibleCN/user_nl_clm @@ -0,0 +1,24 @@ + wrtdia = .true. + hist_dov2xy = .true.,.false. + hist_ndens = 1,1 + hist_nhtfrq =-24,-8 + hist_mfilt = 1,3 + hist_fincl1 = 'TRAFFICFLUX', 'SNOWLIQ:A','SNOWICE:A' + hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', + 'FSR','FSA','FGEV','FSH','FGR','TSOI', + 'ERRSOI','SABV','SABG', + 'FSDSVD','FSDSND','FSDSVI','FSDSNI', + 'FSRVD','FSRND','FSRVI','FSRNI', + 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', + 'H2OSNO','SOILLIQ','SOILICE', + 'TSA_U', 'TSA_R', + 'TREFMNAV_U', 'TREFMNAV_R', + 'TREFMXAV_U', 'TREFMXAV_R', + 'TG_U', 'TG_R', + 'RH2M_U', 'RH2M_R', + 'QRUNOFF_U', 'QRUNOFF_R', + 'SoilAlpha_U', + 'SWup', 'LWup', 'URBAN_AC', 'URBAN_HEAT' + +use_flexibleCN = .true. + diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/glcMEC/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_clm new file mode 100644 index 0000000000..23452cfa65 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_clm @@ -0,0 +1,7 @@ +! add some special history fields: multi-layer snow fields, and a per-column forcing field + hist_fincl1 += 'SNO_EXISTENCE', 'SNO_ABS', 'SNO_T:M', 'SNO_GS:X', 'QICE_FORC' +! similarly, add a glc-specific field to the second history tape + hist_fincl2 += 'QICE' + +! Set max snow persistence to a small number so that smb from bare land can potentially be triggered + glc_snow_persistence_max_days = 2 diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_cpl b/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_cpl new file mode 100644 index 0000000000..bff92b5760 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC/user_nl_cpl @@ -0,0 +1,2 @@ + glc_nec = 10 + budget_inst = 1 diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/README b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/README new file mode 100644 index 0000000000..2e8fcfc52e --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/README @@ -0,0 +1,4 @@ +This testmods directory switches some glc_mec-related flags in CLM, in order to +test different branches than are tested with the default options. + +It also turns off the feedback from CISM to CLM, to test that option. diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/include_user_mods new file mode 100644 index 0000000000..1730b6b7cf --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/include_user_mods @@ -0,0 +1 @@ +../glcMEC diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/user_nl_clm new file mode 100644 index 0000000000..cbb67daeef --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/user_nl_clm @@ -0,0 +1 @@ + glcmec_downscale_longwave = .false. diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/xmlchange_cmnds new file mode 100644 index 0000000000..404b22b006 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange GLC_TWO_WAY_COUPLING=FALSE diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/README b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/README new file mode 100644 index 0000000000..9d54f93b87 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/README @@ -0,0 +1,2 @@ +This testmods directory is like the standard glcMEC testmods directory, except +it forces a quick decrease in glacier area, along with rearranging the columns. diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/include_user_mods new file mode 100644 index 0000000000..1730b6b7cf --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/include_user_mods @@ -0,0 +1 @@ +../glcMEC diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/user_nl_cism b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/user_nl_cism new file mode 100644 index 0000000000..5163d5528d --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/user_nl_cism @@ -0,0 +1,5 @@ +! For this test, we do a decrease in glacier area, along with rearranging the columns; +enable_frac_overrides = .true. +override_delay = 1 +decrease_frac = 0.04 +rearrange_freq = 3 diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/README b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/README new file mode 100644 index 0000000000..1833bf6a8c --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/README @@ -0,0 +1,2 @@ +This testmods directory is like the standard glcMEC testmods directory, except +it forces a quick increas in glacier area. diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/include_user_mods new file mode 100644 index 0000000000..1730b6b7cf --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/include_user_mods @@ -0,0 +1 @@ +../glcMEC diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/user_nl_cism b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/user_nl_cism new file mode 100644 index 0000000000..3b42ed19dc --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/user_nl_cism @@ -0,0 +1,4 @@ +! For this test, we do an increase in glacier area; +enable_frac_overrides = .true. +override_delay = 1 +increase_frac = 0.5 diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/README b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/README new file mode 100644 index 0000000000..9934bd02d9 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/README @@ -0,0 +1,2 @@ +This directory is similar to the glcMEC testmods directory, but is intended for +long (e.g., multi-year) runs. diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/include_user_mods new file mode 100644 index 0000000000..1730b6b7cf --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/include_user_mods @@ -0,0 +1 @@ +../glcMEC diff --git a/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/user_nl_clm new file mode 100644 index 0000000000..16bce125d8 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/glcMEC_long/user_nl_clm @@ -0,0 +1,6 @@ + hist_nhtfrq =0,0 + hist_mfilt = 1,12 + +! Set max snow persistence to a small number so that smb from bare land can potentially be triggered +! (since this testmods directory is set up for long runs, use 1 year rather than just a couple of days) + glc_snow_persistence_max_days = 365 diff --git a/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/include_user_mods new file mode 100644 index 0000000000..2596fa3cb3 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/include_user_mods @@ -0,0 +1 @@ +../reduceOutput diff --git a/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm new file mode 100644 index 0000000000..2f66a112d4 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm @@ -0,0 +1,8 @@ +hist_fincl1 += 'QIRRIG' +hist_fincl2 += 'QIRRIG' +hist_dov2xy = .true.,.false. +hist_nhtfrq = 0, -8760 +hist_mfilt = 1,1 + +! In contrast to the standard reduceOutput, use double-precision +hist_ndens = 1,1 diff --git a/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/xmlchange_cmnds new file mode 100755 index 0000000000..0470d46a28 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrigOn_reduceOutput/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange CLM_BLDNML_OPTS="-irrig .true." -append diff --git a/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/README b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/README new file mode 100644 index 0000000000..2e7fcbeba6 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/README @@ -0,0 +1,3 @@ +This testmods directory turns on both irrigation and ozone. These two options +are unrelated, but are simply combined for convenience (so we can turn on a +number of things with a single test). diff --git a/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/include_user_mods new file mode 100644 index 0000000000..af6f0ed80d --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/include_user_mods @@ -0,0 +1 @@ +../irrigOn_reduceOutput diff --git a/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/user_nl_clm new file mode 100644 index 0000000000..937cd64717 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/irrig_o3_reduceOutput/user_nl_clm @@ -0,0 +1,6 @@ +! explicitly include stuff needed for o3 here rather than including the o3 directory, +! since the o3 directory includes default, and we don't want that for this +! reducedOutput testmod +use_ozone = .true. +hist_fincl1 += 'O3UPTAKESUN', 'O3UPTAKESHA' +hist_fincl2 += 'O3UPTAKESUN', 'O3UPTAKESHA' diff --git a/components/clm/cimetest/testmods_dirs/clm/luna/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/luna/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/luna/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/luna/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/luna/user_nl_clm new file mode 100644 index 0000000000..b851af6e62 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/luna/user_nl_clm @@ -0,0 +1,2 @@ + use_luna = .true. + diff --git a/components/clm/cimetest/testmods_dirs/clm/monthly/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/monthly/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/monthly/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_clm new file mode 100644 index 0000000000..a6ac15b7f0 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_clm @@ -0,0 +1,5 @@ +! Change hist frequency to something more appropriate for long tests, and add some snow +! fields in order to test those history fields + hist_nhtfrq = 0,-240 + hist_mfilt = 1,1 + hist_fincl1 += 'SNO_EXISTENCE', 'SNO_ABS', 'SNO_T:M', 'SNO_GS:X' diff --git a/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_cpl b/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_cpl new file mode 100644 index 0000000000..3771552f9a --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/monthly/user_nl_cpl @@ -0,0 +1 @@ +budget_inst = 1 diff --git a/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/include_user_mods new file mode 100644 index 0000000000..399579f425 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/include_user_mods @@ -0,0 +1 @@ +../monthly diff --git a/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/user_nl_clm new file mode 100644 index 0000000000..a933bc4080 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/monthly_noinitial/user_nl_clm @@ -0,0 +1,4 @@ +! This is useful for testing cases that are not set up with +! out-of-the-box initial conditions files, and would fail if finidat +! were not explicitly set to blank here. +finidat = ' ' diff --git a/components/clm/cimetest/testmods_dirs/clm/o3/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/o3/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/o3/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/o3/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/o3/user_nl_clm new file mode 100644 index 0000000000..a80360aaa0 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/o3/user_nl_clm @@ -0,0 +1,2 @@ + use_ozone = .true. + hist_fincl2 += 'O3UPTAKESUN', 'O3UPTAKESHA' diff --git a/components/clm/cimetest/testmods_dirs/clm/oldhyd/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/oldhyd/user_nl_clm new file mode 100644 index 0000000000..8e8f3b73fc --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/oldhyd/user_nl_clm @@ -0,0 +1,5 @@ + hist_ndens = 1,1 + oldfflag = 1 + h2osfcflag = 0 + origflag = 1 + subgridflag = 0 diff --git a/components/clm/cimetest/testmods_dirs/clm/pts/README b/components/clm/cimetest/testmods_dirs/clm/pts/README new file mode 100644 index 0000000000..30d71a7c8b --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/pts/README @@ -0,0 +1,5 @@ +This testmods directory should not be used directly. Instead, it should be +extended (i.e., included) by a mods directory that defines the point to run +over - something like: + +./xmlchange PTS_LAT=42,PTS_LON=260 diff --git a/components/clm/cimetest/testmods_dirs/clm/pts/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/pts/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/pts/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/pts/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/pts/xmlchange_cmnds new file mode 100644 index 0000000000..6ae1227e22 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/pts/xmlchange_cmnds @@ -0,0 +1,24 @@ +./xmlchange PTS_MODE=TRUE +./xmlchange ATM_NX=0 +./xmlchange ATM_NY=0 +./xmlchange LND_NX=0 +./xmlchange LND_NY=0 +./xmlchange ICE_NX=0 +./xmlchange ICE_NY=0 +./xmlchange OCN_NX=0 +./xmlchange OCN_NY=0 +./xmlchange ROF_NX=0 +./xmlchange ROF_NY=0 +./xmlchange GLC_NX=0 +./xmlchange GLC_NY=0 +./xmlchange WAV_NX=0 +./xmlchange WAV_NY=0 +./xmlchange NTASKS_ATM=1 +./xmlchange NTASKS_LND=1 +./xmlchange NTASKS_ICE=1 +./xmlchange NTASKS_OCN=1 +./xmlchange NTASKS_CPL=1 +./xmlchange NTASKS_GLC=1 +./xmlchange NTASKS_ROF=1 +./xmlchange NTASKS_WAV=1 +./xmlchange TOTALPES=1 diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsRLA/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/ptsRLA/include_user_mods new file mode 100644 index 0000000000..cdb9d9f000 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsRLA/include_user_mods @@ -0,0 +1 @@ +../pts diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsRLA/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/ptsRLA/xmlchange_cmnds new file mode 100644 index 0000000000..db39aa0b54 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsRLA/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange PTS_LAT=42,PTS_LON=260 diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsRLB/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/ptsRLB/include_user_mods new file mode 100644 index 0000000000..cdb9d9f000 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsRLB/include_user_mods @@ -0,0 +1 @@ +../pts diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsRLB/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/ptsRLB/xmlchange_cmnds new file mode 100644 index 0000000000..40722f2340 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsRLB/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange PTS_LAT=-5,PTS_LON=290 diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsROA/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/ptsROA/include_user_mods new file mode 100644 index 0000000000..cdb9d9f000 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsROA/include_user_mods @@ -0,0 +1 @@ +../pts diff --git a/components/clm/cimetest/testmods_dirs/clm/ptsROA/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/ptsROA/xmlchange_cmnds new file mode 100644 index 0000000000..ce89f9ce25 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/ptsROA/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange PTS_LAT=30,PTS_LON=315 diff --git a/components/clm/cimetest/testmods_dirs/clm/reduceOutput/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/reduceOutput/user_nl_clm new file mode 100644 index 0000000000..3d94564c47 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/reduceOutput/user_nl_clm @@ -0,0 +1,12 @@ +hist_empty_htapes = .true. +hist_fincl1 = 'SNOWLIQ','SNOWICE' , + 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', + 'FSR','FSA','FGEV','FSH','FGR','TSOI', + 'ERRSOI','SABV','SABG', + 'FSDSVD','FSDSND','FSDSVI','FSDSNI', + 'FSRVD','FSRND','FSRVI','FSRNI', + 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', + 'H2OSNO','SOILLIQ','SOILICE', + 'TG', + 'RH2M_U', 'RH2M_R', + 'QRUNOFF' diff --git a/components/clm/cimetest/testmods_dirs/clm/rootlit/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/rootlit/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/rootlit/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/rootlit/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/rootlit/user_nl_clm new file mode 100644 index 0000000000..53d20a3a97 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/rootlit/user_nl_clm @@ -0,0 +1,3 @@ + use_vertsoilc = .false. + anoxia = .true. + hist_wrtch4diag = .true. diff --git a/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/user_nl_clm new file mode 100644 index 0000000000..053dd1b48d --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/snowlayers_12/user_nl_clm @@ -0,0 +1,8 @@ +nlevsno = 12 +h2osno_max = 20000. + +! Add some multi-layer snow history fields +hist_fincl1 += 'SNO_EXISTENCE', 'SNO_ABS', 'SNO_T:M', 'SNO_GS:X' + +! Use cold start, because can't change number of snow layers for existing initial conditions file +finidat = ' ' diff --git a/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/include_user_mods new file mode 100644 index 0000000000..399579f425 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/include_user_mods @@ -0,0 +1 @@ +../monthly diff --git a/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/user_nl_clm new file mode 100644 index 0000000000..c6c8bf519a --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/user_nl_clm @@ -0,0 +1,4 @@ +nlevsno = 3 + +! Use cold start, because can't change number of snow layers for existing initial conditions file +finidat = ' ' diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/README b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/README new file mode 100644 index 0000000000..aab790286d --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/README @@ -0,0 +1,7 @@ +This testmods directory is meant to be used in conjunction with a 20th +century transient case at resolution 1x1_tropicAtl. + +However, it generally should not be used directly. Instead, it should be +extended (i.e., included) by a testmods directory that sets the start date to a +desired year, either just before, in the middle of, or after the starting date +on this file. diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/user_nl_clm new file mode 100644 index 0000000000..d13030daf2 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subset/user_nl_clm @@ -0,0 +1,4 @@ +flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/landuse.timeseries_1x1_tropicAtl_TEST_simyr1939-1943_c141219.nc' + +! Need to set this to false because the landuse_timeseries file starts in 1939, disagreeing with the 1850 surface dataset +check_dynpft_consistency = .false. diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/README b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/README new file mode 100644 index 0000000000..1a6bcd2761 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/README @@ -0,0 +1,6 @@ +This testmods directory is meant to be used in conjunction with a 20th +century transient case at resolution 1x1_tropicAtl. + +This starts the simulation prior to the first year defined on that +file, in order to test the logic for starting before the first landuse_timeseries +year. diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/include_user_mods new file mode 100644 index 0000000000..a04b982641 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/include_user_mods @@ -0,0 +1 @@ +../tropicAtl_subset diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/xmlchange_cmnds new file mode 100644 index 0000000000..99f956ee98 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetEarly/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=1938-01-01 diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/README b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/README new file mode 100644 index 0000000000..50d6a82e8d --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/README @@ -0,0 +1,6 @@ +This testmods directory is meant to be used in conjunction with a 20th +century transient case at resolution 1x1_tropicAtl. + +This starts the simulation just after the last year of data defined on +that file, in order to test the logic for starting past the end of the +landuse_timeseries file. diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/include_user_mods new file mode 100644 index 0000000000..a04b982641 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/include_user_mods @@ -0,0 +1 @@ +../tropicAtl_subset diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/xmlchange_cmnds new file mode 100644 index 0000000000..56c60229fd --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetLate/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=1943-01-01 diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/README b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/README new file mode 100644 index 0000000000..3bc05089e0 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/README @@ -0,0 +1,5 @@ +This testmods directory is meant to be used in conjunction with a 20th +century transient case at resolution 1x1_tropicAtl. + +This starts the simulation in the middle of the dataset, in order to +test the logic for starting in the middle of the landuse_timeseries file. diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/include_user_mods new file mode 100644 index 0000000000..a04b982641 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/include_user_mods @@ -0,0 +1 @@ +../tropicAtl_subset diff --git a/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/xmlchange_cmnds b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/xmlchange_cmnds new file mode 100644 index 0000000000..4fe46cd94a --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/tropicAtl_subsetMid/xmlchange_cmnds @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=1941-01-01 diff --git a/components/clm/cimetest/testmods_dirs/clm/vrtlay/include_user_mods b/components/clm/cimetest/testmods_dirs/clm/vrtlay/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/vrtlay/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/components/clm/cimetest/testmods_dirs/clm/vrtlay/user_nl_clm b/components/clm/cimetest/testmods_dirs/clm/vrtlay/user_nl_clm new file mode 100644 index 0000000000..cc19d64f71 --- /dev/null +++ b/components/clm/cimetest/testmods_dirs/clm/vrtlay/user_nl_clm @@ -0,0 +1 @@ + more_vertlayers = .true. diff --git a/components/clm/doc/ChangeLog b/components/clm/doc/ChangeLog new file mode 100644 index 0000000000..2ec83ff776 --- /dev/null +++ b/components/clm/doc/ChangeLog @@ -0,0 +1,46679 @@ +=============================================================== +Tag name: clm4_5_1_r120 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Sat Aug 29 22:58:57 MDT 2015 +One-line Summary: CLM 5 nitrogen models Flexible CN and LUNA + +Purpose of changes: + CLM 5 nitrogen models Flexible CN (Bardan Ghimire, LBNL) + and LUNA (Chonggang Xu, LANL). The LUNA model predicts + photosynthetic capacities as measured by Vc, max25 and Jmax25 + under different environmental conditions (see Ali et al 2015). + +Requirements for tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ - 2208 + https://github.com/CESM-Development/cime/issues - 115, 116 + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + addition of use_luna and use_flexibleCN. use_flexibleCN adds + additional namelist options in the clm_nitrogen group. See xml + definitions file for details. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, Bardan Ghimire, Chonggang Xu + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 - flexibleCN. + cimetest/testmods_dirs/clm/flexibleCN - flexible cn regression test + src/biogeophys/LunaMod.F90 - luna model + cimetest/testmods_dirs/clm/luna - luna regression case + +List all existing files that have been modified, and describe the changes: + + new namelist controls for flexibleCN and luna, clm_nitrogen namelist group: + bld/namelist_files/namelist_definition_clm4_5.xml + bld/namelist_files/namelist_defaults_clm4_5.xml + bld/CLMBuildNamelist.pm + src/main/clm_varctl.F90 + src/main/controlMod.F90 + + flexibleCN + src/biogeochem/CNVegCarbonStateType.F90 - Michaelis-Menten Nitrogen uptake + src/biogeochem/CNVegNitrogenStateType.F90 - Michaelis-Menten Nitrogen uptake + + src/biogeochem/CNGRespMod.F90 - excess carbon storage + src/biogeochem/CNGapMortalityMod.F90 - excess carbon storage + + src/biogeochem/NutrientCompetitionFactoryMod.F90 - add flexible cn option + src/biogeochem/NutrientCompetitionMethodMod.F90 - modify interface to accomidate flexiblecn + src/biogeochem/CNPhenologyMod.F90 - floating cn evergreen phenology + src/biogeochem/CNDriverMod.F90 - update function call args + src/main/pftconMod.F90 - flexible cn pft variables + + src/main/histFileMod.F90 - nlev canopy + src/main/clm_driver.F90 - update function call args + src/main/clm_instMod.F90 - update function call args + src/biogeophys/WaterfluxType.F90 - additional water flux vars + src/biogeophys/SoilWaterMovementMod.F90 - soil water work around + + LUNA + src/main/clm_varcon.F90 - new constant for luna + src/biogeophys/PhotosynthesisMod.F90 - luna use of vcmax25 and jmax25 + src/biogeophys/CanopyFluxesMod.F90 - luna calculation of vcmax25 and jmax25 + src/main/atm2lndType.F90 - state data needed for luna + src/biogeophys/FrictionVelocityMod.F90 - luna variables + src/biogeophys/WaterStateType.F90 - luna variables + src/biogeophys/TemperatureType.F90 - luna variables + src/biogeophys/SolarAbsorbedType.F90 - luna variables + src/biogeophys/QSatMod.F90 - saturated vapor pressure density + src/biogeophys/SoilHydrologyType.F90 - luna var + src/biogeophys/CanopyStateType.F90 - update vcmax and jmax for luna + + cimetest/ExpectedTestFails.xml - update for cime bugs 115 and 116 + cimetest/testlist_clm.xml - update test list for aux_clm_short, new luna and flexibleCN tests + + +CLM testing: regular, build-namelist + + build-namelist tests: + + yellowstone - unit tests : pass, other pass + + unit-tests (components/clm/src): + + yellowstone - ok + + tools-tests (components/clm/test/tools): n/a + + PTCLM testing (components/clm/tools/shared/PTCLM/test): n/a + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel - 40 ok, 45 ok + yellowstone_pgi - 40 ok, 45 ok + yellowstone_gnu (clm45 only) ok + hobart_nag - not run, tests hang, see bug 2208 + + Testing notes: + + * new namelist group clm_nitrogen causes all nlcomp tests to fail + * introduces new tests for flexibleCN and luna that do not + have baselines in clm4_5_1_r119. + * two new expected fails believed to be related to cime issues + 115 and 116. + * removes the existing aux_clm_short tests and replaces them with + a new set of SMS, ERS and ERP tests that are replicated for + yellowstone gnu, intel and pgi. + +CLM tag used for the baseline comparisons: clm4_5_1_r119 + +Changes answers relative to baseline: none + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r119 +Originator(s): erik (Erik Kluzek) +Date: Wed Aug 26 22:29:10 MDT 2015 +One-line Summary: Bring hobart/nag bug fixes to trunk, and fix a few bugs + +Purpose of changes: + +Bring hobart/nag bug fixes to trunk. Fix ncl6.3.0 bug for getregional script. +Fix use_c13 bug. Update RTM to handle regional direction files. Make sure _r8 +constants in ED have a decimal point, so the NAG compiler will treat them as +double-precision rather than as integer*2. + +Move testing from goldbach to hobart. For hobart_nag make all of the tests +on just one node (24 processors). + +Requirements for tag: compile run with hobart/nag (fix bugs 2205 and 2199) + move testing from goldbach to hobart + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2206 (PTCLM stopped working with pft number in surface dataset filenames for mksurfdata.pl) + 2205 (Problems with some constants in ED for NAG compiler) + 2199 (crayftn compiler issue with continuation in middle of string) + 2180 (ncl6.3.0 bug for getregional script) + 2174 (use_c13 bug, unformatted write caused model to die) + 2156 (Update RTM to handle regional direction files) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, klindsay + +List any svn externals directories updated (cime, rtm, cism, etc.): PTCLM, cime and rtm + cime to cime2.0.07 + rtm to rtm1_0_52 + PTCLM to PTCLM2_150826 + +List all files eliminated: Move goldbach to hobart + +D components/clm/test/tools/tests_posttag_goldbach_nompi + +List all files added and what they do: Move goldbach to hobart + +A components/clm/test/tools/tests_posttag_hobart_nompi + +List all existing files that have been modified, and describe the changes: + +------------ Move goldbach to hobart, remove PGI option for hobart +M components/clm/test/tools/test_driver.sh + +M components/clm/bld/unit_testers/build-namelist_test.pl -- Fix ED tests so megan off + +M components/clm/cimetest/testlist_clm.xml --- Move goldbach tests to hobart + Make 2-node hobart_nag tests on a single node + +M components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl -- Fix so will + work with ncl6.3.0, bug 2180 + +M components/clm/src/README.unit_testing --- add some notes about unit-testing + +------------ Bug 2205, some _r8 constants in ED don't have a decimal point +------------ and the NAG compiler then treats them as integer*2. +M components/clm/src/ED/main/EDCLMLinkMod.F90 +M components/clm/src/ED/main/EDRestVectorMod.F90 +M components/clm/src/ED/main/EDInitMod.F90 +M components/clm/src/ED/fire/SFMainMod.F90 +M components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +M components/clm/src/ED/biogeophys/EDBtranMod.F90 +M components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +M components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +M components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +M components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 + +------------ Bug 2199, write to iulog was unformatted, which caused the model +------------ to die after it had already done formatted writes. +M components/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +M components/clm/src/biogeochem/CNVegCarbonStateType.F90 + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (components/clm/src): + + yellowstone yes + + tools testing (components/clm/test/tools): + + yellowstone yes + + PTCLM testing (components/clm/tools/shared/PTCLM/test): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu (clm45 only) yes + hobart_nag yes + hobart_pgi yes + hobart_intel yes + +CLM tag used for the baseline comparisons: clm4_5_1_r118 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r118 +Originator(s): sacks (Bill Sacks) +Date: Wed Aug 5 16:22:33 MDT 2015 +One-line Summary: Minor rework of glc coupling fields + +Purpose of changes: + + This makes CLM compatible with recent CIME changes. + + (1) Use renamed coupler field, in both clm40 and clm45 + + (2) In clm45 code, rework clm_cpl_indices to use glc_elevclass_mod (simpler + and more robust than the earlier code) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.1.11 -> cime2.0.0 + cism2_0_09 -> cism2_1_02 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes +M components/clm/src/cpl/clm_cpl_indices.F90 +M components/clm/src/cpl/lnd_import_export.F90 +M components/clm/src_clm40/main/clm_cpl_indices.F90 +M components/clm/src_clm40/main/lnd_import_export.F90 + +========= Document new unit testing method needed for yellowstone, due to cime update +M components/clm/src/README.unit_testing + +========= Rework test mods due to a fundamental change in how the forced + decrease / increase in glc area works +M components/clm/cimetest/testmods_dirs/clm/glcMEC_decrease/user_nl_cism +M components/clm/cimetest/testmods_dirs/clm/glcMEC_increase/user_nl_cism + +========= New failures, which seem to be attributable to the cime update, + unrelated to my changes. However, the NCK and CME test failures seem + dependent on the order in which tests are run, so these problems are + hard to reproduce. Running them as single tests leads to PASSes. +M components/clm/cimetest/ExpectedTestFails.xml ++ CFAIL CME_Ld5.f10_f10.ICN.yellowstone_intel ++ FAIL NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default ++ RUN ERS_D_Mmpi-serial_Ld5.1x1_brazil.ICLM45ED.yellowstone_gnu.clm-edTest + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok - but see caveat below! + +As noted above, there are three new test failures. The ERS_D ICLM45ED failure +seems to be a legitimate bug in CLM. The other two (CFAIL +CME_Ld5.f10_f10.ICN.yellowstone_intel and FAIL +NCK_Ld1.f10_f10.ICRUCLM45.yellowstone_intel.clm-default) seem to be intermittent +failures, likely due to a bug in the test system or elsewhere in cime. These +sometimes pass and sometimes fail. They always seem to pass when run as single +tests, but sometimes fail when run as part of a test suite. It's not clear if +the new cime is to blame directly, or if these are arising now simply because +tests are being run in a different order. + +golbach-nag does not run out-of-the-box with this tag. However, it should run +out-of-the-box if you merge in the next commit in cime master +(4b52ec73086a4290323dddfde6087a6d6d12ab96). I did my changes with that commit +merged in, but this hadn't come to master in time for me to include it in this +CLM tag. + +CLM tag used for the baseline comparisons: clm4_5_1_r117 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Configurations with CISM (IG), both CLM4 and CLM45 + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Likely larger than roundoff/same climate (but not investigated closely) + + These changes are due to a complete rework of the coupling between CISM + and CLM, manifested as major changes in the CIME and CISM externals. (The + changes in CLM are not directly responsible for the answer changes.) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r117 +Originator(s): sacks (Bill Sacks) +Date: Tue Jul 28 06:01:04 MDT 2015 +One-line Summary: Repartition rain vs. snow from atmosphere + +Purpose of changes: + + Add an option to repartition rain vs. snow from atmosphere based on + near-surface temperature. This repartitioning uses a ramp-based partitioning + that is also used in datm: we ignore the rain vs. snow partitioning sent from + the atmosphere, and generate our own rain vs. snow partitioning. A sensible + heat flux is generated to conserve energy with this repartitioning. + + The motivation for this is two-fold: + + (1) There are biases in CAM which cause rain to be generated in cold + conditions. This is particularly a problem for glacier surface mass + balance in Greenland. Andrew Gettelman has suggested putting in place + this workaround in CLM until CAM can find a robust fix. + + (2) With the downscaling to glacier elevation classes, it is useful to have + a different rain/snow partitioning in each elevation class. + + This repartitioning is on by default in CLM5, off by default in CLM4.5. + + If / when the CAM bias is fixed, we could potentially change this code so + that it just does the repartitioning over the do_smb filter, similarly to the + other downscaling in atm2lndMod. (Rather than doing this correction + everywhere - which we do now in order to correct the rain vs. snow + partitioning bias in CAM.) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + + Removed glcmec_downscale_rain_snow_convert option, added + repartition_rian_snow option + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Sean Swenson reviewed the calculation of the sensible heat +flux correction + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.1.10 -> cime1.1.11 + This creates a new shared routine for partitioning rain vs. snow, now shared + between datm and CLM. + +List all files eliminated: + +List all files added and what they do: + +========= Add unit tests for repartitioning of rain vs snow, and supporting + utility code +A components/clm/src/main/test/atm2lnd_test/test_sens_heat_from_precip_conversion.pf +A components/clm/src/main/test/atm2lnd_test/CMakeLists.txt +A components/clm/src/main/test/atm2lnd_test/test_partition_precip.pf +A components/clm/src/main/test/atm2lnd_test +A components/clm/src/unit_test_shr/unittestArrayMod.F90 +A components/clm/src/unit_test_shr/test/unittestArray_test/CMakeLists.txt +A components/clm/src/unit_test_shr/test/unittestArray_test/test_unittestArray.pf +A components/clm/src/unit_test_shr/test/unittestArray_test + +List all existing files that have been modified, and describe the changes: + +========= Repartition rain vs snow from atmosphere, and add a sensible heat flux + correction for energy conservation +M components/clm/src/biogeophys/EnergyFluxType.F90 +M components/clm/src/main/clm_driver.F90 +M components/clm/src/main/clm_varctl.F90 +M components/clm/src/main/controlMod.F90 +M components/clm/src/main/atm2lndType.F90 +M components/clm/src/main/lnd2atmType.F90 +M components/clm/src/main/atm2lndMod.F90 +M components/clm/src/main/lnd2atmMod.F90 + +========= Remove glcmec_rain_snow_threshold +M components/clm/src/main/clm_varcon.F90 + +========= Remove glcmec_downscale_rain_snow_convert option, add + repartition_rain_snow option +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M components/clm/bld/CLMBuildNamelist.pm + +========= Add an IG CLM5 test +M components/clm/cimetest/testlist_clm.xml + +========= Remove glcmec_downscale_rain_snow_convert setting (which no longer exists) +M components/clm/cimetest/testmods_dirs/clm/glcMEC_changeFlags/user_nl_clm + +========= Add unit tests for repartitioning of rain vs snow, and supporting + utility code +M components/clm/src/main/CMakeLists.txt +M components/clm/src/main/test/CMakeLists.txt +M components/clm/src/biogeophys/CMakeLists.txt +M components/clm/src/unit_test_shr/test/CMakeLists.txt +M components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 +M components/clm/src/unit_test_shr/CMakeLists.txt + +CLM testing: + + build-namelist tests: + + yellowstone: ok (changes namelists, as expected) + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r116 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM5 cases + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Likely new climate, but not investigated closely + + Answer changes are due to new rain vs. snow partitioning, which is on by + default in CLM5. + + Also changes answers for + ERP_D_Ld5.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags + (expected, since it no longer downscales precip). + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r116 +Originator(s): sacks (Bill Sacks) +Date: Wed Jul 22 06:39:28 EDT 2015 +One-line Summary: Rename some history fields + +Purpose of changes: + + (1) Make QSNOMELT point to qflx_snomelt, as it does in CLM4.0, rather than + qflx_snow_drain (previously qflx_snow_melt) + + (2) Turn on QSNOFRZ by default (parallels QSNOMELT) + + (3) For the 3 history fields that have FOO and FOO_NODYNLNDUSE versions: + Rename FOO to FOO_TO_COUPLER and FOO_NODYNLNDUSE to FOO. This is at Sean + Swenson's suggestion: He points out that the version without the dyn landuse + adjustment (and, soon, the sensible heat adjustment from rain/snow + conversion) is the one most people will be interested in, so should be the + one without the suffix. + + (4) Tweak test lists: + + (a) Move prealpha & prebeta goldbach tests to hobart + + (b) Move an aux_clm45 pgi test to intel: With recent versions of cime + (starting with cime1.1.0), threading tests with pgi take a very long time. So + this test took 3 hours with pgi, vs 20 min with intel. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 2178 (QSNOMELT incorrect in clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= See summary above +M components/clm/src/main/lnd2atmType.F90 +M components/clm/src/biogeophys/WaterfluxType.F90 +M components/clm/src/biogeophys/EnergyFluxType.F90 +M components/clm/cimetest/testlist_clm.xml + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: NOT RUN + mac: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r115 + +Changes answers relative to baseline: YES + + Just changes a few diagnostic fields, for CLM4.5 and CLM5: + + - QSNOMELT: changed to qflx_snomelt rather than qflx_snow_drain + + - QRUNOFF: differs for cases with transient landcover + + - FSH: differs for cases with CISM + + - QSNWCPICE: differs for cases with CISM + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r115 +Originator(s): sacks (Bill Sacks) +Date: Wed Jul 15 05:26:37 MDT 2015 +One-line Summary: Remove redundant code, rename a variable + +Purpose of changes: + + (1) Remove some redundant code in SnowHydrologyMod, related to 'void'. This + was supposed to be removed a long time ago. (Apparently the issue this was + trying to fix was fixed in a different, more robust way.) + + (2) Remove redundant, unused copy of accumulMod in utils/ (newer copy is in + main/) + + (3) Rename qflx_snow_melt to qflx_snow_drain, to avoid confusion with the + existing qflx_snomelt. + + (4) Clarify documentation of snowdp_col + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: + +========= Redundant and unused (copy in main/ is used) +D components/clm/src/utils/accumulMod.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Rename qflx_snow_melt to qflx_snow_drain +M components/clm/src/biogeophys/CanopyHydrologyMod.F90 +M components/clm/src/biogeophys/LakeHydrologyMod.F90 +M components/clm/src/biogeophys/BalanceCheckMod.F90 +M components/clm/src/biogeophys/WaterfluxType.F90 +M components/clm/src/biogeophys/SoilTemperatureMod.F90 +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + - also remove redundant lines of code related to 'void' (see above) +M components/clm/src/biogeophys/LakeTemperatureMod.F90 + +========= Clarify documentation for snowdp_col +M components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +M components/clm/src/biogeophys/WaterStateType.F90 + +========= Remove SMS_Lm25.f10_f10.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + (runs out of wall-clock time, and we have sufficient test coverage of + that configuration) +M components/clm/cimetest/testlist_clm.xml + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r114 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r114 +Originator(s): sacks (Bill Sacks) +Date: Fri Jul 10 19:34:57 MDT 2015 +One-line Summary: Update cime external, remove genf90-generated files + +Purpose of changes: + + Main purpose is to update the cime external to the version in cesm1_4_beta05. + + This also required updating the unit test build to use genf90 during the + build rather than relying on already-generated files. + + Making this change led to some genf90'd files being regenerated in-source + during the unit test build, which would lead these files to be updated every + time we make a tag. To avoid this annoyance, I have removed the genf90'd + files from the repository: These are not needed any more in either the unit + test or system builds, and it simplifies things to remove them. + + Then I added an svn:ignore property to ignore files generated by genf90 + during the unit test build. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): + + cime1.0.7 -> cime1.1.10 + + Among other things, this brings in Jay's big batch system refactor + +List all files eliminated: + +========= Remove genf90-generated files, and some scripts that were used to + create them (these are now created as part of the unit test or system build) +D components/clm/src/dyn_subgrid/dynVarMod.F90 +D components/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +D components/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +D components/clm/src/dyn_subgrid/do_genf90 +D components/clm/src/unit_test_stubs/utils/do_genf90 +D components/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90 +D components/clm/src/unit_test_stubs/main/ncdio_var.F90 +D components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 +D components/clm/src/unit_test_stubs/main/do_genf90 +D components/clm/src/utils/restUtilMod.F90 +D components/clm/src/main/ncdio_pio.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Generate files with genf90 rather than using pre-generated files +M components/clm/src/CMakeLists.txt + +========= Document new, simpler method for building and running the unit tests + (thanks largely to new default options in run_tests.py) +M components/clm/src/README.unit_testing + +========= Add svn:ignore property to ignore files generated by genf90 during the + unit test build + M components/clm/src/dyn_subgrid + M components/clm/src/unit_test_stubs/utils + M components/clm/src/unit_test_stubs/main + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r112 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: intel + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff, according to cime documentation + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A: Trusting Sean Santos's cime documentation. + + These changes were likely due to this change in cime: + + commit 0d7eab6bd112565ba9eb6eb82b74127ae5a5f390 + Author: Sean Patrick Santos + Date: Fri May 15 12:35:31 2015 -0600 + + Use our native gamma/erf implementations on Intel + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r113 +Originator(s): sacks (Bill Sacks) +Date: Thu Jul 9 10:01:13 MDT 2015 +One-line Summary: Support backwards compatibility of restart variable names + +Purpose of changes: + + Previously, if a restart variable was renamed, backwards compatibility was + implemented in an ad-hoc manner. A key point is taht none of these ad-hoc + solutions allowed backwards compatibility when running + initInterp. (initInterp would just skip any variable if it could not find an + exact match on the input [template] file.) + + This tag provides a standard mechanism for putting in place backwards + compatibility when renaming a restart variable. This backwards compatibility + carries over to initInterp, by communicating the necessary metadata through a + new attribute on the restart file: 'varnames_on_old_files'. + + In order to use this new mechanism, give a colon-delimited list of variable + names in the varname argument to restartvar. For example, if a restart + variable FOO has been renamed to BAR, then specify varname='BAR:FOO'. Note + that this list is searched in order, and the first item should be the current + restart variable name. + + Also, applied this new mechanism to the recently-added LIQCAN + variable. Previously, backwards compatibility of this variable was handled in + an ad-hoc manner, which did not work when running initInterp. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Erik + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= Add module for higher-level netcdf utilities. Currently contains + routine for finding a variable on a netcdf file from a list of + possible variables. Also add unit tests for this routine. +A components/clm/src/main/ncdio_utils.F90 +A components/clm/src/main/test/ncdio_utils_test/test_ncdio_utils.pf +A components/clm/src/main/test/ncdio_utils_test/CMakeLists.txt +A components/clm/src/main/test/ncdio_utils_test + +List all existing files that have been modified, and describe the changes: + +========= Allow multiple possible names in reading restart files and in reading + the 'input' file in initInterp +M components/clm/src/utils/restUtilMod.F90.in +M components/clm/src/utils/restUtilMod.F90 +M components/clm/src/main/initInterp.F90 + +========= Apply new mechanism to recently-added LIQCAN restart field. Also + remove redundant setting of snocan_patch to 0 if it isn't found on the + restart file - not needed since initCold is always called. +M components/clm/src/biogeophys/WaterStateType.F90 + +========= Changes to support unit testing of ncdio_utils +M components/clm/src/main/CMakeLists.txt +M components/clm/src/main/test/CMakeLists.txt +M components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in +M components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 + +========= Fix path to genf90 for new cime organization +M components/clm/src/unit_test_stubs/main/do_genf90 +M components/clm/src/unit_test_stubs/main/ncdio_var.F90 + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r112 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r112 +Originator(s): oleson (Keith Oleson,UCAR/TSS,303-497-1332) +Date: Wed Jul 1 10:14:11 MDT 2015 +One-line Summary: Justin Perket snow on vegetation + +Purpose of changes: Incorporate Justin Perket's snow on vegetation changes + +Requirements for tag: + +Test level of tag: regular, build-namelist, unit_tests + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: Add snowveg_flag item + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Keith Oleson, Justin Perket, Erik Kluzek + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: +M components/clm/src/README.unit_testing Add note that instructions are for bash shell +M components/clm/src/biogeophys/CanopyFluxesMod.F90 snow/liq on vegetation +M components/clm/src/biogeophys/WaterStateType.F90 history/restart handling for snow/liq on vegetation +M components/clm/src/biogeophys/BalanceCheckMod.F90 line spaces only +M components/clm/src/biogeophys/WaterfluxType.F90 history handling for snow on vegetation +M components/clm/src/biogeophys/CanopyHydrologyMod.F90 snow/liq on vegetation and snowveg_flag handling +M components/clm/src/biogeophys/SurfaceAlbedoMod.F90 snow on vegetation optical properties +M components/clm/src/main/controlMod.F90 line spaces only +M components/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml snowveg_flag handling +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml snowveg_flag handling +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml snowveg_flag handling +M components/clm/bld/CLMBuildNamelist.pm snowveg_flag handling + +CLM testing: + + build-namelist tests: + + yellowstone: ok + All CLM45 and CLM50 tests have namelist differences; this is expected due + to addition of new namelist item + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r111 + +Changes answers relative to baseline: Yes, for CLM50 + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM50 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate. See Justin Perket (perketj@umich.edu) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? NA + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: NA + + URL for LMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r111 +Originator(s): sacks (Bill Sacks) +Date: Fri Jun 12 20:19:25 MDT 2015 +One-line Summary: Remove temporary hack to get bfb results in InitSnowLayers + +Purpose of changes: + + In order to get bit-for-bit results in clm4_5_1_r110 (relative to r109), we + put in place a temporary hack in InitSnowLayers that set dz based on the old + equations rather than the new, more general ones - thus avoiding + roundoff-level changes. This looked like: + + if (abs(dz(c,0)-3.59_r8) < eps) then ! TODO remove + col%dz(c, 0) = snow_depth(c)-col%dz(c,-4)-col%dz(c,-3)-col%dz(c,-2)-col%dz(c,-1) + if (abs(dz(c,0)-3.59_r8) > eps) & + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + + This tag removes that temporary hack. + + In this way, we have separated the answer-changing from non-answer-changing + parts of the r110 refactor. Note that the above code confirms that the + differences are no larger than roundoff (eps was 1e-9 in the above case, but + some tests showed that it could have been much smaller - e.g., ~ 1e-15). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r110 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 / CLM5 cold start + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + See above code sample, which confirms that the changes were no greater + than roundoff-level. + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r110 +Originator(s): sacks (Bill Sacks) +Date: Fri Jun 12 15:30:11 MDT 2015 +One-line Summary: Add flexibility to have more snow layers + +Purpose of changes: + + Generalize snow code so that it no longer assumes 5 snow layers. Instead, + make the number of snow layers (and the maximum SWE in the snow pack) a + runtime parameter, allowing 3 - 12 snow layers. + + Most changes were made by Leo van Kampenhout (l.vankampenhout@uu.nl). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 2182 (possible threading issue with optimized pgi builds) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + - new namelist parameters: nlevsno, h2osno_max + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: + +========= Add tests with different number of snow layers +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12/user_nl_clm +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12/include_user_mods +A components/clm/cimetest/testmods_dirs/clm/snowlayers_12 +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/user_nl_clm +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly/include_user_mods +A components/clm/cimetest/testmods_dirs/clm/snowlayers_3_monthly + +========= Add unit tests for snow pack initialization (note: these were added + mainly to facilitate debugging InitSnowLayers; since this routine is + only used in cold-start, these are not critical unit tests, and can be + removed if the maintenance cost proves too high) +A components/clm/src/biogeophys/test/SnowHydrology_test/CMakeLists.txt +A components/clm/src/biogeophys/test/SnowHydrology_test/README +A components/clm/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology.pf +A components/clm/src/biogeophys/test/SnowHydrology_test + +List all existing files that have been modified, and describe the changes: + +========= Major rework to remove assumption of 5 snow layers - instead allow + runtime-setable number of snow layers, between 3 and 12. + Also, clean up white space throughout file, and add mode/indentation + emacs line. +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +========= Minor changes to remove assumption of 5 snow layers +M components/clm/src/biogeophys/SurfaceRadiationMod.F90 +M components/clm/src/biogeophys/SoilTemperatureMod.F90 + - also: remove unused variables, fix array argument declarations to + conform to conventions +M components/clm/src/main/initVerticalMod.F90 + - also: clean up some white space + +========= Add namelist variables to control number of snow layers and maximum SWE +M components/clm/src/main/clm_varcon.F90 +M components/clm/src/main/clm_varpar.F90 +M components/clm/src/main/controlMod.F90 +M components/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M components/clm/bld/CLMBuildNamelist.pm + +========= Minor changes needed for unit testing of SnowHydrologyMod +M components/clm/src/biogeophys/CMakeLists.txt +M components/clm/src/biogeophys/test/CMakeLists.txt +M components/clm/src/biogeophys/SnowSnicarMod.F90 +M components/clm/src/biogeophys/SnowHydrologyMod.F90 +M components/clm/src/biogeophys/AerosolMod.F90 +M components/clm/src/main/CMakeLists.txt +M components/clm/src/unit_test_stubs/main/histFileMod_stub.F90 + +========= Add tests with different number of snow layers +M components/clm/cimetest/testlist_clm.xml + +========= Unrelated change: remove unused variables in associate statements +M components/clm/src/biogeophys/SoilFluxesMod.F90 + +========= Remove a test that now passes (hooray for weird compiler bugs!) +M components/clm/cimetest/ExpectedTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: ok + All CLM45 and CLM50 tests have namelist differences; this is expected due + to addition of 2 new namelist items. + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r109 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r109 +Originator(s): sacks (Bill Sacks) +Date: Sat Jun 6 06:12:02 MDT 2015 +One-line Summary: Fix bug in DivideSnowLayers + +Purpose of changes: + + Fix bug in DivideSnowLayers. Leo van Kampenhout (l.vankampenhout@uu.nl) + discovered the bug and determined how to fix it. He found this bug in the + course of refactoring this routine to introduce loops; without this bug fix, + answers differed with his new logic that removes duplication. + + Specifically: Logic using many IF-statements is employed to see whether or + not a layer may be subdivided, depending on the layer thickness. Currently, + the test for subdividing the BOTTOM layer are only reachable when the layer + above it was also too thick. As it turns out, this is faulty as a situation + can arise where the bottom layers grows even though the layer above it was + not divided, i.e. dumped mass to it. The current understanding is that this + happens through meltwater percolation (liquid h2o is translated to thickness + as well). + + Note that the indentation has not been appropriately corrected, this is because this + fix is only temporary (less cluttered logic will be implemented next). + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2183 (incorrect logic for sub-dividing bottom +snow layer in DivideSnowLayers) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mark Flanner + +List any svn externals directories updated (cime, rtm, cism, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Bug fix, described above +M components/clm/src/biogeophys/SnowHydrologyMod.F90 + +========= Remove failures from here, now that we're using the file in cimetest +M components/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Change a failure type from FAIL to RUN (presumably due to new test + reporting) +M components/clm/cimetest/ExpectedTestFails.xml + +CLM testing: + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r108 + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: All clm4.5 and clm5 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Larger than roundoff. While not investigated carefully, Leo showed that + the impacts are relatively small, so this is believed NOT to be + climate-changing. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r108 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Fri May 29 15:14:26 MDT 2015 +One-line Summary: Crop changes from Sam Levis + +Purpose of changes: Crop model changes from Sam Levis. Increases the number of +crops to 64, with 78 total pfts. Requires new parameters file, surface dataset, +and land use timeseries files. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2146, 2155 + +Known bugs (include bugzilla ID): 2180, 2182 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: n/a + +Describe any changes made to the namelist: n/a + +List any changes to the defaults for the boundary datasets: + Regenerate surface data sets and land use timeseries to increase the number of + pfts and crops with data from Levis. New raw datasets: + rawdata/pftlanduse.3minx3min.simyr2000.c110913/mksrf_78pft_landuse_rc2000_c130927.nc + rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_78pft_landuse_rc2000_c150130.nc + +Describe any substantial timing or memory changes: + Increased memory usage for all crop runs. Exact consequences requires further study. + +Code reviewed by: andre, levis + +List any svn externals directories updated (cime, rtm, cism, etc.): n/a + +List all files eliminated: n/a + +List all files added and what they do: + components/clm/cimetest/ExpectedTestFails.xml - new expected fails file for upcoming cime xfail integration + components/clm/tools/clm4_5/mksurfdata_map/Makefile.data - automate generating all surface data sets + +List all existing files that have been modified, and describe the changes: + clm/bld/CLMBuildNamelist.pm - increase max pft, add info to error message, fix quoted empty string processing (bug 2146) + clm/bld/namelist_files/namelist_defaults_clm4_5.xml - point to new datasets + clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - update rawdata sets + clm/bld/namelist_files/namelist_definition_clm4_5.xml - update sim year range to avoid special cases for testing + clm/bld/test_build_namelist/t/test_do_harvest.pm - update test (bug 2146) + clm/bld/test_build_namelist/t/test_do_transient_crops.pm - update test (bug 2146) + clm/bld/test_build_namelist/t/test_do_transient_pfts.pm - update test (bug 2146) + + clm/cimetest/testmods_dirs/clm/crop_trans_f10/user_nl_clm - point to new datafiles + clm/cimetest/testmods_dirs/clm/crop_trans_sville/user_nl_clm - point to new datafiles + + clm/src/biogeophys/WaterStateType.F90 - workaround for pgi compiler bug + + clm/src/biogeochem/CNNDynamicsMod.F90 - new crop model + clm/src/biogeochem/CNPhenologyMod.F90 + clm/src/biogeochem/CNVegStructUpdateMod.F90 + clm/src/biogeochem/CropType.F90 + clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 + clm/src/biogeochem/VOCEmissionMod.F90 + clm/src/biogeophys/CanopyFluxesMod.F90 + clm/src/biogeophys/PhotosynthesisMod.F90 + clm/src/main/PatchType.F90 + clm/src/main/clm_varpar.F90 + clm/src/main/pftconMod.F90 + clm/src/main/subgridRestMod.F90 + clm/src/main/surfrdMod.F90 + + clm/tools/clm4_5/mksurfdata_map/README + clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - move file writes into functions. write to __dataset_name__.namelist + clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 - update for new crops + clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 + clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 - update for new crops, fix bug 2155. + + clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 - work around for an issue causing abort during urban dataset generation + clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 + + +CLM testing: regular + + build-namelist tests: + + yellowstone unit tests - ok + + unit-tests (components/clm/src): + + yellowstone_intel - ok + + regular tests (aux_clm40, aux_clm45): + + - yellowstone aux clm40 intel - ok + - yellowstone aux clm40 pgi - ok + - yellowstone aux clm45 intel - ok + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - ed - new parameters file - baseline failures expected, ok'd by rfisher + - ERP_D_Ld5.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags - baseline compare fails, roundoff level, unknown cause, ok'd by sacks + - ERP_E_Ld5.f19_g16.I1850CRUCLM45CN.yellowstone_intel.clm-default - baseline compare fails, only occurs with esmf - ok'd by mvertens + - yellowstone aux clm45 gnu - ok + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - yellowstone aux clm45 pgi - + - all namelist fail - new datasets and parameters + - crop - new crop model - baseline failures expected + - ed - new parameters file - baseline failures expected, ok'd by rfisher + - ERI_D_Ld9.f19_g16.I1850CLM45CN.yellowstone_pgi - roundoff in cpl baseline + - ERI_D_Ld9.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan - roundoff in baseline + - ERP_P15x2_Lm13.f10_f10.IHISTCLM45BGC.yellowstone_pgi.clm-monthly - new xfail, #2182, dies at runtime in optimized, threaded pgi builds only. + - yellowstone mksurfdata_map unit_testers - ok + - yellowstone tools tests - ok, known issues with PTCLMmkdata (bug 2180) + +CLM tag used for the baseline comparisons: clm4_5_1_r106 (bit for bit with clm4_5_1_r107) + +Changes answers relative to baseline: yes + + Summarize any changes to answers, i.e., + - what code configurations: crop, ed + - what platforms/compilers: all + - nature of change : answer changes updated crop model. approved by levis. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - simulations with all pfts everywhere were run with merged code. Levis compared current runs with his archived runs. + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r107 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Tue May 19 10:05:49 MDT 2015 +One-line Summary: Update externals to use github version of cime1.0.7. + +Purpose of changes: Switch the cime external from using svn to github. Update cime to cime1.0.7. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (cime, rtm, cism, etc.): cime 1.0.7 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: regular + + build-namelist tests: + unit-tests: ok + system-tests: not run + + unit-tests (models/lnd/clm/src): + yellowstone: ok + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel 40 - ok; 45 - ok + yellowstone_pgi 40 - ok; 45 - ok + yellowstone_gnu (clm45 only) 45 - ok + +CLM tag used for the baseline comparisons: clm4_5_1_r106 + +Changes answers relative to baseline: none + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r106 +Originator(s): erik/fvitt +Date: Thu May 14 13:22:51 MDT 2015 +One-line Summary: Fix CO2 forcing for MEGAN + +Purpose of changes: + +Bring in changes from Francis Vitt, and Louisa Emmons to correct CO2 forcing +for MEGAN and dry-deposition. Previously, the fixed value of CO2 was being used +rather than using the CO2 forcing sent in from the atmosphere model. + +Also fix some issues with clm4_0 code where some urban diagnostic fields have +a different fill-value pattern on restart from startup. Fill-value is now only +set over non-land, and areas without urban, are set to zero. + ++M models/lnd/clm/src_clm40/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ ++M models/lnd/clm/src_clm40/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin ++ ++M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average ++ ++M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin ++ ++M models/lnd/clm/src/biogeophys/CanopyStateType.F90 ++ - get 10-day average of LAI rather than 1-day average + +Requirements for tag: Fix 2177 and some 2165 clm40 tests + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2177 (MEGAN improperly uses constant CO2 rather than time varying) + 2176 (ED doesn't work with MEGAN -- partial just turn MEGAN off when ED on) + 2165 (some clm40 tests have history files differ on restart in urban fillvalue) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Turn MEGAN off when ED on + Have build-namelist make sure MEGAN is off when ED is on + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,fvitt,simone,emmons + +List any svn externals directories updated (cime, rtm, cism, etc.): cime, cism + cime up to cime0_3_21 (bring in optional orbital calculation) + cism up to cism2_0_09 (just bring the branch to the trunk) + +List all files eliminated: None + +List all files added and what they do: Turn MEGAN off for ED tests + +A components/clm/cimetest/testmods_dirs/clm/edTest/shell_commands + +List all existing files that have been modified, and describe the changes: + + M components/clm/src_clm40/biogeophys/UrbanInitMod.F90 -- Initialize to + zero over land + M components/clm/src_clm40/main/clm_initializeMod.F90 --- Call urbanInit + before reading restart files + M components/clm/src_clm40/main/accFldsMod.F90 ---------- Change running mean + from 1 day to 10 days + M components/clm/src_clm40/main/clmtypeInitMod.F90 ------ Initilize to spval + + M components/clm/src_clm40/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average + M components/clm/src_clm40/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin + + M components/clm/src/biogeochem/VOCEmissionMod.F90 ++ - use time-dependent atmospheric CO2 concentrations rather than ++ the CCSM_CO2_PPMV constant value ++ - use 10-day average of LAI rather than 1-day average + M components/clm/src/biogeochem/DryDepVelocity.F90 ++ - science updates and bug fixes provided by Maria Val Martin + M components/clm/src/biogeophys/CanopyStateType.F90 ++ - get 10-day average of LAI rather than 1-day average + + M README_cime --- Update documentation + + M components/clm/bld/CLMBuildNamelist.pm -- Check that MEGAN off when ED on + M components/clm/bld/unit_testers/build-namelist_test.pl - Add check for + MEGAN off when ED on + M components/clm/bld/clm.buildnml --- only copy drv_flds_in over if it + was actually created. + + M components/clm/tools/README ---- Have documentation point to gen_domain + under cime/tools/mapping + +CLM testing: regular + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r105 + +Changes answers relative to baseline: Yes -- MEGAN diagnostic fields only! + as well as dry-deposition because of science update + + Summarize any changes to answers, i.e., + - what code configurations: All with MEGAN on + - what platforms/compilers: All + - nature of change: Diagnostic fields change + + VOC emissions change + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r105 +Originator(s): erik (Erik) +Date: Thu Apr 16 13:23:19 MDT 2015 +One-line Summary: Move test lists to beneath active components, change build scripts from cshell + to perl, move to new cime directory structure + +Purpose of changes: + + * Move CESM test lists from under scripts to under active components. + Now clm and rtm have their own CESM test lists under their "cimetest" directory. + * Change build scripts from cshell to perl + cshell is buggy with arbitrary problems with line lengths and number of arguments + cshell doesn't allow long scripts to be broken up into subroutine -- perl does +:::::::::: Get unit-testing working with directory structure change + M src/CMakeLists.txt + M src/README.unit_testing + +:::::::::: Get tools testing working with directory structure change + M test/tools/TBLtools.sh + M test/tools/TSMCFGtools.sh + M test/tools/TSMscript_tools.sh + M test/tools/TCBCFGtools.sh + M test/tools/TCBscripttools.sh + M test/tools/TSMncl_tools.sh + M test/tools/TBLCFGtools.sh + M test/tools/TSMtools.sh + M test/tools/TBLscript_tools.sh + M test/tools/TCBtools.sh + M test/tools/test_driver.sh + +:::::::::: Get tools working with directory structure change + M tools/clm4_0/mksurfdata_map/mksurfdata.pl + M tools/clm4_5/mksurfdata_map/mksurfdata.pl + M tools/shared/ncl_scripts/getco2_historical.ncl + +:::::::::: Updates to build + M bld/CLMBuildNamelist.pm + M bld/configure + M bld/queryDefaultNamelist.pl + M bld/listDefaultNamelist.pl + M bld/unit_testers/xFail/wrapClmTests.pl + M bld/unit_testers/xFail/expectedFail.pm + M bld/test_build_namelist/test_build_namelist.pl + M bld/namelist_files/checkmapfiles.ncl + M bld/namelist_files/namelist_definition.xsl + +:::::::::: Updates to documentation with new directory structure + M doc/README + M doc/UsersGuide/co2_streams.txt + M doc/Quickstart.userdatasets + M doc/Quickstart.GUIDE + M doc/KnownLimitations + M tools/README + M tools/README.filecopies + M tools/clm4_0/interpinic/README + M tools/clm4_0/mksurfdata_map/README + M tools/clm4_5/refactorTools/associate/README + M tools/clm4_5/refactorTools/clmType/README + M tools/clm4_5/mksurfdata_map/README + M tools/shared/mkmapgrids/README + M tools/shared/mkmapdata/README + M tools/shared/mkprocdata_map/README + M tools/shared/ncl_scripts/README + M tools/README.testing + M bld/README + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, and aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r104 + +Changes answers relative to baseline: + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r104 +Originator(s): erik (Erik) +Date: Tue Jan 27 11:22:48 MST 2015 +One-line Summary: Update externals to latest cesm beta tag + bring in shared build for clm4_5/clm5_0 for testing + +Purpose of changes: + +* Update externals to cesm1_3_beta15+ shared clm4_5/clm5_0 library build for testing. +* Fix BG1850CN @ f09 by changing fglcmask (Bill Sacks) +* Update more prealpha/prebeta tests to test with clm4_5 +* Create datasets for clm4_5 at ne16 and ne120 resolution + (for ne120 create rcp8.5 and rcp4.5 transient datasets) + M models/lnd/clm/src/cpl/lnd_comp_mct.F90 ----------- Add only for lnd_import_export use statement + +------------ Change so sample subsetting uses the high resolution datasets + M models/lnd/clm/tools/shared/ncl_scripts/README.getregional + M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist + M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + tools testing: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu (clm45 only) yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_1_r103 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: time-change all, roundoff-intel + - nature of change: roundoff + + Small change in driver changes time-stamps on history files by roundoff (drvseq5_1_05). + Normal cprnc comparison then does NOT compare fields and calls files different. Changes + in the intel build (on yellowstone) change answers to roundoff for intel on yellowstone + (Machines update between Machines_141125 and Machines_150106a causes answers to change) + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r103 +Originator(s): sacks (Bill Sacks) +Date: Thu Jan 1 06:15:57 MST 2015 +One-line Summary: enable transient crops + +Purpose of changes: + +(1) Allow transient crops! Note that carbon and nitrogen conservation still is + not done, but this at least allows crop areas to evolve in time. + +(2) Add control flags for which pieces of the transient dynamics should be done: + transient natural PFTs, transient crops, and/or harvest. + +(3) Reworked both source code and unit tests to be able to use the true CLM time + manager in unit tests rather than a stub version. Also added functionality + to time_info_type to be able to take the date from the end of the current + time step or the beginning of the time step. This flexibility was needed + because: (a) for crops, with an annual update, I wanted the update time to + be consistent with the glacier update time: the first time step after + crossing the year boundary (so take time from the start of the time step); + (b) for transient PFTs and harvest, for consistency with what was being done + before, we need to take the time from the end of the time step. + +(4) Make CNBalanceCheck more modular and object-oriented. Also, bypass the + balance check for newly-active columns, which is needed to avoid balance + check errors with transient crops. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: New control flags that control which +aspects of transient subgrid dynamics (and harvest) are turned on/off. This lets +you turn on/off transient natural PFTs, transient crops, and/or harvest +independently. + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: some pieces reviewed by Erik + + scripts: append_nl_value_n03_scripts4_141201 -> append_nl_value_n07_scripts4_141201 + esmf_wrf_timemgr: esmf_wrf_timemgr_141028 -> esmf_wrf_timemgr_141217 + +List all files eliminated: + +========= No longer use stub time manager - use true time manager instead +D models/lnd/clm/src/unit_test_stubs/utils/clm_time_manager_stub.F90 + +List all files added and what they do: + +========= Add transient crops +A models/lnd/clm/src/dyn_subgrid/dyncropFileMod.F90 + +========= Reads and stores namelist items controlling transient dynamics. This + allows turning off select pieces of the transient subgrid behavior. +A models/lnd/clm/src/dyn_subgrid/dynSubgridControlMod.F90 + +========= Add unit test utilities that wrap the clm time manager +A models/lnd/clm/src/unit_test_shr/unittestTimeManagerMod.F90 + +========= Start adding unit tests for the clm time manager +A models/lnd/clm/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf +A models/lnd/clm/src/utils/test/clm_time_manager_test/CMakeLists.txt +A models/lnd/clm/src/utils/test/clm_time_manager_test +A models/lnd/clm/src/utils/test/CMakeLists.txt +A models/lnd/clm/src/utils/test + +========= Test logic for new control flags +A models/lnd/clm/bld/test_build_namelist/t/test_do_transient_pfts.pm +A models/lnd/clm/bld/test_build_namelist/t/test_do_harvest.pm +A models/lnd/clm/bld/test_build_namelist/t/test_do_transient_crops.pm + +List all existing files that have been modified, and describe the changes: + +========= Reworked both source code and unit tests to be able to use the true + CLM time manager in unit tests rather than a stub version. Also added + functionality to time_info_type to be able to take the date from the + end of the current time step or the beginning of the time step. Note + that some unit test builds now need to link against the + esmf_wrf_timemgr library, if they use the time manager either directly + or indirectly. +M models/lnd/clm/src/utils/clm_time_manager.F90 +M models/lnd/clm/src/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 +M models/lnd/clm/src/unit_test_stubs/utils/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt +M models/lnd/clm/src/unit_test_shr/CMakeLists.txt +M models/lnd/clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +M models/lnd/clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +M models/lnd/clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/Daylength_test/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt +M models/lnd/clm/src/utils/CMakeLists.txt + +========= Changes related to new control flags, as well as the rework of the + time_info%set_current_year interface +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 + +========= Changes related to new control flags and addition of transient crops +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Moved flanduse_timeseries and other control flags into dynSubgridControlMod +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/subgridRestMod.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/biogeochem/CNDriverMod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 + +========= Make CNBalanceCheck more modular and object-oriented +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 + - also, bypass balance checks for newly-active columns (needed to + avoid balance check errors for newly-active crop columns) +M models/lnd/clm/src/biogeochem/CNVegNitrogenStateType.F90 +M models/lnd/clm/src/biogeochem/CNVegCarbonStateType.F90 +M models/lnd/clm/src/main/clm_instMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 + - also make alt_calc operate over inactive as well as active points + +========= Added new control flags +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +========= Make test files (more) consistent with actual files. This may not have + been necessary. +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml + +========= Minor changes (e.g., changes to comments and other small changes) +M models/lnd/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 +M models/lnd/clm/src/dyn_subgrid/do_genf90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +M models/lnd/clm/src/biogeophys/ActiveLayerMod.F90 + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + Note that there are differences from baseline due to new control flags + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r102 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r102 +Originator(s): sacks (Bill Sacks) +Date: Sat Dec 27 06:52:20 MST 2014 +One-line Summary: make new input datasets to support transient crops + +Purpose of changes: + +While the main purpose of this tag was to make new input datasets to support +transient crops, it also includes a number of reworks of mksurfdata_map, which +were either central or tangential to this overall goal. Specifically: + +(1) Update mksurfdata_map to be able to generate datasets with transient + crops. Currently the logic uses the non-prognostic-crop raw data for the + transient time series: It takes the area of the generic crop from that + timeseries to specify the transient PCT_CROP area, and sets the PCT_CFT + areas based on the year-2000 areas. + +(2) Rewrite mksurfdata_map code that normalizes pct_pft to account for special + landunits. The code to handle urban was very confusing, and I hope this new + code is at least astep towards being less confusing. Note that this + introduces roundoff-level differences. + +(3) Introduce new mksurfdata_map utility routines: ncd_def_spatial_var and + ncd_put_time_slice. These encapsulate behavior that used to be duplicated in + the code. + +(4) Add mksurfdata_map unit tests using the new pfunit-based unit testing + framework. However, I have NOT done a full migration of the mksurfdata_map + unit tests. Thus, there are still some tests that use the old unit testing + framework that I put in place (which leveraged the test stuff that Erik set + up for csm_share a while ago). These tests can be migrated to pfunit + incrementally: as someone touches code that is under test using the old + framework, they could move the relevant tests into the new pfunit-based + framework. + +(5) Create new input datasets, based on the above changes: + + - new flanduse_timeseries files created because I have changed the + information on these files + + - new surface datasets created because I introduced roundoff-level changes + in the surface datasets, and so regenerated all surface datasets now in + order to save someone a headache later. + + - new initial conditions files created so that out-of-the-box initial + conditions will be compatible with the surface datasets, according to + various consistency checks. + + See the following files in inputdata for documentation of how the new + datasets were created: + + lnd/clm2/surfdata_map/README_c141219 + lnd/clm2/initdata_map/README_c141226 + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: +- new surface datasets +- new flanduse_timeseries files +- new initial conditions files + +List any changes to the defaults for the boundary datasets: +- new surface datasets +- new flanduse_timeseries files +- new initial conditions files + +Describe any substantial timing or memory changes: none + +Code reviewed by: Most changes sent to Erik for review, although I can't +remember how much he actually reviewed. + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: append_nl_value_n02_scripts4_141201 -> append_nl_value_n03_scripts4_141201 + - point tropicAtl_subset tests to new file + +List all files eliminated: + +========= Move tests elsewhere +D models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkpftMod.F90 + + +List all files added and what they do: + +========= New object-oriented class for storing and operating on pct_pft + data. Encapsulating a bunch of behavior in here allowed me to simplify + other code. Before this, I was keeping track of two separate + representations of pct_pft: First it was stored as % of grid cell, + then it was later converted into % of landunit together with the + landunit's % of grid cell. This was starting to get hard to manage, + because certain operations could only be done on the first + representation, and other operations could only be done on the second + representation – and at some point in the processing pipeline, the + conversion happened and the first representation was no longer + usable. Now there is a single representation, and the class allows any + desired operation to be performed on that single representation. This + adds some complexity within the class, but removes complexity from the + rest of the code, particularly mksurfdat.F90. +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpctPftTypeMod.F90 + +========= This new module contains routines that operate on both instances of + pct_pft_type (pctnatpft and pctcft) at once. Thus, this contains + higher-level logic than was appropriate for mkpctPftTypeMod. Yet, I + wanted these routines in a separate module from mkpftMod as an aid to + testing, since mkpftMod has a bunch of dependencies. +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftUtilsMod.F90 + +========= Moved constants from other places into here, partly to centralize + them, and partly to remove problems with circular dependencies +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 + +========= Add automated test of making a transient crop surface dataset +A models/lnd/clm/test/tools/nl_files/mksrfdt_10x15_crp_1850-2000 + +========= Add input file for creating a transient smallville dataset for testing + transient crops +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README.landuse_timeseries_smallvilleIA_hist_simyr1850-1855 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README +A models/lnd/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files + +========= Add pfunit-based unit tests for mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_adjust_total_veg_area.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_convert_from_p2g.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/test_mkpctPftType.pf +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test/CMakeLists.txt +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/test +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/README.unit_testing + + +List all existing files that have been modified, and describe the changes: + +========= Changes that take advantage of some of the other refactoring described + here, plus add logic to allow input dataset to not contain crops even + when generating a transient dataset for crops; also add PCT_CROP and + PCT_CFT on the landuse_timeseries output file +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Changes that take advantage of some of the other refactoring described + here, especially making use of the new pct_pft_type methods. Plus: (a) + save pctcft from the initial input file so it can be used when + generating landuse_timeseries, (b) remove unwanted landunit percents + from the landuse_timeseries file, (c) add transient PCT_CROP and + PCT_CFT, (d) complete rewrite of the code that normalizes pct_pft to + account for special landunits: the code to handle urban was very + confusing, and I hope this new code is at least a step towards being + less confusing [this change introduces roundoff-level differences], + (e) remove some error-checking code that is now embedded in the + pct_pft_type routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + +========= Updated for new files +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles + +========= Added two new routines: ncd_def_spatial_var and + ncd_put_time_slice. These encapsulate behavior that used to be + duplicated in the code. Also, moved convert_latlon from mkutilsMod to + here, since it is really related to netcdf stuff. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 + +========= Simplify this module significantly by using the new + ncd_def_spatial_var. Also change what fields are present on the + transient landuse file: remove some no-longer-desired fields (% of + special landunits, etc.). +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 + +========= Use new ncd_def_spatial_var +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 + +========= Delete routines that have been moved to a more appropriate place +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 + +========= Remove tests from old test framework for code that I have deleted or + migrated to my new modules; and fix some minor errors that appeared + when runnng the old unit tests with gfortran. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 + +========= Trivial changes (change 'use' statements to reflect migrated code, add + comments, etc.) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 + +========= Add logic needed for creating transient crop datasets. The main + differences are (a) for crop, we create a year-2000 surface dataset + together with the transient dataset (rather than a year-1850 surface + dataset), and (b) we always use the non-crop transient raw data, even + when creating a transient crop dataset. +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +========= New fsurdat, flanduse_timeseries and finidat files +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Add automated test of making a transient crop surface dataset +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + tools tests: + + yellowstone: ok + + Note that there were diffs in baseline comparisons for mksurfdata_map tests + (and the PTCLM test, which uses mksurfdata_map). See below for details + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r101 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: most clm4_5 runs + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Note that there were no source code changes in this tag, so the only + differences come from differences in datasets (fsurdat, + flanduse_timeseries, finidat). + + I confirmed that differences in fsurdat and flanduse_timeseries are + generally roundoff-level. There are greater than roundoff-level diffs in + PCT_NAT_PFT at a small number of points, but all of these points have + PCT_NATVEG = 0 (this is due to a fix in how PCT_NAT_PFT is determined for + points with 0% vegetated landunit, and > 0% urban); this would only affect + dynamic landunit runs. Other than that, max normalized RMS diffs are 2e-8, + and most are considerbly smaller. + + finidat files were created as one-offs to ensure that the only differences + are in the subgrid weights, arising from these surface dataset differences. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r101 +Originator(s): sacks (Bill Sacks) +Date: Tue Dec 9 06:27:39 MST 2014 +One-line Summary: rework cold start initialization for transient runs + +Purpose of changes: + + (1) Do not adjust subgrid weights (or set harvest variables) in cold start + initialization. Instead, wait to do this until the first run step. The + motivation for this is (a) this is consistent with what is done for + glacier (for which prognostic weights aren't available until the run + phase), and (b) it simplifies what needs to be done in initialization, + particularly for transient crops (which are coming soon). + + (2) Do not run the biogeophys & biogeochem dyn subgrid conservation code in + the first step of a cold start run. This affects the current operation of + glacier, and is important in conjunction with (1): this avoids doing a + large adjustment of physics or BGC caused by a fictitious change in area + in the first time step after cold start. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens reviewed conceptual changes to clm_time_manager and + DaylengthMod; other changes only reviewed by self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes, as documented above +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 + +========= Unrelated change: Fix a possible threading bug in DaylengthMod + (although this would rarely cause problems: I think this would only + cause a problem if you started / restarted exactly on the solstice) +M models/lnd/clm/src/utils/clm_time_manager.F90 +M models/lnd/clm/src/biogeophys/DaylengthMod.F90 + + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r100 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 cold start runs with glacier and/or + transient PFTs + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Changes answers only in initialization. This shows up as changes in the + fields set to the coupler in initialization, and/or changes in the initial + history file. In offline runs (I compsets), this change does not affect + the simulation beyond initialization, but it is expected to change the + evolution of the system in coupled runs. However, again note that this + only affects cold start runs wth glacier and/or transient PFTs, which + would not be typical for production runs. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r100 +Originator(s): sacks (Bill Sacks); most changes from Jim Edwards +Date: Wed Dec 3 06:21:13 MST 2014 +One-line Summary: update pio calls to pio2 API + +Purpose of changes: + + Update pio calls to the pio2 API, so that the transition to pio2 will be + seamless. Most changes were from Jim Edwards. There are also some other minor + changes that are unrelated to this main change, as noted below. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: sacks + +List any svn externals directories updated (csm_share, mct, etc.): + + pio: pio1_8_13 -> pio1_9_5 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Main changes needed for pio2 API +M models/lnd/clm/src_clm40/main/ncdio_pio.F90 +M models/lnd/clm/src_clm40/main/ncdio_pio.F90.in +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in + +========= Change 2-d array to 1-d. Jim says he thinks this was also needed for + pio2 support. +M models/lnd/clm/src_clm40/main/histFileMod.F90 +M models/lnd/clm/src/main/histFileMod.F90 + +========= Unrelated change: change len to len_trim. Jim says this was needed to + fix a problem on some machine. +M models/lnd/clm/src_clm40/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 + + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r099 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r099 +Originator(s): sacks (Bill Sacks) +Date: Tue Dec 2 15:05:09 MST 2014 +One-line Summary: add ozone stress code from Danica Lombardozzi + +Purpose of changes: + +(1) Implement ozone stress. The scientific implementation was done by Danica + Lombardozzi. The software reimplementation was done by Bill Sacks. + +(2) Fix some misc. bugs, including a restart bug that was introduced in r097. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 2091: some restarts not bit-for-bit starting in clm4_5_1_r097 +- 2029: Memory leak in GetGlobalValuesMod + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ +- 2094: ozone code doesn't work with the PGI compiler + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new namelist option, use_ozone + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: ozone changes reviewed by Danica Lombardozzi (she reviewed +both the code and the changes seen due to ozone in a short simulation) + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: append_nl_value_n02_scripts4_141129 -> append_nl_value_n02_scripts4_141201 + +List all files eliminated: + +List all files added and what they do: + +========= Implement ozone stress. Uses polymorphism to handle ozone-on vs. ozone-off. +A models/lnd/clm/src/biogeophys/OzoneFactoryMod.F90 +A models/lnd/clm/src/biogeophys/OzoneOffMod.F90 +A models/lnd/clm/src/biogeophys/OzoneBaseMod.F90 +A models/lnd/clm/src/biogeophys/OzoneMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Calculate and apply ozone stress +M models/lnd/clm/src/biogeophys/PhotosynthesisMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/main/clm_instMod.F90 + - also fix restart bug (bug 2091) +M models/lnd/clm/src/main/clm_driver.F90 + +========= Add namelist flag to turn ozone on +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 + +========= Fix memory leak (bug 2029) +M models/lnd/clm/src/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src_clm40/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 + +========= Workarounds for compiler bugs +M models/lnd/clm/src/biogeochem/CNDVType.F90 +M models/lnd/clm/src/biogeochem/CNDriverMod.F90 + +========= Improve documentation comments for compiler bug workarounds +M models/lnd/clm/src/biogeophys/IrrigationMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 + +========= Add allocation of Points, matching behavior of true routine +M models/lnd/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + Remove these two entries that now pass: + restarts not bit-for-bit + error on hist comparison + + Add this new failure: + compiler bug in PGI's handling of polymorphism + + +CLM testing: + + Note: testing was done on ozone_polymorphism_n09_clm4_5_1_r098, which was + before I put in place the abort if you're trying to run ozone with pgi. After + that, I ran two tests with pgi (one with ozone and one without), and one test + with intel (with ozone) in order to make sure that the abort check was put in + properly. After all testing was complete, I reverted accidental whitespace + changes in clm_initializeMod.F90 and restFileMod.F90 - I did not run any + additional testing after reverting those whitespace changes. + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + + Also, ran these two additional tests, with comparisons to baselines - these + are tests that I have replaced with new tests: + + ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrigOn_reduceOutput + + +CLM tag used for the baseline comparisons: clm4_5_1_r098 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r098 +Originator(s): sacks (Bill Sacks) +Date: Sat Nov 29 06:18:59 MST 2014 +One-line Summary: update externals to cesm1_3_beta14 or beyond + +Purpose of changes: + + Update most externals to cesm1_3_beta14 or beyond. The one exception is mct, + for which I had trouble accessing the tag at the location used in beta14, so + I am sticking with the previous mct tag. + + Some notable changes: + + (1) update in intel compiler on yellowstone to intel15 + + (2) robust fix for number of datm streams, using Sean Santos's dynamic vector + + (3) testmods reworked to use recursive testmods + + (4) unit_testing, CMake & Machines updated so that unit tests now work on + yellowstone + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/refactor_koven_tags/refactor_koven_n02_scripts4_141023 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/append_nl_value_tags/append_nl_value_n02_scripts4_141129 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141017a ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141125 +-scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140715 ++scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_141122 +-models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_17 ++models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_18 +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141022 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141121 +-models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_140529 ++models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_141028 +-models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_12/pio ++models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_13/pio +-tools/load_balancing_tool https://svn-ccsm-models.cgd.ucar.edu/tools/load_balancing_tool/trunk_tags/load_balancing_tool_140818/ ++tools/load_balancing_tool https://svn-ccsm-models.cgd.ucar.edu/tools/load_balancing_tool/trunk_tags/load_balancing_tool_141008 +-tools/pyReshaper https://subversion.ucar.edu/asap/pyReshaper/tags/v0.9.1/ ++tools/pyReshaper https://proxy.subversion.ucar.edu/pubasap/pyReshaper/tags/v0.9.1 +-tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_08 ++tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_12 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Workaround for pgi internal compiler error +M models/lnd/clm/src/main/clm_driver.F90 + +========= Rework README, mainly to remove the need for using '--clean' +M models/lnd/clm/src/README.unit_testing + +========= Move an xfail from goldbach to yellowstone; add xfail for ERS_Ly5 test + (bug 2091) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Update what machine-comiler combos we test +M .ChangeLog_template + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone: ok + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu (clm45 only): ok + goldbach_nag: ok + + Other than xFails, note that the following failed: + + *** presumably this failed in the previous tag, so baselines didn't exist + BFAIL SMS_D.1x1_mexicocityMEX.I.goldbach_nag.compare_hist.clm4_5_1_r097 + + *** ozone tests that won't work until an upcoming tag that brings ozone in + SFAIL ERS_D.f10_f10.I1850CLM45.goldbach_nag.clm-o3.GC.1128-0838.45.n + SFAIL PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrig_o3_reduceOutput.GC.1128-0838.45.p + SFAIL ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrig_o3_reduceOutput.GC.1128-0838.45.i + + Also, note that the following test failed: + + FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan + + This appears to be a scripts problem. Since Mariana wants to do away with + ERH tests anyway, I just replaced this with: + + PASS ERI_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-drydepnomegan + + + Also ran the following two tests, which have been replaced with + (currently-failing) o3 tests: + + ERS_Ly5.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_pgi.clm-irrigOn_reduceOutput + + The PET test passed, but the ERS test failed (see bug 2091) + +CLM tag used for the baseline comparisons: clm4_5_1_r097 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: yellowstone-intel + - nature of change (roundoff; larger than roundoff/same climate; new climate): + NOT INVESTIGATED + + These diffs are presumably due to the yellowstone-intel compiler upgrade + to v15. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r097 +Originator(s): mvertens mvertens (Mariana Vertenstein,UCAR/CSEG,303-497-1349) +Date: Mon Nov 24 11:06:30 MST 2014 +One-line Summary: major refactorization to introduce new soilbiogeochem data + types and routines that are independent of either ED or CN datatypes + +Purpose of changes: Major refactorization to introduce new soilbiogeochem + data types and permit ED and CN vegetation to be independent of each other + AND both work with either the same soilbiogeochem or in the future + potentially different soilbiogeochem modules + +Requirements for tag: None + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: bld/configure modified to + accomodate new directory structure - introduction of soilbiogeochem/ + directory + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Since use_cn and use_ed + are now mutually exclusive, CN memory is not longer allocated when ED is run + and the memory reduction (for f19_g16) seems to be about 50%. + +Code reviewed by: mvertens, muszala, sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts branch is used + https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/refactor_koven_tags/refactor_koven_n01_scripts4_141023 + +List all files eliminated, added and modified: (see below) +List all files added and what they do: (see below) +List all existing files that have been modified, and describe the changes: (see below) + +These are all grouped together here - since splitting the items up simply did +not make sense in this case + +--------------------------------------------------- +New module where all instances are now declared (moved from clm_initializeMod) +- all calls to instance restarts are here as well - so restFileMod + is greatly simplified +--------------------------------------------------- +A models/lnd/clm/src/main/clm_instMod.F90 + +--------------------------------------------------- +New soilbiogeochem/ directory introduced (new modules and data types) +--------------------------------------------------- +A models/lnd/clm/src/soilbiogeochem + +--------------------------------------------------- +CN state and flux types split into: +SoilBiogeoChem[Carbon|Nitrogen][State|Flux]Type and SoilBiogoechemStateType +CNVeg[Carbon|Nitrogen][State|Flux]Type and CNVegStateType +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNStateType.F90 +D models/lnd/clm/src/biogeochem/CNCarbonFluxType.F90 +D models/lnd/clm/src/biogeochem/CNCarbonStateType.F90 +D models/lnd/clm/src/biogeochem/CNNitrogenFluxType.F90 +D models/lnd/clm/src/biogeochem/CNNitrogenStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegCarbonFluxType.F90 +A models/lnd/clm/src/biogeochem/CNVegCarbonStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegNitrogenStateType.F90 +A models/lnd/clm/src/biogeochem/CNVegNitrogenFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemStateType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 + +--------------------------------------------------- +New modules in soilbiogeochem/ directory that are independent of CNVeg or ED types +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNDecompCascadeConType.F90 +D models/lnd/clm/src/biogeochem/CNNitrifDenitrifMod.F90 +D models/lnd/clm/src/biogeochem/CNVerticalProfileMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompMod.F90 +D models/lnd/clm/src/biogeochem/CNAllocationMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 +D models/lnd/clm/src/biogeochem/CNDecompCascadeCNMod.F90 +D models/lnd/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 +A models/lnd/clm/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 + +--------------------------------------------------- +Moved CNEcosystemDynMod to CNDRiverMod +--------------------------------------------------- +D models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 +A models/lnd/clm/src/biogeochem/CNDriverMod.F90 + +--------------------------------------------------- +Changes to modules in biogeochem/ directory to now use new datatypes (see above) +--------------------------------------------------- +A models/lnd/clm/src/biogeochem/C14BompbSpikeMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/biogeochem/CNDVDriverMod.F90 +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/biogeochem/SatellitePhenologyMod.F90 +M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/biogeochem/NutrientCompetitionMethodMod.F90 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNSharedParamsMod.F90 +M models/lnd/clm/src/biogeochem/CNDVType.F90 +M models/lnd/clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CropType.F90 +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/biogeochem/CNC14DecayMod.F90 + +--------------------------------------------------- +Moved frictionvel_type to FrictionVelocityMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/FrictionVelocityType.F90 + +--------------------------------------------------- +Moved aerosol_type to AerosolMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/AerosolType.F90 + +--------------------------------------------------- +Moved photosyns_type to PhotosynthesisMod +--------------------------------------------------- +D models/lnd/clm/src/biogeophys/PhotosynthesisType.F90 + +--------------------------------------------------- +Moved soilstate cold start initialization to a new module +--------------------------------------------------- +A models/lnd/clm/src/biogeophys/SoilStateInitTimeConstMod.F90 + +--------------------------------------------------- +Moved soilhydrology time constant initialization to a new module +--------------------------------------------------- +A models/lnd/clm/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 + +--------------------------------------------------- +ED Refactorization1 +(1) EDPhenologyMod changed to EDPhenologyType +(2) EDBioType moved as a module type (ed_clm_type) in EDCLMLINKMod.F90 +(3) EDVecPatchType no longer needed (for now is_veg, is_bareground and wt_ed are in PatchType.F90) +--------------------------------------------------- +D models/lnd/clm/src/ED/main/EDBioType.F90 +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +D models/lnd/clm/src/ED/main/EDVecPatchType.F90 +D models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 +A models/lnd/clm/src/ED/biogeochem/EDPhenologyType.F90 +A models/lnd/clm/src/ED/biogeochem/EDSharedParamsMod.F90 + +--------------------------------------------------- +ED Refactorization2 +(1) Modified EDTypesMod.F90 + Removed gridcell_edstate_type (array of pointers) and instance + gridcelledstate - now have the following ED types and instance + defined in clm_instMod.F90 and passed down in clm_initialize and clm_driver (top level) + type(ed_site_type), allocatable, target :: ed_allsites_inst(:) + type(ed_phenology_type) :: ed_phenology_inst + type(ed_clm_type) :: ed_clm_inst + so now have ed_allsites_inst which is an array of sites (at this point allocated at the + gridcell level - but that could easily be modified to be at some other level like the + column level +(2) In EDTypesMod.F90 added method map_clmpatch_to_edpatch that + maps a CLM vector patch to an ED linked-list patch - there is still + a one to one correspondence between an ED patch and a CLM vector patch. The + call looks like the following + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + +(3) In EDTypesMod.F90 added a ED Patch type-bound method set_root_fraction that computes + the root fraction for an ED patch +(4) In EDTypes.F90 eliminated the following components of userdata + type (site) , pointer :: firstsite_pnt => null() ! pointer to the first site in the system + type (cohort), pointer :: storesmallcohort => null() ! storage of the smallest cohort for insertion routine + type (cohort), pointer :: storebigcohort => null() ! storage of the largest cohort for insertion routine + These are no longer needed since the above pointers are now local variables + in EDCohortDynamics and EDPatchDynamics +--------------------------------------------------- +M models/lnd/clm/src/ED/main/EDVecCohortType.F90 +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +M models/lnd/clm/src/ED/main/EDInitMod.F90 +M models/lnd/clm/src/ED/main/EDMainMod.F90 +M models/lnd/clm/src/ED/main/EDTypesMod.F90 +M models/lnd/clm/src/ED/fire/SFMainMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +M models/lnd/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +M models/lnd/clm/src/ED/biogeophys/EDBtranMod.F90 + +--------------------------------------------------- +The following changes are implemented below (and in the above routines) +(1) _vars% changed to _inst% +(2) pft% changed to patch% +(3) merged ecophyscon and pftvarcon into single derived type pftcon (in pftconMod) + "use EcophysConType, only : ecophyscon" changed to "use pftconMod, only : pftcon" +(4) module save statements removed in majority of routines +--------------------------------------------------- +D models/lnd/clm/src/main/EcophysConType.F90 +D models/lnd/clm/src/main/pftvarcon.F90 +A models/lnd/clm/src/main/pftconMod.F90 +M models/lnd/clm/src/main/initInterp.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/main/landunit_varcon.F90 +M models/lnd/clm/src/main/accumulMod.F90 +M models/lnd/clm/src/main/subgridWeightsMod.F90 +M models/lnd/clm/src/main/decompInitMod.F90 +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/subgridRestMod.F90 +M models/lnd/clm/src/main/ColumnType.F90 +M models/lnd/clm/src/main/subgridMod.F90 +M models/lnd/clm/src/main/PatchType.F90 +M models/lnd/clm/src/main/ndepStreamMod.F90 +M models/lnd/clm/src/main/lnd2atmType.F90 +M models/lnd/clm/src/main/atm2lndType.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/clm_varsur.F90 +M models/lnd/clm/src/main/LandunitType.F90 +M models/lnd/clm/src/main/GetGlobalValuesMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSubgridMod.F90 +M models/lnd/clm/src/main/filterMod.F90 +M models/lnd/clm/src/main/lnd2glcMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/main/initGridCellsMod.F90 +M models/lnd/clm/src/main/atm2lndMod.F90 +M models/lnd/clm/src/main/lnd2atmMod.F90 +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/surfrdMod.F90 +M models/lnd/clm/src/main/decompMod.F90 +M models/lnd/clm/src/main/reweightMod.F90 +M models/lnd/clm/src/main/readParamsMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/WaterfluxType.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/SnowSnicarMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/LakeTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/SoilFluxesMod.F90 +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +M models/lnd/clm/src/biogeophys/HumanIndexMod.F90 +M models/lnd/clm/src/biogeophys/PhotosynthesisMod.F90 +M models/lnd/clm/src/biogeophys/LakeFluxesMod.F90 +M models/lnd/clm/src/biogeophys/AerosolMod.F90 +M models/lnd/clm/src/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceResistanceMod.F90 +M models/lnd/clm/src/biogeophys/SoilStateType.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyType.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 +M models/lnd/clm/src/biogeophys/UrbanAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/biogeophys/RootBiophysMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/biogeophys/SoilWaterMovementMod.F90 +M models/lnd/clm/src/biogeophys/SoilMoistStressMod.F90 +M models/lnd/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 +M models/lnd/clm/src/biogeophys/CanopyHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/EnergyFluxType.F90 +M models/lnd/clm/src/biogeophys/CanopyStateType.F90 +M models/lnd/clm/src/biogeophys/UrbanFluxesMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/UrbanRadiationMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/IrrigationMod.F90 +M models/lnd/clm/src/biogeophys/CanopyTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/UrbanParamsType.F90 +M models/lnd/clm/src/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynEDMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynVarMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/dyn_subgrid/dynInitColumnsMod.F90 +M models/lnd/clm/src/cpl/lnd_comp_esmf.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/lnd_comp_mct.F90 +M models/lnd/clm/src/utils/accumulMod.F90 +M models/lnd/clm/src/utils/domainMod.F90 + +--------------------------------------------------- +Changes for Unit testing +--------------------------------------------------- +R models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 +M models/lnd/clm/src/CMakeLists.txt + +--------------------------------------------------- +Configuration changes for new soilbiogeochem/ +--------------------------------------------------- +M models/lnd/clm/bld/configure + +CLM testing: + + unit-tests (models/lnd/clm/src): + + yellowstone - okay + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - okay + yellowstone_pgi - okay + yellowstone_gnu - okay + goldbach_nag - okay + + goldbach_intel (moved these to yellowstone_intel for future tests) + +CLM tag used for the baseline comparisons: clm4_5_1_r096 + +Changes answers relative to baseline: NO (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r096 +Originator(s): erik (Erik) +Date: Wed Nov 19 02:11:09 MST 2014 +One-line Summary: Several answer changing bug-fixes: snow grain size, lake hydrology, default settings, organic soil + +Purpose of changes: + +Bring in several bug-fixes most of which change answers. + +Snow grain size bug that Mark Flanner discovered under snow layer combination. +Lake hydrology fix from Zack Subin that would rarely cause the code to abort. Snow depth fix from +Sean Swenson. Use Priglent inversion as recommended by Charlie Koven. Correct population density for 2000 conditions +from 1850 to peroperly be 2000. Modify all Carbon on spinup from Dave Lawrenece. Add option to square or not square +the organic fraction (default is to square for clm4_5 and to NOT for clm5_0). Bug with pervious road that Keith +Oleson found. Simplify an if for urban to consistently use a double precision constant. Point to the new CLMNCEP_V5 +dataset. + +For clm4_0 rcp6 and rcp8.5 pftdyn datasets are updated for after 2005. + +Some fixes that don't change answers. Get the Prigilent inversion and usephfact options working again. +Fix a bug in interp_source option that Sean Swenson found. Split out test datasets for getregional script since +the datasets all have to be at the same resolution as the domain file. Also read filelist rather than use env +variables. + +Requirements for tag: Fix the bugs below + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1934 -- snow grain size (both clm4_0 and clm4_5). Just fix on clm4_5 side. + 1717 -- lake hydrology fix (clm4_5 only) + 1941 -- snowdp fix from Sean (both clm4_0 and clm4_5) (fix in clm4_5_1_r087) + 1759 -- ngwh for clm4_0 datasets (apply cesm1_2_x_n10_clm4_5_10) + 1772 -- use Priglent inversion + 1838 -- pop dens is 1850 for 2000 compsets + 1774 -- modify all Carbon on spinup + 1765 -- remove duplicate setting of bd and tkdry + 1764 -- Bug with pervious road + 2066 -- getregional_datasets.pl bug for long lists of files + 2067 -- get Prigilent inversion and usephfact options working. + 2081 -- point to new CLMNCEP_V5 version + 2061 -- make constant consistently double precision rather than have an if around it + 2089 -- bug in interp_source that Sean Swenson found + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Add organic_frac_squared=.false. logical as a clm5_0 default feature + The old behavior organic_frac_squared=.true. is on as before for clm4_5. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, swensosc, mflanner, subin + +List any svn externals directories updated (csm_share, mct, etc.): datm + update datm to datm8_141113 update CRUNCEP_V5 dataset version used + +List all files eliminated: None + +List all files added and what they do: + +=========== Split out getregional lists (all files in list MUST be at same res as domain file) +A models/lnd/clm/test/tools/nl_files/getregional_05popd +A models/lnd/clm/test/tools/nl_files/getregional_T62 +A models/lnd/clm/test/tools/nl_files/getregional_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_0.5popd +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_0.5popd +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_ndep +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist_T62 +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist_T62 + +List all existing files that have been modified, and describe the changes: + +=========== Change getregional tests +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_posttag_nompi_regression + +=========== Bring in +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist + +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ------------ correct number of tests +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ---- Update rcp6 and rcp8.5 pftdyn datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ---- Add organic_frac_squared, + set fin_use_fsat=.false. by default +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml -- Add organic_frac_squared +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ------ Correct year for popd from 1850 to 2000 +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml - Correct year for popd from 1850 to 2000 + +M models/lnd/clm/bld/CLMBuildNamelist.pm - Add organic_frac_squared and change setup_logic_more_vertlayers to + setup_logic_soilstate + +M models/lnd/clm/src/utils/CMakeLists.txt - Add namelist util to source list + +M models/lnd/clm/src/biogeochem/ch4Mod.F90 ------------- Pass fsurdat to initCold +M models/lnd/clm/src/biogeochem/CNCarbonStateType.F90 -- Use nlevdecomp_full in place of nlevdecomp +M models/lnd/clm/src/main/initInterp.F90 --------------- Change use of rbufsli to rbufslo +M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Pass nlfilename into soilstate_vars init +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Add col%itype(c) == icol_road_perv to an if condition +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Use 1.0_r8 constant always, rather than integer 1 + for clm4_5 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 --- Use Mass-weighted combination of radius for combo +M models/lnd/clm/src/biogeophys/SoilStateType.F90 ------ Add organic_frac_squared logical and namelist read + for it. Add two if's that determine if organic_frac + should be squared or not. +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 --- Break apart if-condition for snl==-1 + +CLM testing: regular + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes (although still fails) + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: (when tools modified or scripts updated (for PTCLM)) + + yellowstone interactive yes + PTCLM (models/lnd/clm/tools/shared/PTCLM/test) yellowstone yes + +CLM tag used for the baseline comparisons: + +Changes answers relative to baseline: Yes! + + Summarize any changes to answers, i.e., + - what code configurations: clm4_5 and clm5_0 + - what platforms/compilers: all + - nature of change (similar climate, except new clm5_0 feature) + + clm4_0 for rcp6 and rcp8.5 changes answers by using the new good wood harvest + datasets for after 2005. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + /home/erik/noorg_clm451r092_I1850CRUCLM45BGC -- clm4_5 default version + /home/erik/clm451r092_I1850CRUCLM45BGC -------- clm4_5 with organic_frac_squared=.false. + (clm5_0 default version) + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r095 +Originator(s): andre (Benjamin Andre,UCAR/CSEG,303-497-1391) +Date: Mon Nov 10 17:54:18 MST 2014 +One-line Summary: refactoring N comp by Jinyun Tang (LBL) and transpiration sink isolation by Gautam Bisht (LBL) + +Purpose of changes: Bring in two refactorings: + Jinyun Tang (LBL) - isolation of the routines to do soil nutrient + competition dynamics into a module, and allow for different + implementations through runtime polymorphism. + + Gautam Bisht (LBL) - new function to make transpiration sink + distribution independent of subsurface flow physics + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2039 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: andre, cmt + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +Nutrient Competition + List all files added and what they do: + A clm/src/biogeochem/NutrientCompetitionFactoryMod.F90 - factory module to select soil nutrient competition method + A clm/src/biogeochem/NutrientCompetitionMethodMod.F90 - abstract base class for soil nutrient competition dynamics + A clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 - existing clm45 implementation of soil nutrient competition dynamics + + List all existing files that have been modified, and describe the changes: + M clm/src/biogeochem/CNDecompMod.F90 - add nutrient competition method to function parameters + M clm/src/biogeochem/CropType.F90 - rename UpdateAccVars() to work around pgi compiler error, remove dependency on temperature_type + M clm/src/biogeochem/CNAllocationMod.F90 - move code into clm45 default nutrient competition module + M clm/src/biogeochem/CNEcosystemDynMod.F90 - add nutrient competition method to function parameters + MM clm/src/main/clm_initializeMod.F90 - add nutrient competition method to function parameters + M clm/src/main/clm_driver.F90 - add nutrient competition method to function parameters, call to renamed CropUpdateAccVars + M clm/src/main/readParamsMod.F90 - add nutrient competition method to function parameters + +Transpiration Sink: + List all existing files that have been modified, and describe the changes: +M clm/src/biogeophys/SoilWaterMovementMod.F90 - move transpiration sink into separate function so it is independent of physics. + + +CLM testing: + + build-namelist tests: n/a + + unit-tests (models/lnd/clm/src): no + + yellowstone + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 4.0 ok; 4.5 ok + yellowstone_pgi - 4.0 ok; 4.5 ok + yellowstone_gnu - n/a; 4.5 ok + goldbach_nag - 4.0 ok; 4.5 ok + goldbach_intel - 4.0 ok; 4.5 ok + + short tests (aux_clm_short) - no + + tools testing: (when tools modified or scripts updated (for PTCLM)) - n/a + +CLM tag used for the baseline comparisons: clm4_5_1_r094 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r094 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Nov 7 13:43:38 MST 2014 +One-line Summary: misc. glacier-related updates + +Purpose of changes: + +(1) Add dlnd, satm and srof externals, so that TG compsets (CISM-only, forced by + dlnd) can be run from a CLM tag. This will facilitate CISM development and + testing. + +(2) Remove CLM's dependence on the CISM grid. Previously, CLM used the CISM grid + to determine which fglcmask file to use. But the differences between the + fglcmask files were inconsequential (all of them included the full area of + Greenland, which is what was important). I have created a new set of + fglcmask files that are independent of the CISM grid, and point CLM to these + new files. This will make it easier to add new CISM grids in the future, + because no changes will be needed in CLM for this purpose. However, note + that the use of these new files means that the number of virtual landunits & + columns changes for glcmec runs. + +(3) In subgridAveMod, fix c2l routines: change pft%wtlunit to col%wtlunit (bugz + 2077) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 2077 (c2l references pft instead of col) +- 2085 (listDefaultNamelist is broken) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: change fglcmask + +List any changes to the defaults for the boundary datasets: change fglcmask + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +========= Added new externals for the sake of running TG compsets (CISM-only) + from a CLM tag ++models/lnd/dlnd https://svn-ccsm-models.cgd.ucar.edu/dlnd7/trunk_tags/dlnd8_131201 ++models/atm/satm https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/satm ++models/rof/srof https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/srof + +========= Other externals updates +-tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_07 ++tools/unit_testing https://svn-ccsm-models.cgd.ucar.edu/unit_testing/trunk_tags/unit_testing_0_08 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +========= Remove dependence on CISM grid +M models/lnd/clm/bld/listDefaultNamelist.pl + - also fix bug 2085 +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/src_clm40/main/controlMod.F90 +M models/lnd/clm/src_clm40/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 + +========= Change pft%wtlunit to col%wtlunit in c2l routines (which currently + aren't called from anywhere in the code) (bugz 2077) +M models/lnd/clm/src/main/subgridAveMod.F90 + +========= fix numbers of build-namelist unit test failures, due to removal of a test +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + expected failure in 23, due to change in fglcmask + + unit-tests (models/lnd/clm/src): + + yellowstone: still broken, due to internal compiler error + roo2 (mac laptop): ok + + See notes in clm4_5_1_r090. Point (2) has been fixed, but point (1) remains. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: ok + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r093 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: IG compsets - both CLM40 and CLM45 + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + only changes diagnostic cpl hist fields - no change in the simulation + + The changes arise from the new glcmask files, which exclude a few points + from the glcmask that used to be included. These points are all outside + of Greenland, so they are not important for coupling to CISM. However, + it means that a few virtual columns have been removed. This, in turn, + changes the values of some l2x topo, tsrf and qice fields sent to the + coupler. But this does NOT feed back on the simulation in any way. + + Some tests also exhibit diffs in the CLM diagnostic fields PCT_GLC_MEC + and QICE_FORC. Again, these are due to changes in where we have virtual + columns, and do not affect the simulation. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r093 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Nov 7 13:17:47 MST 2014 +One-line Summary: change cold-start snow initialization, update cism external + +Purpose of changes: + +(1) Change cold-start snow initialization logic. The original logic did +different snow initialization depending on whether we are inside or outside the +glcmask. That's a problem in that answers change depending on the glcmask. The +new logic instead uses a latitude threshold for determining where to initialize +a non-zero snow pack. Note that this will change answers for all cold-start +cases, including non-glcmec cases. + +(2) Update CISM to version 2. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self; Dave Lawrence agreed with the change to snow initialization + +List any svn externals directories updated (csm_share, mct, etc.): +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140916 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism2_0_02 + + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/main/clm_initializeMod.F90 + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: ok + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r092 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + (1) any CLM4.5 case with cold start initialization, due to change in snow + initialization + + (2) any case that includes CISM, due to answer changes in the CISM external + + I carefully checked the yellowstone-intel clm4.5 tests to ensure that: + (a) FAILed compare_hist all had finidat = ' ' + (b) PASSed compare_hist either had non-blank finidat OR were single-point + + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated, but expected to be larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r092 +Originator(s): muszala (Stefan Muszala) +Date: Tue Nov 4 06:10:16 MST 2014 +One-line Summary: bug fixes from santos that address valgrind problems. update rtm external + +Purpose of changes: Addresses issues found with Valgrind by Santos. Update RTM. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: santos, self + +List any svn externals directories updated (csm_share, mct, etc.): +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_39 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_40 + +List all files eliminated: N/A + +List all files added and what they do: + +A + models/lnd/clm/src/main/dtypes.h + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- update failures + +M SVN_EXTERNAL_DIRECTORIES +-- rtm update to 40 + +M models/lnd/clm/src_clm40/main/ncdio_pio.F90 +M models/lnd/clm/src_clm40/main/ncdio_pio.F90.in +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in +-- example changes: +- status = pio_inq_vardimid(ncid, vardesc , dids) ++ status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + +M models/lnd/clm/src_clm40/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +-- change 1.0_8 to 1.0_r8 + +CLM testing: + + build-namelist tests: N/A + + unit-tests (models/lnd/clm/src): N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel 40- OK 45- OK + yellowstone_pgi 40- OK 45- OK + yellowstone_gnu 40- N/A 45- OK + goldbach_nag 40- OK 45- OK + goldbach_intel 40- OK 45- OK + + tools testing: (when tools modified or scripts updated (for PTCLM)) N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r091 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r091 +Originator(s): muszala (Stefan Muszala) +Date: Mon Oct 27 09:48:56 MDT 2014 +One-line Summary: update externals. fix bug so CLM runs with Intel 14x. + +Purpose of changes: Update externals. Fix bug in VOCEmissionMod.F90 that prevented +CLM from running with Intel 14x on yellowstone. Bring in workaround for bug 1730 from +Sacks. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ - see CLM test fail list + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, clm developers, particularly Bill Sacks. + +List any svn externals directories updated (csm_share, mct, etc.): +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_141009 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_141023 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141001 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_141017a +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141003 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_141022 +-models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_140416 ++models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_140925 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-- reflect changes in new testlists +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- Sacks' workaround for bug 1730 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/ncdio_pio.F90 +M models/lnd/clm/src/main/ncdio_pio.F90.in +-- remove duplicate assignment of 0_r8 to meg_out(imeg)%flux_out +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 +-- update externals +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + + Please view the CLM expected fail list for new test failures. They are matched + to bugzilla bug ids. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 - OK 45 - OK + yellowstone_pgi - 40 - OK 45 - OK + yellowstone_gnu - 40 - N/A 45 - OK + goldbach_nag - 40 - OK 45 - OK + goldbach_intel - 40 - OK 45 - OK + +CLM tag used for the baseline comparisons: clm4_5_1_r090 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r090 +Originator(s): sacks (Bill Sacks) +Date: Thu Oct 16 06:39:52 MDT 2014 +One-line Summary: modularize irrigation; do some unit test rework + +Purpose of changes: + +(1) Pull irrigation code out of CanopyFluxes and CanopyHydrology, into its + own module + +(2) Pull out the locally-created filters from CanopyFluxes and BareGroundFluxes + into filterMod, in order to support pulling irrigation out of + CanopyFluxes. This will also be needed to support pulling other hydrology + stuff out of CanopyFluxes. + +(3) Add unit tests for irrigation + +(4) Rework some irrigation infrastruture, and add some more unit test utility + routines + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2063 (HumanIndexMod fails to compile with gfortran) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: muszala + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Renamed to unit_test_stubs +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/GetGlobalValuesMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/util_share/do_genf90 +D models/lnd/clm/src/unit_test_mocks/util_share/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +D models/lnd/clm/src/unit_test_mocks/util_share +D models/lnd/clm/src/unit_test_mocks/csm_share/shr_mpi_mod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/csm_share/mct_mod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/csm_share +D models/lnd/clm/src/unit_test_mocks/main/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/main/histFileMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/main +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid/dynFileMod_mock.F90 +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks/dyn_subgrid +D models/lnd/clm/src/unit_test_mocks/CMakeLists.txt +D models/lnd/clm/src/unit_test_mocks + +========= Remove unnecessary files +D models/lnd/clm/src/ED/CMakeLists.txt +D models/lnd/clm/src/ED/biogeophys/CMakeLists.txt + +List all files added and what they do: + +========= Pull out irrigation code into its own module +A models/lnd/clm/src/biogeophys/IrrigationMod.F90 + +========= Add some unit test utility code (and some tests for the utility code) +A models/lnd/clm/src/unit_test_shr/unittestFilterBuilderMod.F90 +A models/lnd/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test/test_filterBuilder.pf +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr/test/unittestFilterBuilder_test +A models/lnd/clm/src/unit_test_shr/test/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr/test + +========= Renamed from unit_test_mocks to unit_test_stubs; also renamed + individual files from mock to stub (or 'fake' for ncdio_pio, because + it does more than a stub); also, moved some stubs to match the current + organization of the main source tree +A models/lnd/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils/do_genf90 +A models/lnd/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90.in +A models/lnd/clm/src/unit_test_stubs/utils/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/utils/clm_time_manager_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/utils +A models/lnd/clm/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/csm_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/csm_share +A models/lnd/clm/src/unit_test_stubs/main/histFileMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_var.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_var.F90.in +A models/lnd/clm/src/unit_test_stubs/main/GetGlobalValuesMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/main/do_genf90 +A models/lnd/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in +A models/lnd/clm/src/unit_test_stubs/main/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/main +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs/dyn_subgrid +A models/lnd/clm/src/unit_test_stubs/CMakeLists.txt +A models/lnd/clm/src/unit_test_stubs + +========= Add dependencies (direct & indirect) of IrrigationMod +A models/lnd/clm/src/biogeochem/CMakeLists.txt + +========= Add unit tests for irrigation (see README file for some design notes) +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_deficit.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_multipatch.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/IrrigationWrapperMod.F90 +A models/lnd/clm/src/biogeophys/test/Irrigation_test/test_irrigation_singlepatch.pf +A models/lnd/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt +A models/lnd/clm/src/biogeophys/test/Irrigation_test/README +A models/lnd/clm/src/biogeophys/test/Irrigation_test + +List all existing files that have been modified, and describe the changes: + +========= Pull irrigation out of CanopyFluxes into its own routine, and also + pull out the filters that used to be created locally in CanopyFluxes + and BareGroundFluxes +M models/lnd/clm/src/main/clm_driver.F90 + +========= Pull out filters that used to be created locally in CanopyFluxes and + BareGroundFluxes, so that they can be reused in irrigation and + elsewhere +M models/lnd/clm/src/main/filterMod.F90 + +========= Add calls to irrigation init & restart routines +MM models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 + +========= Irrigation computations are now done in the irrigation module; also, + the relevant filter is now created outside CanopyFluxes +MM models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +========= Irrigation computations are now done in the irrigation module +M models/lnd/clm/src/biogeophys/CanopyHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/LakeHydrologyMod.F90 + +========= Irrigation variables are now defined in the irrigation module +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/WaterfluxType.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 + +========= Filter is now created outside BareGroundFluxes; also, moved some bare + ground initialization from CanopyFluxes (needed because the filters + are no longer created locally, so CanopyFluxes does not know what + points it would need to set for bare ground) +MM models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 + +========= Remove some dependencies to aid unit testing (this includes combining + two branches of a conditional (allowlakeprod) that were doing the same + thing +M models/lnd/clm/src/biogeophys/SoilStateType.F90 + + +========= Add dependencies (direct & indirect) of IrrigationMod for unit testing +M models/lnd/clm/src/utils/CMakeLists.txt +M models/lnd/clm/src/main/CMakeLists.txt +M models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt +M models/lnd/clm/src/biogeophys/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/CMakeLists.txt + +========= Add new unit test utilities +M models/lnd/clm/src/unit_test_shr/CMakeLists.txt + +========= Make newly-added subgrid units active by default +M models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 + +========= Unrelated fix for gfortran +MM models/lnd/clm/src/biogeophys/HumanIndexMod.F90 + +========= Change whitespace +M models/lnd/clm/src/dyn_subgrid/CMakeLists.txt + + +CLM testing: + + build-namelist tests: + + yellowstone: not run + + unit-tests (models/lnd/clm/src): + + yellowstone: fail due to two issues: + + (1) The unit tests currently won't build on yellowstone due to an ICE that + will probably be fixed when we remove dependencies of SoilStateType. + + (2) In addition, even once that's fixed, the yellowstone unit tests either + need (a) a bump in the unit testing external (unit_testing_0_08) and + Machines external (Machines_141007) (I didn't do that for my tag because + it pulls in a bump in the intel compiler version to 14 rather than 13.1), + or (b) the following diffs: + + Index: tools/unit_testing/python/machine_setup.py + =================================================================== + --- tools/unit_testing/python/machine_setup.py (revision 64421) + +++ tools/unit_testing/python/machine_setup.py (working copy) + @@ -52,7 +52,7 @@ + mod.load("ncarenv/1.0") + mod.load("ncarbinlibs/1.0") + if compiler == "intel": + - mod.load("intel/13.1.2") + + mod.load("intel/14.0.2") + elif compiler == "pgi": + mod.load("pgi/13.9") + mod.load("ncarcompilers/1.0") + Index: scripts/ccsm_utils/Machines/config_compilers.xml + =================================================================== + --- scripts/ccsm_utils/Machines/config_compilers.xml (revision 64421) + +++ scripts/ccsm_utils/Machines/config_compilers.xml (working copy) + @@ -547,7 +547,7 @@ + -xHost + -xHost + $(TRILINOS_PATH) + - /glade/u/home/santos/pFUnit/pFUnit_Intel + + /glade/u/home/sacks/pFUnit/pFUnit3.0.1_Intel14.0.2_Serial + + + + + + + However, I have run the unit tests on my mac, with gfortran, and they all + pass + + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r089 + +Changes answers relative to baseline: YES (but only because of bug 1998) + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: irrigation + - what platforms/compilers: all + - nature of change: larger than roundoff, not investigated closely + + The changes are entirely due to the btran bug (bug 1998): The old flow was: + - compute btran + - calculate irrigation (depends on btran) + - hack btran for soybeans + + whereas the new flow is: + - call CanopyFluxes: computes btran and hacks btran for soybeans + - calculate irrigation (depends on btran) + + I have confirmed that answers are bit-for-bit for both irrigation tests (for + both cpl and clm hist files), when I introduce the following diffs in both + the trunk and the branch: + + Index: src/biogeophys/CanopyFluxesMod.F90 + =================================================================== + --- src/biogeophys/CanopyFluxesMod.F90 (revision 64406) + +++ src/biogeophys/CanopyFluxesMod.F90 (working copy) + @@ -842,9 +842,6 @@ + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + - if (pft%itype(p) == nsoybean .or. pft%itype(p) == nsoybeanirrig) then + - btran(p) = min(1._r8, btran(p) * 1.25_r8) + - end if + end do + + if ( use_ed ) then + @@ -894,9 +891,6 @@ + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + - if (pft%itype(p) == nsoybean .or. pft%itype(p) == nsoybeanirrig) then + - btran(p) = min(1._r8, btran(p) * 1.25_r8) + - end if + end do + + call Photosynthesis (bounds, fn, filterp, & + + + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r089 +Originator(s): erik (Erik) +Date: Mon Oct 13 13:46:43 MDT 2014 +One-line Summary: Bring new urban building temperature to trunk as a clm5.0 feature + as well as human-stress index calculations + +Purpose of changes: + +New prognostic internal building air temperature methodology for CLM5.0. Retain the older simpler method +for CLM4.5. The namelist toggle to switch between them is: building_temp_method. By default for clm4_5 physics +the older method is used and for clm5_0 the newer one is used. Also add in a package of human-stress index +calculations. Again this is by default on for clm5_0 and off for clm4_5. + +The new building air temperature methodology, solves the system of equations for internal: air, roof, floor, +and wall (shade and sunlit) Temperatures. It uses the LAPACK subroutine DGESV to solve the system. It also +figures out the energy flux needed to either cool the building air temperature to a maximum allowed temperature +or to heat it to the minimum allowed temperature. + +Add in the new load balancing tool and the PyReshaper tool (changes multi-variable +monthly history files into single-variable time-series files). + +Remove the now unneeded clm4_5 interpinic as well as the mkmapgrids FORTRAN program. + +Requirements for tag: Bring in new clm5_0 building temperature as option, Fix scripts bugs, bug 2053/2032 + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2053 Problems with dry-deposition for fully coupled cases with CLM4.5 in cesm1_3_beta13 + 2032 rtm.buildnml.csh kills cesm_setup if GET_REFCASE is FALSE + 1685 Drydeposition potentially using "rs" variable before it's defined (over water) + (was fixed but came back) + Fix bugs: 2024, 2035, 2037 in scripts SBN and namelistcompare issues + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: new namelists and namelist items + add: clmu_inparm and clm_humanindex_inparm namelists + move: urban_hac and urban_traffic to clmu_inparm + add: calc_human_stress_indices to clm_humanindex_inparm + building_temp_method to clmu_inparm + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + clm5_0 memory use is greater than clm4_5 due to human_stress_indices calculations + and output on history (I've seen it make up to a 20% difference) + +Code reviewed by: self, oleson, sacks, mvertens, andre + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, rtm, cism, csm_share + Update to cesm1_3_alpha13c externals. + Also add in load_balancing_tool and pyReshaper + + scripts to scripts4_141009 + Machines to Machines_141001 + rtm to rtm1_0_39 + cism to cism1_140916 + csm_share to share3_141003 + load_balancing_tool to load_balancing_tool_140818 + pyReshaper to v0.9.1 + +List all files eliminated: + +--------- Remove clm4_5 interpinic, online interpinic supersedes it +D models/lnd/clm/tools/clm4_5/interpinic +D models/lnd/clm/tools/clm4_5/interpinic/* +D models/lnd/clm/tools/clm4_5/interpinic/src/* + +--------- Remove mkmapgrids program +D models/lnd/clm/tools/shared/mkmapgrids/src +D models/lnd/clm/tools/shared/mkmapgrids/src/* +D models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.namelist +D models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.csh + +--------- shr_sys_mod was mocked only because of it's use of shr_mpi_mod +--------- mock shr_mpi_mod instead and standard shr_sys_mod can be used +D models/lnd/clm/src/unit_test_mocks/csm_share/shr_sys_mod_mock.F90 + +List all files added and what they do: + +A models/lnd/clm/src/biogeophys/HumanIndexMod.F90 -- New module to + calculate a bunch of human stress index values. + +A models/lnd/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 --- New module + for calculating the prognostic internal building air temperature. + +--------- New simple unit tester for humanstress indices module +A models/lnd/clm/src/biogeophys/test/HumanStress_test/test_humanstress.pf +A models/lnd/clm/src/biogeophys/test/HumanStress_test/CMakeLists.txt +A models/lnd/clm/src/biogeophys/test/HumanStress_test + +A models/lnd/clm/src/unit_test_mocks/csm_share/shr_mpi_mod_mock.F90 -- shell + for most shr_mpi_ calls that do nothing (so assumes MPI is NOT being done) + shr_mpi_abort does a stop + +List all existing files that have been modified, and describe the changes: + +--------- remove the mkgriddata and clm4_5 interpinic tools from testing +M models/lnd/clm/test/tools/input_tests_master +M models/lnd/clm/test/tools/tests_posttag_yong +M models/lnd/clm/test/tools/tests_posttag_nompi_regression +M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + +--------- remove documentation of mkgriddata and clm4_5 interpinic tools +--------- but add documentation on ncl script +M models/lnd/clm/tools/shared/mkmapgrids/README +M models/lnd/clm/tools/README + +--------- Add new namelists: clmu_inparm and clm_humanindex_inparm +M models/lnd/clm/bld/configure ---- use same configuration for clm4_5 AND clm5_0 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Set + calc_human_stress_indices, and building_temp_method by clm4_5/clm5_0 +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Move + urban_hac and urban_traffic to new clmu_inparm namelist and + add building_temp_method and add calc_human_stress_indices to + clm_humanindex_inparm namelist +M models/lnd/clm/bld/CLMBuildNamelist.pm -------- Handle new namelists: + clmu_inparm and clm_humanindex_inparm + +--------- Get unit tests working again, and add a simple humanindex test +M models/lnd/clm/src/utils/CMakeLists.txt +M models/lnd/clm/src/ED/main/CMakeLists.txt +M models/lnd/clm/src/ED/biogeophys/CMakeLists.txt +M models/lnd/clm/src/README.unit_testing +M models/lnd/clm/src/biogeophys/CMakeLists.txt +M models/lnd/clm/src/biogeophys/test/CMakeLists.txt +M models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 - set mpicom +M models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +M models/lnd/clm/src/CMakeLists.txt + +--------- Fix so can work with drydeposition namelist and without megan namelist +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - Don't initialize if + megan namelist is turned off (bug 2053) +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Make sure rs is set + before used (bug 1685) + +--------- Handle new building temperature options, add new constants +MM models/lnd/clm/src/main/clm_varcon.F90 -------- Bunch of new constants + for urban-building (should be moved to modules that use them). + Also pass is_simple_buildtemp into init method +MM models/lnd/clm/src/main/clm_initializeMod.F90 - Pass building temp type + down to relevent init methods add initialization for humanindex_vars, + initialize drydepvel_vars (bug 2053) +M models/lnd/clm/src/main/restFileMod.F90 ------- Pass building temp type + logicals down to energyflux_vars and temperature_vars restart methods +M models/lnd/clm/src/main/LandunitType.F90 ------ Add documentation, correct + error in documentation +MM models/lnd/clm/src/main/controlMod.F90 -------- Move urban namelist items to + UrbanReadNML, add HumanIndexReadNML +M models/lnd/clm/src/main/clm_driver.F90 -------- Pass humanindex_vars down as needed + +--------- Change for new shr_cal_mod names +M models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 - Use full name of month + "january" instead of "jan" + +--------- Add new building temperature module and add capability to do old clm4_5 +--------- method as well as new method, also do human_stress_indices calculations +MM models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 --- Add BuildingHAC for + simple building temp method (should move to it's own module) add if + statements for building_temp_method type, call BuildingTemperature + when prognostic method used +M models/lnd/clm/src/biogeophys/SoilFluxesMod.F90 -------- Change name of + eflx_building_heat to eflx_building_heat_errsoi +M models/lnd/clm/src/biogeophys/TemperatureType.F90 ------ Add building + temperature variables (should move to urbBuildTemp module), pass building_temp + method logical down for initialization, add documentation headers + hist, cold, and restart init depends on building temp method logical +M models/lnd/clm/src/biogeophys/LakeFluxesMod.F90 -------- calc_human_stress_indices + (should move to method in humanIndexMod) +MM models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 -- calc_human_stress_indices + (should move to method in humanIndexMod) +MM models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ------ calc_human_stress_indices + (should move to method in humanIndexMod) +M models/lnd/clm/src/biogeophys/EnergyFluxType.F90 ---- change name of eflx_building_heat_col + to eflx_building_heat_errsoi_col, add some new building temperature flux terms + add documentation, alloc, hist, restart and cold initialization depends on + building temperature method type (should move to urban building module) +M models/lnd/clm/src/biogeophys/UrbanFluxesMod.F90 ---- Add private functions: + wasteheat, simple_wasteheatfromac, calc_simple_internal_building_temp + (should move to building_temp modules). + calc_human_stress_indices (should move to method in humanIndexMod) +M models/lnd/clm/src/biogeophys/UrbanParamsType.F90 --- Add methods: UrbanReadNML, + IsSimpleBuildTemp, IsProgBuildTemp, add clmu_inparm namelist, and move urban_* items + there and add building_temp_method to it. + +CLM testing: + + build-namelist tests: + + yellowstone yes + + unit-tests (models/lnd/clm/src): + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + + short tests (aux_clm_short): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: + + yellowstone interactive yes + PTCLM (models/lnd/clm/tools/shared/PTCLM/test) yellowstone yes + +CLM tag used for the baseline comparisons: clm4_5_1_r088 + +Changes answers relative to baseline: No for CLM40 and CLM45 + But, answers DO change for CLM50 + (except scripts tag update changes history files for IG and irrigation compsets/tests) + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r088 +Originator(s): muszala (Stefan Muszala) +Date: Wed Oct 1 09:24:43 MDT 2014 +One-line Summary: Pull out ED deps. in TemperatureTypeMod, can now compile with pgi 14.7 + +Purpose of changes: Pull out the dependency on EDBioType in TemperatureType.F90. The ED +variables related to phenology now reside in EDPhenologyMod.F90. This refactor also had +the effect of getting past a PGI 14.7 ICE which looks like it was due to the use of EDbio_vars +in TemperatureType.F90. When I pulled out lines 1227 and 1226 of biogeophys/TemperatureType.F90 +(in clm4_5_1_r087) and passed the two EDbio_vars variables through the argument list the ICE +went away. + +This tag breaks ED restart tests. We went ahead with the tag because we had to fix a more +general problem with the CESM and CAM builds and PGI 14.7. the ED v0.1.0 branch does not +have these modifications and may be used as an alternative. A new clm tag will shortly +follow that addresses any remaining problems. + +Requirements for tag: None + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +Temporary addition of a cal parameter type in a branch tag. Will be merged into csm_share trunk shortly. + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/share_ece_tags/share_ece_01_140723 + +List all files eliminated: N/A + +List all files added and what they do: + +! new home for ED phenology variables and type-bound procedures that +! allow for accumulation of buffers +A + models/lnd/clm/src/ED/biogeophys/EDPhenologyMod.F90 +! put some CMakeLists.txt in place for ED unittests +A + models/lnd/clm/src/ED/main/CMakeLists.txt +A + models/lnd/clm/src/ED/biogeophys/CMakeLists.txt +A + models/lnd/clm/src/ED/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +! pull out deps. on EDBioType +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/clm_initializeMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/restFileMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/main/clm_driver.F90 + +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +! pull out ED_GDD_patch and phen_cd_status_patch +M models/lnd/clm/src/ED/main/EDBioType.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDMainMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +! add code for new class instance, EDphenology_inst +M models/lnd/clm/src/ED/main/EDInitMod.F90 + +! for ED unit tests +M models/lnd/clm/src/CMakeLists.txt + +! update CNED failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + +ERS CNED tests are failing in this tag. It is expected. expectedClmTestFails.xml is updated to reflect this. + + build-namelist tests: N/A + + yellowstone + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel 40-OK, 45-OK + yellowstone_pgi 40-OK, 45-OK + goldbach_nag 40-OK, 45-OK + goldbach_intel 40-OK, 45-OK + +CLM tag used for the baseline comparisons: clm4_5_1_r087 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r087 +Originator(s): erik (Erik) +Date: Tue Sep 30 12:07:10 MDT 2014 +One-line Summary: Fix two balance check errors, and turn abort for balance check back on to appropriate levels + +Purpose of changes: + +Fix two balance check errors that were causing problems for simulations. Also some of the balance check aborts +were turned off in clm4_5_1_r082, so turn them back on again. Tighten water balance error from 1.e-4 to 1.e-5. +Tighten LW, surface-flux and solar radiation balance errors from 1.e-3 to 1.e-5 and add warning for 1.e-7. +Turn surface-flux balance and soil balance check errors abort back on. Soil balance tightened to 1.e-4 (from 1.e-3) +with warnings shown at 1.e-6. + +Also bring in an update to PTCLM, and allow tools tester to be submitted to geyser or caldera. Just as an aside +as something that was already done. + +Requirements for tag: Fix bugs: 2026 and 1941 + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 2026 Soil balance error + 1941 snowdp balance error + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, swensosc + +List any svn externals directories updated (csm_share, mct, etc.): Update PTCLMmkdata version + + Update PTCLM to PTCLM2_140816 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/tools/test_driver.sh ------ Allow to run in caldera and geyser as well + +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Add aborts back as well as warnings + and tighten some error conditions and warnings. +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Remove calculation and use of the + heat capacity of frozen h2osfc layer but use the heat capacity of the liquid layer + as balance check doesn't know about the frozen, and the discrepency causes balance + check errors. +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 --- snow includes dew. + +CLM testing: + + build-namelist tests: + + yellowstone YES + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel YES + yellowstone_pgi YES + yellowstone_gnu (optional) YES + goldbach_nag YES + goldbach_intel YES + +CLM tag used for the baseline comparisons: clm4_5_1_r086 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 + - what platforms/compilers: ALL + - nature of change: same climate (some shorter simulations are still exact) + +Simulations that Keith ran to test the snowdp change are: + +/glade/p/work/oleson/urb2dev_n00_clm4_5_52/scripts/urb2dev_n03_clm4_5_64_V2DomLam_I20TRCRUCLM45 + +/glade/p/work/oleson/urb2dev_n00_clm4_5_52/scripts/urb2dev_n03_clm4_5_64_V2DomLam_IRCP85CRUCLM45 + + URL for LMWG diagnostics output used to validate new climate: + + For soil balance error... + +http://www.cgd.ucar.edu/staff/swensosc/public/diagnostics/ColdtestTRENDYspinupf091850CRU-ColdtestTRENDYspinupf091850CRU_control/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r086 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 25 09:04:08 MDT 2014 +One-line Summary: critical ED modifications from r fisher, fix bug 2043 + +Purpose of changes: add modifications to ED, particularly for cold deciduous. add + fix for bug 2043. Consider these ED baselines as fixed (ie. + unless you are modifying ED science, these should now be BFB). + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 2043 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, r fisher + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/main/lnd2atmMod.F90 +-- change intent of waterstate_vars to inout (fixes bug 2043) + +M models/lnd/clm/src/main/clm_driver.F90 +-- add EDbio_vars to edmodel actual argument list + +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +-- change leaves_off_switch and laimemory handling + +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +-- rework cold deciduous and threshold code. add fragmentation_scaler routine + +M models/lnd/clm/src/ED/main/EDMainMod.F90 +-- change argument lists to include EDbio_vars for ecosystem_dynamics and phenology + +M models/lnd/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +-- overhaul ED norman radiation code + +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +-- tweak calculation of jmax25top and tpu25top + +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +-- clean up two comments + +CLM testing: + + ED compsets change values. + + For bug 2043. Confirmed that a gnu compile on yellowstone gets passed the intent problem. + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 OK - 45 OK + yellowstone_pgi - 40 OK - 45 OK + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + +CLM tag used for the baseline comparisons: clm4_5_1_r085 + +Changes answers relative to baseline: Only for ED compsets + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r085 +Originator(s): sacks (Bill Sacks) +Date: Fri Sep 19 10:22:30 MDT 2014 +One-line Summary: replace conditionals with polymorphism for soil water retention curve + +Purpose of changes: + +The main motivation for this tag was the need to introduce a +soil_suction_inverse routine, which will be used for irrigation. It is important +that soil_suction_inverse remains consistent with soil_suction for every soil +water retention curve method. In talking with Ben Andre and Erik, we felt the +best way to ensure this consistency was to have a separate, small module for +each soil retention curve method. We felt the best way to implement this was via +polymorphism. Polymorphism is arguably overkill in this simple case, but we +thought it would be good to convert it to polymorphism partly as an example that +we and others can follow in more complex cases where it will provide greater +benefit. + +To add a new soil retention curve method: + + (1) Create a module similar to + SoilWaterRetentionCurveClappHornberg1978Mod.F90 + + (2) Modify the select case statement in SoilWaterRetentionCurveFactoryMod.F90 + so that it is able to create an instance of your new type + +Note that this refactor also combines the soil_suction and soil_hk +parameterization options into a single option. Dave Lawrence and Rosie Fisher +felt that was preferable, and Jinyun Tang was okay with this. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: andre, muszala, Jinyun Tang + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Replaced with the 3 new files noted below +D models/lnd/clm/src/biogeophys/SoiWatRetCurveParMod.F90 + +List all files added and what they do: + +========= Replacement for SoiWatRetCurveParMod, implemented using + polymorphism. Note that I have also added a soil_suction_inverse + routine, which is not yet used or tested. I'll be using (and testing) + this in an upcoming tag, where I refactor the irrigation code to use this. +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveMod.F90 +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 +A models/lnd/clm/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Minor changes to accommodate the refactored code +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/init_hydrology.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/biogeophys/SoilWaterMovementMod.F90 +M models/lnd/clm/src/biogeophys/SoilMoistStressMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyNoDrainageMod.F90 + + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + +CLM tag used for the baseline comparisons: clm4_5_1_r084 + +Changes answers relative to baseline: NO - bfb + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r084 +Originator(s): sacks (Bill Sacks) +Date: Thu Sep 18 14:39:44 MDT 2014 +One-line Summary: make glc_dyn_runoff_routing spatially-varying, based on input from glc + +Purpose of changes: + +Dave Lawrence, Bill Lipscomb and Jeremy Fyke have pointed out that +glc_dyn_runoff_routing needs to be spatially-varying: Even when we're coupling +to CISM, we should continue to use the old scheme in regions that don't have an +active icesheet model underneath (which currently includes Antarctica and all of +the world's smaller glaciers - i.e., everything except Greenland). Furthermore, +we have introduced a new ability into CISM to run in diagnostic mode, without +sending calving/runoff fluxes to the coupler. In this case, too, CLM should +revert to using the old scheme (glc_dyn_runoff_routing = .false.). + +To accomplish both of these things, I have introduced a new coupling field, +through which GLC tells CLM which areas have an icesheet that is "active" in the +sense of sending fluxes to the coupler. In this CLM tag, CLM sets a +spatially-varying version of glc_dyn_runoff_routing based on this new coupler +field - replacing the old, namelist-settable version of this flag. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: + + - removed glc_dyn_runoff_routing + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + drv: drvseq5_0_15 -> drvseq5_0_17 + - fix for some multi-instance runs + - add icemask_coupled_fluxes field + + cism: cism1_140602 -> cism1_140914 + - Add zero_gcm_fluxes option; send icemask_coupled_fluxes field to coupler + + scripts: scripts4_140916b -> scripts4_140916c + - Rename CLM_UPDATE_GLC_AREAS to GLC_TWO_WAY_COUPLING + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Rename CLM_UPDATE_GLC_AREAS xml variable to GLC_TWO_WAY_COUPLING. + Remove glc_dyn_runoff_routing namelist variable (this is now a + spatially-varying field, tied more tightly to CISM). +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/env_run.xml + +========= Receive icemask_coupled_fluxes from CISM +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 + +========= Set spatially-varying glc_dyn_runoff_routing field based on + icemask_coupled_fluxes, and use this in place of the old scalar + glc_dyn_runoff_routing flag +M models/lnd/clm/src/main/glc2lndMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/HydrologyDrainageMod.F90 +M models/lnd/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Add write statement to workaround a pgi compiler problem +M models/lnd/clm/src/main/restFileMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: ok (baseline comparisons fail for clm45 & clm50, as expected) + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + yellowstone_gnu: NOT RUN + goldbach_nag: ok + goldbach_intel: ok + + Note: Most testing was run on glc_runoff_routing_n06_clm4_5_1_r083. After + that tag, I added the following write statement in restFileMod, as a + workaround for a PGI compiler bug: + + write(iulog,*) 'about to call aerosol_vars%restart: ', ubound(waterstate_vars%h2osoi_ice_col) + + After that addition, I just reran a subset of tests: 6 yellowstone-intel + tests, 10 yellowstone-pgi tests (including the 2 that had failed due to the + compiler bug), and 5 goldbach-nag tests. + +NOTE: Unit test build is currently failing due to a change in r082. Stefan is +working on a fix. + +CLM tag used for the baseline comparisons: clm4_5_1_r083 + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with CISM (i.e., IG) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + (1) Large changes in runoff from glaciers in IG compsets, due to setting + glc_dyn_runoff_routing to .false. outside of Greenland. + + (2) Roundoff-level changes in icemask for some resolutions and compilers, + due to changes in the cism external. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? For icemask changes: examined cprnc RMS errors. For other + changes, diffs are greater than roundoff. + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r083 +Originator(s): muszala (Stefan Muszala) +Date: Wed Sep 17 09:21:31 MDT 2014 +One-line Summary: only update scripts and run new baselines. this due to an error in yellowstone pgi test naming (clm_aux45 changed to aux_clm45) + +Purpose of changes: Update scripts due to an error in a previous scripts tag in which I named pgi tests as clm_aux45 instead +of aux_clm45. These were for tests moved from goldbach to yellowstone. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_140910 -> scripts4_140916b + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +- update test list failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + WJS: note: Stef told me that he actually ran all the yellowstone tests, and + all were okay + + yellowstone_intel - 40 OK + yellowstone_pgi + + goldbach_nag - 40 OK, 45 OK + goldbach_intel - 40 OK, 45 OK + +Note 1: Due to the fact that in older baselines component_gen_comp was failing due to a scripts error (now fixed) +some older baselines don't have the clm history files. As one example: + + BFAIL ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.compare_hist.clm4_5_1_r082 + - rerun. compare against clm4_5_1_r081, then it passes. + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.memleak + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.compare_hist.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.memcomp.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.tputcomp.clm4_5_1_r082_oldPgi + PASS ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput.C.140917-082253.nlcomp + + For these tests, I made sure that clm2 history files were in the clm4_5_1_r083 baseline dirs. They + should pass going forward. + + ERI_D.f10_f10.ICRUCLM50BGC.goldbach_intel.clm-reduceOutput + PEM.f10_f10.ICLM45BGCCROP.goldbach_intel.clm-crop + SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default + +Note 2: For these N2 tests, there was a scripts problem with st_archiver in the previous tag. These should pass next time. + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.clm2.h0.compare_hist.clm4_5_1_r082 + BFAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.clm2.h1.compare_hist.clm4_5_1_r082 + +CLM tag used for the baseline comparisons: clm4_5_1_r082 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r082 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 11 14:07:58 MDT 2014 +One-line Summary: Merge in a number of ED changes to address science bugs and infrastructure (particularly restarts) + +Purpose of changes: Merge in ED changes. Most of these have to do with science changes from rfisher. There +is also a refactor and added functionality for ED restarts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): Bug 2041, 2042 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, rfisher + +List any svn externals directories updated (csm_share, mct, etc.): + scripts4_140814a -> scripts4_140910 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +-- add failing N2 tests (due to scripts, see below). + +M models/lnd/clm/bld/build-namelist +-- documentation at top of file should reference CLMBuildNamelist.pm + +M models/lnd/clm/src/main/clm_driver.F90 +-- add call to SurfaceAlbedo for use_ed logical branch, add EDBioVars as +-- argument to temperature_vars%UpdateAccVars and add canopystate_vars as +-- argument to BalanceCheck (for ED) +M models/lnd/clm/src/main/decompMod.F90 +-- added openMP output...remove mods after getting ED working with openMP + +M models/lnd/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +-- change handling of CWD_AG and CWD_BG +M models/lnd/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +-- added tree_sai function +M models/lnd/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +-- signifcant reworking of entire module +M models/lnd/clm/src/ED/biogeochem/EDPhysiologyMod.F90 +-- minor code clean up +M models/lnd/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +-- change an error check to: if (( areatot - area ) > 0._r8 ) then + +M models/lnd/clm/src/ED/main/EDBioType.F90 +-- add infrastrucutre (define, allocate, etc...) +M models/lnd/clm/src/ED/main/EDMainMod.F90 +-- major update for updating canopy biomass pools +M models/lnd/clm/src/ED/main/EDCLMLinkMod.F90 +-- modify calls for history file output and error checking +M models/lnd/clm/src/ED/main/EDRestVectorMod.F90 +-- add resp_clm as restart variable and use SHR_ASSERT instead of call assert. major refactor +-- of createPatchCohortStructure to handle arbitrary number of cohorts and patches +M models/lnd/clm/src/ED/main/EDInitMod.F90 +-- add logical to deal with different values of assignemnt dc%laimemory +M models/lnd/clm/src/ED/main/EDTypesMod.F90 +-- add cohort_type and change paramters: numCohortsPerPatch, cohorts_per_gcell and fire_threshold + +M models/lnd/clm/src/ED/fire/SFMainMod.F90 +-- clean up write statemnts and a bug fix: change tau_b(dg_sf) -> tau_b(c) + +M models/lnd/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +-- change tpu25top(FT) = 0.06_r8 * jmax25top(FT) to tpu25top(FT) = 0.167_r8 * jmax25top(FT), some cleanup + +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +-- clean up a use statement +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +-- remove whitespaces after a statement +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +-- add a use_ed block to prevent some unassigned pointer errors +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +-- add canopystate_vars as argument for elai and esai for more verbose error +-- reporting added by rfisher +M models/lnd/clm/src/biogeophys/TemperatureType.F90 +-- add arg. for UpdateAccVars for new calculations, split out use_ed and use_crop +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +-- add associate statement to tlai for error reporting + +M UpDateChangeLog.pl +-- fix tiny typo + +M SVN_EXTERNAL_DIRECTORIES +-- for scripts update + +CLM testing: + + build-namelist tests: + + yellowstone - N/A, no namelist changes made in this tag + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 45 OK , 40 OK + + Changes due to update of scripts from scripts4_140814a -> scripts4_140910 (this change came with scripts4_140828) + FAIL namelist compare: user_nl_clm differs + These should pass next time. + + NEW: flanduse_timeseries = '$DIN_LOC_ROOT/lnd/clm2/surfdata_map/surfdata.pftdyn_1x1_tropicAtl_TEST_simyr1939-1943_c140108.nc' + BASELINE: flanduse_timeseries = '/glade/p/cesmdata/cseg/inputdata/lnd/clm2/surfdata_map/surfdata.pftdyn_1x1_tropicAtl_TEST_simyr1939-1943_c140108.nc' + + FAIL SMS_Ly3.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetLate.GC.newPgi_45_intel.nlcomp + FAIL SMS_Ly5.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetMid.GC.newPgi_45_intel.nlcomp + FAIL SMS_Ly8.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetEarly.GC.newPgi_45_intel.nlcomp + + These fail due to a bug in scripts4_140905c. Alice is aware of this and will provide a fix for a future CLM tag (but 2041): + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default + + Failure that looks like a hardware problem and that Erik is looking into (bug 2042): + RUN ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.newPgi_45_intel + + yellowstone_pgi - 45 OK , 40 OK + + New PGI tests brought over from goldbach. These are expected as there are no baselines for this on yellowstone + + BFAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f10_f10.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICLM45.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI_D.f19_g16.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f10_f10.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f10_f10.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f19_g16.ICLM45BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERI.f19_g16.ICRUCLM50BGC.yellowstone_pgi.clm-reduceOutput.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-decStart.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_pgi.clm-ciso.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL ERS.f10_f10.I1850CLM45BGC.yellowstone_pgi.clm-default.compare_hist.clm4_5_1_r081 + BFAIL ERS_Lm3.1x1_smallvilleIA.ICLM45BGCCROP.yellowstone_pgi.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL ERS_Lm3.1x1_smallvilleIA.ICLM45BGCCROP.yellowstone_pgi.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS_D.1x1_vancouverCAN.ICLM45.yellowstone_pgi.clm-default.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLB.compare_hist.clm4_5_1_r081 + BFAIL SMS.f45_f45.ICLM45.yellowstone_pgi.clm-ptsROA.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.clm2.h0.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.clm2.h1.compare_hist.clm4_5_1_r081 + BFAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.yellowstone_pgi.clm-decStart.compare_hist.clm4_5_1_r081 + + goldbach_nag - 45 OK , 40 OK + + Baseline missing from previous tag: + ERI_D.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput- + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/ERI_D.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput/cpl.hi.nc does not exis + SMS.f09_g16.ICRUCLM45.goldbach_nag.clm-af_bias_v5 + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS.f09_g16.ICRUCLM45.goldbach_nag.clm-af_bias_v5/cpl.hi.nc does not exist + SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput/cpl.hi.nc does no + SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput + file /fs/cgd/csm/ccsm_baselines/clm4_5_1_r081/SMS_Ly1.f19_g16.ICLM45BGCCROP.goldbach_nag.clm-reduceOutput/cpl.hi.nc does no t exist + + goldbach_intel - 45 OK , 40 OK + + goldbach_pgi (These have been moved to yellowstone due to PGI 14.1 throwing and ICE on goldbach) + +CLM tag used for the baseline comparisons: clm4_5_1_r081 + +Changes answers relative to baseline: Only for ED compsets + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r081 +Originator(s): mvertens (Mariana Vertenstein) +Date: Sun Aug 24 19:39:50 MDT 2014 +One-line Summary: major infrastructure changes and directory reorganization under src + +Purpose of changes: + + Overview of previous code design + ========================================== + - data structures arranged by subgrid type (pps, cps, lps, grc) + - all functional categorization lumped in that one subgrid type which led to + - centralization rather than modularization of all data + - definition and instantiation in ONE big module (clmtype.F90) + - allocation and initialization in ONE big module (clmtypeInitMod.F90) + - history variables all in ONE big module (histFldsMod.F90) + - restart variables in effectively TWO big modules (biogeophysicsRestMod.F90 and CNRestMod.F90) + - time constant initialization in ONE complex module (initTimeConst.F90) + - time varying cold start initialization in ONE module (initColdMod.F90) + - accumulation variables in ONE module (accumulMod.F90) + + Overview of new code design + ========================================== + data structures arranged by scientific functional categories + (e.g. temperature_type, waterstate_type, energyflux_type, etc) + - a given data structure now contains ALL subgrid levels are in the data structure - + and variables in the data structure are now appended with a unique suffix to + indicate their subgrid levels (new suffixes: _patch, _col, _lun, _grc) + - this does NOT effect the science code base, ONLY the associate statements + - there are separate module for each data type definition + (e.g. TemperatureType.F90, WaterstateType.F90, EnergyFluxType.F90, etc) + - each data type has associated methods for + - Allocation: + variables now initialized as NaNs upon allocation + - Cold Start Initialization: + cold start initialization of variables is now ALWAYS done + and overwritten if finidat is read in as spun up dataset (also now + have on line interpolation of initial conditions as part of this refactor as well) + - History initialization of variables + All history fields now initialized as spval + - Restart initialization of variables + - Accumulation Initialization + initialization and accumulation update of variables + - Instantiation of datatypes is now separate from their declaration + (for now in clm_initialize.F90 - will be moved in the future) + + Centralized routines that no longer exist: + ========================================== + Data types : clmtype.F90, clmtypeInitMod.F90 + Initialization : initTimeConst.F90, initCold.F90 + History : histFldsMod.F90 + Accumulation : accumulMod.F90 + Restart : biogeophysRestMod.F90, CNRestMod.F90 + Biogeochemistry: CNSetValue.F90 + + New Type modules that now replace clmtype.F90 + ========================================== + main/atm2lndType.F90 + main/lnd2atmType.F90 + main/ColumnType.F90 + main/EcophysConType.F90 + main/GridcellType.F90 + main/LandunitType.F90 + main/PatchType.F90 + + biogeochem/CNCarbonFluxType.F90 + biogeochem/CNCarbonStateType.F90 + biogeochem/CNDecompCascadeConType.F90 + biogeochem/CNDVType.F90 + biogeochem/CNNitrogenFluxType.F90 + biogeochem/CNNitrogenStateType.F90 + biogeochem/CNStateType.F90 + biogeochem/CropType.F90 + + biogeophys/AerosolType.F90 + biogeophys/CanopyStateType.F90 + biogeophys/EnergyFluxType.F90 + biogeophys/FrictionVelocityType.F90 + biogeophys/LakeStateType.F90 + biogeophys/PhotosynthesisType.F90 + biogeophys/SoilHydrologyType.F90 + biogeophys/SoilStateType.F90 + biogeophys/SolarAbsorbedType.F90 + biogeophys/SurfaceAlbedoType.F90 + biogeophys/TemperatureType.F90 + biogeophys/UrbanParamsType.F90 + biogeophys/WaterfluxType.F90 + biogeophys/WaterStateType.F90 + + ED/main/EDBioType.F90 + ED/main/EDEcophysConType.F90 + ED/main/EDVecCohortType.F90 + ED/main/EDVecPatchType.F90 + + + Instantiation of Types + +2) Public Types: + + - the following are public types that can BE PASSED AS ARGUMENTS + - the type instances FOR NOW are clm_initialized and then used by the driver + - this will be generalized in the future + + type(ch4_type) :: ch4_vars + type(carbonstate_type) :: carbonstate_vars + type(carbonstate_type) :: c13_carbonstate_vars + type(carbonstate_type) :: c14_carbonstate_vars + type(carbonflux_type) :: carbonflux_vars + type(carbonflux_type) :: c13_carbonflux_vars + type(carbonflux_type) :: c14_carbonflux_vars + type(nitrogenstate_type) :: nitrogenstate_vars + type(nitrogenflux_type) :: nitrogenflux_vars + type(dgvs_type) :: dgvs_vars + type(crop_type) :: crop_vars + type(cnstate_type) :: cnstate_vars + type(dust_type) :: dust_vars + type(vocemis_type) :: vocemis_vars + type(drydepvel_type) :: drydepvel_vars + type(aerosol_type) :: aerosol_vars + type(canopystate_type) :: canopystate_vars + type(energyflux_type) :: energyflux_vars + type(frictionvel_type) :: frictionvel_vars + type(lakestate_type) :: lakestate_vars + type(photosyns_type) :: photosyns_vars + type(soilstate_type) :: soilstate_vars + type(soilhydrology_type) :: soilhydrology_vars + type(solarabs_type) :: solarabs_vars + type(surfalb_type) :: surfalb_vars + type(surfrad_type) :: surfrad_vars + type(temperature_type) :: temperature_vars + type(urbanparams_type) :: urbanparams_vars + type(waterflux_type) :: waterflux_vars + type(waterstate_type) :: waterstate_vars + type(atm2lnd_type) :: atm2lnd_vars + type(glc2lnd_type) :: glc2lnd_vars + type(lnd2atm_type) :: lnd2atm_vars + type(lnd2glc_type) :: lnd2glc_vars + type(glc_diagnostics_type) :: glc_diagnostics_vars + type(EDbio_type) :: EDbio_vars + + - private Types (now som modules have their own PRIVATE types) + + DUSTMod.F90 : type(dust_type) + VOCEmissionMod.F90: type(vocemis_type) + ch4Mod.F90 : type(ch4_type) + + API Changes: + ========================================== + Original APIs: + clmtype was in effect a global common block and all routines had use statements into it + difficult to track any intent or flow through system + difficult to set up functional unit testing (.e.g. CanopyFluxesMod.F90, etc) + + Refactorized APIs: + all new datatype instances are passed as arguments + science code is effectively the same since only the associate statements have been modified + + New Directory Structure under clm/ + ========================================== + bld/ + doc/ + src/biogeochem/ + src/biogeophys/ + src/cpl/ + src/dyn_subgrid/ + src/ED/ + src/ED/biogeochem + src/ED/biogeophys + src/ED/fire + src/ED/main + src/main/ + src/unit_test_mocks/ + src/unit_test_shr/ + src/utils/ + src_clm4_0/ + test/ + tools/ + + Advantages of refactorization: + ========================================== + - Lets compiler enforce intent attributes + - Makes functional unit testing easier since module drivers can be + constructed with relevant mock data more easily + - Makes more sense scientifically since now easier to extend code logic as + to where you want to introduce new variables + - Easier to maintain code since code flow is easier to follow and to modify + - Easy to move variables around from one data type to another since now + know everything that is logically connected to that variable that + needs to be moved Offers new modularity for trading in and out new + formulations of targeted functionality + +Requirements for tag: N.A. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N.A. + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + directory restructuring has been reflected in changes to configure in setting up the Filepath + +Describe any changes made to the namelist: + clm_hydrology1_inparm changed to clm_canopyhydrology_inparm + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself, Bill Sacks + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +D clm/src/clm4_5 +D clm/src/clm4_5/biogeochem +D clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +D clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +D clm/src/clm4_5/biogeochem/CNRestMod.F90 +D clm/src/clm4_5/biogeochem/CropRestMod.F90 +D clm/src/clm4_5/biogeochem/CNGRespMod.F90 +D clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +D clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +D clm/src/clm4_5/biogeochem/CNFireMod.F90 +D clm/src/clm4_5/biogeochem/CNMRespMod.F90 +D clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +D clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 +D clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +D clm/src/clm4_5/biogeochem/ch4RestMod.F90 +D clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +D clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +D clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +D clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +D clm/src/clm4_5/biogeochem/ch4Mod.F90 +D clm/src/clm4_5/biogeochem/DUSTMod.F90 +D clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +D clm/src/clm4_5/biogeochem/CNInitMod.F90 +D clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +D clm/src/clm4_5/biogeochem/ch4varcon.F90 +D clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +D clm/src/clm4_5/biogeochem/CNDecompMod.F90 +D clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +D clm/src/clm4_5/biogeochem/CNDVMod.F90 +D clm/src/clm4_5/biogeochem/ED +D clm/src/clm4_5/biogeochem/ED/EDCanopyStructureMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDSetValuesMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDGrowthFunctionsMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDPhysiologyMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDCohortDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/ED/EDPatchDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +D clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +D clm/src/clm4_5/biogeochem/ch4InitMod.F90 +D clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +D clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +D clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +D clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +D clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +D clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +D clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +D clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +D clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +D clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +D clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +D clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +D clm/src/clm4_5/biogeochem/CNDVInitMod.F90 +D clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 + +D clm/src/clm4_5/main +D clm/src/clm4_5/main/clm_varcon.F90 +D clm/src/clm4_5/main/initInterp.F90 +D clm/src/clm4_5/main/clm_varpar.F90 +D clm/src/clm4_5/main/landunit_varcon.F90 +D clm/src/clm4_5/main/initTimeConstMod.F90 +D clm/src/clm4_5/main/subgridWeightsMod.F90 +D clm/src/clm4_5/main/decompInitMod.F90 +D clm/src/clm4_5/main/clm_initializeMod.F90 +D clm/src/clm4_5/main/subgridRestMod.F90 +D clm/src/clm4_5/main/clm_glclnd.F90 +D clm/src/clm4_5/main/paramUtilMod.F90 +D clm/src/clm4_5/main/accFldsMod.F90 +D clm/src/clm4_5/main/subgridMod.F90 +D clm/src/clm4_5/main/clmtypeInitMod.F90 +D clm/src/clm4_5/main/ndepStreamMod.F90 +D clm/src/clm4_5/main/init_hydrology.F90 +D clm/src/clm4_5/main/initColdMod.F90 +D clm/src/clm4_5/main/column_varcon.F90 +D clm/src/clm4_5/main/histFileMod.F90 +D clm/src/clm4_5/main/pft2colMod.F90 +D clm/src/clm4_5/main/clm_atmlnd.F90 +D clm/src/clm4_5/main/findHistFields.pl +D clm/src/clm4_5/main/clm_varsur.F90 +D clm/src/clm4_5/main/restFileMod.F90 +D clm/src/clm4_5/main/CMakeLists.txt +D clm/src/clm4_5/main/controlMod.F90 +D clm/src/clm4_5/main/spitfireSF +D clm/src/clm4_5/main/spitfireSF/SFParamsMod.F90 +D clm/src/clm4_5/main/spitfireSF/SFMainMod.F90 +D clm/src/clm4_5/main/test +D clm/src/clm4_5/main/test/subgridWeights_test +D clm/src/clm4_5/main/test/subgridWeights_test/test_subgridWeights.pf +D clm/src/clm4_5/main/test/subgridWeights_test/CMakeLists.txt +D clm/src/clm4_5/main/test/clm_glclnd_test +D clm/src/clm4_5/main/test/clm_glclnd_test/test_clm_glclnd.pf +D clm/src/clm4_5/main/test/clm_glclnd_test/CMakeLists.txt +D clm/src/clm4_5/main/test/CMakeLists.txt +D clm/src/clm4_5/main/initSubgridMod.F90 +D clm/src/clm4_5/main/filterMod.F90 +D clm/src/clm4_5/main/clm_varctl.F90 +D clm/src/clm4_5/main/clm_driver.F90 +D clm/src/clm4_5/main/surfrdUtilsMod.F90 +D clm/src/clm4_5/main/ED +D clm/src/clm4_5/main/ED/EDInitTimeConst.F90 +D clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +D clm/src/clm4_5/main/ED/EDClmType.F90 +D clm/src/clm4_5/main/ED/EDRestVectorMod.F90 +D clm/src/clm4_5/main/ED/EDHistFldsMod.F90 +D clm/src/clm4_5/main/ED/EDClmTypeInitMod.F90 +D clm/src/clm4_5/main/ED/EDPftvarcon.F90 +D clm/src/clm4_5/main/ED/EDParamsMod.F90 +D clm/src/clm4_5/main/ED/EDInitMod.F90 +D clm/src/clm4_5/main/ED/EDTypesMod.F90 +D clm/src/clm4_5/main/ED/EDMainMod.F90 +D clm/src/clm4_5/main/subgridAveMod.F90 +D clm/src/clm4_5/main/initGridCellsMod.F90 +D clm/src/clm4_5/main/initSoilParVICMod.F90 +D clm/src/clm4_5/main/pftvarcon.F90 +D clm/src/clm4_5/main/surfrdMod.F90 +D clm/src/clm4_5/main/decompMod.F90 +D clm/src/clm4_5/main/FuncPedotransferMod.F90 +D clm/src/clm4_5/main/clmtype.F90 +D clm/src/clm4_5/main/reweightMod.F90 +D clm/src/clm4_5/main/readParamsMod.F90 +D clm/src/clm4_5/main/histFldsMod.F90 + +D clm/src/clm4_5/biogeophys +D clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +D clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +D clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +D clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +D clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +D clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +D clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +D clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +D clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +D clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +D clm/src/clm4_5/biogeophys/UrbanMod.F90 +D clm/src/clm4_5/biogeophys/QSatMod.F90 +D clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +D clm/src/clm4_5/biogeophys/SurfaceResistanceMod.F90 +D clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +D clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +D clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +D clm/src/clm4_5/biogeophys/SNICARMod.F90 +D clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +D clm/src/clm4_5/biogeophys/CMakeLists.txt +D clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +D clm/src/clm4_5/biogeophys/RootBiophysMod.F90 +D clm/src/clm4_5/biogeophys/test +D clm/src/clm4_5/biogeophys/test/CMakeLists.txt +D clm/src/clm4_5/biogeophys/test/Daylength_test +D clm/src/clm4_5/biogeophys/test/Daylength_test/test_daylength.pf +D clm/src/clm4_5/biogeophys/test/Daylength_test/CMakeLists.txt +D clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +D clm/src/clm4_5/biogeophys/SoilWaterMovementMod.F90 +D clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +D clm/src/clm4_5/biogeophys/SoilMoistStressMod.F90 +D clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +D clm/src/clm4_5/biogeophys/SoiWatRetCurveParMod.F90 +D clm/src/clm4_5/biogeophys/ED +D clm/src/clm4_5/biogeophys/ED/EDAccumulateFluxesMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDSurfaceAlbedoMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 +D clm/src/clm4_5/biogeophys/ED/EDBtranMod.F90 +D clm/src/clm4_5/biogeophys/FracWetMod.F90 +D clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +D clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +D clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +D clm/src/clm4_5/biogeophys/SLakeCon.F90 +D clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +D clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +D clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +D clm/src/clm4_5/biogeophys/DaylengthMod.F90 + +D clm/src/clm4_5/dyn_subgrid +D clm/src/clm4_5/dyn_subgrid/test +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +D clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +D clm/src/clm4_5/dyn_subgrid/test/dynVar_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +D clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +D clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +D clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +D clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +D clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +D clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +D clm/src/clm4_5/dyn_subgrid/do_genf90 +D clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 +D clm/src/clm4_5/dyn_subgrid/CMakeLists.txt + +D clm/src/util_share +D clm/src/util_share/organicFileMod.F90 +D clm/src/util_share/spmdGathScatMod.F90 +D clm/src/util_share/clm_time_manager.F90 +D clm/src/util_share/clm_nlUtilsMod.F90 +D clm/src/util_share/clm_varorb.F90 +D clm/src/util_share/abortutils.F90 +D clm/src/util_share/accumulMod.F90 +D clm/src/util_share/getdatetime.F90 +D clm/src/util_share/fileutils.F90 +D clm/src/util_share/dtypes.h +D clm/src/util_share/ncdio_pio.F90 +D clm/src/util_share/SimpleMathMod.F90 +D clm/src/util_share/spmdMod.F90 +D clm/src/util_share/domainMod.F90 +D clm/src/util_share/ncdio_pio.F90.in +D clm/src/util_share/restUtilMod.F90 +D clm/src/util_share/quadraticMod.F90 +D clm/src/util_share/restUtilMod.F90.in +D clm/src/util_share/CMakeLists.txt +D clm/src/util_share/GetGlobalValuesMod.F90 + +D clm/src/clm4_0 +D clm/src/clm4_0/biogeochem +D clm/src/clm4_0/biogeochem/CNCStateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/CNGapMortalityMod.F90 +D clm/src/clm4_0/biogeochem/CropRestMod.F90 +D clm/src/clm4_0/biogeochem/CNGRespMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNBalanceCheckMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/CNFireMod.F90 +D clm/src/clm4_0/biogeochem/CNMRespMod.F90 +D clm/src/clm4_0/biogeochem/MEGANFactorsMod.F90 +D clm/src/clm4_0/biogeochem/CNPrecisionControlMod.F90 +D clm/src/clm4_0/biogeochem/CNWoodProductsMod.F90 +D clm/src/clm4_0/biogeochem/CNSummaryMod.F90 +D clm/src/clm4_0/biogeochem/DUSTMod.F90 +D clm/src/clm4_0/biogeochem/CNDVLightMod.F90 +D clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +D clm/src/clm4_0/biogeochem/CNCStateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNDecompMod.F90 +D clm/src/clm4_0/biogeochem/STATICEcosysDynMod.F90 +D clm/src/clm4_0/biogeochem/CNCStateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/CNDVMod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate1Mod.F90 +D clm/src/clm4_0/biogeochem/CNrestMod.F90 +D clm/src/clm4_0/biogeochem/CNC13StateUpdate3Mod.F90 +D clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 +D clm/src/clm4_0/biogeochem/CNDVEcosystemDynIniMod.F90 +D clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 +D clm/src/clm4_0/biogeochem/CNNStateUpdate2Mod.F90 +D clm/src/clm4_0/biogeochem/C13SummaryMod.F90 +D clm/src/clm4_0/biogeochem/DryDepVelocity.F90 +D clm/src/clm4_0/biogeochem/CNC13FluxMod.F90 +D clm/src/clm4_0/biogeochem/CNAllocationMod.F90 +D clm/src/clm4_0/biogeochem/CNNDynamicsMod.F90 +D clm/src/clm4_0/biogeochem/CNEcosystemDynMod.F90 +D clm/src/clm4_0/biogeochem/CNSetValueMod.F90 +D clm/src/clm4_0/biogeochem/CNVegStructUpdateMod.F90 +D clm/src/clm4_0/biogeochem/CNDVEstablishmentMod.F90 + +D clm/src/clm4_0/main +D clm/src/clm4_0/main/clm_varcon.F90 +D clm/src/clm4_0/main/clm_varpar.F90 +D clm/src/clm4_0/main/CNiniTimeVar.F90 +D clm/src/clm4_0/main/dynlandMod.F90 +D clm/src/clm4_0/main/decompInitMod.F90 +D clm/src/clm4_0/main/clm_initializeMod.F90 +D clm/src/clm4_0/main/subgridRestMod.F90 +D clm/src/clm4_0/main/clm_glclnd.F90 +D clm/src/clm4_0/main/accFldsMod.F90 +D clm/src/clm4_0/main/subgridMod.F90 +D clm/src/clm4_0/main/clmtypeInitMod.F90 +D clm/src/clm4_0/main/ndepStreamMod.F90 +D clm/src/clm4_0/main/pftdynMod.F90 +D clm/src/clm4_0/main/iniTimeConst.F90 +D clm/src/clm4_0/main/histFileMod.F90 +D clm/src/clm4_0/main/pft2colMod.F90 +D clm/src/clm4_0/main/clm_atmlnd.F90 +D clm/src/clm4_0/main/findHistFields.pl +D clm/src/clm4_0/main/restFileMod.F90 +D clm/src/clm4_0/main/clm_varsur.F90 +D clm/src/clm4_0/main/controlMod.F90 +D clm/src/clm4_0/main/initSurfAlbMod.F90 +D clm/src/clm4_0/main/filterMod.F90 +D clm/src/clm4_0/main/clm_driver.F90 +D clm/src/clm4_0/main/clm_varctl.F90 +D clm/src/clm4_0/main/subgridAveMod.F90 +D clm/src/clm4_0/main/initGridCellsMod.F90 +D clm/src/clm4_0/main/CNiniSpecial.F90 +D clm/src/clm4_0/main/pftvarcon.F90 +D clm/src/clm4_0/main/surfrdMod.F90 +D clm/src/clm4_0/main/decompMod.F90 +D clm/src/clm4_0/main/clmtype.F90 +D clm/src/clm4_0/main/histFldsMod.F90 +D clm/src/clm4_0/main/mkarbinitMod.F90 +D clm/src/clm4_0/biogeophys +D clm/src/clm4_0/biogeophys/BalanceCheckMod.F90 +D clm/src/clm4_0/biogeophys/SurfaceRadiationMod.F90 +D clm/src/clm4_0/biogeophys/SoilTemperatureMod.F90 +D clm/src/clm4_0/biogeophys/SnowHydrologyMod.F90 +D clm/src/clm4_0/biogeophys/UrbanInputMod.F90 +D clm/src/clm4_0/biogeophys/Biogeophysics1Mod.F90 +D clm/src/clm4_0/biogeophys/Biogeophysics2Mod.F90 +D clm/src/clm4_0/biogeophys/FracWetMod.F90 +D clm/src/clm4_0/biogeophys/UrbanInitMod.F90 +D clm/src/clm4_0/biogeophys/FrictionVelocityMod.F90 +D clm/src/clm4_0/biogeophys/TridiagonalMod.F90 +D clm/src/clm4_0/biogeophys/SurfaceAlbedoMod.F90 +D clm/src/clm4_0/biogeophys/Hydrology1Mod.F90 +D clm/src/clm4_0/biogeophys/Hydrology2Mod.F90 +D clm/src/clm4_0/biogeophys/BiogeophysicsLakeMod.F90 +D clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 +D clm/src/clm4_0/biogeophys/UrbanMod.F90 +D clm/src/clm4_0/biogeophys/SoilHydrologyMod.F90 +D clm/src/clm4_0/biogeophys/QSatMod.F90 +D clm/src/clm4_0/biogeophys/clm_driverInitMod.F90 +D clm/src/clm4_0/biogeophys/HydrologyLakeMod.F90 +D clm/src/clm4_0/biogeophys/BareGroundFluxesMod.F90 +D clm/src/clm4_0/biogeophys/SNICARMod.F90 +D clm/src/clm4_0/biogeophys/CanopyFluxesMod.F90 + +List all files added and what they do: + +A clm/src_clm40 +A clm/src_clm40/biogeochem +A clm/src_clm40/biogeochem/CNCStateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/CNGRespMod.F90 +A clm/src_clm40/biogeochem/CNBalanceCheckMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNSummaryMod.F90 +A clm/src_clm40/biogeochem/CNPhenologyMod.F90 +A clm/src_clm40/biogeochem/STATICEcosysDynMod.F90 +A clm/src_clm40/biogeochem/CNCStateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNrestMod.F90 +A clm/src_clm40/biogeochem/VOCEmissionMod.F90 +A clm/src_clm40/biogeochem/CNAnnualUpdateMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate2Mod.F90 +A clm/src_clm40/biogeochem/C13SummaryMod.F90 +A clm/src_clm40/biogeochem/CNAllocationMod.F90 +A clm/src_clm40/biogeochem/DryDepVelocity.F90 +A clm/src_clm40/biogeochem/CNNDynamicsMod.F90 +A clm/src_clm40/biogeochem/CNSetValueMod.F90 +A clm/src_clm40/biogeochem/CNGapMortalityMod.F90 +A clm/src_clm40/biogeochem/CropRestMod.F90 +A clm/src_clm40/biogeochem/CNNStateUpdate1Mod.F90 +A clm/src_clm40/biogeochem/CNFireMod.F90 +A clm/src_clm40/biogeochem/CNMRespMod.F90 +A clm/src_clm40/biogeochem/MEGANFactorsMod.F90 +A clm/src_clm40/biogeochem/CNWoodProductsMod.F90 +A clm/src_clm40/biogeochem/CNPrecisionControlMod.F90 +A clm/src_clm40/biogeochem/DUSTMod.F90 +A clm/src_clm40/biogeochem/CNDVLightMod.F90 +A clm/src_clm40/biogeochem/CNDecompMod.F90 +A clm/src_clm40/biogeochem/CNDVMod.F90 +A clm/src_clm40/biogeochem/CNCStateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNC13StateUpdate3Mod.F90 +A clm/src_clm40/biogeochem/CNDVEcosystemDynIniMod.F90 +A clm/src_clm40/biogeochem/CNC13FluxMod.F90 +A clm/src_clm40/biogeochem/CNEcosystemDynMod.F90 +A clm/src_clm40/biogeochem/CNVegStructUpdateMod.F90 +A clm/src_clm40/biogeochem/CNDVEstablishmentMod.F90 + +A clm/src_clm40/main +A clm/src_clm40/main/spmdGathScatMod.F90 +A clm/src_clm40/main/organicFileMod.F90 +A clm/src_clm40/main/clm_varcon.F90 +A clm/src_clm40/main/clm_varpar.F90 +A clm/src_clm40/main/CNiniTimeVar.F90 +A clm/src_clm40/main/abortutils.F90 +A clm/src_clm40/main/accumulMod.F90 +A clm/src_clm40/main/decompInitMod.F90 +A clm/src_clm40/main/clm_glclnd.F90 +A clm/src_clm40/main/accFldsMod.F90 +A clm/src_clm40/main/subgridMod.F90 +A clm/src_clm40/main/pftdynMod.F90 +A clm/src_clm40/main/pft2colMod.F90 +A clm/src_clm40/main/clm_atmlnd.F90 +A clm/src_clm40/main/quadraticMod.F90 +A clm/src_clm40/main/GetGlobalValuesMod.F90 +A clm/src_clm40/main/clm_time_manager.F90 +A clm/src_clm40/main/filterMod.F90 +A clm/src_clm40/main/clm_varctl.F90 +A clm/src_clm40/main/subgridAveMod.F90 +A clm/src_clm40/main/dtypes.h +A clm/src_clm40/main/CNiniSpecial.F90 +A clm/src_clm40/main/surfrdMod.F90 +A clm/src_clm40/main/domainMod.F90 +A clm/src_clm40/main/lnd_import_export.F90 +A clm/src_clm40/main/restUtilMod.F90 +A clm/src_clm40/main/clmtype.F90 +A clm/src_clm40/main/mkarbinitMod.F90 +A clm/src_clm40/main/restUtilMod.F90.in +A clm/src_clm40/main/dynlandMod.F90 +A clm/src_clm40/main/getdatetime.F90 +A clm/src_clm40/main/clm_initializeMod.F90 +A clm/src_clm40/main/subgridRestMod.F90 +A clm/src_clm40/main/fileutils.F90 +A clm/src_clm40/main/clmtypeInitMod.F90 +A clm/src_clm40/main/ndepStreamMod.F90 +A clm/src_clm40/main/SimpleMathMod.F90 +A clm/src_clm40/main/iniTimeConst.F90 +A clm/src_clm40/main/lnd_comp_esmf.F90 +A clm/src_clm40/main/histFileMod.F90 +A clm/src_clm40/main/clm_cpl_indices.F90 +A clm/src_clm40/main/findHistFields.pl +A clm/src_clm40/main/restFileMod.F90 +A clm/src_clm40/main/clm_varsur.F90 +A clm/src_clm40/main/controlMod.F90 +A clm/src_clm40/main/CMakeLists.txt +A clm/src_clm40/main/initSurfAlbMod.F90 +A clm/src_clm40/main/clm_nlUtilsMod.F90 +A clm/src_clm40/main/clm_driver.F90 +A clm/src_clm40/main/clm_varorb.F90 +A clm/src_clm40/main/initGridCellsMod.F90 +A clm/src_clm40/main/lnd_comp_mct.F90 +A clm/src_clm40/main/pftvarcon.F90 +A clm/src_clm40/main/ncdio_pio.F90 +A clm/src_clm40/main/spmdMod.F90 +A clm/src_clm40/main/decompMod.F90 +A clm/src_clm40/main/ncdio_pio.F90.in +A clm/src_clm40/main/histFldsMod.F90 + +A clm/src_clm40/biogeophys +A clm/src_clm40/biogeophys/BalanceCheckMod.F90 +A clm/src_clm40/biogeophys/SoilTemperatureMod.F90 +A clm/src_clm40/biogeophys/UrbanInputMod.F90 +A clm/src_clm40/biogeophys/SnowHydrologyMod.F90 +A clm/src_clm40/biogeophys/Biogeophysics1Mod.F90 +A clm/src_clm40/biogeophys/FrictionVelocityMod.F90 +A clm/src_clm40/biogeophys/TridiagonalMod.F90 +A clm/src_clm40/biogeophys/Hydrology1Mod.F90 +A clm/src_clm40/biogeophys/BiogeophysRestMod.F90 +A clm/src_clm40/biogeophys/UrbanMod.F90 +A clm/src_clm40/biogeophys/QSatMod.F90 +A clm/src_clm40/biogeophys/clm_driverInitMod.F90 +A clm/src_clm40/biogeophys/HydrologyLakeMod.F90 +A clm/src_clm40/biogeophys/BareGroundFluxesMod.F90 +A clm/src_clm40/biogeophys/SNICARMod.F90 +A clm/src_clm40/biogeophys/CanopyFluxesMod.F90 +A clm/src_clm40/biogeophys/SurfaceRadiationMod.F90 +A clm/src_clm40/biogeophys/Biogeophysics2Mod.F90 +A clm/src_clm40/biogeophys/UrbanInitMod.F90 +A clm/src_clm40/biogeophys/FracWetMod.F90 +A clm/src_clm40/biogeophys/SurfaceAlbedoMod.F90 +A clm/src_clm40/biogeophys/Hydrology2Mod.F90 +A clm/src_clm40/biogeophys/BiogeophysicsLakeMod.F90 +A clm/src_clm40/biogeophys/SoilHydrologyMod.F90 + +A clm/src/main +A clm/src/main/organicFileMod.F90 +A clm/src/main/clm_varcon.F90 +A clm/src/main/initInterp.F90 +A clm/src/main/landunit_varcon.F90 +A clm/src/main/clm_varpar.F90 +A clm/src/main/abortutils.F90 +A clm/src/main/accumulMod.F90 +A clm/src/main/subgridWeightsMod.F90 +A clm/src/main/decompInitMod.F90 +A clm/src/main/subgridMod.F90 +A clm/src/main/atm2lndType.F90 +A clm/src/main/lnd2atmType.F90 +A clm/src/main/column_varcon.F90 +A clm/src/main/EcophysConType.F90 +A clm/src/main/GetGlobalValuesMod.F90 +A clm/src/main/initSubgridMod.F90 +A clm/src/main/lnd2glcMod.F90 +A clm/src/main/glc2lndMod.F90 +A clm/src/main/filterMod.F90 +A clm/src/main/surfrdUtilsMod.F90 +A clm/src/main/clm_varctl.F90 +A clm/src/main/subgridAveMod.F90 +A clm/src/main/initVerticalMod.F90 +A clm/src/main/glcDiagnosticsMod.F90 +A clm/src/main/lnd2atmMod.F90 +A clm/src/main/atm2lndMod.F90 +A clm/src/main/surfrdMod.F90 +A clm/src/main/FuncPedotransferMod.F90 +A clm/src/main/readParamsMod.F90 +A clm/src/main/clm_initializeMod.F90 +A clm/src/main/subgridRestMod.F90 +A clm/src/main/paramUtilMod.F90 +A clm/src/main/ColumnType.F90 +A clm/src/main/PatchType.F90 +A clm/src/main/ndepStreamMod.F90 +A clm/src/main/init_hydrology.F90 +A clm/src/main/histFileMod.F90 +A clm/src/main/findHistFields.pl +A clm/src/main/restFileMod.F90 +A clm/src/main/clm_varsur.F90 +A clm/src/main/controlMod.F90 +A clm/src/main/LandunitType.F90 +A clm/src/main/CMakeLists.txt +A clm/src/main/test +A clm/src/main/test/subgridWeights_test +A clm/src/main/test/subgridWeights_test/test_subgridWeights.pf +A clm/src/main/test/subgridWeights_test/CMakeLists.txt +A clm/src/main/test/clm_glclnd_test +A clm/src/main/test/clm_glclnd_test/test_clm_glclnd.pf +A clm/src/main/test/clm_glclnd_test/CMakeLists.txt +A clm/src/main/test/CMakeLists.txt +A clm/src/main/clm_driver.F90 +A clm/src/main/GridcellType.F90 +A clm/src/main/initGridCellsMod.F90 +A clm/src/main/pftvarcon.F90 +A clm/src/main/ncdio_pio.F90 +A clm/src/main/decompMod.F90 +A clm/src/main/ncdio_pio.F90.in +A clm/src/main/reweightMod.F90 + +A clm/src/ED +A clm/src/ED/biogeochem +A clm/src/ED/biogeochem/EDCanopyStructureMod.F90 +A clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 +A clm/src/ED/biogeochem/EDPhysiologyMod.F90 +A clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 +A clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 +A clm/src/ED/main +A clm/src/ED/main/EDBioType.F90 +A clm/src/ED/main/EDEcophysConType.F90 +A clm/src/ED/main/EDParamsMod.F90 +A clm/src/ED/main/EDMainMod.F90 +A clm/src/ED/main/EDCLMLinkMod.F90 +A clm/src/ED/main/EDVecCohortType.F90 +A clm/src/ED/main/EDVecPatchType.F90 +A clm/src/ED/main/EDRestVectorMod.F90 +A clm/src/ED/main/EDPftvarcon.F90 +A clm/src/ED/main/EDInitMod.F90 +A clm/src/ED/main/EDTypesMod.F90 +A clm/src/ED/fire +A clm/src/ED/fire/SFParamsMod.F90 +A clm/src/ED/fire/SFMainMod.F90 +A clm/src/ED/biogeophys +A clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 +A clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 +A clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 +A clm/src/ED/biogeophys/EDBtranMod.F90 +A clm/src/Notes +M clm/src/unit_test_shr/unittestSubgridMod.F90 + +A clm/src/utils +A clm/src/utils/spmdGathScatMod.F90 +A clm/src/utils/clm_time_manager.F90 +A clm/src/utils/clm_nlUtilsMod.F90 +A clm/src/utils/clm_varorb.F90 +A clm/src/utils/accumulMod.F90 +A clm/src/utils/getdatetime.F90 +A clm/src/utils/fileutils.F90 +A clm/src/utils/dtypes.h +A clm/src/utils/spmdMod.F90 +A clm/src/utils/SimpleMathMod.F90 +A clm/src/utils/domainMod.F90 +A clm/src/utils/restUtilMod.F90 +A clm/src/utils/quadraticMod.F90 +A clm/src/utils/CMakeLists.txt +A clm/src/utils/restUtilMod.F90.in + +A clm/src/biogeochem +A clm/src/biogeochem/CNCStateUpdate2Mod.F90 +A clm/src/biogeochem/CNDecompCascadeConType.F90 +A clm/src/biogeochem/CNNitrifDenitrifMod.F90 +A clm/src/biogeochem/CNGRespMod.F90 +A clm/src/biogeochem/CNBalanceCheckMod.F90 +A clm/src/biogeochem/CNNStateUpdate3Mod.F90 +A clm/src/biogeochem/CNDVDriverMod.F90 +A clm/src/biogeochem/SatellitePhenologyMod.F90 +A clm/src/biogeochem/CNPhenologyMod.F90 +A clm/src/biogeochem/CNCarbonFluxType.F90 +A clm/src/biogeochem/CNCarbonStateType.F90 +A clm/src/biogeochem/CNCStateUpdate1Mod.F90 +A clm/src/biogeochem/VOCEmissionMod.F90 +A clm/src/biogeochem/CNAnnualUpdateMod.F90 +A clm/src/biogeochem/CNNStateUpdate2Mod.F90 +A clm/src/biogeochem/CropType.F90 +A clm/src/biogeochem/CNAllocationMod.F90 +A clm/src/biogeochem/CNNDynamicsMod.F90 +A clm/src/biogeochem/DryDepVelocity.F90 +A clm/src/biogeochem/CNDecompCascadeBGCMod.F90 +A clm/src/biogeochem/CNSoilLittVertTranspMod.F90 +A clm/src/biogeochem/CNDecompCascadeCNMod.F90 +A clm/src/biogeochem/CNC14DecayMod.F90 +A clm/src/biogeochem/CNGapMortalityMod.F90 +A clm/src/biogeochem/CNNStateUpdate1Mod.F90 +A clm/src/biogeochem/CNFireMod.F90 +A clm/src/biogeochem/CNNitrogenFluxType.F90 +A clm/src/biogeochem/CNMRespMod.F90 +A clm/src/biogeochem/MEGANFactorsMod.F90 +A clm/src/biogeochem/CNVerticalProfileMod.F90 +A clm/src/biogeochem/CNCIsoFluxMod.F90 +A clm/src/biogeochem/CNWoodProductsMod.F90 +A clm/src/biogeochem/CNPrecisionControlMod.F90 +A clm/src/biogeochem/ch4Mod.F90 +A clm/src/biogeochem/DUSTMod.F90 +A clm/src/biogeochem/CNDVLightMod.F90 +A clm/src/biogeochem/ch4varcon.F90 +A clm/src/biogeochem/CNDecompMod.F90 +A clm/src/biogeochem/CNCStateUpdate3Mod.F90 +A clm/src/biogeochem/CNSharedParamsMod.F90 +A clm/src/biogeochem/CNDVType.F90 +A clm/src/biogeochem/CNStateType.F90 +A clm/src/biogeochem/CNEcosystemDynMod.F90 +A clm/src/biogeochem/CNNitrogenStateType.F90 +A clm/src/biogeochem/CNVegStructUpdateMod.F90 +A clm/src/biogeochem/CNDVEstablishmentMod.F90 + +A clm/src/biogeophys +A clm/src/biogeophys/SnowSnicarMod.F90 +A clm/src/biogeophys/SnowHydrologyMod.F90 +A clm/src/biogeophys/TridiagonalMod.F90 +A clm/src/biogeophys/FrictionVelocityType.F90 +A clm/src/biogeophys/LakeFluxesMod.F90 +A clm/src/biogeophys/PhotosynthesisMod.F90 +A clm/src/biogeophys/AerosolType.F90 +A clm/src/biogeophys/ActiveLayerMod.F90 +A clm/src/biogeophys/QSatMod.F90 +A clm/src/biogeophys/SoilHydrologyType.F90 +A clm/src/biogeophys/HydrologyDrainageMod.F90 +A clm/src/biogeophys/LakeStateType.F90 +A clm/src/biogeophys/BareGroundFluxesMod.F90 +A clm/src/biogeophys/SolarAbsorbedType.F90 +A clm/src/biogeophys/CanopyHydrologyMod.F90 +A clm/src/biogeophys/UrbanFluxesMod.F90 +A clm/src/biogeophys/SurfaceAlbedoMod.F90 +A clm/src/biogeophys/UrbanRadiationMod.F90 +A clm/src/biogeophys/PhotosynthesisType.F90 +A clm/src/biogeophys/CanopyTemperatureMod.F90 +A clm/src/biogeophys/HydrologyNoDrainageMod.F90 +A clm/src/biogeophys/DaylengthMod.F90 +A clm/src/biogeophys/WaterfluxType.F90 +A clm/src/biogeophys/BalanceCheckMod.F90 +A clm/src/biogeophys/SoilTemperatureMod.F90 +A clm/src/biogeophys/WaterStateType.F90 +A clm/src/biogeophys/LakeTemperatureMod.F90 +A clm/src/biogeophys/FrictionVelocityMod.F90 +A clm/src/biogeophys/SoilFluxesMod.F90 +A clm/src/biogeophys/TemperatureType.F90 +A clm/src/biogeophys/SurfaceAlbedoType.F90 +A clm/src/biogeophys/AerosolMod.F90 +A clm/src/biogeophys/SoilStateType.F90 +A clm/src/biogeophys/SurfaceResistanceMod.F90 +A clm/src/biogeophys/UrbanAlbedoMod.F90 +A clm/src/biogeophys/CanopyFluxesMod.F90 +A clm/src/biogeophys/CMakeLists.txt +A clm/src/biogeophys/RootBiophysMod.F90 +A clm/src/biogeophys/test +A clm/src/biogeophys/test/CMakeLists.txt +A clm/src/biogeophys/test/Daylength_test +A clm/src/biogeophys/test/Daylength_test/test_daylength.pf +A clm/src/biogeophys/test/Daylength_test/CMakeLists.txt +A clm/src/biogeophys/SurfaceRadiationMod.F90 +A clm/src/biogeophys/SoilWaterMovementMod.F90 +A clm/src/biogeophys/SoilMoistStressMod.F90 +A clm/src/biogeophys/SoiWatRetCurveParMod.F90 +A clm/src/biogeophys/EnergyFluxType.F90 +A clm/src/biogeophys/CanopyStateType.F90 +A clm/src/biogeophys/BandDiagonalMod.F90 +A clm/src/biogeophys/SoilHydrologyMod.F90 +A clm/src/biogeophys/LakeCon.F90 +A clm/src/biogeophys/LakeHydrologyMod.F90 +A clm/src/biogeophys/UrbanParamsType.F90 +A clm/src/dyn_subgrid +A clm/src/dyn_subgrid/dynLandunitAreaMod.F90 +A clm/src/dyn_subgrid/dynTimeInfoMod.F90 +A clm/src/dyn_subgrid/dynSubgridDriverMod.F90 +A clm/src/dyn_subgrid/dynFileMod.F90 +A clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 +A clm/src/dyn_subgrid/dynEDMod.F90 +A clm/src/dyn_subgrid/dynVarMod.F90 +A clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90 +A clm/src/dyn_subgrid/dynVarMod.F90.in +A clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in +A clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90.in +A clm/src/dyn_subgrid/do_genf90 +A clm/src/dyn_subgrid/CMakeLists.txt +A clm/src/dyn_subgrid/test +A clm/src/dyn_subgrid/test/dynLandunitArea_test +A clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A clm/src/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +A clm/src/dyn_subgrid/test/dynVar_test +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +A clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +A clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynTimeInfo_test +A clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +A clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +A clm/src/dyn_subgrid/test/CMakeLists.txt +A clm/src/dyn_subgrid/test/dynInitColumns_test +A clm/src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +A clm/src/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +A clm/src/dyn_subgrid/dynHarvestMod.F90 +A clm/src/dyn_subgrid/dynPriorWeightsMod.F90 +A clm/src/dyn_subgrid/dynpftFileMod.F90 +A clm/src/dyn_subgrid/dynVarTimeInterpMod.F90 +A clm/src/dyn_subgrid/dynCNDVMod.F90 +A clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 +A clm/src/dyn_subgrid/dynInitColumnsMod.F90 +A clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90 +A clm/src/unit_test_mocks/util_share/restUtilMod_mock.F90.in + +List all existing files that have been modified, and describe the changes: + ALL files have been modified - see the general description for an + overview of what was done - the following files have not had their directories + changed - so the summary is below + +M clm/bld/configure + - needed to account for change in filepath + +M clm/bld/CLMBuildNamelist.pm +M clm/bld/namelist_files/namelist_definition_clm4_5.xml + - see namelist changes mentioned above + +M clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 +M clm/src/unit_test_mocks/util_share/ncdio_var.F90 +M clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +M clm/src/unit_test_mocks/util_share/do_genf90 +M clm/src/unit_test_mocks/util_share/CMakeLists.txt +M clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +M clm/src/unit_test_mocks/main/histFileMod_mock.F90 +M clm/src/CMakeLists.txt + - unit test changes needed to account for introduction of new data types and + directory structure + +M clm/src/cpl/lnd_comp_esmf.F90 +M clm/src/cpl/lnd_import_export.F90 +M clm/src/cpl/lnd_comp_mct.F90 + - coupling interface changes needed to account for introduction of new data types + +CLM testing: + + build-namelist tests: + + yellowstone yes + goldbach yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + NOTE for goldbach_nag - four ED compare_hist tests fail with small bit for bit differences. + In fact - looking more closely, these tests are also run for pgi and intel on goldbach - and + values for LITTER_IN and LITTER_OUT are 0. for those compilers but non-zero for nag. + With the refactoring code - those fields are again 0. for intel and pgi - but totally different + and non-zero for nag. Apparently, this is known problem that will get resolved in when new ED changes + are brount in + + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + + + short tests (aux_clm_short) (generally these are NOT used when making a tag): N/A + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r080 + +Changes answers relative to baseline: No - BFB + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r080 +Originator(s): erik (Erik) +Date: Sat Aug 16 15:01:35 MDT 2014 +One-line Summary: Update externals to CESM trunk versions, allow eighth degree as a valid resolution + +Purpose of changes: + +Update all the externals to the very latest CESM trunk versions (based off of current +cesm1_3_alpha13a). + +Requirements for tag: Get working with trunk externals + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 2012 Problem with mksurfdata_map for eighth degree grid... + Scripts issues as follows: + 2024 nlcompareonly option to create_test not working correctly for reporting + 2019 ERH tests don't save the base env_run.xml, so have trouble when resubmitted... + 2018 Failed tests in cesm1_3_beta11 needed for CLM + 2005 Remove untested named compsets and grids + 1999 T85_g16 has inconsistent land domain and surface datasets + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Archiving updated in support of time series generation + Running test suite now builds some shared libraries built only once + +Describe any changes made to the namelist: + Resolve env and xml vars used in user_nl_* + + Default for drv_in profile_timer changed from 4 to 1 + Some PE layours change: f10_f10 change from 15x1 to 30x1 + +List any changes to the defaults for the boundary datasets: Add 0.125x0.125 mapping files + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): Update to cesm1_3_alpha13a externals + + scripts to scripts4_140814a + scripts/doc to doc_140519 + Machines to Machines_140811 + CMake to CMake_Fortran_utils_140715 + drv to drvseq5_0_15 + cism to cism1_140602 + timing to timing_140416 + pio to pio1_8_12 + cprnc to cprnc_140625 + mapping to mapping_140702b (note: gen_domain changes answers) + unit_testing to unit_testing_0_07 + + PTCLM to PTCLM2_140816 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 -- decrease tolerance + M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl - Loop over variables + and then cat the files together at the end. This makes the process possible for + high resolution and speeds up lower resolution sub-setting as well. + M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 -- decrease tolerance + M models/lnd/clm/tools/shared/mkmapdata/README --------------------- Fix/update documentation + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ----------- Correct test count + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Add 0.125x0.125 + mapping files + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Add 0.125x0.125 + as a valid resolution + M models/lnd/clm/bld/namelist_files/createMapEntry.pl --- Correct path, get working again + +CLM testing: + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + yellowstone_gnu yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_1_r079 + +Changes answers relative to baseline: Yes! (PE layouts that change) + + Summarize any changes to answers, i.e., + - what code configurations: non single-point configurations, where PE layout + changes (f10_f10) + - what platforms/compilers: all + - nature of change (roundoff) + x2l_Flrr_volr changes to roundoff + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r079 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jul 31 17:09:57 MDT 2014 +One-line Summary: G. Bisht (LBL) soil temperature refactor; machines update for goldbach-intel + +Purpose of changes: Refactor soil temperature module to break the construction of the linear system LHS matrix and RHS vector into small physics based routines. Update machines external to fix compiling with goldbach-intel. + +Requirements for tag: regular + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: gbisht, self, muszala + +List any svn externals directories updated (csm_share, mct, etc.): Machines + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 - break creation of linear system into small physics based routines. + + +CLM testing: regular + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 4.0 ok, 4.5 ok + yellowstone_pgi - 4.0 ok, 4.5 ok + goldbach_nag - 4.0 ok, 4.5 ok (see note below) + goldbach_intel - 4.0 ok, 4.5 ok + goldbach_pgi - 4.0 ok, 4.5 ok + + NOTE for goldbach_nag - four ED compare_hist tests fail with small non bit for bit differences. This is the same issue described in clm4_5_1_r078 tag notes. + + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_1_r078 + +Changes answers relative to baseline: No, bit for bit + + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r078 +Originator(s): muszala (Stefan Muszala) +Date: Wed Jul 23 20:42:00 MDT 2014 +One-line Summary: Add lai stream capability and the ability to run with V5 cruncep data. Code written by swenson, +modified and tested by muszala. + +Purpose of changes: Add lai stream capability with use_lai_streams namelist variable. Also add a datm_mode option +s.t. we can use cruncep V5 data if a user wants. Move anomaly focing code out of CLM and into DATM. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: add setup_logic_lai_streams which controls use_lai_streams namelist variable + +List any changes to the defaults for the boundary datasets: added option to use V5 cruncep data sets. V4 is default. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: kluzek, swenson, self + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/addclm50_tags/addclm50_n06_ED_scripts_015_140305_rev ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/addclm50_tags/addclm50_n09_ED_scripts_015_140305_rev + +-models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_140312 ++models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_140723 + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140418 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +! add setup_logic_lai_streams function +M models/lnd/clm/bld/CLMBuildNamelist.pm +! add entries for: stream_year_first_lai, stream_year_last_lai, model_year_align_lai, stream_fldfilename_lai, lai_mapalgo +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +! add default values for items added in namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +! add use_lai_streams code. lai_init, lai_interp +M models/lnd/clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 +! some comment clean up. add use_lai_streams logical +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +! add use_lai_streams namelist handling and mpi_bcast call +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +! remove snomaly forcing streams since they are now in the datm +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +! remove anomaly forcing code since it is now in datm +M models/lnd/clm/src/cpl/lnd_import_export.F90 + +CLM testing: + + build-namelist tests: + + yellowstone - failed 20 tests of 537. This is expected due to the addition of the use_lai_streams namelist variable. + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + -- nlcomp tests for 45 will fail -- + + yellowstone_intel - 40 OK - 45 OK + yellowstone_pgi - 40 OK - 45 OK + + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + goldbach_pgi - 40 OK - 45 OK + +Both NAG tests on goldbach for ED compsets failed BFB. All other compilers and machines pass. Error probably related to a non-BFB error that I (spm) see with varying numbers of +time-steps on an ERS test and am currently trying to fix. + +FAIL ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.compare_hist.clm4_5_1_r077_redo +FAIL ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.clm2.h0.compare_hist.clm4_5_1_r077_redo +FAIL SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.compare_hist.clm4_5_1_r077_redo +FAIL SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest.GC.again_45_nag.clm2.h0.compare_hist.clm4_5_1_r077_redo +CLM tag used for the baseline comparisons: clm4_5_1_r077 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r077 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jul 10 21:55:11 MDT 2014 +One-line Summary: Refactor from Jinyun Tang (LBL) to make hydrology more modular and eventually allow runtime selection of different physics implementations. + +Purpose of changes: Refactor a number of routines in clm45 hydrology to move duplicate code into reusable routines, make the code more modular for eventual unit testing and run time selection of different physics. + +Requirements for tag: bit for bit, regular testing + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, clm-cmt + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + models/lnd/clm/src/util_share/SimpleMathMod.F90 - reuseable array functions + models/lnd/clm/src/clm4_5/main/init_hydrology.F90 - initialize different hydrology submodules. + models/lnd/clm/src/clm4_5/main/FuncPedotransferMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SurfaceResistanceMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/RootBiophysMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilWaterMovementMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilMoistStressMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoiWatRetCurveParMod.F90 - modularize + + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/bld/query-xFail - check python version and provide an error message of it is too old. + models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 - remove unused min/max variables that conflict with intrinsics with gfortran. + + + models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 - modularize + models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - allocate new variable, fix bounds on porosity + models/lnd/clm/src/clm4_5/main/controlMod.F90 - initialize new hydrology modules + models/lnd/clm/src/clm4_5/main/clmtype.F90 - add new variable + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 - modularize + models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 - modularize + +CLM testing: regular + + build-namelist tests: + + yellowstone - n/a + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - OK clm40, OK clm45 + yellowstone_pgi - OK clm40, OK clm45 + goldbach_nag - OK clm40, OK clm45 + goldbach_intel - OK clm40, OK clm45 + goldbach_pgi - OK clm40, OK clm45 + + short tests (aux_clm_short) (generally these are NOT used when making a tag): + + yellowstone_intel - n/a + yellowstone_pgi - n/a + goldbach_nag - n/a + + tools testing: + + yellowstone interactive - n/a + goldbach interactive - n/a + +CLM tag used for the baseline comparisons: clm4_5_1_r076 + +Changes answers relative to baseline: No, bit for bit + + Note: SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTest is not bit for bit. This is the same test Stef had problems with in clm4_5_75. He has looked at it and given the ok make the tag as is. + +=============================================================== +=============================================================== +Tag name: clm4_5_1_r076 +Originator(s): erik (Erik) +Date: Mon Jul 7 14:24:07 MDT 2014 +Orig Date: Wed Jun 25 13:49:49 MDT 2014 (Date of what was tagged as clm4_6_0, before we changed naming convention) +One-line Summary: Answer changes for fire code from Fang Li + +Purpose of changes: + +Several changes to CN Fire model. Some fixes for non-transient, as well as limiting of fire for high tropical +forest coverage. Change some units from per time-step to per second. Change Lightning input dataset from just +cloud to ground to total lightning. Some fire parameters were also changed and re-tuned for Qian forcing. +Some more documentation on fire fields was added. + +When -ed_mode is sent to CLM build-namelist, a particular ED params dataset is used over the default. Make +a simple change that allows ED to run when CN is off. Add a 1850 and transient 20thC and rcp=8.5 datasets +for 1x1_brazil. + +Requirements for tag: Fix bugs 1805 and 1719, lower fire amount in amazon + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1996 -- change cloud to ground lightning dataset to total lightning + 1995 -- change units from per time-step to per second + 1805 -- fire fix for non-transient + 1719 -- remove double counting of baf in fire area + 1992 -- allow ED to run when use_cn=.false. + 1988 -- Add ED params dataset. + 1991 -- transient datasets for 1x1_brazil + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + specific rparams file for ED + add 1850 and 20thC, rcp8.5 datasets for 1x1_brazil + use lightning file that is total lightning not just cloud-to-ground + +Describe any substantial timing or memory changes: + The test SMS.f19_g16.IRCP45CN.yellowstone_pgi showed a memory increase + +Code reviewed by: self, lifang + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to addclm50_n06_ED_scripts_015_140305_rev + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl --------- Add some ED tests + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - Different + params file for ED, and add 1850 and 20thC, rcp8.5 datasets for 1x1_brazil + and use lightning file that is total lightning not just cloud-to-ground + M models/lnd/clm/bld/CLMBuildNamelist.pm ------------------------- Pass use_ed + when getting paramfile + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ------------- Revisions from + Fang Li (2014), change parameters, add documentation, tropical forests will + only burn if > 60% coverage, change some fields units to per second rather than + per time-step, + M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 ------------- change units + for nfire, and farea_burned + M models/lnd/clm/src/clm4_5/main/clmtype.F90 --------------------- Change units + for nfire, lfc, lfc2, baf_crop, baf_peatf, fbac, fbac1, farea_burned + M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 ----------------- Change units for: + LFC2, NFIRE, FAREA_BURNED, BAF_CROP, BAF_PEATF + M models/lnd/clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 Allow to work + when use_cn is .false., use c3psn+1 in finding index for dr array. + +CLM testing: + + build-namelist tests: yes + + NOTE: 191 of the 537 compare tests fail, compared to clm4_5_75, because of changes in the namelist. + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + +CLM tag used for the baseline comparisons: clm4_5_75 + +Changes answers relative to baseline: + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CN and BGC with CLM4.5 physics + CLM4.0 for all modes, and CLM4.5 with SP or ED should be identical + - what platforms/compilers: All + - nature of change: new climate + + Fang Li, ran simulations with Qian forcing on yellowstone and tuned fire parameters to that forcing. + However, her simulations had a minor bug in the conversion of total lightning to just cloud-to-ground + (latitude in degree's was used for a cosine, rather than latitude in radians -- see bug 1996). + +=============================================================== +=============================================================== +Tag name: clm4_5_75 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Fri May 30 11:18:35 MDT 2014 +One-line Summary: update externals to rtm1_0_38 and esmf_wrf_timemgr_140529 + +Purpose of changes: update externals to rtm1_0_38 and esmf_wrf_timemgr_140529. These modifications +are based on valgrind errors that orginated in src/riverroute. Tested in clm4_5_72 to make sure +everything was still BFB (at least w.r.t. CLM testing). Retested (results below) against clm4_5_73. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID):N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_37 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_38 + +-models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 ++models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_140529 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: + +in addition to other clm tests I updated the rtm and esmf externals in cesm1_3_alpha09c and +ran two B cases. + +Note: There is one ED test (SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_nag.clm-edTestGb) that failed for me in my +testing but passed for Bill with the same checkout. We will keep an eye on this, but it's not super-critical at the moment. +Differences are very small in cpl. voc fields (largest RMS difference is 1e-13). + +>>more TestStatus +PASS ERS_PT.T31_g37.B1850CN.yellowstone_gnu +PASS ERS_PT.T31_g37.B1850CN.yellowstone_gnu.memleak + +>>more TestStatus +PASS ERS.ne30_g16.B1850C5CN.yellowstone_intel +PASS ERS.ne30_g16.B1850C5CN.yellowstone_intel.memleak + + build-namelist tests: N/A + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel - 40 OK - 45 OK - component gen comp - OK + yellowstone_pgi - 40 OK - 45 OK - component gen comp - OK + + goldbach_nag - 40 OK - 45 OK + goldbach_intel - 40 OK - 45 OK + goldbach_pgi - 40 OK - 45 OK + +CLM tag used for the baseline comparisons: clm4_5_73 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_74 +Originator(s): sacks (sacks) +Date: Wed May 28 16:05:36 MDT 2014 +One-line Summary: misc. bfb changes - see detailed summary below + +Purpose of changes: + + (1) Rename fpftdyn to flanduse_timeseries, and make related changes to names + throughout the code. This rename is in preparation for an upcoming tag + where this file will take on more general uses (e.g., transient crop + areas). + + (2) Decrease thresholds for water, snow and energy balance checks (these were + too permissive) + + (3) Move stuff out of clm_varcon into landunit_varcon (for constants specific + to CLM's landunits) and column_varcon (for constants specific to CLM's + columns) - analogous to the existing pftvarcon + + (4) Move some routines out of initGridCellsMod into a new initSubgridMod + + (5) Make time_info a public member of dyn_file_type, which allows removing a + bunch of delegation methods. And rename some things in time_info_type for + clarity. + + (6) Rework metadata for the description of landunit, column and pft types + on the history and restart files, to centralize these descriptions to the + appropriate place in the code. + + (7) Add general-purpose functionality for setting up subgrid structure for + unit tests + + (8) Move unit tests into source tree, rather than being in + test/unit_testers. Now the top-level script is in models/lnd/clm/src. + + (9) Fix baseline comparisons for PTCLM tests + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 1928 (create landunit_varcon.F90 and column_varcon.F90 from parts of clm_varcon.F90) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: fpftdyn renamed to flanduse_timeseries + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: addclm50_n03_ED_scripts_015_140305_rev -> addclm50_n04_ED_scripts_015_140305_rev + - Rename CLM's fpftdyn to flanduse_timeseries in tests; update perl5lib + + tools/unit_testing: unit_testing_0_04 -> unit_testing_0_05 + - the major change here is allowing rebuilds with intel without needing to + specify --clean + + models/lnd/clm/tools/PTCLM: PTCLM2_140423 -> PTCLM2_140521 + - rename fpftdyn -> flanduse_timeseries, and other related renames + +List all files eliminated: + +========= Renamed +D models/lnd/clm/tools/clm4_5/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +D models/lnd/clm/tools/clm4_0/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt + +========= Move unit tests into source tree +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/test_daylength.pf +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test +D models/lnd/clm/test/unit_testers/clm4_5/biogeophys +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarShared.F90 +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeInterp.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeUninterp.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/test_init_columns.pf +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test +D models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/GetGlobalValuesMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/clm_time_manager_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/do_genf90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90.in +D models/lnd/clm/test/unit_testers/clm4_5/mock/util_share +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/mct_mod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/histFileMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/main +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynFileMod_mock.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid +D models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/mock +D models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +D models/lnd/clm/test/unit_testers/clm4_5/README +D models/lnd/clm/test/unit_testers/clm4_5 +D models/lnd/clm/test/unit_testers + + +List all files added and what they do: + +========= Renamed +A models/lnd/clm/tools/clm4_5/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt +A models/lnd/clm/tools/clm4_0/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt + +========= Move stuff out of clm_varcon into landunit_varcon (for constants + specific to CLM's landunits) and column_varcon (for constants specific + to CLM's columns) - analogous to the existing pftvarcon. +A models/lnd/clm/src/clm4_5/main/landunit_varcon.F90 +A models/lnd/clm/src/clm4_5/main/column_varcon.F90 + + +========= Move some routines out of initGridCellsMod - these are lower-level + routines that can also be used by unit test code. So initGridCellsMod + contains higher-level stuff that is specific to how the subgrid + structure is set up in a production run; and initSubgridMod contains + lower-level stuff that doesn't know or care how things are actually + set up, conceptually. +A models/lnd/clm/src/clm4_5/main/initSubgridMod.F90 + +========= Add general-purpose functionality for setting up subgrid structure for unit tests +A models/lnd/clm/src/unit_test_shr/unittestSubgridMod.F90 +A models/lnd/clm/src/unit_test_shr/CMakeLists.txt +A models/lnd/clm/src/unit_test_shr + + +========= Move unit tests into source tree; also modify some unit tests to take + advantage of the new unittestSubgridMod; also add tests of + subgridWeightsMod and clm_glclnd +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test/test_subgridWeights.pf +A models/lnd/clm/src/clm4_5/main/test/subgridWeights_test +A models/lnd/clm/src/clm4_5/main/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test/test_clm_glclnd.pf +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/main/test/clm_glclnd_test +A models/lnd/clm/src/clm4_5/main/test +A models/lnd/clm/src/clm4_5/biogeophys/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test/test_daylength.pf +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/test/Daylength_test +A models/lnd/clm/src/clm4_5/biogeophys/test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynLandunitArea_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynVar_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynTimeInfo_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid/test/dynInitColumns_test +A models/lnd/clm/src/clm4_5/dyn_subgrid/test +A models/lnd/clm/src/README.unit_testing +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/GetGlobalValuesMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_var.F90.in +A models/lnd/clm/src/unit_test_mocks/util_share/clm_time_manager_mock.F90 + - also add a routine to this mock, needed because of refactor of + dyn_file_type / dyn_time_inof +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/spmdMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/util_share/do_genf90 +A models/lnd/clm/src/unit_test_mocks/util_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/util_share/ncdio_pio_mock.F90.in +A models/lnd/clm/src/unit_test_mocks/util_share +A models/lnd/clm/src/unit_test_mocks/csm_share/shr_sys_mod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/csm_share/mct_mod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/csm_share/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/csm_share +A models/lnd/clm/src/unit_test_mocks/main/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/main/histFileMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/main +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid/dynFileMod_mock.F90 +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks/dyn_subgrid +A models/lnd/clm/src/unit_test_mocks/CMakeLists.txt +A models/lnd/clm/src/unit_test_mocks +A models/lnd/clm/src/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +========= Renamed fpftdyn -> flanduse_timeseries, and other related changes to + variable names + (NOTE: Some source files are listed both here and elsewhere in the + ChangeLog entry) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/clm4_5/mksurfdata_map/README +M models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +M models/lnd/clm/tools/shared/ncl_scripts/sample_outlist +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varctl.F90 +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/clm4_0/mksurfdata_map/README +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_defaults_clm4_5_test.xml +M models/lnd/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml +M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml +M models/lnd/clm/doc/UsersGuide/single_point.xml +M models/lnd/clm/doc/UsersGuide/tools.xml +M models/lnd/clm/doc/UsersGuide/adding_files.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/ptclm.xml +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 +M models/lnd/clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 + +========= Updated PTCLM external to rename fpftdyn -> flanduse_timeseries +M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + +========= Decrease threshold for water & snow balance checks by 3 orders of + magnitude; decrease threshold for energy balance checks by 2 orders of + magnitude +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Separate clm_varcon into clm_varcon, column_varcon and landunit_varcon +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + +========= Move some routines out of initGridCellsMod, into a new initSubgridMod + (see detailed notes above) +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Make time_info a public member of dyn_file_type. This allows us to + remove all methods from dyn_file_type (which were just delegating + responsibility to time_info_type). Also rename some methods and + variables in time_info_type. +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in + - also change intent(in) to intent(inout), fixing a gfortran problem +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 + +========= Rework metadata for the description of landunit, column and pft types + on the history and restart files. Point is to centralize the + definition of these different types as much as possible (rather than, + e.g., having restFileMod know about the translation between landunit + indices and names). For the history file, I am removing the metadata + from the PCT_LANDUNIT long name, instead putting it in global + metadata, as is done for the restart file. +M models/lnd/clm/src/clm4_5/main/subgridWeightsMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 + +========= Change 'use' statements based on my split of clm_varcon into + clm_varcon, landunit_varcon and column_varcon +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4InitMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 + +========= Fix baseline comparisons for PTCLM tests +M models/lnd/clm/test/tools/TSMscript_tools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh + +========= Just changes in whitespace +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/biogeophys/CMakeLists.txt + + +CLM testing: + + Most testing done on dynlu_crops_n01_addclm50bld_n06_clm4_5_72; PTCLM and + tools testing done on dynlu_crops_n03_addclm50bld_n06_clm4_5_72 + + Note that the branch was up-to-date with addclm50bld_n06_clm4_5_72; this is + identical to clm4_5_73 except for a fix to the build-namelist tests (see below) + + build-namelist tests: + + yellowstone: ok + compared against addclm50bld_n06_clm4_5_72 (essentially clm4_5_73) + expected diffs for transient cases + + The following tests also failed when comparing the baseline against + itself (NOTE: this is apparently fixed in clm4_5_73): + + 466/497 < FAIL> + 467/497 < FAIL> + 496/497 < FAIL> + 497/497 < FAIL> + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel: ok + yellowstone_pgi: ok + goldbach_nag: ok + goldbach_intel: ok + goldbach_pgi: ok + + Most comparisons were done against clm4_5_72. + + These comparisons failed due to a problem with component_gen_comp and the + SSP test; manual comparisons show these to be identical to Erik's tests (for + clm4_5_73): + + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default.GC.0520-2021.45.p.clm2.h0.compare_hist.clm4_5_72 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_pgi.clm-default.GC.0520-2021.45.p.clm2.h1.compare_hist.clm4_5_72 + + For new tests added in Erik's upcoming tag (clm4_5_73), I did manual + comparisons against Erik's baselines (cpl & clm hist for the yellowstone + tests, just cpl for goldbach tests) - all PASS. + + Note that CLM hist files were NOT compared for any goldbach tests, because + there were no CLM hist file baselines for clm4_5_72. + + tools testing: + + yellowstone interactive: ok + + Compared against addclm50bld_n06_clm4_5_72 (essentially clm4_5_73) + + Failures in the following baseline comparisons, due to changed name of output + file (surfdata.pftdyn -> landuse.timeseries). Manual comparisons showed the + output files to be identical in all cases: + + 010 bl754 TBLtools.sh clm4_0 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 018 bl974 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 040 blfg4 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Global_clm4_5^buildtools ......\c + rc=7 FAIL + + Other than that, all tests & baseline comparisons passed + +CLM tag used for the baseline comparisons: clm4_5_72, except where noted above + +Changes answers relative to baseline: NO - bfb + +=============================================================== +=============================================================== +Tag name: clm4_5_73 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed May 28 15:33:10 MDT 2014 +One-line Summary: Add the stub ability for clm5_0 physics to CLM build system + +Purpose of changes: + +Add phys=clm5_0 as an option to the build. Currently, nothing is different in the code, this just +adds the capability to do clm5_0 as a seperate configuration. The one thing that is different between +clm4_5 and clm5_0 is the setting of urban_hac. + +Fix several issues needed for CAM: problem in DryDeposition (reoccurance of bug 1883, that was fixed and then +unfixed in clm4_5_48), fix for internal compiler errors. CAM has been using the branch version of this +since: cam5_3_29. + +Work on updates for PTCLM. Add some new sites for Rosie and Jinyun. Correct the call to mkmapdata.sh. +Have CLM1PT forcing directory to use DIN_LOC_ROOT_CLMFORC so you can point it to a location seperate +from DIN_LOC_ROOT. Add a new support script to PTCLM to submit a list of sites to batch: PTCLMsublist. +Also allow release_tags in version find. Get buildtools to work on edison/hopper. + +Get tools to work on hopper and edison, and update mapping to use ESMF6.3.0. + +Fix various bugs: internal compiler error on janus, trigger an error if user_datm.streams.txt file is + readonly (rather than hang). Use DIN_LOC_ROOT_CLMFORC for CLM1PT. + +Requirements for tag: Fix bug 1883 and 1985 for Cheryl and CAM, fix PTCLM, add clm5_0, tools on hopper/edison + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1985 Internal compiler error on yellowstone with CLM in CAM standalone build + 1965 Internal compiler error on janus with CLM on janus + 1938 Upgrade mkmapdata to ESMF6.3.0 + 1937 Using a read-only user_datm.streams.txt file causes cesm_setup to hang + 1936 CLM1PT forcing directory needs to use DIN_LOC_ROOT_CLMFORC + 1935 Changes needed to get tools to build on hopper... + 1933 Correct call to mkmapdata.sh in PTCLM + 1925 Add more sites to PTCLM + 1904 check for LSF_PJL_TYPE in regridbatch.sh doesn't work correctly + 1883 uninitialized variable in DryDepVelocity.F90 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add clm5_0 as a new supported physics type + +Describe any changes made to the namelist: Set urban_hac according to physics + clm5_0=ON_WASTEHEAT, and clm4_5=ON + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self (clm_phys perl object reviewed by team: bandre, muszala, sacks) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm + scripts to addclm50_n03_ED_scripts_015_140305_rev + datm to datm8_140312 + csm_share to share3_140418 Use trunk version rather than branch + tools/mapping to mapping_131217a + PTCLM to PTCLM2_140423 + +List all files eliminated: + + D models/lnd/clm/bld/unit_testers/env_run.xml -- This file is now built dynamically when the tester is run. + +List all files added and what they do: + + A models/lnd/clm/bld/query-xFail --- Add a script from Ben Andre to read and report on expected fails. + A models/lnd/clm/bld/env_run.xml --- envxml_dir option is now required, so this provides a env_*.xml + file that can be read by default, when build-namelist is called outside of CESM for testing. + A models/lnd/clm/bld/config_files/clm_phys_vers.pm - Enter physics version as a string i.e.: clm4_0 + and then have the ability to interpret it as different types so you can do logical operations + on physics versions + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/shared/mkmapdata/regridbatch.sh ------- Add ability to run on hopper + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh --------- Add ability to run on hopper/edison + remove jaguarpf, and upgrade to ESMF6.3.0 + M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl - New version of NCL requires + load before "begin" statement + + M models/lnd/clm/bld/configure ------------- Allow phys=clm5_0 and add in new clm_phys_vers object + M models/lnd/clm/bld/README ---------------- Update info on files + M models/lnd/clm/bld/CLMBuildNamelist.pm --- Put list of required options at top of help, and make envxml_dir + a required option. Add in use of clm_phys_vers object. Make sure use_ed_spitfire is only on if use_ed is + on. If CLM_UPDATE_GLC_AREAS=TRUE and phys=clm4_0 trigger an error + M models/lnd/clm/bld/config_files/config_definition_clm4_5.xml - Add all three physics version options + M models/lnd/clm/bld/config_files/config_definition_clm4_0.xml - Add info. about clm4_5/clm5_0 options + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - Add use of clm_phys_vers, and create env_run.xml + on the fly. Also add new tests for glacier update areas, and ED: usespitfireButNOTED, useEDclm40, useEDContradict2 + useEDContradict, clm40andUpdateGlc, clm40andUpdateGlc, UpdateGlcContradict, UpdateGlcNoGLCMe, and tests + for clm5_0 + + M models/lnd/clm/bld/test_build_namelist/t/test_vichydro.pm ----- Needs to use clm_phys_vers object + M models/lnd/clm/bld/test_build_namelist/test_build_namelist.pl - Needs to use clm_phys_vers object + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - urban_hac depends on clm4_5/clm5_0 + +-------------- Add phys=clm5_0 for all use-cases that test on phys + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + +------------- Fix bugs 1883 (rs over lake) and 1983 (CAM internal compiler error) and 1965 +------------- (janus internal compiler error) + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 ----- Set rs over lake + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 -------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/main/restFileMod.F90 -------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 ------ Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 -- Add use only for ncd_pio + M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 ----- Add use only for clmtype and dynVarTimeUninterpMod + fixes internal compiler error on janus (1965) + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 ----- Set rs over lake + M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 -------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/subgridRestMod.F90 ----------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/iniTimeConst.F90 ------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/restFileMod.F90 -------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 ---------------- Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/biogeophys/UrbanInputMod.F90 ------ Add use only for ncd_pio + M models/lnd/clm/src/clm4_0/biogeophys/BiogeophysRestMod.F90 -- Add use only for ncd_pio + +CLM testing: + + a) regular + b) build_namelist + c) tools + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm40, aux_clm45, with '-model_gen_comp clm2'): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_intel yes + goldbach_pgi yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_72 + +Changes answers relative to baseline: No (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_72 +Originator(s): muszala (Stefan Muszala) +Date: Mon May 5 17:47:52 MDT 2014 +One-line Summary: Introduce code for Ecosystem Demography (CLM(ED)) Model + +Purpose of changes: Introduce code for Ecosystem Demography (CLM(ED)) Model - first functional tag. + +A large chunk of this code was written and re-written by Rosie Fisher. + +"Introduce code for Ecosystem Demography (CLM(ED)) Model. Adds capability to allow plant functional +types to compete for light, to represent recovery from disturbance, and to allow disturbances +(i.e. fire) to only afflict some fraction of the canopy, and to represent vegetation at the scale +of cohorts of trees. Note that this is a large change and includes: + +1. Significant alterations to canopy albedo and surface radiation calculations +2. New photosynthesis scheme, based on existing science but to allow for more complex canopy structure +3. Introduction of a new allocation and growth scheme, (no consistent with that in CLM(CN) +4. Removal, for now, of Nitrogen limitation capabilities +5. Introduction of the SPITFIRE fire model, which interacts with ED via it's representation of + size-structured mortality and removal of litter pools. +6. Introduction of a simple seed bank model to allow persistence of vegetation through fire events. +7. For ED compsets there exists a cohort dimension on the restart files. + +Cold starts and restarts work for the following. The 1x1_brazil is the most heavily tested case both from +science and SE standpoint: + +1x1_brazil.ICLM45CNED.yellowstone_[intel | pgi] +5x5_amazon.ICLM45CNED.yellowstone_[intel | pgi] +1x1_brazil.ICLM45CNED.goldbach_[nag | intel | pgi ] +5x5_amazon.ICLM45CNED.goldbach_[nag | intel | pgi ] + +Cold starts work for: + +f10_f10.ICLM45CNED.yellowstone_[intel | pgi]. +f19_g16.ICLM45CNED.yellowstone_[intel | pgi] + +Code Origins: + +The ED code in CLM is originally based on code by Moorcroft (www.oeb.harvard.edu/faculty/moorcroft/code_and_data/index.html) +and has been heavily modified in regards to both scientific implementation and assumptions. Fom a software engineering +perspective, ED was rewritten from C into F2003 and the structure of the code has been significantly altered to fit into +the CESM/CLM framework. + +The SPITFIRE code is based on (http://www.biogeosciences.net/7/1991/2010/bg-7-1991-2010.pdf) and has been significantly +altered and extended to fit into the CESM/CLM framework. + +Other points: + 1. removed many unused variables and module uses as reported by nag + 2. changing text wrapping on comments so they end at 139 characters + 3. changed many text based logical operators (.ne., .lt., .ge.) with their math. equivlanet (/=, > , <=) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: ED functionality brought in. Does not change existing +configurations. For ED, there are now a CNED and BGCED compset. Use CNED until BGC issues are worked +out. + +Describe any changes made to the namelist: ED functionality brought in. Does not change existing +configurations. For ED compsets, there are two new namelist variables. They are: + +use_ed = .true. +use_ed_spit_fire = .true. + +use_ed_spit_fire is set to true by default if use_ed is on. Unless you are running our ED tests, you will +have to change your user_nl_clm to something like: + +paramfile ='/glade/p/cesmdata/cseg/inputdata/lnd/clm2/edParams/CLMPARAMS_ED_011514.nc' +finidat = '' +hist_mfilt = 365 +hist_nhtfrq = -24 + +hist_empty_htapes = .true. + +hist_fincl1='NPP','GPP','BTRAN','TOTVEGC','H2OSOI','TLAI','LITTER_IN','LITTER_OUT', +'STORVEGC','FIRE_AREA','SCORCH_HEIGHT','FIRE_INTENSITY','FIRE_TFC_ROS','fire_fuel_mef', +'LITTERC','fire_fuel_bulkd','fire_fuel_sav','FIRE_NESTEROV_INDEX','PFTbiomass', +'PFTleafbiomass','FIRE_ROS','WIND','TFC_ROS','DISPVEGC','AREA_TREES','AREA_PLANT' + +If on goldbach, use: + +paramfile ='/fs/cgd/csm/inputdata/lnd/clm2/edParams/CLMPARAMS_ED_011514.nc' + +List any changes to the defaults for the boundary datasets: N/A. + +Describe any substantial timing or memory changes: + +Code reviewed by: Stefan Muszala and Rosie Fisher. Detailed code review by Bill Sacks, Mariana Vertenstein, +Ben Andre, and Erik Kluzek. Discussion of code review included Dave Lawrence, Forrest Hoffmann +and Ryan Knox. + +List any svn externals directories updated (csm_share, mct, etc.): + +Changed externals to a branch_tag that supports ED compsets. We are using branch_tags because trunk +scripts does not work with all of the current CLM tests: + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/add_dynlu_tests_tags/add_dynlu_tests_n03_scripts4_140305 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/ED_scripts_tags/ED_scripts_015_140305_rev + +List all files eliminated: N/A + +List all files added and what they do: + +### SPITFIRE code +# new SPITEFIRE directory +A + models/lnd/clm/src/clm4_5/main/spitfireSF +# main SPITFIRE code +A + models/lnd/clm/src/clm4_5/main/spitfireSF/SFParamsMod.F90 +# handle SPITFIRE parameters +A + models/lnd/clm/src/clm4_5/main/spitfireSF/SFMainMod.F90 + +# pull out, move to a shared location, place in own module +A + models/lnd/clm/src/util_share/quadraticMod.F90 + +### new source and directories for ED +## ED code required for biogeophysics +# ED directory in biogeophys +A + models/lnd/clm/src/clm4_5/biogeophys/ED +# Calculates daily carbon flux drivers from hourly calculations. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDAccumulateFluxesMod.F90 +# Calculates absorbed, reflected and transmitted radiation in diffuse and direct streams for +# each of the canopy layer x PFT x leaf layer three-dimensional matrix. Uses iterative Norman +# radiation transfer scheme. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDSurfaceAlbedoMod.F90 +# Main photosynthesis model. Calculates leaf level fluxes on a canopy layer x PFT x leaf layer +# three-dimensional matrix. Sums to canopy to produce overall canopy conductance. Unpacks leaf- +# level fluxes into cohort level fluxes. Uses same scientific assumptions as CLM4.5. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDPhotosynthesisMod.F90 +# Generates PFT specific BTRAN vector for each ED patch. Includes option for SPA-like calculations. +A + models/lnd/clm/src/clm4_5/biogeophys/ED/EDBtranMod.F90 + +## ED code required for biogeochemistry +# ED directory in biogeochem +A + models/lnd/clm/src/clm4_5/biogeochem/ED +# Determines which cohorts are in the upper and lower canopy layers. Sets leaf area index inputs to biogeophysics calculations. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDCanopyStructureMod.F90 +# Initializes some ED-specific variables to zero at startup. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDSetValuesMod.F90 +# Contains allometric relationships between vegetation properties (height, dbh, LAI, dead biomass, live biomass, crown area) biogeochem/ED/EDPatchDynamicsMod.F90 : Creates patches, fuses similar patches, controls disturbance and generation of area. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDGrowthFunctionsMod.F90 +# Creates, fuses, terminates, sorts, counts and copies cohort structures. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDCohortDynamicsMod.F90 +# Contains all calculations of derivatives of biomass, litter and seed pools. Also includes phenology model, seed and litter production and decay models, and canopy optimization model. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDPhysiologyMod.F90 +# Creates, fuses, terminates, sorts, counts and copies patch structures. +A + models/lnd/clm/src/clm4_5/biogeochem/ED/EDPatchDynamicsMod.F90 + +## ED core functionality and types that interact with CLM (generally not science) +# ED directory in main +A + models/lnd/clm/src/clm4_5/main/ED +# Transmits required information for CLM (tlai, htop, tile weights). Updates ED-specific history field variables. +A + models/lnd/clm/src/clm4_5/main/ED/EDCLMLinkMod.F90 +# Initializes ED PFT parameter structure. +A + models/lnd/clm/src/clm4_5/main/ED/EDInitTimeConst.F90 +# Contains ED-specific variables for CLM +A + models/lnd/clm/src/clm4_5/main/ED/EDClmType.F90 +# Adds history field variables specific to ED to history file. +A + models/lnd/clm/src/clm4_5/main/ED/EDHistFldsMod.F90 +# Prints out and reads in ED state vector to/from history files. +A + models/lnd/clm/src/clm4_5/main/ED/EDRestVectorMod.F90 +# Initializes ED-specific variables for CLM +A + models/lnd/clm/src/clm4_5/main/ED/EDClmTypeInitMod.F90 +# Allocates ED PFT specific variables. +A + models/lnd/clm/src/clm4_5/main/ED/EDPftvarcon.F90 +# Initializes ED site, patch and cohort structures, either to restarting or bare ground values. +A + models/lnd/clm/src/clm4_5/main/ED/EDInitMod.F90 +# Allocates and initializes ED parameters (that are not PFT specific). +A + models/lnd/clm/src/clm4_5/main/ED/EDParamsMod.F90 +# Main ED model routine. Calls all other daily ED dynamics, integrates variables, checks carbon balance. +A + models/lnd/clm/src/clm4_5/main/ED/EDMainMod.F90 +# Contains ED type structures (cohort, site, patch) and static values. +A + models/lnd/clm/src/clm4_5/main/ED/EDTypesMod.F90 + +# utility routine to help in reading parameter files +A + models/lnd/clm/src/clm4_5/main/paramUtilMod.F90 +# transfers weights calculated internally by ED into wtcol. +A + models/lnd/clm/src/clm4_5/dyn_subgrid/dynEDMod.F90 + +List all existing files that have been modified, and describe the changes: + +### build modifications +# add ED source directories for build +M models/lnd/clm/bld/configure +# build namelist additions for ED +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +# setup_cmdl_ed_mode addition. sets namelist vars +M models/lnd/clm/bld/CLMBuildNamelist.pm + +### util_share modifications +# add function is_beg_curr_day() +M models/lnd/clm/src/util_share/clm_time_manager.F90 +# modify get_proc_bounds to include beg, end cohort +M models/lnd/clm/src/util_share/accumulMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/util_share/ncdio_pio.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +### 4_5 Modifications +# change text based logical with math style (.gt. to >, .ne. to /=) +# modify get_proc_bounds to include beg, end cohort +M models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +# move some variables from stack to heap. +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 + +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initInterp.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +# add call to call EDInitTimeConst +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 +# add decomposition for cohort dimension +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +# add call for ed_init +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +# add code for cohort dimension +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +# add use_ed logical to support cohort dimension +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +# broadcast ed namelist variables +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +# use_ed logical to call edmodel +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +# clean up unsued variables from nag compiler warnings +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +# add routine set_cohort_decomp +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +# change spacing, text wrapping +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +# add support for cohort dimension +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +# change spacing, text wrapping +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +# add call to read ED and SPITFIRE params +R + models/lnd/clm/src/clm4_5/main/readParamsMod.F90 +# add routine set_cohort_decomp +# add use_ed logical(s) +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +# change get_proc_global to support cohort dimension +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +# change spacing, text wrapping +# add use_ed logical(s) +# calculate ed root fractionation +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +# add use_ed logical(s) for forc_solai and parsun +# use_ed reporting +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +# add use_ed logical(s) for norman_radiation +# change spacing +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +# remove unused variable +M models/lnd/clm/src/clm4_5/biogeophys/SLakeCon.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +# change text based logical with math style (.gt. to >, .ne. to /=) +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +# add use_ed logical(s) for call dyn_ED +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +### 4_0 Modifications +# add optional cohort argument for new ED dimension to get_proc_global and +# get_proc_bounds_old for 40 backward compatibility +M models/lnd/clm/src/clm4_0/main/decompMod.F90 + +CLM testing: + +--SNICARFRC - moved ERI_D.T31_g37.ICLM45.goldbach_nag.clm-SNICARFRC to goldbach and nag. This is a BFAIL. + +--Testing for new ED compsets. All compare hist portions were BFAIL's since this is the first time +the tests are being put in place. + +--ED and yellowstone [ intel | pgi ] + PASS ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS.f10_f10.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS.f19_g16.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + PASS SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.yellowstone_[intel | pgi].clm-edTest + +--ED and goldbach [nag | intel | pgi ] + PASS ERS_D_Mmpi-serial.1x1_brazil.ICLM45CNED.goldbach_[nag | intel | pgi ].clm-edTestGb + PASS SMS_D_Mmpi-serial.5x5_amazon.ICLM45CNED.goldbach_[nag | intel | pgi ].clm-edTestGb + +--CLM history file comparison: + +yellowstone [intel | pgi] - OK + +I ran without the -model_gen_comp option, but ran component_gen_comp and summarize_cprnc_diffs +by hand for both yellowstone_intel and yellowstone_pgi. These are both OK + +--Regular tests (aux_clm testlist) + + yellowstone_intel - OK + yellowstone_pgi - OK + goldbach_nag - OK + goldbach_intel - OK + goldbach_pgi - OK + +CLM tag used for the baseline comparisons: clm4_5_71 + +Changes answers relative to baseline: No. Existing compsets do not change. +If you run with an *ED* compset, then results will differ, but that is expected. + +=============================================================== +=============================================================== +Tag name: clm4_5_71 +Originator(s): Bill Sacks & Jeremy Fyke +Date: Fri May 2 13:00:10 MDT 2014 +One-line Summary: 2-way feedbacks for glacier, veg columns compute glacier SMB, and related changes + +Purpose of changes: + + (1) Bring in two-way feedbacks for glacier when coupled to CISM, via dynamic + landunits, so that CLM's glacier area remains consistent with CISM's + glacier area. Also update CLM's glacier topography to be consistent with + CISM. + + (2) Add an elevation class "0", which provides surface mass balance over the + vegetated portion of the grid cell. This is used to achieve glacial + inception in CISM. Along with this change, also (a) set the topographic + height of non-glacier areas based on bare land topography from CISM, and + (b) change the downscaling of atmospheric fields so that they are also + downscaled over vegetated columns within CISM's ice mask, to achieve + greater consistency between what's happening in the glacier and vegetated + portions of CISM's domain. (Note that, because longwave radiation is + normalized, downscaling it over the vegetated column also changes answers + over glacier columns.) These changes were primarily from Jeremy Fyke. + + (3) Rework some consistency checks to play nicely with dynamic landunits. + + (4) Rework unit test build to use libraries for the clm source and csm_share source + + (5) Misc. other changes, as noted below. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + - 1969 (incorrect values for QSNWCPICE_NODYNLNDUSE) + - 1929 (dynFileMod breaks with gfortran 4.8) + - 1832 (logic for weights error check differs between clm4.0 and clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +========= Add tests +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_140305 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/add_dynlu_tests_tags/add_dynlu_tests_n03_scripts4_140305 + +========= Pull in Machines_140318, needed for goldbach +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_01_mach140218 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_02_mach140218 + +========= Changes needed for elevation class 0, etc. +-models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_07 ++models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_10 +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140416 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140501 + + +List all files eliminated: + +========= Point to real decompMod rather than mock +D models/lnd/clm/test/unit_testers/clm4_5/mock/main/decompMod_boundsTypeDecl.F90 + +List all files added and what they do: + +========= Most of reweightMod.F90 moved here; also includes the following changes: + (1) renames some subroutines + (2) adds some diagnostic fields that are written to the history file + (3) adds some utility routines such as get_landunit_weight +A models/lnd/clm/src/clm4_5/main/subgridWeightsMod.F90 + +========= Add code to initialize newly-active columns +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynInitColumnsMod.F90 + +========= New unit tests +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/test_init_columns.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynInitColumns_test + +========= Need new mocks and new real files now that we use the real decompMod, and also because of endrun calls +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/GetGlobalValuesMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/mct_mod_mock.F90 +A models/lnd/clm/src/util_share/CMakeLists.txt + +========= Need stub histFileMod now that many modules include calls to hist_addfld +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/histFileMod_mock.F90 + +List all existing files that have been modified, and describe the changes: + +========= Update glacier cover and topographic heights based on values from CISM; rework + code to accommodate icemask and elevation class 0 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 + +========= Change to be consistent with clm4_5 version, adding elevation class 0 and + x2s%icemask (neither of which are used in the clm4_0 version) +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 + +========= Add glc_do_dynglacier namelist option, which triggers off of + CLM_UPDATE_GLC_AREAS; rename glc_dyntopo to glc_dyn_runoff_routing and make it + also trigger off of CLM_UPDATE_GLC_AREAS; add glc_snow_persistence_max_days; add + dynpft_consistency_checks and finidat_consistency_checks groups +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/CLMBuildNamelist.pm +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/env_run.xml +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + - also use parameter for file name length, so that other modules can + ensure consistency of char length + +========= Add functions to convert between col%itype and icemec class; also add + landunit_names vector +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +========= Add functions add_landunit, add_column, add_patch (cleans up this code, and will + assist with setting up unit tests) and use new functions from clm_varcon +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Use new functions from initGridCellsMod +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 + +========= Remove old consistency checks for restart file, add new ones (these changes are + needed so that consistency checks work right with dynamic landunits, and we're + adding some new consistency checks that weren't in place before) +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + - also read all subgrid weights and glc topo on restart + (some of these used to be read in BiogeophysRestMod; + we need all of them with dynamic landunits) + - also remove redundant mcdate, mcsec + - also add icemask restart variable +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + - also remove redundant PFT_WTGCELL, PFT_WTLUNIT, PFT_WTCOL + (equivalent variables are already output by subgridRestMod) + - also add snow_persistence + +========= Remove old consistency checks for pftdyn file, add new ones + (these changes are needed so that consistency checks work right with dynamic landunits) +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + - also call init_subgrid_weights_mod, put call to update_clm_s2x in + loop over clumps, and move deallocation of topo_glc_mec to later +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 + +========= Add new dimensions for multi-level fields - for subgrid weight diagnostics; add + a dimension to accommodate fields dimensioned by glc_nec+1 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +========= Call new routines (update_clm_x2s, set_subgrid_diagnostic_fields, initialize_new_columns) +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Make various code operate over veg as well as icemec columns +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also put call to update_clm_s2x in a loop over clumps +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 + - also compute snow_persistence, and rework some code for clarity + +========= Add initialization of icemask & snow_persistence; change + initialization of glc_topo and h2osno +M models/lnd/clm/src/clm4_5/main/initColdMod.F90 + +========= Add l2g_scale_type = natveg +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + +========= Fix QSNWCPICE_NODYNLNDUSE, add l2g_scale_type for QICE & related fields, add + SNOW_PERSISTENCE and ICE_MASK, change _FORC fields to include elevation class 0 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +========= Get rid of associate statement that caused problems with some compilers +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 + +========= Track old col%active values, needed for initializing new columns +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 + +========= Moved most functionality to subgridWeightsMod.F90 (now just a small + wrapper to some of the stuff in subgridWeightsMod, whose main purpose + is to avoid a dependency of subgridWeightsMod on filterMod) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Changes for unit tests: + (1) Update unit tests to use libraries for the clm source and csm_share source + (2) New unit test + (3) Make unit tests work with latest CLM trunk + (4) Point to real decompMod rather than mock +M models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +M models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt + +========= Add icemask & snow_persistence; remove unused glc_frac, glc_rofi & glc_rofl +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +========= Minor changes to 'use' statements for the sake of breaking dependencies for unit tests +M models/lnd/clm/src/util_share/GetGlobalValuesMod.F90 +M models/lnd/clm/src/clm4_5/main/decompMod.F90 + +========= Changes to comments only +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/util_share/domainMod.F90 + +========= Remove no-longer-failing test, change failType of a test (it was RUN + rather than FAIL at least as far back as clm4_5_69) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + regular tests + + NOTE: Most tests were done on bare_land_smb_n15_clm4_5_70, which did NOT + include r59820 (add a comma in histFileMod to fix a syntax error caught by + nag). After r59820, reran all goldbach_nag tests, plus one goldbach_pgi and + one goldbach_intel. + + yellowstone_intel: ok + yellowstone_pgi: ok + goldbach_nag: ok + goldbach_intel: ok + goldbach_pgi: ok + + component_gen_comp on yellowstone_intel & yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_69 (clm4_5_68 for a few tests + with missing baselines in clm4_5_69) + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All IG compsets (i.e., GLC compsets) + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + New Climate + + Changes are: + + (1) All IG compsets (clm4.0 & clm4.5) change due to new CISM external + + (2) In addition, IG compsets with CLM4.5 change further due to: + (a) 2-way feedbacks (CLM updated to match CISM) + (b) downscaling done over vegetated landunits within the icemask + + (3) Also, the QSNWCPICE_NODYNLNDUSE history diagnostic field changes for + ALL CLM4.5 runs, due to fixing bug 1969. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_70 +Originator(s): muszala (Stefan Muszala) +Date: Fri Apr 18 08:24:44 MDT 2014 +One-line Summary: bring in SHR_ASSERT macros + +Purpose of changes: bring in SHR_ASSERT macros for Santos. + +Add: #include "shr_assert.h" to source files +Remove: use shr_assert_mod , only : shr_assert + +then replace "call shr_assert" with SHR_ASSERT_ALL when asserting more than one dim + +- call shr_assert((ubound(carr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) ++ SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + +and use SHR_ASSERT when asserting one dimen + +- call shr_assert(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) ++ SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Self, Santos, Sacks + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_140218 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/branch_tags/arfs_tags/arfs_01_mach140218 + +-scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140109 ++scripts/ccsm_utils/CMake https://github.com/quantheory/CMake_Fortran_utils/tags/CMake_Fortran_utils_140403 + +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_37 + +-models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140303 ++models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_140416 + +-models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_131231 ++models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/shr_assert_macro_tags/shr_assert_macro_n04_share3_140115 + +-models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n03_MCT_2.8.3 ++models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n04_MCT_2.8.3 + +-models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_9/pio ++models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_11/pio + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/DaylengthMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 + +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + +Tested with two sets of externals because: + +The old scripts do not allow any PGI tests to run while the new scripts have various issues +with ERI tests and selected PGI tests plus nag debug runs (fixed in a more recent machines tag). + +By running with two sets of externals, I am confident that the source mods for SHR_ASSERT are +working correctly. When CLM gets updates in scripts and machines, these will be updated in +later tags. + +I) Those included in this tag +II) Those that are a part of cesm1_3_alpha09b (only tested clm45). + + build-namelist tests: N/A + + regular tests: for (I) above: + + yellowstone_intel - OK - component_comp_gen - OK + goldbach_nag - OK + goldbach_intel - OK + + regular tests: for (II) above: + +1) Yellowstone + Intel : all ERI tests are completing ref1 and ref2 but die a silent death in the base case. Erik looks like you changed Testlists, so the two VIC tests might be expected. + +>>./cs.status.70Intel.yellowstone | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay | grep -v ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay | grep -v ERS_Ld211_D_P112x1.f10_f10.ICNCROP +RUN ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI.f10_f10.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI.f19_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.T31_g37.ICLM45.yellowstone_intel.clm-SNICARFRC.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.f19_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +RUN ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.GC.70Intel +-- ref1 and ref2 run, then no output in non-ref run +FAIL ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel.compare_hist.clm4_5_69 + 69 Comparing hist file with baseline hist file, /glade/scratch/muszala/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel/run/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay.GC.70Intel.cpl.hi.0001-01-12-00000 .nc /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_69/ERS_D.f10_f10.ICLM45VIC.yellowstone_intel.clm-vrtlay/cpl.hi.nc + 70 ncdump1 done + 71 ncdump2 done + 72 comparing split files x[a-z][a-z] + 73 xaa + 74 6979,6981c6979,6981 < 0.983149585541109, 0.972017300931466, 0.972017300784614, < 0.972017300929172, 0.964088275988772, 0.971373805810303, < 0.977583443108289, 0.983149585551217, 0.983149585568791, --- + 75 FAIL + 76 hist file comparison is FAIL +FAIL SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default.GC.70Intel.compare_hist.clm4_5_69 + 60 /glade/u/spooldir/1397689222.575650.shell: Storing new baseline in /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_70/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default + 61 Comparing hist file with baseline hist file, /glade/scratch/muszala/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default.GC.70Intel/run/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm- default.GC.70Intel.cpl.hi.0001-01-06-00000.n c /glade/p/cesmdata/cseg/ccsm_baselines/clm4_5_69/SMS.f19_g16.ICLM45VIC.yellowstone_intel.clm-default/cpl.hi.nc + 62 ncdump1 done + 63 ncdump2 done + 64 comparing split files x[a-z][a-z] + 65 xad + 66 18300c18300 < 0.983410370293909, 0.984052369383093, 0.979227772964994, --- > 0.983410370293909, 0.984052369383093, 0.979228345951215, 18341,18350c18341,18350 + 67 FAIL + 68 hist file comparison is FAIL + +2) Goldbach + NAG seems to have passed OK, _D runs have failed as expected. The reporting is messed up...ie., TestStatus.out look OK, but TestStatus does not. + +>> ./cs.status.70nag.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v _D +FAIL ERI.f10_f10.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag +--look at /scratch/cluster/muszala/tests/ERI.f10_f10.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag/TestStatus.out and there is no FAIL +FAIL ERI.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag +--/scratch/cluster/muszala/tests/ERI.f19_g16.ICLM45BGC.goldbach_nag.clm-reduceOutput.GC.70nag and there is no FAIL + +3) Goldbach + Intel - these look all like passes to me: see /scratch/cluster/muszala/tests/*/TestStatus.out + +>> ./cs.status.70intel.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp +FAIL ERI.f10_f10.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI.f19_g16.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.T31_g37.I1850CLM45.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f10_f10.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f19_g16.ICLM45BGC.goldbach_intel.clm-reduceOutput.GC.70intel +-- Shows FAIL but PASSes in TestStatus.out + +4) Goldbach + PGI - some are indicating FAIL with TestStatus.out shows PASSes, others are straight out FAILs + +./cs.status.70pgi.goldbach | grep -v CLM50 | grep -v PASS | grep -v tputcomp | grep -v SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_pgi +FAIL ERI.f10_f10.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI.f19_g16.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 22 g005.cgd.ucar.edu - daemon did not report back when launched + 23 g006.cgd.ucar.edu - daemon did not report back when launched + 24 g009.cgd.ucar.edu - daemon did not report back when launched + 25 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory +FAIL ERI_D.f10_f10.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- Shows FAIL but PASSes in TestStatus.out +FAIL ERI_D.f19_g16.ICLM45.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 1 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 2 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 3 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory + 4 -------------------------------------------------------------------------- + 5 A daemon (pid 29755) died unexpectedly with status 127 while attempting +FAIL ERI_D.f19_g16.ICLM45BGC.goldbach_pgi.clm-reduceOutput.GC.70pgi +-- ref1 fail: + 23 g021.cgd.ucar.edu - daemon did not report back when launched + 24 g022.cgd.ucar.edu - daemon did not report back when launched + 25 g023.cgd.ucar.edu - daemon did not report back when launched + 26 /usr/mpi/pgi/openmpi-1.4.3-qlc/bin/orted: error while loading shared libraries: libpgc.so: cannot open shared object file: No such file or directory +FAIL SMS_Ld5.f19_g16.IRCP45CLM45BGC.goldbach_pgi.clm-decStart.GC.70pgi +-- ERROR in /var/spool/torque/mom_priv/jobs/19500.goldbach.cgd.ucar.edu.SC: file /fs/cgd/csm/ccsm_baselines/clm4_5_69/SMS_Ld5.f19_g16.IRCP45CLM45BGC.goldbach_pgi.clm-decStart/cpl.hi.nc does not exist + +CLM tag used for the baseline comparisons: clm4_5_69 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_69 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Tue Mar 18 21:12:34 MDT 2014 +One-line Summary: start unit testing build-namelist + +Purpose of changes: start doing unit testing on construction of the clm namelist. +This involved moving the contents of build-namelist into CLMBuildNamelist.pm and +bringing in perl infrastructure to supplement Test::More. Initial test suites are +implented for several name list variables. + +Requirements for tag: N/A + +Test level of tag: regular, build_namelist + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, clm-cmt + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + + models/lnd/clm/bld: + CLMBuildNamelist.pm - contents of build-namelist + test_build_namelist/perl5lib/* - CPAN modules needed for unit testing + test_build_namelist/t/input/* - mock input files for build-namelist tests + test_build_namelist/t/template_test_XXX.pm - template for new tests + test_build_namelist/t/test_*.pm - unit tests + test_build_namelist/test_build_namelist.pl - unit test driver + test_build_namelist/README + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/bld: + build-namelist - moved contents into CLMBuildNamelist.pm, now just a driver calling main function. + + +CLM testing: + + build-namelist tests: + + yellowstone - OK new and existing generate tests + goldbach - OK new and existing generate tests + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + goldbach_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: N/A + + short tests (aux_clm_short): + + yellowstone_intel - OK + yellowstone_pgi - OK + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_68 + +Changes answers relative to baseline: No + + +=============================================================== +=============================================================== +Tag name: clm4_5_68 +Originator(s): erik (Erik) +Date: Fri Mar 7 16:43:23 MST 2014 +One-line Summary: Update scripts to version that turns on transient CO2 streams for + transient compsets, and update CISM (changes answers) + +Purpose of changes: + +Bring in the scripts version that by default had transient CO2 for any transient +compsets. You can still turn it off by setting DATM_CO2_TSERIES=FALSE in env_run.xml. +Also bring in the latest CISM version that has answer changes for any IG compsets. +It fixes fields sent from CISM to the coupler (fixes an exact restart problem). + +Requirements for tag: + update scripts and CISM, transient and IG compsets have different answers + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 979 (adding CO2 streams) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + scripts to scripts4_140305 + cism to cism1_140303 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: None + +CLM testing: + + build-namelist tests: + + yellowstone yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + goldbach_nag yes + goldbach_pgi yes + goldbach_intel yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel yes + yellowstone_pgi yes + + tools testing: None + +CLM tag used for the baseline comparisons: clm4_5_67 + +Changes answers relative to baseline: Yes! + + Summarize any changes to answers: + - what code configurations: transient and IG compsets + - what platforms/compilers: all + - nature of change: larger than roundoff + +=============================================================== +=============================================================== +Tag name: clm4_5_67 +Originator(s): mvertens +Date: Thu Mar 6 16:53:23 MST 2014 +One-line Summary: removed initSurfAlb as part of the initialization + +Purpose of changes: removed the call to initSurfAlb as well as part of + the initialization and also removed the routine from the clm4.5 + code base + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +M bld/namelist_files/namelist_defaults_clm4_5.xml + - clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c140111.nc had not + in fact been created - this effected the PEM test in the goldbach clm45 test suite + - the default namelist has not been backed up to the original + clmi.ICRUCLM45BGCCROPmp24.0241-01-01.10x15_USGS_simyr2000_c131028.nc + for now + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M src/clm4_5/biogeochem/ch4InitMod.F90 + - removal of code block that is no longer needed due to removal of initSurfAlb + (this had already been commented out in clm4_5_66) + +M src/clm4_5/main/initInterp.F90 + - minor bug fix the turn off spval by default for nonactive points + +D src/clm4_5/main/initSurfAlbMod.F90 +M src/clm4_5/main/clm_initializeMod.F90 + - removal of call initSurfAlb (main purpose of this tag) + - removal of code to upgrade old initial data files to have new metadata + a new scheme should be put in place with a namelist option to take clm4.5 + restart datasets that have been created prior to the introduction of initInterp + and introduce the new metadata at run time + +M src/clm4_5/main/initColdMod.F90 + - had to introduce setting values for the following variables in order to remove + call to initSurfAlb + cps%albgrd_pur(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_pur(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_bc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_bc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_oc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_oc(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgrd_dst(bounds%begc:bounds%endc,:) = 0.2_r8 + cps%albgri_dst(bounds%begc:bounds%endc,:) = 0.2_r8 + +M src/clm4_5/main/clm_driver.F90 + - just comments + +CLM testing: + + regular tests (aux_clm): OK means only failures were expected + + yellowstone_intel : OK + yellowstone_pgi : OK + goldbach_nag : OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi : OK + +CLM tag used for the baseline comparisons: clm4_5_66 + +Changes answers relative to baseline: some - for all compsets where + finidat is set to blank, then answers will change relative to baseline + + for all compsets wehre finidat is pointing to a dataset, answers will be bfb + compared to baseline + +=============================================================== +=============================================================== +Tag name: clm4_5_66 +Originator(s): mvertens +Date: Mon Mar 3 10:50:24 MST 2014 +One-line Summary: refactoring of initialization and introduction of run-time finidat interpolation + +Purpose of changes: refactoring of initialization and introduction of run-time finidat interpolation + +Completely rewrote clm_initialize to leverage new initialization scheme +In the new scheme, cold start initialization is ALWAYS called and values +are overwritten by either an appropriate finidat file OR by calling +finidat_interp to interplate finidat to the output resolution/mask. + +Requirements for tag: + +Test level of tag: regular, short, tools, build_namelist, doc + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + + 1930 (MEGAN does not work correctly with prognostic crops on) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + NONE + +Describe any changes made to the namelist: + + - ALL clm4.5 finidat files have been updated to contain new metadata that will enable the + online interpinic to operate on them. The time stamp on all new files has the date c140111. + The files have been created so that they are bit-for-bit compatible with the code base. + - The following new namelist variables have been added to the namelist_definition_clm4_5.xml file + - finidat_interp_source + if non-blank, then interpinic will be called to interpolate finidat_interp_source and + create output file specified by finidat_interp_dest. + - finidat_interp_dest + if finidat_interp_source is set to non-blank, then interpinic will be called + to interpolate finidat_interp_source and create output file finidat_interp_dest + +List any changes to the defaults for the boundary datasets: + + None + +Describe any substantial timing or memory changes: + + None + +Code reviewed by: + + mvertens, sacks + +List any svn externals directories updated (csm_share, mct, etc.): + + None + +List all files eliminated: + + The following file pairs were renamed and subsequently extensively modfified + Summaries of the modifications are below: + + ------- New module initColdMod.F90 contains calls to initialize the cold start for + ------- the entire model. The cold start values are then overwritten with either + ------- an finidat file or an interpolation file using finidat_interp_source. +D models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +A models/lnd/clm/src/clm4_5/main/initColdMod.F90 + + ------- Renamed file +D models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/SatellitePhenologyMod.F90 + + ------- Renamed file +D models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/CNDVInitMod.F90 + + ------- Renamed file, removed initch4, merged routines initTimeConst_ch4 and makearbinit_ch4 + --------into new routine initColdCH4.Also removed almost all associate statements + ------- (but kept the intput/output documentation) and used the explicit clmtype definition. +D models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +A models/lnd/clm/src/clm4_5/biogeochem/ch4InitMod.F90 + + ------- Renamed and combined files + ------- Migrated all CN cold start initialization for both soil and + ------- special landuntis into new routine initColdCN in new module biogeochem/CNInitMod. +D models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +D models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +A models/lnd/clm/src/clm4_5/biogeochem/CNInitMod.F90 + + ------- Renamed file and merged routines makearbinit and snow_depth2Lake + ------- into one new routine initColdSlake. Also removed almost all associate + ------- statements (but kept the intput/output documentation) and used the explict + ------- clmtype definition. +A models/lnd/clm/src/clm4_5/biogeophys/SLakeInitMod.F90 +D models/lnd/clm/src/clm4_5/biogeophys/initSlakeMod.F90 + + ------- Renamed iniTimeConst, removed associate statements but kept + ------- the documentation of input/output and also explictly listed + ------- full clmtype variables +D models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +A models/lnd/clm/src/clm4_5/main/initTimeConstMod.F90 + +List all files added and what they do: + + ------- New run-time interpolation of input finidat to target resolution/mask + ------- using the new namelist variables finidat_interp_source and finidat_interp_dest +A models/lnd/clm/src/clm4_5/main/initInterp.F90 + + ------- Obtain/write global index space value for target point at given clmlevel +A models/lnd/clm/src/util_share/GetGlobalValuesMod.F90 + +List all existing files that have been modified, and describe the changes: + + ------- In all files, unless otherwise noted added call to errMsg(__FILE__,__LINE__) + ------- and in some cases optional arguments of decomp_index and clmlevel also added + + ------- See documentation for namelist changes above +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + + ------ Overloaded endrun subroutine to also print out global index infromation by + ------ calling new GetGlobalWrite routine if optional arguments decomp_index and + ------ clm_level are passed in +M models/lnd/clm/src/util_share/abortutils.F90 + + ------- Replaced missing value setting of huge(1) with ispval +M models/lnd/clm/src/util_share/accumulMod.F90 + + ------- Replaced endrun with call to shr_sys_abort +M models/lnd/clm/src/util_share/domainMod.F90 + + ------- Added in missing values and special values for variable metadata - this + ------- is needed needed by initInterp +M models/lnd/clm/src/util_share/restUtilMod.F90 +M models/lnd/clm/src/util_share/restUtilMod.F90.in + + ------- Completely rewrote clm_initialize to leverage new initialization scheme + ------- In the new scheme, cold start initialization is ALWAYS called and values + ------- are overwritten by either an appropriate finidat file OR by calling + ------- finidat_interp to interplate finidat to the output resolution/mask. +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + + ------- Added new metadata and variables - include global indices for parent subgrid + ------- level(s) (i.e. column, landunit and gridcell for pfts) +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + + ------- Moved view_factor routine and associated variable from a separate routine + ------- in UrbanMod to part of the initTimeConstUrban subroutine in UrbanInitMod +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + + ------- Removed vf_xx variables from restart file and also + ------- removed do_initsurfalb variable +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + + ------- In all files, unless otherwise noted added call to errMsg(__FILE__,__LINE__) + ------- and in some cases optional arguments of decomp_index and clmlevel also added +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/ndepStreamMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in + +CLM testing: + + regular tests (aux_clm): + + NOTE1: that all namelists compares where finidat was not blank will fail - since + new finidat files are used that have new metadata - BUT - the results are still bfb + + yellowstone_intel - OK + expected failures: + ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + + yellowstone_pgi - OK + expected failures: + ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + goldbach_nag - OK + + goldbach_intel - OK + + goldbach_pgi - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + NOTE1: all .h1 tests fail since there are new meta data fields for + cols1d_active, pfts1d_active - and FILLDIFF is different + + yellowstone_intel OK + yellowstone_pgi OK + +CLM tag used for the baseline comparisons: clm4_5_65 + +Changes answers relative to baseline: No - bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_65 +Originator(s): mvertens (Mariana Vertenstein,UCAR/CSEG,303-497-1349) +Date: Tue Feb 25 13:45:38 MST 2014 +One-line Summary: Turn off MEGAN vocs when crops is running + +Purpose of changes: + +MEGAN does not currently work with prognostic crops. It needs a table of pft-specific values, and that this table has only been created for the 16 "standard" (non-crop) pfts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1930 (MEGAN does not work correctly with prognostic crops on) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.):s + +scripts4_140214a -> scripts4_140220 +Machines_140214 -> Machines_140218 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +======== + Add a new logical variable - use_voc - that is true by default but + is set to false if prognostic cop is activated +======== + +M src/clm4_5/main/clm_initializeMod.F90 +M src/clm4_5/main/clm_atmlnd.F90 +M src/clm4_5/main/controlMod.F90 +M src/clm4_5/main/clm_varctl.F90 +M src/clm4_5/main/clm_driver.F90 +M src/clm4_5/main/histFldsMod.F90 +M src/clm4_0/main/clm_varctl.F90 +M src/cpl/clm_cpl_indices.F90 + + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + expected failures + ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + expected non-bfb failures due to VIC/CROP changes + ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default + ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel + SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel + + yellowstone_pgi - OK + expected failures + ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + goldbach_nag - OK + expected non-bfb failures due to VIC/CROP changes + ERS_D.f10_f10.ICLM45BGCCROP.goldbach_nag.clm-allActive + ERS_Lm3.1x1_numaIA.ICLM45BGCCROP.goldbach_nag + + goldbach_intel - OK + expected non-bfb failures due to VIC/CROP changes + ERS_Ly20.1x1_numaIA.ICLM45BGCDVCROP.goldbach_intel.clm-crop + PEM.f10_f10.ICLM45BGCCROP.goldbach_intel.clm-crop + + goldbach_pgi - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK - + yellowstone_pgi - OK + +CLM tag used for the baseline comparisons: clm4_5_64 + +Changes answers relative to baseline: No - except for VOC fields when + prognostic crop is on (this is a diagnostic only and does not impact + the answers) + +=============================================================== +=============================================================== +Tag name: clm4_5_64 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Wed Feb 19 09:19:40 MST 2014 +One-line Summary: fix and clean ncdio_pio.F90.in. clean clm_time_manager. update externals. + +Purpose of changes: + +Note 1: This is the last tag that is tested on frankfurt; new tests are on goldbach. + +Note 2: Pts. mode is being deprecated for science use as of this tag. Use PTCLM. Pts. mode + remains in place in our test system. + +Note 3: There is an unresolved problem with higher resolutions when dov2xy is .false. and we are + using pnetcdf. Please see bug 1730. + +ncdio_pio.F90.in - fix initialization problem where count and start are sometimes used without + being set. +clm_time_manager - clean out unused variables +update externals to support ED compsets, move pts. mode tests to testmods. Update Machines and + pio to address bug 1730. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.):s + +scripts4_140209 -> scripts4_140214a +Machines_140213 -> Machines_140214 +pio1_8_8 -> pio1_8_9 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.I.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS.f45_f45.I.yellowstone_intel.clm-ptsROA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.yellowstone_intel.clm-ptsRLA.GC.64Intel.compare_hist.clm4_5_63 + Expected due to change in pio_buffer_size_limit + FAIL ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.64Intel.nlcomp + FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.64Intel.nlcomp + New Failure for VIC but due to dov2xy problem + ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay + + yellowstone_pgi - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.I.yellowstone_pgi.clm-ptsRLB.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLA.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.yellowstone_pgi.clm-ptsRLA.GC.64Pgi.compare_hist.clm4_5_63 + Expected due to change in pio_buffer_size_limit + FAIL ERI.f09_g16.I1850CRUCLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERI.f09_g16.ICLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERS_D.hcru_hcru.ICRUCLM45BGC.yellowstone_pgi.GC.64Pgi.nlcomp + FAIL ERS_D.hcru_hcru.ICRUCN.yellowstone_pgi.GC.64Pgi.nlcomp + New Failure for VIC but due to dov2xy problem + ERS.f09_g16.ICLM45VIC.yellowstone_pgi.clm-vrtlay + + frankfurt_nag - OK + Expected due to change in pts. mode: + BFAIL SMS_D_Mmpi-serial.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + BFAIL SMS_Mmpi-serial.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + BFAIL SMS_Mmpich.f45_f45.ICLM45.frankfurt_nag.clm-ptsRLA.GC.64Nag.compare_hist.clm4_5_63 + + frankfurt_intel - OK + + frankfurt_pgi - OK + Expected due to change in pts. mode: + BFAIL SMS.f45_f45.ICLM45.frankfurt_pgi.clm-ptsRLB.GC.64Pgi.compare_hist.clm4_5_63 + BFAIL SMS.f45_f45.ICLM45.frankfurt_pgi.clm-ptsROA.GC.64Pgi.compare_hist.clm4_5_63 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_63 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_63 +Originator(s): sacks (sacks) +Date: Fri Feb 14 07:22:37 MST 2014 +One-line Summary: add some code needed for dynamic landunits; activate 0-weight veg landunit sometimes + +Purpose of changes: + +(1) Add grc%landunit_indices(:,:), so you can find a given l index if you have + the g index (this will be needed in a few places for dynamic landunits) + +(2) Add code to update landunit weights; currently has no effect because + landunit areas don't change yet + +(3) Refactor logic in the is_active_X routines, and add logic to activate a + virtual vegetated landunit under some conditions (needed for coupling with + CISM, and helpful for dynamic landunits). Specifically, we activate a + virtual (0-weight) vegetated landunit for any grid cell that is NOT 100% + istice (i.e., standard glacier) (we exclude grid cells that are 100% istice + to avoid the performance penalty, because these aren't used for coupling + with CISM, and the only way this glacier can retreat is if another landunit, + like crop, increases there, which will rarely happen). + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Performance about 6% worse for clm4.5 IG runs at f09 (i.e., with glcmec), + because of the new virtual vegetated columns. Not investigated for f19 or + T31, but probably a similar performance hit. + + There were also a few memcomp failures + +Code reviewed by: quick review by mvertens + +List any svn externals directories updated (csm_share, mct, etc.): + + Machines: Machines_140207a -> Machines_140213 (to fix pgi on yellowstone) + +List all files eliminated: + +========= Remove "IN_PROGRESS" +D models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90.IN_PROGRESS + +List all files added and what they do: + +========= Add code to update landunit weights; currently has no effect because + landunit areas don't change yet +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90 + +========= Add unit tests for dynLandunitAreaMod +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynLandunitArea_test/test_update_landunit_weights.pf + +List all existing files that have been modified, and describe the changes: + +========= Add grc%landunit_indices(:,:), so you can find a given l index if you + have the g index (this will be needed in a few places for dynamic + landunits) +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + - just add a comment +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Call new code in dynLandunitAreaMod +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 + +========= Refactor logic in the is_active_X routines, and add logic to activate + a virtual vegetated landunit under some conditions (needed for + coupling with CISM, and helpful for dynamic landunits) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Add unit tests for dynLandunitAreaMod +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + + +CLM testing: + + regular tests (aux_clm): + + NOTE: frankfurt intel & pgi ran on a slightly older version of the branch + (dynlu_weight_updates_glacier_n05_clm4_5_62, which did not include some + final minor refactoring to reweightMod); frankfurt nag & yellowstone + intel/pgi ran on the final version + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + + A bunch of expected failures in h1 (1-d) hist files, due to the newly-active + points. + + + Also: Did a manual test to show that answers are the same for virtual + vegetated columns as they would be if the column had non-zero weight (to + ensure there are no dependencies on whether a column's weight is non-zero). + +CLM tag used for the baseline comparisons: clm4_5_62 for yellowstone (but +clm4_5_61 for component_gen_comp); clm4_5_61 for frankfurt + +Changes answers relative to baseline: NO + + However, note diffs in 1-d hist files due to newly-active points. + +=============================================================== +=============================================================== +Tag name: clm4_5_62 +Originator(s): erik (Erik) +Date: Mon Feb 10 04:16:07 MST 2014 +One-line Summary: Get PTCLM working robustly, US-UMB test working, add CO2 streams to datm, add more + consistency testing between compsets and user settings + +Purpose of changes: + +US-UMB fix in scripts and datm update. Fix so build-namelist will abort if there is an inconsistency with CLM_BLDNML_OPTS +and user_nl_clm. Add CO2 streams as a built-in option to datm. Turn CO2 streams on with the DATM_CO2_TSERIES env_run.xml +variable. Can be set to: none,20tr,rcp2.6,rcp4.5,rcp6.0,rcp8.5, by default is none. + +Requirements for tag: + + datm -- CO2 update, streams improvements + Fix build-namelist consistency issues + Fix bug 1847 -- end1d in hist for clm4_0 + Add envxml_dir + check that cndv and fpftdyn aren't on the same time + Add PTCLM tests to test_Driver + Add PTCLM test system in + Make PTCLM more robust + +Test level of tag: regular, tools, build_namelist + +Bugs fixed (include bugzilla ID): + 1918 -- sort options in build-namelist + 1917 -- remove WRF resolutions + 1903 -- buildtools fails for PTCLM + 1900 -- Remove BUILDHEAT and Qanth from output for CLM testing + 1896 -- CLM build-namelist should abort if use_cndv AND fpftdyn are set. + 1881 -- Add envxml_casedir option to CLM build-namelist + 1879 -- need error triggered when use_crop and CLM_BLDNL_OPTS are not consistent + 1847 -- 'histfilemod_mp_hist_restart_ncd_$END1D' is being used without being defined + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: frankfurt switched out for goldbach + +Describe any changes made to the namelist: CLM build-namelist changed to ensure user changes don't conflict with + command-line options + +List any changes to the defaults for the boundary datasets: remove WRF datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts to scripts4_140209 + Machines to Machines_140207a + datm to datm8_140114 + pio to pio1_8_8 + cprnc to cprnc_140203 + + PTCLM to PTCLM2_140204 + +List all files eliminated: move frankfurt to goldbach + +D models/lnd/clm/test/tools/tests_posttag_frankfurt_nompi + +List all files added and what they do: goldbach, and add PTCLM tools testing + +A + models/lnd/clm/test/tools/tests_posttag_goldbach_nompi +A models/lnd/clm/test/tools/TCBscripttools.sh ------------ Add script to run buildtools for PTCLM +A models/lnd/clm/test/tools/config_files/PTCLM__s -------- Config for PTCLM +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_clm4_0 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_clm4_5 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_Cycle_clm4_5 +A models/lnd/clm/test/tools/nl_files/PTCLM_USUMB_Global_clm4_5 +A models/lnd/clm/bld/unit_testers/myuser_nl_clm --- New build-namelist tests +A models/lnd/clm/bld/unit_testers/env_run.xm + + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist ----- Sort options, add -envxml_dir option, check that user hasn't contradicted themself + with CLM_BLDNML_OPTS and user_nl_clm, remove options: -noio, -nofire, -snicar_frc, -vsoilc, -exlaklayers, -clm4me + use Cwd::abs_path and remove home-grown absolute_path, add some more docmentation and comments, redo some ordering and names + M models/lnd/clm/bld/clm.buildnml.csh --- add -envxml_dir so will use env_*.xml files to expand env variables + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml --- Add irrig setting, remove WRF files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Add irrig, bgc_spinup, and bgc_mode + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml -- Remove WRF resolutions: us20, wus12 + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml - Remove WRF resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Remove WRF resolutions, add bgc_mode + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ----------- Add a bunch of new tests + M models/lnd/clm/bld/user_nl_clm ----- make note of variables that should be done by command-line build-namelist options + + M models/lnd/clm/src/clm4_0/main/histFileMod.F90 --- Fix bug 1847 + +------------ Add PTCLM testing + M models/lnd/clm/test/tools/README.testnames + M models/lnd/clm/test/tools/test_driver.sh ------ Remove bluefire, lynx, mirage, jaguarpf -- switch frankfurt for goldbach + M models/lnd/clm/test/tools/TBLscript_tools.sh + M models/lnd/clm/test/tools/TSMscript_tools.sh + M models/lnd/clm/test/tools/input_tests_master + M models/lnd/clm/test/tools/tests_posttag_nompi_regression + M models/lnd/clm/test/tools/tests_posttag_yong + M models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi + +------------ Don't die if debug and files were not created. + M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +CLM testing: regular, build-namelist, tools + + build-namelist tests: + + yellowstone + + regular tests (aux_clm): + + yellowstone_intel + yellowstone_pgi + goldbach_nag + edison_intel + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel + yellowstone_pgi + + tools testing: + + yellowstone interactive + goldbach interactive + +CLM tag used for the baseline comparisons: clm4_5_61 + +Changes answers relative to baseline: None, bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_61 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Feb 4 09:45:43 MST 2014 +One-line Summary: add 3-d snow history fields; continue harvest past end of pftdyn timeseries + +Purpose of changes: + + There are two separate sets of changes in this tag; both apply just to CLM4.5: + + (1) Addition of 3-d snow history fields: These history fields (inactive by + default) provide diagnostics for each layer of the snow pack. This + involved adding some additional history file infrastructure to handle + the variable number of snow pack layers. See the new section in the + user's guide (custom.xml) for a description of how these new history + fields work, and how to interpret them. + + (2) Change the harvest logic for transient runs that extend past the end of + the pftdyn dataset: Until now, harvest was set to 0 when you passed the + end of the pftdyn dataset. With this tag, this behavior is changed, so + that for all years past the end of the pftdyn dataset, harvest rates + remain fixed at the last year's value. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Memory use increases slightly, as observed by memcomp failures for a few + tests. This is presumably due to new fields in clmtype. + +Code reviewed by: Erik reviewed changes for the 3-d snow history fields. + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Add 3-d snow history fields +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/doc/UsersGuide/custom.xml + +========= Add a new snow diagnostic, sub_surf_abs_SW +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 + +========= Continue harvest past end of pftdyn time series +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + + Only failures are these expected failures (see notes on answer changes + below): + + FAIL SMS_Ly3.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetLate.compare_hist.clm4_5_60.clm2.h0 + FAIL SMS_Ly5.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetMid.compare_hist.clm4_5_60.clm2.h0 + FAIL SMS_Ly8.1x1_tropicAtl.I20TRCLM45BGC.yellowstone_intel.clm-tropicAtl_subsetEarly.compare_hist.clm4_5_60.clm2.h0 + +CLM tag used for the baseline comparisons: clm4_5_60 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 transient runs that continue past the end of the pftdyn dataset + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate: Harvest rates are now continued past the end of the pftdyn + dataset (staying fixed at their value from the last year), for the + remainder of the simulation. This leads to potentially large answer + changes for transient runs that continue past the end of the pftdyn + dataset. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_60 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Thu Jan 30 18:27:03 MST 2014 +One-line Summary: refactor build-namelist + +Purpose of changes: : break build-namelist into small unit-testable functions + instead of a single massive script. Use output functions to standardize + screen output for errors, warnings and messages so that results can be + automatically searched by scripts. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Erik + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist - major refactor described above + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - fix incorrect comments + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - minor updates to check new output style + +CLM testing: + + build-namelist tests: + + yellowstone - pass compare and generate with only xfails + frankfurt - not tested, CLM-CMT believes tests may be broken. + + regular tests (aux_clm): + + yellowstone_intel - ok + yellowstone_pgi - ok + frankfurt_intel - ok + frankfurt_pgi - ok + frankfurt_nag - ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - ok + yellowstone_pgi - ok + + short tests (aux_clm_short): + + yellowstone_intel - ok + + tools testing: N/A + +CLM tag used for the baseline comparisons: clm4_5_59 + +Changes answers relative to baseline: none, bit for bit + + +=============================================================== +=============================================================== +Tag name: clm4_5_59 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Jan 22 15:04:12 MST 2014 +One-line Summary: use new get_curr_yearfrac function in clm_time_manager + +Purpose of changes: + + Use the new get_curr_yearfrac function in clm_time_manager in place of + dyn_time_weights. The reason is that, as Erik pointed out, dyn_time_weights + was out of place in dynUtilsMod, and really this functionality belongs in the + clm_time_manager module. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Made obsolete by get_curr_yearfrac in clm_time_manager +D models/lnd/clm/src/clm4_5/dyn_subgrid/dynUtilsMod.F90 +D models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynUtilsMod_mock.F90 + +List all files added and what they do: + +========= Mock out get_curr_yearfrac: return a fixed fraction +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/clm_time_manager_mock.F90 + +List all existing files that have been modified, and describe the changes: + +========= Fix get_curr_yearfrac to be real rather than integer +M models/lnd/clm/src/util_share/clm_time_manager.F90 + +========= Use get_curr_yearfrac instead of dyn_time_weights +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +M models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in + +========= Update unit tests to pull in clm_time_manager (mock) rather than dynUtilsMod (mock) +M models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +M models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_58 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45, either transient or with DV + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Ran testing on an intermediate tag, where I computed the time weights in + both the old and new ways. I confirmed that the difference in time weights + (which is the only change in this tag) is always less than 1e-13. Actually, + this difference is always less than 2e-16, double-precision roundoff. + + Also examined cpl hist diffs for a few select tests. Diffs are generally + ~ 1e-6 after 5 days. + +=============================================================== +=============================================================== +Tag name: clm4_5_58 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Jan 22 14:11:30 MST 2014 +One-line Summary: major refactor of transient pft code, in prep for dynamic landunits + +Purpose of changes: + +Major refactor of transient pft code, in prep for dynamic landunits. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1899 (harvest rates remain non-zero even after the end of the pftdyn dataset) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Erik; design reviewed by CLM-CMT + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_140102 -> scripts4_140114 + Machines: Machines_131206b -> Machines_140107 + csm_share: share3_131226 -> share3_131231 + pio: pio1_8_3 -> pio1_8_6 + + CMake: New external added + +List all files eliminated: + +========= renamed to dynConsBiogeophysMod.F90 +D models/lnd/clm/src/clm4_5/main/dynlandMod.F90 + +========= renamed to dynpftFileMod.F90; much of the stuff in here moved to other + files in the dyn_subgrid directory +D models/lnd/clm/src/clm4_5/main/pftdynMod.F90 + +========= renamed +D models/lnd/clm/test/unit + +List all files added and what they do: + +========= Rename test/unit to test/unit_testers, and add unit tests for some of + the stuff in dyn_subgrid. This also involved adding some mocks - + particularly of ncdio_pio. +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/test_daylength.pf +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys/Daylength_test +A models/lnd/clm/test/unit_testers/clm4_5/biogeophys +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarShared.F90 +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeInterp.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/test_dynVarTimeUninterp.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynVar_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/test_dynTimeInfo.pf +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/dynTimeInfo_test +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/dyn_subgrid +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_var.F90.in +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/spmdMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/do_genf90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share/ncdio_pio_mock.F90.in +A models/lnd/clm/test/unit_testers/clm4_5/mock/util_share +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/shr_sys_mod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/csm_share +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/decompMod_boundsTypeDecl.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/main/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/main +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynFileMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/dynUtilsMod_mock.F90 +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock/dyn_subgrid +A models/lnd/clm/test/unit_testers/clm4_5/mock/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/mock +A models/lnd/clm/test/unit_testers/clm4_5/CMakeLists.txt +A models/lnd/clm/test/unit_testers/clm4_5/README +A models/lnd/clm/test/unit_testers/clm4_5 +A models/lnd/clm/test/unit_testers + +========= Make a new directory to hold all of the stuff related to dynamic + subgrid weights. Currently this means transient PFTs, but soon it will + also mean dynamic landunits. This includes stuff that used to be in + pftdynMod and dynlandMod, as well as a bit from clm_driver. I have + added a new driver for the dyn_subgrid stuff (dynSubgridDriverMod), + and pulled out much of the shared, lower-level functionality into new + modules (dynTimeInfoMod, dynFileMod, dynVarMod, dynVarTimeInterpMod, + dynVarTimeUninterpMod, dynUtilsMod [which will soon go away]). In + addition, I have separated the many routines in pftdynMod into + separate modules, each with a single, better-defined function. +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynTimeInfoMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynSubgridDriverMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynHarvestMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynFileMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeochemMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynPriorWeightsMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynpftFileMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynCNDVMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynConsBiogeophysMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeInterpMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynLandunitAreaMod.F90.IN_PROGRESS +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynUtilsMod.F90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/dynVarTimeUninterpMod.F90.in +A models/lnd/clm/src/clm4_5/dyn_subgrid/CMakeLists.txt +A models/lnd/clm/src/clm4_5/dyn_subgrid + +========= script to generate files from their .in files using genf90 +A models/lnd/clm/src/clm4_5/dyn_subgrid/do_genf90 + + +========= move check_sums_equal_1 to a new module, partly to reduce dependencies + of unit tests, and partly because it is cleaner design to have it + outside of surfrdMod +A models/lnd/clm/src/clm4_5/main/surfrdUtilsMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Add dyn_subgrid directory +M models/lnd/clm/bld/configure + +========= Add get_curr_yearfrac function (currently broken, will be fixed in + next tag) +M models/lnd/clm/src/util_share/clm_time_manager.F90 + +========= Change type(file_desc_t) to class(file_desc_t); add 'only' clause to + use statements to allow compilation with pgi +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90.in + +========= Change 'use statement' for reworked dyn_subgrid code +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 + +========= Move surfrd_check_urban and surfrd_check_sums_equal_1 to more + appropriate places +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 + +========= Move some code into dynSubgridDriverMod +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also remove incorrect header comment + +========= Add compute_higher_order_weights routine +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Add unit testing support +M models/lnd/clm/src/clm4_5/main/CMakeLists.txt + + +========= Frankfurt-PGI tests now pass! +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: ok + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_57 + +Changes answers relative to baseline: YES (very limited; see below) + + Can change answers due to the following: + + (1) Changes answers for harvest when a run starts inside the pftdyn timeseries + but extends beyond it, without an intervening restart (see bug 1899) + + (2) Could theoretically change answers for yellowstone-pgi or hopper-pgi due + to machines updates, but no changes showed up in the yellowstone test suite + +=============================================================== +=============================================================== +Tag name: clm4_5_57 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Jan 7 14:17:04 MST 2014 +One-line Summary: change CNDV water conservation to use the pftdyn method + +Purpose of changes: + + For my dynamic landunit work, I was trying to reconcile what's going on with + prescribed transient PFTs (pftdyn) vs CNDV. The reason is that I'm trying to + set up an overall control flow for dynamic landunits, and you need to be able + to run either of these in conjunction with dynamic landunits. + + In doing this, I noticed that water conservation is handled differently for + pftdyn vs CNDV: + + For pftdyn, water conservation is done as described in section 21.2 of the + CLM4.5 tech note: water contents are summed before and after transition, and + the difference is put in the runoff term + + CNDV appears not to use this before & after difference. Instead, it does a + correction for canopy water in pftdynMod: pftdyn_wbal. + + For dynamic landunits, we're planning to use an approach like what is + currently done for pftdyn. I think it's going to be messy and confusing to + try to maintain the current CNDV approach when it's possible to have CNDV in + conjunction with dynamic landunits. + + Thus, I am changing CNDV to use the pftdyn approach to water conservation, + whether or not you are running with dynamic landunits. This will change + answers for CNDV/BGCDV cases in CLM4.5, though I expect the effects to be + small. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik; concept approved by Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Main changes are here; also minor (somewhat related) cleanup: fix some + section heading comments, add a timer (ndep_interp) - pulling out some + stuff that used to be (inappropriately) in the pftdynwts timer section +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Remove a bunch of now-unneeded code, especially from pftdynMod +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 + + +CLM testing: + + NOTE: Most testing was done from tag cndv_water_conservation_n01_clm4_5_55 - + up-to-date with clm4_5_55, NOT clm4_5_56. I then updated to clm4_5_56 and + reran just the three tests that were run for that tag (see its ChangeLog + entry, below), with comparison to clm4_5_56. + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_55 for most tests, clm4_5_56 +for three tests (see above note) + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with DV (CNDV / BGCDV) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated, but expected to be larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_56 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Thu Jan 2 09:06:32 MST 2014 +One-line Summary: update scripts external to fix I20TRCLM45BGC compset + +Purpose of changes: update scripts external to fix I20TRCLM45BGC compset + +Requirements for tag: fix bug 1869 + +Test level of tag: limited (see below) + +Bugs fixed (include bugzilla ID): 1869 (I20TRCLM45BGC compset improperly defined) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_131203 -> scripts4_140102 + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: none + +CLM testing: + + ONLY TESTED THE 3 AFFECTED TESTS from the yellowstone & frankfurt aux_clm test suites: + + PASS PET_P15x2_Lm13.f10_f10.I20TRCLM45BGC.yellowstone_pgi.clm-reduceOutput.GC.140102-060037 + PASS ERS_D.f10_f10.I20TRCLM45BGC.frankfurt_pgi.clm-decStart.GC.140102-060448 + PASS ERS_Mmpich.f10_f10.I20TRCLM45BGC.frankfurt_nag.clm-decStart.GC.140102-060608 + +CLM tag used for the baseline comparisons: clm4_5_55 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Only I20TRCLM45BGC compsets + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + New climate for this compset: correctly uses CLM4.5 instead of CLM4.0 code. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_55 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Dec 27 16:21:45 MST 2013 +One-line Summary: add hooks to Sean Santos's unit test framework, and begin to add CLM unit tests + +Purpose of changes: + + (1) add hooks to Sean Santos's unit test framework + + (2) begin to add CLM unit tests + + Note: this tag currently does NOT have the CMake utilities that are needed to + run the unit tests. Instead, the instructions show how to point to a version + of these in my directory. That's because, as of the time I submitted this tag + for testing, the necessary working version of the CMake utilities was not yet + tagged. In the near future, another external could be added to pull in these + CMake utilities in the CLM directory tree. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, santos + +List any svn externals directories updated (csm_share, mct, etc.): + + tools/unit_testing: added external + models/csm_share: share3_131101 -> share3_131226 (to get changes needed for building unit tests) + +List all files eliminated: None + +List all files added and what they do: + +========= Set up unit test directories & CMakeLists.txt files, and add unit + tests for DaylengthMod. Note that the tests themselves are in + Daylength_test/test_daylength.pf. See the README file for how to run + the tests +A models/lnd/clm/test/unit +A models/lnd/clm/test/unit/clm4_5 +A models/lnd/clm/test/unit/clm4_5/README +A models/lnd/clm/test/unit/clm4_5/CMakeLists.txt +A models/lnd/clm/test/unit/clm4_5/mock +A models/lnd/clm/test/unit/clm4_5/mock/decompMod_boundsTypeDecl.F90 +A models/lnd/clm/test/unit/clm4_5/mock/CMakeLists.txt +A models/lnd/clm/test/unit/clm4_5/Daylength_test +A models/lnd/clm/test/unit/clm4_5/Daylength_test/test_daylength.pf +A models/lnd/clm/test/unit/clm4_5/Daylength_test/CMakeLists.txt + +========= Add CMakeLists.txt files that are needed to build unit tests +A models/lnd/clm/src/clm4_5/main/CMakeLists.txt +A models/lnd/clm/src/clm4_5/biogeophys/CMakeLists.txt + +List all existing files that have been modified, and describe the changes: + +========= Remove unneeded 'use' statement, to prevent pulling in more than is + necessary for the unit test build +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Externals updated - see above +M SVN_EXTERNAL_DIRECTORIES + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + Also ran the new unit tests, as per the instructions in + models/lnd/clm/test/unit/clm4_5/README - all PASS + +CLM tag used for the baseline comparisons: clm4_5_54 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_54 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Dec 27 15:55:05 MST 2013 +One-line Summary: update externals to cesm1_3_beta06 + +Purpose of changes: + + Update externals to cesm1_3_beta06 versions. + + However, do NOT update RTM, because the latest version of RTM results in + failures for ERI _N2 tests. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): none + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: not investigated + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Index: SVN_EXTERNAL_DIRECTORIES + =================================================================== + --- SVN_EXTERNAL_DIRECTORIES (.../trunk_tags/clm4_5_53) (revision 56268) + +++ SVN_EXTERNAL_DIRECTORIES (.../branch_tags/clm_update_externals_cesm1_3_beta06_tags/clm_update_externals_cesm1_3_beta06_n02_clm4_5_53) (revision 56268) + @@ -1,25 +1,25 @@ + # CESM scripts, machines and driver + -scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131126a + -scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130930b + -models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_02 + +scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131203 + +scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_131206b + +models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq5_0_07 + + # Model components: Data atmosphere, and stub components as well as land-ice model + -models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_131116 + -models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/socn + -models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/sice + -models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/sglc + -models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_03/swav + -models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 + -models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130924 + +models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_131201 + +models/ocn/socn https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/socn + +models/ice/sice https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sice + +models/glc/sglc https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/sglc + +models/wav/swav https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_04/swav + +models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_34 + +models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_131008 + + # Utilities: csm_share, esmf, timing, MCT, PIO + -models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130918 + +models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_131101 + models/utils/esmf_wrf_timemgr https://svn-ccsm-models.cgd.ucar.edu/esmf_wrf_timemgr/trunk_tags/esmf_wrf_timemgr_130213 + -models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130506 + +models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_131108 + models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n03_MCT_2.8.3 + -models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_7_2/pio + +models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_8_3/pio + + # Mapping tools: + -tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130529 + +tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_131120 + tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130716 + models/lnd/clm/tools/shared/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130716/gen_domain_files + + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= NCK tests no longer fail; change fail type of + ERS_D.f19_g16.IGRCP26CN.frankfurt_pgi from CFAIL to RUN +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: generate only (no baselines from clm4_5_53) + +CLM tag used for the baseline comparisons: clm4_5_53 + +Changes answers relative to baseline: YES, but only for multi-instance + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Multi-instance + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated, but suspected to be new climate + + Note that NCK tests newly pass (they had been failing), so this answer change + for multi-instance tests is expected. + + These answer changes show up in the following tests: + + FAIL CME_N2.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-default.GC.131227-063851.compare_hist.clm4_5_53 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.GC.131227-063851.compare_hist.clm4_5_53 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.GC.131227-063851.compare_hist.clm4_5_53 + + FAIL CME_N2.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_53.clm2.h0 + FAIL ERI_N2.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_53.clm2.h0 + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_53 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Dec 19 07:59:56 MST 2013 +One-line Summary: refactor restart interfaces + +Purpose of changes: Refactor restart interfaces. Most work done by mvertens. + +1) Add two *.F90.in files that use genf90.pl go generate source. This saves time + in dev. and maintenence. If you modify only the *.F90 file, your changes will + be lost. Instead modify the *F90.in file, then run genf90.pl on that file. + If you have questions, ask a clm developer for help. +2) Restart capability has now been encapsulated in a subroutine call that uses + Fortran 2003 interfaces over type and dimension. For example: + +- if (flag == 'define') then +- call ncd_defvar(ncid=ncid, varname='grainc_storage_to_xfer', xtype=ncd_double, & +- dim1name='pft',long_name='grain C shift storage to transfer',units='gC/m2/s') +- else if (flag == 'read' .or. flag == 'write') then +- call ncd_io(varname='grainc_storage_to_xfer', data=pcf%grainc_storage_to_xfer, & +- dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) +- if (flag=='read' .and. .not. readvar) then +- if (is_restart()) call endrun +- end if +- end if ++ call restartvar(ncid=ncid, flag=flag, varname='grainc_storage_to_xfer', xtype=ncd_double, & ++ dim1name='pft', & ++ long_name='grain C shift storage to transfer', units='gC/m2/s', & ++ interpinic_flag='interp', readvar=readvar, data=pcf%grainc_storage_to_xfer) + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary data sets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +! renamed for consistency +D models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + +List all files added and what they do: + +A models/lnd/clm/src/util_share/dtypes.h +A models/lnd/clm/src/util_share/ncdio_pio.F90.in +A models/lnd/clm/src/util_share/restUtilMod.F90 +A models/lnd/clm/src/util_share/restUtilMod.F90.in +A models/lnd/clm/src/clm4_5/biogeochem/CNRestMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_52 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_52 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Nov 26 22:07:32 MST 2013 +One-line Summary: turn on longwave radiation downscaling for glc_mec by default + +Purpose of changes: Turn on longwave radiation downscaling for glc_mec by default + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: set glcmec_downscale_longwave to true +by default + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: updated to scripts4_131126a, to get tweaked test list + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Change glcmec_downscale_longwave to true by default +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +========= Remove build-namelist tests that are no longer xFails +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Update scripts to scripts4_131126a, to get tweaked test list +M SVN_EXTERNAL_DIRECTORIES + + +CLM testing: + + build-namelist tests: + + yellowstone: ok + frankfurt + + regular tests (aux_clm): + + yellowstone_intel: ok + yellowstone_pgi: ok + frankfurt_intel: ok + frankfurt_pgi: ok + frankfurt_nag: ok + +Expected baseline failures: +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131126-131812.compare_hist.clm4_5_51 +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131126-131812.nlcomp + +Two BFAILs due to changed tests; I reran them as their old versions and confirmed that answers changed, as expected: +BFAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC_changeFlags.GC.131126-131807.compare_hist.clm4_5_51 +BFAIL PEM_D.f19_g16.IG1850CLM45.yellowstone_pgi.clm-glcMEC.GC.131126-214346.compare_hist.clm4_5_51 + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: ok + yellowstone_pgi: ok + +CLM tag used for the baseline comparisons: clm4_5_51 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with glc_mec (IG compsets) + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + larger than roundoff; not investigated whether it is same climate or new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_51 +Originator(s): sacks (sacks) +Date: Tue Nov 26 05:46:29 MST 2013 +One-line Summary: rework downscaling of atm fields for glc_mec + +Purpose of changes: + +A number of changes related to downscaling atm -> clm fields for glc_mec +landunits: + +(1) Add new options to downscale precip (division into rain/snow) and longwave + radiation (developed by Bill Lipscomb). Both are currently off by default. + +(2) Move downscaling code out of clm_driverInit into clm_atmlnd.F90 - this is a + more appropriate module, and is a step towards modularity, because the code + to deal with the atmospheric forcing fields lives in the same module as the + definition of these atmospheric forcing fields. + +(3) Ensure that all code uses the downscaled, column-level fields where + possible. Previously, some code (which did not operate over glc_mec + landunits) used the non-downscaled, gridcell-level version of fields such as + forc_t. This was a problem because (a) it was confusing and error-prone, and + (b) we will soon be bringing in code to do downscaling over other landunits + as well as glc_mec landunits. + +(4) To support (3), and make it harder for someone to accidentally use the + gridcell-level version of a field when they should be using the downscaled, + column-level version: Broke clm_a2l into two pieces - one containing fields + that aren't downscaled, and one containing fields that are downscaled. For + fields that are downscaled, clearly distinguished the non-downscaled + versions so they couldn't be used by accident. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: For glc_mec runs, added two new +namelist options: glcmec_downscale_rain_snow_convert and +glcmec_downscale_longwave. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik; portions reviewed by Bill Lipscomb, Mariana, Stefan + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Significant changes: includes stuff that used to be in + clm_driverInitMod; added new downscaling code for precip & lwrad; + split atm2lnd type into two types; reworked initialization interfaces; + removed unused field rainf, because it currently isn't used and could + theoretically become inconsistent with the downscaled rain/snow +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 + +========= Removed downscaling code from here +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 + +========= Added call to downscale_forcings +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Changed interface to init_atm2lnd: previously, clm_initialize used + clm_a2l from clm_atmlnd and passed it to init_atm2lnd_type (also in + clm_atmlnd) - there was no reason for this, it was confusing, and to + some extent broke modularity +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= New parameter +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +========= Removed some variables +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +========= New namelist control variables +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +========= Removed unused rainf, added pointer to allow lnd_import_export to + remain identical between clm4_0 and clm4_5 code +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 + +========= Fixed test ids for failing build-namelist tests +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Minor changes in lots of places to (a) use fields from + a2l_downscaled_col instead of clm_a2l, and (b) index those fields by + column rather than by gridcell +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/cpl/lnd_comp_esmf.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M models/lnd/clm/src/cpl/lnd_comp_mct.F90 + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Note the following expected nlcomp failures: + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.GC.131125-104703.nlcomp + FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131125-104751.nlcomp + FAIL PEM_D.f19_g16.IG1850CLM45.yellowstone_pgi.GC.131125-104751.nlcomp + + Also, there were BFAILs for the following, implying that the baselines + didn't exist; I'm not too concerned because baseline comparisons passed for + similar tests: + BFAIL SMS_Ly1_Mmpich.f19_g16.ICLM45BGCCROP.frankfurt_nag.clm-reduceOutput.GC.131125-104832.compare_hist.clm4_5_50 + BFAIL ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.GC.131125-104703.compare_hist.clm4_5_50 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + As above, baselines were missing for this test: + BFAIL2 ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.compare_hist.clm4_5_50.clm2.h0 (baseline history file does not exist) + BFAIL2 ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial.compare_hist.clm4_5_50.clm2.h1 (baseline history file does not exist) + + +CLM tag used for the baseline comparisons: clm4_5_50 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_50 +Originator(s): erik (Erik) +Date: Sun Nov 24 18:51:11 MST 2013 +One-line Summary: Bring in a crop of b4b bugfixes, fix getregional script, + start move of PTCLM to PTCLMmkdata tool + +Purpose of changes: + +Bring in a crop of bit-for-bit bug-fixes to the trunk for November. +Fix the getregional_datasets script and initial move of PTCLM to just +be a CLM tool under models/lnd/clm/tools/shared to create single-point +datasets. + +New option to create_newcase "-user_mods_dir" for a directory with +user chagnes such as user_nl_* namelist modification files, xmlchange_cmnds +file with xmlchanges to make, and SourceMods/src.*/* files. + +Requirements for tag: bit-for-bit bug-fixes and work on PTCLM + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1868 (Add user_mods_dir to create_newcase) + 1854 (Remove fndepdat no longer used) + 1842 (Remove unused variables from gridcell type) (Bill) + 1835 (Add write statement to pftdyn so you can see what it is doing) + 1828 (Clarify modulo used in irrigation code) (Bill) + 1770 (Remove sitespf_pt valid_values list for clm4_0) + 1724 (getregional script does NOT work) + 1625 (Problem setting finidat in CLM for RUN_TYPE=hybrid/branch) + 1543 (large-file format does NOT work in latest clm) + 1481 (Provide a more direct way to set a user provided finidat file) + 1437 (problems with link_dirtree -- no longer needed) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: SourceMods directory on create_newcase + + New -user_mods_dir option to create_newcase that will copy SourceMods/src.*/* + files to the new case. Also copies user_nl_* files and xmlchange_cmnds + +Describe any changes made to the namelist: remove outnc_large_files + Remove outnc_large_files -- wasn't functional + (now always use 64-bit format) + Remove fndepdat from namelist_definition/defaults no longer used. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (fixes for 1842 and 1828) + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts updated to scripts4_131119 + +List all files eliminated: None + +List all files added and what they do: + +------ Add externals for tools so PTCLM shows up in tool directory +------ Add same files and a README file for getregional +A models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES +A models/lnd/clm/tools/shared/ncl_scripts/sample_inlist +A models/lnd/clm/tools/shared/ncl_scripts/sample_outlist +A models/lnd/clm/tools/shared/ncl_scripts/README.getregional + +List all existing files that have been modified, and describe the changes: + +------ Get getregional_datasets script working again. Now operates on +------ lists of files. +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/test/tools/TSMscript_tools.sh --- Copy sample_*list files +M models/lnd/clm/test/tools/nl_files/getregional - change arguments + +------ +M models/lnd/clm/tools/clm4_0/interpinic/src/interpinic.F90 + +------ Remove clm_startfile option and outnc_large_files +M models/lnd/clm/bld/config_files/config_definition_clm4_0.xml -- + Remove valid_values from sitespf_pt so can be anything. +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl -- Remove + clm_startfile option and move some clm4_5 configure options + to build-namelist +M models/lnd/clm/bld/build-namelist --- Remove clm_startfile option + and outnc_large_files +M models/lnd/clm/bld/clm.buildnml.csh - Remove clm_startfile option + set finidat/nrevsn like how is done in CAM + +------ Remove fndepdat and outnc_large_files +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 -------- Remove + some gridcell variables not sued +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 ------------- write + on what's going on +M models/lnd/clm/src/clm4_5/main/controlMod.F90 ------------ Remove + outnc_large_files +M models/lnd/clm/src/clm4_5/main/clmtype.F90 --------------- Remove + a bunch of gridcell variables not needed +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - Add + seconds_since_irrig_start_time temporary to clarify + +------ +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 --- add some writes statements +M models/lnd/clm/src/clm4_0/main/controlMod.F90 -- remove outnc_large_files + +CLM testing: + + build-namelist tests: + + yellowstone yes + frankfurt no + + NOTE: there were some tests that were passing but in the xFail list + from before clm4_5_49 that I marked as working. + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel yes + yellowstone_pgi yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_49 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_49 +Originator(s): muszala (Stefan Muszala) +Date: Sat Nov 16 07:51:27 MST 2013 +One-line Summary: Swenson anomaly forcing - Part 1 + +purpose of changes: + add additional data streams to modify existing + data streams for purposes such as bias correction or specifying + future changes relative to baseline data streams, e.g. specifying + future atmospheric forcing anomalies when running CLM with data atmosphere. + Paired with datm8_131115. + + For what to set in user_nl_cpl, user_nl_datm, see testing section. + + This is part 1 of 2. Part 2 will address a general way to handle + streams in the DATM that is triggered off of an AF compset. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: swenson, kluzek, self + +List any svn externals directories updated (csm_share, mct, etc.): update to datm8_131116 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/cpl/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl/lnd_import_export.F90 +M SVN_EXTERNAL_DIRECTORIES + +CLM testing: + +Testing for features of this tag: f09_g16, ICRUCLM45 + +anomaly forcing namelists + user_nl_cpl: cplflds_custom = 'Sa_prec_af->a2x', 'Sa_prec_af->x2l','Sa_tbot_af->a2x', + 'Sa_tbot_af->x2l','Sa_pbot_af->a2x', 'Sa_pbot_af->x2l','Sa_shum_af->a2x', + 'Sa_shum_af->x2l','Sa_u_af->a2x', 'Sa_u_af->x2 l','Sa_v_af->a2x', + 'Sa_v_af->x2l','Sa_swdn_af->a2x', 'Sa_swdn_af->x2l','Sa_lwdn_af->a2x', + 'Sa_lwdn_af->x2l' + user_nl_datm: anomaly_forcing = 'Anomaly.Forcing.Precip','Anomaly.Forcing.Temperature', + 'Anomaly.Forcing.Pressure','Anomaly.Forcing.Humidity','Anomaly.Forcing.Uwind', + 'Anomaly.Forcing.Vwind','Anomaly.Forcing.Shortwave','Anomaly.Forcing.Longwave' +bias correction namelists + user_nl_cpl: cplflds_custom = 'Sa_precsf->a2x', 'Sa_precsf->x2l' + user_nl_datm: bias_correct = 'BC.CRUNCEP.GPCP.Precip' + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_48 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_48 +Originator(s): muszala (Stefan Muszala) +Date: Thu Nov 14 08:28:31 MST 2013 +One-line Summary: bug fixes for CLM dry deposition and MEGAN VOC emissions + +Purpose of changes: Bring in bug fixes from fvitt for CLM dry deposition and MEGAN VOC emissions. Any changes + to answers are limited to rare circumstances. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: fvitt, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_47 + +Changes answers relative to baseline: Answers change for some of the chemistry configurations, but + these changes will not be see in the CLM standalone tests. + +=============================================================== +=============================================================== +Tag name: clm4_5_47 +Originator(s): muszala (Stefan Muszala) +Date: Tue Nov 12 09:26:20 MST 2013 +One-line Summary: fix Bug 1858 - AGDD now reset annually + +Purpose of changes: Fix bug 1858. AGDD is now reset annually. Replace -99999_r8 with a + parameter in accumulMod.F90 which is used in accFldsMod.F90 + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1858 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: slevis, sacks, muszala + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 + +CLM testing: + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_46 + +Changes answers relative to baseline: Generally, No. There may be changes + in DV compsets over very long simulation times and at very high resolutions. + +=============================================================== +=============================================================== +Tag name: clm4_5_46 +Originator(s): sacks (sacks) +Date: Fri Nov 8 17:26:02 MST 2013 +One-line Summary: remove zeroing out of slope for special landunits + +Purpose of changes: + + Previously, there was code to zero out slope for grid cells with 100% special + landunits. However, there were a number of problems with this: + + (1) With dynamic landunits, this is problematic, because a grid cell could + start as 100% special landunits, then later become < 100% special landunits + (e.g., due to retreating glaciers) + + (2) Moreover, why should the slope of a special landunit depend on whether + the grid cell has 100% special landunits. This seems to be saying that, e.g., + the slope of a glacier landunit depends on whether the grid cell is entirely + glacier or part glacier and part natural veg. + + (3) And I guess moreover, why is the slope zeroed out for special landunits + in the first place? + + + From talking with Erik, we decided thish code was probably a relic from a + time when the surface dataset had some bad values (e.g., over Greenland / + Antarctica). This is no longer the case, so this code is no longer needed. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Following are the baseline failures, which are expected (see below): + +FAIL SMS_D.1x1_mexicocityMEX.ICLM45.frankfurt_intel.clm-default.GC.131107-223431.compare_hist.clm4_5_45 +FAIL SMS_D.1x1_vancouverCAN.ICLM45.frankfurt_pgi.clm-default.GC.131107-223435.compare_hist.clm4_5_45 +FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_nag.clm-default.GC.131107-223439.compare_hist.clm4_5_45 +FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_nag.clm-default.GC.131107-223439.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.GC.131107-223256.compare_hist.clm4_5_45 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.GC.131107-223256.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.I1850CRUCLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 +FAIL ERI.f09_g16.ICLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 +FAIL ERI_D.f09_g16.ICLM45BGC.yellowstone_pgi.GC.131107-223301.compare_hist.clm4_5_45 + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + Following are the baseline failures, which are expected: + +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h0 +FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h1 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h0 +FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.clm-default.compare_hist.clm4_5_45.clm2.h1 + + +CLM tag used for the baseline comparisons: clm4_5_45 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Any configuration that includes a grid cell that + has 100% special landunits, including at least some urban + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated carefully, but expected to be larger than roundoff/same + climate - since this only affects a very small number of grid cells, and + (I believe) only the urban pervious road in those grid cells + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_45 +Originator(s): sacks (sacks) +Date: Fri Nov 8 16:10:22 MST 2013 +One-line Summary: refactor daylength calculation, and other minor changes + +Purpose of changes: + + (1) Compute daylength in a single place, and compute necessary variables at + initialization rather than having them on the restart file + + (2) Compute daylength-related variables at initialization rather than having + them on the restart file, both to clean things up and to fix some daylength + bugs at initialization (these bugs were fixed in a kludgey way in clm4_5_44, + and now are fixed robustly) + + (3) Fix daylength calculation at the poles (previously blew up due to + roundoff errors) (doesn't change behavior currently, but could change + behavior / answers if there were a vegetated landunit at the pole) + + (4) Fix sminn on restart, so that crop restarts can be bfb (bug 1846) + + (5) Add all_active namelist variable that makes even 0-weight points active, + for testing purposes + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + - 1846 (crop restarts aren't exact due to sminn field) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: add all_active namelist variable + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: (1) & (2) reviewed by erik, (3) by self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: update from scripts4_131030 -> scripts4_131107a + +List all files eliminated: none + +List all files added and what they do: + +========= Compute daylength in a single place +A models/lnd/clm/src/clm4_5/biogeophys/DaylengthMod.F90 + +List all existing files that have been modified, and describe the changes: + +========= Refactor daylength calculation to just compute daylength in a single, + central place, and compute necessary variables at initialization + rather than having them on the restart file +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + - also fix sminn on restart (bug 1846) +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + +========= Add all_active namelist variable that makes even 0-weight points + active, for testing purposes +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + + +========= Add & remove tests from xFail list +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +*** No longer tested (replaced by CME_Ly4) +- Runs out of time. CME_Ly4.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-monthly passes + +*** Now passes +- restarts not exact due to bug 1846: crop restarts are not exact due to sminn field + ++ Diffs in cpl log files in rofl, rofi and volr ++ Diffs in cpl log files in rofl, rofi and volr + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + Note that we get the following failures in compare_hist: + + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.131107-214732.compare_hist.clm4_5_44 + FAIL PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput.GC.131107-214732.compare_hist.clm4_5_44 + + However, I think that's expected due to the oddities in the clm4_5_44 tag + with openmp - see notes in the ChangeLog for clm4_5_44 for details. Note + that this one is identical to clm4_5_43, suggesting that clm4_5_45 undoes + the problem introduced in clm4_5_44: + + PASS PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_43.cpl.hi + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + In particular, note that the clm hist comparison passes for the two above + tests that had unexpected cpl diffs: + + PASS PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_44.clm2.h0 + PASS PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel.clm-irrigOn_reduceOutput.compare_hist.clm4_5_44.clm2.h0 + + +CLM tag used for the baseline comparisons: clm4_5_44 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_44 +Originator(s): sacks (sacks) +Date: Fri Nov 8 08:19:56 MST 2013 +One-line Summary: temporary hack to daylength initialization to provide baselines for the next tag + +Purpose of changes: + + The next tag (clm4_5_45) involves a major refactor to the daylength + calculation. That refactor is bfb in most respects, but gives differences in + the first time step in a few situations. + + This tag (clm4_5_44) does the minimal changes needed to get the same results + as clm4_5_45, in order to have more confidence when testing clm4_5_45. + + Note that the changes here are a kludge that will be reverted in clm4_5_45. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1850 (incorrect daylength in first timestep of some runs) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + There were a number of expected compare_hist failures, as described below. + + There was one unexpected compare_hist failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.145424.compare_hist.clm4_5_43 + + Diffs are just in voc cpl fields. CLM hist files are identical at the end of + the run. An SMS version of this test passes. Interestingly, the kludgey code + that I have added for clm4_5_44 isn't even executed in this test... so the + only diffs should be in variable declarations and 'use' statements. And + clm4_5_45 (which I will tag soon) gives identical cpl hist files to + clm4_5_43. So there may just be a compiler fluke in the compilation of this + tag with openmp enabled. Because clm4_5_45 will give identical results to + clm4_5_43, I'm not worrying about this. + + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + A number of expected compare_hist failures, as described below. + +CLM tag used for the baseline comparisons: clm4_5_43 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with BGC (and probably CN), involving + either (a) initial conditions interpolated from a different resolution, or + (b) a change in start date relative to the ref date of an initial file + (which shows up in ERI tests) - see bug 1850 + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated carefully, but almost certainly larger than + roundoff/same climate, since this code mod just changes things in the + first timestep. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_43 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Nov 6 09:21:25 MST 2013 +One-line Summary: allocate memory for most landunits in every grid cell (needed for dynamic landunits) + +Purpose of changes: + + Main change is to allocate memory for most landunits in every grid cell, to + support dynamic landunits. Note that we ALWAYS do this extra memory + allocation, so that the user isn't required to do interpinic between a + non-dynamic run and a dynamic landunit run. (If we eventually change the + restart file format / processing so that you can add / remove 0-weight points + at will, then we could potentially add some logic to only do this extra + allocation if we're using dynamic landunits.) + + Supporting changes are (1) determining which grid cells have enough parameter + data to support urban landunits, (2) new initial conditions files, (3) in + mksurfdata_map, don't set soil parameters to 0 under glacier, and set urban + parameters even if urban cover is 0% + + Other changes are: + + (1) only do snow balance check over active columns + + (2) fix interpinic bug (bug 1839) + + (3) newer files for testing interpinic + + + NOTE: All CLM4.5 initial conditions will need to be interpinic'ed to be + usable in this tag (this has been done for all out-of-the-box initial + conditions) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + - 1839 (interpinic uses wrong column when there are 0-weight columns in the + input file) + + - 1840 (snow balance check is executed over inactive columns) + + - 1825 (surface datasets need urban parameters even when pcturb is 0 + everywhere): partial fix - still waiting on new USUMB dataset + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: new initial conditions for CLM4.5 + +List any changes to the defaults for the boundary datasets: new initial +conditions for CLM4.5 + +Describe any substantial timing or memory changes: + + Significant memory increases for all CLM4.5 configurations - memory is now + allocated for all natural veg landunits, all crop landunits (if using + create_crop_landunit), and most urban landunits. + + Also, significant performance decrease (~ 10%) associated with the above + change, which I believe is mainly due to decreased cache friendliness. + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +D models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c130607.nc + +List all files added and what they do: + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +A models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c131104.nc + +List all existing files that have been modified, and describe the changes: + +========= Determine which grid cells should have urban landunits +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 + +========= Create a natural veg landunit and crop landunit in all grid cells; + create an urban landunit in all grid cells for which we have + determined that urban is "valid" +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 + +========= Change a comment +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 + +========= Only do snow balance check over active columns (fixes bug 1840) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Use new initial conditions files that are consistent with the expanded + 1-d memory structures +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Don't set soil parameters to 0 under glacier; set urban parameters + even if urban cover is 0% +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + +========= Fix interpinic bug (bug 1839) +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + +========= Change files used for testing interpinic, in order to use files that + are up-to-date with the current version of CLM, for a more accurate test +M models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions + + +========= Add two tests to the xFail list +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + ++ Runs out of time. CME_Ly4.f10_f10.I1850CLM45BGC.yellowstone_intel.clm-monthly passes ++ Needs new surface dataset + + +CLM testing: + +NOTE: main tests were done with +dynlu_allocate_memory_n11_fix_cndv_time_averages_n01_clm4_5_41; tools tests with +dynlu_allocate_memory_n12_clm4_5_42; build-namelist tests with a slightly older +tag + + build-namelist tests: + + yellowstone: OK. However, the "correct" comparisons are spurious, because I + think the build-namelist test is broken + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + tools testing: + + yellowstone interactive: OK + + *** Expected failures + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=4 FAIL + + + *** Expected baseline failure (uses new input & output file, and there is a non-bfb change in interpinic) + 016 blh54 TBLtools.sh clm4_5 interpinic tools__ds runoptions ....................................\c + rc=7 FAIL + + *** Expected diffs in PCT_SAND, PCT_CLAY, SOIL_COLOR + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................\c + rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds \c + rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....\c + rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...\c + rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...\c + rc=7 FAIL + + *** Expected diffs in urban fields + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_\c + rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_\c + rc=7 FAIL + + +CLM tag used for the baseline comparisons: clm4_5_42 + +Changes answers relative to baseline: NO - but see note below: + + NOTE: This tag has the potential to change answers for cases using initial + conditions that were interpinic'ed using the out-of-the-box interpinic, + because of bugs in interpinic. This applies to CLM4.5 cases @ ne30 and hcru + resolutions, as well as CLM4.5 cases using DV @ f09. However, no diffs showed + up in the test suite, so it's possible that this isn't a problem. + +=============================================================== +=============================================================== +Tag name: clm4_5_42 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Mon Nov 4 09:45:36 MST 2013 +One-line Summary: fix bug 1857 for CLM4.5 - CNDV running temperature means are incorrect + +Purpose of changes: + + Fix bug 1857 for CLM4.5 (not yet fixed for CLM4.0!). From the bugzilla entry: + + In this code in CNDVMod: + + do p = bounds%begp, bounds%endp + g = pft%gridcell(p) + if (kyr == 2) then ! slevis: add ".and. start_type==arb_ic" here? + tmomin20(g) = t_mo_min(p) ! NO, b/c want to be able to start dgvm + agdd20(g) = agdd(p) ! w/ clmi file from non-dgvm simulation + end if + tmomin20(g) = (19._r8 * tmomin20(g) + t_mo_min(p)) / 20._r8 + agdd20(g) = (19._r8 * agdd20(g) + agdd(p) ) / 20._r8 + end do + + Notice that this is a loop over p, but it's updating gridcell-level variables. + This means that the running temperature means aren't at all what they purport + to be. e.g., in a grid cell with the 17 natural PFTs and nothing else, the grid + cell-level values will get the 17 pft values averaged in each year, rather than + getting a single pft value per year. This means that these temperature + variables are closer to a single year's value than to a running mean. + + The fix here should be simple: just change tmomin20 & agdd20 to pft-level + variables. + + + WARNING: USE CAUTION WHEN USING THIS TAG WITH AN OLDER RESTART FILE FROM A + CLM4.5 DV CASE (this is not a problem for any out-of-the-box initial + conditions files, but could apply if you have your own initial file from a DV + run): In this case, the two DV-related variables AGDD20 and TMOMIN20 will be + reset to their arbitrary initial conditions. + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1857 - partial fix (still open for clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Remove SSP compare_hist BFAIL from xFAIL list (Ben fixed this in the last tag) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + All baseline comparisons pass except the following expected failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.GC.104252.compare_hist.clm4_5_41 + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + All baseline comparisons pass except the following expected failure: + FAIL PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel.clm-reduceOutput.compare_hist.clm4_5_41.clm2.h0 + +CLM tag used for the baseline comparisons: clm4_5_41 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with DV + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Definitely larger than roundoff, but not investigated as to whether it's + same climate or new climate. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_41 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Wed Oct 30 17:33:16 MDT 2013 +One-line Summary: update scripts to convert clm4_5 CPP flags to namelist variables. + +Purpose of changes: Convert clm4_5 CPP flags in controlMod.F90 + into namelist variables, update scripts infrastructure + to generate cases with namelist variables for bgc + (CN, CNDV, methane, vsoilc_centbgc), crop, extra lake layers, + vic, nofire, noio, sitespf_pt, snicarfrc, maxpatch_pft. + +Requirements for tag: + +Test level of tag: regular, tools, build_namelist + +Bugs fixed (include bugzilla ID): 1728 (scripts4_20131030 tag). 1770 (clm4_5 portion). + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: removed clm4_5 CPP flags: + NOFIRE, LCH4, NITRIF, VERTSOILC, EXTRALAKELAYERS, VICHYDRO, CENTURY, CN, + CNDV, CROP, SNICAR, VANCOUVER, NOIO, MEXICOCITY + +Describe any changes made to the namelist: added namelist variables: + + use_nofire, use_lch4, use_nitrif_denitrif, use_vertsoilc, use_extralakelayers, + use_vichydro, use_century_decomp, use_cn, use_cndv, use_crop, use_snicar_frc, + use_vancouver, use_mexicocity, use_noio + + All new namelist variables are logicals. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Erik Kluzek, Bill Sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_131030 + +List all files eliminated: +D models/lnd/clm/bld/config_files/config_definition.xml - split into clm4_X variants + +List all files added and what they do: +A models/lnd/clm/bld/config_files/config_definition_clm4_5.xml +A models/lnd/clm/bld/config_files/config_definition_clm4_0.xml + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - set crop=off by default to pick up correct defaults. +M models/lnd/clm/bld/configure - completely remove clm4_5 only cpp flags, add physics dependent logic to clm4_0 flags. +M models/lnd/clm/bld/queryDefaultNamelist.pl - point to physics specific config_definitions.xml file +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml - replace xml special characters with alternatives so file can be parsed. Add new build-namelist failures. + +M models/lnd/clm/bld/build-namelist - add logic for all new clm4_5 namelist variables, commandline options, switch defaults to use_N. + +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - add new namelist variables + +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 - add CNNDynamicsInit() and logic to set nfix_timeconst from use_nitrif_denitrif namelist instead of CPP. +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 - convert ifdef'd parameters to variables +M models/lnd/clm/src/clm4_5/main/controlMod.F90 - final conversion of CPP flags to namelist variables + + Switch the following files to use new namelist variables for attributes: +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + + +CLM testing: + + build-namelist tests: + + yellowstone - most tests will fail, tests need to be updated in future tag + frankfurt + + regular tests (aux_clm): + - nlcomp tests fail for all clm4_5 because of the new namelist variables. + - SSP tests should now be BFAIL, pass on next tag + - All hist comp are bit for bit. + + yellowstone_intel ok + yellowstone_pgi ok + frankfurt_intel ok + frankfurt_pgi ok + frankfurt_nag ok + + tools testing: + + yellowstone interactive - smiS4 (getregional) also fails in clm4_5_40 + frankfurt interactive - N/A + +CLM tag used for the baseline comparisons: clm4_5_40 + +Changes answers relative to baseline: None. + +=============================================================== +=============================================================== +Tag name: clm4_5_40 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Oct 24 07:54:46 MDT 2013 +One-line Summary: fix Bug 1752 - urban conductances depend on weights in an undesirable way + +Purpose of changes: + +Three parts to this tag. Description from Oleson: + +1) + fix Bug 1752 - modified UrbanMod.F90 to calculate +2) + add 2 new diagnostic history fields (FIRE_U, FIRE_R) + the conductances correctly. I created new variables to more clearly + distinguish between scaled and unscaled conductances. +3) + fix small bug in which the history field output of some of the + anthropogenic heat flux variables are not bfb on restart when finidat is blank. + I found this when verifying bfb for the original bug fix. The cause of this + is initialization which sets non-urban to special value, instead of zero, which + is what is desired. On restart, this initialization is not done and the history + file set_nourb=0 has precedent. A related issue is that eflx_building_heat is + not zero for pervious/impervious road when nlevurb /= nlevgrnd. + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1752 + + long test with irrigate=.true. (because irrigation likely never took effect + in the old test). + +Requirements for tag: + +Test level of tag: regular & build_namelist + +Bugs fixed (include bugzilla ID): + - 1827 / 1830: testmods don't work right for multi-instance tests (fix via + scripts update) + - 1829: PCT_SAND, PCT_CLAY and SOIL_COLOR are incorrect for some grid cells + (fix via new surface datasets) + - 1831: turning on irrigation leads to death in initialization (fix via a new + initial conditions file) + + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: see changes in boundary datasets + +List any changes to the defaults for the boundary datasets: + + - new surface datasets for all resolutions for CLM4.5: same as before except + for PCT_SAND, PCT_CLAY and SOIL_COLOR: these are no longer zeroed out under + points that are believed to be 100% glacier ("believed to be" because this + previously zeroed out some points that ended up having some other special + landunits, such as lake) + + - new initial conditions file for CLM4.5, irrigate=.true., f10 + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts: scripts4_131001 -> scripts4_131003 + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= new logic for irrigation for finidat +M models/lnd/clm/bld/build-namelist + +========= new surface datasets; distinguish finidat based on value of 'irriagte' +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +CLM testing: + + build-namelist tests: + + caldera: OK + The following failures were expected due to new surface datasets: + 413/439 < FAIL> + 418/439 < FAIL> + 423/439 < FAIL> + 428/439 < FAIL> + 433/439 < FAIL> + 438/439 < FAIL> + + + regular tests (aux_clm): + + edison_intel (aux_clm_ys_intel & aux_clm_ys_pgi lists): OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + edison_intel: aux_clm_ys_intel list: OK + edison_intel: aux_clm_ys_pgi list: OK + +CLM tag used for the baseline comparisons: clm4_5_35 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45 + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + Not investigated carefully, but probably larger than roundoff/same climate. + + Answer changes are due to new surface datasets. This is due to fixing + bug 1829 (PCT_SAND, PCT_CLAY and SOIL_COLOR are incorrect for some grid + cells); it looks like this just affects answers over a small number of + lake points (e.g., 9 lake points in an f19 run). + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_35 +Originator(s): sacks (Bill Sacks) +Date: Tue Oct 1 09:47:45 PDT 2013 +One-line Summary: get CLM running on edison + +Purpose of changes: + + Update scripts and Machines externals to get the CLM test suite running on + edison; this will be our replacement for yellowstone while yellowstone is + down. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: N/A + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130929 +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130927 ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_131001 ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130930b + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Remove PEM test that should pass now; add xFails for edison +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + NOTE: Testing was done on tag port_to_edison_02_clm4_5_34. Since then, scripts + has been updated from scripts4_130930a to scripts4_131001. However, the only + difference is the removal of some duplicated tests from the test list. + + regular tests (aux_clm): + + edison_intel (aux_clm_ys_intel & aux_clm_ys_pgi lists): OK + All pass except: + + See "ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi.clm-default + Can't find user datasets + Seg fault while writing h1 file + See ERS_Ld211_D_P112x1.f10_f10.ICNCROP in yellowstone intel list + + #1 and #4 have been failing on yellowstone, #2 and #3 are new failures on edison + + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + NOTE: only generate done here, because no baselines existed + + edison_intel: aux_clm_ys_intel list: OK + edison_intel: aux_clm_ys_pgi list: OK + +CLM tag used for the baseline comparisons: clm4_5_34 + + NOTE: Baseline comparisons only done for frankfurt tests; no baseline + comparisons done with component_gen_comp, because no baselines existed on + edison. + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_34 +Originator(s): erik (Erik Kluzek) +Date: Mon Sep 30 01:30:25 MDT 2013 +One-line Summary: Get PTCLM working, fix a few small bugs + +Purpose of changes: + +Get PTCLM fully working. Allow PTCLM to work with ALL I compsets including clm4_0 compsets. +Add a new option to PTCLM from Keith Oleson --cycle_forcing to set it up to cycle over the forcing. +Another option is to build datasets in the "-mydatafiles" directory (by default under PTCLM +directory). The datasets now have creation time-stamps in them as well. Rename QIAN_tower_yrs +to -use_tower_yrs and remove QIANforcing (now chosen by compset). +scripts now has four different I1PT compsets two new ones for CLM40CN and CLM45BGC. datm +CLM_USRDAT domain file for CLM1PT forcing points to the ATM_DOMAIN_FILE/PATH. Add some new +datasets to the siteDIR from Keith Oleson. Update documenation, remove unused template dir. +Add a script to rename creation dates for map files, so you don't have to regenerate them +each day. + +Fix a few small bugs. Allow clm4_5 to have suplnitro and bgc_spinup to only give a warning +rather than die. Fix a corrupted rawdata PFT file. Fix mkscripgrid.ncl for regional SCRIP +grid creation. Remove some leftover fine-mesh variables that aren't needed anymore. Remove +reference to scaled_harvest in CLM build-namelist which was removed a long time ago. + +Remove a mapping file that didn't seem to be needed for clm4_0 mkmapdata (a default +didn't exist for it either). Add -usr_mapdir option to clm4_0 mksurfdata.pl which is needed +for PTCLM for clm4_0 compsets. + +Requirements for tag: Update scripts and get PTCLM working + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1826 (allow clm4_5 and suplnitro to be ALL for bgc_spinup) + 1818 (two new options to PTCLM) + 1762 (Fix corrupted rawdata PFT file) + 1757 (Bug in mkscripgrid.ncl for regional/global SCRIP grid creation) + 1623 (Remove some leftover fine-mesh variables _a arrays) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Allow two options to go without dying + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, datm, and csm_share + scripts to scripts4_130929 + Machines to Machines_130927 + datm to datm8_130919 + csm_share to share3_130918 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh ------- Remove 10x10min_IGBPmergeICESatGIS for clm4_0 + M models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl --- Fix bug 1757 for regional grid creation + M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl - Add usr_mapdir option + + M models/lnd/clm/bld/build-namelist - Allow missing clm_usrdat files to continue, remove scaled_harvest (long gone) + allow bgc_spinup and suplnitro to coexist with warning + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml - Fix corrupted 856 raw PFT file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - Fix corrupted 856 raw PFT file, remove 1000-1004 testyrs + + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - Remove finemesh _a variables + M models/lnd/clm/src/clm4_5/main/clmtype.F90 -------- Remove finemesh _a variables + M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 - Remove finemesh _a variables + M models/lnd/clm/src/clm4_0/main/clmtype.F90 -------- Remove finemesh _a variables + +CLM testing: regular, build_namelist, tools + + build-namelist tests: + + yellowstone yes + frankfurt yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + tools testing: + + yellowstone interactive yes + +CLM tag used for the baseline comparisons: clm4_5_33 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_33 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Sep 26 10:42:56 MDT 2013 +One-line Summary: clean up from mistakes in previous tag + +Purpose of changes: clean up time-stamps and a mistake in clm4_5_32 + +Requirements for tag: N/A + +Test level of tag: N/A + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: N/A + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + +CLM testing: N/A + +CLM tag used for the baseline comparisons: N/A + +Changes answers relative to baseline: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_32 +Originator(s): muszala (Stefan Muszala,UCAR/TSS,303-497-1320) +Date: Thu Sep 26 10:07:14 MDT 2013 +One-line Summary: bug fix tag - 1798, 1810 + +Purpose of changes: fix bug 1798 and 1810. + +http://bugs.cgd.ucar.edu/show_bug.cgi?id=1798 +http://bugs.cgd.ucar.edu/show_bug.cgi?id=1810 + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1798 and 1810 + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- for bug 1798 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +- for bug 1810 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel - OK + yellowstone_pgi - OK + frankfurt_intel - OK + frankfurt_pgi - OK + frankfurt_nag - OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK + +CLM tag used for the baseline comparisons: clm4_5_31 + +Changes answers relative to baseline: no + +=============================================================== +=============================================================== +Tag name: clm4_5_31 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Wed Sep 25 10:12:47 MDT 2013 +One-line Summary: fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + +Purpose of changes: + + Fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and + decomposition dependence. Fix for this is based on analysis of the original + Agro-IBIS code. + +Requirements for tag: fix bug 1820, the following tests should now pass: + PET_P15x2_Lm25.f10_f10.ICLM45BGCDVCROP.yellowstone_intel + PET_P15x2_Ly3.f10_f10.ICLM45BGCCROP.yellowstone_intel + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Beth Drewniak, Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 + +========= Remove now-passing PET tests +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_30 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 with CROP + - what platforms/compilers: ALL + - nature of change (roundoff; larger than roundoff/same climate; new climate): + larger than roundoff, but not investigated in detail + + Note that no changes were observed in the test suite, but this is due to + a limitation of the test suite (there are very few multi-year crop tests; + the only global multi-year tests are the newly-passing PET tests, which + don't have baselines) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_30 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Sep 24 13:08:01 MDT 2013 +One-line Summary: fix performance bug in decomposition initialization + +Purpose of changes: + +Fix performance bug in decomposition initialization (bug 1771). Code mods from +Tony Craig. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1771 ( Fix for an initialization performance bug) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + + Improves timing of initialization for high resolution casse + +Code reviewed by: tcraig + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +M models/lnd/clm/src/clm4_0/main/decompInitMod.F90 + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_29 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_29 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Tue Sep 24 10:55:42 MDT 2013 +One-line Summary: fix threading in CLM4.5, and other misc fixes + +Purpose of changes: + +(Mostly) fix threading in CLM4.5. This consisted of: + +(1) Rework initGridCellsMod to keep all points in a clump contiguous + +(2) Add info in bounds derived type (not necessary, but this allows +for more error checking and simplifies some code) + +(3) Fix which bounds are passed to reweightWrapup in initialization + +(4) Get rid of syntax like foo(:) = 0, instead using explicit bounds + +(5) Rework bounds declarations for subroutine array arguments, both in +caller (explicitly subset argument by bounds) and callee (use +assumed-shape array arguments rather than declaring upper bounds), and +add assertions on array sizes. + +See https://wiki.ucar.edu/display/ccsm/Community+Land+Model+Developers+Guide +("Guidelines for passing array arguments to subroutines") for the new +conventions that are implemented here. + +(6) Fix crop threading bug, related to nyrs (bug 1598), both in clm4.5 and clm4.0 + +However, note that there is still a crop threading bug (bug 1820), which will +need to be fixed in a separate tag. + + +Also, some unrelated changes: + +(1) Fix size of a megan variable, both in clm4.5 and clm4.0. + +(2) Remove some unused variables from Hydrology2Mod / SoilHydrologyMod + +(3) Fix some bugs in histFileMod / histFldsMod + +(4) Reorder a loop in SurfaceAlbedo to get better performance (especially with +expanded memory allocation for dynamic landunits, in an upcoming tag) + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): + + 1598 (crop threading in clm4.0 and clm4.5) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: + + Added f10 initial file for CLM4.5 BGCCROP, for testing purposes + +Describe any substantial timing or memory changes: + + Timing is currently 5-10% worse, due to calls to shr_log_errMsg, within + shr_assert calls. This should return to previous timings in non-debug runs + once shr_assert calls are ifdef'ed out in non-debug runs (this requires a + csm_share update that Sean Santos is working on). + +Code reviewed by: portions reviewed by erik + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts4_130912 -> scripts4_130916 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Significant rework to work with multiple clumps per proc +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Add info in bounds derived type +M models/lnd/clm/src/clm4_5/main/decompMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + - also fix crop threading bug (1598) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + - also use explicit bounds instead of things like foo(:) + +========= Remove some unused variables +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + - also other bounds-related changes as above + +========= Change 'bounds' to 'bounds_proc', use clump bounds for call to + reweightWrapup, get rid of abort if running with openMP +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= Get rid of syntax like foo(:), instead using explicit bounds +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 + +========= Rework bounds declarations for subroutine array arguments, both in + caller (explicitly subset argument by bounds) and callee (use + assumed-shape array arguments rather than declaring upper bounds), and + add assertions on array sizes +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 + - also remove some now-unneeded temporary arrays + - also use explicit bounds instead of things like foo(:) +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + - also reorder a loop to get better performance +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 + +========= Fix crop threading bug (1598), in both clm4.5 and clm4.0, by reworking + where nyrs is updated +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 + +========= Add comments +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 + +========= Fix size of a megan variable +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + - also initialize rootr, as it was in clm4_5_20 and prior +M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 + +========= Fix some hist file bugs: + - increase max number of characters allowed for hist field names + - when adding a field, make it work to say default='active' -- + previously, explicitly setting default='active' did the same thing + as setting default='inactive' + - change ptr_pft to ptr_col for a few column-level history variables + - remove two duplicate hist_addfld calls +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + - also add some bounds to array arguments +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +========= Add f10 initial file for CLM45 BGCCROP, for testing +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Remove some PET tests from the xFail list; note that some PET tests + still fail due to bug 1820 +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + +CLM tag used for the baseline comparisons: clm4_5_28 + +Changes answers relative to baseline: NO, with the following minor exceptions: + + In general, no answer changes for non-threaded runs (changes answers for + threaded runs due to significant bug fixes!) + + Changes answers for CLM45 BGC CROP at f10 due to new initial conditions + (instead of cold start) + +=============================================================== +=============================================================== +Tag name: clm4_5_28 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Sep 20 21:29:39 MDT 2013 +One-line Summary: fix FracH2oSfc bug + +Purpose of changes: + +Fix bug 1811: FracH2oSfc is called from within a loop over all points. Sean +Swenson realized that the offending block of code is no longer needed, so we +have removed it. + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1811 (FracH2oSfc is called from within a loop +over all points) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove the offending (and no longer needed) block of code +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +========= Remove a now-unused variable +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Move xFail test to the right location +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + +CLM testing: + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + yellowstone_pgi: OK + + See notes below on answer changes + + +CLM tag used for the baseline comparisons: clm4_5_27 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45 cases + - what platforms/compilers: All + - nature of change: larger than roundoff/same climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Sean Swenson performed two 20-year runs with and without the fix. His report + is: + + There are some differences, mainly in runoff, and it looks like at the 1% + level mostly, with a few scattered points showing up on the significance + plots. Other fields like latent heat, soil moisture/temperature, or water + table show even less differences. + + http://www.cgd.ucar.edu/staff/swensosc/public/diagnostics/test_frach2o-test_no_frach2o/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm4_5_27 +Originator(s): sacks (Bill Sacks,UCAR/CSEG,303-497-1762) +Date: Fri Sep 20 20:43:16 MDT 2013 +One-line Summary: fix crop nyrs bug + +Purpose of changes: Fix bug 1815 (nyrs is incorrect at the start of a crop run, +leading to incorrect GDD values for the first 20 years or so of a crop +simulation) + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): +- 1815 (nyrs is incorrect at the start of a crop run, leading to incorrect GDD +values for the first 20 years or so of a crop simulation) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None (but see changes to boundary +datasets below) + +List any changes to the defaults for the boundary datasets: + + New crop initial conditions for CLM4.5 BGCCROP @ f19 - same as old dataset, + but with restyear changed from 1 to 0 + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Don't increment nyrs on the first timestep of a startup run, so that + nyrs is correctly 0 rather than 1 for the first year +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 + +========= New crop initial conditions for CLM4.5 BGCCROP @ f19 - same as old dataset, + but with restyear changed from 1 to 0 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= add test that sometimes runs out of time, move test from + yellowstone_intel to yellowstone_pgi +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +CLM testing: + + build-namelist tests: + + yellowstone: OK + + regular tests (aux_clm): + + yellowstone_intel: OK + yellowstone_pgi: OK + frankfurt_intel: OK + frankfurt_pgi: OK + frankfurt_nag: OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: OK + - expected diffs in SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel + - baselines messed up for + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel, so comparison not + done for that test + yellowstone_pgi: NO BASELINES, SO COMPARISONS NOT RUN + +CLM tag used for the baseline comparisons: clm4_5_27 + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All crop cases (clm4.0 or clm4.5) that either + use arbitrary initial conditions or use the clm4.5 out-of-the-box initial + conditions for BGCCROP @ f19 + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new + climate): new climate + + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + Sam Levis examined a 3-year run with arbitrary initial conditions, and + verified that crop LAI is much more realistic in the new simulation + (previously, crop LAI was near-zero for the first few years) + +=============================================================== +=============================================================== +Tag name: clm4_5_26 +Originator(s): muszala (Stefan Muszala) +Date: Thu Sep 19 17:07:11 MDT 2013 +One-line Summary: water balance and SMS_Ly1.f19_g16.ICLM45BGCCROP fix + +Purpose of changes: 1) Fix water balance error in f09_g16 I1850CRUCLM45BGC simulation + 2) Get all machine/compiler combinations of + SMS_Ly1.f19_g16.ICLM45BGCCROP working + - this fix required (1) and a fix to fthresh in RtmFloodInit + - new RTM tag rtm1_0_32 to go along with this + - PGI+frankfurt version of this test only work with 16 MPI processes + +Requirements for tag: N/A + +Test level of tag: regular + +Bugs fixed (include bugzilla ID):1808 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: S. Swenson, D. Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): rtm1_0_32 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Index: models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +=================================================================== +--- models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 (revision 51190) ++++ models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 (working copy) +@@ -1110,15 +1110,8 @@ + do j = 1, nlevsoi + if(h2osoi_liq(c,j)<0._r8)then + qflx_deficit(c) = qflx_deficit(c) - h2osoi_liq(c,j) +- h2osoi_liq(c,j) = 0._r8 + endif + enddo +- !reduce qcharge if necessary +- !ideally, I can set qflx_deficit as a local variable, but it is helpful +- !to diagnose the problem associated with the solver for the richards' equation. +- if(qflx_deficit(c)>0._r8)then +- qcharge(c) = qcharge(c) - qflx_deficit(c)/dtime +- endif + enddo + + end associate +@@ -1892,9 +1885,12 @@ + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) +- xs1(c) = max(max(h2osoi_liq(c,1),0._r8)-max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1))),0._r8) +- h2osoi_liq(c,1) = min(max(0._r8,pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)), h2osoi_liq(c,1)) + ++ !scs: watmin addition to fix water balance errors ++ xs1(c) = max(max(h2osoi_liq(c,1)-watmin,0._r8)- & ++ max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)-watmin)),0._r8) ++ h2osoi_liq(c,1) = h2osoi_liq(c,1) - xs1(c) ++ + if (urbpoi(clandunit(c))) then + qflx_rsub_sat(c) = xs1(c) / dtime + else + +CLM testing: + +- general note: for clm45 compsets-both clm and cpl history files change + +- specfic testing for these bug fixes: + +1) Water balance fix-ran a clone of run from Dave Lawrence: + -- create_newcase -compset I1850CRUCLM45BGC -res f09_g16 -mach yellowstone -case /glade/u/home/dlawren/expts/clm4.5/clm45bgc_1deg4519_1850spin_bd + -- this ran for over 25 years with no water balance errors. + +2) SMS_Ly1.f19_g16.ICLM45BGCCROP + +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_intel.clm-reduceOutput.115612 +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.yellowstone_pgi.clm-reduceOutput.115522 + +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_intel.clm-reduceOutput.115217 +PASS SMS_Ly1_Mmpich.f19_g16.ICLM45BGCCROP.frankfurt_nag.clm-reduceOutput.120824 +PASS SMS_Ly1.f19_g16.ICLM45BGCCROP.frankfurt_pgi.clm-reduceOutput.016 -- only with 16 MPI tasks + +3) To make sure the RTM refactor did not create any BFB changes, I ran SMS_D.f19_g16.ICLM45BGCCROP.yellowstone_intel + with rtm1_0_31 and rivrtm/branch_tags/bcf_tags/bcf_02_rtm1_0_31. + - With flood_mode='NULL' - Coupler and land history files were BFB. + - With flood_mode='ACTIVE' - Coupler, rtm and land history files were BFB. + + build-namelist tests: N/A + + regular tests (aux_clm): + + yellowstone_intel - OK - changes in cpl. hist files expected + yellowstone_pgi - OK - changes in cpl. hist files expected + frankfurt_intel - OK - changes in cpl. hist files expected + frankfurt_pgi - OK - changes in cpl. hist files expected + frankfurt_nag - OK - changes in cpl. hist files expected + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel - OK - changes in clm fields expected. + +CLM tag used for the baseline comparisons: clm4_5_25 + +Changes answers relative to baseline: Yes. For CLM45 compsets. All changes are from the SoilHydrology mods +as the RTM refactor and fthresh fix are BFB. + +Coupler history fields that change: + +l2x_Sl_avsdr, l2x_Sl_anidr, l2x_Sl_avsdf, l2x_Sl_anidf, l2x_Sl_tref, l2x_Sl_qref, +l2x_Sl_t, l2x_Sl_fv, l2x_Sl_ram1, l2x_Sl_snowh, l2x_Sl_u10, l2x_Fall_swnet, +l2x_Fall_taux, l2x_Fall_tauy, l2x_Fall_lat, l2x_Fall_sen, l2x_Fall_lwup, +l2x_Fall_evap, l2x_Fall_flxdst1, l2x_Fall_flxdst2, l2x_Fall_flxdst3, l2x_Fall_flxdst4, +l2x_Flrl_rofl, l2x_Fall_voc001, l2x_Fall_voc002, l2x_Fall_voc003, l2x_Fall_voc004, +l2x_Fall_voc005, l2x_Fall_voc006, l2x_Fall_voc007, l2x_Fall_voc008, x2l_Flrr_volr, +r2x_Forr_rofl, r2x_Forr_rofi, r2x_Flrr_volr, x2r_Flrl_rofl + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: CLM45 compsets + - what platforms/compilers: All + +=============================================================== +=============================================================== +Tag name: clm4_5_25 +Originator(s): erik (Erik Kluzek) +Date: Fri Sep 13 13:49:45 MDT 2013 +One-line Summary: Bring in Tony's changes to kick sno all the way up to the coupler layer, makes all + CESM components more similar to each other + +Purpose of changes: + Bring in Tony's cplupa branch (cplupa_n06_clm4_5_24) to trunk. This branch moves sno + fields all the way to the top coupler layer rather than being inside of CLM. This makes all + CESM components more similar to each other. + + There was also some small fixes on the side that allow some more tests to work. + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1789 (fix NoVSNoNI test) + 1788 (fix US-UMB test) + 1779 (fix RTM multi-instance) + 1777 (fix RTM branch cases) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add new CPP token to CLM USE_ESMF_METADATA (with no direct machanism to use) + We hate CPP tokens (but had to let this go, only needed by ESMF development folks) + +Describe any changes made to the namelist: drv namelist changes, no changes to CLM namelist + +List any changes to the defaults for the boundary datasets: CLM_USRDAT fsurdat files different directory for clm4_0 than clm4_5 + remove missing ne16np4 fpftdyn file + +Describe any substantial timing or memory changes: + +Code reviewed by: self, tcraig + +List any svn externals directories updated (csm_share, mct, etc.):, scripts, drv, cism, rtm, csm_share, data and stub models + + scripts to scripts4_130912 + drv to drvseq4_3_03 + datm to datm8_130424 + socn/sice/sglc/swav to stubs1_4_02 + rtm to rtm1_0_31 + cism to cism1_130905 + csm_share to share3_130906 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl ------------ Remove ne16 20thC test + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ---- Remove missing ne16 fpftdyn file + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Different directory for + clm4_0/clm4_5 surface datasets + + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Field names change + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ------ Remove "sno" and "s" fields + M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 ---- Remove rofi/rofl + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ---- Remove "sno" and "s" fields, add USE_ESMF_METADATA #ifdef + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 ----- Remove "sno" and "s" fields, add USE_ESMF_METADATA #ifdef + M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 ---- Remove rofi/rofl + +CLM testing: regular + + build-namelist tests: + + bluefire yes + frankfurt yes + + regular tests (aux_clm): + + yellowstone_intel yes + yellowstone_pgi yes + frankfurt_intel yes + frankfurt_pgi yes + frankfurt_nag yes + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel partial (not completed before tag made) + yellowstone_pgi partial (not completed before tag made) + +CLM tag used for the baseline comparisons: clm4_5_24 + +Changes answers relative to baseline: None (bit-for-bit) + + Although my "I compset" testing showed no changes, fully coupled changes + do show differences. Coupler namelists also change. + +=============================================================== +=============================================================== +Tag name: clm4_5_24 +Originator(s): sacks (sacks) +Date: Tue Sep 3 21:36:13 MDT 2013 +One-line Summary: update externals to cesm1_3_beta02 or later + +Purpose of changes: + +Update externals to cesm1_3_beta02 or later + + +Requirements for tag: + +Test level of tag: regular + +Bugs fixed (include bugzilla ID): 1722 (Test failure with VIC and more_vertlayers) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not investigated + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts : scripts4_130816 -> scripts4_130830a + Machines : Machines_130529 -> Machines_130830 + drv : drvseq4_2_33 -> drvseq4_2_35 + cism : cism1_130502 -> cism1_130624 + csm_share : share3_130528 -> share3_130723 + timing : timing_130417 -> timing_130506 + mct : compiler_fixes_n01_MCT_2.8.3 -> compiler_fixes_n03_MCT_2.8.3 + mapping : mapping_130509 -> mapping_130716 + gen_domain : mapping_130509/gen_domain_files -> mapping_130716/gen_domain_files + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove trailing whitespace +M .ChangeLog_template + + +Index: models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +=================================================================== +--- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (revision 50759) ++++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (working copy) +@@ -51,17 +51,14 @@ + + + use before define in history. runs with frankfurt_pgi, yellowstone_intel and yellowstone_pgi +- floating point exception. problem with VIC combined with vertical layers + once threading fixed, this should pass + once threading fixed, this should pass +- core dumps in ref1. Problems with vertical layers. Run without clm-vrtlay and clm-default and it runs + starting in clm4_5_07--The cpl.hi.nc file is not being copied on a generate like it should. + Cannot turn clm4me mode on -- without clm4_5 physics! problem in scripts4_130809b + + +- Problem with scripts and testId string length. This passes with a long testId ++ Problem with scripts and testId string length. This passes with a long testId + Restart not BFB. Runs as ERH_D.f19_g16.I1850CLM45CN.yellowstone_pgi +- floating point exception. problem with VIC combined with vertical layers + once threading fixed, this should pass + once threading fixed, this should pass + once threading fixed, this should pass +@@ -78,7 +75,7 @@ + Water balance errors followed by "negative conc. in ch4tran", then tries "-10^-12 < smin_nh4 < 0. resetting to zero.", then it exits at approximately 9 months. This same test passes with yellowstone_intel and frankfurt_intel + + +- CMake 2.8.6 or higher is required. You are running version 2.6.4 ++ Problem with cism build + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel, yellowstone_pgi, frankfurt_intel and frankfurt_nag + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel, yellowstone_pgi, frankfurt_intel and frankfurt_nag + Fails after reading clmforc.Li_2012_hdm_0.5x0.5_AVHRR_simyr1850-2010_c130401.nc. This same test passes with yellowstone_intel + + +CLM testing: + + build-namelist tests: + + yellowstone: YES + All PASS or xFAIL + + regular tests (aux_clm): + + yellowstone_intel: YES + yellowstone_pgi: YES + frankfurt_intel: YES + frankfurt_pgi: YES + frankfurt_nag: YES + + All PASS or xFAIL + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel: YES + All PASS except for the following newly-passing tests (for + which these failures are unsurprising): + + BFAIL2 ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h0 (baseline history file does not exist) + BFAIL2 ERI_D.ne30_g16.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h1 (baseline history file does not exist) + FAIL ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h0 + FAIL ERS_D.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_23.clm2.h1 + + yellowstone_pgi: YES + Some answer changes (presumably due to compiler change) + +CLM tag used for the baseline comparisons: clm4_5_23 + Note: renamed baselines for frankfurt nag because test names have changed + +Changes answers relative to baseline: YES + + If a tag changes answers relative to baseline comparison the + following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + compsets using cism change answers for g2x gields + + many tests change answers with pgi, both on yellowstone & + frankfurt, presumably due to new compiler + + nature of change not investigated + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_23 +Originator(s): muszala (Stefan Muszala) +Date: Thu Aug 22 09:42:43 MDT 2013 +One-line Summary: refactor to allow CH4 params. to be read from netcdf file and clean up clm4_5_20 + +Purpose of changes: + The second of two tags that brings in parameters that are read from netcdf file (ch4 parameters). Please + see the ChangeLog entry for clm4_5_20. + + - Bring in ch4 parameters + - Combine fconsts file and fpftcon file. New file name is paramfile (clm_params.c130821.nc) + - Refactor so that types, subroutine names and type instances have the names params in them (instead of consts) + - Remove many ch4 namelist vars. since they are now read from the param file + - Add new namelist called use_aereoxid_prog to control old aereoxid namelist + + A bulk of this work was completed by Rajendra Paudel. + +Requirements for tag: N/A + +Test level of tag: regular and build_namelist + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: remove many optional ch4 namelists. + add new namelist valled use_aereoxid_prog. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, dlawren, Rajendra Paudel + +List any svn externals directories updated (csm_share, mct, etc.): scripts4_130730 -> scripts4_130816 + +List all files eliminated: + +- these were renamed +models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 +models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 + +List all files added and what they do: + +- renamed +models/lnd/clm/src/clm4_5/biogeochem/CNSharedParamsMod.F90 +models/lnd/clm/src/clm4_5/main/readParamsMod.F90 + +List all existing files that have been modified, and describe the changes: + +- refactor to remove old namelist vars. for ch4 and add new functionality +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +- put in ch4 parameters and refactor const->params names +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 + +CLM testing: + + build-namelist tests: + + yellowstone: OK. Some changes to phys45 and phys45-crop. Should be OK in next tag. + + regular tests (aux_clm): A few nlcomp differences that will go away in the next tag. + Other than a few expected failures due to new scripts entries, all OK. + + yellowstone_intel OK + yellowstone_pgi OK + frankfurt_intel OK + frankfurt_pgi OK + frankfurt_nag OK + + history file comparison with component_gen_comp and summarize_cprnc_diffs: + + yellowstone_intel OK + yellowstone_pgi OK + +CLM tag used for the baseline comparisons: clm4_5_22 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_22 +Originator(s): muszala (Stefan Muszala) +Date: Tue Jul 30 15:22:51 MDT 2013 +One-line Summary: aux_clm testlist reorganization + +Purpose of changes: + + Reorganize all aux_clm tests and fix new failing tests. As part of + this, bring in a change from Maoyi for VIC w/vertical layers. + A few bug fixes to get new tests working. + Why did we do this? + + 1) better balance between frankfurt, yellowstone and various compilers + 2) faster turn around time for development + 3) make sure current science functionality is properly tested + 4) removed outdated / irrelevant tests + + Other points: + + 1) Introduce regular and short test list. Testing now can consist of: + + a) regular (must be run before handing off a tag to SEs and must be run + before committing a tag) + b) build_namelist (if namelists and/or build_system changed)) + c) tools (only if tools are modified and no CLM source is modified) + d) short (for use during development and in rare cases where only a small + change with known behavior is added ... eg. a minor bug fix) + e) doc (no source testing required) + + 2) PET tests will fail until threading is fixed in CLM + +Requirements for tag: N/A + +Test level of tag: regular. ran tests with old testlists to double check any new mods. + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: add no-vert:no-nitrif option to configure + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self. Extensive discussion regaring list content with Lawrence, + Sacks, Kluzek and Andre. + +List any svn externals directories updated (csm_share, mct, etc.): new scripts + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- add no-vert:no-nitrif option +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +- Update expected failures +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +- Maoyi VIC+vertical layers fix +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +- Update change log template +M .ChangeLog_template +- Change intent out to inout for ciso_flux +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +- Remove crop_prog check to get rid of unassociated pointer with NAG +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +- Fix bounds type error (should be intent=in) +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 + +Machines testing ran on: (Tests in priority order) + + Note: + + 1) All PET tests will fail until openMP is fixed. + 2) All IG compsets fail with the NAG compiler due to non-compliant f77 code. + 3) If one combination fails, it's backed up with a another combination that passes. + There are one or two exceptions to this. + + I) aux_clm tests with old testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + CESM history file comparison: + + yellowstone/aux_clm intel - OK + + II) aux_clm tests with new testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + III) aux_clm_short tests with new testlists: + + yellowstone/aux_clm intel - OK + yellowstone/aux_clm pgi - OK + frankfurt/aux_clm intel - OK + frankfurt/aux_clm pgi - OK + frankfurt/aux_clm nag - OK + + CESM history file comparison: Not run since no baseline comparisons. + +CLM tag used for the baseline comparison tests if applicable: CLM4_5_21 with old testlist. Only ran generate with new testlists. + +Changes answers relative to baseline: Only for VIC with vertical layers. + +=============================================================== +=============================================================== +Tag name: clm4_5_21 +Originator(s): muszala (Stefan Muszala) +Date: Wed Jul 24 14:23:19 MDT 2013 +One-line Summary: ifdef and bounds refactor + +Purpose of changes: +- Almost all implementation by Mvertens +- Refactor ifdef use so that a majority are now in controlMod.F90. This is the +first step to removing them competely. +- Introduction of bounds_type and clump_type +- Refactor interfaces to support bounds_type and clump_type +- Bug fix from Sacks + +Also: Changed layout of landunit, column and pft-level arrays: Previously, all +points for a given grid cell were grouped together. Now, all points for a given +landunit type are grouped together. This improves performance of loops over +filters, because it leads to more memory locality – this will be especially true +when we add more 0-weight points to arrays for the purpose of dynamic +landunits. For example, if a processor has 2 grid cells and there are 3 landunit +types: + +Old layout in memory: (G1L1, G1L2, G1L3, G2L1, G2L2, G2L3) +New layout in memory: (G1L1, G2L1, G1L2, G2L2, G1L3, G2L3) + + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: mvertens, sacks, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +D models/lnd/clm/src/util_share/decompInitMod.F90 +D models/lnd/clm/src/util_share/ndepStreamMod.F90 +D models/lnd/clm/src/util_share/decompMod.F90 +D models/lnd/clm/src/clm4_5/main/initParametersMod.F90 + +List all files added and what they do: + +A + models/lnd/clm/src/clm4_5/main/decompInitMod.F90 +A + models/lnd/clm/src/clm4_5/main/ndepStreamMod.F90 +A + models/lnd/clm/src/clm4_5/main/decompMod.F90 +A + models/lnd/clm/src/clm4_0/main/decompInitMod.F90 +A + models/lnd/clm/src/clm4_0/main/ndepStreamMod.F90 +A + models/lnd/clm/src/clm4_0/main/decompMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/doc/ChangeLog +M models/lnd/clm/doc/ChangeSum +M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/clm_varsur.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/QSatMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/main/controlMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_0/main/clm_driver.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: Not run + + CESM test lists: + + yellowstone/aux_clm intel BFB + yellowstone/aux_clm pgi BFB + frankfurt/aux_clm intel BFB + frankfurt/aux_clm pgi BFB + frankfurt/aux_clm nag BFB + + CESM history file comparison: + + yellowstone/aux_clm intel BFB + +CLM tag used for the baseline comparison tests if applicable: clm4_5_20 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_20 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Sat Jul 20 10:54:43 MDT 2013 +One-line Summary: refactor to allow CN and BGC params. to be read from netcdf file + +Purpose of changes: + +The first of two tags that allows all parameters to be read from a netcdf file to +provide sensitivity analysis capability, to increase modularity of code and to +remove "magic numbers" from code. This tag introduces a new namelist variable +"fconsts" which points to a netcdf file of CN and BGC parameters. In a future +tag, this netcdf file will be combined with CH4 parameters and PFT parameters. + +Values are read in readConstantsMod.F90. Each module that requires +a parameter provides a read subroutine. That read subroutine is called +from readConstantsMod.F90 and places parameters into a private type +for that module. For example, CNDecompMod.F90 provides readCNDecompConsts which +is called from readConstantsMod and populates the type instance CNConstShareInst. +CHConstShareInst is then used in CNDecompMod as: + ++ sminn_to_denit_decomp_cascade_vr(c,j,k) = -CNDecompConstInst%dnp * pmnf_decomp_cascade(c,j,k + +which replaces: + +- dnp = 0.01_r8 +... +- sminn_to_denit_decomp_cascade_vr(c,j,k) = -dnp * pmnf_decomp_cascade(c,j,k) + +A bulk of this work was completed by Rajendra Paudel. + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: new namelist variable called fconsts. + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, D. Lawrence, R. Paudel. (for design: discussion w/ mvertens, sacks, kluzek) + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +Renamed +D models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +D models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 + +List all files added and what they do: + +Rename of Deleted files +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeBGCMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeCNMod.F90 + +Module to read parameters shared by multiple modules +A + models/lnd/clm/src/clm4_5/biogeochem/CNSharedConstsMod.F90 + +Module that reads shared an private parameters +A + models/lnd/clm/src/clm4_5/main/readConstantsMod.F90 + +List all existing files that have been modified, and describe the changes: + +Add fconsts namelist variable +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +Add in functionality to read parameters off of netcdf file +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. These FAILs should pass next round: + + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + CESM test lists: + +CLM45 compsets have failures for nlcomp due to the introduction of fconsts namelist variable. +For example: + +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.test20Pgi.nlcomp +FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_intel.GC.test20Intel.nlcomp + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CLM history file comparison: + + yellowstone/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_19 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_19 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Wed Jul 17 14:29:32 MDT 2013 +One-line Summary: fix setting of bd in iniTimeConst + +Purpose of changes: + +In iniTimeConst, bd (bulk density) was being set incorrectly, so that, +for a given processor, the same value was being put in all (c,j) +locations. In addition to being incorrect, this meant that results +differed depending on processor count. This tag fixes this problem. + +This only affects CLM4.5 BGC runs, because the bd array is only used +in CNNitrifDenitrifMod.F90. (However, as a side note: This array +SHOULD be used in DUSTMod and initSLakeMod, which currently recompute +bd.) + + +Requirements for tag: + +Test level of tag: + +Bugs fixed (include bugzilla ID): + 1736 (bd set incorrectly in iniTimeConst, leads to results that depend on processor count) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: NO + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL1 except CLM45BGC comparisons + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_18 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: All CLM45BGC + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Larger than roundoff; still to be determined if this gives new + climate (Dave Lawrence will run a simulation to determine this) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: (Not yet done) + + URL for LMWG diagnostics output used to validate new climate: (Not + yet done) + +=============================================================== +=============================================================== +Tag name: clm4_5_18 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jul 9 10:07:08 MDT 2013 +One-line Summary: rework urban indexing + +Purpose of changes: + +Change urban derived type and local variables in UrbanMod subroutines to go +lbl:ubl rather than 1:num_urbanl. There are a few reasons for this: (1) this +works better when the urban filter can change (with dynamic landunits), (2) more +consistency with the rest of the CLM code, (3) no longer have to remember +whether a given variable should be indexed by fl or l. The downside is that it +leads to slightly greater memory use. + +Along with doing this, I also changed a few loops in UrbanMod to be simpler +(which is allowed with the above change). + +Also, no longer run over 0-weight urban columns - we don't have to do this any +more now that I have reworked some loops in UrbanMod. + + +Requirements for tag: + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + + Increase in memory use by UrbanMod, which should lead to a small overall + memory increase - though this doesn't show up in most memcomp tests, showing + that the increase is pretty small. + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Major changes to indexing: local variables now dimensioned lbl:ubl + rather than 1:num_urbanl. Also, remove canyon_hwr, wtroad_perv, + ht_roof and wtlunit_roof from urban_params, because there are + duplicate variables in clmtype. +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= No longer make 0-weight urban columns active +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Remove unused wind_hgt_canyon from clmtype +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 + +========= Minor changes for new UrbanMod interfaces +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: NO + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes ** + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS, except the following, which appears to be a system problem: + FAIL ERI_D.f19_g16.ICLM45.frankfurt_pgi.GC.214513 + I will rerun the above test once the system problem is resolved + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL, except the following expected failures: + + *** Expected failures because of failures in the base tests + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_Ld211_D_P112x1.f10_f10.ICNCROP.yellowstone_intel.clm-crop.compare_hist.clm4_5_17.clm2.h0 (no history file in test case) + + *** Expected differences in cols1d_active and pfts1d_active, as well as + FILLDIFFs, due to making 0-weight urban columns no longer active + FAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set2_ciso.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set3_pftroot.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_17.clm2.h1 + + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_17 + +Changes answers relative to baseline: NO, except for inconsequential changes in +1-d hist files (cols1d_active, pfts1d_active, and some FILLDIFFS, due to making +0-weight urban columns no longer active) + +=============================================================== +=============================================================== +Tag name: clm4_5_17 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Wed Jul 3 10:54:03 MDT 2013 +One-line Summary: misc cleanup and bug fixes + +Purpose of changes: + +Bit-for-bit cleanup following from tag clm4_5_11. The biggest change is the +removal of maxpatch, npatch_* and some related variables from clm_varpar (these +were maintenance headaches). + + +Requirements for tag: + +Test level of tag: standard + tools + +Bugs fixed (include bugzilla ID): + + 1747 (need 1x1_tropicAtl datasets) + 1754 (mksurfdata_map problem making CH4 parameters for ne240 CLM4.5 surface dataset) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New 1x1_tropicAtl datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Remove maxpatch, npatch_* and a few related variables that are no + longer needed (these variables were a maintenance headache) +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +========= Rework code to not require the variables that were removed from clm_varpar +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 + +========= Remove unneeded 'use' statements +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 + +========= Allow roundoff-level errors (needed to make ne240 dataset) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 + +========= Fix generation of 1x1_tropicAtl datasets +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + +========= New 1x1_tropicAtl datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/aux_clm intel yes *** + All PASS or xFAIL + yellowstone/aux_clm pgi yes ** + All PASS + frankfurt/aux_clm intel yes ** + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + Additional tests (with comparison to clm4_5_16, including + component_gen_comp; for the FARM test, used a sandbox corresponding to + cesm1_3_alpha01a for components other than CLM): + + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial + SMS.T42_T42.FARM95C4.yellowstone_intel.clm-daily + [the clm-daily nl dir just sets hist_nhtfrq = -24] + + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes ** + All PASS or BFAIL1, except irrelevant failures from this failing test: + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_16.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_16.clm2.h1 + + test_driver.sh tools testing: + + yellowstone interactive: yes + All PASS except expected failures: + + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............\c + rc=4 FAIL + + + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_16 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_16 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jul 2 09:22:41 MDT 2013 +One-line Summary: only run filters over 'active' points + +Purpose of changes: + +In preparation for dynamic landunits, we only want to run most filters over +'active' points. This required changing landunit and column-level filters to +only run over active points. In addition, I changed the nourbanp filter to only +run over active points (in contrast to other pft-level filters, this filter had +previously operated over non-active points, too). + +In addition, this tag includes some related changes, most of which were required +to get the code to run correctly in light of the above changes. Some of these +changes - in particular, the changes to reweightMod, filterMod, and the use of +the new filter_inactive_and_active in some places - effectively undid that +general filter change for select landunits (urban) or subroutine calls. + + +Requirements for tag: + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: changes to filterMod reviewed by erik, mvertens, + stefan, dave lawrence & ben andre; other changes + only by self + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +========= Change main filters to just run over active points; add new filters + that include inactive as well as active points; refactor subroutines + to avoid code duplication now that we have two groups of filters +M models/lnd/clm/src/clm4_5/main/filterMod.F90 + +========= Change filter to just run over active points +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 + +========= Change urban columns & pfts to be active whenever their landunit is + active (to avoid making urban code messier) +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Get rid of wt > 0 checks, which are no longer appropriate in the code + (checks of the active flags should be done instead - and these have + been folded in to the filters) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= Make a loop more consistent in its use of a filter; remove undesirable + pactive check (because decomp_vertprofiles now sometimes operates on + inactive as well as active points) +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 + +========= Use filters that include inactive points in call to + decomp_vertprofiles (this is needed because of the unusual placement + of this routine in the driver sequence) +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Use filters that include inactive points in calls to SurfaceAlbedo and + UrbanAlbedo. For SurfaceAlbedo, this is necessary to avoid floating + point exceptions in transient cases; for UrbanAlbedo, this probably + isn't necessary now, but likely will be needed when we have dynamic + landunits, for the same reason that we need it for SurfaceAlbedo. +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 + +========= Remove pactive check in setting up vegsol / novegsol filters - as far + as I can tell, this check is now unnecessary, and it led to the odd + result that novegsol included all inactive points (e.g., even inactive + istsoil points). Also add some comments and remove some obsolete + comments. +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 + +========= Remove pactive checks that are unnecessary now that the nourbanp + definition has changed +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 + +========= Only check errsoi_col on active columns (to prevent NaN-related + problems in crop runs) +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 + +========= Add comments +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 + + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/aux_clm intel yes + All PASS or xFail + + Also ran the following, which PASSes (also PASSes cpl & clm + hist comparisons, except for expected failures in .h1 file + comparisons, as below): + ERS_Ly5.f10_f10.I20TRCRUCLM45BGC.yellowstone_intel.clm-monthly_noinitial + + yellowstone/aux_clm pgi yes + All PASS + + frankfurt/aux_clm intel yes + All PASS + frankfurt/aux_clm pgi yes + All PASS + frankfurt/aux_clm nag yes + All PASS + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + All PASS, except: + *** Irrelevant, because this test fails + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h0 + FAIL ERS.f09_g16.ICLM45VIC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h1 + + *** Expected diffs in h1 files: differences in cols1d_active, + pfts1d_active, and related FILLDIFFs in a number of variables + FAIL ERI_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-vrtlay.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set2_ciso.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f10_f10.ICLM45BGC.yellowstone_intel.clm-ch4_set3_pftroot.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS.f19_g16.ICRUCLM45BGCCROP.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + FAIL SSP.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.compare_hist.clm4_5_15.clm2.h1 + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_15 + +Changes answers relative to baseline: NO, except for changes in fill +patterns & active flags in 1-d hist files, as noted above + +=============================================================== +=============================================================== +Tag name: clm4_5_15 +Originator(s): muszala (Stefan Muszala) +Date: Mon Jul 1 10:44:05 MDT 2013 +One-line Summary: complete associate refactor for pointers in clm4_5 source + +Purpose of changes: Refactor all clm4_5 source so that pointers assignements are + placed in associate blocks at the start of a subroutine. This allows us to + get rid of pointer declarations, makes the code easier to modify, makes the + code more robust and sets us up for future interface refactorings. The refactor is + explained in more detail in models/lnd/clm/tools/clm4_5/refactorTools/README. + +- real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) +- fdry => pps%fdry ++ associate(& ++ fdry => pps%fdry & ! Output: [real(r8) (:)] fraction of foliage that is green and dry [-] (new) ++ ) + ... +- end subroutine FracWet ++ end associate ++ end subroutine FracWet + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: BGC compsets will see increases + in memory (highwater) use. This can be seen in memcomp portions of testing with + one specific example. Something to keep track of. + + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.clm-default.GC.4515preIntel.memcomp.clm4_5_14 + - highwater goes from 166 MB in clm4_5_14 to 236 MB in clm4_5_15 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOff.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOff.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOn.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnIceOn.GC.4515preIntel.memcomp.clm4_5_14 + FAIL ERS.f19_g16_r01.I1850CLM45BGC.yellowstone_intel.rtm-rtmOnFloodOnEffvelOff.GC.4515preIntel.memcomp.clm4_5_14 + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + +A models/lnd/clm/tools/clm4_5/refactorTools/associate/refactor_new.pl +A models/lnd/clm/tools/clm4_5/refactorTools/associate/README + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + + yellowstone/aux_clm OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_14 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_14 +Originator(s): muszala (Stefan Muszala) +Date: Thu Jun 20 07:51:54 MDT 2013 +One-line Summary: preparation for associate refactor in clm4_5_15 + +Purpose of changes: + Most work by mvertens. + - prep. work for modifying associate + - refactor subgridAveMod.F90 to accept upper and lower bounds + - remove duplicate pointer uses + - remove inicPerpMod.F90 and is_perpetual use + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: + +D models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. Fixed generate numbering. + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_13 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_13 +Originator(s): andre (Benjamin Andre,LAWRENCE BERKELEY NATIONAL LABORATORY,510-486-4617) +Date: Fri Jun 14 15:01:33 MDT 2013 +One-line Summary: hydrology reordering from Jinyun Tang + +Purpose of changes: + reordering the operations of the hydrology. hydrology with and without drainage + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Jinyun Tang, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 - splits out leaching + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 - add icefrac and qflx_deficit + M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 - update calls to CNEcosystemDyn + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 - update calls to CNEcosystemDyn and Hydrology + M models/lnd/clm/src/clm4_5/main/clmtype.F90 - add icefrac and qflx_deficit + M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 - splits out drainage calculations + M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 - calculate water table before subsurface drainage, icefraction, water deficit + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes/no *** + + CESM test lists: + + yellowstone/aux_clm intel yes OK + yellowstone/aux_clm pgi yes OK + frankfurt/aux_clm intel no + frankfurt/aux_clm pgi no + frankfurt/aux_clm nag no + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + test_driver.sh tools testing: N/A + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_12 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: all clm 4.5 with hydrology + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + + casename: ERS_D.f19_g16.ICLM45 - an 11-year base line simulation + was created with the standard trunk version, then a comparison run + was created with the version including hydrology re-ordering. The + comparisons were evaluated by looking at the relative differences + for hydrologic variables as QDRAI, EFLX_LH_TOT, QRUNOFF. Large + relative differences were found for these variables in a few grid + cells, but their absolute magnitudes in those grid cells were + small. Tests were also conducted with VIC hydrology on, the + change in results were similar as that when VIC hydrology was off. + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_5_12 +Originator(s): muszala (Stefan Muszala) +Date: Thu Jun 13 09:41:56 MDT 2013 +One-line Summary: NoVS test, NAG mods and remove TWS from restart file + +Purpose of changes: + + -Fix (from jedwards) for ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit test + Previous tags using ICLM45BGCNoVS are suspect! + -Since I tested this with NAG there are also port mods to CLM that I had to put in. + -Remove TWS from BiogeophysRestMod.F90 per sacks request. OK'd by swenson. + -Update to rtm1_0_29 + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): 1746 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, NoVs error: Charlie Koven and jedwards + +List any svn externals directories updated (csm_share, mct, etc.): rtm1_0_28 -> rtm1_0_29 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-NoVS fix and NAG mods +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +-Nag mods +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +-remove TWS from restart +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +-update to rtm1_0_29 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel OK. The only differences are in ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit. + These are expected due to the fix in ch4Mod.F90. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_11 + +Changes answers relative to baseline: Only for ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit. Previous + versions of this compset should be considered suspect. Fields that change (119 in total) for this test are: + + ACTUAL_IMMOB, CH4STRESS_SAT, CH4STRESS_UNSAT, CH4_AERE_DEPTH_SAT, CH4_AERE_DEPTH_UNSAT, CH4_EBUL_DEPTH_SAT, + CH4_OXID_DEPTH_SAT, CH4_OXID_DEPTH_UNSAT, CH4_PROD_DEPTH_SAT, CH4_SURF_AERE_SAT, CH4_SURF_AERE_UNSAT, + CH4_SURF_DIFF_SAT, CH4_SURF_DIFF_UNSAT, CH4_SURF_EBUL_SAT, CH4_TRAN_DEPTH_SAT, CH4_TRAN_DEPTH_UNSAT, + COL_CTRUNC, COL_NTRUNC, CONC_CH4_SAT, CONC_CH4_UNSAT, CONC_O2_SAT, CONC_O2_UNSAT, CWDC, CWDC_LOSS, + CWDC_TO_LITR2C, CWDC_TO_LITR3C, CWDN, CWDN_TO_LITR2N, CWDN_TO_LITR3N, DENIT, ER, FCH4, FCH4TOCO2, + FUELC, F_DENIT, F_N2O_DENIT, F_N2O_NIT, F_NIT, GROSS_NMIN, HR, LAND_UPTAKE, LITHR, LITR1C, LITR1C_TO_SOIL1C, + LITR1N, LITR1N_TO_SOIL1N, LITR1_HR, LITR2C, LITR2C_TO_SOIL1C, LITR2N, LITR2N_TO_SOIL1N, LITR2_HR, LITR3C, + LITR3C_TO_SOIL2C, LITR3N, LITR3N_TO_SOIL2N, LITR3_HR, LITTERC, LITTERC_HR, LITTERC_LOSS, NBP, NEE, NEM, NEP, + NET_NMIN, O2STRESS_SAT, O2_AERE_DEPTH_SAT, O2_DECOMP_DEPTH_SAT, O2_DECOMP_DEPTH_UNSAT, POTENTIAL_IMMOB, + POT_F_DENIT, POT_F_NIT, SMINN_TO_SOIL1N_L1, SMINN_TO_SOIL1N_L2, SMINN_TO_SOIL1N_S2, SMINN_TO_SOIL1N_S3, + SMINN_TO_SOIL2N_L3, SMINN_TO_SOIL2N_S1, SMINN_TO_SOIL3N_S1, SMINN_TO_SOIL3N_S2, SMIN_NH4, SMIN_NO3, + SMIN_NO3_LEACHED, SOIL1C, SOIL1C_TO_SOIL2C, SOIL1C_TO_SOIL3C, SOIL1N, SOIL1N_TO_SOIL2N, SOIL1N_TO_SOIL3N, + SOIL1_HR_S2, SOIL1_HR_S3, SOIL2C, SOIL2C_TO_SOIL1C, SOIL2C_TO_SOIL3C, SOIL2N, SOIL2N_TO_SOIL1N, + SOIL2N_TO_SOIL3N, SOIL2_HR_S1, SOIL2_HR_S3, SOIL3C, SOIL3C_TO_SOIL1C, SOIL3N, SOIL3N_TO_SOIL1N, SOIL3_HR, + SOILC, SOILC_HR, SOILC_LOSS, SOMHR, SR, TOTCOLC, TOTCOLCH4, TOTCOLN, TOTECOSYSC, TOTECOSYSN, TOTLITC, TOTLITN, + TOTSOMC, TOTSOMN + +=============================================================== +=============================================================== +Tag name: clm4_5_11 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Jun 11 20:54:11 MDT 2013 +One-line Summary: Change pct_pft and related surface dataset variables to be % of landunit + +Purpose of changes: + +Main purpose is to change pct_pft and related surface dataset variables to be % +of landunit rather than % of grid cell. This is needed to support transient PFTs +with dynamic landunits. This required substantial changes in both mksurfdata_map +and CLM. This also required generating all new surface datasets. + +A very related change is the separation of PCT_PFT in the surface dataset into +PCT_NAT_PFT and PCT_CFT; in addition to these two variables, there are also new +PCT_NATVEG (% of natural veg landunit on the gridcell) and PCT_CROP (% of crop +landunit on the gridcell) variables. Note that the separation of PCT_PFT into +natural vs crop was only done on the surface dataset -- raw datasets to +mksurfdata_map have not been changed, nor have most of the CLM data structures. + +In addition, this tag includes the following: + +(1) Renumbered landunits to (a) add separate landunit numbers for each urban +landunit, (b) do away with the obsolete shallow lake, and (c) group together +similar landunits + +(2) In any urban landunit, allocate space for ALL urban columns. Previously, +there were some urban landunits with only one of the two road types. This change +simplifies the code and only adds a relatively small number of columns in memory. + +(3) Modified interpinic, partly to have compatibility with (1), partly to fix +urban bug (allowed by (1)), and partly to fix an unrelated bug + +(4) All new initial conditions for CLM4.5, to have compatibility with (1) and (2) + +(5) Check _OPENMP in initialization rather than driver + +(6) Tighten error check in reweightMod: checkWeights. It seems like this error +check can be stricter with the new pct_pft formulation + + +Requirements for tag: Standard test + tools + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1621 (normalization issue in ne120np4 datasets and in CLM) + 1675 (need to relax error tolerance in reweightMod: weightsOkay) -- note + that I have actually TIGHTENED the tolerance, but that seems to be + okay now + 1702- PARTIAL FIX (clm4.5 interpinic doesn't work right for urban) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1747 - need 1x1_tropicAtl surface dataset and pftdyn dataset for clm4_5_11 and later + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Changes to fsurdat and finidat for +CLM4.5, as described below + +List any changes to the defaults for the boundary datasets: + + For CLM4.5, all surface datasets and initial conditions files have been + recreated. For surface datasets, changes result in only roundoff-level + differences in the pct_* fields. For initial conditions, the new initial + conditions are effectively the same as the old, but bugs in interpinic + prevent them from being exactly the same. + +Describe any substantial timing or memory changes: + + Slight (probably < 1%) increase in memory for all CLM4.5 cases, due to + allocation of ALL urban columns wherever there is an urban landunit + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): NONE + +List all files eliminated: + +========= Remove unneeded modules (iulog moved to fileutils.F90) +D models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varpar.F90 +D models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varctl.F90 + +========= Now differs for clm4_0 and clm4_5, so copied to those two places +D models/lnd/clm/src/util_share/clm_varsur.F90 + +========= Replaced with new file for testing interpinic +D models/lnd/clm/tools/clm4_5/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c121113.nc + + +List all files added and what they do: + +========= New file for testing interpinic +A models/lnd/clm/tools/clm4_5/interpinic/clmi.I2000CLM45BGC.2000-01-01.10x15_simyr2000_c130607.nc + +========= Add tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkpftMod.F90 + +========= Moved from util_share +A models/lnd/clm/src/clm4_0/main/clm_varsur.F90 + +========= Moved from util_share, and modified extensively to support new surface + dataset format +A models/lnd/clm/src/clm4_5/main/clm_varsur.F90 + +========= Add module to do some initialization that doesn't fit well elsewhere, + and/or can't go elsewhere because of circular dependencies +A models/lnd/clm/src/clm4_5/main/initParametersMod.F90 + + +List all existing files that have been modified, and describe the changes: + +========= Change pct_pft and related variables on surface dataset to be % of + landunit; this requires significant changes for mkpftMod, mkglcmecMod + and the error checks / corrections done in mksurfdat.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/fileutils.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Add tests +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 + +========= Update crop landunit numbering, fix urban bug for column-level + variables, take code out of a conditional to prevent floating point + exceptions +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + +========= New files for testing interpinic +M models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions + +========= Change landunit and column numbering; delete udenstype +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 + +========= Add variables for determining number of natural & crop PFTs +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +========= Major changes to handle pct_pft being specified as % of landunit + rather than % of gridcell +M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +========= Initialize new surface variables, check _OPENMP here instead of driver +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 + +========= Update comments, remove udenstype +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +========= Change 'use' statements, use ltype instead of udenstype, fix + initialization for 0-weight columns +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 + +========= Add some consistency checks (moved here from clmtypeInitMod), change others +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 + +========= Change 'use' statements; use urbpoi rather than isturb; remove + references to 'istslak' +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + -- also, remove udenstype, and move some consistency checks elsewhere +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/restFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + -- also, move _OPENMP check to initialization +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 + +========= Tighten tolerance for error check +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +========= Use 'crop_prog' rather than the CROP CPP def +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 + +========= New surface datasets and initial conditions +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +========= Change environment variable in component_gen_comp command to something universal +M .ChangeLog_template + +========= Restore a failing test (see bug 1658) +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + All PASS or xFail except for the following expected baseline failures: + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + + CESM test lists: + + yellowstone/aux_clm intel yes + Tests themselves: All PASS or xFail, except + ERB.ne30_g16.I_1948-2004.yellowstone_intel, which I have re-added to the + xFail list (see bugz 1658) + + Comparisons: Some nlcomp and compare_hist failures, as expected + + yellowstone/aux_clm pgi yes + All PASS or xFail except for some nlcomp & compare_hist failures (expected) + + frankfurt/aux_clm intel yes + All PASS or xFail except for some nlcomp & compare_hist failures (expected) + + frankfurt/aux_clm pgi NO + + frankfurt/aux_clm nag yes + All PASS or xFail except for nlcomp failures (expected) + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $CESMDATAROOT/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + + Some compare_hist failures for CLM4.5 tests, as expected + + test_driver.sh tools testing: + + yellowstone interactive: yes + All PASS except for expected baseline failures: + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................rc=7 FAIL + 016 blh54 TBLtools.sh clm4_5 interpinic tools__ds runoptions ....................................rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_rc=7 FAIL + + and expected failures: + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional .............rc=4 FAIL + + + frankfurt interactive: NO + + yellowstone/PTCLM: NO + +CLM tag used for the baseline comparison tests if applicable: clm4_5_10 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in (otherwise remove this section): + + Summarize any changes to answers, i.e., + - what code configurations: Changes in all CLM4.5 configurations. See below + for details + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Mostly roundoff, but some larger than roundoff -- see below for details. + + Changes are limited to CLM4.5. Where the below notes refer to "all + configurations", this is really limited to CLM4.5 configurations. + + For all configurations, there are roundoff-level changes due to + roundoff-level differences in subgrid weights. These changes can quickly + grow to greater than roundoff (which I believe is due to nonlinear + feedbacks with snow variables), but as described below, I have verified + that the root cause of differences is this roundoff-level change. + + For cases that use initial conditions, where these initial conditions were + previously interpinic'ed, there are greater-than-roundoff level changes + due to various bugs and limitations of interpinic (for example, some + fields, like tsai, are skipped). I took pains to ensure that, for cases + using original (non-interpinic'ed) initial conditions in clm4_5_10 and + prior, the new initial conditions are nearly identical to the old (but not + entirely identical, due to bug 1702 - see comment 2); this applies to most + f09 initial conditions. However, this was not practical for cases that + used interpinic'ed files; this applies to f19, ne30 and hcru initial + conditions, as well as f09 BGCDV initial conditions. So for this latter + set of cases, there can be large differences from clm4_5_10, especially at + the start of the simulation. + + There are also greater than roundoff-level changes for some glc_mec + virtual columns, because we now use information on topo_glc_mec whenever + we can. + + There are also greater than roundoff-level changes in subgrid weights in + virtual (0-weight) glc_mec and crop landunits, now that we no longer use + arbitrary subgrid weights there; I don't think this will affect anything + important, though. + + Some tests that exhibited larger-than-usual changes from baseline, in cpl + hist and/or clm hist files, were the following (ignoring changes that can + be explained by the above notes): + + ERS_Lm3.f19_g16.IGRCP60CLM45CN.yellowstone_intel + ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel.clm-glcMEC + ERS_D.f10_f10.ICLM45BGCNoVS.yellowstone_intel.clm-rootlit + ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel.clm-default + + From these results, it seems that large changes may occur more often in + glc_mec runs, even above and beyond the virtual column changes that are + expected, as noted above. + + For the four above tests, I verified that differences were attributable to + the roundoff-level changes in subgrid weights, using the procedure + documented below. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + In order to confirm that answers only differed by roundoff, I ran 7 + additional tests (these tests all had nl_dirs, but that was not central to + these tests, so I'm not listing them here): + + SMS_Lm1.f19_g16.I_1850_CLM45_BGC + SMS_Ly2.T31_g37.IG1850CLM45CN + SMS_Ly5.T31_g37.I20TRCRUCLM45BGC + SMS_Ly5.T31_g37.ICLM45BGCDV + SMS_Ly5.T31_g37.I_2000_CLM45_BGC + SMS_Ly5.f10_f10.ICLM45BGCDVCROP + SMS_Ly5.f10_f10.I_2000_CLM45_BGC_CROP + + Each test was done as follows: + + (1) Created baselines from clm4_5_04 + + (2) Ran tests from a branch (allocate_all_urban_cols), where all I changed + from the baseline was (a) wherever we have an urban landunit, create ALL + urban landunits, and (b) for f19, change finidat files to use a new, + interpinic'ed file based on the original. Confirmed that this was bfb with + (1) except for (a) 1-d history files (now have extra urban columns), and + (b) any CLM4.5 test that uses initial conditions, since interpinic is + currently broken for urban. + + Side-note: I actually confirmed bfb behavior for the full yellowstone + aux_clm test suite, in addition to the above 7 tests + + This extra branch was necessary because I cannot compare 1-d history files + directly between my main branch and the trunk, because of the extra urban + columns present in the new code. + + + (3) Ran these 7 tests from my main branch, off of clm4_5_04, comparing + with (2). For this comparison, I only confirmed that the subgrid weights + were the same within roundoff (up to about 1e-12 differences for the + transient case; smaller for other cases). Note that greater than + roundoff-level changes are seen in many other fields, presumably because + small differences in subgrid pft weights can cause differences in how + variables are averaged from pft to column. This, in turn, can lead to + larger changes due to nonlinearities in the system (e.g., snow). The + following steps were taken to confirm that other differences between my + branch and the trunk were only due to these small differences in subgrid + weights. + + That is, I am confirming that: + (a) the only differences in the branch are subgrid weights + (b) these subgrid weights only differ by roundoff + + + (4) Reran (2), but with extra code to write out subgrid weights (including + writing these weights at every time step for pftdyn) -- from branch + allocate_all_urban_cols_writeWeights + + (5) Reran (3), but with extra code to read the subgrid weights written in + (4). Confirmed that, with this one-off, my branch was bfb with (4). + + +=============================================================== +=============================================================== +Tag name: clm4_5_10 +Originator(s): muszala (Stefan Muszala) +Date: Mon Jun 10 13:10:31 MDT 2013 +One-line Summary: refactor clmtype + +Purpose of changes: Refactor clmtype so that there is only one level of indirection. + + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & +- ptr_pft=clm3%g%l%c%p%pef%sfc_frc_oc, set_urb=spval) ++ ptr_pft=pef%sfc_frc_oc, set_urb=spval) + +There is a README (with more detailed information) and a script to help with future merges in: + + models/lnd/clm/tools/clm4_5/refactorTools/clmType/{README & renameClmType.pl} + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: + +- script and README for refactoring clmType +A models/lnd/clm/tools/clm4_5/refactorTools +A models/lnd/clm/tools/clm4_5/refactorTools/associate +A models/lnd/clm/tools/clm4_5/refactorTools/clmType +A models/lnd/clm/tools/clm4_5/refactorTools/clmType/renameClmType.pl +A models/lnd/clm/tools/clm4_5/refactorTools/clmType/README + +List all existing files that have been modified, and describe the changes: + +- major refactor in these to flatten clmtype +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 + +- change derived type access to match those of clmtype +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +M models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +M models/lnd/clm/src/clm4_5/main/reweightMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + + CESM history file comparison: + + yellowstone/aux_clm intel + +CLM tag used for the baseline comparison tests if applicable: clm4_5_09 + +Changes answers relative to baseline: No. Everything in this refactor should be BFB. + +=============================================================== +=============================================================== +Tag name: clm4_5_09 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Jun 4 15:59:07 MDT 2013 +One-line Summary: volr and vic fix, update mct and rtm + +Purpose of changes: add volr area correction, minor vic fix from maoyi, update mct and + rtm externals + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, swenson + +List any svn externals directories updated (csm_share, mct, etc.): +-models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_27 ++models/rof/rtm https://svn-ccsm-models.cgd.ucar.edu/rivrtm/trunk_tags/rtm1_0_28 + +-models/utils/mct https://github.com/MCSclimate/MCT/tags/MCT_2.8.3 ++models/utils/mct https://github.com/quantheory/MCT/tags/compiler_fixes_n01_MCT_2.8.3 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +- fix for VIC hydrology +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +- volr area correction +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +- mct and rtm update +M SVN_EXTERNAL_DIRECTORIES +- clean up +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK + yellowstone/aux_clm pgi OK + frankfurt/aux_clm intel OK + frankfurt/aux_clm pgi OK + frankfurt/aux_clm nag OK + +CLM tag used for the baseline comparison tests if applicable: clm4_5_08 + +Changes answers relative to baseline: only for VIC compsets. VOLR diagnostic changes. + +=============================================================== +=============================================================== +Tag name: clm4_5_08 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Jun 3 13:29:30 MDT 2013 +One-line Summary: port for NAG compiler + +Purpose of changes: Bring in Sean Santos mods, port clm4_5 and test with the NAG compiler on Frankfurt. + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): 1721 - Jim Edwards fixed problem in PIO + +Known bugs (include bugzilla ID): 1722 - Error in some VIC tests starting in clm4_5_07 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Santos + +List any svn externals directories updated (csm_share, mct, etc.): PIO - update to pio1_7_2 + +List all files eliminated: + +D models/lnd/clm/src/util_share/nanMod.F90 + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +M models/lnd/clm/src/util_share/clm_time_manager.F90 +M models/lnd/clm/src/util_share/accumulMod.F90 +M models/lnd/clm/src/util_share/ndepStreamMod.F90 +M models/lnd/clm/src/util_share/ncdio_pio.F90 +M models/lnd/clm/src/util_share/spmdMod.F90 +M models/lnd/clm/src/util_share/domainMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +M models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_5/main/subgridMod.F90 +M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CropRestMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/clm4_0/biogeochem/CNDVEstablishmentMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_glclnd.F90 +M models/lnd/clm/src/clm4_0/main/subgridMod.F90 +M models/lnd/clm/src/clm4_0/main/accFldsMod.F90 +M models/lnd/clm/src/clm4_0/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_0/main/pftvarcon.F90 +M models/lnd/clm/src/clm4_0/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_0/main/histFileMod.F90 +M models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M models/lnd/clm/src/clm4_0/biogeophys/SNICARMod.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: - OK. + + yellowstone/aux_clm intel - OK. + yellowstone/aux_clm pgi - OK. + One BFAIL for hcru_hcru which should pass next time around. Bug fixed when upgrading to pio1_7_2. + BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.08testPgi.compare_hist.clm4_5_07 + frankfurt/aux_clm intel - OK. + frankfurt/aux_clm pgi - OK. + frankfurt/aux_clm nag - OK. No baselines to compare against. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_07 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_07 +Originator(s): erik (Erik Kluzek) +Date: Fri May 31 02:49:45 MDT 2013 +One-line Summary: New spinup files for CLM45 AND RTM, work on PTCLM, turn drydep off by default, update externals + +Purpose of changes: + + Bring in new spinup finidat files (f09_g16@1850 for SP and BGC). interpinic to 2deg, hcru_hcru and ne30. + New spinup finidat files for BGCCROP and BGCDV (f19 and f09 respectively) + New spinup finidat files for 2000 (f09_g16 for SP and BGC) + Update RTM to bring in finidat_rtm files for either 1850 or 2000. + Update scripts, Machines, pio + scripts includes update for CLM40CRU hybrid startup + Turn drydep namelist off by default + Do a lot of work on getting PTCLM working and tools working for single-point. + +Requirements for tag: + New spinup files, fix bugs: 1708, 1700 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1715 (rmdups.ncl fails for no-overlap case) + 1714 (mkscripgrid.ncl doesn't calculate corners correctly.) + 1708 (Need Initial conditions for RTM) + 1706 (VIC tests fail) + 1700 (Memory leak in MPI layer on yellowstone) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: drydep namelist now OFF by default + +List any changes to the defaults for the boundary datasets: New initial conditions + Native initial conditions for f09 for: + I1850CLM45SP, I1850CLM45BGC, ICLM45SP, ICLM45BGC + Interpinic for: + I1850CLM45 & I1850CLM45BGC: f19, hcru_hcru, ne30 + ICLM45BGCCROP @ f19 + ICLM45BGCDB @ f09 + + ALSO NOTE THAT NOW RTM HAS INITIAL CONDITIONS FOR R05 -- SO RIVERFLOW CHANGES + FOR BOTH CLM45 AND CLM40 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): many + csm_share, pio, scripts, Machines, RTM, cprnc, mapping + + + scripts to scripts4_130529 (update PTCLM, send simyr to RTM, new IC for CLM40CRUCN) + csm_share to share3_130528 + rtm to rtm1_0_27 (Set startup initial condition files by -simyr flag) + Machines to Machines_130529 (Set hcru_hcru PE-layout, and PE-layout on yellowstone for f09 I cases) + pio to pio1_7_1 + cprnc to cprnc_130425 + mapping to mapping_130509 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/tools/TBLCFGtools.sh --- Correctly point to TSMCFGtools rather than TSMtools.sh. + + M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl - Add -usr_mapdir option + + M models/lnd/clm/tools/shared/mkmapdata/rmdups.ncl ------ Exit early if n_s==0 + M models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh ---- Skip if file already exists, give + directory for rmdups.ncl + M models/lnd/clm/tools/shared/mkmapdata/mknoocnmap.pl --- Don't hide NCL output + M models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl Explicitly calculate corners + + M models/lnd/clm/bld/build-namelist - Set drydep to off by default, check crop setting for finidat files + + M models/lnd/clm/bld/clm.buildnml.csh - Add back logic in about ignoring IC year or date + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml - New initial conditions for: + Native initial conditions for f09 for: + I1850CLM45SP, I1850CLM45BGC, ICLM45SP, ICLM45BGC + Interpinic for: + I1850CLM45SP & I1850CLM45BGC: f19, hcru_hcru, ne30 + ICLM45BGCCROP @ f19 + ICLM45BGCDB @ f09 + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Use surfdata_map rather than surfdata + for CLM_USRDAT_NAME fsurdat files + + M models/lnd/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml - Remove setting of dtime, adjust hist output + + More work on readme files... + + M README + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/Quickstart.GUIDE + M models/lnd/clm/doc/Quickstart.userdatasets + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm intel yes + frankfurt/aux_clm pgi yes + + CESM history file comparison: + (ccsm_utils/Tools/component_gen_comp -compare $oldtag -generate $newtag -testid $testid -baselineroot $GLDCSEG/ccsm_baselines/ -model clm2) + + yellowstone/aux_clm intel yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + + yellowstone/PTCLM: yes! + +CLM tag used for the baseline comparison tests if applicable: clm4_5_06 + +Changes answers relative to baseline: Yes -- due to new initial condition files + for I1850CLM45SP and I1850CLM45BGC @ f09, f19, hcru, ne30 + ICLM45SP and ICLM45BGC @ f09 + ICLM45BGCCROP @ f19 and ICLM45BGCDB @ f09 + and ICLM40CRUCN @ f09 + + AND new initial conditions for RTM for ALL R05 grids + + And turning drydep namelist off in the driver causes answers to appear to be different + when comparing coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_5_06 +Originator(s): erik (Erik Kluzek) +Date: Wed May 15 13:52:43 MDT 2013 +One-line Summary: A few small bug fixes, more updates to README files + +Purpose of changes: + More work on README files and documentation. + Fix from Danica/Bill for transient simulations. + Fix from Zack for Lake output variables + Another multi-instance script fix. + Fix tropixAtl pftdyn filename. + Remove models/lnd/clm/bld/config_query as doesn't work with new CESM scripts. + +Requirements for tag: + Requirements: Fix bug: 1697, 1691, 1675, fix tropicAtl fpftdyn file, minimal testing on frankfurt + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + 1675 (need to relax error tolerance in reweightMod: weightsOkay) + 1691 (Scripts issue for multi-instance for CLM/RTM) + 1697 (ZLAKE and DZLAKE are NOT set) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Fix 1x1_tropicAtl fpftdyn file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (transient fix), dlawren/subin (lake fix), jedwards (multi-instance scripts) + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: testing namelist files for old CLM standalone + + D models/lnd/clm/bld/config_query --- no longer works with new CESM scripts + + D models/lnd/clm/test/tools/nl_files/nl_ch4_set2_ciso + D models/lnd/clm/test/tools/nl_files/nl_ch4_set3_pftroot + D models/lnd/clm/test/tools/nl_files/nl_rootlit + D models/lnd/clm/test/tools/nl_files/nl_ciso + D models/lnd/clm/test/tools/nl_files/nl_anoxia_wtsat + D models/lnd/clm/test/tools/nl_files/nl_vrtlay + D models/lnd/clm/test/tools/nl_files/nl_oldhyd + +List all files added and what they do: + + A models/lnd/clm/tools/clm4_5/interpinic/addmetadata --- Add script to add important meta-data to finidat files. + +List all existing files that have been modified, and describe the changes: + +---------------- Work on README files documentation + M models/lnd/clm/test/tools/config_files/README + M models/lnd/clm/test/tools/README + M models/lnd/clm/test/tools/README.testnames + M models/lnd/clm/tools/README + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/Quickstart.GUIDE + M models/lnd/clm/doc/README + +---------------- + M models/lnd/clm/bld/config_files/config_definition.xml ------------ Document experimental settings / fix syntax error + M models/lnd/clm/bld/clm.buildnml.csh ------------------------------ Multi-instance fix + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml --- Fix 1x1_tropicAtl fpftdyn filename + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml - Document experimental settings + +---------------- + M models/lnd/clm/src/clm4_5/main/histFileMod.F90 ---- ZLAKE/DZLAKE fix + M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 -- ZLAKE/DZLAKE fix + M models/lnd/clm/src/clm4_5/main/reweightMod.F90 ---- Increase tolerance to 1.e-7 so transient + simulations can run their full course. + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: (limited testing on yellowstone/aux_clm/intel) + + frankfurt/aux_clm pgi yes + frankfurt/aux_clm intel yes + +CLM tag used for the baseline comparison tests if applicable: clm4_5_04 + +Changes answers relative to baseline: no (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm4_5_05 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue May 14 13:15:12 MDT 2013 +One-line Summary: hcru bug fixes + +Purpose of changes: update pio tag and nfire init. mod + +Requirements for tag: N/A + +Test level of tag: Only run hcru_hcru tests + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Fang and Erik for nfire problem + +List any svn externals directories updated (csm_share, mct, etc.): update pio to 1_7_0 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +-- nfire init. changed from nan to spval to fix problem with hcru_hcru debug + intel runs +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 + +Machines testing ran on: Only testing hcru_hcru resolutions + +Yellowstone Tests: + + The following were run with DEBUG=TRUE and for 1 day initial + 1 day restart + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_gnu_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_intel_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_yellowstone_pgi_pioFixed/ PASS + + ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_intel.125102 PASS + ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.125128 PASS + +Frankfurt Tests: + + The following were run with DEBUG=TRUE and for 1 day initial + 1 day restart + hcru_hcru_I_2000_CRUFRC_CLM45_CN_frankfurt_pgi_pioFixed/ PASS + hcru_hcru_I_2000_CRUFRC_CLM45_CN_frankfurt_intel_pioFixed/ FAIL initial run (this is + likely related to other existing MPI problems on Frankfurt). + +CLM tag used for the baseline comparison tests if applicable: N/A + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_04 +Originator(s): erik (Erik Kluzek) +Date: Mon May 13 12:25:14 MDT 2013 +One-line Summary: Fix the previous broken tag + +Purpose of changes: + +Fix the problems in the clm4_5_03 untested tag. + +Requirements for tag: Fix bug 1692, 1693 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1693 (Misc. issues with clm4_5_03) + 1692 (externals screwed up in clm4_5_03) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): externals updated to those in SVN_EXTERNAL_DIRECTORIES + +List all files eliminated: Remove test/system as replaced by CESM testing + + models/lnd/clm/test/system -- Delete the whole directory tree + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/clm4_0/main/clm_initializeMod.F90 -- fixed screwed up code + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm intel yes + frankfurt/aux_clm pgi yes + +CLM tag used for the baseline comparison tests if applicable: clm4_5_01 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_5_03 +Originator(s): erik (Erik Kluzek) +Date: Fri May 10 17:29:56 MDT 2013 +One-line Summary: Several bug fixes for release, urban and test single point surface datasets + +Purpose of changes: + + Some work on IMPORTANT_NOTES file. + Fix PTS_MODE restarts from John Truesdale. (implimented, but there are still issues) + Fix history change number of tapes on startup issue. + Bring in urban single pt surface datasets and single pt test: mexicocityMEX, vancouverCAN , urbanc_alpha, 1x1_tropicAtl, 1x1_smallvilleIA + Drydep use before defined problem. + Always bypass first two time-steps for CN/BGC. + Fix gregorian calendar on history files. + Remove two fields on clm45 fpftdata file as per Gordon Bonan. + ncd_pio fix from Jim Edwards/Mariana V. + set nsegspc=20 for HOMME and high resolution grids. + Change documentation on CLM build-namelist -drydep, but keep it default on (will change to off in next tag) + Remove a bunch of datm/drv fields in namelist_definition. + Fix some issues with Crop and DV that Sam found. + Fix a scripts issue with multi-instance. + Update RTM (multi-instance fix, allow null grid). + Update test list so that CLM45/DV/CROP are exercised. + Update scripts/machines tag because of multiple problems. + +Requirements for tag: fix bug 1488, 1673, 1677, 1682, 1653, 1689, 1690, 1687, 1688, 1685, 1691 + +Test level of tag: limited! + +Bugs fixed (include bugzilla ID): + + 1025 (partial -- implement changes from John Truesdale so SCAM can read global IC files) + 1488 (HOMME grids can not use nsegspc=20) + 1653 (Calls to PIO are not properly done) + 1673 (B compset gregorian calendar not reflected in CLM history) + 1677 (Remove bypass_CN_balance_check_on_restart in CLM45) + 1682 (Problem starting up CLM with no history files) + 1685 (use before define issue in DryDeposition) + 1687 (SBN scripts bug) + 1688 (misc. issues with new create_test) + 1689 (CLM45 dgvm does not build) + 1690 (CLM45 CNDV lightning namelist is missing) + 1691 (Scripts issue for multi-instance) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Set nsegspc=20 for HOMME and f05/f02 resolutions + Set stream_fldfilename_lightng for CLM45/CNDV + +List any changes to the defaults for the boundary datasets: New single-point test and urban datasets + New surface datsets for: mexicocityMEX, vancouverCAN, urbanc_alpha, 1x1_tropicAtl, 1x1_smallvilleIA + New fpftdyn for: 1x1_tropicAtl 1850-2005 + New pft-physiology file for CLM45 with three fields removed that were NOT being read in (qe25, mp, and resist) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jedwards/mvertens (fix for bug 1653), jet (fix for bug 1025), slevis (fixes for DV) + +List any svn externals directories updated (csm_share, mct, etc.): Machines, scripts, rtm + Machines to Machines_130509 + scripts to scripts4_130510 + rtm to rtm1_0_25 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist ---- Document drydep as if it's off (will actually become off in next tag) + M models/lnd/clm/bld/clm.buildnml.csh -- Multi-instance bug fix. + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ----- nsegspc for ALL grids is 20 + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml --- Remove datm/drv namelist crap + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ----- nsegspc for ALL grids is 20 + New pft-physiology file, new surface/fpftdyn datasets for single point test and urban + Set stream_fldfilename_lightng for CNDV. + M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml --- Remove datm/drv namelist crap + + M models/lnd/clm/doc/IMPORTANT_NOTES -- updates + + M models/lnd/clm/src/util_share/clm_time_manager.F90 - Set parameters for calendar type. + M models/lnd/clm/src/util_share/ncdio_pio.F90 -------- Fix so that type of data output on read is based + on the variable type of the data rather than the type of data on the input file. (from mvertens/jedwards) + + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ------ Fix so CNDV can build. + M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 ------ Remove bypass_CN_balance_check_on_restart + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 - Fix use before define error. + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 ---- On restart set fieldlist and later compare to make sure + not screwed up. + M models/lnd/clm/src/clm4_5/main/histFileMod.F90 ---------- Make htapes_fieldlist public, check calendar for output files, + check that namelist didn't change number of tapes or fields on restart + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 ----------- Remove bypass_CN_balance_check_on_restart, NEVER do balance check + on first time-step + + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 - Fix use before define error. + M models/lnd/clm/src/clm4_0/main/histFileMod.F90 ---------- Make htapes_fieldlist public, check calendar for output files, + check that namelist didn't change number of tapes or fields on restart + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 ---- On restart set fieldlist and later compare to make sure + not screwed up. + +Machines testing ran on: Limited! (watch out for this tag!) + + I ran preliminary testing, with versions on the cbugfixclm450 ranch. We will fix other issues with the entire + package as we find them. + +CLM tag used for the baseline comparison tests if applicable: clm4_5_02 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_5_02 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue May 7 21:04:35 MDT 2013 +One-line Summary: make 'shared' tools directory, and other minor tools fixes + +Purpose of changes: + +- Make separate 'shared' tools directory, move some tools from the clm4_5 + directory into there. + +- Change interpinic so that htop and hbot are skipped + +- Change Makefile.common files in tools to use ifort by default on yellowstone, + so users can just type 'gmake' without needing to do 'gmake USER_FC=ifort'. + For simplicity, this has been implemented by defaulting to ifort for ALL Linux + machines. + +- Fix minor mksurfdata.pl bugs (1669, 1681). + +Requirements for tag: +- fix bug 1669, 1681* +- only tools testing needed + +Test level of tag: tools only + +Bugs fixed (include bugzilla ID): +- 1669: change needed for mksurfdata.pl for smallville (or crop PFT override anyway) +- Changes to get mksurfdata.pl working with urban single point datasets + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None for CLM; tools builds changed to +use ifort by default on Linux machines + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +========= Moved to 'shared' directory +D models/lnd/clm/tools/clm4_5/mkmapdata +D models/lnd/clm/tools/clm4_5/mkprocdata_map +D models/lnd/clm/tools/clm4_5/ncl_scripts +D models/lnd/clm/tools/clm4_5/mkmapgrids + +List all files added and what they do: + +========= Tools moved from clm4_5 directory to shared directory +A models/lnd/clm/tools/shared +A models/lnd/clm/tools/shared/mkmapdata/mvNimport.sh +A models/lnd/clm/tools/shared/mkmapdata/rmdups.ncl +A models/lnd/clm/tools/shared/mkmapdata/regridbatch.sh +A models/lnd/clm/tools/shared/mkmapdata/createXMLEntries.pl +A models/lnd/clm/tools/shared/mkmapdata/mkmapdata.sh +A models/lnd/clm/tools/shared/mkmapdata/mkunitymap.ncl +A models/lnd/clm/tools/shared/mkmapdata/mknoocnmap.pl +A models/lnd/clm/tools/shared/mkmapdata/README +A models/lnd/clm/tools/shared/mkmapdata +A models/lnd/clm/tools/shared/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_functions.bash +A models/lnd/clm/tools/shared/mkprocdata_map/src/mkprocdata_map.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/gridmapMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/constMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/Makefile.common +A models/lnd/clm/tools/shared/mkprocdata_map/src/fmain.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/shr_file_mod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/nanMod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/Mkdepends +A models/lnd/clm/tools/shared/mkprocdata_map/src/Srcfiles +A models/lnd/clm/tools/shared/mkprocdata_map/src/Filepath +A models/lnd/clm/tools/shared/mkprocdata_map/src/Makefile +A models/lnd/clm/tools/shared/mkprocdata_map/src/fileutils.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src/shr_kind_mod.F90 +A models/lnd/clm/tools/shared/mkprocdata_map/src +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_in +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_all +A models/lnd/clm/tools/shared/mkprocdata_map/clm +A models/lnd/clm/tools/shared/mkprocdata_map/mkprocdata_map_wrap +A models/lnd/clm/tools/shared/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/shared/mkprocdata_map/README +A models/lnd/clm/tools/shared/mkprocdata_map +A models/lnd/clm/tools/shared/ncl_scripts/cprnc.pl +A models/lnd/clm/tools/shared/ncl_scripts/getco2_historical.ncl +A models/lnd/clm/tools/shared/ncl_scripts/cprnc.ncl +A models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.pl +A models/lnd/clm/tools/shared/ncl_scripts/getregional_datasets.ncl +A models/lnd/clm/tools/shared/ncl_scripts/README +A models/lnd/clm/tools/shared/ncl_scripts +A models/lnd/clm/tools/shared/mkmapgrids/src/Makefile.common +A models/lnd/clm/tools/shared/mkmapgrids/src/domainMod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_sys_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_file_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/nanMod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_log_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/Mkdepends +A models/lnd/clm/tools/shared/mkmapgrids/src/Srcfiles +A models/lnd/clm/tools/shared/mkmapgrids/src/mkmapgrids.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src/Filepath +A models/lnd/clm/tools/shared/mkmapgrids/src/Makefile +A models/lnd/clm/tools/shared/mkmapgrids/src/shr_kind_mod.F90 +A models/lnd/clm/tools/shared/mkmapgrids/src +A models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.namelist +A models/lnd/clm/tools/shared/mkmapgrids/mkscripgrid.ncl +A models/lnd/clm/tools/shared/mkmapgrids/mkmapgrids.csh +A models/lnd/clm/tools/shared/mkmapgrids/README +A models/lnd/clm/tools/shared/mkmapgrids + +========= Add test for mkmapdata using '-p clm4_0' +A models/lnd/clm/test/tools/nl_files/mkmapdata_ne30np4_clm4_0 + +List all existing files that have been modified, and describe the changes: + +========= Point to new 'shared' tools directory where appropriate +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + - also fix mksurfdata.pl for crop PFT override (bug 1669) + - also changes to get mksurfdata.pl working with urban single point datasets (bug 1681) +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + - also fix mksurfdata.pl for crop PFT override (bug 1669) +M models/lnd/clm/test/tools/TBLCFGtools.sh +M models/lnd/clm/test/tools/TOPtools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh +M models/lnd/clm/test/tools/TBLtools.sh +M models/lnd/clm/test/tools/input_tests_master + - also add test for mkmapdata using '-p clm4_0' +M models/lnd/clm/tools/README +M models/lnd/clm/tools/clm4_5/mksurfdata_map/README.developers + +========= Put gen_domain in 'shared' tools directory +M SVN_EXTERNAL_DIRECTORIES + +========= Use ifort by default on yellowstone (and other Linux machines) +M models/lnd/clm/tools/clm4_5/interpinic/src/Makefile.common +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common +M models/lnd/clm/tools/clm4_0/interpinic/src/Makefile.common +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common + +========= Change interpinic so that htop and hbot are skipped +M models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 + + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: no + + CESM test lists: + + yellowstone/aux_clm intel no + frankfurt/aux_clm_int intel no + yellowstone/aux_clm pgi no + frankfurt/aux_clm intel no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: yes + + All PASS except for the following expected failures (note that 006 & 008 + baselines are expected to always fail): + + 006 ble14 TBLCFGtools.sh shared gen_domain CFGtools__ds T31.runoptions .......................... rc=4 FAIL + 008 ble@4 TBLCFGtools.sh shared gen_domain CFGtools__ds ne30.runoptions ......................... rc=4 FAIL + 027 smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional ............. rc=6 FAIL + 028 bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional ............. rc=4 FAIL + + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_5_01 + +Changes answers relative to baseline: NO + +=============================================================== +=============================================================== +Tag name: clm4_5_01 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon May 6 16:52:27 MDT 2013 +One-line Summary: update externals + +Purpose of changes: update externals to alpha08b + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +< scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130502 +< scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130502 +< models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_33 +--- +> scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130422 +> scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130412 +> models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_29 +13c13 +< models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130502 +--- +> models/glc/cism https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130405 +16c16 +< models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130423 +--- +> models/csm_share https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_130226 +18c18 +< models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130417 +--- +> models/utils/timing https://svn-ccsm-models.cgd.ucar.edu/timing/trunk_tags/timing_130214 +20c20 +< models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_9/pio +--- +> models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_7/pio +23,25c23,25 +< tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130425 +< tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130426a +< models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130426a/gen_domain_files +--- +> tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130411 +> tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403 +> models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403/gen_domain_files + +List all files eliminated:N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +- clean up test list + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/aux_clm intel OK (detail of fails that should pass next time) + +BFAIL ERI_D.f10_f10.I20TRCN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL ERS.f19_g16_r01.I1850CLM45CN4Me.nldir_rtmOnFloodOnEffvelOff.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- No matching time found in cprnc? should pass next time. +FAIL ERS_D.f19_g16.ICLM45GLCMEC.nldir_glcMEC.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.ICLM45GLCMEC.nldir_glcMEC.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +FAIL ERS_D.f19_g16.IGRCP26CLM45CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.IGRCP26CLM45CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +BFAIL ERS_Ld3_D_P64x1.ne30_g16.ICLM45CN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL ERS_Ld3_D_P64x16.ne30_g16.ICN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.170226.nlcomp + -- changes in cism namelist and cism config +BFAIL PET_D_P1x30.ne30_g16.ICN.nldir_default.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLA.f45_f45.I.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_ROA.f45_f45.I.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_ROA.f45_f45.ICLM45.yellowstone_intel.GC.170226.compare_hist.clm4_0_81 + -- no baseline, should pass next round + + yellowstone/aux_clm pgi OK (detail of fails that should pass next time) + +FAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism_config +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism config +BFAIL ERI_D.f10_f10.I20TRCN.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- no baseline, should pass next round +FAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 +FAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.170137.nlcomp + -- changes in cism namelist and cism config + -- changes in drv_in (ocn_ntreades=2) +FAIL SMS.T31_g37.IG4804CLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- changes in g2x_Sg_frac01 and g2x_Sg_topo01 +BFAIL SMS_RLB.f45_f45.I.yellowstone_pgi.GC.170137.compare_hist.clm4_0_81 + -- no baseline, should pass next round +BFAIL SMS_RLB.f45_f45.ICLM45.yellowstone_pgi.GC.170137.compare_hist.clm4_0_8 + -- no baseline, should pass next round + + frankfurt/aux_clm intel OK + +CLM tag used for the baseline comparison tests if applicable: clm4_0_81 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: only changes in g2x_Sg_frac01 and g2x_Sg_topo01 + - what platforms/compilers: all + +=============================================================== +=============================================================== +Tag name: clm4_5_00 +Originator(s): erik (Erik Kluzek) +Date: Thu May 2 00:20:17 MDT 2013 +One-line Summary: Official end to CLM4.5 development for CLM offline + +Purpose of changes: Changes from clm4_0_54 to now... + +Compsets and Scripts Changes: + +Remove ability to set compset file on command line, and use a new expanded compset file definition that +allows user to create many compsets on the fly by defining a long name with the "-user_compset" option +to "create_newcase". "-user_compset" is in the form of... + +TIME_DATM[%phys]_CLM[40|45][%phys]_SICE_SOCN_RTM[%phys]_GLC[%phys]_SWAV[_BGC%phys] + +Where + TIME = Time period (e.g. 2000, 20TR, RCP8...) + GLC = [CISM1, SGLC] + BGC = optional BGC scenario +The OPTIONAL %phys attributes specify submodes of the given system + +So for example + +./create_newcase -user_compset 1850_DATM%CRU_CLM45%BGC_SICE_SOCN_RTM_SGLC_SWAV -case cru1850 -res f19_g16 -mach yellowstone -compiler intel + +will setup a 1850 case at f19 resolution with CRUNCEP forcing with CLM4.5-BGC. + +Changes for both clm4.0 and clm4.5: + +* Bug fixes in MEGAN VOC emission fluxes and dry deposition velocities +* CRUNCEP is now an option for atmospheric forcing +* Change from Sam Levis for CROP to pft-physiology file so that CROP parameter is in Kelvin rather than Celsius. +* Don't re-weight pftdyn if weights are essentially identical. + +CLM4.5 includes the following: + +* Bring in flood capability to RTM. +* Bring LBNL-merge branch on with: vertical soil, Methane, CENTURY, split nitrification, new-lake model. +* Modifications to GPP, on gppdev branch, multilayer canopy and then single-layer version that reproduces it. +* Crop model updates. Irrigation included with crop model as an option. Fix CNDV-CROP. +* Urban model updates, multi-density, urban depth seperate from soil depth, wasteheat to zero. +* Bring in permafrostsims09 branch with Sean Swensons's flooding changes. +* Update pft-physiology file, change some CN defaults, change min flow slightly in RTM. +* Set ponding to zero, acclimation mods from Keith Oleson, a hydrology change from Sean Swenson. +* Add active flags, change subgrid weighting convention. +* Turn off subgrid topography snow parameterization for glc_mec landunits. +* Jinyun photosynthesis change impacting arid regions. +* Keith Oleson's photosynthesis change, changes canopy top: triose phosphate util. rate to be dependent on vcmax. +* VIC hydrology is an option. +* Update mksurfdata_map for CLM4.5 (also add support for glc_nec=36 although we have no datasets for this). +* Snow depth averaged over grid-cell (SNOWDP) on history file changed in favor of SNOW_DEPTH (averaged only over snow covered area). +* Spinup changes from Charlie Koven from build-time to run-time (spinup now option added to CLM_BLDNML_OPTS as "-spinup on|off"). +* Bring the F. Li and S. Levis Fire model for CLMCN and CLMBGC based on Li et al. (2012a,b; 2013). +* BSW calculation changed affecting drought phenology and frozen temperature sensitivity (SP, CN, and BGC as well as DV) + +Test level of tag: doc + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Changes to CLM configure: + -phys option to specify clm4_0 or clm4_5 + -pergro and -c13 option removed + -spinup option removed for CLM4_0 + New options for clm4_5: -clm4me, -vichydro, -exlaklayers, -vsoilc_centbgc + +Describe any changes made to the namelist: + For CLM4.0: WRF and 360x720cru resolutions added + For CLM4.5: new namelists: popd_streams light_streams clm_hydrology1_inparm clm_soilhydrology_inparm + irrigate is a namelist option rather than using different surface datasets + New namelist items for clm_inparm: + anoxia no_frozen_nitrif_denitrif + atm_c14_filename override_bgc_restart_mismatch_dump + cryoturb_diffusion_k perchroot + decomp_depth_efolding perchroot_altk + deepmixing_depthcrit pftspecific_rootingprofile + deepmixing_mixfact rootprof_exp + exponential_rooting_profile rootprof_exp + froz_q10 som_adv_flux + hist_wrtch4diag som_diffus + lake_melt_icealb spinup_state + max_altdepth_cryoturbation surfprof_exp + max_depth_cryoturb use_c13 + more_vertlayers use_c14 + nfix_timeconst use_c14_bombspike + + +List any changes to the defaults for the boundary datasets: + All CLM4.5 datasets are new. + For CLM4.0, new ne120, ne240, and 360x720cru surface datasets (ne120 ne120 finidat files) + new pft-physiology file + +New history fields: + Dozens of new fields for clm4_5. + Three new fields for clm4_0: ++ >>>>>>>>>>> Set first and last pop-dens year, and do "arb_ic" rather than "startup" +>>>>>>>>>>>> type for all transient cases (allow transient cases to do a cold-start) +>>>>>>>>>>>> ALTHOUGH YOU SHOULD NEVER DO A COLD START FOR A TRANSIENT CASE! + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + +>>>>>>>>>>>> Some small changes to documentation about irrigation. + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + + M models/lnd/clm/src/util_share/ndepStreamMod.F90 -- make default private, namelist data private, and clm_domain_mct public + + M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 --- add number of individuals + M models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 -- handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ----------- Fire module -- almost entirely replaced. Two new public + methods added: ++ public :: CNFireInit ! Initialization of CNFire ++ public :: CNFireInterp ! Interpolate fire data + M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 -------- Handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 -- Handle more impacts of fire + M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 ----------- burndate, lfc, wf, btran2, col_ctrunc, totsomc added to restart + old fire fields removed, _vr fields required if expected., + M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 --- Add CNFireInit, and update CNFireArea call. + M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 ------- Set fire variables. + M models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 farea_burned impacts SAI for stubble after harvest + M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 -------------- Initialize new fire variables + M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 --------- Update CNEcosystemDynInit call + M models/lnd/clm/src/clm4_5/main/accFldsMod.F90 ---------------- Add prec10 and prec60 (10 and 60 day total precipitation) + M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 ------------ Initialize new fire variables. + M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 ----------------- Update lf_conv_cflux, make PFT weight check same as for surfrdMod.F90 + M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 -------------- Read in new fire data, abort if data needed NOT found on the + surface dataset. + M models/lnd/clm/src/clm4_5/main/findHistFields.pl ------------- Also read in CNFireMod for history fields. + M models/lnd/clm/src/clm4_5/main/clm_driver.F90 ---------------- Add CNFireInterp call. + M models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 -------------- Initialize lf_conv_cflux to zero. + M models/lnd/clm/src/clm4_5/main/pftvarcon.F90 ----------------- Read in new fire parameters + (no longer need "resist" on the pft-physiology file) + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 ----------------- Fix tolerances to match mksurdata_map + bug fix for non-irrigated crop. + M models/lnd/clm/src/clm4_5/main/clmtype.F90 ------------------- New fire fields + M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 -------------- Initialize some new fire fields: tsoi17, fsat + M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 --------------- New fire history fields + M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 ----- Save btran2, smp_node_lf for fire + M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 ------- Save wf2, tsoi17, h2osoi_liqice_10cm + + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 ----------------- Fix tolerances to match mksurdata_map + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/aux_clm intel yes + yellowstone/aux_clm pgi yes + frankfurt/aux_clm_int intel yes + frankfurt/aux_clm intel yes + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_79 + +Changes answers relative to baseline: YES! + + Summarize any changes to answers: + - what code configurations: All with CLM45 + - what platforms/compilers: All + - nature of change: new climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + /glade/p/cesm/lmwg/cases/cesm1/C20new -- on yellowstone + /glade/scratch/erik/archive/clm4079_NewFire10f19_CRU_20TR_CN4Me + /glade/scratch/erik/archive/clm4077_I1850CLM45CN4Me + /glade/scratch/erik/archive/clm4077_NewFire10f19_QIAN_20TR_CN4Me + hsi:/home/fangli/qian20 + +=============================================================== +=============================================================== +Tag name: clm4_0_79 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 24 20:27:01 MDT 2013 +One-line Summary: pftdyn, pft-phys*.nc and datm8 update + +Purpose of changes: From Erik:: - update Don't re-weight pftdyn if weights are essentially identical (Both CLM40 AND CLM45). + - Turn wasteheat to "ON" in CLM45. (namelist change) (done) + - Change from Sam Levis for CROP to pft-physiology file so that CROP parameter is in Kelvin rather than Celsius (both CLM40 and CLM45). + - Change datm so that LWDN is NOT read from files for CRUNCEP (datm8_130424). + +Requirements for tag: fix bug 1621 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): fixed 1621 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: turn waste heat on in clm4_5 + +List any changes to the defaults for the boundary datasets: change pft-phys files for 4_0 and 4_5 + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, Erik, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): + +< models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130424 +--- +> models/atm/datm https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130325 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M SVN_EXTERNAL_DIRECTORIES + update to datm8_130424 + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml + - $CSMDATA/lnd/clm2/pftdata/pft-physiology.clm40.c130424.nc +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + - change ON_WASTEHEAT to ON + - use $CSMDATA/lnd/clm2/pftdata/pft-physiology.c130424.nc + +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_0/main/pftdynMod.F90 + - change wtpfttot2 check + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + - syntax clean up - caught by Ben Andre + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. many expected failures due to new pft-physiology files. Should pass next time. + + CESM test lists: + Many nlcomp failures: + clm4_5: + NEW: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c130424.nc' + BASELINE: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c121025.nc' + NEW: urban_hac = 'ON' + BASELINE: urban_hac = 'ON_WASTEHEAT' + clm4_0: + NEW: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.clm40.c130424.nc' + BASELINE: fpftcon = '/fs/cgd/csm/inputdata/lnd/clm2/pftdata/pft-physiology.c110425.nc' + + component_gen_comp: all PASS or BFAIL1 + summarize_cprnc_diffs: differences in CLM files + + yellowstone/CESM: + intel: OK. Expected failures for compare_hist (should pass next time) + FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_E.f19_g16.I1850CRUCLM45CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL NCK.f10_f10.ICRUCLM45.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL PET_PT.f10_f10.I20TRCN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + FAIL SMS.f19_g16.IRCP45CN.yellowstone_intel.GC.222079.compare_hist.clm4_0_78 + pgi : OK. Expected failures for compare_hist (should pass next time) + FAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + FAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + FAIL PET_PT.f10_f10.I20TRCN.yellowstone_pgi.GC.111079.compare_hist.clm4_0_78 + + frankfurt/CESM: + intel: OK. Expected failures for compare_hist (should pass next time) + FAIL SMS.f10_f10.IRCP26CN.frankfurt_intel.GC.pft79.compare_hist.clm4_0_78 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_78 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): same climate + -in coupler history files: l2x_Sl_*, l2x_Fall, x2l_Slrr* and some r2x_* fields change + -in clm history files: for these tests only differences seen in IGRCP60CN + +=============================================================== +=============================================================== +Tag name: clm4_0_78 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Apr 23 19:25:18 MDT 2013 +One-line Summary: MEGAN fixes + +Purpose of changes: + + - Bug fixes in MEGAN VOC emission fluxes and dry deposition velocities + - Remove the land fraction weighting from MEGAN history fields + - Added XPAN capability to dry deposition parametrization + +Requirements for tag: N/A + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, starting branch from Erik. + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + - maximum string length of megan_specifier increased to 1024 characters + + M models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 + M models/lnd/clm/src/clm4_0/biogeochem/VOCEmissionMod.F90 + - land fraction weighting has been removed from the MEGAN diagnostics + - added initialization of the vocflx_meg array to zero to prevent + erroneous values from contributing to the MEGAN emissions + + M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 + M models/lnd/clm/src/clm4_0/biogeochem/DryDepVelocity.F90 + - corrected surface pressure + - added XPAN specification + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + yellowstone/CESM: + -intel: OK + -component_gen_comp fails on a number of tests, but it is all expected. summarize_cprnc_diffs verifies that all fails in the + CLM history files is consistent. + -compare_hist failures are expected due to new dry deposition values going through coupler. + -pgi : OK + -compare_hist failures are expected + + frankfurt/CESM: + -intel: OK. + -compare_hist failures are expected + +CLM tag used for the baseline comparison tests if applicable: clm4_0_77 + +Changes answers relative to baseline: Yes. Changes in l2x_Sl_dd{001-035},l2x_Sl_dd{040,041,043} in coupler hist file. + Possible changes in *_voc fields in coupler hist files for certain configurations. Changes in 10 MEG_* fields and VOCFLXT in CLM history files. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): same climate. changes in CLM fields range from 1.e-9 + (VOCFLXT) to 1.e-17 (MEG_thujene_a) + +=============================================================== +=============================================================== +Tag name: clm4_0_77 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Tue Apr 23 11:38:45 MDT 2013 +One-line Summary: fix carbon balance bug in transient runs with VERTSOI, and fix Soil Hydrology bug + +Purpose of changes: + +Fix two bugs: + +(1) In transient CLM45 runs with VERTSOI, a carbon balance error + occurred due to two routines being called with updated filters + when they should have been called with filters set at their values + from the previous time step. This bug has existed since clm4_0_62. + +(2) A potential for an array out-of-bounds error (which could show up + as garbage results if array bounds checking was off) which showed + up in rare circumstances (e.g., a single grid cell in Greenland in + a 1-year test run) + +Requirements for tag: Fix bugs 1663, 1664 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + + 1663 (array bounds error in SoilHydrologyMod) + 1664 (carbon balance errors) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +========= Fix for bug 1664 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +========= Fix for bug 1663 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + + All PASS or xFAIL; all component_gen_comp comparisons pass or BFAIL1 + + yellowstone/CESM/allIcompsets: no + + frankfurt/CESM: yes + + All PASS or xFAIL + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_76 + +Changes answers relative to baseline: YES, potentially (though none +observed in standard testing) + + Answer changes are possible in any CLM45 case due to the SoilHydrology + bug fix (1663). This changes answers only in rare situations where the + water table comes near the surface (e.g., in a 1-year test run, this only + happened in one grid cell in Greenland) + + In addition, the following answer changes are expected due to the fix for + bug 1664: + + (1) CLM45 transient with VERTSOI (i.e., BGC). Implementing this change in + clm4_0_62 (the first tag that exhibited bug 1664), clm4_0_62-withFix + was identical to clm4_0_61 for this configuration. But clm4_0_77 will + differ from clm4_0_76 for this configuration. + + (2) Answers are changed for CLM45 CNDV with VERTSOI (i.e., BGCDV). It + appears that this configuration was buggy before this tag (e.g., + restarts weren't exact), so this tag changes answers in a way that + seems to fix this configuration. + + + If bitwise differences were observed, how did you show they were no worse + than roundoff? NOT DONE + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_76 +Originator(s): muszala (Stefan Muszala) +Date: Mon Apr 22 13:36:26 MDT 2013 +One-line Summary: spinup changes from Charlie Koven (part 1) + +Purpose of changes: + +Remove SPINUP CPP tokens, in favor of a run-time namelist item that can be set to +change the spinup mode on the fly. The state is stored on the restart file, and +if the user changes the mode on the namelist -- the model will automatically do +the "ENTER-SPINUP" or "EXIT-SPINUP" step as needed on the first time-step. The +spinup options were thus removed from the CLM configure for CLM45 and moved to +the build-namelist as option "-spinup" with values either "on" or "off". + + +Add new history fields: TOTLITC_1m, TOTSOMC_1m, TOTLITN_1m, and TOTSOMN_1m. +Remove the namelist item: reset_permafrost_c_n_pools. Removed default history +output for decomposing C pool changes due to vertical transport, and for vertical + profiles for N Deposition and fixation. + + +Answer Changes for C13: C13 and C13 Carbon isotopes are handled a bit differently + when they are NOT on the restart file. For C13 prior timestep's downregulation +is used in calculating ci used for photosynthetic discrimination. This changes + answers when use_c13 is turned on. + +Requirements for tag: N/A + +Test level of tag: std-tag + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Change the way spin up is handled + +Describe any changes made to the namelist: spinup now controlled in build-namelist + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave L. checked spinup test comparing old and new method. Erik, Charlie Koven + +List any svn externals directories updated (csm_share, mct, etc.): + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130416a ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130419a + +List all files eliminated: N/A + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. + some new failures that should be gone when compared to the next tag. This is due to the new namelist variable + + < spinup_state = 0 + + 418/444 < FAIL> + 423/444 < FAIL> + 428/444 < FAIL> + 433/444 < FAIL> + 438/444 < FAIL> + 443/444 < FAIL> + + CESM test lists: + + yellowstone/CESM: SPM - tracking tputcomp failures + cesm intel: OK + FAIL ERS.f09_g16.ICLM45VIC.nldir_vic_vrtlay.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4Me.nldir_ch4_set2_ciso.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4Me.nldir_ch4_set3_pftroot.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_D.f10_f10.ICLM45CN4MeNoVS.nldir_rootlit.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_E.f19_g16.I1850.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.222075.tputcomp.clm4_0_74 + cesm pgi : OK + FAIL SMS.1x1_numaIA.ICNCROP.yellowstone_pgi.GC.111075.tputcomp.clm4_0_74 + + frankfurt/CESM: + cesm intel: OK + FAIL ERS.f45_g37.I1850CN.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + FAIL SMS.f10_f10.IRCP26CN.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + FAIL SMS_D.1x1_mexicocityMEX.I.frankfurt_intel.GC.00075.tputcomp.clm4_0_74 + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_75 + +Changes answers relative to baseline: some changes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Answer Changes for C13: C13 and C13 Carbon isotopes are handled a bit differently + when they are NOT on the restart file. For C13 prior timestep's downregulation +is used in calculating ci used for photosynthetic discrimination. This changes + answers when use_c13 is turned on. + +=============================================================== +=============================================================== +Tag name: clm4_0_75 +Originator(s): muszala (Stefan Muszala) +Date: Fri Apr 19 16:13:42 MDT 2013 +One-line Summary: run propset + +Purpose of changes: run propset so externals are updated + +Requirements for tag:N/A + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system:N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes:N/A + +Machines testing ran on: no testing run +=============================================================== +=============================================================== +Tag name: clm4_0_74 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 17 15:58:50 MDT 2013 +One-line Summary: snow_depth changes, major scripts overhaul, small fix for tools + +Purpose of changes: bring in snow_depth changes (bfb except for one field in clm hist files, SNOWDP) + update external to alpha06e and bring in scripts refactoring by mvertens. Bug fix for mksurfdata_map + by sacks. Some minor code cleanup by muszala. + +Requirements for tag: N/A + +Test level of tag: doc, std-test + tools + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): Bug in pio1_6_6 which kills mpi-serial runs, jedwards is working on fix. + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self, mvertens, swensoc + +List any svn externals directories updated (csm_share, mct, etc.): + +< scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_130416a +> scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_02_scripts4_130405a +< scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130412 +> scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130403 +< models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_29 +> models/drv https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_26 +< models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_6/pio +> models/utils/pio http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_5/pio +< tools/cprnc https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_130411 +< tools/mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403 +> mapping https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308 +< models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130403/gen_domain_files +> models/lnd/clm/tools/clm4_5/gen_domain https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308/gen_domain_files + +List all files eliminated: models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES (moved cprnc to common location). + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +SVN_EXTERNAL_DIRECTORIES + +--small fix from sacks. +models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 + +--update xFail list since we now run test_system tests out of cesm and scripts +--test_system now uses create_test +models/lnd/clm/test/system/test_system +models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +--minor clean up +models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +models/lnd/clm/src/util_share/organicFileMod.F90 +models/lnd/clm/src/util_share/decompInitMod.F90 + +--snow depth changes +models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +models/lnd/clm/src/clm4_5/main/clm_driver.F90 +models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +models/lnd/clm/src/clm4_5/main/clmtype.F90 +models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK. + + CESM test lists: (this now includes tests from test_system batch from yellowstone). + +yellowstone:: + CESM intel: OK + CESM pgi: OK +frankfurt: + CESM intel: OK. just ran generate. run these instead of test_system interactive tests from now on. + +Tool testing: OK. This was to double check my merge since the branch I started with was in clm4_0_68. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_73 + +Changes answers relative to baseline: Only change is in the clm history field, SNOWDP. Everything else is bfb. + + +=============================================================== +=============================================================== +Tag name: clm4_0_73 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Mon Apr 15 09:48:03 MDT 2013 +One-line Summary: update mksurfdata_map for CLM4.5, and other misc. updates, mainly to tools + +Purpose of changes: + +Main purpose is to add a bunch of new fields to the CLM4.5 mksurfdata_map: +- SLOPE, STD_ELEV +- LAKEDEPTH +- peatf, abm, gdp (for fire) +- binfl, Ws, Dsmax, Ds (for VIC) +- F0, P3, ZWT0 (for methane) + +Also, other miscellaneous changes: + +- some refactoring of mksurfdata_map, and get more routines under unit test + +- for CLM4.5 mksurfdata_map, always use hires datasets, except for pft + +- add support for 36 glc_mec elevation classes (though there are currently + no surface datasets for this option) + +- add support for 1-d domain files in mksurfdata_map + +- add createXMLEntries.pl for creating xml entries for new mapping files + +- change default behavior of new_woodharv for clm4.0 (default is true now), + and only support new_woodharv=true for clm4.5 + +- allow global & regional map generation in a single submission of + mkmapdata/regridbatch.sh + +- handle clm4_0 vs clm4_5 distinction in mkmapdata.sh + +- handle large file support more robustly in mkmapdata.sh + +- refactored mkscripgrid.ncl to use built-in ESMF utility + +- remove 0.47x0.63 support for CLM4.5, since we don't have a good scrip + grid file for that resolution + +- in some files in bld/namelist_files, fix some resolutions listed as + 360x720 to be 360x720cru + +- a few other minor changes, as noted below + + +Requirements for tag: Requirements: tools tests, and build-namelist +test (to catch any accidental changes to CLM's namelist), fix bug: +1641. Also ran standard tests to cover all bases. + +Test level of tag: standard + tools + +Bugs fixed (include bugzilla ID): + - 1641 (RCP6 and RCP8.5 used old bad wood harvest for 2006 and 2007) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None to CLM namelist, but many +changes to mksurfdata_map namelist. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +========= Move to new inputs directory +D models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc + +List all files added and what they do: + +========= Create xml entries and commands to move files to inputdata for + a bunch of mapping files +A models/lnd/clm/tools/clm4_5/mkmapdata/createXMLEntries.pl + +========= Guide for how to add new fields to mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/README.developers + +========= Pull out shared mksurfdata_map code into new, shared modules +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdiagnosticsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkchecksMod.F90 + +========= Regrid new fields for mksurfdata_map +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mktopostatsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgdpMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkagfirepkmonthMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpeatMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkVICparamsMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 + +========= Get more of mksurfdata_map code under unit tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 + +========= Add inputs for new mksurfdata_map unit tests +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lsmlon.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__num_pixels.nc + +========= Move to inputs directory +A models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_lookup_2d_netcdf.nc + + +List all existing files that have been modified, and describe the changes: + +========= Add new mksurfdata_map variables and mapping files +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 + - also add no_inlandwet option + - also handle the case where special landunits sum to a + tiny bit more than 100% and thus give negative pct_pft +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 + - also add some other global attributes +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl + - also add merge_gis and inlandwet options, remove ngwh + option, remove hires option (instead use hirespft) +M models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + - also add support for 36 glc_mec columns, and remove 0.47x0.63 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml + - also remove 0.47x0.63, remove coarse-res lake, change logic for + determining glacier dataset, remove ngwh=off rcp6 and rcp8.5 datasets + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml + - also add support for 36 glc_mec columns, no_inlandwet option, + remove a duplicate section, remove 0.47x0.63 + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/checkmapfiles.ncl +M models/lnd/clm/doc/UsersGuide/tools.xml + +========= Add nodata argument to gridmap_areaave +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 + - also add gridmap_areastddev and gridmap_check routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 + +========= Add support for 36 glc_mec elevation classes +M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml + - also fix ngwh default for rcp6 for 2006 and 2007 + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml + - also add xml file support for more scrip grid file info +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + +========= Change default behavior of new_woodharv for clm4.0 +M models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl + +========= Add new test routines +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles + +========= Change location of input files for unit testing +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 +M models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 + +========= Add support for 1-d domain files; allow larger diffs in + domain_checksame +M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 + +========= Allow global & regional map generation in a single submission +M models/lnd/clm/tools/clm4_5/mkmapdata/regridbatch.sh + +========= Fix yellowstone ESMF path, add new grids, remove bluefire, + no longer make atm-ocn and RTM mapping files, handle large + file support and other grid-specific flags in a more robust + way, add option to differentiate between clm4_0 vs 4_5 +M models/lnd/clm/tools/clm4_5/mkmapdata/mkmapdata.sh + +========= Refactored to use built-in ESMF utility +M models/lnd/clm/tools/clm4_5/mkmapgrids/mkscripgrid.ncl + +========= Remove 0.47x0.63 for CLM4.5, since we don't have a good scrip grid + file for that resolution +M models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.csh + +========= Renumber build-namelist unit tests due to removing a + resolution. Also cleaned up expectedFails list, mostly removing + tests that now pass, changing failure types, and adding + ERB.ne30_g16.I_1948-2004, which failed in clm4_0_72, too +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +========= Fix some paths in tools test scripts +M models/lnd/clm/test/tools/TBLCFGtools.sh +M models/lnd/clm/test/tools/TBLscript_tools.sh +M models/lnd/clm/test/tools/test_driver.sh +M models/lnd/clm/test/tools/TBLtools.sh +M models/lnd/clm/test/tools/TOPtools.sh + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFAIL except: + + ***** Not listed in xFAIL list, but failed in clm4_0_72, so I'm + adding it to the xFAIL list + FAIL ERB.ne30_g16.I_1948-2004.yellowstone_intel + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: yes + All PASS or xFAIL except: + + ***** No baselines + BFAIL ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.GC.142502.compare_hist.clm4_0_72 + + From component_gen_comp, all PASS or BFAIL1 except: + + ****** No baselines + BFAIL2 ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.compare_hist.clm4_0_72.clm2.h0 (baseline history file does not exist) + BFAIL2 ERS_D.f10_f10.I_2000_CLM45_CN4MeNoVSoil.yellowstone_intel_rootlit.compare_hist.clm4_0_72.clm2.h1 (baseline history file does not exist) + + + frankfurt interactive: yes + All PASS or xFAIL (including component_gen_comp) + + + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + frankfurt interactive: no + Couldn't get tools to build on frankfurt, from either my branch or + the clm4_0_72 trunk tag + + yellowstone interactive: yes + All PASS except: + + ********* These seem to be expected failures, based on the fact that they fail in clm4_0_72. Note that the + ********* gen_domain tests themselves pass, but the baseline comparisons fail, even if I compare clm4_0_72 + ********* against itself + 006 ble14 TBLCFGtools.sh clm4_5 gen_domain CFGtools__ds T31.runoptions ..........................rc=4 FAIL + 008 ble@4 TBLCFGtools.sh clm4_5 gen_domain CFGtools__ds ne30.runoptions .........................rc=4 FAIL + 027 smiS4 TSMscript_tools.sh clm4_5 ncl_scripts getregional_datasets.pl getregional .............rc=6 FAIL + 028 bliS4 TBLscript_tools.sh clm4_5 ncl_scripts getregional_datasets.pl getregional .............rc=4 FAIL + + ********* Expected baseline failures due to changes in default behavior of CLM4_5 mksurfdata_map + ********* (see notes on answer changes, below, for what changed; I have rerun these tests with some + ********* changes on my branch and in the trunk tag to confirm that baseline comparisons pass when I + ********* revert the differences noted there) + 012 blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist ...................................rc=7 FAIL + 020 bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds rc=7 FAIL + 022 bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o ....rc=7 FAIL + 024 bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds ...rc=7 FAIL + 026 bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do ...rc=7 FAIL + 030 bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools_ rc=7 FAIL + 032 bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools_ rc=7 FAIL + + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_72 + +Changes answers relative to baseline: NO. However, changes behavior of +these offline tools: + +mksurfdata_map for clm4.5: changes the following defaults: +- use hires raw datasets (where available) for everything except pctpft +- zeroes out inland wetland areas +- changes default glacier dataset for glc_mec surface datasets +- uses correct ngwh dataset for rcp6.0 2006 & 2007 + +mksurfdata_map for clm4.0: changes the following defaults: +- uses correct ngwh dataset for rcp6.0 2006 & 2007 + +mkmapdata.sh: +- no longer generates ocean-atmosphere and RTM mapping files + +mkscripgrid.ncl: +- roundoff-level changes in coordinates +- grid_dims is fixed (now correctly nx by ny, rather than ntot by ntot) + +=============================================================== +=============================================================== +Tag name: clm4_0_72 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Thu Apr 11 15:13:40 MDT 2013 +One-line Summary: maoyi bug fix for vic hydro + +Purpose of changes: Bring in changes from Maoyi that fix a few bugs in the VIC hydrology code. Make a small change in + scripts that fixes NoVS runs. + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): 1648 + +Known bugs (include bugzilla ID): 1658 - ERB problem with clm4_0. + 1659 - RTM restart problem when under a day boundary + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: changed NoVSBGC to NoVS in scripts branch_tag + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): changed scripts branch tag to + +-scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_01_scripts4_130405a ++scripts https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_02_scripts4_130405a + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +from Maoyi Huang: + +The variable cps%ws in my original codes overlaps with another variable in the SLAKE option. So I renamed it to cps$Wsvic. +wtsub in SoilHydrologyMod.F90 when VICHYDRO was on was not initialized. To avoid any potential conflicts, I renamed it to wtsub_vic and initialized it to 0._r8. +cleaned up the codes a little bit by taking out all variables that were not used. + +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + +- updated xFail list and slightly modified test_system yellowstone.batch to reflect ERS_D and ERS_Ln48_D changes. +- tracking tputcomp and memcomp changes in advance of refactoring modifications. + + build-namelist unit tester: All OK. All Failures in clm4_0_71 now pass. + + CESM test lists: + + cesm intel: PID: 163148: OK. a number of tputcomp failures: + FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.GC.163148.tputcomp.clm4_0_71 + + cesm pgi: PID: 163101 OK. one memcomp failure + FAIL ERS.f19_g16.ICNCROP.yellowstone_pgi.GC.163101 + + test_system testing: + + yellowstone batch: OK. Fixed a problem with NoVS, found bug in + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirs.GC.162650.tputcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set2_ciso.GC.162650.memcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set2_ciso.GC.162650.tputcomp.clm4_0_71 + FAIL ERS_D.f10_f10.I_2000_CLM45_CN4Me.yellowstone_intel_ch4_set3_pftroot.GC.162650.tputcomp.clm4_0_71 + + frankfurt interactive: OK. generate and tputcomp sub-tests failed. + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.generate.clm4_0_72 + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.tputcomp.clm4_0_71 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.generate.clm4_0_72 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PTCLM45.frankfurt_intel_user_nl_dirs.GC.165025.tputcomp.clm4_0_71 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_72 + +Changes answers relative to baseline: only for VIC. Original implementation broken. Consider this tag the new baseline against which to test for VIC. + +IF tag changes answers relative to baseline comparison the +following should be filled in: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_71 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Apr 10 08:43:00 MDT 2013 +One-line Summary: compsets refactoring by mvertens + +Purpose of changes: Bring in externals that refactor the compset handling. Update CLM to + work with the new compsets. Compsets are now extensible and easier to + modify and work with. + +Requirements for tag: N/A + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): N/A + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: modify CLM to work with new compset refactor + +Describe any changes made to the namelist: modify CLM to work with new compset refactor + +List any changes to the defaults for the boundary datasets: N/A Levy's new files will come in later. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: mvertens, erik + +List any svn externals directories updated (csm_share, mct, etc.): + +https://svn-ccsm-models.cgd.ucar.edu/scripts/branch_tags/newcompsets2_tags/newcompsets2_01_scripts4_130405a +https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130403 +https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_2_26 +https://svn-ccsm-models.cgd.ucar.edu/datm7/trunk_tags/datm8_130325 +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/socn +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/sice +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/sglc +https://svn-ccsm-models.cgd.ucar.edu/stubs/trunk_tags/stubs1_4_02/swav +https://svn-ccsm-models.cgd.ucar.edu/glc/trunk_tags/cism1_130405 +http://parallelio.googlecode.com/svn/trunk_tags/pio1_6_5/pio +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308 +https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/trunk_tags/mapping_130308/gen_domain_files + +List all files eliminated: + +D models/lnd/clm/test/system/tests_posttag_lynx_nompi +D models/lnd/clm/test/system/mirage.interactive +D models/lnd/clm/test/system/TCBCFGtools.sh +D models/lnd/clm/test/system/tests_pretag_bluefire_nompi +D models/lnd/clm/test/system/config_files +D models/lnd/clm/test/system/config_files/gen_domain +D models/lnd/clm/test/system/config_files/tools__do +D models/lnd/clm/test/system/config_files/tools__s +D models/lnd/clm/test/system/config_files/CFGtools__ds +D models/lnd/clm/test/system/config_files/tools__ds +D models/lnd/clm/test/system/config_files/README +D models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +D models/lnd/clm/test/system/config_files/tools__o +D models/lnd/clm/test/system/get_cprnc_diffs.sh +D models/lnd/clm/test/system/TSMncl_tools.sh +D models/lnd/clm/test/system/CLM_compare.sh +D models/lnd/clm/test/system/TBLCFGtools.sh +D models/lnd/clm/test/system/README.testnames +D models/lnd/clm/test/system/tests_posttag_yong +D models/lnd/clm/test/system/TCBtools.sh +D models/lnd/clm/test/system/test_driver.sh +D models/lnd/clm/test/system/lynx.interactive +D models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +D models/lnd/clm/test/system/bluefire.batch +D models/lnd/clm/test/system/Makefile +D models/lnd/clm/test/system/TSMscript_tools.sh +D models/lnd/clm/test/system/tests_posttag_mirage +D models/lnd/clm/test/system/tests_posttag_frankfurt_nompi +D models/lnd/clm/test/system/gen_test_table.sh +D models/lnd/clm/test/system/TOPtools.sh +D models/lnd/clm/test/system/input_tests_master +D models/lnd/clm/test/system/TSMtools.sh +D models/lnd/clm/test/system/TBLscript_tools.sh +D models/lnd/clm/test/system/tests_posttag_nompi_regression +D models/lnd/clm/test/system/TBLtools.sh +D models/lnd/clm/test/system/show_var_diffs.sh +D models/lnd/clm/test/system/TSMCFGtools.sh + +List all files added and what they do: + +A + models/lnd/clm/test/tools +A + models/lnd/clm/test/tools/TSMscript_tools.sh +A + models/lnd/clm/test/tools/TCBCFGtools.sh +A + models/lnd/clm/test/tools/tests_posttag_frankfurt_nompi +A + models/lnd/clm/test/tools/config_files +A + models/lnd/clm/test/tools/config_files/gen_domain +A + models/lnd/clm/test/tools/config_files/tools__do +A + models/lnd/clm/test/tools/config_files/tools__s +A + models/lnd/clm/test/tools/config_files/CFGtools__ds +A + models/lnd/clm/test/tools/config_files/tools__ds +A + models/lnd/clm/test/tools/config_files/README +A + models/lnd/clm/test/tools/config_files/tools__o +A + models/lnd/clm/test/tools/get_cprnc_diffs.sh +A + models/lnd/clm/test/tools/gen_test_table.sh +A + models/lnd/clm/test/tools/TSMncl_tools.sh +A + models/lnd/clm/test/tools/CLM_compare.sh +A + models/lnd/clm/test/tools/nl_files +A + models/lnd/clm/test/tools/nl_files/nl_ch4_set2_ciso +A + models/lnd/clm/test/tools/nl_files/nl_ch4_set3_pftroot +A + models/lnd/clm/test/tools/nl_files/gen_domain.ne30.runoptions +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850 +A + models/lnd/clm/test/tools/nl_files/nl_rootlit +A + models/lnd/clm/test/tools/nl_files/gen_domain.T31.runoptions +A + models/lnd/clm/test/tools/nl_files/mksrfdt_10x15_1850 +A + models/lnd/clm/test/tools/nl_files/nl_ciso +A + models/lnd/clm/test/tools/nl_files/nl_anoxia_wtsat +A + models/lnd/clm/test/tools/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 +A + models/lnd/clm/test/tools/nl_files/mksrfdt_T31_crpglc_2000 +A + models/lnd/clm/test/tools/nl_files/clm4_0_mksrfdt_10x15_irr_1850 +A + models/lnd/clm/test/tools/nl_files/getregional +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_numaIA_mp24_2000 +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850-2000 +A + models/lnd/clm/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 +A + models/lnd/clm/test/tools/nl_files/mkmapdata_ne30np4 +A + models/lnd/clm/test/tools/nl_files/nl_vrtlay +A + models/lnd/clm/test/tools/nl_files/nl_oldhyd +A + models/lnd/clm/test/tools/nl_files/mksrfdt_1x1_vancouverCAN_2000 +A + models/lnd/clm/test/tools/nl_files/mkmapdata_if10 +A + models/lnd/clm/test/tools/TBLCFGtools.sh +A + models/lnd/clm/test/tools/input_tests_master +A + models/lnd/clm/test/tools/TOPtools.sh +A + models/lnd/clm/test/tools/README +A + models/lnd/clm/test/tools/TSMtools.sh +A + models/lnd/clm/test/tools/README.testnames +A + models/lnd/clm/test/tools/TBLscript_tools.sh +A + models/lnd/clm/test/tools/tests_posttag_yong +A + models/lnd/clm/test/tools/TCBtools.sh +A + models/lnd/clm/test/tools/test_driver.sh +A + models/lnd/clm/test/tools/tests_posttag_nompi_regression +A + models/lnd/clm/test/tools/tests_pretag_yellowstone_nompi +A + models/lnd/clm/test/tools/TBLtools.sh +A + models/lnd/clm/test/tools/show_var_diffs.sh +A + models/lnd/clm/test/tools/TSMCFGtools.sh +A + models/lnd/clm/test/tools/Makefile +A + models/lnd/clm/test/system/yellowstone.namelist + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_system +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/frankfurt.interactive +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/yellowstone.batch +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +MM models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +M models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +MM models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: + +These should pass next time around: +-these two are due to megan now being on by default: + 030/449 < FAIL> + 037/449 < FAIL> +-these four should pass next time...no baselines in clm4_0_70 + 108/449 < FAIL> + 109/449 < FAIL> + 443/449 < FAIL> + 444/449 < FAIL> + + CESM test lists: + + yellowstone/CESM: +intel: other than our expected fail list, current failures should pass during the next round of testing +pgi : see intel + +note for intel and pgi: nlcomp fails should not be considered truth or otherwise. There is a bug compare_namelist. +lots of BFAILS when comparing to clm4_0_70 and some differences in coupler hist. vars. +These are expected due to a new CISM and DATM. + + test_system testing: + + yellowstone batch: OK. See explanation for yellowstone/CESM tests above. + frankfurt interactive: OK. After modifying the frankfurt compset for 1PT. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_70 + +Changes answers relative to baseline: yes, due to CISM, but not due to any science changes in CLM itself. There will be +changes in some coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_0_70 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Apr 1 15:58:23 MDT 2013 +One-line Summary: bring in vic hydrology + +Purpose of changes: Merge in VIC hydrology. This is an isolated option that stands on it's +own and does not effect existing code. Added tests with and without vrtlay = .true.. + +Requirements for tag: Add vic tests for CLM45 and CLM45-vrtlay, normal testing protocol + +Test level of tag: standard + I_compsets + yellowstone_rtm batch + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID):VIC crashes when run in debug mode-1648 + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Add namelist option for vichydro + +Describe any changes made to the namelist: Add namelist option for vichydro + +List any changes to the defaults for the boundary datasets: Using temporary surface data sets. New datasets + will come in at a later tag. The temporary data sets do not effect normal CLM runs. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Erik,Maoyi Huang + +List any svn externals directories updated (csm_share, mct, etc.):N/A + +List all files eliminated:N/A + +List all files added and what they do: + +- For new VIC tests: +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09 +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19 +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay/user_nl_clm +A models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay +A models/lnd/clm/test/system/user_nl_dirs/vic +- For VIC implementation: +A models/lnd/clm/src/clm4_5/main/initSoilParVICMod.F90 +A models/lnd/clm/src/clm4_5/biogeophys/CLMVICMapMod.F90 + +List all existing files that have been modified, and describe the changes: + +- For VIC namelist fucntionality +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +- For new VIC tests +M models/lnd/clm/test/system/yellowstone.batch +- VIC implementation +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: OK + + CESM test lists: + + yellowstone/CESM: + cesm intel: OK. some tputcomp FAILs, but main tests pass + cesm pgi: OK. one tputcomp FAIL, main tests pass + yellowstone/CESM/allIcompsets: OK. + + test_system testing: + yellowstone rtm batch: OK. + yellowstone batch: OK. + + new VIC tests: + ERS.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_f09 + SMS.f19_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_f19 + ERS.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay + ERS_D.f09_g16.I_2000_CLM45_VIC -user_nl_dir ../models/lnd/clm/test/system/user_nl_dirs/vic/vic_vrtlay + this last one expected to Fail. + + frankfurt interactive: OK. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_69 + +Changes answers relative to baseline: No. The VIC hydro option, if turned on + does change answers, but the use of this code is isolated from the rest of CLM. + +=============================================================== +=============================================================== +Tag name: clm4_0_69 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Mar 26 16:24:54 MDT 2013 +One-line Summary: remove hydro reorder, volr and esmf mods + +Purpose of changes: fix volrlnd init. from SPVAL to 0.0 so TWS in CLM looks correct. + modify esmf interfaces for volr. remove hydrology reordering due to nasty bug in + restart. + +Requirements for tag: fix bug 1644 + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1644 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave L. and Jinyn Tang. Minor review by Erik and Bill. + +List any svn externals directories updated (csm_share, mct, etc.): update RTM to 1_0_22 + +List all files eliminated: N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 +M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + + only run CESM tests: + +=== CESM Yellowstone PGI tests: OK. All BFAILS occur in cmopare_hist which is expected due to the removal of the hydro. reordering. +Status with expected failures removed: +./cs.status.114300.yellowstone | grep -v PET_PT.f19_g16.I1850 | grep -v SMS.1x1_numaIA.ICN_CROP | grep -v PET_PT.f10_f10.I20TRCN | grep -v PET_PT.f19_g16.ICLM451850 | grep -v SMS.T31_g37.IG4804CLM45 | grep -v SMS.1x1_numaIA.ICLM45CNCROP | grep -v PET_PT.f10_f10.I20TRCLM45CN | grep -v PASS +Possible test result outcomes: +... +BFAIL SMS_RLB.f45_f45.I.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CN.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS.f19_g16.ICNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERI.f19_g16.IG1850.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS.T31_g37.IG4804.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS.1x1_numaIA.ICNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL SMS_RLB.f45_f45.ICLM45.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS_D.hcru_hcru.I_2000_CRUFRC_CLM45_CN.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERS.f19_g16.ICLM45CNCROP.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 +BFAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.GC.114300.compare_hist.clm4_0_68 + +=== CESM Yellowstone INTEL tests: OK. All BFAILS occur in cmopare_hist which is expected due to the removal of the hydro. reordering. +Status with expected failures removed: +>>./cs.status.114247.yellowstone | grep -v ERH_D.f19_g16.I1850CLM45CN | grep -v ERB.ne30_g16.I_1948-2004_CLM45 | grep -v ERS_E.f19_g16.I1850CRUCLM45CN | grep -v CME.f10_f10.ICN | grep -v ERS_D.f10_f10.ICLM45 | grep -v PET_PT.f19_g16.I1850CN | grep -v ERB.ne30_g16.I_1948-2004 | grep -v PET_PT.f10_f10.I20TRCN | grep -v PET_PT.f19_g16.I1850CLM45CN | grep -v ERS_E.f19_g16.ICLM451850 | grep -v ERS_D.f19_g16.IGRCP26CLM45CN | grep -v ERS_Lm3.f19_g16.IGRCP60CLM45CN | grep -v PET_PT.f10_f10.I20TRCLM45CN | grep -v SMS.f19_g16.IRCP45CLM45CN | grep -v ERS_D.f19_g16.IRCP85CLM45CN | grep -v PASS | grep -v COMMENT +... +FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f10_f10.I.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL NCK.f10_f10.I.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_E.f19_g16.I1850.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERH_D.f19_g16.I1850CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL SMS.f19_g16.IRCP45CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 +FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.114247.memcomp.clm4_0_68 +FAIL SMS_ROA.f45_f45.ICLM45.yellowstone_intel.GC.114247.tputcomp.clm4_0_68 +FAIL NCK.f10_f10.ICRUCLM45.yellowstone_intel.GC.114247.compare_hist.clm4_0_68 + +=== test_system yellowstone.rtm.batch: OK. All compare_hist failures are expected due changes in photosynthesis + +CLM tag used for the baseline comparison tests if applicable: For Cesm intel and pgi tests- clme_0_68 + for rtm tests, against clm4_0_66. + for science validation, clm4_0_66 + +Changes answers relative to baseline: yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + obvious changes in GPP,FPSN and FCTR. Other fields changed as well. + ran the following and had Dave L. and Jinyun Tang look at output. + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_66/ + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_68/ + f19_g16_I_1850_CLM45_CN_yellowstone_intel_photo_clm4_0_69/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_66/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_68/ + f19_g16_ICLM45_yellowstone_intel_photo_clm4_0_69/ + +=============================================================== +=============================================================== +Tag name: clm4_0_68 +Originator(s): erik (Erik Kluzek) +Date: Sat Mar 16 16:03:14 MDT 2013 +One-line Summary: Fix mksurfdata_map for ne120np. Error out if SUM(weights)/=100. Photosynthesis change for CLM45. + +Purpose of changes: + +Bring in ne120fix branch to trunk. This fixes some issues in mksurfdata_map for generation +of ne120np surface data file. Put error back in CLM if weights don't sum to 100. Add in +Keith Oleson's photosynthesis change. This changes canopy top: triose phosphate utilization rate at 25C to +be dependent on vcmax25top ( maximum rate of carboxylation) rather than jmax25top (maximum electron +transport rate). Update getco2_historical.ncl script to be able to handle rcp files as well. + +Update scripts so that I1PT settings for urban single-point files will be used, and IRCP +will properly do a hybrid startup. And seperate out intel/pgi test lists. + +Update datasets for ne120np4 and ne240np4 (CLM40), with updated mksurfdata_map. + +Requirements for tag: + Tools test, yellowstone batch, fix bug 1632/1643 + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1632 (ne120np4 mksurfdata problem) + 1643 (Fix RES_COMPSET_MATCH for I1PT, IRCP*) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New surfdata and pftdyn files for ne120np4 (CLM40) + New surfdata files for ne240np4 (CLM40) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, sacks (mksrfdata changes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts updated to scripts4_130315c + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/yellowstone.batch --- Fix some compset names + + M models/lnd/clm/tools/clm4_5/ncl_scripts/getco2_historical.ncl - Handle rcp CO2 files + M models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 -- Clean out small PFT values + M models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 -- Clean out small PFT values + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml ------- Update ne120/ne240 surfdata/pftdyn datasets + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml ------- Delete ALL finidat files as none compatible + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml - Add rcp CO2 datasets: rcp2.6/4.5/6/8.5 + + M models/lnd/clm/src/clm4_5/main/surfrdMod.F90 - Add back abort if surfdata weights don't sum to 100% + M models/lnd/clm/src/clm4_0/main/surfrdMod.F90 - Add back abort if surfdata weights don't sum to 100% + M models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 - change in photosynthesis + +Changes in expected fails for testing: + + build-namelist unit-test: Following fail because of new datasets will pass next tag + 203 ne120 + 208 ne240 + 306 ne120 20th Century + 428 48x96 for CLM45 (remove finidat) + failType="FAIL">answers change on restart + + + Changes to expected fail: + + + + ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart ++ answers change on restart + + + + + +Restart difference + +Restart difference + +Restart difference + +Restart difference + +Restart difference + +Machines testing ran on: (Tests in priority order) + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: yes + + test_system testing: + + yellowstone batch: yes + frankfurt interactive: yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + +CLM tag used for the baseline comparison tests if applicable: clm4_0_68 + +Changes answers relative to baseline: Yes! + + - what code configurations: + All CLM45 change because of change in photosynthisis + I1PT compsets change because of scripts bug + IRCP compsets now startup with new initial conditions + - what platforms/compilers: All + - nature of change: similar climate + +=============================================================== +=============================================================== +Tag name: clm4_0_67 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Tue Mar 12 11:14:59 MDT 2013 +One-line Summary: Jinyun photosynthesis and hydrology reorder + +Purpose of changes: Bring in mods that reorder hydrology code and modes that + address photosynthesis CN code. This tag is F90 code only. + +Requirements for tag: N/A + +Test level of tag: std-test + ICompset tests + yellowstone interactive + +Bugs fixed (include bugzilla ID): N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets:N/A + +Describe any substantial timing or memory changes:N/A + +Code reviewed by: Dave L, S. Swenson, self + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated:N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +Major changes in CNEcosystemDynMod, SoilHydrologyMod and Hydrology2Mod. Also did some deadCode removal (unused pointer +assignments, unused modules and local variables. + + M biogeochem/CNEcosystemDynMod.F90 - effects CN. Split out CNEcosystemDynA and CNEcosystemDynB + + M main/CNiniTimeVar.F90 - removed some commented out code + M main/clmtypeInitMod.F90 - removed commented out init_gridcell_pstate_type + M main/pftdynMod.F90 + M main/initSurfAlbMod.F90 - effects CN. For photosynthesis. + M main/clm_driver.F90 + M main/CNiniSpecial.F90 + M ain/clmtype.F90 + M main/histFldsMod.F90 + + M biogeophys/Hydrology2Mod.F90 - split out 2A and 2B subroutines + M biogeophys/SoilHydrologyMod.F90 - split out new WaterTable routine from existing Drainage routine + M biogeophys/BareGroundFluxesMod.F90 + M biogeophys/CanopyFluxesMod.F90 - For photosynthesis. + + +Machines testing ran on: (Tests in priority order) + +Dave Lawrence looked at 1 year runs to make sure behavior looked OK before and after mods. +S. Swenson looked at short simulations to make sure reordering worked correctly in the hydrology code. +Expect changes in the following fields (depending on compset and test type) + +roff Flrl_rofliq +roff Flrl_rofliq +lnd Flrl_rofliq +lnd Flrl_rofliq +roff Forr_roff +roff Forr_roff +roff Flrl_rofliq +roff Flrl_rofliq +lnd Fall_lat +lnd Fall_lat +lnd Fall_sen +lnd Fall_sen +lnd Fall_evap +lnd Fall_evap +lnd Flrl_rofliq +lnd Flrl_rofliq +roff Forr_roff +roff Forr_roff +roff Flrl_rofliq +roff Flrl_rofliq +lnd Sl_fv +lnd Sl_f + +l2x_Sl_avsdr +l2x_Sl_anidr +l2x_Sl_avsdf +l2x_Sl_anidf +l2x_Sl_tref +l2x_Sl_qref +l2x_Sl_t +l2x_Sl_fv +l2x_Sl_ram1 +l2x_Sl_snowh +l2x_Sl_u10 +l2x_Fall_swnet +l2x_Fall_taux +l2x_Fall_tauy +l2x_Fall_lat +l2x_Fall_sen +l2x_Fall_lwup +l2x_Fall_evap +l2x_Fall_flxdst1 +l2x_Fall_flxdst2 +l2x_Fall_flxdst3 +l2x_Fall_flxdst4 +l2x_Flrl_rofliq +x2l_Slrr_volr +r2x_Slrr_volr +r2x_Forr_roff +r2x_Forr_ioff +x2r_Flrl_rofliq + + build-namelist unit tester: yes - OK + + CESM test lists: + + yellowstone/CESM: yes - OK. Fails are due to new code. These should pass next tag. + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirGC.113407 + oAIL ERS_D.fol_g16.I_1850_CLM45_CNCENTNoMe.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.113407 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.yellowstone_intel_ciso.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.GC.113407 + + yellowstone/CESM/allIcompsets: yes - OK + + test_system testing: + + yellowstone batch: yes - OK. Fails are due to new code. These should pass next tag. + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_D.f19_g16.I_1850_CLM45_CNCENTNoMe.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.GC.113407 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.113407 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.yellowstone_intel_crop.GC.113407 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.113407 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.yellowstone_intel_ciso.GC.113407.compare_hist.clm4_0_66 + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.GC.113407 + + frankfurt interactive: yes - OK + yellowstone interactive: yes - reasonably OK. Added a few tests to xFail list that need new + surface data sets. + The following fail due to new code and should pass next round: + + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45USUMB.yellowstone_intel_user_nl_dirs.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.075359 + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CLM45_CN.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45_CNDV.yellowstone_intel_monthly.GC.075359.compare_hist.clm4_0_66b + +CLM tag used for the baseline comparison tests if applicable: clm4_0_66 + +Changes answers relative to baseline: Photosynthesis mods and reordering will change answers + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): hydrology reordering will introducce very small changes due to the process of moving around, but not changing code. + photosysthesis mods are major changes that effect science + + +=============================================================== +=============================================================== +Tag name: clm4_0_66 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Thu Mar 7 11:54:05 MST 2013 +One-line Summary: turn off subgrid topography snow parameterization for glc_mec landunits + +Purpose of changes: + +Change from Sean Swenson to turn off subgrid topography snow +parameterization over glc_mec landunits: ice_mec columns already account +for subgrid topographic variability through their use of multiple elevation +classes; thus, to avoid double-accounting for topographic variability in +these columns, we ignore topo_std and use a value of n_melt that assumes +little topographic variability within the column. + +Requirements for tag: yellowstone cesm tests, make sure GLC test goes + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFail (ignoring tput failures); only baseline failure is, + the following, which is an expected failure: + FAIL ERI.f19_g16.IG1850CLM45.yellowstone_pgi.C.113330.compare_hist.clm4_0_65 + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_65 + +Changes answers relative to baseline: Yes, just for CLM4.5 with glc_mec + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with glc_mec + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: N/A + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_65 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Thu Mar 7 09:53:31 MST 2013 +One-line Summary: back out Machines external to get more tests to pass, especially IG + +Purpose of changes: + +Some tests - particularly IG - became broken in clm4_0_64. This tag rolls +back the Machines external so that GLC compiles properly. + +Requirements for tag: + +Test level of tag: only yellowstone CESM tests + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): +-scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130304b ++scripts/ccsm_utils/Machines https://svn-ccsm-models.cgd.ucar.edu/Machines/trunk_tags/Machines_130301 + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Difference in expected fails: this brings the xfail list back to what it +was in clm4_0_63, with the exception of some SBN IcompsetTests that were +added to xFail in clm4_0_64: +@@ -154,12 +154,6 @@ + scripts issue component not threaded + missing finidat file + missing finidat file +- +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- +- ERROR: lnd_prognostic but num_inst_lnd not num_inst_max +- ERROR: lnd_prognostic but num_inst_lnd not num_inst_max + + + scripts issue with ocean not threaded +@@ -170,10 +164,6 @@ + checkWeights error, probably due to old-format urban on surface dataset + Bad compset name: ICNCROP + scripts issue with ocean not threaded +- +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' +- No rule to make target `glc_constants.o/glade/scratch/muszala/ERI.f19_g16.IG1850.yellowstone_pgi.GC.161430/bld/glc/lib/libglimmercismfortran.a', needed by `glc_constants.mod' + + + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + + build-namelist unit tester: no + + CESM test lists: + + yellowstone/CESM: yes + All PASS or xFail (ignoring tput failures) + (note that baselines didn't exist in clm4_0_64 for some tests, + particularly IG) + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: no + frankfurt interactive: no + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_64 + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm4_0_64 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Mar 6 12:41:26 MST 2013 +One-line Summary: update externals. fixes 40/45 intial condition problem + +Purpose of changes: Main purpose is to bring in scripts4_130227b so that + CLM45 compsets do not use CLM40 initial conditions. Put in + PTCLM fix. Secondary purpose is to update other externals. + NOTE: This tag only changes externals. No clm + code, scripts or xml files were touched. + +Requirements for tag: N/A + +Test level of tag: critical (only yellowstone, Icompset and aux 40/45 aux tests) + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Changes in processor count for certain resolutions. + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: the 40/45 fix in scripts4_130227b will fix initial condition problems. + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: muszala, Erik + +List any svn externals directories updated (csm_share, mct, etc.): + + cprnc_120828 -> cprnc_130301 + scripts4_130207 -> scripts4_130304 + Machines_130214 -> Machines_130304b + rtm1_0_19 -> rtm1_0_20 + share3_130220 -> share3_130226 + esmf_wrf_timemgr_120427 -> esmf_wrf_timemgr_130213 + timing_120731 -> timing_130214 + mapping_121113b -> mapping_130222 + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: N/A + + M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + M SVN_EXTERNAL_DIRECTORIES + +Machines testing ran on: (Tests in priority order) + yellowstone/CESM: yes - looks decent, but not great. There are no new test failures and new tests that do fail are + most likely due to new testlists that weren't tested in a clm tag. + A few nl comp failures since number of pes changed (expected). + Many comparisons failed due to baselines not existing. + 5 IG compsets fail due to a linking error. + 2 NCK.F10_f10 tests die with "ERROR: lnd_prognostic but num_inst_lnd not num_inst_max" + + yellowstone/CESM/allIcompsets: yes - looks OK. Transient runs added to xFail list as well as SBN.1x1_smallvilleIA.ICLM45CNCROP + and SBN.f09_g16.IGCLM45IS2 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_63 + +Changes answers relative to baseline: Yes. PE counts change plus the initial condition fixes will change answers compared + to existing baselines + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + The 40/45 fix should bring this back to being correct (ie. the state before clm4_0_60). + +=============================================================== +=============================================================== +Tag name: clm4_0_63 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Mon Mar 4 13:50:15 MST 2013 +One-line Summary: bug 1635 fix - 4_0 CN bug + +Purpose of changes: Put back some removed code. This allows CN to run with 4_0 + beyond one year + +Requirements for tag: + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): 1635 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: Dave Lawrence, Sam Levis + +List any svn externals directories updated (csm_share, mct, etc.): N/A + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 +--- models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 (revision 44311) ++++ models/lnd/clm/src/clm4_0/biogeochem/CNAnnualUpdateMod.F90 (working copy) +@@ -183,6 +183,12 @@ + call p2c(num_soilc, filter_soilc, annavg_t2m, cannavg_t2m) + end if + + + ! column loop + + do fc = 1,num_soilc + + c = filter_soilc(fc) + + if (annsum_counter(c) >= get_days_per_year() * secspday) annsum_counter(c) = 0._r8 + + end do + + + end subroutine CNAnnualUpdate + !----------------------------------------------------------------------- + + +Machines testing ran on: (Tests in priority order) + yellowstone/CESM: yes only 40 list - OK. Matches xFail list + yellowstone/CESM/allIcompsets: yes - OK. Matches xFail list + + Also had D. Lawrence look at one 45 run and a 40 run from this tag compared to one from + clm4_0_58 (the tag just before this bug was introduced). All three runs were 2 years long. + +CLM tag used for the baseline comparison tests if applicable: clm4_0_62 + +Changes answers relative to baseline: No + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_62 +Originator(s): sacks (Bill Sacks,UCAR/CGD,303-497-1762) +Date: Sun Feb 24 15:27:09 MST 2013 +One-line Summary: add active flags, change subgrid weighting convention, other misc fixes + +Purpose of changes: + +Main set of changes involves adding 'active' flags at the pft, column & landunit +levels, saying whether computations should be run over a given point. This +change involved many changes throughout the code, changing conditionals like 'if +(pwtgcell(p) > 0)' to 'if (pactive(p))'. The purpose of this change was +two-fold: (1) make these conditionals less error-prone and more robust to future +changes in the code: currently, the 'active' condition is: weight > 0 OR type = +glc_mec -- but sometimes people forgot to include the latter condition, and it +could get worse moving forwards; (2) make it easy to change the 'active' +condition in the future -- this now just has to be done in one place, in +reweightMod. + +In changing these conditionals to use the new 'active' flags, I also added or +removed conditionals in a few places -- see notes below on the individual file +modifications. + +Also, changed subgrid weighting convention, so that the sum of weights always +adds to 1 at all levels. Previously, there was no fixed convention for the +weights of, e.g., pfts on a 0-weight column. Now, even on a 0-weight column, the +sum of pft weights on the column will still add to 1. + +Also a number of other miscellaneous fixes: +- bug-fix in handling of unstructured grids in determining new vs old urban format +- add some new surface datasets with new urban format +- other misc. fixes noted below + +Requirements for tag: + Testing: build-namelist unit tests, yellowstone cesm, yellowstone + test_system batch, frankfurt test_system interactive; include + component_gen_comp for test_system tests + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: A few new surface datasets (see below) + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): +Main purpose is to update cism (along with necessary scripts & machines +updates), but also updated other externals to their cesm1_2_beta02 versions: +- scripts +- machines +- cism +- mct +- pio +- csm_share (includes scam update from Erik) + +List all files eliminated: + +List all files added and what they do: + +======= Handles modifications and error-checks related to changing subgrid weights +======= (note that direct calls to setFilters should no longer be made -- +======= instead, call reweightWrapup in this new module). This adds a routine that confirms +======= that all subgrid weights add to 1 (from Zack Subin). +A models/lnd/clm/src/clm4_5/main/reweightMod.F90 + +List all existing files that have been modified, and describe the changes: + +======= add 'active' flags; replace use of things like 'if (pwtgcell(p) > 0)' +======= with 'if (pactive(p))' +M models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 ---------- also removed unnecessary conditional +M models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 ------------ also added a pactive check +M models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +M models/lnd/clm/src/clm4_5/main/dynlandMod.F90 --------------- also added a new conditional +M models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +M models/lnd/clm/src/clm4_5/main/histFileMod.F90 +M models/lnd/clm/src/clm4_5/main/controlMod.F90 +M models/lnd/clm/src/clm4_5/main/filterMod.F90 +M models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 ------------ also added a new conditional in p2c_2d_filter + (similar to existing conditional in p2c_1d_filter) +M models/lnd/clm/src/clm4_5/main/clmtype.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 --- also remove ^M line endings accidentally added in clm4_0_61 +M models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 + +======= replace calls to setFilters with calls to reweightWrapup; in driver, +======= moved these calls based on an analysis of where they are needed +M models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +M models/lnd/clm/src/clm4_5/main/clm_driver.F90 + +======= change subgrid weighting convention; remove duplicated code in setting +======= up urban landunits. Note that, in a few places (marked by "TODO WJS") I +======= assumed an arbitrary weighting for, e.g., pft weights in a 0-weight +======= landunit. This can be changed in the future once we change how weights +======= are defined on the surface dataset (using weights on the landunit rather +======= than on the grid cell). +M models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 + +======= declare some parameters as 'parameter' (needed in order to use them in +======= select case statements) +M models/lnd/clm/src/clm4_5/main/clm_varcon.F90 + +======= make check for new vs old format more robust; in particular, fix +======= handling of unstructured grids (before, these were deemed to be +======= old-format urban files by accident) +M models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 + +======= use nlevurb=5 even for more_vertlayers (based on suggestion from Keith +======= and Erik) +M models/lnd/clm/src/clm4_5/main/clm_varpar.F90 + +======= use new surface datasets for glcmec 1.9x2.5 1850&2000, and f10 1850, in +======= order to have valid urban data for some tests to pass +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml + +======= use cism rather than sglc for test_system tests, because sglc means no +======= sno fields are sent to the coupler, which leads to ERS test failures and +======= generally weaker tests +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml + +======= add cism1 distinction in compset name +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/bluefire.interactive +M models/lnd/clm/test/system/lynx.batch + +======= add call to component_gen_comp +M models/lnd/clm/test/system/test_system + +======= Removed some now-passing tests, including some that were passing earlier +======= but still remained in this file +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +xFAIL differences: +Index: models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +=================================================================== +--- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (revision 44092) ++++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (working copy) +@@ -113,8 +113,7 @@ + + + +- +- ++ + + + +@@ -137,7 +136,6 @@ + + scripts issue with ocean not threaded + Restart difference +- Soil balance error on restart + scripts issue with ocean not threaded + + scripts issue with ocean not threaded +@@ -149,20 +147,12 @@ + missing finidat file + + +- problem building with mpi-serial with pgi compiler +- missing LAPACK symbol dgbsv + scripts issue with ocean not threaded +- Need LAPACK for PGI (dgbsv) +- Need LAPACK for PGI (dgbsv) + Bad compset name: ICNCROP + scripts issue with ocean not threaded + +- problem building with mpi-serial with pgi compiler +- missing LAPACK symbol dgbsv +- missing LAPACK symbol dgbsv + scripts issue with ocean not threaded +- Need LAPACK for PGI (dgbsv) +- Need LAPACK for PGI (dgbsv) ++ checkWeights error, probably due to old-format urban on surface dataset + Bad compset name: ICNCROP + scripts issue with ocean not threaded + + + +Machines testing ran on: (Tests in priority order) + Standard Tag Pretag *** Standard Tag Posttag ** + +NOTE: Ignoring throughput fails + + + build-namelist unit tester: yes + All PASS or xFAIL + + CESM test lists: + + Note: the following change was made after running the CESM test list (just + reran the one affected case: ERI.f19_g16.IG1850CLM45.yellowstone_pgi): + In bld/namelist_files/namelist_defaults_clm4_5.xml: + -lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_glcmec10_c120927.nc + +lnd/clm2/surfdata_map/surfdata_1.9x2.5_simyr1850_glcmec10_c130221.nc + + yellowstone/CESM: yes + All PASS or xFAIL except: + + ***** Expected failure due to urban bug-fix for unstructured grids + FAIL ERB.ne30_g16.I_1948-2004_CLM45.yellowstone_intel.GC.051632.compare_hist.clm4_0_61 + + ***** memcomp failures probably due to using cism2 code + FAIL ERS_D.f19_g16.IGRCP26CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + + ***** memcomp failures with unknown cause + FAIL ERS_D.f19_g16.IRCP85CN.yellowstone_intel.GC.051626.memcomp.clm4_0_61 + COMMENT pesmaxmem_incr = 28.2 + + yellowstone/CESM/allIcompsets: no + + test_system testing: + + yellowstone batch: yes, including component_gen_comp + All PASS or xFAIL except: + + ***** Expected failure due to new surface dataset + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.GC.051756.compare_hist.clm4_0_61_test_system + + ***** Expected failure due to urban bug-fix for unstructured grids + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.GC.051756.compare_hist.clm4_0_61_test_system + + ***** memcomp failures with unknown cause + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.yellowstone_intel_voc.GC.051756.memcomp.clm4_0_61_test_system + FAIL ERS_Ln48_D_P64x16.ne30_g16.ICN.yellowstone_intel_user_nl_dirs.GC.051756.memcomp.clm4_0_61_test_system + + + ----- COMPONENT_GEN_COMP RESULTS --- + All comparisons PASS except: + + ****** Expected failures due to new surface dataset and fix in urban for + ****** ne30 These failures all go away when I compare against one-offs + ****** from clm4_0_61 with fixes in surface datasets and the urban ne30 + ****** bug. However, there is then a diff in the h1 file for the GLCMEC + ****** test: diffs just in cols1d_wtlunit & pfts1d_wtlunit, and this is + ****** just over glc_mec columns -- this is expected due to changes in + ****** subgrid weighting convention + FAIL ERS_D.f19_g16.ICLM45GLCMEC.yellowstone_intel_glcMEC.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.yellowstone_intel_monthly.compare_hist.clm4_0_61.clm2.h1 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h0 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h1 + + ****** Differences just over crop landunits: RMS diffs in pft weights on + ****** col and landunit, and col weights on landunit; and FILLDIFFs in 12 + ****** column-level variables (now _FillValue in 0-weight places). These + ****** differences aren't surprising given the changes in subgrid weight + ****** convention and the fact that inactive points are now given spval in + ****** 1-d output + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.yellowstone_intel_user_nl_dirs.compare_hist.clm4_0_61.clm2.h1 + + + frankfurt interactive: yes, including component_gen_comp + All PASS or xFAIL + + yellowstone interactive: no + lynx batch: no + lynx interactive: no + frankfurt batch: no + + test_driver.sh tools testing: + + lynx interactive: no + yellowstone interactive: no + + yellowstone/PTCLM: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_61 + +Changes answers relative to baseline: yes, in limited cases - see below + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CLM4.5 with the following: + - unstructured grids, due to urban bug fix + - glcmec @ 1.9x2.5, due to new surface datasets with new urban + - 1850 @ f10, due to new surface dataset + - what platforms/compilers: ALL + - nature of change: larger than roundoff/same climate OR new climate (not + investigated carefully) + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: NOT DONE + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_61 +Originator(s): muszala (Stefan Muszala,UCAR/CGD,303-497-1320) +Date: Wed Feb 20 15:53:38 MST 2013 +One-line Summary: rtm, drv and clm mods: tws, Volr, r01 rdric file and SoilHydroMod + +Purpose of changes: Bring Volr from RTM to CLM. + New ne120 files. + New SoidHydrologyMod file for 45 (not bit-for-bit) + Bring tws in. + Sacks test list change and test_system change. + Add yellowstone to xFail options. + Added RTM test list for test_system tests (yellowstone.rtm.batch) + DEPRECATE WT in 4_5 code. WT and the variable wt are left in since they are used in other + portions of the code, but they are marked as deprecated since we now have TWS. + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: muszala, swenseon, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): + drv: update from drvseq4_2_20 to drvseq4_2_22 + rtm: update from rtm1_0_18 to rtm1_0_19 + csm_share: update from share3_130213 to share3_130131 + +List all files eliminated: +D https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn +D https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01 + +List all files added and what they do: + Added RTM rtm test_system tests +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOff/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOff +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOn/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnFloodOnEffvelOn +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOff/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOff +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOn/user_nl_rtm +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOnIceOn +A https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.rtm.batch + +List all existing files that have been modified, and describe the changes: +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/test_system +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.interactive +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff/user_nl_rtm +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/README +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/test/system/yellowstone.batch +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/doc/ChangeLog +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/doc/ChangeSum +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/clmtype.F90 +MM https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/models/lnd/clm/src/clm4_0/main/clm_atmlnd.F90 +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/SVN_EXTERNAL_DIRECTORIES +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/ChangeLog +M https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_60/ChangeSum + + +Machines testing ran on: (Tests in priority order) + NOTE: Lots of throughput, NLComp and memcomp fails. Also ran rtm test_system tests + + build-namelist unit tester: OK (yellowstone) - added two tests that were missing from xFail list + + CESM test lists: + + yellowstone/CESM: + -> 4_0 testing: OK. Removed tests in xFail file and ignoring NLComp tests. Remaining Fails (tputcomp and memcomp) will be ignored since test tolerences are too narrow. + + -> 4_5 testing: OK. There will be B4B differences due to a new SoilHydrologyMod which are listed below + + FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL SMS_RLA.f45_f45.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERS_D.f10_f10.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL NCK.f10_f10.ICLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERB.ne30_g16.I_1948-2004_CLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERH_D.f19_g16.I1850CLM45CN.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL SMS.1x1_mexicocityMEX.I1PTCLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PTCLM45.yellowstone_intel.GC.161028.compare_hist.clm4_0_60 + + yellowstone/CESM/allIcompsets: OK + + test_system testing: + + yellowstone batch: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS.f19_g16.I_1850_CLM45_CN4Me.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_D.f19_g16.I_1850_CLM45_CNCENTNoMe.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS.f19_g16.I_2000_CLM45_CN4Me_CROP.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211.f10_f10.ICLM45CNADSPIN.monthly.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D_P64x1.ne30_g16.ICLM45CN.user_nl_dirs.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211_D_P224x1.f10_f10.ICLM45CNCROP.crop.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211_P384x1.f19_g16.ICLM45CNDVCROP.crop.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ld211.f10_f10.I_2000_CLM45_VOC_CN.voc.GC.114029.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D.f10_f10.I_2000_CLM45_CN.ciso.GC.114029.compare_hist.clm4_0_60 + + frankfurt interactive: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.ICLM451PT.frankfurt_intel_user_nl_dirs.GC.104908.compare_hist.clm4_0_60 + FAIL ERS_Mmpi-serial.1x1_mexicocityMEX.ICLM451PT.frankfurt_intel_user_nl_dirs.GC.104908.compare_hist.clm4_0_60 + + yellowstone interactive: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45alaskaCN.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_Mmpi-serial.CLM_USRDAT.ICLM45USUMB.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_P1x1_Mmpi-serial.f19_g16.I20TR_CLM45VSCN.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_D_P1x1_Mmpi-serial.5x5_amazon.I_2000_CLM45.yellowstone_intel_user_nl_dirs.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ln48_D_P1x1_Mmpi-serial.f45_g37.ICLM45VOC.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CLM45_CN.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CLM45_CNDV.yellowstone_intel_monthly.GC.114053.compare_hist.clm4_0_60 + FAIL ERS_Ld211_Mmpi-serial.1x1_brazil.IVSCN.yellowstone_intel_voc.GC.114053.compare_hist.clm4_0_60 + + frankfurt batch: + OK. FAILs due to new SoilHydroMod and r2x_Slrr_volr in coupler + + FAIL ERS_D_P16x1.f19_g16.I_1850_CLM45_CN4Me.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERI_P16x1.f19_g16.I_1850_CLM45_CNCENTNoMe.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_Ld211_P16x1.f10_f10.ICLM45CNADSPIN.frankfurt_intel_monthly.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_P16x1.f19_g16.I_1850_CLM45_CN4Me_LessSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f19_g16.I_1850_CLM45_CN4Me_EXLessSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f10_f10.I_2000_CLM45_CN4Me.frankfurt_intel_vrtlay.GC.104516.compare_hist.clm4_0_60 + FAIL ERS_D_P16x1.f19_g16.I_2000_CLM45_CN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL ERI_P16x1.f19_g16.I_2000_CLM45_CN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + FAIL SMS_D_P16x1.f19_g16.ICLM45CNEXSPIN.frankfurt_intel_user_nl_dirs.GC.104516.compare_hist.clm4_0_60 + +CLM tag used for the baseline comparison tests if applicable: CLM4_0_60 + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: 4_5 code + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + 1) SoilHydrologyMod.F90 mods from Swenson effect soil moisture which are effecting certain l2x coupler fields + 2) bringing VOLR from RTM through the coupler adds one more field to coupler history files. + +=============================================================== +=============================================================== +Tag name: clm4_0_60 +Originator(s): erik (Erik Kluzek) +Date: Mon Feb 11 03:55:56 MST 2013 +One-line Summary: Bring CLM4.5 code from clm45sci branch to trunk as an option set at configure time + +Purpose of changes: + +Bring in CLM4.5 branch as additional directories. Change directory structure, so there are shared files +and utilities for both CLM4.0 and CLM4.5 and files that are different for each. Update compsets in +scripts in order to work in this paradigm. Move clm45sci15_clm4_0_58 code to trunk under clm4_5 phys. + +clm4.5 includes the following: + +* Bring LBNL-merge branch on with: vertical soil, Methane, CENTURY, split nitrification, new-lake model. +* Modifications to GPP, on gppdev branch, multilayer canopy and then single-layer version that reproduces it. +* Crop model updates. Irrigation included with crop model as an option. Fix CNDV-CROP. +* Urban model updates, multi-density, urban depth seperate from soil depth, wasteheat to zero +* Bring in permafrostsims09 branch with Sean Swensons's flooding changes. +* Update pft-physiology file, change some CN defaults, change min flow slightly in RTM +* Set ponding to zero, acclimation mods from Keith Oleson, a hydrology change from Sean Swenson. + +Requirements for tag: clm40/clm45 code/tools work/tested, answers same, complete move from bluefire to yellowstone + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1621 (normalization issue in mksurfdata_map and clm -- partial) + 1604 (The -co2_type flag in the CLM namelist is not set correct.) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Compsets to run CLM4.5 added. + +I_2000_CLM45 (ICLM45) +I_2000_1PTFRC_CLM45 (I1PTCLM45) +I_2000_GLC_CLM45_CISM1 (IGCLM45) +I_2000_GLC_CLM45_CISM2P (IGCLM45IS2) +I_2000_CLM45_CN (ICLM45CN) +I_2000_CLM45_CN_CROP (ICLM45CNCROP) +I_2000_CLM45_CN_4Me (ICLM45CN4Me) +I_2000_CRUFRC_CLM45 (ICRUCLM45) +I_2000_CRUFRC_CLM45_CN (ICRUCLM45CN) +I_2000_CRUFRC_CLM45_CN_4Me (ICRUCLM45CN4Me) +I_2000_CLM45_CN_GLC_CISM1 (IGCLM45CN) +I_1850_CLM45 (I1850CLM45) +I_1850_CLM45_CN_4Me (I1850CLM45CN4Me) +I_1850_CRUFRC_CLM45 (I1850CRUCLM45) +I_1850_CRUFRC_CLM45_CN (I1850CRUCLM45CN) +I_1850_CRUFRC_CLM45_CN_4Me (I1850CRUCLM45CN4Me) +I_1850_CLM45_GLC_CISM1 (IG1850CLM45) +I_1850_CLM45_CN (I1850CLM45CN) +I_1850-2000_CLM45 (I20TRCLM45) +I_1850-2000_CLM45_CN (I20TRCLM45CN) +I_1850-2000_CRUFRCCLM45 (I20TRCRUCLM45) +I_1850-2000_CRUFRC_CLM45_CN (I20TRCRUCLM45CN) +I_1850-2000_CRUFRC_CLM45_CN_4Me (I20TRCRU4MeCLM45) +I_1850-2000_CLM45_GLC_CISM1 (IG20TRCLM45) +I_1850-2000_CLM45_CN_GLC_CISM1 (IG20TRCLM45CN) +I_1948-2004_CLM45 (I4804CLM45) +I_1948-2004_CLM45_GLC_CISM1 (IG4804CLM45) +I_1948-2004_CLM45_CN_GLC_CISM1 (IG4804CLM45CN) +I_RCP8.5_CLM45_CN_GLC_CISM1 (IGRCP85CLM45CN) +I_RCP6.0_CLM45_CN (IRCP60CLM45CN) +I_RCP6.0_CLM45_CN_GLC_CISM1 (IGRCP60CLM45CN) +I_RCP4.5_CLM45_CN (IRCP45CLM45CN) +I_RCP4.5_CLM45_CN_GLC_CISM1 (IGRCP45CNCLM45) +I_RCP2.6_CLM45_CN (IRCP26CLM45CN) +I_RCP2.6_CLM45_CN_GLC_CISM1 (IGRCP26CLM45CN) +I_RCP8.5_CLM45_CN (IRCP85CLM45CN) +I_1850_SPINUP_3HrWx_CLM45_CN_4Me + + CLM configure changes: + + Add physics option to determine if CLM4.0 or CLM4.5 physics is used: ++ -phys Value of clm4_0 or clm4_5 (default is clm4_0) + + Options removed + + -pergro + -c13 + + Options added for CLM4.5 physics: + ++ -clm4me Turn Methane model: [on | off] ++ Requires bgc=cn/cndv (Carbon Nitrogen model) ++ (ONLY valid for CLM4.5!) ++ -exlaklayers Turn on extra lake layers (25 layers instead of 10) [on | off] ++ (ONLY valid for CLM4.5!) ++ -vsoilc_centbgc Turn on vertical soil Carbon profile, CENTURY model decomposition, ++ split Nitrification/de-Nitrification into two mineral ++ pools for NO3 and NH4 (requires clm4me Methane model), and ++ eliminate inconsistent duplicate soil hydraulic ++ parameters used in soil biogeochem. ++ (requires either CN or CNDV) ++ (ONLY valid for CLM4.5!) ++ [on,off or colen delimited list of no options] (default off) ++ no-vert Turn vertical soil Carbon profile off ++ no-cent Turn CENTURY off ++ no-nitrif Turn the Nitrification/denitrification off ++ no-stnd-bsw Turn the standard BSW for soil psi off ++ [no-vert,no-cent,no-nitrif,no-stnd-bsw, ++ no-vert:no-cent,no-nitrif:no-stnd-bsw, ++ no-vert:no-cent:no-stnd-bsw] + + New spinup options added for CLM4.5 physics (but are now deprecated and NOT recommended for use) + ++ Enter-AD Turn on Accelerated Decomposition from (6) ++ existing initial conditions (optional) (deprecated) ++ (ONLY valid for CLM4.5!) ++ AD2Lesser Jump from full AD to lesser AD spinup (optional) (4) ++ (deprecated) (ONLY valid for CLM4.5!) ++ LesserAD Lesser Accelerated Decomposition mode (3) ++ (deprecated) (ONLY valid for CLM4.5!) ++ LesserAD-exit Jump from lesser AD to normal mode (1) ++ (deprecated) (ONLY valid for CLM4.5!) ++ Two sequences are valid: 6-5-4-3-1-0 or 6-5-2-0 (where 6 and 4 are optional) ++ The recommended sequence is 5-2-0 + + + +Describe any changes made to the namelist: + Extensive list of new namelist options for CLM4.5 physics + +List any changes to the defaults for the boundary datasets: + Extensive list of new datasets for CLM4.5 + Add 360x720 grid (hcru_hcru) for CLM4.0 physics + +Describe any substantial timing or memory changes: CLM4.0 -- identical to clm4_0_59 + CLM4.5 -- identical to clm45sci15_clm4_0_58 + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): to cesm1_2_alpha02a versions + + scripts to scripts4_130204 + Machines to Machines_130204 + drv to drvseq4_2_18 + datm to datm8_130130 + rtm to rtm1_0_18 + cism to 45merge_02_cism1_121114 + csm_share to share3_130131 + pio to pio1_6_1 + mapping/gen_domain to mapping_121113b + +List all files eliminated: + +============== Eliminate PERGRO option, remove duplicated tools from clm4_0, change names to include clm4_0 +D models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 +D models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 +D models/lnd/clm/tools/mkmapdata/* ---------> remove +D models/lnd/clm/tools/mkprocdata_map/* ----> remove +D models/lnd/clm/tools/ncl_scripts/* -------> remove +D models/lnd/clm/tools/interpinic/* --------> move to under clm4_0 +D models/lnd/clm/tools/mkmapgrids/* --------> remove +D models/lnd/clm/tools/mksurfdata_map/* ----> move to under clm4_0 +D models/lnd/clm/bld/namelist_files/namelist_definition.xml ---> use clm4_5 version +D models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -> move to name with clm4_0 +D models/lnd/clm/bld/namelist_files/use_cases/pergro_pd.xml ---> Remove PERGRO option +D models/lnd/clm/bld/namelist_files/use_cases/pergro0_pd.xml --> Remove PERGRO option +D models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml -> move to name with clm4_0 + +List all files added and what they do: + +============== testing for clm4_5 and change name of some tests to include clm4_0 +A + models/lnd/clm/test/system/config_files/gen_domain +A + models/lnd/clm/test/system/tests_posttag_frankfurt_nompi +A + models/lnd/clm/test/system/user_nl_dirs/anoxia_wtsat +A + models/lnd/clm/test/system/user_nl_dirs/anoxia_wtsat/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/vrtlay +A + models/lnd/clm/test/system/user_nl_dirs/vrtlay/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/oldhyd +A + models/lnd/clm/test/system/user_nl_dirs/oldhyd/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set2_ciso +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set2_ciso/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set3_pftroot +A + models/lnd/clm/test/system/user_nl_dirs/ch4_set3_pftroot/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/rootlit +A + models/lnd/clm/test/system/user_nl_dirs/rootlit/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/ciso +A + models/lnd/clm/test/system/user_nl_dirs/ciso/user_nl_clm +A + models/lnd/clm/test/system/nl_files/nl_ch4_set2_ciso +A + models/lnd/clm/test/system/nl_files/nl_ch4_set3_pftroot +A + models/lnd/clm/test/system/nl_files/mksrfdt_10x15_1850 +A + models/lnd/clm/test/system/nl_files/nl_rootlit +A + models/lnd/clm/test/system/nl_files/nl_ciso +A + models/lnd/clm/test/system/nl_files/nl_anoxia_wtsat +A + models/lnd/clm/test/system/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 +A + models/lnd/clm/test/system/nl_files/clm4_0_mksrfdt_10x15_irr_1850 +A + models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp24_2000 +A + models/lnd/clm/test/system/nl_files/nl_vrtlay +A + models/lnd/clm/test/system/nl_files/nl_oldhyd +============== clm4_5 version of tools (from clm45sci15_clm4_0_58) +A + models/lnd/clm/tools/clm4_5 +A + models/lnd/clm/tools/clm4_5/mkmapdata +A + models/lnd/clm/tools/clm4_5/mkmapdata/mvNimport.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/rmdups.ncl +A + models/lnd/clm/tools/clm4_5/mkmapdata/regridbatch.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/mkmapdata.sh +A + models/lnd/clm/tools/clm4_5/mkmapdata/mkunitymap.ncl +A + models/lnd/clm/tools/clm4_5/mkmapdata/mknoocnmap.pl +A + models/lnd/clm/tools/clm4_5/mkmapdata/README +A + models/lnd/clm/tools/clm4_5/mkprocdata_map +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_functions.bash +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/mkprocdata_map.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/gridmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/constMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/fmain.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_in +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_all +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/mkprocdata_map_wrap +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A + models/lnd/clm/tools/clm4_5/mkprocdata_map/README +A + models/lnd/clm/tools/clm4_5/ncl_scripts +A + models/lnd/clm/tools/clm4_5/ncl_scripts/cprnc.pl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getco2_historical.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/cprnc.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getregional_datasets.pl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/getregional_datasets.ncl +A + models/lnd/clm/tools/clm4_5/ncl_scripts/README +A + models/lnd/clm/tools/clm4_5/interpinic +A + models/lnd/clm/tools/clm4_5/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c121113.nc +A + models/lnd/clm/tools/clm4_5/interpinic/interpinic.runoptions +A + models/lnd/clm/tools/clm4_5/interpinic/src +A + models/lnd/clm/tools/clm4_5/interpinic/src/interpinic.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_infnan_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_isnan.c +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/fmain.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/interpinic/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_isnan.h +A + models/lnd/clm/tools/clm4_5/interpinic/src/Filepath +A + models/lnd/clm/tools/clm4_5/interpinic/src/Makefile +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_5/interpinic/README +A + models/lnd/clm/tools/clm4_5/mkmapgrids +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/domainMod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/mkmapgrids.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Filepath +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/Makefile +A + models/lnd/clm/tools/clm4_5/mkmapgrids/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.namelist +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkscripgrid.ncl +A + models/lnd/clm/tools/clm4_5/mkmapgrids/mkmapgrids.csh +A + models/lnd/clm/tools/clm4_5/mkmapgrids/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varpar.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_timer_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_string_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/clm_varctl.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Filepath +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/Makefile +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkurbanparMod.F90 +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/README +A + models/lnd/clm/tools/clm4_5/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +============== clm4_0 version of tools +A + models/lnd/clm/tools/clm4_0 +A + models/lnd/clm/tools/clm4_0/interpinic +A + models/lnd/clm/tools/clm4_0/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc +A + models/lnd/clm/tools/clm4_0/interpinic/interpinic.runoptions +A + models/lnd/clm/tools/clm4_0/interpinic/src +A + models/lnd/clm/tools/clm4_0/interpinic/src/interpinic.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/Makefile.common +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/fmain.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/Mkdepends +A + models/lnd/clm/tools/clm4_0/interpinic/src/Srcfiles +A + models/lnd/clm/tools/clm4_0/interpinic/src/Filepath +A + models/lnd/clm/tools/clm4_0/interpinic/src/Makefile +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_0/interpinic/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvarctl.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkncdio.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varpar.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_file_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_timer_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_log_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mklaiMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksoilMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/fileutils.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_const_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparDomMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkharvestMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparCommonMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_string_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvarpar.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/clm_varctl.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_sys_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkvocefMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkdomainMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Filepath +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparAvgMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/shr_kind_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/nanMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Mkdepends +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/Srcfiles +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mklanwatMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/src/mkpftMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkncdio.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Srcfiles +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Filepath +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/Makefile +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/README +A + models/lnd/clm/tools/clm4_0/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0_tools.xml +A + models/lnd/clm/bld/namelist_files/namelist_definition_clm4_0.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5_tools.xml +A + models/lnd/clm/bld/namelist_files/namelist_definition_clm4_5.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_0.xml +A + models/lnd/clm/bld/namelist_files/namelist_defaults_clm4_5.xml +============== clm4_5 version of source (from clm45sci15_clm4_0_58) +A + models/lnd/clm/src/clm4_5 +A + models/lnd/clm/src/clm4_5/biogeochem +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNGapMortalityMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNitrifDenitrifMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNGRespMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CropRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/initch4Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNBalanceCheckMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate3Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNFireMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNMRespMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_BGC.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/MEGANFactorsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNVerticalProfileMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4RestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNWoodProductsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCIsoFluxMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNPrecisionControlMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSummaryMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/DUSTMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVLightMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNPhenologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/ch4varcon.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/STATICEcosysDynMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNCStateUpdate3Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/VOCEmissionMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNrestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVEcosystemDynIniMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNAnnualUpdateMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNStateUpdate2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDecompCascadeMod_CENTURY.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNNDynamicsMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNAllocationMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/DryDepVelocity.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNEcosystemDynMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSetValueMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNVegStructUpdateMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNSoilLittVertTranspMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNDVEstablishmentMod.F90 +A + models/lnd/clm/src/clm4_5/biogeochem/CNC14DecayMod.F90 +A + models/lnd/clm/src/clm4_5/main +A + models/lnd/clm/src/clm4_5/main/clm_varcon.F90 +A + models/lnd/clm/src/clm4_5/main/clm_varpar.F90 +A + models/lnd/clm/src/clm4_5/main/CNiniTimeVar.F90 +A + models/lnd/clm/src/clm4_5/main/dynlandMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_initializeMod.F90 +A + models/lnd/clm/src/clm4_5/main/subgridRestMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_glclnd.F90 +A + models/lnd/clm/src/clm4_5/main/subgridMod.F90 +A + models/lnd/clm/src/clm4_5/main/accFldsMod.F90 +A + models/lnd/clm/src/clm4_5/main/clmtypeInitMod.F90 +A + models/lnd/clm/src/clm4_5/main/pftdynMod.F90 +A + models/lnd/clm/src/clm4_5/main/iniTimeConst.F90 +A + models/lnd/clm/src/clm4_5/main/histFileMod.F90 +A + models/lnd/clm/src/clm4_5/main/pft2colMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_atmlnd.F90 +A + models/lnd/clm/src/clm4_5/main/findHistFields.pl +A + models/lnd/clm/src/clm4_5/main/restFileMod.F90 +A + models/lnd/clm/src/clm4_5/main/controlMod.F90 +A + models/lnd/clm/src/clm4_5/main/initSurfAlbMod.F90 +A + models/lnd/clm/src/clm4_5/main/filterMod.F90 +A + models/lnd/clm/src/clm4_5/main/clm_varctl.F90 +A + models/lnd/clm/src/clm4_5/main/clm_driver.F90 +A + models/lnd/clm/src/clm4_5/main/subgridAveMod.F90 +A + models/lnd/clm/src/clm4_5/main/initGridCellsMod.F90 +A + models/lnd/clm/src/clm4_5/main/CNiniSpecial.F90 +A + models/lnd/clm/src/clm4_5/main/pftvarcon.F90 +A + models/lnd/clm/src/clm4_5/main/surfrdMod.F90 +A + models/lnd/clm/src/clm4_5/main/inicPerpMod.F90 +A + models/lnd/clm/src/clm4_5/main/clmtype.F90 +A + models/lnd/clm/src/clm4_5/main/histFldsMod.F90 +A + models/lnd/clm/src/clm4_5/main/mkarbinitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys +A + models/lnd/clm/src/clm4_5/biogeophys/BalanceCheckMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SoilTemperatureMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanInputMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SnowHydrologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/FrictionVelocityMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/TridiagonalMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeHydrologyMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Hydrology1Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BiogeophysRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/ActiveLayerMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/QSatMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/clm_driverInitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeTemperatureMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BareGroundFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SNICARMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/CanopyFluxesMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SurfaceRadiationMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/initSLakeMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/H2OSfcMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Biogeophysics2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/FracWetMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/UrbanInitMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeRestMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SLakeCon.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SurfaceAlbedoMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/Hydrology2Mod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/BandDiagonalMod.F90 +A + models/lnd/clm/src/clm4_5/biogeophys/SoilHydrologyMod.F90 + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/TCBCFGtools.sh +M models/lnd/clm/test/system/frankfurt.batch +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/test/system/TSMncl_tools.sh +M models/lnd/clm/test/system/TBLCFGtools.sh +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_yong +M models/lnd/clm/test/system/yellowstone.interactive +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/shortlist.interactive +M models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +M models/lnd/clm/test/system/bluefire.batch +M models/lnd/clm/test/system/frankfurt.interactive +M models/lnd/clm/test/system/TSMscript_tools.sh +M models/lnd/clm/test/system/tests_posttag_mirage +M models/lnd/clm/test/system/gen_test_table.sh +M models/lnd/clm/test/system/nl_files/gen_domain.ne30.runoptions +M models/lnd/clm/test/system/nl_files/gen_domain.T31.runoptions +M models/lnd/clm/test/system/TOPtools.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/TSMtools.sh +M models/lnd/clm/test/system/TBLscript_tools.sh +M models/lnd/clm/test/system/yellowstone.batch +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/lynx.batch +M models/lnd/clm/test/system/TBLtools.sh +M models/lnd/clm/test/system/shortlist.batch +M models/lnd/clm/test/system/TSMCFGtools.sh + +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/queryDefaultNamelist.pl +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + +MM models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +MM models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +Difference in expected Fails: + + + +- +- +- +- +- +- missing datasets for us20 +- ne16 missing finidat file for 1850 +- ne60 missing finidat file for 1850 +- 1x1_tropicAtl missing finidat file for 1850 +- +- +- + + + +@@ -25,10 +13,17 @@ + + + ++ + ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + +- missing datasets for wus12 + missing datasets for us20 + ne16 missing finidat file for 1850 + ne60 missing finidat file for 1850 +@@ -38,17 +33,6 @@ + + + +- +- +- +- cprnc showing diffs are not b4b +- problem configuring +- problem configuring +- clm stand-alone can no longer work +- clm stand-alone can no longer work +- +- +- + + + +@@ -62,24 +46,6 @@ + + + +- +- +- +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Ignore. Will be moved to CESM tests. +- Failing for long time. endrun initiated from CNBalanceCheckMod.F90. +- Failing for long time. __cnbalancecheckmod_NMOD_cbalancecheck. +- Failing for long time. Fail because erU61 fails. +- Failing for long time. Fail because erU61 fails. +- Have been failing for a long time . +- Have been failing for a long time. +- Have been failing for a long time. +- Have been failing for a long time. +- +- +- + + + +@@ -93,91 +59,108 @@ + + + +- +- +- Initial simulation fails +- Initial simulation fails +- History files are different +- Initial simulation fails +- Initial simulation fails +- History files are different on restart (known problem + restarting mid-day with _GLC: bug 1557) +- Initial simulation fails +- build error? +- +- + + +- ???? + + + + + + +- ???? + + + + +- Initial simulation fails +- Initial simulation fails case name too + long +- History files are different on restart (known + problem restarting mid-day with _GLC: bug 1557) ++ ++ ++ ++ ++ ++ ++ ++ ++ + + + + + +- +- +- T62 not working +- Dies early with a floating point trap +- +- Baseline comp. test will always fail +- build error? +- +- + + + History files are different on restart (known problem +restarting mid-day with _GLC: bug 1557) + + ++ ++ ++ ++ + + + History files are different on restart (known problem restarting +mid-day with _GLC: bug 1557) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ ++ + + +- ++ + + +- +- ++ ++ ++ + missing datasets + missing datasets +- missing datasets +- +- ++ missing datasets ++ missing 0.1 mapping dataset (for RTM at R01) ++ ++ ++ ++ ++ ++ + ++ ++ scripts issue with ocean not threaded ++ Restart difference ++ Soil balance error on restart ++ scripts issue with ocean not threaded ++ ++ scripts issue with ocean not threaded ++ bad compset name ++ surfdata and pftdyn file mismatched ++ Soil balance error on restart ++ scripts issue component not threaded ++ missing finidat file ++ missing finidat file ++ + +- ???? +- ???? ++ problem building with mpi-serial with pgi compiler ++ missing LAPACK symbol dgbsv ++ scripts issue with ocean not threaded ++ Need LAPACK for PGI (dgbsv) ++ Need LAPACK for PGI (dgbsv) ++ Bad compset name: ICNCROP ++ scripts issue with ocean not threaded ++ ++ problem building with mpi-serial with pgi compiler ++ missing LAPACK symbol dgbsv ++ missing LAPACK symbol dgbsv ++ scripts issue with ocean not threaded ++ Need LAPACK for PGI (dgbsv) ++ Need LAPACK for PGI (dgbsv) ++ Bad compset name: ICNCROP ++ scripts issue with ocean not threaded + + + +Machines testing ran on: (Tests in priority order) + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: yes + + test_system testing: + + yellowstone batch: yes + frankfurt interactive: yes + yellowstone interactive: yes + frankfurt batch: yes + + test_driver.sh tools testing: + + yellowstone interactive: yes + frankfurt interactive: yes + + yellowstone/PTCLM: no (PTCLM still doesn't quite work) + +CLM tag used for the baseline comparison tests if applicable: clm4_0 to clm4_0_59 clm4_5 to clm45sci15_clm4_0_58 + +Changes answers relative to baseline: Yes, for some resolutions for clm4_0 -- because of new default initial condition files in compsets + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + For clm4_0... + New initial conditions for: f09/f19-I_2000, f09/f19-I_1850, f09/f19-I_1850-2000 + f09/f19-I_1948-2004, f09/f19-I_1850_SPINUP_3HrWx + f09/f19-I_RCP + +=============================================================== +=============================================================== +Tag name: clm4_0_59 +Originator(s): mvertens (Mariana Vertenstein) / erik +Date: Thu Dec 20 09:24:16 MST 2012 +One-line Summary: restructure clmtype and all pointer references, new directory structure + +Purpose of changes: + Reststucture trunk directory tree to prepare for incorporation of clm4_5 + Move all cpp-ifdefs to clm_varctl and introduce new logical variables in their place + Restructure clmtype to remove nesting - and also redo all the pointer references + All together the code can then move to having no cpp-ifdefs + +Test level of tag: + std-test + +Bugs fixed (include bugzilla ID): + None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 147 (mkgriddata can't straddle over Greenwich) + 025 (SCM mode can NOT use a global finidat file) + 017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + 1598 (non-repeatable results when running with CNDV and/or CROP) + + Threading seems to work for all cases where CROP and/or CNDV + is not on + +Describe any changes made to build system: + New directory structure + +Describe any changes made to the namelist: + variables use_c13 and use_c14 added to namelist_definition.xml file + +List any changes to the defaults for the boundary datasets: + No + +Describe any substantial timing or memory changes: + Currently more memory for compsets without CN, etc - less memory + when CN, CNDV, etc are activated. This will be fixed in clm4_0_59. + +Code reviewed by: + self (proposed changes reviewed by Erik, Bill and Stefan) + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: + src/biogeochem -> src/clm4_0/biogeochem + src/biogeophys -> src/clm4_0/biogeophys + src/main -> src/clm4_0/main + + +List all files added and what they do: + None + +List all existing files that have been modified, and describe the changes: + + All files in src/clm4_0 have been modified relative to their + original versions to remove the cpp-ifdefs and to adjust pointer + references to new names + + M src/cpl_share/clm_cpl_indices.F90 + M src/cpl_mct/lnd_comp_mct.F90 + M src/cpl_esmf/lnd_comp_esmf.F90 + + M bld/configure + M bld/namelist_files/namelist_definition.xml + M test/system/yellowstone.interactive + M test/system/yellowstone.batch + + Add in 360x720_cruncep datasets (from Erik). + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl --- correct number of tests + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +Machines testing ran on: + + build-namelist unit tester: yes + + CESM test lists: + + yellowstone/CESM: yes + yellowstone/CESM/allIcompsets: no + + PTCLM + yellowstone: no + + test_system testing: + + yellowstone batch: yes + yellowstone interactive: no + frankfurt batch: no + frankfurt interactive: yes + + test_driver.sh tools testing: + + yellowstone interactive: no + frankfurt interactive: no + +Difference in expected fails from testing: + ++ Numbers change for build-namelist unit tests + + +- ???? + + + + +- ???? +- ???? +- ???? + +- +- ???? +- + + +CLM tag used for the baseline comparison tests if applicable: + clm4_0_58 + +Changes answers relative to baseline: + no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_58 +Originator(s): erik (Erik Kluzek) +Date: Fri Dec 14 05:13:33 MST 2012 +One-line Summary: Uncomment us20 and wus12 datasets, more testing to: bluefire, yellowstone, frankfurt + +Purpose of changes: + +Uncomment WRF grids in namelist xml files. Fix mkprocdata bug on lynx. + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1601 (mkprocdata seg faults on lynx) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: No + +Describe any changes made to the namelist: No + +List any changes to the defaults for the boundary datasets: Yes + uncomment out wus12 and us20 WRF datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, csm_share + + scripts to: scripts4_121207b + Machines to: Machines_121207 + csm_share to: share3_121204a + +List all files eliminated: None + +List all files added and what they do: Add frankfurt test lists + +>>>>>>>>>>>>>>>> Tests for frankfurt + A models/lnd/clm/test/system/frankfurt.interactive + A models/lnd/clm/test/system/frankfurt.batch + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_system + M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml + + M models/lnd/clm/test/system/bluefire.batch + M models/lnd/clm/test/system/yellowstone.batch + M models/lnd/clm/test/system/nl_files/mkprocdata_ne30_to_f19_I2000 + +>>>>>>>>>>>>>>>> Fix mkprocdata and allow it to run from a different exe directory for testing + M models/lnd/clm/tools/mkprocdata_map/src/mkprocdata_map.F90 + M models/lnd/clm/tools/mkprocdata_map/src/gridmapMod.F90 + M models/lnd/clm/tools/mkprocdata_map/src/fmain.F90 + M models/lnd/clm/tools/mkprocdata_map/src/shr_file_mod.F90 + M models/lnd/clm/tools/mkprocdata_map/src/fileutils.F90 + M models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_all + M models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_wrap + +>>>>>>>>>>>>>>>> Fix bug in unit-tester + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + +>>>>>>>>>>>>>>>> Uncomment WRF files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Machines testing ran on: + + build-namelist unit tester: yes + + CESM test lists: + + bluefire/CESM: yes + bluefire/CESM/allIcompsets: yes + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + bluefire interactive: yes + yellowstone batch: yes + yellowstone interactive: yes + frankfurt batch: yes + frankfurt interactive: yes + + test_driver.sh tools testing: + + bluefire interactive: yes + lynx interactive: yes + yellowstone interactive: yes + frankfurt interactive: yes + +Difference in expected fails from testing: + +Index: expectedClmTestFails.xml +=================================================================== +--- expectedClmTestFails.xml (revision 42691) ++++ expectedClmTestFails.xml (working copy) +@@ -5,12 +5,12 @@ + + + +- + + +- ne16 missing finidat file for 1850 +- ne60 missing finidat file for 1850 +- 1x1_tropicAtl missing finidat file for 1850 ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + + +@@ -24,6 +24,17 @@ + + + ++ ++ ++ ++ ++ missing datasets for wus12 ++ missing datasets for us20 ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 ++ ++ + + + +@@ -101,6 +112,19 @@ + + + ++ ++ ++ ???? ++ ???? ++ ++ ++ ++ ++ Initial simulation fails ++ Initial simulation fails case name too +long ++ History files are different on restart (known +problem restarting mid-day with _GLC: bug 1557) ++ ++ + + + +@@ -118,6 +142,11 @@ + History files are different on restart (known problem +restarting mid-day with _GLC: bug 1557) + + ++ ++ ++ History files are different on restart (known problem restarting +mid-day with _GLC: bug 1557) ++ ++ + + + +@@ -128,6 +157,18 @@ + missing datasets + + ++ ++ ++ ???? ++ ???? ++ ???? ++ ???? ++ ???? ++ ++ ++ ???? ++ ++ + + + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_58 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +=============================================================== +Tag name: clm4_0_57 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Fri Nov 30 14:20:13 MST 2012 +One-line Summary: update trunk with release mods, some rtm fixes + +Purpose of changes: + +CLM: Merge the changes Erik made in the release branch tags to trunk. +RTM: Add effective velocity as a namelist variable. + Change rdirc file. + Add RTM tests to test_system batch CLM tests. + Clean up logic in RtmFloodInit so R01 works without SLOPE and MAX_VOLR. + Change rdirc file to rdirc_0.5x0.5_simyr2000_slpmxvl_c120717.nc which is + correct and contains FLOOD and MAX_VOLR. This fixes an error in choice + of rdirc file from clm4_0_55 / rtm1_0_10 + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: Changed RTM rdirc file. + +Describe any substantial timing or memory changes: None Known + +Code reviewed by: Erik, Tony, Mariana (in progress) + +List any svn externals directories updated (csm_share, mct, etc.): + - rtm1_0_13 + - scripts4_121127 + - Machines_121126 + - drvseq4_2_13 + - datm8_121123 + - cism1_121114 + +List all files eliminated: + + - Deleted during release tag cleanup +D models/lnd/clm/test/system/TCB.sh +D models/lnd/clm/test/system/tests_pretag_bluefire +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh +D models/lnd/clm/test/system/config_files/17p_cndvsc_m +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m +D models/lnd/clm/test/system/config_files/17p_cndvsc_o +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm +D models/lnd/clm/test/system/config_files/_persc_dh +D models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +D models/lnd/clm/test/system/config_files/17p_cndvsc_s +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s +D models/lnd/clm/test/system/config_files/_persc_dm +D models/lnd/clm/test/system/config_files/_persc_do +D models/lnd/clm/test/system/config_files/_scnv_ds +D models/lnd/clm/test/system/config_files/_persc_ds +D models/lnd/clm/test/system/config_files/17p_sc_dh +D models/lnd/clm/test/system/config_files/17p_sc_dm +D models/lnd/clm/test/system/config_files/17p_sc_do +D models/lnd/clm/test/system/config_files/_sc_dh +D models/lnd/clm/test/system/config_files/17p_sc_ds +D models/lnd/clm/test/system/config_files/_sc_dm +D models/lnd/clm/test/system/config_files/21p_cncrpsc_h +D models/lnd/clm/test/system/config_files/17p_cnsc_h +D models/lnd/clm/test/system/config_files/_sc_do +D models/lnd/clm/test/system/config_files/21p_cncrpsc_dh +D models/lnd/clm/test/system/config_files/17p_cnsc_dh +D models/lnd/clm/test/system/config_files/21p_cncrpsc_m +D models/lnd/clm/test/system/config_files/17p_cnsc_m +D models/lnd/clm/test/system/config_files/_sc_ds +D models/lnd/clm/test/system/config_files/21p_cncrpsc_o +D models/lnd/clm/test/system/config_files/17p_cnsc_o +D models/lnd/clm/test/system/config_files/17p_cnsc_dm +D models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +D models/lnd/clm/test/system/config_files/17p_cnsc_do +D models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +D models/lnd/clm/test/system/config_files/21p_cncrpsc_do +D models/lnd/clm/test/system/config_files/21p_cncrpsc_s +D models/lnd/clm/test/system/config_files/17p_sc_h +D models/lnd/clm/test/system/config_files/17p_cnsc_ds +D models/lnd/clm/test/system/config_files/21p_cncrpsc_ds +D models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +D models/lnd/clm/test/system/config_files/_mexsc_ds +D models/lnd/clm/test/system/config_files/17p_cnc13sc_do +D models/lnd/clm/test/system/config_files/17p_sc_m +D models/lnd/clm/test/system/config_files/17p_sc_o +D models/lnd/clm/test/system/config_files/_sc_h +D models/lnd/clm/test/system/config_files/17p_cnnfsc_dh +D models/lnd/clm/test/system/config_files/_sc_m +D models/lnd/clm/test/system/config_files/17p_cnnfsc_dm +D models/lnd/clm/test/system/config_files/_sc_o +D models/lnd/clm/test/system/config_files/17p_cndvsc_dh +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh +D models/lnd/clm/test/system/config_files/17p_cnnfsc_do +D models/lnd/clm/test/system/config_files/_sc_s +D models/lnd/clm/test/system/config_files/17p_cndvsc_dm +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm +D models/lnd/clm/test/system/config_files/17p_cndvsc_do +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds +D models/lnd/clm/test/system/config_files/_vansc_ds +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm +D models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +D models/lnd/clm/test/system/config_files/_nil3sc_dh +D models/lnd/clm/test/system/config_files/_nil3sc_dm +D models/lnd/clm/test/system/config_files/_scsnf_dh +D models/lnd/clm/test/system/config_files/_scsnf_dm +D models/lnd/clm/test/system/config_files/_scsnf_do +D models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h +D models/lnd/clm/test/system/config_files/17p_cndvsc_h +D models/lnd/clm/test/system/TBL.sh +D models/lnd/clm/test/system/tests_pretag_edinburgh +D models/lnd/clm/test/system/tests_pretag_edinburgh_nompi +D models/lnd/clm/test/system/TBR.sh +D models/lnd/clm/test/system/TER.sh +D models/lnd/clm/test/system/mknamelist +D models/lnd/clm/test/system/tests_posttag_hybrid_regression +D models/lnd/clm/test/system/tests_posttag_purempi_regression +D models/lnd/clm/test/system/TRP.sh +D models/lnd/clm/test/system/tests_pretag_jaguarpf +D models/lnd/clm/test/system/TSMrst_tools.sh +D models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +D models/lnd/clm/test/system/nl_files/nl_per +D models/lnd/clm/test/system/nl_files/nl_voc +D models/lnd/clm/test/system/nl_files/clm_std +D models/lnd/clm/test/system/nl_files/multi_inst +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_1 +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_2 +D models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_3 +D models/lnd/clm/test/system/nl_files/clm_nortm +D models/lnd/clm/test/system/nl_files/clm_transient_rcp2.6 +D models/lnd/clm/test/system/nl_files/clm_ndepdyn +D models/lnd/clm/test/system/nl_files/clm_transient_rcp4.5 +D models/lnd/clm/test/system/nl_files/clm_pftdyn +D models/lnd/clm/test/system/nl_files/clm_transient_rcp8.5 +D models/lnd/clm/test/system/nl_files/clm_per0 +D models/lnd/clm/test/system/nl_files/nl_ptsmode_ocn +D models/lnd/clm/test/system/nl_files/nl_urb_br +D models/lnd/clm/test/system/nl_files/clm_spin +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp6 +D models/lnd/clm/test/system/nl_files/clm_urb1pt +D models/lnd/clm/test/system/nl_files/nl_urb +D models/lnd/clm/test/system/nl_files/nl_crcrop +D models/lnd/clm/test/system/nl_files/clm_per +D models/lnd/clm/test/system/nl_files/clm_drydep +D models/lnd/clm/test/system/nl_files/nl_std +D models/lnd/clm/test/system/nl_files/clm_glcmec +D models/lnd/clm/test/system/nl_files/clm_transient_rcp6 +D models/lnd/clm/test/system/nl_files/nl_crop +D models/lnd/clm/test/system/nl_files/clm_usrdat +D models/lnd/clm/test/system/nl_files/nl_cn_conly +D models/lnd/clm/test/system/nl_files/clm_stdIgnYr +D models/lnd/clm/test/system/nl_files/clm_transient_20thC +D models/lnd/clm/test/system/nl_files/nl_ptsmode +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp2.6 +D models/lnd/clm/test/system/nl_files/clm_irrig +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp4.5 +D models/lnd/clm/test/system/nl_files/nl_lfiles +D models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp8.5 +D models/lnd/clm/test/system/TSMpergro.sh +D models/lnd/clm/test/system/TSMcnspinup.sh +D models/lnd/clm/test/system/TBLrst_tools.sh +D models/lnd/clm/test/system/CLM_runcmnd.sh +D models/lnd/clm/test/system/TSM.sh +D models/lnd/clm/test/system/tests_posttag_lynx +D models/lnd/clm/tools/mkprocdata_map/camhomme +D models/lnd/clm/tools/mkprocdata_map/camhomme/src +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/mkprocdata_map.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/gridmapMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Depends +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/domainMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_file_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/nanMod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Srcfiles +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Filepath +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/Makefile +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/fileutils.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_kind_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/camhomme/mkprocdata_map_in +D models/lnd/clm/tools/mkprocdata_map/clm/src +D models/lnd/clm/tools/mkprocdata_map/clm/src/mkprocdata_map.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/gridmapMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/constMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/fmain.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/shr_file_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/nanMod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/Mkdepends +D models/lnd/clm/tools/mkprocdata_map/clm/src/Srcfiles +D models/lnd/clm/tools/mkprocdata_map/clm/src/Filepath +D models/lnd/clm/tools/mkprocdata_map/clm/src/Makefile +D models/lnd/clm/tools/mkprocdata_map/clm/src/fileutils.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/src/shr_kind_mod.F90 +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_in +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_all +D models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_wrap +D models/lnd/clm/tools/mkprocdata_map/clm/README +D models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat +D models/lnd/clm/tools/ncl_scripts/RMSlahey.dat +D models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl +D models/lnd/clm/tools/ncl_scripts/RMSjaguar.dat +D models/lnd/clm/tools/ncl_scripts/RMSintel.dat +D models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat +D models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl +D models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl +D models/lnd/clm/tools/ncl_scripts/runDepositionRegrid.pl +D models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl +D models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl +D models/lnd/clm/bld/config_files/config_sys_defaults.xml +D models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl +D models/lnd/clm/bld/namelist_files/datm-build-namelist +D models/lnd/clm/bld/namelist_files/checklatsfiles.ncl +D models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml +D models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml + +List all files added and what they do: + + - Added for RTM testing +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOn +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmR01 +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff/user_nl_rtm +A models/lnd/clm/test/system/user_nl_dirs/rtm/rtmOff +A models/lnd/clm/test/system/user_nl_dirs/rtm + - Added from release tags +A models/lnd/clm/test/system/yellowstone.interactive +A models/lnd/clm/test/system/tests_pretag_yellowstone_nompi +A models/lnd/clm/test/system/nl_files/mkprocdata_ne30_to_f19_I2000 +A models/lnd/clm/test/system/yellowstone.batch +A models/lnd/clm/tools/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_functions.bash +A models/lnd/clm/tools/mkprocdata_map/src/mkprocdata_map.F90 +A models/lnd/clm/tools/mkprocdata_map/src/gridmapMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/constMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/Makefile.common +A models/lnd/clm/tools/mkprocdata_map/src/fmain.F90 +A models/lnd/clm/tools/mkprocdata_map/src/shr_file_mod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/nanMod.F90 +A models/lnd/clm/tools/mkprocdata_map/src/Mkdepends +A models/lnd/clm/tools/mkprocdata_map/src/Srcfiles +A models/lnd/clm/tools/mkprocdata_map/src/Filepath +A models/lnd/clm/tools/mkprocdata_map/src/Makefile +A models/lnd/clm/tools/mkprocdata_map/src/fileutils.F90 +A models/lnd/clm/tools/mkprocdata_map/src/shr_kind_mod.F90 +A models/lnd/clm/tools/mkprocdata_map/src +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_in +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_all +A models/lnd/clm/tools/mkprocdata_map/mkprocdata_map_wrap +A models/lnd/clm/tools/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc +A models/lnd/clm/tools/mkprocdata_map/README +A models/lnd/clm/bld/config_query +A models/lnd/clm/doc/UsersGuide/modelnl/xmldef2html_compsets +A models/lnd/clm/doc/UsersGuide/modelnl/showinfo.js +A models/lnd/clm/doc/UsersGuide/modelnl/index.cpp +A models/lnd/clm/doc/UsersGuide/modelnl/Makefile +A models/lnd/clm/doc/UsersGuide/modelnl + +List all existing files that have been modified, and describe the changes: + + - put back qflx_snomelt for consistency with older models. clm4_0_55 mods to the snow + balance check otherwise only effect the diagnostic fields errh2osno, snow_source and snow_sinks +M models/lnd/clm/src/main/histFldsMod.F90 + - modified for RTM testing +M config_files/config_CLMtestCompsets.xml +M bluefire.batch + - modified during release tag modification +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/mirage.interactive +M models/lnd/clm/test/system/test_system +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_yong +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/lynx.interactive +M models/lnd/clm/test/system/shortlist.interactive +M models/lnd/clm/test/system/TSMscript_tools.sh +M models/lnd/clm/test/system/tests_posttag_mirage +M models/lnd/clm/test/system/gen_test_table.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/bluefire.interactive +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +M models/lnd/clm/tools/ncl_scripts +M models/lnd/clm/tools/ncl_scripts/README +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl +M models/lnd/clm/tools/interpinic +M models/lnd/clm/tools/mksurfdata_map/src +M models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkutilsMod.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 +M models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 +M models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist +M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt +M models/lnd/clm/bld +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/queryDefaultNamelist.pl +M models/lnd/clm/bld/user_nl_clm +M models/lnd/clm/bld/config_files/config_definition.xsl +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/clm.buildnml.csh +M models/lnd/clm/bld/README +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/appendix.xml +M models/lnd/clm/doc/UsersGuide/ptclm.xml +M models/lnd/clm/doc/Quickstart.userdatasets +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE +M models/lnd/clm/doc/ChangeLog +M models/lnd/clm/doc/CodeReference/Filepath +M models/lnd/clm/doc/KnownLimitations +M models/lnd/clm/doc/ChangeSum +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/README +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 +M ChangeLog +M ChangeSum +M READM + +Machines testing ran on: (in progress) + + build-namelist unit tester: yes + + - OK. All FAILs (~78 of them) should pass during the next round. + + CESM test lists: + + bluefire/CESM: yes + + -Fail due to throuput comparison problems: + + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.164220.tputcomp.clm4_0_56 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.164220.tputcomp.clm4_0_56 + + -Fail due to new and correct rdirc file. diffs in r2x_Forr_roff & r2x_Forr_ioff + These should pass next time around: + + FAIL ERS_D.f45_g37.I.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL NCK.T31_g37.I.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL PET_PT.f45_g37.I1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.164220.compare_hist.clm4_0_56 + + bluefire/CESM/allIcompsets: yes + + Error in SBN script handling in generate of namelist files so all compare tests are BFAILs. + + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + + 4 xFAIL. The rest that fail now, but should pass the next time around. + + - Fail due to new and correct rdirc file. diffs in r2x_Forr_roff & r2x_Forr_ioff + These should pass next time around: + + FAIL ERS_Ld211.f10_f10.ICNADSPIN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL ERS_Ln48_D_P64x16.ne30_g16.ICN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL PET_D_P1x64.ne30_g16.ICN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + FAIL ERS_Ld211.f10_f10.I_2000_VOC_CN.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + + - Fail due to throughput comparison + + FAIL ERS_Ld211.f10_f10.ICNADSPIN.bluefire_ibm.GC.164759.tputcomp.clm4_0_56 + FAIL ERS_Ld211_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.164759.tputcomp.clm4_0_56 + + - Will pass next time, these tests just introduced + + BFAIL ERS.f19_g16.I_2000_CN_rtmR01.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + BFAIL ERS.f19_g16.I_2000_CN_rtmOff.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + BFAIL ERS.f19_g16.I_2000_CN_rtmOn.bluefire_ibm.GC.164759.compare_hist.clm4_0_56 + + bluefire interactive: yes + + - xFAIL or new tests that will pass next time (missing baselines): + + BFAIL ERS_D_Mmpi-serial.CLM_USRDAT.IalaskaCN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.CLM_USRDAT.I_2000_1PTFRC_US-UMB.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_P1x64_Mmpi-serial.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_P1x25_Mmpi-serial.5x5_amazon.I_2000.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.1x1_asphaltjungleNJ.I_2000_VOC.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x64_Mmpi-serial.f19_g16.I_2000_GLCMECPD.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ly3_Mmpi-serial.1x1_brazil.I_2000_CNDV.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000_VOC_SNCRFRC_CN.bluefire_ibm.GC.164744.compare_hist.clm4_0_56 + + lynx/pgi batch: yes + + - xFAIL or will pass next time (new rdirc file effecting r2x_Forr_roff & r2x_Forr_ioff) + + FAIL ERS_Ln48_D.f45_g37.I_2000_VOC.lynx_pgi.GC.170117.compare_hist.clm4_0_56 + FAIL ERS_Ln48_D.f10_f10.I_2000_CN.lynx_pgi.GC.170117.compare_hist.clm4_0_56 + + lynx/pgi interactive: yes + + - OK except for new test that will pass next time (missing baselines): + + BFAIL SMS_RLA_Mmpi-serial.f45_f45.I.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL SMS_Mmpi-serial.CLM_USRDAT.I_2000_1PTFRC_US-UMB.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_brazil.I_2000.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x12_Mmpi-serial.f10_f10.ICNCROP.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Ld211_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL SMS_D_Mmpi-serial.1x1_vancouverCAN.I1PT.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + BFAIL ERS_Mmpi-serial.1x1_mexicocityMEX.I1PT.lynx_pgi.GC.170039.compare_hist.clm4_0_56 + + lyn/intel mirage testlist: yes + + - OK except for new tests will pass next time (missing baselines): + + BFAIL ERS_Mmpi-serial.1x1_brazil.I_2000.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERI_D_Mmpi-serial.1x1_camdenNJ.I_2000_VOC.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERS_D_Mmpi-serial.1x1_asphaltjungleNJ.I_2000_VOC.lynx_intel.GC.095009.compare_hist.clm4_0_56 + BFAIL ERS_Ln48_D_P1x12_Mmpi-serial.f10_f10.I_2000_CN.lynx_intel.GC.095009.compare_hist.clm4_0_56 + + test_driver.sh tools testing: + + bluefire interactive: yes + + test 001 fails due to a bug in mkprocdata_map_wrap + test 002 fails due to 001 + test 008 will pass next time + + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: modification to default value for effvel in RtmMod.F90 + changes the values of r2x_Forr_roff & r2x_Forr_ioff. This causes cprnc to fail. + This should pass in the next round and matches the value found in CLM4.5. + + - real(r8),parameter :: effvel(nt_rtm) = 0.7_r8 ! downstream velocity (m/s) + + real(r8),parameter :: effvel(nt_rtm) = 1.0_r8 ! downstream velocity (m/s) + + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + with flooding on and new rdirc file, climate may be different. + with flooding off we have b4b + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_56 +Originator(s): sacks (Sacks Bill 303-497-1762 CGD) +Date: Tue Nov 27 14:12:42 MST 2012 +One-line Summary: fix s2x tsrf, add s2x diagnostics + +Purpose of changes: + +The s2x tsrf field was not being time-averaged; this is fixed now. + +Also, add history fields giving per-column diagnostics of the fields sent +from CLM to GLC. + +Requirements for tag: + fix bug 1590 + test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage-test for lynx_intel + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): 1590 (surface temperature sent from CLM to GLC not averaged properly) + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>> Do time-averaging of tsrf field; remove calls to create_clm_s2x +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +>>>>>>> Call to create_clm_s2x now done here instead of lnd_comp_mct / +>>>>>>> lnd_comp_esmf, so that clm_s2x can be used for hist file writes +>>>>>>> (this is needed so that the fields are updated before the history +>>>>>>> updates happen in the driver) +M models/lnd/clm/src/main/clm_initializeMod.F90 +M models/lnd/clm/src/main/clm_driver.F90 + +>>>>>>> Clean up interface to create_clm_s2x +M models/lnd/clm/src/main/clm_glclnd.F90 + +>>>>>>> Add capability to output fields sent from CLM to GLC +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/histFldsMod.F90 + +>>>>>>> Remove non-existent PMT test +M models/lnd/clm/test/system/lynx.batch + +>>>>>>> Add ERS_Ln48_P96x2.f19_g16.I_2000_VOC_SNCRFRC_CN_GLCMECPD to xFail +>>>>>>> list; add comment +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + +Machines testing ran on: + + build-namelist unit tester: no + + CESM test lists: + + bluefire/CESM: yes + All PASS except: + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.101712.compare_hist.clm4_0_55 + + These are expected failures: diffs in topo and tsrf fields + sent to coupler, and topo diffs are small (RMS ~ 1e-13) + + bluefire/CESM/allIcompsets: no + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: yes + All PASS or xFAIL except: + FAIL ERS_Ld211_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.101753.compare_hist.clm4_0_55 + + I believe this is an old problem, not due to the changes here: see bug 1598 + + bluefire interactive: yes + All PASS or xFAIL + + lynx/pgi batch: yes + All PASS or xFAIL + + lynx/pgi interactive: yes + All PASS + + lyn/intel mirage testlist: yes + All PASS + + test_driver.sh tools testing: + + bluefire interactive: no + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: clm4_0_55 + +Difference in expected fails from testing: + + Note: the additional expected fail is NOT a new failure, it is just newly + documented + + --- models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (.../trunk_tags/clm4_0_55) (revision 42229) + +++ models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml (.../branches/fix_glc_tsrf) (revision 42229) + @@ -90,7 +90,7 @@ + + + Initial simulation fails + - History files are different on restart + + History files are different on restart (known problem restarting mid-day with _GLC: bug 1557) + Initial simulation fails + build error? + + @@ -113,6 +113,9 @@ + + + + + + + History files are different on restart (known problem restarting mid-day with _GLC: bug 1557) + + + + + + +Changes answers relative to baseline: YES: changes tsrf and topo fields +sent to GLC (everything else bfb) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: glc_mec + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + new climate for tsrf; roundoff-level for topo field sent to GLC. Note that these + fields are limited to GLC, and don't feed back to the atmosphere at all. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? For topo: examined differences in cprnc output + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: None done + + URL for LMWG diagnostics output used to validate new climate: N/A + +=============================================================== +=============================================================== +Tag name: clm4_0_55 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Thu Nov 15 10:17:23 MST 2012 +One-line Summary: bring in flooding capability + +Purpose of changes: + + Test driver mods from Tony that allows flooding from rof to lnd. Also + brought in code from the rtmflood branch to handle the new flooding values. + Fthresh calculed by reading SLOPE and MAX_VOLR from the rdirc file. Merged + in qflx_snow_melt from Swensons perfmafrost sims branch to fix snow + balance problems in BalanceCheckMod.F90. + +Requirements for tag: + + Test flooding code in CLM by varying fthresh. Test coupler mods by + plotting coupler fields. Look at differences in overall energy balance + with and without flooding. + +Test level of tag: doc, critical, standard, std-test, reg-test + + Critical. Bluefire CESM/CLM tests and namelist tests only + +Bugs fixed (include bugzilla ID): + + N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + N/A + +Describe any changes made to the namelist: + + N/A + +List any changes to the defaults for the boundary datasets: + + N/A + +Describe any substantial timing or memory changes: + + N/A + +Code reviewed by: + + Tony Craig, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): + + Updated all of the following (in relation to clm4_0_54) + scripts4_121105 + Machines_121106 + drvseq4_2_11 + rtm1_0_10 + cism1_121012 + share3_121025 + pio1_5_7 + mapping_121106 + +List all files eliminated: + + N/A + +List all files added and what they do: + + N/A + +List all existing files that have been modified, and describe the changes: + + -the following all for bringing in qflx_snow_melt for new + -balance check calculation with flooding + M models/lnd/clm/src/main/clmtypeInitMod.F90 + M models/lnd/clm/src/main/histFldsMod.F90 + M models/lnd/clm/src/main/mkarbinitMod.F90 + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 + + - mods to bring in flooding from rtmflood + M main/clm_driver.F90 + M main/cmlmtype.F90 + M main/clmtypeInitMod.F90 + M main/histFldsMod.F90 + M main/mkarbinitMod.F90 + M main/clm_varcon.F90 + + - fixes for some test problems + M build-namelist_test.pl + M clm/bld/configure + +Machines testing ran on: + + build-namelist unit tester: yes + + 6 xFails - all OK. + + CESM test lists: + + bluefire/CESM: yes + + Fail due to new coupler fields: + + new field r2x_Forr_roff + + NCK.T31_g37.I.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_E.T31_g37.I1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERI.T31_g37.IG1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + SMS.T31_g37.IG4804.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + + new fields r2x_Forr_roff & r2x_Forr_ioff + + ERS_D.f45_g37.I.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + PET_PT.f45_g37.I1850.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERB.ne30_g16.I_1948-2004.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + PET_PT.f10_f10.I20TRCN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + SMS.f10_f10.IRCP45CN.bluefire_ibm.C.092829.compare_hist.clm4_0_54 + ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.165350.compare_hist.clm4_0_54 + + Fail due to throughput differences: + + FAIL ERS_D.f45_g37.I.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.GC.165350.tputcomp.clm4_0_54 + + bluefire/CESM/allIcompsets: no + lynx/CESM: no + + bluefire/PTCLM: no + + test_system testing: + + bluefire batch: no + bluefire interactive: no + lynx/pgi batch: no + lynx/pgi interactive: no + lyn/intel mirage testlist: no + + test_driver.sh tools testing: + + bluefire interactive: no + lynx interactive: no + +CLM tag used for the baseline comparison tests if applicable: + + us20/wus12 tests were removed so removed from expected fail + ne16/ne60/1x1_tropicAtl 20thC transient tests fails -- need finidat files + New bug: ERS_Ln48_D_P1x64.f19_g16.I_2000_GLCMECPD (bugzilla 1557) + New testname: ERS_Ln48_D_P1x64.f45_g37.I_2000_VOC (was ERS48s_...) + New fail: ERS_Ld211.1x1_camdenNJ.I_2000_VOC, ERS_Ld211_D_P112x2.f10_f10.ICNCROP + Some ERS_L tests now pass that failed previously + I1PT tests pass now + Most SBN tests pass now + Intel single point tests pass now +@@ -5,14 +5,11 @@ + + + +- us20 not fully implmented +- us20 not fully implmented +- wus12 not fully implmented +- wus12 not fully implmented + + +- us20 not fully implemented +- wus12 not fully implemented ++ ne16 missing finidat file for 1850 ++ ne60 missing finidat file for 1850 ++ 1x1_tropicAtl missing finidat file for 1850 + + + +@@ -89,19 +86,17 @@ + CESM script issue + Restart length different + Restart length different +- Initial simulation fails ++ Initial simulation fails ++ History files are different on restart + Initial simulation fails + build error? + + + + +- datm namelist problem for single-point forcing +- datm namelist problem for single-point forcing ++ ???? + + +- CESM script issue +- CESM script issue + + + +@@ -110,10 +105,8 @@ + + + T62 not working +- ignore_ic_date is incompatable with crop! +- CESM script problem didn't see both files +- CESM script problem didn't see both files +- build error? ++ Dies early with a floating point trap ++ build error? + + + +@@ -123,22 +116,9 @@ + + + +- datm namelist issue +- datm namelist issue +- datm namelist issue + 277/277 < PASS> + Successully ran all testing for build-namelist + + Cleanup files created + rm: lnd_in.default: A file or directory in the path name does not exist. + rm: temp_file.txt: A file or directory in the path name does not exist. + # Looks like you failed 4 tests of 277. + +%%cesm/clm tests + + mostly OK + + generate : ./cs.status.164019.bluefire + + nohup create_test_suite -input_list bluefire.clm.auxtest -compare clm4_0_50 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_51 -testroot /glade/scratch/muszala/tests > & ! bf_out_`date +"%m%d%y"`.lg & + ID: 203212 + + ## Reason: throughput measure off + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_50 + FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_50 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_50 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.tputcomp.clm4_0_50 + ## baseline diretory already existed, error copying over nc files + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_D.f45_g37.I.bluefire_ibm.generate.clm4_0_51 + FAIL NCK.T31_g37.I.bluefire_ibm.generate.clm4_0_51 + FAIL PST.f45_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL PET_PT.f45_g37.I1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_51 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL SMS.T31_g37.IG4804.bluefire_ibm.generate.clm4_0_51 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.generate.clm4_0_51 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.generate.clm4_0_51 + ## fails due to cprnc time check. new runs are 11 ts. in 50 these were 10, I expect these to pass next time around + FAIL ERS_D.f45_g37.I.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_50 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_50 + ## No Lm3 directories created during clm4_0_50 generate...new case, should pass next time around + SFAIL ERS_Lm3.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.203212 + ERROR: datm.buildnml.csh failed + BFAIL ERS_Lm3.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_50 + No dir to compare to in tag 50 + ## problems in generate due to scripts for single point + SFAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.203212 + ERROR: datm.buildnml.csh failed also failed during generate + BFAIL SMS.1x1_numaIA.ICN.bluefire_ibm.compare_hist.clm4_0_50 + No dir to compare to in tag 50 - failed during generate + + ## these were failing but passed when rerun - keep an eye on these + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_50 + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_50 + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_50 + + went to generated ref case + ./setup -clean + ./setup + then build and rerun + + went to generate case + ./setup -clean + ./setup + clean-build, then build then reurn + + did the same in the CG case for ref and normal case + + After hand running + ./cs.status.203212.bluefire | grep ERB.f09_g16.I1850SPINUPCN + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.memleak + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.memcomp.clm4_0_50 + PASS ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.tputcomp.clm4_0_50 + + This test was rerun with a new testlist + ./cs.status.203212.bluefire | grep ERB.ne30_g16.I_1948-2004 + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.memleak + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_51 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERB.ne30_g16.I_1948-2004.bluefire_ibm.memcomp.clm4_0_50 + FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.tputcomp.clm4_0_50 + throughput tol. error + + ./cs.status.141307.bluefire + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.memleak + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_51 + FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_50 + see cprnc ts error above + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.memcomp.clm4_0_50 + PASS ERH_D.T31_g37.I1850CN.bluefire_ibm.tputcomp.clm4_0_50 + +%%cesm/clm rof tests + nohup create_test_suite -input_list bluefire.clmRof.auxtest -compare clm4_0_50 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_51 -testroot /glade/scratch/muszala/tests > & ! bf_out_`date +"%m%d%y"`.lg & + + These don't exist anymore, but will be replaced once Tony works out default grid resolutions for r01 and r05 + + ID: 091144 + + BFAIL SMR.f19_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + BFAIL SMR.f09_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + FAIL SMR.f05_g16.I_2000_CN.bluefire_ibm + larger scipt errors in rof - kills the following two tests outright + BFAIL SMR.f05_g16.I_2000_CN.bluefire_ibm.generate.clm4_0_51 + BFAIL SMR.f05_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + FAIL SMR.ne120_g16.I_2000_CN.bluefire_ibm.generate.clm4_0_51 + can't copy in, clm4_0_51 baseline already exists + BFAIL SMR.ne120_g16.I_2000_CN.bluefire_ibm.compare_hist.clm4_0_50 + nothing to compare to in clm4_0_50 + RUN SMR.ne240_g16.I_2000_CN.bluefire_ibm.GC.091144 + + +%%%%%% testing reporting end + +CLM tag used for the baseline comparison tests if applicable: + + clm4_0_50 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_50 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Fri Sep 21 15:13:52 MDT 2012 +One-line Summary: testing of clm and new rof component + +Purpose of changes: + +Run tests on clm for new ROF component. CLM mods by tcraig to support ROF. + +Requirements for tag: + +Test level of tag: doc, critical, standard, std-test, reg-test + +std-test + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + + Not needed since ROF is now a CLM external + D models/lnd/clm/src/main/clm_mct_mod.F90 + D models/lnd/clm/src/riverroute + D models/lnd/clm/src/riverroute/RtmMod.F90 + D models/lnd/clm/src/riverroute/RunoffMod.F90 + +List all files added and what they do: + + Fix for some of Erik's new tests + A models/lnd/clm/test/system/user_nl_dirs/monthly + A models/lnd/clm/test/system/user_nl_dirs/monthly/user_nl_clm + A models/lnd/clm/test/system/user_nl_dirs/monthly/user_nl_cpl + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/tools/ncl_scripts + M models/lnd/clm/tools/interpinic + M models/lnd/clm/tools/mksurfdata_map/src + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl + M models/lnd/clm/bld + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/user_nl_clm + M models/lnd/clm/bld/listDefaultNamelist.pl + M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/clm.buildnml.csh + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 + M models/lnd/clm/src/biogeochem/CNDVMod.F90 + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/spmdGathScatMod.F90 + M models/lnd/clm/src/main/clm_varpar.F90 + M models/lnd/clm/src/main/decompInitMod.F90 + M models/lnd/clm/src/main/clm_initializeMod.F90 + M models/lnd/clm/src/main/clmtypeInitMod.F90 + M models/lnd/clm/src/main/histFileMod.F90 + M models/lnd/clm/src/main/clm_atmlnd.F90 + M models/lnd/clm/src/main/findHistFields.pl + M models/lnd/clm/src/main/restFileMod.F90 + M models/lnd/clm/src/main/controlMod.F90 + M models/lnd/clm/src/main/clm_varctl.F90 + M models/lnd/clm/src/main/clm_driver.F90 + M models/lnd/clm/src/main/ncdio_pio.F90 + M models/lnd/clm/src/main/domainMod.F90 + M models/lnd/clm/src/main/decompMod.F90 + M models/lnd/clm/src/main/clmtype.F90 + M models/lnd/clm/src/main/histFldsMod.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 + M SVN_EXTERNAL_DIRECTORIES + M ChangeLog + M ChangeSum + M scripts/ccsm_utils/Case.template/config_definition.xml + + +Machines testing ran on: + +%%%%%%%% Test reporting START %%%%%%%% + + Test system is currently in flux so I will simply list all tests that have + failed and the 8 tests that we need to keep an eye on. I've included bluefire + and lynx and pointers to where tests live. + +* tests that will pass in next tag due to new features +** denotes an expected fail. +*** any tputcomp tests that fail I'm inclined to ignore also. These change from test to test. +? or cd a test that will need fixing + +BLUEFIRE: + +OK ############ run build-namelist tests +>>cd models/lnd/clm/bld/unit_testers +>>./build-namelist_test.pl -compare /glade/scratch/muszala/svn/clm4_0_49/models/lnd/clm/bld/unit_testers -generate -test -csmdata /glade/proj3/cseg/inputdata >&! out_unit_`date +"%m%d%y"`.lg + + OK...failed tests will pass in next tag + +OK ############# run new I case tests +[be1105en /glade/scratch/muszala/svn/clm_trunk/scripts ]$ +create_test_suite -mach bluefire_ibm -input_list allIcompsetsRes.clm.auxtest -nobatch on -nobuild on -compare clm4_0_49 -baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines -generate clm4_0_50 -testroot /glade/scratch/muszala/tests > & ! bf_out_allI_`date +"%m%d%y"`.lg + + 165507 - /glade/scratch/muszala/tests + >>./cs.status.165507.bluefire | grep FAIL +... +** SFAIL SBN.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_urbanc_alpha.I1PT.bluefire_ibm.GC.165507 +** TFAIL SBN.1x1_asphalt_jungle.ICNTEST.bluefire_ibm.GC.165507 +** TFAIL SBN.T42_g16.I1850.bluefire_ibm.GC.165507 +** TFAIL SBN.T31_g16.I1850.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.1x1_tropicAtl.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.ne30_g16.I20TR.bluefire_ibm.GC.165507 +** SFAIL SBN.ne120_g16.I20TRCN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP26CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP45CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP60CN.bluefire_ibm.GC.165507 +** SFAIL SBN.f05_g16.IRCP85CN.bluefire_ibm.GC.165507 + + +OK ############ run clm interactive tools tests +[be1105en /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system ]$ +>>nohup env CLM_SOFF=FALSE ./test_driver.sh -i >&! bluefire_i_`date +"%m%d%y"`.lg & + + OK: looking at /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system/td.951030.status.xFail - rerun + clmTests/test-driver.533240 - /glade/scratch/muszala/svn/clm_trunk/models/lnd/clm/test/system/td.533240.status.xFail + +############# run old cesm/clm tests out of scripts + + +[be1105en /glade/scratch/muszala/svn/clm_trunk/scripts ]$ +>>create_test_suite -input_list bluefire.clm.auxtest -compare clm4_0_49 \ +-baselineroot /glade/proj2/cgd/tss/clm_cesm_baselines \ +-generate clm4_0_50 \ +-testroot /glade/scratch/muszala/tests >&! bf_out_`date +"%m%d%y"`.lg & + + 143258 +>>cs.status.143258.bluefire | grep -v PASS +... + +*** FAIL SMS.T31_g37.IG4804.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_49 +*** FAIL ERS_D.f45_g37.I.bluefire_ibm.compare_hist.clm4_0_49 + +* FAIL NCK.T31_g37.I.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERS_E.T31_g37.I1850.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm + + Failing in Generate: + "/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statement for + unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.generate.clm4_0_50 + BFAIL ERB.ne30_g16.I_1948-2004.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm + + Failing in Generate: + 0:"/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statemen t for unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.generate.clm4_0_50 + BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_49 +? FAIL ERH_D.T31_g37.I1850CN.bluefire_ibm + + Failing in Generate: + "/glade/scratch/muszala/svn/clm4_0_49/models/drv/shr/seq_infodata_mod.F90", line 620: 1525-006 The STATUS= specifier in the OPEN + statement for + unit 98 cannot be set to OLD because the file rpointer.drv does not exist. The program will stop. + + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.generate.clm4_0_50 + BFAIL ERH_D.T31_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_49 + +* FAIL SMS.T31_g37.IG4804.bluefire_ibm.compare_hist.clm4_0_49 +** SFAIL SMS.1x1_mexicocityMEX.I1PT.bluefire_ibm.GC.143258 + should be xFAIL : ERROR(build-namelist::new): Required input variable yearfirst was not found +** SFAIL ERP.1x1_vancouverCAN.I1PT.bluefire_ibm.GC.143258 + should be xFAIL : ERROR(build-namelist::new): Required input variable yearfirst was not found +* FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERP.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.compare_hist.clm4_0_49 +* FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_49 + + + + +############# run new test_system tests + +## interactive +>> test_system -i -c clm4_0_49 -g clm4_0_50 >&! bluefire_tsi_`date +"%m%d%y"`.lg & + + 161038 +>>cs.status.161038.bluefire | grep -v PASS +... +SFAIL ERS_D.CLM_USRDAT.IalaskaCN.bluefire_ibm.GC.161038 +* FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +* FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.memcomp.clm4_0_49 + max memory values differ +*** FAIL ERS_P1x64.f45_g37.I_1850_SPINUP_3HrWx_CN.bluefire_ibm.tputcomp.clm4_0_49 +** FAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm +** BFAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm.generate.clm4_0_50 +** BFAIL ERS_D_P1x64.f19_g16.I_1850-2000_VOC_SNCRFRC_CN.bluefire_ibm.compare_hist.clm4_0_49 +cd RUN ERS_D_P1x25.5x5_amazon.I_2000.bluefire_ibm.GC.161038 +** RUN ERS_D.1x1_asphaltjungleNJ.I_2000_VOC.bluefire_ibm.GC.161038 +** RUN ERS48s_D_P1x64.f45_g37.I_2000_VOC.bluefire_ibm.GC.161038 +* FAIL ERS48s_D_P1x64.f19_g16.I_2000_GLCMECPD.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS48s_D_P1x64.f19_g16.I_2000_GLCMECPD.bluefire_ibm.tputcomp.clm4_0_49 +** FAIL PET_D_P1x64.f45_g37.I_2000_VOC.bluefire_ibm + + + +## batch +>>test_system -c clm4_0_49 -g clm4_0_50 > & ! bluefire_ts_`date +"%m%d%y"`.lg & + + 143420 -- cs.status.143420.bluefire +cs.status.143420.bluefire | grep -v PASS +... +* FAIL ERS211d.f10_f10.ICNADSPIN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS211d.f10_f10.ICNADSPIN.bluefire_ibm.tputcomp.clm4_0_49 +** CFAIL ERS48s_D.f09_g16.ICNEXSPIN.bluefire_ibm.GC.143420 + this is xFAIL for interactive, should also be listed here +* FAIL ERS48s_D_P64x16.ne30_g16.ICN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +*** FAIL ERS48s_D_P64x16.ne30_g16.ICN.bluefire_ibm.tputcomp.clm4_0_49 +* FAIL PET_D_P1x64.ne30_g16.ICN.bluefire_ibm.compare_hist.clm4_0_49 + new fields in cpl history files +? RUN ERS211d_D_P112x2.f10_f10.ICNCROP.bluefire_ibm.GC.143420 + run failed +** FAIL ERS211d.f10_f10.I_2000_VOC_CN.bluefire_ibm.compare_hist.clm4_0_49 +*** FAIL ERS211d.f10_f10.I_2000_VOC_CN.bluefire_ibm.tputcomp.clm4_0_49 +** RUN ERS211d_P192x2.f19_g16.I_2000_CNDV_CROP.bluefire_ibm.GC.143420 +** SFAIL ERS_D_P96x32.T62_g37.I_2000.bluefire_ibm.GC.143420 + + + +############# + +LYNX: + +############# run new test_system tests + +## interactive +>> test_system -i -c clm4_0_49_lynx_pgi -g clm4_0_50_lynx_pgi >&! lynx_i_`date +"%m%d%y"`.lg & + + 144558 + +cs.status.144558.lynx | grep -v PASS +... +*** FAIL ERS211d.1x1_brazil.I_2000.lynx_pgi.tputcomp.clm4_0_49_lynx_pgi +* FAIL ERS48s_D_P1x12.f10_f10.ICNCROP.lynx_pgi.compare_hist.clm4_0_49_lynx_pgi + new fields in cpl history files +** SFAIL SMS_D.1x1_vancouverCAN.I1PT.lynx_pgi.GC.144558 +** SFAIL ERS.1x1_mexicocityMEX.I1PT.lynx_pgi.GC.144558 + + +## batch +>> test_system -c clm4_0_49_lynx_pgi -g clm4_0_50_lynx_pgi >&! lynx_`date +"%m%d%y"`.lg & + + 160925 +./cs.status.160925.lynx | grep -v PASS +... +? BFAIL PMT_D.f45_g37.I_2000.lynx_pgi.compare_hist.clm4_0_49_lynx_pgi + + problem in generate case not copying over file + PASS + Initial Test log is /glade/scratch/muszala/PMT_D.f45_g37.I_2000.lynx_pgi.G.114232/run/cpl.log.120920-152048 + /var/spool/torque/mom_priv/jobs/102008.nid00003.SC: Storing new baseline in /glade/proj2/cgd/tss/clm_cesm_baselines/clm4_0_49_ly + nx_pgi/PMT_D.f45_g37.I_2000.lynx_pgi + ERROR in /var/spool/torque/mom_priv/jobs/102008.nid00003.SC: could not copy /glade/scratch/muszala/archive/PMT_D.f45_g37.I_2000. + lynx_pgi.G.114232/cpl/hist/ to /glade/proj2/cgd/tss/clm_cesm_baselines/clm4_0_49_lynx_pgi/PMT_D.f45_g37.I_2000.lynx_pgi/cpl.hi.nc + +? RUN ERS48s_D.f45_g37.I_2000_VOC.lynx_pgi.GC.160925 + run didn't finish? +? RUN ERS48s_D.f10_f10.I_2000_CN.lynx_pgi.GC.160925 + PBS: job killed: walltime 9021 exceeded limit 9000 +? RUN ERS48s_P96x2.f19_g16.I_2000_VOC_SNCRFRC_CN_GLCMECPD.lynx_pgi.GC.160925 + PBS: job killed: walltime 9041 exceeded limit 9000 + +## interactive, with mirage test list and intel compiler +>>test_system -i -p intel -l mirage.interactive -o "-mach lynx" -c clm4_0_49_lynx_intel -g clm4_0_50_lynx_intel > & ! lynx_mi_intel_`date +"%m%d%y"`.lg & + + 143620 cs.status.143620.lynx +>>cs.status.143620.lynx | grep -v PASS +... +** FAIL ERS.1x1_brazil.I_2000.lynx_intel +** BFAIL ERS.1x1_brazil.I_2000.lynx_intel.generate.clm4_0_50_lynx_intel +** BFAIL ERS.1x1_brazil.I_2000.lynx_intel.compare_hist.clm4_0_49_lynx_intel +? FAIL ERI_D.1x1_camdenNJ.I_2000_VOC.lynx_intel + forrtl: error (73): floating divide by zero - rtmmod_mp_rtmini_ 303 RtmMod.F90 +** RUN ERS_D.1x1_asphaltjungleNJ.I_2000_VOC.lynx_intel.GC.143620 + forrtl: error (73): floating divide by zero - rtmmod_mp_rtmini_ 303 RtmMod.F90 +* FAIL ERS48s_D_P1x12.f10_f10.I_2000_CN.lynx_intel.compare_hist.clm4_0_49_lynx_intel + new fields in cpl history files +*** FAIL ERS48s_D_P1x12.f10_f10.I_2000_CN.lynx_intel.tputcomp.clm4_0_49_lynx_intel + +%%%%%%%% Test reporting END %%%%%%%% + + + build-namelist unit tester: + + CESM test lists: + + bluefire/CESM + lynx/CESM + + bluefire/PTCLM + + test_system testing: + + bluefire batch: + bluefire interactive: + lynx/pgi batch: + lynx/pgi interactive: + mirage,storm/ifort interactive: + +CLM tag used for the baseline comparison tests if applicable: + + clm4_0_49 + +Changes answers relative to baseline: Yes, runoff is different (similar climate) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all with RTM + - what platforms/compilers: all + - nature of change (similar climate) I compsets only have runoff change + + MSS location of control simulations used to validate new climate: + + https://wiki.ucar.edu/display/ccsm/CCSM4+-+Track5+experiments + + /CCSM/csm/b.e11.B1850CN.f19_g16.004 + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm4_0_49 +Originator(s): erik (Kluzek Erik 303-497-1326 CGD) +Date: Sun Sep 16 01:05:04 MDT 2012 +One-line Summary: Move clm testing to use CESM test framework + +Purpose of changes: + +Move testing for CLM from CLM stand-alone test_driver.sh to one based on +the CESM testing framework. Create CLM specific tests-lists, user_nl_dir, +and compset files to handle most CLM testing. + +Requirements for tag: + + Move major testing from test_driver.sh to one based on CESM framework. Try + to get most of it to work. + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Update to cesm1_1_beta18b + + scripts updated to: scripts4_120915 + scripts updated to: Machines_120915 + mapping updated to: mapping_120816 + stubs updated to: stubs1_3_05 + drv updated to: drvseq1_4_26 + +List all files eliminated: None + +List all files added and what they do: + +A + models/lnd/clm/test/system/test_system ---- New main testing script for CLM. + wrapper script to CESM scripts/create_test_suite with behavior + similar to test_driver.sh + + -b directory [or --baseline] baseline directory + -c version [or --compare] version to compare to + (generate must already have been run to create these) + -d debug usage -- display tests that will run -- but + do NOT actually execute them + -g version [or --generate] name of this version to generate version as + -h [or --help] displays help + -i interactive usage + -l list [or --list] input test list to use instead of default + (path relative to this directory) + -o options [or --options] options to pass to create_test_suite + -p compiler [or --compiler] compiler to use instead of default + -s [or --shortlist] use the short test list + + Typical use: + + cd models/lnd/clm/test/system + test_system -i -c clm4_0_48 -g clm4_0_49 + test_system -c clm4_0_48 -g clm4_0_49 + + +>>>>>>>>>>>>> Test lists +A + models/lnd/clm/test/system/mirage.interactive +A + models/lnd/clm/test/system/lynx.interactive +A + models/lnd/clm/test/system/shortlist.interactive +A + models/lnd/clm/test/system/bluefire.batch +A + models/lnd/clm/test/system/bluefire.interactive +A + models/lnd/clm/test/system/lynx.batch +A + models/lnd/clm/test/system/shortlist.batch + +>>>>>>>>>>>>> compset file and user_nl_* files for testing +A + models/lnd/clm/test/system/config_files/config_CLMtestCompsets.xml +A + models/lnd/clm/test/system/user_nl_dirs +A + models/lnd/clm/test/system/user_nl_dirs/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/crop +A + models/lnd/clm/test/system/user_nl_dirs/crop/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/cn_conly +A + models/lnd/clm/test/system/user_nl_dirs/cn_conly/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/voc +A + models/lnd/clm/test/system/user_nl_dirs/voc/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/voc/user_nl_cpl +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC/user_nl_clm +A + models/lnd/clm/test/system/user_nl_dirs/glcMEC/user_nl_cpl + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/bld/listDefaultNamelist.pl +M models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml - New failed + tests from new test framework +M models/lnd/clm/bld/clm.buildnml.csh - Copy drv_flds_in if clm creates it + and if it doesn't already exist. +M UpDateChangeLog.pl -- Add some support for xFail. Not fully working. + +Machines testing ran on: + + build-namelist unit tester: yes + + test_system testing: + + bluefire batch: yes + bluefire interactive: yes + bluefire/CESM: yes + lynx/pgi batch: yes + lynx/pgi interactive: yes + +CLM tag used for the baseline comparison tests if applicable: clm4_0_48 + +Difference in expected fails from testing: + +Index: expectedClmTestFails.xml +=================================================================== +--- expectedClmTestFails.xml (.../trunk_tags/clm4_0_48/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml) (revision 40288) ++++ expectedClmTestFails.xml (.../trunk/models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml) (revision 40288) +@@ -34,6 +34,10 @@ + + + cprnc showing diffs are not b4b ++ problem configuring ++ problem configuring ++ clm stand-alone can no longer work ++ clm stand-alone can no longer work + + + +@@ -71,14 +75,70 @@ + + + ++ ++ CESM script issue ++ CESM script issue ++ + + + + + ++ ++ ++ ++ CESM script issue ++ Restart length different ++ Restart length different ++ Initial simulation fails ++ Initial simulation fails ++ ++ ++ ++ ++ datm namelist problem for single-point forcing ++ datm namelist problem for single-point forcing ++ ++ ++ ++ ++ ++ ++ ++ T62 not working ++ ignore_ic_date is incompatable with crop! ++ CESM script problem didn't see both files ++ CESM script problem didn't see both files ++ ++ ++ ++ ++ ++ + + + ++ datm namelist issue ++ datm namelist issue ++ datm namelist issue ++ datm namelist issue ++ missing wus12 datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ missing datasets ++ ++ ++ ++ ++ ++ + + + + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_48 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Tue Sep 11 09:14:40 MDT 2012 +One-line Summary: bug fixes, xFail to tests and normalize test output for CLM + +Purpose of changes: Bug Fixes. Add xFail capability to CLM batch, +interactive and namelist tests. Make test output the same for CLM +tests. + +Requirements for tag: Test on bluefire (CESM, int, bat), lynx/pgi (int,bat) +Fix bugs: 1436,1500,1521,1537 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + + 1436,1500,1521,1537 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + + 1545 - on lynx clm-batch doesn't call our new xFAIL module. + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: xFail module Bill, Erik. Rest of code Erik. + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +List a files added and what they do: + +A models/lnd/clm/bld/unit_testers/xFail +A models/lnd/clm/bld/unit_testers/xFail/expectedFail.pm +A models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml +A models/lnd/clm/bld/unit_testers/xFail/wrapClmTests.pl + + - xFAIL module that implements expected fail reporting. wrapClmTests.pl is used +as a wrapper and called by test_driver.sh. The XML file holds test cases. +Documentation is in POD in expectedFail.pm + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/TBL.sh + - fix so that mct and pio are built out of the baseline directory +M models/lnd/clm/bld/configure + - fix path to mct/.../mpi-serial +M models/lnd/clm/src/main/getdatetime.F90 + - fix to broadcast correct time stamp +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + - both of these files modified to support xFAIL functionality +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + - remove wrf mapping entry that isn't in inputdata. fix entries per bug + 1521 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + - remove wrf mapping entry that isn't in inputdata. fix entry per bug 1521 + +Summary of testing: + +Note that tests that used to fail are now being reported as xFAIL. The file +to look at is models/lnd/clm/bld/unit_testers/xFail/expectedClmTestFails.xml. + +There are no tests that used to FAIL that now PASS. + + build-namelist unit testing: all pass + bluefire: all pass + bluefire interactive testing: all pass + bluefire/CESM testing: a few throughput failures + + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 2.945 tput_percent_decr = 21.3 + + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 65.6 tput_percent_decr = 41.9 + + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 1.8039999 tput_percent_decr = 2.07 + + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 2.325 tput_percent_decr = 9.80 + + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_47 + COMMENT tput_decr = 7.0280000 tput_percent_decr = 3.69 + + bluefire/PTCLM testing: N/A + lynx/pgi testing: all pass + lynx/pgi interactive testing: all pass + lynx/CESM testing: + mirage,storm/ifort interactive testing: all pass + +CLM tag used for the baseline comparison tests if applicable: clm4_0_47 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_47 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Thu Aug 23 11:09:27 MDT 2012 +One-line Summary: bug fixes + +Purpose of changes: + + Fix some bugs and tag early since CAM needs fix of bug 1538 asap. + +Requirements for tag: + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + + 1534,1533,1507,1444,1538 + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/configure +-- Passes FLAGS down to cesm_lib build and for pio (only for CLM testing) + +M models/lnd/clm/tools/mkmapdata/regridbatch.sh +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +-- Fixes as per bug 1507. Logic clean up for interactive and using mpi + +M models/lnd/clm/bld/build-namelist +-- Fix as per bug 1538 + +M models/lnd/clm/src/main/controlMod.F90 +-- Fix as per bug 1444. remove call to "mpi_bcast (glc_topomax," and logic + controlling it. + +M models/lnd/clm/src/main/ncdio_pio.F90 +-- Fix as per bug 1533 and 1534 + +M SVN_EXTERNAL_DIRECTORIES +-- Mistake from last tag. Replaced two repos with correct trunk-tag urls. + + +Summary of testing: + + build-namelist unit testing: + All PASS except: + fails involve us20 and wus12 + not ok 141 - lnd_in file the same as expected for CN - 94x192 - fixed. Should pass in next tag. + not ok 214 - lnd_in file exists - us20 - no tests in place + not ok 219 - lnd_in file exists - wus12 - no tests in place + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 - wus12 - no tests in place + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 - wus12 - no tests in place + bluefire: + + 016-019 will be removed and put in CESM/CLM tests + 016 smW51 TSM.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 10 + 017 erW51 TER.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -3+-2 cold ..............FAIL! rc= 5 + 018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 5 + 019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 4 + + 036-039 Failed in the past, see prior versions + 036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 + 037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 + 038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + 039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 + + 049-052 Failed in the past, see prior versions + 049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 + 050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 + 051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + 052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + + bluefire interactive testing: + All PASS execpt: + 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 5 + 012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 5 + 016 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + 020 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 + 024 blCA8 TBL.sh _sc_ds clm_drydep^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic .....FAIL! rc= 5 + 026 blCK4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 + 028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -10 cold ...........FAIL! rc= 5 + 030 blC78 TBL.sh _sc_s clm_std^nl_urb 20021231:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 + 038 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 5 + 042 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 + 046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 5 + 050 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 5 + 054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 5 + 067 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + bluefire/CESM testing: + All PASS except: + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_46 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_46 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_46 + Reason: the throughput tolerance is likely still not large enough. + bluefire/PTCLM testing: N/A + lynx/pgi testing: + lynx/pgi interactive testing: + 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 + 010 blCL4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 + 014 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + lynx/CESM testing: + N/A + mirage,storm/ifort interactive testing: + All PASS except: + 70 004 blC74 TBL.sh _sc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ..................FAIL! rc= 5 + 71 007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 5 + 72 011 blCA4 TBL.sh _sc_ds clm_drydep^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ............FAIL! rc= 5 + 73 015 blCA8 TBL.sh _sc_ds clm_drydep^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic .....FAIL! rc= 5 + 74 019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 5 + 75 023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 5 + Reason: changed configure, but configure in previous tag not updated. + These will pass when a new tag is compared to clm4_0_47 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_46 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_46 +Originator(s): muszala (Muszala Stefan 303-497-1320 CGD) +Date: Wed Aug 8 11:53:44 MDT 2012 +One-line Summary: R01 support and update externals + +Purpose of changes: + + Add support for r01 rtm. Add mapping files for ne120 and ne240. Update all svn + externals to what is in cesm_alpha16e and modify and update our test system as + necessary. + +Requirements for tag: test on bluefire (CESM, int, bat, build-namelist), lynx/pgi (int,bat), mirage. + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID):N/A + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system:N/A + +Describe any changes made to the namelist:N/A + +List any changes to the defaults for the boundary datasets:N/A + +Describe any substantial timing or memory changes:N/A + +Code reviewed by: self, Erik + +List any svn externals directories updated (csm_share, mct, etc.): + Created the following tags: + https://svn-ccsm-models.cgd.ucar.edu/scripts/trunk_tags/scripts4_120808 + https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq4_1_23 + https://svn-ccsm-models.cgd.ucar.edu/tools/cprnc/trunk_tags/cprnc_120807 + +List all files eliminated:N/A + +List all files added and what they do:N/A + +List all existing files that have been modified, and describe the changes: + +== modifications to update externals == + M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES + M SVN_EXTERNAL_DIRECTORIES + +== modifications to get cesm/clm, interactive tests to pass == + + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl + -- added more output for easier test reading + M models/lnd/clm/test/system/TCB.sh + -- fix some indentation + M models/lnd/clm/test/system/TCBtools.sh + -- add support for gen_domain configure on bluefire + M models/lnd/clm/test/system/test_driver.sh + -- move tests to clmTest directory on /glade/scratch + M models/lnd/clm/test/system/CLM_runcmnd.sh + -- just indent diffs + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 + -- handle all files as large files (from ne240 runs) + M models/lnd/clm/bld/configure + -- add dependency for pio piovdf.o: pio_kinds.o + -- remove -lgptl from cesm Makefile + +== added r01 maps to namelist_defaults_clm.xml == + + M clm.buildnml.csh + M namelist_files/namelist_defaults_overall.xml + -- modified namelist_defaults_overall.xml to take wus12 and us20 with rmt off + -- also added ne240 and default gx1v6 ocean mask + -- modes to bld/clm.buildnml.csh so that rtm is off for wus12 + -- added path and script name to xml generated by createMapEntry.pl + -- checked wus12_wus12 run. Configures and runs. Error message to look for is: + + "Do not run the River Transport Model (RTM)" which is correct since wus12_wus12 is + a regional grid + +== modify scripts and drv to get new r01 to gx1v6 mapping files == + M scripts/ccsm_utils/Case.template/config_grid.xml + M scripts/ccsm_utils/Case.template/config_definition.xml + M models/drv/bld/namelist_files/namelist_defaults_drv.xml + -- namelist_defaults_drv.xml - added rof_grid for r01 and gx1v6 + +== modify xml so that 1/10 degree runs work == + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh + M models/lnd/clm/tools/mkmapgrids/mkmapgrids.namelist + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + M models/lnd/clm/src/riverroute/RtmMod.F90 + +Summary of testing: + + build-namelist unit testing: + All PASS except: + fails involve us20 and wus12 + not ok 141 - lnd_in file the same as expected for CN - 94x192 - fixed. Should pass in next tag. + not ok 214 - lnd_in file exists - us20 - no tests in place + not ok 219 - lnd_in file exists - wus12 - no tests in place + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 - wus12 - no tests in place + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 - wus12 - no tests in place + bluefire: + All PASS except: + 018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 + modified to -3+-3 -- still FAIL + 036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 + 037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 + 038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + 039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 + 036-039 needs major work + + and why they fail... + + 018 - cprnc differences in comparison + 036 - endrun initiated from CNBalanceCheckMod.F90 + 037 - __cnbalancecheckmod_NMOD_cbalancecheck + 038, 039 - fail since 037 didn't run + + bluefire interactive testing: + All PASS except: + bl514 - will fail because tag 45 has a broken gen_domain build + bl954 - no ne240 in tag 45 + bl9C4 - 8 bit difference in file size due to using large file write in mkfileMod.F90 + These should pass in next tag + bluefire/CESM testing: + All PASS except: + FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_45 + FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_45 + + There is tolerance check built into the tests that may be too tight. Jay will look at this in the future. + Throughputs are reported and a sampling looks reasonable: + + CHECK SMS_RLA.f45_f45.I.bluefire_ibm.perf npes=1 tput=16.026 memh=259.677 memr=-0.001 tag=clm4_0_45 baseline + CHECK SMS_RLA.f45_f45.I.bluefire_ibm.perf npes=1 tput=9.392 memh=259.856 memr=-0.001 tag= + + CHECK SMS.f10_f10.IRCP45CN.bluefire_ibm.perf npes=16 tput=200.866 memh=265.074 memr=-0.001 tag=clm4_0_45 baseline + CHECK SMS.f10_f10.IRCP45CN.bluefire_ibm.perf npes=16 tput=187.881 memh=267.630 memr=-0.001 tag= + + CHECK ERS_D.f19_g16.IRCP85CN.bluefire_ibm.perf npes=64 tput=29.741 memh=292.035 memr=-0.001 tag=clm4_0_45 baseline + CHECK ERS_D.f19_g16.IRCP85CN.bluefire_ibm.perf npes=64 tput=28.368 memh=294.879 memr=-0.001 tag= + + bluefire/PTCLM testing: + lynx/pgi testing: + lynx/pgi interactive testing:All PASS + lynx/CESM testing:All PASS + mirage,storm/ifort interactive testing:All PASS + +CLM tag used for the baseline comparison tests if applicable: CLM4_0_45 + +Changes answers relative to baseline:No + +=============================================================== +=============================================================== +Tag name: clm4_0_45 +Originator(s): sacks (Sacks Bill 303-497-1762 CGD) +Date: Fri Jul 20 11:41:14 MDT 2012 +One-line Summary: fix virtual columns; new urban mksurfdata_map + +Purpose of changes: + +GLC-related: Fix places where glc virtual columns were not being treated +correctly (major bug!). Change albice default to 0.6,0.4 for glc_mec +cases, based on suggestion from Bill Lipscomb. Fix dust calculation for +glc_mec. + +Other CLM changes: Add an instance of istcrop. Fix landunit-level output +for dov2xy=false. + +Tools changes: Update mksurfdata_map to handle new urban raw data format +(use dominant density class, together with lookup tables; currently used +for mksurfdata_map with hires). Minor fixes to mksurfdata_map. Add unit +tests to mksurfdata_map. Change tools build to support addition of unit +tests. Minor fixes to mkscripgrid.ncl, mkunitymap.ncl and mknoocnmap.pl. + +Namelist-related: Refer to correct scrip grid files for f09, f19; and +a few fixed mapping files for those resolutions, including clm->rtm mapping +files for those resolutions (changes answers for RTM). (The old scrip grid +files had a displaced pole, which is not what we want for CLM. Note that I +did NOT replace the f05 scrip grid file, because the only alternative I can +find has bad values in the corner arrays -- see bug 1518.) + +SPM--Mostly changes to get more tests to pass. Added 1x1_* mapping files to +inputdata. Created script that auto-generates XML for new mapping files for +easier inclusion into existing XML files. Modify build-namelist_test.pl to +pass CSMDATA to build-namelist. Tests were failing if a user didn't have +CSMDATA env set. Touched CFGtools__ds to get a CLM interactive test to pass. +Added openMP and debug openMP tests for bluefire interactive tests for 10x15. +--SPM + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage. +Fix bug 1492 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1492 (missing istcrop) + 1515 (nedd mapping files for + single-point)-SPM + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Makefiles reorganized for tools (mksurfdata_map, interpinic, mkmapgrids) + +Describe any changes made to the namelist: + + albice changed to 0.6,0.4 for glc_mec cases + +List any changes to the defaults for the boundary datasets: + + Use corrected mapping files for CLM->RTM for f09,f19, and for some + mapping files used to create surface datasets. Use correct scrip grids + for f09,f19. Add new urban raw data file for hires mksurfdata_map, and + associated scrip grid file & mapping files. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: + +>>>>>>> Split into mkurbanparCommonMod, mkurbanparAvgMod and mkurbanparDomMod +D models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 + +>>>>>>> Modify build system to make it easier to add unit testers +D models/lnd/clm/tools/mksurfdata_map/src/Macros.custom +D models/lnd/clm/tools/interpinic/src/Macros.custom +D models/lnd/clm/tools/mkmapgrids/src/Macros.custom + + +List all files added and what they do: + +>>>>>>> SPM-- Dump XML of mappings for a specified resolution +A namelist_files/createMapEntry.pl +>>>>>>> --SPM + + +>>>>>>> Pull out routines from mkurbanparMod that are common to different +>>>>>>> ways of creating urban parameter data +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparCommonMod.F90 + +>>>>>>> Modules to handle old (area-average) and new (dominant-type) urban +>>>>>>> input files +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparAvgMod.F90 - mostly from mkurbanparMod +A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparDomMod.F90 - new code, to handle new format + +>>>>>>> New modules with general-purpose utilities for mksurfdata_map +A models/lnd/clm/tools/mksurfdata_map/src/mkutilsMod.F90 +A models/lnd/clm/tools/mksurfdata_map/src/mkindexmapMod.F90 + +>>>>>>> New unit testers for mksurfdata_map +A models/lnd/clm/tools/mksurfdata_map/unit_testers +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkutilsMod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Srcfiles +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mod.F90 +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Filepath +A models/lnd/clm/tools/mksurfdata_map/unit_testers/Makefile +A models/lnd/clm/tools/mksurfdata_map/unit_testers/README +A models/lnd/clm/tools/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 + +>>>>>>> Modify build system to make it easier to add unit testers +A models/lnd/clm/tools/mksurfdata_map/src/Makefile.common +A models/lnd/clm/tools/mkmapgrids/src/Makefile.common +A models/lnd/clm/tools/interpinic/src/Makefile.common + + +List all existing files that have been modified, and describe the changes: + +>>>>>>> SPM-- +>>>>>>> Pass csmdata down to build-namelist and add logic so CSMDATA is set +>>>>>>> even if user does not +M unit_testers/build-namelist_test.pl +>>>>>>> Add support for 1x1_* single point mapping files +M namelist_files/namelist_defaults_clm.xml +M namelist_files/namelist_defaults_clm_tools.xml +>>>>>>> Add support for a few openMP 10x15 tests, modify test list +>>>>>>> and remove some old single point tests +M test/system/tests_pretag_bluefire_nompi +M test/system/input_tests_master +M test/system/tests_posttag_nompi_regression + +>>>>>>> --SPM + +>>>>>>> Fix glc virtual column bugs: change checks of (wt > 0) +>>>>>>> to (wt > 0 .or. ityplun(l)==istice_mec) +M models/lnd/clm/src/main/histFileMod.F90 ---------- also fix landunit-level fields + with dov2xy=.false. +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - also change + 'if (itypelun==istice)' to 'if (itypelun==istice .or. itypelun==istice_mec)' + in setting parameters +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 + +>>>>>>> Add istcrop (fix bug 1492) +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + +>>>>>>> Remove unnecessary 'use' +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 + +>>>>>>> Change albice to 0.6,0.4 for glc_mec cases; add mapping files for +>>>>>>> 3x3min_LandScan2004; use corrected mapping files for 5x5min_ISRIC-WISE_to_0.9x1.25, +>>>>>>> 3x3min_MODIS_to_0.9x1.25 and 5x5min_nomask_to_1.9x2.5, as well as for CLM->RTM +>>>>>>> for f09 and f19 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>> Point to correct files for f09,f19 scrip grids; add new urban raw data file +>>>>>>> for hires mksurfdata_map +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>> Add support for new 3x3min_LandScan2004 grid +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh +M models/lnd/clm/bld/namelist_files/checkmapfiles.ncl +M models/lnd/clm/bld/namelist_files/namelist_definition.xml + +>>>>>>> Changes to mksurfdata_map to support new input urban format +M models/lnd/clm/tools/mksurfdata_map/src/Srcfiles ------ add new source files +M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 - use new urban interfaces; + also, substantially increase tolerance for roundoff error fix in + normalizencheck_landuse (the latter change is unrelated to the new urban + format; this change makes it so more points have 100% special rather than + nearly-100% special, which was required to avoid CLM termination due to + rounding errors in some cases) +M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 - add URBAN_DENSITY_CLASS + and URBAN_REGION_ID fields +M models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 --- public declarations of + routines that are now needed + +>>>>>>> Other, incidental changes to mksurfdata_map +M models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 ---- fix zero_out +M models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 - correct rounding errors + in topoglcmec_o; change a warning to a fatal error +M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 - add tolerance in + checking for lat/lon equality + +>>>>>>> Add src_grid_dims & dst_grid_dims +M models/lnd/clm/tools/mkmapdata/mkunitymap.ncl + +>>>>>>> Fix direction of ocn->atm mapping file +M models/lnd/clm/tools/mkmapdata/mknoocnmap.pl +M models/lnd/clm/tools/README ------------------ also fix typos + +>>>>>>> Fix ordering of corners +M models/lnd/clm/tools/mkmapgrids/mkscripgrid.ncl + +>>>>>>> Modify build system to make it easier to add unit testers +M models/lnd/clm/tools/mksurfdata_map/src/Makefile +M models/lnd/clm/tools/interpinic/src/Makefile +M models/lnd/clm/tools/mkmapgrids/src/Makefile +M models/lnd/clm/test/system/TCBtools.sh ----------- copy correct file + +>>>>>>> Document copy of test_mod +M models/lnd/clm/tools/README.filecopies + + +Summary of testing: + +--SPM. New tests run after update to clm4_0_44 and after tests modifications. + +==== bluefire build-namelist tests: ==== + + * expected fail due to new mapping file + < fmapinp_rtm = '/glade/proj3/CESM/cseg/inputdata//lnd/clm2/mappingdata/maps/1.9x2.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120522.nc' + --- + > fmapinp_rtm = '/glade/proj3/CESM/cseg/inputdata//lnd/clm2/mappingdata/maps/1.9x2.5/map_1.9x2.5_nomask_to_0.5x0.5_nomask_aave_da_c120221.nc' + + * not ok 6 - lnd_in file the same as expected for standard + not ok 23 - lnd_in file the same as expected for standard + +This is expected. Bill states this mod in ChangeLog + + < albice = 0.60,0.40 + --- + > albice = 0.50,0.50 + + * not ok 29 - lnd_in file the same as expected for standard + * not ok 36 - lnd_in file the same as expected for standard + * not ok 43 - lnd_in file the same as expected for standard + * not ok 49 - lnd_in file the same as expected for standard + * not ok 54 - lnd_in file the same as expected for standard + * not ok 59 - lnd_in file the same as expected for standard + * not ok 64 - lnd_in file the same as expected for standard + * not ok 69 - lnd_in file the same as expected for standard + * not ok 74 - lnd_in file the same as expected for standard + * not ok 80 - lnd_in file the same as expected for standard + * not ok 85 - lnd_in file the same as expected for standard + * not ok 91 - lnd_in file the same as expected for standard + * not ok 156 - lnd_in file the same as expected for CN + * not ok 161 - lnd_in file the same as expected for CN + + 221 and 222 are for new WRF tests, ignoring for now since tests not complete + not ok 221 - compare file lnd_in DNE for CN and -res+wus12 + # in NMLTest/CompFiles.pm at line 103. + WARNING(NMLTest::CompFiles::comparefiles):: File /glade/scratch/muszala/svn/clm4_0_44/models/lnd/clm/bld/unit_testers/temp_file.txt.CN.-res+wus12 + does NOT exist! + + not ok 222 - compare file temp_file.txt DNE for CN and -res+wus12 + +WARNING(NMLTest::CompFiles::comparefiles):: File /glade/scratch/muszala/svn/clm4_0_44/models/lnd/clm/bld/unit_testers/temp_file.txt.CN.-res+wus12 + 2349 does NOT exist! + + # Failed test 'compare file temp_file.txt DNE for CN and -res+wus12 + # ' + # in NMLTest/CompFiles.pm at line 103. + + * not ok 276 - lnd_in file the same as expected for crop + +==== bluefire interactive ==== + now pass due to new mapping files (ignore numbering, use test descriptor) +001 sm514 TSMCFGtools.sh gen_domain CFGtools__ds T31.runoptions .................................PASS +002 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds PASS +003 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dPASS +004 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds PASS + + new tests and test descriptors for 10x15 openMP tests +001 sm953 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__o .......PASS +002 bl953 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__o .......SKIPPED* +003 sm954 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......PASS +004 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......SKIPPED* +005 sm957 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__do ......PASS +006 bl957 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__do ......SKIPPED* +007 sm959 TSMscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................PASS +008 bl959 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................SKIPPED* + +--SPM + +NOTE: UNLESS OTHERWISE NOTED, THE BELOW TESTS WERE RUN FROM TAG +virtual_column_fix_03_clm4_0_43. This means that they were run before +reverting the scrip grid file & rtm mapping file for f05. However, that +shouldn't change any test results, since as far as I can tell, nothing in +the CLM test suite tests f05 resolution. THESE TESTS SHOULD BE RERUN ON THE +FINAL VERSION OF THE TAG BEFORE MERGING IT TO THE TRUNK. + + bluefire build-namelist unit testing (run with -test): ALL PASS EXCEPT: +not ok 42 - rtm tstep inconsistent + bluefire mksurfdata_map unit testing: ALL PASS + bluefire: All PASS except: +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +043 blCn1 TBL.sh _sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arb_ic FAIL! rc= 7 +049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except: +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 7 +054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except: +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERI.T31_g37.IG1850.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERP.f19_g16.IGRCP60CN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.compare_hist.clm4_0_43 + bluefire/PTCLM testing: NOT DONE! + lynx/pgi testing: All PASS + lynx/pgi interactive testing: All PASS except: +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +024 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +025 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + lynx/CESM testing: All PASS except: +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.C.123047 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_43 +FAIL ERS.f19_g16.IRCP26CN.lynx_gnu.compare_hist.clm4_0_43 +FAIL ERS.f19_g16.IG1850.lynx_pgi.compare_hist.clm4_0_43 + mirage,storm/ifort interactive testing: All PASS + + Additional testing: Additional CESM B compset tests to test new RTM + mapping files. Ran these from cesm1_1_alpha13e; for most tests, switched + clm to virtual_column_fix_03_clm4_0_43; for the lynx f05 test, switched + clm to virtual_column_fix_04_clm4_0_43. Note that the baseline + comparisons are expected to fail, except for the f05 test. +PASS ERI.f19_g16.BRCP45WCN.bluefire_ibm +FAIL ERI.f19_g16.BRCP45WCN.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS ERS.f19_g16.B2000CNCHM.bluefire_ibm +FAIL ERS.f19_g16.B2000CNCHM.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS SMS_D.f19_g16.B20TRC5.bluefire_ibm +FAIL SMS_D.f19_g16.B20TRC5.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS ERS.f09_g16.B1850BPRP.bluefire_ibm +FAIL ERS.f09_g16.B1850BPRP.bluefire_ibm.compare_hist.cesm1_1_alpha13e +PASS SMS_D.f19_g16.B20TRC5.lynx_pgi +FAIL SMS_D.f19_g16.B20TRC5.lynx_pgi.compare_hist.cesm1_1_alpha13e +PASS SMS.f05_g16.B.lynx_pgi +PASS SMS.f05_g16.B.lynx_pgi.compare_hist.cesm1_1_alpha13e + + +CLM tag used for the baseline comparison tests if applicable: clm4_0_43; +for my additional CESM tests, compared against cesm1_1_alpha13e + +Changes answers relative to baseline: YES, for GLC configurations and all +f09 & f19 configurations with RTM + + Baseline failures that are not because of GLC or RTM mapping file changes + are: + +>>> also failed in clm4_0_43; fails with "build-namelist ERROR:: bad input to drv_runlength option" +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +>>> I think the problem here is that the baseline test is trying to build interpinic from the current directory, +>>> rather than from BL_ROOT. This is a problem because of changes in the tools' build. +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 + + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: - all GLC configurations (albice change & virtual column bug fix) + - all f09 & f19 configurations with RTM (due to change in RTM mapping file) + - what platforms/compilers: All + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + For GLC: climate-changing + + For f09/f19 due to RTM mapping file change: Larger than roundoff, but + expected to have same climate. The new scrip grid files have + roundoff-level differences globally, plus differ substantially at the + poles because the old (incorrect) files had poles displaced from + -90/90. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? N/A + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - compset (and additional configure options): + - build-namelist options (or complete namelist): + - MSS location of output: + + EVALUATION OF NEW CLIMATE NOT PERFORMED + +=============================================================== +=============================================================== +Tag name: clm4_0_44 +Originator(s): erik (Erik Kluzek) +Date: Mon Jul 9 11:14:11 MDT 2012 +One-line Summary: Add wrf resolutions, update externals to cesm1_1_beta15, all components use build-namelist now + +Purpose of changes: + +set nsegspc=1 for all ne grids. Update to latest externals and new datm. Latest externals +have ALL components using a build-namelist, and user_nl.$COMP files are created for you. +Env files changed most fields in env_conf moved to env_run and secondly env_build. +env_mach_pes moved to env_configure. env_conf removed. Add ne4, ne16, ne60 datasets. Add +in ne16, ne30, ne120 20th Century datasets. Change of templates to have +clm.buildnml.csh and clm.buildexe.csh copied to Buildconf. Have -chk_res option to +build-namelist to check for resolution/mask, -note option to include (or not) note on the +bottom of the namelist. Expand build-namelist unit test. + +Requirements for tag: + Requirements: test on bluefire (CESM, int, bat) + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1513 (mksurfdata.pl doesn't work with -crop flag) + 1514 (inconsistancy in char variable fexcl) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (Problem reading restarts@ne30_g16 for some layouts) + 1517 (Performance of datm in clm4_0_44 is even worse) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: Yes! + env*.xml files changed as follows: + + env_conf.xml ------> removed! + Most variables moved to env_run.xml. Some variables moved to env_build.xml + env_mach_pes.xml --> Renamed to env_configure.xml + + Buildconf directory ---> think of it as readonly! +Describe any changes made to the namelist: Yes! + + user_nl_* files for ALL components created for you. Put, your changes to namelists + files here. + + New options to clm build-namelist: + (all but -chk_res and -note are already exercised when running CESM) + -chk_res ------- Check resolution and land mask first. + -clm_startfile - Input file to use to startup for branch or startup cases. + -co2_type ------ CO2 type + -inst_string --- Instance string to use for clm_startfile for multi-instance cases. + -l_ncpl -------- Number of coupling time-steps to take per day. + -lnd_frac ------ Land fraction file to use (domain file) + -note ---------- Write out note about build-namelist usage to end of file. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: Yes! + Most of the throughput tests fail, and single-point performance looks horrible. + Although this may be a sporatic problem due to file systems. See bug 1517. + +Code reviewed by: self, mvertens, tcraig + +List any svn externals directories updated (csm_share, mct, etc.): + Update to cesm1_1_beta15 external versions (other than timing) + scripts to scripts4_120604 + Machines to Machines_120529 + drv to drvseq4_1_15 + datm to datm8_120528 + csm_share to share3_120509 + mct to MCT2_8_0_120503 + pio to pio_1_4_5 + stubs to cism1_120529 + esmf_wrf_timemgr to esmf_wrf_timemgr_120427 + mapping to mapping_120525 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add tools testers for directories that use CESM configure + A models/lnd/clm/test/system/TCBCFGtools.sh + A models/lnd/clm/test/system/TSMCFGtools.sh + A models/lnd/clm/test/system/TBLCFGtools.sh + + A models/lnd/clm/bld/unit_testers/NMLTest/CompFiles.pm - New test module + + A models/lnd/clm/test/system/nl_files/mksrfdt_T31_crpglc_2000 - mksurfdata crop test + +>>>>>>>>>>>> Split out buildexe/buildnml from template so that editing templates +>>>>>>>>>>>> isn't a nightmare + A models/lnd/clm/bld/clm.buildexe.csh + A models/lnd/clm/bld/clm.buildnml.csh + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change tests a bit add a global crop test, get working on mirage + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/CLM_runcmnd.sh --- Allow hostname==vpn* for yong + M models/lnd/clm/test/system/test_driver.sh ---- Add TOOLSLIBS TOOLS_CONF_STRING + if hostname=vpn* use setup for yong + M models/lnd/clm/test/system/input_tests_master Fix test blCK8, add global + crop test case for mksurfdata, add cfg-tool tests + M models/lnd/clm/test/system/TSM.sh ------------ Add cpl.log file + M models/lnd/clm/test/system/TCBtools.sh ------- Set SLIBS needed on generic machines + + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh ------- Use different version of ESMF + for regional, don't do RTM maps for regional + M models/lnd/clm/tools/interpinic/src/Makefile ------ Use NETCDF4 link + M models/lnd/clm/tools/mkmapgrids/src/Makefile ------ Use NETCDF4 link + M models/lnd/clm/tools/mksurfdata_map/src/Makefile -- Use NETCDF4 link + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl - Send crop setting for + determining LAI file + +>>>>>>>>>>>> Add CESM options to build-namelist, add handling of SLIBS for generic +>>>>>>>>>>>> machines. Add new grids: wrf, ne4, ne16, ne60. Set nsegspv=1 for hi-res/ne +>>>>>>>>>>>> grids. Use drv/datm namelist definition/defaults files. Extend +>>>>>>>>>>>> build-namelist unit tester test ALL resolutions/use-cases. + M models/lnd/clm/bld/configure ---- Add ability to handle slibs + M models/lnd/clm/bld/user_nl_clm -- Format change + M models/lnd/clm/bld/config_files/config_definition.xml - slibs, wrf grids + M models/lnd/clm/bld/build-namelist ---------- Add a bunch of options needed for CESM + (all but -chk_res and -note are already exercised when running CESM) + -chk_res ------- Check resolution and land mask first. + -clm_startfile - Input file to use to startup for branch or startup cases. + -co2_type ------ CO2 type + -inst_string --- Instance string to use for clm_startfile for multi-instance cases. + -l_ncpl -------- Number of coupling time-steps to take per day. + -lnd_frac ------ Land fraction file to use (domain file) + -note ---------- Write out note about build-namelist usage to end of file. + namelist definition/defaults files also come from drv/bld and datm/bld, get working + with latest externals + M models/lnd/clm/bld/clm.cpl7.template ------- Use new + clm.buildnml.csh/clm.buildexe.csh scripts which save us from the "\" nightmare + M models/lnd/clm/bld/queryDefaultNamelist.pl - namelist_defaults/definition files + are now split out in datm/drv directories + M models/lnd/clm/bld/queryDefaultXML.pm ------ definition files are an array now + M models/lnd/clm/bld/unit_testers/build-namelist_test.pl - Test a ton more + things. Add -compare, -test, -generate options. Test all use_cases and all + resolutions + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl ------ Add some more resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Get rid of drv/datm + namelist items + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl - Get rid of drv/datm + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add chk_res, note + and default masks for WRF grids + M models/lnd/clm/bld/namelist_files/datm-build-namelist ----- Use datm namelist + defaults/definition files. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Set do_rtm for + regional grids to .false. Add wrf grids: us20, wus12. Add ne4, ne16, ne60 + files. Add 20th transient PFT for: ne16, ne30, ne60, ne120. Set nsegspc to 1 + for hi-res and ne grids. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Domain files + for 512x1024, ne4, ne16, ne60, ne240, and us20, wus12. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Set crop + for LAI and vegtyp files + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Remove settings + already in drv/bld file + +>>>>>>>>>>>> Remove write(6 for write to iulog, remove unneeded writes +>>>>>>>>>>>> use shr_pio over seq_pio. Allow -180-180 form. + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - remove write + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - write to iulog + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------ use endrun not write(6 + M models/lnd/clm/src/main/ndepStreamMod.F90 -------- use shr_pio_getiotype + M models/lnd/clm/src/main/pftdynMod.F90 ------------ use endrun not write(6 + M models/lnd/clm/src/main/histFileMod.F90 ---------- use shr_pio_getiotype + dimension hist_excl* as max_namlen+2 + M models/lnd/clm/src/main/ncdio_pio.F90 ------------ use + shr_pio_getiotype/shr_pio_getiosys + M models/lnd/clm/src/main/surfrdMod.F90 ------------ remove write(6 statements + put write in "if ( masterproc )", if longitudes off by more than 300 + see if -180-180 form works + +Summary of testing: + + build-namelist unit testing: All PASS except... + us20 + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +049 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +058 bl514 TBLCFGtools.sh gen_domain CFGtools__ds T31.runoptions .................................FAIL! rc= 4 +060 bl754 TBLtools.sh mksurfdata_map tools__s namelist ..........................................FAIL! rc= 5 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +071 bl924 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds .....FAIL! rc= 5 +073 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 7 +075 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 5 +078 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +079 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +080 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +081 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +082 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +083 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except.. +FAIL ERI.T31_g37.IG1850.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_RLA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_RLB.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS_ROA.f45_f45.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f45_g37.I.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS.1x1_numaIA.ICN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_E.T31_g37.I1850.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL SMS.f10_f10.IRCP45CN.bluefire_ibm.tputcomp.clm4_0_43 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire_ibm.tputcomp.clm4_0_43 +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL ERI.T31_g37.IG1850.bluefire_ibm.generate.clm4_0_44 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_43 + lynx/pgi testing: All PASS + lynx/pgi interactive testing: All PASS except... +024 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +025 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +026 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + mirage,storm/ifort interactive testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_43 + +Changes answers relative to baseline: No, bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_43 +Originator(s): sacks (Bill Sacks); erik (Erik Kluzek) +Date: Fri Apr 6 11:36:21 MDT 2012 +One-line Summary: Add diagnostic fields, modify some existing history fields + +Purpose of changes: + +Add new diagnostic fields to track snow and ice fluxes. Modify some soil-related fields to +only be averaged over vegetated landunits (from Dave Lawrence). Fix some diagnostic fields +that were incorrect, especially over lakes and urban areas. Change QICE to spval rather +than 0 over non-ice_mec landunits. Rename QMELT to QSNOMELT. Delete redundant QICEYR. Add +snow balance check from Keith Oleson. Add flexible handling of l2g_scale_type in +subgridAveMod, replacing 'urbanh' c2l_scale_type and adding new functionality. Modify +create_clm_s2x to only reference qflx_glcice in the run loop, not in initialization, +because it is now NaN in initialization. Update scripts and esmf_wrf_timemgr. Changes in +clm.cpl7.template from Tony. Add in unit_testers for build-namelist. Update to nsegspc +branch. New qtr-degree RTM file, updates to mkmapdata.sh so requires -r if -f set, +build-namelist changes to ensure rtm and glc options consistent, and updates of +documentation to the latest cesm1_0_4 release tag. Sets nsegspc in the namelist and for +ne30_g16 sets it to 5. Enhancements to baseline tests. + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage. +Fix perf bug 1485, Fix ne30 issue 1488, Fix history dimension issue 1489 + +Test level of tag: std-test + +Bugs fixed (include bugzilla ID): + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (partial -- now works with nsegspc=5) + 1489 (history dimension issue) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + 1488 (Problem reading restarts@ne30_g16 for some layouts) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + + Modified clm.cpl7.template to no longer copy lnd_in to the case directory + +Describe any changes made to the namelist: + + For glacierMEC, use QICE rather than QICEYR for annual history files + Set nsegspc to 5 for ne30np4 and the default of 20 otherwise + +List any changes to the defaults for the boundary datasets: + + Fix qtr-degree RTM mapping file name + +Describe any substantial timing or memory changes: + + Fixes bug 1485 (performance issue with esmf_wrf_timemgr) + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + esmf_wrf_timemgr, cprnc + + scripts to scripts4_120329d + Machines to Machines_120406 + esmf_wrf_timemgr to esmf_wrf_timemgr_120327 + cprnc to cprnc_120405 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>> Enhancements to baseline tests, and post-processor for test results +A models/lnd/clm/test/system/get_cprnc_diffs.sh - Script used by TBL.sh and + TBLrst_tools.sh +A models/lnd/clm/test/system/show_var_diffs.sh -- Post-processor for baseline test + results + +>>>>>>> Add build-namelist unit_tester +A models/lnd/clm/bld/unit_testers +A models/lnd/clm/bld/unit_testers/build-namelist_test.pl + +List all existing files that have been modified, and describe the changes: + +>>>>>>> Use CSMDATA rather than HOME +M models/lnd/clm/test/system/nl_files/getregional + +>>>>>>> Require -res to be set if -f option used +M models/lnd/clm/tools/mkmapdata/mkmapdata.sh + +>>>>>>> Fix qtr-degree RTM map, set nsegspc, work on usability +M models/lnd/clm/bld/user_nl_clm ---- Add notes about setting some things + with build-namelist options +M models/lnd/clm/bld/build-namelist - Set nsegspc, make sure glc_grid, glc_smb + do_rtm, and maxpatch_glcmec aren't set inconsistently between user_nl_clm + and build-namelist options +M models/lnd/clm/bld/README --------- Add notes about new unit_testers +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- qtr-degree RTM + mapping file, and set nsegspc + +>>>>>>> Bring in documentation updates from cesm1_0_4_n05_clm4_0_32, notes on setting +>>>>>>> finidat, adding history fields list +M models/lnd/clm/doc/UsersGuide/special_cases.xml +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>> Remove duplicate line +M models/lnd/clm/test/system/tests_pretag_bluefire + +>>>>>>> Use get_cprnc_diffs.sh; truly print diffs from last file with a failed comparison +>>>>>>> rather than just printing diffs if last comparison failed +M models/lnd/clm/test/system/TBL.sh +M models/lnd/clm/test/system/TBLrst_tools.sh + +>>>>>>> Use QICE rather than QICEYR for annual history files +M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml + +>>>>>>> no longer copy lnd_in to the case directory +M models/lnd/clm/bld/clm.cpl7.template + +>>>>>>> Add new variables for tracking snow and ice fluxes +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Also changed init of btran + and fpsn to spval +M models/lnd/clm/src/main/histFldsMod.F90 -------------- Add some fields, add + c2l_scale_type or l2g_scale_type for others; rename QMELT to QSNOMELT; delete + QICEYR +M models/lnd/clm/src/main/histFileMod.F90 -------------- Time-constant fields just + averaged over certain land units; add handling of set_noglcmec for pft-level + variables. Also, use lon & lat rather than lonatm & latatm +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------ Compute qflx_glcice_frz +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - Compute qflx_glcice_melt + and qflx_snofrz_col +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 --- To get proper grid cell + averages, turn some locals into globals, and add calculation of additional + fields + +>>>>>>> Change QICE to spval rather than 0 over non-ice_mec landunits +M models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 + +>>>>>>> Add snow balance check, fix water balance check for glc_dyntopo +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - Add calculation of + qflx_sl_top_soil, needed for snow balance check +M models/lnd/clm/src/main/pft2colMod.F90 ------------- Column-level averages of some + variables needed for snow balance check; also fixed average of qflx_evap_tot + for lakes + +>>>>>>> Only reference qflx_glcice in the run loop, not in initialization +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 - pass init argument +M models/lnd/clm/src/main/clm_glclnd.F90 ------ in init, qice remains 0 + +>>>>>>> Flexible handling of l2g_scale_type +M models/lnd/clm/src/main/clm_varcon.F90 ---- max_lunit parameter +M models/lnd/clm/src/main/subgridAveMod.F90 - new subroutines for concise handling + of l2g_scale_type; add checks for l2g_scale_type==spval; remove urbanh + c2l_scale_type + + + +Summary of testing: + + bluefire: All PASS except: +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 7 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 7 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 7 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +043 blCn1 TBL.sh _sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arb_ic FAIL! rc= 7 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 +047 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 2 +051 blH#2 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 ne30np4 gx1v6@2000 48 startup .........FAIL! rc= 7 +053 smCI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +054 erCI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +055 brCI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +056 blCI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except: +008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 7 +012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 7 +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +038 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 7 +046 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 7 +054 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +069 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 7 +075 bl9S4 TBLscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 5 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except: +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_42 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_42 + bluefire/PTCLM testing: Not done + lynx/pgi testing: All PASS except: +004 blC92 TBL.sh _sc_dm clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +007 blD92 TBL.sh _persc_dm clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blF92 TBL.sh 17p_sc_dm clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +015 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +019 blL52 TBL.sh _sc_dm clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 + lynx/pgi interactive testing: All PASS except: +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +024 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +025 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + lynx/CESM testing: All PASS except: +FAIL ERS_D.T31_g37.I1850.lynx_pgi.compare_hist.clm4_0_42 +FAIL ERS_D.T31_g37.I1850.lynx_pgi.compare_hist.clm4_0_42 +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.C.124327 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_42 + mirage,storm/ifort interactive testing: All PASS except: +007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 +023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 7 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_42 + +Changes answers relative to baseline: Just changes some diagnostic fields + + Changes the following default history fields: TSOI, HCSOI, ZWT, WA, WT, H2OSOI, + SOILLIQ, SOILICE, SOILWATER_10CM, QICE, QSNWCPICE_NODYNLNDUSE, QSNWCPLIQ + + Renames QMELT to QSNOMELT + + Also changes some fields not output by default + + Also changes cpl avghist files due to changes in qflx_glcice in initialization, but + this doesn't affect the simulation + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change: diagnostic fields only + +=============================================================== +=============================================================== +Tag name: clm4_0_42 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 27 21:14:59 MDT 2012 +One-line Summary: Bring in Francis Vitt's MEGAN changes. + +Purpose of changes: + +Bring Francis Vitt's MEGAN branch to the trunk. Replace the five VOC +compounds with the MEGAN model that allows up to 150 compounds to be +generated and passed to the driver. The mechanism allows the fields to +be choosen by a driver namelist which CLM responds to. + +Requirements for tag: test on bluefire (CESM, int, bat), lynx/pgi (int,bat), mirage + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1459 (PTSMODE fails) + 1480 (Darwin_intel build) + 1482 (Problems running 1x1 resolutions for CLM) + 1484 (re-configure removes the user_nl_clm) + 1486 (bad irrigation maps) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (PTS_MODE can NOT use a global finidat file) + 1017 (PTS_MODE can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1485 (Performance issue with esmf_wrf_timemgr) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + + Add new -megan option to CLM build-namelist to add a megan namelist to + the drv_flds_in file. + Rename -drv_drydep option to -drydep. + + New namelist items for MEGAN: megan_factors_file, megan_specifier, and + megan_mapped_emisfctrs go into the megan_emis_nl namelist in drv_flds_in + + History fields removed: BIOGENCO, ISOPRENE (replaced by MEG_isoprene), + MONOTERP, ORVOC, ORVOC, OVOC + + Units of VOCFLXT changed from uGC/M2/H to moles/m2/sec + + New history fields: + ++ GAMMAC = gamma C for VOC calc (0-1) ++ MEG_2met_2s = MEGAN flux (kg/m2/sec) ++ MEG_2met_nonatriene = MEGAN flux (kg/m2/sec) ++ MEG_2met_s = MEGAN flux (kg/m2/sec) ++ MEG_2met_styrene = MEGAN flux (kg/m2/sec) ++ MEG_3met_3DCTT = MEGAN flux (kg/m2/sec) ++ MEG_Ehsalate = MEGAN flux (kg/m2/sec) ++ MEG_MBO_2m3e2ol = MEGAN flux (kg/m2/sec) ++ MEG_MBO_3m2e1ol = MEGAN flux (kg/m2/sec) ++ MEG_MBO_3m3e1ol = MEGAN flux (kg/m2/sec) ++ MEG_Napthalene = MEGAN flux (kg/m2/sec) ++ MEG_PPPP_2s = MEGAN flux (kg/m2/sec) ++ MEG_acetaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_acetic_acid = MEGAN flux (kg/m2/sec) ++ MEG_acetone = MEGAN flux (kg/m2/sec) ++ MEG_acoradiene = MEGAN flux (kg/m2/sec) ++ MEG_ammonia = MEGAN flux (kg/m2/sec) ++ MEG_anisole = MEGAN flux (kg/m2/sec) ++ MEG_aromadendrene = MEGAN flux (kg/m2/sec) ++ MEG_benzaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_benzyl-acetate = MEGAN flux (kg/m2/sec) ++ MEG_benzyl-alcohol = MEGAN flux (kg/m2/sec) ++ MEG_bergamotene_a = MEGAN flux (kg/m2/sec) ++ MEG_bergamotene_b = MEGAN flux (kg/m2/sec) ++ MEG_bisabolene_a = MEGAN flux (kg/m2/sec) ++ MEG_bisabolene_b = MEGAN flux (kg/m2/sec) ++ MEG_bornene = MEGAN flux (kg/m2/sec) ++ MEG_borneol = MEGAN flux (kg/m2/sec) ++ MEG_bornyl_ACT = MEGAN flux (kg/m2/sec) ++ MEG_bourbonene_b = MEGAN flux (kg/m2/sec) ++ MEG_butanone_2 = MEGAN flux (kg/m2/sec) ++ MEG_butene = MEGAN flux (kg/m2/sec) ++ MEG_cadinene_d = MEGAN flux (kg/m2/sec) ++ MEG_cadinene_g = MEGAN flux (kg/m2/sec) ++ MEG_camphene = MEGAN flux (kg/m2/sec) ++ MEG_camphor = MEGAN flux (kg/m2/sec) ++ MEG_carbon_2s = MEGAN flux (kg/m2/sec) ++ MEG_carbon_monoxide = MEGAN flux (kg/m2/sec) ++ MEG_carbonyl_s = MEGAN flux (kg/m2/sec) ++ MEG_carene_3 = MEGAN flux (kg/m2/sec) ++ MEG_caryophyllene_b = MEGAN flux (kg/m2/sec) ++ MEG_cedrene_a = MEGAN flux (kg/m2/sec) ++ MEG_cedrol = MEGAN flux (kg/m2/sec) ++ MEG_cineole_1_8 = MEGAN flux (kg/m2/sec) ++ MEG_copaene_a = MEGAN flux (kg/m2/sec) ++ MEG_cubebene_a = MEGAN flux (kg/m2/sec) ++ MEG_cubebene_b = MEGAN flux (kg/m2/sec) ++ MEG_cymene_o = MEGAN flux (kg/m2/sec) ++ MEG_cymene_p = MEGAN flux (kg/m2/sec) ++ MEG_decanal = MEGAN flux (kg/m2/sec) ++ MEG_diallyl_2s = MEGAN flux (kg/m2/sec) ++ MEG_dodecene_1 = MEGAN flux (kg/m2/sec) ++ MEG_elemene_b = MEGAN flux (kg/m2/sec) ++ MEG_estragole = MEGAN flux (kg/m2/sec) ++ MEG_ethane = MEGAN flux (kg/m2/sec) ++ MEG_ethanol = MEGAN flux (kg/m2/sec) ++ MEG_ethene = MEGAN flux (kg/m2/sec) ++ MEG_farnescene_a = MEGAN flux (kg/m2/sec) ++ MEG_farnescene_b = MEGAN flux (kg/m2/sec) ++ MEG_fenchene_a = MEGAN flux (kg/m2/sec) ++ MEG_fenchone = MEGAN flux (kg/m2/sec) ++ MEG_formaldehyde = MEGAN flux (kg/m2/sec) ++ MEG_formic_acid = MEGAN flux (kg/m2/sec) ++ MEG_geranyl_acetone = MEGAN flux (kg/m2/sec) ++ MEG_germacrene_B = MEGAN flux (kg/m2/sec) ++ MEG_germacrene_D = MEGAN flux (kg/m2/sec) ++ MEG_gurjunene_b = MEGAN flux (kg/m2/sec) ++ MEG_heptanal = MEGAN flux (kg/m2/sec) ++ MEG_heptane = MEGAN flux (kg/m2/sec) ++ MEG_heptanone = MEGAN flux (kg/m2/sec) ++ MEG_hexanal = MEGAN flux (kg/m2/sec) ++ MEG_hexane = MEGAN flux (kg/m2/sec) ++ MEG_hexanol_1 = MEGAN flux (kg/m2/sec) ++ MEG_hexenal_c3 = MEGAN flux (kg/m2/sec) ++ MEG_hexenal_t2 = MEGAN flux (kg/m2/sec) ++ MEG_hexenol_c3 = MEGAN flux (kg/m2/sec) ++ MEG_hexenyl_ACT_c3 = MEGAN flux (kg/m2/sec) ++ MEG_homosalate = MEGAN flux (kg/m2/sec) ++ MEG_humulene_a = MEGAN flux (kg/m2/sec) ++ MEG_humulene_g = MEGAN flux (kg/m2/sec) ++ MEG_hydrogen_cyanide = MEGAN flux (kg/m2/sec) ++ MEG_hydrogen_s = MEGAN flux (kg/m2/sec) ++ MEG_indole = MEGAN flux (kg/m2/sec) ++ MEG_ionone_b = MEGAN flux (kg/m2/sec) ++ MEG_ipsenol = MEGAN flux (kg/m2/sec) ++ MEG_isolongifolene = MEGAN flux (kg/m2/sec) ++ MEG_isoprene = MEGAN flux (kg/m2/sec) ++ MEG_jasmone = MEGAN flux (kg/m2/sec) ++ MEG_limonene = MEGAN flux (kg/m2/sec) ++ MEG_linalool = MEGAN flux (kg/m2/sec) ++ MEG_linalool_OXD_c = MEGAN flux (kg/m2/sec) ++ MEG_linalool_OXD_t = MEGAN flux (kg/m2/sec) ++ MEG_longifolene = MEGAN flux (kg/m2/sec) ++ MEG_longipinene = MEGAN flux (kg/m2/sec) ++ MEG_met_benzoate = MEGAN flux (kg/m2/sec) ++ MEG_met_bromide = MEGAN flux (kg/m2/sec) ++ MEG_met_chloride = MEGAN flux (kg/m2/sec) ++ MEG_met_heptenone = MEGAN flux (kg/m2/sec) ++ MEG_met_iodide = MEGAN flux (kg/m2/sec) ++ MEG_met_jasmonate = MEGAN flux (kg/m2/sec) ++ MEG_met_mercaptan = MEGAN flux (kg/m2/sec) ++ MEG_met_propenyl_2s = MEGAN flux (kg/m2/sec) ++ MEG_met_salicylate = MEGAN flux (kg/m2/sec) ++ MEG_meta-cymenene = MEGAN flux (kg/m2/sec) ++ MEG_methane = MEGAN flux (kg/m2/sec) ++ MEG_methanol = MEGAN flux (kg/m2/sec) ++ MEG_muurolene_a = MEGAN flux (kg/m2/sec) ++ MEG_muurolene_g = MEGAN flux (kg/m2/sec) ++ MEG_myrcene = MEGAN flux (kg/m2/sec) ++ MEG_myrtenal = MEGAN flux (kg/m2/sec) ++ MEG_nerolidol_c = MEGAN flux (kg/m2/sec) ++ MEG_nerolidol_t = MEGAN flux (kg/m2/sec) ++ MEG_neryl_acetone = MEGAN flux (kg/m2/sec) ++ MEG_nitric_OXD = MEGAN flux (kg/m2/sec) ++ MEG_nitrous_OXD = MEGAN flux (kg/m2/sec) ++ MEG_nonanal = MEGAN flux (kg/m2/sec) ++ MEG_nonenal = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_al = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_c_b = MEGAN flux (kg/m2/sec) ++ MEG_ocimene_t_b = MEGAN flux (kg/m2/sec) ++ MEG_octanal = MEGAN flux (kg/m2/sec) ++ MEG_octanol = MEGAN flux (kg/m2/sec) ++ MEG_octenol_1e3ol = MEGAN flux (kg/m2/sec) ++ MEG_oxopentanal = MEGAN flux (kg/m2/sec) ++ MEG_pentanal = MEGAN flux (kg/m2/sec) ++ MEG_pentane = MEGAN flux (kg/m2/sec) ++ MEG_phellandrene_a = MEGAN flux (kg/m2/sec) ++ MEG_phellandrene_b = MEGAN flux (kg/m2/sec) ++ MEG_phenyl_CCO = MEGAN flux (kg/m2/sec) ++ MEG_pinene_a = MEGAN flux (kg/m2/sec) ++ MEG_pinene_b = MEGAN flux (kg/m2/sec) ++ MEG_piperitone = MEGAN flux (kg/m2/sec) ++ MEG_propane = MEGAN flux (kg/m2/sec) ++ MEG_propene = MEGAN flux (kg/m2/sec) ++ MEG_pyruvic_acid = MEGAN flux (kg/m2/sec) ++ MEG_sabinene = MEGAN flux (kg/m2/sec) ++ MEG_selinene_b = MEGAN flux (kg/m2/sec) ++ MEG_selinene_d = MEGAN flux (kg/m2/sec) ++ MEG_terpinene_a = MEGAN flux (kg/m2/sec) ++ MEG_terpinene_g = MEGAN flux (kg/m2/sec) ++ MEG_terpineol_4 = MEGAN flux (kg/m2/sec) ++ MEG_terpineol_a = MEGAN flux (kg/m2/sec) ++ MEG_terpinolene = MEGAN flux (kg/m2/sec) ++ MEG_terpinyl_ACT_a = MEGAN flux (kg/m2/sec) ++ MEG_tetradecene_1 = MEGAN flux (kg/m2/sec) ++ MEG_thujene_a = MEGAN flux (kg/m2/sec) ++ MEG_thujone_a = MEGAN flux (kg/m2/sec) ++ MEG_thujone_b = MEGAN flux (kg/m2/sec) ++ MEG_toluene = MEGAN flux (kg/m2/sec) ++ MEG_tricyclene = MEGAN flux (kg/m2/sec) ++ MEG_verbenene = MEGAN flux (kg/m2/sec) + +List any changes to the defaults for the boundary datasets: + Correct fpftdyn historical f05 dataset, and add rcp datasets + Fix irrig map for f19 and f10 + +Describe any substantial timing or memory changes: None + Although bug 1485 is NOT fixed! (4X performance hit due to updated esmf_wrf_timemgr!) + +Code reviewed by: self,fvitt + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + drv, pio, cprnc, and cism + + scripts to scripts4_120323 + Machines to Machines_120323a + drv to drvseq4_1_04 + pio to pio_1_4_2 + cprnc to cprnc_120322 + cism to cism1_120322 + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/bld/namelist_files/history_fields.xsl - Style sheet to view history_fields XML file +A + models/lnd/clm/src/biogeochem/MEGANFactorsMod.F90 ---- MEGAN factors file + +List all existing files that have been modified, and describe the changes: + +>>>>>>>> Remove PTS-MODE restart tests +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi +M models/lnd/clm/test/system/tests_posttag_yong +MM models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/test_driver.sh ----- Correct machine name for lynx +M models/lnd/clm/test/system/nl_files/nl_voc ---- Add megan namelist +M models/lnd/clm/test/system/nl_files/clm_drydep Add -megan option rename drydep +to drydep +M models/lnd/clm/test/system/input_tests_master - Tests with VOC must use + clm_drydep, make CA8 tests use drydep + +M models/lnd/clm/tools/SVN_EXTERNAL_DIRECTORIES - update cprnc + +M models/lnd/clm/bld/configure --------- Change top level model from cesm to driver +M models/lnd/clm/bld/build-namelist ---- Add -megan option/namelist, rename + -drv_drydep to drydep, add checking for megan namelist items +M models/lnd/clm/bld/clm.cpl7.template - Fix multi-instance issues, and + don't overwrite user_nl_clm file if it already exists + +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ----- Update driver + namelist items, add megan namelist, more fields to drydep_list, list + megan compounds +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Add commented + out finidat file for f05, update f05 fpftdyn and add fpftdyn for f05 rcp's + update irrig 10x15 mapping file +M models/lnd/clm/bld/namelist_files/namelist_defaults_drydep.xml - Add defaults + for megan namelist + +M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Change VOC fields to megan + fields +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ------ Change VOC fields to megan + fields +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ---- Change VOC fiels to megan +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 - Use Megan_factors_mod, + add VOCEmission_init, megan namelist determines the fields that will be + output rather than the 5 VOC fields +MM models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - More fields that can be + "mapped": 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' +M models/lnd/clm/src/main/clm_varpar.F90 ----------- Remove nvoc +M models/lnd/clm/src/main/clm_initializeMod.F90 ---- Add call to VOCEmission_init +M models/lnd/clm/src/main/clmtypeInitMod.F90 ------- Remove averaged voc fields +M models/lnd/clm/src/main/clm_atmlnd.F90 ----------- Remove voc add megan fields +M models/lnd/clm/src/main/findHistFields.pl -------- Add ability to handle new + megan fields +M models/lnd/clm/src/main/clm_driver.F90 ----------- Initialize cisun/cisha + to -999. each time-step for VOCEmission +M models/lnd/clm/src/main/ncdio_pio.F90 ------------ Changes from John Truesdale + so that PTS_MODE will work +M models/lnd/clm/src/main/clmtype.F90 -------------- VOC fields have extra + dimension remove averaged field +M models/lnd/clm/src/main/histFldsMod.F90 ---------- Remove specific VOC fields + add MEG_ fields + +Summary of testing: + + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 7 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 +047 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 2 + bluefire interactive testing: All PASS except +028 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +034 blF93 TBL.sh 17p_sc_do clm_drydep^nl_voc 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +050 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 7 +061 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +062 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +073 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +076 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +077 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +078 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +079 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +080 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +081 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except.. +BFAIL PST.f45_g37.I1850CN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PET_PT.f45_g37.I1850.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL SMS.1x1_numaIA.ICN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL ERP.1x1_mexicocityMEX.I.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PST.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_41 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire_ibm.compare_hist.clm4_0_41 + bluefire/PTCLM testing: All FAIL + lynx interactive testing: ALL PASS up to... +023 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 + lynx/CESM testing: All PASS except.. +FAIL ERS_D.T31_g37.I1850.lynx_pgi.generate.clm4_0_42 +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.GC.121827 +BFAIL PST.f19_g16.I.lynx_pgi.compare_hist.clm4_0_41 +BFAIL ERS.1x1_vancouverCAN.I.lynx_pgi.compare_hist.clm4_0_41 + mirage,storm/ifort interactive testing: All PASS! + yong/darwin/ifort interactive testing: All PASS up to... +005 smCL4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_41 + +Changes answers relative to baseline: bit-for-bit (except cases with MEGAN or VOC) + +=============================================================== +=============================================================== +Tag name: clm4_0_41 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 13 23:43:45 MDT 2012 +One-line Summary: Bring rmfmesh/rtmmap branches to trunk + +Purpose of changes: + +Get working with latest scripts and have clm template call build-namelist directly. Move +rmfmesh/rtmmap branch to trunk. Remove CASA completely. Start using RTM mapping files. +Allow bigger tolerance for mksurfdata_map frac up to 1.e-5 so can work for f4x5. New +half-degree mapping files. Remove code to calculate RTM mapping. Remove ability to set +maxpatch_pft to something different than numpft in CLM configure. Remove +-ad_spinup/-exit_spinup options in configure make generic -spinup option with a few +allowed values (similar to the clm45sci version of configure). New 1850 fsurdat dataset +for ne240np4. Update externals to the latest, get test_driver working. + +Requirements for tag: test on bluefire (CESM,int,bat), lynx/pgi (CESM), mirage, +template calls build-namelist. Fix 1477, 1476, 1468, 1467 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1477 (Bad f05 datasets) + 1476 (Problem with stand-alone build on bluefire) + 1468 (Bad f09, f19 SCRIP Grid files) + 1467 (Remove runinit_ibm.csh script) + 1449 (Remove fine-mesh) + 1448 (Remove CASA) + 1432 (Several resolutions fail for new mksurfdata_map) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1474 (Missing eulerian domain files) + 1479 (fails on jaguarpf) + 1480 (Darwin_intel build) + 1482 (Problems running 1x1 resolutions for CLM) + 1485 (Performance issue with esmf_wrf_timemgr) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Remove CASA option, don't allow maxpft to be set. + CESM scripts/Machines updated. + +Describe any changes made to the namelist: + + BuildConf/clm.buildnml.csh now becomes a script that simply calls the clm + build-namelist script to build your namelist. This means you effectively treat it + as a READ-only script that you don't put changes into! Instead you use + the "user_nl_clm" file to put your custom changes to the namelist into. + The use of user_nl_clm is documented in the CLM User's Guide at... + + http://www.cesm.ucar.edu/models/cesm1.0/clm/models/lnd/clm/doc/UsersGuide/x1423.html#config_time_nml + + Use preview_namelists to see full namelists that will be created. + +List any changes to the defaults for the boundary datasets: Activate RTM mapping files + New 1840 ne240 fsurdat file, replace all f05 mapping files, replace all f05 mapping + files, and f05, f09, and f19 SCRIP grid files + +Describe any substantial timing or memory changes: Yes! + Much less global memory needed now! Only one temporary global integer array + used. + + 4X performance hit due to updated esmf_wrf_timemgr! (see bug 1485) + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, Machines, + drv, csm_share, esmf_wrf_timemgr, datm + + scripts to datm8_120219 + Machines to Machines_120309 + drv to drvseq4_1_02 + csm_share to share3_120308 + esmf_wrf_timemgr to esmf_wrf_timemgr_120218 + datm to datm8_120219 + +List all files eliminated: + +>>>>>>> Eliminate stand-alone intrepid/kraken testing files, CASA, fine-mesh, +>>>>>>> and RTM mapping calc. Elimanate interpinic run script, too hard to support. +D models/lnd/clm/test/system/tests_posttag_intrepid +D models/lnd/clm/test/system/tests_posttag_intrepid_nompi +D models/lnd/clm/test/system/tests_posttag_kraken +D models/lnd/clm/tools/interpinic/runinit_ibm.csh +D models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 +D models/lnd/clm/src/biogeochem/CASAMod.F90 +D models/lnd/clm/src/main/CASAiniTimeVarMod.F90 +D models/lnd/clm/src/main/downscaleMod.F90 +D models/lnd/clm/src/riverroute/RtmMapMod.F90 + +List all files added and what they do: Add config defaults files for supported + single point datasets, add empty user_nl_clm file + +A + models/lnd/clm/bld/user_nl_clm +A + models/lnd/clm/bld/config_files/config_defaults_1x1_smallvilleIA.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_mexicocityMEX.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_numaIA.xml +A + models/lnd/clm/bld/config_files/config_defaults_1x1_vancouverCAN.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Changes to config_file for changes to configure +>>>>>>>>>>>>> eliminate use of maxpft, ad_spinup and exit_spinup use spinup option +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh +M models/lnd/clm/test/system/config_files/17p_cndvsc_m +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m +M models/lnd/clm/test/system/config_files/17p_cndvsc_o +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm +M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s +M models/lnd/clm/test/system/config_files/17p_cndvsc_s +M models/lnd/clm/test/system/config_files/17p_sc_dh +M models/lnd/clm/test/system/config_files/17p_sc_dm +M models/lnd/clm/test/system/config_files/17p_sc_do +M models/lnd/clm/test/system/config_files/17p_sc_ds +M models/lnd/clm/test/system/config_files/17p_cnsc_h +M models/lnd/clm/test/system/config_files/21p_cncrpsc_h +M models/lnd/clm/test/system/config_files/17p_cnsc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_m +M models/lnd/clm/test/system/config_files/17p_cnsc_m +M models/lnd/clm/test/system/config_files/17p_cnsc_o +M models/lnd/clm/test/system/config_files/21p_cncrpsc_o +M models/lnd/clm/test/system/config_files/17p_cnsc_dm +M models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +M models/lnd/clm/test/system/config_files/17p_cnsc_do +M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +M models/lnd/clm/test/system/config_files/21p_cncrpsc_do +M models/lnd/clm/test/system/config_files/21p_cncrpsc_s +M models/lnd/clm/test/system/config_files/17p_sc_h +M models/lnd/clm/test/system/config_files/21p_cncrpsc_ds +M models/lnd/clm/test/system/config_files/17p_cnsc_ds +M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +M models/lnd/clm/test/system/config_files/17p_cnc13sc_do +M models/lnd/clm/test/system/config_files/17p_sc_m +M models/lnd/clm/test/system/config_files/17p_sc_o +M models/lnd/clm/test/system/config_files/17p_cnnfsc_dh +M models/lnd/clm/test/system/config_files/17p_cnnfsc_dm +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh +M models/lnd/clm/test/system/config_files/17p_cndvsc_dh +M models/lnd/clm/test/system/config_files/17p_cnnfsc_do +M models/lnd/clm/test/system/config_files/17p_cndvsc_dm +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm +M models/lnd/clm/test/system/config_files/17p_cndvsc_do +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h +M models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>> Get working with latest scripts, eliminate intrepid. +M models/lnd/clm/test/system/TCB.sh --------- Send -comp to configure +M models/lnd/clm/test/system/test_driver.sh - Eliminate intrepid, get working + with latest CESM scripts/Machines, update env settings to Machines +M models/lnd/clm/test/system/CLM_runcmnd.sh - Eliminate intrepid +M models/lnd/clm/test/system/tests_pretag_bluefire - Correct test name + +>>>>>>>>>>>>> Eliminate CASA +M models/lnd/clm/tools/interpinic/src/interpinic.F90 +M models/lnd/clm/tools/mksurfdata_map/src/clm_varctl.F90 + +>>>>>>>>>>>>> Eliminate CASA, and maxpft. Read site specific config_defaults +>>>>>>>>>>>>> Change spinup option, get working with latest scripts. +M models/lnd/clm/bld/configure --------- Use clm45sci API (use -spinup in + place of ad_spinup/exit_spinup), read site specific config_defaults + file when sitespf_pt option is used. Eliminate CASA, and maxpft option. + Get configure working with latest CESM scripts. Add mct/pio subdirectory + for SMP=on/off so will build on bluefire. Add -comp option required + for new CESM scripts (for stand-alone test). +M models/lnd/clm/bld/build-namelist ---- Remove faerdep, use spinup from + configure rather than ad/exit_spinup, remove substition of CSMDATA + in filenames. +M models/lnd/clm/bld/clm.cpl7.template - Use sitespf_pt for regional case + when CLM_USRDAT NOT used and don't use clm_root in configure. +M models/lnd/clm/bld/config_files/config_sys_defaults.xml - Add comp settings + and change mach settings to NOT include compiler. Remove: dec_osf, + es, irix, solaris, super-ux, unicosmp as no longer tested on +M models/lnd/clm/bld/config_files/config_definition.xml --- Remove CASA option + mxpft can only be 17 or 21. Add comp, remove ad_spinup/exit_spinup + for spinup option. Change description of sitespf_pt option. + +>>>>>>>>>>>>> Eliminate CASA, move ad/exit_spinup to spinup, add 1850 ne240 fsurdat +>>>>>>>>>>>>> Activate all RTM maps, replace all f05 maps. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Rm fget_archdev + only allow R05 for rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - ad_spinup + to spinup +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + add 1840 ne240 fsurdat, remove null setting of findat for maxpft=4 + activate RTM maps, replace all 0.47x0.63 mapping files +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Use + standard shared SCRIP-grid files for: f05, f09, f19 resolutions +M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Change + ad/exit_spinup to spinup +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Remove + fatmgrid, flndtopo, fatmtopo, and fatmlndfrc files +M models/lnd/clm/doc/IMPORTANT_NOTES - Remove CASA, fine-mesh, and fget_archdev + +>>>>>>>>>>>>> Eliminate CASA, fine-mesh and atm data, change llatlon for ldomain +>>>>>>>>>>>>> Require RTM map files to be read. Require fatmlndfrc files to be +>>>>>>>>>>>>> in CESM domain file format. Require maxpft=numpft+1. Fix a pnetcdf issue. +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Remove CASA use ldomain + in place of llatlon +M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------ ldomain replaces llatlon +M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- Get rid of fine-mesh + downscaling, use ldomain in place of llatlon remove atm, lnd versions + of everything (adomain, adecomp, get_proc_bounds_atm, begg_a/l, atm_sx for example. +M models/lnd/clm/src/main/organicFileMod.F90 ---- llatlon becomes ldomain +M models/lnd/clm/src/main/decompInitMod.F90 ----- Remove decompInit_atm, acid + remove atm grid stuff for: decompInit_lnd and decompInit_glcp +M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove downscaling and atm/lnd + grid stuff as well as CASA. +M models/lnd/clm/src/main/clm_glclnd.F90 -------- Remove clm_maps2x and clm_mapx2s + and atm_s2x and atm_x2s +M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Remove CASA stuff +M models/lnd/clm/src/main/ndepStreamMod.F90 ----- Replace llatlon with ldomain +M models/lnd/clm/src/main/histFileMod.F90 ------- Remove atm grid stuff such + as gratm, namea grids, remove CASA +M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove downscaling/upscaling + init_adiag_type, clm_downscale_a2l and data: atm_a2l, atm_l2a, adiag_arain +M models/lnd/clm/src/main/restFileMod.F90 ------- Remove CASA +M models/lnd/clm/src/main/controlMod.F90 -------- Remove fatmgrid, CASA, fatmtopo + add write about flndtopo (still needed for glc_nec) +M models/lnd/clm/src/main/initSurfAlbMod.F90 ---- Remove CASA +M models/lnd/clm/src/main/clm_varctl.F90 -------- Remove downscale and CASA +M models/lnd/clm/src/main/clm_driver.F90 -------- Remove CASA +M models/lnd/clm/src/main/initGridCellsMod.F90 -- Remove setting of _a domain + info, gindex_a, longdeg_a, latdeg_a, lon_a, lat_a +M models/lnd/clm/src/main/ncdio_pio.F90 --------- Remove use of gratm, set + data=' ' needed for pnetcdf +M models/lnd/clm/src/main/surfrdMod.F90 --------- Remove surfrd_get_latlon, + surfrd_get_frac, surfrd_wtxy_veg_rank, surfrd_mkrank, add + surfrd_get_globmask in place of surfrd_get_latlon, get rid of + ability to read in CLM frac datasets and only read in CESM domain file + format. Abort if allocate_all_vegpfts is NOT true. +M models/lnd/clm/src/main/domainMod.F90 --------- Remove latlon_type, + nara, and ntop add isgrid2d, adomain, alatlon, llatlon, gatm, amask, pftm + methods: domain_setptrs, latlon_init, latlon_check, latlon_clean, + latlon_setsame +M models/lnd/clm/src/main/decompMod.F90 --------- Remove get_proc_global_atm, + get_proc_bounds_atm, and atmosphere decomposition data +M models/lnd/clm/src/main/clmtype.F90 ----------- Remove CASA, gratm +M models/lnd/clm/src/main/histFldsMod.F90 ------- Remove use of atm_a2l, +- adiag_arain, adiag_asnow, adiag_aflux, adiag_lflux, downscale + remove CASA and downscale if's +M models/lnd/clm/src/main/mkarbinitMod.F90 ------ Remove CASA +M models/lnd/clm/src/riverroute/RtmMod.F90 ------ Remove some global RTM + data. Replace call's to endrun to shr_sys_abort as intial + step of the move to having RTM on it's own component. + Add rtm_celledge. +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ---- llatlon to ldomain +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 - formatting change +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ---- Remove CASA +M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 ------ Remove downscaling + +Summary of testing: + + bluefire: TBL tests fail because of use of RTM mapping files and NetCDF issue and +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 +044 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 2 +045 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 2 +046 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 2 + bluefire interactive testing: All PASS except, TBL tests fail because of NetCDF build issue and +026 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +027 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +031 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 + bluefire/CESM testing: All PASS except + (and ALL compare tests fail couldn't find base result) +FAIL SMS.1x1_numaIA.ICN.bluefire_ibm +FAIL ERP.1x1_mexicocityMEX.I.bluefire_ibm + bluefire/PTCLM testing: All FAIL + lynx/pgi testing: ALL FAIL + lynx/pgi interactive testing: ALL FAIL + lynx CESM testing: ALL PASS except... (don't compare as no baselines for clm4_0_40) +CFAIL ERI.f10_f10.IRCP60CN.lynx_pathscale.162157 +FAIL PST.f19_g16.I.lynx_pgi +RUN ERS.1x1_vancouverCAN.I.lynx_pgi.162157 + mirage,storm/ifort interactive testing: All PASS! + jaguarpf CESM testing: All FAIL +RUN ERS_D.f09_g16.I1850.titan_pgi.182111 +FAIL ERI.f10_f10.IRCP60CN.titan_pgi +FAIL PST.f09_g16.I.titan_pgi +FAIL PET_PT.f10_f10.I20TRCN.titan_pgi +FAIL ERP.f19_g16.I4804CN.titan_pgi +RUN ERS.1x1_mexicocityMEX.I.titan_pgi.182111 +FAIL ERI_D.ne30_g16.I1850CN.titan_pgi +TFAIL ERH.ne120_g16.I2000CN.titan_pgi.182111 +RUN ERS.f09_g16.IRCP26CN.titan_pgi.182111 +FAIL SMS.f10_f10.IRCP45CN.titan_pgi +RUN ERS.f19_g16.IRCP60CN.titan_pgi.182111 +FAIL SMS_D.f10_f10.IRCP85CN.titan_pgi +RUN ERS.f09_g16.IG1850.titan_pgi.182111 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_40 + +Changes answers relative to baseline: Yes (using RTM mapping files now) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: RTM mapping for f05 + - what platforms/compilers: + - nature of change larger than roundoff/same climate + +=============================================================== +=============================================================== +Tag name: clm4_0_40 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 16 14:19:28 MST 2012 +One-line Summary: Back out update to new T31 surface datasets + +Purpose of changes: + +Back out the new T31 surface datasets so will have initial conditions to use +for T31. Bring in the new surface datasets with initial conditions in the next tag. + +Requirements for tag: Run on bluefire + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Bring back old T31 datasets + Comment out the new T31 surface datasets and put back the old T31 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/src/main/findHistFields.pl -- Add script to figure out list of + history field names, long_names, and units + Create's a XML file as well as giving you a neatly formatted sorted list. + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Move T31 files + back to previous version and comment out the new files. + +Summary of testing: + + bluefire: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + bluefire interactive testing: All PASS except... +026 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +027 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +031 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +065 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +080 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +082 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +084 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= + bluefire/CESM testing: All PASS except... +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_39 + +Changes answers relative to baseline: T31 + + Answers are identical to clm4_0_38, if fatmgrid=fsurdat in controlMod.F90 + except for ntop for some grids and TREFMXAV and TREFMNAV for others. + +=============================================================== +=============================================================== +Tag name: clm4_0_39 +Originator(s): erik (Erik Kluzek) +Date: Wed Feb 1 11:40:11 MST 2012 +One-line Summary: Bring newgrid branch to trunk + +Purpose of changes: + +Move newgrid branch from Mariana to trunk. Add ne4np4, ne16np4, ne240np4 surface +datasets. Replace all T31 surface datasets. Start removing CASA and fine-mesh testing +and support. Bring in Tony's updates to ESMF5.2.0. + +Requirements for tag: + +run on lynx-pgi/bluefire/mirage-intel, fix bugs: 1446, 1444, 1442, 1404, 1430, 1425, 1420 + +Test level of tag: standard + +Bugs fixed (include bugzilla ID): + 1458 (Problem using fsurdat for fatmgrid as no verticies) + 1444 (attempt to read unallocated variable) + 1442 (Make clm-template same as CAM template) + 1430 (Remove DIN_LOC_ROOT_CLMQIAN -- add ...CLM_FORC) + 1425 (Double quotes causes Namelist.pm to hang) + 1420 (Bad history output for TREFMNAV, TREFMXAV) + 1404 (Inconsistent domain and fatmlndfrc files) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1454 (lack of 1D history files in CLM testing) + 1455 (bad time-stamp in CLM testing) + 1457 (bug in soil color in mksurfdata_map) + 1459 (PTSMODE fails) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: + Move rtm, voc, and glc_nec from configure-time to run-time namelist options + + Remove the -rtm -glc_nec and -voc options from "configure" + (NO longer available to CLM_CONFIG_OPTS) + + +Describe any changes made to the namelist: + + Add "-glc_nec, -glc_smb, -rtm options to build-namelist + (now available to CLM_BLDNML_OPTS) + + Remove fine-mesh option to build-namelist "-lnd_res" + (NO longer available to CLM_BLDNML_OPTS) + + Add following to clm_inparm namelist: + + do_rtm => If TRUE, turn on rtm river routing + maxpatch_glcmec => Number of multiple elevation classes over glacier points. + Normally this is ONLY used when running CESM with the active glacier model. + + Add following to the driver namelist to pass extra fields + + flds_voc + flds_co2a + flds_co2a + flds_co2c + flds_co2_dmsa + cplflds_custom + glc_nec + +List any changes to the defaults for the boundary datasets: + Replace T31 surface datasets, remove T31 finidat datasets + Add T31 fpftdyn datasets for all cases + Add ne240np4 datasets, ne4np4, ne16np4 surface datasets + + remove ALL fatmtopo datasets and all but T31, f09, f19 for glc_nec flndtopo + + Remove fatmlndfrc datasets -- use datm domainfiles in their place + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,mvertens,tcraig (ESMF update) + +List any svn externals directories updated (csm_share, mct, etc.): almost all + scripts to scripts4_120123 + Machines to Machines_120123 + drv to drvseq4_1_01 + datm to datm8_120123 + socn/sice/sglc to stubs1_3_01 + cism to cism1_120123 + csm_share to share3_120123 + esmf_wrf_tmgr to esmf_wrf_timemgr_120123 + gen_domain to gen_domain_120117 + +List all files eliminated: + +>>>>>>>>>>>>>> Get rid of mkgriddata as no longer needed +>>>>>>>>>>>>>> Use gen_domain or models/lnd/clm/tools/mkmapdata/mknoocnmap.pl + D mkgriddata/mkgriddata.namelist + D mkgriddata/mkgriddata.regional + D mkgriddata/src/mkvarpar.F90 + D mkgriddata/src/mkvarctl.F90 + D mkgriddata/src/clm_varpar.F90 + D mkgriddata/src/clm_varctl.F90 + D mkgriddata/src/shr_sys_mod.F90 + D mkgriddata/src/shr_file_mod.F90 + D mkgriddata/src/ncdio.F90 + D mkgriddata/src/shr_log_mod.F90 + D mkgriddata/src/Filepath + D mkgriddata/src/Macros.custom + D mkgriddata/src/shr_kind_mod.F90 + D mkgriddata/src/shr_const_mod.F90 + D mkgriddata/src/mkgriddata.F90 + D mkgriddata/src/domainMod.F90 + D mkgriddata/src/areaMod.F90 + D mkgriddata/src/creategridMod.F90 + D mkgriddata/src/nanMod.F90 + D mkgriddata/src/Srcfiles + D mkgriddata/src/Mkdepends + D mkgriddata/src/Makefile + D mkgriddata/src + D mkgriddata/mkgriddata.singlept + D mkgriddata/mkgriddata.cesm_dom + D mkgriddata/README + D mkgriddata + +>>>>>>>>>>>>>> Remove config files for CASA or that turn off RTM, or +>>>>>>>>>>>>>> turn on VOC or glc_mec + D models/lnd/clm/test/system/config_files/_nrsc_dh + D models/lnd/clm/test/system/config_files/4p_casasc_dh + D models/lnd/clm/test/system/config_files/4p_casasc_dm + D models/lnd/clm/test/system/config_files/4p_casasc_do + D models/lnd/clm/test/system/config_files/4p_casasc_ds + D models/lnd/clm/test/system/config_files/4p_casasc_h + D models/lnd/clm/test/system/config_files/4p_casasc_m + D models/lnd/clm/test/system/config_files/4p_casasc_o + D models/lnd/clm/test/system/config_files/17p_nrsc_ds + D models/lnd/clm/test/system/config_files/_nrsc_dm + D models/lnd/clm/test/system/config_files/_nrsc_do + D models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_h + D models/lnd/clm/test/system/config_files/_nrsc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_m + D models/lnd/clm/test/system/config_files/17p_nrcnsc_do + D models/lnd/clm/test/system/config_files/17p_vorsc_o + D models/lnd/clm/test/system/config_files/17p_nrcnsc_ds + D models/lnd/clm/test/system/config_files/_nrmexsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_dh + D models/lnd/clm/test/system/config_files/_nrcnsc_do + D models/lnd/clm/test/system/config_files/_mec10sc_dm + D models/lnd/clm/test/system/config_files/_nrcnsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_do + D models/lnd/clm/test/system/config_files/_mec10sc_ds + D models/lnd/clm/test/system/config_files/_nrsc_s + D models/lnd/clm/test/system/config_files/_nrvansc_ds + D models/lnd/clm/test/system/config_files/_nrnil3sc_dh + D models/lnd/clm/test/system/config_files/_nrnil3sc_dm + D models/lnd/clm/test/system/config_files/17p_vorsc_dh + D models/lnd/clm/test/system/config_files/21p_nrcncrpsc_s + D models/lnd/clm/test/system/config_files/21p_nrcncrpsc_ds + D models/lnd/clm/test/system/config_files/17p_vorsc_dm + D models/lnd/clm/test/system/config_files/17p_vorsc_do + D models/lnd/clm/test/system/config_files/17p_vorsc_ds + D models/lnd/clm/test/system/config_files/_mec10sc_h + D models/lnd/clm/test/system/config_files/_mec10sc_m + D models/lnd/clm/test/system/config_files/_mec10sc_o + +>>>>>>>>>>>>>> Remove mkdatadomain always use gen_domain + D models/lnd/clm/tools/mkdatadomain + D models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist + D models/lnd/clm/tools/mkdatadomain/src + D models/lnd/clm/tools/mkdatadomain/src/addglobal.F90 + D models/lnd/clm/tools/mkdatadomain/src/create_domain.F90 + D models/lnd/clm/tools/mkdatadomain/src/Mkdepends + D models/lnd/clm/tools/mkdatadomain/src/Srcfiles + D models/lnd/clm/tools/mkdatadomain/src/Filepath + D models/lnd/clm/tools/mkdatadomain/src/Macros.custom + D models/lnd/clm/tools/mkdatadomain/src/Makefile + D models/lnd/clm/tools/mkdatadomain/src/shr_kind_mod.F90 + D models/lnd/clm/tools/mkdatadomain/src/shr_const_mod.F90 + D models/lnd/clm/tools/mkdatadomain/README +>>>>>>>>>>>>>> fine-mesh no longer supported don't worry about topo files anymore + D models/lnd/clm/bld/namelist_files/checktopofiles.ncl + +List all files added and what they do: + +>>>>>>>>>>>>>> Rename without RTM off option + A + models/lnd/clm/test/system/config_files/17p_cnsc_ds + A + models/lnd/clm/test/system/config_files/_mexsc_ds + A + models/lnd/clm/test/system/config_files/_vansc_ds + +>>>>>>>>>>>>>> namelist to turn on VOC and RTM off, and gen_domain options + A + models/lnd/clm/test/system/nl_files/nl_voc + A + models/lnd/clm/test/system/nl_files/clm_nortm + A + models/lnd/clm/test/system/nl_files/gen_domain.ne30.runoptions + A + models/lnd/clm/test/system/nl_files/gen_domain.T31.runoptions + +>>>>>>>>>>>>>> Add scripts to create SCRIP grid/map files for region/single-point domains + A + models/lnd/clm/tools/mkmapdata/mkunitymap.ncl + A + models/lnd/clm/tools/mkmapdata/mknoocnmap.pl + A + models/lnd/clm/tools/mkmapgrids/mkscripgrid.ncl + + mknoocnmap.pl [options] Gets map and grid files for a single land-only point. + REQUIRED OPTIONS + -centerpoint [or -p] Center latitude,longitude of the grid to create. + -name [-or -n] Name to use to describe point + + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Remove rtm off from config files and update README file + M models/lnd/clm/test/system/config_files/_nil3sc_dh + M models/lnd/clm/test/system/config_files/_nil3sc_dm + M models/lnd/clm/test/system/config_files/README + +>>>>>>>>>>>>>> Change tests + M models/lnd/clm/test/system/README.testnames --- Update test names + 6, A, J, Q, S, V, X, and Z configurations are now unused + resolutions: 3, F, G and H are now unused + M models/lnd/clm/test/system/mknamelist --------- Remove fine-mesh option + M models/lnd/clm/test/system/test_driver.sh ----- Update paths for + edinburgh/jaguar + M models/lnd/clm/test/system/input_tests_master - Remove nr,vo,mec in configure + files for tests and move to namelist, remove compile-only test names + M models/lnd/clm/test/system/TSMtools.sh -------- Allow run files to + be in test directory + +>>>>>>>>>>>>>> Change testnames + 6, A, J, Q, S, V, X, and Z configurations are now unused + resolutions: 3, F, G and H are now unused + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + MM models/lnd/clm/test/system/tests_pretag_jaguarpf + MM models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>>>>>> Fix run-time options + M models/lnd/clm/test/system/nl_files/clm_usrdat ----- Add rtm off + M models/lnd/clm/test/system/nl_files/mkmapdata_if10 - Remove -i option + +>>>>>>>>>>>>>> Add option to create datasets NOT entered into XML database + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Use domainfile + rather than fatmgrid file, which changes variable names as well + M models/lnd/clm/tools/README.testing --------------- Note that run files + can be in tool directory or test directory + M models/lnd/clm/tools/README ----------------------- Update information on + process + MM models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl - Add usrspc option + M models/lnd/clm/tools/mkmapdata/regridbatch.sh ----- Use -b instead of -i + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh ------- Replace -i option with + -b for batch, add option to read input SCRIP grid file (-f) and (-t) + option for regional or global type, update usage + M models/lnd/clm/tools/mksurfdata_map/README -------- Update usage info + M models/lnd/clm/tools/mkmapdata/README ------------- Update usage info + + New options for unsupported resolutions to mksurfdata.pl + ++ For unsupported, user-specified resolutions: ++ $ProgName -res usrspec -usr_gname -usr_gdate [OPTIONS] ++ -usr_gname "user_gname" User resolution name to find grid file with ++ (only used if -res is set to 'usrspec') ++ -usr_gdate "user_gdate" User map date to find mapping files with ++ (only used if -res is set to 'usrspec') ++ NOTE: all mapping files are assumed to be in mkmapdata ++ - and the user needs to have invoked mkmapdata in ++ that directory first ++ + +>>>>>>>>>>>>>> Move rtm, glc_nec, voc from configure to build-namelist + M models/lnd/clm/bld/configure -------------- Remove -rtm, -glc_nec, -voc options + M models/lnd/clm/bld/listDefaultNamelist.pl - Get datm namelist files as well + M models/lnd/clm/bld/build-namelist --------- Add: glc_nec, glc_smb, rtm options + Remove: lnd_res fine-mesh option + M models/lnd/clm/bld/clm.cpl7.template ------ Move rtm, glc_nec settings from + configure to build-namelist, set fatmlndfrc from domain file set in scripts + add processing for LND_GRID=reg, set glc_smb, loop over namelists for DART, + M models/lnd/clm/bld/README + M models/lnd/clm/bld/config_files/config_definition.xml - Remove rtm, glc_nec, voc + +>>>>>>>>>>>>>> Add new namelist items, remove CASA, fine-mesh, update T31 +>>>>>>>>>>>>>> add ne4np4, ne16np4, ne240np4 datasets + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ + Add: rtm, maxpatch_glcmec, do_rtm, new cpl files, navy lmask + remove: fatmtopo, CASA namelist items, + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - rtm/glc_nec + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ------- rm CASA + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- + Add: do_rtm, new T31 fsurdat/fpftdyn files, new ne4np4, ne16np4, + fsurdat and ne240np4 fsurdat/fatmlndfrc, missing map files (f19,T31) + Remove: T31 finidat, remove fatmtopo, and most flndtopo + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Change + paths of domainfiles to share/domains + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Add 10min + navy grid file + +>>>>>>>>>>>>>> Add glc_nec + M models/lnd/clm/bld/namelist_files/use_cases/20thC_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_glacierMEC_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/glacierMEC_pd.xml + + +>>>>>>>>>>>>>> Remove RTM, GLC_NEC, ESMF5.2.0 updates, don't require extents on fsurdat + M models/lnd/clm/src/main/clm_varpar.F90 -- Change for glc_nec + M models/lnd/clm/src/main/accumulMod.F90 -- Initialize val to zero if period=1 + M models/lnd/clm/src/main/clm_initializeMod.F90 - Change order of calls, rm RTM + M models/lnd/clm/src/main/clm_glclnd.F90 -- Use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/subgridMod.F90 -- Use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/histFileMod.F90 - Remove RTM add do_rtm + make sure ninst suffix is in restart history filename + M models/lnd/clm/src/main/restFileMod.F90 - Remove RTM add do_rtm + M models/lnd/clm/src/main/controlMod.F90 -- Remove RTM add do_rtm, + maxpatch_glcmec, glc_grid, use fatmlndfrc for fatmgrid if empty + broadcast glc_topomax if create_glacier_mec_landunit + M models/lnd/clm/src/main/clm_time_manager.F90 - Changes from Tony to update + to ESMF5.2.0 + M models/lnd/clm/src/main/clm_varctl.F90 ---- Remove RTM, use do_rtm, and remove + GLC_NEC use arrays for glc_nec variables + M models/lnd/clm/src/main/clm_driver.F90 ---- Remove RTM use do_rtm + M models/lnd/clm/src/main/initGridCellsMod.F90 - Write more info on error + M models/lnd/clm/src/main/pftvarcon.F90 ----- Remove unused MPI vars + M models/lnd/clm/src/main/surfrdMod.F90 ----- Don't require LATS/N,LONE/W on + files set to nan if not used, use maxpatch_glcmec NOT glc_nec + M models/lnd/clm/src/main/domainMod.F90 ----- Don't write LATS/N,LONE/W if + first lonw is nan + M models/lnd/clm/src/main/decompMod.F90 ----- Remove RTM use do_rtm + M models/lnd/clm/src/main/histFldsMod.F90 --- Remove RTM use do_rtm + M models/lnd/clm/src/riverroute/RtmMod.F90 -- Remove RTM use run_rtm NOT do_rtm + M models/lnd/clm/src/riverroute/RunoffMod.F90 Remove RTM + +>>>>>>>>>>>>>> ESMF5.2.0 updates, remove RTM, GLC_NEC + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - ESMF5.2.0 updates, remove RTM + use do_rtm, remove GLC_NEC use arrays of glc_nec + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- ESMF5.2.0 updates + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- ESMF4.2.0 updates + M models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 - Updated for new coupler fields spec + Remove RTM, GLC_NEC CPP tokens, make glc_nec variables arrays + some updates to ESMF5.2.0 + +Summary of testing: + + bluefire: All PASS except... +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brW51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +019 blW51 TBL.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -5 cold .................FAIL! rc= 7 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 (bluefire compiler error) +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 (bluefire compiler error) +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 (bluefire compiler error) +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 (bluefire compiler error) +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 7 (bluefire compiler error) +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 (bluefire compiler error) +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 (bluefire compiler error) +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 (bluefire compiler error) +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 (bluefire compiler error) +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 (bluefire compiler error) +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 (bluefire compiler error) +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 (bluefire compiler error) +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 (bluefire compiler error) +036 smU61 TSM.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -6 cold ......FAIL! rc= 10 (bluefire compiler error) +037 erU61 TER.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 10+38 cold ...FAIL! rc= 5 (bluefire compiler error) +038 brU61 TBR.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 -3+-3 cold ...FAIL! rc= 5 (bluefire compiler error) +039 blU61 TBL.sh 21p_cndvcrpsc_dh clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6 48 cold ......FAIL! rc= 4 (bluefire compiler error) + bluefire interactive testing: +008 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 7 +012 blHS3 TBL.sh 17p_cnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .....FAIL! rc= 7 +016 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +020 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 +024 blJ74 TBL.sh 4p_casasc_ds clm_std^nl_urb 10001230:3600 1x1_tropicAtl test -100 arb_ic .......FAIL! rc= 7 +028 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic ........FAIL! rc= 7 +029 smCK4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 10 +030 erCK4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 5 +031 brCK4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 5 +032 blCK4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 4 +033 smCK8 TSM.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -10 cold ...........FAIL! rc= 10 +034 erCK8 TER.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 5 +035 brCK8 TBR.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 5 +036 blCK8 TBL.sh _sc_ds clm_nortm^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +042 blF93 TBL.sh 17p_sc_do clm_std^nl_voc 20021230:1800 4x5 gx3v7 48 cold .......................FAIL! rc= 5 +046 blC83 TBL.sh _sc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -10 arb_ic .................FAIL! rc= 7 +054 blC63 TBL.sh _sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ........................FAIL! rc= 5 +058 blHQ4 TBL.sh 17p_cnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold ............FAIL! rc= 5 +062 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +066 bl514 TBLtools.sh gen_domain tools__ds T31.runoptions .......................................FAIL! rc= 5 +075 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +076 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +083 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 7 +085 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 7 +090 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +091 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +092 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +093 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +094 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +095 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except, compare_hist +FAIL SMS_RLA.f45_f45.I.bluefire - bug 1459 +FAIL SMS_RLB.f45_f45.I.bluefire - bug 1459 +FAIL SMS_ROA.f45_f45.I.bluefire - bug 1459 + bluefire/PTCLM testing: All FAIL + lynx/pgi: All PASS except... +004 blC92 TBL.sh _sc_dm clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 7 +007 blD92 TBL.sh _persc_dm clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blF92 TBL.sh 17p_sc_dm clm_std^nl_voc 20021230:1800 4x5 gx3v7 48 cold .......................FAIL! rc= 5 +015 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 7 +019 blJ92 TBL.sh 4p_casasc_dm clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 7 +023 blL52 TBL.sh _sc_dm clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 + lynx/pgi interactive testing: All PASS except.. +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 7 +009 smCL4 TSM.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 10 +010 erCL4 TER.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +011 brCL4 TBR.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +012 blCL4 TBL.sh _sc_ds clm_nortm^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 4 +016 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +020 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic .....FAIL! rc= 5 +024 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ....FAIL! rc= 5 +025 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +026 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +027 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + mirage,storm/ifort interactive testing: +007 blD94 TBL.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 7 +011 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic ...............FAIL! rc= 7 +015 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:3600 1x1_asphaltjungleNJ navy -90 arb_ic ........FAIL! rc= 7 +019 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:1800 10x15 USGS 48 arb_ic .......................FAIL! rc= 7 +023 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 48 cold ............FAIL! rc= 7 + jaguarpf: Currently NOT available: + edinburgh: Currently not supported + +CLM tag used for the baseline comparison tests if applicable: clm4_0_38 + +=============================================================== +=============================================================== +Tag name: clm4_0_38 +Originator(s): erik (Erik Kluzek) +Date: Mon Jan 23 13:56:45 MST 2012 +One-line Summary: Fix some minor issues with tools, add high resolution option and +datasets to mksurfdata, remove crap from clmtype so C13 will work on bluefire, convert +nans to FillValue for some cases, fix datasets, update doc + +Purpose of changes: + +Update externals to new version of scripts/Machines. Fix some bugs. Add in maps for: +ne4np4, ne16np4, ne60np4, and ne240np4 resolutions. Begin adding _FillValue/missing_value +to restart files. Start adding in new high-resolution datasets for mksurfdata. Add an +option to mksurfdata.pl to run at hi-res let default be standard half-degree datasets. +Add in 3x3min PFT dataset for 2000, and 5x5min organic. Add in maps for 3x3min and +5x5min_ISRIC_WISE to output grids. Separate out wetland and lake datasets, add in 3x3min +lake dataset. Get mksurfdata to work with T31, fix maps. Have both mksurfdata_map and clm +check files for consistencies. Add initial version of a script to check that maps in the +XML database are correct. Make sure keywords are set in tools, and OPT correctly added to +meta-data. Update gen_domain. Correct some typo's in filenames. Remove some unused data +in clmtype.F90. Update documentation to cesm1_0_4. + +Requirements for tag: + Testing on bluefire-only, Fix bugs: 1432 (part X), 1424X, 1423X, 1401 (part)X, 1309, + mksurfdata works at regular and hi-res and for f09, and at regular for: 128x256, + 512x1024, ne4np4, ne16np4, ne30np4, ne60np4, and ne240np4 resolutions, T31 and T31 + mksurfdata rcp's work + +Test level of tag: critical + +Bugs fixed (include bugzilla ID): + 1432 (Several resolutions fail for new mksurfdata_map) + 1424 (variables written out as gdir) + 1423 (Problem building clmtype on bluefire) + 1398 (clm and mksurfdata_map needs to check map files -- partial) + +Known bugs (include bugzilla ID): + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1468 (Bad f09, f19 SCRIP Grid files) + 1476 (Problem with stand-alone build on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 896 (T62 mode does not work) + 701 (svn keyword) + 452 (Problem with support of soil-colors != 8 or 20) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Correct and add new mapping datasets and datasets for mksurfdata_map + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): most + + scripts to scripts4_111108 + Machines to Machines_111101 + drv to drvseq4_0_08 + cism to cism1_111004 + csm_share to share3_111027 + timing to timing_111101 + MCT to MCT2_7_0-111101 + pio to pio1_3_12 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_scnv_ds - Add serial option + A models/lnd/clm/bld/namelist_files/checkmapfiles.ncl - check that map files + are consistent + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/input_tests_master - Add serial irrig test + + M models/lnd/clm/test/system/test_driver.sh ----- Fix issues on bluefire, + update some paths on edinburgh + +>>>>>>>>>>>>>> Update documentation + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/KnownBugs + +>>>>>>>>>>>>>> Get svn keywords set on tools, and make sure OPT is set + M models/lnd/clm/tools/mkmapdata/mvNimport.sh -------- Fix syntax error + M models/lnd/clm/tools/mkmapdata/mkmapdata.sh -------- Add in 3x3 grid and ISRIC-WISE + mask, add option to build ocean-land mask, and large-file format option, + M models/lnd/clm/tools/interpinic/src/interpinic.F90 - Fix svn keywords + M models/lnd/clm/tools/interpinic/src/Makefile ------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkgriddata/src/Makefile ------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkdatadomain/src/Makefile ----- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mkmapgrids/src/mkmapgrids.F90 - Add more meta-data + M models/lnd/clm/tools/mkmapgrids/src/Makefile-------- Set OPT CPP if OPT=TRUE + +>>>>>>>>>>>>>> Add call to domain_checksame to check if domains are the same, +>>>>>>>>>>>>>> split lake and wetland processing, add write statment for each file +>>>>>>>>>>>>>> opened, add -hires and -allownofile options to mksurfdata.pl + M models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 ---- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkvarctl.F90 ------- Split lake/wetland + M models/lnd/clm/tools/mksurfdata_map/src/mkvocefMod.F90 ----- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mklaiMod.F90 ------- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mksoilMod.F90 ------ Use domain_checksame + increase kmap_max_min from 50 to 90 (so T31 can be run) + M models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 ---- Add domain_checksame, + make domain_init private, add metadata if frac/mask set, eliminate + lats/n,lone/w, use call abort in place of stop, + M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 ------ Split lake/wetland + remove documentation on specific datasets, increase allowed sum of special + landunits from 120 to 250 + M models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 -- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkharvestMod.F90 --- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 ------ Fix meta-data, + remove lats/n,lone/w + M models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 --- Add headers, more + checking, add gridmap_setptrs method private gridmap_checkifset method, + + M models/lnd/clm/tools/mksurfdata_map/src/mklanwatMod.F90 ---- Split mklanwat + into mklakwat/mkwetlnd subroutines, use domain_checksame, + M models/lnd/clm/tools/mksurfdata_map/src/Makefile ----------- Set OPT CPP if OPT=TRUE + M models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 ------- Use domain_checksame + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl ---------- Add -hires and + -allownofile options, split lake and wetland + + -allownofile Allow the script to run even if one of the input files + does NOT exist. + -hires If you want to use high-resolution input datasets rather than the default + lower resolution datasets (low resolution is typically at half-degree) + + M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt Use $CSMDATA + directory path rather than /cgd/tss path + M models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist Split lake and wetland + +>>>>>>>>>>>>>> Minor changes + M models/lnd/clm/bld/build-namelist --------- Move groups earlier, start adding + code to handle lnd_inst_counter + M models/lnd/clm/bld/listDefaultNamelist.pl - Get rcp list sooner + +>>>>>>>>>>>>>> Fix some filename typos, add new mapping files, add hi-res +>>>>>>>>>>>>>> datasets + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------ Add + ne4np4, ne16np4, ne60np4, ne240np4 mapping files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Correct + some typo's in filenames (ne4np4 scripgrid, ngwh mksurfdata pftdyn file + for rcp 6 for year 2006 + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add mksrf_filename, + correct mksrf_* filenames to mksrf_f*, add ISRIC-WISE lmask + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------- Only require + datm_data_dir for CPLHIST3HrWx + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add ISRIC-WISE, + 3x3min_MODIS mapping datasets, correct some map dataset names, + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Add more data + to output table + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Correct and + add new scrip grid files, add hires option for some data, add + mksrf_filename for types of files, add in all mksurfdata raw + datasets, add new hires datasets, correct mksrf_fvegtyp filenames, + +>>>>>>>>>>>>>> Remove initialization of unused data types (allows C13 on bluefire) +>>>>>>>>>>>>>> Add option to convert nan to fillvalue on output files +>>>>>>>>>>>>>> (and vica-versa on input) + M models/lnd/clm/src/main/clmtypeInitMod.F90 - Remove initialization of unused + data types + M models/lnd/clm/src/main/clm_atmlnd.F90 ----- Remove unused pdf variable + M models/lnd/clm/src/main/initSurfAlbMod.F90 - Remove unused CNZeroFluxes + M models/lnd/clm/src/main/ncdio_pio.F90 ------ Add cnvrtnan2fill option + to convert from spval to nan on read and from nan to spval on write + M models/lnd/clm/src/main/clmtype.F90 -------- Remove unused variables + M models/lnd/clm/src/main/histFldsMod.F90 ---- Add some documentation, change + longname of QSOIL, correct: CISUN, CISHA, ALPHAPSNSUN, ALPHAPSNSHA + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + + +Summary of testing: + + bluefire testing: +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 + bluefire interactive testing: All PASS except... +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +037 blAK8 TBL.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +067 bl5@4 TBLtools.sh gen_domain tools__ds namelist .............................................FAIL! rc= 7 +003 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +004 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +008 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +011 sm974 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +012 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 4 +013 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +014 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 4 +015 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 +016 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (compare tests fail because clm4_0_37 file did not exist) + +CLM tag used for the baseline comparison tests if applicable: clm4_0_37 + +=============================================================== +=============================================================== +Tag name: clm4_0_37 +Originator(s): erik (Erik Kluzek) +Date: Mon Sep 26 10:35:24 MDT 2011 +One-line Summary: Fix unstructured grids history files + +Purpose of changes: + +Comment out code for writing out fine-mesh lat/lon for unstructured grids. This caused +the code to blow up when running for HOMME grids such as ne30np4. + +Bugs fixed (include bugzilla ID): + 1415 (History files can't be written out for HOMME grids) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1423 (Problem building clmtype on bluefire) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/main/histFileMod.F90 - Comment out code for fine-mesh + lat/lon for unstructured grids + +Summary of testing: None! + +CLM tag used for the baseline comparison tests if applicable: clm4_0_36 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_36 +Originator(s): erik (Erik Kluzek) +Date: Thu Sep 22 11:05:59 MDT 2011 +One-line Summary: Comment out RTM mapping files for f09 and f19 + +Purpose of changes: + +Comment out the RTM mapping files for f09/f19 so answers are the same as clm4_0_34 and as the f19 mapping +files cause the fully coupled model to blow up in POP. Add "mv" option to mksurfdata.pl and make -nomv the +default so it doesn't try to copy files by default. Increase length of filename strings for mksurfdata pftdyn +files. Add some metadata for some restart file variables. Add "new good wood harvest" datasets +and option (-new_woodharv) to mksurfdata.pl from Peter Lawrence so can make surface +datasets with either set of files. New good wood harvest applies to rcp6 and rcp8.5. +Also add in some new mapping files for: 512x1024,128x256,64x128,32x64,8x16,0.23x0.31,5x5_amazon. +Add SCRIP grid files for: ne4np4,ne16np4, ne60np4, ne240np4. Add 3x3min resolution +and 3x3min SCRIP grid file which will be used for high resolution surface dataset +creation in the future. Use new surface datasets with old fatmgrid values for f09_g16 +for 1850 and 2000 so that answers can be identical to clm4_0_34 without requiring the +fatmgrid file. + +Bugs fixed (include bugzilla ID): + 1414 (Answers change @ f09 resolution w/o fatmgrid file) + 1413 (re is in incorrect units in mksurfdata_map) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1415 (History files can't be written out for HOMME grids) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Comment out RTM mapping files for f09/f19 + Also new mapping files for: 512x1024,128x256,64x128,32x64,8x16,0.23x0.31,5x5_amazon. + Add SCRIP grid files for: ne4np4,ne16np4, ne60np4, ne240np4. + Add 3x3min SCRIP grid file. + New surface datasets with old fatmgrid grid coordinate values for f09/1850/2000 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 -------------- Increase pftdyn file length to 135 + M models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 -------------- Increase nchar dim to 256 + M models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl ------------------ Add "mv" option with "nomv" the default + M models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt - Increse length of strings for files + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add 3x3min, + ne4np4,ne16np4, ne60np4, ne240np4 as valid resolutions + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Comment out f09/f19 RTM mapping files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add new + good wood harvest pftdyn input files from Peter Lawrence for mksurfdata_map + for rcp6 and rcp8.5 + + M models/lnd/clm/src/biogeochem/CNrestMod.F90 --------- Add some FillValue to some fields for restart files + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 - Add some FillValue to some fields for restart files + +Summary of testing: + + bluefire interactive testing: Following PASS +001 sm754 TSMtools.sh mksurfdata_map tools__s namelist ..........................................PASS +003 sm953 TSMscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................PASS +005 sm954 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......PASS +007 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................PASS +008 bl9S4 TBLscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................PASS + bluefire/CESM testing: All PASS except (compare to clm4_0_34) +CFAIL ERS_E.T31_g37.I1850.bluefire.GC.125250 (ESMF doesn't work with NetCDF4) +BFAIL ERB.ne30_g16.I_1948-2004.bluefire.compare.clm4_0_34 (ne30 wasn't in clm4_0_34) (answers are identical to clm4_0_35) +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_34 (I1850SPINUPCN wasn't in clm4_0_34 or before) +FAIL NCK.f10_f10.I.bluefire -- scripts needs to cleannamelist after changing NINST_LND + bluefire extra CESM testing: Following PASS +PASS ERS.f09_g16.ICN.bluefire +PASS ERS.f09_g16.ICN.bluefire.generate.clm4_0_36 +PASS ERS.f09_g16.ICN.bluefire.compare_hist.clm4_0_33 +PASS ERS.f09_g16.ICN.bluefire.compare.clm4_0_33 +PASS ERS.f09_g16.I1850CN.bluefire +PASS ERS.f09_g16.I1850CN.bluefire.generate.clm4_0_36 +PASS ERS.f09_g16.I1850CN.bluefire.compare_hist.clm4_0_33 +PASS ERS.f09_g16.I1850CN.bluefire.compare.clm4_0_33 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_35 + +Changes answers relative to baseline: f09/f19 now same as clm4_0_34 + +=============================================================== +=============================================================== +Tag name: clm4_0_35 +Originator(s): erik (Erik Kluzek), mvertens +Date: Tue Sep 13 22:15:17 MDT 2011 +One-line Summary: Bring in Mariana's non2D grid branch to trunk, enabling HOMME grids: ne30np4/ne120np4 + +Purpose of changes: + +Move Mariana's new non-2D branch to trunk. Extensive changes to mksurfdata, allows 1D-vector surface +datasets. Mariana change mksurfdata to add unstructured grid format using SCRIP weights. Won't work +with PTCLM and mksurfdata won't be able to create single-pt/regional surface datasets. Fix reverse +coordinates on VOC/irrig mksurfdata input file. Update scripts and datm with HOMME grids. Add in +half-degree pftdyn historical dataset. Partial fix to PTSMODE restart problem. Fix the US-UMB data for PTCLM. + +NOTE: File creation process is changed substantially! mksurfdata now requires mapping files to be created first + in order to run the new mksurfdata_map. This means you need to do the following: + + 1.) run mkgriddata + 2.) run mkmapgrid (add files to XML database) (requires 1) + 3.) run mkmapdata (add files to XML database) (requires 2) + 4.) run mksurfdata_map (requires 3) + 5.) run gen_domain (requires 3 needed for datm) + + See the models/lnd/clm/tools/README file for more help on the process. + +WARNING: YOU CAN'T CREATE SINGLE-POINT DATASETS WITH THIS VERSION! You can create frac/grid files with this + version and then use an older verison of clm to use mksurfdata to create surface datasets. The mapping + for single-point datasets using ESMF does NOT work -- although it does work if you have at least 4 points + so you can create regional datasets. + + THIS MEANS PTCLM DOES NOT WORK FOR CREATING NEW DATASETS! It will work for datasets already created however. + +CAUTION: Mapping files to allow mksurfdata to work are only provided for: f09, f19, f10, T31, f45, f25, ne30 and ne120 + +Bugs fixed (include bugzilla ID): + 1392 (US-UMB site has some incorrect data) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1393 (error when running Gregorian calendar) + 1397 (c2l_scale_type not specified for many history fields) + 1398 (clm and mksurfdata_map needs to check map files for consistency) + 1401 (Restart files do NOT have _FillValue/missing_value attributes on fields) + 1404 (Inconsistent domain and fatmlndfrc files) + 1405 (Problem with irrigation on clm4_0_34 with intel compiler) + 1407 (Build problem on jaguar for test_driver.sh with -c option) + 1409 (ne120 is having restart trouble on jaguar with NetCDF3) + 1410 (Problem running PST.f09_g16.I.jaguarpf) + 1411 (ERI_D.ne30_g16.I1850CN.jaguarpf.G.235924 fails on jaguarpf) + 1413 (re is in incorrect units in mksurfdata_map) + 1414 (Answers change @ f09 resolution w/o fatmgrid file) + 1415 (History files can't be written out for HOMME grids) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Can now read in domain files in place of fatmlndfrac + fatmgrid no longer required (use fsurdat to get grid) + fmapinp_rtm new namelist item to give mapping for RTM + +List any changes to the defaults for the boundary datasets: + + Add: ne30np4/ne120np4 datasets, add 1850-2000 0.47x0.63 fpftdyn file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens, sacks + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm + + scripts to scripts4_110906 + csm_share to share3_110906 + datm to datm8_110908 + +List all files eliminated: + +>>>>>>>>>>>> Rename mksurfdata to mksurfdata_map + D models/lnd/clm/tools/mksurfdata/* + +>>>>>>>>>>>> Move source code to src subdirectory + D models/lnd/clm/tools/mkdatadomain/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + D models/lnd/clm/tools/mkgriddata/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + D models/lnd/clm/tools/interpinic/Mkdepends/Srcfiles/Filepath/Makefile/*.F90 + +List all files added and what they do: + +>>>>>>>>>>>> Rename mksurfdata to mksurfdata_map, create src sub-directory + A models/lnd/clm/tools/mksurfdata_map + A models/lnd/clm/tools/mksurfdata_map/mksurfdata.pl + A models/lnd/clm/tools/mksurfdata_map/mksurfdata_map.namelist + A models/lnd/clm/tools/mksurfdata_map/pftdyn_hist_simyr1850-2005.txt + A models/lnd/clm/tools/mksurfdata_map/README + A models/lnd/clm/tools/mksurfdata_map/src + A models/lnd/clm/tools/mksurfdata_map/src/clm_varctl.F90 + A models/lnd/clm/tools/mksurfdata_map/src/clm_varpar.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Filepath + A models/lnd/clm/tools/mksurfdata_map/src/fileutils.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Macros.custom + A models/lnd/clm/tools/mksurfdata_map/src/Makefile + A models/lnd/clm/tools/mksurfdata_map/src/Mkdepends + A models/lnd/clm/tools/mksurfdata_map/src/mkdomainMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkfileMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkglcmecMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkgridmapMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkharvestMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mklaiMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mklanwatMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkncdio.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkpftMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mksoilMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mksurfdat.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkurbanparMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvarctl.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvarpar.F90 + A models/lnd/clm/tools/mksurfdata_map/src/mkvocefMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/nanMod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_const_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_file_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_log_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_string_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_sys_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/shr_timer_mod.F90 + A models/lnd/clm/tools/mksurfdata_map/src/Srcfiles + +>>>>>>>>>>>> Scripts to use ESMF to create SCRIP mapping files from SCRIP grid files + A models/lnd/clm/tools/mkmapdata + A models/lnd/clm/tools/mkmapdata/mkmapdata.sh + A models/lnd/clm/tools/mkmapdata/mvNimport.sh + A models/lnd/clm/tools/mkmapdata/README + A models/lnd/clm/tools/mkmapdata/regridbatch.sh + A models/lnd/clm/tools/mkmapdata/rmdups.ncl ----- NCL script to remove duplicates + +>>>>>>>>>>>> Program to create SCRIP grid files from CLM grid/frac files + A models/lnd/clm/tools/mkmapgrids + A models/lnd/clm/tools/mkmapgrids/mkmapgrids.csh + A models/lnd/clm/tools/mkmapgrids/mkmapgrids.namelist + A models/lnd/clm/tools/mkmapgrids/README + A models/lnd/clm/tools/mkmapgrids/src + A models/lnd/clm/tools/mkmapgrids/src/domainMod.F90 + A models/lnd/clm/tools/mkmapgrids/src/Filepath + A models/lnd/clm/tools/mkmapgrids/src/Macros.custom + A models/lnd/clm/tools/mkmapgrids/src/Makefile + A models/lnd/clm/tools/mkmapgrids/src/Mkdepends + A models/lnd/clm/tools/mkmapgrids/src/mkmapgrids.F90 + A models/lnd/clm/tools/mkmapgrids/src/nanMod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_log_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/shr_sys_mod.F90 + A models/lnd/clm/tools/mkmapgrids/src/Srcfiles + +>>>>>>>>>>>> Programs to postprocess 1D vector unstructured grids + A models/lnd/clm/tools/mkprocdata_map + A models/lnd/clm/tools/mkprocdata_map/camhomme + A models/lnd/clm/tools/mkprocdata_map/camhomme/mkprocdata_map_in + A models/lnd/clm/tools/mkprocdata_map/camhomme/src + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Depends + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/domainMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Filepath + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/fileutils.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/gridmapMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Makefile + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/mkprocdata_map.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/nanMod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/camhomme/src/Srcfiles + A models/lnd/clm/tools/mkprocdata_map/clm + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_all + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_in + A models/lnd/clm/tools/mkprocdata_map/clm/mkprocdata_map_wrap + A models/lnd/clm/tools/mkprocdata_map/clm/README + A models/lnd/clm/tools/mkprocdata_map/clm/src + A models/lnd/clm/tools/mkprocdata_map/clm/src/constMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Filepath + A models/lnd/clm/tools/mkprocdata_map/clm/src/fileutils.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/fmain.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/gridmapMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Makefile + A models/lnd/clm/tools/mkprocdata_map/clm/src/Mkdepends + A models/lnd/clm/tools/mkprocdata_map/clm/src/mkprocdata_map.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/nanMod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/shr_file_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/shr_kind_mod.F90 + A models/lnd/clm/tools/mkprocdata_map/clm/src/Srcfiles + +>>>>>>>>>>>> Make macros files to customize how tools operate (allows all tools to have an identical Makefile) + A models/lnd/clm/tools/interpinic/src/Macros.custom + A models/lnd/clm/tools/mkgridata/src/Macros.custom + A models/lnd/clm/tools/mkdomaindata/src/Macros.custom + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add tests for new grids/tools + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/README.testnames --------------- 4/5=mkmapgrids/gen_domain config + I=CN spinup, @=ne120np4, #=ne30np4, *=ne16np4 run options + +>>>>>>>>>>>> Change build/run for tools, update netcdf on bluefire, update modules on jaguar, add new tests + M models/lnd/clm/test/system/TCB.sh ------------- Remove setting of MACFILE not needed + M models/lnd/clm/test/system/TCBtools.sh -------- Add src directory, Mkdepends, Macros.custom + M models/lnd/clm/test/system/TBLscript_tools.sh - Set CLM_ROOT + M models/lnd/clm/test/system/TBLtools.sh -------- Set CLM_ROOT + M models/lnd/clm/test/system/TBL.sh ------------- Allow compile-only mode to work + M models/lnd/clm/test/system/TSM.sh ------------- Handle multi-instance rpointer files + M models/lnd/clm/test/system/test_driver.sh -- Get netcdf4.1.3 working on bluefire, get mirage build working, + use glade paths, add ESMFBIN_PATH, update jaguar modules + M models/lnd/clm/test/system/input_tests_master - Fill out HM tests, add H#, H@, blJ07, 454, 5@4, 9#2, 953 + tests, mksurfdata=>mksurfdata_map + M models/lnd/clm/test/system/nl_files/clm_spin -- Change case to agree with 1850 MOAR case in CESM scripts + M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 ------------ Remove -nomv option + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 ----- Remove -nomv option + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 - Remove -nomv option + +>>>>>>>>>>>> Run interpinic and checkin the result + M models/lnd/clm/tools/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + +>>>>>>>>>>>> Update to glade path, add notes on src subdirectory + M models/lnd/clm/tools/interpinic/README ------------------ Add notes about src subdirectory + M models/lnd/clm/tools/mkgriddata/mkgriddata.namelist ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.regional ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.singlept ----- Use glade path + M models/lnd/clm/tools/mkgriddata/mkgriddata.cesm_dom ----- Use glade path + M models/lnd/clm/tools/mkgriddata/README ------------------ Update with added src sub-directory + M models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist - Use glade path + M models/lnd/clm/tools/mkdatadomain/README ---------------- Add notes about src subdirectory + +>>>>>>>>>>>> Update tools README information + M models/lnd/clm/tools/README.testing ------ Note about src subdirectory required + M models/lnd/clm/tools/README -------------- Updated with notes on new process + M models/lnd/clm/tools/README.filecopies --- Notes on list of file copies has changed + +>>>>>>>>>>>> Changes to tools source codes moved to src subdirectories, Makefile was standardized +>>>>>>>>>>>> update shr_sys_mod.F90 file to latest csm_share + M models/lnd/clm/tools/interpinic/src/interpinic.F90 --- Add metadata on OPT and OMP + M models/lnd/clm/tools/interpinic/src/Makefile --------- Standardize + M models/lnd/clm/tools/interpinic/src/shr_sys_mod.F90 -- Update + M models/lnd/clm/tools/mkdatadomain/src/Makefile ------- Standardize + M models/lnd/clm/tools/mkdatadomain/src/Filepath ------- Only use local directory + M models/lnd/clm/tools/mkgriddata/src/Makefile --------- Standardize + M models/lnd/clm/tools/mkgriddata/src/shr_sys_mod.F90 -- Update + M models/lnd/clm/tools/mkgriddata/src/clm_varctl.F90 --- Update + +>>>>>>>>>>>> Add RTM mapping file, change some namelist file required logic + M models/lnd/clm/bld/listDefaultNamelist.pl - Also get RTM mapping file, and use $CSMDATA if set + M models/lnd/clm/bld/build-namelist --------- If can't find a frac file use the datm domain file, only + get fatmgrid file for fine-mesh, if RTM on get mapping file, if fine-mesh on and fatmgrid not found + use fsurdat file + M models/lnd/clm/bld/clm.cpl7.template ------ Clarify documentation for CLM_RTM_RES + +>>>>>>>>>>>> Add new files needed for ne30np4/ne120np4 and processing of them + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl --------- Add test for more resolutions + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add: fmapinp_rtm, scripgriddata, mksrf_fglctopo, + map, lmask, hgrid + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Add: ne30np4/ne120np4 datasets, add + 1850-2000 0.47x0.63 fpftdyn file, remove some of the single-point fatmlndgrd files, add mapping files, + add lmask/hgrid for different map types + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add ne30np4/ne120np4 domain files + +>>>>>>>>>>>> Use llatlon structure in place of lsmlat/lsmlon, required files a bit different, use fsurdat if +>>>>>>>>>>>> fatmgrid is not given, add RTM mapping file, if fatmlndfrc NOT set set mask/frac to 1. + M models/lnd/clm/src/biogeochem/CASAMod.F90 ------------ Use llatlon%ni/nj in place of lsmlon/lat + don't allow 1D grids for CASA + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------------ Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 ---------- asca => ascale + M models/lnd/clm/src/main/organicFileMod.F90 ----------- Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/main/clm_varpar.F90 --------------- Remove lsmlon/lsmlat parameters + M models/lnd/clm/src/main/clm_timemanager.F90 ---------- Add some meta-data to restart file, check restart values + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Remove cellarea, surfrd gets area + M models/lnd/clm/src/main/fileutils.F90 ---------------- Make iflag required argument + M models/lnd/clm/src/main/ndepStreamMod.F90 ------------ Use llatlon structure in place of lsmlon/lat + M models/lnd/clm/src/main/iniTimeConst.F90 ------------- Remove start/count lsmlon/lsmlat + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add namea grid, replace lsmlon/lat with llatlon + handle unstructured grids + M models/lnd/clm/src/main/controlMod.F90 --------------- If fatmgrid NOT set, use fsurdat, add fmapinp_rtm + if fatmlndfrc NOT set, set mask/frac to 1. + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Add fmapinp_rtm + M models/lnd/clm/src/main/ncdio_pio.F90 ---------------- Add ncd_inqfdims, io_type public, clmlevel set + earlier, remove switchdim from ncd_io_int_var2, handle switchdim in ncd_io_real_var2 read for + singlept + M models/lnd/clm/src/main/surfrdMod.F90 ---------------- Remove surfrd, add surfrd_get_data hande 1D grids + M models/lnd/clm/src/main/domainMod.F90 ---------------- asca=>ascale + M models/lnd/clm/src/main/decompMod.F90 ---------------- Add namea remove get_clmlevel_dsize + M models/lnd/clm/src/main/clmtype.F90 ------------------ Increase len=8 to len=16 + M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Add L2R_Decomp, remove lsmlat/lon for llatlon + remove river meta-data + M models/lnd/clm/src/riverroute/RtmMapMod.F90 ---------- Pass in fracout + M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ------ Use llatlon in place of lsmlat/lon + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 -------- asca=>ascale + +Summary of testing: + + bluefire: All PASS except... +015 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 7 +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +031 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 +035 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 4 + bluefire interactive testing: All PASS except... +009 blC97 TBL.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 5 +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 +037 blAK8 TBL.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 4 +051 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 +004 blS63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +005 smQQ4 TSM.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 4 +006 erQQ4 TER.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -3+-7 cold ............FAIL! rc= 5 +007 brQQ4 TBR.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -5+-5 cold ............FAIL! rc= 5 +008 blQQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 4 +012 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 +014 bl454 TBLtools.sh mkmapgrids tools__ds namelist .............................................FAIL! rc= 5 +016 bl5@4 TBLtools.sh gen_domain tools__ds namelist .............................................FAIL! rc= 5 +024 bl754 TBLtools.sh mksurfdata_map tools__s namelist ..........................................FAIL! rc= 5 +025 sm774 TSMtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 5 +026 bl774 TBLtools.sh mksurfdata_map tools__ds singlept .........................................FAIL! rc= 4 +033 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +037 bl953 TBLscript_tools.sh mkmapdata mkmapdata.sh mkmapdata_if10 ..............................FAIL! rc= 5 +039 bl954 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ......FAIL! rc= 6 +043 bl974 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds FAIL! rc= 6 +045 bl9T4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +047 bl9C4 TBLscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare_hist.clm4_0_34 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare.clm4_0_34 +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare_hist.clm4_0_34 +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare.clm4_0_34 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_34 +BFAIL ERB.ne30_g16.I_1948-2004.bluefire.compare.clm4_0_34 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_34 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_34 + bluefire/PTCLM testing: All PASS + lynx/pgi testing: All FAIL (build issues) + lynx/pgi interactive testing: All PASS except... +010 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 7 +011 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 6 + lynx/CESM extra testing: ... +PASS ERS.ne30_g16.I1850CN.lynx_gnu +PASS ERS.ne30_g16.I1850CN.lynx_intel +PASS ERS.ne30_g16.I1850CN.lynx_pathscale + jaguarpf: All FAIL (system build issue) + jaguarpf interactive testing: All PASS up to... +14 PTCLM.16750_US-UMB_ICN_exit_spinup.PTCLM PASS + jaguarpf/CESM testing: All PASS except... +FAIL PST.f09_g16.I.jaguarpf +FAIL ERI_D.ne30_g16.I1850CN.jaguarpf +TFAIL ERH.ne120_g16.I2000CN.jaguarpf.G.235924 + jaguarpf/CESM additional testing: ... +FAIL ERH.ne120_g16.ICN.jaguarpf +PASS SMS.ne120_g16.I.jaguarpf +FAIL ERS.ne120_g16.I.jaguarpf + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 7 +007 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 6 +008 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 +025 sm978 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds .....FAIL! rc= 6 +026 sm9T4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__dFAIL! rc= 6 +027 sm9C4 TSMscript_tools.sh mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds FAIL! rc= 6 + edinburgh/CESM testing: ... +PASS ERS.ne30_g16.I1850CN.edinburgh_pgi +PASS ERS.ne30_g16.I1850CN.edinburgh_lahey + edinburgh/PTCLM testing: All PASS up to... +14 PTCLM.30770_US-UMB_ICN_exit_spinup.PTCLM PASS + mirage,storm/ifort interactive testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_34 + +Changes answers relative to baseline: + + f09_gx1v6, f19_gx1v6 are similar climate but different because of new RTM mapping files + +=============================================================== +=============================================================== +Tag name: clm4_0_34 +Originator(s): erik (Erik Kluzek) +Date: Thu Aug 18 13:14:01 MDT 2011 +One-line Summary: Bring tcens branch to trunk, fix a few issues + +Purpose of changes: + +Remove -pftlc to mksurfdata.pl. Correct units of H2OSNOTOP, HC, and HCSOI history fields. +Remove fget_archdev. Fix single point restarts from Brenden Rogers (although now there +is a PIO issue). Fix pio error when clm is running at same grid as RTM from Mariana. +Move Tony's "tcens" DART ensemble branch to trunk. Add save statement to ncdio. Have +chkdatmfiles.ncl check both grid and frac files. +Update pio/MCT/scripts/datm/PTCLM/csm_share. + +Bugs fixed (include bugzilla ID): + 1383 (Remove no-VOC and MAXPFT=4 tests) + 1381 (Can't change monthly average files to NOT be one per month) + 1372 (pio problem writing out RTM hist fields at RTM res) + 1361 (Problem with transient compsets for PTCLM) + 1358 (incorrect units for a few history fields) + 1025 (SCM mode can NOT use a global finidat file) (partial) + 1017 (SCM mode can NOT restart) (partial) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1360 (Can't do a ncdump on US-UMB data) + 1392 (US-UMB site has some incorrect data) + 1393 (error when running Gregorian calendar) + 1396 (pio problem reading 2D data with 1st dim=1) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: + Add -ninst_lnd for multiple ensembles of CLM for data assimulation to configure. + Build pio and mct as seperate libraries (add -mct_dir/pio_dir to configure). + + Set multiple instances with NINST_LND env variable in env_mach_pes.xml + (make sure NTASKS_LND is >= NINST_LND) + +Describe any changes made to the namelist: + Remove fget_archdev option (don't try to get input files from archival device). + + Set multiple instances of namelists by creating a "user_nl_clm" directory + + Inside of the directory place + + user_nl_clm ---- namelist changes to make for ALL instances + user_nl_clm_1 -- namelist changes for first instance + user_nl_clm_2 -- namelist changes for first instance + user_nl_clm_3 -- namelist changes for third instance +. +. +. + + build-namelist will create a namelist for each instance of the model being run. + +List any changes to the defaults for the boundary datasets: domain files updated + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + scripts to scripts4_110812 + drv to drvseq4_0_04 + datm to datm8_110811 + csm_share to share3_110803 + mct to MCT2_7_0_110804a + pio to pio1_3_9 + +List all files eliminated: + +>>>>>>>>>> Delete some 4p and non-VOC tests to reduce testing + D models/lnd/clm/test/system/config_files/4p_vorsc_dm + D models/lnd/clm/test/system/config_files/17p_scnv_dm + D models/lnd/clm/test/system/config_files/4p_vorsc_do + D models/lnd/clm/test/system/config_files/17p_scnv_do + D models/lnd/clm/test/system/config_files/_scnv_dh + D models/lnd/clm/test/system/config_files/4p_vorsc_ds + D models/lnd/clm/test/system/config_files/17p_scnv_ds + D models/lnd/clm/test/system/config_files/_scnv_dm + D models/lnd/clm/test/system/config_files/_scnv_do + D models/lnd/clm/test/system/config_files/17p_scnv_m + D models/lnd/clm/test/system/config_files/17p_scnv_o + D models/lnd/clm/test/system/config_files/17p_scnv_s + D models/lnd/clm/test/system/config_files/4p_vorsc_h + D models/lnd/clm/test/system/config_files/4p_vorsc_o + D models/lnd/clm/test/system/config_files/17p_nrscnv_ds + D models/lnd/clm/test/system/config_files/4p_vonrsc_ds + D models/lnd/clm/test/system/config_files/4p_vorsc_dh + D models/lnd/clm/test/system/config_files/17p_scnv_dh + +List all files added and what they do: + +>>>>>>>>>> Add tests for multi-instance + A models/lnd/clm/test/system/config_files/_nrnil3sc_dh + A models/lnd/clm/test/system/config_files/_nrnil3sc_dm + A models/lnd/clm/test/system/config_files/_nil3sc_dh + A models/lnd/clm/test/system/config_files/_nil3sc_dm + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_1 + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_2 + A models/lnd/clm/test/system/nl_files/multi_inst/multi_inst_3 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Remove old tests add new multi-instance tests in + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>> Handle clm* for multi-instance files, remove PFTDATA + M models/lnd/clm/test/system/TCB.sh -- Set pio/mct_dir in configure, send MACFILE + to make, and create clm exec temp for debug mode + M models/lnd/clm/test/system/TBL.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TBR.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TER.sh --- compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMrst_tools.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMpergro.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/TSMscript_tools.sh -- Remove PFTDATA setting + M models/lnd/clm/test/system/TSM.sh - compare clm* for multi-instance, cat lnd_in_000? files + M models/lnd/clm/test/system/input_tests_master -- add new multi_inst tests remove old + M models/lnd/clm/test/system/mknamelist - add quotes + M models/lnd/clm/test/system/README - Remove storm + M models/lnd/clm/test/system/README.testnames -- Add nil tests remove some 4p no-voc + M models/lnd/clm/test/system/TBLrst_tools.sh - compare clm* for multi-instance history + M models/lnd/clm/test/system/CLM_runcmnd.sh - remove storm + M models/lnd/clm/test/system/test_driver.sh -- use glade paths, add mct/pio_dir + add gres setting on jaguarpf, remove PFTDATA, remove storm, update cprnc on lynx + M models/lnd/clm/test/system/config_files/README - add nil3 config + change x resolution from T31 to f19 (no datasets at T31 for glc) + +>>>>>>>>>> Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 --------- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 --- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 -- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 -------- Remove PFTDATA + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 -- Remove PFTDATA + +>>>>>>>>>> Remove PFTDATA and -p option, add -nobreak to cprnc.pl, print out more info + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - Remove PFTDATA + M models/lnd/clm/tools/ncl_scripts/cprnc.pl ----- Add -nobreak + M models/lnd/clm/tools/ncl_scripts/cprnc.ncl ----- Add BREAKONDIFF, print avg/max diffs + +>>>>>>>>>> Add NINST_LND and build with new MCT/PIO where need mct_pio_dir +>>>>>>>>>> Handle user_nl_clm directory for multi-instance + M models/lnd/clm/bld/configure - Add ninst_lnd/mct_dir/pio_dir options + change to work with new MCT/PIO + M models/lnd/clm/bld/config_files/config_definition.xml - add mct_dir/pio_dir/ninst_lnd/ninst_atm + M models/lnd/clm/bld/build-namelist - Add ability to write out multiple ensemble + namelist files, handle multiple infiles, and infile directories for multiple + ensembles + M models/lnd/clm/bld/clm.cpl7.template - handle NINST_LND add user_nl_clm directory + for multiple ensembles + +>>>>>>>>>> Compare grid/frac files, update domain files for datm, handle multiple infiles + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl - compare grid/frac files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Add glc_pio stuff + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - New f45, f10, f09, + f19, T31 domain files + M models/lnd/clm/bld/namelist_files/datm-build-namelist - Be able to handle multiple + infiles + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Add glc_pio settings + +>>>>>>>>>> Handle multi-instance SPMD and files, remove fget_archdev, fix problem +>>>>>>>>>> of running on RTM grid (mvertens), handle scam restart files (still fails +>>>>>>>>>> because of PIO problem) + M models/lnd/clm/src/biogeochem/CNDVMod.F90 - Add inst_suffix to hv files + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 - Handle multiple instances and + multiple instances lnd_in and lnd_modelio.nml namelist files + M models/lnd/clm/src/main/fileutils.F90 -- Remove set_filename and putfil, simplify + getfil to NOT do archival retreival + M models/lnd/clm/src/main/ndepStreamMod.F90 - Handle multi-instances + M models/lnd/clm/src/main/histFileMod.F90 --- Pass mfilt to set_hist_filename, don't + require mfilt to be one if nhtfrq=0, only use monthly form of filenames if + nhtfrq=0 AND mfilt=1 + M models/lnd/clm/src/main/restFileMod.F90 - Handle multi-instance files + M models/lnd/clm/src/main/controlMod.F90 -- Remove fget_archdev + M models/lnd/clm/src/main/clm_varctl.F90 -- Remove fget_archdev, add inst_* vars + M models/lnd/clm/src/main/ncdio_pio.F90 --- Fix problem of running on RTM grid, handle + multi-instance files, pass vardesc to scam_field_offsets, handle landunit + in scam_field_offsets, start/count set for all dims, check that dimension + sizes and names are equal in order to share iodesc + M models/lnd/clm/src/main/spmdMod.F90 ---- spmd_init has LNDID passed in + M models/lnd/clm/src/main/histFldsMod.F90 - Fix units/long_names + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - Handle multi-instances and + multiple instances lnd_in and lnd_modelio.nml namelist files + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- Get LNDID + +Summary of testing: + + bluefire: All PASS except TBL tests and... +>>>>>>> rpointer.lnd_* files empty +017 erX51 TER.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -3+-2 cold ..............FAIL! rc= 7 +018 brX51 TBR.sh _nil3sc_dh clm_std^multi_inst 20020401:3600 10x15 USGS -2+-3 cold ..............FAIL! rc= 11 +>>>>>>> Build fails +020 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 4 +021 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -3+-7 cold ................FAIL! rc= 5 +022 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -5+-5 cold ................FAIL! rc= 5 +>>>>>>> Build fails +028 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 4 +029 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -3+-7 arb_ic ............FAIL! rc= 5 +030 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -5+-5 arb_ic ............FAIL! rc= 5 +>>>>>>> Build fails +032 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 96 cold ...............FAIL! rc= 4 +033 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 5 +034 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 5 + bluefire interactive testing: All PASS except... (pio bug 1396) +031 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +032 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 +036 brAK8 TBR.sh _nrsc_ds clm_std^nl_ptsmode_ocn 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .........FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERS_RLA.f45_f45.I.bluefire -- pio bug 1396 +>>>>>>> Compare fails because of new domain files/new pftdyn +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_33 +BFAIL ERS_RLA.f45_f45.I.bluefire.generate.clm4_0_34 +BFAIL ERS_RLA.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_33 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_33 +FAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare_hist.clm4_0_33 -- only glc map area? +FAIL ERP.f19_g16.IGRCP60CN.bluefire.compare_hist.clm4_0_33 ---- only glc map area? +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_33 +FAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_33 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_33 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare_hist.clm4_0_33 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_33 + bluefire/PTCLM testing: All PASS + jaguarpf interactive testing: All PASS except... +014 erAK4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 7 +015 brAK4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS, except TBL and... (pio bug 1396) +006 erAL4 TER.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 +007 brAL4 TBR.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -5+-5 cold ................FAIL! rc= 5 + mirage,storm/ifort interactive testing: All fail -- problem with pio build + yong/ifort interactive testing: All fail -- problem with pio build + +CLM tag used for the baseline comparison tests if applicable: clm4_0_33 + +Changes answers relative to baseline: No bit-for-bit, except: + + f10_f10, f45_f45, f09_f09, f19_f19, T31_T31, with new domain files + +=============================================================== +=============================================================== +Tag name: clm4_0_33 +Originator(s): erik (Erik Kluzek) +Date: Mon Jul 25 14:34:18 MDT 2011 +One-line Summary: Move changes on release branch over to trunk + +Purpose of changes: + +Move changes from release branch over to trunk. Update README files and documentation. +Add new tools testing. Use if masterproc and iulog for output. Move pft mksurfdata into +inputdata. rh files are t-1. All clm tools namelist items in XML database. Fix tools +Makefiles. Survey testlists, move tests around. Remove clm* from path, add quotes in test +scripts, remove CLM_CESMBLD. Remove getfil in mksurfdata, make fdynuse optional. Add +-nomv to getregional. Cleanup help and improve documentation in scripts and XML database. +Update datm8/scripts/drv/cism/csm_share. Update pergro data. Changes answers because of +drv update to cesm1_0_beta22 version (answers are identical to cesm1_0_beta22). + +Bugs fixed (include bugzilla ID): + 1301 (Add doc on OpenMP fortran tools) + 1329 (Add new tool tests) + 1338 (Move raw pftdata into inputdata in XML database) + 1341 (Error running with crop for a single-point) + 1346 (save history namelist to the rh0 files NOT rh1) + 1351 (Add all CLM tools namelist items to XML) + 1351 (Problem with interpinic on non bluefire machines) + 1353 (Huge "ccsm.log" file) + 1367 (final_spinup stop time isn't right) +data) +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1309 (Problem with building T31 rcp pftdyn files) + 1325 (GDDHARV on hist causes model to die in debug) + 1339 (Increase streams file limit from 1000 to 2000) + 1358 (incorrect units for a few history fields) + 1360 (Can't do a ncdump on US-UMB data) + 1361 (Problem with transient compsets for PTCLM) + 1372 (pio problem writing out RTM hist fields at RTM res) + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1355 (tlai is zero for first two time-steps in CLMSP) + 1326 (Crop and irrigation sims give balance check error) + 1310 (Restart files different over different tasks) + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts/drv/shr/cism/datm + scripts to scripts4_110711 + drv to drvseq3_1_54 + datm to datm8_110624 + csm_share to share3_110717 + cism to cism1_110418 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>> Add new tests for tools + A models/lnd/clm/test/system/TOPtools.sh ------- Ensure different number of threads + give the same answers for tools + A models/lnd/clm/test/system/TBLscript_tools.sh Comparison test for script tools + A models/lnd/clm/test/system/TBLrst_tools.sh --- Comparison test for rst_tools + A models/lnd/clm/test/system/config_files/tools__do ---- Add OpenMP debug config + A models/lnd/clm/test/system/config_files/17p_nrscnv_ds Add non-RTM debug serial CN + +>>>>>>>>>>> Make copies of existing files to inside of +>>>>>>>>>>> individual tools so that tools can be standalone + A models/lnd/clm/tools/mksurfdata/clm_varpar.F90 + A models/lnd/clm/tools/mksurfdata/shr_file_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_timer_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_log_mod.F90 + A models/lnd/clm/tools/mksurfdata/fileutils.F90 + A models/lnd/clm/tools/mksurfdata/shr_const_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_string_mod.F90 + A models/lnd/clm/tools/mksurfdata/clm_varctl.F90 + A models/lnd/clm/tools/mksurfdata/shr_sys_mod.F90 + A models/lnd/clm/tools/mksurfdata/shr_kind_mod.F90 + A models/lnd/clm/tools/mksurfdata/nanMod.F90 + A models/lnd/clm/tools/mksurfdata/Mkdepends + A models/lnd/clm/tools/mksurfdata/clm_varpar.F90 + A models/lnd/clm/tools/mkgriddata/mkvarpar.F90 + A models/lnd/clm/tools/mkgriddata/clm_varctl.F90 + A models/lnd/clm/tools/mkgriddata/clm_varpar.F90 + A models/lnd/clm/tools/mkgriddata/shr_sys_mod.F90 + A models/lnd/clm/tools/mkgriddata/shr_log_mod.F90 + A models/lnd/clm/tools/mkgriddata/ncdio.F90 + A models/lnd/clm/tools/mkgriddata/shr_kind_mod.F90 + A models/lnd/clm/tools/mkgriddata/shr_const_mod.F90 + A models/lnd/clm/tools/mkgriddata/domainMod.F90 + A models/lnd/clm/tools/mkgriddata/areaMod.F90 + A models/lnd/clm/tools/mkgriddata/nanMod.F90 + A models/lnd/clm/tools/mkgriddata/Mkdepends + A models/lnd/clm/tools/mkdatadomain/Mkdepends + A models/lnd/clm/tools/mkdatadomain/shr_kind_mod.F90 + A models/lnd/clm/tools/mkdatadomain/shr_const_mod.F90 + +>>>>>>>>>>> Add new README files to talk about testing and file copies + A models/lnd/clm/tools/README.testing + A models/lnd/clm/tools/README.filecopies + +>>>>>>>>>>> Add a new chapter for PTCLM + A models/lnd/clm/doc/UsersGuide/ptclm.xml + +List all existing files that have been modified, and describe the changes: + + +>>>>>>>>>>> Remove CLM_CESMBLD, remove clm* in pathname, add quotes in tests +>>>>>>>>>>> fix some spelling and unused vars, add new scripts tests +M models/lnd/clm/test/system/TCB.sh -------------- Remove CLM_CESMBLD +M models/lnd/clm/test/system/TSMncl_tools.sh ----- Remove clm* in pathname +M models/lnd/clm/test/system/TBL.sh -------------- Remove clm* in pathname +M models/lnd/clm/test/system/README.testnames ---- Update for new tests +M models/lnd/clm/test/system/TBR.sh -------------- Remove unused cfgdir +M models/lnd/clm/test/system/TCBtools.sh --------- Remove clm* in pathname, fix spelling +M models/lnd/clm/test/system/TER.sh -------------- Remove unused cfgdir +M models/lnd/clm/test/system/test_driver.sh ------ Remove CLM_CESMBLD, change temp on lynx +M models/lnd/clm/test/system/TSMrst_tools.sh ----- Remove unused cfgdir, add quotes + in comparison +M models/lnd/clm/test/system/nl_files/getregional - Add -nomv option in +M models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 - Put -exedir last +M models/lnd/clm/test/system/input_tests_master --- Add TBLtools, TOPtools, + TBLrst_tools, TBLscript_tools tests in +M models/lnd/clm/test/system/TSMtools.sh ---------- Add CLM_RERUN (needed for + TOPtools which runs the same test over for different threads) + Remove clm* from path add quotes to some if tests +M models/lnd/clm/test/system/TBLtools.sh ---------- Remove clm* from path + +>>>>>>>>>>> Move tests around a bit +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi +M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi - Add TOP test +M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>> Make fdynuse file optional and remove use of getfil +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 ---- Remove fdynuse file, + remove use of getfil, all averaging is the same (no *_pft options) +M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 --- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/creategridMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 - Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkvocefMod.F90 -- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkglacierMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 Remove use of getfil +M models/lnd/clm/tools/mksurfdata/areaMod.F90 ----- Remove _pft methods +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Make mksrf_fdynuse optional + remove use of getfil +M models/lnd/clm/tools/mksurfdata/mklanwatMod.F90 - Remove use of getfil +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ---- Remove use of getfil +M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt -- new paths + +>>>>>>>>>>> Updated RMS differences, and add -nomv option to getregional_datasets +M models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat ---------- Updated RMS differences +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add -nomv option +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Add NOMV env var + +>>>>>>>>>>> Fix bug 1351 +M models/lnd/clm/tools/interpinic/interpinic.F90 -------- Make sure: htop_var, + fpcgrid_var, present_var, itypveg_var are set +M models/lnd/clm/tools/interpinic/interpinic.runoptions - Update the input file to use + +>>>>>>>>>>> Work on formatting, remove use of getfils +M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 - Work on formatting a bit, + removed use of fileutils +M models/lnd/clm/tools/mkgriddata/areaMod.F90 ---- Remove use of getfil +M models/lnd/clm/tools/mkdatadomain/create_domain.F90 - Work on output write + +>>>>>>>>>>> Update documentation in README files +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/bld/namelist_files/use_cases/README +M models/lnd/clm/test/system/README +M models/lnd/clm/tools/mkgriddata/README +M models/lnd/clm/tools/mkdatadomain/README +M models/lnd/clm/tools/interpinic/README +M models/lnd/clm/tools/README.testing +M models/lnd/clm/tools/README +M models/lnd/clm/bld/README + +>>>>>>>>>>> Sync up tools Makefile, make Filepath standalone (only includes .) +>>>>>>>>>>> Work on formatting, set OPT default, add TOOLROOT default +>>>>>>>>>>> compare to null instead of strip +M models/lnd/clm/tools/mksurfdata/Makefile +M models/lnd/clm/tools/mksurfdata/Filepath +M models/lnd/clm/tools/mksurfdata/Srcfiles - Remove spmdMod,fileutils, + abortutils/shr_cal_mod, ESMF, mpi, shr_mpi_mod +M models/lnd/clm/tools/interpinic/Makefile +M models/lnd/clm/tools/mkgriddata/Filepath +M models/lnd/clm/tools/mkgriddata/Srcfiles - Remove fileutils,spmdMod, + abortutils,shr_timer_mod,shr_mpi_mod,shr_file_mod,MPI +M models/lnd/clm/tools/mkgriddata/Makefile +M models/lnd/clm/tools/mkdatadomain/Filepath +M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>> Cleanup help and documentation +M models/lnd/clm/bld/configure --------------- Cleanup help, remove cesm_bld +M models/lnd/clm/bld/queryDefaultNamelist.pl - Cleanup help +M models/lnd/clm/bld/listDefaultNamelist.pl -- Add more description, documentation + set maxpft for crop +M models/lnd/clm/bld/build-namelist ---------- Cleanup help, add papi_inparm + remove some list options for non-CLM vars +M models/lnd/clm/bld/clm.cpl7.template ------- Remove clm* in path + remove warning about CAM and CLM dtime, remove comment about *.h files + +>>>>>>>>>>> Make sure all 1x1 files are in supported single-point res +M models/lnd/clm/bld/config_files/config_definition.xsl - Add CLM in descriptions +M models/lnd/clm/bld/config_files/config_definition.xml - Add + 1x1_numaIA,1x1_smallvilleIA to supported single-point resolutions + cleanup spelling and a few descriptions + +>>>>>>>>>>> Work on documentation descriptions, document all tools namelist items +M models/lnd/clm/bld/namelist_files/checklatsfiles.ncl --------- Add doc, continue + if file NOT found rather than abort +M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl --------- Add doc, continue + if file NOT found rather than abort +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Work on descriptions, + add in all mksurfdata/mkdatadomain/mkgriddata namelist vars, add in + new driver namelist vars (so documented in table in UG), + add HCN,CH3CN to drydep +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add datasource + small formatting change +M namelist_files/namelist_defaults_drv.xml --------------------- Fix final_spinup + (bug 1367) +M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ------ Add attributes + to output for: crop, irrig, ad_spinup, and source +M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ---- Work to improve + output formatting of table +M models/lnd/clm/bld/namelist_files/datm-build-namelist -------- Cleanup help / source +M models/lnd/clm/bld/namelist_files/checktopofiles.ncl --------- Change res list, + add documentation, continue rather than abort if file not found +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Update paths + to landuse for mksurfdata as all in repo now, add default values for + other mksurfdata namelist items + +>>>>>>>>>>> Update documentation for latest release +M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml +M models/lnd/clm/doc/UsersGuide/single_point.xml +M models/lnd/clm/doc/UsersGuide/special_cases.xml +M models/lnd/clm/doc/UsersGuide/tools.xml +M models/lnd/clm/doc/UsersGuide/limitLineLen.pl +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/UsersGuide/clm_ug.xml +M models/lnd/clm/doc/UsersGuide/adding_files.xml +M models/lnd/clm/doc/UsersGuide/appendix.xml +M models/lnd/clm/doc/UsersGuide/custom.xml +M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>>>>>> Update documentation for latest release +M models/lnd/clm/doc/Quickstart.userdatasets +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE +M models/lnd/clm/doc/CodeReference/Filepath +M models/lnd/clm/doc/KnownLimitations +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/README +M README + +>>>>>>>>>>> Add if masterproc, work on documentation, use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CropRestMod.F90 ---------- Add if masterproc +M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- Cleanup endrun statement +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CNDVMod.F90 -------------- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Use iulog NOT unit 6 +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Ensure arepr is initialized + (bug 1341) +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Comment out debug write +M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 - Use iulog NOT unit 6 + +>>>>>>>>>>> Add if masterproc, work on documentation, rh files are t-1 +M models/lnd/clm/src/main/fileutils.F90 --- Add if masterproc +M models/lnd/clm/src/main/pftdynMod.F90 --- Add if masterproc (fix bug 1353) +M models/lnd/clm/src/main/histFileMod.F90 - Add if masterproc, rh files are t-1 + (bug 1346) +M models/lnd/clm/src/main/clmtype.F90 ----- Work on documentation + + +Summary of testing: + + bluefire: All PASS except... (up to 43) +004 blC91 TBL.sh _sc_dh clm_std^nl_urb 20030101:3600 4x5 gx3v7 -6 arb_ic ........................FAIL! rc= 5 +008 blTZ1 TBL.sh 21p_cncrpsc_dh clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 +011 blD91 TBL.sh _persc_dh clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 5 +015 blEH1 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021231:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic ......FAIL! rc= 5 +019 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:1800 1.9x2.5 gx1v6@1850-2100 -10 cold FAIL! rc= 5 +023 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:1800 10x15 USGS@2000 -90 cold ..................FAIL! rc= 5 +027 blHo1 TBL.sh 17p_cnsc_dh clm_drydep 20000101:1800 10x15 USGS@2000 -10 cold ..................FAIL! rc= 5 +028 smG41 TSM.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 10 +029 erG41 TER.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +030 brG41 TBR.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +031 blG41 TBL.sh 17p_scnv_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 4 +035 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 5 +039 blG61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:1800 1.9x2.5 gx1v6 48 startup .................FAIL! rc= 5 +043 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 48 cold ...............FAIL! rc= 5 + bluefire interactive testing: All PASS except TBL tests + bluefire/CESM testing: All PASS except compare tests to clm4_0_32 + bluefire/CESM extra testing (show that answers are identical with cesm1_0_beta22): +PASS ERI.T31_g37.IGCN.bluefire +PASS ERI.T31_g37.IGCN.bluefire.compare.cesm1_0_alpha22a +PASS ERS.T31_g37.ITEST.bluefire +PASS ERS.T31_g37.ITEST.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.T31_g37.ITEST.bluefire.compare.cesm1_0_alpha22a +PASS ERS.f19_g16.IGCN.bluefire +PASS ERS.f19_g16.IGCN.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.f19_g16.IGCN.bluefire.compare.cesm1_0_alpha22a +PASS ERS.f45_g37.I4804.bluefire +PASS ERS.f45_g37.I4804.bluefire.compare_hist.cesm1_0_alpha22a +PASS ERS.f45_g37.I4804.bluefire.compare.cesm1_0_alpha22a +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLA.f45_f45.I.bluefire.compare_hist.cesm1_0_alpha22a +PASS SMS_RLA.f45_f45.I.bluefire.compare.cesm1_0_alpha22a +PASS SMS_RLB.f45_f45.ITEST.bluefire +PASS SMS_RLB.f45_f45.ITEST.bluefire.compare_hist.cesm1_0_alpha22a +PASS SMS_RLB.f45_f45.ITEST.bluefire.compare.cesm1_0_alpha22a + jaguarpf interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 5 +008 blTZ3 TBL.sh 21p_cncrpsc_do clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS -10 cold ..........FAIL! rc= 5 +012 blVU4 TBL.sh 21p_cncrpsc_ds clm_stdIgnYr^nl_crop 20020101:3600 1x1_smallvilleIA test -1100 cold FAIL! rc= 5 +014 blAK4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 +015 smG43 TSM.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 10 +016 erG43 TER.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +017 brG43 TBR.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic .........FAIL! rc= 5 +018 blG43 TBL.sh 17p_scnv_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ...........FAIL! rc= 4 +022 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -670 arb_ic .................FAIL! rc= 5 +026 blSn3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arFAIL! rc= 5 +030 blQQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -150 cold .............FAIL! rc= 5 +034 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 5 +038 blS63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 5 +040 bl8Z3 TBLrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6FAIL! rc= 5 +042 bl954 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_10x15_irr_1850^tools__ds ..........FAIL! rc= 6 +046 bl9T4 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__ds FAIL! rc= 6 +050 bl9C4 TBLscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds ...FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS except... +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 7 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 7 + edinburgh/lf95 testing: All PASS except TBL tests + lynx/intel testing: All PASS except TBL tests + +CLM tag used for the baseline comparison tests if applicable: clm4_0_32 + +Changes answers relative to baseline: Yes (Driver change) + + But, answers are identical to cesm1_0_beta22 where the driver change + was already in effect. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: larger than roundoff/same climate + +=============================================================== +=============================================================== +Tag name: clm4_0_32 +Originator(s): erik (Erik Kluzek) +Date: Thu May 19 15:18:49 MDT 2011 +One-line Summary: Make I1850SPINUPCN compset use MOAR data, various bug fixes, work on test lists + +Purpose of changes: + +Update datm and scripts so can run I1850SPINUPCN compset with MOAR data. Fix CN units. +Fix some documentation for crop. Add attribute that notes that flux variables are NOT +multiplied by landfrac. Change align year for I4804 and I4804CN compsets, add append/warn +option to xmlchange. Some clarifications to clm namelist. build-namelist can run list +options without a config_cache file. Add comment/title to output files. Remove the +2.65x3.33 grid, no longer supported. Work on test lists a bit. + +Bugs fixed (include bugzilla ID): + 1337 (have ISPINUPCN compset use MOAR data) + 1336 (evaluate CLM testing for release) + 1327 (correct documentation of CN variable units) + 1158 (make 4804 compsets consistent with 1850 etc.) + 1151 (remove co2_ppmv when co2_type is NOT constant) + 1140 (build-namelist -list options die with config file) + 1108 (have append/warn mode for xmlchange) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1325 (GDDHARV on hist causes model to die in debug) + 1367 (final_spinup stop time isn't right) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: + + I1850SPINUP compset changed to use MOAR data + + DATM_CPL_* variables added to env_conf.xml to set casename, years run over + I4804 compsets ALIGN year changed to agree with doc. and I1850 compsets + + New options to xmlchange -- allow you to append (-a) to the end of something already + there and another option (-w) warn you and abort if already set. + +Describe any changes made to the namelist: Add options to build-namelist + + Add -co2_ppmv and -rtm_tstep options to set co2_ppmv when co2_type is constant + and set rtm time-step when RTM is on. + + This way co2_ppmv and rtm_nsteps do NOT show up in the namelist if they aren't needed. + +List any changes to the defaults for the boundary datasets: Remove 2.65x3.33 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, slevis (units change), sacks (crop doc) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm + scripts to scripts4_110517 + csm_share to share3_110516 + datm to datm8_110517b + +List all files eliminated: + +>>>>>>>>>>>>> Remove as no longer needed to get lists for documentation + D models/lnd/clm/doc/UsersGuide/config_cache.xml + +List all files added and what they do: + +>>>>>>>>>>>>> Add new test configurations + A models/lnd/clm/test/system/config_files/_scnv_dm + A models/lnd/clm/test/system/config_files/17p_scnv_dm + A models/lnd/clm/test/system/config_files/17p_scnv_ds + A models/lnd/clm/test/system/config_files/17p_nrcnsc_do + A models/lnd/clm/test/system/config_files/17p_nrcnsc_ds + A models/lnd/clm/test/system/config_files/17p_scnv_m + A models/lnd/clm/test/system/config_files/17p_scnv_o + A models/lnd/clm/test/system/config_files/17p_scnv_s + A models/lnd/clm/test/system/config_files/17p_cnnfsc_dh -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/17p_cnnfsc_dm -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/17p_cnnfsc_do -- turn on NOFIRE + A models/lnd/clm/test/system/config_files/21p_nrcncrpsc_s + A models/lnd/clm/test/system/config_files/21p_nrcncrpsc_ds + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README + +>>>>>>>>>>>>> Change tests a bit to make them more consistent with naming convention +>>>>>>>>>>>>> make sure tests are covered, and have no-RTM tests for single-point + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/nl_files/clm_spin --- Use MOAR data on bluefire + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>>>>>> Change test lists + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_jaguarpf + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_posttag_lynx + +>>>>>>>>>>>>> Add -co2_ppmv, and -rtm_tstep options to build-namelist +>>>>>>>>>>>>> Don't require config file for build-namelist list options +>>>>>>>>>>>>> Remove 2.65x3.33 files, add capability to handle MOAR data + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/clm.cpl7.template + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/datm-build-namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>>>> Correct documentation of units from kg to g + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 -- Also documentation changes + from Bill Sacks + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 + +>>>>>>>>>>>>> Add title and comment attributes to output files + M models/lnd/clm/src/main/histFileMod.F90 + M models/lnd/clm/src/main/restFileMod.F90 + +Summary of testing: + + bluefire interactive testing: All PASS up to... +006 smC97 TSM.sh _sc_do clm_spin^nl_urb 20030101:1800 4x5 gx3v7@1850 -6 arb_ic ..................FAIL! rc= 10 + bluefire/CESM testing: All PASS except... +BFAIL PST.f45_g37.I1850CN.bluefire.compare.clm4_0_31 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_31 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_31 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_31 +Originator(s): erik (Erik Kluzek) +Date: Fri May 13 17:11:38 MDT 2011 +One-line Summary: Fix answers for transient_CN, fix interpinic + +Purpose of changes: + +Fix interpinic test with finidat files. Fix CNPrecisionControl so answers with transient +CN are same as clm4_0_26 without crop. + +Bugs fixed (include bugzilla ID): + 1335 (transient_CN sometimes different than clm4_0_26) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1325 (GDDHARV on hist causes model to die in debug) + 1367 (final_spinup stop time isn't right) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>>>> Add transient 20th Century namelist config + A models/lnd/clm/test/system/nl_files/clm_transient_20thC + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add f19 transient-CN tests that start in 1979 (which showed bug 1335) + M models/lnd/clm/test/system/input_tests_master - Add f19 transient CN tests + Also make glc_nec interpinic test run for f09@1850 + M models/lnd/clm/test/system/README.testnames --- Add run-4 for f19 transient CN + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ------ Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_purempi_regression - Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_hybrid_regression -- Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi ------ Add f19 transient_CN +test + M models/lnd/clm/test/system/tests_posttag_nompi_regression --- Add f19 transient_CN +test + +>>>>>>>>>>>>>> Put changes from clm4_0_27 back in except those that cause runs to fail + M models/lnd/clm/tools/interpinic/interpinic.F90 + M models/lnd/clm/tools/interpinic/Srcfiles ------ Add shr_const_mod.F90 back in + +>>>>>>>>>>>>>> + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Add if ( crop_prog ) to + a crop change that needed it + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Remove pft_ctrunc not used + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Remove pft_ctrunc not used + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 -------- Set wesveg for crop_prog + +Summary of testing: + + bluefire extra interactive testing: +001 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS +001 sm893 TSMrst_tools.sh _sc_do interpinic clm_std^nl_urb 20000101:1800 1.9x2.5 gx1v6 4x5 gx3v7 -1 PASS +001 sm857 TSMrst_tools.sh 17p_cnsc_o interpinic clm_std^nl_urb 18500101:1800 1.9x2.5 gx1v6@1850 10x1PASS +002 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_stdIgnYr^nl_crop 20000101:1800 1.9x2.5 gx1v6PASS +003 sm813 TSMrst_tools.sh 17p_cndvsc_do interpinic clm_std^nl_urb 18500101:1800 1.9x2.5 gx1v6@1850 4PASS +>>>>> This test compares to clm4_0_30 and rightly shows that answers change +001 blH43 TBL.sh 17p_cnsc_do clm_transient_20thC 19790101:1800 1.9x2.5 gx1v6@1850-2000 -10 startup FAIL! rc= 7 + bluefire/CESM testing: All PASS except... (why did these comparisons PASS in clm4_0_27) +BFAIL ERP.f19_g16.IGRCP60CN.bluefire.compare.clm4_0_30 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_30 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_30 + bluefire/CESM testing compared to cesm1_0_beta19: +PASS SMS_D.f09_g16.BRCP45CN.bluefire +PASS SMS_D.f09_g16.BRCP45CN.bluefire.compare_hist.cesm1_0_beta19 +PASS SMS_D.f09_g16.BRCP45CN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f09_f09.FAMIPCN.bluefire +PASS ERS.f09_f09.FAMIPCN.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f09_f09.FAMIPCN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPC5.bluefire +PASS ERS.f19_f19.FAMIPC5.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPC5.bluefire.compare.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPCN.bluefire +PASS ERS.f19_f19.FAMIPCN.bluefire.compare_hist.cesm1_0_beta19 +PASS ERS.f19_f19.FAMIPCN.bluefire.compare.cesm1_0_beta19 +PASS ERS.f09_g16.BRCP45CN.lynx_pgi +PASS ERS.f09_g16.BRCP45CN.lynx_pgi.compare_hist.cesm1_0_beta19 +PASS ERS.f09_g16.BRCP45CN.lynx_pgi.compare.cesm1_0_beta19 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_30 + +Changes answers relative to baseline: Some transient_CN tests are different + because of bug 1335 introduced in clm4_0_27 + + With these changes answers are the same as clm4_0_26 + +=============================================================== +=============================================================== +Tag name: clm4_0_30 +Originator(s): erik (Erik Kluzek) +Date: Wed May 11 14:32:19 MDT 2011 +One-line Summary: New finidat/fsurdat files for T31 + +Purpose of changes: + +Externals update, fix some PTCLM problems. New finidat/fsurdat files for T31, make sure +works. + +Bugs fixed (include bugzilla ID): + 1279 (Latest version of PTCLM requires python2.5) + 1248 (PTCLM can only go to 2005) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1325 (GDDHARV on hist causes model to die in debug) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New finidat files for T31 + New fsurdat file for T31@2000 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, mct, pio + + scripts to scripts4_110511 + mct to MCT2_7_0_110504a + pio to pio1_3_0 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/17p_cnsc_h + A models/lnd/clm/test/system/config_files/17p_cnsc_o + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/README.testnames --- Add R f19 rcp4.5 resol + M models/lnd/clm/test/system/input_tests_master - Make some tests startup, add + some rcp tests, change some tests from T31 to f19 + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add new finidat + files for T31@1850/2000, add new surdata file for T31@2000, remove empty + half-degree pftdyn file + +Summary of testing: + + bluefire: All PASS except... +024 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +026 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +049 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 +054 erJ61 TER.sh 4p_casasc_dh clm_std^nl_urb 20021230:1800 1.9x2.5 gx1v6 10+38 cold .............FAIL! rc= 5 +055 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:1800 1.9x2.5 gx1v6 72+72 cold ..........FAIL! rc= 5 +056 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:1800 1.9x2.5 gx1v6 48 cold ................FAIL! rc= 4 + bluefire interactive testing: All PASS + bluefire extra interactive testing: +001 smE13 TSM.sh 17p_vorsc_do clm_std^nl_urb 20021230:1800 48x96 gx3v7 96 startup ...............PASS +001 smH13 TSM.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:1800 48x96 gx3v7@1850-2000 96 startup PASS + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_29 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_29 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_29 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_29 +BFAIL ERS_E.T31_g37.I1850.bluefire.compare.clm4_0_29 +BFAIL ERI.T31_g37.IG1850.bluefire.compare.clm4_0_29 +BFAIL ERS_D.f19_g16.IGRCP26CN.bluefire.compare.clm4_0_29 + + bluefire/CESM rcps extra testing: All PASS... +PASS SMS.f09_g16.IRCP26CN.bluefire +PASS SMS.f09_g16.IRCP45CN.bluefire +PASS SMS.f09_g16.IRCP60CN.bluefire +PASS SMS.f09_g16.IRCP85CN.bluefire +PASS SMS.f09_g16.IGRCP26CN.bluefire +PASS SMS.f09_g16.IGRCP45CN.bluefire +PASS SMS.f09_g16.IGRCP60CN.bluefire +PASS SMS.f09_g16.IGRCP85CN.bluefire +PASS SMS.f19_g16.IRCP26CN.bluefire +PASS SMS.f19_g16.IRCP45CN.bluefire +PASS SMS.f19_g16.IRCP60CN.bluefire +PASS SMS.f19_g16.IGRCP45CN.bluefire +PASS SMS.f19_g16.IGRCP85CN.bluefire + + bluefire/PTCLM testing: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_29 + +Changes answers relative to baseline: no bit-for-bit (except T31 with new files) + +=============================================================== +=============================================================== +Tag name: clm4_0_29 +Originator(s): erik (Erik Kluzek) +Date: Thu May 5 14:19:04 MDT 2011 +One-line Summary: Backout interpinic changes to one that works + +Purpose of changes: + +Backout interpinic to Mariana's non2dgrid version. Won't work for new +files (have to remove fields to get it to work). Adds back in bugs 1318 and 1319. +Add more comparison tests for tools and add cprnc.pl/ncl scripts to compare files that +don't have a time-axis. + +Bugs fixed (include bugzilla ID): + 1328 (interpinic gives bad results that can NOT be used!) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1325 (GDDHARV on hist causes model to die in debug) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>>>> Add scripts to compare two NetCDF files and report if different +>>>>>>>>>>>>>> This mimic's the cprnc program, but also works on files without +>>>>>>>>>>>>>> a time coordinate. For big files it's considerably slower as well. + A models/lnd/clm/tools/ncl_scripts/cprnc.pl + A models/lnd/clm/tools/ncl_scripts/cprnc.ncl + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add tool comparison tests, use cprnc.pl for tool comparison + M models/lnd/clm/test/system/input_tests_master - Add TBLtools test for: + mkgriddata, mksurfdata, mkdatadomain, and interpinic, remove pftdyn + mksurfdata test + M models/lnd/clm/test/system/CLM_compare.sh ----- Remove unused variable + M models/lnd/clm/test/system/TSMtools.sh -------- Copy .txt files over if exist + M models/lnd/clm/test/system/TBLtools.sh -------- Use cprnc.pl in place of cprnc binary + +>>>>>>>>>>>>>> Add tool comparison tests + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Add notes on cprnc tools + M models/lnd/clm/tools/ncl_scripts/README + +>>>>>>>>>>>>>> Move back to Mariana's version of interpinic in non2dgrid08_clm4_0_26 +>>>>>>>>>>>>>> This means it won't work for new files, but will work for older files +>>>>>>>>>>>>>> and gives the same answers as the non2dgrid version. + M models/lnd/clm/tools/interpinic/interpinic.F90 + M models/lnd/clm/tools/interpinic/Srcfiles + + +Summary of testing: + + bluefire interactive testing: These PASS + +002 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS (same as non2dgrid08_clm4_0_26) +001 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................PASS +002 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................PASS +001 bl654 TBLtools.sh mkgriddata tools__ds namelist .............................................PASS +001 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................PASS +002 blZ94 TBLtools.sh mkdatadomain tools__ds namelist ...........................................PASS + + yong/ifort interactive testing: These PASS + +001 bl853 TBLtools.sh interpinic tools__o runoptions ............................................PASS (same as non2dgrid08_clm4_0_26) + +CLM tag used for the baseline comparison tests if applicable: clm4_0_28 + +Changes answers relative to baseline: no bit-for-bit (except interpinic) + +=============================================================== +=============================================================== +Tag name: clm4_0_28 +Originator(s): erik (Erik Kluzek) +Date: Tue May 3 09:14:24 MDT 2011 +One-line Summary: Remove DUST/PROGSSLT in land coupler layer, update driver and scripts + +Purpose of changes: + +Update drv to branch version, fix ram1/fv issue (remove DUST/PROGSSLT #ifdef's in +lnd_comp_*). Answers will then be identical to clm4_0_26 (except air density sent to +cpl). Don't allow both -irrig and -crop to be on at same time in scripts. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1325 (GDDHARV on hist causes model to die in debug) + 1328 (interpinic gives bad results that can NOT be used!) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): drv, scripts + scripts to scripts4_110428a + drv to branch version: t3148b_tags/t3148b02_drvseq3_1_48 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/build-namelist - Don't allow crop and irrig on at same time + + M models/lnd/clm/tools/interpinic/interpinic.F90 -------- Move input read up + M models/lnd/clm/tools/interpinic/interpinic.runoptions - Use latest input file + + M models/lnd/clm/test/system/tests_pretag_bluefire -- Remove some tests + M models/lnd/clm/test/system/README.testnames ------- Don't mix crop and irrig + M models/lnd/clm/test/system/input_tests_master ----- Change irrig+crop tests to + just crop + + +>>>>>>>>>> Remove DUST, PROGSSLT and VOC #ifdef's + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + +Summary of testing: + + bluefire: All PASS except... +024 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +026 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +049 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +050 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +051 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +052 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +058 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (compare to clm4_0_26 with updated datm) +SFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.GC.160557 +SFAIL ERP.T31_g37.IGRCP60CN.bluefire.GC.160557 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_26_datmdens +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_26_datmdens + +CLM tag used for the baseline comparison tests if applicable: clm4_0_27 + +Changes answers relative to baseline: No bit-for-bit + Although coupler log file will show changes in fv and ram1 to clm4_0_27, but + will be identical to clm4_0_26 (although then dens in atm changes) + +=============================================================== +=============================================================== +Tag name: clm4_0_27 +Originator(s): erik (Erik Kluzek) +Date: Mon May 2 09:37:57 MDT 2011 +One-line Summary: Move crop branch over to trunk + +Purpose of changes: + +Move crop branch to trunk. Add crop and noio options to configure. maxpft option to +configure can now only be a number (removing numpft+1 option to it). Add datasets for +crop. Add T31 historical and rcp2.6 transient dynpft datasets. Remove some of the CPP +tokens (DUST, PROGSSLT, etc.) Bring Marian Vertensteins version of interpinic over to the +trunk as well. This version is faster and is able to run for higher resolution cases. +Remove scaled_harvest and carbon_only namelist options and add suplnitro option +(supplemental Nitrogen which can be: NONE, PROG_CROP_ONLY, or ALL). Add number parameters +for the different nsrest settings, and have only one copy of is_restart in +clm_time_manager. Update to ESMF interface from Tony. + +Bugs fixed (include bugzilla ID): + 1323 (Remove some unused items) + 1319 (interpinic doesn't interpolate *_PERIOD) + 1318 (interpinic has trouble with new restart files) + 1303 (remove complexity of no-urban in interpinic) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 901 (remove some CPP tokens) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1299 (interpinic does NOT work going from non glc_mec) + 1325 (GDDHARV on hist causes model to die in debug) + 1328 (interpinic gives bad results that can NOT be used!) + 1335 (transient_CN sometimes different than clm4_0_26) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Yes + + Add -crop and -noio options to configure, remove -dust and -progsslt options + Remove "numpft+1" option to -maxpft. maxpft can go up to 17 without crop and + needs to be 21 for crop. + + -crop adds the CROP #ifdef. Removes the DUST, PROGSSLT, CLAMP CPP tokens. + Also remove: DISTURB, COUP_WRF, NO_DAYLEN_VCMAX, TCX_REMOVE_SEE_NOTES_ABOVE, and + L2R_Decomp, and some testing/debug CPP defines + +Describe any changes made to the namelist: Yes + + Remove Carbon_only and scaled_harvest options + Add suplnitro option which can be set to: NONE, PROG_CROP_ONLY, or ALL + + Add new history output variables: + + A5TMIN 5-day running mean of min 2-m temperature (K) + A10TMIN 10-day running mean of min 2-m temperature (K) + GDD0 Growing degree days base 0C from planting (ddays) + GDD8 Growing degree days base 8C from planting (ddays) + GDD10 Growing degree days base 10C from planting (ddays) + GDD020 Twenty year average of growing degree days base 0C from planting (ddays) + GDD820 Twenty year average of growing degree days base 8C from planting (ddays) + GDD1020 Twenty year average of growing degree days base 10C from planting (ddays) + GDDPLANT Accumulated growing degree days past planting date for crop (ddays) + GDDHARV Growing degree days (gdd) needed to harvest (ddays) + GDDTSOI Growing degree-days from planting (top two soil layers) (ddays) + +List any changes to the defaults for the boundary datasets: + New point mode for crop: 1x1_numaIA and 1x1_smallvilleIA + pftcon: pft-physiology.c110425.nc + surface datasets for crop mode for: f19, f10, 1x1_numaIA, and 1x1_smallvilleIA + (also crop datasets with crop AND irrigation on) + finidat file for crop for f19 + New T31 pftdyn file for historical and rcp2.6 + Raw veg and lai datasets for mksurfdata for crop + +Describe any substantial timing or memory changes: Crop adds some additional variables + and if checks that may make small differences in run-time and/or memory + +Code reviewed by: self, slevis + +List any svn externals directories updated (csm_share, mct, etc.): Almost all + + scripts to scripts4_110421 + share to share3_110411 + drv to drvseq3_1_53 + datm to datm8_110419 + stubs to stubs1_2_04 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove test configs that explicitly have dust + D models/lnd/clm/test/system/config_files/4p_vodsrsc_dh + D models/lnd/clm/test/system/config_files/4p_vodsrsc_dm + D models/lnd/clm/test/system/config_files/4p_vodsrsc_do + D models/lnd/clm/test/system/config_files/4p_vodsrsc_ds + D models/lnd/clm/test/system/config_files/17p_vodsrsc_h + D models/lnd/clm/test/system/config_files/17p_vodsrsc_m + D models/lnd/clm/test/system/config_files/17p_vodsrsc_o + D models/lnd/clm/test/system/config_files/17p_vodsrsc_dh + D models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + D models/lnd/clm/test/system/config_files/17p_vodsrsc_dm + D models/lnd/clm/test/system/config_files/17p_vodsrsc_do + D models/lnd/clm/test/system/config_files/4p_vodsrsc_h + D models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + D models/lnd/clm/test/system/config_files/4p_vodsrsc_o + +>>>>>>>>>>>>>>> Remove test for scaled_harvest namelist item + D models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + +>>>>>>>>>>>>>>> Remove sample namelists and always use mksurfdata.pl script + D models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig + D models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn + +>>>>>>>>>>>>>>> Remove these two from changes that mvertens applied + D models/lnd/clm/tools/interpinic/addglobal.F90 + D models/lnd/clm/tools/interpinic/wrap_nf.F90 + +>>>>>>>>>>>>>>> Update sample IC file + D models/lnd/clm/tools/interpinic/clmi.IQ.1953-01-01_10x15_USGS_simyr2000_c081202.nc + +List all files added and what they do: + +>>>>>>>>>>>>>>> Add crop test configs + A models/lnd/clm/test/system/config_files/21p_cncrpsc_do + A models/lnd/clm/test/system/config_files/21p_cncrpsc_s + A models/lnd/clm/test/system/config_files/21p_cncrpsc_ds + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dh + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_dm + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_do + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_ds + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_h + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_m + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_o + A models/lnd/clm/test/system/config_files/21p_cndvcrpsc_s + A models/lnd/clm/test/system/config_files/21p_cncrpsc_h + A models/lnd/clm/test/system/config_files/21p_cncrpsc_dh + A models/lnd/clm/test/system/config_files/21p_cncrpsc_m + A models/lnd/clm/test/system/config_files/21p_cncrpsc_o + A models/lnd/clm/test/system/config_files/21p_cncrpsc_dm +>>>>>>>>>>>>>>> Add test configs without dust + A models/lnd/clm/test/system/config_files/4p_vorsc_dm + A models/lnd/clm/test/system/config_files/4p_vorsc_do + A models/lnd/clm/test/system/config_files/4p_vorsc_ds + A models/lnd/clm/test/system/config_files/17p_vorsc_h + A models/lnd/clm/test/system/config_files/17p_vorsc_m + A models/lnd/clm/test/system/config_files/17p_vorsc_o + A models/lnd/clm/test/system/config_files/4p_vorsc_h + A models/lnd/clm/test/system/config_files/4p_vorsc_o + A models/lnd/clm/test/system/config_files/17p_vorsc_dm + A models/lnd/clm/test/system/config_files/17p_vorsc_dh + A models/lnd/clm/test/system/config_files/17p_vorsc_do + A models/lnd/clm/test/system/config_files/17p_vorsc_ds + A models/lnd/clm/test/system/config_files/4p_vorsc_dh + +>>>>>>>>>>>>>>> Add crop restart variables + A models/lnd/clm/src/biogeochem/CropRestMod.F90 + +>>>>>>>>>>>>>>> Add namelist for crop, and mksurfdata to create crop single point + A models/lnd/clm/test/system/nl_files/nl_crop + A models/lnd/clm/test/system/nl_files/nl_cn_conly + A models/lnd/clm/test/system/nl_files/clm_stdIgnYr + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_numaIA_mp20irrcr_2000 + + A models/lnd/clm/test/system/TSMrst_tools.sh - Add test to use finidat files + run interpinic on it and then make sure you can startup from the result + +>>>>>>>>>>>>>>> Explicitly add csm_share files into interpinic build + A models/lnd/clm/tools/interpinic/Mkdepends + A models/lnd/clm/tools/interpinic/shr_sys_mod.F90 + A models/lnd/clm/tools/interpinic/shr_log_mod.F90 + A models/lnd/clm/tools/interpinic/shr_kind_mod.F90 + A models/lnd/clm/tools/interpinic/shr_const_mod.F90 + +>>>>>>>>>>>>>>> Add the latest 10x15 initial conditions file to test on + A models/lnd/clm/tools/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Set maxpft to number + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_m + M models/lnd/clm/test/system/config_files/17p_cndvsc_o + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_s + M models/lnd/clm/test/system/config_files/_nrmexsc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_m + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/_nrvansc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_dm + M models/lnd/clm/test/system/config_files/17p_cndvsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/4p_vonrsc_ds + M models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>>>> Remove some tests add new crop tests + M models/lnd/clm/test/system/README.testnames ---------------- + M models/lnd/clm/test/system/tests_posttag_lynx_nompi -------- + M models/lnd/clm/test/system/tests_pretag_bluefire ----------- + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ----- + M models/lnd/clm/test/system/tests_pretag_edinburgh ---------- + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi ---- + M models/lnd/clm/test/system/tests_posttag_yong -------------- + M models/lnd/clm/test/system/tests_pretag_jaguarpf ----------- + M models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi ----- + M models/lnd/clm/test/system/tests_posttag_mirage ------------ + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression - + M models/lnd/clm/test/system/tests_posttag_nompi_regression -- + + M models/lnd/clm/test/system/TCBtools.sh ------- Add TOOL_ROOT + M models/lnd/clm/test/system/test_driver.sh ---- Use path to glade, update path + M models/lnd/clm/test/system/mknamelist -------- Add ability to set finidat file on + startup + M models/lnd/clm/test/system/input_tests_master Change out vodsrsc for vorsc, + add crop tests, add interpinic restart tests + M models/lnd/clm/test/system/tests_posttag_lynx Add sm9T4 test + M models/lnd/clm/test/system/CLM_runcmnd.sh ---- Remove -d + + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 Change from 1850-2000 + to just 1850 + M models/lnd/clm/test/system/nl_files/clm_irrig -------------- Use ignore_ic_year + instead of ignore_ic_date + +>>>>>>>>>>>>>>> Add ability to add crop in, add -crop to mksurfdata.pl which sets the +>>>>>>>>>>>>>>> numpft=20 namelist item + M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 - Add numstdpft + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 - Add numpft + M models/lnd/clm/tools/mksurfdata/ncdio.F90 ---- Add nf_get_att_double/nf_get_var_text + M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 - Use numpft + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 Add mksrf_flai/mksrf_firrig to file + M models/lnd/clm/tools/mksurfdata/areaMod.F90 -- Put numpft in mkvarctl + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 - Add numpft to namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl Handle crop and irrig and change + names accordingly + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 - Add numpft and add to namelist + if numpft = 20 add crop in + +>>>>>>>>>>>>>>> Bring in interpinic version from Mariana Vertenstein +>>>>>>>>>>>>>>> Make faster and use less memory, update NetCDF interface, make +>>>>>>>>>>>>>>> standalone so not dependant on other directories + M models/lnd/clm/tools/interpinic/interpinic.F90 - Make faster by saving indices, + use less memory, update to F90 NetCDF interface, make standalone + M models/lnd/clm/tools/interpinic/fmain.F90 ------ Add -a option to NOT override missing + M models/lnd/clm/tools/interpinic/Srcfiles ------- Remove mpi files + M models/lnd/clm/tools/interpinic/Filepath ------- Make standalone + M models/lnd/clm/tools/interpinic/Makefile ------- Use local MkDepends, compare + to null, change interface for testing a bit + M models/lnd/clm/tools/interpinic/README --------- Add note about SMP, update clmi file + M models/lnd/clm/tools/interpinic/interpinic.runoptions Use new file + +>>>>>>>>>>>>>>> Add numpft + M models/lnd/clm/tools/mkgriddata/mkvarctl.F90 + +>>>>>>>>>>>>>>> Add crop/noio remove dust and progsslt and CLAMP setting + M models/lnd/clm/bld/configure ------------- Add -crop/-noio remove -dust/-progsslt + turn RTM off for sitespf_pt, error check crop, maxpft, remove CLAMP setting + M models/lnd/clm/bld/listDefaultNamelist.pl Add loop for crop + M models/lnd/clm/bld/build-namelist -------- Sense crop=on/off, add suplnitro remove + Carbon_only + M models/lnd/clm/bld/clm.cpl7.template ----- Change order of $CLM_CONFIG_OPTS + so will be done last and override other settings + M models/lnd/clm/bld/config_files/config_definition.xml Add crop/noio, remove dust/progsslt + have maxpft only allow numbers up to 21 + +>>>>>>>>>>>>>>> New files for crop, remove old namelist items add new, add crop datasets + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Remove + Carbon_only add suplnitro, remove scaled_harvest, correct spellings + 1x1_numaIA,1x1_smallvilleIA resolutions + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Add + 1x1_numaIA,1x1_smallvilleIA + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ Add + 1x1_numaIA,1x1_smallvilleIA + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- Add + settings for suplnitro, new fpftcon, finidat for crop f19, add crop parameters + files for crop for f19,f10,1x1_numaIA,1x1_smallvilleIA, fix T31 files + turn create_crop_landunit on for crop + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add + mksrf_flai/mksrf_fvegtyp for crop add crop=on/off for those files + +>>>>>>>>>>>>>>> Use nsrest parameters, use secspday/days_per_year, handle prognostic crop +>>>>>>>>>>>>>>> Remove CLAMP/is_restart/DUST/DISTURB/CLAMP +>>>>>>>>>>>>>>> if soil also check if crop, use vegetation indices, add initialization +>>>>>>>>>>>>>>> subroutines, pass crop filters down, suplementatal Nitrogen can be for +>>>>>>>>>>>>>>> nothing, just for crop, or for all. + M models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 ----- Use nsrest parameters, secspday + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ---- Use secspday + M models/lnd/clm/src/biogeochem/CNGRespMod.F90 ----------- Handle crop + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 --- Handle crop + M models/lnd/clm/src/biogeochem/CNFireMod.F90 ------------ Use secspday/days_per_year + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 ----------- If crop add livestem + M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- Remove CLAMP is_restart + if soil or crop, nsrest parameters, use veg indices + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 Handle crop + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Remove CLAMP, add crop + M models/lnd/clm/src/biogeochem/DUSTMod.F90 -------------- Remove DUST, if soil or crop + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 ------- Add init and crop-Phenology + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 --- Add prog crop + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ---------- Pass crop filter down + use secspday + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Remove extra use + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------ Remove is_restart + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ---- Add CROP #ifdef to CNDV + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 ------- Use dayspyr and secspday + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Add init subroutine + section for prognostic crop, supplemental Nitrogen can be on for nothing, + crop only, or everything + M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ---- Add init subroutine, + add crop filters + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set crop vars remove CLAMP + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Add if section for crop + M models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 - Remove DISTURB + +>>>>>>>>>>>>>>> Use nsrest parameters, update ESMF interface + M models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 --- Use nsrest parameters + M models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 - Update interface from Tony Craig + Use nsrest parameters, use phase as a keyword. + M models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 -- Update interface from Tony Craig + compare success to ESMF_SUCCESS rather than 0. + +>>>>>>>>>>>>>>> Add istcrop and if statements for istsoil also test for istcrop +>>>>>>>>>>>>>>> Remove CLAMP/DUST/PROGSSLT/debug ifdef/vcmx25/dw_fcel/dw_flig +>>>>>>>>>>>>>>> /scaled_harv/ bad hist indices. Set if prog_crop in surfrdMod +>>>>>>>>>>>>>>> Use secspday and days_per_year, more vars on pft-physiology file +>>>>>>>>>>>>>>> Add parameters for nsrest settings, new hist vars, error check CROP + M models/lnd/clm/src/main/clm_varcon.F90 -------- Add istcrop + M models/lnd/clm/src/main/clm_varpar.F90 -------- Add numveg and mxpft + M models/lnd/clm/src/main/CNiniTimeVar.F90 ------ Remove CLAMP, if soil or crop + also set some crop vars + M models/lnd/clm/src/main/dynlandMod.F90 -------- If soil or crop + M models/lnd/clm/src/main/accumulMod.F90 -------- Remove is_restart, add missing to _PERIOD + M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove CLAMP/DUST, use nsrest parameters + add call to CNEcosystemDynInit + M models/lnd/clm/src/main/subgridRestMod.F90 ---- Remove incorrect grid indices (bug 1310) + M models/lnd/clm/src/main/accFldsMod.F90 -------- Add GDD0/8/10/PLANT/HARV/TSOI/TDM5/10 + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Remove CLAMP + CROP & C13 is not valid, add crop vars, remove vcmx25/dw_fcel/dw_flig + M models/lnd/clm/src/main/ndepStreamMod.F90 ----- Use secspday in place of 86400 + M models/lnd/clm/src/main/pftdynMod.F90 --------- Use days_per_year in place of 365 + move pconv/pprod10/pprod100 to pft-physiology file, if soil or crop + use nsrest parameters, remove scaled_harvest + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Add graincn, remove: vcmx25/dw_fcel/dw_flig + M models/lnd/clm/src/main/histFileMod.F90 ------- Use secspday in place of 86400 + fix Conventions, use nsrest parameters, comment out indices (bug 1310) + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove DUST/PROGSSLT/1==1 + M models/lnd/clm/src/main/restFileMod.F90 ------- Use nsrest parameters, add CropRest + fix Conventions + M models/lnd/clm/src/main/controlMod.F90 -------- Remove scaled_harvest/Carbon_only + use nsrest parameters, add suplnitro + M models/lnd/clm/src/main/initSurfAlbMod.F90 ---- if soil or crop, send crop filters + to CNEcosystemDyn + M models/lnd/clm/src/main/clm_time_manager.F90 -- Remove COUP_WRF, add get_driver_start_ymd + M models/lnd/clm/src/main/filterMod.F90 --------- Add filter for prognostic-crop + if soil or crop + M models/lnd/clm/src/main/clm_varctl.F90 -------- Add parameters for nsrest valid + values: nsrStartup, nsrContinue, nsrBranch, remove scaled_harvest + make sure crop allocates all PFT's + M models/lnd/clm/src/main/clm_driver.F90 -------- Remove DUST send crop filters + to CNEcosystemDyn + M models/lnd/clm/src/main/initGridCellsMod.F90 -- If crop send istcrop to set_landunit_crop_noncompete + M models/lnd/clm/src/main/CASAiniTimeVarMod.F90 - Remove CLAMP + M models/lnd/clm/src/main/pftvarcon.F90 --------- Add crop vars, corn, + temperate sping/winter cereal, and soybean, remove vcmx25/dw_flig/dw_fcel + add new variables for crop add npcropmin, npcropmax and error checking + M models/lnd/clm/src/main/ncdio_pio.F90 --------- Add logical field support + M models/lnd/clm/src/main/spmdMod.F90 ----------- Add MPI_LOR + M models/lnd/clm/src/main/surfrdMod.F90 --------- Add crop_prog as public module data + Remove TCX_REMOVE_SEE_NOTES_ABOVE, error checking if prognostic crops avail + and CROP not defined and vice versa + M models/lnd/clm/src/main/clmtype.F90 ----------- New variables for CROP, remove CLAMP + Remove dw_fcel, dw_flig, vcmx25 + M models/lnd/clm/src/main/histFldsMod.F90 ------- Remove CLAMP and DUST, T10 output + for CNDV or CROP, add A5TMIN, A10TMIN, GDD0, GDD8, GDD10, GDD020, GDD820, + GDD1020, GDDPLANT, GDDTSOI and GDDHARV for crop (as inactive) + + M models/lnd/clm/src/main/mkarbinitMod.F90 ------ If soil or crop + + M models/lnd/clm/src/riverroute/RtmMod.F90 - Remove L2R_Decomp #ifdef, and #if (1 == + Remove is_restart and use clm_time_manager version. +0) + +>>>>>>>>>>>>>>> Change if statements on "if soil" to "if soil or crop" +>>>>>>>>>>>>>>> Remove DUST, NO_DAYLEN_VCMAX #ifdefs, is_restart, vcmx25, avcmx, +>>>>>>>>>>>>>>> and SNICAR stats. vcmx calc is different for crop and btran for soybean + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - If soil or crop + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 -- If soil or crop + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 ---- If soil or crop + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- If soil or crop + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 --- If soil or crop + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Remove DUST #ifdef + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- If soil or crop + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 ------- If soil, urb, wet or crop + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- If soil or crop + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Remove is_restart use + clm_time_manger version, use nsrest parameters + M models/lnd/clm/src/biogeophys/SNICARMod.F90 ----------- Remove commented out SNICAR stats + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - If soil or crop + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Remove NO_DAYLEN_VCMAX, + and vcmx25,avcmx, vcmx calc different for crop and btran for soybean. + +Summary of testing: + + bluefire: All PASS except... +008 blAZ1 TBL.sh 21p_cncrpsc_dh clm_irrig^nl_crop 20020401:3600 10x15 USGS -10 cold .............FAIL! rc= 5 +015 blE91 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 arb_ic ...................FAIL! rc= 5 +020 blF92 TBL.sh 17p_vorsc_dm clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 +024 blEH1 TBL.sh 4p_vorsc_dh clm_std^nl_urb 20021231:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic ......FAIL! rc= 5 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:3600 10x15 USGS@1850-2000 -10 arb_ic ..............FAIL! rc= 7 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +032 blF93 TBL.sh 17p_vorsc_do clm_std^nl_urb 20021230:1800 4x5 gx3v7 48 cold ....................FAIL! rc= 5 +056 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +057 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +058 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + bluefire/CESM testing: All PASS except... (dens, fv and ram1 change) +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_26 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_26 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_26 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_26 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_26 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_26 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_26 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_26 +FAIL ERI.f19_g16.IG1850.bluefire.compare.clm4_0_26 +SFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.GC.231059 +SFAIL ERP.T31_g37.IGRCP60CN.bluefire.GC.231059 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_26 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_26 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_26 +FAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_26 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_26 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare_hist.clm4_0_26 +FAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_26 + bluefire/PTCLM testing: All PASS up to.. +US-Ha1_ICN_ad_spinup.PTCLM PASS + jaguarpf interactive testing: All PASS up to... +008 blAZ3 TBL.sh 21p_cncrpsc_do clm_irrig^nl_crop 20020401:3600 10x15 USGS -10 cold .............FAIL! rc= 5 +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +035 sm8Z3 TSMrst_tools.sh 21p_cncrpsc_do interpinic clm_irrig^nl_crop 20000101:1800 1.9x2.5 gx1v6 10FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 7 +010 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic .............FAIL! rc= 7 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 7 +018 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ..FAIL! rc= 7 +026 blL74 TBL.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 + mirage,storm/ifort interactive testing: All PASS except... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_26 + +Changes answers relative to baseline: no bit-for-bit + with the exception that the new crop mode is NOT in previous tags + +=============================================================== +=============================================================== +Tag name: clm4_0_26 +Originator(s): erik (Erik Kluzek) +Date: Wed Mar 23 11:43:00 MDT 2011 +One-line Summary: Update externals, driver update changes answers, drydep changes from fvitt, fix bugs + +Purpose of changes: + +Update externals to latest pre-cesm1_0_beta17 version. driver to beyond cesm1_0_beta16 +version -- so answers change. Always update ndep_interp in clm_driver -- so restarts are +exact. Bring in Francis Vitt drydep changes. Remove bad T31 pftdyn datasets add in +a new T31 rcp2.6 T31 dataset. Fix interpinic _var bug. Remove HIRES from bld. Change +tools Makefile's so that you can set env variables. Change test_driver to use newer +version of cprnc. + +Bugs fixed (include bugzilla ID): + 1284 (Crop restart test fails) + 1304 (bug in interpinic *_var) + 1308 (tools Make doesn't allow setting env vars) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: more fields added for drydep namelist + +List any changes to the defaults for the boundary datasets: + Remove bad T31 pftdyn datasets + +Describe any substantial timing or memory changes: none + +Code reviewed by: self, drydep changes from fvitt and JFL + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, cprnc + + scripts to scripts4_110314 + drv to drvseq3_1_51 + cprnc to cprnc_110310 + +List all files eliminated: None + +List all files added and what they do: + + A README_EXTERNALS -- Describes how to work with externals (similar to cam file) + +List all existing files that have been modified, and describe the changes: + + M README - Update with new + + M models/lnd/clm/test/system/CLM_compare.sh - Update for latest cprnc which + doesn't have a "completed successfully line at the end" + M models/lnd/clm/test/system/test_driver.sh - Use newer cprnc on bluefire + +>>>>>>>>>>> Change tools build so that you can set env variables for SMP/USER_FC/CC + M models/lnd/clm/tools/mksurfdata/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/interpinic/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/mkgriddata/Makefile -------- Compare to ,null rather than strip + M models/lnd/clm/tools/mkdatadomain/Makefile ------ Compare to ,null rather than strip + + M models/lnd/clm/tools/interpinic/interpinic.F90 -- Make sure htop_var/fpcgrid_var + are initialized to false each time comes into routine (bug 1304) + + M models/lnd/clm/bld/configure -- Remove HIRES setting for stand-alone testing + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New rcp2.6 T31 + pftdyn dataset remove rcp4.5,6,8.5 T31 pftdyn files as they only go to 2035 + + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Pick wesveg and index_season + differently for special landunits, add max for rc, assume no surface + resistance for SO2 over water, use has_rain logical (from fvitt) + M models/lnd/clm/src/main/clm_driver.F90 ----------- Always call ndep_interp + even if (stream_year_first_ndep /= stream_year_last_ndep) as can change + answers if not + +Summary of testing: + + bluefire: All PASS except TBL tests and... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS except TBL tests + bluefire/CESM testing: All PASS (even the comparision tests) + bluefire/PTCLM testing: All PASS up to... +US-Ha1_ICN_ad_spinup.PTCLM PASS + edinburgh/lf95 interactive testing: All PASS except... +021 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 10 + mirage,storm/ifort interactive testing: All PASS except TBL tests and... +016 smVx3 TSM.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 10 +017 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 5 +018 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 5 +024 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +026 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + yong/ifort interactive testing: All PASS except... +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_25 + +Changes answers relative to baseline: Yes! Greater than roundoff + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change:(larger than roundoff/same climate + + driver mapping changes, drydep code has changes, ndep_interp is always called + which changes answers on some platforms/compilers (such as intel compiler). + +=============================================================== +=============================================================== +Tag name: clm4_0_25 +Originator(s): erik (Erik Kluzek) +Date: Tue Mar 22 10:13:08 MDT 2011 +One-line Summary: Always output restart-history files add more meta-data to them, + fix urbanc_alpha and 2.5x3.33 datasets, Changes from Keith O on SNOWLIQ/SNOWICE + +Purpose of changes: + +Move history namelist information to restart history files and always output them. Add +attributes and meta-data to the restart history files. Fix urbanc_alpha test site surface +dataset. Fix datm namelist for urban cases. Use new crop pft-physiology file. Update +scripts and csm_share. Changes from Keith O on SNOWLIQ/SNOWICE so goes to zero rather +than missing value. Update 2.5x3.33 datasets. Fix dvolrdt units documentation, call +mksoifmaxInit. + +Bugs fixed (include bugzilla ID): + 1247 (Some changes to ncd_pio in clm) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New pft-physiology file with fields for prognostic crop + New surface dataset for urbanc_alpha + New grid/topo/frac/domain files for 2.5x3.33 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, snowliq/snowice changes by oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, cism, csm_share + + scripts to scripts4_110204 + datm to datm8_110210 + cism to cism1_110220 + csm_share to share3_110201 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/input_tests_master - Change start dates of urban tests + +>>>>>>>>>>>> Move mksoil*Init subroutines private to mksoilMod, and call a mksoilInit +>>>>>>>>>>>> routine from mksrfdata, making sure mksoifmaxInit is called. + M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 - Add mksoilInit to call + mksoitexInit/mksoicolInit and mksoifmaxInit (mksoifmaxInit was missing) + fix mksoifmaxInit, and make mksoitex/col/fmaxInit routines private + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -- Call mksoilInit, + remove mksoicol/texInit + +>>>>>>>>>>>> Add notes about setting path to NetCDF, and other gmake options + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/interpinic/README + M models/lnd/clm/tools/mkgriddata/README + M models/lnd/clm/tools/mkdatadomain/README + + M models/lnd/clm/bld/queryDefaultNamelist.pl - Remove white-space from input options + M models/lnd/clm/bld/listDefaultNamelist.pl -- Also list datm_internal files + M models/lnd/clm/bld/build-namelist ---------- Add drv_final_spinup from PTCLM + document precidence of the different env_conf.xml + +>>>>>>>>>>>> Fix 2.5x3.33 and urbanc_alpha files, change some settings for CLM1PT +>>>>>>>>>>>> or pt1_pt1 resolution, remove ndepsrc. + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Add + taxmode and dtlimit, add 2.5x3.33 resolution + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Add + sim_year="2000" sim_year_range="constant" for pft1_pt1 datm_presaero files + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ Add + 1x1_numaIA and 1x1_smallvilleIA domain/preseaero files, update 2.5x3.33 domain + make mapalgo nn for CLM1PT, set taxmode and tintalgo appropriately + if CLM1PT is set. Add transient presaero file for 1x1_tropicAtl. + M models/lnd/clm/bld/namelist_files/use_cases/stdurbpt_pd.xml ------- Set + dtime to 1800 for 1x1_urbanc_alpha + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- Set + tintalgo, mapalgo by datm_source, and set taxmode as well. Remove + option for datm_presaero="none". Set mapalgo=nn for datm_presaero=pt1_pt1. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- Update + urbanc_alpha surface dataset, 2.5x3.33 grid/topo/frac datasets + Remove ndepsrc="stream" in ndepmapalgo settings as doesn't exist anymore. + Use latest pft-physiology file from CROP branch (has extra data needed + for prognostic crop) + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Set + atm_cpl_dt=1800 for urbanc_alpha, set stop_option/stop_n for + urban sites carefully (add 1 time-step to stop_n, double for urbanc_alpha). + Use "test" mask for urbanc_alpha + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Remove + ndepsrc="stream" + +>>>>>>>>>>>> Add meta-data to restart hist files, put history restart data on +>>>>>>>>>>>> restart hist files and off master restart files (so initial condition +>>>>>>>>>>>> files aren't cluttered with information only needed for continue runs). +>>>>>>>>>>>> Some changes to SNOWLIQ/SNOWICE, document dvolrdt units. + M models/lnd/clm/src/main/histFileMod.F90 - Use htape_create for restart_hist + files, modify hist_restart_ncd so that namelist vars on one restart + history files and they are always output, add more metadata to + restart hist files, remove some temp arrays. Restart history files + now always needed for continue runs, but not for other run types, + and restart history information does not clutter the master restart + files. The only history variables on master restart files are the + history and restart filenames. Comments on the files make this clear. + M models/lnd/clm/src/main/restFileMod.F90 - Change hist_restart_ncd calls + M models/lnd/clm/src/main/ncdio_pio.F90 --- Add ncd_io_log_var0_nf interface + add options for attributes: comment, flag_values, flag_meanings, and + nvalid_range for variables., fix an issue in ncd_io_int_var0_nf + M models/lnd/clm/src/main/histFldsMod.F90 - Change default for SNOWLIQ/SNOWICE + to "Average" rather than "Instant" (from oleson). + M models/lnd/clm/src/riverroute/RtmMod.F90 ---- Document dvolrdt conversion + M models/lnd/clm/src/riverroute/RunoffMod.F90 - Document dvolrdt units + correctly. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 - Initialize snowice/snowliq + to zero over lake filter (from oleson). + +Summary of testing: + + bluefire: All PASS except TBL tests and... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS except all TBL tests fail + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL SMS_RLB.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL SMS_ROA.f45_f45.I.bluefire.generate.clm4_0_25 +FAIL ERS_D.f45_g37.I.bluefire.generate.clm4_0_25 +BFAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_23 +FAIL PST.f45_g37.I1850.bluefire.generate.clm4_0_25 +FAIL PET_PT.f45_g37.I1850.bluefire.generate.clm4_0_25 +FAIL ERS_E.f19_g16.I1850.bluefire.generate.clm4_0_25 +FAIL ERI.f19_g16.IG1850.bluefire.generate.clm4_0_25 +FAIL ERS_D.T31_g37.IGRCP26CN.bluefire.generate.clm4_0_25 +FAIL ERP.T31_g37.IGRCP60CN.bluefire.generate.clm4_0_25 +BFAIL ERP.T31_g37.IGRCP60CN.bluefire.compare.clm4_0_23 +FAIL ERB.f09_g16.I_1948-2004.bluefire.generate.clm4_0_25 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_25 +FAIL ERH_D.f10_f10.I1850CN.bluefire.generate.clm4_0_25 +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_23 +FAIL PST.f10_f10.I20TRCN.bluefire.generate.clm4_0_25 +FAIL PET_PT.f10_f10.I20TRCN.bluefire.generate.clm4_0_25 +FAIL SMS.f10_f10.IRCP45CN.bluefire.generate.clm4_0_25 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.generate.clm4_0_25 +BFAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_23 + jaguarpf interactive testing: +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -5+-5 arb_ic .............FAIL! rc= 13 +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:1800 1x1_brazil navy -5+-5 arb_ic ..........FAIL! rc= 11 +006 erAZ3 TER.sh _sc_do clm_irrig 20020401:3600 10x15 USGS -3+-7 cold ...........................FAIL! rc= 13 +007 brAZ3 TBR.sh _sc_do clm_irrig 20020401:3600 10x15 USGS -5+-5 cold ...........................FAIL! rc= 11 +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +016 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:3600 1x1_tropicAtl test -10+-10 arb_ic ..FAIL! rc= 13 +017 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 11 +020 erK74 TER.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -334+-336 arb_ic ............FAIL! rc= 13 +021 brK74 TBR.sh 17p_cndvsc_s clm_std 19971231:1800 1x1_brazil navy -334+-336 arb_ic ............FAIL! rc= 11 +024 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 13 +025 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 11 +028 erHQ4 TER.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -3+-7 cold ............FAIL! rc= 13 +029 brHQ4 TBR.sh _nrcnsc_ds clm_drydep 20000214:1800 1x1_brazil navy@2000 -5+-5 cold ............FAIL! rc= 11 +032 erV63 TER.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 10+38 arb_ic ................FAIL! rc= 13 + jaguarpf/CESM testing: All PASS including comparision tests except... +FAIL PST.f10_f10.I20TRCN.jaguarpf + edinburgh/lf95 interactive testing: +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -5+-5 arb_ic .............FAIL! rc= 13 +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:1800 1x1_brazil navy -5+-5 arb_ic ..........FAIL! rc= 11 +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:1800 1x1_brazil navy -10 arb_ic ...............FAIL! rc= 7 +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 7 +008 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -45+-45 arb_ic .........FAIL! rc= 13 +009 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:3600 1x1_camdenNJ navy -10+-10 arb_ic ......FAIL! rc= 11 +010 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:3600 1x1_camdenNJ navy -90 arb_ic .............FAIL! rc= 7 +012 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 115+115 arb_ic FAIL! rc= 13 +013 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:3600 1x1_vancouverCAN navy 72+72 arb_ic FAIL! rc= 11 +014 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:3600 1x1_vancouverCAN navy 331 arb_ic ...FAIL! rc= 5 +016 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 58+100 arb_ic FAIL! rc= 13 +017 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:3600 1x1_mexicocityMEX navy 72+72 arb_ic FAIL! rc= 11 +018 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:3600 1x1_mexicocityMEX navy 158 arb_ic ..FAIL! rc= 5 +020 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 13 +021 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 11 +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 7 +024 erL74 TER.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -5+-5 arb_ic ..............FAIL! rc= 13 +025 brL74 TBR.sh _nrsc_s clm_std^nl_urb_br 20020101:1800 1x1_brazil navy -10+-10 arb_ic .........FAIL! rc= 11 +026 blL74 TBL.sh _nrsc_s clm_std^nl_urb 20020101:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 + edinburgh/CESM testing: All PASS including comparision tests + yong/intel testing: +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 2 +012 erD94 TER.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 +022 smV24 TSM.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 96 arb_ic .....................FAIL! rc= 10 +023 erV24 TER.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 10+38 arb_ic ..................FAIL! rc= 5 +024 brV24 TBR.sh _mec10sc_ds clm_glcmec^nl_urb_br 19980115:1800 48x96 gx3v7 72+72 arb_ic ........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_24 + +Changes answers relative to baseline: answers bit-for-bit, but SNOWLIQ/SNOWICE on history + files change. + +=============================================================== +=============================================================== +Tag name: clm4_0_24 +Originator(s): erik (Erik Kluzek) +Date: Wed Feb 9 13:20:39 MST 2011 +One-line Summary: Fix mksurfdata and add ability to override soil_fmax + +Purpose of changes: + +Fix mksurfdata for urban. Add soil_fmx to mksurfdata. Add attributes to suface datasets +that tell you the special namelist settings (such as all_urban, soil_, pft_). Add -irrig +as option to mksurfdata.pl. Update datm with new datasets for urbanc_alpha. Add new frac +dataset for urbanc_alpha. Update documentation to cesm1_0_rel_09_clm4_0_14 tag. Change +test_driver from jaguar to jaguarpf. Fix bug in build-namelist creating namelist +with clm_usr_name option. + +Bugs fixed (include bugzilla ID): + 1281 (bug in mksurfdata for urban_only case) + 1280 (improve modularity of mksurfdata) [partial] + 1276 (urbanc_alpha site does not work) [partial] + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1283 (CLM with glacier-MEC fails running on intel) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Update frac and domain file for urbanc_alpha site + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + scripts, drv and csm_share to cesm1_0_beta15 versions + + scripts to scripts4_110204 + drv to drvseq3_1_48 + csm_share to share3_110201 + datm to datm8_110204 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/mkfmaxMod.F90 --- Put inside of mksoilMod.F90 + + D models/lnd/clm/test/system/tests_pretag_jaguar ------- rename to jaguarpf + D models/lnd/clm/test/system/tests_pretag_jaguar_nompi - rename to jaguarpf + +>>>>>>>>>>>> Remove files that were no longer used +>>>>>>>>>>>> (they are already in mksoilMod or mkpftMod) + D models/lnd/clm/tools/mksurfdata/mkorganic.F90 + D models/lnd/clm/tools/mksurfdata/mkrank.F90 + D models/lnd/clm/tools/mksurfdata/mkirrig.F90 + D models/lnd/clm/tools/mksurfdata/mksoicolMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>> Add an irrigation and urban test for mksurfdata + A models/lnd/clm/test/system/nl_files/mksrfdt_10x15_irr_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_vancouverCAN_2000 + + A models/lnd/clm/test/system/tests_pretag_jaguarpf ------- rename from jaguar + A models/lnd/clm/test/system/tests_pretag_jaguarpf_nompi - rename from jaguar + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add all_urban and irrigation mksurfdata tests +>>>>>>>>>>>> Update jaguar to jaguarpf + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/TCBtools.sh ---- Remove copy of *.h files + M models/lnd/clm/test/system/test_driver.sh - change jaguar to jaguarpf, update + modules to agree with scripts + M models/lnd/clm/test/system/CLM_runcmnd.sh - change jaguar to jaguarpf + +>>>>>>>>>>>> Add soil_fmax option and soil_fmx, soil_col and irrig option to +>>>>>>>>>>>> mksurfdata.pl. Add attributes to file for override cases. +>>>>>>>>>>>> Put mkfmax inside of mksoilMod, add mksoilAtt and mkpftAtt methods. + M models/lnd/clm/tools/mksurfdata/Srcfiles -------- Remove unused files + M models/lnd/clm/tools/mksurfdata/mksoilMod.F90 --- Move mkfmax inside here + add mksoifmaxInit, mkfmax, and mksoilAtt interfaces, add soil_fmax as + an override setting + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ---- Fix bug in if statement + (needed to also ask if .not. zerod_out). Create mkpftAtt interface, move + settings from mkfileMod.F90 to there. + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 --- Move soil and pft specific + declarations to either mksoilAtt or mkpftAt interfaces + if all_urban is set add all_urban=TRUE attribute to file + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Add soil_fmax to namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Add ability to set soil_col, + soil_fmax and irrig on command line + bring irrigation, setting of numpft and query of lai file from crop branch + +>>>>>>>>>>>> Update urbanc_alpha domain/frac files + M models/lnd/clm/bld/namelist_files/namelist_definition.xml -------- Add mksrf_flai + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml -- Set + urbanc_alpha default mask to test + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ----- urbanc_alpha + domain file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------ urbanc_alpha + frac file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml Add in + mksrf_flai file + +>>>>>>>>>>>> Update to cesm1_0_rel_09_clm4_0_14 documentation (includes info on new bugs) + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/KnownBugs + +Summary of testing: + + bluefire interactive testing: +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 5 + jaguarpf interactive testing: +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +026 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 +034 blV63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 + edinburgh/lf95 interactive testing: +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + mirage/intel interactive testing: All PASS except... +017 erVx3 TER.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -4+-6 aFAIL! rc= 5 +018 brVx3 TBR.sh _mec10sc_do clm_transient_glcMEC_rcp4.5^nl_urb_br 20331231:1800 48x96 gx3v7@1850-21FAIL! rc= 5 +019 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 4 +021 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +022 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +024 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +025 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +026 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +029 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +030 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + yong/intel interactive testing: +011 smD94 TSM.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +012 erD94 TER.sh _persc_ds clm_per^nl_per 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 +022 smV24 TSM.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 96 arb_ic .....................FAIL! rc= 10 +023 erV24 TER.sh _mec10sc_ds clm_glcmec 19980115:1800 48x96 gx3v7 10+38 arb_ic ..................FAIL! rc= 5 +024 brV24 TBR.sh _mec10sc_ds clm_glcmec^nl_urb_br 19980115:1800 48x96 gx3v7 72+72 arb_ic ........FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_23 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_23 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 3 13:42:17 MST 2011 +One-line Summary: Add in new glacier-MEC use-cases + +Purpose of changes: + +Add in new datasets and use-cases for glc_mec to support glc_nec=10 for 1850, 2000, +1850-2000, and 1850-2100 for all 4 rcp's. Standardize naming convention for use-cases. +Use scripts branch that has new compsets in it that access the new use-cases. Make sure +ncdpio is used for all I/O. Work with PTCLM a bit, and PTCLM testing. Change precedence +for build-namelist so that use-case is lower after user_nl_clm. + +Bugs fixed (include bugzilla ID): + 1273 (fix pts_mode problem on jaguar) + 1256 (fix PTCLM testcases.csh on jaguar to use netcdf/3) + 1254 (PTCLM add .nc and date to pft-physiology file copy) + 1250 (add scratchroot in PTCLM for generic machines) + 1247 (some changes in ncdio_pio) [partial] + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1168 (Change precedence so user_nl_clm used over use-case) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1276 (urbanc_alpha site does not work) + 1279 (Latest version of PTCLM requires python2.5) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Change order of precedence so that + use_case is AFTER -namelist -infile and clm_usr_name options. + Thus values in your user_nl_clm file will be used instead of what's in + the use_case. + + New precedence is... + 1. values set on the command-line using the -namelist option, + 2. values read from the file specified by -infile, + 3. datasets from the -clm_usr_name option, + 4. values set from a use-case scenario, e.g., -use_case + 5. values from the namelist defaults file. +List any changes to the defaults for the boundary datasets: + New datasets for glc_nec="10" + surfdata for 1850@(f09,f19,T31) + pftdyn for 1850-2000@(f09,f19,T31) + pftdyn for 1850-2100@(f09,f19,T31) rcp (2.6,4.5,6,8.5) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, cism + + scripts to glccsbr01_scripts4_110111 + datm to datm8_110124 + cism to cism1_110125 + +List all files eliminated: + + Rename use-cases to versions with an _pd ending or 2000_*_control form + + models/lnd/clm/bld/namelist_files/use_cases/... + D .../use_cases/stdurbpt.xml ----- rename to stdurbpt_pd + D .../use_cases/glacier_mec.xml -- rename to 2000_glacierMEC_control + D .../use_cases/pergro.xml ------- rename to pergro_pd + D .../use_cases/pergro0.xml ------ rename to pergro0_pd + +List all files added and what they do: + +>>>>>>>>>>>>>> Add tests for all new glacier-MEC use-cases + A models/lnd/clm/test/system/nl_files/clm_glcmec + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp2.6 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp4.5 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp8.5 + A models/lnd/clm/test/system/nl_files/clm_transient_glcMEC_rcp6 + + A models/lnd/clm/test/system/nl_files/nl_per - PERGRO testing namelist + +>>>>>>>>>>>>>> + models/lnd/clm/bld/namelist_files/use_cases/... + A .../use_cases/pergro_pd.xml -------------- Renamed from pergro + A .../use_cases/2000_glacierMEC_control.xml Copy of glacier_mec_pd + A .../use_cases/stdurbpt_pd.xml ------------ Renamed from stdurbpt + A .../use_cases/pergro0_pd.xml ------------- Renamed from pergro0 + A .../use_cases/README --------------------- Add README file to describe + naming convention for use_cases + +>>>>>>>>>>>>>> Add new glacier_MEC use_cases + models/lnd/clm/bld/namelist_files/use_cases/... + A .../use_cases/1850_glacierMEC_control.xml + A .../use_cases/20thC_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp6_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp2.6_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp4.5_glacierMEC_transient.xml + A .../use_cases/1850-2100_rcp8.5_glacierMEC_transient.xml + A .../use_cases/glacierMEC_pd.xml --- renamed from glacier_mec + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add some new glacierMEC use-case tests + M models/lnd/clm/test/system/README.testnames ------------- Add n,w,x,y glcMEC resolutions + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_yong + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_mirage + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Get glcmec branch testing to work and pergro testing working with +>>>>>>>>>>>>>> build-namelist precedence change + M models/lnd/clm/test/system/TBR.sh ------------- Match history files + NOT restart-history files + M models/lnd/clm/test/system/nl_files/clm_per0 -- Change use-case name + M models/lnd/clm/test/system/nl_files/nl_urb_br - Add hist_fincl2 to remove + any secondardy history files from use-case + M models/lnd/clm/test/system/nl_files/clm_per --- Change use-case name + M models/lnd/clm/test/system/input_tests_master - Add new tests + M models/lnd/clm/test/system/TSM.sh ------------- Make restart file touched + with .nc extension, remove bit about deleting clm.i files + +>>>>>>>>>>>>>> Use mksrf_glacier files from XML database, add glc_nec to mksurfdata.pl, +>>>>>>>>>>>>>> allow glc_nec=0, and don't write out glcmec fields if glc_nec=0. + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 --- Don't define glc_nec + fields if nglcec == 0. + M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 - Set nglcec=0 by default, + add ability to handle nglcec=0 + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Don't write out or call + glc-mec stuff if nglcec == 0. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Add ability to set glc_nec + get mksrf_glacier file from XML database + +>>>>>>>>>>>>>> Add in new glc_nec=10 datasets, change precedence order in +>>>>>>>>>>>>>> build-namelist so use_case is AFTER -namelist/-infile/-clm_usr_name. +>>>>>>>>>>>>>> Add mksrf_glacier files to XML database + M models/lnd/clm/bld/listDefaultNamelist.pl - Make faster and add settings + for glc_nec and glc_grid, also add loop over sim_year_range + M models/lnd/clm/bld/build-namelist --------- Change precedence order so + that use-cases are after namelist and infile (thus user_nl_clm files + are used in place of the use-case. Check that the use-cases follow + a strict naming convention (ensures will work with PTCLM.py). + This is the new order of precedence ++ 1. values set on the command-line using the -namelist option, ++ 2. values read from the file specified by -infile, ++ 3. datasets from the -clm_usr_name option, ++ 4. values set from a use-case scenario, e.g., -use_case ++ 5. values from the namelist defaults file. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Add + mksrf_glacier file for mksurfdata.pl to XML database + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- Change + order of precedence so that use_case is after infile and namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- New glc datasets + surfdata for 1850@(f09,f19,T31) + pftdyn for 1850-2000@(f09,f19,T31) + pftdyn for 1850-2100@(f09,f19,T31) rcp (2.6,4.5,6,8.5) + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add + mksrf_glacier datasets for glc_nec=0 (previous version), glc_nec=3,5,10 + use older glacier dataset that Bill Lipscomb says has better glacier + representation over greenland +>>>>>>>>>>>>>> Remove direct calls to pio -- use ncdio_pio module for all NetCDF +>>>>>>>>>>>>>> read/write/define/query. Write out at initialization if there is no +>>>>>>>>>>>>>> land and won't be running CLM. + M models/lnd/clm/src/main/clm_initializeMod.F90 - Set subname and write out + if no land exists and clm will NOT be run + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Use ncd_io to read in mxsoil_color + (remove direct calls to pio) + M models/lnd/clm/src/main/histFileMod.F90 ------- Use ncd_io to read/write + everything (remove direct calls to pio). Add max_nFields function. + M models/lnd/clm/src/main/restFileMod.F90 ------- Change use of PIO_GLOBAL + to NCD_GLOBAL + M models/lnd/clm/src/main/ncdio_pio.F90 --------- Remove making pio interfaces + public, add new interfaces to ncd_io global, add dimexist as optional + argument to ncd_inqdid, and name as optional argument to ncd_inqdlen + change ncd_io interfaces that could NOT need to call scam_field_offsets + so that they don't. Initialize data_offset and pfts to bigint NOT nan. + New interfaces: ++ module procedure ncd_io_char_var1_nf ++ module procedure ncd_io_char_var3_nf ++ module procedure ncd_io_char_varn_strt_nf + M models/lnd/clm/src/main/surfrdMod.F90 --------- Use ncd_inqdid and ncd_inqvid + instead of pio interfaces directly. + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +057 blV61 TBL.sh _mec10sc_dh clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +061 blVn1 TBL.sh _mec10sc_dh clm_transient_glcMEC_rcp8.5 20331231:1800 1.9x2.5 gx1v6@1850-2100 48 arFAIL! rc= 5 +063 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +064 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +065 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +066 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + +glcmec TBL tests fail since they didn't exist in previous version + + bluefire interactive testing: +006 smHS3 TSM.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 8 +007 erHS3 TER.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic ...FAIL! rc= 5 +008 brHS3 TBR.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic ...FAIL! rc= 5 +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic ......FAIL! rc= 4 +044 blV63 TBL.sh _mec10sc_do clm_glcmec 19980115:1800 1.9x2.5 gx1v6 48 arb_ic ...................FAIL! rc= 7 +060 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + bluefire/CESM testing: All PASS except... (new compare tests fail since didn't exist before) +BFAIL ERI.f19_g16.IG1850.bluefire.compare.clm4_0_22 +BFAIL ERS_D.T31_g37.IGRCP26CN.bluefire.compare.clm4_0_22 +BFAIL PST.f10_f10.I20TRCN.bluefire.compare.clm4_0_22 +BFAIL PET_PT.f10_f10.I20TRCN.bluefire.compare.clm4_0_22 +BFAIL SMS.f10_f10.IRCP45CN.bluefire.compare.clm4_0_22 + +PEND ERS_D.f45_g37.I.bluefire.GC.003008 +PEND ERP.T31_g37.IGRCP60CN.bluefire.GC.003008 +PEND ERH_D.f10_f10.I1850CN.bluefire.GC.003008 +PEND ERS_D.f19_g16.IRCP85CN.bluefire.GC.003008 + + bluefire/CESM Extra testing: +PASS ERI.f19_g16.IG1850.bluefire +PASS ERI.f19_g16.IG1850CN.bluefire +PASS ERS.T31_g37.IGRCP45CN.bluefire +PASS ERS.T31_g37.IGRCP85CN.bluefire + +PASS ERS_D.T31_g37.IG.bluefire +PASS ERS_D.f19_g16.IGCN.bluefire + + bluefire/CESM Extra testing for coupled with CAM and CAM/POP: +PASS ERI.f19_g16.BGCN.bluefire +PASS SMS_D.f19_g16.BG1850CN.bluefire +PASS ERP.f09_g16.BG20TRCN.bluefire +PASS ERS.T31_g37.BGRCP26CN.bluefire +RUN ERS_D.T31_g37.BGRCP45CN.bluefire.111336 --- takes too long +PASS ERS.T31_g37.BGRCP60CN.bluefire +RUN ERS_D.T31_g37.BGRCP85CN.bluefire.111336 --- takes too long +FAIL SMS.f19_f19.EGCN.bluefire ----------------- seg-fault +FAIL SMS.T31_T31.EG1850CN.bluefire ------------- seg-fault +PASS ERI.f09_f09.FGCN.bluefire +PASS SMS.f19_f19.FG1850CN.bluefire +PASS SMS.T31_T31.FG20TRCN.bluefire +FAIL SMS.T31_g37.TG.bluefire + + bluefire/PTCLM testing: +PTCLM.631306_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.631306_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.631306_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.631306_US-Ha1_I_1850.PTCLM PASS +PTCLM.631306_US-Ha1_I20TR.PTCLM PASS +PTCLM.631306_US-Ha1_I20TRCN.PTCLM PASS +PTCLM.631306_US-Ha1_ICN.PTCLM PASS +PTCLM.631306_US-Ha1_I1850CN.PTCLM PASS +PTCLM.631306_US-Ha1_IRCP85CN.PTCLM PASS +PTCLM.631306_US-Ha1_I.PTCLM PASS +PTCLM.631306_US-Ha1_I_QIAN.PTCLM PASS +PTCLM.631306_US-Ha1_I.PTCLM PASS +PTCLM.631306_US-UMB_I.PTCLM PASS +PTCLM.631306_US-UMB_I_QIAN.PTCLM PASS +PTCLM.631306_US-UMB_I.PTCLM PASS +US-Ha1_ICN_ad_spinup.PTCLM PASS + jaguar interactive testing: All PASS except... +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +014 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +026 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + jaguar/PTCLM testing: +PTCLM.4224_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.4224_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.4224_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.4224_US-Ha1_I_1850.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I20TR.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I20TRCN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_ICN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I1850CN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_IRCP85CN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I_QIAN.PTCLM FAIL 0 +PTCLM.4224_US-Ha1_I.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I_QIAN.PTCLM FAIL 0 +PTCLM.4224_US-UMB_I.PTCLM FAIL 0 +US-Ha1_ICN_ad_spinup.PTCLM PASS + edinburgh/lf95 interactive testing: All PASS up to... +022 blVx3 TBL.sh _mec10sc_do clm_transient_glcMEC_rcp4.5 20331231:1800 48x96 gx3v7@1850-2100 -10 arbFAIL! rc= 5 + edinburgh/PTCLM testing: Fails because Python is too OLD (2.4 when needs 2.5) + yong/intel/PTCLM testing: Following PASS... +PTCLM.4900_1x1_mexicocityMEX_ICN.PTCLM PASS +PTCLM.4900_1x1_mexicocityMEX_I.PTCLM PASS +PTCLM.4900_1x1_mexicocityMEX_I_QIAN.PTCLM PASS +PTCLM.4900_US-Ha1_I_1850.PTCLM PASS +PTCLM.4900_US-Ha1_I20TR.PTCLM PASS +PTCLM.4900_US-Ha1_I20TRCN.PTCLM PASS +PTCLM.4900_US-Ha1_ICN.PTCLM PASS + +CLM tag used for the baseline comparison tests if applicable: clm4_0_22 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_22 +Originator(s): erik (Erik Kluzek) +Date: Thu Jan 20 13:17:56 MST 2011 +One-line Summary: Move coupler field indicies to clm, move cpl_* directories up a level, add the cpl_share directory + +Purpose of changes: + +Move cpl_* directories up a level, add cpl_shr directory. Update driver, move coupler +field indicies to clm, and allow fields to be passed in driver with just names added to +namelist. Make is_restart() public in clm_time_manager.F90. Fix PTS_MODE. Don't pass +Sl_landfrac to driver in run-phase. + +Bugs fixed (include bugzilla ID): + 1271 (Problem in PTS_MODE with clm) + 1270 (Make is_restart public in clm_time_manager.F90) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1273 (fix pts_mode problem on jaguar) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error in datm8 with partial year forcing) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Change Filepath + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens (most code changes originate from mvertens) + I made some tweaks after the review and added protex header documentation to the + new clm_cpl_indices file. + +List any svn externals directories updated (csm_share, mct, etc.): datm, cism + datm to datm8_110118 + cism to cism1_100913 + +List all files eliminated: + +>>>>>>>>> Move to directories up a level + D models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + D models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + D models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 + +List all files added and what they do: + +>>>>>>>>> Use this local version of indices rather than seq_indices_mod.F90 + A models/lnd/clm/src/cpl_share/clm_cpl_indices.F90 + +>>>>>>>>> Move to directories up a level, use local version of indices rather +>>>>>>>>> than seq_* version and remove sending landfrac at run phase. + A models/lnd/clm/src/cpl_mct/lnd_comp_mct.F90 + A models/lnd/clm/src/cpl_esmf/lnd_comp_esmf.F90 + A models/lnd/clm/src/cpl_esmf/lnd_comp_mct.F90 + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/doc/README -- Update directory info. + +>>>>>>>>> Change pts_mode test so that RTM is not turned on. + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>> Change Filepath + M models/lnd/clm/bld/configure + +>>>>>>>>> Make is_restart() method public + M models/lnd/clm/src/main/clm_time_manager.F90 + +>>>>>>>>> Fix PTS_MODE. + M models/lnd/clm/src/main/pftvarcon.F90 ------- Pass posNOTonfile=.true. down + to ncd_io methods so won't check for lat/lon + M models/lnd/clm/src/main/ncdio_pio.F90 ------- Add posNOTonfile option to global + reads so that if set, won't try to find nearest lat/lon to PTS_MODE point + (for files that are global data NOT spatial). + M models/lnd/clm/src/biogeophys/SNICARMod.F90 - Pass posNOTonfile=.true. down + to ncd_io methods so won't check for lat/lon + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +>>>>>>>> Test was changed to remove RTM +025 blAK4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 1.9x2.5 gx1v6 -10 cold ...............FAIL! rc= 5 + bluefire/CESM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_20 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_20 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_20 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_20 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_20 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_20 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_20 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_20 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_20 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_20 +FAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_20 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_20 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_20 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_20 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_20 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_20 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_20 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_20 +>>>>>>>> Compare tests fail because Sl_landfrac is missing on new case +>>>>>>>> Everything else is identical + bluefire/PTCLM testing: All PASS + edinburgh/lf95 interactive testing: All PASS except... +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 + yong/intel interactive testing: +006 blAL4 TBL.sh _nrsc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ..................FAIL! rc= 5 +011 smD94 TSM.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +012 erD94 TER.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +013 blD94 TBL.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 4 +019 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +020 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_21 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_21 +Originator(s): jedwards (Jim Edwards) +Date: Wed Jan 12 14:50:45 MST 2011 +One-line Summary: Remove includes, finish PIO transition + +Purpose of changes: + +Code cleanup + +Remove misc.h/preproc.h, update SNICARMod to use ncdio_pio calls rather than NetCDF +directly. + +Bugs fixed (include bugzilla ID): + 394 (misc.h and preproc.h NOT used at all anymore) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1271 (Problem in PTS_MODE with clm) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error when a full year isn't available) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Removed generation of files misc.h and preproc.h + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, Erik K + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: misc.h, preproc.h + +D models/lnd/clm/tools/mksurfdata/misc.h +D models/lnd/clm/tools/mksurfdata/preproc.h +D models/lnd/clm/tools/mkdatadomain/preproc.h +D models/lnd/clm/tools/mkdatadomain/misc.h + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + models/lnd/clm/tools/mkgriddata/README + models/lnd/clm/tools/mksurfdata/README + models/lnd/clm/tools/mkdatadomain/README + models/lnd/clm/tools/README + models/lnd/clm/bld/configure + models/lnd/clm/bld/clm.cpl7.template + models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 + models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CNGRespMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNFireMod.F90 + models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 + models/lnd/clm/src/biogeochem/CNSummaryMod.F90 + models/lnd/clm/src/biogeochem/CNDVLightMod.F90 + models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 + models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 + models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 + models/lnd/clm/src/biogeochem/CNDVEcosystemDynIniMod.F90 + models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 + models/lnd/clm/src/biogeochem/C13SummaryMod.F90 + models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 + models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 + models/lnd/clm/src/biogeochem/CNAllocationMod.F90 + models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 + models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 + models/lnd/clm/src/biogeochem/CNSetValueMod.F90 + models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 + models/lnd/clm/src/main/organicFileMod.F90 + models/lnd/clm/src/main/dynlandMod.F90 + models/lnd/clm/src/main/accFldsMod.F90 + models/lnd/clm/src/main/fileutils.F90 + models/lnd/clm/src/main/pftdynMod.F90 + models/lnd/clm/src/main/pft2colMod.F90 + models/lnd/clm/src/main/restFileMod.F90 + models/lnd/clm/src/main/clm_varsur.F90 + models/lnd/clm/src/main/controlMod.F90 + models/lnd/clm/src/main/initSurfAlbMod.F90 + models/lnd/clm/src/main/filterMod.F90 + models/lnd/clm/src/main/clm_varorb.F90 + models/lnd/clm/src/main/initGridCellsMod.F90 + models/lnd/clm/src/main/pftvarcon.F90 + models/lnd/clm/src/main/spmdMod.F90 + models/lnd/clm/src/main/domainMod.F90 + models/lnd/clm/src/riverroute/RunoffMod.F90 + models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 + models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 + models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 + models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 + models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 + models/lnd/clm/src/biogeophys/QSatMod.F90 + models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 + models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 + + models/lnd/clm/src/biogeophys/SNICARMod.F90 + models/lnd/clm/src/main/ncdio_pio.F90 + + Removed reference to preproc.h and misc.h in all files. Converted snicarmod to use pio + and added support for a 3d non-decomposed real variable in ncdio. + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +NOTE: pts_mode tests failed... (bug 1271) + bluefire/CESM testing: All PASS + + jaguarpf: All pass except ... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 72+72 arb_ic ..................FAIL! rc= 10 +022 erH92 TER.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 10+38 cold FAIL! rc= 13 +023 brH92 TBR.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 72+72 cold FAIL! rc= 11 +038 smLI2 TSM.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +039 erLI2 TER.sh _sc_dm clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +040 brLI2 TBR.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +041 blLI2 TBL.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 +042 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 +043 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +044 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +045 blL58 TBL.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 48 arb_ic ....................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_19 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +Tag name: clm4_0_20 +Originator(s): erik (Erik Kluzek) +Date: Tue Jan 11 11:18:30 MST 2011 +One-line Summary: Update for ESMF metadata, update doc. from release branch, + bug fixes (doc of qflx_evap_tot, threading CNDV, aer/ndepregrid) + +Purpose of changes: + +Update externals, fix in datm speeds up single-point simulations, update for esmf +metadata capability. Update documentation from Release branch (cesm1_0_rel07_clm4_0_14). +Fix documentation of qflx_evap_tot. Fix ndepregrid/aerdepregrid scripts. Fix threading +problem with CNDV. + +Bugs fixed (include bugzilla ID): + 1266 (Threading problem with CNDV) + 1265 (Fix ndep/aerdepregrid.ncl) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1258 (runinit_ibm.csh needs to be updated) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1281 (bug in mksurfdata for urban_only case) + 1282 (Trouble running to last CLM1PT atm time-step) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1110 (dtlimit error when a full year isn't available) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: + Small section of clm_driver was moved to a OMP loop. This should + improve threading performance slightly. + +Code reviewed by: self, doc of qflx_evap_tot by Keith Oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, + stubs, datm, csm_share, timing + + scripts to scripts4_110108 + drv to drvseq3_1_47 + sice to stubs1_2_03 + socn to stubs1_2_03 + sglc to stubs1_2_03 + datm to datm8_110106 + csm_share to share3_101231 + timing to timing_101215 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Fix deposition regrid scripts so they will work (from crop04) + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Fix XML queries so will + work, using the datm_internal namelist now + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Fix XML queries so will + work, using stream_fldfilename_ndep in the ndepdyn_nml namelist. + +>>>>>>>>> Fix so will work (from rel07) + M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Fix config options so will work + M models/lnd/clm/bld/config_files/config_definition.xsl ---- Remove extra empty rows + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl Fix missing ">" + +>>>>>>>>> Update documentation (from rel07) + M models/lnd/clm/doc/UsersGuide/single_point.xml - Change how supported single-point + cases are handled and add documentation on setting start/stop times + M models/lnd/clm/doc/UsersGuide/tools.xml -------- Add new options to mksurfdata.pl + add notes about bugs, add notes that aer/ndepregid is optional + M models/lnd/clm/doc/UsersGuide/preface.xml ------ Update what_is_new section + M models/lnd/clm/doc/UsersGuide/clm_ug.xml ------- Add more versions in quicklist + M models/lnd/clm/doc/UsersGuide/appendix.xml ----- Add note about runinit_ibm.csh + problem + M models/lnd/clm/doc/UsersGuide/custom.xml ------- Remove DATM_PRESAERO=none option, + remove hist_crtinic, and use_ndepstream namelist settings + +>>>>>>>>> Update documentation (from rel07) + M models/lnd/clm/doc/KnownLimitations - Add doc on dtlimit error + M models/lnd/clm/doc/KnownBugs -------- Add bug 1168, remove bug 498 + M models/lnd/clm/doc/README ----------- Rework what's new + M models/lnd/clm/doc/index.shtml ------ Add link to KnownLimitations + M README ------------------------------ Rework what's new + +>>>>>>>>> Fix threading problem with CNDV, by adding an OMP loop in a section +>>>>>>>>> in clm_driver that didn't have one, pass down beg/end c|g|p indices +>>>>>>>>> as needed + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 - Pass in begc/endc, begp/endp + M models/lnd/clm/src/main/clm_initializeMod.F90 --- Add OMP loop over setFilters + M models/lnd/clm/src/main/pftdynMod.F90 ----------- Pass down beg/end indices as needed + pftdyn_wbal_init, pftdyn_cnbal, pftwt_interp, + M models/lnd/clm/src/main/filterMod.F90 ----------- Pass clump index down to setFilters + remove OMP from inside + M models/lnd/clm/src/main/clm_driver.F90 ---------- Add OMP loop around section that + wasn't inside an OMP loop + +>>>>>>>>> Fix the documentation of the qflx_evap_tot field + M models/lnd/clm/src/main/clmtype.F90 -------------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- Fix qflx_evap_tot doc + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 -- Fix qflx_evap_tot doc + +>>>>>>>>> Add component meta-data for ESMF + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - Add meta-data description + of CLM + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 -- Add more arguments to + lnd_register method + +Summary of testing: + + bluefire: All PASS except... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 4 +037 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +059 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +060 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +061 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +062 blLI1 TBL.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 4 + bluefire interactive testing: All PASS + bluefire/CESM testing: All PASS + bluefire/PTCLM testing: All PASS + jaguar interactive testing: All PASS except (up to 017 brJ74)... +011 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic +.............FAIL! rc= 10 +012 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic +...........FAIL! rc= 5 +013 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 + up to.... + +017 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:3600 1x1_tropicAtl test -3+-3 arb_ic .PASS + edinburgh/lf95 interactive testing: All PASS except... +005 smAL4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:1800 10x15 USGS -10 cold ....................FAIL! rc= 10 + edinburgh/PTCLM testing: All PASS up to ... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 + mirage,storm/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_19 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_19 +Originator(s): erik (Erik Kluzek) +Date: Wed Dec 8 22:20:30 MST 2010 +One-line Summary: Bring irrigation branch to the trunk + +Purpose of changes: + +Add option for simple code to redirect some riverflow to irrigate generic crops. +Irrigation is turned on at 6AM, runs for 4 hours and keeps soil moisture to 0.7. +Change corn and wheat indices to c3crop and irrigated generic c3 crop. +Add QIRRIG as a history file output. Change pft-physiology and RTM flow files from +ASCII to NetCDF. Single pft-physiology file can handle all cases (has extra FCUR value +for CNDV), also has for new fields for crops that will come in later: corn, spring-wheat, +winter-wheat and soybean. Add findat and fsurdat files for irrigation (f09, f19, f10, finidat +only for f19). Split RTM run method into three and move subroutines around to where makes +more sense. Fix a mksurfdata PFT override bug. Synchronize the Makefiles for the tools +and add build for Darwin intel and PGI and remove Darwin XLF. Remove concurrent +directives and UNICOSMP, CPP_VECTOR, NEC_SX CPP #ifdefs. Remove some #include +misc.h/preproc.h statements. Switch pio_close for ncd_close calls. Replace some constants +with parameters. Remove clm_comp layer and call clm_initialize and clm_driver directly. +Change mk*.F90 subroutines in mksurfdata into modules, so that argument checking will +happen at compile-time. + +Bugs fixed (include bugzilla ID): + 964 (Remove UNICOS #ifdef logic in clm) + 1238 (PST test fails) + 1249 (problem in mksurfdata for PFT override mode) + 1253 (mkglacier in mksurfdata has arguments in wrong order) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1248 (PTCLM can only go to 2005) + 1251 (PTCLM testcases aborts in I_QIAN case) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + 1298 (Can NOT turn RTM off in CLM_CONFIG_OPTS) + 1299 (interpinic does NOT work going from non glc_mec) + 1304 (bug in interpinic *_var) + 1306 (mksoifmaxInit is NOT called) + 1305 (dvolrdt is documented with the wrong units) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add -irrig and -rtm_res options to build-namelist + ++ -irrig Seek surface datasets with irrigation turned on. ++ -rtm_res "resolution" Specify river transport model resolution. + (Still only have half-degree files in the XML database) + + Add new history field: + + QIRRIG water added through irrigation (mm/s) + +List any changes to the defaults for the boundary datasets: NetCDF pft-phys/RTM files + NetCDF PT-physiology file: pft-physiology.c101006.nc + finidat and surfdata files for irrigation (for 1.9x2.5@2000) + surfdata files for irrigation (for f09 and f10) + NetCDF River-direction file: clmi.IQirrcr_2000-01-01_1.9x2.5_gx1v6_c101115.nc + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, slevis, dlawren, wsacks, mvertens, swensosc + slevis/wsacks -- irrigation changes + dlawren -------- convert pft-physiology file to NetCDF + mvertens ------- high level restructuring + swensosc ------- convert RTM flow file to NetCDF + +List any svn externals directories updated (csm_share, mct, etc.): scripts and csm_share + + scripts to scripts4_101206 + csm_share to csm_share3_101122 + +List all files eliminated: + +D models/lnd/clm/src/main/inicFileMod.F90 --------- Move to inicPerpMod +D models/lnd/clm/src/main/clm_comp.F90 ------------ Move to clm_initialize and + clm_driver +D models/lnd/clm/src/main/scam_setlatlonidx.F90 --- Use shr_scam version +D models/lnd/clm/src/main/snowdp2lev.F90 ---------- Move to mkarbinitMod +D models/lnd/clm/src/main/areaMod.F90 ------------- Split out into relavent modules: + celledge -> RtmMapMod + map_setmapsAr -> RmtMapMod + cellarea -> clm_initialize + map_setgatm -> downscaleMod +D models/lnd/clm/test/system/tests_posttag_spot1 -- rename to yong + +D models/lnd/clm/tools/mksurfdata/mkfmax.F90 ---- rename to mkfmaxMod.F90 +D models/lnd/clm/tools/mksurfdata/mkvocef.F90 --- rename to mkvocefMod.F90 +D models/lnd/clm/tools/mksurfdata/mkglacier.F90 - put in mkglcmecMod.F90 +D models/lnd/clm/tools/mksurfdata/mklanwat.F90 -- rename to mklanwatMod.F90 +D models/lnd/clm/tools/mksurfdata/mkelev.F90 ---- put in mkurbanparMod.F90 +D models/lnd/clm/tools/mksurfdata/mkurban.F90 --- put in mkurbanparMod.F90 +D models/lnd/clm/tools/mksurfdata/mksoitexMod.F90 rename to mksoilMod.F90 + +List all files added and what they do: + +A + models/lnd/clm/test/system/nl_files/clm_irrig -- New irrigation test + +>>>>>>>>>>> Some high level restructuring/renames +A + models/lnd/clm/src/main/inicPerpMod.F90 -------- From inicFileMod +A + models/lnd/clm/src/riverroute/RtmMapMod.F90 ---- From areaMod.F90 +A models/lnd/clm/test/system/tests_posttag_yong -- rename add more tests + +>>>>>>>>>>> Rename mksurfdata subroutines into modules +A models/lnd/clm/tools/mksurfdata/mkfmaxMod.F90 +A models/lnd/clm/tools/mksurfdata/mksoilMod.F90 +A models/lnd/clm/tools/mksurfdata/mkvocefMod.F90 +A models/lnd/clm/tools/mksurfdata/mklanwatMod.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Add irrigation "AZ" tests at 10x15 with irrigation on +M models/lnd/clm/test/system/tests_posttag_lynx_nompi +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_pretag_edinburgh +M models/lnd/clm/test/system/tests_pretag_jaguar_nompi +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/tests_posttag_intrepid_nompi +M models/lnd/clm/test/system/tests_posttag_nompi_regression +M models/lnd/clm/test/system/tests_pretag_bluefire_nompi -- Remove repeated test + +M models/lnd/clm/test/system/README.testnames --- Add Z res (10x15 with irrig) +M models/lnd/clm/test/system/test_driver.sh ----- Changes for lynx and yong + +>>>>>>>>>>> Fix bug 1249 for PFT overrides, correct irrigation sample namelist +>>>>>>>>>>> Change subroutines into modules for mk*.F90 files (allows compiler to check args) +>>>>>>>>>>> Fix bug 1253 putting mksoitex call after mkglacier +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig - Correct name of irrigation dataset +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 nullify pctpft_i +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 Set nlat_i/nlon_i to 1 if PFT override +M models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 -- Add mkglacier subroutine +M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 Add mkurban and mkelev subroutines +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ----- Change subroutines into modules + nullify pctpft_i, put mksoitex call after mkglacier +M models/lnd/clm/tools/mksurfdata/Srcfiles --------- Change names of files +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ----- Add mkirrig subroutine + + +>>>>>>>>>>> Sync up the tools Makefiles and add darwin intel and pgi build (remove darwin xlf) +M models/lnd/clm/tools/mksurfdata/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/interpinic/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/mkgriddata/Makefile ---- Sync up makefiles, add darwin build +M models/lnd/clm/tools/mkdatadomain/Makefile -- Sync up makefiles, add darwin build + +>>>>>>>>>>> Add -irrig and -rtm_res options, update files to new NetCDF versions, +>>>>>>>>>>> add in findat/fsurdat files for irrigation (f19,f10, f09) +M models/lnd/clm/bld/build-namelist ----- Add -irrig, -rtm_res options + set do_budgets, and budget_inst in drv_namelist, finidat/fsurdat depend on irrig + set create_crop_landunit by irrig +M models/lnd/clm/bld/clm.cpl7.template -- Set CLM_RTM_RES to half-degree and pass + to build-namelist +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ add irrig and rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml default for irrig and rtm_res +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---- New NetCDF + pft-physiology file (for all configs), finidat and fsurdat files check + irrig, f19, f10, and f09 surfdata files for irrigation (and f19 finidat) + defaults for create_croplandunit, new NetCDF RTM direction file +M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ---- Set do_budgets + to .true. and budget_inst to 1. + +>>>>>>>>>>> Remove concurrent directives and misc.h/preproc.h #includes +>>>>>>>>>>> Remove scam_setlatlonidx and use shr_scam_. +>>>>>>>>>>> Switch ncorn for nc3crop and nwheat for nirrig change pio_close for ncd_close +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 -------- Remove concurrent directives + remove misc.h/preproc.h #includes +M models/lnd/clm/src/biogeochem/CASAMod.F90 ----------- Change pio_closefile to + ncd_pioclosefile +M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 - Remove directives +M models/lnd/clm/src/biogeochem/DUSTMod.F90 ----------- Remove directives +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 ncorn->nc3crop, + use shr_scam_getCloseLatLon in place of scam_setlatlonidx, + Remove directives, switch pio_close with ncd_pio_closefile +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ------- Remove directives and #includes +M models/lnd/clm/src/biogeochem/CNDVMod.F90 ----------- Switch pio_plosefile with ncd_close +M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ---- ncorn->nc2crop +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ---- ncorn->nc3crop, nwheat->nirrig + and remove #includes +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 ncorn->nc3crop, nwheat->nirrig + and remove #includes + +>>>>>>>>>>> Remove concurrent directives and misc.h/preproc.h #includes +>>>>>>>>>>> Remove scam_setlatlonidx and use shr_scam_. +>>>>>>>>>>> Switch ncorn for nc3crop and nwheat for nirrig change pio_close for ncd_close +M models/lnd/clm/src/main/clm_varcon.F90 ------- Add degpsec, isecspday, + and remove #includes +M models/lnd/clm/src/main/clm_varpar.F90 ------- Remove #includes, add ivis/inir + indices, and make rtmlat/rtmlon variables not parameters +M models/lnd/clm/src/main/CNiniTimeVar.F90 ----- Remove directives, and #includes, + add qflx_irrig +M models/lnd/clm/src/main/abortutils.F90 ------- Remove directives, and #includes + and NEC_SX, and UNICOSMP CPP defines +M models/lnd/clm/src/main/accumulMod.F90 ------- Remove directives +M models/lnd/clm/src/main/decompInitMod.F90 ---- Remove UNICOSMP CPP defines +M models/lnd/clm/src/main/clm_initializeMod.F90 Move cellarea from areaMod to here + work with downscale a bit, add stuff from clm_comp init to here +M models/lnd/clm/src/main/clmtypeInitMod.F90 --- Add irrig_rate and n_irrig_steps_left +M models/lnd/clm/src/main/iniTimeConst.F90 ----- Switch pio_close with ncd_close, + add single-column read for PCT_CLAY, switch 86400 for secspday +M models/lnd/clm/src/main/histFileMod.F90 ------ Remove UNICOSMP, switch pio_close + with ncd_close +M models/lnd/clm/src/main/restFileMod.F90 ------ Switch pio_close with ncd_close +There's also a new driver namelist setting that will update the orbit each year +(setting orb_mode and orb_iyear_align). + +Bugs fixed (include bugzilla ID): + 1225 (abort if both trigrid and finemesh on) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 935 (RTM warning NOT an error) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on mirage...) + 1165 (Restart trouble for scaled harvest test on mirage) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1238 (PST test fails) + 1239 (ESMF build fails) + 1240 (lynx_pgi build fails) + 1249 (problem in mksurfdata for PFT override mode) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + 1318 (interpinic has trouble with new restart files) + 1372 (pio problem writing out CLM history files for CRU + 1381 (Can't change monthly average files to NOT be one per month) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart) + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: Add in darwin_intel build + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: Add in T341 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, + csm_share, pio, mct, cprnc + + scripts to mpiserial07_scripts4_101117 + drv to drv3_1_45 + datm to datm8_101105 + csm_share to share3_101118 + pio to pio1_2_6 + mct to MCT2_7_0_100228-mpiserial101109_tag02 + cprnc to cprnc_101119 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/tests_pretag_jaguar - remove non-existant tests + +>>>>>>>>>> Remove clmi frequency setting, add darwin build/run + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/TBR.sh + M models/lnd/clm/test/system/test_driver.sh - Add darwin builds + M models/lnd/clm/test/system/mknamelist + +>>>>>>>>>> Change orb_iyear for orb_iyear_ad + M models/lnd/clm/test/system/nl_files/nl_urb + M models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + M models/lnd/clm/test/system/nl_files/clm_ndepdyn -- remove ndepsrc stream setting + Can now replace usage of this file with clm_std + M models/lnd/clm/test/system/nl_files/nl_cn_conly + M models/lnd/clm/test/system/nl_files/nl_urb_br + +>>>>>>>>>> Get build working with darwin_intel + M models/lnd/clm/bld/configure ------ get it working with darwin_intel + M models/lnd/clm/bld/clm.cpl7.template - Use $GMAKE, set to gmake if not set + +>>>>>>>>>> Remove non-existant resolution: 2.5x3.33 + M models/lnd/clm/bld/namelist_files/checklatsfiles.ncl + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl + +>>>>>>>>>> Add orb_mode, set orbit based on it, also add orb_iyear_align +>>>>>>>>>> Add run_barriers, pio_inparm namelist, add T341 resolution (512x1024) + M models/lnd/clm/bld/build-namelist - Set orbit based on orb_mode, set pio namelist + for stand-alone testing, + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Remove pio namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/datm-build-namelist + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Add T341: griddata, + fracdata, surfdata, topodata (fracdata for USGS and tx0.1 masks)` + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml + +>>>>>>>>>> Switch orb_iyear for orb_iyear_ad + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +>>>>>>>>>> Switch ncd_x for pio_x/nf_x +>>>>>>>>>> Fix a couple memory leaks that Jim Edwards found +>>>>>>>>>> Make ncd_pio private, add documentation add attributes for restart history +>>>>>>>>>> files, add 2D character read (needed for NetCDF pft-physiology file read on +>>>>>>>>>> irrigation branch) + M models/lnd/clm/src/biogeochem/CASAMod.F90 ------------ Replcae pio_x + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - use masterproc at top of module + M models/lnd/clm/src/biogeochem/CNDVMod.F90 ------------ Replace pio_x + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ---------- Replace pio_x + M models/lnd/clm/src/main/inicFileMod.F90 -------------- Add use MPI_LOGICAL + M models/lnd/clm/src/main/accumulMod.F90 --------------- Replace pio_x + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Remove samegrids use downscale, + don't pass namelist to ncd_pio initialization + M models/lnd/clm/src/main/subgridRestMod.F90 ----------- Add use endrun, switch ncd_x for nf_x + M models/lnd/clm/src/main/ndepStreamMod.F90 ------------ PIO initialization uses + driver settings, pass get_calendar to initialization + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add attributes to history restart files + M models/lnd/clm/src/main/restFileMod.F90 -------------- Replace pio_x + M models/lnd/clm/src/main/clm_time_manager.F90 --------- Replace nf_x with ncd_x add + get_calendar + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ----- Abort if trigrid and downscale + Update orbit params in run-phase + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Remove samegrids + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 --- Abort if trigrid and downscale + Update orbit params in run-phase + M models/lnd/clm/src/main/ncdio_pio.F90 ---------------- Update documentation, make private + add ncd_pio_closefile wrapper, make some pio interfaces public from here, + add ncd_io_char_var2_nf for NetCDF pft-physiology file, remove pio namelist + remove a second allocation that Jim Edwards found + M models/lnd/clm/src/main/surfrdMod.F90 ---------------- Fix memory leak from Jim Edwards + M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Switch nf_x with ncd_x + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 -- Add use for spval and iulog, + change nf_x for ncd_x + +Summary of testing: + +All TBL tests fail... (although you can use clm4_0_16 with updated externals and show b4b) + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 + bluefire interactive testing: All PASS + bluefire/CESM testing: +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_16 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_16 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_16 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_16 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_16 +FAIL PST.f45_g37.I1850.bluefire <<<<< Didn't create scripts problem, bug 1238 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_16 +FAIL ERS_E.f19_g16.I1850.bluefire <<<< Scripts build issue, bug 1239 +BFAIL ERS_E.f19_g16.I1850.bluefire.generate.clm4_0_17 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_16 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_16 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_16 +FAIL PST.f10_f10.I8520CN.bluefire <<<<< Didn't create scripts problem, bug 1238 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_16 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_16 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_16 + bluefire/PTCLM testing: All PASS + jaguar: All PASS except... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 72+72 arb_ic ..................FAIL! rc= 13 +022 erH92 TER.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 10+38 cold FAIL! rc= 13 +023 brH92 TBR.sh 17p_cnsc_dm clm_ndepdyn^nl_cn_conly 20020101:1800 4x5 gx3v7@1850-2000 72+72 cold FAIL! rc= 11 +038 smLI2 TSM.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10 arb_ic .............................FAIL! rc= 10 +039 erLI2 TER.sh _sc_dm clm_std 20020101:1800 94x192 T62 -5+-5 arb_ic ...........................FAIL! rc= 5 +040 brLI2 TBR.sh _sc_dm clm_std 20020101:1800 94x192 T62 -10+-10 arb_ic .........................FAIL! rc= 5 +042 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 +043 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +044 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 + jaguar interactive testing: All PASS except... +007 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +008 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +009 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +027 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + edinburgh/lf95 interactive testing: All PASS + edinburgh/lf95 testing: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:1200 4x5 gx3v7 72+72 cold ....................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic ..............FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 96 arb_ic .................FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:1800 4x5 gx3v7 10+38 arb_ic ..............FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:1800 4x5 gx3v7 72+72 arb_ic ...........FAIL! rc= 5 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:1800 10x15 USGS@2000 10+38 cold ............FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:1800 10x15 USGS@2000 72+72 cold .........FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:1800 10x15 USGS 96 arb_ic .......................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:1800 10x15 USGS 10+38 arb_ic ....................FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:1800 10x15 USGS 72+72 arb_ic .................FAIL! rc= 5 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 96 cold ..FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 5 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:1800 10x15 USGS 96 arb_ic ....................FAIL! rc= 10 + edinburgh/PTCLM testing: All PASS up to... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 + mirage,storm/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:1800 10x15 USGS@1850 10+38 cold .........FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:1800 10x15 USGS@1850 72+72 cold ......FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 144 arb_ic .............FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 10+38 arb_ic ...........FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:1800 10x15 USGS@1000-1002 72+72 arb_ic ...........FAIL! rc= 5 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 10+38 cold FAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:1800 10x15 USGS@2000 72+72 cold FAIL! rc= 11 + lynx/pgi testing: All FAIL scripts build issue <<<< bug 1240 + yong/darwin_intel testing: All PASS up to ... +005 smD94 TSM.sh _persc_ds clm_per^nl_urb 20021231:1200 4x5 gx3v7 144 cold ......................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_16 + + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All with datm + - what platforms/compilers: All + - nature of change: roundoff + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + PERGRO test on bluefire + +=============================================================== +=============================================================== +Tag name: clm4_0_16 +Originator(s): erik/mvertens (Kluzek Erik 1326 CGD) (Vertenstein Mariana 1349 CGD) +Date: Wed Oct 27 13:33:21 MDT 2010 +One-line Summary: Fix downscaling roundoff difference for same-grids by copying scale factor when needed + +Purpose of changes: + +Fix bug 1230, that caused problems with runoff to the ocean when running fully coupled. The global integrals of runoff fields +was the same in the coupler -- but the values where roundoff different. This caused problems both in testing for bit-for-bit with +the previous version and with restarts. The problem was that in the downscaling changes made in clm4_0_15 the areal scaling factor +asca needed to be copied from adomain into ldomain is no downscaling is taking place. + +Bugs fixed (include bugzilla ID): +=============================================================== +Tag name: clm4_0_14 +Originator(s): erik (Erik Kluzek) +Date: Tue Oct 19 13:12:36 MDT 2010 +One-line Summary: Fix finidat file for T31 sim_year=2000 cases + +Purpose of changes: + +Remove the 1850 T31 finidat file for sim_year=2000 and use the previous sim_year=2000 +files (created using interpinic). Update scripts and datm. + +Bugs fixed (include bugzilla ID): Correct finidat file for T31 sim_year=2000 + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1249 (problem in mksurfdata for PFT override mode) + 1258 (runinit_ibm.csh needs to be updated) + 1264 (Incorrect doc of qflx_evap_tot in the code) + 1265 (Fix ndep/aerdepregrid.ncl) + 1266 (Threading problem with CNDV) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Go back to T31,sim_year=2000 +finidat file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and datm + + scripts to mpiserial05_scripts4_101018 + datm to datm8_101008 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Return to old + finidat file for T31 sim_year=2000 +M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - change + fearedep to datm_file_aero + +Summary of testing: + + bluefire/CESM testing: +PASS SMS_D.T31_g37.I1850CN.bluefire +PASS SMS_D.T31_g37.ICN.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm4_0_13 + +Changes answers relative to baseline: T31 2000 cases + +=============================================================== +=============================================================== +Tag name: clm4_0_13 +Originator(s): erik (Erik Kluzek) +Date: Sat Oct 16 09:14:08 MDT 2010 +One-line Summary: Bring in PTCLM branch, add in T31 finidat file and turn off ice_runoff for T31 + +Purpose of changes: + +Bring in PTCLM work. Update externals for scripts, datm, drv. Get mksurfdata to have options to override soil/PFT with user input values. Fix some issues with getregional_datasets.pl. Remove old stand-alone CLM Makefile (always use CESM Macro's files and Makefile). More removal of ndepsrc in build-namelist. Turn off ice_runoff for T31. Add in T31 finidat file. + +Bugs fixed (include bugzilla ID): + 1189 (Create ability to change soil color/texture in mksurfdata) + 1188 (Add ability to handle control transient land-cover change) + 1206 (Problem looping over a single year of CPLHIST forcing) + 1211 (Small memory leak in CLM4 initialization) + 1223 (ESMF problem) +Known bugs (include bugzilla ID): + 701 (svn keyword) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) + 1249 (problem in mksurfdata for PFT override mode) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1147 (mkgriddata can't straddle over Greenwich) + 1025 (SCM mode can NOT use a global finidat file) + 1017 (SCM mode can NOT restart + 452 (Problem with support of soil-colors != 8 or 20) + +Type of tag: standard + +Describe any changes made to build system: + + Remove custom options to stand-alone build/test, require using cesm make files + +Describe any changes made to the namelist: None, although many new options to mksurfdata namelist + +List any changes to the defaults for the boundary datasets: New T31 finidat files + +Describe any substantial timing or memory changes: none + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + + drv to drvseq3_1_37 + datm to datm8_100921 + csm_share to share3_101001 + scripts to PTCLM03_scripts4_101005 + +List all files eliminated: + + R models/lnd/clm/test/system/tests_posttag_breeze >>> rename to mirage +>>>>>>>>>>> Rename to module + R models/lnd/clm/tools/mksurfdata/mkglcmec.F90 + R models/lnd/clm/tools/mksurfdata/mksoicol.F90 + R models/lnd/clm/tools/mksurfdata/mksoitex.F90 + + R models/lnd/clm/bld/config_files/Makefile.in --- Remove always use CESM make + +List all files added and what they do: + +>>>>>>>>>>> Renames + A models/lnd/clm/test/system/tests_posttag_mirage + A models/lnd/clm/tools/mksurfdata/mkglcmecMod.F90 + A models/lnd/clm/tools/mksurfdata/mksoitexMod.F90 + A models/lnd/clm/tools/mksurfdata/mksoicolMod.F90 + +>>>>>>>>>>> Namelist settings for standard urban single-point + A models/lnd/clm/bld/namelist_files/use_cases/stdurbpt.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Remove PTS_MODE restart/branch tests + M models/lnd/clm/test/system/tests_posttag_lynx_nompi + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_posttag_spot1 --------- remove hybrid test + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_intrepid_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>> Change breeze+ for mirage changes for new build that requires CESM build files + M models/lnd/clm/test/system/TCB.sh -------------------- Set nc_path + M models/lnd/clm/test/system/config_files/_nrmexsc_ds -- Use -sitespf_pt + M models/lnd/clm/test/system/config_files/_nrvansc_ds -- Use -sitespf_pt + M models/lnd/clm/test/system/test_driver.sh ------------ Swap out mirage/storm for breeze+, add GEN machine options, remove CLM_CESMBLD + M models/lnd/clm/test/system/mknamelist ---------------- Use config_file variable + M models/lnd/clm/test/system/TSMscript_tools.sh -------- Add exedir + M models/lnd/clm/test/system/CLM_runcmnd.sh ------------ Add more options for yong, change breeze+ to mirage/storm + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 ------ Add exedir + M models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 - Add exedir + +>>>>>>>>>>> Add new options to override dataset setttings with your own values for: soil color/texture, and PFT + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 ----- Make private + M models/lnd/clm/tools/mksurfdata/mkglacier.F90 ---- Add option to zero out glacier + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 - Add mkharvest_parse_oride to override harvesting + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ---- Move nglcec here + M models/lnd/clm/tools/mksurfdata/mklanwat.F90 ----- Add option to zero out lake + M models/lnd/clm/tools/mksurfdata/mkurban.F90 ------ Add option to zero out urban + M models/lnd/clm/tools/mksurfdata/mkvarsur.F90 ----- Make private + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ----- Add new namelist options: soil_color, soil_sand, soil_clay, pft_idx, pft_frc + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 ----- Add init and override methods: mkpftInit, mkpft, and mkpft_parse_oride + M models/lnd/clm/tools/mksurfdata/Filepath --------- Add esmf_wrf_timemgr to directory list + M models/lnd/clm/tools/mksurfdata/Srcfiles --------- Change names, add shr_cal_mod, shr_string_mod, and ESMF files + + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---- Add new options to override your own values, and error check the input: ++ -dynpft "filename" Dynamic PFT/harvesting file to use ++ (rather than create it on the fly) ++ (must be consistent with first year) ++ -exedir "directory" Directory where mksurfdata program is ++ (by default assume it's in the current directory) ++OPTIONS to override the mapping of the input gridded data with hardcoded input ++ ++ -pft_frc "list of fractions" Comma delimited list of percentages for veg types ++ -pft_idx "list of veg index" Comma delimited veg index for each fraction ++ -soil_cly "% of clay" % of soil that is clay ++ -soil_snd "% of sand" % of soil that is sand + +>>>>>>>>>>> Start fixing some issues with getregional scripts +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl + +>>>>>>>>>>> Add USER_FCTYP + M models/lnd/clm/tools/mksurfdata/Makefile + M models/lnd/clm/tools/interpinic/Makefile + M models/lnd/clm/tools/mkgriddata/Makefile + M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>> Remove stand-alone user options and require cesm_bld, add ice_runoff run_stopdate, and new finidat files for T31, more ndepmapalgo defaults +>>>>>>>>>>> Change stop_n values for urban single-point so will run to completion + M models/lnd/clm/bld/configure --------------- Remove options: test, cc, cflags, fc, fflags, fopt, gmake, ldflags, linker, mpi/nc_inc/_lib + add nc_path and mpi_path options, require cesm_bld, and remove logic for doing + clm-stand-alone build + M models/lnd/clm/bld/queryDefaultNamelist.pl - Check for valid values, add list options, + M models/lnd/clm/bld/queryDefaultXML.pm ------ Change a comment + M models/lnd/clm/bld/build-namelist ---------- Add setting of ice_runoff + M models/lnd/clm/bld/config_files/config_sys_defaults.xml --- Set more default machine names + M models/lnd/clm/bld/config_files/config_definition.xml ----- Remove compiler options above and add nc_path/mpi_path + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add run_stopdate and work on comments + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add ice_runoff defaults, new finidat files for T31, add more ndepmapalgo defaults + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml - Change stop_n for urban single-point, add stop_date + + M models/lnd/clm/doc/UsersGuide/preface.xml - Change comment + +>>>>>>>>>>> Fix two code bugs (1211 and 1223) + M models/lnd/clm/src/main/iniTimeConst.F90 ------------ make sure to deallocate memory + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 -- add use statement needed for endrun + +Summary of testing: + + bluefire testing: All PASS except.. (up to 054 smI59) +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS except.. +061 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 6 + bluefire/CESM testing: All PASS except +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_11 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_11 + jaguar interactive testing: All PASS except... +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 10 +007 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +008 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +009 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/lf95 interactive testing: All PASS + mirage/storm.intel interactive testing: ALL PASS up to... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_12 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_12 +Originator(s): erik (Erik Kluzek) +Date: Fri Sep 10 13:07:03 MDT 2010 +One-line Summary: Add U10 to history, cesm1_0_rel06 updates, PTCLM02 updates (except + mksurfdata), remove ndepdat/dyn/faerdep + +Purpose of changes: + +Update to latest cesm1 release branch. Change SPMD from spmd to use_mpiserial in +configure. Remove old aerdep and ndepdat/dyn files from code and scripts. Change ccsm in +scripts to cesm. Add in new U10 field to history files, change old name to U10_DUST. Some +updates from PTCLM branch for XML database. Also perturb initial conditions read in from +initial file by pertlim. With with PERGRO CPP #ifdef a bit. Start adding in testing on +lynx. + +Bugs fixed (include bugzilla ID): + 1199 (Add trusted machine history file for PERGRO analysis) + 1196 (Add urban option to configure, delete GRANDVIEW ifdefs) + 1191 (UG documentation for single-point needs to change que to shared-que) + 1167 (Add note about reducing PE's for single-point mode) + 1115 (Make config_definition names the same as configure options) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1206 (Problem looping over a single year of CPLHIST forcing) + http://bugs.cgd.ucar.edu/ + +Known Limitations: + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1147 (mkgriddata can't straddle over Greenwich) + +Type of tag: std-test + +Describe any changes made to build system: + Names of configure modes changed: seq_ccsm to clm_stndln, and ext_ccsm_seq to ext_cesm + Add sitespf_pt option which will set either MEXICOCITY or VANCOUVER cpp ifdefs + Names of some configure options changed to make consistent with config_definition file. + +Describe any changes made to the namelist: Remove use_ndepstream/fndepdat/fndepdyn/faerdep + +List any changes to the defaults for the boundary datasets: + + New 10x15 rcp6 transient 1850-2100 pftdyn dataset + Add navy oro file to clm_tools XML file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, U10 code from Keith Oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts and datm + scripts to scripts4_100901a + datm to datm8_100830 + +List all files eliminated: + + D models/lnd/clm/src/main/aerdepMod.F90 + D models/lnd/clm/src/main/ndepFileMod.F90 + D models/lnd/clm/tools/ncl_scripts/convertUrbanOffline2Seq.ncl + D models/lnd/clm/tools/ncl_scripts/getndepdatFrom20thCentury.ncl + D models/lnd/clm/tools/mkgriddata/mkgriddata.ccsm_dom -- Rename to .cesm_dom + D models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all files added and what they do: + +>>>>>>>>>> Transient test files for rcp2.6 and rcp4.5, start adding lynx testing + A models/lnd/clm/test/system/nl_files/clm_transient_rcp2.6 + A models/lnd/clm/test/system/nl_files/clm_transient_rcp4.5 + A models/lnd/clm/test/system/tests_posttag_lynx + A models/lnd/clm/test/system/tests_posttag_lynx_nompi + +>>>>>>>>>> Sample perturbation growth data for jaguar, intel and lahey + A models/lnd/clm/tools/ncl_scripts/RMSjaguar.dat + A models/lnd/clm/tools/ncl_scripts/RMSintel.dat + A models/lnd/clm/tools/ncl_scripts/RMSlahey.dat + + A models/lnd/clm/tools/mkgriddata/mkgriddata.cesm_dom - rename from .ccsm_dom + +>>>>>>>>>> Plot of sample bad perturbation error growth + A models/lnd/clm/doc/UsersGuide/badpergro.jpg + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Change ccsm_seq=>clm_stndln, spmd=>nouse_mpiserial + M models/lnd/clm/test/system/config_files/_nrsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_nrsc_ds + M models/lnd/clm/test/system/config_files/17p_scnv_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_m + M models/lnd/clm/test/system/config_files/_scnv_dh + M models/lnd/clm/test/system/config_files/_nrsc_dm + M models/lnd/clm/test/system/config_files/17p_cndvsc_o + M models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/_nrsc_do + M models/lnd/clm/test/system/config_files/_persc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cndvsc_s + M models/lnd/clm/test/system/config_files/_nrsc_ds + M models/lnd/clm/test/system/config_files/_scnv_do + M models/lnd/clm/test/system/config_files/_persc_dm + M models/lnd/clm/test/system/config_files/_persc_do + M models/lnd/clm/test/system/config_files/4p_vodsrsc_dh + M models/lnd/clm/test/system/config_files/_persc_ds + M models/lnd/clm/test/system/config_files/_nrmexsc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_dm + M models/lnd/clm/test/system/config_files/_nrcnsc_do + M models/lnd/clm/test/system/config_files/17p_sc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_do + M models/lnd/clm/test/system/config_files/_mec10sc_dm + M models/lnd/clm/test/system/config_files/_nrcnsc_ds + M models/lnd/clm/test/system/config_files/4p_casasc_dh + M models/lnd/clm/test/system/config_files/4p_vodsrsc_ds + M models/lnd/clm/test/system/config_files/17p_sc_dm + M models/lnd/clm/test/system/config_files/_mec10sc_do + M models/lnd/clm/test/system/config_files/17p_sc_do + M models/lnd/clm/test/system/config_files/_sc_dh + M models/lnd/clm/test/system/config_files/_mec10sc_ds + M models/lnd/clm/test/system/config_files/4p_casasc_dm + M models/lnd/clm/test/system/config_files/4p_casasc_do + M models/lnd/clm/test/system/config_files/17p_sc_ds + M models/lnd/clm/test/system/config_files/_sc_dm + M models/lnd/clm/test/system/config_files/4p_casasc_ds + M models/lnd/clm/test/system/config_files/_nrsc_s + M models/lnd/clm/test/system/config_files/_sc_do + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_m + M models/lnd/clm/test/system/config_files/_sc_ds + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/_nrvansc_ds + M models/lnd/clm/test/system/config_files/17p_sc_h + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/4p_casasc_h + M models/lnd/clm/test/system/config_files/17p_sc_m + M models/lnd/clm/test/system/config_files/17p_sc_o + M models/lnd/clm/test/system/config_files/_sc_h + M models/lnd/clm/test/system/config_files/4p_casasc_m + M models/lnd/clm/test/system/config_files/4p_casasc_o + M models/lnd/clm/test/system/config_files/_sc_m + M models/lnd/clm/test/system/config_files/17p_vodsrsc_h + M models/lnd/clm/test/system/config_files/17p_cndvsc_dh + M models/lnd/clm/test/system/config_files/_sc_o + M models/lnd/clm/test/system/config_files/17p_vodsrsc_m + M models/lnd/clm/test/system/config_files/_sc_s + M models/lnd/clm/test/system/config_files/17p_cndvsc_dm + M models/lnd/clm/test/system/config_files/17p_vodsrsc_o + M models/lnd/clm/test/system/config_files/17p_cndvsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/17p_vodsrsc_dh + M models/lnd/clm/test/system/config_files/_scsnf_dh + M models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + M models/lnd/clm/test/system/config_files/17p_vodsrsc_dm + M models/lnd/clm/test/system/config_files/_scsnf_dm + M models/lnd/clm/test/system/config_files/17p_vodsrsc_do + M models/lnd/clm/test/system/config_files/4p_vodsrsc_h + M models/lnd/clm/test/system/config_files/_scsnf_do + M models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_h + M models/lnd/clm/test/system/config_files/4p_vodsrsc_o + M models/lnd/clm/test/system/config_files/_mec10sc_m + M models/lnd/clm/test/system/config_files/_mec10sc_o + M models/lnd/clm/test/system/config_files/17p_scnv_dh + M models/lnd/clm/test/system/config_files/17p_cndvsc_h + M models/lnd/clm/test/system/config_files/README --- seq-ccsm=>standalone clm + +>>>>>>>>>> Change comments of CCSM to CESM, start adding in test support of lynx, convert +>>>>>>>>>> SPMD to NOUSE_MPISERIAL, change mode name of seq_ccsm to clm_stndln, add tests +>>>>>>>>>> for more rcp's. + M models/lnd/clm/test/system/TCB.sh ------------- CCSM_MACH=>CESM_MACH, ccsm_bld=>cesm_bld + M models/lnd/clm/test/system/README.testnames --- Change ccsm=>cesm, seq_ccsm=>clm_stndln + M models/lnd/clm/test/system/test_driver.sh ----- Change CLM_CCSMBLD=>CLM_CESMBLD, + Start adding lynx. + M models/lnd/clm/test/system/input_tests_master - Add HX and HY tests, ccsm=>cesm + M models/lnd/clm/test/system/README ------------- CLM_CCSMBLD=>CLM_CESMBLD + M models/lnd/clm/test/system/CLM_runcmnd.sh ----- NOSPMD=>NOUSE_MPISERIAL + +>>>>>>>>>> Change comments from ccsm to cesm, change namelist to get faerdep file from, +>>>>>>>>>> work on pergro plot so can plot more graphs. + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl --- ccsm=>cesm, + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl -- ccsm=>cesm, + get aerdep file from clmexp clm_tool namelist + M models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat ---- New data + M models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat ---- New data + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl --- Get from clmexp namelist + M models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl ----- Add ability to plot up to + five files, make sure lines are different, add success line to end. + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Do some operations with + out meta-data to save time and remove warnings + M models/lnd/clm/tools/ncl_scripts/README --------- Change ccsm=>cesm and improve + M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Change ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/mkvarctl.F90 ---- Correct documentation, ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 -- ccsm=>cesm + M models/lnd/clm/tools/mkgriddata/README ---------- ccsm=>cesm + M models/lnd/clm/tools/mkdatadomain/addglobal.F90 - ccsm=>cesm + +>>>>>>>>>> Changes comments of ccsm to cesm, add sitespf_pt config option, remove +>>>>>>>>>> -ndepsrc, add ndepmapalgo, switch prog_seasalt for progsslt, spmd for +>>>>>>>>>> nouse_mpiserial, change names of modes + M models/lnd/clm/bld/configure ---------------- ccsm=>cesm, +sitespf_pt, + prog_seasalt=>progsslt, spmd=>nouse_mpiserial, modes changed to + ext_cesm, and clm_stndln, remove setting of SPMD cppdef + M models/lnd/clm/bld/queryDefaultNamelist.pl -- ccsm=>cesm + M models/lnd/clm/bld/queryDefaultXML.pm ------- Remove ability to use cam config + file, spmd=>nouse_mpiserial + M models/lnd/clm/bld/build-namelist ----------- ccsm=>cesm, remove -ndepsrc, + add rcp to some settings, ccsm_seq=>clm_stndln, set start_ymd from + runstart_date, add settings of ndepmapalgo, remove fndepdat/dyn/faerdep + M models/lnd/clm/bld/clm.cpl7.template -------- Remove -spmd, mode now ext_cesm, + ccsm=>cesm + M models/lnd/clm/bld/README ------------------- CCSM=>CESM + M models/lnd/clm/bld/config_files/Makefile.in - SPMD=>NOUSE_MPISERIAL, ccsm=>cesm + M models/lnd/clm/bld/config_files/config_definition.xsl --- Titles to caption, + put valid_values under description + M models/lnd/clm/bld/config_files/config_sys_defaults.xml - spmd=>nouse_mpiserial + M models/lnd/clm/bld/config_files/config_definition.xml --- +sitespf_pt, + comp_interface=>comp_intf, ccsm=>cesm, spmd=>nouse_mpiserial, mode + valid values are: ext_cesm, clm_stndln + +>>>>>>>>>> Remove ndepsrc/usr_ndepstream/fndepdat/fndepdyn/faerdep add mksrf_navyoor +>>>>>>>>>> Change comments from ccsm to cesm, exchange run_startdate for start_ymd, add +>>>>>>>>>> ndepmapalo, add stop_option/stop_n settings for spinup modes + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --------- Remove + ndepsrc/use_ndepstream/fndepdat/dyn/faerdep, ccsm=>cesm, add mksrf_navyoro, + run_startdate, faerdep and fndepdat for aerdepregrid/ndepregrid tools, + add 0.33x0.33 resolution for navyoro file + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml --- Remove + ndepsrc add defaults when sitespf_pt is set + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ------ rcp6 datm_presaero + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----------- Add sitespf_pt + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --------- Headers to captions + M models/lnd/clm/bld/namelist_files/datm-build-namelist ------------- ccsm=>cesm + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ------- ccsm=>cesm, + remove use_ndepstream, faerdep, fndepdat, fndepdyn + add ndepmapalgo + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml - Add navy oro + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ------- Add + stop_option/stop_n for spinup modes, change start_ymd for run_startdate + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add ndepmapalgo + +>>>>>>>>>> Change config mode names (from ccsm_seq to clm_stndln), remove ndepsrc, +>>>>>>>>>> remove start_ymd, clm_demand just sets fpftdyn (fndepdat/dyn removed) + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/glacier_mec.xml ----- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml ---- mode + changes to clm_stndln + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml - mode + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml - mode + changes to clm_stndln, clm_demand just sets fpftdyn remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml --- mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml - mode + changes to clm_stndln, remove start_ymd, clm_demand just sets fpftdyn + remove ndepsrc + M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml -- Also output TSA + M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml - Also output TSA + +>>>>>>>>>> Change so any scripts calls start with "./", ccsm=>cesm, remove ndepsrc +>>>>>>>>>> Use macro for PTS_MODE, use .submit rather than .run scripts. +>>>>>>>>>> Add bit about managing your data with link_dirtree, add more notes and +>>>>>>>>>> examples for PERGRO testing, add more notes about using batch for single-pt +>>>>>>>>>> mode + M models/lnd/clm/doc/UsersGuide/trouble_shooting.xml -- Add more about ccsm log file + M models/lnd/clm/doc/UsersGuide/config_cache.xml ------ Update from configure + M models/lnd/clm/doc/UsersGuide/single_point.xml ------ Add section on which mode + Add warning about single-point on batch machines, remove warning about + error that was fixed, remove notes about setting ndepsrc + M models/lnd/clm/doc/UsersGuide/special_cases.xml ----- Use .submit, add notes + about using provided history files from bluefire for PERGRO testing, and + add bit about TSA as well as TSOI, add more machines and examples of + bad pergro for PERGRO examples. + M models/lnd/clm/doc/UsersGuide/tools.xml ------------- Remove ndepsrc stuff + M models/lnd/clm/doc/UsersGuide/preface.xml ----------- Talk about very latest updates. + remove bit about PERGRO not validated + M models/lnd/clm/doc/UsersGuide/clm_ug.xml ------------ Update version, remove bug fix + M models/lnd/clm/doc/UsersGuide/appendix.xml ---------- + M models/lnd/clm/doc/UsersGuide/adding_files.xml ------ Add bit about managing your + data when you use link_dirtree, update table, remove ndepsrc + M models/lnd/clm/doc/UsersGuide/custom.xml ------------ Remove bit about rcp experimental + comment out tables that cause docbook to fail with a seg fault. + M models/lnd/clm/doc/UsersGuide/pergro.jpg ------------ New data + M models/lnd/clm/doc/UsersGuide/Makefile -------------- Remove vandif bug fix + M models/lnd/clm/doc/Quickstart.userdatasets ---------- Shorten lines remove faerdep + correct procedure + M models/lnd/clm/doc/Quickstart.GUIDE ----------------- Use .submit script + M models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl - Change tables from + informal to formal, using captions for titles, add template for bold. + +>>>>>>>>>> Changes comments for CCSM to CESM, remove misc.h and preproc.h #includes +>>>>>>>>>> Remove use_ndepstream/fndepdat/fndepdyn/faerdep/set_*dep_from_file +>>>>>>>>>> Add u10_clm and va, add ability to perturb IC from startup finidat file + M models/lnd/clm/src/biogeochem/DUSTMod.F90 ----- CCSM=>CESM, remove misc/preproc.h + M models/lnd/clm/src/main/clm_comp.F90 ---------- CCSM=>CESM + M models/lnd/clm/src/main/clm_initializeMod.F90 - Remove use_ndepstream logic + hardwire it to on + M models/lnd/clm/src/main/clm_glclnd.F90 -------- CCSM=>CESM + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Add u10 and va + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Rm set_caerdep_from_file/dustdep + M models/lnd/clm/src/main/controlMod.F90 -------- Rm fndepdat, fndepdyn, + use_ndepstream, faerdep, ccsm=>cesm + M models/lnd/clm/src/main/clm_time_manager.F90 -- ccsm=>cesm, remove misc/preproc.h + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- lnd_chkAerDep_mct just + aborts if aerosols NOT sent from atm. + M models/lnd/clm/src/main/clm_driver.F90 ------------- Rm aerdep and old ndep interpoaltion + M models/lnd/clm/src/main/clm_varctl.F90 ------------- Rm set_caerdep_from_file/dustdep, + faerdep, fndepdat, fndepdyn, use_ndepstream + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - lnd_chkAerDep_mct just + aborts if aerosols NOT sent from atm. + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 -- ccsm=>cesm + M models/lnd/clm/src/main/surfrdMod.F90 ---------- ccsm=>cesm, remove misc/preproc.h + M models/lnd/clm/src/main/domainMod.F90 ---------- Rm misc/preproc.h, ccsm=>cesm + M models/lnd/clm/src/main/clmtype.F90 ------------ Add u10_clm, and va + M models/lnd/clm/src/main/histFldsMod.F90 -------- Add U10, and VA, and mv old U10 to U10_DUST + M models/lnd/clm/src/main/mkarbinitMod.F90 ------- Make into module, remove + misc/preproc.h, add seperate subroutine to perturb initial conditions + M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 - Remove misc/preproc.h, + remove GRANDVIEW #ifdefs + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Add u10/va, + remove misc/preproc.h and concurrent loops + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 Add some PERGRO #ifdef + remove misc/preproc.h + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Add perturbIC call + remove misc/preproc.h and concurrent loops + M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ---- Remove misc/preproc.h, + KO comments and concurrent loops + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------ Remove misc/preproc.h, + and GRANDVIEW #ifdefs + + M README - Start with ./, and correct .build script name, and use .submit in exp + +Summary of testing: + + bluefire interactive testing: All PASS except... +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + jaguar: All PASS except... +007 brB91 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic .............FAIL! rc= 13 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@1850 72+72 cold .FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_11 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_11 +Originator(s): erik (Erik Kluzek) +Date: Fri Aug 27 14:14:37 MDT 2010 +One-line Summary: New files for rcp6, fix MPI bug, update externals + +Purpose of changes: + +Add in new pftdyn and stream_ndep files for rcp=6.0. Fix MPI bug where send array was the same as receive array. +Fix problem with datm template on gust, and syntax errors for pt1_pt1 mode. Add start_tod to drv/scripts. + +Bugs fixed (include bugzilla ID): + 1197 (MPI problem sending and receiving data in same array) + 1207 (Problem with datm template on gust) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1206 (Problem looping over a single year of CPLHIST forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add ndepmapalgo + Move datasets just for clm tools to clm_tools namelist_defaults XML file + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, +csm_share + scripts to scripts4_100730 + drv to drvseq3_1_33 + datm to datm8_100728 + csm_share to share3_100802 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add configure test file for serial + A models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + +>>>>>>>>>>>> Add some files to test mksurfdata.pl script + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 + +>>>>>>>>>>>> Put all files for clm-tools in seperate file + A models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>>>>>>> Add new chapter on trouble shooting, add a script to limit +>>>>>>>>>>>> the line lengths, add style sheet to convert HTML XSL table +>>>>>>>>>>>> to docbook. Add file to fix vancouver problem. + A models/lnd/clm/doc/UsersGuide/trouble_shooting.xml + A models/lnd/clm/doc/UsersGuide/limitLineLen.pl + A models/lnd/clm/doc/UsersGuide/addxhtmlhead.pl + A models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl + A models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change some of the tests around + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>> Work with testing a bit, add mksurfdata.pl and drydep tests + M models/lnd/clm/test/system/README.testnames ---- Add "V" drydep test + M models/lnd/clm/test/system/test_driver.sh ------ Add pftdata, change +multi-processing a bit + M models/lnd/clm/test/system/TSMscript_tools.sh -- Fix some glitches + M models/lnd/clm/test/system/gen_test_table.sh --- Convert to xhtml + M models/lnd/clm/test/system/nl_files/clm_usrdat - Remove non-streams mode for ndep +and aerdep + M models/lnd/clm/test/system/input_tests_master -- Add mksurfdata.pl and drydep tests + make scsnf 4x5 rather than 10x15 + +>>>>>>>>>>>> Add -nomv, usrname, and pftdyn options, add ability to run in +>>>>>>>>>>>> a different directory, check for vegtyp files before running. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +>>>>>>>>>>>> Handle rcp's correctly, and handle datm streams for presaero files +>>>>>>>>>>>> and ndep streams files + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- default rcp=hist, set + RCP to ncl script + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - add ability to handle + usrname files, and handle ndep and aerdep streams files correctly + +>>>>>>>>>>>> Move tools files into clm_tools default file, add ndepmapalgo +>>>>>>>>>>>> Work on the formatting of the files, do better with clm_usrdat_name + M models/lnd/clm/bld/queryDefaultNamelist.pl - Add clm_tools default file. + Don't limit list to -var, as now done in .pm file below. + M models/lnd/clm/bld/queryDefaultXML.pm ------ If -var set, don't process variables + that don't match + M models/lnd/clm/bld/config_files/config_definition.xsl - Change to lowercase + for xhtml standard, remove glacier list + M models/lnd/clm/bld/config_files/config_definition.xml - Put glc_nec in physics list + M models/lnd/clm/bld/build-namelist --------------------- Fix minor doc issues + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add ndepmapalgo, + change formatting for GPTL options + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Improve formatting, + put note in table if All: res, masks, yrs, or sim_yr_rng + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --- Improve formatting + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove mksrf_fvegtyp + files and fndepdat files for single-years only used for processing +tools + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add in handling + of rcp's, and stream_fldfilename_ndep, remove fndepdat/dyn + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/get_Icaselist.pl + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/src/main/ndepStreamMod.F90 + M models/lnd/clm/src/main/surfrdMod.F90 + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +038 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 10 +039 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 5 +040 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 5 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smHS3 TSM.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 8 +007 erHS3 TER.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic FAIL! rc= 5 +008 brHS3 TBR.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -3+-3 arb_ic FAIL! rc= 5 +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 4 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +065 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 6 +066 sm974 TSMscript_tools.sh mksurfdata mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds ....FAIL! rc= 6 + bluefire/CESM testing: +FAIL SMS_RLA.f45_f45.I.bluefire +BFAIL SMS_RLA.f45_f45.I.bluefire.generate.clm4_0_11 +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_10 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_10 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_10 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_10 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_10 +FAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_10 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_11 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_10 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_10 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_10 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_10 +Originator(s): erik (Erik Kluzek) +Date: Wed Aug 4 14:37:59 MDT 2010 +One-line Summary: Update doc to cesm_rel05, bug-fixes, fix issues for single-point, mksurfdata/getregional scripts + +Purpose of changes: + +Use nn instead of copy for CO2 patch file. Update documentation to latest cesm version +05. Update externals. Some changes to build-namelist for generic single-point +simulations. Move tools XML files to clm_tools namelist_default file. Add 4x5 drydep +test, work with testing a bit. Add tests for getregional.pl and mksurfdata.pl scripts. +Add: usrname, nomv and pftdata options to mksurfdata.pl. Get RCP's working in getregional +script. Update getregional to handle ndep and aerdep streams, also get it to run in a +different directory. XML query wont test variables that don't match when -var option is +specified. Convert test table to xhtml. Move glc_nec to physics. Add option for +ndepmapalgo. Get faerdep and fndep streams files working right in +namelist_defaults_usrdat.xml file. + +Bugs fixed (include bugzilla ID): + 1166 (get_regional script needs to be updated) + 1190 (add ndepmapalgo to ndep streams) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1207 (Problem with datm template on gust) + +Update of datm also fixes several issues with datm for single pt simulations: 1173, 1175, 1176, 1181 + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add ndepmapalgo + Move datasets just for clm tools to clm_tools namelist_defaults XML file + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + scripts to scripts4_100730 + drv to drvseq3_1_33 + datm to datm8_100728 + csm_share to share3_100802 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Add configure test file for serial + A models/lnd/clm/test/system/config_files/4p_vodsnrsc_ds + +>>>>>>>>>>>> Add some files to test mksurfdata.pl script + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850 + A models/lnd/clm/test/system/nl_files/mksrfdt_1x1_brazil_1850-2000 + +>>>>>>>>>>>> Put all files for clm-tools in seperate file + A models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml + +>>>>>>>>>>>> Add new chapter on trouble shooting, add a script to limit +>>>>>>>>>>>> the line lengths, add style sheet to convert HTML XSL table +>>>>>>>>>>>> to docbook. Add file to fix vancouver problem. + A models/lnd/clm/doc/UsersGuide/trouble_shooting.xml + A models/lnd/clm/doc/UsersGuide/limitLineLen.pl + A models/lnd/clm/doc/UsersGuide/addxhtmlhead.pl + A models/lnd/clm/doc/UsersGuide/stylesheethtml2docbook.xsl + A models/lnd/clm/doc/UsersGuide/fixvan_datm.buildnml.diff + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Change some of the tests around + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>> Work with testing a bit, add mksurfdata.pl and drydep tests + M models/lnd/clm/test/system/README.testnames ---- Add "V" drydep test + M models/lnd/clm/test/system/test_driver.sh ------ Add pftdata, change multi-processing a bit + M models/lnd/clm/test/system/TSMscript_tools.sh -- Fix some glitches + M models/lnd/clm/test/system/gen_test_table.sh --- Convert to xhtml + M models/lnd/clm/test/system/nl_files/clm_usrdat - Remove non-streams mode for ndep and aerdep + M models/lnd/clm/test/system/input_tests_master -- Add mksurfdata.pl and drydep tests + make scsnf 4x5 rather than 10x15 + +>>>>>>>>>>>> Add -nomv, usrname, and pftdyn options, add ability to run in +>>>>>>>>>>>> a different directory, check for vegtyp files before running. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +>>>>>>>>>>>> Handle rcp's correctly, and handle datm streams for presaero files +>>>>>>>>>>>> and ndep streams files + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- default rcp=hist, set + RCP to ncl script + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - add ability to handle + usrname files, and handle ndep and aerdep streams files correctly + +>>>>>>>>>>>> Move tools files into clm_tools default file, add ndepmapalgo +>>>>>>>>>>>> Work on the formatting of the files, do better with clm_usrdat_name + M models/lnd/clm/bld/queryDefaultNamelist.pl - Add clm_tools default file. + Don't limit list to -var, as now done in .pm file below. + M models/lnd/clm/bld/queryDefaultXML.pm ------ If -var set, don't process variables + that don't match + M models/lnd/clm/bld/config_files/config_definition.xsl - Change to lowercase + for xhtml standard, remove glacier list + M models/lnd/clm/bld/config_files/config_definition.xml - Put glc_nec in physics list + M models/lnd/clm/bld/build-namelist --------------------- Fix minor doc issues + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Add ndepmapalgo, + change formatting for GPTL options + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl ----- Improve formatting, + put note in table if All: res, masks, yrs, or sim_yr_rng + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl --- Improve formatting + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove mksrf_fvegtyp + files and fndepdat files for single-years only used for processing tools + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml - Add in handling + of rcp's, and stream_fldfilename_ndep, remove fndepdat/dyn + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/get_Icaselist.pl + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/src/main/ndepStreamMod.F90 + M models/lnd/clm/src/main/surfrdMod.F90 + +>>>>>>>>>>>> Update to documentation from update to cesm1_0_rel_05 + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 4 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CESM testing: All PASS except... +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_10 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_09 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + edinburgh/lf95 interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 4 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 4 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +028 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +032 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 4 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_09 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_09 +Originator(s): erik (erik) +Date: Mon Jun 14 00:02:12 MDT 2010 +One-line Summary: Fix some small issues, update documentation, and externals + +Purpose of changes: + +Work on documentation for CESM1.0 release, with glcec changes, and namelist changes. Run +testing and fix bugs. Move documentation changes from release branch to trunk. Fix +getregional script for transient. Remove "At point 2" from lnd log files. Update +csm_share, and scripts version so can now run testing with lahey compiler. Get CO2 patch +file working. + +Bugs fixed (include bugzilla ID): + 1092 (Problems running on dublin with datm8 with debug) + 1159 (date in fco2 file is not used) + 1160 (Fix mksurfdata.pl script to work with 1000-1004) + 1167 (doc. about running single point reduce pes) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, +cism, csm_share + scripts to scripts4_100612 + drv to drvseq3_1_31 + datm to datm8_100612 + cism to cism1_100608 + csm_share to share3_100607 + +List all files eliminated: None + +List all files added and what they do: None + +>>>>>>>>>>>> Add testing configure file + A models/lnd/clm/test/system/config_files/_nrcnsc_do + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add CLM_USRDAT_NAME and getregional.pl tests + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_edinburgh_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/TSMscript_tools.sh + M models/lnd/clm/test/system/nl_files/clm_usrdat + M models/lnd/clm/test/system/nl_files/getregional + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/README + +>>>>>>>>>>>> + M models/lnd/clm/tools/ncl_scripts/getco2_historical.ncl ---- Add comment that + date variable is NOT used + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add path to scripts + so can run from a different directory + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Fix warnings and + allow some files to not be converted if not needed + M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl ------- Re-order longitudes + so from -180-180 rather than 0-360 + +>>>>>>>>>>>> + M models/lnd/clm/bld/queryDefaultXML.pm ----- Get working for usrdat better + M models/lnd/clm/bld/listDefaultNamelist.pl - Get working for usrdat files + M models/lnd/clm/bld/build-namelist --------- Allow lnd_res to be usrdat name + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Set year first/last + for datm_presaero for clim_2000 + M models/lnd/clm/bld/namelist_files/datm-build-namelist -------- Don't allow + prognostic for datm_presaero + +>>>>>>>>>>>> Update documentation, add cprnc README to document + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff - Update patch to + work with the latest datm with DATM_PRESAERO + +>>>>>>>>>>>> Remove "at point 2" and fix esmf duplication from fix by Mariana + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + +>>>>>>>>>>>> Update README files and use CESM in place of CCSM + M models/lnd/clm/doc/Quickstart.userdatasets + M models/lnd/clm/doc/IMPORTANT_NOTES + M models/lnd/clm/doc/KnownBugs + M models/lnd/clm/doc/README + M models/lnd/clm/doc/index.shtml + M Copyright + M README + +Summary of testing: + + bluefire: All PASS except... +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 5 +017 smEH1 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 +018 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +019 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 4 +021 smHN1 TSM.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 8 +022 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 3 +023 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 3 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 3 +025 smHO2 TSM.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -90 cold .............FAIL! rc= 3 +026 erHO2 TER.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -3+-7 cold ...........FAIL! rc= 3 +027 brHO2 TBR.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -5+-5 cold ...........FAIL! rc= 3 +028 blHO2 TBL.sh 17p_cnsc_dm clm_drydep 20000704:NONE:1800 10x15 USGS@2000 -90 cold .............FAIL! rc= 3 +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 3 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 3 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 3 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 3 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 3 +034 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 3 +035 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 3 +036 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 3 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 3 +038 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 3 +039 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 3 +040 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 3 +041 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 3 +042 smC61 TSM.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 -6 startup ............FAIL! rc= 3 +043 erC61 TER.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 10+38 startup .........FAIL! rc= 3 +044 brC61 TBR.sh _scnv_dh clm_std^nl_urb_br 20020101:NONE:1800 1.9x2.5 gx1v6 -3+-3 startup ......FAIL! rc= 3 +045 blC61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 48 startup ............FAIL! rc= 3 +046 smH52 TSM.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 96 cold ..........FAIL! rc= 3 +047 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 3 +048 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 3 +049 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold ..........FAIL! rc= 3 +050 smV61 TSM.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 96 arb_ic ..............FAIL! rc= 3 +051 erV61 TER.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 10+38 arb_ic ...........FAIL! rc= 3 +052 brV61 TBR.sh _mec10sc_dh clm_std 19980115:NONE:1800 1.9x2.5 gx1v6 72+72 arb_ic ..............FAIL! rc= 3 +053 blV61 TBL.sh _mec10sc_dh clm_glcmec 19980115:NONE:1800 1.9x2.5 gx1v6 48 arb_ic ..............FAIL! rc= 3 +054 smI59 TSMcnspinup.sh 17p_cnadspinupsc_dm 17p_cnexitspinupsc_dm 17p_cnsc_dm clm_std 20020115:NONEFAIL! rc= 3 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 3 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 3 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 3 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 3 +059 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 3 +060 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 3 +061 brL58 TBR.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 3 +062 blL58 TBL.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 48 arb_ic ...............FAIL! rc= 3 +063 smJ61 TSM.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 3 +064 erJ61 TER.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 3 +065 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 3 +066 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 3 +067 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 3 + bluefire interactive testing: All PASS except... +009 blHS3 TBL.sh _nrcnsc_do clm_usrdat 20030101:NONE:1800 13x12pt_f19_alaskaUSA gx1v6 -6 arb_ic .FAIL! rc= 5 +021 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 5 +025 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +026 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +030 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +062 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 3 +063 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 3 +064 smZ94 TSMtools.sh mkdatadomain tools__ds namelist ...........................................FAIL! rc= 3 +065 sm9S4 TSMscript_tools.sh ncl_scripts getregional_datasets.pl getregional ....................FAIL! rc= 3 + bluefire/CESM testing: All PASS except... +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_08 +BFAIL ERI.f19_g16.IG.bluefire.compare.clm4_0_08 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_09 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_08 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 smV23 TSM.sh _mec10sc_do clm_glcmec 19980115:NONE:1800 48x96 gx3v7 96 arb_ic ................FAIL! rc= 8 +026 erV23 TER.sh _mec10sc_do clm_glcmec 19980115:NONE:1800 48x96 gx3v7 10+38 arb_ic .............FAIL! rc= 5 +027 brV23 TBR.sh _mec10sc_do clm_std 19980115:NONE:1800 48x96 gx3v7 72+72 arb_ic ................FAIL! rc= 5 + jaguar/CESM testing: All PASS + edinburgh/lf95 interactive testing: All PASS except... +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +008 blAL4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -10 cold ...............FAIL! rc= 5 +012 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 5 + edinburgh/lf95: All PASS except... +005 smD91 TSM.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 10 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 5 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 4 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG56 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +013 smE91 TSM.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 96 arb_ic ............FAIL! rc= 10 +014 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 10+38 arb_ic .........FAIL! rc= 5 +015 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 5 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 4 +018 erH52 TER.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold .......FAIL! rc= 13 +019 brH52 TBR.sh 17p_cnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 cold ....FAIL! rc= 11 +025 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +026 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +027 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +028 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +029 smH41 TSM.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold FAIL! rc= 10 +030 erH41 TER.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 5 +031 brH41 TBR.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 5 +032 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 4 +033 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_08 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_08 +Originator(s): erik (erik) +Date: Fri Jun 4 01:25:39 MDT 2010 +One-line Summary: Snow hydrology bug fix from Keith and Dave + +Purpose of changes: + +SnowHydrology bug fix from Keith Oleson. For test-suite, make default to send aerosol +data through datm. Update version of cism, scripts and datm. Remove some of the old aerdep +stuff from the XML database as we now are using presaero from datm (leave 1-deg and +2-deg). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: none + +Describe any changes made to the namelist: Move datm_presaero to overall defaults + +List any changes to the defaults for the boundary datasets: + Remove all faerdep files except f09 and f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + code changes come from Keith Oleson and Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): scripts, cism and drv + scripts to scripts4_100603a + drv to drvseq3_1_29 + cism to cism1_100603 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/17p_cnsc_m + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Switch demand for ndepdyn for + ndepsrc stream + + M models/lnd/clm/bld/build-namelist ----- Get datm_presaero if not null + do NOT set faerdep + M models/lnd/clm/bld/clm.cpl7.template -- Set datm_presaero by DATM_PRESAERO + if datm or to prognostic if not (so aerosol dep require from atm) + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Set + datm_presaero by resolution, sim_year, sim_year_range and rcp + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Remove datm_presaero + M models/lnd/clm/bld/namelist_files/datm-build-namelist ----------- Set + datm_presaero by resolution, sim_year, sim_year_range and rcp + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Remove + all faerdep files except for f09 and 19 + + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - Snow hydrology fix + +Summary of testing: + + bluefire interactive testing: All PASS up to... +014 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test +-1100 arb_ic FAIL! rc= 10 + bluefire/CCSM testing: All PASS except.. +FAIL SMS_RLB.f45_f45.I.bluefire +BFAIL SMS_RLB.f45_f45.I.bluefire.generate.clm4_0_08 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_06 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_06 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_06 +FAIL ERS_E.f19_g16.I1850.bluefire.compare_hist.clm4_0_06 +FAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_06 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_06 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_08 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_06 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_06 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_06 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_06 + Extra testing: +PASS ERI.f19_g16.IG.bluefire +Make sure answers agree with /OLESON/csm/ccsm4_0_beta52_ndepaer other than VOC fields +Test that F case will configure.. +create_newcase -compset F -case testF -res f19_g16 -mach bluefire -skip_rundb + +CLM tag used for the baseline comparison tests if applicable: clm4_0_07 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: ALL + - what platforms/compilers: ALL + - nature of change: larger than roundoff/same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + + - platform/compilers: IBM + - compset (and additional configure options): I1850CN + - build-namelist options (or complete namelist): -ndepsrc stream + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/ccsm4_0_beta52_ndepaer + /OLESON/csm/ccsm4_0_beta52_ndepaertrans + + The above is identical to this tag (other than the two VOC fields that changed) + +=============================================================== +=============================================================== +Tag name: clm4_0_07 +Originator(s): erik (erik) +Date: Thu Jun 3 21:22:46 MDT 2010 +One-line Summary: Some cleanup/fix bugs, add RTM var, add albice to namelist, allow last-millenium in mksurfdata, allow setting of datm_presaero in clm test-suite + +Purpose of changes: + +Fix mksurfdata.pl, to correctly create 1000-1004 test datasets. Fix drydep for OpenMP. +Update 1x1_tropicAtl_1000-1004 test fsurdat file. Move glc_grid from configure to +build-namelist. Add in alb_ice to namelist. Start adding in the capability to handle +mksurfdata from 0850-1850AD, put all mksrf_fvegtyp files in XML database (remove some of +the sample pftdyn text files). New RTM field on history output from Sean (VOLR and +VOLR_ICE, only VOLR output by default). Allow use of aerosol data from datm for I cases +in the clm test suite. Split out datm-build-namelist from clm build-namelist (put in +bld/namelist_files). + +Bugs fixed (include bugzilla ID): + 1162 (OpenMP bug with dry-deposition code in clm) + 883 (aerosol deposition not from atm) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1163 (finidat file has a bunch of NaN's in it) + 1164 (Restart trouble for CN13 on gust...) + 1165 (Restart trouble for scaled harvest test on gust) + 1166 (get_regional script needs to be updated) + 1192 (Y1K problem for mksurfdata.pl) + 1193 (bug in reading GLCMASK) + 1197 (MPI problem sending and receiving data in same array) + 1206 (Problem looping over a single year of forcing) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: Move glc_grid to build-namelist + remove esmf_libdir, fix ccsm_bld so will build threaded properly + +Describe any changes made to the namelist: Add albice to namelist + Add new history fields VOLR and VOLR_ICE + + VOLR RTM storage: LIQ (m3) + VOLR_ICE RTM storage: ICE (m3) + +List any changes to the defaults for the boundary datasets: + New datasets for 1x1_tropicAtl 1000 tests + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, VOLR changes come from Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + scripts to scripts4_100601 + drv to drvseq3_1_28 + pio to pio1_1_1 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove mksurdata pftdyn text files, let XML database create them + D models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp6.0_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt + D models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt + +List all files added and what they do: + +>>>>>>>>>>>>>>> Split out datm part of build-namelist into it's own script + A models/lnd/clm/bld/namelist_files/datm-build-namelist + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000-2000.txt -- Same as + old file with 2000.txt name rather than 2000-2000.txt name. + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Move glc_grid to build-namelist, remove kraken + M models/lnd/clm/test/system/config_files/_mec10sc_dh + M models/lnd/clm/test/system/config_files/_mec10sc_dm + M models/lnd/clm/test/system/config_files/_mec10sc_do + M models/lnd/clm/test/system/config_files/_mec10sc_ds + M models/lnd/clm/test/system/config_files/_mec10sc_h + M models/lnd/clm/test/system/config_files/_mec10sc_m + M models/lnd/clm/test/system/config_files/_mec10sc_o + M models/lnd/clm/test/system/test_driver.sh --------- Remove kraken, update dataroot + for bluefire, and tempworkspacefor intrepid + M models/lnd/clm/test/system/CLM_runcmnd.sh --------- Remove kraken + M models/lnd/clm/test/system/nl_files/clm_drydep ---- Change drydep to drv_drydep + +>>>>>>>>>>>>>>> Use XML database for pftdyn files, have mksrfdata.pl write out pftdyn files + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig - change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ------ start at 1850 + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist ---- change pftdyn file name + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---------- Get mksrf_vegtyp filenames + from XML database for all files, and write out pftdyn files with them + also get working for 1000-1004 test cases (specifically for 1x12_tropicAtl + test case) + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt - Use CSMDATA versions + of 1850 and 2000 files + +>>>>>>>>>>>>>>> Move glc_grid to namelist, fix ccsm_bld=on, add datm_presaero +>>>>>>>>>>>>>>> Only do COLD start for startup type + M models/lnd/clm/bld/configure --------------- Remove glc_grid and esmf_libdir + add in control of CCSM_VOC, set compile_threaded for ccsm_bld on, + M models/lnd/clm/bld/queryDefaultNamelist.pl - Remove double reading of namelist_defaults_overall.xml + M models/lnd/clm/bld/queryDefaultXML.pm ------ Add csmdata to beginning of file, only + if it's a relative pathname (to handle instances of /cgd/tss for mksrf_vegtyp files) + M models/lnd/clm/bld/config_files/config_definition.xml - Remove glc_grid/esmf_libdir + M models/lnd/clm/bld/listDefaultNamelist.pl --- Move glc_grid to namelist vars + M models/lnd/clm/bld/build-namelist ----------- Add in glc_grid, and datm_presaero + change -drydep to -drv_drydep option, set glc_nthreads, outnc_large_files + and albice if glc_nec>0, move datm settings to own datm-build-namelist. + M models/lnd/clm/bld/clm.cpl7.template -------- Move glc_grid to build-namelist, + remove outnc_large_files setting (now in build-namelist), only do + COLD start for startup type (NOT for hybrid or branch). + +>>>>>>>>>>>>>>> Add albice/glc_grid/datm_presaero/outnc_large_files +>>>>>>>>>>>>>>> New datasets for 1x1_tropicAtl 1000 tests +>>>>>>>>>>>>>>> Add in all mksrf_fvegtyp files and include last-millenium + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------ Add in albice, + and glc_* settings for drv (glc_nthreads, glc_ntasks etc.), add presaero + datam_presaero, datm_file_aero, datm_year_first_aero, datm_year_last_aero, + datm_year_align_aero, and glc_grid. Add 0.5x0.5 resolution (for mksurfdata) + and some premillenial years (850,1100,1350,1600) and sim-year ranges + (850-1100,1100-1350,1350-1600,1600-1850) + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Set default + masks here, and add in glc_grid default + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Add in some + new domain files that are in datm template, and add in datm_presaero + settings needed: datm_file_aero, datm_aero_streams, datm_year_first_aero +  datm_year_last_aero, and datm_year_align_aero + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl --------- Show + datm_presaero setting if set. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Add + outnc_large_files, albice, and move mask to overall, update + 1x1_tropicAtl files for 1000, 1000-1004, add in all mksrf_fvegtyp + files for all scenarios and last-millenium. Add in diri and diro. + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ----- Get URL + svn keyword set properly. + +>>>>>>>>>>>>>>> Put datm/drv settings on bottom (only for mode=ccsm_seq) +>>>>>>>>>>>>>>> set datm_presaero and data_cycle_beg/end years + M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml -- default + datm_presaero is clim_2000 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml - default + datm_presaero is rcp8.5, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml - default + datm_presaero is rcp8.5, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml ------------ default + datm_presaero is trans_1850-2000, beg/end year 1948-1972, co2=386.9 + M models/lnd/clm/bld/namelist_files/use_cases/glacier_mec.xml ---------------- default + datm_presaero is clim_2000 + M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml --------------- default + datm_presaero is clim_1850, beg/end year 1948/1972 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml - default + datm_presaero is rcp2.6, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml --- default + datm_presaero is rcp6.0, beg/end year 1972-2004 + M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml - default + datm_presaero is rcp4.5, beg/end year 1972-2004 + +>>>>>>>>>>>>>>> Add in albice to namelist, add VOLR and VOLR_ICE to history files +>>>>>>>>>>>>>>> always call interpMonthlyVeg for drydep + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 - Remove interpMonthlyVeg + call as coming from a threaded region + M models/lnd/clm/src/main/clm_comp.F90 ------------- Call interpMonthlyVeg + for drydep even if CN is on + M models/lnd/clm/src/main/controlMod.F90 ----------- Add albice + M models/lnd/clm/src/main/clm_varcon.F90 ----------- Remove albice + M models/lnd/clm/src/main/clm_driver.F90 ----------- Always call interpMonthlyVeg + if drydep is on (even when NOT doalb) + M models/lnd/clm/src/main/histFldsMod.F90 ---------- Add VOLR and VOLR_ICE + (VOLR_ICE is an optional field) + M models/lnd/clm/src/riverroute/RtmMod.F90 --------- Handle volr under runoff + type, rather than as local variable + M models/lnd/clm/src/riverroute/RunoffMod.F90 ------ Add volr, volrlnd, volr_nt1/2 + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 Add albice as public var + that can be set in controlMod on namelist + +Summary of testing: + + bluefire: All PASS except (up to test 061 nl_crcrop) +061 brL58 TBR.sh _sc_dh clm_std^nl_crcrop +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 7 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 7 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 7 +045 blC61 TBL.sh _scnv_dh clm_std^nl_urb 20020101:NONE:1800 1.9x2.5 gx1v6 48 startup ............FAIL! rc= 7 + bluefire interactive testing: All PASS up to... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except.. +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_06 + + + bluefire/extra CCSM testing: +Make sure answers agree with /OLESON/csm/ccsm4_0_beta52_ndepaer other than VOC fields + (when snowhydrology changes are put in) + + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 +018 brR53 TBR.sh 17p_cnc13sc_do clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@1850 72+72 cold .FAIL! rc= 11 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +025 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coFAIL! rc= 13 +026 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coFAIL! rc= 11 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_06 + +Changes answers relative to baseline: no bit-for-bit (except omp active stand-alone tests) + The standalone tests with OpenMP on are different because the previous tag + wasn't building with OpenMP + +=============================================================== +=============================================================== +Tag name: clm4_0_06 +Originator(s): erik (erik) +Date: Wed May 26 10:35:26 MDT 2010 +One-line Summary: Update gglc to cism + +Purpose of changes: + +Changes from jwolfe to lnd_comp* subroutines to exchange cism fields. Requires an update +to the driver for the index of the fieldnames passed. Change paths of gglc glc_grid files +from gglc to cism. Make stream the default for all resolutions for ndepsrc. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1162 (OpenMP bug with dry-deposition code in clm) + 1163 (finidat file has a bunch of NaN's in it) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: + Change name of ice model from gglc to cism + Change list of fields exchanged with cism + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Change pathnames for gglc fglcmask datasets to cism + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jwolfe, lipscomb + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, cism + scripts to scripts4_100525 + drv to drvseq3_1_26 + cism to cism1_100525b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Change default + of ndepsrc for f19 and f09 to stream + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Change pathnames + for fglcmask files to pathame with cism instead of gglc + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ---------------- Pass a different + set of fields for sno (needed for update to cism) + + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 -------------- Pass a different + set of fields for sno (needed for update to cism) + +Summary of testing: + + bluefire/CCSM testing: +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_06 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_05 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_05 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_05 + bluefire/CCSM extra testing: +PASS SMS.f19_g16.IG.bluefire +PASS ERS.f19_g16.IG.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm4_0_05 + +Changes answers relative to baseline: Only when glc is active + Or for f19 and f09 with CN as now ndepsrc streams is the default for all resolutions + (previously ndepsrc data was the default for f19 and f09) + +=============================================================== +=============================================================== +Tag name: clm4_0_05 +Originator(s): erik (erik) +Date: Tue May 25 15:13:30 MDT 2010 +One-line Summary: Move Nitrogen deposition stream branch to trunk + +Purpose of changes: + +Move branch that treats ndepdyn files as streams to trunk. Change csm_share to have a +simpler normalization for coszen scaling (from dlawren/kauff in datm/csm_share). Fix +fragile code in clm_atmlnd, from Mariana. Update to datm8 that can set streams for +aerosols. Fix template so that CLM_BLDNML_OPTS is active. Update scripts and get in +other new finidat files, change clm test list, include _E test and IG f19 test. + +Bugs fixed (include bugzilla ID): + 1161 (New history fields added that should NOT be) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1162 (OpenMP bug with dry-deposition code in clm) + 1163 (finidat file has a bunch of NaN's in it) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Add -ndepsrc option to build-namelist + +List any changes to the defaults for the boundary datasets: + Add new datasets for Nitrogen deposition streams files (same as fndepdyn files) + Remove fndepdat/fndepdyn files for resolutions other than f09 and f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, csm_share + scripts to scripts4_100524b + drv to drvseq3_1_23 + datm to datm8_100420 + csm_share to share3_100423 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>>> Handle Nitrogen deposition streams +A models/lnd/clm/src/main/ndepStreamMod.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>> Add some CN drydep tests for hybrid/open-MP +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>>>>> Add ability to handle ndep streams namelists +>>>>>>>>>>>> Add ability to set CLM_BLDNML_OPTS +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +>>>>>>>>>>>> Set ndepstreams variables if ndepsrc=stream, otherwise set fndep files +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +>>>>>>>>>>>> Handle new ndep streams namelist and namelist variables +>>>>>>>>>>>> Remove misc.h and preproc.h #includes +M models/lnd/clm/src/main/clm_comp.F90 ---------- Renumber starting at 1 not 0 +M models/lnd/clm/src/main/clm_initializeMod.F90 - Handle initialization both + for ndep streams and old ndep handling +M models/lnd/clm/src/main/aerdepMod.F90 --------- Check if allocated before allocate +M models/lnd/clm/src/main/iniTimeConst.F90 ------ Move setting of ndep out of here +M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Remove fragile code +M models/lnd/clm/src/main/controlMod.F90 -------- Handle use_ndepstream +M models/lnd/clm/src/main/clm_varctl.F90 -------- Add use_ndepstream +M models/lnd/clm/src/main/clm_driver.F90 -------- Add ndep_interp if use_ndepstream + and first and last years are different +M models/lnd/clm/src/main/ndepFileMod.F90 ------- Make fndepdat optional input so + can do this way (old way) or ndep streams (new way). +M models/lnd/clm/src/main/clm_glclnd.F90 -------- Change order of vars from Bill Lipscomb + +M models/lnd/clm/src/main/areaMod.F90 - Add interfaces for MCT datatypes + +M models/lnd/clm/src/main/clmtypeInitMod.F90 - Remove unfilled history vars +M models/lnd/clm/src/main/clmtype.F90 -------- Remove unfilled history vars +M models/lnd/clm/src/main/histFldsMod.F90 ---- Remove unfilled history vars, add QTOPSOIL + as an optional history variable. +M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 - Handle fragile code mapping with MCT +M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- Handle fragile code mapping with MCT + +Summary of testing: + + bluefire: All PASS except... +029 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +030 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +031 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +032 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +033 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +037 blH41 TBL.sh 17p_cnsc_dh clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 48 cold FAIL! rc= 7 +049 blH52 TBL.sh 17p_cnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold ..........FAIL! rc= 7 +055 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +056 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +057 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +058 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 7 +048 blHQ4 TBL.sh _nrcnsc_ds clm_drydep 20000214:NONE:1800 1x1_brazil navy@2000 -150 cold ........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except... +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL SMS_ROA.f45_f45.I.bluefire.compare_hist.clm4_0_04 +FAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_04 +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm4_0_04 +FAIL ERS_D.f45_g37.I.bluefire.compare.clm4_0_04 +FAIL PST.f45_g37.I1850.bluefire.compare.clm4_0_04 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_04 +BFAIL ERS_E.f19_g16.I1850.bluefire.compare.clm4_0_04 +FAIL ERI.f19_g16.IG.bluefire +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_04 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_05 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_04 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm4_0_04 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm4_0_04 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm4_0_04 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm4_0_04 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_04 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 10+38 cold ....FAIL! rc= 13 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_04 + +Changes answers relative to baseline: Yes! + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + ndepaer01_clm3_7_15 + SnowHydrology changes + - platform/compilers: IBM + - compset (and additional configure options): I1850CN + - build-namelist options (or complete namelist): -ndepsrc stream + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/ccsm4_0_beta52_ndepaer + /OLESON/csm/ccsm4_0_beta52_ndepaertrans + +=============================================================== +=============================================================== +Tag name: clm4_0_04 +Originator(s): erik (erik) +Date: Thu May 20 10:57:54 MDT 2010 +One-line Summary: New namelist items: ice_runoff, scaled_harvest, carbon_only, new + RTM hist vars, new finidat files, update esmf interface, turn off aerosol read quicker + +Purpose of changes: + +Redo all fndepdyn datasets for f19. Add namelist option to turn off ice-flow and send it +to liquid runoff: ice_runoff (by default .true.). Add new coefficients for harvest from +Johann, and add ability to trigger it on and off for backwards compatibility +(scaled_harvest, by default .false.). Change SUPLN from CPP token to carbon_only namelist +item. Add in new RTM variable to history files from Sean. Add in T31 1850/2000 CN/non-CN +and 2-deg 2000 CNDV finidat files. Turn off reading of aerosol/dust at initialization +rather than run time, so files aren't even opened if CAM is passing data to clm. Update +lnd_comp_esmf to same as mct interface. + +New history fields are incorrect. This is bug 1161. Since, time-lines are critical +and testing was completed, these changes will go in, but will be removed next week. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1161 (New history fields added that should NOT be) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: Remove SUPLN #ifdef change to namelist option + +Describe any changes made to the namelist: Add namelist items + + ice_runoff = If true, river runoff will be split up into liquid and ice streams, + otherwise ice runoff will be zero and all runoff directed to liquid stream + scaled_harvest = If true, harvesting will be scaled according to coeffecients + determined by Johann Feddema, 2009 + carbon_only = If true, and CLMCN carbon-nitrogen model is on, Nitrogen will be + prescribed rather than prognosed + +List any changes to the defaults for the boundary datasets: + New fndepdyn files with correct time coordinate + New finidat files for T31 1850/2000 and f19 2000 for CNDV + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + +>>>>>>>>>>>>>> Remove SUPLN build tests + D models/lnd/clm/test/system/config_files/17p_cnnsc_h + D models/lnd/clm/test/system/config_files/17p_cnnsc_m + D models/lnd/clm/test/system/config_files/17p_cnnsc_o + D models/lnd/clm/test/system/config_files/_cnnsc_h + D models/lnd/clm/test/system/config_files/_cnnsc_m + D models/lnd/clm/test/system/config_files/_cnnsc_o + D models/lnd/clm/test/system/config_files/17p_nrcnnsc_ds + D models/lnd/clm/test/system/config_files/17p_cnnsc_dh + D models/lnd/clm/test/system/config_files/17p_cnnsc_dm + D models/lnd/clm/test/system/config_files/17p_cnnsc_do + D models/lnd/clm/test/system/config_files/_cnnsc_dh + D models/lnd/clm/test/system/config_files/17p_cnnsc_ds + D models/lnd/clm/test/system/config_files/_cnnsc_dm + D models/lnd/clm/test/system/config_files/_cnnsc_do + D models/lnd/clm/test/system/config_files/_cnnsc_ds + +>>>>>>>>>>>>>> Remove namelist files no longer used + D models/lnd/clm/test/system/nl_files/scam + D models/lnd/clm/test/system/nl_files/ext_ccsm_seq_cam + D models/lnd/clm/test/system/nl_files/nl_glcsmb + D models/lnd/clm/test/system/nl_files/scam_prep + +List all files added and what they do: + +>>>>>>>>>>>>>> Add ice_runoff=.false., scaled_harvest=.true., and carbon_only tests + A models/lnd/clm/test/system/nl_files/nl_noicertm_sclharv + A models/lnd/clm/test/system/nl_files/nl_cn_conly + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Switch SUPLN tests for carbon_only +>>>>>>>>>>>>>> Add ice_runoff=.false., scaled_harvest=.true tests + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/tests_pretag_edinburgh + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_breeze + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_nompi_regression + +>>>>>>>>>>>>>> Remove setting of supln to off + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + +>>>>>>>>>>>>>> Remove SUPLN from configure + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/config_files/config_definition.xml + +>>>>>>>>>>>>>> Add carbon_only, scaled_harvest and ice_runoff options +>>>>>>>>>>>>>> T31 1850/2000 finidat files, f19 CNDV 2000 finidat file +>>>>>>>>>>>>>> Add error checking, change fndepdyn files for ones with +>>>>>>>>>>>>>> corrected time axis. + M models/lnd/clm/bld/build-namelist + M models/lnd/clm/bld/namelist_files/namelist_definition.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>>>>> Remove SUPLN #ifdef for carbon_only namelist + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 - Correct comment + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ---- Switch SUPLN for carbon_only + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ----- Remove ltype as duplicated + +>>>>>>>>>>>>>> Add carbon_only, scaled_harvest, and ice_runoff options +>>>>>>>>>>>>>> Add new RTM history variables + M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Add res_sno, topo_ndx, + topo_slope, var_track, var_track2, frost_table, zwt_perched, + qflx_top_soil, qflx_snow_out, qflx_drain_perched + M models/lnd/clm/src/main/pftdynMod.F90 ---------------- Add CN ifdef's for harvest + add if for scaled_harvest or not + M models/lnd/clm/src/main/iniTimeConst.F90 ------------- Add CN ifdef's for ndep + M models/lnd/clm/src/main/histFileMod.F90 -------------- Add RTM ifdef's for frivinp_rtm + M models/lnd/clm/src/main/controlMod.F90 --------------- Put options in appropriate + RTM and CN #ifdef blocks. Add ice_runoff, scaled_harvest and carbon_only to namelist + M models/lnd/clm/src/main/clm_varctl.F90 --------------- Add CN/RTM #ifdefs, add + scaled_harvest and ice_runoff + M models/lnd/clm/src/main/clm_driver.F90 --------------- Add CN #ifdef for ndepdyn + M models/lnd/clm/src/main/ndepFileMod.F90 -------------- Add CN #ifdef + M models/lnd/clm/src/main/clmtype.F90 ------------------ Add res_sno, topo_ndx, + topo_slope, var_track, var_track2, frost_table, zwt_perched, + qflx_top_soil, qflx_snow_out, qflx_drain_perched + M models/lnd/clm/src/main/histFldsMod.F90 -------------- Add + FROST_TABLE, ZWT_PERCH, QDRAI_PERCH, QTOPSOIL + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ----- Move lnd_chkAerDep_mct to init + add ice_runoff option to output rtm streams + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 --- Move lnd_chkAerDep_mct to + add ice_runoff option to output rtm streams. And sync up with lnd_comp_mct +init + + +Summary of testing: + + bluefire interactive extra checking: +001 smH43 TSM.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 96 cold PASS +002 erH43 TER.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 10+38 coPASS +003 brH43 TBR.sh 17p_cnsc_do clm_std^nl_noicertm_sclharv 20021230:NONE:1800 10x15 USGS@2000 72+72 coPASS +005 smH93 TSM.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 96 cold PASS +006 erH93 TER.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 10+38 coPASS +007 brH93 TBR.sh 17p_cnsc_do clm_ndepdyn^nl_cn_conly 20020101:NONE:1800 4x5 gx3v7@1850-2000 72+72 coPASS + bluefire/CCSM testing: All PASS except... +FAIL ERI.T31_g37.IG.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_04 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_03 + jaguar/CCSM testing: All FAIL +FAIL ERS_D.f09_g16.I1850.jaguar +FAIL PST.f10_f10.I8520CN.jaguar +FAIL PET_PT.f10_f10.I8520CN.jaguar + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm4_0_03 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_03 +Originator(s): erik (erik) +Date: Mon May 17 14:06:50 MDT 2010 +One-line Summary: Changes from Francis for VOC and drydep + +Purpose of changes: + +Changes from Francis Vitt and Jean-Francois Lamarque for VOC and drydep. Add a scaling +factor for VOC isoprene. Get annual LAI and differences from CLMSP even when CLMCN is +on when sending drydep to atm, as need LAI monthly differences to estimate season index. +Get these changes to work with CN on and off and also get it to work with DEBUG mode +on. Use clm veg indicies in pftvarcon and abort drydep if don't find a wesley veg type +index. Fix ndeplintInterp.ncl script for rcp=-999.9 historical (bug 1153). Add in quarter +degree gx1v6 fraction dataset. + +Bugs fixed (include bugzilla ID): + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1158 (I_1850-2000_CN (I4804CN) inconsistent with I_1850-2000 (I4804) compset) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: qtr-degree, gx1v6 frac/domain datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, fvitt + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_100513 + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_nrcnsc_ds --- cn test without rtm or supln + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Add in qtr-degree fraction and domain file datasets +>>>>>>>>>>> Make gx1v6 default mask for qtr-degree + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +>>>>>>>>>>> Separate out CN+SUPLN tests as H and CN only as P + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/README.testnames + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/nl_files/clm_drydep ---- correct build-nml options + M models/lnd/clm/test/system/input_tests_master ----- Remove 360x720 tests, add + drydep tests with CN and without, have start dates for drydep + tests span the year + +>>>>>>>>>>> A few small fixes to tools + M models/lnd/clm/tools/mksurfdata/mkvocef.F90 --------- Remove diagnostics as nonsensical + (also was incorrect, see bug 1157) + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Fix so can work with historical case + +>>>>>>>>>>> Allow some CLMSP subroutines to be called even with CLMCN so that LAI can help set +>>>>>>>>>>> the season index when dry-deposition is active (and only when dry-dep is active) + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 - Change #ifdefs so that + some can be called from drydep even when CN is on. Don't allow + EcosystemDyn to be called if CN on though. + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ----- Add a scaling factor + for isoprene + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ----- Make winter season on + anytime you have snow. Use pftvarcon indices to set wesveg type from + clmveg type. Add landuse type and set to desert winter if not veg type. + (so won't abort on DEBUG mode) + M models/lnd/clm/src/main/clm_initializeMod.F90 -------- Also call + EcosystemDynini and readAnnualVegetation even if CN is on when drydep is on. + +Summary of testing: + + bluefire: Ran 100 days of 1850CN, compared to Francis's mods and the two results were identical + bluefire interactive testing: +001 smCO3 TSM.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -10 cold ................PASS +002 erCO3 TER.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -3+-7 cold ..............PASS +003 brCO3 TBR.sh _sc_do clm_drydep^nl_urb_br 20021001:NONE:3600 10x15 USGS -5+-5 cold ...........PASS +004 blCO3 TBL.sh _sc_do clm_drydep^nl_urb 20021001:NONE:3600 10x15 USGS -30 cold ................PASS +005 smCP3 TSM.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -15 startup ..........PASS +006 erCP3 TER.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -3+-7 startup ........PASS +007 brCP3 TBR.sh _sc_do clm_drydep^nl_urb_br 20020317:NONE:1800 1.9x2.5 gx1v6 -5+-5 startup .....PASS +008 blCP3 TBL.sh _sc_do clm_drydep^nl_urb 20020317:NONE:1800 1.9x2.5 gx1v6 -15 startup ..........PASS +001 sm654 TSMtools.sh mkgriddata tools__ds namelist .............................................PASS +002 sm674 TSMtools.sh mkgriddata tools__ds singlept .............................................PASS +003 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................PASS +004 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................SKIPPED* +005 sm853 TSMtools.sh interpinic tools__o runoptions ............................................PASS + bluefire/CCSM testing: All PASS except... +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm4_0_0+upext +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm4_0_0+upext +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm4_0_0+upext +FAIL ERI.T31_g37.IG.bluefire +BFAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm4_0_0+upext +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_03 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm4_0_0+upext + +CLM tag used for the baseline comparison tests if applicable: clm4_0_02 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_02 +Originator(s): erik (erik) +Date: Thu May 13 00:47:40 MDT 2010 +One-line Summary: Make sure dtime is initialized, so that answers are consistently the same as clm4_0_00 + +Purpose of changes: + +Make sure dtime is initialized before it is used in lnd_run_mct/lnd_run_esmf so +that results are consistent. This bug has been around since clm3_6_36 where doalb +logic was changed. However, until clm4_0_01 results seemed to have been consistent, +but with clm4_0_01 results were inconsistent, and usually incorrect for nstep=1 (in +calculating calday1 and hence doalb). + +Bugs fixed (include bugzilla ID): + 1156 (Reproducability problem with clm4_0_01) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: critical + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>> Add a reproducability test + A models/lnd/clm/test/system/TRP.sh + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Add reproducability test + M models/lnd/clm/test/system/input_tests_master + +>>>>>>>>> Set glcmec by GLC_NEC_ $ifdefs + M models/lnd/clm/src/main/clm_varpar.F90 + +>>>>>>>>> Make sno fields NOT optional, and set dtime before use in _run + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + +Summary of testing: + + bluefire interactive testing: +001 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........PASS + bluefire/CCSM testing: +PASS PST.f45_g37.I1850.bluefire.compare.clm4_0_0+upext +PASS PET_PT.f45_g37.I1850.bluefire.compare.clm4_0_0+upext +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm4_0_0+upext +PASS ERS.f19_g16.I1850.bluefire.compare.clm4_0_0+upext +PASS PST.f10_f10.I8520CN.bluefire.compare.clm4_0_0+upext +PASS PET_PT.f10_f10.I8520CN.bluefire.compare.clm4_0_0+upext + +CLM tag used for the baseline comparison tests if applicable: clm4_0_00 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_01 +Originator(s): erik (erik) +Date: Tue May 11 14:39:25 MDT 2010 +One-line Summary: Move glacier multiple elevation class branch to the trunk so that we can work with the active glacier model + +Purpose of changes: + +Add ability to handle glacier multiple elevation classes (glc_mec) in clm, so that we +can interact with the active glacier component (glc). Adds glacier elevation classes +to the surface datasets and requires they be read in when glacier multiple elevation +classes are active. New namelist options for glc_mec include glc_smb and glc_dyntopo. +At build-time the number of glc_mec classes is set (can be 0, 1, 3, 5, or 10). The +model also interacts with the mask of valid glacier points that the active glacier +model determined (input with the fglcmask file), and set by glc_grid (which can be +gland5,gland10, or gland20 for 5-20km resolution over Greenland). glc_grid is set at +build time, but should be moved to the build-namelist. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1156 (Reproducability problem with clm4_0_01) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) + http://bugs.cgd.ucar.edu/ + +Type of tag: standard + +Describe any changes made to build system: Add glc_nec and glc_grid options to configure + glc_nec can be 1,3,5, or 10 and MUST match the number on the input surface dataset + the elevation classes themselves are read from the surface dataset + glc_grid can be gland5, gland10, gland20 for greenland 5, 10, or 20km resolution + it is merely passed on to build-namelist to pick the glcmask file + +Describe any changes made to the namelist: + +- create_glacier_mec_landunit (= T when these landunits are created; F by default) +- glc_smb (= T if passing surface mass balance to GLC; else pass PDD info; T by default) +- glc_dyntopo (= T if CLM topography changes dynamically; currently F) + (NOT fully implemented yet) + + New history fields: + QICE ice growth/melt (mm/s) + QICEYR ice growth/melt (mm/s) + gris_mask Greenland mask (unitless) + gris_area Greenland ice area (km^2) + aais_mask Antarctic mask (unitless) + aais_area Antarctic ice area (km^2) + +Changes to build-namelist: + + finidat file and possibly the fsurdat files include glc_nec values + Currently only support glc_nec=0 or glc_nec=10 + +List any changes to the defaults for the boundary datasets: Update datm domain file for T31 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jwolfe, lipscomb, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share + Also add in active glacier model + scripts to scripts4_100510a + csm_share to share3_100423 + gglc to glc4_100507 + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>> Add mec tests + A models/lnd/clm/test/system/config_files/_mec10sc_dh + A models/lnd/clm/test/system/config_files/_mec10sc_dm + A models/lnd/clm/test/system/config_files/_mec10sc_do + A models/lnd/clm/test/system/config_files/_mec10sc_ds + A models/lnd/clm/test/system/config_files/_mec10sc_h + A models/lnd/clm/test/system/config_files/_mec10sc_m + A models/lnd/clm/test/system/config_files/_mec10sc_o + A models/lnd/clm/test/system/nl_files/clm_glcmec + A models/lnd/clm/test/system/nl_files/nl_glcsmb + +>>>>>>>>>> Handle passing of data from clm to the active glacier model + A models/lnd/clm/src/main/clm_glclnd.F90 -- handle passing data to glc model + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Add mec tests + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/input_tests_master + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/config_files/README + M models/lnd/clm/test/system/README.testnames + +>>>>>>>>>>>> Add GLC_MEC to mksurfdata, add ability to set glc_nec on namelist + M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 + M models/lnd/clm/tools/mksurfdata/Makefile ------ Add gfortran remove xlf90 for Darwin + M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 + +>>>>>>>>>>>> Add some more checking for glc settings + M models/lnd/clm/bld/listDefaultNamelist.pl - Try to make faster, add loop over + glc_nec and glc_grid + M models/lnd/clm/bld/build-namelist --------- Get default glc_smb when + create_glacier_mec_landunits is on + M models/lnd/clm/bld/clm.cpl7.template ------ Add glc_ settings + M models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add glc_nec to + finidat files, add glc_nec="10" fsurdat files for T31, 1-deg, 2-deg + M models/lnd/clm/bld/configure + M models/lnd/clm/bld/config_files/Makefile.in - Add gfortran to Darwin and remove +xlf90 + M models/lnd/clm/bld/config_files/config_definition.xsl - Add glacier types + M models/lnd/clm/bld/config_files/config_definition.xml + +>>>>>>>>>>>> Read in glacier elevation classes from surfdata file as GLC_MEC +>>>>>>>>>>>> require it when create_glacier_mec_landunits is .true. and use it +>>>>>>>>>>>> to set value of glc_topomax. Add checking for glc options. +>>>>>>>>>>>> Also remove concurrent directives + M models/lnd/clm/src/main/clm_varcon.F90 -------- Add h2osno_max, lapse_glcmec + and istice_mec, change albice when GLC_NEC>0 + M models/lnd/clm/src/main/clm_varpar.F90 -------- Add npatch_glacier_mec + M models/lnd/clm/src/main/dynlandMod.F90 -------- Add checking for istice_mec + M models/lnd/clm/src/main/decompInitMod.F90 ----- Pass glcmask in + M models/lnd/clm/src/main/clm_initializeMod.F90 - Handle create_glacier_mec_landunit + M models/lnd/clm/src/main/ncdio.F90 ------------- Add 2D module procedures to ncd_iolocal interface + M models/lnd/clm/src/main/subgridMod.F90 -------- Handle create_glacier_mec_landunit if true + M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- Add glcmecpoi and greenland and antarctic mask/area + add forc_pbot, forc_rho, glc_topo, forc_t, forc_th to ces, forc_q to cws, eflx_bot to cef + add qflx_glcice, glc_rofi, glc_rofl + M models/lnd/clm/src/main/pftdynMod.F90 --------- Change comments + M models/lnd/clm/src/main/iniTimeConst.F90 ------ Handle istice_mec + M models/lnd/clm/src/main/clm_atmlnd.F90 -------- Fix comment + M models/lnd/clm/src/main/clm_varsur.F90 -------- Add topoxy + M models/lnd/clm/src/main/controlMod.F90 -------- Add create_glacier_mec_landunit, glc_dyntopo, glc_smb, fglcmask to namelist + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Add sno_export/import + M models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 Add sno_export/import + M models/lnd/clm/src/main/filterMod.F90 --------- Add istice_mec + M models/lnd/clm/src/main/clm_varctl.F90 -------- Add fglcmask, create_glacier_mec_landunit, + glc_dyntopo, glc_smb, glc_nec, and glc_topomax add some error checking for them + M models/lnd/clm/src/main/initGridCellsMod.F90 -- Make ice sheet masks and deal with glcmask + M models/lnd/clm/src/main/surfrdMod.F90 --------- Read GLCMASK, GLC_MEC, PCT_GLC_MEC and TOPO_GLC_MEC when create_glacier_mec_landunit + M models/lnd/clm/src/main/domainMod.F90 --------- Add glcmask + M models/lnd/clm/src/main/clmtype.F90 ----------- Add forc_pbot, forc_rho, glc_frac, glc_topo add + forc_t, forc_q, eflx_bot, qflx_glcice, glc_rofi, glc_rofl, glcmecpoi, gris and assis mask/area + M models/lnd/clm/src/main/histFldsMod.F90 ------- Add new fields when create_glacier_mec_landunit + M models/lnd/clm/src/main/histFileMod.F90 ------- Add glacier_mec to notes, set_noglcmec to hist_addfld1d + M models/lnd/clm/src/main/mkarbinitMod.F90 ------ Set mask sno to h2osno_max, use istice_mec + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ----- Assess if istice_mec and add qflx_glcice for glc_dyntopo +P + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - Assess if istice_mec + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 -- Assess if istice_mec and add eflx_bot + M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 ---- Assess if istice_mec + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- Move forc_pbot/forc_q/forc_t/forc_th from g to c, assess istice_mec + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- Assess if isice_mec + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 ------- Assess if isice_mec move force_t from g to c + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- Assess if istice_mec and add qflx_glcice + M models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 --- Downscale forc_t, forc_th, forc_q, forc_pbot from gridcell to columns + based on surface eleveation for glc_mec landunits + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - Change forcing from g to c + +Summary of testing: + + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_15 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_15 +FAIL ERS.f19_g16.I1850.bluefire.compare_hist.clm3_7_15 +FAIL ERS.f19_g16.I1850.bluefire.compare.clm3_7_15 +FAIL ERI.T31_g37.IG.bluefire +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_15 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm4_0_01 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_15 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_15 +FAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_15 + +PASS SMS_D.f19_g16.IG.bluefire +PASS ERS.f19_g16.IG.bluefire +FAIL SMS.T31_g37.IG.bluefire +FAIL SMS.f09_g16.IG.bluefire + + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_15 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm4_0_00 +Originator(s): erik (erik) +Date: Tue May 4 23:02:18 MDT 2010 +One-line Summary: Update to datm8, redirect aquifer overflow to drainage, add + gx3v7 masks, script to extract regional datasets, add harvesting for CN, + modify shrubs, include urban model, ice stream for snowcapping, new + build-namelist system, scale solar by solar zenith angle in datm, deep + soil with bedrock at bottom, organic matter in soils, SNICAR for snow + radiation, sparce dense aero, snow cover changes + +Type of tag: doc + +Software engineering changes: + + Update to cpl7 and scripts. + Remove offline and cpl6 modes. + Remove support for CASA model. + Update to datm8 atmospheric data model. + Add gx3v7 land mask for T31 and fv-4x5 horizontal resolutions. + Add gx1v6 land mask for f05, f09, and f19 horizontal resolutions. + Add tx1v1 land mask and 1.9x2.5_tx1v1 horizontal resolution. + Add in 2.5x3.33 horizontal resolution. + Add in T62 horizontal resolution so can run at same resolution as input datm data. + Allow first history tape to be 1D. + Add ability to use own version of input datasets with CLM_USRDAT_NAME variable. + Add a script to extract out regional datasets. + New build-namelist system with XML file describing all namelist items. + Add glacier_mec use-case and stub glacier model. + Add ncl script to time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. + Make default of maxpatch_pft=numpft+1 instead of 4. + Only output static 3D fields on first h0 history file to save space. + Add new fields for VOC (Volatile Organic Compounds) on some surface datasets + Add irrigation area to mksurfdata tool (NOT used in CLM yet). + Add multiple elevation class option for glaciers in mksurfdata tool (NOT used in CLM yet). + Add ascale field to land model in support of model running on it's own grid. + +Science changes: + + Change to freezing temperature constant + Forcing height at atm plus z0+d on each tile + Effective porosity divide by zero fix + Sparse/dense canopy aerodynamic parameters + Ground/snow emissivity smooth transition + Thermal and hydraulic properties of organic soil + Init h2osoi=0.3 + Snow compaction fix + Snow T profile during layer splitting fix + Snow burial fraction + Snow cover fraction + SNICAR (snow aging, black carbon and dust deposition, vertical distribution of solar energy) + Remove SNOWAGE, no longer used + Deep soil (15 layers, ~50m), 5 new layers are hydrologically inactive bed rock + Ground evap (beta), stability, and litter resistance + Organic/mineral soil hydraulic conductivity percolation theory + Richards equation modifications + Normalization of frozen fraction of soil formulation + One-step solution for soil moisture and qcharge + Changes to rsub_max for drainage and decay factor for surface runoff + Fixed diurnal cycle of solar radiation in offline forcing data + Back to CLM3 lakes and wetlands datasets, but 1% rather than 5% threshold (same for glacier) + Changes to pft physiology file from CN + New grass optical properties + New surface dataset assuming no herbaceous understory + Direct versus diffuse radiation offline + New VOC model (MEGAN) + Snow-capped runoff goes to new ice stream and routed to ocean as ice + Dust model always on, LAI threshold parameter change from 0.1 to 0.3 + Daylength control on vcmax + SAI and get_rad_dtime fix + Always run with MAXPATCH_PFT=npfts + 1 instead of 4 + Transient land cover/use mode - datasets, energy and water balance + RTM sub-cycling + Twostream bug fix + Update soil colors + 2m relative humidity + Fix for aquifer leak (SoilHydrologyMod, BalanceCheckMod) + New nitrogen deposition file (units and sum of NOx, NHy) + +Quickstart to new cpl7 scripts... + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) +Quickstart to use of regional extraction scripts and PERSONAL datasets: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + 1197 (MPI problem sending and receiving data in same array) +Describe any changes made to build system: + + Change directory structure to match CCSM. + Add BGP target. + Add choice between ESMF and MCT frameworks. + Start removing #ifdef and directives that supported Cray-X1 Phoenix as now decommissioned. + Make default of maxpatch_pft=numpft+1 instead of 4 for all configurations. + By default turn on CLAMP when either CN or CASA is enabled + New SNICAR_FRC, CARBON_AERO, and C13 CPP ifdef tokens. + + New options added to configure: + + -comp_intf Component interface to use (ESMF or MCT) (default MCT) + -nofire Turn off wildfires for bgc setting of CN (default includes fire for CN) + -pio Switch enables building with Parallel I/O library. [on | off] (default is on) + -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] (default is off) + +Describe any changes made to the namelist: + + NOTE: build-namelist now checks the validity of your namelist you generate by looking at data in the namelist_definition.xml + file. In order to add new namelist items you need to change the code and also edit this file. To view information + on the namelist view the file: + models/lnd/clm/bld/namelist_files/namelist_definition.xml + in your browser and you'll see the names, type, description and valid_values for all namelist variables. + + Changes to build-namelist: + Transient sim_year ranges (i.e. 1850-2000) + Remove cam_hist_case option. + Make sure options ONLY used for stand-alone testing have a "drv_" or "datm_" prefix in them and list these + options all together and last when asking for help from build-namelist. + New options to build-namelist: + -clm_usr_name "name" Dataset resolution/descriptor for personal datasets. Default: not used + Example: 1x1pt_boulderCO_c090722 to describe location, + number of pts, and date files created + New list options to build-namelist: + build-namelist -res list # List valid resolutions + build-namelist -mask list # List valid land-masks + build-namelist -sim_year list # List valid simulation years and simulation year ranges + build-namelist -clm_demand list # List namelist variables including those you could demand to be included. + build-namelist -use_case list # List valid use-cases + build-namelist -rcp list # List valid representative concentration pathways + # for future scenarios + + List of use-cases for build-namelist: + +1850-2100_rcp4.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 1850 to 2005 and then with the RCP4.5 scenario from MINICAM + +1850-2100_rcp8.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 1850 to 2005 and then with the RCP8.5 scenario from MESSAGE + + 1850_control = Conditions to simulate 1850 land-use +2000-2100_rcp8.5_transient = Simulate transient land-use, and aerosol deposition changes +with historical data from 2000 to 2005 and then with the RCP8.5 scenario from MESSAGE + + 2000_control = Conditions to simulate 2000 land-use +20thC_transient = Simulate transient land-use, and aerosol deposition changes from 1850 +to 2005 + pergro = Perturbation error growth test with initial conditions perturbed by +roundoff level + pergro0 = Perturbation error growth test with unperturbed initial conditions + + + New namelist items: + + urban_hac = OFF, ON or ON_WASTEHEAT (default OFF) Flag for urban Heating and Air-Conditioning + OFF = Building internal temperature is un-regulated. + ON = Building internal temperature is bounded to reasonable range. + ON_WASTEHEAT = Building internal temperature is bounded and resultant waste + heat is given off. + urban_traffic = .true. or .false. (default .false.) Flag to include additional multiplicative factor of urban traffic + to sensible heat flux. + fsnowoptions = filename file for snow/aerosol optical properties (required) + fsnowaging = filename file for snow aging parameters (required) + faerdep = filename file of aerosol deposition (required) + + New history variables: (note watt vs. W in units, 26 vs. 76) + BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s + BIOGENCO biogenic CO flux uGC/M2/H + C13_PRODUCT_CLOSS C13 total carbon loss from wood product pools gC13/m^2/s + DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s + EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 + FGR12 heat flux between soil layers 1 and 2 watt/m^2 + FSAT fractional area with water table at surface unitless + FSH_NODYNLNDUSE sensible heat flux not including correction for land use change + watt/m^2 + GC_HEAT1 initial gridcell total heat content J/m^2 + GC_HEAT2 post land cover change total heat content J/m^2 inactive + GC_ICE1 initial gridcell total ice content mm/s + GC_ICE2 post land cover change total ice content mm/s inactive + GC_LIQ1 initial gridcell total liq content mm + GC_LIQ2 initial gridcell total liq content mm inactive <<<< name?? + H2OSNO_TOP mass of snow in top snow layer kg + HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning + watt/m^2 + HK hydraulic conductivity mm/s inactive + ISOPRENE isoprene flux uGC/M2/H + LAND_USE_FLUX total C emitted from land cover conversion and wood produc t pools gC/m^2/s + LAND_UPTAKE NEE minus LAND_USE_FLUX, negative for update gC/m^2/s + LWup upwelling longwave radiation watt/m^2 inactive + MONOTERP monoterpene flux uGC/M2/H + NBP net biome production, includes fire, landuse, and harvest flux, positive for sink + gC/m^2/s + OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s + OVOC other VOC flux uGC/M2/H + ORVOC other reactive VOC flux uGC/M2/H + PBOT atmospheric pressure Pa + PCO2 atmospheric partial pressure of CO2 Pa + PRODUCT_CLOSS total carbon loss from wood product pools gC/m^2/s + PRODUCT_NLOSS total N loss from wood product pools gN/m^2/s + Qair atmospheric specific humidity kg/kg inactive + Qanth anthropogenic heat flux watt/m^2 inactive + Qtau momentum flux kg/m/s^2 + QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s + QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s + QRUNOFF_NODYNLNDUSE total liquid runoff not including correction for land use change (does not include QSNWCPICE) + mm/s + QSNWCPICE excess snowfall due to snow capping mm/s + QSNWCPICE_NODYNLNDUSE excess snowfall due to snow capping not including correction for land use change + mm/s + QSNWCPLIQ excess rainfall due to snow capping mm/s inactive + SMP soil matric potential mm inactive + SNOAERFRC2L surface forcing of all aerosols in snow, averaged only when snow is present (land) + watt/m^2 + SNOAERFRCL surface forcing of all aerosols in snow (land) watt/m^2 + SNOBCFRCL surface forcing of BC in snow (land) watt/m^2 + SNOBCMCL mass of BC in snow column kg/m2 + SNOBCMSL mass of BC in top snow layer kg/m2 + SNOdTdzL top snow layer temperature gradient (land) K/m + SNODSTFRC2L surface forcing of dust in snow, averaged only when snow is present (land) + watt/m^2 + SNODSTFRCL surface forcing of dust in snow (land) watt/m^2 + SNODSTMCL mass of dust in snow column kg/m2 + SNODSTMSL mass of dust in top snow layer kg/m2 + SNOFSRND direct nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRNI diffuse nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRVD direct vis reflected solar radiation from snow watt/m^2 inactive + SNOFSRVI diffuse vis reflected solar radiation from snow watt/m^2 inactive + SNOFSDSND direct nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSNI diffuse nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSVD direct vis incident solar radiation on snow watt/m^2 inactive + SNOFSDSVI diffuse vis incident solar radiation on snow watt/m^2 inactive + SNOLIQFL top snow layer liquid water fraction (land) fraction inactive + SNOOCMCL mass of OC in snow column kg/m2 + SNOOCMSL mass of OC in top snow layer Kg/m2 + SNOOCFRC2L surface forcing of OC in snow, averaged only when snow is present (land) + SNOOCFRCL surface forcing of OC in snow (land) watt/m^2 + watt/m^2 + SNORDSL top snow layer effective grain radius m^-6 inactive + SNOTTOPL snow temperature (top layer) K/m inactive <<< units? + SOILWATER_10CM soil liquid water + ice in top 10cm of soil kg/m2 + SWup upwelling shortwave radiation watt/m^2 inactive + TSOI_10CM soil temperature in top 10cm of soil K + URBAN_AC urban air conditioning flux watt/m^2 + URBAN_HEAT urban heating flux watt/m^2 + VOCFLXT total VOC flux into atmosphere uGC/M2/H + Wind atmospheric wind velocity magnitude m/s inactive + WOOD_HARVESTC wood harvest (to product pools) gC/m^2/s + WOOD_HARVESTN wood harvest (to product pools) gN/m^2/s + + History field name changes: + + ANNSUM_PLANT_NDEMAND => ANNSUM_POTENTIAL_GPP + ANNSUM_RETRANSN => ANNMAX_RETRANSN + C13_DWT_PROD10C_LOSS => C13_PROD10C_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + C13_DWT_PROD10N_LOSS => C13_PROD10N_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + DWT_PROD100N_LOSS => PROD10N_LOSS + DWT_PROD100N_LOSS => PROD100N_LOSS + DWT_PROD100C_LOSS => PROD10C_LOSS + DWT_PROD100C_LOSS => PROD100C_LOSS + HCSOISNO => HC + TEMPSUM_PLANT_NDEMAND => TEMPSUM_POTENTIAL_GPP + TEMPSUM_RETRANSN => TEMPMAX_RETRANSN + + History field names deleted: + SNOWAGE, TSNOW, FMICR, FCO2, DMI, QFLX_SNOWCAP + + Add new urban oriented _U, and _R (Urban and Rural) for: + EFLX_LH_TOT, FGR, FIRA, FSH, FSM, Q2M, QRUNOFF, RH2M, SoilAlpha, TG, TREFMNAV, TREFMXAV, and TSA + (missing _R for SoilAlpha) + +Describe timing and memory performance: + +Versions of any externally defined libraries: + + scripts scripts4_100108b + drv vocemis-drydep12_drvseq3_1_11 + datm datm8_091218 + socn stubs1_2_02/socn + sice stubs1_2_02/sice + sglc stubs1_2_02/sglc + csm_share vocemis-drydep13_share3_091217 + esmf_wrf_timemgr esmf_wrf_timemgr_090402 + timing timing_090929 + mct MCT2_7_0_100106 + pio pio60_prod + cprnc cprnc_081022 + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_5_00 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: new climate for clm4 + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ + +=============================================================== +=============================================================== +Tag name: clm3_8_00 +Originator(s): erik (erik) +Date: Tue May 4 22:39:18 MDT 2010 +One-line Summary: Get future scenarios working, finalize documentation, bring in MEGAN VOC and CNDV, simplify, mksurfdata optimization, fix bugs: snow enthalpy, BMOZ, pergro, use pft weights from fsurdat NOT finidat + +Purpose of changes: + +Get all of the future scenarios working (other than rcp=6.0) and get all of the datasets +for these scenarios (pftdyn, fndepdyn, and aerdep files, for rcp=2.6,4.5, and 8.5). +Finalize the User's Guide for now, with reviews from: Sam, Keith, Dave, and Sean, as +well as more work on tools chapter, and adding testing chapter in appendix. We brought +in the MEGAN version of the Volatile Organic Compounds (VOC) module which also reads +in VOC emission factors from the surface dataset, and hence all fsurdat files needed +to be replaced. Along with this the mksurfdata tool was changed in order to handle VOC's +and effort was made to optimize it, add shared memory paralelism, and do memory +optimization. We also removed the old Dynamic Global Vegetation Model (DGVM) and replaced +it with the Carbon Nitrogen Dynamic Vegetation model (CNDV). Make some simplifications +in the configure system to always use the CCSM version of build files, remove some +unused options, put standalone test options last in configure. Improve documenation in +XML files for configure and build-namelist options. + +Fix many different bugs. Enthalpy in snow combination was sometimes NOT conserved and now +is. There was a problem running DryDeposition for the BMOZ compset that is now fixed. +There were multiple issues running PERGRO testing that is now fixed. Previously, if +both the finidat file and the fsurdat file had PFT weights on them, the values from +the finidat file was used, now it will use the values from the fsurdat file. There are +also several cases where if the weights are different it will abort with an error, or +at least send a message to the log file about the differences. + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Type of tag: doc + +Describe any changes made to build system: + Switch cndv for dgvm, Have configure disallow bad cases + Change configure to NOT allow supln with spinup cases + Do NOT allow exit_spinup and ad_spinup at the same time. + Only allow voc to be set for seq_ccsm NOT ext_ccsm_seq + Remove carbon_aero and pio from configure (always build with pio) + emove unused configure options: clm_exe, -clm_exedir, and -clm_bld. + Move standalone testing options to the end of help. Use CCSM version + of mkSrcfiles/mkDepends, separate config vars into categories, work + on documentation with comments from Keith/Sam. + +Describe any changes made to the namelist: + Add 2000-2100 simulation year range as allowed option + + Two new history fields: + + TSOI_10CM = soil temperature in top 10cm of soil (K) + SOILWATER_10CM = soil liquid water + ice in top 10cm of soil (kg/m2) + + Check for some files based on rcp (fpftdyn, ndepdyn, and aerdep) + + Add in ability to add a user namelist in your case directory to input + namelist items at configure time. Simply add a file called "user_nl_clm" + as a valid namelist and the items in that namelist will show up in the initial + BuildConf/clm.buildnml.csh file. + +List any changes to the defaults for the boundary datasets: + get urbanc_alpha grid and frac files in + get in new single-point datasets + new qtr-degree, T62 and T85 fsurdat + new f10, f05, f09, 1850 fsurdat + new rcp=8.5, f19 pftdyn, + new rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=8.5/4.5/2.6 f19 aerdep 1850-2100 datasets + new rcp=8.5/4.5 f19 fndepdyn 1850-2100 datasets + new rcp=2.6/4.5 f10, f45, f25, f09 aerdep/ndepdyn datasets + new rcp=2.6/4.5,8.5 f19 decadal averages for ndepdat + (Note: harvest was updated in PFTDYN files and raw PFT input files for 2006). + New 10x15 and 4x5 finidat files so that transient cases will work at those resolutions + New finidat files for 1-deg and 2-deg (from fully coupled simulations) + New datasets for I cases that are set in scripts + Duplicate cn datasets for cndv + New pft-physiology files with extra fields for CNDV + Remove 360x720 files, gx3v5, gx1v5 files + Remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + Remove gx1v3, gx1v4, gx1v5 land masks, add drydep defaults. + add mksrf_fvegtyp@1000-1004 + +Describe any substantial timing or memory changes: None + +Code reviewed by: + snow changes came from dlawren and also reviewed by oleson + PFT weight change also reviewed by: dlawren, slevis, oleson + CNDV came from slevis + VOC changes came from Francis Vitt and Jean-Francois Lamarque + history changes came from Keith Oleson, reviewed by Dave Lawrenece + OpenMP bug fix came from Mariana-Vertenstein, reviewed by Pat Worley + +List any svn externals directories updated (csm_share, mct, etc.): all + scripts to scripts4_100406a + drv to drvseq3_1_23 + datm to datm8_100406 + csm_share to share3_100407 + pio to pio1_0_18 + timing to timing_091021 + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_00 + +Changes answers relative to baseline: Yes! + snow change has a small effect on climate (see below) + Bringing in MEGAN VOC changes answers for VOC fluxes in a diagnostic way + Changing to use weights from fsurdat file rather than finidat file, changes + answers for cases with finidat startup files, if the weights are different. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ +http://www.cgd.ucar.edu/ccr/dlawren/research/clm4.0_dev/b40.1850.track1.2deg.003.snowa-b40.1850.track1.2deg.003.controla/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_7_15 +Originator(s): erik (erik) +Date: Tue Apr 27 10:13:57 MDT 2010 +One-line Summary: Finish User's Guide, surfdata files for urban-1pt, fix mksurfdata ifort bugs, work with testing + +Purpose of changes: + +Fix all urban single-point datasets (mexicocity, urbanc_alpha), fix get_regional script +to work. Add more documentation on mksurfdata to users-guide, add pergro procedure +examples, more to testing section. Remove "moving the sun" warning. Fix +ndeplintInterp.ncl and getregional_datasets.ncl scripts. + +Bugs fixed (include bugzilla ID): + 1125 (T85, qtr-degree and urban pt surface datasets) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1150 (Bug in indices in getregional_datasets.ncl script) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Type of tag: std-test + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New fsurdat files for urban-1p datasets + 1x1_vancouverCAN, 1x1_mexicocityMEX, 1x1_urbanc_alpha, 1x1_asphaltjungleNJ + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm + + datm to datm8_100406 + +List all files eliminated: + +>>>>>>>>>>> Remove test lists no longer used + D models/lnd/clm/test/system/tests_pretag_bangkok + D models/lnd/clm/test/system/tests_pretag_calgary + D models/lnd/clm/test/system/tests_posttag_lightning_nompi + +List all files added and what they do: + +>>>>>>>>>>> Add plot of pergro testing + A models/lnd/clm/doc/UsersGuide/pergro.jpg +>>>>>>>>>>> Add in plotting for pergro testing + A models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat + A models/lnd/clm/tools/ncl_scripts/RMSintrepid.dat + A models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Remove tests no longer used, work on documentation + M models/lnd/clm/test/system/test_driver.sh ---- Remove calgary, work on doc + M models/lnd/clm/test/system/gen_test_table.sh - Remove note for calgary + M models/lnd/clm/test/system/README ------------ Clarify documentation + M models/lnd/clm/test/system/CLM_runcmnd.sh ---- Remove calgary +>>>>>>>>>>> Fix ifort compiler problems, point to $CSMDATA locations of 1850 +>>>>>>>>>>> and 2000 PFT datasets + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ---- Change path + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt - Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ------- Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn --------- Change path + M models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt - Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ------- Change path + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist ------- Change path + M models/lnd/clm/tools/mksurfdata/README -------------------- Update documentation + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -------------- outnc_double to + .true., fix implicit none statements, add documentation + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ------------- Add ability to set + inputdata directory + M models/lnd/clm/tools/mksurfdata/creategridMod.F90 --------- Change where to loops +>>>>>>>>>>> Fix bug in time axis and getregional indices + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl - Fix time axis and check it + M models/lnd/clm/tools/ncl_scripts/README ------------- Add note about pergroPlot + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl +>>>>>>>>>>> Fix CLM_USRDAT_NAME and add urban 1pt datasets + M models/lnd/clm/bld/clm.cpl7.template ------------------------ Set resolution for CLM_USRDAT_NAME + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New urban pt1 + datasets: 1x1_vancouverCAN, 1x1_mexicocityMEX, 1x1_urbanc_alpha, 1x1_asphaltjungleNJ +>>>>>>>>>>> Remove SNICAR message about moving the sun + M models/lnd/clm/src/biogeophys/SNICARMod.F90 +>>>>>>>>>>> Finish off current User's Guide +>>>>>>>>>>> Bring rel03->rel04 updates in, run ispell on everything +>>>>>>>>>>> Work on mksurfdata and testing sections, give instructions for pergro +>>>>>>>>>>> Add help from mksurfdata.pl and test_driver.sh scripts + M models/lnd/clm/doc/KnownBugs -- Add note that mkgriddata can not straddle Greenwich + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/config_cache.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/special_cases.xml + +Summary of testing: + + bluefire: All PASS except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG55 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +048 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 12 + bluefire interactive testing: All PASS except... +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except +FAIL PST.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL PET_PT.f45_g37.I1850.bluefire.compare.clm3_7_10 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_15 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_10 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_10 +BFAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_10 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_10 + jaguar: All PASS except.. +005 smB51 TSM.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 144 arb_ic ..............FAIL! rc= 10 +006 erB51 TER.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +007 brB51 TBR.sh _scsnf_dh clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +026 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +027 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +028 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +030 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +031 erL58 TER.sh _sc_dh clm_std^nl_crcrop 20020115:NONE:1800 10x15 USGS 12+84 arb_ic ............FAIL! rc= 5 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: All PASS except... +002 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA92 TBR.sh _sc_dm clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 72+72 cold ...............FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 5 +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +020 smG53 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG53 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG53 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG53 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_14 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_14 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Apr 8 16:15:35 MDT 2010 +One-line Summary: Fix rcp=2.6/4.5 1-degree fndepdyn filenames + +Purpose of changes: + +Fix the names of the rcp=2.6/4.5 1-degree fndepdyn filenames (had a 100208 file creation +date but should be 100407). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Fix fndepdyn filenames + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Fix fndepdyn filenames + +Summary of testing: None + +=============================================================== +=============================================================== +Tag name: clm3_7_13 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Apr 8 10:53:06 MDT 2010 +One-line Summary: Add in missing rcp=2.6/6 use-cases, and fix syntax errors in the namelist_defaults file + +Purpose of changes: + +Add in missing use cases for rcp=4.5 and rcp=6 transient future scenarios. Fix syntax errors in the namelist_defaults_clm +file. + +Bugs fixed (include bugzilla ID): Above two problems + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Nonae + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp2.6_transient.xml +A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp6_transient.xml + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Fix syntax errors + +Summary of testing: None, other than script creation testing + +=============================================================== +=============================================================== +Tag name: clm3_7_12 +Originator(s): erik (erik) +Date: Thu Apr 8 00:30:30 MDT 2010 +One-line Summary: rcp=2.6/4.5 datasets for fndepdyn and aerdepdat, fix some minor issues, new 1pt urban surfdata files + +Purpose of changes: + +Add in urban single-point surfdata files. Add in regridded ndepdyn/aerdep files: f09, +f45, f10, f25. Fix name of f05, 1850 fsurdat file, add in new urban single point +datasets, add back urbanc_alpha grid/frac files. Put rcp in filenames for aerdep/ndep +regrid scripts. chomp frac filename in mksurfdata.pl, for urban single-point files. Make +OPT=TRUE default for mksurfdata. Lengthen allowed gridname for mksurfdata. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + aerdep/ndepdyn for rcp=2.6/4.5 f10, f45, f25, f09 + fix name of f05 fsurdata file for 1850 + get urbanc_alpha grid and frac files in + get in new urban single-point datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + csm_share to share3_100407 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/Makefile ------ make OPT=TRUE the default +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -- lengthen gridname to 32 +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - make sure to chomp fracdata file + +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Add rcp to filename +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Add rcp to filename + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New datasets + aerdep/ndepdyn for rcp=2.6/4.5 f10, f45, f25, f09 + fix name of f05 fsurdata file for 1850 + get urbanc_alpha grid and frac files in + get in new urban single-point datasets + +Summary of testing: + + bluefire interactive testing: All PASS except up to 014 smJ74 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +010 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 + +=============================================================== +=============================================================== +Tag name: clm3_7_11 +Originator(s): erik (erik) +Date: Wed Apr 7 11:59:22 MDT 2010 +One-line Summary: qtr-degree and T85 surfdata, rcp=2.6/4.5 datasets, doc updates + +Purpose of changes: + +Documentation updates, for users guide and namelist and configure xml files (rel04 to +rel05 update). Fix missing deallocate (bug 1133), and line length for NEE. Changes in +mksurfdata so that will run for qtr-degree. New rcp datasets for 4.5 and 2.6, aerdep +(only f19)/ndepdyn/pftdyn datasets. Fix CN spinup test, fix test name for bluefire tests. +Add in qtr-degree and T85 surfdata files. + +Bugs fixed (include bugzilla ID): + 1141 (CN spinup test) + 1137 (qtr-deg fsurdat) + 1136 (line length for NEE in histFlds) + 1135 (miss smG45 test) + 1133 (missing deallocate) + 1125 (T85, qtr-degree and urban pt surface datasets) + (partial T85 and qtr-degree) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + new qtr-degree and T85 fsurdat + new rcp=8.5, f19 pftdyn, rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=4.5/2.6 f19 aerdep 1850-2100 datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv + scripts to scripts4_100406a + drv to drvseq3_1_23 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt -- Rename with _hist_ + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt -- Rename with _hist_ + +List all files added and what they do: + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr2000.txt - Renamed from above + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850.txt - Renamed from above + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Turn supln off for spinup modes + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/tests_pretag_bluefire --------------- Change name of missing test smG45->smG55 + +>>>>>>>>>>>>> Change names of pftdyn text files to include _hist_ +>>>>>>>>>>>>> Memory updates so uses less memory (allocate just before needed +>>>>>>>>>>>>> deallocate after done). This is from the ccsm4_0_rel05 update +>>>>>>>>>>>>> Mariana started the changes and Erik added some more. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 ----- Memory updates + + M models/lnd/clm/bld/clm.cpl7.template - Use $CASETOOLS for Makefile + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - + new qtr-degree and T85 fsurdat + new rcp=8.5, f19 pftdyn, rcp=4.5 f09, f19, f10 pftdyn + new rcp=2.6 f09, f19, f10 pftdyn + new rcp=4.5/2.6 f19 aerdep 1850-2100 datasets + +>>>>>>>>>>>>> Documentation udpates updating from rel04 to ccsm4_0_rel05 + M models/lnd/clm/bld/configure -------------------------- change CVS to SVN + M models/lnd/clm/bld/config_files/config_definition.xsl - Correct name + M models/lnd/clm/bld/config_files/config_definition.xml - Add category for maxpft + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Work with categories + and improve descriptions, remove rpntpath + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl - Seperate out + stand-alone testing categories, improve documentation, work + on categories. + +>>>>>>>>>>>>> Documentation udpates updating from rel04 to ccsm4_0_rel05 +>>>>>>>>>>>>> Updates from Sam, Keith, and Sean, more doc on tools and appendix + M models/lnd/clm/doc/UsersGuide/co2_streams.txt + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_stylesheet.dsl + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + M models/lnd/clm/doc/UsersGuide/special_cases.xml + M models/lnd/clm/doc/KnownBugs --------------------------- Add notes on: + bugzilla bugs: 669, 1024, 1124, 1125, 1127 + + M models/lnd/clm/src/main/accFldsMod.F90 -- Deallocate outside #ifdef + M models/lnd/clm/src/main/histFldsMod.F90 - Shorten long line for NEE + +Summary of testing: + + bluefire: All PASS up to 024, blHN1 test except... +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except (up to 26 brAK8 test) +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + jaguar interactive testing: All PASS up to smAK4 test except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............SKIPPED* +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +008 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_10 + +Changes answers relative to baseline: no (b4b) + +=============================================================== +=============================================================== +Tag name: clm3_7_10 +Originator(s): erik (erik) +Date: Mon Mar 22 23:54:48 MDT 2010 +One-line Summary: Fix drydep so that BMOZ case will work + +Purpose of changes: + +Update externals, fix drydep bug (so that BMOZ case will run bug 1132). Add 10x15 and 4x5 +finidat files, so that bluefire.clm.auxtest PET and PST cases will work. Fix +documentation on transient CO2. + +Bugs fixed (include bugzilla ID): + 1132 (clm failure for BMOZ compset) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New 10x15 and 4x5 finidat files so that transient cases will work at those resolutions + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm, pio + Update to ccsm4_0_beta47 versions + scripts to scripts4_100322b + drv to drvseq3_1_20 + datm to datm8_100225 + pio to pio1_0_18 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/doc/UsersGuide/Makefile ---------- Fix conversion to xml +M models/lnd/clm/doc/UsersGuide/special_cases.xml - Fix transient CO2 doc +M models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff - Fix CO2 file + +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --- Fix historical rcp value +M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Fix so will run + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Add 10x15, 4x5 + finidat files + +M models/lnd/clm/src/main/clm_comp.F90 ------- check drydep_method +M models/lnd/clm/src/main/clmtypeInitMod.F90 - check drydep_method +M models/lnd/clm/src/main/clm_atmlnd.F90 ----- check drydep_method, don't pass + drydep stuff unless drydep_method is DD_XLND + +Summary of testing: + + bluefire/CCSM testing: All PASS except... +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_10 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_07 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_09 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_09 +Originator(s): erik (erik) +Date: Sun Mar 21 21:08:54 MDT 2010 +One-line Summary: Fix snow enthalpy bug, cndv datasets, various fixes + +Purpose of changes: + +Fix snow enthalpy bug from Dave Lawrence. Add rcp to mksurfdata.pl. Add new 2006 datasets +for pftdyn files for mksurfdata. Fix history bug. New rcp 8.5 1-degree pftdyn dataset. +Duplicate all cn datasets for cndv. pergro use cases output in double precision. Some +work on documentation. + +Bugs fixed (include bugzilla ID): + 1128 (cndv needs the same input files as cn) + 1130 (History problem on restarts) + 1131 (pergro use cases need double output files) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1124 (Reported energy for pftdyn grid-cell not right) + 1125 (T85, qtr-degree and urban pt surface datasets) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + + New 1-degree rcp=8.5 pftdyn dataset with harvest for 2006 + Duplicate cn datasets for cndv + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + snow changes come from dlawren and also reviewed by oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +>>>>>>>>>>> Add AIM rcp datasets +A models/lnd/clm/tools/mksurfdata/pftdyn_rcp6.0_simyr1850-2100.txt + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt - New 2006 file +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl - Add rcp as argument +M models/lnd/clm/tools/mksurfdata/README -------- Document mksurfdata.pl and rcp files + +M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl - Get rid of old masks + +M models/lnd/clm/tools/interpinic/runinit_ibm.csh - Get rid of old masks/grids, and sim_year +M models/lnd/clm/tools/interpinic/README ---------- Update documentation + +M models/lnd/clm/tools/mkgriddata/mkgriddata.ccsm_dom - Add clm grid file +M models/lnd/clm/tools/mkgriddata/README ------------- More documentation + +M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml ------ Output history in double +M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml ----- Output history in double +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Duplicate cn files for cndv + New 1-degree rcp=8.5 pftdyn file + +M models/lnd/clm/src/main/histFileMod.F90 - Make sure 3D fields defined before output + +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 - conserve enthalpy on snow combination + +M models/lnd/clm/doc/IMPORTANT_NOTES ----- Add notes about fine-mesh +M models/lnd/clm/doc/UsersGuide/Makefile - Remove file for realclean + +Summary of testing: + + bluefire: +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v7 -3+-3 arb_ic .............FAIL! rc= 11 +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v7 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v7 144 cold .................FAIL! rc= 7 +010 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 arb_ic ......FAIL! rc= 11 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 arb_ic ............FAIL! rc= 7 +015 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 cold .......FAIL! rc= 11 +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 7 +019 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 13 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +023 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 13 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic .....FAIL! rc= 13 +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +016 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 11 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +031 brF93 TBR.sh 17p_vodsrsc_do clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v7 72+72 cold .......FAIL! rc= 11 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 7 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 13 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +047 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +049 bl754 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 2 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort: interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +009 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +010 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +011 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +013 smOC4 TSM.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +017 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 + edinburgh/ifort +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_08 + +Changes answers relative to baseline: YES + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: same climate + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + ccsm4_0_beta35 + bluefire + -compset B_1850_TRACK1_CN -res f19_g16 + + MSS location of control simulations used to validate new climate: + +/DLAWREN/csm/b40.1850.track1.2deg.003.snow + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/ccr/paleo/b40.snow/b40.1850.track1.2deg.003.snow-b40.1850.track1.2deg.003.control/ +http://www.cgd.ucar.edu/ccr/dlawren/research/clm4.0_dev/b40.1850.track1.2deg.003.snowa-b40.1850.track1.2deg.003.controla/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_7_08 +Originator(s): Mariana Vertenstein (mvertens) +Date: Fri Mar 12 13:26:09 MST 2010 +One-line Summary: Removal of check for weights if dynamic land use is used + +Purpose of changes: +This one line change enabled the vast majority of the CCSM tests to pass. + +Verified that ERI 20th century tests in CCSM test suite for ccsm4_0_beta46 now passed with this changed + +This was reviewed by Dave Lawrence and Sam Levis + +Everything from clm3_7_07 applies except for the following: + +M biogeophys/BiogeophysRestMod.F90 + - if ( nsrest == 1 .or. (nsrest == 3 .and. fpftdyn /= ' ') )then + - ! Do NOT do any testing for restart or a pftdyn branch case + + if ( nsrest == 1 .or. fpftdyn /= ' ' )then + + ! Do NOT do any testing for restart or a pftdyn case + also added in a #if CNDV + +M biogeochem/CNDVEstablishmentMod.F90 +M main/clmtypeInitMod.F90 + - fix for case when leaf area index is pathologically large + the original fix for this was not longer working - and the above changes address this + +M bld/build-namelist +M bld/namelist_files/namelist_defaults_clm.xml + - fixed issues related to getting fndepdat for -bgc cndv + +=============================================================== +Tag name: clm3_7_07 +Originator(s): erik (erik) +Date: Wed Mar 10 23:35:37 MST 2010 +One-line Summary: New finidat datasets for 1-deg, 2-deg, and abort if weights from finidat/fsurdat files are too different, and use fsurdat files as truth + +Purpose of changes: + +Use surfdata weights and stop if finidat file weights are too different. Use ccsm4init +datasets for finidat files for 1-deg and 2-deg. In I compsets, setup for special I case +finidat files. Update scripts. Drydep changes from Francis. Change cell_method to +cell_methods. Allow clm_start_type to be overridden if on use_case. Only set orb_iyearad +for standalone clm testing. Allow vars on use_cases to not be set for some configs. Make +sure all BGC modes are set for variables on use_cases. Set cold-start for pergro cases. +Update documentation. + +Bugs fixed (include bugzilla ID): + 1098 (use weights from surdat file rather than finidat file) + 1121 (history variable attribute cell_methods misnamed) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + + New finidat files for 1-deg and 2-deg (from fully coupled simulations) + New datasets for I cases that are set in scripts + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, dlawren, slevis, oleson + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_100310c + + This version of scripts sets up special finidat files that will be used + for all I cases (other cases use the fully coupled datasets that are stored + in the namelist_defaults_clm.xml database). + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New finidat files +M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ------------ Changes from Francis +M models/lnd/clm/src/main/ncdio.F90 --------------------------- Change cell_method to cell_methods +M models/lnd/clm/src/main/clm_initializeMod.F90 --------------- Remove second call to pftdyn_interp +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --------- Compare weights only + if NOT restart and NOT branch with pftdyn. If weights are too different + abort, if close enough write a warning and continue using the surfdata + weights + +>>>>>>>>>>>>>>>> Some work on documentation +M models/lnd/clm/doc/KnownBugs +M models/lnd/clm/doc/UsersGuide/preface.xml +M models/lnd/clm/doc/IMPORTANT_NOTES +M models/lnd/clm/doc/Quickstart.GUIDE + +>>>>>>>>>>>>>>>> Allow clm_start_type to be overridden if on use_case +>>>>>>>>>>>>>>>> Allow vars in use_cases to not be set for some configs +M models/lnd/clm/bld/build-namelist + +>>>>>>>>>>>>>>>> Change start_type to clm_start_type for all use-cases +>>>>>>>>>>>>>>>> Only set orb_iyearad for standalone clm testing +M models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml +M models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml +M models/lnd/clm/bld/namelist_files/use_cases/pergro.xml --------- Set start to cold +M models/lnd/clm/bld/namelist_files/use_cases/pergro0.xml -------- Set start to cold +M models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + +Summary of testing: + + bluefire: All PASS except... +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: All PASS except... +FAIL ERS.f19_g16.I1850.bluefire.compare_hist.clm3_7_06 +FAIL ERS.f19_g16.I1850.bluefire.compare.clm3_7_06 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_06 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_07 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_06 +SFAIL PST.f10_f10.I8520CN.bluefire.GC.201955 +SFAIL PET_PT.f10_f10.I8520CN.bluefire.GC.201955 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare_hist.clm3_7_06 +FAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_06 + jaguar interactive testing: All PASS up to... +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold + +CLM tag used for the baseline comparison tests if applicable: clm3_7_06 + +Changes answers relative to baseline: Different initial condition datasets, + also now using weights from surfdata files rather than finidat files + +=============================================================== +=============================================================== +Tag name: clm3_7_06 +Originator(s): erik (erik) +Date: Wed Mar 10 16:35:57 MST 2010 +One-line Summary: Bring cndv branch to trunk + +Purpose of changes: + +Bring CNDV branch to trunk cndv16_clm3_7_05 (erik/slevis). Fix bug 978 for Sam (nl +option for branch). Put CROP part of CNDV branch on it's own branch. Add a couple more +history fields (LAND_USE_FLUX, and LAND_UPTAKE). Add HTOP to default output. SNICAR_FRC +fix, test SNICAR_FRC. Fix VOC by making sure fsun240 is between 0 and 1. Fix CO2 PPMV for +I cases. Add in script to create CO2 streams file that can be used by datm8. Update VOC +documentation. Get in updates from ccsm4_0_rel branch. Remove 360x720 grid, files with +gx3v5/gx1v5 masks. Fix bug 1120, by initializing displavegc+ for CN, Change start_type to +clm_start_type, don't allow both fndepdat and fndepdyn. Don't allow spinup modes with +supln, and don't allow both ad_spinup and exit_spinup. Move testing from gx3v5 to gx3v7 +mask + +Bugs fixed (include bugzilla ID): + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1121 (history variable attribute cell_methods misnamed) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Switch cndv for dgvm, Have configure disallow +bad cases + Change configure to NOT allow supln with spinup cases + Do NOT allow exit_spinup and ad_spinup at the same time. + Only allow voc to be set for seq_ccsm NOT ext_ccsm_seq + +Describe any changes made to the namelist: Add override_nsrest namelist option + +List any changes to the defaults for the boundary datasets: + New pft-physiology files with extra fields for CNDV + Add new f05 1850 surfdata file + Remove 360x720 files, gx3v5, gx1v5 files + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis, self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, csm_share, mct, and pio + + scripts to scripts4_100306 + drv to drvseq3_1_19 + csm_share to share3_100228 + mct to MCT2_7_0_100228 + pio to pio1_0_15 + +List all files eliminated: Remove DGVM files + + D models/lnd/clm/src/biogeochem/DGVMLightMod.F90 + D models/lnd/clm/src/biogeochem/DGVMReproductionMod.F90 + D models/lnd/clm/src/biogeochem/DGVMAllocationMod.F90 + D models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 + D models/lnd/clm/src/biogeochem/DGVMKillMod.F90 + D models/lnd/clm/src/biogeochem/DGVMEstablishmentMod.F90 + D models/lnd/clm/src/biogeochem/DGVMRestMod.F90 + D models/lnd/clm/src/biogeochem/DGVMMod.F90 + D models/lnd/clm/src/biogeochem/DGVMMortalityMod.F90 + D models/lnd/clm/src/biogeochem/DGVMTurnoverMod.F90 + D models/lnd/clm/src/biogeochem/DGVMFireMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>>> Add CNDV files + A models/lnd/clm/src/biogeochem/CNDVEstablishmentMod.F90 + A models/lnd/clm/src/biogeochem/CNDVLightMod.F90 + A models/lnd/clm/src/biogeochem/CNDVMod.F90 + A models/lnd/clm/src/biogeochem/CNDVEcosystemDynIniMod.F90 +>>>>>>>>>>>>> Add script to convert CAM historical greenhouse gas file to CO2 history +>>>>>>>>>>>>> file that can be used in datm streams + A models/lnd/clm/tools/ncl_scripts/getco2_historical.ncl +>>>>>>>>>>>>> Add SNICAR_FRC and CNDV config files to test + A models/lnd/clm/test/system/config_files/_scsnf_dh + A models/lnd/clm/test/system/config_files/_scsnf_dm + A models/lnd/clm/test/system/config_files/_scsnf_do + A models/lnd/clm/test/system/config_files/17p_cndvsc_dh + A models/lnd/clm/test/system/config_files/17p_cndvsc_dm + A models/lnd/clm/test/system/config_files/17p_cndvsc_do + A models/lnd/clm/test/system/config_files/17p_cndvsc_h + +>>>>>>>>>>>>> Add files to describe how to add streams for CO2 + A models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + A models/lnd/clm/doc/UsersGuide/co2_streams.txt + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Document new getco2 script, use correct namelist in getregional script + M models/lnd/clm/tools/ncl_scripts/README + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl + +>>>>>>>>>>>>>>> Add K configure tests for CNDV, B configure tests for SNICAR_FRC, +>>>>>>>>>>>>>>> and create_croplunit tests Change maxpft 17 tests to numpft+1 + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_h + M models/lnd/clm/test/system/config_files/17p_cnnsc_m + M models/lnd/clm/test/system/config_files/17p_cnnsc_o + M models/lnd/clm/test/system/config_files/17p_cnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dh + M models/lnd/clm/test/system/config_files/17p_cnsc_do + M models/lnd/clm/test/system/config_files/17p_cnc13sc_dm + M models/lnd/clm/test/system/config_files/17p_cnc13sc_do + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm + M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_dh + M models/lnd/clm/test/system/config_files/17p_cnnsc_dm + M models/lnd/clm/test/system/config_files/17p_cnnsc_do + M models/lnd/clm/test/system/config_files/17p_cnnsc_ds + + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_breeze + M models/lnd/clm/test/system/tests_pretag_jaguar_nompi + M models/lnd/clm/test/system/tests_pretag_bangkok + M models/lnd/clm/test/system/tests_posttag_purempi_regression + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_pretag_calgary + + M models/lnd/clm/test/system/input_tests_master - Add B and K tests + M models/lnd/clm/test/system/test_driver.sh ----- Update for bluefire changes + to scripts + M models/lnd/clm/test/system/mknamelist --------- Change start_type to + clm_start_type add in nrevsnfile + M models/lnd/clm/test/system/README.testnames --- Change K configure +tests to mean CNDV + +>>>>>>>>>>>>> + M models/lnd/clm/bld/configure ---- Swap out cndv for dgvm. -bgc cndv turns on + both CN AND CNDV cpp tokens. + voc part of standalone_test arguments + supln and spinup options can't be on at the same +time + exit_spinup and ad_spinup can't be on at the +same time + M models/lnd/clm/bld/queryDefaultXML.pm ---------------- Swap cndv for DGVM + M models/lnd/clm/bld/config_files/config_definition.xml - Swap cndv for dgvm + voc in standalone_test, maxpft lists valid numbers +category + M models/lnd/clm/bld/build-namelist ----- Change start_type to clm_start_type + Don't allow both fndepdyn and fndepdat to e set + Work with nrevsn, so not always given + M models/lnd/clm/bld/clm.cpl7.template -- Rename start_type to clm_start_type, and + let default be "default" + M models/lnd/clm/bld/namelist_files/checkdatmfiles.ncl ------ Update mask list + M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Add override_nsrest, + mkghg_bndtvghg, rename start_type to clm_startype + + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add +clm_start_type + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml ---- Remove domain +files + with gx3v5 and gx1v5 masks + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- new pft-physiology files for CNDV + Use same fndepdat datasets for cndv + Remove 360x720 files, + files with gx3v5 and gx1v5 masks + New 1850 f05 fsurdat file + Add mkghg_bndtvghg dataset to point to CAM + historical greenhouse dataset + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ----- Remove +start_type + + M models/lnd/clm/doc/UsersGuide/tools.xml + M models/lnd/clm/doc/UsersGuide/preface.xml + M models/lnd/clm/doc/UsersGuide/clm_ug.xml + M models/lnd/clm/doc/UsersGuide/adding_files.xml + M models/lnd/clm/doc/UsersGuide/appendix.xml + M models/lnd/clm/doc/UsersGuide/custom.xml + M models/lnd/clm/doc/UsersGuide/single_point.xml + M models/lnd/clm/doc/UsersGuide/Makefile + M models/lnd/clm/doc/UsersGuide/special_cases.xml + +>>>>>>>>>>>>> Add in landuseflux/landuptake, always use hardwire_sla for VOC +>>>>>>>>>>>>> Set displavegc for CN not just CNDV, new fields for SNICAR_FRC restarts + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Calculate landuseflux/landuptake + M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 ------- Calculate pftmayexist for CNDV + Remove concurrent directives + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Always use hardwire_sla + Remove DGVM CPP ifdefs, fix for transient problem from Dave + loop over soil filter rather than non-lake + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set displavegc etc. for CN as well as CNDV + Add some CNDV fields + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------- Remove agdd0/agdd5,fnpsn10, + initialize landuseflux/landuptake + M models/lnd/clm/src/main/CNiniSpecial.F90 --------------- initialize landuseflux/landuptake + M models/lnd/clm/src/main/clmtype.F90 -------------------- Swap DGVM vars for CNDV + add pftmayexist, landuseflux/landuptake + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Add LAND_USE_FLUX, LAND_UPTAKE, make HTOP active + Swap DGVM fields for CNDV + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 ---- Add fields needed for SNICAR_FRC + + M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 --- Remove uneeded use statement + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ---- CNDV changes + M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNGRespMod.F90 ----------- Remove junk + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ---- + M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 --- + M models/lnd/clm/src/biogeochem/CNFireMod.F90 ------------ CNDV section + M models/lnd/clm/src/biogeochem/CNMRespMod.F90 ----------- Remove junk + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 Remove junk + M models/lnd/clm/src/biogeochem/CNDecompMod.F90 ---------- Pass lbp, ubp to CNAllocate + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 --- Formatting changes + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- Swap CNDV for DGVM + M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 - Remove junk + M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------ Add CNDV section + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ---- Add CNDV section + M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 -------- Remove junk + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 ------- Remove junk + M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------ Pass pft loop indices in, + formatting changes remove junk + M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 --------- Remove junk + M models/lnd/clm/src/biogeochem/DryDepVelocity.F90 ------- Swap CNDV for DGVM + M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ---- Pass lbp, ubp to CNDecompAlloc + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Use dwood from pft-physiology file + Add CNDV section + + M models/lnd/clm/src/main/clm_varpar.F90 --------- Change some of the names around + M models/lnd/clm/src/main/CNiniTimeVar.F90 ------- CNDV section for litter fall + M models/lnd/clm/src/main/clm_comp.F90 ----------- Swap CNDV for DGVM + M models/lnd/clm/src/main/clm_initializeMod.F90 -- Swap CNDV for DGVM + M models/lnd/clm/src/main/accFldsMod.F90 --------- Swap CNDV for DGVM + M models/lnd/clm/src/main/subgridMod.F90 --------- Handle create_croplandunit correctly + M models/lnd/clm/src/main/pftdynMod.F90 ---------- Add CNDV subroutine: pftwt_init + For CNDV make pftwt_interp public +and + M models/lnd/clm/src/main/iniTimeConst.F90 ------- Change dgvm vars init + M models/lnd/clm/src/main/restFileMod.F90 -------- Remove DGVM + M models/lnd/clm/src/main/controlMod.F90 --------- Add override_nsrest, swap CNDV for DGVM + M models/lnd/clm/src/main/initSurfAlbMod.F90 ----- Swap CNDV for DGVM + M models/lnd/clm/src/main/filterMod.F90 ---------- Swap CNDV for DGVM remove concurrent directives + M models/lnd/clm/src/main/clm_driver.F90 --------- Swap CNDV for DGVM + M models/lnd/clm/src/main/clm_varctl.F90 --------- Swap CNDV for DGVM, fix check for create_croplandunit + M models/lnd/clm/src/main/ndepFileMod.F90 -------- Remove junk + M models/lnd/clm/src/main/initGridCellsMod.F90 --- Fix create_croplandunit + M models/lnd/clm/src/main/pftvarcon.F90 ---------- New CNDV parameters, formatting changes, + Always read all parameters to make read easier to understand + M models/lnd/clm/src/main/surfrdMod.F90 ---------- Swap CNDV for DGVMA, fix create_croplandunit, change some names + + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ----- Remove junk + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 - Remove junk add comments + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 --- Remove junk + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Change comments remove DGVM + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ---- Change formatting add comments + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------- Remove DGVM + M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 - Remove junk + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Remove DGVM add in CNDV + +Summary of testing: + + bluefire: +FAIL! rc= 7 +025 smK51 TSM.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................PASS +026 erK51 TER.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 10+38 arb_ic ...............PASS +027 brK51 TBR.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 24+24 arb_ic ...............PASS +028 blK51 TBL.sh 17p_cndvsc_dh clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +029 smHN1 TSM.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colPASS +030 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 13 +031 brHN1 TBR.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -5+-5 cFAIL! rc= 11 +032 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + bluefire interactive testing: All PASS except... +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v7 48 cold .............FAIL! rc= 5 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 7 +040 blK74 TBL.sh 17p_cndvsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 + bluefire/CCSM testing: All PASS except.. (compare tests fail because CO2 level was changed for 2000 compsets) +FAIL SMS_RLA.f45_f45.I.bluefire.compare_hist.clm3_7_05 +FAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_7_05 +FAIL SMS_RLB.f45_f45.I.bluefire.compare_hist.clm3_7_05 +FAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_7_05 +BFAIL ERS_D.f45_g37.I.bluefire.compare.clm3_7_05 +FAIL ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_7_05 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_06 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_05 +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_05 +FAIL PST.f10_f10.I8520CN.bluefire.compare.clm3_7_05 +BFAIL PET_PT.f10_f10.I8520CN.bluefire.compare.clm3_7_05 +BFAIL ERS_D.f19_g16.IRCP85CN.bluefire.compare.clm3_7_05 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_05 + +Changes answers relative to baseline: I2000 cases are different because of new CCSM_CO2_PPMV + +=============================================================== +=============================================================== +Tag name: clm3_7_05 +Originator(s): erik (erik) +Date: Wed Feb 24 00:33:08 MST 2010 +One-line Summary: Bring VOC branch source code to trunk + +Purpose of changes: + +Move VOC branch over to trunk (vocemis-drydep19_clm3_7_04), this includes source code +changes for VOC and drydep. Ensure answers for f09, f19, f10 are identical to clm3_7_02 +(other than VOC fields). Split users guide into separate files by chapter. Remove dublin. +Add rcp option to getregional dataset script. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1132 (clm failure for BMOZ compset) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Fix date of 1x1_tropicAtl surfdata + New T62 fsurdat file with VOC + Fix syntax error in default_datm file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and drv + + scripts to scripts4_100222 (uses new bluefire compiler with bug-fix for + reproducibility bug) + drv to drvseq3_1_17 + +List all files eliminated: + +>>>>>>>>>>>>> Rename to edinburgh + D models/lnd/clm/test/system/tests_pretag_dublin + D models/lnd/clm/test/system/tests_pretag_dublin_nompi + +>>>>>>>>>>>>> Split into separate files + D models/lnd/clm/doc/UsersGuide/index.xml + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_edinburgh ------- Rename dublin files + A models/lnd/clm/test/system/tests_pretag_edinburgh_nompi - Rename dublin files + +>>>>>>>>>>>>> Split Users Guide into separate files by chapter + A models/lnd/clm/doc/UsersGuide/tools.xml + A models/lnd/clm/doc/UsersGuide/preface.xml + A models/lnd/clm/doc/UsersGuide/clm_ug.xml + A models/lnd/clm/doc/UsersGuide/adding_files.xml + A models/lnd/clm/doc/UsersGuide/config_cache.xml + A models/lnd/clm/doc/UsersGuide/custom.xml + A models/lnd/clm/doc/UsersGuide/get_Icaselist.pl --- Script to list I cases + A models/lnd/clm/doc/UsersGuide/single_point.xml + A models/lnd/clm/doc/UsersGuide/special_cases.xml + +>>>>>>>>>>>>> Add module to handle dry-deposition velocity + A models/lnd/clm/src/biogeochem/DryDepVelocity.F90 + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>> Remove dublin + M models/lnd/clm/test/system/test_driver.sh + M models/lnd/clm/test/system/input_tests_master - Decrease mexicoCity run length to 157 + M models/lnd/clm/test/system/CLM_runcmnd.sh + +>>>>>>>>>>>>> Fix bug in dynamic PFT file generation example, let intel allow lines of +>>>>>>>>>>>>> any length + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn - Use 1850 veg file to start from + M models/lnd/clm/tools/mksurfdata/Makefile ---------- Remove intel -132 so can be any +length + M models/lnd/clm/tools/mkgriddata/Makefile ---------- Remove intel -132 so can be any + length, add SMP option + M models/lnd/clm/tools/mkdatadomain/Makefile -------- Remove intel -132 so can be any +length + + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl -- Add absolute_path and + ability to use rcp + M models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl - Add rcp + correct namelist for domainfile + +>>>>>>>>>>>>> + M models/lnd/clm/bld/clm.cpl7.template ---- Turn rtm off for PTS_MODE, remove lnd_in +and Filepath files from clmconf + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Fix syntax error in +2.5x3.33 domain file + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Fix date of +surfdata_1x1_tropicAtl file + +>>>>>>>>>>>>> Split into separate files by Chapter + M models/lnd/clm/doc/UsersGuide/Makefile + +>>>>>>>>>>>>> Source code changes to use MEGAN VOC and dry-deposition + + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 -- Add readAnnualVegetation + subroutine for dry-deposition, use some F90 NetCDF, + get mlai difference between months for dry-deposition + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------ New MEGAN VOC module + remove concurrent directives + M models/lnd/clm/src/main/clm_varpar.F90 ---------------- Change comment on nvoc + M models/lnd/clm/src/main/clm_comp.F90 ------------------ Interp monthly veg for + drydep on clm_init2 + M models/lnd/clm/src/main/clm_initializeMod.F90 --------- add readAnnualVegetation + M models/lnd/clm/src/main/accFldsMod.F90 ---------------- 24hr and 10day accumulators for + t_veg, fsd, fsi, fsun, laip, remove concurrent directives + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------ Add new VOC and drydep variables + M models/lnd/clm/src/main/iniTimeConst.F90 -------------- Read in VOC emission + factors, remove concurrent directives + M models/lnd/clm/src/main/clm_atmlnd.F90 ---------------- Add VOC and drydep fluxes + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 ------ Pass VOC and drydep fluxes + M models/lnd/clm/src/main/clm_driver.F90 ---------------- Always call VOC emission + and call depvel_compute + M models/lnd/clm/src/main/clmtype.F90 ------------------- Add some VOC and drydep + variables, move sandfrac/clayfrac for all not just CASA + add accumulation variables + M models/lnd/clm/src/main/histFldsMod.F90 --------------- Bunch of new inactive + variables for VOC fluxes + M models/lnd/clm/src/main/inicFileMod.F90 --------------- Li Xu: correct ncd_iolocal and snow_fraction + M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 - Deal with drydep velocity + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Add mlaidiff to restart + file, if fsun set to NaN on restart set it to spval + M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ----- Keep track of boundary + layer resistance + +Summary of testing: + + Baseline tests are identical other than VOC flux fields.. +> grep RMS +> /ptmp/erik/test-driver.612049/TBL.4p_vodsrsc_dh.clm_std^nl_urb.20021231:NONE:3600.1.9x2.5^0.9x1.25.gx1v6.48.arb_ic/cprnc.clmrun.clm2.h0.2002-12-31-00000.nc.out +> | grep -v 0.0000E+00 + RMS BIOGENCO 1.0058E-01 + RMS ISOPRENE 2.9500E+02 + RMS MONOTERP 2.9129E+00 + RMS ORVOC 3.3526E-01 + RMS OVOC 3.3526E-01 + RMS VOCFLXT 2.9641E+02 + + bluefire: +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 +011 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 +016 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +020 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +024 blHN1 TBL.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -10 colFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +033 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 +041 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 7 +043 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 8 +044 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +045 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +046 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +050 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 7 + bluefire interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +006 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +007 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +008 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +011 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +012 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 +017 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 7 +018 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +023 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +028 blL78 TBL.sh _nrsc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic ...........FAIL! rc= 7 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 7 +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +RUN ERS_D.f45_g37.I.bluefire.GC.092123 +PASS PST.f45_g37.I1850.bluefire.cpl +PASS PST.f45_g37.I1850.bluefire.atm +PASS PST.f45_g37.I1850.bluefire.lnd +PASS PST.f45_g37.I1850.bluefire.ice +PASS PST.f45_g37.I1850.bluefire.ocn +PASS PST.f45_g37.I1850.bluefire.glc +PASS PET_PT.f45_g37.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PEND ERH_D.f10_f10.I1850CN.bluefire.GC.092123 +PASS PST.f10_f10.I8520CN.bluefire.cpl +PASS PST.f10_f10.I8520CN.bluefire.atm +PASS PST.f10_f10.I8520CN.bluefire.lnd +PASS PST.f10_f10.I8520CN.bluefire.ice +PASS PST.f10_f10.I8520CN.bluefire.ocn +PASS PST.f10_f10.I8520CN.bluefire.glc + jaguar/CCSM testing: +PASS ERS_D.f09_g16.I1850.jaguar +PASS PST.f10_f10.I8520CN.jaguar.cpl +PASS PST.f10_f10.I8520CN.jaguar.atm +PASS PST.f10_f10.I8520CN.jaguar.lnd +PASS PST.f10_f10.I8520CN.jaguar.ice +PASS PST.f10_f10.I8520CN.jaguar.ocn +PASS PST.f10_f10.I8520CN.jaguar.glc +PASS PET_PT.f10_f10.I8520CN.jaguar + jaguar interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic FAIL! rc= 8 +014 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 5 +016 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 4 + edinburgh/ifort interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +009 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +010 erCA4 TER.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ....FAIL! rc= 5 +011 brCA4 TBR.sh _nrsc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic .FAIL! rc= 5 +012 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +013 smOC4 TSM.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +014 erOC4 TER.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_FAIL! rc= 5 +015 brOC4 TBR.sh _nrvansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arbFAIL! rc= 5 +016 blOC4 TBL.sh _nrvansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 4 +017 smNB4 TSM.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 10 +018 erNB4 TER.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 57+100 arb_FAIL! rc= 5 +019 brNB4 TBR.sh _nrmexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arFAIL! rc= 5 +020 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 157 arb_ic FAIL! rc= 4 + edinburgh/ifort: +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +016 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 7 +008 smCA4 TSM.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 10 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 4 +010 smCA8 TSM.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 10 +011 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 4 +015 blL54 TBL.sh _sc_ds clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 7 +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold .......FAIL! rc= 7 +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_04 + +Changes answers relative to baseline: No bit-for-bit (except voc flux fields) + +=============================================================== +=============================================================== +Tag name: clm3_7_04 +Originator(s): erik (erik) +Date: Wed Feb 17 23:22:23 MST 2010 +One-line Summary: Bring VOC branch (vocemis-drydep18_clm3_7_03) tools, testing, and build to trunk (everything other than VOC code changes) + +Purpose of changes: + +Move VOC branch (vocemis-drydep18_clm3_7_03) to trunk for support functionality, tools, +testing, everything but the code changes. This includes optimization of mksurfdata, +adding new tests, adding drydep to build, listen to cpl flag if aerosols are sent, update +documentation about configure variables, remove pio and carbon_aero config options +(always build with pio), remove local Macro's files for Darwin (yong_g95, and +breeze_intel), and remove gx1v3, gx1v4 masks, and 1x1.25 and 2x2.5 grids. All NCL regrid +scripts to be able to use GRDFIL env variable to set location of a grid file just +created. turn rtm off if PTS_MODE is TRUE. mksurfdata optimization includes: create +subroutines for landuse normalization, add OpenMP parallelism, optimize memory so +deallocate when done, and put OMP threads, veg filenames and optimization level on +mksurfdata files. Move shr_drydepInputMod.F90 to drv/shr/seq_drydepMod.F90 (from +csm_share to drv). Update externals. Work on documentation using output logs from scripts +and moving documentation into separate chapters. + +Bugs fixed (include bugzilla ID): + 926 (pftdyn code needs to be shared in mksurfdata) + 1105 (Turn RTM mode off for PTS_MODE) + 1110 (dt limit error, for mexicocity) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1121 (history variable attribute cell_methods misnamed) + 1118 (Restarts with SNICAR_FRC fail) + 1133 (missing deallocate) + 1135 (miss smG45 test) + 1136 (line length for NEE in histFlds) + 1137 (qtr-deg fsurdat) + 1139 (LAND and PFTS 1D vector averaging doesn't work) + 1141 (CN spinup test) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + 1157 (Problem with VOC interpolation in mksurfdata) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Remove carbon_aero and pio from configure (always build with pio) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + Remove gx1v3, gx1v4, gx1v5 land masks, add drydep defaults. + Update 2.65x3.33@2000, 1x1_tropicAtl@2000, f09@1850 and 1x1_tropicAtl@1000-1004 pftdyn + add mksrf_fvegtyp@1000-1004 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, drv, datm, and timing + + csm_share to share3_100215 + scripts to scripts4_100216 + drv to drvseq3_1_16 + datm to datm8_100215 + timing to timing_091021 + +List all files eliminated: + +>>>>>>>>>>>> Remove local Macros files, and remove maxpft=4 vodsrcsc tests + D models/lnd/clm/bld/config_files/Macros.yong_g95 + D models/lnd/clm/bld/config_files/Macros.breeze_intel + D models/lnd/clm/test/system/config_files/4p_vodsrsc_m + D models/lnd/clm/test/system/config_files/4p_vodsrsc_h + + D models/lnd/clm/doc/UsersGuide/index.xml -- Rename to clm_ug.xml + Divide most of the content into separate chapters. + +List all files added and what they do: + + A models/lnd/clm/test/system/config_files/_scnv_dh ---- No-VOC debug-hybrid mode + A models/lnd/clm/test/system/config_files/_scnv_do ---- No-VOC debug-pure SMP hybrid mode + A models/lnd/clm/test/system/config_files/17p_scnv_dh - 17pft no-VOC debug-hybrid mode + A models/lnd/clm/test/system/config_files/17p_scnv_do - 17pft no-VOC debug-pure SMP mode + A models/lnd/clm/test/system/nl_files/clm_drydep ------ Turn on drydep in namelist + A models/lnd/clm/tools/mksurfdata/mkvocef.F90 --------- VOC emissions + A models/lnd/clm/bld/namelist_files/namelist_defaults_drydep.xml - Drydep namelist defaults + A models/lnd/clm/doc/UsersGuide/tools.xml --------- Tools chapter + A models/lnd/clm/doc/UsersGuide/preface.xml ------- Preface and introduction chapter + A models/lnd/clm/doc/UsersGuide/clm_ug.xml -------- Change name of index.xml + Move most of the contents into separate chapters + A models/lnd/clm/doc/UsersGuide/adding_files.xml -- Adding files chapter + A models/lnd/clm/doc/UsersGuide/config_cache.xml -- Sample config cache file so can + run build-namelist for documentation + A models/lnd/clm/doc/UsersGuide/custom.xml -------- Customizing chapter + A models/lnd/clm/doc/UsersGuide/get_Icaselist.pl -- Script to get list of I cases + A models/lnd/clm/doc/UsersGuide/single_point.xml -- Single point chapter + A models/lnd/clm/doc/UsersGuide/special_cases.xml - Special cases chapter + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README - Add nv no-VOC config case + M models/lnd/clm/test/system/README.testnames ---- Add drydep testnames + M models/lnd/clm/test/system/test_driver.sh ------ Use generic_linux_intel mach for breeze + also changes to get jaguar to work + M models/lnd/clm/test/system/input_tests_master -- Add drydep and no-VOC tests, cut + back Mexicocity test to 158 steps + + M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 -------- Add mksrf_gridnm and mksrf_fvocef + M models/lnd/clm/tools/mksurfdata/ncdio.F90 ----------- Write out error codes on a problem. + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional - Add voc file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn --- Add voc file, use 1850 veg file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept - Add voc file. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist - Add voc file. + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 ---- Move file definition for harvest to init sub + M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ------- Write out OpenMP threads + and OPT TRUE or FALSE, VOC fields, and veg filenames + M models/lnd/clm/tools/mksurfdata/mkorganic.F90 ------- Remove test and use 3D areaave + M models/lnd/clm/tools/mksurfdata/Makefile ------------ Add in SMP option to turn on OpenMP + M models/lnd/clm/tools/mksurfdata/mkurbanparMod.F90 --- Remove single level fields + and use 4D areaave + M models/lnd/clm/tools/mksurfdata/areaMod.F90 --------- Add 3D and 4D areaave interfaces + and add OpenMP directives + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 -------- Create subroutines shared + by dynpft loop and surfdata: change_landuse and normalizencheck_landuse. + Allocate memory as late as possible and deallocate as soon as possible. + Add: mksrf_gridnm and mksrf_fvocef to namelist + Add mkvocef and add to output file + M models/lnd/clm/tools/mksurfdata/Srcfiles ------------ Add mkvocef.F90 + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ------- Allow command line arguments + to pick resolutions and simulation-years. Read in namelist database information + for checking and using defaults. Add in mksrf_fvocef, and use mksrf_gridnm to + give output file same name as the input grid resolution name. + M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 -------- Remove testing, add 3D areaave + + M models/lnd/clm/tools/ncl_scripts/README ----------- Remove script no longer available. + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Allow env var GRDFIL to give + grid file to use + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Allow env var GRDFIL to give + grid file to use + + M models/lnd/clm/tools/mkgriddata/README -- Fix typo + + M models/lnd/clm/bld/configure --------------------------------- Remove carbon_aero + and pio (always build with pio), and make voc default on + M models/lnd/clm/bld/queryDefaultNamelist.pl ------------------- Add drydep file. + M models/lnd/clm/bld/config_files/config_sys_defaults.xml ------ Change mach + defaults, remove darwin make linux edinburgh_pgi + M models/lnd/clm/bld/config_files/config_definition.xml -------- Remove carbon_aero + and pio, make default for mode ext_ccsm_seq, make voc on, + work on documentation + M models/lnd/clm/bld/build-namelist ---------------------------- Add drydep, remove + carbon_aero and pio + M models/lnd/clm/bld/clm.cpl7.template ------------------------- Turn rtm off for PTS_MODE + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add mksrf_fvegtyp, + remove 1x1.25, 2x2.5, and 2.5x3.33 grid resolutions + remove gx1v3, gx1v4, gx1v5 land masks, add drydep_method, and drydep_list + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Remove 1x1.25, + 2x2.5, and gx1v3, gx1v4, gx1v5 domain files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- Remove 1x1.25, + and gx1v3, gx1v4, gx1v5 files + update 2.65x3.33@2000, 1x1_tropicAtl@2000, f09@1850 + and 1x1_tropicAtl@1000-1004 pftdyn + add mksrf_fvegtyp@1000-1004 + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml -- Remove gx1v4, gx1v5 start dates + + M models/lnd/clm/doc/UsersGuide/Makefile --- Get makefile to use scripts to make + log info to put into document, and separate out document + into chapters + + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 --- Use atm_aero in infodata + to determine: caerdep_filled, and dustdep_filled + some changes to get ready for VOC and drydep branch to come to trunk + +Summary of testing: + + bluefire: All PASS up to 019 brEH1 + bluefire interactive testing: All PASS except... +004 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 +arb_ic FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 + bluefire/CCSM testing: +PASS SMS_RLB.f45_f45.I.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/ifort: All PASS except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_03 + +Changes answers relative to baseline: 1x1_tropicAtl changes due to new surfdata file + +=============================================================== +=============================================================== +Tag name: clm3_7_03 +Originator(s): erik (erik) +Date: Wed Feb 10 11:29:56 MST 2010 +One-line Summary: Add in more future scenario datasets, new history fields from Keith + +Purpose of changes: + +Add in pftdyn dataset for 1-degree rcp-8.5. Add in interpolated aerdep/ndepdyn scenario +files for f10, f09. Add in code change from Keith O. for average of top soil layers. Add +in rcp for ndep and aerdep regrid scripts. Allow 2000-2100 sim_year_range for 1-degree +resolution, and have a aerdep dataset for 1-degree for 2000-2100 (copy other 1850-2100 +datasets). There is also a 1-degree 1850-2100 aerosol dataset, but the file is large (~9GB). + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: + Add 2000-2100 simulation year range as allowed option + + Two new history fields: + + TSOI_10CM = soil temperature in top 10cm of soil (K) + SOILWATER_10CM = soil liquid water + ice in top 10cm of soil (kg/m2) + +List any changes to the defaults for the boundary datasets: New datasets for rcp=8.5 + f09, rcp=8.5 pftdyn for 1850-200 (use same file for 2000-2100) + faerdep, for 1850-2100 rcp=8.5, f10, f45, f25, f09 (and 2000-2100) and f19 for 2000-2100 + fndepdyn, for 1850-2000 rcp=8.5 f09 (use same file for 2000-2100), f25, f45, f10 + fndepdyn for 1850-2100 rcp=2.6 for native f19 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, history changes from Keith Oleson, reviewed by Dave Lawrenece + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: use-case for 2000-2100 for high resolution (1 degree and up) + +>>>>>>>>>> Add a use-case for a future scenario that only includes 2000-2100 +>>>>>>>>>> this is for 1-degree and higher resolution where we can't include the +>>>>>>>>>> historical period and have resonable sized files. + A models/lnd/clm/bld/namelist_files/use_cases/2000-2100_rcp8.5_transient.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>> Get regridding scripts working for rcp's + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Allow rcp to be set, more printing + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Allow rcp to be set, allow more sim_year_ranges + +>>>>>>>>>> New rcp=8.5 datasets, and 2000-2100 support for 1-degree + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New rcp=8.5 datasets + f09, rcp=8.5 pftdyn for 1850-200 (use same file for 2000-2100) + faerdep, for 1850-2100 rcp=8.5, f10, f45, f25, f09 (and 2000-2100) and f19 for 2000-2100 + fndepdyn, for 1850-2000 rcp=8.5 f09 (use same file for 2000-2100), f25, f45, f10 + fndepdyn for 1850-2100 rcp=2.6 for native f19 + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Allow 2000-2100 sim-year range + + M models/lnd/clm/doc/UsersGuide/index.xml --- Update documentation with namelist examples + +>>>>>>>>>> Code changes from Keith Oleson to add 10cm soil temperature and soil water history variables. + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------ Add h2osoi_liqice_10cm and t_soi_10cm + M models/lnd/clm/src/main/clmtype.F90 ------------- Add h2osoi_liqice_10cm and t_soi_10cm + M models/lnd/clm/src/main/histFldsMod.F90 --------- Add TSOI_10CM and SOILWATER_10CM, + on by default and output as average by default. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 - Calculate 10cm soil averages for non-urban points + +Summary of testing: + + bluefire: All PASS except... +022 erHN1 TER.sh 17p_cnsc_dh clm_transient_rcp8.5 20051220:NONE:1800 1.9x2.5 gx1v6@1850-2100 -3+-7 cFAIL! rc= 7 +025 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +026 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +029 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +034 erL83 TER.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ........FAIL! rc= 6 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 3 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 3 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLA.f45_f45.I.bluefire.compare_hist.clm3_7_02 +PASS SMS_RLA.f45_f45.I.bluefire.compare.clm3_7_02 +PEND SMS_RLB.f45_f45.I.bluefire.GC.140232 +PEND SMS_ROA.f45_f45.I.bluefire.GC.140232 +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_7_02 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_7_02 +PEND PET.f45_g37.I1850.bluefire.GC.140232 +PEND ERS.f19_g16.I1850.bluefire.GC.140232 +RUN ERB.f09_g16.I_1948-2004.bluefire.GC.140232 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_02 +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_02 +PEND PET.f10_f10.I8520CN.bluefire.GC.140232 +FAIL ERS_D.f19_g16.I8521CNR85.bluefire +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.compare.clm3_7_02 + jaguar interactive testing: All PASS except... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + edinburgh/lf95: All PASS up to smL58 (test 29) except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_02 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_02 +Originator(s): erik (erik) +Date: Sat Feb 6 00:43:49 MST 2010 +One-line Summary: Start adding in new rcp=8.5 datasets, remove some junk, change some env_conf variables, add user_nl_clm + +Purpose of changes: + +New pftdyn, ndep and aerdep files for rcp=8.5 future scenario 2005+ . Need to have the +ability to handle four future scenarios: minicam (rcp4.5), aim (rcp 6), image (rcp2.6), +and message (rcp8.5). Add in ndepdat datasets for rcp2.6 for future decades. Add in +ndepdyn, pftdyn, aerdep datasets for rcp8.5, and ndepdyn for rcp4.5 (f19) and pftdyn for +f10 as well. Some changes to scripts, remove CLM_DEMAND, add CLM_NML_USE_CASE, +CLM_CO2_TYPE and user namelist. Add user_nl to clm.cpl7.template, remove CLM_DEMAND add +CLM_CO2_TYPE and CLM_NML_USE_CASE (in favor of use_case's,). Make sure driver/scripts +updated with this change. Update documentation Users-Guide with comments from Keith and +Sam. Remove clm copy of mkSrcfiles/mkDepends. Remove run-ibm. Remove following options +from configure and config_definition: clm_exe, clm_exedir, and clm_bld. Remove +CASE/CCSM/CAM tests from test_driver.sh. Add some tests for new rcp=8.5. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1143 (Problems with mksurfdata and ifort) + 1144 (Bug in ndeplintInterp.ncl in calculation of time axis) + 1147 (mkgriddata can't straddle over Greenwich) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Some changes to configure + Remove unused configure options: clm_exe, -clm_exedir, and -clm_bld. + Move standalone testing options to the end of help. Use CCSM version + of mkSrcfiles/mkDepends, separate config vars into categories, work + on documentation with comments from Keith/Sam. + +Describe any changes made to the namelist: Check for some files based on rcp + + Add in ability to add a user namelist in your case directory to input + namelist items at configure time. Simply add a file called "user_nl_clm" + as a valid namelist and the items in that namelist will show up in the initial + BuildConf/clm.buildnml.csh file. + +List any changes to the defaults for the boundary datasets: + fsurdat: f10, 1850 + fpftdyn: f10, 1850-2000, 1850-2100 (rcp=8.5) + fpftdyn: f19, 1850-2100 (rcp=8.5) + faerdep: f19, 1850-2100 (rcp=8.5) + fndepdat: f19, decadal averages (rcp=2.6) + fndepdyn: f19, 1850-2100 (rcp=8.5 and rcp=4.5) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + + scripts to scripts4_100204 + drv to drvseq3_1_15 + pio to pio1_0_8 + +List all files eliminated: + +>>>>>>>>>>>>>>> Remove CCSM, scam, cam, and run-ibm script testing from test-system +>>>>>>>>>>>>>>> Use .clm.auxtest lists in CCSM scripts for CCSM testing + D models/lnd/clm/test/system/TSM_ccsmseq.sh + D models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh + D models/lnd/clm/test/system/TCT_ccsmseq.sh + D models/lnd/clm/test/system/TCSruncase.sh + D models/lnd/clm/test/system/TSMruncase.sh + D models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh + D models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh + D models/lnd/clm/test/system/tests_posttag_lightning + D models/lnd/clm/test/system/config_files/scam_ds + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_10x15_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_4x5_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_1.9x2.5_dh + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s + D models/lnd/clm/test/system/config_files/ext_ccsm_seq_0.9x1.25_dh + D models/lnd/clm/bld/run-ibm.csh + D models/lnd/clm/bld/create_newcase +>>>>>>>>>>>>>>> Remove mkSrcfiles/mkDepends duplicated from ccsm scripts + D models/lnd/clm/bld/mkSrcfiles + D models/lnd/clm/bld/mkDepends + +List all files added and what they do: + +>>>>>>>>>>>>> no-RTM mode configurations for hybrid and mpi-only testing + A models/lnd/clm/test/system/config_files/_nrsc_dh + A models/lnd/clm/test/system/config_files/_nrsc_dm +>>>>>>>>>>>>> Add transient_rcp8.5 use-case option + A models/lnd/clm/test/system/nl_files/clm_transient_rcp8.5 + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/README.testnames --- Update test names + M models/lnd/clm/test/system/test_driver.sh ----- Remove CLM_SEQCCSMROOT + M models/lnd/clm/test/system/input_tests_master - Remove CCSM/cam tests, add rcp8.5 test + M models/lnd/clm/test/system/README ------------- Remove doc on CLM_SEQCCSMROOT +>>>>>>>>>>>>> Remove CCSM, cam, scam, and run-ibm tests from test lists + M models/lnd/clm/test/system/tests_pretag_bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi + M models/lnd/clm/test/system/tests_pretag_jaguar + M models/lnd/clm/test/system/tests_posttag_kraken + M models/lnd/clm/test/system/tests_posttag_hybrid_regression + M models/lnd/clm/test/system/tests_pretag_bangkok + M models/lnd/clm/test/system/tests_posttag_intrepid + M models/lnd/clm/test/system/tests_pretag_dublin + M models/lnd/clm/test/system/tests_pretag_dublin_nompi + M models/lnd/clm/test/system/tests_posttag_nompi_regression + M models/lnd/clm/test/system/tests_pretag_calgary + +>>>>>>>>>>>>> New location for mkDepends, correct documentation + M models/lnd/clm/tools/mkgriddata/README ----- Correct mention of download + M models/lnd/clm/tools/mksurfdata/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/interpinic/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/mkgriddata/Makefile --- Change location of mkDepends + M models/lnd/clm/tools/mkdatadomain/Makefile - Change location of mkDepends + +>>>>>>>>>>>>> Remove unused configure options: clm_exe, -clm_exedir, and -clm_bld +>>>>>>>>>>>>> Move standalone testing options to the end of help +>>>>>>>>>>>>> Use CCSM version of mkSrcfiles/mkDepends, separate config vars into +>>>>>>>>>>>>> categories, work on documentation + M models/lnd/clm/bld/configure -------------------------- Move clm standalone testing + options to the end of the help, remove: -clm_exe, + -clm_exedir, and -clm_bld options + M models/lnd/clm/bld/config_files/Makefile.in ----------- Use CCSM version of mkSrcfiles/mkDepends + M models/lnd/clm/bld/config_files/config_definition.xsl - Separate variables into categories. + M models/lnd/clm/bld/config_files/config_definition.xml - Add categories, add + description changes from Keith/Sam, remove clm_exe, clm_exedir, and clm_bld + + M models/lnd/clm/bld/listDefaultNamelist.pl -- Also loop over rcp values + + M models/lnd/clm/bld/build-namelist ----- have rcp value impact filenames retrieved + M models/lnd/clm/bld/clm.cpl7.template -- Add CLM_NML_USE_CASE and CLM_CO2_TYPE, + remove CLM_DEMAND add user_nl_clm namelist, remove -clm_bld. + M models/lnd/clm/bld/README ------------- Update documentation after removing the + clm stand-alone build/run scripts. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------- Remove defaults + as in namelist_defaults files, apply suggestions from Keith/Sam + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Change rcp default to -999.9 + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ------- Put description above valid values + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- New datasets: + fsurdat: f10, 1850 + fpftdyn: f10, 1850-2000, 1850-2100 (rcp=8.5) + fpftdyn: f19, 1850-2100 (rcp=8.5) + faerdep: f19, 1850-2100 (rcp=8.5) + fndepdat: f19, decadal averages (rcp=2.6) + fndepdyn: f19, 1850-2100 (rcp=8.5 and rcp=4.5) +>>>>>>>>>>>>> Update documentation, add in documentation on changes added in here + M models/lnd/clm/doc/UsersGuide/index.xml -- Spellcheck, more work on doc, update + for changes that came in on this tag. + M models/lnd/clm/doc/index.shtml ----------- Correct test table. + +Summary of testing: + + bluefire: All PASS except... +009 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 10 +010 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +011 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +012 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 4 +013 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +.........FAIL! rc= 10 +017 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic +.........FAIL! rc= 7 + bluefire interactive testing: All PASS + bluefire/CCSM testing: All PASS, except.. +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_7_02 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_7_01 +FAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_7_01 +FAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_7_01 +FAIL ERS_D.f19_g16.I8521CNR85.bluefire +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.generate.clm3_7_02 +BFAIL ERS_D.f19_g16.I8521CNR85.bluefire.compare.clm3_7_01 + Special testing: +PASS ERS.f19_g16.I8521CNR85.bluefire + breeze,gale,hail,gust/ifort interactive testing: All PASS except... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_01 + +Changes answers relative to baseline: f10 because of new surface dataset + Other resolutions will be bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_01 +Originator(s): erik (Erik Kluzek) +Date: Fri Jan 29 12:58:12 MST 2010 +One-line Summary: OpenMP fix for pftdyn, start adding in rcp's, update ndeplintInterp.ncl script + +Purpose of changes: + +Changes to ndeplintInterp script to add the ability to generate ndepdyn datasets for future scenarios +2005+. Add rcp as input to build-namelist and add use-cases with different rcp's. Small bug-fixes to +mksurfdata. Add lists for 1850-2100 for the rcp's. Update drv and scripts to latest. Update documentation. +Fix from Mariana on OpenMP problem in pftdyn. Remove lightning from tests, start adding in +edinburgh. + +Bugs fixed (include bugzilla ID): + 1102 (OpenMP problem with pftdyn mode) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1104 (Restart problem with pftdyn mode) + 1118 (Restarts with SNICAR_FRC fail) + 1121 (history variable attribute cell_methods misnamed) + 1153 (Problem with ndeplintInterp for historical case) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, code-changes came from Mariana-Vertenstein, reviewed by Pat Worley + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, and datm + + scripts to scripts4_100125 + drv to drvseq3_1_13 + datm to datm8_100122 + +List all files eliminated: + + D models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt --> rename to pftdyn_hist_simyr1850-2005.txt + +List all files added and what they do: + +>>>>>>>>>>>>>>> List of surface datasets to create pftdyn files + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp2.6_simyr1850-2100.txt + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp4.5_simyr1850-2100.txt + A models/lnd/clm/tools/mksurfdata/pftdyn_rcp8.5_simyr1850-2100.txt +>>>>>>>>>>>>>>> Add use-cases for future scenarios + A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp8.5_transient.xml + A models/lnd/clm/bld/namelist_files/use_cases/1850-2100_rcp4.5_transient.xml + + A models/lnd/clm/tools/mksurfdata/pftdyn_hist_simyr1850-2005.txt --> renamed + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add edinburgh, remove lightning + M models/lnd/clm/test/system/test_driver.sh --------- Remove lightning, add edinburgh + M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh -- Delete csm_share/dshr directory no longer exists + M models/lnd/clm/test/system/CLM_runcmnd.sh --------- Remove lightning, add edinburgh + + M models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 -- Fix small compiler bug for jaguar + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn - Point to new name for historical pftdyn file + +>>>>>>>>>>>>>> Handle future scenarios for dynamic Nitrogen-Deposition file creation + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl -- Add ability to handle future scenario data, and also leave + previous historical data the same as before, or + +>>>>>>>>>>>>>> Start adding ability to handle future scenarios for different RCP's + M models/lnd/clm/bld/build-namelist ------------------------------- Add rcp, + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------- Add rcp, new sim_year, sim_year_range values, allow blank + for hist_type1d_pertape + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml - Add default for rcp as -999. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ----- Add new Nitrogen deposition decadal datasets for RCP4.5/RCP8.5 + + M models/lnd/clm/doc/UsersGuide/index.xml -- Add more in, add notes on namelist, tools, and special cases + +>>>>>>>>>>>> Changes from Mariana V. to fix bug 1102, OpenMP bug with pftdyn cases + M models/lnd/clm/src/main/clm_initializeMod.F90 - Don't pass decomp bounds down + M models/lnd/clm/src/main/pftdynMod.F90 --------- Get decomp bounds here + M models/lnd/clm/src/main/clm_driver.F90 -------- Call pftdyn_interp on own OMP loop + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +049 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +050 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +051 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +052 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + bluefire interactive testing: +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7022 +brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire special testing: + Run I8520 from Dec/1/1850 @f09_g16 for 14 months with 64 tasks and 4 threads and make sure identical + to same with 128 tasks and 1 thread (require openMP build) comparing clm history files. clm3_7_00 4-thread case for this fails. But, answers are identical with clm3_7_00 for 128 tasks and 1 thread. + jaguar: +020 blJ62 TBL.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 5 +026 erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................FAIL! rc= 4 +027 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar interactive testing: +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + jaguar/special testing: + Run I8520 from Dec/1/1850 @f09_g16 for 5 months with 416 tasks and 4 threads and make sure identical + to same with 1 thread (require openMP build) comparing clm history files. clm3_7_00 4-thread case for this fails. + jaguar/CCSM testing: +PASS ERS_D.f09_g16.I1850.jaguar +PASS PET.f10_f10.I8520CN.jaguar.cpl +PASS PET.f10_f10.I8520CN.jaguar.atm +PASS PET.f10_f10.I8520CN.jaguar.lnd +PASS PET.f10_f10.I8520CN.jaguar.ice +PASS PET.f10_f10.I8520CN.jaguar.ocn +PASS PET.f10_f10.I8520CN.jaguar.glc + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + dublin/ifort interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + edinburgh/pgi interactive testing: All PASS except... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_7_00 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_7_00 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jan 22 22:48:09 MST 2010 +One-line Summary: Update to datm8, redirect aquifer overflow to drainage, add gx3v7 + masks, script to extract regional datasets, add harvesting for CN, + modify shrubs, include urban model, ice stream for snowcapping, + new build-namelist system, scale solar by solar zenith angle in + datm, deep soil with bedrock at bottom, organic matter in soils, + SNICAR for snow radiation, sparce dense aero, snow cover changes + +Software engineering changes: + + Update to cpl7 and scripts. + Remove offline and cpl6 modes. + Remove support for CASA model. + Update to datm8 atmospheric data model. + Add gx3v7 land mask for T31 and fv-4x5 horizontal resolutions. + Add gx1v6 land mask for f05, f09, and f19 horigonzl resolutions. + Add tx1v1 land mask and 1.9x2.5_tx1v1 horizontal resolution. + Add in 2.5x3.33 horizontal resolution. + Add in T62 horizontal resolution so can run at same resolution as input datm data. + Allow first history tape to be 1D. + Add ability to use own version of input datasets with CLM_USRDAT_NAME variable. + Add a script to extract out regional datasets. + New build-namelist system with XML file describing all namelist items. + Add glacier_mec use-case and stub glacier model. + Add ncl script to time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. + Make default of maxpatch_pft=numpft+1 instead of 4. + Only output static 3D fields on first h0 history file to save space. + Add new fields for VOC (Volatile Organic Compounds) on some surface datasets, that will be + needed for the new MEGAN VOC model (NOT incorporated yet). + Add irrigation area to mksurfdata tool (NOT used in CLM yet). + Add multiple elevation class option for glaciers in mksurfdata tool (NOT used in CLM yet). + Add ascale field to land model in support of model running on it's own grid. + +Science changes: + + Change to freezing temperature constant + Forcing height at atm plus z0+d on each tile + Effective porosity divide by zero fix + Sparse/dense canopy aerodynamic parameters + Ground/snow emissivity smooth transition + Thermal and hydraulic properties of organic soil + Init h2osoi=0.3 + Snow compaction fix + Snow T profile during layer splitting fix + Snow burial fraction + Snow cover fraction + SNICAR (snow aging, black carbon and dust deposition, vertical distribution of solar energy) + Remove SNOWAGE, no longer used + Deep soil (15 layers, ~50m), 5 new layers are hydrologically inactive bed rock + Ground evap (beta), stability, and litter resistance + Organic/mineral soil hydraulic conductivity percolation theory + Richards equation modifications + Normalization of frozen fraction of soil formulation + One-step solution for soil moisture and qcharge + Changes to rsub_max for drainage and decay factor for surface runoff + Fixed diurnal cycle of solar radiation in offline forcing data + Back to CLM3 lakes and wetlands datasets, but 1% rather than 5% threshold (same for glacier) + Changes to pft physiology file from CN + New grass optical properties + New surface dataset assuming no herbaceous understory + Direct versus diffuse radiation offline + New VOC model (MEGAN) + Snow-capped runoff goes to new ice stream and routed to ocean as ice + Dust model always on, LAI threshold parameter change from 0.1 to 0.3 + Daylength control on vcmax + SAI and get_rad_dtime fix + Always run with MAXPATCH_PFT=npfts + 1 instead of 4 + Transient land cover/use mode - datasets, energy and water balance + RTM sub-cycling + Twostream bug fix + Update soil colors + 2m relative humidity + Fix for aquifer leak (SoilHydrologyMod, BalanceCheckMod) + New nitrogen deposition file (units and sum of NOx, NHy) + +Quickstart to new cpl7 scripts... + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) +Quickstart to use of regional extraction scripts and PERSONAL datasets: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 -skip_rundb + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + 1121 (history variable attribute cell_methods misnamed) + 1118 (Restarts with SNICAR_FRC fail) + +Describe any changes made to build system: + + Change directory structure to match CCSM. + Add BGP target. + Add choice between ESMF and MCT frameworks. + Start removing #ifdef and directives that supported Cray-X1 Phoenix as now decommisioned. + Make default of maxpatch_pft=numpft+1 instead of 4 for all configurations. + By default turn on CLAMP when either CN or CASA is enabled + New SNICAR_FRC, CARBON_AERO, and C13 CPP ifdef tokens. + + New options added to configure: + + -comp_intf Component interface to use (ESMF or MCT) (default MCT) + -nofire Turn off wildfires for bgc setting of CN (default includes fire for CN) + -pio Switch enables building with Parallel I/O library. [on | off] (default is on) + -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] (default is off) + +Describe any changes made to the namelist: + + NOTE: build-namelist now checks the validity of your namelist you generate by looking at data in the namelist_definition.xml + file. In order to add new namelist items you need to change the code and also edit this file. To view information + on the namelist view the file: + models/lnd/clm/bld/namelist_files/namelist_definition.xml + in your browser and you'll see the names, type, description and valid_values for all namelist variables. + + Changes to build-namelist: + Transient sim_year ranges (i.e. 1850-2000) + Remove cam_hist_case option. + Make sure options ONLY used for stand-alone testing have a "drv_" or "datm_" prefix in them and list these + options all together and last when asking for help from build-namelist. + New options to build-namelist: + -clm_usr_name "name" Dataset resolution/descriptor for personal datasets. Default: not used + Example: 1x1pt_boulderCO_c090722 to describe location, + number of pts, and date files created + New list options to build-namelist: + build-namelist -res list # List valid resolutions + build-namelist -mask list # List valid land-masks + build-namelist -sim_year list # List valid simulation years and simulation year ranges + build-namelist -clm_demand list # List namelist variables including those you could demand to be included. + build-namelist -use_case list # List valid use-cases + + New use-cases for: + + 1850_control = Conditions to simulate 1850 land-use + 2000_control = Conditions to simulate 2000 land-use +20thC_transient = Simulate transient land-use, and aerosol deposition changes from 1850 to 2005 + glacier_mec = Placeholder for running IG cases with the ice sheet model glimmer + + New namelist items: + + urban_hac = OFF, ON or ON_WASTEHEAT (default OFF) Flag for urban Heating and Air-Conditioning + OFF = Building internal temperature is un-regulated. + ON = Building internal temperature is bounded to reasonable range. + ON_WASTEHEAT = Building internal temperature is bounded and resultant waste + heat is given off. + urban_traffic = .true. or .false. (default .false.) Flag to include additional multiplicative factor of urban traffic + to sensible heat flux. + fsnowoptions = filename file for snow/aerosol optical properties (required) + fsnowaging = filename file for snow aging parameters (required) + faerdep = filename file of aerosol deposition (required) + + New history variables: (note watt vs. W in units, 26 vs. 76) + BCDEP total BC deposition (dry+wet) from atmosphere kg/m^2/s + C13_PRODUCT_CLOSS C13 total carbon loss from wood product pools gC13/m^2/s + DSTDEP total dust deposition (dry+wet) from atmosphere kg/m^2/s + EFLX_DYNBAL dynamic land cover change conversion energy flux W/m^2 + FGR12 heat flux between soil layers 1 and 2 watt/m^2 + FSAT fractional area with water table at surface unitless + FSH_NODYNLNDUSE sensible heat flux not including correction for land use change + watt/m^2 + GC_HEAT1 initial gridcell total heat content J/m^2 + GC_HEAT2 post land cover change total heat content J/m^2 inactive + GC_ICE1 initial gridcell total ice content mm/s + GC_ICE2 post land cover change total ice content mm/s inactive + GC_LIQ1 initial gridcell total liq content mm + GC_LIQ2 initial gridcell total liq content mm inactive <<<< name?? + H2OSNO_TOP mass of snow in top snow layer kg + HEAT_FROM_AC sensible heat flux put into canyon due to heat removed from air conditioning + watt/m^2 + HK hydraulic conductivity mm/s inactive + LWup upwelling longwave radiation watt/m^2 inactive + NBP net biome production, includes fire, landuse, and harvest flux, positive for sink + gC/m^2/s + OCDEP total OC deposition (dry+wet) from atmosphere kg/m^2/s + PBOT atmospheric pressure Pa + PCO2 atmospheric partial pressure of CO2 Pa + PRODUCT_CLOSS total carbon loss from wood product pools gC/m^2/s + PRODUCT_NLOSS total N loss from wood product pools gN/m^2/s + Qair atmospheric specific humidity kg/kg inactive + Qanth anthropogenic heat flux watt/m^2 inactive + Qtau momentum flux kg/m/s^2 + QFLX_LIQ_DYNBAL liq dynamic land cover change conversion runoff flux mm/s + QFLX_ICE_DYNBAL ice dynamic land cover change conversion runoff flux mm/s + QRUNOFF_NODYNLNDUSE total liquid runoff not including correction for land use change (does not include QSNWCPICE) + mm/s + QSNWCPICE excess snowfall due to snow capping mm/s + QSNWCPICE_NODYNLNDUSE excess snowfall due to snow capping not including correction for land use change + mm/s + QSNWCPLIQ excess rainfall due to snow capping mm/s inactive + SMP soil matric potential mm inactive + SNOAERFRC2L surface forcing of all aerosols in snow, averaged only when snow is present (land) + watt/m^2 + SNOAERFRCL surface forcing of all aerosols in snow (land) watt/m^2 + SNOBCFRCL surface forcing of BC in snow (land) watt/m^2 + SNOBCMCL mass of BC in snow column kg/m2 + SNOBCMSL mass of BC in top snow layer kg/m2 + SNOdTdzL top snow layer temperature gradient (land) K/m + SNODSTFRC2L surface forcing of dust in snow, averaged only when snow is present (land) + watt/m^2 + SNODSTFRCL surface forcing of dust in snow (land) watt/m^2 + SNODSTMCL mass of dust in snow column kg/m2 + SNODSTMSL mass of dust in top snow layer kg/m2 + SNOFSRND direct nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRNI diffuse nir reflected solar radiation from snow watt/m^2 inactive + SNOFSRVD direct vis reflected solar radiation from snow watt/m^2 inactive + SNOFSRVI diffuse vis reflected solar radiation from snow watt/m^2 inactive + SNOFSDSND direct nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSNI diffuse nir incident solar radiation on snow watt/m^2 inactive + SNOFSDSVD direct vis incident solar radiation on snow watt/m^2 inactive + SNOFSDSVI diffuse vis incident solar radiation on snow watt/m^2 inactive + SNOLIQFL top snow layer liquid water fraction (land) fraction inactive + SNOOCMCL mass of OC in snow column kg/m2 + SNOOCMSL mass of OC in top snow layer Kg/m2 + SNOOCFRC2L surface forcing of OC in snow, averaged only when snow is present (land) + SNOOCFRCL surface forcing of OC in snow (land) watt/m^2 + watt/m^2 + SNORDSL top snow layer effective grain radius m^-6 inactive + SNOTTOPL snow temperature (top layer) K/m inactive <<< units? + SWup upwelling shortwave radiation watt/m^2 inactive + URBAN_AC urban air conditioning flux watt/m^2 + URBAN_HEAT urban heating flux watt/m^2 + Wind atmospheric wind velocity magnitude m/s inactive + WOOD_HARVESTC wood harvest (to product pools) gC/m^2/s + WOOD_HARVESTN wood harvest (to product pools) gN/m^2/s + + History field name changes: + + ANNSUM_PLANT_NDEMAND => ANNSUM_POTENTIAL_GPP + ANNSUM_RETRANSN => ANNMAX_RETRANSN + C13_DWT_PROD10C_LOSS => C13_PROD10C_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + C13_DWT_PROD10N_LOSS => C13_PROD10N_LOSS + C13_DWT_PROD100C_LOSS => C13_PROD100C_LOSS + DWT_PROD100N_LOSS => PROD10N_LOSS + DWT_PROD100N_LOSS => PROD100N_LOSS + DWT_PROD100C_LOSS => PROD10C_LOSS + DWT_PROD100C_LOSS => PROD100C_LOSS + HCSOISNO => HC + TEMPSUM_PLANT_NDEMAND => TEMPSUM_POTENTIAL_GPP + TEMPSUM_RETRANSN => TEMPMAX_RETRANSN + + History field names deleted: + SNOWAGE, TSNOW, FMICR, FCO2, DMI, QFLX_SNOWCAP + + Add new urban oriented _U, and _R (Urban and Rural) for: + EFLX_LH_TOT, FGR, FIRA, FSH, FSM, Q2M, QRUNOFF, RH2M, SoilAlpha, TG, TREFMNAV, TREFMXAV, and TSA + (missing _R for SoilAlpha) + +Describe timing and memory performance: + +Versions of any externally defined libraries: + + scripts scripts4_100108b + drv vocemis-drydep12_drvseq3_1_11 + datm datm8_091218 + socn stubs1_2_02/socn + sice stubs1_2_02/sice + sglc stubs1_2_02/sglc + csm_share vocemis-drydep13_share3_091217 + esmf_wrf_timemgr esmf_wrf_timemgr_090402 + timing timing_090929 + mct MCT2_7_0_100106 + pio pio60_prod + cprnc cprnc_081022 + +Summary of testing: + bluefire: All PASS up to...017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............PASS + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +PASS ERH.f09_g16.B20TRCN.bluefire +BFAIL ERH.f09_g16.B20TRCN.bluefire.compare.ccsm4_0_beta38 --- compset names changed -- but cpl.log files compare exactly +! +> ../Tools/check_exactrestart.pl cpl.log.100109-171753 $FISHOME/ccsm4_0_beta38/scripts/ERH.f09_g16.B20TRTR1CN.bluefire.G +.172652/logs/cpl.log.100108-181015 +log files match! +PASS +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<< Failed before bug 1063 +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: None PASS because of bug 1092 + dublin/lf95: None PASS because of bug 1092 + dublin/INTEL interactive testing: ALL PASS except (and didn't compare to baseline) +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +028 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/INTEL: All PASS up to 021 smJ92 TSM.sh (and didn't compare to baseline) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + +=============================================================== +=============================================================== +Tag name: clm3_6_64 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jan 22 22:19:24 MST 2010 +One-line Summary: Update documentation and README/Quickstart files, set NetCDF large-file format on by default in template, update pio, update some fsurdat files to vocemis-drydep versions, add 2.5x3.33_gx3v7 frac file, make gx3v7 default for 4x5 res + +Purpose of changes: + +Setup makefiles for docbook UsersGuide to output both pdf and html formats. Work on documentation of new _esmf driver files. Work on documentation. Make sure documentation of clm xml variables is good. Add note about CASA NOT being supported. Work on README/Quickstart files, and move the files from the top level to clm doc directory, but leave a file at top level pointing to these files. Make large file support default, remove LND_CDF64. Add in VOC surfdata files from voc branch: T42, T31, T21, T5, 4x5, 10x15-pftdyn. Add in new 2x5x3.33_gx3v7 frac file. Make default mask for 4x5 gx3v7. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Turn NetCDF large-file support on by default + +List any changes to the defaults for the boundary datasets: + + New fsurdat files for: T42, T31, T21, T5, 4x5 + New fpftdyn file for 10x15 for 1850-2000, new frac file for 2.5x3.33_gx3v7 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): pio + + pio updated to google version: http://parallelio.googlecode.com/svn/trunk_tags/pio1_0_7/pio + +List all files eliminated: + + D Quickstart.userdatasets --- Move to models/lnd/clm/doc + D Quickstart.GUIDE ---------- Move to models/lnd/clm/doc + D README.DGVM --------------- Move to models/lnd/clm/doc + D KnownBugs ----------------- Move to models/lnd/clm/doc + D models/lnd/clm/doc/docs.html ----------------- Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/clm_head.shtml - Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/tree.html ------ Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/clm_foot.shtml - Remove in favor of DocBook documentation + D models/lnd/clm/doc/UsersGuide/index.shtml ---- Remove in favor of DocBook documentation + +List all files added and what they do: + + A models/lnd/clm/doc/Quickstart.userdatasets - Move from top level + A models/lnd/clm/doc/IMPORTANT_NOTES --------- Add important notes about what's scientifically valided/expected to work + A models/lnd/clm/doc/Quickstart.GUIDE -------- Move from top level + A models/lnd/clm/doc/KnownBugs --------------- Move from top level + A models/lnd/clm/doc/UsersGuide/Makefile ----- Makefile to build Users-Guide + A models/lnd/clm/doc/index.shtml ------------- Add HTML guide to documentation + A models/lnd/clm/doc/CodeReference/Filepath -- Filepath to source-code to build Code Reference Guide + A models/lnd/clm/doc/CodeReference/Makefile -- Makefile to build Code Reference Guide using Protex + + A models/lnd/clm/test/system/Makefile -------- Makefile to build HTML test table + + A models/lnd/clm/test/system/config_files/_nrsc_do --- Add smp only option for no-RTM seq-ccsm default mode + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/bld/clm.cpl7.template -------------------------- Set large_file_format to true by default + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Add in vocemis-drydep branch fsurdat files for: T42, T31, T21, T5, + and 4x5 resolution (as well as 10x15 1850-2005 pftdyn file) + Add in 2.5x3.33_gx3v7 frac file, and make gx3v7 mask the default + for 4x5 resolution. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml -- 2.5x3.33_gx3v7 domain file +>>>>>>>>>>>>> Update documentation and README text files + M models/lnd/clm/test/system/README + M models/lnd/clm/tools/mksurfdata/README + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ------------------ Make namelist documentation a little more clea + M models/lnd/clm/tools/ncl_scripts/convertUrbanOffline2Seq.ncl -- Document datm as datm8 + M models/lnd/clm/tools/ncl_scripts/README + M models/lnd/clm/tools/interpinic/README + M models/lnd/clm/tools/mkdatadomain/README + M models/lnd/clm/tools/README + M models/lnd/clm/bld/README + M models/lnd/clm/doc/UsersGuide/index.xml ---- Update docbook UsersGuide + M models/lnd/clm/doc/README + M README + + M models/lnd/clm/test/system/tests_pretag_bluefire ----------- Remove LD1 (2.65x3.33 res) tests + M models/lnd/clm/test/system/tests_posttag_hybrid_regression - Remove LD1 tests + M models/lnd/clm/test/system/input_tests_master -------------- Remove LD1 tests + +Summary of testing: + + bluefire: All PASS except... +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 << 4x5 fsurdat +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 << 4x5 fsurdat +012 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 << 4x5 fsurdat +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 << 4x5 fsurdat +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 << 10x15 fpftdyn different +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +043 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 5 + bluefire interactive testing: All PASS except... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 << 4x5 fsurdat +040 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 5 << no _nrsc_do in previous +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 << script error +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 << script error +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 3 << script error +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 3 + bluefire/CCSM testing: All PASS except... +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different than previous version +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +FAIL ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 <<<<<<<< 4x5 surfdata file different +FAIL ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<<<< 4x5 surfdata file different +FAIL PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 <<<<<<<<<<< 4x5 surfdata file different +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<<<< Previous failure +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.generate.clm3_6_64 <<<<<<<< Previous failure +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 <<< Previous failure +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_6_58+datm8 <<<<<<< 10x15 pftdyn file different +BFAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_6_58+datm8 <<<<<<<<< 10x15 pftdyn file different + +CLM tag used for the baseline comparison tests if applicable: clm3_6_63 + +Changes answers relative to baseline: Only for the following resolutions because of new fsurdat files: T42, T31, T5, 4x5 + and for dynamic PFT at 10x15 resolution because of a new pftdyn file + +=============================================================== +=============================================================== +Tag name: clm3_6_63 +Originator(s): erik (erik) +Date: Sat Jan 9 20:37:53 MST 2010 +One-line Summary: Get answers to be identical with ccsm4_0_beta38 for 1 and 2 degree transient cases + +Purpose of changes: + +Get answers to be identical to ccsm4_0_beta38 for both 1 and 2 degree transient cases. Update scripts to +very latest. Tweak test_suite for CN so that can run with finidat file, and can run interactive on dublin +by turning CCSM_BLD to off. + +Bugs fixed (include bugzilla ID): + 1098 (Use finidat weights instead of weights from fpftdyn file) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + +List all files eliminated: None + +List all files added and what they do: + +>>>>>> Add configuration files for CN with default of numpft+1 maxpft +A models/lnd/clm/test/system/config_files/_cnnsc_h +A models/lnd/clm/test/system/config_files/_cnnsc_m +A models/lnd/clm/test/system/config_files/_cnnsc_o +A models/lnd/clm/test/system/config_files/_cnnsc_dh +A models/lnd/clm/test/system/config_files/_cnnsc_dm +A models/lnd/clm/test/system/config_files/_cnnsc_do +A models/lnd/clm/test/system/config_files/_cnnsc_ds + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Tweak test suite so can test for a CN transient case with a startup file, needed to find bug +M models/lnd/clm/test/system/test_driver.sh ------------ Turn CCSM_BLD to off for interactive use +M models/lnd/clm/test/system/input_tests_master -------- Tweak CN tests so can use finidat file +>>>>>>>>>>>>>>> Get answers to be identical with ccsm4_0_beta38 +M models/lnd/clm/src/main/clm_initializeMod.F90 -------- add extra call to pftdyn_interp after restart +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 -- Read weights directly into clm_type rather than + a temporary array. + +Summary of testing: + + bluefire: All PASS up to... +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............PASS + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: +PASS ERH.f09_g16.B20TRCN.bluefire +BFAIL ERH.f09_g16.B20TRCN.bluefire.compare.ccsm4_0_beta38 --- compset names changed -- but cpl.log files compare exactly! +> ../Tools/check_exactrestart.pl cpl.log.100109-171753 $FISHOME/ccsm4_0_beta38/scripts/ERH.f09_g16.B20TRTR1CN.bluefire.G.172652/logs/cpl.log.100108-181015 +log files match! +PASS +PASS SMS_RLA.f45_f45.I.bluefire +BFAIL SMS_RLA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS SMS_RLB.f45_f45.I.bluefire +BFAIL SMS_RLB.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS SMS_ROA.f45_f45.I.bluefire +BFAIL SMS_ROA.f45_f45.I.bluefire.compare.clm3_6_58+datm8 <<< f45_f45 NOT allowed in baseline +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<<<<<<<<<<<<<<<<<<<<<<< Failed before bug 1063 +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 +PASS ERH_D.f10_f10.I1850CN.bluefire +BFAIL ERH_D.f10_f10.I1850CN.bluefire.compare.clm3_6_58+datm8 <<< f10_f10 NOT allowed in baseline +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc +BFAIL PET.f10_f10.I8520CN.bluefire.compare.clm3_6_58+datm8 <<< f10_f10 NOT allowed in baseline + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: None PASS because of bug 1092 + dublin/lf95: None PASS because of bug 1092 + dublin/INTEL interactive testing: ALL PASS except (and didn't compare to baseline) +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +028 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/INTEL: All PASS up to 021 smJ92 TSM.sh (and didn't compare to baseline) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58+datm8 + +Changes answers relative to baseline: No bit-for-bit -- really now! + +=============================================================== +=============================================================== +Tag name: clm3_6_62 +Originator(s): erik (erik) +Date: Fri Jan 8 04:50:59 MST 2010 +One-line Summary: Fix startup of PFT transient cases so properly use data from pftdyn file rather than finidat file + +Purpose of changes: + +Attempt to fix bug 1098 so that properly use the PFT weights interpolated from the fpftdyn file rather than using the +weights from the input finidat file. + +Bugs fixed (include bugzilla ID): Attempt to fix -- but only a partial fix, answers were still different + 1098 (Use finidat weights instead of weights from fpftdyn file) + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts and mct + + scripts to scripts4_100107b + mct to MCT2_7_0_100106 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --- Fix bug with fpftdyn weights + M models/lnd/clm/test/system/test_driver.sh ------------- Fix name of ifort Macros file + +Summary of testing: + + bluefire: All PASS except, up to 045 erLD1 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + bluefire interactive testing: All PASS up to.. +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except CN spinup as below +PASS ERS.f09_g16.I8520CN.bluefire +PASS ERS.f09_g16.I8520CN.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f09_g16.I8520CN.bluefire.compare.clm3_6_58+datm8 +PASS SMS_RLA.f45_g37.I.bluefire +PASS SMS_RLA.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_RLA.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS SMS_RLB.f45_g37.I.bluefire +PASS SMS_RLB.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_RLB.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS SMS_ROA.f45_g37.I.bluefire +PASS SMS_ROA.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS SMS_ROA.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire +PASS ERS_D.f45_g37.I.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS_D.f45_g37.I.bluefire.compare.clm3_6_58+datm8 +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS PET.f45_g37.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire +PASS ERS.f19_g16.I1850.bluefire.compare_hist.clm3_6_58+datm8 +PASS ERS.f19_g16.I1850.bluefire.compare.clm3_6_58+datm8 +PASS ERB.f09_g16.I_1948-2004.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire.compare.clm3_6_58+datm8 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +BFAIL ERB.f09_g16.I1850SPINUPCN.bluefire.compare.clm3_6_58+datm8 +PASS ERH_D.f09_g16.I1850CN.bluefire +PASS ERH_D.f09_g16.I1850CN.bluefire.compare.clm3_6_58+datm8 +PASS PET.f19_g16.I8520CN.bluefire.cpl +PASS PET.f19_g16.I8520CN.bluefire.atm + jaguar: All PASS up to 021 smJ05 + jaguar interactive testing: All FAIL except... +001 smA74 TSM.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........PASS +002 erA74 TER.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic ........PASS +003 brA74 TBR.sh _nrsc_ds clm_std^nl_urb_br 20030101:NONE:1800 1x1_brazil navy -5+-5 arb_ic .....PASS +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........PASS +005 smAK4 TSM.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............PASS +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............PASS + dublin/lf95: None pass because of bug 1092 + dublin/pgi: All PASS except... +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 + dublin/ifort interactive: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58+datm8 (ccsm4_0_beta38) + +Changes answers relative to baseline: Identical without fpftdyn files + with and without finidat files. But, can be + different to roundoff or more for transient cases. + +=============================================================== +=============================================================== +Tag name: clm3_6_61 +Originator(s): erik (erik) +Date: Thu Jan 7 00:55:20 MST 2010 +One-line Summary: Comment out endrun on finidat and fsurdat weights being incomptable, and go back to using finidat weights + +Purpose of changes: + +Most of our finidat files have weights incompatible with our new fsurdat files. Hence, we went back to allowing +the weights to be different and to using the finidat weights so that answers would be the same as before. +Also hardwire the logfile for datm and clm so that can run testsuite on jaguar. Also add in cppdef required +for breeze. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1098 (Use finidat weights instead of weights from fpftdyn file) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to scripts4_100107 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_driver.sh -------------------- Add -cppdefs '-DFORTRANUNDERSCORE' for breeze. + M models/lnd/clm/bld/build-namelist ---------------------------- For standalone testing hardwire clm and + datm output log files + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - Add comment remove logfile + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 ---------- Put implicit none in right place, comment + out abort if weights too different, and use finidat weights instead of fsurdat weights. Hence + this version is identical to clm3_6_58, other than the use of datm8 (which is roundoff different). + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + bluefire/CCSM testing: +PEND SMS_RLA.f45_f45.I.bluefire.200614 +PEND SMS_RLB.f45_f45.I.bluefire.200614 +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g37.I.bluefire +PASS PET.f45_g37.I1850.bluefire.cpl +PASS PET.f45_g37.I1850.bluefire.atm +PASS PET.f45_g37.I1850.bluefire.lnd +PASS PET.f45_g37.I1850.bluefire.ice +PASS PET.f45_g37.I1850.bluefire.ocn +PASS PET.f45_g37.I1850.bluefire.glc +PASS ERS.f19_g16.I1850.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I1850CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd +PASS PET.f10_f10.I8520CN.bluefire.ice +PASS PET.f10_f10.I8520CN.bluefire.ocn +PASS PET.f10_f10.I8520CN.bluefire.glc + jaguar interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +008 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 5 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smJ74 TSM.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic FAIL! rc= 8 +014 erJ74 TER.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_nrcasasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_icFAIL! rc= 5 +016 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 4 + dublin/lf95: All Fail due to bug 1092 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58 (but with datm8 rather than datm7) + +Changes answers relative to baseline: No bit-for-bit except for transient cases which are different + +=============================================================== +=============================================================== +Tag name: clm3_6_60 +Originator(s): erik (erik) +Date: Tue Jan 5 23:59:43 MST 2010 +One-line Summary: Fix clm template + +Purpose of changes: + +Fix the broken clm template. Update externals for very latest scripts tag. + +Bugs fixed (include bugzilla ID): Fix clm template which was broken + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): Update scripts + + scripts to scripts4_100105b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_driver.sh -- update bl to ccsm4_0_beta38 +M models/lnd/clm/bld/clm.cpl7.template ------- fix so can work + +Summary of testing: + + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +FAIL ERS.f19_g16.I_1850.bluefire +FAIL ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948-2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.I8520CN.bluefire.cpl +PASS PET.f10_f10.I8520CN.bluefire.atm +PASS PET.f10_f10.I8520CN.bluefire.lnd + +CLM tag used for the baseline comparison tests if applicable: clm3_6_59 + +Changes answers relative to baseline: no bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_59 +Originator(s): erik (erik) +Date: Tue Jan 5 17:44:48 MST 2010 +One-line Summary: Update to datm8, fix so wts used are from fsurdat file NOT finidat file + +Purpose of changes: + +Changes needed for beta34 ESMF upgrade. Use new datm8 model which is more flexible and +has new options as well as parallel IO. Add in 4x5_gx3v7 frac file. Remove use for +ESMF_mod. Abort if finidat weights are significantly different from surfdata file +weights. Change name of driver and initializeMod to have a clm_ prefix. Convert UG +outline from html to DocBook. Make changes to code documentation for high level +subroutines. Remove documentation of namelist items in controlMod and have it point +to the documentation in the xml namelist file. Fix "called from" in code documentation +and remove a lot of the concurrent directives. New files from Tony for esmf interface. +Alpha release testing will start with this version. + +Bugs fixed (include bugzilla ID): + 1084 (don't use only for ESMF_Mod) + 1087 (let weights come from fsurdat file NOT finidat) + 1088 (change name of driver module) + 1093 (namelist tweaks) -- partial + +Known bugs (include bugzilla ID): + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1092 (Problems running in debug mode on dublin with datm8) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Let CCSM build determine FORTRAN mangle definitions + Directory structure changes slightly with new ESMF interfaces and new datm8 + +Describe any changes made to the namelist: + Make default for hist_crtinic NONE so clm.i files are NOT made by default. + Change names of options to build-namelist that only are for clm stand-alone testing. + Add a drv_ or datm_ prefix, and separate how these options are displayed in the help + Also add an option to several commands for "list" so that you can list the variables + for clm_demand, for resolution, and for use-cases. + Also update build-namelist to work with the new datm8 + +List any changes to the defaults for the boundary datasets: Add in 4x5_gx3v7 dataset + +Describe any substantial timing or memory changes: datm8 is approx. 30% faster + datm8 also allows you to enable parallel I/O + +Code reviewed by: self, oleson, slevis, dlawren review of weights change + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, csm_share, drv, pio + ++scripts to scripts4_100103b ++drv to vocemis-drydep12_drvseq3_1_11 ++datm to datm8_091218 ++csm_share to vocemis-drydep13_share3_091217 ++pio to pio60_prod + +List all files eliminated: + + D models/lnd/clm/test/system/config_files/_mexsc_ds --- Rename with nr in name + D models/lnd/clm/test/system/config_files/_vansc_ds --- Rename with nr in name + D models/lnd/clm/src/main/driver.F90 ------------------ Rename with clm_ prefix + D models/lnd/clm/src/main/initializeMod.F90 ----------- Rename with clm_ prefix + D models/lnd/clm/src/biogeophys/DriverInitMod.F90 ----- Rename to clm_driverInitMod + +List all files added and what they do: + + A models/lnd/clm/doc/UsersGuide/index.xml ---------------- Users Guide Outline in docbook format +>>>>>>>>>>> Version with "nr" so that RTM is turned off for non-global tests + A models/lnd/clm/test/system/config_files/_nrsc_s + A models/lnd/clm/test/system/config_files/17p_nrsc_ds + A models/lnd/clm/test/system/config_files/4p_nrcasasc_ds + A models/lnd/clm/test/system/config_files/_nrsc_ds + A models/lnd/clm/test/system/config_files/_nrmexsc_ds + A models/lnd/clm/test/system/config_files/_nrvansc_ds + A models/lnd/clm/test/system/config_files/17p_nrcnnsc_ds +>>>>>>>>>>> New files from Tony for ESMF interfaces + A models/lnd/clm/src/main/cpl_esmf/lnd_comp_esmf.F90 + A models/lnd/clm/src/main/cpl_esmf/lnd_comp_mct.F90 + + A models/lnd/clm/src/main/clm_initializeMod.F90 ---------- Rename with clm_ prefix + Also change so that dyn pft is always called before reading in the restart + file. + A models/lnd/clm/src/main/clm_driver.F90 ----------------- Rename with clm_ prefix + A models/lnd/clm/src/biogeophys/clm_driverInitMod.F90 ---- Rename from driverInitMod + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/config_files/README -- Note about nr means no-RTM + M models/lnd/clm/test/system/test_driver.sh ------- Some tweaks for dublin/intrepid + M models/lnd/clm/test/system/mknamelist ----------- Changes for datm namelists, and + change for new options names for + build-namelist + M models/lnd/clm/test/system/nl_files/clm_per ----- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_std ----- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_pftdyn -- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_per0 ---- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_spin ---- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/nl_files/clm_urb1pt -- Change case and source to + drv_case and datm_source + M models/lnd/clm/test/system/input_tests_master --- Use nr in test names + M models/lnd/clm/test/system/CLM_runcmnd.sh ------- Change name for laptop + M models/lnd/clm/test/system/TSM.sh --------------- Change datm restart files + + M models/lnd/clm/bld/clm.cpl7.template ------------ Change template to not put RTM + time-step in when rtm is off + M models/lnd/clm/bld/configure -------------------- Change to new datm dir structure + M models/lnd/clm/bld/listDefaultNamelist.pl ------- Change name of datm namelist + M models/lnd/clm/bld/build-namelist --------------- New list options, update for + new datm8 namelist. + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Document pio options + new datm8 namelist items, CASA nameist items, and fget_archdev + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- New 4x5_gx3v7 frac file + set default of hist_crtinic to NONE + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml - New datm8 defaults + M models/lnd/clm/bld/namelist_files/namelist_definition.xsl ---- Add section for + CASA nl items, and a commented out section for the pio items + + M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 ---- Fix called from, rm concurrnt directives + M models/lnd/clm/src/biogeochem/CASAPhenologyMod.F90 ------ Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNGapMortalityMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 --- Fix called from + M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CASAMod.F90 --------------- Doc routine as private, fix called from, rm con dirct. + M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 ---------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/DGVMMod.F90 --------------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 -- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 --------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 ---------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 --------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 -- Fix called from, rm con dirt. + + M models/lnd/clm/src/main/clm_comp.F90 ------------- Add clm_ prefix to calls + M models/lnd/clm/src/main/pftdynMod.F90 ------------ Fix called from, rm con dirt. + M models/lnd/clm/src/main/histFileMod.F90 ---------- Add more documentation, rm con direct. + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------- Change documentation of units for nee + M models/lnd/clm/src/main/restFileMod.F90 ---------- Change called from documentation + M models/lnd/clm/src/main/controlMod.F90 ----------- Remove namelist items documentation + point to xml files for documenation + Work with code documentation + Get rid of notes about aerdep + files going away + M models/lnd/clm/src/main/clm_time_manager.F90 ----- Fix called from doc + M models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Add documentation + M models/lnd/clm/src/main/domainMod.F90 ------------ Clarify which driver in doc + M models/lnd/clm/src/main/clmtype.F90 -------------- Work on code documentation + M models/lnd/clm/src/main/histFldsMod.F90 ---------- Work on code documentation and formatting + + M models/lnd/clm/src/riverroute/RtmMod.F90 - Fix called from + + M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ Remove KO and fix called from in code doc, rm con dirct. + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- Fix called from, rm con dirt. + M models/lnd/clm/src/biogeophys/SNICARMod.F90 ------------ Fix called from. + + M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 - Check that weights when read + in agree reasonably closely with fsurdat weights + +Summary of testing: + + bluefire: +004 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 7 +007 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 +012 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 7 +017 blF92 TBL.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +021 blEH1 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 7 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +028 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 13 +029 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 11 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 7 +034 blC61 TBL.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 48 cold .................FAIL! rc= 7 +038 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 7 +043 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 7 +049 blJ61 TBL.sh 4p_casasc_dh clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 7 +050 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 3 +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 3 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 3 + bluefire interactive testing: +004 blA74 TBL.sh _nrsc_ds clm_std^nl_urb 20030101:NONE:1800 1x1_brazil navy -10 arb_ic ..........FAIL! rc= 5 +009 blCA4 TBL.sh _nrsc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ........FAIL! rc= 5 +013 blNB4 TBL.sh _nrmexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blJ74 TBL.sh 4p_nrcasasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic FAIL! rc= 5 +019 blCA8 TBL.sh _nrsc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic .FAIL! rc= 5 +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +023 blAK4 TBL.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -10 cold ............FAIL! rc= 7 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ......FAIL! rc= 6 +028 blL78 TBL.sh _nrsc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic ...........FAIL! rc= 5 +032 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 7 +033 smL83 TSM.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 4 +034 erL83 TER.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ........FAIL! rc= 5 +035 brL83 TBR.sh _nrsc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic ...FAIL! rc= 5 +036 blL83 TBL.sh _nrsc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ..........FAIL! rc= 4 +041 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +043 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 +045 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +050 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/lf95: No testing as all tests fail due to bug 1092 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_58 + +Changes answers relative to baseline: datm8 causes answers to be roundoff different + Change to use of fsurdat instead of finidat weights means answers may change + for non-coldstart cases. + +=============================================================== +=============================================================== +Tag name: clm3_6_58 +Originator(s): erik (erik) +Date: Tue Dec 8 12:56:47 MST 2009 +One-line Summary: Fix rpointer, correct units for export of nee, start adding testing for intrepid + +Purpose of changes: + Only update the rpointer file when restart files are written NOT when clm.i initial + files are written. This was causing problems to restart the model when it was + aborting before it completed it's period to run for. + Correct the units for the export of NEE from kg C to kg CO2 (kgCO2/m2/s) + Remove some concurent directives in the code and the unicosmp target_os in + configure as we no longer have Phoenix. + Add bgp target_os to configure, only set Fortran mangling if NOT using the + CCSM build in configure. + Add CN atm spinup data source as option to configure and to test_driver.sh. + Update version of external to test with to ccsm4_0_beta35 + Add ability to test on intrepid to test_driver.sh. + +Bugs fixed (include bugzilla ID): + 1079 (rpointer file updated with clm.i files) + 1082 (Add bgp, don't do Fortran mangling for CCSM build) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1070 (pftdyn datasets bad for f19, 2.5x3.33) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Have configure write out unresolved filepaths + when called from cpl7.template + +Describe any changes made to the namelist: drv namelist updated + +List any changes to the defaults for the boundary datasets: + Add 2.5x3.33 resolution + Remove 2x2.5 res files + New f09, f19 finidat files + New f09, f19, f10, 1x1_tropicAtl fsurdat/fpftdyn files (only f19 change answers) + New f05, 5x5_amazon, 1x1_brazil 2000 fsurdat file (b4b) + New f03, f09, f19, f03, f10 ndepdyn files (changes 1851-1924, 1996-2004) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): to ccsm4_0_beta33 versions + + scripts to scripts4_091027b + drv to vocemis-drydep12_drvseq3_0_37 + datm7 to datm7_090928 + socn/sice/sglc to stubs1_2_02 + csm_share to share3_091013 + timing to timing_090929 + mct to MCT2_6_0_090926 + pio to pio57_prod + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Quickstart.userdatasets --- Update notes about setting user-defined datasets +>>>>>>>>>>>>>>> Update jaguar, kraken, and bluefire env vars to latest scripts +>>>>>>>>>>>>>>> Remove blAK8 test as ocean-only and no clm files to compare + M models/lnd/clm/test/system/README.testnames ---------------- Add 2.5x3.33 test resolution + M models/lnd/clm/test/system/tests_driver.sh ----------------- Update env vars + to whats in scripts4_091015 for jaguar, kraken and bluefire + M models/lnd/clm/test/system/tests_pretag_bluefire_nompi ----- Rm blAK8 + M models/lnd/clm/test/system/input_tests_master -------------- Rm blAK8, add 1x1_tropicAtl@1850,1850-2000, and 2.5x3.33 tests + M models/lnd/clm/test/system/tests_posttag_nompi_regression -- Rm blAK8 + +>>>>>>>>>>>>>>> Allow configure to write out unresolved Filepath, make TopCCSMBld +>>>>>>>>>>>>>>> Makefile closer to CPL7 version + M models/lnd/clm/bld/configure -------------------------- Add clm_root option + add ability to set comp_intf to cpl_$COMP, allow ability to check for + directories existance resolving env vars that are set. Create a subroutine + is_valid_directory to check for directories instead of "-d". + M models/lnd/clm/bld/config_files/config_definition.xml - Allow cpl_$COMP rm lapacklibdir + M models/lnd/clm/bld/clm.cpl7.template -- Set COMP based on COMP_INTERFACE, + add clm_root to configure, don't resolve CODEROOT and CASEROOT on output + M models/lnd/clm/bld/config_files/TopCCSMBldMakefile.in - Changes to make closer to scripts4_091015 version. +>>>>>>>>>>>>>>> Change drv namelist names, + M models/lnd/clm/bld/build-namelist ----- Change drv namelist names: cpl_io_numtasks/cpl_io_typename +>>>>>>>>>>>>>>> Change drv namelist names, add 2.5x3.33 resolution +>>>>>>>>>>>>>>> Remove 2x2.5 res files +>>>>>>>>>>>>>>> New f09, f19 finidat files +>>>>>>>>>>>>>>> New f09, f19, f10, 1x1_tropicAtl fsurdat/fpftdyn files (only f19 change answers) +>>>>>>>>>>>>>>> New f05, 5x5_amazon, 1x1_brazil 2000 fsurdat file (b4b) +>>>>>>>>>>>>>>> New f03, f09, f19, f03, f10 ndepdyn files (changes 1851-1924, 1996-2004) + M models/lnd/clm/bld/namelist_files/namelist_definition.xml -----Change drv namelist + names: cpl_io_numtasks/cpl_io_typename, add 2.5x3.33 resolution + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml -- Add 2.5x3.33 res domainfile + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- New f19, f09 finidat files + new f09, f19, f10 fsurdat/fpftdyn files + new 2.5x3.33: fatmgrid, flndtopo, fatmtopo, fatmlndfrc, faerdep, fndepdat files + new f05, 5x5_amazon, 1x1_brazil 2000 fsurdat files + new f03, f09, f19, f03, f10 ndepdyn files + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml --- Change drv namelist + names: cpl_io_numtasks/cpl_io_typename + + M models/lnd/clm/src/main/histFldsMod.F90 -- GC_HEAT2, GC_LIQ2, GC_ICE2 NOT on by default +>>>>>>>>>>>>>>> Remove dips in 20th Century transient Nitrogen deposition +>>>>>>>>>>>>>>> for 1855 and 2000. + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl --- Remove 1855-1915 and 2000 + from list of input files. The 1850 dataset had too high of CO2 and hence + to high Nitrogen deposition, which gives a unrealistic dip near the + beginning. + +>>>>>>>>>>>>>>> Documentation changes of ProTex comments to fit the ProTex standard +M tools/mksurfdata/mkglcmec.F90 +M tools/mksurfdata/mkfmax.F90 +M tools/mksurfdata/ncdio.F90 +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkglacier.F90 +M tools/mksurfdata/mkharvestMod.F90 +M tools/mksurfdata/creategridMod.F90 +M tools/mksurfdata/mkorganic.F90 +M tools/mksurfdata/mklanwat.F90 +M tools/mksurfdata/mksoicol.F90 +M tools/mksurfdata/mkrank.F90 +M tools/mksurfdata/mkelev.F90 +M tools/mksurfdata/mkurban.F90 +M tools/mksurfdata/mkurbanparMod.F90 +M tools/mksurfdata/mksoitex.F90 +M tools/mksurfdata/mkirrig.F90 +M tools/mksurfdata/domainMod.F90 +M tools/mksurfdata/areaMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/mkpftMod.F90 +M tools/mkgriddata/mkgriddata.F90 +M tools/mkgriddata/creategridMod.F90 +M tools/mkdatadomain/create_domain.F90 +M src/biogeochem/DGVMLightMod.F90 +M src/biogeochem/DGVMReproductionMod.F90 +M src/biogeochem/DGVMAllocationMod.F90 +M src/biogeochem/DGVMEcosystemDynMod.F90 +M src/biogeochem/CASAMod.F90 +M src/biogeochem/DGVMKillMod.F90 +M src/biogeochem/DUSTMod.F90 +M src/biogeochem/DGVMEstablishmentMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMRestMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/biogeochem/CNrestMod.F90 +M src/biogeochem/VOCEmissionMod.F90 +M src/biogeochem/DGVMMortalityMod.F90 +M src/biogeochem/DGVMTurnoverMod.F90 +M src/biogeochem/DGVMFireMod.F90 +M src/biogeochem/CNEcosystemDynMod.F90 +M src/main/inicFileMod.F90 +M src/main/organicFileMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/clm_varpar.F90 +M src/main/CNiniTimeVar.F90 +M src/main/dynlandMod.F90 +M src/main/accumulMod.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/decompInitMod.F90 +M src/main/ncdio.F90 +M src/main/getdatetime.F90 +M src/main/subgridRestMod.F90 +M src/main/accFldsMod.F90 +M src/main/subgridMod.F90 +M src/main/fileutils.F90 +M src/main/aerdepMod.F90 +M src/main/initializeMod.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/pft2colMod.F90 +M src/main/clm_atmlnd.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/initSurfAlbMod.F90 +M src/main/clm_time_manager.F90 +M src/main/cpl_mct/lnd_comp_mct.F90 +M src/main/ndepFileMod.F90 +M src/main/subgridAveMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/CASAiniTimeVarMod.F90 +M src/main/CNiniSpecial.F90 +M src/main/pftvarcon.F90 +M src/main/snowdp2lev.F90 +M src/main/spmdMod.F90 +M src/main/surfrdMod.F90 +M src/main/domainMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/iobinary.F90 +M src/main/do_close_dispose.F90 +M src/main/mkarbinitMod.F90 +M src/riverroute/RtmMod.F90 +M src/riverroute/RunoffMod.F90 +M src/biogeophys/BalanceCheckMod.F90 +M src/biogeophys/SurfaceRadiationMod.F90 +M src/biogeophys/SoilTemperatureMod.F90 +M src/biogeophys/SnowHydrologyMod.F90 +M src/biogeophys/UrbanInputMod.F90 +M src/biogeophys/Biogeophysics1Mod.F90 +M src/biogeophys/Biogeophysics2Mod.F90 +M src/biogeophys/FracWetMod.F90 +M src/biogeophys/UrbanInitMod.F90 +M src/biogeophys/FrictionVelocityMod.F90 +M src/biogeophys/TridiagonalMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/Hydrology1Mod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/BiogeophysicsLakeMod.F90 +M src/biogeophys/BiogeophysRestMod.F90 +M src/biogeophys/SoilHydrologyMod.F90 +M src/biogeophys/UrbanMod.F90 +M src/biogeophys/QSatMod.F90 +M src/biogeophys/HydrologyLakeMod.F90 +M src/biogeophys/SNICARMod.F90 +M src/biogeophys/DriverInitMod.F90 +M src/biogeophys/BareGroundFluxesMod.F90 +M src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluefire: +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 +arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic +.........FAIL! rc= 10 +031 smC61 TSM.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 -6 cold +.................FAIL! rc= 10 +032 erC61 TER.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 10+38 cold +..............FAIL! rc= 5 +033 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold +...........FAIL! rc= 5 +034 blC61 TBL.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 48 cold +.................FAIL! rc= 4 +035 smH52 TSM.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 96 cold +.........FAIL! rc= 8 +036 erH52 TER.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 +cold ......FAIL! rc= 5 +037 brH52 TBR.sh 17p_cnnsc_dm clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS@2000 72+72 +cold ...FAIL! rc= 5 +038 blH52 TBL.sh 17p_cnnsc_dm clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold +.........FAIL! rc= 4 +039 smI59 TSMcnspinup.sh 17p_cnadspinupsc_dm 17p_cnexitspinupsc_dm 17p_cnsc_dm clm_std +20020115:NONEFAIL! rc= 5 +040 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic +........................FAIL! rc= 10 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic +......................FAIL! rc= 5 + bluefire interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic........FAIL! rc= 10 + bluefire/CCSM testing: +PASS SMS_RLA.f45_f45.I.bluefire +PASS SMS_RLB.f45_f45.I.bluefire +PASS SMS_ROA.f45_f45.I.bluefire +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +FAIL ERS.f19_g16.I_1850-2000.bluefire <-- script fails, but cpl log same +PASS ERB.f09_g16.I_1948_2004.bluefire +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <-- recv lnd Sl_t different +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS + jaguar interactive testing: All PASS except +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 +007 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 6 +009 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +011 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +013 smJ74 TSM.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic .FAIL! rc= 8 +014 erJ74 TER.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +015 brJ74 TBR.sh 4p_casasc_ds clm_std^nl_urb_br 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic FAIL! rc= 5 + dublin/lf95 interactive testing: +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 +007 brAL4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 6 +026 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +027 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +030 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + dublin/lf95: +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +030 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to.. +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold ......FAIL! rc= 7 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_53 + +Changes answers relative to baseline: Only f19 due to new fsurdat file (off by roundoff) + and startup for f09 and f19 with CN change due + to new finidat files. 20th Century simulations + with CN change because the ndep data set is different + from 1851-1924, and 2001-2004. + +=============================================================== +=============================================================== +Tag name: clm3_6_53 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Tue Sep 22 16:15:39 MDT 2009 +One-line Summary: Fix so that T31_gx3v7 file is actually included + +Purpose of changes: + +Add new optics file from Mark Flanner. Fix so T31_gx3v7 file included. Change testing +for 48x96 to gx3v7. Update datm so that pt1_pt1 res works. Fix clm template so +that RTM is turned off for pt1_pt1 resolution. + +Bugs fixed (include bugzilla ID): + 1042 (Bug with domain directory name in datm for pt1_pt1 resolution) + 789 -- change so that RTM is off should make single-point mode faster + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1063 (Problem in restarts for CCSM spinup data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: In template turn off RTM if grid=pt1 + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Add in T31_gx3v7 frac file, update snicar optics file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm7 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M Quickstart.userdatasets +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Summary of testing: Limited + + bluefire: + bluefire interactive testing: + bluefire/CCSM testing: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_53 + +Changes answers relative to baseline: None -- bit for bit + +=============================================================== +=============================================================== +Tag name: clm3_6_52 +Originator(s): erik (erik) +Date: Thu Sep 17 11:07:19 MDT 2009 +One-line Summary: Add T31_gx3v7 support, remove forganic, read from fsurdat, add script to extract regional datasets, work with CN output, add more urban/rural fields + +Purpose of changes: + + Add T31_gx3v7 files needed. Read organic fields from fsurdat file, remove forganic file. + Add in script to extract regional datasets. Change CN output fields list, add NBP (Net + Biome Production field). New Urban/Rural fields from Keith. Update bluefire compiler + to XLF12 (causes some restart issues listed below). + + This tag includes new scripts to extract regional datasets from the global datasets + in order to run for a specific region of interest. The scripts are available in the + models/lnd/clm/tools/ncl_scripts directory, the main script is the + getregional_datasets.pl perl script and it has a command line interface and help with + the "-help" option. There's also a README file in the directory containing the scripts, + and more information in the Quickstart.userdatasets file at the top level. + + Quickstart to use of regional extraction scripts: + + # Run the script to create an area to put your files (assume CSMDATA set to standard inputdata) + cd scripts + setenv MYCSMDATA $HOME/myinputdata + link_dirtree $CSMDATA $MYCSMDATA + + # Run the extraction for data from 52-73 North latitude, 190-220 longitude + # that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over + # Alaska + cd ../models/lnd/clm/tools/ncl_scripts + setenv MYID 13x12pt_f19_alaskaUSA + getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYID -mycsmdata $MYCSMDATA + + # Now create a case that uses these datasets + cd ../../../../../scripts + create_newcase -case testregional -compset I -mach bluefire -res pt1_pt1 -skip_rundb + cd testregional + $EDITOR env_conf.xml # change CLM_BLDNML_OPTS to include "-clm_usr_name $MYID" (expand $MYID) + $EDITOR env_mach_pes.xml # Change tasks/threads as appropriate (defaults to serial) + xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + $EDITOR Tool/Templates/datm.cpl7.template.csh # Add the following line before the check on DOMAINFILE (expand $MYID) + +if ( $DOMAINFILE == "unset" ) set DOMAINFILE = "domain.lnd.$MYID.nc" + + # Do other changes to xml files as appropriate + # configure as normal, then edit the datm namelist + + configure -case + + # Then build and run the case as normal + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1042 (Bug with domain directory name in datm for pt1_pt1 resolution) + 1063 (Problem in restarts for CCSM spinup data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Filepath, bluefire compiler to XLF12 + + Filepath for stub-components changes + In scripts and in test_driver.sh update compiler for bluefire to XLF12 + (this causes the restart issue for certain cases below). + +Describe any changes made to the namelist: Remove forganic (read organic from fsurdat file) + +List any changes to the defaults for the boundary datasets: Add 48x96_gx3v7 fracdata + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson(urban/rural), slevis (CN fields, new NBP field) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, stub-comps, csm_share + + scripts to scripts4_090916 + drv to vocemis-drydep12_drvseq3_0_29 + datm7 to datm7_090915 + socn/sice/sglc to stubs1_2_01 + csm_share to share3_090902 + +List all files eliminated: Remove noOrganicSoilDataset use case + + Remove the use case that removed the requirement for the forganic dataset. + + D models/lnd/clm/bld/namelist_files/use_cases/noOrganicSoilDataset.xml + +List all files added and what they do: + + Add stylesheet for namelist defaults files. + + A models/lnd/clm/bld/namelist_files/namelist_defaults.xsl + + Scripts to extract regions of interest from global grids and put them into the place + expected by build-namelist with the clm_usr_name option. + + A models/lnd/clm/tools/ncl_scripts/getregional_datasets.pl --- Main script to extract regional datasets. + This one has a command line interface. + A models/lnd/clm/tools/ncl_scripts/getregional_datasets.ncl -- Support script to do the actual work. + This one works based on settings of a bunch of environment variables. + +List all existing files that have been modified, and describe the changes: + + M Quickstart.userdatasets - Add notes about using getregional_datasets.pl + M Quickstart.GUIDE -------- Fix typo + + M models/lnd/clm/test/system/test_driver.sh ---- Update seqccsm version to beta26 + Also update bluefire to XLF12. + + M models/lnd/clm/tools/ncl_scripts/README ----- Add note about new getregional_datasets scripts + +>>>>>>>>>>>>>>> Get configure working with new scripts/stub-components + M models/lnd/clm/bld/configure ------- Change Filepath for stub components, remove + write_filepath_ccsm use ccsmbld version + +>>>>>>>>>>>>>>> Remove forganic, add T31_gx3v7, have query NOT return user filenames +>>>>>>>>>>>>>>> for transient files when sim_year_range=constant. +>>>>>>>>>>>>>>> Add style sheets for namelist_defaults files. + M models/lnd/clm/bld/queryDefaultXML.pm -- Skip filenames set to "null" + M models/lnd/clm/bld/build-namelist ------ Remove forganic + + M models/lnd/clm/bld/namelist_files/namelist_definition.xml ------------ Remove forganic, + add gx3v7 + M models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml ------ Remove forganic, + add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml --------- Add T31_gx3v7 + domainfile, add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml ---------- Add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---------- Make + gx3v7 default for T31, remove reference to forganic, add stylesheet. + M models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml ---- Set transient + files to null for sim_year_range=constant, add stylesheet. + +>>>>>>>>>>>>>>> Add NBP, change which CN fields active/inactive, add new Urban/Rural +>>>>>>>>>>>>>>> fields, remove forganic read organic soil from fsurdat + M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 --------- Add nbp, update doc for nee, nep, + work with formatting + M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 -------- Add nbp, update doc for nee, nep, + work with formatting + M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 -------- Set nbp and work with formatting + M models/lnd/clm/src/main/organicFileMod.F90 ------------- Remove forganic use fsurdat + M models/lnd/clm/src/main/clmtypeInitMod.F90 ------------- New urban/rural fields and nbp, + work with formatting + M models/lnd/clm/src/main/controlMod.F90 ----------------- Remove forganic + M models/lnd/clm/src/main/clm_varctl.F90 ----------------- Remove forganic + M models/lnd/clm/src/main/clmtype.F90 -------------------- Add urban/rural (oleson) and nbp, + and update doc on nep, nee + M models/lnd/clm/src/main/histFldsMod.F90 ---------------- Add urban/rural fields (oleson), + Change which CN fields on/off, add NBP + M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 -- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 --- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 --------- Add urban/rural (oleson) + M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Add urban/rural (oleson) + +Summary of testing: + + bluefire: All PASS except... +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS up to... +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + bluefire/CCSM testing: All PASS except for branch tests that fail due to XLF12 +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +FAIL ERB.f09_g16.I_1948_2004.bluefire <<<< FAIL's due to compiler upgrade to XLF12 +FAIL ERB.f09_g16.I1850SPINUPCN.bluefire <<<< FAIL's due to compiler upgrade to XLF12 +>>>>>>>>>>>>> NOTE This same problem exists in clm3_6_51 if you update the compiler to +>>>>>>>>>>>>> XLF12. +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + dublin/lf95 interactive testing: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + dublin/lf95: All PASS except (up to...) +008 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +009 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +010 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +011 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +012 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... + change path for cprnc on jaguar +M models/lnd/clm/test/system/input_tests_master -------------- single-column tests are cold-starts +M models/lnd/clm/test/system/tests_pretag_dublin_nompi ------- Add single-column tests +M models/lnd/clm/test/system/tests_posttag_nompi_regression -- Add single-column tests +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ---------- Remove assumption about order of dimensions +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ------------ Remove assumption about order of dimensions +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl -------- Remove assumption about order of dimensions +M models/lnd/clm/bld/config_files/Makefile.in ---------------- For ifort only add -132 to FIXEDFLAGS +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml Go back to old fndepdyn files from clm3_6_47 +M models/lnd/clm/src/main/clm_time_manager.F90 --------------- Label sub as "clm::" and change data to + intent(inout) to comply with ESMF3 + (From Dani Bundy-Coleman) + +Summary of testing: + + bluefire: All PASS except +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS except +021 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ........FAIL! rc= 5 +022 brAK4 TBR.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ........FAIL! rc= 5 +026 brAK8 TBR.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 arb_ic ....FAIL! rc= 6 +027 blAK8 TBL.sh _sc_ds clm_std^nl_ptsmode_ocn 20030101:NONE:1800 1.9x2.5 gx1v6 -10 arb_ic ......FAIL! rc= 6 +051 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar interactive testing: All PASS up to... +006 erAK4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 1.9x2.5 gx1v6 -5+-5 cold ..........FAIL! rc= 7 + lightning/ifort interactive testing: All PASS + dublin/lf95 interactive testing: All PASS up to... +006 erAL4 TER.sh _sc_ds clm_std^nl_ptsmode 20030101:NONE:1800 10x15 USGS -5+-5 cold .............FAIL! rc= 7 + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_48 + +Changes answers relative to baseline: No (bit-for-bit) + +=============================================================== +=============================================================== +Tag name: clm3_6_48 +Originator(s): erik (erik) +Date: Wed Aug 12 19:22:59 MDT 2009 +One-line Summary: New aerosol/nitrogen deposition datasets, mksurfdata work, scm work, clm_usr_name option to build-namelist + +Purpose of changes: + +Add in 0.47x0.63, 0.9x1.25 finidat file for CN and 1850, and 0.47x0.63 surface dataset. +Add in datasets at f09, f10, f05, f02 for aerosol (excepting f02 and f05) and nitrogen +deposition from J-F. Work with mksurfdata so that 0.23x0.31 dataset will work (Forrest). +Update csm_share, and get scam working. Add scam tests in. Add clm_usr_name option for +personal datasets to build-namelist. Add a noOrganicSoilDataset use-case so it won't add +in forganic file. Work on using ccsm build files for stand-alone testing. Get testing +going on dublin. + +Bugs fixed (include bugzilla ID): + 813 (use CCSM build files in testing -- partial) + 1010 (error in mksurfdata for qtr degree) + 1014 (shr_scam checkSurface can NOT run an I case) + 1023 (SCM mode check for lnd_present) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1017 (SCM mode can NOT restart) + 1025 (SCM mode can NOT use a global finidat file) + 1029 (ifort compilation error in pio) + 1031 (Can't run SMS_D.f09_g16.ICN8520) + 1032 (Problem running SCM mode on Lahey) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Get ccsm_bld option working + +Describe any changes made to the namelist: Add -clm_usr_name option for user-datasets, + add noOrganicSoilDataset use case (leaves forganic file off) + + Add the clm_usr_name option to build-namelist, document how this is done in the + Quickstart.userdataset README file. In short... + + if -clm_usr_name is set to ${MYDATAID} then do the following... + + surfdata: copy files into: + $MYCSMDATA/lnd/clm2/surfdata/surfdata_${MYDATAID}_simyr${SIM_YEAR}.nc + fatmgrid: copy files into: + $MYCSMDATA/lnd/clm2/griddata/griddata_${MYDATAID}.nc + fatmlndfrc: copy files into: + $MYCSMDATA/lnd/clm2/griddata/fracdata_${MYDATAID}_${MASK}.nc + faerdep: copy files into: + $MYCSMDATA/lnd/clm2/snicardata/aerosoldep_monthly_${SIM_YEAR}_${MYDATAID}.nc + + Then set CLM_BLDNML_OPTS="-clm_usr_name $MYDATAID" in your env_conf.xml. You + may have to set DIN_LOC_ROOT_CSMDATA in env_run.xml to $MYCSMDATA is this isn't + the standard location as well (use scripts/link_dirtree $CSMDATA $MYCSMDATA to + link standard datasets to your location. + +List any changes to the defaults for the boundary datasets: New datasets + New aerosol and nitrogen deposition datasets from Jean-Francois Lamarque + New interpolated finidat: for 0.9x1.25, and 0.47x0.63 + New fsurdat: for 0.47x0.63 + New faerdep, 1849-2006: for 0.9x1.25 strung together by David Bailey + New faerdep, 1849-2006: for 1.9x2.5, 10x15 (interpolated) + New fndepdat, decadal avgs: for 1.9x2.5 (raw data from J-F) + New fndepdyn, 1850-2006: for 1.9x.25 strung together + New fndepdyn, 1849-2006: for 0.9x1.25, 0.47x0.63, 10x15 (interpolated) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, datm7 + + scripts to scripts4_090806 + csm_share to share3_090811 + datm7 to datm7_090812 + +List all files eliminated: None + +List all files added and what they do: + + A Quickstart.userdatasets ---------------------------- Documentation on using own datasets + A models/lnd/clm/test/system/nl_files/nl_ptsmode_ocn - Test SCM mode + A models/lnd/clm/test/system/nl_files/nl_ptsmode ----- Test SCM mode over ocean + A models/lnd/clm/bld/namelist_files/namelist_defaults_usr_files.xml --- Template for + user defined input datasets + A models/lnd/clm/bld/namelist_files/use_cases/noOrganicSoilDataset.xml- Use case to + turn off organic soil dataset + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> Add scm tests, new variable to turn on use of CCSM build +>>>>>>>>>>>>>>>> Turn off -test in nl_files, already in mknamelist +>>>>>>>>>>>>>>>> Update dublin build/run to what used by cam. + M models/lnd/clm/test/system/TCB.sh --------------- Test for CLM_CCSMBLD + M models/lnd/clm/test/system/README.testnames ----- Add K and L single point mode cases + M models/lnd/clm/test/system/test_driver.sh ------- Update dublin, add INTEL for dublin + reconcile jaguar module with CCSM build + also set PNETCDF dirs. + M models/lnd/clm/test/system/nl_files/clm_per ----- Remove -test + M models/lnd/clm/test/system/nl_files/clm_std ----- Remove -test + M models/lnd/clm/test/system/nl_files/clm_ndepdyn - Remove -test + M models/lnd/clm/test/system/nl_files/clm_pftdyn -- Remove -test + M models/lnd/clm/test/system/nl_files/clm_per0 ---- Remove -test + M models/lnd/clm/test/system/nl_files/clm_urb1pt -- Remove -test + M models/lnd/clm/test/system/input_tests_master --- Add single point tests AK4/AK8,AL4 + M models/lnd/clm/test/system/README --------------- Add note about CLM_CCSMBLD env var + M models/lnd/clm/test/system/CLM_runcmnd.sh ------- Update dublin +>>>>>>>>>>>>>>>> Changes from Forrest Hoffman so that 0.23x0.31 case will work +>>>>>>>>>>>>>>>> I had started this work, but didn't complete it. Forrest checked +>>>>>>>>>>>>>>>> the following changes in. +>>>> 1. Changed the FFLAGS for debug mode on AIX +>>>> 2. Added calls to areaave(), gridmap_clean(), and areaini() in mksoicol.F90 and mksoitex.F90 +>>>> 3. Changed "stop" to "call abort()" in mksrfdat.F90 +>>>> 4. Added roundoff error fixes for gridcells containing only special landunits not +>>>> totalling 100% twice in mksrfdat.F90 +>>>> 5. Added error checking for after landunit adjustment to detect gridcells whose +>>>> components do not total 100% twice in mksrfdat.F90 + M models/lnd/clm/tools/mksurfdata/mksoicol.F90 ---- Add regrid for mask + M models/lnd/clm/tools/mksurfdata/Makefile -------- On IBM optimized remove -C, non-opt remove -O0 + M models/lnd/clm/tools/mksurfdata/mksoitex.F90 ---- Regrid mask + M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---- Roundoff error fix and test +>>>>>>>>>>>>>>>> Handle sim_year_range for datasets, loosen the tolerance for area sum +>>>>>>>>>>>>>>>> Allow time variable to be one ndep files. + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl - Handle sim_year_range + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --- Handle sim_year_range, loosen + tolerance, and allow time variable +>>>>>>>>>>>>>>>> Get ccsm_bld option working, change ifort a bit, add clm_usr_name +>>>>>>>>>>>>>>>> option and noOrganicSoilDataset use case to build-namelist +>>>>>>>>>>>>>>>> New datasets + Fix hybrid bug for dynpft case, update externals. Require get_clump_bounds to be called + in threaded regions and get_proc_bounds to be called in non-threaded regions. Remove uneeded get_proc_bounds + calls, and pass down begg stuff as needed. Make loop in initSurfAlb Open-MP. Begin adding + testing for dublin, and add lightning_pgi testing. Add new pftdyn test datasets for 1x1_tropicAtl. + Update testing to beta20, default for lightning is ifort, add lighting_pgi testing. Change hist varnames + of 3D_Time_constants_vars* to Time_constant_3Dvars*. Remove use of LSMLAT/LSMLON cpp tokens, by default + set lsmlat/lsmlon to 1. + +Bugs fixed (include bugzilla ID): 1011 (PGI build problem in driver) + 1016 (Problem with PTS_MODE build) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + +Known bugs (include bugzilla ID): 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1010 (error in mksurfdata for qtr degree) + 1014 (shr_scam checkSurface can NOT run an I case) + 1023 (SCM mode check for lnd_present) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + 1102 (OpenMP problem with pftdyn mode) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: pftdyn test datasets for 1x1_tropicAtl + +Describe any substantial timing or memory changes: None + +Code reviewed by: self,mvertens + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, csm_share + +scripts to scripts4_090801 ---------------- Begin adding PTS_MODE settings, update clm testlists +drv to vocemis-drydep12_drvseq3_0_27 -- Add PTS_MODE settings to template +datm7 to datm7_090729 ------------------- Add single_column support +csm_share to share3_090729 ------------------ Add dshr support for scmlat/scmlon in domain + +List all files eliminated: None + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_dublin ------- Add test list for dublin + A models/lnd/clm/test/system/tests_pretag_dublin_nompi - Add interactive test list for dublin + +List all existing files that have been modified, and describe the changes: + + M models/lnd/clm/test/system/test_driver.sh ------- Seq testing to beta20, begin adding dublin, default + for lightning is ifort, add lightning_pgi, + M models/lnd/clm/test/system/input_tests_master -- Add openMP 4x5 test + M models/lnd/clm/test/system/CLM_runcmnd.sh ------ Add dublin remove bangkok + + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Update pftdyn surfdata for 1000-1004 + tests for 1x1_tropicAtl + + M models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 - Remove call to get_proc_bounds -- NOT needed + M models/lnd/clm/src/main/clm_varpar.F90 -------------- By default set lsmlat/lsmlon to 1 + M models/lnd/clm/src/main/dynlandMod.F90 -------------- Remove get_proc_bounds pass begg stuff in + M models/lnd/clm/src/main/driver.F90 ------------------ Pass begg stuff down to pft_interp + M models/lnd/clm/src/main/initializeMod.F90 ----------- Pass begg stuff down to pft_interp + M models/lnd/clm/src/main/pftdynMod.F90 --------------- Pass begg stuff down, remove get_proc_bounds calls + M models/lnd/clm/src/main/histFileMod.F90 ------------- Change var names of 3D_Time_constants_vars* to + Time_constant_3Dvars* + M models/lnd/clm/src/main/initSurfAlbMod.F90 ---------- Make loop OpenMP parallel + M models/lnd/clm/src/main/decompMod.F90 --------------- Make sure get_clumpbounds is called from threaded + regions and get_proc_bounds is NOT. + +Summary of testing: + + bluefire: All PASS except +002 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +006 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 7 +010 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 7 +011 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 6 +019 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 +020 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 6 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 7 +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +048 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 6 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS! + bluefire/CCSM testing: All PASS! +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire +PASS PET.f10_f10.ICN8520.bluefire.cpl +PASS PET.f10_f10.ICN8520.bluefire.atm +PASS PET.f10_f10.ICN8520.bluefire.lnd +PASS PET.f10_f10.ICN8520.bluefire.ice +PASS PET.f10_f10.ICN8520.bluefire.ocn +PASS PET.f10_f10.ICN8520.bluefire.glc + jaguar: All PASS! + lightning/ifort interactive testing: All PASS! + breeze,gale,hail,gust/ifort interactive testing: All PASS up to... +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_46 + +Changes answers relative to baseline: No bit-for-bit (except dynpft which was irreproducible before) + +=============================================================== +=============================================================== +Tag name: clm3_6_46 +Originator(s): erik (erik) +Date: Wed Jul 22 15:50:43 MDT 2009 +One-line Summary: Get more tests to work/document them, add use cases for 1850_control, + 2000_control, and 20thC_transient, straighten out single-point grids, Listen to + LND_CDF64 env variable from template, remove CLM_ARB_IC. + +Purpose of changes: + +Work with build-namelist to make 20th-Century a use-case so that ndepdyn files will be +included if found, but can still work without them (20thC_transient, 2000_control, and +1850_control use cases). Fix more bugs and tests, report on testing status for each +machine. Add files needed for 1.9x2.5_tx1v1 grid and new 10x15 surface dataset. Reconcile +grids for single-point datasets so consistent (lon within 0-360 rather than -180-180). +Get new single-point datasets for aerosol and nitrogen-deposition. Work with +pftdyntest2raw.ncl so will work. Work with mksurfdata.pl script so will append needed +grid data on urban point datasets. Add in CLM1PT mode for datm7 and use datm7 streams +template for testing. Listen to LND_CDF64 env variable from template, remove CLM_ARB_IC. + +Bugs fixed (include bugzilla ID): 1002 (remove CLM_ARB_IC) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 896 (T62 mode does not work) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1007 (interpinic error with Linux/lahey) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + + Add CLM1PT option to DATM_MODE in env_conf.xml + +Describe any changes made to the namelist: + + New use-cases for: + 2000_control + 1850_control + 20thC_transient + +List any changes to the defaults for the boundary datasets: + 1.9x2.5_tx1v1 datasets, new single-point/regional datasets, new 10x15 surface dataset + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm7, pio + +scripts to scripts4_090720 +datm7 to datm7_090721 +pio to pio51_prod + +List all files eliminated: + +D models/lnd/clm/bld/namelist_files/streams.txt.readme ------- Use datm7 version +D models/lnd/clm/bld/namelist_files/datm.streams.template.xml- Use datm7 version +D models/lnd/clm/test/system/nl_files/clm_organic ------------ organic files included anyway + +List all files added and what they do: + +>>>>>>>>>>>> Add new use cases +A models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- 2000 control +A models/lnd/clm/bld/namelist_files/use_cases/20thC_transient.xml - 20th Century transient +A models/lnd/clm/bld/namelist_files/use_cases/1850_control.xml ---- 1850 control +A models/lnd/clm/bld/namelist_files/use_cases/2000_control.xml ---- 2000 control + +>>>>>>>>>>>> Add regression tests list for without MPI +A models/lnd/clm/test/system/tests_posttag_nompi_regression ------- no mpi tests + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>> Get more tests working, or at least closer to working +>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>> models/lnd/clm/test/system directory changes +M TCB.sh -------------------------------- Put -mach arg here +M tests_pretag_bluefire ----------------- Change some hybrid tests to MPI +M config_files/ext_ccsm_seq_10x15_dh ---- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_4x5_dh ------ Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_1.9x2.5_dh -- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_64x128_s ---- Set cice decomp / remove silent mode +M config_files/ext_ccsm_seq_0.9x1.25_dh - Set cice decomp / remove silent mode +M test_driver.sh ------------------------ Set threads/tasks, move -mach to TCB, + set DIN_LOC_ROOT, change needed for latest jaguar build +M tests_posttag_hybrid_regression ------- Remove bad tests, move pure-mpi, serial/open-mp out +M tests_posttag_purempi_regression ------ Remove bad tests, move pure-mpi, serial/open-mp out +M nl_files/nl_urb ----------------------- Remove urban fields already included +M nl_files/nl_urb_br -------------------- Remove urban fields already included +M input_tests_master -------------------- Changes so tests will work +M TCBext_ccsmseq_cam.sh ----------------- Add main/cpl_mct to clm list of dirs + +>>>>>>>>>>>>>>>>>> Update filenames, append grid/frac files to urban single-pt in script +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional ---- New griddata, fix filepath +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept ---- New griddata, fix filepath +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl ---------- Fix, append grid/frac data + to urban single-point datasets + +>>>>>>>>>>>>>>>>>> Get the pftdyntest2raw script working (will update datasets later) +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl - Fix so will work, add grazing on +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ----- Add sim_yr to out filenames + +>>>>>>>>>>>>>>>>>> Validate grid +M models/lnd/clm/tools/mkgriddata/creategridMod.F90 - Check for valid grid values + +M models/lnd/clm/srm/main/pftdynMod.F90 - Shorten some long lines + +>>>>>>>>>>>>>>>>>> Change to build: add use-cases, remove CLM_ARB_IC, listen to LND_CDF64 +>>>>>>>>>>>>>>>>>> Add new 1.9x2.5_tx1v1 frac dataset, new datasets for single-point, +>>>>>>>>>>>>>>>>>> new 10x15 datasets, separate out sim_yr and sim_year_range +>>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>> models/lnd/clm/bld directory changes +M listDefaultNamelist.pl ----------------------- Add csmdata arg +M build-namelist ------------------------------- Add -list_use_cases option + load uses cases before other defaults, add $ccsm_tools var, + separate sim_yr and sim_year_range, put case_desc for use-cases +M clm.cpl7.template ---------------------------- Remove CLM_ARB_IC, use LND_CDF64 +M namelist_files/checkdatmfiles.ncl ------------ Add tx1v1 mask +M namelist_files/namelist_definition.xml ------- Add tx1v1 mask, make sim_year integer + add sim_year_range, use_case_desc, and clm_demand +M namelist_files/namelist_defaults_overall.xml - default sim_year_range is constant + and default clm_demand is null +M namelist_files/namelist_defaults_datm.xml ---- Use datm7 streams template, + and update domain files +M namelist_files/use_cases/pergro.xml ---------- Add use_case_desc +M namelist_files/use_cases/pergro0.xml --------- Add use_case_desc +M namelist_files/namelist_defaults_clm.xml ----- Move co2_ppmv defaults to use_cases + new surf/frac/aer/ndep/grid data: 5x5_amazon, 1x1_brazil, 1x1_urbanc_alpha, + 1x1_mexicocityMEX, 1x1_vancouverCAN + new frac data: 1.9x2.5_tx1v1 + new aerdep/ndep data: 1x1_camdenNJ, 1x1_tropicAtl, 1x1_asphaltjungleNJ + new surfdata/pftdyn: 10x15 + (new finidat file for f09 CN, 1850 -- commented out -- so answers same as last tag) + +Summary of testing: + + bluefire: All PASS except +019 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 +020 brEH1 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 6 +022 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +023 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +024 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +025 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +026 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +027 smC45 TSM.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 8 +028 erC45 TER.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -3+-7 arb_ic .......FAIL! rc= 5 +029 brC45 TBR.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -5+-5 arb_ic .......FAIL! rc= 5 +030 blC45 TBL.sh 17p_sc_m clm_pftdyn 18501230:NONE:3600 10x15 USGS@1850-2000 -10 arb_ic .........FAIL! rc= 4 +033 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold ...........FAIL! rc= 6 +041 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 7 +042 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 6 +051 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 4 +052 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +054 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + bluefire interactive testing: All PASS except +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +013 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +017 blJ74 TBL.sh 4p_casasc_ds clm_std^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ..FAIL! rc= 7 +019 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +021 blL78 TBL.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 7 +027 erL83 TER.sh _sc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 7 +028 brL83 TBR.sh _sc_do clm_std^nl_urb_br 20020115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 6 +029 blL83 TBL.sh _sc_do clm_std^nl_urb 20020115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 5 +034 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 4 +036 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 +043 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire +PASS ERH_D.f10_f10.I_1850_CN.bluefire + lightning/ifort: All PASS except -- up to test 18 +002 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +003 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +005 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +006 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +007 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +008 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +009 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +011 erJ42 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 7 +012 brJ42 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 6 +015 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 7 +016 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 6 + lightning/ifort interactive testing: up to test 004 +004 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 + calgary/lf95: All PASS except... +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +015 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +019 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 7 +023 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +024 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +025 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +026 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +027 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +028 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +049 blL74 TBL.sh _sc_s clm_std^nl_urb 20020101:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 7 +052 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +053 smM94 TSMncl_tools.sh ndepregrid ............................................................FAIL! rc= 6 +055 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +056 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze,gale,hail,gust/ifort: All PASS except... +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 7 +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +011 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +019 blR53 TBL.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@1850 48 cold .......FAIL! rc= 7 +020 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +021 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +022 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +023 blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_45 + +Changes answers relative to baseline: Bit-for-bit EXCEPT for (as datasets change) + 5x5_amazon, 1x1_brazil, 1x1_urbanc_alpha, 1x1_mexicocityMEX, 1x1_vancouverCAN + 1x1_camdenNJ, 1x1_tropicAtl, 1x1_asphaltjungleNJ, 10x15 + +=============================================================== +=============================================================== +Tag name: clm3_6_45 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Jul 10 14:00:27 MDT 2009 +One-line Summary: Remove inconsistent finidat file in clm3_6_44 + +Purpose of changes: A few simple bug fixes from clm3_6_44, with minimul testing + + Remove finidat inconsistent with the surface datasets for f19_g16, bgc=cn, sim_yr=1850 + Fix typo in test list, and fix thread settings for bluefire tests + Remove -ftz from CFLAGS for ifort for mkdatadomain + Change csh run scripts so: use CCSM env_machopts settings, set defaults, fix so can run serial + Update datm7 so that CPLHIST3HrWxHfHrSol mode has iradsw=-1 so mimics running with CAM + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Remove inconsistent + finidat file for 0.9x1.25, gx1v6, BGC=cn, sim_yr=1850 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): datm7 + + datm7 to datm7_090709 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/test/system/test_driver.sh ------------------- Fix threads settings for bluefire +M models/lnd/clm/test/system/input_tests_master --------------- Fix typo +M models/lnd/clm/tools/interpinic/runinit_ibm.csh ------------- Use CCSM env_machopts settings +M models/lnd/clm/tools/mkdatadomain/Makefile ------------------ Remove -ftz from CFLAGS for ifort +M models/lnd/clm/bld/run-ibm.csh ------------------------------ Use CCSM env_machopts settings, set defaults, + fix so can run serial +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove 0.9x1.25, BGC=cn, sim_year=1850, mask=gx1v6 + finidat file as was inconsistent with new surface dataset + +Summary of testing: Limited + +CLM tag used for the baseline comparison tests if applicable: clm3_6_44 + +Changes answers relative to baseline: bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_44 +Originator(s): erik (erik) +Date: Thu Jul 9 11:47:40 MDT 2009 +One-line Summary: Fix C13 bug, update scripts, drv, datm. Add domain files for idmap +atm-ocn grids for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with +ndeplintInterp, fix SCAM + +Purpose of changes: + +Fix C13 nflds bug, update scripts, drv, datm. Add domain files for idmap atm-ocn grids +for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with ndeplintInterp to +enable using J-F's new Nitrogen deposition files for transient 20th Century simulations. +SCAM fixes from John Truesdale. Add indices for PFT types. + +Bugs fixed (include bugzilla ID): 981 (ccsm domain files for atm=ocn grid) + 987 (remove SEQ_MCT) + 991 (C13 nfields cause model to blowup on jaguar) + 997 (interpolated finidat files cause fully coupled cases to fail) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 990 (CN transient blowup) + 994 (finidat files on jaguar for pftdyn fail) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Remove SEQ_MCT + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New surface datasets for 0.9x1.25 and 1.9x2.5, and new finidat for 1850 for 0.9x1.25 + 10x15 2000 10x15 dataset set to the 1850 version so that testing will work. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson (pftvarcon changes) + SCAM changes from John Truesdale + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, + csm_share and pio + + scripts to scripts4_090707b + drv to vocemis-drydep11_drvseq3_0_23 + datm7 to datm7_090708 + csm_share to share3_090706b + pio to pio50_prod + +List all files eliminated: + + D models/lnd/clm/test/system/tests_pretag_bangkok -- Rename to calgary + +List all files added and what they do: + + A models/lnd/clm/test/system/tests_pretag_calgary ----------- Rename from bangkok + A models/lnd/clm/test/system/tests_pretag_bluefire_nompi ---- serial/open-MP tests + A models/lnd/clm/test/system/tests_pretag_jaguar_nompi ------ serial/open-MP tests + A models/lnd/clm/test/system/tests_posttag_lightning_nompi -- serial/open-MP tests + +List all existing files that have been modified, and describe the changes: + + M Quickstart.GUIDE --- fix minor error in name of directory as scripts changed. + + >>>>>>>>>>>> Separate out non-mpi tests for bluefire, jaguar, and lightning + Test list is different if run interactive or submitted to batch que. + Serial, open-mp only tests are run interactive, MPI and hybrid tests + are run when submitted to the batch que. This prevents waste of resources + for serial and open-mp only tests. + Remove bangkok, replace with calgary only. Default threads depends + on if interative or not. + M models/lnd/clm/test/system/test_driver.sh ----------- + M models/lnd/clm/test/system/tests_pretag_bluefire ---- + M models/lnd/clm/test/system/tests_pretag_jaguar ------ + M models/lnd/clm/test/system/tests_posttag_lightning -- + M models/lnd/clm/test/system/README ------------------- Add note about CLM_SOFF + + >>>>>>>>>>>> + M models/lnd/clm/tools/mksurfdata/Makefile ------------------- For ifort remove -ftz option to CFLAGS + M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ----- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.regional -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ---------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist -------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt -- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ------- New input PFT datasets from Peter L. + M models/lnd/clm/tools/mksurfdata/mksurfdata.pl -------------- New input PFT datasets from Peter L. + + >>>>>>>>>>>> Work on linear interpolation of Nitrogen deposition so that add in mid-decades + M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ------- Check if interpolation should be cyclic + M models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl ----- Also loop over mid decades as well + M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl --------- Check if interpolation should be cyclic + + >>>>>>>>>>>> Fix from Sam so that don't have negative ice flow + M models/lnd/clm/tools/interpinic/interpinic.F90 --- Change from Sam so that fully coupled cases don't trap negative ice flow + M models/lnd/clm/tools/interpinic/Srcfiles --------- Don't repeat filenames so can build with lahey + + >>>>>>>>>>>> Change so that document that files should have longs between 0 and 360 rather than -180 to 180 + M models/lnd/clm/tools/mkgriddata/mkgriddata.regional --- Use longs 0-360 + M models/lnd/clm/tools/mkgriddata/mkgriddata.singlept --- Use longs 0-360 + M models/lnd/clm/tools/mkgriddata/Makefile -------------- For ifort remove -ftz option to CFLAGS + M models/lnd/clm/tools/mkgriddata/README ---------------- Make note that regional/single-pt grid files should have longs: 0 <= longs <= 360 + + >>>>>>>>>>>> Remove SEQ_MCT and handle COMP_INTERFACE from ccsm cpl7 scripts, new surface datasets + M models/lnd/clm/bld/configure ----------- Remove SEQ_MCT, handle cpl_esmf + M models/lnd/clm/bld/clm.cpl7.template --- Handle $COMP_INTERFACE + M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Allow mid-decadal + sim_years so can process ndepdyn files + M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- New 0.9 finidat, + 0.9x1.25, and 1.9x2.5 surfdata, fndepdat files for mid-decadal sim_years. + + >>>>>>>>>>>> Add indices for PFTs. Fixes for SCAM. Break up long lines > 132chars + M models/lnd/clm/src/biogeochem/CASAMod.F90 -------------- noveg, nc3_nonarctic_grass + M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 --- noveg, ncorn, nbrdlf_dcd_brl_shrub + M models/lnd/clm/src/biogeochem/VOCEmissionMod.F90 ------- Add PFT indices + M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - Add PFT indices + M models/lnd/clm/src/main/organicFileMod.F90 ------------- SCAM fix (from jet) + M models/lnd/clm/src/main/ncdio.F90 ---------------------- Break up long lines + M models/lnd/clm/src/main/pftdynMod.F90 ------------------ Break up long lines, add + noveg, nbrdlf_evr_shrub + M models/lnd/clm/src/main/clm_atmlnd.F90 ----------------- C13 bug fix for number of fields + (found by Jon Wolfe) + M models/lnd/clm/src/main/pftvarcon.F90 ------------------ Add PFT indices, make sure + pftnames from pftcon file is + as expected. + M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 -------- SCAM fix (from jet) + +Summary of testing: + + bluefire: All FAIL except... +008 smB91 TSMruncase.sh .........................................................................PASS +053 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................PASS + bluefire/CCSM testing: All PASS +PASS ERS_D.f45_g35.I_2000.bluefire +PASS PET.f45_g35.I_1850.bluefire.cpl +PASS PET.f45_g35.I_1850.bluefire.atm +PASS PET.f45_g35.I_1850.bluefire.lnd +PASS PET.f45_g35.I_1850.bluefire.ice +PASS PET.f45_g35.I_1850.bluefire.ocn +PASS PET.f45_g35.I_1850.bluefire.glc +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +PASS ERB.f09_g16.I1850SPINUPCN.bluefire.001802 +PASS ERH_D.f10_f10.I_1850_CN.bluefire + +CLM tag used for the baseline comparison tests if applicable: clm3_6_43 + +Changes answers relative to baseline: No -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_43 +Originator(s): erik (erik) +Date: Wed Jun 10 11:41:57 MDT 2009 +One-line Summary: Fix pftdyn bug, enable 1D primary hist files, fix time-const3D output, fix template bug, enable cpl_esmf/cpl_mct + +Purpose of changes: + +Add src/main/cpl_esmf,src/main/cpl_mct directories, change configure to build either way, +add -comp_intf option. Remove SEQ_ #ifdef's, simplify some of the logic associated with +the old options (cpl6 and program_off). Brian K -- fix nans, enable openMP again. Allow +first history tape to be 1D (Sean Swenson). Fix template co2_ppmv error. Remove SPMD +#ifdef from RTM. Fix driver pftdyn bug. Fix bug on writing out 3D time-constant fields. + +Bugs fixed (include bugzilla ID): + 929 (bug in co2ppmv value in template) + 969 (allow primary tapes to be 1D) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 991 (C13 nfields cause model to blowup on jaguar) + 1019 (hybrid/OpenMP reproducibility bug for pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Add choice between ESMF/MCT compilation + NOTE: ESMF option does NOT work as files do NOT exist yet! + Add -comp_intf option to configure + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, swensosc (1D and history changes), + kauff (reenable OpenMP, some vars spval instead of nan) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, pio + + scripts to scripts4_090605b + drv to vocemis-drydep08_drvseq3_0_18 + pio back to pio45_prod (to eliminate compilation problem with pathscale) + +List all files eliminated: + +D models/lnd/clm/src/main/lnd_comp_mct.F90 --- Move to cpl_mct + +List all files added and what they do: + +A models/lnd/clm/src/main/cpl_mct ---- Directory for MCT interface +A models/lnd/clm/src/main/cpl_esmf --- Directory for ESMF interface +A models/lnd/clm/src/main/cpl_mct/lnd_comp_mct.F90 - Moved from main directory + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Add -comp_intf option, fix template bug, closing input namelist +M models/lnd/clm/bld/configure ----------- Add -comp_intf option +M models/lnd/clm/bld/config_files/config_definition.xml -- Add comp_interface +M models/lnd/clm/bld/clm.cpl7.template --- Close input namelist with ending "/" + +>>>>>>>>>>>>>> Remove SEQ_ CPP #if's, require some arguments + (needed to be optional for cpl6/offline), allow primary hist files 1D + Fix so that 3D time-constant data does get written out. +M models/lnd/clm/src/main/clm_comp.F90 --------- Make rstwr, nlend, rdate required +M models/lnd/clm/src/main/driver.F90 ----------- Remove doalb if's, PFTDYNWBAL CPP + (for pftdyn bug). Require rstwr, + nlend, and rdate +M models/lnd/clm/src/main/clmtypeInitMod.F90 --- Some vars init to spval (kauff) + certain cell & pft level variables are initialized to spval + instead of nan so eliminate the appearance of nans on restart files. + (not all cell & pfts were used and given non-nan values) +M models/lnd/clm/src/main/histFileMod.F90 ------ Write out 3D time-constant vars, + fix so can write primary 1D files + (Sean Swenson) +M models/lnd/clm/src/main/restFileMod.F90 ------ nlend required +M models/lnd/clm/src/main/controlMod.F90 ------- Remove SEQ_ CPP #if's, allow 1D primary + ability to run threaded is re-enabled (kauff) +M models/lnd/clm/src/main/do_close_dispose.F90 - Require rstwr, nlend +M models/lnd/clm/src/riverroute/RtmMod.F90 ----- Remove SPMD #ifdef + +>>>>>>>>>>>>>> Move testing to calgary from bangkok +M models/lnd/clm/test/system/test_driver.sh ---- Add LD_LIBRARY_PATH for calgary/lf95 + +Summary of testing: + + bluefire: All PASS except (up to test 35) +007 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +008 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +009 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +012 blD91 TBL.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 5 +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -1100 cold FAIL! rc= 8 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -100 cold FAIL! rc= 4 +019 blE91 TBL.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 5 +028 blF93 TBL.sh 17p_vodsrsc_do clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +034 erEH1 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 7 + + bluefire/CCSM testing: +PASS ERS.f45_g35.I_2000.bluefire +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +SFAIL ERH.f10_f10.I_1850_CN.bluefire.235943 <<< f10_f10 doesn't work for datm7 right now + +TBL hybrid/openMP tests fail since previous version had OpenMP disabled. + + breeze/gale/hail/gust/ifort: All PASS up to test 12 (10x15, smL51 test) + +CLM tag used for the baseline comparison tests if applicable: clm3_6_43 + +Changes answers relative to baseline: Only pftdyn mode + +=============================================================== +=============================================================== +Tag name: clm3_6_42 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Tue Jun 2 11:58:25 MDT 2009 +One-line Summary: Bring CN Harvest branch (cnhrv02_clm3_6_41) to trunk + +Purpose of changes: + + Add in Peter Thornton's code to read in harvesting variables on surface datasets + and apply harvesting to carbon and nitrogen pools. + Add in surface datasets from clm3_6_40 that have harvesting fields on them for + 0.9x1.25, 1.9x2.5, and 10x15 (as well as aerdep, ndepdat, and ndepdyn datasets). + Remove urban test list as urban on by default, and remove top level doc directory. + Add C13 CPP token for C13 extension of CN add -c13 option to configure. + Add C13/10x15@1850-2000 testing. + Let sum of percent types match to 100 within small value rather than an exact match. + Increase wasteheat limit from 40 to 100 W/m2. + Change default masks to USGS for 4x5,T31,T42, and T85 resolutions so same as cice + Update drv to latest version (drvseq3_0_17 -- on voc branch). + Update ccsm comparision version used in test suite. + +Bugs fixed (include bugzilla ID): + 977 (bug writing out 3D time-const data) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 971 (abort on lahey with MPI) + 972 (abort on intel with MPI) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + Add C13 #ifdef for CN + Add -c13 option to configure + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + Make USGS mask default for 4x5,T31,T42, and T85 + surface datasets with harvesting for: 0.9x1.25, 1.9x2.5, 10x15 (1850,2000) + pftdyn datasets with harvesting for: 0.9x1.25, 10x15 (1850-2005) + faerdep datasets for: 0.9x1.25, 10x15 (1850, 2000, 1850-2000) + fndepdat datasets for: 0.9x1.25, 10x15 (1850,2000) + fndepdyn datasets for: 0.9x1.25, 1.9x2.5, 10x15 (1850-2000) + +Describe any substantial timing or memory changes: Minor for CN + +Code reviewed by: thornton, erik + +List any svn externals directories updated (csm_share, mct, etc.): + Remove top level doc directory as out of date and won't be updated. Howto is in + the scripts directory + +List all files eliminated: + +D models/lnd/clm/test/system/tests_posttag_urban - Urban on by default so doesn't + need it's own tests +>>>>>>>>>>>>>>>>>> Remove as can NOT easily recreate source from them and code + has changed since the creation of the scripts. Would take work + to get the two in sync and be able to use these scripts as source. +D models/lnd/clm/src/main/gen_ncdio_global_subs.csh +D models/lnd/clm/src/main/gen_ncdio_local_subs.csh +D models/lnd/clm/src/main/gen_spmdgs_subs.csh + +List all files added and what they do: + +>>>>>>>>>>>>>>>>>> Add new configurations to test C13 config +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_dh +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_dm +A + models/lnd/clm/test/system/config_files/17p_cnc13sc_do +>>>>>>>>>>>>>>>>>> New module to handle wood harvesting +A + models/lnd/clm/src/biogeochem/CNWoodProductsMod.F90 Calculate loss fluxes from wood + products pools, and update + product pool state variables + +List all existing files that have been modified, and describe the changes: + +M Quickstart.GUIDE --- Update documentation +M README ------------- Update documentation +>>>>>>>>>>>>>>>>>> Add C13 and 10x15@1850-2000 tests +M models/lnd/clm/test/system/tests_pretag_bluefire --- Add 10x15@1850-2000 tests +M models/lnd/clm/test/system/config_files/README ----- Add note on new C13 config +M models/lnd/clm/test/system/tests_posttag_breeze ---- Add openmp C13 test +M models/lnd/clm/test/system/README.testnames -------- Add R configuration for C13 config +M models/lnd/clm/test/system/tests_posttag_hybrid_regression -- Add C45 and R51 tests +M models/lnd/clm/test/system/tests_posttag_purempi_regression - Add C45 and R52 tests +M models/lnd/clm/test/system/input_tests_master ------ Add C45 (10x15@1850-2000, pure-mpi) and + R51-R53 (C13) tests +M models/lnd/clm/test/system/test_driver.sh ---------- Update ccsm4 comparision version + to beta17 +>>>>>>>>>>>>>>>>>> Add C13 configuration option, and new datasets +M models/lnd/clm/bld/configure -------------------------------- Add -c13 option +M models/lnd/clm/bld/config_files/config_definition.xml ------- Add c13 entry +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - + Change default masks for 4x5,T31,T42,T85 to USGS so agree with cice defaults + surface datasets with harvesting for: 0.9x1.25, 1.9x2.5, 10x15 (1850,2000) + pftdyn datasets with harvesting for: 0.9x1.25, 10x15 (1850-2005) + faerdep datasets for: 0.9x1.25, 10x15 (1850, 2000, 1850-2000) + fndepdat datasets for: 0.9x1.25, 10x15 (1850,2000) + fndepdyn datasets for: 0.9x1.25, 1.9x2.5, 10x15 (1850-2000) +>>>>>>>>>>>>>>>>>> C13/DGVM #ifdefs, add harvest vars and calculations +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 ---- Add CStateUpdate2h method for + harvest mortality fluxes +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 -- Add C13 cpp and add C13StateUpdate2h + method for harvesting +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 ---- Remove 10n and 100n variables +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 ----- Add in harvesting terms +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 - Add C13 #ifdef's +M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 ---------- Add harvesting fields +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 ---- Remove 10c, 100c variables, + formatting changes +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 -- Add C13 #ifdef, remove 10c, 100c vars +M models/lnd/clm/src/biogeochem/CNrestMod.F90 ------------- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 -- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 ---- Add NStateUpdate2h Nitrogen + harvesting method +M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 --------- Add C13 #ifdef +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 ------- Add C13 #ifdef and harvesting variables +M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 ---------- Add C13 #ifdef and C13Flux2h harvest + method, and CNC13HarvestPftToColumn + private method +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 ----- Add harvesting method calls + filters by lbc,ubc + Add C13 #ifdef, add CNHarvest call if + fpftdyn file is set. +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 --------- Add C13 #ifdef, remove 10c, 100c loss + vars, add harvest vars +M models/lnd/clm/src/main/clm_varcon.F90 ------------------ Add C13 #ifdef + Increase wasteheat limit to 100 W/m2 +M models/lnd/clm/src/main/CNiniTimeVar.F90 ---------------- Add C13 #ifdef + begc, endc to methods +M models/lnd/clm/src/main/accFldsMod.F90 ------------------ Put frmf and other vars (t10, t_mo, + ... agdd) in DGVM #ifdef +M models/lnd/clm/src/main/clmtypeInitMod.F90 -------------- Add C13 and DGVM #ifdef and new + harvesting vars +M models/lnd/clm/src/main/pftdynMod.F90 ------------------- Add CNHarvest and CNHarvestPftToColumn + as public methods, + add pftdyn_getharvest private methods, + check that land fractions sum to 100 + within 1e-15 rather than exactly 100, + change pftdyn_get_data to pftdyn_getdata + Add C13 #ifdef, remove 10c, 100c loss + calculation +M models/lnd/clm/src/main/iniTimeConst.F90 ---------------- Add DGVM #ifdef +M models/lnd/clm/src/main/clm_atmlnd.F90 ------------------ Add C13 #ifdef +M models/lnd/clm/src/main/lnd_comp_mct.F90 ---------------- Add C13 #ifdef +M models/lnd/clm/src/main/CNiniSpecial.F90 ---------------- Add C13 #ifdef +M models/lnd/clm/src/main/clmtype.F90 --------------------- Add DGVM, C13 #ifdef, + harvest vars +M models/lnd/clm/src/main/histFldsMod.F90 ----------------- Add C13 #ifdef, correct SEEDN, + Add: WOOD_HARVESTC, PRODUCT_CLOSS, C13_PRODUCT_CLOSS, WOOD_HARVESTN, PRODUCT_NLOSS + Change long_name: DWT_PROD10C_GAIN, DWT_PROD100C_GAIN, DWT_CLOSS, DWT_NLOSS +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 --- Add C13 #ifdef +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ------- Add C13 #ifdef + +Summary of testing: + + bluefire: hybrid and open-mp tests FAIL, pftdyn 1000 tests fail, most TBL tests FAIL as answers change +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +005 smL74 TSM.sh _sc_s clm_std^nl_urb 20020101:NONE:1800 1x1_brazil navy -10 arb_ic .............PASS +015 smB91 TSMruncase.sh .........................................................................PASS +021 smF92 TSM.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 96 cold .............PASS +022 erF92 TER.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 cold ..........PASS +023 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 cold .......PASS +029 smCA4 TSM.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +030 erCA4 TER.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......PASS +031 brCA4 TBR.sh _sc_ds clm_std^nl_urb_br 20021001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...PASS +032 blCA4 TBL.sh _sc_ds clm_std^nl_urb 20021001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +046 smCA8 TSM.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +047 blCA8 TBL.sh _sc_ds clm_std^nl_urb 20021230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +048 smNB4 TSM.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic PASS +049 erNB4 TER.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 59+100 arb_icPASS +050 brNB4 TBR.sh _mexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arb_PASS +051 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic PASS +065 smL78 TSM.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -366 arb_ic ............PASS +066 blL78 TBL.sh _sc_s clm_std^nl_urb 20021231:NONE:1800 1x1_brazil navy -10 arb_ic .............PASS +PASS ERS.f45_g35.I_2000.bluefire +PASS ERS.f19_g16.I_1850.bluefire +PASS ERS.f19_g16.I_1850-2000.bluefire +PASS ERB.f09_g16.I_1948_2004.bluefire +SFAIL ERH.f10_f10.I_1850_CN.bluefire.014926 <<< f10_f10 doesn't work for datm7 right now +PASS ERP.f19_g16.I_CN_1850-2000.bluefire + bangkok/lf95: Up to test 6 as follows +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 20030101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 20030101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +005 smA92 TSM.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 + breeze/gale/hail/gust/ifort: +001 smA74 TSM.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............PASS +002 erA74 TER.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic ..........PASS +003 brA74 TBR.sh _sc_ds clm_std^nl_urb_br 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .......PASS +004 blA74 TBL.sh _sc_ds clm_std^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............SKIPPED* +005 smD94 TSM.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................PASS +006 erD94 TER.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............PASS +007 blD94 TBL.sh _persc_ds clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................SKIPPED* +008 smCA4 TSM.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........PASS +009 blCA4 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........SKIPPED* +010 smCA8 TSM.sh _sc_ds clm_std^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...PASS +011 blCA8 TBL.sh _sc_ds clm_std^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...SKIPPED* +012 smL54 TSM.sh _sc_ds clm_std^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_41 + +Changes answers relative to baseline: Yes, urban wasteheat limit increased to 100 W/m2 + and CN changes due to harvesting + +=============================================================== +Tag name: clm3_6_41 +Originator(s): kauff,erik +Date: Fri May 29 14:15:38 MDT 2009 +One-line Summary: shrub mods, abort if nthreads > 1 (temporary, wrt bugz #965) + +Purpose of changes: fix shrub height, disable threading (due to inexact restart) + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): + - update externals for scripts and pio. + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + + - abort if num threads > 1 + main/controlMod.F90 + + - Change CNVegStructUpdateMod.F90 according to Keith Oleson for shrubs. + * First change tsai_min to be multiplied by 0.5 instead of 0.65, and + * second to lower the tapering for shrubs (types 9 and 11) to 10 with 200 for other woody plants. + + main/aerdepMod.F90 ./aerdepMod.F90 + main/clmtype.F90 ./clmtype.F90 + main/clmtypeInitMod.F90 ./clmtypeInitMod.F90 + main/decompInitMod.F90 ./decompInitMod.F90 + main/driver.F90 ./driver.F90 + main/filterMod.F90 ./filterMod.F90 + main/histFileMod.F90 ./histFileMod.F90 + main/histFldsMod.F90 ./histFldsMod.F90 + main/initializeMod.F90 ./initializeMod.F90 + main/pftdynMod.F90 ./pftdynMod.F90 + main/subgridRestMod.F90 + + biogeochem/CNAnnualUpdateMod.F90 ./CNAnnualUpdateMod.F90 + biogeochem/CNBalanceCheckMod.F90 ./CNBalanceCheckMod.F90 + biogeochem/CNEcosystemDynMod.F90 ./CNEcosystemDynMod.F90 + biogeochem/CNVegStructUpdateMod.F90 ./CNVegStructUpdateMod.F90 + + biogeophys//BalanceCheckMod.F90 ./BalanceCheckMod.F90 + biogeophys//SurfaceAlbedoMod.F90 ./SurfaceAlbedoMod.F90 + biogeophys//UrbanInputMod.F90 + +Summary of testing: + + bluefire: + PASS ERS.f45_g35.I_2000.bluefire + PASS ERS.f19_g16.I_1850.bluefire + PASS ERS.f19_g16.I_1850-2000.bluefire + PASS ERB.f09_g16.I_1948_2004.bluefire + SFAIL ERH.f10_f10.I_1850_CN.bluefire.b16+pretag + * code exact restarts when threaded but using only 1 thread + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_6_40 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu May 28 15:17:11 MDT 2009 +One-line Summary: Fix openMP bug, add fndepdyn ncl script, fix interpinic for urban, add mkharvest to mksurfdata, new spinups, turn CLAMP on for CASA or CN + +Purpose of changes: + +Fix hybrid/open-MP mode bug, and testing for hybrid/open-MP. Add ncl script to +time-interpolate between 1850 and 2000 for fndepdat dataset, for fndepdyn version. Fix +interpinic for urban and cndv (jet/oleson/slevis). Update aerdepregrid.ncl and +ndepregrid.ncl scripts. Add mkharvest fields to mksurfdata. Remove furbinp and just use +fsurdat (leave forganic, so can remove to turn off). Begin to add an option to build +with ccsm makefiles, for test-suite. Remove archiving, branching and resub from last run +script in models/lnd/clm/bld. New spin-up files for 1850 and 2000 for 1.9x2.5 and 1850 +for CN. Make sure CLAMP is turned on for either CASA or CN. Change testing years to +2002-2003 so same as for ccsm tests. + +Bugs fixed (include bugzilla ID): 954 (hybrid problem) + 959 (test suite NOT testing hybrid) + 965 (hybrid problem for high-proc count) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 966 (Hybrid restart problem on bluefire) + 967 (PIO bounds problem on jaguar) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Start adding option to build with ccsm Makefiles + + By default turn on CLAMP when either CN or CASA is enabled + +Describe any changes made to the namelist: Remove furbinp (use fsurdat) + +List any changes to the defaults for the boundary datasets: New spinup files + + clmi.IQmp17_1950-01-01_1.9x2.5_gx1v6_simyr1850_c090509.nc + clmi.IQmp17_2000-01-01_1.9x2.5_gx1v6_simyr2000_c090509.nc + clmi.BCN_0093-01-01_1.9x2.5_gx1v6_simyr1850_c090527.nc + +Describe any substantial timing or memory changes: Faster because of a fix to a I/O + write bug in datm7 + +Code reviewed by: self, forrest, mvertens, oleson, jet (relevant portions from them) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm7, csm_share + + scripts to scripts4_090527 + datm7 to datm7_090518 + csm_share to share3_090512 + +List all files eliminated: + +D models/lnd/clm/bld/build-streams -- Remove phasing out old run scripts, another + version exists in scripts/ccsm_utils/Tools/build_streams + +List all files added and what they do: + +>>>>>>>>>>>>>>>>>>>> Add harvest fields to surface datasets +A models/lnd/clm/tools/mksurfdata/mkharvestMod.F90 ------------- New module to handle harvest fields + +>>>>>>>>>>>>>>>>>>>> New files for ccsm_bld option +A models/lnd/clm/bld/config_files/Macros.yong_g95 -------------- Macro's file for my Darwin Mac-OSX laptop +A models/lnd/clm/bld/config_files/Macros.breeze_intel ---------- Macro's file for intel on breeze. +A models/lnd/clm/bld/config_files/TopCCSMBldMakefile.in -------- Top level makefile for a ccsm_bld + +>>>>>>>>>>>>>>>>>>>> New scripts to regrid all aerosol/nitrogen deposition resolutions and create + transient Nitrogen-Deposition +A models/lnd/clm/tools/ncl_scripts/runDepositionRegrid.pl ------ Run regrid for many resolutions for + aerosol and nitrogen deposition +A models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl ---------- Linearly interpolate nitrogen-deposition + between 1850 and 2000 to get + transient nitrogen deposition. + +>>>>>>>>>>>>>>>>>>>> New serial and open-MP tests +A models/lnd/clm/test/system/config_files/17p_cnexitspinupsc_do +A models/lnd/clm/test/system/config_files/17p_cnadspinupsc_do +A models/lnd/clm/test/system/config_files/17p_vodsrsc_ds + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>> Fix hybrid bug (959), some tweaks, change dates to 2002/2003 to correspond with + data checked in +M models/lnd/clm/test/system/tests-driver.sh -------------------- Add -mach option to configure, + able to set CLM_THREADS as input +M models/lnd/clm/test/system/tests_pretag_bluefire -------------- Move f19_g16 test closer to + beginning of list +M models/lnd/clm/test/system/config_files/17p_cnsc_dh ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnsc_dm ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnsc_do ----------- Turn supln off +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dh --- Turn supln on +M models/lnd/clm/test/system/config_files/17p_cnadspinupsc_dm --- Turn supln on +M models/lnd/clm/test/system/mknamelist ------------------------- Set number of threads by input CLM_THREADS +M models/lnd/clm/test/system/input_tests_master ----------------- Change all start dates to 2002/2003 to + correspond with data checked in +M models/lnd/clm/test/system/README ----------------------------- Document that can set CLM_THREADS +M models/lnd/clm/test/system/TSM.sh ----------------------------- Set number of threads by input + CLM_THREADS / handle cold start + +>>>>>>>>>>>>>>>>>>>> Add harvest fields +M models/lnd/clm/tools/mksurfdata/ncdio.F90 --------------------- Add nf_get_att_text +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ----------------- Write out harvest fields +M models/lnd/clm/tools/mksurfdata/mkvarpar.F90 ------------------ Formatting change +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ------------------ Call mkharvest_init, mkharvest, + and add harvest fields to file +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ---------- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt ----- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ---------- Point to new landuse files +M models/lnd/clm/tools/mksurfdata/Srcfiles ---------------------- Add mkharvestMod.F90 file to list + +>>>>>>>>>>>>>>>>>>>> Fix interpinic for urban +M models/lnd/clm/tools/interpinic/interpinic.F90 ---- Changes from Keith Oleson/John Truesdale to + handle urban +M models/lnd/clm/tools/interpinic/runinit_ibm.csh --- Tweak sim_years, maxpft, and start times + +>>>>>>>>>>>>>>>>>>>> Fix regrid scripts for new sim_yr +M models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl --- Add sim_yr, document better, add time coord. + variable +M models/lnd/clm/tools/ncl_scripts/ndepregrid.ncl ----- Add sim_yr, figure out file-type from it, + document better, transient files use + lowercase lat, lon instead of LAT, LON. + +>>>>>>>>>>>>>>>>>>>> Fix hybrid bug (959), deprecate old scripts +M models/lnd/clm/bld/configure ----------------- By default turn on CLAMP when either CN or CASA is enabled, + start adding ccsm_bld option, and -mach option. +M models/lnd/clm/bld/mkSrcfiles ---------------- Get it to match scripts version of same thing +M models/lnd/clm/bld/mkDepends ----------------- Get it to match scripts version of same thing, + remove Darwin kludge for assert.h (as has been renamed) +M models/lnd/clm/bld/queryDefaultXML.pm -------- Handle return characters in values +M models/lnd/clm/bld/config_files/Makefile.in -- Get rid of SGI, Nec-SX6, ES, Cray-X1 build options, + tweak Linux build +M models/lnd/clm/bld/listDefaultNamelist.pl ---- Add option to do all resolutions, correct prints +M models/lnd/clm/bld/build-namelist ------------ Add drv_in namelist "ccsm_pes" setting threads to + OMP_NUM_THREADS value, remove furbinp file +M models/lnd/clm/bld/create_newcase ------------ Document that this script is deprecated +M models/lnd/clm/bld/run-ibm.csh --------------- Remove archiving, change defaults, + add notes that script is deprecated +M models/lnd/clm/bld/README -------------------- Remove files taken out +M models/lnd/clm/bld/config_files/config_sys_defaults.xml ----- Add default mach settings +M models/lnd/clm/bld/config_files/config_definition.xml ------- Add mach and ccsm_bld settings +M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Remove furbinp, add task thread layouts + for ccsm_pe namelist +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml - Make same as datm7 version + (except using %p instead of DIN_LOC_ROOT) +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New finidat spinup files for 1.9x2.5, + 1850, 2000 and 1850-CN + +>>>>>>>>>>>>>>>>>>>> Changes from Forrest Hoffman to fix hybrid issues on jaguar (bug 954 and more) +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 -- Add lbc,ubc +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 -- Add lbc, ubc, lbp, ubp +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 -- Explicitly dimension filters to "ubp-lbp+1" + rather than ":" + +>>>>>>>>>>>>>>>>>>>> Fix hybrid issues (bug 954), add #ifdefs to clmtype so can use CLAMP with CASA, + remove CSD and USE_OMP junk +M models/lnd/clm/src/main/driver.F90 ------------------- Remove CSD directives and USE_OMP. + Add more variables to private for OMP loops + (forrest) (bug 954) + Pass array bounds to dynland_hwcontent + (mvertens) (bug 954). + Pass array bounds needed by Forrest's + biogeochem changes above. +M models/lnd/clm/src/main/decompInitMod.F90 ------------ Make a line shorter (with continue lines) +M models/lnd/clm/src/main/subgridRestMod.F90 ----------- Make a line shorter (with continue lines) +M models/lnd/clm/src/main/aerdepMod.F90 ---------------- Remove generic save statement, add save for + each data instantiation +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- Add #ifdefs from casafire branch to limit + clmtype size +M models/lnd/clm/src/main/initializeMod.F90 ------------ Remove USE_OMP and CSD directives +M models/lnd/clm/src/main/pftdynMod.F90 ---------------- #ifdef pftdyn_cnbal +M models/lnd/clm/src/main/histFileMod.F90 -------------- Remove CSD directives +M models/lnd/clm/src/main/controlMod.F90 --------------- Remove furbinp, remove UNICOSMP and SSP complexity +M models/lnd/clm/src/main/filterMod.F90 ---------------- Remove CSD directives +M models/lnd/clm/src/main/clmtype.F90 ------------------ Add #ifdefs from casafire branch to limit + clmtype size +M models/lnd/clm/src/main/histFldsMod.F90 -------------- Remove KO comments + +>>>>>>>>>>>>>>>>>>>> Fix hybrid issues (bug 954 and 965), use fsurdat instead of furbinp file for urban input +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ---- Pass in array bounds (mvertens) (bug 954) +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ------ Use fsurdat instead of separate furbinp file +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 --- Remove num_solar logic that caused an early exit + (bug 965) + +Summary of testing: + + bluefire: All PASS except +007 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +008 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 6 +011 erD91 TER.sh _persc_dh clm_per^nl_urb 20021231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 7 +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -1100 cold FAIL! rc= 8 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test@1000-1004 -100 cold FAIL! rc= 4 +017 erE91 TER.sh 4p_vodsrsc_dh clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 7 +018 brE91 TBR.sh 4p_vodsrsc_dh clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 6 +022 erF92 TER.sh 17p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 cold ..........FAIL! rc= 7 +023 brF92 TBR.sh 17p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 cold .......FAIL! rc= 6 +009 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +010 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +011 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +012 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +013 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +021 erC61 TER.sh _sc_dh clm_std^nl_urb 20021001:NONE:1800 1.9x2.5 gx1v6 10+38 cold ..............FAIL! rc= 7 +022 brC61 TBR.sh _sc_dh clm_std^nl_urb_br 20021001:NONE:1800 1.9x2.5 gx1v6 -3+-3 cold ...........FAIL! rc= 6 +025 erH51 TER.sh 17p_cnnsc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 7 +027 blH51 TBL.sh 17p_cnnsc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +029 smLI1 TSM.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +030 erLI1 TER.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +031 brLI1 TBR.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +032 blLI1 TBL.sh _sc_dh clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +036 erLD1 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:1800 2.65x3.33 USGS -5+-5 arb_ic ...........FAIL! rc= 7 +007 brJ61 TBR.sh 4p_casasc_dh clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 6 + jaguar: All PASS except +005 smA91 TSM.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 <<< bug 967 +006 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 <<< bug 967 +010 erE92 TER.sh 4p_vodsrsc_dm clm_std^nl_urb 20021230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_std^nl_urb_br 20021230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +013 smEH2 TSM.sh 4p_vodsrsc_dm clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 <<< bug 967 +014 erEH2 TER.sh 4p_vodsrsc_dm clm_std^nl_urb 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +015 brEH2 TBR.sh 4p_vodsrsc_dm clm_std^nl_urb_br 20021231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 10+38 arb_ic ......FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 96 cold .............FAIL! rc= 8 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 20020101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 <<< bug 967 +026 erJ62 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 20020101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 + lightning/pathscale: All PASS except +009 smA91 TSM.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +010 erA91 TER.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +011 brA91 TBR.sh _sc_dh clm_std^nl_urb_br 20030101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +012 blA91 TBL.sh _sc_dh clm_std^nl_urb 20030101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 4 +017 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +018 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +019 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 4 +021 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +023 erJ42 TER.sh 4p_casasc_dm clm_std^nl_urb 20021230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 7 +024 brJ42 TBR.sh 4p_casasc_dm clm_std^nl_urb_br 20021230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 6 +026 smL51 TSM.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +027 erL51 TER.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +028 brL51 TBR.sh _sc_dh clm_std^nl_urb_br 20020115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +029 blL51 TBL.sh _sc_dh clm_std^nl_urb 20020115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 4 +032 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +035 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +036 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +037 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 5 + bangkok/lf95: +024 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 +025 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +026 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 72+72 arb_ic ......FAIL! rc= 5 +028 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic .........FAIL! rc= 10 +051 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +052 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +055 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +056 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS up to the pftdyn test +016 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS@1000-1002 144 arb_ic ........FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_39 + +Changes answers relative to baseline: No bit-for-bit (unless compare cases using the new vs old spin-up files) + +=============================================================== +=============================================================== +Tag name: clm3_6_39 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu May 7 14:18:08 MDT 2009 +One-line Summary: Bug fix for script version and maxpatchpft back to numpft+1 + +Purpose of changes: Bug fixes for two issues, script version to set CLM_DEMAND="null" instead of none + And reset default maxpatch_pft=numpft+1 instead of 4 which crept in on clm3_6_38 + +Bugs fixed (include bugzilla ID): 943 (CLM_DEMAND="null") + 946 (default maxpatchpft) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Change default for maxpatch_pft back to numpft+1 + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + + scripts to scripts4_090506 (default CLM_DEMAND is null rather than none) + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/config_files/config_definition.xml ----- maxpft=numpft+1 +M models/lnd/clm/bld/namelist_files/namelist_definition.xml - Allow sim_year=1000 for test datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml Add co2_ppmv for test_yr=1000 +M models/lnd/clm/src/main/driver.F90 ------------------------ Don't write out message about dynamic pft every time-step +M models/lnd/clm/src/main/lnd_comp_mct.F90 ------------------ Set iulog for non-masterproc processors +M models/lnd/clm/test/system/input_tests_master ------------- Put year-range for pftdyn 10x15 tests + +Summary of testing: Limited + +CLM tag used for the baseline comparison tests if applicable: clm3_6_38 + +Changes answers relative to baseline: Default number of PFT's is numpft+1 instead of 4. + +=============================================================== +=============================================================== +Tag name: clm3_6_38 +Originator(s): erik (erik) +Date: Wed May 6 00:20:37 MDT 2009 +One-line Summary: New fsurdat for other resolutions, bug-fixes, deep wetlands to bedrock, new spinups for 1.9x2.5 1850, 2000 + +Purpose of changes: + +New surfdata for all resolutions, and new pftdyn test datasets (1x1 and 10x15). Make sure +furbinp/forganic/fsurdata consistent. New 1850 and 2000 spin-up for 1.9x2.5. Add in field +to restart files needed for urban interpinic. Change deep wetlands to bedrock. Remove +some output for urban and aerdep. fcov changes from Sean. Bring in history change from +Dave (so only output static 3D fields on first h0 file). Bug fix for RTM bug from Keith +O. + +Bugs fixed (include bugzilla ID): 941 (RTM output 6X too low) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 943 (CLM_DEMAND="null") + 946 (default maxpatchpft) + 974 (bug in pftdyn mode) + 977 (bug writing out 3D time-const data) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: + +Describe any changes made to the namelist: Remove step2init, add irad from datm + factorfn now null instead of unused. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: None + +Code reviewed by: swensosc, oleson, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, csm_share, +drv, datm7, mct, pio + + scripts to scripts4_090505c + drv to vocemis-drydep08_drvseq3_0_16 + datm7 to datm7_090505b + csm_share to share3_090429 + pio to pio40_prod + +List all files eliminated: Remove old run scripts, pt-urban input data + +D models/lnd/clm/test/system/nl_files/clm_urb -- remove since urban is default +D models/lnd/clm/tools/ncl_scripts/addgrid2spointurban.ncl -- only needed to create + urban pt surface datasets +D models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl - only needed to go + from 10 layer to 15 layer finidat files. +D models/lnd/clm/bld/urban_input +D models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc +D models/lnd/clm/bld/urban_input/metropolis_fluxes.nc +D models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc +D models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_tropicAtl_urb3den_simyr2000_c090320.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr2000_c090320.nc +D models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc +D models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr1850_c090317.nc +D models/lnd/clm/bld/run-pc.csh +D models/lnd/clm/bld/run-lightning.csh + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> configure defaults for everything on, update for new datm7 + new sim_year for pftdyn test datasets. New fsurdat for all + resolutions, furbinp and forganic=fsurdat. +M models/lnd/clm/bld/configure -------------------------------- document defaults +correctly +M models/lnd/clm/bld/config_files/config_definition.xml ------- defaults for: + dust: on, maxpft:numpft+1, progsslt:on, rtm:on +M models/lnd/clm/bld/listDefaultNamelist.pl ------------------- all -res all option +M models/lnd/clm/bld/clm.cpl7.template ------------------------ use defaults for + dust, progsslt, and rtm. Don't demand furbinp, or forganic +M models/lnd/clm/bld/namelist_files/namelist_definition.xml --- Remove step2init, +change defaults for factorfn, and sim_year (for test ranges 1000-1002, and 1000-1004) +M models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml Factorfn=null, rm step2init +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - New 1.9x2.5 finidat, + new fsurdat for all resolutions, +M models/lnd/clm/bld/build-namelist --------------------------- furbinp,forganic now +longer clm_demand + furbinp = fsurdat, forganic = fsurdat, fsurdat no longer need + furbinp and fpftdyn, finidat doesn't need furbinp, remove step2init +>>>>>>>>>>>>>>>> +M models/lnd/clm/src/main/aerdepMod.F90 ---------------- log output only to masterproc +M models/lnd/clm/src/main/iniTimeConst.F90 ------------- remove urban log output +M models/lnd/clm/src/main/subgridRestMod.F90 ----------- add cols1d_ityp +M models/lnd/clm/src/main/clmtypeInitMod.F90 ----------- add fsat +M models/lnd/clm/src/main/iniTimeConst.F90 ------------- make deep wetlands bedrock +M models/lnd/clm/src/main/histFileMod.F90 -------------- only write out static fields + to h0 tapes on nstep=0 +M models/lnd/clm/src/main/clmtype.F90 ------------------ add fcov and fsat +M models/lnd/clm/src/main/histFldsMod.F90 -------------- add fsat to history files +M models/lnd/clm/src/main/mkarbinitMod.F90 ------------- make wetlands bedrock +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 - make wetlands bedrock +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 ------- add fcov/fsat +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 ------ add fcov/fsat +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 --- add fcov/fsat +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 --- add fcov/fsat +M models/lnd/clm/src/riverroute/RtmMod.F90 ------------- Fix RTM bug so accumulate + during RTM intervals +>>>>>>>>>>>>>>>> Remove run-pc/run-lighning tests, remove CLMNCEP, update to beta15 + lightning no parallel gmake, no clm_demand for furbinp, change clm_urb + to clm_std, add sim_year for pftdyn tests, add serial vodsrsc tests +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/test_driver.sh --------- update to beta15, lightning gmake no parallel +M models/lnd/clm/test/system/mknamelist ------------- remove CLMNCEP option +M models/lnd/clm/test/system/TCSruncase.sh ---------- remove lightning, pc option +M models/lnd/clm/test/system/nl_files/clm_per ------- no clm_demand on furbinp +M models/lnd/clm/test/system/nl_files/clm_per0 ------ no clm_demand on furbinp +M models/lnd/clm/test/system/nl_files/clm_urb1pt ---- no clm_demand on furbinp +M models/lnd/clm/test/system/input_tests_master ----- change clm_urb to clm_std + add sim_year for pftdyn tests, add serial vodsrsc + tests +>>>>>>>>>>>>>>>> Change urban pt datasets from 1850 to 2000 sim_year. +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl + +Summary of testing: limited testing on breeze, lightning, and bangkok + + bluefire: All PASS except TBL up to test 27 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_37 + +Changes answers relative to baseline: Yes, RTM 6X higher, surface datasets different + deep wetlands now bedrock + +=============================================================== +=============================================================== +Tag name: clm3_6_37 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Mon Apr 27 23:27:26 MDT 2009 +One-line Summary: Update faerdep dataset for 1.9x2.5 to point to version cice is using for 1850 and 2000 + +Purpose of changes: Point to same version of faerdep datasets used by cice for 1.9x2.5 1850/2000 + This was needed for the ccsm4_0_beta15 tag. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: + New faerdep datasets for 1.9x2.5 used by cice (only difference is time coord) + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): scripts + scripts to scripts4_090427b + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml + +Summary of testing: None, other than build-namelist for 1.9x2.5 sim_year=1850/2000 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_36 + +Changes answers relative to baseline: Should be identical + +=============================================================== +=============================================================== +Tag name: clm3_6_36 +Originator(s): erik (erik) +Date: Mon Apr 27 14:10:13 MDT 2009 +One-line Summary: Handle transient aersol, make maxpatchpft=numpft+1 default, new datasets for 1.9x2.5 and 0.9x1.25, change doalb + +Purpose of changes: + +Changes so can do aerosol transient time-series (1850-2000) (kauff). New surfdata +datasets for 1.9x2.5 and 0.9x1.25 (1850 and 2000). New 1850-2000 pftdyn dataset for +1.9x2.5. New aerosol and ndep for 1.9x2.5 (1850 and 2000). Change to doalb from Mariana. +Make maxpatchpft=numpft+1 the default and remove all finidat files + +Bugs fixed (include bugzilla ID): 936 (create_test bug) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 935 (RTM warning NOT an error) + 937 (undef value on bangkok for maxpatchpft=numpft+1 case) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1068 (Problems interpolated deposition datasets to high res) + 1069 (Nitrogen Deposition datasets have wrong units) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: maxpatchpft default is now numpft+1 + +Describe any changes made to the namelist: build-namelist now allows 1850-2000 for sim_year for transient datasets + aerdep now chooses a transient dataset for this case as well + +List any changes to the defaults for the boundary datasets: + New aerosol deposition and nitrogen deposition datasets for 1.9x2.5 and transient + New pftdyn dataset for 1.9x2.5 for 1850-2000 + New surfdata for 1.9x2.5 and 0.9x1.25 + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, kauff (aer transient), mvertens (doalb changes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, and pio + scripts to scripts4_090424 + drv to vocemis-drydep08_drvseq3_0_14 + datm7 to datm7_090406 + pio to pio38_prod + +List all files eliminated: None + +List all files added and what they do: Add file for generic settings NOT used by a specific model component + +A models/lnd/clm/bld/namelist_files/namelist_defaults_overall.xml + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>>>>>> Add cice decomp info, use xml input file for PE change +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_10x15_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_4x5_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_1.9x2.5_dh +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_0.9x1.25_dh +M models/lnd/clm/test/system/TCT_ccsmseq.sh --- use xml file format for PE change +>>>>>>>>>>>>>>>>>>>>>>>> Base LANDMASK on SUM(PCT_PFT) rather than LANDFRAC_PFT +M models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl +>>>>>>>>>>>>>>>>>>>>>>>> Add 1850-2000 simyr option +M models/lnd/clm/bld/config_files/config_definition.xml ------ maxpatchpft default +is numpft+1 +M models/lnd/clm/bld/namelist_files/namelist_definition.xml -- Add 1850-2000 to valid sim_year values +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml - Remove finidat files, + remove data in namelist_defaults_overall, + new fsurdat,forganic,furbinp for 1.9x2.5 and 0.9x1.25 + 1850-2000 PFT dataset for 1.9x2.5 + new aerdep and ndep datasets for 1.9x2.5 and 0.9x1.25, + and transient 1850-2000 aerdep datasets +M models/lnd/clm/bld/build-namelist ----------- Be careful if datasets are picked +based on full sim_year (which could be 1850-2000) or the first year (1850 finidat, +fsurdat files) +M models/lnd/clm/bld/listDefaultNamelist.pl --- Use list of defaults files +M models/lnd/clm/bld/queryDefaultNamelist.pl -- Use list of defaults files, remove scpto option +M models/lnd/clm/bld/queryDefaultXML.pm ------- Use list of defaults files +>>>>>>>>>>>>>>>>>>>>>>>> doalb changes from Mariana Vertenstein (branches/new_doalb) +>>>>>>>>>>>>>>>>>>>>>>>> remove caldayp1 use next_swcday sent from atm +M models/lnd/clm/src/biogeochem/DGVMMod.F90 ---------- remove caldayp1, send nextsw_cday +M models/lnd/clm/src/main/clm_comp.F90 --------------- don't calcualte caldayp1, calc declinp1 based on nextsw_cday +M models/lnd/clm/src/main/driver.F90 ----------------- Pass nextsw_cday instead of caldayp1 +M models/lnd/clm/src/main/initSurfAlbMod.F90 --------- Don't pass calday and declin +M models/lnd/clm/src/main/lnd_comp_mct.F90 ----------- Remove never_doAlb logic, pass nextsw_cday down +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 - cosz based on nextsw_cday NOT caldayp1 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 --------- Do NOT pass calday, declin +>>>>>>>>>>>>>>>>>>>>>>>> aerdep changes from Brian Kauffman (cbgcdev05_clm3_6_35) +M models/lnd/clm/src/main/aerdepMod.F90 -- Time-interpolation done each time-step (rather than just each day) method slightly different. + Also allows transient file where uses first year + until reaches middle years, then after last year continues to use last year. + +Summary of testing: + + bluefire: All PASS except TBL and... up to test 62 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +038 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +039 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +040 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +042 smCA8 TSM.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 10 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_35 + +Changes answers relative to baseline: Yes -- default for maxpatchpft is numpft+1 + rather than 4 + And aersol time-interpolation is different + method is different and also does interpolation + for every time-step NOT held constant each day. + +=============================================================== +=============================================================== +Tag name: clm3_6_35 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Mon Apr 20 15:19:17 MDT 2009 +One-line Summary: Fix major logic bug in mksurfdata + +Purpose of changes: Fix major logic bug in mksurfdata (bug 934) which requires us to recreate any surface datasets + created with clm3_6_32. The bug zero'd out LAI for some PFT's and biased the LAI values + (LAI, SAI, veg-bot, veg-top). + + This is a note from dlawren + "I have taken a look at the new surface files and they look correct to me. LAI + is defined everywhere. I did a quick test using this surface dataset with a + spunup file from Keith's prior 1850 simulation and it worked fine (no errors). + I also confirmed that indeed the gridbox mean LAI is different by up to about + +-0.5. In most places the difference is below +-0.1." + + +Bugs fixed (include bugzilla ID): 934 (pftdyn logic bug) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Self (but new 1.9x2.5 surface dataset checked by dlawren and lawrence) + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/tools/ncl_scripts/pftdyntest2raw.ncl --- Create raw pftdyn test datasets, so can create new ones. + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 ---------------- Fix pftdyn logic error. +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ---------------- Move soil-text calc higher up, allow more space for filenames +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig ------ Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.pftdyn ----------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist --------- Make output in double precision +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl --------------- Get T62, 2x2.5 and qtr deg res's, only do 2000 for urban single-point +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt --- Allow larger size for filenames +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt -------- Allow larger size for filenames +M models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt -------- Allow larger size for filenames + +MM models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ----------- Add svn keywords +MM models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl - Add svn keywords +M models/lnd/clm/tools/ncl_scripts/README --------------------- Update doc on files + +Summary of testing: No testing except for mksurfdata on bluefire + +001 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................PASS +002 sm754 TSMtools.sh mksurfdata tools__s globalirrig ...........................................PASS +003 sm756 TSMtools.sh mksurfdata tools__s pftdyn ................................................PASS + +CLM tag used for the baseline comparison tests if applicable: clm3_6_34 + +Changes answers relative to baseline: no bit-for-bit (other than mksurfdata) + +=============================================================== +=============================================================== +Tag name: clm3_6_34 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Sun Apr 19 09:34:43 MDT 2009 +One-line Summary: Fix bangkok urban bug + +Purpose of changes: Fix urban bug found from bangkok testing (#927) and eliminate potential water balance error + +Bugs fixed (include bugzilla ID): 927 + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 934 (pftdyn logic bug) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself, Erik Kluzek, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 .... Change loop over all columns to filter_nourbanc +M models/lnd/clm/src/biogeophys/UrbanMod.F90 .... Change some net_solar fields from intent(out) to intent(inout). + add soilalpha_u restriction on soil evaporation/transpiration selection for pervious road (this second + change is bit for bit for all bluefire/bangkok testing, but will prevent small water balance errors in + special situations (e.g., perpetual January simulations) + +Summary of testing: + + bluefire: All PASS except: +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +072 blJ61 TBL.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 4 +082 bl744 TBLtools.sh mksurfdata tools__s namelist ..............................................FAIL! rc= 7 +084 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +086 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +088 bl756 TBLtools.sh mksurfdata tools__s pftdyn ................................................FAIL! rc= 7 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: All PASS except: +008 blA92 TBL.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +011 blD91 TBL.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 5 +033 blH52 TBL.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +037 blJ92 TBL.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold ...............FAIL! rc= 4 +041 blL51 TBL.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +048 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +049 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_33 + +Changes answers relative to baseline: No, bit for bit + +=============================================================== +=============================================================== +Tag name: clm3_6_33 +Originator(s): erik (erik) +Date: Thu Apr 16 14:45:23 MDT 2009 +One-line Summary: Bring in dynpft changes from cbgc branch + +Purpose of changes: New method for dealing with dynamic land-use changes + + morph routine casa() in casa_ecosystemDyn(), so casa is more similar to CN & DGVM, + and prepares casa code for adding additional carbon flux functionality. + Larger plan is to duplicate these and other mods from casafire branch on this branch. + Add new method for conserving heat & water wrt dynamic land use. + Conserves heat & water for any change in the land-unit, column, or pft arrangment. + when pftdyn is activated, "normalize" sum of new pft weights in a column + to be the same as the sum of the old pft weights + otherwise BalanceCheck will generate water/heat balance errors. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 927 (problem with urban on bangkok/lahey) + 934 (pftdyn logic bug) + 941 (RTM output 6X too low) + 974 (bug in pftdyn mode) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: + B. Kauffman, D. Lawrence, G. Bonan, K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: + + D biogeochem/CASASummary.F90 ................ code relocated inside CASAMod.F90 + +List all files added and what they do: + + A main/dynlandMod.F90 ............... new routine is here + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>> models/lnd/clm/src + M biogeochem/CASAMod.F90 .......... Add in CASASummary.F90, add casa_recosystemDyn subroutine + M main/pftdynMod.F90 .............. when pftdyn is active, "normalize" pft weights in a column + M biogeophys/BalanceCheckMod.F90 .. improved imbalance write statement + M main/driver.F90 ................. CASAsummary, CASAPhenology now called in + casa_ecocsystemDyn() + M main/initSurfAlbMod.F90 ......... casa() renamed casa_ecocsystemDyn() + M main/driver.F90 ......... call new routine here + M main/clmtype.F90 ......... define new fields + M main/clmtypeInitMod.F90 ......... init new fields + M main/histFldsMod.F90 ......... put new fields on hist file + M main/clm_atmlnd.F90 ......... heat imbalance is applied here + (to latent heat flux) + M riverroute/RtmMod.F90 ......... water imbalance is applied here (to runoff) + +Summary of testing: + + bluefire: All PASS except pftdyn TBL tests and ... +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: All PASS except +005 smA91 TSM.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 +010 erE92 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +013 smEH2 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 10 +014 erEH2 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 10+38 arb_icFAIL! rc= 5 +015 brEH2 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 24+24 arbFAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 96 cold .............FAIL! rc= 10 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +026 erJ62 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +038 erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................FAIL! rc= 4 +039 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + lightning/pathscale: All PASS except pftdyn TBL tests and ... +011 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 7 +012 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +018 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +019 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +020 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +022 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +023 smJ42 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 10x15 USGS 96 cold ..............FAIL! rc= 10 +024 erJ42 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 10x15 USGS 10+38 cold ...........FAIL! rc= 5 +025 brJ42 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 10x15 USGS 72+72 cold ........FAIL! rc= 5 +027 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +028 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +029 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +036 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +037 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +038 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 + bangkok/lf95: All PASS except pftdyn TBL tests and ... +005 smA92 TSM.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA92 TBR.sh _sc_dm clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 5 +030 smH52 TSM.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 96 cold .........FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS@2000 72+72 cold ...FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +038 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +048 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +049 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +CLM tag used for the baseline comparison tests if applicable: clm3_6_33 + +Changes answers relative to baseline: Only for pftdyn mode + +=============================================================== +================================================================================ +Tag name: clm3_6_32 +Originator(s): dlawren, erik, jet +Date: Fri Apr 10 14:38:52 MDT 2009 +One-line Summary: Add irrigation area to mksrfdata, fix high-res and pftdyn problems + +Purpose of changes: Add irrigation area to mksrfdat tool, for irrigated area copy PFT=15 LAI and heights + into PFT=16, PFT=15 is unirrigated crop, PFT=16 is irrigated crop + fix pftdyn mode for mksurfdata (erik), bug fixes to mksurfdata from John Truesdale + script changes to make gx1v6 default. + +Bugs fixed (include bugzilla ID): 919 (pftdyn mode in mksurfdata) + 821 (problems running mksurfdata at high-res) + 357 (codes replicated in tools) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 920 (glacier_mec problems in mksurfdata) + 926 (pftdyn code needs to be shared in mksurfdata) + 927 (problem with urban on bangkok/lahey) + 934 (pftdyn logic bug) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Building with PIO is on by default + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: gx1v6 for and 0.47 res + fix 5x5_amazon surface dataset. + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, jet, dlawren + +List any svn externals directories updated (csm_share, mct, etc.): scripts, drv, datm7, +csm_share, esmf_wrf_timemgr + + scripts to scripts4_090406 + drv to vocemis-drydep08_drvseq3_0_13 + datm7 to datm7_090403 + csm_share to share3_090407 + timemgr to esmf_wrf_timemgr_090402 + +List all files eliminated: Remove text urban input files, globalurban mksurf namelist -- +as urban is default. + +D models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +D models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt +D models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +D models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +D models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt +D models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban + +List all files added and what they do: + +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850-2005.txt . List of dynamic PFT files from 1850 to 2005 +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr1850.txt ...... Dynamic PFT file for 1850 +A models/lnd/clm/tools/mksurfdata/pftdyn_simyr2000.txt ...... Dynamic PFT file for 2000 +A models/lnd/clm/tools/mksurfdata/mkirrig.F90 ............... calculates irrigated area from irrigated area on input dataset +A models/lnd/clm/tools/mksurfdata/mksurfdata.globalirrig .... namelist file pointing to irrigated area source file +A models/lnd/clm/bld/namelist_files/namelist_defaults_datm.xml datm namelist info +A models/lnd/clm/bld/namelist_files/namelist_defaults_drv.xml drv namelist info + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Add firrig option, fix bugs, fix pftdyn mode +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 .............. Add mksrf_firrig +M models/lnd/clm/tools/mksurfdata/mklaiMod.F90 .............. Copy LAI in PFT=15 into PFT=16 if mksrf_irrig /= '' + use standard averaging for pftdyn +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ............. Add mksrf_firrig +M models/lnd/clm/tools/mksurfdata/README +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 .............. Add pct_irr to surface dataset if mksrf_irrig /= '' +M models/lnd/clm/tools/mksurfdata/Srcfiles +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 .............. Adjust PCT_PFT for non-irrigated (PFT=15) and irrigted (PFT=16) crops +M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 .............. Check for divide by zero (JT) +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 .............. Initialize files to blank +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 ............. Only output data needed for pftdyn files +M models/lnd/clm/tools/mksurfdata/mkorganic.F90 ............. Allocate bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/mkurban.F90 ............... bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/areaMod.F90 ............... bug-fix (JT) +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 .............. add mkirrig, changes for pftdyn +M models/lnd/clm/tools/mksurfdata/Srcfiles .................. add mkirrig.F90 +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 .............. if firrig => irrig/non-irrig crops +>>>>>>>>>>>>>>> Always create files using the transient input raw datasets +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist +>>>>>>>>>>>>>>> Add needed fields (mask, LANDMASK) to urban datasets +M models/lnd/clm/tools/ncl_scripts/addgrid2spointurban.ncl +>>>>>>>>>>>>>>> Turn pio on, work with defaults +M models/lnd/clm/bld/configure +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/run-ibm.csh +M models/lnd/clm/bld/clm.cpl7.template +M models/lnd/clm/bld/build-namelist +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +>>>>>>>>>>>>>>> Add mask,PCT_URBAN and LANDMASK to urban point input files +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc ..... Add mask +M models/lnd/clm/bld/urban_input/metropolis_fluxes.nc ....... Add mask +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc ..... Add mask +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc .... Add mask +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc .... Changes from Keith, add mask +>>>>>>>>>>>>>>> +M models/lnd/clm/test/system/tests_pretag_bluefire - add pftdyn test +M models/lnd/clm/test/system/test_driver.sh -------- use beta14 +M models/lnd/clm/test/system/input_tests_master ---- fix TBR tests, +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh - remove eshr +M models/lnd/clm/test/system/TSM.sh ---------------- fix +M models/lnd/clm/test/system/tests_pretag_bangkok -- put some serial tests first +M models/lnd/clm/test/system/CLM_runcmnd.sh -------- remove bluesky +>>>>>>>>>>>>>>> Always use T_REF2M NOT t_ref2m +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 + +Summary of testing: + + bluefire: All PASS except +004 blA74 TBL.sh _sc_ds clm_urb^nl_urb 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ............FAIL! rc= 5 +009 blA91 TBL.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 5 +012 blD91 TBL.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 7 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 5 +019 blE91 TBL.sh 4p_vodsrsc_dh clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ............FAIL! rc= 5 +024 blF92 TBL.sh 17p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +028 blF93 TBL.sh 17p_vodsrsc_do clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 48 cold .............FAIL! rc= 5 +032 blEH1 TBL.sh 4p_vodsrsc_dh clm_urb^nl_urb 19981231:NONE:3600 1.9x2.5^0.9x1.25 gx1v6 48 arb_ic FAIL! rc= 5 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +041 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 7 +043 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +047 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 7 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v6 48 cold .................FAIL! rc= 7 +055 blH51 TBL.sh 17p_cnnsc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 48 cold .........FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +062 blL78 TBL.sh _sc_s clm_urb^nl_urb 19971231:NONE:1800 1x1_brazil navy -10 arb_ic .............FAIL! rc= 5 +065 smL83 TSM.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 10 +066 erL83 TER.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 5 +067 brL83 TBR.sh _sc_do clm_urb^nl_urb_br 19980115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 5 +068 blL83 TBL.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 4 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +072 blJ61 TBL.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 48 cold ...........FAIL! rc= 4 +073 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....FAIL! rc= 10 +077 blJ74 TBL.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ..FAIL! rc= 5 +084 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +086 bl754 TBLtools.sh mksurfdata tools__s globalirrig ...........................................FAIL! rc= 6 +088 bl756 TBLtools.sh mksurfdata tools__s pftdyn ................................................FAIL! rc= 7 +093 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +094 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +095 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 4 +096 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 4 +097 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 4 + jaguar: ALL FAIL except +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v6 48 arb_ic .....PASS + breeze/pathscale: All PASS + bangkok/lahey: All PASS except +005 smA92 TSM.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA92 TER.sh _sc_dm clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA92 TBR.sh _sc_dm clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 144 cold .................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per^nl_urb 19981231:NONE:1200 4x5 gx3v5 72+72 cold ...............FAIL! rc= 5 +014 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 7 +030 smH52 TSM.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 96 cold .........FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS@2000 10+38 cold ......FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS@2000 72+72 cold ...FAIL! rc= 5 +034 smJ92 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 cold ...............FAIL! rc= 10 +035 erJ92 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 cold ............FAIL! rc= 5 +036 brJ92 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 cold .........FAIL! rc= 5 +038 smL51 TSM.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erL51 TER.sh _sc_dh clm_urb^nl_urb 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brL51 TBR.sh _sc_dh clm_urb^nl_urb_br 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ............FAIL! rc= 5 +052 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 8 +053 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_30 + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_31 +Originator(s): erik (erik) +Date: Wed Apr 1 00:58:15 MDT 2009 +One-line Summary: New surface datasets for 1850,2000, support for 0.9x1.25_gx1v6, urban always on. New pft-physiology file. Update scripts so remove some CLM_ env_conf vars. Fix CN for urban/pftdyn. + +Purpose of changes: + +New surface datasets for 1850,2000. sim_year can be 1850 or 2000 +(1870 no longer supported), support for 0.9x1.25_gx1v6. Demand furbinp (urban always on), +wasteheat='ON_WASTEHEAT' by default. Change cpl7 template so can either do a cold start +or require a finidat file (cold or startup). New pft-physiology file for CN used by +everything. Update scripts so remove some CLM_ env_conf vars: CLM_BGC, CLM_DYNNDEP, +CLM_DYNPFT, CLM_CO2_TYPE, remove CLMNCEP from scripts/datm (keeping CLM_QIAN mode). +Change final CN loop to go over soil filter -- so CN,CASA,DGVM can work with urban. +Remove traffic_flux array as it's subscript was out of bounds on breeze. lnd_comp_mct +changed so that check for spval allows for rounding of spval. + +Bugs fixed (include bugzilla ID): 904 (I cases start in 2003 rather than 1948) + 897 (string comparision in scripts) + 357 (remove duplicated files in tools) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 919 (problems in mksurfdata for pftdyn mode) + 920 (glacier_mec problems in mksurfdata) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Add -pio option to configure + Will set the BUILDPIO CPP token as well as adding pio source to Filepath. + +Describe any changes made to the namelist: Add pio_inparm namelist when -pio + was set in configure + +List any changes to the defaults for the boundary datasets: + New 1850 and 2000 surface datasets with urban enabled for most resolutions + Also new 1850 and 2000 finidat files for 1.9x2.5 resolution (other finidat files removed) + +Describe any substantial timing or memory changes: None + +Code reviewed by: Peter Thornton, Keith Oleson, Forrest Hoffman + +List any svn externals directories updated (csm_share, mct, etc.): scripts, datm, csm_share, mct, pio + + scripts4_090325 + datm7_090325 + vocemis-drydep11_share3_090112 + CT2_6_0_090308 + pio28_prod + +List all files eliminated: + +>>>>>>>>>>>>>> Remove DGVM namelist tests. +D models/lnd/clm/test/system/config_files/10p_dgvmsc_h +D models/lnd/clm/test/system/config_files/10p_dgvmsc_m +D models/lnd/clm/test/system/config_files/10p_dgvmsc_o +D models/lnd/clm/test/system/config_files/10p_dgvmsc_s +D models/lnd/clm/test/system/config_files/10p_dgvmsc_dh +D models/lnd/clm/test/system/config_files/10p_dgvmsc_dm +D models/lnd/clm/test/system/config_files/10p_dgvmsc_do + +>>>>>>>>>>>>>> Remove script that creates ASCII global data for urban. +D models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_urbanparam_file_p7.ncl + +>>>>>>>>>>>>>> Remove modules replicated in mkgriddata by mksurfdata modules +>>>>>>>>>>>>>> use the versions in mksurfdata. +D models/lnd/clm/tools/mkgriddata/ncdio.F90 +D models/lnd/clm/tools/mkgriddata/domainMod.F90 +D models/lnd/clm/tools/mkgriddata/areaMod.F90 + +List all files added and what they do: + +>>>>>>>>>>>>>> Add point datasets that now have urban information in them. +A models/lnd/clm/bld/urban_input/surfdata_1x1_tropicAtl_urb3den_simyr2000_c090320.nc +A models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr2000_c090320.nc +A models/lnd/clm/bld/urban_input/surfdata_1x1_brazil_urb3den_simyr1850_c090317.nc + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>> Make most tests with urban, remove dgvm tests +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/config_files/README +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/nl_files/clm_per +M models/lnd/clm/test/system/nl_files/clm_per0 +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/tests_posttag_lightning + +>>>>>>>>>>>>>> Add all_urban mode for single-point mode +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 +M models/lnd/clm/tools/mksurfdata/ncdio.F90 +M models/lnd/clm/tools/mksurfdata/mkglacier.F90 +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 +M models/lnd/clm/tools/mksurfdata/mklanwat.F90 +M models/lnd/clm/tools/mksurfdata/mkurban.F90 +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 +M models/lnd/clm/tools/mksurfdata/mksurfdata.pl +M models/lnd/clm/tools/mksurfdata/mkpftMod.F90 + +>>>>>>>>>>>>>> Add pio option to configure, and if set add pio_inparm namelist +>>>>>>>>>>>>>> Datasets to 1850/2000 and most with urban. +M models/lnd/clm/bld/configure ------------- Add pio option +M models/lnd/clm/bld/config_files/config_definition.xml - Add pio to config_cache.xml +M models/lnd/clm/bld/clm.cpl7.template ----- require furbinp, remove CLM_ env vars +M models/lnd/clm/bld/build-namelist -------- make sure sim_year sent in, change + some names etc. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ---- Add pio_inparm +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml -- Remove CLM_NCEP +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml -- urban datasets + for most resolutions, datasets for 1850 and 2000, remove most finidat + +>>>>>>>>>>>>>> Add data from grid files as well as LANDMASK and PCT_URBAN. +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc +M models/lnd/clm/bld/urban_input/metropolis_fluxes.nc +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc + +>>>>>>>>>>>>>> Changes from Forrest H./Peter T. to fix some CN problems (single-point, pftdyn) +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/main/driver.F90 +M models/lnd/clm/src/main/pftdynMod.F90 +M models/lnd/clm/src/main/lnd_comp_mct.F90 --------- Change from Mark Flanner + to fix roundoff issues for aerosols. +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------- Remove traffic_flux as subscript + bounds was being exceeded on breeze. + +Summary of testing: + + bluefire: All PASS except TBL and... +023 brF92 TBR.sh 17p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 72+72 cold ..........FAIL! rc= 13 +027 brF93 TBR.sh 17p_vodsrsc_do clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 72+72 cold ..........FAIL! rc= 13 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +065 smL83 TSM.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -10 arb_ic ............FAIL! rc= 10 +066 erL83 TER.sh _sc_do clm_urb^nl_urb 19980115:NONE:3600 5x5_amazon navy -5+-5 arb_ic ..........FAIL! rc= 5 +067 brL83 TBR.sh _sc_do clm_urb^nl_urb_br 19980115:NONE:3600 5x5_amazon navy -10+-10 arb_ic .....FAIL! rc= 5 +069 smJ61 TSM.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +070 erJ61 TER.sh 4p_casasc_dh clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +071 brJ61 TBR.sh 4p_casasc_dh clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +076 brJ74 TBR.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 13 + jaguar: All PASS except TBL and... +005 smA91 TSM.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ...................FAIL! rc= 10 +006 erA91 TER.sh _sc_dh clm_urb^nl_urb 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic ................FAIL! rc= 5 +007 brA91 TBR.sh _sc_dh clm_urb^nl_urb_br 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .............FAIL! rc= 5 +009 smE92 TSM.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ............FAIL! rc= 10 +010 erE92 TER.sh 4p_vodsrsc_dm clm_urb^nl_urb 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic .........FAIL! rc= 5 +011 brE92 TBR.sh 4p_vodsrsc_dm clm_urb^nl_urb_br 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ......FAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +025 smJ62 TSM.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 96 cold ...........FAIL! rc= 10 +026 erJ62 TER.sh 4p_casasc_dm clm_urb^nl_urb 19981230:NONE:1800 1.9x2.5 gx1v6 10+38 cold ........FAIL! rc= 5 +027 brJ62 TBR.sh 4p_casasc_dm clm_urb^nl_urb_br 19981230:NONE:1800 1.9x2.5 gx1v6 72+72 cold .....FAIL! rc= 5 +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +030 smJ74 TSM.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic .FAIL! rc= 10 +031 erJ74 TER.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic FAIL! rc= 5 +032 brJ74 TBR.sh 4p_casasc_ds clm_urb^nl_urb 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic .FAIL! rc= 5 +034 smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +035 erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +036 brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +039 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 7 + bangkok/lf95: All PASS except TBL + breeze/gale/hail/gust/ifort: All PASS + +TBL tests are different since most tests are now with urban. + +Most of the fails are due to missing files. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_30 + +Changes answers relative to baseline: Yes for CN -- new pft-physiology file + +=============================================================== +=============================================================== +Tag name: clm3_6_30 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Thu Mar 19 20:44:33 MDT 2009 +One-line Summary: Fix urban roof/wall layers + +Purpose of changes: Fix urban roof/wall layers + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Me + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/main/iniTimeConst.F90 ---- divide roof/wall thickness by nlevurb instead of nlevsoi + +Summary of testing: + + bluefire: All urban testing passed except TBL + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_29 + +Changes answers relative to baseline: Urban only + +=============================================================== +=============================================================== +Tag name: clm3_6_29 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Thu Mar 19 07:16:05 MDT 2009 +One-line Summary: CN SAI, CN testing fix, rad step size fix + +Purpose of changes: Add SAI decay for CN mode. + Fix CN for tests SmI58, smH51, erH51, brH51 + Add new get_rad_step_size function used by SAI decay function. This is the "simple fix" + and yields correct radiation time step size for all time steps except one for the I and F + cases. The "complete fix" involves changes to other component models and will be available soon. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: K. Oleson, G. Bonan, F. Hoffman, M. Vertenstein, J. Truesdale + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeochem/CNrestMod.F90 --- add seven CN fields deleted previously for restart +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 ---- add SAI decay function (calls get_rad_step_size) +M models/lnd/clm/src/main/clm_time_manager.F90 ---- changes to fix get_rad_step_size function +M models/lnd/clm/src/main/lnd_comp_mct.F90 ---- changes to fix get_rad_step_size function + +Summary of testing: + + bluefire: All PASS except: +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 4 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +055 blH51 TBL.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 48 cold ................FAIL! rc= 7 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +smH74 and blH74 failures are being investigated. +blH51 fails because it fails in clm3_6_28 (fixed in this commit). +Other failures are known. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_28 + +Changes answers relative to baseline: CN mode only due to SAI decay factor + +=============================================================== +=============================================================== +Tag name: clm3_6_28 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Tue Mar 17 07:03:12 MDT 2009 +One-line Summary: Fix permission denied error when reading surface dataset + +Purpose of changes: Change nf_open statement in UrbanInputMod.F90 + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Erik K. + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 ---- don't use getavu for nf_open + +Summary of testing: + + bluefire: All PASS except for: +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +014 blH74 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 cold ........FAIL! rc= 4 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 cold .................FAIL! rc= 5 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 10+38 cold .............FAIL! rc= 7 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 72+72 cold .............FAIL! rc= 6 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +sm74, blH74, smI58 are known failures related to CN and are being investigated. +blC61 fails because clm3_6_27 fails (fixed in this tag). +Other failures are known. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_27 + +Changes answers relative to baseline: bfb + +=============================================================== +=============================================================== +Tag name: clm3_6_27 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Mon Mar 16 10:52:05 MDT 2009 +One-line Summary: Urban model changes and FGR12 fix + +Purpose of changes: Fix large urban saturation excess runoff. + Limit urban dew formation. + Change FGR12 diagnostic. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not tested + +Code reviewed by: K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 ---- change eflx_fgr12 diagnostic +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ---- limit urban dew formation and calculate + pervious road qred over nlevsoi, not nlevurb +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ---- prevent large saturation excess due to + ponded ice + +Summary of testing: + + bluefire: All PASS tests_pretag_bluefire except TBL and : +013 smH74 TSM.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -1100 cold .......FAIL! rc= 10 +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +048 smC61 TSM.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 -6 cold .................FAIL! rc= 10 +049 erC61 TER.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 10+38 cold ..............FAIL! rc= 5 +050 brC61 TBR.sh _sc_dh clm_urb^nl_urb_br 19981001:NONE:1800 1.9x2.5 gx1v5 -3+-3 cold ...........FAIL! rc= 5 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 10+38 cold .............FAIL! rc= 7 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@2000 72+72 cold .............FAIL! rc= 6 +056 smI58 TSMcnspinup.sh 17p_cnadspinupsc_dh 17p_cnexitspinupsc_dh 17p_cnsc_dh clm_std 19980115:NONEFAIL! rc=5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + +smH74 and smI58 are CN-related tests that did not fail in clm3_6_25, but fail in clm3_6_26 and in this tag and +thus should be investigated further. +smC61, erC61, brC61 fail because of permission denied when reading surface dataset. This appears to be a test +suite problem only. + + jaguar: + kraken: + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: clm3_6_26 + +Changes answers relative to baseline: Urban answers change because of runoff fix. + Standard mode answers only change in FGR12 diagnostic. + +=============================================================== +=============================================================== +Tag name: clm3_6_26 +Originator(s): Peter Thornton +Date: 3/14/09 +One-line Summary: CN time step and restart file changes + +Purpose of changes: shorten CN restart file. Requires moving CLM to physical model timestep. + +Bugs fixed (include bugzilla ID): + +Known bugs (include bugzilla ID): + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: nonee + +Describe any substantial timing or memory changes: CLM restart file reduced in size by ~factor of 3. + +Code reviewed by: Forrest Hoffman + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all files eliminated: none + +List all files added and what they do: + + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNFireMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 - change q10 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 - remove reference to retransn +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 - change q10 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNrestMod.F90 - eliminate many CN variables +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 - change time step, and cleanup some variable names +M models/lnd/clm/src/biogeochem/CNEcosystemDynMod.F90 - change time step +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 - cleanup variable names +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 - change time step +M models/lnd/clm/src/main/CNiniTimeVar.F90 - cleanup variable names +M models/lnd/clm/src/main/driver.F90 - change time step +M models/lnd/clm/src/main/clmtypeInitMod.F90 - cleanup variable names +M models/lnd/clm/src/main/pftdynMod.F90 - change time step +M models/lnd/clm/src/main/clm_time_manager.F90 - change time step +M models/lnd/clm/src/main/clmtype.F90 - cleanup variable names +M models/lnd/clm/src/main/histFldsMod.F90 - cleanup variable names + +Summary of testing: + + bluefire: + jaguar: + Ran the CLM test suite, with the following results: +smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................PASS +erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................PASS +brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................PASS +blA74 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................SKIPPED* +smA91 TSM.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................PASS +erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 (passes with 512 tasks) +brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 (passes with 512 tasks) +blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................SKIPPED* +smE92 TSM.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ...................PASS +erE92 TER.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic ................PASS +brE92 TBR.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ................PASS +blE92 TBL.sh 4p_vodsrsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ...................SKIPPED* +smEH2 TSM.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 48 arb_ic .......PASS +erEH2 TER.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 10+38 arb_ic ....PASS +brEH2 TBR.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 24+24 arb_ic ....PASS +blEH2 TBL.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 1.9x2.5^0.9x1.25 USGS 48 arb_ic .......SKIPPED* +smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +blG43 TBL.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................SKIPPED* +smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 96 cold .............PASS +erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 10+38 cold ..........PASS +brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 72+72 cold ..........PASS +blH92 TBL.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@2000 48 cold .............SKIPPED* +smJ62 TSM.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 96 startup ...............PASS +erJ62 TER.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 10+38 startup ............PASS +brJ62 TBR.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 72+72 startup ............PASS +blJ62 TBL.sh 4p_casasc_dm clm_std 19981230:NONE:1800 1.9x2.5 gx1v5 48 startup ...............SKIPPED* +smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +smJ74 TSM.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic ........PASS +erJ74 TER.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic ......PASS +brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........PASS +blJ74 TBL.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........SKIPPED* +smK92 TSM.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 96 arb_ic ...................PASS +erK92 TER.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 10+38 arb_ic ................PASS +brK92 TBR.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 72+72 arb_ic ................PASS +blK92 TBL.sh 10p_dgvmsc_dm clm_std 19981230:NONE:1800 4x5 gx3v5 48 arb_ic ...................SKIPPED* +smLI2 TSM.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +erLI2 TER.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +brLI2 TBR.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +blLI2 TBL.sh _sc_dm clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................SKIPPED* +erP65 TSM_ccsmseq.sh ERS f19_g15 I ..........................................................PASS +erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................PASS kraken: + +Note: the tests that FAIL here are the same that FAIL on jaguar with clm3_6_25. + + lightning/pathscale: + bangkok/lf95: + breeze/gale/hail/gust/ifort: + +CLM tag used for the baseline comparison tests if applicable: + +Changes answers relative to baseline: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + q10 changes are climate changing. Time step changes are larger than roundoff, similar climate. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_6_25 +Originator(s): dlawren (Lawrence David 1384 CGD), erik (Kluzek Erik), tcraig (Craig Tony) +Date: Fri Mar 13 15:11:01 MDT 2009 +One-line Summary: Daylength control on Vcmax, 1%Lake,wetland,glacier in mksrfdat, remove ELEVATION in surface data file + +Purpose of changes: Include changes from Peter Thornton to include daylength control +on vcmax in photosynthesis scheme; Set minimum lake, wetland, and glacier area to 1% +to be more consistent with urban and to represent more lakes and wetlands; remove +temporary unused ELEVATION field from surface dataset + +Bugs fixed (include bugzilla ID): 877 (CN restart problem) + 911 (high PE count problem) + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New global urban datasets 10x15 and 1.9x2.5 resolutions + +Describe any substantial timing or memory changes: None + +Code reviewed by: David Lawrence (code), Erik Kluzek (testing and build), Tony Craig (DecompInitMod.F90) + +List any svn externals directories updated (csm_share, mct, etc.): scripts, mct, datm + + scripts to scripts4_090310 + datm7 to datm7_090229 + mct to MCT2_6_0_090308 + +List all files eliminated: None + +List all files added and what they do: + +A models/lnd/clm/test/system/config_files/tools__s ..... Optimized serial mode for tools + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/tools/mksurfdata/mkglcmec.F90 ..... correct bug in error check +M models/lnd/clm/tools/mksurfdata/mkglacier.F90 .... reduce min glacier frac from 5 to 1% +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 .... remove ELEVATION field +M models/lnd/clm/tools/mksurfdata/mklanwat.F90 ..... reduce min lake,wetland frac from 5 to 1% +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 ..... remove ELEVATION field +M models/lnd/clm/tools/mksurfdata/README ........... add documentation about being slow unless use OPT=TRUE in gmake +M models/lnd/clm/src/main/decompInitMod.F90 ........ Changes from Tony Craig to fix for high PE counts +M models/lnd/clm/src/main/clm_comp.F90 ............. daylength control on vcmax changes +M models/lnd/clm/src/main/driver.F90 ............... daylength control on vcmax changes +M models/lnd/clm/src/main/clmtypeInitMod.F90 ....... daylength control on vcmax changes +M models/lnd/clm/src/main/iniTimeConst.F90 ......... daylength control on vcmax changes +M models/lnd/clm/src/main/clmtype.F90 .............. daylength control on vcmax changes +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 daylength control on vcmax changes + +M models/lnd/clm/test/system/test_driver.sh ........ update to beta10, fix some issues on jaguar +M models/lnd/clm/test/system/input_tests_master .... do most mksurfdata testing optimized + change CN tests to cold-starts, change 1890 to 1870 + +M models/lnd/clm/bld/build-namelist ................ pass sim_year and maxpft in when determining default for finidat +M models/lnd/clm/bld/clm.cpl7.template ............. add in ignore logic like cam +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml . update input files + +Summary of testing: + + bluefire: All PASS except TBL and... +020 smE95 TSM.sh 4p_vodsrsc_h clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ....................FAIL! rc= 10 +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +052 smH51 TSM.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 96 cold ................FAIL! rc= 8 +053 erH51 TER.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 cold .............FAIL! rc= 5 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 cold .............FAIL! rc= 5 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +096 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +097 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +098 erP61 TSM_ccsmseq.sh ERS f19_g15 I4804 ......................................................FAIL! rc= 6 +099 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 6 +100 erP68 TSM_ccsmseq.sh ERS f19_g15 ICASA ......................................................FAIL! rc= 6 + jaguar: Limited testing... + lightning/pathscale: All PASS except TBL and... +002 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +003 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +004 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +006 smOC4 TSM.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +007 erOC4 TER.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_icFAIL! rc= 5 +008 brOC4 TBR.sh _vansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arb_iFAIL! rc= 5 +011 erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 +012 brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 +019 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 7 +020 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 6 +024 erJ42 TER.sh 4p_casasc_dm clm_std 19981230:NONE:1800 10x15 USGS 10+38 startup ...............FAIL! rc= 7 +025 brJ42 TBR.sh 4p_casasc_dm clm_std 19981230:NONE:1800 10x15 USGS 72+72 startup ...............FAIL! rc= 6 +027 smK51 TSM.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +028 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +029 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 5 +032 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 7 +033 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 6 +040 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +041 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +042 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804 ....................................................FAIL! rc= 5 + breeze/gale/hail/gust/ifort: All PASS except TBL + +CLM tag used for the baseline comparison tests if applicable: clm3_6_24 + +Changes answers relative to baseline: Yes + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: similar climate + + Dave Lawrence ran a short simulation to show that answers do NOT change significantly + +=============================================================== +=============================================================== +Tag name: clm3_6_24 +Originator(s): oleson (Oleson Keith 1332 CGD) +Date: Mon Mar 9 21:01:47 MDT 2009 +One-line Summary: Fix urban testing and some history field changes + +Purpose of changes: Convert urban ascii files to netcdf to get urban testing to work. + Add rh_ref2m calculation for urban and change urban/rural humidity from specific to relative in + history files. + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 672 (3.5.4-3.5.14 diffs) + 698 (cprnc bug gives false difference) + 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 722 (threading slow) + 789 (1pt sims 2.5X slow) + 794 (hist avg strange) + 821 (mksurfdata for qtr deg) + 851 (abort when files non-exist on jaguar) + 877 (CN restart problem) + 883 (aerosol deposition not from atm) + 903 (problems in driver with open-MP on PGI) + 990 (illegal instruction) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + 1087 (let weights come from fsurdat file NOT finidat) + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: None + +Describe any changes made to the namelist: In namelist_defaults_clm.xml: + Change *.txt urban files to *.nc + Change aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090119.nc to + aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090114.nc + Change path for surfdata_0096x0144_090223_v2.nc from + lnd/clm2/surfdata/ to lnd/clm2/urbdata + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Not tested + +Code reviewed by: K. Oleson + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all files eliminated: None + +List all files added and what they do: A models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.nc + A models/lnd/clm/bld/urban_input/metropolis_fluxes.nc + A models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.nc + A models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.nc + A models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.nc + +List all existing files that have been modified, and describe the changes: +M models/lnd/clm/test/system/nl_files/nl_urb ---- Remove TSNOW from hist_fincl1, remove Q2M, Q2M_R, Q2M_U and + add RH2M, RH2M_R, RH2M_U to hist_fincl2 +M models/lnd/clm/test/system/nl_files/nl_urb_br --- Remove TSNOW from hist_fincl1 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml ---- Change *.txt urban files to *.nc + Change aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090119.nc to + aerosoldep_monthly_1990s_mean_1x1_urbanc_alpha_c090114.nc + Change path for surfdata_0096x0144_090223_v2.nc from + lnd/clm2/surfdata/ to lnd/clm2/urbdata +M models/lnd/clm/src/main/clmtypeInitMod.F90 ---- delete q_ref2m_r, q_ref2m_u, and add rh_ref2m_r, rh_ref2m_u +M models/lnd/clm/src/main/clmtype.F90 ---- delete q_ref2m_r, q_ref2m_u, and add rh_ref2m_r, rh_ref2m_u +M models/lnd/clm/src/main/histFldsMod.F90 ---- delete Q2M_U, Q2M_R, and add RH2M_U, RH2M_R +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 ---- delete q_ref2m_u and add rh_ref2m_u +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ---- delete q_ref2m_u and add calculation for rh_ref2m_u +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 ---- delete q_ref2m_r and add rh_ref2m_r +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 ---- delete q_ref2m_r and add rh_ref2m_r + +Summary of testing: + + bluefire: All PASS except: +033 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +034 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +035 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +036 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +037 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +041 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +043 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +047 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +051 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 cold .................FAIL! rc= 5 +052 smH51 TSM.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..........FAIL! rc= 1 +053 erH51 TER.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic .......FAIL! rc= 1 +054 brH51 TBR.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic .......FAIL! rc= 1 +055 blH51 TBL.sh 17p_cnnsc_dh clm_std std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..........FAIL! rc= 1 +057 smLI1 TSM.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 10 +058 erLI1 TER.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -5+-5 arb_ic ......................FAIL! rc= 5 +059 brLI1 TBR.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10+-10 arb_ic ....................FAIL! rc= 5 +060 blLI1 TBL.sh _sc_dh clm_std 19980101:NONE:1800 94x192 T62 -10 arb_ic ........................FAIL! rc= 4 +090 sm9J2 TSMext_ccsmseq_cam.sh ext_ccsm_seq_0.9x1.25_dh ext_ccsm_seq_cam 48 ....................FAIL! rc= 8 +091 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +092 erP61 TSM_ccsmseq.sh ERS f19_g1 701 (svn keyword) + 698 (cprnc bug gives false difference) + 717 (archiving bug -- only archive 1000 files at a time) + 1077 (Slow leak of land aquifer to Ocean runoff) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + + Known bugs that will NOT be resolved: 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Hydrology changes (Guo-Yue Niu water table below soil column, fff=7, +Qing micropore eqs (hksat and sucsat) and Qing microporosity +-Simulation clm3_5niu5). + +Snow cover fraction (Niu and Yang); snow burial fraction for short vegetation +(Wang and Zeng); thermal and hydraulic organic soil (Lawrence); +snow compaction fix (Lawrence); snow T profile during layer splitting +fix (Lawrence); new FGR12 diagnostic. + +Ground emissivity now weighted combination (using fsno) of snow and soil +emissivity, sparse dense aerodynamic parameters from X. Zeng parameterization, +Liu (2004) saturated hydraulic conductivity and matric potential, +change saturation excess mechanism to only go to next to lowest layer, change +forcing height to min. of 40m. + +Lower volumetric soil water content to remove drainage spikes from some points +with high sand content. Change volumetric soil water content from 0.4 to 0.3. + +Incorporate hydrologically inactive deep soil (15 layers, 11-15 +hyrdologically inactive) and add mksoilcarb capability. +Change deep soil (layers 11-15) to dry rock type rather than wet sand +to reduce spinup time and for greater realism. + +Improved representation of snow-radiation interaction, including snow aging, +darkening from black carbon and dust, and vertically-resolved solar heating. + +Remove code pertaining to 40m minimum forcing height. Forcing height is now +whatever the atmospheric model provides plus z0+d of each pft. For offline +simulations this will be 30m+z0+d. + +saturation excess back to CLM3.5 parameterization. Sakaguchi litter resistance +Remove Qing Liu soil micropore functions and return to CLM3.5 formulations, +change decay factor for drainage to 2.5. remove Niu water table below soil +column formulation, frozen fraction of soil expression normalized per Zeng, +rsubmax=9.9 for drainage calculation, decay factor=0.5 for surface runoff +calculation, Zeng/Decker Richards equation mods, modified one-step solution +for soil moisture and qcharge for compatibility with Zeng/Decker Richards +mods per Swenson. + +Change input datm7 forcing so that Precip is over 6 hour interval, +times are corrected for Temp, Pres, Humid, and Wind data and linear +interpolation is used, and solar data is scaled by the cos(sol-zen angle). + +Set litter LAI = 0.5 and incorporate Swenson organic/mineral soil hk +percolation theory + +CASA changes from Forrest Hoffman: + + These changes add SOILPSI to the CASA' + configuration, correct units on C-LAMP carbon pool type fluxes, and reclassify + microbial pools as soil type pools. I believe this includes all modifications + between bgcmip04_clm3_expa_60 and bgcmip08_clm3_expa_72. + +Summary of CN and Btran changes from Sam Levis: + +- CanopyFluxes modification in the calculation of btran so that it equals 0 in soil layers with temperature <=-2 C. +- CN mods recommended by Peter Thornton and the BGCWG during the bgc development phase of the last few months. + +Grassland AND CROP optical properties changes from Keith Oleson: + +New pft physiology file was created: + +pft-physiology.c081002 + +Description of changes to physiology file: + +New leaf and stem optical properties (VIS and NIR reflectance and transmittance) +were derived for grasslands and crops (pfts 12-16) from full optical range +spectra of measured optical properties (Asner et al. (RSE 1998). + +New properties are: + + Leaf Stem + VIS NIR VIS NIR +Reflectance 0.11 0.35 0.31 0.53 +Transmittance 0.05 0.34 0.12 0.25 + + +Describe any changes made to build system: + + Add SNICAR_FRC and CARBON_AERO ifdef tokens + + DEFINE option SNICAR_FRC: enables second radiative transfer calculation of pure snow for radiative forcing estimation + + in configure use options -carbon_aero and -snicar_frc + +Describe any changes made to the namelist: Add fsnowoptics, fsnowaging, faerdep + +Added namelist variables fsnowoptics, fsnowaging, and faerdep, which point to files containing, respectively, snow/aerosol optical properties, snow aging parameters, and global aerosol deposition file. THESE FILES ARE REQUIRED. + +List any changes to the defaults for the boundary datasets: + + finidat files developed, all new fsurdat files, new pft-physiology, + files for T62, new organic files, new files for SNICAR (fsnowoptics, + fsnowaging, faerdep), fix some inconsistencies with fraction files, + get topo files setup correctly, get all files for 4x5 and 2x2.5 resolution + +Describe any substantial timing or memory changes: Yes + 20% slower because of SNICAR and slower because of deep soil + +Code reviewed by: Keith Oleson, Mark Flanner, Dave Lawrence, + Peter Thornton, Sam Levis, Sean Swenson + +List any svn externals directories updated (csm_share, mct, etc.): scripts, + drv, datm7, socn, sice, sglc, csm_share, timing, pio, cprnc + ++scripts scripts4_090112 ++models/drv/seq_mct drvseq3_0_04 ++models/atm/datm7 datm7_090107 ++models/ocn/socn stubs1_1_01/socn ++models/ice/sice stubs1_1_01/sice ++models/glc/sglc stubs1_1_01/sglc ++models/csm_share share3_090112 ++models/utils/timing timing_081028 ++models/utils/pio pio28_prod/pio ++models/lnd/clm/tools/cprnc cprnc_081022 + +List all files eliminated: + +D models/lnd/clm/test/system/tests_pretag_bluevista - remove +D models/lnd/clm/bld/scpDefaultNamelist.pl ---------- replace with listDefaultNamelist.pl +D models/lnd/clm/bld/run-frost.csh ------------------ remove as can use cpl7 +D models/lnd/clm/tools/interpinic/clmi_1999-01-02_10x15_c070330.nc -- new file + +List all files added and what they do: + +A + models/lnd/clm/test/system/nl_files/clm_organic ------------ test organic +A + models/lnd/clm/tools/mksurfdata/mkorganic.F90 -------------- add organic to surfdat +A + models/lnd/clm/tools/mksurfdata/mksurfdata.pl -------------- create all fsurdat files +A + models/lnd/clm/tools/ncl_scripts/aerdepregrid.ncl ---------- interpolate aerosol deposition +A + models/lnd/clm/tools/ncl_scripts/clmi_increasesoillayer.ncl interpolate old clmi files to 15 soil levels +A + models/lnd/clm/tools/interpinic/clmi.IQ.1953-01-01_10x15_USGS_simyr2000_c081202.nc + ---------------- new 15 layer file to test interpolation +A + models/lnd/clm/tools/interpinic/runinit_ibm.csh ------------ create all finidat files +A + models/lnd/clm/bld/listDefaultNamelist.pl ------------------ list inputdata files needed +A + models/lnd/clm/src/main/organicFileMod.F90 ----------------- organic soil +A + models/lnd/clm/src/main/aerdepMod.F90 ---------------------- read in aerosol deposition +A + models/lnd/clm/src/biogeophys/SNICARMod.F90 ---------------- SNICAR model +A + Quickstart.GUIDE ------------------------------------------- Quickstart to cpl7 scripts + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>>>>>>>>>>>> Add compile_only option, fix smp/spmd, change most +>>>>>>>>>>>>>>>>>>>>>>>>> tests to 4x5 resolution, update ccsm version, +>>>>>>>>>>>>>>>>>>>>>>>>> remove bluevista, change to clm_qian inputdata +>>>>>>>>>>>>>>>>>>>>>>>>> add cold start type + +M models/lnd/clm/test/system/TCB.sh +M models/lnd/clm/test/system/config_files/4p_vodsrsc_dm +M models/lnd/clm/test/system/config_files/4p_vodsrsc_do +M models/lnd/clm/test/system/config_files/scam_ds ----- fix defaults for scam +M models/lnd/clm/test/system/config_files/17p_cnnsc_o +M models/lnd/clm/test/system/config_files/4p_casasc_dm +M models/lnd/clm/test/system/config_files/10p_dgvmsc_o +M models/lnd/clm/test/system/config_files/4p_casasc_do +M models/lnd/clm/test/system/config_files/4p_casasc_o +M models/lnd/clm/test/system/config_files/17p_vodsrsc_o +M models/lnd/clm/test/system/config_files/17p_cnnsc_dm +M models/lnd/clm/test/system/config_files/17p_cnnsc_do +M models/lnd/clm/test/system/config_files/10p_dgvmsc_dm +M models/lnd/clm/test/system/config_files/10p_dgvmsc_do +M models/lnd/clm/test/system/config_files/17p_vodsrsc_dm +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/config_files/17p_vodsrsc_do +M models/lnd/clm/test/system/config_files/4p_vodsrsc_o +M models/lnd/clm/test/system/TSMncl_tools.sh +M models/lnd/clm/test/system/CLM_compare.sh +M models/lnd/clm/test/system/TBL.sh +M models/lnd/clm/test/system/TSM_ccsmseq.sh +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_posttag_kraken +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_breeze +M models/lnd/clm/test/system/tests_pretag_bangkok +M models/lnd/clm/test/system/TBR.sh +M models/lnd/clm/test/system/TCBtools.sh +M models/lnd/clm/test/system/TER.sh +M models/lnd/clm/test/system/test_driver.sh +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/mknamelist +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/TCT_ccsmseq.sh +M models/lnd/clm/test/system/TCSruncase.sh +M models/lnd/clm/test/system/TSMpergro.sh +M models/lnd/clm/test/system/nl_files/clm_per +M models/lnd/clm/test/system/nl_files/clm_urb +M models/lnd/clm/test/system/nl_files/clm_std +M models/lnd/clm/test/system/nl_files/clm_ndepdyn +M models/lnd/clm/test/system/nl_files/clm_pftdyn +M models/lnd/clm/test/system/nl_files/clm_per0 +M models/lnd/clm/test/system/TSMcnspinup.sh +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/TSMtools.sh +M models/lnd/clm/test/system/TSMruncase.sh +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh +M models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/CLM_runcmnd.sh +M models/lnd/clm/test/system/TBLtools.sh +M models/lnd/clm/test/system/TSM.sh + +>>>>>>>>>>>>>>>>>>>>>>>>> Add organic add option to output as double precision +>>>>>>>>>>>>>>>>>>>>>>>>> be more careful with averging add error checking +M models/lnd/clm/tools/mksurfdata/mkvarctl.F90 +M models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban +M models/lnd/clm/tools/mksurfdata/mksurfdata.regional +M models/lnd/clm/tools/mksurfdata/mkfileMod.F90 +M models/lnd/clm/tools/mksurfdata/Makefile ----------- -Kieee for pgi +M models/lnd/clm/tools/mksurfdata/mksurfdata.singlept +M models/lnd/clm/tools/mksurfdata/mksrfdat.F90 +M models/lnd/clm/tools/mksurfdata/Srcfiles +M models/lnd/clm/tools/mksurfdata/mksurfdata.namelist + +>>>>>>>>>>>>>>>>>>>>>>>>> 15 levels for urban +MM models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_urbanparam_file_p7.ncl +M models/lnd/clm/tools/ncl_scripts/README + +>>>>>>>>>>>>>>>>>>>>>>>>> Change for 15 levels and new variables/dims on dataset +M models/lnd/clm/tools/interpinic/interpinic.F90 +M models/lnd/clm/tools/interpinic/interpinic.runoptions +M models/lnd/clm/tools/interpinic/Srcfiles +M models/lnd/clm/tools/interpinic/Filepath +M models/lnd/clm/tools/interpinic/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> 10x15 resolution, start to resolve domain checking bug +M models/lnd/clm/tools/mkgriddata/mkgriddata.namelist +M models/lnd/clm/tools/mkgriddata/mkgriddata.F90 +M models/lnd/clm/tools/mkgriddata/domainMod.F90 +M models/lnd/clm/tools/mkgriddata/creategridMod.F90 +M models/lnd/clm/tools/mkgriddata/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> Get grid data from grid files rather than frac files +M models/lnd/clm/tools/mkdatadomain/mkdatadomain.namelist +M models/lnd/clm/tools/mkdatadomain/addglobal.F90 +M models/lnd/clm/tools/mkdatadomain/create_domain.F90 +M models/lnd/clm/tools/mkdatadomain/Makefile + +>>>>>>>>>>>>>>>>>>>>>>>>> minor changes to build, new datasets for build-namelist +M models/lnd/clm/bld/configure --- add -snicar_frc and -carbon_aero, add sglc, remove timing for cpl7 +M models/lnd/clm/bld/queryDefaultNamelist.pl --- minor change +M models/lnd/clm/bld/config_files/Makefile.in -- add HAVE_GETTIMEOFDAY for new timing, more consistent with cpl7 build +M models/lnd/clm/bld/config_files/config_definition.xml -- add snicar_frc and carbon_aero +M models/lnd/clm/bld/clm.cpl7.template -- simplify update for new scripts +M models/lnd/clm/bld/README ------------- update info. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml ----- add new namelist items remove irad +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml --- new Qian datasets +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- new defaults +M models/lnd/clm/bld/build-namelist + +>>>>>>>>>>>>>>>>>>>>>>>>> change default resolution to 4x5 remove irad +M models/lnd/clm/bld/run-pc.csh +M models/lnd/clm/bld/run-ibm.csh +M models/lnd/clm/bld/run-lightning.csh + +>>>>>>>>>>>>>>>>>>>>>>>>> New 15 layer urban single point datasets +M models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt + +>>>>>>>>>>>>>>>>>>>>>>>>> Code changes documented above +M models/lnd/clm/src/biogeochem/CASASummaryMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/DGVMEcosystemDynMod.F90 +M models/lnd/clm/src/biogeochem/CNBalanceCheckMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNFireMod.F90 +M models/lnd/clm/src/biogeochem/CNMRespMod.F90 +M models/lnd/clm/src/biogeochem/CASAMod.F90 +M models/lnd/clm/src/biogeochem/CNPrecisionControlMod.F90 +M models/lnd/clm/src/biogeochem/CNSummaryMod.F90 +M models/lnd/clm/src/biogeochem/DUSTMod.F90 +M models/lnd/clm/src/biogeochem/CNPhenologyMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/CNDecompMod.F90 +M models/lnd/clm/src/biogeochem/STATICEcosysDynMod.F90 +M models/lnd/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate1Mod.F90 +M models/lnd/clm/src/biogeochem/DGVMMod.F90 +M models/lnd/clm/src/biogeochem/CNrestMod.F90 +M models/lnd/clm/src/biogeochem/CNC13StateUpdate3Mod.F90 +M models/lnd/clm/src/biogeochem/CNAnnualUpdateMod.F90 +M models/lnd/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +M models/lnd/clm/src/biogeochem/C13SummaryMod.F90 +M models/lnd/clm/src/biogeochem/CNNDynamicsMod.F90 +M models/lnd/clm/src/biogeochem/CNAllocationMod.F90 +M models/lnd/clm/src/biogeochem/CNC13FluxMod.F90 +M models/lnd/clm/src/biogeochem/CNSetValueMod.F90 +M models/lnd/clm/src/biogeochem/CNVegStructUpdateMod.F90 +M models/lnd/clm/src/main/inicFileMod.F90 +M models/lnd/clm/src/main/clm_varcon.F90 +M models/lnd/clm/src/main/clm_varpar.F90 +M models/lnd/clm/src/main/CNiniTimeVar.F90 +M models/lnd/clm/src/main/clm_comp.F90 +M models/lnd/clm/src/main/driver.F90 +M models/lnd/clm/src/main/ncdio.F90 +M models/lnd/clm/src/main/fileutils.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/pftdynMod.F90 +M models/lnd/clm/src/main/iniTimeConst.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/clm_atmlnd.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSurfAlbMod.F90 +M models/lnd/clm/src/main/clm_time_manager.F90 +M models/lnd/clm/src/main/filterMod.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/lnd_comp_mct.F90 +M models/lnd/clm/src/main/CASAiniTimeVarMod.F90 +M models/lnd/clm/src/main/areaMod.F90 +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/mkarbinitMod.F90 +M models/lnd/clm/src/riverroute/RtmMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceRadiationMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/biogeophys/SnowHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 +M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 +M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 +M models/lnd/clm/src/biogeophys/UrbanMod.F90 +M models/lnd/clm/src/biogeophys/DriverInitMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +>>>>>>>>>>>>>>>>>>>>>>>>> update documentation +M README -------------- update information +M KnownBugs ----------- add info on new known bugs + +Summary of testing: + + bluefire: All PASS except TBL and ... + +031 smF96 TSM.sh 17p_vodsrsc_m clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ...................FAIL! rc= 10 +036 smF96 TSM.sh 17p_vodsrsc_m clm_std 19981231:NONE:1800 4x5 gx3v5 48 arb_ic ...................FAIL! rc= 2 +013 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +015 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +019 blNB4 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +020 smC61 TSM.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 -6 arb_ic ...............FAIL! rc= 10 +021 erC61 TER.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 10+38 arb_ic ............FAIL! rc= 5 +022 brC61 TBR.sh _sc_dh clm_urb^nl_urb_br 19981001:NONE:1800 1.9x2.5 gx1v5 -3+-3 arb_ic .........FAIL! rc= 5 +023 blC61 TBL.sh _sc_dh clm_urb^nl_urb 19981001:NONE:1800 1.9x2.5 gx1v5 48 arb_ic ...............FAIL! rc= 4 +024 smH91 TSM.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 96 startup ..........FAIL! rc= 10 +025 erH91 TER.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 10+38 startup .......FAIL! rc= 5 +026 brH91 TBR.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 72+72 startup .......FAIL! rc= 5 +027 blH91 TBL.sh 17p_cnnsc_dh clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 48 startup ..........FAIL! rc= 4 +029 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 13 +030 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 11 +031 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..............FAIL! rc= 7 + + lightning/pathscale: all PASS except TBL and ... + +009 blCA4 TBL.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA8 TBL.sh _sc_ds clm_urb^nl_urb 19971230:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +017 blOC4 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 erA91 TER.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 7 +020 brA91 TBR.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -3+-3 arb_ic .......................FAIL! rc= 6 +021 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -6 arb_ic ..........................FAIL! rc= 5 +027 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 7 +028 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 6 +029 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 5 +031 smH52 TSM.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..............FAIL! rc= 10 +032 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 5 +033 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 5 +034 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 48 arb_ic ..............FAIL! rc= 4 +036 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 7 +037 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 6 +001 smL51 TSM.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 96 arb_ic .........................FAIL! rc= 10 +002 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 5 +003 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 5 +004 blL51 TBL.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 48 arb_ic .........................FAIL! rc= 4 +005 sm674 TSMtools.sh mkgriddata tools__ds singlept .............................................FAIL! rc= 6 +006 sm774 TSMtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 6 +007 bl774 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 +010 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +011 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +012 erP91 TSM_ccsmseq.sh ERS f45_g35 ICN4804Q ...................................................FAIL! rc= 4 + + jaguar: ALL PASS except TBL and .... + +001 smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 10 +002 erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +003 brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +013 smE32 TSM.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 48 arb_ic .........FAIL! rc= 10 +014 erE32 TER.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 10+38 arb_ic ......FAIL! rc= 5 +015 brE32 TBR.sh 4p_vodsrsc_dm clm_std 19981231:NONE:3600 64x128^360x720 USGS 24+24 arb_ic ......FAIL! rc= 5 +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ................FAIL! rc= 5 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +021 smH92 TSM.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 96 startup ..........FAIL! rc= 10 +022 erH92 TER.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 10+38 startup .......FAIL! rc= 5 +023 brH92 TBR.sh 17p_cnnsc_dm clm_ndepdyn 19980101:NONE:1800 4x5 gx3v5@1890 72+72 startup .......FAIL! rc= 5 +029 smJ05 TSM.sh 4p_casasc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5 48 startup ....FAIL! rc= 10 +030 smJ74 TSM.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -1100 arb_ic ........FAIL! rc= 10 +031 erJ74 TER.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -10+-10 arb_ic ......FAIL! rc= 5 +032 brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........FAIL! rc= 5 +038 smL62 TSM.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 10 +039 erL62 TER.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -5+-5 startup ...................FAIL! rc= 5 +040 brL62 TBR.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10+-10 startup .................FAIL! rc= 5 + + breeze/gale/hail/gust/ifort: All PASS except TBL and... + + bangkok: All PASS except TBL and.. + +005 smA74 TSM.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 10 +006 erA74 TER.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +007 brA74 TBR.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -5+-5 arb_ic .................FAIL! rc= 5 +009 smD91 TSM.sh _persc_dh clm_per 19981231:NONE:1200 4x5 gx3v5 144 startup .....................FAIL! rc= 10 +010 erD91 TER.sh _persc_dh clm_per 19981231:NONE:1200 4x5 gx3v5 72+72 startup ...................FAIL! rc= 5 +013 smCA4 TSM.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 10 +014 erCA4 TER.sh _sc_ds clm_urb^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -45+-45 arb_ic ......FAIL! rc= 5 +015 brCA4 TBR.sh _sc_ds clm_urb^nl_urb_br 19981001:NONE:3600 1x1_camdenNJ navy -10+-10 arb_ic ...FAIL! rc= 5 +017 smOC4 TSM.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 10 +018 erOC4 TER.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 115+115 arb_icFAIL! rc= 5 +019 brOC4 TBR.sh _vansc_ds clm_urb1pt^nl_urb_br 19920812:NONE:3600 1x1_vancouverCAN navy 72+72 arb_iFAIL! rc= 5 +021 smNB4 TSM.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 10 +022 erNB4 TER.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 59+100 arb_icFAIL! rc= 5 +023 brNB4 TBR.sh _mexsc_ds clm_urb1pt^nl_urb_br 19931201:NONE:3600 1x1_mexicocityMEX navy 72+72 arb_FAIL! rc= 5 +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +030 smH52 TSM.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 96 arb_ic ..............FAIL! rc= 10 +031 erH52 TER.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 10+38 arb_ic ...........FAIL! rc= 5 +032 brH52 TBR.sh 17p_cnnsc_dm clm_std 19980115:NONE:1800 10x15 USGS@1890 72+72 arb_ic ...........FAIL! rc= 5 +038 smK51 TSM.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 96 arb_ic ..................FAIL! rc= 10 +039 erK51 TER.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 10+38 arb_ic ...............FAIL! rc= 5 +040 brK51 TBR.sh 10p_dgvmsc_dh clm_std 19981230:NONE:1800 10x15 USGS 72+72 arb_ic ...............FAIL! rc= 5 +042 smL51 TSM.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 96 arb_ic .........................FAIL! rc= 10 +043 erL51 TER.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 10+38 arb_ic ......................FAIL! rc= 5 +044 brL51 TBR.sh _sc_dh clm_std 19980115:NONE:1800 10x15 USGS 72+72 arb_ic ......................FAIL! rc= 5 +046 smL58 TSM.sh _sc_dh clm_std^nl_crcrop 19980115:NONE:1800 10x15 USGS 96 arb_ic ...............FAIL! rc= 10 +047 smL74 TSM.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -10 arb_ic ....................FAIL! rc= 10 +048 erL74 TER.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -5+-5 arb_ic ..................FAIL! rc= 5 +049 brL74 TBR.sh _sc_s clm_std 19980101:NONE:1800 1x1_brazil navy -10+-10 arb_ic ................FAIL! rc= 5 +051 sm654 TSMtools.sh mkgriddata tools__ds namelist .............................................FAIL! rc= 6 +052 sm853 TSMtools.sh interpinic tools__o runoptions ............................................FAIL! rc= 6 +053 sm854 TSMtools.sh interpinic tools__ds runoptions ...........................................FAIL! rc= 6 +057 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 +Changes answers relative to baseline: Yes! Changes climate + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change (new climate) + - configuration (CPP ifdefs): All + - build-namelist command (or complete namelist): + + MSS location of control simulations used to validate new climate: + + Grass optical properties: /OLESON/csm/clm36sci16_clm3_6_11shklit0_5sfc_goa + + ccsm4_0_beta05: /CCSM/csm/b40.018 + + URL for LMWG diagnostics output used to validate new climate: + +ccsm4_0_beta05 (with clm36sci27_clm3_6_14) + +http://www.cgd.ucar.edu/cdp/mai/ccsmweb/b40.018-b40.017/setsIndex.html + +http://www.cgd.ucar.edu/tss/clm/diagnostics/clm4.0_dev/clm36sci16_clm3_6_11shklit0_5sfc_goa-clm36sci16_clm3_6_11shklit0_5sfca/setsIndex.html + +=============================================================== +=============================================================== +Tag name: clm3_6_14 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Oct 10 11:32:57 MDT 2008 +One-line Summary: Fix some global urban issues, fix pftdyn, really get compile-only option working in testing + +Purpose of changes: Fix column and pft averaging for urban (crtical for coupling to cam) (from Keith) + Fix Qanth (was wasteheat previously) (from Keith) + Fix so that pftdyn works (fix from Sam) + Really get the compile-only option working in test-suite + (so that doesn't re-compile, but does re-run, when sent again) + +Bugs fixed (include bugzilla ID): 826 (pftdyn) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), 830 (missing C-LAMP mods) + 680 (t0 precip diff for seq-ccsm), 789 (pt sims slower than offline) + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 833 (bug with cam in ccsm4_0_alpha37), 722 (threading slow) + 832 (problem with cice bn in ccsm4_0_alpha37) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, oleson, slevis (Sam provided pftdyn fix, and Keith provided urban fixes) + +List any svn externals directories updated (csm_share, mct, etc.): scripts and drv + + scripts to scripts4_081009 + drv to drvseq2_0_33 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>> Change so that pftdyn will work, do urban averaging, and fix Qanth + M models/lnd/clm/src/main/clm_atmlnd.F90 -------------- Make averaging take into account urban (critical for global urban modeling) + M models/lnd/clm/src/main/histFldsMod.F90 ------------- Add urban scaling, fix Qanth + M models/lnd/clm/src/main/filterMod.F90 --------------- Change urban filter to include pftwgt>0 + M models/lnd/clm/src/biogeophys/SurfaceAlbedoMod.F90 -- Change filter_vegsol to include pftwgt>0 +>>>>>>>>>>> Fix so that compile-only option leaves compiled program there, doesn't recompile, but does rerun + M models/lnd/clm/test/system/TCB.sh + M models/lnd/clm/test/system/TSMncl_tools.sh + M models/lnd/clm/test/system/TBL.sh + M models/lnd/clm/test/system/TSM_ccsmseq.sh + M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh + M models/lnd/clm/test/system/TBR.sh + M models/lnd/clm/test/system/TCBtools.sh + M models/lnd/clm/test/system/test_driver.sh + M models/lnd/clm/test/system/TER.sh + M models/lnd/clm/test/system/TCT_ccsmseq.sh + M models/lnd/clm/test/system/TSMpergro.sh + M models/lnd/clm/test/system/TSMcnspinup.sh + M models/lnd/clm/test/system/TSMtools.sh + M models/lnd/clm/test/system/TSMruncase.sh + M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh + M models/lnd/clm/test/system/CLM_runcmnd.sh + M models/lnd/clm/test/system/TSM.sh + +Summary of testing: + + bluefire: All PASS except +071 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguar: All PASS + bangkok/lf95: All PASS except +028 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 5 +054 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 6 +055 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +pftdyn TBL test fails, because pftdyn did not work in previous tag. +cam and scam tests fail because of bugs 832 and 833 in ccsm4_0_alpha37 + +CLM tag used for the baseline comparison tests if applicable: clm3_6_13 + +Changes answers relative to baseline: No -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_6_13 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Wed Oct 1 13:33:36 MDT 2008 +One-line Summary: Update to new version of cpl7 scripts and build, update externals for versions needed for clm36sci branch, add new CASA tests + +Purpose of changes: Update to new version of cpl7 scripts and build. + Update externals for versions needed on clm36sci branch. + Add new CASA tests. + Add $CLM_ACCOUNT as option to test_driver.sh + Add single point capability to cpl7 scripts. + Add CLM_DEMAND, CLM_BLD_NL_OPTIONS as options to cpl7 scripts. + Some code changes from Keith Oleson to fix a CASA startup problem. + +Code changes from Keith Oleson + +1. Volumetric soil water check in BiogeophysRestMod changed so that it accounts for ponded ice/water +that may be present in surface layer. If volumetric soil water is above saturation, h2osoi_liq +and h2osoi_ice are reduced according to their proportion of total water/ice. Both h2osoi_liq +and h2osoi_ice are limited to be no lower than watmin (currently 0.01_r8 mm). All this done for +soil points only. + +2. In SoilHydrologyMod, variable su changed to: + + su = max(0._r8,(s1-fcov(c)) / max(0.01_r8,1._r8-fcov(c)) + +to account for the fact that fcov could be one and hence divide by zero could have occurred. +Also, the factor "1._r8" multiplying fcov in the numerator was removed. + +3. watmin made a global parameter available from clm_varcon + +Bugs fixed (include bugzilla ID): 805 (too much output in build-streams), 801 (G95 in csm_Share), + 786 (dshr_map bug), 834 (CASA startup bug), + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 826 (pftdyn), 833 (bug with cam in ccsm4_0_alpha37) + 832 (problem with cice bn in ccsm4_0_alpha37) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Update to new ccsm4_0_alpha37 scripts + + New options in cpl7 scripts: CLM_DEMAND, CLM_BLD_NL_OPTIONS + + CLM_DEMAND: List of output variables to require be set in namelist + For example, set to "furbinp" to use urban grid. + CLM_BLD_NL_OPTIONS: List of options to pass to clm build-namelist. + + New grid in cpl7 scripts: pt1_pt1 (also set CLM_PT1_NAME) for single point sims + + Add ability to set "none" in clm build-namelist -clm_dmand option. + +Quickstart to new cpl7 scripts... + + New cpl7 namelists now do two things for you. + - Add a ton of error checking at each step -- so it won't let you do something you aren't allowed to + - Only show you the variables that you could actually set in your case. + + To accomplish this we use XML files rather than cshell env files. But, the + operation sequence is similar with options only changed slightly. + + cd scripts + ./create_newcase -help # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g15 -compset I # create new "I" case for bluefire at 1.9x2.5_gx1v5 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + ./xmlchange -help # Get help on editor for XML files + ./xmlchange env_conf.xml env_mach_pes # Edit configure files if needed + configure -case # create scripts + ./xmlchange env_build.xml # Edit build files if needed + testI.build # build model and create namelists + ./xmlchange env_run.xml # Edit run files if needed + bsub < testI.run # submit script + # (NOTE: edit env_run.xml to set RESUBMIT to number of times to automatically resubmit) + + Note that the -skip_rundb option to create_newcase no longer needs the argument of "NONE". + Syntax of create_tests changed to only one form. + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik, oleson and dlawren (source code changes) + +List any svn externals directories updated (csm_share, mct, etc.): drv, csm_share, datm7, and scripts + + csm_share, datm7 and scripts include changes required for the clm36sci branch. + + scripts to scripts4_080930 + drv to drvseq2_0_32 + datm7 to datm7_080926 + csm_share to share3_080929 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>> Add $CLM_ACCOUNT env var, change tests around, update to ccsm4_0_alpha37 + add some more CASA tests. +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_posttag_kraken +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/test_driver.sh ------------------ Add $CLM_ACCOUNT env var + update to ccsm4_0_alpha37 +M models/lnd/clm/test/system/input_tests_master -------------- Add CASA 1.9x2.5 tests +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh ----------- Separate call to cice bn +M models/lnd/clm/test/system/TCT_ccsmseq.sh +M models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh ----------- Need to set threads/tasks +M models/lnd/clm/test/system/TSM.sh -------------------------- Remove old namelist name + +>>>>>>>>>>>>>> Update for new scripts +M models/lnd/clm/bld/clm.cpl7.template ----------------------- Straighten out clm_demand + Add new env vars. Remove prestaging. +M models/lnd/clm/bld/namelist_files/namelist_definition.xml -- Update to alpha37 +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml- Add file for clm36sci branch +M models/lnd/clm/bld/build-namelist -------------------------- Allow clm_demand to include none. + +>>>>>>>>>>>>>> These are Keith's changes to fix bug 834. They do make it possible for + answers to change, but in most cases they don't. It allows code to + startup correctly for situations it might fail in, and sets a mininum + value in SoilHydrologyMod to guard against divide by zero. This would + change answers when amount of ice -- fcov > 0.99 -- which would be rare. +M models/lnd/clm/src/main/clm_varcon.F90 +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 + +Summary of testing: + + bluefire: All PASS except +042 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +043 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +044 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +045 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +P +046 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +079 blL61 TBL.sh _sc_h clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +083 blL62 TBL.sh _sc_m clm_std 19980101:NONE:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +107 brJ74 TBR.sh 4p_casasc_ds clm_std 10001230:NONE:3600 1x1_tropicAtl test -3+-3 arb_ic ........FAIL! rc= 11 +127 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + kraken: All PASS except all TER and TBR tests fail, because of a script problem and ends early + lightning/pathscale: All PASS except +022 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +023 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +024 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +025 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +026 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +050 erP11 TSM_ccsmseq.sh ERS T31_g35 ICN4804 ....................................................FAIL! rc= 5 + bangkok/lf95: All PASS except +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +028 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 4 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 +054 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 .......................FAIL! rc= 6 +055 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + breeze/gale/hail/gust/ifort: All PASS + +pftdyn tests fail because of previous problem (bug 826). ext_ccsmseq_ tests fail +because of problem with ccsm4_0_alpha37 (bug 833). + +CLM tag used for the baseline comparison tests if applicable: clm3_6_12 + +Changes answers relative to baseline: Only for some cases, see tests 079 and 083 on +bluefire above + +=============================================================== +=============================================================== +Tag name: clm3_6_12 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Sun Sep 21 10:04:22 MDT 2008 +One-line Summary: Fix restarts for urban, add capability to do global urban experiments, add new forcing height changes, remove cpl6 + +Purpose of changes: Fix restarts for urban model as well as adding capability to do global urban experiments. + It also adds the new forcing height changes into the trunk. + And we remove all the cpl6 #ifdef's, source codes, and associated scripts and script options. + Also fix some memory leaks found in MCT. + Add testing for kraken. + Fix branch tests so they change the start_ymd. + Add some more tests for CASA. + Set minimum urban percentage to use from 5% to 1%. + Completely remove COUP_CAM #ifdef as NOT needed anymore. + +Bugs fixed (include bugzilla ID): Fix urban model restarts, remove cpl6 (755), MCT memory leak (825) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams), 826 (pftdyn) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Add nofire option to configure, remove cpl6 option + +Describe any changes made to the namelist: Add new urban oriented output history variables: + + _U, and _R (Urban and Rural) for: + QRUNOFF, TREFMXAV, TREFMNAV, TSA, SoilAlpha, TG, Q2M, TREFAV + URBAN_AC, and URBAN_HEAT, Qanth, SWup, LWup, QTau, HWR, Wind, Qair + and ZBOT_PFT for forcing height + + Change build-namelist so that to use a dataset with urban points on it you + need to use "-clm_demand furbinp". This way it will not only select the appropriate + furbinp dataset -- but it will select the correct surface dataset that includes + urban data on it. Such as for 10x15 and 1.9x2.5 surface datasets where there is + now an urban version as well as the standard version. + + +List any changes to the defaults for the boundary datasets: Add urbanc point dataset, + and 1.9x2.5 and 10x15 urban datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self (some changes by Keith Oleson) + +List any svn externals directories updated (csm_share, mct, etc.): drv, datm7, mct + + drv to drvseq3_0_26 + datm7 to datm7_080907 + mct to MCT2_5_1_080522 + +List all files eliminated: Remove cpl6 files + +R models/lnd/clm/test/system/TCText_ccsmcon.sh +R models/lnd/clm/test/system/TSMext_ccsmcon.sh +R models/lnd/clm/bld/clm.cpl6.template +R models/lnd/clm/src/main/program_csm.F90 +R models/lnd/clm/src/main/clm_csmMod.F90 + +List all files added and what they do: + +A models/lnd/clm/test/system/config_files/4p_casasc_ds ----- Add serial test for CASA +A models/lnd/clm/test/system/nl_files/clm_urb -------------- For standard urban tests. +A models/lnd/clm/test/system/nl_files/nl_urb_br ------------ Urban namelist for branch tests. +A models/lnd/clm/test/system/tests_posttag_kraken ---------- Add tests for kraken +A models/lnd/clm/tools/ncl_scripts/generate_ascii_avg_fv1_9x2_5_urbanparam_file_p7.ncl -- script to create furbinp dataset +A models/lnd/clm/tools/mksurfdata/mksurfdata.globalurban --- Example namelist to make a global urban surface dataset +A models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt --- Add urban intercomparison test case + +List all existing files that have been modified, and describe the changes: + +>>>>>>>>>>>>>>> Remove cpl6 option, add nofire, make urban point datasets consistent with global Feddema datasets +M models/lnd/clm/bld/configure -------------------------------- Remove cpl6 option, add nofire option +M models/lnd/clm/bld/queryDefaultNamelist.pl ------------------ Add -filenameonly option +M models/lnd/clm/bld/urban_input/metropolis_fluxes.txt +M models/lnd/clm/bld/urban_input/urbanc_alpha_fluxes.txt +M models/lnd/clm/bld/urban_input/asphaltjungle_fluxes.txt +M models/lnd/clm/bld/urban_input/mexicocityMEX_fluxes.txt +M models/lnd/clm/bld/urban_input/vancouverCAN_fluxes.txt +M models/lnd/clm/bld/config_files/config_definition.xml +M models/lnd/clm/bld/namelist_files/namelist_definition.xml +M models/lnd/clm/bld/namelist_files/datm.streams.template.xml +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +M models/lnd/clm/bld/build-namelist --------------------------- Have urban surface datasets dependent on furbinp + +M models/lnd/clm/test/system/README.testnames +M models/lnd/clm/test/system/tests_posttag_urban +M models/lnd/clm/test/system/tests_pretag_jaguar +M models/lnd/clm/test/system/tests_pretag_bluefire +M models/lnd/clm/test/system/tests_posttag_purempi_regression +M models/lnd/clm/test/system/tests_posttag_hybrid_regression +M models/lnd/clm/test/system/tests_pretag_bluevista +M models/lnd/clm/test/system/tests_posttag_lightning +M models/lnd/clm/test/system/nl_files/clm_urb1pt +M models/lnd/clm/test/system/input_tests_master +M models/lnd/clm/test/system/README +M models/lnd/clm/test/system/CLM_runcmnd.sh +M models/lnd/clm/test/system/TBR.sh ---------------------- Change so start_ymd of branch runs is initial-length after original start-date +M models/lnd/clm/test/system/test_driver.sh -------------- Reduce from premium to regular, add kraken +M models/lnd/clm/test/system/mknamelist ------------------ Set hist_* values for second file +M models/lnd/clm/test/system/nl_files/nl_crcrop ---------- Set hist_dens for second file +M models/lnd/clm/test/system/nl_files/nl_urb ------------- Set hist_dens for second file, add more fields to list +M models/lnd/clm/test/system/nl_files/nl_std ------------- Set hist_dens for second file +M models/lnd/clm/test/system/nl_files/nl_lfiles ---------- Set hist_dens for second file +M models/lnd/clm/test/system/input_tests_master ---------- Change TBR tests, add more CASA tests + +M models/lnd/clm/tools/mksurfdata/mkurban.F90 ------------ Change threshold to ignore urban from 5% to 1% + +M models/lnd/clm/src/biogeophys/FrictionVelocityMod.F90 -- For DUST fix forcing height appropriately +M models/lnd/clm/src/biogeophys/UrbanMod.F90 ------------- Don't set pointers if no urban points + +>>>>>>>>>>>>>>>> Remove COUP_CSM #ifdefs + +M models/lnd/clm/src/main/driver.F90 --------- Also make sure urban calls have urban points +M models/lnd/clm/src/main/accFldsMod.F90 +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/initializeMod.F90 +M models/lnd/clm/src/main/iniTimeConst.F90 +M models/lnd/clm/src/main/histFileMod.F90 +M models/lnd/clm/src/main/restFileMod.F90 +M models/lnd/clm/src/main/controlMod.F90 +M models/lnd/clm/src/main/initSurfAlbMod.F90 +M models/lnd/clm/src/main/clm_time_manager.F90 +M models/lnd/clm/src/main/clm_varctl.F90 +M models/lnd/clm/src/main/subgridAveMod.F90 +M models/lnd/clm/src/main/initGridCellsMod.F90 +M models/lnd/clm/src/main/spmdMod.F90 +M models/lnd/clm/src/main/surfrdMod.F90 ------------- Also remove COUP_CAM #ifdef +M models/lnd/clm/src/main/do_close_dispose.F90 +M models/lnd/clm/src/main/clmtype.F90 --------------- Also forcing height changes +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/mkarbinitMod.F90 +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 +M models/lnd/clm/src/biogeophys/SoilTemperatureMod.F90 +M models/lnd/clm/src/biogeophys/UrbanInputMod.F90 +M models/lnd/clm/src/biogeophys/Biogeophysics1Mod.F90 ------ Also forcing height changes +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 +M models/lnd/clm/src/biogeophys/UrbanInitMod.F90 +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 ------ Also forcing height changes +M models/lnd/clm/src/biogeophys/BiogeophysRestMod.F90 --------- Fix restarts for urban +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 +M models/lnd/clm/src/biogeophys/BareGroundFluxesMod.F90 +M models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluefire: All PASS except TBL and +042 smG41 TSM.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +043 erG41 TER.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +044 brG41 TBR.sh 17p_sc_dh clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +046 smG45 TSM.sh 17p_sc_h clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 + jaguar: All PASS except TBL and +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 + kraken: All PASS except TBL and TER and TBR (this may be a setup problem) and +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 + lightning/pathscale: All PASS except TBL and + bangkok/lf95: All PASS except TBL and +025 smG42 TSM.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ..................FAIL! rc= 10 +026 erG42 TER.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +027 brG42 TBR.sh 17p_sc_dm clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ................FAIL! rc= 5 +029 smG46 TSM.sh 17p_sc_m clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ...................FAIL! rc= 10 + kraken: All PASS except TBL and +017 smG43 TSM.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 144 arb_ic ........... +.......FAIL! rc= 10 +018 erG43 TER.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 10+38 arb_ic ......... +.......FAIL! rc= 13 +019 brG43 TBR.sh 17p_sc_do clm_pftdyn 10001230:NONE:1800 10x15 USGS 72+72 arb_ic ......... +.......FAIL! rc= 5 + breeze/gale/hail/gust/ifort: All PASS + + pftdyn tests fail on all platforms -- due to a previous problem that was not +detected because of a bug in the test. + TER and TBR tests fail on kraken -- this may be a setup problem. Possibily a problem +with newcprnc? I'm not sure but since it passes elsewhere, I don't think it's a problem +in the code. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_11 + +Changes answers relative to baseline: Forcing height changes cause answers to change + +=============================================================== +=============================================================== +Tag name: clm3_6_11 +Originator(s): dlawren (Lawrence David 1384 CGD) +Date: Tue Aug 26 21:53:22 MDT 2008 +One-line Summary: Ice stream for snow capped regions + +Purpose of changes: Split liquid and ice runoff streams in snow capped situations + +Bugs fixed (include bugzilla ID): None + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Update version of pft-physiology file used + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik + +List any svn externals directories updated (csm_share, mct, etc.): scripts and csm_share + + scripts to scripts4_080731 + csm_share to share3_080801 + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml --- Use the same pft-phisiology file for every option +M models/lnd/clm/src/main/clmtypeInitMod.F90 +M models/lnd/clm/src/main/pft2colMod.F90 +M models/lnd/clm/src/main/clmtype.F90 +M models/lnd/clm/src/main/histFldsMod.F90 +M models/lnd/clm/src/main/models/lnd/clm/src/main/clm_time_manager.F90 -- Hack for fake Gregorian calendar +M models/lnd/clm/src/riverroute/RtmMod.F90 --------------- two runoff sreams, liq and ice (qflx_snwcp_ice) +M models/lnd/clm/src/biogeophys/Biogeophysics2Mod.F90 ---- dew snwcp +M models/lnd/clm/src/biogeophys/Hydrology1Mod.F90 -------- snow and rain split for snwcp +M models/lnd/clm/src/biogeophys/SoilHydrologyMod.F90 ----- liq snwcp +M models/lnd/clm/src/biogeophys/Hydrology2Mod.F90 -------- qrgwl minus snwcp_ice +M models/lnd/clm/src/biogeophys/HydrologyLakeMod.F90 ----- lake snwcp +M models/lnd/clm/src/biogeophys/BiogeophysicsLakeMod.F90 - initialize snwcp fields to zero for lakes +M models/lnd/clm/src/biogeophys/BalanceCheckMod.F90 ------ revised balance check + >>>>>>>>>> Get scam test working +M models/lnd/clm/test/system/TSMext_ccsmseq_cam.sh +M models/lnd/clm/test/system/nl_files/scam +M models/lnd/clm/test/system/TSCext_ccsmseq_scam.sh +M models/lnd/clm/test/system/config_files/scam_ds +M models/lnd/clm/test/system/config_files/ext_ccsm_seq_64x128_s +M models/lnd/clm/test/system/nl_files/scam +M models/lnd/clm/test/system/nl_files/scam_prep + +Summary of testing: + + bluefire: All PASS except TBL tests + lightning/pathscale: All PASS except TBL tests + bangkok/lf95: All PASS except TBL tests + breeze/gale/hail/gust/ifort: All PASS + + Didn't test on jaguar -- since it was down. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_10 + +Changes answers relative to baseline: Yes -- pft-physiology file, RTM changes + +=============================================================== +=============================================================== +Tag name: clm3_6_10 +Originator(s): tcraig +Date: Fri Aug 15 09:05:50 MDT 2008 +One-line Summary: extend rtm tracer, ascale for tri-grids, AIX O3 to O2 + +Purpose of changes: extend rtm to handle multiple tracers. added + second tracer to rtm associated with frozen water. first tracer + is now liquid water. both are passed to cpl7 now via the roff and + ioff fields. + + add ascale field to land model in support of model running on it's + own grid. ascale is a field provided by the coupler to the land model + via the driver "domain" datatype. it is needed to correct fluxes + in the land model for conservation. it is being applied to the + land to rtm fluxes and will need to be fully validated in a ccsm4 + tri-grid configuration which is still under development. + + change AIX optimization from -O3 to -O2 at request of LMWG. not + needed for these changes in particular. see bug #812. + +Bugs fixed (include bugzilla ID): 812 + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), + 680 (t0 precip diff for seq-ccsm), + 698 (cprnc bug gives false difference), 701 (svn keyword) + 717 (archiving bug -- only archive 1000 files at a time) + 805 (too much output in build-streams) + 1079 (rpointer file updated with clm.i files) + 1083 (Units of NEE exported should be kg CO2 NOT kg C) + http://bugs.cgd.ucar.edu/ + +Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: + change AIX -O3 to -O2 at request of LMWG, incorporated + into tag for convenience. + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: + added extra rtm tracer, should have no noticable impact on timing + or memory. + +Code reviewed by: tcraig + +List any svn externals directories updated (csm_share, mct, etc.): + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M bld/config_files/Makefile.in +M src/main/clmtypeInitMod.F90 +M src/main/pft2colMod.F90 +M src/main/clm_atmlnd.F90 +M src/main/clm_csmMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/domainMod.F90 +M src/main/clmtype.F90 +M src/main/histFldsMod.F90 +M src/riverroute/RtmMod.F90 +M src/riverroute/RunoffMod.F90 +M src/biogeophys/Biogeophysics2Mod.F90 +M src/biogeophys/Hydrology1Mod.F90 +M src/biogeophys/SoilHydrologyMod.F90 + +- change AIX -O3 to -O2 +- add ascale implementation. add asca field to domain datatype, set + for atm and lnd domains. default is 1.0. received from coupler + in first run call. reset in lnd only if atm and lnd domain are same. +- split qflx_snowcap term into qflx_snowcap_rain and qflx_snowcap_snow. + snowcap_rain term is same implementation as old snowcap term. + snowcap_snow is set to zero now. potential future mods are noted + and commented out, search for tcx_snowcap_new in src code. +- implement multiple tracers extensibility in rtm. add frozen + runoff tracer in addition to liquid runoff tracer. +- set roff and ioff runoff terms in lnd_comp_mct to send back to coupler +- update rtm restart file, support backward compatability by setting + runoff tracers to zero if the new fields are not on the restart file. +- update history file for new rtm tracers. requires individual fields + to be copied from tracer arrays to single field arrays for history + interface. + +Summary of testing: + + bluefire: all PASS except + 073 blL61 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup + 077 blL62 TBL.sh _sc_m clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup + 085 blL74 TBL.sh _sc_s clm_std 19980101:6-HOURLY:1800 1x1_brazil navy -10 arb_ic + 087 blL78 TBL.sh _sc_s clm_std 19971231:NONE:1800 1x1_brazil navy -10 arb_ic + the above 4 bl cases FAIL due to -O3 to -O2 optimzation change + 113 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 + sm984 fails due to inconsistent driver in test + jaguar: all PASS except + 038 erP65 TSM_ccsmseq.sh ERS f19_g13 I + 039 erP15 TSM_ccsmseq.sh ERS T31_g35 ICN + 040 erP66 TSM_ccsmseq.sh ERH f19_g13 I + 041 erP16 TSM_ccsmseq.sh ERH T31_g35 ICN + 042 erP67 TSM_ccsmseq.sh ERB f19_g13 I + 043 erP17 TSM_ccsmseq.sh ERB T31_g35 ICN + erP* tests fail due to script error + bangkok/lf95: all PASS except + 046 sm952 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dh ext_ccsm_seq_cam 48 + 047 sm984 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 + sm952 and sm984 fail due to inconsistent driver in test + breeze/gale/hail/gust/ifort: all PASS + + bluefire cam pretag: all PASS except previously documented failures + bluefire ccsm4 pretag: all PASS except previously documented failures + compare with alpha33 FAILS since rtm not bit-for-bit in some tests. + +CLM tag used for the baseline comparison tests if applicable: clm3_6_09 + +Changes answers relative to baseline: + change of AIX -O3 to -O2 changes some results by what ap.........FAIL! rc= 7 +061 smK17 TSM.sh 10p_dgvmsc_h clm_std 19981231:NONE:1800 48x96 gx3v5 -213 arb_ic ................FAIL! rc= 10 +065 blK71 TBL.sh 10p_dgvmsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 +088 smL83 TSM.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 10 +089 erL83 TER.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -5+-5 arb_ic ................FAIL! rc= 5 +090 brL83 TBR.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10+-10 arb_ic ..............FAIL! rc= 6 +091 blL83 TBL.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 4 +095 bl711 TBLtools.sh mksurfdata tools__ds namelist .............................................FAIL! rc= 7 +097 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 7 + lightning/pathscale: +------>>>>>>> Bug 694 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 11 +025 smE13 TSM.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 10 +026 erE13 TER.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ............FAIL! rc= 5 +027 brE13 TBR.sh 4p_vodsrsc_do clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ............FAIL! rc= 5 +029 smE16 TSM.sh 4p_vodsrsc_o clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ................FAIL! rc= 10 + lightning/ifort: +004 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +------>>>>>>> Bug 694 +010 sm111 TSM.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 10 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 5 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 5 +013 bl111 TBL.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 4 +014 sm114 TSM.sh 4p_vodsr_h clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 10 +016 erE11 TER.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ............FAIL! rc= 13 +017 brE11 TBR.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ............FAIL! rc= 11 +018 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 + tempest: +009 smB11 TSMruncase.sh .........................................................................FAIL! rc= 4 +------>>>>>>> Bug 694 +011 er111 TER.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +012 br111 TBR.sh 4p_vodsr_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 24+24 arb_ic ..............FAIL! rc= 11 +036 erE31 TER.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 10+38 arb_ic ....FAIL! rc= 7 +037 brE31 TBR.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 24+24 arb_ic ....FAIL! rc= 6 +045 smH01 TSM.sh 17p_cnnsc_h clm_std^nl_lfiles 19800101:NONE:1800 0.47x0.63 gx1v5@2000 48 startup FAIL! rc= 10 + +CLM tag used for the baseline comparison tests if applicable: clm3_5_19 + +Changes answers relative to baseline: Bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_19 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Mar 6 14:52:17 MST 2008 +One-line Summary: Change directory structure to mimic CCSM, fix so no NaNS on BGC interpinic output, new half degree CN clmi dataset + +Purpose of changes: move cdir1_clm3_5_18 to trunk. Get directory structure to look like CCSM. + + models ------------------------------ Model source code for each component + models/lnd + models/lnd/clm ---------------------- CLM source code, build-scripts, tools, and testing + models/lnd/clm/test/system ---------- CLM test scripts + models/lnd/clm/tools ---------------- CLM tools + models/lnd/clm/tools/mksurfdata + models/lnd/clm/tools/ncl_scripts + models/lnd/clm/tools/interpinic + models/lnd/clm/tools/mkgriddata + models/lnd/clm/tools/mkdatadomain + models/lnd/clm/tools/cprnc + models/lnd/clm/bld ------------------ CLM build scripts + models/lnd/clm/bld/run-ibm.csh ------ sample CLM run script for the IBM + models/lnd/clm/bld/urban_input + models/lnd/clm/bld/usr.src + models/lnd/clm/bld/perl5lib + models/lnd/clm/doc ------------------ CLM documentation + models/lnd/clm/doc/UsersGuide + models/lnd/clm/doc/CodeReference + models/lnd/clm/doc/Dev + models/lnd/clm/src ------------------ CLM specific source code directories + models/lnd/clm/src/biogeochem + models/lnd/clm/src/main + models/lnd/clm/src/riverroute + models/lnd/clm/src/biogeophys + models/ocn/socn --------------------- stub ocean model + models/ice + models/ice/sice --------------------- stub sea-ice model + models/atm + models/atm/datm7 -------------------- data atmosphere model + models/atm/datm7/bld + models/utils ------------------------ Utiltiies + models/utils/esmf_wrf_timemgr ------- ESMF WRF time-manager API + models/utils/timing ----------------- timing utiltities + models/utils/mct -------------------- Model Coupling Toolkit + models/utils/pio -------------------- Parallel I/O + models/drv -------------------------- Sequential CCSM source code + models/drv/seq_mct + models/drv/seq_mct/driver + models/csm_share -------------------- CCSM share code (shared between CCSM component models) + scripts ----------------------------- CCSM build, run and testing scripts + scripts/README ---------------------- ReadMe file on CCSM scripts + doc --------------------------------- CCSM documentation (currently out of date) + + Changes so that interpinic doesn't output NaNS on AIX compiler for CN configuration. + + QUICKSTART: using the new CPL7 scripts: + + cd scripts + ./create_newcase # get help on how to run create_newcase + ./create_newcase -case testI -mach blueice -res f19_g15 -compset I # create new "I" case for blueice at 1.9x2.5_gx1v5 res + # "I" case is clm active, datm7, and inactive ice/ocn + cd testI + configure -mach blueice # create scripts + testI.build # build model and create namelists + bsub < testI.run # submit script + # (NOTE: edit env_run to set RESUBMIT to number of times to automatically resubmit) + +Bugs fixed (include bugzilla ID): 681 (archiving/resub), 696 (save datm7 files) , 707 (xlf90 bug with CAM) + +Known bugs (include bugzilla ID): 251 (TwoStream), 672 (3.5.4-3.5.14 diffs), 680 (t0 precip diff for seq-ccsm), + 694 (restarts for offline) , 697 (version etc.), 698 (cprnc bug), 701 (svn keyword), + 708, (xlf bug on bluevista) + http://bugs.cgd.ucar.edu/ + + New bugs found: 708 -- bug with new xlf90 compiler on bluevista for CASA + 710 -- Some variables are NaNS on clm.i output from CN configuration + + Known bugs that will NOT be resolved: 512 (mksurf on PGI), 546(interpinic for DGVM), + 652 (threads different answers with older PGI versions) + +Describe any changes made to build system: Changed to work with new directory structure + (also works with any wildcard in clm "models/lnd/clm*" directory name) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: Update half degree CN clmi file + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): drv (also add in CCSM doc and scripts directories as externals) + doc_060127, seqmct45_scripts_080108, drvseq2_0_10 + +List all files eliminated: Files moved around extensively + +List all files added and what they do: Files moved around extensively + +List all existing files that have been modified, and describe the changes: Files moved around extensively + + models/lnd/clm/bld/DefaultCLM_INPARM_Namelist.xml --- change CN half degree clmi file + models/lnd/clm/bld/clm.cpl6.template ---------------- change assumed paths (use wildcard for models/lnd/clm*) + models/lnd/clm/bld/clm.cpl7.template ---------------- change assumed paths (use wildcard for models/lnd/clm*) + models/lnd/clm/bld/configure ------------------------ get to work in new directory structure + models/lnd/clm/bld/run-ibm.csh ---------------------- fix archiving, and resubmit + models/lnd/clm/bld/run-lightning.csh ---------------- fix archiving, and resubmit + models/lnd/clm/bld/run-pc.csh ----------------------- fix archiving, and resubmit + models/lnd/clm/src/main/clm_time_manager.F90 -------- make save statements explicit + models/lnd/clm/tools/*/Makefile --------------------- change so CLM_ROOT is top of directory structure with + models/lnd/clm* assumed below + models/lnd/clm/tools/interpinic/interpinic.F90 ------ get numrad dimsize, on AIX check for NaNS and convert to spval, + if weights == 0 set values to spval + models/lnd/clm/test/system/test_driver.sh ----------- new directory structure, update to ccsm3_9_beta03 and ccsm4_0_alpha25 + models/lnd/clm/test/system/TBL.sh ------------------- new directory structure + models/lnd/clm/test/system/TBLtools.sh -------------- new directory structure + models/lnd/clm/test/system/TSMncl_tools.sh ---------- new directory structure + models/lnd/clm/test/system/TBR.sh ------------------- new directory structure + models/lnd/clm/test/system/TER.sh ------------------- new directory structure + models/lnd/clm/test/system/TSM.sh ------------------- new directory structure + models/lnd/clm/test/system/TSMpergro.sh ------------- new directory structure + models/lnd/clm/test/system/TSMtools.sh -------------- new directory structure + models/lnd/clm/test/system/TSMcnspinup.sh ----------- new directory structure + models/lnd/clm/test/system/TCBext_ccsmseq_cam.sh ---- new directory structure + models/lnd/clm/test/system/TCBtools.sh -------------- new directory structure + models/lnd/clm/test/system/TCText_ccsmcon.sh -------- new directory structure, add blueice + +Summary of testing: + + bluevista: All PASS except +052 smJ11 TSM.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 +053 erJ11 TER.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 10+38 arb_ic ...............FAIL! rc= 5 +054 brJ11 TBR.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 24+24 arb_ic ...............FAIL! rc= 5 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + CAM tests: All PASS except: +060 sm711 TSM.sh h5x8adm adia 9s ..................................FAIL! rc= 6 + blueice: + CPL7 test_scripts: ERS.f19_g15.I.blueice, ERB.f19_g15.I.blueice, ERS.f45_g35.I.blueice +FAIL ERB.f19_g15.I.blueice + CPL6 test_scripts: PASS ERT_OS.f19_g15.I.blueice PASS ERH_OS.T31_g35.ICN.blueice + jaguarcnl: All PASS + lightning: All PASS except +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 + bangkok/lf95: All PASS except +18 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + tempest: All PASS + +CLM tag used for the baseline comparison tests if applicable: ccsm4_alpha25 with clm3_5_18 in place of default clm + +Changes answers relative to baseline: No bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_18 +Originator(s): erik (Erik Kluzek) +Date: Thu Feb 21 22:57:39 MST 2008 +One-line Summary: Update to latest seq-ccsm4.alpha tag + +Purpose of changes: Get clm trunk to work with latest ccsm4.alpha24 tag + +Bugs fixed (include bugzilla ID): 678 (get clm to work with latest cpl7) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, + 681, 694, 696, 697, 698, 701, 702, 707, 708 + http://bugs.cgd.ucar.edu/ + + New bugs: 697-- username,version,hostname NOT in seq-driver namelists + 707-- bug on new xlf90 compiler on bluevista for running with CAM + 708-- bug on new xlf90 compiler on bluevista for running with CASA + +Describe any changes made to build system: minor change in configure script + name of mode ext_cam changed to ext_ccsm_seq in configure script + +Describe any changes made to the namelist: Sequential driver namelists change + +ccsm_inparm namelist changes to seq_infodata_inparm + (remove restart_override, username, version, hostname) +timemgr_inparm namelist changes to seq_timemgr_inparm + (remove restart_overrideTMG, stop_final_ymd [use stop_ymd instead] ) + +List any changes to the defaults for the boundary datasets: + Add 2.65x3.33 datasets, newer 1x1_brazil domain file + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens (original version on seq branch) + +List any svn externals directories updated (csm_share, mct, etc.): + +drv, datm7, sice, socn, csm_share_, and mct + +src/drv drvseq2_0_07 +src/datm7 drva_datm7_070824_tags/drva07_datm7_071129 +src/sice stubs1_0_7 +src/socn stubs1_0_7 +src/csm_share drva_share3_070903_tags/loga25_share3_071107 +src/utils/mct seqa_MCT2 _3_0_070524_tags/seqa07_MCT2_4_2_071026 + +List all files eliminated: None + +List all files added and what they do: + +A + bld/ExtSeqCCSMDrvInNamelistsDescriptions.xml -- for moving drv_in namelist items +A + bld/clm.cpl7.template ------------------------- for running with cpl7 + +List all existing files that have been modified, and describe the changes: + +------------- Get external CAM tests working, and with changes to seq-ccsm +M test/system/TSMext_ccsmseq_cam.sh +M test/system/test_driver.sh +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/nl_files/scam +M test/system/nl_files/scam_prep +M test/system/nl_files/ext_ccsm_seq_cam +M test/system/TSM.sh + +------------- Now need clm_varpar.F90 in tools +M tools/mksurfdata/Srcfiles +M tools/mkgriddata/Srcfiles + +------------- Add ext_ccsm_seq, add 2.65x3.33 datasets, change for new seq-ccsm namelists + switch 1x1_brazil domain file +M bld/configure +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/run-ibm.csh +M bld/clm_inparm.pm +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/sample.seqccsm.namelists +M bld/run-pc.csh +M bld/timemgr_inparm.pm +M bld/DefaultCCSM_INPARM_Namelist.xml +M bld/drv_in.pm +M bld/run-lightning.csh +M bld/mkSrcfiles +M bld/SeqCCSM_namelist.pm +M bld/ccsm_inparm.pm +M bld/SeqCCSMDrvInNamelistsDescriptions.xml +M bld/DefaultDATM_DSHR_NML_Namelist.xml + +------------- Don't allow seq_ccsm datatypes to go below lnd_comp_mct, fix scam +M src/main/clm_comp.F90 ------------- Remove SyncClock, CCSMInit +M src/main/driver.F90 --------------- Remove SyncClock, CCSMInit +M src/main/decompInitMod.F90 -------- Use endrun rather than shr_sys_abort +M src/main/ncdio.F90 ---------------- fixes for scam +M src/main/atmdrvMod.F90 ------------ remove unneeded printing +M src/main/clmtypeInitMod.F90 ------- explicit use only's +M src/main/initializeMod.F90 -------- remove CCSMInit and EClock +M src/main/controlMod.F90 ----------- move initialization to timemgr/clm_varctl + set methods +M src/main/clm_time_manager.F90 ----- Make namelist input private, add set method +M src/main/clm_varctl.F90 ----------- Add set and initialization methods +M src/main/clm_varorb.F90 ----------- Remove values not needed +M src/main/lnd_comp_mct.F90 --------- Update to new structures/logic + On time-step 0 also advance to time-step 1 +M src/main/program_off.F90 ---------- Move orbital info/dtime to this level +M src/main/spmdMod.F90 -------------- Change print format +M src/biogeophys/UrbanInputMod.F90 -- Initialize filename + +Summary of testing: + + bluevista: +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +008 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +011 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 5 +014 blG71 TBL.sh 17p_sc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........FAIL! rc= 5 +016 blH71 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ......FAIL! rc= 5 +021 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +026 blF27 TBL.sh 17p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..............FAIL! rc= 5 +031 blE31 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic +.......FAIL! rc= 5 +034 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +036 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +040 blG41 TBL.sh 17p_sc_dh clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +046 blH11 TBL.sh 17p_cnnsc_dh clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 5 +050 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 5 +052 smJ11 TSM.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 <<<< bug 708 +053 erJ11 TER.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 10+38 arb_ic ...............FAIL! rc= 5 <<<< bug 708 +054 brJ11 TBR.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 24+24 arb_ic ...............FAIL! rc= 5 <<<< bug 708 +055 blJ11 TBL.sh 4p_casasc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 4 +059 blK11 TBL.sh 10p_dgvmsc_dh clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 5 +064 blK71 TBL.sh 10p_dgvmsc_s clm_std 19971231:NONE:1800 1x1_brazil navy -670 arb_ic ............FAIL! rc= 5 +068 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 +072 blL63 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup ..................FAIL! rc= 5 +076 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 5 +080 blL52 TBL.sh _sc_ds clm_std 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ......................FAIL! rc= 5 +084 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 5 +089 blL83 TBL.sh _sc_dh clm_std 19980115:DAILY:3600 5x5_amazon navy -10 arb_ic ..................FAIL! rc= 5 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 <<<<< bug 707 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 <<<<<< bug 707 + CAM tests all PASS except +060 sm711 TSM.sh h5x8adm adia 9s ..................................FAIL! rc= 6 +062 sc001 TSC.sh e64bfbiop scm_prep scm64bfbiop scm_b4b_o1 7s .....FAIL! rc= 5 + +First was a Build-namelist error, next was core-dump. + + tempest: +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +007 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 5 +010 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +014 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +016 blG71 TBL.sh 17p_sc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic .........FAIL! rc= 5 +018 blH71 TBL.sh 17p_cnnsc_ds clm_pftdyn 10001230:NONE:3600 1x1_tropicAtl test -100 arb_ic ......FAIL! rc= 5 + lightning/pathscale: +004 blA91 TBL.sh _sc_dh clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 5 +011 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +015 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< bug 694 +026 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +031 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 5 +035 blK51 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 5 +039 blL51 TBL.sh _sc_dh clm_std 19980115:MONTHLY:1800 10x15 USGS 48 arb_ic ......................FAIL! rc= 5 +043 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 +047 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 5 + jaguarcnl: +008 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 7 +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 7 +024 blH12 TBL.sh 17p_cnnsc_dm clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 7 +028 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 7 + bangkok/lf95: +004 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 7 +008 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 7 +011 blD91 TBL.sh _persc_ds clm_per 19981231:YEARLY:1200 4x5 gx3v5 144 arb_ic ....................FAIL! rc= 7 +014 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 7 +016 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 7 +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<<<< 694 +025 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 7 +030 blH52 TBL.sh 17p_cnnsc_dm clm_std 19980115:MONTHLY:1800 10x15 USGS@1890 48 arb_ic ...........FAIL! rc= 7 +034 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 7 +038 blK51 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 10x15 USGS 48 arb_ic ..................FAIL! rc= 7 +042 blL51 TBL.sh _sc_dh clm_std 19980115:MONTHLY:1800 10x15 USGS 48 arb_ic ......................FAIL! rc= 7 +047 blL73 TBL.sh _sc_s clm_std 19980101:6_HOURLY:1800 1x1_brazil navy -10 arb_ic ................FAIL! rc= 7 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + +TBL _sc tests fail because of addition of area-corrected fluxes and addition of running + time-step 1 when time-step 0 is done on initialization. +er111/112 tests fail due to previous bug 694 +sm921/982 test fail on bluevista due to new bug 707 on (compiler bug on bluevista) + +CLM tag used for the baseline comparison tests if applicable: clm3_5_17 + +Changes answers relative to baseline: Yes -- greater than roundoff + + Summarize any changes to answers, i.e., + - what code configurations: Any mode with sequential-CCSM + - what platforms/compilers: ALL + - nature of change: larger than roundoff + +Fluxes in driver are corrected by ratio's of area's from different components. +Also at time-step 0 you also run time-step 1 -- rather than just time-step 0. + +=============================================================== +=============================================================== +Tag name: clm3_5_17 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Wed Feb 6 10:10:17 MST 2008 +One-line Summary: Merge Tony Craig's FMI branch fmi12_clm3_5_16 to the clm trunk + +Purpose of changes: Reducing the debug level in some initialization routines, fixing a few diagnostics, + updating timers, improve the write_diagnostic performance, update of rtm init to improve scaling and performance. + +Bugs fixed (include bugzilla ID): 597 + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, 681, 694, 696, 698, 701, 702 + http://bugs.cgd.ucar.edu/ + + New bugs found: datm7 restart files NOT being archived (696), cprnc found to have problems (698), + version autoinsertion in tools (701), test_driver times out on jaguar (702) + +Describe any changes made to build system: Add BUILDPIO CPP variable + +Describe any changes made to the namelist: Add new namelist variables dealing with PIO (see below) + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: erik,tcraig + +List any svn externals directories updated (csm_share, mct, etc.): pio to pio11_prod + +List all files eliminated: None + +List all files added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M doc/UpDateChangeLog.pl ----------------- Tweak update of date to work correctly for both files +M bld/run-frost.csh ---------------------- Tony gets working, add PIO build as commented out, turn querys off, put files + in explicitly, tests new ncd_ options +M src/biogeochem/STATICEcosysDynMod.F90 -- Add timers +M src/main/clm_comp.F90 ------------------ Add timers +M src/main/driver.F90 -------------------- Add timers, add barrier for diagnostics write, change send/recv into reduce (leave option for old code) +M src/main/decompInitMod.F90 ------------- Reduce debug level for initialization +M src/main/initializeMod.F90 ------------- Add timers +M src/main/histFileMod.F90 --------------- PIO option +M src/main/ncdio.F90 --------------------- Work for PIO, new options +M src/main/gen_ncdio_global_subs.csh ----- Work for PIO, new options +M src/main/gen_ncdio_local_subs.csh ------ Work for PIO, new options +M src/main/controlMod.F90 ---------------- Add new namelist items + +History experimental options (mostly for PIO which isn't fully implemented yet) + + o hist_pioflag = logical true if want to turn on hist with pio [.FALSE., .TRUE.] + o ncd_lowmem2d = logical true if want to turn on low memory 2d writes in clm hist [.TRUE., .FALSE.] + o ncd_pio_def = logical true if want default pio use setting [.FALSE., .TRUE.] + o ncd_pio_UseRearranger = logical true if want to use MCT as Rearranger [.TRUE., .FALSE.] + o ncd_pio_UseBoxRearr = logical true if want to use box as Rearranger [.FALSE., .TRUE.] + o ncd_pio_SerialCDF = logical true if want to write with pio serial netcdf mode [.FALSE., .TRUE.] + o ncd_pio_IODOF_rootonly = logical true if want to write history in pio from root only [.FALSE., .TRUE.] + o ncd_pio_DebugLevel = integer pio debug level ( default 2) + o ncd_pio_num_iotasks = integer number of iotasks to use for PIO (default all PEs) + +M src/main/clm_varctl.F90 ----------------- New ncd and PIO history options +M src/main/program_off.F90 ---------------- Add mpi barrier +M src/main/areaMod.F90 -------------------- Improve performance/robustness +M src/main/clm_mct_mod.F90 ---------------- Use pelocs +M src/riverroute/RtmMod.F90 --------------- Add timers, update of rtm init to improve scaling and performance +M test/system/test_driver.sh -------------- Fix for new account names on jaguar/phoenix + +Summary of testing: + + bluevista: All PASS except +021 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +026 blF27 TBL.sh 17p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ..............FAIL! rc= 7 +031 blE31 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguarcnl: All PASS except +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 7 + bangkok/lf95: All PASS except +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +020 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 +051 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + lightning/pathscale: All PASS except +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 +021 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 + tempest: All PASS except +010 blE11 TBL.sh 4p_vodsrsc_dh clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 7 + +er112, bl112, sm921, sm951, sm982 tests failed previously +other bl tests fail because of the changes in RTM + +CLM tag used for the baseline comparison tests if applicable: clm3_5_16 + +Changes answers relative to baseline: Only RTM + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: RTM + - what platforms/compilers: All + - nature of change: Roundoff change + + If bitwise differences were observed, how did you show they were no worse + than roundoff? Only fields with RTM show differences and only to roundoff level + + RMS DVOLRDT_ 8.8031E-22 + RMS DVOLRDT_ 3.4573E-23 + RMS QCHANR 3.6282E-16 + RMS QCHOCNR 5.4893E-17 + +The above is on bluevista after running for a day (other fields show RMS difference of zero) + +=============================================================== +=============================================================== +Tag name: clm3_5_16 +Originator(s): erik (Erik Kluzek) +Date: Mon Jan 28 15:00:53 MST 2008 +One-line Summary: Get point version of Urban code onto trunk (urban code can not restart) + +Purpose of changes: Move urban branch onto trunk. Fix bug so hv files are saved. Add + high resolution datasets from Art Mirin. + + Urban code was started by Gordon Bonan, and taken up by Mariana Vertenstein and Keith Oleson. + This represents work that has been ongoing for several years. Revision dates go back to + before 2003. + + Some papers on the work are available from: + + Oleson et.-al. Journal of Applied Meteorology and Climatology, in-Press as of Jan/2008 + + http://www.cgd.ucar.edu/tss/staff/oleson/publications/JAMC1597_rev_jul27_2007.pdf + http://www.cgd.ucar.edu/tss/staff/oleson/publications/JAMC1598_rev_jul27_2007.pdf + +Bugs fixed (include bugzilla ID): 644 (save hv files) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 672, 675, 676, 680, 681, 694 + http://bugs.cgd.ucar.edu/ + + New bug found from clm3_5_15 (694) -- restarts are NOT bit-for-bit on lightning and bangkok/lf95 for offline + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Added furbinp -- for urban datasets + +List any changes to the defaults for the boundary datasets: Added more urban datasets. + Add 0.23x0.31 datasets from Art Mirin. + +Describe any substantial timing or memory changes: Approx 1% slower, memory should be very close + +Code reviewed by: oleson + +List any svn externals directories updated (csm_share, mct, etc.): bld/archiving + bld/archiving to scripts_080108 + +List all files eliminated: None + +List all files added and what they do: + +------ Urban point input datasets (ASCII) +A bld/urban_input/asphaltjungle_fluxes.txt +A bld/urban_input/metropolis_fluxes.txt +A bld/urban_input/mexicocityMEX_fluxes.txt +A bld/urban_input/vancouverCAN_fluxes.txt +----- Main urban source codes +A src/biogeophys/UrbanInitMod.F90 +A src/biogeophys/UrbanInputMod.F90 +A src/biogeophys/UrbanMod.F90 +----- Add testing for urban code +A test/system/tests_posttag_urban ------ List of urban point tests +A test/system/nl_files/clm_urb1pt ------ Namelist options for CLM1PT datasets +A test/system/nl_files/nl_urb ---------- Urban namelist +A test/system/config_files/_mexsc_ds --- Mexicocity, MEX +A test/system/config_files/_vansc_ds --- Vancouver, CAN +----- Add tool to convert Urban point datasets to sequential-CCSM mode for datm7 +A tools/ncl_scripts/convertUrbanOffline2Seq.ncl + +List all existing files that have been modified, and describe the changes: + +-------- Add in urban datasets to build-namelist +M bld/configure ---------------------------- Move subroutine definition to before first reference +M bld/datm_dshr_in.pm +M bld/clm_inparm.pm +M bld/datm.streams.template.xml ------------ Add in CLM1PT datasets for Urban +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/DefaultSettings.xml +M bld/DefaultDATM_DSHR_NML_Namelist.xml +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/timemgr_inparm.pm +M bld/run-pc.pm ---------------------------- Remove extra line, set mode in configure, add note about step=coupling step +M bld/run-ibm.pm --------------------------- Add note about step=coupling step +M bld/run-lightning.pm --------------------- Add note about step=coupling step +-------- source code changes to add in urban code +-------- mostly adding urban and non-urban filters +M src/biogeochem/DGVMMod.F90 --------------- Add urban filters +M src/main/atmdrvMod.F90 ------------------- Add RH and rainf, zero out solar if coszen<0, Urban pt CPPs +M src/main/clm_varcon.F90 ------------------ Add PI, RGAS, SECSPDAY, urban PFT types, urban ponding depth +M src/main/clm_varpar.F90 ------------------ Add maxpatch_urb for 5 PFT's +M src/main/clm_atmlnd.F90 ------------------ Fill RH and rainf +M src/main/clmtype.F90 --------------------- Add urban state data +M src/main/clmtypeInitMod.F90 -------------- Initialize urban state data +M src/main/controlMod.F90 ------------------ Add furbinp namelist item for urban input data +M src/main/driver.F90 ---------------------- Pass urban filters, call urban modules +M src/main/filterMod.F90 ------------------- Add urban filters +M src/main/histFileMod.F90 ----------------- Add scale types needed for urban which needs to calculate area-averages based on urban input +M src/main/histFldsMod.F90 ----------------- Add new output fields: + + BUILDHEAT heat flux from urban building interior to walls and roof W/m^2 active + LWdown atmospheric longwave radiation W/m^2 + PSurf surface pressure Pa + Qh sensible heat W/m^2 + Qle total evaporation W/m^2 + Qstor storage heat flux (includes snowmelt) W/m^2 + RH atmospheric relative humidity % + Rainf atmospheric rain mm/s + Rnet net radiation W/m^2 + SWdown atmospheric incident solar radiation W/m^2 + TBUILD internal urban building temperature K active + TRAFFICFLUX sensible heat flux from urban traffic W/m^2 active + Tair atmospheric air temperature K + WASTEHEAT sensible heat flux from heating/cooling sources of urban waste heat W/m^2 active + +(Fields not mentioned above as active are set to inactive unless asked for. They are "ALMA" variables needed for + an urban model intercomparision project.) + +M src/main/iniTimeConst.F90 ---------------- Initialize urban data +M src/main/initGridCellsMod.F90 ------------ Add initialization of urban landunits +M src/main/initSurfAlbMod.F90 -------------- Call urban albedo calc +M src/main/initializeMod.F90 --------------- Urban initialization +M src/main/lnd_comp_mct.F90 ---------------- Add saturation vapor calc to compute RH +M src/main/mkarbinitMod.F90 ---------------- Initialize urban state +M src/main/pftvarcon.F90 ------------------- Fix typo +M src/main/program_off.F90 ----------------- Pass declination angle from orbit to atmdrv (so solar can be nullified for coszen<0) +M src/main/subgridAveMod.F90 --------------- Setup grid info for urban +M src/main/subgridMod.F90 ------------------ Set urban landunit +M src/main/surfrdMod.F90 ------------------- Initialize urban weights -- remove old code that aborted if urban fraction>0 +M src/biogeophys/BalanceCheckMod.F90 ------- Incoming rain does NOT include sun or shade wall, some checks only non-urban +M src/biogeophys/Biogeophysics1Mod.F90 ----- Take into account type of urban column +M src/biogeophys/Biogeophysics2Mod.F90 ----- Take into account type of urban column +M src/biogeophys/FrictionVelocityMod.F90 --- Change index and filters +M src/biogeophys/Hydrology1Mod.F90 --------- Take into account no water flow through urban buildings and impervious road +M src/biogeophys/Hydrology2Mod.F90 --------- Send urban filters down, and no water flow in certain urban column types +M src/biogeophys/SnowHydrologyMod.F90 ------ Urban similar to bare-soil landunit +M src/biogeophys/SoilHydrologyMod.F90 ------ Determine ponding limits for urban roof and impervious road, no runoff for sun/shade wall +M src/biogeophys/SoilTemperatureMod.F90 ---- Take into account that urban columns interact +M src/biogeophys/SurfaceAlbedoMod.F90 ------ Filter urban columns appropriately +M src/biogeophys/SurfaceRadiationMod.F90 --- Filter urban columns out +---------- Make MPI and OpenMP settings explicit in configuration files +M test/system/config_files/17p_vodsr_dm +M test/system/config_files/17p_vodsr_do +M test/system/config_files/4p_casa_m +M test/system/config_files/4p_casa_o +M test/system/config_files/17p_vodsr_m +M test/system/config_files/17p_vodsr_o +M test/system/config_files/4p_vodsr_dm +M test/system/config_files/17p_cnn_m +M test/system/config_files/4p_vodsr_do +M test/system/config_files/17p_cnn_o +M test/system/config_files/17p_cnn_dm +M test/system/config_files/17p_cnn_do +M test/system/config_files/10p_dgvm_m +M test/system/config_files/4p_casa_dm +M test/system/config_files/10p_dgvm_o +M test/system/config_files/4p_casa_do +M test/system/config_files/10p_dgvm_dm +M test/system/config_files/README +M test/system/config_files/10p_dgvm_do +M test/system/config_files/4p_vodsr_m +M test/system/config_files/4p_vodsr_o +---------- Add urban tests to testing system +M test/system/input_tests_master +M test/system/README.testnames +M test/system/mknamelist +M test/system/test_driver.sh +M test/system/tests_posttag_bangkok +M test/system/tests_posttag_blueice +M test/system/tests_posttag_lightning +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/tests_pretag_bangkok +M test/system/tests_pretag_bluevista +---------- Put options on separate lines, explicitly set source +M test/system/nl_files/clm_pftdyn +M test/system/nl_files/clm_per +M test/system/nl_files/clm_per0 +M test/system/nl_files/clm_std +---------- Add note about need of other directories to build +M tools/ncl_scripts/README ---------------------- Also add note about new script +M tools/mksurfdata/README +M tools/ncl_scripts/README +M tools/interpinic/README +M tools/mkgriddata/README +M tools/mkdatadomain/README + + +Summary of testing: + + bluevista: All PASS except +034 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +036 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +076 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 +101 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +102 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + tempest: ALL PASS + jaguarcnl: All PASS except TBL tests which fail because of a problem with the previous version on jaguar. +004 blA71 TBL.sh _sc_ds clm_std 19990101:NONE:3600 1x1_brazil navy -10 arb_ic ...................FAIL! rc= 4 +008 blA92 TBL.sh _sc_dm clm_std 19990101:NONE:3600 4x5 gx3v5 -10 arb_ic .........................FAIL! rc= 5 +012 blE12 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic ...............FAIL! rc= 5 +016 blE32 TBL.sh 4p_vodsrsc_dm clm_std 19981231:YEARLY:1800 64x128^360x720 USGS 48 arb_ic .......FAIL! rc= 5 +020 blG42 TBL.sh 17p_sc_dm clm_pftdyn 10001230:MONTHLY:1800 10x15 USGS 48 arb_ic ................FAIL! rc= 5 +024 blH12 TBL.sh 17p_cnnsc_dm clm_std 19980101:MONTHLY:1800 48x96 gx3v5@1890 48 arb_ic ..........FAIL! rc= 5 +028 blJ12 TBL.sh 4p_casasc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic ..................FAIL! rc= 5 +032 blK12 TBL.sh 10p_dgvmsc_dm clm_std 19981231:NONE:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 5 + bangkok/lf95: All PASS except +014 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +016 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +018 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< +020 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 +051 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +052 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + + lightning/pathf90: All PASS except +011 blCA1 TBL.sh _sc_ds clm_std^nl_urb 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic ..........FAIL! rc= 5 +013 blCA2 TBL.sh _sc_ds clm_std^nl_urb 19971231:NONE:3600 1x1_asphaltjungleNJ navy -90 arb_ic ...FAIL! rc= 5 +015 blNB1 TBL.sh _mexsc_ds clm_urb1pt^nl_urb 19931201:NONE:3600 1x1_mexicocityMEX navy 159 arb_ic FAIL! rc= 5 +017 blOC1 TBL.sh _vansc_ds clm_urb1pt^nl_urb 19920812:NONE:3600 1x1_vancouverCAN navy 330 arb_ic FAIL! rc= 5 +019 er112 TER.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 10+38 arb_ic ..............FAIL! rc= 13 <<<< +021 bl112 TBL.sh 4p_vodsr_dm clm_std 19981231:YEARLY:1800 48x96 gx3v5 48 arb_ic .................FAIL! rc= 7 + + +Urban TBL point tests do NOT pass because previous model version didn't have urban enabled. +cam standalone tests require the ccsm4_alpha series version of clm. +<<<<< Tests are the 694 bug found in clm3_5_15. + + +CLM tag used for the baseline comparison tests if applicable: clm3_5_15 + +Changes answers relative to baseline: None bit-for-bit + (except albedo's will be different when running in offline mode see below) + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: All mode=offline + - what platforms/compilers: All + - nature of change: Solar now set to zero when coszen<0, which influences + some non-common instances near twilight when the dataset shows solar>0 + but coszen<0. It doesn't change the model results -- because everything is + reflected anyway, but it will change how albedo is averaged over those periods. + +=============================================================== +=============================================================== +Tag name: clm3_5_15 +Originator(s): erik (Erik Kluzek) +Date: Fri Dec 21 20:33:01 MST 2007 +One-line Summary: Fix interpinic for half degree grid, add in large-file support, allow configure to work with ccsm directory structure + +Purpose of changes: + +Change configure so it will work with the ccsm4_alpha directory structure (especially for +the test suite). Add in large-file support for main code as well as tools (mksurfdata). +Add in tests for create_croplandunit and large-file support. Get interpinic to work for +half degree, and optimize and verify it's use of Open-MP. Add tool to interpolate +Nitrogen deposition files (ndepregrid.ncl). Update run scripts with suggestions from Sam +(and fix a couple of minor bugs). + +interpinic problem: Previous version may have incorrectly found nearest points for PFT data. + Data would have been valid -- but possibly NOT from the nearest point. + There was also a potential Open-MP problem where answers could change depending on the + number of threads used. The new version corrects both of these problems. The new version + should be used to interpolate critical datasets. + +Bugs fixed (include bugzilla ID): 656 (interpinic), 660 (large-file), 674 (diff -q in run script), 679 (testing task/thread change) + +Known bugs (include bugzilla ID): 251, 512, 546, 652, 664, 672, 675, 676 + http://bugs.cgd.ucar.edu/ + +Describe any changes made to build system: Remove mpi include/lib for jaguarcnl + (as already included with the ftn command) + + Make ccsm_seq -- the default way to run. + +Describe any changes made to the namelist: Add outnc_large_files option + + outnc_large_files --- TRUE => use NetCDF 64-bit large file format for output files + (history and restart files) + + The NetCDF 64-bit large file format became available in NetCDF3.6.0 and allows larger dimensions as well as allowing + output files > 2 GBytes. For more info. on Large File Support (LFS) for NetCDF see... + + http://www.unidata.ucar.edu/software/netcdf/docs/faq.html#lfs + + Since, file offsets are stored with 64-bit words rather than 32-bit words -- file sizes may change slightly with LFS. + +List any changes to the defaults for the boundary datasets: + + Added in new clmi files: + ++lnd/clm2/initdata/clmi.BCN.1980-01-01-00000.071207.nc ++lnd/clm2/initdata/clmi.F_0000-01-01_1.9x2.5_gx1v5_c071203.nc ++lnd/clm2/initdata/clmi.F_0000-09-01_1.9x2.5_gx1v5_c071203.nc + + Added in ndep files at half degree + ++lnd/clm2/ndepdata/ndep_clm_2100_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/ndep_clm_2000_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/ndep_clm_1890_0.47x0.63_c071213.nc ++lnd/clm2/ndepdata/fndep_clm_1890-2100_0.47x0.63_c071213.nc + + Add documentation and delete extra variables from T42 base ndep datasets + ++lnd/clm2/ndepdata/ndep_clm_2100_64x128_c071221.nc ++lnd/clm2/ndepdata/ndep_clm_2000_64x128_c071221.nc ++lnd/clm2/ndepdata/ndep_clm_1890_64x128_c071221.nc + + Added in urban testing dataset + ++lnd/clm2/surfdata/surfdata_1x1pt_camdenNJ_navy_070824.nc ++lnd/clm2/griddata/griddata_1x1pt_camdenNJ_navy_070824.nc ++lnd/clm2/griddata/fracdata_1x1pt_camdenNJ_navy_070824.nc + + +Describe any substantial timing or memory changes: None + +Code reviewed by: slevis (interpinic, run-ibm.csh), + thornton (ndepregrid.ncl, outnc_large_files option) + +List any svn externals directories updated (csm_share, mct, etc.): + perl5lib to perl5lib_071204 which includes new Decomp module. + +List all files eliminated: None + +List all files added and what they do: + +Add files for testing different tool configurations and ncl scripts, and for testing of +create_crop_landunit, large_file support, and an urbin test. Also change offline configuration +files so they have offline explicitly set as the mode. + +A + test/system/config_files/tools__ds +A + test/system/config_files/tools__o +A + test/system/TSMncl_tools.sh +A + test/system/nl_files/nl_crcrop +A + test/system/nl_files/nl_std +A + test/system/nl_files/nl_lfiles + +Add ncl script to regrid Nitrogen deposition files + +A + tools/ncl_scripts +A + tools/ncl_scripts/README +A + tools/ncl_scripts/ndepregrid.ncl +A + tools/mkgriddata/mkgriddata.ccsm_dom ------ add sample script for using CCSM domain files + +List all existing files that have been modified, and describe the changes: + + + Testing system updates... + +M test/system/config_files/* <-- offline configure files -- explicitly set offline mode +M test/system/config_files/README +M test/system/tests_posttag_spot1 +M test/system/tests_pretag_jaguar +M test/system/README.testnames +M test/system/tests_pretag_bangkok +M test/system/TCBtools.sh +M test/system/test_driver.sh +M test/system/mknamelist +M test/system/tests_posttag_hybrid_regression +M test/system/tests_posttag_purempi_regression +M test/system/tests_pretag_tempest +M test/system/tests_pretag_bluevista +M test/system/tests_posttag_blueice +M test/system/input_tests_master +M test/system/README +M test/system/TSMtools.sh +M test/system/TCBext_ccsmseq_cam.sh +M test/system/tests_posttag_lightning +M test/system/TBLtools.sh +M test/system/TSM.sh + + Update tools makefile and change svn keyword strings + +M tools/mksurfdata/mkvarctl.F90 +M tools/mksurfdata/README +M tools/mksurfdata/mkfileMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/Makefile +M tools/interpinic/interpinic.F90 +M tools/interpinic/Srcfiles +M tools/interpinic/Makefile +M tools/mkgriddata/creategridMod.F90 +M tools/mkgriddata/Makefile +M tools/mkdatadomain/Makefile +M tools/README + +M bld/configure ---------------------- changes to work with ccsm4.alpha directory structure, and jaguarcnl +M bld/DefaultCLM_INPARM_Namelist.xml - Add new datasets +M bld/Makefile.in -------------------- changes needed for jaguarcnl and Darwin +M bld/scpDefaultNamelist.pl ---------- extend to work with ndep files + Make changes to run scripts -- move section of things to change to top + Remove stuff not used. Add more documentation. Add suggestions from Sam Levis. +M bld/run-ibm.csh -------------------- remove -q option to diff +M bld/run-lightning.csh -------------- add bit about comparing rpointer files to see if advancing from run-ibm.csh +M bld/run-pc.csh --------------------- add bit about comparing rpointer files to see if advancing from run-ibm.csh + + Add large-file support + +M src/biogeochem/CASAMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/main/ncdio.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/clm_varctl.F90 + +Summary of testing: + + tempest: All PASS + bluevista: All PASS, except +033 smEA1 TSM.sh _sc_ds clm_std 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic .................FAIL! rc= 10 --> Urban not active yet +034 blEA1 TBL.sh _sc_ds clm_std 19981001:NONE:3600 1x1_camdenNJ navy -90 arb_ic .................FAIL! rc= 4 ---> Urban not active yet +066 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 ---> New test +070 blL63 TBL.sh _sc_h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup ..................FAIL! rc= 7 ---> New clmi file +074 bl563 TBL.sh _h clm_std 19980101:MONTHLY:1800 1.9x2.5 gx1v5 -10 startup .....................FAIL! rc= 7 ---> New clmi file +092 bl711 TBLtools.sh mksurfdata tools__ds namelist .............................................FAIL! rc= 4 ---> Test changed +094 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 4 ---> Test changed +099 sm921 TSMext_ccsmseq_cam.sh ext_ccsm_seq_4x5_dh ext_ccsm_seq_cam 48 .........................FAIL! rc= 4 +100 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + jaguarcnl: ALL PASS, except TBL tests because previous code didn't run on jaguar with recent changes + lightning: ALL PASS, except +035 blL53 TBL.sh _sc_dh clm_std^nl_crcrop 19980115:MONTHLY:1800 10x15 USGS 24 arb_ic ............FAIL! rc= 5 ---> New test +042 bl771 TBLtools.sh mksurfdata tools__ds singlept .............................................FAIL! rc= 5 ---> New test + bangkok/lf95: All PASS, except +047 sm951 TSMext_ccsmseq_cam.sh ext_ccsm_seq_10x15_dm ext_ccsm_seq_cam 48 .......................FAIL! rc= 4 +048 sm982 TSCext_ccsmseq_scam.sh ext_ccsm_seq_64x128_s scam_prep scam_ds scam 3 .................FAIL! rc= 4 + + CAM tests fail because of incomptabilities of csm_share code. + +CLM tag used for the baseline comparison tests if applicable: clm3_5_14 + +Changes answers relative to baseline: None -- bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_5_14 +Originator(s): erik (Erik Kluzek) +Date: Thu Nov 29 12:18:47 MST 2007 +One-line Summary: Use build-streams, and archiving, multiple bug-fixes + +Purpose of changes: Move bstrms5_clm3_5_13 to trunk + +Remove long-term archiving from clm code. Use Mat's long-term and short-term archiving +scripts like cam. Short term script runs at the end of your run script -- then the +long-term archiving script is submitted to the batch que at the end. Update to newer +version of csm_share that doesn't have any mss_ options. Tune usage of build-namelist. +Make streams file on the fly. Remove references to get_env and $HEADUrl$. Fix interpinic +for CASA and RTM (from Sam). Change testing from being done in offline mode to +seq_ccsm mode. Make default in run scripts to run seq_ccsm mode. Add option to run scripts +to resubmit itself until reaches a given model date. + +Add in HCSOI and HCSOISNO from Dave Lawrence. Add PERGRO test to test suite. Simple PERGRO +fix from Jerry Olson. Use branch of driver code for seq-ccsm and removing archiving. Add +in lnd_comp_mct changes from ccsm4.alpha series. + +Bugs fixed (include bugzilla ID): 449 (create_crop), 548 (rm getenv), 579 (cam config), +Changes answers relative to baseline: None + + To verify bit-for-bit ran standard offline test case (bl111) on: tempest, bluevista, bangkok + (pass on bangkok, and bluevista -- but failed on tempest) + +=============================================================== +=============================================================== +Tag name: clm3_5_13 +Originator(s): erik (Erik Kluzek) +Date: Fri Nov 16 10:17:38 MST 2007 +One-line Summary: Update xml file with file needed for ccsm3_5_beta18 + +Describe any changes made to build system: Add models/utils/perl5lib to path for perl tools + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: New 0.47x0.63 fraction + dataset compatible with CCSM datasets + +Describe any substantial timing or memory changes: None + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all subroutines eliminated: None + +List all subroutines added and what they do: + +A bld/scpDefaultNamelist.pl -- Script to help copy files in xml database. + +List all existing files that have been modified, and describe the changes: + +M bld/configure --- add models/util to path +M bld/DefaultCLM_INPARM_Namelist.xml -- add new file +M bld/queryDefaultNamelist.pl --- add models/util to path +M bld/build-namelist --- add models/util to path + +Summary of testing: None + +Changes answers relative to baseline: No + +=============================================================== +=============================================================== +Tag name: clm3_5_12 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Thu Nov 8 13:49:25 MST 2007 +One-line Summary: Tag with new files needed for ccsm3_5_beta17 + +Purpose of changes: Add new files needed for new resolutions being adding in ccsm3_5_beta17 + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: Small changes to configure from bstrms branch + +Describe any changes made to the namelist: Add new files to Default*.xml files + +List any changes to the defaults for the boundary datasets: New resolutions added + +Describe any substantial timing or memory changes: None + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all existing files that have been modified, and describe the changes: + +Move files over from the bstrms3_clm3_5_11 branch with the new resolutions needed. + +M bld/configure +M bld/DefaultCLM_INPARM_Namelist.xml +M bld/DefaultDATM_NML_Namelist.xml +M bld/DefaultSettings.xml +M bld/DefaultTIMEMGR_INPARM_Namelist.xml +M bld/DefaultPROF_INPARM_Namelist.xml +M bld/queryDefaultNamelist.pl +M bld/DefaultCCSM_INPARM_Namelist.xml +M bld/build-namelist +M bld/DefaultDATM_DSHR_NML_Namelist.xml + +Summary of testing: None + +Changes answers relative to baseline: None + +=============================================================== +=============================================================== +Tag name: clm3_5_11 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Sep 28 12:03:30 MDT 2007 +Date:One-line Summary: Update datasets in the DefaultCLM file for 0.23x0.31, 0.47x0.63, 0.9x1.25 and add fndepdyn file for 1.9x2.5 + +Purpose of changes: Needed for CCSM 20th Century simulation needed for ccsm3_5_beta13 + +Bugs fixed (include bugzilla ID): 585, 589, 593, 611 + + Add T42_gx1v5, 0.9x1.25_gx1v5 support. + also look in scripts/ccsm_utils/Tools for perl5lib. + abort if set -cycle_begyr or cycle_nyrs on namelist rather than on build-namelist command-line. + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608, 618, 622, 624 + + New nasty bugs found: + +618 You can't add new fields using: hist_fincl*. +622 CLM blindly continues even if needed fields are missing from surface dataset. + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Just add more files to XML database + +List any changes to the defaults for the boundary datasets: Add new files for: + 0.23x0.31, 0.47x0.63, 0.9x1.25, (64x128 with mask=gx1v5) and add fndepdyn file for 1.9x2.5 + +Describe any substantial timing or memory changes: None + +Code reviewed by: None + +List any svn externals directories updated (csm_share, mct, etc.): csm_share updated to trunk_tags/share3_070927 + + This is the version needed in ccsm3_5_beta13 tag (previous version causes problems building on tempest) + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M bld/DefaultCLM_INPARM_Namelist.xml ---- Add new datasets. +M bld/clm_inparm.pm --------------------- Abort if try to define cycle_nyr and cycle_begyr on namelist + rather than with command line options. +M bld/queryDefaultNamelist.pl ----------- Add ability to use perl5lib from under ccsm_utils/scripts/Tools. +M bld/build-namelist -------------------- Add ability to use perl5lib from under ccsm_utils/scripts/Tools. + + ------------------------- Remove test blZ11 (can't do the comparision), and update cam tag comparing to. +M test/system/tests_pretag_bangkok +M test/system/test_driver.sh +M test/system/tests_posttag_purempi_regression +M test/system/tests_posttag_hybrid_regression +M test/system/tests_pretag_bluevista +M test/system/tests_posttag_lightning + +Summary of testing: None + +Changes answers relative to baseline: No clm source code changed + +=============================================================== +=============================================================== +Tag name: clm3_5_10 +Originator(s): jet +Date: Tue Sep 18 12:00:23 MDT 2007 +Date:One-line Summary: Fixed scam bugs when reading initial land dataset + and moved scam_setlatlon functionality to shr_scam_mod in + csm_shr repos. Merged in Mariana's changes to add new boundary + dataset file to help scam determine land/ocn/ice fractions. + +Purpose of changes: Fix scam bugs and refactor code to allow scam to easily + determine land/ocean/ice fractions. + +Bugs fixed (include bugzilla ID): 612, 480 + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608, 618, 622 + +Describe any changes made to build system: Change configure to include new focndomain file. + +Describe any changes made to the namelist: focndomain file added to ocn_in + +List any changes to the defaults for the boundary datasets: Mariana created + a new focndomain boundary dataset (at the standard resolutions) which + describe the grid fraction of land/ocn/ice + +Describe any substantial timing or memory changes: None + +Code reviewed by: self, mariana + +List any svn externals directories updated (csm_share, mct, etc.): + + clm3_5_10 + branches/scm_drvseq1_0_43 + branches/csm_share3_070824_scm + +List all subroutines eliminated: scam_setlatlonidx.F90 + +List all subroutines added and what they do: moved scm functionality + from scam_setlatlonidx.F90 into a csm_share module that can + now be used by all surface models. + +List all existing files that have been modified, and describe the changes: +M test/system/test_driver.sh - use latest cam in testing +M test/system/nl_files/scam - fixed scam bug +M test/system/nl_files/scam_prep - fixed scam bug +M test/system/nl_files/ext_ccsm_seq_cam - use latest cam in testing +M SVN_EXTERNAL_DIRECTORIES - point to needed external dirs +M src/biogeochem/STATICEcosysDynMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/ncdio.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/initializeMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/iniTimeConst.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/restFileMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +D src/main/scam_setlatlonidx.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/clm_varctl.F90 - use new shr code instead of scam_setlatlonidx.F90 +M src/main/surfrdMod.F90 - use new shr code instead of scam_setlatlonidx.F90 +Summary of testing: + + bluevista: Everything but ccsm tests pass ( due to requirment on external + directories) + + bangkok/lf95: all passed except ccsm - expected due to requirment on external + directories + tempest all passed except 034 br531 (failed previous to this commit) + + CLM tag used for the baseline comparison tests if applicable: clm3_5_09 + +Changes answers relative to baseline: None + +=============================================================== +=============================================================== +Tag name: clm3_5_09 +Originator(s): erik (Kluzek Erik 1326 CGD) +Date: Fri Aug 31 13:58:46 MDT 2007 +Date:One-line Summary: Change configure to NOT have csm_share code for ccsm_con option, and add in 1x1.25 file, and update datm7 and csm_share + +Purpose of changes: Fix for ccsm3_5_beta12 tag + +Bugs fixed (include bugzilla ID): 581, 583 + +Known bugs (include bugzilla ID): 251, 449, 512, 546, 608,found with a suggested fix by Inez Fung + +Bugs fixed (include bugzilla ID): 389 (partial), 442, 443, 445, 450 + +Describe any changes made to build system: Fix build for jaguar and phoenix + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: nanr, slevis, dlawren, oleson, and bonan reviewed the mklai changes + +List any svn externals directories updated (csm_share, mct, etc.): None + +List all subroutines eliminated: None + +List all subroutines added and what they do: Documentation files + +A + doc/README.DGVM +A + doc/KnownBugs + +List all existing files that have been modified, and describe the changes: + +---------------------> Improve testing +M test/system/nl_files/t31_cnall +M test/system/nl_files/singlept_dgvm_long +M test/system/nl_files/1.9x2.5 +M test/system/nl_files/t31_dgvm +M test/system/nl_files/singlept +M test/system/nl_files/10x15_cnall +M test/system/nl_files/10x15_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/regional +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/nl_files/10x15 +M test/system/tests_posttag_robin +M test/system/input_tests_master +M test/system/tests_pretag_jaguar +M test/system/tests_posttag_phoenix +M test/system/test_driver.sh +M test/system/TSCscam.sh + +---------------------> Change calculation of LAI,SAI,Canopy-top/bottom so weighted by %-PFT +M tools/mksurfdata/mkfmax.F90 +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkglacier.F90 +M tools/mksurfdata/mkurban.F90 +M tools/mksurfdata/mksoitex.F90 +M tools/mksurfdata/areaMod.F90 +M tools/mksurfdata/mksrfdat.F90 +M tools/mksurfdata/Srcfiles +M tools/mksurfdata/mksoicol.F90 +M tools/mksurfdata/mkpftMod.F90 + +---------------------> Use new default files at T42, add and correct documentation +M bld/run-pc.csh +M bld/run-lightning.csh +M bld/Makefile.in +M bld/run-ibm.csh +M bld/config_clm_defaults.xml +M bld/system_defaults.xml +M bld/run-frost.csh + +---------------------> Remove uneeded shr_sys_flush, put #ifndef UNICOSMP around shr_sys_flush(6), correct MCT vector calls + needed for phoenix/robin build. + +M src/biogeochem/CNCStateUpdate2Mod.F90 +M src/biogeochem/CNGapMortalityMod.F90 +M src/biogeochem/CNC13StateUpdate2Mod.F90 +M src/biogeochem/CNFireMod.F90 +M src/biogeochem/CASAMod.F90 -------------------> Fix CASA by uncommenting lines according to Inez Fung +M src/biogeochem/CNPrecisionControlMod.F90 +M src/biogeochem/DUSTMod.F90 -------------------> Changes from Natalie M. and Francis Vitt for CAM/CLM3.5 Aerosols +M src/biogeochem/CNPhenologyMod.F90 +M src/biogeochem/CNCStateUpdate1Mod.F90 +M src/biogeochem/CNDecompMod.F90 +M src/biogeochem/CNCStateUpdate3Mod.F90 +M src/biogeochem/CNC13StateUpdate1Mod.F90 +M src/biogeochem/CNC13StateUpdate3Mod.F90 +M src/biogeochem/CNAllocationMod.F90 +M src/biogeochem/CNC13FluxMod.F90 +M src/biogeochem/CNEcosystemDynMod.F90 +M src/biogeochem/CNVegStructUpdateMod.F90 +M src/main/inicFileMod.F90 +M src/main/abortutils.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 -----------------------> Changes from Keith O. to fix TKFRZ change +M src/main/initializeMod.F90 +M src/main/clmtypeInitMod.F90 +M src/main/histFileMod.F90 +M src/main/clm_csmMod.F90 +M src/main/controlMod.F90 ----------------------> Fix #ifdef's so extra namelist items only on for COUP_CSM or OFFLINE +M src/main/initSurfAlbMod.F90 +M src/main/clm_time_manager.F90 +M src/main/initGridCellsMod.F90 +M src/main/program_off.F90 +M src/main/surfrdMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/clm_mct_mod.F90 +M src/riverroute/RtmMod.F90 +M src/biogeophys/SurfaceRadiationMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/CanopyFluxesMod.F90 + +Summary of testing: + + bluevista: All PASS except +004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................FAIL! rc= +009 bl127 TBL.sh 17p_vodsr_dh t31 48 ..............................FAIL! rc= +014 bl131 TBL.sh 4p_vodsr_dh t42half 48 ...........................FAIL! rc= +019 bl141 TBL.sh 17p__dh 10x15_pftdyn 48 ..........................FAIL! rc= +024 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................FAIL! rc= +028 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................FAIL! rc= +032 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................FAIL! rc= +037 bl471 TBL.sh 10p_dgvm_s singlept_dgvm_long -730 ...............FAIL! rc= +041 bl563 TBL.sh _h 1.9x2.5 -10 ...................................FAIL! rc= +045 bl552 TBL.sh _ds 10x15 24 .....................................FAIL! rc= +049 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +053 bl583 TBL.sh _dh regional -10 .................................FAIL! rc= +057 bl711 TBLtools.sh mksurfdata namelist .........................FAIL! rc= +059 bl771 TBLtools.sh mksurfdata singlept .........................FAIL! rc= +062 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 7 + lightning: All PASS except +004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= +009 bl142 TBL.sh 17p__dm 10x15_pftdyn 48 ..........................FAIL! rc= +014 bl252 TBL.sh 17p_cnn_dm 10x15_cnall 48 ........................FAIL! rc= +018 bl451 TBL.sh 10p_dgvm_dm 10x15_dgvm 48 ........................FAIL! rc= +019 sm551 TSM.sh _dh 10x15 48 .....................................FAIL! rc= 8 +020 er551 TER.sh _dh 10x15 10+38 ..................................FAIL! rc= 5 +021 br551 TBR.sh _dh 10x15 24+24 ..................................FAIL! rc= 5 +022 bl551 TBL.sh _dh 10x15 48 .....................................FAIL! rc= +026 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +029 bl771 TBLtools.sh mksurfdata singlept .........................FAIL! rc= + bangkok/lf95: +004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= +009 bl142 TBL.sh 17p__dm 10x15_pftdyn 48 ..........................FAIL! rc= +014 bl252 TBL.sh 17p_cnn_dm 10x15_cnall 48 ........................FAIL! rc= +018 bl312 TBL.sh 4p_casa_dm t31_casa 48 ...........................FAIL! rc= +022 bl451 TBL.sh 10p_dgvm_dm 10x15_dgvm 48 ........................FAIL! rc= +026 bl551 TBL.sh _dh 10x15 48 .....................................FAIL! rc= +030 bl573 TBL.sh _s singlept -10 ..................................FAIL! rc= +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + robin: All compile tests pass + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_98 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers: + - what code configurations: All + - what platforms/compilers: All + - nature of change: new LAI, TKFRZ change is roundoff different, Dust and CASA changes are significant + +=============================================================== +=============================================================== +Tag name: clm3_expa_98 +Originator(s): erik (KLUZEK ERIK 1326 CGD) +Date: Wed Apr 18 09:51:53 MDT 2007 +One-line Summary: Move externals to top, make SOM4 the default, rename setidx file, use new datafiles, + remove NUMLONS read, tweak testing, remove shell_cmd, remove read of old surfdata file + +Purpose of changes: Some simple cleanup preparing for CLM3.5 release + +Bugs fixed (include bugzilla ID): 440, 441 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: Use new datasets + +List any changes to the defaults for the boundary datasets: Use new NCEP forcing datasets, + and new Nitrogen deposition datasets + +Describe any substantial timing or memory changes: None + +Code reviewed by: self + +List any svn externals directories updated (csm_share, mct, etc.): + + Directories are the same -- but SVN externals themselves moved to top level + +List all subroutines eliminated: + +D test/system/tests_pretag_blueice > Rename to posttag filename +D bld/empty -----------------------> Rename to usr.src +D src/main/setlatlonidx.F90 -------> Rename to scam_setlatlonidx.F90 filename +D src/main/system_cmd.c +D src/main/cfort.h +D src/SVN_EXTERNAL_DIRECTORIES ----> Move to top layer + +List all subroutines added and what they do: + + -------------------> Files renamed from above +A + test/system/tests_posttag_blueice +A + bld/usr.src +A + SVN_EXTERNAL_DIRECTORIES +A + src/main/scam_setlatlonidx.F90 + + -------------------> New files +A test/system/config_files/10p_dgvm_s -------> New DGVM test +A + test/system/tests_posttag_blueice ---------> Rename +A test/system/tests_posttag_robin -----------> Add tests for robin/phoenix +A test/system/tests_posttag_phoenix +A test/system/nl_files/singlept_dgvm_long ---> Add new singlept DGVM test + -------------------> Add new documentation README files +A tools/README +A bld/README +A Copyright ----> CCSM Copyright file +A README + +List all existing files that have been modified, and describe the changes: + + -------------------> Tweak testing -- use new datasets, increase diversity of testing +M test/system/tests_pretag_bluevista +M test/system/nl_files/t31_cnall +M test/system/nl_files/1.9x2.5 +M test/system/nl_files/t31_dgvm +M test/system/nl_files/singlept +M test/system/nl_files/10x15_cnall +M test/system/nl_files/10x15_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/regional +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/nl_files/10x15 +M test/system/input_tests_master +M test/system/test_driver.sh + ---------------------> Remove system_cmd.c from list of source files needed to compile +M tools/mksurfdata/Srcfiles +M tools/interpinic/interpinic.F90 <--- fix interpinic compile on bluevista +M tools/mkgriddata/Srcfiles + ---------------------> Use new datasets, make sure works +M bld/run-pc.csh +M bld/configure ---- Remove SOM4 CPP declaration +M bld/run-lightning.csh +M bld/run-ibm.csh +M bld/run-frost.csh + ---------------------> Make SOM4 the default remove other option, remove read of NUMLON + ---------------------> Remove read of old surfdata sets, remove shell_cmd +M src/biogeochem/CNDecompMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/main/ncdio.F90 +M src/main/fileutils.F90 -----> Remove shell_cmd as unused now. +M src/main/iniTimeConst.F90 +M src/main/clm_varsur.F90 +M src/main/surfrdMod.F90 + +Summary of testing: + + bluevista: All PASS, except +062 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 7 + bangkok/lf95: All PASS + tempest: All PASS, except +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_97 + +=============================================================== +=============================================================== +Tag name: clm3_expa_97 +Originator(s): erik (KLUZEK ERIK 1326 CGD) +Date: Wed Apr 11 12:18:32 MDT 2007 +One-line Summary: Remove SPMD, update to clm proc tag, update timing, improve testing + +Purpose of changes: + Remove SPMD #ifdefs -- use mpi-serial code + Remove COUP_CAM #ifdefs for SEQ_MCT || SEQ_ESMF + Remove LOCAL_DEBUG CPP #ifdefs + Update to prof05_clm3_expa_92 tag (timing changes, SCAM fixes) + Update timing library to latest + Fix bugs + Improve test suite + Change scripts so will rebuild each time (only configure first time if config file DNE) + Change tool Makefile to be consistent and have USER_ overload options. + Add script to update ChangeLog + +Bugs fixed (include bugzilla ID): 337, 361, 389(partial), 407, 408, 417, 428 + 337 -- SPMD + 361 -- IRIX + 389 -- Testing + 407 -- Single gridcell + 408 -- mksurfdata,mkgriddata compiling + 417 -- write last file to mss correctly + 428 -- pdt-dyn mode now restarts correctly + +Describe any changes made to build system: Remove HIDE_MPI, remove + stuff left over from CAM Makefile, put FORTRAN name definition in configure + remove LOCAL_DEBUG CPP #ifdefs + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: mvertens, oleson, thornton (all just briefly) + +List any svn externals directories updated (csm_share, mct, etc.): + Update csm_share to share3_070321 + Update timing to timing_070328 + +List all subroutines eliminated: + +D bld/run-sgi.csh --------------------> Remove SGI run script +D test/system/tests_pretag_bluesky ---> Remove since bluesky is gone +D tools/mksurfdata/mksrfdat.namelist -> Change name to mksurfdata.namelist + + -------> Rename interpinic files to *.F90 + +D tools/interpinic/fmain.f90 +D tools/interpinic/wrap_nf.f90 +D tools/interpinic/shr_kind_mod.f90 +D tools/interpinic/interpinic.f90 +D tools/interpinic/addglobal.f90 + + --------> Remove file no longer needed by SCAM or for SPMD mode +D src/main/getnetcdfdata.F90 +D src/main/mpiinc.F90 + + +List all subroutines added and what they do: + +------- Add concurrent and sequential CCSM tests, add more resolutions, improve tools tests +A test/system/TSMconccsm.sh ----------- Concurrent CCSM test +--------------------> New configurations to test +A test/system/config_files/scam_ds +A test/system/config_files/_h +A test/system/config_files/_dh +A test/system/config_files/_m +A test/system/config_files/_o +A test/system/config_files/_dm +A test/system/config_files/_do +A test/system/config_files/_s +A test/system/config_files/_ds +A test/system/config_files/seqccsm_4x5_dh +A test/system/config_files/seqccsm_64x128_s +A test/system/config_files/seqccsm_10x15_dm +A test/system/config_files/17p__m +A test/system/config_files/17p__o +A test/system/config_files/17p__dh +A test/system/config_files/17p__dm +A test/system/config_files/17p__do +A test/system/config_files/17p__h +A test/system/TSMseqccsm.sh ------------- Sequential CCSM test +--------------------> New namelists and resolutions to test +A test/system/nl_files/scam +A test/system/nl_files/1.9x2.5 +A test/system/nl_files/singlept +A test/system/nl_files/10x15_cnall +A test/system/nl_files/10x15_dgvm +A test/system/nl_files/seqccsm +A test/system/nl_files/regional +A test/system/nl_files/scam_prep +A test/system/nl_files/10x15 +A test/system/README +A test/system/TCBseqccsm.sh --------> Sequential CCSM configure/build +A test/system/TSCscam.sh -----------> Sequential CCSM SCAM mode configure/build +A test/system/TCTconccsm.sh --------> CCSM create-test +A test/system/TBLtools.sh ----------> Compare tools to baseline version + +----------- add singlept and regional tests +A tools/mksurfdata/mksurfdata.singlept +A tools/mksurfdata/mksurfdata.regional +A + tools/mksurfdata/mksurfdata.namelist + +----------- Get improved code from Sam Levis (change names to *.F90) + +A tools/interpinic/interpinic.runoptions +A + tools/interpinic/fmain.F90 +A tools/interpinic/clmi_1999-01-02_10x15_c070330.nc <---- Test file +A + tools/interpinic/wrap_nf.F90 +A tools/interpinic/Filepath +A + tools/interpinic/interpinic.F90 +A + tools/interpinic/addglobal.F90 +A tools/interpinic/Srcfiles +----------- add singlept and regional tests +A tools/mkgriddata/mkgriddata.singlept +A tools/mkgriddata/mkgriddata.regional + +----------- Help to update ChangeLog +A doc/UpDateChangeLog.pl + +----------- New code needed for SCAM mode +A + src/main/setlatlonidx.F90 + + +List all existing files that have been modified, and describe the changes: + +----------- Improve test system (tweak tests, add new tests to various machines) +M test/system/tests_pretag_bluevista +M test/system/nl_files/t31_cnall +M test/system/nl_files/t31_dgvm +M test/system/nl_files/t31_casa +M test/system/nl_files/10x15_pftdyn +M test/system/nl_files/t31_dgvm_long +M test/system/nl_files/t42half +M test/system/nl_files/t31 +M test/system/CLM_runcmnd.sh ------- Use mpirun instead of mpiexec on bangkok/calgary +M test/system/tests_pretag_blueice +M test/system/input_tests_master +M test/system/tests_pretag_jaguar +M test/system/TSMtools.sh +M test/system/tests_pretag_bangkok +M test/system/TCBtools.sh +M test/system/test_driver.sh +M test/system/tests_pretag_tempest +M test/system/tests_posttag_lightning + +----------- Get tools to build +M tools/mksurfdata/mklaiMod.F90 +M tools/mksurfdata/mkfileMod.F90 +M tools/mksurfdata/creategridMod.F90 +M tools/mksurfdata/Srcfiles +M tools/mksurfdata/Makefile ------ Make makefile consistent and add USER_ options +M tools/interpinic/Makefile ------ Make makefile consistent and add USER_ options +M tools/mkgriddata/mkgriddata.F90 +M tools/mkgriddata/creategridMod.F90 +M tools/mkgriddata/Srcfiles +M tools/mkgriddata/Makefile ------ Make makefile consistent and add USER_ options + +----------- Improvements to run scripts and build system + Change scripts so will rebuild each time (only configure first time if config file DNE), remove left over + features from CAM Makefile. +M bld/run-pc.csh +M bld/configure +M bld/run-lightning.csh +M bld/Makefile.in +M bld/run-ibm.csh +M bld/run-frost.csh + +----------- Source code changes, removing SPMD #ifdef, LOCAL_DEBUG, get SCAM mode working with new CAM, change + to work with new timing library, fix code bugs above. Remove COUP_CAM #ifdefs for SEQ_MCT || SEQ_ESMF +M src/biogeochem/CASAMod.F90 +M src/biogeochem/CNPhenologyMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/biogeochem/CNAllocationMod.F90 +M src/biogeochem/CNVegStructUpdateMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/abortutils.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 +M src/main/fileutils.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/program_csm.F90 +M src/main/restFileMod.F90 +M src/main/clm_csmMod.F90 +M src/main/controlMod.F90 +M src/main/ndepFileMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/program_off.F90 +M src/main/pftvarcon.F90 +M src/main/spmdMod.F90 +M src/main/surfrdMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/iobinary.F90 +M src/main/do_close_dispose.F90 +M src/riverroute/RtmMod.F90 +M src/biogeophys/Hydrology2Mod.F90 +M src/biogeophys/BiogeophysRestMod.F90 + +Summary of testing: + + tempest: ALL PASS + bluevista: +019 bl141 TBL.sh 17p_vodsr_dh 10x15_pftdyn 48 .....................FAIL! rc= 7 +022 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................FAIL! rc= 6 +059 sm061 TSMconccsm.sh ERS f19_g13 ...............................FAIL! rc= 5 + bangkok/lf95: +033 sm982 TSCscam.sh seqccsm_64x128_s scam_prep scam_ds scam 7 ....FAIL! rc= 4 + +TBL test fails because of restart trouble with pftdyn. +Concurrent CCSM test fails because of a problem with ccsm3_5_beta01 for datm7. +bangkok scam test fails as is says that scm_crm_mode is not initialized in +CAM code. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_96 + (had to add in new tests, and set SOM4) + +Changes Answers: No + +=============================================================== + +=============================================================== +Tag name: clm3_expa_96 +Originator(s): tcraig +Date: Mon Mar 12 16:41:58 MDT 2007 +One-line Summary: fixed finemesh, pftdyn modes, add new tests + +Purpose of changes: restore finemesh and pftdyn modes, improve + test coverage + +Bugs fixed (include bugzilla ID): 389 (partial) + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: reduced memory use in pftdyn + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + + M test/system/tests_pretag_bluevista + A + test/system/nl_files/10x15_pftdyn + A + test/system/nl_files/t31_dgvm_long + A + test/system/nl_files/t42half + M test/system/input_tests_master + M test/system/tests_pretag_blueice + M test/system/tests_pretag_jaguar + M test/system/tests_pretag_bangkok + M test/system/test_driver.sh + M test/system/tests_posttag_lightning + M src/main/subgridMod.F90 + M src/main/initializeMod.F90 + M src/main/pftdynMod.F90 + M src/main/clm_varsur.F90 + M src/main/ndepFileMod.F90 + M src/main/subgridAveMod.F90 + M src/main/initGridCellsMod.F90 + M src/main/lnd_comp_mct.F90 + M src/main/program_off.F90 + M src/main/surfrdMod.F90 + M src/main/domainMod.F90 + M src/main/decompMod.F90 + M src/main/areaMod.F90 + +- rename lvegxy,lwtxy to vegxy, wtxy +- implement general setgatm, get finemesh working again +- refactor pftdynMod for low memory implementation, validate pfydyn mode +- modify ndep and pftdyn from x = x1*wt1 + x2*wt2 to x = x2 + wt1*(x1-x2) + as suggested by k.lindsay, improves roundoff performance +- clean up some old code +- add new tests configurations (10x15_pftdyn, t31_dgvm_long, t42half), +- update pretag lists, add new tests + +Summary of testing: + + bluevista: + all clm tests pass except bl for new cases including new tests + all cam tests pass except bl (due to clm changes in expa_94/95) + ccsm passes ERS.f45_g35.B.bluevista16 (answers change due to expa_94/95) + bangkok/lf95: + all clm tests pass including new tests in list + all cam tests pass except bl (due to clm changes in expa_94/95) + tempest: + all cam tests pass except bl (due to clm changes in expa_94/95) + lightning: + ccsm passes ERS.f45_g35.B2.lightning (answers change due to expa_94/95) + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_95, cam3_4_03, ccsm3_1_beta45 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + answers are bfb with clm3_expa_95 in clm. cam and ccsm could not + be tested for bfb due to lagging clm version in latest cam and ccsm tags + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_95 +Originator(s): nanr, Keith Oleson, Peter Thornton +Date: Thu Mar 8 17:06:06 MST 2007 +One-line Summary: Adding N limitation for CLM standalone w/o CN. + +Purpose of changes: Improve estimation of photosynthesis in CLM when it +is run without CN active. These changes impose a N limitation as a fcn of +PFT [0-1]. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: testing suites: fpftcon = pft-physiology.c070207 + +List any changes to the defaults for the boundary datasets: + fptfcon = pft-physiology.c070207 + pft-physiology.c070207.readme + +Describe any substantial timing or memory changes: none expected + +Code reviewed by: Keith Oleson, Peter Thornton, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +bv1103en.ucar.edu-/fis/cgd/tss/nanr/clm/clm3_trunk % !svn +svn status | grep 'M ' +M test/system/nl_files/t31_cnall ! change pft-physiology.c070207 +M test/system/nl_files/t31_dgvm ! change pft-physiology.c070207 +M test/system/nl_files/t31 ! change pft-physiology.c070207 +M test/system/nl_files/t31_casa ! change pft-physiology.c070207 +M bld/run-pc.csh ! change pft-physiology.c070207 +M bld/run-sgi.csh ! change pft-physiology.c070207 +M bld/run-lightning.csh ! change pft-physiology.c070207 +M bld/run-ibm.csh ! change pft-physiology.c070207 +M bld/run-frost.csh ! change pft-physiology.c070207 +M src/main/clmtypeInitMod.F90 ! initialize new N limitation factor (fnitr) +M src/main/iniTimeConst.F90 ! initialize new N limitation factor (fnitr) +M src/main/pftvarcon.F90 ! read in new var (fnitr) +M src/main/clmtype.F90 ! initialize new N limitation factor (fnitr) +M src/biogeophys/CanopyFluxesMod.F90 ! apply new N limitation factor (fnitr) + +Summary of testing: + + bluevista: + 001 sm111 TSM.sh 4p_vodsr_dh t31 48 ...............................PASS + 002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................PASS + 003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................PASS + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................SKIPPED* + 005 sm114 TSM.sh 4p_vodsr_h t31 48 ................................PASS + 006 sm121 TSM.sh 17p_vodsr_dh t31 48 ..............................PASS + 007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................PASS + 008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................PASS + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................SKIPPED* + 010 sm124 TSM.sh 17p_vodsr_h t31 48 ...............................PASS + 011 sm211 TSM.sh 17p_cnn_dh t31_cnall 48 ..........................PASS + 012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................PASS + 013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................PASS + 014 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................SKIPPED* + 015 sm311 TSM.sh 4p_casa_dh t31_casa 48 ...........................PASS + 016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................PASS + 017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................PASS + 018 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................SKIPPED* + 019 sm411 TSM.sh 10p_dgvm_dh t31_dgvm 48 ..........................PASS + 020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................PASS + 021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................PASS + 022 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................SKIPPED* + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: CN inactive + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + new climate + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + /OLESON/csm/hydp2_off_communn_hk39 + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/tss/clm/diagnostics/lmwg_hydro/hydp2_off_communn_hk39aa-hydp2_off_communn_hk38aa/setsIndex.html + + + +=============================================================== +=============================================================== +Tag name: clm3_expa_94 +Originator(s): nanr, Keith Oleson, Peter Thornton +Date: Thu Mar 8 14:22:36 MST 2007 +One-line Summary: BTRAN modification + +Purpose of changes: Change BTRAN calculation to improve prognostic + LAI estimation in high latitudes. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Keith Oleson, Peter Thornton, Dave Lawrence + +List any svn externals directories updated (csm_share, mct, etc.): nanr + +List all subroutines eliminated: nanr + +List all subroutines added and what they do: nanr + +List all existing files that have been modified, and describe the changes: +M src/biogeophys/CanopyFluxesMod.F90 + +Changing calculation of rootr to allow non-zero rootr (and btran) in partially frozen layers. + +Summary of testing: + + bluevista: + + 001 sm111 TSM.sh 4p_vodsr_dh t31 48 ...............................PASS + 002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................PASS + 003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................PASS + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................SKIPPED* + 005 sm114 TSM.sh 4p_vodsr_h t31 48 ................................PASS + 006 sm121 TSM.sh 17p_vodsr_dh t31 48 ..............................PASS + 007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................PASS + 008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................PASS + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................SKIPPED* + 010 sm124 TSM.sh 17p_vodsr_h t31 48 ...............................PASS + 011 sm211 TSM.sh 17p_cnn_dh t31_cnall 48 ..........................PASS + 012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................PASS + 013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................PASS + 014 bl211 TBL.sh 17p_cnn_dh t31_cnall 48 ..........................SKIPPED* + 015 sm311 TSM.sh 4p_casa_dh t31_casa 48 ...........................PASS + 016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................PASS + 017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................PASS + 018 bl311 TBL.sh 4p_casa_dh t31_casa 48 ...........................SKIPPED* + 019 sm411 TSM.sh 10p_dgvm_dh t31_dgvm 48 ..........................PASS + 020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................PASS + 021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................PASS + 022 bl411 TBL.sh 10p_dgvm_dh t31_dgvm 48 ..........................SKIPPED* + + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: none + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: all + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + -larger than roundoff. Climate changes unknown. + -Improves prognostic LAI estimation in high latitudes. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): clm3_expa_89 + - platform/compilers: bluevista + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + /OLESON/csm/hydp2_off_communn_hk38 + + URL for LMWG diagnostics output used to validate new climate: + +http://www.cgd.ucar.edu/tss/clm/diagnostics/lmwg_hydro/hydp2_off_communn_hk38aa-hydp2_off_communn_expa89aa/setsIndex.html + + +=============================================================== + +=============================================================== +Tag name: clm3_expa_93 ! NOTE: Tag incremented to correct mistaken tag number in documentation. (nanr) +Originator(s): tcraig +Date: Tue Feb 27 16:53:41 MST 2007 +One-line Summary: merge fmf branch to trunk (low memory mods) + +Purpose of changes: reduce memory and improve memory scaling + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: began adding support + for frost in Makefile and added a run-frost.csh (not yet + fully validated) + +Describe any changes made to the namelist: added new optional namelist + input, nsegspc (number of segments per clump for new decomp. default + is 20, 1 will produce poor loadbalance, infinity yields too many + segments per pe but good load balance. performance asymptotes for + several configurations at about 5-10 segments/pe, use 20 as default.) + +List any changes to the defaults for the boundary datasets: NONE + +Describe any substantial timing or memory changes: significant reduction + in memory use and improved memory scaling. + +Code reviewed by: + +List any svn externals directories updated (csm_share, mct, etc.): update + to mct external, MCT2_3_0_070206 + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +- implement new 1d decomp based on ngsegspc rather than balancing pfts, + ngsegspc is the number of segments per clump. the 1d gridcells will + be divided into clumps and segments per clump so there will be + a total number of segments, clumps*nsegspc, each of about equal number + of gridcells, that will be distributed round-robin to pes. pfts are + derived later and will hopefully end up being nearly as well load + balanced as the previous method without having to precompute pfts + and requiring much less memory. see above for more info on the namelist + input and default. +- reorganize initialization, split decomp_init into three phases, + atm (coarse), lnd (finemesh), and glcp (subgrid). +- add new datatype, latlon to hold some global grid info +- now all domain info is local (although initialization still needs + to be modified) +- remove some dead code +- add new timers (bug #302) +- split gatm out of domain type +- create simple setgatm_UNITY routine, finemesh capability now disabled, + must fix setgatm in future version +- move wtxy, vegxy, and pctspec to clm_varsur, allocate as local arrays + now (begg:endg) and modify surfrd to handle local data only both for + I/O and initialization. +- implement gather/scatter routines in spmdGathScatMod that use gsmaps. +- update MCT and share +- port to frost +- get rid of some of the global decomps use in code, still more to do +- memory cleanup in STATICEcosysDynMod +- implement new ncdio methods for reading to local gridcell data using gsmaps +- clean up atmdrv, use newer low mem datatypes, reduce memory +- clean up rtm, use newer low mem datatypes, reduce memory +- remove history "lat/lon" fields + +M test/system/test_driver.sh +M tools/mkgriddata/mkgriddata.F90 +M bld/configure +M bld/Makefile.in +A + bld/run-frost.csh +M src/biogeochem/CASAMod.F90 +M src/biogeochem/STATICEcosysDynMod.F90 +M src/biogeochem/DGVMMod.F90 +M src/main/spmdGathScatMod.F90 +M src/main/abortutils.F90 +M src/main/clm_comp.F90 +M src/main/driver.F90 +M src/main/ncdio.F90 +M src/main/atmdrvMod.F90 +M src/main/subgridMod.F90 +M src/main/initializeMod.F90 +M src/main/pftdynMod.F90 +M src/main/iniTimeConst.F90 +M src/main/histFileMod.F90 +M src/main/program_csm.F90 +M src/main/clm_atmlnd.F90 +M src/main/clm_varsur.F90 +M src/main/clm_csmMod.F90 +M src/main/restFileMod.F90 +M src/main/controlMod.F90 +M src/main/clm_varctl.F90 +M src/main/ndepFileMod.F90 +M src/main/initGridCellsMod.F90 +M src/main/lnd_comp_mct.F90 +M src/main/program_off.F90 +M src/main/surfrdMod.F90 +M src/main/domainMod.F90 +M src/main/decompMod.F90 +M src/main/areaMod.F90 +M src/main/clm_mct_mod.F90 +M src/SVN_EXTERNAL_DIRECTORIES +M src/riverroute/RtmMod.F90 + +Summary of testing: + + bluevista: all pass except + 004 bl111 TBL.sh 4p_vodsr_dh t31 48 ...............................FAIL! rc= 7 + 009 bl121 TBL.sh 17p_vodsr_dh t31 48 ..............................FAIL! rc= 7 + bangkok/lf95: all pass except + 004 bl112 TBL.sh 4p_vodsr_dm t31 48 ...............................FAIL! rc= 7 + 009 bl122 TBL.sh 17p_vodsr_dm t31 48 ..............................FAIL! rc= 7 + Due to roundoff change in rtm, only rtm fields affected, otherwise bfb + + Also tested version in CCSM vs ccsm3_1_beta45 + ERS.f45_g35.B.bluevista16 + ERS.f45_g35.B2.lightning + Both PASS and bfb versus beta45 except for rtm roundoff difference and + associated error growth through ocean coupling + + Also tested mods merged to clm3_expa_91 with cam3_4_00, all + CAM tests pass on bangkok, bluevista, and tempest including scam. + Tested on bangkok with cam3_4_01 and updated to clm3_expa_92, all + CAM tests pass on bangkok. bluevista and tempest not tested + due to time constraints and earlier adequate testing with + clm3_expa_91 and cam3_4_00. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_89 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: anything with RTM on + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff change in RTM due to roundoff change in cell area calculation + + If bitwise differences were observed, how did you show they were no worse + than roundoff? tested in multiple systems, review growth of diffs in + stand-alone clm, only rtm fields affected, diffs remain roundoff for + 48 timesteps, no coupling to other fields or error growth in system. + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_92 +Originator(s): erik,mvertens,mvr +Date: Mon Feb 26 15:59:16 MST 2007 +One-line Summary: When running with Sequential CCSM -- use date for albedo calculation + +Purpose of changes: To work with cam3_4_01 + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik,mvr,mvertens + +List any svn externals directories updated (csm_share, mct, etc.): none + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/main/clm_comp.F90 +M src/main/lnd_comp_mct.F90 + +Have sequential CCSM give CLM the date of the next radiation calculation so that +it can calculate albedo's for that specific time-step. This is needed to work with +cam3_4_01. + +Summary of testing: + + bluevista: Pass + bangkok/lf95: Pass + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_91 + +=============================================================== +=============================================================== +Tag name: clm3_expa_91 +Originator(s): erik +Date: Wed Feb 21 13:19:51 MST 2007 +One-line Summary: Fix SCAM mode, add more machines for test_driver, have tools use csm_share, + make clmtype private (except for data exporting), fix several bugs + +Purpose of changes: Fix SCAM mode so can make a new CAM tag. + +Bugs fixed (include bugzilla ID): 252, 310, 370, 377, 385 (partial -- 302, 357, 389) + +Describe any changes made to build system: Remove -DNO_R16 from Makefile + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: MSS writes are now synchronous instead of + asynchronous + +Code reviewed by: slevis + +List any externals updated: Update to csm_share3_070220 + +List all subroutines eliminated: + +Remove makdep -- as MkDepends replaces it +Remove cprlndnc -- as newcprnc replaces it + +D tools/makdep +D tools/makdep/main.c +D tools/makdep/Makefile +D tools/makdep/README +D tools/cprlndnc +D tools/cprlndnc/cprtps.F +D tools/cprlndnc/lenchr.F +D tools/cprlndnc/precision.F +D tools/cprlndnc/printstats.F +D tools/cprlndnc/wrap_nf.F +D tools/cprlndnc/stats.F +D tools/cprlndnc/ismax.F +D tools/cprlndnc/initstats.F +D tools/cprlndnc/nldat.F +D tools/cprlndnc/cpr.F +D tools/cprlndnc/prhddiff.F +D tools/cprlndnc/header.F +D tools/cprlndnc/Makefile +D doc/BranchLog +D doc/ChangeSum + +Delete files that tools use that are copied from main src directories (so we don't have +to maintain separate copies of code) + +D Deleting tools/mkgriddata/fileutils.F90 +D Deleting tools/mkgriddata/nanMod.F90 +D Deleting tools/mkgriddata/shr_const_mod.F90 +D Deleting tools/mkgriddata/shr_kind_mod.F90 +D Deleting tools/mkgriddata/shr_sys_mod.F90 +D Deleting tools/mksurfdata/fileutils.F90 +D Deleting tools/mksurfdata/nanMod.F90 +D Deleting tools/mksurfdata/shr_const_mod.F90 +D Deleting tools/mksurfdata/shr_kind_mod.F90 +D Deleting tools/mksurfdata/shr_sys_mod.F90 +D Deleting tools/mksurfdata/shr_timer_mod.F90 + +List all subroutines added and what they do: + +A test/system/TSMtools.sh -- for testing of the tools (not tested yet) +A test/system/TCBtools.sh -- for build testing of the tools (not tested yet) +A test/system/tests_pretag_blueice -- for running on blueice (does work) +A test/system/tests_pretag_jaguar -- for running on jaguar (doesn't work yet) +A test/system/tests_posttag_lightning -- for running on lightning (doesn't work yet) + +Files added so that tools build uses copies of files in main directories rather than separate copies + +A tools/mkgriddata/Filepath +A tools/mkgriddata/Srcfiles +A tools/mkgriddata/misc.h +A tools/mkgriddata/preproc.h +A tools/mksurfdata/Filepath +A tools/mksurfdata/Srcfiles +A tools/mksurfdata/misc.h +A tools/mksurfdata/preproc.h + +List all existing files that have been modified, and describe the changes: + +Add check for soil energy balance: + +M src/biogeophys/BalanceCheckMod.F90 + +Bigint bug fix (don't copy over static fields with bigint values when copying a domain) + +M src/main/domainMod.F90 + +SCAM fixes (read datasets differently for SCAM) + +M src/main/surfrdMod.F90 +M src/main/ndepFileMod.F90 +M src/main/iniTimeConst.F90 + +Change so that tools use main copies of code rather than own particular copy: + +M tools/mkgriddata/Makefile +M tools/mkgriddata/mkgriddata.namelist +M tools/mksurfdata/Makefile +M tools/mksurfdata/domainMod.F90 + +Make MSS write's synchronous instead of asynchronous: Required for LSF queing systems + +M src/main/fileutils.F90 + +Landmask bug fix: (landmask now output globally with no missing or fill values) + +M src/main/histFileMod.F90 +M src/main/initializeMod.F90 +M src/main/ncdio.F90 + +Timers + +M src/main/program_csm.F90 +M src/main/driver.F90 + +Make clmtype private -- so only exports it's data not data it uses. + +M src/biogeochem/CNGapMortalityMod.F90 +M src/biogeochem/VOCEmissionMod.F90 +M src/biogeochem/CNrestMod.F90 +M src/biogeochem/CNC13FluxMod.F90 +M src/biogeochem/CNSetValueMod.F90 +M src/main/atmdrvMod.F90 +M src/main/clmtypeInitMod.F90 +M src/main/pftdynMod.F90 +M src/main/restFileMod.F90 +M src/main/clmtype.F90 +M src/biogeophys/SnowHydrologyMod.F90 +M src/biogeophys/SurfaceAlbedoMod.F90 +M src/biogeophys/BiogeophysRestMod.F90 +M src/biogeophys/DriverInitMod.F90 + +Miscellaneous: + +M bld/Makefile.in --- Remove NO_R16 CPP token, some changes to start work on jaguar +M test/system/test_driver.sh -- add more machines +M test/system/CLM_runcmnd.sh -- add more machines + +Summary of testing: + + bluevista: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + bangkok/lf95: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + blueice: All PASS -- except TBL tests because of csm_share shr_const_mod TKFRZ change + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_90 + + Summarize any changes to answers: larger than roundoff (all config/all machines) + + (No simulations were performed as CCSM scientists deemed the change to be + insignificant) + +=============================================================== +=============================================================== +Tag name: clm3_expa_90 +Originator(s): nanr +Date: Tue Feb 6 13:17:55 MST 2007 +One-line Summary: Changed creategridMod.F90 to read variables from 10min USGS file. + +Purpose of changes: +Added htopo and landfract to retrieve landfrac and topography for processing USGS-gtopo30_10min_c050419.nc + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: nanr + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M creategridMod.F90 + + Added lines to creategridMod.F90 to read variables from USGS-gtopo30-10min_c050419.nc + + ier = nf_inq_varid (ncid, 'landfract', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read landfract' + call check_ret(nf_inq_varid (ncid, 'landfract', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + ier = nf_inq_varid (ncid, 'htopo', varid) + if (ier == NF_NOERR) then + if (toposet) write(6,*) trim(subname),' WARNING, overwriting topo' + toposet = .true. + write(6,*) trim(subname),' read htopo' + call check_ret(nf_inq_varid (ncid, 'htopo', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%topo), subname) + endif + + +Summary of testing: none. Affects tools/mkgriddata only. + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_89 +Originator(s): erik,oleson +Date: Feb/02/2007 +One-line Summary: + +Purpose of changes: Use new water table rise calculation in SoilHydrology + +Bugs fixed (include bugzilla ID): 345, 353 + +Describe any changes made to build system: None (although added Darwin to mksrfdat build Makefile) + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Keith Oleson + +List all subroutines eliminated: None + +Remove bld/offline directory tree + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +M bld/Makefile.in ---- Add -DFORTRANUNDERSCORE so can compile mpi-serial on IRIX + +Change run scripts so that spmd and smp settings work for both on AND off + +M bld/run-pc.csh ----------------------- Also add LD_LIBRARY_PATH setting +M bld/run-sgi.csh +M bld/run-lightning.csh + +M src/main/spmdMod.F90 ------------------ Remove #ifdef around #include so will + run serial (this is a partial fix to bug 337. The longer term fix is to remove all + #ifdef SPMD as we can use the mpi-serial code to make the serial and SPMD code the same. + +M src/biogeophys/SoilHydrologyMod.F90 --- New drainage formulation from Keith Oleson + +Summary of testing: + + bluesky: -- All but comparision to previous version + tempest: -- All but comparison to previous version and the following restart tests + (These tests fail on previous versions as well -- documented as bug 361) +002 er111 TER.sh 4p_vodsr_dh t31 10+38 ............................FAIL! rc= 11 +003 br111 TBR.sh 4p_vodsr_dh t31 24+24 ............................FAIL! rc= 11 +005 sm116 TSM.sh 4p_vodsr_o t31 48 ................................FAIL! rc= 4 +007 er121 TER.sh 17p_vodsr_dh t31 10+38 ...........................FAIL! rc= 11 +008 br121 TBR.sh 17p_vodsr_dh t31 24+24 ...........................FAIL! rc= 11 +012 er211 TER.sh 17p_cnn_dh t31_cnall 10+38 .......................FAIL! rc= 11 +013 br211 TBR.sh 17p_cnn_dh t31_cnall 24+24 .......................FAIL! rc= 11 +016 er311 TER.sh 4p_casa_dh t31_casa 10+38 ........................FAIL! rc= 11 +017 br311 TBR.sh 4p_casa_dh t31_casa 24+24 ........................FAIL! rc= 11 +020 er411 TER.sh 10p_dgvm_dh t31_dgvm 10+38 .......................FAIL! rc= 11 +021 br411 TBR.sh 10p_dgvm_dh t31_dgvm 24+24 .......................FAIL! rc= 11 + (We are going to remove tempest as a standard test for CLM) + + bangkok/lf95: -- All but comparision to previous version + +CLM tag used for the baseline comparison tests if applicable: none + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change (similar climate) + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: Cray-XT3/jaguar + - configuration (CPP ifdefs): default + - build-namelist command (or complete namelist): + - MSS location of output: /CCSM/csm/b31.020ws/lnd/hist + + URL for LMWG diagnostics output used to validate new climate: Not yet prepared + +=============================================================== +=============================================================== +Tag name: clm3_expa_88 +Originator(s): nanr +Date: Thu Jan 11 12:31:51 MST 2007 +One-line Summary: Minor formatting change in tools. + Correctons to ChangLog + + +Purpose of changes: +1. Update formatted write in tools/ mkgriddata.F90 and tools/mksrfdat.F90 + to accomodate 4 digit lat/lons. +2. Add note to ChangeLog to explain commit by nanr (10/27) that was not tagged. +3. correct Changelog for tag clm3_expa_80. The changes listed below never happened. + surfFileMod.F90 was actually removed from the trunk in a previous tag (clm3_expa_66) + and renamed surfrdMod.F90. So this modification probably reflects the status of the branch + Keith Oleson was working on. + M src/main/surfFileMod.F90 + + Removed statements contained within CN ifdef (OK'd by P. Thornton) that: + + ! the following test prevents the assignment of temperate deciduous + ! vegetation types in the tropics + ! 1. broadleaf deciduous temperate tree -> broadleaf deciduous tropical tree + ! 2. broadleaf deciduous temperate shrub -> broadleaf deciduous tropical tree + ! this reassignment from shrub to tree is necessary because there is currently no + ! tropical deciduous broadleaf shrub type defined. + + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: nanr + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M tools/mksurfdata/mksrfdat.F90 +M tools/mkgriddata/mkgriddata.F90 + + Changed formatting strings to accomodate 4 char lat/lons. + OLD: write (resol,'(i3.3,"x",i3.3)') lsmlat,lsmlon + NEW: write (resol,'(i4.4,"x",i4.4)') lsmlat,lsmlon + +Summary of testing: none. Changes only to tools and ChangeLog + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: none + +IF tag changes answers relative to baseline comparison the +following should be filled in: none + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: NA + + URL for LMWG diagnostics output used to validate new climate: NA + +=============================================================== +=============================================================== +Tag name: clm3_expa_87 +Originator(s): tcraig, jet +Date: Wed Dec 27 05:03:01 GMT 2006 +One-line Summary: merge fme branch, merge refactor_scam branch + +Purpose of changes: bug fixes, reduce memory usage, improve memory scaling, + add mct package, update scam + +Bugs fixed (include bugzilla ID): + #133 adomain,ldomain compare + #290 time bounds problem in history file + #291 fix rtm history bug on bangkok + #301 modify decomp info in i/o + #321 merge refactor_scam branch + +Describe any changes made to build system: none + + consisting of src, dst, S (COL, ROW, S). update the internal clm + atm/lnd mappings to use new datatype. lnd/rtm and driver/atm + mapping still using gridmap_type. this will be updated in future + versions. +- convert domain from 2d global to 1d global arrays. add glo + decomp which is global 1d indexing like ij to 1d or gsn + uncompressed. +- convert wtxy, vegxy, pctspec from 2d to 1d arrays. migrate many other arrays + from 2d global (i,j) to 1d global. this is for nesting and to eventually + cut down on number of index mappings in decomp_type +- reorganize order of initialization calls to start thinking about nesting +- add gatm array to domain datatype +- clean up dead code. +- rename initSubgridMod to subgridMod +- move map_indexes to subgridMod, rename get_subgrid_indexees +- rearrange a few subroutines to improve filename hierarchy and use logic +- delete get_sn routines, no longer needed +- update indexing in clm_atmlnd, remove hardwire indexes +- rewrite i/o as needed for 1d global arrays, not 2d +- delete gatherWeightsDGVM from DGVMMod.F90, no longer needed +- rename surfFileMod to surfrdMod.F90 +- reduce size of subgrid_type and redefine gcelldc and gcellsn + + +Summary of testing: + + bluesky: clm test passes, cam pretag passes except ccsm + tempest: cam pretag passes + bangkok/lf95: cam pretag passes except bl153, bl353, bl553 due to code + changes and resulting binary produced by compiler optimizations. + also scam fails. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_65, cam3_3_16 + + Summarize any changes to answers: NONE bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_expa_65 +Originator(s): Erik Kluzek +Date: Mon Jul 10 13:52:20 MDT 2006 +One-line Summary: Use share clocks and inputinfo object at driver level + +Purpose of changes: Use new version of esmf_wrf and csm_share as next step + in sequential CCSM development. + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: Add ability to use Darwin, add eshr to +Filepath + +Describe any changes made to the namelist: Instead of directing namelist from stdin + explicitly open namelist filename. Change namelist name from clmexp to clm_inparm. + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Mariana Vertenstein, Tony Craig, Forrest Hoffman + +Externals changed: csm_share to share3_060710 + esmf_wrf_timemgr to esmf_wrf_timemgr_060616 + +List all subroutines eliminated: None + +List all subroutines added and what they do: control_setNL (controlMod.F90) sets the + namelist filename. + +List all existing files that have been modified, and describe the changes: + +tools/newcprnc/Makefile +bld/offline/tests/CLM_namelist.pm +bld/offline/tests/CLM_lab.pm +bld/offline/tests/CLM.pm +bld/offline/tests/model_specs.csh +bld/offline/tests/configure.csh +bld/offline/tests/config_machine_specs.csh +bld/offline/tests/CLM_run.pm +bld/offline/tests/test_batch.csh +bld/offline/tests/Makefile +bld/offline/jobscript.csh + + Add eshr to Filepath, add Darwin as a valid platform, don't redirect unit 5 for +namelist. Set MODEL_DATDIR explicitly. Use lnd.stdin as default namelist name. +Add "-g" to Makefile. Change clm namelist from clmexp to clm_inparm. Get test_batch.csh +to work both on bangkok for Linux/Lahey and tempest for SGI. Write out Rootdir file +when configuring build directory. + +src/main/time_manager.F90 -- Use dayOfYear_r8 for calc_calday. +src/main/clm_comp.F90 ------ Pass CCSMInit in. +src/main/fileutils.F90 ----- Small changes to how using shr_file_mod. +src/main/initializeMod.F90 - Pass clock in. +src/main/program_csm.F90 --- Change where ESMF_Initialize is done. +src/main/controlMod.F90 ---- Add method to set namelist name, pass clock in and use it. +src/main/clm_varctl.F90 ---- Get rid of cam_ variables. +src/main/lnd_comp_mct.F90 -- Pass in clock and CCSMInit object. + +Summary of testing: + + bluesky: test-batch.csh -- PASS and CAM and CAM CCSM tests pass. + tempest: test-batch.csh -- PASS and CAM tests pass. + bangkok/lf95: test-batch.csh -- PASS and CAM tests pass. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_64 + + Summarize any changes to answers: NONE bit-for-bit + +=============================================================== +=============================================================== +Tag name: clm3_expa_64 +Originator(s): Dani Bundy Coleman +Date: Thu Jun 29 14:44:07 MDT 2006 +One-line Summary: dust modifications from Natalie Mahowald + +Purpose of changes: update dust code + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mariana Vertenstein + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + +M src/biogeochem/DUSTMod.F90 + OLD dmt_vma = 2.524e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + NEW dmt_vma = 3.500e-6_r8 ! [m] Mass median diameter analytic + +M src/main/clm_atmlnd.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) +M src/main/lnd_comp_mct.F90 + add land-to-atmosphere communication of fv,ram1 & dust fluxes + (only active if defined DUST or PROGSEASALT ) + +Summary of testing: + + bluesky: tested with cam, bfb when DUST and PROGSEASALT not defined + tempest: + bangkok/lf95: tested with cam, bfb when DUST and PROGSEASALT not defined + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_63 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_63 +Originator(s): Mariana Vertenstein +Date: Fri May 12 16:08:03 MDT 2006 +One-line Summary: introduced mct domains in COUP_CAM mode + +Purpose of changes: To introduce generalized mct domains +in COUP_CAM mode for the purposes of generating a sequential +ccsm + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Tony Craig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: + lnd_comp_mct.f90 + removed lnd_CheckGrid_mct routine and replaced it with lnd_domain_mct + each processor sends it local domain information stored in an MCT + GeneralGrid data structure back to the top level application driver. + A global gather is done for the GeneralGrid and domain comparison is + performed on the master processor. + +Summary of testing: + + bluesky: only cam test suite was run successfully + tempest: only cam test suite was run successfully + bangkok/lf95: only cam test suite was run successfully + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== +Tag name: clm3_expa_62 +Originator(s): erik, tcraig +Date: Wed May 10 00:06:39 MDT 2006 +One-line Summary: merge shrgetput08_clm3_expa_61, fix finemesh bugs + +Purpose of changes: changes required for sequential ccsm. validate + finemesh is running properly. + +Bugs fixed (include bugzilla ID): + a couple finemesh bugs, not documented. + +Describe any changes made to build system: modified makefile slightly + to set HIDE_MPI when SPMD is FALSE, remove HIDE_SHR_MSG + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: erik, tcraig + +List all subroutines eliminated: none + +List all subroutines added and what they do: none + +List all existing files that have been modified, and describe the changes: +Makefile: + - remove HIDE_SHR_MSG, not needed anymore + - add HIDE_MPI if SPMD is FALSE +SVN_EXTERNALS: + - change csm_share version from share3_051205 to share3_060428 + - change emsf_wrf_timemgr version from esmf_wrf_timemgr_051212 to esmf_wrf_timemgr_060501 +fileutils.F90: + - uses shr_file_mod.F90 routines + - use shr_file_mod syntax for archive_dir (using mss: prefix) +initializeMod.F90: + - add pnamer_bin get +program_csm.F90: + - add ESMF_Initialize call +clm_atmlnd.F90: + - fix bug in call to grid_maparray for finemesh mapping, only affects finemesh runs. +controlMod.F90: + - use shr_file_mod syntax for archive_dir (using mss: prefix) +lnd_comp_mct.F90: + - change call to get_proc_bounds to get_proc_bounds_atm (bug for finemesh runs). +program_off.F90: + - add calls to ESMF_Initialize and ESMF_Finalize + + +Summary of testing: + bluesky: cam full suite bfb + clm full suite not bfb (TS is bfb for 2 days, history file not bfb + after ~1.5 days probably due to new esmf time manager, likely roundoff) + tempest: cam full suite bfb, ccsm build test + bangkok/lf95: cam full suite bfb + bluevista : ccsm TER.01a.1.9x2.5_gx1v3.B.bluevista bfb + cam finemesh T42half.clim0 test, bfb for 42 timesteps vs cam3_2_49 + lightning : ccsm TER.01a.4x5_gx3v5.B.bluevista bfb + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_61, cam3_3_4, ccsm3_1_beta27 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: clm standalone only + - what platforms/compilers: only bluesky tested + - nature of change (roundoff; larger than roundoff/same climate; new climate): + assume roundoff. it's bfb for at least a day. in cam and ccsm mode they + are bfb. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? guess + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +=============================================================== +Tag name: clm3_expa_61 +Originator(s): T Craig +Date: Thu Apr 27 01:10:40 MDT 2006 +One-line Summary: merge cammct05_clm3_expa_58 onto main trunk, + modify surface dataset input + +Purpose of changes: merge branch + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself, developed my MV + +List all subroutines eliminated: + clm_camMod.F90 - interface to cam + MCT_atmlnd_cpl.F90 - mct migrated to sequential driver + MCT_lnd_comp.F90 - mct migrated to sequential driver + +List all subroutines added and what they do: + lnd_comp_mct.F90 - interface to sequential driver using mct coupling + +List all existing files that have been modified, and describe the changes: + clm_comp.F90 - separate init method into init1, init2 + initializeMod.F90 - separate initialize into initialize1 and 2 + program_csm.F90 - add call to clm_init0 + clm_atmlnd.F90 - PWorley's changes to improve phoenix performance, + packed arrays in clm_mapa2l and clm_mapl2a interpolation. + program_off.F90 - add call to clm_init0 + areaMod.F90 - PWorley's changes to improve phoenix performance, + interpolate packed arrays in gridmap_maparray + Hydrology2Mod.F90 - remove use of iam + + mksurfdata, several files changed to convert + mksrf_fgrid_global/regional to mksrf_fgrid and mksrf_gridtype + +Summary of testing: + + bluesky: clm full suite bfb, cam full suite bfb + bluevista: ccsm bfb TER.01a.T31_gx3v5.B.bluevista, TER.01a.4x5_gx3v5.B.bluevista + tempest: cam full suite bfb + bangkok/lf95: cam full suite bfb + + mksrf tested on bluevista, 7 cases, bfb + +CLM tag used for the baseline comparison tests if applicable: + clm3_expa_60, cam3_3_2, ccsm3_1_beta25 + +changes are bit-for-bit + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_60 +Originator(s): Forrest Hoffman +Date: Fri Apr 14 11:03:34 EDT 2006 +One-line Summary: Rearranged physiology fields, changed CO2 constants, fixed Bug #43 + +Purpose of changes: Make radiation-related physiology fields standard, prepare code for C-LAMP experiments, and make test-model run on Cray X1E (phoenix) + +Bugs fixed (include bugzilla ID): Bug #43 + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: Myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +nfwrappers.f90: +Changed intent for ncid from intent(in) to intent(out) since it must be +returned to the calling routines. This fixed Bug #43 which was discovered +on the Cray X1E (phoenix). + +ChangeLog: +Added this log entry. + +clm_varcon.F90: +Changed co2_ppmv_const to 283.1878_r8 for both CASA' and CN in preparation +for Experiment 1 of the C-LAMP. + +histFldsMod.F90 +Moved LAISUN, LAISHA, TLAI, TSAI, SLASUN, and SLASHA out of the CN-only +section of the code so that they appear on the regular CLM output files +since the two-leaf radiation code is now standard. In addition, TLAI and +TSAI were removed from the DGVM-only section of the code since these +output fields are now standard. + +Summary of testing: + + cheetah: +Ran test-model for T31, T31cn, T31cnall, T31casa, and T31dgvm with +baseline clm3_expa_59. T31 and T31dgvm passed all tests. The others +passed tests 01-05, but not the 06_control test because of the change +in co2_ppmv_const. + + phoenix: +Ran test-model for T31, T31cn, T31cnall, T31casa, and T31dgvm with +baseline clm3_expa_59. T31 and T31dgvm passed all tests. The others +passed tests 01-05, but not the 06_control test because of the change +in co2_ppmv_const. + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_59 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: co2_ppmv_const modification changes answers + - what platforms/compilers: IBM (cheetah) and Cray X1E (phoenix) + - nature of change (roundoff; larger than roundoff/same climate; new climate): larger than roundoff because of changes in carbon pools + + If bitwise differences were observed, how did you show they were no worse + than roundoff? cprnc + + * There is no validated climate in these model configurations. * + +=============================================================== +=============================================================== +Tag name: clm3_expa_59 +Originator(s): Tony Craig +Date: Wed Apr 5 18:03:23 MDT 2006 +One-line Summary: add fatmlndfrc capability + +Purpose of changes: Support new datasets, other minor improvements, + update mkgrid and mksurf tools for new dataset generation. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: jobscript.csh modified for + new surface datasets, change baseline resolution to T31. + +Describe any changes made to the namelist: added optional fatmlndfrc + namelist input for landfrac file on atm grid. + +List any changes to the defaults for the boundary datasets: all new + grid, frac, and surf datasets generated, located in + /fs/cgd/csm/inputdata/lnd/clm2/[griddata,surfdata] + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + +tools/mksurfdata/mkrfdat.F90 - change default output filenames +tools/mksurfdata/mklaiMod.F90 - removed masking since there is no mask anymore +tools/mksurfdata/mkfileMod.F90 - removed read of LANDMASK and LANDFRAC +tools/mksurfdata/creategridMod.F90 - removed write of LANDMASK and LANDFRAC +tools/mksurfdata/Makefile - fix clean bug +tools/mkgriddata/mkgriddata.F90 - add generation of ffracdat file + force area calculation for ccsm domain files due to noise in scrip areas + change default output filenames +tools/mkgriddata/mkvarctl.F90 - add support for area recomputation +tools/mkgriddata/mkfileMod.F90 - removed, merged into creategridMod.F90 +tools/mkgriddata/areaMod.F90 - add flush(6) +tools/mkgriddata/creategridMod.F90 - add mkfile subroutine + fix bug in setting of corner points + handle wrap-around points better with corner points + add ability to adjust units of area (not automatic) + add checks for area + add ability write eigher grid or frac file in write_domain +bld/offline/tests/test_batch.csh - change default version from 53 to 58 + turn on dgvm testing by default +bld/offline/jobscript.csh - change to share queue on bluesky + run mixed mpi/openmp by default, 2x2 + change default resolution to T31 (was T42) + update to use new surface datasets + change default, turn on DUST, RTM, VOC, turn off CN, SUPLN, SUNSHA, STOMATA2 + add unlimit unlimited for AIX + fix redirection to compile_log.clm output file +src/main/initializeMod.F90 - add fatmlndfrc stuff + add computation of ldomain%frac and ldomain%mask +src/main/controlMod.F90 - add fatmlndfrc stuff +src/main/clm_varctl.F90 - add fatmlndfrc stuff +src/main/driver.F90 - remove redundant definition of caldayp1 +src/main/clmtypeInitMod.F90 - remove landfrac variable for clm3 gridcell_type +src/main/histFileMod.F90 - add indxupsc, jndxupsc indices for upscaling +src/main/program_csm.F90 - move shr_msg_stdio to after MPI_INIT, change + call so it only redirects log file for masterproc. this will clean + up the log file significantly but may lead to error messages ending + up in stdout. +src/main/surfFileMod.F90 - add fatmlndfrc stuff +src/main/initGridCellsMod.F90 - remove landfrac variable for clm3 gridcell_type +src/main/domainMod.F90 - reorder domain data slightly (nothing changed) +src/main/areaMod.F90 - change default of i_ovr and j_ovr from bigint to -1, + allows for cleaner writing of indxupsc and jndxupsc in history file. + change gridmap_setmapsFM to use _a and _l notation instead of _i and _o +src/main/clmtype.F90 - remove landfrac from clm3 gridcell_type + + +Summary of testing: + + Baseline versions, clm3_expa_58, cam3_2_56, ccsm3_1_beta24 + + bluesky: clm full suite passes, cam full suite passes + tempest: cam full suite passes + bangkok/lf95: cam full suite passes + bluevista: ccsm TER.01a B passes for several resolutions, new datasets + in scripts + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_58 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Code changes are bfb, but answers may change when using new surface datasets + + Summarize any changes to answers, i.e., + - what code configurations: CCSM answers will change with new datasets as + default datasets are changing. clm default test is bfb at T31 with new datasets, + cam will be bfb as current default datasets are not being updated. + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + + +=============================================================== +Tag name: clm3_expa_58 +Originator(s): Forrest Hoffman +Date: Thu Mar 9 17:04:27 EST 2006 +One-line Summary: Updates for the Cray X1E and a forcing height error check. + +Purpose of changes: Improvements on the Cray X1E and avoiding arithmetic exceptions when the forcing height is below the canopy height. + +Bugs fixed (include bugzilla ID): Bug #36 + +Describe any changes made to build system: jobscript.csh modified for Cray X1E + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: None + +Code reviewed by: myself and (for forcing height check code) Mariana Vertenstein + +List all subroutines eliminated: None + +List all subroutines added and what they do: None + +List all existing files that have been modified, and describe the changes: + + jobscript.csh - Modified for Cray X1E and cross-compiler + inicFileMod.F90 - Added compiler directives for vectorization + driver.F90 - Commented out CSDs to avoid model hangs caused by write + statements in science routines within the associated loops + controlMod.F90 - Changed default clump_pproc to 1 for the Cray (since CSDs + are not used in driver.F90 + histFldsMod.F90 - Changed type2d='levlak' for the TLAKE field + CanopyFluxesMod.F90 - Inserted code to check if the forcing height + is below the canopy height for any pft. Model will now abort when this + occurs instead of taking the log() of a negative number. See Bug #36 + +Summary of testing: + + bluesky: test-model ran as follows +01_debug_run_SPMD: T31 ran +02_debug_run_nonSPMD: T31 ran +03_start: T31 ran +04_restart: T31 ran +05_norestart_compare_to_restart: T31 ran +06_control: T31 ran +01_debug_run_SPMD: T31cn ran +02_debug_run_nonSPMD: T31cn ran +03_start: T31cn ran +04_restart: T31cn ran +05_norestart_compare_to_restart: T31cn ran +06_control: T31cn ran +01_debug_run_SPMD: T31cnall ran +02_debug_run_nonSPMD: T31cnall ran +03_start: T31cnall ran +04_restart: T31cnall ran +05_norestart_compare_to_restart: T31cnall ran +06_control: T31cnall ran +01_debug_run_SPMD: T31casa ran +02_debug_run_nonSPMD: T31casa ran +03_start: T31casa ran +04_restart: T31casa ran +05_norestart_compare_to_restart: T31casa ran +06_control: T31casa ran + cheetah: +01_debug_run_SPMD: T31cnall ran +02_debug_run_nonSPMD: T31cnall ran +03_start: T31cnall ran +04_restart: T31cnall ran +05_norestart_compare_to_restart: T31cnall ran +06_control: T31cnall ran +01_debug_run_SPMD: T31 ran +02_debug_run_nonSPMD: T31 ran +03_start: T31 ran +04_restart: T31 ran +05_norestart_compare_to_restart: T31 ran +06_control: T31 ran +01_debug_run_SPMD: T31cn ran +02_debug_run_nonSPMD: T31cn ran +03_start: T31cn ran +04_restart: T31cn ran +05_norestart_compare_to_restart: T31cn ran +06_control: T31cn ran +01_debug_run_SPMD: T31casa ran +02_debug_run_nonSPMD: T31casa ran +03_start: T31casa ran +04_restart: T31casa ran +05_norestart_compare_to_restart: T31casa ran +06_control: T31casa ran + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_57 + +=============================================================== +Tag name: clm3_expa_57 +Originator(s): Peter Thornton +Date: 31 Jan 2006 +One-line Summary: Mods to allow switching between 3 and 4 soil + organic matter pools + +Purpose of changes: New science. + +Bugs fixed (include bugzilla ID): bugs in pftdynMod.F90 and ndepfileMod.F90 + +Describe any changes made to build system: + +Describe any changes made to the namelist: Added SOM4 as new CPP directive + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: none + +Code reviewed by: myself + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +main/clmtype.F90: added soil4c (and 13C equiv.), soil4n states and associated + flux variables. Also added long name commenting for many previously defined + variables. +main/clmtypeInitMod.F90: added initialization for new variables +main/CNiniTimeVar.F90: initialize new state variables. +main/histFldsMod.F90: added new variables, and also added long names for + many previously defined variables. +main/pftdynMod.F90: bug fix in mpi_bcast, change MPI_REAL8 to MPI_INTEGER. +main/ndepFileMod.F90: bug fix for mpi_bcast, change MPI_REAL8 to MPI_INTEGER. +biogeochem/CNSetValueMod.F90: add code for new state and flux variables. +biogeochem/CNDecompMod.F90: add code to allow either 3 or 4 SOM pools. Default + behavior is 3 pools, 4-pool behavior triggered by SOM4 CPP directive. +biogeochem/CNCStateUpdate1Mod.F90: handling for new variables. +biogeochem/CNNStateUpdate1Mod.F90: handling for new variables. +biogeochem/CNSummaryMod.F90: handling for new variables. +biogeochem/CNBalanceCheckMod.F90: handling for new variables +biogeochem/CNPrecisionControlMod.F90: handling for new variables +biogeochem/CNC13FluxMod.F90: handling for isotope version of new variables +biogeochem/C13StateUpdate1Mod.F90: handling for new variables +biogeochem/C13SummaryMod.F90: handling for new variables +biogeochem/CNrestMod.F90: handling for new variables, and modify EXIT_SPINUP + controls + +Summary of testing: + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: in 3-pool mode +(SOM4 not set), results are bfb with clm3_expa_55. in 4-pool mode, changes +answers, as expected. + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: +bfb under 3-pools is demonstrated at: +http:/www.cgd.ucar.edu/tss/clm/diagnostics/clm3cn/c13/ccsm3_bgc31_I_5a-ccsm3_bgc31_I_2b/setsIndex.html + +=============================================================== +Tag name: clm3_expa_56 +Originator(s): Tony Craig +Date: 31 Jan 2006 +One-line Summary: Final changes for finemesh implementation. + +Purpose of changes: Integrate final changes for finemesh implementation. These +changes are 100% backward compatable and bfb, but also support use of a finemesh grid. finemesh implementation has been test in clm and cam. + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: Update Makefile so Depends are regenerated if any code is changed. + +Describe any changes made to the namelist: Added one new optional namelist, fatmgrid. This is a dataset for the coarse grid in clm. The format is the same as the surface dataset but only needs to include grid variables. + +List any changes to the defaults for the boundary datasets: Generated some new datasets with filled wetland and higher resolution. Not required and not yet added to default suite of datasets. + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +tools/mksurfdata: + mksrfdat.F90,areaMod.F90,creategridMod.F90 +bld/offline/Makefile +doc/ChangeLog + src/main: +clm_comp.F90,driver.F90,clm_camMod.F90,atmdrvMod.F90,clmtypeInitMod.F90,initializeMod.F90,histFileMod.F90,program_csm.F90,clm_atmlnd.F90,clm_csmMod.F90,surfFileMod.F90,controlMod.F90,clm_varctl.F90,initGridCellsMod.F90,MCT_lnd_comp.F90,program_off.F90,domainMod.F90,decompMod.F90,areaMod.F90,clmtype.F90 +src/biogeophys/SurfaceAlbedoMod.F90 + +Code changes: +add pftm to domain datatype and history file +modify program_off and program_cs to use clm_init[1,2], clm_run[1,2] +modify coupling to handle coarse <-> finemesh for standlaone, cam, and + ccsm. +modify Makefile so depends file is reset whenever there is a code change +add normalized area to history files +add lat_a, lon_a, latdeg_a, londeg_a to clm3 datatype for atm lats/lons. + required in SurfaceAlbedo computation where the the zenith angle has + to be based on the atm (coarse) grid, not the fine clm grid. +merge with clm3_expa_53_brnchT_cam01 tag + +Summary of testing: + + bluesky: clm full suite bfb, cam full suite bfb, ccsm bfb + tempest: cam full suite bfb + bangkok/lf95: cam full suite bfb + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_55 + +IF tag changes answers relative to baseline comparison the +following should be filled in: bfb + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? bfb + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_55 +Originator(s): Peter Thornton +Date: 24 Jan 2006 +One-line Summary: Fixes for 13C isotope code, migration from cvs + +Purpose of changes: + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: myself + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: +Files modified: +1. CNFireMod.F90 +Added initialization of variable mep. + +2. CNrestMod.F90 +Added EXIT_SPINUP controls on column-level 13C pools + +3. C13SummaryMod.F90 +Added current and excess maintenance respiration terms to summary MR variable. + +4. CNC13FluxMod.F90 +Added new routines to calculate 13C fluxes. Litter to column, non-mortality fluxes +at the column level, pft-level gap mortality fluxes, pft and column level fire mortality fluxes, + +5. CNEcosystemDynMod.F90 +Added calls for C13Flux2, C13Flux3, C13StateUpdate2, and C13StateUpdate3. + +6. clm_varcon.F90 +Added parameters to define a fixed pre_industrial del13C (set to -6 permil) + +Summary of testing: + + bluesky: + tempest: + bangkok/lf95: + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_40 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +Changes answers for CN only, and then only for the isotope prognostics. + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: +http://www.cgd.ucar.edu/tss/clm/diagnostics/clm3cn/c13/ccsm3_bgc31_I_2a-ccsm3_bgc26_I_1d/setsIndex.html +=============================================================== +Tag name: clm3_expa_54 +Originator(s): Tony Craig +Date: 17 Jan 2006 +One-line Summary: Update infrastructure in support of finemesh, migration from cvs + +Purpose of changes: bfb infrastructure changes committed, partial step towards finemesh implementation + +Bugs fixed (include bugzilla ID): None + +Describe any changes made to build system: None + +Describe any changes made to the namelist: None + +List any changes to the defaults for the boundary datasets: None + +Describe any substantial timing or memory changes: Some memory added for extra coarse grid, atmosphere domain, as well as changes to interpolation datatypes and code. Redundant memory deleted from some datasets. + +Code reviewed by: Mariana Vertenstein + +List all subroutines eliminated: + +List all subroutines added and what they do: + +List all existing files that have been modified, and describe the changes: + +src/main: +initGridIndexMod.F90,lnd2atmMod.F90,CNiniTimeVar.F90,abortutils.F90,clm_comp.F90,driver.F90,clm_camMod.F90,atmdrvMod.F90,subgridRestMod.F90,accFldsMod.F90,clmtypeInitMod.F90,initializeMod.F90,pftdynMod.F90,iniTimeConst.F90,histFileMod.F90,program_csm.F90,clm_atmlnd.F90,clm_varsur.F90,clm_csmMod.F90,restFileMod.F90,surfFileMod.F90,controlMod.F90,initSurfAlbMod.F90,initSubgridMod.F90,clm_varctl.F90,ndepFileMod.F90,initGridCellsMod.F90,MCT_lnd_comp.F90,program_off.F90,domainMod.F90,decompMod.F90,areaMod.F90,clmtype.F90,histFldsMod.F90 + +src/riverroute: +RtmMod.F90 + +src/biogeochem: +CASAMod.F90,DUSTMod.F90,CNPhenologyMod.F90,STATICEcosysDynMod.F90,DGVMMod.F90,CNrestMod.F90,VOCEmissionMod.F90,CNNDynamicsMod.F90,CNVegStructUpdateMod.F90 + +src/biogeophys: +BalanceCheckMod.F90,SurfaceRadiationMod.F90,SoilTemperatureMod.F90,Biogeophysics1Mod.F90,Biogeophysics2Mod.F90,FrictionVelocityMod.F90,Hydrology1Mod.F90,Hydrology2Mod.F90,BiogeophysicsLakeMod.F90,HydrologyLakeMod.F90,BareGroundFluxesMod.F90,CanopyFluxesMod.F90 + +bld/offline/tests: +CLM_lab.pm,test_batch.csh + +tools/mksurfdata: +mkdynpftMod.F90,mkgridMod.F90,shr_timer_mod.F90,mklaiMod.F90,mkglacier.F90,mkurban.F90,fileutils.F90,mksoitex.F90,mkfileMod.F90,domainMod.F90,areaMod.F90,creategridMod.F90,mkvarsur.F90,mksrfdat.F90,nanMod.F90,mklanwat.F90,mksoicol.F90,Makefile,mkpftMod.F90 + +tools/mkgriddata: +mkvarctl.F90,fileutils.F90,mkgriddata.F90,mkfileMod.F90,domainMod.F90,areaMod.F90,creategridMod.F90,mkvarsur.F90,nanMod.F90,Makefile + +Code changes: +Merge atm2lnd_state_type, atm2lnd_flux_type. Same for lnd2atm state/flux. + Related changes in clm3 and elsewhere in code. +Add domainMod.F90 and domain_type. Migrate grid data into domain type. + Instantiate adomain(atm/coarse), ldomain(lnd/finemesh), rdomain(rtm), + ddomain(atmdrv external data) in model. +Add lats, latn, lonw, lone 2d arrays and associated code changes. +Cleanup areaMod.F90; merging subroutines, removing redundant code, eliminate + *_point routines. +Remove numlon +Add decomp_type for gcelldc and gcellsn. Remove redundant data in other + arrays related to addressing physical space and logical space. +Clean up interface in set_landunit subroutines. Remove redundant code. +Clean up procs and clumps datatypes, removing redundant data. +Migrate clm3 topology data to pointers from copies +Add gridmap_type for interpolation and associated code and routines to + support the type. +Add clm_atmlnd.F90 file for upscale/downscale code. Add clm_mapa2l + and clm_mapl2a to carry out mapping associated with upscale/downscale. +Add gridmap_setmapsFM for generation of weights for downscale/upscale + routines. +forc_ndep should not be in atm2lnd_type. +Reuse code as much as possible throughout. +Update mksurfdata, mkgriddata. Speed code up, bfb, new fields added, + new input options for files. Fill with wetland, add PFTDATA_MASK + field for real/fake land. +Update code to clm3_expa_53 +Rename latixy and longxy to latc and lonc. +Remove fullgrid attribute. + +Summary of testing: + + bluesky: full clm test, full cam test + tempest: full cam test + bangkok/lf95: full cam test + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_53 + +IF tag changes answers relative to baseline comparison the +following should be filled in: bfb + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? bfb + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_53 +Originator(s): Mariana Vertenstein +Date: Fri Dec.16 2005 +One-line Summary: Put in MCT communication for cam-clm coupling + +Purpose of changes: removed lp_coupling communication and put in +MCT communication interfaces + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the input datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: Mariana Vertenstein, Rob Jacob + +List all subroutines eliminated: none + +List all subroutines added and what they do: + main/MCT_atmlnd_cpl.F90 + clm/cam MCT coupling interface - will be moved out of clm code in + near future + main/MCT_lnd_comp.F90 + clm MCT wrapper layer + main/clm_comp.F90 + module containing wrapper routines that separate clm into chunks of + code that contain no communication (e.g. clm_run1, clm_run2 has no + communicaiton). This is needed to satisfy requirement for implementing + multiple coupling interfaces (e.g. concurrent/MCT, sequential/MCT, + sequential/ESMF) within ccsm. + main/clm_varorb.F90 + module for orbital parameters + (this will be added to program_off.F90 and program_csm.F90) + +List all existing files that have been modified, and describe the changes: + clm_camMod.F90 - all coupling still exists here + +Summary of testing: + + bluesky: + test-model.pl -res T31 + test-model.pl -res T31cn + test-model.pl -res T31cnall + test-model.pl -res T31casa + test-model.pl -res T31dgvm + + tempest: No testing + + bangkok/lf95: No testing + +CLM tag used for the baseline comparison tests if applicable: clm3_expa_48 + results were bfb with clm3_expa48 + +IF tag changes answers relative to baseline comparison the +following should be filled in: + + Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + If this tag changes climate describe the run(s) done to evaluate the new + climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + + MSS location of control simulations used to validate new climate: + + URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_52 +Originator(s): Mariana Vertenstein +Date: Tues Dec.12 2005 +One-line Summary: Put in scam fix needed in CAM mode + +Purpose of changes: clean up svn clm structure + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +None + +Describe any changes made to the namelist: +None + +List any changes to the defaults for the input datasets: +None + +Describe any substantial timing or memory changes: +None + +Code reviewed by: +Mariana Vertenstein + +List all subroutines eliminated: +None + +List all subroutines added and what they do: +None + +List all existing files that have been modified, and describe the changes: +clm_camMod.F90 (this change was put into cam3_2_41) + +Summary of testing: +No testing done + +CLM tag used for the baseline comparison tests if applicable: +NA + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_51 +Originator(s): mvr +Date: Tues Dec.12 2005 +One-line Summary: removed src/utils dir + +Purpose of changes: should've been done with external setup in prev tag + +Bugs fixed (include bugzilla ID): none + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the input datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: mvr, mvertens + +List all subroutines eliminated: +D src/utils + +List all subroutines added and what they do: +none + +List all existing files that have been modified, and describe the changes: +none + +Summary of testing: + +bluesky: none +tempest: none +bangkok/lf95: none + +CLM tag used for the baseline comparison tests if applicable: + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? b4b + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== +Tag name: clm3_expa_50 +Originator(s): Mariana Vertenstein +Date: Tues Dec.12 2005 +One-line Summary: Updated external definitions for utils + +Purpose of changes: clean up svn clm structure + +Bugs fixed (include bugzilla ID): + +Describe any changes made to build system: +None + +Describe any changes made to the namelist: +None + +List any changes to the defaults for the input datasets: +None + +Describe any substantial timing or memory changes: +None + +Code reviewed by: +NA + +List all subroutines eliminated: +None + +List all subroutines added and what they do: +None + +List all existing files that have been modified, and describe the changes: +None + +Summary of testing: +No testing done + +CLM tag used for the baseline comparison tests if applicable: +NA + +IF tag changes answers relative to baseline comparison the +following should be filled in: + +Summarize any changes to answers, i.e., + - what code configurations: + - what platforms/compilers: + - nature of change (roundoff; larger than roundoff/same climate; new climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., + - source tag (all code used must be in the repository): + - platform/compilers: + - configuration (CPP ifdefs): + - build-namelist command (or complete namelist): + - MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for LMWG diagnostics output used to validate new climate: + +=============================================================== + +Tag name: clm3_expa_49 +Originator(s): Mariana Vertenstein +Date: Mon Dec 12 2005 +One-line Summary: Updated clm with changes put into cam3_2_38 + +Purpose of changes: +Cray-X1E OpenMP/CSD compatibility modifications. + +Bugs fixed (include bugzilla ID): +None + +Describe any changes made to build system: +None + +Tested that restarts are bit-for-bit: yes +Tested that different domain decompositions match bit-for-bit: yes +Code reviewed by: myself +Changes answers: no (bit-for-bit) +Changes made: + +This is the start of the clm_exp experimental development +branch. This version is the same as clm3_deva_10 which was checked +into clm_dev by Mariana Vertenstein on April 27th, 2004. +=============================================================== +=============================================================== +=============================================================== + + + + + + + + + + + + + + + + + + + + + diff --git a/components/clm/doc/ChangeSum b/components/clm/doc/ChangeSum new file mode 100644 index 0000000000..505427874e --- /dev/null +++ b/components/clm/doc/ChangeSum @@ -0,0 +1,335 @@ +Tag Who Date Summary +============================================================================================================================ + clm4_5_1_r120 andre 08/29/2015 CLM 5 nitrogen models Flexible CN and LUNA + clm4_5_1_r119 erik 08/26/2015 Bring hobart/nag bug fixes to trunk, and fix a few bugs + clm4_5_1_r118 sacks 08/05/2015 Minor rework of glc coupling fields + clm4_5_1_r117 sacks 07/28/2015 Repartition rain vs. snow from atmosphere + clm4_5_1_r116 sacks 07/22/2015 Rename some history fields + clm4_5_1_r115 sacks 07/15/2015 Remove redundant code, rename a variable + clm4_5_1_r114 sacks 07/10/2015 Update cime external, remove genf90-generated files + clm4_5_1_r113 sacks 07/09/2015 Support backwards compatibility of restart variable names + clm4_5_1_r112 oleson 07/01/2015 Justin Perket snow on vegetation + clm4_5_1_r111 sacks 06/12/2015 Remove temporary hack to get bfb results in InitSnowLayers + clm4_5_1_r110 sacks 06/12/2015 Add flexibility to have more snow layers + clm4_5_1_r109 sacks 06/06/2015 Fix bug in DivideSnowLayers + clm4_5_1_r108 andre 05/29/2015 Crop changes from Sam Levis + clm4_5_1_r107 andre 05/19/2015 Update externals to use github version of cime1.0.7. + clm4_5_1_r106 erik 05/14/2015 Fix CO2 forcing for MEGAN + clm4_5_1_r105 erik 04/16/2015 Move test lists to beneath active components, change build scripts from cshell to perl, move to new cime directory structure + clm4_5_1_r104 erik 01/27/2015 Update externals to latest cesm beta tag + bring in shared build for clm4_5/clm5_0 for testing + clm4_5_1_r103 sacks 01/01/2015 enable transient crops + clm4_5_1_r102 sacks 12/27/2014 make new input datasets to support transient crops + clm4_5_1_r101 sacks 12/09/2014 rework cold start initialization for transient runs + clm4_5_1_r100 sacks 12/03/2014 update pio calls to pio2 API + clm4_5_1_r099 sacks 12/02/2014 add ozone stress code from Danica Lombardozzi + clm4_5_1_r098 sacks 11/29/2014 update externals to cesm1_3_beta14 or beyond + clm4_5_1_r097 mvertens 11/24/2014 major refactorization to introduce new soilbiogeochem data types and routines that are independent of either ED or CN datatypes + clm4_5_1_r096 erik 11/19/2014 Several answer changing bug-fixes: snow grain size, lake hydrology, default settings, organic soil + clm4_5_1_r095 andre 11/10/2014 N comp refactoring by Jinyun Tang (LBL) and transpiration sink isolation by Gautam Bisht (LBL) + clm4_5_1_r094 sacks 11/07/2014 misc. glacier-related updates + clm4_5_1_r093 sacks 11/07/2014 change cold-start snow initialization, update cism external + clm4_5_1_r092 muszala 11/04/2014 bug fixes from santos that address valgrind problems. update rtm external + clm4_5_1_r091 muszala 10/27/2014 update externals. fix bug so CLM runs with Intel 14x. + clm4_5_1_r090 sacks 10/16/2014 modularize irrigation; do some unit test rework + clm4_5_1_r089 erik 10/13/2014 Bring new urban building temperature to trunk as a clm5.0 feature as well as human-stress index calculations + clm4_5_1_r088 muszala 10/01/2014 pull out ED deps. in TemperatureTypeMod, can now compile with pgi 14.7 + clm4_5_1_r087 erik 09/30/2014 Fix two balance check errors, and turn abort for balance check back on to appropriate levels + clm4_5_1_r086 muszala 09/25/2014 critical ED modifications from r fisher, fix bug 2043 + clm4_5_1_r085 sacks 09/19/2014 replace conditionals with polymorphism for soil water retention curve + clm4_5_1_r084 sacks 09/18/2014 make glc_dyn_runoff_routing spatially-varying, based on input from glc + clm4_5_1_r083 muszala 09/17/2014 only update scripts and run new baselines. this due to an error in yellowstone pgi test naming (clm_aux45 changed to aux_clm45) + clm4_5_1_r082 muszala 09/11/2014 Merge in a number of ED changes to address science bugs and infrastructure (partiulararly restarts) + clm4_5_1_r081 mvertens 08/24/2014 major infrastructure changes and directory reorganization under src + clm4_5_1_r080 erik 08/16/2014 Update externals to trunk version, allow eighth degree as a valid resolution + clm4_5_1_r079 andre 07/31/2014 G. Bisht (LBL) soil temperature refactor; machines update for goldbach-intel + clm4_5_1_r078 muszala 07/23/2014 add lai stream capability and the ability to run with V5 cruncep data + clm4_5_1_r077 andre 07/10/2014 Refactor from Jinyun Tang (LBL) to make hydrology more modular. + clm4_5_1_r076 erik 07/07/2014 Answer changes for fire code from Fang Li + clm4_5_75 muszala 05/30/2014 update externals to rtm1_0_38 and esmf_wrf_timemgr_140523 + clm4_5_74 sacks 05/28/2014 misc. bfb changes - see detailed summary below + clm4_5_73 erik 05/28/2014 Add the stub ability for clm5_0 physics to CLM build system + clm4_5_72 muszala 05/05/2014 Introduce code for Ecosystem Demography (CLM(ED)) Model + clm4_5_71 sacks 05/02/2014 2-way feedbacks for glacier, veg columns compute glacier SMB, and related changes + clm4_5_70 muszala 04/18/2014 bring in SHR_ASSERT macros + clm4_5_69 andre 03/18/2014 start unit testing build-namelist + clm4_5_68 erik 03/07/2014 Update scripts to version that turns on transient CO2 streams for transient compsets, and update CISM (changes answers) + clm4_5_67 mvertens 03/06/2014 removed initSurfAlb as part of the initialization + clm4_5_66 mvertens 03/03/2014 refactoring of initialization and introduction of run-time finidat interpolation + clm4_5_65 mvertens 02/25/2014 Turn off MEGAN vocs when crops is running + clm4_5_64 muszala 02/19/2014 fix and clean ncdio_pio.F90.in. clean clm_time_manager. update externals. + clm4_5_63 sacks 02/14/2014 add some code needed for dynamic landunits; activate 0-weight veg landunit sometimes + clm4_5_62 erik 02/10/2014 Get PTCLM working robustly, US-UMB test working, add CO2 streams to datm, add more consistency testing between compsets and user settings + clm4_5_61 sacks 02/04/2014 add 3-d snow history fields; continue harvest past end of pftdyn timeseries + clm4_5_60 andre 01/30/2014 refactor build-namelist + clm4_5_59 sacks 01/22/2014 use new get_curr_yearfrac function in clm_time_manager + clm4_5_58 sacks 01/22/2014 major refactor of transient pft code, in prep for dynamic landunits + clm4_5_57 sacks 01/07/2014 change CNDV water conservation to use the pftdyn method + clm4_5_56 sacks 01/02/2014 update scripts external to fix I20TRCLM45BGC compset + clm4_5_55 sacks 12/27/2013 add hooks to Sean Santos's unit test frameworks, and begin to add CLM unit tests + clm4_5_54 sacks 12/27/2013 update externals to cesm1_3_beta06 + clm4_5_53 muszala 12/19/2013 refactor restart interfaces + clm4_5_52 sacks 11/26/2013 turn on longwave radiation downscaling for glc_mec by default + clm4_5_51 sacks 11/26/2013 rework downscaling of atm fields for glc_mec + clm4_5_50 erik 11/24/2013 Bring in a bunch of b4b bugfixes, fix getregional script, start move of PTCLM to PTCLMmkdata tool + clm4_5_49 muszala 11/16/2013 swenson anomaly forcing - part 1 + clm4_5_48 muszala 11/14/2013 bug fixes for CLM dry deposition and MEGAN VOC emissions + clm4_5_47 muszala 11/12/2013 fix Bug 1858 - AGDD now reset annually + clm4_5_46 sacks 11/08/2013 remove zeroing out of slope for special landunits + clm4_5_45 sacks 11/08/2013 refactor daylength calculation, and other minor changes + clm4_5_44 sacks 11/08/2013 temporary hack to daylength initialization to provide baselines for the next tag + clm4_5_43 sacks 11/06/2013 allocate memory for most landunits in every grid cell (needed for dynamic landunits) + clm4_5_42 sacks 11/04/2013 fix bug 1857 for CLM4.5 - CNDV running temperature means are incorrect + clm4_5_41 andre 10/30/2013 update scripts to convert clm4_5 CPP flags to namelist variables. + clm4_5_40 muszala 10/24/2013 fix Bug 1752 - urban conductances depend on weights in an undesirable way + clm4_5_39 muszala 10/23/2013 bug fix from santos - h2osoi_vol not passed to atmosphere model on restart + clm4_5_38 sacks 10/18/2013 change irrigation variables to be pft-level + clm4_5_37 muszala 10/10/2013 Modifications to bring clm up to date with major driver refactoring in drvseq5_0_01 + clm4_5_36 sacks 10/04/2013 new surface datasets, and other minor fixes + clm4_5_35 sacks 10/01/2013 get CLM running on edison + clm4_5_34 erik 09/30/2013 Get PTCLM working, fix a few small bugs + clm4_5_33 muszala 09/26/2013 clean up from mistakes in previous tag + clm4_5_32 muszala 09/26/2013 bug fix tag - 1798, 1810 + clm4_5_31 sacks 09/25/2013 fix bug 1820: incomplete conditional in CNSoyfix leads to buggy results and decomposition dependence + clm4_5_30 sacks 09/24/2013 fix performance bug in decomposition initialization + clm4_5_29 sacks 09/24/2013 fix threading in CLM4.5, and other misc fixes + clm4_5_28 sacks 09/20/2013 fix FracH2oSfc bug + clm4_5_27 sacks 09/20/2013 fix crop nyrs bug + clm4_5_26 muszala 09/19/2013 water balance and SMS_Ly1.f19_g16.ICLM45BGCCROP fix + clm4_5_25 erik 09/13/2013 Bring in Tony's changes to kick sno all the way up to the coupler layer, makes all + CESM components more similar to each other + clm4_5_24 sacks 09/03/2013 update externals to cesm1_3_beta02 or later + clm4_5_23 muszala 08/22/2013 refactor to allow CH4 params. to be read from netcdf file and clean up clm4_5_20 + clm4_5_22 muszala 07/30/2013 aux_clm testlist reorganization + clm4_5_21 muszala 07/24/2013 ifdef and bounds refactor + clm4_5_20 muszala 07/20/2013 refactor to allow CN and BGC params. to be read from netcdf file + clm4_5_19 sacks 07/17/2013 fix setting of bd in iniTimeConst + clm4_5_18 sacks 07/09/2013 rework urban indexing + clm4_5_17 sacks 07/03/2013 misc cleanup and bug fixes + clm4_5_16 sacks 07/02/2013 only run filters over 'active' points + clm4_5_15 muszala 07/01/2013 complete associate refactor for pointers in clm4_5 source + clm4_5_14 muszala 06/20/2013 preparation for associate refactor in clm4_5_15 + clm4_5_13 andre 06/14/2013 hydrology reordering from Jinyun Tang + clm4_5_12 muszala 06/13/2013 NoVS test, NAG mods and remove TWS from restart file + clm4_5_11 sacks 06/11/2013 Change pct_pft and related surface dataset variables to be % of landunit + clm4_5_10 muszala 06/10/2013 refactor clmtype + clm4_5_09 muszala 06/04/2013 volr and vic fix, update mct and rtm + clm4_5_08 muszala 06/03/2013 port for NAG compiler + clm4_5_07 erik 05/31/2013 New spinup files for CLM45 AND RTM, work on PTCLM, turn drydep off by default, update externals + clm4_5_06 erik 05/15/2013 A few small bug fixes, more updates to README files + clm4_5_05 muszala 05/14/2013 hcru bug fixes + clm4_5_04 erik 05/13/2013 Fix the previous broken tag + clm4_5_03 erik 05/10/2013 Several bug fixes for release, urban and test single point surface datasets + clm4_5_02 sacks 05/07/2013 make 'shared' tools directory, and other minor tools fixes + clm4_5_01 muszala 05/06/2013 update externals + clm4_5_00 erik 05/02/2013 Official end to CLM4.5 development for CLM offline + clm4_0_81 bandre 04/29/2013 Charlie Koven's variable consolidation, cryoturbation and BSW CPP changes + clm4_0_80 erik 04/26/2013 Bring Fang Li. Fire model into CLM4.5 science, update ALL CLM4.5 surface datasets, + provide a working initial condition file for CLM45BGC@f19_g16-1850 + clm4_0_79 muszala 04/24/2013 pftdyn, pft-phys*.nc and datm8 update + clm4_0_78 muszala 04/23/2013 MEGAN fixes + clm4_0_77 sacks 04/23/2013 fix carbon balance bug in transient runs with VERTSOI, and fix Soil Hydrology bug + clm4_0_76 muszala 04/22/2013 spinup changes from Charlie Koven (part 1) + clm4_0_75 muszala 04/19/2013 run propset + clm4_0_74 muszala 04/17/2013 snow_depth changes, major scripts overhaul, bug fix for tools + clm4_0_73 sacks 04/15/2013 update mksurfdata_map for CLM4.5, and other misc. updates, mainly to tools + clm4_0_72 muszala 04/11/2013 maoyi bug fix for vic hydro + clm4_0_71 muszala 04/10/2013 compsets refactoring by mvertens + clm4_0_70 muszala 04/01/2013 bring in vic hydrology + clm4_0_69 muszala 03/26/2013 remove hydro reorder, volr and esmf mods + clm4_0_68 erik 03/16/2013 Fix some issues in mksurfdata_map for generation of ne120np surface data file. + Put error back in CLM if weights don't sum to 100. Add in Keith's photosynthesis change for CLM45. + clm4_0_67 muszala 03/12/2013 Jinyun photosynthesis and hydrology reorder + clm4_0_66 sacks 03/07/2013 turn off subgrid topography snow parameterization for glc_mec landunits + clm4_0_65 sacks 03/07/2013 back out Machines external to get more tests to pass, especially IG + clm4_0_64 muszala 03/06/2013 update externals. fixes 40/45 intial condition problem + clm4_0_63 muszala 03/04/2013 bug 1635 fix - 4_0 CN bug + clm4_0_62 sacks 02/24/2013 add active flags, change subgrid weighting convention, other misc fixes + clm4_0_61 muszala 02/20/2013 rtm, drv and clm mods: tws, olr, r01 rdric file and SoilHydroMod + clm4_0_60 erik 02/11/2013 Bring CLM4.5 code from clm45sci branch to trunk as an option set at configure time + clm4_0_59 mvertens 12/20/2012 restructure clmtype and all pointer references, new directory structure + clm4_0_58 erik 12/14/2012 Uncomment us20 and wus12 datasets, more testing to: bluefire, yellowstone, frankfurt + clm4_0_57 muszala 11/30/2012 update trunk with release mods, some rtm fixes + clm4_0_56 sacks 11/27/2012 fix s2x tsrf, add s2x diagnostics + clm4_0_55 muszala 11/14/2012 bring in flooding capability + clm4_0_54 erik 10/09/2012 Fix esmf for carma field, fix some CLM_USRDAT issues + clm4_0_53 erik 10/03/2012 Update to fsurdat, fpftdyn, finidat datasets, new high resolution organic/fmax/glacier raw datasets + clm4_0_52 sacks 09/27/2012 new pct_glacier raw data file + clm4_0_51 muszala 09/26/2012 bug fixes, pio performance and SCRIP files + clm4_0_50 muszala 09/21/2012 testing of clm and new rof component + clm4_0_49 erik 09/16/2012 Move clm testing to use CESM test framework + clm4_0_48 muszala 09/11/2012 bug fixes, xFail to tests and normalize test output for CLM + clm4_0_47 muszala 08/23/2012 bug fixes + clm4_0_46 muszala 08/08/2012 R01 support and update externals + clm4_0_45 sacks 07/20/2012 fix virtual columns; new urban mksurfdata_map + clm4_0_44 erik 07/09/2012 Add wrf resolutions, update externals to cesm1_1_beta15, all components use build-namelist now + clm4_0_43 sacks 04/06/2012 Add diagnostic fields, modify some existing history fields + clm4_0_42 erik 03/27/2012 Bring in Francis Vitt's MEGAN changes. + clm4_0_41 erik 03/13/2012 Bring rmfmesh/rtmmap branches to trunk + clm4_0_40 erik 02/16/2012 Back out update to new T31 surface datasets + clm4_0_39 erik 02/01/2012 Bring newgrid branch to trunk + clm4_0_38 erik 01/23/2012 Fix f09 surface datasets + clm4_0_37 erik 09/26/2011 Fix unstructured grids history files + clm4_0_36 erik 09/22/2011 Comment out RTM mapping files for f09 and f19 + clm4_0_35 erik 09/13/2011 Bring in Mariana's non2D grid branch to trunk, enabling HOMME grids: ne30np4/ne120np4 + clm4_0_34 erik 08/18/2011 Bring tcens branch to trunk, fix a few issues + clm4_0_33 erik 07/25/2011 Move changes on release branch over to trunk + clm4_0_32 erik 05/19/2011 Make I1850SPINUPCN compset use MOAR data, various bug fixes, work on test lists + clm4_0_31 erik 05/13/2011 Fix answers for transient_CN, fix interpinic + clm4_0_30 erik 05/11/2011 New finidat/fsurdat files for T31 + clm4_0_29 erik 05/05/2011 Backout interpinic changes to one that works + clm4_0_28 erik 05/03/2011 Remove DUST/PROGSSLT in land coupler layer, update driver and scripts + clm4_0_27 erik 05/02/2011 Move crop branch over to trunk + clm4_0_26 erik 03/23/2011 Update externals, driver update changes answers, drydep changes from fvitt, fix bugs + clm4_0_25 erik 03/22/2011 Always output restart-history files add more meta-data to them, fix urbanc_alpha and 2.5x3.33 datasets, Changes from Keith O on SNOWLIQ/SNOWICE + clm4_0_24 erik 02/09/2011 Fix mksurfdata and add ability to override soil_fmax + clm4_0_23 erik 02/03/2011 Add in new glacier-MEC use-cases + clm4_0_22 erik 01/20/2011 Move coupler field indicies to clm, move cpl_* directories up a level, add the cpl_share directory + clm4_0_21 jedwards 01/12/2011 Remove includes, finish PIO transition + clm4_0_20 erik 01/11/2011 Update for ESMF metadata, update doc. from release branch, bug fixes (doc of qflx_evap_tot, threading CNDV, aer/ndepregrid) + clm4_0_19 erik 12/08/2010 Bring irrigation branch to the trunk + clm4_0_18 erik 11/21/2010 Fix a problem with the clm template, update scripts version to fix bug with linking with ESMF + clm4_0_17 erik 11/20/2010 Update to externals that change answers to roundoff, use drv pio namelist, add in T341 datasets + clm4_0_16 erik/mverten 10/27/2010 Fix downscaling roundoff difference for same-grids by copying scale factor when needed + clm4_0_15 erik/mverten 10/24/2010 Move pio branch to trunk + clm4_0_14 erik 10/19/2010 Fix finidat file for T31 sim_year=2000 cases + clm4_0_13 erik 10/16/2010 Bring in PTCLM branch, add in T31 finidat file and turn off ice_runoff for T31 + clm4_0_12 erik 09/10/2010 Add U10 to history, cesm1_0_rel06 updates, PTCLM02 updates (except mksurfdata), remove ndepdat/dyn/faerdep + clm4_0_11 erik 08/27/2010 New files for rcp6, fix MPI bug, update externals + clm4_0_10 erik 08/04/2010 Update doc to cesm_rel05, bug-fixes, fix issues for single-point, mksurfdata/getregional scripts + clm4_0_09 erik 06/14/2010 Fix some small issues, update documentation, and externals + clm4_0_08 erik 06/04/2010 Snow hydrology bug fix from Keith and Dave + clm4_0_07 erik 06/03/2010 Some cleanup/fix bugs, add RTM var, add albice to namelist, allow last-millenium in mksurfdata, allow setting of datm_presaero in clm test-suite + clm4_0_06 erik 05/26/2010 Update gglc to cism + clm4_0_05 erik 05/25/2010 Move Nitrogen deposition stream branch to trunk + clm4_0_04 erik 05/20/2010 New namelist items: ice_runoff, scaled_harvest, carbon_only, + new RTM hist vars, new finidat files, update esmf interface, turn off aerosol read quicker + clm4_0_03 erik 05/17/2010 Changes from Francis for VOC and drydep + clm4_0_02 erik 05/13/2010 Make sure dtime is initialized, so that answers are consistently the same as clm4_0_00 + clm4_0_01 erik 05/11/2010 Move glacier multiple elevation class branch to the trunk so that we can work with the active glacier model + clm4_0_00 erik 05/04/2010 Update to datm8, redirect aquifer overflow + to drainage, add gx3v7 masks, script to extract regional + datasets, add harvesting for CN, modify shrubs, include urban + model, ice stream for snowcapping, new build-namelist system, + scale solar by solar zenith angle in datm, deep soil with + bedrock at bottom, organic matter in soils, SNICAR for snow + radiation, sparce dense aero, snow cover changes + clm3_8_00 erik 05/04/2010 Get future scenarios working, finalize + documentation, bring in MEGAN VOC and CNDV, simplify, + mksurfdata optimization, fix bugs: snow enthalpy, BMOZ, pergro, + use pft weights from fsurdat NOT finidat + clm3_7_15 erik 04/27/2010 Finish User's Guide, surfdata files for urban-1pt, fix mksurfdata ifort bugs, work with testing + clm3_7_14 erik 04/08/2010 Fix rcp=2.6/4.5 1-degree fndepdyn filenames + clm3_7_13 erik 04/08/2010 Add in missing rcp=2.6/6 use-cases, and fix syntax errors in the namelist_defaults file + clm3_7_12 erik 04/08/2010 rcp=2.6/4.5 datasets for fndepdyn and aerdepdat, fix some minor issues, new 1pt urban surfdata files + clm3_7_11 erik 04/07/2010 qtr-degree and T85 surfdata, rcp=2.6/4.5 datasets, doc updates + clm3_7_10 erik 03/22/2010 Fix drydep so that BMOZ case will work + clm3_7_09 erik 03/21/2010 Fix snow enthalpy bug, cndv datasets, various fixes + clm3_7_08 mvertens 03/12/2010 Removal of check for weights if dynamic land use is +used + clm3_7_07 erik 03/10/2010 New finidat datasets for 1-deg, 2-deg, and abort if weights from finidat/fsurdat files are too different, and use fsurdat files as truth + clm3_7_06 erik 03/10/2010 Bring cndv branch to trunk + clm3_7_05 erik 02/24/2010 Bring VOC branch source code to trunk + clm3_7_04 erik 02/17/2010 Bring VOC branch (vocemis-drydep18_clm3_7_03) tools, testing, and build to trunk (everything other than VOC code changes) + clm3_7_03 erik 02/10/2010 Add in more future scenario datasets, new history fields from Keith + clm3_7_02 erik 02/06/2010 Start adding in new rcp=8.5 datasets, remove some junk, change some env_conf variables, add user_nl_clm + clm3_7_01 erik 01/29/2010 OpenMP fix for pftdyn, start adding in rcp's, update ndeplintInterp.ncl script + clm3_7_00 erik 01/22/2010 Update to datm8, redirect aquifer overflow to drainage, add gx3v7 masks, script to extract regional datasets, add harvesting for CN, modify shrubs, include urban model, ice stream for snowcapping, new build-namelist system, scale solar by solar zenith angle in datm, deep soil with bedrock at bottom, organic matter in soils, SNICAR for snow radiation, sparce dense aero, snow cover changes + clm3_6_64 erik 01/22/2010 Update documentation and README/Quickstart files, set NetCDF large-file format on by default in template, update pio, update some fsurdat files to vocemis-drydep versions, add 2.5x3.33_gx3v7 frac file, make gx3v7 default for 4x5 res + clm3_6_63 erik 01/09/2010 Get answers to be identical with ccsm4_0_beta38 for 1 and 2 degree transient cases + clm3_6_62 erik 01/08/2010 Fix startup of PFT transient cases so properly use data from pftdyn file rather than finidat file + clm3_6_61 erik 01/07/2010 Comment out endrun on finidat and fsurdat weights being incomptable, and go back to using finidat weights + clm3_6_60 erik 01/05/2010 Fix clm template + clm3_6_59 erik 01/05/2010 Update to datm8, fix so wts used are from fsurdat file NOT finidat file + clm3_6_58 erik 12/08/2009 Fix rpointer, correct units for export of nee, start adding testing for intrepid + clm3_6_57 erik 11/20/2009 Redirect aquifer overflow to drainage, so doesn't end up in ocean + clm3_6_56 erik 11/10/2009 New ndepdat and ndepdyn datasets + clm3_6_55 erik 11/05/2009 Fix tool to create Nitrogen deposition datasets, and change configure to use CCSM Makefile as source for TopLevel Makefile + clm3_6_54 erik 10/28/2009 Allow comp_intf to change on ccsm build, reduce default hist fields, start adding 2.5x3.33, start adding VOC fsurdat datasets, new finidat files for f09 and f19 + clm3_6_53 erik 09/22/2009 Fix so that T31_gx3v7 file is actually included + clm3_6_52 erik 09/17/2009 Add T31_gx3v7 support, remove forganic, read from fsurdat, add script to extract regional datasets, work with CN output, add more urban/rural fields + clm3_6_51 erik 09/01/2009 Update fndepdyn and aerdep datasets (f02,f05,f09,f10) (1850,2000) and f09, f10 transient (1850-2000) + clm3_6_50 erik 08/28/2009 Fix ncl regridding scripts so that NO missing values are allowed for aerosol and nitrogen deposition + clm3_6_49 erik 08/25/2009 Fix ncl interpolation scripts, update externals, turn on CLM_CCSM_BLD for bluefire,jaguar, ESMF3 compliance + clm3_6_48 erik 08/12/2009 New aerosol/nitrogen deposition datasets, mksurfdata work, scm work, clm_usr_name option to build-namelist + clm3_6_47 erik 08/03/2009 Fix hybrid bug for dynpft case, update externals + clm3_6_46 erik 07/22/2009 Get more tests to work/document them, add use cases for 1850_control, 2000_control, and + 20thC_transient, straighten out single-point grids, Listen to LND_CDF64 env variable from + template, remove CLM_ARB_IC. + clm3_6_45 erik 07/10/2009 Remove inconsistent finidat file in clm3_6_44 + clm3_6_44 erik 07/09/2009 Fix C13 bug, update scripts, drv, datm. Add domain files for idmap atm-ocn grids for datm. Remove SEQ_MCT, add new ESMF env vars to template. Work with ndeplintInterp + clm3_6_43 erik 06/10/2009 Fix pftdyn bug, enable 1D primary hist files, fix time-const3D output, fix template bug, enable cpl_esmf/cpl_mct + clm3_6_42 erik 06/02/2009 Bring CN Harvest branch to trunk + clm3_6_41 kauff 05/29/2009 shrub mods, abort if nthreads > 1 (temporary, wrt bugz #965) + clm3_6_40 erik 05/28/2009 Fix openMP bug, add fndepdyn ncl script, fix interpinic for urban, add mkharvest to mksurfdata, new spinups, turn CLAMP on for CASA or CN + clm3_6_39 erik 05/07/2009 Bug fix for script version and maxpatchpft back to numpft+1 + clm3_6_38 erik 05/06/2009 New fsurdat for other resolutions, bug-fixes, deep wetlands to bedrock, new spinups for 1.9x2.5 1850, 2000 + clm3_6_37 erik 04/27/2009 Update faerdep dataset for 1.9x2.5 to point to version cice is using for 1850 and 2000 + clm3_6_36 erik 04/27/2009 Handle transient aersol, make maxpatchpft=numpft+1 default, new datasets for 1.9x2.5 and 0.9x1.25, change doalb + clm3_6_35 erik 04/20/2009 Fix major logic bug in mksurfdata + clm3_6_34 oleson 04/19/2009 Fix bangkok urban bug + clm3_6_33 erik 04/16/2009 Bring in dynpft changes from cbgc branch + clm3_6_32 erik 04/15/2009 Add irrigation area to mksrfdata, fix high-res and pftdyn problems + clm3_6_31 erik 04/01/2009 New surface datasets for 1850,2000, support for 0.9x1.25_gx1v6, urban always on. New pft-physiology file. Update scripts so remove some CLM_ env_conf vars. Fix CN for urban/pftdyn. + clm3_6_30 oleson 03/19/2009 Fix urban roof/wall layers + clm3_6_29 oleson 03/19/2009 CN SAI, CN testing fix, rad step size fix + clm3_6_28 oleson 03/17/2009 Fix permission denied error when reading surface dataset + clm3_6_27 oleson 03/16/2009 Urban model changes and FGR12 fix + clm3_6_25 dlawren 03/13/2009 Daylength control on Vcmax, 1%Lake,wetland,glacier in mksrfdat, remove ELEVATION in surface data file + clm3_6_24 oleson 03/09/2009 Fix urban testing and some history field changes + clm3_6_23 oleson 03/08/2009 Prune history fields and change to snowdp threshold for solar radiation penetration into snow + clm3_6_21 oleson 03/04/2009 History file changes and finish testing on tags clm3_6_19 and clm3_6_20 + clm3_6_19 oleson 02/27/2009 Changes to urban model and urban surface data + clm3_6_17 oleson 02/26/2009 Urban model changes and mksurfdata changes to incorporate urban data + clm3_6_16 erik 02/12/2009 Multiple elevation classes on surface dataset, urban fixes, mpi-serial and testing fixes + clm3_6_15 erik 01/19/2009 Bring clm36sci branch to the trunk + clm3_6_14 erik 10/10/2008 Fix some global urban issues, fix pftdyn, really get compile-only option + working in testing + clm3_6_13 erik 10/01/2008 Update to new version of cpl7 scripts and build, update externals for versions + needed for clm36sci branch, add new CASA tests + clm3_6_12 erik 09/21/2008 Fix restarts for urban, add capability to do global urban experiments, + add in new forcing height changes + clm3_6_11 dlawren 08/26/2008 Ice stream for snow capped regions + clm3_6_10 tcraig 08/15/2008 extend rtm tracer, ascale for tri-grids, AIX O3 to O2 + clm3_6_09 erik 08/11/2008 Fix clm.cpl7.template to run hybrid and branch cases + clm3_6_08 erik 08/06/2008 Fix bugs, and build changes for inputdata repo + clm3_6_07 erik 07/08/2008 Implement new build namelist system from Vertenstein/Eaton, bluefire, and BGP updates + clm3_6_06 erik 05/30/2008 Small fix needed for ccsm4_alpha30 + (use gx1v5 for some resolutions when OCN_GRID==ATM_GRID) + clm3_6_05 erik 05/27/2008 Fix to compile with PGI-6, update scripts, fix cpl7.template for new scripts LND_GRID, + fix 2.65x3.33 frac dataset. + clm3_6_04 erik 05/20/2008 Remove all MCT permutes, fix cpl7 script issues, remove offline mode, + add ability to run over a range of years + clm3_6_03 erik 05/08/2008 Fix so listen to next_swcday to calculate albedo rather than using irad + clm3_6_02 erik 03/25/2008 Minor fix in configure remove perl5lib version under models/lnd/clm/bld + clm3_6_01 erik 03/20/2008 40 m forcing height changes for clm + clm3_6_00 erik 03/20/2008 Fully implement sequential-ccsm mode, upgrade configure, build-namelist and testing, + upgrade interpolation tool, add mkdatadomain, write to iulog rather than 6 explicitly, + SCAM update, Update datasets, add archiving, and build-streams, add in point version + of Urban model, change directory structure to mimic CCSM + clm3_5_20 erik 03/17/2008 Bug fixes before spinning off clm3_6_00, put in changes from ccsm4a01_clm3_5_18 + to ccsm4a04_clm3_5_18 + clm3_5_19 erik 03/06/2008 Change directory structure to mimic CCSM, fix so no NaNS on BGC interpinic output, + new half degree CN clmi dataset + clm3_5_18 erik 02/21/2008 Update to latest seq-ccsm4.alpha tag + clm3_5_17 erik 02/06/2008 Merge Tony Craig's FMI branch fmi12_clm3_5_16 to the clm trunk + clm3_5_16 erik 01/28/2008 Get point version of Urban code onto trunk (urban code can not restart) + clm3_5_15 erik 12/10/2007 Fix interpinic for half degree grid, add in large-file support, + allow configure to work with ccsm directory structure + clm3_5_14 erik 11/27/2007 Use build-streams, and archiving, multiple bug-fixes + clm3_5_13 erik 11/16/2007 Update xml file with file needed for ccsm3_5_beta18 + clm3_5_12 erik 11/08/2007 Tag with new files needed for ccsm3_5_beta17 + clm3_5_11 erik 09/28/2007 Update datasets in the DefaultCLM file for 0.23x0.31, 0.47x0.63, 0.9x1.25 and + add fndepdyn file for 1.9x2.5 + clm3_5_10 jet 09/18/2007 SCAM update + clm3_5_09 erik 08/31/2007 Change configure to NOT have csm_share code for ccsm_con option, and add in 1x1.25 file, + and update datm7 and csm_share + clm3_5_08 tcraig 08/20/2007 convert 6 to iulog in logfile, updates for I/O + clm3_5_07 erik 08/17/2007 Add mkdatadomain tool, add cprnc and perl5lib as externals + clm3_5_06 erik 08/10/2007 Update: interpolation, testing, script namelist build, and scripts. Fix bugs, + and fix possible + clm3_5_05 tcraig 07/11/2007 seq clm mods and first hist refactor mods + clm3_5_04 mvertens 06/05/2007 lnd_comp_mct.F90 change to work with sequential diagnostics + clm3_5_03 tcraig 05/23/2007 reduce memory, partial I/O refactor, downscaling implementation + clm3_5_02 mvertens 05/22/2007 put in hourly coupling with sequential driver + clm3_5_01 erik 05/16/2007 Move newcn06 branch to trunk + clm3_5_00 erik 05/03/2007 New surface datasets, improved canopy integration, and various improvements to Hydrology diff --git a/components/clm/doc/CodeReference/Filepath b/components/clm/doc/CodeReference/Filepath new file mode 100644 index 0000000000..8e9c406b2b --- /dev/null +++ b/components/clm/doc/CodeReference/Filepath @@ -0,0 +1,4 @@ +/fs/cgd/data0/erik/clm_rel_doc_source/cesm1_1_0_n07_clm4_0_54/models/lnd/clm/doc/CodeReference/../../src/main/cpl_mct +/fs/cgd/data0/erik/clm_rel_doc_source/cesm1_1_0_n07_clm4_0_54/models/lnd/clm/doc/CodeReference/../../src/main +/fs/cgd/data0/erik/clm_rel_doc_source/cesm1_1_0_n07_clm4_0_54/models/lnd/clm/doc/CodeReference/../../src/biogeochem +/fs/cgd/data0/erik/clm_rel_doc_source/cesm1_1_0_n07_clm4_0_54/models/lnd/clm/doc/CodeReference/../../src/biogeophys diff --git a/components/clm/doc/CodeReference/Makefile b/components/clm/doc/CodeReference/Makefile new file mode 100644 index 0000000000..534bd4bcf8 --- /dev/null +++ b/components/clm/doc/CodeReference/Makefile @@ -0,0 +1,36 @@ +# +# Makefile to convert clm code documentation into html +# Currently using ProTex, eventually will be converted into +# Doxygen +# + +# Set up special characters +null := +space := $(null) $(null) +comma := $(null),$(null) +dirs := . $(shell cat Filepath) + +# Expand any tildes in directory names. Change spaces to colons. +VPATH := $(foreach dir,$(dirs),$(wildcard $(dir))) +VPATH := $(subst $(space),:,$(VPATH)) + +# Get list of files +FIND_FILES = $(wildcard $(dir)/*.[Ff]90) +SOURCES = $(foreach dir, $(dirs),$(FIND_FILES)) + +.SUFFIXES: .F90 .tex .html .dvi .pdf + +HTMLCR := index.html + +all: $(HTMLCR) + +clmcr.tex: $(SOURCES) + protex -F $(SOURCES) > clmcr.tex + +$(HTMLCR): clmcr.tex + latex2html -noshow_section_numbers -nosubdir clmcr.tex + +clean: + rm -f $(HTMLCR) +realclean: clean + rm -f clmcr.tex node*.html clmcr.css clmcr.html clmcr.aux clmcr.tex clmcr.pdf clmcr.toc internals.pl labels.pl WARNINGS diff --git a/components/clm/doc/IMPORTANT_NOTES b/components/clm/doc/IMPORTANT_NOTES new file mode 100644 index 0000000000..67c3b80677 --- /dev/null +++ b/components/clm/doc/IMPORTANT_NOTES @@ -0,0 +1,72 @@ +IMPORTANT_NOTES May/07/2013 + Erik Kluzek + +I.) For clm4_0: + +Configure Modes NOT scientifically validated, documented, supported or even advised to be used: +(options to CLM_CONFIG_OPTS) + + SNICAR_FRC (-snicar_frc) + This mode is tested and functional, but is NOT constantly scientifcally validated, and should be + considered experimental. + +Namelist items that should NOT be exercised: + + glc_dyntopo Change topographic height over glacier MEC (Not functional) + suplnitro='ALL' (suplnitro='ALL' with -bgc cn) + The suplemental Nitrogen mode of the CN model is known + to be too productive. + urban_traffic: Not currently functional + +II.) For clm4_5: + +Configure Modes NOT scientifically validated, documented, supported or even advised to be used: +(options to CLM_CONFIG_OPTS) + + VIC (-vichydro) + VIC hydrology has just been added, and this mode is experimental. + + EXTRALAKELAYERS (-exlaklayers) + Experimental and not normally exercised. + + (-vsoilc_centbgc no-cent,no-nitrif) + CLM4.5 BGC is normally exercised with vertical soil carbon, Century pools, and + Nitrification/Denitrification with the CLM4Me Methane model. Turning Century pools + off and/or Nitrification/Denitrification off is experimental and NOT normally exercised. + We do limited testing with CLM4.5 BGC without vertically resolved Carbon pools. + +Namelist items that should NOT be exercised: + + See + + ../bld/namelist_files/namelist_definition_clm4_5.xml -- for definitions + + All of these are experimental, and most are NOT tested, some aren't even functional. + The two thare ARE tested are: more_vertlayers and allowlakeprod + + allowlakeprod Turn methane production on for lake columns + anoxia_wtsat Weight calculation of oxygen limitation by the inundated fraction + if anoxia is on. + (NOT functional -- Deprecated will be removed) + atm_c14_filename C14 dataset -- No dataset provided + exponential_rooting_profile Use exponential rooting profile. + fin_use_fsat Use the saturated fraction (fsat) calculated + in Soil Hydrology to diagnose the inundated fraction + glc_dyntopo Change topographic height over glacier MEC (Not functional) + lake_decomp_fact Used if allowlakeprod is on + more_vertlayers Increase number of vertical layers + no_frozen_nitrif_denitrif No denitrification or nitrification in frozen soil layer + perchroot Weight btran by unfrozen layers + perchroot_alt Weight btran by active layer + replenishlakec Maintain constant soil carbon under lakes + use_c14_bombspike Use C14 dataset -- No datasets provided + usefrootc Use the fine root carbon predicted by CN + +See KnownBugs/KnownLimitations files for Known Problems: + + See the KnownBugs file in this directory for the list of known problems. We expect + that eventually we will fix the bugs in this list. In the KnownLimitations file + we list limitations in the code that we have workarounds for that we do NOT expect + to fix. + + diff --git a/components/clm/doc/KnownBugs b/components/clm/doc/KnownBugs new file mode 100644 index 0000000000..601542a1db --- /dev/null +++ b/components/clm/doc/KnownBugs @@ -0,0 +1,464 @@ +Known Bugs in CLM4.0.54 in CESM1.1.0 Nov/08/2012 + +==================================================================================== +Bug Number: 1543 +large-file format does NOT work in latest clm + +CLM has the NetCDF large-file format hardwired to TRUE. You can NOT use the namelist +variable outnc_large_files to change them to Classic format. + +==================================================================================== +Bug Number: 1398 +clm and mksurfdata_map needs to check map file + +If the map files sent to CLM are inconsistent with the datafiles, CLM does NOT +nicely abort, but aborts with the following types of problem.... + + +==================================================================================== +Bug Number: 1397 +c2l_scale_type not specified for many history fields + +Bill Sacks reports the following problem... + +Many history fields do not have a c2l_scale_type parameter (in histFldsMod), +but it seems they should. For example, there is a set of water flux variables, +starting with QFLX_RAIN_GRND and ending with QFLX_DEW_SNOW, most of which do +not have a c2l_scale_type. From talking with Keith Oleson, it seems that at +least some and maybe all of these should have c2l_scale_type='urbanf', by +analogy with similar fluxes that do have a c2l_scale_type specified. + +From talking with Keith Oleson: it sounds like most fluxes should have +c2l_scale_type='urbanf', but this isn't necessarily always true. So this will +require more investigation to determine the appropriate scale type for each +history field. + +Most (all?) of the fields that do not have a c2l_scale_type are ones that were +added after the urban model came in - for example, fields that were added when +the CN code came in. So my guess is that whoever added these fields didn't +realize that a c2l_scale_type was required. + +After these fields are fixed, perhaps scale_type_c2l should be made a required +argument to hist_addfld1d and hist_addfld2d to prevent this problem from +arising again in the future. + +==================================================================================== +Bug Number: 1377 +CLM1PT mode is in extend mode by default, so fails going beyond one data cycle + +PLM1PT mode puts atm forcing data in extend mode so if you go beyond one data +cycle it gives screwy results. I ran the spinup series with PTCLM and since it +was running over multiple years after it ran one cycle it used the last +time-step for the future years. + +Here's one way to fix this issue after a case is built... + + sed "s/'extend','cycle'/'cycle','cycle'/g" Buildconf/datm.buildnml.csh > datm.bld + mv datm.bld Buildconf/datm.buildnml.csh + +See bug 1368 below for a case where this causes a major problem with a +simulation. + +==================================================================================== +Bug Number: 1368 +PTCLM for US-UMB spins up with zero GPP + +I ran a spinup with PTCLM (to test the procedure and to get initial conditions +for US-UMB, and be able to work the transient issue). For the final_spinup +phase GPP was identically zero. + +This was fixed by setting taxmode='cycle'. See bug 1377 above. + +==================================================================================== +Bug Number: 1360 +Can't do a ncdump on the US-UMB single point data for PTCLM + +I get the following error doing an ncdump on the US-UMB data... + +ncdump -h 1999-01.nc +ncdump: name begins with space or control-character: 1 + + +I can view the file with ncks, or ncl, or ncview. + +It turns out the problem is that the filename -- doesn't start with an +alphabetical letter it starts with a number. So there isn't really a way around +this other than renaming the files and changing the streams. To do a ncdump, +you can simply rename the file to something else and then do the ncdump on it. + +==================================================================================== +Bug Number: 1348 +Restart test with crop on shows differences in landmask field + +The following test is failing on edinburgh with the lahey compiler with +clm4_0_32. + +006 erTZ4 TER.sh 21p_cncrpsc_ds clm_stdIgnYr^nl_crop 20020401:3600 10x15 USGS +-3+-7 cold ........FAIL! rc= 13 + + +The difference is in landmask field where some values are set to 1.95379e+09 +looks like over ocean. + +==================================================================================== +Bug Number: 1345 +Irrigation dataset is upside down! + +The irrigation dataset used to create surface datasets by mksurfdata is upside +down (latitude goes from 90 to -90 rather) relative to other files used to +create surface datasets. + +The filename is: + + $CSMDATA/lnd/clm2/rawdata/mksrf_irrig_2160x4320_simyr2000.c090320.nc + +This is the same problem as in the VOC dataset in bug number 1044 below. + +Even though the file looks incorrect the datasets it creates are fine. + +==================================================================================== +Bug Number: 1339 +Limit on number of files when running with 155 years of MOAR data + +In order to run with 155 years of MOAR data the file limit in shr_stream needs +to increase from 1000 to 2000 (technically 1860 would be sufficient, but might +as well bump it to 2000). + +Index: shr_stream_mod.F90 +=================================================================== +--- shr_stream_mod.F90 (revision 28396) ++++ shr_stream_mod.F90 (working copy) +@@ -101,7 +101,7 @@ + end type shr_stream_fileType + + !--- hard-coded array dims ~ could allocate these at run time --- +- integer(SHR_KIND_IN),parameter :: nFileMax = 1000 ! max number of files ++ integer(SHR_KIND_IN),parameter :: nFileMax = 2000 ! max number of files + + type shr_stream_streamType + !private ! no public access to internal components + +We didn't put this change in as it causes a compiler error on bluefire for AIX +when compiling the dlnd component... + +/ptmp/mvertens/SMS.f45_g37.A.bluefire.rel06_d/lnd/obj/Depends +mpxlf90_r -c -I. -I/usr/include -I/usr/local/include -I/usr/local/include -I. +-I/ptmp/mvertens/SMS.f45_g37.A.bluefire.rel06_d/SourceMods/src.dlnd +-I/glade/proj3/cseg/people/mver +tens/src/cesm/cesm1_0_rel06/models/lnd/dlnd +-I/glade/proj3/cseg/people/mvertens/src/cesm/cesm1_0_rel06/models/lnd/dlnd/cpl_mct +-I/ptmp/mvertens/SMS.f45_g37.A.bluefire.rel06_d/li +b/include -WF,-DMCT_INTERFACE -WF,-DHAVE_MPI -WF,-DAIX -WF,-DSEQ_ -WF,-DFORTRAN_SAME +-q64 -g -qfullpath -qmaxmem=-1 -qarch=auto -qsigtrap=xl__trcedump -qsclk=micro -O2 +-qstri +ct -Q -qsuffix=f=f90:cpp=F90 +/glade/proj3/cseg/people/mvertens/src/cesm/cesm1_0_rel06/models/lnd/dlnd/dlnd_comp_mod.F90 +touch /ptmp/mvertens/SMS.f45_g37.A.bluefire.rel06_d/lnd/obj/Filepath + 1517-009: (U) Error in compiler runtime system; compilation ended. +xlf90_r: 1501-230 (S) Internal compiler error; please contact your Service +Representative. For more information visit: +http://www.ibm.com/support/docview.wss?uid=swg21110810 +1501-511 Compilation failed for file dlnd_comp_mod.F90. +gmake: *** [dlnd_comp_mod.o] Error 40 + +==================================================================================== +Bug Number: 1326 +Running with both crop AND irrigation fail with a balance check error + +Running tests that have both crop AND irrigation fail with a balance check +error. This is for starting up with arbitrary initial conditions and running +with either CN and/or CNDV. + +==================================================================================== +Bug Number: 1325 +Writing out GDDHARV cause abort when written out to history file + +The variables: GDDHARV cause the model to abort when +adding it to the history file and DEBUG mode is on. It aborts in one of the +pft averaging functions in subgridAveMod with a multiply by a NaN. This is on +bluefire. The variables are initialized to spval, so I'm not sure why this +happens. + +Here's what the abort looks like... + +(seq_mct_drv) : Model initialization complete + + + Signal received: SIGTRAP - Trace trap + Signal generated for floating-point exception: + FP invalid operation + + Instruction that generated the exception: + fmul fr02,fr01,fr02 + Source Operand values: + fr01 = NaNS + fr02 = 1.00000000000000e+00 + + Traceback: + Offset 0x00002104 in procedure __subgridavemod_NMOD_p2g_1d, near line 796 +in file /fis/cgd/home/erik/clm_cropbr/models/lnd/clm/src/main/subgridAveMod.F90 + Offset 0x00000540 in procedure +*__subgridavemod_NMOD_p2g_1d_stub_in___histfilemod_NMOD_hist_update_hbuf_field_1d + Offset 0x00000670 in procedure +__histfilemod_NMOD_hist_update_hbuf_field_1d, near line 1172 in file +/fis/cgd/home/erik/clm_cropbr/models/lnd/clm/src/main/histFileMod.F90 + Offset 0x000000fc in procedure __histfilemod_NMOD_hist_update_hbuf@OL@1 + Location 0x09000000015f2d4c + Location 0x09000000015eb758 + Offset 0x000000dc in procedure _pthread_body + --- End of call chain --- + +==================================================================================== +Bug Number: 1310 +Some indices are different for differing number of threads + +Some of the 1d indices are different on the history files when differing number of +threads is used. + +034 erL83 TER.sh _nrsc_do clm_std^nl_urb 20020115:3600 5x5_amazon navy -5+-5 +arb_ic .............FAIL! rc= 13 + +Everything's bit-for-bit up to... + +CLM_compare.sh: comparing clmrun.clm2.h1.2002-01-20-00000.nc + with +/ptmp/erik/test-driver.888958/TSM._nrsc_do.clm_std^nl_urb.20020115:3600.5x5_amazon.navy.-10.arb_ic/clmrun.clm2.h1.2002 +-01-20-00000.nc +CLM_compare.sh: files are NOT b4b + + RMS land1d_g 7 + RMS cols1d_g 7 + RMS cols1d_l 8 + RMS pfts1d_g 7 + RMS pfts1d_l 8 + RMS pfts1d_c 12 + +We got around this by removing these fields from the history files. + +==================================================================================== +Bug Number: 1289 +Problem reading in single-point CO2 stream file on franklin + +We verified this is a problem on franklin, but NOT other machines such as bluefire +for example. + +Zack Subin + +Reports on the following problem on Franklin. The problem is a subscript out of +range in a MCT subroutine being used by PIO. Hence why I've added Jim E. and +Rob J. to the list of people. + +He's the running the following case documented in the CLM Users Guide. + +http://www.cesm.ucar.edu/models/cesm1.0/clm/models/lnd/clm/doc/UsersGuide/x2920.html#AEN2948 + +I think the thing that's unique here is that the CO2 file only has one +datapoint. There might be an assumption that you are reading more datapoints +and something isn't dimensioned right in MCT, PIO or in datm? Not sure which... + +I ran the same case on bluefire and it runs both with DEBUG on and off (as I +say below). But, possibly bluefire is more forgiving on this subscript overflow +than Franklin. Since Franklin is a pretty standard machine it would probably +show up on other platforms as well. + +Here's Zack's message, with my previous message to him to give me some data to +file the bug report with. + +I'm running I_1850-2000_CN, 1.9x2.5 deg, on Franklin with clm4_0_24. It +is out of the box with the instructions for passing CO2 except for the +location of the forcing files and the initial conditions file, and the +number of tasks in drv_in:ccsm_pes: *_ntasks. + +The end of the standard output log reads: +0: Subscript out of range for array compbuf (rearrange.F90: 300) + subscript=1, lower bound=1, upper bound=0, dimension=1 + +The end of the cpl.log reads: +(seq_mct_drv) : Initialize each component: atm, lnd, ocn, and ice +(seq_mct_drv) : Initialize atm component + +The end of the datm.log reads: +(shr_dmodel_readLBUB) reading file: +/global/homes/z/zmsubin/Scratch/clmdata/fco2_datm_1765-2007_c100309.nc + 85 + +There is no lnd.log. It does not produce a core file. + +When I run with DEBUG off it runs normally, and the PCO2 is identical to +what I get from a run in clm4_0_16 except that the point at (1, 1) has a +nonzero PCO2 whereas it is 0 in clm4_0_16. + +When I follow your instructions for setting the number of atm pio tasks +to 1, it still has the same error. + +--Zack + +I was able to replicate this problem on lynx: + +/glade/proj2/fis/cgd/home/erik/clm4_0_24/scripts/DATM_CO2_TSERIES + + cat /ptmp/erik/DATM_CO2_TSERIES/run/ccsm.log.110225-170538 + +ock size conversion in bytes is 4086.02 +8 MB memory alloc in MB is 8.00 +8 MB memory dealloc in MB is 0.00 +Memory block size conversion in bytes is 4086.02 +8 MB memory alloc in MB is 8.00 +8 MB memory dealloc in MB is 0.00 +8 MB memory dealloc in MB is 0.00 +Memory block size conversion in bytes is 4086.02 +Memory block size conversion in bytes is 4086.02 +. +. +. +. +0: Subscript out of range for array compbuf (rearrange.F90: 300) + subscript=1, lower bound=1, upper bound=0, dimension=1 +0: Subscript out of range for array compbuf (rearrange.F90: 300) + subscript=1, lower bound=1, upper bound=0, dimension=1 +[NID 00073] 2011-02-25 17:06:52 Apid 136614: initiated application termination +Application 136614 exit codes: 127 +Application 136614 exit signals: Killed +Application 136614 resources: utime 0, stime 0 + +atm.log file ends with... + +(shr_dmodel_readLBUB) reading file: +/glade/proj2/fis/cgd/cseg/csm/inputdata/atm/datm7/CO2/fco2_datm_1765-2007_c100614.nc + 85 + +==================================================================================== +Bug Number: 1282 +Trouble running datm8 to the last time-step for datasets with missing data + +The urban single-point sites all have only a portion of a complete year of atm +forcing data. Hence, all of them abort with a dtlimit error when you try to run +until the last time-step. This is because it reads in the data for the next +time-step (thinking it needs to do a time-interpolation) and finds the +difference in time-step is large (since it's over the part of the year with +missing data). This is for the 1x1_mexicocityMEX, 1x1_vancouverCAN, and +1x1_urbanc_alpha sites, but would be the case for other datasets with missing +time-periods. + +The fix is to change the datm namelist to add settings for tintalgo and dtlimit +in the datm namelist as follows... + + &shr_strdata_nml +. +. +. + tintalgo = 'nearest','linear' + dtlimit = 25000.,1.5 + / + +Thus it will use the nearest point in time, and won't die with a dtlimit error, +as we are setting the dtlimit to a very high value. + +==================================================================================== +Bug Number: 1164 +Restart trouble for CNC13 with INTEL, PGI and LAHEY compilers + +017 erR53 TER.sh 17p_cnc13sc_do clm_std^nl_urb 20020115:NONE:1800 10x15 +USGS@1850 10+38 cold ....FAIL! rc= 13 + +Answers differ and gradually diverge in time. This could be a restart issue or a +multi-processing or threading issue. + +==================================================================================== +Bug Number: 1163 +CN finidat files have a bunch of fields with NaN's on it. + +For example on: + +$CSMDATA/ccsm4_init/I2000CN_f09_g16_c100503/0001-01-01/ \ +I2000CN_f09_g16_c100503.clm2.r.0001-01-01-00000.nc + +the fields: mlaidiff, flx_absdv, flx_absdn, flx_absiv, flx_absin, and +qflx_snofrz_lyr all have NaN's, with mlaidiff being completely full of NaN's +(since mlaidiff is only defined for CLMSP or if drydep is on). + +==================================================================================== +Bug Number: 1127 +interpinic not tested for CNDV, yet; expected not to work + +Interpinic has not worked for the old dgvm since probably before clm3.5. +Interpinic has not been tested, yet, for CNDV. Therefore, we assume that it +does not work. + +==================================================================================== +Bug Number: 1124 +Reported energy for grid-cell is not quite right for pftdyn + +The amount of water is conserved correctly in pftdyn mode, but the energy isn't +reported quite accurately. + +==================================================================================== +Bug Number: 1101 +suplnitro=ALL mode is over-productive + +suplnitro=ALL mode is over-productive. This is because it provides unlimited +Nitrogen. Fixing it requires using fnitr from the pft-physiology file, a different +pft-physiology file with fnitr scaled appropriately and some code modifications +to get this all to work. + +==================================================================================== +Bug Number: 1063 +Problems restarting for CESM spinup data mode + +Exact restarts for the 1850 CN spinup compset fail on bluefire... + +ERS.f09_g16.I1850SPINUPCN.bluefire + +also the ERB test fails, and the ERB_D test fails with optimization set to +zero. + +(note ERS for the I1850CN compset passes, it's just the SPINUP case that fails) + +In the coupler log file there's a single field that is different... + +The good thing is that it's a single field from the land model that's causing +trouble... + +Comparing initial log file with second log file +Error: +/ptmp/erik/ERS.f09_g16.I1850SPINUPCN.bluefire.124426/run/cpl.log.091029-130401 +and +/ptmp/erik/ERS.f09_g16.I1850SPINUPCN.bluefire.124426/run/cpl.log.091029-130648 +are different. +>comm_diag xxx sorr 1 4.5555498624818352000E+16 recv lnd Sl_t + + 9999. Having dates of Y10K or more +is sometimes useful for paleo simulations. +For clm to get past the Y10K barrier -- it needs the subroutines + +set_hist_filename +restFile_filename +set_dgvm_filename + +changed to allow 5 or 6 digit years rather than just 4-digit ones. + +scripts, drv, and csm_share also have problems with Y10K as well. + +==================================================================================== diff --git a/components/clm/doc/KnownLimitations b/components/clm/doc/KnownLimitations new file mode 100644 index 0000000000..9a13dd41a5 --- /dev/null +++ b/components/clm/doc/KnownLimitations @@ -0,0 +1,161 @@ +Known Limitations in CLM4/CESM1.1.0 Nov/08/2012 + +As opposed to the KnownBugs file where we expect that eventually we will find a +fix, these are limitations that we do NOT have plans to fix. They are simply known +limitations that we describe workarounds for below. In the course of doing other +work they may be resolved, but we do not plan on addressing them directly. We +reference "bug numbers" in this list, but these are things where those "bugs" +were closed out with a "will-not-fix". + +==================================================================================== +Bug Number: 1355 +tlai is zero for first two time-steps in CLMSP + +tlai is zero for time-steps 0, and 1 when doing a startup simulation. + +For CLMSP EcosystemDyn is only done when doalb is true, and it's NOT called at +initialization. At initialization for CLMSP it doesn't setup tlai, and only +does a barebones setting of vars. In contrast CLMCN calls it's EcosystemDyn +every time step (and not just when doalb is true), and at initalization it +calls CNAllocation and CNPhenology, so it's got at least something going. With +an initialization more similar to CN it would at least make sure tlai is set. + +==================================================================================== +Bug Number: 1310 +Difference in restart files for differing number of tasks/threads + +This is from Bill Sacks... + +With Mariana's help, I believe I have uncovered a minor bug in the urban model; +this came up while testing the new CLM multi-instance code that I have been +working on. This appears as a difference in the lnd restart files depending on +the number of processors. It's possible that this is unimportant, but I thought +I'd let you know anyway. + +In particular, the two variables albgrd and albgri differ in some urban +landunits in the CLM restart files. I have confirmed this with the latest clm +tag (clm4_0_26), doing a 5-day run with resolution f19_g16, and comparing +results using 64 vs. 16 tasks for the land model. You can see the output of +cprnc in +/ptmp/sacks/archive/clm4_0_26.init.quarterPEs/rest/0001-01-06-00000/cprnc.out + + +I believe that what is going on is the following: + +(1) In UrbanMod.F90: UrbanAlbedo: A count is made of the number of urban +landunits with coszen > 0 (num_solar); note that this count is just of the +number of landunits that this processor is responsible for; thus, this is where +the # PE-dependence comes in, I think. + +(2) Later in that subroutine, a bunch of calculations are done if num_solar > 0 +-- i.e., if this PE is responsible for at least one urban landunit with coszen +> 0. Note that many of these calculations are done for all landunits, even ones +for which coszen = 0. This introduces the possibility for different results +depending on the decomposition. + +(3) The particular difference that I am seeing is in albgrd & albgri. These are +initialized to 0 at the start of the subroutine, and so remain 0 on any PE for +which num_solar = 0. However, for PEs with num_solar > 0, landunits that have +coszen = 0 end up getting albgrd = albgri = 1. This is because the calculation +of albgrd & albgri depends on the values of the sref_* variables, which are +initialized to 1 (and stay at 1 for any landunit for which coszen = 0). + +==================================================================================== +Bug Number: 1147 +mkgriddata regional grids can't straddle over Greenwich + +mkgriddata is not able to run for any domain that has Eastern edge > Western +edge, because it straddles across the 0 degree longitude line. + +The workaround is to divide the domain into two and run two regional grids. + +==================================================================================== +Bug Number: 1110 +dtlimit error with datm8 when a full year isn't available + +datm8 dies with a dtlimit error as follows when your atm forcing data doesn't +include an entire year (such as the MexicoCity and Vancouver urban test sites). + +(shr_dmodel_readLBUB) reading file: +/fs/cgd/csm/inputdata/atm/datm7/CLM1PT_data/mexicocityMEX.c080124/clm1pt-1993-12.nc + 160 +(datm_comp_run) atm: model date 19931207 57600s +(shr_dmodel_readLBUB) reading file: +/fs/cgd/csm/inputdata/atm/datm7/CLM1PT_data/mexicocityMEX.c080124/clm1pt-1993-12.nc + 1 + (shr_strdata_advance) ERROR: dt limit1 358.375011574074051 +0.416666666666666297E-01 1.50000000000000000 + (shr_strdata_advance) ERROR: dt limit2 19931207 61199 19941201 7200 +(shr_sys_abort) ERROR: (shr_strdata_advance) ERROR dt limit +(shr_sys_abort) WARNING: calling shr_mpi_abort() and stopping + +This is because the model runs out of data and loops around to the beginning of the +year, and hence has a large time-step difference to the rest of the data when it +loops around. You can remove this problem if you increase dtlimit (normally 1.5 and +represents the ratio of the largest allowed relative difference in time intervals +for the data). Or you just make sure that your input data doesn't have these type +of abnormal jumps of missing data. + +==================================================================================== +Bug Number: 1100 +Trouble compiling with pgi7 + +The model does NOT compile using PGI7.2.2. It DOES compile with later versions of the +PGI compiler, such as 9.0.4. + +The workaround is to use a later version of the PGI compilers. + +==================================================================================== +Bug Number: 1017 and 1025 +PTS_MODE can NOT restart or use a global finidat file + +Single column mode (or PTS_MODE turned on using the -pts_lat and -pts_lon options in +scripts/create_newcase) can NOT read restart files or global finidat initial condition +files. + +The workaround is to use the compoennts/clm/tools/ncl_scripts/getregional_datasets.pl +script to create datasets from the global datasets. See the CLM User's Guide and the +README documentation in the ncl_scripts directory as well as in the script itself. + +Here's the message that happens when you try to run from a restart file. + +(OPNFIL): Successfully opened file ./rpointer.lnd on unit= 14 + Reading restart data..... +------------------------------------------------------------ + (GETFIL): attempting to find local file +c40b19+.I.pts.01.clm2.r.0001-01-06-00000.nc + (GETFIL): using c40b19+.I.pts.01.clm2.r.0001-01-06-00000.nc in current working +directory + Reading restart dataset + ERROR - setlatlon.F:Cant get variable dim for lat or lsmlat + ENDRUN: called without a message string + +==================================================================================== +Bug number: 896 +CLM won't run at T62 + +We aren't quite sure why. But we've found that CLM currently won't run at T62 resolution +the same resolution as the input CLM-Qian atmosphere forcing data. + +==================================================================================== +Bug number: 652 +Output different for different number of threads PGF90 + +PGI Version 6.1.6, and NetCDF Version 3.6.2. Works on other platforms/compilers and +also works with PGI-7.0-7. + +The workaround is to use another compiler or a later version of the PGI compiler. + +==================================================================================== +Bug Number: 452 +Problem with support of number of soil-colors NOT equal to 8 or 20 + +The mksurfdata tools file mksoicol.F90 sets nsoicol to the max value found in +the input soilcolor file: + nsoicol = maxval(soil_color_i) + +However, the code will fail if nsoicol does not equal 20 or 8 (which it might +in paleo cases). perhaps the code should be extended to handle a case where +nsoicol is not 20 or 8. + +==================================================================================== diff --git a/components/clm/doc/Quickstart.GUIDE b/components/clm/doc/Quickstart.GUIDE new file mode 100644 index 0000000000..df8479105e --- /dev/null +++ b/components/clm/doc/Quickstart.GUIDE @@ -0,0 +1,72 @@ + Quick-Start to Using cpl7 Scripts for clm4_5 + ============================================ + +Assumptions: You want to use yellowstone with clm4_5 BGC + to do a clm simulation with data atmosphere and the + latest CRUNCEP atm forcing files and settings. You also want to cycle + the CRUNCEP atm data between 1950 to 2010 and you want to run at + 0.9x1.25 degree resolution. + +Process: + + # Create the case + + cd cime/scripts + + ./create_newcase -case -mach yellowstone_intel -res f09_g16 -compset I4804 + (./create_newcase -help -- to get help on the script) + + # Setup the case + + cd + ./xmlchange id1=val1,id2=val2 # to make changes to any settings in the env_*.xml files + ./cesm_setup + (./cesm_setup -help -- to get help on the script, this creates the ./.run script) + + # Add any namelist changes to the user_nl_* files + + $EDITOR user_nl_* + + # Compile the code + + ./.build + + # Submit the run + + ./.submit + +Information on Compsets: + + "I" compsets are the ones with clm and datm7 without ice and ocean. + Most of the "I" compsets for CLM4.0 use the CLM_QIAN data with solar following + the cosine of solar zenith angle, precipitation constant, and other + variables linear interpolated in time (and with appropriate time-stamps on + the date). + Some of the I compsets are: + + Name (short-name): Description + -------------------------------------------------------------------------- + I_2000 (I): CLM to simulate year=2000 + I_2000_1PTFRC (I1PT): CLM to simulate year=2000 with single-point forcing + I_2000_CN (ICN): CLM to simulate year=2000 with Carbon-Nitrogen BGC model (CN) + I_1850 (I1850): CLM to simulate year=1850 + I_1850_CN (I1850CN): CLM to simulate year=1850 with Carbon-Nitrogen BGC model (CN) + I_1850_SPINUP_3HrWx_CN (I1850SPINUPCN): CLM to simulate year=1850 with MOAR forcing to spinup Carbon-Nitrogen BGC model (CN) + I_1948_2004 (I4804): CLM running with atm data over 1948-2004 + I_1850-2000 (I8520): CLM with transient PFT over 1850-2000 + I_1948-2004_CN (I4804CN): CLM with CN on running with atm data over 1948-2004 + I_1850-2000_CN (I20TRCN): CLM with CN on with transient PFT over 1850-2000 + I_RCP2.6_CN (IRCP26CN): CLM with CN on with transient PFT over 1850-2100 for RCP=2.6 scenario + I_RCP4.5_CN (IRCP45CN): CLM with CN on with transient PFT over 1850-2100 for RCP=4.5 scenario + I_RCP6.0_CN (IRCP60CN): CLM with CN on with transient PFT over 1850-2100 for RCP=6.0 scenario + I_RCP8.5_CN (IRCP85CN): CLM with CN on with transient PFT over 1850-2100 for RCP=8.5 scenario + +Automatically resubmitting jobs: + + After doing a short simulation that you believe is correct + + ./xmlchange CONTINUE_RUN=TRUE + + # Change RESUBMIT to number greater than 0, and CONTINUE_RUN to TRUE... + + ./.submit diff --git a/components/clm/doc/Quickstart.userdatasets b/components/clm/doc/Quickstart.userdatasets new file mode 100644 index 0000000000..b3b9ea9dfd --- /dev/null +++ b/components/clm/doc/Quickstart.userdatasets @@ -0,0 +1,150 @@ + Quick-Start to using your own datasets in clm4 + =============================================== + +Assumptions: You are already familiar with the use of the cpl7 scripts + for creating cases to run with "standalone" clm. See the + Quickstart.GUIDE and the README files and documentation in + the scripts directory for more information on this process. + We also assume that the env variable $CSMDATA points to the + location of the standard datasets for your machine + ($CESMDATAROOT/inputdata on yellowstone). We also assume that the + following variables are used to point to the appropriate + values that you want to use for your case. Mask is included + as part of your resolution for your case, and SIM_YEAR and + SIM_YEAR_RANGE will be set appropriately for the particular use + case that you choose for your compset (i.e. 1850_control, + 20thC_transient etc.). + + SIM_YEAR -------- Simulation year (i.e. 1850, or 2000) + SIM_YEAR_RANGE -- Simulation year range (i.e. constant, or 1850-2000) + MASK ------------ Land mask (i.e. navy, USGS, or gx1v6) + +Process: + + 0.) Why do this? + + An alternative to the steps below, is to create your case, and hand-edit the + relevant namelists as appropriate with your own datasets. One reason for + the process below is so that we can do automated testing on dataset inclusion. + But, it also provides the following functionality to the user: + a.) New cases with the same datasets only require a small change to + env_conf.xml and env_run.xml (steps 5,6, and 8) + b.) You can clone new cases based on a working case, without having to + hand-edit all of the namelists for the new case in the same way. + c.) The process will check for the existence of files when cases are + configured so you can have the scripts check that datasets exist + rather than finding out at run-time after submitted to batch. + d.) The process checks for valid namelists, and makes it less likely + for you to put an error or typo in the namelists. + e.) The *.input_data_list files will be accurate for your case, + you can use the check_input_data script to do queries on the files. + f.) Your dataset names will be closer to standard names, and easier + for inclusion in standard clm (with the exception of creation dates). + g.) The regional extraction script (see 3.b below) will automatically create + files with names following this convention. + + 1.) Create your own dataset area -- link it to standard dataset location + + Create a directory to put your own datasets (such as /ptmp/$USER/my_inputdata). + Use the script link_dirtree to link the standard datasets into this location. + If you already have complete control over the datasets in $CSMDATA -- you + can skip this step. + + setenv MYCSMDATA /ptmp/$USER/my_inputdata + scripts/link_dirtree $CSMDATA $MYCSMDATA + + If you do this you can find the files you've added with... + + find $MYCSMDATA -type f -print + + and you can find the files that are linked to the standard location with... + + find $MYCSMDATA -type l -print + + 2.) Establish a "user dataset identifier name" string + + You need a unique identifier for your datasets for a given resolution, + mask, area, simulation-year, and simulation year-range. The identifier + can be any string you want -- but we have the following suggestions: + + Suggestions for global grids: + + setenv MYDATAID ${degLat}x${degLon} + + Suggestions for regional grids: either give the number of points in the grid + + setenv MYDATAID nxmpt_citySTATE + setenv MYDATAID nxmpt_cityCOUNTRY + setenv MYDATAID nxmpt_regionCOUNTRY + setenv MYDATAID nxmpt_region + + or give the total size of the gridcells + + setenv MYDATAID nxmdeg_citySTATE + setenv MYDATAID nxmdeg_cityCOUNTRY + + for example: setenv MYDATAID 10x15 -- global 10x15 grid + setenv MYDATAID 1x1pt_boulderCO -- single-point for Boulder CO + setenv MYDATAID 5x5pt_boulderCO -- 5x5 region around Boulder CO + setenv MYDATAID 1x1deg_boulderCO - 1x1 degree region around Boulder CO + setenv MYDATAID 13x12pt_f19_alaskaUSA1 - 13x12 gridcells from f19 + (1.9x2.5) global resolution over Alaska + + 3.) Add your own datasets in the standard locations in that area + + 3.a) Create datasets using the standard tools valid for any specific points + + Use the tools in components/clm/tools to create new datasets. Tools + such as: mkgriddata, mksurfdata, mkdatadomain, and the regridding tools + in ncl_scripts + + (see the components/clm/bld/namelist_files/namelist_defaults_usr_files.xml + for the exact syntax for all files). + + surfdata: copy files into: + $MYCSMDATA/lnd/clm2/surfdata_map/surfdata_${MYDATAID}_simyr${SIM_YEAR}.nc + domainfile: copy files into: + $MYCSMDATA/atm/datm7/domain.clm/domain.lnd.${MYDATAID}_${MASK}.nc + + 3.b) Use the regional extraction script to get regional datasets from the global ones + Use the getregional_datasets.pl script to extract out regional datasets of interest. + Note, the script works on all files other than the "finidat" file as it's a 1D vector file. + + For example, Run the extraction for data from 52-73 North latitude, 190-220 longitude + that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over Alaska. + + cd components/clm/tools/ncl_scripts + ./getregional_datasets.pl -sw 52,190 -ne 73,220 -id $MYDATAID \ + -mycsmdata $MYCSMDATA + + Repeat this process if you need files for multiple sim_year, and sim_year_range values. + + 4.) Setup your case + + Follow the standard steps for executing "cime/scripts/create_newcase" and customize + your case as appropriate. + + i.e. + + ./create_newcase -case my_userdataset_test -res pt1_pt1 -compset I1850 \ + -mach yellowstone_intel + + The above example implies that: MASK=gx1v6, SIM_YEAR=1850, and SIM_YEAR_RANGE=constant. + 5.) Edit the env_run.xml in the case to point to your new dataset area + + Edit DIN_LOC_ROOT in env_run.xml to point to $MYCSMDATA + + ./xmlchange DIN_LOC_ROOT=$MYCSMDATA + + 6.) Edit the env_conf.xml in the case to point to your user dataset identifier + name. + + Edit CLM_USRDAT_NAME to point to $MYDATAID + + ./xmlchange CLM_USRDAT_NAME=$MYDATAID + + 7.) Setup the case as normal + + ./cesm_setup + + 8.) Run your case as normal diff --git a/components/clm/doc/README b/components/clm/doc/README new file mode 100644 index 0000000000..9d8524fafa --- /dev/null +++ b/components/clm/doc/README @@ -0,0 +1,113 @@ +components/clm/README 04/07/2015 + +Community Land Surface Model (CLM) science version 4.5.1 series -- source code, tools, +offline-build and test scripts. This gives you everything you need +to run CLM with CESM with datm8 to provide Qian or CRU NCEP forcing data in +place of a modeled atmosphere. + +General directory structure: + +components/clm/doc ---- Documentation of CLM. +components/clm/bld ---- Template, configure and build-namelist scripts for clm. +components/clm/src ---- CLM Source code. +components/clm/test --- CLM Testing scripts for CLM offline tools. +components/clm/tools -- CLM Offline tools to prepare input datasets and process output. + +cime/scripts --------------- CPL7 scripts + +cime/driver_cpl/driver ---------- CESM top level driver source code. +cime/driver_cpl/shr ------------- CESM top level driver shared code. +cime/driver_cpl/shr_esmf -------- CESM top level driver shared code for ESMF. +cime/components/data_comps/datm - CESM Data model version 8 source code. +components/cism ----------------- CESM Community land Ice Sheet Model. +components/rtm ------------------ CESM River Transport Model. +cime/components/stub_comps/sice - CESM stub sea-ice model source code. +cime/components/stub_comps/socn - CESM stub ocean model source code. +cime/components/stub_comps/sglc - CESM stub glacier model source code. +cime/external ------------------- CESM external utility codes + (Model Coupling Toolkit (MCT) + (Earth System Model Framework) + (timing -- code timing utility) + (pio -- Parallel Input/Output) + +Top level documentation: + +README ------------------- This file +README_EXTERNALS --------- Information on how to work with subversion externals for clm +SVN_EXTERNAL_DIRECTORIES - Subversions externals to use +Copyright ---------------- CESM Copyright file +UpDateChangeLog.pl ------- Script to add documentation on a tag to the + ChangeLog/ChangeSum files +ChangeLog ---------------- Documents different CLM versions +ChangeSum ---------------- Summary documentation of different CLM versions +ChangeLog/ChangeSum ------ Also copied to components/clm/doc + +Documentation of Namelist Items: (view the following in a web browser) + +components/clm/bld/namelist_files/namelist_definition.xml --- Definition of all namelist items +components/clm/bld/namelist_files/namelist_defaults_clm.xml - Default values + +============================================================================================= +Important files in main directories: +============================================================================================= + +components/lnd/clm/doc/Quickstart.GUIDE -------- Quick guide to using cpl7 scripts. +components/lnd/clm/doc/Quickstart.userdatasets - Quick guide to using your own datasets. +components/lnd/clm/doc/IMPORTANT_NOTES --------- Some important notes about this version of + clm, configuration modes and namelist items + that are not validated or functional. +components/clm/doc/KnownBugs --------------- List of known bugs. +components/clm/doc/KnownLimitations -------- List of known limitations and workarounds. +components/clm/doc/ChangeLog --------------- Detailed list of changes for each model version. +components/clm/doc/ChangeSum --------------- Summary one-line list of changes for each + model version. +components/clm/doc/README ------------------ Documentation similar to this file +components/clm/doc/UsersGuide -------------- CLM Users Guide +components/clm/doc/CodeReference ----------- CLM Code Reference Guide + +components/clm/bld/configure --------------- Script to prepare CLM to be built. + +components/clm/test/tools/test_driver.sh -- Script for general software testing of + CLM's offline tools. + +components/clm/tools/clm4_5/mksurfdata_map --- Directory to build program to create surface dataset + at any resolution. +components/clm/tools/clm4_5/interpinic ------- Directory to build program to interpolate initial + conditions to any resolution. +components/clm/tools/shared/mkdatadomain ----- Directory to build program to create datm7 or docn7 + domain files from clm files. +components/clm/tools/shared/mkprocdata_map --- Process history data from unstructed grids to a gridded + format. +components/clm/tools/shared/ncl_scripts ----- Directory of NCL and perl scripts to do various + tasks. Most notably to plot perturbation error growth + testing and to extract regional information from + global datasets for single-point/regional simulations. + +components/clm/bld/README ------------- Description of how to use the configure and + build-namelist scripts. + +============================================================================================= +Source code directory structure: +============================================================================================= + +components/clm/src/biogeochem -- Biogeochemisty +components/clm/src/main -------- Main control and high level code +components/clm/src/cpl --------- Land model high level MCT and ESMF drivers +components/clm/src/biogeophys -- Biogeophysics (Hydrology) + +============================================================================================= + QUICKSTART: using the CPL7 scripts: +============================================================================================= + + cd cime/scripts + ./create_newcase # get help on how to run create_newcase + ./create_newcase -case testI -mach bluefire -res f19_g16 -compset I + # create new "I" case for bluefire at 1.9x2.5_gx1v6 res + # "I" case is clm active, datm8, and inactive ice/ocn + cd testI + ./cesm_setup # create the $CASE.run file + ./testI.bluefire.build # build model and create namelists + ./testI.bluefire.submit # submit script + # (NOTE: ./xmlchange RESUBMIT=10 to set RESUBMIT to number + # # of times to automatically resubmit -- 10 in this example) + diff --git a/components/clm/doc/UsersGuide/Makefile b/components/clm/doc/UsersGuide/Makefile new file mode 100644 index 0000000000..1c76bc75bd --- /dev/null +++ b/components/clm/doc/UsersGuide/Makefile @@ -0,0 +1,193 @@ +# +# Makefile to convert DocBook CLM Users-Guide into html and/or pdf +# (rtf, txt, ps, tex, man, dvi, and texi are also valid docbook formats) +# +VPATH := ../../tools/cprnc . .. ../../bld ../../tools/ncl_scripts \ + ../../tools/mksurfdata ../../test/system ../../bld/namelist_files \ + ../../bld/config_files ../../tools ../../../../../scripts/ccsm_utils/Tools \ + ../../../../../scripts/ccsm_utils/Tools/lnd/clm/PTCLM/ ../../src/main + +PDFUG := clm_ug.pdf +HTMLUG := book1.html +DOCBKUG := clm_ug.xml +CFGLOG := config_help +CPRLOG := cprnc_readme +BNMLOG := buildnml_help +BSTLOG := build_streams_help +RESLOG := buildnml_resolutions +USCLOG := buildnml_usecases +QCKLOG := quickstart_guide +COPLOG := filecopies +MKSLOG := mksurfdata.pl +USRLOG := quickstart_usrdat +PTCLOG := ptclm_help +PTCLST := ptclm_list +TDRLOG := test_driver.sh +GETREG := getregional_datasets +CO2DIF := addco2_datm.buildnml +DATLOG := build_date +NMLDFTBL := namelist_definition_table +NMLDLTBL := namelist_defaults_clm_table +HSFLDTBL := history_fields_table +CFGDFTBL := config_definition_table +COMPLIST := compsets_list_ofIcases.xml +SOURCES := $(DOCBKUG) $(COMPLIST) $(CFGLOG).xml $(PTCLOG).xml $(BNMLOG).xml \ + $(RESLOG).xml $(USCLOG).xml $(QCKLOG).xml $(COPLOG).xml $(PTCLST).xml \ + $(USRLOG).xml $(GETREG).xml preface.xml custom.xml special_cases.xml \ + tools.xml adding_files.xml single_point.xml addco2_datm.buildnml.xml \ + appendix.xml trouble_shooting.xml ptclm.xml $(BSTLOG).xml \ + $(MKSLOG).xml $(TDRLOG).xml $(DATLOG).xml $(CPRLOG).xml \ + $(NMLDFTBL).xml $(NMLDLTBL).xml $(CFGDFTBL).xml $(HSFLDTBL).xml + +CONVAMP := sed 's/\&/\&/g' +CONVSIGNS := sed 's/>/\>/g' | sed 's/ tmpFile.txt + addxhtmlhead.pl tmpFile.txt > $@ + $(RM) tmpFile.txt + +$(NMLDLTBL).xhtml: namelist_defaults_clm.xml namelist_defaults.xsl + xsltproc ../../bld/namelist_files/namelist_defaults.xsl $< > tmpFile.txt + addxhtmlhead.pl tmpFile.txt > $@ + $(RM) tmpFile.txt + +$(CFGDFTBL).xhtml: config_definition.xml config_definition.xsl + xsltproc ../../bld/config_files/config_definition.xsl $< > tmpFile.txt + addxhtmlhead.pl tmpFile.txt > $@ + $(RM) tmpFile.txt + +history_fields.xml: findHistFields.pl + cd ../../src/main; ./findHistFields.pl >& tmpFile.txt + $(RM) tmpFile.txt + +$(HSFLDTBL).xhtml: history_fields.xml history_fields.xsl + xsltproc ../../bld/namelist_files/history_fields.xsl $< > tmpFile.txt + addxhtmlhead.pl tmpFile.txt > $@ + $(RM) tmpFile.txt + +.xhtml.xml: + xsltproc stylesheethtml2docbook.xsl $< > $@ + +.tlog.xml: + $(CONVAMP) $< | $(CONVSIGNS) > tempFile.txt + limitLineLen.pl tempFile.txt > $@ + $(RM) tempFile.txt + +.diff.xml: + $(CONVAMP) $< | $(CONVSIGNS) > $@ + +debug: + @echo "SOURCES: $(SOURCES)" + @echo "CONVAMP: $(CONVAMP)" + @echo "CONVSIGNS: $(CONVSIGNS)" + +$(COMPLIST): + ./get_Icaselist.pl > $@ + +$(HTMLUG): $(SOURCES) + docbook2html --dsl clm_stylesheet.dsl#html $< + +$(PDFUG): $(SOURCES) + docbook2pdf --dsl clm_stylesheet.dsl#print $< + +$(BNMLOG).tlog: build-namelist + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../bld/build-namelist -help >& $@ + +$(BSTLOG).tlog: build_streams + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../../../../scripts/ccsm_utils/Tools/build_streams --help >& $@ + +$(DATLOG).tlog: + @echo "Get current build date" + date +%b-%d-%Y >& $@ + +$(RESLOG).tlog: build-namelist + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../bld/build-namelist -res list >& $@ + +$(USCLOG).tlog: build-namelist + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../bld/build-namelist -use_case list >& $@ + +$(CFGLOG).tlog: configure + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../bld/configure -help >& $@ + +$(PTCLOG).tlog: PTCLM.py + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../../../../scripts/ccsm_utils/Tools/lnd/clm/PTCLM/PTCLM.py --help >& $@ + +$(PTCLST).tlog: PTCLM.py + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + cd ../../../../../scripts/ccsm_utils/Tools/lnd/clm/PTCLM; \ + PTCLM.py --list >& $(CURDIR)/$@ + +$(MKSLOG).tlog: mksurfdata.pl + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../tools/mksurfdata/mksurfdata.pl -help >& $@ + +$(TDRLOG).tlog: test_driver.sh + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $@ is good and redo your make" + ../../test/system/test_driver.sh -help >& $@ + +$(QCKLOG).tlog: Quickstart.GUIDE + cp $< $@ + +$(COPLOG).tlog: README.filecopies + cp $< $@ + +$(CPRLOG).tlog: README + cp $< $@ + +$(USRLOG).tlog: Quickstart.userdatasets + cp $< $@ + +$(GETREG).tlog: getregional_datasets.pl + @echo "The following line will fail in the make as it calls die -- but that is expected" + @echo "Check that the output $(GETREG) is good and redo your make" + ../../tools/ncl_scripts/getregional_datasets.pl -help >& $@ + +clean: + $(RM) -f $(HTMLUG) $(PDFUG) *.tlog $(DATLOG).xml *.xhtml *.tex + +realclean: clean + $(RM) -f f*.html c*.html x*.html a*.html i*.html $(COMPLIST) $(CFGLOG).xml \ + $(BNMLOG).xml $(BSTLOG).xml $(PTCLOG).xml $(PTCLST).xml \ + $(RESLOG).xml $(USCLOG).xml $(USRLOG).xml $(GETREG).xml $(QCKLOG).xml \ + $(CO2DIF).xml *.tlog $(MKSLOG).xml $(TDRLOG).xml $(DATLOG).xml \ + $(NMLDFTBL).xml $(NMLDLTBL).xml $(CFGDFTBL).xml $(CPRLOG).xml \ + $(COPLOG).xml diff --git a/components/clm/doc/UsersGuide/addco2_datm.buildnml.diff b/components/clm/doc/UsersGuide/addco2_datm.buildnml.diff new file mode 100644 index 0000000000..b8fbf34e36 --- /dev/null +++ b/components/clm/doc/UsersGuide/addco2_datm.buildnml.diff @@ -0,0 +1,59 @@ +*** datm.buildnml.csh.orig 2010-06-11 10:59:29.246523532 -0600 +--- datm.buildnml.csh 2010-06-11 11:06:30.710784206 -0600 +*************** +*** 34,48 **** + streams = 'clm_qian.T62.stream.Solar.txt 1895 1948 1972 ', + 'clm_qian.T62.stream.Precip.txt 1895 1948 1972 ', + 'clm_qian.T62.stream.TPQW.txt 1895 1948 1972 ', +! 'presaero.stream.txt 1849 1849 2006' + vectors = 'null' + mapmask = 'nomask', + 'nomask', + 'nomask', + 'nomask' + tintalgo = 'coszen', + 'nearest', + 'linear', + 'linear' + / + EOF1 +--- 34,56 ---- + streams = 'clm_qian.T62.stream.Solar.txt 1895 1948 1972 ', + 'clm_qian.T62.stream.Precip.txt 1895 1948 1972 ', + 'clm_qian.T62.stream.TPQW.txt 1895 1948 1972 ', +! 'presaero.stream.txt 1849 1849 2006', +! 'datm.global1val.stream.CO2.txt 1766 1766 2005 ' + vectors = 'null' + mapmask = 'nomask', + 'nomask', + 'nomask', ++ 'nomask', + 'nomask' ++ mapalgo = 'bilinear', ++ 'bilinear', ++ 'bilinear', ++ 'bilinear', ++ 'nn' + tintalgo = 'coszen', + 'nearest', + 'linear', ++ 'linear', + 'linear' + / + EOF1 +*************** +*** 1112,1121 **** +--- 1120,1132 ---- + + EOF1 + ++ cp $CASEBUILD/co2_streams.txt datm.global1val.stream.CO2.txt ++ + + $CASETOOLS/listfilesin_streams -input_data_list -t clm_qian.T62.stream.Solar.txt >> $CASEBUILD/datm.input_data_list + $CASETOOLS/listfilesin_streams -input_data_list -t clm_qian.T62.stream.Precip.txt >> $CASEBUILD/datm.input_data_list + $CASETOOLS/listfilesin_streams -input_data_list -t clm_qian.T62.stream.TPQW.txt >> $CASEBUILD/datm.input_data_list ++ $CASETOOLS/listfilesin_streams -input_data_list -t datm.global1val.stream.CO2.txt >> $CASEBUILD/datm.input_data_list + + cat >! presaero.stream.txt << EOF1 + diff --git a/components/clm/doc/UsersGuide/adding_files.xml b/components/clm/doc/UsersGuide/adding_files.xml new file mode 100644 index 0000000000..68209c9681 --- /dev/null +++ b/components/clm/doc/UsersGuide/adding_files.xml @@ -0,0 +1,397 @@ + + +Adding New Resolutions or New Files to the build-namelist Database + +In the last chapter we gave the details on how to create new files for input into +CLM. These files could be either global resolutions, regional-grids or even a single +grid point. If you want to easily have these files available for continued use in your +development you will then want to include them in the build-namelist database so +that build-namelist can easily find them for you. You can deal with them, just by +editing your namelist by hand (or using a &usernlclm; namelist file), or by using +&CLMUSRDAT;. Another way to deal with them is to enter them into +the database for build-namelist, so that build-namelist can find them for you. +This keeps one central database for all your files, rather than having multiple locations +to keep track of files. If you have a LOT of files to keep track of it also might +be easier than keeping track by hand, especially if you have to periodically update +your files. If you just have a few quick experiments to try, for a short time period +you might be best off using the other methods mentioned above. + + +There are two parts to adding files to the build-namelist database. The first part +is adding new resolution names which is done in the +models/lnd/clm/bld/namelist_files/namelist_definition.xml file +(and in the +models/lnd/clm/bld/config_files/config_definition.xml file +when adding supported single-point datasets). +The second part is actually adding the new filenames which is done in the +models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml file +(models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml +file for CLM tools). +If you aren't adding any new resolutions, and you are just changing the files for existing +resolutions, you don't need to edit the namelist_definition file. + + + +Managing Your Own Data-files + +If you are running on a supported machine (such as bluefire or jaguar) the standard +input datasets will already be available and you won't have to check them out of the +subversion inputdata server. However, you also will NOT be able to add your own datafiles +to these standard inputdata directories -- because most likely you won't have permissions +to do so. In order to add files to the XML database or to use &CLMUSRDAT; you need +to put data in the standard locations so that they can be found. The recommended +way to do this is to use the link_dirtree tool in the &cesm; scripts. +Some information on link_dirtree is available in the +&cesmrel; Scripts User's Guide. We also have +some examples of it's use here and in other sections of this User's Guide. + + +Using link_dirtree is quite simple, you give the directory where +data exists and then the directory that you want to create where datasets will point +to the original source files. In the example below we use "$HOME/inputdata", but +MYCSMDATA could be any directory you have access to where you want to +put your data. + +> cd scripts +# First make sure you have a inputdata location that you can write to +# You only need to do this step once, so you won't need to do this in the future +# (except to bring in any updated files in the original $CSMDATA location). +> setenv MYCSMDATA $HOME/inputdata # Set env var for the directory for input data +> ./link_dirtree $CSMDATA $MYCSMDATA + +Then when you create a case you will change DIN_LOC_ROOT_CSMDATA to +point to the location you linked to rather than the default location. + +> ./xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA + + + +In order to list the files that you have created you merely need to use the UNIX +command find to find the files that are NOT softlinks. So for +example executing the following command: + +> find $MYCSMDATA -type f -print + +for me gives the following list of &CLMUSRDAT; files that I have created. + +/blhome/erik/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_monthly_1849-2006_1x1pt_US-Ha1.nc +/blhome/erik/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_monthly_1849-2006_13x12pt_f19_alaskaUSA.nc +/blhome/erik/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_rcp8.5_monthly_1850-2100_13x12pt_f19_alaskaUSA.nc +/blhome/erik/inputdata/atm/cam/chem/trop_mozart_aero/aero/aerosoldep_rcp4.5_monthly_1850-2100_13x12pt_f19_alaskaUSA.nc +/blhome/erik/inputdata/atm/datm7/domain.clm/domain.lnd.1x1pt_US-Ha1_USGS.nc +/blhome/erik/inputdata/atm/datm7/domain.clm/domain.lnd.13x12pt_f19_alaskaUSA_gx1v6.nc +/blhome/erik/inputdata/lnd/clm2/griddata/fracdata_13x12pt_f19_alaskaUSA_gx1v6.nc +/blhome/erik/inputdata/lnd/clm2/griddata/fracdata_1x1pt_US-Ha1_USGS.nc +/blhome/erik/inputdata/lnd/clm2/griddata/topodata_13x12pt_f19_alaskaUSA.nc +/blhome/erik/inputdata/lnd/clm2/griddata/griddata_1x1pt_US-Ha1.nc +/blhome/erik/inputdata/lnd/clm2/griddata/griddata_13x12pt_f19_alaskaUSA.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata_13x12pt_f19_alaskaUSA_simyr1850.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata_1x1pt_US-Ha1_simyr2000.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_rcp4.5_13x12pt_f19_alaskaUSA_simyr1850-2100.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata_1x1pt_US-Ha1_simyr1850.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata_13x12pt_f19_alaskaUSA_simyr2000.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_1x1pt_US-Ha1_simyr1849-2006.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_13x12pt_f19_alaskaUSA_simyr1850-2100.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_rcp8.5_13x12pt_f19_alaskaUSA_simyr1850-2100.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_13x12pt_f19_alaskaUSA_simyr1849-2006.nc +/blhome/erik/inputdata/lnd/clm2/surfdata/surfdata.pftdyn_1x1pt_US-Ha1_simyr1850-2100.nc + +You can also use find to list files that have a particular pattern +in the name as well (using the -name option with wildcards). Also you can always rerun the +link_dirtree command if any new files are added that you need to be +linked into your directory tree. Since, the files are soft-links -- it doesn't take up +much space other than the files that you add there. This way all of the files are kept +in one place, they are organized by usage according to &cesm; standards, and you can +easily find your own files, and &clm; can find them as well. + + + + +Adding Resolution Names + +If you are adding files for new resolutions which aren't covered in the +namelist_definition file -- you'll need to add them in. The list of valid resolutions +is in the id="res" entry in the +models/lnd/clm/bld/namelist_files/namelist_definition.xml file. +You need to choose a name for your new resolution and simply add it to the comma +delimited +list of valid_values for the id="res" entry. The convention for global Gaussian grids +is number_of_latitudes x number_of_longitudes. The convention for global finite +volume grids is latitude_grid_size x longitude_grid_size where latitude and longitude +is measured in degrees. For regional or single-point datasets the names have a grid size +number_of_latitudes x number_of_longitudes followed by an underscore and then a +descriptive name such as a City name followed by an abbreviation for the Country in caps. +The only hard requirement is that names be unique for different grid files. +Here's what the entry for resolutions looks like in the file: + +<entry id="res" type="char*30" category="default_settings" + group="default_settings" + valid_values= +"128x256,64x128,48x96,32x64,8x16,94x192,0.23x0.31,0.47x0.63, +0.9x1.25,1.9x2.5,2.65x3.33,4x5,10x15,5x5_amazon,1x1_tropicAtl, +1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ, +1x1_brazil,1x1_urbanc_alpha,0.5x0.5"> +Horizontal resolutions +</entry> + +As you can see you just add your new resolution names to the end of the valid_values +list. + + +When using &ptclm; and adding supported single-point resolutions, you'll also want to +add these resolutions to the +models/lnd/clm/bld/config_files/config_definition.xml under +the sitespf_pt name. The entry in that file looks like: + +<entry id="sitespf_pt" +valid_values="none,1x1_brazil,1x1_tropicAtl,5x5_amazon, +1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX,1x1_asphaltjungleNJ, +1x1_urbanc_alpha,1x1_numaIA,1x1_smallvilleIA" +value="none" category="physics"> +Flag to turn on site specific special configuration flags for supported single +point resolutions. +Currently the only special settings are for MEXICOCITY and VANCOUVER, which make +changes to urban parameters. +</entry> + +&ptclm; assumes that any supported single-point resolutions are valid settings for +sitespf_pt. + + + + +Adding or Changing Default Filenames + +To add or change the default filenames you edit the +models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +and either change an existing filename or add a new one. Most entries in the +default namelist files, include different attributes that describe the different +properties that describe the differences in the datasets. Attributes include +the: resolution, year to simulation, range of years to simulate for transient +datafiles, the land-mask, the representative concentration pathway (rcp) for future +scenarios, and the type of biogeochemistry (bgc) model used. For example the +fatmgrid for the 1.9x2.5 resolution is as follows: + +<fatmgrid hgrid="1.9x2.5" >lnd/clm2/griddata/griddata_1.9x2.5_060404.nc +</fatmgrid> + +Other fatmgrid files are distinguished from this one by +their resolution (hgrid) attribute. + + +To add or change the default filenames for &clm; tools edit the +models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml +and either change an existing filename or add a new one. Editing this file is +similar to the namelist_defaults_clm.xml talked about above. + + +What are the required files? + +Different types of simulations and different types of configurations for &clm; require +different lists of files. The Carbon Nitrogen (cn) Biogeochemistry model for example +requires stream_fldfilename_ndep files, which are NOT required by +other bgc modes. Transient simulations also require transient datasets, and the names +of these datasets are sometimes different from the static versions (sometimes both are +required as in the dynamic PFT cases). + + +In the following table we list the different files used by CLM, they are listed +in order of importance, dependencies, and customizing. So the required files +are all near the top, and the files used only under different conditions are listed +later, and files with the fewest dependencies are near the top, as are the files +that are least likely to be customized. + + +Required Files for Different Configurations and Simulation Types + + + + + + + Filename + Config. type + Simulation type + Resol. Dependent? + Other Dependencies? + + + Notes + + + + + + fpftcon + ALL + ALL + No + No + + + Not usually customized, as describes plant function +type properties. &ptclm; copies the file for you so that you can customize it if you +like, see . + + + fsnowoptics + ALL + ALL + No + No + + + Not usually customized as describes global snow optical properties. + + + fsnowaging + ALL + ALL + No + No + + + Not usually customized as describes global snow aging properties. + + + fatmgrid + ALL + ALL + Yes + No + + + Creating, using mkgriddata +usually gives you the amount of customization +you need, as it just describes the grid and grid extents. + + + fatmlndfrc + ALL + ALL + Yes + land-mask + + + Describes the land-mask for points with active land, as well as the fraction +of each grid-cell covered by land. You might customize it to make sure the land-fraction +of your grid-cell matches the expected values for your site. But, usually you will just +use what mkgriddata gives you. + + + fsurdat + ALL + ALL + Yes + simulation-year + + + Describes percentages of different land-units, columns and +vegetation types within each grid-cell. To customize for a specific point +or region you may want to use custom input datasets to mksurfdata when +creating the file. mksurfdata also allows you to customize the PFT, +and soil types to it see . &ptclm; takes +advantage of this to create customized datasets as well, see the chapter on &ptclm; +at . + + + flanduse_timeseries + ALL + transient land-use land-cover change + Yes + Simulation year range, and representative concentration pathway (rcp) + + + See notes on fsurdat files. + + + frivinp_rtm + RTM only + ALL + No + No + + + We only provide a half-degree global river routing file. If you want +to model river flow for a smaller scale, or a basin regional scale, you would +need to create your own custom file to do that. Normally, we turn river-routing +OFF for regional or single point simulations. + + + flndtopo + ALL + fine-mesh simulations (specifying land resolution as a finer grid than +atmosphere resolution). + Yes + No + + + You may customize to give better surface heights for your site, or +input a higher resolution orography file when you create it using +mkgriddata. + + + fatmtopo + ALL + fine-mesh simulations (specifying land resolution as a finer grid than +atmosphere resolution). + Yes + No + + + You may customize to give better surface heights + for your site, or +input a higher resolution orography file when you create it using +mkgriddata. + + + finidat + ALL + RUN_TYPE="startup", CLM_FORCE_COLDSTART="off" + Yes + mask, maxpft, bgc, simulation-year, start-date + + + Used for starting the model from a spun-up state. +Create these files by running the model +for multiple years and saving the restart file from the end of a spin-up +simulation. + + + + fglcmask + glc_nec > 0 + Used for simulations with the active glacier ice sheet model "cism" + Yes + glacier-grid + + + Needs to match the file used by "cism" and +be for the same glacier grid. Only customized as coupled with the glacier model. + + + + + stream_fldfilename_ndep + bgc=cn/cndv + Yes + No + simulation-year + + + +You may customize this file to get the Nitrogen deposition characteristics +of your site if available. This file will be interpolated while the model is +running from it's resolution to the resolution that &clm; is running at. + + + + + +
+ + + + + + diff --git a/components/clm/doc/UsersGuide/addxhtmlhead.pl b/components/clm/doc/UsersGuide/addxhtmlhead.pl new file mode 100755 index 0000000000..d5f9615c58 --- /dev/null +++ b/components/clm/doc/UsersGuide/addxhtmlhead.pl @@ -0,0 +1,78 @@ +#!/usr/bin/env perl +# +use strict; +use Cwd; +use English; +use IO::File; +use Getopt::Long; +use IO::Handle; +#----------------------------------------------------------------------------------------------- + +# Get the directory name and filename of this script. If the command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume +# the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script + # is in + # the user's PATH +my $nm = "$ProgName::"; # name to use if script dies +my $scrdir; +if ($ProgDir) { + $scrdir = $ProgDir; +} else { + $scrdir = getcwd() +} + +sub usage { + my $msg = shift; + + print "ERROR:: $msg\n"; + die < +OPTIONS + NONE +EOF +} + +my %opts = ( ); + +GetOptions( +) or usage(); + +if ( $#ARGV != 0 ) { + &usage( "Wrong number of command line arguments" ); +} + +my $inputFile = $ARGV[0]; + +if ( ! -f $inputFile ) { + &usage( "Input file does NOT exist : $inputFile" ); +} + +my $fh = IO::File->new($inputFile, '<') or die "** $nm - can't open input file: +$inputFile\n"; + +# +# Add in XML XHTML headers +# +print <<"EOF"; + + + +EOF +while (my $line = <$fh>) { + if ( $line =~ /^$/ ) { + print "
\n"; + } elsif ( $line =~ /^'."\n"; + } else { + print $line; + } +} +$fh->close(); diff --git a/components/clm/doc/UsersGuide/appendix.xml b/components/clm/doc/UsersGuide/appendix.xml new file mode 100644 index 0000000000..058e67d577 --- /dev/null +++ b/components/clm/doc/UsersGuide/appendix.xml @@ -0,0 +1,305 @@ + +Editing Template Files Before Configure + +The last kind of customization that you can do for a case, before configure is run +is to edit the templates. The &clm; template is in +models/lnd/clm/bld/clm.cpl7.template, the &datm; template is +in models/atm/datm/bld/datm.cpl7.template, and the driver templates +are in the models/drv/bld directory and are named: +ccsm.template and cpl.template. When a case is +created they are also copied to the Tools/Templates directory +underneath your case. If you want to make changes that will impact all your cases, you +should edit the template files under the models directory, but +if you want to make a change ONLY for a particular case you should edit the template +under that specific case. + + + +Editing the template files is NOT for the faint of heart! We recommend this ONLY for +experts! It's difficult to do because the template is a script that actually creates +another script. So part of the script is echoing the script to be created and part of +it is a script that is run when "configure -case" is run. As a result any variables +in the part of the script that is being echoed have to be escaped like this: + +\$VARIABLE + +But, in other parts of the script that is run, you can NOT escape variables. So you +need to understand if you are in a part of the script that is echoing the script to +be created, or in the part of the script that is actually run. + + + +If you can customize your case using: compsets, env_*.xml variables, +or a user namelist, as outlined in you should do so. +The main reason to actually edit the template files, is if you are in a situation where +the template aborts when you try it run it when "configure -case" is run. The other +reason to edit the template is if you are &clm; developer and need to make adjustments +to the template because of code or script updates. An example of modifying the &datm; +template is in where sed is used to modify the path +for &CPLHIST; data. + + +Outline of the &clm; template + +The outline of the &clm; template is as follows: + +# set up options for clm configure and then run clm configure +$CODEROOT/lnd/clm*/bld/configure <options> +# set up options for clm build-namelist and then run clm build-namelist +$CODEROOT/lnd/clm*/bld/build-namelist <options> +# echo the $CASEBUILD/clm.buildnml.csh script out +cat >! $CASEBUILD/clm.buildnml.csh << EOF1 +# NOTE: variables in this section must be escaped +EOF1 +# Remove temporary namelist files + +# echo the $CASEBUILD/clm.buildexe.csh script out +cat > $CASEBUILD/clm.buildexe.csh <<EOF2 +# NOTE: variables in this section must be escaped +EOF2 +# Remove temporary configure files + + + + + +Outline of the &datm; template + +The outline of the &datm; template is as follows: + +# Check $GRID to set the $DOMAINFILE and $DOMAINPATH + +# Check DATM_PRESAERO to set the prescribed aerosol option +# If &CLMUSRDAT; is set and $DOMAINFILE is NOT -- set it by &CLMUSRDAT; +# Ensure $DOMAINFILE is set or else abort + +#============================================================================== +# Create resolved prestage data script +#============================================================================== +cat >! $CASEBUILD/datm.buildnml.csh << EOF1 +# NOTE: variables in this section must be escaped +EOF1 +# Major if blocks look at DATM_MODE: +# the if blocks setup streams and run Tools/build_streams to create stream files +#----- CLM_QIAN mode ---------------------------------------------------------- +else if ($DATM_MODE == "&CLMQIAN;" ) then +. + # Customize &CLMQIAN; options here + + # A.) Setup datm_atm_in namelist +cat >! $CASEBUILD/datm.buildnml.csh << EOF +cat >! datm_atm_in << EOF1 +# NOTE: variables in this section must be escaped +EOF1 +EOF + + # B.) Setup options to build_streams +. +. +. +#----- CLM1PT mode ---------------------------------------------------------- +else if ($DATM_MODE == "CLM1PT" ) then +. + # Customize CLM1PT options here + + # A.) Setup datm_atm_in namelist +cat >! $CASEBUILD/datm.buildnml.csh << EOF +cat >! datm_atm_in << EOF1 +# NOTE: variables in this section must be escaped +EOF1 +EOF + + # B.) Setup options to build_streams +. +. +. +. +#----- CPLHIST 3-hourly time-averaging mode +---------------------------------------------------------- +else if ($DATM_MODE == "&CPLHIST;" ) then +. + # Customize &CPLHIST; options here + + # A.) Setup datm_atm_in namelist +cat >! $CASEBUILD/datm.buildnml.csh << EOF +cat >! datm_atm_in << EOF1 +# NOTE: variables in this section must be escaped +EOF1 +EOF + + # B.) Setup options to build_streams +. +. +. +. + +#----- INVALID mode -----------------------------------------------------------else + echo "ERROR: unrecognized DATM_MODE = \$DATM_MODE " + exit -1 +endif + +#============================================================================== +# Create prescribed aero streams if appropriate +#============================================================================== +. +. +. +#============================================================================== +# Create remaining resolved namelist +#============================================================================== + +cat >! $CASEBUILD/datm.buildnml.csh << EOF +cat >! datm_in << EOF1 +# NOTE: variables in this section must be escaped +. +. +. +EOF1 + +EOF + +#============================================================================== +# Create script to build executable +#============================================================================== + +cat > $CASEBUILD/datm.buildexe.csh <<EOF +#! /bin/csh -f +# NOTE: variables in this section must be escaped +EOF + +#============================================================================== +# end of script +#============================================================================== + + + + + +Adding a new DATM_MODE to the &datm; template + + The steps to adding a new DATM_MODE + +Add a new "if" block to the &datm; template + +As you can see from above +there are major "if" blocks for the different DATM_MODE's. So adding a new +DATM_MODE means adding a new "if" block. The two major parts of each DATM_MODE +block are: + +Setup datm_atm_in namelist +Setup options to build_streams + + + + +In the "if" block create the <filename>datm_atm_in</filename> namelist + +See for some notes about the +&datm; namelist and streams files. That and the + +&datm; User's Guide should give you guidance on how to +setup the namelist for your case. + + + +In the "if" block create options to and call <command>build_streams</command> + +The next part of the "if" block in the &datm; template file to work with is the +call to build_streams. You may need to add additional options +to it. You may also need to call it multiple times for multiple streams. You will +also likely need to add a new source option to it with the "-s" option. For more +information on build_streams do the following. + +Getting help with <command>build_streams</command> for &datm; + +> scripts/ccsm_utils/Tools/build_streams -help + + +The output of the above command is: + + +&build_streams_help; + + + + + +Add new streams templates to the &datm; +<filename>datm.template.streams.xml</filename> file + +As part of modifying the behavior of build_streams you will also +have to edit the models/atm/datm7/bld/datm.template.streams.xml +file as well (or the local version in your +$CASENAME/Tools/Templates directory for a particular case). +The template is an XML file much like the output streams file, but there are attributes +to distinguish which fields will be used based on things like: RESOLUTION or datasource. +And there are filename indicators (starting with a "%") that get translated into various +things such as: + +%c = Case (from above -case command line option) +%do = Use domain file +%y = Year (through range given from begyear to endyear) +%ym = Year-Month (all 12 months through year range) +%6ym = Like %ym but 6 digit year (ie. %YYYYYY-MM). (can replace the 6 with any digit 1-9) + + + + +Add a new valid_value to the <filename>config_definition.xml</filename> file in +scripts. + +Adding a new DATM_MODE also requires adding a new valid_value to +scripts/ccsm_utils/Case.template/config_definition.xml. This +enables the scripts to recognize the new value as a valid option to DATM_MODE +in the &envconf; file. + + + + + + + +Building the Users-Guide Documentation for &clm; + +All of the documentation for &clm; can be built using GNU Makefiles that are +available in the appropriate directories. The Makefiles require the following +utilities: docbook2html, docbook2pdf, +protex, and latex2html. + + +To build the Users Guide for &clm; (requires docbook). + +> cd models/lnd/clm/doc/UsersGuide +> gmake + +Note, that when the Users-Guide is built it will get output from other &clm; +utilities that by nature abort, and hence stop the make from continuing. However, +this is expected so you should simply run gmake again until +it either completes or comes upon a legitimate issue. Here is what a sample +warning looks like when gmake is run. + +The following line will fail in the make as it calls die -- but that is expected +Check that the output config_help.tlog is good and redo your make +../../bld/configure -help >&` config_help.tlog +make: *** [config_help.tlog] Error 255 + +To build the Code Reference Guide for &clm; (requires protex and +latex2html). The make here uses a Filepath +file that points to the list of directories that you want protex +to run over. You should examine this file and make sure it is appropriate for what +you need to do, before running the make. + +> cd models/lnd/clm/doc/CodeReference +> gmake + +To build the table of tests for the &clm; test suite. The make here runs a UNIX +shell script to create a html table of the list of tests run on the different machines +from the &clm; test suite. + +> cd models/lnd/clm/test/system +> gmake + + + + + diff --git a/components/clm/doc/UsersGuide/badpergro.jpg b/components/clm/doc/UsersGuide/badpergro.jpg new file mode 100644 index 0000000000..4a378cf52d Binary files /dev/null and b/components/clm/doc/UsersGuide/badpergro.jpg differ diff --git a/components/clm/doc/UsersGuide/clm_stylesheet.dsl b/components/clm/doc/UsersGuide/clm_stylesheet.dsl new file mode 100644 index 0000000000..7bc3ed0036 --- /dev/null +++ b/components/clm/doc/UsersGuide/clm_stylesheet.dsl @@ -0,0 +1,154 @@ + + +]> + + + + + + + + + +;;Default extension for filenames +(define %html-ext% ".html") +;;What font would you like for the body? +(define %body-font-family% + "Arial") + +(element emphasis +(if (equal? (normalize "bold") (attribute-string (normalize "role"))) + ($bold-seq$) + ($italic-seq$))) + +(element tgroup + (let* ((wrapper (parent (current-node))) + (frameattr (attribute-string (normalize "frame") wrapper)) + (pgwide (attribute-string (normalize "pgwide") wrapper)) + (footnotes (select-elements (descendants (current-node)) + (normalize "footnote"))) + (border (if (equal? frameattr (normalize "none")) + '(("BORDER" "0")) + '(("BORDER" "1")))) + (bgcolor '(("BGCOLOR" "#E0E0E0"))) + (width (if (equal? pgwide "1") + (list (list "WIDTH" ($table-width$))) + '())) + (head (select-elements (children (current-node)) (normalize "thead"))) + (body (select-elements (children (current-node)) (normalize "tbody"))) + (feet (select-elements (children (current-node)) (normalize "tfoot")))) + (make element gi: "TABLE" + attributes: (append + border + width + bgcolor + '(("CELLSPACING" "0")) + '(("CELLPADDING" "4")) + (if %cals-table-class% + (list (list "CLASS" %cals-table-class%)) + '())) + (process-node-list head) + (process-node-list body) + (process-node-list feet) + (make-table-endnotes)))) + + +;;Should verbatim items be 'shaded' with a table? +(define %shade-verbatim% + #t) + +;;Define shade-verbatim attributes +(define ($shade-verbatim-attr$) + (list + (list "BORDER" "0") + (list "BGCOLOR" "#E0E0E0") + (list "WIDTH" ($table-width$)))) + +;;Index +(define (generate-index) + ("1")) + +;;======================== +;;Title Pages for Books +;;======================= + +(define (book-titlepage-recto-elements) + (list (normalize "title") + (normalize "subtitle") + (normalize "authorgroup") + (normalize "author") + (normalize "date") + (normalize "releaseinfo") + (normalize "orgname") + (normalize "graphic") + (normalize "copyright") + (normalize "legalnotice"))) + + + + + + + + + +;;Index +(define ($insert.xref.page.number$) + ("yes")) + +;;Index +(define ($generate-index$) + ("1")) + +;;Tex Backend off +(define tex-backend + #f) + +;;What elements should have a LOT? +(define ($generate-book-lot-list$) + (list (normalize "example") + (normalize "table") + (normalize "figure") + (normalize "equation"))) + +;;======================== +;;Title Pages for Books +;;======================= + +(define (book-titlepage-recto-elements) + (list (normalize "title") + (normalize "subtitle") + (normalize "authorgroup") + (normalize "author") + (normalize "date") + (normalize "orgname") + (normalize "graphic") + (normalize "copyright") + (normalize "legalnotice") + (normalize "releaseinfo"))) + +(define %show-ulinks% + ;; Display URLs after ULinks? + #t) + +(define %indent-screen-lines% + ;; Indent lines in a 'Screen'? + " ") + + + + + + + + diff --git a/components/clm/doc/UsersGuide/clm_ug.xml b/components/clm/doc/UsersGuide/clm_ug.xml new file mode 100644 index 0000000000..79a0d3de76 --- /dev/null +++ b/components/clm/doc/UsersGuide/clm_ug.xml @@ -0,0 +1,191 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + build-namelist"> + configure"> + NCAR"> + CCSM"> + CCSM4.0"> + CESM"> + CESM1.0"> + CESM1.0.1"> + CESM1.0.2"> + CESM1.0.3"> + + PTCLM"> + PTCLM1"> + PTCLM1.110504"> + CLM"> + CLMCN"> + CLMSP"> + CLMU"> + CLM3.0"> + CLM3.5"> + CLM4"> + CLM4.0.00"> + + + + + + + + DATM"> + models/lnd/clm/doc/KnownBugs"> + NetCDF"> + FORTRAN"> + FORTRAN-90"> + MPI"> + PIO"> + OpenMP"> + NCL"> + Perl"> + XML"> + xmlchange"> + 2"> + + + + env_run.xml"> + env_build.xml"> + env_conf.xml"> + user_nl_clm"> + + + PTS_MODE"> + CSMDATA"> + CLM_FORCE_COLDSTART"> + CLM_CONFIG_OPTS"> + CLM_BLDNML_OPTS"> + CLM_NML_USE_CASE"> + CLM_NAMELIST_OPTS"> + CLM_PT1_NAME"> + CLM_QIAN"> + CPLHIST3HrWx"> + CLM_USRDAT_NAME"> + CLM_CO2_TYPE"> + DIN_LOC_ROOT"> + + + CLM_QIAN"> + + + + %ISOamsa; + ]]> + + + + %ISOgrk1; + ]]> + +]> + + + + +&cesm; Research Tools: &clmrel; User's Guide Documentation + + + CESM + CLM + community earth system model + climate + climate model + earth system model + land surface model + hydrology + biogeochemistry + urban model + documentation + + + + + + Erik + Kluzek + + NCAR + + + + + + + +The user's guide to &clmrel; which is the active land surface model component of &cesmrel;. +The purpose of this guide is to instruct both the novice and experienced user, as well as +&clm; developers in the use of &clm4; for land-surface climate modeling. + + + +$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/doc/UsersGuide/clm_ug.xml $ + +&build_date; + + + + + +Dedicated to the Land Model Working Group, winners of the 2008 &ccsm; Distinguished Achievement Award. +May you continue to collaborate together well, and continue to drive +the science of land surface modeling forward with your diligent and persistent efforts. + + + + +&preface; +&custom; +&tools; +&adding_files; +&special_cases; +&single_point; +&ptclmdoc; +&trouble; +&testing; +&appendix; + + diff --git a/components/clm/doc/UsersGuide/co2_streams.txt b/components/clm/doc/UsersGuide/co2_streams.txt new file mode 100644 index 0000000000..4d38c6d06e --- /dev/null +++ b/components/clm/doc/UsersGuide/co2_streams.txt @@ -0,0 +1,50 @@ + + + This is a streams file to pass historical CO2 from datm8 to the other + surface models. It reads in a historical dataset derived from data used + by CAM. The getco2_historical.ncl script in components/clm/tools/ncl_scripts + was used to convert the CAM file to a streams compatible format (adding domain + information and making CO2 have latitude/longitude even if only for a single + point. + + + + Input stream description file for historical CO2 reconstruction data + + 04 March 2010: Converted to form that can be used by datm8 by Erik Kluzek + 18 December 2009: Prepared by B. Eaton using data provided by + Jean-Francois Lamarque. All variables except f11 are directly from + PRE2005_MIDYR_CONC.DAT. Data from 1765 to 2007 with 2006/2007 just + a repeat of 2005. + + + CLMNCEP + + + + time time + lonc lon + latc lat + area area + mask mask + + + /fis/cgd/cseg/csm/inputdata/atm/datm7/CO2 + + + fco2_datm_1765-2007_c100614.nc + + + + + CO2 co2diag + + + /fis/cgd/cseg/csm/inputdata/atm/datm7/CO2 + + + fco2_datm_1765-2007_c100614.nc + + + + diff --git a/components/clm/doc/UsersGuide/custom.xml b/components/clm/doc/UsersGuide/custom.xml new file mode 100644 index 0000000000..58f14b4c74 --- /dev/null +++ b/components/clm/doc/UsersGuide/custom.xml @@ -0,0 +1,1615 @@ + + + + + + + component set + compset + "I" compsets + "B" compsets + "E" compsets + "F" compsets + &CLMCONFIG; + &CLMNAMELIST; + &CLMFORCECOLD; + &CLMUSECASE; + &CLM1PT; + &CLMUSRDAT; + &CLMCO2; + + +How to customize the configuration for a case with &clm; + + +The +&cesm; User's Guide gives you the details on how to setup, &configure;, build, and run +a case. That is the document to give you the details on using the &cesm; scripts. The purpose +of this document is to give you the details when using &cesm; with &clm; on how to customize +and use advanced features in &clm;. You should be familiar with the &cesm; User's Guide and +how to setup cases with &cesmrel; before referring to this document. + + +In this chapter we deal with three different ways of customizing a case: Choosing a compset, +Customizing Configuration options, and customizing the &clm; Namelist. There are many different +compsets that use &clm; and many are setup to enable special features of &clm; from the start. So +the first thing you want to be familiar with are the different options in the compsets. The +next section shows the different options for customizing the configuration options for +&clm;. +Here we introduce the &clm; &configure; and &buildnml; scripts and how using the options in +&envconf; you can customize the configuration and the initial +namelist. The final section tells you about the &clm; namelist and how you can customize the +namelist once you have run "&configure; -case" and have an initial namelist in +BuildConf/clm.buildnml.csh. You can also +use &envconf; options to change your namelist as well, before "&configure; -case" is +run. + + + +Choosing a compset using &clm; + + +When setting up a new case one of the first choices to make is which "component +set" (or compset) to use. The +compset refers to which component models are used as well as specific settings for them. We label the different +types of compsets with a different letter of the alphabet from "A" (for all data model) to "X" (for all dead model). +The compsets of interest when working with &clm; are the "I" compsets (which contain +&clm; with a data atmosphere model +and a stub ocean, and stub sea-ice models), "E" and "F" compsets (which contain &clm; +with the active atmosphere model (CAM), +prescribed sea-ice model, and a data ocean model), and "B" compsets which have all active components. Below we +go into details on the "I" compsets which emphasize &clm; as the only active model, and just mention the two other categories. + + +When working with &clm; you usually want to start with a relevant "I" compset before moving to the more +complex cases that involve other active model components. The "I" compsets can exercise +&clm; in a way that +is similar to the coupled modes, but with much lower computational cost and faster turnaround times. + + +Compsets coupled to data atmosphere and stub ocean/sea-ice ("I" compsets) +&compsets_list; + + + + Compsets coupled to active atmosphere with data ocean + + CAM compsets are compsets that start with "E" or "F" in the name. They are + described more fully in the scripts documentation or the CAM documentation. "E" compsets have +a slab ocean model while "F" compsets have a data ocean model. + + + + +Fully coupled compsets with fully active ocean, sea-ice, and atmosphere + + Fully coupled compsets are compsets that start with "B" in the name. They are + described more fully in the scripts documentation. + + + + +Conclusion to choosing a compset + +We've introduced the basic type of compsets that use &clm; and given some further details +for the "standalone &clm;" (or "I" compsets). The + +config_compsets.xml lists all of the compsets and gives a full description +of each of them. In the next section we look into customizing the &configure; time options +for compsets using &clm;. + + + + + + + +Customizing the &clm; configuration + +The "Creating a Case" section of the +&cesm1; Scripts +User's-Guide +gives instructions on creating a case. What is of interest here is how to customize your +use of &clm; +for the case that you created. In this section we discuss how to customize your case before the first +step -- the "&configure; -case" step is done. In the next section we will discuss how to customize your +&clm; namelist after "&configure; -case" has already been done. + + +For &clm; when "&configure; -case" is called there are two steps that take place: + + +The &clm; "&configure;" script is called to setup the build-time +configuration for &clm; (more information on &configure; is given in +). +The &clm; "&buildnml;" script is called to generate the initial +run-time namelist for &clm; (more information on &buildnml; is given below in +. + + +When customizing your case at the &configure; step you are able to modify the process by effecting either one +or both of these steps. The &clm; "&configure;" and "&buildnml;" scripts are both available in the "models/lnd/clm/bld" +directory in the distribution. Both of these scripts have a "-help" option that is useful to examine to see what +types of options you can give either of them. + + +There are five different types of customization for the configuration that we will +discuss: &cesm1; &clm; configuration items, Configure time User Namelist, +other noteworthy &cesm; configuration items, the &clm; &configure; script options, and +the &clm; &buildnml; script options. + + +Information on all of the script, configuration, build and run items is found under +scripts/ccsm_utils/Case.template +in the +config_definition.xml + file. + + + +&clm; Script configuration items + +Below we list each of the &cesm; configuration items that are specific to &clm;. All +of these are available in your: &envconf; file. + + + + &CLMCONFIG; + &CLMBLDNML; + &CLMNAMELIST; + &CLMFORCECOLD; + &CLMUSECASE; + &CLM1PT; + &CLMUSRDAT; + &CLMCO2; + +For the precedence of the different options to &buildnml; see the section on +precedence below. + + +The first item &CLMCONFIG; has to do with customizing the &clm; configuration options for your case, the rest +all have to do with generating the initial namelist. + + + +&CLMCONFIG; + + +The option &CLMCONFIG; is all about passing command line arguments to the &clm; &configure; script. It is important +to note that some compsets, may already put a value into the &CLMCONFIG; variable. You can still add more +options to your &CLMCONFIG; but make sure you add to what is already there rather than replacing it. Hence, +we recommend using the "-append" option to the xmlchange script. In + +below we will go into more details on options that can be customized in the &clm; "&configure;" script. It's +also important to note that the &clm; template may already invoke certain &clm; &configure; options and as such those +command line options are NOT going to be available to change at this step (nor would you want to change them). +The options to &configure; are given with the "-help" option which is given in +. + + + + + +&CLMUSECASE; + + +&CLMUSECASE; is used to set a particular set of conditions that set multiple namelist items, all centering around +a particular usage of the model. +To list the valid options do the following: + + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -use_case list + + +The output of the above command is: + + +&usecases_list; + + + +See the section for the precedence of this +option relative to the others. + + + + + + +&CLMBLDNML; + + +The option &CLMBLDNML; is for passing options to the &clm; "&buildnml;" script. As with the "&configure;" +script the &clm; template may already invoke certain options and as such those options will NOT be available to be +set here. The best way to see what options can be sent to the "&buildnml;" script is to do + + +> cd models/lnd/clm/bld +> ./&buildnml; -help + + +Here is the output from the above. + + +./&buildnml_help; + + +The &clm; template already sets the resolution and mask as well as the &configure; file, +the start-type, the co2_ppmv, rtm_tstep, and rtm_res, and defines an input +namelist and namelist input file, and it normally sets either "-ignore_ic_year" or +"-ignore_ic_date". Also many +of the options are designed solely for &clm; stand-alone testing and hence should NOT +be used (any of the options starting +with a "datm_" or "drv_" prefix. Hence there are then only five different options that could be set: + + + +-lnd_res +-sim_year +-rcp +-clm_demand +-verbose + + + +"-lnd_res" is used to run &clm; in fine-mesh mode at a higher resolution than the atmospheric model. This can +be useful to get higher resolution from the land model, but saving computer time +by running the more expensive atmospheric model at a lower resolution. +To get a list of valid resolutions to run at do the following: + + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -lnd_res list + + + +The fine-mesh mode is considered experimental, and you may run into problems when you use +it. Another option is to use the CESM level "tri-grid" capability to run the land model +on a different grid than the atmospheric model. Read the CESM User's-Guide to learn how +to do this. + + + + + +See the section for the precedence of this +option relative to the others. + + + + +"-clm_demand" asks the &buildnml; step to require that the list of variables +entered be set. Typically, this is used to require that optional filenames be used and ensure +they are set before continuing. For example, you may want to require that +flanduse_timeseries be set to get dynamically changing vegetation types. To do this +you would do the following. + +> ./xmlchange -file env_conf.xml -id &CLMBLDNML; -val "-clm_demand flanduse_timeseries" + +To see a list of valid variables that you could set do this: + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -clm_demand list + + + + +Using a 20th-Century transient compset or the 20thC_transient use-case +using &CLMUSECASE; would set this as well, but would also use +dynamic nitrogen and aerosol deposition files, so using -clm_demand would be a way +to get just dynamic vegetation types and NOT the other files as well. + + + +"-sim_year" is used to set the simulation year you want the data-sets to simulate conditions for in the input +datasets. The simulation "year" can also be a range of years in order to do simulations +with changes in the dataset values as the simulation progresses. To list the valid +options do the following: + + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -sim_year list + + +"-rcp" is used to set the representative concentration pathway for the future scenarios +you want the data-sets to simulate conditions for, in the input +datasets. To list the valid options do the following: + + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -rcp list + + + + + +&CLMNAMELIST; + + +The option &CLMNAMELIST; is for passing namelist items into the "clm_inparm" namelist. +Any items that are set in &CLMNAMELIST; will be set in your namelist after "&configure; +-case" is done. + + + +For character namelist items you need to use "&apos;" as quotes for strings so that the +scripts don't get confused with other quotes they use. + + + +Example, you want to set hist_dov2xy to .false. +so that you get vector output to your history files. To do so edit +&envconf; and add a setting for hist_dov2xy. +So do the following: + +> ./xmlchange -file env_conf.xml -id &CLMNAMELIST; -val hist_dov2xy=.false. + + + +Example, you want to set hist_fincl1 to add the variable 'HK' +to your history files. To do so edit +&envconf; and add a setting for hist_fincl1. +So do the following: + +> ./xmlchange -file env_conf.xml -id &CLMNAMELIST; -val "hist_fincl1=&apos;HK&apos;" + +For a list of the history fields available see +&clm; History Fields. + + + +See the section for the precedence of this +option relative to the others. + + + + + + +&CLMCO2; + + +&CLMCO2; sets the type of input &CO2; for either "constant", "diagnostic" or prognostic". +If "constant" the value from CCSM_CO2_PPMV will be used. If "diagnostic" +or "prognostic" the values MUST be sent from the atmosphere model. For more information on how +to send &CO2; from the data atmosphere model see . + + + + + +&CLMFORCECOLD; + + +&CLMFORCECOLD; when set to on, requires that +your simulation do a cold start from arbitrary initial conditions. If this is NOT set, it +will use an initial condition file if it can find an appropriate one, and otherwise do a cold +start. &CLMFORCECOLD; is a good way to ensure that you are doing a cold +start if that is what you want to do. + + + + + +&CLM1PT; + + +&CLM1PT; is used ONLY for a pt1_pt1 +resolution simulation to set the name of the single-point files to use. +To see a list of the valid resolutions do this: + +> cd models/lnd/clm/doc +> ../bld/&buildnml; -res list + + + +The output of the above command is: + + +&res_list; + + +the valid resolutions that can be used with &CLM1PT; are the ones that +have city or nation names such as: 5x5_amazon, 1x1_vancouverCAN 1x1_mexicocityMEX, or +1x1_brazil. The "1x1_" prefix means the file is for a single-point, while "5x5_" prefix means +it's for a region of five points in latitude by five points in longitude. Both regional +and single point datasets can be used for &CLM1PT;. If you create your own datasets +you can also use &CLM1PT; along with &CLMUSRDAT; (documented below), setting &CLM1PT; to +the value in &CLMUSRDAT; so that your datasets are used rather than the standard ones.o + + + + + +&CLMUSRDAT; + + +&CLMUSRDAT; provides a way to enter your own datasets into the initial +namelist setup at "&configure; -case". The files you create must be named with +specific naming conventions outlined in: . +To see what the expected names of the files are, use the +queryDefaultNamelist.pl to see +what the names will need to be. For example if your &CLMUSRDAT; will +be "1x1_boulderCO", with a "navy" land-mask, constant simulation year range, for 1850, +the following will list what your filenames should be: + +> cd models/lnd/clm/bld +> queryDefaultNamelist.pl -usrname "1x1_boulderCO" -options \ +mask=navy,sim_year=1850,sim_year_range="constant" -csmdata $CSMDATA + +An example of using &CLMUSRDAT; for a simulation is given in +. + + + +See the section for the precedence of this +option relative to the others. + + + + + + + + + +Configure time User Namelist + +&CLMNAMELIST; as described above allows you to set any +extra namelist items you would like to appear in your namelist after first &configure;d. +However, it only allows you a single line to enter namelist items, and strings must +be quoted with &apos; which is a bit awkward. If you have a long list of namelist +items you want to set (such as a long list of history fields) a convenient way to do it +is to create a &usernlclm; that contains just the list of namelist +variables you want to add to your initial namelist. The &usernlclm; +will only be used when &configure; is run, so if you change it after &configure; -- it won't +change anything. The file needs to be in valid FORTRAN namelist format, and the &configure; +step will abort if there are syntax errors. It merely needs to be named correctly +&usernlclm; and placed in your case directory (where your other +env_*.xml files are). The namelist name actually doesn't have to be +valid, but all the variable names must be. Here's an example &usernlclm; +namelist that sets a bunch of history file related items, to create output history files +monthly, daily, every six and 1 hours. + +Example &usernlclm; namelist file + +&clmexp + hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', + 'FSR','FSA','FGEV','FSH','FGR','TSOI', + 'ERRSOI','BUILDHEAT','SABV','SABG', + 'FSDSVD','FSDSND','FSDSVI','FSDSNI', + 'FSRVD','FSRND','FSRVI','FSRNI', + 'TSA','FCTR','FCEV','QBOT','RH2M','H2OSOI', + 'H2OSNO','SOILLIQ','SOILICE', + 'TSA_U', 'TSA_R', + 'TREFMNAV_U', 'TREFMNAV_R', + 'TREFMXAV_U', 'TREFMXAV_R', + 'TG_U', 'TG_R', + 'RH2M_U', 'RH2M_R', + 'QRUNOFF_U', 'QRUNOFF_R', + 'SoilAlpha_U', + 'Qanth', 'SWup', 'LWup', 'URBAN_AC', 'URBAN_HEAT' + hist_fincl3 = 'TG:I', 'FSA:I', 'SWup:I', 'URBAN_AC:I', 'URBAN_HEAT:I', + 'TG_U:I', 'TG_R:I', + hist_fincl4 = 'TG', 'FSA', 'SWup', 'URBAN_AC', 'URBAN_HEAT' + hist_mfilt = 1, 30, 28, 24 + hist_nhtfrq = 0, -24, -6, -1 +/ + + + + +See the section for the precedence of this +option relative to the others. + + + + +In the above example we use an invalid namelist name &clmexp -- but it works anyway +because the &clm; &buildnml; knows the namelist that specific variable names belong to, and +it puts them there. + + +Obviously, all of this would be difficult to put in the &CLMNAMELIST; +variable, especially having to put &apos; around all the character strings. For +more information on the namelist variables being set here and what they mean, see +the section on &clm; namelists below, as well as the namelist definition that gives +details on each variable. + + + + +Precedence of Options + +Note: The precedence for setting the values of namelist variables with the +different env_conf options is (highest to lowest): + +Namelist values set by specific command-line options, like, -d, -sim_year +(i.e. &CLMBLDNML; env_conf variable) +Values set on the command-line using the -namelist option, +(i.e. &CLMNAMELIST; env_conf variable) +Values read from the file specified by -infile, +(i.e. &usernlclm; file) +Datasets from the -clm_usr_name option, +(i.e. &CLMUSRDAT; env_conf variable) +Values set from a use-case scenario, e.g., -use_case +(i.e. &CLMUSECASE;env_conf variable) +Values from the namelist defaults file. + +Thus a setting in &CLMBLDNML; will override a setting for the same thing given in +a use case with &CLMUSECASE;. Likewise, a setting in &CLMNAMELIST; will override a +setting in &usernlclm;. + + + + +Setting Your Initial Conditions File + +Especially with &clmcn; starting from initial conditions is very important. Even +with &clmsp; it takes many simulation years to get the model fully spunup. There +are a couple different ways to provide an initial condition file. + + + + + + + + +Your initial condition file MUST agree with the surface dataset you are using +to run the simulation. If the two files do NOT agree you will get a +run-time about a mis-match in PFT weights, or in the number of PFT's or +columns. To get around this you'll need to use +to interpolate your initial condition dataset. + + + + + +Doing a hybrid simulation to provide initial conditions + +The first option is to setup a hybrid simulation and give a +RUN_REFCASE and RUN_REFDATE to specify the +reference case simulation name to use. +When you setup most cases, at the standard resolutions of "f09" or "f19" it +will already do this for you. For example, if you run an "I2000CN" compset +at "f09_g16" resolution the following settings will already be done for you. + +./xmlchange -file env_conf.xml -id RUN_TYPE -val hybrid +./xmlchange -file env_conf.xml -id RUN_REFCASE -val I2000CN_f09_g16_c100503 +./xmlchange -file env_conf.xml -id RUN_REFDATE -val 0001-01-01 +./xmlchange -file env_conf.xml -id GET_REFCASE -val TRUE + +Setting the GET_REFCASE option to TRUE means it +will copy the files from the: +$DIN_LOC_ROOT/ccsm4_init/I2000CN_f09_g16_c100503/0001-01-01 +directory. Note, that the RUN_REFCASE and +RUN_REFDATE variables are expanded to get the directory name +above. If you do NOT set GET_REFCASE to TRUE then +you will need to have placed the file in your run directory yourself. In either +case, the file is expected to be named: +$RUN_REFCASE.clm2.r.$RUN_REFDATE-00000.nc with the variables +expanded of course. + + + + +Doing a branch simulation to provide initial conditions + +The setup for running a branch simulation is essentially the same as for a hybrid. +With the exception of setting RUN_TYPE to branch +rather than hybrid. A branch simulation runs the case essentially +as restarting from it's place before to exactly reproduce it. While a hybrid simulation +allows you to change namelist items, and use a different code base that may have +fewer fields on it than a full restart file. The GET_REFCASE works +similarily for a branch case as for a hybrid. + + + + +Providing a finidat file in your &usernlclm; file + +Setting up a branch or hybrid simulation requires the initial condition file +to follow a standard naming convention, and a standard input directory if you +use the GET_REFCASE option. If you want to name your file willy +nilly and place it anywhere, you can set it in your &usernlclm; file as in this +example. + +&clm_inparm + finidat = '/glade/home/$USER/myinitdata/clmi_I1850CN_f09_g16_0182-01-01.c120329.nc' +/ + +Note, if you provide an initial condition file -- you can NOT set &CLMFORCECOLD; to +TRUE. + + + + +Adding a finidat file to the XML database + +Like other datasets, if you want to use a given initial condition file to +be used for all (or most of) your cases you'll want to put it in the XML +database so it will be used by default. The initial condition files, are +resolution dependent, and dependent on the number of PFT's and other variables +such as GLC_NEC or if irrigation is on or off. +See for more information on this. + + + + + +Other noteworthy configuration items + +For running "I" cases there are several other noteworthy configuration items that +you may want to work with. Most of these involve settings for the &datm;, but one +CCSM_CO2_PPMV applies to all models. If you are running an B, E, +or F case that doesn't use the &datm; obviously the DATM_* settings will not be used. +All of the settings below are in your &envconf; file + + CCSM_CO2_PPMV + CCSM_VOC + DATM_MODE + DATM_PRESAERO + DATM_CLMNCEP_YR_ALIGN + DATM_CLMNCEP_YR_START + DATM_CLMNCEP_YR_END + DATM_CPL_CASE + DATM_CPL_YR_ALIGN + DATM_CPL_YR_START + DATM_CPL_YR_END + + + + + +CCSM_CO2_PPMV + +CCSM_CO2_PPMV sets the mixing ratio of &CO2; in +parts per million by volume for ALL &cesm; components to use. Note that most compsets +already set this value to something reasonable. Also note that some compsets may +tell the atmosphere model to override this value with either historic or ramped +values. If the CCSM_BGC variable is set to something other than "none" +the atmosphere model will determine &CO2;, and &clm; will listen +and use what the atmosphere sends it. On the &clm; side the namelist item +co2_type tells &clm; to use the value sent from the atmosphere rather than +a value set on it's own namelist. + + + + +CCSM_VOC + +CCSM_VOC enables passing of the Volatile Organic Compounds (VOC) from +&clm; to the atmospheric model. This of course is only important if the atmosphere +model is a fully active model that can use these fields in it's chemistry calculations. + + + + +DATM_MODE + +DATM_MODE sets the mode that the &datm; model should run in this determines +how data is handled as well as what the source of the data will be. Many of the modes +are setup specifically to be used for ocean and/or sea-ice modeling. The modes +that are designed for use by &clm; are: + +&CLMQIAN; +CLM1PT +&CPLHIST; + + + +&CLMQIAN; is for the standard mode of using global atmospheric data +that was developed by Qian et. al. for &clm; using NCEP data from 1948 to 2004. +See for more information on +the &datm; settings for &CLMQIAN; mode. +CLM1PT is for the special cases where we have single-point tower +data for particular sites. Right now we only have data for three urban locations: +MexicoCity Mexico, Vancouver Canada, and the urban-c alpha site. +See for more information on +the &datm; settings for CLM1PT mode. +&CPLHIST; is for running with atmospheric forcing from a previous &cesm; simulation. +See for more information on +the &datm; settings for &CPLHIST; mode. + + +There is a problem with running simulations for the CLM1PT mode +that are greater than one data cycle, where the atm forcing will be held constant. +This will result in useless +results as all atmosphere forcing fields will be held constant at the last value. +See bug 1377 in the &KnownBugs; file on how to fix this problem. + + + + + + + +DATM_PRESAERO + +DATM_PRESAERO sets the prescribed aerosol mode for the data atmosphere +model. The list of valid options include: + +clim_1850 = constant year 1850 conditions +clim_2000 = constant year 2000 conditions +trans_1850-2000 = transient 1850 to year 2000 conditions +rcp2.6 = transient conditions for the rcp=2.6 +W/m2 future +scenario +rcp4.5 = transient conditions for the rcp=4.5 +W/m2 future +scenario +rcp6.0 = transient conditions for the rcp=6.0 +W/m2 future +scenario +rcp8.5 = transient conditions for the rcp=8.5 +W/m2 future +scenario +pt1_pt1 = read in single-point or regional datasets + + + + + +DATM_CLMNCEP_YR_START + +DATM_CLMNCEP_YR_START sets the beginning year to cycle the atmospheric +data over for the &CLMQIAN; mode. + + + + +DATM_CLMNCEP_YR_END + +DATM_CLMNCEP_YR_END sets the ending year to cycle the atmospheric +data over for the &CLMQIAN; mode. + + + + +DATM_CLMNCEP_YR_ALIGN + +DATM_CLMNCEP_YR_START and DATM_CLMNCEP_YR_END determine +the range of years to cycle the atmospheric data over, and DATM_CLMNCEP_YR_ALIGN +determines which year in that range of years the simulation will start with. + + + + +DATM_CPL_CASE + +DATM_CPL_CASE sets the casename to use for the &CPLHIST; mode. + + + + +DATM_CPL_YR_START + +DATM_CPL_YR_START sets the beginning year to cycle the atmospheric +data over for the &CPLHIST; mode. + + + + +DATM_CPL_YR_END + +DATM_CPL_YR_END sets the ending year to cycle the atmospheric +data over for the &CPLHIST; mode. + + + + +DATM_CPL_YR_ALIGN + +DATM_CPL_YR_START and DATM_CPL_YR_END determine +the range of years to cycle the atmospheric data over, and DATM_CPL_YR_ALIGN +determines which year in that range of years the simulation will start with. + + + + + + + + +Downloading DATM Forcing Data + +In Chapter One of the +&cesm; User's Guide +there is a section on "Downloading input data". The normal process of setting up +cases will use the "scripts/ccsm_utils/Tools/check_input_data" script to retrieve +data from the &cesm; subversion inputdata repository. However, the DATM forcing data +is unique -- because it is large compared to the rest of the input data (56 Gbytes). Most of the +data is stored in the directory set by the &envrun; variable +DIN_LOC_ROOT_CSMDATA. The &CLMQIAN; forcing data is in a (possibly) +separate directory using the &envrun; variable DIN_LOC_ROOT_CLMQIAN. +In most cases this directory will be in the directory: +atm/datm7/atm_forcing.datm7.Qian.T62.c080727 under +DIN_LOC_ROOT_CSMDATA. On bluefire there is a separate path for +the &CLMQIAN; forcing data. We have the full set of data available on a few of +the machines we use: bluefire, jaguarpf, and edinburgh. As of October, 18th, 2011 +we've uploaded the entire set of forcing data into the input data repository so +now it can be treated like other input datasets and the check_input_data script +can retreive it for you. Previously only two years of data was available. +You can also download the data from the +Earth System Grid for other machines. See the +Model Forcing Data +link under the +&clm; Documentation Page + + + + +Customizing via the template files + +The final thing that the user may wish to do before &configure; is run is to edit +the template files which determine the configuration and initial namelist. The +variables in &envconf; typically mean you will NOT have +to edit the template. But, there are rare instances where it is useful to do so. + gives the details on how to do this. +The template files are copied to your case directory and are available under +Tools/Templates. +The list of template files you might wish to edit are: + + clm.cpl7.template + datm.cpl7.template + cpl.template + + + + + + +More information on the &clm; &configure; script + +The &configure; script defines the details of a clm configuration and summarizes it into a +config_cache.xml file. The config_cache.xml +will be placed in your case directory under Buildconf/clmconf. +The config_definition.xml +in models/lnd/clm/bld/config_files +gives a definition of each &clm; configuration item, it is viewable in a web-browser. +Many of these items are things that you would NOT change, but looking through the +list gives you the valid options, and a good description of each. Below we repeat +the config_definition.xml files contents: + + + + + +Help on &clm; &configure; + +Coupling this with looking at the options to &configure; with +"-help" as below will enable you to understand how to set the different options. + +> cd models/lnd/clm/bld +> &configure; -help + + + +The output to the above command is as follows: + + +&config_help; + + +We've given details on how to use the options in &envconf; to +interact with the &clm; "&configure;" and "&buildnml;" scripts, as well as giving a good +understanding of how these scripts work and the options to them. In the next section we +give further details on the &clm; namelist. You could customize the namelist for these +options after "&configure; -case" is run. + + + + + + + + + + Customizing the &clm; namelist + +Once a case is &configure;d, we can then customize the case further, by editing the +run-time namelist for &clm;. First let's list the definition of each namelist +item and their valid values, and then we'll list the default values for them. +Next for some of the most used or tricky namelist items we'll give examples of their +use, and give you example namelists that highlight these features. + + + + +Definition of Namelist items and their default values + +Here we point to you where you can find the definition of each namelist item and +separately the default values for them. The default values may change depending on +the resolution, land-mask, simulation-year and other attributes. Both of these +files are viewable in your web browser. Below we provide the link for them, and +then expand each in turn. + + + +Definition of each Namelist Item + + +Default values of each +&clm; Namelist Item + + + +One set of the namelist items allows you to add fields to the output history files: +hist_fincl1, hist_fincl2, +hist_fincl3, hist_fincl4, +hist_fincl5, and hist_fincl6. The link +&clm; History Fields +documents all of the history fields available and gives the long-name and units +for each. + + + + + +&hisfldtbl; + + + + + + + +Examples of using different namelist features + +Below we will give examples of user namelists that activate different commonly used +namelist features. We will discuss the namelist features in different examples and then +show a user namelist that includes an example of the use of these features. First we +will show the default namelist that doesn't activate any user options. + + + +The default namelist + +Here we give the default namelist as it would be created for a I1850CN compset at 0.9x1.25 +resolution with a gx1v6 land-mask. To edit the namelist you would edit the +BuildConf/clm.buildnml.csh under your case (or before &configure; +include a user namelist with just the items you want to change). For simplicity we will +just show the namelist and NOT the entire file. In the sections below, for simplicity + we will just show the user namelist (&usernlclm;) that will add (or modify existing) +namelist items to the namelist. Again, just adding the &usernlclm; file to your case +directory, before "&configure; -case" is invoked will cause the given namelist items to +appear in your &clm; namelist. + +Default &clm; Namelist + +&clm_inparm + co2_ppmv = 284.7 + co2_type = 'constant' + create_crop_landunit = .false. + dtime = 1800 + fatmgrid = '$DIN_LOC_ROOT/lnd/clm2/griddata/griddata_0.9x1.25_070212.nc' + fatmlndfrc = +'$DIN_LOC_ROOT/lnd/clm2/griddata/fracdata_0.9x1.25_gx1v6_c090317.nc' + finidat = 'I1850CN_f09_g16_c100503.clm2.r.0001-01-01-00000.nc' + fpftcon = '$DIN_LOC_ROOT/lnd/clm2/pftdata/pft-physiology.c110425.nc' + frivinp_rtm = '$DIN_LOC_ROOT/lnd/clm2/rtmdata/rdirc_0.5x0.5_simyr2000_slpmxvl_c120717.nc' + fsnowaging = +'$DIN_LOC_ROOT/lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc' + fsnowoptics = +'$DIN_LOC_ROOT/lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc' + fsurdat = +'$DIN_LOC_ROOT/lnd/clm2/surfdata/surfdata_0.9x1.25_simyr1850_c091006.nc' + ice_runoff = .true. + outnc_large_files = .true. + rtm_nsteps = 6 + urban_hac = 'ON_WASTEHEAT' + urban_traffic = .false. +/ +&ndepdyn_nml + stream_fldfilename_ndep = +'$DIN_LOC_ROOT/lnd/clm2/ndepdata/fndep_clm_hist_simyr1849-2006_1.9x2.5_c100428.nc' + stream_year_first_ndep = 1850 + stream_year_last_ndep = 1850 +/ + + +Note that the namelist introduces some of the history namelist options that will be +talked about in further detail below (hist_mfilt and +hist_nhtfrq). + + + + +Adding/removing fields on your primary history file + +The primary history files are output monthly, and contain an extensive list of +fieldnames, but the list of fieldnames can be added to using hist_fincl1 +or removed from by adding fieldnames to hist_fexcl1. +A sample user namelist &usernlclm; adding few new fields +(cosine of solar zenith angle, and solar declination) and excluding a few +standard fields is (ground temperature, vegetation temperature, soil temperature and soil water).: + +Example &usernlclm; namelist adding and removing fields on primary history file + +&clm_inparm + hist_fincl1 = 'COSZEN', 'DECL' + hist_fexcl1 = 'TG', 'TV', 'TSOI', 'H2OSOI' +/ + + + + + + +Adding auxiliary history files and changing output +frequency + +The hist_fincl2 through hist_fincl6 set of +namelist variables add given history fieldnames to auxiliary history file "streams", and +hist_fexcl2 through hist_fexcl6 set of +namelist variables remove given history fieldnames from history file auxiliary "streams". +A history "stream" is a set of history files that are produced at a given frequency. +By default there is only one stream of monthly data files. To add more streams you +add history fieldnames to hist_fincl2 through +hist_fincl6. The output frequency and the way averaging is done +can be different for each history file stream. By default the primary history files +are monthly and any others are daily. You can have up to six active history streams, but you need +to activate them in order. So if you activate stream "6" by setting +hist_fincl6, but if any of hist_fincl2 through +hist_fincl5 are unset, only the history streams up to the first blank one +will be activated. + + +The frequency of the history file streams is given by the namelist variable +hist_nhtfrq which is an array of rank six for each history stream. +The values of the array hist_nhtfrq must be integers, where the +following values have the given meaning: + +Positive value means the output frequency is the number of +model steps between output. + +Negative value means the output frequency is the absolute +value in hours given (i.e -1 would mean an hour and -24 would mean a full day). Daily +(-24) is the default value for all auxiliary files. + +Zero means the output frequency is monthly. This is the +default for the primary history files. + + + + +The number of samples on each history file stream is given by the namelist variable +hist_mfilt which is an array of rank six for each history stream. +The values of the array hist_mfilt must be positive integers. By +default the primary history file stream has one time sample on it (i.e. output is +to separate monthly files), and all other streams have thirty time samples on them. + + +A sample user namelist &usernlclm; turning on four extra file +streams for output: daily, six-hourly, hourly, and every time-step, +leaving the primary history files as monthly, and changing the number +of samples on the streams to: yearly (12), thirty, weekly (28), daily (24), and daily +(48) is: + +Example &usernlclm; namelist adding auxiliary history files and changing output frequency + +&clm_inparm + hist_fincl2 = 'TG', 'TV' + hist_fincl3 = 'TG', 'TV' + hist_fincl4 = 'TG', 'TV' + hist_fincl5 = 'TG', 'TV' + hist_nhtfrq = 0, -24, -6, -1, 1 + hist_mfilt = 12, 30, 28, 24, 48 +/ + + + + + + +Removing all history fields + +Sometimes for various reasons you want to remove all the history fields either +because you want to do testing without any output, or you only want a very small +custom list of output fields rather than the default extensive list of fields. +By default only the primary history files are active, so technically using +hist_fexcl1 explained in the first example, you could list +ALL of the history fields that are output in +hist_fexcl1 and then you wouldn't get any output. However, as +the list is very extensive this would be a cumbersome thing to do. So to facilitate +this hist_empty_htapes allows you to turn off all default output. +You can still use hist_fincl1 to turn your own list of fields +on, but you then start from a clean slate. +A sample user namelist &usernlclm; turning off all history +fields and then activating just a few selected fields (ground and vegetation temperatures +and absorbed solar radiation) is: + +Example &usernlclm; namelist removing all history fields + +&clm_inparm + hist_empty_htapes = .true. + hist_fincl1 = 'TG', 'TV', 'FSA' +/ + + +Note, you could also build adding the "-noio" option to &CLMCONFIG;. But, this would +build the model without history output and you wouldn't be able to add that in later. + + + + +Various ways to change history output averaging flags + +There are two ways to change the averaging of output history fields. The first is using +hist_avgflag_pertape which gives a default value for each history +stream, the second is when you add fields using hist_fincl*, you add +an averaging flag to the end of the field name after a colon (for example 'TSOI:X', would +output the maximum of TSOI). +The types of averaging that can be done are: + +A Average, over the output interval. +I Instantaneous, output the value at the output interval. +X Maximum, over the output interval. +M Minimum, over the output interval. + + +The default averaging depends on the specific fields, but for most fields is an average. +A sample user namelist &usernlclm; making the monthly output +fields all averages (except TSOI for the first two streams and FIRE for the 5th stream), +and adding auxiliary file streams for instantaneous (6-hourly), +maximum (daily), minimum (daily), and average (daily). For some of the fields we +diverge from the per-tape value given and customize to some different type of +optimization. + +Example &usernlclm; namelist with various ways to average history fields + +&clm_inparm + hist_empty_htapes = .true. + hist_fincl1 = 'TSOI:X', 'TG', 'TV', 'FIRE', 'FSR', 'FSH', + 'EFLX_LH_TOT', 'WT' + hist_fincl2 = 'TSOI:X', 'TG', 'TV', 'FIRE', 'FSR', 'FSH', + 'EFLX_LH_TOT', 'WT' + hist_fincl3 = 'TSOI', 'TG:I', 'TV', 'FIRE', 'FSR', 'FSH', + 'EFLX_LH_TOT', 'WT' + hist_fincl4 = 'TSOI', 'TG', 'TV:I', 'FIRE', 'FSR', 'FSH', + 'EFLX_LH_TOT', 'WT' + hist_fincl5 = 'TSOI', 'TG', 'TV', 'FIRE:I', 'FSR', 'FSH', + 'EFLX_LH_TOT', 'WT' + hist_avgflag_pertape = 'A', 'I', 'X', 'M', 'A' + hist_nhtfrq = 0, -6, -24, -24, -24 +/ + + + + + +In the example we put the same list of fields on each of the tapes: soil-temperature, +ground temperature, vegetation temperature, emitted longwave radiation, reflected +solar radiation, sensible heat, total latent-heat, and total water storage. We also +modify the soil-temperature for the primary and secondary auxiliary tapes by outputting +them for a maximum instead of the prescribed per-tape of average and instantaneous +respectively. For the tertiary auxiliary tape we output ground temperature instantaneous +instead of as a maximum, and for the fourth auxiliary tape we output vegetation +temperature instantaneous instead of as a minimum. Finally, for the fifth auxiliary +tapes we output FIRE instantaneously instead of as an average. + + + + +We also use hist_empty_htapes as in the previous example, +so we can list ONLY the fields that we want on the primary history tapes. + + + + + +Outputting history files as a vector in order to analyze +the plant function types within gridcells + +By default the output to history files are the grid-cell average of all land-units, and +vegetation types within that grid-cell, and output is on the +full 2D latitude/longitude grid with ocean masked out. Sometimes it's important to +understand how different land-units or vegetation types are acting within a grid-cell. +The way to do this is to output history files as a 1D-vector of all land-units and vegetation +types. In order to display this, you'll need to do extensive post-processing to make sense +of the output. Often you may only be interested in a few points, so once you figure out the +1D indices for the grid-cells of interest, you can easily view that data. 1D vector output +can also be useful for single point datasets, since it's then obvious that all data is for the +same grid cell. + + +To do this you use hist_dov2xy which is an array of rank six for +each history stream. Set it to +.false. if you want one of the history streams to be a 1D vector. +You can also use hist_type1d_pertape if you want to average over all the: +Plant-Function-Types, columns, land-units, or grid-cells. +A sample user namelist &usernlclm; leaving the primary monthly +files as 2D, and then doing grid-cell (GRID), column (COLS), +and no averaging over auxiliary tapes output daily for a single field +(ground temperature) is: + +Example &usernlclm; namelist outputting some files in 1D Vector format + +&clm_inparm + hist_fincl2 = 'TG' + hist_fincl3 = 'TG' + hist_fincl4 = 'TG' + hist_fincl5 = 'TG' + hist_fincl6 = 'TG' + hist_dov2xy = .true., .false., .false., .false. + hist_type2d_pertape = ' ', 'GRID', 'COLS', ' ' + hist_nhtfrq = 0, -24, -24, -24 +/ + + + + +LAND and COLS are also options to the pertape averaging, but currently there is a bug +with them and they fail to work. + + + + + +Technically the default for hist_nhtfrq is for primary files +output monthly and the other auxiliary tapes for daily, so we don't actually have +to include hist_nhtfrq, we could use the default for it. Here +we specify it for clarity. + + + + +Visualizing global 1D vector files will take effort. You'll probably want +to do some post-processing and possibly just extract out single points of interest +to see what is going on. Since, the output is a 1D vector, of only land-points +traditional plots won't be helpful. The number of points per grid-cell will also +vary for anything, but grid-cell averaging. You'll need to use the output fields +pfts1d_ixy, and pfts1d_jxy, to get the mapping +of the fields to the global 2D array. pfts1d_itype_veg gives you +the PFT number for each PFT. Most likely you'll want to do this analysis in a +data processing tool (such as NCL, Matlab, Mathmatica, IDL, etcetera that is able +to read and process &netcdf; data files). + + + + + +Outputting multi-layer snow history fields + +A number of history fields provide information about individual snow layers: +SNO_ABS, SNO_T, SNO_GS, +SNO_Z, SNO_LIQH2O, +SNO_ICE, SNO_TK, and +SNO_BW; there is also an auxiliary field to aid +interpretation: SNO_EXISTENCE (described below). These fields +are inactive by default, but can be enabled like other history fields. If the +maximum number of snow layers is 5 (for example), then the layers of these +fields are arranged on the history file so that layer 5 is closest to the +ground, and layer 1 only exists if the snow is deep enough to support all +layers. + + +Because snow layers can come into and out of existence, these fields can be +challenging to interpret. It is easiest to analyze these fields if you do output +every time step, and do not average to the grid cell (i.e., dov2xy = +.false.). Otherwise, a few principles should be kept in mind when +working with these fields: + +Temporal averages are taken only over times when a given snow layer exists +Grid cell averages are taken only over columns in which a given snow layer exists +SNO_EXISTENCE gives the fraction of the averaging +period in which a given snow layer existed. For grid cell averages, this gives +the weighted spatial fraction of the columns in which a snow layer existed for +this averaging period. This is most useful for subsetting grid cells for +analysis. For example, grid cells that have SNO_EXISTENCE = 1 +for all snow layers can be analyzed most easily. + + + +Here is a simple example illustrating this averaging; this considers a given +snow layer, L: + + +Assume a grid cell with 2 columns, with averaging done over 4 time steps. Column +#1 has subgrid weight 0.2, and no snow in layer L in any time +step. Column #2 has subgrid weight 0.8, and has snow in layer +L in time steps 3 and 4; the snow field of interest has +values 1.0 and 2.0 in these two time steps, for this layer. + + +SNO_EXISTENCE is then 0.8*(2/4) = 0.4. The snow field's value +would be 1.5 (note that times and columns with no snow in this layer are simply +ignored). + + +Finally, note that the SNOABS field is not computed for urban +columns, so it will have a missing value if snow only exists over urban columns +for a given snow layer. + + + + +Conclusion to namelist examples + +We've given various examples of namelists that feature the use of different namelist options +to customize a case for particular uses. Most the examples revolve around how to customize the +output history fields. This should give you a good basis for setting up your own &clm; namelist. + + + + + + + + + +Customizing the &datm; Namelist and Streams files + +When running "I" compsets with &clm; you use the &datm; model to give atmospheric +forcing data to &clm;. There are four ways to customize &datm;: + + +&datm; Main Namelist (datm_in) + + +&datm; Stream Namelist (datm_atm_in) + + +&datm; stream files + + +&datm; template file +(Tools/Templates.datm.cpl7.template) + + +The +Data Model Documentation gives the details of all the options for the data +models and for &datm; specifically. It goes into detail on all namelist items both for +&datm; +and for &datm; streams. It shows examples of stream files and talks about their use. In + we talk about editing the CLM and &datm; +template files. So here we won't talk about the &datm; template file, and we won't list +ALL of the &datm; namelist options, nor go into great details about stream files. But, +we will talk about a few of the different options that are relevant for running with +&clm;. All of the options for changing the namelists or stream files is done by editing +the Buildconf/datm.buildnml.csh file. + + +Because, they aren't useful for work with &clm; we will NOT discuss any of the options +for the main &datm; namelist. Use the &datm; Users Guide at the link above to find +details of that. For the streams namelist we will discuss three items: + + +mapalgo + + +taxmode + + +tintalgo + + +And for the streams file itself we will discuss: + + offset + +Again everything else (and including the above items) are discussed in the Data Model +User's Guide. Of the above the last three: offset, taxmode and tintalgo are all closely +related and have to do with the time interpolation of the &datm; data. + + + + +mapalgo + +mapalgo sets the spatial interpolation method to go from the +&datm; input data to the output &datm; model grid. The default is +bilinear. For CLM1PT we set it to nn to just +select the nearest neighbor. This saves time and we also had problems running the +interpolation for single-point mode. + + + + +taxmode + +taxmode is the time axis mode. For &clm; we usually have it +set to cycle which means that once the end of the data is reached +it will start over at the beginning. The extend modes is used +have it use the last time-step of the forcing data once it reaches the end of forcing +data (or use the first time-step before it reaches where the forcing data starts). +See the warning below about the extend mode. + + +THE extend OPTION NEEDS TO BE USED WITH CAUTION! +It is only invoked by default for the CLM1PT mode and is only intended for the +supported urban datasets to extend the data for a single time-step. If you have the +model run extensively through periods in this mode you will effectively +be repeating that last time-step over that entire period. This means the +output of your simulation will be worthless. See bug 1377 in the &KnownBugs; file for +more information on this issue. + + + + + + +offset (in the stream file) + +offset is the time offset in seconds to give to each stream +of data. Normally it is NOT used because the time-stamps for data is set correctly +for each stream of data. Note, the offset may NEED to be +adjusted depending on the taxmode described above, or it may +need to be adjusted to account for data that is time-stamped at the END of an +interval rather than the middle or beginning of interval. The +offset can is set in the stream file rather than on the +stream namelist. For data with a taxmode method of +coszen the time-stamp needs to be for the beginning of the interval, +while for other data it should be the midpoint. The offset can be +used to adjust the time-stamps to get the data to line up correctly. + + + + +tintalgo + +tintalgo is the time interpolation algorithm. For &clm; we usually +use one of three modes: coszen, nearest, or +linear. We use coszen for solar data, +nearest for precipitation data, and linear +for everything else. If your data is half-hourly or hourly, nearest +will work fine for everything. The coszen scaling is useful for +longer periods (three hours or more) to try to get the solar to match the cosine of +the solar zenith angle over that longer period of time. If you use +linear for longer intervals, the solar will cut out at night-time +anyway, and the straight line will be a poor approximation of the cosine of the +solar zenith angle of actual solar data. nearest likewise would +be bad for longer periods where it would be much higher than the actual values. + + +For coszen the time-stamps of the data should correspond to the +beginning of the interval the data is measured for. Either make sure the time-stamps +on the datafiles is set this way, or use the offset described above +to set it. + + + + +For nearest and linear the time-stamps of the +data should correspond to the middle of the interval the data is measured for. Either +make sure the time-stamps on the datafiles is set this way, or use the +offset described above to set it. + + + + + + +In the sections below we go over each of the relevant DATM_MODE +options and what the above &datm; settings are for each. This gives you examples +of actual usage for the settings. We also describe in what ways you might want +to customize them for your own case. + + + +&CLMQIAN; mode and it's &datm; settings + +In &CLMQIAN; mode the Qian dataset is used which has 6-hourly +solar and precipitation data, and 3-hourly for everything else. +The dataset is divided into those three data streams: solar, precipitation, +and everything else (temperature, pressure, humidity and wind). The time-stamps +of the data were also adjusted so that they are the beginning of the interval +for solar, and the middle for the other two. Because, of this the +offset is set to zero, and the tintalgo +is: coszen, nearest, and +linear for the solar, precipitation and other data +respectively. taxmode is set to cycle +and mapalgo is set to bilinear so that +the data is spatially interpolated from the input T62 grid to the grid the atmosphere +model is being run at. + + +Normally you wouldn't customize the &CLMQIAN; settings, but you might replicate +it's use for your own global data that had similar temporal characteristics. + + + + +CLM1PT mode and it's &datm; settings + +In CLM1PT mode the model is assumed to have half-hourly or hourly data +for a single-point. For the supported datasets that is exactly what it has. +But, if you add your own data you may need to make adjustments accordingly. +Using the &CLMUSRDAT; option you can easily extend this mode for your own +datasets that may be regional or even global and could be at different temporal +frequencies. If you do so you'll need to make adjustments to your &datm; settings. +The dataset has all data in a single stream file. The time-stamps +of the data were also adjusted so that they are at the middle of the interval. +Because, of this the offset is set to zero, and the +tintalgo is set to nearest. +taxmode is set to extend +and mapalgo is set to nn so that +simply the nearest point is used. + + +If you are using your own data for this mode and it's not at least hourly +you'll want to adjust the &datm; settings for it. If the data is three or +six hourly, you'll need to divide it up into separate streams like in +&CLMQIAN; mode which will require fairly extensive changes to the &datm; +namelist and streams files. For an example of doing this see +. + + + + +&CPLHIST; mode and it's &datm; settings + +In &CPLHIST; mode the model is assumed to have 3-hourly for a global grid from +a previous &cesm; simulation. Like &CLMQIAN; mode the data is divided into +three streams: one for precipitation, one for solar, and one for everything else. +The time-stamps for Coupler history files for &cesm; is at the end of the interval, +so the offset needs to be set in order to adjust the time-stamps to what it needs +to be for the tintalgo settings. For precipitation +taxmode is set to nearest so the +offset is set to -5400 seconds so that +the ending time-step is adjusted by an hour and half to the middle of the interval. +For solar taxmode is set to coszen so the +offset is set to -10800 seconds so that +the ending time-step is adjust by three hours to the beginning of the interval. +For everything else taxmode is set to +linear so the offset is set to +-5400 seconds so that the ending time-step is adjusted by an +hour and half to the middle of the interval. + + +Normally you wouldn't modify the &datm; settings for this mode. However, if you +had data at a different frequency than 3-hours you would need to modify the +offset and possibly the taxmode. The other +two things that you might modify would be the path to the data (which you can +change in the &datm; template see ) or +the domain file for the resolution (which is currently hardwired to f09). For +data at a different input resolution you would need to change the domain file +in the streams file to use a domain file to the resolution that the data comes in +on. + + + + + + + +Conclusion to customizing chapter + +We've given extensive details on customizing cases with &clm;, by choosing compsets, by changing +&configure; options and interacting with the &clm; "&configure;" and "&buildnml;" scripts, +we've given details on all of the &clm; namelist items, and finally given some +instruction in customizing the &datm; namelist and streams files. In the next chapter we talk +about further ways to customize cases with &clm; by creating your own datasets using the tools +provided in &clm;. + + + + diff --git a/components/clm/doc/UsersGuide/get_Icaselist.pl b/components/clm/doc/UsersGuide/get_Icaselist.pl new file mode 100755 index 0000000000..6aefc26159 --- /dev/null +++ b/components/clm/doc/UsersGuide/get_Icaselist.pl @@ -0,0 +1,136 @@ +#!/usr/bin/env perl +#----------------------------------------------------------------------------------------------- +# +# get_Icaselist.pl +# +# This utility gets a list of the I cases from the CCSM compset database. +# +#----------------------------------------------------------------------------------------------- + +use strict; +use Cwd; +use English; +use Getopt::Long; +use IO::File; +use IO::Handle; +#----------------------------------------------------------------------------------------------- + +sub usage { + die <autoflush(); + +#----------------------------------------------------------------------------------------------- +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +$cfgdir = $cwd; + +#----------------------------------------------------------------------------------------------- +# Parse command-line options. +my %opts = ( + ); +GetOptions( + "h|help" => \$opts{'help'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; + +# Check for unparsed argumentss +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +# Check for manditory case input if not just listing valid values + +my %cfg = (); # build configuration + +#----------------------------------------------------------------------------------------------- + +# Check for the configuration definition file. +my $config_def_file = "config_definition.xml"; +my $case_def_dir = "$cfgdir/../../../../../scripts/ccsm_utils/Case.template"; +(-f "$case_def_dir/$config_def_file") or die <<"EOF"; +** Cannot find configuration definition file \"$config_def_file\" in directory + \"$case_def_dir\" ** +EOF + +# Compset definition file. +my $compset_file = 'config_compsets.xml'; +(-f "$case_def_dir/$compset_file") or die <<"EOF"; +** Cannot find compset parameters file \"$compset_file\" in directory + \"$case_def_dir\" ** +EOF + +my $xml_dir = "$cfgdir/../../../../../scripts/ccsm_utils/Tools/perl5lib"; +# The XML::Lite module is required to parse the XML configuration files. +(-f "$xml_dir/XML/Lite.pm") or die <<"EOF"; +** Cannot find perl module \"XML/Lite.pm\" in directory + \"$xml_dir\" ** +EOF + + +#----------------------------------------------------------------------------------------------- +my @dirs = ( $cfgdir, $xml_dir, $case_def_dir ); +unshift @INC, @dirs; +require XML::Lite; +require ConfigCase; + +#----------------------------------------------------------------------------------------------- +my $cfg_ref = ConfigCase->new("$case_def_dir/$config_def_file"); +print_compsets( "$case_def_dir/$compset_file" ); + +#----------------------------------------------------------------------------------------------- +# FINNISHED #################################################################################### +#----------------------------------------------------------------------------------------------- + +#------------------------------------------------------------------------------- + +sub print_compsets +{ + # Print all currently supported valid compsets + + my ($compset_file) = @_; + my $xml = XML::Lite->new( $compset_file ); + my $root = $xml->root_element(); + + # Check for valid root node + my $name = $root->get_name(); + $name eq "config_compset" or die + "file $compset_file is not a compset parameters file\n"; + + # Read the compset parameters from $compset_file. + my @e = $xml->elements_by_name( "compset" ); + my %a = (); + my %data; + while ( my $e = shift @e ) { + %a = $e->get_attributes(); + my $sname = $a{'SHORTNAME'}; + if ($a{GRID_MATCH} && exists($data{$sname}) && defined($data{$sname}{'DESC'} && defined($a{'DESC'}) ) ) { + if ( $data{$sname}{'DESC'} =~ /^INVALID:/ ) { + $data{$sname}{'DESC'} = $a{'DESC'}; + } + } elsif ( $a{'SHORTNAME'} =~ /^I/ ) { + $data{$sname}{'NAME'} = $a{'NAME'}; + $data{$sname}{'DESC'} = $a{'DESC'}; + } + } + print "\n"; + foreach my $sname ( sort(keys(%data)) ) { + print "$data{$sname}{'NAME'}" . + "($sname)\n"; + print "$data{$sname}{'DESC'}\n"; + } + print "\n"; +} + diff --git a/components/clm/doc/UsersGuide/limitLineLen.pl b/components/clm/doc/UsersGuide/limitLineLen.pl new file mode 100755 index 0000000000..25f1216d06 --- /dev/null +++ b/components/clm/doc/UsersGuide/limitLineLen.pl @@ -0,0 +1,104 @@ +#!/usr/bin/env perl +# +# Limit the line length for output designed to go into the document. +# +use strict; +use Cwd; +use English; +use IO::File; +use Getopt::Long; +use IO::Handle; +#----------------------------------------------------------------------------------------------- + +# Get the directory name and filename of this script. If the command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script + # is in + # the user's PATH +my $nm = "$ProgName::"; # name to use if script dies +my $scrdir; +if ($ProgDir) { + $scrdir = $ProgDir; +} else { + $scrdir = getcwd() +} +my $limitLen = 99; + +sub usage { + my $msg = shift; + + print "ERROR:: $msg\n"; + die < +OPTIONS + -l = Limit line length to this value (default $limitLen) +EOF +} + +sub LengthofwhiteSpaceNearLength { + my $line = shift; + my $leng = shift; + + my $l = $leng; + while( substr( $line, $l, 1 ) !~ /\s|:|,|\// ) { + # First search for white-space before desired length -- and then after + if ( $l <= $leng ) { + $l--; + } else { + $l++; + } + # Once reach beginning of line, go to the desired length+1 and increment + if ( $l < 0 ) { $l = $leng+1; } + # Once reach the very end of the line die as couldn't break it + if ( $l >= length($line) ) { + die "ERROR : went through entire line and did NOT find a place to break it\n"; + } + } + return( $l ); +} + +my %opts = ( limitLen => $limitLen ); + +GetOptions( + "l=s" => \$opts{'limitLen'}, +) or usage(); + +if ( $#ARGV != 0 ) { + &usage( "Wrong number of command line arguments" ); +} + +$limitLen = $opts{'limitLen'}; + +my $inputFile = $ARGV[0]; + +if ( ! -f $inputFile ) { + &usage( "Input file does NOT exist : $inputFile" ); +} + +my $fh = IO::File->new($inputFile, '<') or die "** $nm - can't open input file: $inputFile\n"; + +while (my $line = <$fh>) { + + while( length($line) > $limitLen ) { + print STDERR "Line length over $limitLen\n"; + my $lenlim = &LengthofwhiteSpaceNearLength( $line, $limitLen ); + if ( ($lenlim == length($line)) || $lenlim < 0 ) { + print "Can NOT truncate long line: $line\n"; + die "ERROR : Having trouble breaking a long line\n"; + } + my $substring = substr( $line, 0, $lenlim+1 ); + print "$substring \\ \n"; + my $newline = " " . substr( $line, $lenlim+1, length($line) ); + $line = $newline; + } + print $line; + +} +$fh->close; + + diff --git a/components/clm/doc/UsersGuide/modelnl/Makefile b/components/clm/doc/UsersGuide/modelnl/Makefile new file mode 100644 index 0000000000..595a1b3a3e --- /dev/null +++ b/components/clm/doc/UsersGuide/modelnl/Makefile @@ -0,0 +1,85 @@ +# +# Makefile to create HTML documentation of namelists +# +SCRNLDIR := ../../../../../../scripts/doc/modelnl +VPATH := . $(SCRNLDIR) ../../../../../drv/bld/namelist_files ../../../../../glc/cism/bld/namelist_files \ + ../../../../../atm/datm/bld/namelist_files ../../../../../../scripts/ccsm_utils/Case.template \ + ../../../../../../scripts/ccsm_utils/Machines ../../../../../rof/rtm/bld/namelist_files \ + ../../../bld/namelist_files ../.. +SOURCES := namelist_definition_drv.xml namelist_definition_cism.xml namelist_definition.xml \ + namelist_definition_rtm.xm namelist_definition_datm.xml config_definition.xml \ + config_grid.xml config_machines.xml config_compsets.xml ChangeSum +TAGFILE := clmtag.txt + +CWD := $(shell pwd ) +ALLOUT := $(CWD)/clm_nl_drv.html $(CWD)/clm_nl_cism.html $(CWD)/clm_nl_clm.html $(CWD)/clm_nl_rtm.html \ + $(CWD)/clm_nl_datm.html $(CWD)/clm_env_case.html $(CWD)/clm_env_build.html $(CWD)/clm_env_pesetup.html \ + $(CWD)/clm_env_run.html $(CWD)/clm_grid.html $(CWD)/clm_machines.html $(CWD)/clm_compsets.html \ + $(TAGFILE) $(CWD)/index.html + +all: $(ALLOUT) + +debug: + @echo "SOURCES = $(SOURCES)" + @echo "VPATH = $(VPATH)" + @echo "ALLOUT = $(ALLOUT)" + @echo "SCRNLDIR = $(SCRNLDIR)" + @echo "CWD = $(CWD)" + @echo "TAGFILE = $(TAGFILE)" + +.SUFFIXES: +.SUFFIXES: .xml .html .txt + +RM := /bin/rm + +CTAGNAME = $(shell cat $(TAGFILE) ) + + +$(TAGFILE): ChangeSum + head -3 $< | tail -1 | awk '{print $$1}' > $@ + +$(CWD)/index.html: $(TAGFILE) index.cpp + sed 's/CLMTAGNAME/$(CTAGNAME)/' index.cpp > $@ + +$(CWD)/clm_nl_drv.html: namelist_definition_drv.xml + cd $(SCRNLDIR) ; ./nldef2html_drv > $@ + +$(CWD)/clm_nl_cism.html: namelist_definition_cism.xml + cd $(SCRNLDIR) ; ./nldef2html_cism > $@ + +$(CWD)/clm_nl_clm.html: namelist_definition.xml + cd $(SCRNLDIR) ; ./nldef2html_clm > $@ + +$(CWD)/clm_nl_rtm.html: namelist_definition_rtm.xml + cd $(SCRNLDIR) ; ./nldef2html_rtm > $@ + +$(CWD)/clm_nl_datm.html: namelist_definition_datm.xml + cd $(SCRNLDIR) ; ./nldef2html_datm > $@ + +$(CWD)/clm_env_case.html: config_definition.xml + cd $(SCRNLDIR) ; ./xmldef2html_env_case > $@ + +$(CWD)/clm_env_build.html: config_definition.xml + cd $(SCRNLDIR) ; ./xmldef2html_env_build > $@ + +$(CWD)/clm_env_pesetup.html: config_definition.xml + cd $(SCRNLDIR) ; ./xmldef2html_env_pesetup > $@ + +$(CWD)/clm_env_run.html: config_definition.xml + cd $(SCRNLDIR) ; ./xmldef2html_env_run > $@ + +$(CWD)/clm_grid.html: config_grid.xml + cd $(SCRNLDIR) ; ./xmldef2html_grid > $@ + +$(CWD)/clm_machines.html: config_machines.xml + cd $(SCRNLDIR) ; ./xmldef2html_machines > $@ + +$(CWD)/clm_compsets.html: config_compsets.xml + cd $(SCRNLDIR) ; ./xmldef2html_compsets > $@ + +clean: + $(RM) -f $(ALLOUT) + +realclean: clean + $(RM) -f $(TAGFILE) + diff --git a/components/clm/doc/UsersGuide/modelnl/index.cpp b/components/clm/doc/UsersGuide/modelnl/index.cpp new file mode 100644 index 0000000000..c55aa64159 --- /dev/null +++ b/components/clm/doc/UsersGuide/modelnl/index.cpp @@ -0,0 +1,45 @@ + + + + + +CLM Namelist Definitions (CLMTAGNAME) + + + + + + +
+ + +

CLM Tag: CLMTAGNAME

+ +

Component Namelist Definitions

+ + +

create_newcase files (supported machines, grids, compsets)

+ + +

$CASEROOT xml files

+ + + + + + diff --git a/components/clm/doc/UsersGuide/modelnl/showinfo.js b/components/clm/doc/UsersGuide/modelnl/showinfo.js new file mode 100644 index 0000000000..fd8a608472 --- /dev/null +++ b/components/clm/doc/UsersGuide/modelnl/showinfo.js @@ -0,0 +1,193 @@ + function applyFilter(filter_text) { + + // applying a filter hides all standard names not matching filter_text + // if filter_text contains no spaces, it is treated as a regexp + // otherwise, all substrings must occur somewhere + + var is_match = false; + var search_type = 'regexp'; + var search_help_text = false; + var num_matches = 0; + var is_boolean_and = true; + + search_help_text = (document.getElementById('search_help_text').checked); + is_boolean_and = (document.getElementById('logical_operator_and').checked); + + if (filter_text.indexOf(' ') == -1) { + search_type = 'regexp'; + var re = new RegExp(filter_text, 'i') + } + else { + search_type = 'string'; + var string_parts = filter_text.split(' '); + } + + allTRs = document.getElementsByTagName('tr'); + + for (var i = 0; i < allTRs.length; i++) { + curTR = allTRs[i]; + + if (curTR.id != '') { + + if (search_type == 'regexp') { + + is_match = curTR.id.substring(0, curTR.id.length - 3).match(re); + + if (search_help_text) { + + var helpText = document.getElementById(curTR.id.substring(0,curTR.id.length - 3) + '_help').innerHTML; + is_match = is_match || helpText.match(re); + } + } + else { + + if (is_boolean_and) { + var is_name_match = true; + for (var j = 0; j < string_parts.length && is_name_match; j++) { + + if (!curTR.id.match(new RegExp(string_parts[j], 'i'))) { + is_name_match = false; + } + } + } + else { + + var is_name_match = false; + for (var j = 0; j < string_parts.length && !is_name_match; j++) { + + if (curTR.id.substring(0, curTR.id.length - 3).match(new RegExp(string_parts[j], 'i'))) { + is_name_match = true; + } + } + } + + is_match = is_name_match; + + if (search_help_text) { + var helpText = document.getElementById(curTR.id.substring(0,curTR.id.length - 3) + '_help').innerHTML; + + if (is_boolean_and) { + var is_help_match = true; + + for (var j = 0; j < string_parts.length && is_help_match; j++) { + + if (!helpText.match(new RegExp(string_parts[j], 'i'))) { + is_help_match = false; + } + } + } + else { + + var is_help_match = false; + + for (var j = 0; j < string_parts.length && !is_help_match; j++) { + + if (helpText.match(new RegExp(string_parts[j], 'i'))) { + is_help_match = true; + } + } + } + + is_match = is_match || is_help_match; + + } + } + + if (!is_match) { + curTR.style.display = 'none'; + } + else { + num_matches++; + curTR.style.display = ''; + if (search_help_text) { + showHelp(curTR.id.substring(0,curTR.id.length - 3)); + } + else { + hideHelp(curTR.id.substring(0,curTR.id.length - 3)); + } + } + } + } + + var filter_matches = document.getElementById('filter_matches'); + var filter_matches_num = document.getElementById('filter_matches_num'); + var filter_matches_query = document.getElementById('filter_matches_query'); + + if (filter_text != '') { + filter_matches.style.visibility = 'visible'; + filter_matches_num.innerHTML = num_matches; + filter_matches_query.innerHTML = filter_text; + } + else { + filter_matches.style.visibility = 'hidden'; + } + + } // end function applyFilter() + + function clearFilter() { + + allTRs = document.getElementsByTagName('tr'); + + for (var i = 0; i < allTRs.length; i++) { + curTR = allTRs[i]; + if (curTR.id != '') { + curTR.style.display = ''; + hideHelp(curTR.id.substring(0,curTR.id.length - 3)); + + } + } + + var filter_matches = document.getElementById('filter_matches'); + filter_matches.style.visibility = 'hidden'; + + document.getElementById('filter_text').value = ''; + } + + function toggleHelp(standard_name) { + + // check for the existence of the help "tr" object for this standard_name + + var helpDiv = document.getElementById(standard_name + '_help'); + + if (helpDiv) { + + if (helpDiv.style.display != 'none') { + + helpDiv.style.display = 'none'; + + curArrow = document.getElementById(standard_name + '_arrow'); + curArrow.src = "./images/arrow_right.gif"; + } + else { + helpDiv.style.display = ''; + + curArrow = document.getElementById(standard_name + '_arrow'); + curArrow.src = "./images/arrow_down.gif"; + } + } + } + + + function showHelp(standard_name) { + + var helpDiv = document.getElementById(standard_name + '_help'); + + if (helpDiv) { + + helpDiv.style.display = ''; + curArrow = document.getElementById(standard_name + '_arrow'); + curArrow.src = "./images/arrow_down.gif"; + } + } + + function hideHelp(standard_name) { + + var helpDiv = document.getElementById(standard_name + '_help'); + + if (helpDiv) { + helpDiv.style.display = 'none'; + curArrow = document.getElementById(standard_name + '_arrow'); + curArrow.src = "./images/arrow_right.gif"; + } + } + diff --git a/components/clm/doc/UsersGuide/modelnl/xmldef2html_compsets b/components/clm/doc/UsersGuide/modelnl/xmldef2html_compsets new file mode 100755 index 0000000000..2659beed17 --- /dev/null +++ b/components/clm/doc/UsersGuide/modelnl/xmldef2html_compsets @@ -0,0 +1,162 @@ +#!/usr/bin/env perl + +use strict; + +if ( $#ARGV != 0 ) { + die "Wrong number of input arguments -- should just enter one filename\n"; +} +my $infilename = $ARGV[0]; +if ( ! -f $infilename ) { + die "Input file: $infilename does NOT exist\n"; +} + +my @dirs = ('../../../../../../scripts/ccsm_utils/Tools/per5lib', '../../../../../../scripts//ccsm_utils/Tools/perl5lib/Build'); +unshift @INC, @dirs; +require XML::Lite; +use lib "../../../../../../scripts/ccsm_utils/Tools/perl5lib"; + +my $image_dir = "./images"; + +print <<"END_of_Start"; + + + + + + + CESM Component Models Namelist Definitions + + + + + + +

Search or Browse supported component sets

+

+This page contains the complete list of config_grid.xml variables available. They are grouped +by categories designed to aid browsing. Clicking on the name of a variable will display descriptive +information. If search terms are entered in the text box below, the list will be condensed to contain +only matched variables. +

+ +
+ + + + + + +
+ + + +
+ + + (separate search terms with spaces) +
+ +
+
+ + + +END_of_Start + +my $xml = XML::Lite->new( $infilename ); +my $root = $xml->root_element(); + +# Check for valid root node +my $name = $root->get_name(); +$name eq "config_compset" or die + "file $infilename is not a compset definition file\n"; + +# Print table +print_start_table("config_compsets.xml variables"); +my @e = $xml->elements_by_name( "compset" ); +my %a = (); +while ( my $e = shift @e ) { + %a = $e->get_attributes(); + + if ($a{'NAME'} =~ /I_/ ) { + my $var = $a{'NAME'}; + my $doc = "Description: $a{DESC} \n"; + my $grp = "$a{SHORTNAME}"; + print_row($var, $doc, $grp); + } +} +print_end_table(); + +# Finish +print <<"END_of_html"; + + +END_of_html + +#-------------------------------------------------------------------------------------------- + +sub print_start_table { + my $hdr = shift; + +print <<"START_table"; +

$hdr

+ + + +START_table +} + +#-------------------------------------------------------------------------------------------- + +sub print_row { + + my $name = shift; + my $doc = shift; + my $grp = shift; + +print <<"END_of_row"; + + + + +END_of_row +} + +#-------------------------------------------------------------------------------------------- + +sub print_end_table { + +print <<"END_table"; +
Compset NameShort Name
+ + + $name + + + $grp
+END_table +} + +#-------------------------------------------------------------------------------------------- + diff --git a/components/clm/doc/UsersGuide/pergro.jpg b/components/clm/doc/UsersGuide/pergro.jpg new file mode 100644 index 0000000000..a0cb81e046 Binary files /dev/null and b/components/clm/doc/UsersGuide/pergro.jpg differ diff --git a/components/clm/doc/UsersGuide/preface.xml b/components/clm/doc/UsersGuide/preface.xml new file mode 100644 index 0000000000..75cb0df4f4 --- /dev/null +++ b/components/clm/doc/UsersGuide/preface.xml @@ -0,0 +1,1426 @@ + + + +$Id: preface.xml 46394 2013-04-25 22:24:18Z erik $ + +Acknowledgments + +I want to acknowledge all of the people that helped review or edit the model +documentation: David Lawrence, Samuel Levis, Keith Oleson, and Sean Swenson. +Thank you for your help in catching errors, and making the document more +understandable and readable. Our readers thank you as well, as now it is much +easier for them to digest. Any mistakes, or errors are all mine. If you run +across one of those errors, please let us know, by following +. +I also want to thank Sheri +Mickelson, for her work in doing perturbation analysis on bluefire and intrepid, +which was used in our initial versions of this User's Guide. We also want to +thank the original authors of &ptclm;: Daniel M. Ricciuto, Dali Wang, Peter E. Thornton, +Wilfred M. Post, and R. Quinn Thomas for providing a nice addition to the &cesm; +effort. We also want to thank the folks at University of Michigan Biological Stations +(US-UMB) who allowed us to use their Fluxnet station data and import it into our +inputdata repository, especially Gil Bohrer the PI on record for this site +(see for permission information on using this +data). + + + + +Introduction + + +The Community Land Model (&clmrel;) is the latest in a series of +global land models developed by the &cesm; Land Model Working Group +(LMWG) and maintained at the National Center for +Atmospheric Research (&ncar;). This guide is intended to instruct both +the novice and experienced user on running &clm;. This guide pertains to the +latest version &clmrel; available for download from the public release +subversion repository as a part of &cesmrel;. Documentation may be different if you are using an +older version, you should either update to the latest version, or use the +documentation inside your own source tree. There is information in the +ChangeLog file and in the +regarding the changes from previous versions of &cesm;. + + + +The novice user should read + in detail before beginning work, while the +expert user should read and + chapters, and then use the more detailed +chapters as reference. Before novice users go onto more technical problems covered +in , , , or they +should know the material covered in and be able +to replicate some of the examples given there. + + +All users should read the + +and sections to understand the document conventions +and the various ways of getting help on using &clm4;. Users should also read +the section to see if their planned use of the +model is something that has been scientifically validated and well tested. Users +that are NOT using &ncar; machines or our list of well tested machines should also +read the section to make sure they have +all the required UNIX utilities on the system they want to do their work. + + + + + +Introduction to the &clm4; User's Guide +What is in here anyway? + + +Here in the introduction we first give a simple guide to understand the document +conventions in . The next section +describes the differences between &clmrel; and &clm40; (for each &cesm; release version +up to &cesmrel;) as well as between +&clm40; and &clm35;, both from a scientific +as well as a software engineering point of view. It also talks about differences in the +configuration, namelist, and history fields. The next section +is for users that are already experts in using &clm; and gives a quickstart guide to the +bare details on how to use &clm4;. The next tells +you about what has been extensively tested and scientifically validated (and maybe more +importantly) what has NOT. lists the UNIX utilities +required to use &clm4; and is important if you are running on non-&ncar; machines, generic +local machines, or machines NOT as well tested by us at &ncar;. Next we +have to detail some of the best practices for using +&clm4; for science. The last introductory section is which lists +different resources for getting help with &cesm1; and &clm4;. + + + + goes into detail on how to setup and run simulations with +&clm4; and especially how to customize cases. Details of &configure; +modes and &buildnml; options as well as namelist options are given in this chapter. + + + + gives instructions on the &clm4; tools for creating input datasets +for use by &clm;, for the expert user. There's an overview of what each tool does, and some general notes on how to build +the FORTRAN tools. Then each tool is described in detail along with different ways in +which the tool might be used. +A final section +on how to customize datasets for observational sites for very savvy expert users is given as the last section of this chapter. + + + +As a followup to the tools chapter, tells how to add files to the +XML database for &buildnml; to use. This is important if you want to use the XML database to automatically select +user-created input files that you have created when you setup new cases with &clm;. + + + +In , again for the expert user, we give details on how to do some particularly +difficult special cases. For example, we give the protocol for spinning up both the &clmcn; model and &clm; with dynamic +vegetation active (CNDV). We give instructions to do a spinup case +from a previous case with Coupler history output for atmospheric forcing. We also give +instructions on running the prognostic crop model and its irrigation option. We also review +how to validate a port to a new machine using the Perturbation error +growth technique. Lastly we tell the user how to use the DATM model to send historical &CO2; data to &clm;. + + + + outlines how to do single-point or +regional simulations using &clm4;. +This is useful to either compare &clm; simulations with point observational stations, +such as tower sites (which might include your own atmospheric forcing), or +to do quick simulations with &clm; for example to test a new parameterization. There are +several different ways given on how to perform +single-point simulations which range from simple &PTSMODE; to more complex where you create all your own datasets, tying into + and also to add the +files into the &buildnml; XML database. After this chapter + chapter outlines how to use the &ptclm; python script to +help you run single-point simulations. + + + +Finally, gives some guidance on trouble-shooting +problems when using &clm4;. It doesn't cover all possible problems with &clm;, but gives +you some guidelines for things that can be done for some common problems. + + + +In the appendices we talk about some issues that are useful for advanced users and +developers of &clm;. +In we give some basic background to the &clm; +developer on how to edit the models/lnd/clm/bld/clm.cpl7.template. +This is a very difficult exercise and we don't recommend it for any, but the most +advanced users of &clm; who are also experts in UNIX and UNIX scripting. + + +In we go over how to run the script +runinit_ibm.csh" that will interpolate standard resolution +initial condition dataset to several other resolutions at once. It also runs &clm; +to create template files as well as doing the interpolation using +interpinic. In general this is only something that a developer +would want to do. Most users will only want to interpolate for a few specific +resolutions. + + +In we go over the automated testing scripts for +validating that the &clm; is working correctly. The test scripts run many different +configurations and options with &clm; making sure that they work, as well as doing +automated testing to verify restarts are working correctly, and testing at many +different resolutions. In general this is an activity important only for a developer +of &clm;, but could also be used by users who are doing extensive code modifications +and want to ensure that the model continues to work correctly. + + +Finally in we give instructions on how to build +the documentation associated with &clm; (i.e. how to build this document). This +document is included in every &clm; distribution and can be built so that you can +view a local copy rather than having to go to the &cesm; website. This also could +be useful for developers who need to update the documentation due to changes they +have made. + + + + + + + + + +Important Notes and Best Practices for Usage of &clm4; + + + +When running with CN, it is critical to begin with initial conditions +hat are provided with the release or to spin the model up following the CN spinup +procedure before conducting scientific runs (see . +Simulations without a proper spinup will effectively be starting from an unvegetated +world. See for information on how to +provide initial conditions for your simulation. + + +Initial condition files are provided for fully coupled BCN and offline +ICN cases for 1850 and 2000 at 1deg, 2deg, and T31 resolutions. There's also an +initial condition file for ICN with the prognostic crop model for 2000 at 2deg +resolution, and one with &clmsp; for 2000 at 2deg resolution. We also have initial +conditions for offline CNDV for 1850. And there are interpolated datasets for 4x5 and +10x15 resolution for 1850. The 1850 initial condition +files are in 'reasonable' equilibrium. The 2000 initial condition files represent +the model state for the year 2000, and have been taken from transient simulations. +Therefore, by design the year 2000 initial condition files do not represent an +equilibrium state. Note also that spinning the 2000 initial conditions out to +equilibrium will not reflect the best estimate of the real carbon/nitrogen state +for the year 2000. + + +Users can generate initial condition files at different resolutions by +using the &clm; tool interpinic to interpolate from one of the +provided resolutions to the resolution of interest. Interpolated initial condition +files may no longer be in 'reasonable' equilibrium. + + +Aerosol deposition is a required field to &clm4; sent from the +atmosphere model. Simulations without aerosol deposition will exhibit unreasonably +high snow albedos. The model sends aerosol deposition from the atmospheric model (either +CAM or &datm;). When running with prescribed aerosol the atmosphere +model will interpolate the aerosols from 2-degree resolution to the resolution the +atmosphere model is running at. + + + + + + + + + + + + + $EDITOR + + + +How to Use This Document +Conventions used in the document for code and commands + + +This section provides the details in using &clm; with the &cesm; modeling +system. Links to descriptions and definitions have been provided in the code below. +We use the same conventions used in the &cesm; documentation as outlined below. + + + +Throughout the document this style is used to indicate shell +commands and options, fragments of code, namelist variables, etc. +Where examples from an interactive shell session are presented, lines +starting with > indicate the shell prompt. A backslash "\" at the end +of a line means the line continues onto the next one (as it does in +standard UNIX shell). Note that $EDITOR" is used to refer to the +text editor of your choice. $EDITOR is a standard UNIX environment +variable and should be set on most UNIX systems. Comment lines are +signaled with a "#" sign, which is the standard UNIX comment sign as well. +$CSMDATA is used to denote the path to the inputdata directory for +your &cesm; data. + +> This is a shell prompt with commands \ +that continues to the following line. +> $EDITOR filename # means you are using a text editor to edit "filename" +# This is a comment line + + + + + + + + + + + &clmcn; + &clmsp; + + +What is new with &clmrel; since previous public releases? + +In this section we list the updates that have occurred to &clm4; since previous +public releases. In the first sections we describe changes in &clmrel; since the &ccsm4; release, +and in the last one we describe changes from &clm35; to &clm40; release. Note, that +the changes in the last section do NOT include the more recent changes given in the +first section, but only list the changes from &clm35; to the &clm40; release that +was part of the &ccsm4; public release. We will describe both the +changes in the science in the model as the software engineering changes. Software +engineering changes includes the configure and namelist changes, as well as the new +history fields. + + +What is new with &clmrel; since the December 8th, 2010 &cesm102; release? + + + +What is new with &clmrel; Science since &clmcesm102;? + +A prognostic crop model option was added in (based on Agro-IBIS) from work by +Samuel Levis. The crop model adds in four new vegetation types for: soybean, +winter and spring temperate cereals, and corn on their own separate columns. Winter +cereal was added as a PFT type, but doesn't exist in the input datasets, only +spring cereal is used. Winter cereal also has NOT been scientifically validated +or tested. The model manages these by modeling both planting and harvesting. See for an example of running with it. + + +An irrigation model was added from work by Samuel Levis and Bill Sacks. This +model takes water from runoff and adds it to the crop pfts for areas equipped +for irrigation. See for an example of running with it. +Please note that the irrigation model only works with the crop model active. + + + + +What is new with &clmrel; Software since &clmcesm102;? + +Since &clmcesm102; all Input/Output uses &pio; (Parallel Input/Output package). +Restart history files are now &netcdf;. Input and output files can be read/written +in parallel using PIO. We removed a list of old CPP defines and removed the +old misc/preproc.h files. Also a new tool for working with single-point sites was +added into the &cesm; scripts the Python tool &ptclm;. We have a complete chapter on it's use. + + +New configuration options: + +-crop +-noio + + + +Configuration options removed: + +-dust +-progsslt + + + +New build-namelist options: + +-co2_ppmv +-rtm_res +-rtm_tstep + + + +New precedence for build-namelist options is... + +Values set on the command-line using the -namelist option +(&CLMNAMELIST;). +Values read from the file specified by -infile (&usernlclm; file). +Datasets from the -clm_usr_name option (&CLMUSRDAT;). +Values set from a use-case scenario, e.g., -use_case (&CLMUSECASE;). +Values from the namelist defaults file. + + + +Namelist options renamed: + +carbon_only => suplnitro (can be set to NONE or ALL) + + + +namelist options removed: + +carbon_only => suplnitro +scaled_harvest +hist_crtinic +hist_pioflag +ncd_lowmem2d +ncd_pio_def +ncd_pio_UseRearranger +ncd_pio_UseBoxRearr +ncd_pio_SerialCDF +ncd_pio_IODOF_rootonly +ncd_pio_DebugLevel +ncd_pio_num_iotasks + + + +New history fields: + +A5TMIN 5-day running mean of min 2-m temperature +(K) +A10TMIN 10-day running mean of min 2-m temperature +(K) +GDD0 Growing degree days base 0C from planting +(ddays) +GDD8 Growing degree days base 8C from planting +(ddays) +GDD10 Growing degree days base 10C from planting +(ddays) +GDD020 Twenty year average of growing degree days base 0C from planting +(ddays) +GDD820 Twenty year average of growing degree days base 8C from planting +(ddays) +GDD1020 Twenty year average of growing degree days base 10C from planting +(ddays) +GDDPLANT Accumulated growing degree days past planting date for crop +(ddays) +GDDHARV Growing degree days (gdd) needed to harvest +(ddays) +GDDTSOI Growing degree-days from planting (top two soil layers) +(ddays) +QIRRIG water added through irrigation +(mm/s) + + + +SNOWLIQ and SNOWICE changed from average to instantaneous output. + + + + +What was new with &clm4014; (in &cesm102;) since the September 17th, 2010 &cesm101; release? + +Since, &clm4010; in the &cesm101; release there were several developments made +to &clmrel;. Several new namelist items were added +a few new history fields. There were also some updates for +running the model with single-point mode. + + +Configuration options that were renamed: + +prog_seasalt => progsslt + + + +Namelist items removed: + +prog_seasalt => progsslt + + + +What was new with &clm4014; Science since &clm4010;? + +A long simulation at the course resolution of T31 (typically used for Paleo-climate +studies) was done and an spun-up initial condition file was provided for this +resolution (also by default the namelist variable ice_runoff was +turned off for T31). Also a new surface dataset and transient land-cover dataset was +provided for half-degree resolution. + + + +What was new with &clm4014; Software since &clm4010;? + +New configuration options + +sitespf_pt + + + +sitespf_pt is used for single-point/regional mode and is set to the site-name +that will be used (see the config_definition.xml for the +list of valid options). + + +Configuration options that were renamed: + +prog_seasalt => progsslt + + + +Namelist items removed: + +faerdep +fndepdat +fndepdyn +use_ndepstream + + + +Nitrogen deposition datasets are now only entered through the +ndepdyn_nml namelist (removing fndepdat, fndepdyn, and +use_ndepstream). Aerosol deposition is now a required input from +the atmosphere model, hence faerdep is removed. + + +New history fields: + +U10 10-m wind (m/s) +U10_DUST 10-m wind for dust model (m/s) +VA atmospheric wind speed plus convective velocity (m/s) +VOLR RTM storage: LIQ (m3) +VOLR_ICE RTM storage: ICE (m3) + + + + + + +What was new with &clm4010; (in &cesm101;) since the April 1st, 2010 &ccsm4; release? + +From, &clm40; in the &ccsm4; release to &clm4010; there were several developments made +to &clm;. A glacier multiple elevation class option was added that allows the +use of &clm4; with a glacier land ice model the Community Ice Sheet Model (CISM). +A bug-fix for the snow hydrology was added. Several new namelist items were added +a few new history fields. Also the capability of reading aerosol and nitrogen +deposition from stream files at one resolution and regridded on the fly rather than +with datasets at the model resolution was added in. This was important for higher +resolutions so that large datasets do not have to be created before running the model, +nor are datasets for every resolution required. + + +What was new with &clm4010; Science since &ccsm4;? + +In general, snow layers should not be thinner than + +dzmin = wice/rhoice + wliq/rholiq + +If dz < dzmin, then the value of "void" computed in subroutine +SnowCompaction is negative, which is unphysical. This doesn't cause +problems with the compaction itself, but results in unrealistic values +of vol_ice, vol_liq, and eff_porosity in subroutine SnowWater. We can +have vol_ice = 1 and vol_liq = 0 even when liquid is present, which cuts +off the runoff (qout) from the lowest snow layer. Liquid water then +accumulates in the snow column without draining, which leads to further +problems and eventually a code crash. + + +The solution to this problem was to adjust layer thickness dz for any water+ice content +changes in excess of previous layer thickness, e.g., + +dz(c,j) = max(dz(c,j),h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice) + +at appropriate steps in the snow hydrology subroutines. + + + +Snow hydrology bug fix. +Add multiple elevation class option for glaciers so can interact with +the land ice sheet model. + + + + +What was new with &clm4010; Software since &ccsm4;? + +New configuration options + +glc_nec + + + +glc_nec can be 1,3,5, or 10 and MUST match the number on the input surface dataset +the elevation classes themselves are read from the surface dataset + + +New namelist items: + +carbon_only +create_glacier_mec_landunit +glc_dyntopo +glc_smb +ice_runoff +ndepmapalgo +scaled_harvest + + + +carbon_only = If true, and CLMCN carbon-nitrogen model is on, Nitrogen is unlimited + rather than prognosed and vegetation will be over-productive (replaces the supplemental Nitrogen #ifdef) + + + create_glacier_mec_landunit (= T when these landunits are created; F by default) + + + glc_smb (= T if passing surface mass balance to GLC; else pass PDD info; T by default) + + + glc_dyntopo (= T if &clm; topography changes dynamically; currently F) + (NOT fully implemented yet) + + +ice_runoff = If true, river runoff will be split up into liquid and ice streams, + otherwise ice runoff will be zero and all runoff directed to liquid stream + + + ndepmapalgo = Mapping method from Nitrogen deposition input file to the model + resolution (can be bilinear,nn,nnoni,nnonj,spval,copy, bilinear by default) + + +scaled_harvest = If true, harvesting will be scaled according to coefficients + determined by Johann Feddema, 2009 + + +New history fields: + +aais_area Antarctic ice area (km^2) +aais_mask Antarctic mask (unitless) +gris_area Greenland ice area (km^2) +gris_mask Greenland mask (unitless) +QICE ice growth/melt (mm/s) +QICEYR ice growth/melt (mm/s) +QTOPSOIL water input to surface (mm/s) +VOLR RTM storage: LIQ (m3) +VOLR_ICE RTM storage: ICE (m3) + + + + + + + +What was new with &clm40; since &clm35;? + + +From &clm35; to &clm40; there were advances in both the science and the software infrastructure. +There were also new configure and namelist options as well as new history fields. In this +section we will describe each of these changes in turn. + + + +What was new with &clm40; Science? + +The following aspects are changes to the science in &clm40; since &clm35;. + + +Biogeophysics and Hydrology + +Changes to &clm40; beyond &clm35; (Oleson et al., 2008a; Stockli et al., 2008) include +updates throughout the model. The hydrology scheme has been modified with a revised +numerical solution of the Richards equation (Zeng and Decker, 2009; Decker and Zeng, +2009); a revised soil evaporation parameterization that removes the soil resistance term +introduced in &clm35; and replaces it with a so-called &Bgr; formulation, as well as accounts for the role of litter and within- +canopy stability (Sakaguchi and Zeng, 2009). +&clm4; also includes a representation of the thermal and hydraulic properties of organic +soil that operates in conjunction with the mineral soil properties (Lawrence and Slater, +2008). The ground column has been extended to ~50-m depth by adding five additional +hydrologically inactive ground layers (making a total of 15 ground layers, 10 soil +layers and 5 bedrock layers; Lawrence et al., 2008). An urban landunit and associated +urban canyon model (&clmu;) has been added which permits the study of urban climate +and urban heat island effects (Oleson et al., 2008b). + + + + +Snow Model + +The snow model is significantly modified via incorporation of SNICAR (SNow and Ice Aerosol Radiation) which represents the effect of aerosol deposition (e.g. black and organic carbon and dust) on albedo, introduces a grain-size dependent snow aging parameterization, and permits vertically resolved snowpack heating (Flanner and Zender, 2005; Flanner and Zender, 2006; Flanner et al., 2007). The new snow model also includes a new density-dependent snow cover fraction parameterization (Niu and Yang, 2007), a revised snow burial fraction over short vegetation (Wang and Zeng, 2009) and corrections to snow compaction (Lawrence and Slater, 2009). + + + + +Surface Datasets + +The PFT distribution is as in Lawrence and +Chase (2007) except that a new cropping dataset is used (Ramankutty et al., 2008) and +a grass PFT restriction has been put in place to reduce a high grass PFT bias in +forested regions by replacing the herbaceous fraction with low trees rather than grass. +Grass and crop PFT optical properties have been adjusted according to values presented +in Asner et al. (1998), resulting in significantly reduced albedo biases. Soil colors +have been re-derived according to the new PFT distribution. + + + + +Biogeochemistry + +The model is extended with a carbon-nitrogen biogeochemical model (Thornton et al., 2007; +Thornton et al., 2009; Randerson et al., 2009) which is referred to as &clmcn;. CN is +based on the terrestrial biogeochemistry Biome-BGC model with prognostic carbon and +nitrogen cycle (Thornton et al., 2002; Thornton and Rosenbloom, 2005). &clmcn; is +prognostic with respect to carbon and nitrogen state variables in the vegetation, litter, +and soil organic matter. Vegetation phenology and canopy heights are also prognostic. A +detailed description of the biogeochemical component can be found in Thornton et al. +(2007). Note that &clm40; can be run with either prescribed satellite phenology +(&clmsp;) or with prognostic phenology provided by the carbon- nitrogen cycle model +(&clmcn;). Additionally, a transient land cover and land use change, including wood harvest, +capability has been introduced that enables the evaluation of the impact of historic and +future land cover and land use change on energy, water, and momentum fluxes as well as +carbon and nitrogen fluxes. The dynamic global vegetation model in &clm3; has been +revised such that the carbon dynamics (e.g. productivity, decomposition, phenology, +allocation, etc.) are controlled by CN and only the dynamic vegetation biogeography +(competition) aspect of the &clm3; DGVM is retained. +The biogenic volatile organic compounds model (BVOC) that was available in &clm3; has +been replaced with the MEGAN BVOC model (Heald et al. 2008). + + + + +Miscellaneous Changes + +Several other minor changes have been incorporated including a change to the atmospheric reference height so that it is the height above zo+d for all surface types. The convergence of +canopy roughness length zo and displacement height d to bare soil values as the +above-ground biomass, or the sum of leaf and stem area indices, goes to zero is ensured +(Zeng and Wang, 2007). Several corrections have been made to the way the offline forcing +data is interpreted. The main change is a vastly improved and smooth diurnal cycle of +incoming solar radiation that conserves the total incoming solar radiation from the +forcing dataset. Additionally, in offline mode rather than partitioning incoming solar +radiation into a constant 70%/30% direct vs diffuse split, it is partitioned according to +empirical equations that are a function of total solar radiation. Finally, to improve +global energy conservation in fully coupled simulations, runoff is split into separate +liquid and ice water streams that are passed separately to the ocean. Input to the ice +water comes from excess snowfall in snow-capped regions. + + + + +Summary of Science Changes + +Taken together, these augmentations to &clm35; in &clm40; result in improved soil moisture dynamics +that lead to higher soil moisture variability and drier soils. Excessively wet and +unvarying soil moisture was recognized as a deficiency in &clm35; (Oleson et al. 2008a, +Decker and Zeng, 2009). The revised model also simulates, on average, higher snow cover, +cooler soil temperatures in organic-rich soils, greater global river discharge, lower +albedos over forests and grasslands, and higher transition-season albedos in snow covered +regions, all of which are improvements compared to &clm35;. + + + + + +What is new with &clm40; Software Infrastructure? + +The following aspects are changes to the software infrastructure in &clm40; since &clm35;. + + + + Update to cpl7 and scripts. + Remove offline and cpl6 modes. + Remove support for CASA model. + Update to datm8 atmospheric data model. + Add gx3v7 land mask for T31 and fv-4x5 horizontal resolutions. + Add gx1v6 land mask for f05, f09, and f19 horizontal resolutions. + Add tx1v1 land mask and 1.9x2.5_tx1v1 horizontal resolution. + Add in 2.5x3.33 horizontal resolution. + Add in T62 horizontal resolution so can run at same resolution as input &datm; +data. + Allow first history tape to be 1D. + Add ability to use own version of input datasets with &CLMUSRDAT; +variable. + Add a script to extract out regional datasets. + New &buildnml; system with XML file describing all namelist +items. + Add glacier_mec use-case and stub glacier model. + Make default of maxpatch_pft=numpft+1 instead of 4. + Only output static 3D fields on first h0 history file to save space. + Add new fields for VOC (Volatile Organic Compounds) on surface datasets, + needed for the new MEGAN VOC model. + Add multiple elevation class option for glaciers in mksurfdata tool (NOT used +in &clm; yet). + Add ascale field to land model in support of model running on it's own +grid. + + + + + +What are The New Configuration Options in &clm40;? + +Describe any changes made to build system: + + + +Change directory structure to match &ccsm;. +Add BGP target. +Add choice between ESMF and MCT frameworks. +Start removing #ifdef and directives that supported Cray-X1 Phoenix as now +decommissioned. +Make default of maxpatch_pft=numpft+1 instead of 4 for all +configurations. +By default turn on CLAMP when either CN or CASA is enabled +New SNICAR_FRC, CARBON_AERO, and C13 CPP ifdef tokens. + + + + +New options added to &configure;: +More information on options to &clm; &configure; are given in . + + + + +OptionDescription +-comp_intf <name>Component interface to use (ESMF or MCT) (default +MCT) +-nofireTurn off wildfires for bgc setting of CN (default includes +fire for CN) +-pio <name>Switch enables building with Parallel I/O library. [on +| off] (default is on) +-snicar_frc <name>Turn on SNICAR radiative forcing calculation. [on | +off] (default is off) + +More information on options to &clm; &configure; are given in . + + + + +What are The New Namelist Options in &clm40;? + +&buildnml; now checks the validity of your namelist you generate by looking at data in +the namelist_definition.xml file. In order to add new namelist items you need to +change the code and also edit this file (e.g. a namelist option required for your +research project that is not currently an option in &clm40;). To view information +on the namelist view the +file: models/lnd/clm/bld/namelist_files/namelist_definition.xml +in a browser and you'll see the names, type, description and valid_values for all +namelist variables. + + +Changes to &buildnml;: + +Allow simulation year entered to include ranges of years (i.e. 1850-2000) +Remove cam_hist_case option. +Make sure options ONLY used for stand-alone testing have a "drv_" or "datm_" + prefix in them and list these options all together and last when asking for + help from &buildnml;. + + + + New option to &buildnml;: + + -clm_usr_name "name" Dataset resolution/descriptor for personal datasets. + Default: not used + Example: 1x1pt_boulderCO_c090722 to describe location, + number of pts, and date files created + + + + New list options to &buildnml; + + cd models/lnd/clm/bld + ./&buildnml; -res list # List valid resolutions + ./&buildnml; -mask list # List valid land-masks + ./&buildnml; -sim_year list # List valid simulation years and simulation year ranges + ./&buildnml; -clm_demand list # List namelist variables including those you could + # demand to be set. + ./&buildnml; -use_case list # List valid use-cases + + + + +New use-cases for &buildnml;: + + 1850_control = Conditions to simulate 1850 land-use + 2000_control = Conditions to simulate 2000 land-use +20thC_transient = Simulate transient land-use, aerosol and Nitrogen deposition + from 1850 to 2005 + + + + + New namelist items: + + urban_hac = OFF, ON or ON_WASTEHEAT (default OFF) Flag for urban Heating + and Air-Conditioning + OFF = Building internal temperature is un-regulated. + ON = Building internal temperature is bounded to reasonable range. + ON_WASTEHEAT = Building internal temperature is bounded and resultant waste + heat is given off. + urban_traffic = .true. or .false. Flag to include additional multiplicative + factor of urban traffic to sensible heat flux. + (default .false.) + fsnowoptics = filename file for snow/aerosol optical properties (required) + fsnowaging = filename file for snow aging parameters (required) + +More information on the &buildnml; options are given in +. +and in +&CLMBLDNML;. + + +More information on the &buildnml; options are given in in . + + + + +What are The New History Fields? + +New history variables: (note watt vs. W in units, 26 vs. 76) + + + + +NameLong-nameUnitsActive/Inactive +BCDEPtotal BC deposition (dry+wet) from +atmospherekg/m^2/s +BIOGENCObiogenic CO +fluxuGC/M2/H +C13_PRODUCT_CLOSSC13 total carbon loss from wood product +poolsgC13/m^2/s +DSTDEPtotal dust deposition (dry+wet) from +atmospherekg/m^2/s +EFLX_DYNBALdynamic land cover change conversion energy +fluxW/m^2 +FGR12heat flux between soil layers 1 and +2watt/m^2 +FSATfractional area with water table at +surfaceunitless +FSH_NODYNLNDUSEsensible heat flux not including correction for land use change + watt/m^2 +GC_HEAT1initial gridcell total heat +contentJ/m^2 +GC_HEAT2post land cover change total heat +contentJ/m^2inactive +GC_ICE1initial gridcell total ice +contentmm/s +GC_ICE2post land cover change total ice +contentmm/sinactive +GC_LIQ1initial gridcell total liq +contentmm +GC_LIQ2initial gridcell total liq content +mminactive +H2OSNO_TOPmass of snow in top snow +layerkg + HEAT_FROM_ACsensible heat flux put into canyon due to heat +removed from air conditioningwatt/m^2 +HKhydraulic +conductivitymm/sinactive +ISOPRENEisoprene fluxuGC/M2/H +LAND_USE_FLUXtotal C emitted from land cover conversion and +wood product poolsgC/m^2/s +LAND_UPTAKENEE minus LAND_USE_FLUX, negative for +updategC/m^2/s +LWupupwelling longwave +radiationwatt/m^2inactive +MONOTERPmonoterpene +fluxuGC/M2/H +NBPnet biome production, includes fire, landuse, and harvest +flux, positive for sinkgC/m^2/s +OCDEPtotal OC deposition (dry+wet) from +atmospherekg/m^2/s +OVOCother VOC fluxuGC/M2/H +ORVOCother reactive VOC +fluxuGC/M2/H +PBOTatmospheric pressurePa +PCO2atmospheric partial pressure of +&CO2;Pa +PRODUCT_CLOSStotal carbon loss from wood product +poolsgC/m^2/s +PRODUCT_NLOSStotal N loss from wood product +poolsgN/m^2/s +Qairatmospheric specific +humiditykg/kginactive +Qanthanthropogenic heat +fluxwatt/m^2inactive +Qtaumomentum fluxkg/m/s^2 +QFLX_LIQ_DYNBALliq dynamic land cover change conversion +runoff fluxmm/s +QFLX_ICE_DYNBALice dynamic land cover change conversion +runoff fluxmm/s +QRUNOFF_NODYNLNDUSEtotal liquid runoff not including correction for land use change (does not include QSNWCPICE) +mm/s +QSNWCPICEexcess snowfall due to snow +cappingmm/s +QSNWCPICE_NODYNLNDUSEexcess snowfall due to snow capping not including correction for land use change +mm/s +QSNWCPLIQexcess rainfall due to snow +cappingmm/sinactive +SMPsoil matric +potentialmminactive +SNOAERFRC2Lsurface forcing of all aerosols in snow, averaged only when snow is present (land) +watt/m^2 +SNOAERFRCLsurface forcing of all aerosols in snow +(land)watt/m^2 +SNOBCFRCLsurface forcing of BC in snow +(land)watt/m^2 +SNOBCMCLmass of BC in snow +columnkg/m2 +SNOBCMSLmass of BC in top snow +layerkg/m2 +SNOdTdzLtop snow layer temperature gradient +(land)K/m +SNODSTFRC2Lsurface forcing of dust in snow, averaged only when snow is present (land) +watt/m^2 +SNODSTFRCLsurface forcing of dust in snow +(land)watt/m^2 +SNODSTMCLmass of dust in snow +columnkg/m2 +SNODSTMSLmass of dust in top snow +layerkg/m2 +SNOFSRNDdirect nir reflected solar radiation from +snowwatt/m^2inactive +SNOFSRNIdiffuse nir reflected solar radiation from +snowwatt/m^2inactive +SNOFSRVDdirect vis reflected solar radiation from +snowwatt/m^2inactive +SNOFSRVIdiffuse vis reflected solar radiation from +snowwatt/m^2inactive +SNOFSDSNDdirect nir incident solar radiation on +snowwatt/m^2inactive +SNOFSDSNIdiffuse nir incident solar radiation on +snowwatt/m^2inactive +SNOFSDSVDdirect vis incident solar radiation on +snowwatt/m^2inactive +SNOFSDSVIdiffuse vis incident solar radiation on +snowwatt/m^2inactive +SNOLIQFLtop snow layer liquid water fraction +(land)fractioninactive +SNOOCMCLmass of OC in snow +columnkg/m2 +SNOOCMSLmass of OC in top snow +layerKg/m2 +SNOOCFRC2Lsurface forcing of OC in snow, averaged only when snow is present (land) +watt/m^2 +SNOOCFRCLsurface forcing of OC in snow +(land)watt/m^2 +SNORDSLtop snow layer effective grain +radiusm^-6inactive +SNOTTOPLsnow temperature (top +layer)K/minactive +SWupupwelling shortwave +radiationwatt/m^2inactive +TSOI_10CMsoil temperature in top 10cm of +soilK +URBAN_ACurban air conditioning +fluxwatt/m^2 +URBAN_HEATurban heating +fluxwatt/m^2 +VOCFLXTtotal VOC flux into +atmosphereuGC/M2/H +Windatmospheric wind velocity +magnitudem/sinactive +WOOD_HARVESTCwood harvest (to product +pools)gC/m^2/s +WOOD_HARVESTwood harvest (to product +pools)gN/m^2/s + + + + + History field name changes: + + +OldNew +ANNSUM_PLANT_NDEMAND= +ANNSUM_POTENTIAL_GPP +ANNSUM_RETRANSN= ANNMAX_RETRANSN +C13_DWT_PROD10C_LOSS= C13_PROD10C_LOSS +C13_DWT_PROD100C_LOSS= C13_PROD100C_LOSS +C13_DWT_PROD10N_LOSS= C13_PROD10N_LOSS +C13_DWT_PROD100C_LOSS= C13_PROD100C_LOSS +DWT_PROD100N_LOSS= PROD10N_LOSS +DWT_PROD100N_LOSS= PROD100N_LOSS +DWT_PROD100C_LOSS= PROD10C_LOSS +DWT_PROD100C_LOSS= PROD100C_LOSS +HCSOISNO= HC +TEMPSUM_PLANT_NDEMAND= +TEMPSUM_POTENTIAL_GPP +TEMPSUM_RETRANSN= TEMPMAX_RETRANSN + + + +History field names deleted include: SNOWAGE, TSNOW, FMICR, FCO2, DMI, QFLX_SNOWCAP + + + +Add new urban oriented _U, and _R (Urban and Rural) for the following history variables: +EFLX_LH_TOT, FGR, FIRA, FSH, FSM, Q2M, QRUNOFF, RH2M, SoilAlpha, TG, TREFMNAV, +TREFMXAV, and TSA (missing _R for SoilAlpha as the regular SoilAlpha is only defined +for rural areas anyway) + + + +We are missing the Rural soil-alpha variable: SoilAlpha_R on purpose. +SoilAlpha_U is only defined over pervious road, and missing everywhere else. +SoilAlpha is defined only for rural areas. + + + + + + + + + + + +Quickstart to using &clm4; + +Before working with &clm4; read the QuickStart Guide in the +&cesmrel; +Scripts User's Guide. Once you are familiar with how to setup cases for +any type of simulation with &cesm; you will want to direct your attention to the specifics +of using &clm;. + + +For some of the details of setting up cases for &clm4; read the README and text files available +from the "models/lnd/clm/doc" directory (see the "&clm; Web pages" section for a link to the list +of these files). Here are the important ones that you should be familiar with. + +README file describing the directory structure. +Quickstart.userdatasets file describing how to +use your own datasets in the model (also see ). +&KnownBugs; file describing known +problems in &clm4; (that we expect to eventually fix). +KnownLimitations file +describing known limitations in &clm4; and workarounds that we do NOT expect to +fix. + + +The IMPORTANT_NOTES file is given in the next chapter on what +is functional/validated in &clm4;? + +The ChangeLog/ChangeSum files are largely explained in the previous chapter on "What is new with +&clm4;?" + +Note other directories have README files that explain different components and tools used +when running &clm; and are useful in +understanding how those parts of the model work and should be consulted when using tools in those directories. +For more details on configuring and customizing a case with &clm; see . + +The Quickstart.GUIDE (which can be found in +models/lnd/clm/doc) is repeated here. + +&quickstart_guide; + + + + +What is scientifically validated and functional in &clm4;? + +In this section we go over what has been extensively tested and scientifically validated +with &clm4;, and maybe more importantly what has NOT been tested and may NOT be +scientifically validated. You can use all features of &clm;, but need to realize that +some things haven't been tested extensively or validated scientifically. When you use +these features you may run into trouble doing so, and will need to do your own work to +make sure the science is reasonable. + + + +Standard Configuration and Namelist Options that are Validated + +The standard version of the model is &clmcn; at 1-degree horizontal resolution (0.9x1.25). This version has been scientifically +validated with long simulations for: fully coupled simulations ("B" cases), coupled to +atmosphere model CAM ("F" cases), and stand-alone &clm; +cases ("I" cases). We've also done both long simulations for 1850 conditions, and transient 20th century simulations from 1850 to 2005 (with +transient land-use, Nitrogen and Aerosol deposition). There have also been transient +future scenario simulations done for fully coupled cases for different "representative +concentration pathway" (RCP) scenarios (RCP2.6, RCP4.5, RCP6.0, and RCP8.5). +To a lesser extent there have also +been simulations done at T31 and 2-degree horizontal +resolution (1.9x2.5), and with &clmsp; for these resolutions. As such we have provided +appropriate 1-degree, 2-degree, and T31 initial condition +datasets for these configurations. The irrigation and prognostic crop models were both +validated at 2-degree resolution. The irrigation model for &clmsp; for present day +conditions for an "I" compset, and the prognostic crop model for present day conditions +for a case coupled to the active land model, but using a data ocean model (an "F" +compset). Other resolutions, configurations, and namelist options are less well tested or scientifically validated. +The further you get away from the standard configurations and resolutions, the more likely you are to run into trouble, and/or need to +scientifically validate your work. + + +In the sections below we go through configuration and/or namelist options or modes that the user should be especially wary of using. You +are of course free to use these options, and you may find that they work functionally. Although in some cases you will find issues even +with functionality of using them. If so you will need to test, debug and find solutions for these issues on your own. But in every case +you will need to go through more extensive work to validate these options from a scientific standpoint. + + + + +Configure Modes NOT scientifically validated, documented, supported or, in some +cases, even advised to be used: + + + + + C13(-c13) +The C13 mode for bgc=cn is NOT scientifically validated or documented and is NOT +recommended for use. + + + + + + CASA(-bgc casa) +The bgc=casa mode is NOT scientifically validated or documented and is NOT +recommended for use. + + + + + + SNICAR_FRC(-snicar_frc) + This mode is tested and functional, but is NOT constantly scientifically validated, and should be + considered experimental. + + + + + + + +Namelist options that should NOT be exercised: + +Build-Namelist options that should NOT be exercised: + + +-irrig with -bgc cn +We have only run the irrigation model with &clmsp; (i.e. without the CN model). We +recommend that if you want to run the irrigation model with CN, that you do a spinup. +But, more than that you may need to make adjustments to +irrig_factor in +models/lnd/clm/src/biogeophys/CanopyFluxesMod.F90. See the +notes on this in the description of the irrigation model in the + +Technical Descriptions of the Interactive Crop Management and Interactive +Irrigation Models. + + +-irrig with -crop on +Irrigation doesn't work with the prognostic crop model. Irrigation is only applied to +generic crop currently, which negates it's practical usage. We also have a known +problem when both are on (see bug 1326 in the &KnownBugs; file). +If you try to run in this mode, the &clm; &buildnml; will return with an error. + + +-lnd_res: Fine-mesh mode, functional, but experimental + +-rcp: Representative Concentration Pathway (RCP) +for future scenarios, functional for limited resolutions, but experimental + +-datm_*: All options that start with "datm_" they are +only used for &clm; stand-alone testing. + +-drv_*: All options that start with "drv_" they are +only used for &clm; stand-alone testing. + + + + + + +Namelist items that should NOT be exercised: + + +casa namelist options: lnpp, lalloc, q10, spunup, and fcpool + + CASA has NOT been scientifically validated in &clm4;. + +fine-mesh namelist options: flndtopo, and fatmtopo. + These options are functional but experimental. See the -lnd_res option above. + + + + suplnitro='ALL' + The suplnitro namelist option to the CN Biogeochemistry model supplies +unlimited nitrogen and therefore vegetation is over-productive in this mode. + + + +urban_traffic: Not currently functional + + + + + + + + + +What are the UNIX utilities required to use &clm;? + +Running the &clm; requires a suite of UNIX utilities and programs and you should +make sure you have all of these available before trying to go forward with using +it. If you are missing one of these you should contact the systems administrator +for the machine you wish to run on and make sure they are installed. + +&FORTRAN90; compiler +"C" compiler +GNU make +UNIX csh and tcsh shells +UNIX sh shell +UNIX bash shell +UNIX awk +UNIX sed +&netcdf; library +MPI Library +"C" pre-processor +&perl; +Autoconf +m4 macro processor +Parallel &netcdf; (optional) +&ncl; (for some of the offline tools for creating/modifying &clm; input +datasets see for more information on &ncl;) +Python (optional, needed for &ptclm;) +xsltproc, docbook and docbook utilities (optional, needed to build the Users-Guide) +protex and latex2html (optional, needed to build the Code-Reference Guide) + + + + + + + + + &cesm; Online Bulletin Board + &cesmrel; Scripts User's Guide + + +Other resources to get help from + + +In addition to this users-guide there are several other resources that are available +to help you use &clm4;. The first one is the &cesm; User's-Guide, which documents the entire +process of creating cases with &cesm;. The next is the &cesm; bulletin board which is +a web-site for exchanging information between users of &cesm;. There are also &clm; +web-pages specific for &clm;, and finally there is an email address to report bugs that +you find in &cesm1;. + + + +The &cesm; User's-Guide + +&clmrel; is always run from within the standard &cesmrel; build and run scripts. Therefore, the +user of &clm4; +should familiarize themselves with the &cesmrel; scripts and understand how to work with them. +User's-Guide documentation on the &cesmrel; scripts are available from the following web-page. The purpose +of this &clmrel; User's Guide is to give the &clm4; user more complete details on how to work +with &clm; and the set of tools that support &clm;, as well as to give examples that are unique to the use +of &clm;. However, the &cesmrel; Scripts User's-Guide remains the primary source to get detailed +information on how to build and run the &cesm; system. + +&cesm1; Scripts +User's-Guide + + + + + +The &cesm; Bulletin Board + +There is a rich and diverse set of people that use the &cesm;, and often it is useful to be in contact with +others to get help in solving problems or trying something new. To facilitate this we have an online +Bulletin Board for questions on the &cesm;. There are also different sections in the Bulletin Board for +the different component models or for different topics. + +&cesm; Online Bulletin Board + + + + + +The &clm; web pages + +The main &clm; web page contains information on the &clm;, it's history, developers, as well as +downloads for previous model versions. There are also documentation text files in the +models/lnd/clm/doc directory that give some quick information on using &clm;. + +&clm; web page +&clm; Documentation Text Files + +Also note that several of the XML database files can be viewed in a web browser to get +a nice table of namelist options, namelist defaults, or compsets. Simply view them +as a local file and bring up one of the following files: + +models/lnd/clm/bld/namelist_files/namelist_definition.xml +-- definition of &clm; namelist items. +models/lnd/clm/bld/namelist_files/namelist_defaults_clm.xml +-- default values for &clm; namelist items. +scripts/ccsm_utils/Case.template/config_definition.xml +-- definition of all env_*.xml items. +scripts/ccsm_utils/Case.template/config_compsets.xml +-- definition of all the compsets. +models/lnd/clm/bld/namelist_files/history_fields.xml +-- definition of &clm; history fields. + + + + + +Reporting bugs in &clm4; + +If you have any problems, additional questions, bug reports, or any other feedback, please send an email to +cesmhelp@cgd.ucar.edu. If you find bad, wrong, or misleading information + in this users guide send an email to erik@ucar.edu. The current list of +known issues for &clmrel; is in the &KnownBugs; file, and the list of issues for +&cesmrel; is at... + +&cesmwebmodelrel;/tags/cesm1_0_3/#PROBLEMS +. + + + + + + + + diff --git a/components/clm/doc/UsersGuide/ptclm.xml b/components/clm/doc/UsersGuide/ptclm.xml new file mode 100644 index 0000000000..6c0ef2aec8 --- /dev/null +++ b/components/clm/doc/UsersGuide/ptclm.xml @@ -0,0 +1,992 @@ + + +How to run &ptclm; + +&ptclm; (pronounced point clime) is a Python script to help you set up PoinT CLM +simulations. It runs the &clm; tools for you to get datasets set up, and copies them +to a location you can use them according to the &CLMUSRDAT; naming convention. Then +it runs create_newcase for you and modifies the env settings and +namelist appropriately. &ptclm; has a simple ASCII text file for storing basic +information for your sites. We also have complete lists for AmeriFlux and Fluxnet-Canada +sites, although we only have the meteorology data for one site. For other sites you +will need to obtain the meteorology data and translate it to a format that the &cesm; +datm model can use. But, even without meteorology data &ptclm; is useful to setup +datasets to run with standard &CLMQIAN; data. + + + +The original authors of &ptclm; are: Daniel M. Ricciuto, Dali Wang, Peter E. Thornton, +Wilfred M. Post all at Environmental Sciences Division, Oak Ridge National Laboratory +(ORNL) and R. Quinn Thomas at Cornell University. It was then modified +fairly extensively by Erik Kluzek at &ncar;. We want to thank all of these individuals +for this contribution to the &cesm; effort. We also want to thank the folks at +University of Michigan Biological Stations (US-UMB) who allowed us to use their Fluxnet +station data and import it into our inputdata repository, especially Gil Bohrer the +PI on record for this site. + + + +Introduction to PTCLM + +To get help on &ptclm; use the "--help" option as follows. + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +> ./PTCLM.py --help + + + +The output to the above command is as follows: + + + +&ptclm_help; + + + + +Here we give a simple example of using &ptclm; for a straightforward case of running +at the US-UMB Fluxnet site on bluefire where we already have the meteorology data on +the machine. Note, see for permission information +to use this data. + +Example of running &ptclm; for US-UMB on bluefire + +setenv CSMDATA /fis/cgd/cseg/csm/inputdata +setenv MYCSMDATA $HOME/inputdata +setenv SITE US-UMB +setenv MYMACH bluefire +setenv MYCASE testPTCLM + +# First link the standard input files to a location you have write access +cd scripts +./link_dirtree $CSMDATA $MYCSMDATA + +# Next build all of the clm tools you will need +cd ../models/lnd/clm/tools/mksurfdata +gmake +gmake clean +cd ../mkdatadomain +gmake +gmake clean +cd ../mkgriddata +gmake +gmake clean +# next run PTCLM (NOTE -- MAKE SURE python IS IN YOUR PATH) +cd ../../../../../scripts/ccsm_utils/Tools/lnd/clm/PTCLM +./PTCLM.py -m $MYMACH --case=$MYCASE --site=$SITE --csmdata=$MYCSMDATA \ + --aerdepgrid --ndepgrid +# NOTE: we use --aerdepgrid --ndepgrid so that you use the global +# aerosol and Nitrogen deposition files rather than site-specific ones. +cd ../../../../../$MYCASE +# Finally configure, build, and run the case as normal + + + + + + +Guide to the options of &ptclm; + +There are three types of options to &ptclm;: required, configure/run-time, and +dataset generation options. The three required options are the three settings that +MUST be specified for &ptclm; to work at all. The other settings have default +values that will default to something useful. The configure/run-time options control +how the simulation will be setup and run. The dataset generation options control +the generation of datasets needed when &ptclm; is run. Most options use a double +dash "--" "longname" such as "--list", but the most common options also have a short-name +with a single dash (such as -m instead of --machine). + + +The required options to &ptclm; are: inputdata directory (-d), machine (-m) and +site-name (-s). Inputdata directory is the directory where you have the &cesm; +inputdata files, you need to have write access to this directory, so if you are +running on a machine that you do NOT have write access to the standard inputdata +location (such as &ncar; bluefire or ORNL jaguar) you need +to link the standard files to a location you do have control over. We recommend +using the scripts/link_dirtree tool to do that. "machine" is +the scripts name for the machine/compiler you will be using for your case. And +finally site-name is the name of the site that you want to run for. Site-name +can either be a valid &CLM1PT; supported dataset name or a Fluxnet site name +from the list of sites you are running on (see the --sitegroupname for more information +about the site lists). + + +After &ptclm; is run a case directory where you can then configure, build and run +your &cesm; case as normal. It also creates a README.PTCLM +in that directory that documents the commandline options to &ptclm; that were used +to create it. + + +After "help" the "list" option is one of the most useful options for getting +help on using &ptclm;. This option gives you information about some of the other +options to &ptclm;. To get a list of the machine, sites, and compsets that can be +used for &ptclm; use the "--list" option as follows. + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +> ./PTCLM.py --list + + + +The output to the above command is as follows: + + + +&ptclm_list; + + + + +Overview on using &ptclm; + +Steps in running &ptclm; + +Setup Inputdata directory with write access (use +<command>link_dirtree</command> script) + +You need to setup an inputdata directory where you have write access to it. +Normally, for &ncar; machines the data is on an inputdata where the user +does NOT have write access to it. A way that you can get around this is +to use the link_dirtree script to create softlinks from +the normal location to a location you have write access to. So for example +on bluefire: + +> setenv CSMDATA /fs/cgd/csm/inputdata +> setenv MYCSMDATA $HOME/inputdata +> mkdir $MYCSMDATA +> cd scripts +> ./link_dirtree $CSMDATA $MYCSMDATA + +See for more information on this. + + + +Build the &clm; tools + +Next you need to make sure all the &clm; &FORTRAN; tools are built. + +> cd models/lnd/clm/tools/mkgriddata +> gmake +> gmake clean +> cd ../mkdatadomain +> gmake +> gmake clean +> cd ../mksurfdata +> gmake +> gmake clean + + + + +Run &ptclm; + +Next you actually run &ptclm; which does the different things listed below: + + + +&ptclm; names your case based on your input + +&ptclm; names you case based on the input you give to it. + +[Prefix_]SiteCode_Compset[_QIAN][_spinuptype] +Where: + Prefix is from the caseidprefix option (or blank if not used). + SiteCode is the site name you entered with the -s option. + Compset is the compset name you entered with the -c option. + _QIAN is part of the name only if the useQIAN is used. + _spinuptype is part of the name if one of: ad_spinup, exit_spinup, or + final_spinup is used, and the exact spinup name chosen is used. + +For example, the casename for the following will be: + +> cd scripts +> ./PTCLM.py -m bluefire -s US-UMB -d $MYCSMDATA -c I_2000_CN --ad_spinup --useQIAN + +"US-UMB_I_2000_CN_QIAN_ad_spinup". + + + +&ptclm; creates datasets for you + +It will populate $MYCSMDATA with new datasets it creates using the +&clm; tools. + + + +If a transient compset and &ptclm; finds a <filename>_dynpftdata.txt</filename> +file + +If you are running a transient compset (such as the "I_1850-2000_CN" compset) +AND you there is a file in the PTCLM_sitedata directory under +the &ptclm; directory called $SITE_dynpftdata.txt it will use +this file for the land-use changes. Otherwise it will leave land-use constant, unless +you use the pftgrid option so it uses the global dataset for landuse changes. +See for more information on this. There +is a sample transient dataset called US-Ha1_dynpftdata.txt. +Transient compsets, are compsets that create transient land-use change and +forcing conditions such as: +'I_1850-2000', 'I_1850-2000_CN', 'I_RCP8.5_CN', 'I_RCP6.0_CN', 'I_RCP4.5_CN', +or 'I_RCP2.6_CN'. + + + +&ptclm; creates a <filename>pft-physiology</filename> for you + +&ptclm; will create a local copy of the pft-physiology +specific for your site that you could then customize with changes specific +for that site. + + + +&ptclm; creates a <filename>README.PTCLM</filename> for you + +&ptclm; will create a simple text file with the command line for it in a file +called README.PTCLM in the case directory it creates for you. + + + + + + +Customize, configure, build and run case as normal + +You then customize your case as you would normally. See the chapter for more information on doing this. + + + + + + + +Details on the options of &ptclm; + +Next we discuss the configure and run-time options, dividing them up into +configure, spinup, and run-time options. + + +Configure options include: + +-c MYCOMPSET, --compset=MYCOMPSET +--caseidprefix=MYCASEID +--cesm_root=BASE_CESM +--namelist=NAMELIST +--rmold +--scratchroot=SCRATCHROOT +--sitegroupname=SITEGROUP +--QIAN_tower_yrs +--useQIAN + + + + + +--compset + +The "-c" option is the most commonly used option after the required options, as it +specifies the &cesm; scripts component set to use with &ptclm;. The default compset +is the "ICN" compset with CN on for present day conditions. + + + + + +--caseidprefix + +This option gives a prefix to include in the casename when the case is created, in +case you want to customize your casenames a bit. By default, casenames are figured +out based on the other options. The argument to this option can either be a name to +prefix casenames with and/or a pathname to include. Hence, if you want cases to +appear in a specific directory you can give the pathname to that directory with this +option. + + + + + +--cesm_root + +This option is for running &ptclm; with a different root directory to &cesm; than the +version &ptclm; exists in. Normally you do NOT need to use this option. + + + + + +--namelist + +This option adds any items given into the &clm; &usernlclm; namelist. This allows you to +add customizations to the namelist before the clm.buildnml.csh file +is created for the case. + + + + + +--rmold + +This option will remove an old case directory of the same name if one exists. Otherwise, +if an old case directory already exists and you try to run &ptclm; it will return with +an error. + + + + + +--scratchroot + +This option is ONLY valid when using one of the generic machines (the -m option). +This passed onto create_newcase and gives the location where cases +will be built and run. + + + + + +--sitegroupname + +In the &ptclm; directory there is a subdirectory "PTCLM_sitedata" that contains +files with the site, PFT and soil data information for groups of sites. These site groups +are all separate ASCII files with the same prefix followed by a "_*data.txt" name. +See for more information on these files. +By default we have provided three different valid group names: + +EXAMPLE +AmeriFlux +Fluxnet-Canada + +The EXAMPLE is the group used by default and ONLY includes the US-UMB site as that +is the only site we have data provided for. The other two site groups include the +site information for all of both the AmeriFlux and Fluxnet-Canada sites. You can use +the "sitegroupname" option to use one of the other lists, or you can create your own +lists using the EXAMPLE file as an example. Your list of sites could be real world +locations or could be theoretical "virtual" sites given to exercise &clm; on +differing biomes for example. Note, see with +permission information to use the US-UMB data. + + + + + +--useQIAN + +This option says to use the standard &clm; global Qian T62 atmospheric forcing rather +than any tower site forcing data available. Otherwise, &ptclm; will try to find tower +forcing data for the specific site entered. + + + + + +--QIAN_tower_yrs + +This option is used with the "useQIAN" option to set the years to cycle over for +the Qian data. In this case Qian atmospheric forcing will be used, but the +simulation will run over the same years that tower site is available for this site. + + + + + + +Spinup options include: + +--coldstart +--ad_spinup +--exit_spinup +--final_spinup +--finidat=FINIDAT + + + + +The spinup options enable the different CN spinup modes, but also set the run +length. The coldstart option says to startup with OUT an initial condition file, while +the finidat option explicitly gives the initial condition file to use. Obviously, +the different spinup options can NOT be used together, nor can the coldstart and +finidat options be either. + + +--coldstart + +This option ensures that a cold-start will be done with arbitrary initial conditions. + + + + + +--ad_spinup + +This option enables the accelerated decomposition mode when a CN compset is used. It +also sets the run-length as given in the example for running exit spinup in +. + + + + + +--exit_spinup + +This option enables the exit spinup mode when a CN compset is used. It also sets the +run-length to a year just as given in the example for running exit spinup in +. + + + + + +--final_spinup + +This option sets the run length as given in the example for a final spinup in +. This option can be used for any compset. + + +There is a bug in the final_spinup mode for setting the run length. Because of the +bug, final_spinup mode only runs for a very short time, you'll need to edit +the run length by hand to be 50 years. See bug 1367 in the &KnownBugs; file. + + + + + + + +--finidat + +This option sets the initial condition file to startup the simulation from. + + + + + + + + + +Run-time options include: + +--debug +--run_n=MYRUN_N +--run_units=MYRUN_UNITS +--stdurbpt + + + + + + + +--debug + +This option tells &ptclm; to echo what it would do if it were run, but NOT actually +run anything. So it will show you the dataset creation commands it would use. +It does however, run create_newcase, but then it only displays +the xmlchange commands and changes that it would do. Also note +that if you give the "--rmold" option it won't delete the case directory beforehand. +Primarily this is intended for debugging the operation of &ptclm;. + + + + + +--run_n + +This option along with run_units is used to set the length for the simulation. "run_n" +is the number of units to use. +The default run length depends on the site, compset, +and configuration and for example if a "spinup" option is selected. + + + + + +--run_units + +This option is the units of time to use for the length of the simulation. It is used +along with "run_n" to set the length of the simulation. +The default run length depends on the site, compset, +and configuration and for example if a "spinup" option is selected. + + + + + +--stdurbpt + +This option turns on the "stdurbpt_pd" use-case for &CLMUSECASE;. This option +can NOT be used for compsets that set the use-case to something besides present-day. + + + + + + + + +Lastly we discuss the dataset generation options. The dataset generation options are: + +--aerdepgrid +--ndepgrid +--pftgrid +--soilgrid +--nopointdata +--owritesrfaer + + + + +The options that with a "grid" suffix all mean to create datasets using the global +gridded information rather than using the site specific point data. By default the +site specific point data is used. The "nopointdata" and "owritesrfaer" options have to +do with file creation. + + +Because supported single-point datasets already have the data created for them, you +MUST use the "nopointdata" and "ndepgrid" options when you are using a supported +single-point site. You must use "ndepgrid" even for a compset without CN. You also +can NOT use the options: "soilgrid", "pftgrid", "aerdepgrid", or "owritesrfaer". + + + + + +--aerdepgrid + +This option says to use the aerosol deposition files from the global dataset rather +than creating an interpolated version. + + +This option must NOT be used when you you are using a site that +is a supported single point dataset. + + + + + +--ndepgrid + +This option says to use the Nitrogen deposition files from the global dataset rather +than creating an interpolated version. This is only needed for compsets with CN. + + + +This option is required when you you are using a site that +is a supported single point dataset. This is true even when you are NOT using a +compset with CN. + + + + + + +--pftgrid + +This option says to use the PFT values provided on the global dataset rather than +using the specific site based values from the +PTCLM_sitedata/*_pftdata.txt file when creating the surface dataset. + + +This option must NOT be used when you you are using a site that +is a supported single point dataset. + + + + + +--soilgrid + +This option says to use the soil values provided on the global dataset rather than +using the specific site based values from the +PTCLM_sitedata/*_soildata.txt file when creating the surface dataset. + + +This option must NOT be used when you you are using a site that +is a supported single point dataset. + + + + + +--nopointdata + +This option says to NOT create any input datasets -- assume this step has already been +done. If datasets weren't already created, your case will fail when you try to run it. +In general the first time you run &ptclm; for a new site you want it to generate new +datasets, but the next time and future times you want to use this option so that it +doesn't waste a lot of time rebuilding datasets over again. + + + +This option is required when you you are using a site that +is a supported single point dataset. + + + + + + +--owritesrfaer + +This option says to overwrite any surface and/or aerosol deposition datasets that +were already created. Otherwise, the creation of these files will be skipped if a file +is already found (but it WILL create files if they don't exist). + + +This option must NOT be used when you you are using a site that +is a supported single point dataset. + + + + + + + + +Note on the aerosol and Nitrogen deposition files. When the "aerdepgrid" and "ndepgrid" +options are NOT used -- aerosol and Nitrogen deposition files will be created by +interpolating from the global datasets. However, after these interpolated files +are created you could customize them for your site with data that you provide. You +could then write protect the files and use the "nopointdata" option so that &ptclm; +doesn't try to overwrite them in the future. + + + + + + +Examples using &ptclm; + +Now let's give a few more complex examples using some of the options we have +discussed above. + + +In this first example, we'll demonstrate using a supported single point dataset, +which then requires using the "nopointdata" and "ndepgrid" options. We'll also +demonstrate the compset option, "stdurbpt" and "caseidprefix" options. + +Example of running &ptclm; for the Mexicocity supported single point +dataset + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +> ./PTCLM.py -m bluefire -s 1x1_mexicocityMEX -d $CSMDATA --nopointdata --ndepgrid \ +--stdurbpt -c I --caseidprefix `pwd`/myPTCLMcases/site +> cd myPTCLMcases/site_1x1_mexicocityMEX_I +> ./configure -case +# Now build and run normally +> ./site_1x1_mexicocityMEX_I.bluefire.build +# Here we show running interactively +> ./site_1x1_mexicocityMEX_I.bluefire.run + + + + + +Now, let's demonstrate using a different group list, doing a spinup, running with Qian +global forcing data, but using tower years to set the years to run over. This uses +the options: sitegroupname, ad_spinup, useQIAN, and QIANtower_years. + +Example of running &ptclm; for a spinup simulation with Qian data for tower years. + + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +> ./PTCLM.py -m bluefire -s US-Ha1 -d $CSMDATA --sitegroupname AmeriFlux \ +--ad_spinup --useQIAN --QIAN_tower_yrs +> cd ../../../../../US-Ha1_ICN_QIAN_ad_spinup +> ./configure -case +# Now build and run normally +> ./US-Ha1_ICN_QIAN_ad_spinup.bluefire.build +# Here we show running interactively +> ./US-Ha1_ICN_QIAN_ad_spinup.bluefire.run + + + + + +Finally, let's demonstrate using a generic machine (which then requires the scratchroot +option), using the global grid for PFT and soil types, and setting the run length +to two months. + +Example of running &ptclm; on a generic machine with global PFT and soil types +dataset + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +# Note, see the with permission information +# to use the US-UMB data. +> ./PTCLM.py -m generic_darwin_intel -s US-UMB -d $CSMDATA --pftgrid --soilgrid \ +--scratchroot $HOME --run_n 2 --run_units nmonths +> cd ../../../../../US-UMB_ICN +> ./configure -case +# Now build +> ./US-UMB_ICN.generic_darwin_intel.build +# To get the files from the svn server... +# First list the files from the streams text file +> ../ccsm_utils/Tools/listfilesin_streams \ +-t $HOME/US-UMB_ICN/run/clm1PT.1x1pt_US-UMB.stream.txt -l \ +> Buildconf/datm.input_data_list +# And now run the script to export data to your machine +> ../ccsm_utils/Tools/check_input_data -export +# Here we show running interactively +> ./US-UMB_ICN.generic_darwin_intel.run + + + + +Because of Bug 1364, when running this case as above we get a floating point +error after reaching time-step 124 for the example exactly as above. Other +machines or compilers probably won't have this problem. See the &KnownBugs; file +for more information on this problem. + + + + +As documented in Bug 1368, spinning up the US-UMB site for a I2000CN compset gives +zero Gross Primary Production (GPP). If the user wishes to use this site for &clmcn;, +they'll need to address this issue. +See the &KnownBugs; file for more information on this problem. + + + + + + +Adding data for use by &ptclm; + +&ptclm; Group Site Lists + +The "sitegroupname" option to &ptclm; looks for groups of sites in the +files in the PTCLM_sitedata directory under the &ptclm; directory. +You can add new names available for this option including your own lists of sites, by +adding more files in this directory. There are three files for each "sitegroupname": +$SITEGROUP_sitedata.txt, +$SITEGROUP_soildata.txt +and $SITEGROUP_pftdata.txt (where $SITEGROUP is the name that would +be entered as "sitegroupname" to &ptclm;). Each file needs to have the same list of sites, +but gives different information: site data, PFT data, and soil data respectively. +Although the site codes need to be the same between the three files, the files do NOT +have to be in the same order. Each file has a one-line header that lists the contents +of each column which are separated by commas. The first column for each of the files +is the "site_code" which must be consistent between the three files. The site code +can be any unique character string, but in general we use the AmeriFlux site code. + + +Site data file: $SITEGROUP_sitedata.txt): The header for +this file is: + +site_code,name,state,lon,lat,elev,startyear,endyear,alignyear + +The columns: name, state, and elevation are informational only. Name is a longer +descriptive name of the site, and state is the state for U.S. sites or country +for non U.S. sites. The columns: lon and lat are the longitude and latitude of +the location in decimal degrees. The last three columns are the start and ending +year for the data and the align year for an 1850 case for the data. The align year +is currently unused. + + +Soil data file: $SITEGROUP_soildata.txt): The header for this +file is: + +site_code,soil_depth,n_layers,layer_depth,layer_sand%,layer_clay% + +The first three fields after "site_code" are currently unused. The only two that +are used are the percent sand and clay columns to set the soil texture. + + +PFT data file: $SITEGROUP_pftdata.txt): The header for this +file is: + +site_code,pft_f1,pft_c1,pft_f2,pft_c2,pft_f3,pft_c3,pft_f4,pft_c4,pft_f5,pft_c5 + +This file gives the vegetation coverage for the different vegetation types for the site. +The file only supports up to five PFT's at the same time. The columns with "pft_f" are +the fractions for each PFT, and the columns with "pft_c" is the integer index of the +given PFT. Look at the pft-physiology file to see what the PFT index for each PFT type +is. + + + + +Dynamic Land-Use Change Files for use by &ptclm; + +There is a mechanism for giving site-specific land-use change in &ptclm;. Adding +site specific files to the PTCLM_sitedata directory under +&ptclm; allows you to specify the change in vegetation and change in harvesting +(for the CN model) for that site. Files are named: +$SITE_dynpftdata.txt. There is a sample file for the US-Ha1 +site called: US-Ha1_dynpftdata.txt. The file has a one-line +header with the information that the file has, and then one-line for each year +with a transition. The header line is as follows: + +trans_year,pft_f1,pft_c1,pft_f2,pft_c2,pft_f3,pft_c3,pft_f4,pft_c4,pft_f5,pft_c5,har_vh1,har_vh2,har_sh1,har_sh2,har_sh3,graze,hold_harv,hold_graze + +This file only requires a line for each year where a transition or harvest happens. As +in the "pftdata" file above "pft_f" refers to the fraction and "pft_c" refers to the +PFT index, and only up to five vegetation types are allowed to co-exist. The last +eight columns have to do with harvesting and grazing. The last two columns are whether +to hold harvesting and/or grazing constant until the next transition year and will +just be either 1 or 0. This file will be converted by the +PTCLM_sitedata/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl script in the &ptclm; +directory to a format that mksurfdata can read that has an entry +for each year for the range of years valid for the compset in question. + + + + +Converting AmeriFlux Data for use by &ptclm; + +AmeriFlux data comes in comma separated format and is available from: + +http://public.ornl.gov/ameriflux/dataproducts.shtml. Before you +download the data you need to agree to the usage terms. + + +Here is a copy of the usage terms from the web-site on June/13/2011. + + +"The AmeriFlux data provided on this site are freely available and were furnished by +individual AmeriFlux scientists who encourage their use. Please kindly inform the +appropriate AmeriFlux scientist(s) of how you are using the data and of any publication +plans. Please acknowledge the data source as a citation or in the acknowledgments if the +data are not yet published. If the AmeriFlux Principal Investigators (PIs) feel that they +should be acknowledged or offered participation as authors, they will let you know and we +assume that an agreement on such matters will be reached before publishing and/or use of +the data for publication. If your work directly competes with the PI's analysis they may +ask that they have the opportunity to submit a manuscript before you submit one that uses +unpublished data. In addition, when publishing, please acknowledge the agency that +supported the research. Lastly, we kindly request that those publishing papers using +AmeriFlux data provide preprints to the PIs providing the data and to the data archive at +the Carbon Dioxide Information Analysis Center (CDIAC)." + + +The above agreement applies to the "US-UMB" dataset imported into our repository as +well, and Gil Bohrer is the PI on record for that dataset. + + +The &cesm; can NOT handle missing data, so we recommend using the "Level 4" Gap filled +datasets. +The fields will also need to be renamed. The "WS" column becomes "WIND", "PREC" becomes +"PRECmms", "RH" stays as "RH", "TA" becomes "TBOT", "Rg" becomes "FSDS", "Rgl" becomes +"FLDS", "PRESS" becomes "PSRF". "ZBOT" can just be set to the constant of "30" (m). +The units of Temperature need to be converted from "Celsius" to "Kelvin" (use the +value in SHR_CONST_TKFRZ in the file +models/csm_share/shr/shr_const.F90 of 273.15. +The units of Pressure also need to be converted from "kPa" to "Pa". LATIXY, and +LONGXY should also be set to the latitude and longitude of the site. + + + +&ptclm; transient example over a shorter time period + + +Example of running &ptclm; for transient land-use 1991-2006 for US-Ha1 on bluefire + +This is an example of using &ptclm; for Harvard Forest (AmeriFlux site code US-Ha1). In +order to do this we would've needed to have converted the AmeriFlux data into &netcdf; +format as show in the section above. Also note +that this site has a site-specific dynamic land-use change file for it +PTCLM_sitedata/US-Ha1_dynpftdata.txt in the &ptclm; directory +and this file will be used for land-use change and harvesting rather than the +global dataset. + + +> cd scripts/ccsm_utils/Tools/lnd/clm/PTCLM +# We are going to use forcing data over 1991 to 2006, but we need to start with +# a transient compset to do so, so we use the 20th Century transient: 1850-2000 +# Note: When creating the flanduse_timeseries dataset for this site it will use the +# PTCLM_sitedata/US-Ha1_dynpftdata.txt +# file for land-use change and harvesting +> ./PTCLM.py -m bluefire -s US-Ha1 -d $MYCSMDATA --sitegroupname AmeriFlux \ +-c I_1850-2000_CN +> mkdir $MYCSMDATA/atm/datm7/CLM1PT_data/1x1pt_US-Ha1 +> cd $MYCSMDATA/atm/datm7/CLM1PT_data/1x1pt_US-Ha1 +# Copy data in &netcdf; format to this directory, filenames should be YYYY-MM.nc +# The fieldnames on the file should be: +# FLDS,FSDS,LATIXY, LONGXY, PRECTmms,PSRF,RH,TBOT,WIND,ZBOT +# With units +# W/m2,W/m2,degrees_N,degrees_E,mm/s, Pa, %, K, m/s, m +# The time coordinate units should be: days since YYYY-MM-DD 00:00:00 +> cd ../../../../../US-Ha1_I_1850-2000_CN +# We need to turn cold-start on, so it doesn't expect an initial condition file +# preferably, you would generate your own initial condition file and then use +# the --finidat option to &ptclm; to enter it +> ./xmlchange -file env_conf.xml -id CLM_FORCE_COLDSTART -val on +# Now we need to set the start date to 1991, and have it cycle forcing data +# over 1991 to 2006 +> ./xmlchange -file env_conf.xml -id RUN_STARTDATE -val 1991-01-01 +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_ALIGN -val 1991 +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_END -val 2006 +> ./xmlchange -file env_conf.xml -id CLM_NAMELIST_OPTS -val \ +# Similarly for Nitrogen deposition data we cycle over: 1991 to 2006 +"model_year_align_ndep=1991,stream_year_first_ndep=1991,stream_year_last_ndep=2006" +# Now configure the case, and we'll edit the datm namelist for prescribed aerosols +> ./configure -case +# We also need to change the datm to run with aerosols over the 1991-2006 period +cat << EOF > patch.diff +*** datm.buildnml.csh.orig 2011-06-14 09:28:20.000000000 -0600 +--- datm.buildnml.csh 2011-06-14 09:28:57.000000000 -0600 +*************** +*** 32,38 **** + dataMode = 'CLMNCEP' + domainFile = '$DOMAINFILE' + streams = 'clm1PT.1x1pt_US-Ha1.stream.txt 1991 1991 2006 ', +! 'presaero.stream.txt 1849 1849 2006' + vectors = 'null','null' + mapmask = 'nomask','nomask' + mapalgo = 'nn','nn' +--- 32,38 ---- + dataMode = 'CLMNCEP' + domainFile = '$DOMAINFILE' + streams = 'clm1PT.1x1pt_US-Ha1.stream.txt 1991 1991 2006 ', +! 'presaero.stream.txt 1991 1991 2006' + vectors = 'null','null' + mapmask = 'nomask','nomask' + mapalgo = 'nn','nn' +EOF +# Apply the above patch to the datm build namelist file +> patch Buildconf/datm.buildnml.csh patch.diff + + + + + + +Because of bug 1361, this won't work out of the box. You'll need to add the change +to PTCLM.py given in the KnownBugs file on this issue. + + + + + + + + +A bit about the structure of &ptclm;, what it does, and how it works + +A large part of &ptclm; just sets up the different options and does error checking +on the options given. &ptclm; then uses the options provided to use +create_newcase to create a new case. It then queries both the +case directory and/or the XML database (using +queryDefaultNamelist.pl in models/lnd/clm/bld +and does other settings for the case. It then runs the different &clm; tools in turn to +create the necessary datasets and points to them in the case with the &CLMUSRDAT; option. +It runs mkgriddata, mksurfdata.pl, and +mkdatadomain as well as the aerdepregrid.ncl and +ndepregrid.ncl &ncl; scripts. mkgriddata and +mkdatadomain have template namelist files in the +scripts/ccsm_utils/Tools/lnd/clm/PTCLM/usr_files directory. +When running mksurfdata.pl if it finds a +$SITE_dynpftdata.txt in the +scripts/ccsm_utils/Tools/lnd/clm/PTCLM/PTCLM_sitedata directory +it will use that file for transient landuse changes (there's a sample file for +"US-Ha1" called US-Ha1_dynpftdata.txt). +It modifies the different env*.xml using +xmlchange and creates an initial &usernlclm; filename. After +&ptclm; is run you can then make changes to the case by hand, and configure, build +and run as normal. + + +There is a simple test script to test &ptclm;. See +for more information on using it. + + + + + diff --git a/components/clm/doc/UsersGuide/single_point.xml b/components/clm/doc/UsersGuide/single_point.xml new file mode 100644 index 0000000000..e4cf232a73 --- /dev/null +++ b/components/clm/doc/UsersGuide/single_point.xml @@ -0,0 +1,931 @@ + + + +How to run Single-Point/Regional cases + +The &clm; also allows you to set up and run cases with a single-point or a local region as well +as global resolutions. This is often useful for running quick cases for testing, evaluating +specific vegetation types, or land-units, or running with observed data for a specific site. +There are four different ways to do this: &PTSMODE;, +&CLM1PT;, &CLMUSRDAT;, and with &ptclm;. + +&PTSMODE; -- to run for a single point +using global datasets. +&CLM1PT; -- to run for a supported single-point +or regional dataset. +&CLMUSRDAT; -- to run using your own datasets (single-point +or regional). +&ptclm; -- to easily setup simulations to run for +tower sites.. + + + + +&PTSMODE; and &ptclm; only work for a single point, while the other two options can +also work for regional datasets as well. + + + +Which Single Point Option Should I choose? + +In general is the quick and dirty method +that gets you started without having to create datasets -- but has limitations. It's +good for an initial attempt at seeing results for a point of interest, but since you +can NOT restart with it, it's usage is limited. It is the quickest method as you can +create a case for it directly from create_newcase. Although you +can't restart, running a single point is very fast, and you can run for long +simulation times even without restarts. If you need restarts a good solution is to use +getregional_datasets.pl and &CLMUSRDAT; +which can get you running almost as quickly as well as +&PTSMODE;. Like +&PTSMODE; + only runs for points that exist within +a global dataset. + + +Running &CLM1PT; is a great solution, if one of the supported +single-point/regional datasets, is your region of interest (see +). All the datasets are +created for you, and you can easily select one and run, pretty much, out of the box +with it. The problem is that there is a very limited set of supported datasets. You +can also use this method for your own datasets, but you have to create the datasets, +and add them to the XML database and to the &datm;. This is worthwhile if you want to +repeat many multiple cases for a given point or region. + + +Next, &CLMUSRDAT; is the best way to setup cases quickly +where you have to create your own datasets (see +). With this method you don't have to +change &datm; or add files to the XML database -- but you have to follow a strict +naming convention for files. However, once the files are named and in the proper +location, you can easily setup new cases that use these datasets. This is good +for treating all the required datasets as a "group" and for a particular +model version. For advanced &clm; developers who need to track dataset changes with +different model versions you would be best off adding these datasets as supported +datasets with the &CLM1PT; method. + + +Lastly &ptclm; is a great way to easily create datasets, +setup simulations and run simulations for tower sites. It takes advantage of both +&CLM1PT; and &CLMUSRDAT; internally. A big advantage to it, is that it's one-stop +shopping, it runs tools to create datasets, and runs create_newcase +and sets the appropriate env variables for you. So you only have to learn how to run +one tool, rather than work with many different ones. &ptclm; is described in the next +chapter . + + +Finally, if you also have meteorology data that you want to force your &clm; simulations +with you'll need to setup cases as described in . +You'll need to create &clm; datasets either according to &CLM1PT; +or &CLMUSRDAT;, but you'll also need to modify &datm; to use +your forcing data. And you'll need to change your forcing data to be in a format that +&datm; can use. In the &ptclm; chapter the +section tells you how to use AmeriFlux data for atmospheric forcing. + + + + +Running &PTSMODE; configurations + +&PTSMODE; enables you to run the model using global datasets, but just picking a +single point from those datasets and operating on it. It can be a very quick way to do fast +simulations and get a quick turnaround. + + +To setup a &PTSMODE; simulation you use the "-pts_lat" and "-pts_lon" +arguments to create_newcase to give the latitude and longitude of the point you want to +simulate for (the code will pick the point on the global grid nearest to the point you +give. Here's an example to setup a simulation for the nearest point at 2-degree resolution +to Boulder Colorado. + +> cd scripts +> ./create_newcase -case testPTS_MODE -res f19_g16 -compset I -mach bluefire \ +-pts_lat 40.0 -pts_lon -105 +> cd testPTS_MODE +# We make sure the model will start up cold rather than using initial conditions +> ./xmlchange -file env_conf.xml -id &CLMFORCECOLD; -val on +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup + +Then configure, build and run as normal. We make sure initial conditions are NOT used +since &PTSMODE; currently CAN NOT run with initial conditions. + + + +By default it sets up to run with +USE_MPISERIAL (in the env_build.xml file) turned on, +which allows you to run the model interactively. On some machines this mode is NOT +supported and you may need to change it to FALSE before you are able to build. + + + + +&PTSMODE; currently does NOT restart nor +is it able to startup from global initial condition files. See bugs "1017 and 1025" +in the KnownLimitations file. + + + + +You can change the point you are simulating for at run-time by changing the values of +PTS_LAT and PTS_LON in the env_run.xml file. + + + + +Note, that when running with &PTSMODE; the number of processors +is automatically set to one. When running a single grid point you can only use a single +processor. You might also want to set the "env_conf" variable: USE_MPISERIAL to +TRUE so that you can also run interactively without having to use +&mpi; to start up your job. + + + + +Warning about Running with a Single-Processor on a Batch Machine + +This problem always comes up when running for a single point, because you can only use +a single-processor, but may come up in other instances when you are running with +one processor. This applies to all the different ways of running in single-point mode. + + + +A warning for submitting single-point simulations to the batch que when only using +one processor. On many machines this will mean using up at least an entire node, and +being charged for all the CPU's on that node even if you aren't using them. For example, +on the &ncar; machine bluefire, there are 32 processors for each node +and the batch scripts are setup to have exclusive use of that node (and hence be charged +for all 32 processors). There are similar issues on other machines, below we show you +what to do when running on bluefire. + + +To change this on bluefire -- change the following: + +#BSUB -q regular +#BSUB -N +#BSUB -x + +to... + +#BSUB -q share +#BSUB -N + +so remove the "#BSUB -x" which gives you the entire node exclusively, and change to the +share que. One other machines you may have to do something similar, but the particulars +depend on the given machine, hence you will need to consult with the system +administrators for the given machine you are running on. + + + + +Another similar problem on many machines is that some batch ques have a minimum number +of nodes or processors that can be used. On these machine you may have to change the +queue (in some way similar to the above for bluefire) and possibly the time-limits of +the job, to get it to run in the batch que. + + + +Another way to get around this problem is to run the job interactively using +USE_MPISERIAL so that you don't submit the job to the batch que. +For single point mode you also may want to consider using a smaller workstation or +cluster, rather than a super-computer, because you can't take advantage of the +multi-processing power of the super-computer anyway. + + + + +Running Supported Single-point/Regional Datasets + +In addition to &PTSMODE; the &clm; supports running using single-point or +regional datasets that are customized to a particular region. In the section below we +tell the user how to create their own dataset, but we also support a small number of +single-point and regional datasets that are ready to setup and run in the CESM modeling +system. + + +To get the list of supported dataset resolutions see the method�given in the +section on use of &CLM1PT;, which results in the following: + +&res_list; + +The resolution names that have an underscore in them ("_") are all single-point or +regional resolutions. +To run with the supported single-point and regional datasets, you setup a simulation for the +"pt1_pt1" resolution and give the short-name for the file to use in the +env_conf.xml file. + + +To run for the Brazil test site +do the following: + +Example of running &clm; over a single-point test site in Brazil +with the default Qian atmosphere data forcing. + + +> cd scripts +> ./create_newcase -case testSPDATASET -res pt1_pt1 -compset I \ +-mach bluefire +> cd testSPDATASET +# Configure to run for the test site +> set SITE=1x1_brazil +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-sitespf_pt $SITE" +> ./xmlchange -file env_conf.xml -id &CLM1PT; -val $SITE + + + + +Then configure, build and run normally. + + +Then to run for the urban Mexico City Mexico test site that also has atmosphere +forcing data, but to run it with the Qian forcing data, but over the period for +which it's own forcing data is provided do the following: + +Example of running &clm; over the single-point of Mexicocity Mexico +with the default Qian atmosphere data forcing. + + +> cd scripts +> ./create_newcase -case testSPDATASET -res pt1_pt1 -compset I \ +-mach bluefire +> cd testSPDATASET +# Set a variable to the site you want to use (as it's used several times below) +> set SITE=1x1_mexicocityMEX +# Configure to run for the urban test site +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-sitespf_pt $SITE" +> ./xmlchange -file env_conf.xml -id &CLM1PT; -val $SITE +# Set &datm; prescribed aerosols to single-point dataset +# Will then use the dataset with just the point for this $SITE +> ./xmlchange -file env_conf.xml -id DATM_PRESAERO -val pt1_pt1 +# +# Set some of the settings that are particular to this site, by values contained +# in the XML database. For some sites, or for new sites this information won't be +# stored. And the queryDefaultNamelist.pl command will abort. +# +# Set &datm; start and end range (optional just to run over the same years that +# atmospheric forcing data is available for this site) +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_START -val \ +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist default_settings -silent -var datm_cycle_beg_year -justvalue` +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_END -val \ +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist default_settings -silent -var datm_cycle_end_year -justvalue` + + + + +Then configure, build and run normally. + + + +Just like &PTSMODE; above, By default it sets up to run with +USE_MPISERIAL (in the env_build.xml file) turned on, +which allows you to run the model interactively. On some machines this mode is NOT +supported and you may need to change it to FALSE before you are able to build. + + + + +See for a warning about running single-point jobs +on batch machines. + + + + +Note, that when running a pt1_pt1 resolution the number of processors +is automatically set to one. When running a single grid point you can only use a single +processor. You might also want to set the "env_conf" variable: USE_MPISERIAL to +TRUE so that you can also run interactively without having to use +mpi to start up your job. + + + +Running Supported Single-point Datasets that have their own Atmospheric Forcing + +Of the supported single-point datasets we have three that also have atmospheric forcing data +that go with them: Mexico City (Mexico), Vancouver, (Canada, British Columbia), and +urbanc_alpha (test data for an Urban inter-comparison project). Mexico city and Vancouver +also have "#ifdef" in the source code for them to work with modified urban data +parameters that are particular to these locations. They can be turned on by using +the &CLMCONFIG; &envconf; variable to set the "-sitespf_pt" option in the &clm; +&configure;. To turn on the atmospheric forcing for these datasets, you set the +&envconf; DATM_MODE variable to "CLM1PT", and then the atmospheric +forcing datasets will be used for the point picked. + + +When running with datasets that have their own atmospheric forcing you need to be careful +to run over the period that data is available. If you have at least one year of forcing +it will cycle over the available data over and over again no matter how long of a simulation +you run. However, if you have less than a years worth of data (or if the start date doesn't +start at the beginning of the year, or the end date doesn't end at the end of the year) then +you won't be able to run over anything but the data extent. In this case you will need to +carefully set the RUN_STARTDATE, START_TOD and +STOP_N/STOP_OPTION variables for your case to run over the entire time extent +of your data. For the supported data points, these values are in the XML database +and you can use the queryDefaultNamelist.pl script to query the values +and set them for your case (they are set for the three urban test cases: Mexicocity, Vancouver, and +urbanc_alpha). + + +In the example below we will show how to do this for the Vancouver, Canada point. + + +Example of running &clm; over the single-point of Vancouver Canada with +supplied atmospheric forcing data for Vancouver. + + +> cd scripts +# Create a case at the single-point resolutions +> ./create_newcase -case testSPDATASETnAtmForcing -res pt1_pt1 -compset I \ +-mach bluefire +> cd testSPDATASETnAtmForcing +# Set a variable to the site you want to use (as it's used several times below) +> set SITE=1x1_vancouverCAN +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-sitespf_pt $SITE" +# Now set the CLM single-point variable to the site name +> ./xmlchange -file env_conf.xml -id &CLM1PT; -val $SITE +# Set the aerosols to use the single-point dataset for 2000 conditions +# You could also use the default global dataset, but running would be a bit slower +> ./xmlchange -file env_conf.xml -id DATM_MODE -val CLM1PT +# Set the coupling frequency to once an hour +> ./xmlchange -file env_conf.xml -id ATM_NCPL -val 24 +# Set the standard namelist options for an urban test site +> ./xmlchange -file env_conf.xml -id CLM_NML_USE_CASE -val stdurbpt +# Set many of the settings that are particular to this site, by values contained +# in the XML database. For some sites, or for new sites this information won't be +# stored. And the queryDefaultNamelist.pl command will abort. +# +# Set the start date +> setenv RUN_STARTDATE \ +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist default_settings -silent -var run_startdate -justvalue` +> setenv STARTDATE `echo $RUN_STARTDATE | sed s/-//g` +> @ START_YEAR = $STARTDATE / 10000 +> ./xmlchange -file env_conf.xml -id RUN_STARTDATE -val $RUN_STARTDATE +# Set the run length and start time of day +> ./xmlchange -file env_run.xml -id STOP_OPTION \ +-val `../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist seq_timemgr_inparm -silent -var stop_option -justvalue` +> setenv STOP_N \ +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist seq_timemgr_inparm -silent -var stop_n -justvalue` +> ./xmlchange -file env_run.xml -id STOP_N -val $STOP_N +> ./xmlchange -file env_run.xml -id START_TOD \ +-val `../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist seq_timemgr_inparm -silent -var start_tod -justvalue` +# Set &datm; start and end range... +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_START -val +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist default_settings -silent -var datm_cycle_beg_year -justvalue` +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_END -val +`../../models/lnd/clm/bld/queryDefaultNamelist.pl -res $SITE \ +-namelist default_settings -silent -var datm_cycle_end_year -justvalue` +# Set the User namelist to set the output frequencies of the history files +# Setting the stdurbpt use-case option create three history file streams +# The frequencies and number of time-samples needs to be set +> cat << EOF > &usernlclm; +&clm_inparm + hist_mfilt = $STOP_N,$STOP_N,$STOP_N + hist_nhtfrq = -1,-1,-1 +/ +EOF +# Set align year to start year as defined above +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_ALIGN -val $START_YEAR +# Set &datm; prescribed aerosols to single-point dataset +# Will then use the dataset with just the point for this site +> ./xmlchange -file env_conf.xml -id DATM_PRESAERO -val pt1_pt1 +> ./configure -case + + + + +If you don't set the start-year and run-length carefully as shown above the +model will abort with a "dtlimit error" in the atmosphere model (see bug 1110 in +the KnownLimitations file for documentation on this). Since, the forcing data for +this site (and the MexicoCity site) is less than a year, the model won't be able to +run for a full year. The 1x1_urbanc_alpha site has data for more +than a full year, but neither year is complete hence, it has the same problem (see the +problem for this site above). + + + + +Just like &PTSMODE; above, By default it sets up to run with +USE_MPISERIAL (in the env_build.xml file) turned on, +which allows you to run the model interactively. On some machines this mode is NOT +supported and you may need to change it to FALSE before you are able to build. + + + + +See for a warning about running single-point jobs +on batch machines. + + + + +Note, that when running a pt1_pt1 resolution the number of processors +is automatically set to one. When running a single grid point you can only use a single +processor. You might also want to set the "env_conf" variable: USE_MPISERIAL to +TRUE so that you can also run interactively without having to use +mpi to start up your job. + + + + + + +Creating your own single-point/regional surface datasets + +The file: +Quickstart.userdatasets in the +models/lnd/clm/doc directory gives guidelines on how to create and run +with your own single-point or regional datasets. Below we reprint the above guide. + +&quickstart_userdata; + + + + +Using getregional_datasets.pl to get a complete suite of single-point/regional +surface datasets from global ones + +Use the regional extraction script to get regional datasets from the global ones +The getregional_datasets.pl script to extract out regional datasets of interest. +Note, the script works on all files other than the "finidat" file as it's a 1D vector file. +The script will extract out a block of gridpoints from all the input global datasets, +and create the full suite of input datasets to run over that block. The input datasets +will be named according to the input "id" you give them and the id can then be used +as input to &CLMUSRDAT; to create a case that uses it. See +the section on &clm; Script Configuration Items for +more information on setting &CLMUSRDAT; (in ). The list of files extracted by +their name used in the namelists are: +fatmgrid, fatmlndfrc, +fsurdat, flanduse_timeseries, +flndtopo, +stream_fldfilename_ndep, and the &datm; files +domainfile, and faerdep. +For more information on these files see the Table on required files. + + +The alternatives to using this script are to use &PTSMODE;, +discussed earlier, to use &ptclm; discussed in the next chapter, or creating the files +individually using the different file creation tools (given in the +Tools Chapter). Creating +all the files individually takes quite a bit of effort and time. &PTSMODE; +has some limitations as discussed earlier, but also as it uses global files, is +a bit slower when running simulations than using files that just have the set +of points you want to run over. Another advantage is that once you've created the +files using this script you can customize them if you have data on this specific +location that you can replace with what's already in these files. + + +The script requires the use of both "Perl" and "NCL". See the NCL Script section in the Tools Chapter +on getting and using NCL and NCL scripts. The main script to use is a &perl; script +which will then in turn call the NCL script that actually creates the output files. +The ncl script gets it's settings from environment variables set by the perl script. +To get help with the script use "-help" as follows: + +> cd models/lnd/clm/tools/ncl_scripts +> ./getregional_datasets.pl -help + +The output of the above is: + +&getreg_datasets; + + + +The required options are: -id, +-ne, and -se, for the output identifier +name to use in the filenames, latitude and longitude of the Northeast corner, and +latitude and longitude of the SouthEast corner (in degrees). Options that specify +which files will be used are: -mask, -res, +-rcp, -sim_year, and -sim_yr_rng +for the land-mask to use, global resolution name, representative concentration pathway +for future scenarios, simulation year, and simulation year range. The location of the +input and output files will be determined by the option -mycsmdata +(can also be set by using the environment variable $CSMDATA). If +you are running on a machine like at &ncar; where you do NOT have write permission +to the CESM inputdata files, you should use the scripts/link_dirtree +script to create soft-links of the original files to a location that you can write +to. This way you can use both your new files you created as well as the original +files and use them from the same location. + + +The remaining options to the script are -debug, +and -verbose. -debug is used to show what +would happen if the script was run, without creating the actual files. +-verbose adds extra log output while creating the files so you +can more easily see what the script is doing. + + +For example, Run the extraction for data from 52-73 North latitude, 190-220 longitude +that creates 13x12 gridcell region from the f19 (1.9x2.5) global resolution over Alaska. + +Example of running <command>getregional_datasets.pl</command> to get +datasets for a specific region over Alaska + +> cd scripts +# First make sure you have a inputdata location that you can write to +# You only need to do this step once, so you won't need to do this in the future +> setenv MYCSMDATA $HOME/inputdata # Set env var for the directory for input data +> ./link_dirtree $CSMDATA $MYCSMDATA +> cd ../models/lnd/clm/tools/ncl_scripts +> ./getregional_datasets.pl -sw 52,190 -ne 73,220 -id 13x12pt_f19_alaskaUSA -mycsmdata $MYCSMDATA + + +Repeat this process if you need files for multiple sim_year, resolutions, land-masks, +and sim_year_range values. + + + +See for a warning about running single-point jobs +on batch machines. + + + + +See for notes about managing your data +when using link_dirtree. + + + +Now to run a simulation with the datasets created above, you create a single-point +case, and set &CLMUSRDAT; to the identifier used above. Note that in the example below +we set the number of processors to use to one (-pecount 1). For a single point, you +should only use a single processor, but for a regional grid, such as the example below +you could use up to the number of grid points (12x13=156 processors. + + +Example of using &CLMUSRDAT; to run a simulation using user datasets for a +specific region over Alaska + +> cd scripts +# Create the case and set it to only use one processor +> ./create_newcase -case my_userdataset_test -res pt1_pt1 -compset I1850 \ +-mach bluefire +> cd my_userdataset_test/ +> ./xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA +> ./xmlchange -file env_conf.xml -id &CLMUSRDAT; -val 13x12pt_f19_alaskaUSA +> ./xmlchange -file env_conf.xml -id &CLMBLDNML; -val '-mask gx1v6' +> ./xmlchange -file env_conf.xml -id &CLM1PT; -val 13x12pt_f19_alaskaUSA +> ./configure -case + + + + + + + +Running with your own atmosphere forcing + +Here we want to run with our own customized datasets for &clm; as well as +running with our own supplied atmosphere forcing datasets. Thus we effectively +combine the information from with +. First we need to follow +the procedures in to come up with &clm; +datasets that are customized for our point or region in question. This includes +running link_dirtree to create a directory location where you +can add your own files to it. Next, set +DATM_MODE to "CLM1PT" and &CLM1PT; and &CLMUSRDAT; to the +id of the data you created. To see a list of what the filenames need to be +see the section on setting &CLMUSRDAT;. + + +Next we need to setup the atmosphere forcing data in &netcdf; format that can be +read by &datm;. There is a list of eight variables that are expected to be on the input +files with the names and units on the following table (in the table TDEW and SHUM +are optional fields that can be used in place of RH). In the table we also list +which of the fields are required and if not required what the code will do to +replace them. If the names of the fields are different or the list is changed +from the standard list of eight fields: FLDS, FSDS, PRECTmms, +PSRF, RH, TBOT, WIND, and ZBOT, the resulting streams file will need to be modified +to take this into account (see an example streams file for this in below). + +Atmosphere Forcing Fields + + + + Short-name + Description + Units + Required? + If NOT required how replaced + + + + + FLDSincident longwave +(FLDS)W/m2No +calculates based on Temperature, Pressure and Humidity + + + FSDSincident solar +(FSDS)W/m2Yes- + + + FSDSdifincident solar (FSDS) +diffuseW/m2Nobased on FSDS + + + FSDSdirincident solar (FSDS) +directW/m2Nobased on FSDS + + + PRECTmmsprecipitation +(PRECTmms)mm/sYes- + + + PSRFpressure at the lowest atm level +(PSRF)PaNoassumes standard-pressure + + + RHrelative humidity at the lowest atm level +(RH)%Nocan be replaced with SHUM or TDEW + + + SHUMspecific humidity at the lowest atm level +kg/kgOptional in place of RHcan be replaced with RH or TDEW + + + TBOTtemperature at the lowest atm level +(TBOT)K (or can be C)Yes- + + + TDEWdew point temperature +K (or can be C)Optional in place of RHcan be replaced with RH or SHUM + + + WINDwind at the lowest atm level +(WIND)m/sYes- + + + ZBOTobservational heightmNo +assumes 30 meters + + + +
+All of the variables should be dimensioned: time, lat, lon, with time being the unlimited +dimension. The coordinate variable "time" is also required with CF-compliant units in +days, hours, minutes, or seconds. It can also have a calendar attribute that can +be "noleap" or "gregorian". Normally the files will be placed in the: +$MYCSMDATA/atm/datm7/CLM1PT_data/$MYUSRDAT directory with separate files per +month called YYYY-MM.nc where YYYY-MM corresponds to the four +digit year and two digit month with a dash in-between. You also need a domain file that +gives the coordinate information for the data that should be placed in: +$MYCSMDATA/atm/datm7/domain.lnd.$MYUSRDAT_USGS.nc. + +Example of setting up a case with your own atmosphere forcing + +> cd scripts +# First make sure you have a inputdata location that you can write to +# You only need to do this step once, so you won't need to do this in the future +> setenv MYCSMDATA $HOME/inputdata # Set env var for the directory for input data +> ./link_dirtree $CSMDATA $MYCSMDATA +# Next create and move all your datasets into $MYCSMDATA with id $MYUSRDAT +# See above for naming conventions + +# Now create a single-point case +> ./create_newcase -case my_atmforc_test -res pt1_pt1 -compset I1850 \ +-mach bluefire +> cd my_atmforc_test +# Set the data root to your inputdata directory, and set &CLM1PT; and &CLMUSRDAT; +# to the user id you created for your datasets above +> ./xmlchange -file env_run.xml -id DIN_LOC_ROOT_CSMDATA -val $MYCSMDATA +> ./xmlchange -file env_conf.xml -id &CLM1PT; -val $MYUSRDAT +> ./xmlchange -file env_conf.xml -id &CLMUSRDAT; -val $MYUSRDAT +# Set the land-mask to USGS, so both clm and &datm; can find files +> ./xmlchange -file env_conf.xml -id &CLMBLDNML; -val '-mask USGS' +# Then set DATM_MODE to single-point mode so &datm; will use your forcing datasets +# Put your forcing datasets into $MYCSMDATA/atm/datm7/CLM1PT_data/$MYUSRDAT +> ./xmlchange -file env_conf.xml -id DATM_MODE -val CLM1PT +> ./configure -case +# If the list of fields, or filenames, filepaths, or fieldnames are different +# you'll need to edit the &datm; namelist streams file to make it consistent +> $EDITOR Buildconf/datm.buildnml.csh + + + + + +See for a warning about running single-point jobs +on batch machines. + + + + +See for notes about managing your data +when using link_dirtree. + + + + +Now, we'll show an example of what the &datm; streams file might look like for a case +with your own forcing data with 3-hourly forcing. In this example, we'll leave off the +fields: ZBOT, and FLDS so they'll be calculated as given in the + table above. We'll also include: +FSDSdif and FSDSdir which aren't required, and we'll use TDEW in place of RH. In this +example the datafiles are in &netcdf; format and contain the fields: TA, Tdew, WS, +PREC, Rg, Rgdir, Rgdif, and PRESS which are translated into the &datm; internal names +in this streams file. There is also a domain file that has the position information +for this location. The normal assumption for CLM1PT mode in the &datm; is that data is +hourly or half-hourly and as such is often enough that using the data on the nearest +time-stamp is reasonable and as such the data is in a single streams file (see + for more information on +the default settings for &datm; and how to change them. If the data is less often three to six hours -- see +below, where you will need to modify the time-interpolation method as well as the +time stamp offsets. In the example below we also have to divide the single +stream file into three files to manage the time-stamps and time interpolation +algorithm for the different types of data differently. + +Example of &datm; streams files with your own forcing for 3-hourly data + +Precipitation streams file +(clm1PT.1x1pt_lapazMEX.precip.stream.txt file) . + + +<streamstemplate> +<stream> + <dataSource> + CLMNCEP + </dataSource> + <domainInfo> + <variableNames> + time time + xc lon + yc lat + area area + mask mask + </variableNames> + <filePath> + $DIN_LOC_ROOT/atm/datm7/domain.clm + </filePath> + <fileNames> + domain.lnd.1x1pt_lapazMEX_navy.nc + </fileNames> + </domainInfo> + <fieldInfo> + <variableNames> + PRECTmms PREC + </variableNames> + <offset> + -5400 + </offset> + <filePath> + $DIN_LOC_ROOT/atm/datm7/CLM1PT_data/1x1pt_lapazMEX + </filePath> + <fileNames> + 2004-01.nc + 2004-02.nc + 2004-03.nc +. +. +. + 2009-12.nc + </fileNames> + </fieldInfo> +</stream> +</streamstemplate> + + +Solar streams file (clm1PT.1x1pt_lapazMEX.solar.stream.txt file). + + +<streamstemplate> +<stream> + <dataSource> + CLMNCEP + </dataSource> + <domainInfo> + <variableNames> + time time + xc lon + yc lat + area area + mask mask + </variableNames> + <filePath> + $DIN_LOC_ROOT/atm/datm7/domain.clm + </filePath> + <fileNames> + domain.lnd.1x1pt_lapazMEX_navy.nc + </fileNames> + </domainInfo> + <fieldInfo> + <variableNames> + FSDS Rg + FSDSdir Rgdir + FSDSdif Rgdif + </variableNames> + <offset> + -10800 + </offset> + <filePath> + $DIN_LOC_ROOT/atm/datm7/CLM1PT_data/1x1pt_lapazMEX + </filePath> + <fileNames> + 2004-01.nc + 2004-02.nc + 2004-03.nc +. +. +. + 2009-12.nc + </fileNames> + </fieldInfo> +</stream> +</streamstemplate> + + +Other fields streams file. +(clm1PT.1x1pt_lapazMEX.other.stream.txt file) . + + +<streamstemplate> +<stream> + <dataSource> + CLMNCEP + </dataSource> + <domainInfo> + <variableNames> + time time + xc lon + yc lat + area area + mask mask + </variableNames> + <filePath> + $DIN_LOC_ROOT/atm/datm7/domain.clm + </filePath> + <fileNames> + domain.lnd.1x1pt_lapazMEX_navy.nc + </fileNames> + </domainInfo> + <fieldInfo> + <variableNames> + TBOT TA + TDEW Tdew + WIND WS + PSRF PRESS + </variableNames> + <offset> + -5400 + </offset> + <filePath> + $DIN_LOC_ROOT/atm/datm7/CLM1PT_data/1x1pt_lapazMEX + </filePath> + <fileNames> + 2004-01.nc + 2004-02.nc + 2004-03.nc +. +. +. + 2009-12.nc + </fileNames> + </fieldInfo> +</stream> +</streamstemplate> + + +Example streams namelist for the above streams files: + + + &shr_strdata_nml + dataMode = 'CLMNCEP' + domainFile = '$DOMAINFILE' + streams = 'clm1PT.1x1pt_lapazMEX.solar.stream.txt 1 2004 2009 ', + 'clm1PT.1x1pt_lapazMEX.precip.stream.txt 1 2004 2009 ', + 'clm1PT.1x1pt_lapazMEX.other.stream.txt 1 2004 2009 ', + 'presaero.stream.txt 1 2000 2000' + vectors = 'null','null','null','null' + mapmask = 'nomask','nomask','nomask','nomask' + mapalgo = 'nn','nn','nn','nn' + tintalgo = 'coszen','nearest','linear','linear' + taxmode = 'cycle','cycle','cycle','cycle' + / + + + + + +The example above shows the resolved namelist and streams file after &configure; +has been run. In order to save this configuration for future use, you would need +to edit the &datm; template adding new DATM_MODE see + for more information on how to do this. + + + + +We've outlined and given a few examples of using your own atmosphere +forcing. In the next chapter we go into the details of using &ptclm;. + + + + + + diff --git a/components/clm/doc/UsersGuide/special_cases.xml b/components/clm/doc/UsersGuide/special_cases.xml new file mode 100644 index 0000000000..ac5c7fef3b --- /dev/null +++ b/components/clm/doc/UsersGuide/special_cases.xml @@ -0,0 +1,916 @@ + + +How to run some special cases + +In this chapter we describe how to run some special cases that take more than one step +to do. The straightforward cases have compsets and/or build-namelist use-cases setup for +them or require simple editing of a single-case. All of the cases here require you +to do at least two simulations with different configurations, or require more complex +editing of the case (changing the streams files). + + +The nine cases we will describe are: + + + +Running with the prognostic crop model on + + + + +Running with the irrigation model on + + + + +Spinning up the Satellite Phenology Model (&clmsp; spinup) + + + + +Spinning up the biogeochemistry Carbon-Nitrogen Model (CN spinup) + + + + +Spinning up the Carbon-Nitrogen Dynamic Global Vegetation Model (CNDV spinup) + + + + +Running with MOAR data as atmospheric forcing to spinup the model + + + + +Running with your own previous simulation as atmospheric forcing to spinup the model + + + + +Doing perturbation error growth tests + + + + +Running stand-alone &clm; with transient historical &CO2; +concentration + + + + + + +The cases in this chapter are more sophisticated and require more technical knowledge +and skill than cases in previous chapters. The user should be very familiar with doing +simple cases before moving onto the cases described here. + + + +Running with the prognostic crop model on + + +In &clmcesm103; a prognostic crop model was added to &clm4;. The prognostic crop +model is setup to work with CN for present day conditions and we have surface +and initial condition datasets at f19 resolution. In order to use the initial condition +file, we need to set the RUN_TYPE to startup rather +than hybrid since the compset for f19 sets up to use an initial +condition file without crop active. To activate the crop model we simply add "-crop on" +to &CLMCONFIG;. + +Example Crop Simulation + +> cd scripts +> ./create_newcase -case CROP -res f19_g16 -compset ICN -mach bluefire +> cd CROP +# Append "-crop on" to &CLMCONFIG; in env_conf.xml (you could also use an editor) +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-crop on" -append +# Change to startup type so uses spunup initial conditions file for crop if it exists +# By default the model will do a hybrid startup with an initial condition file +# incompatible with the crop surface dataset. +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup +> ./configure -case +# Now build and run normally +> ./CROP.bluefire.build +> ./CROP.bluefire.submit + + + + + + +Running with the irrigation model on + + +In &clmcesm103; an irrigation model for generic crop was added to &clm4;. Currently, +irrigation and crop can NOT be used together see bug number 1326 in the +&KnownBugs; file. +The irrigation model is tuned to work only with &clmsp; see the caution below for +for more information on this. To turn on +irrigation we simply add "-irrig on" to &CLMBLDNML;. Just as in the crop example we +also change RUN_TYPE to startup so that we don't use +an initial condition file that is incompatible with irrigation. + +Example Irrigation Simulation + +> cd scripts +# Note here we do a &clmsp; simulation as that is what has been validated +> ./create_newcase -case IRRIG -res f19_g16 -compset I -mach bluefire +> cd IRRIG +# Append "-irrig on" to &CLMBLDNML; in env_conf.xml (you could also use an editor) +> ./xmlchange -file env_conf.xml -id &CLMBLDNML; -val "-irrig" -append +# Change to startup type so uses spunup initial conditions file for irrigation if it exists +# By default the model will do a hybrid startup with an initial condition file +# incompatible with the irrigation surface dataset. +> xmlchange -file env_conf.xml -id RUN_TYPE -val startup +> ./configure -case +# Now build and run normally +> ./IRRIG.bluefire.build +> ./IRRIG.bluefire.submit + + + + +We have only run the irrigation model with &clmsp; (i.e. without the CN model). We +recommend that if you want to run the irrigation model with CN, that you do a spinup +as outlined in the examples below. But, more than that you may need to make +the adjustments we discuss in . + + + + + + +Spinning up the Satellite Phenology Model (&clmsp; spinup) + + +To spin-up the &clmsp; model you merely need to run &clmsp; for 50 simulation +years starting from arbitrary initial conditions. You then use the final +restart file for initial conditions in other simulations. +Because, this is a straight forward operation we will NOT give +the details on how to do that here, but leave it as an exercise for the reader. +See the as an example of doing this +as the last step for &clmcn;. + + + + +Spinning up the biogeochemistry Carbon-Nitrogen Model (CN spinup) + +To get the &clmcn; model to a steady state, you first run it from arbitrary initial conditions +using the "accelerated decomposition spinup" (-ad_spinup in configure) mode for 600 simulation years. After +this you branch from this mode in the "exit spinup" (-exit_spinup in configure), run +for a simulation year, and then save a restart from that and use it as initial conditions +for further spinup of CN (at least 50 simulation years). + + +Spinup of &clmcn; + +AD_SPINUP + +For the first step of running 600 years in "-ad_spinup" mode, you will setup +a case, and then edit the values in env_conf.xml and +env_run.xml so that the right configuration is turned on and +the simulation is setup to run for the required length of simulation time. +So do the following: + +Example AD_SPINUP Simulation + +> cd scripts +> ./create_newcase -case CN_spinup -res f19_g16 -compset ICN -mach bluefire +> cd CN_spinup +# Append "-ad_spinup on" to &CLMCONFIG; in env_conf.xml +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-ad_spinup on" -append +# The following sets &CLMFORCECOLD; to "on" in env_conf.xml (you could also use an editor) +> ./xmlchange -file env_conf.xml -id &CLMFORCECOLD; -val on +# Make the output history files only annual, by adding the following to the &usernlclm; namelist +> echo '&clm_inparm hist_nhtfrq = -8760 /' > &usernlclm; +# Now configure +> ./configure -case +> ./xmlchange -file env_run.xml -id STOP_DATE -val 6010101 +# Now build +> ./CN_spinup.bluefire.build +# The following sets RESUBMIT to 30 times in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id RESUBMIT -val 30 +# The following sets STOP_OPTION to "nyears" in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_OPTION -val nyears +# The following sets STOP_N to 20 years in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_N -val 20 +# The following sets STOP_DATE to Jan/1 of year 601 in env_run.xml (you could also use an editor) +# Now run normally +> ./CN_spinup.bluefire.submit + + +Afterwards save the last restart file from this simulation to use in the next step. + + + + +EXIT_SPINIP + + +Example EXIT_SPINUP Simulation + +> cd scripts +> ./create_newcase -case CN_exitspinup -res f19_g16 -compset ICN -mach bluefire +> cd CN_exitspinup +# Append "-exit_spinup on" to &CLMCONFIG; in env_conf.xml +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-exit_spinup on" -append +# Change run type to branch and branch from the last year of the last simulation +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val branch +> ./xmlchange -file env_conf.xml -id RUN_REFCASE -val CN_spinup +> ./xmlchange -file env_conf.xml -id RUN_REFDATE -val 0601-01-01 +> ./xmlchange -file env_conf.xml -id GET_REFCASE -val FALSE +> ./configure -case +# Go ahead and build, so that the run directory is created +> ./CN_exitspinup.bluefire.build +# Now, Copy the last restart files from the earlier case into your run directory +> cp /ptmp/$LOGIN/archive/CN_spinup/rest/CN_spinup.*.r*.0601-01-01-00000* /ptmp/$LOGIN/CN_exitspinup +# And copy the rpointer files for datm and drv from the earlier case +> cp /ptmp/$LOGIN/archive/CN_spinup/rest/rpointer.atm /ptmp/$LOGIN/CN_exitspinup +> cp /ptmp/$LOGIN/archive/CN_spinup/rest/rpointer.drv /ptmp/$LOGIN/CN_exitspinup +# The following sets STOP_OPTION to "nyears" in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_OPTION -val nyears +> ./xmlchange -file env_run.xml -id STOP_N -val 1 +# Now run normally +> ./CN_exitspinup.bluefire.submit + + + + + + +Final spinup + +Next save the last restart file from this step and use it as the "finidat" file to +use for one more spinup for at least 50 years in normal mode. +So do the following: + +Example Final CN Spinup Simulation + +> cd scripts +> ./create_newcase -case CN_finalspinup -res f19_g16 -compset ICN -mach bluefire +> cd CN_finalspinup +# The following sets &CLMFORCECOLD; to "on" in env_conf.xml (you could also use an editor) +> ./xmlchange -file env_conf.xml -id &CLMFORCECOLD; -val on +# Now, Copy the last &clm; restart file from the earlier case into your run directory +> cp /ptmp/$LOGIN/archive/CN_exitspinup/rest/CN_exitspinup.clm*.r*.0602-01-01-00000.nc \ +/ptmp/$LOGIN/CN_finalspinup +# And copy the rpointer files for datm and drv from the earlier case +> cp /ptmp/$LOGIN/archive/CN_exitspinup/rest/rpointer.atm /ptmp/$LOGIN/CN_finalspinup +> cp /ptmp/$LOGIN/archive/CN_exitspinup/rest/rpointer.drv /ptmp/$LOGIN/CN_finalspinup +# Set the finidat file to the last restart file saved in previous step +> echo '&clm_inparm finidat = "CN_exitspinup.clm2.r.0602-01-01-00000.nc" /' > &usernlclm; +# Now configure +> ./configure -case +> $EDITOR Buildconf/clm.buildnml.csh +> Now build +> .CN_finalspinup.bluefire.build +# The following sets RESUBMIT to 5 times in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id RESUBMIT -val 5 +# The following sets STOP_OPTION to "nyears" in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_OPTION -val nyears +# The following sets STOP_N to 10 years in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_N -val 10 +> Now run as normal +> .CN_finalspinup.bluefire.submit + + + + +To assess if the model is spunup plot trends of CN variables of interest. If you see +a trend, you may need to run the simulation longer. +Finally save the restart file from the end of this simulation to use as an "finidat" file for future +simulations. + + + + + + +Spinning up the Carbon-Nitrogen Dynamic Global Vegetation Model (CNDV spinup) + +To spinup the &clm; CNDV model -- you first follow the procedures above to spinup the CN model. +Then you take the CN initial state file you created for the spinup with just CN, and +run CNDV for 200 more years. +We've provided such spunup files for two resolutions (f09 and f19) and two time-periods +(1850 and 2000), so in this example we will use the files provided to start from. +We've also provided a spinup file at f19 resolution for CNDV, hence the following is +NOT required when running at f19. +If you were to start from your own &clmcn; spunup files -- the procedure would require +some modification. +There are no compsets using CNDV, so in +env_conf.xml change CLM_CONFIG_OPTS to +-bgc cndv. + +Example CNDV Spinup Simulation + +> cd scripts +> ./create_newcase -case CNDV_spinup -res f09_g16 -compset ICN -mach bluefire +> cd CNDV_spinup +# Set run type to startup and do a cold start +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup +# The following sets CLM_CONFIG_OPTS to "-bgc cndv" in env_conf.xml (you could also use an editor) +> ./xmlchange -file env_conf.xml -id CLM_CONFIG_OPTS -val "-bgc cndv" +# Make the default primary history file annual and add an annual 1D vector auxiliary file +# By putting the following in a &usernlclm; file. +> cat << EOF > &usernlclm; +&clm_inparm + hist_nhtfrq = -8760, -8760 + hist_mfilt = 1, 1 + hist_fincl2 = 'TLAI', 'TSAI', 'HTOP', 'HBOT', 'NPP' + hist_dov2xy = .true., .false. +/ +> ./configure -case +# NOTE: If you were using your own CN spinup files you would edit the namelist to use it +# $EDITOR Buildconf/clm.buildnml.csh +# +# Now build and run as normal +> ./CNDV_spinup.bluefire.build +# The following sets RESUBMIT to 10 times in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id RESUBMIT -val 10 +# The following sets STOP_OPTION to "nyears" in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_OPTION -val nyears +# The following sets STOP_N to 20 years in env_run.xml (you could also use an editor) +> ./xmlchange -file env_run.xml -id STOP_N -val 20 +# Make sure you turn archiving on, so you save your files to long term archival +> ./xmlchange -file env_run.xml -id DOUT_L_MS -val TRUE +> ./CNDV_spinup.bluefire.submit + + + + + +There is a build bug with &clmcesm103; see bug 1370 in the &KnownBugs; on +how to address this. + + + + + +In a data analysis tool you should examine the auxiliary file and examine the +pfts1d_wtgcell to see where and what types of vegetation have +been established. See the caution in for more +information on visualizing and analyzing 1D vector fields. + + + +CNDV also writes out two vector fields to "hv" auxiliary files, on an annual basis by +default. + + + + +We've provided a spinup file for CNDV at f19 resolution, you could also use +interpinic to interpolate this file to other resolutions. + + + + + +Running with MOAR data as atmospheric forcing to spinup the model + +Because it takes so long to spinup the CN model (as we just saw previously), if you +are doing fully coupled simulations with active atmosphere and ocean, you will want +to do the spinup portion of this "offline". So instead of doing expensive fully +coupled simulations for the spinup duration, you run &clm; in a very cheap "I" +compset using atmospheric forcing from a shorter fully coupled simulation +(or a simulation run previously by someone else). + + +In this example we will use the I1850SPINUPCN compset to setup +&clm; to run with atmospheric forcing from a previous fully coupled simulation with +data that is already stored on disk on bluefire. There are several simulations that +have high frequency data for which we can do this. You can also do this on a machine +other than bluefire, but would need to download the data from the Earth System Grid and +change the datapath similar to . +This compset is designed for constant +1850 conditions, but unfortunately (because of bug 1354 see the &KnownBugs; file) by +default it points to a transient simulation instead of an 1850 simulation. Here we +point to an 1850 simulation and setup the forcing years to run over. + +Example Simulation with MOAR Data on bluefire + +> cd scripts +> ./create_newcase -case MOARforce1850 -res f19_g16 -compset I1850SPINUPCN -mach bluefire +> cd MOARforce1850 +# The following sets the casename to point to for atm forcing (you could also use an editor) +> ./xmlchange -file env_conf.xml -id DATM_CPL_CASE -val b40.1850.track1.1deg.006a +# The following sets the align year and years to run over for atm forcing +# (you could also use an editor) +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_ALIGN -val 1 +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_START -val 960 +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_END -val 1030 +> ./configure -case +# Now build and run as normal +> ./MOARforce1850.bluefire.build +> ./MOARforce1850.bluefire.submit + + + + +Because of bug 1339 (see the &KnownBugs; file on this) +you can't run with 83 or more years of forcing. If you do need to run with more years of +forcing, you'll need to address the issue as outlined in the &KnownBugs; file. + + + + + + +Running with your own previous simulation as atmospheric forcing to spinup the model + +Another way that you might want to spinup the model is to run your own simulation +for a relatively short period (either a B, E, or F compset) and then use it as forcing +for your "I" case later. By only running 20 to 50 years for the fully coupled case, +you'll save a substantial amount of computer time rather than running the entire spinup +period with a fully coupled model. + + +The first thing we need to do is to run a fully coupled case and save the atmospheric +coupling fields on a three hourly basis. In this example, we will run on bluefire +and archive the data to a local disk that we can then use in the next simulation. + +Example Fully Coupled Simulation to Create Data to Force Next Example Simulation + +> cd scripts +> ./create_newcase -case myBCN1850 -res f09_g16 -compset B1850CN -mach bluefire +> cd myBCN1850 +> ./configure -case +# Set histaux_a2x3hr to .true. in cpl.buildnml.csh so output from the atmosphere model +# will be saved 3 hourly +$EDITOR BuildConf/cpl.buildnml.csh +# Now build +> ./myBCN1850.bluefire.build +# The following sets the archival disk space (you could also use an editor) +> ./xmlchange -file env_run.xml -id DOUT_S_ROOT -val '/glade/home/$USER/$CASE' +# Make sure files are archived to disk, but NOT to long term storage +# (you could also use an editor) +> ./xmlchange -file env_run.xml -id DOUT_S -val TRUE +> ./xmlchange -file env_run.xml -id DOUT_L_MS -val FALSE +# Set the run length to run a total of 20 years (you could also use an editor) +> ./xmlchange -file env_run.xml -id RESUBMIT -val 9 +> ./xmlchange -file env_run.xml -id STOP_OPTION -val nyears +> ./xmlchange -file env_run.xml -id STOP_N -val 2 +# Now run as normal +> ./myBCN1850.bluefire.submit + + + + +Now we run an I compset forced with the data from the previous simulation using +the &CPLHIST; option to DATM_MODE. See + for more information on the +&datm; settings for &CPLHIST; mode. + +Example Simulation Forced with Data from the Previous Simulation + +> cd scripts +> ./create_newcase -case frcwmyBCN1850 -res f09_g16 -compset I1850SPINUPCN -mach bluefire +> cd frcWmyBCN1850 +# The following sets the casename to point to for atm forcing (you could also use an editor) +> ./xmlchange -file env_conf.xml -id DATM_CPL_CASE -val "myBCN1850" +# The following sets the align year and years to run over for atm forcing +# (you could also use an editor) +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_ALIGN -val "1" +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_START -val "1" +> ./xmlchange -file env_conf.xml -id DATM_CPL_YR_END -val "20" +# Set the datapath in the template to the archival path from the case above +> sed -E 's#set datapath = ".+"#set datapath = "/glade/home/$USER/%c/cpl/hist"#' \ + Tools/Templates/datm.cpl7.template > new.datm.cpl7.template +> mv -f new.datm.cpl7.template Tools/Templates/datm.cpl7.template +> chmod +x Tools/Templates/datm.cpl7.template +> ./configure -case +# Now build and run as normal +> ./frcwmyBCN1850.bluefire.build +> ./frcwmyBCN1850.bluefire.submit + + + + +In order to accomplish this we needed to edit the &datm; template file. See + for more information on doing this. +If your input case was at a resolution besides f09 you would have to edit +the &datm; template file even further to use a domain file at the input resolution. + + + + + + +Doing perturbation error growth tests + +Doing perturbation error growth tests is a way to validate a port of +the model to a new machine or to verify that changes are only roundoff. +The steps are the same in either case, but in the discussion below I will +assume you are doing a port validation to a new machine (but in parentheses +I will put a reminder that it could also be for code-mods). +The basic idea is to run a case on the trusted machine (trusted code) and +another with initial conditions perturbed by roundoff and compare the results of +the two. The difference between these two simulations (the error) will grow over time +and describe a curve that we compare with the error growth on the new machine (code +changes). The error growth on the new machine is the difference between the non-perturbed +state on the trusted machine and the non-perturbed state on the new machine (code +changes). If the new machine (code changes) are well-behaved +the plot of this error growth compared to the error growth curve on the trusted machine +should be similar. If the +changes are NOT well-behaved the changes from the new machine (code changes) will be +larger than the perturbation changes. In summary the simulations and steps that need to be performed are: + + +Run a simulation with the trusted code on the trusted machine. +(optionally you can use a dataset from inputdata repository). + + + +Run a simulation with the trusted code on the trusted machine with initial conditions +perturbed by roundoff (using a namelist item to do so). +(this is optional is you are using inputdata repository datasets) + + + +Run a simulation with the new code on the non-trusted machine (code changes). + + +Do a plot of the RMS difference of history variables between simulation 1 and simulation 2. + + +Do a plot of the RMS difference of history variables between simulation 1 and simulation 3. + + +Compare the two plots in steps 4 and 5. + + +If the plots compare well the new machine (code changes) is running as well as the trusted machine. + + +If the plots do NOTcompare well the new machine is +NOTrunning as well as the trusted machine. Typically the +recommendation here is to lower the optimization level on the new machine and try +again (or in the case of code changes, modify or simplify the code changes to get +something that should be closer). + +The history variables we have used to do this is either 'TSOI', and/or 'TSA'. 'TSOI' are +the 3D snow and soil temperatures for vegetated land-units. If there is a change in +soil physics it should show up in this field (and it should show up even for something +that is at a pretty deep soil depth). However, as 'TSOI' is only for vegetated +land-units, changes in lake or urban land-units -- will NOT show up. 'TSA' by contrast is +the 2m surface temperature across all land-units, so changes in urban or lake land-units +will show up. However, changes in deep soil physics will only show up as it propagates +to the surface. So one field may show something that the other doesn't. In the examples, +we use 'TSOI', but 'TSA' can be used as well. And in most cases you should check both. + + + +Now we will give a detailed description of the procedure with examples and the +exact steps to perform. + + +Using Perturbation Error Growth Analysis to Verify a Port to a New Machine + +Running non-perturbed on trusted machine + +The first step is to run a non-perturbed case on the trusted machine. You need to run +all of the steps with the same compset and same resolution. For these examples we will +use 2-degree resolution with the ICN compset for 2000 conditions. You need to run for +three days with a cold-start. + + + +As we describe below, This is optional if you will be using datasets from the +inputdata repository to take place of this step. + + + + +Example non-perturbed error growth simulation + +> cd scripts +> ./create_newcase -case trustedMachinePergro0 -compset ICN -res f19_g16 \ +-mach bluefire +> cd trustedMachinePergro0 +# Set the non-perturbed PERGRO use-case +> ./xmlchange -file env_conf.xml -id CLM_NML_USE_CASE -val pergro0_pd +# Set coldstart on so arbitrary initial conditions will be used +> ./xmlchange -file env_conf.xml -id CLM_FORCE_COLDSTART -val on +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup +# Set PERGRO on in the configure +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-pergro on" -append +# Now configure and build +> ./configure -case +> ./trustedMachinePergro0.bluefire.build +# Set it to run for three days and turn archiving off +> ./xmlchange -file env_run.xml -id STOP_N -val 3 +> ./xmlchange -file env_run.xml -id DOUT_S -val FALSE +# Run the case and then you will save the history file output for later use +> ./trustedMachinePergro0.bluefire.submit + + + + + +If you aren't able to do this step, as you don't have access to a trusted machine, you +can use datasets that are available from the svn inputdata repository to take place of +running it yourself. The disadvantage is that this is only done for certain model +versions and for exactly the configuration/namelist given here. You won't be able to +test it for your own custom code or configurations. + + + + +Running perturbed on the trusted machine + +The next step is to run a perturbed case on the trusted machine. + +Example perturbed error growth simulation + +> cd scripts +> ./create_newcase -case trustedMachinePergroRnd -compset ICN -res f19_g16 \ +-mach bluefire +> cd trustedMachinePergroRnd +# Set the perturbed PERGRO use-case +> ./xmlchange -file env_conf.xml -id CLM_NML_USE_CASE -val pergro_pd +# Set coldstart on so arbitrary initial conditions will be used +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup +> ./xmlchange -file env_conf.xml -id CLM_FORCE_COLDSTART -val on +# Set PERGRO on in the configure +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-pergro on" -append +# Now configure and build +> ./configure -case +> ./trustedMachinePergroRnd.bluefire.build +# Set it to run for three days and turn archiving off +> ./xmlchange -file env_run.xml -id STOP_N -val 3 +> ./xmlchange -file env_run.xml -id DOUT_S -val FALSE +# Run the case and then you will save the history file output for later use +> ./trustedMachinePergroRnd.bluefire.submit + + + + + +If you aren't able to do this step, as you don't have access to a trusted machine, you +can use datasets that are available from the svn inputdata repository to take place of +running it yourself. The disadvantage is that this is only done for certain model +versions and for exactly the configuration/namelist given here. You won't be able to +test it for your own custom code or configurations. + + + + +Running non-perturbed on the new machine + +The next step is to run a non-perturbed case on the new machine. Here +we will demonstrate using the machine intrepid. For the previous two steps +you have the option of using datasets provided in the subversion inputdata +repository to take their place -- however this step is required. + +> cd scripts +> ./create_newcase -case newMachinePergro0 -compset ICN -res f19_g16 \ +-mach intrepid +> cd newMachinePergro0 +# Set the non-perturbed PERGRO use-case +> ./xmlchange -file env_conf.xml -id CLM_NML_USE_CASE -val pergro0_pd +> ./xmlchange -file env_conf.xml -id CLM_FORCE_COLDSTART -val on +> ./xmlchange -file env_conf.xml -id RUN_TYPE -val startup +# Set PERGRO on in the configure +> ./xmlchange -file env_conf.xml -id &CLMCONFIG; -val "-pergro on" -append +# Now configure and build +> ./configure -case +> ./newMachinePergro0.intrepid.build +# Set it to run for three days and turn archiving off +> ./xmlchange -file env_run.xml -id STOP_N -val 3 +> ./xmlchange -file env_run.xml -id DOUT_S -val FALSE +# Run the case and then you will save the history file output for later use +> ./newMachinePergro0.intrepid.submit + + + + + +Plotting the differences + +You can use the cprnc program to compute root mean square differences +between the relevant history files. See for more information +on it and how to build it. On many platforms you will need to set some environment +variables in order to complete the build (see for +more information on building the tools). + +# Build the cprnc program +> cd models/lnd/clm/tools/cprnc +> gmake +# Now go to your case directory and run cprnc on the trusted-machine with and without +# perturbation +> cd ../../../../../scripts/trustedMachinePergro0 +> ../../models/lnd/clm/tools/cprnc/cprnc trustedMachinePergro0.clm2.h0.001-01-01.00000.nc \ +../trustedMachinePergroRnd/trustedMachinePergroRnd.clm2.h0.001-01-01.00000.nc > trustedPergro.log +# Copy the history file from the new machine to here +# +# And now run cprnc on the trusted-machine and the new machine both without perturbation +> ../../models/lnd/clm/tools/cprnc/cprnc trustedMachinePergro0.clm2.h0.001-01-01.00000.nc \ +../newMachinePergro0/newMachinePergro0.clm2.h0.001-01-01.00000.nc > newPergro.log +# Now extract out the RMS differences of TSOI for both +# You may want to extract out the RMS differences for TSA as well +# Changes in urban or lake land-units won't be detected with TSOI +> grep "RMS TSOI" trustedPergro.log | awk '{print $3}' > RMStrusted.dat +> grep "RMS TSOI" newPergro.log | awk '{print $3}' > RMSnewmachine.dat +# And plot the two curves up to your screen +> env TYPE=x11 RMSDAT=RMSnewmachine.dat RMSDAT2=RMStrusted.dat ncl \ +../../models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl + +Here is a sample plot for several trusted machines: bluefire, intrepid, jaguar, +and edinburgh (with both the lahey and intel compilers). +The green line is the error growth for bluefire, the red is the error growth +for intrepid, the dashed navy is for jaguar, the dashed maroon is for the intel +compiler on edinburgh, and the thick dashed goldenrod line is for edinburgh with the +lahey compiler. Note, the data for this plot is in +models/lnd/clm/tools/ncl_scripts the files are named: +according to the legend. Note, that the lines tend to cluster together and follow +quite closely to the bluefire line which is our main trusted machine. +
+Sample Good Perturbation Error Growth Curves (within roundoff) + + + +
+ + + +When you do NOT have access to a trusted machine you can use the trusted file from +bluefire that is available on the inputdata repository. + +# Build the cprnc program +> cd models/lnd/clm/tools/cprnc +> gmake +# Get the unperturbed file from the subversion repository +> cd ../../../../../scripts/newMachinePergro0 +> set dir = "lnd/clm2/pergrodata" +> set file = bluefirePergro0.ICN.0001-01-01_1.9x2.5_gx1v6_simyr2000_clm4-cesm1_0_3.c110617.nc +> echo "trustedfile = DIN_LOC_ROOT/$dir/$file" > clm.input_data_list +> ../ccsm_utils/Tools/check_input_data -datalistdir . -export -inputdata $DIN_LOC_ROOT +# And now run cprnc on the bluefire file and the new machine both without perturbation +> ../../models/lnd/clm/tools/cprnc/cprnc $file \ +../newMachinePergro0/newMachinePergro0.clm2.h0.001-01-01.00000.nc > newPergro.log +# Now extract out the RMS difference +# You may want to extract out the RMS differences for TSA as well +# Changes in urban or lake land-units won't be detected with TSOI +> grep "RMS TSOI" newPergro.log | awk '{print $3}' > RMSnewmachine.dat +# And plot the new curve versus the trusted curve up to your screen +> env TYPE=x11 RMSDAT=RMSnewmachine.dat \ +RMSDAT2=../../models/lnd/clm/tools/ncl_scripts/RMSbluefire.dat \ +../../models/lnd/clm/tools/ncl_scripts/pergroPlot.ncl + + + +In the figure below we now show example of curves for changes that are larger than +roundoff. Once again the green curve is the trusted error growth from bluefire. The +other curves are for changes that may be fairly small, but are larger than roundoff. The +goldenrod curve is for using the 1850, and the navy is for using the 1999 Nitrogen +deposition files rather than for year 2000. The red is for using the 1850 aerosol +dataset rather than 2000, and the maroon is for adding the snow combination bug in. The +differences in changes that are greater than roundoff is that the curves climb very +steeply to the 10-6 value and then level off, while the +curve for bluefire climbs much more slowly and gradually. The curves also don't mimic +each other in any way, like the trusted machine plots do. +
+Sample Bad Perturbation Error Growth Curves (changes greater than roundoff) + + + +
+ + + + + + + +Running stand-alone &clm; with transient historical &CO2; +concentration + +In this case you want to run a simulation with stand-alone &clm; responding +to changes in &CO2; for a historical period. +For this example, we will start with the "I_1850-2000_CN" compset that +has transient: land-use, Nitrogen and Aerosol deposition already. You could +also use another compset if you didn't want these other features to be transient. +In order to get &CO2; to be transient we need to edit the +&datm; template so that we add an extra streams file to describe how +&CO2; varies over the historical period. You also need +a &netcdf; datafile that datm can read that gives the variation. You could +supply your own file, but we have a standard file that is used by CAM for this +and our example will make use of this file. + + + +Most everything here has to do with changing datm rather than &clm; +to allow this to happen. As such the user that wishes to do this should +first become more familiar with datm and read the +&cesm; Data +Model User's Guide especially as it pertains to the datm. Note, also +that in this example we show how to edit the datm "buildnml" file for your +case, but you could do something similar by editing the datm template. + + + + +This section documents the process for doing something that is non-standard. +There may be errors with the documentation and process, and you may have to do +some work before all of this works for you. If that is the case, we recommend +that you do further research into understanding the process and the files, as +well as understanding the datm and how it works. You may have to read documentation +found in the code for datm as well as "csm_share". + + + +The datm has "streams" files that have rough XML-like syntax and specify the +location and file to get data from, as well as information on the variable names +and the data locations of the grid points. The datm expects specific variable names +and the datm "maps" the expected variable names from the file to the names expected +by datm. The file we are working with here is a file with a single-point, that covers +the entire globe (so the vertices go from -90 to 90 degrees in latitude and 0 to 360 +degrees in longitude). Since it's a single point it's a little easier to work with +than datasets that may be at a given horizontal resolution. The datm also expects +that variables will be in certain units, and only expects a limited number of +variables so arbitrary fields can NOT be exchanged this way. However, the process +would be similar for datasets that do contain more than one point. + + +The three things that are needed: a domain file, a data file, and a streams text file. +The domain file is a CF-compliant &netcdf; file that has information +on the grid points (latitudes and longitudes for cell-centers and vertices, mask +, fraction, and areas). The datafile is a CF-compliant &netcdf; file with the data that +will be mapped. The streams text file is the XML-like file that tells datm how to find +the files and how to map the variables datm knows about to the variable names on the +&netcdf; files. Note, that in our case the domain file and the data file are the same +file. In other cases, the domain file may be separate from the data file. + + +First we are going to create a case, and we will edit +the Buildconf/datm.buildnml.csh so that we add a +&CO2; data stream in. There is a streams text file +available in models/lnd/clm/doc/UsersGuide/co2_streams.txt, +that includes file with a &CO2; time-series from 1765 to 2007. + +Example Transient Simulation with Historical &CO2; + +> cd scripts +> ./create_newcase -case DATM_CO2_TSERIES -res f19_g16 -compset I_1850-2000_CN \ +-mach bluefire +> cd DATM_CO2_TSERIES +# Set CCSM_BGC to CO2A so that CO2 will be passed from atmosphere to land +> ./xmlchange -file env_conf.xml -id CCSM_BGC -val CO2A +# Set CLM_CO2_TYPE to diagnostic so that the land will use the value sent from the atmosphere +> ./xmlchange -file env_conf.xml -id CLM_CO2_TYPE -val diagnostic +> ./configure -case +> cd Buildconf +# Copy the sample streams file over +> cp ../../../models/lnd/clm/doc/UsersGuide/co2_streams.txt . + + +The first thing we will do is to edit the datm buildnml script to add +a CO2 file stream in. To do this we will apply a patch with the differences +needed. The patch file addco2_datm.buildnml.diff is +in models/lnd/clm/doc/UsersGuide and looks like this... + +&co2streams_diff; + +So to apply the patch you do this... + +> cd scripts/DATM_CO2_TSERIES/Buildconf +> patch < ../../../models/lnd/clm/doc/UsersGuide/addco2_datm.buildnml.diff + +Once, you've done that you can build and run your case normally. + + + +The patch assumes you are using a I_1850-2000_CN compset out of the box, with +DATM_PRESAERO equal to trans_1850-2000. So it assumes standard +Qian atmosphere forcing, and transient prescribed aerosols from streams files. If your case changes +anything here the patch will fail, and you will need to put the changes in by hand. + + + + + +If the patch fails, you will have to add the changes to the +datm.buildnml.csh found in the above +patch file by hand. Basically, it adds an extra streams file for &CO2; to the end of the streams variable, +and other arrays associated with streams (adding mapalgo as a new array with bilinear for everything, but +the &CO2; file which should be "nn" for nearest neighbor). + + + + + +The streams file above is hard-coded for the path of the file on &ncar; computers. To use it on an outside +machine you'll need to edit the filepath in the streams file to point to the location where you have the file. + + + + +After going through these steps, you will have a case where you have datm reading +in an extra streams text file that points to a data file with &CO2; +data on it that will send that data to the &clm;. + + + + diff --git a/components/clm/doc/UsersGuide/stylesheethtml2docbook.xsl b/components/clm/doc/UsersGuide/stylesheethtml2docbook.xsl new file mode 100644 index 0000000000..13c30ff71d --- /dev/null +++ b/components/clm/doc/UsersGuide/stylesheethtml2docbook.xsl @@ -0,0 +1,579 @@ + + + + + +wb +file:///epicuser/AISolutions/graphics/AIWorkbench/ + + + + + + + + + + <xsl:value-of select=".//html:h1[1] + |.//html:h2[1] + |.//html:h3[1]"/> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + _ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + inlinemediaobject + + mediaobject + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Matched +
+ +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + No template for + + + + + + No template for + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ +
+ + + + + + + + _ + + + + + + + + + + + + + + _ + + + + + + + + + + + + + + + + + + + + + + + + + <xsl:value-of select=".//html:caption"/> + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Attempting to count columns on a non-table element + + + Row parameter is not a valid row + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/clm/doc/UsersGuide/tools.xml b/components/clm/doc/UsersGuide/tools.xml new file mode 100644 index 0000000000..d89006c371 --- /dev/null +++ b/components/clm/doc/UsersGuide/tools.xml @@ -0,0 +1,1395 @@ + + +Using the &clm; tools to create your own input datasets + +There are several tools provided with &clm; that allow you to create your own input +datasets at resolutions you choose, or to interpolate initial conditions to a different +resolution, or used to compare &clm; history files between different cases. The tools are +all available in the models/lnd/clm/tools directory. Most of the tools +are &FORTRAN; stand-alone programs in their own directory, but there is also a suite of +&ncl; +scripts in the ncl_scripts directory. Some of the &ncl; scripts are +very specialized and not meant for general use, and we won't document them here. They +still contain documentation in the script itself and the README file in the tools +directory. But, the list of generally important scripts and programs are: + + + cprnc to compare &netcdf; files with a time axis. + + + interpinic to interpolate initial condition files. + + + mkgriddata to create grid datasets. + + + mkdatadomain to create domain files from grid datasets +used by &datm; or docn. + + + mksurfdata to create surface datasets from grid datasets. + + + ncl_scripts/getregional_datasets.pl script to extract a +region or a single-point from global input datasets. See the single-point chapter +for more information on this. + + + ncl_scripts/npdepregrid.ncl interpolate the Nitrogen +deposition datasets to a new resolution. + + + ncl_scripts/aerdepregrid.ncl interpolate the Aerosol +deposition datasets to a new resolution. + + + + + +In the sections to come we will go into detailed description of how to use each of +these tools in turn. First, however we will discuss the common environment variables +and options that are used by all of the &FORTRAN; tools. Second, we go over the outline +of the entire file creation process for all input files needed by &clm; for a new +resolution, then we turn to each tool. In the last section we will +discuss how to customize files for particular observational sites. + + + +Common environment variables and options used in building the &FORTRAN; +tools + +The &FORTRAN; tools all have similar makefiles, and similar options for building. +All of the Makefiles use GNU Make extensions and thus require that you use GNU make +to use them. They also auto detect the type of platform you are on, using "uname -s" +and set the compiler, compiler flags and such accordingly. There are also environment +variables that can be set to set things that must be customized. All the tools use +&netcdf; and hence require the path to the &netcdf; libraries and include files. +On some platforms (such as Linux) multiple compilers can be used, and hence there +are env variables that can be set to change the &FORTRAN; and/or "C" compilers used. +The tools other than cprnc also allow finer control, by also +allowing the user to add compiler flags they choose, for both &FORTRAN; and "C", as +well as picking the compiler, linker and and add linker options. Finally the tools +other than cprnc allow you to turn +optimization on (which is off by default but on for the mksurfdata and +interpinic +programs) with the OPT flag so that the +tool will run faster. To get even faster performance, the interpinic, +mksurfdata, and +mkgriddata programs allow you to also use the SMP to +turn on multiple shared memory processors. +When SMP=TRUE you set the number of threads used by the program with +the OMP_NUM_THREADS environment variable. + + +Options used by all: cprnc, interpinic, +mkdatadomain, mkgriddata, and +mksurfdata + +LIB_NETCDF -- sets the location of the &netcdf; library. +INC_NETCDF -- sets the location of the &netcdf; include files. +USER_FC -- sets the name of the &FORTRAN; compiler. + +Options used by: interpinic, mkdatadomain, +mkgriddata, and mksurfdata + +MOD_NETCDF -- sets the location of the &netcdf; &FORTRAN; module. +USER_LINKER -- sets the name of the linker to use. +USER_CPPDEFS -- adds any CPP defines to use. +USER_CFLAGS -- add any "C" compiler flags to use. +USER_FFLAGS -- add any &FORTRAN; compiler flags to use. +USER_LDFLAGS -- add any linker flags to use. +USER_CC -- sets the name of the "C" compiler to use. +OPT -- set to TRUE to compile the code optimized (TRUE or FALSE) + +Options used by: interpinic, mkgriddata, and mksurfdata: + +SMP -- set to TRUE to turn on shared memory parallelism (i.e. +&omp;) (TRUE or FALSE) +Filepath -- list of directories to build source code from. +Srcfiles -- list of source code filenames to build executable from. + +Options used only by cprnc: + +EXEDIR -- sets the location where the executable will be built. +VPATH -- colon delimited path list to find the source files. + +More details on each environment variable. + + +LIB_NETCDF + +This variable sets the path to the &netcdf; library file +(libnetcdf.a). If not +set it defaults to /usr/local/lib. In order to use the tools +you need to build the &netcdf; library and be able to link to it. In order to build +the model with a particular compiler you may have to compile the &netcdf; library with +the same compiler (or at least a compatible one). + + + + + +INC_NETCDF + +This variable sets the path to the &netcdf; include directory (in order to find +the include file netcdf.inc). +if not set it defaults to /usr/local/include. + + + + + +MOD_NETCDF + +This variable sets the path to the &netcdf; module directory (in order to find +the &netcdf; &FORTRAN90; module file when &netcdf; is used with a &FORTRAN90; +use statement. When not set it defaults to the +LIB_NETCDF value. + + + + + +USER_FC + +This variable sets the command name to the &FORTRAN90; compiler to use when +compiling the tool. The default compiler to use depends on the platform. And +for example, on the AIX platform this variable is NOT used + + + + + +USER_LINKER + +This variable sets the command name to the linker to use when linking the object +files from the compiler together to build the executable. By default this is set to +the value of the &FORTRAN90; compiler used to compile the source code. + + + + + +USER_CPPDEFS + +This variable adds additional optional values to define for the C preprocessor. +Normally, there is no reason to do this as there are very few CPP tokens in the CLM +tools. However, if you modify the tools there may be a reason to define new CPP +tokens. + + + + + +USER_CC + +This variable sets the command name to the "C" compiler to use when +compiling the tool. The default compiler to use depends on the platform. And +for example, on the AIX platform this variable is NOT used + + + + + +USER_CFLAGS + +This variable adds additional compiler options for the "C" compiler to use +when compiling the tool. By default the compiler options are picked according +to the platform and compiler that will be used. + + + + + +USER_FFLAGS + +This variable adds additional compiler options for the &FORTRAN90; compiler to use +when compiling the tool. By default the compiler options are picked according +to the platform and compiler that will be used. + + + + + +USER_LDFLAGS + +This variable adds additional options to the linker that will be used when linking +the object files into the executable. By default the linker options are picked according +to the platform and compiler that is used. + + + + + +SMP + +This variable flags if shared memory parallelism (using i&omp;) should be used when +compiling the tool. It can be set to either TRUE or +FALSE, by default it is set to FALSE, so +shared memory parallelism is NOT used. When set to TRUE you can +set the number of threads by using the OMP_NUM_THREADS environment +variable. Normally, the most you would set this to would be to the number of on-node +CPU processors. Turning this on should make the tool run much faster. + + + +Note, that depending on the compiler answers may be different when SMP +is activated. + + + + + + +OPT + +This variable flags if compiler optimization should be used when +compiling the tool. It can be set to either TRUE or +FALSE, by default it is set to FALSE for +mkdatadomain and TRUE for +mksurfdata and interpinic. +Turning this on should make the tool run much faster. + + + +Note, you should expect that answers will be different when OPT +is activated. + + + + + + +Filepath + +All of the tools are stand-alone and don't need any outside code to operate. The +Filepath is the list of directories needed to compile +and hence is always simply "." the current directory. Several tools use +copies of code outside their directory that is in the &cesm; +distribution (either csm_share code or &clm; source code). + + + + + +Srcfiles + +The Srcfiles lists the filenames of the source code to use +when building the tool. + + + + + +EXEDIR + +The cprnc tool uses this variable to set the location of where the executable +will be built. The default is the current directory. + + + + + +VPATH + +The cprnc tool uses this variable to set the colon delimited pathnames of where +the source code exists. The default is the current directory. + + + + + + + + + +There are several files that are copies of the original files from either +models/lnd/clm/src/main, +models/csm_share/shr, or copies from other tool +directories. By having copies the tools can all be made stand-alone, but +any changes to the originals will have to be put into the tool directories +as well. + + + +The README.filecopies (which can be found in +models/lnd/clm/tools) is repeated here. + +&filecopies; + + + + + +General information on running the &FORTRAN; tools + +The tools run either one of two ways, with a namelist to provide options, or +with command line arguments (and NOT both). interpinic and +cprnc run with command line arguments, and the other tools +run with namelists. + + +Running &FORTRAN; tools with namelists + +mkgridata, mksurfdata and +mkdatadomain run with namelists that are read from +standard input. Hence, you create a namelist and then run them by +redirecting the namelist file into standard input as follows: + +./program < namelist + +For programs with namelists there is at least one sample namelist with the +name "program".namelist (i.e. mksurfdata.namelist +for the mksurfdata program). There may also be other sample +namelists that end in a different name besides "namelist". Namelists that you create +should be similar to the example namelist. The namelist values are also documented +along with the other namelists in the: + +models/lnd/clm/bld/namelist_files/namelist_definition.xml +file and default values in the: + +models/lnd/clm/bld/namelist_files/namelist_defaults_clm_tools.xml +file. + + + +Running &FORTRAN; tools with command line options + +interpinic and cprnc run with command line +arguments. The detailed sections below will give you more information on the command +line arguments specific to each tool. Also running the tool without any arguments +will give you a general synopsis on how to run the tool. For example to get help +on running interpinic do the following. + +cd models/lnd/clm/tools/interpinic +gmake +./interpinic + + + + +Running &FORTRAN; tools built with SMP=TRUE + +When you enable SMP=TRUE on your build of one of the tools that +make use of it, you are using &omp; for shared memory parallelism (SMP). In +SMP loops are run in parallel with different threads run on different processors +all of which access the same memory (called on-node). Thus you can only usefully +run up to the number of processors that are available on a single-node of the machine +you are running on. For example, on the &ncar; machine bluefire there are 32 processors +per node, but the SMT hardware on the machine allows you to submit twice as many +threads or 64 threads. So to run the mksurfdata on bluefire +optimized, with 64 threads you would do the following: + +cd models/lnd/clm/tools/mksurfdata +gmake OPT=TRUE SMP=TRUE +setenv OMP_NUM_THREADS 64 +./mksurfdata < mksurfdata.namelist + + + + + + +The File Creation Process + + +When just creating a replacement file for an existing one, the relevant tool should +be used directly to create the file. When you are creating a set of files for a new +resolution there are some dependencies between the tools that you need to keep in mind +when creating them. The main dependency is that the mkgriddata MUST +be done first as the grid dataset is then input into the other tools. Also look at +. + + + +Creating a complete set of files for input to &clm; + +Create grid and fraction datasets + +First use mkgriddata to create grid and fraction datasets. +See for more information on this. + + + + +Create domain dataset (if NOT already done) + +Next use mkdatadomain to create a domain file for use by +&datm; from the grid and fraction datasets just created. This is required, unless +a domain file already created was input into mkgriddata on +the previous step. +See for more information on this. + + + + +Create surface datasets + +Next use mksurfdata to create a surface dataset, using the grid +dataset as input. +See for more information on this. + + + + +Interpolate aerosol deposition datasets (optional) + +By default the atmosphere model will interpolate +these datasets on the fly, so you don't normally need to do this step. +A reason you might want to do this is to make the read and interpolation faster, +by reducing the amount of data read in and removing the need for the interpolation. +So, if you do, you can use aerdepregrid.ncl to regrid aerosol +deposition datasets to your new resolution using the grid dataset as input. +See for more information on this. + + + + +Interpolate Nitrogen deposition datasets (optional, but only needed if running &clmcn;) + +By default Nitrogen deposition is read in from stream +files at 2-degree resolution and interpolated to the resolution you are running at, +so you don't need to do this step. As with aerosol deposition datasets a reason +you might want to do this is to make the read and interpolation faster, +by reducing the amount of data read in and removing the need for the interpolation. +So, if you do you can use ndepregrid.ncl +to regrid Nitrogen deposition datasets to your new resolution using the grid dataset +as input. +See for more information on this. + + + + +Create some sort of initial condition dataset + + +You then need to do one of the following three options to have an initial dataset +to start from. + + + + + +Use spinup-procedures to create initial condition datasets + +The first option is to do the spinup procedures from arbitrary initial conditions +to get good initial datasets. This is the most robust method to use. +See , , or + for more information on this. + + + + +Use <command>interpinic</command> to interpolate existing initial +condition datasets + +The next option is to interpolate from spunup datasets at a different resolution, using +interpinic. +See for more information on this. + + + + +Start up from arbitrary initial conditions + +The last alternative is to run from arbitrary initial conditions without using any +spun-up datasets. This is inappropriate when using &clmcn; (bgc=cn or cndv) as it +takes a long time to spinup Carbon pools. + + +This is NOT recommended as many fields in &clm; take a long time to equilibrate. + + + + + + + + + + +Enter the new datasets into the &buildnml; XML database + +The last optional thing to do is to enter the new datasets into the &buildnml; +XML database. See for more information on +doing this. This is optional because the user may enter these files into their +namelists manually. The advantage of entering them into the database is so that +they automatically come up when you create new cases. + + + + + + + + +Using the <command>cprnc</command> tool to compare two history files + +cprnc is a tool shared by both CAM and &clm; to compare two +&netcdf; history files. +It differences every field that has a time-axis that is also shared on both files, +and reports a summary of the difference. The summary includes the three largest +differences, as well as the root mean square (RMS) difference. It also gives some +summary information on the field as well. You have to enter at least one file, and up to +two files. With one file it gives you summary information on the file, and with two it +gives you information on the differences between the two. At the end it will give you a +summary of the fields compared and how many fields were different and how many were +identical. + + +Options: + +-m = do NOT align time-stamps before comparing +-v = verbose output +-ipr +-jpr +-kpr + +See the cprnc +README file for more details which is +repeated here: + +&cprnc_readme; + + + +To compare files with OUT a time axis you can use the cprnc.ncl +&ncl; script in models/lnd/clm/tools/ncl_scripts. It won't give +you the details on the differences but will report if the files are identical or +different. + + + + + + +Using <command>interpinic</command> to interpolate initial conditions to different +resolutions + +"interpinic" is used to interpolate initial conditions from one resolution to another. +In order to do the interpolation you must first run &clm; to create a restart file to +use as the "template" to interpolate into. Running from arbitrary initial conditions +(i.e. finidat = ' ') for a single time-step is sufficient to do this. Make sure the +model produces a restart file. You also need to make sure that you setup the same +configuration that you want to run the model with, when you create the template file. + + +Command line options to interpinic: + +-i = Input filename to interpolate from +-o = Output interpolated file, and starting template file + + + +There is a sample template file in the models/lnd/clm/tools/interpinic +directory and can be used to run interpolate to. +However, this file was created with an older version of &clm; and hence +we actually recommend that you would do a short run with &clm; to create a template file +to use. + + + + +Example of running &clm; to create a template file for +<command>interpinic</command> to interpolate to + +> cd scripts +> ./create_newcase -case cr_f10_TmpltI1850CN -res f10_f10 -compset I1850CN \ +-mach bluefire +> cd cr_f10_TmpltI1850CN +# Set starting date to end of year +> ./xmlchange -file env_conf.xml -id RUN_STARTDATE -val 1948-12-31 +# Set year align to starting year +> ./xmlchange -file env_conf.xml -id DATM_CLMNCEP_YR_ALIGN -val 1948 +# Set to run a cold start +> ./xmlchange -file env_conf.xml -id CLM_FORCE_COLDSTART -val on +# Set to run only a single day, so a restart file will be created on Jan/1/1949 +> ./xmlchange -file env_run.xml -id STOP_N -val 1 +# Then configure, build and run as normal +> ./configure -case +> ./cr_f10_TmpltI1850CN.bluefire.build +> ./cr_f10_TmpltI1850CN.bluefire.submit +# And copy the resulting restart file to your interpinic directory +> cd ../models/lnd/clm/tools/interpinic +> cp /ptmp/$LOGIN/cr_f10_TmpltI1850CN/run/cr_f10_TmpltI1850CN.clm2.r.1949-01-01-00000.nc . + + + + +In the next example we build interpinic optimized with shared +memory on for 64 threads so that it runs as fast as possible, to interpolate one of +the standard 1-degree datasets to the above 10x15 template file that we created. + + +Example of building and running <command>interpinic</command> to +interpolate a 1-degree <filename>finidat</filename> dataset to 10x15 + +> cd models/lnd/clm/tools/interpinic +> gmake OPT=TRUE SMP=TRUE +> env OMP_NUM_THREADS=64 ./interpinic -o cr_f10_TmpltI1850CN.clm2.r.1949-01-01-00000.nc / +-i /fs/cgd/csm/inputdata/ccsm4_init/b40.1850.track1.1deg.006/0863-01-01/b40.1850.track1.1deg.006.clm2.r.0863-01-01-00000.nc + + + + +Running interpinic at high resolution can take a long time, so we +recommend that you always build it optimized and with shared memory processing on, to +cut down the run time as much as possible. + + + + +interpinic does NOT work for CNDV (bgc=cndv). + + + + + + +In we give a simpler way to run +interpinic for several standard resolutions at once, with a script +to loop over several resolutions. This is useful for &clm; developers who need to +create many finidat files at once. + + + + + +Using <command>mkgriddata</command> to create grid datasets + +mkgriddata is used to create grid, fraction, and topography +datasets to run &clm; at a new resolution. It is typically the first step in creating +datasets needed to run &clm; at a new resolution (followed by +mksurfdata, and +then the interpolation programs, aerdepregrid.ncl, and +ndepregrid.ncl when running with CN). + + + +mkgriddata namelist + +mkgriddata is controlled by a namelist. There are ten different +namelist items, and you need to use enough of them so that files will be output. +The different types of input datasets contain different input data types, that +correspond to the three different types of output files: grid, fraction, and topography. +Output files for each of these will only be output if there is input data that +correspond to these. If you only have input data for grid locations -- you will only +get an output grid file. If you have both grid and fraction data you will get grid and +fraction data files. If you also have topography data you will also get topo files. + + +Namelist options to mkgriddata include: + +mksrf_fnavyoro -- Navy orography file to use for land fraction +and surface heights. +mksrf_frawtopo -- Raw topography file with just surface +heights. +mksrf_fcamfile -- CAM initial conditions file with +land-fractions and topography +mksrf_fclmgrid -- &clm; grid file +mksrf_fccsmdom -- &cesm; domain file +mksrf_fcamtopo -- CAM topography file +mksrf_lsmlon -- number of longitude for regional grid +mksrf_lsmlatnumber of latitudes for regional grid +mksrf_edgen -- Northern edge for regional grid +mksrf_edgee -- Southern edge for regional grid +mksrf_edges -- Eastern edge for regional grid +mksrf_edgew -- Western edge for regional grid + + + +You need to enter one of the following four options: + + mksrf_fnavyoro - high resolution topo dataset (topo data) + mksrf_lsmlon - number of longitudes + mksrf_lsmlat - number of latitudes + mksrf_edgen - northern edge of grid (degrees) + mksrf_edgee - eastern edge of grid (degrees) + mksrf_edges - southern edge of grid (degrees) + mksrf_edgew - western edge of grid (degrees) + +or + + mksrf_fcamfile - CAM topo file (grid and possibly fraction data) + +or + + mksrf_fccsmdom - &cesm; domain file (both grid, and fraction data) + +or + + mksrf_fclmgrid - &clm; grid or surface dataset file (grid data) + +Note, you can provide more than one of the needed datasets, and the output +data will be determined by the datasets according to an order of precedence. +The order of precedence for data is as follows: + +mksrf_fcamfile +mksrf_fclmgrid +mksrf_fnavyoro +mksrf_fccsmdom + +Grid data then will be established by the file with the highest precedence. +&cesm; domain files sometimes have latitudes and longitudes that are "off" from +the standard by a small amount. By establishing an order of precedence you can ensure +that grid locations exactly match a given standard file, even if the values in the domain +file are off from that. + + + +There are three different major modes for using "mkgriddata" to create grid files +for &clm;: + +mksrf_fnavyoro -- Navy orography file to use for land fraction +and surface heights. +mksrf_frawtopo -- Raw topography file with just surface +heights. +mksrf_fcamfile -- CAM initial conditions file with +land-fractions and topography +mksrf_fclmgrid -- &clm; grid file +mksrf_fccsmdom -- &cesm; domain file +mksrf_fcamtopo -- CAM topography file +mksrf_lsmlon -- number of longitude for regional grid +mksrf_lsmlat -- number of latitudes for regional grid +mksrf_edgen -- Northern edge for regional grid +mksrf_edgee -- Southern edge for regional grid +mksrf_edges -- Eastern edge for regional grid +mksrf_edgew -- Western edge for regional grid + + + +You need to enter one of the following four options: + + mksrf_fnavyoro - high resolution topo dataset (topo data) + mksrf_lsmlon - number of longitudes + mksrf_lsmlat - number of latitudes + mksrf_edgen - northern edge of grid (degrees) + mksrf_edgee - eastern edge of grid (degrees) + mksrf_edges - southern edge of grid (degrees) + mksrf_edgew - western edge of grid (degrees) + +or + + mksrf_fcamfile - CAM topo file (grid and possibly fraction data) + +or + + mksrf_fccsmdom - &cesm; domain file (both grid, and fraction data) + +or + + mksrf_fclmgrid - &clm; grid or surface dataset file (grid data) + +Note, you can provide more than one of the needed datasets, and the output +data will be determined by the datasets according to an order of precedence. +The order of precedence for data is as follows: + +mksrf_fcamfile +mksrf_fclmgrid +mksrf_fnavyoro +mksrf_fccsmdom + +Grid data then will be established by the file with the highest precedence. +&cesm; domain files sometimes have latitudes and longitudes that are "off" from +the standard by a small amount. By establishing an order of precedence you can ensure +that grid locations exactly match a given standard file, even if the values in the domain +file are off from that. + + + +There are three different major modes for using mkgriddata to +create grid files for &clm;: + +Convert &cesm; domain files to &clm; grid files +Create single point or regional area grid files +Convert CAM files to &clm; grid files + + + + + +Convert &cesm; domain files to &clm; grid files + +&cesm; domain files such as used for &datm;, include all the information +needed to create &clm; grid and fraction files. + +Example <command>mkgriddata</command> namelist to convert &cesm; 4x5 domain files to &clm; grid files + +&clmexp + mksrf_fccsmdom= +'/fs/cgd/csm/inputdata/lnd/dlnd7/domain.lnd.4x5_gx3v5.060404.nc' + mksrf_fclmgrid= +'/fs/cgd/csm/inputdata/lnd/clm2/griddata/griddata_4x5_060404.nc' +/ + + + + +Notice that in the above example, a &clm; grid file is included as well, even though +it's not required. The reason for this is to ensure that the latitude and longitudes +on the output files exactly match a standard grid file. + + + + + + +Create single point or regional area grid files + +The process to create single-point or regional area &clm; grid files is the same. +You enter the number of latitudes and longitudes you want on your output file and +the extent of the grid: North, East, South and West. You also tell +mkgriddata that +you are entering a "regional" grid and you also enter the standard Navy orography +dataset (or your own orography file if desired). For a single point you simply +enter "1" for the number of latitudes and longitudes, but you still enter the +grid extent (of the single grid cell). Here is a sample regional namelist to create +a 5x5 regional grid over the Amazon: + +Example <command>mkgriddata</command> namelist to create regional grid over Amazon + +&clmexp + mksrf_fnavyoro= +"/fs/cgd/csm/inputdata/lnd/clm2/rawdata/mksrf_navyoro_20min.c010129.nc" + mksrf_lsmlon = 5 + mksrf_lsmlat = 5 + mksrf_edgee = 303.75 + mksrf_edgew = 286.25 + mksrf_edges = -15. + mksrf_edgen = -4. +/ + + + + + +Currently you can NOT have regional grids that straddle both +sides of the Greenwich (longitude = zero) line. + + + + +You should enter longitudes with values from 0 to 360 East. + + + + + +Convert <acronym>CAM</acronym> files to &clm; grid files (deprecated) + +Older CAM initial files included all the information needed to create &clm; +grid files. Newer CAM files no longer include land fraction data. Hence you +can use CAM files to give you the grid coordinates, but you need other data +to give you the land-mask and topography. Since, CAM files no longer +contain the needed information, this option is now deprecated. In most cases you should +use one of the other two options. + + + + + + + +Using <command>mkdatadomain</command> to create domain datasets for &datm; or docn from &clm; grid datasets + +"mkdatadomain" is used to convert &clm; grid and fraction datasets into domain datasets +that can be used by either the "datm" or "docn" models. Most often &clm; users will want +to convert the grid datasets they just created using mkgriddata into +domain datasets to be used by &datm; for an "I" case. mkdatadomain is +controlled by a namelist, and has a very straight forward operation with only four +namelist items all of which are required. You specify which output mode you want "datm" +or "docn", and then set the input &clm; grid and frac datasets, and the output domain file. + + +Example <command>mkdatadomain</command> namelist to create a domain file from +&clm; frac and grid data files + +&domain_nl + dtype = "datm" + f_fracdata = +'/fs/cgd/csm/inputdata/lnd/clm2/griddata/fracdata_4x5_USGS_070110.nc' + f_griddata = +'/fs/cgd/csm/inputdata/lnd/clm2/griddata/griddata_4x5_060404.nc' + f_domain = +'domain.lnd.fv4x5_USGS.090117.nc' +/ + + + + + +Using mksurfdata to create surface datasets from grid datasets + +mksurfdata is used to create surface-datasets from grid datasets and raw datafiles +at half-degree resolution to produce files that describe the surface characteristics +needed by &clm; (fraction of grid cell covered by different land-unit types, and fraction +for different vegetation types, as well as things like soil color, and soil texture, +etc.). To run mksurfdata you can either use the +mksurfdata.pl script which will create namelists for you using the &buildnml; +XML database, or you can run it by hand using a namelist that you provide (possibly +modeled after an example provided in the +models/lnd/clm/tools/mksurfdata directory). The namelist for +mksurfdata is sufficiently complex that we recommend using the +mksurfdata.pl tool to build them. In the next section +we describe how to use the mksurfdata.pl script and the following +section gives more details on running mksurfdata by hand and the +various namelist input variables to it. + + +Running <command>mksurfdata.pl</command> + +The script mksurfdata.pl can be used to run the +mksurfdata program for several configurations, resolutions, +simulation-years and simulation year ranges. It will create the needed namelists for +you and move the files +over to your inputdata directory location (and create a list of the files created, and +for developers this file is also a script to import the files into the svn inputdata +repository). It will also use the &buildnml; XML database +to determine the correct input files to use, and for transient cases it will create +the appropriate mksrf_fdynuse file with the list of files for each +year needed for this case. And in the case of urban single-point +datasets (where surface datasets are actually input into mksurfdata) +it will do the additional processing required so that the output dataset +can be used once again by mksurfdata. Because, it figures out +namelist and input files for you, it is recommended that you use this script for creation +of standard surface datasets. If you need to create surface datasets for customized +cases, you might need to run mksurfdata on it's own. But you +could use mksurfdata.pl with the "-debug" option to give you +a namelist to start from. +For help on mksurfdata.pl you can use the "-help" option as below: + +> cd models/lnd/clm/tools/mksurfdata +> mksurdata.pl -help + +The output of the above command is: + +&mksurfdatapl; + + + +To run the script with optimized mksurfdata for a 4x5 degree grid +for 1850 conditions, on bluefire you would do the following: + +Example of running <command>mksurfdata.pl</command> to create a 4x5 resolution +<filename>fsurdat</filename> for a 1850 simulation year + +> cd models/lnd/clm/tools/mksurfdata +> gmake +> mksurfdata.pl -y 1850 -r 4x5 + + + + + + +Running <command>mksurfdata</command> by Hand + +In the above section we show how to run mksurfdata through +the mksurfdata.pl using input datasets that are in the &buildnml; +XML database. When you are running with input datasets that are NOT available in +the XML database you either need to add them as outlined in +, or you need to run mksurfdata +by hand, as we will outline here. + + + +Preparing your <command>mksurfdata</command> namelist + +When running mksurfdata by hand you will need to prepare your +own input namelist. There are sample namelists that are setup for running on the +&ncar; machine bluefire. You will need to change the filepaths to +run on a different machine. The list of sample namelists include + +mksurfdata.namelist -- standard sample namelist. +mksurfdata.regional -- sample namelist to +build for a regional grid dataset (5x5_amazon) +mksurfdata.singlept -- sample namelist to +build for a single point grid dataset (1x1_brazil) + +Note, that one of the inputs mksrf_fdynuse is a filename that +includes the filepaths to other files. The filepaths in this file will have to +be changed as well. You also need to make sure that the line lengths remain the same +as the read is a formatted read, so the placement of the year in the file, must remain +the same, even with the new filenames. One advantage of the mksurfdata.pl +script is that it will create the mksrf_fdynuse file for you. + + +We list the namelist items below. Most of the namelist items are filepaths to give to +the input half degree resolution datasets that you will use to scale from to the +resolution of your grid dataset. +You must first specify the input grid dataset for the resolution to output for: + +mksrf_fgrid Grid dataset + +Then you must specify settings for input high resolution datafiles + +mksrf_ffrac land fraction and land mask dataset +mksrf_fglacier Glacier dataset +mksrf_flai Leaf Area Index dataset +mksrf_flanwat Land water dataset +mksrf_forganic Organic soil carbon dataset +mksrf_fmax Max fractional saturated area dataset +mksrf_fsoicol Soil color dataset +mksrf_fsoitex Soil texture dataset +mksrf_ftopo Topography dataset (this is used to limit +the extent of urban regions and is used for glacier multiple elevation classes) + +mksrf_furban Urban dataset +mksrf_fvegtyp PFT vegetation type dataset +mksrf_fvocef Volatile Organic Compound Emission Factor +dataset +mksrf_fgdp GDP dataset +mksrf_fpeat Peatland dataset +mksrf_fabm Agricultural fire peak month dataset +mksrf_ftopostats Topography statistics dataset +mksrf_fvic VIC parameters dataset +mksrf_fch4 Inversion-derived CH4 parameters dataset + +You specify the ASCII text file with the land-use files. + +mksrf_fdynuse "dynamic land use" for transient +land-use/land-cover changes. This is an ASCII text file that lists the filepaths +to files for each year and then the year it represents (note: you MUST change the +filepaths inside the file when running on a machine NOT at &ncar;). +We always use this file, even for creating datasets of a fixed year. Also note +that when using the "pft_" settings this file will be an XML-like file with settings +for PFT's rather than filepaths (see below). + + + +And optionally you can specify settings for: + +all_urban If entire area is urban (typically used for +single-point urban datasets, that you want to be exclusively urban) +no_inlandwet If TRUE, set wetland to 0% over land +(renormalizing other landcover types as needed); wetland will only be used for ocean +points. (Only applies to CLM4.5 version of mksurfdata_map, for which the default is +TRUE.) +mksrf_firrig Irrigation dataset, if you want +activate the irrigation model over generic cropland +(experimental mode, normally NOT used) +mksrf_gridnm Name of output grid resolution (if not +set the files will be named according to the number of longitudes by latitudes) +mksrf_gridtype Type of grid (default is 'global') +nglcec number of glacier multiple elevation classes. +Can be 0, 1, 3, 5, or 10. When using the resulting dataset with &clm; you can then run +with glc_nec of either 0 or this value. + (experimental normally use the default of 0, when running with the land-ice +model in practice only 10 has been used) +numpft number of Plant Function Types (PFT) +in the input vegetation mksrf_fvegtyp dataset. You change +this to 20, if you want to create a dataset with prognostic crop activated. The +vegetation dataset also needs to have prognostic crop types on it as well. + (experimental normally not changed from the default of 16) +outnc_large_files If output should be in &netcdf; large file +format +outnc_double If output should be in double +precision (normally we turn this on) +pft_frc array of fractions to override PFT +data with for all gridpoints (experimental mode, normally NOT used). +pft_idx array of PFT indices to override PFT +data with for all gridpoints (experimental mode, normally NOT used). +soil_clay percent clay soil to override +all gridpoints with (experimental mode, normally NOT used). +soil_color Soil color to override +all gridpoints with (experimental mode, normally NOT used). +soil_fmax Soil maximum fraction to override +all gridpoints with (experimental mode, normally NOT used). +soil_sand percent sandy soil to +override all gridpoints with (experimental mode, normally NOT used). + + + +After creating your namelist, +when running on a non &ncar; machine you will need to get the files +from the inputdata repository. +In order to retrieve the files needed for mksurfdata you can do the following on your +namelist to get the files from the inputdata repository, using the +check_input_data script which also allows you to export data to +your local disk. + +Getting the raw datasets for <command>mksurfdata</command> to your local +machine using the <command>check_input_data</command> script + +> cd models/lnd/clm/tools/mksurfdata +# First remove any quotes and copy into a filename that can be read by the +# check_input_data script +> sed "s/'//g" namelist > clm.input_data_list +# Run the script with -export and give the location of your inputdata with $CSMDATA +> ../../../../../scripts/ccsm_utils/Tools/check_input_data -datalistdir . \ +-inputdata $CSMDATA -check -export +# You must then do the same with the flanduse_timeseries file referred to in the namelist +# in this case we add a file = to the beginning of each line +> awk '{print "file = "$1}' landuse_timeseries_hist_simyr2000-2000.txt > clm.input_data_list +# Run the script with -export and give the location of your inputdata with $CSMDATA +> ../../../../../scripts/ccsm_utils/Tools/check_input_data -datalistdir . \ +-inputdata $CSMDATA -check -export + + + + +Experimental options to <command>mksurfdata</command> + +The options: pft_frc, pft_idx, soil_clay, soil_color, soil_fmax, and soil_sand are also +new and considered experimental. They provide a way to override the PFT and soil +values for all grid points to the given values that you set. This is useful for +running with single-point tower sites where the soil type and vegetation is known. +Note that when you use pft_frc, all other landunits will be zeroed out, and the +sum of your pft_frc array MUST equal 100.0. Also note that when using the "pft_" +options the mksrf_fdynuse file instead of having filepath's +will be an XML-like file with PFT settings. Unlike the file of file-paths, you will +have to create this file by hand, mksurfdata.pl will NOT be able +to create it for you (other than the first year which will be set to the values +entered on the command line). Note, that when &ptclm; is run, it CAN create these +files for you from a simpler format (see ). +Instead of a filepath you have a list of XML elements that give information on the PFT's +and harvesting for example: + +<pft_f>100</pft_f><pft_i>1</pft_i><harv>0,0,0,0,0</harv><graz>0</graz> + +So the <pft_f> tags give the PFT fractions and the <pft_i> tags give the +index for that fraction. Harvest is an array of five elements, and grazing is a single +value. Like the usual file each list of XML elements goes with a year, and there is +limit on the number of characters that can be used. + + + + + +Standard Practices when using <command>mksurfdata</command> + +In this section we give the recommendations for how to use mksurfdata +to give similar results to the files that we created when using it. + + +If you look at the standard surface datasets that we have created and provided for use, +there are three practices that we have consistently done in each (you also see these in +the sample namelists and in the mksurfdata.pl script). The first is +that we always output data in double precision (hence outnc_double +is set to .true.). The next is that we always use the procedure +for creating transient datasets (using mksrf_fdynuse) even when +creating datasets for a fixed simulation year. This is to ensure that the fixed year +datasets will be consistent with the transient datasets. When this is done a +"landuse_timeseries" dataset will be created -- but will NOT be used in &clm;. If you look +at the sample namelist mksurfdata.namelist you note that it +sets mksrf_fdynuse to the file +landuse_timeseries_hist_simyr2000.txt, where the single file entered is +the same PFT file used in the rest of the namelist (as mksrf_fvegtyp). +The last practice that we always do is to always set mksrf_ftopo, +even if glacier elevation classes are NOT active. This is +important in limiting urban areas based on topographic height, and hence is important +to use all the time. The glacier multiple elevation classes will be used as well if +you are running a compset with the active glacier model. + + +There are two other important practices for creating urban single point datasets. The +first is that you often will want to set all_urban to +.true. so that the dataset will have 100% of the gridcell output +as urban rather than some mix of: urban, vegetation types, and other landunits. The +next practice is that most of our specialized urban datasets have custom values for +the urban parameters, hence we do NOT want to use the global urban dataset to get +urban parameters -- we use a previous version of the surface dataset for the urban +parameters. However, in order to do this, we need to append onto the previous surface +dataset the grid and land mask/land fraction information from the grid and fraction +datasets. This is done in mksurfdata.pl using the NCO +program ncks. An example of doing this for the Mexico City, Mexico +urban surface dataset is as follows: + +> ncks -A $CSMDATA/lnd/clm2/griddata/griddata_1x1pt_mexicocityMEX_c090715.nc \ +$CSMDATA/lnd/clm2/surfdata/surfdata_1x1_mexicocityMEX_simyr2000_c100407.nc +> ncks -A $CSMDATA/lnd/clm2/griddata/fracdata_1x1pt_mexicocityMEX_navy_c090715.nc \ +$CSMDATA/lnd/clm2/surfdata/surfdata_1x1_mexicocityMEX_simyr2000_c100407.nc + +Note, if you look at the current single point urban surface datasets you will note +that the above has already been done. + + +The final issue is how to build mksurfdata. When NOT optimized +mksurfdata is very slow, and can take many hours to days to +even run for medium resolutions such as one or two degree. So usually you will want +to run it optimized. Possibly you also want to use shared memory parallelism using +&omp; with the SMP option. The problem with running optimized is that +answers will be different when running optimized versus non-optimized for most +compilers. So if you want answers to be the same as a previous surface dataset, you +will need to run it on the same platform and optimization level. Likewise, running +with or without &omp; may also change answers (for most compilers it will NOT, however +it does for the IBM compiler). However, answers should be the same regardless of the +number of threads used when &omp; is enabled. Note, that the output surface datasets +will have attributes that describe whether the file was written out optimized or not, +with threading or not and the number of threads used, to enable the user to more +easily try to match datasets created previously. For more information on the different +compiler options for the &clm4; tools see . + + + + + + + +Using &ncl; scripts <command>ndepregrid.ncl</command> and +<command>aerdepregrid.ncl</command> to interpolate aerosol deposition datasets + +Unlike the other tools, these are &ncar; Command Language (&ncl;) scripts +and you will need to get a copy of &ncl; in order to use them. You also won't have to +build an executable in order to use them, hence no Makefile is provided. &ncl; is provided +for free download as either binaries or source code from: +http://www.ncl.ucar.edu/. The &ncl; +web-site also contains documentation on &ncl; and it's use. + + +By default at this point neither of these scripts HAS to be used, +as the model is now constructed to read aerosol and Nitrogen deposition from 2-degree +datasets and interpolate to the model resolution on the fly. The main reason you might +want to do this now, is for better performance for single-point simulations. + + +Both the ndepregrid.ncl and aerdepregrid.ncl +scripts have similar interfaces and you customize the output resolution and +characteristics based on the settings of environment variables that you set (if you +don't set any of the variables, the script has defaults that it will use). +The list of environment variables that can be set are: + +RES -- output resolution name +RCP -- representative concentration pathway for future scenarios +(example 2.6, 4.5, 6, or 8.5) +SIM_YR -- simulation year (example 1850 or 2000) +SIM_YR_RNG -- simulation year range (example 1850-2000 or +1850-2100) +GRDFIL -- full pathname of grid file to use +(in place of getting the default grid file based on the RES value) +CSMDATA -- &cesm; inputdata directory +CLM_ROOT -- root directory for &clm; (models/lnd/clm directory) + + + + +You MUST provide either RES or both +GRDFIL AND RES. If you +just give RES the default namelist database in +models/lnd/clm/bld will be used to find the default grid +file based on the resolution name RES. If you provide +GRDFIL the input pathname of the gridfile provided will be used, +and the output filename will include RES as part of it's name +to designate it as an output file at that resolution. + + + +Both scripts assume that you will be interpolating from a native resolution of 1.9x2.5 +and using the default files found in the namelist database to interpolate from. If you +want to interpolate from another resolution or use other files, you would need to edit +the scripts to do so. Both scripts also use a bilinear interpolation to do the +regridding. The environment variables: RCP, SIM_YR, +and SIM_YR_RNG will be used to query the namelist database to +determine which native dataset to interpolate from. If you don't provide valid +values for these variables, it won't be able to find a dataset to interpolate from. +You can use the build-namelist script to query what the valid values for these can +be. Likewise, when you use RES to determine the grid file to interpolate +to, it needs to be a valid value from the namelist database. + + +The scripts can be used to interpolate from (and create output) constant or +transient datasets. +Constant datasets specify the SIM_YR and set SIM_YR_RNG +to constant (which is also the default). Transient datasets need +to specify both SIM_YR and SIM_YR_RNG, where +SIM_YR is set to the first year in the interval (typically 1850). + + +The default for CSMDATA works for &ncar; computers, but will need to +be set to the top level directory location of your &cesm; input data on other computers. +If you set this as a default for your shell when you login (for example with your +$HOME/.cshrc if you use csh) you won't have to set it each time +you run the script. CLM_ROOT will default to the proper location +when you run it in the models/lnd/clm/tools/ncl_script +directory. It is only useful if you want to run the script out of a different +directory. + + +Using <command>ndepregrid.ncl</command> to interpolate Nitrogen deposition datasets + +ndepregrid.ncl interpolates the Nitrogen deposition datasets from one resolution +to another. + + + +Interpolating Nitrogen deposition files is no longer needed, because the model can +read Nitrogen deposition files at one resolution and interpolate to the resolution the +model is running at on the fly. Interpolating to another +resolution is only useful for very course resolutions, if you want to save some computing +resources in reading larger datasets. For example, this may be useful in obtaining +single-point datasets. + + + +For example, to interpolate to an output resolution of 0.9x1.25, for a constant +simulation-year of 1850, you would do the following: + +> env RES=0.9x1.25 SIM_YR=1850 ncl ndepregrid.ncl + + + + + +Using <command>aerdepregrid.ncl</command> to interpolate Aerosol deposition datasets + +aerdepregrid.ncl interpolates the Aerosol deposition datasets from one resolution. +It can be used to interpolate either constant datasets (for example: +aerosoldep_monthly_2000_0.9x1.25_c090828.nc) or transient datasets (for example: +aerosoldep_monthly_1849-2006_0.9x1.25_c090830.nc). + + + +Interpolating aerosol deposition files is no longer needed, because the &datm; model can +read aerosol deposition files at one resolution and interpolate to the resolution the +model is running at on the fly. Interpolating to another +resolution is only useful for very course resolutions, if you want to save some computing +resources in reading larger datasets. For example, this may be useful in obtaining +single-point datasets. + + + +For example, to interpolate to an output resolution of 4x5, for a transient +simulation-year range of 1850 to 2100 and the rcp of 8.5, you would do the following: + +> env RES=4x5 SIM_YR=1850 SIM_YR_RNG=1850-2100 RCP=8.5 ncl ndepregrid.ncl + + + + + + +How to Customize Datasets for particular Observational Sites + +There are two ways to customize datasets for a particular observational site. The first +is to customize the input to the tools that create the dataset, and the second is to +over-write the default data after you've created a given dataset. Depending on the tool +it might be easier to do it one way or the other. In we list the files that are most likely to be +customized and the way they might be customized. Of those files, the ones you are most +likely to customize are: fatmlndfrc, fsurdat, faerdep (for &datm;), and +stream_fldfilename_ndep. Note mksurfdata as documented previously +has options to overwrite the vegetation and soil types. For more information on this also see + and &ptclm; uses these methods to +customize datasets see . + + +Another aspect of customizing your input datasets is customizing the input atmospheric +forcing datasets. See the for more +information on this. Also the chapter on &ptclm; in +has information on using the AmeriFlux tower site data as atmospheric forcing. + + + + +Conclusion of tools description + +We've given a description of how to use the different tools with &clm; to create +customized datasets. In the next chapter we will talk about how to make these +files available for build-namelist so that you can easily create simulations +that include them. In the chapter on single-point and regional datasets we also +give an alternative way to enter new datasets without having to edit files. + + + + + diff --git a/components/clm/doc/UsersGuide/trouble_shooting.xml b/components/clm/doc/UsersGuide/trouble_shooting.xml new file mode 100644 index 0000000000..418cfabaae --- /dev/null +++ b/components/clm/doc/UsersGuide/trouble_shooting.xml @@ -0,0 +1,545 @@ + + +Trouble Shooting Problems + +In this chapter we give some guidance on what to do when you encounter some of the +most common problems. We can't cover all the problems that a user could potentially +have, but we will try to help you recognize some of the most common situations. +And we'll give you some suggestions on how to approach the problem to come up with +a solution. + + +In general you will run into one of three type of problems: + +configure-time +build-time +run-time + +You may also run into problems with create_newcase itself, or +with the archiving scripts -- for those problems you should consult the +&cesmrel; Scripts User's Guide. + + + +Trouble with Configuration + +The first type of problem happens when you invoke the configure -case +command. This indicates there is something wrong with your template files, or input +datasets, or the details of what you are trying to configure the model to do. +There's also a trouble-shooting chapter in the &cesmrel; +Scripts User's Guide. Many of the problems with configuration can be resolved +with the guidelines given there. Here we will restrict ourselves to problems from the +&clm; or &datm; templates or input files. + +Example of configure problem with missing datasets + +> ./create_newcase -case T31rcp6 -res T31_g37 -compset IRCP60CN \ +-mach bluefire +> ./configure -case + +The following is what is displayed to the screen. + +Generating resolved namelist, prestage, and build scripts +configure done. +adding use_case 1850-2100_rcp6_transient defaults for var clm_demand with val flanduse_timeseries +adding use_case 1850-2100_rcp6_transient defaults for var clm_start_type with val startup +adding use_case 1850-2100_rcp6_transient defaults for var model_year_align_ndep with val +1850 +adding use_case 1850-2100_rcp6_transient defaults for var rcp with val 6 +adding use_case 1850-2100_rcp6_transient defaults for var sim_year with val 1850 +adding use_case 1850-2100_rcp6_transient defaults for var sim_year_range with val +1850-2100 +adding use_case 1850-2100_rcp6_transient defaults for var stream_year_first_ndep with val +1850 +adding use_case 1850-2100_rcp6_transient defaults for var stream_year_last_ndep with val +2100 +adding use_case 1850-2100_rcp6_transient defaults for var use_case_desc with val Simulate +transient land-use, aerosol and Nitrogen deposition changes with historical data from +1850 to 2005 and then with the RCP6 scenario from AIM + +build-namelist - No default value found for flanduse_timeseries. + Are defaults provided for this resolution and land mask? +ERROR: generate_resolved.csh error for lnd template +configure error: configure generated error in attempting to created resolved scripts + + +The important thing to note here is the line: + +ERROR: generate_resolved.csh error for lnd template + +which tells us that the problem is in the land template. It may also indicate problems +in one of the other templates (atm, ccsm, cpl, glc, ice, or ocn), in which case you +should consult the appropriate model user's guide, and examine the given template file +in Tools/Templates. For more information on working with template +files see . + + +In the example above, it's obvious that the problem is coming from the &clm; &buildnml;, +in other situations it might not be so obvious where the problem is occurring. In such +cases it might be useful to add a "set echo" command to the top of the template file so +that each command in the template will be echoed to the screen and you can see what +is happening and where the error is occurring. + +set echo + + + +In the example, the error is that the &clm; XML database does NOT have a +flanduse_timeseries for the given resolution, rcp scenario and ocean mask. +That means you will need to create the file and then supply the file into your case. See + for more information on creating files, and see + for more information on adding files to the +XML database. Alternatively, you can provide the file to your case by creating +a user namelist as shown in . + + + +The two most common problems from your &clm; template will be errors from the &clm; +&configure; or &buildnml;. For more information on these scripts see: + and +the section on &CLMBLDNML;. + + + + + +Trouble with Building + +Here's an example of running the build for a case and having it fail in the land model +build. As you can see it lists which model component is being built and the build log +for that component. + + CCSM BUILDEXE SCRIPT STARTING + - Build Libraries: mct pio csm_share +Sat Jun 19 21:21:19 MDT 2010 /ptmp/erik/test_build/mct/mct.bldlog.100619-212107 +Sat Jun 19 21:22:18 MDT 2010 /ptmp/erik/test_build/pio/pio.bldlog.100619-212107 +Sat Jun 19 21:23:18 MDT 2010 +/ptmp/erik/test_build/csm_share/csm_share.bldlog.100619-212107 +Sat Jun 19 21:24:00 MDT 2010 /ptmp/erik/test_build/run/cpl.bldlog.100619-212107 +Sat Jun 19 21:24:00 MDT 2010 /ptmp/erik/test_build/run/atm.bldlog.100619-212107 +Sat Jun 19 21:24:06 MDT 2010 /ptmp/erik/test_build/run/lnd.bldlog.100619-212107 +ERROR: clm.buildexe.csh failed, see /ptmp/erik/test_build/run/lnd.bldlog.100619-212107 +ERROR: cat /ptmp/erik/test_build/run/lnd.bldlog.100619-212107 + +You can then examine the build log that failed and see what went wrong. Most compilers +will give the full filepath and line number for the file that filed to compile. + + + + +Trouble with Running + +Tracking down problems while the model is running is much more difficult to do +than configure or build problems. In this section we will give some suggestions +on how to find run time problems. Below we show the log file results of a job +that aborted while running. + + CCSM PRESTAGE SCRIPT HAS FINISHED SUCCESSFULLY +Sun Jun 20 18:24:06 MDT 2010 -- CSM EXECUTION BEGINS HERE +Sun Jun 20 18:24:35 MDT 2010 -- CSM EXECUTION HAS FINISHED +Model did not complete - see /ptmp/erik/test_run/run/cpl.log.100620-182358 + +In the next section we will talk about using the different log files to track +down problems, and find out where the problem is coming from. In the section +after that we give some general advice on debugging problems and some suggestions +on ideas that may be helpful to track the problem down. Some of the examples +below are from the &KnownBugs; file. + + +Tracking Problems by Querying Log Files + +The first thing to do when tracking down problems is to query the different log +files to see if you can discover where the problem occurs, and any error messages about +it. It's important to figure out if the problem comes in at initialization or in the +run phase of the model, and in which model component the problem happens. There +are different log files for the different major components, and they all end +with the date and time in YYMMDD-HHMMSS format (2-digit: year, month, day, hour +minute and second). When the model runs to completion the log files will be copied +to the logs directory in the script directory, but when the +model fails they will remain in the run directory. Here's an example list of +log files from an "I" case where the model dies in the land model initialization. +For "I" cases the sea-ice and ocean components are just stubs and don't create +log files (and unless running with the active land-ice model "glc" log files won't +be created either). + +atm.log.100620-182358 +ccsm.log.100620-182358 +cpl.log.100620-182358 +lnd.log.100620-182358 + + + + +The coupler log file + +The first log file to check is the coupler log file so that you can see where +the model dies and which model component it fails in. When the model dies at +initialization the last model component listed is the component that failed. + + +Example of a case that fails in the &clm; land model initialization. + +(seq_timemgr_clockPrint) Prev Time = 00001201 00000 +(seq_timemgr_clockPrint) Next Time = 99991201 00000 +(seq_timemgr_clockPrint) Intervl yms = 9999 0 0 + +(seq_mct_drv) : Initialize each component: atm, lnd, ocn, and ice +(seq_mct_drv) : Initialize atm component +(seq_mct_drv) : Initialize lnd component + + + + + +The ccsm log file + +The ccsm log files are to some extent the "garbage collection" of log output. The +&clm; sends it's output from it's master processor, but sends other output and possibly +errors to the ccsm log file. Because, of this, often error messages are somewhere in the +ccsm log file. However, since there is so much other output it may be difficult to find. +For example, here is some output from an older version of &cesm; (&cesm102;) where the +RTM river routing file (before it was converted to &netcdf;) was not provided and +the error on the open statement for the file was embedded near the end of the ccsm log +file. + +NODE# NAME +( 0) be1105en.ucar.edu +"/gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/lnd/clm/src/riverroute/RtmMod.F90", line +239: 1525-155 The file name provided in the OPEN statement for unit 1 has zero length or +contains all blanks. The program will recover by ignoring the OPEN statement. +"/gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/lnd/clm/src/riverroute/RtmMod.F90", line +241: 1525-001 The READ statement on the file fort.1 cannot be completed because the end +of the file was reached. The program will stop. + +Running: ./ccsm.exe +Please wait... + +Memory usage for ./ccsm.exe (task # 0) is: 51696 KB. Exit status: 1. Signal: 0 + +Although the example is from an earlier version of the model it still serves to +illustrate finding problems from the ccsm log file. + + +When working with the ccsm log file, for a run-time problem, you will need to be able +to separate it's output into three categories: pre-crash, crash, and post-crash. The +pre-crash section is everything that is normal output for good operation of the model. +The crash section is the section where the model dies and reports on the actual problem. +the post-crash section is the cleanup and finalization after the model dies. The most +important part of this of course is the crash section. The tricky part is distinguishing +it from the other sections. Also because the ccsm log file most likely has duplicated +output from multiple processors it is even more difficult to distinguish the different +sections and to some extent the sections may be intertwined, as different processors +reach the different sections at different times. Because, of this reducing the number of +processors for your simulation may help you sort out the output in the file (see +). Also much of the output from the ccsm log file are +system level information having to do with &mpi; multiprocessing. Usually you can ignore +this information, but it makes it more difficult to trudge through. + + +Sometimes the ccsm log file is the ONLY file available, because the model terminates +early in initialization. In this case understanding the output in the ccsm log file +becomes even more important. This also indicates the model did NOT advance far enough +to reach the initialization of the individual model components. This may mean that the +initialization of the multiprocessing for &mpi; and/or &omp; failed, or that the +reading of the driver namelist file "drv_in" failed. + + +Here we show those three sections for a ccsm log file where a two task job failed on +reading the namelist file. For a typical job with many tasks similar sections of this +will be repeated not just twice but for each task and hence make it harder to read. + + +Pre-crash section of the ccsm log file + +ATTENTION: 0031-386 MP_INSTANCES setting ignored when LoadLeveler is not being used. +ATTENTION: 0031-386 MP_INSTANCES setting ignored when LoadLeveler is not being used. +ATTENTION: 0031-378 MP_EUIDEVICE setting ignored when LoadLeveler is not being used. +ATTENTION: 0031-386 MP_INSTANCES setting ignored when LoadLeveler is not being used. + 0:INFO: 0031-724 Executing program: </usr/local/lsf/7.0/aix5-64/bin/lsnrt_run> + 1:INFO: 0031-724 Executing program: </usr/local/lsf/7.0/aix5-64/bin/lsnrt_run> + 0:/contrib/bin/ccsm_launch: process 401894 bound to logical CPU 0 on host be0310en.ucar.edu ... + 1:/contrib/bin/ccsm_launch: process 439264 bound to logical CPU 1 on host be0310en.ucar.edu ... + 0:INFO: 0031-619 64bit(us, Packet striping on) ppe_rmas MPCI_MSG: MPI/MPCI library was compiled on Wed Aug 5 13:36:06 2009 + 0: + 1:LAPI version #14.26 2008/11/23 11:02:30 1.296 src/rsct/lapi/lapi.c, lapi, rsct_rpt53, rpt53s004a 09/04/29 64bit(us) library compiled on Wed Apr 29 15:30:42 2009 + 1:. + 1:LAPI is using lightweight lock. + 0:LAPI version #14.26 2008/11/23 11:02:30 1.296 src/rsct/lapi/lapi.c, lapi, rsct_rpt53, rpt53s004a 09/04/29 64bit(us) library compiled on Wed Apr 29 15:30:42 2009 + 0:. + 0:LAPI is using lightweight lock. + 0:Use health ping for failover/recovery + 1:Use health ping for failover/recovery + 0:Initial communication over instance 2. + 1:Initial communication over instance 0. + 1:IB RDMA initialization completed successfully + 1:The MPI shared memory protocol is used for the job + 0:IB RDMA initialization completed successfully + 0:LAPI job ID for this job is: 1684890719 + 0:The MPI shared memory protocol is used for the job + 0:(seq_comm_setcomm) initialize ID ( 7 GLOBAL ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 2 ATM ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 1 LND ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 4 ICE ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 5 GLC ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 3 OCN ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_setcomm) initialize ID ( 6 CPL ) pelist = 0 1 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_joincomm) initialize ID ( 8 CPLATM ) join IDs = 6 2 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_joincomm) initialize ID ( 9 CPLLND ) join IDs = 6 1 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_joincomm) initialize ID ( 10 CPLICE ) join IDs = 6 4 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_joincomm) initialize ID ( 11 CPLOCN ) join IDs = 6 3 ( npes = 2) ( nthreads = 1) + 0:(seq_comm_joincomm) initialize ID ( 12 CPLGLC ) join IDs = 6 5 ( npes = 2) ( nthreads = 1) + 0: + 0: (seq_comm_printcomms) ID layout : global pes vs local pe for each ID + 0: gpe LND ATM OCN ICE GLC CPL GLOBAL CPLATM CPLLND CPLICE CPLOCN CPLGLC nthrds + 0: --- ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ + 0: 0 : 0 0 0 0 0 0 0 0 0 0 0 0 1 + 1: 1 : 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1: + 0: (t_initf) Read in prof_inparm namelist from: drv_in + 1: (seq_io_init) cpl_io_stride, iotasks or root out of bounds - resetting to defaults 4 0 1 + 0: piolib_mod.f90 1353 1 2 1 2 + 1: piolib_mod.f90 1353 1 2 1 2 + 0: pio_support::pio_die:: myrank= 0 : ERROR: piolib_mod.f90: 1354 : not enough procs for the stride + 1: pio_support::pio_die:: myrank= 1 : ERROR: piolib_mod.f90: 1354 : not enough procs for the stride + + + +Crash section of the ccsm log file + + 0: + 0: Traceback: + 1: + 1: Traceback: + 0: Offset 0x00000c4c in procedure __pio_support_NMOD_piodie, near line 88 in file pio_support.F90.in + 1: Offset 0x00000c4c in procedure __pio_support_NMOD_piodie, near line 88 in file pio_support.F90.in + 0: Offset 0x00000fd0 in procedure __piolib_mod_NMOD_init, near line 1354 in file piolib_mod.F90 + 1: Offset 0x00000fd0 in procedure __piolib_mod_NMOD_init, near line 1354 in file piolib_mod.F90 + 1: Offset 0x00000398 in procedure __seq_io_mod_NMOD_seq_io_init, near line 247 in file /gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/drv/shr/seq_io_mod.F90 + 0: Offset 0x00000398 in procedure __seq_io_mod_NMOD_seq_io_init, near line 247 in file /gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/drv/shr/seq_io_mod.F90 + 0: Offset 0x0001aa88 in procedure ccsm_driver, near line 465 in file /gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/drv/driver/ccsm_driver.F90 + 0: --- End of call chain --- + 1: Offset 0x0001aa88 in procedure ccsm_driver, near line 465 in file /gpfs/proj2/fis/cgd/home/erik/clm_trunk/models/drv/driver/ccsm_driver.F90 + 1: --- End of call chain --- + + + +Post-crash section of the ccsm log file + + 1:Communication statistics of task 1 is associated with task key: 1684890719_1 + 0:Communication statistics of task 0 is associated with task key: 1684890719_0 + 0: + 0:Running: ./ccsm.exe + 0:Please wait... + 0: + 0:Memory usage for ./ccsm.exe (task # 0) is: 198892 KB. Exit status: 134. Signal: 0 + 1: + 1:Running: ./ccsm.exe + 1:Please wait... + 1: + 1:Memory usage for ./ccsm.exe (task # 0) is: 198572 KB. Exit status: 134. Signal: 0 +INFO: 0031-656 I/O file STDOUT closed by task 0 +INFO: 0031-656 I/O file STDERR closed by task 0 +ERROR: 0031-250 task 0: IOT/Abort trap +INFO: 0031-656 I/O file STDOUT closed by task 1 +INFO: 0031-656 I/O file STDERR closed by task 1 +ERROR: 0031-250 task 1: IOT/Abort trap +INFO: 0031-639 Exit status from pm_respond = 0 +ATTENTION: 0031-386 MP_INSTANCES setting ignored when LoadLeveler is not being used. +Job /usr/local/lsf/7.0/aix5-64/bin/poejob /contrib/bin/ccsm_launch /contrib/bin/job_memusage.exe ./ccsm.exe + +TID HOST_NAME COMMAND_LINE STATUS TERMINATION_TIME +===== ========== ================ ======================= =================== +00000 be0310en /contrib/bin/ccs Exit (134) 08/31/2010 12:32:57 +00001 be0310en /contrib/bin/ccs Exit (134) 08/31/2010 12:32:57 + + + + + +The &clm; log file + +Of course when you are working with and making changes to &clm;, most of your focus +will be on the &clm; log file and the errors it shows. As already pointed out +if you don't see errors in the lnd.log.* file you should look +in the ccsm.log.* to see if any errors showed up there. + + +Here's an example of the lnd.log.* file when running +&PTSMODE; with initial conditions (this is bug 1025 in the &KnownBugs; file). + + Successfully initialized variables for accumulation + + reading restart file I2000CN_f09_g16_c100503.clm2.r.0001-01-01-00000.nc + Reading restart dataset + ERROR - setlatlon.F:Cant get variable dim for lat or lsmlat + ENDRUN: called without a message string + + + + + +The &datm; log file + +When working with "I cases" the second most common problems after &clm; problems are +problems with the data atmosphere model. So examining the atm.log.* +is important. + + +Here's an example of a problem that occurs when the wrong prescribed aerosol file +is given to a pt1_pt1 simulation. + +(datm_comp_init) atm mode = CLMNCEP +(shr_strdata_init) calling shr_dmodel_mapSet for fill +(shr_strdata_init) calling shr_dmodel_mapSet for remap + ('shr_map_getWts') ERROR: yd outside bounds 19.5000000000000000 +(shr_sys_abort) ERROR: ('shr_map_getWts') ERROR yd outside 90 degree bounds +(shr_sys_abort) WARNING: calling shr_mpi_abort() and stopping + + + + + +The batch log files + +The names of the batch log files will depend on the batch system of the machine +that is being used. They will normally be in the script directory. Usually, they +don't contain important information, but they are a last resort place to look for +error messages. On the &ncar; IBM system "bluefire" the batch files are called +with names that start with "poe" and then either "stderr" or "stdout", with the +job number at the end. + + + + + + +General Advice on Debugging Run time Problems + +Here are some suggestions on how to track down a problem while running. In general +if the problem still occurs for a simpler case, it will be easier to track down. + +Run in DEBUG mode +Run with a smaller set of processors +Run in serial mode with a single processor +Run at a lower resolution +Run a simpler case +Run with a debugger + + + + +Run in DEBUG mode + +The first thing to try is to run in DEBUG mode so that float point trapping will be +triggered as well as array bounds checking and other things the compiler can turn +on to help you find problems. To do this edit the &envbuild; file and set DEBUG + to TRUE as follows: + +> ./xmlchange -file env_build.xml -id DEBUG -val TRUE + + + + + +Run with a smaller set of processors + +Another way to simplify the system is to run with a smaller set of processors. You +will need to clean the configure and edit the env_mach_pes.xml. +For example, to run with four processors: + +> ./configure -cleanall +> ./xmlchange -file env_mach_pes.xml -id NTASKS_ATM -val 4 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_LND -val 4 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_ICE -val 4 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_OCN -val 4 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_CPL -val 4 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_GLC -val 4 +> ./configure -case + +Another recommended simplification is to run without threading, so set the +NTHRDS for each component to "1" if it isn't already. Sometimes, +multiprocessing problems require a certain number of processors before they occur +so you may not be able to debug the problem without enough processors. But, it's always +good to reduce it to as low a number as possible to make it simpler. For threading +problems you may have to have threading enabled to find the problem, but you can run +with 1, 2, or 3 threads to see what happens. + + + + +Run in serial mode with a single processor + +Simplifying to one processor removes all multi-processing problems and makes +the case as simple as possible. If you can enable USE_MPI_SERIAL +you will also be able to run interactively rather than having to submit to a job +queue, which sometimes makes it easier to run and debug. If you can use +USE_MPI_SERIAL you can also use threading, but still run interactively +in order to use more processors to make it faster if needed. + +> ./configure -cleanall +# Set tasks and threads for each component to 1 +# You could also set threads to something > 1 for speed, but still +# run interactively if threading isn't an issue. +> ./xmlchange -file env_mach_pes.xml -id NTASKS_ATM -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_ATM -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_LND -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_LND -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_ICE -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_ICE -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_OCN -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_OCN -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_CPL -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_CPL -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTASKS_GLC -val 1 +> ./xmlchange -file env_mach_pes.xml -id NTHRDS_GLC -val 1 +# If mpi-serial capability is available on the machine you are using +# set USE_MPI_SERIAL to true so that you can run interactively +> ./xmlchange -file env_conf.xml -id USE_MPI_SERIAL -val TRUE +> ./configure -case +# Then build your case +# And finally run, by running the *.run script interactively +# (If you were able to set USE_MPI_SERIAL to true) + + + + + +Run at a lower resolution + +If you can create a new case running at a lower resolution and replicate the problem +it may be easier to solve. This of course requires creating a whole new case, and trying +out different lower resolutions. + + + + +Run a simpler case + +Along the same lines, you might try running a simpler case, trying another compset +with a simpler setup and see if you can replicate the problem and then debug from that +simpler case. Again, of course you will need to create new cases to do this. + + + + +Run with a debugger + +Another suggestion is to run the model with a debugger such as: dbx, +gdb, or totalview. Often to run with a debugger +you will need to reduce the number of processors as outlined above. Some debuggers such +as dbx will only work with one processor, while more advanced +debuggers such as totalview can work with both &mpi; tasks and OMP +threads. Even simple debuggers though can be used to query core files, to see where +the code was at when it died (for example using the where in +dbx for a core file can be very helpful. For help in running +with a debugger you will need to contact your system administrators for the machine +you are running on. + + + + + + + + diff --git a/components/clm/doc/index.shtml b/components/clm/doc/index.shtml new file mode 100644 index 0000000000..9f01e32b6e --- /dev/null +++ b/components/clm/doc/index.shtml @@ -0,0 +1,25 @@ + +

CLM Documentation

+
    +
  • CLM Users Guide (html) + + (pdf) +
  • CLM Code Reference Guide (html) +
  • CLM Testing Table of Tests run with the offline CLM Test-suite (html) +
+

CLM Quickstart Documentation (all in text format)

+ + diff --git a/components/clm/src/CMakeLists.txt b/components/clm/src/CMakeLists.txt new file mode 100644 index 0000000000..89e9f4f206 --- /dev/null +++ b/components/clm/src/CMakeLists.txt @@ -0,0 +1,75 @@ +cmake_minimum_required(VERSION 2.8) +project(clm45_tests Fortran C) + +list(APPEND CMAKE_MODULE_PATH ${CESM_CMAKE_MODULE_DIRECTORY}) +include(CESM_utils) + +set(CLM_ROOT "..") +set(CESM_ROOT "${CLM_ROOT}/../../") + +# This definition is needed to avoid having ESMF depend on mpi +add_definitions(-DHIDE_MPI) + +# 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(${CESM_ROOT}/cime/share/csm_share/shr csm_share) +add_subdirectory(${CESM_ROOT}/cime/share/esmf_wrf_timemgr esmf_wrf_timemgr) + +# 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/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/ED/main ed_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() + +# Build libraries containing stuff needed for the unit tests. +# Eventually, these add_library calls should probably be distributed into the correct location, rather than being in this top-level CMakeLists.txt file. +add_library(csm_share ${share_sources}) +declare_generated_dependencies(csm_share "${share_genf90_sources}") +add_library(esmf_wrf_timemgr ${esmf_wrf_timemgr_sources}) +add_library(clm ${clm_sources}) +declare_generated_dependencies(clm "${clm_genf90_sources}") +add_dependencies(esmf_wrf_timemgr csm_share) +add_dependencies(clm csm_share esmf_wrf_timemgr) + +# We need to look for header files here, in order to pick up shr_assert.h +include_directories(${CESM_ROOT}/cime/share/csm_share/include) + +# And we need to look for header files here, for some include files needed by +# the esmf_wrf_timemgr code +include_directories(${CESM_ROOT}/cime/share/esmf_wrf_timemgr) + +# Tell cmake to look for libraries & mod files here, because this is where we built libraries +include_directories(${CMAKE_CURRENT_BINARY_DIR}) +link_directories(${CMAKE_CURRENT_BINARY_DIR}) + +# Add the test directories +# Note: it's possible that these could be added by each source directory that +# has tests in it. However, it appears that the order needs to be done +# carefully: for example, include_directories and link_directories needs to be +# done before adding the tests themselves. +add_subdirectory(${CLM_ROOT}/src/unit_test_shr/test clm_unit_test_shr_test) +add_subdirectory(${CLM_ROOT}/src/utils/test clm_utils_test) +add_subdirectory(${CLM_ROOT}/src/biogeophys/test clm_biogeophys_test) +add_subdirectory(${CLM_ROOT}/src/dyn_subgrid/test clm_dyn_subgrid_test) +add_subdirectory(${CLM_ROOT}/src/main/test clm_main_test) diff --git a/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 new file mode 100755 index 0000000000..133639fc67 --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDCanopyStructureMod.F90 @@ -0,0 +1,631 @@ + +module EDCanopyStructureMod + + ! ============================================================================ + ! Code to determine whether the canopy is closed, and which plants are either in the understorey or overstorey + ! This is obviosuly far too complicated for it's own good and needs re-writing. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8; + use clm_varpar , only : nclmax + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use EDGrowthFunctionsMod , only : c_area + use EDCohortDynamicsMod , only : copy_cohort, terminate_cohorts, fuse_cohorts + use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, ncwd + + implicit none + private + + public :: canopy_structure + public :: canopy_spread + + ! 10/30/09: Created by Rosie Fisher + ! ============================================================================ + +contains + + ! ============================================================================ + subroutine canopy_structure( currentSite ) + ! + ! !DESCRIPTION: + ! create cohort instance + ! + ! This routine allocates the 'canopy_layer' attribute to each cohort + ! All top leaves in the same canopy layer get the same light resources. + ! The first canopy layer is the 'canopy' or 'overstorey'. The second is the 'understorey'. + ! More than two layers is not permitted at the moment + ! Seeds germinating into the 3rd or higher layers are automatically removed. + ! + ! ------Perfect Plasticity----- + ! The idea of these canopy layers derives originally from Purves et al. 2009 + ! Their concept is that, given enoughplasticity in canopy position, size, shape and depth + ! all of the gound area will be filled perfectly by leaves, and additional leaves will have + ! to exist in the understorey. + ! Purves et al. use the concept of 'Z*' to assume that the height required to attain a place in the + ! canopy is spatially uniform. In this implementation, described in Fisher et al. (2010, New Phyt) we + ! extent that concept to assume that position in the canopy has some random element, and that BOTH height + ! and chance combine to determine whether trees get into the canopy. + ! Thus, when the canopy is closed and there is excess area, some of it must be demoted + ! If we demote -all- the trees less than a given height, there is a massive advantage in being the cohort that is + ! the biggest when the canopy is closed. + ! In this implementation, the amount demoted, ('weight') is a function of the height weighted by the competitive exclusion + ! parameter (ED_val_comp_excln). + + ! Complexity in this routine results from a few things. + ! Firstly, the complication of the demotion amount sometimes being larger than the cohort area (for a very small, short cohort) + ! Second, occasionaly, disturbance (specifically fire) can cause the canopy layer to become less than closed, + ! without changing the area of the patch. If this happens, then some of the plants in the lower layer need to be 'promoted' so + ! all of the routine has to happen in both the downwards and upwards directions. + ! + ! The order of events here is therefore: + ! (The entire subroutine has a single outer 'patch' loop. + ! Section 1: figure out the total area, and whether there are >1 canopy layers at all. + ! + ! Sorts out cohorts into canopy and understorey layers... + ! + ! !USES: + use clm_varpar, only : nlevcan_ed + use EDParamsMod, only : ED_val_comp_excln, ED_val_ag_biomass + use SFParamsMod, only : SF_val_cwd_frac + use EDtypesMod , only : ncwd + ! + ! !ARGUMENTS + type(ed_site_type) , intent(inout), target :: currentSite + ! + ! !LOCAL VARIABLES: + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort,copyc + integer :: i,j + integer :: z ! Current number of canopy layers. (1= canopy, 2 = understorey) + real(r8) :: checkarea + real(r8) :: cc_loss + real(r8) :: lossarea + real(r8) :: newarea + real(r8) :: arealayer(nlevcan_ed) ! Amount of plant area currently in each canopy layer + real(r8) :: sumdiff(nlevcan_ed) ! The total of the exclusion weights for all cohorts in layer z + real(r8) :: weight ! The amount of the total lost area that comes from this cohort + real(r8) :: sum_weights(nlevcan_ed) + real(r8) :: new_total_area_check + real(r8) :: missing_area, promarea,cc_gain,sumgain + integer :: promswitch,lower_cohort_switch + integer :: c + real(r8) :: sumloss,excess_area + integer :: count_mi + !---------------------------------------------------------------------- + + currentPatch => currentSite%oldest_patch + + ! Section 1: Check total canopy area. + + new_total_area_check = 0._r8 + do while (associated(currentPatch)) ! Patch loop + excess_area = 1.0_r8 + + ! Does any layer have excess area in it? Keep going until it does not... + + do while(excess_area > 0.000001_r8) + + ! Calculate the area currently in each canopy layer. + z = 1 + arealayer = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) ! Reassess cohort area. + arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area + z = max(z,currentCohort%canopy_layer) ! What is the current number of canopy layers? + currentCohort => currentCohort%shorter + enddo + + ! Does the bottom layer have more than a full canopy? If so we need to make another layer. + + if(arealayer(z) > currentPatch%area)then ! Do we have too much area in either layer? + !write(iulog,*) 'CANOPY CLOSURE', z + z = z + 1 + endif + + currentPatch%NCL_p = min(nclmax,z) ! Set current canopy layer occupancy indicator. + + do i = 1,z ! Loop around the currently occupied canopy layers. + + do while((arealayer(i)-currentPatch%area) > 0.000001_r8) + ! Is this layer currently over-occupied? + ! In that case, we need to work out which cohorts to demote. + + sumloss = 0.0_r8 + new_total_area_check = 0.0_r8 + sumdiff(i) = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + if(arealayer(i) > currentPatch%area.and.currentCohort%canopy_layer == i)then + currentCohort%excl_weight = 1.0_r8/(currentCohort%dbh**ED_val_comp_excln) + sumdiff(i) = sumdiff(i) + currentCohort%excl_weight + endif + currentCohort => currentCohort%shorter + enddo !currentCohort + + lossarea = arealayer(i) - currentPatch%area !how much do we have to lose? + sum_weights(i) = 0.0_r8 + currentCohort => currentPatch%tallest !start from the tallest cohort + + ! Correct the demoted cohorts for + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i) then + weight = currentCohort%excl_weight/sumdiff(i) + currentCohort%excl_weight = min(currentCohort%c_area/lossarea, weight) + sum_weights(i) = sum_weights(i) + currentCohort%excl_weight + endif + currentCohort => currentCohort%shorter + enddo + + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i)then !All the trees in this layer need to lose some area... + weight = currentCohort%excl_weight/sum_weights(i) + cc_loss = lossarea*weight !what this cohort has to lose. + !-----------Split and copy boundary cohort-----------------! + if(cc_loss < currentCohort%c_area)then + allocate(copyc) + + call copy_cohort(currentCohort, copyc) !makes an identical copy... + ! n.b this needs to happen BEFORE the cohort goes into the new layer, + ! otherwise currentPatch%spread(i+1) will be higher and the area will change...!!! + sumloss = sumloss + cc_loss + + newarea = currentCohort%c_area - cc_loss + copyc%n = currentCohort%n*newarea/currentCohort%c_area ! + currentCohort%n = currentCohort%n - (currentCohort%n*newarea/currentCohort%c_area) ! + + copyc%canopy_layer = i !the taller cohort is the copy + currentCohort%canopy_layer = i + 1 !demote the current cohort to the understory. + ! seperate cohorts. + ! - 0.000000000001_r8 !needs to be a very small number to avoid + ! causing non-linearity issues with c_area. is this really required? + currentCohort%dbh = currentCohort%dbh + copyc%dbh = copyc%dbh !+ 0.000000000001_r8 + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) + if(i+1 > nclmax)then + !put the litter from the terminated cohorts into the fragmenting pools + ! write(iulog,*) '3rd canopy layer' + do c=1,ncwd + + currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & + ED_val_ag_biomass * & + SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area + + currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & + (1.0_r8-ED_val_ag_biomass) * & + SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. + + enddo + + currentPatch%leaf_litter(currentCohort%pft) = & + currentPatch%leaf_litter(currentCohort%pft) + (currentCohort%bl)* & + currentCohort%n/currentPatch%area ! leaf litter flux per m2. + + currentPatch%root_litter(currentCohort%pft) = & + currentPatch%root_litter(currentCohort%pft) + & + (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area + + currentCohort%n = 0.0_r8 + currentCohort%c_area = 0._r8 + else + currentCohort%c_area = c_area(currentCohort) + endif + copyc%c_area = c_area(copyc) + new_total_area_check = new_total_area_check+copyc%c_area + + !----------- Insert copy into linked list ------------------------! + copyc%shorter => currentCohort + if(associated(currentCohort%taller))then + copyc%taller => currentCohort%taller + currentCohort%taller%shorter => copyc + else + currentPatch%tallest => copyc + copyc%taller => null() + endif + currentCohort%taller => copyc + else + currentCohort%canopy_layer = i + 1 !the whole cohort becomes demoted + sumloss = sumloss + currentCohort%c_area + + !kill the ones which go into canopy layers that are not allowed... (default nclmax=2) + if(i+1 > nclmax)then + !put the litter from the terminated cohorts into the fragmenting pools + do c=1,ncwd + + currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + (currentCohort%bdead+currentCohort%bsw) * & + ED_val_ag_biomass * & + SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area + currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + (currentCohort%bdead+currentCohort%bsw) * & + (1.0_r8-ED_val_ag_biomass) * & + SF_val_CWD_frac(c)*currentCohort%n/currentPatch%area !litter flux per m2. + + enddo + + currentPatch%leaf_litter(currentCohort%pft) = & + currentPatch%leaf_litter(currentCohort%pft) + currentCohort%bl* & + currentCohort%n/currentPatch%area ! leaf litter flux per m2. + + currentPatch%root_litter(currentCohort%pft) = & + currentPatch%root_litter(currentCohort%pft) + & + (currentCohort%br+currentCohort%bstore)*currentCohort%n/currentPatch%area + currentCohort%n = 0.0_r8 + currentCohort%c_area = 0._r8 + + else + currentCohort%c_area = c_area(currentCohort) + endif + + !write(iulog,*) 'demoting whole cohort', currentCohort%c_area,cc_loss, & + !currentCohort%canopy_layer,currentCohort%dbh + + endif + ! call terminate_cohorts(currentPatch) + + !----------- End of cohort splitting ------------------------------! + endif !canopy layer = i + + currentCohort => currentCohort%shorter + + enddo !currentCohort + + call terminate_cohorts(currentPatch) + arealayer(i) = arealayer(i) - sumloss + !Update arealayer for diff calculations of layer below. + arealayer(i + 1) = arealayer(i + 1) + sumloss + + enddo !arealayer loop + if(arealayer(i)-currentPatch%area > 0.00001_r8)then + write(iulog,*) 'lossarea problem', lossarea,sumloss,z,currentPatch%patchno,currentPatch%clm_pno + endif + + enddo !z + + z = 1 + arealayer = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area + z = max(z,currentCohort%canopy_layer) + currentCohort => currentCohort%shorter + enddo + + !does the bottom layer have more than a full canopy? If so we need to make another layer. + if(arealayer(z) > currentPatch%area)then + z = z + 1 + endif + excess_area = 0.0_r8 + do j=1,z + if(arealayer(j) > currentPatch%area)then + excess_area = arealayer(j)-currentPatch%area + endif + enddo + currentPatch%ncl_p = min(z,nclmax) + + enddo !is there still excess area in any layer? + + call terminate_cohorts(currentPatch) + call fuse_cohorts(currentPatch) + call terminate_cohorts(currentPatch) + + ! ----------- Check cohort area ------------------------------! + do i = 1,z + checkarea = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i)then + checkarea = checkarea + c_area(currentCohort) + endif + + currentCohort=>currentCohort%shorter + + enddo + + enddo ! + + + ! ----------- Check whether the intended 'full' layers are actually filling all the space. + ! If not, promote some fraction of cohorts upwards ------------------------------! + ! THIS SECTION MIGHT BE TRIGGERED BY A FIRE OR MORTALITY EVENT, FOLLOWED BY A PATCH FUSION, + ! SO THE TOP LAYER IS NO LONGER FULL... + + promswitch = 0 + + missing_area=1.0_r8 + count_mi = 0 + !does any layer have excess area in it? keep going until it does not... + do while(missing_area > 0.000001_r8.and.z > 1) + count_mi = count_mi +1 + do i = 1,z-1 ! if z is greater than one, there is a possibility of too many plants in the understorey. + lower_cohort_switch = 1 + ! is the area of the layer less than the area of the patch, if it is supposed to be closed (z>1) + do while((arealayer(i)-currentPatch%area) < -0.000001_r8.and.lower_cohort_switch == 1) + + if(arealayer(i+1) <= 0.000001_r8)then + currentCohort => currentPatch%tallest + arealayer = 0._r8 + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i+1)then !look at the cohorts in the canopy layer below... + currentCohort%canopy_layer = i + currentCohort%c_area = c_area(currentCohort) + + ! write(iulog,*) 'promoting very small cohort', currentCohort%c_area,currentCohort%canopy_layer + endif + arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer)+currentCohort%c_area + currentCohort => currentCohort%shorter + enddo + + endif !promoting all of the small amount of area in the lower layers. + + + lower_cohort_switch = 0 + sumgain = 0.0_r8 + sumdiff(i) = 0.0_r8 + ! figure out with what weighting we need to promote cohorts. + ! This is the opposite of the demotion weighting... + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + if(currentCohort%canopy_layer == i+1)then !look at the cohorts in the canopy layer below... + currentCohort%prom_weight = currentCohort%dbh**ED_val_comp_excln !as opposed to 1/(dbh^C_e) + sumdiff(i) = sumdiff(i) + currentCohort%prom_weight + endif + currentCohort => currentCohort%shorter + enddo !currentCohort + + promarea = currentPatch%area -arealayer(i) !how much do we need to gain? + sum_weights(i) = 0.0_r8 + currentCohort => currentPatch%tallest !start from the tallest cohort + + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i+1) then !still looking at the layer beneath. + weight = currentCohort%prom_weight/sumdiff(i) + if(promarea > 0._r8)then + currentCohort%prom_weight = min(currentCohort%c_area/promarea, weight) + else + currentCohort%prom_weight = 0._r8 + endif + sum_weights(i) = sum_weights(i) + currentCohort%prom_weight + endif + currentCohort => currentCohort%shorter + enddo + + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i+1)then !All the trees in this layer need to promote some area upwards... + lower_cohort_switch = 1 + weight = currentCohort%prom_weight/sum_weights(i) + cc_gain = promarea*weight !what this cohort has to promote. + !-----------Split and copy boundary cohort-----------------! + if(cc_gain < currentCohort%c_area)then + allocate(copyc) + + call copy_cohort(currentCohort, copyc) !makes an identical copy... + ! n.b this needs to happen BEFORE the cohort goes into the new layer, otherwise currentPatch + ! %spread(+1) will be higher and the area will change...!!! + sumgain = sumgain + cc_gain + + + newarea = currentCohort%c_area - cc_gain !new area of existing cohort + copyc%n = currentCohort%n*cc_gain/currentCohort%c_area !number of individuals in promoted cohort. + ! number of individuals in cohort remianing in understorey + currentCohort%n = currentCohort%n - (currentCohort%n*cc_gain/currentCohort%c_area) + + currentCohort%canopy_layer = i+1 !keep current cohort in the understory. + copyc%canopy_layer = i ! promote copy to the higher canopy layer. + + ! seperate cohorts. + ! needs to be a very small number to avoid causing non-linearity issues with c_area. + ! is this really required? + currentCohort%dbh = currentCohort%dbh - 0.000000000001_r8 + copyc%dbh = copyc%dbh + 0.000000000001_r8 + + currentCohort%c_area = c_area(currentCohort) + copyc%c_area = c_area(copyc) + + !----------- Insert copy into linked list ------------------------! + copyc%shorter => currentCohort + if(associated(currentCohort%taller))then + copyc%taller => currentCohort%taller + currentCohort%taller%shorter => copyc + else + currentPatch%tallest => copyc + copyc%taller => null() + endif + currentCohort%taller => copyc + else + currentCohort%canopy_layer = i !the whole cohort becomes promoted + sumgain = sumgain + currentCohort%c_area !inserting deliberate mistake to see how far we make it... + ! update area AFTER we sum up the losses. the cohort may shrink at this point, + ! if the upper canopy spread is smaller. this shold be dealt with by the 'excess area' loop. + currentCohort%c_area = c_area(currentCohort) + + promswitch = 1 + + ! write(iulog,*) 'promoting whole cohort', currentCohort%c_area,cc_gain,currentCohort%canopy_layer, & + !currentCohort%pft,currentPatch%patchno + + endif + !call terminate_cohorts(currentPatch) + if(promswitch == 1)then + ! write(iulog,*) 'cohort loop',currentCohort%pft,currentCohort%indexnumber,currentPatch%patchno + endif + !----------- End of cohort splitting ------------------------------! + else + if(promswitch == 1)then + ! write(iulog,*) 'cohort list',currentCohort%pft,currentCohort%indexnumber, & + ! currentCohort%canopy_layer,currentCohort%c_area + endif + endif + + currentCohort => currentCohort%shorter + enddo !currentCohort + arealayer(i) = arealayer(i) + sumgain + arealayer(i + 1) = arealayer(i + 1) - sumgain !Update arealayer for diff calculations of layer below. + + if(promswitch == 1)then + ! write(iulog,*) 'arealayer loop',arealayer(1:3),currentPatch%area,promarea,sumgain, & + !currentPatch%patchno,z,i,lower_cohort_switch + endif + if(promswitch == 1.and.associated(currentPatch%tallest))then + ! write(iulog,*) 'cohorts',currentCohort%pft,currentCohort%indexnumber,currentPatch%patchno, & + !currentCohort%c_area + endif + enddo !arealayer loop + + if(currentPatch%area-arealayer(i) < 0.000001_r8)then + !write(iulog,*) 'gainarea problem',sumgain,arealayer(i),currentPatch%area,z, & + !currentPatch%patchno,currentPatch%clm_pno,currentPatch%area - arealayer(i),i,missing_area,count_mi + endif + if(promswitch == 1)then + ! write(iulog,*) 'z loop',arealayer(1:3),currentPatch%patchno,z + endif + enddo !z + + z = 1 + arealayer = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area + z = max(z,currentCohort%canopy_layer) + currentCohort => currentCohort%shorter + enddo + + missing_area = 0.0_r8 + do j=1,z-1 + if(arealayer(j) < currentPatch%area)then !this is the amount of area that we still have spare in this layer. + missing_area = currentPatch%area - arealayer(j) + if(missing_area <= 0.000001_r8.and.missing_area > 0._r8)then + missing_area = 0.0_r8 + ! write(iulog,*) 'correcting MI',j,currentPatch%area - arealayer(j) + endif + endif + enddo + currentPatch%ncl_p = min(z,nclmax) + if(promswitch == 1)then + ! write(iulog,*) 'missingarea loop',arealayer(1:3),currentPatch%patchno,missing_area,z + endif + enddo !is there still not enough canopy area in any layer? + + call terminate_cohorts(currentPatch) + call fuse_cohorts(currentPatch) + call terminate_cohorts(currentPatch) + + if(promswitch == 1)then + !write(iulog,*) 'going into cohort check',currentPatch%clm_pno + endif + ! ----------- Check cohort area ------------------------------! + do i = 1,z + checkarea = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i)then + checkarea = checkarea + c_area(currentCohort) + endif + + currentCohort => currentCohort%shorter + + enddo + + if(((checkarea-currentPatch%area)) > 0.0001)then + write(iulog,*) 'problem with canopy area', checkarea,currentPatch%area,checkarea-currentPatch%area,i,z,missing_area + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + if(currentCohort%canopy_layer == i)then + write(iulog,*) 'c_areas in top layer', c_area(currentCohort) + endif + currentCohort => currentCohort%shorter + + enddo + + endif + + if ( i > 1) then + if ( (arealayer(i) - arealayer(i-1) )>1e-11 ) then + write(iulog,*) 'smaller top layer than bottom layer ',arealayer(i),arealayer(i-1), & + currentPatch%area,currentPatch%spread(i-1:i) + endif + endif + enddo ! + + if(promswitch == 1)then + ! write(iulog,*) 'end patch loop',currentSite%clmgcell + endif + + currentPatch => currentPatch%younger + enddo !patch + + if(promswitch == 1)then + ! write(iulog,*) 'end canopy structure',currentSite%clmgcell + endif + + end subroutine canopy_structure + + ! ============================================================================ + subroutine canopy_spread( currentSite ) + ! + ! !DESCRIPTION: + ! Calculates the spatial spread of tree canopies based on canopy closure. + ! + ! !USES: + use clm_varpar , only : nlevcan_ed + use EDParamsMod , only : ED_val_maxspread, ED_val_minspread + ! + ! !ARGUMENTS + type (ed_site_type), intent(inout), target :: currentSite + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type), pointer :: currentCohort + type (ed_patch_type) , pointer :: currentPatch + real(r8) :: arealayer(nlevcan_ed) ! Amount of canopy in each layer. + real(r8) :: inc ! Arbitrary daily incremental change in canopy area + integer :: z + !---------------------------------------------------------------------- + + inc = 0.005_r8 + + currentPatch => currentSite%oldest_patch + + do while (associated(currentPatch)) + + !calculate canopy area in each canopy storey... + arealayer = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + if(pftcon%woody(currentCohort%pft) == 1)then + arealayer(currentCohort%canopy_layer) = arealayer(currentCohort%canopy_layer) + currentCohort%c_area + endif + currentCohort => currentCohort%shorter + enddo + + !If the canopy area is approaching closure, squash the tree canopies and make them taller and thinner + do z = 1,nclmax + + if(arealayer(z)/currentPatch%area > 0.9_r8)then + currentPatch%spread(z) = currentPatch%spread(z) - inc + else + currentPatch%spread(z) = currentPatch%spread(z) + inc + endif + if(currentPatch%spread(z) >= ED_val_maxspread)then + currentPatch%spread(z) = ED_val_maxspread + endif + if(currentPatch%spread(z) <= ED_val_minspread)then + currentPatch%spread(z) = ED_val_minspread + endif + enddo !z + !write(iulog,*) 'spread',currentPatch%spread(1:2) + !currentPatch%spread(:) = ED_val_maxspread + !FIX(RF,033114) spread is off + !write(iulog,*) 'canopy_spread',currentPatch%area,currentPatch%spread(1:2) + currentPatch => currentPatch%younger + + enddo !currentPatch + + end subroutine canopy_spread + +end module EDCanopyStructureMod diff --git a/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 new file mode 100755 index 0000000000..7fe96b45a5 --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDCohortDynamicsMod.F90 @@ -0,0 +1,993 @@ +module EDCohortDynamicsMod + ! + ! !DESCRIPTION: + ! Cohort stuctures in ED. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8; + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use EDEcophysContype , only : EDecophyscon + use EDGrowthFunctionsMod , only : c_area, tree_lai + use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDTypesMod , only : fusetol, nclmax + use EDtypesMod , only : ncwd, numcohortsperpatch, udata + ! + implicit none + private + ! + public :: create_cohort + public :: zero_cohort + public :: nan_cohort + public :: terminate_cohorts + public :: fuse_cohorts + public :: insert_cohort + public :: sort_cohorts + public :: copy_cohort + public :: count_cohorts + public :: countCohorts + public :: allocate_live_biomass + + ! 10/30/09: Created by Rosie Fisher + !-------------------------------------------------------------------------------------! + +contains + + !-------------------------------------------------------------------------------------! + subroutine create_cohort(patchptr, pft, nn, hite, dbh, & + balive, bdead, bstore, laimemory, status, ctrim, clayer) + ! + ! !DESCRIPTION: + ! create new cohort + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type), intent(inout), pointer :: patchptr + integer, intent(in) :: pft ! Cohort Plant Functional Type + integer, intent(in) :: clayer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + integer, intent(in) :: status ! growth status of plant (2 = leaves on , 1 = leaves off) + real(r8), intent(in) :: nn ! number of individuals in cohort per 'area' (10000m2 default) + real(r8), intent(in) :: hite ! height: meters + real(r8), intent(in) :: dbh ! dbh: cm + real(r8), intent(in) :: balive ! total living biomass: kGC per indiv + real(r8), intent(in) :: bdead ! total dead biomass: kGC per indiv + real(r8), intent(in) :: bstore ! stored carbon: kGC per indiv + real(r8), intent(in) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv + real(r8), intent(in) :: ctrim ! What is the fraction of the maximum leaf biomass that we are targeting? :- + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: new_cohort ! Pointer to New Cohort structure. + type(ed_cohort_type), pointer :: storesmallcohort + type(ed_cohort_type), pointer :: storebigcohort + integer :: tnull,snull ! are the tallest and shortest cohorts allocate + !---------------------------------------------------------------------- + + allocate(new_cohort) + udata%cohort_number = udata%cohort_number + 1 !give each cohort a unique number for checking cohort fusing routine. + + call nan_cohort(new_cohort) ! Make everything in the cohort not-a-number + call zero_cohort(new_cohort) ! Zero things that need to be zeroed. + + !**********************/ + ! Define cohort state variable + !**********************/ + + new_cohort%indexnumber = udata%cohort_number + new_cohort%siteptr => patchptr%siteptr + new_cohort%patchptr => patchptr + new_cohort%pft = pft + new_cohort%status_coh = status + new_cohort%n = nn + new_cohort%hite = hite + new_cohort%dbh = dbh + new_cohort%canopy_trim = ctrim + new_cohort%canopy_layer = clayer + new_cohort%laimemory = laimemory + new_cohort%bdead = bdead + new_cohort%balive = balive + new_cohort%bstore = bstore + + if (new_cohort%dbh <= 0.0_r8 .or. new_cohort%n == 0._r8 .or. new_cohort%pft == 0 & + .or. new_cohort%canopy_trim <= 0.0_r8 .or. new_cohort%balive <= 0._r8) then + write(iulog,*) 'ED: something is zero in create_cohort',new_cohort%indexnumber,new_cohort%dbh,new_cohort%n, & + new_cohort%pft,new_cohort%canopy_trim,new_cohort%balive + endif + if (new_cohort%siteptr%status==2.and.pftcon%season_decid(pft) == 1) then + new_cohort%laimemory = 0.0_r8 + endif + if (new_cohort%siteptr%dstatus==2.and.pftcon%stress_decid(pft) == 1) then + new_cohort%laimemory = 0.0_r8 + endif + + ! Calculate live biomass allocation + call allocate_live_biomass(new_cohort) + + ! Assign canopy extent and depth + new_cohort%c_area = c_area(new_cohort) + new_cohort%treelai = tree_lai(new_cohort) + new_cohort%lai = new_cohort%treelai * new_cohort%c_area/patchptr%area + new_cohort%treesai = 0.0_r8 !FIX(RF,032414) + + ! Put cohort at the right place in the linked list + storebigcohort => patchptr%tallest + storesmallcohort => patchptr%shortest + + if (associated(patchptr%tallest)) then + tnull = 0 + else + tnull = 1 + patchptr%tallest => new_cohort + endif + + if (associated(patchptr%shortest)) then + snull = 0 + else + snull = 1 + patchptr%shortest => new_cohort + endif + + call insert_cohort(new_cohort, patchptr%tallest, patchptr%shortest, tnull, snull, & + storebigcohort, storesmallcohort) + + patchptr%tallest => storebigcohort + patchptr%shortest => storesmallcohort + + end subroutine create_cohort + + !-------------------------------------------------------------------------------------! + subroutine allocate_live_biomass(cc_p) + ! + ! !DESCRIPTION: + ! Divide alive biomass between leaf, root and sapwood parts. + ! Needs to be called whenver balive changes. + ! + ! !USES: + ! + ! !ARGUMENTS + type (ed_cohort_type), intent(inout), target :: cc_p ! current cohort pointer + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type), pointer :: currentCohort + real(r8) :: leaf_frac ! fraction of live biomass in leaves + real(r8) :: ideal_balive ! theoretical ideal (root and stem) biomass for deciduous trees with leaves off. + ! accounts for the fact that live biomass may decline in the off-season, + ! making leaf_memory unrealistic. + real(r8) :: ratio_balive ! ratio between root+shoot biomass now and root+shoot biomass when leaves fell off. + + integer :: ft ! functional type + integer :: leaves_off_switch + !---------------------------------------------------------------------- + + currentCohort => cc_p + ft = currentcohort%pft + leaf_frac = 1.0_r8/(1.0_r8 + EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + pftcon%froot_leaf(ft)) + + currentcohort%bl = currentcohort%balive*leaf_frac + ratio_balive = 1.0_r8 + !for deciduous trees, there are no leaves + + if (pftcon%evergreen(ft) == 1) then + currentcohort%laimemory = 0._r8 + currentcohort%status_coh = 2 + endif + + !diagnore the root and stem biomass from the functional balance hypothesis. This is used when the leaves are + !fully on. + currentcohort%br = pftcon%froot_leaf(ft) * (currentcohort%balive + currentcohort%laimemory) * leaf_frac + currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(currentcohort%balive + & + currentcohort%laimemory)*leaf_frac + + leaves_off_switch = 0 + if (currentcohort%status_coh == 1.and.pftcon%stress_decid(ft) == 1.and.currentcohort%siteptr%dstatus==1) then !no leaves + leaves_off_switch = 1 !drought decid + endif + if (currentcohort%status_coh == 1.and.pftcon%season_decid(ft) == 1.and.currentcohort%siteptr%status==1) then !no leaves + leaves_off_switch = 1 !cold decid + endif + + if (leaves_off_switch==1) then + + !the purpose of this section is to figure out the root and stem biomass when the leaves are off + !at this point, we know the former leaf mass (laimemory) and the current alive mass + !because balive may decline in the off-season, we need to adjust the root and stem biomass that are predicted + !from the laimemory, for the fact that we now might not have enough live biomass to support the hypothesized root mass + !thus, we use 'ratio_balive' to adjust br and bsw. Apologies that this is so complicated! RF + currentcohort%bl = 0.0_r8 + ideal_balive = currentcohort%laimemory * pftcon%froot_leaf(ft) + & + currentcohort%laimemory* EDecophyscon%sapwood_ratio(ft) * currentcohort%hite + currentcohort%br = pftcon%froot_leaf(ft) * (ideal_balive + currentcohort%laimemory) * leaf_frac + currentcohort%bsw = EDecophyscon%sapwood_ratio(ft) * currentcohort%hite *(ideal_balive + & + currentcohort%laimemory)*leaf_frac + + ratio_balive = currentcohort%balive / ideal_balive + currentcohort%br = currentcohort%br * ratio_balive + currentcohort%bsw = currentcohort%bsw * ratio_balive + endif + + + if (abs(currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw)>1e-12) then + write(iulog,*) 'issue with carbon allocation in create_cohort',& + currentcohort%balive -currentcohort%bl- currentcohort%br - currentcohort%bsw, currentcohort%status_coh,currentcohort%balive + write(iulog,*) 'actual vs predicted balive',ideal_balive,currentcohort%balive ,ratio_balive,leaf_frac + write(iulog,*) 'leaf,root,stem',currentcohort%bl,currentcohort%br,currentcohort%bsw + endif + currentCohort%b = currentCohort%bdead + currentCohort%balive + + end subroutine allocate_live_biomass + + !-------------------------------------------------------------------------------------! + subroutine nan_cohort(cc_p) + ! + ! !DESCRIPTION: + ! Make all the cohort variables NaN so they aren't used before defined. + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS + type (ed_cohort_type), intent(inout), target :: cc_p + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type) , pointer :: currentCohort + !---------------------------------------------------------------------- + + currentCohort => cc_p + + currentCohort%taller => null() ! pointer to next tallest cohort + currentCohort%shorter => null() ! pointer to next shorter cohort + currentCohort%patchptr => null() ! pointer to patch that cohort is in + currentCohort%siteptr => null() ! pointer to site that cohort is in + + nullify(currentCohort%taller) + nullify(currentCohort%shorter) + nullify(currentCohort%patchptr) + nullify(currentCohort%siteptr) + + ! VEGETATION STRUCTURE + currentCohort%pft = 999 ! pft number + currentCohort%indexnumber = 999 ! unique number for each cohort. (within clump?) + currentCohort%canopy_layer = 999 ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + currentCohort%NV = 999 ! Number of leaf layers: - + currentCohort%status_coh = 999 ! growth status of plant (2 = leaves on , 1 = leaves off) + + currentCohort%n = nan ! number of individuals in cohort per 'area' (10000m2 default) + currentCohort%dbh = nan ! 'diameter at breast height' in cm + currentCohort%hite = nan ! height: meters + currentCohort%balive = nan ! total living biomass: kGC per indiv + currentCohort%bdead = nan ! dead biomass: kGC per indiv + currentCohort%bstore = nan ! stored carbon: kGC per indiv + currentCohort%laimemory = nan ! target leaf biomass- set from previous year: kGC per indiv + currentCohort%b = nan ! total biomass: kGC per indiv + currentCohort%bsw = nan ! sapwood in stem and roots: kGC per indiv + currentCohort%bl = nan ! leaf biomass: kGC per indiv + currentCohort%br = nan ! fine root biomass: kGC per indiv + currentCohort%lai = nan ! leaf area index of cohort m2/m2 + currentCohort%sai = nan ! stem area index of cohort m2/m2 + currentCohort%gscan = nan ! Stomatal resistance of cohort. + currentCohort%canopy_trim = nan ! What is the fraction of the maximum leaf biomass that we are targeting? :- + currentCohort%leaf_cost = nan ! How much does it cost to maintain leaves: kgC/m2/year-1 + currentCohort%excl_weight = nan ! How much of this cohort is demoted each year, as a proportion of all cohorts:- + currentCohort%prom_weight = nan ! How much of this cohort is promoted each year, as a proportion of all cohorts:- + currentCohort%c_area = nan ! areal extent of canopy (m2) + currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) + currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) + + ! CARBON FLUXES + currentCohort%gpp = nan ! GPP: kgC/indiv/year + currentCohort%gpp_clm = nan ! GPP: kgC/indiv/timestep + currentCohort%gpp_acc = nan ! GPP: kgC/indiv/day + currentCohort%npp = nan ! NPP: kgC/indiv/year + currentCohort%npp_clm = nan ! NPP: kGC/indiv/timestep + currentCohort%npp_acc = nan ! NPP: kgC/indiv/day + currentCohort%year_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/year + currentCohort%ts_net_uptake(:) = nan ! Net uptake of individual leaf layers kgC/m2/s + currentCohort%resp = nan ! RESP: kgC/indiv/year + currentCohort%resp_clm = nan ! RESP: kgC/indiv/timestep + currentCohort%resp_acc = nan ! RESP: kGC/cohort/day + + !RESPIRATION + currentCohort%rd = nan + currentCohort%resp_m = nan ! Maintenance respiration. kGC/cohort/year + currentCohort%resp_g = nan ! Growth respiration. kGC/cohort/year + currentCohort%livestem_mr = nan ! Live stem maintenance respiration. kgC/indiv/s-1 + currentCohort%livecroot_mr = nan ! Coarse root maintenance respiration. kgC/indiv/s-1 + currentCohort%froot_mr = nan ! Fine root maintenance respiration. kgC/indiv/s-1 + + ! ALLOCATION + currentCohort%md = nan ! plant maintenance demand: kgC/indiv/year + currentCohort%leaf_md = nan ! leaf maintenance demand: kgC/indiv/year + currentCohort%root_md = nan ! root maintenance demand: kgC/indiv/year + currentCohort%carbon_balance = nan ! carbon remaining for growth and storage: kg/indiv/year + currentCohort%dmort = nan ! proportional mortality rate. (year-1) + currentCohort%seed_prod = nan ! reproduction seed and clonal: KgC/indiv/year + currentCohort%c_area = nan ! areal extent of canopy (m2) + currentCohort%treelai = nan ! lai of tree (total leaf area (m2) / canopy area (m2) + currentCohort%treesai = nan ! stem area index of tree (total stem area (m2) / canopy area (m2) + currentCohort%leaf_litter = nan ! leaf litter from phenology: KgC/m2 + currentCohort%woody_turnover = nan ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. + + ! NITROGEN POOLS + currentCohort%livestemn = nan ! live stem nitrogen : KgN/invid + currentCohort%livecrootn = nan ! live coarse root nitrogen: KgN/invid + currentCohort%frootn = nan ! fine root nitrogen : KgN/invid + + ! VARIABLES NEEDED FOR INTEGRATION + currentCohort%dndt = nan ! time derivative of cohort size + currentCohort%dhdt = nan ! time derivative of height + currentCohort%ddbhdt = nan ! time derivative of dbh + currentCohort%dbalivedt = nan ! time derivative of total living biomass + currentCohort%dbdeaddt = nan ! time derivative of dead biomass + currentCohort%dbstoredt = nan ! time derivative of stored biomass + currentCohort%storage_flux = nan ! flux from npp into bstore + + ! FIRE + currentCohort%cfa = nan ! proportion of crown affected by fire + currentCohort%cambial_mort = nan ! probability that trees dies due to cambial char P&R (1986) + currentCohort%crownfire_mort = nan ! probability of tree post-fire mortality due to crown scorch + currentCohort%fire_mort = nan ! post-fire mortality from cambial and crown damage assuming two are independent + + end subroutine nan_cohort + + !-------------------------------------------------------------------------------------! + subroutine zero_cohort(cc_p) + ! + ! !DESCRIPTION: + ! Zero variables that need to be accounted for if + ! this cohort is altered before they are defined. + ! + ! !USES: + ! + ! !ARGUMENTS + type (ed_cohort_type), intent(inout), target :: cc_p + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type) , pointer :: currentCohort + !---------------------------------------------------------------------- + + currentCohort => cc_p + + currentCohort%NV = 0 + currentCohort%status_coh = 0 + currentCohort%rd = 0._r8 + currentCohort%resp_m = 0._r8 + currentCohort%resp_g = 0._r8 + currentCohort%livestem_mr = 0._r8 + currentCohort%livecroot_mr = 0._r8 + currentCohort%froot_mr = 0._r8 + currentCohort%fire_mort = 0._r8 + currentcohort%npp_acc = 0._r8 + currentcohort%gpp_acc = 0._r8 + currentcohort%resp_acc = 0._r8 + currentcohort%npp_clm = 0._r8 + currentcohort%gpp_clm = 0._r8 + currentcohort%resp_clm = 0._r8 + currentcohort%resp = 0._r8 + currentcohort%carbon_balance = 0._r8 + currentcohort%leaf_litter = 0._r8 + currentcohort%year_net_uptake(:) = 999 ! this needs to be 999, or trimming of new cohorts will break. + currentcohort%ts_net_uptake(:) = 0._r8 + currentcohort%seed_prod = 0._r8 + currentcohort%cfa = 0._r8 + currentcohort%md = 0._r8 + currentcohort%root_md = 0._r8 + currentcohort%leaf_md = 0._r8 + currentcohort%npp = 0._r8 + currentcohort%gpp = 0._r8 + currentcohort%storage_flux = 0._r8 + currentcohort%dmort = 0._r8 + currentcohort%gscan = 0._r8 + currentcohort%treesai = 0._r8 + + end subroutine zero_cohort + + !-------------------------------------------------------------------------------------! + subroutine terminate_cohorts( patchptr ) + ! + ! !DESCRIPTION: + ! terminates cohorts when they get too small + ! + ! !USES: + use EDParamsMod, only : ED_val_ag_biomass + use SFParamsMod, only : SF_val_CWD_frac + ! + ! !ARGUMENTS + type (ed_patch_type), intent(inout), target :: patchptr + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type) , pointer :: currentCohort + type (ed_cohort_type) , pointer :: nextc + integer :: terminate ! do we terminate (1) or not (0) + integer :: c ! counter for litter size class. + !---------------------------------------------------------------------- + + currentPatch => patchptr + currentCohort => currentPatch%tallest + + do while (associated(currentCohort)) + nextc => currentCohort%shorter + terminate = 0 + + ! Not enough n or dbh + if (currentCohort%n/currentPatch%area <= 0.00001_r8 .or. currentCohort%dbh < & + 0.00001_r8.and.currentCohort%bstore < 0._r8) then + terminate = 1 + ! write(iulog,*) 'terminating cohorts 1',currentCohort%n/currentPatch%area,currentCohort%dbh + endif + + ! In the third canopy layer + if (currentCohort%canopy_layer > NCLMAX) then + terminate = 1 + ! write(iulog,*) 'terminating cohorts 2', currentCohort%canopy_layer + endif + + ! live biomass pools are terminally depleted + if (currentCohort%balive < 1e-10_r8 .or. currentCohort%bstore < 1e-10_r8) then + terminate = 1 + ! write(iulog,*) 'terminating cohorts 3', currentCohort%balive,currentCohort%bstore + endif + + ! Total cohort biomass is negative + if (currentCohort%balive+currentCohort%bdead+currentCohort%bstore < 0._r8) then + terminate = 1 + ! write(iulog,*) 'terminating cohorts 4', currentCohort%balive, currentCohort%bstore, currentCohort%bdead, & + ! currentCohort%balive+currentCohort%bdead+& + ! currentCohort%bstore, currentCohort%n + endif + + + if (terminate == 1) then + if (.not. associated(currentCohort%taller)) then + currentPatch%tallest => currentCohort%shorter + else + currentCohort%taller%shorter => currentCohort%shorter + endif + if (.not. associated(currentCohort%shorter)) then + currentPatch%shortest => currentCohort%taller + else + currentCohort%shorter%taller => currentCohort%taller + endif + + !put the litter from the terminated cohorts straight into the fragmenting pools + if (currentCohort%n.gt.0.0_r8) then + do c=1,ncwd + + currentPatch%CWD_AG(c) = currentPatch%CWD_AG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / & + currentPatch%area & + * SF_val_CWD_frac(c) * ED_val_ag_biomass + currentPatch%CWD_BG(c) = currentPatch%CWD_BG(c) + currentCohort%n*(currentCohort%bdead+currentCohort%bsw) / & + currentPatch%area & + * SF_val_CWD_frac(c) * (1.0_r8 - ED_val_ag_biomass) + enddo + + currentPatch%leaf_litter(currentCohort%pft) = currentPatch%leaf_litter(currentCohort%pft) + currentCohort%n* & + (currentCohort%bl)/currentPatch%area + currentPatch%root_litter(currentCohort%pft) = currentPatch%root_litter(currentCohort%pft) + currentCohort%n* & + (currentCohort%br+currentCohort%bstore)/currentPatch%area + + deallocate(currentCohort) + endif + endif + currentCohort => nextc + enddo + + end subroutine terminate_cohorts + + !-------------------------------------------------------------------------------------! + subroutine fuse_cohorts(patchptr) + ! + ! !DESCRIPTION: + ! Join similar cohorts to reduce total number + ! + ! !USES: + use clm_varpar , only : nlevcan_ed + ! + ! !ARGUMENTS + type (ed_patch_type), intent(inout), target :: patchptr + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type) , pointer :: currentCohort, nextc, nextnextc + integer :: i + integer :: fusion_took_place + integer :: maxcohorts !maximum total no of cohorts. Needs to be >numpft_edx2 + integer :: iterate !do we need to keep fusing to get below maxcohorts? + integer :: nocohorts + real(r8) :: newn + real(r8) :: diff + real(r8) :: dynamic_fusion_tolerance + !---------------------------------------------------------------------- + + !set initial fusion tolerance + dynamic_fusion_tolerance = fusetol + + !This needs to be a function of the canopy layer, because otherwise, at canopy closure + !the number of cohorts doubles and very dissimilar cohorts are fused together + !because c_area and biomass are non-linear with dbh, this causes several mass inconsistancies + !in theory, all of this routine therefore causes minor losses of C and area, but these are below + !detection limit normally. + iterate = 1 + fusion_took_place = 0 + currentPatch => patchptr + maxcohorts = currentPatch%NCL_p * numCohortsPerPatch + !---------------------------------------------------------------------! + ! Keep doing this until nocohorts <= maxcohorts ! + !---------------------------------------------------------------------! + if (associated(currentPatch%shortest)) then + do while(iterate == 1) + + currentCohort => currentPatch%tallest + + !CHANGED FROM C VERSION loop from tallest to smallest, fusing if they are similar + do while (currentCohort%indexnumber /= currentPatch%shortest%indexnumber) + nextc => currentPatch%tallest + + do while (associated(nextc)) + nextnextc => nextc%shorter + diff = abs((currentCohort%dbh - nextc%dbh)/(0.5*(currentCohort%dbh + nextc%dbh))) + + !Criteria used to divide up the height continuum into different cohorts. + + if (diff < dynamic_fusion_tolerance) then + + if (currentCohort%indexnumber /= nextc%indexnumber) then + + if (currentCohort%pft == nextc%pft) then + + ! check cohorts in same c. layer. before fusing + if (currentCohort%canopy_layer == nextc%canopy_layer) then + fusion_took_place = 1 + newn = currentCohort%n + nextc%n ! sum individuals in both cohorts. + + currentCohort%balive = (currentCohort%n*currentCohort%balive + nextc%n*nextc%balive)/newn + currentCohort%bdead = (currentCohort%n*currentCohort%bdead + nextc%n*nextc%bdead)/newn + currentCohort%bstore = (currentCohort%n*currentCohort%bstore + nextc%n*nextc%bstore)/newn + currentCohort%seed_prod = (currentCohort%n*currentCohort%seed_prod + nextc%n*nextc%seed_prod)/newn + currentCohort%root_md = (currentCohort%n*currentCohort%root_md + nextc%n*nextc%root_md)/newn + currentCohort%leaf_md = (currentCohort%n*currentCohort%leaf_md + nextc%n*nextc%leaf_md)/newn + currentCohort%laimemory = (currentCohort%n*currentCohort%laimemory + nextc%n*nextc%laimemory)/newn + currentCohort%md = (currentCohort%n*currentCohort%md + nextc%n*nextc%md)/newn + + currentCohort%carbon_balance = (currentCohort%n*currentCohort%carbon_balance + & + nextc%n*nextc%carbon_balance)/newn + currentCohort%storage_flux = (currentCohort%n*currentCohort%storage_flux + & + nextc%n*nextc%storage_flux)/newn + + currentCohort%b = (currentCohort%n*currentCohort%b + nextc%n*nextc%b)/newn + currentCohort%bsw = (currentCohort%n*currentCohort%bsw + nextc%n*nextc%bsw)/newn + currentCohort%bl = (currentCohort%n*currentCohort%bl + nextc%n*nextc%bl)/newn + currentCohort%br = (currentCohort%n*currentCohort%br + nextc%n*nextc%br)/newn + currentCohort%hite = (currentCohort%n*currentCohort%hite + nextc%n*nextc%hite)/newn + currentCohort%dbh = (currentCohort%n*currentCohort%dbh + nextc%n*nextc%dbh)/newn + currentCohort%gpp_acc = (currentCohort%n*currentCohort%gpp_acc + nextc%n*nextc%gpp_acc)/newn + currentCohort%npp_acc = (currentCohort%n*currentCohort%npp_acc + nextc%n*nextc%npp_acc)/newn + currentCohort%resp_acc = (currentCohort%n*currentCohort%resp_acc + nextc%n*nextc%resp_acc)/newn + currentCohort%resp = (currentCohort%n*currentCohort%resp + nextc%n*nextc%resp)/newn + currentCohort%npp = (currentCohort%n*currentCohort%npp + nextc%n*nextc%npp)/newn + currentCohort%gpp = (currentCohort%n*currentCohort%gpp + nextc%n*nextc%gpp)/newn + currentCohort%canopy_trim = (currentCohort%n*currentCohort%canopy_trim + nextc%n*nextc%canopy_trim)/newn + currentCohort%dmort = (currentCohort%n*currentCohort%dmort + nextc%n*nextc%dmort)/newn + currentCohort%fire_mort = (currentCohort%n*currentCohort%fire_mort + nextc%n*nextc%fire_mort)/newn + currentCohort%leaf_litter = (currentCohort%n*currentCohort%leaf_litter + nextc%n*nextc%leaf_litter)/newn + + do i=1, nlevcan_ed + if (currentCohort%year_net_uptake(i) == 999._r8 .or. nextc%year_net_uptake(i) == 999._r8) then + currentCohort%year_net_uptake(i) = min(nextc%year_net_uptake(i),currentCohort%year_net_uptake(i)) + else + currentCohort%year_net_uptake(i) = (currentCohort%n*currentCohort%year_net_uptake(i) + & + nextc%n*nextc%year_net_uptake(i))/newn + endif + enddo + + currentCohort%n = newn + !remove fused cohort from the list + nextc%taller%shorter => nextnextc + if (.not. associated(nextc%shorter)) then !this is the shortest cohort. + currentPatch%shortest => nextc%taller + else + nextnextc%taller => nextc%taller + endif + if (associated(nextc)) then + deallocate(nextc) + endif + endif !canopy layer + endif !pft + endif !index no. + endif !diff + + if (associated(nextc)) then + nextc => nextc%shorter + else + nextc => nextnextc !if we have removed next + endif + enddo !end checking nextc cohort loop + + if (associated (currentCohort%shorter)) then + currentCohort => currentCohort%shorter + endif + enddo !end currentCohort cohort loop + + !---------------------------------------------------------------------! + ! Is the number of cohorts larger than the maximum? ! + !---------------------------------------------------------------------! + nocohorts = 0 + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + nocohorts = nocohorts + 1 + currentCohort => currentCohort%shorter + enddo + + if (nocohorts > maxcohorts) then + iterate = 1 + dynamic_fusion_tolerance = dynamic_fusion_tolerance * 1.1_r8 + !write(iulog,*) 'maxcohorts exceeded',dynamic_fusion_tolerance + !---------------------------------------------------------------------! + ! Making profile tolerance larger means that more fusion will happen ! + !---------------------------------------------------------------------! + else + iterate = 0 + endif + + enddo !do while nocohorts>maxcohorts + + endif ! patch. + + if (fusion_took_place == 1) then ! if fusion(s) occured sort cohorts + call sort_cohorts(currentPatch) + endif + + end subroutine fuse_cohorts + +!-------------------------------------------------------------------------------------! + + subroutine sort_cohorts(patchptr) + ! ============================================================================ + ! sort cohorts into the correct order DO NOT CHANGE THIS IT WILL BREAK + ! ============================================================================ + + type(ed_patch_type) , intent(inout), target :: patchptr + + type(ed_patch_type) , pointer :: current_patch + type(ed_cohort_type), pointer :: current_c, next_c + type(ed_cohort_type), pointer :: shortestc, tallestc + type(ed_cohort_type), pointer :: storesmallcohort + type(ed_cohort_type), pointer :: storebigcohort + integer :: snull,tnull + + current_patch => patchptr + tallestc => NULL() + shortestc => NULL() + storebigcohort => null() + storesmallcohort => null() + current_c => current_patch%tallest + + do while (associated(current_c)) + next_c => current_c%shorter + tallestc => storebigcohort + shortestc => storesmallcohort + if (associated(tallestc)) then + tnull = 0 + else + tnull = 1 + tallestc => current_c + endif + + if (associated(shortestc)) then + snull = 0 + else + snull = 1 + shortestc => current_c + endif + + call insert_cohort(current_c, tallestc, shortestc, tnull, snull, storebigcohort, storesmallcohort) + + current_patch%tallest => storebigcohort + current_patch%shortest => storesmallcohort + current_c => next_c + + enddo + + end subroutine sort_cohorts + + !-------------------------------------------------------------------------------------! + subroutine insert_cohort(pcc, ptall, pshort, tnull, snull, storebigcohort, storesmallcohort) + ! + ! !DESCRIPTION: + ! Insert cohort into linked list + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_cohort_type) , intent(inout), target :: pcc + type(ed_cohort_type) , intent(inout), target :: ptall + type(ed_cohort_type) , intent(inout), target :: pshort + integer , intent(in) :: tnull + integer , intent(in) :: snull + type(ed_cohort_type) , intent(inout),pointer,optional :: storesmallcohort ! storage of the smallest cohort for insertion routine + type(ed_cohort_type) , intent(inout),pointer,optional :: storebigcohort ! storage of the largest cohort for insertion routine + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: current + type(ed_cohort_type), pointer :: tallptr, shortptr, icohort + type(ed_cohort_type), pointer :: ptallest, pshortest + real(r8) :: tsp + integer :: tallptrnull,exitloop + !---------------------------------------------------------------------- + + currentPatch => pcc%patchptr + ptallest => ptall + pshortest => pshort + + if (tnull == 1) then + ptallest => null() + endif + if (snull == 1) then + pshortest => null() + endif + + icohort => pcc ! assign address to icohort local name + !place in the correct place in the linked list of heights + !begin by finding cohort that is just taller than the new cohort + tsp = icohort%dbh + + current => pshortest + exitloop = 0 + !starting with shortest tree on the grid, find tree just + !taller than tree being considered and return its pointer + if (associated(current)) then + do while (associated(current).and.exitloop == 0) + if (current%dbh < tsp) then + current => current%taller + else + exitloop = 1 + endif + enddo + endif + + if (associated(current)) then + tallptr => current + tallptrnull = 0 + else + tallptr => null() + tallptrnull = 1 + endif + + !new cohort is tallest + if (.not.associated(tallptr)) then + !new shorter cohort to the new cohort is the old tallest cohort + shortptr => ptallest + + !new cohort is tallest cohort and next taller remains null + ptallest => icohort + if (present(storebigcohort)) then + storebigcohort => icohort + end if + currentPatch%tallest => icohort + icohort%patchptr%tallest => icohort + !new cohort is not tallest + else + !next shorter cohort to new cohort is the next shorter cohort + !to the cohort just taller than the new cohort + shortptr => tallptr%shorter + + !new cohort becomes the next shorter cohort to the cohort + !just taller than the new cohort + tallptr%shorter => icohort + endif + + !new cohort is shortest + if (.not.associated(shortptr)) then + !next shorter reamins null + !cohort is placed at the bottom of the list + pshortest => icohort + if (present(storesmallcohort)) then + storesmallcohort => icohort + end if + currentPatch%shortest => icohort + icohort%patchptr%shortest => icohort + else + !new cohort is not shortest and becomes next taller cohort + !to the cohort just below it as defined in the previous block + shortptr%taller => icohort + endif + + ! assign taller and shorter links for the new cohort + icohort%taller => tallptr + if (tallptrnull == 1) then + icohort%taller=> null() + endif + icohort%shorter => shortptr + + end subroutine insert_cohort + + !-------------------------------------------------------------------------------------! + subroutine copy_cohort( currentCohort,copyc ) + ! + ! !DESCRIPTION: + ! Copies all the variables in one cohort into another empty cohort + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_cohort_type), intent(inout) , target :: copyc ! New cohort argument. + type(ed_cohort_type), intent(in) , target :: currentCohort ! Old cohort argument. + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: n,o ! New and old cohort pointers + !---------------------------------------------------------------------- + + o => currentCohort + n => copyc + + udata%cohort_number = udata%cohort_number + 1 + n%indexnumber = udata%cohort_number + + ! VEGETATION STRUCTURE + n%pft = o%pft + n%n = o%n + n%dbh = o%dbh + n%hite = o%hite + n%b = o%b + n%balive = o%balive + n%bdead = o%bdead + n%bstore = o%bstore + n%laimemory = o%laimemory + n%bsw = o%bsw + n%bl = o%bl + n%br = o%br + n%lai = o%lai + n%sai = o%sai + n%gscan = o%gscan + n%leaf_cost = o%leaf_cost + n%canopy_layer = o%canopy_layer + n%nv = o%nv + n%status_coh = o%status_coh + n%canopy_trim = o%canopy_trim + n%status_coh = o%status_coh + n%excl_weight = o%excl_weight + n%prom_weight = o%prom_weight + + ! CARBON FLUXES + n%gpp = o%gpp + n%gpp_acc = o%gpp_acc + n%gpp_clm = o%gpp_clm + n%npp = o%npp + n%npp_clm = o%npp_clm + n%npp_acc = o%npp_acc + n%resp_clm = o%resp_clm + n%resp_acc = o%resp_acc + n%resp = o%resp + n%year_net_uptake = o%year_net_uptake + n%ts_net_uptake = o%ts_net_uptake + + !RESPIRATION + n%rd = o%rd + n%resp_m = o%resp_m + n%resp_g = o%resp_g + n%livestem_mr = o%livestem_mr + n%livecroot_mr = o%livecroot_mr + n%froot_mr = o%froot_mr + + ! NITROGEN POOLS + n%livestemn = o%livestemn + n%livecrootn = o%livecrootn + n%frootn = o%frootn + + ! ALLOCATION + n%md = o%md + n%leaf_md = o%leaf_md + n%root_md = o%root_md + n%carbon_balance = o%carbon_balance + n%dmort = o%dmort + n%seed_prod = o%seed_prod + n%treelai = o%treelai + n%treesai = o%treesai + n%leaf_litter = o%leaf_litter + n%c_area = o%c_area + n%woody_turnover = o%woody_turnover + + ! VARIABLES NEEDED FOR INTEGRATION + n%dndt = o%dndt + n%dhdt = o%dhdt + n%ddbhdt = o%ddbhdt + n%dbalivedt = o%dbalivedt + n%dbdeaddt = o%dbdeaddt + n%dbstoredt = o%dbstoredt + n%storage_flux = o%storage_flux + + ! FIRE + n%cfa = o%cfa + n%fire_mort = o%fire_mort + n%crownfire_mort = o%crownfire_mort + n%cambial_mort = o%cambial_mort + + !Pointers + n%taller => NULL() ! pointer to next tallest cohort + n%shorter => NULL() ! pointer to next shorter cohort + n%patchptr => o%patchptr ! pointer to patch that cohort is in + n%siteptr => o%siteptr ! pointer to site that cohort is in + + end subroutine copy_cohort + + !-------------------------------------------------------------------------------------! + function count_cohorts( currentPatch ) result ( backcount ) + ! + ! !DESCRIPTION: + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type), intent(inout), target :: currentPatch !new site + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer ::currentCohort !new patch + integer backcount + !---------------------------------------------------------------------- + + currentCohort => currentPatch%shortest + + currentPatch%countcohorts = 0 + do while (associated(currentCohort)) + currentPatch%countcohorts = currentPatch%countcohorts + 1 + currentCohort => currentCohort%taller + enddo + + backcount = 0 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + backcount = backcount + 1 + currentCohort => currentCohort%shorter + enddo + + if (backcount /= currentPatch%countcohorts) then + write(iulog,*) 'problem with linked list, not symmetrical' + endif + + end function count_cohorts + + !-------------------------------------------------------------------------------------! + function countCohorts( bounds, ed_allsites_inst ) result ( totNumCohorts ) + ! + ! !DESCRIPTION: + ! counts the total number of cohorts over all p levels (ed_patch_type) so we + ! can allocate vectors, copy from LL -> vector and read/write restarts. + ! + ! !USES: + use decompMod, only : bounds_type + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type) , pointer :: currentCohort + integer :: g, totNumCohorts + logical :: error + !---------------------------------------------------------------------- + + totNumCohorts = 0 + + do g = bounds%begg,bounds%endg + + if (ed_allsites_inst(g)%istheresoil) then + + currentPatch => ed_allsites_inst(g)%oldest_patch + do while(associated(currentPatch)) + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + totNumCohorts = totNumCohorts + 1 + currentCohort => currentCohort%taller + enddo !currentCohort + currentPatch => currentPatch%younger + end do + + end if + end do + + end function countCohorts + +end module EDCohortDynamicsMod diff --git a/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 new file mode 100755 index 0000000000..a497df202a --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDGrowthFunctionsMod.F90 @@ -0,0 +1,367 @@ +module EDGrowthFunctionsMod + + ! ============================================================================ + ! Functions that control the trajectory of plant growth. + ! Ideally these would all use parameters that are fed in from the parameter file. + ! At present, there is only a single allocation trajectory. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use EDEcophysContype , only : EDecophyscon + use EDTypesMod , only : ed_cohort_type, nlevcan_ed, dinc_ed + + implicit none + private + + public :: bleaf + public :: hite + public :: ddbhdbd + public :: ddbhdbl + public :: dhdbd + public :: dbh + public :: bdead + public :: tree_lai + public :: tree_sai + public :: c_area + public :: mortality_rates + + logical :: DEBUG_growth = .false. + + ! ============================================================================ + ! 10/30/09: Created by Rosie Fisher + ! ============================================================================ + +contains + + real(r8) function Dbh( cohort_in ) + + ! ============================================================================ + ! Creates diameter in cm as a function of height in m + ! Height(m) diameter(cm) relationships. O'Brien et al - for 56 patch at BCI + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + !FIX(SPM,040214) - move to param file + real(r8) :: m !parameter of allometric equation (needs to not be hardwired... + real(r8) :: c !parameter of allometric equation (needs to not be hardwired... + + m = 0.64_r8 + c = 0.37_r8 + + dbh = (10.0_r8**((log10(cohort_in%hite) - c)/m)) + + return + + end function dbh + +! ============================================================================ + + real(r8) function Hite( cohort_in ) + + ! ============================================================================ + ! Creates height in m as a function of diameter in cm. + ! Height(m) diameter(cm) relationships. O'Brien et al - for 56 pft at BCI + ! ============================================================================ + + type(ed_cohort_type), intent(inout) :: cohort_in + + real(r8) :: m + real(r8) :: c + real(r8) :: h + + m = 0.64_r8 + c = 0.37_r8 + + if(cohort_in%dbh <= 0._r8)then + write(iulog,*) 'ED: dbh less than zero problem!',cohort_in%indexnumber + cohort_in%dbh = 0.1_r8 + endif + + ! if the hite is larger than the maximum allowable height (set by dbhmax) then + ! set the height to the maximum value. + ! this could do with at least re-factoring and probably re-thinking. RF + if(cohort_in%dbh <= EDecophyscon%max_dbh(cohort_in%pft)) then + h = (10.0_r8**(log10(cohort_in%dbh) * m + c)) + else + h = (10.0_r8**(log10(EDecophyscon%max_dbh(cohort_in%pft))*m + c)) + endif + Hite = h + + return + + end function Hite + +! ============================================================================ + + real(r8) function Bleaf( cohort_in ) + + ! ============================================================================ + ! Creates leaf biomass (kGC) as a function of tree diameter. + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + if(cohort_in%dbh < 0._r8.or.cohort_in%pft == 0.or.cohort_in%dbh > 1000.0_r8)then + write(iulog,*) 'problems in bleaf',cohort_in%dbh,cohort_in%pft + endif + + if(cohort_in%dbh <= EDecophyscon%max_dbh(cohort_in%pft))then + bleaf = 0.0419_r8 * (cohort_in%dbh**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 + else + bleaf = 0.0419_r8 * (EDecophyscon%max_dbh(cohort_in%pft)**1.56) * EDecophyscon%wood_density(cohort_in%pft)**0.55_r8 + endif + + !Adjust for canopies that have become so deep that their bottom layer is not producing any carbon... + !nb this will change the allometry and the effects of this remain untested. RF. April 2014 + bleaf = bleaf*cohort_in%canopy_trim + + return + end function Bleaf + +! ============================================================================ + + real(r8) function tree_lai( cohort_in ) + + ! ============================================================================ + ! LAI of individual trees is a function of the total leaf area and the total canopy area. + ! ============================================================================ + + type(ed_cohort_type), intent(inout) :: cohort_in + + real(r8) :: leafc_per_unitarea ! KgC of leaf per m2 area of ground. + real(r8) :: slat ! the sla of the top leaf layer. m2/kgC + + if( cohort_in%bl < 0._r8 .or. cohort_in%pft == 0 ) then + write(iulog,*) 'problem in treelai',cohort_in%bl,cohort_in%pft + endif + + if( cohort_in%status_coh == 2 ) then ! are the leaves on? + slat = 1000.0_r8 * pftcon%slatop(cohort_in%pft) ! m2/g to m2/kg + cohort_in%c_area = c_area(cohort_in) ! call the tree area + leafc_per_unitarea = cohort_in%bl/(cohort_in%c_area/cohort_in%n) !KgC/m2 + if(leafc_per_unitarea > 0.0_r8)then + tree_lai = leafc_per_unitarea * slat !kg/m2 * m2/kg = unitless LAI + else + tree_lai = 0.0_r8 + endif + else + tree_lai = 0.0_r8 + endif !status + cohort_in%treelai = tree_lai + + ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it + ! at the moments nlevcan_ed default is 40, which is very large, so exceeding this would clearly illustrate a + ! huge error + if(cohort_in%treelai > nlevcan_ed*dinc_ed)then + write(iulog,*) 'too much lai' , cohort_in%treelai , cohort_in%pft , nlevcan_ed * dinc_ed + endif + + return + + end function tree_lai + + ! ============================================================================ + + real(r8) function tree_sai( cohort_in ) + + ! ============================================================================ + ! SAI of individual trees is a function of the total dead biomass per unit canopy area. + ! ============================================================================ + + type(ed_cohort_type), intent(inout) :: cohort_in + + real(r8) :: bdead_per_unitarea ! KgC of leaf per m2 area of ground. + real(r8) :: sai_scaler ! This is hardwired, but should be made a parameter - + ! I need to add a new parameter to the 'standard' parameter file but don't have permission... RF 2 july. + + sai_scaler = 0.05_r8 ! here, a high biomass of 20KgC per m2 gives us a high SAI of 1.0. + + if( cohort_in%bdead < 0._r8 .or. cohort_in%pft == 0 ) then + write(iulog,*) 'problem in treesai',cohort_in%bdead,cohort_in%pft + endif + + cohort_in%c_area = c_area(cohort_in) ! call the tree area + bdead_per_unitarea = cohort_in%bdead/(cohort_in%c_area/cohort_in%n) !KgC/m2 + tree_sai = bdead_per_unitarea * sai_scaler !kg/m2 * m2/kg = unitless LAI + + cohort_in%treesai = tree_sai + + ! here, if the LAI exceeeds the maximum size of the possible array, then we have no way of accomodating it + ! at the moments nlevcan_ed default is 40, which is very large, so exceeding this would clearly illustrate a + ! huge error + if(cohort_in%treesai > nlevcan_ed*dinc_ed)then + write(iulog,*) 'too much sai' , cohort_in%treesai , cohort_in%pft , nlevcan_ed * dinc_ed + endif + + return + + end function tree_sai + + +! ============================================================================ + + real(r8) function c_area( cohort_in ) + + ! ============================================================================ + ! Calculate area of ground covered by entire cohort. (m2) + ! Function of DBH (cm) canopy spread (m/cm) and number of individuals. + ! ============================================================================ + + use EDParamsMod , only : ED_val_grass_spread + + type(ed_cohort_type), intent(in) :: cohort_in + + real(r8) :: dbh ! Tree diameter at breat height. cm. + + if (DEBUG_growth) then + write(iulog,*) 'z_area 1',cohort_in%dbh,cohort_in%pft + write(iulog,*) 'z_area 2',EDecophyscon%max_dbh + write(iulog,*) 'z_area 3',pftcon%woody + write(iulog,*) 'z_area 4',cohort_in%n + write(iulog,*) 'z_area 5',cohort_in%patchptr%spread + write(iulog,*) 'z_area 6',cohort_in%canopy_layer + write(iulog,*) 'z_area 7',ED_val_grass_spread + end if + + dbh = min(cohort_in%dbh,EDecophyscon%max_dbh(cohort_in%pft)) + if(pftcon%woody(cohort_in%pft) == 1)then + c_area = 3.142_r8 * cohort_in%n * & + (cohort_in%patchptr%spread(cohort_in%canopy_layer)*dbh)**1.56_r8 + else + c_area = 3.142_r8 * cohort_in%n * (ED_val_grass_spread*dbh)**1.56_r8 + end if + + end function c_area + +! ============================================================================ + + real(r8) function Bdead( cohort_in ) + + ! ============================================================================ + ! Calculate stem biomass from height(m) dbh(cm) and wood density(g/cm3) + ! using allometry of J.G. Saldarriaga et al 1988 - Rio Negro + ! Journal of Ecology vol 76 p938-958 + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + bdead = 0.06896_r8*(cohort_in%hite**0.572_r8)*(cohort_in%dbh**1.94_r8)* & + (EDecophyscon%wood_density(cohort_in%pft)**0.931_r8) + + end function Bdead + +! ============================================================================ + + real(r8) function dHdBd( cohort_in ) + + ! ============================================================================ + ! convert changes in structural biomass to changes in height + ! consistent with Bstem and h-dbh allometries + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + real(r8) :: dbddh ! rate of change of dead biomass (KgC) per unit change of height (m) + + dbddh = 0.06896_r8*0.572_r8*(cohort_in%hite**(-0.428_r8))*(cohort_in%dbh**1.94_r8)* & + (EDecophyscon%wood_density(cohort_in%pft)**0.931_r8) + dHdBd = 1.0_r8/dbddh !m/KgC + + return + + end function dHdBd + +! ============================================================================ + real(r8) function dDbhdBd( cohort_in ) + + ! ============================================================================ + ! convert changes in structural biomass to changes in diameter + ! consistent with Bstem and h-dbh allometries + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + real(r8) :: dBD_dDBH !Rate of change of dead biomass (KgC) with change in DBH (cm) + real(r8) :: dH_dDBH !Rate of change of height (m) with change in DBH (cm) + + dBD_dDBH = 1.94_r8*0.06896_r8*(cohort_in%hite**0.572_r8)*(cohort_in%dbh**0.94_r8)* & + (EDecophyscon%wood_density(cohort_in%pft)**0.931_r8) + if(cohort_in%dbh < EDecophyscon%max_dbh(cohort_in%pft))then + dH_dDBH = 1.4976_r8*(cohort_in%dbh**(-0.36_r8)) + dBD_dDBH = dBD_dDBH + 0.572_r8*0.06896_r8*(cohort_in%hite**(0.572_r8 - 1.0_r8))* & + (cohort_in%dbh**1.94_r8)*(EDecophyscon%wood_density(cohort_in%pft)**0.931_r8)*dH_dDBH + endif + + dDbhdBd = 1.0/dBD_dDBH + + return + + end function dDbhdBd + +! ============================================================================ + + real(r8) function dDbhdBl( cohort_in ) + + ! ============================================================================ + ! convert changes in leaf biomass (KgC) to changes in DBH (cm) + ! ============================================================================ + + type(ed_cohort_type), intent(in) :: cohort_in + + real(r8) :: dblddbh ! Rate of change of leaf biomass with change in DBH + + dblddbh = 1.56_r8*0.0419_r8*(cohort_in%dbh**0.56_r8)*(EDecophyscon%wood_density(cohort_in%pft)**0.55_r8) + dblddbh = dblddbh*cohort_in%canopy_trim + + dDbhdBl = 1.0_r8/dblddbh + + return + + end function dDbhdBl + +! ============================================================================ + + real(r8) function mortality_rates( cohort_in ) + + ! ============================================================================ + ! Calculate mortality rates as a function of carbon storage + ! ============================================================================ + + use EDParamsMod, only : ED_val_stress_mort + + type (ed_cohort_type), intent(in) :: cohort_in + + real(r8) :: frac ! relativised stored carbohydrate + real(r8) :: smort ! stress mortality : Fraction per year + real(r8) :: bmort ! background mortality : Fraction per year + + ! 'Background' mortality (can vary as a function of density as in ED1.0 and ED2.0, but doesn't here for tractability) + bmort = 0.014_r8 + + ! Proxy for hydraulic failure induced mortality. + smort = 0.0_r8 + if(cohort_in%patchptr%btran_ft(cohort_in%pft) <= 0.000001_r8)then + smort = smort + ED_val_stress_mort + endif + + ! Carbon Starvation induced mortality. + if ( cohort_in%dbh > 0._r8 ) then + if(Bleaf(cohort_in) > 0._r8.and.cohort_in%bstore <= Bleaf(cohort_in))then + frac = cohort_in%bstore/(Bleaf(cohort_in)) + smort = smort + max(0.0_r8,ED_val_stress_mort*(1.0_r8 - frac)) + endif + else + write(iulog,*) 'dbh problem in mortality_rates', & + cohort_in%dbh,cohort_in%pft,cohort_in%n,cohort_in%canopy_layer,cohort_in%indexnumber + endif + + mortality_rates = smort + bmort + + end function mortality_rates + +! ============================================================================ + +end module EDGrowthFunctionsMod diff --git a/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 new file mode 100755 index 0000000000..826e7a60ac --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDPatchDynamicsMod.F90 @@ -0,0 +1,1324 @@ +module EDPatchDynamicsMod + + ! ============================================================================ + ! Controls formation, creation, fusing and termination of patch level processes. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8; + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use EDCohortDynamicsMod , only : fuse_cohorts, sort_cohorts, insert_cohort + use EDtypesMod , only : ncwd, n_dbh_bins, ntol, numpft_ed, area, dbhmax + use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, udata + ! + implicit none + private + ! + public :: create_patch + public :: spawn_patches + public :: zero_patch + public :: fuse_patches + public :: terminate_patches + public :: patch_pft_size_profile + public :: disturbance_rates + public :: check_patch_area + public :: set_patchno + + private:: fuse_2_patches + + ! 10/30/09: Created by Rosie Fisher + ! ============================================================================ + +contains + + ! ============================================================================ + subroutine disturbance_rates( site_in) + ! + ! !DESCRIPTION: + ! Calculates the fire and mortality related disturbance rates for each patch, + ! and then determines which is the larger at the patch scale (for now, there an only + ! be one disturbance type for each timestep. + ! all disturbance rates here are per daily timestep. + ! + ! !USES: + use EDGrowthFunctionsMod , only : c_area, mortality_rates + use EDTypesMod , only : udata + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: site_in + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + !--------------------------------------------------------------------- + + !MORTALITY + site_in%disturbance_mortality = 0.0_r8 + + currentPatch => site_in%oldest_patch + + do while (associated(currentPatch)) + + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + ! Mortality for trees in the understorey. + currentCohort%patchptr => currentPatch + + currentCohort%dmort = mortality_rates(currentCohort) + currentCohort%c_area = c_area(currentCohort) + + if(currentCohort%canopy_layer == 1)then + + currentPatch%disturbance_rates(1) = currentPatch%disturbance_rates(1) + & + min(1.0_r8,currentCohort%dmort)*udata%deltat*currentCohort%c_area/currentPatch%area + + endif + + currentCohort => currentCohort%taller + + enddo !currentCohort + + ! if fires occur at site + ! Fudge - fires can't burn the whole patch, as this causes /0 errors. + ! This is accumulating the daily fires over the whole 30 day patch generation phase. + currentPatch%disturbance_rates(2) = min(0.99_r8,currentPatch%disturbance_rates(2) + currentPatch%frac_burnt) + + if (currentPatch%disturbance_rates(2) > 0.98_r8)then + write(iulog,*) 'very high fire areas',currentPatch%disturbance_rates(2),currentPatch%frac_burnt + endif + + !Only use larger of two natural disturbance modes WHY? + if(currentPatch%disturbance_rates(2) > currentPatch%disturbance_rates(1))then ! DISTURBANCE IS FIRE + currentPatch%disturbance_rate = currentPatch%disturbance_rates(2) + else + currentPatch%disturbance_rate = currentPatch%disturbance_rates(1) ! DISTURBANCE IS MORTALITY + endif + + site_in%disturbance_mortality = site_in%disturbance_mortality + & + currentPatch%disturbance_rates(1)*currentPatch%area/area + currentPatch => currentPatch%younger + + enddo !patch loop + + ! FIRE + site_in%disturbance_fire = site_in%frac_burnt/AREA + + ! Use largest disturbance mode and ignore the other... This is necessary to + ! have a single type of disturbance and to calculate the survival rates etc... + if (site_in%disturbance_fire > site_in%disturbance_mortality) then + site_in%disturbance_rate = site_in%disturbance_fire + site_in%dist_type = 2 + else + site_in%disturbance_rate = site_in%disturbance_mortality + site_in%dist_type = 1 + endif + + end subroutine disturbance_rates + + ! ============================================================================ + subroutine spawn_patches( currentSite ) + ! + ! !DESCRIPTION: + ! In this subroutine, the following happens + ! 1) the total area disturbed is calculated + ! 2) a new patch is created + ! 3) properties are averaged + ! 4) litter fluxes from fire and mortality are added + ! 5) For mortality, plants in existing patch canopy are killed. + ! 6) For mortality, Plants in new and existing understorey are killed + ! 7) For fire, burned plants are killed, and unburned plants are added to new patch. + ! 8) New cohorts are added to new patch and sorted. + ! 9) New patch is added into linked list + ! 10) Area checked, and patchno recalculated. + ! + ! !USES: + use clm_varpar , only : nclmax + use EDParamsMod , only : ED_val_maxspread, ED_val_understorey_death + use EDCohortDynamicsMod , only : zero_cohort, copy_cohort, terminate_cohorts + ! + ! !ARGUMENTS: + type (ed_site_type), intent(inout), target :: currentSite + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: new_patch + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + type (ed_cohort_type), pointer :: nc + type (ed_cohort_type), pointer :: storesmallcohort + type (ed_cohort_type), pointer :: storebigcohort + real(r8) :: site_areadis ! total area disturbed in m2 per site per day + real(r8) :: patch_site_areadis ! total area disturbed in m2 per patch per day + real(r8) :: age ! notional age of this patch in years + integer :: tnull ! is there a tallest cohort? + integer :: snull ! is there a shortest cohort? + real(r8) :: root_litter_local(numpft_ed) ! initial value of root litter. KgC/m2 + real(r8) :: leaf_litter_local(numpft_ed) ! initial value of leaf litter. KgC/m2 + real(r8) :: cwd_ag_local(ncwd) ! initial value of above ground coarse woody debris. KgC/m2 + real(r8) :: cwd_bg_local(ncwd) ! initial value of below ground coarse woody debris. KgC/m2 + real(r8) :: seed_bank_local(numpft_ed) ! initial value of seed bank. KgC/m2 + real(r8) :: spread_local(nclmax) ! initial value of canopy spread parameter.no units + !--------------------------------------------------------------------- + + storesmallcohort => null() ! storage of the smallest cohort for insertion routine + storebigcohort => null() ! storage of the largest cohort for insertion routine + + ! calculate area of disturbed land, in this timestep, by summing contributions from each existing patch. + currentPatch => currentSite%youngest_patch + currentSite%cwd_ag_burned = 0.0_r8 + currentSite%leaf_litter_burned = 0.0_r8 + + site_areadis = 0.0_r8 + do while(associated(currentPatch)) + + !FIX(RF,032414) Does using the max(fire,mort) actually make sense here? + site_areadis = site_areadis + currentPatch%area * min(1.0_r8,currentPatch%disturbance_rate) + currentPatch => currentPatch%older + + enddo ! end loop over patches. sum area disturbed for all patches. + + if (site_areadis > 0.0_r8) then + cwd_ag_local = 0.0_r8 + cwd_bg_local = 0.0_r8 + leaf_litter_local = 0.0_r8 + root_litter_local = 0.0_r8 + spread_local(1:nclmax) = ED_val_maxspread + age = 0.0_r8 + seed_bank_local = 0.0_r8 + + allocate(new_patch) + + call zero_patch(new_patch) + + call create_patch(currentSite, new_patch, age, site_areadis, & + spread_local, cwd_ag_local, cwd_bg_local, leaf_litter_local, & + root_litter_local, seed_bank_local) + + new_patch%tallest => null() + new_patch%shortest => null() + + currentPatch => currentSite%oldest_patch + ! loop round all the patches that contribute surviving indivduals and litter pools to the new patch. + do while(associated(currentPatch)) + patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate ! how much land is disturbed in this donor patch? + + call average_patch_properties(currentPatch, new_patch, patch_site_areadis) + if (currentSite%disturbance_mortality > currentSite%disturbance_fire) then !mortality is dominant disturbance + call mortality_litter_fluxes(currentPatch, new_patch, patch_site_areadis) + else + call fire_litter_fluxes(currentPatch, new_patch, patch_site_areadis) + endif + + !INSERT SURVIVORS FROM DISTURBANCE INTO NEW PATCH + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + allocate(nc) + call zero_cohort(nc) + + ! nc is the new cohort that goes in the disturbed patch (new_patch)... currentCohort + ! is the curent cohort that stays in the donor patch (currentPatch) + call copy_cohort(currentCohort, nc) + + !this is the case as the new patch probably doesn't have a closed canopy, and + ! even if it does, that will be sorted out in canopy_structure. + nc%canopy_layer = 1 + + !mortality is dominant disturbance + if(currentPatch%disturbance_rates(1) > currentPatch%disturbance_rates(2))then + if(currentCohort%canopy_layer == 1)then + ! keep the trees that didn't die + currentCohort%n = currentCohort%n * (1.0_r8 - min(1.0_r8,currentCohort%dmort * udata%deltat)) + nc%n = 0.0_r8 ! kill all of the trees who caused the disturbance. + else + if(pftcon%woody(currentCohort%pft) == 1)then + + ! remaining of understory plants of those that are knocked over by the overstorey trees dying... + nc%n = (1.0_r8 - ED_val_understorey_death) * currentCohort%n * patch_site_areadis/currentPatch%area + ! understory trees that might potentially be knocked over in the disturbance. + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + ! grass is not killed by mortality disturbance events. Just move it into the new patch area. + + else + + ! remaining of understory plants of those that are knocked over by the overstorey trees dying... + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area + ! understory trees that might potentially be knocked over in the disturbance. + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + endif + endif + else !fire + + ! loss of individual from fire in new patch. + nc%n = currentCohort%n * patch_site_areadis/currentPatch%area * (1.0_r8 - currentCohort%fire_mort) + ! loss of individuals from source patch + currentCohort%n = currentCohort%n * (1._r8 - patch_site_areadis/currentPatch%area) + + endif + + if (nc%n > 0.0_r8) then + storebigcohort => new_patch%tallest + storesmallcohort => new_patch%shortest + if(associated(new_patch%tallest))then + tnull = 0 + else + tnull = 1 + new_patch%tallest => nc + nc%taller => null() + endif + + if(associated(new_patch%shortest))then + snull = 0 + else + snull = 1 + new_patch%shortest => nc + nc%shorter => null() + endif + nc%patchptr => new_patch + call insert_cohort(nc, new_patch%tallest, new_patch%shortest, tnull, snull, storebigcohort, storesmallcohort) + + new_patch%tallest => storebigcohort + new_patch%shortest => storesmallcohort + else + deallocate(nc) !get rid of the new memory. + endif + + currentCohort => currentCohort%taller + enddo ! currentCohort + call sort_cohorts(currentPatch) + + !zero disturbance accumulators + currentPatch%disturbance_rate = 0._r8 + currentPatch%disturbance_rates = 0._r8 + + !update area of donor patch + currentPatch%area = currentPatch%area - patch_site_areadis + + !sort out the cohorts, since some of them may be so small as to need removing. + call fuse_cohorts(currentPatch) + call terminate_cohorts(currentPatch) + call sort_cohorts(currentPatch) + + currentPatch => currentPatch%younger + + enddo ! currentPatch patch loop. + + !*************************/ + !** INSERT NEW PATCH INTO LINKED LIST + !**********`***************/ + currentPatch => currentSite%youngest_patch + new_patch%older => currentPatch + new_patch%younger => NULL() + currentPatch%younger => new_patch + currentSite%youngest_patch => new_patch + + call fuse_cohorts(new_patch) + call terminate_cohorts(new_patch) + call sort_cohorts(new_patch) + + endif !end new_patch area + + call check_patch_area(currentSite) + call set_patchno(currentSite) + + end subroutine spawn_patches + + ! ============================================================================ + subroutine check_patch_area( currentSite ) + ! + ! !DESCRIPTION: + ! Check to see that total area is not exceeded. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type), intent(in), target :: currentSite + ! + ! !LOCAL VARIABLES: + real(r8) :: areatot + type(ed_patch_type), pointer :: currentPatch + !--------------------------------------------------------------------- + + areatot = 0._r8 + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + areatot = areatot + currentPatch%area + currentPatch => currentPatch%younger + if (( areatot - area ) > 0._r8 ) then + write(iulog,*) 'trimming patch area - is too big' , areatot-area + currentSite%oldest_patch%area = currentSite%oldest_patch%area - (areatot - area) + endif + enddo + + end subroutine check_patch_area + + ! ============================================================================ + subroutine set_patchno( currentSite ) + ! + ! !DESCRIPTION: + ! Give patches an order number from the oldest to youngest. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type),intent(in), target :: currentSite + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + integer patchno + !--------------------------------------------------------------------- + + patchno = 1 + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + currentPatch%patchno = patchno + patchno = patchno + 1 + currentPatch => currentPatch%younger + enddo + + end subroutine set_patchno + + ! ============================================================================ + subroutine average_patch_properties( currentPatch, newPatch, patch_site_areadis ) + ! + ! !DESCRIPTION: + ! Average together the state properties of all of the donor patches that + ! make up the new patch. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_patch_type) , intent(in), target :: currentPatch + type(ed_patch_type) , intent(inout) :: newPatch + real(r8) , intent(out) :: patch_site_areadis ! amount of land disturbed in this patch. m2 + ! + ! !LOCAL VARIABLES: + integer :: c,p ! counters for PFT and litter size class. + !--------------------------------------------------------------------- + + patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate ! how much land is disturbed in this donor patch? + + do p=1,numpft_ed + newPatch%seed_bank(p) = newPatch%seed_bank(p) + currentPatch%seed_bank(p) * patch_site_areadis/newPatch%area + enddo + + do c = 1,ncwd !move litter pool en mass into the new patch. + newPatch%cwd_ag(c) = newPatch%cwd_ag(c) + currentPatch%cwd_ag(c) * patch_site_areadis/newPatch%area + newPatch%cwd_bg(c) = newPatch%cwd_bg(c) + currentPatch%cwd_bg(c) * patch_site_areadis/newPatch%area + enddo + + do p = 1,numpft_ed !move litter pool en mass into the new patch + newPatch%root_litter(p) = newPatch%root_litter(p) + currentPatch%root_litter(p) * patch_site_areadis/newPatch%area + newPatch%leaf_litter(p) = newPatch%leaf_litter(p) + currentPatch%leaf_litter(p) * patch_site_areadis/newPatch%area + enddo + + newPatch%spread = newPatch%spread + currentPatch%spread * patch_site_areadis/newPatch%area + + end subroutine average_patch_properties + + ! ============================================================================ + subroutine fire_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) + ! + ! !DESCRIPTION: + ! CWD pool burned by a fire. + ! Carbon going from burned trees into CWD pool + ! Burn parts of trees that don't die in fire + ! Burn live grasses and kill them. + ! + ! !USES: + use EDParamsMod, only : ED_val_ag_biomass + use SFParamsMod, only : SF_VAL_CWD_FRAC + use EDGrowthFunctionsMod, only : c_area + use EDtypesMod , only : dg_sf + ! + ! !ARGUMENTS: + type(ed_patch_type) , intent(inout), target :: cp_target + type(ed_patch_type) , intent(inout), target :: new_patch_target + real(r8) , intent(inout) :: patch_site_areadis + ! + ! !LOCAL VARIABLES: + type(ed_site_type) , pointer :: currentSite + type(ed_patch_type) , pointer :: currentPatch + type(ed_patch_type) , pointer :: new_patch + type(ed_cohort_type), pointer :: currentCohort + real(r8) :: bcroot ! amount of below ground coarse root per cohort kgC. (goes into CWD_BG) + real(r8) :: bstem ! amount of above ground stem biomass per cohort kgC.(goes into CWG_AG) + real(r8) :: dead_tree_density ! no trees killed by fire per m2 + reaL(r8) :: burned_litter ! amount of each litter pool burned by fire. kgC/m2/day + real(r8) :: burned_leaves ! amount of tissue consumed by fire for grass. KgC/individual/day + integer :: c, p + !--------------------------------------------------------------------- + + !check that total area is not exceeded. + currentPatch => cp_target + new_patch => new_patch_target + + if ( currentPatch%fire == 1 ) then !only do this if there was a fire in this actual patch. + patch_site_areadis = currentPatch%area * currentPatch%disturbance_rate ! how much land is disturbed in this donor patch? + currentSite => currentPatch%siteptr + + !************************************/ + !PART 1) Burn the fractions of existing litter in the new patch that were consumed by the fire. + !************************************/ + do c = 1,ncwd + burned_litter = new_patch%cwd_ag(c) * patch_site_areadis/new_patch%area * currentPatch%burnt_frac_litter(c+1) !kG/m2/day + new_patch%cwd_ag(c) = new_patch%cwd_ag(c) - burned_litter + currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/day + enddo + + do p = 1,numpft_ed + burned_litter = new_patch%leaf_litter(p) * patch_site_areadis/new_patch%area * currentPatch%burnt_frac_litter(dg_sf) + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) - burned_litter + currentSite%flux_out = currentSite%flux_out + burned_litter * new_patch%area !kG/site/dat + enddo + + !************************************/ + !PART 2) Put unburned parts of plants that died in the fire into the litter pool of new and old patches + ! This happens BEFORE the plant numbers have been updated. So we are working with the + ! pre-fire population of plants, which is the right way round. + !************************************/ + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + p = currentCohort%pft + if(pftcon%woody(p) == 1)then !DEAD (FROM FIRE) TREES + !************************************/ + ! Number of trees that died because of the fire, per m2 of ground. + ! Divide their litter into the four litter streams, and spread evenly across ground surface. + !************************************/ + ! stem biomass per tree + bstem = (currentCohort%bsw + currentCohort%bdead) * ED_val_ag_biomass + ! coarse root biomass per tree + bcroot = (currentCohort%bsw + currentCohort%bdead) * (1.0_r8 - ED_val_ag_biomass) + ! density of dead trees per m2. + dead_tree_density = (currentCohort%fire_mort * currentCohort%n*patch_site_areadis/currentPatch%area) / AREA + + ! Unburned parts of dead tree pool. + ! Unburned leaves and roots + + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + dead_tree_density * (currentCohort%bl) & + * (1.0_r8-currentCohort%cfa) + new_patch%root_litter(p) = new_patch%root_litter(p) + dead_tree_density * (currentCohort%br+currentCohort%bstore) + currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + dead_tree_density * & + (currentCohort%bl) * (1.0_r8-currentCohort%cfa) + currentPatch%root_litter(p) = currentPatch%root_litter(p) + dead_tree_density * & + (currentCohort%br+currentCohort%bstore) + + ! below ground coarse woody debris from burned trees + do c = 1,ncwd + new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot + currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + dead_tree_density * SF_val_CWD_frac(c) * bcroot + enddo + + ! above ground coarse woody debris from unburned twigs and small branches + do c = 1,2 + new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem & + * (1.0_r8-currentCohort%cfa) + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * & + bstem * (1.0_r8-currentCohort%cfa) + enddo + + ! above ground coarse woody debris from large branches and stems: these do not burn in crown fires. + do c = 3,4 + new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + dead_tree_density * SF_val_CWD_frac(c) * bstem + enddo + + ! Burned parts of dead tree pool. + ! Burned twigs and small branches. + do c = 1,2 + + currentSite%cwd_ag_burned(c) = currentSite%cwd_ag_burned(c) + dead_tree_density * & + SF_val_CWD_frac(c) * bstem * currentCohort%cfa + currentSite%flux_out = currentSite%flux_out + dead_tree_density * & + AREA * SF_val_CWD_frac(c) * bstem * currentCohort%cfa + + enddo + + !burned leaves. + do p = 1,numpft_ed + + currentSite%leaf_litter_burned(p) = currentSite%leaf_litter_burned(p) + & + dead_tree_density * currentCohort%bl * currentCohort%cfa + currentSite%flux_out = currentSite%flux_out + & + dead_tree_density * AREA * currentCohort%bl * currentCohort%cfa + + enddo + + endif + + currentCohort => currentCohort%taller + + enddo ! currentCohort + + !************************************/ + ! PART 3) Burn parts of trees that did *not* die in the fire. + ! PART 4) Burn parts of grass that are consumed by the fire. + ! grasses are not killed directly by fire. They die by losing all of their leaves and starving. + !************************************/ + currentCohort => new_patch%shortest + do while(associated(currentCohort)) + + currentCohort%c_area = c_area(currentCohort) + if(pftcon%woody(currentCohort%pft) == 1)then + burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentCohort%cfa + else + burned_leaves = (currentCohort%bl+currentCohort%bsw) * currentPatch%burnt_frac_litter(6) + endif + if (burned_leaves > 0.0_r8) then + + currentCohort%balive = max(currentCohort%br,currentCohort%balive - burned_leaves) + currentCohort%bl = max(0.00001_r8, currentCohort%bl - burned_leaves) + !KgC/gridcell/day + currentSite%flux_out = currentSite%flux_out + burned_leaves * currentCohort%n * & + patch_site_areadis/currentPatch%area * AREA + + endif + currentCohort%cfa = 0.0_r8 + + currentCohort => currentCohort%taller + + enddo + + endif !currentPatch%fire. + + end subroutine fire_litter_fluxes + + ! ============================================================================ + subroutine mortality_litter_fluxes(cp_target, new_patch_target, patch_site_areadis) + ! + ! !DESCRIPTION: + ! Carbon going from ongoing mortality into CWD pools. + ! + ! !USES: + use EDParamsMod, only : ED_val_ag_biomass, ED_val_understorey_death + use SFParamsMod, only : SF_val_cwd_frac + ! + ! !ARGUMENTS: + type(ed_patch_type) , intent(inout), target :: cp_target + type(ed_patch_type) , intent(inout), target :: new_patch_target + real(r8) , intent(in) :: patch_site_areadis + ! + ! !LOCAL VARIABLES: + real(r8) :: cwd_litter_density + real(r8) :: litter_area ! area over which to distribute this litter. + type(ed_cohort_type), pointer :: currentCohort + type(ed_patch_type) , pointer :: currentPatch + type(ed_patch_type) , pointer :: new_patch + real(r8) :: understorey_dead !Number of individual dead from the canopy layer /day + real(r8) :: canopy_dead !Number of individual dead from the understorey layer /day + real(r8) :: np_mult !Fraction of the new patch which came from the current patch (and so needs the same litter) + integer :: p,c + !--------------------------------------------------------------------- + + currentPatch => cp_target + new_patch => new_patch_target + currentPatch%canopy_mortality_woody_litter = 0.0_r8 ! mortality generated litter. KgC/m2/day + currentPatch%canopy_mortality_leaf_litter(:) = 0.0_r8 + currentPatch%canopy_mortality_root_litter(:) = 0.0_r8 + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + p = currentCohort%pft + if(currentPatch%disturbance_rates(1) > currentPatch%disturbance_rates(2))then !mortality is dominant disturbance + if(currentCohort%canopy_layer == 1)then + !currentCohort%dmort = mortality_rates(currentCohort) + !the disturbance calculations are done with the previous n, c_area and d_mort. So it's probably & + !not right to recalcualte dmort here. + canopy_dead = currentCohort%n * min(1.0_r8,currentCohort%dmort * udata%deltat) + + currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & + canopy_dead*(currentCohort%bdead+currentCohort%bsw) + currentPatch%canopy_mortality_leaf_litter(p) = currentPatch%canopy_mortality_leaf_litter(p)+ & + canopy_dead*(currentCohort%bl) + currentPatch%canopy_mortality_root_litter(p) = currentPatch%canopy_mortality_root_litter(p)+ & + canopy_dead*(currentCohort%br+currentCohort%bstore) + + else + if(pftcon%woody(currentCohort%pft) == 1)then + + understorey_dead = ED_val_understorey_death * currentCohort%n * (patch_site_areadis/currentPatch%area) !kgC/site/day + currentPatch%canopy_mortality_woody_litter = currentPatch%canopy_mortality_woody_litter + & + understorey_dead*(currentCohort%bdead+currentCohort%bsw) + currentPatch%canopy_mortality_leaf_litter(p)= currentPatch%canopy_mortality_leaf_litter(p)+ & + understorey_dead* currentCohort%bl + currentPatch%canopy_mortality_root_litter(p)= currentPatch%canopy_mortality_root_litter(p)+ & + understorey_dead*(currentCohort%br+currentCohort%bstore) + + ! FIX(SPM,040114) - clarify this comment + ! grass is not killed by canopy mortality disturbance events. + ! Just move it into the new patch area. + else + ! no-op + endif + endif + endif + + currentCohort => currentCohort%taller + + enddo !currentCohort + + !************************************/ + !Evenly distribute the litter from the trees that died across the new and old patches + !************************************/ + !************************************/ + !Evenly distribute the litter from the trees that died across the new and old patches + !'litter' fluxes here are in KgC + !************************************/ + litter_area = currentPatch%area + np_mult = patch_site_areadis/new_patch%area + ! This litter is distributed between the current and new patches, & + ! not to any other patches. This is really the eventually area of the current patch & + ! (currentPatch%area-patch_site_areadis) +patch_site_areadis... + ! For the new patch, only some fraction of its land area (patch_areadis/np%area) is derived from the current patch + ! so we need to multiply by patch_areadis/np%area + do c = 1,ncwd + + cwd_litter_density = SF_val_CWD_frac(c) * currentPatch%canopy_mortality_woody_litter / litter_area + + new_patch%cwd_ag(c) = new_patch%cwd_ag(c) + ED_val_ag_biomass * cwd_litter_density * np_mult + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + ED_val_ag_biomass * cwd_litter_density + new_patch%cwd_bg(c) = new_patch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density * np_mult + currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + (1._r8-ED_val_ag_biomass) * cwd_litter_density + + enddo + + do p = 1,numpft_ed + + new_patch%leaf_litter(p) = new_patch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area * np_mult + new_patch%root_litter(p) = new_patch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area * np_mult + currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + currentPatch%canopy_mortality_leaf_litter(p) / litter_area + currentPatch%root_litter(p) = currentPatch%root_litter(p) + currentPatch%canopy_mortality_root_litter(p) / litter_area + + enddo + + end subroutine mortality_litter_fluxes + + ! ============================================================================ + subroutine create_patch(currentSite, new_patch, age, areap, spread_local,cwd_ag_local,cwd_bg_local, & + leaf_litter_local,root_litter_local,seed_bank_local) + ! + ! !DESCRIPTION: + ! Set default values for creating a new patch + ! + ! !USES: + use clm_varpar , only : nlevgrnd + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: currentSite + type(ed_patch_type), intent(inout), target :: new_patch + real(r8), intent(in) :: age ! notional age of this patch in years + real(r8), intent(in) :: areap ! initial area of this patch in m2. + real(r8), intent(in) :: cwd_ag_local(:) ! initial value of above ground coarse woody debris. KgC/m2 + real(r8), intent(in) :: cwd_bg_local(:) ! initial value of below ground coarse woody debris. KgC/m2 + real(r8), intent(in) :: root_litter_local(:)! initial value of root litter. KgC/m2 + real(r8), intent(in) :: leaf_litter_local(:)! initial value of leaf litter. KgC/m2 + real(r8), intent(in) :: spread_local(:) ! initial value of canopy spread parameter.no units + real(r8), intent(in) :: seed_bank_local(:) ! initial value of seed bank. KgC/m2 + ! + ! !LOCAL VARIABLES: + !--------------------------------------------------------------------- + + call zero_patch(new_patch) !The nan value in here is not working?? + + new_patch%tallest => null() ! pointer to patch's tallest cohort + new_patch%shortest => null() ! pointer to patch's shortest cohort + new_patch%older => null() ! pointer to next older patch + new_patch%younger => null() ! pointer to next shorter patch + new_patch%siteptr => null() ! pointer to the site that the patch is in + + ! assign known patch attributes + + new_patch%siteptr => currentSite + new_patch%age = age + new_patch%area = areap + new_patch%spread = spread_local + new_patch%cwd_ag = cwd_ag_local + new_patch%cwd_bg = cwd_bg_local + new_patch%leaf_litter = leaf_litter_local + new_patch%root_litter = root_litter_local + new_patch%seed_bank = seed_bank_local + + !zeroing things because of the surfacealbedo problem... shouldnt really be necesary + new_patch%cwd_ag_in(:) = 0._r8 + new_patch%cwd_bg_in(:) = 0._r8 + + new_patch%f_sun = 0._r8 + new_patch%ed_laisun_z(:,:,:) = 0._r8 + new_patch%ed_laisha_z(:,:,:) = 0._r8 + new_patch%ed_parsun_z(:,:,:) = 0._r8 + new_patch%ed_parsha_z(:,:,:) = 0._r8 + new_patch%fabi = 0._r8 + new_patch%fabd = 0._r8 + new_patch%tr_soil_dir(:) = 1._r8 + new_patch%tr_soil_dif(:) = 1._r8 + new_patch%tr_soil_dir_dif(:) = 0._r8 + new_patch%fabd_sun_z(:,:,:) = 0._r8 + new_patch%fabd_sha_z(:,:,:) = 0._r8 + new_patch%fabi_sun_z(:,:,:) = 0._r8 + new_patch%fabi_sha_z(:,:,:) = 0._r8 + new_patch%frac_burnt = 0._r8 + new_patch%total_tree_area = 0.0_r8 + new_patch%NCL_p = 1 + + allocate(new_patch%rootfr_ft(numpft_ed,nlevgrnd)) + allocate(new_patch%rootr_ft(numpft_ed,nlevgrnd)) + + end subroutine create_patch + + ! ============================================================================ + subroutine zero_patch(cp_p) + ! + ! !DESCRIPTION: + ! Sets all the variables in the patch to nan or zero + ! (this needs to be two seperate routines, one for nan & one for zero + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + type(ed_patch_type), intent(inout), target :: cp_p + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + !--------------------------------------------------------------------- + + currentPatch => cp_p + + currentPatch%tallest => null() + currentPatch%shortest => null() + currentPatch%older => null() + currentPatch%younger => null() + currentPatch%siteptr => null() + + currentPatch%patchno = 999 + currentPatch%clm_pno = 999 + + currentPatch%age = nan + currentPatch%area = nan + currentPatch%canopy_layer_lai(:) = nan + currentPatch%total_canopy_area = nan + currentPatch%canopy_area = nan + currentPatch%bare_frac_area = nan + + currentPatch%tlai_profile(:,:,:) = nan + currentPatch%elai_profile(:,:,:) = nan + currentPatch%tsai_profile(:,:,:) = nan + currentPatch%esai_profile(:,:,:) = nan + currentPatch%canopy_area_profile(:,:,:) = nan + + currentPatch%fabd_sun_z(:,:,:) = nan + currentPatch%fabd_sha_z(:,:,:) = nan + currentPatch%fabi_sun_z(:,:,:) = nan + currentPatch%fabi_sha_z(:,:,:) = nan + + currentPatch%ed_laisun_z(:,:,:) = nan + currentPatch%ed_laisha_z(:,:,:) = nan + currentPatch%ed_parsun_z(:,:,:) = nan + currentPatch%ed_parsha_z(:,:,:) = nan + currentPatch%psn_z(:,:,:) = nan + + currentPatch%f_sun(:,:,:) = nan + currentPatch%tr_soil_dir(:) = nan ! fraction of incoming direct radiation that is transmitted to the soil as direct + currentPatch%tr_soil_dif(:) = nan ! fraction of incoming diffuse radiation that is transmitted to the soil as diffuse + currentPatch%tr_soil_dir_dif(:) = nan ! fraction of incoming direct radiation that is transmitted to the soil as diffuse + currentPatch%fab(:) = nan ! fraction of incoming total radiation that is absorbed by the canopy + currentPatch%fabd(:) = nan ! fraction of incoming direct radiation that is absorbed by the canopy + currentPatch%fabi(:) = nan ! fraction of incoming diffuse radiation that is absorbed by the canopy + + currentPatch%present(:,:) = 999 ! is there any of this pft in this layer? + currentPatch%nrad(:,:) = 999 ! number of exposed leaf layers for each canopy layer and pft + currentPatch%ncan(:,:) = 999 ! number of total leaf layers for each canopy layer and pft + currentPatch%lai = nan ! leaf area index of patch + currentPatch%spread(:) = nan ! dynamic ratio of dbh to canopy area. + currentPatch%pft_agb_profile(:,:) = nan + currentPatch%gpp = 0._r8 + currentPatch%npp = 0._r8 + currentPatch%seed_bank(:) = 0._r8 + currentPatch%dseed_dt(:) = 0._r8 + + ! DISTURBANCE + currentPatch%disturbance_rates = 0._r8 + currentPatch%disturbance_rate = 0._r8 + + ! LITTER + currentPatch%cwd_ag(:) = 0.0_r8 ! above ground coarse woody debris gc/m2. + currentPatch%cwd_bg(:) = 0.0_r8 ! below ground coarse woody debris + currentPatch%root_litter(:) = 0.0_r8 + currentPatch%leaf_litter(:) = 0.0_r8 + + ! FIRE + currentPatch%fuel_eff_moist = 0.0_r8 ! average fuel moisture content of the ground fuel + ! (incl. live grasses. omits 1000hr fuels) + currentPatch%livegrass = 0.0_r8 ! total ag grass biomass in patch. 1=c3 grass, 2=c4 grass. gc/m2 + currentPatch%sum_fuel = 0.0_r8 ! total ground fuel related to ros (omits 1000hr fuels). gc/m2 + currentPatch%fuel_bulkd = 0.0_r8 ! average fuel bulk density of the ground fuel + ! (incl. live grasses. omits 1000hr fuels). kgc/m3 + currentPatch%fuel_sav = 0.0_r8 ! average surface area to volume ratio of the ground fuel + ! (incl. live grasses. omits 1000hr fuels). + currentPatch%fuel_mef = 0.0_r8 ! average moisture of extinction factor of the ground fuel + ! (incl. live grasses. omits 1000hr fuels). + currentPatch%ros_front = 0.0_r8 ! average rate of forward spread of each fire in the patch. m/min. + currentPatch%effect_wspeed = 0.0_r8 ! dailywind modified by fraction of relative grass and tree cover. m/min. + currentPatch%tau_l = 0.0_r8 ! mins p&r(1986) + currentPatch%fuel_frac(:) = 0.0_r8 ! fraction of each litter class in the sum_fuel + !- for purposes of calculating weighted averages. + currentPatch%tfc_ros = 0.0_r8 ! used in fi calc + currentPatch%fi = 0._r8 ! average fire intensity of flaming front during day. + ! backward ros plays no role. kj/m/s or kw/m. + currentPatch%fire = 999 ! sr decide_fire.1=fire hot enough to proceed. 0=stop everything- no fires today + currentPatch%fd = 0.0_r8 ! fire duration (mins) + currentPatch%ros_back = 0.0_r8 ! backward ros (m/min) + currentPatch%ab = 0.0_r8 ! area burnt daily m2 + currentPatch%nf = 0.0_r8 ! number of fires initiated daily + currentPatch%sh = 0.0_r8 ! average scorch height for the patch(m) + currentPatch%frac_burnt = 0.0_r8 ! fraction burnt in each timestep. + currentPatch%burnt_frac_litter(:) = 0.0_r8 + currentPatch%btran_ft(:) = 0.0_r8 + + currentPatch%canopy_layer_lai(:) = 0.0_r8 + currentPatch%seeds_in(:) = 0.0_r8 + currentPatch%seed_decay(:) = 0.0_r8 + currentPatch%seed_germination(:) = 0.0_r8 + currentPatch%fab(:) = 0.0_r8 + currentPatch%sabs_dir(:) = 0.0_r8 + currentPatch%sabs_dif(:) = 0.0_r8 + + + end subroutine zero_patch + + ! ============================================================================ + subroutine fuse_patches( csite ) + ! + ! !DESCRIPTION: + ! Decide to fuse patches if their cohort structures are similar + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type), intent(inout), target :: csite + ! + ! !LOCAL VARIABLES: + type(ed_site_type) , pointer :: currentSite + type(ed_patch_type), pointer :: currentPatch,tpp,tmpptr + integer :: ft,z !counters for pft and height class + real(r8) :: norm !normalized difference between biomass profiles + real(r8) :: profiletol !tolerance of patch fusion routine. Starts off high and is reduced if there are too many patches. + integer :: maxpatch !maximum number of allowed patches. FIX-RF. These should be namelist variables. + integer :: nopatches !number of patches presently in gridcell + integer :: iterate !switch of patch reduction iteration scheme. 1 to keep going, 0 to stop + integer :: fuse_flag !do patches get fused (1) or not (0). + !--------------------------------------------------------------------- + + maxpatch = 4 + + currentSite => csite + + profiletol = 0.6_r8 !start off with a very small profile tol, or a predefined parameter? + + nopatches = 0 + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + nopatches = nopatches +1 + currentPatch => currentPatch%older + enddo + !---------------------------------------------------------------------! + ! We only really care about fusing patches if nopatches > 1 ! + !---------------------------------------------------------------------! + iterate = 1 + + !---------------------------------------------------------------------! + ! Keep doing this until nopatches >= maxpatch ! + !---------------------------------------------------------------------! + + do while(iterate == 1) + !---------------------------------------------------------------------! + ! Calculate the biomass profile of each patch ! + !---------------------------------------------------------------------! + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + call patch_pft_size_profile(currentPatch) + currentPatch => currentPatch%older + enddo + + !---------------------------------------------------------------------! + ! Loop round current & target (currentPatch,tpp) patches to assess combinations ! + !---------------------------------------------------------------------! + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + tpp => currentSite%youngest_patch + do while(associated(tpp)) + + if(.not.associated(currentPatch))then + write(iulog,*) 'ED: issue with currentPatch' + endif + + if(associated(tpp).and.associated(currentPatch))then + fuse_flag = 1 !the default is to fuse the patches + if(currentPatch%patchno /= tpp%patchno) then !these should be the same patch + + !---------------------------------------------------------------------! + ! Calculate the difference criteria for each pft and dbh class ! + !---------------------------------------------------------------------! + do ft = 1,numpft_ed ! loop over pfts + do z = 1,n_dbh_bins ! loop over hgt bins + !is there biomass in this category? + if(currentPatch%pft_agb_profile(ft,z) > 0.0_r8.or.tpp%pft_agb_profile(ft,z) > 0.0_r8)then + norm = abs(currentPatch%pft_agb_profile(ft,z) - tpp%pft_agb_profile(ft,z))/(0.5_r8*& + &(currentPatch%pft_agb_profile(ft,z) + tpp%pft_agb_profile(ft,z))) + !---------------------------------------------------------------------! + ! Look for differences in profile biomass, above the minimum biomass ! + !---------------------------------------------------------------------! + + if(norm > profiletol)then + !looking for differences between profile density. + if(currentPatch%pft_agb_profile(ft,z) > NTOL.or.tpp%pft_agb_profile(ft,z) > NTOL)then + fuse_flag = 0 !do not fuse - keep apart. + endif + endif ! profile tol + endif ! NTOL + enddo !ht bins + enddo ! PFT + + !---------------------------------------------------------------------! + ! Call the patch fusion routine if there is a meaningful difference ! + ! any of the pft x height categories ! + !---------------------------------------------------------------------! + + if(fuse_flag == 1)then + tmpptr => currentPatch%older + call fuse_2_patches(currentPatch, tpp) + call fuse_cohorts(tpp) + call sort_cohorts(tpp) + currentPatch => tmpptr + else + ! write(iulog,*) 'patches not fused' + endif + endif !are both patches associated? + endif !are these different patches? + tpp => tpp%older + enddo !tpp loop + + if(associated(currentPatch))then + currentPatch => currentPatch%older + else + currentPatch => null() + endif !associated currentPatch + + enddo ! currentPatch loop + + !---------------------------------------------------------------------! + ! Is the number of patches larger than the maximum? ! + !---------------------------------------------------------------------! + nopatches = 0 + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + nopatches = nopatches +1 + currentPatch => currentPatch%older + enddo + + if(nopatches > maxpatch)then + iterate = 1 + profiletol = profiletol * 1.1_r8 + write(iulog,*) 'maxpatch exceeded, triggering patch fusion iteration.',profiletol,nopatches + !---------------------------------------------------------------------! + ! Making profile tolerance larger means that more fusion will happen ! + !---------------------------------------------------------------------! + else + iterate = 0 + endif + + enddo !do while nopatches>maxpatch + + end subroutine fuse_patches + + ! ============================================================================ + subroutine fuse_2_patches(dp, rp) + ! + ! !DESCRIPTION: + ! This function fuses the two patches specified in the argument. + ! It fuses the first patch in the argument (the "donor") into the second + ! patch in the argument (the "recipient"), and frees the memory + ! associated with the secnd patch + ! + ! !USES: + ! + ! !ARGUMENTS: + type (ed_patch_type) , intent(inout), pointer :: dp ! Donor Patch + type (ed_patch_type) , intent(inout), pointer :: rp ! Recipient Patch + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type), pointer :: currentCohort ! Current Cohort + type (ed_cohort_type), pointer :: nextc ! Remembers next cohort in list + type (ed_cohort_type), pointer :: storesmallcohort + type (ed_cohort_type), pointer :: storebigcohort + integer :: c,p !counters for pft and litter size class. + integer :: tnull,snull ! are the tallest and shortest cohorts associated? + !--------------------------------------------------------------------- + + !area weighted average of ages & litter & seed bank + rp%age = (dp%age * dp%area + rp%age * rp%area)/(dp%area + rp%area) + + do p = 1,numpft_ed + rp%seed_bank(p) = (rp%seed_bank(p)*rp%area + dp%seed_bank(p)*dp%area)/(rp%area + dp%area) + rp%seeds_in(p) = (rp%seeds_in(p)*rp%area + dp%seeds_in(p)*dp%area)/(rp%area + dp%area) + rp%seed_decay(p) = (rp%seed_decay(p)*rp%area + dp%seed_decay(p)*dp%area)/(rp%area + dp%area) + rp%seed_germination(p) = (rp%seed_germination(p)*rp%area + dp%seed_germination(p)*dp%area)/(rp%area + dp%area) + enddo + + do c = 1,ncwd + rp%cwd_ag(c) = (dp%cwd_ag(c)*dp%area + rp%cwd_ag(c)*rp%area)/(dp%area + rp%area) + rp%cwd_bg(c) = (dp%cwd_bg(c)*dp%area + rp%cwd_bg(c)*rp%area)/(dp%area + rp%area) + enddo + + do p = 1,numpft_ed + rp%leaf_litter(p) = (dp%leaf_litter(p)*dp%area + rp%leaf_litter(p)*rp%area)/(dp%area + rp%area) + rp%root_litter(p) = (dp%root_litter(p)*dp%area + rp%root_litter(p)*rp%area)/(dp%area + rp%area) + enddo + + rp%fuel_eff_moist = (dp%fuel_eff_moist*dp%area + rp%fuel_eff_moist*rp%area)/(dp%area + rp%area) + rp%livegrass = (dp%livegrass*dp%area + rp%livegrass*rp%area)/(dp%area + rp%area) + rp%sum_fuel = (dp%sum_fuel*dp%area + rp%sum_fuel*rp%area)/(dp%area + rp%area) + rp%fuel_bulkd = (dp%fuel_bulkd*dp%area + rp%fuel_bulkd*rp%area)/(dp%area + rp%area) + rp%fuel_sav = (dp%fuel_sav*dp%area + rp%fuel_sav*rp%area)/(dp%area + rp%area) + rp%fuel_mef = (dp%fuel_mef*dp%area + rp%fuel_mef*rp%area)/(dp%area + rp%area) + rp%ros_front = (dp%ros_front*dp%area + rp%ros_front*rp%area)/(dp%area + rp%area) + rp%effect_wspeed = (dp%effect_wspeed*dp%area + rp%effect_wspeed*rp%area)/(dp%area + rp%area) + rp%tau_l = (dp%tau_l*dp%area + rp%tau_l*rp%area)/(dp%area + rp%area) + rp%fuel_frac(:) = (dp%fuel_frac(:)*dp%area + rp%fuel_frac(:)*rp%area)/(dp%area + rp%area) + rp%tfc_ros = (dp%tfc_ros*dp%area + rp%tfc_ros*rp%area)/(dp%area + rp%area) + rp%fi = (dp%fi*dp%area + rp%fi*rp%area)/(dp%area + rp%area) + rp%fd = (dp%fd*dp%area + rp%fd*rp%area)/(dp%area + rp%area) + rp%ros_back = (dp%ros_back*dp%area + rp%ros_back*rp%area)/(dp%area + rp%area) + rp%ab = (dp%ab*dp%area + rp%ab*rp%area)/(dp%area + rp%area) + rp%nf = (dp%nf*dp%area + rp%nf*rp%area)/(dp%area + rp%area) + rp%sh = (dp%sh*dp%area + rp%sh*rp%area)/(dp%area + rp%area) + rp%frac_burnt = (dp%frac_burnt*dp%area + rp%frac_burnt*rp%area)/(dp%area + rp%area) + rp%burnt_frac_litter(:) = (dp%burnt_frac_litter(:)*dp%area + rp%burnt_frac_litter(:)*rp%area)/(dp%area + rp%area) + rp%btran_ft(:) = (dp%btran_ft(:)*dp%area + rp%btran_ft(:)*rp%area)/(dp%area + rp%area) + + rp%area = rp%area + dp%area !THIS MUST COME AT THE END! + + !insert donor cohorts into recipient patch + if(associated(dp%shortest))then + + currentCohort => dp%shortest + if(associated(currentCohort)) then + nextc => currentCohort%taller + endif + + do while(associated(dp%shortest)) + + storebigcohort => rp%tallest + storesmallcohort => rp%shortest + + if(associated(rp%tallest))then + tnull = 0 + else + tnull = 1 + rp%tallest => currentCohort + endif + + if(associated(rp%shortest))then + snull = 0 + else + snull = 1 + rp%shortest => currentCohort + endif + + call insert_cohort(currentCohort, rp%tallest, rp%shortest, tnull, snull, storebigcohort, storesmallcohort) + + rp%tallest => storebigcohort + rp%shortest => storesmallcohort + + currentCohort%patchptr => rp + currentCohort => nextc + + dp%shortest => currentCohort + + if(associated(currentCohort)) then + nextc => currentCohort%taller + endif + + enddo !cohort + endif !are there any cohorts? + + call patch_pft_size_profile(rp) ! Recalculate the patch size profile for the resulting patch + + ! FIX(SPM,032414) dangerous code here. Passing in dp as a pointer allows the code below + ! to effect the currentPatch that is the actual argument when in reality, dp should be + ! intent in only with these pointers being set on the actual argument + ! outside of this routine (in fuse_patches). basically this should be split + ! into a copy, then change pointers, then delete. + + if(associated(dp%younger)) then + dp%younger%older => dp%older + else + dp%siteptr%youngest_patch => dp%older !youngest + endif + if(associated(dp%older)) then + dp%older%younger => dp%younger + else + dp%siteptr%oldest_patch => dp%younger !oldest + endif + + deallocate(dp) + + end subroutine fuse_2_patches + + ! ============================================================================ + subroutine terminate_patches(cs_pnt) + ! + ! !DESCRIPTION: + ! Terminate Patches if they are too small + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type), target, intent(in) :: cs_pnt + ! + ! !LOCAL VARIABLES: + type(ed_site_type), pointer :: currentSite + type(ed_patch_type), pointer :: currentPatch + real(r8) areatot ! variable for checking whether the total patch area is wrong. + !--------------------------------------------------------------------- + + currentSite => cs_pnt + + currentPatch => currentSite%oldest_patch + + !fuse patches if one of them is very small.... + currentPatch => currentSite%youngest_patch + do while(associated(currentPatch)) + if(currentPatch%area <= 0.001_r8)then + if(associated(currentPatch%older).and.currentPatch%patchno /= currentSite%youngest_patch%patchno)then + ! Do not force the fusion of the youngest patch to its neighbour. + ! This is only really meant for very old patches. + write(iulog,*) 'fusing patches because one is too small',currentPatch%area, currentPatch%lai, & + currentPatch%older%area,currentPatch%older%lai,currentPatch%seed_bank(1) + call fuse_2_patches(currentPatch%older, currentPatch) + deallocate(currentPatch%older) + write(iulog,*) 'after fusion',currentPatch%area,currentPatch%seed_bank(1) + endif + endif + + currentPatch => currentPatch%older + + enddo + + !check area is not exceeded + areatot = 0._r8 + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + areatot = areatot + currentPatch%area + currentPatch => currentPatch%younger + if((areatot-area) > 0.0000001_r8)then + write(iulog,*) 'ED: areatot too large. end terminate', areatot,currentSite%clmgcell + endif + enddo + + end subroutine terminate_patches + + ! ============================================================================ + subroutine patch_pft_size_profile(cp_pnt) + ! + ! !DESCRIPTION: + ! Binned patch size profiles generated for patch fusion routine + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_patch_type), target, intent(inout) :: cp_pnt + ! + ! !LOCAL VARIABLES: + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + real(r8) :: mind(N_DBH_BINS) ! Bottom of DBH bin + real(r8) :: maxd(N_DBH_BINS) ! Top of DBH bin + real(r8) :: delta_dbh ! Size of DBH bin + integer :: p ! Counter for PFT + integer :: j ! Counter for DBH bins + !--------------------------------------------------------------------- + + currentPatch => cp_pnt + + delta_dbh = (DBHMAX/N_DBH_BINS) + + do p = 1,numpft_ed + do j = 1,N_DBH_BINS + currentPatch%pft_agb_profile(p,j) = 0.0_r8 + enddo + enddo + + do j = 1,N_DBH_BINS + if (j == 1) then + mind(j) = 0.0_r8 + maxd(j) = delta_dbh + else + mind(j) = (j-1) * delta_dbh + maxd(j) = (j)*delta_dbh + endif + enddo + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + do j = 1,N_DBH_BINS + if((currentCohort%dbh > mind(j)) .AND. (currentCohort%dbh <= maxd(j)))then + + currentPatch%pft_agb_profile(currentCohort%pft,j) = currentPatch%pft_agb_profile(currentCohort%pft,j) + & + currentCohort%bdead*currentCohort%n/currentPatch%area + + endif + enddo ! dbh bins + + ! Deal with largest dbh bin + j = N_DBH_BINS-1 + if(currentCohort%dbh > j*delta_dbh)then + + currentPatch%pft_agb_profile(currentCohort%pft,j) = currentPatch%pft_agb_profile(currentCohort%pft,j) + & + currentCohort%bdead*currentCohort%n/currentPatch%area + + endif ! + + currentCohort => currentCohort%taller + + enddo !currentCohort + + end subroutine patch_pft_size_profile + + ! ============================================================================ + function countPatches( bounds, ed_allsites_inst ) result ( totNumPatches ) + ! + ! !DESCRIPTION: + ! Loop over all Patches to count how many there are + ! + ! !USES: + use decompMod , only : bounds_type + use abortutils , only : endrun + use EDTypesMod , only : ed_site_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + integer :: g ! gridcell + integer :: totNumPatches ! total number of patches. + !--------------------------------------------------------------------- + + totNumPatches = 0 + + do g = bounds%begg,bounds%endg + if (ed_allsites_inst(g)%istheresoil) then + currentPatch => ed_allsites_inst(g)%oldest_patch + do while(associated(currentPatch)) + totNumPatches = totNumPatches + 1 + currentPatch => currentPatch%younger + enddo + endif + enddo + + end function countPatches + +end module EDPatchDynamicsMod diff --git a/components/clm/src/ED/biogeochem/EDPhenologyType.F90 b/components/clm/src/ED/biogeochem/EDPhenologyType.F90 new file mode 100644 index 0000000000..f948fc7024 --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDPhenologyType.F90 @@ -0,0 +1,277 @@ +module EDPhenologyType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! This module holds routines dealing with phenology in ED. The primary use + ! is to hold extract and accumulate routines + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_cal_mod , only : calParams + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep, get_step_size + ! + ! !USES: + implicit none + private + ! + type, public :: ed_phenology_type + ! + ! change these to allocatable + ! add a rbuf variable that is a part of this type + ! + real(r8), pointer :: ED_GDD_patch (:) ! ED Phenology growing degree days. + ! This (phen_cd_status_patch?) could and should be site-level. RF + integer , pointer :: phen_cd_status_patch (:) ! ED Phenology cold deciduous status + character(10) :: accString = 'ED_GDD0' + real(r8) :: checkRefVal = 26._r8 + + contains + + ! Public procedures + procedure, public :: accumulateAndExtract + procedure, public :: init + procedure, public :: initAccVars + procedure, public :: initAccBuffer + procedure, public :: clean + + ! Private procedures + procedure, private :: initAllocate + procedure, private :: initHistory + + end type ed_phenology_type + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine accumulateAndExtract( this, bounds, & + t_ref2m_patch, & + gridcell, latdeg, & + day, month, secs ) + ! + ! start formal argument list -- + ! group formal (dummy) arguments by use/similarity + ! + class(ed_phenology_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds ! beginning and ending pft index + ! data arguments + real(r8) , intent(in) :: t_ref2m_patch(bounds%begp: ) ! patch 2 m height surface air temperature (K) + ! arguments for the grid + integer , intent(in) :: gridcell(bounds%begp: ) ! gridcell + real(r8) , intent(in) :: latdeg(bounds%begg: ) ! latitude (degrees) + ! time related arguments + integer , intent(in) :: day ! day + integer , intent(in) :: month ! month + integer , intent(in) :: secs ! secs + ! + ! -- end formal argument list + ! + + ! + ! local variables + ! + ! update_accum_field expects a pointer, can't make this an allocatable + real(r8), pointer :: rbufslp(:) ! temporary single level - pft level + integer :: g, p ! local index for gridcell and pft + integer :: ier ! error code + integer :: m ! local month variable + + allocate(rbufslp(bounds%begp:bounds%endp), stat=ier) + if (ier/=0) then + call endrun(msg="extract_accum_hist allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate and extract GDD0 for ED + do p = bounds%begp,bounds%endp + + g = gridcell(p) + + if (latdeg(g) >= 0._r8) then + m = calParams%january + else + m = calParams%june + endif + + ! FIX(RF,032414) - is this accumulation a bug in the normal phenology code, + ! as it means to count from november but ctually counts from january? + if ( month==m .and. day==calParams%firstDayOfMonth .and. secs==get_step_size() ) then + rbufslp(p) = accumResetVal ! reset ED_GDD + else + rbufslp(p) = max(0._r8, min(this%checkRefVal, t_ref2m_patch(p)-SHR_CONST_TKFRZ)) & + * get_step_size()/SHR_CONST_CDAY + end if + + if( this%phen_cd_status_patch(p) == 2 ) then ! we have over-counted past the maximum possible range + rbufslp(p) = accumResetVal !don't understand how this doens't make it negative, but it doesn't. RF + endif + + if( latdeg(g) >= 0._r8 .and. month >= calParams%july ) then !do not accumulate in latter half of year. + rbufslp(p) = accumResetVal + endif + + if( latdeg(g) < 0._r8 .and. month < calParams%june ) then !do not accumulate in earlier half of year. + rbufslp(p) = accumResetVal + endif + + end do + + call update_accum_field ( trim(this%accString), rbufslp, get_nstep() ) + call extract_accum_field ( trim(this%accstring), this%ED_GDD_patch, get_nstep() ) + + deallocate(rbufslp) + + end subroutine accumulateAndExtract + + !--------------------------------------------------------------------- + subroutine clean( this ) + ! + ! !DESCRIPTION: + ! clean up memory + ! + ! !USES: + ! + ! !ARGUMENTS: + class(ed_phenology_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + !--------------------------------------------------------------------- + + deallocate(this%ED_GDD_patch) + deallocate(this%phen_cd_status_patch) + + end subroutine clean + + subroutine init(this, bounds) + + class(ed_phenology_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + + call this%initAllocate ( bounds ) + call this%initHistory () + + end subroutine init + + !------------------------------------------------------------------------ + subroutine initAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(ed_phenology_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + !------------------------------------------------------------------------ + + allocate(this%ED_GDD_patch (bounds%begp:bounds%endp)) ; this%ED_GDD_patch (:) = 0.0_r8 + allocate(this%phen_cd_status_patch (bounds%begp:bounds%endp)) ; this%phen_cd_status_patch (:) = 0 + + end subroutine initAllocate + + !------------------------------------------------------------------------ + subroutine initHistory(this) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(Ed_phenology_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + !--------------------------------------------------------------------- + + call hist_addfld1d (fname=trim(this%accString), units='deg C', & + avgflag='A', long_name='ED phenology growing degree days', & + ptr_patch=this%ED_GDD_patch, set_lake=0._r8, set_urb=0._r8) + + end subroutine initHistory + + !----------------------------------------------------------------------- + subroutine initAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! Each interval and accumulation type is unique to each field processed. + ! Routine [initAccBuffer] defines the fields to be processed + ! and the type of accumulation. + ! Routine [updateAccVars] does the actual accumulation for a given field. + ! Fields are accumulated by calls to subroutine [update_accum_field]. + ! To accumulate a field, it must first be defined in subroutine [initAccVars] + ! and then accumulated by calls to [updateAccVars]. + ! Four types of accumulations are possible: + ! o average over time interval + ! o running mean over time interval + ! o running accumulation over time interval + ! Time average fields are only valid at the end of the averaging interval. + ! Running means are valid once the length of the simulation exceeds the + ! averaging interval. Accumulated fields are continuously accumulated. + ! The trigger value "-99999." resets the accumulation to zero. + ! + ! !USES + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(ed_phenology_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + + ! + ! !LOCAL VARIABLES: + !--------------------------------------------------------------------- + + call init_accum_field (name=this%accString, units='K', & + desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=huge(1), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end subroutine initAccBuffer + + !----------------------------------------------------------------------- + subroutine initAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES + ! + ! !ARGUMENTS: + class(ed_phenology_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + + allocate(rbufslp(bounds%begp:bounds%endp), stat=ier) + if (ier/=0) then + call endrun(msg="extract_accum_hist allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + call extract_accum_field (this%accString, rbufslp, get_nstep()) + this%ED_GDD_patch(bounds%begp:bounds%endp) = rbufslp(bounds%begp:bounds%endp) + + deallocate(rbufslp) + + end subroutine initAccVars + +end module EDPhenologyType diff --git a/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 new file mode 100755 index 0000000000..ab543045de --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDPhysiologyMod.F90 @@ -0,0 +1,1153 @@ +module EDPhysiologyMod + +#include "shr_assert.h" + + ! ============================================================================ + ! Miscellaneous physiology routines from ED. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use WaterstateType , only : waterstate_type + use pftconMod , only : pftcon + use EDEcophysContype , only : EDecophyscon + use EDCohortDynamicsMod , only : allocate_live_biomass, zero_cohort, create_cohort, fuse_cohorts, sort_cohorts + use EDPhenologyType , only : ed_phenology_type + use EDTypesMod , only : dg_sf, dinc_ed, external_recruitment + use EDTypesMod , only : ncwd, nlevcan_ed, n_sub, numpft_ed, senes + use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + + implicit none + private + + public :: canopy_derivs + public :: non_canopy_derivs + public :: trim_canopy + public :: phenology + public :: phenology_leafonoff + public :: Growth_Derivatives + public :: recruitment + public :: cwd_input + public :: cwd_out + public :: fragmentation_scaler + public :: seeds_in + public :: seed_decay + public :: seed_germination + ! ============================================================================ + +contains + + ! ============================================================================ + subroutine canopy_derivs( currentPatch ) + ! + ! !DESCRIPTION: + ! spawn new cohorts of juveniles of each PFT + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type) , intent(inout), target :: currentPatch + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer ::currentCohort + !---------------------------------------------------------------------- + + ! call plant growth functions + + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + call Growth_Derivatives(currentCohort) + currentCohort => currentCohort%taller + enddo + + end subroutine canopy_derivs + + ! ============================================================================ + subroutine non_canopy_derivs( currentPatch, temperature_inst, soilstate_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Returns time differentials of the state vector + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type) , intent(inout) :: currentPatch + type(temperature_type) , intent(in) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer c,p + !---------------------------------------------------------------------- + + currentPatch%leaf_litter_in(:) = 0.0_r8 + currentPatch%root_litter_in(:) = 0.0_r8 + currentPatch%leaf_litter_out(:) = 0.0_r8 + currentPatch%root_litter_out(:) = 0.0_r8 + currentPatch%cwd_AG_in(:) = 0.0_r8 + currentPatch%cwd_BG_in(:) = 0.0_r8 + currentPatch%cwd_AG_out(:) = 0.0_r8 + currentPatch%cwd_BG_out(:) = 0.0_r8 + currentPatch%seeds_in(:) = 0.0_r8 + currentPatch%seed_decay(:) = 0.0_r8 + currentPatch%seed_germination(:) = 0.0_r8 + + ! update seed fluxes + call seeds_in(currentPatch) + call seed_decay(currentPatch) + call seed_germination(currentPatch) + + ! update fragmenting pool fluxes + call cwd_input(currentPatch) + call cwd_out( currentPatch, temperature_inst, soilstate_inst, waterstate_inst) + + do p = 1,numpft_ed + currentPatch%dseed_dt(p) = currentPatch%seeds_in(p) - currentPatch%seed_decay(p) - currentPatch%seed_germination(p) + enddo + + do c = 1,ncwd + currentPatch%dcwd_AG_dt(c) = currentPatch%cwd_AG_in(c) - currentPatch%cwd_AG_out(c) + currentPatch%dcwd_BG_dt(c) = currentPatch%cwd_BG_in(c) - currentPatch%cwd_BG_out(c) + enddo + + do p = 1,numpft_ed + currentPatch%dleaf_litter_dt(p) = currentPatch%leaf_litter_in(p) - currentPatch%leaf_litter_out(p) + currentPatch%droot_litter_dt(p) = currentPatch%root_litter_in(p) - currentPatch%root_litter_out(p) + enddo + + currentPatch%leaf_litter_in(:) = 0.0_r8 + currentPatch%root_litter_in(:) = 0.0_r8 + currentPatch%leaf_litter_out(:) = 0.0_r8 + currentPatch%root_litter_out(:) = 0.0_r8 + currentPatch%CWD_AG_in(:) = 0.0_r8 + currentPatch%cwd_bg_in(:) = 0.0_r8 + currentPatch%CWD_AG_out(:) = 0.0_r8 + currentPatch%cwd_bg_out(:) = 0.0_r8 + + end subroutine non_canopy_derivs + + ! ============================================================================ + subroutine trim_canopy( currentSite ) + ! + ! !DESCRIPTION: + ! Canopy trimming / leaf optimisation. Removes leaves in negative annual carbon balance. + ! + ! !USES: + ! + use EDParamsMod, only : ED_val_grperc + use EDGrowthFunctionsMod, only : tree_lai + ! + ! !ARGUMENTS + type (ed_site_type),intent(inout), target :: currentSite + ! + ! !LOCAL VARIABLES: + type (ed_cohort_type) , pointer :: currentCohort + type (ed_patch_type) , pointer :: currentPatch + + real(r8) :: inc ! rate at which canopy acclimates to uptake + real(r8) :: trim_limit ! this is the limit of the canopy trimming routine, so that trees + ! can't just lose all their leaves and have no reproductive costs. + integer :: z ! leaf layer + integer :: trimmed ! was this layer trimmed in this year? If not expand the canopy. + + trim_limit = 0.3_r8 ! Arbitrary limit to reductions in leaf area with stress. Without this nothing ever dies. + inc = 0.03_r8 ! Arbitrary incremental change in trimming function. Controls + ! rate at which leaves are optimised to their environment. + !---------------------------------------------------------------------- + + currentPatch => currentSite%youngest_patch + + do while(associated(currentPatch)) + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + trimmed = 0 + currentCohort%treelai = tree_lai(currentCohort) + currentCohort%nv = ceiling((currentCohort%treelai+currentCohort%treesai)/dinc_ed) + if (currentCohort%nv > nlevcan_ed)then + write(iulog,*) 'nv > nlevcan_ed',currentCohort%nv,currentCohort%treelai,currentCohort%treesai, & + currentCohort%c_area,currentCohort%n,currentCohort%bl + endif + + !Leaf cost vs netuptake for each leaf layer. + do z = 1,nlevcan_ed + if (currentCohort%year_net_uptake(z) /= 999._r8)then !there was activity this year in this leaf layer. + !Leaf Cost kgC/m2/year-1 + !decidous costs. + if (pftcon%season_decid(currentCohort%pft) == 1.or.pftcon%stress_decid(currentCohort%pft) == 1)then + currentCohort%leaf_cost = 1._r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) + currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & + pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc+1._r8) + else !evergreen costs + currentCohort%leaf_cost = 1.0_r8/(pftcon%slatop(currentCohort%pft)* & + pftcon%leaf_long(currentCohort%pft)*1000.0_r8) !convert from sla in m2g-1 to m2kg-1 + currentCohort%leaf_cost = currentCohort%leaf_cost + 1.0_r8/(pftcon%slatop(currentCohort%pft)*1000.0_r8) * & + pftcon%froot_leaf(currentCohort%pft) / EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_cost = currentCohort%leaf_cost * (ED_val_grperc+1._r8) + endif + if (currentCohort%year_net_uptake(z) < currentCohort%leaf_cost)then + if (currentCohort%canopy_trim > trim_limit)then + ! write(iulog,*) 'trimming leaves',currentCohort%canopy_trim,currentCohort%leaf_cost + ! keep trimming until none of the canopy is in negative carbon balance. + if (currentCohort%hite > EDecophyscon%hgt_min(currentCohort%pft))then + currentCohort%canopy_trim = currentCohort%canopy_trim - inc + if (pftcon%evergreen(currentCohort%pft) /= 1)then + currentCohort%laimemory = currentCohort%laimemory*(1.0_r8 - inc) + endif + trimmed = 1 + endif + endif + endif + endif !leaf activity? + enddo !z + if (currentCohort%NV.gt.2)then + write(iulog,*) 'nv>4',currentCohort%year_net_uptake(1:6),currentCohort%leaf_cost,& + currentCohort%canopy_trim + endif + + currentCohort%year_net_uptake(:) = 999.0_r8 + if (trimmed == 0.and.currentCohort%canopy_trim < 1.0_r8)then + currentCohort%canopy_trim = currentCohort%canopy_trim + inc + endif + ! write(iulog,*) 'trimming',currentCohort%canopy_trim + + ! currentCohort%canopy_trim = 1.0_r8 !FIX(RF,032414) this turns off ctrim for now. + currentCohort => currentCohort%shorter + enddo + currentPatch => currentPatch%older + enddo + + end subroutine trim_canopy + + ! ============================================================================ + subroutine phenology( currentSite, ed_phenology_inst, temperature_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Phenology. + ! + ! !USES: + use clm_varcon, only : tfrz + use EDTypesMod, only : udata + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), pointer:: currentSite + type(ed_phenology_type) , intent(in) :: ed_phenology_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + real(r8), pointer :: t_veg24(:) + real(r8), pointer :: ED_GDD_patch(:) + integer :: g ! grid point + integer :: t ! day of year + integer :: ncolddays ! no days underneath the threshold for leaf drop + integer :: ncolddayslim ! critical no days underneath the threshold for leaf drop + integer :: i + integer :: timesincedleafon,timesincedleafoff,timesinceleafon,timesinceleafoff + real(r8) :: gdd_threshold + real(r8) :: a,b,c ! params of leaf-pn model from botta et al. 2000. + real(r8) :: cold_t ! threshold below which cold days are counted + real(r8) :: coldday ! definition of a 'chilling day' for botta model + real(r8) :: ncdstart ! beginning of counting period for growing degree days. + real(r8) :: drought_threshold + real(r8) :: off_time ! minimum number of days between leaf off and leaf on for drought phenology + real(r8) :: temp_in_C ! daily averaged temperature in celcius + real(r8) :: mindayson + !------------------------------------------------------------------------ + + t_veg24 => temperature_inst%t_veg24_patch ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs + ED_GDD_patch => ed_phenology_inst%ED_GDD_patch ! Input: [real(r8) (:)] growing deg. days base 0 deg C (ddays) + + g = currentSite%clmgcell + + ! Parameter of drought decid leaf loss in mm in top layer...FIX(RF,032414) + ! - this is arbitrary and poorly understood. Needs work. ED_ + drought_threshold = 0.15 + off_time = 100.0_r8 + + !Parameters of Botta et al. 2000 GCB,6 709-725 + a = -68.0_r8 + b = 638.0_r8 + c = -0.001_r8 + coldday = 5.0_r8 + + mindayson = 30 + + !Parameters from SDGVM model of senesence + ncolddayslim = 5 + cold_t = 7.5_r8 + + t = udata%time_period + temp_in_C = t_veg24(currentSite%oldest_patch%clm_pno-1) - tfrz + + !-----------------Cold Phenology--------------------! + + !Zero growing degree and chilling day counters + if (currentSite%lat > 0)then + ncdstart = 270._r8; !Northern Hemisphere begining November + else + ncdstart = 120._r8; !Southern Hemisphere beginning May + endif + + ! FIX(SPM,032414) - this will only work for the first year, no? + if (t == ncdstart)then + currentSite%ncd = 0._r8 + endif + + !Accumulate growing/chilling days after start of counting period + if (temp_in_C < coldday)then + currentSite%ncd = currentSite%ncd + 1.0_r8 + endif + + gdd_threshold = a + b*exp(c*currentSite%ncd) !GDD accumulation function, which also depends on chilling days. + + !Accumulate temperature of last 10 days. + currentSite%last_n_days(2:senes) = currentSite%last_n_days(1:senes-1) + currentSite%last_n_days(1) = temp_in_C + !count number of days for leaves off + ncolddays = 0 + do i = 1,senes + if (currentSite%last_n_days(i) < cold_t)then + ncolddays = ncolddays + 1 + endif + enddo + + timesinceleafoff = t - currentSite%leafoffdate + if (t < currentSite%leafoffdate)then + timesinceleafoff = t +(365-currentSite%leafoffdate) + endif + + !LEAF ON: COLD DECIDUOUS. Needs to + !1) have exceeded the growing degree day threshold + !2) The leaves should not be on already + !3) There should have been at least on chilling day in the counting period. + if (ED_GDD_patch(currentSite%oldest_patch%clm_pno) > gdd_threshold)then + if (currentSite%status == 1)then + if (currentSite%ncd >= 1)then + currentSite%status = 2 !alter status of site to 'leaves on' + currentSite%leafondate = t !record leaf on date + write(iulog,*) 'leaves on' + endif !ncd + endif !status + endif !GDD + + timesinceleafon = t - currentSite%leafondate + if (t < currentSite%leafondate)then + timesinceleafon = t +(365-currentSite%leafondate) + endif + + !LEAF OFF: COLD THRESHOLD + !Needs to: + !1) have exceeded the number of cold days threshold + !2) have exceeded the minimum leafon time. + !3) The leaves should not be off already + !4) The day of the year should be larger than the counting period. (not sure if we need this/if it will break the restarting) + + if (ncolddays > ncolddayslim)then + if (timesinceleafon > mindayson)then + if (currentSite%status == 2)then + currentSite%status = 1 !alter status of site to 'leaves on' + currentSite%leafoffdate = t !record leaf off date + write(iulog,*) 'leaves off' + endif + endif + endif + + !LEAF OFF: COLD LIFESPAN THRESHOLD + if (timesinceleafoff > 360)then !remove leaves after a whole year when there is no 'off' period. + if (currentSite%status == 2)then + currentSite%status = 1 !alter status of site to 'leaves on' + currentSite%leafoffdate = t !record leaf off date + write(iulog,*) 'leaves off' + endif + endif + + !-----------------Drought Phenology--------------------! + ! Principles of drought-deciduos phenology model... + ! The 'dstatus' flag is 2 when leaves are on, and 1 when leaves area off. + ! The following sets those site-level flags, which are acted on in phenology_deciduos. + ! A* The leaves live for either the length of time the soil moisture is over the threshold + ! or the lifetime of the leaves, whichever is shorter. + ! B*: If the soil is only wet for a very short time, then the leaves stay on for 100 days + ! C*: The leaves are only permitted to come ON for a 60 day window around when they last came on, + ! to prevent 'flickering' on in response to wet season storms + ! D*: We don't allow anything to happen in the first ten days to allow the water memory window to come into equlibirum. + ! E*: If the soil is always wet, the leaves come on at the beginning of the window, and then last for their lifespan. + ! ISSUES + ! 1. It's not clear what water content we should track. Here we are tracking the top layer, + ! but we probably should track something like BTRAN, + ! but BTRAN is defined for each PFT, and there could potentially be more than one stress-dec PFT.... ? + ! 2. In the beginning, the window is set at an arbitrary time of the year, so the leaves might come on + ! in the dry season, using up stored reserves + ! for the stress-dec plants, and potentially killing them. To get around this, we need to read in the + ! 'leaf on' date from some kind of start-up file + ! but we would need that to happen for every resolution, etc. + ! 3. Will this methodology properly kill off the stress-dec trees where there is no water stress? + ! What about where the wet period coincides with the + ! warm period? We would just get them overlapping with the cold-dec trees, even though that isn't appropriate.... + ! Why don't the drought deciduous trees grow + ! in the North? Is cold decidousness maybe even the same as drought deciduosness there (and so does this + ! distinction actually matter??).... + + !Accumulate surface water memory of last 10 days. + currentSite%water_memory(1) = waterstate_inst%h2osoi_vol_col(currentSite%clmcolumn,1) + do i = 1,9 !shift memory along one + currentSite%water_memory(11-i) = currentSite%water_memory(10-i) + enddo + + !In drought phenology, we often need to force the leaves to stay on or off as moisture fluctuates... + timesincedleafoff = 0 + if (currentSite%dstatus == 1)then !the leaves are off. How long have they been off? + !leaves have come on, but last year, so at a later date than now. + if (currentSite%dleafoffdate > 0.and.currentSite%dleafoffdate > t)then + timesincedleafoff = t + (360 - currentSite%dleafoffdate) + else + timesincedleafoff = t - currentSite%dleafoffdate + endif + endif + + timesincedleafon = 0 + !the leaves are on. How long have they been on? + if (currentSite%dstatus == 2)then + !leaves have come on, but last year, so at a later date than now. + if (currentSite%dleafondate > 0.and.currentSite%dleafondate > t)then + timesincedleafon = t + (360 - currentSite%dleafondate) + else + timesincedleafon = t - currentSite%dleafondate + endif + endif + + !LEAF ON: DROUGHT DECIDUOUS WETNESS + !Here, we used a window of oppurtunity to determine if we are close to the time when then leaves came on last year + if ((t >= currentSite%dleafondate - 30.and.t <= currentSite%dleafondate + 30).or.(t > 360 - 15.and. & + currentSite%dleafondate < 15))then ! are we in the window? + if (sum(currentSite%water_memory(1:10)/10._r8) >= drought_threshold.and.currentSite%dstatus == 1.and.t >= 10)then + ! leave some minimum time between leaf off and leaf on to prevent 'flickering'. + if (timesincedleafoff > off_time)then + currentSite%dstatus = 2 !alter status of site to 'leaves on' + currentSite%dleafondate = t !record leaf on date + endif + endif + endif + + !we still haven't done budburst by end of window + if (t == currentSite%dleafondate+30.and.currentSite%dstatus == 1)then + currentSite%dstatus = 2 ! force budburst! + currentSite%dleafondate = t ! record leaf on date + endif + + !LEAF OFF: DROUGHT DECIDUOUS LIFESPAN - if the leaf gets to the end of its useful life. A*, E* + if (currentSite%dstatus == 2.and.t >= 10)then !D* + !Are the leaves at the end of their lives? !FIX(RF,0401014)- this is hardwiring.... + if (timesincedleafon > 365.0*pftcon%leaf_long(7))then + currentSite%dstatus = 1 !alter status of site to 'leaves on' + currentSite%dleafoffdate = t !record leaf on date + endif + endif + + !LEAF OFF: DROUGHT DECIDUOUS DRYNESS - if the soil gets too dry, and the leaves have already been on a while... + if (currentSite%dstatus == 2.and.t >= 10)then !D* + if (sum(currentSite%water_memory(1:10)/10._r8) <= drought_threshold)then + if (timesincedleafon > 100)then !B* Have the leaves been on for some reasonable length of time? To prevent flickering. + currentSite%dstatus = 1 !alter status of site to 'leaves on' + currentSite%dleafoffdate = t !record leaf on date + endif + endif + endif + + call phenology_leafonoff(currentSite) + + end subroutine phenology + + ! ============================================================================ + subroutine phenology_leafonoff(currentSite) + ! + ! !DESCRIPTION: + ! Controls the leaf on and off economics + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type), intent(inout), pointer:: currentSite + ! + ! !LOCAL VARIABLES: + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + !------------------------------------------------------------------------ + + currentPatch => CurrentSite%oldest_patch + + do while(associated(currentPatch)) + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + + !COLD LEAF ON + if (pftcon%season_decid(currentCohort%pft) == 1)then + if (currentSite%status == 2)then !we have just moved to leaves being on . + if (currentCohort%status_coh == 1)then !Are the leaves currently off? + currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. + if (currentCohort%laimemory <= currentCohort%bstore)then + currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. + else + currentCohort%bl = currentCohort%bstore !we can only put on as much carbon as there is in the store... + !nb. Putting all of bstore into leaves is C-starvation suicidal. The tendency for this could be parameterized + endif + currentCohort%balive = currentCohort%balive + currentCohort%bl ! Add deployed carbon to alive biomass pool + currentCohort%bstore = currentCohort%bstore - currentCohort%bl ! Drain store + currentCohort%laimemory = 0.0_r8 + endif !pft phenology + endif ! growing season + + !COLD LEAF OFF + currentCohort%leaf_litter = 0.0_r8 !zero leaf litter for today. + if (currentSite%status == 1)then !past leaf drop day? Leaves still on tree? + if (currentCohort%status_coh == 2)then ! leaves have not dropped + currentCohort%status_coh = 1 + !remember what the lai was this year to put the same amount back on in the spring... + currentCohort%laimemory = currentCohort%bl + ! decrement balive for leaf litterfall + currentCohort%balive = currentCohort%balive - currentCohort%bl + ! add lost carbon to litter + currentCohort%leaf_litter = currentCohort%bl + currentCohort%bl = 0.0_r8 + endif !leaf status + endif !currentSite status + endif !season_decid + + !DROUGHT LEAF ON + if (pftcon%stress_decid(currentCohort%pft) == 1)then + if (currentSite%dstatus == 2)then !we have just moved to leaves being on . + if (currentCohort%status_coh == 1)then !is it the leaf-on day? Are the leaves currently off? + currentCohort%status_coh = 2 !Leaves are on, so change status to stop flow of carbon out of bstore. + if (currentCohort%laimemory <= currentCohort%bstore)then + currentCohort%bl = currentCohort%laimemory !extract stored carbon to make new leaves. + else + currentCohort%bl = currentCohort%bstore !we can only put on as much carbon as there is in the store... + endif + currentCohort%balive = currentCohort%balive + currentCohort%bl + currentCohort%bstore = currentCohort%bstore - currentCohort%bl ! empty store + currentCohort%laimemory = 0.0_r8 + endif !currentCohort status again? + endif !currentSite status + + !DROUGHT LEAF OFF + if (currentSite%dstatus == 1)then + if (currentCohort%status_coh == 2)then ! leaves have not dropped + currentCohort%status_coh = 1 + currentCohort%laimemory = currentCohort%bl + ! decrement balive for leaf litterfall + currentCohort%balive = currentCohort%balive - currentCohort%bl + ! add retranslocated carbon (very small) to store. + currentCohort%bstore = currentCohort%bstore + ! add falling leaves to litter pools . convert to KgC/m2 + currentCohort%leaf_litter = currentCohort%bl + currentCohort%bl = 0.0_r8 + endif + endif !status + endif !drought dec. + currentCohort => currentCohort%shorter + enddo !currentCohort + + currentPatch => currentPatch%younger + + enddo !currentPatch + + end subroutine phenology_leafonoff + + + ! ============================================================================ + subroutine seeds_in( cp_pnt ) + ! + ! !DESCRIPTION: + ! Flux from plants into seed pool. + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type), intent(inout), target :: cp_pnt ! seeds go to these patches. + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + type(ed_site_type), pointer :: currentSite + type(ed_cohort_type), pointer :: currentCohort + integer :: p + !---------------------------------------------------------------------- + + currentPatch => cp_pnt + currentSite => currentPatch%siteptr + + currentPatch%seeds_in(:) = 0.0_r8 + currentCohort => currentPatch%tallest + do while (associated(currentCohort)) + p = currentCohort%pft + currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + currentCohort%seed_prod * currentCohort%n/currentPatch%area + currentCohort => currentCohort%shorter + enddo !cohort loop + + currentPatch => currentSite%oldest_patch + + do while(associated(currentPatch)) + if (EXTERNAL_RECRUITMENT == 1) then !external seed rain - needed to prevent extinction + do p = 1,numpft_ed + currentPatch%seeds_in(p) = currentPatch%seeds_in(p) + EDecophyscon%seed_rain(p) !KgC/m2/year + enddo + endif + currentPatch => currentPatch%younger + enddo + + end subroutine seeds_in + + ! ============================================================================ + subroutine seed_decay( currentPatch ) + ! + ! !DESCRIPTION: + ! Flux from seed pool into leaf litter pool + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type),intent(inout) :: currentPatch ! seeds go to these patches. + ! + ! !LOCAL VARIABLES: + integer :: p + real(r8) :: seed_turnover !complete seed turnover rate in yr-1. + !---------------------------------------------------------------------- + + seed_turnover = 0.51_r8 ! from Liscke and Loffler 2006 + ! decays the seed pool according to exponential model + ! sd_mort is in yr-1 + do p = 1,numpft_ed + currentPatch%seed_decay(p) = currentPatch%seed_bank(p) * seed_turnover + enddo + + end subroutine seed_decay + + ! ============================================================================ + subroutine seed_germination( currentPatch ) + ! + ! !DESCRIPTION: + ! Flux from seed pool into sapling pool + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type),intent(inout) :: currentPatch ! seeds go to these patches. + ! + ! !LOCAL VARIABLES: + integer :: p + real(r8) max_germination !cap on germination rates. KgC/m2/yr Lishcke et al. 2009 + real(r8) germination_timescale !yr-1 + !---------------------------------------------------------------------- + + germination_timescale = 0.5_r8 !this is arbitrary + max_germination = 1.0_r8 !this is arbitrary + + do p = 1,numpft_ed + currentPatch%seed_germination(p) = min(currentPatch%seed_bank(p) * germination_timescale,max_germination) + enddo + + end subroutine seed_germination + + ! ============================================================================ + subroutine Growth_Derivatives( currentCohort) + ! + ! !DESCRIPTION: + ! Main subroutine controlling growth and allocation derivatives + ! + ! !USES: + use EDGrowthFunctionsMod , only : Bleaf, dDbhdBd, dhdbd, hite, mortality_rates,dDbhdBl + use EDTypesMod , only : udata + ! + ! !ARGUMENTS + type(ed_cohort_type),intent(inout), target :: currentCohort + ! + ! !LOCAL VARIABLES: + type(ed_site_type), pointer :: currentSite + real(r8) :: dbldbd !rate of change of dead biomass per unit dbh + real(r8) :: dbrdbd !rate of change of root biomass per unit dbh + real(r8) :: dbswdbd !rate of change of sapwood biomass per unit dbh + real(r8) :: dhdbd_fn !rate of change of height per unit dbh + real(r8) :: va !fraction of growth going to alive biomass + real(r8) :: vs !fraction of growth going to structural biomass + real(r8) :: u,h !intermediates + real(r8) :: frac !fraction the stored carbon is of target store amount + real(r8) :: f_store !fraction of NPP allocated to storage in this timestep (functionf of stored pool) + real(r8) :: gr_fract !fraction of carbon balance that is allocated to growth (not reproduction) + real(r8) :: target_balive !target leaf biomass under allometric optimum. + real(r8) :: balive_loss + !---------------------------------------------------------------------- + + currentSite => currentCohort%siteptr + + ! Mortality for trees in the understorey. + !if trees are in the canopy, then their death is 'disturbance'. This probably needs a different terminology + if (currentCohort%canopy_layer > 1)then + currentCohort%dndt = -1.0_r8 * mortality_rates(currentCohort) * currentCohort%n + else + currentCohort%dndt = 0._r8 + endif + + ! Height + currentCohort%hite = Hite(currentCohort) + h = currentCohort%hite + + call allocate_live_biomass(currentCohort) + + ! calculate target size of living biomass compartment for a given dbh. + target_balive = Bleaf(currentCohort) * (1.0_r8 + pftcon%froot_leaf(currentCohort%pft) + & + EDecophyscon%sapwood_ratio(currentCohort%pft)*h) + !target balive without leaves. + if (currentCohort%status_coh == 1)then + target_balive = Bleaf(currentCohort) * (pftcon%froot_leaf(currentCohort%pft) + & + EDecophyscon%sapwood_ratio(currentCohort%pft) * h) + endif + + ! NPP + currentCohort%npp = currentCohort%npp_acc * N_SUB !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year + currentCohort%gpp = currentCohort%gpp_acc * N_SUB !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year + currentCohort%resp = currentCohort%resp_acc * N_SUB !Link to CLM. convert from kgC/indiv/day into kgC/indiv/year + + currentSite%flux_in = currentSite%flux_in + currentCohort%npp_acc * currentCohort%n + + ! Maintenance demands + if (pftcon%evergreen(currentCohort%pft) == 1)then !grass and EBT + currentCohort%leaf_md = currentCohort%bl / pftcon%leaf_long(currentCohort%pft) + currentCohort%root_md = currentCohort%br / EDecophyscon%root_long(currentCohort%pft) + currentCohort%md = currentCohort%root_md + currentCohort%leaf_md + endif + + !FIX(RF,032414) - I took out the stem turnover demand as it seemed excesively high and caused odd size-reated + ! decline affect + !with which I am not especially comfortable, particularly as the concept of sapwood turnover is unclear for trees that + !are still in an expansion phase. + + if (pftcon%season_decid(currentCohort%pft) == 1)then + currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_md = 0._r8 + currentCohort%md = currentCohort%root_md + currentCohort%leaf_md + endif + + if (pftcon%stress_decid(currentCohort%pft) == 1)then + currentCohort%root_md = currentCohort%br /EDecophyscon%root_long(currentCohort%pft) + currentCohort%leaf_md = 0._r8 + currentCohort%md = currentCohort%root_md + currentCohort%leaf_md + endif + + if (pftcon%stress_decid(currentCohort%pft) /= 1.and.pftcon%season_decid(currentCohort%pft) /= 1.and. & + pftcon%evergreen(currentCohort%pft) /= 1)then + write(iulog,*) 'problem with phenology definitions',currentCohort%pft,pftcon%stress_decid(currentCohort%pft), & + pftcon%season_decid(currentCohort%pft),pftcon%evergreen(currentCohort%pft) + endif + + ! FIX(RF,032414) -turned off for now as it makes balive go negative.... + ! FIX(RF,032414) jan2012 0.01_r8 * currentCohort%bdead + currentCohort%woody_turnover = 0.0_r8 + currentCohort%md = currentCohort%md + currentCohort%woody_turnover + + ! Calculate carbon balance + ! this is the fraction of maintenance demand we -have- to do... + + currentCohort%carbon_balance = currentCohort%npp - currentCohort%md * EDecophyscon%leaf_stor_priority(currentCohort%pft) + + if (Bleaf(currentCohort) > 0._r8)then + + if (currentCohort%carbon_balance > 0._r8)then !spend C on growing and storing + + !what fraction of the target storage do we have? + frac = max(0.0_r8,currentCohort%bstore/(Bleaf(currentCohort) * EDecophyscon%cushion(currentCohort%pft))) + ! FIX(SPM,080514,fstore never used ) + f_store = max(exp(-1.*frac**4._r8) - exp( -1.0_r8 ),0.0_r8) + !what fraction of allocation do we divert to storage? + !what is the flux into the store? + currentCohort%storage_flux = currentCohort%carbon_balance * f_store + !what is the tax on the carbon available for growth? + currentCohort%carbon_balance = currentCohort%carbon_balance * (1.0_r8 - f_store) + else !cbalance is negative. Take C out of store to pay for maintenance respn. + currentCohort%storage_flux = currentCohort%carbon_balance + currentCohort%carbon_balance = 0._r8 + endif + + else + + currentCohort%storage_flux = 0._r8 + currentCohort%carbon_balance = 0._r8 + write(iulog,*) 'ED: no leaf area in gd', currentCohort%indexnumber,currentCohort%n,currentCohort%bdead, & + currentCohort%dbh,currentCohort%balive + + endif + + !Do we have enough carbon left over to make up the rest of the turnover demand? + balive_loss = 0._r8 + if (currentCohort%carbon_balance > currentCohort%md*(1.0_r8- EDecophyscon%leaf_stor_priority(currentCohort%pft)))then ! Yes... + currentCohort%carbon_balance = currentCohort%carbon_balance - currentCohort%md * (1.0_r8 - & + EDecophyscon%leaf_stor_priority(currentCohort%pft)) + else ! we can't maintain constant leaf area and root area. Balive is reduced + balive_loss = currentCohort%md *(1.0_r8- EDecophyscon%leaf_stor_priority(currentCohort%pft))- currentCohort%carbon_balance + currentCohort%carbon_balance = 0._r8 + endif + + !********************************************/ + ! Allometry & allocation of remaining carbon*/ + !********************************************/ + !Use remaining carbon to refill balive or to get larger. + + !only if carbon balance is +ve + if ((currentCohort%balive >= target_balive).AND.(currentCohort%carbon_balance > 0._r8))then + ! fraction of carbon going into active vs structural carbon + if (currentCohort%dbh <= EDecophyscon%max_dbh(currentCohort%pft))then ! cap on leaf biomass + dbldbd = dDbhdBd(currentCohort)/dDbhdBl(currentCohort) + dbrdbd = pftcon%froot_leaf(currentCohort%pft) * dbldbd + dhdbd_fn = dhdbd(currentCohort) + dbswdbd = EDecophyscon%sapwood_ratio(currentCohort%pft) * (h*dbldbd + currentCohort%bl*dhdbd_fn) + u = 1.0_r8 / (dbldbd + dbrdbd + dbswdbd) + va = 1.0_r8 / (1.0_r8 + u) + vs = u / (1.0_r8 + u) + gr_fract = 1.0_r8 - EDecophyscon%seed_alloc(currentCohort%pft) + else + dbldbd = 0._r8; dbrdbd = 0._r8 ;dbswdbd = 0._r8 + va = 0.0_r8 + vs = 1.0_r8 + gr_fract = 1.0_r8 - (EDecophyscon%seed_alloc(currentCohort%pft) + EDecophyscon%clone_alloc(currentCohort%pft)) + endif + + !FIX(RF,032414) - to fix high bl's. needed to prevent numerical errors without the ODEINT. + if (currentCohort%balive > target_balive*1.1_r8)then + va = 0.0_r8; vs = 1._r8 + write(iulog,*) 'using high bl cap',target_balive,currentCohort%balive + endif + + else + dbldbd = 0._r8; dbrdbd = 0._r8; dbswdbd = 0._r8 + va = 1.0_r8; vs = 0._r8 + gr_fract = 1.0_r8 + endif + + ! calculate derivatives of living and dead carbon pools + currentCohort%dbalivedt = gr_fract * va * currentCohort%carbon_balance - balive_loss + currentCohort%dbdeaddt = gr_fract * vs * currentCohort%carbon_balance + currentCohort%dbstoredt = currentCohort%storage_flux + currentCohort%seed_prod = (1.0_r8 - gr_fract) * currentCohort%carbon_balance + if (abs(currentCohort%npp-(currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+ & + currentCohort%seed_prod+currentCohort%md)) > 0.0000000001_r8)then + write(iulog,*) 'error in carbon check growth derivs',currentCohort%npp- & + (currentCohort%dbalivedt+currentCohort%dbdeaddt+currentCohort%dbstoredt+currentCohort%seed_prod+currentCohort%md) + write(iulog,*) 'cohort fluxes',currentCohort%pft,currentCohort%canopy_layer,currentCohort%n, & + currentCohort%npp,currentCohort%dbalivedt,balive_loss, & + currentCohort%dbdeaddt,currentCohort%dbstoredt,currentCohort%seed_prod,currentCohort%md * & + EDecophyscon%leaf_stor_priority(currentCohort%pft) + write(iulog,*) 'proxies' ,target_balive,currentCohort%balive,currentCohort%dbh,va,vs,gr_fract + endif + + ! prevent negative leaf pool (but not negative store pool). This is also a numerical error prevention, + ! but it shouldn't happen actually... + if (-1.0_r8*currentCohort%dbalivedt * udata%deltat > currentCohort%balive*0.99)then + write(iulog,*) 'using non-neg leaf mass cap',currentCohort%balive , currentCohort%dbalivedt,currentCohort%dbstoredt, & + currentCohort%carbon_balance + currentCohort%dbstoredt = currentCohort%dbstoredt + currentCohort%dbalivedt + currentCohort%dbalivedt = 0._r8 + endif + + ! calculate change in diameter and height + currentCohort%ddbhdt = currentCohort%dbdeaddt * dDbhdBd(currentCohort) + currentCohort%dhdt = currentCohort%dbdeaddt * dHdBd(currentCohort) + + end subroutine Growth_Derivatives + + ! ============================================================================ + subroutine recruitment( t, currentPatch ) + ! + ! !DESCRIPTION: + ! spawn new cohorts of juveniles of each PFT + ! + ! !USES: + use EDGrowthFunctionsMod, only : bdead,dbh, Bleaf + use EDTypesMod, only : udata + ! + ! !ARGUMENTS + integer, intent(in) :: t + type(ed_patch_type), intent(inout), pointer :: currentPatch + ! + ! !LOCAL VARIABLES: + integer :: ft + type (ed_cohort_type) , pointer :: temp_cohort + integer :: cohortstatus + !---------------------------------------------------------------------- + + allocate(temp_cohort) ! create temporary cohort + call zero_cohort(temp_cohort) + + do ft = 1,numpft_ed + + temp_cohort%canopy_trim = 0.8_r8 !starting with the canopy not fully expanded + temp_cohort%pft = ft + temp_cohort%hite = EDecophyscon%hgt_min(ft) + temp_cohort%dbh = Dbh(temp_cohort) + temp_cohort%bdead = Bdead(temp_cohort) + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(ft) & + + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite) + temp_cohort%bstore = EDecophyscon%cushion(ft)*(temp_cohort%balive/ (1.0_r8 + pftcon%froot_leaf(ft) & + + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite)) + temp_cohort%n = currentPatch%area * currentPatch%seed_germination(ft)*udata%deltat & + / (temp_cohort%bdead+temp_cohort%balive+temp_cohort%bstore) + + if (t == 1)then + write(iulog,*) 'filling in cohorts where there are none left; this will break carbon balance', & + currentPatch%patchno,currentPatch%area + temp_cohort%n = 0.1_r8*currentPatch%area + write(iulog,*) 'cohort n',ft,temp_cohort%n + endif + + temp_cohort%laimemory = 0.0_r8 + if (pftcon%season_decid(temp_cohort%pft) == 1.and.currentPatch%siteptr%status == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive + endif + if (pftcon%stress_decid(temp_cohort%pft) == 1.and.currentPatch%siteptr%dstatus == 1)then + temp_cohort%laimemory = (1.0_r8/(1.0_r8 + pftcon%froot_leaf(ft) + & + EDecophyscon%sapwood_ratio(ft)*temp_cohort%hite))*temp_cohort%balive + endif + + cohortstatus = currentPatch%siteptr%status + if (pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + cohortstatus = currentPatch%siteptr%dstatus + endif + + if (temp_cohort%n > 0.0_r8)then + call create_cohort(currentPatch, temp_cohort%pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & + temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, currentPatch%NCL_p) + endif + enddo !pft loop + + deallocate(temp_cohort) ! delete temporary cohort + + call fuse_cohorts(currentPatch) + call sort_cohorts(currentPatch) + + end subroutine recruitment + + ! ============================================================================ + subroutine CWD_Input( currentPatch) + ! + ! !DESCRIPTION: + ! Generate litter fields from turnover. + ! + ! !USES: + use SFParamsMod , only : SF_val_CWD_frac + use EDParamsMod , only : ED_val_ag_biomass + use EDTypesMod , only : udata + ! + ! !ARGUMENTS + type(ed_patch_type),intent(inout), target :: currentPatch + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: currentCohort + integer :: c,p + real(r8) :: not_dead_n !projected remaining number of trees in understorey cohort after turnover + real(r8) :: dead_n !understorey dead tree density + integer :: pft + !---------------------------------------------------------------------- + + ! ================================================ + ! Other direct litter fluxes happen in phenology and in spawn_patches. + ! ================================================ + + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + pft = currentCohort%pft + ! ================================================ + ! Litter from tissue turnover. KgC/m2/year + ! ================================================ + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & + currentCohort%leaf_md * currentCohort%n/currentPatch%area !turnover + + currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & + currentCohort%root_md * currentCohort%n/currentPatch%area !turnover + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & + currentCohort%leaf_litter * currentCohort%n/currentPatch%area/udata%deltat + + !daily leaf loss needs to be scaled up to the annual scale here. + + do c = 1,ncwd + currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + currentCohort%woody_turnover * & + SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *ED_val_ag_biomass + currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + currentCohort%woody_turnover * & + SF_val_CWD_frac(c) * currentCohort%n/currentPatch%area *(1.0_r8-ED_val_ag_biomass) + enddo + + if (currentCohort%canopy_layer > 1)then + + ! ================================================ + ! Litter fluxes for understorey mortality. KgC/m2/year + ! ================================================ + dead_n = -1.0_r8 * currentCohort%dndt / currentPatch%area + + currentPatch%leaf_litter_in(pft) = currentPatch%leaf_litter_in(pft) + & + (currentCohort%bl+currentCohort%leaf_litter/udata%deltat)* dead_n + currentPatch%root_litter_in(pft) = currentPatch%root_litter_in(pft) + & + (currentCohort%br+currentCohort%bstore) * dead_n + + do c = 1,ncwd + currentPatch%cwd_AG_in(c) = currentPatch%cwd_AG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * dead_n * ED_val_ag_biomass + currentPatch%cwd_BG_in(c) = currentPatch%cwd_BG_in(c) + (currentCohort%bdead+currentCohort%bsw) * & + SF_val_CWD_frac(c) * dead_n * (1.0_r8-ED_val_ag_biomass) + + if (currentPatch%cwd_AG_in(c) < 0.0_r8)then + write(iulog,*) 'negative CWD in flux',currentPatch%cwd_AG_in(c), & + (currentCohort%bdead+currentCohort%bsw), dead_n + endif + enddo + + endif !canopy layer + + currentCohort => currentCohort%taller + + enddo ! end loop over cohorts + + do p = 1,numpft_ed + currentPatch%leaf_litter_in(p) = currentPatch%leaf_litter_in(p) + currentPatch%seed_decay(p) !KgC/m2/yr + enddo + + end subroutine CWD_Input + + ! ============================================================================ + subroutine fragmentation_scaler( currentPatch, temperature_inst ) + ! + ! !DESCRIPTION: + ! Simple CWD fragmentation Model + ! FIX(SPM, 091914) this should be a function as it returns a value in currentPatch%fragmentation_scaler + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_PI, SHR_CONST_TKFRZ + use EDSharedParamsMod , only : EDParamsShareInst + ! + ! !ARGUMENTS + type(ed_patch_type) , intent(inout) :: currentPatch + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + logical :: use_century_tfunc = .false. + type(ed_site_type), pointer :: currentSite + integer :: c,p,j + real(r8) :: t_scalar + real(r8) :: w_scalar + real(r8) :: catanf ! hyperbolic temperature function from CENTURY + real(r8) :: catanf_30 ! hyperbolic temperature function from CENTURY + real(r8) :: t1 ! temperature argument + real(r8) :: Q10 ! temperature dependence + real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates + real(r8), pointer :: t_veg24(:) + !---------------------------------------------------------------------- + + catanf(t1) = 11.75_r8 +(29.7_r8 / SHR_CONST_PI) * atan( SHR_CONST_PI * 0.031_r8 * ( t1 - 15.4_r8 )) + + t_veg24 => temperature_inst%t_veg24_patch ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs + + catanf_30 = catanf(30._r8) + + c = currentPatch%siteptr%clmcolumn + p = currentPatch%clm_pno + + ! set "froz_q10" parameter + froz_q10 = EDParamsShareInst%froz_q10 + Q10 = EDParamsShareInst%Q10 + + if ( .not. use_century_tfunc ) then + !calculate rate constant scalar for soil temperature,assuming that the base rate constants + !are assigned for non-moisture limiting conditions at 25C. + if (t_veg24(p) >= SHR_CONST_TKFRZ) then + t_scalar = Q10**((t_veg24(p)-(SHR_CONST_TKFRZ+25._r8))/10._r8) + ! Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8) + else + t_scalar = (Q10**(-25._r8/10._r8))*(froz_q10**((t_veg24(p)-SHR_CONST_TKFRZ)/10._r8)) + !Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8) + endif + else + ! original century uses an arctangent function to calculate the temperature dependence of decomposition + t_scalar = max(catanf(t_veg24(p)-SHR_CONST_TKFRZ)/catanf_30,0.01_r8) + endif + + !Moisture Limitations + !BTRAN APPROACH - is quite simple, but max's out decomp at all unstressed soil moisture values, which is not realistic. + !litter decomp is proportional to water limitation on average... + w_scalar = sum(currentPatch%btran_ft(1:numpft_ed))/numpft_ed + + currentPatch%fragmentation_scaler = min(1.0_r8,max(0.0_r8,t_scalar * w_scalar)) + + end subroutine fragmentation_scaler + + ! ============================================================================ + subroutine cwd_out( currentPatch, temperature_inst, soilstate_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Simple CWD fragmentation Model + ! spawn new cohorts of juveniles of each PFT + ! + ! !USES: + use SFParamsMod, only : SF_val_max_decomp + use EDTypesMod , only : udata + ! + ! !ARGUMENTS + type(ed_patch_type) , intent(inout), target :: currentPatch + type(temperature_type) , intent(in) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + type(ed_site_type), pointer :: currentSite + integer :: c,ft + !---------------------------------------------------------------------- + + currentSite => currentPatch%siteptr + currentPatch%root_litter_out = 0.0_r8 + currentPatch%leaf_litter_out = 0.0_r8 + + call fragmentation_scaler(currentPatch, temperature_inst) + + !Flux of coarse woody debris into decomposing litter pool. + + currentPatch%cwd_ag_out(1:ncwd) = 0.0_r8 + currentPatch%cwd_bg_out(1:ncwd) = 0.0_r8 + currentPatch%leaf_litter_out(1:numpft_ed) = 0.0_r8 + currentPatch%root_litter_out(1:numpft_ed) = 0.0_r8 + + do c = 1,ncwd + currentPatch%cwd_ag_out(c) = max(0.0_r8, currentPatch%cwd_ag(c) * & + SF_val_max_decomp(c+1) * currentPatch%fragmentation_scaler ) + currentPatch%cwd_bg_out(c) = max(0.0_r8, currentPatch%cwd_bg(c) * & + SF_val_max_decomp(c+1) * currentPatch%fragmentation_scaler ) + enddo + + ! this is the rate at which dropped leaves stop being part of the burnable pool and begin to be part of the + ! decomposing pool. This should probably be highly sensitive to moisture, but also to the type of leaf + ! thick leaves can dry out before they are decomposed, for example. + ! this section needs further scientific input. + + do ft = 1,numpft_ed + currentPatch%leaf_litter_out(ft) = max(0.0_r8,currentPatch%leaf_litter(ft)* SF_val_max_decomp(dg_sf) * & + currentPatch%fragmentation_scaler ) + currentPatch%root_litter_out(ft) = max(0.0_r8,currentPatch%root_litter(ft)* SF_val_max_decomp(dg_sf) * & + currentPatch%fragmentation_scaler ) + if ( currentPatch%leaf_litter_out(ft)<0.0_r8.or.currentPatch%root_litter_out(ft)<0.0_r8)then + write(iulog,*) 'root or leaf out is negative?',SF_val_max_decomp(dg_sf),currentPatch%fragmentation_scaler + endif + enddo + + !add up carbon going into fragmenting pools + currentSite%flux_out = currentSite%flux_out + sum(currentPatch%leaf_litter_out) * & + currentPatch%area *udata%deltat!kgC/site/day + currentSite%flux_out = currentSite%flux_out + sum(currentPatch%root_litter_out) * & + currentPatch%area *udata%deltat!kgC/site/day + currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_ag_out) * & + currentPatch%area *udata%deltat!kgC/site/day + currentSite%flux_out = currentSite%flux_out + sum(currentPatch%cwd_bg_out) * & + currentPatch%area *udata%deltat!kgC/site/day + + end subroutine cwd_out + +end module EDPhysiologyMod diff --git a/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 new file mode 100644 index 0000000000..a51fbb5f24 --- /dev/null +++ b/components/clm/src/ED/biogeochem/EDSharedParamsMod.F90 @@ -0,0 +1,54 @@ +module EDSharedParamsMod + + !----------------------------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + + ! EDParamsShareInst. PGI wants the type decl. public but the instance + ! is indeed protected. A generic private statement at the start of the module + ! overrides the protected functionality with PGI + + type, public :: EDParamsShareType + real(r8) :: Q10 ! temperature dependence + real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates + end type EDParamsShareType + + type(EDParamsShareType), protected :: EDParamsShareInst + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine EDParamsReadShared(ncid) + ! + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + character(len=32) :: subname = 'EDParamsReadShared' + character(len=100) :: errCode = '-Error reading in ED shared params file. Var:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! netcdf read here + ! + tString='q10_mr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + EDParamsShareInst%Q10=tempr + + tString='froz_q10' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + EDParamsShareInst%froz_q10=tempr + + end subroutine EDParamsReadShared + +end module EDSharedParamsMod diff --git a/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 new file mode 100644 index 0000000000..29312bb317 --- /dev/null +++ b/components/clm/src/ED/biogeophys/EDAccumulateFluxesMod.F90 @@ -0,0 +1,83 @@ +module EDAccumulateFluxesMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! This routine accumulates NPP, GPP and respiration of each cohort over the course of each 24 hour period. + ! The fluxes are stored per cohort, and the npp_clm (etc) fluxes are calcualted in EDPhotosynthesis + ! This routine cannot be in EDPhotosynthesis because EDPhotosynthesis is a loop and therefore would + ! erroneously add these things up multiple times. + ! Rosie Fisher. March 2014. + ! + ! !USES: + implicit none + ! + public :: AccumulateFluxes_ED + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine AccumulateFluxes_ED(bounds, p, ed_allsites_inst, photosyns_inst) + ! + ! !DESCRIPTION: + ! see above + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use EDTypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, map_clmpatch_to_edpatch + use PatchType , only : patch + use PhotosynthesisMod , only : photosyns_type + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: p !patch/'p' + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type), pointer :: currentCohort ! current cohort + type(ed_patch_type) , pointer :: currentPatch ! current patch + integer :: iv !leaf layer + integer :: g !gridcell + !---------------------------------------------------------------------- + + associate(& + fpsn => photosyns_inst%fpsn_patch , & ! Output: [real(r8) (:)] photosynthesis (umol CO2 /m**2 /s) + psncanopy => photosyns_inst%psncanopy_patch & ! Output: [real(r8) (:,:)] canopy scale photosynthesis umol CO2 /m**2/ s + ) + + fpsn(p) = psncanopy(p) + + if (patch%is_veg(p)) then + + g = patch%gridcell(p) + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + + ! Accumulate fluxes from hourly to daily values. + ! _clm fluxes are KgC/indiv/timestep _acc are KgC/indiv/day + + currentCohort%npp_acc = currentCohort%npp_acc + currentCohort%npp_clm + currentCohort%gpp_acc = currentCohort%gpp_acc + currentCohort%gpp_clm + currentCohort%resp_acc = currentCohort%resp_acc + currentCohort%resp_clm + + do iv=1,currentCohort%nv + if(currentCohort%year_net_uptake(iv) == 999._r8)then ! note that there were leaves in this layer this year. + currentCohort%year_net_uptake(iv) = 0._r8 + end if + currentCohort%year_net_uptake(iv) = currentCohort%year_net_uptake(iv) + currentCohort%ts_net_uptake(iv) + enddo + + currentCohort => currentCohort%taller + enddo ! while(associated(currentCohort) + + end if !is_veg + + end associate + + end subroutine AccumulateFluxes_ED + +end module EDAccumulateFluxesMod diff --git a/components/clm/src/ED/biogeophys/EDBtranMod.F90 b/components/clm/src/ED/biogeophys/EDBtranMod.F90 new file mode 100644 index 0000000000..5cfb93c74b --- /dev/null +++ b/components/clm/src/ED/biogeophys/EDBtranMod.F90 @@ -0,0 +1,349 @@ +module EDBtranMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! This routine accumulates NPP, GPP and respiration of each cohort over the course of each 24 hour period. + ! The fluxes are stored per cohort, and the npp_clm (etc) fluxes are calcualted in EDPhotosynthesis + ! This routine cannot be in EDPhotosynthesis because EDPhotosynthesis is a loop and therefore would + ! erroneously add these things up multiple times. + ! Rosie Fisher. March 2014. + ! + ! !USES: + use pftconMod , only : pftcon + use EDTypesMod , only : ed_patch_type, ed_cohort_type, numpft_ed + use EDEcophysContype , only : EDecophyscon + ! + implicit none + private + ! + public :: BTRAN_ED + ! + type(ed_cohort_type), pointer :: currentCohort ! current cohort + type(ed_patch_type) , pointer :: currentPatch ! current patch + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine btran_ed( bounds, p, ed_allsites_inst, & + soilstate_inst, waterstate_inst, temperature_inst, energyflux_inst) + ! + ! !DESCRIPTION: + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : shr_const_pi + use decompMod , only : bounds_type + use clm_varpar , only : nlevgrnd + use clm_varctl , only : iulog + use clm_varcon , only : tfrz, denice, denh2o + use SoilStateType , only : soilstate_type + use WaterStateType , only : waterstate_type + use TemperatureType , only : temperature_type + use EnergyFluxType , only : energyflux_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use EDTypesMod , only : ed_site_type, map_clmpatch_to_edpatch + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds ! clump bounds + integer , intent(in) :: p ! patch/'p' + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(soilstate_type) , intent(inout) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: iv !leaf layer + integer :: g !gridcell + integer :: c !column + integer :: j !soil layer + integer :: ft ! plant functional type index + !---------------------------------------------------------------------- + + ! Inputs to model from CLM. To be read in through an input file for the purposes of this program. + integer, parameter :: nv = 5 ! Number of canopy layers + real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s] + real(r8) :: s1 ! HC intermediate + real(r8) :: swp_mpa(nlevgrnd) ! matrix potential - MPa + real(r8) :: hk(nlevgrnd) ! hydraulic conductivity [mm h2o/s] + real(r8) :: rootxsecarea ! root X-sectional area (m2) + real(r8) :: rootmass(nlevgrnd) ! root mass in each layer (g) + real(r8) :: rootlength(nlevgrnd) ! root length in each layer (m) + real(r8) :: soilr1(nlevgrnd) ! soil-to-root resistance in each layer (MPa s m2 mmol-1) + real(r8) :: soilr2(nlevgrnd) ! internal root resistance in each layer (MPa s m2 mmol-1) + real(r8) :: rs ! intermediate variable + real(r8) :: soilr_z(nlevgrnd) ! soil-to-xylem resistance in each layer (MPa s m2 mmol-1) + real(r8) :: lsoil(nlevgrnd) ! hydraulic conductivity in each soil layer + + real(r8) :: estevap(nlevgrnd) ! potential suction from each soil layer (mmol m-2 s-1) + real(r8) :: totestevap ! potential suction from each soil layer (mmol m-2 s-1) + real(r8) :: fraction_uptake(nlevgrnd) ! Uptake of water from each soil layer (-) + real(r8) :: maxevap(nlevgrnd) ! potential suction from each soil layer (mmol m-2 s-1) + real(r8) :: totmaxevap ! potential suction from each soil layer (mmol m-2 s-1) + real(r8) :: fleaf ! fraction of leaves in each canopy layer + + ! Model parameters + real(r8) :: head = 0.009807_r8 ! head of pressure (MPa/m) + real(r8) :: rootdens = 0.5e6_r8 ! root density, g biomass m-3 root + real(r8) :: pi = shr_const_pi + real(r8) :: vol_ice ! partial volume of ice lens in layer + real(r8) :: eff_porosity ! effective porosity in layer + real(r8) :: vol_liq ! partial volume of liquid water in layer + real(r8) :: s_node ! vol_liq/eff_porosity + real(r8) :: smp_node ! matrix potential + + ! To be read in from pft file ultimately. + real(r8) :: minlwp = -2.5_r8 ! minimum leaf water potential in MPa + real(r8) :: rootrad = 0.001_r8 ! root radius in metres + + ! Outputs to CLM_SPA + real(r8) :: weighted_SWP ! weighted apparent soil water potential: MPa. + real(r8) :: canopy_soil_resistance(nv) ! Resistance experienced by each canopy layer: MPa s m2 mmol-1 + + ! SPA Pointers from CLM type. + logical, parameter :: SPA_soil=.false. ! Is the BTRAN model SPA or CLM? FIX(SPM,032414) ed - make this a namelist var + + real(r8) :: rresis_ft(numpft_ed,nlevgrnd) ! resistance to water uptake per pft and soil layer. + real(r8) :: pftgs(numpft_ed) ! pft weighted stomatal conductance s/m + real(r8) :: temprootr + !------------------------------------------------------------------------------ + + associate(& + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + + smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm) + smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm) + + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + watdry => soilstate_inst%watdry_col , & ! Input: [real(r8) (:,:) ] btran parameter for btran=0 + watopt => soilstate_inst%watopt_col , & ! Input: [real(r8) (:,:) ] btran parameter for btran = 1 + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + soilbeta => soilstate_inst%soilbeta_col , & ! Input: [real(r8) (:) ] soil wetness relative to field capacity + sand => soilstate_inst%sandfrac_patch , & ! Input: [real(r8) (:) ] % sand of soil + rootr => soilstate_inst%rootr_patch , & ! Output: [real(r8) (:,:) ] Fraction of water uptake in each layer + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + btran => energyflux_inst%btran_patch , & ! Output: [real(r8) (:) ] transpiration wetness factor (0 to 1) + btran2 => energyflux_inst%btran2_patch , & ! Output: [real(r8) (:) ] + rresis => energyflux_inst%rresis_patch & ! Output: [real(r8) (:,:) ] root resistance by layer (0-1) (nlevgrnd) + ) + + if (patch%is_veg(p)) then + + c = patch%column(p) + g = patch%gridcell(p) + + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + do FT = 1,numpft_ed + currentPatch%btran_ft(FT) = 0.0_r8 + do j = 1,nlevgrnd + + !Root resistance factors + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity = watsat(c,j)-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + if (vol_liq <= 0._r8 .or. t_soisno(c,j) <= tfrz-2._r8) then + currentPatch%rootr_ft(FT,j) = 0._r8 + else + s_node = max(vol_liq/eff_porosity,0.01_r8) + smp_node = max(smpsc(FT), -sucsat(c,j)*s_node**(-bsw(c,j))) + !FIX(RF,032414) for junipers + rresis_ft(FT,j) = min( (eff_porosity/watsat(c,j))* & + (smp_node - smpsc(FT)) / (smpso(FT) - smpsc(FT)), 1._r8) + + currentPatch%rootr_ft(FT,j) = currentPatch%rootfr_ft(FT,j)*rresis_FT(FT,j) + ! root water uptake is not linearly proportional to root density, + ! to allow proper deep root funciton. Replace with equations from SPA/Newman. FIX(RF,032414) + ! currentPatch%rootr_ft(FT,j) = currentPatch%rootfr_ft(FT,j)**0.3*rresis_FT(FT,j)/ & + ! sum(currentPatch%rootfr_ft(FT,1:nlevgrnd)**0.3) + currentPatch%btran_ft(FT) = currentPatch%btran_ft(FT) + currentPatch%rootr_ft(FT,j) + end if + end do !j + + btran(p) = currentPatch%btran_ft(1) !FIX(RF,032414) for TRF where is this used? + + ! Normalize root resistances to get layer contribution to ET + do j = 1,nlevgrnd + if (currentPatch%btran_ft(FT) > 0.0_r8) then + currentPatch%rootr_ft(FT,j) = currentPatch%rootr_ft(FT,j)/currentPatch%btran_ft(FT) + else + currentPatch%rootr_ft(FT,j) = 0._r8 + end if + end do + + end do !PFT + + ! PFT-averaged point level root fraction for extraction purposese. + ! This probably needs to be weighted by actual transpiration from each pft. FIX(RF,032414). + pftgs(:) = 0._r8 + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + pftgs(currentCohort%pft) = pftgs(currentCohort%pft) + currentCohort%gscan * currentCohort%n + currentCohort => currentCohort%shorter + enddo + + do j = 1,nlevgrnd + rootr(p,j) = 0._r8 + btran(p) = 0.0_r8 + do FT = 1,numpft_ed + if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail + !bit-retart test as a result? FIX(RF,032414) + rootr(p,j) = rootr(p,j) + currentPatch%rootr_ft(FT,j) * pftgs(ft)/sum(pftgs) + else + rootr(p,j) = rootr(p,j) + currentPatch%rootr_ft(FT,j) * 1./numpft_ed + end if + enddo + enddo + + + !--------------------------------------------------------------------------------------- + ! SPA based recalculation of BTRAN and water uptake. + !--------------------------------------------------------------------------------------- + + if (SPA_soil) then ! normal case don't run this. + rootr(p,:) = 0._r8 + do FT = 1,numpft_ed + + ! Soil Physics + do j = 1,nlevgrnd + ! CLM water retention curve. Clapp and Hornberger equation. + s1 = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + s1 = min(1.0_r8,s1) + smp_node = -sucsat(c,j)*s1**(-bsw(c,j)) + swp_mpa(j) = smp_node *10.0_r8/1000000.0_r8 !convert from mm to Mpa + + ! CLM hydraulic conductivity curve. + ! As opposed to the Richard's equation solution in SoilHydrology.Mod + ! the conductivity here is defined in the middle of the layer in question, not at the edge... + xksat = 0.0070556_r8 * (10._r8**(-0.884_r8+0.0153_r8*sand(p)) ) + hk(j) = xksat*s1**(2._r8*bsw(c,j)+2._r8) !removed the ice from here to avoid 1st ts crashing + enddo + + ! Root resistance + rootxsecarea=3.14159*rootrad**2 + do j = 1,nlevgrnd + rootmass(j) = EDecophyscon%soilbeta(FT) * currentPatch%rootfr_ft(FT,j) + rootlength(j) = rootmass(j)/(rootdens*rootxsecarea) !m m-3 soil + Lsoil(j) = hk(j)/1000/head !converts from mms-1 to ms-1 and then to m2 s-1 MPa-1 + if(Lsoil(j) < 1e-35_r8.or.currentPatch%rootfr_ft(ft,j) <= 0.0_r8)then !prevent floating point error + soilr_z(j) = 1e35_r8 + soilr2(j) = 1e35_r8 + else + ! Soil-to-root water uptake from Newman (1969). + rs = sqrt (1._r8 / (rootlength(j) * pi)) + soilr1(j) = log(rs/rootrad) / (2.0_r8 * pi * rootlength(j) * Lsoil(j) * dz(c,j)) + ! convert from MPa s m2 m-3 to MPa s m2 mmol-1 + soilr1(j) = soilr1(j) * 1E-6_r8 * 18_r8 * 0.001_r8 + ! second component of below ground resistance is related to root hydraulics + soilr2(j) = EDecophyscon%rootresist(FT)/(rootmass(j)*dz(c,j)) + soilr_z(j) = soilr1(j)+soilr2(j) + end if + enddo + + ! Aggregate soil layers + totestevap=0._r8 + weighted_SWP=0._r8 + estevap=0._r8 + fraction_uptake=0._r8 + canopy_soil_resistance=0._r8 !Reset Counters + totmaxevap = 0._r8 + + ! Estimated max transpiration from LWP gradient / soil resistance + do j = 1,nlevgrnd + estevap(j) = (swp_mpa(j) - minlwp)/(soilr_z(j)) + estevap(j) = max(0._r8,estevap(j)) ! no negative uptake + maxevap(j) = (0.0_r8 - minlwp)/(soilr2(j)) + enddo + totestevap = sum(estevap) + totmaxevap = sum(maxevap) + + ! Weighted soil water potential + do j = 1,nlevgrnd + if(totestevap > 0._r8)then + fraction_uptake(j) = estevap(j)/totestevap !Fraction of total ET taken from this soil layer + else + estevap(j) = 0._r8 + fraction_uptake(j)=1._r8/nlevgrnd + end if + weighted_SWP = weighted_SWP + swp_mpa(j) * estevap(j) + enddo + + + if(totestevap > 0._r8)then + weighted_swp = weighted_swp/totestevap + ! weight SWP for the total evaporation + else + write(iulog,*) 'empty soil', totestevap + ! error check + weighted_swp = minlwp + end if + + ! Weighted soil-root resistance. Aggregate the conductances (1/soilR) for each soil layer + do iv = 1,nv !leaf layers + fleaf = 1.0_r8/nv + do j = 1,nlevgrnd !root layers + ! Soil resistance for each canopy layer is related to leaf area + ! The conductance of the root system to the + ! whole canopy is reduced by the fraction of leaves in this layer... + canopy_soil_resistance(iv) = canopy_soil_resistance(iv)+fleaf * 1.0_r8/(soilr_z(j)) + enddo + ! Turn aggregated conductance back into resistance. mmol MPa-1 s-1 m-2 to MPa s m2 mmol-1 + canopy_soil_resistance(iv) = 1./canopy_soil_resistance(iv) + enddo + + currentPatch%btran_ft(FT) = totestevap/totmaxevap + do j = 1,nlevgrnd + if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail + !bit-retart test as a result? FIX(RF,032414) + rootr(p,j) = rootr(p,j) + fraction_uptake(j) * pftgs(ft)/sum(pftgs) + else + rootr(p,j) = rootr(p,j) + fraction_uptake(j) * 1./numpft_ed + end if + enddo + + enddo !pft loop + + end if ! + !--------------------------------------------------------------------------------------- + ! end of SPA based recalculation of BTRAN and water uptake. + !--------------------------------------------------------------------------------------- + + !weight patch level output BTRAN for the + btran(p) = 0.0_r8 + do FT = 1,numpft_ed + if(sum(pftgs) > 0._r8)then !prevent problem with the first timestep - might fail + !bit-retart test as a result? FIX(RF,032414) + btran(p) = btran(p) + currentPatch%btran_ft(FT) * pftgs(ft)/sum(pftgs) + else + btran(p) = btran(p) + currentPatch%btran_ft(FT) * 1./numpft_ed + end if + enddo + + temprootr = sum(rootr(p,:)) + if(temprootr /= 1.0_r8)then + !write(iulog,*) 'error with rootr in canopy fluxes',sum(rootr(p,:)) + if(temprootr > 0._r8)then + do j = 1,nlevgrnd + rootr(p,j) = rootr(p,j) / temprootr + enddo + end if + end if + + else ! edpatch + currentPatch%btran_ft(1:numpft_ed) = 1._r8 + end if ! edpatch + + end associate + + end subroutine btran_ed + +end module EDBtranMod diff --git a/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 new file mode 100644 index 0000000000..889c905412 --- /dev/null +++ b/components/clm/src/ED/biogeophys/EDPhotosynthesisMod.F90 @@ -0,0 +1,972 @@ +module EDPhotosynthesisMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculates the photosynthetic fluxes for the ED model + ! This code is equivalent to the 'photosynthesis' subroutine in PhotosynthesisMod.F90. + ! We have split this out to reduce merge conflicts until we can pull out + ! common code used in both the ED and CLM versions. + ! + ! !USES: + ! + implicit none + private + ! + ! PUBLIC MEMBER FUNCTIONS: + public :: Photosynthesis_ED !ED specific photosynthesis routine + !------------------------------------------------------------------------------ + +contains + + !--------------------------------------------------------- + subroutine Photosynthesis_ED (bounds, fn, filterp, esat_tv, eair, oair, cair, & + rb, dayl_factor, ed_allsites_inst, & + atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst) + ! + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_time_manager , only : get_step_size + use clm_varcon , only : rgas, tfrz, namep + use clm_varpar , only : nlevcan_ed, nclmax, nlevsoi, mxpft + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use perf_mod , only : t_startf, t_stopf + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use TemperatureType , only : temperature_type + use PatchType , only : patch + use quadraticMod , only : quadratic + use EDParamsMod , only : ED_val_grperc + use EDSharedParamsMod , only : EDParamsShareInst + use EDTypesMod , only : numpft_ed, dinc_ed + use EDtypesMod , only : ed_patch_type, ed_cohort_type, ed_site_type, numpft_ed, map_clmpatch_to_edpatch + use EDEcophysContype , only : EDecophyscon + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + real(r8) , intent(in) :: esat_tv(bounds%begp: ) ! saturation vapor pressure at t_veg (Pa) + real(r8) , intent(in) :: eair( bounds%begp: ) ! vapor pressure of canopy air (Pa) + real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) + real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) + real(r8) , intent(inout) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) + real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + ! !CALLED FROM: + ! subroutine CanopyFluxes + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + ! + integer , parameter :: psn_type = 2 !c3 or c4. + ! + ! Leaf photosynthesis parameters + real(r8) :: vcmax_z(nclmax,mxpft,nlevcan_ed) ! maximum rate of carboxylation (umol co2/m**2/s) + real(r8) :: jmax_z(nclmax,mxpft,nlevcan_ed) ! maximum electron transport rate (umol electrons/m**2/s) + real(r8) :: tpu_z(nclmax,mxpft,nlevcan_ed) ! triose phosphate utilization rate (umol CO2/m**2/s) + real(r8) :: kp_z(nclmax,mxpft,nlevcan_ed) ! initial slope of CO2 response curve (C4 plants) + real(r8) :: lmr_z(nclmax,mxpft,nlevcan_ed) ! initial slope of CO2 response curve (C4 plants) + real(r8) :: rs_z(nclmax,mxpft,nlevcan_ed) ! stomatal resistance s/m + real(r8) :: gs_z(nclmax,mxpft,nlevcan_ed) ! stomatal conductance m/s + + real(r8) :: ci(nclmax,mxpft,nlevcan_ed) ! intracellular leaf CO2 (Pa) + real(r8) :: lnc(mxpft) ! leaf N concentration (gN leaf/m^2) + real(r8) :: kc( bounds%begp:bounds%endp ) ! Michaelis-Menten constant for CO2 (Pa) + real(r8) :: ko( bounds%begp:bounds%endp ) ! Michaelis-Menten constant for O2 (Pa) + real(r8) :: co2_cp( bounds%begp:bounds%endp ) ! CO2 compensation point (Pa) + real(r8) :: bbbopt(psn_type) ! Ball-Berry minimum leaf conductance, unstressed (umol H2O/m**2/s) + real(r8) :: bbb(mxpft) ! Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8) :: mbbopt(psn_type) ! Ball-Berry slope of conductance-photosynthesis relationship, unstressed + real(r8) :: mbb(mxpft) ! Ball-Berry slope of conductance-photosynthesis relationship + + real(r8) :: kn(mxpft) ! leaf nitrogen decay coefficient + real(r8) :: vcmax25top(mxpft) ! canopy top: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25top(mxpft) ! canopy top: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25top(mxpft) ! canopy top: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25top(mxpft) ! canopy top: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25top(mxpft) ! canopy top: initial slope of CO2 response curve (C4 plants) at 25C + + real(r8) :: vcmax25 ! leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25 ! leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25 ! leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25 ! leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25 ! leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C + real(r8) :: kc25 ! Michaelis-Menten constant for CO2 at 25C (Pa) + real(r8) :: ko25 ! Michaelis-Menten constant for O2 at 25C (Pa) + real(r8) :: cp25 ! CO2 compensation point at 25C (Pa) + + real(r8) :: vcmaxha ! activation energy for vcmax (J/mol) + real(r8) :: jmaxha ! activation energy for jmax (J/mol) + real(r8) :: tpuha ! activation energy for tpu (J/mol) + real(r8) :: lmrha ! activation energy for lmr (J/mol) + real(r8) :: kcha ! activation energy for kc (J/mol) + real(r8) :: koha ! activation energy for ko (J/mol) + real(r8) :: cpha ! activation energy for cp (J/mol) + + real(r8) :: vcmaxhd ! deactivation energy for vcmax (J/mol) + real(r8) :: jmaxhd ! deactivation energy for jmax (J/mol) + real(r8) :: tpuhd ! deactivation energy for tpu (J/mol) + real(r8) :: lmrhd ! deactivation energy for lmr (J/mol) + + real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) + real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) + real(r8) :: tpuse ! entropy term for tpu (J/mol/K) + real(r8) :: lmrse ! entropy term for lmr (J/mol/K) + + real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: lmrc ! scaling factor for high temperature inhibition (25 C = 1.0) + + real(r8) :: qe(psn_type) ! quantum efficiency, used only for C4 (mol CO2 / mol photons) + real(r8) :: fnps ! fraction of light absorbed by non-photosynthetic pigments + real(r8) :: theta_psii ! empirical curvature parameter for electron transport rate + + real(r8) :: theta_cj(psn_type) ! empirical curvature parameter for ac, aj photosynthesis co-limitation + real(r8) :: theta_ip ! empirical curvature parameter for ap photosynthesis co-limitation + + ! Other + integer :: c,CL,f,g,iv,j,p,ps,ft ! indices + integer :: NCL_p ! number of canopy layers in patch + real(r8) :: cf ! s m**2/umol -> s/m + real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) + real(r8) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) + real(r8) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + real(r8) :: gs ! leaf stomatal conductance (m/s) + real(r8) :: hs ! fractional humidity at leaf surface (dimensionless) + real(r8) :: sco ! relative specificity of rubisco + real(r8) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8) :: ha ! activation energy in photosynthesis temperature function (J/mol) + real(r8) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8) :: cc2 ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: ciold ! previous value of Ci for convergence check + real(r8) :: gs_mol_err ! gs_mol for error check + real(r8) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) + real(r8) :: aquad,bquad,cquad ! terms for quadratic equations + real(r8) :: r1,r2 ! roots of quadratic equation + real(r8) :: ceair ! vapor pressure of air, constrained (Pa) + real(r8) :: act25 ! (umol/mgRubisco/min) Rubisco activity at 25 C + integer :: niter ! iteration loop index + real(r8) :: nscaler ! leaf nitrogen scaling coefficient + real(r8) :: leaf_frac ! ratio of to leaf biomass to total alive biomass + + real(r8) :: ac ! Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8) :: aj ! RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8) :: ap ! product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8) :: ag(nclmax,mxpft,nlevcan_ed) ! co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8) :: an(nclmax,mxpft,nlevcan_ed) ! net leaf photosynthesis (umol CO2/m**2/s) + real(r8) :: an_av(nclmax,mxpft,nlevcan_ed) ! net leaf photosynthesis (umol CO2/m**2/s) averaged over sun and shade leaves. + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + + real(r8) :: laican ! canopy sum of lai_z + real(r8) :: vai ! leaf and steam area in ths layer. + integer :: exitloop + real(r8) :: laifrac + real(r8) :: tcsoi ! Temperature response function for root respiration. + real(r8) :: tc ! Temperature response function for wood + + real(r8) :: br ! Base rate of root respiration. (gC/gN/s) + real(r8) :: q10 ! temperature dependence of root respiration + integer :: sunsha ! sun (1) or shaded (2) leaves... + real(r8) :: dr(2) + real(r8) :: coarse_wood_frac ! amount of woody biomass that is coarse... + real(r8) :: tree_area + real(r8) :: gs_cohort + + ! FIX(SPM, 040714) [I]- these should be proper functions... + real(r8) :: ft1 ! photosynthesis temperature response (statement function) + real(r8) :: fth ! photosynthesis temperature inhibition (statement function) + real(r8) :: fth25 ! scaling factor for photosynthesis temperature inhibition (statement function) + ! ... get rid of function statements [I] + + real(r8) dtime ! stepsize in seconds + !------------------------------------------------------------------------------ + + ! + ! FIX(SPM, 040714) [I]- these should be proper functions...Jinyun might be doing this in his refactor...check. + ! + ! Temperature and soil water response functions + ft1(tl,ha) = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + fth(tl,hd,se,cc2) = cc2 / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + fth25(hd,se) = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + ! ... get rid of function statements [I] + + associate( & + c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 + slatop => pftcon%slatop , & ! specific leaf area at top of canopy, projected area basis [m^2/gC] + flnr => pftcon%flnr , & ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + woody => pftcon%woody , & ! Is vegetation woody or not? + fnitr => pftcon%fnitr , & ! foliage nitrogen limitation factor (-) + leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) + + bb_slope => EDecophyscon%BB_slope , & ! slope of BB relationship + + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + + psncanopy => photosyns_inst%psncanopy_patch , & ! Output: [real(r8) (:,:) ] canopy scale photosynthesis umol CO2 /m**2/ s + lmrcanopy => photosyns_inst%lmrcanopy_patch , & ! Output: [real(r8) (:,:) ] canopy scale leaf maintenance respiration umol CO2 /m**2/ s + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index + rscanopy => canopystate_inst%rscanopy_patch , & ! Output: [real(r8) (:,:) ] canopy resistance s/m + gccanopy => canopystate_inst%gccanopy_patch & ! Output: [real(r8) (:,:) ] canopy conductance mmol m-2 s-1 + ) + + !set timestep + dtime = get_step_size() + + ! Assign local pointers to derived type members (gridcell-level) + dr(1) = 0.025_r8; dr(2) = 0.015_r8 + + ! Peter Thornton: 3/13/09 + ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning + ! to improve seasonal cycle of atmospheric CO2 concentration in global + ! simulatoins + q10 = 1.5_r8 + Q10 = EDParamsShareInst%Q10 + + !==============================================================================! + ! Photosynthesis and stomatal conductance parameters, from: + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + !==============================================================================! + + ! vcmax25 parameters, from CN + + act25 = 3.6_r8 !umol/mgRubisco/min + ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s + act25 = act25 * 1000.0_r8 / 60.0_r8 + + ! Activation energy, from: + ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 + ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 + + kcha = 79430._r8 + koha = 36380._r8 + cpha = 37830._r8 + vcmaxha = 65330._r8 + jmaxha = 43540._r8 + tpuha = 53100._r8 + lmrha = 46390._r8 + + ! High temperature deactivation, from: + ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 + ! The factor "c" scales the deactivation to a value of 1.0 at 25C + + vcmaxhd = 149250._r8 + jmaxhd = 152040._r8 + tpuhd = 150650._r8 + lmrhd = 150650._r8 + + vcmaxse = 485._r8 + jmaxse = 495._r8 + tpuse = 490._r8 + lmrse = 490._r8 + + vcmaxc = fth25(vcmaxhd, vcmaxse) + jmaxc = fth25(jmaxhd, jmaxse) + tpuc = fth25(tpuhd, tpuse) + lmrc = fth25(lmrhd, lmrse) + + ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + + fnps = 0.15_r8 + theta_psii = 0.7_r8 + theta_ip = 0.95_r8 + + qe(1) = 0._r8 + theta_cj(1) = 0.98_r8 + bbbopt(1) = 10000._r8 + mbbopt(1) = 9._r8 + + qe(2) = 0.05_r8 + theta_cj(2) = 0.80_r8 + bbbopt(2) = 40000._r8 + mbbopt(2) = 4._r8 + + do f = 1,fn + p = filterp(f) + call t_startf('edfluxes') + + ! NOTE: THESE ARE ZEROED EVEN IF THERE'S NO PATCH! + + psncanopy(p) = 0._r8 + lmrcanopy(p) = 0._r8 + rscanopy(p) = 0._r8 + gccanopy(p) = 0._r8 + + if (patch%is_veg(p)) then + g = patch%gridcell(p) + c = patch%column(p) + + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + + currentPatch%ncan(:,:) = 0 + !redo the canopy structure algorithm to get round a bug that is happening for site 125, FT13. + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + + currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft) = & + max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV) + + currentCohort => currentCohort%shorter + + enddo !cohort + + currentPatch%nrad = currentPatch%ncan + do CL = 1,nclmax + do ft = 1,numpft_ed + currentPatch%present(CL,ft) = 0 + do iv = 1, currentPatch%nrad(CL,ft); + if(currentPatch%canopy_area_profile(CL,ft,iv) > 0._r8)then + currentPatch%present(CL,ft) = 1 + end if + end do !iv + enddo !ft + enddo !CL + + ! Soil water stress applied to Ball-Berry parameters + do FT = 1,numpft_ed + if (nint(c3psn(FT)) == 1)then + ps = 1 + else + ps = 2 + end if + bbb(FT) = max (bbbopt(ps)*currentPatch%btran_ft(FT), 1._r8) + + mbb(FT) = bb_slope(ft) ! mbbopt(ps) + end do + + ! kc, ko, currentPatch, from: Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! + ! kc25 = 404.9 umol/mol + ! ko25 = 278.4 mmol/mol + ! cp25 = 42.75 umol/mol + ! + ! Derive sco from currentPatch and O2 using present-day O2 (0.209 mol/mol) and re-calculate + ! currentPatch to account for variation in O2 using currentPatch = 0.5 O2 / sco + ! + + kc25 = (404.9_r8 / 1.e06_r8) * forc_pbot(c) + ko25 = (278.4_r8 / 1.e03_r8) * forc_pbot(c) + sco = 0.5_r8 * 0.209_r8 / (42.75_r8 / 1.e06_r8) + cp25 = 0.5_r8 * oair(p) / sco + + if(t_veg(p).gt.150_r8.and.t_veg(p).lt.350_r8)then + kc(p) = kc25 * ft1(t_veg(p), kcha) + ko(p) = ko25 * ft1(t_veg(p), koha) + co2_cp(p) = cp25 * ft1(t_veg(p), cpha) + else + kc(p) = 1 + ko(p) = 1 + co2_cp(p) = 1 + write(iulog,*) 'something wrong with temperature',t_veg(p),p,elai(p),tlai(p) + end if + + end if + end do + + ! Multi-layer parameters scaled by leaf nitrogen profile. + ! Loop through each canopy layer to calculate nitrogen profile using + ! cumulative lai at the midpoint of the layer + + + do f = 1,fn + p = filterp(f) + c = patch%column(p) + + if (patch%is_veg(p)) then + g = patch%gridcell(p) + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + + do FT = 1,numpft_ed + if (nint(c3psn(FT)) == 1)then + ps = 1 + else + ps = 2 + end if + bbb(FT) = max (bbbopt(ps)*currentPatch%btran_ft(FT), 1._r8) + mbb(FT) = mbbopt(ps) + + if (nint(c3psn(FT)) == 1)then + ci(:,FT,:) = 0.7_r8 * cair(p) + else + ci(:,FT,:) = 0.4_r8 * cair(p) + end if + enddo + + NCL_p = currentPatch%NCL_p + + do FT = 1,numpft_ed !calculate patch and pft specific propserties at canopy top. + + ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) + lnc(FT) = 1._r8 / (slatop(FT) * leafcn(FT)) + + !at the moment in ED we assume that there is no active N cycle. This should change, of course. FIX(RF,032414) Sep2011. + vcmax25top(FT) = fnitr(FT) !fudge - shortcut using fnitr as a proxy for vcmax... + + ! Parameters derived from vcmax25top. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of Experimental Botany 44:907-920. + ! Here use a factor "1.67", from Medlyn et al (2002) Plant, Cell and Environment 25:1167-1179 + + !RF - copied this from the CLM trunk code, but where did it come from, and how can we make these consistant? + !jmax25top(FT) = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top(FT) + jmax25top(FT) = 0.167_r8 * vcmax25top(FT) + tpu25top(FT) = 0.167_r8 * vcmax25top(FT) + kp25top(FT) = 20000._r8 * vcmax25top(FT) + + + + ! Nitrogen scaling factor. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used + ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al (2010) Biogeosciences, 7, 1833-1859 + ! Remove daylength factor from vcmax25 so that kn is based on maximum vcmax25 + + if (dayl_factor(p) == 0._r8) then + kn(FT) = 0._r8 + else + kn(FT) = exp(0.00963_r8 * vcmax25top(FT) - 2.43_r8) + end if + + ! Leaf maintenance respiration to match the base rate used in CN + ! but with the new temperature functions for C3 and C4 plants. + ! + ! Base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! + ! CN respiration has units: g C / g N [leaf] / s. This needs to be + ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s + ! + ! Then scale this value at the top of the canopy for canopy depth + + lmr25top(FT) = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) + lmr25top(FT) = lmr25top(FT) * lnc(FT) / 12.e-06_r8 + + end do !FT + + !==============================================================================! + ! Calculate Nitrogen scaling factors and photosynthetic parameters. + !==============================================================================! + do CL = 1, NCL_p + do FT = 1,numpft_ed + + do iv = 1, currentPatch%nrad(CL,FT) + if(currentPatch%canopy_area_profile(CL,FT,iv)>0._r8.and.currentPatch%present(CL,FT) /= 1)then + write(iulog,*) 'CF: issue with present structure',CL,FT,iv, & + currentPatch%canopy_area_profile(CL,FT,iv),currentPatch%present(CL,FT), & + currentPatch%nrad(CL,FT),currentPatch%ncl_p,nclmax + currentPatch%present(CL,FT) = 1 + end if + enddo + + if(currentPatch%present(CL,FT) == 1)then ! are there any leaves of this pft in this layer? + + if(CL==NCL_p)then !are we in the top canopy layer or a shaded layer? + laican = 0._r8 + else + laican = sum(currentPatch%canopy_layer_lai(CL+1:NCL_p)) + end if + + ! Loop through canopy layers (above snow). Respiration needs to be + ! calculated every timestep. Others are calculated only if daytime + do iv = 1, currentPatch%nrad(CL,FT) + vai = (currentPatch%elai_profile(CL,FT,iv)+currentPatch%esai_profile(CL,FT,iv)) !vegetation area index. + if (iv == 1) then + laican = laican + 0.5_r8 * vai + else + laican = laican + 0.5_r8 * (currentPatch%elai_profile(CL,FT,iv-1)+ & + currentPatch%esai_profile(CL,FT,iv-1))+vai + end if + + ! Scale for leaf nitrogen profile + nscaler = exp(-kn(FT) * laican) + + + ! Maintenance respiration: umol CO2 / m**2 [leaf] / s + lmr25 = lmr25top(FT) * nscaler + + if (nint(c3psn(FT)) == 1)then + lmr_z(CL,FT,iv) = lmr25 * ft1(t_veg(p), lmrha) * fth(t_veg(p), lmrhd, lmrse, lmrc) + else + lmr_z(CL,FT,iv) = lmr25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + lmr_z(CL,FT,iv) = lmr_z(CL,FT,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) + end if + + + if (currentPatch%ed_parsun_z(CL,FT,iv) <= 0._r8) then ! night time + vcmax_z(CL,FT,iv) = 0._r8 + jmax_z(CL,FT,iv) = 0._r8 + tpu_z(CL,FT,iv) = 0._r8 + kp_z(CL,FT,iv) = 0._r8 + else ! day time + vcmax25 = vcmax25top(FT) * nscaler + jmax25 = jmax25top(FT) * nscaler + tpu25 = tpu25top(FT) * nscaler + kp25 = kp25top(FT) * nscaler + + ! Adjust for temperature + vcmax_z(CL,FT,iv) = vcmax25 * ft1(t_veg(p), vcmaxha) * fth(t_veg(p), vcmaxhd, vcmaxse, vcmaxc) + jmax_z(CL,FT,iv) = jmax25 * ft1(t_veg(p), jmaxha) * fth(t_veg(p), jmaxhd, jmaxse, jmaxc) + tpu_z(CL,FT,iv) = tpu25 * ft1(t_veg(p), tpuha) * fth(t_veg(p), tpuhd, tpuse, tpuc) + + if (nint(c3psn(FT)) /= 1) then + vcmax_z(CL,FT,iv) = vcmax25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + vcmax_z(CL,FT,iv) = vcmax_z(CL,FT,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) + vcmax_z(CL,FT,iv) = vcmax_z(CL,FT,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) + end if + kp_z(CL,FT,iv) = kp25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) !q10 response of product limited psn. + end if + ! Adjust for soil water:(umol co2/m**2/s) + + vcmax_z(CL,FT,iv) = vcmax_z(CL,FT,iv) * currentPatch%btran_ft(FT) + ! completely removed respiration drought response + ! - (lmr_z(CL,FT,iv) * (1.0_r8-currentPatch%btran_ft(FT)) *pftcon%resp_drought_response(FT)) + lmr_z(CL,FT,iv) = lmr_z(CL,FT,iv) + + end do ! iv + end if !present + enddo !PFT + enddo !CL + + !==============================================================================! + ! Leaf-level photosynthesis and stomatal conductance + !==============================================================================! + + rsmax0 = 2.e4_r8 + + ! Leaf boundary layer conductance, umol/m**2/s + + cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e06_r8 + gb = 1._r8/rb(p) + gb_mol = gb * cf + ! Constrain eair >= 0.05*esat_tv so that solution does not blow up. This ensures + ! that hs does not go to zero. Also eair <= esat_tv so that hs <= 1 + + ceair = min( max(eair(p), 0.05_r8*esat_tv(p)), esat_tv(p) ) + ! Loop through canopy layers (above snow). Only do calculations if daytime + do CL = 1, NCL_p + do FT = 1,numpft_ed + if (nint(c3psn(FT)) == 1)then + ps = 1 + else + ps = 2 + end if + if(currentPatch%present(CL,FT) == 1)then ! are there any leaves of this pft in this layer? + do iv = 1, currentPatch%nrad(CL,FT) + if (currentPatch%ed_parsun_z(CL,FT,iv) <= 0._r8) then ! night time + ac = 0._r8 + aj = 0._r8 + ap = 0._r8 + ag(CL,FT,iv) = 0._r8 + an(CL,FT,iv) = ag(CL,FT,iv) - lmr_z(CL,FT,iv) + an_av(cl,ft,iv) = 0._r8 + currentPatch%psn_z(cl,ft,iv) = 0._r8 + rs_z(CL,FT,iv) = min(rsmax0, 1._r8/bbb(FT) * cf) + + + else ! day time + !is there leaf area? - (NV can be larger than 0 with only stem area if deciduous) + if(currentPatch%ed_laisun_z(CL,ft,iv)+currentPatch%ed_laisha_z(cl,ft,iv) > 0._r8)then + !Loop aroun shaded and unshaded leaves + currentPatch%psn_z(CL,ft,iv) = 0._r8 ! psn is accumulated across sun and shaded leaves. + rs_z(CL,FT,iv) = 0._r8 ! 1/rs is accumulated across sun and shaded leaves. + gs_z(CL,FT,iv) = 0._r8 + an_av(CL,FT,iv) = 0._r8 + do sunsha = 1,2 + ! Electron transport rate for C3 plants. Convert par from W/m2 to umol photons/m**2/s + ! using the factor 4.6 + ! Convert from units of par absorbed per unit ground area to par absorbed per unit leaf area. + + if(sunsha == 1)then !sunlit + if((currentPatch%ed_laisun_z(CL,FT,iv) * currentPatch%canopy_area_profile(CL,FT,iv)) > & + 0.0000000001_r8)then + + qabs = currentPatch%ed_parsun_z(CL,FT,iv) / (currentPatch%ed_laisun_z(CL,FT,iv) * & + currentPatch%canopy_area_profile(CL,FT,iv)) + qabs = qabs * 0.5_r8 * (1._r8 - fnps) * 4.6_r8 + + else + qabs = 0.0_r8 + end if + else + + qabs = currentPatch%ed_parsha_z(CL,FT,iv) / (currentPatch%ed_laisha_z(CL,FT,iv) * & + currentPatch%canopy_area_profile(CL,FT,iv)) + qabs = qabs * 0.5_r8 * (1._r8 - fnps) * 4.6_r8 + + end if + + !convert the absorbed par into absorbed par per m2 of leaf, + ! so it is consistant with the vcmax and lmr numbers. + aquad = theta_psii + bquad = -(qabs + jmax_z(cl,ft,iv)) + cquad = qabs * jmax_z(cl,ft,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + je = min(r1,r2) + + ! Iterative loop for ci beginning with initial guess + if (nint(c3psn(FT)) == 1)then + ci(cl,ft,iv) = 0.7_r8 * cair(p) + else + ci(cl,ft,iv) = 0.4_r8 * cair(p) + end if + + niter = 0 + exitloop = 0 + do while(exitloop == 0) + ! Increment iteration counter. Stop if too many iterations + niter = niter + 1 + + ! Save old ci + ciold = ci(cl,ft,iv) + + ! Photosynthesis limitation rate calculations + if (nint(c3psn(FT)) == 1)then + ! C3: Rubisco-limited photosynthesis + ac = vcmax_z(cl,ft,iv) * max(ci(cl,ft,iv)-co2_cp(p), 0._r8) / (ci(cl,ft,iv)+kc(p)* & + (1._r8+oair(p)/ko(p))) + ! C3: RuBP-limited photosynthesis + aj = je * max(ci(cl,ft,iv)-co2_cp(p), 0._r8) / (4._r8*ci(cl,ft,iv)+8._r8*co2_cp(p)) + ! C3: Product-limited photosynthesis + ap = 3._r8 * tpu_z(cl,ft,iv) + else + ! C4: Rubisco-limited photosynthesis + ac = vcmax_z(cl,ft,iv) + ! C4: RuBP-limited photosynthesis + if(sunsha == 1)then !sunlit + if((currentPatch%ed_laisun_z(cl,ft,iv) * currentPatch%canopy_area_profile(cl,ft,iv)) > & + 0.0000000001_r8)then !guard against /0's in the night. + aj = qe(ps) * currentPatch%ed_parsun_z(cl,ft,iv) * 4.6_r8 + !convert from per cohort to per m2 of leaf) + aj = aj / (currentPatch%ed_laisun_z(cl,ft,iv) * & + currentPatch%canopy_area_profile(cl,ft,iv)) + else + aj = 0._r8 + end if + else + aj = qe(ps) * currentPatch%ed_parsha_z(cl,ft,iv) * 4.6_r8 + aj = aj / (currentPatch%ed_laisha_z(cl,ft,iv) * & + currentPatch%canopy_area_profile(cl,ft,iv)) + end if + + ! C4: PEP carboxylase-limited (CO2-limited) + ap = kp_z(cl,ft,iv) * max(ci(cl,ft,iv), 0._r8) / forc_pbot(c) + end if + ! Gross photosynthesis smoothing calculations. First co-limit ac and aj. Then co-limit ap + aquad = theta_cj(ps) + bquad = -(ac + aj) + cquad = ac * aj + call quadratic (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = theta_ip + bquad = -(ai + ap) + cquad = ai * ap + call quadratic (aquad, bquad, cquad, r1, r2) + ag(cl,ft,iv) = min(r1,r2) + + ! Net carbon assimilation. Exit iteration if an < 0 + an(cl,ft,iv) = ag(cl,ft,iv) - lmr_z(cl,ft,iv) + if (an(cl,ft,iv) < 0._r8) then + exitloop = 1 + end if + + ! Quadratic gs_mol calculation with an known. Valid for an >= 0. + ! With an <= 0, then gs_mol = bbb + + cs = cair(p) - 1.4_r8/gb_mol * an(cl,ft,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + aquad = cs + bquad = cs*(gb_mol - bbb(FT)) - mbb(FT)*an(cl,ft,iv)*forc_pbot(c) + cquad = -gb_mol*(cs*bbb(FT) + mbb(FT)*an(cl,ft,iv)*forc_pbot(c)*ceair/esat_tv(p)) + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol = max(r1,r2) + + ! Derive new estimate for ci + ci(cl,ft,iv) = cair(p) - an(cl,ft,iv) * forc_pbot(c) * & + (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) + + ! Check for ci convergence. Delta ci/pair = mol/mol. Multiply by 10**6 to + ! convert to umol/mol (ppm). Exit iteration if convergence criteria of +/- 1 x 10**-6 ppm + ! is met OR if at least ten iterations (niter=10) are completed + + if ((abs(ci(cl,ft,iv)-ciold)/forc_pbot(c)*1.e06_r8 <= 2.e-06_r8) .or. niter == 5) then + exitloop = 1 + end if + end do !iteration loop + + ! End of ci iteration. Check for an < 0, in which case gs_mol = bbb + if (an(cl,ft,iv) < 0._r8) then + gs_mol = bbb(FT) + end if + + ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) + cs = cair(p) - 1.4_r8/gb_mol * an(cl,ft,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + ci(cl,ft,iv) = cair(p) - an(cl,ft,iv) * forc_pbot(c) * (1.4_r8*gs_mol+1.6_r8*gb_mol) / & + (gb_mol*gs_mol) + ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) + gs = gs_mol / cf + + !accumulate total photosynthesis umol/m2 ground/s-1. weight per unit sun and sha leaves. + if(sunsha == 1)then !sunlit + + currentPatch%psn_z(cl,ft,iv) = currentPatch%psn_z(cl,ft,iv) + ag(cl,ft,iv) * & + currentPatch%f_sun(cl,ft,iv) + an_av(cl,ft,iv) = an_av(cl,ft,iv) + an(cl,ft,iv) * & + currentPatch%f_sun(cl,ft,iv) + gs_z(cl,ft,iv) = gs_z(cl,ft,iv) + 1._r8/(min(1._r8/gs, rsmax0)) * & + currentPatch%f_sun(cl,ft,iv) + + else + + currentPatch%psn_z(cl,ft,iv) = currentPatch%psn_z(cl,ft,iv) + ag(cl,ft,iv) & + * (1.0_r8-currentPatch%f_sun(cl,ft,iv)) + an_av(cl,ft,iv) = an_av(cl,ft,iv) + an(cl,ft,iv) & + * (1.0_r8-currentPatch%f_sun(cl,ft,iv)) + gs_z(cl,ft,iv) = gs_z(cl,ft,iv) + & + 1._r8/(min(1._r8/gs, rsmax0)) * (1.0_r8-currentPatch%f_sun(cl,ft,iv)) + + end if + + ! Make sure iterative solution is correct + if (gs_mol < 0._r8) then + write (iulog,*)'Negative stomatal conductance:' + write (iulog,*)'p,iv,gs_mol= ',p,iv,gs_mol + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + + ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b + hs = (gb_mol*ceair + gs_mol*esat_tv(p)) / ((gb_mol+gs_mol)*esat_tv(p)) + gs_mol_err = mbb(FT)*max(an(cl,ft,iv), 0._r8)*hs/cs*forc_pbot(c) + bbb(FT) + + if (abs(gs_mol-gs_mol_err) > 1.e-01_r8) then + write (iulog,*) 'CF: Ball-Berry error check - stomatal conductance error:' + write (iulog,*) gs_mol, gs_mol_err + end if + + enddo !sunsha loop + !average leaf-level stomatal resistance rate over sun and shade leaves... + rs_z(cl,ft,iv) = 1._r8/gs_z(cl,ft,iv) + end if !is there leaf area? + end if ! night or day + end do ! iv canopy layer + end if ! present(L,ft) ? rd_array + end do ! PFT loop + end do !canopy layer + + call t_stopf('edfluxes') + call t_startf('edunpack') + + !==============================================================================! + ! Unpack fluxes from arrays into cohorts + !==============================================================================! + + call currentPatch%set_root_fraction() + + if(currentPatch%countcohorts > 0.0)then !avoid errors caused by empty patches + + currentCohort => currentPatch%tallest ! Cohort loop + + do while (associated(currentCohort)) ! Cohort loop + call t_startf('edfluxunpack1') + if(currentCohort%n > 0._r8)then + ! Zero cohort flux accumulators. + currentCohort%npp_clm = 0._r8 + currentCohort%resp_clm = 0._r8 + + ! Select canopy layer and PFT. + FT = currentCohort%pft !are we going to have ftindex? + CL = currentCohort%canopy_layer + !------------------------------------------------------------------------------ + ! Accumulate fluxes over the sub-canopy layers of each cohort. + !------------------------------------------------------------------------------ + ! Convert from umolC/m2leaf/s to umolC/indiv/s ( x canopy area x 1m2 leaf area). + tree_area = currentCohort%c_area/currentCohort%n + if(currentCohort%nv > 1)then + + currentCohort%gpp_clm = sum(currentPatch%psn_z(cl,ft,1:currentCohort%nv-1) * & + currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area + currentCohort%rd = sum(lmr_z(cl,ft,1:currentCohort%nv-1) * & + currentPatch%elai_profile(cl,ft,1:currentCohort%nv-1)) * tree_area + + currentCohort%gscan = sum((1.0_r8/(rs_z(cl,ft,1:currentCohort%nv-1)+rb(p)))) * tree_area + currentCohort%ts_net_uptake(1:currentCohort%nv) = an_av(cl,ft,1:currentCohort%nv) * 12E-9 * dtime + + else + + currentCohort%gpp_clm = 0.0_r8 + currentCohort%rd = 0._r8 + currentCohort%gscan = 0._r8 + currentCohort%ts_net_uptake(:) = 0._r8 + + end if + + laifrac = (currentCohort%treelai+currentCohort%treesai)-(currentCohort%nv-1)*dinc_ed + + gs_cohort = 1.0_r8/(rs_z(cl,ft,currentCohort%nv)+rb(p))*laifrac*tree_area + currentCohort%gscan = currentCohort%gscan+gs_cohort + + currentCohort%gpp_clm = currentCohort%gpp_clm + currentPatch%psn_z(cl,ft,currentCohort%nv) * & + currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area + currentCohort%rd = currentCohort%rd + lmr_z(cl,ft,currentCohort%nv) * & + currentPatch%elai_profile(cl,ft,currentCohort%nv) * laifrac * tree_area + + call t_stopf('edfluxunpack1') + call t_startf('edfluxunpack2') + + !------------------------------------------------------------------------------ + ! Calculate Whole Plant Respiration (this doesn't really need to be in this iteration at all, surely?) + ! Leaf respn needs to be in the sub-layer loop to account for changing N through canopy. + ! + ! base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + !------------------------------------------------------------------------------ + + br = 2.525e-6_r8 + + leaf_frac = 1.0_r8/(currentCohort%canopy_trim + EDecophyscon%sapwood_ratio(currentCohort%pft) * & + currentCohort%hite + pftcon%froot_leaf(currentCohort%pft)) + currentCohort%bsw = EDecophyscon%sapwood_ratio(currentCohort%pft) * currentCohort%hite * & + (currentCohort%balive + currentCohort%laimemory)*leaf_frac + currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) + + currentCohort%livestem_mr = 0._r8 + currentCohort%livecroot_mr = 0._r8 + if (woody(FT) == 1) then + tc = q10**((t_veg(p)-tfrz - 20.0_r8)/10.0_r8) + currentCohort%livestem_mr = currentCohort%livestemn * br * tc !*currentPatch%btran_ft(currentCohort%pft) + currentCohort%livecroot_mr = currentCohort%livecrootn * br * tc !*currentPatch%btran_ft(currentCohort%pft) + + !convert from gC /indiv/s-1 to kgC/indiv/s-1 + currentCohort%livestem_mr = currentCohort%livestem_mr /1000 + currentCohort%livecroot_mr = currentCohort%livecroot_mr /1000 + else + tc = 1.0_r8 + currentCohort%livestem_mr = 0._r8 + currentCohort%livecroot_mr = 0._r8 + end if + + if (pftcon%woody(currentCohort%pft) == 1) then + coarse_wood_frac = 0.5_r8 + else + coarse_wood_frac = 0.0_r8 + end if + + ! Soil temperature. + currentCohort%froot_mr = 0._r8 + + do j = 1,nlevsoi + tcsoi = q10**((t_soisno(c,j)-tfrz - 20.0_r8)/10.0_r8) + !fine root respn. + currentCohort%froot_mr = currentCohort%froot_mr + (1.0_r8 - coarse_wood_frac) * & + currentCohort%br*br*tcsoi * currentPatch%rootfr_ft(ft,j)/leafcn(currentCohort%pft) + ! convert from gC/indiv/s-1 to kgC/indiv/s-1 + currentCohort%froot_mr = currentCohort%froot_mr /1000.0_r8 + enddo + + call t_stopf('edfluxunpack2') + call t_startf('edfluxunpack3') + ! convert gpp and resp from umol/indiv/s-1 to kgC/indiv/s-1 = X * 12 *10-6 * 10-3 + !currentCohort%resp_m = currentCohort%rd * 12.0E-9 + currentCohort%gpp_clm = currentCohort%gpp_clm * 12.0E-9 + ! add on whole plant respiration values in kgC/indiv/s-1 + currentCohort%resp_m = currentCohort%livestem_mr + currentCohort%livecroot_mr + currentCohort%froot_mr + ! no drought response * (1.0_r8 - currentPatch%btran_ft(currentCohort%pft)*pftcon%resp_drought_response(FT)) + currentCohort%resp_m = currentCohort%resp_m + currentCohort%rd * 12.0E-9 !this was already corrected fo BTRAN + + ! convert from kgC/indiv/s to kgC/indiv/timestep + currentCohort%resp_m = currentCohort%resp_m * dtime + currentCohort%gpp_clm = currentCohort%gpp_clm * dtime + currentCohort%resp_g = ED_val_grperc * (max(0._r8,currentCohort%gpp_clm - currentCohort%resp_m)) + currentCohort%resp_clm = currentCohort%resp_m + currentCohort%resp_g ! kgC/indiv/ts + currentCohort%npp_clm = currentCohort%gpp_clm - currentCohort%resp_clm ! kgC/indiv/ts + + !------------------------------------------------------------------------------ + ! Remove whole plant respiration from net uptake. (kgC/indiv/ts) + if(currentCohort%treelai > 0._r8)then + ! do iv =1,currentCohort%NV + ! currentCohort%year_net_uptake(iv) = currentCohort%year_net_uptake(iv) - & + ! (timestep_secs*(currentCohort%livestem_mr + currentCohort%livecroot_mr & + ! minus contribution to whole plant respn. + ! + currentCohort%froot_mr))/(currentCohort%treelai*currentCohort%c_area/currentCohort%n) + ! enddo + else !lai<0 + currentCohort%gpp_clm = 0._r8 + currentCohort%resp_m = 0._r8 + currentCohort%gscan = 0._r8 + end if + else !pft<0 n<0 + write(iulog,*) 'CF: pft 0 or n 0',currentCohort%pft,currentCohort%n,currentCohort%indexnumber + currentCohort%gpp_clm = 0._r8 + currentCohort%resp_m = 0._r8 + currentCohort%gscan = 0._r8 + currentCohort%ts_net_uptake(1:currentCohort%nv) = 0._r8 + end if !pft<0 n<0 + + psncanopy(p) = psncanopy(p) + currentCohort%gpp_clm + lmrcanopy(p) = lmrcanopy(p) + currentCohort%resp_m + ! accumulate cohort level canopy conductances over whole area before dividing by total area. + gccanopy(p) = gccanopy(p) + currentCohort%gscan * currentCohort%n /currentPatch%total_canopy_area + + currentCohort => currentCohort%shorter + + enddo ! end cohort loop. + end if !count_cohorts is more than zero. + + psncanopy(p) = psncanopy(p) / currentPatch%area + lmrcanopy(p) = lmrcanopy(p) / currentPatch%area + if(gccanopy(p) > 1._r8/rsmax0.and.elai(p) > 0.0_r8)then + rscanopy(p) = (1.0_r8/gccanopy(p))-rb(p)/elai(p) ! this needs to be resistance per unit leaf area. + else + rscanopy(p) = rsmax0 + end if + gccanopy(p) = 1.0_r8/rscanopy(p) *cf /1000 !convert into umol m02 s-1 then mmol m-2 s-1. + + else !EDpatch + + rscanopy(p) = rsmax0 + + end if !edpatch + + call t_stopf('edfluxunpack3') + call t_stopf('edunpack') + + end do !patch loop + + end associate + + end subroutine Photosynthesis_ED + +end module EDPhotosynthesisMod diff --git a/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 new file mode 100644 index 0000000000..868bd98491 --- /dev/null +++ b/components/clm/src/ED/biogeophys/EDSurfaceAlbedoMod.F90 @@ -0,0 +1,940 @@ +module EDSurfaceAlbedoMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Performs surface albedo calculations + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : numrad, nclmax + use decompMod , only : bounds_type + + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: ED_Norman_Radiation ! Surface albedo and two-stream fluxes + ! + ! !PUBLIC DATA MEMBERS: + ! The CLM default albice values are too high. + ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) + ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. + + real(r8), public :: albice(numrad) = & ! albedo land ice by waveband (1=vis, 2=nir) + (/ 0.80_r8, 0.55_r8 /) + ! + ! !PRIVATE MEMBER FUNCTIONS: + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine ED_Norman_Radiation (bounds, & + filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & + coszen, ed_allsites_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Two-stream fluxes for canopy radiative transfer + ! Use two-stream approximation of Dickinson (1983) Adv Geophysics + ! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 + ! to calculate fluxes absorbed by vegetation, reflected by vegetation, + ! and transmitted through vegetation for unit incoming direct or diffuse + ! flux given an underlying surface with known albedo. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! !USES: + use clm_varctl , only : iulog + use pftconMod , only : pftcon + use EDtypesMod , only : ed_patch_type, numpft_ed, nlevcan_ed + use EDTypesMod , only : ed_site_type, map_clmpatch_to_edpatch + use PatchType , only : patch + use SurfaceAlbedoType , only : surfalb_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: filter_vegsol(:) ! filter for vegetated pfts with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated pfts where coszen>0 + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter + real(r8) , intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + ! ============================================================================ + ! ED/NORMAN RADIATION DECS + ! ============================================================================ + type (ed_patch_type) , pointer :: currentPatch + integer :: radtype, L, ft, g ,j + integer :: iter ! Iteration index + integer :: irep ! Flag to exit iteration loop + real(r8) :: sb + real(r8) :: error ! Error check + real(r8) :: down_rad, up_rad ! Iterative solution do Dif_dn and Dif_up + real(r8) :: ftweight(nclmax,numpft_ed,nlevcan_ed) + real(r8) :: k_dir(numpft_ed) ! Direct beam extinction coefficient + real(r8) :: tr_dir_z(nclmax,numpft_ed,nlevcan_ed) ! Exponential transmittance of direct beam radiation through a single layer + real(r8) :: tr_dif_z(nclmax,numpft_ed,nlevcan_ed) ! Exponential transmittance of diffuse radiation through a single layer + real(r8) :: forc_dir(bounds%begp:bounds%endp,numrad) + real(r8) :: forc_dif(bounds%begp:bounds%endp,numrad) + real(r8) :: weighted_dir_tr(nclmax) + real(r8) :: weighted_fsun(nclmax) + real(r8) :: weighted_dif_ratio(nclmax,numrad) + real(r8) :: weighted_dif_down(nclmax) + real(r8) :: weighted_dif_up(nclmax) + real(r8) :: refl_dif(nclmax,numpft_ed,nlevcan_ed,numrad) ! Term for diffuse radiation reflected by laye + real(r8) :: tran_dif(nclmax,numpft_ed,nlevcan_ed,numrad) ! Term for diffuse radiation transmitted by layer + real(r8) :: dif_ratio(nclmax,numpft_ed,nlevcan_ed,numrad) ! Ratio of upward to forward diffuse fluxes + real(r8) :: Dif_dn(nclmax,numpft_ed,nlevcan_ed) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + real(r8) :: Dif_up(nclmax,numpft_ed,nlevcan_ed) ! Upward diffuse flux above canopy layer J (W/m**2 ground area) + real(r8) :: lai_change(nclmax,numpft_ed,nlevcan_ed) ! Forward diffuse flux onto canopy layer J (W/m**2 ground area) + + real(r8) :: f_not_abs(numpft_ed,numrad) ! Fraction reflected + transmitted. 1-absorbtion. + real(r8) :: tolerance + real(r8) :: Abs_dir_z(numpft_ed,nlevcan_ed) + real(r8) :: Abs_dif_z(numpft_ed,nlevcan_ed) + real(r8) :: abs_rad(numrad) !radiation absorbed by soil + real(r8) :: tr_soili ! Radiation transmitted to the soil surface. + real(r8) :: tr_soild ! Radiation transmitted to the soil surface. + real(r8) :: phi1b(bounds%begp:bounds%endp,numpft_ed) ! Radiation transmitted to the soil surface. + real(r8) :: phi2b(bounds%begp:bounds%endp,numpft_ed) + real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) + + real(r8) :: angle + real(r8), parameter :: pi = 3.141592654 ! PI + real(r8) :: denom + real(r8) :: lai_reduction(2) + + integer :: fp,p,c,iv ! array indices + integer :: ib ! waveband number + real(r8) :: cosz ! 0.001 <= coszen <= 1.000 + real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(bounds%begp:bounds%endp) ! leaf projection in solar direction (0 to 1) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + ! What is this about? (FIX(RF,032414)) + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + associate(& + rhol => pftcon%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir + rhos => pftcon%rhos , & ! Input: [real(r8) (:) ] stem reflectance: 1=vis, 2=nir + taul => pftcon%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir + taus => pftcon%taus , & ! Input: [real(r8) (:) ] stem transmittance: 1=vis, 2=nir + xl => pftcon%xl , & ! Input: [real(r8) (:) ] ecophys const - leaf/stem orientation index + + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) (column-level) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse)(column-level) + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flx + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flx + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flx + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + fsun_z => surfalb_inst%fsun_z_patch & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + ) + + + + ! TODO (mv, 2014-10-29) the filter here is different than below + ! this is needed to have the VOC's be bfb - this needs to be + ! re-examined int he future + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (patch%is_veg(p)) then + g = patch%gridcell(p) + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + currentPatch%f_sun (:,:,:) = 0._r8 + currentPatch%fabd_sun_z (:,:,:) = 0._r8 + currentPatch%fabd_sha_z (:,:,:) = 0._r8 + currentPatch%fabi_sun_z (:,:,:) = 0._r8 + currentPatch%fabi_sha_z (:,:,:) = 0._r8 + currentPatch%fabd (:) = 0._r8 + currentPatch%fabi (:) = 0._r8 + end if + end do + + !================================================================ + ! NORMAN RADIATION CODE + ! ============================================================================ + ! FIX(SPM,032414) refactor this...too long for one routine. + tolerance = 0.000000001_r8 ! FIX(SPM,032414) make this a param + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + c = patch%column(p) + g = patch%gridcell(p) + + weighted_dir_tr(:) = 0._r8 + weighted_dif_down(:) = 0._r8 + weighted_dif_up(:) = 0._r8 + albd(p,:) = 0._r8 + albi(p,:) = 0._r8 + fabi(p,:) = 0._r8 + fabd(p,:) = 0._r8 + tr_dir_z(:,:,:) = 0._r8 + tr_dif_z(:,:,:) = 0._r8 + ftweight(:,:,:) = 0._r8 + lai_change(:,:,:) = 0._r8 + Dif_up(:,:,:) = 0._r8 + Dif_dn(:,:,:) = 0._r8 + refl_dif(:,:,:,:) = 0.0_r8 + tran_dif(:,:,:,:) = 0.0_r8 + dif_ratio(:,:,:,:) = 0.0_r8 + ftdd(p,:) = 1._r8 + ftid(p,:) = 1._r8 + ftii(p,:) = 1._r8 + + if (patch%is_veg(p)) then ! We have vegetation... + + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + + if (associated(currentPatch))then + !zero all of the matrices used here to reduce potential for errors. + currentPatch%f_sun (:,:,:) = 0._r8 + currentPatch%fabd_sun_z (:,:,:) = 0._r8 + currentPatch%fabd_sha_z (:,:,:) = 0._r8 + currentPatch%fabi_sun_z (:,:,:) = 0._r8 + currentPatch%fabi_sha_z (:,:,:) = 0._r8 + currentPatch%fabd (:) = 0._r8 + currentPatch%fabi (:) = 0._r8 + + if (maxval(currentPatch%nrad(1,:))==0)then + !there are no leaf layers in this patch. it is effectively bare ground. + ! no radiation is absorbed + fabd(p,:) = 0.0_r8 + fabi(p,:) = 0.0_r8 + do ib = 1,numrad + albd(p,ib) = albgrd(c,ib) + albd(p,ib) = albgri(c,ib) + ftdd(p,ib)= 1.0_r8 + ftid(p,ib)= 1.0_r8 + ftii(p,ib)= 1.0_r8 + enddo + else + + ! Is this pft/canopy layer combination present in this patch? + do L = 1,nclmax + do ft = 1,numpft_ed + currentPatch%present(L,ft) = 0 + do iv = 1, currentPatch%nrad(L,ft) + if (currentPatch%canopy_area_profile(L,ft,iv) > 0._r8)then + currentPatch%present(L,ft) = 1 + !I think 'present' is only used here... + endif + end do !iv + end do !ft + end do !L + g = currentPatch%siteptr%clmgcell + + do radtype = 1,2 !do this once for one unit of diffuse, and once for one unit of direct radiation + do ib = 1,numrad + if (radtype == 1) then + ! Set the hypothetical driving radiation. We do this once for a single unit of direct and + ! once for a single unit of diffuse radiation. + forc_dir(p,ib) = 1.00_r8 + forc_dif(p,ib) = 0.00_r8 + else !dif + forc_dir(p,ib) = 0.00_r8 + forc_dif(p,ib) = 1.00_r8 + end if + end do !ib + + !Extract information that needs to be provided by ED into local array. + ftweight(:,:,:) = 0._r8 + do L = 1,currentPatch%NCL_p + do ft = 1,numpft_ed + do iv = 1, currentPatch%nrad(L,ft) + !this is already corrected for area in CLAP + ftweight(L,ft,iv) = currentPatch%canopy_area_profile(L,ft,iv) + end do !iv + end do !ft1 + end do !L + if (sum(ftweight(1,:,1))<0.999_r8)then + write(iulog,*) 'canopy not full',ftweight(1,:,1) + endif + if (sum(ftweight(1,:,1))>1.0001_r8)then + write(iulog,*) 'canopy too full',ftweight(1,:,1) + endif + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Direct beam extinction coefficient, k_dir. PFT specific. + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + cosz = max(0.001_r8, coszen(p)) !copied from previous radiation code... + do ft = 1,numpft_ed + sb = (90._r8 - (acos(cosz)*180/pi)) * (pi / 180._r8) + chil(p) = xl(ft) !min(max(xl(ft), -0.4_r8), 0.6_r8 ) + if (abs(chil(p)) <= 0.01_r8) then + chil = 0.01_r8 + end if + phi1b(p,ft) = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) + phi2b(p,ft) = 0.877_r8 * (1._r8 - 2._r8*phi1b(p,ft)) !0 = horiz leaves, 1 - vert leaves. + gdir(p) = phi1b(p,ft) + phi2b(p,ft) * sin(sb) + !how much direct light penetrates a singleunit of lai? + k_dir(ft) = gdir(p) / sin(sb) + end do !FT + + do L = 1,currentPatch%NCL_p !start at the top canopy layer (1 is the top layer.) + weighted_dir_tr(L) = 0.0_r8 + weighted_fsun(L) = 0._r8 + weighted_dif_ratio(L,1:numrad) = 0._r8 + !Each canopy layer (canopy, understorey) has multiple 'parallel' pft's + do ft =1,numpft_ed + if (currentPatch%present(L,ft) == 1)then !only do calculation if there are the appropriate leaves. + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Diffuse transmittance, tr_dif, do each layer with thickness elai_z. + ! Estimated do nine sky angles in increments of 10 degrees + ! PFT specific... + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + tr_dif_z(L,ft,:) = 0._r8 + do iv = 1,currentPatch%nrad(L,ft) + do j = 1,9 + angle = (5._r8 + (j - 1) * 10._r8) * 3.142 / 180._r8 + gdir(p) = phi1b(p,ft) + phi2b(p,ft) * sin(angle) !This line is redundant FIX(RF,032414). + tr_dif_z(L,ft,iv) = tr_dif_z(L,ft,iv) + exp(-gdir(p) / sin(angle) * & + (currentPatch%elai_profile(L,ft,iv)+currentPatch%esai_profile(L,ft,iv))) * & + sin(angle)*cos(angle) + end do + + tr_dif_z(L,ft,iv) = tr_dif_z(L,ft,iv) * 2._r8 * (10.00*pi/180._r8) + + end do + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Direct beam transmittance, tr_dir_z, uses cumulative LAI above layer J to give + ! unscattered direct beam onto layer J. do each PFT section. + ! This is just an decay curve based on k_dir. (leaf & sun angle) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + if (L==1)then + tr_dir_z(L,ft,1) = 1._r8 + else + tr_dir_z(L,ft,1) = weighted_dir_tr(L-1) + endif + laisum = 0.00_r8 + !total direct beam getting to the bottom of the top canopy. + do iv = 1,currentPatch%nrad(L,ft) + laisum = laisum + currentPatch%elai_profile(L,ft,iv)+currentPatch%esai_profile(L,ft,iv) + lai_change(L,ft,iv) = 0.0_r8 + if (( ftweight(L,ft,iv+1) > 0.0_r8 ) .and. ( ftweight(L,ft,iv+1) < ftweight(L,ft,iv) ))then + !where there is a partly empty leaf layer, some fluxes go straight through. + lai_change(L,ft,iv) = ftweight(L,ft,iv)-ftweight(L,ft,iv+1) + endif + if (ftweight(L,ft,iv+1) - ftweight(L,ft,iv) > 1.e-10_r8)then + write(iulog,*) 'lower layer has more coverage. This is wrong' , & + ftweight(L,ft,iv),ftweight(L,ft,iv+1),ftweight(L,ft,iv+1)-ftweight(L,ft,iv) + endif + + !n.b. in theory lai_change could be calculated daily in the ED code. + !This is light coming striaght through the canopy. + if (L==1)then + tr_dir_z(L,ft,iv+1) = exp(-k_dir(ft) * laisum)* & + (ftweight(L,ft,iv)/ftweight(L,ft,1)) + else + tr_dir_z(L,ft,iv+1) = weighted_dir_tr(L-1)*exp(-k_dir(ft) * laisum)* & + (ftweight(L,ft,iv)/ftweight(L,ft,1)) + endif + + if (iv == 1)then + !this is the top layer. + tr_dir_z(L,ft,iv+1) = tr_dir_z(L,ft,iv+1) + tr_dir_z(L,ft,iv) * & + ((ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1)) + else + !the lai_change(iv) affects the light incident on layer iv+2 not iv+1 + ! light coming from the layer above (iv-1) goes through iv and onto iv+1. + if (lai_change(L,ft,iv-1) > 0.0_r8)then + tr_dir_z(L,ft,iv+1) = tr_dir_z(L,ft,iv+1) + tr_dir_z(L,ft,iv)* & + lai_change(L,ft,iv-1) / ftweight(L,ft,1) + tr_dir_z(L,ft,iv+1) = tr_dir_z(L,ft,iv+1) + tr_dir_z(L,ft,iv-1)* & + (ftweight(L,ft,1)-ftweight(L,ft,iv-1))/ftweight(L,ft,1) + else + !account fot the light that comes striaght down from unfilled layers above. + tr_dir_z(L,ft,iv+1) = tr_dir_z(L,ft,iv+1) + tr_dir_z(L,ft,iv) * & + ((ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1)) + endif + endif + end do + + !add up all the weighted contributions from the different PFT columns. + weighted_dir_tr(L) = weighted_dir_tr(L) + tr_dir_z(L,ft,currentPatch%nrad(L,ft)+1)*ftweight(L,ft,1) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Sunlit and shaded fraction of leaf layer + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + + !laisum = 0._r8 + do iv = 1,currentPatch%nrad(L,ft) + ! Cumulative leaf area. Original code uses cumulative lai do layer. + ! Now use cumulative lai at center of layer. + ! Same as tr_dir_z calcualtions, but in the middle of the layer? FIX(RF,032414)-WHY? + if (iv == 1) then + laisum = 0.5_r8 * (currentPatch%elai_profile(L,ft,iv)+currentPatch%esai_profile(L,ft,iv)) + else + laisum = laisum + currentPatch%elai_profile(L,ft,iv)+currentPatch%esai_profile(L,ft,iv) + end if + + + if (L == 1)then !top canopy layer + currentPatch%f_sun(L,ft,iv) = exp(-k_dir(ft) * laisum)* & + (ftweight(L,ft,iv)/ftweight(L,ft,1)) + else + currentPatch%f_sun(L,ft,iv) = weighted_fsun(L-1)* exp(-k_dir(ft) * laisum)* & + (ftweight(L,ft,iv)/ftweight(L,ft,1)) + endif + + if ( iv > 1 ) then ! becasue we are looking at this layer (not the next) + ! we only ever add fluxes if iv>1 + if (lai_change(L,ft,iv-1) > 0.0_r8)then + currentPatch%f_sun(L,ft,iv) = currentPatch%f_sun(L,ft,iv) + & + currentPatch%f_sun(L,ft,iv) * & + lai_change(L,ft,iv-1)/ftweight(L,ft,1) + currentPatch%f_sun(L,ft,iv) = currentPatch%f_sun(L,ft,iv) + & + currentPatch%f_sun(L,ft,iv-1) * & + (ftweight(L,ft,1)-ftweight(L,ft,iv-1))/ftweight(L,ft,1) + else + currentPatch%f_sun(L,ft,iv) = currentPatch%f_sun(L,ft,iv) + & + currentPatch%f_sun(L,ft,iv-1) * & + (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + endif + endif + + end do !iv + weighted_fsun(L) = weighted_fsun(L) + currentPatch%f_sun(L,ft,currentPatch%nrad(L,ft))* & + ftweight(L,ft,1) + + ! instance where the first layer ftweight is used a proxy for the whole column. FTWA + ! this is possibly a source of slight error. If we use the ftweight at the top of the PFT column, + ! then we willl underestimate fsun, but if we use ftweight at the bottom of the column, we will + ! underestimate it. Really, we should be tracking the release of direct light from the column as it tapers + ! towards the ground. Is that necessary to get energy closure? It would be quite hard... + endif !present. + end do!pft loop + end do !L + + do L = currentPatch%NCL_p,1, -1 !start at the bottom and work up. + do ft = 1,numpft_ed + if (currentPatch%present(L,ft) == 1)then + !==============================================================================! + ! Iterative solution do scattering + !==============================================================================! + + do ib = 1,numrad !vis, nir + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Leaf scattering coefficient and terms do diffuse radiation reflected + ! and transmitted by a layer + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + f_not_abs(ft,ib) = rhol(ft,ib) + taul(ft,ib) !leaf level fraction NOT absorbed. + !tr_dif_z is a term that uses the LAI in each layer, whereas rhol and taul do not, + !because they are properties of leaf surfaces and not of the leaf matrix. + do iv = 1,currentPatch%nrad(L,ft) + !How much diffuse light is intercepted and then reflected? + refl_dif(L,ft,iv,ib) = (1._r8 - tr_dif_z(L,ft,iv)) * rhol(ft,ib) + !How much diffuse light in this layer is transmitted? + tran_dif(L,ft,iv,ib) = (1._r8 - tr_dif_z(L,ft,iv)) * taul(ft,ib) + tr_dif_z(L,ft,iv) + end do + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Ratio of upward to forward diffuse fluxes, dif_ratio + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! Soil diffuse reflectance (ratio of down to up radiation). + iv = currentPatch%nrad(L,ft) + 1 + if (L == currentPatch%NCL_p)then !nearest the soil + dif_ratio(L,ft,iv,ib) = albgri(c,ib) + else + dif_ratio(L,ft,iv,ib) = weighted_dif_ratio(L+1,ib) + end if + ! Canopy layers, working upwardfrom soil with dif_ratio(iv+1) known + ! FIX(RF,032414) ray tracing eqution - need to find derivation of this... + ! for each unit going down, there are x units going up. + do iv = currentPatch%nrad(L,ft),1, -1 + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv+1,ib) * tran_dif(L,ft,iv,ib)*tran_dif(L,ft,iv,ib) / & + (1._r8 - dif_ratio(L,ft,iv+1,ib) * refl_dif(L,ft,iv,ib)) + refl_dif(L,ft,iv,ib) + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) * ftweight(L,ft,iv)/ftweight(L,ft,1) + dif_ratio(L,ft,iv,ib) = dif_ratio(L,ft,iv,ib) + dif_ratio(L,ft,iv+1,ib)* & + (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + end do + weighted_dif_ratio(L,ib) = weighted_dif_ratio(L,ib) + dif_ratio(L,ft,1,ib) * ftweight(L,ft,1) + !instance where the first layer ftweight is used a proxy for the whole column. FTWA + end do!numrad + endif ! currentPatch%present + end do!ft + end do!L + + do ib = 1,numrad + Dif_dn(:,:,:) = 0.00_r8 + Dif_up(:,:,:) = 0.00_r8 + do L = 1, currentPatch%NCL_p !work down from the top of the canopy. + weighted_dif_down(L) = 0._r8 + do ft = 1, numpft_ed + if (currentPatch%present(L,ft) == 1)then + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! First estimates do downward and upward diffuse flux + ! + ! Dif_dn = forward diffuse flux onto layer J + ! Dif_up = Upward diffuse flux above layer J + ! + ! Solved here without direct beam radiation and using dif_ratio = Dif_up / Dif_dn + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! downward diffuse flux onto the top surface of the canopy + + if (L == 1)then + Dif_dn(L,ft,1) = forc_dif(p,ib) + else + Dif_dn(L,ft,1) = weighted_dif_down(L-1) + end if + ! forward diffuse flux within the canopy and at soil, working forward through canopy + do iv = 1,currentPatch%nrad(L,ft) + denom = refl_dif(L,ft,iv,ib) * dif_ratio(L,ft,iv,ib) + denom = 1._r8 - denom + Dif_dn(L,ft,iv+1) = Dif_dn(L,ft,iv) * tran_dif(L,ft,iv,ib) / & + denom *ftweight(L,ft,iv)/ftweight(L,ft,1) + if (iv > 1)then + if (lai_change(L,ft,iv-1) > 0.0_r8)then + !here we are thinking about whether the layer above had an laichange, + !but calculating the flux onto the layer below. + Dif_dn(L,ft,iv+1) = Dif_dn(L,ft,iv+1)+ Dif_dn(L,ft,iv)* & + lai_change(L,ft,iv-1)/ftweight(L,ft,1) + Dif_dn(L,ft,iv+1) = Dif_dn(L,ft,iv+1)+ Dif_dn(L,ft,iv-1)* & + (ftweight(L,ft,1)-ftweight(L,ft,iv-1)/ftweight(L,ft,1)) + else + Dif_dn(L,ft,iv+1) = Dif_dn(L,ft,iv+1) + Dif_dn(L,ft,iv) * & + (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + endif + else + Dif_dn(L,ft,iv+1) = Dif_dn(L,ft,iv+1) + Dif_dn(L,ft,iv) * & + (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + endif + end do + + weighted_dif_down(L) = weighted_dif_down(L) + Dif_dn(L,ft,currentPatch%nrad(L,ft)+1) * & + ftweight(L,ft,1) + + !instance where the first layer ftweight is used a proxy for the whole column. FTWA + endif !present + end do !ft + if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is the the (incomplete) understorey? + !Add on the radiation going through the canopy gaps. + weighted_dif_down(L) = weighted_dif_down(L) + weighted_dif_down(L-1)*(1.0-sum(ftweight(L,:,1))) + !instance where the first layer ftweight is used a proxy for the whole column. FTWA + endif + end do !L + + do L = currentPatch%NCL_p,1 ,-1 !work up from the bottom. + weighted_dif_up(L) = 0._r8 + do ft = 1, numpft_ed + if (currentPatch%present(L,ft) == 1)then + !Bounce diffuse radiation off soil surface. + iv = currentPatch%nrad(L,ft) + 1 + if (L==currentPatch%NCL_p)then !is this the bottom layer ? + Dif_up(L,ft,iv) =albgri(c,ib) * Dif_dn(L,ft,iv) + else + Dif_up(L,ft,iv) = weighted_dif_up(L+1) + end if + ! Upward diffuse flux within the canopy and above the canopy, working upward through canopy + + do iv = currentPatch%nrad(L,ft), 1, -1 + if (lai_change(L,ft,iv) > 0.0_r8)then + Dif_up(L,ft,iv) = dif_ratio(L,ft,iv,ib) * Dif_dn(L,ft,iv)*ftweight(L,ft,iv)/ftweight(L,ft,1) + Dif_up(L,ft,iv) = Dif_up(L,ft,iv) + Dif_up(L,ft,iv+1) * & + tran_dif(L,ft,iv,ib) * lai_change(L,ft,iv)/ftweight(L,ft,1) + Dif_up(L,ft,iv) = Dif_up(L,ft,iv) + Dif_up(L,ft,iv+1) * & + (ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + !nb is this the right constuction? + ! the radiation that hits the empty space is not reflected. + else + Dif_up(L,ft,iv) = dif_ratio(L,ft,iv,ib) * Dif_dn(L,ft,iv) * ftweight(L,ft,iv) + Dif_up(L,ft,iv) = Dif_up(L,ft,iv) + Dif_up(L,ft,iv+1) * (1.0_r8-ftweight(L,ft,iv)) + endif + end do + + weighted_dif_up(L) = weighted_dif_up(L) + Dif_up(L,ft,1) * ftweight(L,ft,1) + !instance where the first layer ftweight is used a proxy for the whole column. FTWA + endif !present + end do !ft + if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? + !Add on the radiation coming up through the canopy gaps. + !diffuse to diffuse + weighted_dif_up(L) = weighted_dif_up(L) +(1.0-sum(ftweight(L,:,1))) * & + weighted_dif_down(L-1) * albgri(c,ib) + !direct to diffuse + weighted_dif_up(L) = weighted_dif_up(L) + forc_dir(p,ib) * & + weighted_dir_tr(L-1) * (1.0-sum(ftweight(L,:,1)))*albgrd(c,ib) + endif + end do !L + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + ! 3. Iterative calculation of forward and upward diffuse fluxes, iNCL_puding + ! scattered direct beam + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++! + + ! Flag to exit iteration loop: 0 = exit and 1 = iterate + irep = 1 + ! Iteration loop + iter = 0 + do while(irep ==1 .and. iter<50) + + iter = iter + 1 + irep = 0 + do L = 1,currentPatch%NCL_p !working from the top down + weighted_dif_down(L) = 0._r8 + do ft =1,numpft_ed + if (currentPatch%present(L,ft) == 1)then + ! forward diffuse flux within the canopy and at soil, working forward through canopy + ! with Dif_up -from previous iteration-. Dif_dn(1) is the forward diffuse flux onto the canopy. + ! Note: down = forward flux onto next layer + if (L == 1)then !is this the top layer? + Dif_dn(L,ft,1) = forc_dif(p,ib) + else + Dif_dn(L,ft,1) = weighted_dif_down(L-1) + end if + down_rad = 0._r8 + + do iv = 1, currentPatch%nrad(L,ft) + + down_rad = Dif_dn(L,ft,iv) * tran_dif(L,ft,iv,ib) + & + Dif_up(L,ft,iv+1) * refl_dif(L,ft,iv,ib) + & + forc_dir(p,ib) * tr_dir_z(L,ft,iv) * (1.00_r8 - & + exp(-k_dir(ft) * (currentPatch%elai_profile(L,ft,iv)+ & + currentPatch%esai_profile(L,ft,iv)))) * taul(ft,ib) + down_rad = down_rad *(ftweight(L,ft,iv)/ftweight(L,ft,1)) + + if (iv > 1)then + if (lai_change(L,ft,iv-1) > 0.0_r8)then + down_rad = down_rad + Dif_dn(L,ft,iv) * lai_change(L,ft,iv-1)/ftweight(L,ft,1) + down_rad = down_rad + Dif_dn(L,ft,iv-1) * (ftweight(L,ft,1)-ftweight(L,ft,iv-1))/ & + ftweight(L,ft,1) + else + down_rad = down_rad + Dif_dn(L,ft,iv) * (ftweight(L,ft,1)-ftweight(L,ft,iv))/ & + ftweight(L,ft,1) + endif + else + down_rad = down_rad + Dif_dn(L,ft,iv) * (ftweight(L,ft,1)-ftweight(L,ft,iv))/ & + ftweight(L,ft,1) + endif + + !this is just Dif down, plus refl up, plus dir intercepted and turned into dif... , + if (abs(down_rad - Dif_dn(L,ft,iv+1)) > tolerance)then + irep = 1 + end if + Dif_dn(L,ft,iv+1) = down_rad + + end do !iv + + weighted_dif_down(L) = weighted_dif_down(L) + Dif_dn(L,ft,currentPatch%nrad(L,ft)+1) * & + ftweight(L,ft,1) + + endif !present + end do!ft + if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? + weighted_dif_down(L) = weighted_dif_down(L) + weighted_dif_down(L-1)*(1.0-sum(ftweight(L,:,1))) + end if + end do ! do L loop + + do L = 1, currentPatch%NCL_p ! working from the top down. + weighted_dif_up(L) = 0._r8 + do ft =1,numpft_ed + if (currentPatch%present(L,ft) == 1)then + ! Upward diffuse flux at soil or from lower canopy (forward diffuse and unscattered direct beam) + iv = currentPatch%nrad(L,ft) + 1 + if (L==currentPatch%NCL_p)then !In the bottom canopy layer, reflect off the soil + Dif_up(L,ft,iv) = Dif_dn(L,ft,iv) *albgri(c,ib) + & + forc_dir(p,ib) * tr_dir_z(L,ft,iv) *albgrd(c,ib) + else !In the other canopy layers, reflect off the underlying vegetation. + Dif_up(L,ft,iv) = weighted_dif_up(L+1) + end if + + ! Upward diffuse flux within and above the canopy, working upward through canopy + ! with Dif_dn from previous interation. Note: up = upward flux above current layer + do iv = currentPatch%nrad(L,ft),1,-1 + !this is radiation up, by layer transmittance, by + + !reflection of the lower layer, + up_rad = Dif_dn(L,ft,iv) * refl_dif(L,ft,iv,ib) + up_rad = up_rad + forc_dir(p,ib) * tr_dir_z(L,ft,iv) * (1.00_r8 - exp(-k_dir(ft) * & + (currentPatch%elai_profile(L,ft,iv)+currentPatch%esai_profile(L,ft,iv)))) * rhol(ft,ib) + up_rad = up_rad + Dif_up(L,ft,iv+1) * tran_dif(L,ft,iv,ib) + up_rad = up_rad * ftweight(L,ft,iv)/ftweight(L,ft,1) + up_rad = up_rad + Dif_up(L,ft,iv+1) *(ftweight(L,ft,1)-ftweight(L,ft,iv))/ftweight(L,ft,1) + ! THE LOWER LAYER FLUX IS HOMOGENIZED, SO WE DON"T CONSIDER THE LAI_CHANGE HERE... + + if (abs(up_rad - Dif_up(L,ft,iv)) > tolerance) then !are we close to the tolerance level? + irep = 1 + end if + Dif_up(L,ft,iv) = up_rad + + end do !iv + weighted_dif_up(L) = weighted_dif_up(L) + Dif_up(L,ft,1) * ftweight(L,ft,1) + end if !present + end do!ft + + if (L == currentPatch%NCL_p.and.currentPatch%NCL_p > 1)then !is this the (incomplete) understorey? + !Add on the radiation coming up through the canopy gaps. + weighted_dif_up(L) = weighted_dif_up(L) +(1.0_r8-sum(ftweight(L,:,1))) * & + weighted_dif_down(L-1) * albgri(c,ib) + weighted_dif_up(L) = weighted_dif_up(L) + forc_dir(p,ib) * & + weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,:,1)))*albgrd(c,ib) + end if + end do!L + end do ! do while over iter + + abs_rad(ib) = 0._r8 + tr_soili = 0._r8 + tr_soild = 0._r8 + do L = 1, currentPatch%NCL_p !working from the top down. + abs_dir_z(:,:) = 0._r8 + abs_dif_z(:,:) = 0._r8 + do ft =1,numpft_ed + if (currentPatch%present(L,ft) == 1)then + !==============================================================================! + ! Compute absorbed flux densities + !==============================================================================! + + ! Absorbed direct beam and diffuse do leaf layers + do iv = 1, currentPatch%nrad(L,ft) + Abs_dir_z(ft,iv) = ftweight(L,ft,iv)* forc_dir(p,ib) * tr_dir_z(L,ft,iv) * & + (1.00_r8 - exp(-k_dir(ft) * (currentPatch%elai_profile(L,ft,iv)+ & + currentPatch%esai_profile(L,ft,iv)))) * (1.00_r8 - f_not_abs(ft,ib)) + Abs_dif_z(ft,iv) = ftweight(L,ft,iv)* ((Dif_dn(L,ft,iv) + & + Dif_up(L,ft,iv+1)) * (1.00_r8 - tr_dif_z(L,ft,iv)) * & + (1.00_r8 - f_not_abs(ft,ib))) + end do + + ! Absorbed direct beam and diffuse do soil + if (L == currentPatch%NCL_p)then + iv = currentPatch%nrad(L,ft) + 1 + Abs_dif_z(ft,iv) = ftweight(L,ft,1)*Dif_dn(L,ft,iv) * (1.0_r8 -albgri(c,ib)) + Abs_dir_z(ft,iv) = ftweight(L,ft,1)*forc_dir(p,ib) * & + tr_dir_z(L,ft,iv) * (1.0_r8 -albgrd(c,ib)) + tr_soild = tr_soild + ftweight(L,ft,1)*forc_dir(p,ib) * tr_dir_z(L,ft,iv) + tr_soili = tr_soili + ftweight(L,ft,1)*Dif_dn(L,ft,iv) + end if + ! Absorbed radiation, shaded and sunlit portions of leaf layers + !here we get one unit of diffuse radiation... how much of + !it is absorbed? + do iv = 1, currentPatch%nrad(L,ft) + if (radtype==1)then + currentPatch%fabd_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * (1._r8 - currentPatch%f_sun(L,ft,iv)) + currentPatch%fabd_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * currentPatch%f_sun(L,ft,iv) + & + Abs_dir_z(ft,iv) + else + currentPatch%fabi_sha_z(L,ft,iv) = Abs_dif_z(ft,iv) * (1._r8 - currentPatch%f_sun(L,ft,iv)) + currentPatch%fabi_sun_z(L,ft,iv) = Abs_dif_z(ft,iv) * currentPatch%f_sun(L,ft,iv) + end if + end do + + !==============================================================================! + ! Sum fluxes + !==============================================================================! + ! Solar radiation absorbed by ground + iv = currentPatch%nrad(L,ft) + 1 + if (L==currentPatch%NCL_p)then + abs_rad(ib) = abs_rad(ib) + (Abs_dir_z(ft,iv) + Abs_dif_z(ft,iv)) + end if + ! Solar radiation absorbed by vegetation and sunlit/shaded leaves + do iv = 1,currentPatch%nrad(L,ft) + if (radtype == 1)then + currentPatch%fabd(ib) = currentPatch%fabd(ib) + Abs_dir_z(ft,iv)+Abs_dif_z(ft,iv) + ! fabd(p,ib) = currentPatch%fabd(ib) + else + currentPatch%fabi(ib) = currentPatch%fabi(ib) + Abs_dif_z(ft,iv) + ! fabi(p,ib) = currentPatch%fabi(ib) + endif + end do + ! Albefor + if (L==1)then !top canopy layer. + if (radtype == 1)then + albd(p,ib) = albd(p,ib) + Dif_up(L,ft,1) * ftweight(L,ft,1) + else + albi(p,ib) = albi(p,ib) + Dif_up(L,ft,1) * ftweight(L,ft,1) + end if + end if + end if ! present + end do !ft + if (radtype == 1)then + fabd(p,ib) = currentPatch%fabd(ib) + else + fabi(p,ib) = currentPatch%fabi(ib) + endif + + + !radiation absorbed from fluxes through unfilled part of lower canopy. + if (currentPatch%NCL_p > 1.and.L == currentPatch%NCL_p)then + abs_rad(ib) = abs_rad(ib) + weighted_dif_down(L-1) * & + (1.0_r8-sum(ftweight(L,:,1)))*(1.0_r8-albgri(c,ib)) + abs_rad(ib) = abs_rad(ib) + forc_dir(p,ib) * weighted_dir_tr(L-1) * & + (1.0_r8-sum(ftweight(L,:,1)))*(1.0_r8-albgrd(c,ib)) + tr_soili = tr_soili + weighted_dif_down(L-1) * (1.0_r8-sum(ftweight(L,:,1))) + tr_soild = tr_soild + forc_dir(p,ib) * weighted_dir_tr(L-1) * (1.0_r8-sum(ftweight(L,:,1))) + endif + + if (radtype == 1)then + currentPatch%tr_soil_dir(ib) = tr_soild + currentPatch%tr_soil_dir_dif(ib) = tr_soili + currentPatch%sabs_dir(ib) = abs_rad(ib) + ftdd(p,ib) = tr_soild + ftid(p,ib) = tr_soili + else + currentPatch%tr_soil_dif(ib) = tr_soili + currentPatch%sabs_dif(ib) = abs_rad(ib) + ftii(p,ib) = tr_soili + end if + + end do!l + + + !==============================================================================! + ! Conservation check + !==============================================================================! + ! Total radiation balance: absorbed = incoming - outgoing + + if (radtype == 1)then + error = abs(currentPatch%sabs_dir(ib)-(currentPatch%tr_soil_dir(ib)*(1.0_r8-albgrd(c,ib))+ & + currentPatch%tr_soil_dir_dif(ib)*(1.0_r8-albgri(c,ib)))) + if ( abs(error) > 0.0001)then + write(iulog,*)'dir ground absorption error',p,g,error,currentPatch%sabs_dir(ib), & + currentPatch%tr_soil_dir(ib)* & + (1.0_r8-albgrd(c,ib)),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) + write(iulog,*) 'albedos',currentPatch%sabs_dir(ib) ,currentPatch%tr_soil_dir(ib), & + (1.0_r8-albgrd(c,ib)),currentPatch%lai + + do ft =1,3 + iv = currentPatch%nrad(1,ft) + 1 + write(iulog,*) 'abs soil fluxes', Abs_dir_z(ft,iv),Abs_dif_z(ft,iv) + end do + + end if + else + if ( abs(currentPatch%sabs_dif(ib)-(currentPatch%tr_soil_dif(ib) * & + (1.0_r8-albgri(c,ib)))) > 0.0001)then + write(iulog,*)'dif ground absorption error',p,g,currentPatch%sabs_dif(ib) , & + (currentPatch%tr_soil_dif(ib)* & + (1.0_r8-albgri(c,ib))),currentPatch%NCL_p,ib,sum(ftweight(1,:,1)) + endif + endif + + if (radtype == 1)then + error = (forc_dir(p,ib) + forc_dif(p,ib)) - (fabd(p,ib) + albd(p,ib) + currentPatch%sabs_dir(ib)) + else + error = (forc_dir(p,ib) + forc_dif(p,ib)) - (fabi(p,ib) + albi(p,ib) + currentPatch%sabs_dif(ib)) + endif + lai_reduction(:) = 0.0_r8 + do L = 1, currentPatch%NCL_p + do ft =1,numpft_ed + if (currentPatch%present(L,ft) == 1)then + do iv = 1, currentPatch%nrad(L,ft) + if (lai_change(L,ft,iv) > 0.0_r8)then + lai_reduction(L) = max(lai_reduction(L),lai_change(L,ft,iv)) + endif + enddo + endif + enddo + enddo + if (lai_change(1,2,1).gt.0.0.and.lai_change(1,2,2).gt.0.0)then + write(iulog,*) 'lai_change(1,2,12)',lai_change(1,2,1:4) + endif + if (lai_change(1,2,2).gt.0.0.and.lai_change(1,2,3).gt.0.0)then + write(iulog,*) ' lai_change (1,2,23)',lai_change(1,2,1:4) + endif + if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,2).gt.0.0)then + ! write(iulog,*) 'first layer of lai_change 2 3',lai_change(1,1,1:3) + endif + if (lai_change(1,1,3).gt.0.0.and.lai_change(1,1,4).gt.0.0)then + ! write(iulog,*) 'first layer of lai_change 3 4',lai_change(1,1,1:4) + endif + if (lai_change(1,1,4).gt.0.0.and.lai_change(1,1,5).gt.0.0)then + ! write(iulog,*) 'first layer of lai_change 4 5',lai_change(1,1,1:5) + endif + + + + if (radtype == 1)then + !here we are adding a within-ED radiation scheme tolerance, and then adding the diffrence onto the albedo + !it is important that the lower boundary for this is ~1000 times smaller than the tolerance in surface albedo. + if (abs(error) > 1.e-9_r8 .and. abs(error) < 0.15_r8)then + ! write(iulog,*) 'Dir error',error,fabd(p,ib),& + ! albd(p,ib),currentPatch%sabs_dir(ib) + ! write(iulog,*) 'elai',pps%elai(p),pps%tlai(p), currentPatch%NCL_p,currentPatch%nrad(1:2,1:2) + albd(p,ib) = albd(p,ib) + error + !this terms adds the error back on to the albedo. While this is partly inexcusable, it is + ! in the medium term a solution that + ! prevents the model from crashing with small and occasional energy balances issues. + ! These are extremely difficult to debug, many have been solved already, leading + ! to the complexity of this code, but where the system generates occasional errors, we + ! will deal with them for now. + end if + if (abs(error) > 0.15_r8)then + write(iulog,*) 'Large Dir Radn consvn error',error ,p,ib + write(iulog,*) 'diags',albd(p,ib),ftdd(p,ib),ftid(p,ib),fabd(p,ib) + write(iulog,*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'ftweight',ftweight(1,1:2,1:4) + write(iulog,*) 'cp',currentPatch%area, currentPatch%patchno + write(iulog,*) 'albgrd(c,ib)',albgrd(c,ib) + + ! albd(p,ib) = albd(p,ib) + error + end if + else + + if (abs(error) > 1.e-9_r8 .and. abs(error) < 0.15_r8)then + ! write(iulog,*) 'Dif error',error,fabi(p,ib),& + ! albi(p,ib),currentPatch%sabs_dif(ib) + albi(p,ib) = albi(p,ib) + error + end if + if (abs(error) > 0.15_r8)then + write(iulog,*) '>5% Dif Radn consvn error',error ,p,ib + write(iulog,*) 'diags',albi(p,ib),ftii(p,ib),fabi(p,ib) + write(iulog,*) 'lai_change',lai_change(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'elai',currentpatch%elai_profile(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'esai',currentpatch%esai_profile(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'ftweight',ftweight(currentpatch%ncl_p,1:2,1:4) + write(iulog,*) 'cp',currentPatch%area, currentPatch%patchno + write(iulog,*) 'albgri(c,ib)',albgri(c,ib) + write(iulog,*) 'rhol',rhol(1:2,:) + write(iulog,*) 'ftw',sum(ftweight(1,:,1)),ftweight(1,1:2,1) + write(iulog,*) 'present',currentPatch%present(1,1:2) + write(iulog,*) 'CAP',currentPatch%canopy_area_profile(1,1:2,1) + + + ! albi(p,ib) = albi(p,ib) + error + end if + + + if (radtype == 1)then + error = (forc_dir(p,ib) + forc_dif(p,ib)) - (fabd(p,ib) + albd(p,ib) + currentPatch%sabs_dir(ib)) + else + error = (forc_dir(p,ib) + forc_dif(p,ib)) - (fabi(p,ib) + albi(p,ib) + currentPatch%sabs_dif(ib)) + endif + if (abs(error) > 0.00000001_r8)then + write(iulog,*) 'there is still error after correction',error ,p,ib + end if + + end if + + end do !numrad + + enddo ! rad-type + + endif ! is there vegetation? + endif !associated + endif ! EDPATCH + enddo ! loop over fp and indirection to p + + end associate +end subroutine ED_Norman_Radiation + +end module EDSurfaceAlbedoMod diff --git a/components/clm/src/ED/fire/SFMainMod.F90 b/components/clm/src/ED/fire/SFMainMod.F90 new file mode 100755 index 0000000000..60194c1735 --- /dev/null +++ b/components/clm/src/ED/fire/SFMainMod.F90 @@ -0,0 +1,936 @@ +module SFMainMod + + ! ============================================================================ + ! All subroutines realted to the SPITFIRE fire routine. + ! Code originally developed by Allan Spessa & Rosie Fisher as part of the NERC-QUEST project. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8; + use spmdMod , only : masterproc + use clm_varctl , only : iulog + use atm2lndType , only : atm2lnd_type + use TemperatureType , only : temperature_type + use pftconMod , only : pftcon + use EDEcophysconType , only : EDecophyscon + use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, AREA, DG_SF, FIRE_THRESHOLD + use EDtypesMod , only : LB_SF, LG_SF, NCWD, TR_SF + + implicit none + private + + public :: fire_model + public :: fire_danger_index + public :: charecteristics_of_fuel + public :: rate_of_spread + public :: ground_fuel_consumption + public :: fire_intensity + public :: wind_effect + public :: area_burnt + public :: crown_scorching + public :: crown_damage + public :: cambial_damage_kill + public :: post_fire_mortality + + integer :: write_SF = 0 ! for debugging + logical :: DEBUG = .false. ! for debugging + + ! ============================================================================ + ! ============================================================================ + +contains + + ! ============================================================================ + ! Area of site burned by fire + ! ============================================================================ + subroutine fire_model( currentSite, atm2lnd_inst, temperature_inst) + + use clm_varctl, only : use_ed_spit_fire + + type(ed_site_type) , intent(inout), target :: currentSite + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + + type (ed_patch_type), pointer :: currentPatch + + integer temporary_SF_switch + + !zero fire things + currentPatch => currentSite%youngest_patch + temporary_SF_switch = 0 + do while(associated(currentPatch)) + currentPatch%frac_burnt = 0.0_r8 + currentPatch%AB = 0.0_r8 + currentPatch%fire = 0 + currentPatch => currentPatch%older + enddo + + if(write_SF==1)then + write(iulog,*) 'use_ed_spit_fire',use_ed_spit_fire + endif + + if(use_ed_spit_fire.and.temporary_SF_switch==1)then + call fire_danger_index(currentSite, temperature_inst, atm2lnd_inst) + call wind_effect(currentSite, atm2lnd_inst) + call charecteristics_of_fuel(currentSite) + call rate_of_spread(currentSite) + call ground_fuel_consumption(currentSite) + call fire_intensity(currentSite) + call area_burnt(currentSite) + call crown_scorching(currentSite) + call crown_damage(currentSite) + call cambial_damage_kill(currentSite) + call post_fire_mortality(currentSite) + end if + + end subroutine fire_model + + !***************************************************************** + subroutine fire_danger_index ( currentSite, temperature_inst, atm2lnd_inst) + + !***************************************************************** + ! currentSite%acc_NI is the accumulated Nesterov fire danger index + + use clm_varcon , only : tfrz + + use SFParamsMod, only : SF_val_fdi_a, SF_val_fdi_b + + type(ed_site_type) , intent(inout), target :: currentSite + type(temperature_type) , intent(in) :: temperature_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + + real(r8) :: temp_in_C ! daily averaged temperature in celcius + real(r8) :: rainfall ! daily precip + real(r8) :: rh ! daily rh + + real yipsolon; !intermediate varable for dewpoint calculation + real dewpoint; !dewpoint in K + real d_NI; !daily change in Nesterov Index. C^2 + + associate( & + t_veg24 => temperature_inst%t_veg24_patch , & ! Input: [real(r8) (:)] avg pft vegetation temperature for last 24 hrs + + prec24 => atm2lnd_inst%prec24_patch , & ! Input: [real(r8) (:)] avg pft rainfall for last 24 hrs + rh24 => atm2lnd_inst%rh24_patch & ! Input: [real(r8) (:)] avg pft relative humidity for last 24 hrs + ) + + ! NOTE: t_veg24(:), prec24(:) and rh24(:) are p level temperatures, precipitation and RH, + ! which probably won't have much inpact, unless we decide to ever calculated the NI for each patch. + + temp_in_C = t_veg24(currentSite%oldest_patch%clm_pno) - tfrz + rainfall = prec24(currentSite%oldest_patch%clm_pno) *24.0_r8*3600._r8 + rh = rh24(currentSite%oldest_patch%clm_pno) + + if (rainfall > 3.0_r8) then !rezero NI if it rains... + d_NI = 0.0_r8 + currentSite%acc_NI = 0.0_r8 + else + yipsolon = (SF_val_fdi_a* temp_in_C)/(SF_val_fdi_b+ temp_in_C)+log(rh/100.0_r8) + dewpoint = (SF_val_fdi_b*yipsolon)/(SF_val_fdi_a-yipsolon) !Standard met. formula + d_NI = ( temp_in_C-dewpoint)* temp_in_C !follows Nesterov 1968. Equation 5. Thonicke et al. 2010. + if (d_NI < 0.0_r8) then !Change in NI cannot be negative. + d_NI = 0.0_r8 !check + endif + endif + currentSite%acc_NI = currentSite%acc_NI + d_NI !Accumulate Nesterov index over the fire season. + + end associate + + end subroutine fire_danger_index + + + !***************************************************************** + subroutine charecteristics_of_fuel ( currentSite ) + !***************************************************************** + + use SFParamsMod, only : SF_val_alpha_FMC, SF_val_SAV, SF_val_FBD + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + real(r8) timeav_swc + real(r8) fuel_moisture(ncwd+2) ! Scaled moisture content of small litter fuels. + real(r8) MEF(ncwd+2) ! Moisture extinction factor of fuels integer n + + fuel_moisture(:) = 0.0_r8 + + currentPatch => currentSite%oldest_patch; + do while(associated(currentPatch)) + ! How much live grass is there? + currentPatch%livegrass = 0.0_r8 + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + if(pftcon%woody(currentCohort%pft) == 0)then + currentPatch%livegrass = currentPatch%livegrass + currentCohort%bl*currentCohort%n/currentPatch%area + endif + currentCohort => currentCohort%shorter + enddo + + ! There are SIX fuel classes + ! 1) Leaf litter, 2:5) four CWD_AG pools (twig, s branch, l branch, trunk) and 6) live grass + ! NCWD =4 + ! dg_sf = 1, lb_sf, = 4, tr_sf = 5, lg_sf = 6, + + ! zero fire arrays. + currentPatch%fuel_eff_moist = 0.0_r8 + currentPatch%fuel_bulkd = 0.0_r8 + currentPatch%fuel_sav = 0.0_r8 + currentPatch%fuel_frac(:) = 0.0_r8 + currentPatch%fuel_mef = 0.0_r8 + currentPatch%sum_fuel = 0.0_r8 + currentPatch%fuel_frac = 0.0_r8 + + if(write_sf == 1)then + if (masterproc) write(iulog,*) ' leaf_litter1 ',currentPatch%leaf_litter + if (masterproc) write(iulog,*) ' leaf_litter2 ',sum(currentPatch%CWD_AG) + if (masterproc) write(iulog,*) ' leaf_litter3 ',currentPatch%livegrass + if (masterproc) write(iulog,*) ' sum fuel', currentPatch%sum_fuel + endif + + currentPatch%sum_fuel = sum(currentPatch%leaf_litter) + sum(currentPatch%CWD_AG) + currentPatch%livegrass + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'sum fuel', currentPatch%sum_fuel,currentPatch%area + endif + ! =============================================== + ! Average moisture, bulk density, surface area-volume and moisture extinction of fuel + ! ================================================ + + if (currentPatch%sum_fuel > 0.0) then + ! Fraction of fuel in litter classes + currentPatch%fuel_frac(dg_sf) = sum(currentPatch%leaf_litter)/ currentPatch%sum_fuel + currentPatch%fuel_frac(dg_sf+1:tr_sf) = currentPatch%CWD_AG / currentPatch%sum_fuel + + if(write_sf == 1)then + if (masterproc) write(iulog,*) 'ff1 ',currentPatch%fuel_frac + if (masterproc) write(iulog,*) 'ff2 ',currentPatch%fuel_frac + if (masterproc) write(iulog,*) 'ff2a ',lg_sf,currentPatch%livegrass,currentPatch%sum_fuel + endif + + currentPatch%fuel_frac(lg_sf) = currentPatch%livegrass / currentPatch%sum_fuel + MEF(1:ncwd+2) = 0.524_r8 - 0.066_r8 * log10(SF_val_SAV(1:ncwd+2)) + + !Equation 6 in Thonicke et al. 2010. + fuel_moisture(dg_sf+1:tr_sf) = exp(-1.0_r8 * SF_val_alpha_FMC(dg_sf+1:tr_sf) * currentSite%acc_NI) + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'ff3 ',currentPatch%fuel_frac + if (masterproc) write(iulog,*) 'fm ',fuel_moisture + if (masterproc) write(iulog,*) 'csa ',currentSite%acc_NI + if (masterproc) write(iulog,*) 'sfv ',SF_val_alpha_FMC + endif + ! FIX(RF,032414): needs refactoring. + ! average water content !is this the correct metric? + timeav_swc = sum(currentSite%water_memory(1:10)) / 10._r8 + ! Equation B2 in Thonicke et al. 2010 + fuel_moisture(dg_sf) = max(0.0_r8, 10.0_r8/9._r8 * timeav_swc - 1.0_r8/9.0_r8) + + ! Average properties over the first four litter pools (dead leaves, twigs, s branches, l branches) + currentPatch%fuel_bulkd = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * SF_val_FBD(dg_sf:lb_sf)) + currentPatch%fuel_sav = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * SF_val_SAV(dg_sf:lb_sf)) + currentPatch%fuel_mef = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * MEF(dg_sf:lb_sf)) + currentPatch%fuel_eff_moist = sum(currentPatch%fuel_frac(dg_sf:lb_sf) * fuel_moisture(dg_sf:lb_sf)) + if(write_sf == 1)then + if (masterproc) write(iulog,*) 'ff4 ',currentPatch%fuel_eff_moist + endif + ! Add on properties of live grass multiplied by grass fraction. (6) + currentPatch%fuel_bulkd = currentPatch%fuel_bulkd + currentPatch%fuel_frac(lg_sf) * SF_val_FBD(lg_sf) + currentPatch%fuel_sav = currentPatch%fuel_sav + currentPatch%fuel_frac(lg_sf) * SF_val_SAV(lg_sf) + currentPatch%fuel_mef = currentPatch%fuel_mef + currentPatch%fuel_frac(lg_sf) * MEF(lg_sf) + currentPatch%fuel_eff_moist = currentPatch%fuel_eff_moist + currentPatch%fuel_frac(lg_sf) * fuel_moisture(lg_sf) + + ! Correct averaging for the fact that we are not using the trunks pool (5) + currentPatch%fuel_bulkd = currentPatch%fuel_bulkd * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) + currentPatch%fuel_sav = currentPatch%fuel_sav * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) + currentPatch%fuel_mef = currentPatch%fuel_mef * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) + currentPatch%fuel_eff_moist = currentPatch%fuel_eff_moist * (1.0_r8/(1.0_r8-currentPatch%fuel_frac(tr_sf))) + + ! Convert from biomass to carbon. Which variables is this needed for? + currentPatch%fuel_bulkd = currentPatch%fuel_bulkd * 0.45_r8 + + ! Pass litter moisture into the fuel burning routine + ! (wo/me term in Thonicke et al. 2010) + currentPatch%litter_moisture(dg_sf:lb_sf) = fuel_moisture(dg_sf:lb_sf)/MEF(dg_sf:lb_sf) + currentPatch%litter_moisture(tr_sf) = 0.0_r8 + currentPatch%litter_moisture(lg_sf) = fuel_moisture(lg_sf)/MEF(lg_sf) + + else + + if(write_SF == 1)then + + if (masterproc) write(iulog,*) 'no litter fuel at all',currentPatch%patchno, & + currentPatch%sum_fuel,sum(currentPatch%cwd_ag), & + sum(currentPatch%cwd_bg),sum(currentPatch%leaf_litter) + + endif + currentPatch%fuel_sav = sum(SF_val_SAV(1:ncwd+2))/(ncwd+2) ! make average sav to avoid crashing code. + + if (masterproc) write(iulog,*) 'problem with spitfire fuel averaging' + + ! FIX(SPM,032414) refactor...should not have 0 fuel unless everything is burnt + ! off. + currentPatch%fuel_eff_moist = 0.0000000001_r8 + currentPatch%fuel_bulkd = 0.0000000001_r8 + currentPatch%fuel_frac(:) = 0.0000000001_r8 + currentPatch%fuel_mef = 0.0000000001_r8 + currentPatch%sum_fuel = 0.0000000001_r8 + currentPatch%fuel_frac = 0.0000000001_r8 + + endif + ! check values. + ! FIX(SPM,032414) refactor... + if(write_SF == 1.and.currentPatch%fuel_sav <= 0.0_r8.or.currentPatch%fuel_bulkd <= & + 0.0_r8.or.currentPatch%fuel_mef <= 0.0_r8.or.currentPatch%fuel_eff_moist <= 0.0_r8)then + if (masterproc) write(iulog,*) 'problem with spitfire fuel averaging' + endif + + currentPatch => currentPatch%younger + + enddo !end patch loop + + end subroutine charecteristics_of_fuel + + + !***************************************************************** + subroutine wind_effect ( currentSite, atm2lnd_inst) + !*****************************************************************. + + ! Routine called daily from within ED within a site loop. + ! Calculates the effective windspeed based on vegetation charecteristics. + + type(ed_site_type) , intent(inout), target :: currentSite + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + ! note - this is a p level temperature, which probably won't have much inpact, + ! unless we decide to ever calculated the NI for each patch. + real(r8), pointer :: wind24(:) + + real(r8) :: wind ! daily wind + real(r8) :: total_grass_area ! per patch,in m2 + real(r8) :: tree_fraction ! site level. no units + real(r8) :: grass_fraction ! site level. no units + real(r8) :: bare_fraction ! site level. no units + + wind24 => atm2lnd_inst%wind24_patch ! Input: [real(r8) (:)] avg pft windspeed (m/s) + + wind = wind24(currentSite%oldest_patch%clm_pno) * 60._r8 ! Convert to m/min for SPITFIRE units. + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'wind24', wind24(currentSite%oldest_patch%clm_pno) + endif + ! --- influence of wind speed, corrected for surface roughness---- + ! --- averaged over the whole grid cell to prevent extreme divergence + ! average_wspeed = 0.0_r8 + tree_fraction = 0.0_r8 + grass_fraction = 0.0_r8 + currentPatch=>currentSite%oldest_patch; + do while(associated(currentPatch)) + currentPatch%total_tree_area = 0.0_r8 + total_grass_area = 0.0_r8 + currentCohort => currentPatch%tallest + + do while(associated(currentCohort)) + write(iulog,*) 'SF currentCohort%c_area ',currentCohort%c_area + if(pftcon%woody(currentCohort%pft) == 1)then + currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area + else + total_grass_area = total_grass_area + currentCohort%c_area + endif + currentCohort => currentCohort%shorter + enddo + tree_fraction = tree_fraction + min(currentPatch%area,currentPatch%total_tree_area)/AREA + grass_fraction = grass_fraction + min(currentPatch%area,total_grass_area)/AREA + + if(DEBUG)then + !write(iulog,*) 'SF currentPatch%area ',currentPatch%area + !write(iulog,*) 'SF currentPatch%total_area ',currentPatch%total_tree_area + !write(iulog,*) 'SF total_grass_area ',tree_fraction,grass_fraction + !write(iulog,*) 'SF AREA ',AREA + endif + + currentPatch => currentPatch%younger + enddo !currentPatch loop + + !if there is a cover of more than one, then the grasses are under the trees + grass_fraction = min(grass_fraction,1.0_r8-tree_fraction) + bare_fraction = 1.0 - tree_fraction - grass_fraction + if(write_sf == 1)then + if (masterproc) write(iulog,*) 'grass, trees, bare',grass_fraction, tree_fraction, bare_fraction + endif + + currentPatch=>currentSite%oldest_patch; + + do while(associated(currentPatch)) + currentPatch%total_tree_area = min(currentPatch%total_tree_area,currentPatch%area) + currentPatch%effect_wspeed = wind * (tree_fraction*0.6+grass_fraction*0.4+bare_fraction*1.0) + + currentPatch => currentPatch%younger + enddo !end patch loop + + end subroutine wind_effect + + !***************************************************************** + subroutine rate_of_spread ( currentSite ) + !*****************************************************************. + !Routine called daily from within ED within a site loop. + !Returns the updated currentPatch%ROS_front value for each patch. + + use SFParamsMod, only : SF_val_miner_total, SF_val_part_dens, & + SF_val_miner_damp, SF_val_fuel_energy + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + + real(r8) dummy + + ! Rothermal fire spread model parameters. + real(r8) beta + real(r8) ir !reaction intensity + real(r8) xi,eps,q_ig,phi_wind + real(r8) gamma_aptr,gamma_max + real(r8) moist_damp,mw_weight + real(r8) bet,beta_op + real(r8) a,b,c,e + + currentPatch=>currentSite%oldest_patch; + + do while(associated(currentPatch)) + + ! ---initialise parameters to zero.--- + bet = 0.0_r8; q_ig = 0.0_r8; eps = 0.0_r8; a = 0.0_r8; b = 0.0_r8; c = 0.0_r8; e = 0.0_r8 + phi_wind = 0.0_r8; xi = 0.0_r8; gamma_max = 0.0_r8; gamma_aptr = 0.0_r8; mw_weight = 0.0_r8 + moist_damp = 0.0_r8; ir = 0.0_r8; dummy = 0.0_r8; + currentPatch%ROS_front = 0.0_r8 + currentPatch%sum_fuel = currentPatch%sum_fuel * (1.0_r8 - SF_val_miner_total) !net of minerals + + ! ----start spreading--- + if (masterproc.and.DEBUG) write(iulog,*) 'SF - currentPatch%fuel_bulkd ',currentPatch%fuel_bulkd + if (masterproc.and.DEBUG) write(iulog,*) 'SF - SF_val_part_dens ',SF_val_part_dens + + beta = (currentPatch%fuel_bulkd / 0.45_r8) / SF_val_part_dens + + ! Equation A6 in Thonicke et al. 2010 + beta_op = 0.200395_r8 *(currentPatch%fuel_sav**(-0.8189_r8)) + if (masterproc.and.DEBUG) write(iulog,*) 'SF - beta ',beta + if (masterproc.and.DEBUG) write(iulog,*) 'SF - beta_op ',beta_op + bet = beta/beta_op + if(write_sf == 1)then + if (masterproc) write(iulog,*) 'esf ',currentPatch%fuel_eff_moist + endif + ! ---heat of pre-ignition--- + ! Equation A4 in Thonicke et al. 2010 + q_ig = 581.0_r8 +2594.0_r8 * currentPatch%fuel_eff_moist + + ! ---effective heating number--- + ! Equation A3 in Thonicke et al. 2010. + eps = exp(-4.528_r8 / currentPatch%fuel_sav) + ! Equation A7 in Thonicke et al. 2010 + b = 0.15988_r8 * (currentPatch%fuel_sav**0.54_r8) + ! Equation A8 in Thonicke et al. 2010 + c = 7.47_r8 * (exp(-0.8711_r8 * (currentPatch%fuel_sav**0.55_r8))) + ! Equation A9 in Thonicke et al. 2010. + e = 0.715_r8 * (exp(-0.01094_r8 * currentPatch%fuel_sav)) + ! Equation A5 in Thonicke et al. 2010 + + if (DEBUG) then + if (masterproc.and.DEBUG) write(iulog,*) 'SF - c ',c + if (masterproc.and.DEBUG) write(iulog,*) 'SF - currentPatch%effect_wspeed ',currentPatch%effect_wspeed + if (masterproc.and.DEBUG) write(iulog,*) 'SF - b ',b + if (masterproc.and.DEBUG) write(iulog,*) 'SF - bet ',bet + if (masterproc.and.DEBUG) write(iulog,*) 'SF - e ',e + endif + + ! convert from m/min to ft/min for Rothermel ROS eqn + phi_wind = c * ((3.281_r8*currentPatch%effect_wspeed)**b)*(bet**(-e)) + + ! ---propagating flux---- + ! Equation A2 in Thonicke et al. + + xi = (exp((0.792_r8 + 3.7597_r8 * (currentPatch%fuel_sav**0.5_r8)) * (beta+0.1_r8))) / & + (192_r8+7.9095_r8 * currentPatch%fuel_sav) + + ! ---reaction intensity---- + ! Equation in table A1 Thonicke et al. 2010. + a = 8.9033_r8 * (currentPatch%fuel_sav**(-0.7913_r8)) + dummy = exp(a*(1-bet)) + ! Equation in table A1 Thonicke et al. 2010. + gamma_max = 1.0_r8 / (0.0591_r8 + 2.926_r8* (currentPatch%fuel_sav**(-1.5_r8))) + gamma_aptr = gamma_max*(bet**a)*dummy + + mw_weight = currentPatch%fuel_eff_moist/currentPatch%fuel_mef + + ! Equation in table A1 Thonicke et al. 2010. + moist_damp = max(0.0_r8,(1.0_r8 - (2.59_r8 * mw_weight) + (5.11_r8 * (mw_weight**2.0_r8)) - & + (3.52_r8*(mw_weight**3.0_r8)))) + + ! FIX(SPM, 040114) ask RF if this should be an endrun + ! if(write_SF == 1)then + ! write(iulog,*) 'moist_damp' ,moist_damp,mw_weight,currentPatch%fuel_eff_moist,currentPatch%fuel_mef + ! endif + + ir = gamma_aptr*(currentPatch%sum_fuel/0.45_r8)*SF_val_fuel_energy*moist_damp*SF_val_miner_damp + ! currentPatch%sum_fuel needs to be converted from kgC/m2 to kgBiomass/m2 + ! write(iulog,*) 'ir',gamma_aptr,moist_damp,SF_val_fuel_energy,SF_val_miner_damp + if (((currentPatch%fuel_bulkd/0.45_r8) <= 0.0_r8).or.(eps <= 0.0_r8).or.(q_ig <= 0.0_r8)) then + currentPatch%ROS_front = 0.0_r8 + else ! Equation 9. Thonicke et al. 2010. + currentPatch%ROS_front = (ir*xi*(1.0_r8+phi_wind)) / (currentPatch%fuel_bulkd/0.45_r8*eps*q_ig) + ! write(iulog,*) 'ROS',currentPatch%ROS_front,phi_wind,currentPatch%effect_wspeed + ! write(iulog,*) 'ros calcs',currentPatch%fuel_bulkd,ir,xi,eps,q_ig + endif + ! Equation 10 in Thonicke et al. 2010 + ! Can FBP System in m/min + currentPatch%ROS_back = currentPatch%ROS_front*exp(-0.012_r8*currentPatch%effect_wspeed) + + currentPatch => currentPatch%younger + + enddo !end patch loop + + end subroutine rate_of_spread + + !***************************************************************** + subroutine ground_fuel_consumption ( currentSite ) + !***************************************************************** + !returns the the hypothetic fuel consumed by the fire + + use SFParamsMod, only : SF_val_miner_total, SF_val_min_moisture, & + SF_val_mid_moisture, SF_val_low_moisture_C, SF_val_low_moisture_S, & + SF_val_mid_moisture_C, SF_val_mid_moisture_S + + type(ed_site_type) , intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + + real(r8) :: moist !effective fuel moisture + real(r8) :: tau_b(ncwd+2) !lethal heating rates for each fuel class (min) + real(r8) :: fc_ground(ncwd+2) !propn of fuel consumed + + integer :: c + + currentPatch => currentSite%oldest_patch; + + do while(associated(currentPatch)) + currentPatch%burnt_frac_litter = 1.0_r8 + ! Calculate fraction of litter is burnt for all classes. + ! Equation B1 in Thonicke et al. 2010--- + do c = 1, ncwd+2 !work out the burnt fraction for all pools, even if those pools dont exist. + moist = currentPatch%litter_moisture(c) + ! 1. Very dry litter + if (moist <= SF_val_min_moisture(c)) then + currentPatch%burnt_frac_litter(c) = 1.0_r8 + endif + ! 2. Low to medium moistures + if (moist > SF_val_min_moisture(c).and.moist <= SF_val_mid_moisture(c)) then + currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_low_moisture_C(c)- & + SF_val_low_moisture_S(c)*moist)) + else + ! For medium to high moistures. + if (moist > SF_val_mid_moisture(c).and.moist <= 1.0_r8) then + currentPatch%burnt_frac_litter(c) = max(0.0_r8,min(1.0_r8,SF_val_mid_moisture_C(c)- & + SF_val_mid_moisture_S(c)*moist)) + endif + + endif + ! Very wet litter + if (moist >= 1.0_r8) then !this shouldn't happen? + currentPatch%burnt_frac_litter(c) = 0.0_r8 + endif + enddo !c + + ! we can't ever kill -all- of the grass. + currentPatch%burnt_frac_litter(lg_sf) = min(0.8_r8,currentPatch%burnt_frac_litter(lg_sf )) + ! reduce burnt amount for mineral content. + currentPatch%burnt_frac_litter = currentPatch%burnt_frac_litter * (1.0_r8-SF_val_miner_total) + + !---Calculate amount of fuel burnt.--- + FC_ground(dg_sf) = currentPatch%burnt_frac_litter(dg_sf) * sum(currentPatch%leaf_litter) + FC_ground(2:tr_sf) = currentPatch%burnt_frac_litter(2:tr_sf) * currentPatch%CWD_AG + FC_ground(lg_sf) = currentPatch%burnt_frac_litter(lg_sf) * currentPatch%livegrass + + ! Following used for determination of cambial kill follows from Peterson & Ryan (1986) scheme + ! less empirical cf current scheme used in SPITFIRE which attempts to mesh Rothermel + ! and P&R, and while solving potential inconsistencies, actually results in BIG values for + ! fire residence time, thus lots of vegetation death! + ! taul is the duration of the lethal heating. + ! The /10 is to convert from kgC/m2 into gC/cm2, as in the Peterson and Ryan paper #Rosie,Jun 2013 + + do c = 1,ncwd+2 + tau_b(c) = 39.4_r8 *(currentPatch%fuel_frac(c)*currentPatch%sum_fuel/0.45_r8/10._r8)* & + (1.0_r8-((1.0_r8-currentPatch%burnt_frac_litter(c))**0.5_r8)) + enddo + tau_b(tr_sf) = 0.0_r8 + ! Cap the residence time to 8mins, as suggested by literature survey by P&R (1986). + currentPatch%tau_l = min(8.0_r8,sum(tau_b)) + + !---calculate overall fuel consumed by spreading fire --- + ! ignore 1000hr fuels. Just interested in fuels affecting ROS + currentPatch%TFC_ROS = sum(FC_ground)-FC_ground(tr_sf) + + currentPatch=>currentPatch%younger; + enddo !end patch loop + + end subroutine ground_fuel_consumption + + !***************************************************************** + subroutine fire_intensity ( currentSite ) + !***************************************************************** + !returns the updated currentPatch%FI value for each patch. + + !currentPatch%FI average fire intensity of flaming front during day. Backward ROS plays no role here. kJ/m/s or kW/m. + !currentPatch%ROS_front forward ROS (m/min) + !currentPatch%TFC_ROS total fuel consumed by flaming front (kgC/m2) + + use clm_varctl, only : use_ed_spit_fire + use SFParamsMod, only : SF_val_fdi_alpha,SF_val_fuel_energy, & + SF_val_max_durat, SF_val_durat_slope + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + + real(r8) ROS !m/s + real(r8) W ! kgBiomass/m2 + real(r8) :: d_fdi !change in the NI on this day to give fire duration. + + currentPatch => currentSite%oldest_patch; + + do while(associated(currentPatch)) + ROS = currentPatch%ROS_front / 60.0_r8 !m/min to m/sec + W = currentPatch%TFC_ROS / 0.45_r8 !kgC/m2 to kgbiomass/m2 + currentPatch%FI = SF_val_fuel_energy * W * ROS !kj/m/s, or kW/m + if(write_sf == 1)then + if(masterproc) write(iulog,*) 'fire_intensity',currentPatch%fi,W,currentPatch%ROS_front + endif + !'decide_fire' subroutine shortened and put in here... + if (currentPatch%FI >= fire_threshold) then ! 50kW/m is the threshold for a self-sustaining fire + currentPatch%fire = 1 ! Fire... :D + + ! This is like but not identical to equation 7 in Thonicke et al. 2010. WHY? + d_FDI = 1.0_r8 - exp(-SF_val_fdi_alpha*currentSite%acc_NI) !follows Venevsky et al GCB 2002 + ! Equation 14 in Thonicke et al. 2010 + currentPatch%FD = SF_val_max_durat / (1.0_r8 + SF_val_max_durat * exp(SF_val_durat_slope*d_FDI)) + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'fire duration minutes',currentPatch%fd + endif + !equation 15 in Arora and Boer CTEM model.Average fire is 1 day long. + !currentPatch%FD = 60.0_r8 * 24.0_r8 !no minutes in a day + else + currentPatch%fire = 0 ! No fire... :-/ + currentPatch%FD = 0.0_r8 + endif + ! FIX(SPM,032414) needs a refactor + ! FIX(RF,032414) : should happen outside of SF loop - doing all spitfire code is inefficient otherwise. + if(.not. use_ed_spit_fire)then + currentPatch%fire = 0 !fudge to turn fire off + endif + + currentPatch => currentPatch%younger; + enddo !end patch loop + + end subroutine fire_intensity + + + !***************************************************************** + subroutine area_burnt ( currentSite ) + !***************************************************************** + !currentPatch%AB daily area burnt (m2) + !currentPatch%NF !Daily number of ignitions (lightning and human-caused), adjusted for size of patch. + + use domainMod, only : ldomain + use EDParamsMod, only : ED_val_nfires + + type(ed_site_type), intent(inout), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + + real lb !length to breadth ratio of fire ellipse + real df !distance fire has travelled forward + real db !distance fire has travelled backward + real(r8) gridarea + real(r8) size_of_fire + integer g + + currentSite%frac_burnt = 0.0_r8 + + currentPatch => currentSite%oldest_patch; + do while(associated(currentPatch)) + currentPatch%AB = 0.0_r8 + currentPatch%frac_burnt = 0.0_r8 + lb = 0.0_r8; db = 0.0_r8; df = 0.0_r8 + + if (currentPatch%fire == 1) then + ! The feedback between vegetation structure and ellipse size if turned off for now, + ! to reduce the positive feedback in the syste, + ! This will also be investigated by William Hoffmans proposal. + ! if (currentPatch%effect_wspeed < 16.67_r8) then !16.67m/min = 1km/hr + lb = 1.0_r8 + ! else + !FIX(RF,032414) FOR NO GRASS + ! lb = currentPatch%total_canopy_area/currentPatch%area*(1.0_r8)+(8.729_r8 * & + ! ((1.0_r8 -(exp(-0.03_r8 * 0.06_r8 * currentPatch%effect_wspeed)))**2.155_r8)) !& + !& +currentPatch%fpc_grass*(1.1_r8+((0.06_r8*currentPatch%effect_wspeed)**0.0464)) + + ! endif + + ! if (lb > 8.0_r8)then + ! lb = 8.0_r8 !Constraint Canadian Fire Behaviour System + ! endif + ! ---- calculate length of major axis--- + db = currentPatch%ROS_back * currentPatch%FD !m + df = currentPatch%ROS_front * currentPatch%FD !m + + ! --- calculate area burnt--- + if(lb > 0.0_r8) then + g = currentSite%clmgcell + gridarea = ldomain%area(g) *1000000.0_r8 !convert from km2 into m2 + currentPatch%NF = ldomain%area(g) * ED_val_nfires * currentPatch%area/area /365 + ! If there are 15 lightening strickes per year, per km2. (approx from NASA product) + ! then there are 15/365 s/km2 each day. + + ! Equation 1 in Thonicke et al. 2010 + ! To Do: Connect here with the Li & Levis GDP fire suppression algorithm. + ! Equation 16 in arora and boer model. + !currentPatch%ab = currentPatch%ab *3.0_r8 + size_of_fire = ((3.1416_r8/(4.0_r8*lb))*((df+db)**2.0_r8)) + currentPatch%AB = size_of_fire * currentPatch%nf + if (currentPatch%AB > gridarea*currentPatch%area/area) then !all of patch burnt. + + if (masterproc) write(iulog,*) 'burnt all of patch',currentPatch%patchno, & + currentPatch%area/area,currentPatch%ab,currentPatch%area/area*gridarea + if (masterproc) write(iulog,*) 'ros',currentPatch%ROS_front,currentPatch%FD, & + currentPatch%NF,currentPatch%FI,size_of_fire + + if (masterproc) write(iulog,*) 'litter',currentPatch%sum_fuel,currentPatch%CWD_AG,currentPatch%leaf_litter + ! turn km2 into m2. work out total area burnt. + currentPatch%AB = currentPatch%area * gridarea/AREA + endif + currentPatch%frac_burnt = currentPatch%AB / (gridarea*currentPatch%area/area) + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'frac_burnt',currentPatch%frac_burnt + endif + endif + endif! fire + currentSite%frac_burnt = currentSite%frac_burnt + currentPatch%frac_burnt + + currentPatch => currentPatch%younger; + + enddo !end patch loop + + end subroutine area_burnt + + !***************************************************************** + subroutine crown_scorching ( currentSite ) + !***************************************************************** + !currentPatch%SH !average scorch height for the patch(m) + !currentPatch%FI average fire intensity of flaming front during day. kW/m. + + use SFParamsMod, only : SF_val_alpha_SH + use EDParamsMod, only : ED_val_ag_biomass + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + real f_ag_bmass !fraction of a tree cohort's above-ground biomass as a proportion of total patch ag tree biomass. + real tree_ag_biomass !total amount of above-ground tree biomass in patch. kgC/m2 + + currentPatch => currentSite%oldest_patch; + do while(associated(currentPatch)) + + tree_ag_biomass = 0.0_r8 + f_ag_bmass = 0.0_r8 + if (currentPatch%fire == 1) then + currentCohort => currentPatch%tallest; + do while(associated(currentCohort)) + if (pftcon%woody(currentCohort%pft) == 1) then !trees only + tree_ag_biomass = tree_ag_biomass+(currentCohort%bl+ED_val_ag_biomass* & + (currentCohort%bsw + currentCohort%bdead))*currentCohort%n + endif !trees only + + currentCohort=>currentCohort%shorter; + + enddo !end cohort loop + + !This loop weights the scorch height for the contribution of each cohort to the overall biomass. + currentPatch%SH = 0.0_r8 + currentCohort => currentPatch%tallest; + do while(associated(currentCohort)) + if (pftcon%woody(currentCohort%pft) == 1.and.(tree_ag_biomass > 0.0_r8)) then !trees only + f_ag_bmass = ((currentCohort%bl+ED_val_ag_biomass*(currentCohort%bsw + & + currentCohort%bdead))*currentCohort%n)/tree_ag_biomass + !equation 16 in Thonicke et al. 2010 + if(write_SF == 1)then + if (masterproc) write(iulog,*) 'currentPatch%SH',currentPatch%SH,f_ag_bmass + endif + !2/3 Byram (1959) + currentPatch%SH = currentPatch%SH + f_ag_bmass * SF_val_alpha_SH * (currentPatch%FI**0.667_r8) + endif !trees only + currentCohort=>currentCohort%shorter; + enddo !end cohort loop + endif !fire + + currentPatch => currentPatch%younger; + enddo !end patch loop + + end subroutine crown_scorching + + !***************************************************************** + subroutine crown_damage ( currentSite ) + !***************************************************************** + + !returns the updated currentCohort%cfa value for each tree cohort within each patch. + !currentCohort%cfa proportion of crown affected by fire + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + currentPatch => currentSite%oldest_patch + + do while(associated(currentPatch)) + if (currentPatch%fire == 1) then + + currentCohort=>currentPatch%tallest + + do while(associated(currentCohort)) + currentCohort%cfa = 0.0_r8 + if (pftcon%woody(currentCohort%pft) == 1) then !trees only + ! Flames lower than bottom of canopy. + ! c%hite is height of cohort + if (currentPatch%SH < (currentCohort%hite-currentCohort%hite*EDecophyscon%crown(currentCohort%pft))) then + currentCohort%cfa = 0.0_r8 + else + ! Flames part of way up canopy. + ! Equation 17 in Thonicke et al. 2010. + ! flames over bottom of canopy but not over top. + if ((currentCohort%hite > 0.0_r8).and.(currentPatch%SH >= & + (currentCohort%hite-currentCohort%hite*EDecophyscon%crown(currentCohort%pft)))) then + + currentCohort%cfa = (currentPatch%SH-currentCohort%hite* & + EDecophyscon%crown(currentCohort%pft))/(currentCohort%hite-currentCohort%hite* & + EDecophyscon%crown(currentCohort%pft)) + + else + ! Flames over top of canopy. + currentCohort%cfa = 1.0_r8 + endif + + endif + ! Check for strange values. + currentCohort%cfa = min(1.0_r8, max(0.0_r8,currentCohort%cfa)) + endif !trees only + !shrink canopy to account for burnt section. + !currentCohort%canopy_trim = min(currentCohort%canopy_trim,(1.0_r8-currentCohort%cfa)) + + currentCohort => currentCohort%shorter; + + enddo !end cohort loop + endif !fire? + + currentPatch => currentPatch%younger; + + enddo !end patch loop + + end subroutine crown_damage + + !***************************************************************** + subroutine cambial_damage_kill ( currentSite ) + !***************************************************************** + ! routine description. + ! returns the probability that trees dies due to cambial char + ! currentPatch%tau_l = duration of lethal stem heating (min). Calculated at patch level. + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + real(r8) :: tau_c !critical time taken to kill cambium (minutes) + real(r8) :: bt !bark thickness in cm. + + currentPatch => currentSite%oldest_patch; + + do while(associated(currentPatch)) + + if (currentPatch%fire == 1) then + currentCohort => currentPatch%tallest; + do while(associated(currentCohort)) + if (pftcon%woody(currentCohort%pft) == 1) then !trees only + ! Equation 21 in Thonicke et al 2010 + bt = EDecophyscon%bark_scaler(currentCohort%pft)*currentCohort%dbh ! bark thickness. + ! Equation 20 in Thonicke et al. 2010. + tau_c = 2.9_r8*bt**2.0_r8 !calculate time it takes to kill cambium (min) + ! Equation 19 in Thonicke et al. 2010 + if ((currentPatch%tau_l/tau_c) >= 2.0_r8) then + currentCohort%cambial_mort = 1.0_r8 + else + if ((currentPatch%tau_l/tau_c) > 0.22_r8) then + currentCohort%cambial_mort = (0.563_r8*(currentPatch%tau_l/tau_c)) - 0.125_r8 + else + currentCohort%cambial_mort = 0.0_r8 + endif + endif + endif !trees + + currentCohort => currentCohort%shorter; + + enddo !end cohort loop + endif !fire? + + currentPatch=>currentPatch%younger; + + enddo !end patch loop + + end subroutine cambial_damage_kill + + !***************************************************************** + subroutine post_fire_mortality ( currentSite ) + !***************************************************************** + + ! returns the updated currentCohort%fire_mort value for each tree cohort within each patch. + ! currentCohort%cfa proportion of crown affected by fire + ! currentCohort%crownfire_mort probability of tree post-fire mortality due to crown scorch + ! currentCohort%cambial_mort probability of tree post-fire mortality due to cambial char + ! currentCohort%fire_mort post-fire mortality from cambial and crown damage assuming two are independent. + + type(ed_site_type), intent(in), target :: currentSite + + type(ed_patch_type), pointer :: currentPatch + type(ed_cohort_type), pointer :: currentCohort + + currentPatch => currentSite%oldest_patch + + do while(associated(currentPatch)) + + if (currentPatch%fire == 1) then + currentCohort => currentPatch%tallest + do while(associated(currentCohort)) + currentCohort%fire_mort = 0.0_r8 + currentCohort%crownfire_mort = 0.0_r8 + if (pftcon%woody(currentCohort%pft) == 1) then + ! Equation 22 in Thonicke et al. 2010. + currentCohort%crownfire_mort = EDecophyscon%crown_kill(currentCohort%pft)*currentCohort%cfa**3.0_r8 + ! Equation 18 in Thonicke et al. 2010. + currentCohort%fire_mort = currentCohort%crownfire_mort+currentCohort%cambial_mort- & + (currentCohort%crownfire_mort*currentCohort%cambial_mort) !joint prob. + else + currentCohort%fire_mort = 0.0_r8 !I have changed this to zero and made the mode of death removal of leaves... + endif !trees + + currentCohort => currentCohort%shorter + + enddo !end cohort loop + endif !fire? + + currentPatch => currentPatch%younger + + enddo !end patch loop + + end subroutine post_fire_mortality + + ! ============================================================================ +end module SFMainMod diff --git a/components/clm/src/ED/fire/SFParamsMod.F90 b/components/clm/src/ED/fire/SFParamsMod.F90 new file mode 100644 index 0000000000..3caa526a01 --- /dev/null +++ b/components/clm/src/ED/fire/SFParamsMod.F90 @@ -0,0 +1,212 @@ +module SFParamsMod + ! + ! module that deals with reading the SF parameter file + ! + use shr_kind_mod , only: r8 => shr_kind_r8 + use EDtypesMod , only: NLSC,NFSC,NCWD + + implicit none + save + ! private - if we allow this module to be private, it does not allow the protected values below to be + ! seen outside of this module. + + ! + ! this is what the user can use for the actual values + ! + real(r8),protected :: SF_val_fdi_a + real(r8),protected :: SF_val_fdi_b + real(r8),protected :: SF_val_fdi_alpha + real(r8),protected :: SF_val_miner_total + real(r8),protected :: SF_val_fuel_energy + real(r8),protected :: SF_val_part_dens + real(r8),protected :: SF_val_miner_damp + real(r8),protected :: SF_val_max_durat + real(r8),protected :: SF_val_durat_slope + real(r8),protected :: SF_val_alpha_SH + real(r8),protected :: SF_val_alpha_FMC(NLSC) + real(r8),protected :: SF_val_CWD_frac(NCWD) + real(r8),protected :: SF_val_max_decomp(NLSC) + real(r8),protected :: SF_val_SAV(NFSC) + real(r8),protected :: SF_val_FBD(NFSC) + real(r8),protected :: SF_val_min_moisture(NFSC) + real(r8),protected :: SF_val_mid_moisture(NFSC) + real(r8),protected :: SF_val_low_moisture_C(NFSC) + real(r8),protected :: SF_val_low_moisture_S(NFSC) + real(r8),protected :: SF_val_mid_moisture_C(NFSC) + real(r8),protected :: SF_val_mid_moisture_S(NFSC) + + character(len=20),parameter :: SF_name_fdi_a = "fdi_a" + character(len=20),parameter :: SF_name_fdi_b = "fdi_b" + character(len=20),parameter :: SF_name_fdi_alpha = "fdi_alpha" + character(len=20),parameter :: SF_name_miner_total = "miner_total" + character(len=20),parameter :: SF_name_fuel_energy = "fuel_energy" + character(len=20),parameter :: SF_name_part_dens = "part_dens" + character(len=20),parameter :: SF_name_miner_damp = "miner_damp" + character(len=20),parameter :: SF_name_max_durat = "max_durat" + character(len=20),parameter :: SF_name_durat_slope = "durat_slope" + character(len=20),parameter :: SF_name_alpha_SH = "alpha_SH" + character(len=20),parameter :: SF_name_alpha_FMC = "alpha_FMC" + character(len=20),parameter :: SF_name_CWD_frac = "CWD_frac" + character(len=20),parameter :: SF_name_max_decomp = "max_decomp" + character(len=20),parameter :: SF_name_SAV = "SAV" + character(len=20),parameter :: SF_name_FBD = "FBD" + character(len=20),parameter :: SF_name_min_moisture = "min_moisture" + character(len=20),parameter :: SF_name_mid_moisture = "mid_moisture" + character(len=20),parameter :: SF_name_low_moisture_C = "low_moisture_C" + character(len=20),parameter :: SF_name_low_moisture_S = "low_moisture_S" + character(len=20),parameter :: SF_name_mid_moisture_C = "mid_moisture_C" + character(len=20),parameter :: SF_name_mid_moisture_S = "mid_moisture_S" + + public :: SFParamsRead + +contains + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine SFParamsRead(ncid) + ! + ! calls to initialize parameter instance and do ncdio read + ! + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + + call SFParamsReadLocal(ncid) + + end subroutine SFParamsRead + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine SFParamsReadLocal(ncid) + ! + ! read the netcdf file and populate internalInstScalar + ! + use ncdio_pio , only : file_desc_t + use paramUtilMod , only : readNcdio + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + + ! local vars + character(len=32) :: subname = 'SFParamsReadLocal::' + + ! + ! call read function + ! + + call readNcdio(ncid = ncid, & + varName=SF_name_fdi_a, & + callingName=subname, & + retVal=SF_val_fdi_a) + + call readNcdio(ncid = ncid, & + varName=SF_name_fdi_b, & + callingName=subname, & + retVal=SF_val_fdi_b) + + call readNcdio(ncid = ncid, & + varName=SF_name_fdi_alpha, & + callingName=subname, & + retVal=SF_val_fdi_alpha) + + call readNcdio(ncid = ncid, & + varName=SF_name_miner_total, & + callingName=subname, & + retVal=SF_val_miner_total) + + call readNcdio(ncid = ncid, & + varName=SF_name_fuel_energy, & + callingName=subname, & + retVal=SF_val_fuel_energy) + + call readNcdio(ncid = ncid, & + varName=SF_name_part_dens, & + callingName=subname, & + retVal=SF_val_part_dens) + + call readNcdio(ncid = ncid, & + varName=SF_name_miner_damp, & + callingName=subname, & + retVal=SF_val_miner_damp) + + call readNcdio(ncid = ncid, & + varName=SF_name_max_durat, & + callingName=subname, & + retVal=SF_val_max_durat) + + call readNcdio(ncid = ncid, & + varName=SF_name_durat_slope, & + callingName=subname, & + retVal=SF_val_durat_slope) + + call readNcdio(ncid = ncid, & + varName=SF_name_alpha_SH, & + callingName=subname, & + retVal=SF_val_alpha_SH) + + call readNcdio(ncid = ncid, & + varName=SF_name_alpha_FMC, & + callingName=subname, & + retVal=SF_val_alpha_FMC) + + call readNcdio(ncid = ncid, & + varName=SF_name_CWD_frac, & + callingName=subname, & + retVal=SF_val_CWD_frac) + + call readNcdio(ncid = ncid, & + varName=SF_name_max_decomp, & + callingName=subname, & + retVal=SF_val_max_decomp) + + call readNcdio(ncid = ncid, & + varName=SF_name_SAV, & + callingName=subname, & + retVal=SF_val_SAV) + + call readNcdio(ncid = ncid, & + varName=SF_name_FBD, & + callingName=subname, & + retVal=SF_val_FBD) + + call readNcdio(ncid = ncid, & + varName=SF_name_min_moisture, & + callingName=subname, & + retVal=SF_val_min_moisture) + + call readNcdio(ncid = ncid, & + varName=SF_name_mid_moisture, & + callingName=subname, & + retVal=SF_val_mid_moisture) + + call readNcdio(ncid = ncid, & + varName=SF_name_low_moisture_C, & + callingName=subname, & + retVal=SF_val_low_moisture_C) + + call readNcdio(ncid = ncid, & + varName=SF_name_low_moisture_S, & + callingName=subname, & + retVal=SF_val_low_moisture_S) + + call readNcdio(ncid = ncid, & + varName=SF_name_mid_moisture_C, & + callingName=subname, & + retVal=SF_val_mid_moisture_C) + + call readNcdio(ncid = ncid, & + varName=SF_name_mid_moisture_S, & + callingName=subname, & + retVal=SF_val_mid_moisture_S) + + end subroutine SFParamsReadLocal + !----------------------------------------------------------------------- + +end module SFParamsMod diff --git a/components/clm/src/ED/main/CMakeLists.txt b/components/clm/src/ED/main/CMakeLists.txt new file mode 100644 index 0000000000..28dbfa2d77 --- /dev/null +++ b/components/clm/src/ED/main/CMakeLists.txt @@ -0,0 +1,8 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources + EDPftvarcon.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/ED/main/EDCLMLinkMod.F90 b/components/clm/src/ED/main/EDCLMLinkMod.F90 new file mode 100755 index 0000000000..5de402f35f --- /dev/null +++ b/components/clm/src/ED/main/EDCLMLinkMod.F90 @@ -0,0 +1,1427 @@ +module EDCLMLinkMod + + ! ============================================================================ + ! Modules to control the passing of infomation generated by ED into CLM to be used for either + ! diagnostics, or as input to the land surface components. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8; + use decompMod , only : bounds_type + use clm_varpar , only : nclmax, nlevcan_ed, numpft, numcft + use clm_varctl , only : iulog + use EDtypesMod , only : ed_site_type, ed_cohort_type, ed_patch_type + ! + implicit none + private + ! + logical :: DEBUG = .false. ! for debugging this module (EDCLMLinkMod.F90) + + type, public :: ed_clm_type + + real(r8), pointer, private :: trimming_patch (:) + real(r8), pointer, private :: area_plant_patch (:) + real(r8), pointer, private :: area_trees_patch (:) + real(r8), pointer, private :: canopy_spread_patch (:) + real(r8), pointer, private :: PFTbiomass_patch (:,:) ! total biomass of each patch + real(r8), pointer, private :: PFTleafbiomass_patch (:,:) ! total biomass of each patch + real(r8), pointer, private :: PFTstorebiomass_patch (:,:) ! total biomass of each patch + real(r8), pointer, private :: PFTnindivs_patch (:,:) ! total biomass of each patch + + real(r8), pointer, private :: nesterov_fire_danger_patch (:) ! total biomass of each patch + real(r8), pointer, private :: spitfire_ROS_patch (:) ! total biomass of each patch + real(r8), pointer, private :: effect_wspeed_patch (:) ! total biomass of each patch + real(r8), pointer, private :: TFC_ROS_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_intensity_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_area_patch (:) ! total biomass of each patch + real(r8), pointer, private :: scorch_height_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_fuel_bulkd_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_fuel_eff_moist_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_fuel_sav_patch (:) ! total biomass of each patch + real(r8), pointer, private :: fire_fuel_mef_patch (:) ! total biomass of each patch + real(r8), pointer, private :: sum_fuel_patch (:) ! total biomass of each patch + + real(r8), pointer, private :: litter_in_patch (:) ! total biomass of each patch + real(r8), pointer, private :: litter_out_patch (:) ! total biomass of each patch + real(r8), pointer, private :: efpot_patch (:) ! potential transpiration + real(r8), pointer, private :: rb_patch (:) ! boundary layer conductance + + real(r8), pointer, private :: daily_temp_patch (:) ! daily temperature for fire and phenology models + real(r8), pointer, private :: daily_rh_patch (:) ! daily RH for fire model + real(r8), pointer, private :: daily_prec_patch (:) ! daily rain for fire and phenology models. + + !seed model. Aggregated to gridcell for now. + + real(r8), pointer, private :: seed_bank_patch (:) ! kGC/m2 Mass of seeds. + real(r8), pointer, private :: seeds_in_patch (:) ! kGC/m2/year Production of seed mass. + real(r8), pointer, private :: seed_decay_patch (:) ! kGC/m2/year Decay of seed mass. + real(r8), pointer, private :: seed_germination_patch (:) ! kGC/m2/year Germiantion rate of seed mass. + + real(r8), pointer, private :: ED_bstore_patch (:) ! kGC/m2 Total stored biomass. + real(r8), pointer, private :: ED_bdead_patch (:) ! kGC/m2 Total dead biomass. + real(r8), pointer, private :: ED_balive_patch (:) ! kGC/m2 Total alive biomass. + real(r8), pointer, private :: ED_bleaf_patch (:) ! kGC/m2 Total leaf biomass. + real(r8), pointer, private :: ED_biomass_patch (:) ! kGC/m2 Total biomass. + + real(r8), pointer, private :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer, private :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer, private :: leafc_patch (:) ! (gC/m2) leaf C + real(r8), pointer, private :: livestemc_patch (:) ! (gC/m2) live stem C + real(r8), pointer, private :: deadstemc_patch (:) ! (gC/m2) dead stem C + real(r8), pointer, private :: livestemn_patch (:) ! (gN/m2) live stem N + real(r8), pointer, private :: npp_patch (:) ! (gC/m2/s) patch net primary production + real(r8), pointer, private :: gpp_patch (:) ! (gC/m2/s) patch gross primary production + + contains + + ! Public routines + procedure , public :: Init + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: ed_clm_link + + ! Private routines + procedure , private :: ed_clm_leaf_area_profile + procedure , private :: ed_update_history_variables + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type ed_clm_type + + ! 10/30/09: Created by Rosie Fisher + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure instance + ! + ! !ARGUMENTS: + class(ed_clm_type) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevgrnd + ! + ! !ARGUMENTS: + class (ed_clm_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + + allocate(this%trimming_patch (begp:endp)) ; this%trimming_patch (:) = 0.0_r8 + allocate(this%canopy_spread_patch (begp:endp)) ; this%canopy_spread_patch (:) = 0.0_r8 + allocate(this%area_plant_patch (begp:endp)) ; this%area_plant_patch (:) = 0.0_r8 + allocate(this%area_trees_patch (begp:endp)) ; this%area_trees_patch (:) = 0.0_r8 + allocate(this%PFTbiomass_patch (begp:endp,1:nlevgrnd)) ; this%PFTbiomass_patch (:,:) = 0.0_r8 + allocate(this%PFTleafbiomass_patch (begp:endp,1:nlevgrnd)) ; this%PFTleafbiomass_patch (:,:) = 0.0_r8 + allocate(this%PFTstorebiomass_patch (begp:endp,1:nlevgrnd)) ; this%PFTstorebiomass_patch (:,:) = 0.0_r8 + allocate(this%PFTnindivs_patch (begp:endp,1:nlevgrnd)) ; this%PFTnindivs_patch (:,:) = 0.0_r8 + allocate(this%nesterov_fire_danger_patch (begp:endp)) ; this%nesterov_fire_danger_patch (:) = 0.0_r8 + allocate(this%spitfire_ROS_patch (begp:endp)) ; this%spitfire_ROS_patch (:) = 0.0_r8 + allocate(this%effect_wspeed_patch (begp:endp)) ; this%effect_wspeed_patch (:) = 0.0_r8 + allocate(this%TFC_ROS_patch (begp:endp)) ; this%TFC_ROS_patch (:) = 0.0_r8 + allocate(this%fire_intensity_patch (begp:endp)) ; this%fire_intensity_patch (:) = 0.0_r8 + allocate(this%fire_area_patch (begp:endp)) ; this%fire_area_patch (:) = 0.0_r8 + allocate(this%scorch_height_patch (begp:endp)) ; this%scorch_height_patch (:) = 0.0_r8 + allocate(this%fire_fuel_bulkd_patch (begp:endp)) ; this%fire_fuel_bulkd_patch (:) = 0.0_r8 + allocate(this%fire_fuel_eff_moist_patch (begp:endp)) ; this%fire_fuel_eff_moist_patch (:) = 0.0_r8 + allocate(this%fire_fuel_sav_patch (begp:endp)) ; this%fire_fuel_sav_patch (:) = 0.0_r8 + allocate(this%fire_fuel_mef_patch (begp:endp)) ; this%fire_fuel_mef_patch (:) = 0.0_r8 + allocate(this%sum_fuel_patch (begp:endp)) ; this%sum_fuel_patch (:) = 0.0_r8 + allocate(this%litter_in_patch (begp:endp)) ; this%litter_in_patch (:) = 0.0_r8 + allocate(this%litter_out_patch (begp:endp)) ; this%litter_out_patch (:) = 0.0_r8 + allocate(this%efpot_patch (begp:endp)) ; this%efpot_patch (:) = 0.0_r8 + allocate(this%rb_patch (begp:endp)) ; this%rb_patch (:) = 0.0_r8 + allocate(this%seed_bank_patch (begp:endp)) ; this%seed_bank_patch (:) = 0.0_r8 + allocate(this%seed_decay_patch (begp:endp)) ; this%seed_decay_patch (:) = 0.0_r8 + allocate(this%seeds_in_patch (begp:endp)) ; this%seeds_in_patch (:) = 0.0_r8 + allocate(this%seed_germination_patch (begp:endp)) ; this%seed_germination_patch (:) = 0.0_r8 + allocate(this%ED_bstore_patch (begp:endp)) ; this%ED_bstore_patch (:) = 0.0_r8 + allocate(this%ED_bdead_patch (begp:endp)) ; this%ED_bdead_patch (:) = 0.0_r8 + allocate(this%ED_balive_patch (begp:endp)) ; this%ED_balive_patch (:) = 0.0_r8 + allocate(this%ED_bleaf_patch (begp:endp)) ; this%ED_bleaf_patch (:) = 0.0_r8 + allocate(this%ED_biomass_patch (begp:endp)) ; this%ED_biomass_patch (:) = 0.0_r8 + + allocate(this%storvegc_patch (begp:endp)) ; this%storvegc_patch (:) = nan + allocate(this%dispvegc_patch (begp:endp)) ; this%dispvegc_patch (:) = nan + allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan + allocate(this%livestemc_patch (begp:endp)) ; this%livestemc_patch (:) = nan + allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = nan + allocate(this%livestemn_patch (begp:endp)) ; this%livestemn_patch (:) = nan + + allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = nan + allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! add history fields for all variables, always set as default='inactive' + ! + ! !USES: + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : nlevdecomp, nlevdecomp_full, crop_prog + use clm_varcon , only : spval + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(ed_clm_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj + character(8) :: vr_suffix + character(10) :: active + integer :: begp,endp + integer :: begc,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + call hist_addfld1d (fname='TRIMMING', units='none', & + avgflag='A', long_name='Degree to which canopy expansion is limited by leaf economics', & + ptr_patch=this%trimming_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='AREA_PLANT', units='m2', & + avgflag='A', long_name='area occupied by all plants', & + ptr_patch=this%area_plant_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='AREA_TREES', units='m2', & + avgflag='A', long_name='area occupied by woody plants', & + ptr_patch=this%area_trees_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='CANOPY_SPREAD', units='none', & + avgflag='A', long_name='Scaling factor between tree basal area and canopy area', & + ptr_patch=this%canopy_spread_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld2d (fname='PFTbiomass', units='kgC/m2', type2d='levgrnd', & + avgflag='A', long_name='total PFT level biomass', & + ptr_patch=this%PFTbiomass_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld2d (fname='PFTleafbiomass', units='kgC/m2', type2d='levgrnd', & + avgflag='A', long_name='total PFT level biomass', & + ptr_patch=this%PFTleafbiomass_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld2d (fname='PFTstorebiomass', units='kgC/m2', type2d='levgrnd', & + avgflag='A', long_name='total PFT level biomass', & + ptr_patch=this%PFTstorebiomass_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld2d (fname='PFTnindivs', units='kgC/m2', type2d='levgrnd', & + avgflag='A', long_name='total PFT level biomass', & + ptr_patch=this%PFTnindivs_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='FIRE_NESTEROV_INDEX', units='none', & + avgflag='A', long_name='nesterov_fire_danger index', & + ptr_patch=this%nesterov_fire_danger_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='FIRE_ROS', units='m/min', & + avgflag='A', long_name='fire rate of spread m/min', & + ptr_patch=this%spitfire_ROS_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='EFFECT_WSPEED', units='none', & + avgflag='A', long_name='effective windspeed for fire spread', & + ptr_patch=this%effect_wspeed_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='FIRE_TFC_ROS', units='none', & + avgflag='A', long_name='total fuel consumed', & + ptr_patch=this%TFC_ROS_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='FIRE_INTENSITY', units='kJ/m/s', & + avgflag='A', long_name='spitfire fire intensity: kJ/m/s', & + ptr_patch=this%fire_intensity_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='FIRE_AREA', units='fraction', & + avgflag='A', long_name='spitfire fire area:m2', & + ptr_patch=this%fire_area_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SCORCH_HEIGHT', units='m', & + avgflag='A', long_name='spitfire fire area:m2', & + ptr_patch=this%scorch_height_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='fire_fuel_mef', units='m', & + avgflag='A', long_name='spitfire fuel moisture', & + ptr_patch=this%fire_fuel_mef_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='fire_fuel_bulkd', units='m', & + avgflag='A', long_name='spitfire fuel bulk density', & + ptr_patch=this%fire_fuel_bulkd_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='fire_fuel_eff_moist', units='m', & + avgflag='A', long_name='spitfire fuel moisture', & + ptr_patch=this%fire_fuel_eff_moist_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='fire_fuel_sav', units='m', & + avgflag='A', long_name='spitfire fuel surface/volume ', & + ptr_patch=this%fire_fuel_sav_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='TFC_ROS', units='m', & + avgflag='A', long_name='spitfire fuel surface/volume ', & + ptr_patch=this%TFC_ROS_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SUM_FUEL', units=' KgC m-2 y-1', & + avgflag='A', long_name='Litter flux in leaves', & + ptr_patch=this%sum_fuel_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='LITTER_IN', units=' KgC m-2 y-1', & + avgflag='A', long_name='Litter flux in leaves', & + ptr_patch=this%litter_in_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='LITTER_OUT', units=' KgC m-2 y-1', & + avgflag='A', long_name='Litter flux out leaves', & + ptr_patch=this%litter_out_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SEED_BANK', units=' KgC m-2', & + avgflag='A', long_name='Total Seed Mass of all PFTs', & + ptr_patch=this%seed_bank_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SEEDS_IN', units=' KgC m-2 y-1', & + avgflag='A', long_name='Seed Production Rate', & + ptr_patch=this%seeds_in_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SEED_GERMINATION', units=' KgC m-2 y-1', & + avgflag='A', long_name='Seed mass converted into new cohorts', & + ptr_patch=this%seed_germination_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='SEED_DECAY', units=' KgC m-2 y-1', & + avgflag='A', long_name='Seed mass decay', & + ptr_patch=this%seed_decay_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='ED_bstore', units=' KgC m-2', & + avgflag='A', long_name='ED stored biomass', & + ptr_patch=this%ED_bstore_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='ED_bdead', units=' KgC m-2', & + avgflag='A', long_name='ED dead biomass', & + ptr_patch=this%ED_bdead_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='ED_balive', units=' KgC m-2', & + avgflag='A', long_name='ED live biomass', & + ptr_patch=this%ED_balive_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='ED_bleaf', units=' KgC m-2', & + avgflag='A', long_name='ED leaf biomass', & + ptr_patch=this%ED_bleaf_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='ED_biomass', units=' KgC m-2', & + avgflag='A', long_name='ED total biomass', & + ptr_patch=this%ED_biomass_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='RB', units=' s m-1', & + avgflag='A', long_name='leaf boundary resistance', & + ptr_patch=this%rb_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='EFPOT', units='', & + avgflag='A', long_name='potential evap', & + ptr_patch=this%efpot_patch, set_lake=0._r8, set_urb=0._r8) + + this%dispvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='DISPVEGC', units='gC/m^2', & + avgflag='A', long_name='displayed veg carbon, excluding storage and cpool', & + ptr_patch=this%dispvegc_patch) + + this%storvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='STORVEGC', units='gC/m^2', & + avgflag='A', long_name='stored vegetation carbon, excluding cpool', & + ptr_patch=this%storvegc_patch) + + this%leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC', units='gC/m^2', & + avgflag='A', long_name='leaf C', & + ptr_patch=this%leafc_patch) + + this%livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC', units='gC/m^2', & + avgflag='A', long_name='live stem C', & + ptr_patch=this%livestemc_patch) + + this%deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC', units='gC/m^2', & + avgflag='A', long_name='dead stem C', & + ptr_patch=this%deadstemc_patch) + + this%livestemn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN', units='gN/m^2', & + avgflag='A', long_name='live stem N', & + ptr_patch=this%livestemn_patch) + + this%gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='GPP', units='gC/m^2/s', & + avgflag='A', long_name='gross primary production', & + ptr_patch=this%gpp_patch) + + this%npp_patch(begp:endp) = spval + call hist_addfld1d (fname='NPP', units='gC/m^2/s', & + avgflag='A', long_name='net primary production', & + ptr_patch=this%npp_patch) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize relevant time varying variables + ! + ! !ARGUMENTS: + class (ed_clm_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%dispvegc_patch(p) = 0._r8 + this%storvegc_patch(p) = 0._r8 + end do + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write restart data + ! + ! !USES: + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (ed_clm_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(in) :: flag !'read' or 'write' or 'define' + ! + ! !LOCAL VARIABLES: + logical :: readvar + !------------------------------------------------------------------------ + + call restartvar(ncid=ncid, flag=flag, varname='leafc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemn_patch) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues( this, bounds, val) + ! + ! !ARGUMENTS: + class (ed_clm_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: val + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !----------------------------------------------------------------------- + + ! + ! FIX(SPM,082714) - commenting these lines out while merging ED branch to CLM + ! trunk. Commented out by RF to work out science issues + ! + !this%trimming_patch (:) = val + !this%canopy_spread_patch (:) = val + !this%PFTbiomass_patch (:,:) = val + !this%PFTleafbiomass_patch (:,:) = val + !this%PFTstorebiomass_patch (:,:) = val + !this%PFTnindivs_patch (:,:) = val + this%efpot_patch (:) = val + this%rb_patch (:) = val + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ed_clm_link( this, bounds, ed_allsites_inst, ed_phenology_inst, & + waterstate_inst, canopystate_inst) + ! + ! !USES: + use landunit_varcon , only : istsoil + use EDGrowthFunctionsMod , only : tree_lai, c_area + use EDEcophysConType , only : EDecophyscon + use EDPhenologyType , only : ed_phenology_type + use EDtypesMod , only : area + use PatchType , only : clmpatch => patch + use ColumnType , only : col + use LandunitType , only : lun + use pftconMod , only : pftcon + use CanopyStateType , only : canopystate_type + use WaterStateType , only : waterstate_type + ! + ! !ARGUMENTS + class(ed_clm_type) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type) , pointer :: currentCohort + integer :: g,l,p,c + integer :: ft ! plant functional type + integer :: patchn ! identification number for each patch. + integer :: firstsoilpatch(bounds%begg:bounds%endg) ! the first patch in this gridcell that is soil and thus bare... + real(r8) :: total_bare_ground ! sum of the bare fraction in all pfts. + real(r8) :: total_patch_area + real(r8) :: coarse_wood_frac + real(r8) :: canopy_leaf_area ! total amount of leaf area in the vegetated area. m2. + integer :: sitecolumn(bounds%begg:bounds%endg) + logical :: istheresoil(bounds%begg:bounds%endg) + !---------------------------------------------------------------------- + + if (DEBUG) then + write(iulog,*) 'in ed_clm_link' + endif + + associate( & + tlai => canopystate_inst%tlai_patch , & + elai => canopystate_inst%elai_patch , & + tsai => canopystate_inst%tsai_patch , & + esai => canopystate_inst%esai_patch , & + htop => canopystate_inst%htop_patch , & + hbot => canopystate_inst%hbot_patch , & + begg => bounds%begg , & + endg => bounds%endg , & + begc => bounds%begc , & + endc => bounds%endc , & + begp => bounds%begp , & + endp => bounds%endp & + ) + + ! determine if gridcell is soil + + istheresoil(begg:endg) = .false. + do c = begc,endc + g = col%gridcell(c) + l = col%landunit(c) + + if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then + istheresoil(g) = .true. + endif + ed_allsites_inst(g)%istheresoil = istheresoil(g) + enddo + + ! retrieve the first soil patch associated with each gridcell. + ! make sure we only get the first patch value for places which have soil. + + firstsoilpatch(begg:endg) = -999 + do c = begc,endc + g = col%gridcell(c) + l = col%landunit(c) + + if (lun%itype(l) == istsoil .and. col%itype(c) == istsoil) then + firstsoilpatch(g) = col%patchi(c) + sitecolumn(g) = c + endif + enddo + + ! ============================================================================ + ! Zero the whole variable so we dont have ghost values when patch number declines. + ! ============================================================================ + + clmpatch%is_veg(begp:endp) = .false. + clmpatch%is_bareground(begp:endp) = .false. + tlai(begp:endp) = 0.0_r8 + elai(firstsoilpatch(g)) = 0.0_r8 + tsai(firstsoilpatch(g)) = 0.0_r8 + esai(firstsoilpatch(g)) = 0.0_r8 + htop(begp:endp) = 0.0_r8 + hbot(begp:endp) = 0.0_r8 + + do g = begg,endg + + if(firstsoilpatch(g) >= 0.and.ed_allsites_inst(g)%istheresoil)then + ed_allsites_inst(g)%clmcolumn = sitecolumn(g) + + ! ============================================================================ + ! Zero the bare ground tile BGC variables. + ! ============================================================================ + + tlai(firstsoilpatch(g)) = 0.0_r8 + htop(firstsoilpatch(g)) = 0.0_r8 + hbot(firstsoilpatch(g)) = 0.0_r8 + + patchn = 0 + total_bare_ground = 0.0_r8 + total_patch_area = 0._r8 + + currentPatch => ed_allsites_inst(g)%oldest_patch + do while(associated(currentPatch)) + patchn = patchn + 1 + currentPatch%patchno = patchn + + if (patchn <= numpft - numcft)then !don't expand into crop patches. + + currentPatch%clm_pno = firstsoilpatch(g) + patchn !the first 'soil' patch is unvegetated... + p = currentPatch%clm_pno + c = clmpatch%column(p) + clmpatch%is_veg(p) = .true. !this .is. a tile filled with vegetation... + + call currentPatch%set_root_fraction() + + !zero cohort-summed variables. + currentPatch%total_canopy_area = 0.0_r8 + currentPatch%total_tree_area = 0.0_r8 + currentPatch%lai = 0.0_r8 + canopy_leaf_area = 0.0_r8 + + !update cohort quantitie s + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + ft = currentCohort%pft + currentCohort%livestemn = currentCohort%bsw / pftcon%leafcn(currentCohort%pft) + + if (pftcon%woody(ft) == 1) then + coarse_wood_frac = 0.5_r8 + else + coarse_wood_frac = 0.0_r8 + end if + + currentCohort%livecrootn = currentCohort%br * coarse_wood_frac / pftcon%leafcn(ft) + currentCohort%b = currentCohort%balive+currentCohort%bdead+currentCohort%bstore + currentCohort%treelai = tree_lai(currentCohort) + ! Why is currentCohort%c_area used and then reset in the + ! following line? + canopy_leaf_area = canopy_leaf_area + currentCohort%treelai *currentCohort%c_area + currentCohort%c_area = c_area(currentCohort) + + if(currentCohort%canopy_layer==1)then + currentPatch%total_canopy_area = currentPatch%total_canopy_area + currentCohort%c_area + if(pftcon%woody(ft)==1)then + currentPatch%total_tree_area = currentPatch%total_tree_area + currentCohort%c_area + endif + endif + + ! Check for erroneous zero values. + if(currentCohort%dbh <= 0._r8 .or. currentCohort%n == 0._r8)then + write(iulog,*) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n + endif + if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then + write(iulog,*) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim + endif + if(currentCohort%balive <= 0._r8)then + write(iulog,*) 'ED: balive is zero in clmedlink',currentCohort%balive + endif + + currentCohort => currentCohort%taller + + enddo ! ends 'do while(associated(currentCohort)) + + if ( currentPatch%total_canopy_area-currentPatch%area > 0.000001_r8 ) then + write(iulog,*) 'canopy area bigger than area',currentPatch%total_canopy_area ,currentPatch%area + currentPatch%total_canopy_area = currentPatch%area + endif + + ! PASS BACK PATCH-LEVEL QUANTITIES THAT ARE NEEDED BY THE CLM CODE + if (associated(currentPatch%tallest)) then + htop(p) = currentPatch%tallest%hite + else + ! FIX(RF,040113) - should this be a parameter for the minimum possible vegetation height? + htop(p) = 0.1_r8 + endif + + hbot(p) = max(0._r8, min(0.2_r8, htop(p)- 1.0_r8)) + + ! leaf area index: of .only. the areas with some vegetation on them, as the non-vegetated areas + ! are merged into the bare ground fraction. This introduces a degree of unrealism, + ! which could be fixed if the surface albedo routine took account of the possibiltiy of bare + ! ground mixed with trees. + + if(currentPatch%total_canopy_area > 0)then; + tlai(p) = canopy_leaf_area/currentPatch%total_canopy_area + else + tlai(p) = 0.0_r8 + endif + + !write(iulog,*) 'tlai',tlai(p) + !write(iulog,*) 'htop',htop(p) + + ! We are assuming here that grass is all located underneath tree canopies. + ! The alternative is to assume it is all spatial distinct from tree canopies. + ! In which case, the bare area would have to be reduced by the grass area... + ! currentPatch%total_canopy_area/currentPatch%area is fraction of this patch cover by plants + ! currentPatch%area/AREA is the fraction of the soil covered by this patch. + + clmpatch%wt_ed(p) = min(1.0_r8,(currentPatch%total_canopy_area/currentPatch%area)) * (currentPatch%area/AREA) + currentPatch%bare_frac_area = (1.0_r8 - min(1.0_r8,currentPatch%total_canopy_area/currentPatch%area)) * & + (currentPatch%area/AREA) + ! write(iulog,*) 'bare frac',currentPatch%bare_frac_area + total_patch_area = total_patch_area + clmpatch%wt_ed(p) + currentPatch%bare_frac_area + total_bare_ground = total_bare_ground + currentPatch%bare_frac_area + currentCohort=> currentPatch%tallest + + else + write(iulog,*) 'ED: too many patches' + end if ! patchn<15 + + currentPatch => currentPatch%younger + end do !patch loop + + if((total_patch_area-1.0_r8)>1e-9)then + write(iulog,*) 'total area is wrong in CLMEDLINK',total_patch_area + endif + + !loop round all and zero the remaining empty vegetation patches + do p = firstsoilpatch(g)+patchn+1,firstsoilpatch(g)+numpft + clmpatch%wt_ed(p) = 0.0_r8 + enddo + + !set the area of the bare ground patch. + p = firstsoilpatch(g) + clmpatch%wt_ed(p) = total_bare_ground + clmpatch%is_bareground = .true. + endif ! are there any soil patches? + + call this%ed_clm_leaf_area_profile(ed_allsites_inst(g), waterstate_inst, canopystate_inst ) + + end do !grid loop + + call this%ed_update_history_variables( bounds, ed_allsites_inst(begg:endg), & + firstsoilpatch, ed_Phenology_inst, canopystate_inst) + + end associate + + end subroutine ed_clm_link + + !----------------------------------------------------------------------- + subroutine ed_update_history_variables( this, bounds, ed_allsites_inst, & + firstsoilpatch, ed_Phenology_inst, canopystate_inst) + ! + ! !USES: + use EDPhenologyType , only : ed_phenology_type + use CanopyStateType , only : canopystate_type + use PatchType , only : clmpatch => patch + ! + ! !ARGUMENTS: + class(ed_clm_type) :: this + type(bounds_type) , intent(in) :: bounds ! clump bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type) , pointer :: currentCohort + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: G,p,ft + integer :: firstsoilpatch(bounds%begg:bounds%endg) + real(r8) :: n_density ! individual of cohort per m2. + !----------------------------------------------------------------------- + + associate( & + trimming => this%trimming_patch , & ! Output: + canopy_spread => this%canopy_spread_patch , & ! Output: + PFTbiomass => this%PFTbiomass_patch , & ! Output: + PFTleafbiomass => this%PFTleafbiomass_patch , & ! Output: + PFTstorebiomass => this%PFTstorebiomass_patch , & ! Output: + PFTnindivs => this%PFTnindivs_patch , & ! Output: + area_plant => this%area_plant_patch , & ! Output: + area_trees => this%area_trees_patch , & ! Output: + nesterov_fire_danger => this%nesterov_fire_danger_patch , & ! Output: + spitfire_ROS => this%spitfire_ROS_patch , & ! Output: + effect_wspeed => this%effect_wspeed_patch , & ! Output: + TFC_ROS => this%TFC_ROS_patch , & ! Output: + sum_fuel => this%sum_fuel_patch , & ! Output: + fire_intensity => this%fire_intensity_patch , & ! Output: + fire_area => this%fire_area_patch , & ! Output: + scorch_height => this%scorch_height_patch , & ! Output: + fire_fuel_bulkd => this%fire_fuel_bulkd_patch , & ! Output: + fire_fuel_eff_moist => this%fire_fuel_eff_moist_patch , & ! Output: + fire_fuel_sav => this%fire_fuel_sav_patch , & ! Output: + fire_fuel_mef => this%fire_fuel_mef_patch , & ! Output: + litter_in => this%litter_in_patch , & ! Output: + litter_out => this%litter_out_patch , & ! Output: + seed_bank => this%seed_bank_patch , & ! Output: + seeds_in => this%seeds_in_patch , & ! Output: + seed_decay => this%seed_decay_patch , & ! Output: + seed_germination => this%seed_germination_patch , & ! Output: + + ED_biomass => this%ED_biomass_patch , & ! InOut: + ED_bdead => this%ED_bdead_patch , & ! InOut: + ED_bleaf => this%ED_bleaf_patch , & ! InOut: + ED_balive => this%ED_balive_patch , & ! InOut: + ED_bstore => this%ED_bstore_patch , & ! InOut: + + phen_cd_status => ed_phenology_inst%phen_cd_status_patch , & ! InOut: + + gpp => this%gpp_patch , & ! Output: + npp => this%npp_patch , & ! Output: + + tlai => canopystate_inst%tlai_patch , & ! InOut: + elai => canopystate_inst%elai_patch , & ! InOut: + tsai => canopystate_inst%tsai_patch , & ! InOut: + esai => canopystate_inst%esai_patch , & ! InOut: + + begp => bounds%begp , & + endp => bounds%endp & + + ) + + ! ============================================================================ + ! Zero the whole variable so we dont have ghost values when patch number declines. + ! ============================================================================ + + trimming(:) = 1.0_r8 !the default value of this is 1.0, making it 0.0 means that the output is confusing. + canopy_spread(:) = 0.0_r8 + PFTbiomass(:,:) = 0.0_r8 + PFTleafbiomass(:,:) = 0.0_r8 + PFTstorebiomass(:,:) = 0.0_r8 + PFTnindivs(:,:) = 0.0_r8 + gpp(:) = 0.0_r8 + npp(:) = 0.0_r8 + area_plant(:) = 0.0_r8 + area_trees(:) = 0.0_r8 + nesterov_fire_danger(:) = 0.0_r8 + spitfire_ROS(:) = 0.0_r8 + effect_wspeed = 0.0_r8 + TFC_ROS(:) = 0.0_r8 + fire_intensity(:) = 0.0_r8 + fire_area(:) = 0.0_r8 + scorch_height(:) = 0.0_r8 + fire_fuel_bulkd(:) = 0.0_r8 + fire_fuel_eff_moist(:) = 0.0_r8 + fire_fuel_sav(:) = 0.0_r8 + fire_fuel_mef(:) = 0.0_r8 + litter_in(:) = 0.0_r8 + litter_out(:) = 0.0_r8 + seed_bank(:) = 0.0_r8 + seeds_in(:) = 0.0_r8 + seed_decay(:) = 0.0_r8 + seed_germination(:) = 0.0_r8 + ED_biomass(:) = 0.0_r8 + ED_bdead(:) = 0.0_r8 + ED_bleaf(:) = 0.0_r8 + ED_bstore(:) = 0.0_r8 + ED_balive(:) = 0.0_r8 + phen_cd_status(:) = 2 + + do g = bounds%begg,bounds%endg + + if (firstsoilpatch(g) >= 0 .and. ed_allsites_inst(g)%istheresoil) then + + ! ============================================================================ + ! Zero the bare ground tile BGC variables. + ! ============================================================================ + + trimming(firstsoilpatch(g)) = 1.0_r8 + canopy_spread(firstsoilpatch(g)) = 0.0_r8 + PFTbiomass(firstsoilpatch(g),:) = 0.0_r8 + PFTleafbiomass(firstsoilpatch(g),:) = 0.0_r8 + PFTstorebiomass(firstsoilpatch(g),:) = 0.0_r8 + PFTnindivs(firstsoilpatch(g),:) = 0.0_r8 + gpp(firstsoilpatch(g)) = 0.0_r8 + npp(firstsoilpatch(g)) = 0.0_r8 + area_plant(firstsoilpatch(g)) = 0.0_r8 + area_trees(firstsoilpatch(g)) = 0.0_r8 + nesterov_fire_danger(firstsoilpatch(g)) = 0.0_r8 + spitfire_ROS(firstsoilpatch(g)) = 0.0_r8 + TFC_ROS(firstsoilpatch(g)) = 0.0_r8 + effect_wspeed(firstsoilpatch(g)) = 0.0_r8 + fire_intensity(firstsoilpatch(g)) = 0.0_r8 + fire_area(firstsoilpatch(g)) = 0.0_r8 + scorch_height(firstsoilpatch(g)) = 0.0_r8 + fire_fuel_bulkd(firstsoilpatch(g)) = 0.0_r8 + fire_fuel_eff_moist(firstsoilpatch(g)) = 0.0_r8 + fire_fuel_sav(firstsoilpatch(g)) = 0.0_r8 + fire_fuel_mef(firstsoilpatch(g)) = 0.0_r8 + litter_in(firstsoilpatch(g)) = 0.0_r8 + litter_out(firstsoilpatch(g)) = 0.0_r8 + seed_bank(firstsoilpatch(g)) = 0.0_r8 + seeds_in(firstsoilpatch(g)) = 0.0_r8 + seed_decay(firstsoilpatch(g)) = 0.0_r8 + seed_germination(firstsoilpatch(g)) = 0.0_r8 + ED_biomass(firstsoilpatch(g)) = 0.0_r8 + ED_balive(firstsoilpatch(g)) = 0.0_r8 + ED_bdead(firstsoilpatch(g)) = 0.0_r8 + ED_bstore(firstsoilpatch(g)) = 0.0_r8 + ED_bleaf(firstsoilpatch(g)) = 0.0_r8 + elai(firstsoilpatch(g)) = 0.0_r8 + tlai(firstsoilpatch(g)) = 0.0_r8 + tsai(firstsoilpatch(g)) = 0.0_r8 + esai(firstsoilpatch(g)) = 0.0_r8 + ED_bleaf(firstsoilpatch(g)) = 0.0_r8 + sum_fuel(firstsoilpatch(g)) = 0.0_r8 + !this should probably be site level. + phen_cd_status(firstsoilpatch(g)) = ed_allsites_inst(g)%status + + currentPatch => ed_allsites_inst(g)%oldest_patch + do while(associated(currentPatch)) + + if(currentPatch%patchno <= numpft - numcft)then !don't expand into crop patches. + p = currentPatch%clm_pno + + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + !accumulate into history variables. + ft = currentCohort%pft + if(currentPatch%area>0._r8)then + n_density = currentCohort%n/currentPatch%area + else + n_density = 0.0_r8 + endif + ED_bleaf(p) = ED_bleaf(p) + n_density * currentCohort%bl + ED_bstore(p) = ED_bstore(p) + n_density * currentCohort%bstore + ED_biomass(p) = ED_biomass(p) + n_density * currentCohort%b + ED_bdead(p) = ED_bdead(p) + n_density * currentCohort%bdead + ED_balive(p) = ED_balive(p) + n_density * currentCohort%balive + npp(p) = npp(p) + n_density * currentCohort%npp + gpp(p) = gpp(p) + n_density * currentCohort%gpp + PFTbiomass(p,ft) = PFTbiomass(p,ft) + n_density * currentCohort%b + PFTleafbiomass(p,ft) = PFTleafbiomass(p,ft) + n_density * currentCohort%bl + PFTstorebiomass(p,ft) = PFTstorebiomass(p,ft) + n_density * currentCohort%bstore + PFTnindivs(p,ft) = PFTnindivs(p,ft) + currentCohort%n + currentCohort => currentCohort%taller + enddo ! cohort loop + + !Patch specific variables that are already calculated + + !These things are all duplicated. Should they all be converted to LL or array structures RF? + nesterov_fire_danger(p) = ed_allsites_inst(g)%acc_NI + spitfire_ROS(p) = currentPatch%ROS_front + TFC_ROS(p) = currentPatch%TFC_ROS + effect_wspeed(p) = currentPatch%effect_wspeed + fire_intensity(p) = currentPatch%FI + fire_area(p) = currentPatch%frac_burnt + scorch_height(p) = currentPatch%SH + fire_fuel_bulkd(p) = currentPatch%fuel_bulkd + fire_fuel_eff_moist(p) = currentPatch%fuel_eff_moist + fire_fuel_sav(p) = currentPatch%fuel_sav + fire_fuel_mef(p) = currentPatch%fuel_mef + sum_fuel(p) = currentPatch%sum_fuel + litter_in(p) = sum(currentPatch%CWD_AG_in) +sum(currentPatch%leaf_litter_in) + litter_out(p) = sum(currentPatch%CWD_AG_out)+sum(currentPatch%leaf_litter_out) + seed_bank(p) = sum(currentPatch%seed_bank) + seeds_in(p) = sum(currentPatch%seeds_in) + seed_decay(p) = sum(currentPatch%seed_decay) + seed_germination(p) = sum(currentPatch%seed_germination) + canopy_spread(p) = currentPatch%spread(1) + area_plant(p) = currentPatch%total_canopy_area /currentPatch%area + area_trees(p) = currentPatch%total_tree_area /currentPatch%area + phen_cd_status(p) = ed_allsites_inst(g)%status + if(associated(currentPatch%tallest))then + trimming(p) = currentPatch%tallest%canopy_trim + else + trimming(p) = 0.0_r8 + endif + + else + write(iulog,*) 'ED: too many patches' + end if ! patchn<15 + + currentPatch => currentPatch%younger + end do !patch loop + + endif ! are there any soil patches? + enddo !gridcell loop + + end associate + + end subroutine ed_update_history_variables + + !------------------------------------------------------------------------ + subroutine ed_clm_leaf_area_profile( this, currentSite, waterstate_inst, canopystate_inst ) + ! + ! !DESCRIPTION: + ! Load LAI in each layer into array to send to CLM + ! + ! !USES: + use EDGrowthFunctionsMod , only : tree_lai, tree_sai, c_area + use EDtypesMod , only : area, dinc_ed, hitemax, numpft_ed, n_hite_bins + use EDEcophysConType , only : EDecophyscon + use CanopyStateType , only : canopystate_type + use WaterStateType , only : waterstate_type + use PatchType , only : clmpatch => patch + ! + ! !ARGUMENTS + class(ed_clm_type) :: this + type(ed_site_type) , intent(inout) :: currentSite + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + type (ed_cohort_type) , pointer :: currentCohort + real(r8) :: remainder !Thickness of layer at bottom of canopy. + real(r8) :: fleaf ! fraction of cohort incepting area that is leaves. + integer :: ft ! Plant functional type index. + integer :: iv ! Vertical leaf layer index + integer :: L ! Canopy layer index + integer :: P ! clm patch index + integer :: C ! column index + real(r8) :: tlai_temp ! calculation of tlai to check this method + real(r8) :: elai_temp ! make a new elai based on the layer-by-layer snow coverage. + real(r8) :: tsai_temp ! + real(r8) :: esai_temp ! + real(r8) :: fraction_exposed ! how much of this layer is not covered by snow? + real(r8) :: layer_top_hite ! notional top height of this canopy layer (m) + real(r8) :: layer_bottom_hite ! notional bottom height of this canopy layer (m) + integer :: smooth_leaf_distribution ! is the leaf distribution this option (1) or not (0) + real(r8) :: frac_canopy(N_HITE_BINS) ! amount of canopy in each height class + real(r8) :: minh(N_HITE_BINS) ! minimum height in height class (m) + real(r8) :: maxh(N_HITE_BINS) ! maximum height in height class (m) + real(r8) :: dh ! vertical detph of height class (m) + real(r8) :: min_chite ! bottom of cohort canopy (m) + real(r8) :: max_chite ! top of cohort canopy (m) + real(r8) :: lai ! summed lai for checking m2 m-2 + integer :: NC ! number of cohorts, for bug fixing. + !---------------------------------------------------------------------- + + smooth_leaf_distribution = 0 + + associate( & + snow_depth => waterstate_inst%snow_depth_col , & !Input: + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & !Input: + snowdp => waterstate_inst%snowdp_col , & !Output: + + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch , & !Output: + tlai => canopystate_inst%tlai_patch , & !Output + elai => canopystate_inst%elai_patch , & !Output + tsai => canopystate_inst%tsai_patch , & !Output + esai => canopystate_inst%esai_patch & !Output + ) + + ! Here we are trying to generate a profile of leaf area, indexed by 'z' and by pft + ! We assume that each point in the canopy recieved the light attenuated by the average + ! leaf area index above it, irrespective of PFT identity... + ! Each leaf is defined by how deep in the canopy it is, in terms of LAI units. (FIX(RF,032414), GB) + + if (currentSite%istheresoil)then + + currentPatch => currentSite%oldest_patch ! ed patch + p = currentPatch%clm_pno ! index for clm patch + + do while(associated(currentPatch)) + + !Calculate tree and canopy areas. + currentPatch%canopy_area = 0._r8 + currentPatch%canopy_layer_lai(:) = 0._r8 + NC = 0 + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + currentCohort%c_area = c_area(currentCohort) + currentPatch%canopy_area = currentPatch%canopy_area + currentCohort%c_area + NC = NC+1 + currentCohort => currentCohort%taller + enddo + ! if plants take up all the tile, then so does the canopy. + currentPatch%canopy_area = min(currentPatch%canopy_area,currentPatch%area) + + !calculate tree lai and sai. + currentPatch%ncan(:,:) = 0 + currentPatch%nrad(:,:) = 0 + currentPatch%lai = 0._r8 + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + currentCohort%treelai = tree_lai(currentCohort) + currentCohort%treesai = tree_sai(currentCohort) + currentCohort%lai = currentCohort%treelai *currentCohort%c_area/currentPatch%canopy_area + currentCohort%sai = currentCohort%treesai *currentCohort%c_area/currentPatch%canopy_area + !Calculate the LAI plus SAI in each canopy storey. + currentCohort%NV = CEILING((currentCohort%treelai+currentCohort%treesai)/dinc_ed) + + currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft) = & + max(currentPatch%ncan(currentCohort%canopy_layer,currentCohort%pft),currentCohort%NV) + currentPatch%lai = currentPatch%lai +currentCohort%lai + + do L = 1,nclmax-1 + if(currentCohort%canopy_layer == L)then + currentPatch%canopy_layer_lai(L) = currentPatch%canopy_layer_lai(L) + currentCohort%lai + & + currentCohort%sai + endif + enddo + + currentCohort => currentCohort%taller + + enddo !currentCohort + currentPatch%nrad = currentPatch%ncan + + if(smooth_leaf_distribution == 1)then + ! we are going to ignore the concept of canopy layers, and put all of the leaf area into height banded bins. + ! using the same domains as we had before, except that CL always = 1 + currentPatch%tlai_profile = 0._r8 + currentPatch%tsai_profile = 0._r8 + currentPatch%elai_profile = 0._r8 + currentPatch%esai_profile = 0._r8 + + ! this is a crude way of dividing up the bins. Should it be a function of actual maximum height? + dh = 1.0_r8*(HITEMAX/N_HITE_BINS) + do iv = 1,N_HITE_BINS + if (iv == 1) then + minh(iv) = 0.0_r8 + maxh(iv) = dh + else + minh(iv) = (iv-1)*dh + maxh(iv) = (iv)*dh + endif + enddo + c = clmpatch%column(currentPatch%clm_pno) + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + ft = currentCohort%pft + min_chite = currentCohort%hite - currentCohort%hite * EDecophyscon%crown(ft) + max_chite = currentCohort%hite + do iv = 1,N_HITE_BINS + frac_canopy(iv) = 0.0_r8 + ! this layer is in the middle of the canopy + if(max_chite > maxh(iv).and.min_chite < minh(iv))then + frac_canopy(iv)= min(1.0_r8,dh / (currentCohort%hite*EDecophyscon%crown(ft))) + ! this is the layer with the bottom of the canopy in it. + elseif(min_chite < maxh(iv).and.min_chite > minh(iv).and.max_chite > maxh(iv))then + frac_canopy(iv) = (maxh(iv) -min_chite ) / (currentCohort%hite*EDecophyscon%crown(ft)) + ! this is the layer with the top of the canopy in it. + elseif(max_chite > minh(iv).and.max_chite < maxh(iv).and.min_chite < minh(iv))then + frac_canopy(iv) = (max_chite - minh(iv)) / (currentCohort%hite*EDecophyscon%crown(ft)) + elseif(max_chite < maxh(iv).and.min_chite > minh(iv))then !the whole cohort is within this layer. + frac_canopy(iv) = 1.0_r8 + endif + + ! no m2 of leaf per m2 of ground in each height class + currentPatch%tlai_profile(1,ft,iv) = currentPatch%tlai_profile(1,ft,iv) + frac_canopy(iv) * & + currentCohort%lai + currentPatch%tsai_profile(1,ft,iv) = currentPatch%tsai_profile(1,ft,iv) + frac_canopy(iv) * & + currentCohort%sai + + !snow burial + fraction_exposed = 1.0_r8 !default. + + snowdp(c) = snow_depth(c) * frac_sno_eff(c) + if(snowdp(c) > maxh(iv))then + fraction_exposed = 0._r8 + endif + if(snowdp(c) < minh(iv))then + fraction_exposed = 1._r8 + endif + if(snowdp(c) >= minh(iv).and.snowdp(c) <= maxh(iv))then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-minh(iv))/dh))) + endif + + ! no m2 of leaf per m2 of ground in each height class + ! FIX(SPM,032414) these should be uncommented this and double check + !currentPatch%elai_profile(1,ft,iv) = currentPatch%tlai_profile(1,ft,iv) * fraction_exposed + !currentPatch%esai_profile(1,ft,iv) = currentPatch%tsai_profile(1,ft,iv) * fraction_exposed + + enddo ! (iv) hite bins + + currentCohort => currentCohort%taller + + enddo !currentCohort + + !check + currentPatch%lai = 0._r8 + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + currentPatch%lai = currentPatch%lai +currentCohort%lai + currentCohort => currentCohort%taller + enddo !currentCohort + lai = 0.0_r8 + do ft = 1,numpft_ed + lai = lai+ sum(currentPatch%tlai_profile(1,ft,:)) + enddo + + if(lai > currentPatch%lai)then + write(iulog,*) 'problem with lai assignments' + endif + + + else ! smooth leaf distribution + !Go through all cohorts and add their leaf area and canopy area to the accumulators. + currentPatch%tlai_profile = 0._r8 + currentPatch%tsai_profile = 0._r8 + currentPatch%elai_profile = 0._r8 + currentPatch%esai_profile = 0._r8 + currentPatch%canopy_area_profile(:,:,:) = 0._r8 + currentPatch%ncan(:,:) = 0 + currentPatch%nrad(:,:) = 0 + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + L = currentCohort%canopy_layer + ft = currentCohort%pft + !Calculate the number of layers of thickness dlai, including the last one. + currentCohort%NV = CEILING((currentCohort%treelai+currentCohort%treesai)/dinc_ed) + !how much of each tree is stem area index? Assuming that there is + if(currentCohort%treelai+currentCohort%treesai > 0._r8)then + fleaf = currentCohort%lai / (currentCohort%lai + currentCohort%sai) + else + fleaf = 0._r8 + write(iulog,*) 'no stem or leaf area' ,currentCohort%pft,currentCohort%bl, & + currentCohort%balive,currentCohort%treelai,currentCohort%treesai,currentCohort%dbh, & + currentCohort%n,currentCohort%status_coh + endif + currentPatch%ncan(L,ft) = max(currentPatch%ncan(L,ft),currentCohort%NV) + currentPatch%nrad(L,ft) = currentPatch%ncan(L,ft) !fudge - this needs to be altered for snow burial + if(currentCohort%NV > currentPatch%nrad(L,ft))then + write(iulog,*) 'CF: issue with NV',currentCohort%NV,currentCohort%pft,currentCohort%canopy_layer + endif + c = clmpatch%column(currentPatch%clm_pno) + + !Whole layers. Make a weighted average of the leaf area in each layer before dividing it by the total area. + !fill up layer for whole layers. FIX(RF,032414)- for debugging jan 2012 + do iv = 1,currentCohort%NV-1 + + currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv)+ dinc_ed * fleaf * & + currentCohort%c_area/currentPatch%total_canopy_area + currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv)+ dinc_ed * (1._r8 - fleaf) * & + currentCohort%c_area/currentPatch%total_canopy_area + currentPatch%canopy_area_profile(L,ft,iv) = min(1.0_r8,currentPatch%canopy_area_profile(L,ft,iv) + & + currentCohort%c_area/currentPatch%total_canopy_area) + + ! what is the height of this layer? (for snow burial purposes...) + ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & + EDecophyscon%crown(currentCohort%pft) ) + layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & + EDecophyscon%crown(currentCohort%pft)) ! pftcon%vertical_canopy_frac(ft)) + fraction_exposed = 1.0_r8 !default. + snowdp(c) = snow_depth(c) * frac_sno_eff(c) + if(snowdp(c) > layer_top_hite)then + fraction_exposed = 0._r8 + endif + if(snowdp(c) <= layer_bottom_hite)then + fraction_exposed = 1._r8 + endif + if(snowdp(c) > layer_bottom_hite.and.snowdp(c) <= layer_top_hite)then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-layer_bottom_hite)/ & + (layer_top_hite-layer_bottom_hite )))) + endif + + currentPatch%elai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) *fraction_exposed + !here we are assuming that the stem and leaf area indices have the same profile... + currentPatch%esai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) *fraction_exposed + end do + + !Bottom layer + iv = currentCohort%NV + ! pftcon%vertical_canopy_frac(ft))! fudge - this should be pft specific but i cant get it to compile. + layer_top_hite = currentCohort%hite-((iv/currentCohort%NV) * currentCohort%hite * & + EDecophyscon%crown(currentCohort%pft) ) + ! pftcon%vertical_canopy_frac(ft)) + layer_bottom_hite = currentCohort%hite-(((iv+1)/currentCohort%NV) * currentCohort%hite * & + EDecophyscon%crown(currentCohort%pft)) + fraction_exposed = 1.0_r8 !default. + + fraction_exposed = 1.0_r8 !default. + if(snowdp(c) > layer_top_hite)then + fraction_exposed = 0._r8 + endif + if(snowdp(c) <= layer_bottom_hite)then + fraction_exposed = 1._r8 + endif + if(snowdp(c) > layer_bottom_hite.and.snowdp(c) <= layer_top_hite)then !only partly hidden... + fraction_exposed = max(0._r8,(min(1.0_r8,(snowdp(c)-layer_bottom_hite) / & + (layer_top_hite-layer_bottom_hite )))) + endif + + remainder = (currentCohort%treelai + currentCohort%treesai) - (dinc_ed*(currentCohort%NV-1)) + if(remainder > 1.0_r8)then + write(iulog,*)'issue with remainder',currentCohort%treelai,currentCohort%treesai,dinc_ed, & + currentCohort%NV + endif + !assumes that fleaf is unchanging FIX(RF,032414) + + currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv)+ remainder * fleaf * & + currentCohort%c_area/currentPatch%total_canopy_area + + !assumes that fleaf is unchanging FIX(RF,032414) + + currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv)+ remainder * & + (1.0_r8-fleaf) * currentCohort%c_area/currentPatch%total_canopy_area + currentPatch%elai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) *fraction_exposed + currentPatch%esai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) *fraction_exposed + currentPatch%canopy_area_profile(L,ft,iv) = min(1.0_r8,currentPatch%canopy_area_profile(L,ft,iv) + & + currentCohort%c_area/currentPatch%total_canopy_area) + + if(currentCohort%dbh <= 0._r8.or.currentCohort%n == 0._r8)then + write(iulog,*) 'ED: dbh or n is zero in clmedlink', currentCohort%dbh,currentCohort%n + endif + if(currentCohort%pft == 0.or.currentCohort%canopy_trim <= 0._r8)then + write(iulog,*) 'ED: PFT or trim is zero in clmedlink',currentCohort%pft,currentCohort%canopy_trim + endif + if(currentCohort%balive <= 0._r8.or.currentCohort%bl < 0._r8)then + write(iulog,*) 'ED: balive is zero in clmedlink',currentCohort%balive,currentCohort%bl + endif + + currentCohort => currentCohort%taller + + enddo !cohort + + do L = 1,currentPatch%NCL_p + do ft = 1,numpft_ed + do iv = 1,currentPatch%nrad(L,ft) + !account for total canopy area + currentPatch%tlai_profile(L,ft,iv) = currentPatch%tlai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + currentPatch%tsai_profile(L,ft,iv) = currentPatch%tsai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + currentPatch%elai_profile(L,ft,iv) = currentPatch%elai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + currentPatch%esai_profile(L,ft,iv) = currentPatch%esai_profile(L,ft,iv) / & + currentPatch%canopy_area_profile(L,ft,iv) + enddo + + currentPatch%tlai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan_ed) = 0._r8 + currentPatch%tsai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan_ed) = 0._r8 + currentPatch%elai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan_ed) = 0._r8 + currentPatch%esai_profile(L,ft,currentPatch%nrad(L,ft)+1: nlevcan_ed) = 0._r8 + + enddo + enddo + + !what is the resultant leaf area? + + tlai_temp = 0._r8 + elai_temp = 0._r8 + tsai_temp = 0._r8 + esai_temp = 0._r8 + + do L = 1,currentPatch%NCL_p + do ft = 1,numpft_ed + + tlai_temp = tlai_temp + sum(currentPatch%canopy_area_profile(L,ft,1:currentPatch%nrad(L,ft)) * & + currentPatch%tlai_profile(L,ft,1:currentPatch%nrad(L,ft))) + elai_temp = elai_temp + sum(currentPatch%canopy_area_profile(L,ft,1:currentPatch%nrad(L,ft)) * & + currentPatch%elai_profile(L,ft,1:currentPatch%nrad(L,ft))) + tsai_temp = tsai_temp + sum(currentPatch%canopy_area_profile(L,ft,1:currentPatch%nrad(L,ft)) * & + currentPatch%tsai_profile(L,ft,1:currentPatch%nrad(L,ft))) + esai_temp = esai_temp + sum(currentPatch%canopy_area_profile(L,ft,1:currentPatch%nrad(L,ft)) * & + currentPatch%esai_profile(L,ft,1:currentPatch%nrad(L,ft))) + enddo + enddo + + p = currentPatch%clm_pno + if(abs(tlai(p)-tlai_temp) > 0.0001_r8) then + + write(iulog,*) 'error with tlai calcs',& + NC,currentSite%clmgcell, abs(tlai(p)-tlai_temp), tlai_temp,tlai(p) + + do L = 1,currentPatch%NCL_p + write(iulog,*) 'carea profile',L,currentPatch%canopy_area_profile(L,1,1:currentPatch%nrad(L,1)) + write(iulog,*) 'tlai profile',L,currentPatch%tlai_profile(L,1,1:currentPatch%nrad(L,1)) + end do + + endif + + elai(p) = max(0.1_r8,elai_temp) + tlai(p) = max(0.1_r8,tlai_temp) + esai(p) = max(0.1_r8,esai_temp) + tsai(p) = max(0.1_r8,tsai_temp) + + ! write(iulog,*) 'elai',elai(p),tlai(p),tlai_temp,elai_temp + ! write(iulog,*) 'esai',esai(p),tsai(p) + ! write(iulog,*) 'TLAI_prof',currentPatch%tlai_profile(1,:,:) + + ! Fraction of vegetation free of snow. What does this do? Is it right? + if ((elai(p) + esai(p)) > 0._r8) then + frac_veg_nosno_alb(p) = 1.0_r8 + else + frac_veg_nosno_alb(p) = 0.0_r8 + end if + ! write(iulog,*) 'frac nosno',frac_veg_nosno_alb(p) + + currentPatch%nrad = currentPatch%ncan + do L = 1,currentPatch%NCL_p + do ft = 1,numpft_ed + if(currentPatch%nrad(L,ft) > 30)then + write(iulog,*) 'ED: issue w/ nrad' + endif + currentPatch%present(L,ft) = 0 + do iv = 1, currentPatch%nrad(L,ft); + if(currentPatch%canopy_area_profile(L,ft,iv) > 0._r8)then + currentPatch%present(L,ft) = 1 + endif + end do !iv + enddo !ft + + if ( L == 1 .and. abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999 & + .and. currentPatch%NCL_p > 1 ) then + write(iulog,*) 'canopy area too small',sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1)) + write(iulog,*) 'cohort areas', currentPatch%canopy_area_profile(1,1:numpft_ed,:) + endif + + if (L == 1 .and. currentPatch%NCL_p > 1 .and. & + abs(sum(currentPatch%canopy_area_profile(1,1:numpft_ed,1))) < 0.99999) then + write(iulog,*) 'not enough area in the top canopy', & + sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), & + currentPatch%canopy_area_profile(L,1:numpft_ed,1) + endif + + if(abs(sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1))) > 1.00001)then + write(iulog,*) 'canopy-area-profile wrong',sum(currentPatch%canopy_area_profile(L,1:numpft_ed,1)), & + currentSite%clmgcell,currentPatch%patchno,L + write(iulog,*) 'areas',currentPatch%canopy_area_profile(L,1:2,1),currentPatch%patchno + + currentCohort => currentPatch%shortest + + do while(associated(currentCohort)) + + if(currentCohort%canopy_layer==1)then + write(iulog,*) 'cohorts',currentCohort%dbh,currentCohort%c_area, & + currentPatch%total_canopy_area,currentPatch%area,currentPatch%canopy_area + write(iulog,*) 'fracarea',currentCohort%pft, currentCohort%c_area/currentPatch%total_canopy_area + endif + + currentCohort => currentCohort%taller + + enddo !currentCohort + endif + enddo ! loop over L + + do L = 1,currentPatch%NCL_p + do ft = 1,numpft_ed + if(currentPatch%present(L,FT) > 1)then + write(iulog,*) 'present issue',currentPatch%clm_pno,L,ft,currentPatch%present(L,FT) + currentPatch%present(L,ft) = 1 + endif + enddo + enddo + + endif !leaf distribution + + currentPatch => currentPatch%younger + + enddo !patch + + endif !is there soil? + + end associate + + end subroutine ed_clm_leaf_area_profile + +end module EDCLMLinkMod diff --git a/components/clm/src/ED/main/EDEcophysConType.F90 b/components/clm/src/ED/main/EDEcophysConType.F90 new file mode 100644 index 0000000000..e305510f0a --- /dev/null +++ b/components/clm/src/ED/main/EDEcophysConType.F90 @@ -0,0 +1,110 @@ +module EDEcophysConType + + !---------------------------------------------------- + ! ED ecophysiological constants + !---------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: EDecophysconInit + ! + ! !PUBLIC TYPES: + type, public :: EDecophyscon_type + real(r8), pointer :: max_dbh (:) ! maximum dbh at which height growth ceases... + real(r8), pointer :: freezetol (:) ! minimum temperature tolerance... + real(r8), pointer :: wood_density (:) ! wood density g cm^-3 ... + real(r8), pointer :: alpha_stem (:) ! live stem turnover rate. y-1 + real(r8), pointer :: hgt_min (:) ! sapling height m + real(r8), pointer :: cushion (:) ! labile carbon storage target as multiple of leaf pool. + real(r8), pointer :: leaf_stor_priority (:) ! leaf turnover vs labile carbon use prioritisation. ! (1=lose leaves, 0=use store). + real(r8), pointer :: leafwatermax (:) ! amount of water allowed on leaf surfaces + real(r8), pointer :: rootresist (:) + real(r8), pointer :: soilbeta (:) + real(r8), pointer :: crown (:) ! fraction of the height of the plant that is occupied by crown. For fire model. + real(r8), pointer :: bark_scaler (:) ! scaler from dbh to bark thickness. For fire model. + real(r8), pointer :: crown_kill (:) ! scaler on fire death. For fire model. + real(r8), pointer :: initd (:) ! initial seedling density + real(r8), pointer :: sd_mort (:) ! rate of death of seeds produced from reproduction. + real(r8), pointer :: seed_rain (:) ! seeds that come from outside the gridbox. + real(r8), pointer :: BB_slope (:) ! ball berry slope parameter + real(r8), pointer :: root_long (:) ! root longevity (yrs) + real(r8), pointer :: clone_alloc (:) ! fraction of carbon balance allocated to clonal reproduction. + real(r8), pointer :: seed_alloc (:) ! fraction of carbon balance allocated to seeds. + real(r8), pointer :: sapwood_ratio (:) ! amount of sapwood per unit leaf carbon and m height + end type EDecophyscon_type + + type(EDecophyscon_type), public :: EDecophyscon ! ED ecophysiological constants structure + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine EDecophysconInit(EDpftvarcon_inst, numpft) + ! + ! !USES: + use EDPftvarcon, only : EDPftvarcon_type + ! + ! !ARGUMENTS: + type(EDpftVarCon_type) , intent(in) :: EDpftvarcon_inst + integer , intent(in) :: numpft + ! + ! !LOCAL VARIABLES: + integer :: m, ib + !------------------------------------------------------------------------ + + allocate( EDecophyscon%max_dbh (0:numpft)); EDecophyscon%max_dbh (:) = nan + allocate( EDecophyscon%freezetol (0:numpft)); EDecophyscon%freezetol (:) = nan + allocate( EDecophyscon%wood_density (0:numpft)); EDecophyscon%wood_density (:) = nan + allocate( EDecophyscon%alpha_stem (0:numpft)); EDecophyscon%alpha_stem (:) = nan + allocate( EDecophyscon%hgt_min (0:numpft)); EDecophyscon%hgt_min (:) = nan + allocate( EDecophyscon%cushion (0:numpft)); EDecophyscon%cushion (:) = nan + allocate( EDecophyscon%leaf_stor_priority (0:numpft)); EDecophyscon%leaf_stor_priority (:) = nan + allocate( EDecophyscon%leafwatermax (0:numpft)); EDecophyscon%leafwatermax (:) = nan + allocate( EDecophyscon%rootresist (0:numpft)); EDecophyscon%rootresist (:) = nan + allocate( EDecophyscon%soilbeta (0:numpft)); EDecophyscon%soilbeta (:) = nan + allocate( EDecophyscon%crown (0:numpft)); EDecophyscon%crown (:) = nan + allocate( EDecophyscon%bark_scaler (0:numpft)); EDecophyscon%bark_scaler (:) = nan + allocate( EDecophyscon%crown_kill (0:numpft)); EDecophyscon%crown_kill (:) = nan + allocate( EDecophyscon%initd (0:numpft)); EDecophyscon%initd (:) = nan + allocate( EDecophyscon%sd_mort (0:numpft)); EDecophyscon%sd_mort (:) = nan + allocate( EDecophyscon%seed_rain (0:numpft)); EDecophyscon%seed_rain (:) = nan + allocate( EDecophyscon%BB_slope (0:numpft)); EDecophyscon%BB_slope (:) = nan + allocate( EDecophyscon%root_long (0:numpft)); EDecophyscon%root_long (:) = nan + allocate( EDecophyscon%seed_alloc (0:numpft)); EDecophyscon%seed_alloc (:) = nan + allocate( EDecophyscon%clone_alloc (0:numpft)); EDecophyscon%clone_alloc (:) = nan + allocate( EDecophyscon%sapwood_ratio (0:numpft)); EDecophyscon%sapwood_ratio (:) = nan + + do m = 0,numpft + EDecophyscon%max_dbh(m) = EDPftvarcon_inst%max_dbh(m) + EDecophyscon%freezetol(m) = EDPftvarcon_inst%freezetol(m) + EDecophyscon%wood_density(m) = EDPftvarcon_inst%wood_density(m) + EDecophyscon%alpha_stem(m) = EDPftvarcon_inst%alpha_stem(m) + EDecophyscon%hgt_min(m) = EDPftvarcon_inst%hgt_min(m) + EDecophyscon%cushion(m) = EDPftvarcon_inst%cushion(m) + EDecophyscon%leaf_stor_priority(m) = EDPftvarcon_inst%leaf_stor_priority(m) + EDecophyscon%leafwatermax(m) = EDPftvarcon_inst%leafwatermax(m) + EDecophyscon%rootresist(m) = EDPftvarcon_inst%rootresist(m) + EDecophyscon%soilbeta(m) = EDPftvarcon_inst%soilbeta(m) + EDecophyscon%crown(m) = EDPftvarcon_inst%crown(m) + EDecophyscon%bark_scaler(m) = EDPftvarcon_inst%bark_scaler(m) + EDecophyscon%crown_kill(m) = EDPftvarcon_inst%crown_kill(m) + EDecophyscon%initd(m) = EDPftvarcon_inst%initd(m) + EDecophyscon%sd_mort(m) = EDPftvarcon_inst%sd_mort(m) + EDecophyscon%seed_rain(m) = EDPftvarcon_inst%seed_rain(m) + EDecophyscon%bb_slope(m) = EDPftvarcon_inst%bb_slope(m) + EDecophyscon%root_long(m) = EDPftvarcon_inst%root_long(m) + EDecophyscon%seed_alloc(m) = EDPftvarcon_inst%seed_alloc(m) + EDecophyscon%clone_alloc(m) = EDPftvarcon_inst%clone_alloc(m) + EDecophyscon%sapwood_ratio(m) = EDPftvarcon_inst%sapwood_ratio(m) + end do + + end subroutine EDecophysconInit + +end module EDEcophysConType diff --git a/components/clm/src/ED/main/EDInitMod.F90 b/components/clm/src/ED/main/EDInitMod.F90 new file mode 100755 index 0000000000..3390053c3f --- /dev/null +++ b/components/clm/src/ED/main/EDInitMod.F90 @@ -0,0 +1,388 @@ +module EDInitMod + + ! ============================================================================ + ! Contains all modules to set up the ED structure. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8; + use spmdMod , only : masterproc + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varpar , only : nclmax + use clm_varctl , only : iulog, use_ed_spit_fire + use clm_time_manager , only : is_restart + use CanopyStateType , only : canopystate_type + use WaterStateType , only : waterstate_type + use GridcellType , only : grc + use pftconMod , only : pftcon + use EDPhenologyType , only : ed_phenology_type + use EDEcophysConType , only : EDecophyscon + use EDGrowthFunctionsMod , only : bdead, bleaf, dbh + use EDCohortDynamicsMod , only : create_cohort, fuse_cohorts, sort_cohorts + use EDPatchDynamicsMod , only : create_patch + use EDMainMod , only : ed_update_site + use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type, area + use EDTypesMod , only : cohorts_per_gcell, ncwd, numpft_ed, udata + use EDCLMLinkMod , only : ed_clm_type + + implicit none + private + + public :: ed_init + public :: ed_init_sites + public :: zero_site + + private :: set_site_properties + private :: init_patches + private :: init_cohorts + ! ============================================================================ + +contains + + ! ============================================================================ + subroutine ed_init( bounds, ed_allsites_inst, ed_clm_inst, & + ed_phenology_inst, waterstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! use ed_allsites_inst at the top level, then pass it through arg. list. then we can + ! actually use intents + ! + ! !USES: + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds ! clump bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_clm_type) , intent(inout) :: ed_clm_inst + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: g + !---------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'ED: restart ? = ' ,is_restart() ! FIX(SPM,032414) debug + write(iulog,*) 'ED_Mod.F90 :: SPITFIRE_SWITCH (use_ed_spit_fire) ',use_ed_spit_fire ! FIX(SPM,032414) debug + write(iulog,*) 'ED_Mod.F90 :: cohorts_per_gcell ',cohorts_per_gcell ! FIX(SPM,032414) debug + end if + + if ( .not. is_restart() ) then + call ed_init_sites( bounds, ed_allsites_inst(bounds%begg:bounds%endg)) + + do g = bounds%begg,bounds%endg + if (ed_allsites_inst(g)%istheresoil) then + call ed_update_site(ed_allsites_inst(g)) + end if + end do + + call ed_clm_inst%ed_clm_link( bounds, ed_allsites_inst(bounds%begg:bounds%endg), & + ed_phenology_inst, waterstate_inst, canopystate_inst) + endif + + end subroutine ed_init + + ! ============================================================================ + subroutine ed_init_sites( bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! Intialize all ED sites + ! + ! !USES: + use ColumnType , only : col + use landunit_varcon , only : istsoil + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + integer :: g,l,c + logical :: istheresoil(bounds%begg:bounds%endg) + !---------------------------------------------------------------------- + + ! INITIALISE THE SITE STRUCTURES + udata%cohort_number = 0 !Makes unique cohort identifiers. Needs zeroing at beginning of run. + + do g = bounds%begg,bounds%endg + ! zero the site + call zero_site(ed_allsites_inst(g)) + + !create clm mapping to ED structure + ed_allsites_inst(g)%clmgcell = g + ed_allsites_inst(g)%lat = grc%latdeg(g) + ed_allsites_inst(g)%lon = grc%londeg(g) + enddo + + istheresoil(bounds%begg:bounds%endg) = .false. + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + if (col%itype(c) == istsoil) then + istheresoil(g) = .true. + endif + ed_allsites_inst(g)%istheresoil = istheresoil(g) + enddo + + call set_site_properties( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + + ! on restart, this functionality is handled in EDRestVectorMod::createPatchCohortStructure + if (.not. is_restart() ) then + call init_patches( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + endif + + end subroutine ed_init_sites + + ! ============================================================================ + subroutine zero_site( site_in ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS + type(ed_site_type), intent(inout) :: site_in + ! + ! !LOCAL VARIABLES: + !---------------------------------------------------------------------- + + site_in%oldest_patch => null() ! pointer to oldest patch at the site + site_in%youngest_patch => null() ! pointer to yngest patch at the site + + ! INDICES + site_in%lat = nan + site_in%lon = nan + site_in%clmgcell = 0 + site_in%clmcolumn = 0 + site_in%istheresoil = .false. + + ! DISTURBANCE + site_in%disturbance_rate = 0._r8 ! site level disturbance rates from mortality and fire. + site_in%dist_type = 0 ! disturbance dist_type id. + + ! PHENOLOGY + site_in%status = 0 ! are leaves in this pixel on or off? + site_in%dstatus = 0 + site_in%gdd = nan ! growing degree days + site_in%ncd = nan ! no chilling days + site_in%last_n_days(:) = 999 ! record of last 10 days temperature for senescence model. + site_in%leafondate = 999 ! doy of leaf on + site_in%leafoffdate = 999 ! doy of leaf off + site_in%dleafondate = 999 ! doy of leaf on drought + site_in%dleafoffdate = 999 ! doy of leaf on drought + site_in%water_memory(:) = nan + + ! FIRE + site_in%acc_ni = 0.0_r8 ! daily nesterov index accumulating over time. time unlimited theoretically. + site_in%frac_burnt = 0.0_r8 ! burn area read in from external file + + end subroutine zero_site + + ! ============================================================================ + subroutine set_site_properties( bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! + ! !USES: + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + integer :: i,g !beginning and end of these data clumps. + real(r8) :: leafon (bounds%begg:bounds%endg) + real(r8) :: leafoff (bounds%begg:bounds%endg) + real(r8) :: stat (bounds%begg:bounds%endg) + real(r8) :: NCD (bounds%begg:bounds%endg) + real(r8) :: GDD (bounds%begg:bounds%endg) + real(r8) :: dstat (bounds%begg:bounds%endg) + real(r8) :: acc_NI (bounds%begg:bounds%endg) + real(r8) :: watermem (bounds%begg:bounds%endg) + integer :: dleafoff (bounds%begg:bounds%endg) + integer :: dleafon (bounds%begg:bounds%endg) + !---------------------------------------------------------------------- + + if ( .not. is_restart() ) then + !initial guess numbers for site condition. + do i = bounds%begg,bounds%endg + NCD(i) = 0.0_r8 + GDD(i) = 30.0_r8 + leafon(i) = 100.0_r8 + leafoff(i) = 300.0_r8 + stat(i) = 2 + acc_NI(i) = 0.0_r8 + dstat(i) = 2 + dleafoff(i) = 300 + dleafon(i) = 100 + watermem(i) = 0.5_r8 + enddo + else ! assignements for restarts + do i = bounds%begg,bounds%endg + NCD(i) = 1.0_r8 ! NCD should be 1 on restart + !GDD(i) = 0.0_r8 + leafon(i) = 0.0_r8 + leafoff(i) = 0.0_r8 + stat(i) = 1 + acc_NI(i) = 0.0_r8 + dstat(i) = 2 + dleafoff(i) = 300 + dleafon(i) = 100 + watermem(i) = 0.5_r8 + enddo + endif + + do g = bounds%begg,bounds%endg + ed_allsites_inst(g)%gdd = GDD(g) + ed_allsites_inst(g)%ncd = NCD(g) + ed_allsites_inst(g)%leafondate = leafon(g) + ed_allsites_inst(g)%leafoffdate = leafoff(g) + ed_allsites_inst(g)%dleafoffdate = dleafoff(g) + ed_allsites_inst(g)%dleafondate = dleafon(g) + + if ( .not. is_restart() ) then + ed_allsites_inst(g)%water_memory(1:10) = watermem(g) + end if + + ed_allsites_inst(g)%status = stat(g) + !start off with leaves off to initialise + ed_allsites_inst(g)%dstatus= dstat(g) + + ed_allsites_inst(g)%acc_NI = acc_NI(g) + ed_allsites_inst(g)%frac_burnt = 0.0_r8 + ed_allsites_inst(g)%old_stock = 0.0_r8 + enddo + + end subroutine set_site_properties + + ! ============================================================================ + subroutine init_patches( bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + !initialize patches on new ground + ! + ! !USES: + use EDParamsMod , only : ED_val_maxspread + ! + ! !ARGUMENTS + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + integer :: g + real(r8) :: cwd_ag_local(ncwd) + real(r8) :: cwd_bg_local(ncwd) + real(r8) :: spread_local(nclmax) + real(r8) :: leaf_litter_local(numpft_ed) + real(r8) :: root_litter_local(numpft_ed) + real(r8) :: seed_bank_local(numpft_ed) + real(r8) :: age !notional age of this patch + type(ed_patch_type), pointer :: newp + !---------------------------------------------------------------------- + + cwd_ag_local(:) = 0.0_r8 !ED_val_init_litter -- arbitrary value for litter pools. kgC m-2 + cwd_bg_local(:) = 0.0_r8 !ED_val_init_litter + leaf_litter_local(:) = 0.0_r8 + root_litter_local(:) = 0.0_r8 + spread_local(:) = ED_val_maxspread + seed_bank_local(:) = 0.0_r8 !Note (mv,11-04-2014, this is a bug fix - this line was missing) + age = 0.0_r8 + + !FIX(SPM,032414) clean this up...inits out of this loop + do g = bounds%begg,bounds%endg + + allocate(newp) +! call zero_patch(newp) !Note (mv,11-04-2014, this is a bug fix - this line was missing) + + newp%patchno = 1 + newp%younger => null() + newp%older => null() + + ed_allsites_inst(g)%youngest_patch => newp + ed_allsites_inst(g)%youngest_patch => newp + ed_allsites_inst(g)%oldest_patch => newp + + ! make new patch... + call create_patch(ed_allsites_inst(g), newp, age, AREA, & + spread_local, cwd_ag_local, cwd_bg_local, leaf_litter_local, & + root_litter_local, seed_bank_local) + + call init_cohorts(newp) + + enddo !gridcells + + end subroutine init_patches + + ! ============================================================================ + subroutine init_cohorts( patch_in ) + ! + ! !DESCRIPTION: + ! initialize new cohorts on bare ground + ! + ! !USES: + ! + ! !ARGUMENTS + type(ed_patch_type), intent(inout), pointer :: patch_in + ! + ! !LOCAL VARIABLES: + type(ed_cohort_type),pointer :: temp_cohort + integer :: cstatus + integer :: pft + !---------------------------------------------------------------------- + + patch_in%tallest => null() + patch_in%shortest => null() + + do pft = 1,numpft_ed !FIX(RF,032414) - turning off veg dynamics + + allocate(temp_cohort) ! temporary cohort + + temp_cohort%pft = pft + temp_cohort%n = EDecophyscon%initd(pft) * patch_in%area + temp_cohort%hite = EDecophyscon%hgt_min(pft) + temp_cohort%dbh = Dbh(temp_cohort) ! FIX(RF, 090314) - comment out addition of ' + 0.0001_r8*pft ' - seperate out PFTs a little bit... + temp_cohort%canopy_trim = 1.0_r8 + temp_cohort%bdead = Bdead(temp_cohort) + temp_cohort%balive = Bleaf(temp_cohort)*(1.0_r8 + pftcon%froot_leaf(pft) & + + EDecophyscon%sapwood_ratio(temp_cohort%pft)*temp_cohort%hite) + temp_cohort%b = temp_cohort%balive + temp_cohort%bdead + + if( pftcon%evergreen(pft) == 1) then + temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) + temp_cohort%laimemory = 0._r8 + cstatus = 2 + endif + + if( pftcon%season_decid(pft) == 1 ) then !for dorment places + temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) !stored carbon in new seedlings. + if(patch_in%siteptr%status == 2)then + temp_cohort%laimemory = 0.0_r8 + else + temp_cohort%laimemory = Bleaf(temp_cohort) + endif + ! reduce biomass according to size of store, this will be recovered when elaves com on. + temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory + cstatus = patch_in%siteptr%status + endif + + if ( pftcon%stress_decid(pft) == 1 ) then + temp_cohort%bstore = Bleaf(temp_cohort) * EDecophyscon%cushion(pft) + temp_cohort%laimemory = Bleaf(temp_cohort) + temp_cohort%balive = temp_cohort%balive - temp_cohort%laimemory + cstatus = patch_in%siteptr%dstatus + endif + + call create_cohort(patch_in, pft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & + temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + temp_cohort%laimemory, cstatus, temp_cohort%canopy_trim, 1) + + deallocate(temp_cohort) ! get rid of temporary cohort + + enddo !numpft + + call fuse_cohorts(patch_in) + call sort_cohorts(patch_in) + + end subroutine init_cohorts + +end module EDInitMod diff --git a/components/clm/src/ED/main/EDMainMod.F90 b/components/clm/src/ED/main/EDMainMod.F90 new file mode 100755 index 0000000000..ccabb1baed --- /dev/null +++ b/components/clm/src/ED/main/EDMainMod.F90 @@ -0,0 +1,492 @@ +module EDMainMod + + ! =========================================================================== + ! Main ED module. + ! ============================================================================ + + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varctl , only : iulog + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterStateType , only : waterstate_type + use EDCohortDynamicsMod , only : allocate_live_biomass, terminate_cohorts, fuse_cohorts, sort_cohorts, count_cohorts + use EDPatchDynamicsMod , only : disturbance_rates, fuse_patches, spawn_patches, terminate_patches + use EDPhysiologyMod , only : canopy_derivs, non_canopy_derivs, phenology, recruitment, trim_canopy + use SFMainMod , only : fire_model + use EDtypesMod , only : ncwd, n_sub, numpft_ed, udata + use EDtypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDPhenologyType , only : ed_phenology_type + use EDCLMLinkMod , only : ed_clm_type + + implicit none + private + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: ed_driver + public :: ed_update_site + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: ed_ecosystem_dynamics + private :: ed_integrate_state_variables + private :: ed_total_balance_check + + logical :: DEBUG_main = .false. + ! + ! 10/30/09: Created by Rosie Fisher + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine ed_driver( bounds, ed_allsites_inst, ed_clm_inst, ed_phenology_inst, & + atm2lnd_inst, soilstate_inst, temperature_inst, waterstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! Main ed model routine containing gridcell loop + ! + ! !USES: + use clm_time_manager , only : get_days_per_year, get_curr_date + use clm_time_manager , only : get_ref_date, timemgr_datediff + use CanopySTateType , only : canopystate_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_clm_type) , intent(inout) :: ed_clm_inst + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + type(ed_site_type), pointer :: currentSite + real(r8) :: dayDiff ! day of run + integer :: dayDiffInt ! integer of day of run + integer :: g ! gridcell + integer :: yr ! year (0, ...) + integer :: mon ! month (1, ..., 12) + integer :: day ! day of month (1, ..., 31) + integer :: sec ! seconds of the day + integer :: ncdate ! current date + integer :: nbdate ! base date (reference date) + !----------------------------------------------------------------------- + + call ed_clm_inst%SetValues( bounds, 0._r8 ) + + ! timing statements. + n_sub = get_days_per_year() + udata%deltat = 1.0_r8/n_sub !for working out age of patches in years + if(udata%time_period == 0)then + udata%time_period = n_sub + endif + + call get_curr_date(yr, mon, day, sec) + ncdate = yr*10000 + mon*100 + day + call get_ref_date(yr, mon, day, sec) + nbdate = yr*10000 + mon*100 + day + + call timemgr_datediff(nbdate, 0, ncdate, sec, dayDiff) + + dayDiffInt = floor(dayDiff) + udata%time_period = mod( dayDiffInt , n_sub ) + + ! where most things happen + do g = bounds%begg,bounds%endg + if (ed_allsites_inst(g)%istheresoil) then + currentSite => ed_allsites_inst(g) + call ed_ecosystem_dynamics(currentSite, & + ed_clm_inst, ed_phenology_inst, atm2lnd_inst, & + soilstate_inst, temperature_inst, waterstate_inst) + + call ed_update_site( ed_allsites_inst(g)) + endif + enddo + + ! updates site & patch information + + ! link to CLM structures + call ed_clm_inst%ed_clm_link( bounds, ed_allsites_inst(bounds%begg:bounds%endg), & + ed_phenology_inst, waterstate_inst, canopystate_inst) + + write(iulog,*) 'leaving ed model',bounds%begg,bounds%endg,dayDiffInt + + end subroutine ed_driver + + !-------------------------------------------------------------------------------! + subroutine ed_ecosystem_dynamics(currentSite, & + ed_clm_inst, ed_phenology_inst, atm2lnd_inst, & + soilstate_inst, temperature_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Core of ed model, calling all subsequent vegetation dynamics routines + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), pointer :: currentSite + type(ed_phenology_type) , intent(in) :: ed_phenology_inst + type(ed_clm_type) , intent(in) :: ed_clm_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: currentPatch + !----------------------------------------------------------------------- + + !************************************************************************** + ! Fire, growth, biogeochemistry. + !************************************************************************** + + !FIX(SPM,032414) take this out. On startup these values are all zero and on restart it + !zeros out values read in the restart file + + call ed_total_balance_check(currentSite, 0) + + call phenology(currentSite, ed_phenology_inst, temperature_inst, waterstate_inst) + + call fire_model(currentSite, atm2lnd_inst, temperature_inst) + + ! Calculate disturbance and mortality based on previous timestep vegetation. + call disturbance_rates(currentSite) + + ! Integrate state variables from annual rates to daily timestep + call ed_integrate_state_variables(currentSite, soilstate_inst, temperature_inst, waterstate_inst) + + !****************************************************************************** + ! Reproduction, Recruitment and Cohort Dynamics : controls cohort organisation + !****************************************************************************** + + currentPatch => currentSite%oldest_patch + do while (associated(currentPatch)) + + ! adds small cohort of each PFT + call recruitment(0,currentPatch) + + currentPatch => currentPatch%younger + enddo + + call ed_total_balance_check(currentSite,1) + + currentPatch => currentSite%oldest_patch + do while (associated(currentPatch)) + + ! kills cohorts that are too small + call terminate_cohorts(currentPatch) + + ! puts cohorts in right order + call sort_cohorts(currentPatch) + + ! fuses similar cohorts + call fuse_cohorts(currentPatch) + + currentPatch => currentPatch%younger + enddo + + call ed_total_balance_check(currentSite,2) + + !********************************************************************************* + ! Patch dynamics sub-routines: fusion, new patch creation (spwaning), termination. + !********************************************************************************* + + ! make new patches from disturbed land + call spawn_patches(currentSite) + + call ed_total_balance_check(currentSite,3) + + ! fuse on the spawned patches. + call fuse_patches(currentSite) + + call ed_total_balance_check(currentSite,4) + + ! kill patches that are too small + call terminate_patches(currentSite) + + call ed_total_balance_check(currentSite,5) + + end subroutine ed_ecosystem_dynamics + + !-------------------------------------------------------------------------------! + subroutine ed_integrate_state_variables(currentSite, soilstate_inst, temperature_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! FIX(SPM,032414) refactor so everything goes through interface + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(in) :: currentSite + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type) , pointer :: currentCohort + + integer :: c ! Counter for litter size class + integer :: p ! Counter for PFT + real(r8) :: small_no ! to circumvent numerical errors that cause negative values of things that can't be negative + real(r8) :: cohort_biomass_store ! remembers the biomass in the cohort for balance checking + !----------------------------------------------------------------------- + + small_no = 0.0000000000_r8 ! Obviously, this is arbitrary. RF - changed to zero + + currentPatch => currentSite%youngest_patch + + do while(associated(currentPatch)) + + currentPatch%age = currentPatch%age + udata%deltat + ! FIX(SPM,032414) valgrind 'Conditional jump or move depends on uninitialised value' + if( currentPatch%age < 0._r8 )then + write(iulog,*) 'negative patch age?',currentSite%clmgcell, currentPatch%age, & + currentPatch%patchno,currentPatch%area + endif + + ! Find the derivatives of the growth and litter processes. + call canopy_derivs(currentPatch) + + ! Update Canopy Biomass Pools + currentCohort => currentPatch%shortest + do while(associated(currentCohort)) + + cohort_biomass_store = (currentCohort%balive+currentCohort%bdead+currentCohort%bstore) + currentCohort%dbh = max(small_no,currentCohort%dbh + currentCohort%ddbhdt * udata%deltat ) + currentCohort%balive = currentCohort%balive + currentCohort%dbalivedt * udata%deltat + currentCohort%bdead = max(small_no,currentCohort%bdead + currentCohort%dbdeaddt * udata%deltat ) + currentCohort%bstore = currentCohort%bstore + currentCohort%dbstoredt * udata%deltat + + if( (currentCohort%balive+currentCohort%bdead+currentCohort%bstore)*currentCohort%n<0._r8)then + write(iulog,*) 'biomass is negative', currentCohort%n,currentCohort%balive, & + currentCohort%bdead,currentCohort%bstore + endif + + if(abs((currentCohort%balive+currentCohort%bdead+currentCohort%bstore+udata%deltat*(currentCohort%md+ & + currentCohort%seed_prod)-cohort_biomass_store)-currentCohort%npp_acc) > 1e-8_r8)then + write(iulog,*) 'issue with c balance in integration', abs(currentCohort%balive+currentCohort%bdead+ & + currentCohort%bstore+udata%deltat* & + (currentCohort%md+currentCohort%seed_prod)-cohort_biomass_store-currentCohort%npp_acc) + endif + !do we need these any more? + currentCohort%npp_acc = 0.0_r8 + currentCohort%gpp_acc = 0.0_r8 + currentCohort%resp_acc = 0.0_r8 + + call allocate_live_biomass(currentCohort) + + currentCohort => currentCohort%taller + + enddo + + write(6,*)'DEBUG18: calling non_canopy_derivs with pno= ',currentPatch%clm_pno + call non_canopy_derivs( currentPatch, temperature_inst, soilstate_inst, waterstate_inst ) + + !update state variables simultaneously according to derivatives for this time period. + do p = 1,numpft_ed + currentPatch%seed_bank(p) = currentPatch%seed_bank(p) + currentPatch%dseed_dt(p)*udata%deltat + enddo + + do c = 1,ncwd + currentPatch%cwd_ag(c) = currentPatch%cwd_ag(c) + currentPatch%dcwd_ag_dt(c)* udata%deltat + currentPatch%cwd_bg(c) = currentPatch%cwd_bg(c) + currentPatch%dcwd_bg_dt(c)* udata%deltat + enddo + + do p = 1,numpft_ed + currentPatch%leaf_litter(p) = currentPatch%leaf_litter(p) + currentPatch%dleaf_litter_dt(p)* udata%deltat + currentPatch%root_litter(p) = currentPatch%root_litter(p) + currentPatch%droot_litter_dt(p)* udata%deltat + enddo + + ! Check for negative values. Write out warning to show carbon balance. + do p = 1,numpft_ed + if(currentPatch%seed_bank(p) currentPatch%shortest + do while(associated(currentCohort)) + currentCohort%n = max(small_no,currentCohort%n + currentCohort%dndt * udata%deltat ) + currentCohort => currentCohort%taller + enddo + + currentPatch => currentPatch%older + + enddo + + end subroutine ed_integrate_state_variables + + !-------------------------------------------------------------------------------! + subroutine ed_update_site( currentSite ) + ! + ! !DESCRIPTION: + ! Calls routines to consolidate the ED growth process. + ! Canopy Structure to assign canopy layers to cohorts + ! Canopy Spread to figure out the size of tree crowns + ! Trim_canopy to figure out the target leaf biomass. + ! Extra recruitment to fill empty patches. + ! + ! !USES: + use EDCanopyStructureMod , only : canopy_spread, canopy_structure + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout), target :: currentSite + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: currentPatch + integer :: cohort_number ! To print out the number of cohorts. + integer :: g ! Counter for sites + !----------------------------------------------------------------------- + + call canopy_spread(currentSite) + + call ed_total_balance_check(currentSite,6) + + call canopy_structure(currentSite) + + call ed_total_balance_check(currentSite,7) + + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + + call terminate_cohorts(currentPatch) + + ! FIX(SPM,040314) why is this needed for BFB restarts? Look into this at some point + cohort_number = count_cohorts(currentPatch) + if (DEBUG_main) then + write(iulog,*) 'tempCount ',cohort_number + endif + ! Note (RF) + ! This breaks the balance check, but if we leave it out, then + ! the first new patch that isn't fused has no cohorts at the end of the spawn process + ! and so there are radiation errors instead. + ! Fixing this would likely require a re-work of how seed germination works which would be tricky. + if(currentPatch%countcohorts < 1)then + !write(iulog,*) 'ED: calling recruitment for no cohorts',currentPatch%siteptr%clmgcell,currentPatch%patchno + !call recruitment(1,currentPatch) + ! write(iulog,*) 'patch empty',currentPatch%area,currentPatch%age + endif + + currentPatch => currentPatch%younger + + enddo + + ! FIX(RF,032414). This needs to be monthly, not annual + if((udata%time_period == N_SUB-1))then + write(iulog,*) 'calling trim canopy' + call trim_canopy(currentSite) + endif + + end subroutine ed_update_site + + !-------------------------------------------------------------------------------! + subroutine ed_total_balance_check (currentSite, call_index ) + ! + ! !DESCRIPTION: + ! This routine looks at the carbon in and out of the ED model and compares it to + ! the change in total carbon stocks. + ! Fluxes in are NPP. Fluxes out are decay of CWD and litter into SOM pools. + ! ed_allsites_inst%flux_out and ed_allsites_inst%flux_in are set where they occur + ! in the code. + ! + ! !ARGUMENTS: + type(ed_site_type) , intent(inout) :: currentSite + integer , intent(in) :: call_index + ! + ! !LOCAL VARIABLES: + real(r8) :: biomass_stock ! total biomass in KgC/site + real(r8) :: litter_stock ! total litter in KgC/site + real(r8) :: seed_stock ! total seed mass in KgC/site + real(r8) :: total_stock ! total ED carbon in KgC/site + real(r8) :: change_in_stock ! Change since last time we set ed_allsites_inst%old_stock in this routine. KgC/site + real(r8) :: error ! How much carbon did we gain or lose (should be zero!) + real(r8) :: net_flux ! Difference between recorded fluxes in and out. KgC/site + + ! nb. There is no time associated with these variables + ! because this routine can be called between any two + ! arbitrary points in code, even if no time has passed. + ! Also, the carbon pools are per site/gridcell, so that + ! we can account for the changing areas of patches. + + type(ed_patch_type) , pointer :: currentPatch + type(ed_cohort_type) , pointer :: currentCohort + !----------------------------------------------------------------------- + + change_in_stock = 0.0_r8 + biomass_stock = 0.0_r8 + litter_stock = 0.0_r8 + seed_stock = 0.0_r8 + + if (currentSite%istheresoil) then + currentPatch => currentSite%oldest_patch + do while(associated(currentPatch)) + + litter_stock = litter_stock + currentPatch%area * (sum(currentPatch%cwd_ag)+ & + sum(currentPatch%cwd_bg)+sum(currentPatch%leaf_litter)+sum(currentPatch%root_litter)) + seed_stock = seed_stock + currentPatch%area * sum(currentPatch%seed_bank) + currentCohort => currentPatch%tallest; + + do while(associated(currentCohort)) + + biomass_stock = biomass_stock + (currentCohort%bdead + currentCohort%balive + & + currentCohort%bstore) * currentCohort%n + currentCohort => currentCohort%shorter; + + enddo !end cohort loop + + currentPatch => currentPatch%younger + + enddo !end patch loop + + endif + + total_stock = biomass_stock + seed_stock +litter_stock + change_in_stock = total_stock - currentSite%old_stock + net_flux = currentSite%flux_in - currentSite%flux_out + error = abs(net_flux - change_in_stock) + + if ( abs(error) > 10e-6 ) then + write(iulog,*) 'total error:in,out,net,dstock,error',call_index, currentSite%flux_in, & + currentSite%flux_out,net_flux,change_in_stock,error + write(iulog,*) 'biomass,litter,seeds', biomass_stock,litter_stock,seed_stock + write(iulog,*) 'lat lon',currentSite%lat,currentSite%lon + endif + + currentSite%flux_in = 0.0_r8 + currentSite%flux_out = 0.0_r8 + currentSite%old_stock = total_stock + + end subroutine ed_total_balance_check + +end module EDMainMod diff --git a/components/clm/src/ED/main/EDParamsMod.F90 b/components/clm/src/ED/main/EDParamsMod.F90 new file mode 100644 index 0000000000..cf851430a1 --- /dev/null +++ b/components/clm/src/ED/main/EDParamsMod.F90 @@ -0,0 +1,149 @@ +module EDParamsMod + ! + ! module that deals with reading the ED parameter file + ! + use shr_kind_mod , only: r8 => shr_kind_r8 + + implicit none + save + ! private - if we allow this module to be private, it does not allow the protected values below to be + ! seen outside of this module. + + ! + ! this is what the user can use for the actual values + ! + real(r8),protected :: ED_val_grass_spread + real(r8),protected :: ED_val_comp_excln + real(r8),protected :: ED_val_stress_mort + real(r8),protected :: ED_val_dispersal + real(r8),protected :: ED_val_grperc + real(r8),protected :: ED_val_maxspread + real(r8),protected :: ED_val_minspread + real(r8),protected :: ED_val_init_litter + real(r8),protected :: ED_val_nfires + real(r8),protected :: ED_val_understorey_death + real(r8),protected :: ED_val_profile_tol + real(r8),protected :: ED_val_ag_biomass + + character(len=20),parameter :: ED_name_grass_spread = "grass_spread" + character(len=20),parameter :: ED_name_comp_excln = "comp_excln" + character(len=20),parameter :: ED_name_stress_mort = "stress_mort" + character(len=20),parameter :: ED_name_dispersal = "dispersal" + character(len=20),parameter :: ED_name_grperc = "grperc" + character(len=20),parameter :: ED_name_maxspread = "maxspread" + character(len=20),parameter :: ED_name_minspread = "minspread" + character(len=20),parameter :: ED_name_init_litter = "init_litter" + character(len=20),parameter :: ED_name_nfires = "nfires" + character(len=20),parameter :: ED_name_understorey_death = "understorey_death" + character(len=20),parameter :: ED_name_profile_tol = "profile_tol" + character(len=20),parameter :: ED_name_ag_biomass= "ag_biomass" + + public :: EDParamsRead + +contains + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine EDParamsRead(ncid) + ! + ! calls to initialize parameter instance and do ncdio read + ! + use ncdio_pio , only : file_desc_t + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + + call EDParamsReadLocal(ncid) + + end subroutine EDParamsRead + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine EDParamsReadLocal(ncid) + ! + ! read the netcdf file and populate internalInstScalar + ! + use ncdio_pio , only : file_desc_t + use paramUtilMod , only : readNcdio + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + + ! local vars + character(len=32) :: subname = 'EDParamsReadLocal::' + + ! + ! call read function + ! + + call readNcdio(ncid = ncid, & + varName=ED_name_grass_spread, & + callingName=subname, & + retVal=ED_val_grass_spread) + + call readNcdio(ncid = ncid, & + varName=ED_name_comp_excln, & + callingName=subname, & + retVal=ED_val_comp_excln) + + call readNcdio(ncid = ncid, & + varName=ED_name_stress_mort, & + callingName=subname, & + retVal=ED_val_stress_mort) + + call readNcdio(ncid = ncid, & + varName=ED_name_dispersal, & + callingName=subname, & + retVal=ED_val_dispersal) + + call readNcdio(ncid = ncid, & + varName=ED_name_grperc, & + callingName=subname, & + retVal=ED_val_grperc) + + call readNcdio(ncid = ncid, & + varName=ED_name_maxspread, & + callingName=subname, & + retVal=ED_val_maxspread) + + call readNcdio(ncid = ncid, & + varName=ED_name_minspread, & + callingName=subname, & + retVal=ED_val_minspread) + + call readNcdio(ncid = ncid, & + varName=ED_name_init_litter, & + callingName=subname, & + retVal=ED_val_init_litter) + + call readNcdio(ncid = ncid, & + varName=ED_name_nfires, & + callingName=subname, & + retVal=ED_val_nfires) + + call readNcdio(ncid = ncid, & + varName=ED_name_understorey_death, & + callingName=subname, & + retVal=ED_val_understorey_death) + + call readNcdio(ncid = ncid, & + varName=ED_name_profile_tol, & + callingName=subname, & + retVal=ED_val_profile_tol) + + call readNcdio(ncid = ncid, & + varName=ED_name_ag_biomass, & + callingName=subname, & + retVal=ED_val_ag_biomass) + + end subroutine EDParamsReadLocal + !----------------------------------------------------------------------- + +end module EDParamsMod diff --git a/components/clm/src/ED/main/EDPftvarcon.F90 b/components/clm/src/ED/main/EDPftvarcon.F90 new file mode 100644 index 0000000000..421828a6ba --- /dev/null +++ b/components/clm/src/ED/main/EDPftvarcon.F90 @@ -0,0 +1,138 @@ +module EDPftvarcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing vegetation constants and method to + ! read and initialize vegetation (PFT) constants. + ! + ! !USES: + use clm_varpar , only : mxpft + use shr_kind_mod, only : r8 => shr_kind_r8 + + ! + ! !PUBLIC TYPES: + implicit none + save + private + + !ED specific variables. + type, public :: EDPftvarcon_type + real(r8) :: max_dbh (0:mxpft) ! maximum dbh at which height growth ceases... + real(r8) :: freezetol (0:mxpft) ! minimum temperature tolerance... + real(r8) :: wood_density (0:mxpft) ! wood density g cm^-3 ... + real(r8) :: alpha_stem (0:mxpft) ! live stem turnover rate. y-1 + real(r8) :: hgt_min (0:mxpft) ! sapling height m + real(r8) :: cushion (0:mxpft) ! labile carbon storage target as multiple of leaf pool. + real(r8) :: leaf_stor_priority (0:mxpft) ! leaf turnover vs labile carbon use prioritisation. (1 = lose leaves, 0 = use store). + real(r8) :: leafwatermax (0:mxpft) ! degree to which respiration is limited by btran if btran = 0 + real(r8) :: rootresist (0:mxpft) + real(r8) :: soilbeta (0:mxpft) + real(r8) :: crown (0:mxpft) + real(r8) :: bark_scaler (0:mxpft) + real(r8) :: crown_kill (0:mxpft) + real(r8) :: initd (0:mxpft) + real(r8) :: sd_mort (0:mxpft) + real(r8) :: seed_rain (0:mxpft) + real(r8) :: BB_slope (0:mxpft) + real(r8) :: root_long (0:mxpft) ! root longevity (yrs) + real(r8) :: clone_alloc (0:mxpft) ! fraction of carbon balance allocated to clonal reproduction. + real(r8) :: seed_alloc (0:mxpft) ! fraction of carbon balance allocated to seeds. + real(r8) :: sapwood_ratio (0:mxpft) ! amount of sapwood per unit leaf carbon and m of height. gC/gC/m + end type EDPftvarcon_type + + type(EDPftvarcon_type), public :: EDPftvarcon_inst + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: EDpftconrd ! Read and initialize vegetation (PFT) constants + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine EDpftconrd( ncid ) + ! + ! !DESCRIPTION: + ! Read and initialize vegetation (PFT) constants + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_io + use abortutils , only : endrun + ! + ! !ARGUMENTS: + implicit none + ! + type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id + + ! !LOCAL VARIABLES: + + logical :: readv ! read variable in or not + character(len=32) :: subname = 'EDpftconrd' ! subroutine name + + call ncd_io('max_dbh',EDPftvarcon_inst%max_dbh, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('freezetol',EDPftvarcon_inst%freezetol, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('wood_density',EDPftvarcon_inst%wood_density, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('alpha_stem',EDPftvarcon_inst%alpha_stem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('hgt_min',EDPftvarcon_inst%hgt_min, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('cushion',EDPftvarcon_inst%cushion, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('leaf_stor_priority',EDPftvarcon_inst%leaf_stor_priority, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('leafwatermax',EDPftvarcon_inst%leafwatermax, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('rootresist',EDPftvarcon_inst%rootresist,'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + + call ncd_io('soilbeta',EDPftvarcon_inst%soilbeta,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('crown',EDPftvarcon_inst%crown,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('bark_scaler',EDPftvarcon_inst%bark_scaler,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('crown_kill',EDPftvarcon_inst%crown_kill,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('initd',EDPftvarcon_inst%initd,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('sd_mort',EDPftvarcon_inst%sd_mort,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('seed_rain',EDPftvarcon_inst%seed_rain,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('BB_slope',EDPftvarcon_inst%BB_slope,'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('root_long',EDPftvarcon_inst%root_long, 'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('seed_alloc',EDPftvarcon_inst%seed_alloc, 'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('clone_alloc',EDPftvarcon_inst%clone_alloc, 'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + call ncd_io('sapwood_ratio',EDPftvarcon_inst%sapwood_ratio, 'read', ncid, readvar=readv) + if ( .not. readv) call endrun(trim(subname)// ' ERROR : error in reading in pft data') + + end subroutine EDpftconrd + +end module EDPftvarcon + diff --git a/components/clm/src/ED/main/EDRestVectorMod.F90 b/components/clm/src/ED/main/EDRestVectorMod.F90 new file mode 100755 index 0000000000..4481e42e63 --- /dev/null +++ b/components/clm/src/ED/main/EDRestVectorMod.F90 @@ -0,0 +1,1618 @@ +module EDRestVectorMod + +#include "shr_assert.h" + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use decompMod , only : bounds_type, get_clmlevel_gsmap + use CanopyStateType , only : canopystate_type + use WaterStateType , only : waterstate_type + use pftconMod , only : pftcon + use EDTypesMod , only : area, cohorts_per_gcell, numpft_ed, numWaterMem, nclmax, numCohortsPerPatch + use EDTypesMod , only : ncwd, invalidValue + use EDTypesMod , only : ed_site_type, ed_patch_type, ed_cohort_type + use EDPhenologyType , only : ed_phenology_type + ! + implicit none + private + ! + ! ED cohort data as a type of vectors + ! + type, public :: EDRestartVectorClass + ! + ! for vector start and stop, equivalent to begCohort and endCohort + ! + integer :: vectorLengthStart + integer :: vectorLengthStop + + logical :: DEBUG = .false. + ! + ! add ED vectors that need to be written for Restarts + ! + + ! required to map cohorts and patches to/fro + ! vectors/LinkedLists + integer, pointer :: cellWithPatch(:) + integer, pointer :: numPatchesPerCell(:) + integer, pointer :: cohortsPerPatch(:) + ! + ! cohort data + ! + real(r8), pointer :: balive(:) + real(r8), pointer :: bdead(:) + real(r8), pointer :: bl(:) + real(r8), pointer :: br(:) + real(r8), pointer :: bstore(:) + real(r8), pointer :: canopy_layer(:) + real(r8), pointer :: canopy_trim(:) + real(r8), pointer :: dbh(:) + real(r8), pointer :: hite(:) + real(r8), pointer :: laimemory(:) + real(r8), pointer :: leaf_md(:) ! this can probably be removed + real(r8), pointer :: root_md(:) ! this can probably be removed + real(r8), pointer :: n(:) + real(r8), pointer :: gpp_acc(:) + real(r8), pointer :: npp_acc(:) + real(r8), pointer :: resp_clm(:) + integer, pointer :: pft(:) + integer, pointer :: status_coh(:) + ! + ! patch level restart vars + ! indexed by ncwd + ! + real(r8), pointer :: cwd_ag(:) + real(r8), pointer :: cwd_bg(:) + ! + ! indexed by pft + ! + real(r8), pointer :: leaf_litter(:) + real(r8), pointer :: root_litter(:) + real(r8), pointer :: leaf_litter_in(:) + real(r8), pointer :: root_litter_in(:) + real(r8), pointer :: seed_bank(:) + ! + ! indext by nclmax + ! + real(r8), pointer :: spread(:) + ! + ! one per patch + ! + real(r8), pointer :: livegrass(:) ! this can probably be removed + real(r8), pointer :: age(:) + real(r8), pointer :: areaRestart(:) + ! + ! site level restart vars + ! + real(r8), pointer :: water_memory(:) + real(r8), pointer :: old_stock(:) + contains + ! + ! implement getVector and setVector + ! + procedure :: setVectors + procedure :: getVectors + ! + ! restart calls + ! + procedure :: doVectorIO + ! + ! clean up pointer arrays + ! + procedure :: deleteEDRestartVectorClass + ! + ! utility routines + ! + procedure :: convertCohortListToVector + procedure :: createPatchCohortStructure + procedure :: convertCohortVectorToList + procedure :: printIoInfoLL + procedure :: printDataInfoLL + procedure :: printDataInfoVector + + end type EDRestartVectorClass + + ! Fortran way of getting a user-defined ctor + interface EDRestartVectorClass + module procedure newEDRestartVectorClass + end interface EDRestartVectorClass + + ! + ! non type-bound procedures + ! + public :: EDRest + !-------------------------------------------------------------------------------! + +contains + + !--------------------------------------------! + ! Type-Bound Procedures Here: + !--------------------------------------------! + + !-------------------------------------------------------------------------------! + subroutine deleteEDRestartVectorClass( this ) + ! + ! !DESCRIPTION: + ! provide clean-up routine of allocated pointer arrays + ! + ! !USES: + ! + ! !ARGUMENTS: + class(EDRestartVectorClass), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + deallocate(this%cellWithPatch ) + deallocate(this%numPatchesPerCell ) + deallocate(this%cohortsPerPatch ) + deallocate(this%balive ) + deallocate(this%bdead ) + deallocate(this%bl ) + deallocate(this%br ) + deallocate(this%bstore ) + deallocate(this%canopy_layer ) + deallocate(this%canopy_trim ) + deallocate(this%dbh ) + deallocate(this%hite ) + deallocate(this%laimemory ) + deallocate(this%leaf_md ) + deallocate(this%root_md ) + deallocate(this%n ) + deallocate(this%gpp_acc ) + deallocate(this%npp_acc ) + deallocate(this%resp_clm ) + deallocate(this%pft ) + deallocate(this%status_coh ) + deallocate(this%cwd_ag ) + deallocate(this%cwd_bg ) + deallocate(this%leaf_litter ) + deallocate(this%root_litter ) + deallocate(this%leaf_litter_in ) + deallocate(this%root_litter_in ) + deallocate(this%seed_bank ) + deallocate(this%spread ) + deallocate(this%livegrass ) + deallocate(this%age ) + deallocate(this%areaRestart ) + deallocate(this%water_memory ) + deallocate(this%old_stock ) + + end subroutine deleteEDRestartVectorClass + + !-------------------------------------------------------------------------------! + function newEDRestartVectorClass( bounds ) + ! + ! !DESCRIPTION: + ! provide user-defined ctor, with array length argument + ! allocate memory for vector to write + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + type(EDRestartVectorClass) :: newEDRestartVectorClass + integer :: retVal = 99 + integer, parameter :: allocOK = 0 + !----------------------------------------------------------------------- + + associate( new => newEDRestartVectorClass) + + ! set class variables + new%vectorLengthStart = bounds%begCohort + new%vectorLengthStop = bounds%endCohort + + ! + ! cohort level variables that are required on restart + ! + + allocate(new%cellWithPatch & + (bounds%begg:bounds%endg), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%cellWithPatch(:) = 0 + + allocate(new%numPatchesPerCell & + (bounds%begg:bounds%endg), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%numPatchesPerCell(:) = invalidValue + + allocate(new%cohortsPerPatch & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%cohortsPerPatch(:) = invalidValue + + allocate(new%balive & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%balive(:) = 0.0_r8 + + allocate(new%bdead & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%bdead(:) = 0.0_r8 + + allocate(new%bl & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%bl(:) = 0.0_r8 + + allocate(new%br & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%br(:) = 0.0_r8 + + allocate(new%bstore & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%bstore(:) = 0.0_r8 + + allocate(new%canopy_layer & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%canopy_layer(:) = 0.0_r8 + + allocate(new%canopy_trim & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%canopy_trim(:) = 0.0_r8 + + allocate(new%dbh & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%dbh(:) = 0.0_r8 + + allocate(new%hite & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%hite(:) = 0.0_r8 + + allocate(new%laimemory & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%laimemory(:) = 0.0_r8 + + allocate(new%leaf_md & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leaf_md(:) = 0.0_r8 + + allocate(new%root_md & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%root_md(:) = 0.0_r8 + + allocate(new%n & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%n(:) = 0.0_r8 + + allocate(new%gpp_acc & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%gpp_acc(:) = 0.0_r8 + + allocate(new%npp_acc & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%npp_acc(:) = 0.0_r8 + + allocate(new%resp_clm & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%resp_clm(:) = 0.0_r8 + + allocate(new%pft & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%pft(:) = 0 + + allocate(new%status_coh & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%status_coh(:) = 0 + + ! + ! some patch level variables that are required on restart + ! + allocate(new%cwd_ag & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%cwd_ag(:) = 0.0_r8 + + allocate(new%cwd_bg & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%cwd_bg(:) = 0.0_r8 + + allocate(new%leaf_litter & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leaf_litter(:) = 0.0_r8 + + allocate(new%root_litter & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%root_litter(:) = 0.0_r8 + + allocate(new%leaf_litter_in & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%leaf_litter_in(:) = 0.0_r8 + + allocate(new%root_litter_in & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%root_litter_in(:) = 0.0_r8 + + allocate(new%seed_bank & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%seed_bank(:) = 0.0_r8 + + allocate(new%spread & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%spread(:) = 0.0_r8 + + allocate(new%livegrass & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%livegrass(:) = 0.0_r8 + + allocate(new%age & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%age(:) = 0.0_r8 + + allocate(new%areaRestart & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%areaRestart(:) = 0.0_r8 + + ! + ! site level variable + ! + + allocate(new%water_memory & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%water_memory(:) = 0.0_r8 + + allocate(new%old_stock & + (new%vectorLengthStart:new%vectorLengthStop), stat=retVal) + SHR_ASSERT(( retVal == allocOK ), errMsg(__FILE__, __LINE__)) + new%old_stock(:) = 0.0_r8 + + end associate + + end function newEDRestartVectorClass + + !-------------------------------------------------------------------------------! + subroutine setVectors( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! implement setVectors + ! + ! !USES: + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + !----------------------------------------------------------------------- + + write(iulog,*) 'edtime setVectors ',get_nstep() + + if (this%DEBUG) then + call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%printDataInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + end if + + call this%convertCohortListToVector ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + + if (this%DEBUG) then + call this%printDataInfoVector ( ) + end if + + end subroutine setVectors + + !-------------------------------------------------------------------------------! + subroutine getVectors( this, bounds, ed_allsites_inst, ed_clm_inst, & + ed_phenology_inst, waterstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! implement getVectors + ! + ! !USES: + use clm_time_manager , only : get_nstep + use EDCLMLinkMod , only : ed_clm_type + use EDInitMod , only : ed_init_sites + use EDMainMod , only : ed_update_site + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_clm_type) , intent(inout) :: ed_clm_inst + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: g + !----------------------------------------------------------------------- + + if (this%DEBUG) then + write(iulog,*) 'edtime getVectors ',get_nstep() + call this%printDataInfoVector ( ) + end if + + call this%createPatchCohortStructure ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + + call this%convertCohortVectorToList ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + + do g = bounds%begg,bounds%endg + if (ed_allsites_inst(g)%istheresoil) then + call ed_update_site( ed_allsites_inst(g) ) + end if + end do + + call ed_clm_inst%ed_clm_link( bounds, ed_allsites_inst(bounds%begg:bounds%endg), & + ed_phenology_inst, waterstate_inst, canopystate_inst) + + if (this%DEBUG) then + call this%printIoInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + call this%printDataInfoLL ( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + end if + + end subroutine getVectors + + !-------------------------------------------------------------------------------! + subroutine doVectorIO( this, ncid, flag ) + ! + ! !DESCRIPTION: + ! implement VectorIO + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_int, ncd_double + use restUtilMod, only : restartvar + use clm_varcon, only : nameg, nameCohort + use spmdMod, only : iam + use mct_mod, only : mct_gsMap, mct_gsmap_OP + ! + ! !ARGUMENTS: + class(EDRestartVectorClass), intent(inout) :: this + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar + character(len=16) :: dimName = trim(nameCohort) + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmOP ! gsmap ordered points + !----------------------------------------------------------------------- + + ! TODO(wjs, 2014-11-25) gsmap and gsmOP are computed here, but never used. Are these + ! place-holders that are intended to be used at some point, or can they be removed? + call get_clmlevel_gsmap(clmlevel='cohort', gsmap=gsmap) + call mct_gsmap_OP(gsmap, iam, gsmOP) + + ! + ! cohort level vars + ! + call restartvar(ncid=ncid, flag=flag, varname='ed_io_cellWithPatch', xtype=ncd_int, & + dim1name=nameg, & + long_name='1 if a gridcell has a patch', units='1=true,0=false', & + interpinic_flag='interp', data=this%cellWithPatch, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_io_numPatchesPerCell', xtype=ncd_int, & + dim1name=nameg, & + long_name='works with ed_cellWithPatch. num patches per gridcell', units='unitless', & + interpinic_flag='interp', data=this%numPatchesPerCell, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_io_cohortsPerPatch', xtype=ncd_int, & + dim1name=dimName, & + long_name='list of cohorts per patch. indexed by numPatchesPerCell', units='unitless', & + interpinic_flag='interp', data=this%cohortsPerPatch, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_balive', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort ed_balive', units='unitless', & + interpinic_flag='interp', data=this%balive, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_bdead', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - bdead', units='unitless', & + interpinic_flag='interp', data=this%bdead, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_bl', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - bl', units='unitless', & + interpinic_flag='interp', data=this%bl, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_br', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - br', units='unitless', & + interpinic_flag='interp', data=this%br, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_bstore', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - bstore', units='unitless', & + interpinic_flag='interp', data=this%bstore, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_canopy_layer', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - canopy_layer', units='unitless', & + interpinic_flag='interp', data=this%canopy_layer, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_canopy_trim', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - canopy_trim', units='unitless', & + interpinic_flag='interp', data=this%canopy_trim, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_dbh', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - dbh', units='unitless', & + interpinic_flag='interp', data=this%dbh, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_hite', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - hite', units='unitless', & + interpinic_flag='interp', data=this%hite, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_laimemory', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - laimemory', units='unitless', & + interpinic_flag='interp', data=this%laimemory, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_md', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - leaf_md', units='unitless', & + interpinic_flag='interp', data=this%leaf_md, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_root_md', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - root_md', units='unitless', & + interpinic_flag='interp', data=this%root_md, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_n', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - n', units='unitless', & + interpinic_flag='interp', data=this%n, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_gpp_acc', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - gpp_acc', units='unitless', & + interpinic_flag='interp', data=this%gpp_acc, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_npp_acc', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - npp_acc', units='unitless', & + interpinic_flag='interp', data=this%npp_acc, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_resp_clm', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - resp_clm', units='unitless', & + interpinic_flag='interp', data=this%resp_clm, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_pft', xtype=ncd_int, & + dim1name=dimName, & + long_name='ed cohort - pft', units='unitless', & + interpinic_flag='interp', data=this%pft, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_status_coh', xtype=ncd_int, & + dim1name=dimName, & + long_name='ed cohort - status_coh', units='unitless', & + interpinic_flag='interp', data=this%status_coh, & + readvar=readvar) + + ! + ! patch level vars + ! + + call restartvar(ncid=ncid, flag=flag, varname='ed_cwd_ag', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - cwd_ag', units='unitless', & + interpinic_flag='interp', data=this%cwd_ag, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_cwd_bg', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - cwd_bg', units='unitless', & + interpinic_flag='interp', data=this%cwd_bg, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_litter', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - leaf_litter', units='unitless', & + interpinic_flag='interp', data=this%leaf_litter, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_root_litter', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - root_litter', units='unitless', & + interpinic_flag='interp', data=this%root_litter, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_leaf_litter_in', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - leaf_litter_in', units='unitless', & + interpinic_flag='interp', data=this%leaf_litter_in, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_root_litter_in', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - root_litter_in', units='unitless', & + interpinic_flag='interp', data=this%root_litter_in, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_seed_bank', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - seed_bank', units='unitless', & + interpinic_flag='interp', data=this%seed_bank, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_spread', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - spread', units='unitless', & + interpinic_flag='interp', data=this%spread, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_livegrass', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - livegrass', units='unitless', & + interpinic_flag='interp', data=this%livegrass, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_age', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - age', units='unitless', & + interpinic_flag='interp', data=this%age, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_area', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - area', units='unitless', & + interpinic_flag='interp', data=this%areaRestart, & + readvar=readvar) + + ! + ! site level vars + ! + + call restartvar(ncid=ncid, flag=flag, varname='ed_water_memory', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - water_memory', units='unitless', & + interpinic_flag='interp', data=this%water_memory, & + readvar=readvar) + + call restartvar(ncid=ncid, flag=flag, varname='ed_old_stock', xtype=ncd_double, & + dim1name=dimName, & + long_name='ed cohort - old_stock', units='unitless', & + interpinic_flag='interp', data=this%old_stock, & + readvar=readvar) + + deallocate(gsmOP) + + end subroutine doVectorIO + + !-------------------------------------------------------------------------------! + subroutine printDataInfoVector( this ) + ! + ! !DESCRIPTION: + ! + ! !USES: + ! + ! !ARGUMENTS: + class(EDRestartVectorClass), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + character(len=32) :: methodName = 'PDIV ' + integer :: iSta, iSto + !----------------------------------------------------------------------- + + iSta = this%vectorLengthStart + iSto = iSta + 1 + + write(iulog,*) trim(methodName)//' :: this%vectorLengthStart ', & + this%vectorLengthStart + write(iulog,*) trim(methodName)//' :: this%vectorLengthStop ', & + this%vectorLengthStop + + write(iulog,*) ' PDIV chk ',iSta,iSto + write(iulog,*) trim(methodName)//' :: balive ', & + this%balive(iSta:iSto) + write(iulog,*) trim(methodName)//' :: bdead ', & + this%bdead(iSta:iSto) + write(iulog,*) trim(methodName)//' :: bl ', & + this%bl(iSta:iSto) + write(iulog,*) trim(methodName)//' :: br ', & + this%br(iSta:iSto) + write(iulog,*) trim(methodName)//' :: bstore ', & + this%bstore(iSta:iSto) + + write(iulog,*) trim(methodName)//' :: canopy_layer ', & + this%canopy_layer(iSta:iSto) + write(iulog,*) trim(methodName)//' :: canopy_trim ', & + this%canopy_trim(iSta:iSto) + write(iulog,*) trim(methodName)//' :: dbh ', & + this%dbh(iSta:iSto) + + write(iulog,*) trim(methodName)//' :: hite ', & + this%hite(iSta:iSto) + write(iulog,*) trim(methodName)//' :: laimemory ', & + this%laimemory(iSta:iSto) + write(iulog,*) trim(methodName)//' :: leaf_md ', & + this%leaf_md(iSta:iSto) + write(iulog,*) trim(methodName)//' :: root_md ', & + this%root_md(iSta:iSto) + write(iulog,*) trim(methodName)//' :: n ', & + this%n(iSta:iSto) + write(iulog,*) trim(methodName)//' :: gpp_acc ', & + this%gpp_acc(iSta:iSto) + write(iulog,*) trim(methodName)//' :: npp_acc ', & + this%npp_acc(iSta:iSto) + write(iulog,*) trim(methodName)//' :: resp_clm ', & + this%resp_clm(iSta:iSto) + + write(iulog,*) trim(methodName)//' :: pft ', & + this%pft(iSta:iSto) + write(iulog,*) trim(methodName)//' :: status_coh ', & + this%status_coh(iSta:iSto) + + write(iulog,*) trim(methodName)//' :: cwd_ag ', & + this%cwd_ag(iSta:iSto) + write(iulog,*) trim(methodName)//' :: cwd_bg ', & + this%cwd_bg(iSta:iSto) + write(iulog,*) trim(methodName)//' :: leaf_litter ', & + this%leaf_litter(iSta:iSto) + write(iulog,*) trim(methodName)//' :: root_litter ', & + this%root_litter(iSta:iSto) + write(iulog,*) trim(methodName)//' :: leaf_litter_in ', & + this%leaf_litter_in(iSta:iSto) + write(iulog,*) trim(methodName)//' :: root_litter_in ', & + this%root_litter_in(iSta:iSto) + write(iulog,*) trim(methodName)//' :: seed_bank ', & + this%seed_bank(iSta:iSto) + write(iulog,*) trim(methodName)//' :: spread ', & + this%spread(iSta:iSto) + write(iulog,*) trim(methodName)//' :: livegrass ', & + this%livegrass(iSta:iSto) + write(iulog,*) trim(methodName)//' :: age ', & + this%age(iSta:iSto) + write(iulog,*) trim(methodName)//' :: area ', & + this%areaRestart(iSta:iSto) + write(iulog,*) trim(methodName)//' :: water_memory ', & + this%water_memory(iSta:iSto) + write(iulog,*) trim(methodName)//' :: old_stock ', & + this%old_stock(iSta:iSto) + + end subroutine printDataInfoVector + + !-------------------------------------------------------------------------------! + subroutine printDataInfoLL( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! counts the total number of cohorts over all p levels (ed_patch_type) so we + ! can allocate vectors, copy from LL -> vector and read/write restarts. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + integer :: g + integer :: totalCohorts + integer :: numCohort + integer :: numPatches,totPatchCount + character(len=32) :: methodName = 'printDataInfoLL ' + !----------------------------------------------------------------------- + + totalCohorts = 0 + totPatchCount = 1 + + write(iulog,*) 'vecLenStart ',this%vectorLengthStart + + g = bounds%begg + do while(g <= bounds%endg) + + if (ed_allsites_inst(g)%istheresoil) then + currentPatch => ed_allsites_inst(g)%oldest_patch + + numPatches = 1 + + do while(associated(currentPatch)) + currentCohort => currentPatch%shortest + + write(iulog,*) trim(methodName)//':: found gcell with patch(s) ',g + + numCohort = 0 + + do while(associated(currentCohort)) + + totalCohorts = totalCohorts + 1 + + write(iulog,*) trim(methodName)//' balive ' ,totalCohorts,currentCohort%balive + write(iulog,*) trim(methodName)//' bdead ' ,totalCohorts,currentCohort%bdead + write(iulog,*) trim(methodName)//' bl ' ,totalCohorts,currentCohort%bl + write(iulog,*) trim(methodName)//' br ' ,totalCohorts,currentCohort%br + write(iulog,*) trim(methodName)//' bstore ' ,totalCohorts,currentCohort%bstore + write(iulog,*) trim(methodName)//' canopy_layer ' ,totalCohorts,currentCohort%canopy_layer + write(iulog,*) trim(methodName)//' canopy_trim ' ,totalCohorts,currentCohort%canopy_trim + write(iulog,*) trim(methodName)//' dbh ' ,totalCohorts,currentCohort%dbh + write(iulog,*) trim(methodName)//' hite ' ,totalCohorts,currentCohort%hite + write(iulog,*) trim(methodName)//' laimemory ' ,totalCohorts,currentCohort%laimemory + write(iulog,*) trim(methodName)//' leaf_md ' ,totalCohorts,currentCohort%leaf_md + write(iulog,*) trim(methodName)//' root_md ' ,totalCohorts,currentCohort%root_md + write(iulog,*) trim(methodName)//' n ' ,totalCohorts,currentCohort%n + write(iulog,*) trim(methodName)//' gpp_acc ' ,totalCohorts,currentCohort%gpp_acc + write(iulog,*) trim(methodName)//' npp_acc ' ,totalCohorts,currentCohort%npp_acc + write(iulog,*) trim(methodName)//' resp_clm ' ,totalCohorts,currentCohort%resp_clm + write(iulog,*) trim(methodName)//' pft ' ,totalCohorts,currentCohort%pft + write(iulog,*) trim(methodName)//' status_coh ' ,totalCohorts,currentCohort%status_coh + + numCohort = numCohort + 1 + + currentCohort => currentCohort%taller + enddo ! currentCohort do while + + write(iulog,*) trim(methodName)//': numpatches for gcell ',& + ed_allsites_inst(g)%clmgcell, numPatches + + write(iulog,*) trim(methodName)//': patches and cohorts ',& + totPatchCount,numCohort + + write(iulog,*) trim(methodName)//' cwd_ag ' ,currentPatch%cwd_ag + write(iulog,*) trim(methodName)//' cwd_bg ' ,currentPatch%cwd_bg + write(iulog,*) trim(methodName)//' leaf_litter ' ,currentPatch%leaf_litter + write(iulog,*) trim(methodName)//' root_litter ' ,currentPatch%root_litter + write(iulog,*) trim(methodName)//' leaf_litter_in ' ,currentPatch%leaf_litter_in + write(iulog,*) trim(methodName)//' root_litter_in ' ,currentPatch%root_litter_in + write(iulog,*) trim(methodName)//' seed_bank ' ,currentPatch%seed_bank + write(iulog,*) trim(methodName)//' spread ' ,currentPatch%spread + write(iulog,*) trim(methodName)//' livegrass ' ,currentPatch%livegrass + write(iulog,*) trim(methodName)//' age ' ,currentPatch%age + write(iulog,*) trim(methodName)//' area ' ,currentPatch%area + write(iulog,*) trim(methodName)//' old_stock ' ,ed_allsites_inst(g)%old_stock + + currentPatch => currentPatch%younger + + totPatchCount = totPatchCount + 1 + numPatches = numPatches + 1 + enddo ! currentPatch do while + endif + g = g + 1 + + write(iulog,*) trim(methodName)//' water_memory ',ed_allsites_inst(g)%water_memory(1) + + enddo + + write(iulog,*) trim(methodName)//': total cohorts ',totalCohorts + + end subroutine printDataInfoLL + + !-------------------------------------------------------------------------------! + subroutine printIoInfoLL( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! for debugging. prints some IO info regarding cohorts/patches + ! currently prints cohort level variables + ! + ! !USES: + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + integer g + integer totalCohorts + integer numCohort + integer numPatches,totPatchCount + character(len=32) :: methodName = 'printIoInfoLL ' + !----------------------------------------------------------------------- + + totalCohorts = 0 + totPatchCount = 1 + + write(iulog,*) 'vecLenStart ',this%vectorLengthStart + + g = bounds%begg + do while(g <= bounds%endg) + + if (ed_allsites_inst(g)%istheresoil) then + currentPatch => ed_allsites_inst(g)%oldest_patch + + numPatches = 1 + + do while(associated(currentPatch)) + currentCohort => currentPatch%shortest + + write(iulog,*) trim(methodName)//': found gcell with patch(s) ',g + + numCohort = 0 + + do while(associated(currentCohort)) + + totalCohorts = totalCohorts + 1 + numCohort = numCohort + 1 + + write(iulog,*) trim(methodName)//' balive ',numCohort,currentCohort%balive + write(iulog,*) trim(methodName)//' bdead ',currentCohort%bdead + write(iulog,*) trim(methodName)//' bl ',currentCohort%bl + write(iulog,*) trim(methodName)//' br ',currentCohort%br + write(iulog,*) trim(methodName)//' bstore ',currentCohort%bstore + write(iulog,*) trim(methodName)//' canopy_layer ',currentCohort%canopy_layer + write(iulog,*) trim(methodName)//' canopy_trim ',currentCohort%canopy_trim + write(iulog,*) trim(methodName)//' dbh ',currentCohort%dbh + write(iulog,*) trim(methodName)//' hite ',currentCohort%hite + write(iulog,*) trim(methodName)//' laimemory ',currentCohort%laimemory + write(iulog,*) trim(methodName)//' leaf_md ',currentCohort%leaf_md + write(iulog,*) trim(methodName)//' root_md ',currentCohort%root_md + write(iulog,*) trim(methodName)//' n ',currentCohort%n + write(iulog,*) trim(methodName)//' gpp_acc ',currentCohort%gpp_acc + write(iulog,*) trim(methodName)//' npp_acc ',currentCohort%npp_acc + write(iulog,*) trim(methodName)//' resp_clm ',currentCohort%resp_clm + write(iulog,*) trim(methodName)//' pft ',currentCohort%pft + write(iulog,*) trim(methodName)//' status_coh ',currentCohort%status_coh + + currentCohort => currentCohort%taller + enddo ! currentCohort do while + + write(iulog,*) trim(methodName)//': numpatches for gcell ',ed_allsites_inst(g)%clmgcell, numPatches + write(iulog,*) trim(methodName)//': patches and cohorts ',totPatchCount,numCohort + + currentPatch => currentPatch%younger + + totPatchCount = totPatchCount + 1 + numPatches = numPatches + 1 + enddo ! currentPatch do while + endif + g = g + 1 + enddo + + end subroutine printIoInfoLL + + !-------------------------------------------------------------------------------! + subroutine convertCohortListToVector( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! counts the total number of cohorts over all p levels (ed_patch_type) so we + ! can allocate vectors, copy from LL -> vector and read/write restarts. + ! + ! !USES: + use clm_varpar, only : nclmax + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(in), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + type (ed_cohort_type), pointer :: currentCohort + integer :: g + integer :: totalCohorts ! number of cohorts starting from 1 + integer :: countCohort ! number of cohorts starting from + ! vectorLengthStart + integer :: numCohort + integer :: numPatches + integer :: totPatchCount, offsetTotPatchCount + integer :: countPft + integer :: countNcwd + integer :: countWaterMem + integer :: countNclmax + integer :: i, incrementOffset + !----------------------------------------------------------------------- + + totalCohorts = 0 + + incrementOffset = this%vectorLengthStart + countCohort = this%vectorLengthStart + countPft = this%vectorLengthStart + countNcwd = this%vectorLengthStart + countNclmax = this%vectorLengthStart + countWaterMem = this%vectorLengthStart + + g = bounds%begg + do while(g <= bounds%endg) + + if (ed_allsites_inst(g)%istheresoil)then + + currentPatch => ed_allsites_inst(g)%oldest_patch + + ! new grid cell, reset num patches + numPatches = 0 + + do while(associated(currentPatch)) + + ! found patch, increment + numPatches = numPatches + 1 + + currentCohort => currentPatch%shortest + + ! new patch, reset num cohorts + numCohort = 0 + + do while(associated(currentCohort)) + + ! found cohort, increment + numCohort = numCohort + 1 + totalCohorts = totalCohorts + 1 + + if (this%DEBUG) then + write(iulog,*) 'countCohort ',countCohort, this%vectorLengthStart, this%vectorLengthStop + endif + + this%balive(countCohort) = currentCohort%balive + this%bdead(countCohort) = currentCohort%bdead + this%bl(countCohort) = currentCohort%bl + this%br(countCohort) = currentCohort%br + this%bstore(countCohort) = currentCohort%bstore + this%canopy_layer(countCohort) = currentCohort%canopy_layer + this%canopy_trim(countCohort) = currentCohort%canopy_trim + this%dbh(countCohort) = currentCohort%dbh + this%hite(countCohort) = currentCohort%hite + this%laimemory(countCohort) = currentCohort%laimemory + this%leaf_md(countCohort) = currentCohort%leaf_md + this%root_md(countCohort) = currentCohort%root_md + this%n(countCohort) = currentCohort%n + this%gpp_acc(countCohort) = currentCohort%gpp_acc + this%npp_acc(countCohort) = currentCohort%npp_acc + this%resp_clm(countCohort) = currentCohort%resp_clm + this%pft(countCohort) = currentCohort%pft + this%status_coh(countCohort) = currentCohort%status_coh + + if (this%DEBUG) then + write(iulog,*) 'offsetNumCohorts II ',countCohort, & + numCohort + endif + + countCohort = countCohort + 1 + + currentCohort => currentCohort%taller + + enddo ! currentCohort do while + + if ( numCohort > numCohortsPerPatch ) then + write(iulog,*) 'offsetNumCohorts, numCohortsPerPatch ',countCohort, numCohortsPerPatch + call shr_sys_abort( 'error in convertCohortListToVector :: '//& + 'overrun of number of total cohorts in one patch. Try increasing cohorts for '//& + 'IO '//errMsg(__FILE__, __LINE__)) + endif + + ! + ! deal with patch level fields here + ! + this%livegrass(incrementOffset) = currentPatch%livegrass + this%age(incrementOffset) = currentPatch%age + this%areaRestart(incrementOffset) = currentPatch%area + this%old_stock(incrementOffset) = ed_allsites_inst(g)%old_stock + ! set cohorts per patch for IO + this%cohortsPerPatch( incrementOffset ) = numCohort + + if (this%DEBUG) then + write(iulog,*) 'offsetNumCohorts III ' & + ,countCohort,cohorts_per_gcell, numCohort + endif + ! + ! deal with patch level fields of arrays here + ! + ! these are arrays of length numpft_ed, each patch contains one + ! vector so we increment + do i = 1,numpft_ed ! numpft_ed currently 2 + this%leaf_litter(countPft) = currentPatch%leaf_litter(i) + this%root_litter(countPft) = currentPatch%root_litter(i) + this%leaf_litter_in(countPft) = currentPatch%leaf_litter_in(i) + this%root_litter_in(countPft) = currentPatch%root_litter_in(i) + this%seed_bank(countPft) = currentPatch%seed_bank(i) + countPft = countPft + 1 + end do + + do i = 1,ncwd ! ncwd currently 4 + this%cwd_ag(countNcwd) = currentPatch%cwd_ag(i) + this%cwd_bg(countNcwd) = currentPatch%cwd_bg(i) + countNcwd = countNcwd + 1 + end do + + do i = 1,nclmax ! nclmax currently 2 + this%spread(countNclmax) = currentPatch%spread(i) + countNclmax = countNclmax + 1 + end do + + ! set numpatches for this gcell + this%numPatchesPerCell( ed_allsites_inst(g)%clmgcell ) = numPatches + + incrementOffset = incrementOffset + numCohortsPerPatch + ! reset counters so that they are all advanced evenly. Currently + ! the offset is 10, the max of numpft_ed, ncwd, nclmax, + ! countWaterMem and the number of allowed cohorts per patch + countPft = incrementOffset + countNcwd = incrementOffset + countNclmax = incrementOffset + countCohort = incrementOffset + + write(iulog,*) 'incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & + incrementOffset, cohorts_per_gcell, numCohort, totalCohorts + + currentPatch => currentPatch%younger + + enddo ! currentPatch do while + + ! set which gridcells have patches/cohorts + this%cellWithPatch( ed_allsites_inst(g)%clmgcell ) = 1 + + do i = 1,numWaterMem ! numWaterMem currently 10 + this%water_memory( countWaterMem ) = ed_allsites_inst(g)%water_memory(i) + countWaterMem = countWaterMem + 1 + end do + + if ( incrementOffset > cohorts_per_gcell ) then + write(iulog,*) 'incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & + incrementOffset, cohorts_per_gcell, numCohort, totalCohorts + call shr_sys_abort( 'error in convertCohortListToVector :: '//& + 'overrun of number of total cohorts in this gcell. Try increasing cohorts for '//& + 'IO '//errMsg(__FILE__, __LINE__)) + endif + + countWaterMem = incrementOffset + + endif ! is there soil check + + g = g + 1 + + enddo + + if (this%DEBUG) then + write(iulog,*) 'total cohorts ',totalCohorts + end if + + end subroutine convertCohortListToVector + + !-------------------------------------------------------------------------------! + subroutine createPatchCohortStructure( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! counts the total number of cohorts over all p levels (ed_patch_type) so we + ! can allocate vectors, copy from LL -> vector and read/write restarts. + ! + ! !USES: + use EDPatchDynamicsMod , only : zero_patch + use EDGrowthFunctionsMod, only : Dbh + use EDCohortDynamicsMod, only : create_cohort + use EDInitMod , only : zero_site + use EDParamsMod , only : ED_val_maxspread + use EDPatchDynamicsMod , only : create_patch + use GridcellType , only : grc + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type) , pointer :: newp + type(ed_cohort_type), allocatable :: temp_cohort + real(r8) :: cwd_ag_local(ncwd),cwd_bg_local(ncwd),spread_local(nclmax) + real(r8) :: leaf_litter_local(numpft_ed),root_litter_local(numpft_ed) + real(r8) :: seed_bank_local(numpft_ed) + real(r8) :: age !notional age of this patch + integer :: cohortstatus + integer :: g,patchIdx,currIdx, fto, ft + !----------------------------------------------------------------------- + + currIdx = this%vectorLengthStart + + cwd_ag_local = 0.0_r8 !ED_val_init_litter !arbitrary value for litter pools. kgC m-2 ! + cwd_bg_local = 0.0_r8 !ED_val_init_litter + leaf_litter_local = 0.0_r8 + root_litter_local = 0.0_r8 + age = 0.0_r8 + spread_local = ED_val_maxspread + + ! + ! loop over model grid cells and create patch/cohort structure based on + ! restart data + ! + do g = bounds%begg, bounds%endg + + if (this%DEBUG) then + write(iulog,*) 'cellWithPatch ',this%cellWithPatch(g),this%numPatchesPerCell(g) + end if + + call zero_site( ed_allsites_inst(g) ) + ! + ! set a few items that are necessary on restart for ED but not on the + ! restart file + ! + ed_allsites_inst(g)%istheresoil = .true. ! if we are dealing with ED data there will always be soil + ed_allsites_inst(g)%lat = grc%latdeg(g) + ed_allsites_inst(g)%lon = grc%londeg(g) + ed_allsites_inst(g)%gdd = 0.0_r8 + ed_allsites_inst(g)%ncd = 0.0_r8 + + ! then this site has soil and should be set here + do patchIdx = 1,this%numPatchesPerCell(g) + + if (this%DEBUG) then + write(iulog,*) 'create patch ',patchIdx + write(iulog,*) 'patchIdx 1-numCohorts : ',this%cohortsPerPatch(currIdx) + end if + + ! create patch + allocate(newp) + call zero_patch(newp) + + ! make new patch + call create_patch(ed_allsites_inst(g), newp, age, AREA, & + spread_local, cwd_ag_local, cwd_bg_local, & + leaf_litter_local, root_litter_local, seed_bank_local) + + newp%siteptr => ed_allsites_inst(g) + + ! give this patch a unique patch number + newp%patchno = patchIdx + + do fto = 1, this%cohortsPerPatch(currIdx) + + allocate(temp_cohort) + + temp_cohort%n = 700.0_r8 + temp_cohort%balive = 0.0_r8 + temp_cohort%bdead = 0.0_r8 + temp_cohort%bstore = 0.0_r8 + temp_cohort%laimemory = 0.0_r8 + temp_cohort%canopy_trim = 0.0_r8 + temp_cohort%canopy_layer = 1.0_r8 + + ! set the pft (only 2 used in ed) based on odd/even cohort + ! number + ft=2 + if ((mod(fto, 2) == 0 )) then + ft=1 + endif + + cohortstatus = newp%siteptr%status + + if(pftcon%stress_decid(ft) == 1)then !drought decidous, override status. + cohortstatus = newp%siteptr%dstatus + endif + + temp_cohort%hite = 1.25_r8 + ! the dbh function should only take as an argument, the one + ! item it needs, not the entire cohort...refactor + temp_cohort%dbh = Dbh(temp_cohort) + 0.0001_r8*ft + + call create_cohort(newp, ft, temp_cohort%n, temp_cohort%hite, temp_cohort%dbh, & + temp_cohort%balive, temp_cohort%bdead, temp_cohort%bstore, & + temp_cohort%laimemory, cohortstatus, temp_cohort%canopy_trim, newp%NCL_p) + + deallocate(temp_cohort) + + enddo ! ends loop over fto + + ! + ! insert this patch with cohorts into the site pointer. At this + ! point just insert the new patch in the youngest position + ! + if (patchIdx == 1) then ! nothing associated yet. first patch is pointed to by youngest and oldest + + if (this%DEBUG) write(iulog,*) 'patchIdx ',patchIdx + + ed_allsites_inst(g)%youngest_patch => newp + ed_allsites_inst(g)%oldest_patch => newp + ed_allsites_inst(g)%youngest_patch%younger => null() + ed_allsites_inst(g)%youngest_patch%older => null() + ed_allsites_inst(g)%oldest_patch%younger => null() + ed_allsites_inst(g)%oldest_patch%older => null() + + else if (patchIdx == 2) then ! add second patch to list + + if (this%DEBUG) write(iulog,*) 'patchIdx ',patchIdx + + ed_allsites_inst(g)%youngest_patch => newp + ed_allsites_inst(g)%youngest_patch%younger => null() + ed_allsites_inst(g)%youngest_patch%older => ed_allsites_inst(g)%oldest_patch + ed_allsites_inst(g)%oldest_patch%younger => ed_allsites_inst(g)%youngest_patch + ed_allsites_inst(g)%oldest_patch%older => null() + + else ! more than 2 patches, insert patch into youngest slot + + if (this%DEBUG) write(iulog,*) 'patchIdx ',patchIdx + + newp%older => ed_allsites_inst(g)%youngest_patch + ed_allsites_inst(g)%youngest_patch%younger => newp + newp%younger => null() + ed_allsites_inst(g)%youngest_patch => newp + + endif + + currIdx = currIdx + numCohortsPerPatch + + enddo ! ends loop over patchIdx + + enddo ! ends loop over g + + end subroutine createPatchCohortStructure + + !-------------------------------------------------------------------------------! + subroutine convertCohortVectorToList( this, bounds, ed_allsites_inst ) + ! + ! !DESCRIPTION: + ! counts the total number of cohorts over all p levels (ed_patch_type) so we + ! can allocate vectors, copy from LL -> vector and read/write restarts. + ! + ! !USES: + use clm_varpar, only : nclmax + ! + ! !ARGUMENTS: + class(EDRestartVectorClass) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + ! + ! !LOCAL VARIABLES: + type (ed_patch_type), pointer :: currentPatch + type (ed_cohort_type),pointer :: currentCohort + integer :: g + integer :: totalCohorts ! number of cohorts starting from 0 + integer :: countCohort ! number of cohorts starting from + ! vectorLengthStart + integer :: numCohort + integer :: numPatches + integer :: countPft + integer :: countNcwd + integer :: countWaterMem + integer :: countNclmax + integer :: i, incrementOffset + !----------------------------------------------------------------------- + + totalCohorts = 0 + + incrementOffset = this%vectorLengthStart + countCohort = this%vectorLengthStart + countPft = this%vectorLengthStart + countNcwd = this%vectorLengthStart + countNclmax = this%vectorLengthStart + countWaterMem = this%vectorLengthStart + + g = bounds%begg + do while(g <= bounds%endg) + + if (ed_allsites_inst(g)%istheresoil) then + currentPatch => ed_allsites_inst(g)%oldest_patch + + ! new grid cell, reset num patches + numPatches = 0 + + ed_allsites_inst(g)%clmgcell = g + + do while(associated(currentPatch)) + + ! found patch, increment + numPatches = numPatches + 1 + + currentCohort => currentPatch%shortest + + ! new patch, reset num cohorts + numCohort = 0 + + do while(associated(currentCohort)) + + ! found cohort, increment + numCohort = numCohort + 1 + totalCohorts = totalCohorts + 1 + + if (this%DEBUG) then + write(iulog,*) 'CVTL countCohort ',countCohort, this%vectorLengthStart, this%vectorLengthStop + endif + + currentCohort%balive = this%balive(countCohort) + currentCohort%bdead = this%bdead(countCohort) + currentCohort%bl = this%bl(countCohort) + currentCohort%br = this%br(countCohort) + currentCohort%bstore = this%bstore(countCohort) + currentCohort%canopy_layer = this%canopy_layer(countCohort) + currentCohort%canopy_trim = this%canopy_trim(countCohort) + currentCohort%dbh = this%dbh(countCohort) + currentCohort%hite = this%hite(countCohort) + currentCohort%laimemory = this%laimemory(countCohort) + currentCohort%leaf_md = this%leaf_md(countCohort) + currentCohort%root_md = this%root_md(countCohort) + currentCohort%n = this%n(countCohort) + currentCohort%gpp_acc = this%gpp_acc(countCohort) + currentCohort%npp_acc = this%npp_acc(countCohort) + currentCohort%resp_clm = this%resp_clm(countCohort) + currentCohort%pft = this%pft(countCohort) + currentCohort%status_coh = this%status_coh(countCohort) + + if (this%DEBUG) then + write(iulog,*) 'CVTL II ',countCohort, & + numCohort + endif + + countCohort = countCohort + 1 + + currentCohort => currentCohort%taller + + enddo ! currentPatch do while + + if ( numCohort > numCohortsPerPatch ) then + write(iulog,*) 'CVTL offsetNumCohorts, numCohortsPerPatch ',countCohort, numCohortsPerPatch + call shr_sys_abort( 'error in convertCohortListToVector :: '//& + 'overrun of number of total cohorts in one patch. Try increasing cohorts for '//& + 'IO '//errMsg(__FILE__, __LINE__)) + endif + + ! FIX(SPM,032414) move to init if you can...or make a new init function + currentPatch%leaf_litter(:) = 0.0_r8 + currentPatch%root_litter(:) = 0.0_r8 + currentPatch%leaf_litter_in(:) = 0.0_r8 + currentPatch%root_litter_in(:) = 0.0_r8 + currentPatch%seed_bank(:) = 0.0_r8 + currentPatch%spread(:) = 0.0_r8 + + ! + ! deal with patch level fields here + ! + currentPatch%livegrass = this%livegrass(incrementOffset) + currentPatch%age = this%age(incrementOffset) + currentPatch%area = this%areaRestart(incrementOffset) + ed_allsites_inst(g)%old_stock = this%old_stock(incrementOffset) + ! set cohorts per patch for IO + + if (this%DEBUG) then + write(iulog,*) 'CVTL III ' & + ,countCohort,cohorts_per_gcell, numCohort + endif + ! + ! deal with patch level fields of arrays here + ! + ! these are arrays of length numpft_ed, each patch contains one + ! vector so we increment + do i = 1,numpft_ed ! numpft_ed currently 2 + currentPatch%leaf_litter(i) = this%leaf_litter(countPft) + currentPatch%root_litter(i) = this%root_litter(countPft) + currentPatch%leaf_litter_in(i) = this%leaf_litter_in(countPft) + currentPatch%root_litter_in(i) = this%root_litter_in(countPft) + currentPatch%seed_bank(i) = this%seed_bank(countPft) + countPft = countPft + 1 + end do + + do i = 1,ncwd ! ncwd currently 4 + currentPatch%cwd_ag(i) = this%cwd_ag(countNcwd) + currentPatch%cwd_bg(i) = this%cwd_bg(countNcwd) + countNcwd = countNcwd + 1 + end do + + do i = 1,nclmax ! nclmax currently 2 + currentPatch%spread(i) = this%spread(countNclmax) + countNclmax = countNclmax + 1 + end do + + incrementOffset = incrementOffset + numCohortsPerPatch + ! reset counters so that they are all advanced evenly. Currently + ! the offset is 10, the max of numpft_ed, ncwd, nclmax, + ! countWaterMem and the number of allowed cohorts per patch + countPft = incrementOffset + countNcwd = incrementOffset + countNclmax = incrementOffset + countCohort = incrementOffset + + if (this%DEBUG) then + write(iulog,*) 'CVTL incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & + incrementOffset, cohorts_per_gcell, numCohort, totalCohorts + endif + + currentPatch => currentPatch%younger + + enddo ! currentPatch do while + + do i = 1,numWaterMem + ed_allsites_inst(g)%water_memory(i) = this%water_memory( countWaterMem ) + countWaterMem = countWaterMem + 1 + end do + + if ( incrementOffset > cohorts_per_gcell ) then + write(iulog,*) 'CVTL incrementOffset, cohorts_per_gcell, numCohort, totalCohorts ', & + incrementOffset, cohorts_per_gcell, numCohort, totalCohorts + call shr_sys_abort( 'error in convertCohortListToVector :: '//& + 'overrun of number of total cohorts in this gcell. Try increasing cohorts for '//& + 'IO '//errMsg(__FILE__, __LINE__)) + endif + + countWaterMem = incrementOffset + + endif ! is there soil check + + g = g + 1 + + enddo + + if (this%DEBUG) then + write(iulog,*) 'CVTL total cohorts ',totalCohorts + end if + + end subroutine convertCohortVectorToList + + !--------------------------------------------! + ! Non Type-Bound Procedures Here: + !--------------------------------------------! + + !-------------------------------------------------------------------------------! + subroutine EDRest ( bounds, ncid, flag, ed_allsites_inst, ed_clm_inst, ed_phenology_inst, & + waterstate_inst, canopystate_inst ) + ! + ! !DESCRIPTION: + ! Read/write ED restart data + ! EDRest called from restFileMod.F90 + ! + ! !USES: + use ncdio_pio , only : file_desc_t + use EDCLMLinkMod , only : ed_clm_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(ed_clm_type) , intent(inout) :: ed_clm_inst + type(ed_phenology_type) , intent(inout) :: ed_phenology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + type(EDRestartVectorClass) :: ervc + !----------------------------------------------------------------------- + ! + ! Note: ed_allsites_inst already exists and is allocated in clm_instInit + ! + ervc = newEDRestartVectorClass( bounds ) + + if ( flag == 'write' ) then + call ervc%setVectors( bounds, ed_allsites_inst(bounds%begg:bounds%endg) ) + endif + + call ervc%doVectorIO( ncid, flag ) + + if ( flag == 'read' ) then + call ervc%getVectors( bounds, ed_allsites_inst(bounds%begg:bounds%endg), ed_clm_inst, & + ed_phenology_inst, waterstate_inst, canopystate_inst) + endif + + call ervc%deleteEDRestartVectorClass () + + end subroutine EDRest + +end module EDRestVectorMod diff --git a/components/clm/src/ED/main/EDTypesMod.F90 b/components/clm/src/ED/main/EDTypesMod.F90 new file mode 100755 index 0000000000..1362b0480a --- /dev/null +++ b/components/clm/src/ED/main/EDTypesMod.F90 @@ -0,0 +1,457 @@ +module EDTypesMod + + use shr_kind_mod , only : r8 => shr_kind_r8; + use decompMod , only : bounds_type + use clm_varpar , only : nlevcan_ed, nclmax, numrad, nlevgrnd + use domainMod , only : domain_type + use shr_sys_mod , only : shr_sys_flush + + implicit none + save + + !SWITCHES THAT ARE READ IN + integer RESTART ! restart flag, 1= read initial system state 0 = bare ground + + ! MODEL PARAMETERS + real(r8) :: timestep_secs ! subdaily timestep in seconds (e.g. 1800 or 3600) + integer :: n_sub ! num of substeps in year + real(r8), parameter :: AREA = 10000.0_r8 ! Notional area of simulated forest m2 + integer doy + + integer, parameter :: invalidValue = -9999 ! invalid value for gcells, + ! cohorts, and patches + + ! for setting number of patches per gridcell and number of cohorts per patch + ! for I/O and converting to a vector + integer, parameter :: numPatchesPerGridCell = 4 ! + integer, parameter :: numCohortsPerPatch = 20 ! + integer, parameter :: cohorts_per_gcell = 80 ! should be numPatchesPerGridCell*numCohortsPerPatch + integer, parameter :: numWaterMem = 10 ! watermemory saved as site level var + + ! BIOLOGY/BIOGEOCHEMISTRY + integer , parameter :: INTERNAL_RECRUITMENT = 1 ! internal recruitment fla 1=yes + integer , parameter :: EXTERNAL_RECRUITMENT = 0 ! external recruitment flag 1=yes + integer , parameter :: SENES = 10 ! Window of time over which we track temp for cold sensecence (days) + real(r8), parameter :: DINC_ED = 1.0_r8 ! size of LAI bins. + integer , parameter :: N_DIST_TYPES = 2 ! number of disturbance types (mortality, fire) + integer , parameter :: numpft_ed = 2 ! number of PFTs used in ED. + + ! SPITFIRE + integer , parameter :: NLSC = 5 ! number carbon compartments in above ground litter array + integer , parameter :: NFSC = 6 ! number fuel size classes + integer , parameter :: N_EF = 7 ! number of emission factors. One per trace gas or aerosol species. + integer, parameter :: NCWD = 4 ! number of coarse woody debris pools + integer, parameter :: lg_sf = 6 ! array index of live grass pool for spitfire + integer, parameter :: dg_sf = 1 ! array index of dead grass pool for spitfire + integer, parameter :: tr_sf = 5 ! array index of dead trunk pool for spitfire + integer, parameter :: lb_sf = 4 ! array index of lrge branch pool for spitfire + real(r8), parameter :: fire_threshold = 35.0_r8 ! threshold for fires that spread or go out. KWm-2 + + ! COHORT FUSION + real(r8), parameter :: FUSETOL = 0.6_r8 ! min fractional difference in dbh between cohorts + + ! PATCH FUSION + real(r8), parameter :: NTOL = 0.05_r8 ! min plant density for hgt bin to be used in height profile comparisons + real(r8), parameter :: HITEMAX = 30.0_r8 ! max dbh value used in hgt profile comparison + real(r8), parameter :: DBHMAX = 150.0_r8 ! max dbh value used in hgt profile comparison + integer , parameter :: N_HITE_BINS = 60 ! no. of hite bins used to distribute LAI + integer , parameter :: N_DBH_BINS = 5 ! no. of dbh bins used when comparing patches + + character*4 yearchar + + !************************************ + !** COHORT type structure ** + !************************************ + type ed_cohort_type + + ! POINTERS + type (ed_cohort_type) , pointer :: taller => null() ! pointer to next tallest cohort + type (ed_cohort_type) , pointer :: shorter => null() ! pointer to next shorter cohort + type (ed_patch_type) , pointer :: patchptr => null() ! pointer to patch that cohort is in + type (ed_site_type) , pointer :: siteptr => null() ! pointer to site that cohort is in + + ! VEGETATION STRUCTURE + integer :: pft ! pft number + real(r8) :: n ! number of individuals in cohort per 'area' (10000m2 default) + real(r8) :: dbh ! dbh: cm + real(r8) :: hite ! height: meters + integer :: indexnumber ! unique number for each cohort. (within clump?) + real(r8) :: balive ! total living biomass: kGC per indiv + real(r8) :: bdead ! dead biomass: kGC per indiv + real(r8) :: bstore ! stored carbon: kGC per indiv + real(r8) :: laimemory ! target leaf biomass- set from previous year: kGC per indiv + integer :: canopy_layer ! canopy status of cohort (1 = canopy, 2 = understorey, etc.) + real(r8) :: b ! total biomass: kGC per indiv + real(r8) :: bsw ! sapwood in stem and roots: kGC per indiv + real(r8) :: bl ! leaf biomass: kGC per indiv + real(r8) :: br ! fine root biomass: kGC per indiv + real(r8) :: lai ! leaf area index of cohort m2/m2 + real(r8) :: sai ! stem area index of cohort m2/m2 + real(r8) :: gscan ! Stomatal resistance of cohort. + real(r8) :: canopy_trim ! What is the fraction of the maximum leaf biomass that we are targeting? :- + real(r8) :: leaf_cost ! How much does it cost to maintain leaves: kgC/m2/year-1 + real(r8) :: excl_weight ! How much of this cohort is demoted each year, as a proportion of all cohorts:- + real(r8) :: prom_weight ! How much of this cohort is promoted each year, as a proportion of all cohorts:- + integer :: nv ! Number of leaf layers: - + integer :: status_coh ! growth status of plant (2 = leaves on , 1 = leaves off) + real(r8) :: c_area ! areal extent of canopy (m2) + real(r8) :: treelai ! lai of tree (total leaf area (m2) / canopy area (m2) + real(r8) :: treesai ! stem area index of tree (total stem area (m2) / canopy area (m2) + + ! CARBON FLUXES + real(r8) :: gpp ! GPP: kgC/indiv/year + real(r8) :: gpp_acc ! GPP: kgC/indiv/day + real(r8) :: gpp_clm ! GPP: kgC/indiv/timestep + real(r8) :: npp ! NPP: kgC/indiv/year + real(r8) :: npp_acc ! NPP: kgC/indiv/day + real(r8) :: npp_clm ! NPP: kgC/indiv/timestep + real(r8) :: resp ! Resp: kgC/indiv/year + real(r8) :: resp_acc ! Resp: kgC/indiv/day + real(r8) :: resp_clm ! Resp: kgC/indiv/timestep + + real(r8) :: ts_net_uptake(nlevcan_ed) ! Net uptake of leaf layers: kgC/m2/s + real(r8) :: year_net_uptake(nlevcan_ed) ! Net uptake of leaf layers: kgC/m2/year + + ! RESPIRATION COMPONENTS + real(r8) :: rd ! Dark respiration: umol/indiv/s + real(r8) :: resp_g ! Growth respiration: kgC/indiv/timestep + real(r8) :: resp_m ! Maintenance respiration: kgC/indiv/timestep + real(r8) :: livestem_mr ! Live stem maintenance respiration: kgC/indiv/s + real(r8) :: livecroot_mr ! Live coarse root maintenance respiration: kgC/indiv/s + real(r8) :: froot_mr ! Live fine root maintenance respiration: kgC/indiv/s + + ! ALLOCATION + real(r8) :: md ! plant maintenance demand: kgC/indiv/year + real(r8) :: leaf_md ! leaf maintenance demand: kgC/indiv/year + real(r8) :: root_md ! root maintenance demand: kgC/indiv/year + real(r8) :: carbon_balance ! carbon remaining for growth and storage: kg/indiv/year + real(r8) :: seed_prod ! reproduction seed and clonal: KgC/indiv/year + real(r8) :: leaf_litter ! leaf litter from phenology: KgC/m2 + real(r8) :: woody_turnover ! amount of wood lost each day: kgC/indiv/year. Currently set to zero. + + !MORTALITY + real(r8) :: dmort ! proportional mortality rate. (year-1) + + ! NITROGEN POOLS + real(r8) :: livestemn ! live stem nitrogen : KgN/invid + real(r8) :: livecrootn ! live coarse root nitrogen: KgN/invid + real(r8) :: frootn ! fine root nitrogen : KgN/invid + + ! GROWTH DERIVIATIVES + real(r8) :: dndt ! time derivative of cohort size : n/year + real(r8) :: dhdt ! time derivative of height : m/year + real(r8) :: ddbhdt ! time derivative of dbh : cm/year + real(r8) :: dbalivedt ! time derivative of total living biomass : KgC/year + real(r8) :: dbdeaddt ! time derivative of dead biomass : KgC/year + real(r8) :: dbstoredt ! time derivative of stored biomass : KgC/year + real(r8) :: storage_flux ! flux from npp into bstore : KgC/year + + ! FIRE + real(r8) :: cfa ! proportion of crown affected by fire:- + real(r8) :: cambial_mort ! probability that trees dies due to cambial char:- + real(r8) :: crownfire_mort ! probability of tree post-fire mortality due to crown scorch:- + real(r8) :: fire_mort ! post-fire mortality from cambial and crown damage assuming two are independent:- + + end type ed_cohort_type + + !************************************ + !** Patch type structure ** + !************************************ + + type ed_patch_type + + ! POINTERS + type (ed_cohort_type), pointer :: tallest => null() ! pointer to patch's tallest cohort + type (ed_cohort_type), pointer :: shortest => null() ! pointer to patch's shortest cohort + type (ed_patch_type), pointer :: older => null() ! pointer to next older patch + type (ed_patch_type), pointer :: younger => null() ! pointer to next younger patch + type (ed_site_type), pointer :: siteptr => null() ! pointer to the site that the patch is in + + !INDICES + integer :: patchno ! unique number given to each new patch created for tracking + integer :: clm_pno ! clm patch number (index of p vector) + + ! PATCH INFO + real(r8) :: age ! average patch age: years + real(r8) :: area ! patch area: m2 + integer :: countcohorts ! Number of cohorts in patch + integer :: ncl_p ! Number of occupied canopy layers + + ! LEAF ORGANIZATION + real(r8) :: spread(nclmax) ! dynamic ratio of dbh to canopy area: cm/m2 + real(r8) :: pft_agb_profile(numpft_ed,n_dbh_bins) ! binned above ground biomass, for patch fusion: KgC/m2 + real(r8) :: canopy_layer_lai(nclmax) ! lai that is shading this canopy layer: m2/m2 + real(r8) :: total_canopy_area ! area that is covered by vegetation : m2 + real(r8) :: total_tree_area ! area that is covered by woody vegetation : m2 + real(r8) :: canopy_area ! area that is covered by vegetation : m2 (is this different to total_canopy_area? + real(r8) :: bare_frac_area ! bare soil in this patch expressed as a fraction of the total soil surface. + real(r8) :: lai ! leaf area index of patch + + real(r8) :: tlai_profile(nclmax,numpft_ed,nlevcan_ed) ! total leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: elai_profile(nclmax,numpft_ed,nlevcan_ed) ! exposed leaf area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: tsai_profile(nclmax,numpft_ed,nlevcan_ed) ! total stem area in each canopy layer, pft, and leaf layer. m2/m2 + real(r8) :: esai_profile(nclmax,numpft_ed,nlevcan_ed) ! exposed stem area in each canopy layer, pft, and leaf layer. m2/m2 + + real(r8) :: canopy_area_profile(nclmax,numpft_ed,nlevcan_ed) ! fraction of canopy in each canopy + ! layer, pft, and leaf layer:- + integer :: present(nclmax,numpft_ed) ! is there any of this pft in this canopy layer? + integer :: nrad(nclmax,numpft_ed) ! number of exposed leaf layers for each canopy layer and pft + integer :: ncan(nclmax,numpft_ed) ! number of total leaf layers for each canopy layer and pft + + !RADIATION FLUXES + real(r8) :: fabd_sun_z(nclmax,numpft_ed,nlevcan_ed) ! sun fraction of direct light absorbed by each canopy + ! layer, pft, and leaf layer:- + real(r8) :: fabd_sha_z(nclmax,numpft_ed,nlevcan_ed) ! shade fraction of direct light absorbed by each canopy + ! layer, pft, and leaf layer:- + real(r8) :: fabi_sun_z(nclmax,numpft_ed,nlevcan_ed) ! sun fraction of indirect light absorbed by each canopy + ! layer, pft, and leaf layer:- + real(r8) :: fabi_sha_z(nclmax,numpft_ed,nlevcan_ed) ! shade fraction of indirect light absorbed by each canopy + ! layer, pft, and leaf layer:- + + real(r8) :: ed_laisun_z(nclmax,numpft_ed,nlevcan_ed) ! amount of LAI in the sun in each canopy layer, + ! pft, and leaf layer. m2/m2 + real(r8) :: ed_laisha_z(nclmax,numpft_ed,nlevcan_ed) ! amount of LAI in the shade in each canopy layer, + real(r8) :: ed_parsun_z(nclmax,numpft_ed,nlevcan_ed) ! PAR absorbed in the sun in each canopy layer, + real(r8) :: ed_parsha_z(nclmax,numpft_ed,nlevcan_ed) ! PAR absorbed in the shade in each canopy layer, + real(r8) :: f_sun(nclmax,numpft_ed,nlevcan_ed) ! fraction of leaves in the sun in each canopy layer, pft, + ! and leaf layer. m2/m2 + real(r8) :: tr_soil_dir(numrad) ! fraction of incoming direct radiation that + ! is transmitted to the soil as direct + real(r8) :: tr_soil_dif(numrad) ! fraction of incoming diffuse radiation that + ! is transmitted to the soil as diffuse + real(r8) :: tr_soil_dir_dif(numrad) ! fraction of incoming direct radiation that + ! is transmitted to the soil as diffuse + real(r8) :: fab(numrad) ! fraction of incoming total radiation that is absorbed by the canopy + real(r8) :: fabd(numrad) ! fraction of incoming direct radiation that is absorbed by the canopy + real(r8) :: fabi(numrad) ! fraction of incoming diffuse radiation that is absorbed by the canopy + real(r8) :: sabs_dir(numrad) ! fraction of incoming direct radiation that is absorbed by the canopy + real(r8) :: sabs_dif(numrad) ! fraction of incoming diffuse radiation that is absorbed by the canopy + + + !SEED BANK + real(r8) :: seed_bank(numpft_ed) ! seed pool in KgC/m2/year + real(r8) :: seeds_in(numpft_ed) ! seed production KgC/m2/year + real(r8) :: seed_decay(numpft_ed) ! seed decay in KgC/m2/year + real(r8) :: seed_germination(numpft_ed) ! germination rate of seed pool in KgC/m2/year + real(r8) :: dseed_dt(numpft_ed) + + ! PHOTOSYNTHESIS + real(r8) :: psn_z(nclmax,numpft_ed,nlevcan_ed) ! carbon assimilation in each canopy layer, pft, and leaf layer. umolC/m2/s + real(r8) :: gpp ! total patch gpp: KgC/m2/year + real(r8) :: npp ! total patch npp: KgC/m2/year + + ! ROOTS + real(r8), allocatable :: rootfr_ft(:,:) ! root fraction of each PFT in each soil layer:- + real(r8), allocatable :: rootr_ft(:,:) ! fraction of water taken from each PFT and soil layer:- + real(r8) :: btran_ft(numpft_ed) ! btran calculated seperately for each PFT:- + + ! DISTURBANCE + real(r8) :: disturbance_rates(n_dist_types) ! disturbance rate from 1) mortality and 2) fire: fraction/day + real(r8) :: disturbance_rate ! larger effective disturbance rate: fraction/day + + ! LITTER AND COARSE WOODY DEBRIS + ! Pools of litter (non respiring) + real(r8) :: cwd_ag(ncwd) ! above ground coarse wood debris litter that does not respire. KgC/m2 + real(r8) :: cwd_bg(ncwd) ! below ground coarse wood debris litter that does not respire. KgC/m2 + real(r8) :: leaf_litter(numpft_ed) ! above ground leaf litter that does not respire. KgC/m2 + real(r8) :: root_litter(numpft_ed) ! below ground fine root litter that does not respire. KgC/m2 + + ! Fluxes of litter (non respiring) + real(r8) :: fragmentation_scaler ! Scale rate of litter fragmentation. 0 to 1. + real(r8) :: cwd_ag_in(ncwd) ! Flux into CWD_AG from turnover and mortality KgC/m2/y + real(r8) :: cwd_bg_in(ncwd) ! Flux into cwd_bg from root turnover and mortality KgC/m2/y + real(r8) :: cwd_ag_out(ncwd) ! Flux out of AG CWD into AG litter KgC/m2/y + real(r8) :: cwd_bg_out(ncwd) ! Flux out of BG CWD into BG litter KgC/m2/ + + + real(r8) :: leaf_litter_in(numpft_ed) ! Flux in to AG leaf litter from leaf turnover and mortality KgC/m2/y + real(r8) :: leaf_litter_out(numpft_ed) ! Flux out of AG leaf litter from fragmentation KgC/m2/y + real(r8) :: root_litter_in(numpft_ed) ! Flux in to BG root litter from leaf turnover and mortality KgC/m2/y + real(r8) :: root_litter_out(numpft_ed) ! Flux out of BG root from fragmentation KgC/m2/y + + ! Derivatives of litter (non respiring) + real(r8) :: dcwd_AG_dt(ncwd) ! rate of change of above ground CWD in each size class: KgC/m2/year. + real(r8) :: dcwd_BG_dt(ncwd) ! rate of change of below ground CWD in each size class: KgC/m2/year. + real(r8) :: dleaf_litter_dt(numpft_ed) ! rate of change of leaf litter in each size class: KgC/m2/year. + real(r8) :: droot_litter_dt(numpft_ed) ! rate of change of root litter in each size class: KgC/m2/year. + + real(r8) :: canopy_mortality_woody_litter ! flux of wood litter in to litter pool: KgC/m2/year + real(r8) :: canopy_mortality_leaf_litter(numpft_ed) ! flux in to leaf litter from tree death: KgC/m2/year + real(r8) :: canopy_mortality_root_litter(numpft_ed) ! flux in to froot litter from tree death: KgC/m2/year + + real(r8) :: repro(numpft_ed) ! allocation to reproduction per PFT : KgC/m2 + + !FUEL CHARECTERISTICS + real(r8) :: sum_fuel ! total ground fuel related to ros (omits 1000hr fuels): KgC/m2 + real(r8) :: fuel_frac(ncwd+2) ! fraction of each litter class in the ros_fuel:-. + real(r8) :: livegrass ! total aboveground grass biomass in patch. KgC/m2 + real(r8) :: fuel_bulkd ! average fuel bulk density of the ground fuel + ! (incl. live grasses. omits 1000hr fuels). KgC/m3 + real(r8) :: fuel_sav ! average surface area to volume ratio of the ground fuel + ! (incl. live grasses. omits 1000hr fuels). + real(r8) :: fuel_mef ! average moisture of extinction factor + ! of the ground fuel (incl. live grasses. omits 1000hr fuels). + real(r8) :: fuel_eff_moist ! effective avearage fuel moisture content of the ground fuel + ! (incl. live grasses. omits 1000hr fuels) + real(r8) :: litter_moisture(ncwd+2) + + ! FIRE SPREAD + real(r8) :: ros_front ! rate of forward spread of fire: m/min + real(r8) :: ros_back ! rate of backward spread of fire: m/min + real(r8) :: effect_wspeed ! windspeed modified by fraction of relative grass and tree cover: m/min + real(r8) :: tau_l ! Duration of lethal heating: mins + real(r8) :: fi ! average fire intensity of flaming front: kj/m/s or kw/m + integer :: fire ! Is there a fire? 1=yes 0=no + real(r8) :: fd ! fire duration: mins + real(r8) :: nf ! number of fires initiated daily: n/gridcell/day + real(r8) :: sh ! average scorch height: m + + ! FIRE EFFECTS + real(r8) :: ab ! area burnt: m2/day + real(r8) :: frac_burnt ! fraction burnt: frac gridcell/day + real(r8) :: tfc_ros ! total fuel consumed - no trunks. KgC/m2/day + real(r8) :: burnt_frac_litter(nfsc) ! fraction of each litter pool burned:- + + contains + + procedure, public :: set_root_fraction + + end type ed_patch_type + + !************************************ + !** Site type structure ** + !************************************ + + type ed_site_type + + ! POINTERS + type (ed_patch_type), pointer :: oldest_patch => null() ! pointer to oldest patch at the site + type (ed_patch_type), pointer :: youngest_patch => null() ! pointer to yngest patch at the site + + ! INDICES + real(r8) :: lat ! latitude: degrees + real(r8) :: lon ! longitude: degrees + integer :: clmgcell ! gridcell index + integer :: clmcolumn ! column index (assuming there is only one soil column in each gcell. + logical :: istheresoil ! are there any soil columns, or is this all ice/rocks/lakes? + + ! CARBON BALANCE + real(r8) :: flux_in ! for carbon balance purpose. C coming into biomass pool: KgC/site + real(r8) :: flux_out ! for carbon balance purpose. C leaving ED pools KgC/site + real(r8) :: old_stock ! for accounting purposes, remember biomass stock from last time: KgC/site + + ! DISTURBANCE + real(r8) :: disturbance_mortality ! site level disturbance rates from mortality. + real(r8) :: disturbance_fire ! site level disturbance rates from fire. + integer :: dist_type ! disturbance dist_type id. + real(r8) :: disturbance_rate ! site total dist rate + + ! PHENOLOGY + integer :: status ! are leaves in this pixel on or off for cold decid + integer :: dstatus ! are leaves in this pixel on or off for drought decid + real(r8) :: gdd ! growing degree days: deg C. + real(r8) :: ncd ! no chilling days:- + real(r8) :: last_n_days(senes) ! record of last 10 days temperature for senescence model. deg C + integer :: leafondate ! doy of leaf on:- + integer :: leafoffdate ! doy of leaf off:- + integer :: dleafondate ! doy of leaf on drought:- + integer :: dleafoffdate ! doy of leaf on drought:- + real(r8) :: water_memory(10) ! last 10 days of soil moisture memory... + real(r8) :: cwd_ag_burned(ncwd) + real(r8) :: leaf_litter_burned(numpft_ed) + + ! FIRE + real(r8) :: acc_ni ! daily nesterov index accumulating over time. + real(r8) :: ab ! daily burnt area: m2 + real(r8) :: frac_burnt ! fraction of soil burnt in this day. + + end type ed_site_type + + !************************************ + !** Userdata type structure ** + !************************************ + + type userdata + integer :: cohort_number ! Counts up the number of cohorts which have been made. + real(r8) :: deltat ! fraction of year used for each timestep (1/N_SUB) + integer :: time_period ! Within year timestep (1:N_SUB) day of year + integer :: restart_year ! Which year of simulation are we starting in? + end type userdata + + type(userdata), public, target :: udata + !-------------------------------------------------------------------------------------! + +contains + + !-------------------------------------------------------------------------------------! + function map_clmpatch_to_edpatch(site, clmpatch_number) result(edpatch_pointer) + ! + ! !ARGUMENTS + type(ed_site_type), intent(in), target :: site + integer, intent(in) :: clmpatch_number + ! + ! !LOCAL VARIABLES: + type(ed_patch_type), pointer :: edpatch_pointer + !---------------------------------------------------------------------- + + ! There is a one-to-one mapping between edpatches and clmpatches. To obtain + ! this mapping - the following is computed elsewhere in the code base + ! (1) what is the weight respective to the column of clmpatch? + ! dynEDMod determines this via the following logic + ! if (clm_patch%is_veg(p) .or. clm_patch%is_bareground(p)) then + ! clm_patch%wtcol(p) = clm_patch%wt_ed(p) + ! else + ! clm_patch%wtcol(p) = 0.0_r8 + ! end if + ! (2) is the clmpatch active? + ! subgridWeightsMod uses the following logic (in routine is_active_p) to determine if + ! clmpatch_number is active ( this is a shortened version of the logic to capture + ! only the essential parts relevent here) + ! if (clmpatch%wtcol(p) > 0._r8) is_active_p = .true. + + edpatch_pointer => site%oldest_patch + do while ( clmpatch_number /= edpatch_pointer%clm_pno ) + edpatch_pointer => edpatch_pointer%younger + end do + + end function map_clmpatch_to_edpatch + + !-------------------------------------------------------------------------------------! + subroutine set_root_fraction( this ) + ! + ! !DESCRIPTION: + ! Calculates the fractions of the root biomass in each layer for each pft. + ! + ! !USES: + use PatchType , only : clmpatch => patch + use ColumnType , only : col + use clm_varpar , only : nlevsoi + use pftconMod , only : pftcon + ! + ! !ARGUMENTS + class(ed_patch_type) :: this + ! + ! !LOCAL VARIABLES: + integer :: lev,p,c,ft + !---------------------------------------------------------------------- + + p = this%clm_pno + c = clmpatch%column(p) + + do ft = 1,numpft_ed + do lev = 1, nlevgrnd + this%rootfr_ft(ft,lev) = 0._r8 + enddo + + do lev = 1, nlevsoi-1 + this%rootfr_ft(ft,lev) = .5_r8*( & + exp(-pftcon%roota_par(ft) * col%zi(c,lev-1)) & + + exp(-pftcon%rootb_par(ft) * col%zi(c,lev-1)) & + - exp(-pftcon%roota_par(ft) * col%zi(c,lev)) & + - exp(-pftcon%rootb_par(ft) * col%zi(c,lev))) + end do + end do + + end subroutine set_root_fraction + +end module EDTypesMod diff --git a/components/clm/src/ED/main/EDVecCohortType.F90 b/components/clm/src/ED/main/EDVecCohortType.F90 new file mode 100644 index 0000000000..96dc04e9b7 --- /dev/null +++ b/components/clm/src/ED/main/EDVecCohortType.F90 @@ -0,0 +1,42 @@ +module EDVecCohortType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! cohortype. mimics CLM vector subgrid types. For now this holds ED data that is + ! necessary in the rest of CLM + ! + ! !USES: + + ! !PUBLIC TYPES: + implicit none + public + ! + type, public :: ed_vec_cohort_type + integer :: cohorts_per_gridcell + integer , pointer :: gridcell(:) !index into gridcell level quantities + contains + procedure, public :: Init + end type ed_vec_cohort_type + + type(ed_vec_cohort_type), public :: ed_vec_cohort + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, beg, end) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(ed_vec_cohort_type) :: this + integer, intent(in) :: beg, end + !------------------------------------------------------------------------ + + ! FIX(SPM,032414) pull this out and put in own ED source + + allocate(this%gridcell(beg:end)) + + end subroutine Init + +end module EDVecCohortType diff --git a/components/clm/src/README.unit_testing b/components/clm/src/README.unit_testing new file mode 100644 index 0000000000..c782b26a02 --- /dev/null +++ b/components/clm/src/README.unit_testing @@ -0,0 +1,11 @@ +# To run all CIME unit tests on caldera, run the following command: +# (Note that this must be done from an interactive caldera session, not from yellowstone) +# (One way to do that is to prepend with the "execca" utility that sends the resulting command to caldera) +# NOTE: YOU MUST HAVE "." IN YOUR PATH FOR THIS TO WORK!!!! +execca ../../../cime/tools/unit_testing/run_tests.py --test-spec-dir=. --compiler=intel --mpilib=mpich2 \ +--mpirun-command=mpirun.lsf --cmake-args=-DPAPI_LIB=/glade/apps/opt/papi/5.3.0/intel/12.1.5/lib64 & + +# The inclusion of PAPI_LIB is needed above since config_compilers includes: +# -Wl,-rpath ${PAPI_LIB} -L${PAPI_LIB} -lpapi +# On a different machine besides yellowstone the path would obviously be different + diff --git a/components/clm/src/biogeochem/C14BompbSpikeMod.F90 b/components/clm/src/biogeochem/C14BompbSpikeMod.F90 new file mode 100644 index 0000000000..5f1cae914d --- /dev/null +++ b/components/clm/src/biogeochem/C14BompbSpikeMod.F90 @@ -0,0 +1,134 @@ +module C14BombSpikeMod + + !----------------------------------------------------------------------- + ! Module for transient pulse simulation + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_curr_date,get_days_per_year + use clm_varcon , only : c14ratio, secspday + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: C14BombSpike + public:: C14_init_BombSpike + + ! !PUBLIC TYPES: + logical , public :: use_c14_bombspike = .false. ! do we use time-varying atmospheric C14? + character(len=256) , public :: atm_c14_filename = ' ' ! file name of C14 input data + + ! !PRIVATE TYPES: + real(r8), allocatable, private :: atm_c14file_time(:) + real(r8), allocatable, private :: atm_delta_c14(:) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine C14BombSpike( rc14_atm ) + ! + ! !DESCRIPTION: + ! for transient pulse simulation, impose a simplified bomb spike + ! + ! !ARGUMENTS: + real(r8), intent(out) :: rc14_atm + ! + ! !LOCAL VARIABLES: + integer :: yr, mon, day, tod, offset + real(r8) :: dateyear + real(r8) :: delc14o2_atm + real(r8) :: days_per_year ! days per year + integer :: fp, p, nt + integer :: ind_below + integer :: ntim_atm_ts + real(r8) :: twt_1, twt_2 ! weighting fractions for interpolating + !----------------------------------------------------------------------- + + ! get current date + call get_curr_date(yr, mon, day, tod, offset) + days_per_year = get_days_per_year() + dateyear = real(yr) + real(mon)/12._r8 + real(day)/days_per_year + real(tod)/(secspday*days_per_year) + + ! find points in atm timeseries to interpolate between + ntim_atm_ts = size(atm_c14file_time) + ind_below = 0 + do nt = 1, ntim_atm_ts + if (dateyear >= atm_c14file_time(nt) ) then + ind_below = ind_below+1 + endif + end do + + ! interpolate between nearest two points in atm c14 timeseries + if (ind_below .eq. 0 ) then + delc14o2_atm = atm_delta_c14(1) + elseif (ind_below .eq. ntim_atm_ts ) then + delc14o2_atm = atm_delta_c14(ntim_atm_ts) + else + twt_2 = min(1._r8, max(0._r8,(dateyear-atm_c14file_time(ind_below)) & + / (atm_c14file_time(ind_below+1)-atm_c14file_time(ind_below)))) + twt_1 = 1._r8 - twt_2 + delc14o2_atm = atm_delta_c14(ind_below) * twt_1 + atm_delta_c14(ind_below+1) * twt_2 + endif + + ! change delta units to ratio, put on patch loop + + rc14_atm = (delc14o2_atm * 1.e-3_r8 + 1._r8) * c14ratio + + end subroutine C14BombSpike + + !----------------------------------------------------------------------- + subroutine C14_init_BombSpike() + ! + ! !DESCRIPTION: + ! read netcdf file containing a timeseries of atmospheric delta C14 values; save in module-level array + ! + ! !USES: + use ncdio_pio + use fileutils , only : getfil + use abortutils , only : endrun + use clm_varctl , only : iulog + use spmdMod , only : masterproc + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: dimid,varid ! input netCDF id's + integer :: ntim ! number of input data time samples + integer :: t + !----------------------------------------------------------------------- + + if ( masterproc ) then + write(iulog, *) 'C14_init_BombSpike: preparing to open file:' + write(iulog, *) trim(locfn) + endif + + call getfil(atm_c14_filename, locfn, 0) + + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call ncd_inqdlen(ncid,dimid,ntim,'time') + + !! allocate arrays based on size of netcdf timeseries + allocate(atm_c14file_time(ntim)) + allocate(atm_delta_c14(ntim)) + + call ncd_io(ncid=ncid, varname='time', flag='read', data=atm_c14file_time) + + call ncd_io(ncid=ncid, varname='atm_delta_c14', flag='read', data=atm_delta_c14) + + call ncd_pio_closefile(ncid) + + ! check to make sure that time dimension is well behaved + do t = 2, ntim + if ( atm_c14file_time(t) - atm_c14file_time(t-1) <= 0._r8 ) then + write(iulog, *) 'C14_init_BombSpike: error. time axis must be monotonically increasing' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end do + + end subroutine C14_init_BombSpike + +end module C14BombSpikeMod diff --git a/components/clm/src/biogeochem/CMakeLists.txt b/components/clm/src/biogeochem/CMakeLists.txt new file mode 100644 index 0000000000..d7f8a5669e --- /dev/null +++ b/components/clm/src/biogeochem/CMakeLists.txt @@ -0,0 +1,8 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources + CNSharedParamsMod.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/biogeochem/CNAnnualUpdateMod.F90 b/components/clm/src/biogeochem/CNAnnualUpdateMod.F90 new file mode 100644 index 0000000000..f26fdeadec --- /dev/null +++ b/components/clm/src/biogeochem/CNAnnualUpdateMod.F90 @@ -0,0 +1,109 @@ +module CNAnnualUpdateMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for updating annual summation variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNvegStateType , only : cnveg_state_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNAnnualUpdate + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNAnnualUpdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update annual summation variables + ! + ! !USES: + use clm_time_manager, only: get_step_size, get_days_per_year + use clm_varcon , only: secspday + use SubgridAveMod , only: p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + cnveg_state_inst%annsum_counter_col(c) = cnveg_state_inst%annsum_counter_col(c) + dt + end do + + if (num_soilc > 0) then + + if (cnveg_state_inst%annsum_counter_col(filter_soilc(1)) >= get_days_per_year() * secspday) then + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! update annual plant ndemand accumulator + cnveg_state_inst%annsum_potential_gpp_patch(p) = cnveg_state_inst%tempsum_potential_gpp_patch(p) + cnveg_state_inst%tempsum_potential_gpp_patch(p) = 0._r8 + + ! update annual total N retranslocation accumulator + cnveg_state_inst%annmax_retransn_patch(p) = cnveg_state_inst%tempmax_retransn_patch(p) + cnveg_state_inst%tempmax_retransn_patch(p) = 0._r8 + + ! update annual average 2m air temperature accumulator + cnveg_state_inst%annavg_t2m_patch(p) = cnveg_state_inst%tempavg_t2m_patch(p) + cnveg_state_inst%tempavg_t2m_patch(p) = 0._r8 + + ! update annual NPP accumulator, convert to annual total + cnveg_carbonflux_inst%annsum_npp_patch(p) = cnveg_carbonflux_inst%tempsum_npp_patch(p) * dt + cnveg_carbonflux_inst%tempsum_npp_patch(p) = 0._r8 + + ! update annual litfall accumulator, convert to annual total + cnveg_carbonflux_inst%annsum_litfall_patch(p) = cnveg_carbonflux_inst%tempsum_litfall_patch(p) * dt + cnveg_carbonflux_inst%tempsum_litfall_patch(p) = 0._r8 + end do + + ! use p2c routine to get selected column-average patch-level fluxes and states + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst%annsum_npp_patch(bounds%begp:bounds%endp), & + cnveg_carbonflux_inst%annsum_npp_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_state_inst%annavg_t2m_patch(bounds%begp:bounds%endp), & + cnveg_state_inst%annavg_t2m_col(bounds%begc:bounds%endc)) + end if + + end if + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + if (cnveg_state_inst%annsum_counter_col(c) >= get_days_per_year() * secspday) then + cnveg_state_inst%annsum_counter_col(c) = 0._r8 + end if + end do + + end subroutine CNAnnualUpdate + +end module CNAnnualUpdateMod diff --git a/components/clm/src/biogeochem/CNBalanceCheckMod.F90 b/components/clm/src/biogeochem/CNBalanceCheckMod.F90 new file mode 100644 index 0000000000..3261907df3 --- /dev/null +++ b/components/clm/src/biogeochem/CNBalanceCheckMod.F90 @@ -0,0 +1,318 @@ +module CNBalanceCheckMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon/nitrogen mass balance checking. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_time_manager , only : get_step_size + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemCarbonfluxType , only : soilbiogeochem_carbonflux_type + use ColumnType , only : col + use GridcellType , only : grc + ! + implicit none + private + ! + ! !PUBLIC TYPES: + type, public :: cn_balance_type + private + real(r8), pointer :: begcb_col(:) ! (gC/m2) carbon mass, beginning of time step + real(r8), pointer :: endcb_col(:) ! (gC/m2) carbon mass, end of time step + real(r8), pointer :: begnb_col(:) ! (gN/m2) nitrogen mass, beginning of time step + real(r8), pointer :: endnb_col(:) ! (gN/m2) nitrogen mass, end of time step + logical , pointer :: beg_vals_set_col(:) ! Whether begcb/begnb have been set for this column in this time step + contains + procedure , public :: Init + procedure , public :: BeginCNBalance + procedure , public :: CBalanceCheck + procedure , public :: NBalanceCheck + procedure , private :: InitAllocate + end type cn_balance_type + ! + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + class(cn_balance_type) :: this + type(bounds_type) , intent(in) :: bounds + + call this%InitAllocate(bounds) + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + class(cn_balance_type) :: this + type(bounds_type) , intent(in) :: bounds + + integer :: begc, endc + + begc = bounds%begc; endc= bounds%endc + + allocate(this%begcb_col(begc:endc)) ; this%begcb_col(:) = nan + allocate(this%endcb_col(begc:endc)) ; this%endcb_col(:) = nan + allocate(this%begnb_col(begc:endc)) ; this%begnb_col(:) = nan + allocate(this%endnb_col(begc:endc)) ; this%endnb_col(:) = nan + allocate(this%beg_vals_set_col(begc:endc)) ; this%beg_vals_set_col(:) = .false. + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine BeginCNBalance(this, bounds, num_soilc, filter_soilc, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Calculate beginning column-level carbon/nitrogen balance, for mass conservation check + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c + !----------------------------------------------------------------------- + + associate( & + col_begcb => this%begcb_col , & ! Output: [real(r8) (:)] (gC/m2) carbon mass, beginning of time step + col_begnb => this%begnb_col , & ! Output: [real(r8) (:)] (gN/m2) nitrogen mass, beginning of time step + beg_vals_set => this%beg_vals_set_col , & ! Output: [logical (:)] Whether begcb/begnb have been set + totcolc => cnveg_carbonstate_inst%totc_col , & ! Input: [real(r8) (:)] (gC/m2) total column carbon, incl veg and cpool + totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:)] (gN/m2) total column nitrogen, incl veg + ) + + beg_vals_set(bounds%begc:bounds%endc) = .false. + + do fc = 1,num_soilc + c = filter_soilc(fc) + col_begcb(c) = totcolc(c) + col_begnb(c) = totcoln(c) + beg_vals_set(c) = .true. + end do + + end associate + + end subroutine BeginCNBalance + + !----------------------------------------------------------------------- + subroutine CBalanceCheck(this, bounds, num_soilc, filter_soilc, & + soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Perform carbon mass conservation check for column and patch + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,err_index ! indices + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: col_cinputs + real(r8) :: col_coutputs + real(r8) :: col_errcb(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- + + associate( & + col_begcb => this%begcb_col , & ! Input: [real(r8) (:) ] (gC/m2) carbon mass, beginning of time step + col_endcb => this%endcb_col , & ! Output: [real(r8) (:) ] (gC/m2) carbon mass, end of time step + beg_vals_set => this%beg_vals_set_col , & ! Input: [logical (:) ] Whether begcb/begnb have been set in this time step + dwt_closs => cnveg_carbonflux_inst%dwt_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total carbon loss from product pools and conversion + product_closs => cnveg_carbonflux_inst%product_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total wood product carbon loss + gpp => cnveg_carbonflux_inst%gpp_col , & ! Input: [real(r8) (:) ] (gC/m2/s) gross primary production + er => cnveg_carbonflux_inst%er_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + col_fire_closs => cnveg_carbonflux_inst%fire_closs_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total column-level fire C loss + col_hrv_xsmrpool_to_atm => cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_col , & ! Input: [real(r8) (:) ] (gC/m2/s) excess MR pool harvest mortality + + som_c_leached => soilbiogeochem_carbonflux_inst%som_c_leached_col , & ! Input: [real(r8) (:) ] (gC/m2/s) total SOM C loss from vertical transport + + totcolc => cnveg_carbonstate_inst%totc_col & ! Input: [real(r8) (:) ] (gC/m2) total column carbon, incl veg and cpool + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + err_found = .false. + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. beg_vals_set(c)) then + ! Skip the check if the beginning values weren't set for this column. This + ! can happen, for example, if this is a newly-active column. + cycle + end if + + ! calculate the total column-level carbon storage, for mass conservation check + col_endcb(c) = totcolc(c) + + ! calculate total column-level inputs + col_cinputs = gpp(c) + + ! calculate total column-level outputs + ! er = ar + hr, col_fire_closs includes patch-level fire losses + col_coutputs = er(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + col_hrv_xsmrpool_to_atm(c) + + ! subtract leaching flux + col_coutputs = col_coutputs - som_c_leached(c) + + ! calculate the total column-level carbon balance error for this time step + col_errcb(c) = (col_cinputs - col_coutputs)*dt - (col_endcb(c) - col_begcb(c)) + + ! check for significant errors + if (abs(col_errcb(c)) > 1e-8_r8) then + err_found = .true. + err_index = c + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column cbalance error = ', col_errcb(c), c + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'begcb = ',col_begcb(c) + write(iulog,*)'endcb = ',col_endcb(c) + write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end associate + + end subroutine CBalanceCheck + + !----------------------------------------------------------------------- + subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & + soilbiogeochem_nitrogenflux_inst, cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Perform nitrogen mass conservation check + ! + ! !USES: + use clm_varpar, only : crop_prog + ! + ! !ARGUMENTS: + class(cn_balance_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc (:) ! filter for soil columns + type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,err_index,j ! indices + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8):: dt ! radiation time step (seconds) + real(r8):: col_ninputs(bounds%begc:bounds%endc) + real(r8):: col_noutputs(bounds%begc:bounds%endc) + real(r8):: col_errnb(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- + + associate( & + col_begnb => this%begnb_col , & ! Input: [real(r8) (:) ] (gN/m2) nitrogen mass, beginning of time step + col_endnb => this%endnb_col , & ! Output: [real(r8) (:) ] (gN/m2) nitrogen mass, end of time step + beg_vals_set => this%beg_vals_set_col , & ! Input: [logical (:) ] Whether begcb/begnb have been set in this time step + ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) atmospheric N deposition to soil mineral N + nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) symbiotic/asymbiotic N fixation to soil mineral N + fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) + soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) + supplement_to_sminn => soilbiogeochem_nitrogenflux_inst%supplement_to_sminn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) supplemental N supply + denit => soilbiogeochem_nitrogenflux_inst%denit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total rate of denitrification + sminn_leached => soilbiogeochem_nitrogenflux_inst%sminn_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral N pool loss to leaching + smin_no3_leached => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to leaching + smin_no3_runoff => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_col , & ! Input: [real(r8) (:) ] (gN/m2/s) soil mineral NO3 pool loss to runoff + f_n2o_nit => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) flux of N2o from nitrification + som_n_leached => soilbiogeochem_nitrogenflux_inst%som_n_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total SOM N loss from vertical transport + + col_fire_nloss => cnveg_nitrogenflux_inst%fire_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total column-level fire N loss + dwt_nloss => cnveg_nitrogenflux_inst%dwt_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total nitrogen loss from product pools and conversion + product_nloss => cnveg_nitrogenflux_inst%product_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total wood product nitrogen loss + + totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + err_found = .false. + do fc = 1,num_soilc + c=filter_soilc(fc) + + if (.not. beg_vals_set(c)) then + ! Skip the check if the beginning values weren't set for this column. This + ! can happen, for example, if this is a newly-active column. + cycle + end if + + ! calculate the total column-level nitrogen storage, for mass conservation check + col_endnb(c) = totcoln(c) + + ! calculate total column-level inputs + col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c) + if (crop_prog) then + col_ninputs(c) = col_ninputs(c) + fert_to_sminn(c) + soyfixn_to_sminn(c) + end if + + ! calculate total column-level outputs + col_noutputs(c) = denit(c) + col_fire_nloss(c) + dwt_nloss(c) + product_nloss(c) + + if (.not. use_nitrif_denitrif) then + col_noutputs(c) = col_noutputs(c) + sminn_leached(c) + else + col_noutputs(c) = col_noutputs(c) + f_n2o_nit(c) + + col_noutputs(c) = col_noutputs(c) + smin_no3_leached(c) + smin_no3_runoff(c) + end if + + col_noutputs(c) = col_noutputs(c) - som_n_leached(c) + + ! calculate the total column-level nitrogen balance error for this time step + col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - (col_endnb(c) - col_begnb(c)) + + if (abs(col_errnb(c)) > 1e-8_r8) then + err_found = .true. + err_index = c + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column nbalance error = ',col_errnb(c), c + write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'begnb = ',col_begnb(c) + write(iulog,*)'endnb = ',col_endnb(c) + write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c) + write(iulog,*)'input mass = ',col_ninputs(c)*dt + write(iulog,*)'output mass = ',col_noutputs(c)*dt + write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end associate + + end subroutine NBalanceCheck + +end module CNBalanceCheckMod diff --git a/components/clm/src/biogeochem/CNC14DecayMod.F90 b/components/clm/src/biogeochem/CNC14DecayMod.F90 new file mode 100644 index 0000000000..0efc881da8 --- /dev/null +++ b/components/clm/src/biogeochem/CNC14DecayMod.F90 @@ -0,0 +1,142 @@ +module CNC14DecayMod + + !----------------------------------------------------------------------- + ! Module for 14-carbon flux variable update, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size, get_days_per_year + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, ndecomp_pools + use clm_varcon , only : secspday + use clm_varctl , only : spinup_state + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: C14Decay + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine C14Decay( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, calculate the radioactive decay of C14 + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(CNVeg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,j,l,p,fc,c,i + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: half_life + real(r8) :: decay_const + real(r8) :: days_per_year ! days per year + real(r8) :: spinup_term ! spinup accelerated decomposition factor, used to accelerate transport as well + !----------------------------------------------------------------------- + + associate( & + spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] factor for AD spinup associated with each pool + + decomp_cpools_vr => c14_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + seedc => c14_cnveg_carbonstate_inst%seedc_col , & ! Output: [real(r8) (:) ] + cpool => c14_cnveg_carbonstate_inst%cpool_patch , & ! Output: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + xsmrpool => c14_cnveg_carbonstate_inst%xsmrpool_patch , & ! Output: [real(r8) (:) ] (gC/m2) execss maint resp C pool + deadcrootc => c14_cnveg_carbonstate_inst%deadcrootc_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => c14_cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + deadstemc => c14_cnveg_carbonstate_inst%deadstemc_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => c14_cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C storage + deadstemc_xfer => c14_cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + frootc => c14_cnveg_carbonstate_inst%frootc_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => c14_cnveg_carbonstate_inst%frootc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => c14_cnveg_carbonstate_inst%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + gresp_storage => c14_cnveg_carbonstate_inst%gresp_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) growth respiration storage + gresp_xfer => c14_cnveg_carbonstate_inst%gresp_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) growth respiration transfer + leafc => c14_cnveg_carbonstate_inst%leafc_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => c14_cnveg_carbonstate_inst%leafc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => c14_cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + livecrootc => c14_cnveg_carbonstate_inst%livecrootc_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => c14_cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => c14_cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + livestemc => c14_cnveg_carbonstate_inst%livestemc_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => c14_cnveg_carbonstate_inst%livestemc_storage_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C storage + livestemc_xfer => c14_cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + pft_ctrunc => c14_cnveg_carbonstate_inst%ctrunc_patch & ! Output: [real(r8) (:) ] (gC/m2) patch-level sink for C truncation + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + days_per_year = get_days_per_year() + + half_life = 5568._r8 * secspday * days_per_year !! libby half-life value, for comparison against ages calculated with this value + ! half_life = 5730._r8 * secspday * days_per_year !! recent half-life value + decay_const = - log(0.5_r8) / half_life + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + seedc(c) = seedc(c) * (1._r8 - decay_const * dt) + end do ! end of columns loop + + do l = 1, ndecomp_pools + if ( spinup_state == 1) then + ! speed up radioactive decay by the same factor as decomposition so tat SOM ages prematurely in all respects + spinup_term = spinup_factor(l) + else + spinup_term = 1. + endif + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_cpools_vr(c,j,l) = decomp_cpools_vr(c,j,l) * (1._r8 - decay_const * spinup_term * dt) + end do + end do + end do ! end of columns loop + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + cpool(p) = cpool(p) * (1._r8 - decay_const * dt) + xsmrpool(p) = xsmrpool(p) * (1._r8 - decay_const * dt) + deadcrootc(p) = deadcrootc(p) * (1._r8 - decay_const * dt) + deadcrootc_storage(p) = deadcrootc_storage(p) * (1._r8 - decay_const * dt) + deadcrootc_xfer(p) = deadcrootc_xfer(p) * (1._r8 - decay_const * dt) + deadstemc(p) = deadstemc(p) * (1._r8 - decay_const * dt) + deadstemc_storage(p) = deadstemc_storage(p) * (1._r8 - decay_const * dt) + deadstemc_xfer(p) = deadstemc_xfer(p) * (1._r8 - decay_const * dt) + frootc(p) = frootc(p) * (1._r8 - decay_const * dt) + frootc_storage(p) = frootc_storage(p) * (1._r8 - decay_const * dt) + frootc_xfer(p) = frootc_xfer(p) * (1._r8 - decay_const * dt) + gresp_storage(p) = gresp_storage(p) * (1._r8 - decay_const * dt) + gresp_xfer(p) = gresp_xfer(p) * (1._r8 - decay_const * dt) + leafc(p) = leafc(p) * (1._r8 - decay_const * dt) + leafc_storage(p) = leafc_storage(p) * (1._r8 - decay_const * dt) + leafc_xfer(p) = leafc_xfer(p) * (1._r8 - decay_const * dt) + livecrootc(p) = livecrootc(p) * (1._r8 - decay_const * dt) + livecrootc_storage(p) = livecrootc_storage(p) * (1._r8 - decay_const * dt) + livecrootc_xfer(p) = livecrootc_xfer(p) * (1._r8 - decay_const * dt) + livestemc(p) = livestemc(p) * (1._r8 - decay_const * dt) + livestemc_storage(p) = livestemc_storage(p) * (1._r8 - decay_const * dt) + livestemc_xfer(p) = livestemc_xfer(p) * (1._r8 - decay_const * dt) + pft_ctrunc(p) = pft_ctrunc(p) * (1._r8 - decay_const * dt) + end do + + end associate + + end subroutine C14Decay + +end module CNC14DecayMod diff --git a/components/clm/src/biogeochem/CNCIsoFluxMod.F90 b/components/clm/src/biogeochem/CNCIsoFluxMod.F90 new file mode 100644 index 0000000000..f4f92fd895 --- /dev/null +++ b/components/clm/src/biogeochem/CNCIsoFluxMod.F90 @@ -0,0 +1,1335 @@ +module CNCIsoFluxMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon isotopic flux variable update, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, ndecomp_pools + use clm_varpar , only : max_patch_per_col, maxpatch_pft + use abortutils , only : endrun + use pftconMod , only : pftcon + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CIsoFlux1 + public :: CIsoFlux2 + public :: CIsoFlux2h + public :: CIsoFlux3 + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: CNCIsoLitterToColumn + private :: CNCIsoGapPftToColumn + private :: CNCIsoHarvestPftToColumn + private :: CIsoFluxCalc + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_soilbiogeochem_carbonflux_inst, iso_soilbiogeochem_carbonstate_inst, & + iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, & + isotope) + ! + ! !DESCRIPTION: + ! On the radiation time step, set the carbon isotopic flux + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: iso_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: iso_soilbiogeochem_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: iso_cnveg_carbonstate_inst + character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' + ! + ! !LOCAL VARIABLES: + integer :: fp,pi,l,fc,cc,j + integer :: cdp + !----------------------------------------------------------------------- + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & + soilbiogeochem_cs => soilbiogeochem_carbonstate_inst , & + soilbiogeochem_cf => soilbiogeochem_carbonflux_inst , & + cnveg_cf => cnveg_carbonflux_inst , & + cnveg_cs => cnveg_carbonstate_inst , & + iso_cnveg_cf => iso_cnveg_carbonflux_inst , & + iso_cnveg_cs => iso_cnveg_carbonstate_inst , & + iso_soilbiogeochem_cs => iso_soilbiogeochem_carbonstate_inst , & + iso_soilbiogeochem_cf => iso_soilbiogeochem_carbonflux_inst & + ) + + ! patch-level non-mortality fluxes + + ! Note: if the variables which are arguments to CIsoFluxCalc are ever changed to NOT be + ! pointers, then the CIsoFluxCalc routine will need to be changed to declare the bounds + ! of each argument, these bounds will need to be passed in, and - importantly for + ! threading to work properly - the subroutine calls will need to be changed so that + ! instead of 'call CIsoFluxCalc(foo, ...)' we have 'call CIsoFluxCalc(foo(begp:endp), ...)'. + + call CIsoFluxCalc(& + iso_cnveg_cf%leafc_xfer_to_leafc_patch , cnveg_cf%leafc_xfer_to_leafc_patch, & + iso_cnveg_cs%leafc_xfer_patch , cnveg_cs%leafc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%frootc_xfer_to_frootc_patch , cnveg_cf%frootc_xfer_to_frootc_patch, & + iso_cnveg_cs%frootc_xfer_patch , cnveg_cs%frootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livestemc_xfer_to_livestemc_patch , cnveg_cf%livestemc_xfer_to_livestemc_patch, & + iso_cnveg_cs%livestemc_xfer_patch , cnveg_cs%livestemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%deadstemc_xfer_to_deadstemc_patch , cnveg_cf%deadstemc_xfer_to_deadstemc_patch, & + iso_cnveg_cs%deadstemc_xfer_patch , cnveg_cs%deadstemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livecrootc_xfer_to_livecrootc_patch , cnveg_cf%livecrootc_xfer_to_livecrootc_patch, & + iso_cnveg_cs%livecrootc_xfer_patch , cnveg_cs%livecrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%deadcrootc_xfer_to_deadcrootc_patch , cnveg_cf%deadcrootc_xfer_to_deadcrootc_patch, & + iso_cnveg_cs%deadcrootc_xfer_patch , cnveg_cs%deadcrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%leafc_to_litter_patch , cnveg_cf%leafc_to_litter_patch, & + iso_cnveg_cs%leafc_patch , cnveg_cs%leafc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%frootc_to_litter_patch , cnveg_cf%frootc_to_litter_patch, & + iso_cnveg_cs%frootc_patch , cnveg_cs%frootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livestemc_to_deadstemc_patch , cnveg_cf%livestemc_to_deadstemc_patch, & + iso_cnveg_cs%livestemc_patch , cnveg_cs%livestemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livecrootc_to_deadcrootc_patch , cnveg_cf%livecrootc_to_deadcrootc_patch, & + iso_cnveg_cs%livecrootc_patch , cnveg_cs%livecrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%leaf_curmr_patch , cnveg_cf%leaf_curmr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%froot_curmr_patch , cnveg_cf%froot_curmr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livestem_curmr_patch , cnveg_cf%livestem_curmr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livecroot_curmr_patch , cnveg_cf%livecroot_curmr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%leaf_xsmr_patch , cnveg_cf%leaf_xsmr_patch, & + iso_cnveg_cs%totvegc_patch , cnveg_cs%totvegc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%froot_xsmr_patch , cnveg_cf%froot_xsmr_patch, & + iso_cnveg_cs%totvegc_patch , cnveg_cs%totvegc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livestem_xsmr_patch , cnveg_cf%livestem_xsmr_patch, & + iso_cnveg_cs%totvegc_patch , cnveg_cs%totvegc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livecroot_xsmr_patch , cnveg_cf%livecroot_xsmr_patch, & + iso_cnveg_cs%totvegc_patch , cnveg_cs%totvegc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_xsmrpool_patch , cnveg_cf%cpool_to_xsmrpool_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_leafc_patch , cnveg_cf%cpool_to_leafc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_leafc_storage_patch , cnveg_cf%cpool_to_leafc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_frootc_patch , cnveg_cf%cpool_to_frootc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_frootc_storage_patch , cnveg_cf%cpool_to_frootc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_livestemc_patch , cnveg_cf%cpool_to_livestemc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_livestemc_storage_patch , cnveg_cf%cpool_to_livestemc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_deadstemc_patch , cnveg_cf%cpool_to_deadstemc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_deadstemc_storage_patch , cnveg_cf%cpool_to_deadstemc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_livecrootc_patch , cnveg_cf%cpool_to_livecrootc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_livecrootc_storage_patch , cnveg_cf%cpool_to_livecrootc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_deadcrootc_patch , cnveg_cf%cpool_to_deadcrootc_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_deadcrootc_storage_patch , cnveg_cf%cpool_to_deadcrootc_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_leaf_gr_patch , cnveg_cf%cpool_leaf_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_froot_gr_patch , cnveg_cf%cpool_froot_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_livestem_gr_patch , cnveg_cf%cpool_livestem_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_deadstem_gr_patch , cnveg_cf%cpool_deadstem_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_livecroot_gr_patch , cnveg_cf%cpool_livecroot_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_deadcroot_gr_patch , cnveg_cf%cpool_deadcroot_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_leaf_storage_gr_patch , cnveg_cf%cpool_leaf_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_froot_storage_gr_patch , cnveg_cf%cpool_froot_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_livestem_storage_gr_patch , cnveg_cf%cpool_livestem_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_deadstem_storage_gr_patch , cnveg_cf%cpool_deadstem_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_livecroot_storage_gr_patch , cnveg_cf%cpool_livecroot_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_deadcroot_storage_gr_patch , cnveg_cf%cpool_deadcroot_storage_gr_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%cpool_to_gresp_storage_patch , cnveg_cf%cpool_to_gresp_storage_patch, & + iso_cnveg_cs%cpool_patch , cnveg_cs%cpool_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_leaf_gr_patch , cnveg_cf%transfer_leaf_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_froot_gr_patch , cnveg_cf%transfer_froot_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_livestem_gr_patch , cnveg_cf%transfer_livestem_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_deadstem_gr_patch , cnveg_cf%transfer_deadstem_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_livecroot_gr_patch , cnveg_cf%transfer_livecroot_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%transfer_deadcroot_gr_patch , cnveg_cf%transfer_deadcroot_gr_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%leafc_storage_to_xfer_patch , cnveg_cf%leafc_storage_to_xfer_patch, & + iso_cnveg_cs%leafc_storage_patch , cnveg_cs%leafc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%frootc_storage_to_xfer_patch , cnveg_cf%frootc_storage_to_xfer_patch, & + iso_cnveg_cs%frootc_storage_patch , cnveg_cs%frootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livestemc_storage_to_xfer_patch , cnveg_cf%livestemc_storage_to_xfer_patch, & + iso_cnveg_cs%livestemc_storage_patch , cnveg_cs%livestemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%deadstemc_storage_to_xfer_patch , cnveg_cf%deadstemc_storage_to_xfer_patch, & + iso_cnveg_cs%deadstemc_storage_patch , cnveg_cs%deadstemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%livecrootc_storage_to_xfer_patch , cnveg_cf%livecrootc_storage_to_xfer_patch, & + iso_cnveg_cs%livecrootc_storage_patch , cnveg_cs%livecrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%deadcrootc_storage_to_xfer_patch , cnveg_cf%deadcrootc_storage_to_xfer_patch, & + iso_cnveg_cs%deadcrootc_storage_patch , cnveg_cs%deadcrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%gresp_storage_to_xfer_patch , cnveg_cf%gresp_storage_to_xfer_patch, & + iso_cnveg_cs%gresp_storage_patch , cnveg_cs%gresp_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + ! call routine to shift patch-level litterfall fluxes to column, for isotopes + ! the non-isotope version of this routine is called in CNPhenologyMod.F90 + ! For later clean-up, it would be possible to generalize this function to operate on a single + ! patch-to-column flux. + + call CNCIsoLitterToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + + ! column-level non-mortality fluxes + + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_cascade_transitions + cdp = cascade_donor_pool(l) + if ( soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp) /= 0._r8) then + iso_soilbiogeochem_cf%decomp_cascade_hr_vr_col(cc,j,l) = & + soilbiogeochem_cf%decomp_cascade_hr_vr_col(cc,j,l) * & + (iso_soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp) & + / soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp)) * 1._r8 + else + iso_soilbiogeochem_cf%decomp_cascade_hr_vr_col(cc,j,l) = 0._r8 + end if + end do + end do + end do + + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_cascade_transitions + cdp = cascade_donor_pool(l) + if ( soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp) /= 0._r8) then + iso_soilbiogeochem_cf%decomp_cascade_ctransfer_vr_col(cc,j,l) = & + soilbiogeochem_cf%decomp_cascade_ctransfer_vr_col(cc,j,l) * & + (iso_soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp) & + / soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,cdp)) * 1._r8 + else + iso_soilbiogeochem_cf%decomp_cascade_ctransfer_vr_col(cc,j,l) = 0._r8 + end if + end do + end do + end do + + end associate + + end subroutine CIsoFlux1 + + !----------------------------------------------------------------------- + subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp , filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, isotope) + ! + ! !DESCRIPTION: + ! On the radiation time step, set the carbon isotopic fluxes for gap mortality + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: iso_cnveg_carbonstate_inst + character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' + ! + ! !LOCAL VARIABLES: + integer :: fp,pi + !----------------------------------------------------------------------- + + associate( & + cnveg_cf => cnveg_carbonflux_inst , & + cnveg_cs => cnveg_carbonstate_inst , & + iso_cnveg_cf => iso_cnveg_carbonflux_inst , & + iso_cnveg_cs => iso_cnveg_carbonstate_inst & + ) + + ! patch-level gap mortality fluxes + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_to_litter_patch , cnveg_cf%m_leafc_to_litter_patch, & + iso_cnveg_cs%leafc_patch , cnveg_cs%leafc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_storage_to_litter_patch , cnveg_cf%m_leafc_storage_to_litter_patch, & + iso_cnveg_cs%leafc_storage_patch , cnveg_cs%leafc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_xfer_to_litter_patch , cnveg_cf%m_leafc_xfer_to_litter_patch, & + iso_cnveg_cs%leafc_xfer_patch , cnveg_cs%leafc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_to_litter_patch , cnveg_cf%m_frootc_to_litter_patch, & + iso_cnveg_cs%frootc_patch , cnveg_cs%frootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_storage_to_litter_patch , cnveg_cf%m_frootc_storage_to_litter_patch, & + iso_cnveg_cs%frootc_storage_patch , cnveg_cs%frootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_xfer_to_litter_patch , cnveg_cf%m_frootc_xfer_to_litter_patch, & + iso_cnveg_cs%frootc_xfer_patch , cnveg_cs%frootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_to_litter_patch , cnveg_cf%m_livestemc_to_litter_patch, & + iso_cnveg_cs%livestemc_patch , cnveg_cs%livestemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_storage_to_litter_patch , cnveg_cf%m_livestemc_storage_to_litter_patch, & + iso_cnveg_cs%livestemc_storage_patch , cnveg_cs%livestemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_xfer_to_litter_patch , cnveg_cf%m_livestemc_xfer_to_litter_patch, & + iso_cnveg_cs%livestemc_xfer_patch , cnveg_cs%livestemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_to_litter_patch , cnveg_cf%m_deadstemc_to_litter_patch, & + iso_cnveg_cs%deadstemc_patch , cnveg_cs%deadstemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_storage_to_litter_patch , cnveg_cf%m_deadstemc_storage_to_litter_patch, & + iso_cnveg_cs%deadstemc_storage_patch , cnveg_cs%deadstemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_xfer_to_litter_patch , cnveg_cf%m_deadstemc_xfer_to_litter_patch, & + iso_cnveg_cs%deadstemc_xfer_patch , cnveg_cs%deadstemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_to_litter_patch , cnveg_cf%m_livecrootc_to_litter_patch, & + iso_cnveg_cs%livecrootc_patch , cnveg_cs%livecrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_storage_to_litter_patch , cnveg_cf%m_livecrootc_storage_to_litter_patch, & + iso_cnveg_cs%livecrootc_storage_patch , cnveg_cs%livecrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_xfer_to_litter_patch , cnveg_cf%m_livecrootc_xfer_to_litter_patch, & + iso_cnveg_cs%livecrootc_xfer_patch , cnveg_cs%livecrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_to_litter_patch , cnveg_cf%m_deadcrootc_to_litter_patch, & + iso_cnveg_cs%deadcrootc_patch , cnveg_cs%deadcrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_storage_to_litter_patch , cnveg_cf%m_deadcrootc_storage_to_litter_patch, & + iso_cnveg_cs%deadcrootc_storage_patch , cnveg_cs%deadcrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_xfer_to_litter_patch , cnveg_cf%m_deadcrootc_xfer_to_litter_patch, & + iso_cnveg_cs%deadcrootc_xfer_patch , cnveg_cs%deadcrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_gresp_storage_to_litter_patch , cnveg_cf%m_gresp_storage_to_litter_patch, & + iso_cnveg_cs%gresp_storage_patch , cnveg_cs%gresp_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_gresp_xfer_to_litter_patch , cnveg_cf%m_gresp_xfer_to_litter_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + ! call routine to shift patch-level gap mortality fluxes to column , for isotopes + ! the non-isotope version of this routine is in CNGapMortalityMod.F90. + + call CNCIsoGapPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + + end associate + + end subroutine CIsoFlux2 + + !----------------------------------------------------------------------- + subroutine CIsoFlux2h(num_soilc , filter_soilc, num_soilp , filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, isotope) + ! + ! !DESCRIPTION: + ! set the carbon isotopic fluxes for harvest mortality + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: iso_cnveg_carbonstate_inst + character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' + !----------------------------------------------------------------------- + + associate( & + cnveg_cf => cnveg_carbonflux_inst , & + cnveg_cs => cnveg_carbonstate_inst , & + iso_cnveg_cf => iso_cnveg_carbonflux_inst , & + iso_cnveg_cs => iso_cnveg_carbonstate_inst & + ) + + ! patch-level gap mortality fluxes + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_leafc_to_litter_patch , cnveg_cf%hrv_leafc_to_litter_patch, & + iso_cnveg_cs%leafc_patch , cnveg_cs%leafc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_leafc_storage_to_litter_patch , cnveg_cf%hrv_leafc_storage_to_litter_patch, & + iso_cnveg_cs%leafc_storage_patch , cnveg_cs%leafc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_leafc_xfer_to_litter_patch , cnveg_cf%hrv_leafc_xfer_to_litter_patch, & + iso_cnveg_cs%leafc_xfer_patch , cnveg_cs%leafc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_frootc_to_litter_patch , cnveg_cf%hrv_frootc_to_litter_patch, & + iso_cnveg_cs%frootc_patch , cnveg_cs%frootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_frootc_storage_to_litter_patch , cnveg_cf%hrv_frootc_storage_to_litter_patch, & + iso_cnveg_cs%frootc_storage_patch , cnveg_cs%frootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_frootc_xfer_to_litter_patch , cnveg_cf%hrv_frootc_xfer_to_litter_patch, & + iso_cnveg_cs%frootc_xfer_patch , cnveg_cs%frootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livestemc_to_litter_patch , cnveg_cf%hrv_livestemc_to_litter_patch, & + iso_cnveg_cs%livestemc_patch , cnveg_cs%livestemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livestemc_storage_to_litter_patch , cnveg_cf%hrv_livestemc_storage_to_litter_patch, & + iso_cnveg_cs%livestemc_storage_patch , cnveg_cs%livestemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livestemc_xfer_to_litter_patch , cnveg_cf%hrv_livestemc_xfer_to_litter_patch, & + iso_cnveg_cs%livestemc_xfer_patch , cnveg_cs%livestemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadstemc_to_prod10c_patch , cnveg_cf%hrv_deadstemc_to_prod10c_patch, & + iso_cnveg_cs%deadstemc_patch , cnveg_cs%deadstemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadstemc_to_prod100c_patch , cnveg_cf%hrv_deadstemc_to_prod100c_patch, & + iso_cnveg_cs%deadstemc_patch , cnveg_cs%deadstemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadstemc_storage_to_litter_patch , cnveg_cf%hrv_deadstemc_storage_to_litter_patch, & + iso_cnveg_cs%deadstemc_storage_patch , cnveg_cs%deadstemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadstemc_xfer_to_litter_patch , cnveg_cf%hrv_deadstemc_xfer_to_litter_patch, & + iso_cnveg_cs%deadstemc_xfer_patch , cnveg_cs%deadstemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livecrootc_to_litter_patch , cnveg_cf%hrv_livecrootc_to_litter_patch, & + iso_cnveg_cs%livecrootc_patch , cnveg_cs%livecrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livecrootc_storage_to_litter_patch , cnveg_cf%hrv_livecrootc_storage_to_litter_patch, & + iso_cnveg_cs%livecrootc_storage_patch , cnveg_cs%livecrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_livecrootc_xfer_to_litter_patch , cnveg_cf%hrv_livecrootc_xfer_to_litter_patch, & + iso_cnveg_cs%livecrootc_xfer_patch , cnveg_cs%livecrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadcrootc_to_litter_patch , cnveg_cf%hrv_deadcrootc_to_litter_patch, & + iso_cnveg_cs%deadcrootc_patch , cnveg_cs%deadcrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadcrootc_storage_to_litter_patch , cnveg_cf%hrv_deadcrootc_storage_to_litter_patch, & + iso_cnveg_cs%deadcrootc_storage_patch , cnveg_cs%deadcrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_deadcrootc_xfer_to_litter_patch , cnveg_cf%hrv_deadcrootc_xfer_to_litter_patch, & + iso_cnveg_cs%deadcrootc_xfer_patch , cnveg_cs%deadcrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_gresp_storage_to_litter_patch , cnveg_cf%hrv_gresp_storage_to_litter_patch, & + iso_cnveg_cs%gresp_storage_patch , cnveg_cs%gresp_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_gresp_xfer_to_litter_patch , cnveg_cf%hrv_gresp_xfer_to_litter_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%hrv_xsmrpool_to_atm_patch , cnveg_cf%hrv_xsmrpool_to_atm_patch, & + cnveg_cs%totvegc_patch , cnveg_cs%totvegc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + ! call routine to shift patch-level gap mortality fluxes to column, + ! for isotopes the non-isotope version of this routine is in CNGapMortalityMod.F90. + + call CNCIsoHarvestPftToColumn(num_soilc, filter_soilc, soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + + end associate + + end subroutine CIsoFlux2h + + !----------------------------------------------------------------------- + subroutine CIsoFlux3(num_soilc , filter_soilc, num_soilp , filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst, iso_cnveg_carbonstate_inst, & + iso_soilbiogeochem_carbonstate_inst, isotope) + ! + ! !DESCRIPTION: + ! On the radiation time step, set the carbon isotopic fluxes for fire mortality + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(in) :: iso_cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: iso_soilbiogeochem_carbonstate_inst + character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' + ! + ! !LOCAL VARIABLES: + integer :: pi,pp,l,fc,cc,j + !----------------------------------------------------------------------- + + associate( & + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + soilbiogeochem_cs => soilbiogeochem_carbonstate_inst , & + cnveg_cf => cnveg_carbonflux_inst , & + cnveg_cs => cnveg_carbonstate_inst , & + iso_cnveg_cf => iso_cnveg_carbonflux_inst , & + iso_cnveg_cs => iso_cnveg_carbonstate_inst , & + iso_soilbiogeochem_cs => iso_soilbiogeochem_carbonstate_inst & + ) + + ! patch-level fire mortality fluxes + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_to_fire_patch , cnveg_cf%m_leafc_to_fire_patch, & + iso_cnveg_cs%leafc_patch , cnveg_cs%leafc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_storage_to_fire_patch , cnveg_cf%m_leafc_storage_to_fire_patch, & + iso_cnveg_cs%leafc_storage_patch , cnveg_cs%leafc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_leafc_xfer_to_fire_patch , cnveg_cf%m_leafc_xfer_to_fire_patch, & + iso_cnveg_cs%leafc_xfer_patch , cnveg_cs%leafc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_to_fire_patch , cnveg_cf%m_frootc_to_fire_patch, & + iso_cnveg_cs%frootc_patch , cnveg_cs%frootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_storage_to_fire_patch , cnveg_cf%m_frootc_storage_to_fire_patch, & + iso_cnveg_cs%frootc_storage_patch , cnveg_cs%frootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_frootc_xfer_to_fire_patch , cnveg_cf%m_frootc_xfer_to_fire_patch, & + iso_cnveg_cs%frootc_xfer_patch , cnveg_cs%frootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_to_fire_patch , cnveg_cf%m_livestemc_to_fire_patch, & + iso_cnveg_cs%livestemc_patch , cnveg_cs%livestemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_storage_to_fire_patch , cnveg_cf%m_livestemc_storage_to_fire_patch, & + iso_cnveg_cs%livestemc_storage_patch , cnveg_cs%livestemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livestemc_xfer_to_fire_patch , cnveg_cf%m_livestemc_xfer_to_fire_patch, & + iso_cnveg_cs%livestemc_xfer_patch , cnveg_cs%livestemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_to_fire_patch , cnveg_cf%m_deadstemc_to_fire_patch, & + iso_cnveg_cs%deadstemc_patch , cnveg_cs%deadstemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_to_litter_fire_patch , cnveg_cf%m_deadstemc_to_litter_fire_patch, & + iso_cnveg_cs%deadstemc_patch , cnveg_cs%deadstemc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_storage_to_fire_patch , cnveg_cf%m_deadstemc_storage_to_fire_patch, & + iso_cnveg_cs%deadstemc_storage_patch , cnveg_cs%deadstemc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadstemc_xfer_to_fire_patch , cnveg_cf%m_deadstemc_xfer_to_fire_patch, & + iso_cnveg_cs%deadstemc_xfer_patch , cnveg_cs%deadstemc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_to_fire_patch , cnveg_cf%m_livecrootc_to_fire_patch, & + iso_cnveg_cs%livecrootc_patch , cnveg_cs%livecrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_storage_to_fire_patch , cnveg_cf%m_livecrootc_storage_to_fire_patch, & + iso_cnveg_cs%livecrootc_storage_patch , cnveg_cs%livecrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_livecrootc_xfer_to_fire_patch , cnveg_cf%m_livecrootc_xfer_to_fire_patch, & + iso_cnveg_cs%livecrootc_xfer_patch , cnveg_cs%livecrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_to_fire_patch , cnveg_cf%m_deadcrootc_to_fire_patch, & + iso_cnveg_cs%deadcrootc_patch , cnveg_cs%deadcrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch , cnveg_cf%m_deadcrootc_to_litter_fire_patch, & + iso_cnveg_cs%deadcrootc_patch , cnveg_cs%deadcrootc_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_storage_to_fire_patch , cnveg_cf%m_deadcrootc_storage_to_fire_patch, & + iso_cnveg_cs%deadcrootc_storage_patch , cnveg_cs%deadcrootc_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_deadcrootc_xfer_to_fire_patch , cnveg_cf%m_deadcrootc_xfer_to_fire_patch, & + iso_cnveg_cs%deadcrootc_xfer_patch , cnveg_cs%deadcrootc_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_gresp_storage_to_fire_patch , cnveg_cf%m_gresp_storage_to_fire_patch, & + iso_cnveg_cs%gresp_storage_patch , cnveg_cs%gresp_storage_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + call CIsoFluxCalc(& + iso_cnveg_cf%m_gresp_xfer_to_fire_patch , cnveg_cf%m_gresp_xfer_to_fire_patch, & + iso_cnveg_cs%gresp_xfer_patch , cnveg_cs%gresp_xfer_patch, & + num_soilp , filter_soilp, 1._r8, 0, isotope) + + ! calculate the column-level flux of deadstem and deadcrootc to cwdc as the result of fire mortality. + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + cc = filter_soilc(fc) + if ( pi <= col%npatches(cc) ) then + pp = col%patchi(cc) + pi - 1 + if (patch%active(pp)) then + do j = 1, nlevdecomp + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + iso_cnveg_cf%m_deadstemc_to_litter_fire_patch(pp) * patch%wtcol(pp) * stem_prof(pp,j) + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) = & + iso_cnveg_cf%fire_mortality_c_to_cwdc_col(cc,j) + & + iso_cnveg_cf%m_deadcrootc_to_litter_fire_patch(pp) * patch%wtcol(pp) * croot_prof(pp,j) + end do + end if + end if + end do + end do + + + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_pools + if ( soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,l) /= 0._r8) then + iso_cnveg_cf%m_decomp_cpools_to_fire_vr_col(cc,j,l) = & + cnveg_cf%m_decomp_cpools_to_fire_vr_col(cc,j,l) * & + (iso_soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,l) / & + soilbiogeochem_cs%decomp_cpools_vr_col(cc,j,l)) * 1._r8 + else + iso_cnveg_cf%m_decomp_cpools_to_fire_vr_col(cc,j,l) = 0._r8 + end if + end do + end do + end do + + end associate + + end subroutine CIsoFlux3 + + !----------------------------------------------------------------------- + subroutine CNCIsoLitterToColumn (num_soilc, filter_soilc, & + soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + ! + ! !DESCRIPTION: + ! called at the end of cn_phenology to gather all patch-level litterfall fluxes + ! to the column level and assign them to the three litter pools + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) for this patch (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + + leafc_to_litter => iso_cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + frootc_to_litter => iso_cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + phenology_c_to_litr_met_c => iso_cnveg_carbonflux_inst%phenology_c_to_litr_met_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + phenology_c_to_litr_cel_c => iso_cnveg_carbonflux_inst%phenology_c_to_litr_cel_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + phenology_c_to_litr_lig_c => iso_cnveg_carbonflux_inst%phenology_c_to_litr_lig_c_col & ! InOut: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + ! leaf litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + end if + end if + + end do + end do + + end do + + end associate + + end subroutine CNCIsoLitterToColumn + + !----------------------------------------------------------------------- + subroutine CNCIsoGapPftToColumn (num_soilc, filter_soilc, & + soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + ! + ! !DESCRIPTION: + ! gather all patch-level gap mortality fluxes + ! to the column level and assign them to the three litter pools (+ cwd pool) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] patch weight relative to column (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + m_leafc_to_litter => iso_cnveg_carbonflux_inst%m_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_to_litter => iso_cnveg_carbonflux_inst%m_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_to_litter => iso_cnveg_carbonflux_inst%m_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_to_litter => iso_cnveg_carbonflux_inst%m_deadstemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_to_litter => iso_cnveg_carbonflux_inst%m_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_to_litter => iso_cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_storage_to_litter => iso_cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_storage_to_litter => iso_cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_storage_to_litter => iso_cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_storage_to_litter => iso_cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_storage_to_litter => iso_cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_storage_to_litter => iso_cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_storage_to_litter => iso_cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter => iso_cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_xfer_to_litter => iso_cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + + gap_mortality_c_to_litr_met_c => iso_cnveg_carbonflux_inst%gap_mortality_c_to_litr_met_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + gap_mortality_c_to_litr_cel_c => iso_cnveg_carbonflux_inst%gap_mortality_c_to_litr_cel_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + gap_mortality_c_to_litr_lig_c => iso_cnveg_carbonflux_inst%gap_mortality_c_to_litr_lig_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + gap_mortality_c_to_cwdc => iso_cnveg_carbonflux_inst%gap_mortality_c_to_cwdc_col & ! InOut: [real(r8) (:,:) ] C fluxes associated with gap mortality to CWD pool (gC/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! storage gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! transfer gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + end if + end if + + end do + + end do + end do + + end associate + + end subroutine CNCIsoGapPftToColumn + + !----------------------------------------------------------------------- + subroutine CNCIsoHarvestPftToColumn (num_soilc, filter_soilc, & + soilbiogeochem_state_inst, iso_cnveg_carbonflux_inst) + ! + ! !DESCRIPTION: + ! gather all patch-level harvest mortality fluxes + ! to the column level and assign them to the litter, cwd, and wood product pools + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: iso_cnveg_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] patch weight relative to column (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + hrv_leafc_to_litter => iso_cnveg_carbonflux_inst%hrv_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_to_litter => iso_cnveg_carbonflux_inst%hrv_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_to_litter => iso_cnveg_carbonflux_inst%hrv_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemc_to_prod10c => iso_cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemc_to_prod100c => iso_cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_to_litter => iso_cnveg_carbonflux_inst%hrv_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_to_litter => iso_cnveg_carbonflux_inst%hrv_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_gresp_storage_to_litter => iso_cnveg_carbonflux_inst%hrv_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_gresp_xfer_to_litter => iso_cnveg_carbonflux_inst%hrv_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + chrv_deadstemc_to_prod10c => iso_cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_col , & ! Output: [real(r8) (:) ] + chrv_deadstemc_to_prod100c => iso_cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_col , & ! Output: [real(r8) (:) ] + harvest_c_to_litr_met_c => iso_cnveg_carbonflux_inst%harvest_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with harvest to litter metabolic pool (gC/m3/s) + harvest_c_to_litr_cel_c => iso_cnveg_carbonflux_inst%harvest_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with harvest to litter cellulose pool (gC/m3/s) + harvest_c_to_litr_lig_c => iso_cnveg_carbonflux_inst%harvest_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with harvest to litter lignin pool (gC/m3/s) + harvest_c_to_cwdc => iso_cnveg_carbonflux_inst%harvest_c_to_cwdc_col & ! Output: [real(r8) (:,:) ] C fluxes associated with harvest to CWD pool (gC/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + ! leaf harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_cel_c(c,j) = harvest_c_to_litr_cel_c(c,j) + & + hrv_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_lig_c(c,j) = harvest_c_to_litr_lig_c(c,j) + & + hrv_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_cel_c(c,j) = harvest_c_to_litr_cel_c(c,j) + & + hrv_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_lig_c(c,j) = harvest_c_to_litr_lig_c(c,j) + & + hrv_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood harvest mortality carbon fluxes + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! storage harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! transfer harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + end if + end if + + end do + + end do + end do + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + chrv_deadstemc_to_prod10c(c) = chrv_deadstemc_to_prod10c(c) + & + phrv_deadstemc_to_prod10c(p) * wtcol(p) + chrv_deadstemc_to_prod100c(c) = chrv_deadstemc_to_prod100c(c) + & + phrv_deadstemc_to_prod100c(p) * wtcol(p) + end if + end if + end do + end do + + end associate + + end subroutine CNCIsoHarvestPftToColumn + + !----------------------------------------------------------------------- + subroutine CIsoFluxCalc(& + ciso_flux, ctot_flux, & + ciso_state, ctot_state, & + num, filter, frax_c13, diag, isotope) + ! + ! !DESCRIPTION: + ! On the radiation time step, set the carbon isotopic flux + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + real(r8) , intent(inout), pointer :: ciso_flux(:) ! isoC flux + real(r8) , intent(in) , pointer :: ctot_flux(:) ! totC flux + real(r8) , intent(in) , pointer :: ciso_state(:) ! isoC state, upstream pool + real(r8) , intent(in) , pointer :: ctot_state(:) ! totC state, upstream pool + real(r8) , intent(in) :: frax_c13 ! fractionation factor (1 = no fractionation) for C13 + integer , intent(in) :: num ! number of filter members + integer , intent(in) :: filter(:) ! filter indices + integer , intent(in) :: diag ! 0=no diagnostics, 1=print diagnostics + character(len=*) , intent(in) :: isotope ! 'c13' or 'c14' + ! + ! ! LOCAL VARIABLES: + integer :: i,f ! indices + real(r8) :: temp + real(r8) :: frax + !----------------------------------------------------------------------- + + ! if C14, double the fractionation + select case (isotope) + case ('c14') + frax = 1._r8 + (1._r8 - frax_c13) * 2._r8 + case ('c13') + frax = frax_c13 + case default + call endrun(msg='CNCIsoFluxMod: iso must be either c13 or c14'//errMsg(__FILE__, __LINE__)) + end select + + ! loop over the supplied filter + do f = 1,num + i = filter(f) + if (ctot_state(i) /= 0._r8) then + ciso_flux(i) = ctot_flux(i) * (ciso_state(i)/ctot_state(i)) * frax + else + ciso_flux(i) = 0._r8 + end if + + if (diag == 1) then + ! put diagnostic print statements here for isoC flux calculations + end if + end do + + end subroutine CIsoFluxCalc + +end module CNCIsoFluxMod diff --git a/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 new file mode 100644 index 0000000000..aae9e3b6a8 --- /dev/null +++ b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -0,0 +1,350 @@ +module CNCStateUpdate1Mod + + !----------------------------------------------------------------------- + ! Module for carbon state variable update, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp + use clm_time_manager , only : get_step_size + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use pftconMod , only : npcropmin, nc3crop, pftcon + use abortutils , only : endrun + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegStateType , only : cnveg_state_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate1 + public:: CStateUpdate0 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdate0(num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update cpool carbon state + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! gross photosynthesis fluxes + do fp = 1,num_soilp + p = filter_soilp(fp) + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) + cf_veg%psnsun_to_cpool_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) + cf_veg%psnshade_to_cpool_patch(p)*dt + end do + + end associate + + end subroutine CStateUpdate0 + + !----------------------------------------------------------------------- + subroutine CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst ! See note below for xsmrpool_to_atm_patch + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + + harvdate => cnveg_state_inst%harvdate_patch , & ! Input: [integer (:) ] harvest date + + cf_veg => cnveg_carbonflux_inst , & ! Output: + cs_veg => cnveg_carbonstate_inst , & ! Output: + cf_soil => soilbiogeochem_carbonflux_inst & ! Output: + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! Below is the input into the soil biogeochemistry model + + ! plant to litter fluxes + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! phenology and dynamic land cover fluxes + cf_soil%decomp_cpools_sourcesink_col(c,j,i_met_lit) = & + ( cf_veg%phenology_c_to_litr_met_c_col(c,j) + cf_veg%dwt_frootc_to_litr_met_c_col(c,j) ) *dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = & + ( cf_veg%phenology_c_to_litr_cel_c_col(c,j) + cf_veg%dwt_frootc_to_litr_cel_c_col(c,j) ) *dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = & + ( cf_veg%phenology_c_to_litr_lig_c_col(c,j) + cf_veg%dwt_frootc_to_litr_lig_c_col(c,j) ) *dt + cf_soil%decomp_cpools_sourcesink_col(c,j,i_cwd) = & + ( cf_veg%dwt_livecrootc_to_cwdc_col(c,j) + cf_veg%dwt_deadcrootc_to_cwdc_col(c,j) ) *dt + end do + end do + + ! litter and SOM HR fluxes + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & + - ( cf_soil%decomp_cascade_hr_vr_col(c,j,k) + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt + end do + end do + end do + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + cf_soil%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) & + + cf_soil%decomp_cascade_ctransfer_vr_col(c,j,k)*dt + end do + end do + end if + end do + + ! seeding fluxes, from dynamic landcover + do fc = 1,num_soilc + c = filter_soilc(fc) + cs_veg%seedc_col(c) = cs_veg%seedc_col(c) - cf_veg%dwt_seedc_to_leaf_col(c) * dt + cs_veg%seedc_col(c) = cs_veg%seedc_col(c) - cf_veg%dwt_seedc_to_deadstem_col(c) * dt + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) + cf_veg%leafc_xfer_to_leafc_patch(p)*dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - cf_veg%leafc_xfer_to_leafc_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) + cf_veg%frootc_xfer_to_frootc_patch(p)*dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - cf_veg%frootc_xfer_to_frootc_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%deadstemc_xfer_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - cf_veg%deadstemc_xfer_to_deadstemc_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) + cf_veg%livecrootc_xfer_to_livecrootc_patch(p)*dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - cf_veg%livecrootc_xfer_to_livecrootc_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%deadcrootc_xfer_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - cf_veg%deadcrootc_xfer_to_deadcrootc_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - cf_veg%livestemc_xfer_to_livestemc_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) + cf_veg%grainc_xfer_to_grainc_patch(p)*dt + cs_veg%grainc_xfer_patch(p) = cs_veg%grainc_xfer_patch(p) - cf_veg%grainc_xfer_to_grainc_patch(p)*dt + end if + + ! phenology: litterfall fluxes + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - cf_veg%leafc_to_litter_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - cf_veg%frootc_to_litter_patch(p)*dt + + ! livewood turnover fluxes + if (woody(ivt(p)) == 1._r8) then + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - cf_veg%livestemc_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%livestemc_to_deadstemc_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - cf_veg%livecrootc_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%livecrootc_to_deadcrootc_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - cf_veg%livestemc_to_litter_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) - cf_veg%grainc_to_food_patch(p)*dt + end if + + ! maintenance respiration fluxes from cpool + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_xsmrpool_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%leaf_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%froot_curmr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livestem_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livecroot_curmr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%livestem_curmr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%grain_curmr_patch(p)*dt + end if + + ! maintenance respiration fluxes from xsmrpool + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) + cf_veg%cpool_to_xsmrpool_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%leaf_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%froot_xsmr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livestem_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livecroot_xsmr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%livestem_xsmr_patch(p)*dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%grain_xsmr_patch(p)*dt + if (harvdate(p) < 999) then ! beginning at harvest, send to atm + ! TODO (mv, 11-02-2014) the following line is why the cf_veg is an intent(inout) + ! fluxes should not be updated in this module - not sure where this belongs + cf_veg%xsmrpool_to_atm_patch(p) = cf_veg%xsmrpool_to_atm_patch(p) + cs_veg%xsmrpool_patch(p)/dt + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) - cf_veg%xsmrpool_to_atm_patch(p)*dt + end if + end if + + ! allocation fluxes + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_leafc_patch(p)*dt + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) + cf_veg%cpool_to_leafc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_leafc_storage_patch(p)*dt + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) + cf_veg%cpool_to_leafc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_frootc_patch(p)*dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) + cf_veg%cpool_to_frootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_frootc_storage_patch(p)*dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) + cf_veg%cpool_to_frootc_storage_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadstemc_patch(p)*dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) + cf_veg%cpool_to_deadstemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadstemc_storage_patch(p)*dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) + cf_veg%cpool_to_deadstemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livecrootc_patch(p)*dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) + cf_veg%cpool_to_livecrootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livecrootc_storage_patch(p)*dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) + cf_veg%cpool_to_livecrootc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadcrootc_patch(p)*dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) + cf_veg%cpool_to_deadcrootc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_deadcrootc_storage_patch(p)*dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) + cf_veg%cpool_to_deadcrootc_storage_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) + cf_veg%cpool_to_livestemc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) + cf_veg%cpool_to_livestemc_storage_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_grainc_patch(p)*dt + cs_veg%grainc_patch(p) = cs_veg%grainc_patch(p) + cf_veg%cpool_to_grainc_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_grainc_storage_patch(p)*dt + cs_veg%grainc_storage_patch(p) = cs_veg%grainc_storage_patch(p) + cf_veg%cpool_to_grainc_storage_patch(p)*dt + end if + + ! growth respiration fluxes for current growth + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_leaf_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_froot_gr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadstem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livecroot_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadcroot_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_grain_gr_patch(p)*dt + end if + + ! growth respiration for transfer growth + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_leaf_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_froot_gr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livestem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_deadstem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livecroot_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_deadcroot_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_livestem_gr_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - cf_veg%transfer_grain_gr_patch(p)*dt + end if + + ! growth respiration at time of storage + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_leaf_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_froot_storage_gr_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadstem_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livecroot_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_deadcroot_storage_gr_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_livestem_storage_gr_patch(p)*dt + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_grain_storage_gr_patch(p)*dt + end if + + ! growth respiration stored for release during transfer growth + cs_veg%cpool_patch(p) = cs_veg%cpool_patch(p) - cf_veg%cpool_to_gresp_storage_patch(p)*dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) + cf_veg%cpool_to_gresp_storage_patch(p)*dt + + ! move storage pools into transfer pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - cf_veg%leafc_storage_to_xfer_patch(p)*dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) + cf_veg%leafc_storage_to_xfer_patch(p)*dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - cf_veg%frootc_storage_to_xfer_patch(p)*dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) + cf_veg%frootc_storage_to_xfer_patch(p)*dt + if (woody(ivt(p)) == 1._r8) then + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) + cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - cf_veg%deadstemc_storage_to_xfer_patch(p)*dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) + cf_veg%deadstemc_storage_to_xfer_patch(p)*dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p)- cf_veg%livecrootc_storage_to_xfer_patch(p)*dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) + cf_veg%livecrootc_storage_to_xfer_patch(p)*dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p)- cf_veg%deadcrootc_storage_to_xfer_patch(p)*dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) + cf_veg%deadcrootc_storage_to_xfer_patch(p)*dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - cf_veg%gresp_storage_to_xfer_patch(p)*dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) + cf_veg%gresp_storage_to_xfer_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) + cf_veg%livestemc_storage_to_xfer_patch(p)*dt + cs_veg%grainc_storage_patch(p) = cs_veg%grainc_storage_patch(p) - cf_veg%grainc_storage_to_xfer_patch(p)*dt + cs_veg%grainc_xfer_patch(p) = cs_veg%grainc_xfer_patch(p) + cf_veg%grainc_storage_to_xfer_patch(p)*dt + end if + + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate1 + +end module CNCStateUpdate1Mod diff --git a/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 new file mode 100644 index 0000000000..dc4f9d1820 --- /dev/null +++ b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 @@ -0,0 +1,249 @@ +module CNCStateUpdate2Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use CNvegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonStatetype , only : soilbiogeochem_carbonstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate2 + public:: CStateUpdate2h + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables affected by gap-phase mortality fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c ,p,j ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst , & + + cs_soil => soilbiogeochem_carbonstate_inst & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column level carbon fluxes from gap-phase mortality + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column gap mortality fluxes + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + cf_veg%gap_mortality_c_to_litr_met_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + cf_veg%gap_mortality_c_to_litr_cel_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + cf_veg%gap_mortality_c_to_litr_lig_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%gap_mortality_c_to_cwdc_col(c,j) * dt + + end do + end do + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! patch-level carbon fluxes from gap-phase mortality + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) & + - cf_veg%m_leafc_to_litter_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) & + - cf_veg%m_frootc_to_litter_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) & + - cf_veg%m_livestemc_to_litter_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) & + - cf_veg%m_deadstemc_to_litter_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) & + - cf_veg%m_livecrootc_to_litter_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) & + - cf_veg%m_deadcrootc_to_litter_patch(p) * dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) & + - cf_veg%m_leafc_storage_to_litter_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) & + - cf_veg%m_frootc_storage_to_litter_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) & + - cf_veg%m_livestemc_storage_to_litter_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) & + - cf_veg%m_deadstemc_storage_to_litter_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) & + - cf_veg%m_livecrootc_storage_to_litter_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) & + - cf_veg%m_deadcrootc_storage_to_litter_patch(p) * dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) & + - cf_veg%m_gresp_storage_to_litter_patch(p) * dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) & + - cf_veg%m_leafc_xfer_to_litter_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) & + - cf_veg%m_frootc_xfer_to_litter_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) & + - cf_veg%m_livestemc_xfer_to_litter_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) & + - cf_veg%m_deadstemc_xfer_to_litter_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) & + - cf_veg%m_livecrootc_xfer_to_litter_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) & + - cf_veg%m_deadcrootc_xfer_to_litter_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) & + - cf_veg%m_gresp_xfer_to_litter_patch(p) * dt + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate2 + + !----------------------------------------------------------------------- + subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Update all the prognostic carbon state + ! variables affected by harvest mortality fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & + cs_veg => cnveg_carbonstate_inst , & + cs_soil => soilbiogeochem_carbonstate_inst & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column level carbon fluxes from harvest mortality + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column harvest fluxes + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + cf_veg%harvest_c_to_litr_met_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + cf_veg%harvest_c_to_litr_cel_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + cf_veg%harvest_c_to_litr_lig_c_col(c,j) * dt + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = & + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + cf_veg%harvest_c_to_cwdc_col(c,j) * dt + + ! wood to product pools - states updated in CNWoodProducts() + end do + end do + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! patch-level carbon fluxes from harvest mortality + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) & + - cf_veg%hrv_leafc_to_litter_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) & + - cf_veg%hrv_frootc_to_litter_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) & + - cf_veg%hrv_livestemc_to_litter_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) & + - cf_veg%hrv_deadstemc_to_prod10c_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) & + - cf_veg%hrv_deadstemc_to_prod100c_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) & + - cf_veg%hrv_livecrootc_to_litter_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) & + - cf_veg%hrv_deadcrootc_to_litter_patch(p) * dt + + ! xsmrpool + cs_veg%xsmrpool_patch(p) = cs_veg%xsmrpool_patch(p) & + - cf_veg%hrv_xsmrpool_to_atm_patch(p) * dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) & + - cf_veg%hrv_leafc_storage_to_litter_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) & + - cf_veg%hrv_frootc_storage_to_litter_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) & + - cf_veg%hrv_livestemc_storage_to_litter_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) & + - cf_veg%hrv_deadstemc_storage_to_litter_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) & + - cf_veg%hrv_livecrootc_storage_to_litter_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) & + - cf_veg%hrv_deadcrootc_storage_to_litter_patch(p) * dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) & + - cf_veg%hrv_gresp_storage_to_litter_patch(p) * dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) & + - cf_veg%hrv_leafc_xfer_to_litter_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) & + - cf_veg%hrv_frootc_xfer_to_litter_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) & + - cf_veg%hrv_livestemc_xfer_to_litter_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) & + - cf_veg%hrv_deadstemc_xfer_to_litter_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) & + - cf_veg%hrv_livecrootc_xfer_to_litter_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) & + - cf_veg%hrv_deadcrootc_xfer_to_litter_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) & + - cf_veg%hrv_gresp_xfer_to_litter_patch(p) * dt + + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate2h + +end module CNCStateUpdate2Mod diff --git a/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 new file mode 100644 index 0000000000..748e028432 --- /dev/null +++ b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 @@ -0,0 +1,183 @@ +module CNCStateUpdate3Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for carbon state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, ndecomp_pools, i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate3 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables affected by fire fluxes + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cf_veg => cnveg_carbonflux_inst , & ! Input + cs_veg => cnveg_carbonstate_inst, & ! Output + cs_soil => soilbiogeochem_carbonstate_inst & ! Output + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column level carbon fluxes from fire + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! patch-level wood to column-level CWD (uncombusted wood) + cs_soil%decomp_cpools_vr_col(c,j,i_cwd) = cs_soil%decomp_cpools_vr_col(c,j,i_cwd) + & + cf_veg%fire_mortality_c_to_cwdc_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_met_lit) + & + cf_veg%m_c_to_litr_met_fire_col(c,j)* dt + cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_cel_lit) + & + cf_veg%m_c_to_litr_cel_fire_col(c,j)* dt + cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) = cs_soil%decomp_cpools_vr_col(c,j,i_lig_lit) + & + cf_veg%m_c_to_litr_lig_fire_col(c,j)* dt + end do + end do + + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cs_soil%decomp_cpools_vr_col(c,j,l) = cs_soil%decomp_cpools_vr_col(c,j,l) - & + cf_veg%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do + + ! patch-level carbon fluxes from fire + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - & + cf_veg%m_leafc_to_fire_patch(p) * dt + cs_veg%leafc_patch(p) = cs_veg%leafc_patch(p) - & + cf_veg%m_leafc_to_litter_fire_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - & + cf_veg%m_frootc_to_fire_patch(p) * dt + cs_veg%frootc_patch(p) = cs_veg%frootc_patch(p) - & + cf_veg%m_frootc_to_litter_fire_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - & + cf_veg%m_livestemc_to_fire_patch(p) * dt + cs_veg%livestemc_patch(p) = cs_veg%livestemc_patch(p) - & + cf_veg%m_livestemc_to_litter_fire_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) - & + cf_veg%m_deadstemc_to_fire_patch(p) * dt + cs_veg%deadstemc_patch(p) = cs_veg%deadstemc_patch(p) - & + cf_veg%m_deadstemc_to_litter_fire_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - & + cf_veg%m_livecrootc_to_fire_patch(p) * dt + cs_veg%livecrootc_patch(p) = cs_veg%livecrootc_patch(p) - & + cf_veg%m_livecrootc_to_litter_fire_patch(p)* dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) - & + cf_veg%m_deadcrootc_to_fire_patch(p) * dt + cs_veg%deadcrootc_patch(p) = cs_veg%deadcrootc_patch(p) - & + cf_veg%m_deadcrootc_to_litter_fire_patch(p)* dt + + ! storage pools + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - & + cf_veg%m_leafc_storage_to_fire_patch(p) * dt + cs_veg%leafc_storage_patch(p) = cs_veg%leafc_storage_patch(p) - & + cf_veg%m_leafc_storage_to_litter_fire_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - & + cf_veg%m_frootc_storage_to_fire_patch(p) * dt + cs_veg%frootc_storage_patch(p) = cs_veg%frootc_storage_patch(p) - & + cf_veg%m_frootc_storage_to_litter_fire_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - & + cf_veg%m_livestemc_storage_to_fire_patch(p) * dt + cs_veg%livestemc_storage_patch(p) = cs_veg%livestemc_storage_patch(p) - & + cf_veg%m_livestemc_storage_to_litter_fire_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - & + cf_veg%m_deadstemc_storage_to_fire_patch(p) * dt + cs_veg%deadstemc_storage_patch(p) = cs_veg%deadstemc_storage_patch(p) - & + cf_veg%m_deadstemc_storage_to_litter_fire_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) - & + cf_veg%m_livecrootc_storage_to_fire_patch(p) * dt + cs_veg%livecrootc_storage_patch(p) = cs_veg%livecrootc_storage_patch(p) - & + cf_veg%m_livecrootc_storage_to_litter_fire_patch(p)* dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) - & + cf_veg%m_deadcrootc_storage_to_fire_patch(p) * dt + cs_veg%deadcrootc_storage_patch(p) = cs_veg%deadcrootc_storage_patch(p) - & + cf_veg%m_deadcrootc_storage_to_litter_fire_patch(p)* dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - & + cf_veg%m_gresp_storage_to_fire_patch(p) * dt + cs_veg%gresp_storage_patch(p) = cs_veg%gresp_storage_patch(p) - & + cf_veg%m_gresp_storage_to_litter_fire_patch(p) * dt + + ! transfer pools + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - & + cf_veg%m_leafc_xfer_to_fire_patch(p) * dt + cs_veg%leafc_xfer_patch(p) = cs_veg%leafc_xfer_patch(p) - & + cf_veg%m_leafc_xfer_to_litter_fire_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - & + cf_veg%m_frootc_xfer_to_fire_patch(p) * dt + cs_veg%frootc_xfer_patch(p) = cs_veg%frootc_xfer_patch(p) - & + cf_veg%m_frootc_xfer_to_litter_fire_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - & + cf_veg%m_livestemc_xfer_to_fire_patch(p) * dt + cs_veg%livestemc_xfer_patch(p) = cs_veg%livestemc_xfer_patch(p) - & + cf_veg%m_livestemc_xfer_to_litter_fire_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - & + cf_veg%m_deadstemc_xfer_to_fire_patch(p) * dt + cs_veg%deadstemc_xfer_patch(p) = cs_veg%deadstemc_xfer_patch(p) - & + cf_veg%m_deadstemc_xfer_to_litter_fire_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - & + cf_veg%m_livecrootc_xfer_to_fire_patch(p) * dt + cs_veg%livecrootc_xfer_patch(p) = cs_veg%livecrootc_xfer_patch(p) - & + cf_veg%m_livecrootc_xfer_to_litter_fire_patch(p)* dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - & + cf_veg%m_deadcrootc_xfer_to_fire_patch(p) * dt + cs_veg%deadcrootc_xfer_patch(p) = cs_veg%deadcrootc_xfer_patch(p) - & + cf_veg%m_deadcrootc_xfer_to_litter_fire_patch(p)* dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - & + cf_veg%m_gresp_xfer_to_fire_patch(p) * dt + cs_veg%gresp_xfer_patch(p) = cs_veg%gresp_xfer_patch(p) - & + cf_veg%m_gresp_xfer_to_litter_fire_patch(p) * dt + + end do ! end of patch loop + + end associate + + end subroutine CStateUpdate3 + +end module CNCStateUpdate3Mod diff --git a/components/clm/src/biogeochem/CNDVDriverMod.F90 b/components/clm/src/biogeochem/CNDVDriverMod.F90 new file mode 100644 index 0000000000..fa21d1e18a --- /dev/null +++ b/components/clm/src/biogeochem/CNDVDriverMod.F90 @@ -0,0 +1,464 @@ +module CNDVDriverMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Note that this module was created simply to contain the subroutine dv + ! which cannot cannot be in CNDVMod due to circular dependencies + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use clm_varcon , only : grlnd + use LandunitType , only : lun + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNDVDriver + public :: CNDVHist + ! + ! !PRIVATE MEMBER FUNCTIONS: + private set_dgvm_filename + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNDVDriver(bounds, & + num_natvegp, filter_natvegp, kyr, & + atm2lnd_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, dgvs_inst) + ! + ! !DESCRIPTION: + ! Drives the annual dynamic vegetation that works with CN + ! + ! !USES: + use CNDVLightMod , only : Light + use CNDVEstablishmentMod , only : Establishment + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(inout) :: num_natvegp ! number of naturally-vegetated patches in filter + integer , intent(inout) :: filter_natvegp(:) ! filter for naturally-vegetated patches + integer , intent(in) :: kyr ! used in routine climate20 below + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + !----------------------------------------------------------------------- + + associate( & + fpcgrid => dgvs_inst%fpcgrid_patch , & ! Input: [real(r8) (:) ] foliar projective cover on gridcell (fraction) + agdd20 => dgvs_inst%agdd20_patch , & ! Output: [real(r8) (:) ] 20-yr running mean of agdd + tmomin20 => dgvs_inst%tmomin20_patch , & ! Output: [real(r8) (:) ] 20-yr running mean of tmomin + agdd => dgvs_inst%agdd_patch , & ! Input: [real(r8) (:) ] accumulated growing degree days above 5 + + t_mo_min => atm2lnd_inst%t_mo_min_patch , & ! Output: [real(r8) (:) ] annual min of t_mo (Kelvin) + + leafcmax => cnveg_carbonstate_inst%leafcmax_patch & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + ) + + ! ************************************************************************* + ! S. Levis version of LPJ's routine climate20: 'Returns' tmomin20 & agdd20 + ! for use in routine bioclim, which I have placed in routine Establishment + ! Instead of 20-yr running mean of coldest monthly temperature, + ! use 20-yr running mean of minimum 10-day running mean + ! ************************************************************************* + + do p = bounds%begp, bounds%endp + if (kyr == 2) then ! slevis: add ".and. start_type==arb_ic" here? + tmomin20(p) = t_mo_min(p) ! NO, b/c want to be able to start dgvm + agdd20(p) = agdd(p) ! w/ clmi file from non-dgvm simulation + end if + tmomin20(p) = (19._r8 * tmomin20(p) + t_mo_min(p)) / 20._r8 + agdd20(p) = (19._r8 * agdd20(p) + agdd(p) ) / 20._r8 + end do + + ! Rebuild filter of present natually-vegetated patches after Kill() + + num_natvegp = 0 + do p = bounds%begp,bounds%endp + if (dgvs_inst%present_patch(p)) then + num_natvegp = num_natvegp + 1 + filter_natvegp(num_natvegp) = p + end if + end do + + ! Returns fpcgrid and nind + + call Light(bounds, num_natvegp, filter_natvegp, & + cnveg_carbonstate_inst, dgvs_inst) + + ! Returns updated fpcgrid, nind, crownarea, and present. Due to updated + ! present, we do not use the natveg filter in this subroutine. + + call Establishment(bounds, & + atm2lnd_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, dgvs_inst) + + ! Reset dgvm variables needed in next yr (too few to keep subr. dvreset) + + do p = bounds%begp,bounds%endp + leafcmax(p) = 0._r8 + t_mo_min(p) = 1.0e+36_r8 + end do + + end associate + + end subroutine CNDVDriver + + !----------------------------------------------------------------------- + subroutine CNDVHist(bounds, dgvs_inst) + ! + ! !DESCRIPTION: + ! Write CNDV history file + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_CDAY + use shr_sys_mod , only : shr_sys_getenv + use clm_varpar , only : maxpatch_pft + use clm_varctl , only : caseid, ctitle, finidat, fsurdat, paramfile, iulog + use clm_varcon , only : spval + use clm_time_manager, only : get_ref_date, get_nstep, get_curr_date, get_curr_time + use domainMod , only : ldomain + use fileutils , only : get_filename + use spmdMod , only : masterproc + use ncdio_pio + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(dgvs_type) , intent(in) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + character(len=256) :: dgvm_fn ! dgvm history filename + type(file_desc_t) :: ncid ! netcdf file id + integer :: ncprec ! output precision + integer :: g,p,l ! indices + integer :: ier ! error status + integer :: mdcur, mscur, mcdate ! outputs from get_curr_time + integer :: yr,mon,day,mcsec ! outputs from get_curr_date + integer :: hours,minutes,secs ! hours,minutes,seconds of hh:mm:ss + integer :: nstep ! time step + integer :: nbsec ! seconds components of a date + integer :: dimid ! dimension, variable id + real(r8):: time ! current time + character(len=256) :: str ! temporary string + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len= 10) :: basedate ! base date (yyyymmdd) + character(len= 8) :: basesec ! base seconds + real(r8) , pointer :: rbuf2dg (:,:) ! Input: [real(r8) (:,:)] temporary + !----------------------------------------------------------------------- + + associate(& + fpcgrid => dgvs_inst%fpcgrid_patch , & ! Input: [real(r8) (:)] foliar projective cover on gridcell (fraction) + nind => dgvs_inst%nind_patch & ! Input: [real(r8) (:)] number of individuals (#/m**2) + ) + + allocate(rbuf2dg(bounds%begg:bounds%endg,maxpatch_pft), stat=ier) + if (ier /= 0) call endrun(msg='histCNDV: allocation error for rbuf2dg'//& + errMsg(__FILE__, __LINE__)) + + ! Set output precision + + ncprec = ncd_double + + ! ----------------------------------------------------------------------- + ! Create new netCDF file. File will be in define mode + ! ----------------------------------------------------------------------- + + dgvm_fn = set_dgvm_filename() + call ncd_pio_createfile(ncid, trim(dgvm_fn)) + + ! ----------------------------------------------------------------------- + ! Create global attributes. + ! ----------------------------------------------------------------------- + + str = 'CF1.0' + call ncd_putatt (ncid, ncd_global, 'conventions', trim(str)) + + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(ncid, ncd_global,'history', trim(str)) + + call shr_sys_getenv('LOGNAME', str, ier) + if (ier /= 0) call endrun(msg='error: LOGNAME environment variable not defined'//& + errMsg(__FILE__, __LINE__)) + + call ncd_putatt (ncid, ncd_global, 'logname', trim(str)) + + call shr_sys_getenv('HOST', str, ier) + call ncd_putatt (ncid, ncd_global, 'host', trim(str)) + + str = 'Community Land Model: CLM3' + call ncd_putatt (ncid, ncd_global, 'source', trim(str)) + + str = '$Name$' + call ncd_putatt (ncid, ncd_global, 'version', trim(str)) + + str = '$Id$' + call ncd_putatt (ncid, ncd_global, 'revision_id', trim(str)) + + str = ctitle + call ncd_putatt (ncid, ncd_global, 'case_title', trim(str)) + + str = caseid + call ncd_putatt (ncid, ncd_global, 'case_id', trim(str)) + + str = get_filename(fsurdat) + call ncd_putatt(ncid, ncd_global, 'Surface_dataset', trim(str)) + + str = 'arbitrary initialization' + if (finidat /= ' ') str = get_filename(finidat) + call ncd_putatt(ncid, ncd_global, 'Initial_conditions_dataset', trim(str)) + + str = get_filename(paramfile) + call ncd_putatt(ncid, ncd_global, 'PFT_physiological_constants_dataset', trim(str)) + + ! ----------------------------------------------------------------------- + ! Define dimensions. + ! ----------------------------------------------------------------------- + + if (ldomain%isgrid2d) then + call ncd_defdim (ncid, 'lon' ,ldomain%ni, dimid) + call ncd_defdim (ncid, 'lat' ,ldomain%nj, dimid) + else + call ncd_defdim (ncid, 'gridcell', ldomain%ns, dimid) + end if + call ncd_defdim (ncid, 'pft' , maxpatch_pft , dimid) + call ncd_defdim (ncid, 'time', ncd_unlimited, dimid) + call ncd_defdim (ncid, 'string_length', 80 , dimid) + + ! ----------------------------------------------------------------------- + ! Define variables + ! ----------------------------------------------------------------------- + + ! Define coordinate variables (including time) + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='lon', xtype=ncprec, dim1name='lon', & + long_name='coordinate longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='lat', xtype=ncprec, dim1name='lat', & + long_name='coordinate latitude', units='degrees_north') + end if + + call get_curr_time(mdcur, mscur) + call get_ref_date(yr, mon, day, nbsec) + hours = nbsec / 3600 + minutes = (nbsec - hours*3600) / 60 + secs = (nbsec - hours*3600 - minutes*60) + write(basedate,80) yr,mon,day +80 format(i4.4,'-',i2.2,'-',i2.2) + write(basesec ,90) hours, minutes, secs +90 format(i2.2,':',i2.2,':',i2.2) + str = 'days since ' // basedate // " " // basesec + time = mdcur + mscur/SHR_CONST_CDAY + + call ncd_defvar(ncid=ncid, varname='time', xtype=ncd_double, dim1name='time', & + long_name='time', units=str) + + ! Define surface grid (coordinate variables, latitude, longitude, surface type). + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='longxy', xtype=ncprec, & + dim1name='lon', dim2name='lat', & + long_name='longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='latixy', xtype=ncprec, & + dim1name='lon', dim2name='lat', & + long_name='latitude', units='degrees_north') + + call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='land/ocean mask (0.=ocean and 1.=land)') + else + call ncd_defvar(ncid=ncid, varname='longxy', xtype=ncprec, & + dim1name='gridcell',& + long_name='longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='latixy', xtype=ncprec, & + dim1name='gridcell',& + long_name='latitude', units='degrees_north') + + call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int, & + dim1name='gridcell', & + long_name='land/ocean mask (0.=ocean and 1.=land)') + end if + + ! Define time information + + call ncd_defvar(ncid=ncid, varname='mcdate', xtype=ncd_int, dim1name='time',& + long_name='current date (YYYYMMDD)') + + call ncd_defvar(ncid=ncid, varname='mcsec', xtype=ncd_int, dim1name='time',& + long_name='current seconds of current date', units='s') + + call ncd_defvar(ncid=ncid, varname='mdcur', xtype=ncd_int, dim1name='time',& + long_name='current day (from base day)') + + call ncd_defvar(ncid=ncid, varname='mscur', xtype=ncd_int, dim1name='time',& + long_name='current seconds of current day', units='s') + + call ncd_defvar(ncid=ncid, varname='nstep', xtype=ncd_int, dim1name='time',& + long_name='time step', units='s') + + ! Define time dependent variables + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='FPCGRID', xtype=ncprec, & + dim1name='lon', dim2name='lat', dim3name='pft', dim4name='time', & + long_name='plant functional type cover', units='fraction of vegetated area', & + missing_value=spval, fill_value=spval) + + call ncd_defvar(ncid=ncid, varname='NIND', xtype=ncprec, & + dim1name='lon', dim2name='lat', dim3name='pft', dim4name='time', & + long_name='number of individuals', units='individuals/m2 vegetated land', & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=ncid, varname='FPCGRID', xtype=ncprec, & + dim1name='gridcell', dim2name='pft', dim3name='time', & + long_name='plant functional type cover', units='fraction of vegetated area', & + missing_value=spval, fill_value=spval) + + call ncd_defvar(ncid=ncid, varname='NIND', xtype=ncprec, & + dim1name='gridcell', dim2name='pft', dim3name='time', & + long_name='number of individuals', units='individuals/m2 vegetated land', & + missing_value=spval, fill_value=spval) + end if + + call ncd_enddef(ncid) + + ! ----------------------------------------------------------------------- + ! Write variables + ! ----------------------------------------------------------------------- + + ! Write surface grid (coordinate variables, latitude, longitude, surface type). + + call ncd_io(ncid=ncid, varname='longxy' , data=ldomain%lonc, flag='write', & + dim1name=grlnd) + call ncd_io(ncid=ncid, varname='latixy' , data=ldomain%latc, flag='write', & + dim1name=grlnd) + call ncd_io(ncid=ncid, varname='landmask', data=ldomain%mask, flag='write', & + dim1name=grlnd) + + ! Write current date, current seconds, current day, current nstep + + call get_curr_date(yr, mon, day, mcsec) + mcdate = yr*10000 + mon*100 + day + nstep = get_nstep() + + call ncd_io(ncid=ncid, varname='mcdate', data=mcdate, nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mcsec' , data=mcsec , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mdcur' , data=mdcur , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mscur' , data=mcsec , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='nstep' , data=nstep , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='time' , data=time , nt=1, flag='write') + + ! Write time dependent variables to CNDV history file + + ! The if .not. ifspecial statment below guarantees that the m index will + ! always lie between 1 and maxpatch_pft + + rbuf2dg(bounds%begg : bounds%endg, :) = 0._r8 + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + if (.not. lun%ifspecial(l)) rbuf2dg(g,patch%mxy(p)) = fpcgrid(p)*100._r8 + end do + call ncd_io(ncid=ncid, varname='FPCGRID', dim1name=grlnd, data=rbuf2dg, & + nt=1, flag='write') + + rbuf2dg(bounds%begg : bounds%endg, :) = 0._r8 + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + if (.not. lun%ifspecial(l)) rbuf2dg(g,patch%mxy(p)) = nind(p) + end do + call ncd_io(ncid=ncid, varname='NIND', dim1name=grlnd, data=rbuf2dg, & + nt=1, flag='write') + + ! Deallocate dynamic memory + + deallocate(rbuf2dg) + + !------------------------------------------------------------------ + ! Close and archive netcdf CNDV history file + !------------------------------------------------------------------ + + call ncd_pio_closefile(ncid) + + if (masterproc) then + write(iulog,*)'(histCNDV): Finished writing CNDV history dataset ',& + trim(dgvm_fn), 'at nstep = ',get_nstep() + end if + + end associate + + end subroutine CNDVHist + + !----------------------------------------------------------------------- + character(len=256) function set_dgvm_filename () + ! + ! !DESCRIPTION: + ! Determine initial dataset filenames + ! + ! !USES: + use clm_varctl , only : caseid, inst_suffix + use clm_time_manager , only : get_curr_date + ! + ! !ARGUMENTS: + implicit none + ! + ! !LOCAL VARIABLES: + character(len=256) :: cdate !date char string + integer :: day !day (1 -> 31) + integer :: mon !month (1 -> 12) + integer :: yr !year (0 -> ...) + integer :: sec !seconds into current day + !----------------------------------------------------------------------- + + call get_curr_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec + set_dgvm_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".hv."//trim(cdate)//".nc" + + end function set_dgvm_filename + + !----------------------------------------------------------------------- + subroutine BuildNatVegFilter(bounds, num_natvegp, filter_natvegp, dgvs_inst) + ! + ! !DESCRIPTION: + ! Reconstruct a filter of naturally-vegetated Patches for use in DGVM + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(out) :: num_natvegp ! number of patches in naturally-vegetated filter + integer , intent(out) :: filter_natvegp(:) ! patch filter for naturally-vegetated points + type(dgvs_type) , intent(in) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + integer :: p + !----------------------------------------------------------------------- + + num_natvegp = 0 + do p = bounds%begp,bounds%endp + if (dgvs_inst%present_patch(p)) then + num_natvegp = num_natvegp + 1 + filter_natvegp(num_natvegp) = p + end if + end do + + end subroutine BuildNatVegFilter + +end module CNDVDriverMod diff --git a/components/clm/src/biogeochem/CNDVEstablishmentMod.F90 b/components/clm/src/biogeochem/CNDVEstablishmentMod.F90 new file mode 100644 index 0000000000..6df91c2d55 --- /dev/null +++ b/components/clm/src/biogeochem/CNDVEstablishmentMod.F90 @@ -0,0 +1,447 @@ +module CNDVEstablishmentMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates establishment of new patches + ! Called once per year + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type, dgv_ecophyscon + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use LandunitType , only : lun + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Establishment + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Establishment(bounds, & + atm2lnd_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, dgvs_inst) + ! + ! !DESCRIPTION: + ! Calculates establishment of new patches - called once per year + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_PI, SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use landunit_varcon , only : istsoil + use clm_varctl , only : iulog + use pftconMod , only : noveg, nc3_arctic_grass + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + integer :: g,l,p,m ! indices + integer :: fn, filterg(bounds%begg-bounds%endg+1) ! local gridcell filter for error check + ! + ! gridcell level variables + integer :: ngrass(bounds%begg:bounds%endg) ! counter + integer :: npft_estab(bounds%begg:bounds%endg) ! counter + real(r8) :: fpc_tree_total(bounds%begg:bounds%endg) ! total fractional cover of trees in vegetated portion of gridcell + real(r8) :: fpc_total(bounds%begg:bounds%endg) ! old-total fractional vegetated portion of gridcell (without bare ground) + real(r8) :: fpc_total_new(bounds%begg:bounds%endg) ! new-total fractional vegetated portion of gridcell (without bare ground) + + ! patch level variables + logical :: survive(bounds%begp:bounds%endp) ! true=>pft survives + logical :: estab(bounds%begp:bounds%endp) ! true=>pft is established + real(r8) :: dstemc(bounds%begp:bounds%endp) ! local copy of deadstemc + + ! local and temporary variables or parameters + real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) + real(r8) :: estab_rate ! establishment rate + real(r8) :: estab_grid ! establishment rate on grid cell + real(r8) :: fpcgridtemp ! temporary + real(r8) :: stemdiam ! stem diameter + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: lai_ind ! LAI per individual + real(r8) :: lm_ind ! leaf carbon (gC/ind) + real(r8) :: fpc_ind ! individual foliage projective cover + real(r8):: bm_delta + + ! parameters + real(r8), parameter :: ramp_agddtw = 300.0 + + ! minimum individual density for persistence of PATCH (indiv/m2) + real(r8), parameter :: nind_min = 1.0e-10_r8 + + ! minimum precip. for establishment (mm/s) + real(r8), parameter :: prec_min_estab = 100._r8/(365._r8*SHR_CONST_CDAY) + + ! maximum sapling establishment rate (indiv/m2) + real(r8), parameter :: estab_max = 0.24_r8 + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis [m^2/gC] + dwood => pftcon%dwood , & ! Input: wood density (gC/m3) + woody => pftcon%woody , & ! Input: woody patch or not + + crownarea_max => dgv_ecophyscon%crownarea_max , & ! Input: [real(r8) (:) ] ecophys const - tree maximum crown area [m2] + twmax => dgv_ecophyscon%twmax , & ! Input: [real(r8) (:) ] ecophys const - upper limit of temperature of the warmest month + reinickerp => dgv_ecophyscon%reinickerp , & ! Input: [real(r8) (:) ] ecophys const - parameter in allometric equation + allom1 => dgv_ecophyscon%allom1 , & ! Input: [real(r8) (:) ] ecophys const - parameter in allometric + tcmax => dgv_ecophyscon%tcmax , & ! Input: [real(r8) (:) ] ecophys const - maximum coldest monthly mean temperature + tcmin => dgv_ecophyscon%tcmin , & ! Input: [real(r8) (:) ] ecophys const - minimum coldest monthly mean temperature + gddmin => dgv_ecophyscon%gddmin , & ! Input: [real(r8) (:) ] ecophys const - minimum growing degree days (at or above 5 C) + + prec365 => atm2lnd_inst%prec365_patch , & ! Input: [real(r8) (:) ] 365-day running mean of tot. precipitation + + agddtw => dgvs_inst%agddtw_patch , & ! Input: [real(r8) (:) ] accumulated growing degree days above twmax + agdd20 => dgvs_inst%agdd20_patch , & ! Input: [real(r8) (:) ] 20-yr running mean of agdd + tmomin20 => dgvs_inst%tmomin20_patch , & ! Input: [real(r8) (:) ] 20-yr running mean of tmomin + pftmayexist => dgvs_inst%pftmayexist_patch , & ! Input: [logical (:) ] exclude seasonal decid patches from tropics [1=true, 0=false] + present => dgvs_inst%present_patch , & ! Output: [logical (:) ] true=> PATCH present in patch + nind => dgvs_inst%nind_patch , & ! Output: [real(r8) (:) ] number of individuals (#/m**2) + fpcgrid => dgvs_inst%fpcgrid_patch , & ! Output: [real(r8) (:) ] foliar projective cover on gridcell (fraction) + crownarea => dgvs_inst%crownarea_patch , & ! Output: [real(r8) (:) ] area that each individual tree takes up (m^2) + greffic => dgvs_inst%greffic_patch , & ! Output: [real(r8) (:) ] lpj's growth efficiency + heatstress => dgvs_inst%heatstress_patch , & ! Output: [real(r8) (:) ] + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum NPP (gC/m2/yr) + annsum_litfall => cnveg_carbonflux_inst%annsum_litfall_patch , & ! Input: [real(r8) (:) ] annual sum litfall (gC/m2/yr) + + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + leafcmax => cnveg_carbonstate_inst%leafcmax_patch & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + ) + + ! ********************************************************************** + ! Slevis version of LPJ's subr. bioclim + ! Limits based on 20-year running averages of coldest-month mean + ! temperature and growing degree days (5 degree base). + ! For SURVIVAL, coldest month temperature and GDD should be + ! at least as high as PFT-specific limits. + ! For REGENERATION, PATCH must be able to survive AND coldest month + ! temperature should be no higher than a PFT-specific limit. + ! ********************************************************************** + + taper = 200._r8 ! make a global constant as with dwood (lpj's wooddens) + + ! Initialize gridcell-level metrics + + do g = bounds%begg,bounds%endg + ngrass(g) = 0 + npft_estab(g) = 0 + fpc_tree_total(g) = 0._r8 + fpc_total(g) = 0._r8 + fpc_total_new(g) = 0._r8 + end do + + do p = bounds%begp,bounds%endp + ! Set the presence of patch for this gridcell + + if (nind(p) == 0._r8) present(p) = .false. + if (.not. present(p)) then + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + survive(p) = .false. + estab(p) = .false. + dstemc(p) = deadstemc(p) + end do + + ! Must go thru all 16 patches and decide which can/cannot establish or survive + ! Determine present, survive, estab. Note: Even if tmomin20>tcmax, crops + ! and 2nd boreal summergreen tree cannot exist (see + ! EcosystemDynini) because this model cannot simulate such patches, yet. + ! Note - agddtw is only defined at the patch level and has now been moved + ! to an if-statement below to determine establishment of boreal trees + + do p = bounds%begp,bounds%endp + if (tmomin20(p) >= tcmin(ivt(p)) + SHR_CONST_TKFRZ ) then + if (tmomin20(p) <= tcmax(ivt(p)) + SHR_CONST_TKFRZ .and. agdd20(p) >= gddmin(ivt(p))) then + estab(p) = .true. + end if + survive(p) = .true. + ! seasonal decid. patches that would have occurred in regions without + ! short winter day lengths (see CNPhenology) + if (.not. pftmayexist(p)) then + survive(p) = .false. + estab(p) = .false. + pftmayexist(p) = .true. + end if + end if + end do + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + ! Case 1 -- patch ceases to exist -kill patches not adapted to current climate + + if (present(p) .and. (.not. survive(p) .or. nind(p)= prec_min_estab .and. estab(p)) then + if (twmax(ivt(p)) > 999._r8 .or. agddtw(p) == 0._r8) then + + present(p) = .true. + nind(p) = 0._r8 + ! lpj starts with fpcgrid=0 and calculates + ! seed fpcgrid from the carbon of saplings; + ! with CN we need the seed fpcgrid up front + ! to scale seed leafc to lm_ind to get fpcgrid; + ! sounds circular; also seed fpcgrid depends on sla, + ! so theoretically need diff value for each pft;slevis + fpcgrid(p) = 0.000844_r8 + if (woody(ivt(p)) < 1._r8) then + fpcgrid(p) = 0.05_r8 + end if + + ! Seed carbon for newly established patches + ! Equiv. to pleaf=1 & pstor=1 set in subr pftwt_cnbal (slevis) + ! ***Dangerous*** to hardwire leafcmax here; find alternative! + ! Consider just assigning nind and fpcgrid for newly + ! established patches instead of entering the circular procedure + ! outlined in the paragraph above + leafcmax(p) = 1._r8 + if (dstemc(p) <= 0._r8) dstemc(p) = 0.1_r8 + + end if ! conditions required for establishment + end if ! conditions required for establishment + end if ! if soil + + ! Case 3 -- some patches continue to exist (no change) and some patches + ! continue to not exist (no change). Do nothing for this case. + + end do + + ! Sapling and grass establishment + ! Calculate total woody FPC, FPC increment and grass cover (= crown area) + ! Calculate total woody FPC and number of woody Patches present and able to establish + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + if (present(p)) then + if (woody(ivt(p)) == 1._r8) then + fpc_tree_total(g) = fpc_tree_total(g) + fpcgrid(p) + if (estab(p)) npft_estab(g) = npft_estab(g) + 1 + else if (woody(ivt(p)) < 1._r8 .and. ivt(p) > noveg) then !grass + ngrass(g) = ngrass(g) + 1 + end if + end if + end do + + ! Above grid-level establishment counters are required for the next steps. + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + + if (present(p) .and. woody(ivt(p)) == 1._r8 .and. estab(p)) then + + ! Calculate establishment rate over available space, per tree PFT + ! Max establishment rate reduced by shading as tree FPC approaches 1 + ! Total establishment rate partitioned equally among regenerating woody Patches + + estab_rate = estab_max * (1._r8-exp(5._r8*(fpc_tree_total(g)-1._r8))) / real(npft_estab(g)) + + ! Calculate grid-level establishment rate per woody PFT + ! Space available for woody PATCH establishment is fraction of grid cell + ! not currently occupied by woody Patches + + estab_grid = estab_rate * (1._r8-fpc_tree_total(g)) + + ! Add new saplings to current population + + nind(p) = nind(p) + estab_grid + + !slevis: lpj's lm_ind was the max leaf mass for the year; + !now lm_ind is the max leaf mass for the year calculated in CNFire + !except when a patch is newly established (nind==0); then lm_ind + !is assigned a leafcmax above + + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) ! nind>0 for sure + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + ! stemdiam derived here from cn's formula for htop found in + ! CNVegStructUpdate and cn's assumption stemdiam=2*htop/taper + ! this derivation neglects upper htop limit enforced elsewhere + stemdiam = (24._r8 * dstemc(p) / (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) + else + stemdiam = 0._r8 + end if + ! Eqn D (now also in Light; need here for 1st yr when patches haven't established, yet) + crownarea(p) = min(crownarea_max(ivt(p)), allom1(ivt(p))*stemdiam**reinickerp(ivt(p))) + + ! Update LAI and FPC + + if (crownarea(p) > 0._r8) then + if (dsladlai(ivt(p)) > 0._r8) then + ! make lai_ind >= 0.001 to avoid killing plants at this stage + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else ! currently redundant because dsladlai=0 for grasses only + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) ! lpj's formula + end if + else + lai_ind = 0._r8 + end if + + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + + end if ! add new saplings block + if (present(p) .and. woody(ivt(p)) == 1._r8) then + fpc_total_new(g) = fpc_total_new(g) + fpcgrid(p) + end if + end do ! close loop to update fpc_total_new + + ! Adjustments- don't allow trees to exceed 95% of vegetated landunit + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + if (fpc_total_new(g) > 0.95_r8) then + if (woody(ivt(p)) == 1._r8 .and. present(p)) then + nind(p) = nind(p) * 0.95_r8 / fpc_total_new(g) + fpcgrid(p) = fpcgrid(p) * 0.95_r8 / fpc_total_new(g) + end if + fpc_total(g) = 0.95_r8 + + else + fpc_total(g) = fpc_total_new(g) + end if + end do + + ! Section for grasses. Grasses can establish in non-vegetated areas + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + if (present(p) .and. woody(ivt(p)) < 1._r8) then + if (leafcmax(p) <= 0._r8 .or. fpcgrid(p) <= 0._r8 ) then + present(p) = .false. + nind(p) = 0._r8 + else + nind(p) = 1._r8 ! in case these grasses just established + crownarea(p) = 1._r8 + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + if (dsladlai(ivt(p)) > 0._r8) then + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else ! 'if' is currently redundant b/c dsladlai=0 for grasses only + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) + end if + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + fpc_total(g) = fpc_total(g) + fpcgrid(p) + end if + end if + end do ! end of pft-loop + + ! Adjustment of fpc_total > 1 due to grasses (ivt >= nc3_arctic_grass) + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + + if (fpc_total(g) > 1._r8) then + if (ivt(p) >= nc3_arctic_grass .and. fpcgrid(p) > 0._r8) then + fpcgridtemp = fpcgrid(p) + fpcgrid(p) = max(0._r8, fpcgrid(p) - (fpc_total(g)-1._r8)) + fpc_total(g) = fpc_total(g) - fpcgridtemp + fpcgrid(p) + end if + end if + + ! Remove tiny fpcgrid amounts + + if (fpcgrid(p) < 1.e-15_r8) then + fpc_total(g) = fpc_total(g) - fpcgrid(p) + fpcgrid(p) = 0._r8 + present(p) = .false. + nind(p) = 0._r8 + end if + + ! Set the fpcgrid for bare ground if there is bare ground in + ! vegetated landunit and patch is bare ground so that everything + ! can add up to one. + + if (fpc_total(g) < 1._r8 .and. ivt(p) == noveg) then + fpcgrid(p) = 1._r8 - fpc_total(g) + fpc_total(g) = fpc_total(g) + fpcgrid(p) + end if + + end do + + ! Annual calculations used hourly in GapMortality + ! Ultimately may wish to place in separate subroutine... + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + + ! Stress mortality from lpj's subr Mortality + + if (woody(ivt(p)) == 1._r8 .and. nind(p) > 0._r8 .and. & + leafcmax(p) > 0._r8 .and. fpcgrid(p) > 0._r8) then + + if (twmax(ivt(p)) < 999._r8) then + heatstress(p) = max(0._r8, min(1._r8, agddtw(p) / ramp_agddtw)) + else + heatstress(p) = 0._r8 + end if + + ! Net individual living biomass increment + ! NB: lpj's turnover not exactly same as cn's litfall: + ! lpj's sap->heartwood turnover not included in litfall (slevis) + + bm_delta = max(0._r8, annsum_npp(p) - annsum_litfall(p)) + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + + ! Growth efficiency (net biomass increment per unit leaf area) + + if (dsladlai(ivt(p)) > 0._r8) then + greffic(p) = bm_delta / (max(0.001_r8, & + ( ( exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) & + - slatop(ivt(p)) ) / dsladlai(ivt(p)) ))) + else ! currently redundant because dsladlai=0 for grasses only + greffic(p) = bm_delta / (lm_ind * slatop(ivt(p))) + end if + else + greffic(p) = 0. + heatstress(p) = 0. + end if + + end do + + ! Check for error in establishment + fn = 0 + do g = bounds%begg,bounds%endg + if (abs(fpc_total(g) - 1._r8) > 1.e-6) then + fn = fn + 1 + filterg(fn) = g + end if + end do + ! Just print out the first error + if (fn > 0) then + g = filterg(1) + write(iulog,*) 'Error in Establishment: fpc_total =',fpc_total(g), ' at gridcell ',g + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end associate + + end subroutine Establishment + +end module CNDVEstablishmentMod diff --git a/components/clm/src/biogeochem/CNDVLightMod.F90 b/components/clm/src/biogeochem/CNDVLightMod.F90 new file mode 100644 index 0000000000..3c498742b9 --- /dev/null +++ b/components/clm/src/biogeochem/CNDVLightMod.F90 @@ -0,0 +1,231 @@ +module CNDVLightMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate light competition + ! Update fpc for establishment routine + ! Called once per year + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_PI + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use CNDVType , only : dgv_ecophyscon, dgvs_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Light + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Light(bounds, num_natvegp, filter_natvegp, & + cnveg_carbonstate_inst, dgvs_inst) + ! + ! !DESCRIPTION: + ! Calculate light competition and update fpc for establishment routine + ! Called once per year + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_natvegp ! number of naturally-vegetated patches in filter + integer , intent(in) :: filter_natvegp(:) ! patch filter for naturally-vegetated points + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: fpc_tree_max = 0.95_r8 !maximum total tree FPC + integer :: p,fp, g ! indices + real(r8) :: fpc_tree_total(bounds%begg:bounds%endg) + real(r8) :: fpc_inc_tree(bounds%begg:bounds%endg) + real(r8) :: fpc_inc(bounds%begp:bounds%endp) ! foliar projective cover increment (fraction) + real(r8) :: fpc_grass_total(bounds%begg:bounds%endg) + real(r8) :: fpc_shrub_total(bounds%begg:bounds%endg) + real(r8) :: fpc_grass_max(bounds%begg:bounds%endg) + real(r8) :: fpc_shrub_max(bounds%begg:bounds%endg) + integer :: numtrees(bounds%begg:bounds%endg) + real(r8) :: excess + real(r8) :: nind_kill + real(r8) :: lai_ind + real(r8) :: fpc_ind + real(r8) :: fpcgrid_old + real(r8) :: lm_ind ! leaf carbon (gC/individual) + real(r8) :: stemdiam ! stem diameter + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + crownarea_max => dgv_ecophyscon%crownarea_max , & ! Input: [real(r8) (:) ] ecophys const - tree maximum crown a + reinickerp => dgv_ecophyscon%reinickerp , & ! Input: [real(r8) (:) ] ecophys const - parameter in allomet + allom1 => dgv_ecophyscon%allom1 , & ! Input: [real(r8) (:) ] ecophys const - parameter in allomet + + dwood => pftcon%dwood , & ! Input: wood density (gC/m3) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis (m2/gC) + dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis (m2/gC) + woody => pftcon%woody , & ! Input: woody patch or not + tree => pftcon%tree , & ! Input: tree patch or not + + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + + crownarea => dgvs_inst%crownarea_patch , & ! Output: [real(r8) (:) ] area that each individual tree takes up (m^2) + nind => dgvs_inst%nind_patch , & ! Output: [real(r8) (:) ] number of individuals + fpcgrid => dgvs_inst%fpcgrid_patch & ! Output: [real(r8) (:) ] foliar projective cover on gridcell (fraction) + ) + + taper = 200._r8 ! make a global constant; used in Establishment + ? + + ! Initialize gridcell-level metrics + + do g = bounds%begg, bounds%endg + fpc_tree_total(g) = 0._r8 + fpc_inc_tree(g) = 0._r8 + fpc_grass_total(g) = 0._r8 + fpc_shrub_total(g) = 0._r8 + numtrees(g) = 0 + end do + + do fp = 1,num_natvegp + p = filter_natvegp(fp) + g = patch%gridcell(p) + + ! Update LAI and FPC as in the last lines of DGVMAllocation + + if (woody(ivt(p))==1._r8) then + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + ! stemdiam derived here from cn's formula for htop found in + ! CNVegStructUpdate and cn's assumption stemdiam=2*htop/taper + ! this derivation neglects upper htop limit enforced elsewhere + stemdiam = (24._r8 * deadstemc(p) / (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) + else + stemdiam = 0._r8 + end if + crownarea(p) = min(crownarea_max(ivt(p)), allom1(ivt(p))*stemdiam**reinickerp(ivt(p))) ! Eqn D (from Establishment) + !else ! crownarea is 1 and does not need updating + end if + + if (crownarea(p) > 0._r8 .and. nind(p) > 0._r8) then + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + if (dsladlai(ivt(p)) > 0._r8) then + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) + end if + else + lai_ind = 0._r8 + end if + + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid_old = fpcgrid(p) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + fpc_inc(p) = max(0._r8, fpcgrid(p) - fpcgrid_old) + + if (woody(ivt(p)) == 1._r8) then + if (tree(ivt(p)) == 1) then + numtrees(g) = numtrees(g) + 1 + fpc_tree_total(g) = fpc_tree_total(g) + fpcgrid(p) + fpc_inc_tree(g) = fpc_inc_tree(g) + fpc_inc(p) + else ! if shrubs + fpc_shrub_total(g) = fpc_shrub_total(g) + fpcgrid(p) + end if + else ! if grass + fpc_grass_total(g) = fpc_grass_total(g) + fpcgrid(p) + end if + end do + + do g = bounds%begg, bounds%endg + fpc_grass_max(g) = 1._r8 - min(fpc_tree_total(g), fpc_tree_max) + fpc_shrub_max(g) = max(0._r8, fpc_grass_max(g) - fpc_grass_total(g)) + end do + + ! The gridcell level metrics are now in place; continue... + ! slevis replaced the previous code that updated pfpcgrid + ! with a simpler way of doing so: + ! fpcgrid(p) = fpcgrid(p) - excess + ! Later we may wish to update this subroutine + ! according to Strassmann's recommendations (see relevant pdf) + + do fp = 1,num_natvegp + p = filter_natvegp(fp) + g = patch%gridcell(p) + + ! light competition + + if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==1._r8) then + + if (fpc_tree_total(g) > fpc_tree_max) then + + if (fpc_inc_tree(g) > 0._r8) then + excess = (fpc_tree_total(g) - fpc_tree_max) * & + fpc_inc(p) / fpc_inc_tree(g) + else + excess = (fpc_tree_total(g) - fpc_tree_max) / & + real(numtrees(g)) + end if + + ! Reduce individual density (and thereby gridcell-level biomass) + ! so that total tree FPC reduced to 'fpc_tree_max' + + if (fpcgrid(p) > 0._r8) then + nind_kill = nind(p) * excess / fpcgrid(p) + nind(p) = max(0._r8, nind(p) - nind_kill) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + else + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + + ! Transfer lost biomass to litter + + end if ! if tree cover exceeds max allowed + else if (woody(ivt(p))==0._r8) then ! grass + + if (fpc_grass_total(g) > fpc_grass_max(g)) then + + ! grass competes with itself if total fpc exceeds 1 + + excess = (fpc_grass_total(g) - fpc_grass_max(g)) * fpcgrid(p) / fpc_grass_total(g) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + + end if + + else if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==0._r8) then ! shrub + + if (fpc_shrub_total(g) > fpc_shrub_max(g)) then + + excess = 1._r8 - fpc_shrub_max(g) / fpc_shrub_total(g) + + ! Reduce individual density (and thereby gridcell-level biomass) + ! so that total shrub FPC reduced to fpc_shrub_max(g) + + if (fpcgrid(p) > 0._r8) then + nind_kill = nind(p) * excess / fpcgrid(p) + nind(p) = max(0._r8, nind(p) - nind_kill) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + else + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + + end if + + end if ! end of if-tree + + end do + + end associate + + end subroutine Light + +end module CNDVLightMod diff --git a/components/clm/src/biogeochem/CNDVType.F90 b/components/clm/src/biogeochem/CNDVType.F90 new file mode 100644 index 0000000000..f8adfcacd3 --- /dev/null +++ b/components/clm/src/biogeochem/CNDVType.F90 @@ -0,0 +1,516 @@ +module CNDVType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing routines to drive the annual dynamic vegetation + ! that works with CN, reset related variables, + ! and initialize/reset time invariant variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varctl , only : use_cndv, iulog + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC DATA TYPES: + ! + ! DGVM-specific ecophysiological constants structure (patch-level) + type, public :: dgv_ecophyscon_type + real(r8), pointer :: crownarea_max(:) ! patch tree maximum crown area [m2] + real(r8), pointer :: tcmin(:) ! patch minimum coldest monthly mean temperature [units?] + real(r8), pointer :: tcmax(:) ! patch maximum coldest monthly mean temperature [units?] + real(r8), pointer :: gddmin(:) ! patch minimum growing degree days (at or above 5 C) + real(r8), pointer :: twmax(:) ! patch upper limit of temperature of the warmest month [units?] + real(r8), pointer :: reinickerp(:) ! patch parameter in allometric equation + real(r8), pointer :: allom1(:) ! patch parameter in allometric + real(r8), pointer :: allom2(:) ! patch parameter in allometric + real(r8), pointer :: allom3(:) ! patch parameter in allometric + end type dgv_ecophyscon_type + type(dgv_ecophyscon_type), public :: dgv_ecophyscon + ! + ! DGVM state variables structure + type, public :: dgvs_type + real(r8), pointer, public :: agdd_patch (:) ! patch accumulated growing degree days above 5 + real(r8), pointer, public :: agddtw_patch (:) ! patch accumulated growing degree days above twmax + real(r8), pointer, public :: agdd20_patch (:) ! patch 20-yr running mean of agdd + real(r8), pointer, public :: tmomin20_patch (:) ! patch 20-yr running mean of tmomin + logical , pointer, public :: present_patch (:) ! patch whether PATCH present in patch + logical , pointer, public :: pftmayexist_patch (:) ! patch if .false. then exclude seasonal decid patches from tropics + real(r8), pointer, public :: nind_patch (:) ! patch number of individuals (#/m**2) + real(r8), pointer, public :: lm_ind_patch (:) ! patch individual leaf mass + real(r8), pointer, public :: lai_ind_patch (:) ! patch LAI per individual + real(r8), pointer, public :: fpcinc_patch (:) ! patch foliar projective cover increment (fraction) + real(r8), pointer, public :: fpcgrid_patch (:) ! patch foliar projective cover on gridcell (fraction) + real(r8), pointer, public :: fpcgridold_patch (:) ! patch last yr's fpcgrid + real(r8), pointer, public :: crownarea_patch (:) ! patch area that each individual tree takes up (m^2) + real(r8), pointer, public :: greffic_patch (:) + real(r8), pointer, public :: heatstress_patch (:) + + contains + + procedure , public :: Init + procedure , public :: Restart + procedure , public :: InitAccBuffer + procedure , public :: InitAccVars + procedure , public :: UpdateAccVars + procedure , private :: InitAllocate + procedure , private :: InitCold + procedure , private :: InitHistory + end type dgvs_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + + ! Note - need allocation so that associate statements can be used + ! at run time for NAG (allocation of variables is needed) - history + ! should only be initialized if use_cndv is true + + call this%InitAllocate (bounds) + + if (use_cndv) then + call this%InitCold (bounds) + call this%InitHistory (bounds) + end if + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : numpft + use pftconMod , only : allom1s, allom2s, allom1, allom2, allom3, reinickerp + use pftconMod , only : ntree, nbrdlf_dcd_brl_shrub + use pftconMod , only : pftcon + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: m + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + allocate(this%agdd_patch (begp:endp)) ; this%agdd_patch (:) = nan + allocate(this%agddtw_patch (begp:endp)) ; this%agddtw_patch (:) = nan + allocate(this%agdd20_patch (begp:endp)) ; this%agdd20_patch (:) = nan + allocate(this%tmomin20_patch (begp:endp)) ; this%tmomin20_patch (:) = nan + allocate(this%present_patch (begp:endp)) ; this%present_patch (:) = .false. + allocate(this%pftmayexist_patch (begp:endp)) ; this%pftmayexist_patch (:) = .true. + allocate(this%nind_patch (begp:endp)) ; this%nind_patch (:) = nan + allocate(this%lm_ind_patch (begp:endp)) ; this%lm_ind_patch (:) = nan + allocate(this%lai_ind_patch (begp:endp)) ; this%lai_ind_patch (:) = nan + allocate(this%fpcinc_patch (begp:endp)) ; this%fpcinc_patch (:) = nan + allocate(this%fpcgrid_patch (begp:endp)) ; this%fpcgrid_patch (:) = nan + allocate(this%fpcgridold_patch (begp:endp)) ; this%fpcgridold_patch (:) = nan + allocate(this%crownarea_patch (begp:endp)) ; this%crownarea_patch (:) = nan + allocate(this%greffic_patch (begp:endp)) ; this%greffic_patch (:) = nan + allocate(this%heatstress_patch (begp:endp)) ; this%heatstress_patch (:) = nan + + allocate(dgv_ecophyscon%crownarea_max (0:numpft)) + allocate(dgv_ecophyscon%tcmin (0:numpft)) + allocate(dgv_ecophyscon%tcmax (0:numpft)) + allocate(dgv_ecophyscon%gddmin (0:numpft)) + allocate(dgv_ecophyscon%twmax (0:numpft)) + allocate(dgv_ecophyscon%reinickerp (0:numpft)) + allocate(dgv_ecophyscon%allom1 (0:numpft)) + allocate(dgv_ecophyscon%allom2 (0:numpft)) + allocate(dgv_ecophyscon%allom3 (0:numpft)) + + do m = 0,numpft + dgv_ecophyscon%crownarea_max(m) = pftcon%pftpar20(m) + dgv_ecophyscon%tcmin(m) = pftcon%pftpar28(m) + dgv_ecophyscon%tcmax(m) = pftcon%pftpar29(m) + dgv_ecophyscon%gddmin(m) = pftcon%pftpar30(m) + dgv_ecophyscon%twmax(m) = pftcon%pftpar31(m) + dgv_ecophyscon%reinickerp(m) = reinickerp + dgv_ecophyscon%allom1(m) = allom1 + dgv_ecophyscon%allom2(m) = allom2 + dgv_ecophyscon%allom3(m) = allom3 + ! modification for shrubs by X.D.Z + if (m > ntree .and. m <= nbrdlf_dcd_brl_shrub ) then + dgv_ecophyscon%allom1(m) = allom1s + dgv_ecophyscon%allom2(m) = allom2s + end if + end do + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%present_patch(p) = .false. + this%crownarea_patch(p) = 0._r8 + this%nind_patch(p) = 0._r8 + this%agdd20_patch(p) = 0._r8 + this%tmomin20_patch(p) = SHR_CONST_TKFRZ - 5._r8 !initialize this way for Phenology code + end do + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize history variables + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + call hist_addfld1d (fname='AGDD', units='K', & + avgflag='A', long_name='growing degree-days base 5C', & + ptr_patch=this%agdd_patch) + + end subroutine InitHistory + + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use clm_varcon , only : spval + use spmdMod , only : masterproc + use decompMod , only : get_proc_global + use restUtilMod + use ncdio_pio + use pio + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c,p ! indices + logical :: readvar ! determine if variable is on initial file + logical :: do_io ! whether to do i/o for the given variable + integer :: nump_global ! total number of patches, globally + integer :: dimlen ! dimension length + integer :: ier ! error status + integer :: itemp ! temporary + integer , pointer :: iptemp(:) ! pointer to memory to be allocated + integer :: err_code ! error code + !----------------------------------------------------------------------- + + ! Get expected total number of points, for later error checks + call get_proc_global(np=nump_global) + + call restartvar(ncid=ncid, flag=flag, varname='CROWNAREA', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%crownarea_patch) + + call restartvar(ncid=ncid, flag=flag, varname='nind', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nind_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fpcgrid', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fpcgrid_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fpcgridold', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fpcgridold_patch) + + ! tmomin20 + do_io = .true. + if (flag == 'read') then + ! On a read, confirm that this variable has the expected size; if not, don't + ! read it (instead leave it at its arbitrary initial value). This is needed to + ! support older initial conditions for which this variable had a different size. + call ncd_inqvdlen(ncid, 'TMOMIN20', 1, dimlen, err_code) + if (dimlen /= nump_global) then + do_io = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='TMOMIN20', xtype=ncd_double, & + dim1name='pft', & + long_name='',units='', & + interpinic_flag='interp', readvar=readvar, data=this%tmomin20_patch) + end if + + ! agdd20 + do_io = .true. + if (flag == 'read') then + ! On a read, confirm that this variable has the expected size; if not, don't + ! read it (instead leave it at its arbitrary initial value). This is needed to + ! support older initial conditions for which this variable had a different size. + call ncd_inqvdlen(ncid, 'AGDD20', 1, dimlen, err_code) + if (dimlen /= nump_global) then + do_io = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='AGDD20', xtype=ncd_double, & + dim1name='pft',& + long_name='',units='', & + interpinic_flag='interp', readvar=readvar, data=this%agdd20_patch) + end if + + ! present + if (flag == 'read' .or. flag == 'write') then + allocate (iptemp(bounds%begp:bounds%endp), stat=ier) + end if + if (flag == 'write') then + do p = bounds%begp,bounds%endp + iptemp(p) = 0 + if (this%present_patch(p)) iptemp(p) = 1 + end do + end if + call restartvar(ncid=ncid, flag=flag, varname='present', xtype=ncd_int, & + dim1name='pft',& + long_name='',units='', & + interpinic_flag='interp', readvar=readvar, data=iptemp) + if (flag=='read' .and. readvar) then + do p = bounds%begp,bounds%endp + this%present_patch(p) = .false. + if (iptemp(p) == 1) this%present_patch(p) = .true. + end do + end if + if (flag == 'read' .or. flag == 'write') then + deallocate (iptemp) + end if + + call restartvar(ncid=ncid, flag=flag, varname='heatstress', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%heatstress_patch) + + call restartvar(ncid=ncid, flag=flag, varname='greffic', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%greffic_patch) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! Each interval and accumulation type is unique to each field processed. + ! Routine [initAccBuffer] defines the fields to be processed + ! and the type of accumulation. + ! Routine [updateCNDVAccVars] does the actual accumulation for a given field. + ! Fields are accumulated by calls to subroutine [update_accum_field]. + ! To accumulate a field, it must first be defined in subroutine [initAccVars] + ! and then accumulated by calls to [updateCNDVAccVars]. + ! + ! This should only be called if use_cndv is true. + ! + ! !USES + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + + ! + ! !LOCAL VARIABLES: + integer, parameter :: not_used = huge(1) + + !--------------------------------------------------------------------- + + ! The following are accumulated fields. + ! These types of fields are accumulated until a trigger value resets + ! the accumulation to zero (see subroutine update_accum_field). + ! Hence, [accper] is not valid. + + call init_accum_field (name='AGDDTW', units='K', & + desc='growing degree-days base twmax', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='AGDD', units='K', & + desc='growing degree-days base 5C', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! This should only be called if use_cndv is true. + ! + ! !USES + use accumulMod , only : extract_accum_field + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(dgvs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: nstep + integer :: ier ! error status + real(r8), pointer :: rbufslp(:) ! temporary + + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)' in ' + call endrun(msg=" allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + nstep = get_nstep() + + call extract_accum_field ('AGDDTW', rbufslp, nstep) + this%agddtw_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('AGDD', rbufslp, nstep) + this%agdd_patch(begp:endp) = rbufslp(begp:endp) + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine UpdateAccVars(this, bounds, t_a10_patch, t_ref2m_patch) + ! + ! !DESCRIPTION: + ! Update accumulated variables. Should be called every time step. + ! + ! This should only be called if use_cndv is true. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + use clm_time_manager , only : get_step_size, get_nstep, get_curr_date + use pftconMod , only : ndllf_dcd_brl_tree + use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + ! + ! !ARGUMENTS: + class(dgvs_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! COMPILER_BUG(wjs, 2014-11-30, pgi 14.7) These arrays get resized to 0 when running + ! with threading with pgi 14.7 on yellowstone. My standard workarounds weren't + ! working; the only thing that I can find that works is to change them to pointers +! real(r8) , intent(in) :: t_a10_patch( bounds%begp:) ! 10-day running mean of the 2 m temperature (K) +! real(r8) , intent(in) :: t_ref2m_patch( bounds%begp:) ! 2 m height surface air temperature (K) + real(r8), pointer , intent(in) :: t_a10_patch(:) ! 10-day running mean of the 2 m temperature (K) + real(r8), pointer , intent(in) :: t_ref2m_patch(:) ! 2 m height surface air temperature (K) + ! + ! !LOCAL VARIABLES: + integer :: p ! index + integer :: ier ! error status + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: year ! year (0, ...) for nstep + integer :: month ! month (1, ..., 12) for nstep + integer :: day ! day of month (1, ..., 31) for nstep + integer :: secs ! seconds into current date for nstep + integer :: begp, endp + real(r8), pointer :: rbufslp(:) ! temporary single level - patch level + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(t_a10_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_ref2m_patch) == (/endp/)), errMsg(__FILE__, __LINE__)) + + dtime = get_step_size() + nstep = get_nstep() + call get_curr_date (year, month, day, secs) + + ! Allocate needed dynamic memory for single level patch field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate growing degree days based on 10-day running mean temperature. + ! The trigger to reset the accumulated values to zero is -99999. + + ! Accumulate and extract AGDDTW (gdd base twmax, which is 23 deg C + ! for boreal woody patches) + + do p = begp,endp + rbufslp(p) = max(0._r8, & + (t_a10_patch(p) - SHR_CONST_TKFRZ - dgv_ecophyscon%twmax(ndllf_dcd_brl_tree)) & + * dtime/SHR_CONST_CDAY) + if (month==1 .and. day==1 .and. secs==int(dtime)) rbufslp(p) = accumResetVal + end do + call update_accum_field ('AGDDTW', rbufslp, nstep) + call extract_accum_field ('AGDDTW', this%agddtw_patch, nstep) + + ! Accumulate and extract AGDD + + do p = begp,endp + rbufslp(p) = max(0.0_r8, & + (t_ref2m_patch(p) - (SHR_CONST_TKFRZ + 5.0_r8)) * dtime/SHR_CONST_CDAY) + ! + ! Fix (for bug 1858) from Sam Levis to reset the annual AGDD variable + ! + if (month==1 .and. day==1 .and. secs==int(dtime)) rbufslp(p) = accumResetVal + end do + call update_accum_field ('AGDD', rbufslp, nstep) + call extract_accum_field ('AGDD', this%agdd_patch, nstep) + + deallocate(rbufslp) + + end subroutine UpdateAccVars + +end module CNDVType diff --git a/components/clm/src/biogeochem/CNDriverMod.F90 b/components/clm/src/biogeochem/CNDriverMod.F90 new file mode 100644 index 0000000000..feeff20ef9 --- /dev/null +++ b/components/clm/src/biogeochem/CNDriverMod.F90 @@ -0,0 +1,877 @@ +module CNDriverMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Ecosystem dynamics: phenology, vegetation + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : use_c13, use_c14, use_ed + use dynSubgridControlMod , only : get_do_harvest + use decompMod , only : bounds_type + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : use_century_decomp, use_nitrif_denitrif + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use CNDVType , only : dgvs_type + use CanopyStateType , only : canopystate_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use WaterfluxType , only : waterflux_type + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use PhotosynthesisMod , only : photosyns_type + use ch4Mod , only : ch4_type + use EnergyFluxType , only : energyflux_type + use SoilHydrologyType , only : soilhydrology_type + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNDriverInit ! Ecosystem dynamics: initialization + public :: CNDriverNoLeaching ! Ecosystem dynamics: phenology, vegetation, before doing N leaching + public :: CNDriverLeaching ! Ecosystem dynamics: phenology, vegetation, doing N leaching + public :: CNDriverSummary ! Ecosystem dynamics: summary + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNDriverInit(bounds) + ! + ! !DESCRIPTION: + ! Initialzation of the CN Ecosystem dynamics. + ! + ! !USES: + use CNPhenologyMod , only : CNPhenologyInit + use CNFireMod , only : CNFireInit + use SoilBiogeochemCompetitionMod, only : SoilBiogeochemCompetitionInit + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + !----------------------------------------------------------------------- + + call SoilBiogeochemCompetitionInit(bounds) + call CNPhenologyInit(bounds) + call CNFireInit(bounds) + + end subroutine CNDriverInit + + !----------------------------------------------------------------------- + subroutine CNDriverNoLeaching(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & + cnveg_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + atm2lnd_inst, waterstate_inst, waterflux_inst, & + canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & + dgvs_inst, photosyns_inst, soilhydrology_inst, energyflux_inst, nutrient_competition_method) + ! + ! !DESCRIPTION: + ! The core CN code is executed here. Calculates fluxes for maintenance + ! respiration, decomposition, allocation, phenology, and growth respiration. + ! These routines happen on the radiation time step so that canopy structure + ! stays synchronized with albedo calculations. + ! + ! !USES: + use clm_varpar , only: crop_prog, nlevgrnd, nlevdecomp_full + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use subgridAveMod , only: p2c + use CropType , only: crop_type + use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix + use CNMRespMod , only: CNMResp + use CNPhenologyMod , only: CNPhenology + use CNGRespMod , only: CNGResp + use CNFireMod , only: CNFireArea, CNFireFluxes + use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + use CNC14DecayMod , only: C14Decay + use CNWoodProductsMod , only: CNWoodProducts + use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 + use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h + use CNCStateUpdate3Mod , only: CStateUpdate3 + use CNNStateUpdate1Mod , only: NStateUpdate1 + use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h + use CNGapMortalityMod , only: CNGapMortality + use dynHarvestMod , only: CNHarvest + use SoilBiogeochemDecompCascadeBGCMod , only: decomp_rate_constants_bgc + use SoilBiogeochemDecompCascadeCNMod , only: decomp_rate_constants_cn + use SoilBiogeochemCompetitionMod , only: SoilBiogeochemCompetition + use SoilBiogeochemDecompMod , only: SoilBiogeochemDecomp + use SoilBiogeochemLittVertTranspMod , only: SoilBiogeochemLittVertTransp + use SoilBiogeochemPotentialMod , only: SoilBiogeochemPotential + use SoilBiogeochemVerticalProfileMod , only: SoilBiogeochemVerticalProfile + use SoilBiogeochemNitrifDenitrifMod , only: SoilBiogeochemNitrifDenitrif + use SoilBiogeochemNStateUpdate1Mod , only: SoilBiogeochemNStateUpdate1 + use NutrientCompetitionMethodMod , only: nutrient_competition_method_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(crop_type) , intent(in) :: crop_inst + type(ch4_type) , intent(in) :: ch4_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(energyflux_type) , intent(in) :: energyflux_inst + class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method + ! + ! !LOCAL VARIABLES: + real(r8):: cn_decomp_pools(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_pools) + real(r8):: p_decomp_cpool_loss(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential C loss from one pool to another + real(r8):: pmnf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,1:ndecomp_cascade_transitions) !potential mineral N flux, from one pool to another + real(r8):: arepr(bounds%begp:bounds%endp) ! reproduction allocation coefficient (only used for crop_prog) + real(r8):: aroot(bounds%begp:bounds%endp) ! root allocation coefficient (only used for crop_prog) + integer :: begp,endp + integer :: begc,endc + + integer :: dummy_to_make_pgi_happy + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + !real(r8) , intent(in) :: rootfr_patch(bounds%begp:, 1:) + !integer , intent(in) :: altmax_lastyear_indx_col(bounds%begc:) ! frost table depth (m) + + associate( & + rootfr_patch => soilstate_inst%rootfr_patch , & ! fraction of roots in each soil layer (nlevgrnd) + altmax_lastyear_indx_col => canopystate_inst%altmax_lastyear_indx_col , & ! frost table depth (m) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch , & ! Output: [integer (:) ] frac of vegetation not covered by snow [-] + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch & ! Output: [real(r8) (:) ] canopy bottom (m) + ) + + ! -------------------------------------------------- + ! zero the column-level C and N fluxes + ! -------------------------------------------------- + + call t_startf('CNZero') + + call cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + + ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without this, the filter is full of garbage + ! in some situations + dummy_to_make_pgi_happy = ubound(filter_soilc, 1) + call soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + end if + + call cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + + call cnveg_nitrogenflux_inst%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + + call soilbiogeochem_nitrogenflux_inst%SetValues( & + num_soilc, filter_soilc, 0._r8) + + call t_stopf('CNZero') + + ! -------------------------------------------------- + ! Nitrogen Deposition, Fixation and Respiration + ! -------------------------------------------------- + + call t_startf('CNDeposition') + call CNNDeposition(bounds, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNDeposition') + + call t_startf('CNFixation') + call CNNFixation( num_soilc, filter_soilc, & + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNFixation') + + if (crop_prog) then + call CNNFert(bounds, num_soilc,filter_soilc, & + cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + + call CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterstate_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + end if + + call t_startf('CNMResp') + call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenstate_inst) + call t_stopf('CNMResp') + + !-------------------------------------------- + ! Soil Biogeochemistry + !-------------------------------------------- + + if (use_century_decomp) then + call decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + canopystate_inst, soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + else + call decomp_rate_constants_cn(bounds, num_soilc, filter_soilc, & + canopystate_inst, soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + end if + + ! calculate potential decomp rates and total immobilization demand (previously inlined in CNDecompAlloc) + call SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & + p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & + pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) + + ! calculate vertical profiles for distributing soil and litter C and N (previously subroutine decomp_vertprofiles called from CNDecompAlloc) + call SoilBiogeochemVerticalProfile(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_inst, soilstate_inst,soilbiogeochem_state_inst) + + ! calculate nitrification and denitrification rates (previously subroutine nitrif_denitrif called from CNDecompAlloc) + if (use_nitrif_denitrif) then + call SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + soilstate_inst, waterstate_inst, temperature_inst, ch4_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + end if + + !-------------------------------------------- + ! Resolve the competition between plants and soil heterotrophs + ! for available soil mineral N resource + !-------------------------------------------- + + call t_startf('CNDecompAlloc') + + ! Jinyun Tang: at this stage, the plant_nutrient_demand only calculates the plant ntirgeon demand. + ! Assume phosphorus dynamics will be included in the future. Also, I consider plant_nutrient_demand + ! as a generic interface to call actual nutrient calculation from different aboveground plantbgc. + ! Right now it is assumed the plant nutrient demand is summarized into columnwise demand, and the + ! nutrient redistribution after uptake is done by the plant bgc accordingly. + ! When nutrient competition is required to be done at cohort level both plant_nutrient_demand and + ! do_nutrient_competition should be modified, but that modification should not significantly change + ! the current interface. + + call nutrient_competition_method%calc_plant_nutrient_demand ( & + bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot=aroot(begp:endp), arepr=arepr(begp:endp)) + + ! get the column-averaged plant_ndemand (needed for following call to SoilBiogeochemCompetition) + + call p2c(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst%plant_ndemand_patch(begp:endp), & + soilbiogeochem_state_inst%plant_ndemand_col(begc:endc)) + + ! resolve plant/heterotroph competition for mineral N + + call SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + + ! distribute the available N between the competing patches on the basis of + ! relative demand, and allocate C and N to new growth and storage + + call nutrient_competition_method%calc_plant_nutrient_competition ( & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot=aroot(begp:endp), & + arepr=arepr(begp:endp), & + fpg_col=soilbiogeochem_state_inst%fpg_col(begc:endc)) + + call t_stopf('CNDecompAlloc') + + !-------------------------------------------- + ! Calculate litter and soil decomposition rate + !-------------------------------------------- + + ! Calculation of actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N (previously inlined in CNDecompAllocation in CNDecompMod) + + call t_startf('SoilBiogeochemDecomp') + + call SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools=cn_decomp_pools(begc:endc,1:nlevdecomp,1:ndecomp_pools), & + p_decomp_cpool_loss=p_decomp_cpool_loss(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions), & + pmnf_decomp_cascade=pmnf_decomp_cascade(begc:endc,1:nlevdecomp,1:ndecomp_cascade_transitions)) + + call t_stopf('SoilBiogeochemDecomp') + + !-------------------------------------------- + ! Phenology + !-------------------------------------------- + + ! CNphenology needs to be called after above calls, since it depends on current + ! time-step fluxes to new growth on the lastlitterfall timestep in deciduous systems + + call t_startf('CNPhenology') + + call CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterstate_inst, temperature_inst, crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full)) + + call t_stopf('CNPhenology') + + !-------------------------------------------- + ! Growth respiration + !-------------------------------------------- + + call t_startf('CNGResp') + + call CNGResp(num_soilp, filter_soilp,& + cnveg_carbonflux_inst, canopystate_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + + call t_stopf('CNGResp') + + !-------------------------------------------- + ! CNUpdate0 + !-------------------------------------------- + + call t_startf('CNUpdate0') + + call CStateUpdate0(num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst) + + if ( use_c13 ) then + call CStateUpdate0(num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst) + end if + + if ( use_c14 ) then + call CStateUpdate0(num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst) + end if + + call t_stopf('CNUpdate0') + + !-------------------------------------------- + ! Update1 + !-------------------------------------------- + + call t_startf('CNUpdate1') + + ! Set the carbon isotopic flux variables (except for gap-phase mortality and fire fluxes) + if ( use_c13 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + ! Update all prognostic carbon state variables (except for gap-phase mortality and fire fluxes) + call CStateUpdate1( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_carbonflux_inst) + if ( use_c13 ) then + call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst) + end if + if ( use_c14 ) then + call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst) + end if + + ! Update all prognostic nitrogen state variables (except for gap-phase mortality and fire fluxes) + call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + + call SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + + call t_stopf('CNUpdate1') + + !-------------------------------------------- + ! Calculate vertical mixing of soil and litter pools + !-------------------------------------------- + + call t_startf('SoilBiogeochemLittVertTransp') + + call SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + canopystate_inst, soilbiogeochem_state_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + + call t_stopf('SoilBiogeochemLittVertTransp') + + !-------------------------------------------- + ! Calculate the gap mortality carbon and nitrogen fluxes + !-------------------------------------------- + + call t_startf('CNGapMortality') + + call CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & + !cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full)) + + call t_stopf('CNGapMortality') + + !-------------------------------------------- + ! Update2 (gap mortality) + !-------------------------------------------- + + call t_startf('CNUpdate2') + + ! Set the carbon isotopic fluxes for gap mortality + if ( use_c13 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c13_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + iso_cnveg_carbonflux_inst=c14_cnveg_carbonflux_inst, & + iso_cnveg_carbonstate_inst=c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + ! Update all the prognostic carbon state variables affected by gap-phase mortality fluxes + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + if ( use_c13 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst) + end if + if ( use_c14 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) + end if + + ! Update all the prognostic nitrogen state variables affected by gap-phase mortality fluxes + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) + + !-------------------------------------------- + ! Update2h (harvest) + !-------------------------------------------- + + ! Set harvest mortality routine + if (get_do_harvest()) then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + end if + + if ( use_c13 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + isotope='c14') + end if + + call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + if ( use_c13 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst) + end if + if ( use_c14 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) + end if + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) + + !-------------------------------------------- + ! Calculate loss fluxes from wood products pools + ! and update product pool state variables + !-------------------------------------------- + + call CNWoodProducts(num_soilc, filter_soilc, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst) + + !-------------------------------------------- + ! Calculate fire area and fluxes + !-------------------------------------------- + + call CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + atm2lnd_inst, energyflux_inst, soilhydrology_inst, waterstate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, & + totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + t_soi17cm_col=temperature_inst%t_soi17cm_col(begc:endc)) + + call CNFireFluxes(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp, 1:nlevdecomp_full), & + froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp, 1:nlevdecomp_full), & + croot_prof_patch=soilbiogeochem_state_inst%croot_prof_patch(begp:endp, 1:nlevdecomp_full), & + stem_prof_patch=soilbiogeochem_state_inst%stem_prof_patch(begp:endp, 1:nlevdecomp_full), & + totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + decomp_cpools_vr_col=soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + decomp_npools_vr_col=soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + somc_fire_col=soilbiogeochem_carbonflux_inst%somc_fire_col(begc:endc)) + + call t_stopf('CNUpdate2') + + !-------------------------------------------- + ! Update3 + !-------------------------------------------- + + if ( use_c13 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c13_soilbiogeochem_carbonstate_inst, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst , soilbiogeochem_carbonstate_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, & + isotope='c14') + end if + + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, soilbiogeochem_carbonstate_inst) + + if ( use_c13 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst) + end if + + if ( use_c14 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) + + call C14Decay(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_cnveg_carbonstate_inst, c14_soilbiogeochem_carbonstate_inst) + end if + + end associate + + end subroutine CNDriverNoLeaching + + !----------------------------------------------------------------------- + subroutine CNDriverLeaching(bounds, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterstate_inst, waterflux_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Update the nitrogen leaching rate as a function of soluble mineral N and total soil water outflow. + ! Also update nitrogen state variables + ! + ! !USES: + use SoilBiogeochemNLeachingMod, only: SoilBiogeochemNLeaching + use CNNStateUpdate3Mod , only: NStateUpdate3 + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + !----------------------------------------------------------------------- + + ! Mineral nitrogen dynamics (deposition, fixation, leaching) + + call SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + waterstate_inst, waterflux_inst, soilbiogeochem_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst) + + ! Nitrogen state variable update, mortality fluxes. + + call t_startf('CNUpdate3') + + call NstateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + + call t_stopf('CNUpdate3') + + end subroutine CNDriverLeaching + + !----------------------------------------------------------------------- + subroutine CNDriverSummary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Call to all CN and SoilBiogeochem summary routines + ! + ! !USES: + use clm_varpar , only: ndecomp_cascade_transitions + use CNPrecisionControlMod , only: CNPrecisionControl + use SoilBiogeochemPrecisionControlMod , only: SoilBiogeochemPrecisionControl + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + ! Call to all summary routines + + call t_startf('CNsum') + + ! Set controls on very low values in critical state variables + + call CNPrecisionControl(num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + + call SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst,soilbiogeochem_nitrogenstate_inst) + + ! Note - all summary updates to cnveg_carbonstate_inst and cnveg_carbonflux_inst are done in + ! soilbiogeochem_carbonstate_inst%summary and CNVeg_carbonstate_inst%summary + + ! ---------------------------------------------- + ! soilbiogeochem carbon/nitrogen state summary + ! ---------------------------------------------- + + call soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonstate_inst%summary(bounds, num_soilc, filter_soilc) + end if + call soilbiogeochem_nitrogenstate_inst%summary(bounds, num_soilc, filter_soilc) + + ! ---------------------------------------------- + ! soilbiogeochem carbon/nitrogen flux summary + ! ---------------------------------------------- + + call soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + if ( use_c13 ) then + call c13_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + end if + if ( use_c14 ) then + call c14_soilbiogeochem_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc) + end if + call soilbiogeochem_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc) + + ! ---------------------------------------------- + ! cnveg carbon/nitrogen state summary + ! ---------------------------------------------- + + call cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + + if ( use_c13 ) then + call c13_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=c13_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=c13_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=c13_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=c13_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + end if + + if ( use_c14 ) then + call c14_cnveg_carbonstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col=c14_soilbiogeochem_carbonstate_inst%cwdc_col(begc:endc), & + soilbiogeochem_totlitc_col=c14_soilbiogeochem_carbonstate_inst%totlitc_col(begc:endc), & + soilbiogeochem_totsomc_col=c14_soilbiogeochem_carbonstate_inst%totsomc_col(begc:endc), & + soilbiogeochem_ctrunc_col=c14_soilbiogeochem_carbonstate_inst%ctrunc_col(begc:endc)) + end if + + call cnveg_nitrogenstate_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_nitrogenstate_inst) + + ! ---------------------------------------------- + ! cnveg carbon/nitrogen flux summary + ! ---------------------------------------------- + + call cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='bulk', & + soilbiogeochem_hr_col=soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions)) + + if ( use_c13 ) then + call c13_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c13', & + soilbiogeochem_hr_col=c13_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=c13_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c13_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions)) + end if + + if ( use_c14 ) then + call c14_cnveg_carbonflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope='c14', & + soilbiogeochem_hr_col=c14_soilbiogeochem_carbonflux_inst%hr_col(begc:endc), & + soilbiogeochem_lithr_col=c14_soilbiogeochem_carbonflux_inst%lithr_col(begc:endc), & + soilbiogeochem_decomp_cascade_ctransfer_col=& + c14_soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions)) + end if + + call cnveg_nitrogenflux_inst%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + + call t_stopf('CNsum') + + end subroutine CNDriverSummary + +end module CNDriverMod diff --git a/components/clm/src/biogeochem/CNFireMod.F90 b/components/clm/src/biogeochem/CNFireMod.F90 new file mode 100644 index 0000000000..f6cdacbd52 --- /dev/null +++ b/components/clm/src/biogeochem/CNFireMod.F90 @@ -0,0 +1,1553 @@ +module CNFireMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! module for fire dynamics + ! created in Nov, 2012 and revised in Apr, 2013 by F. Li and S. Levis + ! based on Li et al. (2012a,b; 2013) + ! revised in Apr, 2014 according Li et al.(2014) + ! Fire-related parameters were calibrated or tuned in Apr, 2013 based on the + ! 20th Century transient simulations at f19_g16 with (newfire05_clm45sci15_clm4_0_58) + ! a CLM4.5 version, Qian et al. (2006) atmospheric forcing, and + ! climatological lightning data. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_const_mod , only : SHR_CONST_PI,SHR_CONST_TKFRZ + use shr_infnan_mod , only : shr_infnan_isnan + use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create, shr_strdata_print + use shr_strdata_mod , only : shr_strdata_advance + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full + use clm_varcon , only : dzsoi_decomp + use pftconMod , only : noveg, pftcon + use spmdMod , only : masterproc, mpicom, comp_id + use fileutils , only : getavu, relavu + use controlMod , only : NLFilename + use decompMod , only : gsmap_lnd_gdc2glo + use domainMod , only : ldomain + use abortutils , only : endrun + use decompMod , only : bounds_type + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNDVType , only : dgvs_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use EnergyFluxType , only : energyflux_type + use SoilHydrologyType , only : soilhydrology_type + use WaterstateType , only : waterstate_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use mct_mod + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNFireInit ! Initialization of CNFire + public :: CNFireInterp ! Interpolate fire data + public :: CNFireArea ! Calculate fire area + public :: CNFireFluxes ! Calculate fire fluxes + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: hdm_init ! position datasets for dynamic human population density + private :: hdm_interp ! interpolates between two years of human pop. density file data + private :: lnfm_init ! position datasets for Lightning + private :: lnfm_interp ! interpolates between two years of Lightning file data + + ! !PRIVATE MEMBER DATA: + real(r8), pointer :: forc_lnfm(:) ! Lightning frequency + real(r8), pointer :: forc_hdm(:) ! Human population density + real(r8), parameter :: secsphr = 3600._r8 ! Seconds in an hour + real(r8), parameter :: borealat = 40._r8 ! Latitude for boreal peat fires + + type(shr_strdata_type) :: sdat_hdm ! Human population density input data stream + type(shr_strdata_type) :: sdat_lnfm ! Lightning input data stream + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNFireInit( bounds ) + ! + ! !DESCRIPTION: + ! Initialize CN Fire module + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + call hdm_init(bounds) + call hdm_interp(bounds) + call lnfm_init(bounds) + call lnfm_interp(bounds) + + end subroutine CNFireInit + + !----------------------------------------------------------------------- + subroutine CNFireInterp(bounds) + ! + ! !DESCRIPTION: + ! Interpolate CN Fire datasets + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + call hdm_interp(bounds) + call lnfm_interp(bounds) + + end subroutine CNFireInterp + + !----------------------------------------------------------------------- + subroutine CNFireArea (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + atm2lnd_inst, energyflux_inst, soilhydrology_inst, waterstate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, totlitc_col, decomp_cpools_vr_col, t_soi17cm_col) + ! + ! !DESCRIPTION: + ! Computes column-level burned area + ! + ! !USES: + use clm_time_manager , only: get_step_size, get_days_per_year, get_curr_date, get_nstep + use clm_varpar , only: max_patch_per_col + use clm_varcon , only: secspday + use clm_varctl , only: use_nofire + use pftconMod , only: nc4_grass, nc3crop, ndllf_evr_tmp_tree + use pftconMod , only: nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree, nbrdlf_evr_shrub + use dynSubgridControlMod , only : get_do_transient_pfts + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + real(r8) , intent(in) :: totlitc_col(bounds%begc:) + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) + real(r8) , intent(in) :: t_soi17cm_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: lfuel=75._r8 ! lower threshold of fuel mass (gC/m2) for ignition, Li et al.(2014) + real(r8), parameter :: ufuel=1050._r8 ! upper threshold of fuel mass(gC/m2) for ignition + real(r8), parameter :: g0=0.05_r8 ! g(W) when W=0 m/s + ! + ! a1 parameter for cropland fire in (Li et. al., 2014), but changed from + ! /timestep to /hr + real(r8), parameter :: cropfire_a1 = 0.3_r8 + ! + ! c parameter for peatland fire in Li et. al. (2013) + ! boreal peat fires (was different in paper),changed from /timestep to /hr + real(r8), parameter :: boreal_peatfire_c = 4.2e-5_r8 + ! + ! non-boreal peat fires (was different in paper) + real(r8), parameter :: non_boreal_peatfire_c = 0.001_r8 + ! + integer :: g,l,c,p,pi,j,fc,fp,kyr, kmo, kda, mcsec ! index variables + real(r8) :: dt ! time step variable (s) + real(r8) :: m ! top-layer soil moisture (proportion) + real(r8) :: dayspyr ! days per year + real(r8) :: cli ! effect of climate on deforestation fires (0-1) + real(r8), parameter ::cli_scale = 0.035_r8 !global constant for deforestation fires (/d) + real(r8) :: cri ! thresholds used for cli, (mm/d), see Eq.(7) in Li et al.(2013) + real(r8) :: fb ! availability of fuel for regs A and C + real(r8) :: fhd ! impact of hd on agricultural fire + real(r8) :: fgdp ! impact of gdp on agricultural fire + real(r8) :: fire_m ! combustability of fuel for fire occurrence + real(r8) :: spread_m ! combustability of fuel for fire spread + real(r8) :: Lb_lf ! length-to-breadth ratio added by Lifang + integer :: i_cwd ! cwd pool + real(r8) :: lh ! anthro. ignitions (count/km2/hr) + real(r8) :: fs ! hd-dependent fires suppression (0-1) + real(r8) :: ig ! total ignitions (count/km2/hr) + real(r8) :: hdmlf ! human density + real(r8) :: btran_col(bounds%begc:bounds%endc) + logical :: do_transient_pfts ! whether transient pfts are active in this run + real(r8), target :: prec60_col_target(bounds%begc:bounds%endc) + real(r8), target :: prec10_col_target(bounds%begc:bounds%endc) + real(r8), pointer :: prec60_col(:) + real(r8), pointer :: prec10_col(:) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(totlitc_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soi17cm_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + + associate( & + totlitc => totlitc_col , & ! Input: [real(r8) (:) ] (gC/m2) total lit C (column-level mean) + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + tsoi17 => t_soi17cm_col , & ! Input: [real(r8) (:) ] (K) soil T for top 0.17 m + + fsr_pft => pftcon%fsr_pft , & ! Input: + fd_pft => pftcon%fd_pft , & ! Input: + + btran2 => energyflux_inst%btran2_patch , & ! Input: [real(r8) (:) ] root zone soil wetness + fsat => soilhydrology_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + wf => waterstate_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m + wf2 => waterstate_inst%wf2_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + + forc_rh => atm2lnd_inst%forc_rh_grc , & ! Input: [real(r8) (:) ] relative humidity + forc_wind => atm2lnd_inst%forc_wind_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed (m/s) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] downscaled snow + prec60 => atm2lnd_inst%prec60_patch , & ! Input: [real(r8) (:) ] 60-day running mean of tot. precipitation + prec10 => atm2lnd_inst%prec10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of tot. precipitation + + lfpftd => cnveg_state_inst%lfpftd_patch , & ! Input: [real(r8) (:) ] decrease of patch weight (0-1) on the col. for dt + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + gdp_lf => cnveg_state_inst%gdp_lf_col , & ! Input: [real(r8) (:) ] gdp data + peatf_lf => cnveg_state_inst%peatf_lf_col , & ! Input: [real(r8) (:) ] peatland fraction data + abm_lf => cnveg_state_inst%abm_lf_col , & ! Input: [integer (:) ] prescribed crop fire time + baf_crop => cnveg_state_inst%baf_crop_col , & ! Output: [real(r8) (:) ] burned area fraction for cropland (/sec) + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Output: [real(r8) (:) ] burned area fraction for peatland (/sec) + burndate => cnveg_state_inst%burndate_patch , & ! Output: [integer (:) ] burn date for crop + fbac => cnveg_state_inst%fbac_col , & ! Output: [real(r8) (:) ] total burned area out of conversion (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Output: [real(r8) (:) ] burned area out of conversion region due to land use fire + farea_burned => cnveg_state_inst%farea_burned_col , & ! Output: [real(r8) (:) ] total fractional area burned (/sec) + nfire => cnveg_state_inst%nfire_col , & ! Output: [real(r8) (:) ] fire counts (count/km2/sec), valid only in Reg. C + fsr_col => cnveg_state_inst%fsr_col , & ! Output: [real(r8) (:) ] fire spread rate at column level + fd_col => cnveg_state_inst%fd_col , & ! Output: [real(r8) (:) ] fire duration rate at column level + lgdp_col => cnveg_state_inst%lgdp_col , & ! Output: [real(r8) (:) ] gdp limitation factor for nfire + lgdp1_col => cnveg_state_inst%lgdp1_col , & ! Output: [real(r8) (:) ] gdp limitation factor for baf per fire + lpop_col => cnveg_state_inst%lpop_col , & ! Output: [real(r8) (:) ] pop limitation factor for baf per fire + lfwt => cnveg_state_inst%lfwt_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop and non-bare-soil Patches + trotr1_col => cnveg_state_inst%trotr1_col , & ! Output: [real(r8) (:) ] patch weight of BET on the gridcell (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Output: [real(r8) (:) ] patch weight of BDT on the gridcell (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Output: [real(r8) (:) ] decreased frac. coverage of BET+BDT on grid for dt + lfc => cnveg_state_inst%lfc_col , & ! Output: [real(r8) (:) ] conversion area frac. of BET+BDT that haven't burned before + wtlf => cnveg_state_inst%wtlf_col , & ! Output: [real(r8) (:) ] fractional coverage of non-crop Patches + + totvegc => cnveg_carbonstate_inst%totvegc_patch , & ! Input: [real(r8) (:) ] (gC/m2) total vegetation carbon, excluding cpool + totvegc_col => cnveg_carbonstate_inst%totvegc_col , & ! Output: [real(r8) (:) ] totvegc at column level + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + rootc_col => cnveg_carbonstate_inst%rootc_col , & ! Output: [real(r8) (:) ] root carbon + leafc_col => cnveg_carbonstate_inst%leafc_col , & ! Output: [real(r8) (:) ] leaf carbon at column level + fuelc => cnveg_carbonstate_inst%fuelc_col , & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.C + fuelc_crop => cnveg_carbonstate_inst%fuelc_crop_col & ! Output: [real(r8) (:) ] fuel avalability factor for Reg.A + ) + + do_transient_pfts = get_do_transient_pfts() + + !pft to column average + prec10_col =>prec10_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec10(bounds%begp:bounds%endp), & + prec10_col(bounds%begc:bounds%endc)) + + prec60_col =>prec60_col_target + call p2c(bounds, num_soilc, filter_soilc, & + prec60(bounds%begp:bounds%endp), & + prec60_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + totvegc(bounds%begp:bounds%endp), & + totvegc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + leafc(bounds%begp:bounds%endp), & + leafc_col(bounds%begc:bounds%endc)) + + call get_curr_date (kyr, kmo, kda, mcsec) + dayspyr = get_days_per_year() + ! Get model step size + dt = real( get_step_size(), r8 ) + ! + ! On first time-step, just set area burned to zero and exit + ! + if ( get_nstep() == 0 )then + do fc = 1,num_soilc + c = filter_soilc(fc) + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + cropf_col(c) = 0._r8 + end do + return + end if + ! + ! Calculate fraction of crop (cropf_col) and non-crop and non-bare-soil + ! vegetation (lfwt) in vegetated column + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + cropf_col(c) = 0._r8 + lfwt(c) = 0._r8 + end do + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + ! For crop veg types + if( patch%itype(p) > nc4_grass )then + cropf_col(c) = cropf_col(c) + patch%wtcol(p) + end if + ! For natural vegetation (non-crop and non-bare-soil) + if( patch%itype(p) >= ndllf_evr_tmp_tree .and. patch%itype(p) <= nc4_grass )then + lfwt(c) = lfwt(c) + patch%wtcol(p) + end if + end if + end do + end do + ! + ! Calculate crop fuel + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fuelc_crop(c)=0._r8 + end do + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + ! For crop PFTs, fuel load includes leaf and litter; only + ! column-level litter carbon + ! is available, so we use leaf carbon to estimate the + ! litter carbon for crop PFTs + if( patch%itype(p) > nc4_grass .and. patch%wtcol(p) > 0._r8 .and. leafc_col(c) > 0._r8 )then + fuelc_crop(c)=fuelc_crop(c) + (leafc(p) + leafc_storage(p) + & + leafc_xfer(p))*patch%wtcol(p)/cropf_col(c) + & + totlitc(c)*leafc(p)/leafc_col(c)*patch%wtcol(p)/cropf_col(c) + end if + end if + end do + end do + ! + ! Calculate noncrop column variables + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + fsr_col(c) = 0._r8 + fd_col(c) = 0._r8 + rootc_col(c) = 0._r8 + lgdp_col(c) = 0._r8 + lgdp1_col(c) = 0._r8 + lpop_col(c) = 0._r8 + btran_col(c) = 0._r8 + wtlf(c) = 0._r8 + trotr1_col(c)= 0._r8 + trotr2_col(c)= 0._r8 + if (do_transient_pfts) then + dtrotr_col(c)=0._r8 + end if + end do + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + ! For non-crop -- natural vegetation and bare-soil + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8 )then + if( .not. shr_infnan_isnan(btran2(p))) then + if (btran2(p) <= 1._r8 ) then + btran_col(c) = btran_col(c)+btran2(p)*patch%wtcol(p) + wtlf(c) = wtlf(c)+patch%wtcol(p) + end if + end if + if( patch%itype(p) == nbrdlf_evr_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr1_col(c)=trotr1_col(c)+patch%wtcol(p)*col%wtgcell(c) + end if + if( patch%itype(p) == nbrdlf_dcd_trp_tree .and. patch%wtcol(p) > 0._r8 )then + trotr2_col(c)=trotr2_col(c)+patch%wtcol(p)*col%wtgcell(c) + end if + if (do_transient_pfts) then + if( patch%itype(p) == nbrdlf_evr_trp_tree .or. patch%itype(p) == nbrdlf_dcd_trp_tree )then + if(lfpftd(p) > 0._r8)then + dtrotr_col(c)=dtrotr_col(c)+lfpftd(p)*col%wtgcell(c) + end if + end if + end if + rootc_col(c) = rootc_col(c) + (frootc(p) + frootc_storage(p) + & + frootc_xfer(p) + deadcrootc(p) + & + deadcrootc_storage(p) + deadcrootc_xfer(p) + & + livecrootc(p)+livecrootc_storage(p) + & + livecrootc_xfer(p))*patch%wtcol(p) + + fsr_col(c) = fsr_col(c) + fsr_pft(patch%itype(p))*patch%wtcol(p)/(1.0_r8-cropf_col(c)) + + if( lfwt(c) /= 0.0_r8 )then + hdmlf=forc_hdm(g) + + ! all these constants are in Li et al. BG (2012a,b;2013) + + if( hdmlf > 0.1_r8 )then + ! For NOT bare-soil + if( patch%itype(p) /= noveg )then + ! For shrub and grass (crop already excluded above) + if( patch%itype(p) >= nbrdlf_evr_shrub )then !for shurb and grass + lgdp_col(c) = lgdp_col(c) + (0.1_r8 + 0.9_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/8._r8)**0.5_r8))*patch%wtcol(p) & + /(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (gdp_lf(c)/7._r8)))*patch%wtcol(p)/lfwt(c) + lpop_col(c) = lpop_col(c) + (0.2_r8 + 0.8_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/450._r8)**0.5_r8))*patch%wtcol(p)/lfwt(c) + else ! for trees + if( gdp_lf(c) > 20._r8 )then + lgdp_col(c) =lgdp_col(c)+0.39_r8*patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + end if + if( gdp_lf(c) > 20._r8 )then + lgdp1_col(c) = lgdp1_col(c)+0.62_r8*patch%wtcol(p)/lfwt(c) + else + if( gdp_lf(c) > 8._r8 ) then + lgdp1_col(c)=lgdp1_col(c)+0.83_r8*patch%wtcol(p)/lfwt(c) + else + lgdp1_col(c)=lgdp1_col(c)+patch%wtcol(p)/lfwt(c) + end if + end if + lpop_col(c) = lpop_col(c) + (0.4_r8 + 0.6_r8* & + exp(-1._r8*SHR_CONST_PI* & + (hdmlf/125._r8)))*patch%wtcol(p)/lfwt(c) + end if + end if + else + lgdp_col(c) = lgdp_col(c)+patch%wtcol(p)/(1.0_r8 - cropf_col(c)) + lgdp1_col(c) = lgdp1_col(c)+patch%wtcol(p)/lfwt(c) + lpop_col(c) = lpop_col(c)+patch%wtcol(p)/lfwt(c) + end if + end if + + fd_col(c) = fd_col(c) + fd_pft(patch%itype(p)) * patch%wtcol(p) * secsphr / (1.0_r8-cropf_col(c)) + end if + end if + end do + end do + + ! estimate annual decreased fractional coverage of BET+BDT + ! land cover conversion in CLM4.5 is the same for each timestep except for the beginning + + if (do_transient_pfts) then + do fc = 1,num_soilc + c = filter_soilc(fc) + if( dtrotr_col(c) > 0._r8 )then + if( kmo == 1 .and. kda == 1 .and. mcsec == 0)then + lfc(c) = 0._r8 + end if + if( kmo == 1 .and. kda == 1 .and. mcsec == dt)then + lfc(c) = dtrotr_col(c)*dayspyr*secspday/dt + end if + else + lfc(c)=0._r8 + end if + end do + end if + ! + ! calculate burned area fraction in cropland + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + baf_crop(c)=0._r8 + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + if( kmo == 1 .and. kda == 1 .and. mcsec == 0 )then + burndate(p) = 10000 ! init. value; actual range [0 365] + end if + end do + + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + g= col%gridcell(c) + hdmlf=forc_hdm(g) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + ! For crop + if( forc_t(c) >= SHR_CONST_TKFRZ .and. patch%itype(p) > nc4_grass .and. & + kmo == abm_lf(c) .and. forc_rain(c)+forc_snow(c) == 0._r8 .and. & + burndate(p) >= 999 .and. patch%wtcol(p) > 0._r8 )then ! catch crop burn time + + ! calculate human density impact on ag. fire + fhd = 0.04_r8+0.96_r8*exp(-1._r8*SHR_CONST_PI*(hdmlf/350._r8)**0.5_r8) + + ! calculate impact of GDP on ag. fire + fgdp = 0.01_r8+0.99_r8*exp(-1._r8*SHR_CONST_PI*(gdp_lf(c)/10._r8)) + + ! calculate burned area + fb = max(0.0_r8,min(1.0_r8,(fuelc_crop(c)-lfuel)/(ufuel-lfuel))) + + ! crop fire only for generic crop types at this time + ! managed crops are treated as grasses if crop model is turned on + baf_crop(c) = baf_crop(c) + cropfire_a1/secsphr*fb*fhd*fgdp*patch%wtcol(p) + if( fb*fhd*fgdp*patch%wtcol(p) > 0._r8)then + burndate(p)=kda + end if + end if + end if + end do + end do + ! + ! calculate peatland fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g= col%gridcell(c) + if(grc%latdeg(g) < borealat )then + baf_peatf(c) = non_boreal_peatfire_c/secsphr*max(0._r8, & + min(1._r8,(4.0_r8-prec60_col(c)*secspday)/ & + 4.0_r8))**2*peatf_lf(c)*(1._r8-fsat(c)) + else + baf_peatf(c) = boreal_peatfire_c/secsphr*exp(-SHR_CONST_PI*(max(wf2(c),0._r8)/0.3_r8))* & + max(0._r8,min(1._r8,(tsoi17(c)-SHR_CONST_TKFRZ)/10._r8))*peatf_lf(c)* & + (1._r8-fsat(c)) + end if + end do + ! + ! calculate other fires + ! + + ! Set the number of timesteps for e-folding. + ! When the simulation has run fewer than this number of steps, + ! re-scale the e-folding time to get a stable early estimate. + + ! find which pool is the cwd pool + i_cwd = 0 + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + i_cwd = l + endif + end do + + ! + ! begin column loop to calculate fractional area affected by fire + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + hdmlf=forc_hdm(g) + if( cropf_col(c) < 1.0 )then + if (trotr1_col(c)+trotr2_col(c)>0.6_r8) then + farea_burned(c)=min(1.0_r8,baf_crop(c)+baf_peatf(c)) + else + fuelc(c) = totlitc(c)+totvegc_col(c)-rootc_col(c)-fuelc_crop(c)*cropf_col(c) + do j = 1, nlevdecomp + fuelc(c) = fuelc(c)+decomp_cpools_vr(c,j,i_cwd) * dzsoi_decomp(j) + end do + fuelc(c) = fuelc(c)/(1._r8-cropf_col(c)) + fb = max(0.0_r8,min(1.0_r8,(fuelc(c)-lfuel)/(ufuel-lfuel))) + m = max(0._r8,wf(c)) + fire_m = exp(-SHR_CONST_PI *(m/0.69_r8)**2)*(1.0_r8 - max(0._r8, & + min(1._r8,(forc_rh(g)-30._r8)/(80._r8-30._r8))))* & + min(1._r8,exp(SHR_CONST_PI*(forc_t(c)-SHR_CONST_TKFRZ)/10._r8)) + lh = 0.0035_r8*6.8_r8*hdmlf**(0.43_r8)/30._r8/24._r8 + fs = 1._r8-(0.01_r8+0.98_r8*exp(-0.025_r8*hdmlf)) + ig = (lh+forc_lnfm(g)/(5.16_r8+2.16_r8*cos(3._r8*grc%lat(g)))*0.25_r8)*(1._r8-fs)*(1._r8-cropf_col(c)) + nfire(c) = ig/secsphr*fb*fire_m*lgdp_col(c) !fire counts/km2/sec + Lb_lf = 1._r8+10.0_r8*(1._r8-EXP(-0.06_r8*forc_wind(g))) + if ( wtlf(c) > 0.0_r8 )then + spread_m = (1.0_r8 - max(0._r8,min(1._r8,(btran_col(c)/wtlf(c)-0.3_r8)/ & + (0.7_r8-0.3_r8))))*(1.0_r8-max(0._r8, & + min(1._r8,(forc_rh(g)-30._r8)/(80._r8-30._r8)))) + else + spread_m = 0.0_r8 + end if + farea_burned(c) = min(1._r8,(g0*spread_m*fsr_col(c)* & + fd_col(c)/1000._r8)**2*lgdp1_col(c)* & + lpop_col(c)*nfire(c)*SHR_CONST_PI*Lb_lf+ & + baf_crop(c)+baf_peatf(c)) ! fraction (0-1) per sec + end if + ! + ! if landuse change data is used, calculate deforestation fires and + ! add it in the total of burned area fraction + ! + if (do_transient_pfts) then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 )then + if(( kmo == 1 .and. kda == 1 .and. mcsec == 0) .or. & + dtrotr_col(c) <=0._r8 )then + fbac1(c) = 0._r8 + farea_burned(c) = baf_crop(c)+baf_peatf(c) + else + cri = (4.0_r8*trotr1_col(c)+1.8_r8*trotr2_col(c))/(trotr1_col(c)+trotr2_col(c)) + cli = (max(0._r8,min(1._r8,(cri-prec60_col(c)*secspday)/cri))**0.5)* & + (max(0._r8,min(1._r8,(cri-prec10_col(c)*secspday)/cri))**0.5)* & + max(0.0005_r8,min(1._r8,19._r8*dtrotr_col(c)*dayspyr*secspday/dt-0.001_r8))* & + max(0._r8,min(1._r8,(0.25_r8-(forc_rain(c)+forc_snow(c))*secsphr)/0.25_r8)) + farea_burned(c) = cli*(cli_scale/secspday)+baf_crop(c)+baf_peatf(c) + ! burned area out of conversion region due to land use fire + fbac1(c) = max(0._r8,cli*(cli_scale/secspday) - 2.0_r8*lfc(c)/dt) + end if + ! total burned area out of conversion + fbac(c) = fbac1(c)+baf_crop(c)+baf_peatf(c) + else + fbac(c) = farea_burned(c) + end if + end if + + else + farea_burned(c) = min(1._r8,baf_crop(c)+baf_peatf(c)) + end if + + if (use_nofire) then + ! zero out the fire area if NOFIRE flag is on + + farea_burned(c) = 0._r8 + baf_crop(c) = 0._r8 + baf_peatf(c) = 0._r8 + fbac(c) = 0._r8 + fbac1(c) = 0._r8 + ! with NOFIRE, tree carbon is still removed in landuse change regions by the + ! landuse code + end if + + end do ! end of column loop + + end associate + + end subroutine CNFireArea + + !----------------------------------------------------------------------- + subroutine CNFireFluxes (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch, & + totsomc_col, decomp_cpools_vr_col, decomp_npools_vr_col, somc_fire_col) + ! + ! !DESCRIPTION: + ! Fire effects routine for coupled carbon-nitrogen code (CN). + ! Relies primarily on estimate of fractional area burned, from CNFireArea(). + ! + ! Total fire carbon emissions (g C/m2 land area/yr) + ! =avg(COL_FIRE_CLOSS)*seconds_per_year + avg(SOMC_FIRE)*seconds_per_year + + ! avg(LF_CONV_CFLUX)*seconds_per_year*min(1.0,avg(LFC2)*seconds_per_year)*0.8 + ! where avg means the temporal average in a year + ! seconds_per_year is the number of seconds in a year. + ! + ! !USES: + use clm_time_manager , only: get_step_size,get_days_per_year,get_curr_date + use clm_varpar , only: max_patch_per_col + use clm_varctl , only: use_cndv + use clm_varcon , only: secspday + use pftconMod , only: nc3crop + use dynSubgridControlMod , only: get_do_transient_pfts + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: totsomc_col(bounds%begc:) ! (gC/m2) total soil organic matter C + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(in) :: decomp_npools_vr_col(bounds%begc:,1:,1:) ! (gC/m3) VR decomp. (litter, cwd, soil) + real(r8) , intent(out) :: somc_fire_col(bounds%begc:) ! (gC/m2/s) fire C emissions due to peat burning + ! + ! !LOCAL VARIABLES: + integer :: g,c,p,j,l,pi,kyr, kmo, kda, mcsec ! indices + integer :: fp,fc ! filter indices + real(r8):: f ! rate for fire effects (1/s) + real(r8):: dt ! time step variable (s) + real(r8):: dayspyr ! days per year + logical :: do_transient_pfts ! whether transient pfts are active in this run + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(totsomc_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_npools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(somc_fire_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + + ! NOTE: VR = Vertically Resolved + ! conv. = conversion + ! frac. = fraction + ! BAF = Burned Area Fraction + ! ann. = annual + ! GC = gridcell + ! dt = timestep + ! C = Carbon + ! N = Nitrogen + ! emis. = emissions + ! decomp. = decomposing + + associate( & + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + totsomc => totsomc_col , & ! Input: [real(r8) (:) ] (gC/m2) total soil organic matter C + decomp_cpools_vr => decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + decomp_npools_vr => decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) VR decomp. (litter, cwd, soil) + somc_fire => somc_fire_col , & ! Output: [real(r8) (:) ] (gC/m2/s) fire C emissions due to peat burning + + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + is_litter => decomp_cascade_con%is_litter , & ! Input: [logical (:) ] TRUE => pool is a litter pool + + woody => pftcon%woody , & ! Input: woody lifeform (1=woody, 0=not woody) + cc_leaf => pftcon%cc_leaf , & ! Input: + cc_lstem => pftcon%cc_lstem , & ! Input: + cc_dstem => pftcon%cc_dstem , & ! Input: + cc_other => pftcon%cc_other , & ! Input: + fm_leaf => pftcon%fm_leaf , & ! Input: + fm_lstem => pftcon%fm_lstem , & ! Input: + fm_other => pftcon%fm_other , & ! Input: + fm_root => pftcon%fm_root , & ! Input: + fm_lroot => pftcon%fm_lroot , & ! Input: + fm_droot => pftcon%fm_droot , & ! Input: + lf_flab => pftcon%lf_flab , & ! Input: + lf_fcel => pftcon%lf_fcel , & ! Input: + lf_flig => pftcon%lf_flig , & ! Input: + fr_flab => pftcon%fr_flab , & ! Input: + fr_fcel => pftcon%fr_fcel , & ! Input: + fr_flig => pftcon%fr_flig , & ! Input: + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m2) + + cropf_col => cnveg_state_inst%cropf_col , & ! Input: [real(r8) (:) ] cropland fraction in veg column + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] fractional area burned (/sec) + fbac1 => cnveg_state_inst%fbac1_col , & ! Input: [real(r8) (:) ] burned area out of conv. region due to LU fire + fbac => cnveg_state_inst%fbac_col , & ! Input: [real(r8) (:) ] total burned area out of conversion (/sec) + baf_crop => cnveg_state_inst%baf_crop_col , & ! Input: [real(r8) (:) ] BAF for cropland + baf_peatf => cnveg_state_inst%baf_peatf_col , & ! Input: [real(r8) (:) ] BAF for peatlabd + trotr1_col => cnveg_state_inst%trotr1_col , & ! Input: [real(r8) (:) ] patch weight of BET on the gridcell (0-1) + trotr2_col => cnveg_state_inst%trotr2_col , & ! Input: [real(r8) (:) ] patch weight of BDT on the gridcell (0-1) + dtrotr_col => cnveg_state_inst%dtrotr_col , & ! Input: [real(r8) (:) ] ann. decreased frac. coverage of BET+BDT (0-1) on GC + lfc => cnveg_state_inst%lfc_col , & ! Input: [real(r8) (:) ] conv. area frac. of BET+BDT that haven't burned before + lfc2 => cnveg_state_inst%lfc2_col , & ! Output: [real(r8) (:) ] conv. area frac. of BET+BDT burned this dt (/sec) + + leafcmax => cnveg_carbonstate_inst%leafcmax_patch , & ! Output: [real(r8) (:) ] (gC/m2) ann max leaf C + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration transfer + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + fire_mortality_c_to_cwdc => cnveg_carbonflux_inst%fire_mortality_c_to_cwdc_col , & ! Input: [real(r8) (:,:) ] C flux fire mortality to CWD (gC/m3/s) + m_leafc_to_fire => cnveg_carbonflux_inst%m_leafc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc + m_leafc_storage_to_fire => cnveg_carbonflux_inst%m_leafc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_storage + m_leafc_xfer_to_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from leafc_xfer + m_livestemc_to_fire => cnveg_carbonflux_inst%m_livestemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) fire C emis. from livestemc + m_livestemc_storage_to_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_storage + m_livestemc_xfer_to_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livestemc_xfer + m_deadstemc_to_fire => cnveg_carbonflux_inst%m_deadstemc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_deadstemc_storage_to_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_storage + m_deadstemc_xfer_to_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadstemc_xfer + m_frootc_to_fire => cnveg_carbonflux_inst%m_frootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc + m_frootc_storage_to_fire => cnveg_carbonflux_inst%m_frootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_storage + m_frootc_xfer_to_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. frootc_xfer + m_livecrootc_to_fire => cnveg_carbonflux_inst%m_livecrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc + m_livecrootc_storage_to_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_storage + m_livecrootc_xfer_to_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. livecrootc_xfer + m_deadcrootc_to_fire => cnveg_carbonflux_inst%m_deadcrootc_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc + m_deadcrootc_storage_to_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_storage + m_deadcrootc_xfer_to_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. deadcrootc_xfer + m_gresp_storage_to_fire => cnveg_carbonflux_inst%m_gresp_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_storage + m_gresp_xfer_to_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) C emis. gresp_xfer + m_leafc_to_litter_fire => cnveg_carbonflux_inst%m_leafc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_storage_to_litter_fire => cnveg_carbonflux_inst%m_leafc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemc_to_deadstemc_fire => cnveg_carbonflux_inst%m_livestemc_to_deadstemc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_to_litter_fire => cnveg_carbonflux_inst%m_frootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_frootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootc_to_deadcrootc_fire => cnveg_carbonflux_inst%m_livecrootc_to_deadcrootc_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_storage_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter_fire => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_storage_to_litter_fire => cnveg_carbonflux_inst%m_gresp_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_gresp_xfer_to_litter_fire => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_cpools_to_fire_vr => cnveg_carbonflux_inst%m_decomp_cpools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] (gC/m3/s) VR decomp. C fire loss + m_c_to_litr_met_fire => cnveg_carbonflux_inst%m_c_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_cel_fire => cnveg_carbonflux_inst%m_c_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_c_to_litr_lig_fire => cnveg_carbonflux_inst%m_c_to_litr_lig_fire_col , & ! Output: [real(r8) (:,:) ] + + fire_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%fire_mortality_n_to_cwdn_col , & ! Input: [real(r8) (:,:) ] N flux fire mortality to CWD (gN/m3/s) + m_leafn_to_fire => cnveg_nitrogenflux_inst%m_leafn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn + m_leafn_storage_to_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_storage + m_leafn_xfer_to_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. leafn_xfer + m_livestemn_to_fire => cnveg_nitrogenflux_inst%m_livestemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn + m_livestemn_storage_to_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_s + m_livestemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livestemn_xfer + m_deadstemn_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn + m_deadstemn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_storage + m_deadstemn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadstemn_xfer + m_frootn_to_fire => cnveg_nitrogenflux_inst%m_frootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn + m_frootn_storage_to_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_storage + m_frootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. frootn_xfer + m_livecrootn_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. m_livecrootn_to_fire + m_livecrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_storage + m_livecrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. livecrootn_xfer + m_deadcrootn_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn + m_deadcrootn_storage_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_storage + m_deadcrootn_xfer_to_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. deadcrootn_xfer + m_retransn_to_fire => cnveg_nitrogenflux_inst%m_retransn_to_fire_patch , & ! Input: [real(r8) (:) ] (gN/m2/s) N emis. retransn + m_leafn_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_leafn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livestemn_to_deadstemn_fire => cnveg_nitrogenflux_inst%m_livestemn_to_deadstemn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadstemn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_frootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_livecrootn_to_deadcrootn_fire => cnveg_nitrogenflux_inst%m_livecrootn_to_deadcrootn_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_storage_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter_fire => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_retransn_to_litter_fire => cnveg_nitrogenflux_inst%m_retransn_to_litter_fire_patch , & ! Output: [real(r8) (:) ] + m_decomp_npools_to_fire_vr => cnveg_nitrogenflux_inst%m_decomp_npools_to_fire_vr_col , & ! Output: [real(r8) (:,:,:) ] VR decomp. N fire loss (gN/m3/s) + m_n_to_litr_met_fire => cnveg_nitrogenflux_inst%m_n_to_litr_met_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_cel_fire => cnveg_nitrogenflux_inst%m_n_to_litr_cel_fire_col , & ! Output: [real(r8) (:,:) ] + m_n_to_litr_lig_fire => cnveg_nitrogenflux_inst%m_n_to_litr_lig_fire_col & ! Output: [real(r8) (:,:) ] + ) + + do_transient_pfts = get_do_transient_pfts() + + ! Get model step size + ! calculate burned area fraction per sec + dt = real( get_step_size(), r8 ) + + dayspyr = get_days_per_year() + ! + ! patch loop + ! + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if( patch%itype(p) < nc3crop .and. cropf_col(c) < 1.0_r8)then + ! For non-crop (bare-soil and natural vegetation) + if (do_transient_pfts) then + f = (fbac(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + else + f = (farea_burned(c)-baf_crop(c))/(1.0_r8-cropf_col(c)) + end if + else + ! For crops + if(cropf_col(c) > 0._r8)then + f = baf_crop(c) /cropf_col(c) + else + f = 0._r8 + end if + end if + + ! apply this rate to the patch state variables to get flux rates + ! biomass burning + ! carbon fluxes + m_leafc_to_fire(p) = leafc(p) * f * cc_leaf(patch%itype(p)) + m_leafc_storage_to_fire(p) = leafc_storage(p) * f * cc_other(patch%itype(p)) + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemc_to_fire(p) = livestemc(p) * f * cc_lstem(patch%itype(p)) + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f * cc_other(patch%itype(p)) + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemc_to_fire(p) = deadstemc(p) * f * cc_dstem(patch%itype(p)) + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f * cc_other(patch%itype(p)) + m_frootc_to_fire(p) = frootc(p) * f * 0._r8 + m_frootc_storage_to_fire(p) = frootc_storage(p) * f * cc_other(patch%itype(p)) + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootc_to_fire(p) = livecrootc(p) * f * 0._r8 + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootc_to_fire(p) = deadcrootc(p) * f * 0._r8 + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f* cc_other(patch%itype(p)) + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f * cc_other(patch%itype(p)) + m_gresp_storage_to_fire(p) = gresp_storage(p) * f * cc_other(patch%itype(p)) + m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f * cc_other(patch%itype(p)) + + + ! nitrogen fluxes + m_leafn_to_fire(p) = leafn(p) * f * cc_leaf(patch%itype(p)) + m_leafn_storage_to_fire(p) = leafn_storage(p) * f * cc_other(patch%itype(p)) + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f * cc_other(patch%itype(p)) + m_livestemn_to_fire(p) = livestemn(p) * f * cc_lstem(patch%itype(p)) + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f * cc_other(patch%itype(p)) + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadstemn_to_fire(p) = deadstemn(p) * f * cc_dstem(patch%itype(p)) + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f * cc_other(patch%itype(p)) + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f * cc_other(patch%itype(p)) + m_frootn_to_fire(p) = frootn(p) * f * 0._r8 + m_frootn_storage_to_fire(p) = frootn_storage(p) * f * cc_other(patch%itype(p)) + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f * cc_other(patch%itype(p)) + m_livecrootn_to_fire(p) = livecrootn(p) * f * 0._r8 + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f * cc_other(patch%itype(p)) + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_to_fire(p) = deadcrootn(p) * f * 0._r8 + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f * cc_other(patch%itype(p)) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f * cc_other(patch%itype(p)) + m_retransn_to_fire(p) = retransn(p) * f * cc_other(patch%itype(p)) + + ! mortality due to fire + ! carbon pools + m_leafc_to_litter_fire(p) = leafc(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafc_storage_to_litter_fire(p) = leafc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafc_xfer_to_litter_fire(p) = leafc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_to_litter_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemc_storage_to_litter_fire(p) = livestemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_xfer_to_litter_fire(p) = livestemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemc_to_deadstemc_fire(p) = livestemc(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadstemc_to_litter_fire(p) = deadstemc(p) * f * & + (1._r8 - cc_dstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_deadstemc_storage_to_litter_fire(p) = deadstemc_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_deadstemc_xfer_to_litter_fire(p) = deadstemc_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_frootc_to_litter_fire(p) = frootc(p) * f * & + fm_root(patch%itype(p)) + m_frootc_storage_to_litter_fire(p) = frootc_storage(p) * f * & + fm_other(patch%itype(p)) + m_frootc_xfer_to_litter_fire(p) = frootc_xfer(p) * f * & + fm_other(patch%itype(p)) + m_livecrootc_to_litter_fire(p) = livecrootc(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootc_storage_to_litter_fire(p) = livecrootc_storage(p) * f * & + fm_other(patch%itype(p)) + m_livecrootc_xfer_to_litter_fire(p) = livecrootc_xfer(p) * f * & + fm_other(patch%itype(p)) + m_livecrootc_to_deadcrootc_fire(p) = livecrootc(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f * & + fm_droot(patch%itype(p)) + m_deadcrootc_storage_to_litter_fire(p) = deadcrootc_storage(p) * f * & + fm_other(patch%itype(p)) + m_deadcrootc_xfer_to_litter_fire(p) = deadcrootc_xfer(p) * f * & + fm_other(patch%itype(p)) + m_gresp_storage_to_litter_fire(p) = gresp_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_gresp_xfer_to_litter_fire(p) = gresp_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + + ! nitrogen pools + m_leafn_to_litter_fire(p) = leafn(p) * f * & + (1._r8 - cc_leaf(patch%itype(p))) * & + fm_leaf(patch%itype(p)) + m_leafn_storage_to_litter_fire(p) = leafn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_leafn_xfer_to_litter_fire(p) = leafn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_to_litter_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + fm_droot(patch%itype(p)) + m_livestemn_storage_to_litter_fire(p) = livestemn_storage(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_xfer_to_litter_fire(p) = livestemn_xfer(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + m_livestemn_to_deadstemn_fire(p) = livestemn(p) * f * & + (1._r8 - cc_lstem(patch%itype(p))) * & + (fm_lstem(patch%itype(p))-fm_droot(patch%itype(p))) + m_frootn_to_litter_fire(p) = frootn(p) * f * & + fm_root(patch%itype(p)) + m_frootn_storage_to_litter_fire(p) = frootn_storage(p) * f * & + fm_other(patch%itype(p)) + m_frootn_xfer_to_litter_fire(p) = frootn_xfer(p) * f * & + fm_other(patch%itype(p)) + m_livecrootn_to_litter_fire(p) = livecrootn(p) * f * & + fm_droot(patch%itype(p)) + m_livecrootn_storage_to_litter_fire(p) = livecrootn_storage(p) * f * & + fm_other(patch%itype(p)) + m_livecrootn_xfer_to_litter_fire(p) = livecrootn_xfer(p) * f * & + fm_other(patch%itype(p)) + m_livecrootn_to_deadcrootn_fire(p) = livecrootn(p) * f * & + (fm_lroot(patch%itype(p))-fm_droot(patch%itype(p))) + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f * & + fm_droot(patch%itype(p)) + m_deadcrootn_storage_to_litter_fire(p) = deadcrootn_storage(p) * f * & + fm_other(patch%itype(p)) + m_deadcrootn_xfer_to_litter_fire(p) = deadcrootn_xfer(p) * f * & + fm_other(patch%itype(p)) + m_retransn_to_litter_fire(p) = retransn(p) * f * & + (1._r8 - cc_other(patch%itype(p))) * & + fm_other(patch%itype(p)) + + if (use_cndv) then + if ( woody(patch%itype(p)) == 1._r8 )then + if ( livestemc(p)+deadstemc(p) > 0._r8 )then + nind(p) = nind(p)*(1._r8-1._r8*fm_droot(patch%itype(p))*f) + else + nind(p) = 0._r8 + end if + end if + leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) + if (patch%itype(p) == noveg) leafcmax(p) = 0._r8 + end if + + end do ! end of patches loop + + ! fire-induced transfer of carbon and nitrogen pools to litter and cwd + + do j = 1,nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + if ( patch%active(p) ) then + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadstemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_deadcrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadstemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_deadcrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livestemc_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_c_to_cwdc(c,j) = fire_mortality_c_to_cwdc(c,j) + & + m_livecrootc_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livestemn_to_litter_fire(p) * patch%wtcol(p) * stem_prof(p,j) + fire_mortality_n_to_cwdn(c,j) = fire_mortality_n_to_cwdn(c,j) + & + m_livecrootn_to_litter_fire(p) * patch%wtcol(p) * croot_prof(p,j) + + + m_c_to_litr_met_fire(c,j)=m_c_to_litr_met_fire(c,j) + & + ((m_leafc_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafc_storage_to_litter_fire(p) + & + m_leafc_xfer_to_litter_fire(p) + & + m_gresp_storage_to_litter_fire(p) & + +m_gresp_xfer_to_litter_fire(p))*leaf_prof(p,j) + & + (m_frootc_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootc_storage_to_litter_fire(p) + & + m_frootc_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemc_storage_to_litter_fire(p) + & + m_livestemc_xfer_to_litter_fire(p) & + +m_deadstemc_storage_to_litter_fire(p) + & + m_deadstemc_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootc_storage_to_litter_fire(p) + & + m_livecrootc_xfer_to_litter_fire(p) & + +m_deadcrootc_storage_to_litter_fire(p) + & + m_deadcrootc_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_cel_fire(c,j)=m_c_to_litr_cel_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_c_to_litr_lig_fire(c,j)=m_c_to_litr_lig_fire(c,j) + & + (m_leafc_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootc_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + + m_n_to_litr_met_fire(c,j)=m_n_to_litr_met_fire(c,j) + & + ((m_leafn_to_litter_fire(p)*lf_flab(patch%itype(p)) & + +m_leafn_storage_to_litter_fire(p) + & + m_leafn_xfer_to_litter_fire(p)+m_retransn_to_litter_fire(p)) & + *leaf_prof(p,j) +(m_frootn_to_litter_fire(p)*fr_flab(patch%itype(p)) & + +m_frootn_storage_to_litter_fire(p) + & + m_frootn_xfer_to_litter_fire(p))*froot_prof(p,j) & + +(m_livestemn_storage_to_litter_fire(p) + & + m_livestemn_xfer_to_litter_fire(p) & + +m_deadstemn_storage_to_litter_fire(p) + & + m_deadstemn_xfer_to_litter_fire(p))* stem_prof(p,j)& + +(m_livecrootn_storage_to_litter_fire(p) + & + m_livecrootn_xfer_to_litter_fire(p) & + +m_deadcrootn_storage_to_litter_fire(p) + & + m_deadcrootn_xfer_to_litter_fire(p))* croot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_cel_fire(c,j)=m_n_to_litr_cel_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_fcel(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_fcel(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + m_n_to_litr_lig_fire(c,j)=m_n_to_litr_lig_fire(c,j) + & + (m_leafn_to_litter_fire(p)*lf_flig(patch%itype(p))*leaf_prof(p,j) + & + m_frootn_to_litter_fire(p)*fr_flig(patch%itype(p))*froot_prof(p,j))* patch%wtcol(p) + end if + end if + end do + end do + end do + ! + ! vertically-resolved decomposing C/N fire loss + ! column loop + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + + f = farea_burned(c) + + ! change CC for litter from 0.4_r8 to 0.5_r8 and CC for CWD from 0.2_r8 + ! to 0.25_r8 according to Li et al.(2014) + do j = 1, nlevdecomp + ! carbon fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * f * 0.5_r8 + end if + if ( is_cwd(l) ) then + m_decomp_cpools_to_fire_vr(c,j,l) = decomp_cpools_vr(c,j,l) * & + (f-baf_crop(c)) * 0.25_r8 + end if + end do + + ! nitrogen fluxes + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * f * 0.5_r8 + end if + if ( is_cwd(l) ) then + m_decomp_npools_to_fire_vr(c,j,l) = decomp_npools_vr(c,j,l) * & + (f-baf_crop(c)) * 0.25_r8 + end if + end do + + end do + end do ! end of column loop + + ! carbon loss due to deforestation fires + + if (do_transient_pfts) then + call get_curr_date (kyr, kmo, kda, mcsec) + do fc = 1,num_soilc + c = filter_soilc(fc) + lfc2(c)=0._r8 + if( .not. (kmo == 1 .and. kda == 1 .and. mcsec == 0) )then + if( trotr1_col(c)+trotr2_col(c) > 0.6_r8 .and. dtrotr_col(c) > 0._r8 .and. & + lfc(c) > 0._r8 .and. fbac1(c) == 0._r8) then + lfc2(c) = max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))/2.0*dt))/(dtrotr_col(c)*dayspyr*secspday/dt)/dt + lfc(c) = lfc(c) - max(0._r8, min(lfc(c), (farea_burned(c)-baf_crop(c) - & + baf_peatf(c))*dt/2.0_r8)) + end if + end if + end do + end if + ! + ! Carbon loss due to peat fires + ! + ! somc_fire is not connected to clm45 soil carbon pool, ie does not decrease + ! soil carbon b/c clm45 soil carbon was very low in several peatland grids + ! + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if( grc%latdeg(g) < borealat)then + somc_fire(c)= totsomc(c)*baf_peatf(c)*6.0_r8/33.9_r8 + else + somc_fire(c)= baf_peatf(c)*2.2e3_r8 + end if + end do + + ! Fang Li has not added aerosol and trace gas emissions due to fire, yet + ! They will be added here in proportion to the carbon emission + ! Emission factors differ for various fire types + + end associate + + end subroutine CNFireFluxes + + !----------------------------------------------------------------------- + subroutine hdm_init( bounds ) + ! + ! !DESCRIPTION: + ! Initialize data stream information for population density. + ! + ! !USES: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use clm_nlUtilsMod , only : find_nlgroup_name + use ndepStreamMod , only : clm_domain_mct + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: stream_year_first_popdens ! first year in pop. dens. stream to use + integer :: stream_year_last_popdens ! last year in pop. dens. stream to use + integer :: model_year_align_popdens ! align stream_year_first_hdm with + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_popdens ! population density streams filename + character(len=CL) :: popdensmapalgo = 'bilinear' ! mapping alogrithm for population density + character(*), parameter :: subName = "('hdmdyn_init')" + character(*), parameter :: F00 = "('(hdmdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /popd_streams/ & + stream_year_first_popdens, & + stream_year_last_popdens, & + model_year_align_popdens, & + popdensmapalgo, & + stream_fldFileName_popdens + + ! Allocate pop dens forcing data + allocate( forc_hdm(bounds%begg:bounds%endg) ) + + ! Default values for namelist + stream_year_first_popdens = 1 ! first year in stream to use + stream_year_last_popdens = 1 ! last year in stream to use + model_year_align_popdens = 1 ! align stream_year_first_popdens with this model year + stream_fldFileName_popdens = ' ' + + ! Read popd_streams namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'popd_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=popd_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading popd_streams namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_popdens, mpicom) + call shr_mpi_bcast(stream_year_last_popdens, mpicom) + call shr_mpi_bcast(model_year_align_popdens, mpicom) + call shr_mpi_bcast(stream_fldFileName_popdens, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'popdens_streams settings:' + write(iulog,*) ' stream_year_first_popdens = ',stream_year_first_popdens + write(iulog,*) ' stream_year_last_popdens = ',stream_year_last_popdens + write(iulog,*) ' model_year_align_popdens = ',model_year_align_popdens + write(iulog,*) ' stream_fldFileName_popdens = ',stream_fldFileName_popdens + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat_hdm,name="clmhdm", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_popdens, & + yearLast=stream_year_last_popdens, & + yearAlign=model_year_align_popdens, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_popdens), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_popdens)/) , & + fldListFile='hdm', & + fldListModel='hdm', & + fillalgo='none', & + mapalgo=popdensmapalgo, & + calendar=get_calendar(), & + tintalgo='nearest', & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_hdm,'population density data') + endif + + ! Add history fields + call hist_addfld1d (fname='HDM', units='counts/km^2', & + avgflag='A', long_name='human population density', & + ptr_lnd=forc_hdm, default='inactive') + +end subroutine hdm_init + +!----------------------------------------------------------------------- +subroutine hdm_interp(bounds) + ! + ! !DESCRIPTION: + ! Interpolate data stream information for population density. + ! + ! !USES: + use clm_time_manager, only : get_curr_date + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat_hdm, mcdate, sec, mpicom, 'hdmdyn') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + forc_hdm(g) = sdat_hdm%avs(1)%rAttr(1,ig) + end do + +end subroutine hdm_interp + +!----------------------------------------------------------------------- +subroutine lnfm_init( bounds ) + ! + ! !DESCRIPTION: + ! + ! Initialize data stream information for Lightning. + ! + ! !USES: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use clm_nlUtilsMod , only : find_nlgroup_name + use ndepStreamMod , only : clm_domain_mct + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: stream_year_first_lightng ! first year in Lightning stream to use + integer :: stream_year_last_lightng ! last year in Lightning stream to use + integer :: model_year_align_lightng ! align stream_year_first_lnfm with + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_lightng ! lightning stream filename to read + character(len=CL) :: lightngmapalgo = 'bilinear'! Mapping alogrithm + character(*), parameter :: subName = "('lnfmdyn_init')" + character(*), parameter :: F00 = "('(lnfmdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /light_streams/ & + stream_year_first_lightng, & + stream_year_last_lightng, & + model_year_align_lightng, & + lightngmapalgo, & + stream_fldFileName_lightng + + ! Allocate lightning forcing data + allocate( forc_lnfm(bounds%begg:bounds%endg) ) + + ! Default values for namelist + stream_year_first_lightng = 1 ! first year in stream to use + stream_year_last_lightng = 1 ! last year in stream to use + model_year_align_lightng = 1 ! align stream_year_first_lnfm with this model year + stream_fldFileName_lightng = ' ' + + ! Read light_streams namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'light_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=light_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading light_streams namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_lightng, mpicom) + call shr_mpi_bcast(stream_year_last_lightng, mpicom) + call shr_mpi_bcast(model_year_align_lightng, mpicom) + call shr_mpi_bcast(stream_fldFileName_lightng, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'light_stream settings:' + write(iulog,*) ' stream_year_first_lightng = ',stream_year_first_lightng + write(iulog,*) ' stream_year_last_lightng = ',stream_year_last_lightng + write(iulog,*) ' model_year_align_lightng = ',model_year_align_lightng + write(iulog,*) ' stream_fldFileName_lightng = ',stream_fldFileName_lightng + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat_lnfm,name="clmlnfm", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_lightng, & + yearLast=stream_year_last_lightng, & + yearAlign=model_year_align_lightng, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_lightng), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_lightng)/),& + fldListFile='lnfm', & + fldListModel='lnfm', & + fillalgo='none', & + mapalgo=lightngmapalgo, & + calendar=get_calendar(), & + taxmode='cycle' ) + + if (masterproc) then + call shr_strdata_print(sdat_lnfm,'Lightning data') + endif + + ! Add history fields + call hist_addfld1d (fname='LNFM', units='counts/km^2/hr', & + avgflag='A', long_name='Lightning frequency', & + ptr_lnd=forc_lnfm, default='inactive') + +end subroutine lnfm_init + +!----------------------------------------------------------------------- +subroutine lnfm_interp(bounds ) + ! + ! !DESCRIPTION: + ! Interpolate data stream information for Lightning. + ! + ! !USES: + use clm_time_manager, only : get_curr_date + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat_lnfm, mcdate, sec, mpicom, 'lnfmdyn') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + forc_lnfm(g) = sdat_lnfm%avs(1)%rAttr(1,ig) + end do + +end subroutine lnfm_interp + +end module CNFireMod diff --git a/components/clm/src/biogeochem/CNGRespMod.F90 b/components/clm/src/biogeochem/CNGRespMod.F90 new file mode 100644 index 0000000000..9b3e4583f4 --- /dev/null +++ b/components/clm/src/biogeochem/CNGRespMod.F90 @@ -0,0 +1,422 @@ +module CNGRespMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for growth respiration fluxes, + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use pftconMod , only : npcropmin, pftcon + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use PatchType , only : patch + use CanopyStateType , only : canopystate_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use clm_varctl , only : carbon_excess_opt + use clm_varctl , only : carbon_storage_excess_opt + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNGResp + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + ! subroutine CNGResp(num_soilp, filter_soilp, cnveg_carbonflux_inst) + subroutine CNGResp(num_soilp, filter_soilp, cnveg_carbonflux_inst, canopystate_inst, cnveg_carbonstate_inst, & + cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic carbon state + ! variables + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: respfact_leaf + real(r8):: respfact_froot + real(r8):: respfact_livecroot + real(r8):: respfact_livestem + real(r8):: respfact_leaf_storage + real(r8):: respfact_froot_storage + real(r8):: respfact_livecroot_storage + real(r8):: respfact_livestem_storage + real(r8):: leafcn_storage_actual + real(r8):: leafcn_actual + real(r8):: frootcn_storage_actual + real(r8):: frootcn_actual + real(r8):: livestemcn_storage_actual + real(r8):: livestemcn_actual + real(r8):: livecrootcn_storage_actual + real(r8):: livecrootcn_actual + real(r8):: leafcn_max + real(r8):: frootcn_max + real(r8):: livewdcn_max + !integer, parameter :: carbon_excess_opt = 0 + !integer, parameter :: carbon_storage_excess_opt = 0 + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:)] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:)] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:)] shaded projected leaf area index + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:)] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:)] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:)] + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:)] + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C storage + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N storage + + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Input: [real(r8) (:)] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Input: [real(r8) (:)] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Input: [real(r8) (:)] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Input: [real(r8) (:)] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Input: [real(r8) (:)] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Input: [real(r8) (:)] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Input: [real(r8) (:)] allocation to dead coarse root C (gC/m2/s) + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Input: [real(r8) (:)] allocation to dead coarse root C storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Input: [real(r8) (:)] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Input: [real(r8) (:)] allocation to grain C storage (gC/m2/s) + grainc_xfer_to_grainc => cnveg_carbonflux_inst%grainc_xfer_to_grainc_patch , & ! Input: [real(r8) (:)] grain C growth from storage (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Input: [real(r8) (:)] leaf C growth from storage (gC/m2/s) + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Input: [real(r8) (:)] fine root C growth from storage (gC/m2/s) + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Input: [real(r8) (:)] live stem C growth from storage (gC/m2/s) + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Input: [real(r8) (:)] dead stem C growth from storage (gC/m2/s) + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Input: [real(r8) (:)] live coarse root C growth from storage (gC/m2/s) + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Input: [real(r8) (:)] dead coarse root C growth from storage (gC/m2/s) + cpool_grain_gr => cnveg_carbonflux_inst%cpool_grain_gr_patch , & ! Output: [real(r8) (:)] + cpool_grain_storage_gr => cnveg_carbonflux_inst%cpool_grain_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_grain_gr => cnveg_carbonflux_inst%transfer_grain_gr_patch , & ! Output: [real(r8) (:)] + cpool_leaf_gr => cnveg_carbonflux_inst%cpool_leaf_gr_patch , & ! Output: [real(r8) (:)] + cpool_leaf_storage_gr => cnveg_carbonflux_inst%cpool_leaf_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_leaf_gr => cnveg_carbonflux_inst%transfer_leaf_gr_patch , & ! Output: [real(r8) (:)] + cpool_froot_gr => cnveg_carbonflux_inst%cpool_froot_gr_patch , & ! Output: [real(r8) (:)] + cpool_froot_storage_gr => cnveg_carbonflux_inst%cpool_froot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_froot_gr => cnveg_carbonflux_inst%transfer_froot_gr_patch , & ! Output: [real(r8) (:)] + cpool_livestem_gr => cnveg_carbonflux_inst%cpool_livestem_gr_patch , & ! Output: [real(r8) (:)] + cpool_livestem_storage_gr => cnveg_carbonflux_inst%cpool_livestem_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_livestem_gr => cnveg_carbonflux_inst%transfer_livestem_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadstem_gr => cnveg_carbonflux_inst%cpool_deadstem_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadstem_storage_gr => cnveg_carbonflux_inst%cpool_deadstem_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_deadstem_gr => cnveg_carbonflux_inst%transfer_deadstem_gr_patch , & ! Output: [real(r8) (:)] + cpool_livecroot_gr => cnveg_carbonflux_inst%cpool_livecroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_livecroot_storage_gr => cnveg_carbonflux_inst%cpool_livecroot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_livecroot_gr => cnveg_carbonflux_inst%transfer_livecroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadcroot_gr => cnveg_carbonflux_inst%cpool_deadcroot_gr_patch , & ! Output: [real(r8) (:)] + cpool_deadcroot_storage_gr => cnveg_carbonflux_inst%cpool_deadcroot_storage_gr_patch , & ! Output: [real(r8) (:)] + transfer_deadcroot_gr => cnveg_carbonflux_inst%transfer_deadcroot_gr_patch & ! Output: [real(r8) (:)] + ) + + ! Loop through patches + ! start patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + respfact_leaf = 1.0_r8 + respfact_froot = 1.0_r8 + respfact_livecroot = 1.0_r8 + respfact_livestem = 1.0_r8 + respfact_livecroot = 1.0_r8 + respfact_livestem = 1.0_r8 + respfact_leaf_storage = 1.0_r8 + respfact_froot_storage = 1.0_r8 + respfact_livecroot_storage = 1.0_r8 + respfact_livestem_storage = 1.0_r8 + respfact_livecroot_storage = 1.0_r8 + respfact_livestem_storage = 1.0_r8 + + if (carbon_excess_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + ! computing carbon to nitrogen ratio of different plant parts + + if (leafn(p) == 0.0_r8) then ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + leafcn_actual = leafc(p) / 0.000000001_r8 + else + leafcn_actual = leafc(p) / leafn(p) ! leaf CN ratio + end if + + if (frootn(p) == 0.0_r8) then ! to avoid division by zero, and also to make frootcn_actual(p) a very large number if frootc(p) is zero + frootcn_actual = frootc(p) / 0.000000001_r8 + else + frootcn_actual = frootc(p) / frootn(p) ! fine root CN ratio + end if + + if (woody(ivt(p)) == 1._r8) then + + if (livestemn(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = livestemc(p) / 0.000000001_r8 + else + livestemcn_actual = livestemc(p) / livestemn(p) ! live stem CN ratio + end if + + if (livecrootn(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = livecrootc(p) / 0.000000001_r8 + else + livecrootcn_actual = livecrootc(p) / livecrootn(p) ! live coarse root CN ratio + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (livestemn(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = livestemc(p) / 0.000000001_r8 + else + livestemcn_actual = livestemc(p) / livestemn(p) ! live stem CN ratio + end if + + if (livecrootn(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = livecrootc(p) / 0.000000001_r8 + else + livecrootcn_actual = livecrootc(p) / livecrootn(p) ! live coarse root CN ratio + end if + + end if + + leafcn_max = leafcn(ivt(p)) + 25.0_r8 + frootcn_max = frootcn(ivt(p)) + 25.0_r8 + + ! Note that for high CN ratio stress the plant part does not retranslocate nitrogen as the plant part will need the N + ! if high leaf CN ratio (i.e., high leaf C compared to N) then turnover extra C + if (leafcn_actual > leafcn_max) then + respfact_leaf = 1.0_r8 + end if + + ! if high fine root CN ratio (i.e., high fine root C compared to N) then turnover extra C + if (frootcn_actual > frootcn_max) then + respfact_froot = 1.0_r8 + end if + + if (woody(ivt(p)) == 1._r8) then + + livewdcn_max = livewdcn(ivt(p)) + 25.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + respfact_livecroot = 1.0_r8 + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + respfact_livestem = 1.0_r8 + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + livewdcn_max = livewdcn(ivt(p)) + 25.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + respfact_livecroot = 1.0_r8 + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + respfact_livestem = 1.0_r8 + end if + + end if + + end if + + + if (carbon_storage_excess_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + ! computing carbon to nitrogen ratio of different plant parts + + if (leafn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + leafcn_storage_actual = leafc_storage(p) / 0.000000001_r8 + else + leafcn_storage_actual = leafc_storage(p) / leafn_storage(p) ! leaf CN ratio + end if + + if (frootn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make frootcn_actual(p) a very large number if frootc(p) is zero + frootcn_storage_actual = frootc_storage(p) / 0.000000001_r8 + else + frootcn_storage_actual = frootc_storage(p) / frootn_storage(p) ! fine root CN ratio + end if + + if (woody(ivt(p)) == 1._r8) then + + if (livestemn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_storage_actual = livestemc_storage(p) / 0.000000001_r8 + else + livestemcn_storage_actual = livestemc_storage(p) / livestemn_storage(p) ! live stem CN ratio + end if + + if (livecrootn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_storage_actual = livecrootc_storage(p) / 0.000000001_r8 + else + livecrootcn_storage_actual = livecrootc_storage(p) / livecrootn_storage(p) ! live coarse root CN ratio + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (livestemn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_storage_actual = livestemc_storage(p) / 0.000000001_r8 + else + livestemcn_storage_actual = livestemc_storage(p) / livestemn_storage(p) ! live stem CN ratio + end if + + if (livecrootn_storage(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_storage_actual = livecrootc_storage(p) / 0.000000001_r8 + else + livecrootcn_storage_actual = livecrootc_storage(p) / livecrootn_storage(p) ! live coarse root CN ratio + end if + + end if + + + leafcn_max = leafcn(ivt(p)) + 25.0_r8 + frootcn_max = frootcn(ivt(p)) + 25.0_r8 + + ! Note that for high CN ratio stress the plant part does not retranslocate nitrogen as the plant part will need the N + ! if high leaf CN ratio (i.e., high leaf C compared to N) then turnover extra C + if (leafcn_storage_actual > leafcn_max) then + respfact_leaf_storage = 1.0_r8 + end if + + ! if high fine root CN ratio (i.e., high fine root C compared to N) then turnover extra C + if (frootcn_storage_actual > frootcn_max) then + respfact_froot_storage = 1.0_r8 + end if + + if (woody(ivt(p)) == 1._r8) then + + livewdcn_max = livewdcn(ivt(p)) + 25.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_storage_actual > livewdcn_max) then + respfact_livecroot_storage = 1.0_r8 + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_storage_actual > livewdcn_max) then + respfact_livestem_storage = 1.0_r8 + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + livewdcn_max = livewdcn(ivt(p)) + 25.0_r8 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_storage_actual > livewdcn_max) then + respfact_livecroot_storage = 1.0_r8 + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_storage_actual > livewdcn_max) then + respfact_livestem_storage = 1.0_r8 + end if + + end if + + end if + + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) * respfact_livestem + + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & + respfact_livestem_storage + + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & + respfact_livestem_storage + + cpool_grain_gr(p) = cpool_to_grainc(p) * grperc(ivt(p)) + + cpool_grain_storage_gr(p) = cpool_to_grainc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_grain_gr(p) = grainc_xfer_to_grainc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + end if + + ! leaf and fine root growth respiration + cpool_leaf_gr(p) = cpool_to_leafc(p) * grperc(ivt(p)) * respfact_leaf + + cpool_leaf_storage_gr(p) = cpool_to_leafc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * respfact_leaf_storage + + transfer_leaf_gr(p) = leafc_xfer_to_leafc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * respfact_leaf_storage + + cpool_froot_gr(p) = cpool_to_frootc(p) * grperc(ivt(p)) * respfact_froot * respfact_froot + + cpool_froot_storage_gr(p) = cpool_to_frootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * respfact_froot_storage + + transfer_froot_gr(p) = frootc_xfer_to_frootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * respfact_froot_storage + + if (woody(ivt(p)) == 1._r8) then + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) * respfact_livestem + + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & +respfact_livestem_storage + + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & +respfact_livestem_storage + + cpool_deadstem_gr(p) = cpool_to_deadstemc(p) * grperc(ivt(p)) + + cpool_deadstem_storage_gr(p) = cpool_to_deadstemc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_deadstem_gr(p) = deadstemc_xfer_to_deadstemc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + + cpool_livecroot_gr(p) = cpool_to_livecrootc(p) * grperc(ivt(p)) * respfact_livecroot + + cpool_livecroot_storage_gr(p) = cpool_to_livecrootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) * & +respfact_livecroot_storage + + transfer_livecroot_gr(p) = livecrootc_xfer_to_livecrootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) * & +respfact_livecroot_storage + + cpool_deadcroot_gr(p) = cpool_to_deadcrootc(p) * grperc(ivt(p)) + + cpool_deadcroot_storage_gr(p) = cpool_to_deadcrootc_storage(p) * grperc(ivt(p)) * grpnow(ivt(p)) + + transfer_deadcroot_gr(p) = deadcrootc_xfer_to_deadcrootc(p) * grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + end if + + end do + + end associate + + end subroutine CNGResp + +end module CNGRespMod diff --git a/components/clm/src/biogeochem/CNGapMortalityMod.F90 b/components/clm/src/biogeochem/CNGapMortalityMod.F90 new file mode 100644 index 0000000000..192851e9af --- /dev/null +++ b/components/clm/src/biogeochem/CNGapMortalityMod.F90 @@ -0,0 +1,707 @@ +module CNGapMortalityMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in gap mortality for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use pftconMod , only : pftcon + use CNDVType , only : dgvs_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CanopyStateType , only : canopystate_type + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: CNGapMortality + + type, private :: params_type + real(r8):: am ! mortality rate based on annual rate, fractional mortality (1/yr) + real(r8):: k_mort ! coeff. of growth efficiency in mortality equation + end type params_type + ! + type(params_type), private :: params_inst + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: CNGap_PatchToColumn + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read in parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNGapMortParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='r_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%am=tempr + + tString='k_mort' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_mort=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine CNGapMortality (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, canopystate_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) + ! + ! !DESCRIPTION: + ! Gap-phase mortality routine for coupled carbon-nitrogen code (CN) + ! + ! !USES: + use clm_time_manager , only: get_days_per_year + use clm_varpar , only: nlevdecomp_full + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv + use pftconMod , only: npcropmin + use clm_varctl , only : carbon_excess_opt + use clm_varctl , only : carbon_storage_excess_opt + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(canopystate_type) , intent(in) :: canopystate_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: fp ! patch filter index + real(r8):: am ! rate for fractional mortality (1/yr) + real(r8):: m ! rate for fractional mortality (1/s) + real(r8):: mort_max ! asymptotic max mortality rate (/yr) + real(r8):: k_mort = 0.3 ! coeff of growth efficiency in mortality equation + + real(r8):: leafcn_storage_actual + real(r8):: leafcn_actual + real(r8):: frootcn_storage_actual + real(r8):: frootcn_actual + real(r8):: livestemcn_storage_actual + real(r8):: livestemcn_actual + real(r8):: livecrootcn_storage_actual + real(r8):: livecrootcn_actual + real(r8):: leafcn_max + real(r8):: frootcn_max + real(r8):: livewdcn_max + real(r8):: lfr_cn + real(r8):: mort_cn + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform + + greffic => dgvs_inst%greffic_patch , & ! Input: [real(r8) (:) ] + heatstress => dgvs_inst%heatstress_patch , & ! Input: [real(r8) (:) ] + + leafcn => pftcon%leafcn , & ! Input: [real(r8) (:)] leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: [real(r8) (:)] fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: [real(r8) (:)] live wood (phloem and ray parenchyma) C:N (gC/gN) + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + nind => dgvs_inst%nind_patch & ! Output: [real(r8) (:) ] number of individuals (#/m2) added by F. Li and S. Levis + ) + + ! set the mortality rate based on annual rate + am = params_inst%am + ! set coeff of growth efficiency in mortality equation + k_mort = params_inst%k_mort + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (use_cndv) then + ! Stress mortality from lpj's subr Mortality. + + if (woody(ivt(p)) == 1._r8) then + + if (ivt(p) == 8) then + mort_max = 0.03_r8 ! BDT boreal + else + mort_max = 0.01_r8 ! original value for all patches + end if + + ! heatstress and greffic calculated in Establishment once/yr + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + am = min(1._r8, am + heatstress(p)) + else ! lpj didn't set this for grasses; cn does + ! set the mortality rate based on annual rate + am = params_inst%am + end if + + end if + + m = am/(get_days_per_year() * secspday) + + !------------------------------------------------------ + ! patch-level gap mortality carbon fluxes + !------------------------------------------------------ + + ! displayed pools + cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) * m + cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) * m + cnveg_carbonflux_inst%m_deadstemc_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) * m + cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) * m + + ! storage pools + cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) * m + cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) * m + cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) * m + cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_storage_patch(p) * m + + if (ivt(p) == 11 .OR. ivt(p) == 14) then + + if (carbon_excess_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + ! computing carbon to nitrogen ratio of different plant parts + + if (cnveg_nitrogenstate_inst%leafn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + leafcn_actual = cnveg_carbonstate_inst%leafc_patch(p) / 0.000000001_r8 + else + leafcn_actual = cnveg_carbonstate_inst%leafc_patch(p) / cnveg_nitrogenstate_inst%leafn_patch(p) ! leaf CN ratio + end if + + if (cnveg_nitrogenstate_inst%frootn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make frootcn_actual(p) a very large number if frootc(p) is zero + frootcn_actual = cnveg_carbonstate_inst%frootc_patch(p) / 0.000000001_r8 + else + frootcn_actual = cnveg_carbonstate_inst%frootc_patch(p) / cnveg_nitrogenstate_inst%frootn_patch(p) ! fine root CN ratio + end if + + if (woody(ivt(p)) == 1._r8) then + + if (cnveg_nitrogenstate_inst%livestemn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = cnveg_carbonstate_inst%livestemc_patch(p) / 0.000000001_r8 + else + livestemcn_actual = cnveg_carbonstate_inst%livestemc_patch(p) / cnveg_nitrogenstate_inst%livestemn_patch(p) ! live stem CN ratio + end if + + if (cnveg_nitrogenstate_inst%livecrootn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_patch(p) / 0.000000001_r8 + else + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_patch(p) ! live coarse root CN ratio + end if + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (cnveg_nitrogenstate_inst%livestemn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_actual = cnveg_carbonstate_inst%livestemc_patch(p) / 0.000000001_r8 + else + livestemcn_actual = cnveg_carbonstate_inst%livestemc_patch(p) / cnveg_nitrogenstate_inst%livestemn_patch(p) ! live stem CN ratio + end if + + if (cnveg_nitrogenstate_inst%livecrootn_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_patch(p) / 0.000000001_r8 + else + livecrootcn_actual = cnveg_carbonstate_inst%livecrootc_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_patch(p) ! live coarse root CN ratio + end if + end if + + lfr_cn = 7.0_r8 ! turnover time if CN ratio exceeds the maximum = 12 days put this later in text file + mort_cn = 1.0_r8 / (lfr_cn * secspday) ! converting annual to seconds + + leafcn_max = leafcn(ivt(p)) + 25 + frootcn_max = frootcn(ivt(p)) + 25 + + ! Note that for high CN ratio stress the plant part does not retranslocate nitrogen as the plant part will need the N + ! if high leaf CN ratio (i.e., high leaf C compared to N) then turnover extra C + if (leafcn_actual > leafcn_max) then + cnveg_carbonflux_inst%m_leafc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%leafc_patch(p) + end if + + ! if high fine root CN ratio (i.e., high fine root C compared to N) then turnover extra C + if (frootcn_actual > frootcn_max) then + cnveg_carbonflux_inst%m_frootc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%frootc_patch(p) + end if + + if (woody(ivt(p)) == 1._r8) then + + livewdcn_max = livewdcn(ivt(p)) + 25 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%livecrootc_patch(p) + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%livestemc_patch(p) + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + livewdcn_max = livewdcn(ivt(p)) + 25 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livecrootc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%livecrootc_patch(p) + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livestemc_to_litter_patch(p) = mort_cn * cnveg_carbonstate_inst%livestemc_patch(p) + end if + + end if + + end if + + + if (carbon_storage_excess_opt == 1 .AND. laisun(p)+laisha(p) > 0.0_r8) then + ! computing carbon to nitrogen ratio of different plant parts + + if (cnveg_nitrogenstate_inst%leafn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + leafcn_storage_actual = cnveg_carbonstate_inst%leafc_storage_patch(p) / 0.000000001_r8 + else + leafcn_storage_actual = cnveg_carbonstate_inst%leafc_storage_patch(p) / & + cnveg_nitrogenstate_inst%leafn_storage_patch(p) ! leaf CN ratio + end if + + if (cnveg_nitrogenstate_inst%frootn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make frootcn_actual(p) a very large number if frootc(p) is zero + frootcn_storage_actual = cnveg_carbonstate_inst%frootc_storage_patch(p) / 0.000000001_r8 + else + frootcn_storage_actual = cnveg_carbonstate_inst%frootc_storage_patch(p) / & + cnveg_nitrogenstate_inst%frootn_storage_patch(p) ! fine root CN ratio + end if + + if (woody(ivt(p)) == 1._r8) then + + if (cnveg_nitrogenstate_inst%livestemn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_storage_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / 0.000000001_r8 + else + livestemcn_storage_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) ! live stem CN ratio + end if + + if (cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_storage_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / 0.000000001_r8 + else + livecrootcn_storage_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) ! live coarse root CN ratio + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (cnveg_nitrogenstate_inst%livestemn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livestemcn_actual(p) a very large number if livestemc(p) is zero + livestemcn_storage_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / 0.000000001_r8 + else + livestemcn_storage_actual = cnveg_carbonstate_inst%livestemc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) ! live stem CN ratio + end if + + if (cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) == 0.0_r8) then ! to avoid division by zero, and also to make livecrootcn_actual(p) a very large number if livecrootc(p) is zero + livecrootcn_storage_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / 0.000000001_r8 + else + livecrootcn_storage_actual = cnveg_carbonstate_inst%livecrootc_storage_patch(p) / & + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) ! live coarse root CN ratio + end if + + end if + + lfr_cn = 7.0_r8 ! turnover time if CN ratio exceeds the maximum = 12 days put this later in text file + mort_cn = 1.0_r8 / (lfr_cn * secspday) ! converting annual to seconds + + leafcn_max = leafcn(ivt(p)) + 25 + frootcn_max = frootcn(ivt(p)) + 25 + + ! Note that for high CN ratio stress the plant part does not retranslocate nitrogen as the plant part will need the N + ! if high leaf CN ratio (i.e., high leaf C compared to N) then turnover extra C + if (leafcn_storage_actual > leafcn_max) then + cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%leafc_storage_patch(p) + end if + + ! if high fine root CN ratio (i.e., high fine root C compared to N) then turnover extra C + if (frootcn_storage_actual > frootcn_max) then + cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%frootc_storage_patch(p) + end if + + if (woody(ivt(p)) == 1._r8) then + + livewdcn_max = livewdcn(ivt(p)) + 25 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_storage_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%livecrootc_storage_patch(p) + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_storage_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%livestemc_storage_patch(p) + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + livewdcn_max = livewdcn(ivt(p)) + 25 + + ! if high coarse root CN ratio (i.e., high coarse root C compared to N) then turnover extra C + if (livecrootcn_storage_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%livecrootc_storage_patch(p) + end if + + ! if high stem CN ratio (i.e., high stem C compared to N) then turnover extra C + if (livestemcn_storage_actual > livewdcn_max) then + cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch(p) = mort_cn * & + cnveg_carbonstate_inst%livestemc_storage_patch(p) + end if + + end if + + end if + + end if ! end of if (ivt(p) == 11 .OR. ivt(p) == 14) then + + ! transfer pools + cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) * m + cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) * m + + !------------------------------------------------------ + ! patch-level gap mortality nitrogen fluxes + !------------------------------------------------------ + + ! displayed pools + cnveg_nitrogenflux_inst%m_leafn_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) * m + cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) * m + if (ivt(p) < npcropmin) then + cnveg_nitrogenflux_inst%m_retransn_to_litter_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) * m + end if + + ! storage pools + cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) * m + + ! transfer pools + cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) * m + cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) * m + + ! added by F. Li and S. Levis + if (use_cndv) then + if (woody(ivt(p)) == 1._r8)then + if (cnveg_carbonstate_inst%livestemc_patch(p) + cnveg_carbonstate_inst%deadstemc_patch(p)> 0._r8)then + nind(p)=nind(p)*(1._r8-m) + else + nind(p) = 0._r8 + end if + end if + end if + + end do ! end of patch loop + + ! gather all patch-level litterfall fluxes to the column + ! for litter C and N inputs + + call CNGap_PatchToColumn(bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + froot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + croot_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full), & + stem_prof_patch(bounds%begp:bounds%endp, 1:nlevdecomp_full)) + + end associate + + end subroutine CNGapMortality + + !----------------------------------------------------------------------- + subroutine CNGap_PatchToColumn (bounds, num_soilc, filter_soilc, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch, croot_prof_patch, stem_prof_patch) + ! + ! !DESCRIPTION: + ! gathers all patch-level gap mortality fluxes to the column level and + ! assigns them to the three litter pools + ! + ! !USES: + use clm_varpar , only : maxpatch_pft, nlevdecomp, nlevdecomp_full + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: croot_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: stem_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(croot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(stem_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + + associate( & + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] patch weight relative to column (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: [real(r8) (:) ] leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: [real(r8) (:) ] leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: [real(r8) (:) ] leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: [real(r8) (:) ] fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: [real(r8) (:) ] fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: [real(r8) (:) ] fine root litter lignin fraction + + m_leafc_to_litter => cnveg_carbonflux_inst%m_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_to_litter => cnveg_carbonflux_inst%m_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_to_litter => cnveg_carbonflux_inst%m_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_to_litter => cnveg_carbonflux_inst%m_deadstemc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_to_litter => cnveg_carbonflux_inst%m_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_to_litter => cnveg_carbonflux_inst%m_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_storage_to_litter => cnveg_carbonflux_inst%m_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_storage_to_litter => cnveg_carbonflux_inst%m_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_storage_to_litter => cnveg_carbonflux_inst%m_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_storage_to_litter => cnveg_carbonflux_inst%m_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_storage_to_litter => cnveg_carbonflux_inst%m_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_storage_to_litter => cnveg_carbonflux_inst%m_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_storage_to_litter => cnveg_carbonflux_inst%m_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafc_xfer_to_litter => cnveg_carbonflux_inst%m_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootc_xfer_to_litter => cnveg_carbonflux_inst%m_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemc_xfer_to_litter => cnveg_carbonflux_inst%m_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemc_xfer_to_litter => cnveg_carbonflux_inst%m_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootc_xfer_to_litter => cnveg_carbonflux_inst%m_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootc_xfer_to_litter => cnveg_carbonflux_inst%m_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_gresp_xfer_to_litter => cnveg_carbonflux_inst%m_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + gap_mortality_c_to_litr_met_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + gap_mortality_c_to_litr_cel_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + gap_mortality_c_to_litr_lig_c => cnveg_carbonflux_inst%gap_mortality_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + gap_mortality_c_to_cwdc => cnveg_carbonflux_inst%gap_mortality_c_to_cwdc_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with gap mortality to CWD pool (gC/m3/s) + + m_leafn_to_litter => cnveg_nitrogenflux_inst%m_leafn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_to_litter => cnveg_nitrogenflux_inst%m_frootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_to_litter => cnveg_nitrogenflux_inst%m_livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_retransn_to_litter => cnveg_nitrogenflux_inst%m_retransn_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_storage_to_litter => cnveg_nitrogenflux_inst%m_leafn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_storage_to_litter => cnveg_nitrogenflux_inst%m_frootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_storage_to_litter => cnveg_nitrogenflux_inst%m_livestemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_storage_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + m_leafn_xfer_to_litter => cnveg_nitrogenflux_inst%m_leafn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_frootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_frootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livestemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livestemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadstemn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadstemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_livecrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_livecrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + m_deadcrootn_xfer_to_litter => cnveg_nitrogenflux_inst%m_deadcrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + gap_mortality_n_to_litr_met_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + gap_mortality_n_to_litr_cel_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + gap_mortality_n_to_litr_lig_n => cnveg_nitrogenflux_inst%gap_mortality_n_to_litr_lig_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + gap_mortality_n_to_cwdn => cnveg_nitrogenflux_inst%gap_mortality_n_to_cwdn_col & ! Output: [real(r8) (:,:) ] N fluxes associated with gap mortality to CWD pool (gN/m3/s) + ) + + do j = 1,nlevdecomp + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + ! leaf gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_cel_c(c,j) = gap_mortality_c_to_litr_cel_c(c,j) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_lig_c(c,j) = gap_mortality_c_to_litr_lig_c(c,j) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality carbon fluxes + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & + (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! storage gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_storage_to_litter(p) + m_deadstemc_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_storage_to_litter(p) + m_deadcrootc_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality carbon fluxes + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_leafc_xfer_to_litter(p) + m_gresp_xfer_to_litter(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + m_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livestemc_xfer_to_litter(p) + m_deadstemc_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & + (m_livecrootc_xfer_to_litter(p) + m_deadcrootc_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! leaf gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_cel_n(c,j) = gap_mortality_n_to_litr_cel_n(c,j) + & + m_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_lig_n(c,j) = gap_mortality_n_to_litr_lig_n(c,j) + & + m_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood gap mortality nitrogen fluxes + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livestemn_to_litter(p) + m_deadstemn_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_cwdn(c,j) = gap_mortality_n_to_cwdn(c,j) + & + (m_livecrootn_to_litter(p) + m_deadcrootn_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool gap mortality fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! storage gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_storage_to_litter(p) + m_deadstemn_storage_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_storage_to_litter(p) + m_deadcrootn_storage_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + ! transfer gap mortality nitrogen fluxes + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + m_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livestemn_xfer_to_litter(p) + m_deadstemn_xfer_to_litter(p)) * wtcol(p) * stem_prof(p,j) + gap_mortality_n_to_litr_met_n(c,j) = gap_mortality_n_to_litr_met_n(c,j) + & + (m_livecrootn_xfer_to_litter(p) + m_deadcrootn_xfer_to_litter(p)) * wtcol(p) * croot_prof(p,j) + + + end if + end if + + end do + end do + end do + + end associate + + end subroutine CNGap_PatchToColumn + +end module CNGapMortalityMod diff --git a/components/clm/src/biogeochem/CNMRespMod.F90 b/components/clm/src/biogeochem/CNMRespMod.F90 new file mode 100644 index 0000000000..e6d281cd05 --- /dev/null +++ b/components/clm/src/biogeochem/CNMRespMod.F90 @@ -0,0 +1,208 @@ +module CNMRespMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding maintenance respiration routines for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevgrnd + use decompMod , only : bounds_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use pftconMod , only : npcropmin, pftcon + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use PhotosynthesisMod , only : photosyns_type + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNSharedParamsMod , only : CNParamsShareInst + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: CNMResp + + type, private :: params_type + real(r8) :: br ! base rate for maintenance respiration(gC/gN/s) + end type params_type + + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNMRespParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='br_mr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%br=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + ! FIX(SPM,032414) this shouldn't even be called with ED on. + ! + subroutine CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_inst, soilstate_inst, temperature_inst, photosyns_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil points in column filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j ! indices + integer :: fp ! soil filter patch index + integer :: fc ! soil filter column index + real(r8):: br ! base rate (gC/gN/s) + real(r8):: q10 ! temperature dependence + real(r8):: tc ! temperature correction, 2m air temp (unitless) + real(r8):: tcsoi(bounds%begc:bounds%endc,nlevgrnd) ! temperature correction by soil layer (unitless) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (Kelvin) + + lmrsun => photosyns_inst%lmrsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + lmrsha => photosyns_inst%lmrsha_patch , & ! Input: [real(r8) (:) ] shaded leaf maintenance respiration rate (umol CO2/m**2/s) + + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + grainn => cnveg_nitrogenstate_inst%grainn_patch , & ! Input: [real(r8) (:) ] (kgN/m2) grain N + + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Output: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Output: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Output: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Output: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch & ! Output: [real(r8) (:) ] + + ) + + ! base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! set constants + br = params_inst%br + + ! Peter Thornton: 3/13/09 + ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning + ! to improve seasonal cycle of atmospheric CO2 concentration in global + ! simulatoins + Q10 = CNParamsShareInst%Q10 + + ! column loop to calculate temperature factors in each soil layer + do j=1,nlevgrnd + do fc = 1, num_soilc + c = filter_soilc(fc) + + ! calculate temperature corrections for each soil layer, for use in + ! estimating fine root maintenance respiration with depth + tcsoi(c,j) = Q10**((t_soisno(c,j)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + end do + end do + + ! patch loop for leaves and live wood + do fp = 1, num_soilp + p = filter_soilp(fp) + + ! calculate maintenance respiration fluxes in + ! gC/m2/s for each of the live plant tissues. + ! Leaf and live wood MR + + tc = Q10**((t_ref2m(p)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + + if (frac_veg_nosno(p) == 1) then + + leaf_mr(p) = lmrsun(p) * laisun(p) * 12.011e-6_r8 + & + lmrsha(p) * laisha(p) * 12.011e-6_r8 + + else !nosno + + leaf_mr(p) = 0._r8 + + end if + + if (woody(ivt(p)) == 1) then + livestem_mr(p) = livestemn(p)*br*tc + livecroot_mr(p) = livecrootn(p)*br*tc + else if (ivt(p) >= npcropmin) then + livestem_mr(p) = livestemn(p)*br*tc + grain_mr(p) = grainn(p)*br*tc + end if + end do + + ! soil and patch loop for fine root + + do j = 1,nlevgrnd + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! Fine root MR + ! rootfr(j) sums to 1.0 over all soil layers, and + ! describes the fraction of root mass that is in each + ! layer. This is used with the layer temperature correction + ! to estimate the total fine root maintenance respiration as a + ! function of temperature and N content. + + froot_mr(p) = froot_mr(p) + frootn(p)*br*tcsoi(c,j)*rootfr(p,j) + end do + end do + + end associate + + end subroutine CNMResp + +end module CNMRespMod diff --git a/components/clm/src/biogeochem/CNNDynamicsMod.F90 b/components/clm/src/biogeochem/CNNDynamicsMod.F90 new file mode 100644 index 0000000000..373f946755 --- /dev/null +++ b/components/clm/src/biogeochem/CNNDynamicsMod.F90 @@ -0,0 +1,320 @@ +module CNNDynamicsMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for mineral nitrogen dynamics (deposition, fixation, leaching) + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, nfix_timeconst + use subgridAveMod , only : p2c + use atm2lndType , only : atm2lnd_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use WaterStateType , only : waterstate_type + use WaterFluxType , only : waterflux_type + use CropType , only : crop_type + use ColumnType , only : col + use PatchType , only : patch + use perf_mod , only : t_startf, t_stopf + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNNDeposition + public :: CNNFixation + public :: CNNFert + public :: CNSoyfix + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNNDeposition( bounds, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst ) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen deposition rate + ! from atmospheric forcing. For now it is assumed that all the atmospheric + ! N deposition goes to the soil mineral N pool. + ! This could be updated later to divide the inputs between mineral N absorbed + ! directly into the canopy and mineral N entering the soil pool. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g,c ! indices + !----------------------------------------------------------------------- + + associate( & + forc_ndep => atm2lnd_inst%forc_ndep_grc , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) + ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & ! Output: [real(r8) (:)] + ) + + ! Loop through columns + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + ndep_to_sminn(c) = forc_ndep(g) + end do + + end associate + + end subroutine CNNDeposition + + !----------------------------------------------------------------------- + subroutine CNNFixation(num_soilc, filter_soilc, & + cnveg_carbonflux_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen fixation rate + ! as a function of annual total NPP. This rate gets updated once per year. + ! All N fixation goes to the soil mineral N pool. + ! + ! !USES: + use clm_time_manager , only : get_days_per_year, get_step_size + use shr_sys_mod , only : shr_sys_flush + use clm_varcon , only : secspday, spval + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! indices + real(r8) :: t ! temporary + real(r8) :: dayspyr ! days per year + !----------------------------------------------------------------------- + + associate( & + cannsum_npp => cnveg_carbonflux_inst%annsum_npp_col , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) + col_lag_npp => cnveg_carbonflux_inst%lag_npp_col , & ! Input: [real(r8) (:)] (gC/m2/s) lagged net primary production + + nfix_to_sminn => soilbiogeochem_nitrogenflux_inst%nfix_to_sminn_col & ! Output: [real(r8) (:)] symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + ) + + dayspyr = get_days_per_year() + + if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then + ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (col_lag_npp(c) /= spval) then + ! need to put npp in units of gC/m^2/year here first + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + else + nfix_to_sminn(c) = 0._r8 + endif + end do + else + ! use annual-mean values for NPP-NFIX relation + do fc = 1,num_soilc + c = filter_soilc(fc) + + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + end do + endif + + end associate + + end subroutine CNNFixation + + !----------------------------------------------------------------------- + subroutine CNNFert(bounds, num_soilc, filter_soilc, & + cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen fertilizer for crops + ! All fertilizer goes into the soil mineral N pool. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! indices + !----------------------------------------------------------------------- + + associate( & + fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) + fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col & ! Output: [real(r8) (:)] + ) + + call p2c(bounds, num_soilc, filter_soilc, & + fert(bounds%begp:bounds%endp), & + fert_to_sminn(bounds%begc:bounds%endc)) + + end associate + + end subroutine CNNFert + + !----------------------------------------------------------------------- + subroutine CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterstate_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! This routine handles the fixation of nitrogen for soybeans based on + ! the EPICPHASE model M. Cabelguenne et al., Agricultural systems 60: 175-196, 1999 + ! N-fixation is based on soil moisture, plant growth phase, and availibility of + ! nitrogen in the soil root zone. + ! + ! !USES: + use pftconMod, only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod, only : ntrp_soybean, nirrig_trp_soybean + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(waterstate_type) , intent(in) :: waterstate_inst + type(crop_type) , intent(in) :: crop_inst + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c + real(r8):: fxw,fxn,fxg,fxr ! soil water factor, nitrogen factor, growth stage factor + real(r8):: soy_ndemand ! difference between nitrogen supply and demand + real(r8):: GDDfrac + real(r8):: sminnthreshold1, sminnthreshold2 + real(r8):: GDDfracthreshold1, GDDfracthreshold2 + real(r8):: GDDfracthreshold3, GDDfracthreshold4 + !----------------------------------------------------------------------- + + associate( & + wf => waterstate_inst%wf_col , & ! Input: [real(r8) (:) ] soil water as frac. of whc for top 0.5 m + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + croplive => cnveg_state_inst%croplive_patch , & ! Input: [logical (:) ] true if planted and not harvested + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Input: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + soyfixn => cnveg_nitrogenflux_inst%soyfixn_patch , & ! Output: [real(r8) (:) ] nitrogen fixed to each soybean crop + + fpg => soilbiogeochem_state_inst%fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + sminn => soilbiogeochem_nitrogenstate_inst%sminn_col , & ! Input: [real(r8) (:) ] (kgN/m2) soil mineral N + soyfixn_to_sminn => soilbiogeochem_nitrogenflux_inst%soyfixn_to_sminn_col & ! Output: [real(r8) (:) ] + ) + + sminnthreshold1 = 30._r8 + sminnthreshold2 = 10._r8 + GDDfracthreshold1 = 0.15_r8 + GDDfracthreshold2 = 0.30_r8 + GDDfracthreshold3 = 0.55_r8 + GDDfracthreshold4 = 0.75_r8 + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! if soybean currently growing then calculate fixation + + if (croplive(p) .and. & + (patch%itype(p) == ntmp_soybean .or. & + patch%itype(p) == nirrig_tmp_soybean .or. & + patch%itype(p) == ntrp_soybean .or. & + patch%itype(p) == nirrig_trp_soybean) ) then + + ! difference between supply and demand + + if (fpg(c) < 1._r8) then + soy_ndemand = 0._r8 + soy_ndemand = plant_ndemand(p) - plant_ndemand(p)*fpg(c) + + ! fixation depends on nitrogen, soil water, and growth stage + + ! soil water factor + + fxw = 0._r8 + fxw = wf(c)/0.85_r8 + + ! soil nitrogen factor (Beth says: CHECK UNITS) + + if (sminn(c) > sminnthreshold1) then + fxn = 0._r8 + else if (sminn(c) > sminnthreshold2 .and. sminn(c) <= sminnthreshold1) then + fxn = 1.5_r8 - .005_r8 * (sminn(c) * 10._r8) + else if (sminn(c) <= sminnthreshold2) then + fxn = 1._r8 + end if + + ! growth stage factor + ! slevis: to replace GDDfrac, assume... + ! Beth's crit_offset_gdd_def is similar to my gddmaturity + ! Beth's ac_gdd (base 5C) similar to my hui=gddplant (base 10 + ! for soy) + ! Ranges below are not firm. Are they lit. based or tuning based? + + GDDfrac = hui(p) / gddmaturity(p) + + if (GDDfrac <= GDDfracthreshold1) then + fxg = 0._r8 + else if (GDDfrac > GDDfracthreshold1 .and. GDDfrac <= GDDfracthreshold2) then + fxg = 6.67_r8 * GDDfrac - 1._r8 + else if (GDDfrac > GDDfracthreshold2 .and. GDDfrac <= GDDfracthreshold3) then + fxg = 1._r8 + else if (GDDfrac > GDDfracthreshold3 .and. GDDfrac <= GDDfracthreshold4) then + fxg = 3.75_r8 - 5._r8 * GDDfrac + else ! GDDfrac > GDDfracthreshold4 + fxg = 0._r8 + end if + + ! calculate the nitrogen fixed by the soybean + + fxr = min(1._r8, fxw, fxn) * fxg + fxr = max(0._r8, fxr) + soyfixn(p) = fxr * soy_ndemand + soyfixn(p) = min(soyfixn(p), soy_ndemand) + + else ! if nitrogen demand met, no fixation + + soyfixn(p) = 0._r8 + + end if + + else ! if not live soybean, no fixation + + soyfixn(p) = 0._r8 + + end if + end do + + call p2c(bounds, num_soilc, filter_soilc, & + soyfixn(bounds%begp:bounds%endp), & + soyfixn_to_sminn(bounds%begc:bounds%endc)) + + end associate + + end subroutine CNSoyfix + +end module CNNDynamicsMod diff --git a/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 new file mode 100644 index 0000000000..d5e4205f1a --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -0,0 +1,227 @@ +module CNNStateUpdate1Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable updates, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use clm_varpar , only : crop_prog, i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varcon , only : nitrif_n2o_loss_frac + use pftconMod , only : npcropmin, pftcon + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + nf_veg => cnveg_nitrogenflux_inst , & ! Input: + ns_veg => cnveg_nitrogenstate_inst , & ! Output: + nf_soil => soilbiogeochem_nitrogenflux_inst & ! Output: + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + + ! soilbiogeochemistry fluxes TODO - this should be moved elsewhere + ! plant to litter fluxes - phenology and dynamic landcover fluxes + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf_soil%decomp_npools_sourcesink_col(c,j,i_met_lit) = & + ( nf_veg%phenology_n_to_litr_met_n_col(c,j) + nf_veg%dwt_frootn_to_litr_met_n_col(c,j) ) * dt + + nf_soil%decomp_npools_sourcesink_col(c,j,i_cel_lit) = & + ( nf_veg%phenology_n_to_litr_cel_n_col(c,j) + nf_veg%dwt_frootn_to_litr_cel_n_col(c,j) ) * dt + + nf_soil%decomp_npools_sourcesink_col(c,j,i_lig_lit) = & + ( nf_veg%phenology_n_to_litr_lig_n_col(c,j) + nf_veg%dwt_frootn_to_litr_lig_n_col(c,j) ) * dt + + nf_soil%decomp_npools_sourcesink_col(c,j,i_cwd) = & + ( nf_veg%dwt_livecrootn_to_cwdn_col(c,j) + nf_veg%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt + + end do + end do + + ! seeding fluxes, from dynamic landcover + do fc = 1,num_soilc + c = filter_soilc(fc) + + ns_veg%seedn_col(c) = ns_veg%seedn_col(c) - nf_veg%dwt_seedn_to_leaf_col(c) * dt + ns_veg%seedn_col(c) = ns_veg%seedn_col(c) - nf_veg%dwt_seedn_to_deadstem_col(c) * dt + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) + nf_veg%leafn_xfer_to_leafn_patch(p)*dt + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - nf_veg%leafn_xfer_to_leafn_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) + nf_veg%frootn_xfer_to_frootn_patch(p)*dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - nf_veg%frootn_xfer_to_frootn_patch(p)*dt + + if (woody(ivt(p)) == 1.0_r8) then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - nf_veg%deadstemn_xfer_to_deadstemn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) + nf_veg%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - nf_veg%livecrootn_xfer_to_livecrootn_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - nf_veg%deadcrootn_xfer_to_deadcrootn_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - nf_veg%livestemn_xfer_to_livestemn_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) + nf_veg%grainn_xfer_to_grainn_patch(p)*dt + ns_veg%grainn_xfer_patch(p) = ns_veg%grainn_xfer_patch(p) - nf_veg%grainn_xfer_to_grainn_patch(p)*dt + end if + + ! phenology: litterfall and retranslocation fluxes + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - nf_veg%leafn_to_litter_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_litter_patch(p)*dt + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - nf_veg%leafn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%leafn_to_retransn_patch(p)*dt + + ! live wood turnover and retranslocation fluxes + if (woody(ivt(p)) == 1._r8) then + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%livestemn_to_deadstemn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - nf_veg%livecrootn_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%livecrootn_to_deadcrootn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - nf_veg%livecrootn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livecrootn_to_retransn_patch(p)*dt + end if + if (ivt(p) >= npcropmin) then ! Beth adds retrans from froot + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - nf_veg%frootn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%frootn_to_retransn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_litter_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) + nf_veg%livestemn_to_retransn_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) - nf_veg%grainn_to_food_patch(p)*dt + end if + + ! uptake from soil mineral N pool + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) + nf_veg%sminn_to_npool_patch(p)*dt + + ! deployment from retranslocation pool + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) + nf_veg%retransn_to_npool_patch(p)*dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - nf_veg%retransn_to_npool_patch(p)*dt + + ! allocation fluxes + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_leafn_patch(p)*dt + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) + nf_veg%npool_to_leafn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_leafn_storage_patch(p)*dt + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) + nf_veg%npool_to_leafn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_frootn_patch(p)*dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) + nf_veg%npool_to_frootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_frootn_storage_patch(p)*dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) + nf_veg%npool_to_frootn_storage_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) + nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadstemn_patch(p)*dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) + nf_veg%npool_to_deadstemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadstemn_storage_patch(p)*dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) + nf_veg%npool_to_deadstemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livecrootn_patch(p)*dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) + nf_veg%npool_to_livecrootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livecrootn_storage_patch(p)*dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) + nf_veg%npool_to_livecrootn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadcrootn_patch(p)*dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) + nf_veg%npool_to_deadcrootn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_deadcrootn_storage_patch(p)*dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) + nf_veg%npool_to_deadcrootn_storage_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) + nf_veg%npool_to_livestemn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) + nf_veg%npool_to_livestemn_storage_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_grainn_patch(p)*dt + ns_veg%grainn_patch(p) = ns_veg%grainn_patch(p) + nf_veg%npool_to_grainn_patch(p)*dt + ns_veg%npool_patch(p) = ns_veg%npool_patch(p) - nf_veg%npool_to_grainn_storage_patch(p)*dt + ns_veg%grainn_storage_patch(p) = ns_veg%grainn_storage_patch(p) + nf_veg%npool_to_grainn_storage_patch(p)*dt + end if + + ! move storage pools into transfer pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - nf_veg%leafn_storage_to_xfer_patch(p)*dt + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) + nf_veg%leafn_storage_to_xfer_patch(p)*dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - nf_veg%frootn_storage_to_xfer_patch(p)*dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) + nf_veg%frootn_storage_to_xfer_patch(p)*dt + + if (woody(ivt(p)) == 1._r8) then + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) + nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - nf_veg%deadstemn_storage_to_xfer_patch(p)*dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) + nf_veg%deadstemn_storage_to_xfer_patch(p)*dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - nf_veg%livecrootn_storage_to_xfer_patch(p)*dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) + nf_veg%livecrootn_storage_to_xfer_patch(p)*dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - nf_veg%deadcrootn_storage_to_xfer_patch(p)*dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) + nf_veg%deadcrootn_storage_to_xfer_patch(p)*dt + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) + nf_veg%livestemn_storage_to_xfer_patch(p)*dt + ns_veg%grainn_storage_patch(p) = ns_veg%grainn_storage_patch(p) - nf_veg%grainn_storage_to_xfer_patch(p)*dt + ns_veg%grainn_xfer_patch(p) = ns_veg%grainn_xfer_patch(p) + nf_veg%grainn_storage_to_xfer_patch(p)*dt + end if + + end do + + end associate + + end subroutine NStateUpdate1 + +end module CNNStateUpdate1Mod diff --git a/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 new file mode 100644 index 0000000000..50e3c4528e --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 @@ -0,0 +1,240 @@ +module CNNStateUpdate2Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevsoi, nlevdecomp + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate2 + public:: NStateUpdate2h + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & + ns_veg => cnveg_nitrogenstate_inst , & + ns_soil => soilbiogeochem_nitrogenstate_inst & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column-level nitrogen fluxes from gap-phase mortality + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + nf_veg%gap_mortality_n_to_litr_met_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + nf_veg%gap_mortality_n_to_litr_cel_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + nf_veg%gap_mortality_n_to_litr_lig_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & + ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%gap_mortality_n_to_cwdn_col(c,j) * dt + end do + end do + + ! patch -level nitrogen fluxes from gap-phase mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) & + - nf_veg%m_leafn_to_litter_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) & + - nf_veg%m_frootn_to_litter_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) & + - nf_veg%m_livestemn_to_litter_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) & + - nf_veg%m_deadstemn_to_litter_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) & + - nf_veg%m_livecrootn_to_litter_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) & + - nf_veg%m_deadcrootn_to_litter_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) & + - nf_veg%m_retransn_to_litter_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) & + - nf_veg%m_leafn_storage_to_litter_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) & + - nf_veg%m_frootn_storage_to_litter_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) & + - nf_veg%m_livestemn_storage_to_litter_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) & + - nf_veg%m_deadstemn_storage_to_litter_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) & + - nf_veg%m_livecrootn_storage_to_litter_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) & + - nf_veg%m_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) & + - nf_veg%m_leafn_xfer_to_litter_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) & + - nf_veg%m_frootn_xfer_to_litter_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) & + - nf_veg%m_livestemn_xfer_to_litter_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) & + - nf_veg%m_deadstemn_xfer_to_litter_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) & + - nf_veg%m_livecrootn_xfer_to_litter_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) & + - nf_veg%m_deadcrootn_xfer_to_litter_patch(p) * dt + + end do + + end associate + + end subroutine NStateUpdate2 + + !----------------------------------------------------------------------- + subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Update all the prognostic nitrogen state + ! variables affected by harvest mortality fluxes + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & + ns_veg => cnveg_nitrogenstate_inst , & + ns_soil => soilbiogeochem_nitrogenstate_inst & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column-level nitrogen fluxes from harvest mortality + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + nf_veg%harvest_n_to_litr_met_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + nf_veg%harvest_n_to_litr_cel_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + nf_veg%harvest_n_to_litr_lig_n_col(c,j) * dt + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = & + ns_soil%decomp_npools_vr_col(c,j,i_cwd) + nf_veg%harvest_n_to_cwdn_col(c,j) * dt + end do + end do + + ! patch-level nitrogen fluxes from harvest mortality + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed pools + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) & + - nf_veg%hrv_leafn_to_litter_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) & + - nf_veg%hrv_frootn_to_litter_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) & + - nf_veg%hrv_livestemn_to_litter_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) & + - nf_veg%hrv_deadstemn_to_prod10n_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) & + - nf_veg%hrv_deadstemn_to_prod100n_patch(p)* dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) & + - nf_veg%hrv_livecrootn_to_litter_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) & + - nf_veg%hrv_deadcrootn_to_litter_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) & + - nf_veg%hrv_retransn_to_litter_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) & + - nf_veg%hrv_leafn_storage_to_litter_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) & + - nf_veg%hrv_frootn_storage_to_litter_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) & + - nf_veg%hrv_livestemn_storage_to_litter_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) & + - nf_veg%hrv_deadstemn_storage_to_litter_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) & + - nf_veg%hrv_livecrootn_storage_to_litter_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) & + - nf_veg%hrv_deadcrootn_storage_to_litter_patch(p) * dt + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) & + - nf_veg%hrv_leafn_xfer_to_litter_patch(p) *dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) & + - nf_veg%hrv_frootn_xfer_to_litter_patch(p) *dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) & + - nf_veg%hrv_livestemn_xfer_to_litter_patch(p) *dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) & + - nf_veg%hrv_deadstemn_xfer_to_litter_patch(p) *dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) & + - nf_veg%hrv_livecrootn_xfer_to_litter_patch(p) *dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) & + - nf_veg%hrv_deadcrootn_xfer_to_litter_patch(p) *dt + + end do + + end associate + + end subroutine NStateUpdate2h + +end module CNNStateUpdate2Mod diff --git a/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 new file mode 100644 index 0000000000..cb33339319 --- /dev/null +++ b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 @@ -0,0 +1,206 @@ +module CNNStateUpdate3Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable update, mortality fluxes. + ! Also, sminn leaching flux. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varpar , only: nlevdecomp, ndecomp_pools + use clm_time_manager , only : get_step_size + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate3 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux. + ! NOTE - associate statements have been removed where there are + ! no science equations. This increases readability and maintainability. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + nf_veg => cnveg_nitrogenflux_inst , & ! Input + ns_veg => cnveg_nitrogenstate_inst , & ! Output + nf_soil => soilbiogeochem_nitrogenflux_inst , & ! Input + ns_soil => soilbiogeochem_nitrogenstate_inst & ! Output + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_nitrif_denitrif) then + ! mineral N loss due to leaching + ns_soil%sminn_vr_col(c,j) = ns_soil%sminn_vr_col(c,j) - nf_soil%sminn_leached_vr_col(c,j) * dt + else + ! mineral N loss due to leaching and runoff + ns_soil%smin_no3_vr_col(c,j) = max( ns_soil%smin_no3_vr_col(c,j) - & + ( nf_soil%smin_no3_leached_vr_col(c,j) + nf_soil%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) + + ns_soil%sminn_vr_col(c,j) = ns_soil%smin_no3_vr_col(c,j) + ns_soil%smin_nh4_vr_col(c,j) + end if + + ! column level nitrogen fluxes from fire + ! patch-level wood to column-level CWD (uncombusted wood) + ns_soil%decomp_npools_vr_col(c,j,i_cwd) = ns_soil%decomp_npools_vr_col(c,j,i_cwd) + & + nf_veg%fire_mortality_n_to_cwdn_col(c,j) * dt + + ! patch-level wood to column-level litter (uncombusted wood) + ns_soil%decomp_npools_vr_col(c,j,i_met_lit) = ns_soil%decomp_npools_vr_col(c,j,i_met_lit) + & + nf_veg%m_n_to_litr_met_fire_col(c,j)* dt + ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) = ns_soil%decomp_npools_vr_col(c,j,i_cel_lit) + & + nf_veg%m_n_to_litr_cel_fire_col(c,j)* dt + ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) = ns_soil%decomp_npools_vr_col(c,j,i_lig_lit) + & + nf_veg%m_n_to_litr_lig_fire_col(c,j)* dt + end do ! end of column loop + end do + + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns_soil%decomp_npools_vr_col(c,j,l) = ns_soil%decomp_npools_vr_col(c,j,l) - & + nf_veg%m_decomp_npools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do + + ! patch-level nitrogen fluxes + + do fp = 1,num_soilp + p = filter_soilp(fp) + + !from fire displayed pools + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - & + nf_veg%m_leafn_to_fire_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - & + nf_veg%m_frootn_to_fire_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - & + nf_veg%m_livestemn_to_fire_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) - & + nf_veg%m_deadstemn_to_fire_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - & + nf_veg%m_livecrootn_to_fire_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) - & + nf_veg%m_deadcrootn_to_fire_patch(p) * dt + + ns_veg%leafn_patch(p) = ns_veg%leafn_patch(p) - & + nf_veg%m_leafn_to_litter_fire_patch(p) * dt + ns_veg%frootn_patch(p) = ns_veg%frootn_patch(p) - & + nf_veg%m_frootn_to_litter_fire_patch(p) * dt + ns_veg%livestemn_patch(p) = ns_veg%livestemn_patch(p) - & + nf_veg%m_livestemn_to_litter_fire_patch(p) * dt + ns_veg%deadstemn_patch(p) = ns_veg%deadstemn_patch(p) - & + nf_veg%m_deadstemn_to_litter_fire_patch(p) * dt + ns_veg%livecrootn_patch(p) = ns_veg%livecrootn_patch(p) - & + nf_veg%m_livecrootn_to_litter_fire_patch(p) * dt + ns_veg%deadcrootn_patch(p) = ns_veg%deadcrootn_patch(p) - & + nf_veg%m_deadcrootn_to_litter_fire_patch(p) * dt + + ! storage pools + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - & + nf_veg%m_leafn_storage_to_fire_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - & + nf_veg%m_frootn_storage_to_fire_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - & + nf_veg%m_livestemn_storage_to_fire_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - & + nf_veg%m_deadstemn_storage_to_fire_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - & + nf_veg%m_livecrootn_storage_to_fire_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - & + nf_veg%m_deadcrootn_storage_to_fire_patch(p) * dt + + ns_veg%leafn_storage_patch(p) = ns_veg%leafn_storage_patch(p) - & + nf_veg%m_leafn_storage_to_litter_fire_patch(p) * dt + ns_veg%frootn_storage_patch(p) = ns_veg%frootn_storage_patch(p) - & + nf_veg%m_frootn_storage_to_litter_fire_patch(p) * dt + ns_veg%livestemn_storage_patch(p) = ns_veg%livestemn_storage_patch(p) - & + nf_veg%m_livestemn_storage_to_litter_fire_patch(p) * dt + ns_veg%deadstemn_storage_patch(p) = ns_veg%deadstemn_storage_patch(p) - & + nf_veg%m_deadstemn_storage_to_litter_fire_patch(p) * dt + ns_veg%livecrootn_storage_patch(p) = ns_veg%livecrootn_storage_patch(p) - & + nf_veg%m_livecrootn_storage_to_litter_fire_patch(p) * dt + ns_veg%deadcrootn_storage_patch(p) = ns_veg%deadcrootn_storage_patch(p) - & + nf_veg%m_deadcrootn_storage_to_litter_fire_patch(p) * dt + + + ! transfer pools + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - & + nf_veg%m_leafn_xfer_to_fire_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - & + nf_veg%m_frootn_xfer_to_fire_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - & + nf_veg%m_livestemn_xfer_to_fire_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - & + nf_veg%m_deadstemn_xfer_to_fire_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - & + nf_veg%m_livecrootn_xfer_to_fire_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - & + nf_veg%m_deadcrootn_xfer_to_fire_patch(p) * dt + + ns_veg%leafn_xfer_patch(p) = ns_veg%leafn_xfer_patch(p) - & + nf_veg%m_leafn_xfer_to_litter_fire_patch(p) * dt + ns_veg%frootn_xfer_patch(p) = ns_veg%frootn_xfer_patch(p) - & + nf_veg%m_frootn_xfer_to_litter_fire_patch(p) * dt + ns_veg%livestemn_xfer_patch(p) = ns_veg%livestemn_xfer_patch(p) - & + nf_veg%m_livestemn_xfer_to_litter_fire_patch(p) * dt + ns_veg%deadstemn_xfer_patch(p) = ns_veg%deadstemn_xfer_patch(p) - & + nf_veg%m_deadstemn_xfer_to_litter_fire_patch(p) * dt + ns_veg%livecrootn_xfer_patch(p) = ns_veg%livecrootn_xfer_patch(p) - & + nf_veg%m_livecrootn_xfer_to_litter_fire_patch(p) * dt + ns_veg%deadcrootn_xfer_patch(p) = ns_veg%deadcrootn_xfer_patch(p) - & + nf_veg%m_deadcrootn_xfer_to_litter_fire_patch(p) * dt + + ! retranslocated N pool + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - & + nf_veg%m_retransn_to_fire_patch(p) * dt + ns_veg%retransn_patch(p) = ns_veg%retransn_patch(p) - & + nf_veg%m_retransn_to_litter_fire_patch(p) * dt + end do + + end associate + + end subroutine NStateUpdate3 + +end module CNNStateUpdate3Mod diff --git a/components/clm/src/biogeochem/CNPhenologyMod.F90 b/components/clm/src/biogeochem/CNPhenologyMod.F90 new file mode 100644 index 0000000000..d9a4ed2008 --- /dev/null +++ b/components/clm/src/biogeochem/CNPhenologyMod.F90 @@ -0,0 +1,2600 @@ +module CNPhenologyMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !MODULE: CNPhenologyMod + ! + ! !DESCRIPTION: + ! Module holding routines used in phenology model for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : bounds_type + use clm_varpar , only : numpft, nlevdecomp_full + use clm_varctl , only : iulog, use_cndv + use clm_varcon , only : tfrz + use abortutils , only : endrun + use CanopyStateType , only : canopystate_type + use CNDVType , only : dgvs_type + use CNVegstateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + use CropType , only : crop_type + use pftconMod , only : pftcon + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use ColumnType , only : col + use GridcellType , only : grc + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams ! Read parameters + public :: CNPhenologyInit ! Initialization + public :: CNPhenology ! Update + ! + ! !PRIVATE DATA MEMBERS: + type, private :: params_type + real(r8) :: crit_dayl ! critical day length for senescence + real(r8) :: ndays_on ! number of days to complete leaf onset + real(r8) :: ndays_off ! number of days to complete leaf offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer for each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days to set gdd counter + real(r8) :: crit_onset_swi ! critical number of days > soilpsi_on for onset + real(r8) :: soilpsi_on ! critical soil water potential for leaf onset + real(r8) :: crit_offset_fdd ! critical number of freezing days to initiate offset + real(r8) :: crit_offset_swi ! critical number of water stress days to initiate offset + real(r8) :: soilpsi_off ! critical soil water potential for leaf offset + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + end type params_type + + type(params_type) :: params_inst + + real(r8) :: dt ! radiation time step delta t (seconds) + real(r8) :: fracday ! dtime as a fraction of day + real(r8) :: crit_dayl ! critical daylength for offset (seconds) + real(r8) :: ndays_on ! number of days to complete onset + real(r8) :: ndays_off ! number of days to complete offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer on each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days + real(r8) :: crit_onset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_on ! water potential for onset trigger (MPa) + real(r8) :: crit_offset_fdd ! critical number of freezing degree days to trigger offset + real(r8) :: crit_offset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_off ! water potential for offset trigger (MPa) + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + + ! CropPhenology variables and constants + real(r8) :: p1d, p1v ! photoperiod factor constants for crop vernalization + real(r8) :: hti ! cold hardening index threshold for vernalization + real(r8) :: tbase ! base temperature for vernalization + + integer, parameter :: NOT_Planted = 999 ! If not planted yet in year + integer, parameter :: NOT_Harvested = 999 ! If not harvested yet in year + integer, parameter :: inNH = 1 ! Northern Hemisphere + integer, parameter :: inSH = 2 ! Southern Hemisphere + integer, pointer :: inhemi(:) ! Hemisphere that patch is in + + integer, allocatable :: minplantjday(:,:) ! minimum planting julian day + integer, allocatable :: maxplantjday(:,:) ! maximum planting julian day + integer :: jdayyrstart(inSH) ! julian day of start of year + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNPhenolParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! + ! read in parameters + ! + tString='crit_dayl' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%crit_dayl=tempr + + tString='ndays_on' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%ndays_on=tempr + + tString='ndays_off' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%ndays_off=tempr + + tString='fstor2tran' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%fstor2tran=tempr + + tString='crit_onset_fdd' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%crit_onset_fdd=tempr + + tString='crit_onset_swi' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%crit_onset_swi=tempr + + tString='soilpsi_on' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%soilpsi_on=tempr + + tString='crit_offset_fdd' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%crit_offset_fdd=tempr + + tString='crit_offset_swi' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%crit_offset_swi=tempr + + tString='soilpsi_off' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%soilpsi_off=tempr + + tString='lwtop_ann' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun( msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%lwtop=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + doalb, waterstate_inst, temperature_inst, crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, leaf_prof_patch, froot_prof_patch) + ! + ! !DESCRIPTION: + ! Dynamic phenology routine for coupled carbon-nitrogen code (CN) + ! 1. grass phenology + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + logical , intent(in) :: doalb ! true if time for sfc albedo calc + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + + ! each of the following phenology type routines includes a filter + ! to operate only on the relevant patches + + call CNPhenologyClimate(num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_inst, cnveg_state_inst) + + call CNEvergreenPhenology(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNSeasonDecidPhenology(num_soilp, filter_soilp, & + temperature_inst, cnveg_state_inst, dgvs_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNStressDecidPhenology(num_soilp, filter_soilp, & + soilstate_inst, temperature_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + if (doalb .and. num_pcropp > 0 ) then + call CropPhenology(num_pcropp, filter_pcropp, & + waterstate_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + end if + + ! the same onset and offset routines are called regardless of + ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr + + call CNOnsetGrowth(num_soilp, filter_soilp, & + cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNOffsetLitterfall(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNBackgroundLitterfall(num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + call CNLivewoodTurnover(num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + ! gather all patch-level litterfall fluxes to the column for litter C and N inputs + + call CNLitterToColumn(bounds, num_soilc, filter_soilc, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full), & + froot_prof_patch(bounds%begp:bounds%endp,1:nlevdecomp_full)) + + end subroutine CNPhenology + + !----------------------------------------------------------------------- + subroutine CNPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CNPhenology. Must be called after time-manager is + ! initialized, and after pftcon file is read in. + ! + ! !USES: + use clm_time_manager, only: get_step_size + use clm_varpar , only: crop_prog + use clm_varcon , only: secspday + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + !------------------------------------------------------------------------ + + ! + ! Get time-step and what fraction of a day it is + ! + dt = real( get_step_size(), r8 ) + fracday = dt/secspday + + ! set constants for CNSeasonDecidPhenology + ! (critical daylength from Biome-BGC, v4.1.2) + crit_dayl=params_inst%crit_dayl + + ! Set constants for CNSeasonDecidPhenology and CNStressDecidPhenology + ndays_on=params_inst%ndays_on + ndays_off=params_inst%ndays_off + + ! set transfer parameters + fstor2tran=params_inst%fstor2tran + + ! ----------------------------------------- + ! Constants for CNStressDecidPhenology + ! ----------------------------------------- + + ! onset parameters + crit_onset_fdd=params_inst%crit_onset_fdd + ! critical onset gdd now being calculated as a function of annual + ! average 2m temp. + ! crit_onset_gdd = 150.0 ! c3 grass value + ! crit_onset_gdd = 1000.0 ! c4 grass value + crit_onset_swi=params_inst%crit_onset_swi + soilpsi_on=params_inst%soilpsi_on + + ! offset parameters + crit_offset_fdd=params_inst%crit_offset_fdd + crit_offset_swi=params_inst%crit_offset_swi + soilpsi_off=params_inst%soilpsi_off + + ! ----------------------------------------- + ! Constants for CNLivewoodTurnover + ! ----------------------------------------- + + ! set the global parameter for livewood turnover rate + ! define as an annual fraction (0.7), and convert to fraction per second + lwtop=params_inst%lwtop/31536000.0_r8 !annual fraction converted to per second + + ! ----------------------------------------- + ! Call any subroutine specific initialization routines + ! ----------------------------------------- + + if ( crop_prog ) call CropPhenologyInit(bounds) + + end subroutine CNPhenologyInit + + !----------------------------------------------------------------------- + subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcropp, & + temperature_inst, cnveg_state_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use clm_time_manager , only : get_curr_date, is_first_step + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prognostic crops in filter + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches + type(temperature_type) , intent(inout) :: temperature_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + integer :: nyrs ! number of years prognostic crop has run + real(r8) :: dayspyr ! days per year (days) + integer :: kyr ! current year + integer :: kmo ! month of year (1, ..., 12) + integer :: kda ! day of month (1, ..., 31) + integer :: mcsec ! seconds of day (0, ..., seconds/day) + real(r8), parameter :: yravg = 20.0_r8 ! length of years to average for gdd + real(r8), parameter :: yravgm1 = yravg-1.0_r8 ! minus 1 of above + !----------------------------------------------------------------------- + + associate( & + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2m air temperature (K) + gdd0 => temperature_inst%gdd0_patch , & ! Output: [real(r8) (:) ] growing deg. days base 0 deg C (ddays) + gdd8 => temperature_inst%gdd8_patch , & ! Output: [real(r8) (:) ] " " " " 8 " " " + gdd10 => temperature_inst%gdd10_patch , & ! Output: [real(r8) (:) ] " " " " 10 " " " + gdd020 => temperature_inst%gdd020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd0 (ddays) + gdd820 => temperature_inst%gdd820_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd8 (ddays) + gdd1020 => temperature_inst%gdd1020_patch , & ! Output: [real(r8) (:) ] 20-yr mean of gdd10 (ddays) + + tempavg_t2m => cnveg_state_inst%tempavg_t2m_patch & ! Output: [real(r8) (:) ] temp. avg 2m air temperature (K) + ) + + ! set time steps + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + tempavg_t2m(p) = tempavg_t2m(p) + t_ref2m(p) * (fracday/dayspyr) + end do + + ! + ! The following crop related steps are done here rather than CropPhenology + ! so that they will be completed each time-step rather than with doalb. + ! + ! The following lines come from ibis's climate.f + stats.f + ! gdd SUMMATIONS ARE RELATIVE TO THE PLANTING DATE (see subr. updateAccFlds) + + if (num_pcropp > 0) then + ! get time-related info + call get_curr_date(kyr, kmo, kda, mcsec) + nyrs = cnveg_state_inst%CropRestYear + end if + + do fp = 1,num_pcropp + p = filter_pcropp(fp) + if (kmo == 1 .and. kda == 1 .and. nyrs == 0) then ! YR 1: + gdd020(p) = 0._r8 ! set gdd..20 variables to 0 + gdd820(p) = 0._r8 ! and crops will not be planted + gdd1020(p) = 0._r8 + end if + if (kmo == 1 .and. kda == 1 .and. mcsec == 0) then ! <-- END of EVERY YR: + if (nyrs == 1) then ! <-- END of YR 1 + gdd020(p) = gdd0(p) ! <-- END of YR 1 + gdd820(p) = gdd8(p) ! <-- END of YR 1 + gdd1020(p) = gdd10(p) ! <-- END of YR 1 + end if ! <-- END of YR 1 + gdd020(p) = (yravgm1* gdd020(p) + gdd0(p)) / yravg ! gdd..20 must be long term avgs + gdd820(p) = (yravgm1* gdd820(p) + gdd8(p)) / yravg ! so ignore results for yrs 1 & 2 + gdd1020(p) = (yravgm1* gdd1020(p) + gdd10(p)) / yravg + end if + end do + + end associate + + end subroutine CNPhenologyClimate + + !----------------------------------------------------------------------- + subroutine CNEvergreenPhenology (num_soilp, filter_soilp , & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! cnveg_state_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! + ! !USES: + use clm_varcon , only : secspday + use clm_time_manager , only : get_days_per_year + use clm_varctl , only : CN_evergreen_phenology_opt + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type), intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: dayspyr ! Days per year + integer :: p ! indices + integer :: fp ! lake filter patch index + + real(r8):: tranr + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + evergreen => pftcon%evergreen , & ! Input: binary flag for evergreen leaf habit (0 or 1) + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! InOut: [real(r8) (:)] (gC/m2) dead coarse root C transfer + + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! InOut: [real(r8) (:)] (gN/m2) dead coarse root N transfer + + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! InOut: [real(r8) (:)] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! InOut: [real(r8) (:)] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! InOut: [real(r8) (:)] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! InOut: [real(r8) (:)] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! InOut: [real(r8) (:)] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! InOut: [real(r8) (:)] + + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch , & ! InOut: [real(r8) (:)] + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! InOut: [real(r8) (:)] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! InOut: [real(r8) (:)] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! InOut: [real(r8) (:)] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! InOut: [real(r8) (:)] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! InOut: [real(r8) (:)] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! InOut: [real(r8) (:)] + + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch & ! Output: [real(r8) (:) ] long growing season factor [0-1] + ) + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + bglfr(p) = 1._r8/(leaf_long(ivt(p)) * dayspyr * secspday) + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + end if + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (CN_evergreen_phenology_opt == 1) then + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + + tranr=0.0002_r8 + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = tranr * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = tranr * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = tranr * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = tranr * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = tranr * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = tranr * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = tranr * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = tranr * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = tranr * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = tranr * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = tranr * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = tranr * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = tranr * deadcrootn_storage(p)/dt + end if + + t1 = 1.0_r8 / dt + + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + end if + + !write (iulog,*) 'leafc_storage_to_xfer(p), leafn_storage_to_xfer(p) =', leafc_storage_to_xfer(p), leafn_storage_to_xfer(p) delete later + !write (iulog,*) 'leafc_xfer_to_leafc(p), leafn_xfer_to_leafc(p) =', leafc_xfer_to_leafc(p), leafn_xfer_to_leafn(p) delete later + + end if ! end of if (evergreen(ivt(p)) == 1._r8) then + + end do ! end of pft loop + + end if ! end of if (CN_evergreen_phenology_opt == 1) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + end associate + + end subroutine CNEvergreenPhenology + + !----------------------------------------------------------------------- + subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & + temperature_inst, cnveg_state_inst, dgvs_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! For coupled carbon-nitrogen code (CN). + ! This routine handles the seasonal deciduous phenology code (temperate + ! deciduous vegetation that has only one growing season per year). + ! + ! !USES: + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_PI + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(temperature_type) , intent(in) :: temperature_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g,c,p !indices + integer :: fp !lake filter patch index + real(r8):: ws_flag !winter-summer solstice flag (0 or 1) + real(r8):: crit_onset_gdd !critical onset growing degree-day sum + real(r8):: soilt + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + prev_dayl => grc%prev_dayl , & ! Input: [real(r8) (:) ] daylength from previous time step (s) + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + season_decid => pftcon%season_decid , & ! Input: binary flag for seasonal-deciduous leaf habit (0 or 1) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + pftmayexist => dgvs_inst%pftmayexist_patch , & ! Output: [logical (:) ] exclude seasonal decid patches from tropics + + annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Input: [real(r8) (:) ] annual average 2m air temperature (K) + dormant_flag => cnveg_state_inst%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnveg_state_inst%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnveg_state_inst%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_gdd => cnveg_state_inst%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch & ! Output: [real(r8) (:) ] + ) + + ! start patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (season_decid(ivt(p)) == 1._r8) then + + ! set background litterfall rate, background transfer rate, and + ! long growing season factor to 0 for seasonal deciduous types + bglfr(p) = 0._r8 + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + ! set flag for solstice period (winter->summer = 1, summer->winter = 0) + if (dayl(g) >= prev_dayl(g)) then + ws_flag = 1._r8 + else + ws_flag = 0._r8 + end if + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1.0_r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + if (use_cndv) then + pftmayexist(p) = .true. + end if + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + + onset_flag(p) = 0.0_r8 + onset_counter(p) = 0.0_r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0.0_r8 + frootc_xfer_to_frootc(p) = 0.0_r8 + leafn_xfer_to_leafn(p) = 0.0_r8 + frootn_xfer_to_frootn(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0.0_r8 + deadstemc_xfer_to_deadstemc(p) = 0.0_r8 + livecrootc_xfer_to_livecrootc(p) = 0.0_r8 + deadcrootc_xfer_to_deadcrootc(p) = 0.0_r8 + livestemn_xfer_to_livestemn(p) = 0.0_r8 + deadstemn_xfer_to_deadstemn(p) = 0.0_r8 + livecrootn_xfer_to_livecrootn(p) = 0.0_r8 + deadcrootn_xfer_to_deadcrootn(p) = 0.0_r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0.0_r8 + leafn_xfer(p) = 0.0_r8 + frootc_xfer(p) = 0.0_r8 + frootn_xfer(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0.0_r8 + livestemn_xfer(p) = 0.0_r8 + deadstemc_xfer(p) = 0.0_r8 + deadstemn_xfer(p) = 0.0_r8 + livecrootc_xfer(p) = 0.0_r8 + livecrootn_xfer(p) = 0.0_r8 + deadcrootc_xfer(p) = 0.0_r8 + deadcrootn_xfer(p) = 0.0_r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1.0_r8) then + + ! Test to turn on growing degree-day sum, if off. + ! switch on the growing degree day sum on the winter solstice + + if (onset_gddflag(p) == 0._r8 .and. ws_flag == 1._r8) then + onset_gddflag(p) = 1._r8 + onset_gdd(p) = 0._r8 + end if + + ! Test to turn off growing degree-day sum, if on. + ! This test resets the growing degree day sum if it gets past + ! the summer solstice without reaching the threshold value. + ! In that case, it will take until the next winter solstice + ! before the growing degree-day summation starts again. + + if (onset_gddflag(p) == 1._r8 .and. ws_flag == 0._r8) then + onset_gddflag(p) = 0._r8 + onset_gdd(p) = 0._r8 + end if + + ! if the gdd flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + soilt = t_soisno(c,3) + if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) then + onset_flag(p) = 1.0_r8 + dormant_flag(p) = 0.0_r8 + onset_gddflag(p) = 0.0_r8 + onset_gdd(p) = 0.0_r8 + onset_counter(p) = ndays_on * secspday + + ! move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0.0_r8) then + if (use_cndv) then + ! If days_active > 355, then remove patch in + ! CNDVEstablishment at the end of the year. + ! days_active > 355 is a symptom of seasonal decid. patches occurring in + ! gridcells where dayl never drops below crit_dayl. + ! This results in TLAI>1e4 in a few gridcells. + days_active(p) = days_active(p) + fracday + if (days_active(p) > 355._r8) pftmayexist(p) = .false. + end if + + ! only begin to test for offset daylength once past the summer sol + if (ws_flag == 0._r8 .and. dayl(g) < crit_dayl) then + offset_flag(p) = 1._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + end if ! end if seasonal deciduous + + end do ! end of patch loop + + end associate + + end subroutine CNSeasonDecidPhenology + + !----------------------------------------------------------------------- + subroutine CNStressDecidPhenology (num_soilp, filter_soilp , & + soilstate_inst, temperature_inst, cnveg_state_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! This routine handles phenology for vegetation types, such as grasses and + ! tropical drought deciduous trees, that respond to cold and drought stress + ! signals and that can have multiple growing seasons in a given year. + ! This routine allows for the possibility that leaves might persist year-round + ! in the absence of a suitable stress trigger, by switching to an essentially + ! evergreen habit, but maintaining a deciduous leaf longevity, while waiting + ! for the next stress trigger. This is in contrast to the seasonal deciduous + ! algorithm (for temperate deciduous trees) that forces a single growing season + ! per year. + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use clm_varcon , only : secspday + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_PI + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8),parameter :: secspqtrday = secspday / 4 ! seconds per quarter day + integer :: g,c,p ! indices + integer :: fp ! lake filter patch index + real(r8):: dayspyr ! days per year + real(r8):: crit_onset_gdd ! degree days for onset trigger + real(r8):: soilt ! temperature of top soil layer + real(r8):: psi ! water stress of top soil layer + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + stress_decid => pftcon%stress_decid , & ! Input: binary flag for stress-deciduous leaf habit (0 or 1) + + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + dormant_flag => cnveg_state_inst%dormant_flag_patch , & ! Output: [real(r8) (:) ] dormancy flag + days_active => cnveg_state_inst%days_active_patch , & ! Output: [real(r8) (:) ] number of days since last dormancy + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter (seconds) + onset_gddflag => cnveg_state_inst%onset_gddflag_patch , & ! Output: [real(r8) (:) ] onset freeze flag + onset_fdd => cnveg_state_inst%onset_fdd_patch , & ! Output: [real(r8) (:) ] onset freezing degree days counter + onset_gdd => cnveg_state_inst%onset_gdd_patch , & ! Output: [real(r8) (:) ] onset growing degree days + onset_swi => cnveg_state_inst%onset_swi_patch , & ! Output: [real(r8) (:) ] onset soil water index + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter (seconds) + offset_fdd => cnveg_state_inst%offset_fdd_patch , & ! Output: [real(r8) (:) ] offset freezing degree days counter + offset_swi => cnveg_state_inst%offset_swi_patch , & ! Output: [real(r8) (:) ] offset soil water index + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + annavg_t2m => cnveg_state_inst%annavg_t2m_patch , & ! Output: [real(r8) (:) ] annual average 2m air temperature (K) + + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:) ] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + leafc_storage_to_xfer => cnveg_carbonflux_inst%leafc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootc_storage_to_xfer => cnveg_carbonflux_inst%frootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemc_storage_to_xfer => cnveg_carbonflux_inst%livestemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemc_storage_to_xfer => cnveg_carbonflux_inst%deadstemc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootc_storage_to_xfer => cnveg_carbonflux_inst%livecrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootc_storage_to_xfer => cnveg_carbonflux_inst%deadcrootc_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + gresp_storage_to_xfer => cnveg_carbonflux_inst%gresp_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + leafn_storage_to_xfer => cnveg_nitrogenflux_inst%leafn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + frootn_storage_to_xfer => cnveg_nitrogenflux_inst%frootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livestemn_storage_to_xfer => cnveg_nitrogenflux_inst%livestemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadstemn_storage_to_xfer => cnveg_nitrogenflux_inst%deadstemn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + livecrootn_storage_to_xfer => cnveg_nitrogenflux_inst%livecrootn_storage_to_xfer_patch , & ! Output: [real(r8) (:) ] + deadcrootn_storage_to_xfer => cnveg_nitrogenflux_inst%deadcrootn_storage_to_xfer_patch & ! Output: [real(r8) (:) ] + ) + + ! set time steps + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (stress_decid(ivt(p)) == 1._r8) then + soilt = t_soisno(c,3) + psi = soilpsi(c,3) + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1._r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0._r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + onset_flag(p) = 0._r8 + onset_counter(p) = 0._r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0._r8 + frootc_xfer_to_frootc(p) = 0._r8 + leafn_xfer_to_leafn(p) = 0._r8 + frootn_xfer_to_frootn(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0._r8 + deadstemc_xfer_to_deadstemc(p) = 0._r8 + livecrootc_xfer_to_livecrootc(p) = 0._r8 + deadcrootc_xfer_to_deadcrootc(p) = 0._r8 + livestemn_xfer_to_livestemn(p) = 0._r8 + deadstemn_xfer_to_deadstemn(p) = 0._r8 + livecrootn_xfer_to_livecrootn(p) = 0._r8 + deadcrootn_xfer_to_deadcrootn(p) = 0._r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = 0._r8 + frootc_xfer(p) = 0._r8 + frootn_xfer(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0._r8 + livestemn_xfer(p) = 0._r8 + deadstemc_xfer(p) = 0._r8 + deadstemn_xfer(p) = 0._r8 + livecrootc_xfer(p) = 0._r8 + livecrootn_xfer(p) = 0._r8 + deadcrootc_xfer(p) = 0._r8 + deadcrootn_xfer(p) = 0._r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1._r8) then + + ! keep track of the number of freezing degree days in this + ! dormancy period (only if the freeze flag has not previously been set + ! for this dormancy period + + if (onset_gddflag(p) == 0._r8 .and. soilt < SHR_CONST_TKFRZ) onset_fdd(p) = onset_fdd(p) + fracday + + ! if the number of freezing degree days exceeds a critical value, + ! then onset will require both wet soils and a critical soil + ! temperature sum. If this case is triggered, reset any previously + ! accumulated value in onset_swi, so that onset now depends on + ! the accumulated soil water index following the freeze trigger + + if (onset_fdd(p) > crit_onset_fdd) then + onset_gddflag(p) = 1._r8 + onset_fdd(p) = 0._r8 + onset_swi(p) = 0._r8 + end if + + ! if the freeze flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + if (onset_gddflag(p) == 1._r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! if soils are wet, accumulate soil water index for onset trigger + if (psi >= soilpsi_on) onset_swi(p) = onset_swi(p) + fracday + + ! if critical soil water index is exceeded, set onset_flag, and + ! then test for soil temperature criteria + + if (onset_swi(p) > crit_onset_swi) then + onset_flag(p) = 1._r8 + + ! only check soil temperature criteria if freeze flag set since + ! beginning of last dormancy. If freeze flag set and growing + ! degree day sum (since freeze trigger) is lower than critical + ! value, then override the onset_flag set from soil water. + + if (onset_gddflag(p) == 1._r8 .and. onset_gdd(p) < crit_onset_gdd) onset_flag(p) = 0._r8 + end if + + ! only allow onset if dayl > 6hrs + if (onset_flag(p) == 1._r8 .and. dayl(g) <= secspqtrday) then + onset_flag(p) = 0._r8 + end if + + ! if this is the beginning of the onset period + ! then reset the phenology flags and indices + + if (onset_flag(p) == 1._r8) then + dormant_flag(p) = 0._r8 + days_active(p) = 0._r8 + onset_gddflag(p) = 0._r8 + onset_fdd(p) = 0._r8 + onset_gdd(p) = 0._r8 + onset_swi(p) = 0._r8 + onset_counter(p) = ndays_on * secspday + + ! call subroutine to move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0._r8) then + + ! if soil water potential lower than critical value, accumulate + ! as stress in offset soil water index + + if (psi <= soilpsi_off) then + offset_swi(p) = offset_swi(p) + fracday + + ! if the offset soil water index exceeds critical value, and + ! if this is not the middle of a previously initiated onset period, + ! then set flag to start the offset period and reset index variables + + if (offset_swi(p) >= crit_offset_swi .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + + ! if soil water potential higher than critical value, reduce the + ! offset water stress index. By this mechanism, there must be a + ! sustained period of water stress to initiate offset. + + else if (psi >= soilpsi_on) then + offset_swi(p) = offset_swi(p) - fracday + offset_swi(p) = max(offset_swi(p),0._r8) + end if + + ! decrease freezing day accumulator for warm soil + if (offset_fdd(p) > 0._r8 .and. soilt > SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) - fracday + offset_fdd(p) = max(0._r8, offset_fdd(p)) + end if + + ! increase freezing day accumulator for cold soil + if (soilt <= SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) + fracday + + ! if freezing degree day sum is greater than critical value, initiate offset + if (offset_fdd(p) > crit_offset_fdd .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + end if + + ! force offset if daylength is < 6 hrs + if (dayl(g) <= secspqtrday) then + offset_flag(p) = 1._r8 + end if + + ! if this is the beginning of the offset period + ! then reset flags and indices + if (offset_flag(p) == 1._r8) then + offset_fdd(p) = 0._r8 + offset_swi(p) = 0._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! keep track of number of days since last dormancy for control on + ! fraction of new growth to send to storage for next growing season + + if (dormant_flag(p) == 0.0_r8) then + days_active(p) = days_active(p) + fracday + end if + + ! calculate long growing season factor (lgsf) + ! only begin to calculate a lgsf greater than 0.0 once the number + ! of days active exceeds days/year. + lgsf(p) = max(min((days_active(p)-dayspyr)/dayspyr, 1._r8),0._r8) + + ! set background litterfall rate, when not in the phenological offset period + if (offset_flag(p) == 1._r8) then + bglfr(p) = 0._r8 + else + ! calculate the background litterfall rate (bglfr) + ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season + + bglfr(p) = (1._r8/(leaf_long(ivt(p))*dayspyr*secspday))*lgsf(p) + end if + + ! set background transfer rate when active but not in the phenological onset period + if (onset_flag(p) == 1._r8) then + bgtr(p) = 0._r8 + else + ! the background transfer rate is calculated as the rate that would result + ! in complete turnover of the storage pools in one year at steady state, + ! once lgsf has reached 1.0 (after 730 days active). + + bgtr(p) = (1._r8/(dayspyr*secspday))*lgsf(p) + + ! set carbon fluxes for shifting storage pools to transfer pools + + leafc_storage_to_xfer(p) = leafc_storage(p) * bgtr(p) + frootc_storage_to_xfer(p) = frootc_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * bgtr(p) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * bgtr(p) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * bgtr(p) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * bgtr(p) + gresp_storage_to_xfer(p) = gresp_storage(p) * bgtr(p) + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = leafn_storage(p) * bgtr(p) + frootn_storage_to_xfer(p) = frootn_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * bgtr(p) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * bgtr(p) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * bgtr(p) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * bgtr(p) + end if + end if + + end if ! end if stress deciduous + + end do ! end of patch loop + + end associate + + end subroutine CNStressDecidPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenology(num_pcropp, filter_pcropp , & + waterstate_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst , & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + ! !DESCRIPTION: + ! Code from AgroIBIS to determine crop phenology and code from CN to + ! handle CN fluxes during the phenological onset & offset periods. + + ! !USES: + use clm_time_manager , only : get_curr_date, get_curr_calday, get_days_per_year + use pftconMod , only : ntmp_corn, nswheat, nwwheat, ntmp_soybean + use pftconMod , only : nirrig_tmp_corn, nirrig_swheat, nirrig_wwheat, nirrig_tmp_soybean + use pftconMod , only : ntrp_corn, nsugarcane, ntrp_soybean, ncotton, nrice + use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane, nirrig_trp_soybean + use pftconMod , only : nirrig_cotton, nirrig_rice + use clm_varcon , only : spval, secspday + ! + ! !ARGUMENTS: + integer , intent(in) :: num_pcropp ! number of prog crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! LOCAL VARAIBLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + integer jday ! julian day of the year + integer fp,p ! patch indices + integer c ! column indices + integer g ! gridcell indices + integer h ! hemisphere indices + integer idpp ! number of days past planting + real(r8) dayspyr ! days per year + real(r8) crmcorn ! comparitive relative maturity for corn + real(r8) ndays_on ! number of days to fertilize + !------------------------------------------------------------------------ + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leaf_long => pftcon%leaf_long , & ! Input: leaf longevity (yrs) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + fertnitro => pftcon%fertnitro , & ! Input: max fertilizer to be applied in total (kgN/m2) + mxmat => pftcon%mxmat , & ! Input: + minplanttemp => pftcon%minplanttemp , & ! Input: + planttemp => pftcon%planttemp , & ! Input: + gddmin => pftcon%gddmin , & ! Input: + hybgdd => pftcon%hybgdd , & ! Input: + lfemerg => pftcon%lfemerg , & ! Input: + grnfill => pftcon%grnfill , & ! Input: + + t_ref2m_min => temperature_inst%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + a5tmin => temperature_inst%t_a5min_patch , & ! Input: [real(r8) (:) ] 5-day running mean of min 2-m temperature + a10tmin => temperature_inst%t_a10min_patch , & ! Input: [real(r8) (:) ] 10-day running mean of min 2-m temperature + gdd020 => temperature_inst%gdd020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd0 + gdd820 => temperature_inst%gdd820_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd8 + gdd1020 => temperature_inst%gdd1020_patch , & ! Input: [real(r8) (:) ] 20 yr mean of gdd10 + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] gdd from top soil layer temperature + + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + idop => cnveg_state_inst%idop_patch , & ! Output: [integer (:) ] date of planting + harvdate => cnveg_state_inst%harvdate_patch , & ! Output: [integer (:) ] harvest date + croplive => cnveg_state_inst%croplive_patch , & ! Output: [logical (:) ] Flag, true if planted, not harvested + cropplant => cnveg_state_inst%cropplant_patch , & ! Output: [logical (:) ] Flag, true if crop may be planted + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Output: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Output: [real(r8) (:) ] same to reach vegetative maturity + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + hdidx => cnveg_state_inst%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + vf => cnveg_state_inst%vf_patch , & ! Output: [real(r8) (:) ] vernalization factor + bglfr => cnveg_state_inst%bglfr_patch , & ! Output: [real(r8) (:) ] background litterfall rate (1/s) + bgtr => cnveg_state_inst%bgtr_patch , & ! Output: [real(r8) (:) ] background transfer growth rate (1/s) + lgsf => cnveg_state_inst%lgsf_patch , & ! Output: [real(r8) (:) ] long growing season factor [0-1] + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Output: [real(r8) (:) ] onset flag + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Output: [real(r8) (:) ] offset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Output: [real(r8) (:) ] onset counter + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Output: [real(r8) (:) ] offset counter + + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer + + dwt_seedc_to_leaf => cnveg_carbonflux_inst%dwt_seedc_to_leaf_col , & ! Output: [real(r8) (:) ] (gC/m2/s) seed source to patch-level + + fert_counter => cnveg_nitrogenflux_inst%fert_counter_patch , & ! Output: [real(r8) (:) ] >0 fertilize; <=0 not (seconds) + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer + dwt_seedn_to_leaf => cnveg_nitrogenflux_inst%dwt_seedn_to_leaf_col , & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to patch-level + fert => cnveg_nitrogenflux_inst%fert_patch & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + ) + + ! get time info + dayspyr = get_days_per_year() + jday = get_curr_calday() + call get_curr_date(kyr, kmo, kda, mcsec) + + ndays_on = 20._r8 ! number of days to fertilize + + do fp = 1, num_pcropp + p = filter_pcropp(fp) + c = patch%column(p) + g = patch%gridcell(p) + h = inhemi(p) + + ! background litterfall and transfer rates; long growing season factor + + bglfr(p) = 0._r8 ! this value changes later in a crop's life cycle + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! --------------------------------- + ! from AgroIBIS subroutine planting + ! --------------------------------- + + ! in order to allow a crop to be planted only once each year + ! initialize cropplant = .false., but hold it = .true. through the end of the year + + ! initialize other variables that are calculated for crops + ! on an annual basis in cropresidue subroutine + + if ( jday == jdayyrstart(h) .and. mcsec == 0 )then + + ! make sure variables aren't changed at beginning of the year + ! for a crop that is currently planted, such as + ! WINTER TEMPERATE CEREAL = winter (wheat + barley + rye) + ! represented here by the winter wheat pft + + if (.not. croplive(p)) then + cropplant(p) = .false. + idop(p) = NOT_Planted + + ! keep next for continuous, annual winter temperate cereal crop; + ! if we removed elseif, + ! winter cereal grown continuously would amount to a cereal/fallow + ! rotation because cereal would only be planted every other year + + else if (croplive(p) .and. (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then + cropplant(p) = .false. + ! else ! not possible to have croplive and ivt==cornORsoy? (slevis) + end if + + end if + + if ( (.not. croplive(p)) .and. (.not. cropplant(p)) ) then + + ! gdd needed for * chosen crop and a likely hybrid (for that region) * + ! to reach full physiological maturity + + ! based on accumulated seasonal average growing degree days from + ! April 1 - Sept 30 (inclusive) + ! for corn and soybeans in the United States - + ! decided upon by what the typical average growing season length is + ! and the gdd needed to reach maturity in those regions + + ! first choice is used for spring temperate cereal and/or soybeans and maize + + ! slevis: ibis reads xinpdate in io.f from control.crops.nc variable name 'plantdate' + ! According to Chris Kucharik, the dataset of + ! xinpdate was generated from a previous model run at 0.5 deg resolution + + ! winter temperate cereal : use gdd0 as a limit to plant winter cereal + + if (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat) then + + ! add check to only plant winter cereal after other crops (soybean, maize) + ! have been harvested + + ! *** remember order of planting is crucial - in terms of which crops you want + ! to be grown in what order *** + + ! in this case, corn or soybeans are assumed to be planted before + ! cereal would be in any particular year that both patches are allowed + ! to grow in the same grid cell (e.g., double-cropping) + + ! slevis: harvdate below needs cropplant(p) above to be cropplant(p,ivt(p)) + ! where ivt(p) has rotated to winter cereal because + ! cropplant through the end of the year for a harvested crop. + ! Also harvdate(p) should be harvdate(p,ivt(p)) and should be + ! updated on Jan 1st instead of at harvest (slevis) + if (a5tmin(p) /= spval .and. & + a5tmin(p) <= minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + (gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p)))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + ! latest possible date to plant winter cereal and after all other + ! crops were harvested for that year + + else if (jday >= maxplantjday(ivt(p),h) .and. & + gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + else + gddmaturity(p) = 0._r8 + end if + + else ! not winter cereal... slevis: added distinction between NH and SH + ! slevis: The idea is that jday will equal idop sooner or later in the year + ! while the gdd part is either true or false for the year. + if (t10(p) /= spval.and. a10tmin(p) /= spval .and. & + t10(p) > planttemp(ivt(p)) .and. & + a10tmin(p) > minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + jday <= maxplantjday(ivt(p),h) .and. & + t10(p) /= spval .and. a10tmin(p) /= spval .and. & + gdd820(p) /= spval .and. & + gdd820(p) >= gddmin(ivt(p))) then + + ! impose limit on growing season length needed + ! for crop maturity - for cold weather constraints + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + ! go a specified amount of time before/after + ! climatological date + if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & + ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) + end if + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then + gddmaturity(p) = max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + gddmaturity(p) = max(950._r8, min(gddmaturity(p)+150._r8, 1850._r8)) + end if + if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & + ivt(p) == nrice .or. ivt(p) == nirrig_rice) then + gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) + end if + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + ! If hit the max planting julian day -- go ahead and plant + else if (jday == maxplantjday(ivt(p),h) .and. gdd820(p) > 0._r8 .and. & + gdd820(p) /= spval ) then + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & + ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) + end if + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then + gddmaturity(p) = max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + end if + if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & + ivt(p) == nrice .or. ivt(p) == nirrig_rice) then + gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) + end if + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + else + gddmaturity(p) = 0._r8 + end if + end if ! crop patch distinction + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! calculate threshold from phase 1 to phase 2: + ! threshold for attaining leaf emergence (based on fraction of + ! gdd(i) -- climatological average) + ! Hayhoe and Dwyer, 1990, Can. J. Soil Sci 70:493-497 + ! Carlson and Gage, 1989, Agric. For. Met., 45: 313-324 + ! J.T. Ritchie, 1991: Modeling Plant and Soil systems + + huileaf(p) = lfemerg(ivt(p)) * gddmaturity(p) ! 3-7% in cereal + + ! calculate threshhold from phase 2 to phase 3: + ! from leaf emergence to beginning of grain-fill period + ! this hypothetically occurs at the end of tassling, not the beginning + ! tassel initiation typically begins at 0.5-0.55 * gddmaturity + + ! calculate linear relationship between huigrain fraction and relative + ! maturity rating for maize + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then + ! the following estimation of crmcorn from gddmaturity is based on a linear + ! regression using data from Pioneer-brand corn hybrids (Kucharik, 2003, + ! Earth Interactions 7:1-33: fig. 2) + crmcorn = max(73._r8, min(135._r8, (gddmaturity(p)+ 53.683_r8)/13.882_r8)) + + ! the following adjustment of grnfill based on crmcorn is based on a tuning + ! of Agro-IBIS to give reasonable results for max LAI and the seasonal + ! progression of LAI growth (pers. comm. C. Kucharik June 10, 2010) + huigrain(p) = -0.002_r8 * (crmcorn - 73._r8) + grnfill(ivt(p)) + + huigrain(p) = min(max(huigrain(p), grnfill(ivt(p))-0.1_r8), grnfill(ivt(p))) + huigrain(p) = huigrain(p) * gddmaturity(p) ! Cabelguenne et + else + huigrain(p) = grnfill(ivt(p)) * gddmaturity(p) ! al. 1999 + end if + + end if ! crop not live nor planted + + ! ---------------------------------- + ! from AgroIBIS subroutine phenocrop + ! ---------------------------------- + + ! all of the phenology changes are based on the total number of gdd needed + ! to change to the next phase - based on fractions of the total gdd typical + ! for that region based on the April 1 - Sept 30 window of development + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! Phase 1: Planting to leaf emergence (now in CNAllocation) + ! Phase 2: Leaf emergence to beginning of grain fill (general LAI accumulation) + ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline) + ! Harvest: if gdd past grain fill initiation exceeds limit + ! or number of days past planting reaches a maximum, the crop has + ! reached physiological maturity and plant is harvested; + ! crop could be live or dead at this stage - these limits + ! could lead to reaching physiological maturity or determining + ! a harvest date for a crop killed by an early frost (see next comments) + ! --- --- --- + ! keeping comments without the code (slevis): + ! if minimum temperature, t_ref2m_min <= freeze kill threshold, tkill + ! for 3 consecutive days and lai is above a minimum, + ! plant will be damaged/killed. This function is more for spring freeze events + ! or for early fall freeze events + + ! spring temperate cereal is affected by this, winter cereal kill function + ! is determined in crops.f - is a more elaborate function of + ! cold hardening of the plant + + ! currently simulates too many grid cells killed by freezing temperatures + + ! removed on March 12 2002 - C. Kucharik + ! until it can be a bit more refined, or used at a smaller scale. + ! we really have no way of validating this routine + ! too difficult to implement on 0.5 degree scale grid cells + ! --- --- --- + + onset_flag(p) = 0._r8 ! CN terminology to trigger certain + offset_flag(p) = 0._r8 ! carbon and nitrogen transfers + + if (croplive(p)) then + + ! call vernalization if winter temperate cereal planted, living, and the + ! vernalization factor is not 1; + ! vf affects the calculation of gddtsoi & gddplant + + if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. & + (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then + call vernalization(p, & + canopystate_inst, temperature_inst, waterstate_inst, cnveg_state_inst) + end if + + ! days past planting may determine harvest + + if (jday >= idop(p)) then + idpp = jday - idop(p) + else + idpp = int(dayspyr) + jday - idop(p) + end if + + ! onset_counter initialized to zero when .not. croplive + ! offset_counter relevant only at time step of harvest + + onset_counter(p) = onset_counter(p) - dt + + ! enter phase 2 onset for one time step: + ! transfer seed carbon to leaf emergence + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then + if (abs(onset_counter(p)) > 1.e-6_r8) then + onset_flag(p) = 1._r8 + onset_counter(p) = dt + fert_counter(p) = ndays_on * secspday + fert(p) = fertnitro(ivt(p)) * 1000._r8 / fert_counter(p) + else + ! this ensures no re-entry to onset of phase2 + ! b/c onset_counter(p) = onset_counter(p) - dt + ! at every time step + + onset_counter(p) = dt + end if + + ! enter harvest for one time step: + ! - transfer live biomass to litter and to crop yield + ! - send xsmrpool to the atmosphere + ! if onset and harvest needed to last longer than one timestep + ! the onset_counter would change from dt and you'd need to make + ! changes to the offset subroutine below + + else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then + if (harvdate(p) >= NOT_Harvested) harvdate(p) = jday + croplive(p) = .false. ! no re-entry in greater if-block + if (tlai(p) > 0._r8) then ! plant had emerged before harvest + offset_flag(p) = 1._r8 + offset_counter(p) = dt + else ! plant never emerged from the ground + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt + leafc_xfer(p) = 0._r8 ! revert planting transfers + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + end if + + ! enter phase 3 while previous criteria fail and next is true; + ! in terms of order, phase 3 occurs before harvest, but when + ! harvest *can* occur, we want it to have first priority. + ! AgroIBIS uses a complex formula for lai decline. + ! Use CN's simple formula at least as a place holder (slevis) + + else if (hui(p) >= huigrain(p)) then + bglfr(p) = 1._r8/(leaf_long(ivt(p))*dayspyr*secspday) + end if + + ! continue fertilizer application while in phase 2; + ! assumes that onset of phase 2 took one time step only + + if (fert_counter(p) <= 0._r8) then + fert(p) = 0._r8 + else ! continue same fert application every timestep + fert_counter(p) = fert_counter(p) - dt + end if + + else ! crop not live + ! next 2 lines conserve mass if leaf*_xfer > 0 due to interpinic + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt + onset_counter(p) = 0._r8 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + end if ! croplive + + end do ! prognostic crops loop + + end associate + + end subroutine CropPhenology + + !----------------------------------------------------------------------- + subroutine CropPhenologyInit(bounds) + ! + ! !DESCRIPTION: + ! Initialization of CropPhenology. Must be called after time-manager is + ! initialized, and after pftcon file is read in. + ! + ! !USES: + use pftconMod , only: npcropmin, npcropmax, npcropmaxknown + use clm_time_manager, only: get_calday + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! LOCAL VARAIBLES: + integer :: p,g,n,i ! indices + !------------------------------------------------------------------------ + + allocate( inhemi(bounds%begp:bounds%endp) ) + + allocate( minplantjday(0:numpft,inSH)) ! minimum planting julian day + allocate( maxplantjday(0:numpft,inSH)) ! minimum planting julian day + + ! Julian day for the start of the year (mid-winter) + jdayyrstart(inNH) = 1 + jdayyrstart(inSH) = 182 + + ! Convert planting dates into julian day + minplantjday(:,:) = huge(1) + maxplantjday(:,:) = huge(1) + do n = npcropmin, npcropmaxknown + if (pftcon%mergetoclmpft(n) >= npcropmin) then + minplantjday(n, inNH) = int( get_calday( pftcon%mnNHplantdate(n), 0 ) ) + maxplantjday(n, inNH) = int( get_calday( pftcon%mxNHplantdate(n), 0 ) ) + + minplantjday(n, inSH) = int( get_calday( pftcon%mnSHplantdate(n), 0 ) ) + maxplantjday(n, inSH) = int( get_calday( pftcon%mxSHplantdate(n), 0 ) ) + end if + end do + + ! Figure out what hemisphere each PATCH is in + do p = bounds%begp, bounds%endp + g = patch%gridcell(p) + ! Northern hemisphere + if ( grc%latdeg(g) > 0.0_r8 )then + inhemi(p) = inNH + else + inhemi(p) = inSH + end if + end do + + ! + ! Constants for Crop vernalization + ! + ! photoperiod factor calculation + ! genetic constant - can be modified + + p1d = 0.004_r8 ! average for genotypes from Ritchey, 1991. + ! Modeling plant & soil systems: Wheat phasic developmt + p1v = 0.003_r8 ! average for genotypes from Ritchey, 1991. + + hti = 1._r8 + tbase = 0._r8 + + end subroutine CropPhenologyInit + + !----------------------------------------------------------------------- + subroutine vernalization(p, & + canopystate_inst, temperature_inst, waterstate_inst, cnveg_state_inst) + ! + ! !DESCRIPTION: + ! + ! * * * only call for winter temperate cereal * * * + ! + ! subroutine calculates vernalization and photoperiod effects on + ! gdd accumulation in winter temperate cereal varieties. Thermal time accumulation + ! is reduced in 1st period until plant is fully vernalized. During this + ! time of emergence to spikelet formation, photoperiod can also have a + ! drastic effect on plant development. + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! PATCH index running over + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + ! + ! LOCAL VARAIBLES: + real(r8) tcrown ! ? + real(r8) vd, vd1, vd2 ! vernalization dependence + real(r8) tkil ! Freeze kill threshold + integer c,g ! indices + !------------------------------------------------------------------------ + + associate( & + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (K) + t_ref2m_min => temperature_inst%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) + t_ref2m_max => temperature_inst%t_ref2m_max_patch , & ! Input: [real(r8) (:) ] daily maximum of average 2 m height surface air temperature (K) + + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + hdidx => cnveg_state_inst%hdidx_patch , & ! Output: [real(r8) (:) ] cold hardening index? + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:) ] cumulative vernalization d?ependence? + vf => cnveg_state_inst%vf_patch , & ! Output: [real(r8) (:) ] vernalization factor for cereal + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Output: [real(r8) (:) ] gdd needed to harvest + huigrain => cnveg_state_inst%huigrain_patch & ! Output: [real(r8) (:) ] heat unit index needed to reach vegetative maturity + ) + + c = patch%column(p) + + ! for all equations - temperatures must be in degrees (C) + ! calculate temperature of crown of crop (e.g., 3 cm soil temperature) + ! snow depth in centimeters + + if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K) + tcrown = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snow_depth(c)*100._r8, 15._r8) - 15._r8)**2) + else !slevis: snow_depth inst of adsnod=daily average (m) + tcrown = t_ref2m(p) - tfrz + end if + + ! vernalization factor calculation + ! if vf(p) = 1. then plant is fully vernalized - and thermal time + ! accumulation in phase 1 will be unaffected + ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis) + ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis) + + if (t_ref2m_max(p) > tfrz) then + if (t_ref2m_min(p) <= tfrz+15._r8) then + vd1 = 1.4_r8 - 0.0778_r8 * tcrown + vd2 = 0.5_r8 + 13.44_r8 / ((t_ref2m_max(p)-t_ref2m_min(p)+3._r8)**2) * tcrown + vd = max(0._r8, min(1._r8, vd1, vd2)) + cumvd(p) = cumvd(p) + vd + end if + + if (cumvd(p) < 10._r8 .and. t_ref2m_max(p) > tfrz+30._r8) then + cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8) + end if + cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + + vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p)) + vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + end if + + ! calculate cold hardening of plant + ! determines for winter cereal varieties whether the plant has completed + ! a period of cold hardening to protect it from freezing temperatures. If + ! not, then exposure could result in death or killing of plants. + + ! there are two distinct phases of hardening + + if (t_ref2m_min(p) <= tfrz-3._r8 .or. hdidx(p) /= 0._r8) then + if (hdidx(p) >= hti) then ! done with phase 1 + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + + else if (tcrown >= tbase-1._r8) then + if (tcrown <= tbase+8._r8) then + hdidx(p) = hdidx(p) + 0.1_r8 - (tcrown-tbase+3.5_r8)**2 / 506._r8 + if (hdidx(p) >= hti .and. tcrown <= tbase + 0._r8) then + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + end if + + ! calculate what the cereal killing temperature + ! there is a linear inverse relationship between + ! hardening of the plant and the killing temperature or + ! threshold that the plant can withstand + ! when plant is fully-hardened (hdidx = 2), the killing threshold is -18 C + + ! will have to develop some type of relationship that reduces LAI and + ! biomass pools in response to cold damaged crop + + if (t_ref2m_min(p) <= tfrz - 6._r8) then + tkil = (tbase - 6._r8) - 6._r8 * hdidx(p) + if (tkil >= tcrown) then + if ((0.95_r8 - 0.02_r8 * (tcrown - tkil)**2) >= 0.02_r8) then + write (iulog,*) 'crop damaged by cold temperatures at p,c =', p,c + else if (tlai(p) > 0._r8) then ! slevis: kill if past phase1 + gddmaturity(p) = 0._r8 ! by forcing through + huigrain(p) = 0._r8 ! harvest + write (iulog,*) '95% of crop killed by cold temperatures at p,c =', p,c + end if + end if + end if + + end associate + + end subroutine vernalization + + !----------------------------------------------------------------------- + subroutine CNOnsetGrowth (num_soilp, filter_soilp, & + cnveg_state_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of stored C and N from transfer pools to display + ! pools during the phenological onset period. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: t1 ! temporary variable + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + + onset_flag => cnveg_state_inst%onset_flag_patch , & ! Input: [real(r8) (:) ] onset flag + onset_counter => cnveg_state_inst%onset_counter_patch , & ! Input: [real(r8) (:) ] onset days counter + bgtr => cnveg_state_inst%bgtr_patch , & ! Input: [real(r8) (:) ] background transfer growth rate (1/s) + + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + + leafc_xfer_to_leafc => cnveg_carbonflux_inst%leafc_xfer_to_leafc_patch , & ! Output: [real(r8) (:) ] + frootc_xfer_to_frootc => cnveg_carbonflux_inst%frootc_xfer_to_frootc_patch , & ! Output: [real(r8) (:) ] + livestemc_xfer_to_livestemc => cnveg_carbonflux_inst%livestemc_xfer_to_livestemc_patch , & ! Output: [real(r8) (:) ] + deadstemc_xfer_to_deadstemc => cnveg_carbonflux_inst%deadstemc_xfer_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_xfer_to_livecrootc => cnveg_carbonflux_inst%livecrootc_xfer_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + deadcrootc_xfer_to_deadcrootc => cnveg_carbonflux_inst%deadcrootc_xfer_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + leafn_xfer_to_leafn => cnveg_nitrogenflux_inst%leafn_xfer_to_leafn_patch , & ! Output: [real(r8) (:) ] + frootn_xfer_to_frootn => cnveg_nitrogenflux_inst%frootn_xfer_to_frootn_patch , & ! Output: [real(r8) (:) ] + livestemn_xfer_to_livestemn => cnveg_nitrogenflux_inst%livestemn_xfer_to_livestemn_patch , & ! Output: [real(r8) (:) ] + deadstemn_xfer_to_deadstemn => cnveg_nitrogenflux_inst%deadstemn_xfer_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livecrootn_xfer_to_livecrootn => cnveg_nitrogenflux_inst%livecrootn_xfer_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + deadcrootn_xfer_to_deadcrootn => cnveg_nitrogenflux_inst%deadcrootn_xfer_to_deadcrootn_patch & ! Output: [real(r8) (:) ] + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes during onset period + if (onset_flag(p) == 1._r8) then + + ! The transfer rate is a linearly decreasing function of time, + ! going to zero on the last timestep of the onset period + + if (onset_counter(p) == dt) then + t1 = 1.0_r8 / dt + else + t1 = 2.0_r8 / (onset_counter(p)) + end if + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + end if + + end if ! end if onset period + + ! calculate the background rate of transfer growth (used for stress + ! deciduous algorithm). In this case, all of the mass in the transfer + ! pools should be moved to displayed growth in each timestep. + + if (bgtr(p) > 0._r8) then + leafc_xfer_to_leafc(p) = leafc_xfer(p) / dt + frootc_xfer_to_frootc(p) = frootc_xfer(p) / dt + leafn_xfer_to_leafn(p) = leafn_xfer(p) / dt + frootn_xfer_to_frootn(p) = frootn_xfer(p) / dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) / dt + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) / dt + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) / dt + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) / dt + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) / dt + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) / dt + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) / dt + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) / dt + end if + end if ! end if bgtr + + end do ! end patch loop + + end associate + + end subroutine CNOnsetGrowth + + !----------------------------------------------------------------------- + subroutine CNOffsetLitterfall (num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools during the phenological offset period. + ! + ! !USES: + use pftconMod, only : npcropmin + use clm_varctl , only : CNratio_floating + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p, c ! indices + integer :: fp ! lake filter patch index + real(r8):: t1 ! temporary variable + real(r8) :: ntovr_leaf + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + lflitcn => pftcon%lflitcn , & ! Input: leaf litter C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + + offset_flag => cnveg_state_inst%offset_flag_patch , & ! Input: [real(r8) (:) ] offset flag + offset_counter => cnveg_state_inst%offset_counter_patch , & ! Input: [real(r8) (:) ] offset days counter + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + grainc => cnveg_carbonstate_inst%grainc_patch , & ! Input: [real(r8) (:) ] (gC/m2) grain C + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) livestem C + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) livestem N + + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Input: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Input: [real(r8) (:) ] allocation to live stem C (gC/m2/s) + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Input: [real(r8) (:) ] allocation to leaf C (gC/m2/s) + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Input: [real(r8) (:) ] allocation to fine root C (gC/m2/s) + prev_leafc_to_litter => cnveg_carbonflux_inst%prev_leafc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep leaf C litterfall flux (gC/m2/s) + prev_frootc_to_litter => cnveg_carbonflux_inst%prev_frootc_to_litter_patch , & ! Output: [real(r8) (:) ] previous timestep froot C litterfall flux (gC/m2/s) + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] fine root C litterfall (gC/m2/s) + livestemc_to_litter => cnveg_carbonflux_inst%livestemc_to_litter_patch , & ! Output: [real(r8) (:) ] live stem C litterfall (gC/m2/s) + grainc_to_food => cnveg_carbonflux_inst%grainc_to_food_patch , & ! Output: [real(r8) (:) ] grain C to food (gC/m2/s) + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + + livestemn_to_litter => cnveg_nitrogenflux_inst%livestemn_to_litter_patch , & ! Output: [real(r8) (:) ] livestem N to litter (gN/m2/s) + grainn_to_food => cnveg_nitrogenflux_inst%grainn_to_food_patch , & ! Output: [real(r8) (:) ] grain N to food (gN/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] leaf N to retranslocated N pool (gN/m2/s) + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch & ! Output: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + ) + + ! The litterfall transfer rate starts at 0.0 and increases linearly + ! over time, with displayed growth going to 0.0 on the last day of litterfall + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate fluxes during offset period + if (offset_flag(p) == 1._r8) then + + if (offset_counter(p) == dt) then + t1 = 1.0_r8 / dt + leafc_to_litter(p) = t1 * leafc(p) + cpool_to_leafc(p) + frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p) + ! this assumes that offset_counter == dt for crops + ! if this were ever changed, we'd need to add code to the "else" + if (ivt(p) >= npcropmin) then + grainc_to_food(p) = t1 * grainc(p) + cpool_to_grainc(p) + livestemc_to_litter(p) = t1 * livestemc(p) + cpool_to_livestemc(p) + end if + else + t1 = dt * 2.0_r8 / (offset_counter(p) * offset_counter(p)) + leafc_to_litter(p) = prev_leafc_to_litter(p) + t1*(leafc(p) - prev_leafc_to_litter(p)*offset_counter(p)) + frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p)) + end if + + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + if (CNratio_floating .eqv. .true.) then + if (leafc(p) == 0.0_r8) then + ntovr_leaf = 0.0_r8 + else + ntovr_leaf = leafc_to_litter(p) * (leafn(p) / leafc(p)) + end if + + leafn_to_litter(p) = 0.5_r8 * ntovr_leaf ! assuming 50% goes to litter + leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) + end if + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + if (CNratio_floating .eqv. .true.) then + if (frootc(p) == 0.0_r8) then + frootn_to_litter(p) = 0.0_r8 + else + frootn_to_litter(p) = frootc_to_litter(p) * (frootn(p) / frootc(p)) + end if + end if + + if (ivt(p) >= npcropmin) then + ! NOTE(slevis, 2014-12) results in -ve livestemn and -ve totpftn + !X! livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p)) + ! NOTE(slevis, 2014-12) Beth Drewniak suggested this instead + livestemn_to_litter(p) = livestemn(p) / dt + grainn_to_food(p) = grainc_to_food(p) / graincn(ivt(p)) + end if + + ! save the current litterfall fluxes + prev_leafc_to_litter(p) = leafc_to_litter(p) + prev_frootc_to_litter(p) = frootc_to_litter(p) + + end if ! end if offset period + + end do ! end patch loop + + end associate + + end subroutine CNOffsetLitterfall + + !----------------------------------------------------------------------- + subroutine CNBackgroundLitterfall (num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from displayed pools to litter + ! pools as the result of background litter fall. + ! + use clm_varctl , only : CNratio_floating + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8) :: ntovr_leaf + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + lflitcn => pftcon%lflitcn , & ! Input: leaf litter C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + + bglfr => cnveg_state_inst%bglfr_patch , & ! Input: [real(r8) (:) ] background litterfall rate (1/s) + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) (:) ] + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Output: [real(r8) (:) ] + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:) ] + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch & ! Output: [real(r8) (:) ] + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes if the background litterfall rate is non-zero + if (bglfr(p) > 0._r8) then + ! units for bglfr are already 1/s + leafc_to_litter(p) = bglfr(p) * leafc(p) + frootc_to_litter(p) = bglfr(p) * frootc(p) + + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + if (CNratio_floating .eqv. .true.) then + if (leafc(p) == 0.0_r8) then + ntovr_leaf = 0.0_r8 + else + ntovr_leaf = leafc_to_litter(p) * (leafn(p) / leafc(p)) + end if + + leafn_to_litter(p) = 0.5_r8 * ntovr_leaf ! assuming 50% goes to litter + leafn_to_retransn(p) = ntovr_leaf - leafn_to_litter(p) + end if + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + if (CNratio_floating .eqv. .true.) then + if (frootc(p) == 0.0_r8) then + frootn_to_litter(p) = 0.0_r8 + else + frootn_to_litter(p) = frootc_to_litter(p) * (frootn(p) / frootc(p)) + end if + end if + + end if + + end do + + end associate + + end subroutine CNBackgroundLitterfall + + !----------------------------------------------------------------------- + subroutine CNLivewoodTurnover (num_soilp, filter_soilp, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Determines the flux of C and N from live wood to + ! dead wood pools, for stem and coarse root. + ! + use clm_varctl , only : CNratio_floating + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: ctovr ! temporary variable for carbon turnover + real(r8):: ntovr ! temporary variable for nitrogen turnover + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live stem C + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) live coarse root C + + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:) ] (gN/m2) live coarse root N + + livestemc_to_deadstemc => cnveg_carbonflux_inst%livestemc_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + livecrootc_to_deadcrootc => cnveg_carbonflux_inst%livecrootc_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + + livestemn_to_deadstemn => cnveg_nitrogenflux_inst%livestemn_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_deadcrootn => cnveg_nitrogenflux_inst%livecrootn_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + livecrootn_to_retransn => cnveg_nitrogenflux_inst%livecrootn_to_retransn_patch & ! Output: [real(r8) (:) ] + ) + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes for woody types + if (woody(ivt(p)) > 0._r8) then + + ! live stem to dead stem turnover + + ctovr = livestemc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + livestemc_to_deadstemc(p) = ctovr + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) + + if (CNratio_floating .eqv. .true.) then + if (livestemc(p) == 0.0_r8) then + ntovr = 0.0_r8 + else + ntovr = ctovr * (livestemn(p) / livestemc(p)) + end if + + livestemn_to_deadstemn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn + end if + + livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) + + ! live coarse root to dead coarse root turnover + + ctovr = livecrootc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + livecrootc_to_deadcrootc(p) = ctovr + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) + + if (CNratio_floating .eqv. .true.) then + if (livecrootc(p) == 0.0_r8) then + ntovr = 0.0_r8 + else + ntovr = ctovr * (livecrootn(p) / livecrootc(p)) + end if + + livecrootn_to_deadcrootn(p) = 0.5_r8 * ntovr ! assuming 50% goes to deadstemn + end if + + livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) + + end if + + end do + + end associate + + end subroutine CNLivewoodTurnover + + !----------------------------------------------------------------------- + subroutine CNLitterToColumn (bounds, num_soilc, filter_soilc, & + cnveg_state_inst,cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + leaf_prof_patch, froot_prof_patch) + ! + ! !DESCRIPTION: + ! called at the end of cn_phenology to gather all patch-level litterfall fluxes + ! to the column level and assign them to the three litter pools + ! + ! !USES: + use clm_varpar , only : max_patch_per_col, nlevdecomp + use pftconMod , only : npcropmin + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) + real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(leaf_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(froot_prof_patch) == (/bounds%endp,nlevdecomp_full/)), errMsg(__FILE__, __LINE__)) + + associate( & + leaf_prof => leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) for this patch (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Input: [real(r8) (:) ] leaf C litterfall (gC/m2/s) + frootc_to_litter => cnveg_carbonflux_inst%frootc_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + livestemc_to_litter => cnveg_carbonflux_inst%livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] live stem C litterfall (gC/m2/s) + grainc_to_food => cnveg_carbonflux_inst%grainc_to_food_patch , & ! Input: [real(r8) (:) ] grain C to food (gC/m2/s) + phenology_c_to_litr_met_c => cnveg_carbonflux_inst%phenology_c_to_litr_met_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + phenology_c_to_litr_cel_c => cnveg_carbonflux_inst%phenology_c_to_litr_cel_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + phenology_c_to_litr_lig_c => cnveg_carbonflux_inst%phenology_c_to_litr_lig_c_col , & ! Output: [real(r8) (:,:) ] C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + + livestemn_to_litter => cnveg_nitrogenflux_inst%livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] livestem N to litter (gN/m2/s) + grainn_to_food => cnveg_nitrogenflux_inst%grainn_to_food_patch , & ! Input: [real(r8) (:) ] grain N to food (gN/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Input: [real(r8) (:) ] leaf N litterfall (gN/m2/s) + frootn_to_litter => cnveg_nitrogenflux_inst%frootn_to_litter_patch , & ! Input: [real(r8) (:) ] fine root N litterfall (gN/m2/s) + phenology_n_to_litr_met_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_met_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) + phenology_n_to_litr_cel_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_cel_n_col , & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) + phenology_n_to_litr_lig_n => cnveg_nitrogenflux_inst%phenology_n_to_litr_lig_n_col & ! Output: [real(r8) (:,:) ] N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + + ! leaf litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! leaf litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! fine root litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + livestemc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + livestemc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + livestemc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! stem litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + livestemn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + livestemn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + livestemn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! grain litter carbon fluxes + phenology_c_to_litr_met_c(c,j) = phenology_c_to_litr_met_c(c,j) & + + grainc_to_food(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_cel_c(c,j) = phenology_c_to_litr_cel_c(c,j) & + + grainc_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_c_to_litr_lig_c(c,j) = phenology_c_to_litr_lig_c(c,j) & + + grainc_to_food(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! grain litter nitrogen fluxes + phenology_n_to_litr_met_n(c,j) = phenology_n_to_litr_met_n(c,j) & + + grainn_to_food(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_cel_n(c,j) = phenology_n_to_litr_cel_n(c,j) & + + grainn_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + phenology_n_to_litr_lig_n(c,j) = phenology_n_to_litr_lig_n(c,j) & + + grainn_to_food(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + end if + end if + end if + + end do + + end do + end do + + end associate + + end subroutine CNLitterToColumn + +end module CNPhenologyMod diff --git a/components/clm/src/biogeochem/CNPrecisionControlMod.F90 b/components/clm/src/biogeochem/CNPrecisionControlMod.F90 new file mode 100644 index 0000000000..0f5974a767 --- /dev/null +++ b/components/clm/src/biogeochem/CNPrecisionControlMod.F90 @@ -0,0 +1,567 @@ +module CNPrecisionControlMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! controls on very low values in critical state variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNPrecisionControl + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNPrecisionControl(num_soilp, filter_soilp, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! Force leaf and deadstem c and n to 0 if they get too small. + ! + ! !USES: + use clm_varctl , only : iulog, use_c13, use_c14 + use clm_varpar , only : crop_prog + use pftconMod , only : nc3crop + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of soil patchs in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,j,k ! indices + integer :: fp ! filter indices + real(r8):: pc,pn ! truncation terms for patch-level corrections + real(r8):: pc13 ! truncation terms for patch-level corrections + real(r8):: pc14 ! truncation terms for patch-level corrections + real(r8):: cc14 ! truncation terms for column-level corrections + real(r8):: ccrit ! critical carbon state value for truncation + real(r8):: ncrit ! critical nitrogen state value for truncation + !----------------------------------------------------------------------- + + ! cnveg_carbonstate_inst%cpool_patch Output: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + ! cnveg_carbonstate_inst%deadcrootc_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C + ! cnveg_carbonstate_inst%deadcrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C storage + ! cnveg_carbonstate_inst%deadcrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead coarse root C transfer + ! cnveg_carbonstate_inst%deadstemc_patch Output: [real(r8) (:) ] (gC/m2) dead stem C + ! cnveg_carbonstate_inst%deadstemc_storage_patch Output: [real(r8) (:) ] (gC/m2) dead stem C storage + ! cnveg_carbonstate_inst%deadstemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) dead stem C transfer + ! cnveg_carbonstate_inst%frootc_patch Output: [real(r8) (:) ] (gC/m2) fine root C + ! cnveg_carbonstate_inst%frootc_storage_patch Output: [real(r8) (:) ] (gC/m2) fine root C storage + ! cnveg_carbonstate_inst%frootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) fine root C transfer + ! cnveg_carbonstate_inst%gresp_storage_patch Output: [real(r8) (:) ] (gC/m2) growth respiration storage + ! cnveg_carbonstate_inst%gresp_xfer_patch Output: [real(r8) (:) ] (gC/m2) growth respiration transfer + ! cnveg_carbonstate_inst%leafc_patch Output: [real(r8) (:) ] (gC/m2) leaf C + ! cnveg_carbonstate_inst%leafc_storage_patch Output: [real(r8) (:) ] (gC/m2) leaf C storage + ! cnveg_carbonstate_inst%leafc_xfer_patch Output: [real(r8) (:) ] (gC/m2) leaf C transfer + ! cnveg_carbonstate_inst%livecrootc_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C + ! cnveg_carbonstate_inst%livecrootc_storage_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C storage + ! cnveg_carbonstate_inst%livecrootc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live coarse root C transfer + ! cnveg_carbonstate_inst%livestemc_patch Output: [real(r8) (:) ] (gC/m2) live stem C + ! cnveg_carbonstate_inst%livestemc_storage_patch Output: [real(r8) (:) ] (gC/m2) live stem C storage + ! cnveg_carbonstate_inst%livestemc_xfer_patch Output: [real(r8) (:) ] (gC/m2) live stem C transfer + ! cnveg_carbonstate_inst%ctrunc_patch Output: [real(r8) (:) ] (gC/m2) patch-level sink for C truncation + ! cnveg_carbonstate_inst%xsmrpool_patch Output: [real(r8) (:) ] (gC/m2) execss maint resp C pool + ! cnveg_carbonstate_inst%grainc_patch Output: [real(r8) (:) ] (gC/m2) grain C + ! cnveg_carbonstate_inst%grainc_storage_patch Output: [real(r8) (:) ] (gC/m2) grain C storage + ! cnveg_carbonstate_inst%grainc_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain C transfer + + ! cnveg_nitrogenstate_inst%deadcrootn_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N + ! cnveg_nitrogenstate_inst%deadcrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N storage + ! cnveg_nitrogenstate_inst%deadcrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead coarse root N transfer + ! cnveg_nitrogenstate_inst%deadstemn_patch Output: [real(r8) (:) ] (gN/m2) dead stem N + ! cnveg_nitrogenstate_inst%deadstemn_storage_patch Output: [real(r8) (:) ] (gN/m2) dead stem N storage + ! cnveg_nitrogenstate_inst%deadstemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) dead stem N transfer + ! cnveg_nitrogenstate_inst%frootn_patch Output: [real(r8) (:) ] (gN/m2) fine root N + ! cnveg_nitrogenstate_inst%frootn_storage_patch Output: [real(r8) (:) ] (gN/m2) fine root N storage + ! cnveg_nitrogenstate_inst%frootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) fine root N transfer + ! cnveg_nitrogenstate_inst%leafn_patch Output: [real(r8) (:) ] (gN/m2) leaf N + ! cnveg_nitrogenstate_inst%leafn_storage_patch Output: [real(r8) (:) ] (gN/m2) leaf N storage + ! cnveg_nitrogenstate_inst%leafn_xfer_patch Output: [real(r8) (:) ] (gN/m2) leaf N transfer + ! cnveg_nitrogenstate_inst%livecrootn_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N + ! cnveg_nitrogenstate_inst%livecrootn_storage_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N storage + ! cnveg_nitrogenstate_inst%livecrootn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live coarse root N transfer + ! cnveg_nitrogenstate_inst%grainn_patch Output: [real(r8) (:) ] (gC/m2) grain N + ! cnveg_nitrogenstate_inst%grainn_storage_patch Output: [real(r8) (:) ] (gC/m2) grain N storage + ! cnveg_nitrogenstate_inst%grainn_xfer_patch Output: [real(r8) (:) ] (gC/m2) grain N transfer + ! cnveg_nitrogenstate_inst%livestemn_patch Output: [real(r8) (:) ] (gN/m2) live stem N + ! cnveg_nitrogenstate_inst%livestemn_storage_patch Output: [real(r8) (:) ] (gN/m2) live stem N storage + ! cnveg_nitrogenstate_inst%livestemn_xfer_patch Output: [real(r8) (:) ] (gN/m2) live stem N transfer + ! cnveg_nitrogenstate_inst%npool_patch Output: [real(r8) (:) ] (gN/m2) temporary plant N pool + ! cnveg_nitrogenstate_inst%ntrunc_patch Output: [real(r8) (:) ] (gN/m2) patch-level sink for N truncation + ! cnveg_nitrogenstate_inst%retransn_patch Output: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + associate( & + cs => cnveg_carbonstate_inst , & + ns => cnveg_nitrogenstate_inst , & + c13cs => c13_cnveg_carbonstate_inst , & + c14cs => c14_cnveg_carbonstate_inst & + ) + + ! set the critical carbon state value for truncation (gC/m2) + ccrit = 1.e-8_r8 + + ! set the critical nitrogen state value for truncation (gN/m2) + ncrit = 1.e-8_r8 + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! initialize the patch-level C and N truncation terms + pc = 0._r8 + pn = 0._r8 + if ( use_c13 ) pc13 = 0._r8 + if ( use_c14 ) pc14 = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate C, C13, and N components + + ! leaf C and N + if (abs(cs%leafc_patch(p)) < ccrit) then + pc = pc + cs%leafc_patch(p) + cs%leafc_patch(p) = 0._r8 + + pn = pn + ns%leafn_patch(p) + ns%leafn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%leafc_patch(p) + c13cs%leafc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%leafc_patch(p) + c14cs%leafc_patch(p) = 0._r8 + endif + end if + + ! leaf storage C and N + if (abs(cs%leafc_storage_patch(p)) < ccrit) then + pc = pc + cs%leafc_storage_patch(p) + cs%leafc_storage_patch(p) = 0._r8 + + pn = pn + ns%leafn_storage_patch(p) + ns%leafn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%leafc_storage_patch(p) + c13cs%leafc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%leafc_storage_patch(p) + c14cs%leafc_storage_patch(p) = 0._r8 + endif + end if + + ! leaf transfer C and N + if (abs(cs%leafc_xfer_patch(p)) < ccrit) then + pc = pc + cs%leafc_xfer_patch(p) + cs%leafc_xfer_patch(p) = 0._r8 + + pn = pn + ns%leafn_xfer_patch(p) + ns%leafn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%leafc_xfer_patch(p) + c13cs%leafc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%leafc_xfer_patch(p) + c14cs%leafc_xfer_patch(p) = 0._r8 + endif + end if + + ! froot C and N + if (abs(cs%frootc_patch(p)) < ccrit) then + pc = pc + cs%frootc_patch(p) + cs%frootc_patch(p) = 0._r8 + + pn = pn + ns%frootn_patch(p) + ns%frootn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%frootc_patch(p) + c13cs%frootc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%frootc_patch(p) + c14cs%frootc_patch(p) = 0._r8 + endif + end if + + ! froot storage C and N + if (abs(cs%frootc_storage_patch(p)) < ccrit) then + pc = pc + cs%frootc_storage_patch(p) + cs%frootc_storage_patch(p) = 0._r8 + + pn = pn + ns%frootn_storage_patch(p) + ns%frootn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%frootc_storage_patch(p) + c13cs%frootc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%frootc_storage_patch(p) + c14cs%frootc_storage_patch(p) = 0._r8 + endif + end if + + ! froot transfer C and N + if (abs(cs%frootc_xfer_patch(p)) < ccrit) then + pc = pc + cs%frootc_xfer_patch(p) + cs%frootc_xfer_patch(p) = 0._r8 + + pn = pn + ns%frootn_xfer_patch(p) + ns%frootn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%frootc_xfer_patch(p) + c13cs%frootc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%frootc_xfer_patch(p) + c14cs%frootc_xfer_patch(p) = 0._r8 + endif + end if + + if ( crop_prog .and. patch%itype(p) >= nc3crop )then + ! grain C and N + if (abs(cs%grainc_patch(p)) < ccrit) then + pc = pc + cs%grainc_patch(p) + cs%grainc_patch(p) = 0._r8 + + pn = pn + ns%grainn_patch(p) + ns%grainn_patch(p) = 0._r8 + end if + + ! grain storage C and N + if (abs(cs%grainc_storage_patch(p)) < ccrit) then + pc = pc + cs%grainc_storage_patch(p) + cs%grainc_storage_patch(p) = 0._r8 + + pn = pn + ns%grainn_storage_patch(p) + ns%grainn_storage_patch(p) = 0._r8 + end if + + ! grain transfer C and N + if (abs(cs%grainc_xfer_patch(p)) < ccrit) then + pc = pc + cs%grainc_xfer_patch(p) + cs%grainc_xfer_patch(p) = 0._r8 + + pn = pn + ns%grainn_xfer_patch(p) + ns%grainn_xfer_patch(p) = 0._r8 + end if + end if + + ! livestem C and N + if (abs(cs%livestemc_patch(p)) < ccrit) then + pc = pc + cs%livestemc_patch(p) + cs%livestemc_patch(p) = 0._r8 + + pn = pn + ns%livestemn_patch(p) + ns%livestemn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livestemc_patch(p) + c13cs%livestemc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livestemc_patch(p) + c14cs%livestemc_patch(p) = 0._r8 + endif + end if + + ! livestem storage C and N + if (abs(cs%livestemc_storage_patch(p)) < ccrit) then + pc = pc + cs%livestemc_storage_patch(p) + cs%livestemc_storage_patch(p) = 0._r8 + + pn = pn + ns%livestemn_storage_patch(p) + ns%livestemn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livestemc_storage_patch(p) + c13cs%livestemc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livestemc_storage_patch(p) + c14cs%livestemc_storage_patch(p) = 0._r8 + endif + end if + + ! livestem transfer C and N + if (abs(cs%livestemc_xfer_patch(p)) < ccrit) then + pc = pc + cs%livestemc_xfer_patch(p) + cs%livestemc_xfer_patch(p) = 0._r8 + + pn = pn + ns%livestemn_xfer_patch(p) + ns%livestemn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livestemc_xfer_patch(p) + c13cs%livestemc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livestemc_xfer_patch(p) + c14cs%livestemc_xfer_patch(p) = 0._r8 + endif + end if + + ! deadstem C and N + if (abs(cs%deadstemc_patch(p)) < ccrit) then + pc = pc + cs%deadstemc_patch(p) + cs%deadstemc_patch(p) = 0._r8 + + pn = pn + ns%deadstemn_patch(p) + ns%deadstemn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadstemc_patch(p) + c13cs%deadstemc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadstemc_patch(p) + c14cs%deadstemc_patch(p) = 0._r8 + endif + end if + + ! deadstem storage C and N + if (abs(cs%deadstemc_storage_patch(p)) < ccrit) then + pc = pc + cs%deadstemc_storage_patch(p) + cs%deadstemc_storage_patch(p) = 0._r8 + + pn = pn + ns%deadstemn_storage_patch(p) + ns%deadstemn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadstemc_storage_patch(p) + c13cs%deadstemc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadstemc_storage_patch(p) + c14cs%deadstemc_storage_patch(p) = 0._r8 + endif + end if + + ! deadstem transfer C and N + if (abs(cs%deadstemc_xfer_patch(p)) < ccrit) then + pc = pc + cs%deadstemc_xfer_patch(p) + cs%deadstemc_xfer_patch(p) = 0._r8 + + pn = pn + ns%deadstemn_xfer_patch(p) + ns%deadstemn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadstemc_xfer_patch(p) + c13cs%deadstemc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadstemc_xfer_patch(p) + c14cs%deadstemc_xfer_patch(p) = 0._r8 + endif + end if + + ! livecroot C and N + if (abs(cs%livecrootc_patch(p)) < ccrit) then + pc = pc + cs%livecrootc_patch(p) + cs%livecrootc_patch(p) = 0._r8 + + pn = pn + ns%livecrootn_patch(p) + ns%livecrootn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livecrootc_patch(p) + c13cs%livecrootc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livecrootc_patch(p) + c14cs%livecrootc_patch(p) = 0._r8 + endif + end if + + ! livecroot storage C and N + if (abs(cs%livecrootc_storage_patch(p)) < ccrit) then + pc = pc + cs%livecrootc_storage_patch(p) + cs%livecrootc_storage_patch(p) = 0._r8 + + pn = pn + ns%livecrootn_storage_patch(p) + ns%livecrootn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livecrootc_storage_patch(p) + c13cs%livecrootc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livecrootc_storage_patch(p) + c14cs%livecrootc_storage_patch(p) = 0._r8 + endif + end if + + ! livecroot transfer C and N + if (abs(cs%livecrootc_xfer_patch(p)) < ccrit) then + pc = pc + cs%livecrootc_xfer_patch(p) + cs%livecrootc_xfer_patch(p) = 0._r8 + + pn = pn + ns%livecrootn_xfer_patch(p) + ns%livecrootn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%livecrootc_xfer_patch(p) + c13cs%livecrootc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%livecrootc_xfer_patch(p) + c14cs%livecrootc_xfer_patch(p) = 0._r8 + endif + end if + + ! deadcroot C and N + if (abs(cs%deadcrootc_patch(p)) < ccrit) then + pc = pc + cs%deadcrootc_patch(p) + cs%deadcrootc_patch(p) = 0._r8 + + pn = pn + ns%deadcrootn_patch(p) + ns%deadcrootn_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadcrootc_patch(p) + c13cs%deadcrootc_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadcrootc_patch(p) + c14cs%deadcrootc_patch(p) = 0._r8 + endif + end if + + ! deadcroot storage C and N + if (abs(cs%deadcrootc_storage_patch(p)) < ccrit) then + pc = pc + cs%deadcrootc_storage_patch(p) + cs%deadcrootc_storage_patch(p) = 0._r8 + + pn = pn + ns%deadcrootn_storage_patch(p) + ns%deadcrootn_storage_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadcrootc_storage_patch(p) + c13cs%deadcrootc_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadcrootc_storage_patch(p) + c14cs%deadcrootc_storage_patch(p) = 0._r8 + endif + end if + + ! deadcroot transfer C and N + if (abs(cs%deadcrootc_xfer_patch(p)) < ccrit) then + pc = pc + cs%deadcrootc_xfer_patch(p) + cs%deadcrootc_xfer_patch(p) = 0._r8 + + pn = pn + ns%deadcrootn_xfer_patch(p) + ns%deadcrootn_xfer_patch(p) = 0._r8 + + if ( use_c13 ) then + pc13 = pc13 + c13cs%deadcrootc_xfer_patch(p) + c13cs%deadcrootc_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%deadcrootc_xfer_patch(p) + c14cs%deadcrootc_xfer_patch(p) = 0._r8 + endif + end if + + ! gresp_storage (C only) + if (abs(cs%gresp_storage_patch(p)) < ccrit) then + pc = pc + cs%gresp_storage_patch(p) + cs%gresp_storage_patch(p) = 0._r8 + if ( use_c13 ) then + pc13 = pc13 + c13cs%gresp_storage_patch(p) + c13cs%gresp_storage_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%gresp_storage_patch(p) + c14cs%gresp_storage_patch(p) = 0._r8 + endif + end if + + ! gresp_xfer(c only) + if (abs(cs%gresp_xfer_patch(p)) < ccrit) then + pc = pc + cs%gresp_xfer_patch(p) + cs%gresp_xfer_patch(p) = 0._r8 + if ( use_c13 ) then + pc13 = pc13 + c13cs%gresp_xfer_patch(p) + c13cs%gresp_xfer_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%gresp_xfer_patch(p) + c14cs%gresp_xfer_patch(p) = 0._r8 + endif + end if + + ! cpool (C only) + if (abs(cs%cpool_patch(p)) < ccrit) then + pc = pc + cs%cpool_patch(p) + cs%cpool_patch(p) = 0._r8 + if ( use_c13 ) then + pc13 = pc13 + c13cs%cpool_patch(p) + c13cs%cpool_patch(p) = 0._r8 + endif + if ( use_c14 ) then + pc14 = pc14 + c14cs%cpool_patch(p) + c14cs%cpool_patch(p) = 0._r8 + endif + end if + + if ( crop_prog .and. patch%itype(p) >= nc3crop )then + ! xsmrpool (C only) + if (abs(cs%xsmrpool_patch(p)) < ccrit) then + pc = pc + cs%xsmrpool_patch(p) + cs%xsmrpool_patch(p) = 0._r8 + end if + end if + + ! retransn (N only) + if (abs(ns%retransn_patch(p)) < ncrit) then + pn = pn + ns%retransn_patch(p) + ns%retransn_patch(p) = 0._r8 + end if + + ! npool (N only) + if (abs(ns%npool_patch(p)) < ncrit) then + pn = pn + ns%npool_patch(p) + ns%npool_patch(p) = 0._r8 + end if + + cs%ctrunc_patch(p) = cs%ctrunc_patch(p) + pc + + ns%ntrunc_patch(p) = ns%ntrunc_patch(p) + pn + + if ( use_c13 ) then + c13cs%ctrunc_patch(p) = c13cs%ctrunc_patch(p) + pc13 + endif + if ( use_c14 ) then + c14cs%ctrunc_patch(p) = c14cs%ctrunc_patch(p) + pc14 + endif + + end do ! end of patch loop + + end associate + + end subroutine CNPrecisionControl + +end module CNPrecisionControlMod diff --git a/components/clm/src/biogeochem/CNSharedParamsMod.F90 b/components/clm/src/biogeochem/CNSharedParamsMod.F90 new file mode 100644 index 0000000000..8e2bfb18dc --- /dev/null +++ b/components/clm/src/biogeochem/CNSharedParamsMod.F90 @@ -0,0 +1,94 @@ +module CNSharedParamsMod + + !----------------------------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + + ! CNParamsShareInst. PGI wants the type decl. public but the instance + ! is indeed protected. A generic private statement at the start of the module + ! overrides the protected functionality with PGI + + type, public :: CNParamsShareType + real(r8) :: Q10 ! temperature dependence + real(r8) :: minpsi ! minimum soil water potential for heterotrophic resp + real(r8) :: cwd_fcel ! cellulose fraction of coarse woody debris + real(r8) :: cwd_flig ! lignin fraction of coarse woody debris + real(r8) :: froz_q10 ! separate q10 for frozen soil respiration rates + real(r8) :: decomp_depth_efolding ! e-folding depth for reduction in decomposition (m) + real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a fraction of potential aerobic rate + real(r8) :: organic_max ! organic matter content (kg/m3) where soil is assumed to act like peat + end type CNParamsShareType + + type(CNParamsShareType), protected :: CNParamsShareInst + + logical, public :: anoxia_wtsat = .false. + integer, public :: nlev_soildecomp_standard = 5 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNParamsReadShared(ncid) + ! + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + character(len=32) :: subname = 'CNParamsReadShared' + character(len=100) :: errCode = '-Error reading in CN and BGC shared params file. Var:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! netcdf read here + ! + tString='q10_mr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%Q10=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%minpsi=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%cwd_fcel=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%cwd_flig=tempr + + tString='froz_q10' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%froz_q10=tempr + + tString='decomp_depth_efolding' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%decomp_depth_efolding=tempr + + tString='mino2lim' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%mino2lim=tempr + !CNParamsShareInst%mino2lim=0.2_r8 + + tString='organic_max' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNParamsShareInst%organic_max=tempr + + end subroutine CNParamsReadShared + +end module CNSharedParamsMod diff --git a/components/clm/src/biogeochem/CNVegCarbonFluxType.F90 b/components/clm/src/biogeochem/CNVegCarbonFluxType.F90 new file mode 100644 index 0000000000..7a1f32d3ab --- /dev/null +++ b/components/clm/src/biogeochem/CNVegCarbonFluxType.F90 @@ -0,0 +1,4202 @@ +module CNVegCarbonFluxType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : crop_prog, nlevdecomp_full, nlevgrnd, nlevdecomp + use clm_varcon , only : spval, dzsoi_decomp + use clm_varctl , only : use_cndv, use_c13 + use landunit_varcon , only : istsoil, istcrop, istdlak + use pftconMod , only : npcropmin + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: cnveg_carbonflux_type + + ! gap mortality fluxes + real(r8), pointer :: m_leafc_to_litter_patch (:) ! leaf C mortality (gC/m2/s) + real(r8), pointer :: m_leafc_storage_to_litter_patch (:) ! leaf C storage mortality (gC/m2/s) + real(r8), pointer :: m_leafc_xfer_to_litter_patch (:) ! leaf C transfer mortality (gC/m2/s) + real(r8), pointer :: m_frootc_to_litter_patch (:) ! fine root C mortality (gC/m2/s) + real(r8), pointer :: m_frootc_storage_to_litter_patch (:) ! fine root C storage mortality (gC/m2/s) + real(r8), pointer :: m_frootc_xfer_to_litter_patch (:) ! fine root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_to_litter_patch (:) ! live stem C mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_storage_to_litter_patch (:) ! live stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_xfer_to_litter_patch (:) ! live stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_litter_patch (:) ! dead stem C mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_storage_to_litter_patch (:) ! dead stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_to_litter_patch (:) ! live coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_litter_patch (:) ! dead coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_gresp_storage_to_litter_patch (:) ! growth respiration storage mortality (gC/m2/s) + real(r8), pointer :: m_gresp_xfer_to_litter_patch (:) ! growth respiration transfer mortality (gC/m2/s) + + ! harvest mortality fluxes + real(r8), pointer :: hrv_leafc_to_litter_patch (:) ! leaf C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_storage_to_litter_patch (:) ! leaf C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_xfer_to_litter_patch (:) ! leaf C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litter_patch (:) ! fine root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_storage_to_litter_patch (:) ! fine root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_xfer_to_litter_patch (:) ! fine root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_to_litter_patch (:) ! live stem C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_storage_to_litter_patch (:) ! live stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_xfer_to_litter_patch (:) ! live stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod10c_patch (:) ! dead stem C harvest to 10-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod100c_patch (:) ! dead stem C harvest to 100-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_storage_to_litter_patch (:) ! dead stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter_patch (:) ! dead stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_to_litter_patch (:) ! live coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_storage_to_litter_patch (:) ! live coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter_patch (:) ! live coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_to_litter_patch (:) ! dead coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter_patch (:) ! dead coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter_patch (:) ! dead coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_storage_to_litter_patch (:) ! growth respiration storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_xfer_to_litter_patch (:) ! growth respiration transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s) + + ! fire fluxes + real(r8), pointer :: m_leafc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc + real(r8), pointer :: m_leafc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_storage + real(r8), pointer :: m_leafc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from leafc_xfer + real(r8), pointer :: m_livestemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc + real(r8), pointer :: m_livestemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_storage + real(r8), pointer :: m_livestemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livestemc_xfer + real(r8), pointer :: m_deadstemc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer + real(r8), pointer :: m_deadstemc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_storage + real(r8), pointer :: m_deadstemc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadstemc_xfer + real(r8), pointer :: m_frootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc + real(r8), pointer :: m_frootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_storage + real(r8), pointer :: m_frootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from frootc_xfer + real(r8), pointer :: m_livecrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc + real(r8), pointer :: m_livecrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_storage + real(r8), pointer :: m_livecrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from livecrootc_xfer + real(r8), pointer :: m_deadcrootc_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc + real(r8), pointer :: m_deadcrootc_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_storage + real(r8), pointer :: m_deadcrootc_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from deadcrootc_xfer + real(r8), pointer :: m_gresp_storage_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_storage + real(r8), pointer :: m_gresp_xfer_to_fire_patch (:) ! (gC/m2/s) fire C emissions from gresp_xfer + real(r8), pointer :: m_leafc_to_litter_fire_patch (:) ! (gC/m2/s) from leafc to litter c due to fire + real(r8), pointer :: m_leafc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_storage to litter C due to fire + real(r8), pointer :: m_leafc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from leafc_xfer to litter C due to fire + real(r8), pointer :: m_livestemc_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc to litter C due to fire + real(r8), pointer :: m_livestemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_storage to litter C due to fire + real(r8), pointer :: m_livestemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livestemc_xfer to litter C due to fire + real(r8), pointer :: m_livestemc_to_deadstemc_fire_patch (:) ! (gC/m2/s) from livestemc to deadstemc due to fire + real(r8), pointer :: m_deadstemc_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc to litter C due to fire + real(r8), pointer :: m_deadstemc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_storage to litter C due to fire + real(r8), pointer :: m_deadstemc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadstemc_xfer to litter C due to fire + real(r8), pointer :: m_frootc_to_litter_fire_patch (:) ! (gC/m2/s) from frootc to litter C due to fire + real(r8), pointer :: m_frootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_storage to litter C due to fire + real(r8), pointer :: m_frootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from frootc_xfer to litter C due to fire + real(r8), pointer :: m_livecrootc_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc to litter C due to fire + real(r8), pointer :: m_livecrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_storage to litter C due to fire + real(r8), pointer :: m_livecrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from livecrootc_xfer to litter C due to fire + real(r8), pointer :: m_livecrootc_to_deadcrootc_fire_patch (:) ! (gC/m2/s) from livecrootc to deadstemc due to fire + real(r8), pointer :: m_deadcrootc_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc to litter C due to fire + real(r8), pointer :: m_deadcrootc_storage_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_storage to litter C due to fire + real(r8), pointer :: m_deadcrootc_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from deadcrootc_xfer to litter C due to fire + real(r8), pointer :: m_gresp_storage_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_storage to litter C due to fire + real(r8), pointer :: m_gresp_xfer_to_litter_fire_patch (:) ! (gC/m2/s) from gresp_xfer to litter C due to fire + + ! phenology fluxes from transfer pools + real(r8), pointer :: grainc_xfer_to_grainc_patch (:) ! grain C growth from storage for prognostic crop(gC/m2/s) + real(r8), pointer :: leafc_xfer_to_leafc_patch (:) ! leaf C growth from storage (gC/m2/s) + real(r8), pointer :: frootc_xfer_to_frootc_patch (:) ! fine root C growth from storage (gC/m2/s) + real(r8), pointer :: livestemc_xfer_to_livestemc_patch (:) ! live stem C growth from storage (gC/m2/s) + real(r8), pointer :: deadstemc_xfer_to_deadstemc_patch (:) ! dead stem C growth from storage (gC/m2/s) + real(r8), pointer :: livecrootc_xfer_to_livecrootc_patch (:) ! live coarse root C growth from storage (gC/m2/s) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc_patch (:) ! dead coarse root C growth from storage (gC/m2/s) + + ! leaf and fine root litterfall fluxes + real(r8), pointer :: leafc_to_litter_patch (:) ! leaf C litterfall (gC/m2/s) + real(r8), pointer :: frootc_to_litter_patch (:) ! fine root C litterfall (gC/m2/s) + real(r8), pointer :: livestemc_to_litter_patch (:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food_patch (:) ! grain C to food for prognostic crop(gC/m2/s) + + ! maintenance respiration fluxes + real(r8), pointer :: leaf_mr_patch (:) ! leaf maintenance respiration (gC/m2/s) + real(r8), pointer :: froot_mr_patch (:) ! fine root maintenance respiration (gC/m2/s) + real(r8), pointer :: livestem_mr_patch (:) ! live stem maintenance respiration (gC/m2/s) + real(r8), pointer :: livecroot_mr_patch (:) ! live coarse root maintenance respiration (gC/m2/s) + real(r8), pointer :: grain_mr_patch (:) ! crop grain or organs maint. respiration (gC/m2/s) + real(r8), pointer :: leaf_curmr_patch (:) ! leaf maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: froot_curmr_patch (:) ! fine root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livestem_curmr_patch (:) ! live stem maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livecroot_curmr_patch (:) ! live coarse root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: grain_curmr_patch (:) ! crop grain or organs maint. respiration from current GPP (gC/m2/s) + real(r8), pointer :: leaf_xsmr_patch (:) ! leaf maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: froot_xsmr_patch (:) ! fine root maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livestem_xsmr_patch (:) ! live stem maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livecroot_xsmr_patch (:) ! live coarse root maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: grain_xsmr_patch (:) ! crop grain or organs maint. respiration from storage (gC/m2/s) + + ! photosynthesis fluxes + real(r8), pointer :: psnsun_to_cpool_patch (:) ! C fixation from sunlit canopy (gC/m2/s) + real(r8), pointer :: psnshade_to_cpool_patch (:) ! C fixation from shaded canopy (gC/m2/s) + + ! allocation fluxes, from current GPP + real(r8), pointer :: cpool_to_xsmrpool_patch (:) ! allocation to maintenance respiration storage pool (gC/m2/s) + real(r8), pointer :: cpool_to_grainc_patch (:) ! allocation to grain C for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage_patch (:) ! allocation to grain C storage for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_leafc_patch (:) ! allocation to leaf C (gC/m2/s) + real(r8), pointer :: cpool_to_leafc_storage_patch (:) ! allocation to leaf C storage (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_patch (:) ! allocation to fine root C (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_storage_patch (:) ! allocation to fine root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_patch (:) ! allocation to live stem C (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_storage_patch (:) ! allocation to live stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc_patch (:) ! allocation to dead stem C (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc_storage_patch (:) ! allocation to dead stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_patch (:) ! allocation to live coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_storage_patch (:) ! allocation to live coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_patch (:) ! allocation to dead coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_storage_patch (:) ! allocation to dead coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_gresp_storage_patch (:) ! allocation to growth respiration storage (gC/m2/s) + + ! growth respiration fluxes + real(r8), pointer :: xsmrpool_to_atm_patch (:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: cpool_leaf_gr_patch (:) ! leaf growth respiration (gC/m2/s) + real(r8), pointer :: cpool_leaf_storage_gr_patch (:) ! leaf growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_leaf_gr_patch (:) ! leaf growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_froot_gr_patch (:) ! fine root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_froot_storage_gr_patch (:) ! fine root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_froot_gr_patch (:) ! fine root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livestem_gr_patch (:) ! live stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livestem_storage_gr_patch (:) ! live stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livestem_gr_patch (:) ! live stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadstem_gr_patch (:) ! dead stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadstem_storage_gr_patch (:) ! dead stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadstem_gr_patch (:) ! dead stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livecroot_gr_patch (:) ! live coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livecroot_storage_gr_patch (:) ! live coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livecroot_gr_patch (:) ! live coarse root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_gr_patch (:) ! dead coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_storage_gr_patch (:) ! dead coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadcroot_gr_patch (:) ! dead coarse root growth respiration from storage (gC/m2/s) + + ! growth respiration for prognostic crop model + real(r8), pointer :: cpool_grain_gr_patch (:) ! grain growth respiration (gC/m2/s) + real(r8), pointer :: cpool_grain_storage_gr_patch (:) ! grain growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_grain_gr_patch (:) ! grain growth respiration from storage (gC/m2/s) + + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainc_storage_to_xfer_patch (:) ! grain C shift storage to transfer for prognostic crop model (gC/m2/s) + real(r8), pointer :: leafc_storage_to_xfer_patch (:) ! leaf C shift storage to transfer (gC/m2/s) + real(r8), pointer :: frootc_storage_to_xfer_patch (:) ! fine root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livestemc_storage_to_xfer_patch (:) ! live stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadstemc_storage_to_xfer_patch (:) ! dead stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livecrootc_storage_to_xfer_patch (:) ! live coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadcrootc_storage_to_xfer_patch (:) ! dead coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: gresp_storage_to_xfer_patch (:) ! growth respiration shift storage to transfer (gC/m2/s) + + ! turnover of livewood to deadwood + real(r8), pointer :: livestemc_to_deadstemc_patch (:) ! live stem C turnover (gC/m2/s) + real(r8), pointer :: livecrootc_to_deadcrootc_patch (:) ! live coarse root C turnover (gC/m2/s) + + ! phenology: litterfall and crop fluxes + real(r8), pointer :: phenology_c_to_litr_met_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gC/m3/s) + real(r8), pointer :: phenology_c_to_litr_cel_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gC/m3/s) + real(r8), pointer :: phenology_c_to_litr_lig_c_col (:,:) ! C fluxes associated with phenology (litterfall and crop) to litter lignin pool (gC/m3/s) + + ! gap mortality + real(r8), pointer :: gap_mortality_c_to_litr_met_c_col (:,:) ! C fluxes associated with gap mortality to litter metabolic pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_litr_cel_c_col (:,:) ! C fluxes associated with gap mortality to litter cellulose pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_litr_lig_c_col (:,:) ! C fluxes associated with gap mortality to litter lignin pool (gC/m3/s) + real(r8), pointer :: gap_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with gap mortality to CWD pool (gC/m3/s) + + ! fire + real(r8), pointer :: fire_mortality_c_to_cwdc_col (:,:) ! C fluxes associated with fire mortality to CWD pool (gC/m3/s) + + ! harvest + real(r8), pointer :: harvest_c_to_litr_met_c_col (:,:) ! C fluxes associated with harvest to litter metabolic pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_litr_cel_c_col (:,:) ! C fluxes associated with harvest to litter cellulose pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_litr_lig_c_col (:,:) ! C fluxes associated with harvest to litter lignin pool (gC/m3/s) + real(r8), pointer :: harvest_c_to_cwdc_col (:,:) ! C fluxes associated with harvest to CWD pool (gC/m3/s) + real(r8), pointer :: hrv_deadstemc_to_prod10c_col (:) ! dead stem C harvest mortality to 10-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod100c_col (:) ! dead stem C harvest mortality to 100-year product pool (gC/m2/s) + + ! fire fluxes + real(r8), pointer :: m_decomp_cpools_to_fire_vr_col (:,:,:) ! vertically-resolved decomposing C fire loss (gC/m3/s) + real(r8), pointer :: m_decomp_cpools_to_fire_col (:,:) ! vertically-integrated (diagnostic) decomposing C fire loss (gC/m2/s) + real(r8), pointer :: m_c_to_litr_met_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter labile C by fire (gC/m3/s) + real(r8), pointer :: m_c_to_litr_cel_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter cellulose C by fire (gC/m3/s) + real(r8), pointer :: m_c_to_litr_lig_fire_col (:,:) ! C from leaf, froot, xfer and storage C to litter lignin C by fire (gC/m3/s) + + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedc_to_leaf_col (:) ! (gC/m2/s) seed source to patch-level + real(r8), pointer :: dwt_seedc_to_deadstem_col (:) ! (gC/m2/s) seed source to patch-level + real(r8), pointer :: dwt_conv_cflux_col (:) ! (gC/m2/s) conversion C flux (immediate loss to atm) + real(r8), pointer :: dwt_prod10c_gain_col (:) ! (gC/m2/s) addition to 10-yr wood product pool + real(r8), pointer :: dwt_prod100c_gain_col (:) ! (gC/m2/s) addition to 100-yr wood product pool + real(r8), pointer :: dwt_frootc_to_litr_met_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr_cel_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr_lig_c_col (:,:) ! (gC/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootc_to_cwdc_col (:,:) ! (gC/m3/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootc_to_cwdc_col (:,:) ! (gC/m3/s) dead coarse root to CWD due to landcover change + real(r8), pointer :: dwt_closs_col (:) ! (gC/m2/s) total carbon loss from product pools and conversion + + ! wood product pool loss fluxes + real(r8), pointer :: prod10c_loss_col (:) ! (gC/m2/s) decomposition loss from 10-yr wood product pool + real(r8), pointer :: prod100c_loss_col (:) ! (gC/m2/s) decomposition loss from 100-yr wood product pool + real(r8), pointer :: product_closs_col (:) ! (gC/m2/s) total wood product carbon loss + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: gpp_before_downreg_patch (:) ! (gC/m2/s) gross primary production before down regulation + real(r8), pointer :: current_gr_patch (:) ! (gC/m2/s) growth resp for new growth displayed in this timestep + real(r8), pointer :: transfer_gr_patch (:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep + real(r8), pointer :: storage_gr_patch (:) ! (gC/m2/s) growth resp for growth sent to storage for later display + real(r8), pointer :: plant_calloc_patch (:) ! (gC/m2/s) total allocated C flux + real(r8), pointer :: excess_cflux_patch (:) ! (gC/m2/s) C flux not allocated due to downregulation + real(r8), pointer :: prev_leafc_to_litter_patch (:) ! (gC/m2/s) previous timestep leaf C litterfall flux + real(r8), pointer :: prev_frootc_to_litter_patch (:) ! (gC/m2/s) previous timestep froot C litterfall flux + real(r8), pointer :: availc_patch (:) ! (gC/m2/s) C flux available for allocation + real(r8), pointer :: xsmrpool_recover_patch (:) ! (gC/m2/s) C flux assigned to recovery of negative cpool + real(r8), pointer :: xsmrpool_c13ratio_patch (:) ! C13/C(12+13) ratio for xsmrpool (proportion) + + real(r8), pointer :: cwdc_hr_col (:) ! (gC/m2/s) col-level coarse woody debris C heterotrophic respiration + real(r8), pointer :: cwdc_loss_col (:) ! (gC/m2/s) col-level coarse woody debris C loss + real(r8), pointer :: litterc_loss_col (:) ! (gC/m2/s) col-level litter C loss + real(r8), pointer :: frootc_alloc_patch (:) ! (gC/m2/s) patch-level fine root C alloc + real(r8), pointer :: frootc_loss_patch (:) ! (gC/m2/s) patch-level fine root C loss + real(r8), pointer :: leafc_alloc_patch (:) ! (gC/m2/s) patch-level leaf C alloc + real(r8), pointer :: leafc_loss_patch (:) ! (gC/m2/s) patch-level leaf C loss + real(r8), pointer :: woodc_alloc_patch (:) ! (gC/m2/s) patch-level wood C alloc + real(r8), pointer :: woodc_loss_patch (:) ! (gC/m2/s) patch-level wood C loss + + real(r8), pointer :: gpp_patch (:) ! (gC/m2/s) patch gross primary production + real(r8), pointer :: gpp_col (:) ! (gC/m2/s) column GPP flux before downregulation (p2c) + real(r8), pointer :: rr_patch (:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: rr_col (:) ! (gC/m2/s) root respiration (fine root MR + total root GR) (p2c) + real(r8), pointer :: mr_patch (:) ! (gC/m2/s) maintenance respiration + real(r8), pointer :: gr_patch (:) ! (gC/m2/s) total growth respiration + real(r8), pointer :: ar_patch (:) ! (gC/m2/s) patch autotrophic respiration (MR + GR) + real(r8), pointer :: ar_col (:) ! (gC/m2/s) column autotrophic respiration (MR + GR) (p2c) + real(r8), pointer :: npp_patch (:) ! (gC/m2/s) patch net primary production + real(r8), pointer :: npp_col (:) ! (gC/m2/s) column net primary production (p2c) + real(r8), pointer :: agnpp_patch (:) ! (gC/m2/s) aboveground NPP + real(r8), pointer :: bgnpp_patch (:) ! (gC/m2/s) belowground NPP + real(r8), pointer :: litfall_patch (:) ! (gC/m2/s) patch litterfall (leaves and fine roots) + real(r8), pointer :: litfall_col (:) ! (gC/m2/s) column litterfall C loss (p2c) + real(r8), pointer :: wood_harvestc_patch (:) ! (gC/m2/s) patch-level wood harvest (to product pools) + real(r8), pointer :: wood_harvestc_col (:) ! (gC/m2/s) column-level wood harvest (to product pools) (p2c) + real(r8), pointer :: cinputs_patch (:) ! (gC/m2/s) patch-level carbon inputs (for balance checking) + real(r8), pointer :: coutputs_patch (:) ! (gC/m2/s) patch-level carbon outputs (for balance checking) + real(r8), pointer :: sr_col (:) ! (gC/m2/s) total soil respiration (HR + root resp) + real(r8), pointer :: er_col (:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: litfire_col (:) ! (gC/m2/s) litter fire losses + real(r8), pointer :: somfire_col (:) ! (gC/m2/s) soil organic matter fire losses + real(r8), pointer :: totfire_col (:) ! (gC/m2/s) total ecosystem fire losses + real(r8), pointer :: hrv_xsmrpool_to_atm_col (:) ! (gC/m2/s) excess MR pool harvest mortality (p2c) + + ! fire code + real(r8), pointer :: fire_closs_patch (:) ! (gC/m2/s) total fire C loss + real(r8), pointer :: fire_closs_p2c_col (:) ! (gC/m2/s) patch2col averaged column-level fire C loss (p2c) + real(r8), pointer :: fire_closs_col (:) ! (gC/m2/s) total patch-level fire C loss + + ! temporary and annual sums + real(r8), pointer :: tempsum_litfall_patch (:) ! (gC/m2/yr) temporary annual sum of litfall (CNDV only for now) + real(r8), pointer :: annsum_litfall_patch (:) ! (gC/m2/yr) annual sum of litfall (CNDV only for now) + real(r8), pointer :: tempsum_npp_patch (:) ! (gC/m2/yr) temporary annual sum of NPP + real(r8), pointer :: annsum_npp_patch (:) ! (gC/m2/yr) annual sum of NPP + real(r8), pointer :: annsum_npp_col (:) ! (gC/m2/yr) annual sum of NPP, averaged from patch-level + real(r8), pointer :: lag_npp_col (:) ! (gC/m2/yr) lagged net primary production + + ! Summary C fluxes. + real(r8), pointer :: nep_col (:) ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink + real(r8), pointer :: nbp_col (:) ! (gC/m2/s) net biome production, includes fire, landuse, and harvest flux, positive for sink + real(r8), pointer :: nee_col (:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source + + ! Dynamic landcover fluxnes + real(r8), pointer :: landuptake_col (:) ! (gC/m2/s) nee-landuseflux + real(r8), pointer :: landuseflux_col(:) ! (gC/m2/s) dwt_closs+product_closs + + contains + + procedure , public :: Init + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: ZeroDWT + procedure , public :: Summary => Summary_carbonflux + + end type cnveg_carbonflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, carbon_type) + + class(cnveg_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + + call this%InitAllocate ( bounds) + call this%InitHistory ( bounds, carbon_type ) + call this%InitCold (bounds ) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (cnveg_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%m_leafc_to_litter_patch (begp:endp)) ; this%m_leafc_to_litter_patch (:) = nan + allocate(this%m_frootc_to_litter_patch (begp:endp)) ; this%m_frootc_to_litter_patch (:) = nan + allocate(this%m_leafc_storage_to_litter_patch (begp:endp)) ; this%m_leafc_storage_to_litter_patch (:) = nan + allocate(this%m_frootc_storage_to_litter_patch (begp:endp)) ; this%m_frootc_storage_to_litter_patch (:) = nan + allocate(this%m_livestemc_storage_to_litter_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_patch (:) = nan + allocate(this%m_deadstemc_storage_to_litter_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_patch (:) = nan + allocate(this%m_livecrootc_storage_to_litter_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_patch (:) = nan + allocate(this%m_leafc_xfer_to_litter_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_patch (:) = nan + allocate(this%m_frootc_xfer_to_litter_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemc_xfer_to_litter_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemc_to_litter_patch (begp:endp)) ; this%m_livestemc_to_litter_patch (:) = nan + allocate(this%m_deadstemc_to_litter_patch (begp:endp)) ; this%m_deadstemc_to_litter_patch (:) = nan + allocate(this%m_livecrootc_to_litter_patch (begp:endp)) ; this%m_livecrootc_to_litter_patch (:) = nan + allocate(this%m_deadcrootc_to_litter_patch (begp:endp)) ; this%m_deadcrootc_to_litter_patch (:) = nan + allocate(this%m_gresp_storage_to_litter_patch (begp:endp)) ; this%m_gresp_storage_to_litter_patch (:) = nan + allocate(this%m_gresp_xfer_to_litter_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_patch (:) = nan + allocate(this%hrv_leafc_to_litter_patch (begp:endp)) ; this%hrv_leafc_to_litter_patch (:) = nan + allocate(this%hrv_leafc_storage_to_litter_patch (begp:endp)) ; this%hrv_leafc_storage_to_litter_patch (:) = nan + allocate(this%hrv_leafc_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_frootc_to_litter_patch (begp:endp)) ; this%hrv_frootc_to_litter_patch (:) = nan + allocate(this%hrv_frootc_storage_to_litter_patch (begp:endp)) ; this%hrv_frootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_frootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_to_litter_patch (begp:endp)) ; this%hrv_livestemc_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemc_storage_to_litter_patch (:) = nan + allocate(this%hrv_livestemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadstemc_to_prod10c_patch (begp:endp)) ; this%hrv_deadstemc_to_prod10c_patch (:) = nan + allocate(this%hrv_deadstemc_to_prod100c_patch (begp:endp)) ; this%hrv_deadstemc_to_prod100c_patch (:) = nan + allocate(this%hrv_deadstemc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadstemc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_livecrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootc_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootc_xfer_to_litter_patch (:) = nan + allocate(this%hrv_gresp_storage_to_litter_patch (begp:endp)) ; this%hrv_gresp_storage_to_litter_patch (:) = nan + allocate(this%hrv_gresp_xfer_to_litter_patch (begp:endp)) ; this%hrv_gresp_xfer_to_litter_patch (:) = nan + allocate(this%hrv_xsmrpool_to_atm_patch (begp:endp)) ; this%hrv_xsmrpool_to_atm_patch (:) = nan + allocate(this%m_leafc_to_fire_patch (begp:endp)) ; this%m_leafc_to_fire_patch (:) = nan + allocate(this%m_leafc_storage_to_fire_patch (begp:endp)) ; this%m_leafc_storage_to_fire_patch (:) = nan + allocate(this%m_leafc_xfer_to_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_fire_patch (:) = nan + allocate(this%m_livestemc_to_fire_patch (begp:endp)) ; this%m_livestemc_to_fire_patch (:) = nan + allocate(this%m_livestemc_storage_to_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_fire_patch (:) = nan + allocate(this%m_livestemc_xfer_to_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_fire_patch (:) = nan + allocate(this%m_deadstemc_to_fire_patch (begp:endp)) ; this%m_deadstemc_to_fire_patch (:) = nan + allocate(this%m_deadstemc_storage_to_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_fire_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_fire_patch (:) = nan + allocate(this%m_frootc_to_fire_patch (begp:endp)) ; this%m_frootc_to_fire_patch (:) = nan + allocate(this%m_frootc_storage_to_fire_patch (begp:endp)) ; this%m_frootc_storage_to_fire_patch (:) = nan + allocate(this%m_frootc_xfer_to_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_fire_patch (:) = nan + allocate(this%m_livecrootc_to_fire_patch (begp:endp)) ; this%m_livecrootc_to_fire_patch (:) = nan + allocate(this%m_livecrootc_storage_to_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_fire_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_to_fire_patch (begp:endp)) ; this%m_deadcrootc_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_fire_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_fire_patch (:) = nan + allocate(this%m_gresp_storage_to_fire_patch (begp:endp)) ; this%m_gresp_storage_to_fire_patch (:) = nan + allocate(this%m_gresp_xfer_to_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_fire_patch (:) = nan + allocate(this%m_leafc_to_litter_fire_patch (begp:endp)) ; this%m_leafc_to_litter_fire_patch (:) = nan + allocate(this%m_leafc_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_leafc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemc_to_deadstemc_fire_patch (begp:endp)) ; this%m_livestemc_to_deadstemc_fire_patch (:) = nan + allocate(this%m_deadstemc_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_to_litter_fire_patch (begp:endp)) ; this%m_frootc_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_frootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootc_to_deadcrootc_fire_patch (begp:endp)) ; this%m_livecrootc_to_deadcrootc_fire_patch (:) = nan + allocate(this%m_deadcrootc_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootc_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootc_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootc_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_gresp_storage_to_litter_fire_patch (begp:endp)) ; this%m_gresp_storage_to_litter_fire_patch (:) = nan + allocate(this%m_gresp_xfer_to_litter_fire_patch (begp:endp)) ; this%m_gresp_xfer_to_litter_fire_patch (:) = nan + allocate(this%leafc_xfer_to_leafc_patch (begp:endp)) ; this%leafc_xfer_to_leafc_patch (:) = nan + allocate(this%frootc_xfer_to_frootc_patch (begp:endp)) ; this%frootc_xfer_to_frootc_patch (:) = nan + allocate(this%livestemc_xfer_to_livestemc_patch (begp:endp)) ; this%livestemc_xfer_to_livestemc_patch (:) = nan + allocate(this%deadstemc_xfer_to_deadstemc_patch (begp:endp)) ; this%deadstemc_xfer_to_deadstemc_patch (:) = nan + allocate(this%livecrootc_xfer_to_livecrootc_patch (begp:endp)) ; this%livecrootc_xfer_to_livecrootc_patch (:) = nan + allocate(this%deadcrootc_xfer_to_deadcrootc_patch (begp:endp)) ; this%deadcrootc_xfer_to_deadcrootc_patch (:) = nan + allocate(this%leafc_to_litter_patch (begp:endp)) ; this%leafc_to_litter_patch (:) = nan + allocate(this%frootc_to_litter_patch (begp:endp)) ; this%frootc_to_litter_patch (:) = nan + allocate(this%leaf_mr_patch (begp:endp)) ; this%leaf_mr_patch (:) = nan + allocate(this%froot_mr_patch (begp:endp)) ; this%froot_mr_patch (:) = nan + allocate(this%livestem_mr_patch (begp:endp)) ; this%livestem_mr_patch (:) = nan + allocate(this%livecroot_mr_patch (begp:endp)) ; this%livecroot_mr_patch (:) = nan + allocate(this%grain_mr_patch (begp:endp)) ; this%grain_mr_patch (:) = nan + allocate(this%leaf_curmr_patch (begp:endp)) ; this%leaf_curmr_patch (:) = nan + allocate(this%froot_curmr_patch (begp:endp)) ; this%froot_curmr_patch (:) = nan + allocate(this%livestem_curmr_patch (begp:endp)) ; this%livestem_curmr_patch (:) = nan + allocate(this%livecroot_curmr_patch (begp:endp)) ; this%livecroot_curmr_patch (:) = nan + allocate(this%grain_curmr_patch (begp:endp)) ; this%grain_curmr_patch (:) = nan + allocate(this%leaf_xsmr_patch (begp:endp)) ; this%leaf_xsmr_patch (:) = nan + allocate(this%froot_xsmr_patch (begp:endp)) ; this%froot_xsmr_patch (:) = nan + allocate(this%livestem_xsmr_patch (begp:endp)) ; this%livestem_xsmr_patch (:) = nan + allocate(this%livecroot_xsmr_patch (begp:endp)) ; this%livecroot_xsmr_patch (:) = nan + allocate(this%grain_xsmr_patch (begp:endp)) ; this%grain_xsmr_patch (:) = nan + allocate(this%psnsun_to_cpool_patch (begp:endp)) ; this%psnsun_to_cpool_patch (:) = nan + allocate(this%psnshade_to_cpool_patch (begp:endp)) ; this%psnshade_to_cpool_patch (:) = nan + allocate(this%cpool_to_xsmrpool_patch (begp:endp)) ; this%cpool_to_xsmrpool_patch (:) = nan + allocate(this%cpool_to_leafc_patch (begp:endp)) ; this%cpool_to_leafc_patch (:) = nan + allocate(this%cpool_to_leafc_storage_patch (begp:endp)) ; this%cpool_to_leafc_storage_patch (:) = nan + allocate(this%cpool_to_frootc_patch (begp:endp)) ; this%cpool_to_frootc_patch (:) = nan + allocate(this%cpool_to_frootc_storage_patch (begp:endp)) ; this%cpool_to_frootc_storage_patch (:) = nan + allocate(this%cpool_to_livestemc_patch (begp:endp)) ; this%cpool_to_livestemc_patch (:) = nan + allocate(this%cpool_to_livestemc_storage_patch (begp:endp)) ; this%cpool_to_livestemc_storage_patch (:) = nan + allocate(this%cpool_to_deadstemc_patch (begp:endp)) ; this%cpool_to_deadstemc_patch (:) = nan + allocate(this%cpool_to_deadstemc_storage_patch (begp:endp)) ; this%cpool_to_deadstemc_storage_patch (:) = nan + allocate(this%cpool_to_livecrootc_patch (begp:endp)) ; this%cpool_to_livecrootc_patch (:) = nan + allocate(this%cpool_to_livecrootc_storage_patch (begp:endp)) ; this%cpool_to_livecrootc_storage_patch (:) = nan + allocate(this%cpool_to_deadcrootc_patch (begp:endp)) ; this%cpool_to_deadcrootc_patch (:) = nan + allocate(this%cpool_to_deadcrootc_storage_patch (begp:endp)) ; this%cpool_to_deadcrootc_storage_patch (:) = nan + allocate(this%cpool_to_gresp_storage_patch (begp:endp)) ; this%cpool_to_gresp_storage_patch (:) = nan + allocate(this%cpool_leaf_gr_patch (begp:endp)) ; this%cpool_leaf_gr_patch (:) = nan + allocate(this%cpool_leaf_storage_gr_patch (begp:endp)) ; this%cpool_leaf_storage_gr_patch (:) = nan + allocate(this%transfer_leaf_gr_patch (begp:endp)) ; this%transfer_leaf_gr_patch (:) = nan + allocate(this%cpool_froot_gr_patch (begp:endp)) ; this%cpool_froot_gr_patch (:) = nan + allocate(this%cpool_froot_storage_gr_patch (begp:endp)) ; this%cpool_froot_storage_gr_patch (:) = nan + allocate(this%transfer_froot_gr_patch (begp:endp)) ; this%transfer_froot_gr_patch (:) = nan + allocate(this%cpool_livestem_gr_patch (begp:endp)) ; this%cpool_livestem_gr_patch (:) = nan + allocate(this%cpool_livestem_storage_gr_patch (begp:endp)) ; this%cpool_livestem_storage_gr_patch (:) = nan + allocate(this%transfer_livestem_gr_patch (begp:endp)) ; this%transfer_livestem_gr_patch (:) = nan + allocate(this%cpool_deadstem_gr_patch (begp:endp)) ; this%cpool_deadstem_gr_patch (:) = nan + allocate(this%cpool_deadstem_storage_gr_patch (begp:endp)) ; this%cpool_deadstem_storage_gr_patch (:) = nan + allocate(this%transfer_deadstem_gr_patch (begp:endp)) ; this%transfer_deadstem_gr_patch (:) = nan + allocate(this%cpool_livecroot_gr_patch (begp:endp)) ; this%cpool_livecroot_gr_patch (:) = nan + allocate(this%cpool_livecroot_storage_gr_patch (begp:endp)) ; this%cpool_livecroot_storage_gr_patch (:) = nan + allocate(this%transfer_livecroot_gr_patch (begp:endp)) ; this%transfer_livecroot_gr_patch (:) = nan + allocate(this%cpool_deadcroot_gr_patch (begp:endp)) ; this%cpool_deadcroot_gr_patch (:) = nan + allocate(this%cpool_deadcroot_storage_gr_patch (begp:endp)) ; this%cpool_deadcroot_storage_gr_patch (:) = nan + allocate(this%transfer_deadcroot_gr_patch (begp:endp)) ; this%transfer_deadcroot_gr_patch (:) = nan + allocate(this%leafc_storage_to_xfer_patch (begp:endp)) ; this%leafc_storage_to_xfer_patch (:) = nan + allocate(this%frootc_storage_to_xfer_patch (begp:endp)) ; this%frootc_storage_to_xfer_patch (:) = nan + allocate(this%livestemc_storage_to_xfer_patch (begp:endp)) ; this%livestemc_storage_to_xfer_patch (:) = nan + allocate(this%deadstemc_storage_to_xfer_patch (begp:endp)) ; this%deadstemc_storage_to_xfer_patch (:) = nan + allocate(this%livecrootc_storage_to_xfer_patch (begp:endp)) ; this%livecrootc_storage_to_xfer_patch (:) = nan + allocate(this%deadcrootc_storage_to_xfer_patch (begp:endp)) ; this%deadcrootc_storage_to_xfer_patch (:) = nan + allocate(this%gresp_storage_to_xfer_patch (begp:endp)) ; this%gresp_storage_to_xfer_patch (:) = nan + allocate(this%livestemc_to_deadstemc_patch (begp:endp)) ; this%livestemc_to_deadstemc_patch (:) = nan + allocate(this%livecrootc_to_deadcrootc_patch (begp:endp)) ; this%livecrootc_to_deadcrootc_patch (:) = nan + allocate(this%current_gr_patch (begp:endp)) ; this%current_gr_patch (:) = nan + allocate(this%transfer_gr_patch (begp:endp)) ; this%transfer_gr_patch (:) = nan + allocate(this%storage_gr_patch (begp:endp)) ; this%storage_gr_patch (:) = nan + allocate(this%plant_calloc_patch (begp:endp)) ; this%plant_calloc_patch (:) = nan + allocate(this%excess_cflux_patch (begp:endp)) ; this%excess_cflux_patch (:) = nan + allocate(this%prev_leafc_to_litter_patch (begp:endp)) ; this%prev_leafc_to_litter_patch (:) = nan + allocate(this%prev_frootc_to_litter_patch (begp:endp)) ; this%prev_frootc_to_litter_patch (:) = nan + allocate(this%gpp_before_downreg_patch (begp:endp)) ; this%gpp_before_downreg_patch (:) = nan + allocate(this%availc_patch (begp:endp)) ; this%availc_patch (:) = nan + allocate(this%xsmrpool_recover_patch (begp:endp)) ; this%xsmrpool_recover_patch (:) = nan + allocate(this%xsmrpool_c13ratio_patch (begp:endp)) ; this%xsmrpool_c13ratio_patch (:) = nan + + allocate(this%cpool_to_grainc_patch (begp:endp)) ; this%cpool_to_grainc_patch (:) = nan + allocate(this%cpool_to_grainc_storage_patch (begp:endp)) ; this%cpool_to_grainc_storage_patch (:) = nan + allocate(this%livestemc_to_litter_patch (begp:endp)) ; this%livestemc_to_litter_patch (:) = nan + allocate(this%grainc_to_food_patch (begp:endp)) ; this%grainc_to_food_patch (:) = nan + allocate(this%grainc_xfer_to_grainc_patch (begp:endp)) ; this%grainc_xfer_to_grainc_patch (:) = nan + allocate(this%cpool_grain_gr_patch (begp:endp)) ; this%cpool_grain_gr_patch (:) = nan + allocate(this%cpool_grain_storage_gr_patch (begp:endp)) ; this%cpool_grain_storage_gr_patch (:) = nan + allocate(this%transfer_grain_gr_patch (begp:endp)) ; this%transfer_grain_gr_patch (:) = nan + allocate(this%xsmrpool_to_atm_patch (begp:endp)) ; this%xsmrpool_to_atm_patch (:) = nan + allocate(this%grainc_storage_to_xfer_patch (begp:endp)) ; this%grainc_storage_to_xfer_patch (:) = nan + allocate(this%frootc_alloc_patch (begp:endp)) ; this%frootc_alloc_patch (:) = nan + allocate(this%frootc_loss_patch (begp:endp)) ; this%frootc_loss_patch (:) = nan + allocate(this%leafc_alloc_patch (begp:endp)) ; this%leafc_alloc_patch (:) = nan + allocate(this%leafc_loss_patch (begp:endp)) ; this%leafc_loss_patch (:) = nan + allocate(this%woodc_alloc_patch (begp:endp)) ; this%woodc_alloc_patch (:) = nan + allocate(this%woodc_loss_patch (begp:endp)) ; this%woodc_loss_patch (:) = nan + + allocate(this%phenology_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); + this%phenology_c_to_litr_met_c_col (:,:)=nan + + allocate(this%phenology_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_cel_c_col (:,:)=nan + allocate(this%phenology_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%phenology_c_to_litr_lig_c_col (:,:)=nan + + allocate(this%gap_mortality_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_met_c_col(:,:)=nan + allocate(this%gap_mortality_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_cel_c_col(:,:)=nan + allocate(this%gap_mortality_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_litr_lig_c_col(:,:)=nan + + allocate(this%gap_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%gap_mortality_c_to_cwdc_col (:,:)=nan + allocate(this%fire_mortality_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%fire_mortality_c_to_cwdc_col (:,:)=nan + allocate(this%m_c_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_met_fire_col (:,:)=nan + allocate(this%m_c_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_cel_fire_col (:,:)=nan + allocate(this%m_c_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)); this%m_c_to_litr_lig_fire_col (:,:)=nan + allocate(this%harvest_c_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_met_c_col (:,:)=nan + allocate(this%harvest_c_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_cel_c_col (:,:)=nan + allocate(this%harvest_c_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_litr_lig_c_col (:,:)=nan + allocate(this%harvest_c_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%harvest_c_to_cwdc_col (:,:)=nan + + allocate(this%dwt_frootc_to_litr_met_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_met_c_col (:,:)=nan + allocate(this%dwt_frootc_to_litr_cel_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_cel_c_col (:,:)=nan + allocate(this%dwt_frootc_to_litr_lig_c_col (begc:endc,1:nlevdecomp_full)); this%dwt_frootc_to_litr_lig_c_col (:,:)=nan + allocate(this%dwt_livecrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_livecrootc_to_cwdc_col (:,:)=nan + allocate(this%dwt_deadcrootc_to_cwdc_col (begc:endc,1:nlevdecomp_full)); this%dwt_deadcrootc_to_cwdc_col (:,:)=nan + + allocate(this%dwt_closs_col (begc:endc)) ; this%dwt_closs_col (:) =nan + allocate(this%dwt_seedc_to_leaf_col (begc:endc)) ; this%dwt_seedc_to_leaf_col (:) =nan + allocate(this%dwt_seedc_to_deadstem_col (begc:endc)) ; this%dwt_seedc_to_deadstem_col (:) =nan + allocate(this%dwt_conv_cflux_col (begc:endc)) ; this%dwt_conv_cflux_col (:) =nan + allocate(this%dwt_prod10c_gain_col (begc:endc)) ; this%dwt_prod10c_gain_col (:) =nan + allocate(this%dwt_prod100c_gain_col (begc:endc)) ; this%dwt_prod100c_gain_col (:) =nan + allocate(this%prod10c_loss_col (begc:endc)) ; this%prod10c_loss_col (:) =nan + allocate(this%prod100c_loss_col (begc:endc)) ; this%prod100c_loss_col (:) =nan + allocate(this%product_closs_col (begc:endc)) ; this%product_closs_col (:) =nan + + allocate(this%cwdc_hr_col (begc:endc)) ; this%cwdc_hr_col (:) =nan + allocate(this%cwdc_loss_col (begc:endc)) ; this%cwdc_loss_col (:) =nan + allocate(this%litterc_loss_col (begc:endc)) ; this%litterc_loss_col (:) =nan + + allocate(this%hrv_deadstemc_to_prod10c_col(begc:endc)) + this%hrv_deadstemc_to_prod10c_col(:)= nan + + allocate(this%hrv_deadstemc_to_prod100c_col(begc:endc)) + this%hrv_deadstemc_to_prod100c_col(:)= nan + + allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan + + allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_col(:,:)= nan + + allocate(this%hrv_deadstemc_to_prod10c_col(begc:endc)) + this%hrv_deadstemc_to_prod10c_col(:)= nan + + allocate(this%hrv_deadstemc_to_prod100c_col(begc:endc)) + this%hrv_deadstemc_to_prod100c_col(:)= nan + + allocate(this%m_decomp_cpools_to_fire_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_vr_col(:,:,:)= nan + + allocate(this%m_decomp_cpools_to_fire_col(begc:endc,1:ndecomp_pools)) + this%m_decomp_cpools_to_fire_col(:,:)= nan + + allocate(this%rr_patch (begp:endp)) ; this%rr_patch (:) = nan + allocate(this%mr_patch (begp:endp)) ; this%mr_patch (:) = nan + allocate(this%gr_patch (begp:endp)) ; this%gr_patch (:) = nan + allocate(this%ar_patch (begp:endp)) ; this%ar_patch (:) = nan + allocate(this%npp_patch (begp:endp)) ; this%npp_patch (:) = nan + allocate(this%agnpp_patch (begp:endp)) ; this%agnpp_patch (:) = nan + allocate(this%bgnpp_patch (begp:endp)) ; this%bgnpp_patch (:) = nan + allocate(this%litfall_patch (begp:endp)) ; this%litfall_patch (:) = nan + allocate(this%wood_harvestc_patch (begp:endp)) ; this%wood_harvestc_patch (:) = nan + allocate(this%cinputs_patch (begp:endp)) ; this%cinputs_patch (:) = nan + allocate(this%coutputs_patch (begp:endp)) ; this%coutputs_patch (:) = nan + allocate(this%gpp_patch (begp:endp)) ; this%gpp_patch (:) = nan + allocate(this%fire_closs_patch (begp:endp)) ; this%fire_closs_patch (:) = nan + allocate(this%sr_col (begc:endc)) ; this%sr_col (:) = nan + allocate(this%er_col (begc:endc)) ; this%er_col (:) = nan + allocate(this%litfire_col (begc:endc)) ; this%litfire_col (:) = nan + allocate(this%somfire_col (begc:endc)) ; this%somfire_col (:) = nan + allocate(this%totfire_col (begc:endc)) ; this%totfire_col (:) = nan + allocate(this%rr_col (begc:endc)) ; this%rr_col (:) = nan + allocate(this%ar_col (begc:endc)) ; this%ar_col (:) = nan + allocate(this%gpp_col (begc:endc)) ; this%gpp_col (:) = nan + allocate(this%npp_col (begc:endc)) ; this%npp_col (:) = nan + allocate(this%fire_closs_p2c_col (begc:endc)) ; this%fire_closs_p2c_col (:) = nan + allocate(this%fire_closs_col (begc:endc)) ; this%fire_closs_col (:) = nan + allocate(this%litfall_col (begc:endc)) ; this%litfall_col (:) = nan + allocate(this%wood_harvestc_col (begc:endc)) ; this%wood_harvestc_col (:) = nan + allocate(this%hrv_xsmrpool_to_atm_col (begc:endc)) ; this%hrv_xsmrpool_to_atm_col (:) = nan + allocate(this%tempsum_npp_patch (begp:endp)) ; this%tempsum_npp_patch (:) = nan + allocate(this%annsum_npp_patch (begp:endp)) ; this%annsum_npp_patch (:) = nan + allocate(this%tempsum_litfall_patch (begp:endp)) ; this%tempsum_litfall_patch (:) = nan + allocate(this%annsum_litfall_patch (begp:endp)) ; this%annsum_litfall_patch (:) = nan + allocate(this%annsum_npp_col (begc:endc)) ; this%annsum_npp_col (:) = nan + allocate(this%lag_npp_col (begc:endc)) ; this%lag_npp_col (:) = spval + + allocate(this%nep_col (begc:endc)) ; this%nep_col (:) = nan + allocate(this%nbp_col (begc:endc)) ; this%nbp_col (:) = nan + allocate(this%nee_col (begc:endc)) ; this%nee_col (:) = nan + allocate(this%landuptake_col (begc:endc)) ; this%landuptake_col (:) = nan + allocate(this%landuseflux_col (begc:endc)) ; this%landuseflux_col (:) = nan + + end subroutine InitAllocate; + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, carbon_type) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use clm_varpar , only : nlevdecomp, nlevdecomp_full, nlevgrnd + use clm_varctl , only : hist_wrtch4diag + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj + character(8) :: vr_suffix + character(10) :: active + integer :: begp,endp + integer :: begc,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + !------------------------------- + ! C flux variables - patch + !------------------------------- + + if (carbon_type == 'c12') then + + if (crop_prog) then + this%grainc_to_food_patch(begp:endp) = spval + call hist_addfld1d (fname='GRAINC_TO_FOOD', units='gC/m^2/s', & + avgflag='A', long_name='grain C to food', & + ptr_patch=this%grainc_to_food_patch) + end if + + this%litterc_loss_col(begc:endc) = spval + call hist_addfld1d (fname='LITTERC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='litter C loss', & + ptr_col=this%litterc_loss_col) + + this%woodc_alloc_patch(begp:endp) = spval + call hist_addfld1d (fname='WOODC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='wood C eallocation', & + ptr_patch=this%woodc_alloc_patch) + + this%woodc_loss_patch(begp:endp) = spval + call hist_addfld1d (fname='WOODC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='wood C loss', & + ptr_patch=this%woodc_loss_patch) + + this%leafc_loss_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='leaf C loss', & + ptr_patch=this%leafc_loss_patch) + + this%leafc_alloc_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='leaf C allocation', & + ptr_patch=this%leafc_alloc_patch) + + this%frootc_loss_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='fine root C loss', & + ptr_patch=this%frootc_loss_patch) + + this%frootc_alloc_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='fine root C allocation', & + ptr_patch=this%frootc_alloc_patch) + + this%m_leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C mortality', & + ptr_patch=this%m_leafc_to_litter_patch, default='inactive') + + this%m_frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C mortality', & + ptr_patch=this%m_frootc_to_litter_patch, default='inactive') + + this%m_leafc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C storage mortality', & + ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive') + + this%m_frootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage mortality', & + ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive') + + this%m_livestemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage mortality', & + ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive') + + this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage mortality', & + ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive') + + this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C storage mortality', & + ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive') + + this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C storage mortality', & + ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive') + + this%m_leafc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer mortality', & + ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive') + + this%m_frootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer mortality', & + ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer mortality', & + ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive') + + this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer mortality', & + ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive') + + this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C transfer mortality', & + ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive') + + this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C transfer mortality', & + ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C mortality', & + ptr_patch=this%m_livestemc_to_litter_patch, default='inactive') + + this%m_deadstemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C mortality', & + ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive') + + this%m_livecrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C mortality', & + ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive') + + this%m_deadcrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C mortality', & + ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive') + + this%m_gresp_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage mortality', & + ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive') + + this%m_gresp_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer mortality', & + ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive') + + this%m_leafc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C fire loss', & + ptr_patch=this%m_leafc_to_fire_patch, default='inactive') + + this%m_leafc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C storage fire loss', & + ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive') + + this%m_leafc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer fire loss', & + ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive') + + this%m_livestemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C fire loss', & + ptr_patch=this%m_livestemc_to_fire_patch, default='inactive') + + this%m_livestemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage fire loss', & + ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive') + + this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer fire loss', & + ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive') + + this%m_deadstemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C fire loss', & + ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive') + + this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage fire loss', & + ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive') + + this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer fire loss', & + ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive') + + this%m_frootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C fire loss', & + ptr_patch=this%m_frootc_to_fire_patch, default='inactive') + + this%m_frootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage fire loss', & + ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive') + + this%m_frootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer fire loss', & + ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive') + + this%m_livecrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C fire loss', & + ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive') + + this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C storage fire loss', & + ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive') + + this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C transfer fire loss', & + ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive') + + this%m_deadcrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C fire loss', & + ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive') + + this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C storage fire loss', & + ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive') + + this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C transfer fire loss', & + ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive') + + this%m_gresp_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage fire loss', & + ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive') + + this%m_gresp_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer fire loss', & + ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive') + + this%m_leafc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C fire mortality to litter', & + ptr_patch=this%m_leafc_to_litter_fire_patch, default='inactive') + + ! add by F. Li and S. Levis + this%m_leafc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C fire mortality to litter', & + ptr_patch=this%m_leafc_storage_to_litter_fire_patch, default='inactive') + + this%m_leafc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer fire mortality to litter', & + ptr_patch=this%m_leafc_xfer_to_litter_fire_patch, default='inactive') + + this%m_livestemc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C fire mortality to litter', & + ptr_patch=this%m_livestemc_to_litter_fire_patch, default='inactive') + + this%m_livestemc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage fire mortality to litter', & + ptr_patch=this%m_livestemc_storage_to_litter_fire_patch, default='inactive') + + this%m_livestemc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer fire mortality to litter', & + ptr_patch=this%m_livestemc_xfer_to_litter_fire_patch, default='inactive') + + this%m_livestemc_to_deadstemc_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMC_TO_DEADSTEMC_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C fire mortality to dead stem C', & + ptr_patch=this%m_livestemc_to_deadstemc_fire_patch, default='inactive') + + this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C fire mortality to litter', & + ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive') + + this%m_deadstemc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage fire mortality to litter', & + ptr_patch=this%m_deadstemc_storage_to_litter_fire_patch, default='inactive') + + this%m_deadstemc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer fire mortality to litter', & + ptr_patch=this%m_deadstemc_xfer_to_litter_fire_patch, default='inactive') + + this%m_frootc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C fire mortality to litter', & + ptr_patch=this%m_frootc_to_litter_fire_patch, default='inactive') + + this%m_frootc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage fire mortality to litter', & + ptr_patch=this%m_frootc_storage_to_litter_fire_patch, default='inactive') + + this%m_frootc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer fire mortality to litter', & + ptr_patch=this%m_frootc_xfer_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C fire mortality to litter', & + ptr_patch=this%m_livecrootc_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C storage fire mortality to litter', & + ptr_patch=this%m_livecrootc_storage_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C transfer fire mortality to litter', & + ptr_patch=this%m_livecrootc_xfer_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_to_deadcrootc_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVEROOTC_TO_DEADROOTC_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live root C fire mortality to dead root C', & + ptr_patch=this%m_livecrootc_to_deadcrootc_fire_patch, default='inactive') + + + this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C fire mortality to litter', & + ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive') + + this%m_deadcrootc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C storage fire mortality to litter', & + ptr_patch=this%m_deadcrootc_storage_to_litter_fire_patch, default='inactive') + + this%m_deadcrootc_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADROOTC_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead root C transfer fire mortality to litter', & + ptr_patch=this%m_deadcrootc_xfer_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C fire mortality to litter', & + ptr_patch=this%m_livecrootc_storage_to_litter_fire_patch, default='inactive') + + this%m_deadcrootc_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C storage fire mortality to litter', & + ptr_patch=this%m_deadcrootc_storage_to_litter_fire_patch, default='inactive') + + this%m_gresp_storage_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage fire mortality to litter', & + ptr_patch=this%m_gresp_storage_to_litter_fire_patch, default='inactive') + + this%m_gresp_xfer_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_GRESP_XFER_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer fire mortality to litter', & + ptr_patch=this%m_gresp_xfer_to_litter_fire_patch, default='inactive') + + this%leafc_xfer_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_XFER_TO_LEAFC', units='gC/m^2/s', & + avgflag='A', long_name='leaf C growth from storage', & + ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive') + + this%frootc_xfer_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_XFER_TO_FROOTC', units='gC/m^2/s', & + avgflag='A', long_name='fine root C growth from storage', & + ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive') + + this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_XFER_TO_LIVESTEMC', units='gC/m^2/s', & + avgflag='A', long_name='live stem C growth from storage', & + ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive') + + this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC_XFER_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C growth from storage', & + ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive') + + this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC_XFER_TO_LIVECROOTC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C growth from storage', & + ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive') + + this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTC_XFER_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C growth from storage', & + ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive') + + this%leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C litterfall', & + ptr_patch=this%leafc_to_litter_patch, default='inactive') + + this%frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C litterfall', & + ptr_patch=this%frootc_to_litter_patch, default='inactive') + + this%leaf_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAF_MR', units='gC/m^2/s', & + avgflag='A', long_name='leaf maintenance respiration', & + ptr_patch=this%leaf_mr_patch) + + this%froot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOT_MR', units='gC/m^2/s', & + avgflag='A', long_name='fine root maintenance respiration', & + ptr_patch=this%froot_mr_patch, default='inactive') + + this%livestem_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEM_MR', units='gC/m^2/s', & + avgflag='A', long_name='live stem maintenance respiration', & + ptr_patch=this%livestem_mr_patch, default='inactive') + + this%livecroot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOT_MR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root maintenance respiration', & + ptr_patch=this%livecroot_mr_patch, default='inactive') + + this%psnsun_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSUN_TO_CPOOL', units='gC/m^2/s', & + avgflag='A', long_name='C fixation from sunlit canopy', & + ptr_patch=this%psnsun_to_cpool_patch) + + this%psnshade_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSHADE_TO_CPOOL', units='gC/m^2/s', & + avgflag='A', long_name='C fixation from shaded canopy', & + ptr_patch=this%psnshade_to_cpool_patch) + + this%cpool_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LEAFC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to leaf C', & + ptr_patch=this%cpool_to_leafc_patch, default='inactive') + + this%cpool_to_leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LEAFC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to leaf C storage', & + ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive') + + this%cpool_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_FROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to fine root C', & + ptr_patch=this%cpool_to_frootc_patch, default='inactive') + + this%cpool_to_frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_FROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to fine root C storage', & + ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive') + + this%cpool_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live stem C', & + ptr_patch=this%cpool_to_livestemc_patch, default='inactive') + + this%cpool_to_livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live stem C storage', & + ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive') + + this%cpool_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead stem C', & + ptr_patch=this%cpool_to_deadstemc_patch, default='inactive') + + this%cpool_to_deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead stem C storage', & + ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive') + + this%cpool_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live coarse root C', & + ptr_patch=this%cpool_to_livecrootc_patch, default='inactive') + + this%cpool_to_livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live coarse root C storage', & + ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive') + + this%cpool_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root C', & + ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive') + + this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root C storage', & + ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive') + + this%cpool_to_gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_TO_GRESP_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to growth respiration storage', & + ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive') + + this%cpool_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LEAF_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration', & + ptr_patch=this%cpool_leaf_gr_patch, default='inactive') + + this%cpool_leaf_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LEAF_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration to storage', & + ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive') + + this%transfer_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_LEAF_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration from storage', & + ptr_patch=this%transfer_leaf_gr_patch, default='inactive') + + this%cpool_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_FROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration', & + ptr_patch=this%cpool_froot_gr_patch, default='inactive') + + this%cpool_froot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_FROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration to storage', & + ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive') + + this%transfer_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_FROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration from storage', & + ptr_patch=this%transfer_froot_gr_patch, default='inactive') + + this%cpool_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LIVESTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration', & + ptr_patch=this%cpool_livestem_gr_patch, default='inactive') + + this%cpool_livestem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LIVESTEM_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration to storage', & + ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive') + + this%transfer_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_LIVESTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration from storage', & + ptr_patch=this%transfer_livestem_gr_patch, default='inactive') + + this%cpool_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_DEADSTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration', & + ptr_patch=this%cpool_deadstem_gr_patch, default='inactive') + + this%cpool_deadstem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_DEADSTEM_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration to storage', & + ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive') + + this%transfer_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_DEADSTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration from storage', & + ptr_patch=this%transfer_deadstem_gr_patch, default='inactive') + + this%cpool_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LIVECROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration', & + ptr_patch=this%cpool_livecroot_gr_patch, default='inactive') + + this%cpool_livecroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_LIVECROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration to storage', & + ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive') + + this%transfer_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_LIVECROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration from storage', & + ptr_patch=this%transfer_livecroot_gr_patch, default='inactive') + + this%cpool_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_DEADCROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration', & + ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive') + + this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL_DEADCROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration to storage', & + ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive') + + this%transfer_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_DEADCROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration from storage', & + ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive') + + this%leafc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C shift storage to transfer', & + ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive') + + this%frootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C shift storage to transfer', & + ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive') + + this%livestemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C shift storage to transfer', & + ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive') + + this%deadstemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C shift storage to transfer', & + ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive') + + this%livecrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C shift storage to transfer', & + ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive') + + this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C shift storage to transfer', & + ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive') + + this%gresp_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='GRESP_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration shift storage to transfer', & + ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive') + + this%livestemc_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='live stem C turnover', & + ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive') + + this%livecrootc_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C turnover', & + ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive') + + this%gpp_before_downreg_patch(begp:endp) = spval + call hist_addfld1d (fname='INIT_GPP', units='gC/m^2/s', & + avgflag='A', long_name='GPP flux before downregulation', & + ptr_patch=this%gpp_before_downreg_patch, default='inactive') + + this%current_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='CURRENT_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for new growth displayed in this timestep', & + ptr_patch=this%current_gr_patch, default='inactive') + + this%transfer_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='TRANSFER_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for transfer growth displayed in this timestep', & + ptr_patch=this%transfer_gr_patch, default='inactive') + + this%storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for growth sent to storage for later display', & + ptr_patch=this%storage_gr_patch, default='inactive') + + this%availc_patch(begp:endp) = spval + call hist_addfld1d (fname='AVAILC', units='gC/m^2/s', & + avgflag='A', long_name='C flux available for allocation', & + ptr_patch=this%availc_patch, default='inactive') + + this%plant_calloc_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANT_CALLOC', units='gC/m^2/s', & + avgflag='A', long_name='total allocated C flux', & + ptr_patch=this%plant_calloc_patch, default='inactive') + + this%excess_cflux_patch(begp:endp) = spval + call hist_addfld1d (fname='EXCESS_CFLUX', units='gC/m^2/s', & + avgflag='A', long_name='C flux not allocated due to downregulation', & + ptr_patch=this%excess_cflux_patch, default='inactive') + + this%prev_leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='PREV_LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='previous timestep leaf C litterfall flux', & + ptr_patch=this%prev_leafc_to_litter_patch, default='inactive') + + this%prev_frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='PREV_FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='previous timestep froot C litterfall flux', & + ptr_patch=this%prev_frootc_to_litter_patch, default='inactive') + + this%xsmrpool_recover_patch(begp:endp) = spval + call hist_addfld1d (fname='XSMRPOOL_RECOVER', units='gC/m^2/s', & + avgflag='A', long_name='C flux assigned to recovery of negative xsmrpool', & + ptr_patch=this%xsmrpool_recover_patch) + + this%gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='GPP', units='gC/m^2/s', & + avgflag='A', long_name='gross primary production', & + ptr_patch=this%gpp_patch) + + this%rr_patch(begp:endp) = spval + call hist_addfld1d (fname='RR', units='gC/m^2/s', & + avgflag='A', long_name='root respiration (fine root MR + total root GR)', & + ptr_patch=this%rr_patch) + + this%mr_patch(begp:endp) = spval + call hist_addfld1d (fname='MR', units='gC/m^2/s', & + avgflag='A', long_name='maintenance respiration', & + ptr_patch=this%mr_patch) + + this%gr_patch(begp:endp) = spval + call hist_addfld1d (fname='GR', units='gC/m^2/s', & + avgflag='A', long_name='total growth respiration', & + ptr_patch=this%gr_patch) + + this%ar_patch(begp:endp) = spval + call hist_addfld1d (fname='AR', units='gC/m^2/s', & + avgflag='A', long_name='autotrophic respiration (MR + GR)', & + ptr_patch=this%ar_patch) + + this%npp_patch(begp:endp) = spval + call hist_addfld1d (fname='NPP', units='gC/m^2/s', & + avgflag='A', long_name='net primary production', & + ptr_patch=this%npp_patch) + + this%agnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='AGNPP', units='gC/m^2/s', & + avgflag='A', long_name='aboveground NPP', & + ptr_patch=this%agnpp_patch) + + this%bgnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='BGNPP', units='gC/m^2/s', & + avgflag='A', long_name='belowground NPP', & + ptr_patch=this%bgnpp_patch) + + this%litfall_patch(begp:endp) = spval + call hist_addfld1d (fname='LITFALL', units='gC/m^2/s', & + avgflag='A', long_name='litterfall (leaves and fine roots)', & + ptr_patch=this%litfall_patch) + + this%wood_harvestc_patch(begp:endp) = spval + call hist_addfld1d (fname='WOOD_HARVESTC', units='gC/m^2/s', & + avgflag='A', long_name='wood harvest carbon (to product pools)', & + ptr_patch=this%wood_harvestc_patch) + + this%fire_closs_patch(begp:endp) = spval + call hist_addfld1d (fname='PFT_FIRE_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total patch-level fire C loss for non-peat fires outside land-type converted region', & + ptr_patch=this%fire_closs_patch) + + end if ! end of if-c12 + + !------------------------------- + ! C13 flux variables - patch + !------------------------------- + + if ( carbon_type == 'c13') then + + this%gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_GPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 gross primary production', & + ptr_patch=this%gpp_patch) + + this%rr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_RR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 root respiration (fine root MR + total root GR)', & + ptr_patch=this%rr_patch) + + this%mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 maintenance respiration', & + ptr_patch=this%mr_patch) + + this%gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total growth respiration', & + ptr_patch=this%gr_patch) + + this%ar_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_AR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 autotrophic respiration (MR + GR)', & + ptr_patch=this%ar_patch) + + this%npp_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_NPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net primary production', & + ptr_patch=this%npp_patch) + + this%agnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_AGNPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 aboveground NPP', & + ptr_patch=this%agnpp_patch) + + this%bgnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_BGNPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 belowground NPP', & + ptr_patch=this%bgnpp_patch) + + this%litfall_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LITFALL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litterfall (leaves and fine roots)', & + ptr_patch=this%litfall_patch, default='inactive') + + this%fire_closs_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PFT_FIRE_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total patch-level fire C loss', & + ptr_patch=this%fire_closs_patch) + + this%m_leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C mortality', & + ptr_patch=this%m_leafc_to_litter_patch, default='inactive') + + this%m_frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C mortality', & + ptr_patch=this%m_frootc_to_litter_patch, default='inactive') + + this%m_leafc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C storage mortality', & + ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive') + + this%m_frootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C storage mortality', & + ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive') + + this%m_livestemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C storage mortality', & + ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive') + + this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C storage mortality', & + ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive') + + this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C storage mortality', & + ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive') + + this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C storage mortality', & + ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive') + + this%m_leafc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C transfer mortality', & + ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive') + + this%m_frootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C transfer mortality', & + ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C transfer mortality', & + ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive') + + this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C transfer mortality', & + ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive') + + this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C transfer mortality', & + ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive') + + this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C transfer mortality', & + ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C mortality', & + ptr_patch=this%m_livestemc_to_litter_patch, default='inactive') + + this%m_deadstemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C mortality', & + ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive') + + this%m_livecrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C mortality', & + ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive') + + this%m_deadcrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C mortality', & + ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive') + + this%m_gresp_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration storage mortality', & + ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive') + + this%m_gresp_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration transfer mortality', & + ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive') + + this%m_leafc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C fire loss', & + ptr_patch=this%m_leafc_to_fire_patch, default='inactive') + + this%m_frootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C fire loss', & + ptr_patch=this%m_frootc_to_fire_patch, default='inactive') + + this%m_leafc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C storage fire loss', & + ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive') + + this%m_frootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C storage fire loss', & + ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive') + + this%m_livestemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C storage fire loss', & + ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive') + + this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C storage fire loss', & + ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive') + + this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C storage fire loss', & + ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive') + + this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C storage fire loss', & + ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive') + + this%m_leafc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C transfer fire loss', & + ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive') + + this%m_frootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C transfer fire loss', & + ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive') + + this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C transfer fire loss', & + ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive') + + this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C transfer fire loss', & + ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive') + + this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C transfer fire loss', & + ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive') + + this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C transfer fire loss', & + ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive') + + this%m_livestemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C fire loss', & + ptr_patch=this%m_livestemc_to_fire_patch, default='inactive') + + this%m_deadstemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C fire loss', & + ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive') + + this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C fire mortality to litter', & + ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C fire loss', & + ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive') + + this%m_deadcrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C fire loss', & + ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive') + + this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C fire mortality to litter', & + ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive') + + this%m_gresp_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration storage fire loss', & + ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive') + + this%m_gresp_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration transfer fire loss', & + ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive') + + this%leafc_xfer_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC_XFER_TO_LEAFC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C growth from storage', & + ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive') + + this%frootc_xfer_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC_XFER_TO_FROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C growth from storage', & + ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive') + + this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC_XFER_TO_LIVESTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C growth from storage', & + ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive') + + this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADSTEMC_XFER_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C growth from storage', & + ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive') + + this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC_XFER_TO_LIVECROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C growth from storage', & + ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive') + + this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADCROOTC_XFER_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C growth from storage', & + ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive') + + this%leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C litterfall', & + ptr_patch=this%leafc_to_litter_patch, default='inactive') + + this%frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall', & + ptr_patch=this%frootc_to_litter_patch, default='inactive') + + this%leaf_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAF_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf maintenance respiration', & + ptr_patch=this%leaf_mr_patch, default='inactive') + + this%froot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOT_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root maintenance respiration', & + ptr_patch=this%froot_mr_patch, default='inactive') + + this%livestem_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEM_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem maintenance respiration', & + ptr_patch=this%livestem_mr_patch, default='inactive') + + this%livecroot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOT_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root maintenance respiration', & + ptr_patch=this%livecroot_mr_patch, default='inactive') + + this%psnsun_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSUN_TO_CPOOL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 C fixation from sunlit canopy', & + ptr_patch=this%psnsun_to_cpool_patch) + + this%psnshade_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSHADE_TO_CPOOL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 C fixation from shaded canopy', & + ptr_patch=this%psnshade_to_cpool_patch) + + this%cpool_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to leaf C', & + ptr_patch=this%cpool_to_leafc_patch, default='inactive') + + this%cpool_to_leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to leaf C storage', & + ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive') + + this%cpool_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to fine root C', & + ptr_patch=this%cpool_to_frootc_patch, default='inactive') + + this%cpool_to_frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to fine root C storage', & + ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive') + + this%cpool_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live stem C', & + ptr_patch=this%cpool_to_livestemc_patch, default='inactive') + + this%cpool_to_livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live stem C storage', & + ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive') + + this%cpool_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead stem C', & + ptr_patch=this%cpool_to_deadstemc_patch, default='inactive') + + this%cpool_to_deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead stem C storage', & + ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive') + + this%cpool_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live coarse root C', & + ptr_patch=this%cpool_to_livecrootc_patch, default='inactive') + + this%cpool_to_livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live coarse root C storage', & + ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive') + + this%cpool_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead coarse root C', & + ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive') + + this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead coarse root C storage', & + ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive') + + this%cpool_to_gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_TO_GRESP_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to growth respiration storage', & + ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive') + + this%cpool_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LEAF_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration', & + ptr_patch=this%cpool_leaf_gr_patch, default='inactive') + + this%cpool_leaf_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LEAF_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration to storage', & + ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive') + + this%transfer_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_LEAF_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration from storage', & + ptr_patch=this%transfer_leaf_gr_patch, default='inactive') + + this%cpool_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_FROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration', & + ptr_patch=this%cpool_froot_gr_patch, default='inactive') + + this%cpool_froot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_FROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration to storage', & + ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive') + + this%transfer_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_FROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration from storage', & + ptr_patch=this%transfer_froot_gr_patch, default='inactive') + + this%cpool_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration', & + ptr_patch=this%cpool_livestem_gr_patch, default='inactive') + + this%cpool_livestem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration to storage', & + ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive') + + this%transfer_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_LIVESTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration from storage', & + ptr_patch=this%transfer_livestem_gr_patch, default='inactive') + + this%cpool_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration', & + ptr_patch=this%cpool_deadstem_gr_patch, default='inactive') + + this%cpool_deadstem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration to storage', & + ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive') + + this%transfer_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_DEADSTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration from storage', & + ptr_patch=this%transfer_deadstem_gr_patch, default='inactive') + + this%cpool_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration', & + ptr_patch=this%cpool_livecroot_gr_patch, default='inactive') + + this%cpool_livecroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration to storage', & + ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive') + + this%transfer_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_LIVECROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration from storage', & + ptr_patch=this%transfer_livecroot_gr_patch, default='inactive') + + this%cpool_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration', & + ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive') + + this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration to storage', & + ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive') + + this%transfer_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_DEADCROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration from storage', & + ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive') + + this%leafc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C shift storage to transfer', & + ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive') + + this%frootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C shift storage to transfer', & + ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive') + + this%livestemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C shift storage to transfer', & + ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive') + + this%deadstemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C shift storage to transfer', & + ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive') + + this%livecrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C shift storage to transfer', & + ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive') + + this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C shift storage to transfer', & + ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive') + + this%gresp_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_GRESP_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration shift storage to transfer', & + ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive') + + this%livestemc_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C turnover', & + ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive') + + this%livecrootc_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C turnover', & + ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive') + + this%current_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CURRENT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for new growth displayed in this timestep', & + ptr_patch=this%current_gr_patch, default='inactive') + + this%transfer_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TRANSFER_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for transfer growth displayed in this timestep', & + ptr_patch=this%transfer_gr_patch, default='inactive') + + this%storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for growth sent to storage for later display', & + ptr_patch=this%storage_gr_patch, default='inactive') + + this%xsmrpool_c13ratio_patch(begp:endp) = spval + call hist_addfld1d (fname='XSMRPOOL_C13RATIO', units='proportion', & + avgflag='A', long_name='C13/C(12+13) ratio for xsmrpool', & + ptr_patch=this%xsmrpool_c13ratio_patch, default='inactive') + + endif + + !------------------------------- + ! C14 flux variables - patch + !------------------------------- + + if ( carbon_type == 'c14' ) then + + this%m_leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C mortality', & + ptr_patch=this%m_leafc_to_litter_patch, default='inactive') + + this%m_frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C mortality', & + ptr_patch=this%m_frootc_to_litter_patch, default='inactive') + + this%m_leafc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C storage mortality', & + ptr_patch=this%m_leafc_storage_to_litter_patch, default='inactive') + + this%m_frootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C storage mortality', & + ptr_patch=this%m_frootc_storage_to_litter_patch, default='inactive') + + this%m_livestemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C storage mortality', & + ptr_patch=this%m_livestemc_storage_to_litter_patch, default='inactive') + + this%m_deadstemc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C storage mortality', & + ptr_patch=this%m_deadstemc_storage_to_litter_patch, default='inactive') + + this%m_livecrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C storage mortality', & + ptr_patch=this%m_livecrootc_storage_to_litter_patch, default='inactive') + + this%m_deadcrootc_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C storage mortality', & + ptr_patch=this%m_deadcrootc_storage_to_litter_patch, default='inactive') + + this%m_leafc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C transfer mortality', & + ptr_patch=this%m_leafc_xfer_to_litter_patch, default='inactive') + + this%m_frootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C transfer mortality', & + ptr_patch=this%m_frootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C transfer mortality', & + ptr_patch=this%m_livestemc_xfer_to_litter_patch, default='inactive') + + this%m_deadstemc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C transfer mortality', & + ptr_patch=this%m_deadstemc_xfer_to_litter_patch, default='inactive') + + this%m_livecrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C transfer mortality', & + ptr_patch=this%m_livecrootc_xfer_to_litter_patch, default='inactive') + + this%m_deadcrootc_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C transfer mortality', & + ptr_patch=this%m_deadcrootc_xfer_to_litter_patch, default='inactive') + + this%m_livestemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C mortality', & + ptr_patch=this%m_livestemc_to_litter_patch, default='inactive') + + this%m_deadstemc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C mortality', & + ptr_patch=this%m_deadstemc_to_litter_patch, default='inactive') + + this%m_livecrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C mortality', & + ptr_patch=this%m_livecrootc_to_litter_patch, default='inactive') + + this%m_deadcrootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C mortality', & + ptr_patch=this%m_deadcrootc_to_litter_patch, default='inactive') + + this%m_gresp_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_GRESP_STORAGE_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth respiration storage mortality', & + ptr_patch=this%m_gresp_storage_to_litter_patch, default='inactive') + + this%m_gresp_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_GRESP_XFER_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth respiration transfer mortality', & + ptr_patch=this%m_gresp_xfer_to_litter_patch, default='inactive') + + this%m_leafc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C fire loss', & + ptr_patch=this%m_leafc_to_fire_patch, default='inactive') + + this%m_frootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C fire loss', & + ptr_patch=this%m_frootc_to_fire_patch, default='inactive') + + this%m_leafc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C storage fire loss', & + ptr_patch=this%m_leafc_storage_to_fire_patch, default='inactive') + + this%m_frootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C storage fire loss', & + ptr_patch=this%m_frootc_storage_to_fire_patch, default='inactive') + + this%m_livestemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C storage fire loss', & + ptr_patch=this%m_livestemc_storage_to_fire_patch, default='inactive') + + this%m_deadstemc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C storage fire loss', & + ptr_patch=this%m_deadstemc_storage_to_fire_patch, default='inactive') + + this%m_livecrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C storage fire loss', & + ptr_patch=this%m_livecrootc_storage_to_fire_patch, default='inactive') + + this%m_deadcrootc_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C storage fire loss', & + ptr_patch=this%m_deadcrootc_storage_to_fire_patch, default='inactive') + + this%m_leafc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LEAFC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C transfer fire loss', & + ptr_patch=this%m_leafc_xfer_to_fire_patch, default='inactive') + + this%m_frootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_FROOTC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C transfer fire loss', & + ptr_patch=this%m_frootc_xfer_to_fire_patch, default='inactive') + + this%m_livestemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C transfer fire loss', & + ptr_patch=this%m_livestemc_xfer_to_fire_patch, default='inactive') + + this%m_deadstemc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C transfer fire loss', & + ptr_patch=this%m_deadstemc_xfer_to_fire_patch, default='inactive') + + this%m_livecrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C transfer fire loss', & + ptr_patch=this%m_livecrootc_xfer_to_fire_patch, default='inactive') + + this%m_deadcrootc_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C transfer fire loss', & + ptr_patch=this%m_deadcrootc_xfer_to_fire_patch, default='inactive') + + this%m_livestemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVESTEMC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C fire loss', & + ptr_patch=this%m_livestemc_to_fire_patch, default='inactive') + + this%m_deadstemc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C fire loss', & + ptr_patch=this%m_deadstemc_to_fire_patch, default='inactive') + + this%m_deadstemc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADSTEMC_TO_LITTER_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C fire mortality to litter', & + ptr_patch=this%m_deadstemc_to_litter_fire_patch, default='inactive') + + this%m_livecrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_LIVECROOTC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C fire loss', & + ptr_patch=this%m_livecrootc_to_fire_patch, default='inactive') + + this%m_deadcrootc_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C fire loss', & + ptr_patch=this%m_deadcrootc_to_fire_patch, default='inactive') + + this%m_deadcrootc_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_DEADCROOTC_TO_LITTER_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C fire mortality to litter', & + ptr_patch=this%m_deadcrootc_to_litter_fire_patch, default='inactive') + + this%m_gresp_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_GRESP_STORAGE_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth respiration storage fire loss', & + ptr_patch=this%m_gresp_storage_to_fire_patch, default='inactive') + + this%m_gresp_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_M_GRESP_XFER_TO_FIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth respiration transfer fire loss', & + ptr_patch=this%m_gresp_xfer_to_fire_patch, default='inactive') + + this%leafc_xfer_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC_XFER_TO_LEAFC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C growth from storage', & + ptr_patch=this%leafc_xfer_to_leafc_patch, default='inactive') + + this%frootc_xfer_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC_XFER_TO_FROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C growth from storage', & + ptr_patch=this%frootc_xfer_to_frootc_patch, default='inactive') + + this%livestemc_xfer_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC_XFER_TO_LIVESTEMC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C growth from storage', & + ptr_patch=this%livestemc_xfer_to_livestemc_patch, default='inactive') + + this%deadstemc_xfer_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADSTEMC_XFER_TO_DEADSTEMC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C growth from storage', & + ptr_patch=this%deadstemc_xfer_to_deadstemc_patch, default='inactive') + + this%livecrootc_xfer_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC_XFER_TO_LIVECROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C growth from storage', & + ptr_patch=this%livecrootc_xfer_to_livecrootc_patch, default='inactive') + + this%deadcrootc_xfer_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADCROOTC_XFER_TO_DEADCROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C growth from storage', & + ptr_patch=this%deadcrootc_xfer_to_deadcrootc_patch, default='inactive') + + this%leafc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C litterfall', & + ptr_patch=this%leafc_to_litter_patch, default='inactive') + + this%frootc_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC_TO_LITTER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C litterfall', & + ptr_patch=this%frootc_to_litter_patch, default='inactive') + + this%leaf_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAF_MR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf maintenance respiration', & + ptr_patch=this%leaf_mr_patch, default='inactive') + + this%froot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOT_MR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root maintenance respiration', & + ptr_patch=this%froot_mr_patch, default='inactive') + + this%livestem_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEM_MR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem maintenance respiration', & + ptr_patch=this%livestem_mr_patch, default='inactive') + + this%livecroot_mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOT_MR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root maintenance respiration', & + ptr_patch=this%livecroot_mr_patch, default='inactive') + + this%psnsun_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSUN_TO_CPOOL', units='gC14/m^2/s', & + avgflag='A', long_name='C14 C fixation from sunlit canopy', & + ptr_patch=this%psnsun_to_cpool_patch) + + this%psnshade_to_cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSHADE_TO_CPOOL', units='gC14/m^2/s', & + avgflag='A', long_name='C14 C fixation from shaded canopy', & + ptr_patch=this%psnshade_to_cpool_patch) + + this%cpool_to_leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LEAFC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to leaf C', & + ptr_patch=this%cpool_to_leafc_patch, default='inactive') + + this%cpool_to_leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LEAFC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to leaf C storage', & + ptr_patch=this%cpool_to_leafc_storage_patch, default='inactive') + + this%cpool_to_frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_FROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to fine root C', & + ptr_patch=this%cpool_to_frootc_patch, default='inactive') + + this%cpool_to_frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_FROOTC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to fine root C storage', & + ptr_patch=this%cpool_to_frootc_storage_patch, default='inactive') + + this%cpool_to_livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LIVESTEMC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to live stem C', & + ptr_patch=this%cpool_to_livestemc_patch, default='inactive') + + this%cpool_to_livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LIVESTEMC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to live stem C storage', & + ptr_patch=this%cpool_to_livestemc_storage_patch, default='inactive') + + this%cpool_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_DEADSTEMC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to dead stem C', & + ptr_patch=this%cpool_to_deadstemc_patch, default='inactive') + + this%cpool_to_deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_DEADSTEMC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to dead stem C storage', & + ptr_patch=this%cpool_to_deadstemc_storage_patch, default='inactive') + + this%cpool_to_livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LIVECROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to live coarse root C', & + ptr_patch=this%cpool_to_livecrootc_patch, default='inactive') + + this%cpool_to_livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_LIVECROOTC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to live coarse root C storage', & + ptr_patch=this%cpool_to_livecrootc_storage_patch, default='inactive') + + this%cpool_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_DEADCROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to dead coarse root C', & + ptr_patch=this%cpool_to_deadcrootc_patch, default='inactive') + + this%cpool_to_deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_DEADCROOTC_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to dead coarse root C storage', & + ptr_patch=this%cpool_to_deadcrootc_storage_patch, default='inactive') + + this%cpool_to_gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_TO_GRESP_STORAGE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 allocation to growth respiration storage', & + ptr_patch=this%cpool_to_gresp_storage_patch, default='inactive') + + this%cpool_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LEAF_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf growth respiration', & + ptr_patch=this%cpool_leaf_gr_patch, default='inactive') + + this%cpool_leaf_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LEAF_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf growth respiration to storage', & + ptr_patch=this%cpool_leaf_storage_gr_patch, default='inactive') + + this%transfer_leaf_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_LEAF_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf growth respiration from storage', & + ptr_patch=this%transfer_leaf_gr_patch, default='inactive') + + this%cpool_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_FROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root growth respiration', & + ptr_patch=this%cpool_froot_gr_patch, default='inactive') + + this%cpool_froot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_FROOT_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root growth respiration to storage', & + ptr_patch=this%cpool_froot_storage_gr_patch, default='inactive') + + this%transfer_froot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_FROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root growth respiration from storage', & + ptr_patch=this%transfer_froot_gr_patch, default='inactive') + + this%cpool_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LIVESTEM_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem growth respiration', & + ptr_patch=this%cpool_livestem_gr_patch, default='inactive') + + this%cpool_livestem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LIVESTEM_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem growth respiration to storage', & + ptr_patch=this%cpool_livestem_storage_gr_patch, default='inactive') + + this%transfer_livestem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_LIVESTEM_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem growth respiration from storage', & + ptr_patch=this%transfer_livestem_gr_patch, default='inactive') + + this%cpool_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_DEADSTEM_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem growth respiration', & + ptr_patch=this%cpool_deadstem_gr_patch, default='inactive') + + this%cpool_deadstem_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_DEADSTEM_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem growth respiration to storage', & + ptr_patch=this%cpool_deadstem_storage_gr_patch, default='inactive') + + this%transfer_deadstem_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_DEADSTEM_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem growth respiration from storage', & + ptr_patch=this%transfer_deadstem_gr_patch, default='inactive') + + this%cpool_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LIVECROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root growth respiration', & + ptr_patch=this%cpool_livecroot_gr_patch, default='inactive') + + this%cpool_livecroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_LIVECROOT_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root growth respiration to storage', & + ptr_patch=this%cpool_livecroot_storage_gr_patch, default='inactive') + + this%transfer_livecroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_LIVECROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root growth respiration from storage', & + ptr_patch=this%transfer_livecroot_gr_patch, default='inactive') + + this%cpool_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_DEADCROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root growth respiration', & + ptr_patch=this%cpool_deadcroot_gr_patch, default='inactive') + + this%cpool_deadcroot_storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL_DEADCROOT_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root growth respiration to storage', & + ptr_patch=this%cpool_deadcroot_storage_gr_patch, default='inactive') + + this%transfer_deadcroot_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_DEADCROOT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root growth respiration from storage', & + ptr_patch=this%transfer_deadcroot_gr_patch, default='inactive') + + this%leafc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 leaf C shift storage to transfer', & + ptr_patch=this%leafc_storage_to_xfer_patch, default='inactive') + + this%frootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C shift storage to transfer', & + ptr_patch=this%frootc_storage_to_xfer_patch, default='inactive') + + this%livestemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C shift storage to transfer', & + ptr_patch=this%livestemc_storage_to_xfer_patch, default='inactive') + + this%deadstemc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADSTEMC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead stem C shift storage to transfer', & + ptr_patch=this%deadstemc_storage_to_xfer_patch, default='inactive') + + this%livecrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C shift storage to transfer', & + ptr_patch=this%livecrootc_storage_to_xfer_patch, default='inactive') + + this%deadcrootc_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADCROOTC_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 dead coarse root C shift storage to transfer', & + ptr_patch=this%deadcrootc_storage_to_xfer_patch, default='inactive') + + this%gresp_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_GRESP_STORAGE_TO_XFER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth respiration shift storage to transfer', & + ptr_patch=this%gresp_storage_to_xfer_patch, default='inactive') + + this%livestemc_to_deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC_TO_DEADSTEMC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live stem C turnover', & + ptr_patch=this%livestemc_to_deadstemc_patch, default='inactive') + + this%livecrootc_to_deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC_TO_DEADCROOTC', units='gC14/m^2/s', & + avgflag='A', long_name='C14 live coarse root C turnover', & + ptr_patch=this%livecrootc_to_deadcrootc_patch, default='inactive') + + this%current_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CURRENT_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth resp for new growth displayed in this timestep', & + ptr_patch=this%current_gr_patch, default='inactive') + + this%transfer_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TRANSFER_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth resp for transfer growth displayed in this timestep', & + ptr_patch=this%transfer_gr_patch, default='inactive') + + this%storage_gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_STORAGE_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 growth resp for growth sent to storage for later display', & + ptr_patch=this%storage_gr_patch, default='inactive') + + this%gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_GPP', units='gC14/m^2/s', & + avgflag='A', long_name='C14 gross primary production', & + ptr_patch=this%gpp_patch) + + this%rr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_RR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 root respiration (fine root MR + total root GR)', & + ptr_patch=this%rr_patch) + + this%mr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_MR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 maintenance respiration', & + ptr_patch=this%mr_patch) + + this%gr_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_GR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total growth respiration', & + ptr_patch=this%gr_patch) + + this%ar_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_AR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 autotrophic respiration (MR + GR)', & + ptr_patch=this%ar_patch) + + this%npp_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_NPP', units='gC14/m^2/s', & + avgflag='A', long_name='C14 net primary production', & + ptr_patch=this%npp_patch) + + this%agnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_AGNPP', units='gC14/m^2/s', & + avgflag='A', long_name='C14 aboveground NPP', & + ptr_patch=this%agnpp_patch) + + this%bgnpp_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_BGNPP', units='gC14/m^2/s', & + avgflag='A', long_name='C14 belowground NPP', & + ptr_patch=this%bgnpp_patch) + + this%litfall_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LITFALL', units='gC14/m^2/s', & + avgflag='A', long_name='C14 litterfall (leaves and fine roots)', & + ptr_patch=this%litfall_patch, default='inactive') + + this%fire_closs_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PFT_FIRE_CLOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total patch-level fire C loss', & + ptr_patch=this%fire_closs_patch) + endif + + !------------------------------- + ! C flux variables - column + !------------------------------- + + if (carbon_type == 'c12') then + + this%cwdc_hr_col(begc:endc) = spval + call hist_addfld1d (fname='CWDC_HR', units='gC/m^2/s', & + avgflag='A', long_name='coarse woody debris C heterotrophic respiration', & + ptr_col=this%cwdc_hr_col) + + this%cwdc_loss_col(begc:endc) = spval + call hist_addfld1d (fname='CWDC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='coarse woody debris C loss', & + ptr_col=this%cwdc_loss_col) + + this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval + this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval + do k = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then + data1dptr => this%m_decomp_cpools_to_fire_col(:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default='inactive') + + if ( nlevdecomp_full > 1 ) then + data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + endif + end do + + this%dwt_seedc_to_leaf_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_SEEDC_TO_LEAF', units='gC/m^2/s', & + avgflag='A', long_name='seed source to patch-level leaf', & + ptr_col=this%dwt_seedc_to_leaf_col) + + this%dwt_seedc_to_deadstem_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_SEEDC_TO_DEADSTEM', units='gC/m^2/s', & + avgflag='A', long_name='seed source to patch-level deadstem', & + ptr_col=this%dwt_seedc_to_deadstem_col) + + this%dwt_conv_cflux_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_CONV_CFLUX', units='gC/m^2/s', & + avgflag='A', long_name='conversion C flux (immediate loss to atm)', & + ptr_col=this%dwt_conv_cflux_col) + + this%dwt_prod10c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_PROD10C_GAIN', units='gC/m^2/s', & + avgflag='A', long_name='landcover change-driven addition to 10-yr wood product pool', & + ptr_col=this%dwt_prod10c_gain_col) + + this%prod10c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='PROD10C_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='loss from 10-yr wood product pool', & + ptr_col=this%prod10c_loss_col) + + this%dwt_prod100c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_PROD100C_GAIN', units='gC/m^2/s', & + avgflag='A', long_name='landcover change-driven addition to 100-yr wood product pool', & + ptr_col=this%dwt_prod100c_gain_col) + + this%prod100c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='PROD100C_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='loss from 100-yr wood product pool', & + ptr_col=this%prod100c_loss_col) + + this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_MET_C', units='gC/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive') + + this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_CEL_C', units='gC/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive') + + this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTC_TO_LITR_LIG_C', units='gC/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive') + + this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_LIVECROOTC_TO_CWDC', units='gC/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='live coarse root to CWD due to landcover change', & + ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive') + + this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_DEADCROOTC_TO_CWDC', units='gC/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='dead coarse root to CWD due to landcover change', & + ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive') + + this%dwt_closs_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total carbon loss from land cover conversion', & + ptr_col=this%dwt_closs_col) + + this%product_closs_col(begc:endc) = spval + call hist_addfld1d (fname='PRODUCT_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total carbon loss from wood product pools', & + ptr_col=this%product_closs_col) + + this%sr_col(begc:endc) = spval + call hist_addfld1d (fname='SR', units='gC/m^2/s', & + avgflag='A', long_name='total soil respiration (HR + root resp)', & + ptr_col=this%sr_col) + + this%er_col(begc:endc) = spval + call hist_addfld1d (fname='ER', units='gC/m^2/s', & + avgflag='A', long_name='total ecosystem respiration, autotrophic + heterotrophic', & + ptr_col=this%er_col) + + this%litfire_col(begc:endc) = spval + call hist_addfld1d (fname='LITFIRE', units='gC/m^2/s', & + avgflag='A', long_name='litter fire losses', & + ptr_col=this%litfire_col, default='inactive') + + this%somfire_col(begc:endc) = spval + call hist_addfld1d (fname='SOMFIRE', units='gC/m^2/s', & + avgflag='A', long_name='soil organic matter fire losses', & + ptr_col=this%somfire_col, default='inactive') + + this%totfire_col(begc:endc) = spval + call hist_addfld1d (fname='TOTFIRE', units='gC/m^2/s', & + avgflag='A', long_name='total ecosystem fire losses', & + ptr_col=this%totfire_col, default='inactive') + + this%fire_closs_col(begc:endc) = spval + call hist_addfld1d (fname='COL_FIRE_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total column-level fire C loss for non-peat fires outside land-type converted region', & + ptr_col=this%fire_closs_col) + + this%annsum_npp_patch(begp:endp) = spval + call hist_addfld1d (fname='ANNSUM_NPP', units='gC/m^2/yr', & + avgflag='A', long_name='annual sum of NPP', & + ptr_patch=this%annsum_npp_patch, default='inactive') + + this%annsum_npp_col(begc:endc) = spval + call hist_addfld1d (fname='CANNSUM_NPP', units='gC/m^2/s', & + avgflag='A', long_name='annual sum of column-level NPP', & + ptr_col=this%annsum_npp_col, default='inactive') + + this%nep_col(begc:endc) = spval + call hist_addfld1d (fname='NEP', units='gC/m^2/s', & + avgflag='A', long_name='net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink', & + ptr_col=this%nep_col) + + this%nbp_col(begc:endc) = spval + call hist_addfld1d (fname='NBP', units='gC/m^2/s', & + avgflag='A', long_name='net biome production, includes fire, landuse, and harvest flux, positive for sink', & + ptr_col=this%nbp_col) + + this%nee_col(begc:endc) = spval + call hist_addfld1d (fname='NEE', units='gC/m^2/s', & + avgflag='A', long_name='net ecosystem exchange of carbon, includes fire, landuse,'& + //' harvest, and hrv_xsmrpool flux, positive for source', & + ptr_col=this%nee_col) + + this%landuptake_col(begc:endc) = spval + call hist_addfld1d (fname='LAND_UPTAKE', units='gC/m^2/s', & + avgflag='A', long_name='NEE minus LAND_USE_FLUX, negative for update', & + ptr_col=this%landuptake_col) + + this%landuseflux_col(begc:endc) = spval + call hist_addfld1d (fname='LAND_USE_FLUX', units='gC/m^2/s', & + avgflag='A', long_name='total C emitted from land cover conversion and wood product pools', & + ptr_col=this%landuseflux_col) + + end if + + !------------------------------- + ! C13 flux variables - column + !------------------------------- + + if ( carbon_type == 'c13' ) then + + this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval + this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval + do k = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then + data1dptr => this%m_decomp_cpools_to_fire_col(:,k) + fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld1d (fname=fieldname, units='gC13/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default='inactive') + + if ( nlevdecomp_full > 1 ) then + data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) + fieldname = 'C13_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + end if + endif + end do + + this%dwt_seedc_to_leaf_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_SEEDC_TO_LEAF', units='gC13/m^2/s', & + avgflag='A', long_name='C13 seed source to patch-level leaf', & + ptr_col=this%dwt_seedc_to_leaf_col) + + this%dwt_seedc_to_deadstem_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_SEEDC_TO_DEADSTEM', units='gC13/m^2/s', & + avgflag='A', long_name='C13 seed source to patch-level deadstem', & + ptr_col=this%dwt_seedc_to_deadstem_col) + + this%dwt_conv_cflux_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_CONV_CFLUX', units='gC13/m^2/s', & + avgflag='A', long_name='C13 conversion C flux (immediate loss to atm)', & + ptr_col=this%dwt_conv_cflux_col) + + this%dwt_prod10c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_PROD10C_GAIN', units='gC13/m^2/s', & + avgflag='A', long_name='C13 addition to 10-yr wood product pool', & + ptr_col=this%dwt_prod10c_gain_col) + + this%prod10c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='C13_PROD10C_LOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 loss from 10-yr wood product pool', & + ptr_col=this%prod10c_loss_col) + + this%dwt_prod100c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_PROD100C_GAIN', units='gC13/m^2/s', & + avgflag='A', long_name='C13 addition to 100-yr wood product pool', & + ptr_col=this%dwt_prod100c_gain_col) + + this%prod100c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='C13_PROD100C_LOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 loss from 100-yr wood product pool', & + ptr_col=this%prod100c_loss_col) + + this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_MET_C', units='gC13/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive') + + this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_CEL_C', units='gC13/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive') + + this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C13_DWT_FROOTC_TO_LITR_LIG_C', units='gC13/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive') + + this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C13_DWT_LIVECROOTC_TO_CWDC', units='gC13/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C13 live coarse root to CWD due to landcover change', & + ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive') + + this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C13_DWT_DEADCROOTC_TO_CWDC', units='gC13/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C13 dead coarse root to CWD due to landcover change', & + ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive') + + this%dwt_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C13_DWT_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total carbon loss from land cover conversion', & + ptr_col=this%dwt_closs_col) + + this%product_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C13_PRODUCT_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total carbon loss from wood product pools', & + ptr_col=this%product_closs_col) + + this%sr_col(begc:endc) = spval + call hist_addfld1d (fname='C13_SR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total soil respiration (HR + root resp)', & + ptr_col=this%sr_col) + + this%er_col(begc:endc) = spval + call hist_addfld1d (fname='C13_ER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total ecosystem respiration, autotrophic + heterotrophic', & + ptr_col=this%er_col) + + this%litfire_col(begc:endc) = spval + call hist_addfld1d (fname='C13_LITFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter fire losses', & + ptr_col=this%litfire_col, default='inactive') + + this%somfire_col(begc:endc) = spval + call hist_addfld1d (fname='C13_SOMFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 soil organic matter fire losses', & + ptr_col=this%somfire_col, default='inactive') + + this%totfire_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total ecosystem fire losses', & + ptr_col=this%totfire_col, default='inactive') + + this%fire_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C13_COL_FIRE_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total column-level fire C loss', & + ptr_col=this%fire_closs_col) + + this%nep_col(begc:endc) = spval + call hist_addfld1d (fname='C13_NEP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net ecosystem production, excludes fire flux, positive for sink', & + ptr_col=this%nep_col) + + this%nee_col(begc:endc) = spval + call hist_addfld1d (fname='C13_NEE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net ecosystem exchange of carbon, includes fire flux, positive for source', & + ptr_col=this%nee_col) + + endif + + !------------------------------- + ! C14 flux variables - column + !------------------------------- + + if (carbon_type == 'c14') then + + this%m_decomp_cpools_to_fire_col(begc:endc,:) = spval + this%m_decomp_cpools_to_fire_vr_col(begc:endc,:,:) = spval + do k = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then + data1dptr => this%m_decomp_cpools_to_fire_col(:,k) + fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE' + longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld1d (fname=fieldname, units='gC14/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default='inactive') + + if ( nlevdecomp_full > 1 ) then + data2dptr => this%m_decomp_cpools_to_fire_vr_col(:,:,k) + fieldname = 'C14_M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_FIRE'//trim(vr_suffix) + longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_long(k))//' C fire loss' + call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + end if + endif + end do + + this%dwt_seedc_to_leaf_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_SEEDC_TO_LEAF', units='gC14/m^2/s', & + avgflag='A', long_name='C14 seed source to patch-level leaf', & + ptr_col=this%dwt_seedc_to_leaf_col) + + this%dwt_seedc_to_deadstem_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_SEEDC_TO_DEADSTEM', units='gC14/m^2/s', & + avgflag='A', long_name='C14 seed source to patch-level deadstem', & + ptr_col=this%dwt_seedc_to_deadstem_col) + + this%dwt_conv_cflux_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_CONV_CFLUX', units='gC14/m^2/s', & + avgflag='A', long_name='C14 conversion C flux (immediate loss to atm)', & + ptr_col=this%dwt_conv_cflux_col) + + this%dwt_prod10c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_PROD10C_GAIN', units='gC14/m^2/s', & + avgflag='A', long_name='C14 addition to 10-yr wood product pool', & + ptr_col=this%dwt_prod10c_gain_col) + + this%prod10c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='C14_PROD10C_LOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 loss from 10-yr wood product pool', & + ptr_col=this%prod10c_loss_col) + + this%dwt_prod100c_gain_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_PROD100C_GAIN', units='gC14/m^2/s', & + avgflag='A', long_name='C14 addition to 100-yr wood product pool', & + ptr_col=this%dwt_prod100c_gain_col) + + this%prod100c_loss_col(begc:endc) = spval + call hist_addfld1d (fname='C14_PROD100C_LOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 loss from 100-yr wood product pool', & + ptr_col=this%prod100c_loss_col) + + this%dwt_frootc_to_litr_met_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_MET_C', units='gC14/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C14 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_met_c_col, default='inactive') + + this%dwt_frootc_to_litr_cel_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_CEL_C', units='gC14/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C14 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_cel_c_col, default='inactive') + + this%dwt_frootc_to_litr_lig_c_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C14_DWT_FROOTC_TO_LITR_LIG_C', units='gC14/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C14 fine root to litter due to landcover change', & + ptr_col=this%dwt_frootc_to_litr_lig_c_col, default='inactive') + + this%dwt_livecrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C14_DWT_LIVECROOTC_TO_CWDC', units='gC14/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C14 live coarse root to CWD due to landcover change', & + ptr_col=this%dwt_livecrootc_to_cwdc_col, default='inactive') + + this%dwt_deadcrootc_to_cwdc_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='C14_DWT_DEADCROOTC_TO_CWDC', units='gC14/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='C14 dead coarse root to CWD due to landcover change', & + ptr_col=this%dwt_deadcrootc_to_cwdc_col, default='inactive') + + this%dwt_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C14_DWT_CLOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total carbon loss from land cover conversion', & + ptr_col=this%dwt_closs_col) + + this%product_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C14_PRODUCT_CLOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total carbon loss from wood product pools', & + ptr_col=this%product_closs_col) + + this%sr_col(begc:endc) = spval + call hist_addfld1d (fname='C14_SR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total soil respiration (HR + root resp)', & + ptr_col=this%sr_col) + + this%er_col(begc:endc) = spval + call hist_addfld1d (fname='C14_ER', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total ecosystem respiration, autotrophic + heterotrophic', & + ptr_col=this%er_col) + + this%litfire_col(begc:endc) = spval + call hist_addfld1d (fname='C14_LITFIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 litter fire losses', & + ptr_col=this%litfire_col, default='inactive') + + this%somfire_col(begc:endc) = spval + call hist_addfld1d (fname='C14_SOMFIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 soil organic matter fire losses', & + ptr_col=this%somfire_col, default='inactive') + + this%totfire_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTFIRE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total ecosystem fire losses', & + ptr_col=this%totfire_col, default='inactive') + + this%fire_closs_col(begc:endc) = spval + call hist_addfld1d (fname='C14_COL_FIRE_CLOSS', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total column-level fire C loss', & + ptr_col=this%fire_closs_col) + + this%nep_col(begc:endc) = spval + call hist_addfld1d (fname='C14_NEP', units='gC14/m^2/s', & + avgflag='A', long_name='C14 net ecosystem production, excludes fire flux, positive for sink', & + ptr_col=this%nep_col) + + this%nee_col(begc:endc) = spval + call hist_addfld1d (fname='C14_NEE', units='gC14/m^2/s', & + avgflag='A', long_name='C14 net ecosystem exchange of carbon, includes fire flux, positive for source', & + ptr_col=this%nee_col) + + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p, c, l, j + integer :: fc ! filter index + integer :: num_special_col ! number of good values in special_col filter + integer :: num_special_patch ! number of good values in special_patch filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches + !----------------------------------------------------------------------- + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! Set patch filters + + num_special_patch = 0 + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + if (lun%ifspecial(l)) then + num_special_patch = num_special_patch + 1 + special_patch(num_special_patch) = p + end if + end do + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + this%gpp_before_downreg_patch(p) = 0._r8 + + if (lun%ifspecial(l)) then + this%availc_patch(p) = spval + this%xsmrpool_recover_patch(p) = spval + this%excess_cflux_patch(p) = spval + this%plant_calloc_patch(p) = spval + this%prev_leafc_to_litter_patch(p) = spval + this%prev_frootc_to_litter_patch(p) = spval + if ( use_c13 ) then + this%xsmrpool_c13ratio_patch(p) = spval + endif + end if + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%availc_patch(p) = 0._r8 + this%xsmrpool_recover_patch(p) = 0._r8 + this%excess_cflux_patch(p) = 0._r8 + this%prev_leafc_to_litter_patch(p) = 0._r8 + this%prev_frootc_to_litter_patch(p) = 0._r8 + this%plant_calloc_patch(p) = 0._r8 + end if + end do + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + ! also initialize dynamic landcover fluxes so that they have + ! real values on first timestep, prior to calling pftdyn_cnbal + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%dwt_seedc_to_leaf_col(c) = 0._r8 + this%dwt_seedc_to_deadstem_col(c) = 0._r8 + this%dwt_conv_cflux_col(c) = 0._r8 + this%dwt_prod10c_gain_col(c) = 0._r8 + this%dwt_prod100c_gain_col(c) = 0._r8 + this%prod10c_loss_col(c) = 0._r8 + this%prod100c_loss_col(c) = 0._r8 + do j = 1, nlevdecomp_full + this%dwt_frootc_to_litr_met_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_cel_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_lig_c_col(c,j) = 0._r8 + this%dwt_livecrootc_to_cwdc_col(c,j) = 0._r8 + this%dwt_deadcrootc_to_cwdc_col(c,j) = 0._r8 + end do + this%dwt_closs_col(c) = 0._r8 + end if + end do + + ! initialize fields for special filters + + do fc = 1,num_special_col + c = special_col(fc) + this%dwt_closs_col(c) = 0._r8 + this%landuseflux_col(c) = 0._r8 + this%landuptake_col(c) = 0._r8 + end do + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + this%gpp_patch(p) = 0._r8 + if (lun%ifspecial(l)) then + this%tempsum_npp_patch(p) = spval + this%annsum_npp_patch(p) = spval + this%tempsum_litfall_patch(p) = spval + this%annsum_litfall_patch(p) = spval + end if + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%tempsum_npp_patch(p) = 0._r8 + this%annsum_npp_patch(p) = 0._r8 + this%tempsum_litfall_patch(p) = 0._r8 + this%annsum_litfall_patch(p) = 0._r8 + end if + end do + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%ifspecial(l)) then + this%annsum_npp_col(c) = spval + end if + + ! also initialize dynamic landcover fluxes so that they have + ! real values on first timestep, prior to calling pftdyn_cnbal + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%annsum_npp_col(c) = 0._r8 + end if + end do + + ! initialize fields for special filters + + call this%SetValues (& + num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, & + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) + use clm_time_manager , only : is_restart + use clm_varcon , only : c13ratio, c14ratio + use clm_varctl , only : use_lch4 + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (cnveg_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !------------------------------------------------------------------------ + + if (crop_prog) then + + call restartvar(ncid=ncid, flag=flag, varname='grainc_xfer_to_grainc', xtype=ncd_double, & + dim1name='pft', & + long_name='grain C growth from storage', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_to_grainc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_to_litter', xtype=ncd_double, & + dim1name='pft', & + long_name='live stem C litterfall', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_to_litter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainc_to_food', xtype=ncd_double, & + dim1name='pft', & + long_name='grain C to food', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_to_food_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cpool_to_grainc', xtype=ncd_double, & + dim1name='pft', & + long_name='allocation to grain C', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_to_grainc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cpool_to_grainc_storage', xtype=ncd_double, & + dim1name='pft', & + long_name='allocation to grain C storage', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_to_grainc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cpool_grain_gr', xtype=ncd_double, & + dim1name='pft', & + long_name='grain growth respiration', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_grain_gr_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cpool_grain_storage_gr', xtype=ncd_double, & + dim1name='pft', & + long_name='grain growth respiration to storage', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_grain_storage_gr_patch) + + call restartvar(ncid=ncid, flag=flag, varname='transfer_grain_gr', xtype=ncd_double, & + dim1name='pft', & + long_name='grain growth respiration from storage', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%transfer_grain_gr_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainc_storage_to_xfer', xtype=ncd_double, & + dim1name='pft', & + long_name='grain C shift storage to transfer', units='gC/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_to_xfer_patch) + + end if + + call restartvar(ncid=ncid, flag=flag, varname='gpp_pepv', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gpp_before_downreg_patch) + + call restartvar(ncid=ncid, flag=flag, varname='availc', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%availc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_recover', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_recover_patch) + + call restartvar(ncid=ncid, flag=flag, varname='plant_calloc', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_calloc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='excess_cflux', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%excess_cflux_patch) + + call restartvar(ncid=ncid, flag=flag, varname='prev_leafc_to_litter', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prev_leafc_to_litter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='prev_frootc_to_litter', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prev_frootc_to_litter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tempsum_npp', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tempsum_npp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annsum_npp', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annsum_npp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='col_lag_npp', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%lag_npp_col) + + call restartvar(ncid=ncid, flag=flag, varname='cannsum_npp', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annsum_npp_col) + + call restartvar(ncid=ncid, flag=flag, varname='tempsum_litfall', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tempsum_litfall_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annsum_litfall', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annsum_litfall_patch) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon state fluxes + ! + ! !ARGUMENTS: + class (cnveg_carbonflux_type) :: this + integer , intent(in) :: num_patch + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k,l ! indices + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i = filter_patch(fi) + + this%m_leafc_to_litter_patch(i) = value_patch + this%m_frootc_to_litter_patch(i) = value_patch + this%m_leafc_storage_to_litter_patch(i) = value_patch + this%m_frootc_storage_to_litter_patch(i) = value_patch + this%m_livestemc_storage_to_litter_patch(i) = value_patch + this%m_deadstemc_storage_to_litter_patch(i) = value_patch + this%m_livecrootc_storage_to_litter_patch(i) = value_patch + this%m_deadcrootc_storage_to_litter_patch(i) = value_patch + this%m_leafc_xfer_to_litter_patch(i) = value_patch + this%m_frootc_xfer_to_litter_patch(i) = value_patch + this%m_livestemc_xfer_to_litter_patch(i) = value_patch + this%m_deadstemc_xfer_to_litter_patch(i) = value_patch + this%m_livecrootc_xfer_to_litter_patch(i) = value_patch + this%m_deadcrootc_xfer_to_litter_patch(i) = value_patch + this%m_livestemc_to_litter_patch(i) = value_patch + this%m_deadstemc_to_litter_patch(i) = value_patch + this%m_livecrootc_to_litter_patch(i) = value_patch + this%m_deadcrootc_to_litter_patch(i) = value_patch + this%m_gresp_storage_to_litter_patch(i) = value_patch + this%m_gresp_xfer_to_litter_patch(i) = value_patch + this%hrv_leafc_to_litter_patch(i) = value_patch + this%hrv_leafc_storage_to_litter_patch(i) = value_patch + this%hrv_leafc_xfer_to_litter_patch(i) = value_patch + this%hrv_frootc_to_litter_patch(i) = value_patch + this%hrv_frootc_storage_to_litter_patch(i) = value_patch + this%hrv_frootc_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemc_to_litter_patch(i) = value_patch + this%hrv_livestemc_storage_to_litter_patch(i) = value_patch + this%hrv_livestemc_xfer_to_litter_patch(i) = value_patch + this%hrv_deadstemc_to_prod10c_patch(i) = value_patch + this%hrv_deadstemc_to_prod100c_patch(i) = value_patch + this%hrv_deadstemc_storage_to_litter_patch(i) = value_patch + this%hrv_deadstemc_xfer_to_litter_patch(i) = value_patch + this%hrv_livecrootc_to_litter_patch(i) = value_patch + this%hrv_livecrootc_storage_to_litter_patch(i) = value_patch + this%hrv_livecrootc_xfer_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_storage_to_litter_patch(i) = value_patch + this%hrv_deadcrootc_xfer_to_litter_patch(i) = value_patch + this%hrv_gresp_storage_to_litter_patch(i) = value_patch + this%hrv_gresp_xfer_to_litter_patch(i) = value_patch + this%hrv_xsmrpool_to_atm_patch(i) = value_patch + + this%m_leafc_to_fire_patch(i) = value_patch + this%m_leafc_storage_to_fire_patch(i) = value_patch + this%m_leafc_xfer_to_fire_patch(i) = value_patch + this%m_livestemc_to_fire_patch(i) = value_patch + this%m_livestemc_storage_to_fire_patch(i) = value_patch + this%m_livestemc_xfer_to_fire_patch(i) = value_patch + this%m_deadstemc_to_fire_patch(i) = value_patch + this%m_deadstemc_storage_to_fire_patch(i) = value_patch + this%m_deadstemc_xfer_to_fire_patch(i) = value_patch + this%m_frootc_to_fire_patch(i) = value_patch + this%m_frootc_storage_to_fire_patch(i) = value_patch + this%m_frootc_xfer_to_fire_patch(i) = value_patch + this%m_livecrootc_to_fire_patch(i) = value_patch + this%m_livecrootc_storage_to_fire_patch(i) = value_patch + this%m_livecrootc_xfer_to_fire_patch(i) = value_patch + this%m_deadcrootc_to_fire_patch(i) = value_patch + this%m_deadcrootc_storage_to_fire_patch(i) = value_patch + this%m_deadcrootc_xfer_to_fire_patch(i) = value_patch + this%m_gresp_storage_to_fire_patch(i) = value_patch + this%m_gresp_xfer_to_fire_patch(i) = value_patch + + this%m_leafc_to_litter_fire_patch(i) = value_patch + this%m_leafc_storage_to_litter_fire_patch(i) = value_patch + this%m_leafc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemc_to_litter_fire_patch(i) = value_patch + this%m_livestemc_storage_to_litter_fire_patch(i) = value_patch + this%m_livestemc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemc_to_deadstemc_fire_patch(i) = value_patch + this%m_deadstemc_to_litter_fire_patch(i) = value_patch + this%m_deadstemc_storage_to_litter_fire_patch(i) = value_patch + this%m_deadstemc_xfer_to_litter_fire_patch(i) = value_patch + this%m_frootc_to_litter_fire_patch(i) = value_patch + this%m_frootc_storage_to_litter_fire_patch(i) = value_patch + this%m_frootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_storage_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootc_to_deadcrootc_fire_patch(i) = value_patch + this%m_deadcrootc_to_litter_fire_patch(i) = value_patch + this%m_deadcrootc_storage_to_litter_fire_patch(i) = value_patch + this%m_deadcrootc_xfer_to_litter_fire_patch(i) = value_patch + this%m_gresp_storage_to_litter_fire_patch(i) = value_patch + this%m_gresp_xfer_to_litter_fire_patch(i) = value_patch + + this%leafc_xfer_to_leafc_patch(i) = value_patch + this%frootc_xfer_to_frootc_patch(i) = value_patch + this%livestemc_xfer_to_livestemc_patch(i) = value_patch + this%deadstemc_xfer_to_deadstemc_patch(i) = value_patch + this%livecrootc_xfer_to_livecrootc_patch(i) = value_patch + this%deadcrootc_xfer_to_deadcrootc_patch(i) = value_patch + this%leafc_to_litter_patch(i) = value_patch + this%frootc_to_litter_patch(i) = value_patch + this%leaf_mr_patch(i) = value_patch + this%froot_mr_patch(i) = value_patch + this%livestem_mr_patch(i) = value_patch + this%livecroot_mr_patch(i) = value_patch + this%grain_mr_patch(i) = value_patch + this%leaf_curmr_patch(i) = value_patch + this%froot_curmr_patch(i) = value_patch + this%livestem_curmr_patch(i) = value_patch + this%livecroot_curmr_patch(i) = value_patch + this%grain_curmr_patch(i) = value_patch + this%leaf_xsmr_patch(i) = value_patch + this%froot_xsmr_patch(i) = value_patch + this%livestem_xsmr_patch(i) = value_patch + this%livecroot_xsmr_patch(i) = value_patch + this%grain_xsmr_patch(i) = value_patch + this%psnsun_to_cpool_patch(i) = value_patch + this%psnshade_to_cpool_patch(i) = value_patch + this%cpool_to_xsmrpool_patch(i) = value_patch + this%cpool_to_leafc_patch(i) = value_patch + this%cpool_to_leafc_storage_patch(i) = value_patch + this%cpool_to_frootc_patch(i) = value_patch + this%cpool_to_frootc_storage_patch(i) = value_patch + this%cpool_to_livestemc_patch(i) = value_patch + this%cpool_to_livestemc_storage_patch(i) = value_patch + this%cpool_to_deadstemc_patch(i) = value_patch + this%cpool_to_deadstemc_storage_patch(i) = value_patch + this%cpool_to_livecrootc_patch(i) = value_patch + this%cpool_to_livecrootc_storage_patch(i) = value_patch + this%cpool_to_deadcrootc_patch(i) = value_patch + this%cpool_to_deadcrootc_storage_patch(i) = value_patch + this%cpool_to_gresp_storage_patch(i) = value_patch + this%cpool_leaf_gr_patch(i) = value_patch + this%cpool_leaf_storage_gr_patch(i) = value_patch + this%transfer_leaf_gr_patch(i) = value_patch + this%cpool_froot_gr_patch(i) = value_patch + this%cpool_froot_storage_gr_patch(i) = value_patch + this%transfer_froot_gr_patch(i) = value_patch + this%cpool_livestem_gr_patch(i) = value_patch + this%cpool_livestem_storage_gr_patch(i) = value_patch + this%transfer_livestem_gr_patch(i) = value_patch + this%cpool_deadstem_gr_patch(i) = value_patch + this%cpool_deadstem_storage_gr_patch(i) = value_patch + this%transfer_deadstem_gr_patch(i) = value_patch + this%cpool_livecroot_gr_patch(i) = value_patch + this%cpool_livecroot_storage_gr_patch(i) = value_patch + this%transfer_livecroot_gr_patch(i) = value_patch + this%cpool_deadcroot_gr_patch(i) = value_patch + this%cpool_deadcroot_storage_gr_patch(i) = value_patch + this%transfer_deadcroot_gr_patch(i) = value_patch + this%leafc_storage_to_xfer_patch(i) = value_patch + this%frootc_storage_to_xfer_patch(i) = value_patch + this%livestemc_storage_to_xfer_patch(i) = value_patch + this%deadstemc_storage_to_xfer_patch(i) = value_patch + this%livecrootc_storage_to_xfer_patch(i) = value_patch + this%deadcrootc_storage_to_xfer_patch(i) = value_patch + this%gresp_storage_to_xfer_patch(i) = value_patch + this%livestemc_to_deadstemc_patch(i) = value_patch + this%livecrootc_to_deadcrootc_patch(i) = value_patch + + this%current_gr_patch(i) = value_patch + this%transfer_gr_patch(i) = value_patch + this%storage_gr_patch(i) = value_patch + this%frootc_alloc_patch(i) = value_patch + this%frootc_loss_patch(i) = value_patch + this%leafc_alloc_patch(i) = value_patch + this%leafc_loss_patch(i) = value_patch + this%woodc_alloc_patch(i) = value_patch + this%woodc_loss_patch(i) = value_patch + end do + + if ( crop_prog )then + do fi = 1,num_patch + i = filter_patch(fi) + this%xsmrpool_to_atm_patch(i) = value_patch + this%livestemc_to_litter_patch(i) = value_patch + this%grainc_to_food_patch(i) = value_patch + this%grainc_xfer_to_grainc_patch(i) = value_patch + this%cpool_to_grainc_patch(i) = value_patch + this%cpool_to_grainc_storage_patch(i) = value_patch + this%cpool_grain_gr_patch(i) = value_patch + this%cpool_grain_storage_gr_patch(i) = value_patch + this%transfer_grain_gr_patch(i) = value_patch + this%grainc_storage_to_xfer_patch(i) = value_patch + end do + end if + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + this%phenology_c_to_litr_met_c_col(i,j) = value_column + this%phenology_c_to_litr_cel_c_col(i,j) = value_column + this%phenology_c_to_litr_lig_c_col(i,j) = value_column + + this%gap_mortality_c_to_litr_met_c_col(i,j) = value_column + this%gap_mortality_c_to_litr_cel_c_col(i,j) = value_column + this%gap_mortality_c_to_litr_lig_c_col(i,j) = value_column + this%gap_mortality_c_to_cwdc_col(i,j) = value_column + + this%fire_mortality_c_to_cwdc_col(i,j) = value_column + this%m_c_to_litr_met_fire_col(i,j) = value_column + this%m_c_to_litr_cel_fire_col(i,j) = value_column + this%m_c_to_litr_lig_fire_col(i,j) = value_column + + this%harvest_c_to_litr_met_c_col(i,j) = value_column + this%harvest_c_to_litr_cel_c_col(i,j) = value_column + this%harvest_c_to_litr_lig_c_col(i,j) = value_column + this%harvest_c_to_cwdc_col(i,j) = value_column + + end do + end do + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_cpools_to_fire_vr_col(i,j,k) = value_column + end do + end do + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_cpools_to_fire_col(i,k) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%hrv_deadstemc_to_prod10c_col(i) = value_column + this%hrv_deadstemc_to_prod100c_col(i) = value_column + this%prod10c_loss_col(i) = value_column + this%prod100c_loss_col(i) = value_column + this%product_closs_col(i) = value_column + this%cwdc_hr_col(i) = value_column + this%cwdc_loss_col(i) = value_column + this%litterc_loss_col(i) = value_column + end do + + do fi = 1,num_patch + i = filter_patch(fi) + + this%gpp_patch(i) = value_patch + this%mr_patch(i) = value_patch + this%gr_patch(i) = value_patch + this%ar_patch(i) = value_patch + this%rr_patch(i) = value_patch + this%npp_patch(i) = value_patch + this%agnpp_patch(i) = value_patch + this%bgnpp_patch(i) = value_patch + this%litfall_patch(i) = value_patch + this%wood_harvestc_patch(i) = value_patch + this%cinputs_patch(i) = value_patch + this%coutputs_patch(i) = value_patch + this%fire_closs_patch(i) = value_patch + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%sr_col(i) = value_column + this%er_col(i) = value_column + this%litfire_col(i) = value_column + this%somfire_col(i) = value_column + this%totfire_col(i) = value_column + this%fire_closs_col(i) = value_column + + ! Zero p2c column fluxes + this%rr_col(i) = value_column + this%ar_col(i) = value_column + this%gpp_col(i) = value_column + this%npp_col(i) = value_column + this%fire_closs_col(i) = value_column + this%litfall_col(i) = value_column + this%wood_harvestc_col(i) = value_column + this%hrv_xsmrpool_to_atm_col(i) = value_column + + this%nep_col(i) = value_column + this%nbp_col(i) = value_column + this%nee_col(i) = value_column + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize flux variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, j ! indices + !----------------------------------------------------------------------- + + ! set column-level conversion and product pool fluxes + ! to 0 at the beginning of every timestep + + do c = bounds%begc,bounds%endc + this%dwt_seedc_to_leaf_col(c) = 0._r8 + this%dwt_seedc_to_deadstem_col(c) = 0._r8 + this%dwt_conv_cflux_col(c) = 0._r8 + this%dwt_prod10c_gain_col(c) = 0._r8 + this%dwt_prod100c_gain_col(c) = 0._r8 + end do + + do j = 1, nlevdecomp_full + do c = bounds%begc,bounds%endc + this%dwt_frootc_to_litr_met_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_cel_c_col(c,j) = 0._r8 + this%dwt_frootc_to_litr_lig_c_col(c,j) = 0._r8 + this%dwt_livecrootc_to_cwdc_col(c,j) = 0._r8 + this%dwt_deadcrootc_to_cwdc_col(c,j) = 0._r8 + end do + end do + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- + subroutine Summary_carbonflux(this, & + bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + isotope, soilbiogeochem_hr_col, soilbiogeochem_lithr_col, & + soilbiogeochem_decomp_cascade_ctransfer_col) + ! + ! !DESCRIPTION: + ! Perform patch and column-level carbon summary calculations + ! + ! !USES: + use clm_time_manager , only: get_step_size + use clm_varcon , only: secspday + use clm_varctl , only: nfix_timeconst + use subgridAveMod , only: p2c + use SoilBiogeochemDecompCascadeConType , only: decomp_cascade_con + ! + ! !ARGUMENTS: + class(cnveg_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + character(len=*) , intent(in) :: isotope + real(r8) , intent(in) :: soilbiogeochem_hr_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_lithr_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_decomp_cascade_ctransfer_col(bounds%begc:,1:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: nfixlags, dtime ! temp variables for making lagged npp + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! calculate patch-level summary carbon fluxes and states + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! maintenance respiration (MR) + if ( trim(isotope) == 'c13' .or. trim(isotope) == 'c14') then + this%leaf_mr_patch(p) = this%leaf_curmr_patch(p) + this%leaf_xsmr_patch(p) + this%froot_mr_patch(p) = this%froot_curmr_patch(p) + this%froot_xsmr_patch(p) + this%livestem_mr_patch(p) = this%livestem_curmr_patch(p) + this%livestem_xsmr_patch(p) + this%livecroot_mr_patch(p) = this%livecroot_curmr_patch(p) + this%livecroot_xsmr_patch(p) + endif + + this%mr_patch(p) = & + this%leaf_mr_patch(p) + & + this%froot_mr_patch(p) + & + this%livestem_mr_patch(p) + & + this%livecroot_mr_patch(p) + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%mr_patch(p) = & + this%mr_patch(p) + & + this%grain_mr_patch(p) + end if + + ! growth respiration (GR) + + ! current GR is respired this time step for new growth displayed in this timestep + this%current_gr_patch(p) = & + this%cpool_leaf_gr_patch(p) + & + this%cpool_froot_gr_patch(p) + & + this%cpool_livestem_gr_patch(p) + & + this%cpool_deadstem_gr_patch(p) + & + this%cpool_livecroot_gr_patch(p) + & + this%cpool_deadcroot_gr_patch(p) + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%current_gr_patch(p) = this%current_gr_patch(p) + & + this%cpool_grain_gr_patch(p) + end if + + ! transfer GR is respired this time step for transfer growth displayed in this timestep + this%transfer_gr_patch(p) = & + this%transfer_leaf_gr_patch(p) + & + this%transfer_froot_gr_patch(p) + & + this%transfer_livestem_gr_patch(p) + & + this%transfer_deadstem_gr_patch(p) + & + this%transfer_livecroot_gr_patch(p) + & + this%transfer_deadcroot_gr_patch(p) + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%transfer_gr_patch(p) = this%transfer_gr_patch(p) + & + this%transfer_grain_gr_patch(p) + end if + + ! storage GR is respired this time step for growth sent to storage for later display + this%storage_gr_patch(p) = & + this%cpool_leaf_storage_gr_patch(p) + & + this%cpool_froot_storage_gr_patch(p) + & + this%cpool_livestem_storage_gr_patch(p) + & + this%cpool_deadstem_storage_gr_patch(p) + & + this%cpool_livecroot_storage_gr_patch(p) + & + this%cpool_deadcroot_storage_gr_patch(p) + + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%storage_gr_patch(p) = this%storage_gr_patch(p) + & + this%cpool_grain_storage_gr_patch(p) + end if + + ! GR is the sum of current + transfer + storage GR + this%gr_patch(p) = & + this%current_gr_patch(p) + & + this%transfer_gr_patch(p) + & + this%storage_gr_patch(p) + + ! autotrophic respiration (AR) adn + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%ar_patch(p) = & + this%mr_patch(p) + & + this%gr_patch(p) + & + this%xsmrpool_to_atm_patch(p) ! xsmr... is -ve (slevis) + else + this%ar_patch(p) = & + this%mr_patch(p) + & + this%gr_patch(p) + end if + + ! gross primary production (GPP) + this%gpp_patch(p) = & + this%psnsun_to_cpool_patch(p) + & + this%psnshade_to_cpool_patch(p) + + ! net primary production (NPP) + this%npp_patch(p) = & + this%gpp_patch(p) - & + this%ar_patch(p) + + ! root respiration (RR) + this%rr_patch(p) = & + this%froot_mr_patch(p) + & + this%cpool_froot_gr_patch(p) + & + this%cpool_livecroot_gr_patch(p) + & + this%cpool_deadcroot_gr_patch(p) + & + this%transfer_froot_gr_patch(p) + & + this%transfer_livecroot_gr_patch(p) + & + this%transfer_deadcroot_gr_patch(p) + & + this%cpool_froot_storage_gr_patch(p) + & + this%cpool_livecroot_storage_gr_patch(p) + & + this%cpool_deadcroot_storage_gr_patch(p) + + ! update the annual NPP accumulator, for use in allocation code + if (trim(isotope) == 'bulk') then + this%tempsum_npp_patch(p) = & + this%tempsum_npp_patch(p) + & + this%npp_patch(p) + end if + + ! aboveground NPP: leaf, live stem, dead stem (AGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of AGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + + this%agnpp_patch(p) = & + this%cpool_to_leafc_patch(p) + & + this%leafc_xfer_to_leafc_patch(p) + & + this%cpool_to_livestemc_patch(p) + & + this%livestemc_xfer_to_livestemc_patch(p) + & + this%cpool_to_deadstemc_patch(p) + & + this%deadstemc_xfer_to_deadstemc_patch(p) + + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%agnpp_patch(p) = & + this%agnpp_patch(p) + & + this%cpool_to_grainc_patch(p) + & + this%grainc_xfer_to_grainc_patch(p) + end if + + ! belowground NPP: fine root, live coarse root, dead coarse root (BGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of BGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + + this%bgnpp_patch(p) = & + this%cpool_to_frootc_patch(p) + & + this%frootc_xfer_to_frootc_patch(p) + & + this%cpool_to_livecrootc_patch(p) + & + this%livecrootc_xfer_to_livecrootc_patch(p) + & + this%cpool_to_deadcrootc_patch(p) + & + this%deadcrootc_xfer_to_deadcrootc_patch(p) + + ! litterfall (LITFALL) + + this%litfall_patch(p) = & + this%leafc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + & + this%m_leafc_to_litter_patch(p) + & + this%m_leafc_storage_to_litter_patch(p) + & + this%m_leafc_xfer_to_litter_patch(p) + & + this%m_frootc_to_litter_patch(p) + & + this%m_frootc_storage_to_litter_patch(p) + & + this%m_frootc_xfer_to_litter_patch(p) + & + this%m_livestemc_to_litter_patch(p) + & + this%m_livestemc_storage_to_litter_patch(p) + & + this%m_livestemc_xfer_to_litter_patch(p) + & + this%m_deadstemc_to_litter_patch(p) + & + this%m_deadstemc_storage_to_litter_patch(p) + & + this%m_deadstemc_xfer_to_litter_patch(p) + & + this%m_livecrootc_to_litter_patch(p) + & + this%m_livecrootc_storage_to_litter_patch(p) + & + this%m_livecrootc_xfer_to_litter_patch(p) + & + this%m_deadcrootc_to_litter_patch(p) + & + this%m_deadcrootc_storage_to_litter_patch(p) + & + this%m_deadcrootc_xfer_to_litter_patch(p) + & + this%m_gresp_storage_to_litter_patch(p) + & + this%m_gresp_xfer_to_litter_patch(p) + & + + this%m_leafc_to_litter_fire_patch(p) + & + this%m_leafc_storage_to_litter_fire_patch(p) + & + this%m_leafc_xfer_to_litter_fire_patch(p) + & + this%m_livestemc_to_litter_fire_patch(p) + & + this%m_livestemc_storage_to_litter_fire_patch(p) + & + this%m_livestemc_xfer_to_litter_fire_patch(p) + & + this%m_deadstemc_to_litter_fire_patch(p) + & + this%m_deadstemc_storage_to_litter_fire_patch(p) + & + this%m_deadstemc_xfer_to_litter_fire_patch(p) + & + this%m_frootc_to_litter_fire_patch(p) + & + this%m_frootc_storage_to_litter_fire_patch(p) + & + this%m_frootc_xfer_to_litter_fire_patch(p) + & + this%m_livecrootc_to_litter_fire_patch(p) + & + this%m_livecrootc_storage_to_litter_fire_patch(p) + & + this%m_livecrootc_xfer_to_litter_fire_patch(p) + & + this%m_deadcrootc_to_litter_fire_patch(p) + & + this%m_deadcrootc_storage_to_litter_fire_patch(p) + & + this%m_deadcrootc_xfer_to_litter_fire_patch(p) + & + this%m_gresp_storage_to_litter_fire_patch(p) + & + this%m_gresp_xfer_to_litter_fire_patch(p) + & + + this%hrv_leafc_to_litter_patch(p) + & + this%hrv_leafc_storage_to_litter_patch(p) + & + this%hrv_leafc_xfer_to_litter_patch(p) + & + this%hrv_frootc_to_litter_patch(p) + & + this%hrv_frootc_storage_to_litter_patch(p) + & + this%hrv_frootc_xfer_to_litter_patch(p) + & + this%hrv_livestemc_to_litter_patch(p) + & + this%hrv_livestemc_storage_to_litter_patch(p) + & + this%hrv_livestemc_xfer_to_litter_patch(p) + & + this%hrv_deadstemc_storage_to_litter_patch(p) + & + this%hrv_deadstemc_xfer_to_litter_patch(p) + & + this%hrv_livecrootc_to_litter_patch(p) + & + this%hrv_livecrootc_storage_to_litter_patch(p) + & + this%hrv_livecrootc_xfer_to_litter_patch(p) + & + this%hrv_deadcrootc_to_litter_patch(p) + & + this%hrv_deadcrootc_storage_to_litter_patch(p) + & + this%hrv_deadcrootc_xfer_to_litter_patch(p) + & + this%hrv_gresp_storage_to_litter_patch(p) + & + this%hrv_gresp_xfer_to_litter_patch(p) + + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%litfall_patch(p) = & + this%litfall_patch(p) + & + this%livestemc_to_litter_patch(p) + & + this%grainc_to_food_patch(p) + end if + + ! update the annual litfall accumulator, for use in mortality code + + if (use_cndv) then + this%tempsum_litfall_patch(p) = & + this%tempsum_litfall_patch(p) + & + this%leafc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + end if + + ! patch-level wood harvest + + this%wood_harvestc_patch(p) = & + this%hrv_deadstemc_to_prod10c_patch(p) + & + this%hrv_deadstemc_to_prod100c_patch(p) + + ! patch-level carbon losses to fire changed by F. Li and S. Levis + + this%fire_closs_patch(p) = & + this%m_leafc_to_fire_patch(p) + & + this%m_leafc_storage_to_fire_patch(p) + & + this%m_leafc_xfer_to_fire_patch(p) + & + this%m_frootc_to_fire_patch(p) + & + this%m_frootc_storage_to_fire_patch(p) + & + this%m_frootc_xfer_to_fire_patch(p) + & + this%m_livestemc_to_fire_patch(p) + & + this%m_livestemc_storage_to_fire_patch(p) + & + this%m_livestemc_xfer_to_fire_patch(p) + & + this%m_deadstemc_to_fire_patch(p) + & + this%m_deadstemc_storage_to_fire_patch(p) + & + this%m_deadstemc_xfer_to_fire_patch(p) + & + this%m_livecrootc_to_fire_patch(p) + & + this%m_livecrootc_storage_to_fire_patch(p) + & + this%m_livecrootc_xfer_to_fire_patch(p) + & + this%m_deadcrootc_to_fire_patch(p) + & + this%m_deadcrootc_storage_to_fire_patch(p) + & + this%m_deadcrootc_xfer_to_fire_patch(p) + & + this%m_gresp_storage_to_fire_patch(p) + & + this%m_gresp_xfer_to_fire_patch(p) + + ! new summary variables for CLAMP + + ! (FROOTC_ALLOC) - fine root C allocation + this%frootc_alloc_patch(p) = & + this%frootc_xfer_to_frootc_patch(p) + & + this%cpool_to_frootc_patch(p) + + ! (FROOTC_LOSS) - fine root C loss changed by F. Li and S. Levis + this%frootc_loss_patch(p) = & + this%m_frootc_to_litter_patch(p) + & + this%m_frootc_to_fire_patch(p) + & + this%m_frootc_to_litter_fire_patch(p) + & + this%hrv_frootc_to_litter_patch(p) + & + this%frootc_to_litter_patch(p) + + ! (LEAFC_ALLOC) - leaf C allocation + this%leafc_alloc_patch(p) = & + this%leafc_xfer_to_leafc_patch(p) + & + this%cpool_to_leafc_patch(p) + + ! (LEAFC_LOSS) - leaf C loss changed by F. Li and S. Levis + this%leafc_loss_patch(p) = & + this%m_leafc_to_litter_patch(p) + & + this%m_leafc_to_fire_patch(p) + & + this%m_leafc_to_litter_fire_patch(p) + & + this%hrv_leafc_to_litter_patch(p) + & + this%leafc_to_litter_patch(p) + + ! (WOODC_ALLOC) - wood C allocation + this%woodc_alloc_patch(p) = & + this%livestemc_xfer_to_livestemc_patch(p) + & + this%deadstemc_xfer_to_deadstemc_patch(p) + & + this%livecrootc_xfer_to_livecrootc_patch(p) + & + this%deadcrootc_xfer_to_deadcrootc_patch(p) + & + this%cpool_to_livestemc_patch(p) + & + this%cpool_to_deadstemc_patch(p) + & + this%cpool_to_livecrootc_patch(p) + & + this%cpool_to_deadcrootc_patch(p) + + ! (WOODC_LOSS) - wood C loss + this%woodc_loss_patch(p) = & + this%m_livestemc_to_litter_patch(p) + & + this%m_deadstemc_to_litter_patch(p) + & + this%m_livecrootc_to_litter_patch(p) + & + this%m_deadcrootc_to_litter_patch(p) + & + this%m_livestemc_to_fire_patch(p) + & + this%m_deadstemc_to_fire_patch(p) + & + this%m_livecrootc_to_fire_patch(p) + & + this%m_deadcrootc_to_fire_patch(p) + & + this%hrv_livestemc_to_litter_patch(p) + & + this%hrv_livestemc_storage_to_litter_patch(p) + & + this%hrv_livestemc_xfer_to_litter_patch(p) + & + this%hrv_deadstemc_to_prod10c_patch(p) + & + this%hrv_deadstemc_to_prod100c_patch(p) + & + this%hrv_deadstemc_storage_to_litter_patch(p) + & + this%hrv_deadstemc_xfer_to_litter_patch(p) + & + this%hrv_livecrootc_to_litter_patch(p) + & + this%hrv_livecrootc_storage_to_litter_patch(p) + & + this%hrv_livecrootc_xfer_to_litter_patch(p) + & + this%hrv_deadcrootc_to_litter_patch(p) + & + this%hrv_deadcrootc_storage_to_litter_patch(p) + & + this%hrv_deadcrootc_xfer_to_litter_patch(p) + + end do ! end of patches loop + + !------------------------------------------------ + ! column variables + !------------------------------------------------ + + ! use p2c routine to get selected column-average patch-level fluxes and states + + call p2c(bounds, num_soilc, filter_soilc, & + this%hrv_xsmrpool_to_atm_patch(bounds%begp:bounds%endp), & + this%hrv_xsmrpool_to_atm_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%wood_harvestc_patch(bounds%begp:bounds%endp), & + this%wood_harvestc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%fire_closs_patch(bounds%begp:bounds%endp), & + this%fire_closs_p2c_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%litfall_patch(bounds%begp:bounds%endp), & + this%litfall_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%npp_patch(bounds%begp:bounds%endp), & + this%npp_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%rr_patch(bounds%begp:bounds%endp), & + this%rr_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%ar_patch(bounds%begp:bounds%endp), & + this%ar_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%gpp_patch(bounds%begp:bounds%endp), & + this%gpp_col(bounds%begc:bounds%endc)) + + ! this code is to calculate an exponentially-relaxed npp value for use in NDynamics code + + if ( trim(isotope) == 'bulk') then + if (nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then + dtime = get_step_size() + nfixlags = nfix_timeconst * secspday + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( this%lag_npp_col(c) /= spval ) then + this%lag_npp_col(c) = & + this%lag_npp_col(c) * exp(-dtime/nfixlags) + & + this%npp_col(c) * (1._r8 - exp(-dtime/nfixlags)) + else + ! first timestep + this%lag_npp_col(c) = this%npp_col(c) + endif + end do + endif + endif + + + ! vertically integrate column-level carbon fire losses + do l = 1, ndecomp_pools + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%m_decomp_cpools_to_fire_col(c,l) = & + this%m_decomp_cpools_to_fire_col(c,l) + & + this%m_decomp_cpools_to_fire_vr_col(c,j,l)*dzsoi_decomp(j) + end do + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! litter fire losses (LITFIRE) + this%litfire_col(c) = 0._r8 + + ! soil organic matter fire losses (SOMFIRE) + this%somfire_col(c) = 0._r8 + + ! total ecosystem fire losses (TOTFIRE) + this%totfire_col(c) = & + this%litfire_col(c) + & + this%somfire_col(c) + + ! total wood product loss + this%product_closs_col(c) = & + this%prod10c_loss_col(c) + & + this%prod100c_loss_col(c) + + ! carbon losses to fire, including patch losses + this%fire_closs_col(c) = this%fire_closs_p2c_col(c) + do l = 1, ndecomp_pools + this%fire_closs_col(c) = & + this%fire_closs_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + + ! carbon losses due to landcover change + this%dwt_closs_col(c) = & + this%dwt_conv_cflux_col(c) + + ! total soil respiration, heterotrophic + root respiration (SR) + this%sr_col(c) = & + this%rr_col(c) + & + soilbiogeochem_hr_col(c) + + ! total ecosystem respiration, autotrophic + heterotrophic (ER) + this%er_col(c) = & + this%ar_col(c) + & + soilbiogeochem_hr_col(c) + + ! coarse woody debris heterotrophic respiration + this%cwdc_hr_col(c) = 0._r8 + + ! net ecosystem production, excludes fire flux, landcover change, + ! and loss from wood products, positive for sink (NEP) + this%nep_col(c) = & + this%gpp_col(c) - & + this%er_col(c) + + ! net biome production of carbon, includes depletion from: fire flux, + ! landcover change flux, and loss from wood products pools, positive for sink (NBP) + this%nbp_col(c) = & + this%nep_col(c) - & + this%fire_closs_col(c) - & + this%dwt_closs_col(c) - & + this%product_closs_col(c) + + ! net ecosystem exchange of carbon, includes fire flux, landcover change flux, loss + ! from wood products pools, and hrv_xsmrpool flux, positive for source (NEE) + this%nee_col(c) = & + -this%nep_col(c) + & + this%fire_closs_col(c) + & + this%dwt_closs_col(c) + & + this%product_closs_col(c) + & + this%hrv_xsmrpool_to_atm_col(c) + + ! land use flux + this%landuseflux_col(c) = & + this%dwt_closs_col(c) + & + this%product_closs_col(c) + + ! land uptake flux + this%landuptake_col(c) = & + this%nee_col(c) - & + this%landuseflux_col(c) + + end do + + ! coarse woody debris C loss + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = 0._r8 + end do + associate(is_cwd => decomp_cascade_con%is_cwd) ! TRUE => pool is a cwd pool + do l = 1, ndecomp_pools + if ( is_cwd(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = & + this%cwdc_loss_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + end if + end do + do k = 1, ndecomp_cascade_transitions + if ( is_cwd(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_loss_col(c) = & + this%cwdc_loss_col(c) + & + soilbiogeochem_decomp_cascade_ctransfer_col(c,k) + end do + end if + end do + end associate + + + ! litter C loss + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = soilbiogeochem_lithr_col(c) + end do + associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool + do l = 1, ndecomp_pools + if ( is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = & + this%litterc_loss_col(c) + & + this%m_decomp_cpools_to_fire_col(c,l) + end do + end if + end do + do k = 1, ndecomp_cascade_transitions + if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%litterc_loss_col(c) = & + this%litterc_loss_col(c) + & + soilbiogeochem_decomp_cascade_ctransfer_col(c,k) + end do + end if + end do + end associate + + end subroutine Summary_carbonflux + +end module CNVegCarbonFluxType + + diff --git a/components/clm/src/biogeochem/CNVegCarbonStateType.F90 b/components/clm/src/biogeochem/CNVegCarbonStateType.F90 new file mode 100644 index 0000000000..a1988c1280 --- /dev/null +++ b/components/clm/src/biogeochem/CNVegCarbonStateType.F90 @@ -0,0 +1,2207 @@ +module CNVegCarbonStateType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_const_mod , only : SHR_CONST_PDB + use shr_log_mod , only : errMsg => shr_log_errMsg + use pftconMod , only : noveg, npcropmin, pftcon + use clm_varpar , only : crop_prog + use clm_varcon , only : spval + use clm_varctl , only : iulog, use_cndv + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: cnveg_carbonstate_type + + real(r8), pointer :: grainc_patch (:) ! (gC/m2) grain C (crop model) + real(r8), pointer :: grainc_storage_patch (:) ! (gC/m2) grain C storage (crop model) + real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) + real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_patch (:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage_patch (:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer_patch (:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_patch (:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage_patch (:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer_patch (:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_patch (:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage_patch (:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer_patch (:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_patch (:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage_patch (:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer_patch (:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_patch (:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage_patch (:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer_patch (:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: gresp_storage_patch (:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer_patch (:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: cpool_patch (:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool_patch (:) ! (gC/m2) abstract C pool to meet excess MR demand + real(r8), pointer :: ctrunc_patch (:) ! (gC/m2) patch-level sink for C truncation + real(r8), pointer :: woodc_patch (:) ! (gC/m2) wood C + real(r8), pointer :: leafcmax_patch (:) ! (gC/m2) ann max leaf C + real(r8), pointer :: totc_patch (:) ! (gC/m2) total patch-level carbon, including cpool + real(r8), pointer :: rootc_col (:) ! (gC/m2) root carbon at column level (fire) + real(r8), pointer :: leafc_col (:) ! (gC/m2) column-level leafc (fire) + real(r8), pointer :: fuelc_col (:) ! (0-1) fuel avalability factor for Reg.C + real(r8), pointer :: fuelc_crop_col (:) ! (0-1) fuel avalability factor for Reg.A + + ! pools for dynamic landcover + real(r8), pointer :: seedc_col (:) ! (gC/m2) column-level pool for seeding new Patches + real(r8), pointer :: prod10c_col (:) ! (gC/m2) wood product C pool, 10-year lifespan + real(r8), pointer :: prod100c_col (:) ! (gC/m2) wood product C pool, 100-year lifespan + real(r8), pointer :: totprodc_col (:) ! (gC/m2) total wood product C + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegc_patch (:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: storvegc_patch (:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totvegc_patch (:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: totvegc_col (:) ! (gC/m2) total vegetation carbon, excluding cpool averaged to column (p2c) + + ! Total C pools + real(r8), pointer :: totc_col (:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc_col (:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + + contains + + procedure , public :: Init + procedure , public :: SetValues + procedure , public :: ZeroDWT + procedure , public :: Restart + procedure , public :: Summary => Summary_carbonstate + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type cnveg_carbonstate_type + + real(r8) :: c3_r2 ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8) :: c4_r2 ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, carbon_type, ratio, c12_cnveg_carbonstate_inst) + + class(cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: ratio + character(len=3) , intent(in) :: carbon_type + type(cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst + !----------------------------------------------------------------------- + + call this%InitAllocate ( bounds) + call this%InitHistory ( bounds, carbon_type) + if (present(c12_cnveg_carbonstate_inst)) then + call this%InitCold ( bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst) + else + call this%InitCold ( bounds, ratio, carbon_type) + end if + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (cnveg_carbonstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan + allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan + allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan + allocate(this%frootc_patch (begp:endp)) ; this%frootc_patch (:) = nan + allocate(this%frootc_storage_patch (begp:endp)) ; this%frootc_storage_patch (:) = nan + allocate(this%frootc_xfer_patch (begp:endp)) ; this%frootc_xfer_patch (:) = nan + allocate(this%livestemc_patch (begp:endp)) ; this%livestemc_patch (:) = nan + allocate(this%livestemc_storage_patch (begp:endp)) ; this%livestemc_storage_patch (:) = nan + allocate(this%livestemc_xfer_patch (begp:endp)) ; this%livestemc_xfer_patch (:) = nan + allocate(this%deadstemc_patch (begp:endp)) ; this%deadstemc_patch (:) = nan + allocate(this%deadstemc_storage_patch (begp:endp)) ; this%deadstemc_storage_patch (:) = nan + allocate(this%deadstemc_xfer_patch (begp:endp)) ; this%deadstemc_xfer_patch (:) = nan + allocate(this%livecrootc_patch (begp:endp)) ; this%livecrootc_patch (:) = nan + allocate(this%livecrootc_storage_patch (begp:endp)) ; this%livecrootc_storage_patch (:) = nan + allocate(this%livecrootc_xfer_patch (begp:endp)) ; this%livecrootc_xfer_patch (:) = nan + allocate(this%deadcrootc_patch (begp:endp)) ; this%deadcrootc_patch (:) = nan + allocate(this%deadcrootc_storage_patch (begp:endp)) ; this%deadcrootc_storage_patch (:) = nan + allocate(this%deadcrootc_xfer_patch (begp:endp)) ; this%deadcrootc_xfer_patch (:) = nan + allocate(this%gresp_storage_patch (begp:endp)) ; this%gresp_storage_patch (:) = nan + allocate(this%gresp_xfer_patch (begp:endp)) ; this%gresp_xfer_patch (:) = nan + allocate(this%cpool_patch (begp:endp)) ; this%cpool_patch (:) = nan + allocate(this%xsmrpool_patch (begp:endp)) ; this%xsmrpool_patch (:) = nan + allocate(this%ctrunc_patch (begp:endp)) ; this%ctrunc_patch (:) = nan + allocate(this%dispvegc_patch (begp:endp)) ; this%dispvegc_patch (:) = nan + allocate(this%storvegc_patch (begp:endp)) ; this%storvegc_patch (:) = nan + allocate(this%leafcmax_patch (begp:endp)) ; this%leafcmax_patch (:) = nan + allocate(this%totc_patch (begp:endp)) ; this%totc_patch (:) = nan + allocate(this%grainc_patch (begp:endp)) ; this%grainc_patch (:) = nan + allocate(this%grainc_storage_patch (begp:endp)) ; this%grainc_storage_patch (:) = nan + allocate(this%grainc_xfer_patch (begp:endp)) ; this%grainc_xfer_patch (:) = nan + allocate(this%woodc_patch (begp:endp)) ; this%woodc_patch (:) = nan + + allocate(this%seedc_col (begc:endc)) ; this%seedc_col (:) = nan + allocate(this%prod10c_col (begc:endc)) ; this%prod10c_col (:) = nan + allocate(this%prod100c_col (begc:endc)) ; this%prod100c_col (:) = nan + allocate(this%totprodc_col (begc:endc)) ; this%totprodc_col (:) = nan + allocate(this%rootc_col (begc:endc)) ; this%rootc_col (:) = nan + allocate(this%leafc_col (begc:endc)) ; this%leafc_col (:) = nan + allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan + allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan + + allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan + allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan + + allocate(this%totc_col (begc:endc)) ; this%totc_col (:) = nan + allocate(this%totecosysc_col (begc:endc)) ; this%totecosysc_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, carbon_type) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use clm_varctl , only : use_c13, use_c14 + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class (cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj + character(10) :: active + integer :: begp,endp + integer :: begc,endc + integer :: begg,endg + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + !------------------------------- + ! C12 state variables + !------------------------------- + + if (carbon_type == 'c12') then + + if (crop_prog) then + this%grainc_patch(begp:endp) = spval + call hist_addfld1d (fname='GRAINC', units='gC/m^2', & + avgflag='A', long_name='grain C', & + ptr_patch=this%grainc_patch) + end if + + this%woodc_patch(begp:endp) = spval + call hist_addfld1d (fname='WOODC', units='gC/m^2', & + avgflag='A', long_name='wood C', & + ptr_patch=this%woodc_patch) + + this%leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC', units='gC/m^2', & + avgflag='A', long_name='leaf C', & + ptr_patch=this%leafc_patch) + + this%leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='leaf C storage', & + ptr_patch=this%leafc_storage_patch) + + this%leafc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFC_XFER', units='gC/m^2', & + avgflag='A', long_name='leaf C transfer', & + ptr_patch=this%leafc_xfer_patch) + + this%frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC', units='gC/m^2', & + avgflag='A', long_name='fine root C', & + ptr_patch=this%frootc_patch) + + this%frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='fine root C storage', & + ptr_patch=this%frootc_storage_patch) + + this%frootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='fine root C transfer', & + ptr_patch=this%frootc_xfer_patch) + + this%livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC', units='gC/m^2', & + avgflag='A', long_name='live stem C', & + ptr_patch=this%livestemc_patch) + + this%livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='live stem C storage', & + ptr_patch=this%livestemc_storage_patch) + + this%livestemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMC_XFER', units='gC/m^2', & + avgflag='A', long_name='live stem C transfer', & + ptr_patch=this%livestemc_xfer_patch) + + this%deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC', units='gC/m^2', & + avgflag='A', long_name='dead stem C', & + ptr_patch=this%deadstemc_patch) + + this%deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='dead stem C storage', & + ptr_patch=this%deadstemc_storage_patch) + + this%deadstemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMC_XFER', units='gC/m^2', & + avgflag='A', long_name='dead stem C transfer', & + ptr_patch=this%deadstemc_xfer_patch) + + this%livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC', units='gC/m^2', & + avgflag='A', long_name='live coarse root C', & + ptr_patch=this%livecrootc_patch) + + this%livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='live coarse root C storage', & + ptr_patch=this%livecrootc_storage_patch) + + this%livecrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='live coarse root C transfer', & + ptr_patch=this%livecrootc_xfer_patch) + + this%deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTC', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C', & + ptr_patch=this%deadcrootc_patch) + + this%deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C storage', & + ptr_patch=this%deadcrootc_storage_patch) + + this%deadcrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C transfer', & + ptr_patch=this%deadcrootc_xfer_patch) + + this%gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='GRESP_STORAGE', units='gC/m^2', & + avgflag='A', long_name='growth respiration storage', & + ptr_patch=this%gresp_storage_patch) + + this%gresp_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='GRESP_XFER', units='gC/m^2', & + avgflag='A', long_name='growth respiration transfer', & + ptr_patch=this%gresp_xfer_patch) + + this%cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='CPOOL', units='gC/m^2', & + avgflag='A', long_name='temporary photosynthate C pool', & + ptr_patch=this%cpool_patch) + + this%xsmrpool_patch(begp:endp) = spval + call hist_addfld1d (fname='XSMRPOOL', units='gC/m^2', & + avgflag='A', long_name='temporary photosynthate C pool', & + ptr_patch=this%xsmrpool_patch) + + this%ctrunc_patch(begp:endp) = spval + call hist_addfld1d (fname='PFT_CTRUNC', units='gC/m^2', & + avgflag='A', long_name='patch-level sink for C truncation', & + ptr_patch=this%ctrunc_patch) + + this%dispvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='DISPVEGC', units='gC/m^2', & + avgflag='A', long_name='displayed veg carbon, excluding storage and cpool', & + ptr_patch=this%dispvegc_patch) + + this%storvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='STORVEGC', units='gC/m^2', & + avgflag='A', long_name='stored vegetation carbon, excluding cpool', & + ptr_patch=this%storvegc_patch) + + this%totvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='TOTVEGC', units='gC/m^2', & + avgflag='A', long_name='total vegetation carbon, excluding cpool', & + ptr_patch=this%totvegc_patch) + + this%totc_patch(begp:endp) = spval + call hist_addfld1d (fname='TOTPFTC', units='gC/m^2', & + avgflag='A', long_name='total patch-level carbon, including cpool', & + ptr_patch=this%totc_patch) + + this%seedc_col(begc:endc) = spval + call hist_addfld1d (fname='SEEDC', units='gC/m^2', & + avgflag='A', long_name='pool for seeding new Patches', & + ptr_col=this%seedc_col) + + this%prod10c_col(begc:endc) = spval + call hist_addfld1d (fname='PROD10C', units='gC/m^2', & + avgflag='A', long_name='10-yr wood product C', & + ptr_col=this%prod10c_col) + + this%prod100c_col(begc:endc) = spval + call hist_addfld1d (fname='PROD100C', units='gC/m^2', & + avgflag='A', long_name='100-yr wood product C', & + ptr_col=this%prod100c_col) + + this%totprodc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTPRODC', units='gC/m^2', & + avgflag='A', long_name='total wood product C', & + ptr_col=this%totprodc_col) + + this%fuelc_col(begc:endc) = spval + call hist_addfld1d (fname='FUELC', units='gC/m^2', & + avgflag='A', long_name='fuel load', & + ptr_col=this%fuelc_col) + + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTCOLC', units='gC/m^2', & + avgflag='A', long_name='total column carbon, incl veg and cpool', & + ptr_col=this%totc_col) + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTECOSYSC', units='gC/m^2', & + avgflag='A', long_name='total ecosystem carbon, incl veg but excl cpool', & + ptr_col=this%totecosysc_col) + + end if + + !------------------------------- + ! C13 state variables + !------------------------------- + + if ( carbon_type == 'c13' ) then + + this%leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C', & + ptr_patch=this%leafc_patch) + + this%leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C storage', & + ptr_patch=this%leafc_storage_patch, default='inactive') + + this%leafc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LEAFC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C transfer', & + ptr_patch=this%leafc_xfer_patch, default='inactive') + + this%frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C', & + ptr_patch=this%frootc_patch) + + this%frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C storage', & + ptr_patch=this%frootc_storage_patch, default='inactive') + + this%frootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_FROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C transfer', & + ptr_patch=this%frootc_xfer_patch, default='inactive') + + this%livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C', & + ptr_patch=this%livestemc_patch) + + this%livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C storage', & + ptr_patch=this%livestemc_storage_patch, default='inactive') + + this%livestemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVESTEMC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C transfer', & + ptr_patch=this%livestemc_xfer_patch, default='inactive') + + this%deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADSTEMC', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C', & + ptr_patch=this%deadstemc_patch) + + this%deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C storage', & + ptr_patch=this%deadstemc_storage_patch, default='inactive') + + this%deadstemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADSTEMC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C transfer', & + ptr_patch=this%deadstemc_xfer_patch, default='inactive') + + this%livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C', & + ptr_patch=this%livecrootc_patch) + + this%livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C storage', & + ptr_patch=this%livecrootc_storage_patch, default='inactive') + + this%livecrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_LIVECROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C transfer', & + ptr_patch=this%livecrootc_xfer_patch, default='inactive') + + this%deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADCROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C', & + ptr_patch=this%deadcrootc_patch) + + this%deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C storage', & + ptr_patch=this%deadcrootc_storage_patch, default='inactive') + + this%deadcrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DEADCROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C transfer', & + ptr_patch=this%deadcrootc_xfer_patch, default='inactive') + + this%gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_GRESP_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 growth respiration storage', & + ptr_patch=this%gresp_storage_patch, default='inactive') + + this%gresp_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_GRESP_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 growth respiration transfer', & + ptr_patch=this%gresp_xfer_patch, default='inactive') + + this%cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_CPOOL', units='gC13/m^2', & + avgflag='A', long_name='C13 temporary photosynthate C pool', & + ptr_patch=this%cpool_patch) + + this%xsmrpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_XSMRPOOL', units='gC13/m^2', & + avgflag='A', long_name='C13 temporary photosynthate C pool', & + ptr_patch=this%xsmrpool_patch) + + this%ctrunc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PFT_CTRUNC', units='gC13/m^2', & + avgflag='A', long_name='C13 patch-level sink for C truncation', & + ptr_patch=this%ctrunc_patch) + + this%dispvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_DISPVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 displayed veg carbon, excluding storage and cpool', & + ptr_patch=this%dispvegc_patch) + + this%storvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_STORVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 stored vegetation carbon, excluding cpool', & + ptr_patch=this%storvegc_patch) + + this%totvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TOTVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 total vegetation carbon, excluding cpool', & + ptr_patch=this%totvegc_patch) + + this%totc_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_TOTPFTC', units='gC13/m^2', & + avgflag='A', long_name='C13 total patch-level carbon, including cpool', & + ptr_patch=this%totc_patch) + + this%seedc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_SEEDC', units='gC13/m^2', & + avgflag='A', long_name='C13 pool for seeding new Patches', & + ptr_col=this%seedc_col) + + this%prod10c_col(begc:endc) = spval + call hist_addfld1d (fname='C13_PROD10C', units='gC13/m^2', & + avgflag='A', long_name='C13 10-yr wood product C', & + ptr_col=this%prod10c_col) + + this%prod100c_col(begc:endc) = spval + call hist_addfld1d (fname='C13_PROD100C', units='gC13/m^2', & + avgflag='A', long_name='C13 100-yr wood product C', & + ptr_col=this%prod100c_col) + + this%totprodc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTPRODC', units='gC13/m^2', & + avgflag='A', long_name='C13 total wood product C', & + ptr_col=this%totprodc_col) + + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTCOLC', units='gC13/m^2', & + avgflag='A', long_name='C13 total column carbon, incl veg and cpool', & + ptr_col=this%totc_col) + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTECOSYSC', units='gC13/m^2', & + avgflag='A', long_name='C13 total ecosystem carbon, incl veg but excl cpool', & + ptr_col=this%totecosysc_col) + + endif + + !------------------------------- + ! C14 state variables + !------------------------------- + + if ( carbon_type == 'c14') then + + this%leafc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC', units='gC14/m^2', & + avgflag='A', long_name='C14 leaf C', & + ptr_patch=this%leafc_patch) + + this%leafc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 leaf C storage', & + ptr_patch=this%leafc_storage_patch, default='inactive') + + this%leafc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LEAFC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 leaf C transfer', & + ptr_patch=this%leafc_xfer_patch, default='inactive') + + this%frootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC', units='gC14/m^2', & + avgflag='A', long_name='C14 fine root C', & + ptr_patch=this%frootc_patch) + + this%frootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 fine root C storage', & + ptr_patch=this%frootc_storage_patch, default='inactive') + + this%frootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_FROOTC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 fine root C transfer', & + ptr_patch=this%frootc_xfer_patch, default='inactive') + + this%livestemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC', units='gC14/m^2', & + avgflag='A', long_name='C14 live stem C', & + ptr_patch=this%livestemc_patch) + + this%livestemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 live stem C storage', & + ptr_patch=this%livestemc_storage_patch, default='inactive') + + this%livestemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVESTEMC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 live stem C transfer', & + ptr_patch=this%livestemc_xfer_patch, default='inactive') + + this%deadstemc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADSTEMC', units='gC14/m^2', & + avgflag='A', long_name='C14 dead stem C', & + ptr_patch=this%deadstemc_patch) + + this%deadstemc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADSTEMC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 dead stem C storage', & + ptr_patch=this%deadstemc_storage_patch, default='inactive') + + this%deadstemc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADSTEMC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 dead stem C transfer', & + ptr_patch=this%deadstemc_xfer_patch, default='inactive') + + this%livecrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC', units='gC14/m^2', & + avgflag='A', long_name='C14 live coarse root C', & + ptr_patch=this%livecrootc_patch) + + this%livecrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 live coarse root C storage', & + ptr_patch=this%livecrootc_storage_patch, default='inactive') + + this%livecrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_LIVECROOTC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 live coarse root C transfer', & + ptr_patch=this%livecrootc_xfer_patch, default='inactive') + + this%deadcrootc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADCROOTC', units='gC14/m^2', & + avgflag='A', long_name='C14 dead coarse root C', & + ptr_patch=this%deadcrootc_patch) + + this%deadcrootc_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADCROOTC_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 dead coarse root C storage', & + ptr_patch=this%deadcrootc_storage_patch, default='inactive') + + this%deadcrootc_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DEADCROOTC_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 dead coarse root C transfer', & + ptr_patch=this%deadcrootc_xfer_patch, default='inactive') + + this%gresp_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_GRESP_STORAGE', units='gC14/m^2', & + avgflag='A', long_name='C14 growth respiration storage', & + ptr_patch=this%gresp_storage_patch, default='inactive') + + this%gresp_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_GRESP_XFER', units='gC14/m^2', & + avgflag='A', long_name='C14 growth respiration transfer', & + ptr_patch=this%gresp_xfer_patch, default='inactive') + + this%cpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_CPOOL', units='gC14/m^2', & + avgflag='A', long_name='C14 temporary photosynthate C pool', & + ptr_patch=this%cpool_patch) + + this%xsmrpool_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_XSMRPOOL', units='gC14/m^2', & + avgflag='A', long_name='C14 temporary photosynthate C pool', & + ptr_patch=this%xsmrpool_patch) + + this%ctrunc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PFT_CTRUNC', units='gC14/m^2', & + avgflag='A', long_name='C14 patch-level sink for C truncation', & + ptr_patch=this%ctrunc_patch) + + this%dispvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_DISPVEGC', units='gC14/m^2', & + avgflag='A', long_name='C14 displayed veg carbon, excluding storage and cpool', & + ptr_patch=this%dispvegc_patch) + + this%storvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_STORVEGC', units='gC14/m^2', & + avgflag='A', long_name='C14 stored vegetation carbon, excluding cpool', & + ptr_patch=this%storvegc_patch) + + this%totvegc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TOTVEGC', units='gC14/m^2', & + avgflag='A', long_name='C14 total vegetation carbon, excluding cpool', & + ptr_patch=this%totvegc_patch) + + this%totc_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_TOTPFTC', units='gC14/m^2', & + avgflag='A', long_name='C14 total patch-level carbon, including cpool', & + ptr_patch=this%totc_patch) + + this%seedc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_SEEDC', units='gC14/m^2', & + avgflag='A', long_name='C14 pool for seeding new Patches', & + ptr_col=this%seedc_col) + + this%prod10c_col(begc:endc) = spval + call hist_addfld1d (fname='C14_PROD10C', units='gC14/m^2', & + avgflag='A', long_name='C14 10-yr wood product C', & + ptr_col=this%prod10c_col) + + this%prod100c_col(begc:endc) = spval + call hist_addfld1d (fname='C14_PROD100C', units='gC14/m^2', & + avgflag='A', long_name='C14 100-yr wood product C', & + ptr_col=this%prod100c_col) + + this%totprodc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTPRODC', units='gC14/m^2', & + avgflag='A', long_name='C14 total wood product C', & + ptr_col=this%totprodc_col) + + this%totc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTCOLC', units='gC14/m^2', & + avgflag='A', long_name='C14 total column carbon, incl veg and cpool', & + ptr_col=this%totc_col) + + this%totecosysc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTECOSYSC', units='gC14/m^2', & + avgflag='A', long_name='C14 total ecosystem carbon, incl veg but excl cpool', & + ptr_col=this%totecosysc_col) + + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + use landunit_varcon , only : istsoil, istcrop + use clm_time_manager , only : is_restart, get_nstep + use clm_varctl, only : MM_Nuptake_opt + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: ratio + character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' + type(cnveg_carbonstate_type) , optional, intent(in) :: c12_cnveg_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,j,k,i + integer :: fc ! filter index + real(r8) :: c3_r1 ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8) :: c4_r1 ! isotope ratio (13c/12c) for C4 photosynthesis + real(r8) :: c3_del13c ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c4_del13c ! typical del13C for C4 photosynthesis (permil, relative to PDB) + integer :: num_special_col ! number of good values in special_col filter + integer :: num_special_patch ! number of good values in special_patch filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches + !----------------------------------------------------------------------- + + if (carbon_type == 'c13' .or. carbon_type == 'c14') then + if (.not. present(c12_cnveg_carbonstate_inst)) then + call endrun(msg=' ERROR: for C13 or C14 must pass in c12_cnveg_carbonstate_inst as argument' //& + errMsg(__FILE__, __LINE__)) + end if + end if + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! Set patch filters + + num_special_patch = 0 + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + if (lun%ifspecial(l)) then + num_special_patch = num_special_patch + 1 + special_patch(num_special_patch) = p + end if + end do + + !----------------------------------------------- + ! initialize patch-level carbon state variables + !----------------------------------------------- + + do p = bounds%begp,bounds%endp + + this%leafcmax_patch(p) = 0._r8 + + l = patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + if (patch%itype(p) == noveg) then + this%leafc_patch(p) = 0._r8 + this%leafc_storage_patch(p) = 0._r8 + if (MM_Nuptake_opt .eqv. .true.) then + this%frootc_patch(p) = 0._r8 + this%frootc_storage_patch(p) = 0._r8 + end if + else + if (pftcon%evergreen(patch%itype(p)) == 1._r8) then + this%leafc_patch(p) = 1._r8 * ratio + this%leafc_storage_patch(p) = 0._r8 + if (MM_Nuptake_opt .eqv. .true.) then + this%leafc_patch(p) = 20._r8 * ratio + this%frootc_patch(p) = 20._r8 * ratio + this%frootc_storage_patch(p) = 0._r8 + end if + else if (patch%itype(p) >= npcropmin) then ! prognostic crop types + this%leafc_patch(p) = 0._r8 + this%leafc_storage_patch(p) = 0._r8 + if (MM_Nuptake_opt .eqv. .true.) then + this%frootc_patch(p) = 0._r8 + this%frootc_storage_patch(p) = 0._r8 + end if + else + this%leafc_patch(p) = 0._r8 + this%leafc_storage_patch(p) = 1._r8 * ratio + if (MM_Nuptake_opt .eqv. .true.) then + this%leafc_storage_patch(p) = 20._r8 * ratio + this%frootc_patch(p) = 0._r8 + this%frootc_storage_patch(p) = 20._r8 * ratio + end if + end if + end if + this%leafc_xfer_patch(p) = 0._r8 + + if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option + this%frootc_patch(p) = 0._r8 + this%frootc_storage_patch(p) = 0._r8 + end if + this%frootc_xfer_patch(p) = 0._r8 + + this%livestemc_patch(p) = 0._r8 + this%livestemc_storage_patch(p) = 0._r8 + this%livestemc_xfer_patch(p) = 0._r8 + + if (pftcon%woody(patch%itype(p)) == 1._r8) then + this%deadstemc_patch(p) = 0.1_r8 * ratio + else + this%deadstemc_patch(p) = 0._r8 + end if + this%deadstemc_storage_patch(p) = 0._r8 + this%deadstemc_xfer_patch(p) = 0._r8 + + this%livecrootc_patch(p) = 0._r8 + this%livecrootc_storage_patch(p) = 0._r8 + this%livecrootc_xfer_patch(p) = 0._r8 + + this%deadcrootc_patch(p) = 0._r8 + this%deadcrootc_storage_patch(p) = 0._r8 + this%deadcrootc_xfer_patch(p) = 0._r8 + + this%gresp_storage_patch(p) = 0._r8 + this%gresp_xfer_patch(p) = 0._r8 + + this%cpool_patch(p) = 0._r8 + this%xsmrpool_patch(p) = 0._r8 + this%ctrunc_patch(p) = 0._r8 + this%dispvegc_patch(p) = 0._r8 + this%storvegc_patch(p) = 0._r8 + this%woodc_patch(p) = 0._r8 + this%totc_patch(p) = 0._r8 + + if ( crop_prog )then + this%grainc_patch(p) = 0._r8 + this%grainc_storage_patch(p) = 0._r8 + this%grainc_xfer_patch(p) = 0._r8 + end if + + ! calculate totvegc explicitly so that it is available for the isotope + ! code on the first time step. + + this%totvegc_patch(p) = & + this%leafc_patch(p) + & + this%leafc_storage_patch(p) + & + this%leafc_xfer_patch(p) + & + this%frootc_patch(p) + & + this%frootc_storage_patch(p) + & + this%frootc_xfer_patch(p) + & + this%livestemc_patch(p) + & + this%livestemc_storage_patch(p) + & + this%livestemc_xfer_patch(p) + & + this%deadstemc_patch(p) + & + this%deadstemc_storage_patch(p) + & + this%deadstemc_xfer_patch(p) + & + this%livecrootc_patch(p) + & + this%livecrootc_storage_patch(p) + & + this%livecrootc_xfer_patch(p) + & + this%deadcrootc_patch(p) + & + this%deadcrootc_storage_patch(p) + & + this%deadcrootc_xfer_patch(p) + & + this%gresp_storage_patch(p) + & + this%gresp_xfer_patch(p) + & + this%cpool_patch(p) + + if ( crop_prog )then + this%totvegc_patch(p) = & + this%totvegc_patch(p) + & + this%grainc_patch(p) + & + this%grainc_storage_patch(p) + & + this%grainc_xfer_patch(p) + end if + + endif + + end do + + ! ----------------------------------------------- + ! initialize column-level variables + ! ----------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + ! dynamic landcover state variables + this%seedc_col(c) = 0._r8 + this%prod10c_col(c) = 0._r8 + this%prod100c_col(c) = 0._r8 + this%totprodc_col(c) = 0._r8 + + ! total carbon pools + this%totecosysc_col(c) = 0._r8 + this%totc_col(c) = 0._r8 + end if + end do + + ! now loop through special filters and explicitly set the variables that + ! have to be in place for biogeophysics + + do fc = 1,num_special_col + c = special_col(fc) + this%seedc_col(c) = 0._r8 + this%prod10c_col(c) = 0._r8 + this%prod100c_col(c) = 0._r8 + this%totprodc_col(c) = 0._r8 + end do + + if ( .not. is_restart() .and. get_nstep() == 1 ) then + c3_del13c = -28._r8 + c4_del13c = -13._r8 + c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + c3_r2 = c3_r1/(1._r8 + c3_r1) + c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) + c4_r2 = c4_r1/(1._r8 + c4_r1) + + do p = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(p)) == 1._r8) then + this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c3_r2 + this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c3_r2 + this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c3_r2 + this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c3_r2 + this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c3_r2 + this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c3_r2 + this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c3_r2 + this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c3_r2 + else + this%grainc_patch(p) = c12_cnveg_carbonstate_inst%grainc_patch(p) * c4_r2 + this%grainc_storage_patch(p) = c12_cnveg_carbonstate_inst%grainc_storage_patch(p) * c4_r2 + this%grainc_xfer_patch(p) = c12_cnveg_carbonstate_inst%grainc_xfer_patch(p) * c4_r2 + this%dispvegc_patch(p) = c12_cnveg_carbonstate_inst%dispvegc_patch(p) * c4_r2 + this%storvegc_patch(p) = c12_cnveg_carbonstate_inst%storvegc_patch(p) * c4_r2 + this%totvegc_patch(p) = c12_cnveg_carbonstate_inst%totvegc_patch(p) * c4_r2 + this%totc_patch(p) = c12_cnveg_carbonstate_inst%totc_patch(p) * c4_r2 + this%woodc_patch(p) = c12_cnveg_carbonstate_inst%woodc_patch(p) * c4_r2 + end if + end do + end if + + ! initialize fields for special filters + + call this%SetValues (& + num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, & + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_cnveg_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : c14ratio + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' + type (cnveg_carbonstate_type) , intent(in), optional :: c12_cnveg_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,l,c + real(r8) :: m ! multiplier for the exit_spinup code + character(len=128) :: varname ! temporary + logical :: readvar + integer :: idata + logical :: exit_spinup = .false. + logical :: enter_spinup = .false. + real(r8) :: c3_del13c ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c4_del13c ! typical del13C for C4 photosynthesis (permil, relative to PDB) + real(r8) :: c3_r1 ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8) :: c4_r1 ! isotope ratio (13c/12c) for C4 photosynthesis + real(r8) :: c3_r2 ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8) :: c4_r2 ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis + ! flags for comparing the model and restart decomposition cascades + integer :: decomp_cascade_state, restart_file_decomp_cascade_state + !------------------------------------------------------------------------ + + if (carbon_type == 'c13' .or. carbon_type == 'c14') then + if (.not. present(c12_cnveg_carbonstate_inst)) then + call endrun(msg=' ERROR: for C14 must pass in c12_cnveg_carbonstate_inst as argument' //& + errMsg(__FILE__, __LINE__)) + end if + end if + + !-------------------------------- + ! patch carbon state variables (c12) + !-------------------------------- + + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='leafc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leafc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='gresp_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cpool', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_patch) + + call restartvar(ncid=ncid, flag=flag, varname='xsmrpool', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch) + + call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leafcmax', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafcmax_patch) + + call restartvar(ncid=ncid, flag=flag, varname='totcolc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totc_col) + end if + + !-------------------------------- + ! C13 patch carbon state variables + !-------------------------------- + + if ( carbon_type == 'c13') then + call restartvar(ncid=ncid, flag=flag, varname='leafc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c3_r2 + else + this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='leafc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c3_r2 + else + this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c3_r2 + else + this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c3_r2 + else + this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c3_r2 + else + this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c3_r2 + else + this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c3_r2 + else + this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c3_r2 + else + this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c3_r2 + else + this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c3_r2 + else + this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c3_r2 + else + this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c3_r2 + else + this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c3_r2 + else + this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c3_r2 + else + this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c3_r2 + else + this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c3_r2 + else + this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c3_r2 + else + this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c3_r2 + else + this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='gresp_storage_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%gresp_storage with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c3_r2 + else + this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer_13', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%gresp_xfer with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c3_r2 + else + this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='cpool_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%cpool with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c3_r2 + else + this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_13', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%xsmrpool with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c3_r2 + else + this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc_13', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%ctrunc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c3_r2 + else + this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c4_r2 + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='totcolc_13', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totc_col) + end if + + !-------------------------------- + ! C14 patch carbon state variables + !-------------------------------- + + if ( carbon_type == 'c14') then + call restartvar(ncid=ncid, flag=flag, varname='leafc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%leafc_patch(i) /= spval .and. & + .not. isnan(this%leafc_patch(i)) ) then + this%leafc_patch(i) = c12_cnveg_carbonstate_inst%leafc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='leafc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%leafc_storage_patch(i) /= spval .and. & + .not. isnan(this%leafc_storage_patch(i)) ) then + this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='leafc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%leafc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%leafc_xfer_patch(i) /= spval .and. .not. isnan(this%leafc_xfer_patch(i)) ) then + this%leafc_xfer_patch(i) = c12_cnveg_carbonstate_inst%leafc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%frootc_patch(i) /= spval .and. & + .not. isnan(this%frootc_patch(i)) ) then + this%frootc_patch(i) = c12_cnveg_carbonstate_inst%frootc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%frootc_storage_patch(i) /= spval .and. & + .not. isnan(this%frootc_storage_patch(i)) ) then + this%frootc_storage_patch(i) = c12_cnveg_carbonstate_inst%frootc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='frootc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%frootc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%frootc_xfer_patch(i) /= spval .and. & + .not. isnan(this%frootc_xfer_patch(i)) ) then + this%frootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%frootc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livestemc_patch(i) /= spval .and. .not. isnan(this%livestemc_patch(i)) ) then + this%livestemc_patch(i) = c12_cnveg_carbonstate_inst%livestemc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livestemc_storage_patch(i) /= spval .and. .not. isnan(this%livestemc_storage_patch(i)) ) then + this%livestemc_storage_patch(i) = c12_cnveg_carbonstate_inst%livestemc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livestemc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livestemc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livestemc_xfer_patch(i) /= spval .and. .not. isnan(this%livestemc_xfer_patch(i)) ) then + this%livestemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livestemc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadstemc_patch(i) /= spval .and. .not. isnan(this%deadstemc_patch(i)) ) then + this%deadstemc_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadstemc_storage_patch(i) /= spval .and. .not. isnan(this%deadstemc_storage_patch(i)) ) then + this%deadstemc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadstemc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadstemc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadstemc_xfer_patch(i) /= spval .and. .not. isnan(this%deadstemc_xfer_patch(i)) ) then + this%deadstemc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadstemc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livecrootc_patch(i) /= spval .and. .not. isnan(this%livecrootc_patch(i)) ) then + this%livecrootc_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livecrootc_storage_patch(i) /= spval .and. .not. isnan(this%livecrootc_storage_patch(i)) ) then + this%livecrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='livecrootc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%livecrootc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%livecrootc_xfer_patch(i) /= spval .and. .not. isnan(this%livecrootc_xfer_patch(i)) ) then + this%livecrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%livecrootc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadcrootc_patch(i) /= spval .and. .not. isnan(this%deadcrootc_patch(i)) ) then + this%deadcrootc_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadcrootc_storage_patch(i) /= spval .and. .not. isnan(this%deadcrootc_storage_patch(i)) ) then + this%deadcrootc_storage_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootc_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootc_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%deadcrootc_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%deadcrootc_xfer_patch(i) /= spval .and. .not. isnan(this%deadcrootc_xfer_patch(i)) ) then + this%deadcrootc_xfer_patch(i) = c12_cnveg_carbonstate_inst%deadcrootc_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='gresp_storage_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_storage_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%gresp_storage_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%gresp_storage_patch(i) /= spval .and. .not. isnan(this%gresp_storage_patch(i)) ) then + this%gresp_storage_patch(i) = c12_cnveg_carbonstate_inst%gresp_storage_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='gresp_xfer_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gresp_xfer_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%gresp_xfer_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%gresp_xfer_patch(i) /= spval .and. .not. isnan(this%gresp_xfer_patch(i)) ) then + this%gresp_xfer_patch(i) = c12_cnveg_carbonstate_inst%gresp_xfer_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='cpool_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%cpool_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%cpool_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%cpool_patch(i) /= spval .and. .not. isnan(this%cpool_patch(i)) ) then + this%cpool_patch(i) = c12_cnveg_carbonstate_inst%cpool_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='xsmrpool_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%xsmrpool_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%xsmrpool_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%xsmrpool_patch(i) /= spval .and. .not. isnan(this%xsmrpool_patch(i)) ) then + this%xsmrpool_patch(i) = c12_cnveg_carbonstate_inst%xsmrpool_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='pft_ctrunc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ctrunc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%ctrunc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%ctrunc_patch(i) /= spval .and. .not. isnan(this%ctrunc_patch(i)) ) then + this%ctrunc_patch(i) = c12_cnveg_carbonstate_inst%ctrunc_patch(i) * c14ratio + endif + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='totcolc_14', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totc_col) + end if + + !-------------------------------- + ! patch prognostic crop variables + !-------------------------------- + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='grainc', xtype=ncd_double, & + dim1name='pft', long_name='grain C', units='gC/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainc_storage', xtype=ncd_double, & + dim1name='pft', long_name='grain C storage', units='gC/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainc_xfer', xtype=ncd_double, & + dim1name='pft', long_name='grain C transfer', units='gC/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainc_xfer_patch) + end if + + !-------------------------------- + ! column carbon state variables + !-------------------------------- + + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='seedc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%seedc_col) + end if + + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='prod10c', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod10c_col) + end if + + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='prod100c', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod100c_col) + end if + + !-------------------------------- + ! C13 column carbon state variables + !-------------------------------- + + if (carbon_type == 'c13') then + call restartvar(ncid=ncid, flag=flag, varname='seedc_13', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%seedc_col) + if (flag=='read' .and. .not. readvar) then + if (this%seedc_col(i) /= spval .and. & + .not. isnan(this%seedc_col(i)) ) then + this%seedc_col(i) = c12_cnveg_carbonstate_inst%seedc_col(i) * c3_r2 + end if + end if + end if + + if (carbon_type == 'c13') then + call restartvar(ncid=ncid, flag=flag, varname='prod10c_13', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod10c_col) + if (flag=='read' .and. .not. readvar) then + if (this%prod10c_col(i) /= spval .and. & + .not. isnan( this%prod10c_col(i) ) ) then + this%prod10c_col(i) = c12_cnveg_carbonstate_inst%prod10c_col(i) * c3_r2 + endif + end if + end if + + if (carbon_type == 'c13') then + call restartvar(ncid=ncid, flag=flag, varname='prod100c_13', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod100c_col) + if (flag=='read' .and. .not. readvar) then + if (this%prod100c_col(i) /= spval .and. & + .not. isnan( this%prod100c_col(i) ) ) then + this%prod100c_col(i) = c12_cnveg_carbonstate_inst%prod100c_col(i) * c3_r2 + endif + end if + endif + + !-------------------------------- + ! C14 column carbon state variables + !-------------------------------- + + if ( carbon_type == 'c14' ) then + call restartvar(ncid=ncid, flag=flag, varname='seedc_14', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%seedc_col) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%seedc_col with atmospheric c14 value' + do i = bounds%begc,bounds%endc + if (this%seedc_col(i) /= spval .and. & + .not. isnan(this%seedc_col(i)) ) then + this%seedc_col(i) = c12_cnveg_carbonstate_inst%seedc_col(i) * c14ratio + endif + end do + end if + end if + + if ( carbon_type == 'c14' ) then + call restartvar(ncid=ncid, flag=flag, varname='prod10c_14', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod10c_col) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%prod10c_col with atmospheric c14 value' + if (this%prod10c_col(i) /= spval .and. & + .not. isnan(this%prod10c_col(i)) ) then + this%prod10c_col(i) = c12_cnveg_carbonstate_inst%prod10c_col(i) * c14ratio + endif + end if + end if + + if ( carbon_type == 'c14' ) then + call restartvar(ncid=ncid, flag=flag, varname='prod100c_14', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod100c_col) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%prod100c_col with atmospheric c14 value' + if (this%prod100c_col(i) /= spval .and. & + .not. isnan(this%prod100c_col(i)) ) then + this%prod100c_col(i) = c12_cnveg_carbonstate_inst%prod100c_col(i) * c14ratio + endif + end if + endif + + if (carbon_type == 'c13' .or. carbon_type == 'c14') then + if (.not. present(c12_cnveg_carbonstate_inst)) then + call endrun(msg=' ERROR: for C13 or C14 must pass in c12_cnveg_carbonstate_inst as argument' //& + errMsg(__FILE__, __LINE__)) + end if + end if + + c3_del13c = -28._r8 + c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + c3_r2 = c3_r1/(1._r8 + c3_r1) + + c4_del13c = -13._r8 + c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) + c4_r2 = c4_r1/(1._r8 + c4_r1) + + !-------------------------------- + ! C12 carbon state variables + !-------------------------------- + + if (carbon_type == 'c12') then + call restartvar(ncid=ncid, flag=flag, varname='totvegc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch) + end if + + !-------------------------------- + ! C13 carbon state variables + !-------------------------------- + + if ( carbon_type == 'c13') then + call restartvar(ncid=ncid, flag=flag, varname='totvegc_13', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing cnveg_carbonstate_inst%totvegc with atmospheric c13 value' + do i = bounds%begp,bounds%endp + if (pftcon%c3psn(patch%itype(i)) == 1._r8) then + this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c3_r2 + else + this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c4_r2 + endif + end do + end if + endif + + !-------------------------------- + ! C14 patch carbon state variables + !-------------------------------- + + if ( carbon_type == 'c14') then + call restartvar(ncid=ncid, flag=flag, varname='totvegc_14', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totvegc_patch) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%totvegc_patch with atmospheric c14 value' + do i = bounds%begp,bounds%endp + if (this%totvegc_patch(i) /= spval .and. & + .not. isnan(this%totvegc_patch(i)) ) then + this%totvegc_patch(i) = c12_cnveg_carbonstate_inst%totvegc_patch(i) * c14ratio + endif + end do + end if + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon state variables + ! + ! !ARGUMENTS: + class (cnveg_carbonstate_type) :: this + integer , intent(in) :: num_patch + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i = filter_patch(fi) + this%leafc_patch(i) = value_patch + this%leafc_storage_patch(i) = value_patch + this%leafc_xfer_patch(i) = value_patch + this%frootc_patch(i) = value_patch + this%frootc_storage_patch(i) = value_patch + this%frootc_xfer_patch(i) = value_patch + this%livestemc_patch(i) = value_patch + this%livestemc_storage_patch(i) = value_patch + this%livestemc_xfer_patch(i) = value_patch + this%deadstemc_patch(i) = value_patch + this%deadstemc_storage_patch(i) = value_patch + this%deadstemc_xfer_patch(i) = value_patch + this%livecrootc_patch(i) = value_patch + this%livecrootc_storage_patch(i) = value_patch + this%livecrootc_xfer_patch(i) = value_patch + this%deadcrootc_patch(i) = value_patch + this%deadcrootc_storage_patch(i) = value_patch + this%deadcrootc_xfer_patch(i) = value_patch + this%gresp_storage_patch(i) = value_patch + this%gresp_xfer_patch(i) = value_patch + this%cpool_patch(i) = value_patch + this%xsmrpool_patch(i) = value_patch + this%ctrunc_patch(i) = value_patch + this%dispvegc_patch(i) = value_patch + this%storvegc_patch(i) = value_patch + this%woodc_patch(i) = value_patch + this%totvegc_patch(i) = value_patch + this%totc_patch(i) = value_patch + if ( crop_prog ) then + this%grainc_patch(i) = value_patch + this%grainc_storage_patch(i) = value_patch + this%grainc_xfer_patch(i) = value_patch + end if + end do + + do fi = 1,num_column + i = filter_column(fi) + this%rootc_col(i) = value_column + this%leafc_col(i) = value_column + this%fuelc_col(i) = value_column + this%fuelc_crop_col(i) = value_column + this%totvegc_col(i) = value_column + this%totc_col(i) = value_column + this%totecosysc_col(i) = value_column + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%dispvegc_patch(p) = 0._r8 + this%storvegc_patch(p) = 0._r8 + this%totc_patch(p) = 0._r8 + end do + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- + subroutine Summary_carbonstate(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_cwdc_col, soilbiogeochem_totlitc_col, soilbiogeochem_totsomc_col, & + soilbiogeochem_ctrunc_col) + ! + ! !USES: + use subgridAveMod, only : p2c + ! + ! !DESCRIPTION: + ! On the radiation time step, perform patch and column-level carbon summary calculations + ! + ! !ARGUMENTS: + class(cnveg_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + real(r8) , intent(in) :: soilbiogeochem_cwdc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_totlitc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_totsomc_col(bounds%begc:) + real(r8) , intent(in) :: soilbiogeochem_ctrunc_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(soilbiogeochem_cwdc_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(soilbiogeochem_totlitc_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(soilbiogeochem_totsomc_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(soilbiogeochem_ctrunc_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + ! calculate patch -level summary of carbon state + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC) + this%dispvegc_patch(p) = & + this%leafc_patch(p) + & + this%frootc_patch(p) + & + this%livestemc_patch(p) + & + this%deadstemc_patch(p) + & + this%livecrootc_patch(p) + & + this%deadcrootc_patch(p) + + ! stored vegetation carbon, excluding cpool (STORVEGC) + this%storvegc_patch(p) = & + this%cpool_patch(p) + & + this%leafc_storage_patch(p) + & + this%frootc_storage_patch(p) + & + this%livestemc_storage_patch(p) + & + this%deadstemc_storage_patch(p) + & + this%livecrootc_storage_patch(p) + & + this%deadcrootc_storage_patch(p) + & + this%leafc_xfer_patch(p) + & + this%frootc_xfer_patch(p) + & + this%livestemc_xfer_patch(p) + & + this%deadstemc_xfer_patch(p) + & + this%livecrootc_xfer_patch(p) + & + this%deadcrootc_xfer_patch(p) + & + this%gresp_storage_patch(p) + & + this%gresp_xfer_patch(p) + + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%storvegc_patch(p) = & + this%storvegc_patch(p) + & + this%grainc_storage_patch(p) + & + this%grainc_xfer_patch(p) + + this%dispvegc_patch(p) = & + this%dispvegc_patch(p) + & + this%grainc_patch(p) + end if + + ! total vegetation carbon, excluding cpool (TOTVEGC) + this%totvegc_patch(p) = & + this%dispvegc_patch(p) + & + this%storvegc_patch(p) + + ! total patch-level carbon, including xsmrpool, ctrunc + this%totc_patch(p) = & + this%totvegc_patch(p) + & + this%xsmrpool_patch(p) + & + this%ctrunc_patch(p) + + ! (WOODC) - wood C + this%woodc_patch(p) = & + this%deadstemc_patch(p) + & + this%livestemc_patch(p) + & + this%deadcrootc_patch(p) + & + this%livecrootc_patch(p) + + end do + + ! -------------------------------------------- + ! column level summary + ! -------------------------------------------- + + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegc_patch(bounds%begp:bounds%endp), & + this%totvegc_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totc_patch(bounds%begp:bounds%endp), & + this%totc_col(bounds%begc:bounds%endc)) + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! total wood product carbon + this%totprodc_col(c) = & + this%prod10c_col(c) + & + this%prod100c_col(c) + + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + this%totecosysc_col(c) = & + soilbiogeochem_cwdc_col(c) + & + soilbiogeochem_totlitc_col(c) + & + soilbiogeochem_totsomc_col(c) + & + this%totprodc_col(c) + & + this%totvegc_col(c) + + ! total column carbon, including veg and cpool (TOTCOLC) + this%totc_col(c) = this%totc_col(c) + & + soilbiogeochem_cwdc_col(c) + & + soilbiogeochem_totlitc_col(c) + & + soilbiogeochem_totsomc_col(c) + & + this%totprodc_col(c) + & + this%seedc_col(c) + & + soilbiogeochem_ctrunc_col(c) + + end do + + end subroutine Summary_carbonstate + +end module CNVegCarbonStateType diff --git a/components/clm/src/biogeochem/CNVegNitrogenFluxType.F90 b/components/clm/src/biogeochem/CNVegNitrogenFluxType.F90 new file mode 100644 index 0000000000..2c0593c511 --- /dev/null +++ b/components/clm/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -0,0 +1,1552 @@ +module CNVegNitrogenFluxType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : nlevdecomp_full, nlevdecomp, crop_prog + use clm_varcon , only : spval, ispval, dzsoi_decomp + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc + use decompMod , only : bounds_type + use abortutils , only : endrun + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: cnveg_nitrogenflux_type + + ! gap mortality fluxes + real(r8), pointer :: m_leafn_to_litter_patch (:) ! patch leaf N mortality (gN/m2/s) + real(r8), pointer :: m_frootn_to_litter_patch (:) ! patch fine root N mortality (gN/m2/s) + real(r8), pointer :: m_leafn_storage_to_litter_patch (:) ! patch leaf N storage mortality (gN/m2/s) + real(r8), pointer :: m_frootn_storage_to_litter_patch (:) ! patch fine root N storage mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_storage_to_litter_patch (:) ! patch live stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer mortality (gN/m2/s) + real(r8), pointer :: m_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_to_litter_patch (:) ! patch live stem N mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_litter_patch (:) ! patch dead stem N mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_to_litter_patch (:) ! patch live coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_litter_patch (:) ! patch dead coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_retransn_to_litter_patch (:) ! patch retranslocated N pool mortality (gN/m2/s) + + ! harvest fluxes + real(r8), pointer :: hrv_leafn_to_litter_patch (:) ! patch leaf N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_to_litter_patch (:) ! patch fine root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_storage_to_litter_patch (:) ! patch leaf N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_storage_to_litter_patch (:) ! patch fine root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_storage_to_litter_patch (:) ! patch live stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_storage_to_litter_patch (:) ! patch dead stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_storage_to_litter_patch (:) ! patch live coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter_patch (:) ! patch dead coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_xfer_to_litter_patch (:) ! patch leaf N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_xfer_to_litter_patch (:) ! patch fine root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_xfer_to_litter_patch (:) ! patch live stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter_patch (:) ! patch dead stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter_patch (:) ! patch live coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter_patch (:) ! patch dead coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_to_litter_patch (:) ! patch live stem N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod10n_patch (:) ! patch dead stem N harvest to 10-year product pool (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod100n_patch (:) ! patch dead stem N harvest to 100-year product pool (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_to_litter_patch (:) ! patch live coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_to_litter_patch (:) ! patch dead coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_retransn_to_litter_patch (:) ! patch retranslocated N pool harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod10n_col (:) ! col dead stem N harvest mortality to 10-year product pool (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod100n_col (:) ! col dead stem N harvest mortality to 100-year product pool (gN/m2/s) + real(r8), pointer :: m_n_to_litr_met_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter labile N by fire (gN/m3/s) + real(r8), pointer :: m_n_to_litr_cel_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter cellulose N by fire (gN/m3/s) + real(r8), pointer :: m_n_to_litr_lig_fire_col (:,:) ! col N from leaf, froot, xfer and storage N to litter lignin N by fire (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_met_n_col (:,:) ! col N fluxes associated with harvest to litter metabolic pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with harvest to litter cellulose pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with harvest to litter lignin pool (gN/m3/s) + real(r8), pointer :: harvest_n_to_cwdn_col (:,:) ! col N fluxes associated with harvest to CWD pool (gN/m3/s) + + ! fire N fluxes + real(r8), pointer :: m_decomp_npools_to_fire_vr_col (:,:,:) ! col vertically-resolved decomposing N fire loss (gN/m3/s) + real(r8), pointer :: m_decomp_npools_to_fire_col (:,:) ! col vertically-integrated (diagnostic) decomposing N fire loss (gN/m2/s) + real(r8), pointer :: m_leafn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn + real(r8), pointer :: m_leafn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_storage + real(r8), pointer :: m_leafn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from leafn_xfer + real(r8), pointer :: m_livestemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn + real(r8), pointer :: m_livestemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_storage + real(r8), pointer :: m_livestemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livestemn_xfer + real(r8), pointer :: m_deadstemn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn + real(r8), pointer :: m_deadstemn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_storage + real(r8), pointer :: m_deadstemn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadstemn_xfer + real(r8), pointer :: m_frootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn + real(r8), pointer :: m_frootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_storage + real(r8), pointer :: m_frootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from frootn_xfer + real(r8), pointer :: m_livecrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from m_livecrootn_to_fire + real(r8), pointer :: m_livecrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_storage + real(r8), pointer :: m_livecrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from livecrootn_xfer + real(r8), pointer :: m_deadcrootn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn + real(r8), pointer :: m_deadcrootn_storage_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_storage + real(r8), pointer :: m_deadcrootn_xfer_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from deadcrootn_xfer + real(r8), pointer :: m_retransn_to_fire_patch (:) ! patch (gN/m2/s) fire N emissions from retransn + real(r8), pointer :: m_leafn_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn to litter N due to fire + real(r8), pointer :: m_leafn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_storage to litter N due to fire + real(r8), pointer :: m_leafn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from leafn_xfer to litter N due to fire + real(r8), pointer :: m_livestemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn to litter N due to fire + real(r8), pointer :: m_livestemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_storage to litter N due to fire + real(r8), pointer :: m_livestemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livestemn_xfer to litter N due to fire + real(r8), pointer :: m_livestemn_to_deadstemn_fire_patch (:) ! patch (gN/m2/s) from livestemn to deadstemn N due to fire + real(r8), pointer :: m_deadstemn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn to litter N due to fire + real(r8), pointer :: m_deadstemn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_storage to litter N due to fire + real(r8), pointer :: m_deadstemn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadstemn_xfer to litter N due to fire + real(r8), pointer :: m_frootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn to litter N due to fire + real(r8), pointer :: m_frootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_storage to litter N due to fire + real(r8), pointer :: m_frootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from frootn_xfer to litter N due to fire + real(r8), pointer :: m_livecrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn to litter N due to fire + real(r8), pointer :: m_livecrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_storage to litter N due to fire + real(r8), pointer :: m_livecrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to litter N due to fire + real(r8), pointer :: m_livecrootn_to_deadcrootn_fire_patch (:) ! patch (gN/m2/s) from livecrootn_xfer to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_storage_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_storage to deadcrootn due to fire + real(r8), pointer :: m_deadcrootn_xfer_to_litter_fire_patch (:) ! patch (gN/m2/s) from deadcrootn_xfer to deadcrootn due to fire + real(r8), pointer :: m_retransn_to_litter_fire_patch (:) ! patch (gN/m2/s) from retransn to deadcrootn due to fire + real(r8), pointer :: fire_nloss_patch (:) ! patch total patch-level fire N loss (gN/m2/s) + real(r8), pointer :: fire_nloss_col (:) ! col total column-level fire N loss (gN/m2/s) + real(r8), pointer :: fire_nloss_p2c_col (:) ! col patch2col column-level fire N loss (gN/m2/s) (p2c) + real(r8), pointer :: fire_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with fire mortality to CWD pool (gN/m3/s) + + ! phenology fluxes from transfer pool + real(r8), pointer :: grainn_xfer_to_grainn_patch (:) ! patch grain N growth from storage for prognostic crop model (gN/m2/s) + real(r8), pointer :: leafn_xfer_to_leafn_patch (:) ! patch leaf N growth from storage (gN/m2/s) + real(r8), pointer :: frootn_xfer_to_frootn_patch (:) ! patch fine root N growth from storage (gN/m2/s) + real(r8), pointer :: livestemn_xfer_to_livestemn_patch (:) ! patch live stem N growth from storage (gN/m2/s) + real(r8), pointer :: deadstemn_xfer_to_deadstemn_patch (:) ! patch dead stem N growth from storage (gN/m2/s) + real(r8), pointer :: livecrootn_xfer_to_livecrootn_patch (:) ! patch live coarse root N growth from storage (gN/m2/s) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn_patch (:) ! patch dead coarse root N growth from storage (gN/m2/s) + + ! litterfall fluxes + real(r8), pointer :: livestemn_to_litter_patch (:) ! patch livestem N to litter (gN/m2/s) + real(r8), pointer :: grainn_to_food_patch (:) ! patch grain N to food for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_to_litter_patch (:) ! patch leaf N litterfall (gN/m2/s) + real(r8), pointer :: leafn_to_retransn_patch (:) ! patch leaf N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_retransn_patch (:) ! patch fine root N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_litter_patch (:) ! patch fine root N litterfall (gN/m2/s) + + ! allocation fluxes + real(r8), pointer :: retransn_to_npool_patch (:) ! patch deployment of retranslocated N (gN/m2/s) + real(r8), pointer :: sminn_to_npool_patch (:) ! patch deployment of soil mineral N uptake (gN/m2/s) + real(r8), pointer :: npool_to_grainn_patch (:) ! patch allocation to grain N for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_grainn_storage_patch (:) ! patch allocation to grain N storage for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_leafn_patch (:) ! patch allocation to leaf N (gN/m2/s) + real(r8), pointer :: npool_to_leafn_storage_patch (:) ! patch allocation to leaf N storage (gN/m2/s) + real(r8), pointer :: npool_to_frootn_patch (:) ! patch allocation to fine root N (gN/m2/s) + real(r8), pointer :: npool_to_frootn_storage_patch (:) ! patch allocation to fine root N storage (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_patch (:) ! patch allocation to live stem N (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_storage_patch (:) ! patch allocation to live stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn_patch (:) ! patch allocation to dead stem N (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn_storage_patch (:) ! patch allocation to dead stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn_patch (:) ! patch allocation to live coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn_storage_patch (:) ! patch allocation to live coarse root N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn_patch (:) ! patch allocation to dead coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn_storage_patch (:) ! patch allocation to dead coarse root N storage (gN/m2/s) + + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainn_storage_to_xfer_patch (:) ! patch grain N shift storage to transfer for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_storage_to_xfer_patch (:) ! patch leaf N shift storage to transfer (gN/m2/s) + real(r8), pointer :: frootn_storage_to_xfer_patch (:) ! patch fine root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livestemn_storage_to_xfer_patch (:) ! patch live stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadstemn_storage_to_xfer_patch (:) ! patch dead stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s) + real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not + real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s) + + ! turnover of livewood to deadwood, with retranslocation + real(r8), pointer :: livestemn_to_deadstemn_patch (:) ! patch live stem N turnover (gN/m2/s) + real(r8), pointer :: livestemn_to_retransn_patch (:) ! patch live stem N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: livecrootn_to_deadcrootn_patch (:) ! patch live coarse root N turnover (gN/m2/s) + real(r8), pointer :: livecrootn_to_retransn_patch (:) ! patch live coarse root N to retranslocated N pool (gN/m2/s) + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: ndeploy_patch (:) ! patch total N deployed to growth and storage (gN/m2/s) + real(r8), pointer :: wood_harvestn_patch (:) ! patch total N losses to wood product pools (gN/m2/s) + real(r8), pointer :: wood_harvestn_col (:) ! col total N losses to wood product pools (gN/m2/s) (p2c) + + ! phenology: litterfall and crop fluxes + real(r8), pointer :: phenology_n_to_litr_met_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) + real(r8), pointer :: phenology_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) + real(r8), pointer :: phenology_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter lignin pool (gN/m3/s) + + ! gap mortality fluxes + real(r8), pointer :: gap_mortality_n_to_litr_met_n_col (:,:) ! col N fluxes associated with gap mortality to litter metabolic pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with gap mortality to litter cellulose pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_litr_lig_n_col (:,:) ! col N fluxes associated with gap mortality to litter lignin pool (gN/m3/s) + real(r8), pointer :: gap_mortality_n_to_cwdn_col (:,:) ! col N fluxes associated with gap mortality to CWD pool (gN/m3/s) + + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedn_to_leaf_col (:) ! col (gN/m2/s) seed source to patch-level + real(r8), pointer :: dwt_seedn_to_deadstem_col (:) ! col (gN/m2/s) seed source to patch-level + real(r8), pointer :: dwt_conv_nflux_col (:) ! col (gN/m2/s) conversion N flux (immediate loss to atm) + real(r8), pointer :: dwt_prod10n_gain_col (:) ! col (gN/m2/s) addition to 10-yr wood product pool + real(r8), pointer :: dwt_prod100n_gain_col (:) ! col (gN/m2/s) addition to 100-yr wood product pool + real(r8), pointer :: dwt_frootn_to_litr_met_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr_cel_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr_lig_n_col (:,:) ! col (gN/m3/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootn_to_cwdn_col (:,:) ! col (gN/m3/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootn_to_cwdn_col (:,:) ! col (gN/m3/s) dead coarse root to CWD due to landcover change + real(r8), pointer :: dwt_nloss_col (:) ! col (gN/m2/s) total nitrogen loss from product pools and conversion + + ! wood product pool loss fluxes + real(r8), pointer :: prod10n_loss_col (:) ! col (gN/m2/s) decomposition loss from 10-yr wood product pool + real(r8), pointer :: prod100n_loss_col (:) ! col (gN/m2/s) decomposition loss from 100-yr wood product pool + real(r8), pointer :: product_nloss_col (:) ! col (gN/m2/s) total wood product nitrogen loss + + ! Misc + real(r8), pointer :: plant_ndemand_patch (:) ! N flux required to support initial GPP (gN/m2/s) + real(r8), pointer :: avail_retransn_patch (:) ! N flux available from retranslocation pool (gN/m2/s) + real(r8), pointer :: plant_nalloc_patch (:) ! total allocated N flux (gN/m2/s) + + contains + + procedure , public :: Init + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: ZeroDWT + procedure , public :: Summary => Summary_nitrogenflux + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type cnveg_nitrogenflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(cnveg_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate (bounds) + call this%InitHistory (bounds) + call this%InitCold (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize patch nitrogen flux + ! + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%m_leafn_to_litter_patch (begp:endp)) ; this%m_leafn_to_litter_patch (:) = nan + allocate(this%m_frootn_to_litter_patch (begp:endp)) ; this%m_frootn_to_litter_patch (:) = nan + allocate(this%m_leafn_storage_to_litter_patch (begp:endp)) ; this%m_leafn_storage_to_litter_patch (:) = nan + allocate(this%m_frootn_storage_to_litter_patch (begp:endp)) ; this%m_frootn_storage_to_litter_patch (:) = nan + allocate(this%m_livestemn_storage_to_litter_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_patch (:) = nan + allocate(this%m_deadstemn_storage_to_litter_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_patch (:) = nan + allocate(this%m_livecrootn_storage_to_litter_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_patch (:) = nan + allocate(this%m_leafn_xfer_to_litter_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_patch (:) = nan + allocate(this%m_frootn_xfer_to_litter_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemn_xfer_to_litter_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_patch (:) = nan + allocate(this%m_livestemn_to_litter_patch (begp:endp)) ; this%m_livestemn_to_litter_patch (:) = nan + allocate(this%m_deadstemn_to_litter_patch (begp:endp)) ; this%m_deadstemn_to_litter_patch (:) = nan + allocate(this%m_livecrootn_to_litter_patch (begp:endp)) ; this%m_livecrootn_to_litter_patch (:) = nan + allocate(this%m_deadcrootn_to_litter_patch (begp:endp)) ; this%m_deadcrootn_to_litter_patch (:) = nan + allocate(this%m_retransn_to_litter_patch (begp:endp)) ; this%m_retransn_to_litter_patch (:) = nan + allocate(this%hrv_leafn_to_litter_patch (begp:endp)) ; this%hrv_leafn_to_litter_patch (:) = nan + allocate(this%hrv_frootn_to_litter_patch (begp:endp)) ; this%hrv_frootn_to_litter_patch (:) = nan + allocate(this%hrv_leafn_storage_to_litter_patch (begp:endp)) ; this%hrv_leafn_storage_to_litter_patch (:) = nan + allocate(this%hrv_frootn_storage_to_litter_patch (begp:endp)) ; this%hrv_frootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_storage_to_litter_patch (begp:endp)) ; this%hrv_livestemn_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadstemn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_storage_to_litter_patch (:) = nan + allocate(this%hrv_livecrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_storage_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_storage_to_litter_patch (:) = nan + allocate(this%hrv_leafn_xfer_to_litter_patch (begp:endp)) ; this%hrv_leafn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_frootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_frootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livestemn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadstemn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadstemn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livecrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_xfer_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_xfer_to_litter_patch (:) = nan + allocate(this%hrv_livestemn_to_litter_patch (begp:endp)) ; this%hrv_livestemn_to_litter_patch (:) = nan + allocate(this%hrv_deadstemn_to_prod10n_patch (begp:endp)) ; this%hrv_deadstemn_to_prod10n_patch (:) = nan + allocate(this%hrv_deadstemn_to_prod100n_patch (begp:endp)) ; this%hrv_deadstemn_to_prod100n_patch (:) = nan + allocate(this%hrv_livecrootn_to_litter_patch (begp:endp)) ; this%hrv_livecrootn_to_litter_patch (:) = nan + allocate(this%hrv_deadcrootn_to_litter_patch (begp:endp)) ; this%hrv_deadcrootn_to_litter_patch (:) = nan + allocate(this%hrv_retransn_to_litter_patch (begp:endp)) ; this%hrv_retransn_to_litter_patch (:) = nan + + allocate(this%m_leafn_to_fire_patch (begp:endp)) ; this%m_leafn_to_fire_patch (:) = nan + allocate(this%m_leafn_storage_to_fire_patch (begp:endp)) ; this%m_leafn_storage_to_fire_patch (:) = nan + allocate(this%m_leafn_xfer_to_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_fire_patch (:) = nan + allocate(this%m_livestemn_to_fire_patch (begp:endp)) ; this%m_livestemn_to_fire_patch (:) = nan + allocate(this%m_livestemn_storage_to_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_fire_patch (:) = nan + allocate(this%m_livestemn_xfer_to_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_fire_patch (:) = nan + allocate(this%m_deadstemn_to_fire_patch (begp:endp)) ; this%m_deadstemn_to_fire_patch (:) = nan + allocate(this%m_deadstemn_storage_to_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_fire_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_fire_patch (:) = nan + allocate(this%m_frootn_to_fire_patch (begp:endp)) ; this%m_frootn_to_fire_patch (:) = nan + allocate(this%m_frootn_storage_to_fire_patch (begp:endp)) ; this%m_frootn_storage_to_fire_patch (:) = nan + allocate(this%m_frootn_xfer_to_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_fire_patch (:) = nan + allocate(this%m_livecrootn_to_fire_patch (begp:endp)) ; + allocate(this%m_livecrootn_storage_to_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_fire_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_to_fire_patch (begp:endp)) ; this%m_deadcrootn_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_fire_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_fire_patch (:) = nan + allocate(this%m_retransn_to_fire_patch (begp:endp)) ; this%m_retransn_to_fire_patch (:) = nan + + allocate(this%m_leafn_to_litter_fire_patch (begp:endp)) ; this%m_leafn_to_litter_fire_patch (:) = nan + allocate(this%m_leafn_storage_to_litter_fire_patch (begp:endp)) ; this%m_leafn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_leafn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_leafn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livestemn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livestemn_to_deadstemn_fire_patch (begp:endp)) ; this%m_livestemn_to_deadstemn_fire_patch (:) = nan + allocate(this%m_deadstemn_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadstemn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadstemn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_to_litter_fire_patch (begp:endp)) ; this%m_frootn_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_frootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_frootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_frootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_livecrootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_livecrootn_to_deadcrootn_fire_patch (begp:endp)) ; this%m_livecrootn_to_deadcrootn_fire_patch (:) = nan + allocate(this%m_deadcrootn_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootn_storage_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_storage_to_litter_fire_patch (:) = nan + allocate(this%m_deadcrootn_xfer_to_litter_fire_patch (begp:endp)) ; this%m_deadcrootn_xfer_to_litter_fire_patch (:) = nan + allocate(this%m_retransn_to_litter_fire_patch (begp:endp)) ; this%m_retransn_to_litter_fire_patch (:) = nan + + allocate(this%leafn_xfer_to_leafn_patch (begp:endp)) ; this%leafn_xfer_to_leafn_patch (:) = nan + allocate(this%frootn_xfer_to_frootn_patch (begp:endp)) ; this%frootn_xfer_to_frootn_patch (:) = nan + allocate(this%livestemn_xfer_to_livestemn_patch (begp:endp)) ; this%livestemn_xfer_to_livestemn_patch (:) = nan + allocate(this%deadstemn_xfer_to_deadstemn_patch (begp:endp)) ; this%deadstemn_xfer_to_deadstemn_patch (:) = nan + allocate(this%livecrootn_xfer_to_livecrootn_patch (begp:endp)) ; this%livecrootn_xfer_to_livecrootn_patch (:) = nan + allocate(this%deadcrootn_xfer_to_deadcrootn_patch (begp:endp)) ; this%deadcrootn_xfer_to_deadcrootn_patch (:) = nan + allocate(this%leafn_to_litter_patch (begp:endp)) ; this%leafn_to_litter_patch (:) = nan + allocate(this%leafn_to_retransn_patch (begp:endp)) ; this%leafn_to_retransn_patch (:) = nan + allocate(this%frootn_to_retransn_patch (begp:endp)) ; this%frootn_to_retransn_patch (:) = nan + allocate(this%frootn_to_litter_patch (begp:endp)) ; this%frootn_to_litter_patch (:) = nan + allocate(this%retransn_to_npool_patch (begp:endp)) ; this%retransn_to_npool_patch (:) = nan + allocate(this%sminn_to_npool_patch (begp:endp)) ; this%sminn_to_npool_patch (:) = nan + + allocate(this%npool_to_leafn_patch (begp:endp)) ; this%npool_to_leafn_patch (:) = nan + allocate(this%npool_to_leafn_storage_patch (begp:endp)) ; this%npool_to_leafn_storage_patch (:) = nan + allocate(this%npool_to_frootn_patch (begp:endp)) ; this%npool_to_frootn_patch (:) = nan + allocate(this%npool_to_frootn_storage_patch (begp:endp)) ; this%npool_to_frootn_storage_patch (:) = nan + allocate(this%npool_to_livestemn_patch (begp:endp)) ; this%npool_to_livestemn_patch (:) = nan + allocate(this%npool_to_livestemn_storage_patch (begp:endp)) ; this%npool_to_livestemn_storage_patch (:) = nan + allocate(this%npool_to_deadstemn_patch (begp:endp)) ; this%npool_to_deadstemn_patch (:) = nan + allocate(this%npool_to_deadstemn_storage_patch (begp:endp)) ; this%npool_to_deadstemn_storage_patch (:) = nan + allocate(this%npool_to_livecrootn_patch (begp:endp)) ; this%npool_to_livecrootn_patch (:) = nan + allocate(this%npool_to_livecrootn_storage_patch (begp:endp)) ; this%npool_to_livecrootn_storage_patch (:) = nan + allocate(this%npool_to_deadcrootn_patch (begp:endp)) ; this%npool_to_deadcrootn_patch (:) = nan + allocate(this%npool_to_deadcrootn_storage_patch (begp:endp)) ; this%npool_to_deadcrootn_storage_patch (:) = nan + allocate(this%leafn_storage_to_xfer_patch (begp:endp)) ; this%leafn_storage_to_xfer_patch (:) = nan + allocate(this%frootn_storage_to_xfer_patch (begp:endp)) ; this%frootn_storage_to_xfer_patch (:) = nan + allocate(this%livestemn_storage_to_xfer_patch (begp:endp)) ; this%livestemn_storage_to_xfer_patch (:) = nan + allocate(this%deadstemn_storage_to_xfer_patch (begp:endp)) ; this%deadstemn_storage_to_xfer_patch (:) = nan + allocate(this%livecrootn_storage_to_xfer_patch (begp:endp)) ; this%livecrootn_storage_to_xfer_patch (:) = nan + allocate(this%deadcrootn_storage_to_xfer_patch (begp:endp)) ; this%deadcrootn_storage_to_xfer_patch (:) = nan + allocate(this%livestemn_to_deadstemn_patch (begp:endp)) ; this%livestemn_to_deadstemn_patch (:) = nan + allocate(this%livestemn_to_retransn_patch (begp:endp)) ; this%livestemn_to_retransn_patch (:) = nan + allocate(this%livecrootn_to_deadcrootn_patch (begp:endp)) ; this%livecrootn_to_deadcrootn_patch (:) = nan + allocate(this%livecrootn_to_retransn_patch (begp:endp)) ; this%livecrootn_to_retransn_patch (:) = nan + allocate(this%ndeploy_patch (begp:endp)) ; this%ndeploy_patch (:) = nan + allocate(this%wood_harvestn_patch (begp:endp)) ; this%wood_harvestn_patch (:) = nan + allocate(this%fire_nloss_patch (begp:endp)) ; this%fire_nloss_patch (:) = nan + allocate(this%npool_to_grainn_patch (begp:endp)) ; this%npool_to_grainn_patch (:) = nan + allocate(this%npool_to_grainn_storage_patch (begp:endp)) ; this%npool_to_grainn_storage_patch (:) = nan + allocate(this%livestemn_to_litter_patch (begp:endp)) ; this%livestemn_to_litter_patch (:) = nan + allocate(this%grainn_to_food_patch (begp:endp)) ; this%grainn_to_food_patch (:) = nan + allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan + allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan + allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan + allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan + allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan + + allocate(this%hrv_deadstemn_to_prod10n_col (begc:endc)) ; this%hrv_deadstemn_to_prod10n_col (:) = nan + allocate(this%hrv_deadstemn_to_prod100n_col (begc:endc)) ; this%hrv_deadstemn_to_prod100n_col (:) = nan + allocate(this%prod10n_loss_col (begc:endc)) ; this%prod10n_loss_col (:) = nan + allocate(this%prod100n_loss_col (begc:endc)) ; this%prod100n_loss_col (:) = nan + allocate(this%product_nloss_col (begc:endc)) ; this%product_nloss_col (:) = nan + allocate(this%fire_nloss_col (begc:endc)) ; this%fire_nloss_col (:) = nan + allocate(this%fire_nloss_p2c_col (begc:endc)) ; this%fire_nloss_p2c_col (:) = nan + + allocate(this%m_n_to_litr_met_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_met_fire_col (:,:) = nan + allocate(this%m_n_to_litr_cel_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_cel_fire_col (:,:) = nan + allocate(this%m_n_to_litr_lig_fire_col (begc:endc,1:nlevdecomp_full)) ; this%m_n_to_litr_lig_fire_col (:,:) = nan + + allocate(this%dwt_seedn_to_leaf_col (begc:endc)) ; this%dwt_seedn_to_leaf_col (:) = nan + allocate(this%dwt_seedn_to_deadstem_col (begc:endc)) ; this%dwt_seedn_to_deadstem_col (:) = nan + allocate(this%dwt_conv_nflux_col (begc:endc)) ; this%dwt_conv_nflux_col (:) = nan + allocate(this%dwt_prod10n_gain_col (begc:endc)) ; this%dwt_prod10n_gain_col (:) = nan + allocate(this%dwt_prod100n_gain_col (begc:endc)) ; this%dwt_prod100n_gain_col (:) = nan + allocate(this%dwt_nloss_col (begc:endc)) ; this%dwt_nloss_col (:) = nan + allocate(this%wood_harvestn_col (begc:endc)) ; this%wood_harvestn_col (:) = nan + + allocate(this%dwt_frootn_to_litr_met_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_met_n_col (:,:) = nan + allocate(this%dwt_frootn_to_litr_cel_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_cel_n_col (:,:) = nan + allocate(this%dwt_frootn_to_litr_lig_n_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_frootn_to_litr_lig_n_col (:,:) = nan + allocate(this%dwt_livecrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_livecrootn_to_cwdn_col (:,:) = nan + allocate(this%dwt_deadcrootn_to_cwdn_col (begc:endc,1:nlevdecomp_full)) ; this%dwt_deadcrootn_to_cwdn_col (:,:) = nan + + allocate(this%m_decomp_npools_to_fire_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + allocate(this%m_decomp_npools_to_fire_col (begc:endc,1:ndecomp_pools )) + + this%m_decomp_npools_to_fire_vr_col (:,:,:) = nan + this%m_decomp_npools_to_fire_col (:,:) = nan + + allocate(this%phenology_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%phenology_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%phenology_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%gap_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%fire_mortality_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_met_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_cel_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_litr_lig_n_col (begc:endc, 1:nlevdecomp_full)) + allocate(this%harvest_n_to_cwdn_col (begc:endc, 1:nlevdecomp_full)) + + this%phenology_n_to_litr_met_n_col (:,:) = nan + this%phenology_n_to_litr_cel_n_col (:,:) = nan + this%phenology_n_to_litr_lig_n_col (:,:) = nan + this%gap_mortality_n_to_litr_met_n_col (:,:) = nan + this%gap_mortality_n_to_litr_cel_n_col (:,:) = nan + this%gap_mortality_n_to_litr_lig_n_col (:,:) = nan + this%gap_mortality_n_to_cwdn_col (:,:) = nan + this%fire_mortality_n_to_cwdn_col (:,:) = nan + this%harvest_n_to_litr_met_n_col (:,:) = nan + this%harvest_n_to_litr_cel_n_col (:,:) = nan + this%harvest_n_to_litr_lig_n_col (:,:) = nan + this%harvest_n_to_cwdn_col (:,:) = nan + + allocate(this%plant_ndemand_patch (begp:endp)) ; this%plant_ndemand_patch (:) = nan + allocate(this%avail_retransn_patch (begp:endp)) ; this%avail_retransn_patch (:) = nan + allocate(this%plant_nalloc_patch (begp:endp)) ; this%plant_nalloc_patch (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevgrnd, crop_prog + use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(cnveg_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l + integer :: begp, endp + integer :: begc, endc + character(10) :: active + character(24) :: fieldname + character(100) :: longname + character(8) :: vr_suffix + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + ! add suffix if number of soil decomposition depths is greater than 1 + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + this%m_leafn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N mortality', & + ptr_patch=this%m_leafn_to_litter_patch, default='inactive') + + this%m_frootn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N mortality', & + ptr_patch=this%m_frootn_to_litter_patch, default='inactive') + + this%m_leafn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N storage mortality', & + ptr_patch=this%m_leafn_storage_to_litter_patch, default='inactive') + + this%m_frootn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N storage mortality', & + ptr_patch=this%m_frootn_storage_to_litter_patch, default='inactive') + + this%m_livestemn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N storage mortality', & + ptr_patch=this%m_livestemn_storage_to_litter_patch, default='inactive') + + this%m_deadstemn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N storage mortality', & + ptr_patch=this%m_deadstemn_storage_to_litter_patch, default='inactive') + + this%m_livecrootn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N storage mortality', & + ptr_patch=this%m_livecrootn_storage_to_litter_patch, default='inactive') + + this%m_deadcrootn_storage_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N storage mortality', & + ptr_patch=this%m_deadcrootn_storage_to_litter_patch, default='inactive') + + this%m_leafn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N transfer mortality', & + ptr_patch=this%m_leafn_xfer_to_litter_patch, default='inactive') + + this%m_frootn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N transfer mortality', & + ptr_patch=this%m_frootn_xfer_to_litter_patch, default='inactive') + + this%m_livestemn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N transfer mortality', & + ptr_patch=this%m_livestemn_xfer_to_litter_patch, default='inactive') + + this%m_deadstemn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N transfer mortality', & + ptr_patch=this%m_deadstemn_xfer_to_litter_patch, default='inactive') + + this%m_livecrootn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N transfer mortality', & + ptr_patch=this%m_livecrootn_xfer_to_litter_patch, default='inactive') + + this%m_deadcrootn_xfer_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N transfer mortality', & + ptr_patch=this%m_deadcrootn_xfer_to_litter_patch, default='inactive') + + this%m_livestemn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N mortality', & + ptr_patch=this%m_livestemn_to_litter_patch, default='inactive') + + this%m_deadstemn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N mortality', & + ptr_patch=this%m_deadstemn_to_litter_patch, default='inactive') + + this%m_livecrootn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N mortality', & + ptr_patch=this%m_livecrootn_to_litter_patch, default='inactive') + + this%m_deadcrootn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N mortality', & + ptr_patch=this%m_deadcrootn_to_litter_patch, default='inactive') + + this%m_retransn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='M_RETRANSN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='retranslocated N pool mortality', & + ptr_patch=this%m_retransn_to_litter_patch, default='inactive') + + this%m_leafn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N fire loss', & + ptr_patch=this%m_leafn_to_fire_patch, default='inactive') + + this%m_frootn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N fire loss ', & + ptr_patch=this%m_frootn_to_fire_patch, default='inactive') + + this%m_leafn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N storage fire loss', & + ptr_patch=this%m_leafn_storage_to_fire_patch, default='inactive') + + this%m_frootn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N storage fire loss', & + ptr_patch=this%m_frootn_storage_to_fire_patch, default='inactive') + + this%m_livestemn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N storage fire loss', & + ptr_patch=this%m_livestemn_storage_to_fire_patch, default='inactive') + + this%m_deadstemn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N storage fire loss', & + ptr_patch=this%m_deadstemn_storage_to_fire_patch, default='inactive') + + this%m_livecrootn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N storage fire loss', & + ptr_patch=this%m_livecrootn_storage_to_fire_patch, default='inactive') + + this%m_deadcrootn_storage_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N storage fire loss', & + ptr_patch=this%m_deadcrootn_storage_to_fire_patch, default='inactive') + + this%m_leafn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LEAFN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N transfer fire loss', & + ptr_patch=this%m_leafn_xfer_to_fire_patch, default='inactive') + + this%m_frootn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_FROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N transfer fire loss', & + ptr_patch=this%m_frootn_xfer_to_fire_patch, default='inactive') + + this%m_livestemn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N transfer fire loss', & + ptr_patch=this%m_livestemn_xfer_to_fire_patch, default='inactive') + + this%m_deadstemn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N transfer fire loss', & + ptr_patch=this%m_deadstemn_xfer_to_fire_patch, default='inactive') + + this%m_livecrootn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N transfer fire loss', & + ptr_patch=this%m_livecrootn_xfer_to_fire_patch, default='inactive') + + this%m_deadcrootn_xfer_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N transfer fire loss', & + ptr_patch=this%m_deadcrootn_xfer_to_fire_patch, default='inactive') + + this%m_livestemn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVESTEMN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N fire loss', & + ptr_patch=this%m_livestemn_to_fire_patch, default='inactive') + + this%m_deadstemn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N fire loss', & + ptr_patch=this%m_deadstemn_to_fire_patch, default='inactive') + + this%m_deadstemn_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N fire mortality to litter', & + ptr_patch=this%m_deadstemn_to_litter_fire_patch, default='inactive') + + this%m_livecrootn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_LIVECROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N fire loss', & + ptr_patch=this%m_livecrootn_to_fire_patch, default='inactive') + + this%m_deadcrootn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N fire loss', & + ptr_patch=this%m_deadcrootn_to_fire_patch, default='inactive') + + this%m_deadcrootn_to_litter_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N fire mortality to litter', & + ptr_patch=this%m_deadcrootn_to_litter_fire_patch, default='inactive') + + this%m_retransn_to_fire_patch(begp:endp) = spval + call hist_addfld1d (fname='M_RETRANSN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='retranslocated N pool fire loss', & + ptr_patch=this%m_retransn_to_fire_patch, default='inactive') + + this%leafn_xfer_to_leafn_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_XFER_TO_LEAFN', units='gN/m^2/s', & + avgflag='A', long_name='leaf N growth from storage', & + ptr_patch=this%leafn_xfer_to_leafn_patch, default='inactive') + + this%frootn_xfer_to_frootn_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN_XFER_TO_FROOTN', units='gN/m^2/s', & + avgflag='A', long_name='fine root N growth from storage', & + ptr_patch=this%frootn_xfer_to_frootn_patch, default='inactive') + + this%livestemn_xfer_to_livestemn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_XFER_TO_LIVESTEMN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N growth from storage', & + ptr_patch=this%livestemn_xfer_to_livestemn_patch, default='inactive') + + this%deadstemn_xfer_to_deadstemn_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMN_XFER_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N growth from storage', & + ptr_patch=this%deadstemn_xfer_to_deadstemn_patch, default='inactive') + + this%livecrootn_xfer_to_livecrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_XFER_TO_LIVECROOTN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N growth from storage', & + ptr_patch=this%livecrootn_xfer_to_livecrootn_patch, default='inactive') + + this%deadcrootn_xfer_to_deadcrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTN_XFER_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N growth from storage', & + ptr_patch=this%deadcrootn_xfer_to_deadcrootn_patch, default='inactive') + + this%leafn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N litterfall', & + ptr_patch=this%leafn_to_litter_patch, default='inactive') + + this%leafn_to_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='leaf N to retranslocated N pool', & + ptr_patch=this%leafn_to_retransn_patch, default='inactive') + + this%frootn_to_litter_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N litterfall', & + ptr_patch=this%frootn_to_litter_patch, default='inactive') + + this%retransn_to_npool_patch(begp:endp) = spval + call hist_addfld1d (fname='RETRANSN_TO_NPOOL', units='gN/m^2/s', & + avgflag='A', long_name='deployment of retranslocated N', & + ptr_patch=this%retransn_to_npool_patch) + + this%sminn_to_npool_patch(begp:endp) = spval + call hist_addfld1d (fname='SMINN_TO_NPOOL', units='gN/m^2/s', & + avgflag='A', long_name='deployment of soil mineral N uptake', & + ptr_patch=this%sminn_to_npool_patch) + + this%npool_to_leafn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LEAFN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to leaf N', & + ptr_patch=this%npool_to_leafn_patch, default='inactive') + + this%npool_to_leafn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LEAFN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to leaf N storage', & + ptr_patch=this%npool_to_leafn_storage_patch, default='inactive') + + this%npool_to_frootn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_FROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to fine root N', & + ptr_patch=this%npool_to_frootn_patch, default='inactive') + + this%npool_to_frootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_FROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to fine root N storage', & + ptr_patch=this%npool_to_frootn_storage_patch, default='inactive') + + this%npool_to_livestemn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live stem N', & + ptr_patch=this%npool_to_livestemn_patch, default='inactive') + + this%npool_to_livestemn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live stem N storage', & + ptr_patch=this%npool_to_livestemn_storage_patch, default='inactive') + + this%npool_to_deadstemn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead stem N', & + ptr_patch=this%npool_to_deadstemn_patch, default='inactive') + + this%npool_to_deadstemn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead stem N storage', & + ptr_patch=this%npool_to_deadstemn_storage_patch, default='inactive') + + this%npool_to_livecrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live coarse root N', & + ptr_patch=this%npool_to_livecrootn_patch, default='inactive') + + this%npool_to_livecrootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live coarse root N storage', & + ptr_patch=this%npool_to_livecrootn_storage_patch, default='inactive') + + this%npool_to_deadcrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root N', & + ptr_patch=this%npool_to_deadcrootn_patch, default='inactive') + + this%npool_to_deadcrootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root N storage', & + ptr_patch=this%npool_to_deadcrootn_storage_patch, default='inactive') + + this%leafn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N shift storage to transfer', & + ptr_patch=this%leafn_storage_to_xfer_patch, default='inactive') + + this%frootn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N shift storage to transfer', & + ptr_patch=this%frootn_storage_to_xfer_patch, default='inactive') + + this%livestemn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N shift storage to transfer', & + ptr_patch=this%livestemn_storage_to_xfer_patch, default='inactive') + + this%deadstemn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N shift storage to transfer', & + ptr_patch=this%deadstemn_storage_to_xfer_patch, default='inactive') + + this%livecrootn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N shift storage to transfer', & + ptr_patch=this%livecrootn_storage_to_xfer_patch, default='inactive') + + this%deadcrootn_storage_to_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N shift storage to transfer', & + ptr_patch=this%deadcrootn_storage_to_xfer_patch, default='inactive') + + this%livestemn_to_deadstemn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N turnover', & + ptr_patch=this%livestemn_to_deadstemn_patch, default='inactive') + + this%livestemn_to_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N to retranslocated N pool', & + ptr_patch=this%livestemn_to_retransn_patch, default='inactive') + + this%livecrootn_to_deadcrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N turnover', & + ptr_patch=this%livecrootn_to_deadcrootn_patch, default='inactive') + + this%livecrootn_to_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N to retranslocated N pool', & + ptr_patch=this%livecrootn_to_retransn_patch, default='inactive') + + this%ndeploy_patch(begp:endp) = spval + call hist_addfld1d (fname='NDEPLOY', units='gN/m^2/s', & + avgflag='A', long_name='total N deployed in new growth', & + ptr_patch=this%ndeploy_patch) + + this%wood_harvestn_patch(begp:endp) = spval + call hist_addfld1d (fname='WOOD_HARVESTN', units='gN/m^2/s', & + avgflag='A', long_name='wood harvest N (to product pools)', & + ptr_patch=this%wood_harvestn_patch) + + this%fire_nloss_patch(begp:endp) = spval + call hist_addfld1d (fname='PFT_FIRE_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total patch-level fire N loss', & + ptr_patch=this%fire_nloss_patch) + + if (crop_prog) then + this%fert_patch(begp:endp) = spval + call hist_addfld1d (fname='FERT', units='gN/m^2/s', & + avgflag='A', long_name='fertilizer added', & + ptr_patch=this%fert_patch) + end if + + if (crop_prog) then + this%soyfixn_patch(begp:endp) = spval + call hist_addfld1d (fname='SOYFIXN', units='gN/m^2/s', & + avgflag='A', long_name='soybean fixation', & + ptr_patch=this%soyfixn_patch) + end if + + if (crop_prog) then + this%fert_counter_patch(begp:endp) = spval + call hist_addfld1d (fname='FERT_COUNTER', units='seconds', & + avgflag='A', long_name='time left to fertilize', & + ptr_patch=this%fert_counter_patch) + end if + + !------------------------------- + ! N flux variables - native to column + !------------------------------- + + do k = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(k) .or. decomp_cascade_con%is_cwd(k) ) then + this%m_decomp_npools_to_fire_col(begc:endc,k) = spval + data1dptr => this%m_decomp_npools_to_fire_col(:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss' + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default='inactive') + + if ( nlevdecomp_full > 1 ) then + this%m_decomp_npools_to_fire_vr_col(begc:endc,:,k) = spval + data2dptr => this%m_decomp_npools_to_fire_vr_col(:,:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_FIRE'//trim(vr_suffix) + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N fire loss' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + endif + end do + + this%fire_nloss_col(begc:endc) = spval + call hist_addfld1d (fname='COL_FIRE_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total column-level fire N loss', & + ptr_col=this%fire_nloss_col) + + this%dwt_seedn_to_leaf_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_SEEDN_TO_LEAF', units='gN/m^2/s', & + avgflag='A', long_name='seed source to patch-level leaf', & + ptr_col=this%dwt_seedn_to_leaf_col) + + this%dwt_seedn_to_deadstem_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_SEEDN_TO_DEADSTEM', units='gN/m^2/s', & + avgflag='A', long_name='seed source to patch-level deadstem', & + ptr_col=this%dwt_seedn_to_deadstem_col) + + this%dwt_conv_nflux_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_CONV_NFLUX', units='gN/m^2/s', & + avgflag='A', long_name='conversion N flux (immediate loss to atm)', & + ptr_col=this%dwt_conv_nflux_col) + + this%dwt_prod10n_gain_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_PROD10N_GAIN', units='gN/m^2/s', & + avgflag='A', long_name='addition to 10-yr wood product pool', & + ptr_col=this%dwt_prod10n_gain_col) + + this%prod10n_loss_col(begc:endc) = spval + call hist_addfld1d (fname='PROD10N_LOSS', units='gN/m^2/s', & + avgflag='A', long_name='loss from 10-yr wood product pool', & + ptr_col=this%prod10n_loss_col) + + this%dwt_prod100n_gain_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_PROD100N_GAIN', units='gN/m^2/s', & + avgflag='A', long_name='addition to 100-yr wood product pool', & + ptr_col=this%dwt_prod100n_gain_col) + + this%prod100n_loss_col(begc:endc) = spval + call hist_addfld1d (fname='PROD100N_LOSS', units='gN/m^2/s', & + avgflag='A', long_name='loss from 100-yr wood product pool', & + ptr_col=this%prod100n_loss_col) + + this%product_nloss_col(begc:endc) = spval + call hist_addfld1d (fname='PRODUCT_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total N loss from wood product pools', & + ptr_col=this%product_nloss_col) + + this%dwt_frootn_to_litr_met_n_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_MET_N', units='gN/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootn_to_litr_met_n_col, default='inactive') + + this%dwt_frootn_to_litr_cel_n_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_CEL_N', units='gN/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootn_to_litr_cel_n_col, default='inactive') + + this%dwt_frootn_to_litr_lig_n_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_FROOTN_TO_LITR_LIG_N', units='gN/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=this%dwt_frootn_to_litr_lig_n_col, default='inactive') + + this%dwt_livecrootn_to_cwdn_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_LIVECROOTN_TO_CWDN', units='gN/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='live coarse root to CWD due to landcover change', & + ptr_col=this%dwt_livecrootn_to_cwdn_col, default='inactive') + + this%dwt_deadcrootn_to_cwdn_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='DWT_DEADCROOTN_TO_CWDN', units='gN/m^2/s', type2d='levdcmp', & + avgflag='A', long_name='dead coarse root to CWD due to landcover change', & + ptr_col=this%dwt_deadcrootn_to_cwdn_col, default='inactive') + + this%dwt_nloss_col(begc:endc) = spval + call hist_addfld1d (fname='DWT_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total nitrogen loss from landcover conversion', & + ptr_col=this%dwt_nloss_col) + + this%plant_ndemand_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANT_NDEMAND', units='gN/m^2/s', & + avgflag='A', long_name='N flux required to support initial GPP', & + ptr_patch=this%plant_ndemand_patch) + + this%avail_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='AVAIL_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='N flux available from retranslocation pool', & + ptr_patch=this%avail_retransn_patch, default='inactive') + + this%plant_nalloc_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANT_NALLOC', units='gN/m^2/s', & + avgflag='A', long_name='total allocated N flux', & + ptr_patch=this%plant_nalloc_patch, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + use clm_varpar , only : crop_prog + use landunit_varcon , only : istsoil, istcrop + ! + ! !ARGUMENTS: + class(cnveg_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,c,l + integer :: fp, fc ! filter indices + integer :: num_special_col ! number of good values in special_col filter + integer :: num_special_patch ! number of good values in special_patch filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches + !--------------------------------------------------------------------- + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! Set patch filters + + num_special_patch = 0 + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + if (lun%ifspecial(l)) then + num_special_patch = num_special_patch + 1 + special_patch(num_special_patch) = p + end if + end do + + !----------------------------------------------- + ! initialize nitrogen flux variables + !----------------------------------------------- + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + if ( crop_prog )then + this%fert_counter_patch(p) = spval + this%fert_patch(p) = 0._r8 + this%soyfixn_patch(p) = 0._r8 + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%fert_counter_patch(p) = 0._r8 + end if + + if (lun%ifspecial(l)) then + this%plant_ndemand_patch(p) = spval + this%avail_retransn_patch(p) = spval + this%plant_nalloc_patch(p) = spval + end if + end do + + ! initialize fields for special filters + + do fc = 1,num_special_col + c = special_col(fc) + this%dwt_nloss_col(c) = 0._r8 + end do + + call this%SetValues (& + num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, & + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart (this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use clm_varpar, only : crop_prog + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='fert_counter', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_counter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fert', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='grainn_xfer_to_grainn', xtype=ncd_double, & + dim1name='pft', & + long_name='grain N growth from storage', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_xfer_to_grainn_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='livestemn_to_litter', xtype=ncd_double, & + dim1name='pft', & + long_name='livestem N to litter', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%livestemn_to_litter_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='grainn_to_food', xtype=ncd_double, & + dim1name='pft', & + long_name='grain N to food', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_to_food_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='npool_to_grainn', xtype=ncd_double, & + dim1name='pft', & + long_name='allocation to grain N', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%npool_to_grainn_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='npool_to_grainn_storage', xtype=ncd_double, & + dim1name='pft', & + long_name='allocation to grain N storage', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%npool_to_grainn_storage_patch) + end if + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='grainn_storage_to_xfer', xtype=ncd_double, & + dim1name='pft', & + long_name='grain N shift storage to transfer', units='gN/m2/s', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_storage_to_xfer_patch) + end if + + call restartvar(ncid=ncid, flag=flag, varname='plant_ndemand', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_ndemand_patch) + + call restartvar(ncid=ncid, flag=flag, varname='avail_retransn', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%avail_retransn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='plant_nalloc', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_nalloc_patch) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen flux variables + ! + ! !ARGUMENTS: + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + integer , intent(in) :: num_patch + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i=filter_patch(fi) + + this%m_leafn_to_litter_patch(i) = value_patch + this%m_frootn_to_litter_patch(i) = value_patch + this%m_leafn_storage_to_litter_patch(i) = value_patch + this%m_frootn_storage_to_litter_patch(i) = value_patch + this%m_livestemn_storage_to_litter_patch(i) = value_patch + this%m_deadstemn_storage_to_litter_patch(i) = value_patch + this%m_livecrootn_storage_to_litter_patch(i) = value_patch + this%m_deadcrootn_storage_to_litter_patch(i) = value_patch + this%m_leafn_xfer_to_litter_patch(i) = value_patch + this%m_frootn_xfer_to_litter_patch(i) = value_patch + this%m_livestemn_xfer_to_litter_patch(i) = value_patch + this%m_deadstemn_xfer_to_litter_patch(i) = value_patch + this%m_livecrootn_xfer_to_litter_patch(i) = value_patch + this%m_deadcrootn_xfer_to_litter_patch(i) = value_patch + this%m_livestemn_to_litter_patch(i) = value_patch + this%m_deadstemn_to_litter_patch(i) = value_patch + this%m_livecrootn_to_litter_patch(i) = value_patch + this%m_deadcrootn_to_litter_patch(i) = value_patch + this%m_retransn_to_litter_patch(i) = value_patch + this%hrv_leafn_to_litter_patch(i) = value_patch + this%hrv_frootn_to_litter_patch(i) = value_patch + this%hrv_leafn_storage_to_litter_patch(i) = value_patch + this%hrv_frootn_storage_to_litter_patch(i) = value_patch + this%hrv_livestemn_storage_to_litter_patch(i) = value_patch + this%hrv_deadstemn_storage_to_litter_patch(i) = value_patch + this%hrv_livecrootn_storage_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_storage_to_litter_patch(i) = value_patch + this%hrv_leafn_xfer_to_litter_patch(i) = value_patch + this%hrv_frootn_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemn_xfer_to_litter_patch(i) = value_patch + this%hrv_deadstemn_xfer_to_litter_patch(i) = value_patch + this%hrv_livecrootn_xfer_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_xfer_to_litter_patch(i) = value_patch + this%hrv_livestemn_to_litter_patch(i) = value_patch + this%hrv_deadstemn_to_prod10n_patch(i) = value_patch + this%hrv_deadstemn_to_prod100n_patch(i) = value_patch + this%hrv_livecrootn_to_litter_patch(i) = value_patch + this%hrv_deadcrootn_to_litter_patch(i) = value_patch + this%hrv_retransn_to_litter_patch(i) = value_patch + + this%m_leafn_to_fire_patch(i) = value_patch + this%m_leafn_storage_to_fire_patch(i) = value_patch + this%m_leafn_xfer_to_fire_patch(i) = value_patch + this%m_livestemn_to_fire_patch(i) = value_patch + this%m_livestemn_storage_to_fire_patch(i) = value_patch + this%m_livestemn_xfer_to_fire_patch(i) = value_patch + this%m_deadstemn_to_fire_patch(i) = value_patch + this%m_deadstemn_storage_to_fire_patch(i) = value_patch + this%m_deadstemn_xfer_to_fire_patch(i) = value_patch + this%m_frootn_to_fire_patch(i) = value_patch + this%m_frootn_storage_to_fire_patch(i) = value_patch + this%m_frootn_xfer_to_fire_patch(i) = value_patch + this%m_livecrootn_to_fire_patch(i) = value_patch + this%m_livecrootn_storage_to_fire_patch(i) = value_patch + this%m_livecrootn_xfer_to_fire_patch(i) = value_patch + this%m_deadcrootn_to_fire_patch(i) = value_patch + this%m_deadcrootn_storage_to_fire_patch(i) = value_patch + this%m_deadcrootn_xfer_to_fire_patch(i) = value_patch + this%m_retransn_to_fire_patch(i) = value_patch + + + this%m_leafn_to_litter_fire_patch(i) = value_patch + this%m_leafn_storage_to_litter_fire_patch(i) = value_patch + this%m_leafn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemn_to_litter_fire_patch(i) = value_patch + this%m_livestemn_storage_to_litter_fire_patch(i) = value_patch + this%m_livestemn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livestemn_to_deadstemn_fire_patch(i) = value_patch + this%m_deadstemn_to_litter_fire_patch(i) = value_patch + this%m_deadstemn_storage_to_litter_fire_patch(i) = value_patch + this%m_deadstemn_xfer_to_litter_fire_patch(i) = value_patch + this%m_frootn_to_litter_fire_patch(i) = value_patch + this%m_frootn_storage_to_litter_fire_patch(i) = value_patch + this%m_frootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_storage_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_livecrootn_to_deadcrootn_fire_patch(i) = value_patch + this%m_deadcrootn_to_litter_fire_patch(i) = value_patch + this%m_deadcrootn_storage_to_litter_fire_patch(i) = value_patch + this%m_deadcrootn_xfer_to_litter_fire_patch(i) = value_patch + this%m_retransn_to_litter_fire_patch(i) = value_patch + + this%leafn_xfer_to_leafn_patch(i) = value_patch + this%frootn_xfer_to_frootn_patch(i) = value_patch + this%livestemn_xfer_to_livestemn_patch(i) = value_patch + this%deadstemn_xfer_to_deadstemn_patch(i) = value_patch + this%livecrootn_xfer_to_livecrootn_patch(i) = value_patch + this%deadcrootn_xfer_to_deadcrootn_patch(i) = value_patch + this%leafn_to_litter_patch(i) = value_patch + this%leafn_to_retransn_patch(i) = value_patch + this%frootn_to_litter_patch(i) = value_patch + this%retransn_to_npool_patch(i) = value_patch + this%sminn_to_npool_patch(i) = value_patch + this%npool_to_leafn_patch(i) = value_patch + this%npool_to_leafn_storage_patch(i) = value_patch + this%npool_to_frootn_patch(i) = value_patch + this%npool_to_frootn_storage_patch(i) = value_patch + this%npool_to_livestemn_patch(i) = value_patch + this%npool_to_livestemn_storage_patch(i) = value_patch + this%npool_to_deadstemn_patch(i) = value_patch + this%npool_to_deadstemn_storage_patch(i) = value_patch + this%npool_to_livecrootn_patch(i) = value_patch + this%npool_to_livecrootn_storage_patch(i) = value_patch + this%npool_to_deadcrootn_patch(i) = value_patch + this%npool_to_deadcrootn_storage_patch(i) = value_patch + this%leafn_storage_to_xfer_patch(i) = value_patch + this%frootn_storage_to_xfer_patch(i) = value_patch + this%livestemn_storage_to_xfer_patch(i) = value_patch + this%deadstemn_storage_to_xfer_patch(i) = value_patch + this%livecrootn_storage_to_xfer_patch(i) = value_patch + this%deadcrootn_storage_to_xfer_patch(i) = value_patch + this%livestemn_to_deadstemn_patch(i) = value_patch + this%livestemn_to_retransn_patch(i) = value_patch + this%livecrootn_to_deadcrootn_patch(i) = value_patch + this%livecrootn_to_retransn_patch(i) = value_patch + this%ndeploy_patch(i) = value_patch + this%wood_harvestn_patch(i) = value_patch + this%fire_nloss_patch(i) = value_patch + end do + + if ( crop_prog )then + do fi = 1,num_patch + i = filter_patch(fi) + this%livestemn_to_litter_patch(i) = value_patch + this%grainn_to_food_patch(i) = value_patch + this%grainn_xfer_to_grainn_patch(i) = value_patch + this%npool_to_grainn_patch(i) = value_patch + this%npool_to_grainn_storage_patch(i) = value_patch + this%grainn_storage_to_xfer_patch(i) = value_patch + this%soyfixn_patch(i) = value_patch + this%frootn_to_retransn_patch(i) = value_patch + end do + end if + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + ! phenology: litterfall and crop fluxes associated wit + this%phenology_n_to_litr_met_n_col(i,j) = value_column + this%phenology_n_to_litr_cel_n_col(i,j) = value_column + this%phenology_n_to_litr_lig_n_col(i,j) = value_column + + ! gap mortality + this%gap_mortality_n_to_litr_met_n_col(i,j) = value_column + this%gap_mortality_n_to_litr_cel_n_col(i,j) = value_column + this%gap_mortality_n_to_litr_lig_n_col(i,j) = value_column + this%gap_mortality_n_to_cwdn_col(i,j) = value_column + + ! fire + this%fire_mortality_n_to_cwdn_col(i,j) = value_column + this%m_n_to_litr_met_fire_col(i,j) = value_column + this%m_n_to_litr_cel_fire_col(i,j) = value_column + this%m_n_to_litr_lig_fire_col(i,j) = value_column + + ! harvest + this%harvest_n_to_litr_met_n_col(i,j) = value_column + this%harvest_n_to_litr_cel_n_col(i,j) = value_column + this%harvest_n_to_litr_lig_n_col(i,j) = value_column + this%harvest_n_to_cwdn_col(i,j) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%hrv_deadstemn_to_prod10n_col(i) = value_column + this%hrv_deadstemn_to_prod100n_col(i) = value_column + this%prod10n_loss_col(i) = value_column + this%prod100n_loss_col(i) = value_column + this%product_nloss_col(i) = value_column + this%fire_nloss_col(i) = value_column + + ! Zero p2c column fluxes + this%fire_nloss_col(i) = value_column + this%wood_harvestn_col(i) = value_column + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_npools_to_fire_col(i,k) = value_column + end do + end do + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%m_decomp_npools_to_fire_vr_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize flux variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, j ! indices + !----------------------------------------------------------------------- + + do c = bounds%begc,bounds%endc + this%dwt_seedn_to_leaf_col(c) = 0._r8 + this%dwt_seedn_to_deadstem_col(c) = 0._r8 + this%dwt_conv_nflux_col(c) = 0._r8 + this%dwt_prod10n_gain_col(c) = 0._r8 + this%dwt_prod100n_gain_col(c) = 0._r8 + end do + + do j = 1, nlevdecomp_full + do c = bounds%begc,bounds%endc + this%dwt_frootn_to_litr_met_n_col(c,j) = 0._r8 + this%dwt_frootn_to_litr_cel_n_col(c,j) = 0._r8 + this%dwt_frootn_to_litr_lig_n_col(c,j) = 0._r8 + this%dwt_livecrootn_to_cwdn_col(c,j) = 0._r8 + this%dwt_deadcrootn_to_cwdn_col(c,j) = 0._r8 + end do + end do + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- + subroutine Summary_nitrogenflux(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + ! + ! !USES: + use clm_varpar , only: nlevdecomp,ndecomp_cascade_transitions,ndecomp_pools + use clm_varctl , only: use_nitrif_denitrif + use subgridAveMod , only: p2c + ! + ! !ARGUMENTS: + class (cnveg_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! total N deployment (from sminn and retranslocated N pool) (NDEPLOY) + this%ndeploy_patch(p) = & + this%sminn_to_npool_patch(p) + & + this%retransn_to_npool_patch(p) + + ! patch-level wood harvest + this%wood_harvestn_patch(p) = & + this%hrv_deadstemn_to_prod10n_patch(p) + & + this%hrv_deadstemn_to_prod100n_patch(p) + + ! total patch-level fire N losses + this%fire_nloss_patch(p) = & + this%m_leafn_to_fire_patch(p) + & + this%m_leafn_storage_to_fire_patch(p) + & + this%m_leafn_xfer_to_fire_patch(p) + & + this%m_frootn_to_fire_patch(p) + & + this%m_frootn_storage_to_fire_patch(p) + & + this%m_frootn_xfer_to_fire_patch(p) + & + this%m_livestemn_to_fire_patch(p) + & + this%m_livestemn_storage_to_fire_patch(p) + & + this%m_livestemn_xfer_to_fire_patch(p) + & + this%m_deadstemn_to_fire_patch(p) + & + this%m_deadstemn_storage_to_fire_patch(p) + & + this%m_deadstemn_xfer_to_fire_patch(p) + & + this%m_livecrootn_to_fire_patch(p) + & + this%m_livecrootn_storage_to_fire_patch(p) + & + this%m_livecrootn_xfer_to_fire_patch(p) + & + this%m_deadcrootn_to_fire_patch(p) + & + this%m_deadcrootn_storage_to_fire_patch(p) + & + this%m_deadcrootn_xfer_to_fire_patch(p) + & + this%m_retransn_to_fire_patch(p) + + end do + + call p2c(bounds, num_soilc, filter_soilc, & + this%fire_nloss_patch(bounds%begp:bounds%endp), & + this%fire_nloss_p2c_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%wood_harvestn_patch(bounds%begp:bounds%endp), & + this%wood_harvestn_col(bounds%begc:bounds%endc)) + + ! vertically integrate column-level fire N losses + do k = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%m_decomp_npools_to_fire_col(c,k) = & + this%m_decomp_npools_to_fire_col(c,k) + & + this%m_decomp_npools_to_fire_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + ! total column-level fire N losses + do fc = 1,num_soilc + c = filter_soilc(fc) + this%fire_nloss_col(c) = this%fire_nloss_p2c_col(c) + end do + do k = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%fire_nloss_col(c) = & + this%fire_nloss_col(c) + & + this%m_decomp_npools_to_fire_col(c,k) + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column-level N losses due to landcover change + this%dwt_nloss_col(c) = & + this%dwt_conv_nflux_col(c) + + ! total wood product N loss + this%product_nloss_col(c) = & + this%prod10n_loss_col(c) + & + this%prod100n_loss_col(c) + end do + + end subroutine Summary_nitrogenflux + +end module CNVegNitrogenFluxType + diff --git a/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 b/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 new file mode 100644 index 0000000000..2af3be5f4c --- /dev/null +++ b/components/clm/src/biogeochem/CNVegNitrogenStateType.F90 @@ -0,0 +1,875 @@ +module CNVegNitrogenStateType + +#include "shr_assert.h" + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevdecomp, crop_prog + use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi + use landunit_varcon , only : istcrop, istsoil + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp + use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump + use decompMod , only : bounds_type + use pftconMod , only : npcropmin, noveg, pftcon + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use abortutils , only : endrun + use spmdMod , only : masterproc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: cnveg_nitrogenstate_type + + real(r8), pointer :: grainn_patch (:) ! (gN/m2) grain N (crop) + real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop) + real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop) + real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_patch (:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage_patch (:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer_patch (:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_patch (:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage_patch (:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer_patch (:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_patch (:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage_patch (:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer_patch (:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_patch (:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage_patch (:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer_patch (:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_patch (:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage_patch (:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer_patch (:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: retransn_patch (:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool_patch (:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: ntrunc_patch (:) ! (gN/m2) patch-level sink for N truncation + + ! wood product pools, for dynamic landcover + real(r8), pointer :: seedn_col (:) ! (gN/m2) column-level pool for seeding new Patches + real(r8), pointer :: prod10n_col (:) ! (gN/m2) wood product N pool, 10-year lifespan + real(r8), pointer :: prod100n_col (:) ! (gN/m2) wood product N pool, 100-year lifespan + real(r8), pointer :: totprodn_col (:) ! (gN/m2) total wood product N + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegn_patch (:) ! (gN/m2) displayed veg nitrogen, excluding storage + real(r8), pointer :: storvegn_patch (:) ! (gN/m2) stored vegetation nitrogen + real(r8), pointer :: totvegn_patch (:) ! (gN/m2) total vegetation nitrogen + real(r8), pointer :: totvegn_col (:) ! (gN/m2) total vegetation nitrogen (p2c) + real(r8), pointer :: totn_patch (:) ! (gN/m2) total patch-level nitrogen + real(r8), pointer :: totn_col (:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: totecosysn_col (:) ! (gN/m2) total ecosystem nitrogen, incl veg + + contains + + procedure , public :: Init + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: ZeroDWT + procedure , public :: Summary => Summary_nitrogenstate + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type cnveg_nitrogenstate_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, & + leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) + + class(cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: leafc_patch (bounds%begp:) + real(r8) , intent(in) :: leafc_storage_patch (bounds%begp:) + real(r8) , intent(in) :: frootc_patch (bounds%begp:) + real(r8) , intent(in) :: frootc_storage_patch (bounds%begp:) + real(r8) , intent(in) :: deadstemc_patch (bounds%begp:) + + call this%InitAllocate (bounds ) + call this%InitHistory (bounds) + call this%InitCold ( bounds, & + leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%grainn_patch (begp:endp)) ; this%grainn_patch (:) = nan + allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan + allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan + allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan + allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan + allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan + allocate(this%frootn_patch (begp:endp)) ; this%frootn_patch (:) = nan + allocate(this%frootn_storage_patch (begp:endp)) ; this%frootn_storage_patch (:) = nan + allocate(this%frootn_xfer_patch (begp:endp)) ; this%frootn_xfer_patch (:) = nan + allocate(this%livestemn_patch (begp:endp)) ; this%livestemn_patch (:) = nan + allocate(this%livestemn_storage_patch (begp:endp)) ; this%livestemn_storage_patch (:) = nan + allocate(this%livestemn_xfer_patch (begp:endp)) ; this%livestemn_xfer_patch (:) = nan + allocate(this%deadstemn_patch (begp:endp)) ; this%deadstemn_patch (:) = nan + allocate(this%deadstemn_storage_patch (begp:endp)) ; this%deadstemn_storage_patch (:) = nan + allocate(this%deadstemn_xfer_patch (begp:endp)) ; this%deadstemn_xfer_patch (:) = nan + allocate(this%livecrootn_patch (begp:endp)) ; this%livecrootn_patch (:) = nan + allocate(this%livecrootn_storage_patch (begp:endp)) ; this%livecrootn_storage_patch (:) = nan + allocate(this%livecrootn_xfer_patch (begp:endp)) ; this%livecrootn_xfer_patch (:) = nan + allocate(this%deadcrootn_patch (begp:endp)) ; this%deadcrootn_patch (:) = nan + allocate(this%deadcrootn_storage_patch (begp:endp)) ; this%deadcrootn_storage_patch (:) = nan + allocate(this%deadcrootn_xfer_patch (begp:endp)) ; this%deadcrootn_xfer_patch (:) = nan + allocate(this%retransn_patch (begp:endp)) ; this%retransn_patch (:) = nan + allocate(this%npool_patch (begp:endp)) ; this%npool_patch (:) = nan + allocate(this%ntrunc_patch (begp:endp)) ; this%ntrunc_patch (:) = nan + allocate(this%dispvegn_patch (begp:endp)) ; this%dispvegn_patch (:) = nan + allocate(this%storvegn_patch (begp:endp)) ; this%storvegn_patch (:) = nan + allocate(this%totvegn_patch (begp:endp)) ; this%totvegn_patch (:) = nan + allocate(this%totn_patch (begp:endp)) ; this%totn_patch (:) = nan + + allocate(this%seedn_col (begc:endc)) ; this%seedn_col (:) = nan + allocate(this%prod10n_col (begc:endc)) ; this%prod10n_col (:) = nan + allocate(this%prod100n_col (begc:endc)) ; this%prod100n_col (:) = nan + allocate(this%totprodn_col (begc:endc)) ; this%totprodn_col (:) = nan + allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan + allocate(this%totn_col (begc:endc)) ; this%totn_col (:) = nan + allocate(this%totecosysn_col (begc:endc)) ; this%totecosysn_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj + integer :: begp,endp + integer :: begc,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + !------------------------------- + ! patch state variables + !------------------------------- + + if (crop_prog) then + this%grainn_patch(begp:endp) = spval + call hist_addfld1d (fname='GRAINN', units='gN/m^2', & + avgflag='A', long_name='grain N', & + ptr_patch=this%grainn_patch) + end if + + this%leafn_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN', units='gN/m^2', & + avgflag='A', long_name='leaf N', & + ptr_patch=this%leafn_patch) + + this%leafn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='leaf N storage', & + ptr_patch=this%leafn_storage_patch) + + this%leafn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LEAFN_XFER', units='gN/m^2', & + avgflag='A', long_name='leaf N transfer', & + ptr_patch=this%leafn_xfer_patch) + + this%frootn_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN', units='gN/m^2', & + avgflag='A', long_name='fine root N', & + ptr_patch=this%frootn_patch) + + this%frootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='fine root N storage', & + ptr_patch=this%frootn_storage_patch) + + this%frootn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='FROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='fine root N transfer', & + ptr_patch=this%frootn_xfer_patch) + + this%livestemn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN', units='gN/m^2', & + avgflag='A', long_name='live stem N', & + ptr_patch=this%livestemn_patch) + + this%livestemn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='live stem N storage', & + ptr_patch=this%livestemn_storage_patch) + + this%livestemn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVESTEMN_XFER', units='gN/m^2', & + avgflag='A', long_name='live stem N transfer', & + ptr_patch=this%livestemn_xfer_patch) + + this%deadstemn_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMN', units='gN/m^2', & + avgflag='A', long_name='dead stem N', & + ptr_patch=this%deadstemn_patch) + + this%deadstemn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='dead stem N storage', & + ptr_patch=this%deadstemn_storage_patch) + + this%deadstemn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADSTEMN_XFER', units='gN/m^2', & + avgflag='A', long_name='dead stem N transfer', & + ptr_patch=this%deadstemn_xfer_patch) + + this%livecrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN', units='gN/m^2', & + avgflag='A', long_name='live coarse root N', & + ptr_patch=this%livecrootn_patch) + + this%livecrootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='live coarse root N storage', & + ptr_patch=this%livecrootn_storage_patch) + + this%livecrootn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='LIVECROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='live coarse root N transfer', & + ptr_patch=this%livecrootn_xfer_patch) + + this%deadcrootn_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTN', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N', & + ptr_patch=this%deadcrootn_patch) + + this%deadcrootn_storage_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N storage', & + ptr_patch=this%deadcrootn_storage_patch) + + this%deadcrootn_xfer_patch(begp:endp) = spval + call hist_addfld1d (fname='DEADCROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N transfer', & + ptr_patch=this%deadcrootn_xfer_patch) + + this%retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='RETRANSN', units='gN/m^2', & + avgflag='A', long_name='plant pool of retranslocated N', & + ptr_patch=this%retransn_patch) + + this%npool_patch(begp:endp) = spval + call hist_addfld1d (fname='NPOOL', units='gN/m^2', & + avgflag='A', long_name='temporary plant N pool', & + ptr_patch=this%npool_patch) + + this%ntrunc_patch(begp:endp) = spval + call hist_addfld1d (fname='PFT_NTRUNC', units='gN/m^2', & + avgflag='A', long_name='patch-level sink for N truncation', & + ptr_patch=this%ntrunc_patch) + + this%dispvegn_patch(begp:endp) = spval + call hist_addfld1d (fname='DISPVEGN', units='gN/m^2', & + avgflag='A', long_name='displayed vegetation nitrogen', & + ptr_patch=this%dispvegn_patch) + + this%storvegn_patch(begp:endp) = spval + call hist_addfld1d (fname='STORVEGN', units='gN/m^2', & + avgflag='A', long_name='stored vegetation nitrogen', & + ptr_patch=this%storvegn_patch) + + this%totvegn_patch(begp:endp) = spval + call hist_addfld1d (fname='TOTVEGN', units='gN/m^2', & + avgflag='A', long_name='total vegetation nitrogen', & + ptr_patch=this%totvegn_patch) + + this%totn_patch(begp:endp) = spval + call hist_addfld1d (fname='TOTPFTN', units='gN/m^2', & + avgflag='A', long_name='total patch-level nitrogen', & + ptr_patch=this%totn_patch) + + !------------------------------- + ! column state variables + !------------------------------- + + this%seedn_col(begc:endc) = spval + call hist_addfld1d (fname='SEEDN', units='gN/m^2', & + avgflag='A', long_name='pool for seeding new patches', & + ptr_col=this%seedn_col) + + this%prod10n_col(begc:endc) = spval + call hist_addfld1d (fname='PROD10N', units='gN/m^2', & + avgflag='A', long_name='10-yr wood product N', & + ptr_col=this%prod10n_col) + + this%prod100n_col(begc:endc) = spval + call hist_addfld1d (fname='PROD100N', units='gN/m^2', & + avgflag='A', long_name='100-yr wood product N', & + ptr_col=this%prod100n_col) + + this%totprodn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTPRODN', units='gN/m^2', & + avgflag='A', long_name='total wood product N', & + ptr_col=this%totprodn_col) + + this%totecosysn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTECOSYSN', units='gN/m^2', & + avgflag='A', long_name='total ecosystem N', & + ptr_col=this%totecosysn_col) + + this%totn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTCOLN', units='gN/m^2', & + avgflag='A', long_name='total column-level N', & + ptr_col=this%totn_col) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, & + leafc_patch, leafc_storage_patch, frootc_patch, frootc_storage_patch, deadstemc_patch) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + use clm_varctl , only : MM_Nuptake_opt + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: leafc_patch(bounds%begp:) + real(r8) , intent(in) :: leafc_storage_patch(bounds%begp:) + real(r8) , intent(in) :: frootc_patch(bounds%begp:) + real(r8) , intent(in) :: frootc_storage_patch(bounds%begp:) + real(r8) , intent(in) :: deadstemc_patch(bounds%begp:) + ! + ! !LOCAL VARIABLES: + integer :: fc,fp,g,l,c,p,j,k ! indices + integer :: num_special_col ! number of good values in special_col filter + integer :: num_special_patch ! number of good values in special_patch filter + integer :: special_col (bounds%endc-bounds%begc+1) ! special landunit filter - columns + integer :: special_patch (bounds%endp-bounds%begp+1) ! special landunit filter - patches + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL((ubound(leafc_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(leafc_storage_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frootc_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frootc_storage_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(deadstemc_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + ! Set column filters + + num_special_patch = 0 + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + if (lun%ifspecial(l)) then + num_special_patch = num_special_patch + 1 + special_patch(num_special_patch) = p + end if + end do + + ! Set patch filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + !------------------------------------------- + ! initialize patch-level variables + !------------------------------------------- + + do p = bounds%begp,bounds%endp + + l = patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + if (patch%itype(p) == noveg) then + this%leafn_patch(p) = 0._r8 + this%leafn_storage_patch(p) = 0._r8 + if (MM_Nuptake_opt .eqv. .true.) then + this%frootn_patch(p) = 0._r8 + this%frootn_storage_patch(p) = 0._r8 + end if + else + this%leafn_patch(p) = leafc_patch(p) / pftcon%leafcn(patch%itype(p)) + this%leafn_storage_patch(p) = leafc_storage_patch(p) / pftcon%leafcn(patch%itype(p)) + if (MM_Nuptake_opt .eqv. .true.) then + this%frootn_patch(p) = frootc_patch(p) / pftcon%frootcn(patch%itype(p)) + this%frootn_storage_patch(p) = frootc_storage_patch(p) / pftcon%frootcn(patch%itype(p)) + end if + end if + + this%leafn_xfer_patch(p) = 0._r8 + if ( crop_prog )then + this%grainn_patch(p) = 0._r8 + this%grainn_storage_patch(p) = 0._r8 + this%grainn_xfer_patch(p) = 0._r8 + end if + if (MM_Nuptake_opt .eqv. .false.) then ! if not running in floating CN ratio option + this%frootn_patch(p) = 0._r8 + this%frootn_storage_patch(p) = 0._r8 + end if + this%frootn_xfer_patch(p) = 0._r8 + this%livestemn_patch(p) = 0._r8 + this%livestemn_storage_patch(p) = 0._r8 + this%livestemn_xfer_patch(p) = 0._r8 + + ! tree types need to be initialized with some stem mass so that + ! roughness length is not zero in canopy flux calculation + + if (pftcon%woody(patch%itype(p)) == 1._r8) then + this%deadstemn_patch(p) = deadstemc_patch(p) / pftcon%deadwdcn(patch%itype(p)) + else + this%deadstemn_patch(p) = 0._r8 + end if + + this%deadstemn_storage_patch(p) = 0._r8 + this%deadstemn_xfer_patch(p) = 0._r8 + this%livecrootn_patch(p) = 0._r8 + this%livecrootn_storage_patch(p) = 0._r8 + this%livecrootn_xfer_patch(p) = 0._r8 + this%deadcrootn_patch(p) = 0._r8 + this%deadcrootn_storage_patch(p) = 0._r8 + this%deadcrootn_xfer_patch(p) = 0._r8 + this%retransn_patch(p) = 0._r8 + this%npool_patch(p) = 0._r8 + this%ntrunc_patch(p) = 0._r8 + this%dispvegn_patch(p) = 0._r8 + this%storvegn_patch(p) = 0._r8 + this%totvegn_patch(p) = 0._r8 + this%totn_patch(p) = 0._r8 + end if + end do + + !------------------------------------------- + ! initialize column-level variables + !------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + ! dynamic landcover state variables + this%seedn_col(c) = 0._r8 + this%prod10n_col(c) = 0._r8 + this%prod100n_col(c) = 0._r8 + this%totprodn_col(c) = 0._r8 + + ! total nitrogen pools + this%totecosysn_col(c) = 0._r8 + this%totn_col(c) = 0._r8 + end if + end do + + ! now loop through special filters and explicitly set the variables that + ! have to be in place for biogeophysics + + do fc = 1,num_special_col + c = special_col(fc) + this%seedn_col(c) = 0._r8 + this%prod10n_col(c) = 0._r8 + this%prod100n_col(c) = 0._r8 + this%totprodn_col(c) = 0._r8 + end do + + ! initialize fields for special filters + + call this%SetValues (& + num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, & + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write restart data + ! + ! !USES: + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(in) :: flag !'read' or 'write' or 'define' + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,l,c + logical :: readvar + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + character(len=128) :: varname ! temporary + !------------------------------------------------------------------------ + + !-------------------------------- + ! patch nitrogen state variables + !-------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='leafn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leafn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='leafn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%leafn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='frootn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frootn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livestemn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livestemn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadstemn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadstemn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='livecrootn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%livecrootn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootn_storage', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='deadcrootn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%deadcrootn_xfer_patch) + + call restartvar(ncid=ncid, flag=flag, varname='retransn', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%retransn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='npool', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%npool_patch) + + call restartvar(ncid=ncid, flag=flag, varname='pft_ntrunc', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ntrunc_patch) + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='grainn', xtype=ncd_double, & + dim1name='pft', long_name='grain N', units='gN/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainn_storage', xtype=ncd_double, & + dim1name='pft', long_name='grain N storage', units='gN/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_storage_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grainn_xfer', xtype=ncd_double, & + dim1name='pft', long_name='grain N transfer', units='gN/m2', & + interpinic_flag='interp', readvar=readvar, data=this%grainn_xfer_patch) + end if + + !-------------------------------- + ! column nitrogen state variables + !-------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='seedn', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%seedn_col) + + call restartvar(ncid=ncid, flag=flag, varname='prod10n', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod10n_col) + + call restartvar(ncid=ncid, flag=flag, varname='prod100n', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%prod100n_col) + + call restartvar(ncid=ncid, flag=flag, varname='totcoln', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totn_col) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen state variables + ! + ! !ARGUMENTS: + class (cnveg_nitrogenstate_type) :: this + integer , intent(in) :: num_patch + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k ! indices + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i = filter_patch(fi) + + this%leafn_patch(i) = value_patch + this%leafn_storage_patch(i) = value_patch + this%leafn_xfer_patch(i) = value_patch + this%frootn_patch(i) = value_patch + this%frootn_storage_patch(i) = value_patch + this%frootn_xfer_patch(i) = value_patch + this%livestemn_patch(i) = value_patch + this%livestemn_storage_patch(i) = value_patch + this%livestemn_xfer_patch(i) = value_patch + this%deadstemn_patch(i) = value_patch + this%deadstemn_storage_patch(i) = value_patch + this%deadstemn_xfer_patch(i) = value_patch + this%livecrootn_patch(i) = value_patch + this%livecrootn_storage_patch(i) = value_patch + this%livecrootn_xfer_patch(i) = value_patch + this%deadcrootn_patch(i) = value_patch + this%deadcrootn_storage_patch(i) = value_patch + this%deadcrootn_xfer_patch(i) = value_patch + this%retransn_patch(i) = value_patch + this%npool_patch(i) = value_patch + this%ntrunc_patch(i) = value_patch + this%dispvegn_patch(i) = value_patch + this%storvegn_patch(i) = value_patch + this%totvegn_patch(i) = value_patch + this%totn_patch(i) = value_patch + end do + + if ( crop_prog )then + do fi = 1,num_patch + i = filter_patch(fi) + this%grainn_patch(i) = value_patch + this%grainn_storage_patch(i) = value_patch + this%grainn_xfer_patch(i) = value_patch + end do + end if + + do fi = 1,num_column + i = filter_column(fi) + + this%totecosysn_col(i) = value_column + this%totn_col(i) = value_column + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + this%dispvegn_patch(p) = 0._r8 + this%storvegn_patch(p) = 0._r8 + this%totvegn_patch(p) = 0._r8 + this%totn_patch(p) = 0._r8 + end do + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- + subroutine Summary_nitrogenstate(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soilp,& + soilbiogeochem_nitrogenstate_inst) + ! + ! !USES: + use subgridAveMod, only : p2c + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(cnveg_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,k,l ! indices + integer :: fp,fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! -------------------------------------------- + ! patch level summary + ! -------------------------------------------- + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! displayed vegetation nitrogen, excluding storage (DISPVEGN) + this%dispvegn_patch(p) = & + this%leafn_patch(p) + & + this%frootn_patch(p) + & + this%livestemn_patch(p) + & + this%deadstemn_patch(p) + & + this%livecrootn_patch(p) + & + this%deadcrootn_patch(p) + + ! stored vegetation nitrogen, including retranslocated N pool (STORVEGN) + this%storvegn_patch(p) = & + this%leafn_storage_patch(p) + & + this%frootn_storage_patch(p) + & + this%livestemn_storage_patch(p) + & + this%deadstemn_storage_patch(p) + & + this%livecrootn_storage_patch(p) + & + this%deadcrootn_storage_patch(p) + & + this%leafn_xfer_patch(p) + & + this%frootn_xfer_patch(p) + & + this%livestemn_xfer_patch(p) + & + this%deadstemn_xfer_patch(p) + & + this%livecrootn_xfer_patch(p) + & + this%deadcrootn_xfer_patch(p) + & + this%npool_patch(p) + & + this%retransn_patch(p) + + if ( crop_prog .and. patch%itype(p) >= npcropmin )then + this%dispvegn_patch(p) = & + this%dispvegn_patch(p) + & + this%grainn_patch(p) + + this%storvegn_patch(p) = & + this%storvegn_patch(p) + & + this%grainn_storage_patch(p) + & + this%grainn_xfer_patch(p) + end if + + ! total vegetation nitrogen (TOTVEGN) + this%totvegn_patch(p) = & + this%dispvegn_patch(p) + & + this%storvegn_patch(p) + + ! total patch-level carbon (add ntrunc) + this%totn_patch(p) = & + this%totvegn_patch(p) + & + this%ntrunc_patch(p) + + end do + + ! -------------------------------------------- + ! column level summary + ! -------------------------------------------- + + call p2c(bounds, num_soilc, filter_soilc, & + this%totvegn_patch(bounds%begp:bounds%endp), & + this%totvegn_col(bounds%begc:bounds%endc)) + + call p2c(bounds, num_soilc, filter_soilc, & + this%totn_patch(bounds%begp:bounds%endp), & + this%totn_col(bounds%begc:bounds%endc)) + + ! total wood product nitrogen + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totprodn_col(c) = & + this%prod10n_col(c) + & + this%prod100n_col(c) + + ! total ecosystem nitrogen, including veg (TOTECOSYSN) + this%totecosysn_col(c) = & + soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & + soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & + this%totprodn_col(c) + & + this%totvegn_col(c) + + ! total column nitrogen, including patch (TOTCOLN) + + this%totn_col(c) = this%totn_col(c) + & + soilbiogeochem_nitrogenstate_inst%cwdn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & + soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & + soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & + this%totprodn_col(c) + & + this%seedn_col(c) + & + soilbiogeochem_nitrogenstate_inst%ntrunc_col(c) + end do + + end subroutine Summary_nitrogenstate + +end module CNVegNitrogenStateType diff --git a/components/clm/src/biogeochem/CNVegStateType.F90 b/components/clm/src/biogeochem/CNVegStateType.F90 new file mode 100644 index 0000000000..6f43c317ae --- /dev/null +++ b/components/clm/src/biogeochem/CNVegStateType.F90 @@ -0,0 +1,1016 @@ +module CNVegStateType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoifl, nlevsoi, crop_prog + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, nlevdecomp_full, more_vertlayers + use clm_varctl , only : use_vertsoilc, use_c14, use_cn, iulog, fsurdat + use clm_varcon , only : spval, ispval, c14ratio, grlnd + use landunit_varcon, only : istsoil, istcrop + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: checkDates + ! + ! !PUBLIC TYPES: + type, public :: cnveg_state_type + + integer , pointer :: burndate_patch (:) ! patch crop burn date + real(r8) , pointer :: lfpftd_patch (:) ! patch decrease of patch weight (0-1) on the column for the timestep + + ! Prognostic crop model - Note that cropplant and harvdate could be 2D to facilitate rotation + real(r8) , pointer :: hdidx_patch (:) ! patch cold hardening index? + real(r8) , pointer :: cumvd_patch (:) ! patch cumulative vernalization d?ependence? + real(r8) , pointer :: vf_patch (:) ! patch vernalization factor for cereal + real(r8) , pointer :: gddmaturity_patch (:) ! patch growing degree days (gdd) needed to harvest (ddays) + real(r8) , pointer :: huileaf_patch (:) ! patch heat unit index needed from planting to leaf emergence + real(r8) , pointer :: huigrain_patch (:) ! patch heat unit index needed to reach vegetative maturity + real(r8) , pointer :: aleafi_patch (:) ! patch saved leaf allocation coefficient from phase 2 + real(r8) , pointer :: astemi_patch (:) ! patch saved stem allocation coefficient from phase 2 + real(r8) , pointer :: aleaf_patch (:) ! patch leaf allocation coefficient + real(r8) , pointer :: astem_patch (:) ! patch stem allocation coefficient + logical , pointer :: croplive_patch (:) ! patch Flag, true if planted, not harvested + logical , pointer :: cropplant_patch (:) ! patch Flag, true if planted + integer , pointer :: harvdate_patch (:) ! patch harvest date + real(r8) , pointer :: htmx_patch (:) ! patch max hgt attained by a crop during yr (m) + integer , pointer :: peaklai_patch (:) ! patch 1: max allowed lai; 0: not at max + + integer , pointer :: idop_patch (:) ! patch date of planting + + real(r8) , pointer :: gdp_lf_col (:) ! col global real gdp data (k US$/capita) + real(r8) , pointer :: peatf_lf_col (:) ! col global peatland fraction data (0-1) + integer , pointer :: abm_lf_col (:) ! col global peak month of crop fire emissions + + real(r8) , pointer :: lgdp_col (:) ! col gdp limitation factor for fire occurrence (0-1) + real(r8) , pointer :: lgdp1_col (:) ! col gdp limitation factor for fire spreading (0-1) + real(r8) , pointer :: lpop_col (:) ! col pop limitation factor for fire spreading (0-1) + + real(r8) , pointer :: tempavg_t2m_patch (:) ! patch temporary average 2m air temperature (K) + real(r8) , pointer :: annavg_t2m_patch (:) ! patch annual average 2m air temperature (K) + real(r8) , pointer :: annavg_t2m_col (:) ! col annual average of 2m air temperature, averaged from patch-level (K) + real(r8) , pointer :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover + + ! Fire + real(r8) , pointer :: nfire_col (:) ! col fire counts (count/km2/sec), valid only in Reg. C + real(r8) , pointer :: fsr_col (:) ! col fire spread rate at column level (m/s) + real(r8) , pointer :: fd_col (:) ! col fire duration at column level (hr) + real(r8) , pointer :: lfc_col (:) ! col conversion area fraction of BET and BDT that haven't burned before (/timestep) + real(r8) , pointer :: lfc2_col (:) ! col conversion area fraction of BET and BDT that burned (/sec) + real(r8) , pointer :: dtrotr_col (:) ! col annual decreased fraction coverage of BET on the gridcell (0-1) + real(r8) , pointer :: trotr1_col (:) ! col patch weight of BET and BDT on the gridcell(0-1) + real(r8) , pointer :: trotr2_col (:) ! col patch weight of BDT on the gridcell (0-1) + real(r8) , pointer :: cropf_col (:) ! col crop fraction in veg column (0-1) + real(r8) , pointer :: baf_crop_col (:) ! col baf for cropland(/sec) + real(r8) , pointer :: baf_peatf_col (:) ! col baf for peatland (/sec) + real(r8) , pointer :: fbac_col (:) ! col total burned area out of conversion (/sec) + real(r8) , pointer :: fbac1_col (:) ! col burned area out of conversion region due to land use fire (/sec) + real(r8) , pointer :: wtlf_col (:) ! col fractional coverage of non-crop Patches (0-1) + real(r8) , pointer :: lfwt_col (:) ! col fractional coverage of non-crop and non-bare-soil Patches (0-1) + real(r8) , pointer :: farea_burned_col (:) ! col fractional area burned (/sec) + + real(r8), pointer :: dormant_flag_patch (:) ! patch dormancy flag + real(r8), pointer :: days_active_patch (:) ! patch number of days since last dormancy + real(r8), pointer :: onset_flag_patch (:) ! patch onset flag + real(r8), pointer :: onset_counter_patch (:) ! patch onset days counter + real(r8), pointer :: onset_gddflag_patch (:) ! patch onset flag for growing degree day sum + real(r8), pointer :: onset_fdd_patch (:) ! patch onset freezing degree days counter + real(r8), pointer :: onset_gdd_patch (:) ! patch onset growing degree days + real(r8), pointer :: onset_swi_patch (:) ! patch onset soil water index + real(r8), pointer :: offset_flag_patch (:) ! patch offset flag + real(r8), pointer :: offset_counter_patch (:) ! patch offset days counter + real(r8), pointer :: offset_fdd_patch (:) ! patch offset freezing degree days counter + real(r8), pointer :: offset_swi_patch (:) ! patch offset soil water index + real(r8), pointer :: grain_flag_patch (:) ! patch 1: grain fill stage; 0: not + real(r8), pointer :: lgsf_patch (:) ! patch long growing season factor [0-1] + real(r8), pointer :: bglfr_patch (:) ! patch background litterfall rate (1/s) + real(r8), pointer :: bgtr_patch (:) ! patch background transfer growth rate (1/s) + real(r8), pointer :: c_allometry_patch (:) ! patch C allocation index (DIM) + real(r8), pointer :: n_allometry_patch (:) ! patch N allocation index (DIM) + + real(r8), pointer :: tempsum_potential_gpp_patch (:) ! patch temporary annual sum of potential GPP + real(r8), pointer :: annsum_potential_gpp_patch (:) ! patch annual sum of potential GPP + real(r8), pointer :: tempmax_retransn_patch (:) ! patch temporary annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: annmax_retransn_patch (:) ! patch annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: downreg_patch (:) ! patch fractional reduction in GPP due to N limitation (DIM) + + integer :: CropRestYear ! restart year from initial conditions file - increment as time elapses + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, public :: CropRestIncYear + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type cnveg_state_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(cnveg_state_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate ( bounds ) + if (use_cn) then + call this%InitHistory ( bounds ) + end if + call this%InitCold ( bounds ) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(cnveg_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%burndate_patch (begp:endp)) ; this%burndate_patch (:) = ispval + allocate(this%lfpftd_patch (begp:endp)) ; + + allocate(this%hdidx_patch (begp:endp)) ; this%hdidx_patch (:) = nan + allocate(this%cumvd_patch (begp:endp)) ; this%cumvd_patch (:) = nan + allocate(this%vf_patch (begp:endp)) ; this%vf_patch (:) = 0.0_r8 + allocate(this%gddmaturity_patch (begp:endp)) ; this%gddmaturity_patch (:) = spval + allocate(this%huileaf_patch (begp:endp)) ; this%huileaf_patch (:) = nan + allocate(this%huigrain_patch (begp:endp)) ; this%huigrain_patch (:) = nan + allocate(this%aleafi_patch (begp:endp)) ; this%aleafi_patch (:) = nan + allocate(this%astemi_patch (begp:endp)) ; this%astemi_patch (:) = nan + allocate(this%aleaf_patch (begp:endp)) ; this%aleaf_patch (:) = nan + allocate(this%astem_patch (begp:endp)) ; this%astem_patch (:) = nan + allocate(this%croplive_patch (begp:endp)) ; this%croplive_patch (:) = .false. + allocate(this%cropplant_patch (begp:endp)) ; this%cropplant_patch (:) = .false. + allocate(this%harvdate_patch (begp:endp)) ; this%harvdate_patch (:) = huge(1) + allocate(this%htmx_patch (begp:endp)) ; this%htmx_patch (:) = 0.0_r8 + allocate(this%peaklai_patch (begp:endp)) ; this%peaklai_patch (:) = 0 + + allocate(this%idop_patch (begp:endp)) ; this%idop_patch (:) = huge(1) + + allocate(this%gdp_lf_col (begc:endc)) ; + allocate(this%peatf_lf_col (begc:endc)) ; + allocate(this%abm_lf_col (begc:endc)) ; + + allocate(this%lgdp_col (begc:endc)) ; + allocate(this%lgdp1_col (begc:endc)) ; + allocate(this%lpop_col (begc:endc)) ; + + allocate(this%tempavg_t2m_patch (begp:endp)) ; this%tempavg_t2m_patch (:) = nan + allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan + allocate(this%annavg_t2m_col (begc:endc)) ; this%annavg_t2m_col (:) = nan + allocate(this%annavg_t2m_patch (begp:endp)) ; this%annavg_t2m_patch (:) = nan + + allocate(this%nfire_col (begc:endc)) ; this%nfire_col (:) = spval + allocate(this%fsr_col (begc:endc)) ; this%fsr_col (:) = nan + allocate(this%fd_col (begc:endc)) ; this%fd_col (:) = nan + allocate(this%lfc_col (begc:endc)) ; this%lfc_col (:) = spval + allocate(this%lfc2_col (begc:endc)) ; this%lfc2_col (:) = 0._r8 + allocate(this%dtrotr_col (begc:endc)) ; this%dtrotr_col (:) = 0._r8 + allocate(this%trotr1_col (begc:endc)) ; this%trotr1_col (:) = 0._r8 + allocate(this%trotr2_col (begc:endc)) ; this%trotr2_col (:) = 0._r8 + allocate(this%cropf_col (begc:endc)) ; this%cropf_col (:) = nan + allocate(this%baf_crop_col (begc:endc)) ; this%baf_crop_col (:) = nan + allocate(this%baf_peatf_col (begc:endc)) ; this%baf_peatf_col (:) = nan + allocate(this%fbac_col (begc:endc)) ; this%fbac_col (:) = nan + allocate(this%fbac1_col (begc:endc)) ; this%fbac1_col (:) = nan + allocate(this%wtlf_col (begc:endc)) ; this%wtlf_col (:) = nan + allocate(this%lfwt_col (begc:endc)) ; this%lfwt_col (:) = nan + allocate(this%farea_burned_col (begc:endc)) ; this%farea_burned_col (:) = nan + + this%CropRestYear = 0 + + allocate(this%dormant_flag_patch (begp:endp)) ; this%dormant_flag_patch (:) = nan + allocate(this%days_active_patch (begp:endp)) ; this%days_active_patch (:) = nan + allocate(this%onset_flag_patch (begp:endp)) ; this%onset_flag_patch (:) = nan + allocate(this%onset_counter_patch (begp:endp)) ; this%onset_counter_patch (:) = nan + allocate(this%onset_gddflag_patch (begp:endp)) ; this%onset_gddflag_patch (:) = nan + allocate(this%onset_fdd_patch (begp:endp)) ; this%onset_fdd_patch (:) = nan + allocate(this%onset_gdd_patch (begp:endp)) ; this%onset_gdd_patch (:) = nan + allocate(this%onset_swi_patch (begp:endp)) ; this%onset_swi_patch (:) = nan + allocate(this%offset_flag_patch (begp:endp)) ; this%offset_flag_patch (:) = nan + allocate(this%offset_counter_patch (begp:endp)) ; this%offset_counter_patch (:) = nan + allocate(this%offset_fdd_patch (begp:endp)) ; this%offset_fdd_patch (:) = nan + allocate(this%offset_swi_patch (begp:endp)) ; this%offset_swi_patch (:) = nan + allocate(this%grain_flag_patch (begp:endp)) ; this%grain_flag_patch (:) = nan + allocate(this%lgsf_patch (begp:endp)) ; this%lgsf_patch (:) = nan + allocate(this%bglfr_patch (begp:endp)) ; this%bglfr_patch (:) = nan + allocate(this%bgtr_patch (begp:endp)) ; this%bgtr_patch (:) = nan + allocate(this%c_allometry_patch (begp:endp)) ; this%c_allometry_patch (:) = nan + allocate(this%n_allometry_patch (begp:endp)) ; this%n_allometry_patch (:) = nan + allocate(this%tempsum_potential_gpp_patch (begp:endp)) ; this%tempsum_potential_gpp_patch (:) = nan + allocate(this%annsum_potential_gpp_patch (begp:endp)) ; this%annsum_potential_gpp_patch (:) = nan + allocate(this%tempmax_retransn_patch (begp:endp)) ; this%tempmax_retransn_patch (:) = nan + allocate(this%annmax_retransn_patch (begp:endp)) ; this%annmax_retransn_patch (:) = nan + allocate(this%downreg_patch (begp:endp)) ; this%downreg_patch (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp, no_snow_normal + ! + ! !ARGUMENTS: + class(cnveg_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + character(8) :: vr_suffix + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + if ( crop_prog) then + this%gddmaturity_patch(begp:endp) = spval + call hist_addfld1d (fname='GDDHARV', units='ddays', & + avgflag='A', long_name='Growing degree days (gdd) needed to harvest', & + ptr_patch=this%gddmaturity_patch, default='inactive') + end if + + this%lfc2_col(begc:endc) = spval + call hist_addfld1d (fname='LFC2', units='per sec', & + avgflag='A', long_name='conversion area fraction of BET and BDT that burned', & + ptr_col=this%lfc2_col) + + this%annsum_counter_col(begc:endc) = spval + call hist_addfld1d (fname='ANNSUM_COUNTER', units='s', & + avgflag='A', long_name='seconds since last annual accumulator turnover', & + ptr_col=this%annsum_counter_col, default='inactive') + + this%annavg_t2m_col(begc:endc) = spval + call hist_addfld1d (fname='CANNAVG_T2M', units='K', & + avgflag='A', long_name='annual average of 2m air temperature', & + ptr_col=this%annavg_t2m_col, default='inactive') + + this%nfire_col(begc:endc) = spval + call hist_addfld1d (fname='NFIRE', units='counts/km2/sec', & + avgflag='A', long_name='fire counts valid only in Reg.C', & + ptr_col=this%nfire_col) + + this%farea_burned_col(begc:endc) = spval + call hist_addfld1d (fname='FAREA_BURNED', units='proportion', & + avgflag='A', long_name='timestep fractional area burned', & + ptr_col=this%farea_burned_col) + + this%baf_crop_col(begc:endc) = spval + call hist_addfld1d (fname='BAF_CROP', units='proportion/sec', & + avgflag='A', long_name='fractional area burned for crop', & + ptr_col=this%baf_crop_col) + + this%baf_peatf_col(begc:endc) = spval + call hist_addfld1d (fname='BAF_PEATF', units='proportion/sec', & + avgflag='A', long_name='fractional area burned in peatland', & + ptr_col=this%baf_peatf_col) + + this%annavg_t2m_patch(begp:endp) = spval + call hist_addfld1d (fname='ANNAVG_T2M', units='K', & + avgflag='A', long_name='annual average 2m air temperature', & + ptr_patch=this%annavg_t2m_patch, default='inactive') + + this%tempavg_t2m_patch(begp:endp) = spval + call hist_addfld1d (fname='TEMPAVG_T2M', units='K', & + avgflag='A', long_name='temporary average 2m air temperature', & + ptr_patch=this%tempavg_t2m_patch, default='inactive') + + this%dormant_flag_patch(begp:endp) = spval + call hist_addfld1d (fname='DORMANT_FLAG', units='none', & + avgflag='A', long_name='dormancy flag', & + ptr_patch=this%dormant_flag_patch, default='inactive') + + this%days_active_patch(begp:endp) = spval + call hist_addfld1d (fname='DAYS_ACTIVE', units='days', & + avgflag='A', long_name='number of days since last dormancy', & + ptr_patch=this%days_active_patch, default='inactive') + + this%onset_flag_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_FLAG', units='none', & + avgflag='A', long_name='onset flag', & + ptr_patch=this%onset_flag_patch, default='inactive') + + this%onset_counter_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_COUNTER', units='days', & + avgflag='A', long_name='onset days counter', & + ptr_patch=this%onset_counter_patch, default='inactive') + + this%onset_gddflag_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_GDDFLAG', units='none', & + avgflag='A', long_name='onset flag for growing degree day sum', & + ptr_patch=this%onset_gddflag_patch, default='inactive') + + this%onset_fdd_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_FDD', units='C degree-days', & + avgflag='A', long_name='onset freezing degree days counter', & + ptr_patch=this%onset_fdd_patch, default='inactive') + + this%onset_gdd_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_GDD', units='C degree-days', & + avgflag='A', long_name='onset growing degree days', & + ptr_patch=this%onset_gdd_patch, default='inactive') + + this%onset_swi_patch(begp:endp) = spval + call hist_addfld1d (fname='ONSET_SWI', units='none', & + avgflag='A', long_name='onset soil water index', & + ptr_patch=this%onset_swi_patch, default='inactive') + + this%offset_flag_patch(begp:endp) = spval + call hist_addfld1d (fname='OFFSET_FLAG', units='none', & + avgflag='A', long_name='offset flag', & + ptr_patch=this%offset_flag_patch, default='inactive') + + this%offset_counter_patch(begp:endp) = spval + call hist_addfld1d (fname='OFFSET_COUNTER', units='days', & + avgflag='A', long_name='offset days counter', & + ptr_patch=this%offset_counter_patch, default='inactive') + + this%offset_fdd_patch(begp:endp) = spval + call hist_addfld1d (fname='OFFSET_FDD', units='C degree-days', & + avgflag='A', long_name='offset freezing degree days counter', & + ptr_patch=this%offset_fdd_patch, default='inactive') + + this%offset_swi_patch(begp:endp) = spval + call hist_addfld1d (fname='OFFSET_SWI', units='none', & + avgflag='A', long_name='offset soil water index', & + ptr_patch=this%offset_swi_patch, default='inactive') + + this%lgsf_patch(begp:endp) = spval + call hist_addfld1d (fname='LGSF', units='proportion', & + avgflag='A', long_name='long growing season factor', & + ptr_patch=this%lgsf_patch, default='inactive') + + this%bglfr_patch(begp:endp) = spval + call hist_addfld1d (fname='BGLFR', units='1/s', & + avgflag='A', long_name='background litterfall rate', & + ptr_patch=this%bglfr_patch, default='inactive') + + this%bgtr_patch(begp:endp) = spval + call hist_addfld1d (fname='BGTR', units='1/s', & + avgflag='A', long_name='background transfer growth rate', & + ptr_patch=this%bgtr_patch, default='inactive') + + this%c_allometry_patch(begp:endp) = spval + call hist_addfld1d (fname='C_ALLOMETRY', units='none', & + avgflag='A', long_name='C allocation index', & + ptr_patch=this%c_allometry_patch, default='inactive') + + this%n_allometry_patch(begp:endp) = spval + call hist_addfld1d (fname='N_ALLOMETRY', units='none', & + avgflag='A', long_name='N allocation index', & + ptr_patch=this%n_allometry_patch, default='inactive') + + this%tempsum_potential_gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='TEMPSUM_POTENTIAL_GPP', units='gC/m^2/yr', & + avgflag='A', long_name='temporary annual sum of potential GPP', & + ptr_patch=this%tempsum_potential_gpp_patch, default='inactive') + + this%annsum_potential_gpp_patch(begp:endp) = spval + call hist_addfld1d (fname='ANNSUM_POTENTIAL_GPP', units='gN/m^2/yr', & + avgflag='A', long_name='annual sum of potential GPP', & + ptr_patch=this%annsum_potential_gpp_patch, default='inactive') + + this%tempmax_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='TEMPMAX_RETRANSN', units='gN/m^2', & + avgflag='A', long_name='temporary annual max of retranslocated N pool', & + ptr_patch=this%tempmax_retransn_patch, default='inactive') + + this%annmax_retransn_patch(begp:endp) = spval + call hist_addfld1d (fname='ANNMAX_RETRANSN', units='gN/m^2', & + avgflag='A', long_name='annual max of retranslocated N pool', & + ptr_patch=this%annmax_retransn_patch, default='inactive') + + this%downreg_patch(begp:endp) = spval + call hist_addfld1d (fname='DOWNREG', units='proportion', & + avgflag='A', long_name='fractional reduction in GPP due to N limitation', & + ptr_patch=this%downreg_patch, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine initCold(this, bounds) + ! + ! !USES: + use spmdMod , only : masterproc + use fileutils , only : getfil + use clm_varctl , only : nsrest, nsrStartup + use ncdio_pio + ! + ! !ARGUMENTS: + class(cnveg_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p,n,j,m ! indices + real(r8) ,pointer :: gdp (:) ! global gdp data (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: peatf (:) ! global peatf data (needs to be a pointer for use in ncdio) + integer ,pointer :: abm (:) ! global abm data (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: gti (:) ! read in - fmax (needs to be a pointer for use in ncdio) + integer :: dimid ! dimension id + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + logical :: readvar + character(len=256) :: locfn ! local filename + integer :: begc, endc + integer :: begg, endg + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + ! -------------------------------------------------------------------- + ! Open surface dataset + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqdlen(ncid,dimid,nlevsoifl,name='nlevsoi') + if ( .not. more_vertlayers )then + if ( nlevsoifl /= nlevsoi )then + call endrun(msg=' ERROR: Number of soil layers on file does NOT match the number being used'//& + errMsg(__FILE__, __LINE__)) + end if + else + ! read in layers, interpolate to high resolution grid later + end if + + + ! -------------------------------------------------------------------- + ! Read in GDP data + ! -------------------------------------------------------------------- + + allocate(gdp(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='gdp', flag='read', data=gdp, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: gdp NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%gdp_lf_col(c) = gdp(g) + end do + deallocate(gdp) + + ! -------------------------------------------------------------------- + ! Read in peatf data + ! -------------------------------------------------------------------- + + allocate(peatf(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='peatf', flag='read', data=peatf, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: peatf NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%peatf_lf_col(c) = peatf(g) + end do + deallocate(peatf) + + ! -------------------------------------------------------------------- + ! Read in ABM data + ! -------------------------------------------------------------------- + + allocate(abm(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='abm', flag='read', data=abm, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: abm NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%abm_lf_col(c) = abm(g) + end do + deallocate(abm) + + ! Close file + + call ncd_pio_closefile(ncid) + + if (masterproc) then + write(iulog,*) 'Successfully read fmax, soil color, sand and clay boundary data' + write(iulog,*) + endif + + ! -------------------------------------------------------------------- + ! Initialize terms needed for dust model + ! TODO - move these terms to DUSTMod module variables + ! -------------------------------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + this%annsum_counter_col (c) = spval + this%annavg_t2m_col (c) = spval + this%nfire_col (c) = spval + this%baf_crop_col (c) = spval + this%baf_peatf_col (c) = spval + this%fbac_col (c) = spval + this%fbac1_col (c) = spval + this%farea_burned_col (c) = spval + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%annsum_counter_col(c) = 0._r8 + this%annavg_t2m_col(c) = 280._r8 + + ! fire related variables + this%baf_crop_col(c) = 0._r8 + this%baf_peatf_col(c) = 0._r8 + this%fbac_col(c) = 0._r8 + this%fbac1_col(c) = 0._r8 + this%farea_burned_col(c) = 0._r8 + this%nfire_col(c) = 0._r8 + end if + end do + + ! ecophysiological and phenology variables + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + if (lun%ifspecial(l)) then + this%annavg_t2m_patch (p) = spval + this%tempavg_t2m_patch (p) = spval + this%dormant_flag_patch(p) = spval + this%days_active_patch(p) = spval + this%onset_flag_patch(p) = spval + this%onset_counter_patch(p) = spval + this%onset_gddflag_patch(p) = spval + this%onset_fdd_patch(p) = spval + this%onset_gdd_patch(p) = spval + this%onset_swi_patch(p) = spval + this%offset_flag_patch(p) = spval + this%offset_counter_patch(p) = spval + this%offset_fdd_patch(p) = spval + this%offset_swi_patch(p) = spval + this%grain_flag_patch(p) = spval + this%lgsf_patch(p) = spval + this%bglfr_patch(p) = spval + this%bgtr_patch(p) = spval + this%c_allometry_patch(p) = spval + this%n_allometry_patch(p) = spval + this%tempsum_potential_gpp_patch(p) = spval + this%annsum_potential_gpp_patch(p) = spval + this%tempmax_retransn_patch(p) = spval + this%annmax_retransn_patch(p) = spval + this%downreg_patch(p) = spval + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + ! phenology variables + this%dormant_flag_patch(p) = 1._r8 + this%days_active_patch(p) = 0._r8 + this%onset_flag_patch(p) = 0._r8 + this%onset_counter_patch(p) = 0._r8 + this%onset_gddflag_patch(p) = 0._r8 + this%onset_fdd_patch(p) = 0._r8 + this%onset_gdd_patch(p) = 0._r8 + this%onset_swi_patch(p) = 0._r8 + this%offset_flag_patch(p) = 0._r8 + this%offset_counter_patch(p) = 0._r8 + this%offset_fdd_patch(p) = 0._r8 + this%offset_swi_patch(p) = 0._r8 + this%lgsf_patch(p) = 0._r8 + this%bglfr_patch(p) = 0._r8 + this%bgtr_patch(p) = 0._r8 + this%annavg_t2m_patch(p) = 280._r8 + this%tempavg_t2m_patch(p) = 0._r8 + this%grain_flag_patch(p) = 0._r8 + + ! non-phenology variables + this%c_allometry_patch(p) = 0._r8 + this%n_allometry_patch(p) = 0._r8 + this%tempsum_potential_gpp_patch(p) = 0._r8 + this%annsum_potential_gpp_patch(p) = 0._r8 + this%tempmax_retransn_patch(p) = 0._r8 + this%annmax_retransn_patch(p) = 0._r8 + this%downreg_patch(p) = 0._r8 + end if + + end do + + ! fire variables + + do c = bounds%begc,bounds%endc + this%lfc2_col(c) = 0._r8 + end do + + end subroutine initCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(cnveg_state_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + ! + ! !LOCAL VARIABLES: + integer, pointer :: temp1d(:) ! temporary + integer :: p,j,c,i ! indices + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='dormant_flag', xtype=ncd_double, & + dim1name='pft', & + long_name='dormancy flag', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%dormant_flag_patch) + + call restartvar(ncid=ncid, flag=flag, varname='days_active', xtype=ncd_double, & + dim1name='pft', & + long_name='number of days since last dormancy', units='days' , & + interpinic_flag='interp', readvar=readvar, data=this%days_active_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_flag', xtype=ncd_double, & + dim1name='pft', & + long_name='flag if critical growing degree-day sum is exceeded', units='unitless' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_flag_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_counter', xtype=ncd_double, & + dim1name='pft', & + long_name='onset days counter', units='sec' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_counter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_gddflag', xtype=ncd_double, & + dim1name='pft', & + long_name='onset flag for growing degree day sum', units='' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_gddflag_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_fdd', xtype=ncd_double, & + dim1name='pft', & + long_name='onset freezing degree days counter', units='days' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_fdd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_gdd', xtype=ncd_double, & + dim1name='pft', & + long_name='onset growing degree days', units='days' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_gdd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='onset_swi', xtype=ncd_double, & + dim1name='pft', & + long_name='onset soil water index', units='days' , & + interpinic_flag='interp', readvar=readvar, data=this%onset_swi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='offset_flag', xtype=ncd_double, & + dim1name='pft', & + long_name='offset flag', units='unitless' , & + interpinic_flag='interp', readvar=readvar, data=this%offset_flag_patch) + + call restartvar(ncid=ncid, flag=flag, varname='offset_counter', xtype=ncd_double, & + dim1name='pft', & + long_name='offset days counter', units='sec' , & + interpinic_flag='interp', readvar=readvar, data=this%offset_counter_patch) + + call restartvar(ncid=ncid, flag=flag, varname='offset_fdd', xtype=ncd_double, & + dim1name='pft', & + long_name='offset freezing degree days counter', units='days' , & + interpinic_flag='interp', readvar=readvar, data=this%offset_fdd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='offset_swi', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%offset_swi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='lgsf', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%lgsf_patch) + + call restartvar(ncid=ncid, flag=flag, varname='bglfr', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%bglfr_patch) + + call restartvar(ncid=ncid, flag=flag, varname='bgtr', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%bgtr_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annavg_t2m', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annavg_t2m_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tempavg_t2m', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tempavg_t2m_patch) + + call restartvar(ncid=ncid, flag=flag, varname='c_allometry', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%c_allometry_patch) + + call restartvar(ncid=ncid, flag=flag, varname='n_allometry', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%n_allometry_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tempsum_potential_gpp', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tempsum_potential_gpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annsum_potential_gpp', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annsum_potential_gpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tempmax_retransn', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tempmax_retransn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annmax_retransn', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annmax_retransn_patch) + + call restartvar(ncid=ncid, flag=flag, varname='downreg', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%downreg_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annsum_counter', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annsum_counter_col) + + call restartvar(ncid=ncid, flag=flag, varname='burndate', xtype=ncd_int, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%burndate_patch) + + call restartvar(ncid=ncid, flag=flag, varname='lfc', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%lfc_col) + + call restartvar(ncid=ncid, flag=flag, varname='cannavg_t2m', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%annavg_t2m_col) + + if (crop_prog) then + + call restartvar(ncid=ncid, flag=flag, varname='restyear', xtype=ncd_int, & + long_name='Number of years prognostic crop ran', units="years", & + interpinic_flag='copy', readvar=readvar, data=this%CropRestYear) + if (flag=='read' .and. readvar) then + call checkDates( ) + end if + + call restartvar(ncid=ncid, flag=flag, varname='htmx', xtype=ncd_double, & + dim1name='pft', long_name='max height attained by a crop during year', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%htmx_patch) + + call restartvar(ncid=ncid, flag=flag, varname='peaklai', xtype=ncd_int, & + dim1name='pft', long_name='Flag if at max allowed LAI or not', & + flag_values=(/0,1/), nvalid_range=(/0,1/), & + flag_meanings=(/'NOT-at-peak', 'AT_peak-LAI' /) , & + interpinic_flag='interp', readvar=readvar, data=this%peaklai_patch) + + call restartvar(ncid=ncid, flag=flag, varname='idop', xtype=ncd_int, & + dim1name='pft', long_name='Date of planting', units='jday', nvalid_range=(/1,366/), & + interpinic_flag='interp', readvar=readvar, data=this%idop_patch) + + call restartvar(ncid=ncid, flag=flag, varname='aleaf', xtype=ncd_double, & + dim1name='pft', long_name='leaf allocation coefficient', units='', & + interpinic_flag='interp', readvar=readvar, data=this%aleaf_patch) + + call restartvar(ncid=ncid, flag=flag, varname='aleafi', xtype=ncd_double, & + dim1name='pft', long_name='Saved leaf allocation coefficient from phase 2', units='', & + interpinic_flag='interp', readvar=readvar, data=this%aleafi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='astem', xtype=ncd_double, & + dim1name='pft', long_name='stem allocation coefficient', units='', & + interpinic_flag='interp', readvar=readvar, data=this%astem_patch) + + call restartvar(ncid=ncid, flag=flag, varname='astemi', xtype=ncd_double, & + dim1name='pft', long_name='Saved stem allocation coefficient from phase 2', units='', & + interpinic_flag='interp', readvar=readvar, data=this%astemi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='hdidx', xtype=ncd_double, & + dim1name='pft', long_name='cold hardening index', units='', & + interpinic_flag='interp', readvar=readvar, data=this%hdidx_patch) + + call restartvar(ncid=ncid, flag=flag, varname='vf', xtype=ncd_double, & + dim1name='pft', long_name='vernalization factor', units='', & + interpinic_flag='interp', readvar=readvar, data=this%vf_patch) + + call restartvar(ncid=ncid, flag=flag, varname='cumvd', xtype=ncd_double, & + dim1name='pft', long_name='cumulative vernalization d', units='', & + interpinic_flag='interp', readvar=readvar, data=this%cumvd_patch) + + allocate(temp1d(bounds%begp:bounds%endp)) + if (flag == 'write') then + do p= bounds%begp,bounds%endp + if (this%croplive_patch(p)) then + temp1d(p) = 1 + else + temp1d(p) = 0 + end if + end do + end if + call restartvar(ncid=ncid, flag=flag, varname='croplive', xtype=ncd_log, & + dim1name='pft', & + long_name='Flag that crop is alive, but not harvested', & + interpinic_flag='interp', readvar=readvar, data=temp1d) + if (flag == 'read') then + do p= bounds%begp,bounds%endp + if (temp1d(p) == 1) then + this%croplive_patch(p) = .true. + else + this%croplive_patch(p) = .false. + end if + end do + end if + deallocate(temp1d) + + allocate(temp1d(bounds%begp:bounds%endp)) + if (flag == 'write') then + do p= bounds%begp,bounds%endp + if (this%cropplant_patch(p)) then + temp1d(p) = 1 + else + temp1d(p) = 0 + end if + end do + end if + call restartvar(ncid=ncid, flag=flag, varname='cropplant', xtype=ncd_log, & + dim1name='pft', & + long_name='Flag that crop is planted, but not harvested' , & + interpinic_flag='interp', readvar=readvar, data=temp1d) + if (flag == 'read') then + do p= bounds%begp,bounds%endp + if (temp1d(p) == 1) then + this%cropplant_patch(p) = .true. + else + this%cropplant_patch(p) = .false. + end if + end do + end if + deallocate(temp1d) + + call restartvar(ncid=ncid, flag=flag, varname='harvdate', xtype=ncd_int, & + dim1name='pft', long_name='harvest date', units='jday', nvalid_range=(/1,366/), & + interpinic_flag='interp', readvar=readvar, data=this%harvdate_patch) + + call restartvar(ncid=ncid, flag=flag, varname='gddmaturity', xtype=ncd_double, & + dim1name='pft', long_name='Growing degree days needed to harvest', units='ddays', & + interpinic_flag='interp', readvar=readvar, data=this%gddmaturity_patch) + + call restartvar(ncid=ncid, flag=flag, varname='huileaf', xtype=ncd_double, & + dim1name='pft', long_name='heat unit index needed from planting to leaf emergence', units='', & + interpinic_flag='interp', readvar=readvar, data=this%huileaf_patch) + + call restartvar(ncid=ncid, flag=flag, varname='huigrain', xtype=ncd_double, & + dim1name='pft', long_name='heat unit index needed to reach vegetative maturity', units='', & + interpinic_flag='interp', readvar=readvar, data=this%huigrain_patch) + + call restartvar(ncid=ncid, flag=flag, varname='grain_flag', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%grain_flag_patch) + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine CropRestIncYear (this) + ! + ! !DESCRIPTION: + ! Increment the crop restart year, if appropriate + ! + ! This routine should be called every time step, but only once per clump (to avoid + ! inadvertently updating nyrs multiple times) + ! + ! !USES: + use clm_time_manager , only : get_curr_date, is_first_step + ! + ! !ARGUMENTS: + class(cnveg_state_type) :: this + ! + ! !LOCAL VARIABLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + !----------------------------------------------------------------------- + + ! Update restyear only when running with prognostic crop + if ( crop_prog )then + + ! Update restyear when it's the start of a new year - but don't do that at the + ! very start of the run + call get_curr_date ( kyr, kmo, kda, mcsec) + if ((kmo == 1 .and. kda == 1 .and. mcsec == 0) .and. .not. is_first_step()) then + this%CropRestYear = this%CropRestYear + 1 + end if + + end if + + end subroutine CropRestIncYear + + !----------------------------------------------------------------------- + subroutine checkDates( ) + ! + ! !DESCRIPTION: + ! Make sure the dates are compatible. The date given to startup the model + ! and the date on the restart file must be the same although years can be + ! different. The dates need to be checked when the restart file is being + ! read in for a startup or branch case (they are NOT allowed to be different + ! for a restart case). + ! + ! For the prognostic crop model the date of planting is tracked and growing + ! degree days is tracked (with a 20 year mean) -- so shifting the start dates + ! messes up these bits of saved information. + ! + ! !ARGUMENTS: + use clm_time_manager, only : get_driver_start_ymd, get_start_date + use clm_varctl , only : iulog + use clm_varctl , only : nsrest, nsrBranch, nsrStartup + ! + ! !LOCAL VARIABLES: + integer :: stymd ! Start date YYYYMMDD from driver + integer :: styr ! Start year from driver + integer :: stmon_day ! Start date MMDD from driver + integer :: rsmon_day ! Restart date MMDD from restart file + integer :: rsyr ! Restart year from restart file + integer :: rsmon ! Restart month from restart file + integer :: rsday ! Restart day from restart file + integer :: tod ! Restart time of day from restart file + character(len=*), parameter :: formDate = '(A,i4.4,"/",i2.2,"/",i2.2)' ! log output format + character(len=32) :: subname = 'CropRest::checkDates' + !----------------------------------------------------------------------- + ! + ! If branch or startup make sure the startdate is compatible with the date + ! on the restart file. + ! + if ( nsrest == nsrBranch .or. nsrest == nsrStartup )then + stymd = get_driver_start_ymd() + styr = stymd / 10000 + stmon_day = stymd - styr*10000 + call get_start_date( rsyr, rsmon, rsday, tod ) + rsmon_day = rsmon*100 + rsday + if ( masterproc ) & + write(iulog,formDate) 'Date on the restart file is: ', rsyr, rsmon, rsday + if ( stmon_day /= rsmon_day )then + write(iulog,formDate) 'Start date is: ', styr, stmon_day/100, & + (stmon_day - stmon_day/100) + call endrun(msg=' ERROR: For prognostic crop to work correctly, the start date (month and day)'// & + ' and the date on the restart file needs to match (years can be different)'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + end subroutine checkDates + +end module CNVegStateType diff --git a/components/clm/src/biogeochem/CNVegStructUpdateMod.F90 b/components/clm/src/biogeochem/CNVegStructUpdateMod.F90 new file mode 100644 index 0000000000..c080ae06b8 --- /dev/null +++ b/components/clm/src/biogeochem/CNVegStructUpdateMod.F90 @@ -0,0 +1,298 @@ +module CNVegStructUpdateMod + + !----------------------------------------------------------------------- + ! Module for vegetation structure updates (LAI, SAI, htop, hbot) + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_PI + use clm_varctl , only : iulog, use_cndv + use CNDVType , only : dgv_ecophyscon + use WaterStateType , only : waterstate_type + use FrictionVelocityMod , only : frictionvel_type + use CNDVType , only : dgvs_type + use CNVegstateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CanopyStateType , only : canopystate_type + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CNVegStructUpdate + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNVegStructUpdate(num_soilp, filter_soilp, & + waterstate_inst, frictionvel_inst, dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, use C state variables and epc to diagnose + ! vegetation structure (LAI, SAI, height) + ! + ! !USES: + use pftconMod , only : noveg, nc3crop, nc3irrig, nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub + use pftconMod , only : npcropmin + use pftconMod , only : ntmp_corn, nirrig_tmp_corn + use pftconMod , only : ntrp_corn, nirrig_trp_corn + use pftconMod , only : nsugarcane, nirrig_sugarcane + use pftconMod , only : pftcon + use clm_time_manager , only : get_rad_step_size + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilp ! number of column soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(waterstate_type) , intent(in) :: waterstate_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(dgvs_type) , intent(in) :: dgvs_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !REVISION HISTORY: + ! 10/28/03: Created by Peter Thornton + ! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation + ! + ! !LOCAL VARIABLES: + integer :: p,c,g ! indices + integer :: fp ! lake filter indices + real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: ol ! thickness of canopy layer covered by snow (m) + real(r8) :: fb ! fraction of canopy layer covered by snow + real(r8) :: tlai_old ! for use in Zeng tsai formula + real(r8) :: tsai_old ! for use in Zeng tsai formula + real(r8) :: tsai_min ! PATCH derived minimum tsai + real(r8) :: tsai_alpha ! monthly decay rate of tsai + real(r8) :: dt ! radiation time step (sec) + + real(r8), parameter :: dtsmonth = 2592000._r8 ! number of seconds in a 30 day month (60x60x24x30) + !----------------------------------------------------------------------- + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 + ! + ! tsai(p) = max( tsai_alpha(ivt(p))*tsai_old + max(tlai_old-tlai(p),0_r8), tsai_min(ivt(p)) ) + ! notes: + ! * RHS tsai & tlai are from previous timestep + ! * should create tsai_alpha(ivt(p)) & tsai_min(ivt(p)) in pftconMod.F90 - slevis + ! * all non-crop patches use same values: + ! crop tsai_alpha,tsai_min = 0.0,0.1 + ! noncrop tsai_alpha,tsai_min = 0.5,1.0 (includes bare soil and urban) + !------------------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + dsladlai => pftcon%dsladlai , & ! Input: dSLA/dLAI, projected area basis [m^2/gC] + z0mr => pftcon%z0mr , & ! Input: ratio of momentum roughness length to canopy top height (-) + displar => pftcon%displar , & ! Input: ratio of displacement height to canopy top height (-) + dwood => pftcon%dwood , & ! Input: density of wood (gC/m^3) + ztopmx => pftcon%ztopmx , & ! Input: + laimx => pftcon%laimx , & ! Input: + + allom2 => dgv_ecophyscon%allom2 , & ! Input: [real(r8) (:) ] ecophys const + allom3 => dgv_ecophyscon%allom3 , & ! Input: [real(r8) (:) ] ecophys const + + nind => dgvs_inst%nind_patch , & ! Input: [real(r8) (:) ] number of individuals (#/m**2) + fpcgrid => dgvs_inst%fpcgrid_patch , & ! Input: [real(r8) (:) ] fractional area of patch (pft area/nat veg area) + + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch-level [m] + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] (gC/m2) leaf C + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:) ] (gC/m2) dead stem C + + farea_burned => cnveg_state_inst%farea_burned_col , & ! Input: [real(r8) (:) ] F. Li and S. Levis + harvdate => cnveg_state_inst%harvdate_patch , & ! Input: [integer (:) ] harvest date + htmx => cnveg_state_inst%htmx_patch , & ! Output: [real(r8) (:) ] max hgt attained by a crop during yr (m) + peaklai => cnveg_state_inst%peaklai_patch , & ! Output: [integer (:) ] 1: max allowed lai; 0: not at max + + ! *** Key Output from CN*** + tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] frac of vegetation not covered by snow [-] + ) + + dt = real( get_rad_step_size(), r8 ) + + ! constant allometric parameters + taper = 200._r8 + stocking = 1000._r8 + + ! convert from stems/ha -> stems/m^2 + stocking = stocking / 10000._r8 + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + g = patch%gridcell(p) + + if (ivt(p) /= noveg) then + + tlai_old = tlai(p) ! n-1 value + tsai_old = tsai(p) ! n-1 value + + ! update the leaf area index based on leafC and SLA + ! Eq 3 from Thornton and Zimmerman, 2007, J Clim, 20, 3902-3923. + if (dsladlai(ivt(p)) > 0._r8) then + tlai(p) = (slatop(ivt(p))*(exp(leafc(p)*dsladlai(ivt(p))) - 1._r8))/dsladlai(ivt(p)) + else + tlai(p) = slatop(ivt(p)) * leafc(p) + end if + tlai(p) = max(0._r8, tlai(p)) + + ! update the stem area index and height based on LAI, stem mass, and veg type. + ! With the exception of htop for woody vegetation, this follows the DGVM logic. + + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes) + ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor + ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by + ! dt and dividing by dtsmonth (seconds in average 30 day month) + ! tsai_min scaled by 0.5 to match MODIS satellite derived values + if (ivt(p) == nc3crop .or. ivt(p) == nc3irrig) then ! generic crops + + tsai_alpha = 1.0_r8-1.0_r8*dt/dtsmonth + tsai_min = 0.1_r8 + else + tsai_alpha = 1.0_r8-0.5_r8*dt/dtsmonth + tsai_min = 1.0_r8 + end if + tsai_min = tsai_min * 0.5_r8 + tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min) + + if (woody(ivt(p)) == 1._r8) then + + ! trees and shrubs + + ! if shrubs have a squat taper + if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then + taper = 10._r8 + ! otherwise have a tall taper + else + taper = 200._r8 + end if + + ! trees and shrubs for now have a very simple allometry, with hard-wired + ! stem taper (height:radius) and hard-wired stocking density (#individuals/area) + if (use_cndv) then + + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 patch area + htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & + (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) )**allom3(ivt(p)) ! lpj's htop w/ cn's stemdiam + + else + htop(p) = 0._r8 + end if + + else + + htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ & + (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8) + + endif + + ! Peter Thornton, 5/3/2004 + ! Adding test to keep htop from getting too close to forcing height for windspeed + ! Also added for grass, below, although it is not likely to ever be an issue. + htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + ! This becomes an issue when fire mortality is pushing deadstemc + ! to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0._r8, min(3._r8, htop(p)-1._r8)) + + else if (ivt(p) >= npcropmin) then ! prognostic crops + + if (tlai(p) >= laimx(ivt(p))) peaklai(p) = 1 ! used in CNAllocation + + if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & + ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & + ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then + tsai(p) = 0.1_r8 * tlai(p) + else + tsai(p) = 0.2_r8 * tlai(p) + end if + + ! "stubble" after harvest + if (harvdate(p) < 999 .and. tlai(p) == 0._r8) then + tsai(p) = 0.25_r8*(1._r8-farea_burned(c)*0.90_r8) !changed by F. Li and S. Levis + htmx(p) = 0._r8 + peaklai(p) = 0 + end if + !if (harvdate(p) < 999 .and. tlai(p) > 0._r8) write(iulog,*) 'CNVegStructUpdate: tlai>0 after harvest!' ! remove after initial debugging? + + ! canopy top and bottom heights + htop(p) = ztopmx(ivt(p)) * (min(tlai(p)/(laimx(ivt(p))-1._r8),1._r8))**2 + htmx(p) = max(htmx(p), htop(p)) + htop(p) = max(0.05_r8, max(htmx(p),htop(p))) + hbot(p) = 0.02_r8 + + else ! generic crops and ... + + ! grasses + + ! height for grasses depends only on LAI + htop(p) = max(0.25_r8, tlai(p) * 0.25_r8) + + htop(p) = min(htop(p),(forc_hgt_u_patch(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0.0_r8, min(0.05_r8, htop(p)-0.20_r8)) + end if + + else + + tlai(p) = 0._r8 + tsai(p) = 0._r8 + htop(p) = 0._r8 + hbot(p) = 0._r8 + + end if + + ! adjust lai and sai for burying by snow. + ! snow burial fraction for short vegetation (e.g. grasses) as in + ! Wang and Zeng, 2007. + if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then + ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - max(min(snow_depth(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed + !depth of snow required for complete burial of grasses + endif + + elai(p) = max(tlai(p)*fb, 0.0_r8) + esai(p) = max(tsai(p)*fb, 0.0_r8) + + ! Fraction of vegetation free of snow + if ((elai(p) + esai(p)) > 0._r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if + + end do + + end associate + + end subroutine CNVegStructUpdate + +end module CNVegStructUpdateMod diff --git a/components/clm/src/biogeochem/CNWoodProductsMod.F90 b/components/clm/src/biogeochem/CNWoodProductsMod.F90 new file mode 100644 index 0000000000..049b67a84a --- /dev/null +++ b/components/clm/src/biogeochem/CNWoodProductsMod.F90 @@ -0,0 +1,172 @@ +module CNWoodProductsMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate loss fluxes from wood products pools, and update product pool state variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : get_proc_bounds + use spmdMod , only : masterproc + use landunit_varcon , only : istsoil + use clm_time_manager , only : get_step_size + use clm_varctl , only : use_c13, use_c14 + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type + use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: CNWoodProducts + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CNWoodProducts(num_soilc, filter_soilc, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Update all loss fluxes from wood product pools, and update product pool state variables + ! for both loss and gain terms. Gain terms are calculated in pftdyn_cnbal() for gains associated + ! with changes in landcover, and in CNHarvest(), for gains associated with wood harvest. + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(in) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(in) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fc ! lake filter indices + integer :: c ! indices + real(r8) :: dt ! time step (seconds) + real(r8) :: kprod10 ! decay constant for 10-year product pool + real(r8) :: kprod100 ! decay constant for 100-year product pool + !----------------------------------------------------------------------- + + + ! calculate column-level losses from product pools + ! the following (1/s) rate constants result in ~90% loss of initial state over 10 and 100 years, + ! respectively, using a discrete-time fractional decay algorithm. + kprod10 = 7.2e-9 + kprod100 = 7.2e-10 + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate fluxes (1/sec) + cnveg_carbonflux_inst%prod10c_loss_col(c) = cnveg_carbonstate_inst%prod10c_col(c) * kprod10 + cnveg_carbonflux_inst%prod100c_loss_col(c) = cnveg_carbonstate_inst%prod100c_col(c) * kprod100 + + if ( use_c13 ) then + cnveg_carbonflux_inst%prod10c_loss_col(c) = cnveg_carbonstate_inst%prod10c_col(c) * kprod10 + cnveg_carbonflux_inst%prod100c_loss_col(c) = cnveg_carbonstate_inst%prod100c_col(c) * kprod100 + endif + + if ( use_c14 ) then + cnveg_carbonflux_inst%prod10c_loss_col(c) = cnveg_carbonstate_inst%prod10c_col(c) * kprod10 + cnveg_carbonflux_inst%prod100c_loss_col(c) = cnveg_carbonstate_inst%prod100c_col(c) * kprod100 + endif + + cnveg_nitrogenflux_inst%prod10n_loss_col(c) = cnveg_nitrogenstate_inst%prod10n_col(c) * kprod10 + cnveg_nitrogenflux_inst%prod100n_loss_col(c) = cnveg_nitrogenstate_inst%prod100n_col(c) * kprod100 + end do + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! update wood product state variables + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! fluxes into wood product pools, from landcover change + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%dwt_prod10c_gain_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%dwt_prod100c_gain_col(c)*dt + + if ( use_c13 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) *dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%dwt_prod100c_gain_col(c)*dt + endif + + if ( use_c14 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) *dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%dwt_prod100c_gain_col(c)*dt + endif + + cnveg_nitrogenstate_inst%prod10n_col(c) = cnveg_nitrogenstate_inst%prod10n_col(c) + & + cnveg_nitrogenflux_inst%dwt_prod10n_gain_col(c)*dt + cnveg_nitrogenstate_inst%prod100n_col(c) = cnveg_nitrogenstate_inst%prod100n_col(c) + & + cnveg_nitrogenflux_inst%dwt_prod100n_gain_col(c)*dt + + ! fluxes into wood product pools, from harvest + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_col(c)*dt + + if ( use_c13 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_col(c)*dt + endif + + if ( use_c14 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) + & + cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_col(c)*dt + endif + + cnveg_nitrogenstate_inst%prod10n_col(c) = cnveg_nitrogenstate_inst%prod10n_col(c) + & + cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod10n_col(c)*dt + cnveg_nitrogenstate_inst%prod100n_col(c) = cnveg_nitrogenstate_inst%prod100n_col(c) + & + cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod100n_col(c)*dt + + ! fluxes out of wood product pools, from decomposition + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) - & + cnveg_carbonflux_inst%prod10c_loss_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) - & + cnveg_carbonflux_inst%prod100c_loss_col(c)*dt + + if ( use_c13 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) - & + cnveg_carbonflux_inst%prod10c_loss_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) - & + cnveg_carbonflux_inst%prod100c_loss_col(c)*dt + endif + + if ( use_c14 ) then + cnveg_carbonstate_inst%prod10c_col(c) = cnveg_carbonstate_inst%prod10c_col(c) - & + cnveg_carbonflux_inst%prod10c_loss_col(c)*dt + cnveg_carbonstate_inst%prod100c_col(c) = cnveg_carbonstate_inst%prod100c_col(c) - & + cnveg_carbonflux_inst%prod100c_loss_col(c)*dt + endif + + cnveg_nitrogenstate_inst%prod10n_col(c) = cnveg_nitrogenstate_inst%prod10n_col(c) - & + cnveg_nitrogenflux_inst%prod10n_loss_col(c)*dt + cnveg_nitrogenstate_inst%prod100n_col(c) = cnveg_nitrogenstate_inst%prod100n_col(c) - & + cnveg_nitrogenflux_inst%prod100n_loss_col(c)*dt + + end do ! end of column loop + + end subroutine CNWoodProducts + +end module CNWoodProductsMod diff --git a/components/clm/src/biogeochem/CropType.F90 b/components/clm/src/biogeochem/CropType.F90 new file mode 100644 index 0000000000..abe93c0a3f --- /dev/null +++ b/components/clm/src/biogeochem/CropType.F90 @@ -0,0 +1,312 @@ +module CropType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing variables needed for the crop model + ! + ! TODO(wjs, 2014-08-05) Move more crop-specific variables into here + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varcon , only : spval + use clm_varpar , only : crop_prog + use clm_varctl , only : iulog + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC DATA TYPES: + ! + ! Crop state variables structure + type, public :: crop_type + + real(r8), pointer :: gddplant_patch (:) ! patch accum gdd past planting date for crop (ddays) + real(r8), pointer :: gddtsoi_patch (:) ! patch growing degree-days from planting (top two soil layers) (ddays) + + contains + ! Public routines + procedure, public :: Init + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + + ! NOTE(wjs, 2014-09-29) need to rename this from UpdateAccVars to CropUpdateAccVars + ! to prevent cryptic error messages with pgi (v. 13.9 on yellowstone) + ! This is probably related to this bug + ! , which was fixed in pgi 14.7. + procedure, public :: CropUpdateAccVars + + ! Private routines + procedure, private :: InitAllocate + procedure, private :: InitHistory + + end type crop_type + + !------------------------------------------------------------------------ + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + ! + ! !ARGUMENTS: + class(crop_type) , intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Init' + !----------------------------------------------------------------------- + + call this%InitAllocate(bounds) + + if (crop_prog) then + call this%InitHistory(bounds) + end if + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class(crop_type) , intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitAllocate' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + allocate(this%gddplant_patch (begp:endp)) ; this%gddplant_patch (:) = spval + allocate(this%gddtsoi_patch (begp:endp)) ; this%gddtsoi_patch (:) = spval + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(crop_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + this%gddplant_patch(begp:endp) = spval + call hist_addfld1d (fname='GDDPLANT', units='ddays', & + avgflag='A', long_name='Accumulated growing degree days past planting date for crop', & + ptr_patch=this%gddplant_patch, default='inactive') + + this%gddtsoi_patch(begp:endp) = spval + call hist_addfld1d (fname='GDDTSOI', units='ddays', & + avgflag='A', long_name='Growing degree-days from planting (top two soil layers)', & + ptr_patch=this%gddtsoi_patch, default='inactive') + + end subroutine InitHistory + + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! Each interval and accumulation type is unique to each field processed. + ! Routine [initAccBuffer] defines the fields to be processed + ! and the type of accumulation. + ! Routine [updateAccVars] does the actual accumulation for a given field. + ! Fields are accumulated by calls to subroutine [update_accum_field]. + ! To accumulate a field, it must first be defined in subroutine [initAccVars] + ! and then accumulated by calls to [updateAccVars]. + ! + ! Should only be called if crop_prog is true + ! + ! !USES + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(crop_type) , intent(in) :: this + type(bounds_type), intent(in) :: bounds + + ! + ! !LOCAL VARIABLES: + integer, parameter :: not_used = huge(1) + + !--------------------------------------------------------------------- + + call init_accum_field (name='GDDPLANT', units='K', & + desc='growing degree-days from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDDTSOI', units='K', & + desc='growing degree-days from planting (top two soil layers)', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES: + use accumulMod , only : extract_accum_field + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(crop_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + + character(len=*), parameter :: subname = 'InitAccVars' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)' in ' + call endrun(msg=" allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + nstep = get_nstep() + + call extract_accum_field ('GDDPLANT', rbufslp, nstep) + this%gddplant_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('GDDTSOI', rbufslp, nstep) + this%gddtsoi_patch(begp:endp) = rbufslp(begp:endp) + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine CropUpdateAccVars(this, bounds, t_ref2m_patch, t_soisno_col, cnveg_state_inst) + ! + ! !DESCRIPTION: + ! Update accumulated variables. Should be called every time step. + ! Should only be called if crop_prog is true. + ! + ! !USES: + use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + use clm_time_manager , only : get_step_size, get_nstep + use clm_varpar , only : nlevsno, nlevgrnd + use pftconMod , only : nwwheat, nirrig_wwheat, pftcon + use CNVegStateType , only : cnveg_state_type + use ColumnType , only : col + use PatchType , only : patch + ! + ! !ARGUMENTS: + class(crop_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: t_ref2m_patch( bounds%begp:) + real(r8) , intent(inout) :: t_soisno_col(bounds%begc:, -nlevsno+1:) + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c ! indices + integer :: ivt ! vegetation type + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: ier ! error status + integer :: begp, endp + integer :: begc, endc + real(r8), pointer :: rbufslp(:) ! temporary single level - patch level + character(len=*), parameter :: subname = 'CropUpdateAccVars' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(t_ref2m_patch) == (/endp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno_col) == (/endc,nlevgrnd/)) , errMsg(__FILE__, __LINE__)) + + dtime = get_step_size() + nstep = get_nstep() + + ! Allocate needed dynamic memory for single level patch field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate and extract GDDPLANT + + do p = begp,endp + if (cnveg_state_inst%croplive_patch(p)) then ! relative to planting date + ivt = patch%itype(p) + rbufslp(p) = max(0._r8, min(pftcon%mxtmp(ivt), & + t_ref2m_patch(p)-(SHR_CONST_TKFRZ + pftcon%baset(ivt)))) & + * dtime/SHR_CONST_CDAY + if (ivt == nwwheat .or. ivt == nirrig_wwheat) then + rbufslp(p) = rbufslp(p) * cnveg_state_inst%vf_patch(p) + end if + else + rbufslp(p) = accumResetVal + end if + end do + call update_accum_field ('GDDPLANT', rbufslp, nstep) + call extract_accum_field ('GDDPLANT', this%gddplant_patch, nstep) + + ! Accumulate and extract GDDTSOI + ! In agroibis this variable is calculated + ! to 0.05 m, so here we use the top two soil layers + + do p = begp,endp + if (cnveg_state_inst%croplive_patch(p)) then ! relative to planting date + ivt = patch%itype(p) + c = patch%column(p) + rbufslp(p) = max(0._r8, min(pftcon%mxtmp(ivt), & + ((t_soisno_col(c,1)*col%dz(c,1) + & + t_soisno_col(c,2)*col%dz(c,2))/(col%dz(c,1)+col%dz(c,2))) - & + (SHR_CONST_TKFRZ + pftcon%baset(ivt)))) * dtime/SHR_CONST_CDAY + if (ivt == nwwheat .or. ivt == nwwheat) then + rbufslp(p) = rbufslp(p) * cnveg_state_inst%vf_patch(p) + end if + else + rbufslp(p) = accumResetVal + end if + end do + call update_accum_field ('GDDTSOI', rbufslp, nstep) + call extract_accum_field ('GDDTSOI', this%gddtsoi_patch, nstep) + + deallocate(rbufslp) + + end subroutine CropUpdateAccVars + +end module CropType + diff --git a/components/clm/src/biogeochem/DUSTMod.F90 b/components/clm/src/biogeochem/DUSTMod.F90 new file mode 100644 index 0000000000..1e9ba778de --- /dev/null +++ b/components/clm/src/biogeochem/DUSTMod.F90 @@ -0,0 +1,922 @@ +module DUSTMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Routines in this module calculate Dust mobilization and dry deposition for dust. + ! Simulates dust mobilization due to wind from the surface into the + ! lowest atmospheric layer. On output flx_mss_vrt_dst(ndst) is the surface dust + ! emission (kg/m**2/s) [ + = to atm]. + ! Calculates the turbulent component of dust dry deposition, (the turbulent deposition + ! velocity through the lowest atmospheric layer). CAM will calculate the settling + ! velocity through the whole atmospheric column. The two calculations will determine + ! the dust dry deposition flux to the surface. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : dst_src_nbr, ndst, sz_nbr + use clm_varcon , only : grav, spval + use landunit_varcon , only : istcrop, istice_mec, istsoil + use clm_varctl , only : iulog + use abortutils , only : endrun + use subgridAveMod , only : p2l_1d + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use WaterstateType , only : waterstate_type + use FrictionVelocityMod , only : frictionvel_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public DustEmission ! Dust mobilization + public DustDryDep ! Turbulent dry deposition for dust + ! + ! !PUBLIC DATA: + ! + real(r8) , allocatable :: ovr_src_snk_mss(:,:) + real(r8) , allocatable :: dmt_vwr(:) ![m] Mass-weighted mean diameter resolved + real(r8) , allocatable :: stk_crc(:) ![frc] Correction to Stokes settling velocity + real(r8) tmp1 !Factor in saltation computation (named as in Charlie's code) + real(r8) dns_aer ![kg m-3] Aerosol density + ! + ! !PUBLIC DATA TYPES: + ! + type, public :: dust_type + + real(r8), pointer, PUBLIC :: flx_mss_vrt_dst_patch (:,:) ! surface dust emission (kg/m**2/s) [ + = to atm] (ndst) + real(r8), pointer, private :: flx_mss_vrt_dst_tot_patch (:) ! total dust flux into atmosphere + real(r8), pointer, private :: vlc_trb_patch (:,:) ! turbulent deposition velocity (m/s) (ndst) + real(r8), pointer, private :: vlc_trb_1_patch (:) ! turbulent deposition velocity 1(m/s) + real(r8), pointer, private :: vlc_trb_2_patch (:) ! turbulent deposition velocity 2(m/s) + real(r8), pointer, private :: vlc_trb_3_patch (:) ! turbulent deposition velocity 3(m/s) + real(r8), pointer, private :: vlc_trb_4_patch (:) ! turbulent deposition velocity 4(m/s) + real(r8), pointer, private :: mbl_bsn_fct_col (:) ! basin factor + + contains + + procedure , public :: Init + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + procedure , private :: InitDustVars ! Initialize variables used in subroutine Dust + + end type dust_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(dust_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate (bounds) + call this%InitHistory (bounds) + call this%InitCold (bounds) + call this%InitDustVars (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (dust_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp ; endp = bounds%endp + begc = bounds%begc ; endc = bounds%endc + + allocate(this%flx_mss_vrt_dst_patch (begp:endp,1:ndst)) ; this%flx_mss_vrt_dst_patch (:,:) = nan + allocate(this%flx_mss_vrt_dst_tot_patch (begp:endp)) ; this%flx_mss_vrt_dst_tot_patch (:) = nan + allocate(this%vlc_trb_patch (begp:endp,1:ndst)) ; this%vlc_trb_patch (:,:) = nan + allocate(this%vlc_trb_1_patch (begp:endp)) ; this%vlc_trb_1_patch (:) = nan + allocate(this%vlc_trb_2_patch (begp:endp)) ; this%vlc_trb_2_patch (:) = nan + allocate(this%vlc_trb_3_patch (begp:endp)) ; this%vlc_trb_3_patch (:) = nan + allocate(this%vlc_trb_4_patch (begp:endp)) ; this%vlc_trb_4_patch (:) = nan + allocate(this%mbl_bsn_fct_col (begc:endc)) ; this%mbl_bsn_fct_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! + ! !ARGUMENTS: + class (dust_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + + this%flx_mss_vrt_dst_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='DSTFLXT', units='kg/m2/s', & + avgflag='A', long_name='total surface dust emission', & + ptr_patch=this%flx_mss_vrt_dst_tot_patch, set_lake=0._r8, set_urb=0._r8) + + this%vlc_trb_1_patch(begp:endp) = spval + call hist_addfld1d (fname='DPVLTRB1', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 1', & + ptr_patch=this%vlc_trb_1_patch, default='inactive') + + this%vlc_trb_2_patch(begp:endp) = spval + call hist_addfld1d (fname='DPVLTRB2', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 2', & + ptr_patch=this%vlc_trb_2_patch, default='inactive') + + this%vlc_trb_3_patch(begp:endp) = spval + call hist_addfld1d (fname='DPVLTRB3', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 3', & + ptr_patch=this%vlc_trb_3_patch, default='inactive') + + this%vlc_trb_4_patch(begp:endp) = spval + call hist_addfld1d (fname='DPVLTRB4', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 4', & + ptr_patch=this%vlc_trb_4_patch, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class (dust_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,l + !----------------------------------------------------------------------- + + ! Set basin factor to 1 for now + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (.not.lun%lakpoi(l)) then + this%mbl_bsn_fct_col(c) = 1.0_r8 + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine DustEmission (bounds, & + num_nolakep, filter_nolakep, & + atm2lnd_inst, soilstate_inst, canopystate_inst, waterstate_inst, & + frictionvel_inst, dust_inst) + ! + ! !DESCRIPTION: + ! Dust mobilization. This code simulates dust mobilization due to wind + ! from the surface into the lowest atmospheric layer + ! On output flx_mss_vrt_dst(ndst) is the surface dust emission + ! (kg/m**2/s) [ + = to atm] + ! Source: C. Zender's dust model + ! + ! !USES + use shr_const_mod, only : SHR_CONST_RHOFW + use subgridaveMod, only : p2g + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter + integer , intent(in) :: filter_nolakep(num_nolakep) ! patch filter for non-lake points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(dust_type) , intent(inout) :: dust_inst + + ! + ! !LOCAL VARIABLES + integer :: fp,p,c,l,g,m,n ! indices + real(r8) :: liqfrac ! fraction of total water that is liquid + real(r8) :: wnd_frc_rat ! [frc] Wind friction threshold over wind friction + real(r8) :: wnd_frc_slt_dlt ! [m s-1] Friction velocity increase from saltatn + real(r8) :: wnd_rfr_dlt ! [m s-1] Reference windspeed excess over threshld + real(r8) :: dst_slt_flx_rat_ttl + real(r8) :: flx_mss_hrz_slt_ttl + real(r8) :: flx_mss_vrt_dst_ttl(bounds%begp:bounds%endp) + real(r8) :: frc_thr_wet_fct + real(r8) :: frc_thr_rgh_fct + real(r8) :: wnd_frc_thr_slt + real(r8) :: wnd_rfr_thr_slt + real(r8) :: wnd_frc_slt + real(r8) :: lnd_frc_mbl(bounds%begp:bounds%endp) + real(r8) :: bd + real(r8) :: gwc_sfc + real(r8) :: ttlai(bounds%begp:bounds%endp) + real(r8) :: tlai_lu(bounds%begl:bounds%endl) + real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights + logical :: found ! temporary for error check + integer :: index + ! + ! constants + ! + real(r8), parameter :: cst_slt = 2.61_r8 ! [frc] Saltation constant + real(r8), parameter :: flx_mss_fdg_fct = 5.0e-4_r8 ! [frc] Empir. mass flx tuning eflx_lh_vegt + real(r8), parameter :: vai_mbl_thr = 0.3_r8 ! [m2 m-2] VAI threshold quenching dust mobilization + !------------------------------------------------------------------------ + + associate( & + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] downscaled density (kg/m**3) + + gwc_thr => soilstate_inst%gwc_thr_col , & ! Input: [real(r8) (:) ] threshold gravimetric soil moisture based on clay content + mss_frc_cly_vld => soilstate_inst%mss_frc_cly_vld_col , & ! Input: [real(r8) (:) ] [frc] Mass fraction clay limited to 0.20 + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] saturated volumetric soil water + + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid soil water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] frozen soil water (kg/m2) + + fv => frictionvel_inst%fv_patch , & ! Input: [real(r8) (:) ] friction velocity (m/s) (for dust model) + u10 => frictionvel_inst%u10_patch , & ! Input: [real(r8) (:) ] 10-m wind (m/s) (created for dust model) + + mbl_bsn_fct => dust_inst%mbl_bsn_fct_col , & ! Input: [real(r8) (:) ] basin factor + flx_mss_vrt_dst => dust_inst%flx_mss_vrt_dst_patch , & ! Output: [real(r8) (:,:) ] surface dust emission (kg/m**2/s) + flx_mss_vrt_dst_tot => dust_inst%flx_mss_vrt_dst_tot_patch & ! Output: [real(r8) (:) ] total dust flux back to atmosphere (pft) + ) + + ttlai(bounds%begp : bounds%endp) = 0._r8 + ! make lai average at landunit level + do fp = 1,num_nolakep + p = filter_nolakep(fp) + ttlai(p) = tlai(p)+tsai(p) + enddo + + tlai_lu(bounds%begl : bounds%endl) = spval + sumwt(bounds%begl : bounds%endl) = 0._r8 + do p = bounds%begp,bounds%endp + if (ttlai(p) /= spval .and. patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then + c = patch%column(p) + l = patch%landunit(p) + if (sumwt(l) == 0._r8) tlai_lu(l) = 0._r8 + tlai_lu(l) = tlai_lu(l) + ttlai(p) * patch%wtlunit(p) + sumwt(l) = sumwt(l) + patch%wtlunit(p) + end if + end do + found = .false. + do l = bounds%begl,bounds%endl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + exit + else if (sumwt(l) /= 0._r8) then + tlai_lu(l) = tlai_lu(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*) 'p2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Loop through patches + + ! initialize variables which get passed to the atmosphere + flx_mss_vrt_dst(bounds%begp:bounds%endp,:)=0._r8 + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) + + ! the following code from subr. lnd_frc_mbl_get was adapted for lsm use + ! purpose: return fraction of each gridcell suitable for dust mobilization + + ! the "bare ground" fraction of the current sub-gridscale cell decreases + ! linearly from 1 to 0 as VAI(=tlai+tsai) increases from 0 to vai_mbl_thr + ! if ice sheet, wetland, or lake, no dust allowed + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (tlai_lu(l) < vai_mbl_thr) then + lnd_frc_mbl(p) = 1.0_r8 - (tlai_lu(l))/vai_mbl_thr + else + lnd_frc_mbl(p) = 0.0_r8 + endif + lnd_frc_mbl(p) = lnd_frc_mbl(p) * (1.0_r8 - frac_sno(c)) + else + lnd_frc_mbl(p) = 0.0_r8 + end if + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p)>1.0_r8 .or. lnd_frc_mbl(p)<0.0_r8) then + write(iulog,*)'Error dstmbl: pft= ',p,' lnd_frc_mbl(p)= ',lnd_frc_mbl(p) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do + + ! reset history output variables before next if-statement to avoid output = inf + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + flx_mss_vrt_dst_tot(p) = 0.0_r8 + end do + do n = 1, ndst + do fp = 1,num_nolakep + p = filter_nolakep(fp) + flx_mss_vrt_dst(p,n) = 0.0_r8 + end do + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + ! only perform the following calculations if lnd_frc_mbl is non-zero + + if (lnd_frc_mbl(p) > 0.0_r8) then + + ! the following comes from subr. frc_thr_rgh_fct_get + ! purpose: compute factor by which surface roughness increases threshold + ! friction velocity (currently a constant) + + frc_thr_rgh_fct = 1.0_r8 + + ! the following comes from subr. frc_thr_wet_fct_get + ! purpose: compute factor by which soil moisture increases threshold friction velocity + ! adjust threshold velocity for inhibition by moisture + ! modified 4/5/2002 (slevis) to use gravimetric instead of volumetric + ! water content + + bd = (1._r8-watsat(c,1))*2.7e3_r8 ![kg m-3] Bulk density of dry surface soil + gwc_sfc = h2osoi_vol(c,1)*SHR_CONST_RHOFW/bd ![kg kg-1] Gravimetric H2O cont + if (gwc_sfc > gwc_thr(c)) then + frc_thr_wet_fct = sqrt(1.0_r8 + 1.21_r8 * (100.0_r8*(gwc_sfc - gwc_thr(c)))**0.68_r8) + else + frc_thr_wet_fct = 1.0_r8 + end if + + ! slevis: adding liqfrac here, because related to effects from soil water + + liqfrac = max( 0.0_r8, min( 1.0_r8, h2osoi_liq(c,1) / (h2osoi_ice(c,1)+h2osoi_liq(c,1)+1.0e-6_r8) ) ) + + ! the following lines come from subr. dst_mbl + ! purpose: adjust threshold friction velocity to acct for moisture and + ! roughness. The ratio tmp1 / sqrt(forc_rho) comes from + ! subr. wnd_frc_thr_slt_get which computes dry threshold + ! friction velocity for saltation + + wnd_frc_thr_slt = tmp1 / sqrt(forc_rho(c)) * frc_thr_wet_fct * frc_thr_rgh_fct + + ! reset these variables which will be updated in the following if-block + + wnd_frc_slt = fv(p) + flx_mss_hrz_slt_ttl = 0.0_r8 + flx_mss_vrt_dst_ttl(p) = 0.0_r8 + + ! the following line comes from subr. dst_mbl + ! purpose: threshold saltation wind speed + + wnd_rfr_thr_slt = u10(p) * wnd_frc_thr_slt / fv(p) + + ! the following if-block comes from subr. wnd_frc_slt_get + ! purpose: compute the saltating friction velocity + ! theory: saltation roughens the boundary layer, AKA "Owen's effect" + + if (u10(p) >= wnd_rfr_thr_slt) then + wnd_rfr_dlt = u10(p) - wnd_rfr_thr_slt + wnd_frc_slt_dlt = 0.003_r8 * wnd_rfr_dlt * wnd_rfr_dlt + wnd_frc_slt = fv(p) + wnd_frc_slt_dlt + end if + + ! the following comes from subr. flx_mss_hrz_slt_ttl_Whi79_get + ! purpose: compute vertically integrated streamwise mass flux of particles + + if (wnd_frc_slt > wnd_frc_thr_slt) then + wnd_frc_rat = wnd_frc_thr_slt / wnd_frc_slt + flx_mss_hrz_slt_ttl = cst_slt * forc_rho(c) * (wnd_frc_slt**3.0_r8) * & + (1.0_r8 - wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) / grav + + ! the following loop originates from subr. dst_mbl + ! purpose: apply land sfc and veg limitations and global tuning factor + ! slevis: multiply flx_mss_hrz_slt_ttl by liqfrac to incude the effect + ! of frozen soil + + flx_mss_hrz_slt_ttl = flx_mss_hrz_slt_ttl * lnd_frc_mbl(p) * mbl_bsn_fct(c) * & + flx_mss_fdg_fct * liqfrac + end if + + ! the following comes from subr. flx_mss_vrt_dst_ttl_MaB95_get + ! purpose: diagnose total vertical mass flux of dust from vertically + ! integrated streamwise mass flux + + dst_slt_flx_rat_ttl = 100.0_r8 * exp( log(10.0_r8) * (13.4_r8 * mss_frc_cly_vld(c) - 6.0_r8) ) + flx_mss_vrt_dst_ttl(p) = flx_mss_hrz_slt_ttl * dst_slt_flx_rat_ttl + + end if ! lnd_frc_mbl > 0.0 + + end do + + ! the following comes from subr. flx_mss_vrt_dst_prt in C. Zender's code + ! purpose: partition total vertical mass flux of dust into transport bins + + do n = 1, ndst + do m = 1, dst_src_nbr + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p) > 0.0_r8) then + flx_mss_vrt_dst(p,n) = flx_mss_vrt_dst(p,n) + ovr_src_snk_mss(m,n) * flx_mss_vrt_dst_ttl(p) + end if + end do + end do + end do + + do n = 1, ndst + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p) > 0.0_r8) then + flx_mss_vrt_dst_tot(p) = flx_mss_vrt_dst_tot(p) + flx_mss_vrt_dst(p,n) + end if + end do + end do + + end associate + + end subroutine DustEmission + + !------------------------------------------------------------------------ + subroutine DustDryDep (bounds, & + atm2lnd_inst, frictionvel_inst, dust_inst) + ! + ! !DESCRIPTION: + ! + ! Determine Turbulent dry deposition for dust. Calculate the turbulent + ! component of dust dry deposition, (the turbulent deposition velocity + ! through the lowest atmospheric layer. CAM will calculate the settling + ! velocity through the whole atmospheric column. The two calculations + ! will determine the dust dry deposition flux to the surface. + ! Note: Same process should occur over oceans. For the coupled CESM, + ! we may find it more efficient to let CAM calculate the turbulent dep + ! velocity over all surfaces. This would require passing the + ! aerodynamic resistance, ram(1), and the friction velocity, fv, from + ! the land to the atmosphere component. In that case, dustini need not + ! calculate particle diamter (dmt_vwr) and particle density (dns_aer). + ! Source: C. Zender's dry deposition code + ! + ! !USES + use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RDAIR, SHR_CONST_BOLTZ + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(dust_type) , intent(inout) :: dust_inst + ! + ! !LOCAL VARIABLES + integer :: p,c,g,m,n ! indices + real(r8) :: vsc_dyn_atm(bounds%begp:bounds%endp) ! [kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm(bounds%begp:bounds%endp) ! [m2 s-1] Kinematic viscosity of atmosphere + real(r8) :: shm_nbr_xpn ! [frc] Sfc-dep exponent for aerosol-diffusion dependence on Schmidt number + real(r8) :: shm_nbr ! [frc] Schmidt number + real(r8) :: stk_nbr ! [frc] Stokes number + real(r8) :: mfp_atm ! [m] Mean free path of air + real(r8) :: dff_aer ! [m2 s-1] Brownian diffusivity of particle + real(r8) :: rss_trb ! [s m-1] Resistance to turbulent deposition + real(r8) :: slp_crc(bounds%begp:bounds%endp,ndst) ! [frc] Slip correction factor + real(r8) :: vlc_grv(bounds%begp:bounds%endp,ndst) ! [m s-1] Settling velocity + real(r8) :: rss_lmn(bounds%begp:bounds%endp,ndst) ! [s m-1] Quasi-laminar layer resistance + real(r8) :: tmp ! temporary + real(r8), parameter::shm_nbr_xpn_lnd=-2._r8/3._r8 ![frc] shm_nbr_xpn over land + !------------------------------------------------------------------------ + + associate( & + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atm pressure (Pa) + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] atm density (kg/m**3) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atm temperature (K) + + ram1 => frictionvel_inst%ram1_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance (s/m) + fv => frictionvel_inst%fv_patch , & ! Input: [real(r8) (:) ] friction velocity (m/s) + + vlc_trb => dust_inst%vlc_trb_patch , & ! Output: [real(r8) (:,:) ] Turbulent deposn velocity (m/s) + vlc_trb_1 => dust_inst%vlc_trb_1_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 1 + vlc_trb_2 => dust_inst%vlc_trb_2_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 2 + vlc_trb_3 => dust_inst%vlc_trb_3_patch , & ! Output: [real(r8) (:) ] Turbulent deposition velocity 3 + vlc_trb_4 => dust_inst%vlc_trb_4_patch & ! Output: [real(r8) (:) ] Turbulent deposition velocity 4 + ) + + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + g = patch%gridcell(p) + c = patch%column(p) + + ! from subroutine dst_dps_dry (consider adding sanity checks from line 212) + ! when code asks to use midlayer density, pressure, temperature, + ! I use the data coming in from the atmosphere, ie forc_t, forc_pbot, forc_rho + + ! Quasi-laminar layer resistance: call rss_lmn_get + ! Size-independent thermokinetic properties + + vsc_dyn_atm(p) = 1.72e-5_r8 * ((forc_t(c)/273.0_r8)**1.5_r8) * 393.0_r8 / & + (forc_t(c)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102 + mfp_atm = 2.0_r8 * vsc_dyn_atm(p) / & ![m] SeP97 p. 455 + (forc_pbot(c)*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*forc_t(c)))) + vsc_knm_atm(p) = vsc_dyn_atm(p) / forc_rho(c) ![m2 s-1] Kinematic viscosity of air + + do m = 1, ndst + slp_crc(p,m) = 1.0_r8 + 2.0_r8 * mfp_atm * & + (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / & + dmt_vwr(m) ![frc] Slip correction factor SeP97 p. 464 + vlc_grv(p,m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * & + grav * slp_crc(p,m) / vsc_dyn_atm(p) ![m s-1] Stokes' settling velocity SeP97 p. 466 + vlc_grv(p,m) = vlc_grv(p,m) * stk_crc(m) ![m s-1] Correction to Stokes settling velocity + end do + end if + end do + + do m = 1, ndst + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + g = patch%gridcell(p) + c = patch%column(p) + + stk_nbr = vlc_grv(p,m) * fv(p) * fv(p) / (grav * vsc_knm_atm(p)) ![frc] SeP97 p.965 + dff_aer = SHR_CONST_BOLTZ * forc_t(c) * slp_crc(p,m) / & ![m2 s-1] + (3.0_r8*SHR_CONST_PI * vsc_dyn_atm(p) * dmt_vwr(m)) !SeP97 p.474 + shm_nbr = vsc_knm_atm(p) / dff_aer ![frc] SeP97 p.972 + shm_nbr_xpn = shm_nbr_xpn_lnd ![frc] + + ! fxm: Turning this on dramatically reduces + ! deposition velocity in low wind regimes + ! Schmidt number exponent is -2/3 over solid surfaces and + ! -1/2 over liquid surfaces SlS80 p. 1014 + ! if (oro(i)==0.0) shm_nbr_xpn=shm_nbr_xpn_ocn else shm_nbr_xpn=shm_nbr_xpn_lnd + ! [frc] Surface-dependent exponent for aerosol-diffusion dependence on Schmidt # + + tmp = shm_nbr**shm_nbr_xpn + 10.0_r8**(-3.0_r8/stk_nbr) + rss_lmn(p,m) = 1.0_r8 / (tmp * fv(p)) ![s m-1] SeP97 p.972,965 + end if + end do + end do + + ! Lowest layer: Turbulent deposition (CAM will calc. gravitational dep) + + do m = 1, ndst + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + rss_trb = ram1(p) + rss_lmn(p,m) + ram1(p) * rss_lmn(p,m) * vlc_grv(p,m) ![s m-1] + vlc_trb(p,m) = 1.0_r8 / rss_trb ![m s-1] + end if + end do + end do + + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + vlc_trb_1(p) = vlc_trb(p,1) + vlc_trb_2(p) = vlc_trb(p,2) + vlc_trb_3(p) = vlc_trb(p,3) + vlc_trb_4(p) = vlc_trb(p,4) + end if + end do + + end associate + + end subroutine DustDryDep + + !------------------------------------------------------------------------ + subroutine InitDustVars(this, bounds) + ! + ! !DESCRIPTION: + ! + ! Compute source efficiency factor from topography + ! Initialize other variables used in subroutine Dust: + ! ovr_src_snk_mss(m,n) and tmp1. + ! Define particle diameter and density needed by atm model + ! as well as by dry dep model + ! Source: Paul Ginoux (for source efficiency factor) + ! Modifications by C. Zender and later by S. Levis + ! Rest of subroutine from C. Zender's dust model + ! + ! !USES + use shr_const_mod , only: SHR_CONST_PI, SHR_CONST_RDAIR + use shr_spfn_mod , only: erf => shr_spfn_erf + use decompMod , only : get_proc_bounds + ! + ! !ARGUMENTS: + class(dust_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES + integer :: fc,c,l,m,n ! indices + real(r8) :: ovr_src_snk_frc + real(r8) :: sqrt2lngsdi ! [frc] Factor in erf argument + real(r8) :: lndmaxjovrdmdni ! [frc] Factor in erf argument + real(r8) :: lndminjovrdmdni ! [frc] Factor in erf argument + real(r8) :: ryn_nbr_frc_thr_prx_opt ! [frc] Threshold friction Reynolds number approximation for optimal size + real(r8) :: ryn_nbr_frc_thr_opt_fnc ! [frc] Threshold friction Reynolds factor for saltation calculation + real(r8) :: icf_fct ! Interpartical cohesive forces factor for saltation calc + real(r8) :: dns_fct ! Density ratio factor for saltation calculation + real(r8) :: dmt_min(ndst) ! [m] Size grid minimum + real(r8) :: dmt_max(ndst) ! [m] Size grid maximum + real(r8) :: dmt_ctr(ndst) ! [m] Diameter at bin center + real(r8) :: dmt_dlt(ndst) ! [m] Width of size bin + real(r8) :: slp_crc(ndst) ! [frc] Slip correction factor + real(r8) :: vlm_rsl(ndst) ! [m3 m-3] Volume concentration resolved + real(r8) :: vlc_stk(ndst) ! [m s-1] Stokes settling velocity + real(r8) :: vlc_grv(ndst) ! [m s-1] Settling velocity + real(r8) :: ryn_nbr_grv(ndst) ! [frc] Reynolds number at terminal velocity + real(r8) :: cff_drg_grv(ndst) ! [frc] Drag coefficient at terminal velocity + real(r8) :: tmp ! temporary + real(r8) :: ln_gsd ! [frc] ln(gsd) + real(r8) :: gsd_anl ! [frc] Geometric standard deviation + real(r8) :: dmt_vma ! [m] Mass median diameter analytic She84 p.75 Tabl.1 + real(r8) :: dmt_nma ! [m] Number median particle diameter + real(r8) :: lgn_dst ! Lognormal distribution at sz_ctr + real(r8) :: eps_max ! [frc] Relative accuracy for convergence + real(r8) :: eps_crr ! [frc] Current relative accuracy + real(r8) :: itr_idx ! [idx] Counting index + real(r8) :: dns_mdp ! [kg m-3] Midlayer density + real(r8) :: mfp_atm ! [m] Mean free path of air + real(r8) :: vsc_dyn_atm ! [kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm ! [kg m-1 s-1] Kinematic viscosity of air + real(r8) :: vlc_grv_old ! [m s-1] Previous gravitational settling velocity + real(r8) :: series_ratio ! Factor for logarithmic grid + real(r8) :: lngsdsqrttwopi_rcp ! Factor in lognormal distribution + real(r8) :: sz_min(sz_nbr) ! [m] Size Bin minima + real(r8) :: sz_max(sz_nbr) ! [m] Size Bin maxima + real(r8) :: sz_ctr(sz_nbr) ! [m] Size Bin centers + real(r8) :: sz_dlt(sz_nbr) ! [m] Size Bin widths + + ! constants + real(r8), allocatable :: dmt_vma_src(:) ! [m] Mass median diameter BSM96 p. 73 Table 2 + real(r8), allocatable :: gsd_anl_src(:) ! [frc] Geometric std deviation BSM96 p. 73 Table 2 + real(r8), allocatable :: mss_frc_src(:) ! [frc] Mass fraction BSM96 p. 73 Table 2 + + real(r8) :: dmt_grd(5) = & ! [m] Particle diameter grid + (/ 0.1e-6_r8, 1.0e-6_r8, 2.5e-6_r8, 5.0e-6_r8, 10.0e-6_r8 /) + real(r8), parameter :: dmt_slt_opt = 75.0e-6_r8 ! [m] Optim diam for saltation + real(r8), parameter :: dns_slt = 2650.0_r8 ! [kg m-3] Density of optimal saltation particles + !------------------------------------------------------------------------ + + associate(& + mbl_bsn_fct => this%mbl_bsn_fct_col & ! Output: [real(r8) (:)] basin factor + ) + + ! allocate module variable + allocate (ovr_src_snk_mss(dst_src_nbr,ndst)) + allocate (dmt_vwr(ndst)) + allocate (stk_crc(ndst)) + + ! allocate local variable + allocate (dmt_vma_src(dst_src_nbr)) + allocate (gsd_anl_src(dst_src_nbr)) + allocate (mss_frc_src(dst_src_nbr)) + + dmt_vma_src(:) = (/ 0.832e-6_r8 , 4.82e-6_r8 , 19.38e-6_r8 /) + gsd_anl_src(:) = (/ 2.10_r8 , 1.90_r8 , 1.60_r8 /) + mss_frc_src(:) = (/ 0.036_r8 , 0.957_r8 , 0.007_r8 /) + + ! the following comes from (1) szdstlgn.F subroutine ovr_src_snk_frc_get + ! and (2) dstszdst.F subroutine dst_szdst_ini + ! purpose(1): given one set (the "source") of lognormal distributions, + ! and one set of bin boundaries (the "sink"), compute and return + ! the overlap factors between the source and sink distributions + ! purpose(2): set important statistics of size distributions + + do m = 1, dst_src_nbr + sqrt2lngsdi = sqrt(2.0_r8) * log(gsd_anl_src(m)) + do n = 1, ndst + lndmaxjovrdmdni = log(dmt_grd(n+1)/dmt_vma_src(m)) + lndminjovrdmdni = log(dmt_grd(n )/dmt_vma_src(m)) + ovr_src_snk_frc = 0.5_r8 * (erf(lndmaxjovrdmdni/sqrt2lngsdi) - & + erf(lndminjovrdmdni/sqrt2lngsdi)) + ovr_src_snk_mss(m,n) = ovr_src_snk_frc * mss_frc_src(m) + end do + end do + + ! The following code from subroutine wnd_frc_thr_slt_get was placed + ! here because tmp1 needs to be defined just once + + ryn_nbr_frc_thr_prx_opt = 0.38_r8 + 1331.0_r8 * (100.0_r8*dmt_slt_opt)**1.56_r8 + + if (ryn_nbr_frc_thr_prx_opt < 0.03_r8) then + write(iulog,*) 'dstmbl: ryn_nbr_frc_thr_prx_opt < 0.03' + call endrun(msg=errMsg(__FILE__, __LINE__)) + else if (ryn_nbr_frc_thr_prx_opt < 10.0_r8) then + ryn_nbr_frc_thr_opt_fnc = -1.0_r8 + 1.928_r8 * (ryn_nbr_frc_thr_prx_opt**0.0922_r8) + ryn_nbr_frc_thr_opt_fnc = 0.1291_r8 * 0.1291_r8 / ryn_nbr_frc_thr_opt_fnc + else + ryn_nbr_frc_thr_opt_fnc = 1.0_r8 - 0.0858_r8 * exp(-0.0617_r8*(ryn_nbr_frc_thr_prx_opt-10.0_r8)) + ryn_nbr_frc_thr_opt_fnc = 0.120_r8 * 0.120_r8 * ryn_nbr_frc_thr_opt_fnc * ryn_nbr_frc_thr_opt_fnc + end if + + icf_fct = 1.0_r8 + 6.0e-07_r8 / (dns_slt * grav * (dmt_slt_opt**2.5_r8)) + dns_fct = dns_slt * grav * dmt_slt_opt + tmp1 = sqrt(icf_fct * dns_fct * ryn_nbr_frc_thr_opt_fnc) + + ! Introducing particle diameter. Needed by atm model and by dry dep model. + ! Taken from Charlie Zender's subroutines dst_psd_ini, dst_sz_rsl, + ! grd_mk (dstpsd.F90) and subroutine lgn_evl (psdlgn.F90) + + ! Charlie allows logarithmic or linear option for size distribution + ! however, he hardwires the distribution to logarithmic in his code + ! therefore, I take his logarithmic code only + ! furthermore, if dst_nbr == 4, he overrides the automatic grid calculation + ! he currently works with dst_nbr = 4, so I only take the relevant code + ! if ndst ever becomes different from 4, must add call grd_mk (dstpsd.F90) + ! as done in subroutine dst_psd_ini + ! note that here ndst = dst_nbr + + ! Override automatic grid with preset grid if available + + if (ndst == 4) then + do n = 1, ndst + dmt_min(n) = dmt_grd(n) ![m] Max diameter in bin + dmt_max(n) = dmt_grd(n+1) ![m] Min diameter in bin + dmt_ctr(n) = 0.5_r8 * (dmt_min(n)+dmt_max(n)) ![m] Diameter at bin ctr + dmt_dlt(n) = dmt_max(n)-dmt_min(n) ![m] Width of size bin + end do + else + write(iulog,*) 'Dustini error: ndst must equal to 4 with current code' + call endrun(msg=errMsg(__FILE__, __LINE__)) + !see more comments above end if ndst == 4 + end if + + ! Bin physical properties + + gsd_anl = 2.0_r8 ! [frc] Geometric std dev PaG77 p. 2080 Table1 + ln_gsd = log(gsd_anl) + dns_aer = 2.5e+3_r8 ! [kg m-3] Aerosol density + + ! Set a fundamental statistic for each bin + + dmt_vma = 3.5000e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + + ! Compute analytic size statistics + ! Convert mass median diameter to number median diameter (call vma2nma) + + dmt_nma = dmt_vma * exp(-3.0_r8*ln_gsd*ln_gsd) ! [m] + + ! Compute resolved size statistics for each size distribution + ! In C. Zender's code call dst_sz_rsl + + do n = 1, ndst + + series_ratio = (dmt_max(n)/dmt_min(n))**(1.0_r8/sz_nbr) + sz_min(1) = dmt_min(n) + do m = 2, sz_nbr ! Loop starts at 2 + sz_min(m) = sz_min(m-1) * series_ratio + end do + + ! Derived grid values + do m = 1, sz_nbr-1 ! Loop ends at sz_nbr-1 + sz_max(m) = sz_min(m+1) ! [m] + end do + sz_max(sz_nbr) = dmt_max(n) ! [m] + + ! Final derived grid values + do m = 1, sz_nbr + sz_ctr(m) = 0.5_r8 * (sz_min(m)+sz_max(m)) + sz_dlt(m) = sz_max(m)-sz_min(m) + end do + + lngsdsqrttwopi_rcp = 1.0_r8 / (ln_gsd*sqrt(2.0_r8*SHR_CONST_PI)) + dmt_vwr(n) = 0.0_r8 ! [m] Mass wgted diameter resolved + vlm_rsl(n) = 0.0_r8 ! [m3 m-3] Volume concentration resolved + + do m = 1, sz_nbr + + ! Evaluate lognormal distribution for these sizes (call lgn_evl) + tmp = log(sz_ctr(m)/dmt_nma) / ln_gsd + lgn_dst = lngsdsqrttwopi_rcp * exp(-0.5_r8*tmp*tmp) / sz_ctr(m) + + ! Integrate moments of size distribution + dmt_vwr(n) = dmt_vwr(n) + sz_ctr(m) * & + SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + vlm_rsl(n) = vlm_rsl(n) + & + SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + + end do + + dmt_vwr(n) = dmt_vwr(n) / vlm_rsl(n) ![m] Mass weighted diameter resolved + + end do + + ! calculate correction to Stokes' settling velocity (subroutine stk_crc_get) + + eps_max = 1.0e-4_r8 + dns_mdp = 100000._r8 / (295.0_r8*SHR_CONST_RDAIR) ![kg m-3] const prs_mdp & tpt_vrt + + ! Size-independent thermokinetic properties + + vsc_dyn_atm = 1.72e-5_r8 * ((295.0_r8/273.0_r8)**1.5_r8) * 393.0_r8 / & + (295.0_r8+120.0_r8) ![kg m-1 s-1] RoY94 p.102 tpt_mdp=295.0 + mfp_atm = 2.0_r8 * vsc_dyn_atm / & !SeP97 p. 455 constant prs_mdp, tpt_mdp + (100000._r8*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*295.0_r8))) + vsc_knm_atm = vsc_dyn_atm / dns_mdp ![m2 s-1] Kinematic viscosity of air + + do m = 1, ndst + slp_crc(m) = 1.0_r8 + 2.0_r8 * mfp_atm * & + (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / & + dmt_vwr(m) ! [frc] Slip correction factor SeP97 p.464 + vlc_stk(m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * & + grav * slp_crc(m) / vsc_dyn_atm ! [m s-1] SeP97 p.466 + end do + + ! For Reynolds number flows Re < 0.1 Stokes' velocity is valid for + ! vlc_grv SeP97 p. 466 (8.42). For larger Re, inertial effects become + ! important and empirical drag coefficients must be employed + ! Implicit equation for Re, Cd, and Vt is SeP97 p. 467 (8.44) + ! Using Stokes' velocity rather than iterative solution with empirical + ! drag coefficient causes 60% errors for D = 200 um SeP97 p. 468 + + ! Iterative solution for drag coefficient, Reynolds number, and terminal veloc + do m = 1, ndst + + ! Initialize accuracy and counter + eps_crr = eps_max + 1.0_r8 ![frc] Current relative accuracy + itr_idx = 0 ![idx] Counting index + + ! Initial guess for vlc_grv is exact for Re < 0.1 + vlc_grv(m) = vlc_stk(m) ![m s-1] + + do while(eps_crr > eps_max) + + ! Save terminal velocity for convergence test + vlc_grv_old = vlc_grv(m) ![m s-1] + ryn_nbr_grv(m) = vlc_grv(m) * dmt_vwr(m) / vsc_knm_atm !SeP97 p.460 + + ! Update drag coefficient based on new Reynolds number + if (ryn_nbr_grv(m) < 0.1_r8) then + cff_drg_grv(m) = 24.0_r8 / ryn_nbr_grv(m) !Stokes' law Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 3.0_r8*ryn_nbr_grv(m)/16.0_r8 + & + 9.0_r8*ryn_nbr_grv(m)*ryn_nbr_grv(m)* & + log(2.0_r8*ryn_nbr_grv(m))/160.0_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 500.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 0.15_r8*ryn_nbr_grv(m)**0.687_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0e5_r8) then + cff_drg_grv(m) = 0.44_r8 !Sep97 p.463 (8.32) + else + write(iulog,'(a,es9.2)') "ryn_nbr_grv(m) = ",ryn_nbr_grv(m) + write(iulog,*)'Dustini error: Reynolds number too large in stk_crc_get()' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Update terminal velocity based on new Reynolds number and drag coeff + ! [m s-1] Terminal veloc SeP97 p.467 (8.44) + + vlc_grv(m) = sqrt(4.0_r8 * grav * dmt_vwr(m) * slp_crc(m) * dns_aer / & + (3.0_r8*cff_drg_grv(m)*dns_mdp)) + eps_crr = abs((vlc_grv(m)-vlc_grv_old)/vlc_grv(m)) !Relative convergence + if (itr_idx == 12) then + ! Numerical pingpong may occur when Re = 0.1, 2.0, or 500.0 + ! due to discontinuities in derivative of drag coefficient + vlc_grv(m) = 0.5_r8 * (vlc_grv(m)+vlc_grv_old) ! [m s-1] + end if + if (itr_idx > 20) then + write(iulog,*) 'Dustini error: Terminal velocity not converging ',& + ' in stk_crc_get(), breaking loop...' + goto 100 !to next iteration + end if + itr_idx = itr_idx + 1 + + end do !end while + +100 continue !Label to jump to when iteration does not converge + end do !end loop over size + + ! Compute factors to convert Stokes' settling velocities to + ! actual settling velocities + + do m = 1, ndst + stk_crc(m) = vlc_grv(m) / vlc_stk(m) + end do + + end associate + + end subroutine InitDustVars + +end module DUSTMod diff --git a/components/clm/src/biogeochem/DryDepVelocity.F90 b/components/clm/src/biogeochem/DryDepVelocity.F90 new file mode 100644 index 0000000000..6a9e021406 --- /dev/null +++ b/components/clm/src/biogeochem/DryDepVelocity.F90 @@ -0,0 +1,622 @@ +Module DryDepVelocity + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Deposition velocity (m/s) + ! + ! Method: + ! This code simulates dry deposition velocities using the Wesely scheme. + ! Details of this method can be found in: + ! + ! M.L Wesely. Parameterization of surface resistances to gaseous dry deposition + ! in regional-scale numericl models. 1989. Atmospheric Environment vol.23 No.6 + ! pp. 1293-1304. + ! + ! In Wesely (1998) "the magnitude of the dry deposition velocity can be found + ! as: + ! + ! |vd|=(ra+rb+rc)^-1 + ! + ! where ra is the aerodynamic resistance (common to all gases) between a + ! specific height and the surface, rb is the quasilaminar sublayer resistance + ! (whose only dependence on the porperties of the gas of interest is its + ! molecular diffusivity in air), and rc is the bulk surface resistance". + ! + ! In this subroutine both ra and rb are calculated elsewhere in CLM. + ! + ! In Wesely (1989) rc is estimated for five seasonal categories and 11 landuse + ! types. For each season and landuse type, Wesely compiled data into a + ! look-up-table for several parameters used to calculate rc. In this subroutine + ! the same values are used as found in wesely's look-up-tables, the only + ! difference is that this subroutine uses a CLM generated LAI to select values + ! from the look-up-table instead of seasonality. Inaddition, Wesely(1989) + ! land use types are "mapped" into CLM patch types. + ! + ! Subroutine written to operate at the patch level. + ! + ! Output: + ! + ! vd(n_species) !Dry deposition velocity [m s-1] for each molecule or species + ! + ! Author: Beth Holland and James Sulzman + ! + ! Modified: Francis Vitt -- 30 Mar 2007 + ! Modified: Maria Val Martin -- 15 Jan 2014 + ! Corrected major bugs in the leaf and stomatal resitances. The code is now + ! coupled to LAI and Rs uses the Ball-Berry Scheme. Also, corrected minor + ! bugs in rlu and rcl calculations. Added + ! no vegetation removal for CO. See README for details and + ! Val Martin et al., 2014 GRL for major corrections + ! + !********* !!! IMPORTANT !!! ************ + ! STOMATAL RESISTANCE IS OPTIMIZED TO MATCH UP OBSERVATIONS + !----------------------------------------------------------------------- + + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_time_manager , only : get_nstep, get_curr_date, get_curr_time + use spmdMod , only : masterproc + use seq_drydep_mod , only : n_drydep, drydep_list + use seq_drydep_mod , only : drydep_method, DD_XLND + use seq_drydep_mod , only : index_o3=>o3_ndx, index_o3a=>o3a_ndx, index_so2=>so2_ndx, index_h2=>h2_ndx + use seq_drydep_mod , only : index_co=>co_ndx, index_ch4=>ch4_ndx, index_pan=>pan_ndx + use seq_drydep_mod , only : index_xpan=>xpan_ndx + use decompMod , only : bounds_type + use clm_varcon , only : namep + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use FrictionVelocityMod , only : frictionvel_type + use PhotosynthesisMod , only : photosyns_type + use WaterstateType , only : waterstate_type + use GridcellType , only : grc + use LandunitType , only : lun + use PatchType , only : patch + ! + implicit none + private + ! + public :: depvel_compute + ! + type, public :: drydepvel_type + + real(r8), pointer, public :: velocity_patch (:,:) ! Dry Deposition Velocity + + contains + + procedure , public :: Init + procedure , private :: InitAllocate + + end type drydepvel_type + !----------------------------------------------------------------------- + +CONTAINS + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(drydepvel_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + ! + ! !ARGUMENTS: + class(drydepvel_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + + ! Dry Deposition Velocity + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + allocate(this%velocity_patch(begp:endp, n_drydep)); this%velocity_patch(:,:) = nan + end if + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine depvel_compute( bounds, & + atm2lnd_inst, canopystate_inst, waterstate_inst, frictionvel_inst, & + photosyns_inst, drydepvel_inst) + ! + ! !DESCRIPTION: + ! computes the dry deposition velocity of tracers + ! + ! !USES: + use shr_const_mod , only : tmelt => shr_const_tkfrz + use seq_drydep_mod , only : seq_drydep_setHCoeff, mapping, drat, foxd + use seq_drydep_mod , only : rcls, h2_a, h2_b, h2_c, ri, rac, rclo, rlu, rgss, rgso + use landunit_varcon, only : istsoil, istice, istice_mec, istdlak, istwet + use clm_varctl , only : iulog + use pftconMod , only : noveg, ndllf_evr_tmp_tree, ndllf_evr_brl_tree + use pftconMod , only : ndllf_dcd_brl_tree, nbrdlf_evr_trp_tree + use pftconMod , only : nbrdlf_evr_tmp_tree, nbrdlf_dcd_trp_tree + use pftconMod , only : nbrdlf_dcd_tmp_tree, nbrdlf_dcd_brl_tree + use pftconMod , only : nbrdlf_evr_shrub, nbrdlf_dcd_tmp_shrub + use pftconMod , only : nbrdlf_dcd_brl_shrub,nc3_arctic_grass + use pftconMod , only : nc3_nonarctic_grass, nc4_grass, nc3crop + use pftconMod , only : nc3irrig, npcropmin, npcropmax + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(drydepvel_type) , intent(inout) :: drydepvel_inst + ! + ! !LOCAL VARIABLES: + integer :: c + real(r8) :: soilw, var_soilw, fact_h2, dv_soil_h2 + integer :: pi,g, l + integer :: ispec + integer :: length + integer :: wesveg !wesely vegegation index + integer :: clmveg !clm veg index from ivegtype + integer :: i + integer :: index_season !seasonal index based on LAI. This indexs wesely data tables + integer :: nstep !current step + integer :: indexp + + real(r8) :: pg ! surface pressure + real(r8) :: tc ! temperature in celsius + real(r8) :: rs ! constant for calculating rsmx + real(r8) :: es ! saturation vapor pressur + real(r8) :: ws ! saturation mixing ratio + real(r8) :: rmx ! resistance by vegetation + real(r8) :: qs ! saturation specific humidity + real(r8) :: dewm ! multiplier for rs when dew occurs + real(r8) :: crs ! multiplier to calculate crs + real(r8) :: rdc ! part of lower canopy resistance + real(r8) :: rain ! rain fall + real(r8) :: spec_hum ! specific humidity + real(r8) :: solar_flux ! solar radiation(direct beam) W/m2 + real(r8) :: lat ! latitude in degrees + real(r8) :: lon ! longitude in degrees + real(r8) :: sfc_temp ! surface temp + real(r8) :: minlai ! minimum of monthly lai + real(r8) :: maxlai ! maximum of monthly lai + real(r8) :: rds ! resistance for aerosols + + !mvm 11/30/2013 + real(r8) :: rlu_lai ! constant to calculate rlu over bulk canopy + real(r8) :: rs_factor ! constant to optimize stomatal resistance + + logical :: has_dew + logical :: has_rain + real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s + + ! local arrays: dependent on species only + real(r8), dimension(n_drydep) :: rsmx !vegetative resistance (plant mesophyll) + real(r8), dimension(n_drydep) :: rclx !lower canopy resistance + real(r8), dimension(n_drydep) :: rlux !vegetative resistance (upper canopy) + real(r8), dimension(n_drydep) :: rgsx !gournd resistance + real(r8), dimension(n_drydep) :: heff + real(r8) :: rc !combined surface resistance + real(r8) :: cts !correction to flu rcl and rgs for frost + real(r8) :: rlux_o3 !to calculate O3 leaf resistance in dew/rain conditions + + ! constants + real(r8), parameter :: slope = 0._r8 ! Used to calculate rdc in (lower canopy resistance) + integer, parameter :: wveg_unset = -1 ! Unset Wesley vegetation type + character(len=32), parameter :: subname = "depvel_compute" + + ! jfl : mods for PAN + real(r8) :: dv_pan + real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, & + 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /) + real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, & + 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) + !----------------------------------------------------------------------- + + if ( n_drydep == 0 .or. drydep_method /= DD_XLND ) return + + associate( & + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only) + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) + forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric specific humidity (kg/kg) + forc_psrf => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] downscaled surface pressure (Pa) + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] downscaled rain rate [mm/s] + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + + ram1 => frictionvel_inst%ram1_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance + rb1 => frictionvel_inst%rb1_patch , & ! Input: [real(r8) (:) ] leaf boundary layer resistance [s/m] + vds => frictionvel_inst%vds_patch , & ! Input: [real(r8) (:) ] aerodynamical resistance + + rssun => photosyns_inst%rssun_patch , & ! Input: [real(r8) (:) ] stomatal resistance + rssha => photosyns_inst%rssha_patch , & ! Input: [real(r8) (:) ] shaded stomatal resistance (s/m) + + fsun => canopystate_inst%fsun_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + mlaidiff => canopystate_inst%mlaidiff_patch , & ! Input: [real(r8) (:) ] difference in lai between month one and month two + annlai => canopystate_inst%annlai_patch , & ! Input: [real(r8) (:,:) ] 12 months of monthly lai from input data set + + velocity => drydepvel_inst%velocity_patch & ! Output: [real(r8) (:,:) ] cm/sec + ) + + !_________________________________________________________________ + ! Begin loop through patches + + pft_loop: do pi = bounds%begp,bounds%endp + l = patch%landunit(pi) + + active: if (patch%active(pi)) then + + c = patch%column(pi) + g = patch%gridcell(pi) + pg = forc_psrf(c) + spec_hum = forc_q(c) + rain = forc_rain(c) + sfc_temp = forc_t(c) + solar_flux = forc_solad(g,1) + lat = grc%latdeg(g) + lon = grc%londeg(g) + clmveg = patch%itype(pi) + soilw = h2osoi_vol(c,1) + + !map CLM veg type into Wesely veg type + wesveg = wveg_unset + if (clmveg == noveg ) wesveg = 8 + if (clmveg == ndllf_evr_tmp_tree ) wesveg = 5 + if (clmveg == ndllf_evr_brl_tree ) wesveg = 5 + if (clmveg == ndllf_dcd_brl_tree ) wesveg = 5 + if (clmveg == nbrdlf_evr_trp_tree ) wesveg = 4 + if (clmveg == nbrdlf_evr_tmp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_trp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_tmp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_brl_tree ) wesveg = 4 + if (clmveg == nbrdlf_evr_shrub ) wesveg = 11 + if (clmveg == nbrdlf_dcd_tmp_shrub ) wesveg = 11 + if (clmveg == nbrdlf_dcd_brl_shrub ) wesveg = 11 + if (clmveg == nc3_arctic_grass ) wesveg = 3 + if (clmveg == nc3_nonarctic_grass ) wesveg = 3 + if (clmveg == nc4_grass ) wesveg = 3 + if (clmveg == nc3crop ) wesveg = 2 + if (clmveg == nc3irrig ) wesveg = 2 + if (clmveg >= npcropmin .and. clmveg <= npcropmax ) wesveg = 2 + if (wesveg == wveg_unset )then + write(iulog,*) 'clmveg = ', clmveg, 'lun%itype = ', lun%itype(l) + call endrun(decomp_index=pi, clmlevel=namep, & + msg='ERROR: Not able to determine Wesley vegetation type'//& + errMsg(__FILE__, __LINE__)) + end if + + ! create seasonality index used to index wesely data tables from LAI, Bascially + !if elai is between max lai from input data and half that max the index_season=1 + + + !mail1j and mlai2j are the two monthly lai values pulled from a CLM input data set + !/fs/cgd/csm/inputdata/lnd/clm2/rawdata/mksrf_lai.nc. lai for dates in the middle + !of the month are interpolated using using these values and stored in the variable + !elai (done elsewhere). If the difference between mlai1j and mlai2j is greater + !than zero it is assumed to be fall and less than zero it is assumed to be spring. + + !wesely seasonal "index_season" + ! 1 - midsummer with lush vegetation + ! 2 - Autumn with unharvested cropland + ! 3 - Late autumn after frost, no snow + ! 4 - Winter, snow on ground and subfreezing + ! 5 - Transitional spring with partially green short annuals + + + !mlaidiff=jan-feb + minlai=minval(annlai(:,pi)) + maxlai=maxval(annlai(:,pi)) + + index_season = -1 + + if ( lun%itype(l) /= istsoil )then + if ( lun%itype(l) == istice .or. lun%itype(l) == istice_mec ) then + wesveg = 8 + index_season = 4 + elseif ( lun%itype(l) == istdlak ) then + wesveg = 7 + index_season = 4 + elseif ( lun%itype(l) == istwet ) then + wesveg = 9 + index_season = 2 + elseif ( lun%urbpoi(l) ) then + wesveg = 1 + index_season = 2 + end if + else if ( snow_depth(c) > 0 ) then + index_season = 4 + else if(elai(pi) > 0.5_r8*maxlai) then + index_season = 1 + endif + + if (index_season<0) then + if (elai(pi) < (minlai+0.05*(maxlai-minlai))) then + index_season = 3 + endif + endif + + if (index_season<0) then + if (mlaidiff(pi) > 0.0_r8) then + index_season = 2 + elseif (mlaidiff(pi) < 0.0_r8) then + index_season = 5 + elseif (mlaidiff(pi).eq.0.0_r8) then + index_season = 3 + endif + endif + + if (index_season<0) then + call endrun('ERROR: not able to determine season'//errmsg(__FILE__, __LINE__)) + endif + + ! saturation specific humidity + ! + es = 611_r8*exp(5414.77_r8*((1._r8/tmelt)-(1._r8/sfc_temp))) + ws = .622_r8*es/(pg-es) + qs = ws/(1._r8+ws) + + has_dew = .false. + if( qs <= spec_hum ) then + has_dew = .true. + end if + if( sfc_temp < tmelt ) then + has_dew = .false. + end if + + has_rain = rain > rain_threshold + + if ( has_dew .or. has_rain ) then + dewm = 3._r8 + else + dewm = 1._r8 + end if + + !Define tc + tc = sfc_temp - tmelt + + ! + ! rdc (lower canopy res) + ! + rdc=100._r8*(1._r8+1000._r8/(solar_flux+10._r8))/(1._r8+1000._r8*slope) + + ! surface resistance : depends on both land type and species + ! land types are computed seperately, then resistance is computed as average of values + ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 + + !******************************************************* + call seq_drydep_setHCoeff( sfc_temp, heff(:n_drydep) ) + !********************************************************* + + species_loop1: do ispec=1, n_drydep + if(mapping(ispec) <= 0) cycle + + if(ispec.eq.index_o3.or.ispec.eq.index_o3a.or.ispec.eq.index_so2) then + rmx=0._r8 + else + rmx=1._r8/((heff(ispec)/3000._r8)+(100._r8*foxd(ispec))) + endif + + ! correction for frost + cts = 1000._r8*exp( -tc - 4._r8 ) + + !ground resistance + rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rgso(index_season,wesveg)+cts))) + + !------------------------------------------------------------------------------------- + ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) + !------------------------------------------------------------------------------------- + if( ispec == index_h2 .or. ispec == index_co .or. ispec == index_ch4 ) then + + if( ispec == index_co ) then + fact_h2 = 1.0_r8 + elseif ( ispec == index_h2 ) then + fact_h2 = 0.5_r8 + elseif ( ispec == index_ch4 ) then + fact_h2 = 50.0_r8 + end if + + !------------------------------------------------------------------------------------- + ! no deposition on snow, ice, desert, and water + !------------------------------------------------------------------------------------- + if( wesveg == 1 .or. wesveg == 7 .or. wesveg == 8 .or. index_season == 4 ) then + rgsx(ispec) = 1.e36_r8 + else + var_soilw = max( .1_r8,min( soilw,.3_r8 ) ) + if( wesveg == 3 ) then + var_soilw = log( var_soilw ) + end if + dv_soil_h2 = h2_c(wesveg) + var_soilw*(h2_b(wesveg) + var_soilw*h2_a(wesveg)) + if( dv_soil_h2 > 0._r8 ) then + rgsx(ispec) = fact_h2/(dv_soil_h2*1.e-4_r8) + end if + end if + end if + + !------------------------------------------------------------------------------------- + ! no deposition on water or no vegetation or snow (elai<=0) + !------------------------------------------------------------------------------------- + + no_dep: if( wesveg == 7 .or. elai(pi).le.0_r8 ) then !mvm 11/26/2013 + rclx(ispec)=1.e36_r8 + rsmx(ispec)=1.e36_r8 + rlux(ispec)=1.e36_r8 + else + + !Stomatal resistance + !MVM: adjusted rs to calculate stomata conductance over bulk canopy (CLM report pag 161) + + ! fvitt -- at midnight rssun and/or rssha can be zero in some places which sets rs to zero + ! --- this fix prevents divide by zero error (when rsmx is zero) + if (rssun(pi)>0._r8 .and. rssun(pi)<1.e30 .and. rssha(pi)>0._r8 .and. rssha(pi)<1.e30 ) then + rs=(fsun(pi)*rssun(pi)/elai(pi))+((rssha(pi)/elai(pi))*(1.-fsun(pi))) + else + rs=1.e36_r8 + endif + + !MVM: rs_factor=0.2 to match up Rs observations (Padro et al, 1996) + rs_factor = 0.2_r8 + rsmx(ispec) = rs_factor*rs*drat(ispec)+rmx + + ! Leaf resistance + !MVM: adjusted rlu by LAI to get leaf resistance over bulk canopy (gao and wesely, 1995) + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) + + !Lower canopy resistance + rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rclo(index_season,wesveg)+cts))) + + !----------------------------------- + !mvm 11/30/2013: special case for CO + !Dry deposition of CO and hydrocarbons is negligibly + !small in vegetation [Mueller and Brasseur, 1995]. + !------------------------------------ + if( ispec == index_co ) then + rclx(ispec)=1.e36_r8 + rsmx(ispec)=1.e36_r8 + rlux(ispec)=1.e36_r8 + endif + + !-------------------------------------------- + ! jfl : special case for PAN + !-------------------------------------------- + if( ispec == index_pan ) then + dv_pan = c0_pan(wesveg) * (1._r8 - exp(-k_pan(wesveg)*(rs*drat(ispec))*1.e-2_r8 )) + + if( dv_pan > 0._r8 .and. index_season /= 4 ) then + rsmx(ispec) = ( 1._r8/dv_pan ) + end if + end if + + endif no_dep + + end do species_loop1 + + + !---------------------------------------------- + !Adjustment for dew and rain in leaf resitances + !--------------------------------------------- + ! no effect over water + no_water: if( wesveg.ne.7 ) then + !MVM: effect only on vegetated areas (elai> 0) + with_LAI: if (elai(pi).gt.0._r8) then + + ! + ! no effect if sfc_temp < O C + ! + non_freezing: if(sfc_temp.gt.tmelt) then + if( has_dew ) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) + + if (index_o3 > 0) then + rlux(index_o3) = rlux_o3 + endif + if (index_o3a > 0) then + rlux(index_o3a) = rlux_o3 + endif + endif + + if(has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) + + if (index_o3 > 0) then + rlux(index_o3) = rlux_o3 + endif + if (index_o3a > 0) then + rlux(index_o3a) = rlux_o3 + endif + endif + + species_loop2: do ispec=1,n_drydep + if(mapping(ispec).le.0) cycle + if(ispec.ne.index_o3.and.ispec.ne.index_o3a.and.ispec.ne.index_so2) then + + if( has_dew .or. has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & + (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) + endif + + elseif(ispec.eq.index_so2) then + + if( has_dew ) then + rlux(ispec) = 100._r8 + endif + + if(has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) + endif + + if( has_dew .or. has_rain ) then + !MVM:rlux=50 for SO2 in dew or rain only for *urban land* type surfaces. + if (wesveg.eq.1) then + rlux(ispec)=50._r8 + endif + endif + end if + !mvm 11/30/2013: special case for CO + if( ispec.eq.index_co ) then + rlux(ispec)=1.e36_r8 + endif + end do species_loop2 + endif non_freezing + endif with_LAI + endif no_water + + ! resistance for aerosols + rds = 1._r8/vds(pi) + + species_loop3: do ispec=1,n_drydep + if(mapping(ispec) <= 0) cycle + + ! + ! compute rc + ! + rc = 1._r8/((1._r8/rsmx(ispec))+(1._r8/rlux(ispec)) + & + (1._r8/(rdc+rclx(ispec)))+(1._r8/(rac(index_season,wesveg)+rgsx(ispec)))) + rc = max( 10._r8, rc) + ! + ! assume no surface resistance for SO2 over water + ! + if ( drydep_list(ispec) == 'SO2' .and. wesveg == 7 ) then + rc = 0._r8 + end if + + select case( drydep_list(ispec) ) + case ( 'SO4' ) + velocity(pi,ispec) = (1._r8/(ram1(pi)+rds))*100._r8 + case ( 'NH4','NH4NO3','XNH4NO3' ) + velocity(pi,ispec) = (1._r8/(ram1(pi)+0.5_r8*rds))*100._r8 + case ( 'Pb' ) + velocity(pi,ispec) = 0.2_r8 + case ( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + velocity(pi,ispec) = 0.10_r8 + case default + velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 + end select + end do species_loop3 + endif active + end do pft_loop + + end associate + + end subroutine depvel_compute + +end module DryDepVelocity diff --git a/components/clm/src/biogeochem/MEGANFactorsMod.F90 b/components/clm/src/biogeochem/MEGANFactorsMod.F90 new file mode 100644 index 0000000000..9d8bd130b5 --- /dev/null +++ b/components/clm/src/biogeochem/MEGANFactorsMod.F90 @@ -0,0 +1,300 @@ +module MEGANFactorsMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Manages input of MEGAN emissions factors from netCDF file + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : iulog + use shr_log_mod, only : errMsg => shr_log_errMsg + ! + implicit none + private + ! + ! !PUBLIC MEMBERS: + public :: megan_factors_init + public :: megan_factors_get + public :: comp_names + ! + ! !PUBLIC DATA: + real(r8), public, allocatable :: LDF(:) ! light dependent fraction + real(r8), public, allocatable :: Agro(:) ! growing leaf age factor + real(r8), public, allocatable :: Amat(:) ! mature leaf age factor + real(r8), public, allocatable :: Anew(:) ! new leaf age factor + real(r8), public, allocatable :: Aold(:) ! old leaf age factor + real(r8), public, allocatable :: betaT(:)! temperature factor + real(r8), public, allocatable :: ct1(:) ! temperature coefficient 1 + real(r8), public, allocatable :: ct2(:) ! temperature coefficient 2 + real(r8), public, allocatable :: Ceo(:) ! Eopt coefficient + ! + ! !PRIVATE MEMBERS: + integer :: npfts ! number of plant function types + ! + type emis_eff_t + real(r8) , pointer :: eff (:) ! [real(r8) (:)] emissions efficiency factor + real(r8) :: wght ! molecular weight + integer :: class_num ! MEGAN class number + endtype emis_eff_t + ! + type(emis_eff_t) , pointer :: comp_factors_table (:) ! [type(emis_eff_t) (:)] hash table of MEGAN factors (points to an array of pointers) + integer , pointer :: hash_table_indices (:) ! [integer (:)] pointer to hash table indices + integer, parameter :: tbl_hash_sz = 2**16 ! hash table size + ! + character(len=32), allocatable :: comp_names(:) ! MEGAN compound names + real(r8), allocatable :: comp_molecwghts(:)! MEGAN compound molecular weights + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine megan_factors_get( comp_name, factors, class_n, molecwght ) + ! + ! !DESCRIPTION: + ! Method for getting MEGAN information for a named compound + ! + ! !ARGUMENTS: + character(len=*),intent(in) :: comp_name ! MEGAN compound name + real(r8), intent(out) :: factors(npfts) ! vegitation type factors for the compound of intrest + integer, intent(out) :: class_n ! MEGAN class number for the compound of intrest + real(r8), intent(out) :: molecwght ! molecular weight of the compound of intrest + ! + ! LOCAL VARS: + integer :: hashkey, ndx + character(len=120) :: errmes + !----------------------------------------------------------------------- + + hashkey = gen_hashkey(comp_name) + ndx = hash_table_indices(hashkey) + + if (ndx<1) then + errmes = 'megan_factors_get: '//trim(comp_name)//' compound not found in MEGAN table' + write(iulog,*) trim(errmes) + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + factors(:) = comp_factors_table( ndx )%eff(:) + class_n = comp_factors_table( ndx )%class_num + molecwght = comp_factors_table( ndx )%wght + + end subroutine megan_factors_get + + !----------------------------------------------------------------------- + subroutine megan_factors_init( filename ) + ! + ! !DESCRIPTION: + ! Initializes the MEGAN factors using data from input file + ! + ! !USES: + use ncdio_pio, only : ncd_pio_openfile,ncd_inqdlen + use pio, only : pio_inq_varid,pio_get_var,file_desc_t,pio_closefile + use fileutils , only : getfil + ! + ! !ARGUMENTS: + character(len=*),intent(in) :: filename ! MEGAN factors input file + !----------------------------------------------------------------------- + + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + + integer :: start(2), count(2) + + integer :: ierr, i, vid + integer :: dimid, n_comps, n_classes, n_patchs + integer :: class_ef_vid,comp_ef_vid,comp_name_vid,class_num_vid + integer :: comp_mw_vid + integer, allocatable :: class_nums(:) + + real(r8),allocatable :: factors(:) + real(r8),allocatable :: comp_factors(:) + real(r8),allocatable :: class_factors(:) + + allocate(comp_factors_table(150)) + allocate(hash_table_indices(tbl_hash_sz)) + + + call getfil(filename, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call ncd_inqdlen( ncid, dimid, n_comps, name='Comp_Num') + call ncd_inqdlen( ncid, dimid, n_classes, name='Class_Num') + call ncd_inqdlen( ncid, dimid, n_patchs, name='PFT_Num') + + npfts = n_patchs + + ierr = pio_inq_varid(ncid,'Class_EF', class_ef_vid) + ierr = pio_inq_varid(ncid,'Comp_EF', comp_ef_vid) + ierr = pio_inq_varid(ncid,'Comp_Name',comp_name_vid) + ierr = pio_inq_varid(ncid,'Class_Num',class_num_vid) + ierr = pio_inq_varid(ncid,'Comp_MW', comp_mw_vid) + + allocate( factors(n_patchs) ) + allocate( comp_factors(n_patchs) ) + allocate( class_factors(n_patchs) ) + + factors(1:n_patchs) = 0._r8 + comp_factors(1:n_patchs) = 0._r8 + class_factors(1:n_patchs) = 0._r8 + + allocate( comp_names(n_comps) ) + allocate( comp_molecwghts(n_comps) ) + allocate( class_nums(n_comps) ) + + ierr = pio_get_var( ncid, comp_name_vid, comp_names ) + ierr = pio_get_var( ncid, comp_mw_vid, comp_molecwghts ) + ierr = pio_get_var( ncid, class_num_vid, class_nums ) + + ! set up hash table where data is stored + call bld_hash_table_indices( comp_names ) + do i=1,n_comps + start=(/i,1/) + count=(/1,16/) !TODO - this SHOULD NOT BE HARD-WIRED here!!!!! + ierr = pio_get_var( ncid, comp_ef_vid, start, count, comp_factors ) + start=(/class_nums(i),1/) + ierr = pio_get_var( ncid, class_ef_vid, start, count, class_factors ) + factors(:) = comp_factors(:)*class_factors(:) + call enter_hash_data( trim(comp_names(i)), factors, class_nums(i), comp_molecwghts(i) ) + enddo + + allocate( LDF(n_classes) ) + allocate( Agro(n_classes) ) + allocate( Amat(n_classes) ) + allocate( Anew(n_classes) ) + allocate( Aold(n_classes) ) + allocate( betaT(n_classes) ) + allocate( ct1(n_classes) ) + allocate( ct2(n_classes) ) + allocate( Ceo(n_classes) ) + + ierr = pio_inq_varid(ncid,'LDF', vid) + ierr = pio_get_var( ncid, vid, LDF ) + + ierr = pio_inq_varid(ncid,'Agro', vid) + ierr = pio_get_var( ncid, vid, Agro ) + + ierr = pio_inq_varid(ncid,'Amat', vid) + ierr = pio_get_var( ncid, vid, Amat ) + + ierr = pio_inq_varid(ncid,'Anew', vid) + ierr = pio_get_var( ncid, vid, Anew ) + + ierr = pio_inq_varid(ncid,'Aold', vid) + ierr = pio_get_var( ncid, vid, Aold ) + + ierr = pio_inq_varid(ncid,'betaT', vid) + ierr = pio_get_var( ncid, vid, betaT ) + + ierr = pio_inq_varid(ncid,'ct1', vid) + ierr = pio_get_var( ncid, vid, ct1 ) + + ierr = pio_inq_varid(ncid,'ct2', vid) + ierr = pio_get_var( ncid, vid, ct2 ) + + ierr = pio_inq_varid(ncid,'Ceo', vid) + ierr = pio_get_var( ncid, vid, Ceo ) + + call pio_closefile(ncid) + + deallocate( class_nums, comp_factors,class_factors,factors ) + + endsubroutine megan_factors_init +!----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! Private methods... + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine bld_hash_table_indices( names ) + character(len=*),intent(in) :: names(:) + + integer :: n, i, hashkey + + hash_table_indices(:) = 0 + + n = size(names) + do i=1,n + hashkey = gen_hashkey(names(i)) + hash_table_indices(hashkey) = i + enddo + + endsubroutine bld_hash_table_indices + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine enter_hash_data( name, data, class_n, molec_wght ) + character(len=*), intent(in) :: name + real(r8), intent(in) :: data(:) + integer, intent(in) :: class_n + real(r8), intent(in) :: molec_wght + + integer :: hashkey, ndx + integer :: nfactors + + hashkey = gen_hashkey(name) + nfactors = size(data) + + ndx = hash_table_indices(hashkey) + + allocate (comp_factors_table(ndx)%eff(nfactors)) + + comp_factors_table(ndx)%eff(:) = data(:) + comp_factors_table(ndx)%class_num = class_n + comp_factors_table(ndx)%wght = molec_wght + + end subroutine enter_hash_data + + !----------------------------------------------------------------------- + !from cam_history + ! + ! Purpose: Generate a hash key on the interval [0 .. tbl_hash_sz-1] + ! given a character string. + ! + ! Algorithm is a variant of perl's internal hashing function. + ! + !----------------------------------------------------------------------- + integer function gen_hashkey(string) + + implicit none + ! + ! Arguments: + ! + character(len=*), intent(in) :: string + ! + ! Local vars + ! + integer :: hash + integer :: i + + integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 + integer, parameter :: gen_hash_key_offset = z'000053db' + integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) + + hash = gen_hash_key_offset + + if ( len_trim(string) /= 19 ) then + ! + ! Process arbitrary string length. + ! + do i = 1, len_trim(string) + hash = ieor(hash , (ichar(string(i:i)) * tbl_gen_hash_key(iand(i-1,tbl_max_idx)))) + end do + else + ! + ! Special case string length = 19 + ! + do i = 1, tbl_max_idx+1 + hash = ieor(hash , ichar(string(i:i)) * tbl_gen_hash_key(i-1)) + end do + do i = tbl_max_idx+2, len_trim(string) + hash = ieor(hash , ichar(string(i:i)) * tbl_gen_hash_key(i-tbl_max_idx-2)) + end do + end if + + gen_hashkey = iand(hash, tbl_hash_sz-1) + + return + + end function gen_hashkey + +end module MEGANFactorsMod diff --git a/components/clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 b/components/clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 new file mode 100644 index 0000000000..c5de4b6ce8 --- /dev/null +++ b/components/clm/src/biogeochem/NutrientCompetitionCLM45defaultMod.F90 @@ -0,0 +1,940 @@ +module NutrientCompetitionCLM45defaultMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! DESCRIPTION + ! module contains different subroutines to do soil nutrient competition dynamics + ! + ! created by Jinyun Tang, Sep 8, 2014 + ! modified by Mariana Vertenstein, Nov 15, 2014 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use NutrientCompetitionMethodMod, only : nutrient_competition_method_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_clm45default_type + ! + type, extends(nutrient_competition_method_type) :: nutrient_competition_clm45default_type + private + contains + ! public methocs + procedure, public :: readParams + procedure, public :: calc_plant_nutrient_competition ! calculate nutrient yield rate from competition + procedure, public :: calc_plant_nutrient_demand ! calculate plant nutrient demand + ! + ! private methods + procedure, private:: calc_plant_cn_alloc + procedure, private:: calc_plant_nitrogen_demand + end type nutrient_competition_clm45default_type + ! + interface nutrient_competition_clm45default_type + ! initialize a new nutrient_competition_clm45default_type object + module procedure constructor + end interface nutrient_competition_clm45default_type + ! + type, private :: params_type + real(r8), private :: dayscrecover ! number of days to recover negative cpool + end type params_type + ! + type(params_type), private :: params_inst ! params_inst is populated in readParamsMod + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + type(nutrient_competition_clm45default_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type nutrient_competition_clm45default_type. + ! For now, this is simply a place-holder. + + end function constructor + + !----------------------------------------------------------------------- + subroutine readParams (this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils, only : endrun + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(in) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='dayscrecover' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%dayscrecover=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + + call this%calc_plant_cn_alloc (bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp), & + fpg_col=fpg_col(bounds%begc:bounds%endc)) + + end subroutine calc_plant_nutrient_competition + + !----------------------------------------------------------------------- + subroutine calc_plant_cn_alloc (this, bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use pftconMod , only : pftcon, npcropmin + use clm_varctl , only : use_c13, use_c14 + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp ! lake filter patch index + real(r8):: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8):: fcur ! fraction of current psn displayed as growth + real(r8):: gresp_storage ! temporary variable for growth resp to storage + real(r8):: nlc ! temporary variable for total new leaf carbon allocation + real(r8):: f5 ! grain allocation parameter + real(r8):: cng ! C:N ratio for grain (= cnlw for now; slevis) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fpg_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => pftcon%fcur , & ! Input: allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + + croplive => cnveg_state_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + downreg => cnveg_state_inst%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => cnveg_carbonflux_inst%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => cnveg_carbonflux_inst%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => cnveg_carbonflux_inst%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => cnveg_nitrogenflux_inst%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => cnveg_nitrogenflux_inst%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => cnveg_nitrogenflux_inst%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => cnveg_nitrogenflux_inst%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => cnveg_nitrogenflux_inst%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => cnveg_nitrogenflux_inst%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => cnveg_nitrogenflux_inst%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => cnveg_nitrogenflux_inst%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => cnveg_nitrogenflux_inst%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => cnveg_nitrogenflux_inst%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => cnveg_nitrogenflux_inst%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => cnveg_nitrogenflux_inst%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => cnveg_nitrogenflux_inst%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => cnveg_nitrogenflux_inst%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => cnveg_nitrogenflux_inst%npool_to_deadcrootn_storage_patch & ! Output: [real(r8) (:) ] + ) + + f5 = nan + ! patch loop to distribute the available N between the competing patches + ! on the basis of relative demand, and allocate C and N to new growth and storage + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at + ! ndays_active = days/year. This prevents the continued storage of C and N. + ! turning off this correction (PET, 12/11/03), instead using bgtr in + ! phenology algorithm. + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + + ! calculate the associated carbon allocation, and the excess + ! carbon flux that must be accounted for through downregulation + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + excess_cflux(p) = availc(p) - plant_calloc(p) + + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + + psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + end if + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + end do ! end patch loop + + end associate + + end subroutine calc_plant_cn_alloc + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand(this, bounds, num_soilp, filter_soilp,& + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + !----------------------------------------------------------------------- + + call this%calc_plant_nitrogen_demand(bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp)) + + end subroutine calc_plant_nutrient_demand + + !----------------------------------------------------------------------- + subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + aroot, arepr) + ! + ! !USES: + use pftconMod , only : npcropmin, pftcon + use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + use clm_varcon , only : secspday + use clm_varctl , only : use_c13, use_c14 + use clm_time_manager , only : get_step_size + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + ! + ! !ARGUMENTS: + class(nutrient_competition_clm45default_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + ! + ! !LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter patch index + real(r8):: mr ! maintenance respiration (gC/m2/s) + real(r8):: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8):: curmr, curmr_ratio ! xsmrpool temporary variables + real(r8):: f5 ! grain allocation parameter + real(r8):: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8):: fleaf ! fraction allocated to leaf + real(r8):: t1 ! temporary variable + real(r8):: dt ! model time step + real(r8):: dayscrecover ! number of days to recover negative cpool + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + fleafcn => pftcon%fleafcn , & ! Input: leaf c:n during organ fill + ffrootcn => pftcon%ffrootcn , & ! Input: froot c:n during organ fill + fstemcn => pftcon%fstemcn , & ! Input: stem c:n during organ fill + bfact => pftcon%bfact , & ! Input: parameter used below + aleaff => pftcon%aleaff , & ! Input: parameter used below + arootf => pftcon%arootf , & ! Input: parameter used below + astemf => pftcon%astemf , & ! Input: parameter used below + arooti => pftcon%arooti , & ! Input: parameter used below + fleafi => pftcon%fleafi , & ! Input: parameter used below + allconsl => pftcon%allconsl , & ! Input: parameter used below + allconss => pftcon%allconss , & ! Input: parameter used below + grperc => pftcon%grperc , & ! Input: parameter used below + grpnow => pftcon%grpnow , & ! Input: parameter used below + declfact => pftcon%declfact , & ! Input: + + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + croplive => cnveg_state_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleafi => cnveg_state_inst%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnveg_state_inst%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + grain_flag => cnveg_state_inst%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnveg_state_inst%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnveg_state_inst%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnveg_state_inst%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnveg_state_inst%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + + xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] + + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch , & ! Input: [real(r8) (:) ] + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => cnveg_carbonflux_inst%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + leaf_curmr => cnveg_carbonflux_inst%leaf_curmr_patch , & ! Output: [real(r8) (:) ] + froot_curmr => cnveg_carbonflux_inst%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => cnveg_carbonflux_inst%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => cnveg_carbonflux_inst%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => cnveg_carbonflux_inst%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => cnveg_carbonflux_inst%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => cnveg_carbonflux_inst%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => cnveg_carbonflux_inst%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => cnveg_carbonflux_inst%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => cnveg_carbonflux_inst%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch & ! Output: [real(r8) (:) ] + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! set number of days to recover negative cpool + dayscrecover = params_inst%dayscrecover + + ! loop over patches to assess the total plant N demand + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if + + ! carbon flux available for allocation + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (astem(p) == astemf(ivt(p)) .or. & + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& + ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + if (grain_flag(p) == 0._r8) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & + fleafcn(ivt(p)))) + livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & + fstemcn(ivt(p)))) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & + ffrootcn(ivt(p)))) + end if + grain_flag(p) = 1._r8 + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + + end do ! end patch loop + + end associate + + end subroutine calc_plant_nitrogen_demand + +end module NutrientCompetitionCLM45defaultMod diff --git a/components/clm/src/biogeochem/NutrientCompetitionFactoryMod.F90 b/components/clm/src/biogeochem/NutrientCompetitionFactoryMod.F90 new file mode 100644 index 0000000000..28fb11a4b7 --- /dev/null +++ b/components/clm/src/biogeochem/NutrientCompetitionFactoryMod.F90 @@ -0,0 +1,81 @@ +module NutrientCompetitionFactoryMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Factory to create an instance of nutrient_competition_method_type. This module figures + ! out the particular type to return. + ! + ! !USES: + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + + implicit none + save + private + ! + ! !PUBLIC ROUTINES: + public :: create_nutrient_competition_method ! create an object of class nutrient_competition_method_type + +contains + + !----------------------------------------------------------------------- + function create_nutrient_competition_method() result(nutrient_competition_method) + ! + ! !DESCRIPTION: + ! Create and return an object of nutrient_competition_method_type. The particular type + ! is determined based on a namelist parameter. + ! + ! !USES: + use shr_kind_mod, only : SHR_KIND_CL + use NutrientCompetitionMethodMod, only : nutrient_competition_method_type + use NutrientCompetitionCLM45defaultMod, only : nutrient_competition_clm45default_type + use NutrientCompetitionFlexibleCNMod, only : nutrient_competition_FlexibleCN_type + + ! FIXME(bja, 2015-06) need to pass method control in as a parameter + ! instead of relying on a global! + use clm_varctl, only : use_flexibleCN + + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), allocatable :: nutrient_competition_method ! function result + ! + ! !LOCAL VARIABLES: + + ! For now, hard-code the method. Eventually this will be set from namelist, either by + ! this routine (appropriate if the 'method' is in its own namelist group), or do the + ! namelist read outside this module and pass the method in as a parameter (appropriate + ! if the 'method' is part of a larger namelist group). + character(len=SHR_KIND_CL) :: method + + character(len=*), parameter :: subname = 'create_nutrient_competition_method' + !----------------------------------------------------------------------- + + ! FIXME(bja, 2015-06) flexible_cn may need to be + ! merged with other nitrogen code, so a more robust method of + ! selecting the competition method will depend on how the science + ! is merged. + method = "clm45default" + if (use_flexibleCN) then + method = "flexible_cn" + end if + + select case (trim(method)) + + case ("clm45default") + allocate(nutrient_competition_method, & + source=nutrient_competition_clm45default_type()) + + case ("flexible_cn") + allocate(nutrient_competition_method, & + source=nutrient_competition_FlexibleCN_type()) + + case default + write(iulog,*) subname//' ERROR: unknown method: ', method + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end select + + end function create_nutrient_competition_method + +end module NutrientCompetitionFactoryMod diff --git a/components/clm/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 b/components/clm/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 new file mode 100644 index 0000000000..2f495e8d95 --- /dev/null +++ b/components/clm/src/biogeochem/NutrientCompetitionFlexibleCNMod.F90 @@ -0,0 +1,1565 @@ +module NutrientCompetitionFlexibleCNMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! DESCRIPTION + ! module contains different subroutines to do soil nutrient competition dynamics + ! + ! FIXME(bja, 2015-08) This module was copied from + ! NutrientCompetitionCLM45default then flexible cn modifications + ! were added for the clm50 nitrogen science changes (r120). There is + ! a significant amount of duplicate code between the two + ! modules. They need to be reexamined and the common code pulled out + ! into a common base class. + ! + ! created by Jinyun Tang, Sep 8, 2014 + ! modified by Mariana Vertenstein, Nov 15, 2014 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use NutrientCompetitionMethodMod, only : nutrient_competition_method_type + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_FlexibleCN_type + ! + type, extends(nutrient_competition_method_type) :: nutrient_competition_FlexibleCN_type + private + real(r8), pointer :: actual_leafcn(:) + contains + ! public methocs + procedure, public :: Init + procedure, public :: readParams + procedure, public :: calc_plant_nutrient_competition ! calculate nutrient yield rate from competition + procedure, public :: calc_plant_nutrient_demand ! calculate plant nutrient demand + ! + ! private methods + procedure, private :: InitAllocate + procedure, private :: calc_plant_cn_alloc + procedure, private :: calc_plant_nitrogen_demand + procedure, private :: dynamic_plant_alloc + end type nutrient_competition_FlexibleCN_type + ! + interface nutrient_competition_FlexibleCN_type + ! initialize a new nutrient_competition_FlexibleCN_type object + module procedure constructor + end interface nutrient_competition_FlexibleCN_type + ! + type, private :: params_type + real(r8), private :: dayscrecover ! number of days to recover negative cpool + end type params_type + ! + type(params_type), private :: params_inst ! params_inst is populated in readParamsMod + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + type(nutrient_competition_FlexibleCN_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type nutrient_competition_FlexibleCN_type. + ! For now, this is simply a place-holder. + end function constructor + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize the class + ! + class(nutrient_competition_FlexibleCN_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate memory for the class data + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type) :: this + type(bounds_type), intent(in) :: bounds + + allocate(this%actual_leafcn(bounds%begp:bounds%endp)) + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine readParams (this, ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils, only : endrun + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(in) :: this + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='dayscrecover' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%dayscrecover=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8), intent(in) :: aroot (bounds%begp:) + real(r8), intent(in) :: arepr (bounds%begp:) + real(r8), intent(in) :: fpg_col (bounds%begc:) + + call this%calc_plant_cn_alloc(bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp), & + fpg_col=fpg_col(bounds%begc:bounds%endc)) + + end subroutine calc_plant_nutrient_competition + + !----------------------------------------------------------------------- + + subroutine dynamic_plant_alloc(this, wat_scalar, nit_scalar, LAIndex, alloc_leaf, alloc_stem, alloc_froot) + ! subroutine for dynamic plant allocation for different plant parts + + implicit none + + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + real(r8), intent(in) :: wat_scalar + real(r8), intent(in) :: nit_scalar + real(r8), intent(in) :: LAIndex + + real(r8), intent(out) :: alloc_leaf ! fine root allocation + real(r8), intent(out) :: alloc_stem ! stem allocation + real(r8), intent(out) :: alloc_froot ! leaf allocation + + real(r8) :: water_scalar + real(r8) :: nitrogen_scalar + real(r8) :: LAIndex_max = 10 ! maximum lai + real(r8) :: allocmin_leaf = 0.2 ! minimum leaf allocation + real(r8) :: allocmax_leaf = 0.5 ! maximum leaf allocation + real(r8) :: alloc_r0 = 0.3 ! initial allocation to roots for unlimiting conditions + real(r8) :: alloc_s0 = 0.3 ! initial allocation to stem for unlimiting conditions + real(r8) :: klight_ex = 0.5 ! light extinction parameter + real(r8) :: light_scalar ! scalar for light limitation + real(r8) :: BGr_scalar ! scalar for belowground root processes + + water_scalar = max( 0.1_r8, min( 1.0_r8, wat_scalar ) ) + nitrogen_scalar = max( 0.1_r8, min( 1.0_r8, nit_scalar ) ) + + BGr_scalar = min(water_scalar, nitrogen_scalar) + + if (LAIndex < 10) then + light_scalar = exp (-klight_ex * LAIndex) + else + light_scalar = 0.1_r8 + end if + light_scalar = max( 0.1_r8, min( 1.0_r8, light_scalar ) ) + + ! initial root allocation + alloc_froot = alloc_r0 * 3.0_r8 * light_scalar / (light_scalar + 2.0_r8 * BGr_scalar) + alloc_froot = max (0.15_r8, alloc_froot) + + ! stem allocation + alloc_stem = alloc_s0 * 3.0_r8 * BGr_scalar / (2.0_r8 * light_scalar + BGr_scalar) + + ! leaf allocation + alloc_leaf = 1.0_r8 - (alloc_froot + alloc_stem) + alloc_leaf = max( allocmin_leaf, min( alloc_leaf, allocmax_leaf) ) + + ! final root allocation + alloc_froot = 1.0_r8 - (alloc_stem + alloc_leaf) + + ! if lai greater than laimax then no allocation to leaf; leaf allocation goes to stem + if (LAIndex > LAIndex_max) then + alloc_stem = alloc_stem + alloc_leaf + alloc_leaf = 0.0_r8 + end if + + end subroutine dynamic_plant_alloc + +!----------------------------------------------------------------------- + subroutine calc_plant_cn_alloc(this, bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, & + c14_cnveg_carbonflux_inst, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use pftconMod , only : pftcon, npcropmin + use clm_varctl , only : use_c13, use_c14 + use clm_varctl , only : downreg_opt + use clm_varctl , only : CN_residual_opt + use clm_varctl , only : CN_partition_opt + use clm_time_manager , only : get_step_size + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp ! lake filter patch index + real(r8) :: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8) :: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8) :: fcur ! fraction of current psn displayed as growth + real(r8) :: gresp_storage ! temporary variable for growth resp to storage + real(r8) :: nlc ! temporary variable for total new leaf carbon allocation + real(r8) :: f5 ! grain allocation parameter + real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8) :: dt ! model time step + + + real(r8) :: npool_to_leafn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_leafn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_frootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livestemn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_livecrootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadstemn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_deadcrootn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_supply (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_storage_demand (bounds%begp:bounds%endp) + real(r8) :: npool_to_grainn_storage_supply (bounds%begp:bounds%endp) + real(r8) :: total_plant_Ndemand (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_leafn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_leafn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_frootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_frootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livestemn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livestemn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadstemn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadstemn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livecrootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_livecrootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadcrootn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_deadcrootn_storage (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_grainn (bounds%begp:bounds%endp) + real(r8) :: frNdemand_npool_to_grainn_storage (bounds%begp:bounds%endp) + + ! ----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fpg_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + + associate( & + fpg => fpg_col , & ! Input: [real(r8) (:) ] fraction of potential gpp (no units) + + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => pftcon%fcur , & ! Input: allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + grperc => pftcon%grperc , & ! Input: growth respiration parameter + grpnow => pftcon%grpnow , & ! Input: growth respiration parameter + evergreen => pftcon%evergreen , & ! Input: binary flag for evergreen leaf habit (0 or 1) + + croplive => cnveg_state_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + downreg => cnveg_state_inst%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => cnveg_carbonflux_inst%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => cnveg_carbonflux_inst%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc => cnveg_carbonflux_inst%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => cnveg_carbonflux_inst%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => cnveg_carbonflux_inst%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => cnveg_carbonflux_inst%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => cnveg_carbonflux_inst%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => cnveg_carbonflux_inst%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => cnveg_carbonflux_inst%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => cnveg_carbonflux_inst%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => cnveg_carbonflux_inst%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => cnveg_carbonflux_inst%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => cnveg_carbonflux_inst%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => cnveg_carbonflux_inst%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => cnveg_carbonflux_inst%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => cnveg_carbonflux_inst%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + npool => cnveg_nitrogenstate_inst%npool_patch , & ! Input: [real(r8) (:) ] (gN/m2) temporary plant N pool + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => cnveg_nitrogenflux_inst%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => cnveg_nitrogenflux_inst%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => cnveg_nitrogenflux_inst%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => cnveg_nitrogenflux_inst%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => cnveg_nitrogenflux_inst%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => cnveg_nitrogenflux_inst%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => cnveg_nitrogenflux_inst%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => cnveg_nitrogenflux_inst%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => cnveg_nitrogenflux_inst%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => cnveg_nitrogenflux_inst%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => cnveg_nitrogenflux_inst%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => cnveg_nitrogenflux_inst%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => cnveg_nitrogenflux_inst%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => cnveg_nitrogenflux_inst%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => cnveg_nitrogenflux_inst%npool_to_deadcrootn_storage_patch & ! Output: [real(r8) (:) ] + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! patch loop to distribute the available N between the competing patches + ! on the basis of relative demand, and allocate C and N to new growth and storage + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (.not. downreg_opt) then + if (evergreen(ivt(p)) == 1._r8) then + fcur = 0.0_r8 + end if + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at + ! ndays_active = days/year. This prevents the continued storage of C and N. + ! turning off this correction (PET, 12/11/03), instead using bgtr in + ! phenology algorithm. + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + + if (downreg_opt) then + ! calculate the associated carbon allocation, and the excess + ! carbon flux that must be accounted for through downregulation + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + excess_cflux(p) = availc(p) - plant_calloc(p) + + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + + psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = & + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + end if + end if + + if (.not. downreg_opt) then + plant_calloc(p) = availc(p) + end if + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + if (downreg_opt) then + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + end if + + if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 0) then + + ! N transfer depends on supply and demand + npool_to_frootn_demand(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_supply(p) = npool(p)/dt * fcur + npool_to_frootn(p) = max(min(npool_to_frootn_supply(p),npool_to_frootn_demand(p)),0.0_r8) + + npool_to_frootn_storage_demand(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + npool_to_frootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) + npool_to_frootn_storage(p) = max(min(npool_to_frootn_storage_supply(p),npool_to_frootn_storage_demand(p)),0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p),npool_to_leafn_demand(p)),0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p),npool_to_leafn_storage_demand(p)),0.0_r8) + + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_livestemn(p) = max(min(npool_to_livestemn_supply(p),npool_to_livestemn_demand(p)),0.0_r8) + + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livestemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_livestemn_storage(p) = max(min(npool_to_livestemn_storage_supply(p), & + npool_to_livestemn_storage_demand(p)),0.0_r8) + + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) + npool_to_livecrootn(p) = max(min(npool_to_livecrootn_supply(p),npool_to_livecrootn_demand(p)),0.0_r8) + + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livecrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) + npool_to_livecrootn_storage(p) = max(min(npool_to_livecrootn_storage_supply(p), & + npool_to_livecrootn_storage_demand(p)),0.0_r8) + + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) + npool_to_deadstemn(p) = max(min(npool_to_deadstemn_supply(p),npool_to_deadstemn_demand(p)),0.0_r8) + + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadstemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) + npool_to_deadstemn_storage(p) = max(min(npool_to_deadstemn_storage_supply(p), & + npool_to_deadstemn_storage_demand(p)),0.0_r8) + + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) + npool_to_deadcrootn(p) = max(min(npool_to_deadcrootn_supply(p),npool_to_deadcrootn_demand(p)),0.0_r8) + + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadcrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) + npool_to_deadcrootn_storage(p) = max(min(npool_to_deadcrootn_storage_supply(p), & + npool_to_deadcrootn_storage_demand(p)),0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p),npool_to_leafn_demand(p)),0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) - & + npool_to_deadcrootn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p),& + npool_to_leafn_storage_demand(p)),0.0_r8) + + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + end if + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) + npool_to_livestemn(p) = max(min(npool_to_livestemn_supply(p),npool_to_livestemn_demand(p)),0.0_r8) + + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livestemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) + npool_to_livestemn_storage(p) = max(min(npool_to_livestemn_storage_supply(p), & + npool_to_livestemn_storage_demand(p)),0.0_r8) + + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) + npool_to_livecrootn(p) = max(min(npool_to_livecrootn_supply(p),npool_to_livecrootn_demand(p)),0.0_r8) + + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_livecrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) + npool_to_livecrootn_storage(p) = max(min(npool_to_livecrootn_storage_supply(p), & + npool_to_livecrootn_storage_demand(p)),0.0_r8) + + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) + npool_to_deadstemn(p) = max(min(npool_to_deadstemn_supply(p), npool_to_deadstemn_demand(p)), 0.0_r8) + + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadstemn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) + npool_to_deadstemn_storage(p) = max(min(npool_to_deadstemn_storage_supply(p), & + npool_to_deadstemn_storage_demand(p)),0.0_r8) + + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) + npool_to_deadcrootn(p) = max(min(npool_to_deadcrootn_supply(p), npool_to_deadcrootn_demand(p)), 0.0_r8) + + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_deadcrootn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) + npool_to_deadcrootn_storage(p) = max(min(npool_to_deadcrootn_storage_supply(p), & + npool_to_deadcrootn_storage_demand(p)),0.0_r8) + + npool_to_grainn_demand(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) + npool_to_grainn(p) = max(min(npool_to_grainn_supply(p), npool_to_grainn_demand(p)), 0.0_r8) + + npool_to_grainn_storage_demand(p) = (nlc * f5 / cng) * (1._r8 -fcur) + npool_to_grainn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) - npool_to_deadstemn_storage(p) - & + npool_to_deadcrootn_storage(p) + npool_to_grainn_storage(p) = max(min(npool_to_grainn_storage_supply(p), npool_to_grainn_storage_demand(p)), & + 0.0_r8) + + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_supply(p) = npool(p)/dt * fcur - npool_to_frootn(p) - npool_to_livestemn(p) - & + npool_to_livecrootn(p) - npool_to_deadstemn(p) - npool_to_deadcrootn(p) - npool_to_grainn(p) + npool_to_leafn(p) = max(min(npool_to_leafn_supply(p), npool_to_leafn_demand(p)), 0.0_r8) + + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_leafn_storage_supply(p) = npool(p)/dt * (1._r8 - fcur) - npool_to_frootn_storage(p) - & + npool_to_livestemn_storage(p) - npool_to_livecrootn_storage(p) & + - npool_to_deadstemn_storage(p) - npool_to_deadcrootn_storage(p) - npool_to_grainn_storage(p) + npool_to_leafn_storage(p) = max(min(npool_to_leafn_storage_supply(p), npool_to_leafn_storage_demand(p)), & + 0.0_r8) + + if (CN_residual_opt == 1) then + npool_to_leafn(p) = max(npool_to_leafn_supply(p),0.0_r8) + npool_to_leafn_storage(p) = max(npool_to_leafn_storage_supply(p),0.0_r8) + end if + + end if + + end if + + + ! computing 1.) fractional N demand and 2.) N allocation after uptake for different plant parts + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then + + ! computing nitrogen demand for different pools based on carbon allocated and CN ratio + npool_to_leafn_demand(p) = (nlc / cnl) * fcur + npool_to_leafn_storage_demand(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn_demand(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage_demand(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + cng = graincn(ivt(p)) + npool_to_livestemn_demand(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage_demand(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage_demand(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage_demand(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage_demand(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn_demand(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage_demand(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + + ! computing 1.) fractional N demand for different plant parts + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + + if (woody(ivt(p)) == 1._r8) then + + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + & + npool_to_livestemn_demand(p) + npool_to_livestemn_storage_demand(p) + npool_to_deadstemn_demand(p) + & + npool_to_deadstemn_storage_demand(p) + & + npool_to_livecrootn_demand(p) + npool_to_livecrootn_storage_demand(p) + npool_to_deadcrootn_demand(p) + & + npool_to_deadcrootn_storage_demand(p) + + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + total_plant_Ndemand(p) = npool_to_leafn_demand(p) + npool_to_leafn_storage_demand(p) + & + npool_to_frootn_demand(p) + npool_to_frootn_storage_demand(p) + & + npool_to_livestemn_demand(p) + npool_to_livestemn_storage_demand(p) + npool_to_deadstemn_demand(p) + & + npool_to_deadstemn_storage_demand(p) + & + npool_to_livecrootn_demand(p) + npool_to_livecrootn_storage_demand(p) + npool_to_deadcrootn_demand(p) + & + npool_to_deadcrootn_storage_demand(p) + & + npool_to_grainn_demand(p) + npool_to_grainn_storage_demand(p) + + end if + + if (total_plant_Ndemand(p) == 0.0_r8) then ! removing division by zero + + frNdemand_npool_to_leafn(p) = 0.0_r8 + frNdemand_npool_to_leafn_storage(p) = 0.0_r8 + frNdemand_npool_to_frootn(p) = 0.0_r8 + frNdemand_npool_to_frootn_storage(p) = 0.0_r8 + if (woody(ivt(p)) == 1._r8) then + + frNdemand_npool_to_livestemn(p) = 0.0_r8 + frNdemand_npool_to_livestemn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadstemn(p) = 0.0_r8 + frNdemand_npool_to_deadstemn_storage(p) = 0.0_r8 + frNdemand_npool_to_livecrootn(p) = 0.0_r8 + frNdemand_npool_to_livecrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn_storage(p) = 0.0_r8 + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + frNdemand_npool_to_livestemn(p) = 0.0_r8 + frNdemand_npool_to_livestemn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadstemn(p) = 0.0_r8 + frNdemand_npool_to_deadstemn_storage(p) = 0.0_r8 + frNdemand_npool_to_livecrootn(p) = 0.0_r8 + frNdemand_npool_to_livecrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn(p) = 0.0_r8 + frNdemand_npool_to_deadcrootn_storage(p) = 0.0_r8 + frNdemand_npool_to_grainn(p) = 0.0_r8 + frNdemand_npool_to_grainn_storage(p) = 0.0_r8 + end if + + else + + frNdemand_npool_to_leafn(p) = npool_to_leafn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_leafn_storage(p) = npool_to_leafn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_frootn(p) = npool_to_frootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_frootn_storage(p) = npool_to_frootn_storage_demand(p) / total_plant_Ndemand(p) + if (woody(ivt(p)) == 1._r8) then + + frNdemand_npool_to_livestemn(p) = npool_to_livestemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livestemn_storage(p) = npool_to_livestemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn(p) = npool_to_deadstemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn_storage(p) = npool_to_deadstemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn(p) = npool_to_livecrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn_storage(p) = npool_to_livecrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn(p) = npool_to_deadcrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn_storage(p) = npool_to_deadcrootn_storage_demand(p) / total_plant_Ndemand(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + frNdemand_npool_to_livestemn(p) = npool_to_livestemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livestemn_storage(p) = npool_to_livestemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn(p) = npool_to_deadstemn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadstemn_storage(p) = npool_to_deadstemn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn(p) = npool_to_livecrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_livecrootn_storage(p) = npool_to_livecrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn(p) = npool_to_deadcrootn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_deadcrootn_storage(p) = npool_to_deadcrootn_storage_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_grainn(p) = npool_to_grainn_demand(p) / total_plant_Ndemand(p) + frNdemand_npool_to_grainn_storage(p) = npool_to_grainn_storage_demand(p) / total_plant_Ndemand(p) + end if + + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! computing N allocation for different plant parts + ! allocating allocation to different plant parts in proportion to the fractional demand + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + npool_to_leafn(p) = frNdemand_npool_to_leafn(p) * npool(p) / dt + npool_to_leafn_storage(p) = frNdemand_npool_to_leafn_storage(p) * npool(p) / dt + npool_to_frootn(p) = frNdemand_npool_to_frootn(p) * npool(p) / dt + npool_to_frootn_storage(p) = frNdemand_npool_to_frootn_storage(p) * npool(p) / dt + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = frNdemand_npool_to_livestemn(p) * npool(p) / dt + npool_to_livestemn_storage(p) = frNdemand_npool_to_livestemn_storage(p) * npool(p) / dt + npool_to_deadstemn(p) = frNdemand_npool_to_deadstemn(p) * npool(p) / dt + npool_to_deadstemn_storage(p) = frNdemand_npool_to_deadstemn_storage(p) * npool(p) / dt + npool_to_livecrootn(p) = frNdemand_npool_to_livecrootn(p) * npool(p) / dt + npool_to_livecrootn_storage(p) = frNdemand_npool_to_livecrootn_storage(p) * npool(p) / dt + npool_to_deadcrootn(p) = frNdemand_npool_to_deadcrootn(p) * npool(p) / dt + npool_to_deadcrootn_storage(p) = frNdemand_npool_to_deadcrootn_storage(p) * npool(p) / dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + npool_to_livestemn(p) = frNdemand_npool_to_livestemn(p) * npool(p) / dt + npool_to_livestemn_storage(p) = frNdemand_npool_to_livestemn_storage(p) * npool(p) / dt + npool_to_deadstemn(p) = frNdemand_npool_to_deadstemn(p) * npool(p) / dt + npool_to_deadstemn_storage(p) = frNdemand_npool_to_deadstemn_storage(p) * npool(p) / dt + npool_to_livecrootn(p) = frNdemand_npool_to_livecrootn(p) * npool(p) / dt + npool_to_livecrootn_storage(p) = frNdemand_npool_to_livecrootn_storage(p) * npool(p) / dt + npool_to_deadcrootn(p) = frNdemand_npool_to_deadcrootn(p) * npool(p) / dt + npool_to_deadcrootn_storage(p) = frNdemand_npool_to_deadcrootn_storage(p) * npool(p) / dt + npool_to_grainn(p) = frNdemand_npool_to_grainn(p) * npool(p) / dt + npool_to_grainn_storage(p) = frNdemand_npool_to_grainn_storage(p) * npool(p) / dt + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + end if ! end of if (downreg_opt .eqv. .false. .AND. CN_partition_opt == 1) then + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + end do ! end patch loop + + end associate + + end subroutine calc_plant_cn_alloc + +! ----------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand(this, bounds, num_soilp, filter_soilp,& + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + !----------------------------------------------------------------------- + + call this%calc_plant_nitrogen_demand(bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot=aroot(bounds%begp:bounds%endp), & + arepr=arepr(bounds%begp:bounds%endp)) + + end subroutine calc_plant_nutrient_demand + + !----------------------------------------------------------------------- + subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! !USES: + use pftconMod , only : npcropmin, pftcon + use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + use clm_varcon , only : secspday, dzsoi_decomp + use clm_varctl , only : use_c13, use_c14 + use clm_varctl , only : dynamic_plant_alloc_opt + use clm_varctl , only : nscalar_opt, plant_ndemand_opt, substrate_term_opt, temp_scalar_opt + use clm_varpar , only : nlevdecomp + use clm_time_manager , only : get_step_size + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type ! + ! !ARGUMENTS: + class(nutrient_competition_FlexibleCN_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + ! + ! !LOCAL VARIABLES: + integer :: c, p, j ! indices + integer :: fp ! lake filter patch index + real(r8) :: mr ! maintenance respiration (gC/m2/s) + real(r8) :: f1, f2, f3, f4, g1, g2 ! allocation parameters + real(r8) :: cnl, cnfr, cnlw, cndw ! C:N ratios for leaf, fine root, and wood + real(r8) :: curmr, curmr_ratio ! xsmrpool temporary variables + real(r8) :: f5 ! grain allocation parameter + real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8) :: fleaf ! fraction allocated to leaf + real(r8) :: t1 ! temporary variable + real(r8) :: dt ! model time step + real(r8) :: dayscrecover ! number of days to recover negative cpool + real(r8) :: f_N (bounds%begp:bounds%endp) + real(r8) :: leafcn_actual (bounds%begp:bounds%endp) + real(r8) :: Kmin + real(r8) :: leafcn_max + real(r8) :: leafcn_min + real(r8) :: nscalar + real(r8) :: sminn_total + real(r8) :: substrate_term + real(r8) :: temp_scalar + real(r8) :: Vmax_N + real(r8) :: allocation_leaf (bounds%begp:bounds%endp) + real(r8) :: allocation_stem (bounds%begp:bounds%endp) + real(r8) :: allocation_froot (bounds%begp:bounds%endp) + + ! ----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(aroot) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arepr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] patch vegetation type + + woody => pftcon%woody , & ! Input: binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => pftcon%froot_leaf , & ! Input: allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => pftcon%croot_stem , & ! Input: allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => pftcon%stem_leaf , & ! Input: allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => pftcon%flivewd , & ! Input: allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) + livewdcn => pftcon%livewdcn , & ! Input: live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => pftcon%deadwdcn , & ! Input: dead wood (xylem and heartwood) C:N (gC/gN) + graincn => pftcon%graincn , & ! Input: grain C:N (gC/gN) + fleafcn => pftcon%fleafcn , & ! Input: leaf c:n during organ fill + ffrootcn => pftcon%ffrootcn , & ! Input: froot c:n during organ fill + fstemcn => pftcon%fstemcn , & ! Input: stem c:n during organ fill + bfact => pftcon%bfact , & ! Input: parameter used below + aleaff => pftcon%aleaff , & ! Input: parameter used below + arootf => pftcon%arootf , & ! Input: parameter used below + astemf => pftcon%astemf , & ! Input: parameter used below + arooti => pftcon%arooti , & ! Input: parameter used below + fleafi => pftcon%fleafi , & ! Input: parameter used below + allconsl => pftcon%allconsl , & ! Input: parameter used below + allconss => pftcon%allconss , & ! Input: parameter used below + grperc => pftcon%grperc , & ! Input: parameter used below + grpnow => pftcon%grpnow , & ! Input: parameter used below + declfact => pftcon%declfact , & ! Input: + + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnveg_state_inst%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnveg_state_inst%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + croplive => cnveg_state_inst%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnveg_state_inst%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleafi => cnveg_state_inst%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnveg_state_inst%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnveg_state_inst%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnveg_state_inst%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + grain_flag => cnveg_state_inst%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnveg_state_inst%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnveg_state_inst%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnveg_state_inst%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnveg_state_inst%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnveg_state_inst%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnveg_state_inst%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + + xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:) ] + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:) ] + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + leaf_mr => cnveg_carbonflux_inst%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => cnveg_carbonflux_inst%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => cnveg_carbonflux_inst%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => cnveg_carbonflux_inst%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => cnveg_carbonflux_inst%grain_mr_patch , & ! Input: [real(r8) (:) ] + gpp => cnveg_carbonflux_inst%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => cnveg_carbonflux_inst%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => cnveg_carbonflux_inst%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + psnsun_to_cpool => cnveg_carbonflux_inst%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => cnveg_carbonflux_inst%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + leaf_curmr => cnveg_carbonflux_inst%leaf_curmr_patch , & ! Output: [real(r8) (:) ] + froot_curmr => cnveg_carbonflux_inst%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => cnveg_carbonflux_inst%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => cnveg_carbonflux_inst%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => cnveg_carbonflux_inst%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => cnveg_carbonflux_inst%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => cnveg_carbonflux_inst%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => cnveg_carbonflux_inst%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => cnveg_carbonflux_inst%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => cnveg_carbonflux_inst%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => cnveg_carbonflux_inst%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + plant_ndemand => cnveg_nitrogenflux_inst%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + avail_retransn => cnveg_nitrogenflux_inst%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + retransn_to_npool => cnveg_nitrogenflux_inst%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => cnveg_nitrogenflux_inst%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + leafn_to_retransn => cnveg_nitrogenflux_inst%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => cnveg_nitrogenflux_inst%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => cnveg_nitrogenflux_inst%livestemn_to_retransn_patch,& ! Output: [real(r8) (:) ] + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + btran => energyflux_inst%btran_patch , & ! Input: [real(r8) (:) ] transpiration wetness factor (0 to 1) + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col & ! Input: [real(r8) (:,:) ] soil temperature scalar for decomp + + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! set number of days to recover negative cpool + dayscrecover = params_inst%dayscrecover ! loop over patches to assess the total plant N demand + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14_cnveg_carbonflux_inst%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if ! carbon flux available for allocation + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + + ! dynamic allocation for leaf, stem and roots based on resource limitation, and floating CN ratio + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if (dynamic_plant_alloc_opt) then + ! should the leafcn_actual also be based on storage pool, think about this later + if (leafn(p) == 0.0_r8) then ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + this%actual_leafcn(p) = leafc(p) / 0.000000001_r8 + else + this%actual_leafcn(p) = leafc(p) / leafn(p) ! leaf CN ratio + end if + + leafcn_min = leafcn(ivt(p)) - 10.0_r8 + leafcn_max = leafcn(ivt(p)) + 10.0_r8 + + f_N(p) = min(max(0.0_r8, (leafcn_max - this%actual_leafcn(p)) / (leafcn_max - leafcn_min)),1.0_r8) ! Nitrogen stress factor + + call this%dynamic_plant_alloc(btran(p), f_N(p), laisun(p)+laisha(p), allocation_leaf(p), & + allocation_stem(p), allocation_froot(p)) ! subroutine for performing dynamic allocation + + if (allocation_leaf(p) == 0.0_r8) then + f1 = 0.0_r8 + f3 = 0.0_r8 + else + f1 = allocation_froot(p) / allocation_leaf(p) ! ratio of new fine root : new leaf carbon allocation + f3 = allocation_stem(p) / allocation_leaf(p) ! ratio of new stem : new leaf carbon allocation + end if + + end if + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (astem(p) == astemf(ivt(p)) .or. & + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& + ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + if (grain_flag(p) == 0._r8) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & + fleafcn(ivt(p)))) + livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & + fstemcn(ivt(p)))) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & + ffrootcn(ivt(p)))) + end if + grain_flag(p) = 1._r8 + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + + + if (nscalar_opt) then + ! when we have "if (leafn(p) == 0.0_r8)" below then we + ! have floating overflow (out of floating point range) + ! error in "leafcn_actual(p) = leafc(p) / leafn(p)" + if (leafn(p) < 0.000000001_r8) then + ! to avoid division by zero, and also to make leafcn_actual(p) a very large number if leafn(p) is zero + leafcn_actual(p) = leafc(p) / 0.000000001_r8 + else + leafcn_actual(p) = leafc(p) / leafn(p) ! leaf CN ratio + end if + + leafcn_min = leafcn(ivt(p)) - 10.0_r8 + leafcn_max = leafcn(ivt(p)) + 10.0_r8 + + nscalar = (leafcn_actual(p) - leafcn_min ) / (leafcn_max - leafcn_min) ! Nitrogen scaler factor + nscalar = min( max(0.0_r8, nscalar), 1.0_r8 ) + else ! if (nscalar_opt == .false.) then + nscalar = 1.0_r8 + end if + + if (substrate_term_opt) then + c = patch%column(p) + sminn_total = 0.0_r8 + do j = 1, nlevdecomp + sminn_total = sminn_total + sminn_vr(c,j) * dzsoi_decomp(j) + end do + Kmin = 1.0_r8 + substrate_term = sminn_total / (sminn_total + Kmin) + else ! if (substrate_term_opt == .false) then + substrate_term = 1.0_r8 + end if + + if (.not. temp_scalar_opt) then + temp_scalar = 1.0_r8 + else !(temp_scalar_opt == .true.) then + c = patch%column(p) + temp_scalar=t_scalar(c,1) + temp_scalar = min( max(0.0_r8, temp_scalar), 1.0_r8 ) + end if + + if (plant_ndemand_opt == 0) then + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + else if (plant_ndemand_opt == 1) then + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) * substrate_term + else if (plant_ndemand_opt == 2) then ! N uptake happens at day time only + + if (gpp(p) > 0.0_r8) then + Vmax_N = 2.7E-8_r8 + plant_ndemand(p) = Vmax_N * frootc(p) * substrate_term * temp_scalar * nscalar + else + plant_ndemand(p) = 0.0_r8 + end if + else if (plant_ndemand_opt == 3) then ! N uptake happens at day and night time + + if (laisun(p)+laisha(p) > 0.0_r8) then + Vmax_N = 2.7E-8_r8 + plant_ndemand(p) = Vmax_N * frootc(p) * substrate_term * temp_scalar * nscalar + else + plant_ndemand(p) = 0.0_r8 + end if + + if (leafcn_actual(p) < leafcn_min) then + plant_ndemand(p) = 0.0_r8 + end if + + end if + + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + + end do ! end patch loop + + end associate + + end subroutine calc_plant_nitrogen_demand + +end module NutrientCompetitionFlexibleCNMod diff --git a/components/clm/src/biogeochem/NutrientCompetitionMethodMod.F90 b/components/clm/src/biogeochem/NutrientCompetitionMethodMod.F90 new file mode 100644 index 0000000000..cd26403633 --- /dev/null +++ b/components/clm/src/biogeochem/NutrientCompetitionMethodMod.F90 @@ -0,0 +1,151 @@ +module NutrientCompetitionMethodMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abstract base class for functions to calculate nutrient competition + ! + ! Created by Jinyun Tang, following Bill Sack's implementation of polymorphism + ! !USES: + implicit none + private + ! + ! !PUBLIC TYPES: + public :: nutrient_competition_method_type + + type, abstract :: nutrient_competition_method_type + private + contains + + ! read in nutrient competition kinetic parameters + procedure(readParams_interface), public, deferred :: readParams + + ! compute plant nutrient demand + procedure(calc_plant_nutrient_demand_interface), public, deferred :: calc_plant_nutrient_demand + + ! compute the nutrient yield for different components + procedure(calc_plant_nutrient_competition_interface), public, deferred :: calc_plant_nutrient_competition + + end type nutrient_competition_method_type + + abstract interface + + ! Note: The following code is adapted based on what Bill Scaks has done for soil water retention curve + ! polymorphism. Therefore, I also keep some suggestions he gave there. + ! + ! - Make the interfaces contain all possible inputs that are needed by any + ! implementation; each implementation will then ignore the inputs it doesn't need. + ! + ! - For inputs that are needed only by particular implementations - and particularly + ! for inputs that are constant in time + ! pass these into the constructor, and save pointers to these inputs as components + ! of the child type that needs them. Then they aren't needed as inputs to the + ! individual routines, allowing the interfaces for these routines to remain more + ! consistent between different implementations. + ! + !--------------------------------------------------------------------------- + subroutine readParams_interface(this, ncid) + ! !DESCRIPTION: + ! read in kinetic parameters that are needed for doing nutrient competition + ! + ! !USES: + use ncdio_pio, only : file_desc_t + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type) , intent(in) :: this + type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id + + end subroutine readParams_interface + + !--------------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand_interface (this, bounds, num_soilp, filter_soilp, & + photosyns_inst, crop_inst, canopystate_inst, & + cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, & + energyflux_inst, & + aroot, arepr) + ! + ! DESCRIPTION + ! calculate nutrient yield after considering competition between different components + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use PhotosynthesisMod , only : photosyns_type + use CropType , only : crop_type + use CanopyStateType , only : canopystate_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemCarbonFluxType, only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + use EnergyFluxType , only : energyflux_type + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_inst + type(crop_type) , intent(in) :: crop_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type), intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + real(r8) , intent(out) :: aroot(bounds%begp:) + real(r8) , intent(out) :: arepr(bounds%begp:) + + end subroutine calc_plant_nutrient_demand_interface + + !----------------------------------------------------------------------- + subroutine calc_plant_nutrient_competition_interface (this, & + bounds, num_soilp, filter_soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, & + c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + aroot, arepr, fpg_col) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType, only : soilbiogeochem_nitrogenstate_type + import :: nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(in) :: soilbiogeochem_nitrogenstate_inst + real(r8) , intent(in) :: aroot(bounds%begp:) + real(r8) , intent(in) :: arepr(bounds%begp:) + real(r8) , intent(in) :: fpg_col(bounds%begc:) + + end subroutine calc_plant_nutrient_competition_interface + + end interface + +end module NutrientCompetitionMethodMod diff --git a/components/clm/src/biogeochem/SatellitePhenologyMod.F90 b/components/clm/src/biogeochem/SatellitePhenologyMod.F90 new file mode 100644 index 0000000000..f89837192c --- /dev/null +++ b/components/clm/src/biogeochem/SatellitePhenologyMod.F90 @@ -0,0 +1,679 @@ +module SatellitePhenologyMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! CLM Satelitte Phenology model (SP) ecosystem dynamics (phenology, vegetation). + ! Allow some subroutines to be used by the CLM Carbon Nitrogen model (CLMCN) + ! so that DryDeposition code can get estimates of LAI differences between months. + ! + ! !USES: + use shr_strdata_mod , only : shr_strdata_type, shr_strdata_create + use shr_strdata_mod , only : shr_strdata_print, shr_strdata_advance + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : CL => shr_kind_CL + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : scmlat,scmlon,single_column + use clm_varctl , only : iulog, use_lai_streams + use clm_varcon , only : grlnd + use controlMod , only : NLFilename + use decompMod , only : gsmap_lnd_gdc2glo + use domainMod , only : ldomain + use fileutils , only : getavu, relavu + use PatchType , only : patch + use CanopyStateType , only : canopystate_type + use WaterstateType , only : waterstate_type + use perf_mod , only : t_startf, t_stopf + use spmdMod , only : masterproc + use spmdMod , only : mpicom, comp_id + use mct_mod + use ncdio_pio + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SatellitePhenology ! CLMSP Ecosystem dynamics: phenology, vegetation + public :: SatellitePhenologyInit ! Dynamically allocate memory + public :: interpMonthlyVeg ! interpolate monthly vegetation data + public :: readAnnualVegetation ! Read in annual vegetation (needed for Dry-deposition) + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: readMonthlyVegetation ! read monthly vegetation data for two months + private :: lai_init ! position datasets for LAI + private :: lai_interp ! interpolates between two years of LAI data + + ! !PRIVATE MEMBER DATA: + type(shr_strdata_type) :: sdat_lai ! LAI input data stream + ! + ! !PRIVATE TYPES: + integer , private :: InterpMonths1 ! saved month index + real(r8), private :: timwt(2) ! time weights for month 1 and month 2 + real(r8), private, allocatable :: mlai2t(:,:) ! lai for interpolation (2 months) + real(r8), private, allocatable :: msai2t(:,:) ! sai for interpolation (2 months) + real(r8), private, allocatable :: mhvt2t(:,:) ! top vegetation height for interpolation (2 months) + real(r8), private, allocatable :: mhvb2t(:,:) ! bottom vegetation height for interpolation(2 months) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + ! + ! lai_init + ! + !----------------------------------------------------------------------- + subroutine lai_init(bounds) + ! + ! Initialize data stream information for LAI. + ! + ! + ! !USES: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use clm_nlUtilsMod , only : find_nlgroup_name + use ndepStreamMod , only : clm_domain_mct + use histFileMod , only : hist_addfld1d + use shr_stream_mod , only : shr_stream_file_null + use shr_string_mod , only : shr_string_listCreateField + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: i ! index + integer :: stream_year_first_lai ! first year in Lai stream to use + integer :: stream_year_last_lai ! last year in Lai stream to use + integer :: model_year_align_lai ! align stream_year_first_lai with + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_lai ! lai stream filename to read + character(len=CL) :: lai_mapalgo = 'bilinear' ! Mapping alogrithm + + character(*), parameter :: subName = "('laidyn_init')" + character(*), parameter :: F00 = "('(laidyn_init) ',4a)" + character(*), parameter :: laiString = "LAI" ! base string for field string + integer , parameter :: numLaiFields = 16 ! number of fields to build field string + character(SHR_KIND_CXX) :: fldList ! field string + !----------------------------------------------------------------------- + ! + ! deal with namelist variables here in init + ! + namelist /lai_streams/ & + stream_year_first_lai, & + stream_year_last_lai, & + model_year_align_lai, & + lai_mapalgo, & + stream_fldFileName_lai + + ! Default values for namelist + stream_year_first_lai = 1 ! first year in stream to use + stream_year_last_lai = 1 ! last year in stream to use + model_year_align_lai = 1 ! align stream_year_first_lai with this model year + stream_fldFileName_lai = shr_stream_file_null + + ! Read lai_streams namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'lai_streams', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=lai_streams,iostat=nml_error) + if (nml_error /= 0) then + call endrun(subname // ':: ERROR reading lai_streams namelist') + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_lai, mpicom) + call shr_mpi_bcast(stream_year_last_lai, mpicom) + call shr_mpi_bcast(model_year_align_lai, mpicom) + call shr_mpi_bcast(stream_fldFileName_lai, mpicom) + + if (masterproc) then + + write(iulog,*) ' ' + write(iulog,*) 'lai_stream settings:' + write(iulog,*) ' stream_year_first_lai = ',stream_year_first_lai + write(iulog,*) ' stream_year_last_lai = ',stream_year_last_lai + write(iulog,*) ' model_year_align_lai = ',model_year_align_lai + write(iulog,*) ' stream_fldFileName_lai = ',trim(stream_fldFileName_lai) + + endif + + call clm_domain_mct (bounds, dom_clm) + + ! + ! create the field list for these lai fields...use in shr_strdata_create + ! + fldList = shr_string_listCreateField( numLaiFields, laiString ) + + call shr_strdata_create(sdat_lai,name="laidyn", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_lai, & + yearLast=stream_year_last_lai, & + yearAlign=model_year_align_lai, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_lai), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/stream_fldFileName_lai/), & + fldListFile=fldList, & + fldListModel=fldList, & + fillalgo='none', & + mapalgo=lai_mapalgo, & + calendar=get_calendar(), & + taxmode='cycle' ) + + if (masterproc) then + call shr_strdata_print(sdat_lai,'LAI data') + endif + + end subroutine lai_init + + !----------------------------------------------------------------------- + ! + ! lai_interp + ! + !----------------------------------------------------------------------- + subroutine lai_interp(bounds, canopystate_inst) + ! + ! Interpolate data stream information for Lai. + ! + ! !USES: + use clm_time_manager, only : get_curr_date + use pftconMod , only : noveg + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: ivt, p, g, ip, ig, gpft + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + character(len=CL) :: stream_var_name + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat_lai, mcdate, sec, mpicom, 'laidyn') + + do p = bounds%begp, bounds%endp + ivt = patch%itype(p) + if (ivt /= noveg) then ! vegetated pft + write(stream_var_name,"(i6)") ivt + stream_var_name = 'LAI_'//trim(adjustl(stream_var_name)) + ip = mct_aVect_indexRA(sdat_lai%avs(1),trim(stream_var_name)) + endif + gpft = patch%gridcell(p) + + ! + ! Determine vector index corresponding to gpft + ! + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + if (g == gpft) exit + end do + + ! + ! Set lai for each gridcell/patch combination + ! + if (ivt /= noveg) then ! vegetated pft + canopystate_inst%tlai_patch(p) = sdat_lai%avs(1)%rAttr(ip,ig) + else ! non-vegetated pft + canopystate_inst%tlai_patch(p) = 0._r8 + endif + end do + + end subroutine lai_interp + + !----------------------------------------------------------------------- + subroutine SatellitePhenologyInit (bounds) + ! + ! !DESCRIPTION: + ! Dynamically allocate memory and set to signaling NaN. + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: ier ! error code + !----------------------------------------------------------------------- + + InterpMonths1 = -999 ! saved month index + + ier = 0 + if(.not.allocated(mlai2t)) then + allocate (mlai2t(bounds%begp:bounds%endp,2), & + msai2t(bounds%begp:bounds%endp,2), & + mhvt2t(bounds%begp:bounds%endp,2), & + mhvb2t(bounds%begp:bounds%endp,2), stat=ier) + end if + if (ier /= 0) then + write(iulog,*) 'EcosystemDynini allocation error' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + mlai2t(bounds%begp : bounds%endp, :) = nan + msai2t(bounds%begp : bounds%endp, :) = nan + mhvt2t(bounds%begp : bounds%endp, :) = nan + mhvb2t(bounds%begp : bounds%endp, :) = nan + + if (use_lai_streams) then + call lai_init(bounds) + endif + + end subroutine SatellitePhenologyInit + + !----------------------------------------------------------------------- + subroutine SatellitePhenology(bounds, num_nolakep, filter_nolakep, & + waterstate_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! Ecosystem dynamics: phenology, vegetation + ! Calculates leaf areas (tlai, elai), stem areas (tsai, esai) and height (htop). + ! + ! !USES: + use pftconMod, only : noveg, nbrdlf_dcd_brl_shrub + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter + integer , intent(in) :: filter_nolakep(bounds%endp-bounds%begp+1) ! patch filter for non-lake points + type(waterstate_type) , intent(in) :: waterstate_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c ! indices + real(r8) :: ol ! thickness of canopy layer covered by snow (m) + real(r8) :: fb ! fraction of canopy layer covered by snow + !----------------------------------------------------------------------- + + associate( & + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + tlai => canopystate_inst%tlai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Output: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Output: [real(r8) (:) ] one-sided stem area index with burying by snow + htop => canopystate_inst%htop_patch , & ! Output: [real(r8) (:) ] canopy top (m) + hbot => canopystate_inst%hbot_patch , & ! Output: [real(r8) (:) ] canopy bottom (m) + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + ) + + if (use_lai_streams) then + call lai_interp(bounds, canopystate_inst) + endif + + do fp = 1, num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + + ! need to update elai and esai only every albedo time step so do not + ! have any inconsistency in lai and sai between SurfaceAlbedo calls (i.e., + ! if albedos are not done every time step). + ! leaf phenology + ! Set leaf and stem areas based on day of year + ! Interpolate leaf area index, stem area index, and vegetation heights + ! between two monthly + ! The weights below (timwt(1) and timwt(2)) were obtained by a call to + ! routine InterpMonthlyVeg in subroutine NCARlsm. + ! Field Monthly Values + ! ------------------------- + ! leaf area index LAI <- mlai1 and mlai2 + ! leaf area index SAI <- msai1 and msai2 + ! top height HTOP <- mhvt1 and mhvt2 + ! bottom height HBOT <- mhvb1 and mhvb2 + + if (.not. use_lai_streams) then + tlai(p) = timwt(1)*mlai2t(p,1) + timwt(2)*mlai2t(p,2) + endif + + tsai(p) = timwt(1)*msai2t(p,1) + timwt(2)*msai2t(p,2) + htop(p) = timwt(1)*mhvt2t(p,1) + timwt(2)*mhvt2t(p,2) + hbot(p) = timwt(1)*mhvb2t(p,1) + timwt(2)*mhvb2t(p,2) + + ! adjust lai and sai for burying by snow. if exposed lai and sai + ! are less than 0.05, set equal to zero to prevent numerical + ! problems associated with very small lai and sai. + + ! snow burial fraction for short vegetation (e.g. grasses) as in + ! Wang and Zeng, 2007. + + if (patch%itype(p) > noveg .and. patch%itype(p) <= nbrdlf_dcd_brl_shrub ) then + ol = min( max(snow_depth(c)-hbot(p), 0._r8), htop(p)-hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - max(min(snow_depth(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed + !depth of snow required for complete burial of grasses + endif + + ! area weight by snow covered fraction + + elai(p) = max(tlai(p)*(1.0_r8 - frac_sno(c)) + tlai(p)*fb*frac_sno(c), 0.0_r8) + esai(p) = max(tsai(p)*(1.0_r8 - frac_sno(c)) + tsai(p)*fb*frac_sno(c), 0.0_r8) + if (elai(p) < 0.05_r8) elai(p) = 0._r8 + if (esai(p) < 0.05_r8) esai(p) = 0._r8 + + ! Fraction of vegetation free of snow + + if ((elai(p) + esai(p)) >= 0.05_r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if + + end do ! end of patch loop + + end associate + + end subroutine SatellitePhenology + + !----------------------------------------------------------------------- + subroutine interpMonthlyVeg (bounds, canopystate_inst) + ! + ! !DESCRIPTION: + ! Determine if 2 new months of data are to be read. + ! + ! !USES: + use clm_varctl , only : fsurdat + use clm_time_manager, only : get_curr_date, get_step_size, get_nstep + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(canopystate_type), intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: kyr ! year (0, ...) for nstep+1 + integer :: kmo ! month (1, ..., 12) + integer :: kda ! day of month (1, ..., 31) + integer :: ksec ! seconds into current date for nstep+1 + real(r8):: dtime ! land model time step (sec) + real(r8):: t ! a fraction: kda/ndaypm + integer :: it(2) ! month 1 and month 2 (step 1) + integer :: months(2) ! months to be interpolated (1 to 12) + integer, dimension(12) :: ndaypm= & + (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month + !----------------------------------------------------------------------- + + dtime = get_step_size() + + call get_curr_date(kyr, kmo, kda, ksec, offset=int(dtime)) + + t = (kda-0.5_r8) / ndaypm(kmo) + it(1) = t + 0.5_r8 + it(2) = it(1) + 1 + months(1) = kmo + it(1) - 1 + months(2) = kmo + it(2) - 1 + if (months(1) < 1) months(1) = 12 + if (months(2) > 12) months(2) = 1 + timwt(1) = (it(1)+0.5_r8) - t + timwt(2) = 1._r8-timwt(1) + + if (InterpMonths1 /= months(1)) then + if (masterproc) then + write(iulog,*) 'Attempting to read monthly vegetation data .....' + write(iulog,*) 'nstep = ',get_nstep(),' month = ',kmo,' day = ',kda + end if + call t_startf('readMonthlyVeg') + call readMonthlyVegetation (bounds, fsurdat, months, canopystate_inst) + InterpMonths1 = months(1) + call t_stopf('readMonthlyVeg') + end if + + end subroutine interpMonthlyVeg + + !----------------------------------------------------------------------- + subroutine readAnnualVegetation (bounds, canopystate_inst) + ! + ! !DESCRIPTION: + ! read 12 months of veg data for dry deposition + ! + ! !USES: + use clm_varpar , only : numpft + use pftconMod , only : noveg + use domainMod , only : ldomain + use fileutils , only : getfil + use clm_varctl , only : fsurdat + use shr_scam_mod, only : shr_scam_getCloseLatLon + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(canopystate_type), intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + real(r8), pointer :: annlai(:,:) ! 12 months of monthly lai from input data set + real(r8), pointer :: mlai(:,:) ! lai read from input files + real(r8):: closelat,closelon ! single column vars + integer :: ier ! error code + integer :: g,k,l,m,n,p ! indices + integer :: ni,nj,ns ! indices + integer :: dimid,varid ! input netCDF id's + integer :: ntim ! number of input data time samples + integer :: nlon_i ! number of input data longitudes + integer :: nlat_i ! number of input data latitudes + integer :: npft_i ! number of input data patch types + integer :: closelatidx,closelonidx ! single column vars + logical :: isgrid2d ! true => file is 2d + character(len=256) :: locfn ! local file name + character(len=32) :: subname = 'readAnnualVegetation' + !----------------------------------------------------------------------- + + annlai => canopystate_inst%annlai_patch + + ! Determine necessary indices + + allocate(mlai(bounds%begg:bounds%endg,0:numpft), stat=ier) + if (ier /= 0) then + write(iulog,*)subname, 'allocation error ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (masterproc) then + write (iulog,*) 'Attempting to read annual vegetation data .....' + end if + + call getfil(fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + call check_dim(ncid, 'lsmpft', numpft+1) + + if (single_column) then + call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & + closelat, closelon, closelatidx, closelonidx) + endif + + do k=1,12 !! loop over months and read vegetated data + + call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, & + dim1name=grlnd, nt=k) + + !! only vegetated patches have nonzero values + !! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] patches + !! as determined in subroutine surfrd + + do p = bounds%begp,bounds%endp + g =patch%gridcell(p) + if (patch%itype(p) /= noveg) then !! vegetated pft + do l = 0, numpft + if (l == patch%itype(p)) then + annlai(k,p) = mlai(g,l) + end if + end do + else !! non-vegetated pft + annlai(k,p) = 0._r8 + end if + end do ! end of loop over patches + + enddo ! months loop + + call ncd_pio_closefile(ncid) + + deallocate(mlai) + + endsubroutine readAnnualVegetation + + !----------------------------------------------------------------------- + subroutine readMonthlyVegetation (bounds, & + fveg, months, canopystate_inst) + ! + ! !DESCRIPTION: + ! Read monthly vegetation data for two consec. months. + ! + ! !USES: + use clm_varpar , only : numpft + use pftconMod , only : noveg + use fileutils , only : getfil + use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_INTEGER + use shr_scam_mod , only : shr_scam_getCloseLatLon + use clm_time_manager , only : get_nstep + use netcdf + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: fveg ! file with monthly vegetation data + integer , intent(in) :: months(2) ! months to be interpolated (1 to 12) + type(canopystate_type), intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: g,n,k,l,m,p,ni,nj,ns ! indices + integer :: dimid,varid ! input netCDF id's + integer :: ntim ! number of input data time samples + integer :: nlon_i ! number of input data longitudes + integer :: nlat_i ! number of input data latitudes + integer :: npft_i ! number of input data patch types + integer :: ier ! error code + integer :: closelatidx,closelonidx + real(r8):: closelat,closelon + logical :: readvar + real(r8), pointer :: mlai(:,:) ! lai read from input files + real(r8), pointer :: msai(:,:) ! sai read from input files + real(r8), pointer :: mhgtt(:,:) ! top vegetation height + real(r8), pointer :: mhgtb(:,:) ! bottom vegetation height + character(len=32) :: subname = 'readMonthlyVegetation' + !----------------------------------------------------------------------- + + ! Determine necessary indices + + allocate(& + mlai(bounds%begg:bounds%endg,0:numpft), & + msai(bounds%begg:bounds%endg,0:numpft), & + mhgtt(bounds%begg:bounds%endg,0:numpft), & + mhgtb(bounds%begg:bounds%endg,0:numpft), & + stat=ier) + if (ier /= 0) then + write(iulog,*)subname, 'allocation big error ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! ---------------------------------------------------------------------- + ! Open monthly vegetation file + ! Read data and convert from gridcell to patch data + ! ---------------------------------------------------------------------- + + call getfil(fveg, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + if (single_column) then + call shr_scam_getCloseLatLon (ncid, scmlat, scmlon, closelat, closelon,& + closelatidx, closelonidx) + endif + + do k=1,2 !loop over months and read vegetated data + + call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_LAI NOT on fveg file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='MONTHLY_SAI', flag='read', data=msai, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_SAI NOT on fveg file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', flag='read', data=mhgtt, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', flag='read', data=mhgtb, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun(msg=' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file'//errMsg(__FILE__, __LINE__)) + + ! Only vegetated patches have nonzero values + ! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] patches + ! as determined in subroutine surfrd + + do p = bounds%begp,bounds%endp + g =patch%gridcell(p) + if (patch%itype(p) /= noveg) then ! vegetated pft + do l = 0, numpft + if (l == patch%itype(p)) then + mlai2t(p,k) = mlai(g,l) + msai2t(p,k) = msai(g,l) + mhvt2t(p,k) = mhgtt(g,l) + mhvb2t(p,k) = mhgtb(g,l) + end if + end do + else ! non-vegetated pft + mlai2t(p,k) = 0._r8 + msai2t(p,k) = 0._r8 + mhvt2t(p,k) = 0._r8 + mhvb2t(p,k) = 0._r8 + end if + end do ! end of loop over patches + + end do ! end of loop over months + + call ncd_pio_closefile(ncid) + + if (masterproc) then + k = 2 + write(iulog,*) 'Successfully read monthly vegetation data for' + write(iulog,*) 'month ', months(k) + write(iulog,*) + end if + + deallocate(mlai, msai, mhgtt, mhgtb) + + do p = bounds%begp,bounds%endp + canopystate_inst%mlaidiff_patch(p) = mlai2t(p,1)-mlai2t(p,2) + enddo + + end subroutine readMonthlyVegetation + +end module SatellitePhenologyMod diff --git a/components/clm/src/biogeochem/VOCEmissionMod.F90 b/components/clm/src/biogeochem/VOCEmissionMod.F90 new file mode 100644 index 0000000000..1cd19917e2 --- /dev/null +++ b/components/clm/src/biogeochem/VOCEmissionMod.F90 @@ -0,0 +1,1099 @@ +module VOCEmissionMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Volatile organic compound emission + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varpar , only : numpft, nlevcan + use pftconMod , only : ndllf_evr_tmp_tree, ndllf_evr_brl_tree + use pftconMod , only : ndllf_dcd_brl_tree, nbrdlf_evr_trp_tree + use pftconMod , only : nbrdlf_evr_tmp_tree, nbrdlf_dcd_brl_shrub + use pftconMod , only : nbrdlf_dcd_trp_tree, nbrdlf_dcd_tmp_tree + use pftconMod , only : nbrdlf_dcd_brl_tree, nbrdlf_evr_shrub + use pftconMod , only : nc3_arctic_grass , nc3crop + use pftconMod , only : nc4_grass, noveg + use shr_megan_mod , only : shr_megan_megcomps_n, shr_megan_megcomp_t, shr_megan_linkedlist + use shr_megan_mod , only : shr_megan_mechcomps_n, shr_megan_mechcomps, shr_megan_mapped_emisfctrs + use MEGANFactorsMod , only : Agro, Amat, Anew, Aold, betaT, ct1, ct2, LDF, Ceo + use decompMod , only : bounds_type + use abortutils , only : endrun + use fileutils , only : getfil + use clm_varcon , only : grlnd + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use SoilStateType , only : soilstate_type + use SolarAbsorbedType , only : solarabs_type + use TemperatureType , only : temperature_type + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: VOCEmission + ! + ! !PUBLIC TYPES: + type, public :: vocemis_type + real(r8) , pointer, private :: Eopt_out_patch (:) ! Eopt coefficient + real(r8) , pointer, private :: topt_out_patch (:) ! topt coefficient + real(r8) , pointer, private :: alpha_out_patch (:) ! alpha coefficient + real(r8) , pointer, private :: cp_out_patch (:) ! cp coefficient + real(r8) , pointer, private :: paru_out_patch (:) ! + real(r8) , pointer, private :: par24u_out_patch (:) ! + real(r8) , pointer, private :: par240u_out_patch (:) ! + real(r8) , pointer, private :: para_out_patch (:) ! + real(r8) , pointer, private :: par24a_out_patch (:) ! + real(r8) , pointer, private :: par240a_out_patch (:) ! + real(r8) , pointer, private :: gamma_out_patch (:) ! + real(r8) , pointer, private :: gammaL_out_patch (:) ! + real(r8) , pointer, private :: gammaT_out_patch (:) ! + real(r8) , pointer, private :: gammaP_out_patch (:) ! + real(r8) , pointer, private :: gammaA_out_patch (:) ! + real(r8) , pointer, private :: gammaS_out_patch (:) ! + real(r8) , pointer, private :: gammaC_out_patch (:) ! + real(r8) , pointer, private :: vocflx_tot_patch (:) ! total VOC flux into atmosphere [moles/m2/sec] + real(r8) , pointer, PUBLIC :: vocflx_patch (:,:) ! (num_mech_comps) MEGAN flux [moles/m2/sec] + real(r8) , pointer, private :: efisop_grc (:,:) ! gridcell isoprene emission factors + contains + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + end type vocemis_type + ! + ! !PRIVATE TYPES: + type :: megan_out_type + ! VOC fluxes structure for CLM history output + real(r8), pointer, private :: flux_out(:) ! patch MEGAN flux [ug C m-2 h-1] + end type megan_out_type + type(megan_out_type), private, pointer :: meg_out(:) ! (n_megan_comps) points to output fluxes + ! + logical, parameter :: debug = .false. + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(vocemis_type) :: this + type(bounds_type), intent(in) :: bounds + + if ( shr_megan_mechcomps_n > 0) then + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + end if + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! Allocate memory for module datatypes + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_megan_mod , only : shr_megan_factors_file + use MEGANFactorsMod , only : megan_factors_init, megan_factors_get + ! + ! !ARGUMENTS: + class(vocemis_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: i, imeg + integer :: class_num + real(r8) :: factors(numpft) + real(r8) :: molec_wght + integer :: begg, endg + integer :: begp, endp + type(shr_megan_megcomp_t), pointer :: meg_cmp + !----------------------------------------------------------------------- + + + begg = bounds%begg; endg = bounds%endg + begp = bounds%begp; endp = bounds%endp + + call megan_factors_init( shr_megan_factors_file ) + + meg_cmp => shr_megan_linkedlist + do while(associated(meg_cmp)) + allocate(meg_cmp%emis_factors(numpft)) + call megan_factors_get( trim(meg_cmp%name), factors, class_num, molec_wght ) + meg_cmp%emis_factors = factors + meg_cmp%class_number = class_num + meg_cmp%molec_weight = molec_wght + meg_cmp => meg_cmp%next_megcomp + enddo + + allocate(this%Eopt_out_patch (begp:endp)) ; this%EOPT_out_patch (:) = nan + allocate(this%topt_out_patch (begp:endp)) ; this%topt_out_patch (:) = nan + allocate(this%topt_out_patch (begp:endp)) ; this%Eopt_out_patch (:) = nan + allocate(this%alpha_out_patch (begp:endp)) ; this%alpha_out_patch (:) = nan + allocate(this%cp_out_patch (begp:endp)) ; this%cp_out_patch (:) = nan + allocate(this%para_out_patch (begp:endp)) ; this%para_out_patch (:) = nan + allocate(this%par24a_out_patch (begp:endp)) ; this%par24a_out_patch (:) = nan + allocate(this%par240a_out_patch (begp:endp)) ; this%par240a_out_patch (:) = nan + allocate(this%paru_out_patch (begp:endp)) ; this%paru_out_patch (:) = nan + allocate(this%par24u_out_patch (begp:endp)) ; this%par24u_out_patch (:) = nan + allocate(this%par240u_out_patch (begp:endp)) ; this%par240u_out_patch (:) = nan + allocate(this%gamma_out_patch (begp:endp)) ; this%gamma_out_patch (:) = nan + allocate(this%gammaL_out_patch (begp:endp)) ; this%gammaL_out_patch (:) = nan + allocate(this%gammaT_out_patch (begp:endp)) ; this%gammaT_out_patch (:) = nan + allocate(this%gammaP_out_patch (begp:endp)) ; this%gammaP_out_patch (:) = nan + allocate(this%gammaA_out_patch (begp:endp)) ; this%gammaA_out_patch (:) = nan + allocate(this%gammaS_out_patch (begp:endp)) ; this%gammaS_out_patch (:) = nan + allocate(this%gammaC_out_patch (begp:endp)) ; this%gammaC_out_patch (:) = nan + + allocate(this%vocflx_tot_patch (begp:endp)); this%vocflx_tot_patch (:) = nan + allocate(this%efisop_grc (6,begg:endg)); this%efisop_grc (:,:) = nan + + allocate(meg_out(shr_megan_megcomps_n)) + do i=1,shr_megan_megcomps_n + allocate(meg_out(i)%flux_out(begp:endp)) + meg_out(i)%flux_out(:) = 0._r8 + end do + + allocate(this%vocflx_patch(begp:endp,1:shr_megan_mechcomps_n)) + this%vocflx_patch(:,1:shr_megan_mechcomps_n)= nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize history output fields for MEGAN emissions diagnositics + ! + ! !USES + use clm_varcon , only : spval + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(vocemis_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES + integer :: imeg, ii + integer :: begp, endp + type(shr_megan_megcomp_t), pointer :: meg_cmp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + if (shr_megan_megcomps_n>0) then + + ! loop over megan compounds + meg_cmp => shr_megan_linkedlist + do while(associated(meg_cmp)) + imeg = meg_cmp%index + + call hist_addfld1d ( fname='MEG_'//trim(meg_cmp%name), units='kg/m2/sec', & + avgflag='A', long_name='MEGAN flux', & + ptr_patch=meg_out(imeg)%flux_out, set_lake=0._r8, set_urb=0._r8, default='inactive' ) + + meg_cmp => meg_cmp%next_megcomp + enddo + + this%vocflx_tot_patch(begp:endp)= spval + call hist_addfld1d (fname='VOCFLXT', units='moles/m2/sec', & + avgflag='A', long_name='total VOC flux into atmosphere', & + ptr_patch=this%vocflx_tot_patch, set_lake=0._r8, set_urb=0._r8, default='inactive') + + this%gamma_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMA', units='non', & + avgflag='A', long_name='total gamma for VOC calc', & + ptr_patch=this%gamma_out_patch, set_lake=0._r8, default='inactive') + + this%gammaL_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAL', units='non', & + avgflag='A', long_name='gamma L for VOC calc', & + ptr_patch=this%gammaL_out_patch, set_lake=0._r8, default='inactive') + + this%gammaT_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAT', units='non', & + avgflag='A', long_name='gamma T for VOC calc', & + ptr_patch=this%gammaT_out_patch, set_lake=0._r8, default='inactive') + + this%gammaP_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAP', units='non', & + avgflag='A', long_name='gamma P for VOC calc', & + ptr_patch=this%gammaP_out_patch, set_lake=0._r8, default='inactive') + + this%gammaA_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAA', units='non', & + avgflag='A', long_name='gamma A for VOC calc', & + ptr_patch=this%gammaA_out_patch, set_lake=0._r8, default='inactive') + + this%gammaS_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAS', units='non', & + avgflag='A', long_name='gamma S for VOC calc', & + ptr_patch=this%gammaS_out_patch, set_lake=0._r8, default='inactive') + + this%gammaC_out_patch(begp:endp) = spval + call hist_addfld1d (fname='GAMMAC', units='non', & + avgflag='A', long_name='gamma C for VOC calc', & + ptr_patch=this%gammaC_out_patch, set_lake=0._r8, default='inactive') + + this%EOPT_out_patch(begp:endp) = spval + call hist_addfld1d (fname='EOPT', units='non', & + avgflag='A', long_name='Eopt coefficient for VOC calc', & + ptr_patch=this%Eopt_out_patch, set_lake=0._r8, default='inactive') + + this%topt_out_patch(begp:endp) = spval + call hist_addfld1d (fname='TOPT', units='non', & + avgflag='A', long_name='topt coefficient for VOC calc', & + ptr_patch=this%topt_out_patch, set_lake=0._r8, default='inactive') + + this%alpha_out_patch(begp:endp) = spval + call hist_addfld1d (fname='ALPHA', units='non', & + avgflag='A', long_name='alpha coefficient for VOC calc', & + ptr_patch=this%alpha_out_patch, set_lake=0._r8, default='inactive') + + this%cp_out_patch(begp:endp) = spval + call hist_addfld1d (fname='currentPatch', units='non', & + avgflag='A', long_name='currentPatch coefficient for VOC calc', & + ptr_patch=this%cp_out_patch, set_lake=0._r8, default='inactive') + + this%paru_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR', & + ptr_patch=this%paru_out_patch, set_lake=0._r8, default='inactive') + + this%par24u_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR24_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR (24 hrs)', & + ptr_patch=this%par24u_out_patch, set_lake=0._r8, default='inactive') + + this%par240u_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR240_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR (240 hrs)', & + ptr_patch=this%par240u_out_patch, set_lake=0._r8, default='inactive') + + this%para_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR', & + ptr_patch=this%para_out_patch, set_lake=0._r8, default='inactive') + + this%par24a_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR24_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR (24 hrs)', & + ptr_patch=this%par24a_out_patch, set_lake=0._r8, default='inactive') + + this%par240a_out_patch(begp:endp) = spval + call hist_addfld1d (fname='PAR240_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR (240 hrs)', & + ptr_patch=this%par240a_out_patch, set_lake=0._r8, default='inactive') + + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize cold start conditions for module variables + ! + ! !USES + use ncdio_pio + use clm_varctl, only : fsurdat + ! + ! !ARGUMENTS: + class(vocemis_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + logical :: readvar + integer :: begg, endg + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: locfn ! local filename + real(r8) ,pointer :: temp_ef(:) ! read in - temporary EFs + !----------------------------------------------------------------------- + + begg = bounds%begg; endg = bounds%endg + + ! Time constant + + allocate(temp_ef(begg:endg)) + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_io(ncid=ncid, varname='EF1_BTR', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_BTR'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(1,begg:endg)=temp_ef(begg:endg) + + call ncd_io(ncid=ncid, varname='EF1_FET', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_FET'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(2,begg:endg)=temp_ef(begg:endg) + + call ncd_io(ncid=ncid, varname='EF1_FDT', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_FDT'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(3,begg:endg)=temp_ef(begg:endg) + + call ncd_io(ncid=ncid, varname='EF1_SHR', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_SHR'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(4,begg:endg)=temp_ef(begg:endg) + + call ncd_io(ncid=ncid, varname='EF1_GRS', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_GRS'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(5,begg:endg)=temp_ef(begg:endg) + + call ncd_io(ncid=ncid, varname='EF1_CRP', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg='iniTimeConst: errror reading EF1_CRP'//errMsg(__FILE__, __LINE__)) + end if + this%efisop_grc(6,begg:endg)=temp_ef(begg:endg) + + deallocate(temp_ef) + + call ncd_pio_closefile(ncid) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine VOCEmission (bounds, num_soilp, filter_soilp, & + atm2lnd_inst, canopystate_inst, photosyns_inst, temperature_inst, & + vocemis_inst) + ! + ! ! NEW DESCRIPTION + ! Volatile organic compound emission + ! This code simulates volatile organic compound emissions following + ! MEGAN (Model of Emissions of Gases and Aerosols from Nature) v2.1 + ! for 20 compound classes. The original description of this + ! algorithm (for isoprene only) can be found in Guenther et al., 2006 + ! (we follow equations 2-9, 16-17, 20 for explicit canopy). + ! The model scheme came be described as: + ! E= epsilon * gamma * rho + ! VOC flux (E) [ug m-2 h-1] is calculated from baseline emission + ! factors (epsilon) [ug m-2 h-1] which are specified for each of the 16 + ! CLM Patches (in input file) OR in the case of isoprene, from + ! mapped EFs for each PATCH which reflect species divergence of emissions, + ! particularly in North America. + ! The emission activity factor (gamma) [unitless] for includes + ! dependence on PPFT, temperature, LAI, leaf age and soil moisture. + ! For isoprene only we also include the effect of CO2 inhibition as + ! described by Heald et al., 2009. + ! The canopy environment constant was calculated offline for CLM+CAM at + ! standard conditions. + ! We assume that the escape efficiency (rho) here is unity following + ! Guenther et al., 2006. + ! A manuscript describing MEGAN 2.1 and the implementation in CLM is + ! in preparation: Guenther, Heald et al., 2012 + ! Subroutine written to operate at the patch level. + ! + ! Input: to be read in with EFs and some parameters. + ! Currently these are set in procedure init_EF_params + ! Output: vocflx(shr_megan_mechcomps_n) !VOC flux [moles/m2/sec] + ! + ! !USES: + use subgridAveMod , only : p2g + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of columns in soil patch filter + integer , intent(in) :: filter_soilp(num_soilp) ! patch filter for soil + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(photosyns_type) , intent(in) :: photosyns_inst + type(temperature_type) , intent(in) :: temperature_inst + type(vocemis_type) , intent(inout) :: vocemis_inst + ! + ! !REVISION HISTORY: + ! 4/29/11: Colette L. Heald: expand MEGAN to 20 compound classes + ! 7 Feb 2012: Francis Vitt: Implemented capability to specify MEGAN emissions in namelist + ! and read in MEGAN factors from file. + ! + ! !LOCAL VARIABLES: + integer :: fp,p,g,c ! indices + real(r8) :: epsilon ! emission factor [ug m-2 h-1] + real(r8) :: gamma ! activity factor (accounting for light, T, age, LAI conditions) + real(r8) :: gamma_p ! activity factor for PPFD + real(r8) :: gamma_l ! activity factor for PPFD & LAI + real(r8) :: gamma_t ! activity factor for temperature + real(r8) :: gamma_a ! activity factor for leaf age + real(r8) :: gamma_sm ! activity factor for soil moisture + real(r8) :: gamma_c ! activity factor for CO2 (only isoprene) + real(r8) :: par_sun ! temporary + real(r8) :: par24_sun ! temporary + real(r8) :: par240_sun ! temporary + real(r8) :: par_sha ! temporary + real(r8) :: par24_sha ! temporary + real(r8) :: par240_sha ! temporary + + integer :: class_num, n_meg_comps, imech, imeg, ii + character(len=16) :: mech_name + type(shr_megan_megcomp_t), pointer :: meg_cmp + real(r8) :: cp, alpha, Eopt, topt ! for history output + real(r8) :: co2_ppmv + + real(r8) :: vocflx_meg(shr_megan_megcomps_n) + + ! factor used convert MEGAN units [micro-grams/m2/hr] to CAM srf emis units [g/m2/sec] + real(r8), parameter :: megemis_units_factor = 1._r8/3600._r8/1.e6_r8 + + ! real(r8) :: root_depth(0:numpft) ! Root depth [m] + character(len=32), parameter :: subname = "VOCEmission" + !----------------------------------------------------------------------- + + ! ! root depth (m) (defined based on Zeng et al., 2001, cf Guenther 2006) + ! root_depth(noveg) = 0._r8 ! bare-soil + ! root_depth(ndllf_evr_tmp_tree:ndllf_evr_brl_tree) = 1.8_r8 ! evergreen tree + ! root_depth(ndllf_dcd_brl_tree) = 2.0_r8 ! needleleaf deciduous boreal tree + ! root_depth(nbrdlf_evr_trp_tree:nbrdlf_evr_tmp_tree) = 3.0_r8 ! broadleaf evergreen tree + ! root_depth(nbrdlf_dcd_trp_tree:nbrdlf_dcd_brl_tree) = 2.0_r8 ! broadleaf deciduous tree + ! root_depth(nbrdlf_evr_shrub:nbrdlf_dcd_brl_shrub) = 2.5_r8 ! shrub + ! root_depth(nc3_arctic_grass:numpft) = 1.5_r8 ! grass/crop + ! + if ( shr_megan_mechcomps_n < 1) return + + if ( nlevcan /= 1 )then + call endrun( subname//' error: can NOT work without nlevcan == 1' ) + end if + + associate( & + !dz => col%dz , & ! Input: [real(r8) (:,:) ] depth of layer (m) + !bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (nlevgrnd) + !clayfrac => soilstate_inst%clayfrac_col , & ! Input: [real(r8) (:) ] fraction of soil that is clay + !sandfrac => soilstate_inst%sandfrac_col , & ! Input: [real(r8) (:) ] fraction of soil that is sand + !watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (nlevgrnd) + !sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) (nlevgrnd) + !h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (m3/m3) + !h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice soil content (kg/m3) + + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only) + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (visible only) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric pressure (Pa) + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + forc_solad24 => atm2lnd_inst%fsd24_patch , & ! Input: [real(r8) (:) ] direct beam radiation last 24hrs (visible only) + forc_solad240 => atm2lnd_inst%fsd240_patch , & ! Input: [real(r8) (:) ] direct beam radiation last 240hrs (visible only) + forc_solai24 => atm2lnd_inst%fsi24_patch , & ! Input: [real(r8) (:) ] diffuse radiation last 24hrs (visible only) + forc_solai240 => atm2lnd_inst%fsi240_patch , & ! Input: [real(r8) (:) ] diffuse radiation last 240hrs (visible only) + + fsun => canopystate_inst%fsun_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy + fsun24 => canopystate_inst%fsun24_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy last 24 hrs + fsun240 => canopystate_inst%fsun240_patch , & ! Input: [real(r8) (:) ] sunlit fraction of canopy last 240 hrs + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + elai240 => canopystate_inst%elai240_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow last 240 hrs + + cisun_z => photosyns_inst%cisun_z_patch , & ! Input: [real(r8) (:,:) ] sunlit intracellular CO2 (Pa) + cisha_z => photosyns_inst%cisha_z_patch , & ! Input: [real(r8) (:,:) ] shaded intracellular CO2 (Pa) + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] patch vegetation temperature (Kelvin) + t_veg24 => temperature_inst%t_veg24_patch , & ! Input: [real(r8) (:) ] avg patch vegetation temperature for last 24 hrs + t_veg240 => temperature_inst%t_veg240_patch , & ! Input: [real(r8) (:) ] avg patch vegetation temperature for last 240 hrs + + Eopt_out => vocemis_inst%Eopt_out_patch , & ! Output: [real(r8) (:) ] + topt_out => vocemis_inst%topt_out_patch , & ! Output: [real(r8) (:) ] + alpha_out => vocemis_inst%alpha_out_patch , & ! Output: [real(r8) (:) ] + cp_out => vocemis_inst%cp_out_patch , & ! Output: [real(r8) (:) ] + paru_out => vocemis_inst%paru_out_patch , & ! Output: [real(r8) (:) ] + par24u_out => vocemis_inst%par24u_out_patch , & ! Output: [real(r8) (:) ] + par240u_out => vocemis_inst%par240u_out_patch , & ! Output: [real(r8) (:) ] + para_out => vocemis_inst%para_out_patch , & ! Output: [real(r8) (:) ] + par24a_out => vocemis_inst%par24a_out_patch , & ! Output: [real(r8) (:) ] + par240a_out => vocemis_inst%par240a_out_patch , & ! Output: [real(r8) (:) ] + gammaL_out => vocemis_inst%gammaL_out_patch , & ! Output: [real(r8) (:) ] + gammaT_out => vocemis_inst%gammaT_out_patch , & ! Output: [real(r8) (:) ] + gammaP_out => vocemis_inst%gammaP_out_patch , & ! Output: [real(r8) (:) ] + gammaA_out => vocemis_inst%gammaA_out_patch , & ! Output: [real(r8) (:) ] + gammaS_out => vocemis_inst%gammaS_out_patch , & ! Output: [real(r8) (:) ] + gammaC_out => vocemis_inst%gammaC_out_patch , & ! Output: [real(r8) (:) ] + gamma_out => vocemis_inst%gamma_out_patch , & ! Output: [real(r8) (:) ] + vocflx => vocemis_inst%vocflx_patch , & ! Output: [real(r8) (:,:) ] VOC flux [moles/m2/sec] + vocflx_tot => vocemis_inst%vocflx_tot_patch & ! Output: [real(r8) (:) ] VOC flux [moles/m2/sec] + ) + + ! initialize variables which get passed to the atmosphere + vocflx(bounds%begp:bounds%endp,:) = 0._r8 + vocflx_tot(bounds%begp:bounds%endp) = 0._r8 + + do imeg=1,shr_megan_megcomps_n + meg_out(imeg)%flux_out(bounds%begp:bounds%endp) = 0._r8 + enddo + + ! Begin loop over points + !_______________________________________________________________________________ + do fp = 1,num_soilp + p = filter_soilp(fp) + g = patch%gridcell(p) + c = patch%column(p) + + ! initialize EF + epsilon=0._r8 + + ! initalize to zero since this might not alway get set + ! this needs to be within the fp loop ... + vocflx_meg(:) = 0._r8 + + ! calculate VOC emissions for non-bare ground Patches + if (patch%itype(p) > 0) then + gamma=0._r8 + + ! Calculate PAR: multiply w/m2 by 4.6 to get umol/m2/s for par (added 8/14/02) + !------------------------ + ! SUN: + par_sun = (forc_solad(g,1) + fsun(p) * forc_solai(g,1)) * 4.6_r8 + par24_sun = (forc_solad24(p) + fsun24(p) * forc_solai24(p)) * 4.6_r8 + par240_sun = (forc_solad240(p) + fsun240(p) * forc_solai240(p)) * 4.6_r8 + + ! SHADE: + par_sha = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8 + par24_sha = ((1._r8 - fsun24(p)) * forc_solai24(p)) * 4.6_r8 + par240_sha = ((1._r8 - fsun240(p)) * forc_solai240(p)) * 4.6_r8 + + ! Activity factor for LAI (Guenther et al., 2006): all species + gamma_l = get_gamma_L(fsun240(p), elai(p)) + + ! Activity factor for soil moisture: all species (commented out for now) + ! gamma_sm = get_gamma_SM(clayfrac(p), sandfrac(p), h2osoi_vol(c,:), h2osoi_ice(c,:), & + ! col%dz(c,:), soilstate_inst%bsw_col(c,:), watsat(c,:), sucsat(c,:), root_depth(patch%itype(p))) + gamma_sm = 1.0_r8 + + ! Loop through VOCs for light, temperature and leaf age activity factor & apply + ! all final activity factors to baseline emission factors + !_______________________________________________________________________________ + + ! loop over megan compounds + meg_cmp => shr_megan_linkedlist + meg_cmp_loop: do while(associated(meg_cmp)) + imeg = meg_cmp%index + + ! set emis factor + ! if specified, set EF for isoprene with mapped values + if ( trim(meg_cmp%name) == 'isoprene' .and. shr_megan_mapped_emisfctrs) then + epsilon = get_map_EF(patch%itype(p),g, vocemis_inst) + else + epsilon = meg_cmp%emis_factors(patch%itype(p)) + end if + + class_num = meg_cmp%class_number + + ! Activity factor for PPFD + gamma_p = get_gamma_P(par_sun, par24_sun, par240_sun, par_sha, par24_sha, par240_sha, & + fsun(p), fsun240(p), forc_solad240(p),forc_solai240(p), LDF(class_num), cp, alpha) + + ! Activity factor for T + gamma_t = get_gamma_T(t_veg240(p), t_veg24(p),t_veg(p), ct1(class_num), ct2(class_num),& + betaT(class_num),LDF(class_num), Ceo(class_num), Eopt, topt) + + ! Activity factor for Leaf Age + gamma_a = get_gamma_A(patch%itype(p), elai240(p),elai(p),class_num) + + ! Activity factor for CO2 (only for isoprene) + if (trim(meg_cmp%name) == 'isoprene') then + co2_ppmv = 1.e6*forc_pco2(g)/forc_pbot(c) + gamma_c = get_gamma_C(cisun_z(p,1),cisha_z(p,1),forc_pbot(c),fsun(p), co2_ppmv) + else + gamma_c = 1._r8 + end if + + ! Calculate total scaling factor + gamma = gamma_l * gamma_sm * gamma_a * gamma_p * gamma_T * gamma_c + + if ( (gamma >=0.0_r8) .and. (gamma< 100._r8) ) then + + vocflx_meg(imeg) = epsilon * gamma * megemis_units_factor / meg_cmp%molec_weight ! moles/m2/sec + + ! assign to arrays for history file output (not weighted by landfrac) + meg_out(imeg)%flux_out(p) = meg_out(imeg)%flux_out(p) & + + epsilon * gamma * megemis_units_factor*1.e-3_r8 ! Kg/m2/sec + + if (imeg==1) then + ! + gamma_out(p)=gamma + gammaP_out(p)=gamma_p + gammaT_out(p)=gamma_t + gammaA_out(p)=gamma_a + gammaS_out(p)=gamma_sm + gammaL_out(p)=gamma_l + gammaC_out(p)=gamma_c + + paru_out(p)=par_sun + par24u_out(p)=par24_sun + par240u_out(p)=par240_sun + + para_out(p)=par_sha + par24a_out(p)=par24_sha + par240a_out(p)=par240_sha + + alpha_out(p)=alpha + cp_out(p)=cp + + topt_out(p)=topt + Eopt_out(p)=Eopt + + end if + endif + + if (debug .and. gamma > 0.0_r8) then + write(iulog,*) 'MEGAN: n, megan name, epsilon, gamma, vocflx: ', & + imeg, meg_cmp%name, epsilon, gamma, vocflx_meg(imeg), gamma_p,gamma_t,gamma_a,gamma_sm,gamma_l + endif + + meg_cmp => meg_cmp%next_megcomp + enddo meg_cmp_loop + + ! sum up the megan compound fluxes for the fluxes of chem mechanism compounds + do imech = 1,shr_megan_mechcomps_n + n_meg_comps = shr_megan_mechcomps(imech)%n_megan_comps + do imeg = 1,n_meg_comps ! loop over number of megan compounds that make up the nth mechanism compoud + ii = shr_megan_mechcomps(imech)%megan_comps(imeg)%ptr%index + vocflx(p,imech) = vocflx(p,imech) + vocflx_meg(ii) + enddo + vocflx_tot(p) = vocflx_tot(p) + vocflx(p,imech) ! moles/m2/sec + enddo + + end if ! patch%itype(1:15 only) + + enddo ! fp + + + end associate + end subroutine VOCEmission + + !----------------------------------------------------------------------- + function get_map_EF(ivt_in, g_in, vocemis_inst) + ! + ! Get mapped EF for isoprene + ! Use gridded values for 6 Patches specified by MEGAN following + ! Guenther et al. (2006). Map the numpft CLM Patches to these 6. + ! Units: [ug m-2 h-1] + ! + ! !ARGUMENTS: + integer, intent(in) :: ivt_in + integer, intent(in) :: g_in + type(vocemis_type), intent(in) :: vocemis_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: get_map_EF + !----------------------------------------------------------------------- + + ! vocemis_inst%efisop_patch ! Output: [real(r8) (:,:)] emission factors for isoprene for each patch [ug m-2 h-1] + + get_map_EF = 0._r8 + + if ( ivt_in == ndllf_evr_tmp_tree & + .or. ivt_in == ndllf_evr_brl_tree) then !fineleaf evergreen + get_map_EF = vocemis_inst%efisop_grc(2,g_in) + else if (ivt_in == ndllf_dcd_brl_tree) then !fineleaf deciduous + get_map_EF = vocemis_inst%efisop_grc(3,g_in) + else if (ivt_in >= nbrdlf_evr_trp_tree & + .and. ivt_in <= nbrdlf_dcd_brl_tree) then !broadleaf trees + get_map_EF = vocemis_inst%efisop_grc(1,g_in) + else if (ivt_in >= nbrdlf_evr_shrub & + .and. ivt_in <= nbrdlf_dcd_brl_shrub) then !shrubs + get_map_EF = vocemis_inst%efisop_grc(4,g_in) + else if (ivt_in >= nc3_arctic_grass & + .and. ivt_in <= nc4_grass) then !grass + get_map_EF = vocemis_inst%efisop_grc(5,g_in) + else if (ivt_in >= nc3crop) then !crops + get_map_EF = vocemis_inst%efisop_grc(6,g_in) + end if + + end function get_map_EF + + !----------------------------------------------------------------------- + function get_gamma_P(par_sun_in, par24_sun_in, par240_sun_in, par_sha_in, par24_sha_in, par240_sha_in, & + fsun_in, fsun240_in, forc_solad240_in,forc_solai240_in, LDF_in, cp, alpha) + ! + ! Activity factor for PPFD (Guenther et al., 2006): all light dependent species + !------------------------- + ! With distinction between sunlit and shaded leafs, weight scalings by + ! fsun and fshade + ! Scale total incident par by fraction of sunlit leaves (added on 1/2002) + + ! fvitt -- forc_solad240, forc_solai240 can be zero when CLM finidat is specified + ! which will cause par240 to be zero and produce NaNs via log(par240) + ! dml -- fsun240 can be equal to or greater than one before 10 day averages are + ! set on startup or if a new patch comes online during land cover change. + ! Avoid this problem by only doing calculations with fsun240 when fsun240 is + ! between 0 and 1 + ! + ! !ARGUMENTS: + implicit none + real(r8),intent(in) :: par_sun_in + real(r8),intent(in) :: par24_sun_in + real(r8),intent(in) :: par240_sun_in + real(r8),intent(in) :: par_sha_in + real(r8),intent(in) :: par24_sha_in + real(r8),intent(in) :: par240_sha_in + real(r8),intent(in) :: fsun_in + real(r8),intent(in) :: fsun240_in + real(r8),intent(in) :: forc_solad240_in + real(r8),intent(in) :: forc_solai240_in + real(r8),intent(in) :: LDF_in + real(r8),intent(out):: cp ! temporary + real(r8),intent(out):: alpha ! temporary + ! + ! !LOCAL VARIABLES: + real(r8) :: gamma_p_LDF ! activity factor for PPFD + real(r8) :: get_gamma_P ! return value + real(r8), parameter :: ca1 = 0.004_r8 ! empirical coefficent for alpha + real(r8), parameter :: ca2 = 0.0005_r8 ! empirical coefficent for alpha + real(r8), parameter :: ca3 = 0.0468_r8 ! empirical coefficent for cp + real(r8), parameter :: par0_sun = 200._r8 ! std conditions for past 24 hrs [umol/m2/s] + real(r8), parameter :: par0_shade = 50._r8 ! std conditions for past 24 hrs [umol/m2/s] + real(r8), parameter :: alpha_fix = 0.001_r8 ! empirical coefficient + real(r8), parameter :: cp_fix = 1.21_r8 ! empirical coefficient + !----------------------------------------------------------------------- + + if ( (fsun240_in > 0._r8) .and. (fsun240_in < 1._r8) .and. (forc_solad240_in > 0._r8) & + .and. (forc_solai240_in > 0._r8)) then + ! With alpha and cp calculated based on eq 6 and 7: + ! Note indexing for accumulated variables is all at patch level + ! SUN: + alpha = ca1 - ca2 * log(par240_sun_in) + cp = ca3 * exp(ca2 * (par24_sun_in-par0_sun))*par240_sun_in**(0.6_r8) + gamma_p_LDF = fsun_in * ( cp * alpha * par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) ) + ! SHADE: + alpha = ca1 - ca2 * log(par240_sha_in) + cp = ca3 * exp(ca2 * (par_sha_in-par0_shade))*par240_sha_in**(0.6_r8) + gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8)) + else + ! With fixed alpha and cp (from MEGAN User's Guide): + ! SUN: direct + diffuse + alpha = alpha_fix + cp = cp_fix + gamma_p_LDF = fsun_in * ( cp * alpha*par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) ) + ! SHADE: diffuse + gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8)) + end if + + ! Calculate total activity factor for PPFD accounting for light-dependent fraction + get_gamma_P = (1._r8 - LDF_in) + LDF_in * gamma_p_LDF + + end function get_gamma_P + + !----------------------------------------------------------------------- + function get_gamma_L(fsun240_in,elai_in) + ! + ! Activity factor for LAI (Guenther et al., 2006): all species + ! Guenther et al., 2006 eq 3 + ! + ! !USES: + use clm_varcon , only : denice + use clm_varpar , only : nlevsoi + ! + ! !ARGUMENTS: + implicit none + real(r8),intent(in) :: fsun240_in + real(r8),intent(in) :: elai_in + real(r8) :: get_gamma_L ! return value + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: cce = 0.30_r8 ! factor to set emissions to unity @ std + real(r8), parameter :: cce1 = 0.24_r8 ! same as Cce but for non-accumulated vars + !----------------------------------------------------------------------- + if ( (fsun240_in > 0.0_r8) .and. (fsun240_in < 1.e30_r8) ) then + get_gamma_L = cce * elai_in + else + get_gamma_L = cce1 * elai_in + end if + + end function get_gamma_L + + !----------------------------------------------------------------------- + function get_gamma_SM(clayfrac_in, sandfrac_in, h2osoi_vol_in, h2osoi_ice_in, dz_in, & + bsw_in, watsat_in, sucsat_in, root_depth_in) + ! + ! Activity factor for soil moisture (Guenther et al., 2006): all species + !---------------------------------- + ! Calculate the mean scaling factor throughout the root depth. + ! wilting point potential is in units of matric potential (mm) + ! (1 J/Kg = 0.001 MPa, approx = 0.1 m) + ! convert to volumetric soil water using equation 7.118 of the CLM4 Technical Note + ! + ! !USES: + use clm_varcon , only : denice + use clm_varpar , only : nlevsoi + ! + ! !ARGUMENTS: + implicit none + real(r8),intent(in) :: clayfrac_in + real(r8),intent(in) :: sandfrac_in + real(r8),intent(in) :: h2osoi_vol_in(nlevsoi) + real(r8),intent(in) :: h2osoi_ice_in(nlevsoi) + real(r8),intent(in) :: dz_in(nlevsoi) + real(r8),intent(in) :: bsw_in(nlevsoi) + real(r8),intent(in) :: watsat_in(nlevsoi) + real(r8),intent(in) :: sucsat_in(nlevsoi) + real(r8),intent(in) :: root_depth_in + ! + ! !LOCAL VARIABLES: + real(r8) :: get_gamma_SM + integer :: j + real(r8) :: nl ! temporary number of soil levels + real(r8) :: theta_ice ! water content in ice in m3/m3 + real(r8) :: wilt ! wilting point in m3/m3 + real(r8) :: theta1 ! temporary + real(r8), parameter :: deltheta1=0.06_r8 ! empirical coefficient + real(r8), parameter :: smpmax = 2.57e5_r8 ! maximum soil matrix potential + !----------------------------------------------------------------------- + + if ((clayfrac_in > 0) .and. (sandfrac_in > 0)) then + get_gamma_SM = 0._r8 + nl=0._r8 + + do j = 1,nlevsoi + if (sum(dz_in(1:j)) < root_depth_in) then + theta_ice = h2osoi_ice_in(j)/(dz_in(j)*denice) + wilt = ((smpmax/sucsat_in(j))**(-1._r8/bsw_in(j))) * (watsat_in(j) - theta_ice) + theta1 = wilt + deltheta1 + if (h2osoi_vol_in(j) >= theta1) then + get_gamma_SM = get_gamma_SM + 1._r8 + else if ( (h2osoi_vol_in(j) > wilt) .and. (h2osoi_vol_in(j) < theta1) ) then + get_gamma_SM = get_gamma_SM + ( h2osoi_vol_in(j) - wilt ) / deltheta1 + else + get_gamma_SM = get_gamma_SM + 0._r8 + end if + nl=nl+1._r8 + end if + end do + + if (nl > 0._r8) then + get_gamma_SM = get_gamma_SM/nl + endif + + if (get_gamma_SM > 1.0_r8) then + write(iulog,*) 'healdSM > 1: gamma_SM, nl', get_gamma_SM, nl + get_gamma_SM=1.0_r8 + endif + + else + get_gamma_SM = 1.0_r8 + end if + + end function get_gamma_SM + + !----------------------------------------------------------------------- + function get_gamma_T(t_veg240_in, t_veg24_in,t_veg_in, ct1_in, ct2_in, betaT_in, LDF_in, Ceo_in, Eopt, topt) + + ! Activity factor for temperature + !-------------------------------- + ! Calculate both a light-dependent fraction as in Guenther et al., 2006 for isoprene + ! of a max saturation type form. Also caculate a light-independent fraction of the + ! form of an exponential. Final activity factor depends on light dependent fraction + ! of compound type. + ! + ! !ARGUMENTS: + implicit none + real(r8),intent(in) :: t_veg240_in + real(r8),intent(in) :: t_veg24_in + real(r8),intent(in) :: t_veg_in + real(r8),intent(in) :: ct1_in + real(r8),intent(in) :: ct2_in + real(r8),intent(in) :: betaT_in + real(r8),intent(in) :: LDF_in + real(r8),intent(in) :: Ceo_in + real(r8),intent(out) :: Eopt ! temporary + real(r8),intent(out) :: topt ! temporary + ! + ! !LOCAL VARIABLES: + real(r8) :: get_gamma_T + real(r8) :: gamma_t_LDF ! activity factor for temperature + real(r8) :: gamma_t_LIF ! activity factor for temperature + real(r8) :: x ! temporary + real(r8), parameter :: co1 = 313._r8 ! empirical coefficient + real(r8), parameter :: co2 = 0.6_r8 ! empirical coefficient + real(r8), parameter :: co4 = 0.05_r8 ! empirical coefficient + real(r8), parameter :: tstd0 = 297_r8 ! std temperature [K] + real(r8), parameter :: topt_fix = 317._r8 ! std temperature [K] + real(r8), parameter :: Eopt_fix = 2.26_r8 ! empirical coefficient + real(r8), parameter :: ct3 = 0.00831_r8 ! empirical coefficient (0.0083 in User's Guide) + real(r8), parameter :: tstd = 303.15_r8 ! std temperature [K] + real(r8), parameter :: bet = 0.09_r8 ! beta empirical coefficient [K-1] + !----------------------------------------------------------------------- + + ! Light dependent fraction (Guenther et al., 2006) + if ( (t_veg240_in > 0.0_r8) .and. (t_veg240_in < 1.e30_r8) ) then + ! topt and Eopt from eq 8 and 9: + topt = co1 + (co2 * (t_veg240_in-tstd0)) + Eopt = Ceo_in * exp (co4 * (t_veg24_in-tstd0)) * exp(co4 * (t_veg240_in -tstd0)) + else + topt = topt_fix + Eopt = Eopt_fix + endif + x = ( (1._r8/topt) - (1._r8/(t_veg_in)) ) / ct3 + gamma_t_LDF = Eopt * ( ct2_in * exp(ct1_in * x)/(ct2_in - ct1_in * (1._r8 - exp(ct2_in * x))) ) + + + ! Light independent fraction (of exp(beta T) form) + gamma_t_LIF = exp(betaT_in * (t_veg_in - tstd)) + + ! Calculate total activity factor for light as a function of light-dependent fraction + !-------------------------------- + get_gamma_T = (1-LDF_in)*gamma_T_LIF + LDF_in*gamma_T_LDF + + end function get_gamma_T + + !----------------------------------------------------------------------- + function get_gamma_A(ivt_in, elai240_in, elai_in, nclass_in) + + ! Activity factor for leaf age (Guenther et al., 2006) + !----------------------------- + ! If not CNDV elai is constant therefore gamma_a=1.0 + ! gamma_a set to unity for evergreens (Patches 1, 2, 4, 5) + ! Note that we assume here that the time step is shorter than the number of + !days after budbreak required to induce isoprene emissions (ti=12 days) and + ! the number of days after budbreak to reach peak emission (tm=28 days) + ! + ! !ARGUMENTS: + implicit none + integer,intent(in) :: ivt_in + integer,intent(in) :: nclass_in + real(r8),intent(in) :: elai240_in + real(r8),intent(in) :: elai_in + ! + ! !LOCAL VARIABLES: + real(r8) :: get_gamma_A + real(r8) :: elai_prev ! lai for previous timestep + real(r8) :: fnew, fgro, fmat, fold ! fractions of leaves at different phenological stages + !----------------------------------------------------------------------- + if ( (ivt_in == ndllf_dcd_brl_tree) .or. (ivt_in >= nbrdlf_dcd_trp_tree) ) then ! non-evergreen + + if ( (elai240_in > 0.0_r8) .and. (elai240_in < 1.e30_r8) )then + elai_prev = 2._r8*elai240_in-elai_in ! have accumulated average lai over last 10 days + if (elai_prev == elai_in) then + fnew = 0.0_r8 + fgro = 0.0_r8 + fmat = 1.0_r8 + fold = 0.0_r8 + else if (elai_prev > elai_in) then + fnew = 0.0_r8 + fgro = 0.0_r8 + fmat = 1.0_r8 - (elai_prev - elai_in)/elai_prev + fold = (elai_prev - elai_in)/elai_prev + else if (elai_prev < elai_in) then + fnew = 1 - (elai_prev / elai_in) + fgro = 0.0_r8 + fmat = (elai_prev / elai_in) + fold = 0.0_r8 + end if + + get_gamma_A = fnew*Anew(nclass_in) + fgro*Agro(nclass_in) + fmat*Amat(nclass_in) + fold*Aold(nclass_in) + + else + get_gamma_A = 1.0_r8 + end if + + else + get_gamma_A = 1.0_r8 + end if + + + end function get_gamma_A + + !----------------------------------------------------------------------- + function get_gamma_C(cisun_in,cisha_in,forc_pbot_in,fsun_in, co2_ppmv) + + ! Activity factor for instantaneous CO2 changes (Heald et al., 2009) + !------------------------- + ! With distinction between sunlit and shaded leaves, weight scalings by + ! fsun and fshade + ! + ! !CALLED FROM: VOCEmission + ! + ! !REVISION HISTORY: + ! Author: Colette L. Heald (11/30/11) + ! Louisa K. Emmons (16/03/2015) - implement Colette's intended code + ! and use atmosphere CO2 (not nml setting) + ! + ! !USES: + ! use clm_varctl, only : co2_ppmv ! corresponds to CCSM_CO2_PPMV set in env_conf.xml + ! + ! !ARGUMENTS: + implicit none + ! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: cisun_in + real(r8),intent(in) :: cisha_in + real(r8),intent(in) :: forc_pbot_in + real(r8),intent(in) :: fsun_in + real(r8),intent(in) :: co2_ppmv + + real(r8) :: get_gamma_C + + ! local variables + real(r8) :: Ismax ! empirical coeff for CO2 + real(r8) :: h ! empirical coeff for CO2 + real(r8) :: Cstar ! empirical coeff for CO2 + real(r8) :: fint ! interpolation fraction for CO2 + real(r8) :: ci ! temporary sunlight/shade weighted cisun & cisha (umolCO2/mol) + real(r8) :: gamma_ci ! short-term exposure gamma + real(r8) :: gamma_ca ! long-term exposure gamma + real(r8), parameter :: Ismax_ca = 1.344_r8 ! Estimated asymptote at which further decreases in intercellular CO2 have a negligible effect on isoprene emission + real(r8), parameter :: h_ca = 1.4614_r8 ! Exponential scalar + real(r8), parameter :: Cstar_ca = 585._r8 ! Scaling coefficient + real(r8), parameter :: CiCa_ratio = 0.7_r8 ! Ratio of intercellular CO2 to atmospheric CO2 + !----------------------------------------------------------------------- + + + ! LONG-TERM EXPOSURE (based on ambient CO2, Ca) + !----------------------------------------------------------------------------- + gamma_ca = Ismax_ca - ((Ismax_ca * (CiCa_ratio*co2_ppmv)**h_ca) / (Cstar_ca**h_ca + (CiCa_ratio*co2_ppmv)**h_ca) ) + + + ! SHORT-TERM EXPOSURE (based on intercellular CO2, Ci) + !----------------------------------------------------------------------------- + ! Determine long-term CO2 growth environment (ie. ambient CO2) and interpolate + ! parameters + if ( co2_ppmv < 400._r8 ) then + Ismax = 1.072_r8 + h = 1.70_r8 + Cstar = 1218._r8 + else if ( (co2_ppmv > 400._r8) .and. (co2_ppmv < 600._r8) ) then + fint = (co2_ppmv - 400._r8)/200._r8 + Ismax = fint*1.036_r8 + (1.- fint)*1.072_r8 + h = fint*2.0125_r8 + (1.- fint)*1.70_r8 + Cstar = fint*1150._r8 + (1.- fint)*1218._r8 + else if ( (co2_ppmv > 600._r8) .and. (co2_ppmv < 800._r8) ) then + fint = (co2_ppmv - 600._r8)/200._r8 + Ismax = fint*1.046_r8 + (1.- fint)*1.036_r8 + h = fint*1.5380_r8 + (1.- fint)*2.0125_r8 + Cstar = fint*2025._r8 + (1.- fint)*1150._r8 + else if ( co2_ppmv > 800._r8 ) then + Ismax = 1.014_r8 + h = 2.861_r8 + Cstar = 1525._r8 + end if + + ! Intercellular CO2 concentrations (ci) given in Pa, divide by atmos + ! pressure to get mixing ratio (umolCO2/mol) + if ( (cisun_in .eq. cisun_in) .and. (cisha_in .eq. cisha_in) .and. (forc_pbot_in > 0._r8) .and. (fsun_in > 0._r8) ) then + ci = ( fsun_in*cisun_in + (1._r8-fsun_in)*cisha_in )/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else if ( (cisun_in > 0.0_r8) .and. (cisun_in < 1.e30_r8) .and. (forc_pbot_in > 0._r8) .and. (fsun_in .eq. 1._r8) ) then + ci = cisun_in/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else if ( (cisha_in > 0.0_r8) .and. (cisha_in < 1.e30_r8) .and. (forc_pbot_in > 0._r8) .and. (fsun_in .eq. 0._r8) ) then + ci = cisha_in/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else + gamma_ci = 1._r8 + end if + + get_gamma_C = gamma_ci * gamma_ca + + end function get_gamma_C + +end module VOCEmissionMod + + diff --git a/components/clm/src/biogeochem/ch4Mod.F90 b/components/clm/src/biogeochem/ch4Mod.F90 new file mode 100644 index 0000000000..2bc9d49ee0 --- /dev/null +++ b/components/clm/src/biogeochem/ch4Mod.F90 @@ -0,0 +1,3786 @@ +module ch4Mod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines to calculate methane fluxes + ! The driver averages up to gridcell, weighting by finundated, and checks for balance errors. + ! Sources, sinks, "competition" for CH4 & O2, & transport are resolved in ch4_tran. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevsoi, ngases, nlevsno, nlevdecomp + use clm_varcon , only : denh2o, denice, tfrz, grav, spval, rgas, grlnd + use clm_varcon , only : catomw, s_con, d_con_w, d_con_g, c_h_inv, kh_theta, kh_tbase + use landunit_varcon , only : istdlak + use clm_time_manager , only : get_step_size, get_nstep + use clm_varctl , only : iulog, use_cn, use_nitrif_denitrif, use_lch4 + use abortutils , only : endrun + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use CNSharedParamsMod , only : CNParamsShareInst + use CNVegcarbonfluxType , only : cnveg_carbonflux_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use EnergyFluxType , only : energyflux_type + use LakeStateType , only : lakestate_type + use lnd2atmType , only : lnd2atm_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + + ! Non-tunable constants + real(r8) :: rgasm ! J/mol.K; rgas / 1000; will be set below + real(r8), parameter :: rgasLatm = 0.0821_r8 ! L.atm/mol.K + + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: ch4 + + ! !PRIVATE MEMBER FUNCTIONS: + private :: ch4_prod + private :: ch4_oxid + private :: ch4_aere + private :: ch4_ebul + private :: ch4_tran + private :: ch4_annualupdate + private :: get_jwt + + type, private :: params_type + ! ch4 production constants + real(r8) :: q10ch4 ! additional Q10 for methane production ABOVE the soil decomposition temperature relationship + real(r8) :: q10ch4base ! temperature at which the effective f_ch4 actually equals the constant f_ch4 + real(r8) :: f_ch4 ! ratio of CH4 production to total C mineralization + real(r8) :: rootlitfrac ! Fraction of soil organic matter associated with roots + real(r8) :: cnscalefactor ! scale factor on CN decomposition for assigning methane flux + real(r8) :: redoxlag ! Number of days to lag in the calculation of finundated_lag + real(r8) :: lake_decomp_fact ! Base decomposition rate (1/s) at 25C + real(r8) :: redoxlag_vertical ! time lag (days) to inhibit production for newly unsaturated layers + real(r8) :: pHmax ! maximum pH for methane production(= 9._r8) + real(r8) :: pHmin ! minimum pH for methane production(= 2.2_r8) + real(r8) :: oxinhib ! inhibition of methane production by oxygen (m^3/mol) + + ! ch4 oxidation constants + real(r8) :: vmax_ch4_oxid ! oxidation rate constant (= 45.e-6_r8 * 1000._r8 / 3600._r8) [mol/m3-w/s]; + real(r8) :: k_m ! Michaelis-Menten oxidation rate constant for CH4 concentration + real(r8) :: q10_ch4oxid ! Q10 oxidation constant + real(r8) :: smp_crit ! Critical soil moisture potential + real(r8) :: k_m_o2 ! Michaelis-Menten oxidation rate constant for O2 concentration + real(r8) :: k_m_unsat ! Michaelis-Menten oxidation rate constant for CH4 concentration + real(r8) :: vmax_oxid_unsat ! (= 45.e-6_r8 * 1000._r8 / 3600._r8 / 10._r8) [mol/m3-w/s] + + ! ch4 aerenchyma constants + real(r8) :: aereoxid ! fraction of methane flux entering aerenchyma rhizosphere that will be + + ! oxidized rather than emitted + real(r8) :: scale_factor_aere ! scale factor on the aerenchyma area for sensitivity tests + real(r8) :: nongrassporosratio ! Ratio of root porosity in non-grass to grass, used for aerenchyma transport + real(r8) :: unsat_aere_ratio ! Ratio to multiply upland vegetation aerenchyma porosity by compared to inundated systems (= 0.05_r8 / 0.3_r8) + real(r8) :: porosmin ! minimum aerenchyma porosity (unitless)(= 0.05_r8) + + ! ch4 ebbulition constants + real(r8) :: vgc_max ! ratio of saturation pressure triggering ebullition + + ! ch4 transport constants + real(r8) :: satpow ! exponent on watsat for saturated soil solute diffusion + real(r8) :: scale_factor_gasdiff ! For sensitivity tests; convection would allow this to be > 1 + real(r8) :: scale_factor_liqdiff ! For sensitivity tests; convection would allow this to be > 1 + real(r8) :: capthick ! min thickness before assuming h2osfc is impermeable (mm) (= 100._r8) + + ! additional constants + real(r8) :: f_sat ! volumetric soil water defining top of water table or where production is allowed (=0.95) + real(r8) :: qflxlagd ! days to lag qflx_surf_lag in the tropics (days) ( = 30._r8) + real(r8) :: highlatfact ! multiple of qflxlagd for high latitudes (= 2._r8) + real(r8) :: q10lakebase ! (K) base temperature for lake CH4 production (= 298._r8) + real(r8) :: atmch4 ! Atmospheric CH4 mixing ratio to prescribe if not provided by the atmospheric model (= 1.7e-6_r8) (mol/mol) + real(r8) :: rob ! ratio of root length to vertical depth ("root obliquity") (= 3._r8) + end type params_type + type(params_type), private :: params_inst + + type, public :: ch4_type + real(r8), pointer, private :: ch4_prod_depth_sat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_prod_depth_unsat_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_prod_depth_lake_col (:,:) ! col CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_sat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_unsat_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_oxid_depth_lake_col (:,:) ! col CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_aere_depth_sat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_aere_depth_unsat_col (:,:) ! col CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_tran_depth_sat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_tran_depth_unsat_col (:,:) ! col CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_depth_sat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_depth_unsat_col (:,:) ! col CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: ch4_ebul_total_sat_col (:) ! col Total col CH4 ebullition (mol/m2/s) + real(r8), pointer, private :: ch4_ebul_total_unsat_col (:) ! col Total col CH4 ebullition (mol/m2/s) + real(r8), pointer, private :: ch4_surf_aere_sat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_aere_unsat_col (:) ! col CH4 aerenchyma flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_sat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_unsat_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: ch4_surf_ebul_lake_col (:) ! col CH4 ebullition flux to atmosphere (after oxidation) (mol/m2/s) + real(r8), pointer, private :: co2_aere_depth_sat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_aere_depth_unsat_col (:,:) ! col CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_oxid_depth_sat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_oxid_depth_unsat_col (:,:) ! col O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_aere_depth_sat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: o2_aere_depth_unsat_col (:,:) ! col O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_decomp_depth_sat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, private :: co2_decomp_depth_unsat_col (:,:) ! col CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, private :: co2_oxid_depth_sat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: co2_oxid_depth_unsat_col (:,:) ! col CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + real(r8), pointer, private :: conc_o2_lake_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_sat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_unsat_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: conc_ch4_lake_col (:,:) ! col CH4 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, private :: ch4_surf_diff_sat_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_surf_diff_unsat_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_surf_diff_lake_col (:) ! col CH4 surface flux (mol/m2/s) + real(r8), pointer, private :: ch4_dfsat_flux_col (:) ! col CH4 flux to atm due to decreasing fsat (kg C/m^2/s) [+] + + real(r8), pointer, private :: zwt_ch4_unsat_col (:) ! col depth of water table for unsaturated fraction (m) + real(r8), pointer, private :: fsat_bef_col (:) ! col fsat from previous timestep + real(r8), pointer, private :: lake_soilc_col (:,:) ! col total soil organic matter found in level (g C / m^3) (nlevsoi) + real(r8), pointer, private :: totcolch4_col (:) ! col total methane found in soil col (g C / m^2) + real(r8), pointer, private :: annsum_counter_col (:) ! col seconds since last annual accumulator turnover + real(r8), pointer, private :: tempavg_somhr_col (:) ! col temporary average SOM heterotrophic resp. (gC/m2/s) + real(r8), pointer, private :: annavg_somhr_col (:) ! col annual average SOM heterotrophic resp. (gC/m2/s) + real(r8), pointer, private :: tempavg_finrw_col (:) ! col respiration-weighted annual average of finundated + real(r8), pointer, private :: annavg_finrw_col (:) ! col respiration-weighted annual average of finundated + real(r8), pointer, private :: sif_col (:) ! col (unitless) ratio applied to sat. prod. to account for seasonal inundation + real(r8), pointer, private :: ch4stress_unsat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + real(r8), pointer, private :: ch4stress_sat_col (:,:) ! col Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + real(r8), pointer, private :: qflx_surf_lag_col (:) ! col time-lagged surface runoff (mm H2O /s) + real(r8), pointer, private :: finundated_lag_col (:) ! col time-lagged fractional inundated area + real(r8), pointer, private :: layer_sat_lag_col (:,:) ! col Lagged saturation status of soil layer in the unsaturated zone (1 = sat) + real(r8), pointer, private :: zwt0_col (:) ! col coefficient for determining finundated (m) + real(r8), pointer, private :: f0_col (:) ! col maximum inundated fraction for a gridcell (for methane code) + real(r8), pointer, private :: p3_col (:) ! col coefficient for determining finundated (m) + real(r8), pointer, private :: pH_col (:) ! col pH values for methane production + ! + real(r8), pointer, private :: c_atm_grc (:,:) ! grc atmospheric conc of CH4, O2, CO2 (mol/m3) + real(r8), pointer, private :: ch4co2f_grc (:) ! grc CO2 production from CH4 oxidation (g C/m**2/s) + real(r8), pointer, private :: ch4prodg_grc (:) ! grc average CH4 production (g C/m^2/s) + ! + ! for aerenchyma calculations + real(r8), pointer, private :: annavg_agnpp_patch (:) ! patch (gC/m2/s) annual average aboveground NPP + real(r8), pointer, private :: annavg_bgnpp_patch (:) ! patch (gC/m2/s) annual average belowground NPP + real(r8), pointer, private :: tempavg_agnpp_patch (:) ! patch (gC/m2/s) temp. average aboveground NPP + real(r8), pointer, private :: tempavg_bgnpp_patch (:) ! patch (gC/m2/s) temp. average belowground NPP + ! + real(r8), pointer, public :: finundated_col (:) ! col fractional inundated area (excluding dedicated wetland cols) + real(r8), pointer, public :: o2stress_unsat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + real(r8), pointer, public :: o2stress_sat_col (:,:) ! col Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + real(r8), pointer, public :: conc_o2_sat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, public :: conc_o2_unsat_col (:,:) ! col O2 conc in each soil layer (mol/m3) (nlevsoi) + real(r8), pointer, public :: o2_decomp_depth_sat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, public :: o2_decomp_depth_unsat_col (:,:) ! col O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + real(r8), pointer, public :: ch4_surf_flux_tot_col (:) ! col CH4 surface flux (to atm) (kg C/m**2/s) + + real(r8), pointer, public :: grnd_ch4_cond_patch (:) ! patch tracer conductance for boundary layer [m/s] + real(r8), pointer, public :: grnd_ch4_cond_col (:) ! col tracer conductance for boundary layer [m/s] + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, public :: Restart + + end type ch4_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init( this, bounds, cellorg_col, fsurdat ) + + class(ch4_type) :: this + type(bounds_type), intent(in) :: bounds + real(r8) , intent(in) :: cellorg_col (bounds%begc:, 1:) + character(len=*) , intent(in) :: fsurdat ! surface data file name + + call this%InitAllocate (bounds) + if (use_lch4) then + call this%InitHistory (bounds) + call this%InitCold (bounds, cellorg_col, fsurdat) + end if + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate module variables and data structures + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varpar , only: nlevgrnd + ! + ! !ARGUMENTS: + class(ch4_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + allocate(this%ch4_prod_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_sat_col (:,:) = nan + allocate(this%ch4_prod_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_unsat_col (:,:) = nan + allocate(this%ch4_prod_depth_lake_col (begc:endc,1:nlevgrnd)) ; this%ch4_prod_depth_lake_col (:,:) = nan + allocate(this%ch4_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_sat_col (:,:) = nan + allocate(this%ch4_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_unsat_col (:,:) = nan + allocate(this%ch4_oxid_depth_lake_col (begc:endc,1:nlevgrnd)) ; this%ch4_oxid_depth_lake_col (:,:) = nan + allocate(this%o2_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_oxid_depth_sat_col (:,:) = nan + allocate(this%o2_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_oxid_depth_unsat_col (:,:) = nan + allocate(this%o2_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_aere_depth_sat_col (:,:) = nan + allocate(this%o2_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_aere_depth_unsat_col (:,:) = nan + allocate(this%co2_decomp_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_decomp_depth_sat_col (:,:) = nan + allocate(this%co2_decomp_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_decomp_depth_unsat_col (:,:) = nan + allocate(this%co2_oxid_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_oxid_depth_sat_col (:,:) = nan + allocate(this%co2_oxid_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_oxid_depth_unsat_col (:,:) = nan + allocate(this%ch4_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_aere_depth_sat_col (:,:) = nan + allocate(this%ch4_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_aere_depth_unsat_col (:,:) = nan + allocate(this%ch4_tran_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_tran_depth_sat_col (:,:) = nan + allocate(this%ch4_tran_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_tran_depth_unsat_col (:,:) = nan + allocate(this%co2_aere_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%co2_aere_depth_sat_col (:,:) = nan + allocate(this%co2_aere_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%co2_aere_depth_unsat_col (:,:) = nan + allocate(this%ch4_surf_aere_sat_col (begc:endc)) ; this%ch4_surf_aere_sat_col (:) = nan + allocate(this%ch4_surf_aere_unsat_col (begc:endc)) ; this%ch4_surf_aere_unsat_col (:) = nan + allocate(this%ch4_ebul_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4_ebul_depth_sat_col (:,:) = nan + allocate(this%ch4_ebul_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4_ebul_depth_unsat_col (:,:) = nan + allocate(this%ch4_ebul_total_sat_col (begc:endc)) ; this%ch4_ebul_total_sat_col (:) = nan + allocate(this%ch4_ebul_total_unsat_col (begc:endc)) ; this%ch4_ebul_total_unsat_col (:) = nan + allocate(this%ch4_surf_ebul_sat_col (begc:endc)) ; this%ch4_surf_ebul_sat_col (:) = nan + allocate(this%ch4_surf_ebul_unsat_col (begc:endc)) ; this%ch4_surf_ebul_unsat_col (:) = nan + allocate(this%ch4_surf_ebul_lake_col (begc:endc)) ; this%ch4_surf_ebul_lake_col (:) = nan + allocate(this%conc_ch4_sat_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_sat_col (:,:) = spval ! detect file input + allocate(this%conc_ch4_unsat_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_unsat_col (:,:) = spval ! detect file input + allocate(this%conc_ch4_lake_col (begc:endc,1:nlevgrnd)) ; this%conc_ch4_lake_col (:,:) = nan + allocate(this%ch4_surf_diff_sat_col (begc:endc)) ; this%ch4_surf_diff_sat_col (:) = nan + allocate(this%ch4_surf_diff_unsat_col (begc:endc)) ; this%ch4_surf_diff_unsat_col (:) = nan + allocate(this%ch4_surf_diff_lake_col (begc:endc)) ; this%ch4_surf_diff_lake_col (:) = nan + allocate(this%conc_o2_lake_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_lake_col (:,:) = nan + allocate(this%ch4_dfsat_flux_col (begc:endc)) ; this%ch4_dfsat_flux_col (:) = nan + allocate(this%zwt_ch4_unsat_col (begc:endc)) ; this%zwt_ch4_unsat_col (:) = nan + allocate(this%fsat_bef_col (begc:endc)) ; this%fsat_bef_col (:) = nan + allocate(this%lake_soilc_col (begc:endc,1:nlevgrnd)) ; this%lake_soilc_col (:,:) = spval !first time-step + allocate(this%totcolch4_col (begc:endc)) ; this%totcolch4_col (:) = nan + allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan + allocate(this%tempavg_somhr_col (begc:endc)) ; this%tempavg_somhr_col (:) = nan + allocate(this%annavg_somhr_col (begc:endc)) ; this%annavg_somhr_col (:) = nan + allocate(this%tempavg_finrw_col (begc:endc)) ; this%tempavg_finrw_col (:) = nan + allocate(this%annavg_finrw_col (begc:endc)) ; this%annavg_finrw_col (:) = nan + allocate(this%sif_col (begc:endc)) ; this%sif_col (:) = nan + allocate(this%ch4stress_unsat_col (begc:endc,1:nlevgrnd)) ; this%ch4stress_unsat_col (:,:) = nan + allocate(this%ch4stress_sat_col (begc:endc,1:nlevgrnd)) ; this%ch4stress_sat_col (:,:) = nan + allocate(this%qflx_surf_lag_col (begc:endc)) ; this%qflx_surf_lag_col (:) = nan + allocate(this%finundated_lag_col (begc:endc)) ; this%finundated_lag_col (:) = nan + allocate(this%layer_sat_lag_col (begc:endc,1:nlevgrnd)) ; this%layer_sat_lag_col (:,:) = nan + allocate(this%zwt0_col (begc:endc)) ; this%zwt0_col (:) = nan + allocate(this%f0_col (begc:endc)) ; this%f0_col (:) = nan + allocate(this%p3_col (begc:endc)) ; this%p3_col (:) = nan + allocate(this%pH_col (begc:endc)) ; this%pH_col (:) = nan + allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan + + allocate(this%c_atm_grc (begg:endg,1:ngases)) ; this%c_atm_grc (:,:) = nan + allocate(this%ch4co2f_grc (begg:endg)) ; this%ch4co2f_grc (:) = nan + allocate(this%ch4prodg_grc (begg:endg)) ; this%ch4prodg_grc (:) = nan + + allocate(this%tempavg_agnpp_patch (begp:endp)) ; this%tempavg_agnpp_patch (:) = spval + allocate(this%tempavg_bgnpp_patch (begp:endp)) ; this%tempavg_bgnpp_patch (:) = spval + allocate(this%annavg_agnpp_patch (begp:endp)) ; this%annavg_agnpp_patch (:) = spval ! To detect first year + allocate(this%annavg_bgnpp_patch (begp:endp)) ; this%annavg_bgnpp_patch (:) = spval ! To detect first year + + allocate(this%finundated_col (begc:endc)) ; this%finundated_col (:) = nan + allocate(this%o2stress_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2stress_unsat_col (:,:) = nan + allocate(this%o2stress_sat_col (begc:endc,1:nlevgrnd)) ; this%o2stress_sat_col (:,:) = nan + allocate(this%conc_o2_sat_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_sat_col (:,:) = nan + allocate(this%conc_o2_unsat_col (begc:endc,1:nlevgrnd)) ; this%conc_o2_unsat_col (:,:) = nan + allocate(this%o2_decomp_depth_sat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_sat_col (:,:) = nan + allocate(this%o2_decomp_depth_unsat_col (begc:endc,1:nlevgrnd)) ; this%o2_decomp_depth_unsat_col (:,:) = nan + allocate(this%ch4_surf_flux_tot_col (begc:endc)) ; this%ch4_surf_flux_tot_col (:) = nan + + allocate(this%grnd_ch4_cond_patch (begp:endp)) ; this%grnd_ch4_cond_patch (:) = nan + allocate(this%grnd_ch4_cond_col (begc:endc)) ; this%grnd_ch4_cond_col (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use clm_varpar , only : nlevgrnd, nlevdecomp + use clm_varctl , only : hist_wrtch4diag + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + use ch4varcon , only : allowlakeprod + ! + ! !ARGUMENTS: + class(ch4_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + character(8) :: vr_suffix + character(10) :: active + integer :: begc,endc + integer :: begg,endg + !--------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + begg = bounds%begg; endg = bounds%endg + + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + if (hist_wrtch4diag) then + active = "active" + else + active = "inactive" + end if + + this%finundated_col(begc:endc) = spval + call hist_addfld1d (fname='FINUNDATED', units='unitless', & + avgflag='A', long_name='fractional inundated area of vegetated columns', & + ptr_col=this%finundated_col) + + this%finundated_lag_col(begc:endc) = spval + call hist_addfld1d (fname='FINUNDATED_LAG', units='unitless', & + avgflag='A', long_name='time-lagged inundated fraction of vegetated columns', & + ptr_col=this%finundated_lag_col) + + this%ch4_surf_diff_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_DIFF_SAT', units='mol/m2/s', & + avgflag='A', long_name='diffusive surface CH4 flux for inundated / lake area; (+ to atm)', & + ptr_col=this%ch4_surf_diff_sat_col) + + this%ch4_surf_diff_unsat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_DIFF_UNSAT', units='mol/m2/s', & + avgflag='A', long_name='diffusive surface CH4 flux for non-inundated area; (+ to atm)', & + ptr_col=this%ch4_surf_diff_unsat_col) + + this%ch4_ebul_total_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_EBUL_TOTAL_SAT', units='mol/m2/s', & + avgflag='A', long_name='ebullition surface CH4 flux; (+ to atm)', & + ptr_col=this%ch4_ebul_total_sat_col, default='inactive') + + this%ch4_ebul_total_unsat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_EBUL_TOTAL_UNSAT', units='mol/m2/s', & + avgflag='A', long_name='ebullition surface CH4 flux; (+ to atm)', & + ptr_col=this%ch4_ebul_total_unsat_col, default='inactive') + + this%ch4_surf_ebul_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_EBUL_SAT', units='mol/m2/s', & + avgflag='A', long_name='ebullition surface CH4 flux for inundated / lake area; (+ to atm)', & + ptr_col=this%ch4_surf_ebul_sat_col) + + this%ch4_surf_ebul_unsat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_EBUL_UNSAT', units='mol/m2/s', & + avgflag='A', long_name='ebullition surface CH4 flux for non-inundated area; (+ to atm)', & + ptr_col=this%ch4_surf_ebul_unsat_col) + + this%ch4_surf_aere_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_AERE_SAT', units='mol/m2/s', & + avgflag='A', long_name='aerenchyma surface CH4 flux for inundated area; (+ to atm)', & + ptr_col=this%ch4_surf_aere_sat_col) + + this%ch4_surf_aere_unsat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_AERE_UNSAT', units='mol/m2/s', & + avgflag='A', long_name='aerenchyma surface CH4 flux for non-inundated area; (+ to atm)', & + ptr_col=this%ch4_surf_aere_unsat_col) + + this%totcolch4_col(begc:endc) = spval + call hist_addfld1d (fname='TOTCOLCH4', units='gC/m2', & + avgflag='A', long_name='total belowground CH4, (0 for non-lake special landunits)', & + ptr_col=this%totcolch4_col) + + this%conc_ch4_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_CH4_SAT', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil Concentration for inundated / lake area', & + ptr_col=this%conc_ch4_sat_col) + + this%conc_ch4_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_CH4_UNSAT', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil Concentration for non-inundated area', & + ptr_col=this%conc_ch4_unsat_col) + + if (hist_wrtch4diag) then + this%ch4_prod_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_PROD_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil production for inundated / lake area', & + ptr_col=this%ch4_prod_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_prod_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_PROD_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil production for non-inundated area', & + ptr_col=this%ch4_prod_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_oxid_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_OXID_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil oxidation for inundated / lake area', & + ptr_col=this%ch4_oxid_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_oxid_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_OXID_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil oxidation for non-inundated area', & + ptr_col=this%ch4_oxid_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_aere_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_AERE_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil aerenchyma loss for inundated / lake area '// & + ' (including transpiration flux if activated)', & + ptr_col=this%ch4_aere_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_aere_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_AERE_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil aerenchyma loss for non-inundated area '// & + ' (including transpiration flux if activated)', & + ptr_col=this%ch4_aere_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%o2_aere_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='O2_AERE_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='O2 aerenchyma diffusion into soil for inundated / lake area', & + ptr_col=this%o2_aere_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%o2_aere_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='O2_AERE_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='O2 aerenchyma diffusion into soil for non-inundated area', & + ptr_col=this%o2_aere_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + call hist_addfld2d (fname='O2_DECOMP_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='O2 consumption from HR and AR for inundated / lake area', & + ptr_col=this%o2_decomp_depth_sat_col) + end if + + this%o2_decomp_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + if (hist_wrtch4diag) then + this%o2_decomp_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='O2_DECOMP_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='O2 consumption from HR and AR for non-inundated area', & + ptr_col=this%o2_decomp_depth_unsat_col) + else + call hist_addfld2d (fname='o2_decomp_depth_unsat', units='mol/m3/2', type2d='levgrnd', & + avgflag='A', long_name='o2_decomp_depth_unsat', & + ptr_col=this%o2_decomp_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_tran_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_TRAN_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil loss from transpiration for inundated / lake area', & + ptr_col=this%ch4_tran_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_tran_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_TRAN_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil loss from transpiration for non-inundated area', & + ptr_col=this%ch4_tran_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_ebul_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_EBUL_DEPTH_SAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil ebullition for inundated / lake area', & + ptr_col=this%ch4_ebul_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%ch4_ebul_depth_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_EBUL_DEPTH_UNSAT', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 soil ebullition for non-inundated area', & + ptr_col=this%ch4_ebul_depth_unsat_col) + end if + + if (hist_wrtch4diag) then + this%o2stress_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='O2STRESS_SAT', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='Ratio of oxygen available to demanded for non-inundated area', & + ptr_col=this%o2stress_sat_col) + end if + + if (hist_wrtch4diag) then + this%o2stress_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='O2STRESS_UNSAT', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='Ratio of oxygen available to demanded for inundated / lake area', & + ptr_col=this%o2stress_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4stress_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4STRESS_UNSAT', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='Ratio of methane available to total potential sink for inundated / lake area', & + ptr_col=this%ch4stress_unsat_col) + end if + + if (hist_wrtch4diag) then + this%ch4stress_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4STRESS_SAT', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='Ratio of methane available to total potential sink for non-inundated area', & + ptr_col=this%ch4stress_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%ch4_prod_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_PROD_DEPTH_LAKE', units='mol/m3/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 production in each soil layer, lake col. only', & + ptr_col=this%ch4_prod_depth_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%conc_ch4_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_CH4_LAKE', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='CH4 Concentration each soil layer, lake col. only', & + ptr_col=this%conc_ch4_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%conc_o2_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_O2_LAKE', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='O2 Concentration each soil layer, lake col. only', & + ptr_col=this%conc_o2_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%ch4_surf_diff_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_DIFF_LAKE', units='mol/m2/s', & + avgflag='A', long_name='diffusive surface CH4 flux, lake col. only (+ to atm)', & + ptr_col=this%ch4_surf_diff_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%ch4_surf_ebul_sat_col(begc:endc) = spval + call hist_addfld1d (fname='CH4_SURF_EBUL_LAKE', units='mol/m2/s', & + avgflag='A', long_name='ebullition surface CH4 flux, lake col. only (+ to atm)', & + ptr_col=this%ch4_surf_ebul_sat_col) + end if + + if (hist_wrtch4diag .and. allowlakeprod) then + this%ch4_oxid_depth_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CH4_OXID_DEPTH_LAKE', units='mol/m2/s', type2d='levgrnd', & + avgflag='A', long_name='CH4 oxidation in each soil layer, lake col. only', & + ptr_col=this%ch4_oxid_depth_sat_col) + end if + + if (hist_wrtch4diag) then + this%layer_sat_lag_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='LAYER_SAT_LAG', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='lagged saturation status of layer in unsat. zone', & + ptr_col=this%layer_sat_lag_col) + end if + + if (hist_wrtch4diag) then + this%annavg_finrw_col(begc:endc) = spval + call hist_addfld1d (fname='ANNAVG_FINRW', units='unitless', & + avgflag='A', long_name='annual average respiration-weighted FINUNDATED', & + ptr_col=this%annavg_finrw_col) + end if + + if (hist_wrtch4diag) then + this%sif_col(begc:endc) = spval + call hist_addfld1d (fname='SIF', units='unitless', & + avgflag='A', long_name='seasonal inundation factor calculated for sat. CH4 prod. (non-lake)', & + ptr_col=this%sif_col) + end if + + this%conc_o2_sat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_O2_SAT', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='O2 soil Concentration for inundated / lake area', & + ptr_col=this%conc_o2_sat_col) + + this%conc_o2_unsat_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='CONC_O2_UNSAT', units='mol/m3', type2d='levgrnd', & + avgflag='A', long_name='O2 soil Concentration for non-inundated area', & + ptr_col=this%conc_o2_unsat_col) + + this%ch4co2f_grc(begg:endg) = spval + call hist_addfld1d (fname='FCH4TOCO2', units='gC/m2/s', & + avgflag='A', long_name='Gridcell oxidation of CH4 to CO2', & + ptr_lnd=this%ch4co2f_grc) + + this%ch4prodg_grc(begg:endg) = spval + call hist_addfld1d (fname='CH4PROD', units='gC/m2/s', & + avgflag='A', long_name='Gridcell total production of CH4', & + ptr_lnd=this%ch4prodg_grc) + + this%ch4_dfsat_flux_col(begc:endc) = spval + call hist_addfld1d (fname='FCH4_DFSAT', units='kgC/m2/s', & + avgflag='A', long_name='CH4 additional flux due to changing fsat, vegetated landunits only', & + ptr_col=this%ch4_dfsat_flux_col) + + this%zwt_ch4_unsat_col(begc:endc) = spval + call hist_addfld1d (fname='ZWT_CH4_UNSAT', units='m', & + avgflag='A', long_name='depth of water table for methane production used in non-inundated area', & + ptr_col=this%zwt_ch4_unsat_col) + + this%qflx_surf_lag_col(begc:endc) = spval + call hist_addfld1d (fname='QOVER_LAG', units='mm/s', & + avgflag='A', long_name='time-lagged surface runoff for soil columns', & + ptr_col=this%qflx_surf_lag_col) + + if (allowlakeprod) then + this%lake_soilc_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld2d (fname='LAKE_SOILC', units='gC/m3', type2d='levgrnd', & + avgflag='A', long_name='Soil carbon under lakes', & + ptr_col=this%lake_soilc_col) + end if + + this%grnd_ch4_cond_col(begc:endc) = spval + call hist_addfld1d (fname='WTGQ', units='m/s', & + avgflag='A', long_name='surface tracer conductance', & + ptr_col=this%grnd_ch4_cond_col) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, cellorg_col, fsurdat) + ! + ! !DESCRIPTION: + ! - Sets cold start values for time varying values. + ! Initializes the following time varying variables: + ! conc_ch4_sat, conc_ch4_unsat, conc_o2_sat, conc_o2_unsat, + ! lake_soilc, o2stress, finunduated + ! - Sets variables for ch4 code that will not be input + ! from restart/inic file. + ! - Sets values for inactive CH4 columns to spval so that they will + ! not be averaged in history file. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp + use landunit_varcon , only : istsoil, istdlak, istcrop + use clm_varctl , only : iulog + use ch4varcon , only : allowlakeprod, usephfact, fin_use_fsat + use spmdMod , only : masterproc + use fileutils , only : getfil + use ncdio_pio + ! + ! !ARGUMENTS: + class(ch4_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: cellorg_col (bounds%begc:, 1:) + character(len=*) , intent(in) :: fsurdat ! surface data file name + ! + ! !LOCAL VARIABLES: + integer :: j ,g, l,c,p ! indices + type(file_desc_t) :: ncid ! netcdf id + real(r8) ,pointer :: zwt0_in (:) ! read in - zwt0 + real(r8) ,pointer :: f0_in (:) ! read in - f0 + real(r8) ,pointer :: p3_in (:) ! read in - p3 + real(r8) ,pointer :: pH_in (:) ! read in - pH + character(len=256) :: locfn ! local file name + logical :: readvar ! If read variable from file or not + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(cellorg_col) == (/bounds%endc, nlevsoi/)), errMsg(__FILE__, __LINE__)) + + !---------------------------------------- + ! Initialize time constant variables + !---------------------------------------- + + allocate(zwt0_in(bounds%begg:bounds%endg)) + allocate(f0_in(bounds%begg:bounds%endg)) + allocate(p3_in(bounds%begg:bounds%endg)) + if (usephfact) allocate(ph_in(bounds%begg:bounds%endg)) + + ! Methane code parameters for finundated + + call getfil( fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + if (.not. fin_use_fsat) then + call ncd_io(ncid=ncid, varname='ZWT0', flag='read', data=zwt0_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Running with CH4 Model but ZWT0 not on surfdata file'//& + errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='F0', flag='read', data=f0_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Running with CH4 Model but F0 not on surfdata file'//& + errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='P3', flag='read', data=p3_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Running with CH4 Model but P3 not on surfdata file'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + ! pH factor for methane model + if (usephfact) then + call ncd_io(ncid=ncid, varname='PH', flag='read', data=ph_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: CH4 pH production factor activated in ch4par_in'//& + 'but pH is not on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + end if + call ncd_pio_closefile(ncid) + + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + + if (.not. fin_use_fsat) then + this%zwt0_col(c) = zwt0_in(g) + this%f0_col(c) = f0_in(g) + this%p3_col(c) = p3_in(g) + end if + if (usephfact) this%pH_col(c) = pH_in(g) + end do + + deallocate(zwt0_in, f0_in, p3_in) + if (usephfact) deallocate(pH_in) + + !---------------------------------------- + ! Initialize time varying variables + !---------------------------------------- + + if ( masterproc ) write (iulog,*) 'Setting initial data to non-spun up values for CH4 Mod' + + do c = bounds%begc,bounds%endc + + ! To detect first time-step + this%fsat_bef_col (c) = spval + this%annsum_counter_col (c) = spval + this%totcolch4_col (c) = spval + + ! To detect first year + this%annavg_somhr_col(c) = spval + this%annavg_finrw_col(c) = spval + + ! To detect file input + this%qflx_surf_lag_col (c) = spval + this%finundated_lag_col (c) = spval + this%layer_sat_lag_col (c,:) = spval + this%conc_ch4_sat_col (c,:) = spval + this%conc_ch4_unsat_col (c,:) = spval + this%conc_o2_sat_col (c,:) = spval + this%conc_o2_unsat_col (c,:) = spval + this%o2stress_sat_col (c,:) = spval + this%o2stress_unsat_col (c,:) = spval + this%ch4stress_sat_col (c,:) = spval + this%ch4stress_unsat_col(c,:) = spval + this%lake_soilc_col (c,:) = spval + + ! To detect first time-step for denitrification code + this%o2_decomp_depth_unsat_col(c,:)= spval + + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + this%conc_ch4_sat_col (c,1:nlevsoi) = 0._r8 + this%conc_ch4_unsat_col (c,1:nlevsoi) = 0._r8 + this%conc_o2_sat_col (c,1:nlevsoi) = 0._r8 + this%conc_o2_unsat_col (c,1:nlevsoi) = 0._r8 + this%o2stress_sat_col (c,1:nlevsoi) = 1._r8 + this%o2stress_unsat_col (c,1:nlevsoi) = 1._r8 + this%layer_sat_lag_col (c,1:nlevsoi) = 1._r8 + this%qflx_surf_lag_col (c) = 0._r8 + this%finundated_lag_col (c) = 0._r8 + this%finundated_col(c) = 0._r8 + ! finundated will be used to calculate soil decomposition if anoxia is used + ! Note that finundated will be overwritten with this%fsat_bef_col upon reading + ! a restart file - either in a continuation, branch or startup spun-up case + + else if (lun%itype(l) == istdlak) then + + this%conc_ch4_sat_col(c,1:nlevsoi) = 0._r8 + this%conc_o2_sat_col (c,1:nlevsoi) = 0._r8 + this%lake_soilc_col (c,1:nlevsoi) = 580._r8 * cellorg_col(c,1:nlevsoi) + + end if + + ! Set values for all columns equal below nlevsoi + + this%conc_ch4_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%conc_ch4_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%conc_o2_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%conc_o2_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%lake_soilc_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2stress_sat_col (c,nlevsoi+1:nlevgrnd) = 1._r8 + this%o2stress_unsat_col (c,nlevsoi+1:nlevgrnd) = 1._r8 + this%layer_sat_lag_col (c,nlevsoi+1:nlevgrnd) = 1._r8 + this%ch4_prod_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_prod_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_prod_depth_lake_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_oxid_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_oxid_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_oxid_depth_lake_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_oxid_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_oxid_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_decomp_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_decomp_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_aere_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%o2_aere_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_decomp_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_decomp_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_oxid_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_oxid_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_aere_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_aere_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_tran_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_tran_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_aere_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%co2_aere_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_ebul_depth_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4_ebul_depth_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%conc_ch4_lake_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%conc_o2_lake_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4stress_unsat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + this%ch4stress_sat_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + this%conc_ch4_lake_col (c,:) = spval + this%conc_o2_lake_col (c,:) = spval + this%ch4_surf_diff_lake_col (c) = spval + this%ch4_surf_ebul_lake_col (c) = spval + this%ch4_prod_depth_lake_col (c,:) = spval + this%ch4_oxid_depth_lake_col (c,:) = spval + + else if (lun%itype(l) == istdlak .and. allowlakeprod) then + + this%ch4_prod_depth_unsat_col (c,:) = spval + this%ch4_oxid_depth_unsat_col (c,:) = spval + this%o2_oxid_depth_unsat_col (c,:) = spval + this%o2_decomp_depth_unsat_col (c,:) = spval + this%o2_aere_depth_unsat_col (c,:) = spval + this%co2_decomp_depth_unsat_col (c,:) = spval + this%co2_oxid_depth_unsat_col (c,:) = spval + this%ch4_aere_depth_unsat_col (c,:) = spval + this%ch4_tran_depth_unsat_col (c,:) = spval + this%co2_aere_depth_unsat_col (c,:) = spval + this%ch4_surf_aere_unsat_col (c) = spval + this%ch4_ebul_depth_unsat_col (c,:) = spval + this%ch4_ebul_total_unsat_col (c) = spval + this%ch4_surf_ebul_unsat_col (c) = spval + this%ch4_surf_diff_unsat_col (c) = spval + this%ch4_dfsat_flux_col (c) = spval + this%zwt_ch4_unsat_col (c) = spval + this%sif_col (c) = spval + this%o2stress_unsat_col (c,:) = spval + this%ch4stress_unsat_col (c,:) = spval + this%finundated_col (c) = spval + + else ! Inactive CH4 columns + + this%ch4_prod_depth_sat_col (c,:) = spval + this%ch4_prod_depth_unsat_col (c,:) = spval + this%ch4_prod_depth_lake_col (c,:) = spval + this%ch4_oxid_depth_sat_col (c,:) = spval + this%ch4_oxid_depth_unsat_col (c,:) = spval + this%ch4_oxid_depth_lake_col (c,:) = spval + this%o2_oxid_depth_sat_col (c,:) = spval + this%o2_oxid_depth_unsat_col (c,:) = spval + this%o2_decomp_depth_sat_col (c,:) = spval + this%o2_decomp_depth_unsat_col (c,:) = spval + this%o2_aere_depth_sat_col (c,:) = spval + this%o2_aere_depth_unsat_col (c,:) = spval + this%co2_decomp_depth_sat_col (c,:) = spval + this%co2_decomp_depth_unsat_col (c,:) = spval + this%co2_oxid_depth_sat_col (c,:) = spval + this%co2_oxid_depth_unsat_col (c,:) = spval + this%ch4_aere_depth_sat_col (c,:) = spval + this%ch4_aere_depth_unsat_col (c,:) = spval + this%ch4_tran_depth_sat_col (c,:) = spval + this%ch4_tran_depth_unsat_col (c,:) = spval + this%co2_aere_depth_sat_col (c,:) = spval + this%co2_aere_depth_unsat_col (c,:) = spval + this%ch4_surf_aere_sat_col (c) = spval + this%ch4_surf_aere_unsat_col (c) = spval + this%ch4_ebul_depth_sat_col (c,:) = spval + this%ch4_ebul_depth_unsat_col (c,:) = spval + this%ch4_ebul_total_sat_col (c) = spval + this%ch4_ebul_total_unsat_col (c) = spval + this%ch4_surf_ebul_sat_col (c) = spval + this%ch4_surf_ebul_unsat_col (c) = spval + this%ch4_surf_ebul_lake_col (c) = spval + this%ch4_surf_diff_sat_col (c) = spval + this%ch4_surf_diff_unsat_col (c) = spval + this%ch4_surf_diff_lake_col (c) = spval + this%ch4_dfsat_flux_col (c) = spval + this%zwt_ch4_unsat_col (c) = spval + this%conc_ch4_lake_col (c,:) = spval + this%conc_o2_lake_col (c,:) = spval + this%sif_col (c) = spval + this%o2stress_unsat_col (c,:) = spval + this%o2stress_sat_col (c,:) = spval + this%ch4stress_unsat_col (c,:) = spval + this%ch4stress_sat_col (c,:) = spval + this%finundated_col (c) = spval + this%grnd_ch4_cond_col (c) = spval + + ! totcolch4 Set to zero for inactive columns so that this can be used + ! as an appropriate area-weighted gridcell average soil methane content. + this%totcolch4_col (c) = 0._r8 + + end if + end do + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart( this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/Write biogeophysics information to/from restart file. + ! + ! !USES: + use ncdio_pio , only : ncd_double + use pio , only : file_desc_t + use decompMod , only : bounds_type + use restUtilMod + ! + ! !ARGUMENTS: + class(ch4_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*), intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='tempavg_agnpp', xtype=ncd_double, & + dim1name='pft',& + long_name='Temp. Average AGNPP',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%tempavg_agnpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tempavg_bgnpp', xtype=ncd_double, & + dim1name='pft',& + long_name='Temp. Average BGNPP',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%tempavg_bgnpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annavg_agnpp', xtype=ncd_double, & + dim1name='pft',& + long_name='Ann. Average AGNPP',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%annavg_agnpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='annavg_bgnpp', xtype=ncd_double, & + dim1name='pft',& + long_name='Ann. Average BGNPP',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%annavg_bgnpp_patch) + + call restartvar(ncid=ncid, flag=flag, varname='CONC_O2_SAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='oxygen soil concentration', units='mol/m^3', & + readvar=readvar, interpinic_flag='interp', data=this%conc_o2_sat_col) + + call restartvar(ncid=ncid, flag=flag, varname='CONC_O2_UNSAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='oxygen soil concentration', units='mol/m^3', & + readvar=readvar, interpinic_flag='interp', data=this%conc_o2_unsat_col) + + call restartvar(ncid=ncid, flag=flag, varname='O2STRESS_SAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='oxygen stress fraction', units='', & + readvar=readvar, interpinic_flag='interp', data=this%o2stress_sat_col) + + call restartvar(ncid=ncid, flag=flag, varname='O2STRESS_UNSAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='oxygen stress fraction', units='', & + readvar=readvar, interpinic_flag='interp', data=this%o2stress_unsat_col) + + call restartvar(ncid=ncid, flag=flag, varname='O2_DECOMP_DEPTH_SAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='O2 consumption during decomposition', units='mol/m3/s', & + readvar=readvar, interpinic_flag='interp', data=this%o2_decomp_depth_sat_col) + + call restartvar(ncid=ncid, flag=flag, varname='O2_DECOMP_DEPTH_UNSAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='O2 consumption during decomposition', units='mol/m3/s', & + readvar=readvar, interpinic_flag='interp', data=this%o2_decomp_depth_unsat_col) + + call restartvar(ncid=ncid, flag=flag, varname='CONC_CH4_SAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='methane soil concentration', units='mol/m^3', & + readvar=readvar, interpinic_flag='interp', data=this%conc_ch4_sat_col) + + call restartvar(ncid=ncid, flag=flag, varname='CONC_CH4_UNSAT', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='methane soil concentration', units='mol/m^3', & + readvar=readvar, interpinic_flag='interp', data=this%conc_ch4_unsat_col) + + call restartvar(ncid=ncid, flag=flag, varname='LAYER_SAT_LAG', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='lagged saturation status of layer in unsat. zone', units='', & + readvar=readvar, interpinic_flag='interp', data=this%layer_sat_lag_col) + + call restartvar(ncid=ncid, flag=flag, varname='QFLX_SURF_LAG', xtype=ncd_double, & + dim1name='column', & + long_name='time-lagged surface runoff', units='mm/s', & + readvar=readvar, interpinic_flag='interp', data=this%qflx_surf_lag_col) + + call restartvar(ncid=ncid, flag=flag, varname='FINUNDATED_LAG', xtype=ncd_double, & + dim1name='column', & + long_name='time-lagged inundated fraction', units='', & + readvar=readvar, interpinic_flag='interp', data=this%finundated_lag_col) + + call restartvar(ncid=ncid, flag=flag, varname='FINUNDATED', xtype=ncd_double, & + dim1name='column', & + long_name='inundated fraction', units='', & + readvar=readvar, interpinic_flag='interp', data=this%fsat_bef_col) + + call restartvar(ncid=ncid, flag=flag, varname='annavg_somhr', xtype=ncd_double, & + dim1name='column',& + long_name='Annual Average SOMHR',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%annavg_somhr_col) + + call restartvar(ncid=ncid, flag=flag, varname='annavg_finrw', xtype=ncd_double, & + dim1name='column',& + long_name='Annual Average Respiration-Weighted FINUNDATED',units='', & + readvar=readvar, interpinic_flag='interp', data=this%annavg_finrw_col) + + call restartvar(ncid=ncid, flag=flag, varname='annsum_counter_ch4', xtype=ncd_double, & + dim1name='column',& + long_name='CH4 Ann. Sum Time Counter',units='s', & + readvar=readvar, interpinic_flag='interp', data=this%annsum_counter_col) + + call restartvar(ncid=ncid, flag=flag, varname='tempavg_somhr', xtype=ncd_double, & + dim1name='column',& + long_name='Temp. Average SOMHR',units='gC/m^2/s', & + readvar=readvar, interpinic_flag='interp', data=this%tempavg_somhr_col) + + call restartvar(ncid=ncid, flag=flag, varname='tempavg_finrw', xtype=ncd_double, & + dim1name='column',& + long_name='Temp. Average Respiration-Weighted FINUNDATED',units='', & + readvar=readvar, interpinic_flag='interp', data=this%tempavg_finrw_col) + + call restartvar(ncid=ncid, flag=flag, varname='LAKE_SOILC', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true.,& + long_name='lake soil carbon concentration', units='g/m^3', & + readvar=readvar, interpinic_flag='interp', data=this%lake_soilc_col) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use ncdio_pio , only : file_desc_t,ncd_io + use ch4varcon , only : use_aereoxid_prog + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !-------------------------------------------------------------------- + + if ( .not. use_aereoxid_prog ) then + tString='aereoxid' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%aereoxid=tempr + else + ! value should never be used. + params_inst%aereoxid=nan + endif + + tString='q10ch4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%q10ch4=tempr + + tString='q10ch4base' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%q10ch4base=tempr + + tString='f_ch4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%f_ch4=tempr + + tString='rootlitfrac' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rootlitfrac=tempr + + tString='cnscalefactor' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cnscalefactor=tempr + + tString='redoxlag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%redoxlag=tempr + + tString='lake_decomp_fact' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%lake_decomp_fact=tempr + + tString='redoxlag_vertical' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%redoxlag_vertical=tempr + + tString='pHmax' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%pHmax=tempr + + tString='pHmin' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%pHmin=tempr + + tString='vmax_ch4_oxid' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%vmax_ch4_oxid=45.e-6_r8 * 1000._r8 / 3600._r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%vmax_ch4_oxid=tempr + + tString='oxinhib' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%oxinhib=tempr + + tString='k_m' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_m= 5.e-6_r8 * 1000._r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%k_m=tempr + + tString='q10_ch4oxid' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%q10_ch4oxid=tempr + + tString='smp_crit' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%smp_crit=tempr + + tString='k_m_o2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_m_o2 = 20.e-6_r8 * 1000._r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%k_m_o2=tempr + + tString='k_m_unsat' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_m_unsat= 5.e-6_r8 * 1000._r8 / 10._r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%k_m_unsat=tempr + + tString='vmax_oxid_unsat' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%vmax_oxid_unsat = 45.e-6_r8 * 1000._r8 / 3600._r8 / 10._r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%vmax_oxid_unsat=tempr + + tString='scale_factor_aere' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%scale_factor_aere=tempr + + tString='nongrassporosratio' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%nongrassporosratio=tempr + + tString='unsat_aere_ratio' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%unsat_aere_ratio= 0.05_r8 / 0.3_r8 + ! FIX(FIX(SPM,032414),032414) can't be read off of param file. not bfb since it is a divide + !params_inst%unsat_aere_ratio=tempr + + tString='porosmin' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%porosmin=tempr + + tString='vgc_max' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%vgc_max=tempr + + tString='satpow' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%satpow=tempr + + tString='scale_factor_gasdiff' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%scale_factor_gasdiff=tempr + + tString='scale_factor_liqdiff' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%scale_factor_liqdiff=tempr + + tString='f_sat' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%f_sat=tempr + + tString='qflxlagd' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%qflxlagd=tempr + + tString='highlatfact' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%highlatfact=tempr + + tString='q10lakebase' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%q10lakebase=tempr + + tString='atmch4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%atmch4=tempr + + tString='rob' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rob=tempr + + tString='capthick' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%capthick=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine ch4 (bounds, num_soilc, filter_soilc, num_lakec, filter_lakec, num_soilp, filter_soilp, & + atm2lnd_inst, lakestate_inst, canopystate_inst, soilstate_inst, soilhydrology_inst, & + temperature_inst, energyflux_inst, waterstate_inst, waterflux_inst, & + cnveg_carbonflux_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst, ch4_inst, lnd2atm_inst) + ! + ! !DESCRIPTION: + ! Driver for the methane emissions model + ! + ! !USES: + use subgridAveMod , only : p2c, c2g + use clm_varpar , only : nlevgrnd, nlevdecomp + use pftconMod , only : noveg + use ch4varcon , only : replenishlakec, allowlakeprod, ch4offline, fin_use_fsat + use clm_varcon , only : secspday + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of column soil points in column filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + integer , intent(in) :: num_soilp ! number of soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! output ONLY for forcp_ch4 in ch4offline mode + type(lakestate_type) , intent(in) :: lakestate_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(temperature_type) , intent(in) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + type(lnd2atm_type) , intent(inout) :: lnd2atm_inst + ! + ! !LOCAL VARIABLES: + integer :: sat ! 0 = unsatured, 1 = saturated + logical :: lake ! lake or not lake + integer :: j,fc,c,g,fp,p ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: dtime_ch4 ! ch4 model time step (sec) + integer :: nstep + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + real(r8) :: ch4_prod_tot(bounds%begc:bounds%endc) ! CH4 production for column (g C/m**2/s) + real(r8) :: ch4_oxid_tot(bounds%begc:bounds%endc) ! CH4 oxidation for column (g C/m**2/s) + real(r8) :: nem_col(bounds%begc:bounds%endc) ! net adjustment to atm. C flux from methane production (g C/m**2/s) + real(r8) :: totalsat + real(r8) :: totalunsat + real(r8) :: dfsat + real(r8) :: rootfraction(bounds%begp:bounds%endp, 1:nlevgrnd) + real(r8) :: totcolch4_bef(bounds%begc:bounds%endc) ! g C / m^2 + real(r8) :: errch4 ! g C / m^2 + real(r8) :: zwt_actual + real(r8) :: qflxlags ! Time to lag qflx_surf_lag (s) + real(r8) :: redoxlag ! Redox time lag + real(r8) :: redoxlag_vertical ! Vertical redox lag time + real(r8) :: atmch4 ! Atmospheric CH4 mixing ratio to + ! prescribe if not provided by the atmospheric model (= 1.7e-6_r8) (mol/mol) + real(r8) :: redoxlags ! Redox time lag in s + real(r8) :: redoxlags_vertical ! Vertical redox lag time in s + real(r8) :: qflxlagd ! days to lag qflx_surf_lag in the tropics (days) + real(r8) :: highlatfact ! multiple of qflxlagd for high latitudes + integer :: dummyfilter(1) ! empty filter + character(len=32) :: subname='ch4' ! subroutine name + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevsoi) + + forc_t => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + forc_pbot => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_po2 => atm2lnd_inst%forc_po2_grc , & ! Input: [real(r8) (:) ] O2 partial pressure (Pa) + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] CO2 partial pressure (Pa) + forc_pch4 => atm2lnd_inst%forc_pch4_grc , & ! Input: [real(r8) (:) ] CH4 partial pressure (Pa) + + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) + + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd) + rootfr_col => soilstate_inst%rootfr_col , & ! Output: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd) (p2c) + + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) + + conc_o2_sat => ch4_inst%conc_o2_sat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + zwt0 => ch4_inst%zwt0_col , & ! Input: [real(r8) (:) ] decay factor for finundated (m) + f0 => ch4_inst%f0_col , & ! Input: [real(r8) (:) ] maximum gridcell fractional inundated area + p3 => ch4_inst%p3_col , & ! Input: [real(r8) (:) ] coefficient for qflx_surf_lag for finunated (s/mm) + + grnd_ch4_cond_patch => ch4_inst%grnd_ch4_cond_patch , & ! Input: [real(r8) (:) ] tracer conductance for boundary layer [m/s] + grnd_ch4_cond_col => ch4_inst%grnd_ch4_cond_col , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] (p2c) + + ch4_surf_diff_sat => ch4_inst%ch4_surf_diff_sat_col , & ! Output: [real(r8) (:) ] CH4 surface flux (mol/m2/s) + ch4_surf_diff_unsat => ch4_inst%ch4_surf_diff_unsat_col , & ! Output: [real(r8) (:) ] CH4 surface flux (mol/m2/s) + ch4_surf_diff_lake => ch4_inst%ch4_surf_diff_lake_col , & ! Output: [real(r8) (:) ] CH4 surface flux (mol/m2/s) + ch4_surf_ebul_sat => ch4_inst%ch4_surf_ebul_sat_col , & ! Output: [real(r8) (:) ] CH4 ebullition to atmosphere (mol/m2/s) + ch4_surf_ebul_unsat => ch4_inst%ch4_surf_ebul_unsat_col , & ! Output: [real(r8) (:) ] CH4 ebullition to atmosphere (mol/m2/s) + ch4_surf_ebul_lake => ch4_inst%ch4_surf_ebul_lake_col , & ! Output: [real(r8) (:) ] CH4 ebullition to atmosphere (mol/m2/s) + ch4_surf_aere_sat => ch4_inst%ch4_surf_aere_sat_col , & ! Output: [real(r8) (:) ] Total column CH4 aerenchyma (mol/m2/s) + ch4_surf_aere_unsat => ch4_inst%ch4_surf_aere_unsat_col , & ! Output: [real(r8) (:) ] Total column CH4 aerenchyma (mol/m2/s) + fsat_bef => ch4_inst%fsat_bef_col , & ! Output: [real(r8) (:) ] finundated from previous timestep + ch4_oxid_depth_sat => ch4_inst%ch4_oxid_depth_sat_col , & ! Output: [real(r8) (:,:) ] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_oxid_depth_unsat => ch4_inst%ch4_oxid_depth_unsat_col , & ! Output: [real(r8) (:,:) ] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_oxid_depth_lake => ch4_inst%ch4_oxid_depth_lake_col , & ! Output: [real(r8) (:,:) ] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_prod_depth_sat => ch4_inst%ch4_prod_depth_sat_col , & ! Output: [real(r8) (:,:) ] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + ch4_prod_depth_unsat => ch4_inst%ch4_prod_depth_unsat_col , & ! Output: [real(r8) (:,:) ] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + ch4_prod_depth_lake => ch4_inst%ch4_prod_depth_lake_col , & ! Output: [real(r8) (:,:) ] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + lake_soilc => ch4_inst%lake_soilc_col , & ! Output: [real(r8) (:,:) ] total soil organic matter found in level (g C / m^3) (nlevsoi) + conc_ch4_sat => ch4_inst%conc_ch4_sat_col , & ! Output: [real(r8) (:,:) ] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_ch4_unsat => ch4_inst%conc_ch4_unsat_col , & ! Output: [real(r8) (:,:) ] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_ch4_lake => ch4_inst%conc_ch4_lake_col , & ! Output: [real(r8) (:,:) ] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2_lake => ch4_inst%conc_o2_lake_col , & ! Output: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + ch4_dfsat_flux => ch4_inst%ch4_dfsat_flux_col , & ! Output: [real(r8) (:) ] CH4 flux to atm due to decreasing finundated (kg C/m^2/s) [+] + zwt_ch4_unsat => ch4_inst%zwt_ch4_unsat_col , & ! Output: [real(r8) (:) ] depth of water table for unsaturated fraction (m) + totcolch4 => ch4_inst%totcolch4_col , & ! Output: [real(r8) (:) ] total methane in soil column (g C / m^2) + finundated => ch4_inst%finundated_col , & ! Output: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) + qflx_surf_lag => ch4_inst%qflx_surf_lag_col , & ! Output: [real(r8) (:) ] time-lagged surface runoff (mm H2O /s) + finundated_lag => ch4_inst%finundated_lag_col , & ! Output: [real(r8) (:) ] time-lagged fractional inundated area + layer_sat_lag => ch4_inst%layer_sat_lag_col , & ! Output: [real(r8) (:,:) ] Lagged saturation status of soil layer in the unsaturated zone (1 = sat) + c_atm => ch4_inst%c_atm_grc , & ! Output: [real(r8) (:,:) ] CH4, O2, CO2 atmospheric conc (mol/m3) + ch4co2f => ch4_inst%ch4co2f_grc , & ! Output: [real(r8) (:) ] gridcell CO2 production from CH4 oxidation (g C/m**2/s) + ch4prodg => ch4_inst%ch4prodg_grc , & ! Output: [real(r8) (:) ] gridcell average CH4 production (g C/m^2/s) + ch4_surf_flux_tot => ch4_inst%ch4_surf_flux_tot_col , & ! Output: [real(r8) (:) ] col CH4 flux to atm. (kg C/m**2/s) + + nem_grc => lnd2atm_inst%nem_grc , & ! Output: [real(r8) (:) ] gridcell average net methane correction to CO2 flux (g C/m^2/s) + + begg => bounds%begg , & + endg => bounds%endg , & + begc => bounds%begc , & + endc => bounds%endc , & + begp => bounds%begp , & + endp => bounds%endp & + ) + + redoxlag = params_inst%redoxlag + redoxlag_vertical = params_inst%redoxlag_vertical + atmch4 = params_inst%atmch4 + qflxlagd = params_inst%qflxlagd + highlatfact = params_inst%highlatfact + + dtime = get_step_size() + nstep = get_nstep() + dtime_ch4 = dtime + redoxlags = redoxlag*secspday ! days --> s + redoxlags_vertical = redoxlag_vertical*secspday ! days --> s + rgasm = rgas / 1000._r8 + + jwt(begc:endc) = huge(1) + totcolch4_bef(begc:endc) = nan + + ! Initialize local fluxes to zero: necessary for columns outside the filters because averaging up to gridcell will be done + ch4_surf_flux_tot(begc:endc) = 0._r8 + ch4_prod_tot(begc:endc) = 0._r8 + ch4_oxid_tot(begc:endc) = 0._r8 + rootfraction(begp:endp,:) = spval + + ! Adjustment to NEE for methane production - oxidation + nem_col(begc:endc) = 0._r8 + + do g= begg, endg + if (ch4offline) then + forc_pch4(g) = atmch4*forc_pbot(g) + else + if (forc_pch4(g) == 0._r8) then + write(iulog,*)'not using ch4offline, but methane concentration not passed from the atmosphere', & + 'to land model! CLM Model is stopping.' + call endrun(msg=' ERROR: Methane not being passed to atmosphere'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + c_atm(g,1) = forc_pch4(g) / rgasm / forc_t(g) ! [mol/m3 air] + c_atm(g,2) = forc_po2(g) / rgasm / forc_t(g) ! [mol/m3 air] + c_atm(g,3) = forc_pco2(g) / rgasm / forc_t(g) ! [mol/m3 air] + end do + + ! Initialize CH4 balance and calculate finundated + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + + totcolch4_bef(c) = totcolch4(c) + totcolch4(c) = 0._r8 + + ! Update lagged surface runoff + + if (grc%latdeg(g) < 45._r8) then + qflxlags = qflxlagd * secspday ! 30 days + else + qflxlags = qflxlagd * secspday * highlatfact ! 60 days + end if + qflx_surf_lag(c) = qflx_surf_lag(c) * exp(-dtime/qflxlags) & + + qflx_surf(c) * (1._r8 - exp(-dtime/qflxlags)) + + !There may be ways to improve this for irrigated crop columns... + if (fin_use_fsat) then + finundated(c) = frac_h2osfc(c) + else + if (zwt0(c) > 0._r8) then + if (zwt_perched(c) < z(c,nlevsoi)-1.e-5_r8 .and. zwt_perched(c) < zwt(c)) then + zwt_actual = zwt_perched(c) + else + zwt_actual = zwt(c) + end if + finundated(c) = f0(c) * exp(-zwt_actual/zwt0(c)) + p3(c)*qflx_surf_lag(c) + else + finundated(c) = p3(c)*qflx_surf_lag(c) + end if + end if + finundated(c) = max( min(finundated(c),1._r8), 0._r8) + + ! Update lagged finundated for redox calculation + if (redoxlags > 0._r8) then + finundated_lag(c) = finundated_lag(c) * exp(-dtime/redoxlags) & + + finundated(c) * (1._r8 - exp(-dtime/redoxlags)) + else + finundated_lag(c) = finundated(c) + end if + + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + + totcolch4_bef(c) = totcolch4(c) + totcolch4(c) = 0._r8 + end do + + ! Check to see if finundated changed since the last timestep. If it increased, then reduce conc_ch4_sat + ! proportionally. If it decreased, then add flux to atm. + + do j=1,nlevsoi + do fc = 1, num_soilc + c = filter_soilc(fc) + + if (j==1) then + ch4_dfsat_flux(c) = 0._r8 + end if + + if (fsat_bef(c) /= spval .and. finundated(c) > fsat_bef(c)) then !Reduce conc_ch4_sat + dfsat = finundated(c) - fsat_bef(c) + conc_ch4_sat(c,j) = (fsat_bef(c)*conc_ch4_sat(c,j) + dfsat*conc_ch4_unsat(c,j)) / finundated(c) + else if (fsat_bef(c) /= spval .and. finundated(c) < fsat_bef(c)) then + ch4_dfsat_flux(c) = ch4_dfsat_flux(c) + (fsat_bef(c) - finundated(c))*(conc_ch4_sat(c,j) - conc_ch4_unsat(c,j)) * & + dz(c,j) / dtime * catomw / 1000._r8 ! mol --> kg + end if + end do + end do + + !!!! Begin biochemistry + + ! First for soil + lake = .false. + + ! Do CH4 Annual Averages + call ch4_annualupdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, ch4_inst) + + ! Determine rootfr_col and also check for inactive columns + + if (nlevdecomp == 1) then + + ! Set rootfraction to spval for non-veg points, unless patch%wtcol > 0.99, + ! in which case set it equal to uniform dist. + do j=1, nlevsoi + do fp = 1, num_soilp + p = filter_soilp(fp) + c = patch%column(p) + + if (patch%itype(p) /= noveg) then + rootfraction(p,j) = rootfr(p,j) + else if (patch%wtcol(p) < 0.99_r8) then + rootfraction(p,j) = spval + else + rootfraction(p,j) = dz(c,j) / zi(c,nlevsoi) ! Set equal to uniform distribution + end if + end do + end do + + call p2c (bounds, nlevgrnd, & + rootfraction(bounds%begp:bounds%endp, :), & + rootfr_col(bounds%begc:bounds%endc, :), & + 'unity') + + do j=1, nlevsoi + do fc = 1, num_soilc + c = filter_soilc(fc) + if (.not. col%active(c)) rootfr_col(c,j) = dz(c,j) / zi(c,nlevsoi) + end do + end do + end if + + ! Determine grnd_ch4_cond_col + ! Needed to use non-filter form above so that spval would be treated properly. + + call p2c (bounds, num_soilc, filter_soilc, & + grnd_ch4_cond_patch(bounds%begp:bounds%endp), & + grnd_ch4_cond_col(bounds%begc:bounds%endc)) + + ! Set the gridcell atmospheric CH4 and O2 concentrations + do fc = 1, num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + + c_atm(g,1) = forc_pch4(g) / rgasm / forc_t(g) ! [mol/m3 air] + c_atm(g,2) = forc_po2(g) / rgasm / forc_t(g) ! [mol/m3 air] + !c_atm(g,3) = forc_pco2(g) / rgasm / forc_t(g) ! [mol/m3 air] - Not currently used + enddo + + !------------------------------------------------- + ! Loop over saturated and unsaturated, non-lakes + !------------------------------------------------ + + do sat = 0, 1 ! 0 == unsaturated; 1 = saturated + + ! Get index of water table + if (sat == 0) then ! unsaturated + + call get_jwt (bounds, num_soilc, filter_soilc, jwt(begc:endc), & + soilstate_inst, waterstate_inst, temperature_inst) + + do fc = 1, num_soilc + c = filter_soilc(fc) + zwt_ch4_unsat(c) = zi(c,jwt(c)) + + end do + + ! Update lagged saturation status of layer + do j=1,nlevsoi + do fc = 1, num_soilc + c = filter_soilc(fc) + + if (j > jwt(c) .and. redoxlags_vertical > 0._r8) then ! saturated currently + layer_sat_lag(c,j) = layer_sat_lag(c,j) * exp(-dtime/redoxlags_vertical) & + + (1._r8 - exp(-dtime/redoxlags_vertical)) + else if (redoxlags_vertical > 0._r8) then + layer_sat_lag(c,j) = layer_sat_lag(c,j) * exp(-dtime/redoxlags_vertical) + else if (j > jwt(c)) then ! redoxlags_vertical = 0 + layer_sat_lag(c,j) = 1._r8 + else + layer_sat_lag(c,j) = 0._r8 + end if + end do + end do + + else ! saturated + do fc = 1, num_soilc + c = filter_soilc(fc) + jwt(c) = 0 + end do + endif + + ! calculate CH4 production in each soil layer + call ch4_prod (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + jwt(begc:endc), sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, & + cnveg_carbonflux_inst, soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + ch4_inst) + + ! calculate CH4 oxidation in each soil layer + call ch4_oxid (bounds, & + num_soilc, filter_soilc, & + jwt(begc:endc), sat, lake, & + waterstate_inst, soilstate_inst, temperature_inst, ch4_inst) + + ! calculate CH4 aerenchyma losses in each soil layer + call ch4_aere (bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + jwt(begc:endc), sat, lake, & + canopystate_inst, soilstate_inst, temperature_inst, energyflux_inst, & + waterstate_inst, waterflux_inst, cnveg_carbonflux_inst, ch4_inst) + + ! calculate CH4 ebullition losses in each soil layer + call ch4_ebul (bounds, & + num_soilc, filter_soilc, & + jwt(begc:endc), sat, lake, & + atm2lnd_inst, temperature_inst, lakestate_inst, soilstate_inst, waterstate_inst, & + ch4_inst) + + ! Solve CH4 reaction/diffusion equation + ! Competition for oxygen will occur here. + call ch4_tran (bounds, & + num_soilc, filter_soilc, & + jwt(begc:endc), dtime_ch4, sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, energyflux_inst, ch4_inst) + + enddo ! sat/unsat + + !------------------------------------------------- + ! Now do over lakes + !------------------------------------------------- + + if (allowlakeprod) then + lake = .true. + sat = 1 + do fc = 1, num_lakec + c = filter_lakec(fc) + jwt(c) = 0 + end do + + ! calculate CH4 production in each lake layer + call ch4_prod (bounds, num_lakec, filter_lakec, 0, dummyfilter, & + jwt(begc:endc), sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, & + cnveg_carbonflux_inst, soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + ch4_inst) + + ! calculate CH4 oxidation in each lake layer + call ch4_oxid (bounds, & + num_lakec, filter_lakec, & + jwt(begc:endc), sat, lake, & + waterstate_inst, soilstate_inst, temperature_inst, ch4_inst) + + ! calculate CH4 aerenchyma losses in each lake layer + ! The p filter will not be used here; the relevant column vars will just be set to 0. + call ch4_aere (bounds, num_lakec, filter_lakec, 0, dummyfilter, & + jwt(begc:endc), sat, lake, & + canopystate_inst, soilstate_inst, temperature_inst, energyflux_inst, & + waterstate_inst, waterflux_inst, cnveg_carbonflux_inst, ch4_inst) + + ! calculate CH4 ebullition losses in each lake layer + call ch4_ebul (bounds, num_lakec, filter_lakec, & + jwt(begc:endc), sat, lake, & + atm2lnd_inst, temperature_inst, lakestate_inst, soilstate_inst, waterstate_inst, & + ch4_inst) + + ! Solve CH4 reaction/diffusion equation + ! Competition for oxygen will occur here. + call ch4_tran (bounds, num_lakec, filter_lakec, & + jwt(begc:endc), dtime_ch4, sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, energyflux_inst, ch4_inst) + + end if + + !------------------------------------------------- + ! Average up to gridcell flux and column oxidation and production rate. + !------------------------------------------------- + + ! First weight the soil columns by finundated. + do j=1,nlevsoi + do fc = 1, num_soilc + c = filter_soilc(fc) + + if (j == 1) then + totalsat = ch4_surf_diff_sat(c) + ch4_surf_aere_sat(c) + ch4_surf_ebul_sat(c) + totalunsat = ch4_surf_diff_unsat(c) + ch4_surf_aere_unsat(c) + ch4_surf_ebul_unsat(c) + ch4_surf_flux_tot(c) = (finundated(c)*totalsat + (1._r8 - finundated(c))*totalunsat) * & + catomw / 1000._r8 + !Convert from mol to kg C + ! ch4_oxid_tot and ch4_prod_tot are initialized to zero above + end if + + ch4_oxid_tot(c) = ch4_oxid_tot(c) + (finundated(c)*ch4_oxid_depth_sat(c,j) + & + (1._r8 - finundated(c))*ch4_oxid_depth_unsat(c,j))*dz(c,j) * catomw + !Convert from mol to g C + ch4_prod_tot(c) = ch4_prod_tot(c) + (finundated(c)*ch4_prod_depth_sat(c,j) + & + (1._r8 - finundated(c))*ch4_prod_depth_unsat(c,j))*dz(c,j) * catomw + !Convert from mol to g C + if (j == nlevsoi) then + ! Adjustment to NEE flux to atm. for methane production + nem_col(c) = nem_col(c) - ch4_prod_tot(c) + ! Adjustment to NEE flux to atm. for methane oxidation + nem_col(c) = nem_col(c) + ch4_oxid_tot(c) + end if + end do + end do + + ! Correct for discrepancies in CH4 concentration from changing finundated + + do fc = 1, num_soilc + c = filter_soilc(fc) + + if (fsat_bef(c) /= spval) then ! not first timestep + ch4_surf_flux_tot(c) = ch4_surf_flux_tot(c) + ch4_dfsat_flux(c) + end if + fsat_bef(c) = finundated(c) + end do + + if (allowlakeprod) then + do j=1,nlevsoi + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j == 1) then + ! ch4_oxid_tot and ch4_prod_tot are initialized to zero above + totalsat = ch4_surf_diff_sat(c) + ch4_surf_aere_sat(c) + ch4_surf_ebul_sat(c) + ch4_surf_flux_tot(c) = totalsat*catomw / 1000._r8 + end if + + ch4_oxid_tot(c) = ch4_oxid_tot(c) + ch4_oxid_depth_sat(c,j)*dz(c,j)*catomw + ch4_prod_tot(c) = ch4_prod_tot(c) + ch4_prod_depth_sat(c,j)*dz(c,j)*catomw + + if (.not. replenishlakec) then + !Adjust lake_soilc for production. + lake_soilc(c,j) = lake_soilc(c,j) - 2._r8*ch4_prod_depth_sat(c,j)*dtime*catomw + ! Factor of 2 is for CO2 that comes off with CH4 because of stoichiometry + end if + + if (j == nlevsoi) then + ! Adjustment to NEE flux to atm. for methane production + if (.not. replenishlakec) then + nem_col(c) = nem_col(c) + ch4_prod_tot(c) + ! Here this is positive because it is actually the CO2 that comes off with the methane + ! NOTE THIS MODE ASSUMES TRANSIENT CARBON SUPPLY FROM LAKES; COUPLED MODEL WILL NOT CONSERVE CARBON + ! IN THIS MODE. + else ! replenishlakec + nem_col(c) = nem_col(c) - ch4_prod_tot(c) + ! Keep total C constant, just shift from CO2 to methane + end if + + ! Adjustment to NEE flux to atm. for methane oxidation + nem_col(c) = nem_col(c) + ch4_oxid_tot(c) + + end if + + + !Set lake diagnostic output variables + ch4_prod_depth_lake(c,j) = ch4_prod_depth_sat(c,j) + conc_ch4_lake(c,j) = conc_ch4_sat(c,j) + conc_o2_lake(c,j) = conc_o2_sat(c,j) + ch4_oxid_depth_lake(c,j) = ch4_oxid_depth_sat(c,j) + if (j == 1) then + ch4_surf_diff_lake(c) = ch4_surf_diff_sat(c) + ch4_surf_ebul_lake(c) = ch4_surf_ebul_sat(c) + end if + + end do + end do + end if ! ch4_surf_flux_tot, ch4_oxid_tot, and ch4_prod_tot should be initialized to 0 above if .not. allowlakeprod + + ! Finalize CH4 balance and check for errors + + do j=1,nlevsoi + do fc = 1, num_soilc + c = filter_soilc(fc) + + totcolch4(c) = totcolch4(c) + & + (finundated(c)*conc_ch4_sat(c,j) + (1._r8-finundated(c))*conc_ch4_unsat(c,j))*dz(c,j)*catomw + ! mol CH4 --> g C + + if (j == nlevsoi .and. totcolch4_bef(c) /= spval) then ! not first timestep + ! Check balance + errch4 = totcolch4(c) - totcolch4_bef(c) - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & + - ch4_surf_flux_tot(c)*1000._r8) ! kg C --> g C + if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep + write(iulog,*)'CH4 Conservation Error in CH4Mod driver, nstep, c, errch4 (gC /m^2.timestep)', & + nstep,c,errch4 + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Methane conservation error'//errMsg(__FILE__, __LINE__)) + end if + end if + + end do + if (allowlakeprod) then + do fc = 1, num_lakec + c = filter_lakec(fc) + + totcolch4(c) = totcolch4(c) + conc_ch4_sat(c,j)*dz(c,j)*catomw ! mol CH4 --> g C + + if (j == nlevsoi .and. totcolch4_bef(c) /= spval) then ! not first timestep + ! Check balance + errch4 = totcolch4(c) - totcolch4_bef(c) - dtime*(ch4_prod_tot(c) - ch4_oxid_tot(c) & + - ch4_surf_flux_tot(c)*1000._r8) ! kg C --> g C + if (abs(errch4) > 1.e-7_r8) then ! g C / m^2 / timestep + write(iulog,*)'CH4 Conservation Error in CH4Mod driver for lake column, nstep, c, errch4 (gC/m^2.timestep)', & + nstep,c,errch4 + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Methane conservation error, allowlakeprod'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + end do + end if + end do + + ! Now average up to gridcell for fluxes + call c2g( bounds, & + ch4_oxid_tot(begc:endc), ch4co2f(begg:endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + call c2g( bounds, & + ch4_prod_tot(begc:endc), ch4prodg(begg:endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + call c2g( bounds, & + nem_col(begc:endc), nem_grc(begg:endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + + end associate + + end subroutine ch4 + + !----------------------------------------------------------------------- + subroutine ch4_prod (bounds, num_methc, filter_methc, num_methp, & + filter_methp, jwt, sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, & + cnveg_carbonflux_inst, soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenflux_inst, & + ch4_inst) + ! + ! !DESCRIPTION: + ! Production is done below the water table, based on CN heterotrophic respiration. + ! O2 is consumed by roots & by heterotrophic aerobes. + ! Production is done separately for sat & unsat, and is adjusted for temperature, seasonal inundation, + ! pH (optional), & redox lag factor. + ! + ! !USES: + use ch4varcon , only: usephfact, anoxicmicrosites, ch4rmcnlim + use clm_varctl , only: anoxia + use clm_varpar , only: nlevdecomp, nlevdecomp_full + use CNSharedParamsMod , only: nlev_soildecomp_standard + use pftconMod , only: noveg + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(in) :: num_methp ! number of soil points in patch filter + integer , intent(in) :: filter_methp(:) ! patch filter for soil points + integer , intent(in) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + integer , intent(in) :: sat ! 0 = unsaturated; 1 = saturated + logical , intent(in) :: lake ! function called with lake filter + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(in) :: soilbiogeochem_nitrogenflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,j,g ! indices + integer :: fc ! column index + integer :: fp ! PATCH index + real(r8) :: dtime + real(r8) :: base_decomp ! base rate (mol/m2/s) + real(r8) :: q10lake ! For now, take to be the same as q10ch4 * 1.5. + real(r8) :: q10lakebase ! (K) base temperature for lake CH4 production + real(r8) :: partition_z + real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a fraction of potential aerobic rate + real(r8) :: q10ch4 ! additional Q10 for methane production ABOVE the soil decomposition temperature relationship + real(r8) :: q10ch4base ! temperature at which the effective f_ch4 actually equals the constant f_ch4 + real(r8) :: f_ch4 ! ratio of CH4 production to total C mineralization + real(r8) :: rootlitfrac ! Fraction of soil organic matter associated with roots + real(r8) :: cnscalefactor ! scale factor on CN decomposition for assigning methane flux + real(r8) :: lake_decomp_fact ! Base decomposition rate (1/s) at 25C + + ! added by Lei Meng to account for pH influence of CH4 production + real(r8) :: pHmax + real(r8) :: pHmin + real(r8) :: pH_fact_ch4 ! pH factor in methane production + + ! Factors for methanogen temperature dependence being greater than soil aerobes + real(r8) :: f_ch4_adj ! Adjusted f_ch4 + real(r8) :: t_fact_ch4 ! Temperature factor calculated using additional Q10 + ! O2 limitation on decomposition and methanogenesis + real(r8) :: seasonalfin ! finundated in excess of respiration-weighted annual average + real(r8) :: oxinhib ! inhibition of methane production by oxygen (m^3/mol) + + ! For calculating column average (rootfrac(p,j)*rr(p,j)) + real(r8) :: rr_vr(bounds%begc:bounds%endc, 1:nlevsoi) ! vertically resolved column-mean root respiration (g C/m^2/s) + real(r8), pointer :: ch4_prod_depth(:,:) ! backwards compatibility + real(r8), pointer :: o2_decomp_depth(:,:) ! backwards compatibility + real(r8), pointer :: co2_decomp_depth(:,:) ! backwards compatibility + real(r8), pointer :: conc_o2(:,:) ! backwards compatibility + + character(len=32) :: subname='ch4_prod' ! subroutine name + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevsoi) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevsoi) + rootfr_col => soilstate_inst%rootfr_col , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevsoi) + + rr => cnveg_carbonflux_inst%rr_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) root respiration (fine root MR + total root GR) + col_rr => cnveg_carbonflux_inst%rr_col , & ! Input: [real(r8) (:) ] (gC/m2/s) root respiration (fine root MR + total root GR) + + somhr => soilbiogeochem_carbonflux_inst%somhr_col , & ! Input: [real(r8) (:) ] (gC/m2/s) soil organic matter heterotrophic respiration + lithr => soilbiogeochem_carbonflux_inst%lithr_col , & ! Input: [real(r8) (:) ] (gC/m2/s) litter heterotrophic respiration + hr_vr => soilbiogeochem_carbonflux_inst%hr_vr_col , & ! Input: [real(r8) (:,:) ] total vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + fphr => soilbiogeochem_carbonflux_inst%fphr_col , & ! Input: [real(r8) (:,:) ] fraction of potential heterotrophic respiration + + pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column + pH => ch4_inst%pH_col , & ! Input: [real(r8) (:) ] soil water pH + lake_soilc => ch4_inst%lake_soilc_col , & ! Input: [real(r8) (:,:) ] total soil organic matter found in level (g C / m^3) (nlevsoi) + annavg_finrw => ch4_inst%annavg_finrw_col , & ! Input: [real(r8) (:) ] respiration-weighted annual average of finundated + finundated_lag => ch4_inst%finundated_lag_col , & ! Input: [real(r8) (:) ] time-lagged fractional inundated area + layer_sat_lag => ch4_inst%layer_sat_lag_col , & ! Input: [real(r8) (: ,:) ] Lagged saturation status of soil layer in the unsaturated zone (1 = sat) + sif => ch4_inst%sif_col & ! Output: [real(r8) (:) ] (unitless) ratio applied to sat. prod. to account for seasonal inundation + ) + + if (sat == 0) then ! unsaturated + conc_o2 => ch4_inst%conc_o2_unsat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_unsat_col ! Output: [real(r8) (:,:)] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + o2_decomp_depth => ch4_inst%o2_decomp_depth_unsat_col ! Output: [real(r8) (:,:)] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + co2_decomp_depth => ch4_inst%co2_decomp_depth_unsat_col ! Output: [real(r8) (:,:)] CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + else ! saturated + conc_o2 => ch4_inst%conc_o2_sat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_sat_col ! Output: [real(r8) (:,:)] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + o2_decomp_depth => ch4_inst%o2_decomp_depth_sat_col ! Output: [real(r8) (:,:)] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + co2_decomp_depth => ch4_inst%co2_decomp_depth_sat_col ! Output: [real(r8) (:,:)] CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + endif + + dtime = get_step_size() + + q10ch4 = params_inst%q10ch4 + q10ch4base = params_inst%q10ch4base + f_ch4 = params_inst%f_ch4 + rootlitfrac = params_inst%rootlitfrac + cnscalefactor = params_inst%cnscalefactor + lake_decomp_fact = params_inst%lake_decomp_fact + pHmax = params_inst%pHmax + pHmin = params_inst%pHmin + oxinhib = params_inst%oxinhib + q10lakebase = params_inst%q10lakebase + + ! Shared constant with other modules + mino2lim = CNParamsShareInst%mino2lim + + q10lake = q10ch4 * 1.5_r8 + + ! PATCH loop to calculate vertically resolved column-averaged root respiration + if (.not. lake) then + rr_vr(bounds%begc:bounds%endc,:) = nan + + do fp = 1, num_methc + c = filter_methc(fp) + rr_vr(c,:) = 0.0_r8 + end do + do j=1,nlevsoi + do fp = 1, num_methp + p = filter_methp(fp) + c = patch%column(p) + + if (wtcol(p) > 0._r8 .and. patch%itype(p) /= noveg) then + rr_vr(c,j) = rr_vr(c,j) + rr(p)*rootfr(p,j)*wtcol(p) + end if + end do + end do + end if + + partition_z = 1._r8 + base_decomp = 0.0_r8 + + ! column loop to partition decomposition_rate into each soil layer + do j=1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + g = col%gridcell(c) + + if (.not. lake) then + + if (use_cn) then + ! Use soil heterotrophic respiration (based on Wania) + base_decomp = (somhr(c)+lithr(c)) / catomw + ! Convert from gC to molC + ! Multiply base_decomp by factor accounting for lower carbon stock in seasonally inundated areas than + ! if it were inundated all year. + ! This is to reduce emissions in seasonally inundated zones, because the eq. + ! C-flux will be less than predicted by a non-O2-lim model + if (sat == 1) then + sif(c) = 1._r8 + if (.not. anoxia) then + if (annavg_finrw(c) /= spval) then + seasonalfin = max(finundated(c)-annavg_finrw(c), 0._r8) + if (seasonalfin > 0._r8) then + sif(c) = (annavg_finrw(c) + mino2lim*seasonalfin) / finundated(c) + base_decomp = base_decomp * sif(c) + end if + end if + end if ! anoxia + end if + else + call endrun(msg=' ERROR: No source for decomp rate in CH4Prod.'//& + ' CH4 model currently requires CN.'//errMsg(__FILE__, __LINE__)) + end if ! use_cn + + ! For sensitivity studies + base_decomp = base_decomp * cnscalefactor + + else !lake + + base_decomp = lake_decomp_fact * lake_soilc(c,j) * dz(c,j) * & + q10lake**( (t_soisno(c,j)-q10lakebase)/10._r8) / catomw + ! convert from g C to mol C + end if + + ! For all landunits, prevent production or oxygen consumption when soil is at or below freezing. + ! If using VERTSOILC, it is OK to use base_decomp as given because liquid water stress will limit decomp. + if (t_soisno(c,j) <= tfrz .and. (nlevdecomp == 1 .or. lake)) base_decomp = 0._r8 + + ! depth dependence of production either from rootfr or decomp model + if (.not. lake) then ! use default rootfr, averaged to the column level in the ch4 driver, or vert HR + if (nlevdecomp == 1) then ! not VERTSOILC + if (j <= nlev_soildecomp_standard) then ! Top 5 levels are also used in the CLM code for establishing temperature + ! and moisture constraints on SOM activity + partition_z = rootfr_col(c,j)*rootlitfrac + (1._r8 - rootlitfrac)*dz(c,j)/zi(c,nlev_soildecomp_standard) + else + partition_z = rootfr_col(c,j)*rootlitfrac + end if + else + if ( (somhr(c) + lithr(c)) > 0._r8) then + partition_z = hr_vr(c,j) * dz(c,j) / (somhr(c) + lithr(c)) + else + partition_z = 1._r8 + end if + end if + else ! lake + partition_z = 1._r8 + endif + + ! Adjust f_ch4 to account for the fact that methanogens may have a higher Q10 than aerobic decomposers. + ! Note this is crude and should ideally be applied to all anaerobic decomposition rather than just the + ! f_ch4. + f_ch4_adj = 1.0_r8 + if (.not. lake) then + t_fact_ch4 = q10ch4**((t_soisno(c,j) - q10ch4base)/10._r8) + ! Adjust f_ch4 by the ratio + f_ch4_adj = f_ch4 * t_fact_ch4 + + ! Remove CN nitrogen limitation, as methanogenesis is not N limited. + ! Also remove (low) moisture limitation + if (ch4rmcnlim) then + if (j > nlevdecomp) then + if (fphr(c,1) > 0._r8) then + f_ch4_adj = f_ch4_adj / fphr(c,1) + end if + else ! j == 1 or VERTSOILC + if (fphr(c,j) > 0._r8) then + f_ch4_adj = f_ch4_adj / fphr(c,j) + end if + end if + end if + + else ! lake + f_ch4_adj = 0.5_r8 ! For lakes assume no redox limitation. Production only depends on temp, soil C, and + ! lifetime parameter. + end if + + ! If switched on, use pH factor for production based on spatial pH data defined in surface data. + if (.not. lake .and. usephfact .and. pH(c) > pHmin .and.pH(c) < pHmax) then + pH_fact_ch4 = 10._r8**(-0.2235_r8*pH(c)*pH(c) + 2.7727_r8*pH(c) - 8.6_r8) + ! fitted function using data from Dunfield et al. 1993 + ! Strictly less than one, with optimum at 6.5 + ! From Lei Meng + f_ch4_adj = f_ch4_adj * pH_fact_ch4 + else + ! if no data, then no pH effects + end if + + ! Redox factor + if ( (.not. lake) .and. sat == 1 .and. finundated_lag(c) < finundated(c)) then + f_ch4_adj = f_ch4_adj * finundated_lag(c) / finundated(c) + else if (sat == 0 .and. j > jwt(c)) then ! Assume lag in decay of alternative electron acceptors vertically + f_ch4_adj = f_ch4_adj * layer_sat_lag(c,j) + end if + ! Alternative electron acceptors will be consumed first after soil is inundated. + + f_ch4_adj = min(f_ch4_adj, 0.5_r8) + ! Must be less than 0.5 because otherwise the actual implied aerobic respiration would be negative. + ! The total of aer. respiration + methanogenesis must remain equal to the SOMHR calculated in CN, + ! so that the NEE is sensible. Even perfectly anaerobic conditions with no alternative + ! electron acceptors would predict no more than 0.5 b/c some oxygen is present in organic matter. + ! e.g. 2CH2O --> CH4 + CO2. + + + ! Decomposition uses 1 mol O2 per mol CO2 produced (happens below WT also, to deplete O2 below WT) + ! o2_decomp_depth is the demand in the absense of O2 supply limitation, in addition to autotrophic respiration. + ! Competition will be done in ch4_oxid + + o2_decomp_depth(c,j) = base_decomp * partition_z / dz (c,j) + if (anoxia) then + ! Divide off o_scalar to use potential O2-unlimited HR to represent aerobe demand for oxygen competition + if (.not. lake .and. j > nlevdecomp) then + if (o_scalar(c,1) > 0._r8) then + o2_decomp_depth(c,j) = o2_decomp_depth(c,j) / o_scalar(c,1) + end if + else if (.not. lake) then ! j == 1 or VERTSOILC + if (o_scalar(c,j) > 0._r8) then + o2_decomp_depth(c,j) = o2_decomp_depth(c,j) / o_scalar(c,j) + end if + end if + end if ! anoxia + + ! Add root respiration + if (.not. lake) then + !o2_decomp_depth(c,j) = o2_decomp_depth(c,j) + col_rr(c)*rootfr(c,j)/catomw/dz(c,j) ! mol/m^3/s + o2_decomp_depth(c,j) = o2_decomp_depth(c,j) + rr_vr(c,j)/catomw/dz(c,j) ! mol/m^3/s + ! g C/m2/s ! gC/mol O2 ! m + end if + + ! Add oxygen demand for nitrification + if (use_nitrif_denitrif) then + if (.not. lake .and. j<= nlevdecomp_full ) then + o2_decomp_depth(c,j) = o2_decomp_depth(c,j) + pot_f_nit_vr(c,j) * 2.0_r8/14.0_r8 + ! g N/m^3/s mol O2 / g N + end if + end if + + if (j > jwt(c)) then ! Below the water table so anaerobic CH4 production can occur + ! partition decomposition to layer + ! turn into per volume-total by dz + ch4_prod_depth(c,j) = f_ch4_adj * base_decomp * partition_z / dz (c,j)! [mol/m3-total/s] + else ! Above the WT + if (anoxicmicrosites) then + ch4_prod_depth(c,j) = f_ch4_adj * base_decomp * partition_z / dz (c,j) & + / (1._r8 + oxinhib*conc_o2(c,j)) + else + ch4_prod_depth(c,j) = 0._r8 ! [mol/m3 total/s] + endif ! anoxicmicrosites + endif ! WT + + end do ! fc + end do ! nlevsoi + + end associate + + end subroutine ch4_prod + + !----------------------------------------------------------------------- + subroutine ch4_oxid (bounds, & + num_methc, filter_methc, & + jwt, sat, lake, & + waterstate_inst, soilstate_inst, temperature_inst, ch4_inst) + ! + ! !DESCRIPTION: + ! Oxidation is based on double Michaelis-Mentin kinetics, and is adjusted for low soil moisture. + ! Oxidation will be limited by available oxygen in ch4_tran. + + ! !USES: + use clm_time_manager, only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(in) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + integer , intent(in) :: sat ! 0 = unsaturated; 1 = saturated + logical , intent(in) :: lake ! function called with lake filter + type(waterstate_type) , intent(in) :: waterstate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j ! indices + integer :: fc ! column index + real(r8) :: dtime ! land model time step (sec) + real(r8):: t0 ! Base temperature for Q10 + real(r8):: porevol ! air-filled volume ratio to total soil volume + real(r8):: h2osoi_vol_min ! h2osoi_vol restricted to be below watsat + real(r8):: conc_ch4_rel ! concentration with respect to water volume (mol/m^3 water) + real(r8):: conc_o2_rel ! concentration with respect to water volume (mol/m^3 water) + real(r8):: oxid_a ! Oxidation predicted by method A (temperature & enzyme limited) (mol CH4/m3/s) + real(r8):: smp_fact ! factor for reduction based on soil moisture (unitless) + real(r8):: porewatfrac ! fraction of soil pore space that is filled with water + real(r8):: k_h_cc, k_h_inv ! see functions below for description + real(r8):: k_m_eff ! effective k_m + real(r8):: vmax_eff ! effective vmax + ! ch4 oxidation parameters + real(r8) :: vmax_ch4_oxid ! oxidation rate constant (= 45.e-6_r8 * 1000._r8 / 3600._r8) [mol/m3-w/s]; + real(r8) :: k_m ! Michaelis-Menten oxidation rate constant for CH4 concentration + real(r8) :: q10_ch4oxid ! Q10 oxidation constant + real(r8) :: smp_crit ! Critical soil moisture potential + real(r8) :: k_m_o2 ! Michaelis-Menten oxidation rate constant for O2 concentration + real(r8) :: k_m_unsat ! Michaelis-Menten oxidation rate constant for CH4 concentration + real(r8) :: vmax_oxid_unsat ! (= 45.e-6_r8 * 1000._r8 / 3600._r8 / 10._r8) [mol/m3-w/s] + ! + real(r8), pointer :: ch4_oxid_depth(:,:) + real(r8), pointer :: o2_oxid_depth(:,:) + real(r8), pointer :: co2_oxid_depth(:,:) + real(r8), pointer :: o2_decomp_depth(:,:) + real(r8), pointer :: conc_o2(:,:) + real(r8), pointer :: conc_ch4(:,:) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + + smp_l => soilstate_inst%smp_l_col , & ! Input: [real(r8) (: ,:) ] soil matrix potential [mm] + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + + t_soisno => temperature_inst%t_soisno_col & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + ) + + if (sat == 0) then ! unsaturated + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_unsat_col ! Output: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + o2_oxid_depth => ch4_inst%o2_oxid_depth_unsat_col ! Output: [real(r8) (:,:)] O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + co2_oxid_depth => ch4_inst%co2_oxid_depth_unsat_col ! Output: [real(r8) (:,:)] CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + conc_ch4 => ch4_inst%conc_ch4_unsat_col ! Input: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_unsat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + o2_decomp_depth => ch4_inst%o2_decomp_depth_unsat_col ! Output: [real(r8) (:,:)] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + else ! saturated + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_sat_col ! Output: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + o2_oxid_depth => ch4_inst%o2_oxid_depth_sat_col ! Output: [real(r8) (:,:)] O2 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + co2_oxid_depth => ch4_inst%co2_oxid_depth_sat_col ! Output: [real(r8) (:,:)] CO2 production rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + conc_ch4 => ch4_inst%conc_ch4_sat_col ! Input: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_sat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + o2_decomp_depth => ch4_inst%o2_decomp_depth_sat_col ! Output: [real(r8) (:,:)] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + endif + + ! Get land model time step + dtime = get_step_size() + + ! Set oxidation parameters + vmax_ch4_oxid = params_inst%vmax_ch4_oxid + k_m = params_inst%k_m + q10_ch4oxid = params_inst%q10_ch4oxid + smp_crit = params_inst%smp_crit + k_m_o2 = params_inst%k_m_o2 + k_m_unsat = params_inst%k_m_unsat + vmax_oxid_unsat = params_inst%vmax_oxid_unsat + + t0 = tfrz + 12._r8 ! Walter, for Michigan site where the 45 M/h comes from + + ! Loop to determine oxidation in each layer + do j=1,nlevsoi + do fc = 1, num_methc + c = filter_methc(fc) + + if (sat == 1 .or. j > jwt(c)) then + ! Literature (e.g. Bender & Conrad, 1992) suggests lower k_m and vmax for high-CH4-affinity methanotrophs in + ! upland soils consuming ambient methane. + k_m_eff = k_m + vmax_eff = vmax_ch4_oxid + else + k_m_eff = k_m_unsat + vmax_eff = vmax_oxid_unsat + end if + + porevol = max(watsat(c,j) - h2osoi_vol(c,j), 0._r8) + h2osoi_vol_min = min(watsat(c,j), h2osoi_vol(c,j)) + if (j <= jwt(c) .and. smp_l(c,j) < 0._r8) then + smp_fact = exp(-smp_l(c,j)/smp_crit) + ! Schnell & King, 1996, Figure 3 + else + smp_fact = 1._r8 + end if + + if (j <= jwt(c)) then ! Above the water table + k_h_inv = exp(-c_h_inv(1) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(1))) + k_h_cc = t_soisno(c,j) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + conc_ch4_rel = conc_ch4(c,j) / (h2osoi_vol_min + porevol/k_h_cc) + + k_h_inv = exp(-c_h_inv(2) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(2))) + k_h_cc = t_soisno(c,j) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + conc_o2_rel = conc_o2(c,j) / (h2osoi_vol_min + porevol/k_h_cc) + else + conc_ch4_rel = conc_ch4(c,j) / watsat(c,j) + conc_o2_rel = conc_o2(c,j) / watsat(c,j) + endif + + oxid_a = vmax_eff * h2osoi_vol_min* conc_ch4_rel / (k_m_eff + conc_ch4_rel) & + ![mol/m3-t/s] [mol/m3-w/s] [m3-w/m3-t] [mol/m3-w] [mol/m3-w] [mol/m3-w] + * conc_o2_rel / (k_m_o2 + conc_o2_rel) & + * q10_ch4oxid ** ((t_soisno(c,j) - t0) / 10._r8) * smp_fact + + ! For all landunits / levels, prevent oxidation if at or below freezing + if (t_soisno(c,j) <= tfrz) oxid_a = 0._r8 + + ch4_oxid_depth(c,j) = oxid_a + o2_oxid_depth(c,j) = ch4_oxid_depth(c,j) * 2._r8 + + end do + end do + + end associate + end subroutine ch4_oxid + + !----------------------------------------------------------------------- + subroutine ch4_aere (bounds, num_methc, filter_methc, num_methp, filter_methp, & + jwt, sat, lake, & + canopystate_inst, soilstate_inst, temperature_inst, energyflux_inst, & + waterstate_inst, waterflux_inst, cnveg_carbonflux_inst, ch4_inst) + ! + ! !DESCRIPTION: + ! Arctic c3 grass (which is often present in fens) and all vegetation in inundated areas is assumed to have + ! some root porosity. Currently, root porosity is allowed to be different for grasses & non-grasses. + ! CH4 diffuses out and O2 diffuses into the soil. CH4 is also lossed via transpiration, which is both + ! included in the "aere" variables and output separately. In practice this value is small. + ! By default upland veg. has small 5% porosity but this can be switched to be equal to inundated porosity. + + ! !USES: + use clm_varcon , only : rpi + use clm_time_manager , only : get_step_size + use pftconMod , only : nc3_arctic_grass, nc3_nonarctic_grass, nc4_grass, noveg, pftcon + use ch4varcon , only : transpirationloss, use_aereoxid_prog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(in) :: num_methp ! number of soil points in patch filter + integer , intent(in) :: filter_methp(:) ! patch filter for soil points + integer , intent(in) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + integer , intent(in) :: sat ! 0 = unsaturated; 1 = saturated + logical , intent(in) :: lake ! function called with lake filter + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,g,j ! indices + integer :: fc,fp ! soil filter column index + integer :: itype ! temporary + real(r8) :: f_oxid ! fraction of CH4 oxidized in oxic zone around roots + real(r8) :: diffus_aere ! gas diffusivity through aerenchyma (m^2/s) + real(r8) :: m_tiller + real(r8) :: n_tiller + real(r8) :: poros_tiller + real(r8) :: rob ! root obliquity, e.g. csc of root angle relative to vertical + ! (ratio of root total length to depth) + real(r8) :: area_tiller ! cross-sectional area of tillers (m^2/m^2) + real(r8) :: tranloss ! loss due to transpiration (mol / m3 /s) + real(r8) :: aere, aeretran, oxaere ! (mol / m3 /s) + real(r8) :: k_h_cc, k_h_inv, dtime, oxdiffus, anpp, nppratio, h2osoi_vol_min, conc_ch4_wat + real(r8) :: aerecond ! aerenchyma conductance (m/s) + ! ch4 aerenchyma parameters + real(r8) :: aereoxid ! fraction of methane flux entering aerenchyma rhizosphere + real(r8) :: scale_factor_aere ! scale factor on the aerenchyma area for sensitivity tests + real(r8) :: nongrassporosratio ! Ratio of root porosity in non-grass to grass, used for aerenchyma transport + real(r8) :: unsat_aere_ratio ! Ratio to multiply upland vegetation aerenchyma porosity by compared to inundated systems (= 0.05_r8 / 0.3_r8) + real(r8) :: porosmin ! minimum aerenchyma porosity (unitless)(= 0.05_r8) + + real(r8), parameter :: smallnumber = 1.e-12_r8 + + real(r8), pointer :: ch4_aere_depth(:,:) + real(r8), pointer :: ch4_tran_depth(:,:) + real(r8), pointer :: o2_aere_depth(:,:) + real(r8), pointer :: co2_aere_depth(:,:) + real(r8), pointer :: ch4_oxid_depth(:,:) + real(r8), pointer :: ch4_prod_depth(:,:) + real(r8), pointer :: conc_o2(:,:) + real(r8), pointer :: conc_ch4(:,:) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevsoi) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + rootr => soilstate_inst%rootr_patch , & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer (nlevgrnd) + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevsoi) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + + canopy_cond => energyflux_inst%canopy_cond_patch , & ! Input: [real(r8) (:) ] tracer conductance for canopy [m/s] + + annsum_npp => cnveg_carbonflux_inst%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum NPP (gC/m2/yr) + + annavg_agnpp => ch4_inst%annavg_agnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) annual average aboveground NPP + annavg_bgnpp => ch4_inst%annavg_bgnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) annual average belowground NPP + grnd_ch4_cond => ch4_inst%grnd_ch4_cond_patch , & ! Input: [real(r8) (:) ] tracer conductance for boundary layer [m/s] + c_atm => ch4_inst%c_atm_grc & ! Input: [real(r8) (: ,:) ] CH4, O2, CO2 atmospheric conc (mol/m3) + ) + + if (sat == 0) then ! unsaturated + ch4_aere_depth => ch4_inst%ch4_aere_depth_unsat_col ! Output: [real(r8) (:,:)] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_tran_depth => ch4_inst%ch4_tran_depth_unsat_col ! Output: [real(r8) (:,:)] CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + o2_aere_depth => ch4_inst%o2_aere_depth_unsat_col ! Output: [real(r8) (:,:)] O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + co2_aere_depth => ch4_inst%co2_aere_depth_unsat_col ! Output: [real(r8) (:,:)] CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + conc_ch4 => ch4_inst%conc_ch4_unsat_col ! Input: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_unsat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_unsat_col ! Input: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_unsat_col ! Input: [real(r8) (:,:)] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + else ! saturated + ch4_aere_depth => ch4_inst%ch4_aere_depth_sat_col ! Output: [real(r8) (:,:)] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_tran_depth => ch4_inst%ch4_tran_depth_sat_col ! Output: [real(r8) (:,:)] CH4 loss rate via transpiration in each soil layer (mol/m3/s) (nlevsoi) + o2_aere_depth => ch4_inst%o2_aere_depth_sat_col ! Output: [real(r8) (:,:)] O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + co2_aere_depth => ch4_inst%co2_aere_depth_sat_col ! Output: [real(r8) (:,:)] CO2 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + conc_ch4 => ch4_inst%conc_ch4_sat_col ! Input: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_sat_col ! Input: [real(r8) (:,:)] O2 conc in each soil layer (mol/m3) (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_sat_col ! Input: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_sat_col ! Input: [real(r8) (:,:)] production of CH4 in each soil layer (nlevsoi) (mol/m3/s) + endif + + dtime = get_step_size() + + ! Set aerenchyma parameters + aereoxid = params_inst%aereoxid + scale_factor_aere = params_inst%scale_factor_aere + nongrassporosratio = params_inst%nongrassporosratio + unsat_aere_ratio = params_inst%unsat_aere_ratio + porosmin = params_inst%porosmin + rob = params_inst%rob + + ! Initialize ch4_aere_depth + do j=1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + ch4_aere_depth(c,j) = 0._r8 + ch4_tran_depth(c,j) = 0._r8 + o2_aere_depth(c,j) = 0._r8 + end do + end do + + diffus_aere = d_con_g(1,1)*1.e-4_r8 ! for CH4: m^2/s + ! This parameter is poorly constrained and should be done on a patch-specific basis... + + ! point loop to partition aerenchyma flux into each soil layer + if (.not. lake) then + do j=1,nlevsoi + do fp = 1, num_methp + p = filter_methp (fp) + c = patch%column(p) + g = col%gridcell(c) + + ! Calculate transpiration loss + if (transpirationloss .and. patch%itype(p) /= noveg) then !allow tloss above WT ! .and. j > jwt(c)) then + ! Calculate water concentration + h2osoi_vol_min = min(watsat(c,j), h2osoi_vol(c,j)) + k_h_inv = exp(-c_h_inv(1) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(1))) + k_h_cc = t_soisno(c,j) / k_h_inv * rgasLatm + conc_ch4_wat = conc_ch4(c,j) / ( (watsat(c,j)-h2osoi_vol_min)/k_h_cc + h2osoi_vol_min) + + tranloss = conc_ch4_wat * rootr(p,j)*qflx_tran_veg(p) / dz(c,j) / 1000._r8 + ! mol/m3/s mol/m3 mm / s m mm/m + ! Use rootr here for effective per-layer transpiration, which may not be the same as rootfr + tranloss = max(tranloss, 0._r8) ! in case transpiration is pathological + else + tranloss = 0._r8 + end if + + ! Calculate aerenchyma diffusion + if (j > jwt(c) .and. t_soisno(c,j) > tfrz .and. patch%itype(p) /= noveg) then + ! Attn EK: This calculation of aerenchyma properties is very uncertain. Let's check in once all + ! the new components are in; if there is any tuning to be done to get a realistic global flux, + ! this would probably be the place. We will have to document clearly in the Tech Note + ! any major changes from the Riley et al. 2011 version. (There are a few other minor ones.) + + anpp = annsum_npp(p) ! g C / m^2/yr + anpp = max(anpp, 0._r8) ! NPP can be negative b/c of consumption of storage pools + + if (annavg_agnpp(p) /= spval .and. annavg_bgnpp(p) /= spval .and. & + annavg_agnpp(p) > 0._r8 .and. annavg_bgnpp(p) > 0._r8) then + nppratio = annavg_bgnpp(p) / (annavg_agnpp(p) + annavg_bgnpp(p)) + else + nppratio = 0.5_r8 + end if + + ! Estimate area of tillers (see Wania thesis) + ! m_tiller = anpp * r_leaf_root * lai ! (4.17 Wania) + ! m_tiller = 600._r8 * 0.5_r8 * 2._r8 ! used to be 300 + ! Note: this calculation is based on Arctic graminoids, and should be refined for woody plants, if not + ! done on a patch-specific basis. + + m_tiller = anpp * nppratio * elai(p) + + n_tiller = m_tiller / 0.22_r8 + + itype = patch%itype(p) + if (itype == nc3_arctic_grass .or. pftcon%crop(itype) == 1 .or. & + itype == nc3_nonarctic_grass .or. itype == nc4_grass) then + poros_tiller = 0.3_r8 ! Colmer 2003 + else + poros_tiller = 0.3_r8 * nongrassporosratio + end if + + if (sat == 0) then + poros_tiller = poros_tiller * unsat_aere_ratio + end if + + poros_tiller = max(poros_tiller, porosmin) + + area_tiller = scale_factor_aere * n_tiller * poros_tiller * rpi * 2.9e-3_r8**2._r8 ! (m2/m2) + + k_h_inv = exp(-c_h_inv(1) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(1))) ! (4.12) Wania (L atm/mol) + k_h_cc = t_soisno(c,j) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + aerecond = area_tiller * rootfr(p,j) * diffus_aere / (z(c,j)*rob) + ! Add in boundary layer resistance + aerecond = 1._r8 / (1._r8/(aerecond+smallnumber) + 1._r8/(grnd_ch4_cond(p)+smallnumber)) + + aere = aerecond * (conc_ch4(c,j)/watsat(c,j)/k_h_cc - c_atm(g,1)) / dz(c,j) ![mol/m3-total/s] + !ZS: Added watsat & Henry's const. + aere = max(aere, 0._r8) ! prevent backwards diffusion + + ! Do oxygen diffusion into layer + k_h_inv = exp(-c_h_inv(2) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(2))) + k_h_cc = t_soisno(c,j) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + oxdiffus = diffus_aere * d_con_g(2,1) / d_con_g(1,1) ! adjust for O2:CH4 molecular diffusion + aerecond = area_tiller * rootfr(p,j) * oxdiffus / (z(c,j)*rob) + aerecond = 1._r8 / (1._r8/(aerecond+smallnumber) + 1._r8/(grnd_ch4_cond(p)+smallnumber)) + oxaere = -aerecond *(conc_o2(c,j)/watsat(c,j)/k_h_cc - c_atm(g,2)) / dz(c,j) ![mol/m3-total/s] + oxaere = max(oxaere, 0._r8) + ! Diffusion in is positive; prevent backwards diffusion + if ( .not. use_aereoxid_prog ) then ! fixed aere oxid proportion; will be done in ch4_tran + oxaere = 0._r8 + end if + else + aere = 0._r8 + oxaere = 0._r8 + end if ! veg type, below water table, & above freezing + + ! Impose limitation based on available methane during timestep + ! By imposing the limitation here, don't allow aerenchyma access to methane from other Patches. + aeretran = min(aere+tranloss, conc_ch4(c,j)/dtime + ch4_prod_depth(c,j)) + ch4_aere_depth (c, j) = ch4_aere_depth(c,j) + aeretran*wtcol(p) ! patch weight in col. + ch4_tran_depth (c, j) = ch4_tran_depth(c,j) + min(tranloss, aeretran)*wtcol(p) + o2_aere_depth (c, j) = o2_aere_depth (c,j) + oxaere*wtcol(p) + end do ! p filter + end do ! over levels + end if ! not lake + + end associate + + end subroutine ch4_aere + + !----------------------------------------------------------------------- + subroutine ch4_ebul (bounds, & + num_methc, filter_methc, & + jwt, sat, lake, & + atm2lnd_inst, temperature_inst, lakestate_inst, soilstate_inst, waterstate_inst, & + ch4_inst) + ! + ! !DESCRIPTION: + ! Bubbling is based on temperature & pressure dependent solubility (k_h_cc), + ! with assumed proportion of bubbles + ! which are CH4, and assumed early nucleation at vgc_max sat (Wania). + ! Bubbles are released to the water table surface in ch4_tran. + + ! !USES: + use clm_time_manager , only : get_step_size + use LakeCon + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(in) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + integer , intent(in) :: sat ! 0 = unsaturated; 1 = saturated + logical , intent(in) :: lake ! function called with lake filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j ! indices + integer :: fc ! soil filter column index + integer :: fp ! soil filter patch index + real(r8) :: dtime ! land model time step (sec) + real(r8) :: vgc ! volumetric CH4 content (m3 CH4/m3 pore air) + real(r8) :: vgc_min ! minimum aqueous CH4 content when ebullition ceases + real(r8) :: k_h_inv ! + real(r8) :: k_h ! + real(r8) :: k_h_cc ! + real(r8) :: pressure! sum atmospheric and hydrostatic pressure + real(r8) :: bubble_f! CH4 content in gas bubbles (Kellner et al. 2006) + real(r8) :: ebul_timescale + real(r8) :: vgc_max ! ratio of saturation pressure triggering ebullition + real(r8), pointer :: ch4_ebul_depth(:,:) ! backwards compatibility + real(r8), pointer :: ch4_ebul_total(:) ! backwards compatibility + real(r8), pointer :: conc_ch4(:,:) ! backwards compatibility + real(r8), pointer :: ch4_aere_depth(:,:) ! backwards compatibility + real(r8), pointer :: ch4_oxid_depth(:,:) ! backwards compatibility + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] soil layer depth (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + lakedepth => col%lakedepth , & ! Input: [real(r8) (:) ] column lake depth (m) + + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + frac_h2osfc => waterstate_inst%frac_h2osfc_col & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + ) + + if (sat == 0) then ! unsaturated + ch4_ebul_depth => ch4_inst%ch4_ebul_depth_unsat_col ! Output: [real(r8) (:,:)] CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + ch4_ebul_total => ch4_inst%ch4_ebul_total_unsat_col ! Output: [real(r8) (:)] Total column CH4 ebullition (mol/m2/s) + conc_ch4 => ch4_inst%conc_ch4_unsat_col ! Output: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + ch4_aere_depth => ch4_inst%ch4_aere_depth_unsat_col ! Input: [real(r8) (:,:)] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_unsat_col ! Input: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + else ! saturated + ch4_ebul_depth => ch4_inst%ch4_ebul_depth_sat_col ! Output: [real(r8) (:,:)] CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + ch4_ebul_total => ch4_inst%ch4_ebul_total_sat_col ! Output: [real(r8) (:)] Total column CH4 ebullition (mol/m2/s) + conc_ch4 => ch4_inst%conc_ch4_sat_col ! Output: [real(r8) (:,:)] CH4 conc in each soil layer (mol/m3) (nlevsoi) + ch4_aere_depth => ch4_inst%ch4_aere_depth_sat_col ! Input: [real(r8) (:,:)] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_sat_col ! Input: [real(r8) (:,:)] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + endif + + ! Get land model time step + dtime = get_step_size() + vgc_max = params_inst%vgc_max + + bubble_f = 0.57_r8 ! CH4 content in gas bubbles (Kellner et al. 2006) + vgc_min = vgc_max + ebul_timescale = dtime ! Allow fast bubbling + + ! column loop to estimate ebullition CH4 flux from each soil layer + do j=1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + if (j > jwt(c) .and. t_soisno(c,j) > tfrz) then ! Ebullition occurs only below the water table + + k_h_inv = exp(-c_h_inv(1) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(1))) ! (4.12 Wania) (atm.L/mol) + k_h = 1._r8 / k_h_inv ! (mol/L.atm) + k_h_cc = t_soisno(c,j) * k_h * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + + if (.not. lake) then + pressure = forc_pbot(c) + denh2o * grav * (z(c,j)-zi(c,jwt(c))) ! (Pa) + if (sat == 1 .and. frac_h2osfc(c) > 0._r8) then ! Add ponding pressure head + pressure = pressure + denh2o * grav * h2osfc(c)/1000._r8/frac_h2osfc(c) + ! mm / mm/m + end if + else + pressure = forc_pbot(c) + denh2o * grav * (z(c,j) + lakedepth(c)) + end if + + ! Compare partial pressure to ambient pressure. + vgc = conc_ch4(c,j) / watsat(c,j) / k_h_cc * rgasm * t_soisno(c,j) / pressure + ! [mol/m3t] [m3w/m3t] [m3g/m3w] [Pa/(mol/m3g)] [Pa] + + if (vgc > vgc_max * bubble_f) then ! If greater than max value, remove amount down to vgc_min + ch4_ebul_depth (c,j) = (vgc - vgc_min * bubble_f) * conc_ch4(c,j) / ebul_timescale + ! [mol/m3t/s] [mol/m3t] [s] + else + ch4_ebul_depth (c,j) = 0._r8 + endif + + else ! above the water table or freezing + ch4_ebul_depth (c,j) = 0._r8 + endif ! below the water table and not freezing + + ! Prevent ebullition from reaching the surface for frozen lakes + if (lake .and. lake_icefrac(c,1) > 0.1_r8) ch4_ebul_depth(c,j) = 0._r8 + + end do ! fc + end do ! j + + end associate + + end subroutine ch4_ebul + + !----------------------------------------------------------------------- + subroutine ch4_tran (bounds, & + num_methc, filter_methc, & + jwt, dtime_ch4, sat, lake, & + soilstate_inst, temperature_inst, waterstate_inst, energyflux_inst, ch4_inst) + ! + ! !DESCRIPTION: + ! Solves the reaction & diffusion equation for the timestep. First "competition" between processes for + ! CH4 & O2 demand is done. Then concentrations are apportioned into gas & liquid fractions; only the gas + ! fraction is considered for diffusion in unsat. Snow and lake water resistance to diffusion is added as + ! a bulk term in the ground conductance (which is really a surface layer conductance), but concentrations + ! are not tracked and oxidation is not allowed inside snow and lake water. + ! Diffusivity is set based on soil texture and organic matter fraction. A Crank-Nicholson solution is used. + ! Then CH4 diffusive flux is calculated and consistency is checked. + + ! !USES: + use clm_time_manager , only : get_step_size, get_nstep + use TridiagonalMod , only : Tridiagonal + use ch4varcon , only : ch4frzout, use_aereoxid_prog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(in) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + integer , intent(in) :: sat ! 0 = unsaturated; 1 = saturated + logical , intent(in) :: lake ! function called with lake filter + real(r8) , intent(in) :: dtime_ch4 ! time step for ch4 calculations + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,g,p,s,i,ll ! indices + integer :: fc ! soil filter column index + integer :: fp ! soil filter patch index + integer :: jtop(bounds%begc:bounds%endc) ! top level at each column + integer :: iter ! iteration counter when dtime_ch4 < dtime + real(r8) :: dtime ! land model time step (sec) + real(r8) :: at (bounds%begc:bounds%endc,0:nlevsoi) ! "a" vector for tridiagonal matrix + real(r8) :: bt (bounds%begc:bounds%endc,0:nlevsoi) ! "b" vector for tridiagonal matrix + real(r8) :: ct (bounds%begc:bounds%endc,0:nlevsoi) ! "c" vector for tridiagonal matrix + real(r8) :: rt (bounds%begc:bounds%endc,0:nlevsoi) ! "r" vector for tridiagonal solution + real(r8) :: f_a ! air-filled fraction of available pore space + real(r8) :: diffus (bounds%begc:bounds%endc,0:nlevsoi) ! diffusivity (m2/s) + real(r8) :: k_h_inv ! 1/Henry's Law Constant in Latm/mol + real(r8) :: k_h_cc(bounds%begc:bounds%endc,0:nlevsoi,ngases) ! ratio of mol/m3 in liquid to mol/m3 in gas + real(r8) :: dzj ! + real(r8) :: dp1_zp1 (bounds%begc:bounds%endc,0:nlevsoi) ! diffusivity/delta_z for next j + real(r8) :: dm1_zm1 (bounds%begc:bounds%endc,0:nlevsoi) ! diffusivity/delta_z for previous j + real(r8) :: t_soisno_c ! soil temperature (C) (-nlevsno+1:nlevsoi) + real(r8) :: eps ! either epsilon_a or epsilon_w, depending on where in soil, wrt WT + real(r8) :: deficit ! mol CH4 /m^2 that must be subtracted from diffusive flux to atm. to make up + ! for keeping concentrations always above zero + real(r8) :: conc_ch4_bef(bounds%begc:bounds%endc,1:nlevsoi) ! concentration at the beginning of the timestep + real(r8) :: errch4(bounds%begc:bounds%endc) ! Error (Mol CH4 /m^2) [+ = too much CH4] + real(r8) :: conc_ch4_rel(bounds%begc:bounds%endc,0:nlevsoi) ! Concentration per volume of air or water + real(r8) :: conc_o2_rel(bounds%begc:bounds%endc,0:nlevsoi) ! Concentration per volume of air or water + real(r8) :: conc_ch4_rel_old(bounds%begc:bounds%endc,0:nlevsoi) ! Concentration during last Crank-Nich. loop + real(r8) :: h2osoi_vol_min(bounds%begc:bounds%endc,1:nlevsoi) ! h2osoi_vol restricted to be <= watsat + real(r8), parameter :: smallnumber = 1.e-12_r8 + real(r8) :: snowdiff ! snow diffusivity (m^2/s) + real(r8) :: snowres(bounds%begc:bounds%endc) ! Cumulative Snow resistance (s/m). Also includes + real(r8) :: pondres ! Additional resistance from ponding, up to pondmx water on top of top soil layer (s/m) + real(r8) :: pondz ! Depth of ponding (m) + real(r8) :: ponddiff ! Pondwater diffusivity (m^2/s) + real(r8) :: spec_grnd_cond(bounds%begc:bounds%endc,1:ngases) ! species grnd conductance (s/m) + real(r8) :: airfrac ! air fraction in snow + real(r8) :: waterfrac ! water fraction in snow + real(r8) :: icefrac ! ice fraction in snow + real(r8) :: epsilon_t (bounds%begc:bounds%endc,1:nlevsoi,1:ngases) ! + real(r8) :: epsilon_t_old (bounds%begc:bounds%endc,1:nlevsoi,1:ngases) ! epsilon_t from last time step !Currently deprecated + real(r8) :: source (bounds%begc:bounds%endc,1:nlevsoi,1:ngases) ! source + real(r8) :: source_old (bounds%begc:bounds%endc,1:nlevsoi,1:ngases) ! source from last time step !Currently deprecated + real(r8) :: om_frac ! organic matter fraction + real(r8) :: o2demand, ch4demand ! mol/m^3/s + real(r8) :: liqfrac(bounds%begc:bounds%endc, 1:nlevsoi) + real(r8) :: capthick ! (mm) min thickness before assuming h2osfc is impermeable + real(r8) :: satpow ! exponent on watsat for saturated soil solute diffusion + real(r8) :: scale_factor_gasdiff ! For sensitivity tests; convection would allow this to be > 1 + real(r8) :: scale_factor_liqdiff ! For sensitivity tests; convection would allow this to be > 1 + real(r8) :: organic_max ! organic matter content (kg/m3) where soil is assumed to act like peat + real(r8) :: aereoxid ! fraction of methane flux entering aerenchyma rhizosphere + + real(r8), pointer :: ch4_prod_depth (:,:) + real(r8), pointer :: ch4_oxid_depth (:,:) + real(r8), pointer :: ch4_aere_depth (:,:) + real(r8), pointer :: ch4_surf_aere (:) + real(r8), pointer :: ch4_ebul_depth (:,:) + real(r8), pointer :: ch4_ebul_total (:) + real(r8), pointer :: ch4_surf_ebul (:) + real(r8), pointer :: ch4_surf_diff (:) + real(r8), pointer :: o2_oxid_depth (:,:) + real(r8), pointer :: o2_decomp_depth (:,:) + real(r8), pointer :: o2_aere_depth (:,:) + real(r8), pointer :: o2stress (:,:) + real(r8), pointer :: ch4stress (:,:) + real(r8), pointer :: co2_decomp_depth (:,:) + real(r8), pointer :: conc_o2 (:,:) + real(r8), pointer :: conc_ch4 (:,:) + + integer :: nstep ! time step number + character(len=32) :: subname='ch4_tran' ! subroutine name + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] soil layer depth (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + snl => col%snl , & ! Input: [integer (:) ] negative of number of snow layers + + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (nlevgrnd) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + cellorg => soilstate_inst%cellorg_col , & ! Input: [real(r8) (:,:) ] column 3D org (kg/m^3 organic matter) (nlevgrnd) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) [for snow & soil layers] + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) [for snow & soil layers] + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + + c_atm => ch4_inst%c_atm_grc , & ! Input: [real(r8) (:,:) ] CH4, O2, CO2 atmospheric conc (mol/m3) + + grnd_ch4_cond => ch4_inst%grnd_ch4_cond_col & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] + ) + + if (sat == 0) then ! unsaturated + o2_decomp_depth => ch4_inst%o2_decomp_depth_unsat_col ! Output: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + o2stress => ch4_inst%o2stress_unsat_col ! Output: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_unsat_col ! Output: [real(r8) (:,:) ] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_unsat_col ! Output: [real(r8) (:,:) ] CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + ch4_aere_depth => ch4_inst%ch4_aere_depth_unsat_col ! Output: [real(r8) (:,:) ] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_surf_aere => ch4_inst%ch4_surf_aere_unsat_col ! Output: [real(r8) (:) ] Total column CH4 aerenchyma (mol/m2/s) + ch4_ebul_depth => ch4_inst%ch4_ebul_depth_unsat_col ! Output: [real(r8) (:,:) ] CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + ch4_ebul_total => ch4_inst%ch4_ebul_total_unsat_col ! Output: [real(r8) (:) ] Total column CH4 ebullition (mol/m2/s) + ch4_surf_ebul => ch4_inst%ch4_surf_ebul_unsat_col ! Output: [real(r8) (:) ] CH4 ebullition to atmosphere (mol/m2/s) + ch4_surf_diff => ch4_inst%ch4_surf_diff_unsat_col ! Output: [real(r8) (:) ] CH4 surface flux (mol/m2/s) + o2_oxid_depth => ch4_inst%o2_oxid_depth_unsat_col ! Output: [real(r8) (:,:) ] O2 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + o2_aere_depth => ch4_inst%o2_aere_depth_unsat_col ! Output: [real(r8) (:,:) ] O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4stress => ch4_inst%ch4stress_unsat_col ! Output: [real(r8) (:,:) ] Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + co2_decomp_depth => ch4_inst%co2_decomp_depth_unsat_col ! Output: [real(r8) (:,:) ] CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_ch4 => ch4_inst%conc_ch4_unsat_col ! Output: [real(r8) (:,:) ] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_unsat_col ! Output: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + else ! saturated + o2_decomp_depth => ch4_inst%o2_decomp_depth_sat_col ! Output: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + o2stress => ch4_inst%o2stress_sat_col ! Output: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + ch4_oxid_depth => ch4_inst%ch4_oxid_depth_sat_col ! Output: [real(r8) (:,:) ] CH4 consumption rate via oxidation in each soil layer (mol/m3/s) (nlevsoi) + ch4_prod_depth => ch4_inst%ch4_prod_depth_sat_col ! Output: [real(r8) (:,:) ] CH4 production rate from methanotrophs (mol/m3/s) (nlevsoi) + ch4_aere_depth => ch4_inst%ch4_aere_depth_sat_col ! Output: [real(r8) (:,:) ] CH4 loss rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4_surf_aere => ch4_inst%ch4_surf_aere_sat_col ! Output: [real(r8) (:) ] Total column CH4 aerenchyma (mol/m2/s) + ch4_ebul_depth => ch4_inst%ch4_ebul_depth_sat_col ! Output: [real(r8) (:,:) ] CH4 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + ch4_ebul_total => ch4_inst%ch4_ebul_total_sat_col ! Output: [real(r8) (:) ] Total column CH4 ebullition (mol/m2/s) + ch4_surf_ebul => ch4_inst%ch4_surf_ebul_sat_col ! Output: [real(r8) (:) ] CH4 ebullition to atmosphere (mol/m2/s) + ch4_surf_diff => ch4_inst%ch4_surf_diff_sat_col ! Output: [real(r8) (:) ] CH4 surface flux (mol/m2/s) + o2_oxid_depth => ch4_inst%o2_oxid_depth_sat_col ! Output: [real(r8) (:,:) ] O2 loss rate via ebullition in each soil layer (mol/m3/s) (nlevsoi) + o2_aere_depth => ch4_inst%o2_aere_depth_sat_col ! Output: [real(r8) (:,:) ] O2 gain rate via aerenchyma in each soil layer (mol/m3/s) (nlevsoi) + ch4stress => ch4_inst%ch4stress_sat_col ! Output: [real(r8) (:,:) ] Ratio of methane available to the total per-timestep methane sinks (nlevsoi) + co2_decomp_depth => ch4_inst%co2_decomp_depth_sat_col ! Output: [real(r8) (:,:) ] CO2 production during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_ch4 => ch4_inst%conc_ch4_sat_col ! Output: [real(r8) (:,:) ] CH4 conc in each soil layer (mol/m3) (nlevsoi) + conc_o2 => ch4_inst%conc_o2_sat_col ! Output: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + endif + + ! Get land model time step + dtime = get_step_size() + nstep = get_nstep() + + ! Set transport parameters + satpow = params_inst%satpow + scale_factor_gasdiff = params_inst%scale_factor_gasdiff + scale_factor_liqdiff = params_inst%scale_factor_liqdiff + capthick = params_inst%capthick + aereoxid = params_inst%aereoxid + + ! Set shared constant + organic_max = CNParamsShareInst%organic_max + + ! Perform competition for oxygen and methane in each soil layer if demands over the course of the timestep + ! exceed that available. Assign to each process in proportion to the quantity demanded in the absense of + ! the limitation. + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + o2demand = o2_decomp_depth(c,j) + o2_oxid_depth(c,j) ! o2_decomp_depth includes autotrophic root respiration + if (o2demand > 0._r8) then + o2stress(c,j) = min((conc_o2(c,j) / dtime + o2_aere_depth(c,j)) / o2demand, 1._r8) + else + o2stress(c,j) = 1._r8 + end if + + ch4demand = ch4_oxid_depth(c,j) + ch4_aere_depth(c,j) + ch4_ebul_depth(c,j) + if (ch4demand > 0._r8) then + ch4stress(c,j) = min((conc_ch4(c,j) / dtime + ch4_prod_depth(c,j)) / ch4demand, 1._r8) + else + ch4stress(c,j) = 1._r8 + end if + + ! Resolve methane oxidation + if (o2stress(c,j) < 1._r8 .or. ch4stress(c,j) < 1._r8) then + if (ch4stress(c,j) <= o2stress(c,j)) then ! methane limited + if (o2stress(c,j) < 1._r8) then + ! Recalculate oxygen limitation + o2demand = o2_decomp_depth(c,j) + if (o2demand > 0._r8) then + o2stress(c,j) = min( (conc_o2(c,j) / dtime + o2_aere_depth(c,j) - ch4stress(c,j)*o2_oxid_depth(c,j) ) & + / o2demand, 1._r8) + else + o2stress(c,j) = 1._r8 + end if + end if + ! Reset oxidation + ch4_oxid_depth(c,j) = ch4_oxid_depth(c,j) * ch4stress(c,j) + o2_oxid_depth(c,j) = o2_oxid_depth(c,j) * ch4stress(c,j) + else ! oxygen limited + if (ch4stress(c,j) < 1._r8) then + ! Recalculate methane limitation + ch4demand = ch4_aere_depth(c,j) + ch4_ebul_depth(c,j) + if (ch4demand > 0._r8) then + ch4stress(c,j) = min( (conc_ch4(c,j) / dtime + ch4_prod_depth(c,j) - & + o2stress(c,j)*ch4_oxid_depth(c,j)) / ch4demand, 1._r8) + else + ch4stress(c,j) = 1._r8 + end if + end if + ! Reset oxidation + ch4_oxid_depth(c,j) = ch4_oxid_depth(c,j) * o2stress(c,j) + o2_oxid_depth(c,j) = o2_oxid_depth(c,j) * o2stress(c,j) + end if + end if + + ! Reset non-methanotroph demands + ch4_aere_depth(c,j) = ch4_aere_depth(c,j) * ch4stress(c,j) + ch4_ebul_depth(c,j) = ch4_ebul_depth(c,j) * ch4stress(c,j) + o2_decomp_depth(c,j) = o2_decomp_depth(c,j) * o2stress(c,j) + + end do !c + end do !j + + + ! Accumulate ebullition to place in first layer above water table, or directly to atmosphere + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + if (j == 1) ch4_ebul_total(c) = 0._r8 + ch4_ebul_total(c) = ch4_ebul_total(c) + ch4_ebul_depth(c,j) * dz(c,j) + enddo + enddo + + + ! Set the Henry's Law coefficients + do j = 0,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + do s=1,2 + if (j == 0) then + k_h_inv = exp(-c_h_inv(s) * (1._r8 / t_grnd(c) - 1._r8 / kh_tbase) + log (kh_theta(s))) + ! (4.12) Wania (L atm/mol) + k_h_cc(c,j,s) = t_grnd(c) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + else + k_h_inv = exp(-c_h_inv(s) * (1._r8 / t_soisno(c,j) - 1._r8 / kh_tbase) + log (kh_theta(s))) + ! (4.12) Wania (L atm/mol) + k_h_cc(c,j,s) = t_soisno(c,j) / k_h_inv * rgasLatm ! (4.21) Wania [(mol/m3w) / (mol/m3g)] + end if + end do + end do + end do + + + ! Set the source term for each species (no need to do j=0, since epsilon_t and source not used there) + ! Note that because of the semi-implicit diffusion and the 30 min timestep combined with explicit + ! sources, occasionally negative concentration will result. In this case it is brought to zero and the + ! surface flux is adjusted to conserve. This results in some inaccuracy as compared to a shorter timestep + ! or iterative solution. + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + if ( .not. use_aereoxid_prog ) then + ! First remove the CH4 oxidation that occurs at the base of root tissues (aere), and add to oxidation + ch4_oxid_depth(c,j) = ch4_oxid_depth(c,j) + aereoxid * ch4_aere_depth(c,j) + ch4_aere_depth(c,j) = ch4_aere_depth(c,j) - aereoxid * ch4_aere_depth(c,j) + end if ! else oxygen is allowed to diffuse in via aerenchyma + + source(c,j,1) = ch4_prod_depth(c,j) - ch4_oxid_depth(c,j) - & + ch4_aere_depth(c,j) - ch4_ebul_depth(c,j) ! [mol/m3-total/s] + ! aerenchyma added to surface flux below + ! ebul added to soil depth just above WT + if (source(c,j,1) + conc_ch4(c,j) / dtime < -1.e-12_r8) then + write(iulog,*) 'Methane demands exceed methane available. Error in methane competition (mol/m^3/s), c,j:', & + source(c,j,1) + conc_ch4(c,j) / dtime, c, j + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Methane demands exceed methane available.'& + //errMsg(__FILE__, __LINE__)) + else if (ch4stress(c,j) < 1._r8 .and. source(c,j,1) + conc_ch4(c,j) / dtime > 1.e-12_r8) then + write(iulog,*) 'Methane limited, yet some left over. Error in methane competition (mol/m^3/s), c,j:', & + source(c,j,1) + conc_ch4(c,j) / dtime, c, j + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Methane limited, yet some left over.'//& + errMsg(__FILE__, __LINE__)) + end if + + source(c,j,2) = -o2_oxid_depth(c,j) - o2_decomp_depth(c,j) + o2_aere_depth(c,j) ! O2 [mol/m3/s] + if (source(c,j,2) + conc_o2(c,j) / dtime < -1.e-12_r8) then + write(iulog,*) 'Oxygen demands exceed oxygen available. Error in oxygen competition (mol/m^3/s), c,j:', & + source(c,j,2) + conc_o2(c,j) / dtime, c, j + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Oxygen demands exceed oxygen available.'//& + errMsg(__FILE__, __LINE__) ) + else if (o2stress(c,j) < 1._r8 .and. source(c,j,2) + conc_o2(c,j) / dtime > 1.e-12_r8) then + write(iulog,*) 'Oxygen limited, yet some left over. Error in oxygen competition (mol/m^3/s), c,j:', & + source(c,j,2) + conc_o2(c,j) / dtime, c, j + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: Oxygen limited, yet some left over.'//errMsg(__FILE__, __LINE__)) + end if + + conc_ch4_bef(c,j) = conc_ch4(c,j) !For Balance Check + enddo ! fc + enddo ! j + + ! Accumulate aerenchyma to add directly to atmospheric flux + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + if (j==1) ch4_surf_aere(c) = 0._r8 + ch4_surf_aere(c) = ch4_surf_aere(c) + ch4_aere_depth(c,j) * dz(c,j) + enddo + enddo + + ! Add in ebullition to source at depth just above WT + do fc = 1, num_methc + c = filter_methc(fc) + if (jwt(c) /= 0) then + source(c,jwt(c),1) = source(c,jwt(c),1) + ch4_ebul_total(c)/dz(c,jwt(c)) + endif + enddo ! fc + + ! Calculate concentration relative to m^3 of air or water: needed for the diffusion + do j = 0,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + g = col%gridcell(c) + + if (j == 0) then + conc_ch4_rel(c,j) = c_atm(g,1) + conc_o2_rel(c,j) = c_atm(g,2) + else + h2osoi_vol_min(c,j) = min(watsat(c,j), h2osoi_vol(c,j)) + if (ch4frzout) then + liqfrac(c,j) = max(0.05_r8, (h2osoi_liq(c,j)/denh2o+smallnumber)/ & + (h2osoi_liq(c,j)/denh2o+h2osoi_ice(c,j)/denice+smallnumber)) + else + liqfrac(c,j) = 1._r8 + end if + if (j <= jwt(c)) then ! Above the WT + do s=1,2 + epsilon_t(c,j,s) = watsat(c,j)- (1._r8-k_h_cc(c,j,s))*h2osoi_vol_min(c,j)*liqfrac(c,j) + end do + ! Partition between the liquid and gas phases. The gas phase will drive the diffusion. + else ! Below the WT + do s=1,2 + epsilon_t(c,j,s) = watsat(c,j)*liqfrac(c,j) + end do + end if + conc_ch4_rel(c,j) = conc_ch4(c,j)/epsilon_t(c,j,1) + conc_o2_rel(c,j) = conc_o2(c,j) /epsilon_t(c,j,2) + end if + end do + end do + + + ! Loop over species + do s = 1, 2 ! 1=CH4; 2=O2; 3=CO2 + + + ! Adjust the grnd_ch4_cond to keep it positive, and add the snow resistance & pond resistance + do j = -nlevsno + 1,0 + do fc = 1, num_methc + c = filter_methc (fc) + + if (j == -nlevsno + 1) then + if (grnd_ch4_cond(c) < smallnumber .and. s==1) grnd_ch4_cond(c) = smallnumber + ! Needed to prevent overflow when ground is frozen, e.g. for lakes + snowres(c) = 0._r8 + end if + + ! Add snow resistance + if (j >= snl(c) + 1) then + t_soisno_c = t_soisno(c,j) - tfrz + icefrac = h2osoi_ice(c,j)/denice/dz(c,j) + waterfrac = h2osoi_liq(c,j)/denh2o/dz(c,j) + airfrac = max(1._r8 - icefrac - waterfrac, 0._r8) + ! Calculate snow diffusivity + if (airfrac > 0.05_r8) then + f_a = airfrac / (airfrac + waterfrac) + eps = airfrac ! Air-filled fraction of total snow volume + ! Use Millington-Quirk Expression, as hydraulic properties (bsw) not available + snowdiff = (d_con_g(s,1) + d_con_g(s,2)*t_soisno_c) * 1.e-4_r8 * & + f_a**(10._r8/3._r8) / (airfrac+waterfrac)**2 & + * scale_factor_gasdiff + else !solute diffusion in water only + eps = waterfrac ! Water-filled fraction of total soil volume + snowdiff = eps**satpow * (d_con_w(s,1) + d_con_w(s,2)*t_soisno_c + d_con_w(s,3)*t_soisno_c**2) * 1.e-9_r8 & + * scale_factor_liqdiff + end if + snowdiff = max(snowdiff, smallnumber) + snowres(c) = snowres(c) + dz(c,j)/snowdiff + end if + + if (j == 0) then ! final loop + ! Add pond resistance + pondres = 0._r8 + + ! First old pond formulation up to pondmx + if (.not. lake .and. snl(c) == 0 .and. h2osoi_vol(c,1) > watsat(c,1)) then + t_soisno_c = t_soisno(c,1) - tfrz + if (t_soisno(c,1) <= tfrz) then + ponddiff = (d_con_w(s,1) + d_con_w(s,2)*t_soisno_c + d_con_w(s,3)*t_soisno_c**2) * 1.e-9_r8 & + * (h2osoi_liq(c,1)/denh2o+smallnumber)/ & + (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice+smallnumber) & + * scale_factor_liqdiff + else ! Unfrozen + ponddiff = (d_con_w(s,1) + d_con_w(s,2)*t_soisno_c + d_con_w(s,3)*t_soisno_c**2) * 1.e-9_r8 & + * scale_factor_liqdiff + end if + pondz = dz(c,1) * (h2osoi_vol(c,1) - watsat(c,1)) + pondres = pondz / ponddiff + end if + + ! Now add new h2osfc form + if (.not. lake .and. sat == 1 .and. frac_h2osfc(c) > 0._r8 .and. t_h2osfc(c) >= tfrz) then + t_soisno_c = t_h2osfc(c) - tfrz + ponddiff = (d_con_w(s,1) + d_con_w(s,2)*t_soisno_c + d_con_w(s,3)*t_soisno_c**2) * 1.e-9_r8 & + * scale_factor_liqdiff + pondz = h2osfc(c) / 1000._r8 / frac_h2osfc(c) ! Assume all h2osfc corresponds to sat area + ! mm / mm/m + pondres = pondres + pondz / ponddiff + else if (.not. lake .and. sat == 1 .and. frac_h2osfc(c) > 0._r8 .and. & + h2osfc(c)/frac_h2osfc(c) > capthick) then ! Assuming short-circuit logic will avoid FPE here. + ! assume surface ice is impermeable + pondres = 1/smallnumber + end if + + spec_grnd_cond(c,s) = 1._r8/(1._r8/grnd_ch4_cond(c) + snowres(c) + pondres) + end if + + end do ! fc + end do ! j + + ! Determine gas diffusion and fraction of open pore (f_a) + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + g = col%gridcell(c) + + t_soisno_c = t_soisno(c,j) - tfrz + + if (j <= jwt(c)) then ! Above the WT + f_a = 1._r8 - h2osoi_vol_min(c,j) / watsat(c,j) + ! Provisionally calculate diffusivity as linear combination of the Millington-Quirk + ! expression in Wania (for peat) & Moldrup (for mineral soil) + eps = watsat(c,j)-h2osoi_vol_min(c,j) ! Air-filled fraction of total soil volume + if (organic_max > 0._r8) then + om_frac = min(cellorg(c,j)/organic_max, 1._r8) + ! Use first power, not square as in iniTimeConst + else + om_frac = 1._r8 + end if + diffus (c,j) = (d_con_g(s,1) + d_con_g(s,2)*t_soisno_c) * 1.e-4_r8 * & + (om_frac * f_a**(10._r8/3._r8) / watsat(c,j)**2._r8 + & + (1._r8-om_frac) * eps**2._r8 * f_a**(3._r8 / bsw(c,j)) ) & + * scale_factor_gasdiff + else ! Below the WT use saturated diffusivity and only water in epsilon_t + ! Note the following is not currently corrected for the effect on diffusivity of excess ice in soil under + ! lakes (which is currently experimental only). + eps = watsat(c,j) ! Water-filled fraction of total soil volume + diffus (c,j) = eps**satpow * (d_con_w(s,1) + d_con_w(s,2)*t_soisno_c + d_con_w(s,3)*t_soisno_c**2) * 1.e-9_r8 & + * scale_factor_liqdiff + if (t_soisno(c,j)<=tfrz) then + diffus(c,j) = diffus(c,j)*(h2osoi_liq(c,j)/denh2o+smallnumber)/ & + (h2osoi_liq(c,j)/denh2o+h2osoi_ice(c,j)/denice+smallnumber) + end if + endif ! Above/below the WT + diffus(c,j) = max(diffus(c,j), smallnumber) ! Prevent overflow + + enddo ! fp + enddo ! j + + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + ! Set up coefficients for tridiagonal solver. + if (j == 1 .and. j /= jwt(c) .and. j /= jwt(c)+1) then + dm1_zm1(c,j) = 1._r8/(1._r8/spec_grnd_cond(c,s)+dz(c,j)/(diffus(c,j)*2._r8)) + ! replace Diffusivity / Delta_z by conductance (grnd_ch4_cond) for top layer + dp1_zp1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + else if (j == 1 .and. j == jwt(c)) then + dm1_zm1(c,j) = 1._r8/(1._r8/spec_grnd_cond(c,s)+dz(c,j)/(diffus(c,j)*2._r8)) + ! layer resistance mult. by k_h_cc for dp1_zp1 term + dp1_zp1(c,j) = 2._r8/(dz(c,j)*k_h_cc(c,j,s)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + else if (j == 1) then ! water table at surface: multiply ground resistance by k_h_cc + dm1_zm1(c,j) = 1._r8/(k_h_cc(c,j-1,s)/spec_grnd_cond(c,s)+dz(c,j)/(diffus(c,j)*2._r8)) + ! air concentration will be mult. by k_h_cc below + dp1_zp1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + else if (j <= nlevsoi-1 .and. j /= jwt(c) .and. j /= jwt(c)+1) then + dm1_zm1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j-1)/diffus(c,j-1)) + dp1_zp1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + else if (j <= nlevsoi-1 .and. j == jwt(c)) then ! layer resistance mult. by k_h_cc for dp1_zp1 term + dm1_zm1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j-1)/diffus(c,j-1)) + dp1_zp1(c,j) = 2._r8/(dz(c,j)*k_h_cc(c,j,s)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + ! Concentration in layer will be mult. by k_h_cc below + else if (j <= nlevsoi-1) then ! j==jwt+1: layer above resistance mult. by k_h_cc for dm1_zm1 term + dm1_zm1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j-1)*k_h_cc(c,j-1,s)/diffus(c,j-1)) + ! Concentration in layer above will be mult. by k_h_cc below + dp1_zp1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j+1)/diffus(c,j+1)) + else if (j /= jwt(c)+1) then ! j ==nlevsoi + dm1_zm1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j-1)/diffus(c,j-1)) + else ! jwt == nlevsoi-1: layer above resistance mult. by k_h_cc for dm1_zm1 term + dm1_zm1(c,j) = 2._r8/(dz(c,j)/diffus(c,j)+dz(c,j-1)*k_h_cc(c,j-1,s)/diffus(c,j-1)) + end if + enddo ! fp; patch + end do ! j; nlevsoi + + ! Perform a second loop for the tridiagonal coefficients since need dp1_zp1 and dm1_z1 at each depth + do j = 0,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + g = col%gridcell(c) + + conc_ch4_rel_old(c,j) = conc_ch4_rel(c,j) + + if (j > 0) dzj = dz(c,j) + if (j == 0) then ! top layer (atmosphere) doesn't change regardless of where WT is + at(c,j) = 0._r8 + bt(c,j) = 1._r8 + ct(c,j) = 0._r8 + rt(c,j) = c_atm(g,s) ! 0th level stays at constant atmospheric conc + elseif (j < nlevsoi .and. j == jwt(c)) then ! concentration inside needs to be mult. by k_h_cc for dp1_zp1 term + at(c,j) = -0.5_r8 / dzj * dm1_zm1(c,j) + bt(c,j) = epsilon_t(c,j,s) / dtime_ch4 + 0.5_r8 / dzj * (dp1_zp1(c,j)*k_h_cc(c,j,s) + dm1_zm1(c,j)) + ct(c,j) = -0.5_r8 / dzj * dp1_zp1(c,j) + elseif (j < nlevsoi .and. j == jwt(c)+1) then + ! concentration above needs to be mult. by k_h_cc for dm1_zm1 term + at(c,j) = -0.5_r8 / dzj * dm1_zm1(c,j) * k_h_cc(c,j-1,s) + bt(c,j) = epsilon_t(c,j,s) / dtime_ch4 + 0.5_r8 / dzj * (dp1_zp1(c,j) + dm1_zm1(c,j)) + ct(c,j) = -0.5_r8 / dzj * dp1_zp1(c,j) + elseif (j < nlevsoi) then + at(c,j) = -0.5_r8 / dzj * dm1_zm1(c,j) + bt(c,j) = epsilon_t(c,j,s) / dtime_ch4 + 0.5_r8 / dzj * (dp1_zp1(c,j) + dm1_zm1(c,j)) + ct(c,j) = -0.5_r8 / dzj * dp1_zp1(c,j) + else if (j == nlevsoi .and. j== jwt(c)+1) then + ! concentration above needs to be mult. by k_h_cc for dm1_zm1 term + at(c,j) = -0.5_r8 / dzj * dm1_zm1(c,j) * k_h_cc(c,j-1,s) + bt(c,j) = epsilon_t(c,j,s) / dtime_ch4 + 0.5_r8 / dzj * dm1_zm1(c,j) + ct(c,j) = 0._r8 + else ! j==nlevsoi and jwt 1.e-3_r8 * scale_factor_gasdiff) then + if (deficit > 1.e-2_r8) then + write(iulog,*)'Note: sink > source in ch4_tran, sources are changing '// & + ' quickly relative to diffusion timestep, and/or diffusion is rapid.' + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + write(iulog,*)'This typically occurs when there is a larger than normal '// & + ' diffusive flux.' + write(iulog,*)'If this occurs frequently, consider reducing land model (or '// & + ' methane model) timestep, or reducing the max. sink per timestep in the methane model.' + end if + write(iulog,*) 'Negative conc. in ch4tran. c,j,deficit (mol):',c,j,deficit + end if + conc_ch4_rel(c,j) = 0._r8 + ! Subtract deficit + ch4_surf_diff(c) = ch4_surf_diff(c) - deficit/dtime_ch4 + end if + enddo + enddo + + + elseif (s == 2) then ! O2 + + ! Set rt, since it depends on conc + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + ! For correct balance, deprecate source_old. + source_old(c,j,s) = source(c,j,s) + ! source_old could be removed later + epsilon_t_old(c,j,s) = epsilon_t(c,j,s) + ! epsilon_t acts like source also + dzj = dz(c,j) + if (j < nlevsoi .and. j == jwt(c)) then ! concentration inside needs to be mult. by k_h_cc for dp1_zp1 term + rt(c,j) = epsilon_t_old(c,j,s) / dtime_ch4 * conc_o2_rel(c,j) + & + 0.5_r8 / dzj * (dp1_zp1(c,j) * (conc_o2_rel(c,j+1)-conc_o2_rel(c,j)*k_h_cc(c,j,s)) - & + dm1_zm1(c,j) * (conc_o2_rel(c,j) -conc_o2_rel(c,j-1))) + & + 0.5_r8 * (source(c,j,s) + source_old(c,j,s)) + elseif (j < nlevsoi .and. j == jwt(c)+1) then + ! concentration above needs to be mult. by k_h_cc for dm1_zm1 term + rt(c,j) = epsilon_t_old(c,j,s) / dtime_ch4 * conc_o2_rel(c,j) + & + 0.5_r8 / dzj * (dp1_zp1(c,j) * (conc_o2_rel(c,j+1)-conc_o2_rel(c,j)) - & + dm1_zm1(c,j) * (conc_o2_rel(c,j) -conc_o2_rel(c,j-1)*k_h_cc(c,j-1,s))) + & + 0.5_r8 * (source(c,j,s) + source_old(c,j,s)) + elseif (j < nlevsoi) then + rt(c,j) = epsilon_t_old(c,j,s) / dtime_ch4 * conc_o2_rel(c,j) + & + 0.5_r8 / dzj * (dp1_zp1(c,j) * (conc_o2_rel(c,j+1)-conc_o2_rel(c,j)) - & + dm1_zm1(c,j) * (conc_o2_rel(c,j) -conc_o2_rel(c,j-1))) + & + 0.5_r8 * (source(c,j,s) + source_old(c,j,s)) + else if (j == nlevsoi .and. j== jwt(c)+1) then + ! concentration above needs to be mult. by k_h_cc for dm1_zm1 term + rt(c,j) = epsilon_t_old(c,j,s) / dtime_ch4 * conc_o2_rel(c,j) + & + 0.5_r8 / dzj * ( - dm1_zm1(c,j) * (conc_o2_rel(c,j) -conc_o2_rel(c,j-1)*k_h_cc(c,j-1,s))) + & + 0.5_r8 * (source(c,j,s) + source_old(c,j,s)) + else !j==nlevsoi + rt(c,j) = epsilon_t_old(c,j,s) / dtime_ch4 * conc_o2_rel(c,j) + & + 0.5_r8 / dzj * ( - dm1_zm1(c,j) * (conc_o2_rel(c,j) -conc_o2_rel(c,j-1))) + & + 0.5_r8 * (source(c,j,s) + source_old(c,j,s)) + endif + epsilon_t_old(c,j,s) = epsilon_t(c,j,s) + source_old(c,j,s) = source(c,j,s) + + enddo ! fc; column + enddo ! j; nlevsoi + + call Tridiagonal(bounds, 0, nlevsoi, jtop(bounds%begc:bounds%endc), & + num_methc, filter_methc, & + at(bounds%begc:bounds%endc, :), & + bt(bounds%begc:bounds%endc, :), & + ct(bounds%begc:bounds%endc, :), & + rt(bounds%begc:bounds%endc, :), & + conc_o2_rel(bounds%begc:bounds%endc,0:nlevsoi)) + + ! Ensure that concentrations stay above 0 + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + g = col%gridcell(c) + conc_o2_rel(c,j) = max (conc_o2_rel(c,j), 1.e-12_r8) + ! In case of pathologically large aerenchyma conductance. Should be OK in general but + ! this will maintain stability even if a PATCH with very small weight somehow has an absurd NPP or LAI. + ! Also, oxygen above ambient will probably bubble. + conc_o2_rel(c,j) = min (conc_o2_rel(c,j), c_atm(g,2)/epsilon_t(c,j,2)) + enddo + enddo + + endif ! species + + enddo ! species + + ! Update absolute concentrations per unit volume + do j = 1,nlevsoi ! No need to update the atm. level concentrations + do fc = 1, num_methc + c = filter_methc (fc) + + conc_ch4(c,j) = conc_ch4_rel(c,j)*epsilon_t(c,j,1) + conc_o2(c,j) = conc_o2_rel(c,j) *epsilon_t(c,j,2) + end do + end do + + ! Do Balance Check and absorb small + ! discrepancy into surface flux. + do j = 1,nlevsoi + do fc = 1, num_methc + c = filter_methc (fc) + + if (j == 1) errch4(c) = 0._r8 + errch4(c) = errch4(c) + (conc_ch4(c,j) - conc_ch4_bef(c,j))*dz(c,j) + errch4(c) = errch4(c) - ch4_prod_depth(c,j)*dz(c,j)*dtime + errch4(c) = errch4(c) + ch4_oxid_depth(c,j)*dz(c,j)*dtime + end do + end do + + do fc = 1, num_methc + c = filter_methc (fc) + + ! For history make sure that grnd_ch4_cond includes snow, for methane diffusivity + grnd_ch4_cond(c) = spec_grnd_cond(c,1) + + errch4(c) = errch4(c) + (ch4_surf_aere(c) + ch4_surf_ebul(c) + ch4_surf_diff(c))*dtime + + if (abs(errch4(c)) < 1.e-8_r8) then + ch4_surf_diff(c) = ch4_surf_diff(c) - errch4(c)/dtime + else ! errch4 > 1e-8 mol / m^2 / timestep + write(iulog,*)'CH4 Conservation Error in CH4Mod during diffusion, nstep, c, errch4 (mol /m^2.timestep)', & + nstep,c,errch4(c) + g = col%gridcell(c) + write(iulog,*)'Latdeg,Londeg=',grc%latdeg(g),grc%londeg(g) + call endrun(msg=' ERROR: CH4 Conservation Error in CH4Mod during diffusion'//& + errMsg(__FILE__, __LINE__)) + end if + end do + + end associate + + end subroutine ch4_tran + + !----------------------------------------------------------------------- + subroutine get_jwt (bounds, num_methc, filter_methc, jwt, & + soilstate_inst, waterstate_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Finds the first unsaturated layer going up. Also allows a perched water table over ice. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of column soil points in column filter + integer , intent(in) :: filter_methc(:) ! column filter for soil points + integer , intent(out) :: jwt( bounds%begc: ) ! index of the soil layer right above the water table (-) [col] + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: f_sat ! volumetric soil water defining top of water table or where production is allowed + integer :: c,j,perch! indices + integer :: fc ! filter column index + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + t_soisno => temperature_inst%t_soisno_col & ! Input: [real(r8) (: ,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + ) + + f_sat = params_inst%f_sat + + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table. + ! ZS: Loop is currently not vectorized. + do fc = 1, num_methc + c = filter_methc(fc) + + ! Check to see if any soil layers are frozen and saturated. If so, start looking at the first layer above the top + ! such layer. This is potentially important for perched water tables in the Tundra. + + perch = nlevsoi + do j = nlevsoi, 1, -1 + if (t_soisno(c,j) < tfrz .and. h2osoi_vol(c,j) > f_sat * watsat(c,j)) then + ! strictly less than freezing because it could be permeable otherwise + perch = j-1 + end if + end do + jwt(c) = perch + + do j = perch, 2, -1 + if(h2osoi_vol(c,j) > f_sat * watsat(c,j) .and. h2osoi_vol(c,j-1) < f_sat * watsat(c,j-1)) then + jwt(c) = j-1 + exit + end if + enddo + if (jwt(c) == perch .and. h2osoi_vol(c,1) > f_sat * watsat(c,1)) then ! missed that the top layer is saturated + jwt(c) = 0 + endif + end do + + end associate + + end subroutine get_jwt + + !----------------------------------------------------------------------- + subroutine ch4_annualupdate(bounds, num_methc, filter_methc, num_methp, filter_methp, & + soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, ch4_inst) + ! + ! !DESCRIPTION: Annual mean fields. + ! + ! !USES: + use clm_time_manager, only: get_step_size, get_days_per_year, get_nstep + use clm_varcon , only: secspday + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_methc ! number of soil columns in filter + integer , intent(in) :: filter_methc(:) ! filter for soil columns + integer , intent(in) :: num_methp ! number of soil points in patch filter + integer , intent(in) :: filter_methp(:) ! patch filter for soil points + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fc ! soil column filter indices + integer :: fp ! soil patch filter indices + real(r8):: dt ! time step (seconds) + real(r8):: secsperyear + logical :: newrun + !----------------------------------------------------------------------- + + associate( & + agnpp => cnveg_carbonflux_inst%agnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) aboveground NPP + bgnpp => cnveg_carbonflux_inst%bgnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) belowground NPP + + somhr => soilbiogeochem_carbonflux_inst%somhr_col , & ! Input: [real(r8) (:) ] (gC/m2/s) soil organic matter heterotrophic respiration + + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column + tempavg_agnpp => ch4_inst%tempavg_agnpp_patch , & ! Output: [real(r8) (:) ] temporary average above-ground NPP (gC/m2/s) + annavg_agnpp => ch4_inst%annavg_agnpp_patch , & ! Output: [real(r8) (:) ] annual average above-ground NPP (gC/m2/s) + tempavg_bgnpp => ch4_inst%tempavg_bgnpp_patch , & ! Output: [real(r8) (:) ] temporary average below-ground NPP (gC/m2/s) + annavg_bgnpp => ch4_inst%annavg_bgnpp_patch , & ! Output: [real(r8) (:) ] annual average below-ground NPP (gC/m2/s) + annsum_counter => ch4_inst%annsum_counter_col , & ! Output: [real(r8) (:) ] seconds since last annual accumulator turnover + tempavg_somhr => ch4_inst%tempavg_somhr_col , & ! Output: [real(r8) (:) ] temporary average SOM heterotrophic resp. (gC/m2/s) + annavg_somhr => ch4_inst%annavg_somhr_col , & ! Output: [real(r8) (:) ] annual average SOM heterotrophic resp. (gC/m2/s) + tempavg_finrw => ch4_inst%tempavg_finrw_col , & ! Output: [real(r8) (:) ] respiration-weighted annual average of finundated + annavg_finrw => ch4_inst%annavg_finrw_col & ! Output: [real(r8) (:) ] respiration-weighted annual average of finundated + ) + + ! set time steps + dt = real(get_step_size(), r8) + secsperyear = real( get_days_per_year() * secspday, r8) + + newrun = .false. + + ! column loop + do fc = 1,num_methc + c = filter_methc(fc) + + if (annsum_counter(c) == spval) then + ! These variables are now in restart files for completeness, but might not be in inicFile and are not. + ! set for arbinit. + newrun = .true. + annsum_counter(c) = 0._r8 + tempavg_somhr(c) = 0._r8 + tempavg_finrw(c) = 0._r8 + end if + + annsum_counter(c) = annsum_counter(c) + dt + end do + + ! patch loop + do fp = 1,num_methp + p = filter_methp(fp) + + if (newrun .or. tempavg_agnpp(p) == spval) then ! Extra check needed because for back-compatibility + tempavg_agnpp(p) = 0._r8 + tempavg_bgnpp(p) = 0._r8 + end if + end do + + do fc = 1,num_methc + c = filter_methc(fc) + if (annsum_counter(c) >= secsperyear) then + + ! update annual average somhr + annavg_somhr(c) = tempavg_somhr(c) + tempavg_somhr(c) = 0._r8 + + ! update annual average finrw + if (annavg_somhr(c) > 0._r8) then + annavg_finrw(c) = tempavg_finrw(c) / annavg_somhr(c) + else + annavg_finrw(c) = 0._r8 + end if + tempavg_finrw(c) = 0._r8 + else + tempavg_somhr(c) = tempavg_somhr(c) + dt/secsperyear * somhr(c) + tempavg_finrw(c) = tempavg_finrw(c) + dt/secsperyear * finundated(c) * somhr(c) + end if + end do + + do fp = 1,num_methp + p = filter_methp(fp) + c = patch%column(p) + if (annsum_counter(c) >= secsperyear) then + + annavg_agnpp(p) = tempavg_agnpp(p) + tempavg_agnpp(p) = 0._r8 + + annavg_bgnpp(p) = tempavg_bgnpp(p) + tempavg_bgnpp(p) = 0._r8 + + else + tempavg_agnpp(p) = tempavg_agnpp(p) + dt/secsperyear * agnpp(p) + tempavg_bgnpp(p) = tempavg_bgnpp(p) + dt/secsperyear * bgnpp(p) + end if + end do + + ! column loop + do fc = 1,num_methc + c = filter_methc(fc) + if (annsum_counter(c) >= secsperyear) annsum_counter(c) = 0._r8 + end do + + end associate + + end subroutine ch4_annualupdate + +end module ch4Mod + diff --git a/components/clm/src/biogeochem/ch4varcon.F90 b/components/clm/src/biogeochem/ch4varcon.F90 new file mode 100644 index 0000000000..6c6f090c80 --- /dev/null +++ b/components/clm/src/biogeochem/ch4varcon.F90 @@ -0,0 +1,175 @@ +module ch4varcon + + !----------------------------------------------------------------------- + ! Module containing CH4 parameters and logical switches and routine to read constants from CLM namelist. + ! + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varctl , only : NLFileName_in + ! + implicit none + ! + ! Methane Model Parameters + ! + + logical :: use_aereoxid_prog = .true. ! if false then aereoxid is read off of + ! the parameter file and may be modifed by the user (default aereoxid on the + ! file is 0.0). + + logical :: transpirationloss = .true. ! switch for activating CH4 loss from transpiration + ! Transpiration loss assumes that the methane concentration in dissolved soil + ! water remains constant through the plant and is released when the water evaporates + ! from the stomata. + ! Currently hard-wired to true; impact is < 1 Tg CH4/yr + + logical :: allowlakeprod = .false. ! Switch to allow production under lakes based on soil carbon dataset + ! (Methane can be produced, and CO2 produced from methane oxidation, + ! which will slowly reduce the available carbon stock, if ! replenishlakec, but no other biogeochem is done.) + ! Note: switching this off turns off ALL lake methane biogeochem. However, 0 values + ! will still be averaged into the concentration _sat history fields. + + logical :: usephfact = .false. ! Switch to use pH factor in methane production + + logical :: replenishlakec = .true. ! Switch for keeping carbon storage under lakes constant + ! so that lakes do not affect the carbon balance + ! Good for long term rather than transient warming experiments + ! NOTE SWITCHING THIS OFF ASSUMES TRANSIENT CARBON SUPPLY FROM LAKES; COUPLED MODEL WILL NOT CONSERVE CARBON + ! IN THIS MODE. + + ! New namelists added 6/12/11 + + logical :: fin_use_fsat = .false. ! Use fsat rather than the inversion to Prigent satellite inundation obs. (applied to + ! CLM water table depth and surface runoff) to calculated finundated which is + ! used in methane code and potentially soil code + !!!! Attn EK: Set this to true when Sean Swenson's prognostic, tested + ! fsat is integrated. (CLM4 fsat is bad for these purposes.) + + logical :: usefrootc = .false. ! Use CLMCN fine root C rather than ann NPP & LAI based parameterization to + ! calculate tiller C for aerenchyma area calculation. + ! The NPP & LAI param. was based on Wania for Arctic sedges and may not be + ! appropriate for woody Patches, although nongrassporosratio above partly adjusts + ! for this. However, using fine root C reduces the aerenchyma area by a large + ! factor. + + logical :: ch4offline = .true. ! true --> Methane is not passed between the land & atmosphere. + ! NEM is not added to NEE flux to atm. to correct for methane production, + ! and ambient CH4 is set to constant 2009 value. + + logical :: ch4rmcnlim = .false. ! Remove the N and low moisture limitations on SOM HR when calculating + ! methanogenesis. + ! Note: this option has not been extensively tested. + ! Currently hardwired off. + + logical :: anoxicmicrosites = .false. ! Use Arah & Stephen 1998 expression to allow production above the water table + ! Currently hardwired off; expression is crude. + + logical :: ch4frzout = .false. ! Exclude CH4 from frozen fraction of soil pore H2O, to simulate "freeze-out" pulse + ! as in Mastepanov 2008. + ! Causes slight increase in emissions in the fall and decrease in the spring. + ! Currently hardwired off; small impact. + + public :: ch4conrd ! Read and initialize CH4 constants + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine ch4conrd () + ! + ! !DESCRIPTION: + ! Read and initialize CH4 constants + ! + ! !USES: + use fileutils , only : relavu, getavu + use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_LOGICAL + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + implicit none + ! + integer :: i,j,n ! loop indices + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'ch4conrd' ! subroutine name + !----------------------------------------------------------------------- + + ! ---------------------------------------------------------------------- + ! Namelist Variables + ! ---------------------------------------------------------------------- + + ! Driver + namelist /ch4par_in/ & + ch4offline, fin_use_fsat, replenishlakec, allowlakeprod + + ! Production + namelist /ch4par_in/ & + usephfact + + ! Methane + namelist /ch4par_in/ & + use_aereoxid_prog, usefrootc + + ! ---------------------------------------------------------------------- + ! Read namelist from standard input. + ! ---------------------------------------------------------------------- + + if (masterproc) then + + write(iulog,*) 'Attempting to read CH4 parameters .....' + unitn = getavu() + write(iulog,*) 'Read in ch4par_in namelist from: ', trim(NLFilename_in) + open( unitn, file=trim(NLFilename_in), status='old' ) + call shr_nl_find_group_name(unitn, 'ch4par_in', status=ierr) + if (ierr == 0) then + read(unitn, ch4par_in, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='error in reading in ch4par_in namelist'//& + errMsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if ! masterproc + + + call mpi_bcast ( use_aereoxid_prog, 1 , MPI_LOGICAL, 0, mpicom, ierr ) + call mpi_bcast (allowlakeprod, 1 , MPI_LOGICAL, 0, mpicom, ierr) + call mpi_bcast (usephfact, 1 , MPI_LOGICAL, 0, mpicom, ierr) + call mpi_bcast (replenishlakec, 1 , MPI_LOGICAL, 0, mpicom, ierr) + call mpi_bcast (fin_use_fsat, 1 , MPI_LOGICAL, 0, mpicom, ierr) + call mpi_bcast (usefrootc, 1 , MPI_LOGICAL, 0, mpicom, ierr) + call mpi_bcast (ch4offline, 1 , MPI_LOGICAL, 0, mpicom, ierr) + + if (masterproc) then + write(iulog,*) 'Successfully read CH4 namelist' + write(iulog,*)' ' + write(iulog,*)'allowlakeprod = ', allowlakeprod + write(iulog,*)'usephfact = ', usephfact + write(iulog,*)'replenishlakec = ', replenishlakec + write(iulog,*)'fin_use_fsat = ', fin_use_fsat + write(iulog,*)'usefrootc = ', usefrootc + write(iulog,*)'ch4offline = ', ch4offline + + if (ch4offline) write(iulog,*)'CH4 Model will be running offline and not affect fluxes to atmosphere' + + write(iulog,*)'use_aereoxid_prog = ', use_aereoxid_prog + if ( .not. use_aereoxid_prog ) then + write(iulog,*) 'Aerenchyma oxidation (aereoxid) value is being read from '//& + ' the parameters file' + endif + + if (.not. allowlakeprod) write(iulog,*) 'Lake production has been disabled. '// & + ' Lakes will not factor into CH4 BGC. "Sat" history fields will not average'// & + ' over lakes except for concentrations, which will average zero from lakes.' + if (.not. replenishlakec .and. .not. ch4offline) write(iulog,*)'LAKE SOIL CARBON WILL NOT BE REPLENISHED BUT INSTEAD ',& + 'WILL BE TRANSIENTLY RELEASED: COUPLED MODEL WILL NOT CONSERVE CARBON IN THIS MODE!' + write(iulog,*)'Successfully initialized CH4 parameters from namelist.' + write(iulog,*) + + end if + + end subroutine ch4conrd + +end module ch4varcon + diff --git a/components/clm/src/biogeophys/ActiveLayerMod.F90 b/components/clm/src/biogeophys/ActiveLayerMod.F90 new file mode 100644 index 0000000000..a1b871829c --- /dev/null +++ b/components/clm/src/biogeophys/ActiveLayerMod.F90 @@ -0,0 +1,155 @@ +module ActiveLayerMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines for calculation of active layer dynamics + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varctl , only : iulog + use TemperatureType , only : temperature_type + use CanopyStateType , only : canopystate_type + use GridcellType , only : grc + use ColumnType , only : col + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: alt_calc + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine alt_calc(num_soilc, filter_soilc, & + temperature_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! define active layer thickness similarly to frost_table, except set as deepest thawed layer and define on nlevgrnd + ! also update annual maxima, and keep track of prior year for rooting memory + ! + ! BUG(wjs, 2014-12-15, bugz 2107) Because of this routine's placement in the driver + ! sequence (it is called very early in each timestep, before weights are adjusted and + ! filters are updated), it may be necessary for this routine to compute values over + ! inactive as well as active points (since some inactive points may soon become + ! active) - so that's what is done now. Currently, it seems to be okay to do this, + ! because the variables computed here seem to only depend on quantities that are valid + ! over inactive as well as active points. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevgrnd + use clm_time_manager , only : get_curr_date, get_step_size + use clm_varctl , only : iulog + use clm_varcon , only : zsoi + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(temperature_type) , intent(in) :: temperature_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc, g ! counters + integer :: alt_ind ! index of base of activel layer + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: dtime ! time step length in seconds + integer :: k_frz ! index of first nonfrozen soil layer + logical :: found_thawlayer ! used to break loop when first unfrozen layer reached + real(r8) :: t1, t2, z1, z2 ! temporary variables + !----------------------------------------------------------------------- + + associate( & + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + alt => canopystate_inst%alt_col , & ! Output: [real(r8) (:) ] current depth of thaw + altmax => canopystate_inst%altmax_col , & ! Output: [real(r8) (:) ] maximum annual depth of thaw + altmax_lastyear => canopystate_inst%altmax_lastyear_col , & ! Output: [real(r8) (:) ] prior year maximum annual depth of thaw + alt_indx => canopystate_inst%alt_indx_col , & ! Output: [integer (:) ] current depth of thaw + altmax_indx => canopystate_inst%altmax_indx_col , & ! Output: [integer (:) ] maximum annual depth of thaw + altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col & ! Output: [integer (:) ] prior year maximum annual depth of thaw + ) + + ! on a set annual timestep, update annual maxima + ! make this 1 January for NH columns, 1 July for SH columns + call get_curr_date(year, mon, day, sec) + dtime = get_step_size() + if ( (mon .eq. 1) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if ( grc%lat(g) > 0. ) then + altmax_lastyear(c) = altmax(c) + altmax_lastyear_indx(c) = altmax_indx(c) + altmax(c) = 0. + altmax_indx(c) = 0 + endif + end do + endif + if ( (mon .eq. 7) .and. (day .eq. 1) .and. ( sec / dtime .eq. 1) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + g = col%gridcell(c) + if ( grc%lat(g) <= 0. ) then + altmax_lastyear(c) = altmax(c) + altmax_lastyear_indx(c) = altmax_indx(c) + altmax(c) = 0. + altmax_indx(c) = 0 + endif + end do + endif + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate alt for a given timestep + ! start from base of soil and search upwards for first thawed layer. + ! note that this will put talik in with active layer + ! a different way of doing this could be to keep track of how long a given layer has ben frozen for, and define ALT as the first layer that has been frozen for less than 2 years. + if (t_soisno(c,nlevgrnd) > SHR_CONST_TKFRZ ) then + alt(c) = zsoi(nlevgrnd) + alt_indx(c) = nlevgrnd + else + k_frz=0 + found_thawlayer = .false. + do j=nlevgrnd-1,1,-1 + if ( ( t_soisno(c,j) > SHR_CONST_TKFRZ ) .and. .not. found_thawlayer ) then + k_frz=j + found_thawlayer = .true. + endif + end do + + if ( k_frz > 0 ) then + ! define active layer as the depth at which the linearly interpolated temperature line intersects with zero + z1 = zsoi(k_frz) + z2 = zsoi(k_frz+1) + t1 = t_soisno(c,k_frz) + t2 = t_soisno(c,k_frz+1) + alt(c) = z1 + (t1-SHR_CONST_TKFRZ)*(z2-z1)/(t1-t2) + alt_indx(c) = k_frz + else + alt(c)=0._r8 + alt_indx(c) = 0 + endif + endif + + + ! if appropriate, update maximum annual active layer thickness + if (alt(c) > altmax(c)) then + altmax(c) = alt(c) + altmax_indx(c) = alt_indx(c) + endif + + end do + + end associate + + end subroutine alt_calc + +end module ActiveLayerMod diff --git a/components/clm/src/biogeophys/AerosolMod.F90 b/components/clm/src/biogeophys/AerosolMod.F90 new file mode 100644 index 0000000000..4cc0bafc76 --- /dev/null +++ b/components/clm/src/biogeophys/AerosolMod.F90 @@ -0,0 +1,760 @@ +module AerosolMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use clm_varpar , only : nlevsno, nlevgrnd + use clm_time_manager , only : get_step_size + use atm2lndType , only : atm2lnd_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: AerosolMasses + public :: AerosolFluxes + ! + ! !PUBLIC DATA MEMBERS: + real(r8), public, parameter :: snw_rds_min = 54.526_r8 ! minimum allowed snow effective radius (also "fresh snow" value) [microns + ! + type, public :: aerosol_type + real(r8), pointer, public :: mss_bcpho_col(:,:) ! mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_bcphi_col(:,:) ! mass of hydrophillic BC in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_bctot_col(:,:) ! total mass of BC in snow (pho+phi) (col,lyr) [kg] + real(r8), pointer, public :: mss_bc_col_col(:) ! column-integrated mass of total BC [kg] + real(r8), pointer, public :: mss_bc_top_col(:) ! top-layer mass of total BC [kg] + + real(r8), pointer, public :: mss_ocpho_col(:,:) ! mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_ocphi_col(:,:) ! mass of hydrophillic OC in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_octot_col(:,:) ! total mass of OC in snow (pho+phi) (col,lyr) [kg] + real(r8), pointer, public :: mss_oc_col_col(:) ! column-integrated mass of total OC [kg] + real(r8), pointer, public :: mss_oc_top_col(:) ! top-layer mass of total OC [kg] + + real(r8), pointer, public :: mss_dst1_col(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_dst2_col(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_dst3_col(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_dst4_col(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_dsttot_col(:,:) ! total mass of dust in snow (col,lyr) [kg] + real(r8), pointer, public :: mss_dst_col_col(:) ! column-integrated mass of dust in snow [kg] + real(r8), pointer, public :: mss_dst_top_col(:) ! top-layer mass of dust in snow [kg] + + real(r8), pointer, public :: mss_cnc_bcphi_col(:,:) ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_bcpho_col(:,:) ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_ocphi_col(:,:) ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_ocpho_col(:,:) ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_dst1_col(:,:) ! mass concentration of dust species 1 in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_dst2_col(:,:) ! mass concentration of dust species 2 in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_dst3_col(:,:) ! mass concentration of dust species 3 in snow (col,lyr) [kg/kg] + real(r8), pointer, public :: mss_cnc_dst4_col(:,:) ! mass concentration of dust species 4 in snow (col,lyr) [kg/kg] + + real(r8), pointer, private :: flx_dst_dep_dry1_col(:) ! dust species 1 dry deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_wet1_col(:) ! dust species 1 wet deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_dry2_col(:) ! dust species 2 dry deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_wet2_col(:) ! dust species 2 wet deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_dry3_col(:) ! dust species 3 dry deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_wet3_col(:) ! dust species 3 wet deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_dry4_col(:) ! dust species 4 dry deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_wet4_col(:) ! dust species 4 wet deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_dst_dep_col(:) ! total (dry+wet) dust deposition on ground (positive definite) [kg/s] + + real(r8), pointer, private :: flx_bc_dep_dry_col(:) ! dry (BCPHO+BCPHI) BC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_bc_dep_wet_col(:) ! wet (BCPHI) BC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_bc_dep_pho_col(:) ! hydrophobic BC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_bc_dep_phi_col(:) ! hydrophillic BC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_bc_dep_col(:) ! total (dry+wet) BC deposition on ground (positive definite) [kg/s] + + real(r8), pointer, private :: flx_oc_dep_dry_col(:) ! dry (OCPHO+OCPHI) OC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_oc_dep_wet_col(:) ! wet (OCPHI) OC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_oc_dep_pho_col(:) ! hydrophobic OC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_oc_dep_phi_col(:) ! hydrophillic OC deposition on ground (positive definite) [kg/s] + real(r8), pointer, private :: flx_oc_dep_col(:) ! total (dry+wet) OC deposition on ground (positive definite) [kg/s] + + contains + + ! Public procedures + procedure, public :: Init + procedure, public :: Restart + procedure, public :: Reset + + ! Private procedures + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type aerosol_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(aerosol_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class(aerosol_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + allocate(this%flx_dst_dep_dry1_col (begc:endc)) ; this%flx_dst_dep_dry1_col (:) = nan + allocate(this%flx_dst_dep_wet1_col (begc:endc)) ; this%flx_dst_dep_wet1_col (:) = nan + allocate(this%flx_dst_dep_dry2_col (begc:endc)) ; this%flx_dst_dep_dry2_col (:) = nan + allocate(this%flx_dst_dep_wet2_col (begc:endc)) ; this%flx_dst_dep_wet2_col (:) = nan + allocate(this%flx_dst_dep_dry3_col (begc:endc)) ; this%flx_dst_dep_dry3_col (:) = nan + allocate(this%flx_dst_dep_wet3_col (begc:endc)) ; this%flx_dst_dep_wet3_col (:) = nan + allocate(this%flx_dst_dep_dry4_col (begc:endc)) ; this%flx_dst_dep_dry4_col (:) = nan + allocate(this%flx_dst_dep_wet4_col (begc:endc)) ; this%flx_dst_dep_wet4_col (:) = nan + allocate(this%flx_dst_dep_col (begc:endc)) ; this%flx_dst_dep_col (:) = nan + + allocate(this%flx_bc_dep_dry_col (begc:endc)) ; this%flx_bc_dep_dry_col (:) = nan + allocate(this%flx_bc_dep_wet_col (begc:endc)) ; this%flx_bc_dep_wet_col (:) = nan + allocate(this%flx_bc_dep_pho_col (begc:endc)) ; this%flx_bc_dep_pho_col (:) = nan + allocate(this%flx_bc_dep_phi_col (begc:endc)) ; this%flx_bc_dep_phi_col (:) = nan + allocate(this%flx_bc_dep_col (begc:endc)) ; this%flx_bc_dep_col (:) = nan + + allocate(this%flx_oc_dep_dry_col (begc:endc)) ; this%flx_oc_dep_dry_col (:) = nan + allocate(this%flx_oc_dep_wet_col (begc:endc)) ; this%flx_oc_dep_wet_col (:) = nan + allocate(this%flx_oc_dep_pho_col (begc:endc)) ; this%flx_oc_dep_pho_col (:) = nan + allocate(this%flx_oc_dep_phi_col (begc:endc)) ; this%flx_oc_dep_phi_col (:) = nan + allocate(this%flx_oc_dep_col (begc:endc)) ; this%flx_oc_dep_col (:) = nan + + allocate(this%mss_bcpho_col (begc:endc,-nlevsno+1:0)) ; this%mss_bcpho_col (:,:) = nan + allocate(this%mss_bcphi_col (begc:endc,-nlevsno+1:0)) ; this%mss_bcphi_col (:,:) = nan + allocate(this%mss_bctot_col (begc:endc,-nlevsno+1:0)) ; this%mss_bctot_col (:,:) = nan + allocate(this%mss_bc_col_col (begc:endc)) ; this%mss_bc_col_col (:) = nan + allocate(this%mss_bc_top_col (begc:endc)) ; this%mss_bc_top_col (:) = nan + + allocate(this%mss_ocpho_col (begc:endc,-nlevsno+1:0)) ; this%mss_ocpho_col (:,:) = nan + allocate(this%mss_ocphi_col (begc:endc,-nlevsno+1:0)) ; this%mss_ocphi_col (:,:) = nan + allocate(this%mss_octot_col (begc:endc,-nlevsno+1:0)) ; this%mss_octot_col (:,:) = nan + allocate(this%mss_oc_col_col (begc:endc)) ; this%mss_oc_col_col (:) = nan + allocate(this%mss_oc_top_col (begc:endc)) ; this%mss_oc_top_col (:) = nan + + allocate(this%mss_dst1_col (begc:endc,-nlevsno+1:0)) ; this%mss_dst1_col (:,:) = nan + allocate(this%mss_dst2_col (begc:endc,-nlevsno+1:0)) ; this%mss_dst2_col (:,:) = nan + allocate(this%mss_dst3_col (begc:endc,-nlevsno+1:0)) ; this%mss_dst3_col (:,:) = nan + allocate(this%mss_dst4_col (begc:endc,-nlevsno+1:0)) ; this%mss_dst4_col (:,:) = nan + allocate(this%mss_dsttot_col (begc:endc,-nlevsno+1:0)) ; this%mss_dsttot_col (:,:) = nan + allocate(this%mss_dst_col_col (begc:endc)) ; this%mss_dst_col_col (:) = nan + allocate(this%mss_dst_top_col (begc:endc)) ; this%mss_dst_top_col (:) = nan + + allocate(this%mss_cnc_bcphi_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_bcphi_col (:,:) = nan + allocate(this%mss_cnc_bcpho_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_bcpho_col (:,:) = nan + allocate(this%mss_cnc_ocphi_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_ocphi_col (:,:) = nan + allocate(this%mss_cnc_ocpho_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_ocpho_col (:,:) = nan + allocate(this%mss_cnc_dst1_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_dst1_col (:,:) = nan + allocate(this%mss_cnc_dst2_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_dst2_col (:,:) = nan + allocate(this%mss_cnc_dst3_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_dst3_col (:,:) = nan + allocate(this%mss_cnc_dst4_col (begc:endc,-nlevsno+1:0)) ; this%mss_cnc_dst4_col (:,:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varcon , only: spval + use clm_varpar , only: nlevsno + use histFileMod , only: hist_addfld1d, hist_addfld2d + use histFileMod , only: no_snow_normal, no_snow_zero + ! + ! !ARGUMENTS: + class(aerosol_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + this%flx_dst_dep_col(begc:endc) = spval + call hist_addfld1d (fname='DSTDEP', units='kg/m^2/s', & + avgflag='A', long_name='total dust deposition (dry+wet) from atmosphere', & + ptr_col=this%flx_dst_dep_col, set_urb=spval) + + this%flx_bc_dep_col(begc:endc) = spval + call hist_addfld1d (fname='BCDEP', units='kg/m^2/s', & + avgflag='A', long_name='total BC deposition (dry+wet) from atmosphere', & + ptr_col=this%flx_bc_dep_col, set_urb=spval) + + this%flx_oc_dep_col(begc:endc) = spval + call hist_addfld1d (fname='OCDEP', units='kg/m^2/s', & + avgflag='A', long_name='total OC deposition (dry+wet) from atmosphere', & + ptr_col=this%flx_oc_dep_col, set_urb=spval) + + this%mss_bc_col_col(begc:endc) = spval + call hist_addfld1d (fname='SNOBCMCL', units='kg/m2', & + avgflag='A', long_name='mass of BC in snow column', & + ptr_col=this%mss_bc_col_col, set_urb=spval) + + this%mss_bc_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNOBCMSL', units='kg/m2', & + avgflag='A', long_name='mass of BC in top snow layer', & + ptr_col=this%mss_bc_top_col, set_urb=spval) + + this%mss_oc_col_col(begc:endc) = spval + call hist_addfld1d (fname='SNOOCMCL', units='kg/m2', & + avgflag='A', long_name='mass of OC in snow column', & + ptr_col=this%mss_oc_col_col, set_urb=spval) + + this%mss_oc_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNOOCMSL', units='kg/m2', & + avgflag='A', long_name='mass of OC in top snow layer', & + ptr_col=this%mss_oc_top_col, set_urb=spval) + + this%mss_dst_col_col(begc:endc) = spval + call hist_addfld1d (fname='SNODSTMCL', units='kg/m2', & + avgflag='A', long_name='mass of dust in snow column', & + ptr_col=this%mss_dst_col_col, set_urb=spval) + + this%mss_dst_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNODSTMSL', units='kg/m2', & + avgflag='A', long_name='mass of dust in top snow layer', & + ptr_col=this%mss_dst_top_col, set_urb=spval) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(aerosol_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c ! index + !----------------------------------------------------------------------- + + do c = bounds%begc,bounds%endc + this%mss_cnc_bcphi_col(c,:) = 0._r8 + this%mss_cnc_bcpho_col(c,:) = 0._r8 + this%mss_cnc_ocphi_col(c,:) = 0._r8 + this%mss_cnc_ocpho_col(c,:) = 0._r8 + this%mss_cnc_dst1_col(c,:) = 0._r8 + this%mss_cnc_dst2_col(c,:) = 0._r8 + this%mss_cnc_dst3_col(c,:) = 0._r8 + this%mss_cnc_dst4_col(c,:) = 0._r8 + + this%mss_bctot_col(c,:) = 0._r8 + this%mss_bcpho_col(c,:) = 0._r8 + this%mss_bcphi_col(c,:) = 0._r8 + + this%mss_octot_col(c,:) = 0._r8 + this%mss_ocpho_col(c,:) = 0._r8 + this%mss_ocphi_col(c,:) = 0._r8 + + this%mss_dst1_col(c,:) = 0._r8 + this%mss_dst2_col(c,:) = 0._r8 + this%mss_dst3_col(c,:) = 0._r8 + this%mss_dst4_col(c,:) = 0._r8 + this%mss_dsttot_col(c,:) = 0._r8 + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, & + h2osoi_ice_col, h2osoi_liq_col) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use clm_varctl , only : iulog + use clm_varpar , only : nlevsno + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(aerosol_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + real(r8) , intent(in) :: h2osoi_ice_col( bounds%begc: , -nlevsno+1: ) ! ice content (col,lyr) [kg/m2] + real(r8) , intent(in) :: h2osoi_liq_col( bounds%begc: , -nlevsno+1: ) ! liquid water content (col,lyr) [kg/m2] + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(h2osoi_ice_col) == (/bounds%endc,nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_liq_col) == (/bounds%endc,nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + call restartvar(ncid=ncid, flag=flag, varname='mss_bcpho', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer hydrophobic black carbon mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_bcpho_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_bcpho to zero + this%mss_bcpho_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='mss_bcphi', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer hydrophilic black carbon mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_bcphi_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_bcphi to zero + this%mss_bcphi_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='mss_ocpho', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer hydrophobic organic carbon mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_ocpho_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_ocpho to zero + this%mss_ocpho_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='mss_ocphi', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer hydrophilic organic carbon mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_ocphi_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_ocphi to zero + this%mss_ocphi_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='mss_dst1', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer dust species 1 mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_dst1_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_dst1 to zero + this%mss_dst1_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='mss_dst2', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer dust species 2 mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_dst2_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_dst2 to zero + this%mss_dst2_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + endif + + call restartvar(ncid=ncid, flag=flag, varname='mss_dst3', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer dust species 3 mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_dst3_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_dst3 to zero + this%mss_dst3_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + endif + + call restartvar(ncid=ncid, flag=flag, varname='mss_dst4', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer dust species 4 mass', units='kg m-2', & + interpinic_flag='interp', readvar=readvar, data=this%mss_dst4_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize mss_dst4 to zero + this%mss_dst4_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + end if + + ! initialize other variables that are derived from those stored in the restart buffer (SNICAR variables) + if (flag == 'read' ) then + do j = -nlevsno+1,0 + do c = bounds%begc, bounds%endc + ! mass concentrations of aerosols in snow + if (h2osoi_ice_col(c,j) + h2osoi_liq_col(c,j) > 0._r8) then + this%mss_cnc_bcpho_col(c,j) = this%mss_bcpho_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_bcphi_col(c,j) = this%mss_bcphi_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_ocpho_col(c,j) = this%mss_ocpho_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_ocphi_col(c,j) = this%mss_ocphi_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + + this%mss_cnc_dst1_col(c,j) = this%mss_dst1_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_dst2_col(c,j) = this%mss_dst2_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_dst3_col(c,j) = this%mss_dst3_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + this%mss_cnc_dst4_col(c,j) = this%mss_dst4_col(c,j) / (h2osoi_ice_col(c,j)+h2osoi_liq_col(c,j)) + else + this%mss_cnc_bcpho_col(c,j) = 0._r8 + this%mss_cnc_bcphi_col(c,j) = 0._r8 + this%mss_cnc_ocpho_col(c,j) = 0._r8 + this%mss_cnc_ocphi_col(c,j) = 0._r8 + + this%mss_cnc_dst1_col(c,j) = 0._r8 + this%mss_cnc_dst2_col(c,j) = 0._r8 + this%mss_cnc_dst3_col(c,j) = 0._r8 + this%mss_cnc_dst4_col(c,j) = 0._r8 + endif + enddo + enddo + endif + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Reset(this, column) + ! + ! !DESCRIPTION: + ! Intitialize SNICAR variables for fresh snow column + ! + ! !ARGUMENTS: + class(aerosol_type) :: this + integer , intent(in) :: column ! column index + !----------------------------------------------------------------------- + + this%mss_bcpho_col(column,:) = 0._r8 + this%mss_bcphi_col(column,:) = 0._r8 + this%mss_bctot_col(column,:) = 0._r8 + this%mss_bc_col_col(column) = 0._r8 + this%mss_bc_top_col(column) = 0._r8 + + this%mss_ocpho_col(column,:) = 0._r8 + this%mss_ocphi_col(column,:) = 0._r8 + this%mss_octot_col(column,:) = 0._r8 + this%mss_oc_col_col(column) = 0._r8 + this%mss_oc_top_col(column) = 0._r8 + + this%mss_dst1_col(column,:) = 0._r8 + this%mss_dst2_col(column,:) = 0._r8 + this%mss_dst3_col(column,:) = 0._r8 + this%mss_dst4_col(column,:) = 0._r8 + this%mss_dsttot_col(column,:) = 0._r8 + this%mss_dst_col_col(column) = 0._r8 + this%mss_dst_top_col(column) = 0._r8 + + end subroutine Reset + + !----------------------------------------------------------------------- + subroutine AerosolMasses(bounds, num_on, filter_on, num_off, filter_off, & + waterflux_inst, waterstate_inst, aerosol_inst) + ! + ! !DESCRIPTION: + ! Calculate column-integrated aerosol masses, and + ! mass concentrations for radiative calculations and output + ! (based on new snow level state, after SnowFilter is rebuilt. + ! NEEDS TO BE AFTER SnowFiler is rebuilt in Hydrology2, otherwise there + ! can be zero snow layers but an active column in filter) + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in ) :: bounds + integer , intent(in) :: num_on ! number of column filter-ON points + integer , intent(in) :: filter_on(:) ! column filter for filter-ON points + integer , intent(in) :: num_off ! number of column non filter-OFF points + integer , intent(in) :: filter_off(:) ! column filter for filter-OFF points + type(waterflux_type) , intent(in) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: dtime ! land model time step (sec) + integer :: g,l,c,j,fc ! indices + real(r8) :: snowmass ! liquid+ice snow mass in a layer [kg/m2] + real(r8) :: snowcap_scl_fct ! temporary factor used to correct for snow capping + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + qflx_snwcp_ice=> waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + + h2osno_top => waterstate_inst%h2osno_top_col , & ! Output: [real(r8) (:) | top-layer mass of snow [kg] + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] + + mss_bcpho => aerosol_inst%mss_bcpho_col , & ! Output: [real(r8) (:,:) ] mass of hydrophobic BC in snow (col,lyr) [kg] + mss_bcphi => aerosol_inst%mss_bcphi_col , & ! Output: [real(r8) (:,:) ] mass of hydrophillic BC in snow (col,lyr) [kg] + mss_bctot => aerosol_inst%mss_bctot_col , & ! Output: [real(r8) (:,:) ] total mass of BC (pho+phi) (col,lyr) [kg] + mss_bc_col => aerosol_inst%mss_bc_col_col , & ! Output: [real(r8) (:) ] total mass of BC in snow column (col) [kg] + mss_bc_top => aerosol_inst%mss_bc_top_col , & ! Output: [real(r8) (:) ] total mass of BC in top snow layer (col) [kg] + mss_ocpho => aerosol_inst%mss_ocpho_col , & ! Output: [real(r8) (:,:) ] mass of hydrophobic OC in snow (col,lyr) [kg] + mss_ocphi => aerosol_inst%mss_ocphi_col , & ! Output: [real(r8) (:,:) ] mass of hydrophillic OC in snow (col,lyr) [kg] + mss_octot => aerosol_inst%mss_octot_col , & ! Output: [real(r8) (:,:) ] total mass of OC (pho+phi) (col,lyr) [kg] + mss_oc_col => aerosol_inst%mss_oc_col_col , & ! Output: [real(r8) (:) ] total mass of OC in snow column (col) [kg] + mss_oc_top => aerosol_inst%mss_oc_top_col , & ! Output: [real(r8) (:) ] total mass of OC in top snow layer (col) [kg] + mss_dst1 => aerosol_inst%mss_dst1_col , & ! Output: [real(r8) (:,:) ] mass of dust species 1 in snow (col,lyr) [kg] + mss_dst2 => aerosol_inst%mss_dst2_col , & ! Output: [real(r8) (:,:) ] mass of dust species 2 in snow (col,lyr) [kg] + mss_dst3 => aerosol_inst%mss_dst3_col , & ! Output: [real(r8) (:,:) ] mass of dust species 3 in snow (col,lyr) [kg] + mss_dst4 => aerosol_inst%mss_dst4_col , & ! Output: [real(r8) (:,:) ] mass of dust species 4 in snow (col,lyr) [kg] + mss_dsttot => aerosol_inst%mss_dsttot_col , & ! Output: [real(r8) (:,:) ] total mass of dust in snow (col,lyr) [kg] + mss_dst_col => aerosol_inst%mss_dst_col_col , & ! Output: [real(r8) (:) ] total mass of dust in snow column (col) [kg] + mss_dst_top => aerosol_inst%mss_dst_top_col , & ! Output: [real(r8) (:) ] total mass of dust in top snow layer (col) [kg] + mss_cnc_bcphi => aerosol_inst%mss_cnc_bcphi_col , & ! Output: [real(r8) (:,:) ] mass concentration of BC species 1 (col,lyr) [kg/kg] + mss_cnc_bcpho => aerosol_inst%mss_cnc_bcpho_col , & ! Output: [real(r8) (:,:) ] mass concentration of BC species 2 (col,lyr) [kg/kg] + mss_cnc_ocphi => aerosol_inst%mss_cnc_ocphi_col , & ! Output: [real(r8) (:,:) ] mass concentration of OC species 1 (col,lyr) [kg/kg] + mss_cnc_ocpho => aerosol_inst%mss_cnc_ocpho_col , & ! Output: [real(r8) (:,:) ] mass concentration of OC species 2 (col,lyr) [kg/kg] + mss_cnc_dst1 => aerosol_inst%mss_cnc_dst1_col , & ! Output: [real(r8) (:,:) ] mass concentration of dust species 1 (col,lyr) [kg/kg] + mss_cnc_dst2 => aerosol_inst%mss_cnc_dst2_col , & ! Output: [real(r8) (:,:) ] mass concentration of dust species 2 (col,lyr) [kg/kg] + mss_cnc_dst3 => aerosol_inst%mss_cnc_dst3_col , & ! Output: [real(r8) (:,:) ] mass concentration of dust species 3 (col,lyr) [kg/kg] + mss_cnc_dst4 => aerosol_inst%mss_cnc_dst4_col & ! Output: [real(r8) (:,:) ] mass concentration of dust species 4 (col,lyr) [kg/kg] + ) + + dtime = get_step_size() + + do fc = 1, num_on + c = filter_on(fc) + + ! Zero column-integrated aerosol mass before summation + mss_bc_col(c) = 0._r8 + mss_oc_col(c) = 0._r8 + mss_dst_col(c) = 0._r8 + + do j = -nlevsno+1, 0 + + ! layer mass of snow: + snowmass = h2osoi_ice(c,j) + h2osoi_liq(c,j) + + ! Correct the top layer aerosol mass to account for snow capping. + ! This approach conserves the aerosol mass concentration + ! (but not the aerosol amss) when snow-capping is invoked + + if (j == snl(c)+1) then + if (do_capsnow(c)) then + + snowcap_scl_fct = snowmass / (snowmass + (qflx_snwcp_ice(c)*dtime)) + + mss_bcpho(c,j) = mss_bcpho(c,j)*snowcap_scl_fct + mss_bcphi(c,j) = mss_bcphi(c,j)*snowcap_scl_fct + mss_ocpho(c,j) = mss_ocpho(c,j)*snowcap_scl_fct + mss_ocphi(c,j) = mss_ocphi(c,j)*snowcap_scl_fct + + mss_dst1(c,j) = mss_dst1(c,j)*snowcap_scl_fct + mss_dst2(c,j) = mss_dst2(c,j)*snowcap_scl_fct + mss_dst3(c,j) = mss_dst3(c,j)*snowcap_scl_fct + mss_dst4(c,j) = mss_dst4(c,j)*snowcap_scl_fct + endif + endif + + if (j >= snl(c)+1) then + + mss_bctot(c,j) = mss_bcpho(c,j) + mss_bcphi(c,j) + mss_bc_col(c) = mss_bc_col(c) + mss_bctot(c,j) + mss_cnc_bcphi(c,j) = mss_bcphi(c,j) / snowmass + mss_cnc_bcpho(c,j) = mss_bcpho(c,j) / snowmass + + mss_octot(c,j) = mss_ocpho(c,j) + mss_ocphi(c,j) + mss_oc_col(c) = mss_oc_col(c) + mss_octot(c,j) + mss_cnc_ocphi(c,j) = mss_ocphi(c,j) / snowmass + mss_cnc_ocpho(c,j) = mss_ocpho(c,j) / snowmass + + mss_dsttot(c,j) = mss_dst1(c,j) + mss_dst2(c,j) + mss_dst3(c,j) + mss_dst4(c,j) + mss_dst_col(c) = mss_dst_col(c) + mss_dsttot(c,j) + mss_cnc_dst1(c,j) = mss_dst1(c,j) / snowmass + mss_cnc_dst2(c,j) = mss_dst2(c,j) / snowmass + mss_cnc_dst3(c,j) = mss_dst3(c,j) / snowmass + mss_cnc_dst4(c,j) = mss_dst4(c,j) / snowmass + + else + !set variables of empty snow layers to zero + snw_rds(c,j) = 0._r8 + + mss_bcpho(c,j) = 0._r8 + mss_bcphi(c,j) = 0._r8 + mss_bctot(c,j) = 0._r8 + mss_cnc_bcphi(c,j) = 0._r8 + mss_cnc_bcpho(c,j) = 0._r8 + + mss_ocpho(c,j) = 0._r8 + mss_ocphi(c,j) = 0._r8 + mss_octot(c,j) = 0._r8 + mss_cnc_ocphi(c,j) = 0._r8 + mss_cnc_ocpho(c,j) = 0._r8 + + mss_dst1(c,j) = 0._r8 + mss_dst2(c,j) = 0._r8 + mss_dst3(c,j) = 0._r8 + mss_dst4(c,j) = 0._r8 + mss_dsttot(c,j) = 0._r8 + mss_cnc_dst1(c,j) = 0._r8 + mss_cnc_dst2(c,j) = 0._r8 + mss_cnc_dst3(c,j) = 0._r8 + mss_cnc_dst4(c,j) = 0._r8 + endif + enddo + + ! top-layer diagnostics + h2osno_top(c) = h2osoi_ice(c,snl(c)+1) + h2osoi_liq(c,snl(c)+1) !TODO MV - is this correct to be placed here??? + mss_bc_top(c) = mss_bctot(c,snl(c)+1) + mss_oc_top(c) = mss_octot(c,snl(c)+1) + mss_dst_top(c) = mss_dsttot(c,snl(c)+1) + enddo + + ! Zero mass variables in columns without snow + + do fc = 1, num_off + c = filter_off(fc) + + mss_bc_top(c) = 0._r8 + mss_bc_col(c) = 0._r8 + mss_bcpho(c,:) = 0._r8 + mss_bcphi(c,:) = 0._r8 + mss_bctot(c,:) = 0._r8 + mss_cnc_bcphi(c,:) = 0._r8 + mss_cnc_bcpho(c,:) = 0._r8 + + mss_oc_top(c) = 0._r8 + mss_oc_col(c) = 0._r8 + mss_ocpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_octot(c,:) = 0._r8 + mss_cnc_ocphi(c,:) = 0._r8 + mss_cnc_ocpho(c,:) = 0._r8 + + mss_dst_top(c) = 0._r8 + mss_dst_col(c) = 0._r8 + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + mss_dsttot(c,:) = 0._r8 + + mss_cnc_dst1(c,:) = 0._r8 + mss_cnc_dst2(c,:) = 0._r8 + mss_cnc_dst3(c,:) = 0._r8 + mss_cnc_dst4(c,:) = 0._r8 + + enddo + + end associate + + end subroutine AerosolMasses + + !----------------------------------------------------------------------- + subroutine AerosolFluxes(bounds, num_snowc, filter_snowc, & + atm2lnd_inst, aerosol_inst) + ! + ! !DESCRIPTION: + ! Compute aerosol fluxes through snowpack and aerosol deposition fluxes into top layere + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_snowc ! number of snow points in column filter + integer , intent(in) :: filter_snowc(:) ! column filter for snow points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: dtime ! land model time step (sec) + integer :: c,g,j,fc + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + forc_aer => atm2lnd_inst%forc_aer_grc , & ! Input: [real(r8) (:,:) ] aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] + + mss_bcphi => aerosol_inst%mss_bcphi_col , & ! Output: [real(r8) (:,:) ] hydrophillic BC mass in snow (col,lyr) [kg] + mss_bcpho => aerosol_inst%mss_bcpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic BC mass in snow (col,lyr) [kg] + mss_ocphi => aerosol_inst%mss_ocphi_col , & ! Output: [real(r8) (:,:) ] hydrophillic OC mass in snow (col,lyr) [kg] + mss_ocpho => aerosol_inst%mss_ocpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic OC mass in snow (col,lyr) [kg] + mss_dst1 => aerosol_inst%mss_dst1_col , & ! Output: [real(r8) (:,:) ] mass of dust species 1 in snow (col,lyr) [kg] + mss_dst2 => aerosol_inst%mss_dst2_col , & ! Output: [real(r8) (:,:) ] mass of dust species 2 in snow (col,lyr) [kg] + mss_dst3 => aerosol_inst%mss_dst3_col , & ! Output: [real(r8) (:,:) ] mass of dust species 3 in snow (col,lyr) [kg] + mss_dst4 => aerosol_inst%mss_dst4_col , & ! Output: [real(r8) (:,:) ] mass of dust species 4 in snow (col,lyr) [kg] + + flx_bc_dep => aerosol_inst%flx_bc_dep_col , & ! Output: [real(r8) (:) ] total BC deposition (col) [kg m-2 s-1] + flx_bc_dep_wet => aerosol_inst%flx_bc_dep_wet_col , & ! Output: [real(r8) (:) ] wet BC deposition (col) [kg m-2 s-1] + flx_bc_dep_dry => aerosol_inst%flx_bc_dep_dry_col , & ! Output: [real(r8) (:) ] dry BC deposition (col) [kg m-2 s-1] + flx_bc_dep_phi => aerosol_inst%flx_bc_dep_phi_col , & ! Output: [real(r8) (:) ] hydrophillic BC deposition (col) [kg m-1 s-1] + flx_bc_dep_pho => aerosol_inst%flx_bc_dep_pho_col , & ! Output: [real(r8) (:) ] hydrophobic BC deposition (col) [kg m-1 s-1] + flx_oc_dep => aerosol_inst%flx_oc_dep_col , & ! Output: [real(r8) (:) ] total OC deposition (col) [kg m-2 s-1] + flx_oc_dep_wet => aerosol_inst%flx_oc_dep_wet_col , & ! Output: [real(r8) (:) ] wet OC deposition (col) [kg m-2 s-1] + flx_oc_dep_dry => aerosol_inst%flx_oc_dep_dry_col , & ! Output: [real(r8) (:) ] dry OC deposition (col) [kg m-2 s-1] + flx_oc_dep_phi => aerosol_inst%flx_oc_dep_phi_col , & ! Output: [real(r8) (:) ] hydrophillic OC deposition (col) [kg m-1 s-1] + flx_oc_dep_pho => aerosol_inst%flx_oc_dep_pho_col , & ! Output: [real(r8) (:) ] hydrophobic OC deposition (col) [kg m-1 s-1] + flx_dst_dep => aerosol_inst%flx_dst_dep_col , & ! Output: [real(r8) (:) ] total dust deposition (col) [kg m-2 s-1] + flx_dst_dep_wet1 => aerosol_inst%flx_dst_dep_wet1_col , & ! Output: [real(r8) (:) ] wet dust (species 1) deposition (col) [kg m-2 s-1] + flx_dst_dep_dry1 => aerosol_inst%flx_dst_dep_dry1_col , & ! Output: [real(r8) (:) ] dry dust (species 1) deposition (col) [kg m-2 s-1] + flx_dst_dep_wet2 => aerosol_inst%flx_dst_dep_wet2_col , & ! Output: [real(r8) (:) ] wet dust (species 2) deposition (col) [kg m-2 s-1] + flx_dst_dep_dry2 => aerosol_inst%flx_dst_dep_dry2_col , & ! Output: [real(r8) (:) ] dry dust (species 2) deposition (col) [kg m-2 s-1] + flx_dst_dep_wet3 => aerosol_inst%flx_dst_dep_wet3_col , & ! Output: [real(r8) (:) ] wet dust (species 3) deposition (col) [kg m-2 s-1] + flx_dst_dep_dry3 => aerosol_inst%flx_dst_dep_dry3_col , & ! Output: [real(r8) (:) ] dry dust (species 3) deposition (col) [kg m-2 s-1] + flx_dst_dep_wet4 => aerosol_inst%flx_dst_dep_wet4_col , & ! Output: [real(r8) (:) ] wet dust (species 4) deposition (col) [kg m-2 s-1] + flx_dst_dep_dry4 => aerosol_inst%flx_dst_dep_dry4_col & ! Output: [real(r8) (:) ] dry dust (species 4) deposition (col) [kg m-2 s-1] + ) + + ! set aerosol deposition fluxes from forcing array + ! The forcing array is either set from an external file + ! or from fluxes received from the atmosphere model + + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + + flx_bc_dep_dry(c) = forc_aer(g,1) + forc_aer(g,2) + flx_bc_dep_wet(c) = forc_aer(g,3) + flx_bc_dep_phi(c) = forc_aer(g,1) + forc_aer(g,3) + flx_bc_dep_pho(c) = forc_aer(g,2) + flx_bc_dep(c) = forc_aer(g,1) + forc_aer(g,2) + forc_aer(g,3) + + flx_oc_dep_dry(c) = forc_aer(g,4) + forc_aer(g,5) + flx_oc_dep_wet(c) = forc_aer(g,6) + flx_oc_dep_phi(c) = forc_aer(g,4) + forc_aer(g,6) + flx_oc_dep_pho(c) = forc_aer(g,5) + flx_oc_dep(c) = forc_aer(g,4) + forc_aer(g,5) + forc_aer(g,6) + + flx_dst_dep_wet1(c) = forc_aer(g,7) + flx_dst_dep_dry1(c) = forc_aer(g,8) + flx_dst_dep_wet2(c) = forc_aer(g,9) + flx_dst_dep_dry2(c) = forc_aer(g,10) + flx_dst_dep_wet3(c) = forc_aer(g,11) + flx_dst_dep_dry3(c) = forc_aer(g,12) + flx_dst_dep_wet4(c) = forc_aer(g,13) + flx_dst_dep_dry4(c) = forc_aer(g,14) + flx_dst_dep(c) = forc_aer(g,7) + forc_aer(g,8) + forc_aer(g,9) + & + forc_aer(g,10) + forc_aer(g,11) + forc_aer(g,12) + & + forc_aer(g,13) + forc_aer(g,14) + end do + + ! aerosol deposition fluxes into top layer + ! This is done after the inter-layer fluxes so that some aerosol + ! is in the top layer after deposition, and is not immediately + ! washed out before radiative calculations are done + + dtime = get_step_size() + + do fc = 1, num_snowc + c = filter_snowc(fc) + mss_bcphi(c,snl(c)+1) = mss_bcphi(c,snl(c)+1) + (flx_bc_dep_phi(c)*dtime) + mss_bcpho(c,snl(c)+1) = mss_bcpho(c,snl(c)+1) + (flx_bc_dep_pho(c)*dtime) + mss_ocphi(c,snl(c)+1) = mss_ocphi(c,snl(c)+1) + (flx_oc_dep_phi(c)*dtime) + mss_ocpho(c,snl(c)+1) = mss_ocpho(c,snl(c)+1) + (flx_oc_dep_pho(c)*dtime) + + mss_dst1(c,snl(c)+1) = mss_dst1(c,snl(c)+1) + (flx_dst_dep_dry1(c) + flx_dst_dep_wet1(c))*dtime + mss_dst2(c,snl(c)+1) = mss_dst2(c,snl(c)+1) + (flx_dst_dep_dry2(c) + flx_dst_dep_wet2(c))*dtime + mss_dst3(c,snl(c)+1) = mss_dst3(c,snl(c)+1) + (flx_dst_dep_dry3(c) + flx_dst_dep_wet3(c))*dtime + mss_dst4(c,snl(c)+1) = mss_dst4(c,snl(c)+1) + (flx_dst_dep_dry4(c) + flx_dst_dep_wet4(c))*dtime + end do + + end associate + + end subroutine AerosolFluxes + +end module AerosolMod diff --git a/components/clm/src/biogeophys/BalanceCheckMod.F90 b/components/clm/src/biogeophys/BalanceCheckMod.F90 new file mode 100644 index 0000000000..e0a133d41e --- /dev/null +++ b/components/clm/src/biogeophys/BalanceCheckMod.F90 @@ -0,0 +1,682 @@ +module BalanceCheckMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Water and energy balance check. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varcon , only : namep, namec + use GetGlobalValuesMod , only : GetGlobalIndex + use atm2lndType , only : atm2lnd_type + use glc2lndMod , only : glc2lnd_type + use EnergyFluxType , only : energyflux_type + use SolarAbsorbedType , only : solarabs_type + use SoilHydrologyType , only : soilhydrology_type + use WaterstateType , only : waterstate_type + use WaterfluxType , only : waterflux_type + use IrrigationMod , only : irrigation_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: BeginWaterBalance ! Initialize water balance check + public :: BalanceCheck ! Water and energy balance check + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine BeginWaterBalance(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Initialize column-level water balance at beginning of time step + ! + ! !USES: + use subgridAveMod , only : p2c + use clm_varpar , only : nlevgrnd, nlevsoi, nlevurb + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv, icol_road_imperv + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for non-lake points + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c, p, f, j, fc ! indices + real(r8):: h2osoi_vol + !----------------------------------------------------------------------- + + associate( & + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + + h2ocan_patch => waterstate_inst%h2ocan_patch , & ! Input: [real(r8) (:) ] canopy water (mm H2O) (patch-level) + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + wa => soilhydrology_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + h2ocan_col => waterstate_inst%h2ocan_col , & ! Output: [real(r8) (:) ] canopy water (mm H2O) (column level) + begwb => waterstate_inst%begwb_col & ! Output: [real(r8) (:) ] water mass begining of the time step + ) + + ! Determine beginning water balance for time step + ! patch-level canopy water averaged to column + + call p2c(bounds, num_nolakec, filter_nolakec, & + h2ocan_patch(bounds%begp:bounds%endp), & + h2ocan_col(bounds%begc:bounds%endc)) + + do f = 1, num_hydrologyc + c = filter_hydrologyc(f) + if(zwt(c) <= zi(c,nlevsoi)) then + wa(c) = 5000._r8 + end if + end do + + do f = 1, num_nolakec + c = filter_nolakec(f) + if (col%itype(c) == icol_roof .or. col%itype(c) == icol_sunwall & + .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_road_imperv) then + begwb(c) = h2ocan_col(c) + h2osno(c) + else + begwb(c) = h2ocan_col(c) + h2osno(c) + h2osfc(c) + wa(c) + end if + + end do + do j = 1, nlevgrnd + do f = 1, num_nolakec + c = filter_nolakec(f) + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) .and. j > nlevurb) then + else + begwb(c) = begwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end if + end do + end do + + do f = 1, num_lakec + c = filter_lakec(f) + begwb(c) = h2osno(c) + end do + + end associate + + end subroutine BeginWaterBalance + + !----------------------------------------------------------------------- + subroutine BalanceCheck( bounds, num_do_smb_c, filter_do_smb_c, & + atm2lnd_inst, glc2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & + irrigation_inst, energyflux_inst, canopystate_inst) + ! + ! !DESCRIPTION: + ! This subroutine accumulates the numerical truncation errors of the water + ! and energy balance calculation. It is helpful to see the performance of + ! the process of integration. + ! + ! The error for energy balance: + ! + ! error = abs(Net radiation - change of internal energy - Sensible heat + ! - Latent heat) + ! + ! The error for water balance: + ! + ! error = abs(precipitation - change of water storage - evaporation - runoff) + ! + ! !USES: + use clm_varcon , only : spval + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv, icol_road_imperv + use landunit_varcon , only : istice_mec, istdlak, istsoil,istcrop,istwet + use clm_varctl , only : create_glacier_mec_landunit + use clm_time_manager , only : get_step_size, get_nstep + use clm_initializeMod , only : surfalb_inst + use CanopyStateType , only : canopystate_type + use subgridAveMod + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_do_smb_c ! number of columns in filter_do_smb_c + integer , intent(in) :: filter_do_smb_c (:) ! column filter for points where SMB calculations are done + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(glc2lnd_type) , intent(in) :: glc2lnd_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(irrigation_type) , intent(in) :: irrigation_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(canopystate_type), intent(inout) :: canopystate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,g,fc ! indices + real(r8) :: dtime ! land model time step (sec) + integer :: nstep ! time step number + logical :: found ! flag in search loop + integer :: indexp,indexc,indexl,indexg ! index of first found in search loop + real(r8) :: forc_rain_col(bounds%begc:bounds%endc) ! column level rain rate [mm/s] + real(r8) :: forc_snow_col(bounds%begc:bounds%endc) ! column level snow rate [mm/s] + !----------------------------------------------------------------------- + + associate( & + volr => atm2lnd_inst%volr_grc , & ! Input: [real(r8) (:) ] river water storage (m3) + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (vis=forc_sols , nir=forc_soll ) + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (vis=forc_solsd, nir=forc_solld) + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + + glc_dyn_runoff_routing => glc2lnd_inst%glc_dyn_runoff_routing_grc , & ! Input: [real(r8) (:) ] whether we're doing runoff routing appropriate for having a dynamic icesheet + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osno_old => waterstate_inst%h2osno_old_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) at previous time step + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] effective snow fraction + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + begwb => waterstate_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step + errh2o => waterstate_inst%errh2o_col , & ! Output: [real(r8) (:) ] water conservation error (mm H2O) + errh2osno => waterstate_inst%errh2osno_col , & ! Output: [real(r8) (:) ] error in h2osno (kg m-2) + endwb => waterstate_inst%endwb_col , & ! Output: [real(r8) (:) ] water mass end of the time step + + qflx_rain_grnd_col => waterflux_inst%qflx_rain_grnd_col , & ! Input: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] + qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Input: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] + qflx_evap_soi => waterflux_inst%qflx_evap_soi_col , & ! Input: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+]` + qflx_evap_tot => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_dew_snow => waterflux_inst%qflx_dew_snow_col , & ! Input: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_sub_snow => waterflux_inst%qflx_sub_snow_col , & ! Input: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_col , & ! Input: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_prec_grnd => waterflux_inst%qflx_prec_grnd_col , & ! Input: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_col , & ! Input: [real(r8) (:) ] excess liquid water due to snow capping (mm H2O /s) [+]` + qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) + qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Input: [real(r8) (:) ] conversion of h2osfc to ice + qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] total runoff due to flooding + qflx_h2osfc_surf => waterflux_inst%qflx_h2osfc_surf_col , & ! Input: [real(r8) (:) ] surface water runoff (mm/s) + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack + qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes + qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_runoff => waterflux_inst%qflx_runoff_col , & ! Input: [real(r8) (:) ] total runoff (mm H2O /s) + qflx_glcice => waterflux_inst%qflx_glcice_col , & ! Input: [real(r8) (:) ] flux of new glacier ice (mm H2O /s) [+ if ice grows] + qflx_glcice_melt => waterflux_inst%qflx_glcice_melt_col , & ! Input: [real(r8) (:) ] ice melt (mm H2O/s) + qflx_glcice_frz => waterflux_inst%qflx_glcice_frz_col , & ! Input: [real(r8) (:) ] ice growth (mm H2O/s) [+] + qflx_top_soil => waterflux_inst%qflx_top_soil_col , & ! Input: [real(r8) (:) ] net water input into soil from top (mm/s) + qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Input: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + qflx_liq_dynbal => waterflux_inst%qflx_liq_dynbal_grc , & ! Input: [real(r8) (:) ] liq runoff due to dynamic land cover change (mm H2O /s) + qflx_ice_dynbal => waterflux_inst%qflx_ice_dynbal_grc , & ! Input: [real(r8) (:) ] ice runoff due to dynamic land cover change (mm H2O /s) + snow_sources => waterflux_inst%snow_sources_col , & ! Output: [real(r8) (:) ] snow sources (mm H2O /s) + snow_sinks => waterflux_inst%snow_sinks_col , & ! Output: [real(r8) (:) ] snow sinks (mm H2O /s) + + qflx_irrig => irrigation_inst%qflx_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) + + eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Input: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_lh_tot => energyflux_inst%eflx_lh_tot_patch , & ! Input: [real(r8) (:) ] total latent heat flux (W/m8*2) [+ to atm] + eflx_soil_grnd => energyflux_inst%eflx_soil_grnd_patch , & ! Input: [real(r8) (:) ] soil heat flux (W/m**2) [+ = into soil] + eflx_wasteheat_patch => energyflux_inst%eflx_wasteheat_patch , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac_patch => energyflux_inst%eflx_heat_from_ac_patch , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_traffic_patch => energyflux_inst%eflx_traffic_patch , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_dynbal => energyflux_inst%eflx_dynbal_grc , & ! Input: [real(r8) (:) ] energy conversion flux due to dynamic land cover change(W/m**2) [+ to atm] + errsoi_col => energyflux_inst%errsoi_col , & ! Output: [real(r8) (:) ] column-level soil/lake energy conservation error (W/m**2) + errsol => energyflux_inst%errsol_patch , & ! Output: [real(r8) (:) ] solar radiation conservation error (W/m**2) + errseb => energyflux_inst%errseb_patch , & ! Output: [real(r8) (:) ] surface energy conservation error (W/m**2) + errlon => energyflux_inst%errlon_patch , & ! Output: [real(r8) (:) ] longwave radiation conservation error (W/m**2) + + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg_chk => solarabs_inst%sabg_chk_patch , & ! Input: [real(r8) (:) ] sum of soil/snow using current fsno, for balance check + fsa => solarabs_inst%fsa_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed (total) (W/m**2) + fsr => solarabs_inst%fsr_patch , & ! Input: [real(r8) (:) ] solar radiation reflected (W/m**2) + sabv => solarabs_inst%sabv_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:,:)] + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:,:)] + + fabd => surfalb_inst%fabd_patch , & ! Input: [real(r8) (:,:)] flux absorbed by canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Input: [real(r8) (:,:)] flux absorbed by canopy per unit indirect flux + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:)] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:)] surface albedo (diffuse) + ftdd => surfalb_inst%ftdd_patch , & ! Input: [real(r8) (:,:)] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Input: [real(r8) (:,:)] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Input: [real(r8) (:,:)] down diffuse flux below canopy per unit diffuse flux + + netrad => energyflux_inst%netrad_patch & ! Output: [real(r8) (:) ] net radiation (positive downward) (W/m**2) + ) + + ! Get step size and time step + + nstep = get_nstep() + dtime = get_step_size() + + ! Determine column level incoming snow and rain + ! Assume no incident precipitation on urban wall columns (as in CanopyHydrologyMod.F90). + + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + l = col%landunit(c) + + if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then + forc_rain_col(c) = 0. + forc_snow_col(c) = 0. + else + forc_rain_col(c) = forc_rain(c) + forc_snow_col(c) = forc_snow(c) + end if + end do + + ! Water balance check + + do c = bounds%begc, bounds%endc + + ! add qflx_drain_perched and qflx_flood + if (col%active(c)) then + + errh2o(c) = endwb(c) - begwb(c) & + - (forc_rain_col(c) & + + forc_snow_col(c) & + + qflx_floodc(c) & + + qflx_irrig(c) & + - qflx_evap_tot(c) & + - qflx_surf(c) & + - qflx_h2osfc_surf(c) & + - qflx_qrgwl(c) & + - qflx_drain(c) & + - qflx_drain_perched(c) & + - qflx_snwcp_ice(c)) * dtime + + else + + errh2o(c) = 0.0_r8 + + end if + + end do + + ! Suppose glc_dyn_runoff_routing = T: + ! (1) We have qflx_snwcp_ice = 0, and excess snow has been incorporated in qflx_glcice_frz. + ! This flux must be included here to complete the water balance, because it is a + ! sink of water as far as CLM is concerned (this water will now be owned by CISM). + ! (2) Meltwater from ice (qflx_glcice_melt) is allowed to run off and is included in qflx_qrgwl, + ! but the water content of the ice column has not changed (at least for now) because + ! an equivalent ice mass has been "borrowed" from the base of the column. So this mass + ! has to be added back to the column, as far as the error correction is concerned, by + ! adding back the equivalent flux*timestep. + + do fc = 1,num_do_smb_c + c = filter_do_smb_c(fc) + g = col%gridcell(c) + if (glc_dyn_runoff_routing(g)) then + errh2o(c) = errh2o(c) + qflx_glcice_frz(c)*dtime + errh2o(c) = errh2o(c) - qflx_glcice_melt(c)*dtime + endif + end do + + found = .false. + do c = bounds%begc, bounds%endc + if (abs(errh2o(c)) > 1.e-9_r8) then + found = .true. + indexc = c + end if + end do + + if ( found ) then + + write(iulog,*)'WARNING: water balance error ',& + ' nstep= ',nstep, & + ' local indexc= ',indexc,& + ! ' global indexc= ',GetGlobalIndex(decomp_index=indexc, clmlevel=namec), & + ' errh2o= ',errh2o(indexc) + + if ((col%itype(indexc) == icol_roof .or. & + col%itype(indexc) == icol_road_imperv .or. & + col%itype(indexc) == icol_road_perv) .and. & + abs(errh2o(indexc)) > 1.e-5_r8 .and. (nstep > 2) ) then + + write(iulog,*)'clm urban model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errh2o = ',errh2o(indexc) + write(iulog,*)'forc_rain = ',forc_rain_col(indexc) + write(iulog,*)'forc_snow = ',forc_snow_col(indexc) + write(iulog,*)'endwb = ',endwb(indexc) + write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc) + write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc) + write(iulog,*)'qflx_surf = ',qflx_surf(indexc) + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc) + write(iulog,*)'qflx_drain = ',qflx_drain(indexc) + write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc) + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + + else if (abs(errh2o(indexc)) > 1.e-5_r8 .and. (nstep > 2) ) then + + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errh2o = ',errh2o(indexc) + write(iulog,*)'forc_rain = ',forc_rain_col(indexc) + write(iulog,*)'forc_snow = ',forc_snow_col(indexc) + write(iulog,*)'endwb = ',endwb(indexc) + write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc) + write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc) + write(iulog,*)'qflx_surf = ',qflx_surf(indexc) + write(iulog,*)'qflx_h2osfc_surf = ',qflx_h2osfc_surf(indexc) + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc) + write(iulog,*)'qflx_drain = ',qflx_drain(indexc) + write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched(indexc) + write(iulog,*)'qflx_flood = ',qflx_floodc(indexc) + write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc) + write(iulog,*)'qflx_glcice_melt = ',qflx_glcice_melt(indexc) + write(iulog,*)'qflx_glcice_frz = ',qflx_glcice_frz(indexc) + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Snow balance check + + do c = bounds%begc,bounds%endc + if (col%active(c)) then + g = col%gridcell(c) + l = col%landunit(c) + + ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at + ! any given time step but only if there is at least one snow layer. h2osno + ! also includes snow that is part of the soil column (an initial snow layer is + ! only created if h2osno > 10mm). + + if (col%snl(c) < 0) then + snow_sources(c) = qflx_prec_grnd(c) + qflx_dew_snow(c) + qflx_dew_grnd(c) + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) + qflx_snow_drain(c) & + + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) + qflx_sl_top_soil(c) + + if (lun%itype(l) == istdlak) then + if ( do_capsnow(c) ) then + snow_sources(c) = qflx_snow_grnd_col(c) & + + frac_sno_eff(c) * (qflx_dew_snow(c) + qflx_dew_grnd(c) ) + + snow_sinks(c) = frac_sno_eff(c) * (qflx_sub_snow(c) + qflx_evap_grnd(c) ) & + + (qflx_snwcp_ice(c) + qflx_snwcp_liq(c) - qflx_prec_grnd(c)) & + + qflx_snow_drain(c) + qflx_sl_top_soil(c) + else + snow_sources(c) = qflx_snow_grnd_col(c) & + + frac_sno_eff(c) * (qflx_rain_grnd_col(c) & + + qflx_dew_snow(c) + qflx_dew_grnd(c) ) + + snow_sinks(c) = frac_sno_eff(c) * (qflx_sub_snow(c) + qflx_evap_grnd(c) ) & + + qflx_snow_drain(c) + qflx_sl_top_soil(c) + endif + endif + + if (col%itype(c) == icol_road_perv .or. lun%itype(l) == istsoil .or. & + lun%itype(l) == istcrop .or. lun%itype(l) == istwet ) then + if ( do_capsnow(c) ) then + snow_sources(c) = frac_sno_eff(c) * (qflx_dew_snow(c) + qflx_dew_grnd(c) ) & + + qflx_h2osfc_to_ice(c) + qflx_prec_grnd(c) + + snow_sinks(c) = frac_sno_eff(c) * (qflx_sub_snow(c) + qflx_evap_grnd(c)) & + + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & + + qflx_snow_drain(c) + qflx_sl_top_soil(c) + else + snow_sources(c) = (qflx_snow_grnd_col(c) - qflx_snow_h2osfc(c) ) & + + frac_sno_eff(c) * (qflx_rain_grnd_col(c) & + + qflx_dew_snow(c) + qflx_dew_grnd(c) ) + qflx_h2osfc_to_ice(c) + + snow_sinks(c) = frac_sno_eff(c) * (qflx_sub_snow(c) + qflx_evap_grnd(c)) & + + qflx_snow_drain(c) + qflx_sl_top_soil(c) + endif + endif + + if (glc_dyn_runoff_routing(g)) then + ! Need to add qflx_glcice_frz to snow_sinks for the same reason as it is + ! added to errh2o above - see the comment above for details. + snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) + end if + + errh2osno(c) = (h2osno(c) - h2osno_old(c)) - (snow_sources(c) - snow_sinks(c)) * dtime + else + snow_sources(c) = 0._r8 + snow_sinks(c) = 0._r8 + errh2osno(c) = 0._r8 + end if + + end if + end do + + found = .false. + do c = bounds%begc,bounds%endc + if (col%active(c)) then + if (abs(errh2osno(c)) > 1.0e-9_r8) then + found = .true. + indexc = c + end if + end if + end do + if ( found ) then + write(iulog,*)'WARNING: snow balance error ' + write(iulog,*)'nstep= ',nstep, & + ' local indexc= ',indexc, & + ! ' global indexc= ',GetGlobalIndex(decomp_index=indexc, clmlevel=namec), & + ' col%itype= ',col%itype(indexc), & + ' lun%itype= ',lun%itype(col%landunit(indexc)), & + ' errh2osno= ',errh2osno(indexc) + + if (abs(errh2osno(indexc)) > 1.e-5_r8 .and. (nstep > 2) ) then + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errh2osno = ',errh2osno(indexc) + write(iulog,*)'snl = ',col%snl(indexc) + write(iulog,*)'h2osno = ',h2osno(indexc) + write(iulog,*)'h2osno_old = ',h2osno_old(indexc) + write(iulog,*)'snow_sources = ',snow_sources(indexc) + write(iulog,*)'snow_sinks = ',snow_sinks(indexc) + write(iulog,*)'qflx_prec_grnd = ',qflx_prec_grnd(indexc)*dtime + write(iulog,*)'qflx_sub_snow = ',qflx_sub_snow(indexc)*dtime + write(iulog,*)'qflx_evap_grnd = ',qflx_evap_grnd(indexc)*dtime + write(iulog,*)'qflx_top_soil = ',qflx_top_soil(indexc)*dtime + write(iulog,*)'qflx_dew_snow = ',qflx_dew_snow(indexc)*dtime + write(iulog,*)'qflx_dew_grnd = ',qflx_dew_grnd(indexc)*dtime + write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc)*dtime + write(iulog,*)'qflx_snwcp_liq = ',qflx_snwcp_liq(indexc)*dtime + write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime + if (create_glacier_mec_landunit) then + write(iulog,*)'qflx_glcice_frz = ',qflx_glcice_frz(indexc)*dtime + end if + write(iulog,*)'clm model is stopping' + + call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Energy balance checks + + do p = bounds%begp, bounds%endp + if (patch%active(p)) then + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + ! Solar radiation energy balance + ! Do not do this check for an urban patch since it will not balance on a per-column + ! level because of interactions between columns and since a separate check is done + ! in the urban radiation module + if (.not. lun%urbpoi(l)) then + errsol(p) = fsa(p) + fsr(p) & + - (forc_solad(g,1) + forc_solad(g,2) + forc_solai(g,1) + forc_solai(g,2)) + else + errsol(p) = spval + end if + + ! Longwave radiation energy balance + ! Do not do this check for an urban patch since it will not balance on a per-column + ! level because of interactions between columns and since a separate check is done + ! in the urban radiation module + if (.not. lun%urbpoi(l)) then + errlon(p) = eflx_lwrad_out(p) - eflx_lwrad_net(p) - forc_lwrad(c) + else + errlon(p) = spval + end if + + ! Surface energy balance + ! Changed to using (eflx_lwrad_net) here instead of (forc_lwrad - eflx_lwrad_out) because + ! there are longwave interactions between urban columns (and therefore patches). + ! For surfaces other than urban, (eflx_lwrad_net) equals (forc_lwrad - eflx_lwrad_out), + ! and a separate check is done above for these terms. + + if (.not. lun%urbpoi(l)) then + errseb(p) = sabv(p) + sabg_chk(p) + forc_lwrad(c) - eflx_lwrad_out(p) & + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) + else + errseb(p) = sabv(p) + sabg(p) & + - eflx_lwrad_net(p) & + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) & + + eflx_wasteheat_patch(p) + eflx_heat_from_ac_patch(p) + eflx_traffic_patch(p) + end if + !TODO MV - move this calculation to a better place - does not belong in BalanceCheck + netrad(p) = fsa(p) - eflx_lwrad_net(p) + end if + end do + + ! Solar radiation energy balance check + + found = .false. + do p = bounds%begp, bounds%endp + if (patch%active(p)) then + if ( (errsol(p) /= spval) .and. (abs(errsol(p)) > 1.e-7_r8) ) then + found = .true. + indexp = p + indexg = patch%gridcell(indexp) + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,*)'WARNING:: BalanceCheck, solar radiation balance error (W/m2)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errsol = ',errsol(indexp) + if (abs(errsol(indexp)) > 1.e-5_r8 ) then + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'fsa = ',fsa(indexp) + write(iulog,*)'fsr = ',fsr(indexp) + write(iulog,*)'forc_solad(1) = ',forc_solad(indexg,1) + write(iulog,*)'forc_solad(2) = ',forc_solad(indexg,2) + write(iulog,*)'forc_solai(1) = ',forc_solai(indexg,1) + write(iulog,*)'forc_solai(2) = ',forc_solai(indexg,2) + write(iulog,*)'forc_tot = ',forc_solad(indexg,1)+forc_solad(indexg,2) & + +forc_solai(indexg,1)+forc_solai(indexg,2) + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Longwave radiation energy balance check + + found = .false. + do p = bounds%begp, bounds%endp + if (patch%active(p)) then + if ( (errlon(p) /= spval) .and. (abs(errlon(p)) > 1.e-7_r8) ) then + found = .true. + indexp = p + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,*)'WARNING: BalanceCheck: longwave energy balance error (W/m2)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errlon = ',errlon(indexp) + if (abs(errlon(indexp)) > 1.e-5_r8 ) then + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Surface energy balance check + + found = .false. + do p = bounds%begp, bounds%endp + if (patch%active(p)) then + if (abs(errseb(p)) > 1.e-7_r8 ) then + found = .true. + indexp = p + indexc = patch%column(indexp) + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,*)'WARNING: BalanceCheck: surface flux energy balance error (W/m2)' + write(iulog,*)'nstep = ' ,nstep + write(iulog,*)'errseb = ' ,errseb(indexp) + if (abs(errseb(indexp)) > 1.e-5_r8 ) then + write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'sabv = ' ,sabv(indexp) + + write(iulog,*)'sabg = ' ,sabg(indexp), ((1._r8- frac_sno(indexc))*sabg_soil(indexp) + & + frac_sno(indexc)*sabg_snow(indexp)),sabg_chk(indexp) + + write(iulog,*)'forc_tot = ' ,forc_solad(indexg,1) + forc_solad(indexg,2) + & + forc_solai(indexg,1) + forc_solai(indexg,2) + + write(iulog,*)'eflx_lwrad_net = ' ,eflx_lwrad_net(indexp) + write(iulog,*)'eflx_sh_tot = ' ,eflx_sh_tot(indexp) + write(iulog,*)'eflx_lh_tot = ' ,eflx_lh_tot(indexp) + write(iulog,*)'eflx_soil_grnd = ' ,eflx_soil_grnd(indexp) + write(iulog,*)'fsa fsr = ' ,fsa(indexp), fsr(indexp) + write(iulog,*)'fabd fabi = ' ,fabd(indexp,:), fabi(indexp,:) + write(iulog,*)'albd albi = ' ,albd(indexp,:), albi(indexp,:) + write(iulog,*)'ftii ftdd ftid = ' ,ftii(indexp,:), ftdd(indexp,:),ftid(indexp,:) + write(iulog,*)'elai esai = ' ,elai(indexp), esai(indexp) + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Soil energy balance check + + found = .false. + do c = bounds%begc,bounds%endc + if (col%active(c)) then + if (abs(errsoi_col(c)) > 1.0e-6_r8 ) then + found = .true. + indexc = c + end if + end if + end do + if ( found ) then + write(iulog,*)'WARNING: BalanceCheck: soil balance error (W/m2)' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errsoi_col = ',errsoi_col(indexc) + if (abs(errsoi_col(indexc)) > 1.e-4_r8 .and. (nstep > 2) ) then + write(iulog,*)'clm model is stopping' + call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + end associate + + end subroutine BalanceCheck + +end module BalanceCheckMod diff --git a/components/clm/src/biogeophys/BandDiagonalMod.F90 b/components/clm/src/biogeophys/BandDiagonalMod.F90 new file mode 100644 index 0000000000..bd819ef41d --- /dev/null +++ b/components/clm/src/biogeophys/BandDiagonalMod.F90 @@ -0,0 +1,221 @@ +module BandDiagonalMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Band Diagonal matrix solution + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: BandDiagonal + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine BandDiagonal(bounds, lbj, ubj, jtop, jbot, numf, filter, nband, b, r, u) + ! + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col] + integer , intent(in) :: jbot( bounds%begc: ) ! bottom level for each column [col] + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: nband ! band width + integer , intent(in) :: filter(:) ! filter + real(r8), intent(in) :: b( bounds%begc: , 1: , lbj: ) ! compact band matrix [col, nband, j] + real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" rhs of linear system [col, j] + real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j] + ! + ! ! LOCAL VARIABLES: + integer :: j,ci,fc,info,m,n !indices + integer :: kl,ku !number of sub/super diagonals + integer, allocatable :: ipiv(:) !temporary + real(r8),allocatable :: ab(:,:),temp(:,:) !compact storage array + real(r8),allocatable :: result(:) + + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(jbot) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(b) == (/bounds%endc, nband, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(r) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(u) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + + +!!$ SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) +!!$* +!!$* -- LAPACK driver routine (version 3.1) -- +!!$* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +!!$* November 2006 +!!$* +!!$* .. Scalar Arguments .. +!!$ INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS +!!$* .. +!!$* .. Array Arguments .. +!!$ INTEGER IPIV( * ) +!!$ REAL AB( LDAB, * ), B( LDB, * ) +!!$* .. +!!$* +!!$* Purpose +!!$* ======= +!!$* +!!$* SGBSV computes the solution to a real system of linear equations +!!$* A * X = B, where A is a band matrix of order N with KL subdiagonals +!!$* and KU superdiagonals, and X and B are N-by-NRHS matrices. +!!$* +!!$* The LU decomposition with partial pivoting and row interchanges is +!!$* used to factor A as A = L * U, where L is a product of permutation +!!$* and unit lower triangular matrices with KL subdiagonals, and U is +!!$* upper triangular with KL+KU superdiagonals. The factored form of A +!!$* is then used to solve the system of equations A * X = B. +!!$* +!!$* Arguments +!!$* ========= +!!$* +!!$* N (input) INTEGER +!!$* The number of linear equations, i.e., the order of the +!!$* matrix A. N >= 0. +!!$* +!!$* KL (input) INTEGER +!!$* The number of subdiagonals within the band of A. KL >= 0. +!!$* +!!$* KU (input) INTEGER +!!$* The number of superdiagonals within the band of A. KU >= 0. +!!$* +!!$* NRHS (input) INTEGER +!!$* The number of right hand sides, i.e., the number of columns +!!$* of the matrix B. NRHS >= 0. +!!$* +!!$* AB (input/output) REAL array, dimension (LDAB,N) +!!$* On entry, the matrix A in band storage, in rows KL+1 to +!!$* 2*KL+KU+1; rows 1 to KL of the array need not be set. +!!$* The j-th column of A is stored in the j-th column of the +!!$* array AB as follows: +!!$* AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL) +!!$* On exit, details of the factorization: U is stored as an +!!$* upper triangular band matrix with KL+KU superdiagonals in +!!$* rows 1 to KL+KU+1, and the multipliers used during the +!!$* factorization are stored in rows KL+KU+2 to 2*KL+KU+1. +!!$* See below for further details. +!!$* +!!$* LDAB (input) INTEGER +!!$* The leading dimension of the array AB. LDAB >= 2*KL+KU+1. +!!$* +!!$* IPIV (output) INTEGER array, dimension (N) +!!$* The pivot indices that define the permutation matrix P; +!!$* row i of the matrix was interchanged with row IPIV(i). +!!$* +!!$* B (input/output) REAL array, dimension (LDB,NRHS) +!!$* On entry, the N-by-NRHS right hand side matrix B. +!!$* On exit, if INFO = 0, the N-by-NRHS solution matrix X. +!!$* +!!$* LDB (input) INTEGER +!!$* The leading dimension of the array B. LDB >= max(1,N). +!!$* +!!$* INFO (output) INTEGER +!!$* = 0: successful exit +!!$* < 0: if INFO = -i, the i-th argument had an illegal value +!!$* > 0: if INFO = i, U(i,i) is exactly zero. The factorization +!!$* has been completed, but the factor U is exactly +!!$* singular, and the solution has not been computed. +!!$* +!!$* Further Details +!!$* =============== +!!$* +!!$* The band storage scheme is illustrated by the following example, when +!!$* M = N = 6, KL = 2, KU = 1: +!!$* +!!$* On entry: On exit: +!!$* +!!$* * * * + + + * * * u14 u25 u36 +!!$* * * + + + + * * u13 u24 u35 u46 +!!$* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56 +!!$* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66 +!!$* a21 a32 a43 a54 a65 * m21 m32 m43 m54 m65 * +!!$* a31 a42 a53 a64 * * m31 m42 m53 m64 * * +!!$* +!!$* Array elements marked * are not used by the routine; elements marked +!!$* + need not be set on entry, but are required by the routine to store +!!$* elements of U because of fill-in resulting from the row interchanges. + + +!Set up input matrix AB +!An m-by-n band matrix with kl subdiagonals and ku superdiagonals +!may be stored compactly in a two-dimensional array with +!kl+ku+1 rows and n columns +!AB(KL+KU+1+i-j,j) = A(i,j) + + do fc = 1,numf + ci = filter(fc) + + kl=(nband-1)/2 + ku=kl +! m is the number of rows required for storage space by dgbsv + m=2*kl+ku+1 +! n is the number of levels (snow/soil) +!scs: replace ubj with jbot + n=jbot(ci)-jtop(ci)+1 + + allocate(ab(m,n)) + ab=0.0 + + ab(kl+ku-1,3:n)=b(ci,1,jtop(ci):jbot(ci)-2) ! 2nd superdiagonal + ab(kl+ku+0,2:n)=b(ci,2,jtop(ci):jbot(ci)-1) ! 1st superdiagonal + ab(kl+ku+1,1:n)=b(ci,3,jtop(ci):jbot(ci)) ! diagonal + ab(kl+ku+2,1:n-1)=b(ci,4,jtop(ci)+1:jbot(ci)) ! 1st subdiagonal + ab(kl+ku+3,1:n-2)=b(ci,5,jtop(ci)+2:jbot(ci)) ! 2nd subdiagonal + + allocate(temp(m,n)) + temp=ab + + allocate(ipiv(n)) + allocate(result(n)) + +! on input result is rhs, on output result is solution vector + result(:)=r(ci,jtop(ci):jbot(ci)) + +! DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) + call dgbsv( n, kl, ku, 1, ab, m, ipiv, result, n, info ) + u(ci,jtop(ci):jbot(ci))=result(:) + + if(info /= 0) then + write(iulog,*)'index: ', ci + write(iulog,*)'n,kl,ku,m ',n,kl,ku,m + write(iulog,*)'dgbsv info: ',ci,info + + write(iulog,*) '' + write(iulog,*) 'ab matrix' + do j=1,n + ! write(iulog,'(i2,7f18.7)') j,temp(:,j) + write(iulog,'(i2,5f18.7)') j,temp(3:7,j) + enddo + write(iulog,*) '' + stop + endif + deallocate(temp) + + deallocate(ab) + deallocate(ipiv) + deallocate(result) + end do + + end subroutine BandDiagonal + +end module BandDiagonalMod diff --git a/components/clm/src/biogeophys/BareGroundFluxesMod.F90 b/components/clm/src/biogeophys/BareGroundFluxesMod.F90 new file mode 100644 index 0000000000..483bcee81e --- /dev/null +++ b/components/clm/src/biogeophys/BareGroundFluxesMod.F90 @@ -0,0 +1,424 @@ +module BareGroundFluxesMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Compute sensible and latent fluxes and their derivatives with respect + ! to ground temperature using ground temperatures from previous time step. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use ch4Mod , only : ch4_type + use atm2lndType , only : atm2lnd_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use PhotosynthesisMod , only : photosyns_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use HumanIndexMod , only : humanindex_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: BareGroundFluxes ! Calculate sensible and latent heat fluxes + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & + atm2lnd_inst, soilstate_inst, & + frictionvel_inst, ch4_inst, energyflux_inst, temperature_inst, & + waterflux_inst, waterstate_inst, photosyns_inst, humanindex_inst) + ! + ! !DESCRIPTION: + ! Compute sensible and latent fluxes and their derivatives with respect + ! to ground temperature using ground temperatures from previous time step. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_RGAS + use clm_varpar , only : nlevgrnd + use clm_varcon , only : cpair, vkc, grav, denice, denh2o + use clm_varctl , only : use_lch4 + use landunit_varcon , only : istsoil, istcrop + use FrictionVelocityMod , only : FrictionVelocity, MoninObukIni + use QSatMod , only : QSat + use SurfaceResistanceMod , only : do_soilevap_beta + use HumanIndexMod , only : calc_human_stress_indices, Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & + swbgt, hmdex, dis_coi, dis_coiS, THIndex, & + SwampCoolEff, KtoC, VaporPres + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + 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) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + type(ch4_type) , intent(inout) :: ch4_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(humanindex_type) , intent(inout) :: humanindex_inst + ! + ! !LOCAL VARIABLES: + integer, parameter :: niters = 3 ! maximum number of iterations for surface temperature + integer :: p,c,g,f,j,l ! indices + integer :: iter ! iteration index + real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] + real(r8) :: displa(bounds%begp:bounds%endp) ! displacement height [m] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface + real(r8) :: obu(bounds%begp:bounds%endp) ! Monin-Obukhov length (m) + real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] + real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] + real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile + real(r8) :: temp12m(bounds%begp:bounds%endp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(bounds%begp:bounds%endp) ! relation for specific humidity profile + real(r8) :: temp22m(bounds%begp:bounds%endp) ! relation for specific humidity profile applied at 2-m + real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: cf_bare ! heat transfer coefficient from bare ground [-] + real(r8) :: ram ! aerodynamical resistance [s/m] + real(r8) :: rah ! thermal resistance [s/m] + real(r8) :: raw ! moisture resistance [s/m] + real(r8) :: raih ! temporary variable [kg/m2/s] + real(r8) :: raiw ! temporary variable [kg/m2/s] + real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: z0mg_patch(bounds%begp:bounds%endp) + real(r8) :: z0hg_patch(bounds%begp:bounds%endp) + real(r8) :: z0qg_patch(bounds%begp:bounds%endp) + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + real(r8) :: www ! surface soil wetness [-] + !------------------------------------------------------------------------------ + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zii => col%zii , & ! Input: [real(r8) (:) ] convective boundary height [m] + + tc_ref2m => humanindex_inst%tc_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (C) + vap_ref2m => humanindex_inst%vap_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height vapor pressure (Pa) + appar_temp_ref2m => humanindex_inst%appar_temp_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m apparent temperature (C) + appar_temp_ref2m_r => humanindex_inst%appar_temp_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m apparent temperature (C) + swbgt_ref2m => humanindex_inst%swbgt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Simplified Wetbulb Globe temperature (C) + swbgt_ref2m_r => humanindex_inst%swbgt_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Simplified Wetbulb Globe temperature (C) + humidex_ref2m => humanindex_inst%humidex_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Humidex (C) + humidex_ref2m_r => humanindex_inst%humidex_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Humidex (C) + wbt_ref2m => humanindex_inst%wbt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Stull Wet Bulb temperature (C) + wbt_ref2m_r => humanindex_inst%wbt_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Stull Wet Bulb temperature (C) + wb_ref2m => humanindex_inst%wb_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Wet Bulb temperature (C) + wb_ref2m_r => humanindex_inst%wb_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Wet Bulb temperature (C) + teq_ref2m => humanindex_inst%teq_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent temperature (K) + teq_ref2m_r => humanindex_inst%teq_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Equivalent temperature (K) + ept_ref2m => humanindex_inst%ept_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent Potential temperature (K) + ept_ref2m_r => humanindex_inst%ept_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height Equivalent Potential temperature (K) + discomf_index_ref2m => humanindex_inst%discomf_index_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Discomfort Index temperature (C) + discomf_index_ref2m_r => humanindex_inst%discomf_index_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Discomfort Index temperature (C) + discomf_index_ref2mS => humanindex_inst%discomf_index_ref2mS_patch , & ! Output: [real(r8) (:) ] 2 m height Discomfort Index Stull temperature (C) + discomf_index_ref2mS_r => humanindex_inst%discomf_index_ref2mS_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Discomfort Index Stull temperature (K) + nws_hi_ref2m => humanindex_inst%nws_hi_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m NWS Heat Index (C) + nws_hi_ref2m_r => humanindex_inst%nws_hi_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m NWS Heat Index (C) + thip_ref2m => humanindex_inst%thip_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Physiology (C) + thip_ref2m_r => humanindex_inst%thip_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Temperature Humidity Index Physiology (C) + thic_ref2m => humanindex_inst%thic_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Comfort (C) + thic_ref2m_r => humanindex_inst%thic_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Temperature Humidity Index Comfort (C) + swmp65_ref2m => humanindex_inst%swmp65_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 65% effi (C) + swmp65_ref2m_r => humanindex_inst%swmp65_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Swamp Cooler temperature 65% effi (C) + swmp80_ref2m => humanindex_inst%swmp80_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 80% effi (C) + swmp80_ref2m_r => humanindex_inst%swmp80_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Swamp Cooler temperature 80% effi (C) + + forc_u => atm2lnd_inst%forc_u_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in east direction (m/s) + forc_v => atm2lnd_inst%forc_v_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in north direction (m/s) + forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + soilbeta => soilstate_inst%soilbeta_col , & ! Input: [real(r8) (:) ] soil wetness relative to field capacity + rootr => soilstate_inst%rootr_patch , & ! Output: [real(r8) (:,:) ] effective fraction of roots in each soil layer + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] + thv => temperature_inst%thv_col , & ! Input: [real(r8) (:) ] virtual potential temperature (kelvin) + thm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + beta => temperature_inst%beta_col , & ! Input: [real(r8) (:) ] coefficient of conective velocity [-] + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + qg_snow => waterstate_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_soil => waterstate_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] + qg_h2osfc => waterstate_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + qg => waterstate_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] + dqgdT => waterstate_inst%dqgdT_col , & ! Input: [real(r8) (:) ] temperature derivative of "qg" + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + grnd_ch4_cond => ch4_inst%grnd_ch4_cond_patch , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] + + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] + eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) + tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) + dlrad => energyflux_inst%dlrad_patch , & ! Output: [real(r8) (:) ] downward longwave radiation below the canopy [W/m2] + ulrad => energyflux_inst%ulrad_patch , & ! Output: [real(r8) (:) ] upward longwave radiation above the canopy [W/m2] + cgrnds => energyflux_inst%cgrnds_patch , & ! Output: [real(r8) (:) ] deriv, of soil sensible heat flux wrt soil temp [w/m2/k] + cgrndl => energyflux_inst%cgrndl_patch , & ! Output: [real(r8) (:) ] deriv of soil latent heat flux wrt soil temp [w/m**2/k] + cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] + btran => energyflux_inst%btran_patch , & ! Output: [real(r8) (:) ] transpiration wetness factor (0 to 1) + rresis => energyflux_inst%rresis_patch , & ! Output: [real(r8) (:,:) ] root resistance by layer (0-1) (nlevgrnd) + + t_ref2m => temperature_inst%t_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (Kelvin) + t_ref2m_r => temperature_inst%t_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height surface air temperature (Kelvin) + t_veg => temperature_inst%t_veg_patch , & ! Output: [real(r8) (:) ] vegetation temperature (Kelvin) + + q_ref2m => waterstate_inst%q_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface specific humidity (kg/kg) + rh_ref2m_r => waterstate_inst%rh_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height surface relative humidity (%) + rh_ref2m => waterstate_inst%rh_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) + + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: + u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) + z0mg_col => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length, momentum [m] + z0hg_col => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length, sensible heat [m] + z0qg_col => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length, latent heat [m] + ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] + qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (W/m**2) [+ to atm] + qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + + rssun => photosyns_inst%rssun_patch , & ! Output: [real(r8) (:) ] leaf sunlit stomatal resistance (s/m) (output from Photosynthesis) + rssha => photosyns_inst%rssha_patch , & ! Output: [real(r8) (:) ] leaf shaded stomatal resistance (s/m) (output from Photosynthesis) + + begp => bounds%begp , & + endp => bounds%endp & + ) + + ! First do some simple settings of values over points where frac vegetation covered + ! by snow is zero + + do f = 1, num_noexposedvegp + p = filter_noexposedvegp(f) + c = patch%column(p) + btran(p) = 0._r8 + t_veg(p) = forc_t(c) + cf_bare = forc_pbot(c)/(SHR_CONST_RGAS*0.001_r8*thm(p))*1.e06_r8 + rssun(p) = 1._r8/1.e15_r8 * cf_bare + rssha(p) = 1._r8/1.e15_r8 * cf_bare + do j = 1, nlevgrnd + rootr(p,j) = 0._r8 + rresis(p,j) = 0._r8 + end do + end do + + ! Compute sensible and latent fluxes and their derivatives with respect + ! to ground temperature using ground temperatures from previous time step + + do f = 1, num_noexposedvegp + p = filter_noexposedvegp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Initialization variables + + displa(p) = 0._r8 + dlrad(p) = 0._r8 + ulrad(p) = 0._r8 + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-t_grnd(c) + dqh(p) = forc_q(c) - qg(c) + dthv = dth(p)*(1._r8+0.61_r8*forc_q(c))+0.61_r8*forc_th(c)*dqh(p) + zldis(p) = forc_hgt_u_patch(p) + + ! Copy column roughness to local patch-level arrays + + z0mg_patch(p) = z0mg_col(c) + z0hg_patch(p) = z0hg_col(c) + z0qg_patch(p) = z0qg_col(c) + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_patch(p), um(p), obu(p)) + + end do + + ! Perform stability iteration + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + do iter = 1, niters + + call FrictionVelocity(begp, endp, num_noexposedvegp, filter_noexposedvegp, & + displa(begp:endp), z0mg_patch(begp:endp), z0hg_patch(begp:endp), z0qg_patch(begp:endp), & + obu(begp:endp), iter, ur(begp:endp), um(begp:endp), ustar(begp:endp), & + temp1(begp:endp), temp2(begp:endp), temp12m(begp:endp), temp22m(begp:endp), fm(begp:endp), & + frictionvel_inst) + + do f = 1, num_noexposedvegp + p = filter_noexposedvegp(f) + c = patch%column(p) + g = patch%gridcell(p) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + z0hg_patch(p) = z0mg_patch(p)/exp(0.13_r8 * (ustar(p)*z0mg_patch(p)/1.5e-5_r8)**0.45_r8) + z0qg_patch(p) = z0hg_patch(p) + thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar + zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta(c)*(-grav*ustar(p)*thvstar*zii(c)/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p) + wc*wc) + end if + obu(p) = zldis(p)/zeta + end do + + end do ! end stability iteration + + do f = 1, num_noexposedvegp + p = filter_noexposedvegp(f) + c = patch%column(p) + g = patch%gridcell(p) + l = patch%landunit(p) + + ! Determine aerodynamic resistances + + ram = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah = 1._r8/(temp1(p)*ustar(p)) + raw = 1._r8/(temp2(p)*ustar(p)) + raih = forc_rho(c)*cpair/rah + if (use_lch4) then + grnd_ch4_cond(p) = 1._r8/raw + end if + + ! Soil evaporation resistance + www = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1)/watsat(c,1) + www = min(max(www,0.0_r8),1._r8) + + !changed by K.Sakaguchi. Soilbeta is used for evaporation + if (dqh(p) > 0._r8) then !dew (beta is not applied, just like rsoil used to be) + raiw = forc_rho(c)/(raw) + else + if(do_soilevap_beta())then + ! Lee and Pielke 1992 beta is applied + raiw = soilbeta(c)*forc_rho(c)/(raw) + endif + end if + + ram1(p) = ram !pass value to global variable + + ! Output to patch-level data structures + ! Derivative of fluxes with respect to ground temperature + cgrnds(p) = raih + cgrndl(p) = raiw*dqgdT(c) + cgrnd(p) = cgrnds(p) + htvp(c)*cgrndl(p) + + + ! Variables needed by history tape + + ! Surface fluxes of momentum, sensible and latent heat + ! using ground temperatures from previous time step + taux(p) = -forc_rho(c)*forc_u(g)/ram + tauy(p) = -forc_rho(c)*forc_v(g)/ram + eflx_sh_grnd(p) = -raih*dth(p) + eflx_sh_tot(p) = eflx_sh_grnd(p) + + ! compute sensible heat fluxes individually + eflx_sh_snow(p) = -raih*(thm(p)-t_soisno(c,snl(c)+1)) + eflx_sh_soil(p) = -raih*(thm(p)-t_soisno(c,1)) + eflx_sh_h2osfc(p) = -raih*(thm(p)-t_h2osfc(c)) + + ! water fluxes from soil + qflx_evap_soi(p) = -raiw*dqh(p) + qflx_evap_tot(p) = qflx_evap_soi(p) + + ! compute latent heat fluxes individually + qflx_ev_snow(p) = -raiw*(forc_q(c) - qg_snow(c)) + qflx_ev_soil(p) = -raiw*(forc_q(c) - qg_soil(c)) + qflx_ev_h2osfc(p) = -raiw*(forc_q(c) - qg_h2osfc(c)) + + ! 2 m height air temperature + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + + ! 2 m height specific humidity + q_ref2m(p) = forc_q(c) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + call QSat(t_ref2m(p), forc_pbot(c), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + rh_ref2m_r(p) = rh_ref2m(p) + t_ref2m_r(p) = t_ref2m(p) + end if + + ! Human Heat Stress + if ( calc_human_stress_indices )then + call KtoC(t_ref2m(p), tc_ref2m(p)) + call VaporPres(rh_ref2m(p), e_ref2m, vap_ref2m(p)) + call Wet_Bulb(t_ref2m(p), vap_ref2m(p), forc_pbot(c), rh_ref2m(p), q_ref2m(p), & + teq_ref2m(p), ept_ref2m(p), wb_ref2m(p)) + call Wet_BulbS(tc_ref2m(p),rh_ref2m(p), wbt_ref2m(p)) + call HeatIndex(tc_ref2m(p), rh_ref2m(p), nws_hi_ref2m(p)) + call AppTemp(tc_ref2m(p), vap_ref2m(p), u10_clm(p), appar_temp_ref2m(p)) + call swbgt(tc_ref2m(p), vap_ref2m(p), swbgt_ref2m(p)) + call hmdex(tc_ref2m(p), vap_ref2m(p), humidex_ref2m(p)) + call dis_coi(tc_ref2m(p), wb_ref2m(p), discomf_index_ref2m(p)) + call dis_coiS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p), discomf_index_ref2mS(p)) + call THIndex(tc_ref2m(p), wb_ref2m(p), thic_ref2m(p), thip_ref2m(p)) + call SwampCoolEff(tc_ref2m(p), wb_ref2m(p), swmp80_ref2m(p), swmp65_ref2m(p)) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + teq_ref2m_r(p) = teq_ref2m(p) + ept_ref2m_r(p) = ept_ref2m(p) + wb_ref2m_r(p) = wb_ref2m(p) + wbt_ref2m_r(p) = wbt_ref2m(p) + nws_hi_ref2m_r(p) = nws_hi_ref2m(p) + appar_temp_ref2m_r(p) = appar_temp_ref2m(p) + swbgt_ref2m_r(p) = swbgt_ref2m(p) + humidex_ref2m_r(p) = humidex_ref2m(p) + discomf_index_ref2m_r(p) = discomf_index_ref2m(p) + discomf_index_ref2mS_r(p) = discomf_index_ref2mS(p) + thic_ref2m_r(p) = thic_ref2m(p) + thip_ref2m_r(p) = thip_ref2m(p) + swmp80_ref2m_r(p) = swmp80_ref2m(p) + swmp65_ref2m_r(p) = swmp65_ref2m(p) + end if + end if + end do + + end associate + + end subroutine BareGroundFluxes + +end module BareGroundFluxesMod diff --git a/components/clm/src/biogeophys/CMakeLists.txt b/components/clm/src/biogeophys/CMakeLists.txt new file mode 100644 index 0000000000..597a43ee68 --- /dev/null +++ b/components/clm/src/biogeophys/CMakeLists.txt @@ -0,0 +1,21 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources + AerosolMod.F90 + DaylengthMod.F90 + HumanIndexMod.F90 + IrrigationMod.F90 + LakeCon.F90 + QSatMod.F90 + RootBiophysMod.F90 + SnowHydrologyMod.F90 + SnowSnicarMod.F90 + SoilStateType.F90 + SoilWaterRetentionCurveMod.F90 + TemperatureType.F90 + WaterfluxType.F90 + WaterStateType.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/biogeophys/CanopyFluxesMod.F90 b/components/clm/src/biogeophys/CanopyFluxesMod.F90 new file mode 100644 index 0000000000..c30e511350 --- /dev/null +++ b/components/clm/src/biogeophys/CanopyFluxesMod.F90 @@ -0,0 +1,1271 @@ +module CanopyFluxesMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Performs calculation of leaf temperature and surface fluxes. + ! SoilFluxes then determines soil/snow and ground temperatures and updates the surface + ! fluxes for the new ground temperature. + ! + ! !USES: + use shr_sys_mod , only : shr_sys_flush + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : iulog, use_cn, use_lch4, use_c13, use_c14, use_cndv, use_ed, use_luna + use clm_varpar , only : nlevgrnd, nlevsno + use clm_varcon , only : namep + use pftconMod , only : nbrdlf_dcd_tmp_shrub, pftcon + use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean + use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + use decompMod , only : bounds_type + use PhotosynthesisMod , only : Photosynthesis, PhotosynthesisTotal, Fractionation + use EDPhotosynthesisMod , only : Photosynthesis_ED + use EDAccumulateFluxesMod , only : AccumulateFluxes_ED + use EDBtranMod , only : Btran_ED + use SoilMoistStressMod , only : calc_effective_soilporosity, calc_volumetric_h2oliq + use SoilMoistStressMod , only : calc_root_moist_stress, set_perchroot_opt + use SimpleMathMod , only : array_div_vector + use SurfaceResistanceMod , only : do_soilevap_beta + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use CNVegStateType , only : cnveg_state_type + use EnergyFluxType , only : energyflux_type + use FrictionvelocityMod , only : frictionvel_type + use OzoneBaseMod , only : ozone_base_type + use SoilStateType , only : soilstate_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use CanopyHydrologyMod , only : IsSnowvegFlagOn, IsSnowvegFlagOnRad + use HumanIndexMod , only : humanindex_type + use ch4Mod , only : ch4_type + use PhotosynthesisMod , only : photosyns_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + use EDTypesMod , only : ed_site_type + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + use LunaMod , only : Update_Photosynthesis_Capacity, Acc24_Climate_LUNA,Acc240_Climate_LUNA,Clear24_Climate_LUNA + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CanopyFluxes + ! + ! !PUBLIC DATA MEMBERS: + ! true => btran is based only on unfrozen soil levels + logical, public :: perchroot = .false. + + ! true => btran is based on active layer (defined over two years); + ! false => btran is based on currently unfrozen levels + logical, public :: perchroot_alt = .false. + ! + ! !PRIVATE DATA MEMBERS: + ! Snow in vegetation canopy namelist options. + logical, private :: snowveg_on = .false. ! snowveg_flag = 'ON' + logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, & + ed_allsites_inst, atm2lnd_inst, canopystate_inst, cnveg_state_inst, & + energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & + temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & + humanindex_inst, soil_water_retention_curve, cnveg_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! 1. Calculates the leaf temperature: + ! 2. Calculates the leaf fluxes, transpiration, photosynthesis and + ! updates the dew accumulation due to evaporation. + ! + ! Method: + ! Use the Newton-Raphson iteration to solve for the foliage + ! temperature that balances the surface energy budget: + ! + ! f(t_veg) = Net radiation - Sensible - Latent = 0 + ! f(t_veg) + d(f)/d(t_veg) * dt_veg = 0 (*) + ! + ! Note: + ! (1) In solving for t_veg, t_grnd is given from the previous timestep. + ! (2) The partial derivatives of aerodynamical resistances, which cannot + ! be determined analytically, are ignored for d(H)/dT and d(LE)/dT + ! (3) The weighted stomatal resistance of sunlit and shaded foliage is used + ! (4) Canopy air temperature and humidity are derived from => Hc + Hg = Ha + ! => Ec + Eg = Ea + ! (5) Energy loss is due to: numerical truncation of energy budget equation + ! (*); and "ecidif" (see the code) which is dropped into the sensible + ! heat + ! (6) The convergence criteria: the difference, del = t_veg(n+1)-t_veg(n) + ! and del2 = t_veg(n)-t_veg(n-1) less than 0.01 K, and the difference + ! of water flux from the leaf between the iteration step (n+1) and (n) + ! less than 0.1 W/m2; or the iterative steps over 40. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_RGAS + use clm_time_manager , only : get_step_size, get_prev_date,is_end_curr_day + use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice + use clm_varcon , only : denh2o, tfrz, csoilc, tlsai_crit, alpha_aero + use clm_varcon , only : c14ratio + use perf_mod , only : t_startf, t_stopf + use QSatMod , only : QSat + use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni + use HumanIndexMod , only : calc_human_stress_indices, Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & + swbgt, hmdex, dis_coi, dis_coiS, THIndex, & + SwampCoolEff, KtoC, VaporPres + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use CNVegNitrogenStateType, only : cnveg_nitrogenstate_type + ! + ! !ARGUMENTS: + 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 + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + class(ozone_base_type) , intent(inout) :: ozone_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(humanindex_type) , intent(inout) :: humanindex_inst + class(soil_water_retention_curve_type) , intent(in) :: soil_water_retention_curve + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: btran0 = 0.0_r8 ! initial value + real(r8), parameter :: zii = 1000.0_r8 ! convective boundary layer height [m] + real(r8), parameter :: beta = 1.0_r8 ! coefficient of conective velocity [-] + real(r8), parameter :: delmax = 1.0_r8 ! maxchange in leaf temperature [K] + real(r8), parameter :: dlemin = 0.1_r8 ! max limit for energy flux convergence [w/m2] + real(r8), parameter :: dtmin = 0.01_r8 ! max limit for temperature convergence [K] + integer , parameter :: itmax = 40 ! maximum number of iteration [-] + integer , parameter :: itmin = 2 ! minimum number of iteration [-] + + !added by K.Sakaguchi for litter resistance + real(r8), parameter :: lai_dl = 0.5_r8 ! placeholder for (dry) plant litter area index (m2/m2) + real(r8), parameter :: z_dl = 0.05_r8 ! placeholder for (dry) litter layer thickness (m) + + !added by K.Sakaguchi for stability formulation + real(r8), parameter :: ria = 0.5_r8 ! free parameter for stable formulation (currently = 0.5, "gamma" in Sakaguchi&Zeng,2008) + + real(r8) :: dtime ! land model time step (sec) + real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv(bounds%begp:bounds%endp) ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface + real(r8) :: obu(bounds%begp:bounds%endp) ! Monin-Obukhov length (m) + real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] + real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] + real(r8) :: uaf(bounds%begp:bounds%endp) ! velocity of air within foliage [m/s] + real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile + real(r8) :: temp12m(bounds%begp:bounds%endp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(bounds%begp:bounds%endp) ! relation for specific humidity profile + real(r8) :: temp22m(bounds%begp:bounds%endp) ! relation for specific humidity profile applied at 2-m + real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: taf(bounds%begp:bounds%endp) ! air temperature within canopy space [K] + real(r8) :: qaf(bounds%begp:bounds%endp) ! humidity of canopy air [kg/kg] + real(r8) :: rpp ! fraction of potential evaporation from leaf [-] + real(r8) :: rppdry ! fraction of potential evaporation through transp [-] + real(r8) :: cf ! heat transfer coefficient from leaves [-] + real(r8) :: rb(bounds%begp:bounds%endp) ! leaf boundary layer resistance [s/m] + real(r8) :: rah(bounds%begp:bounds%endp,2) ! thermal resistance [s/m] + real(r8) :: raw(bounds%begp:bounds%endp,2) ! moisture resistance [s/m] + real(r8) :: wta ! heat conductance for air [m/s] + real(r8) :: wtg(bounds%begp:bounds%endp) ! heat conductance for ground [m/s] + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: wta0(bounds%begp:bounds%endp) ! normalized heat conductance for air [-] + real(r8) :: wtl0(bounds%begp:bounds%endp) ! normalized heat conductance for leaf [-] + real(r8) :: wtg0 ! normalized heat conductance for ground [-] + real(r8) :: wtal(bounds%begp:bounds%endp) ! normalized heat conductance for air and leaf [-] + real(r8) :: wtga ! normalized heat cond. for air and ground [-] + real(r8) :: wtaq ! latent heat conductance for air [m/s] + real(r8) :: wtlq ! latent heat conductance for leaf [m/s] + real(r8) :: wtgq(bounds%begp:bounds%endp) ! latent heat conductance for ground [m/s] + real(r8) :: wtaq0(bounds%begp:bounds%endp) ! normalized latent heat conductance for air [-] + real(r8) :: wtlq0(bounds%begp:bounds%endp) ! normalized latent heat conductance for leaf [-] + real(r8) :: wtgq0 ! normalized heat conductance for ground [-] + real(r8) :: wtalq(bounds%begp:bounds%endp) ! normalized latent heat cond. for air and leaf [-] + real(r8) :: wtgaq ! normalized latent heat cond. for air and ground [-] + real(r8) :: el(bounds%begp:bounds%endp) ! vapor pressure on leaf surface [pa] + real(r8) :: deldT ! derivative of "el" on "t_veg" [pa/K] + real(r8) :: qsatl(bounds%begp:bounds%endp) ! leaf specific humidity [kg/kg] + real(r8) :: qsatldT(bounds%begp:bounds%endp) ! derivative of "qsatl" on "t_veg" + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + real(r8) :: air(bounds%begp:bounds%endp) ! atmos. radiation temporay set + real(r8) :: bir(bounds%begp:bounds%endp) ! atmos. radiation temporay set + real(r8) :: cir(bounds%begp:bounds%endp) ! atmos. radiation temporay set + real(r8) :: dc1,dc2 ! derivative of energy flux [W/m2/K] + real(r8) :: delt ! temporary + real(r8) :: delq(bounds%begp:bounds%endp) ! temporary + real(r8) :: del(bounds%begp:bounds%endp) ! absolute change in leaf temp in current iteration [K] + real(r8) :: del2(bounds%begp:bounds%endp) ! change in leaf temperature in previous iteration [K] + real(r8) :: dele(bounds%begp:bounds%endp) ! change in latent heat flux from leaf [K] + real(r8) :: dels ! change in leaf temperature in current iteration [K] + real(r8) :: det(bounds%begp:bounds%endp) ! maximum leaf temp. change in two consecutive iter [K] + real(r8) :: efeb(bounds%begp:bounds%endp) ! latent heat flux from leaf (previous iter) [mm/s] + real(r8) :: efeold ! latent heat flux from leaf (previous iter) [mm/s] + real(r8) :: efpot ! potential latent energy flux [kg/m2/s] + real(r8) :: efe(bounds%begp:bounds%endp) ! water flux from leaf [mm/s] + real(r8) :: efsh ! sensible heat from leaf [mm/s] + real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length from previous iteration + real(r8) :: tlbef(bounds%begp:bounds%endp) ! leaf temperature from previous iteration [K] + real(r8) :: ecidif ! excess energies [W/m2] + real(r8) :: err(bounds%begp:bounds%endp) ! balance error + real(r8) :: erre ! balance error + real(r8) :: co2(bounds%begp:bounds%endp) ! atmospheric co2 partial pressure (pa) + real(r8) :: c13o2(bounds%begp:bounds%endp) ! atmospheric c13o2 partial pressure (pa) + real(r8) :: o2(bounds%begp:bounds%endp) ! atmospheric o2 partial pressure (pa) + real(r8) :: svpts(bounds%begp:bounds%endp) ! saturation vapor pressure at t_veg (pa) + real(r8) :: eah(bounds%begp:bounds%endp) ! canopy air vapor pressure (pa) + real(r8) :: s_node ! vol_liq/eff_porosity + real(r8) :: smp_node ! matrix potential + real(r8) :: smp_node_lf ! F. Li and S. Levis + real(r8) :: vol_liq ! partial volume of liquid water in layer + integer :: itlef ! counter for leaf temperature iteration [-] + integer :: nmozsgn(bounds%begp:bounds%endp) ! number of times stability changes sign + real(r8) :: w ! exp(-LSAI) + real(r8) :: csoilcn ! interpolated csoilc for less than dense canopies + real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: wtshi ! sensible heat resistance for air, grnd and leaf [-] + real(r8) :: wtsqi ! latent heat resistance for air, grnd and leaf [-] + integer :: j ! soil/snow level index + integer :: p ! patch index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! gridcell index + integer :: fn ! number of values in vegetated patch filter + integer :: filterp(bounds%endp-bounds%begp+1) ! vegetated patch filter + integer :: fnorig ! number of values in patch filter copy + integer :: fporig(bounds%endp-bounds%begp+1) ! temporary filter + integer :: fnold ! temporary copy of patch count + integer :: f ! filter index + logical :: found ! error flag for canopy above forcing hgt + integer :: index ! patch index for error + real(r8) :: egvf ! effective green vegetation fraction + real(r8) :: lt ! elai+esai + real(r8) :: ri ! stability parameter for under canopy air (unitless) + real(r8) :: csoilb ! turbulent transfer coefficient over bare soil (unitless) + real(r8) :: ricsoilc ! modified transfer coefficient under dense canopy (unitless) + real(r8) :: snow_depth_c ! critical snow depth to cover plant litter (m) + real(r8) :: rdl ! dry litter layer resistance for water vapor (s/m) + real(r8) :: elai_dl ! exposed (dry) plant litter area index + real(r8) :: fsno_dl ! effective snow cover over plant litter + real(r8) :: dayl_factor(bounds%begp:bounds%endp) ! scalar (0-1) for daylength effect on Vcmax + ! If no unfrozen layers, put all in the top layer. + real(r8) :: rootsum(bounds%begp:bounds%endp) + real(r8) :: delt_snow + real(r8) :: delt_soil + real(r8) :: delt_h2osfc + real(r8) :: lw_grnd + real(r8) :: delq_snow + real(r8) :: delq_soil + real(r8) :: delq_h2osfc + real(r8) :: dt_veg(bounds%begp:bounds%endp) ! change in t_veg, last iteration (Kelvin) + integer :: jtop(bounds%begc:bounds%endc) ! lbning + integer :: filterc_tmp(bounds%endp-bounds%begp+1) ! temporary variable + integer :: ft ! plant functional type index + real(r8) :: temprootr + real(r8) :: dt_veg_temp(bounds%begp:bounds%endp) + integer :: iv + logical :: is_end_day ! is end of current day + + integer :: dummy_to_make_pgi_happy + !------------------------------------------------------------------------------ + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + max_dayl => grc%max_dayl , & ! Input: [real(r8) (:) ] maximum daylength for this grid cell (s) + + dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) + + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + forc_u => atm2lnd_inst%forc_u_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in east direction (m/s) + forc_v => atm2lnd_inst%forc_v_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in north direction (m/s) + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + forc_pc13o2 => atm2lnd_inst%forc_pc13o2_grc , & ! Input: [real(r8) (:) ] partial pressure c13o2 (Pa) + forc_po2 => atm2lnd_inst%forc_po2_grc , & ! Input: [real(r8) (:) ] partial pressure o2 (Pa) + + tc_ref2m => humanindex_inst%tc_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (C) + vap_ref2m => humanindex_inst%vap_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height vapor pressure (Pa) + appar_temp_ref2m => humanindex_inst%appar_temp_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m apparent temperature (C) + appar_temp_ref2m_r => humanindex_inst%appar_temp_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m apparent temperature (C) + swbgt_ref2m => humanindex_inst%swbgt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Simplified Wetbulb Globe temperature (C) + swbgt_ref2m_r => humanindex_inst%swbgt_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Simplified Wetbulb Globe temperature (C) + humidex_ref2m => humanindex_inst%humidex_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Humidex (C) + humidex_ref2m_r => humanindex_inst%humidex_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Humidex (C) + wbt_ref2m => humanindex_inst%wbt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Stull Wet Bulb temperature (C) + wbt_ref2m_r => humanindex_inst%wbt_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Stull Wet Bulb temperature (C) + wb_ref2m => humanindex_inst%wb_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Wet Bulb temperature (C) + wb_ref2m_r => humanindex_inst%wb_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Wet Bulb temperature (C) + teq_ref2m => humanindex_inst%teq_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent temperature (K) + teq_ref2m_r => humanindex_inst%teq_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Equivalent temperature (K) + ept_ref2m => humanindex_inst%ept_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent Potential temperature (K) + ept_ref2m_r => humanindex_inst%ept_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height Equivalent Potential temperature (K) + discomf_index_ref2m => humanindex_inst%discomf_index_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Discomfort Index temperature (C) + discomf_index_ref2m_r => humanindex_inst%discomf_index_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Discomfort Index temperature (C) + discomf_index_ref2mS => humanindex_inst%discomf_index_ref2mS_patch , & ! Output: [real(r8) (:) ] 2 m height Discomfort Index Stull temperature (C) + discomf_index_ref2mS_r => humanindex_inst%discomf_index_ref2mS_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Discomfort Index Stull temperature (K) + nws_hi_ref2m => humanindex_inst%nws_hi_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m NWS Heat Index (C) + nws_hi_ref2m_r => humanindex_inst%nws_hi_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m NWS Heat Index (C) + thip_ref2m => humanindex_inst%thip_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Physiology (C) + thip_ref2m_r => humanindex_inst%thip_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Temperature Humidity Index Physiology (C) + thic_ref2m => humanindex_inst%thic_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Comfort (C) + thic_ref2m_r => humanindex_inst%thic_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Temperature Humidity Index Comfort (C) + swmp65_ref2m => humanindex_inst%swmp65_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 65% effi (C) + swmp65_ref2m_r => humanindex_inst%swmp65_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Swamp Cooler temperature 65% effi (C) + swmp80_ref2m => humanindex_inst%swmp80_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 80% effi (C) + swmp80_ref2m_r => humanindex_inst%swmp80_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m Swamp Cooler temperature 80% effi (C) + + sabv => solarabs_inst%sabv_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + displa => canopystate_inst%displa_patch , & ! Input: [real(r8) (:) ] displacement height (m) + htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] canopy top(m) + altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col , & ! Input: [integer (:) ] prior year maximum annual depth of thaw + altmax_indx => canopystate_inst%altmax_indx_col , & ! Input: [integer (:) ] maximum annual depth of thaw + rscanopy => canopystate_inst%rscanopy_patch , & ! Output: [real(r8) (:,:)] canopy resistance s/m (ED) + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (constant) + watdry => soilstate_inst%watdry_col , & ! Input: [real(r8) (:,:) ] btran parameter for btran=0 (constant) + watopt => soilstate_inst%watopt_col , & ! Input: [real(r8) (:,:) ] btran parameter for btran=1 (constant) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Output: [real(r8) (:,:) ] effective soil porosity + soilbeta => soilstate_inst%soilbeta_col , & ! Input: [real(r8) (:) ] soil wetness relative to field capacity + rootr => soilstate_inst%rootr_patch , & ! Output: [real(r8) (:,:) ] effective fraction of roots in each soil layer + + u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch level [m] + z0mg => frictionvel_inst%z0mg_col , & ! Input: [real(r8) (:) ] roughness length of ground, momentum [m] + ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + z0mv => frictionvel_inst%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] + z0hv => frictionvel_inst%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] + z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] + rb1 => frictionvel_inst%rb1_patch , & ! Output: [real(r8) (:) ] boundary layer resistance (s/m) + + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] + thv => temperature_inst%thv_col , & ! Input: [real(r8) (:) ] virtual potential temperature (kelvin) + thm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + emv => temperature_inst%emv_patch , & ! Input: [real(r8) (:) ] vegetation emissivity + emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] vegetation emissivity + t_veg => temperature_inst%t_veg_patch , & ! Output: [real(r8) (:) ] vegetation temperature (Kelvin) + t_ref2m => temperature_inst%t_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (Kelvin) + t_ref2m_r => temperature_inst%t_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height surface air temperature (Kelvin) + + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of surface water + fwet => waterstate_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) + fdry => waterstate_inst%fdry_patch , & ! Input: [real(r8) (:) ] fraction of foliage that is green and dry [-] + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + qg_snow => waterstate_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_soil => waterstate_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] + qg_h2osfc => waterstate_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + qg => waterstate_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] + dqgdT => waterstate_inst%dqgdT_col , & ! Input: [real(r8) (:) ] temperature derivative of "qg" + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] by F. Li and S. Levis + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_liqvol => waterstate_inst%h2osoi_liqvol_col , & ! Output: [real(r8) (:,:) ] volumetric liquid water (v/v) + h2ocan => waterstate_inst%h2ocan_patch , & ! Output: [real(r8) (:) ] canopy water (mm H2O) + snocan => waterstate_inst%snocan_patch , & ! Output: [real(r8) (:) ] canopy snow (mm H2O) + liqcan => waterstate_inst%liqcan_patch , & ! Output: [real(r8) (:) ] canopy liquid (mm H2O) + snounload => waterstate_inst%snounload_patch , & ! Output: [real(r8) (:) ] canopy snow unloading mass (mm H2O) + + q_ref2m => waterstate_inst%q_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface specific humidity (kg/kg) + rh_ref2m_r => waterstate_inst%rh_ref2m_r_patch , & ! Output: [real(r8) (:) ] Rural 2 m height surface relative humidity (%) + rh_ref2m => waterstate_inst%rh_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) + rhaf => waterstate_inst%rh_af_patch , & ! Output: [real(r8) (:) ] fractional humidity of canopy air [dimensionless] + + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Output: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_evap_veg => waterflux_inst%qflx_evap_veg_patch , & ! Output: [real(r8) (:) ] vegetation evaporation (mm H2O/s) (+ = to atm) + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (W/m**2) [+ to atm] + qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + + rssun => photosyns_inst%rssun_patch , & ! Output: [real(r8) (:) ] leaf sunlit stomatal resistance (s/m) (output from Photosynthesis) + rssha => photosyns_inst%rssha_patch , & ! Output: [real(r8) (:) ] leaf shaded stomatal resistance (s/m) (output from Photosynthesis) + + grnd_ch4_cond => ch4_inst%grnd_ch4_cond_patch , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) [J/kg] (constant) + btran2 => energyflux_inst%btran2_patch , & ! Output: [real(r8) (:) ] F. Li and S. Levis + btran => energyflux_inst%btran_patch , & ! Output: [real(r8) (:) ] transpiration wetness factor (0 to 1) + rresis => energyflux_inst%rresis_patch , & ! Output: [real(r8) (:,:) ] root resistance by layer (0-1) (nlevgrnd) + taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) + tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) + canopy_cond => energyflux_inst%canopy_cond_patch , & ! Output: [real(r8) (:) ] tracer conductance for canopy [m/s] + cgrnds => energyflux_inst%cgrnds_patch , & ! Output: [real(r8) (:) ] deriv. of soil sensible heat flux wrt soil temp [w/m2/k] + cgrndl => energyflux_inst%cgrndl_patch , & ! Output: [real(r8) (:) ] deriv. of soil latent heat flux wrt soil temp [w/m**2/k] + dlrad => energyflux_inst%dlrad_patch , & ! Output: [real(r8) (:) ] downward longwave radiation below the canopy [W/m2] + ulrad => energyflux_inst%ulrad_patch , & ! Output: [real(r8) (:) ] upward longwave radiation above the canopy [W/m2] + cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + begp => bounds%begp , & + endp => bounds%endp , & + begg => bounds%begg , & + endg => bounds%endg & + ) + + ! Determine step size + + dtime = get_step_size() + is_end_day = is_end_curr_day() + + ! Make a local copy of the exposedvegp filter. With the current implementation, + ! this is needed because the filter is modified in the iteration loop. + ! + ! TODO(wjs, 2014-09-24) Determine if this is really needed. I suspect that we could + ! do away with either this temporary fn/filterp, or the temporary fnorig/fporig, + ! with one of these simply using the passed-in filter (num_exposedvegp / + ! filter_exposedvegp) + + fn = num_exposedvegp + filterp(1:fn) = filter_exposedvegp(1:fn) + + ! ----------------------------------------------------------------- + ! Time step initialization of photosynthesis variables + ! ----------------------------------------------------------------- + + call photosyns_inst%TimeStepInit(bounds) + + ! Initialize + + do f = 1, fn + p = filterp(f) + del(p) = 0._r8 ! change in leaf temperature from previous iteration + efeb(p) = 0._r8 ! latent head flux from leaf for previous iteration + wtlq0(p) = 0._r8 + wtalq(p) = 0._r8 + wtgq(p) = 0._r8 + wtaq0(p) = 0._r8 + obuold(p) = 0._r8 + btran(p) = btran0 + btran2(p) = btran0 + end do + + ! calculate daylength control for Vcmax + do f = 1, fn + p=filterp(f) + g=patch%gridcell(p) + ! calculate dayl_factor as the ratio of (current:max dayl)^2 + ! set a minimum of 0.01 (1%) for the dayl_factor + dayl_factor(p)=min(1._r8,max(0.01_r8,(dayl(g)*dayl(g))/(max_dayl(g)*max_dayl(g)))) + end do + + rb1(begp:endp) = 0._r8 + + ! FIX(FIX(SPM,032414),032414) refactor this... + if ( use_ed ) then + + do f = 1, fn + p = filterp(f) + call btran_ed(bounds, p, ed_allsites_inst(begg:endg), & + soilstate_inst, waterstate_inst, temperature_inst, energyflux_inst) + enddo + + else + + !assign the temporary filter + do f = 1, fn + p = filterp(f) + filterc_tmp(f)=patch%column(p) + enddo + + !compute effective soil porosity + call calc_effective_soilporosity(bounds, & + ubj = nlevgrnd, & + numf = fn, & + filter = filterc_tmp(1:fn), & + watsat = watsat(bounds%begc:bounds%endc, 1:nlevgrnd), & + h2osoi_ice = h2osoi_ice(bounds%begc:bounds%endc,1:nlevgrnd), & + denice = denice, & + eff_por=eff_porosity(bounds%begc:bounds%endc, 1:nlevgrnd) ) + + !compute volumetric liquid water content + jtop(bounds%begc:bounds%endc) = 1 + + call calc_volumetric_h2oliq(bounds, & + jtop = jtop(bounds%begc:bounds%endc), & + lbj = 1, & + ubj = nlevgrnd, & + numf = fn, & + filter = filterc_tmp(1:fn), & + eff_porosity = eff_porosity(bounds%begc:bounds%endc, 1:nlevgrnd), & + h2osoi_liq = h2osoi_liq(bounds%begc:bounds%endc, 1:nlevgrnd), & + denh2o = denh2o, & + vol_liq = h2osoi_liqvol(bounds%begc:bounds%endc, 1:nlevgrnd) ) + + !set up perchroot options + call set_perchroot_opt(perchroot, perchroot_alt) + + !calculate root moisture stress + call calc_root_moist_stress(bounds, & + nlevgrnd = nlevgrnd, & + fn = fn, & + filterp = filterp, & + canopystate_inst=canopystate_inst, & + energyflux_inst=energyflux_inst, & + soilstate_inst=soilstate_inst, & + temperature_inst=temperature_inst, & + waterstate_inst=waterstate_inst, & + soil_water_retention_curve=soil_water_retention_curve) + + end if !use_ed + + ! Modify aerodynamic parameters for sparse/dense canopy (X. Zeng) + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + lt = min(elai(p)+esai(p), tlsai_crit) + egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + displa(p) = egvf * displa(p) + z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) + end do + + found = .false. + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Net absorbed longwave radiation by canopy and ground + ! =air+bir*t_veg**4+cir*t_grnd(c)**4 + + air(p) = emv(p) * (1._r8+(1._r8-emv(p))*(1._r8-emg(c))) * forc_lwrad(c) + bir(p) = - (2._r8-emv(p)*(1._r8-emg(c))) * emv(p) * sb + cir(p) = emv(p)*emg(c)*sb + + ! Saturated vapor pressure, specific humidity, and their derivatives + ! at the leaf surface + + call QSat (t_veg(p), forc_pbot(c), el(p), deldT, qsatl(p), qsatldT(p)) + + ! Determine atmospheric co2 and o2 + + co2(p) = forc_pco2(g) + o2(p) = forc_po2(g) + + if ( use_c13 ) then + c13o2(p) = forc_pc13o2(g) + end if + + ! Initialize flux profile + + nmozsgn(p) = 0 + + taf(p) = (t_grnd(c) + thm(p))/2._r8 + qaf(p) = (forc_q(c)+qg(c))/2._r8 + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-taf(p) + dqh(p) = forc_q(c)-qaf(p) + delq(p) = qg(c) - qaf(p) + dthv(p) = dth(p)*(1._r8+0.61_r8*forc_q(c))+0.61_r8*forc_th(c)*dqh(p) + zldis(p) = forc_hgt_u_patch(p) - displa(p) + + ! Check to see if the forcing height is below the canopy height + if (zldis(p) < 0._r8) then + found = .true. + index = p + end if + + end do + + if (found) then + if ( .not. use_ed ) then + write(iulog,*)'Error: Forcing height is below canopy height for patch index ' + call endrun(decomp_index=index, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) + + end do + + ! Set counter for leaf temperature iteration (itlef) + + itlef = 0 + fnorig = fn + fporig(1:fn) = filterp(1:fn) + + ! Begin stability iteration + + call t_startf('can_iter') + ITERATION : do while (itlef <= itmax .and. fn > 0) + + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + call FrictionVelocity (begp, endp, fn, filterp, & + displa(begp:endp), z0mv(begp:endp), z0hv(begp:endp), z0qv(begp:endp), & + obu(begp:endp), itlef+1, ur(begp:endp), um(begp:endp), ustar(begp:endp), & + temp1(begp:endp), temp2(begp:endp), temp12m(begp:endp), temp22m(begp:endp), fm(begp:endp), & + frictionvel_inst) + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + tlbef(p) = t_veg(p) + del2(p) = del(p) + + ! Determine aerodynamic resistances + + ram1(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah(p,1) = 1._r8/(temp1(p)*ustar(p)) + raw(p,1) = 1._r8/(temp2(p)*ustar(p)) + + ! Bulk boundary layer resistance of leaves + + uaf(p) = um(p)*sqrt( 1._r8/(ram1(p)*um(p)) ) + cf = 0.01_r8/(sqrt(uaf(p))*sqrt(dleaf(patch%itype(p)))) + rb(p) = 1._r8/(cf*uaf(p)) + rb1(p) = rb(p) + + ! Parameterization for variation of csoilc with canopy density from + ! X. Zeng, University of Arizona + + w = exp(-(elai(p)+esai(p))) + + ! changed by K.Sakaguchi from here + ! transfer coefficient over bare soil is changed to a local variable + ! just for readability of the code (from line 680) + csoilb = (vkc/(0.13_r8*(z0mg(c)*uaf(p)/1.5e-5_r8)**0.45_r8)) + + !compute the stability parameter for ricsoilc ("S" in Sakaguchi&Zeng,2008) + + ri = ( grav*htop(p) * (taf(p) - t_grnd(c)) ) / (taf(p) * uaf(p) **2.00_r8) + + !! modify csoilc value (0.004) if the under-canopy is in stable condition + + if ( (taf(p) - t_grnd(c) ) > 0._r8) then + ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) + ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) + ricsoilc = csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) + csoilcn = csoilb*w + ricsoilc*(1._r8-w) + else + csoilcn = csoilb*w + csoilc*(1._r8-w) + end if + + !! Sakaguchi changes for stability formulation ends here + + rah(p,2) = 1._r8/(csoilcn*uaf(p)) + raw(p,2) = rah(p,2) + if (use_lch4) then + grnd_ch4_cond(p) = 1._r8/(raw(p,1)+raw(p,2)) + end if + + ! Stomatal resistances for sunlit and shaded fractions of canopy. + ! Done each iteration to account for differences in eah, tv. + + svpts(p) = el(p) ! pa + eah(p) = forc_pbot(c) * qaf(p) / 0.622_r8 ! pa + rhaf(p) = eah(p)/svpts(p) + end do + + ! Modification for shrubs proposed by X.D.Z + ! Equivalent modification for soy following AgroIBIS + ! NOTE: the following block of code was moved out of Photosynthesis subroutine and + ! into here by M. Vertenstein on 4/6/2014 as part of making the photosynthesis + ! routine a separate module. This move was also suggested by S. Levis in the previous + ! version of the code. + ! BUG MV 4/7/2014 - is this the correct place to have it in the iteration? + ! THIS SHOULD BE MOVED OUT OF THE ITERATION but will change answers - + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + if (use_cndv) then + if (patch%itype(p) == nbrdlf_dcd_tmp_shrub) then + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + if (patch%itype(p) == ntmp_soybean .or. patch%itype(p) == nirrig_tmp_soybean .or. & + patch%itype(p) == ntrp_soybean .or. patch%itype(p) == nirrig_trp_soybean) then + btran(p) = min(1._r8, btran(p) * 1.25_r8) + end if + end do + + if ( use_ed ) then + + call t_startf('edpsn') + ! FIX(FIX(SPM,032414),032414) Photo*_ED will need refactoring + call Photosynthesis_ED (bounds, fn, filterp, & + svpts(begp:endp), eah(begp:endp), o2(begp:endp), & + co2(begp:endp), rb(begp:endp), dayl_factor(begp:endp), & + ed_allsites_inst(begg:endg), atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst) + + ! zero all of these things, not just the ones in the filter. + do p = bounds%begp,bounds%endp + photosyns_inst%rssun_patch(p) = 0._r8 + photosyns_inst%rssha_patch(p) = 0._r8 + photosyns_inst%psnsun_patch(p) = 0._r8 + photosyns_inst%psnsha_patch(p) = 0._r8 + photosyns_inst%fpsn_patch(p) = 0._r8 + canopystate_inst%laisun_patch(p) = 0._r8 + canopystate_inst%laisha_patch(p) = 0._r8 + enddo + + call t_stopf('edpsn') + + else ! not use_ed + + call Photosynthesis (bounds, fn, filterp, & + svpts(begp:endp), eah(begp:endp), o2(begp:endp), co2(begp:endp), rb(begp:endp), btran(begp:endp), & + dayl_factor(begp:endp), atm2lnd_inst, temperature_inst, surfalb_inst, solarabs_inst, & + canopystate_inst, ozone_inst, photosyns_inst, cnveg_nitrogenstate_inst, phase='sun') + + if ( use_cn .and. use_c13 ) then + call Fractionation (bounds, fn, filterp, & + atm2lnd_inst, canopystate_inst, cnveg_state_inst, solarabs_inst, surfalb_inst, photosyns_inst, & + phase='sun') + endif + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + if (use_cndv) then + if (patch%itype(p) == nbrdlf_dcd_tmp_shrub) then + btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + end if + if (patch%itype(p) == ntmp_soybean .or. patch%itype(p) == nirrig_tmp_soybean .or. & + patch%itype(p) == ntrp_soybean .or. patch%itype(p) == nirrig_trp_soybean) then + btran(p) = min(1._r8, btran(p) * 1.25_r8) + end if + end do + + call Photosynthesis (bounds, fn, filterp, & + svpts(begp:endp), eah(begp:endp), o2(begp:endp), co2(begp:endp), rb(begp:endp), btran(begp:endp), & + dayl_factor(begp:endp), atm2lnd_inst, temperature_inst, surfalb_inst, solarabs_inst, & + canopystate_inst, ozone_inst, photosyns_inst, cnveg_nitrogenstate_inst, phase='sha') + + if ( use_cn .and. use_c13 ) then + call Fractionation (bounds, fn, filterp, & + atm2lnd_inst, canopystate_inst, cnveg_state_inst, solarabs_inst, surfalb_inst, photosyns_inst, & + phase='sha') + end if + + end if ! end of if use_ed + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Sensible heat conductance for air, leaf and ground + ! Moved the original subroutine in-line... + + wta = 1._r8/rah(p,1) ! air + wtl = (elai(p)+esai(p))/rb(p) ! leaf + wtg(p) = 1._r8/rah(p,2) ! ground + wtshi = 1._r8/(wta+wtl+wtg(p)) + + wtl0(p) = wtl*wtshi ! leaf + wtg0 = wtg(p)*wtshi ! ground + wta0(p) = wta*wtshi ! air + + wtga = wta0(p)+wtg0 ! ground + air + wtal(p) = wta0(p)+wtl0(p) ! air + leaf + + ! Fraction of potential evaporation from leaf + + if ( use_ed ) then + + if (fdry(p) > 0._r8) then + rppdry = fdry(p)*rb(p)/(rb(p)+rscanopy(p)) + else + rppdry = 0._r8 + end if + if (use_lch4) then + ! Calculate canopy conductance for methane / oxygen (e.g. stomatal conductance & leaf bdy cond) + canopy_cond(p) = 1.0_r8/(rb(p)+rscanopy(p)) + end if + + else ! NOT use_ed + + if (fdry(p) > 0._r8) then + rppdry = fdry(p)*rb(p)*(laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/elai(p) + else + rppdry = 0._r8 + end if + + ! Calculate canopy conductance for methane / oxygen (e.g. stomatal conductance & leaf bdy cond) + if (use_lch4) then + canopy_cond(p) = (laisun(p)/(rb(p)+rssun(p)) + laisha(p)/(rb(p)+rssha(p)))/max(elai(p), 0.01_r8) + end if + + end if ! end of if use_ed + + efpot = forc_rho(c)*wtl*(qsatl(p)-qaf(p)) + + if (efpot > 0._r8) then + if (btran(p) > btran0) then + qflx_tran_veg(p) = efpot*rppdry + rpp = rppdry + fwet(p) + else + !No transpiration if btran below 1.e-10 + rpp = fwet(p) + qflx_tran_veg(p) = 0._r8 + end if + !Check total evapotranspiration from leaves + rpp = min(rpp, (qflx_tran_veg(p)+h2ocan(p)/dtime)/efpot) + else + !No transpiration if potential evaporation less than zero + rpp = 1._r8 + qflx_tran_veg(p) = 0._r8 + end if + + ! Update conductances for changes in rpp + ! Latent heat conductances for ground and leaf. + ! Air has same conductance for both sensible and latent heat. + ! Moved the original subroutine in-line... + + wtaq = frac_veg_nosno(p)/raw(p,1) ! air + wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf + + !Litter layer resistance. Added by K.Sakaguchi + snow_depth_c = z_dl ! critical depth for 100% litter burial by snow (=litter thickness) + fsno_dl = snow_depth(c)/snow_depth_c ! effective snow cover for (dry)plant litter + elai_dl = lai_dl*(1._r8 - min(fsno_dl,1._r8)) ! exposed (dry)litter area index + rdl = ( 1._r8 - exp(-elai_dl) ) / ( 0.004_r8*uaf(p)) ! dry litter layer resistance + + ! add litter resistance and Lee and Pielke 1992 beta + if (delq(p) < 0._r8) then !dew. Do not apply beta for negative flux (follow old rsoil) + wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+rdl) + else + if (do_soilevap_beta()) then + wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,2)+rdl) + endif + end if + + wtsqi = 1._r8/(wtaq+wtlq+wtgq(p)) + + wtgq0 = wtgq(p)*wtsqi ! ground + wtlq0(p) = wtlq*wtsqi ! leaf + wtaq0(p) = wtaq*wtsqi ! air + + wtgaq = wtaq0(p)+wtgq0 ! air + ground + wtalq(p) = wtaq0(p)+wtlq0(p) ! air + leaf + + dc1 = forc_rho(c)*cpair*wtl + dc2 = hvap*forc_rho(c)*wtlq + + efsh = dc1*(wtga*t_veg(p)-wtg0*t_grnd(c)-wta0(p)*thm(p)) + efe(p) = dc2*(wtgaq*qsatl(p)-wtgq0*qg(c)-wtaq0(p)*forc_q(c)) + + ! Evaporation flux from foliage + + erre = 0._r8 + if (efe(p)*efeb(p) < 0._r8) then + efeold = efe(p) + efe(p) = 0.1_r8*efeold + erre = efe(p) - efeold + end if + ! fractionate ground emitted longwave + lw_grnd=(frac_sno(c)*t_soisno(c,snl(c)+1)**4 & + +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc(c)**4) + + dt_veg(p) = (sabv(p) + air(p) + bir(p)*t_veg(p)**4 + & + cir(p)*lw_grnd - efsh - efe(p)) / & + (- 4._r8*bir(p)*t_veg(p)**3 +dc1*wtga +dc2*wtgaq*qsatldT(p)) + t_veg(p) = tlbef(p) + dt_veg(p) + dels = dt_veg(p) + del(p) = abs(dels) + err(p) = 0._r8 + if (del(p) > delmax) then + dt_veg(p) = delmax*dels/del(p) + t_veg(p) = tlbef(p) + dt_veg(p) + err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + cir(p)*lw_grnd - & + (efsh + dc1*wtga*dt_veg(p)) - (efe(p) + & + dc2*wtgaq*qsatldT(p)*dt_veg(p)) + end if + + ! Fluxes from leaves to canopy space + ! "efe" was limited as its sign changes frequently. This limit may + ! result in an imbalance in "hvap*qflx_evap_veg" and + ! "efe + dc2*wtgaq*qsatdt_veg" + + efpot = forc_rho(c)*wtl*(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & + -wtgq0*qg(c)-wtaq0(p)*forc_q(c)) + qflx_evap_veg(p) = rpp*efpot + + ! Calculation of evaporative potentials (efpot) and + ! interception losses; flux in kg m**-2 s-1. ecidif + ! holds the excess energy if all intercepted water is evaporated + ! during the timestep. This energy is later added to the + ! sensible heat flux. + + ecidif = 0._r8 + if (efpot > 0._r8 .and. btran(p) > btran0) then + qflx_tran_veg(p) = efpot*rppdry + else + qflx_tran_veg(p) = 0._r8 + end if + ecidif = max(0._r8, qflx_evap_veg(p)-qflx_tran_veg(p)-h2ocan(p)/dtime) + qflx_evap_veg(p) = min(qflx_evap_veg(p),qflx_tran_veg(p)+h2ocan(p)/dtime) + + ! The energy loss due to above two limits is added to + ! the sensible heat flux. + + eflx_sh_veg(p) = efsh + dc1*wtga*dt_veg(p) + err(p) + erre + hvap*ecidif + + ! Re-calculate saturated vapor pressure, specific humidity, and their + ! derivatives at the leaf surface + + call QSat(t_veg(p), forc_pbot(c), el(p), deldT, qsatl(p), qsatldT(p)) + + ! Update vegetation/ground surface temperature, canopy air + ! temperature, canopy vapor pressure, aerodynamic temperature, and + ! Monin-Obukhov stability parameter for next iteration. + + taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p) + qaf(p) = wtlq0(p)*qsatl(p) + wtgq0*qg(c) + forc_q(c)*wtaq0(p) + + ! Update Monin-Obukhov length and wind speed including the + ! stability effect + + dth(p) = thm(p)-taf(p) + dqh(p) = forc_q(c)-qaf(p) + delq(p) = wtalq(p)*qg(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + + thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar + zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p)+wc*wc) + end if + obu(p) = zldis(p)/zeta + + if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 + if (nmozsgn(p) >= 4) obu(p) = zldis(p)/(-0.01_r8) + obuold(p) = obu(p) + + end do ! end of filtered patch loop + + ! Test for convergence + + itlef = itlef+1 + if (itlef > itmin) then + do f = 1, fn + p = filterp(f) + dele(p) = abs(efe(p)-efeb(p)) + efeb(p) = efe(p) + det(p) = max(del(p),del2(p)) + end do + fnold = fn + fn = 0 + do f = 1, fnold + p = filterp(f) + if (.not. (det(p) < dtmin .and. dele(p) < dlemin)) then + fn = fn + 1 + filterp(fn) = p + end if + end do + end if + + end do ITERATION ! End stability iteration + call t_stopf('can_iter') + + fn = fnorig + filterp(1:fn) = fporig(1:fn) + + ! Set status of snowveg_flag + snowveg_on = IsSnowvegFlagOn() + snowveg_onrad = IsSnowvegFlagOnRad() + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + g = patch%gridcell(p) + + ! Energy balance check in canopy + + lw_grnd=(frac_sno(c)*t_soisno(c,snl(c)+1)**4 & + +(1._r8-frac_sno(c)-frac_h2osfc(c))*t_soisno(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc(c)**4) + + err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + !+ cir(p)*t_grnd(c)**4 - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) + + cir(p)*lw_grnd - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) + + ! Fluxes from ground to canopy space + + delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + taux(p) = -forc_rho(c)*forc_u(g)/ram1(p) + tauy(p) = -forc_rho(c)*forc_v(g)/ram1(p) + eflx_sh_grnd(p) = cpair*forc_rho(c)*wtg(p)*delt + + ! compute individual sensible heat fluxes + delt_snow = wtal(p)*t_soisno(c,snl(c)+1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + eflx_sh_snow(p) = cpair*forc_rho(c)*wtg(p)*delt_snow + + delt_soil = wtal(p)*t_soisno(c,1)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + eflx_sh_soil(p) = cpair*forc_rho(c)*wtg(p)*delt_soil + + delt_h2osfc = wtal(p)*t_h2osfc(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + eflx_sh_h2osfc(p) = cpair*forc_rho(c)*wtg(p)*delt_h2osfc + qflx_evap_soi(p) = forc_rho(c)*wtgq(p)*delq(p) + + ! compute individual latent heat fluxes + delq_snow = wtalq(p)*qg_snow(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) + qflx_ev_snow(p) = forc_rho(c)*wtgq(p)*delq_snow + + delq_soil = wtalq(p)*qg_soil(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) + qflx_ev_soil(p) = forc_rho(c)*wtgq(p)*delq_soil + + delq_h2osfc = wtalq(p)*qg_h2osfc(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(c) + qflx_ev_h2osfc(p) = forc_rho(c)*wtgq(p)*delq_h2osfc + + ! 2 m height air temperature + + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + t_ref2m_r(p) = t_ref2m(p) + + ! 2 m height specific humidity + + q_ref2m(p) = forc_q(c) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(c), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + rh_ref2m_r(p) = rh_ref2m(p) + + ! Human Heat Stress + if ( calc_human_stress_indices )then + + call KtoC(t_ref2m(p), tc_ref2m(p)) + call VaporPres(rh_ref2m(p), e_ref2m, vap_ref2m(p)) + call Wet_Bulb(t_ref2m(p), vap_ref2m(p), forc_pbot(c), rh_ref2m(p), q_ref2m(p), & + teq_ref2m(p), ept_ref2m(p), wb_ref2m(p)) + call Wet_BulbS(tc_ref2m(p),rh_ref2m(p), wbt_ref2m(p)) + call HeatIndex(tc_ref2m(p), rh_ref2m(p), nws_hi_ref2m(p)) + call AppTemp(tc_ref2m(p), vap_ref2m(p), u10_clm(p), appar_temp_ref2m(p)) + call swbgt(tc_ref2m(p), vap_ref2m(p), swbgt_ref2m(p)) + call hmdex(tc_ref2m(p), vap_ref2m(p), humidex_ref2m(p)) + call dis_coi(tc_ref2m(p), wb_ref2m(p), discomf_index_ref2m(p)) + call dis_coiS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p), discomf_index_ref2mS(p)) + call THIndex(tc_ref2m(p), wb_ref2m(p), thic_ref2m(p), thip_ref2m(p)) + call SwampCoolEff(tc_ref2m(p), wb_ref2m(p), swmp80_ref2m(p), swmp65_ref2m(p)) + + teq_ref2m_r(p) = teq_ref2m(p) + ept_ref2m_r(p) = ept_ref2m(p) + wb_ref2m_r(p) = wb_ref2m(p) + wbt_ref2m_r(p) = wbt_ref2m(p) + nws_hi_ref2m_r(p) = nws_hi_ref2m(p) + appar_temp_ref2m_r(p) = appar_temp_ref2m(p) + swbgt_ref2m_r(p) = swbgt_ref2m(p) + humidex_ref2m_r(p) = humidex_ref2m(p) + discomf_index_ref2m_r(p) = discomf_index_ref2m(p) + discomf_index_ref2mS_r(p) = discomf_index_ref2mS(p) + thic_ref2m_r(p) = thic_ref2m(p) + thip_ref2m_r(p) = thip_ref2m(p) + swmp80_ref2m_r(p) = swmp80_ref2m(p) + swmp65_ref2m_r(p) = swmp65_ref2m(p) + end if + + ! Downward longwave radiation below the canopy + + dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(c) + & + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) + + ! Upward longwave radiation above the canopy + + ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(c) & + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + emg(c)*(1._r8-emv(p))*sb*lw_grnd) + + ! Derivative of soil energy flux with respect to soil temperature + + cgrnds(p) = cgrnds(p) + cpair*forc_rho(c)*wtg(p)*wtal(p) + cgrndl(p) = cgrndl(p) + forc_rho(c)*wtgq(p)*wtalq(p)*dqgdT(c) + cgrnd(p) = cgrnds(p) + cgrndl(p)*htvp(c) + + ! Update dew accumulation (kg/m2) + h2ocan(p) = max(0._r8,h2ocan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime) + + if (snowveg_on .or. snowveg_onrad) then + if (t_veg(p) > tfrz ) then ! above freezing, update accumulation in liqcan + if ((qflx_evap_veg(p)-qflx_tran_veg(p))*dtime > liqcan(p)) then ! all liq evap + ! In this case, all liqcan will evap. Take remainder from snocan + snocan(p)=snocan(p)+liqcan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime + end if + liqcan(p) = max(0._r8,liqcan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime) + + else if (t_veg(p) <= tfrz) then ! below freezing, update accumulation in snocan + if ((qflx_evap_veg(p)-qflx_tran_veg(p))*dtime > snocan(p)) then ! all sno evap + ! In this case, all snocan will evap. Take remainder from liqcan + liqcan(p)=liqcan(p)+snocan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime + end if + snocan(p) = max(0._r8,snocan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime) + end if + end if + + if ( use_ed ) then + call AccumulateFluxes_ED(bounds, p, ed_allsites_inst(begg:endg), photosyns_inst) + end if + + end do + + ! Determine total photosynthesis + + call PhotosynthesisTotal(fn, filterp, & + atm2lnd_inst, canopystate_inst, photosyns_inst) + + ! Calculate ozone stress. This needs to be done after rssun and rsshade are + ! computed by the Photosynthesis routine. However, Photosynthesis also uses the + ! ozone stress computed here. Thus, the ozone stress computed in timestep i is + ! applied in timestep (i+1). + + ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) The following dummy variable assignment is + ! needed with pgi 14.7 on yellowstone; without it, forc_pbot_downscaled_col gets + ! resized inappropriately in the following subroutine call, due to a compiler bug. + dummy_to_make_pgi_happy = ubound(atm2lnd_inst%forc_pbot_downscaled_col, 1) + call ozone_inst%CalcOzoneStress( & + bounds, fn, filterp, & + forc_pbot = atm2lnd_inst%forc_pbot_downscaled_col(bounds%begc:bounds%endc), & + forc_th = atm2lnd_inst%forc_th_downscaled_col(bounds%begc:bounds%endc), & + rssun = photosyns_inst%rssun_patch(bounds%begp:bounds%endp), & + rssha = photosyns_inst%rssha_patch(bounds%begp:bounds%endp), & + rb = frictionvel_inst%rb1_patch(bounds%begp:bounds%endp), & + ram = frictionvel_inst%ram1_patch(bounds%begp:bounds%endp), & + tlai = canopystate_inst%tlai_patch(bounds%begp:bounds%endp)) + + !--------------------------------------------------------- + !update Vc,max and Jmax by LUNA model + if(use_luna)then + call Acc24_Climate_LUNA(bounds, fn, filterp, & + canopystate_inst, photosyns_inst, & + surfalb_inst, solarabs_inst, & + temperature_inst) + + if(is_end_day)then + + call Acc240_Climate_LUNA(bounds, fn, filterp, & + o2(begp:endp), & + co2(begp:endp), & + rb(begp:endp), & + rhaf(begp:endp),& + temperature_inst, & + photosyns_inst, & + surfalb_inst, & + solarabs_inst, & + waterstate_inst,& + frictionvel_inst) + + call Update_Photosynthesis_Capacity(bounds, fn, filterp, & + dayl_factor(begp:endp), & + atm2lnd_inst, & + temperature_inst, & + canopystate_inst, & + photosyns_inst, & + surfalb_inst, & + solarabs_inst, & + waterstate_inst,& + frictionvel_inst) + + call Clear24_Climate_LUNA(bounds, fn, filterp, & + canopystate_inst, photosyns_inst, & + surfalb_inst, solarabs_inst, & + temperature_inst) + endif + + endif + + ! Filter out patches which have small energy balance errors; report others + + fnold = fn + fn = 0 + do f = 1, fnold + p = filterp(f) + if (abs(err(p)) > 0.1_r8) then + fn = fn + 1 + filterp(fn) = p + end if + end do + + do f = 1, fn + p = filterp(f) + write(iulog,*) 'energy balance in canopy ',p,', err=',err(p) + end do + + if ( use_ed ) then + ! zero all of the array, not just the ones in the filter. + do p = bounds%begp,bounds%endp + photosyns_inst%rssun_patch(p) = 0._r8 + photosyns_inst%rssha_patch(p) = 0._r8 + photosyns_inst%psnsun_patch(p) = 0._r8 + photosyns_inst%psnsha_patch(p) = 0._r8 + photosyns_inst%fpsn_patch(p) = 0._r8 + canopystate_inst%laisun_patch(p) = 0._r8 + canopystate_inst%laisha_patch(p) = 0._r8 + enddo + end if + + end associate + + + end subroutine CanopyFluxes + +end module CanopyFluxesMod + diff --git a/components/clm/src/biogeophys/CanopyHydrologyMod.F90 b/components/clm/src/biogeophys/CanopyHydrologyMod.F90 new file mode 100644 index 0000000000..ac4f15848a --- /dev/null +++ b/components/clm/src/biogeophys/CanopyHydrologyMod.F90 @@ -0,0 +1,915 @@ +module CanopyHydrologyMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculation of + ! (1) water storage of intercepted precipitation + ! (2) direct throughfall and canopy drainage of precipitation + ! (3) the fraction of foliage covered by water and the fraction + ! of foliage that is dry and transpiring. + ! (4) snow layer initialization if the snow accumulation exceeds 10 mm. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use LandunitType , only : lun + use atm2lndType , only : atm2lnd_type + use AerosolMod , only : aerosol_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use IrrigationMod , only : irrigation_type + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CanopyHydrology_readnl ! Read namelist + public :: CanopyHydrology ! Run + public :: IsSnowvegFlagOff ! Returns true if snowveg_flag is OFF + public :: IsSnowvegFlagOn ! Returns true if snowveg_flag is ON + public :: IsSnowvegFlagOnRad ! Returns true if snowveg_flag is ON_RAD + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: FracWet ! Determine fraction of vegetated surface that is wet + private :: FracH2oSfc ! Determine fraction of land surfaces which are submerged + ! + ! !PRIVATE DATA MEMBERS: + integer :: oldfflag=0 ! use old fsno parameterization (N&Y07) + ! Snow in vegetation canopy namelist options. + logical, private :: snowveg_off = .false. ! snowveg_flag = 'OFF' + logical, private :: snowveg_on = .false. ! snowveg_flag = 'ON' + logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' + ! for now, all mods on by default: + character(len= 10), public :: snowveg_flag = 'ON_RAD' + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine CanopyHydrology_readnl( NLFilename ) + ! + ! !DESCRIPTION: + ! Read the namelist for CanopyHydrology + ! + ! !USES: + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'CanopyHydrology_readnl' ! subroutine name + !----------------------------------------------------------------------- + + namelist / clm_canopyhydrology_inparm / oldfflag + namelist / clm_canopyhydrology_inparm / snowveg_flag + + ! ---------------------------------------------------------------------- + ! Read namelist from standard input. + ! ---------------------------------------------------------------------- + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in clm_CanopyHydrology_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'clm_CanopyHydrology_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clm_canopyhydrology_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading clm_canopyhydrology_inparm namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + snowveg_off = IsSnowvegFlagOff() + snowveg_on = IsSnowvegFlagOn() + snowveg_onrad = IsSnowvegFlagOnRad() + write(iulog,*) 'snowveg_off = ',snowveg_off + write(iulog,*) 'snowveg_on = ',snowveg_on + write(iulog,*) 'snowveg_onrad = ',snowveg_onrad + if (snowveg_off .or. snowveg_on .or. snowveg_onrad) then + write(iulog,*) 'snowveg_flag = ',snowveg_flag + else + call endrun(msg="snowveg_flag is set incorrectly (not ON, ON_RAD, or OFF)"//errmsg(__FILE__, __LINE__)) + end if + end if + ! Broadcast namelist variables read in + call shr_mpi_bcast(oldfflag, mpicom) + call shr_mpi_bcast(snowveg_flag, mpicom) + + end subroutine CanopyHydrology_readnl + + !----------------------------------------------------------------------- + subroutine CanopyHydrology(bounds, & + num_nolakec, filter_nolakec, num_nolakep, filter_nolakep, & + atm2lnd_inst, canopystate_inst, temperature_inst, & + aerosol_inst, waterstate_inst, waterflux_inst, irrigation_inst) + ! + ! !DESCRIPTION: + ! Calculation of + ! (1) water storage of intercepted precipitation + ! (2) direct throughfall and canopy drainage of precipitation + ! (3) the fraction of foliage covered by water and the fraction + ! of foliage that is dry and transpiring. + ! (4) snow layer initialization if the snow accumulation exceeds 10 mm. + ! Note: The evaporation loss is taken off after the calculation of leaf + ! temperature in the subroutine clm\_leaftem.f90, not in this subroutine. + ! + ! !USES: + use clm_varcon , only : hfus, denice, zlnd, rpi, spval, tfrz + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use landunit_varcon , only : istcrop, istice, istwet, istsoil, istice_mec + use clm_varctl , only : subgridflag + use clm_varpar , only : nlevsoi,nlevsno + use clm_time_manager , only : get_step_size + use subgridAveMod , only : p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_nolakep ! number of pft non-lake points in pft filter + integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(irrigation_type) , intent(in) :: irrigation_inst + ! + ! !LOCAL VARIABLES: + integer :: f ! filter index + integer :: pi ! patch index + integer :: p ! patch index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! gridcell index + integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) + real(r8) :: dtime ! land model time step (sec) + real(r8) :: h2ocanmx ! maximum allowed water on canopy [mm] + real(r8) :: snocanmx ! maximum allowed snow on canopy [mm equiv. water] + real(r8) :: liqcanmx ! maximum allowed snowliquid water on canopy [mm equiv. water] + real(r8) :: xsnorun ! excess snow that exceeds the leaf capacity [mm/s] + real(r8) :: xliqrun ! excess liquid water + real(r8) :: qflx_snocanfall(bounds%begp:bounds%endp) ! rate of excess canopy snow falling off canopy + real(r8) :: qflx_liqcanfall(bounds%begp:bounds%endp) ! rate of excess canopy liquid falling off canopy + real(r8) :: fpi ! coefficient of interception + real(r8) :: fpisnow ! coefficient of interception for snowfall + real(r8) :: xrun ! excess water that exceeds the leaf capacity [mm/s] + real(r8) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] + real(r8) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + real(r8) :: fracsnow(bounds%begp:bounds%endp) ! frac of precipitation that is snow + real(r8) :: fracrain(bounds%begp:bounds%endp) ! frac of precipitation that is rain + real(r8) :: qflx_candrip(bounds%begp:bounds%endp) ! rate of canopy runoff and snow falling off canopy [mm/s] + real(r8) :: qflx_through_rain(bounds%begp:bounds%endp) ! direct rain throughfall [mm/s] + real(r8) :: qflx_through_snow(bounds%begp:bounds%endp) ! direct snow throughfall [mm/s] + real(r8) :: qflx_prec_grnd_snow(bounds%begp:bounds%endp) ! snow precipitation incident on ground [mm/s] + real(r8) :: qflx_prec_grnd_rain(bounds%begp:bounds%endp) ! rain precipitation incident on ground [mm/s] + real(r8) :: z_avg ! grid cell average snow depth + real(r8) :: rho_avg ! avg density of snow column + real(r8) :: temp_snow_depth,temp_intsnow ! temporary variables + real(r8) :: fmelt + real(r8) :: smr + real(r8) :: delf_melt + real(r8) :: fsno_new + real(r8) :: accum_factor + real(r8) :: newsnow(bounds%begc:bounds%endc) + real(r8) :: snowmelt(bounds%begc:bounds%endc) + integer :: j + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + n_melt => col%n_melt , & ! Input: [real(r8) (:) ] SCA shape parameter + zi => col%zi , & ! Output: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Output: [real(r8) (:,:) ] layer depth (m) + z => col%z , & ! Output: [real(r8) (:,:) ] layer thickness (m) + + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + qflx_floodg => atm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] gridcell flux of flood water from RTM + forc_wind => atm2lnd_inst%forc_wind_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed (m/s) + dewmx => canopystate_inst%dewmx_patch , & ! Input: [real(r8) (:) ] Maximum allowed dew [mm] + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Output: [logical (:) ] true => do snow capping + h2ocan => waterstate_inst%h2ocan_patch , & ! Output: [real(r8) (:) ] total canopy water (mm H2O) + snocan => waterstate_inst%snocan_patch , & ! Output: [real(r8) (:) ] canopy snow (mm H2O) + liqcan => waterstate_inst%liqcan_patch , & ! Output: [real(r8) (:) ] canopy liquid (mm H2O) + snounload => waterstate_inst%snounload_patch , & ! Output: [real(r8) (:) ] canopy snow unloading (mm H2O) + h2osfc => waterstate_inst%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) + h2osno => waterstate_inst%h2osno_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) + snow_depth => waterstate_inst%snow_depth_col , & ! Output: [real(r8) (:) ] snow height (m) + int_snow => waterstate_inst%int_snow_col , & ! Output: [real(r8) (:) ] integrated snowfall [mm] + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Output: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_sno => waterstate_inst%frac_sno_col , & ! Output: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Output: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_iceold => waterstate_inst%frac_iceold_col , & ! Output: [real(r8) (:,:) ] fraction of ice relative to the tot water + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + swe_old => waterstate_inst%swe_old_col , & ! Output: [real(r8) (:,:) ] snow water before update + + qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Output: [real(r8) (:) ] column flux of flood water from RTM + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Input: [real(r8) (:) ] drainage from snow pack from previous time step + qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Output: [real(r8) (:) ] snow falling on surface water (mm/s) + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_patch , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) [+] + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_patch , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Output: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] + qflx_snow_grnd_patch => waterflux_inst%qflx_snow_grnd_patch , & ! Output: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] + qflx_prec_intr => waterflux_inst%qflx_prec_intr_patch , & ! Output: [real(r8) (:) ] interception of precipitation [mm/s] + qflx_prec_grnd => waterflux_inst%qflx_prec_grnd_patch , & ! Output: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] + qflx_rain_grnd => waterflux_inst%qflx_rain_grnd_patch , & ! Output: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] + + qflx_irrig => irrigation_inst%qflx_irrig_patch , & ! Input: [real(r8) (:) ] irrigation amount (mm/s) + qflx_snowindunload => waterflux_inst%qflx_snowindunload_patch , & ! Output: [real(r8) (:) ] canopy snow unloading from wind [mm/s] + qflx_snotempunload => waterflux_inst%qflx_snotempunload_patch & ! Output: [real(r8) (:) ] canopy snow unloading from temp. [mm/s] + ) + + ! Compute time step + + dtime = get_step_size() + + ! Set status of snowveg_flag + snowveg_on = IsSnowvegFlagOn() + snowveg_onrad = IsSnowvegFlagOnRad() + + ! Start patch loop + + do f = 1, num_nolakep + p = filter_nolakep(f) + g = patch%gridcell(p) + l = patch%landunit(p) + c = patch%column(p) + + ! Canopy interception and precipitation onto ground surface + ! Add precipitation to leaf water + + if (lun%itype(l)==istsoil .or. lun%itype(l)==istwet .or. lun%urbpoi(l) .or. & + lun%itype(l)==istcrop) then + + qflx_candrip(p) = 0._r8 ! rate of canopy runoff + qflx_snocanfall(p) = 0._r8 ! rate of just snow canopy fall + qflx_liqcanfall(p) = 0._r8 + qflx_snowindunload(p) = 0._r8 + qflx_snotempunload(p) = 0._r8 + snounload(p)=0._r8 + qflx_through_snow(p) = 0._r8 ! rain precipitation direct through canopy + qflx_through_rain(p) = 0._r8 ! snow precipitation direct through canopy + qflx_prec_intr(p) = 0._r8 ! total intercepted precipitation + fracsnow(p) = 0._r8 ! fraction of input precip that is snow + fracrain(p) = 0._r8 ! fraction of input precip that is rain + + + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then + + if (frac_veg_nosno(p) == 1 .and. (forc_rain(c) + forc_snow(c)) > 0._r8) then + + ! determine fraction of input precipitation that is snow and rain + fracsnow(p) = forc_snow(c)/(forc_snow(c) + forc_rain(c)) + fracrain(p) = forc_rain(c)/(forc_snow(c) + forc_rain(c)) + + ! The leaf water capacities for solid and liquid are different, + ! generally double for snow, but these are of somewhat less + ! significance for the water budget because of lower evap. rate at + ! lower temperature. Hence, it is reasonable to assume that + ! vegetation storage of solid water is the same as liquid water. + h2ocanmx = dewmx(p) * (elai(p) + esai(p)) + ! Coefficient of interception + ! set fraction of potential interception to max 0.25 + fpi = 0.25_r8*(1._r8 - exp(-0.5_r8*(elai(p) + esai(p)))) + + if (snowveg_on .or. snowveg_onrad) then + snocanmx = 60._r8*dewmx(p) * (elai(p) + esai(p)) ! 6*(LAI+SAI) + liqcanmx = h2ocanmx + + fpisnow = (1._r8 - exp(-0.5_r8*(elai(p) + esai(p)))) ! max interception of 1 + ! Direct throughfall + qflx_through_snow(p) = forc_snow(c) * (1._r8-fpisnow) + else + ! Direct throughfall + qflx_through_snow(p) = forc_snow(c) * (1._r8-fpi) + end if + + ! Direct throughfall + qflx_through_rain(p) = forc_rain(c) * (1._r8-fpi) + + if (snowveg_on .or. snowveg_onrad) then + ! Intercepted precipitation [mm/s] + qflx_prec_intr(p) = forc_snow(c)*fpisnow + forc_rain(c)*fpi + ! storage of intercepted snowfall, rain, and dew + snocan(p) = max(0._r8, snocan(p) + dtime*forc_snow(c)*fpisnow) + liqcan(p) = max(0._r8, liqcan(p) + dtime*forc_rain(c)*fpi) + else + ! Intercepted precipitation [mm/s] + qflx_prec_intr(p) = (forc_snow(c) + forc_rain(c)) * fpi + end if + + ! Water storage of intercepted precipitation and dew + h2ocan(p) = max(0._r8, h2ocan(p) + dtime*qflx_prec_intr(p)) + + ! Initialize rate of canopy runoff and snow falling off canopy + qflx_candrip(p) = 0._r8 + qflx_snocanfall(p) = 0._r8 + qflx_liqcanfall(p) = 0._r8 + qflx_snowindunload(p) = 0._r8 + qflx_snotempunload(p) = 0._r8 + snounload(p)=0._r8 + + if (snowveg_on .or. snowveg_onrad) then + if (forc_t(c) > tfrz) then ! Above freezing (Use t_veg?) + xliqrun = (liqcan(p) - liqcanmx)/dtime + if (xliqrun > 0._r8) then + qflx_liqcanfall(p) = xliqrun + liqcan(p) = liqcanmx + end if + else ! Below freezing + xsnorun = (snocan(p) - snocanmx)/dtime + if (xsnorun > 0._r8) then ! exceeds snow capacity + qflx_snocanfall(p) = xsnorun + snocan(p) = snocanmx + end if + end if + qflx_candrip(p) = qflx_snocanfall(p) + qflx_liqcanfall(p) + h2ocan(p) = snocan(p) + liqcan(p) + else + ! Excess water that exceeds the leaf capacity + xrun = (h2ocan(p) - h2ocanmx)/dtime + + ! Test on maximum dew on leaf + ! Note if xrun > 0 then h2ocan must be at least h2ocanmx + if (xrun > 0._r8) then + qflx_candrip(p) = xrun + h2ocan(p) = h2ocanmx + end if + end if + end if + end if + + else if (lun%itype(l)==istice .or. lun%itype(l)==istice_mec) then + + h2ocan(p) = 0._r8 + qflx_candrip(p) = 0._r8 + qflx_through_snow(p) = 0._r8 + qflx_through_rain(p) = 0._r8 + qflx_prec_intr(p) = 0._r8 + fracsnow(p) = 0._r8 + fracrain(p) = 0._r8 + snocan(p) = 0._r8 + liqcan(p) = 0._r8 + qflx_snocanfall(p) = 0._r8 + qflx_liqcanfall(p) = 0._r8 + qflx_snowindunload(p) = 0._r8 + qflx_snotempunload(p) = 0._r8 + snounload(p)=0._r8 + + end if + + ! Precipitation onto ground (kg/(m2 s)) + + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then + if (frac_veg_nosno(p) == 0) then + qflx_prec_grnd_snow(p) = forc_snow(c) + qflx_prec_grnd_rain(p) = forc_rain(c) + else + if (snowveg_on .or. snowveg_onrad) then + qflx_snowindunload(p)=0._r8 + qflx_snotempunload(p)=0._r8 + snounload(p)=0._r8 + if (snocan(p) > 0._r8) then + qflx_snotempunload(p) = max(0._r8,snocan(p)*(forc_t(c)-270.15_r8)/1.87e5_r8) + qflx_snowindunload(p) = 0.5_r8*snocan(p)*forc_wind(g)/1.56e5_r8 + snounload(p) = (qflx_snowindunload(p)+qflx_snotempunload(p))*dtime ! total canopy unloading in timestep + if ( snounload(p) > snocan(p) ) then ! Limit unloading to snow in canopy + snounload(p) = snocan(p) + write(iulog,"(A,I2.2,A,ES13.4E2)") "snocan",p,": ",snocan(p) + end if + snocan(p) = snocan(p) - snounload(p) + h2ocan(p) = h2ocan(p) - snounload(p) + endif + qflx_prec_grnd_snow(p) = qflx_through_snow(p) + qflx_snocanfall(p) + snounload(p)/dtime + qflx_prec_grnd_rain(p) = qflx_through_rain(p) + qflx_liqcanfall(p) + + else + qflx_prec_grnd_snow(p) = qflx_through_snow(p) + (qflx_candrip(p) * fracsnow(p)) + qflx_prec_grnd_rain(p) = qflx_through_rain(p) + (qflx_candrip(p) * fracrain(p)) + end if + end if + ! Urban sunwall and shadewall have no intercepted precipitation + else + qflx_prec_grnd_snow(p) = 0. + qflx_prec_grnd_rain(p) = 0. + end if + + ! Add irrigation water directly onto ground (bypassing canopy interception) + ! Note that it's still possible that (some of) this irrigation water will runoff (as runoff is computed later) + qflx_prec_grnd_rain(p) = qflx_prec_grnd_rain(p) + qflx_irrig(p) + + qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) + + if (do_capsnow(c)) then + qflx_snwcp_liq(p) = qflx_prec_grnd_rain(p) + qflx_snwcp_ice(p) = qflx_prec_grnd_snow(p) + + qflx_snow_grnd_patch(p) = 0._r8 + qflx_rain_grnd(p) = 0._r8 + else + qflx_snwcp_liq(p) = 0._r8 + qflx_snwcp_ice(p) = 0._r8 + qflx_snow_grnd_patch(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) + qflx_rain_grnd(p) = qflx_prec_grnd_rain(p) ! liquid water onto ground (mm/s) + end if + + end do ! (end patch loop) + + ! Determine the fraction of foliage covered by water and the + ! fraction of foliage that is dry and transpiring. + + call FracWet(num_nolakep, filter_nolakep, & + canopystate_inst, waterstate_inst) + + ! Update column level state variables for snow. + + call p2c(bounds, num_nolakec, filter_nolakec, & + qflx_snow_grnd_patch(bounds%begp:bounds%endp), & + qflx_snow_grnd_col(bounds%begc:bounds%endc)) + + ! apply gridcell flood water flux to non-lake columns + do f = 1, num_nolakec + c = filter_nolakec(f) + g = col%gridcell(c) + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then + qflx_floodc(c) = qflx_floodg(g) + else + qflx_floodc(c) = 0._r8 + endif + enddo + + ! Determine snow height and snow water + + do f = 1, num_nolakec + c = filter_nolakec(f) + l = col%landunit(c) + g = col%gridcell(c) + + ! Use Alta relationship, Anderson(1976); LaChapelle(1961), + ! U.S.Department of Agriculture Forest Service, Project F, + ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification. + + qflx_snow_h2osfc(c) = 0._r8 + ! set temporary variables prior to updating + temp_snow_depth=snow_depth(c) + ! save initial snow content + do j= -nlevsno+1,snl(c) + swe_old(c,j) = 0.0_r8 + end do + do j= snl(c)+1,0 + swe_old(c,j)=h2osoi_liq(c,j)+h2osoi_ice(c,j) + enddo + + if (do_capsnow(c)) then + dz_snowf = 0._r8 + newsnow(c) = (1._r8 - frac_h2osfc(c)) * qflx_snow_grnd_col(c) * dtime + frac_sno(c)=1._r8 + int_snow(c) = 5.e2_r8 + else + if (forc_t(c) > tfrz + 2._r8) then + bifall=50._r8 + 1.7_r8*(17.0_r8)**1.5_r8 + else if (forc_t(c) > tfrz - 15._r8) then + bifall=50._r8 + 1.7_r8*(forc_t(c) - tfrz + 15._r8)**1.5_r8 + else + bifall=50._r8 + end if + + ! newsnow is all snow that doesn't fall on h2osfc + newsnow(c) = (1._r8 - frac_h2osfc(c)) * qflx_snow_grnd_col(c) * dtime + + ! update int_snow + int_snow(c) = max(int_snow(c),h2osno(c)) !h2osno could be larger due to frost + + ! snowmelt from previous time step * dtime + snowmelt(c) = qflx_snow_drain(c) * dtime + + ! set shape factor for accumulation of snow + accum_factor=0.1 + + if (h2osno(c) > 0.0) then + + !====================== FSCA PARAMETERIZATIONS ====================== + ! fsca parameterization based on *changes* in swe + ! first compute change from melt during previous time step + if(snowmelt(c) > 0._r8) then + + smr=min(1._r8,(h2osno(c))/(int_snow(c))) + + frac_sno(c) = 1. - (acos(min(1._r8,(2.*smr - 1._r8)))/rpi)**(n_melt(c)) + + endif + + ! update fsca by new snow event, add to previous fsca + if (newsnow(c) > 0._r8) then + fsno_new = 1._r8 - (1._r8 - tanh(accum_factor*newsnow(c)))*(1._r8 - frac_sno(c)) + frac_sno(c) = fsno_new + + ! reset int_snow after accumulation events + temp_intsnow= (h2osno(c) + newsnow(c)) & + / (0.5*(cos(rpi*(1._r8-max(frac_sno(c),1e-6_r8))**(1./n_melt(c)))+1._r8)) + int_snow(c) = min(1.e8_r8,temp_intsnow) + endif + + !==================================================================== + + ! for subgrid fluxes + if (subgridflag ==1 .and. .not. lun%urbpoi(l)) then + if (frac_sno(c) > 0._r8)then + snow_depth(c)=snow_depth(c) + newsnow(c)/(bifall * frac_sno(c)) + else + snow_depth(c)=0._r8 + end if + else + ! for uniform snow cover + snow_depth(c)=snow_depth(c)+newsnow(c)/bifall + endif + + ! use original fsca formulation (n&y 07) + if (oldfflag == 1) then + ! snow cover fraction in Niu et al. 2007 + if(snow_depth(c) > 0.0_r8) then + frac_sno(c) = tanh(snow_depth(c)/(2.5_r8*zlnd* & + (min(800._r8,(h2osno(c)+ newsnow(c))/snow_depth(c))/100._r8)**1._r8) ) + endif + if(h2osno(c) < 1.0_r8) then + frac_sno(c)=min(frac_sno(c),h2osno(c)) + endif + endif + + else !h2osno == 0 + ! initialize frac_sno and snow_depth when no snow present initially + if (newsnow(c) > 0._r8) then + z_avg = newsnow(c)/bifall + fmelt=newsnow(c) + frac_sno(c) = tanh(accum_factor*newsnow(c)) + + ! make int_snow consistent w/ new fsno, h2osno + int_snow(c) = 0. !reset prior to adding newsnow below + temp_intsnow= (h2osno(c) + newsnow(c)) & + / (0.5*(cos(rpi*(1._r8-max(frac_sno(c),1e-6_r8))**(1./n_melt(c)))+1._r8)) + int_snow(c) = min(1.e8_r8,temp_intsnow) + + ! update snow_depth and h2osno to be consistent with frac_sno, z_avg + if (subgridflag ==1 .and. .not. lun%urbpoi(l)) then + snow_depth(c)=z_avg/frac_sno(c) + else + snow_depth(c)=newsnow(c)/bifall + endif + ! use n&y07 formulation + if (oldfflag == 1) then + ! snow cover fraction in Niu et al. 2007 + if(snow_depth(c) > 0.0_r8) then + frac_sno(c) = tanh(snow_depth(c)/(2.5_r8*zlnd* & + (min(800._r8,newsnow(c)/snow_depth(c))/100._r8)**1._r8) ) + endif + endif + else + z_avg = 0._r8 + snow_depth(c) = 0._r8 + frac_sno(c) = 0._r8 + endif + endif ! end of h2osno > 0 + + ! snow directly falling on surface water melts, increases h2osfc + qflx_snow_h2osfc(c) = frac_h2osfc(c)*qflx_snow_grnd_col(c) + + ! update h2osno for new snow + h2osno(c) = h2osno(c) + newsnow(c) + int_snow(c) = int_snow(c) + newsnow(c) + + ! update change in snow depth + dz_snowf = (snow_depth(c) - temp_snow_depth) / dtime + + end if !end of do_capsnow construct + + ! set frac_sno_eff variable + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (subgridflag ==1) then + frac_sno_eff(c) = frac_sno(c) + else + frac_sno_eff(c) = 1._r8 + endif + else + frac_sno_eff(c) = 1._r8 + endif + + if (lun%itype(l)==istwet .and. t_grnd(c)>tfrz) then + h2osno(c)=0._r8 + snow_depth(c)=0._r8 + end if + + ! When the snow accumulation exceeds 10 mm, initialize snow layer + ! Currently, the water temperature for the precipitation is simply set + ! as the surface air temperature + + newnode = 0 ! flag for when snow node will be initialized + if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_r8 .and. frac_sno(c)*snow_depth(c) >= 0.01_r8) then + newnode = 1 + snl(c) = -1 + dz(c,0) = snow_depth(c) ! meter + z(c,0) = -0.5_r8*dz(c,0) + zi(c,-1) = -dz(c,0) + t_soisno(c,0) = min(tfrz, forc_t(c)) ! K + h2osoi_ice(c,0) = h2osno(c) ! kg/m2 + h2osoi_liq(c,0) = 0._r8 ! kg/m2 + frac_iceold(c,0) = 1._r8 + + ! intitialize SNICAR variables for fresh snow: + call aerosol_inst%Reset(column=c) + call waterstate_inst%Reset(column=c) + end if + + ! The change of ice partial density of surface node due to precipitation. + ! Only ice part of snowfall is added here, the liquid part will be added + ! later. + + if (snl(c) < 0 .and. newnode == 0) then + h2osoi_ice(c,snl(c)+1) = h2osoi_ice(c,snl(c)+1)+newsnow(c) + dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime + end if + + end do + + ! update surface water fraction (this may modify frac_sno) + call FracH2oSfc(bounds, num_nolakec, filter_nolakec, & + waterstate_inst) + + end associate + + end subroutine CanopyHydrology + + !----------------------------------------------------------------------- + subroutine FracWet(numf, filter, canopystate_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Determine fraction of vegetated surfaces which are wet and + ! fraction of elai which is dry. The variable ``fwet'' is the + ! fraction of all vegetation surfaces which are wet including + ! stem area which contribute to evaporation. The variable ``fdry'' + ! is the fraction of elai which is dry because only leaves + ! can transpire. Adjusted for stem area which does not transpire. + ! + ! ! USES: + use clm_varcon , only : tfrz + ! !ARGUMENTS: + integer , intent(in) :: numf ! number of filter non-lake points + integer , intent(in) :: filter(numf) ! patch filter for non-lake points + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,p ! indices + real(r8) :: vegt ! lsai + real(r8) :: dewmxi ! inverse of maximum allowed dew [1/mm] + !----------------------------------------------------------------------- + + associate( & + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:)] fraction of veg not covered by snow (0/1 now) [-] + dewmx => canopystate_inst%dewmx_patch , & ! Input: [real(r8) (:) ] Maximum allowed dew [mm] + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + h2ocan => waterstate_inst%h2ocan_patch , & ! Input: [real(r8) (:) ] total canopy water (mm H2O) + snocan => waterstate_inst%snocan_patch , & ! Output: [real(r8) (:) ] canopy snow (mm H2O) + liqcan => waterstate_inst%liqcan_patch , & ! Output: [real(r8) (:) ] canopy liquid (mm H2O) + + fwet => waterstate_inst%fwet_patch , & ! Output: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) + fcansno => waterstate_inst%fcansno_patch , & ! Output: [real(r8) (:) ] fraction of canopy that is snow covered (0 to 1) + fdry => waterstate_inst%fdry_patch & ! Output: [real(r8) (:) ] fraction of foliage that is green and dry [-] (new) + ) + + ! Set status of snowveg_flag + snowveg_onrad = IsSnowvegFlagOnRad() + + do fp = 1,numf + p = filter(fp) + if (frac_veg_nosno(p) == 1) then + if (h2ocan(p) > 0._r8) then + vegt = frac_veg_nosno(p)*(elai(p) + esai(p)) + dewmxi = 1.0_r8/dewmx(p) + fwet(p) = ((dewmxi/vegt)*h2ocan(p))**0.666666666666_r8 + fwet(p) = min (fwet(p),1.0_r8) ! Check for maximum limit of fwet + if (snowveg_onrad) then + if (snocan(p) > 0._r8) then + dewmxi = 1.0_r8/dewmx(p) + fcansno(p) = ((dewmxi/(vegt*6.0_r8*10.0_r8))*snocan(p))**0.15_r8 ! must match snocanmx + fcansno(p) = min (fcansno(p),1.0_r8) + else + fcansno(p) = 0._r8 + end if + else + fcansno(p) = 0._r8 + end if + else + fwet(p) = 0._r8 + fcansno(p) = 0._r8 + end if + fdry(p) = (1._r8-fwet(p))*elai(p)/(elai(p)+esai(p)) + else + fwet(p) = 0._r8 + fdry(p) = 0._r8 + end if + end do + + end associate + end subroutine FracWet + + !----------------------------------------------------------------------- + subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & + waterstate_inst, no_update) + ! + ! !DESCRIPTION: + ! Determine fraction of land surfaces which are submerged + ! based on surface microtopography and surface water storage. + ! + ! !USES: + use shr_const_mod , only : shr_const_pi + use shr_spfn_mod , only : erf => shr_spfn_erf + use landunit_varcon , only : istsoil, istcrop + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_h2osfc ! number of column points in column filter + integer , intent(in) :: filter_h2osfc(:) ! column filter + type(waterstate_type) , intent(inout) :: waterstate_inst + integer , intent(in), optional :: no_update ! flag to make calculation w/o updating variables + ! + ! !LOCAL VARIABLES: + integer :: c,f,l ! indices + real(r8):: d,fd,dfdd ! temporary variable for frac_h2oscs iteration + real(r8):: sigma ! microtopography pdf sigma in mm + real(r8):: min_h2osfc + !----------------------------------------------------------------------- + + associate( & + micro_sigma => col%micro_sigma , & ! Input: [real(r8) (:) ] microtopography pdf sigma (m) + + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (col,lyr) [kg/m2] + h2osfc => waterstate_inst%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) + frac_sno => waterstate_inst%frac_sno_col , & ! Output: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Output: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col & ! Output: [real(r8) (:) ] col fractional area with surface water greater than zero + ) + + ! arbitrary lower limit on h2osfc for safer numerics... + min_h2osfc=1.e-8_r8 + + do f = 1, num_h2osfc + c = filter_h2osfc(f) + l = col%landunit(c) + + ! h2osfc only calculated for soil vegetated land units + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + ! Use newton-raphson method to iteratively determine frac_h20sfc + ! based on amount of surface water storage (h2osfc) and + ! microtopography variability (micro_sigma) + + if (h2osfc(c) > min_h2osfc) then + ! a cutoff is needed for numerical reasons...(nonconvergence after 5 iterations) + d=0.0 + + sigma=1.0e3 * micro_sigma(c) ! convert to mm + do l=1,10 + fd = 0.5*d*(1.0_r8+erf(d/(sigma*sqrt(2.0)))) & + +sigma/sqrt(2.0*shr_const_pi)*exp(-d**2/(2.0*sigma**2)) & + -h2osfc(c) + dfdd = 0.5*(1.0_r8+erf(d/(sigma*sqrt(2.0)))) + + d = d - fd/dfdd + enddo + !-- update the submerged areal fraction using the new d value + frac_h2osfc(c) = 0.5*(1.0_r8+erf(d/(sigma*sqrt(2.0)))) + + else + frac_h2osfc(c) = 0._r8 + h2osoi_liq(c,1) = h2osoi_liq(c,1) + h2osfc(c) + h2osfc(c)=0._r8 + endif + + if (.not. present(no_update)) then + + ! adjust fh2o, fsno when sum is greater than zero + if (frac_sno(c) > (1._r8 - frac_h2osfc(c)) .and. h2osno(c) > 0) then + + if (frac_h2osfc(c) > 0.01_r8) then + frac_h2osfc(c) = max(1.0_r8 - frac_sno(c),0.01_r8) + frac_sno(c) = 1.0_r8 - frac_h2osfc(c) + else + frac_sno(c) = 1.0_r8 - frac_h2osfc(c) + endif + frac_sno_eff(c)=frac_sno(c) + + endif + + endif ! end of no_update construct + + else !if landunit not istsoil/istcrop, set frac_h2osfc to zero + + frac_h2osfc(c) = 0._r8 + + endif + + end do + + end associate + + end subroutine FracH2OSfc + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: IsSnowvegFlagOff + ! + ! !INTERFACE: + ! + logical function IsSnowvegFlagOff( ) + ! + ! !DESCRIPTION: + ! + ! Return true if snowveg_flag is OFF + ! + ! !USES: + implicit none + !EOP + !----------------------------------------------------------------------- + + IsSnowvegFlagOff = (trim(snowveg_flag) == 'OFF') + + end function IsSnowvegFlagOff + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: IsSnowvegFlagOn + ! + ! !INTERFACE: + ! + logical function IsSnowvegFlagOn( ) + ! + ! !DESCRIPTION: + ! + ! Return true if snowveg_flag is ON + ! + ! !USES: + implicit none + !EOP + !----------------------------------------------------------------------- + + IsSnowvegFlagOn = (trim(snowveg_flag) == 'ON') + + end function IsSnowvegFlagOn + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: IsSnowvegFlagOnRad + ! + ! !INTERFACE: + ! + logical function IsSnowvegFlagOnRad( ) + ! + ! !DESCRIPTION: + ! + ! Return true if snowveg_flag is ON_RAD + ! + ! !USES: + implicit none + !EOP + !----------------------------------------------------------------------- + + IsSnowvegFlagOnRad = (trim(snowveg_flag) == 'ON_RAD') + + end function IsSnowvegFlagOnRad + +end module CanopyHydrologyMod diff --git a/components/clm/src/biogeophys/CanopyStateType.F90 b/components/clm/src/biogeophys/CanopyStateType.F90 new file mode 100644 index 0000000000..dc2c38e4b8 --- /dev/null +++ b/components/clm/src/biogeophys/CanopyStateType.F90 @@ -0,0 +1,554 @@ +module CanopyStateType + + !------------------------------------------------------------------------------ + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, shr_infnan_isnan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use landunit_varcon , only : istsoil, istcrop + use clm_varpar , only : nlevcan + use clm_varcon , only : spval + use clm_varctl , only : iulog, use_cn, use_ed + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + type, public :: CanopyState_type + + integer , pointer :: frac_veg_nosno_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-] + integer , pointer :: frac_veg_nosno_alb_patch (:) ! patch fraction of vegetation not covered by snow (0 OR 1) [-] + + real(r8) , pointer :: tlai_patch (:) ! patch canopy one-sided leaf area index, no burying by snow + real(r8) , pointer :: tsai_patch (:) ! patch canopy one-sided stem area index, no burying by snow + real(r8) , pointer :: elai_patch (:) ! patch canopy one-sided leaf area index with burying by snow + real(r8) , pointer :: esai_patch (:) ! patch canopy one-sided stem area index with burying by snow + real(r8) , pointer :: elai240_patch (:) ! patch canopy one-sided leaf area index with burying by snow average over 10days + real(r8) , pointer :: laisun_patch (:) ! patch patch sunlit projected leaf area index + real(r8) , pointer :: laisha_patch (:) ! patch patch shaded projected leaf area index + real(r8) , pointer :: laisun_z_patch (:,:) ! patch patch sunlit leaf area for canopy layer + real(r8) , pointer :: laisha_z_patch (:,:) ! patch patch shaded leaf area for canopy layer + real(r8) , pointer :: mlaidiff_patch (:) ! patch difference between lai month one and month two (for dry deposition of chemical tracers) + real(r8) , pointer :: annlai_patch (:,:) ! patch 12 months of monthly lai from input data set (for dry deposition of chemical tracers) + real(r8) , pointer :: htop_patch (:) ! patch canopy top (m) + real(r8) , pointer :: hbot_patch (:) ! patch canopy bottom (m) + real(r8) , pointer :: displa_patch (:) ! patch displacement height (m) + real(r8) , pointer :: fsun_patch (:) ! patch sunlit fraction of canopy + real(r8) , pointer :: fsun24_patch (:) ! patch 24hr average of sunlit fraction of canopy + real(r8) , pointer :: fsun240_patch (:) ! patch 240hr average of sunlit fraction of canopy + + real(r8) , pointer :: alt_col (:) ! col current depth of thaw + integer , pointer :: alt_indx_col (:) ! col current depth of thaw + real(r8) , pointer :: altmax_col (:) ! col maximum annual depth of thaw + real(r8) , pointer :: altmax_lastyear_col (:) ! col prior year maximum annual depth of thaw + integer , pointer :: altmax_indx_col (:) ! col maximum annual depth of thaw + integer , pointer :: altmax_lastyear_indx_col (:) ! col prior year maximum annual depth of thaw + + real(r8) , pointer :: dewmx_patch (:) ! patch maximum allowed dew [mm] + + real(r8) , pointer :: rscanopy_patch (:) ! patch canopy stomatal resistance (s/m) (ED specific) + real(r8) , pointer :: gccanopy_patch (:) ! patch (ED specific) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars + procedure, public :: Restart + + end type CanopyState_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%frac_veg_nosno_patch (begp:endp)) ; this%frac_veg_nosno_patch (:) = huge(1) + allocate(this%frac_veg_nosno_alb_patch (begp:endp)) ; this%frac_veg_nosno_alb_patch (:) = 0 + allocate(this%tlai_patch (begp:endp)) ; this%tlai_patch (:) = nan + allocate(this%tsai_patch (begp:endp)) ; this%tsai_patch (:) = nan + allocate(this%elai_patch (begp:endp)) ; this%elai_patch (:) = nan + allocate(this%elai240_patch (begp:endp)) ; this%elai240_patch (:) = nan + allocate(this%esai_patch (begp:endp)) ; this%esai_patch (:) = nan + allocate(this%laisun_patch (begp:endp)) ; this%laisun_patch (:) = nan + allocate(this%laisha_patch (begp:endp)) ; this%laisha_patch (:) = nan + allocate(this%laisun_z_patch (begp:endp,1:nlevcan)) ; this%laisun_z_patch (:,:) = nan + allocate(this%laisha_z_patch (begp:endp,1:nlevcan)) ; this%laisha_z_patch (:,:) = nan + allocate(this%mlaidiff_patch (begp:endp)) ; this%mlaidiff_patch (:) = nan + allocate(this%annlai_patch (12,begp:endp)) ; this%annlai_patch (:,:) = nan + allocate(this%htop_patch (begp:endp)) ; this%htop_patch (:) = nan + allocate(this%hbot_patch (begp:endp)) ; this%hbot_patch (:) = nan + allocate(this%displa_patch (begp:endp)) ; this%displa_patch (:) = nan + allocate(this%fsun_patch (begp:endp)) ; this%fsun_patch (:) = nan + allocate(this%fsun24_patch (begp:endp)) ; this%fsun24_patch (:) = nan + allocate(this%fsun240_patch (begp:endp)) ; this%fsun240_patch (:) = nan + + allocate(this%alt_col (begc:endc)) ; this%alt_col (:) = spval + allocate(this%altmax_col (begc:endc)) ; this%altmax_col (:) = spval + allocate(this%altmax_lastyear_col (begc:endc)) ; this%altmax_lastyear_col (:) = spval + allocate(this%alt_indx_col (begc:endc)) ; this%alt_indx_col (:) = huge(1) + allocate(this%altmax_indx_col (begc:endc)) ; this%altmax_indx_col (:) = huge(1) + allocate(this%altmax_lastyear_indx_col (begc:endc)) ; this%altmax_lastyear_indx_col (:) = huge(1) + + allocate(this%dewmx_patch (begp:endp)) ; this%dewmx_patch (:) = nan + + allocate(this%rscanopy_patch (begp:endp)) ; this%rscanopy_patch (:) = nan + allocate(this%gccanopy_patch (begp:endp)) ; this%gccanopy_patch (:) = 0.0_r8 + + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begp, endp + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%elai_patch(begp:endp) = spval + call hist_addfld1d (fname='ELAI', units='m^2/m^2', & + avgflag='A', long_name='exposed one-sided leaf area index', & + ptr_patch=this%elai_patch) + + this%esai_patch(begp:endp) = spval + call hist_addfld1d (fname='ESAI', units='m^2/m^2', & + avgflag='A', long_name='exposed one-sided stem area index', & + ptr_patch=this%esai_patch) + + this%tlai_patch(begp:endp) = spval + call hist_addfld1d (fname='TLAI', units='none', & + avgflag='A', long_name='total projected leaf area index', & + ptr_patch=this%tlai_patch) + + this%tsai_patch(begp:endp) = spval + call hist_addfld1d (fname='TSAI', units='none', & + avgflag='A', long_name='total projected stem area index', & + ptr_patch=this%tsai_patch) + + this%laisun_patch(begp:endp) = spval + call hist_addfld1d (fname='LAISUN', units='none', & + avgflag='A', long_name='sunlit projected leaf area index', & + ptr_patch=this%laisun_patch, set_urb=0._r8) + + this%laisha_patch(begp:endp) = spval + call hist_addfld1d (fname='LAISHA', units='none', & + avgflag='A', long_name='shaded projected leaf area index', & + ptr_patch=this%laisha_patch, set_urb=0._r8) + + if (use_cn .or. use_ed) then + this%fsun_patch(begp:endp) = spval + call hist_addfld1d (fname='FSUN', units='proportion', & + avgflag='A', long_name='sunlit fraction of canopy', & + ptr_patch=this%fsun_patch, default='inactive') + + this%dewmx_patch(begp:endp) = spval + call hist_addfld1d (fname='DEWMX', units='mm', & + avgflag='A', long_name='Maximum allowed dew', & + ptr_patch=this%dewmx_patch, default='inactive') + + this%htop_patch(begp:endp) = spval + call hist_addfld1d (fname='HTOP', units='m', & + avgflag='A', long_name='canopy top', & + ptr_patch=this%htop_patch) + + this%hbot_patch(begp:endp) = spval + call hist_addfld1d (fname='HBOT', units='m', & + avgflag='A', long_name='canopy bottom', & + ptr_patch=this%hbot_patch, default='inactive') + + this%displa_patch(begp:endp) = spval + call hist_addfld1d (fname='DISPLA', units='m', & + avgflag='A', long_name='displacement height', & + ptr_patch=this%displa_patch, default='inactive') + end if + + if (use_cn) then + this%alt_col(begc:endc) = spval + call hist_addfld1d (fname='ALT', units='m', & + avgflag='A', long_name='current active layer thickness', & + ptr_col=this%alt_col) + + this%altmax_col(begc:endc) = spval + call hist_addfld1d (fname='ALTMAX', units='m', & + avgflag='A', long_name='maximum annual active layer thickness', & + ptr_col=this%altmax_col) + + this%altmax_lastyear_col(begc:endc) = spval + call hist_addfld1d (fname='ALTMAX_LASTYEAR', units='m', & + avgflag='A', long_name='maximum prior year active layer thickness', & + ptr_col=this%altmax_lastyear_col) + end if + + ! Allow active layer fields to be optionally output even if not running CN + + if (.not. use_cn) then + this%alt_col(begc:endc) = spval + call hist_addfld1d (fname='ALT', units='m', & + avgflag='A', long_name='current active layer thickness', & + ptr_col=this%alt_col, default='inactive') + + this%altmax_col(begc:endc) = spval + call hist_addfld1d (fname='ALTMAX', units='m', & + avgflag='A', long_name='maximum annual active layer thickness', & + ptr_col=this%altmax_col, default='inactive') + + this%altmax_lastyear_col(begc:endc) = spval + call hist_addfld1d (fname='ALTMAX_LASTYEAR', units='m', & + avgflag='A', long_name='maximum prior year active layer thickness', & + ptr_col=this%altmax_lastyear_col, default='inactive') + end if + + + + ! Accumulated fields + this%fsun24_patch(begp:endp) = spval + call hist_addfld1d (fname='FSUN24', units='K', & + avgflag='A', long_name='fraction sunlit (last 24hrs)', & + ptr_patch=this%fsun24_patch, default='inactive') + + this%fsun240_patch(begp:endp) = spval + call hist_addfld1d (fname='FSUN240', units='K', & + avgflag='A', long_name='fraction sunlit (last 240hrs)', & + ptr_patch=this%fsun240_patch, default='inactive') + + this%elai240_patch(begp:endp) = spval + call hist_addfld1d (fname='LAI240', units='m^2/m^2', & + avgflag='A', long_name='240hr average of leaf area index', & + ptr_patch=this%elai240_patch, default='inactive') + + ! Ed specific field + this%rscanopy_patch(begp:endp) = spval + call hist_addfld1d (fname='RSCANOPY', units=' s m-1', & + avgflag='A', long_name='canopy resistance', & + ptr_patch=this%rscanopy_patch, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='GCCANOPY', units='none', & + avgflag='A', long_name='Canopy Conductance: mmol m-2 s-1', & + ptr_patch=this%GCcanopy_patch, set_lake=0._r8, set_urb=0._r8) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! + ! !USES + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + !--------------------------------------------------------------------- + + this%fsun24_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSUN24', units='fraction', & + desc='24hr average of diffuse solar radiation', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%fsun240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSUN240', units='fraction', & + desc='240hr average of diffuse solar radiation', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%elai240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='LAI240', units='m2/m2', & + desc='240hr average of leaf area index', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES + use accumulMod , only : extract_accum_field + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)' in ' + call endrun(msg="extract_accum_hist allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + ! Determine time step + nstep = get_nstep() + + call extract_accum_field ('FSUN24', rbufslp, nstep) + this%fsun24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('FSUN240', rbufslp, nstep) + this%fsun240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('LAI240', rbufslp, nstep) + this%elai240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('FSUN24', rbufslp, nstep) + this%fsun24_patch(begp:endp) = rbufslp(begp:endp) + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine UpdateAccVars (this, bounds) + ! + ! USES + use clm_time_manager, only : get_nstep + use accumulMod , only : update_accum_field, extract_accum_field + use abortutils , only : endrun + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,p ! indices + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: ier ! error status + integer :: begp, endp + real(r8), pointer :: rbufslp(:) ! temporary single level - patch level + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + nstep = get_nstep() + + ! Allocate needed dynamic memory for single level patch field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate and extract fsun24 & fsun240 + do p = begp,endp + rbufslp(p) = this%fsun_patch(p) + end do + call update_accum_field ('FSUN24' , rbufslp , nstep) + call extract_accum_field ('FSUN24' , this%fsun24_patch , nstep) + call update_accum_field ('FSUN240', rbufslp , nstep) + call extract_accum_field ('FSUN240', this%fsun240_patch , nstep) + + ! Accumulate and extract elai240 + do p = begp,endp + rbufslp(p) = this%elai_patch(p) + end do + call update_accum_field ('LAI240', rbufslp , nstep) + call extract_accum_field ('LAI240', this%elai240_patch , nstep) + + deallocate(rbufslp) + + end subroutine UpdateAccVars + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l,c,g + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + l = patch%landunit(p) + + this%frac_veg_nosno_patch(p) = 0._r8 + this%tlai_patch(p) = 0._r8 + this%tsai_patch(p) = 0._r8 + this%elai_patch(p) = 0._r8 + this%esai_patch(p) = 0._r8 + this%htop_patch(p) = 0._r8 + this%hbot_patch(p) = 0._r8 + this%dewmx_patch(p) = 0.1_r8 + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%laisun_patch(p) = 0._r8 + this%laisha_patch(p) = 0._r8 + end if + + ! needs to be initialized to spval to avoid problems when averaging for the accum + ! field + this%fsun_patch(p) = spval + end do + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%alt_col(c) = 0._r8 !iniitialized to spval for all columns + this%altmax_col(c) = 0._r8 !iniitialized to spval for all columns + this%altmax_lastyear_col(c) = 0._r8 !iniitialized to spval for all columns + this%alt_indx_col(c) = 0 !initiialized to huge for all columns + this%altmax_indx_col(c) = 0 !initiialized to huge for all columns + this%altmax_lastyear_indx_col = 0 !initiialized to huge for all columns + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(canopystate_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,iv ! indices + logical :: readvar ! determine if variable is on initial file + integer :: begp, endp + !----------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + call restartvar(ncid=ncid, flag=flag, varname='FRAC_VEG_NOSNO_ALB', xtype=ncd_int, & + dim1name='pft', long_name='fraction of vegetation not covered by snow (0 or 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frac_veg_nosno_alb_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tlai', xtype=ncd_double, & + dim1name='pft', long_name='one-sided leaf area index, no burying by snow', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tlai_patch) + + call restartvar(ncid=ncid, flag=flag, varname='tsai', xtype=ncd_double, & + dim1name='pft', long_name='one-sided stem area index, no burying by snow', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tsai_patch) + + call restartvar(ncid=ncid, flag=flag, varname='elai', xtype=ncd_double, & + dim1name='pft', long_name='one-sided leaf area index, with burying by snow', units='', & + interpinic_flag='interp', readvar=readvar, data=this%elai_patch) + + call restartvar(ncid=ncid, flag=flag, varname='esai', xtype=ncd_double, & + dim1name='pft', long_name='one-sided stem area index, with burying by snow', units='', & + interpinic_flag='interp', readvar=readvar, data=this%esai_patch) + + call restartvar(ncid=ncid, flag=flag, varname='htop', xtype=ncd_double, & + dim1name='pft', long_name='canopy top', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%htop_patch) + + call restartvar(ncid=ncid, flag=flag, varname='hbot', xtype=ncd_double, & + dim1name='pft', long_name='canopy botton', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%hbot_patch) + + call restartvar(ncid=ncid, flag=flag, varname='mlaidiff', xtype=ncd_double, & + dim1name='pft', long_name='difference between lai month one and month two', units='', & + interpinic_flag='interp', readvar=readvar, data=this%mlaidiff_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fsun', xtype=ncd_double, & + dim1name='pft', long_name='sunlit fraction of canopy', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fsun_patch) + if (flag=='read' )then + do p = bounds%begp,bounds%endp + if (shr_infnan_isnan(this%fsun_patch(p)) ) then + this%fsun_patch(p) = spval + end if + end do + end if + + if (use_cn) then + call restartvar(ncid=ncid, flag=flag, varname='altmax', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%altmax_col) + + call restartvar(ncid=ncid, flag=flag, varname='altmax_lastyear', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%altmax_lastyear_col) + + call restartvar(ncid=ncid, flag=flag, varname='altmax_indx', xtype=ncd_int, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%altmax_indx_col) + + call restartvar(ncid=ncid, flag=flag, varname='altmax_lastyear_indx', xtype=ncd_int, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%altmax_lastyear_indx_col) + end if + + end subroutine Restart + +end module CanopyStateType diff --git a/components/clm/src/biogeophys/CanopyTemperatureMod.F90 b/components/clm/src/biogeophys/CanopyTemperatureMod.F90 new file mode 100644 index 0000000000..48ab99c5cc --- /dev/null +++ b/components/clm/src/biogeophys/CanopyTemperatureMod.F90 @@ -0,0 +1,487 @@ +module CanopyTemperatureMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! CanopyFluxes calculates the leaf temperature and the leaf fluxes, + ! transpiration, photosynthesis and updates the dew accumulation due to evaporation. + ! CanopyTemperature performs calculation of leaf temperature and surface fluxes. + ! SoilFluxes then determines soil/snow and ground temperatures and updates the surface + ! fluxes for the new ground temperature. + + ! + ! !USES: + use shr_sys_mod , only : shr_sys_flush + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_const_mod , only : SHR_CONST_PI + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use PhotosynthesisMod , only : Photosynthesis, PhotosynthesisTotal, Fractionation + use SurfaceResistanceMod , only : calc_soilevap_stress + use pftconMod , only : pftcon + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: CanopyTemperature + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine CanopyTemperature(bounds, & + num_nolakec, filter_nolakec, num_nolakep, filter_nolakep, & + atm2lnd_inst, canopystate_inst, soilstate_inst, frictionvel_inst, & + waterstate_inst, waterflux_inst, energyflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! This is the main subroutine to execute the calculation of leaf temperature + ! and surface fluxes. Subroutine SoilFluxes then determines soil/snow and ground + ! temperatures and updates the surface fluxes for the new ground temperature. + ! + ! Calling sequence is: + ! Biogeophysics1: surface biogeophysics driver + ! -> QSat: saturated vapor pressure, specific humidity, and + ! derivatives at ground surface and derivatives at + ! leaf surface using updated leaf temperature + ! Leaf temperature + ! Foliage energy conservation is given by the foliage energy budget + ! equation: + ! Rnet - Hf - LEf = 0 + ! The equation is solved by Newton-Raphson iteration, in which this + ! iteration includes the calculation of the photosynthesis and + ! stomatal resistance, and the integration of turbulent flux profiles. + ! The sensible and latent heat transfer between foliage and atmosphere + ! and ground is linked by the equations: + ! Ha = Hf + Hg and Ea = Ef + Eg + ! + ! !USES: + use QSatMod , only : QSat + use clm_varcon , only : denh2o, denice, roverg, hvap, hsub, zlnd, zsno, tfrz, spval + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_imperv, icol_road_perv + use landunit_varcon , only : istice, istice_mec, istwet, istsoil, istdlak, istcrop, istdlak + use clm_varpar , only : nlevgrnd, nlevurb, nlevsno, nlevsoi + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_nolakep ! number of column non-lake points in patch filter + integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p ! indices + integer :: j ! soil/snow level index + integer :: fp ! lake filter patch index + integer :: fc ! lake filter column index + real(r8) :: qred ! soil surface relative humidity + real(r8) :: avmuir ! ir inverse optical depth per unit leaf area + real(r8) :: eg ! water vapor pressure at temperature T [pa] + real(r8) :: qsatg ! saturated humidity [kg/kg] + real(r8) :: degdT ! d(eg)/dT + real(r8) :: qsatgdT ! d(qsatg)/dT + real(r8) :: fac ! soil wetness of surface layer + real(r8) :: psit ! negative potential of soil + real(r8) :: hr ! relative humidity + real(r8) :: hr_road_perv ! relative humidity for urban pervious road + real(r8) :: wx ! partial volume of ice and water of surface layer + real(r8) :: fac_fc ! soil wetness of surface layer relative to field capacity + real(r8) :: eff_porosity ! effective porosity in layer + real(r8) :: vol_ice ! partial volume of ice lens in layer + real(r8) :: vol_liq ! partial volume of liquid water in layer + real(r8) :: fh2o_eff(bounds%begc:bounds%endc) ! effective surface water fraction (i.e. seen by atm) + !------------------------------------------------------------------------------ + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zii => col%zii , & ! Output: [real(r8) (:) ] convective boundary height [m] + z_0_town => lun%z_0_town , & ! Input: [real(r8) (:) ] momentum roughness length of urban landunit (m) + z_d_town => lun%z_d_town , & ! Input: [real(r8) (:) ] displacement height of urban landunit (m) + urbpoi => lun%urbpoi , & ! Input: [logical (:) ] true => landunit is an urban point + + z0mr => pftcon%z0mr , & ! Input: ratio of momentum roughness length to canopy top height (-) + displar => pftcon%displar , & ! Input: ratio of displacement height to canopy top height (-) + + forc_hgt_t => atm2lnd_inst%forc_hgt_t_grc , & ! Input: [real(r8) (:) ] observational height of temperature [m] + forc_u => atm2lnd_inst%forc_u_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in east direction (m/s) + forc_v => atm2lnd_inst%forc_v_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in north direction (m/s) + forc_hgt_u => atm2lnd_inst%forc_hgt_u_grc , & ! Input: [real(r8) (:) ] observational height of wind [m] + forc_hgt_q => atm2lnd_inst%forc_hgt_q_grc , & ! Input: [real(r8) (:) ] observational height of specific humidity [m] + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) + + + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + qg_snow => waterstate_inst%qg_snow_col , & ! Output: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_soil => waterstate_inst%qg_soil_col , & ! Output: [real(r8) (:) ] specific humidity at soil surface [kg/kg] + qg => waterstate_inst%qg_col , & ! Output: [real(r8) (:) ] ground specific humidity [kg/kg] + qg_h2osfc => waterstate_inst%qg_h2osfc_col , & ! Output: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] + dqgdT => waterstate_inst%dqgdT_col , & ! Output: [real(r8) (:) ] d(qg)/dT + + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_evap_veg => waterflux_inst%qflx_evap_veg_patch , & ! Output: [real(r8) (:) ] vegetation evaporation (mm H2O/s) (+ = to atm) + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Output: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + + htvp => energyflux_inst%htvp_col , & ! Output: [real(r8) (:) ] latent heat of vapor of water (or sublimation) [j/kg] + cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] + cgrnds => energyflux_inst%cgrnds_patch , & ! Output: [real(r8) (:) ] deriv. of soil sensible heat flux wrt soil temp [w/m2/k] + cgrndl => energyflux_inst%cgrndl_patch , & ! Output: [real(r8) (:) ] deriv. of soil latent heat flux wrt soil temp [w/m**2/k] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_tot_r => energyflux_inst%eflx_sh_tot_r_patch , & ! Output: [real(r8) (:) ] rural total sensible heat flux (W/m**2) [+ to atm] + eflx_lh_tot_u => energyflux_inst%eflx_lh_tot_u_patch , & ! Output: [real(r8) (:) ] urban total latent heat flux (W/m**2) [+ to atm] + eflx_lh_tot => energyflux_inst%eflx_lh_tot_patch , & ! Output: [real(r8) (:) ] total latent heat flux (W/m**2) [+ to atm] + eflx_lh_tot_r => energyflux_inst%eflx_lh_tot_r_patch , & ! Output: [real(r8) (:) ] rural total latent heat flux (W/m**2) [+ to atm] + eflx_sh_tot_u => energyflux_inst%eflx_sh_tot_u_patch , & ! Output: [real(r8) (:) ] urban total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] + + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at patch level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Input: [real(r8) (:) ] observational height of specific humidity at patch level [m] + z0m => frictionvel_inst%z0m_patch , & ! Output: [real(r8) (:) ] momentum roughness length (m) + z0mv => frictionvel_inst%z0mv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, momentum [m] + z0hv => frictionvel_inst%z0hv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, sensible heat [m] + z0qv => frictionvel_inst%z0qv_patch , & ! Output: [real(r8) (:) ] roughness length over vegetation, latent heat [m] + z0hg => frictionvel_inst%z0hg_col , & ! Output: [real(r8) (:) ] roughness length over ground, sensible heat [m] + z0mg => frictionvel_inst%z0mg_col , & ! Output: [real(r8) (:) ] roughness length over ground, momentum [m] + z0qg => frictionvel_inst%z0qg_col , & ! Output: [real(r8) (:) ] roughness length over ground, latent heat [m] + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Output: [real(r8) (:) ] observational height of wind at patch level [m] + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + htop => canopystate_inst%htop_patch , & ! Input: [real(r8) (:) ] canopy top (m) + displa => canopystate_inst%displa_patch , & ! Output: [real(r8) (:) ] displacement height (m) + + smpmin => soilstate_inst%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at field capacity + watdry => soilstate_inst%watdry_col , & ! Input: [real(r8) (:,:) ] volumetric soil moisture corresponding to no restriction on ET from urban pervious surface + watopt => soilstate_inst%watopt_col , & ! Input: [real(r8) (:,:) ] volumetric soil moisture corresponding to no restriction on ET from urban pervious surface + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + rootfr_road_perv => soilstate_inst%rootfr_road_perv_col , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer for urban pervious road + rootr_road_perv => soilstate_inst%rootr_road_perv_col , & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer for urban pervious road + soilalpha => soilstate_inst%soilalpha_col , & ! Output: [real(r8) (:) ] factor that reduces ground saturated specific humidity (-) + soilalpha_u => soilstate_inst%soilalpha_u_col , & ! Output: [real(r8) (:) ] Urban factor that reduces ground saturated specific humidity (-) + + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + beta => temperature_inst%beta_col , & ! Output: [real(r8) (:) ] coefficient of convective velocity [-] + emg => temperature_inst%emg_col , & ! Output: [real(r8) (:) ] ground emissivity + emv => temperature_inst%emv_patch , & ! Output: [real(r8) (:) ] vegetation emissivity + t_h2osfc_bef => temperature_inst%t_h2osfc_bef_col , & ! Output: [real(r8) (:) ] saved surface water temperature + t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground temperature (Kelvin) + thv => temperature_inst%thv_col , & ! Output: [real(r8) (:) ] virtual potential temperature (kelvin) + thm => temperature_inst%thm_patch , & ! Output: [real(r8) (:) ] intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + tssbef => temperature_inst%t_ssbef_col & ! Output: [real(r8) (:,:) ] soil/snow temperature before update + ) + + do j = -nlevsno+1, nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) .and. j > nlevurb) then + tssbef(c,j) = spval + else + tssbef(c,j) = t_soisno(c,j) + end if + ! record t_h2osfc prior to updating + t_h2osfc_bef(c) = t_h2osfc(c) + end do + end do + + ! calculate moisture stress/resistance for soil evaporation + call calc_soilevap_stress(bounds, num_nolakec, filter_nolakec, soilstate_inst, waterstate_inst) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + + if (col%itype(c) == icol_road_perv) then + hr_road_perv = 0._r8 + end if + + ! begin calculations that relate only to the column level + ! Ground and soil temperatures from previous time step + + ! ground temperature is weighted average of exposed soil, snow, and h2osfc + if (snl(c) < 0) then + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = (1 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + endif + + ! Saturated vapor pressure, specific humidity and their derivatives + ! at ground surface + qred = 1._r8 + if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice & + .AND. lun%itype(l)/=istice_mec) then + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + wx = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1) + fac = min(1._r8, wx/watsat(c,1)) + fac = max( fac, 0.01_r8 ) + psit = -sucsat(c,1) * fac ** (-bsw(c,1)) + psit = max(smpmin(c), psit) + ! modify qred to account for h2osfc + hr = exp(psit/roverg/t_soisno(c,1)) + qred = (1._r8 - frac_sno(c) - frac_h2osfc(c))*hr & + + frac_sno(c) + frac_h2osfc(c) + soilalpha(c) = qred + + else if (col%itype(c) == icol_road_perv) then + ! Pervious road depends on water in total soil column + do j = 1, nlevsoi + if (t_soisno(c,j) >= tfrz) then + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity = watsat(c,j)-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + fac = min( max(vol_liq-watdry(c,j),0._r8) / (watopt(c,j)-watdry(c,j)), 1._r8 ) + else + fac = 0._r8 + end if + rootr_road_perv(c,j) = rootfr_road_perv(c,j)*fac + hr_road_perv = hr_road_perv + rootr_road_perv(c,j) + end do + ! Allows for sublimation of snow or dew on snow + qred = (1.-frac_sno(c))*hr_road_perv + frac_sno(c) + + ! Normalize root resistances to get layer contribution to total ET + if (hr_road_perv > 0._r8) then + do j = 1, nlevsoi + rootr_road_perv(c,j) = rootr_road_perv(c,j)/hr_road_perv + end do + end if + soilalpha_u(c) = qred + + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then + qred = 0._r8 + soilalpha_u(c) = spval + + else if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then + qred = 1._r8 + soilalpha_u(c) = spval + end if + + else + soilalpha(c) = spval + + end if + + ! compute humidities individually for snow, soil, h2osfc for vegetated landunits + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + call QSat(t_soisno(c,snl(c)+1), forc_pbot(c), eg, degdT, qsatg, qsatgdT) + if (qsatg > forc_q(c) .and. forc_q(c) > qsatg) then + qsatg = forc_q(c) + qsatgdT = 0._r8 + end if + + qg_snow(c) = qsatg + dqgdT(c) = frac_sno(c)*qsatgdT + + call QSat(t_soisno(c,1) , forc_pbot(c), eg, degdT, qsatg, qsatgdT) + if (qsatg > forc_q(c) .and. forc_q(c) > hr*qsatg) then + qsatg = forc_q(c) + qsatgdT = 0._r8 + end if + qg_soil(c) = hr*qsatg + dqgdT(c) = dqgdT(c) + (1._r8 - frac_sno(c) - frac_h2osfc(c))*hr*qsatgdT + + ! to be consistent with hs_top values in SoilTemp, set qg_snow to qg_soil for snl = 0 case + ! this ensures hs_top_snow will equal hs_top_soil + if (snl(c) >= 0) then + qg_snow(c) = qg_soil(c) + dqgdT(c) = (1._r8 - frac_h2osfc(c))*hr*dqgdT(c) + endif + + call QSat(t_h2osfc(c), forc_pbot(c), eg, degdT, qsatg, qsatgdT) + if (qsatg > forc_q(c) .and. forc_q(c) > qsatg) then + qsatg = forc_q(c) + qsatgdT = 0._r8 + end if + qg_h2osfc(c) = qsatg + dqgdT(c) = dqgdT(c) + frac_h2osfc(c) * qsatgdT + + ! qg(c) = frac_sno(c)*qg_snow(c) + (1._r8 - frac_sno(c) - frac_h2osfc(c))*qg_soil(c) & + qg(c) = frac_sno_eff(c)*qg_snow(c) + (1._r8 - frac_sno_eff(c) - frac_h2osfc(c))*qg_soil(c) & + + frac_h2osfc(c) * qg_h2osfc(c) + + else + call QSat(t_grnd(c), forc_pbot(c), eg, degdT, qsatg, qsatgdT) + qg(c) = qred*qsatg + dqgdT(c) = qred*qsatgdT + + if (qsatg > forc_q(c) .and. forc_q(c) > qred*qsatg) then + qg(c) = forc_q(c) + dqgdT(c) = 0._r8 + end if + + qg_snow(c) = qg(c) + qg_soil(c) = qg(c) + qg_h2osfc(c) = qg(c) + endif + + ! Ground emissivity - only calculate for non-urban landunits + ! Urban emissivities are currently read in from data file + + if (.not. urbpoi(l)) then + if (lun%itype(l)==istice .or. lun%itype(l)==istice_mec) then + emg(c) = 0.97_r8 + else + emg(c) = (1._r8-frac_sno(c))*0.96_r8 + frac_sno(c)*0.97_r8 + end if + end if + + ! Latent heat. We arbitrarily assume that the sublimation occurs + ! only as h2osoi_liq = 0 + + htvp(c) = hvap + if (h2osoi_liq(c,snl(c)+1) <= 0._r8 .and. h2osoi_ice(c,snl(c)+1) > 0._r8) htvp(c) = hsub + + ! Ground roughness lengths over non-lake columns (includes bare ground, ground + ! underneath canopy, wetlands, etc.) + + if (frac_sno(c) > 0._r8) then + z0mg(c) = zsno + else + z0mg(c) = zlnd + end if + z0hg(c) = z0mg(c) ! initial set only + z0qg(c) = z0mg(c) ! initial set only + + ! Potential, virtual potential temperature, and wind speed at the + ! reference height + + beta(c) = 1._r8 + zii(c) = 1000._r8 + thv(c) = forc_th(c)*(1._r8+0.61_r8*forc_q(c)) + + end do ! (end of columns loop) + + ! Initialization + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + + ! Initial set (needed for history tape fields) + + eflx_sh_tot(p) = 0._r8 + l = patch%landunit(p) + if (urbpoi(l)) then + eflx_sh_tot_u(p) = 0._r8 + else if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_sh_tot_r(p) = 0._r8 + end if + eflx_lh_tot(p) = 0._r8 + if (urbpoi(l)) then + eflx_lh_tot_u(p) = 0._r8 + else if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_lh_tot_r(p) = 0._r8 + end if + eflx_sh_veg(p) = 0._r8 + qflx_evap_tot(p) = 0._r8 + qflx_evap_veg(p) = 0._r8 + qflx_tran_veg(p) = 0._r8 + + ! Initial set for calculation + + cgrnd(p) = 0._r8 + cgrnds(p) = 0._r8 + cgrndl(p) = 0._r8 + + ! Vegetation Emissivity + + avmuir = 1._r8 + emv(p) = 1._r8-exp(-(elai(p)+esai(p))/avmuir) + + ! Roughness lengths over vegetation + + z0m(p) = z0mr(patch%itype(p)) * htop(p) + displa(p) = displar(patch%itype(p)) * htop(p) + + z0mv(p) = z0m(p) + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) + end do + + ! Make forcing height a patch-level quantity that is the atmospheric forcing + ! height plus each patch's z0m+displa + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + g = patch%gridcell(p) + l = patch%landunit(p) + c = patch%column(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (frac_veg_nosno(p) == 0) then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + displa(p) + else + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0m(p) + displa(p) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0m(p) + displa(p) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0m(p) + displa(p) + end if + else if (lun%itype(l) == istwet .or. lun%itype(l) == istice & + .or. lun%itype(l) == istice_mec) then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z0mg(c) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z0mg(c) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z0mg(c) + ! Appropriate momentum roughness length will be added in LakeFLuxesMod. + else if (lun%itype(l) == istdlak) then + forc_hgt_u_patch(p) = forc_hgt_u(g) + forc_hgt_t_patch(p) = forc_hgt_t(g) + forc_hgt_q_patch(p) = forc_hgt_q(g) + else if (urbpoi(l)) then + forc_hgt_u_patch(p) = forc_hgt_u(g) + z_0_town(l) + z_d_town(l) + forc_hgt_t_patch(p) = forc_hgt_t(g) + z_0_town(l) + z_d_town(l) + forc_hgt_q_patch(p) = forc_hgt_q(g) + z_0_town(l) + z_d_town(l) + end if + end if + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + + thm(p) = forc_t(c) + 0.0098_r8*forc_hgt_t_patch(p) + end do + + end associate + + end subroutine CanopyTemperature + +end module CanopyTemperatureMod diff --git a/components/clm/src/biogeophys/DaylengthMod.F90 b/components/clm/src/biogeophys/DaylengthMod.F90 new file mode 100644 index 0000000000..138667c5a0 --- /dev/null +++ b/components/clm/src/biogeophys/DaylengthMod.F90 @@ -0,0 +1,158 @@ +module DaylengthMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Computes daylength + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use GridcellType , only : grc + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: daylength ! function to compute daylength + public :: InitDaylength ! initialize daylength for all grid cells + public :: UpdateDaylength ! update daylength for all grid cells + ! + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + elemental real(r8) function daylength(lat, decl) + ! + ! !DESCRIPTION: + ! Computes daylength (in seconds) + ! + ! Latitude and solar declination angle should both be specified in radians. decl must + ! be strictly less than pi/2; lat must be less than pi/2 within a small tolerance. + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, & + assignment(=) + use shr_const_mod , only : SHR_CONST_PI + ! + ! !ARGUMENTS: + real(r8), intent(in) :: lat ! latitude (radians) + real(r8), intent(in) :: decl ! solar declination angle (radians) + ! + ! !LOCAL VARIABLES: + real(r8) :: my_lat ! local version of lat, possibly adjusted slightly + real(r8) :: temp ! temporary variable + + ! number of seconds per radian of hour-angle + real(r8), parameter :: secs_per_radian = 13750.9871_r8 + + ! epsilon for defining latitudes "near" the pole + real(r8), parameter :: lat_epsilon = 10._r8 * epsilon(1._r8) + + ! Define an offset pole as slightly less than pi/2 to avoid problems with cos(lat) being negative + real(r8), parameter :: pole = SHR_CONST_PI/2.0_r8 + real(r8), parameter :: offset_pole = pole - lat_epsilon + !----------------------------------------------------------------------- + + ! Can't SHR_ASSERT in an elemental function; instead, return a bad value if any + ! preconditions are violated + + ! lat must be less than pi/2 within a small tolerance + if (abs(lat) >= (pole + lat_epsilon)) then + daylength = nan + + ! decl must be strictly less than pi/2 + else if (abs(decl) >= pole) then + daylength = nan + + ! normal case + else + ! Ensure that latitude isn't too close to pole, to avoid problems with cos(lat) being negative + my_lat = min(offset_pole, max(-1._r8 * offset_pole, lat)) + + temp = -(sin(my_lat)*sin(decl))/(cos(my_lat) * cos(decl)) + temp = min(1._r8,max(-1._r8,temp)) + daylength = 2.0_r8 * secs_per_radian * acos(temp) + end if + + end function daylength + + + !----------------------------------------------------------------------- + subroutine InitDaylength(bounds, declin, declinm1) + ! + ! !DESCRIPTION: + ! Initialize daylength for all grid cells, and initialize previous daylength. + ! + ! This should be called with declin set at the value for the first model time step, + ! and declinm1 at the value for the previous time step + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: declin ! solar declination angle for the first model time step (radians) + real(r8), intent(in) :: declinm1 ! solar declination angle for the previous time step (radians) + ! + !----------------------------------------------------------------------- + + associate(& + lat => grc%lat, & ! Input: [real(r8) (:)] latitude (radians) + dayl => grc%dayl, & ! Output: [real(r8) (:)] day length (s) + prev_dayl => grc%prev_dayl, & ! Output: [real(r8) (:)] day length from previous time step (s) + + begg => bounds%begg , & ! beginning grid cell index + endg => bounds%endg & ! ending grid cell index + ) + + prev_dayl(begg:endg) = daylength(lat(begg:endg), declinm1) + dayl(begg:endg) = daylength(lat(begg:endg), declin) + + end associate + + end subroutine InitDaylength + + + !----------------------------------------------------------------------- + subroutine UpdateDaylength(bounds, declin) + ! + ! !DESCRIPTION: + ! Update daylength for all grid cells, and set previous daylength. This should be + ! called exactly once per time step. + ! + ! Assumes that InitDaylength has been called in initialization. This Update routine + ! should NOT be called in initialization. + ! + ! !USES: + use clm_time_manager, only : is_first_step_of_this_run_segment + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: declin ! solar declination angle (radians) + ! + !----------------------------------------------------------------------- + + associate(& + lat => grc%lat, & ! Input: [real(r8) (:)] latitude (radians) + dayl => grc%dayl, & ! InOut: [real(r8) (:)] day length (s) + prev_dayl => grc%prev_dayl, & ! Output: [real(r8) (:)] day length from previous time step (s) + + begg => bounds%begg , & ! beginning grid cell index + endg => bounds%endg & ! ending grid cell index + ) + + if (is_first_step_of_this_run_segment()) then + ! DO NOTHING + ! + ! In the first time step, we simply use dayl & prev_dayl that were set in + ! initialization. (We do NOT want to run the normal code in that case, because that + ! would incorrectly set prev_dayl to be the same as the current dayl in the first + ! time step, because of the way prev_dayl is initialized.) + else + prev_dayl(begg:endg) = dayl(begg:endg) + dayl(begg:endg) = daylength(lat(begg:endg), declin) + end if + + end associate + + end subroutine UpdateDaylength + +end module DaylengthMod diff --git a/components/clm/src/biogeophys/EnergyFluxType.F90 b/components/clm/src/biogeophys/EnergyFluxType.F90 new file mode 100644 index 0000000000..f76356ffa6 --- /dev/null +++ b/components/clm/src/biogeophys/EnergyFluxType.F90 @@ -0,0 +1,808 @@ +module EnergyFluxType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! Energy flux data structure + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : spval + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + save + private + ! + type, public :: energyflux_type + + ! Fluxes + real(r8), pointer :: eflx_sh_grnd_patch (:) ! patch sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_veg_patch (:) ! patch sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_snow_patch (:) ! patch sensible heat flux from snow (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_soil_patch (:) ! patch sensible heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_h2osfc_patch (:) ! patch sensible heat flux from surface water (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_patch (:) ! patch total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u_patch (:) ! patch urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_r_patch (:) ! patch rural total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_precip_conversion_col(:) ! col sensible heat flux from precipitation conversion (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_patch (:) ! patch total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_u_patch (:) ! patch urban total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_r_patch (:) ! patch rural total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vegt_patch (:) ! patch transpiration heat flux from veg (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vege_patch (:) ! patch evaporation heat flux from veg (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_grnd_patch (:) ! patch evaporation heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_soil_grnd_patch (:) ! patch soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_u_patch (:) ! patch urban soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_r_patch (:) ! patch rural soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_lwrad_net_patch (:) ! patch net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_r_patch (:) ! patch rural net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_u_patch (:) ! patch urban net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_out_patch (:) ! patch emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_out_r_patch (:) ! patch rural emitted infrared (longwave) rad (W/m**2) + real(r8), pointer :: eflx_lwrad_out_u_patch (:) ! patch urban emitted infrared (longwave) rad (W/m**2) + real(r8), pointer :: eflx_snomelt_col (:) ! col snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_r_col (:) ! col rural snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_u_col (:) ! col urban snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_gnet_patch (:) ! patch net heat flux into ground (W/m**2) + real(r8), pointer :: eflx_grnd_lake_patch (:) ! patch net heat flux into lake / snow surface, excluding light transmission (W/m**2) + real(r8), pointer :: eflx_dynbal_grc (:) ! grc dynamic land cover change conversion energy flux (W/m**2) + real(r8), pointer :: eflx_bot_col (:) ! col heat flux from beneath the soil or ice column (W/m**2) + real(r8), pointer :: eflx_fgr12_col (:) ! col ground heat flux between soil layers 1 and 2 (W/m**2) + real(r8), pointer :: eflx_fgr_col (:,:) ! col (rural) soil downward heat flux (W/m2) (1:nlevgrnd) (pos upward; usually eflx_bot >= 0) + real(r8), pointer :: eflx_building_heat_errsoi_col(:) ! col heat flux to interior surface of walls and roof for errsoi check (W m-2) + real(r8), pointer :: eflx_urban_ac_col (:) ! col urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat_col (:) ! col urban heating flux (W/m**2) + real(r8), pointer :: eflx_anthro_patch (:) ! patch total anthropogenic heat flux (W/m**2) + real(r8), pointer :: eflx_traffic_patch (:) ! patch traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_patch (:) ! patch sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_patch (:) ! patch sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_traffic_lun (:) ! lun traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_lun (:) ! lun sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_lun (:) ! lun sensible heat flux to be put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_building_lun (:) ! lun building heat flux from change in interior building air temperature (W/m**2) + real(r8), pointer :: eflx_urban_ac_lun (:) ! lun urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat_lun (:) ! lun urban heating flux (W/m**2) + + ! Derivatives of energy fluxes + real(r8), pointer :: dgnetdT_patch (:) ! patch derivative of net ground heat flux wrt soil temp (W/m**2 K) + real(r8), pointer :: netrad_patch (:) ! col net radiation (W/m**2) [+ = to sfc] + real(r8), pointer :: cgrnd_patch (:) ! col deriv. of soil energy flux wrt to soil temp [W/m2/k] + real(r8), pointer :: cgrndl_patch (:) ! col deriv. of soil latent heat flux wrt soil temp [W/m**2/k] + real(r8), pointer :: cgrnds_patch (:) ! col deriv. of soil sensible heat flux wrt soil temp [W/m2/k] + + ! Canopy radiation + real(r8), pointer :: dlrad_patch (:) ! col downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad_patch (:) ! col upward longwave radiation above the canopy [W/m2] + + ! Wind Stress + real(r8), pointer :: taux_patch (:) ! patch wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy_patch (:) ! patch wind (shear) stress: n-s (kg/m/s**2) + + ! Conductance + real(r8), pointer :: canopy_cond_patch (:) ! patch tracer conductance for canopy [m/s] + + ! Transpiration + real(r8), pointer :: btran_patch (:) ! patch transpiration wetness factor (0 to 1) + + ! Roots + real(r8), pointer :: btran2_patch (:) ! patch root zone soil wetness factor (0 to 1) + real(r8), pointer :: rresis_patch (:,:) ! patch root resistance by layer (0-1) (nlevgrnd) + + ! Latent heat + real(r8), pointer :: htvp_col (:) ! latent heat of vapor of water (or sublimation) [j/kg] + + ! Balance Checks + real(r8), pointer :: errsoi_patch (:) ! soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errsoi_col (:) ! soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errseb_patch (:) ! surface energy conservation error (W/m**2) + real(r8), pointer :: errseb_col (:) ! surface energy conservation error (W/m**2) + real(r8), pointer :: errsol_patch (:) ! solar radiation conservation error (W/m**2) + real(r8), pointer :: errsol_col (:) ! solar radiation conservation error (W/m**2) + real(r8), pointer :: errlon_patch (:) ! longwave radiation conservation error (W/m**2) + real(r8), pointer :: errlon_col (:) ! longwave radiation conservation error (W/m**2) + + contains + + procedure, public :: Init ! Public initialization method + procedure, private :: InitAllocate ! initialize/allocate + procedure, private :: InitHistory ! setup history fields + procedure, private :: InitCold ! initialize for cold start + procedure, public :: Restart ! setup restart fields + + end type energyflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp ) + ! + ! !DESCRIPTION: + ! Allocate and initialize the data type and setup history, and initialize for cold-start. + ! !USES: + implicit none + ! !ARGUMENTS: + class(energyflux_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: t_grnd_col( bounds%begc: ) + logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method + logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method + + SHR_ASSERT_ALL((ubound(t_grnd_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + call this%InitAllocate ( bounds ) + call this%InitHistory ( bounds, is_simple_buildtemp ) + call this%InitCold ( bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp ) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize and allocate data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, crop_prog + implicit none + ! + ! !ARGUMENTS: + class(energyflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + begg = bounds%begg; endg= bounds%endg + + allocate( this%eflx_sh_snow_patch (begp:endp)) ; this%eflx_sh_snow_patch (:) = nan + allocate( this%eflx_sh_soil_patch (begp:endp)) ; this%eflx_sh_soil_patch (:) = nan + allocate( this%eflx_sh_h2osfc_patch (begp:endp)) ; this%eflx_sh_h2osfc_patch (:) = nan + allocate( this%eflx_sh_tot_patch (begp:endp)) ; this%eflx_sh_tot_patch (:) = nan + allocate( this%eflx_sh_tot_u_patch (begp:endp)) ; this%eflx_sh_tot_u_patch (:) = nan + allocate( this%eflx_sh_tot_r_patch (begp:endp)) ; this%eflx_sh_tot_r_patch (:) = nan + allocate( this%eflx_sh_grnd_patch (begp:endp)) ; this%eflx_sh_grnd_patch (:) = nan + allocate( this%eflx_sh_veg_patch (begp:endp)) ; this%eflx_sh_veg_patch (:) = nan + allocate( this%eflx_sh_precip_conversion_col(begc:endc)) ; this%eflx_sh_precip_conversion_col(:) = nan + allocate( this%eflx_lh_tot_u_patch (begp:endp)) ; this%eflx_lh_tot_u_patch (:) = nan + allocate( this%eflx_lh_tot_patch (begp:endp)) ; this%eflx_lh_tot_patch (:) = nan + allocate( this%eflx_lh_tot_r_patch (begp:endp)) ; this%eflx_lh_tot_r_patch (:) = nan + allocate( this%eflx_lh_grnd_patch (begp:endp)) ; this%eflx_lh_grnd_patch (:) = nan + allocate( this%eflx_lh_vege_patch (begp:endp)) ; this%eflx_lh_vege_patch (:) = nan + allocate( this%eflx_lh_vegt_patch (begp:endp)) ; this%eflx_lh_vegt_patch (:) = nan + allocate( this%eflx_soil_grnd_patch (begp:endp)) ; this%eflx_soil_grnd_patch (:) = nan + allocate( this%eflx_soil_grnd_u_patch (begp:endp)) ; this%eflx_soil_grnd_u_patch (:) = nan + allocate( this%eflx_soil_grnd_r_patch (begp:endp)) ; this%eflx_soil_grnd_r_patch (:) = nan + allocate( this%eflx_lwrad_net_patch (begp:endp)) ; this%eflx_lwrad_net_patch (:) = nan + allocate( this%eflx_lwrad_net_u_patch (begp:endp)) ; this%eflx_lwrad_net_u_patch (:) = nan + allocate( this%eflx_lwrad_net_r_patch (begp:endp)) ; this%eflx_lwrad_net_r_patch (:) = nan + allocate( this%eflx_lwrad_out_patch (begp:endp)) ; this%eflx_lwrad_out_patch (:) = nan + allocate( this%eflx_lwrad_out_u_patch (begp:endp)) ; this%eflx_lwrad_out_u_patch (:) = nan + allocate( this%eflx_lwrad_out_r_patch (begp:endp)) ; this%eflx_lwrad_out_r_patch (:) = nan + allocate( this%eflx_gnet_patch (begp:endp)) ; this%eflx_gnet_patch (:) = nan + allocate( this%eflx_grnd_lake_patch (begp:endp)) ; this%eflx_grnd_lake_patch (:) = nan + allocate( this%eflx_dynbal_grc (begg:endg)) ; this%eflx_dynbal_grc (:) = nan + allocate( this%eflx_bot_col (begc:endc)) ; this%eflx_bot_col (:) = nan + allocate( this%eflx_snomelt_col (begc:endc)) ; this%eflx_snomelt_col (:) = nan + allocate( this%eflx_snomelt_r_col (begc:endc)) ; this%eflx_snomelt_r_col (:) = nan + allocate( this%eflx_snomelt_u_col (begc:endc)) ; this%eflx_snomelt_u_col (:) = nan + allocate( this%eflx_fgr12_col (begc:endc)) ; this%eflx_fgr12_col (:) = nan + allocate( this%eflx_fgr_col (begc:endc, 1:nlevgrnd)) ; this%eflx_fgr_col (:,:) = nan + allocate( this%eflx_building_heat_errsoi_col (begc:endc)) ; this%eflx_building_heat_errsoi_col(:)= nan + allocate( this%eflx_urban_ac_col (begc:endc)) ; this%eflx_urban_ac_col (:) = nan + allocate( this%eflx_urban_heat_col (begc:endc)) ; this%eflx_urban_heat_col (:) = nan + allocate( this%eflx_wasteheat_patch (begp:endp)) ; this%eflx_wasteheat_patch (:) = nan + allocate( this%eflx_traffic_patch (begp:endp)) ; this%eflx_traffic_patch (:) = nan + allocate( this%eflx_heat_from_ac_patch (begp:endp)) ; this%eflx_heat_from_ac_patch (:) = nan + allocate( this%eflx_heat_from_ac_lun (begl:endl)) ; this%eflx_heat_from_ac_lun (:) = nan + allocate( this%eflx_building_lun (begl:endl)) ; this%eflx_building_lun (:) = nan + allocate( this%eflx_urban_ac_lun (begl:endl)) ; this%eflx_urban_ac_lun (:) = nan + allocate( this%eflx_urban_heat_lun (begl:endl)) ; this%eflx_urban_heat_lun (:) = nan + allocate( this%eflx_traffic_lun (begl:endl)) ; this%eflx_traffic_lun (:) = nan + allocate( this%eflx_wasteheat_lun (begl:endl)) ; this%eflx_wasteheat_lun (:) = nan + allocate( this%eflx_anthro_patch (begp:endp)) ; this%eflx_anthro_patch (:) = nan + + allocate( this%dgnetdT_patch (begp:endp)) ; this%dgnetdT_patch (:) = nan + allocate( this%cgrnd_patch (begp:endp)) ; this%cgrnd_patch (:) = nan + allocate( this%cgrndl_patch (begp:endp)) ; this%cgrndl_patch (:) = nan + allocate( this%cgrnds_patch (begp:endp)) ; this%cgrnds_patch (:) = nan + allocate( this%dlrad_patch (begp:endp)) ; this%dlrad_patch (:) = nan + allocate( this%ulrad_patch (begp:endp)) ; this%ulrad_patch (:) = nan + allocate( this%netrad_patch (begp:endp)) ; this%netrad_patch (:) = nan + + allocate( this%taux_patch (begp:endp)) ; this%taux_patch (:) = nan + allocate( this%tauy_patch (begp:endp)) ; this%tauy_patch (:) = nan + + allocate( this%canopy_cond_patch (begp:endp)) ; this%canopy_cond_patch (:) = nan + + allocate( this%htvp_col (begc:endc)) ; this%htvp_col (:) = nan + + allocate(this%rresis_patch (begp:endp,1:nlevgrnd)) ; this%rresis_patch (:,:) = nan + allocate(this%btran_patch (begp:endp)) ; this%btran_patch (:) = nan + allocate(this%btran2_patch (begp:endp)) ; this%btran2_patch (:) = nan + + allocate( this%errsoi_patch (begp:endp)) ; this%errsoi_patch (:) = nan + allocate( this%errsoi_col (begc:endc)) ; this%errsoi_col (:) = nan + allocate( this%errseb_patch (begp:endp)) ; this%errseb_patch (:) = nan + allocate( this%errseb_col (begc:endc)) ; this%errseb_col (:) = nan + allocate( this%errsol_patch (begp:endp)) ; this%errsol_patch (:) = nan + allocate( this%errsol_col (begc:endc)) ; this%errsol_col (:) = nan + allocate( this%errlon_patch (begp:endp)) ; this%errlon_patch (:) = nan + allocate( this%errlon_col (begc:endc)) ; this%errlon_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, is_simple_buildtemp) + ! + ! !DESCRIPTION: + ! Setup fields that can be output to history files + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevgrnd, crop_prog + use clm_varctl , only : use_cn + use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal + use ncdio_pio , only : ncd_inqvdlen + implicit none + ! + ! !ARGUMENTS: + class(energyflux_type) :: this + type(bounds_type), intent(in) :: bounds + logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + integer :: dimlen + integer :: err_code + logical :: do_io + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + begg = bounds%begg; endg= bounds%endg + + + this%eflx_dynbal_grc(begg:endg) = spval + call hist_addfld1d (fname='EFLX_DYNBAL', units='W/m^2', & + avgflag='A', long_name='dynamic land cover change conversion energy flux', & + ptr_lnd=this%eflx_dynbal_grc) + + this%eflx_snomelt_col(begc:endc) = spval + call hist_addfld1d (fname='FSM', units='W/m^2', & + avgflag='A', long_name='snow melt heat flux', & + ptr_col=this%eflx_snomelt_col, c2l_scale_type='urbanf') + + this%eflx_snomelt_r_col(begc:endc) = spval + call hist_addfld1d (fname='FSM_R', units='W/m^2', & + avgflag='A', long_name='Rural snow melt heat flux', & + ptr_col=this%eflx_snomelt_r_col, set_spec=spval) + + this%eflx_snomelt_u_col(begc:endc) = spval + call hist_addfld1d (fname='FSM_U', units='W/m^2', & + avgflag='A', long_name='Urban snow melt heat flux', & + ptr_col=this%eflx_snomelt_u_col, c2l_scale_type='urbanf', set_nourb=spval) + + this%eflx_lwrad_net_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRA', units='W/m^2', & + avgflag='A', long_name='net infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_net_patch, c2l_scale_type='urbanf') + + this%eflx_lwrad_net_r_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRA_R', units='W/m^2', & + avgflag='A', long_name='Rural net infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_net_r_patch, set_spec=spval) + + this%eflx_lwrad_out_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRE', units='W/m^2', & + avgflag='A', long_name='emitted infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_out_patch, c2l_scale_type='urbanf') + ! Rename of FIRE for Urban intercomparision project + this%eflx_lwrad_out_patch(begp:endp) = spval + call hist_addfld1d (fname='LWup', units='W/m^2', & + avgflag='A', long_name='upwelling longwave radiation', & + ptr_patch=this%eflx_lwrad_out_patch, c2l_scale_type='urbanf', default='inactive') + + this%eflx_lwrad_out_r_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRE_R', units='W/m^2', & + avgflag='A', long_name='Rural emitted infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_out_r_patch, set_spec=spval) + + this%eflx_lh_vegt_patch(begp:endp) = spval + call hist_addfld1d (fname='FCTR', units='W/m^2', & + avgflag='A', long_name='canopy transpiration', & + ptr_patch=this%eflx_lh_vegt_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%eflx_lh_vege_patch(begp:endp) = spval + call hist_addfld1d (fname='FCEV', units='W/m^2', & + avgflag='A', long_name='canopy evaporation', & + ptr_patch=this%eflx_lh_vege_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%eflx_lh_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='FGEV', units='W/m^2', & + avgflag='A', long_name='ground evaporation', & + ptr_patch=this%eflx_lh_grnd_patch, c2l_scale_type='urbanf') + + this%eflx_sh_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH', units='W/m^2', & + avgflag='A', long_name='sensible heat not including correction for land use change and rain/snow conversion', & + ptr_patch=this%eflx_sh_tot_patch, c2l_scale_type='urbanf') + + this%eflx_sh_tot_r_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_R', units='W/m^2', & + avgflag='A', long_name='Rural sensible heat', & + ptr_patch=this%eflx_sh_tot_r_patch, set_spec=spval) + + this%eflx_sh_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='Qh', units='W/m^2', & + avgflag='A', long_name='sensible heat', & + ptr_patch=this%eflx_sh_tot_patch, c2l_scale_type='urbanf', & + default = 'inactive') + + this%eflx_lh_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='Qle', units='W/m^2', & + avgflag='A', long_name='total evaporation', & + ptr_patch=this%eflx_lh_tot_patch, c2l_scale_type='urbanf', & + default = 'inactive') + + this%eflx_lh_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_LH_TOT', units='W/m^2', & + avgflag='A', long_name='total latent heat flux [+ to atm]', & + ptr_patch=this%eflx_lh_tot_patch, c2l_scale_type='urbanf') + + this%eflx_lh_tot_r_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_LH_TOT_R', units='W/m^2', & + avgflag='A', long_name='Rural total evaporation', & + ptr_patch=this%eflx_lh_tot_r_patch, set_spec=spval) + + this%eflx_soil_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='Qstor', units='W/m^2', & + avgflag='A', long_name='storage heat flux (includes snowmelt)', & + ptr_patch=this%eflx_soil_grnd_patch, c2l_scale_type='urbanf', & + default = 'inactive') + this%eflx_sh_veg_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_V', units='W/m^2', & + avgflag='A', long_name='sensible heat from veg', & + ptr_patch=this%eflx_sh_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%eflx_sh_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_G', units='W/m^2', & + avgflag='A', long_name='sensible heat from ground', & + ptr_patch=this%eflx_sh_grnd_patch, c2l_scale_type='urbanf') + + this%eflx_soil_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='FGR', units='W/m^2', & + avgflag='A', long_name='heat flux into soil/snow including snow melt and lake / snow light transmission', & + ptr_patch=this%eflx_soil_grnd_patch, c2l_scale_type='urbanf') + + this%eflx_soil_grnd_r_patch(begp:endp) = spval + call hist_addfld1d (fname='FGR_R', units='W/m^2', & + avgflag='A', long_name='Rural heat flux into soil/snow including snow melt and snow light transmission', & + ptr_patch=this%eflx_soil_grnd_r_patch, set_spec=spval) + + this%eflx_lwrad_net_u_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRA_U', units='W/m^2', & + avgflag='A', long_name='Urban net infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_net_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%eflx_soil_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_SOIL_GRND', units='W/m^2', & + avgflag='A', long_name='soil heat flux [+ into soil]', & + ptr_patch=this%eflx_soil_grnd_patch, default='inactive', c2l_scale_type='urbanf') + + this%eflx_lwrad_out_u_patch(begp:endp) = spval + call hist_addfld1d (fname='FIRE_U', units='W/m^2', & + avgflag='A', long_name='Urban emitted infrared (longwave) radiation', & + ptr_patch=this%eflx_lwrad_out_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%eflx_sh_tot_u_patch(begp:endp) = spval + call hist_addfld1d (fname='FSH_U', units='W/m^2', & + avgflag='A', long_name='Urban sensible heat', & + ptr_patch=this%eflx_sh_tot_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%eflx_sh_precip_conversion_col(begc:endc) = spval + call hist_addfld1d (fname = 'FSH_PRECIP_CONVERSION', units='W/m^2', & + avgflag='A', long_name='Sensible heat flux from conversion of rain/snow atm forcing', & + ptr_col=this%eflx_sh_precip_conversion_col, c2l_scale_type='urbanf') + + this%eflx_lh_tot_u_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_LH_TOT_U', units='W/m^2', & + avgflag='A', long_name='Urban total evaporation', & + ptr_patch=this%eflx_lh_tot_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%eflx_soil_grnd_u_patch(begp:endp) = spval + call hist_addfld1d (fname='FGR_U', units='W/m^2', & + avgflag='A', long_name='Urban heat flux into soil/snow including snow melt', & + ptr_patch=this%eflx_soil_grnd_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%netrad_patch(begp:endp) = spval + call hist_addfld1d (fname='Rnet', units='W/m^2', & + avgflag='A', long_name='net radiation', & + ptr_patch=this%netrad_patch, c2l_scale_type='urbanf', & + default='inactive') + + if (use_cn) then + this%dlrad_patch(begp:endp) = spval + call hist_addfld1d (fname='DLRAD', units='W/m^2', & + avgflag='A', long_name='downward longwave radiation below the canopy', & + ptr_patch=this%dlrad_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%ulrad_patch(begp:endp) = spval + call hist_addfld1d (fname='ULRAD', units='W/m^2', & + avgflag='A', long_name='upward longwave radiation above the canopy', & + ptr_patch=this%ulrad_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%cgrnd_patch(begp:endp) = spval + call hist_addfld1d (fname='CGRND', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil energy flux wrt to soil temp', & + ptr_patch=this%cgrnd_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%cgrndl_patch(begp:endp) = spval + call hist_addfld1d (fname='CGRNDL', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil latent heat flux wrt soil temp', & + ptr_patch=this%cgrndl_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%cgrnds_patch(begp:endp) = spval + call hist_addfld1d (fname='CGRNDS', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil sensible heat flux wrt soil temp', & + ptr_patch=this%cgrnds_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%eflx_gnet_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_GNET', units='W/m^2', & + avgflag='A', long_name='net heat flux into ground', & + ptr_patch=this%eflx_gnet_patch, default='inactive', c2l_scale_type='urbanf') + end if + + this%eflx_grnd_lake_patch(begp:endp) = spval + call hist_addfld1d (fname='EFLX_GRND_LAKE', units='W/m^2', & + avgflag='A', long_name='net heat flux into lake/snow surface, excluding light transmission', & + ptr_patch=this%eflx_grnd_lake_patch, set_nolake=spval) + + if ( is_simple_buildtemp )then + this%eflx_building_heat_errsoi_col(begc:endc) = spval + call hist_addfld1d (fname='BUILDHEAT', units='W/m^2', & + avgflag='A', long_name='heat flux from urban building interior to walls and roof', & + ptr_col=this%eflx_building_heat_errsoi_col, set_nourb=0._r8, c2l_scale_type='urbanf') + + this%eflx_urban_ac_col(begc:endc) = spval + call hist_addfld1d (fname='URBAN_AC', units='W/m^2', & + avgflag='A', long_name='urban air conditioning flux', & + ptr_col=this%eflx_urban_ac_col, set_nourb=0._r8, c2l_scale_type='urbanf') + + this%eflx_urban_heat_col(begc:endc) = spval + call hist_addfld1d (fname='URBAN_HEAT', units='W/m^2', & + avgflag='A', long_name='urban heating flux', & + ptr_col=this%eflx_urban_heat_col, set_nourb=0._r8, c2l_scale_type='urbanf') + else + this%eflx_urban_ac_lun(begl:endl) = spval + call hist_addfld1d (fname='EFLXBUILD', units='W/m^2', & + avgflag='A', long_name='building heat flux from change in interior building air temperature', & + ptr_lunit=this%eflx_building_lun, set_nourb=0._r8, l2g_scale_type='unity') + + this%eflx_urban_ac_lun(begl:endl) = spval + call hist_addfld1d (fname='URBAN_AC', units='W/m^2', & + avgflag='A', long_name='urban air conditioning flux', & + ptr_lunit=this%eflx_urban_ac_lun, set_nourb=0._r8, l2g_scale_type='unity') + + this%eflx_urban_heat_lun(begl:endl) = spval + call hist_addfld1d (fname='URBAN_HEAT', units='W/m^2', & + avgflag='A', long_name='urban heating flux', & + ptr_lunit=this%eflx_urban_heat_lun, set_nourb=0._r8, l2g_scale_type='unity') + end if + + + this%dgnetdT_patch(begp:endp) = spval + call hist_addfld1d (fname='DGNETDT', units='W/m^2/K', & + avgflag='A', long_name='derivative of net ground heat flux wrt soil temp', & + ptr_patch=this%dgnetdT_patch, default='inactive', c2l_scale_type='urbanf') + + this%eflx_fgr12_col(begc:endc) = spval + call hist_addfld1d (fname='FGR12', units='W/m^2', & + avgflag='A', long_name='heat flux between soil layers 1 and 2', & + ptr_col=this%eflx_fgr12_col, set_lake=spval) + + this%eflx_fgr_col(begc:endc,:) = spval + call hist_addfld2d (fname='FGR_SOIL_R', units='watt/m^2', type2d='levgrnd', & + avgflag='A', long_name='Rural downward heat flux at interface below each soil layer', & + ptr_col=this%eflx_fgr_col, set_spec=spval, default='inactive') + + this%eflx_traffic_patch(begp:endp) = spval + call hist_addfld1d (fname='TRAFFICFLUX', units='W/m^2', & + avgflag='A', long_name='sensible heat flux from urban traffic', & + ptr_patch=this%eflx_traffic_patch, set_nourb=0._r8, c2l_scale_type='urbanf', & + default='inactive') + + this%eflx_wasteheat_patch(begp:endp) = spval + call hist_addfld1d (fname='WASTEHEAT', units='W/m^2', & + avgflag='A', long_name='sensible heat flux from heating/cooling sources of urban waste heat', & + ptr_patch=this%eflx_wasteheat_patch, set_nourb=0._r8, c2l_scale_type='urbanf') + + this%eflx_heat_from_ac_patch(begp:endp) = spval + call hist_addfld1d (fname='HEAT_FROM_AC', units='W/m^2', & + avgflag='A', long_name='sensible heat flux put into canyon due to heat removed from air conditioning', & + ptr_patch=this%eflx_heat_from_ac_patch, set_nourb=0._r8, c2l_scale_type='urbanf') + + if ( is_simple_buildtemp )then + this%eflx_anthro_patch(begp:endp) = spval + call hist_addfld1d (fname='Qanth', units='W/m^2', & + avgflag='A', long_name='anthropogenic heat flux', & + ptr_patch=this%eflx_anthro_patch, set_nourb=0._r8, c2l_scale_type='urbanf', & + default='inactive') + end if + + this%taux_patch(begp:endp) = spval + call hist_addfld1d (fname='TAUX', units='kg/m/s^2', & + avgflag='A', long_name='zonal surface stress', & + ptr_patch=this%taux_patch) + ! Rename of TAUX for Urban intercomparision project (when U=V) + call hist_addfld1d (fname='Qtau', units='kg/m/s^2', & + avgflag='A', long_name='momentum flux', & + ptr_patch=this%taux_patch, default='inactive') + + this%tauy_patch(begp:endp) = spval + call hist_addfld1d (fname='TAUY', units='kg/m/s^2', & + avgflag='A', long_name='meridional surface stress', & + ptr_patch=this%tauy_patch) + + this%btran_patch(begp:endp) = spval + call hist_addfld1d (fname='BTRAN', units='unitless', & + avgflag='A', long_name='transpiration beta factor', & + ptr_patch=this%btran_patch, set_lake=spval, set_urb=spval) + + if (use_cn) then + this%rresis_patch(begp:endp,:) = spval + call hist_addfld2d (fname='RRESIS', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='root resistance in each soil layer', & + ptr_patch=this%rresis_patch, default='inactive') + end if + + this%errsoi_col(begc:endc) = spval + call hist_addfld1d (fname='ERRSOI', units='W/m^2', & + avgflag='A', long_name='soil/lake energy conservation error', & + ptr_col=this%errsoi_col) + + this%errseb_patch(begp:endp) = spval + call hist_addfld1d (fname='ERRSEB', units='W/m^2', & + avgflag='A', long_name='surface energy conservation error', & + ptr_patch=this%errseb_patch) + + this%errsol_patch(begp:endp) = spval + call hist_addfld1d (fname='ERRSOL', units='W/m^2', & + avgflag='A', long_name='solar radiation conservation error', & + ptr_patch=this%errsol_patch, set_urb=spval) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, t_grnd_col, is_simple_buildtemp, is_prog_buildtemp) + ! + ! !DESCRIPTION: + ! Initialize cold start conditions for module variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb + use clm_varcon , only : denice, denh2o, sb + use landunit_varcon , only : istice, istwet, istsoil, istdlak, istice_mec + use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall + use column_varcon , only : icol_shadewall, icol_road_perv + use clm_varctl , only : iulog, use_vancouver, use_mexicocity + implicit none + ! + ! !ARGUMENTS: + class(energyflux_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: t_grnd_col( bounds%begc: ) + logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method + logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method + ! + ! !LOCAL VARIABLES: + integer :: j,l,c,p,levs,lev + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(t_grnd_col) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + ! Columns + if ( is_simple_buildtemp )then + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%urbpoi(l)) then + this%eflx_building_heat_errsoi_col(c) = 0._r8 + this%eflx_urban_ac_col(c) = 0._r8 + this%eflx_urban_heat_col(c) = 0._r8 + else + this%eflx_building_heat_errsoi_col(c) = 0._r8 + this%eflx_urban_ac_col(c) = 0._r8 + this%eflx_urban_heat_col(c) = 0._r8 + end if + + end do + end if + + ! Patches + do p = bounds%begp, bounds%endp + c = patch%column(p) + l = patch%landunit(p) + + if (.not. lun%urbpoi(l)) then ! non-urban + this%eflx_lwrad_net_u_patch(p) = spval + this%eflx_lwrad_out_u_patch(p) = spval + this%eflx_lh_tot_u_patch(p) = spval + this%eflx_sh_tot_u_patch(p) = spval + this%eflx_soil_grnd_u_patch(p) = spval + end if + + this%eflx_lwrad_out_patch(p) = sb * (t_grnd_col(c))**4 + end do + + ! patches + do p = bounds%begp, bounds%endp + l = patch%landunit(p) + + if (.not. lun%urbpoi(l)) then + this%eflx_traffic_lun(l) = spval + this%eflx_wasteheat_lun(l) = spval + if ( is_prog_buildtemp )then + this%eflx_building_lun(l) = 0._r8 + this%eflx_urban_ac_lun(l) = 0._r8 + this%eflx_urban_heat_lun(l) = 0._r8 + end if + + this%eflx_wasteheat_patch(p) = 0._r8 + this%eflx_heat_from_ac_patch(p) = 0._r8 + this%eflx_traffic_patch(p) = 0._r8 + if ( is_simple_buildtemp) & + this%eflx_anthro_patch(p) = 0._r8 + else + if ( is_prog_buildtemp )then + this%eflx_building_lun(l) = 0._r8 + this%eflx_urban_ac_lun(l) = 0._r8 + this%eflx_urban_heat_lun(l) = 0._r8 + end if + end if + end do + + ! initialize rresis, for use in ecosystemdyn + do p = bounds%begp,bounds%endp + do lev = 1,nlevgrnd + this%rresis_patch(p,lev) = 0._r8 + end do + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildtemp) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, & + ncd_inqvdlen + use restUtilMod + use decompMod , only : get_proc_global + implicit none + ! + ! !ARGUMENTS: + class(energyflux_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + logical , intent(in) :: is_simple_buildtemp ! If using simple building temp method + logical , intent(in) :: is_prog_buildtemp ! If using prognostic building temp method + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + integer :: dimlen + integer :: err_code + integer :: numl_global + logical :: readvar ! determine if variable is on initial file + logical :: do_io + !----------------------------------------------------------------------- + + call get_proc_global(nl=numl_global) + call restartvar(ncid=ncid, flag=flag, varname='EFLX_LWRAD_OUT', xtype=ncd_double, & + dim1name='pft', & + long_name='emitted infrared (longwave) radiation', units='watt/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_lwrad_out_patch) + + ! Restart for building air temperature method + if ( is_prog_buildtemp )then + ! landunit urban energy state variable - eflx_urban_ac + do_io = .true. + ! On a read, confirm that this variable has the expected size (landunit-level); if not, + ! don't read it (instead give it a default value). This is needed to support older initial + ! conditions for which this variable had a different size (column-level). + if (flag == 'read') then + call ncd_inqvdlen(ncid, 'URBAN_AC', 1, dimlen, err_code) + if (dimlen /= numl_global) then + do_io = .false. + readvar = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='URBAN_AC', xtype=ncd_double, & + dim1name='landunit',& + long_name='urban air conditioning flux', units='watt/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_ac_lun) + else + this%eflx_urban_ac_lun = 0.0_r8 + end if + ! landunit urban energy state variable - eflx_urban_heat + do_io = .true. + ! On a read, confirm that this variable has the expected size (landunit-level); if not, + ! don't read it (instead give it a default value). This is needed to support older initial + ! conditions for which this variable had a different size (column-level). + if (flag == 'read') then + call ncd_inqvdlen(ncid, 'URBAN_HEAT', 1, dimlen, err_code) + if (dimlen /= numl_global) then + do_io = .false. + readvar = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='URBAN_HEAT', xtype=ncd_double, & + dim1name='landunit',& + long_name='urban heating flux', units='watt/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_heat_lun) + else + this%eflx_urban_heat_lun = 0.0_r8 + end if + else if ( is_simple_buildtemp )then + call restartvar(ncid=ncid, flag=flag, varname='URBAN_AC', xtype=ncd_double, & + dim1name='column', & + long_name='urban air conditioning flux', units='watt/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_ac_col) + call restartvar(ncid=ncid, flag=flag, varname='URBAN_HEAT', xtype=ncd_double, & + dim1name='column', & + long_name='urban heating flux', units='watt/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_urban_heat_col) + end if + + call restartvar(ncid=ncid, flag=flag, varname='btran2', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%btran2_patch) + + call restartvar(ncid=ncid, flag=flag, varname='eflx_grnd_lake', xtype=ncd_double, & + dim1name='pft', & + long_name='net heat flux into lake/snow surface, excluding light transmission', units='W/m^2', & + interpinic_flag='interp', readvar=readvar, data=this%eflx_grnd_lake_patch) + + end subroutine Restart + +end module EnergyFluxType diff --git a/components/clm/src/biogeophys/FrictionVelocityMod.F90 b/components/clm/src/biogeophys/FrictionVelocityMod.F90 new file mode 100644 index 0000000000..eb7d4249d5 --- /dev/null +++ b/components/clm/src/biogeophys/FrictionVelocityMod.F90 @@ -0,0 +1,761 @@ +module FrictionVelocityMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculation of the friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varcon , only : spval + use clm_varctl , only : use_cn, use_luna + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: FrictionVelocity ! Calculate friction velocity + public :: MoninObukIni ! Initialization of the Monin-Obukhov length + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: StabilityFunc1 ! Stability function for rib < 0. + private :: StabilityFunc2 ! Stability function for rib < 0. + + type, public :: frictionvel_type + + ! Roughness length/resistance for friction velocity calculation + + real(r8), pointer, public :: forc_hgt_u_patch (:) ! patch wind forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: forc_hgt_t_patch (:) ! patch temperature forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: forc_hgt_q_patch (:) ! patch specific humidity forcing height (10m+z0m+d) (m) + real(r8), pointer, public :: u10_patch (:) ! patch 10-m wind (m/s) (for dust model) + real(r8), pointer, public :: u10_clm_patch (:) ! patch 10-m wind (m/s) (for clm_map2gcell) + real(r8), pointer, public :: va_patch (:) ! patch atmospheric wind speed plus convective velocity (m/s) + real(r8), pointer, public :: vds_patch (:) ! patch deposition velocity term (m/s) (for dry dep SO4, NH4NO3) + real(r8), pointer, public :: fv_patch (:) ! patch friction velocity (m/s) (for dust model) + real(r8), pointer, public :: rb1_patch (:) ! patch aerodynamical resistance (s/m) (for dry deposition of chemical tracers) + real(r8), pointer, public :: rb10_patch (:) ! 10-day mean patch aerodynamical resistance (s/m) (for LUNA model) + real(r8), pointer, public :: ram1_patch (:) ! patch aerodynamical resistance (s/m) + real(r8), pointer, public :: z0m_patch (:) ! patch momentum roughness length (m) + real(r8), pointer, public :: z0mv_patch (:) ! patch roughness length over vegetation, momentum [m] + real(r8), pointer, public :: z0hv_patch (:) ! patch roughness length over vegetation, sensible heat [m] + real(r8), pointer, public :: z0qv_patch (:) ! patch roughness length over vegetation, latent heat [m] + real(r8), pointer, public :: z0mg_col (:) ! col roughness length over ground, momentum [m] + real(r8), pointer, public :: z0hg_col (:) ! col roughness length over ground, sensible heat [m] + real(r8), pointer, public :: z0qg_col (:) ! col roughness length over ground, latent heat [m] + + contains + + ! Public procedures + procedure, public :: Init + procedure, public :: Restart + + ! Private procedures + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type frictionvel_type + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(frictionvel_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(frictionvel_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%forc_hgt_u_patch (begp:endp)) ; this%forc_hgt_u_patch (:) = nan + allocate(this%forc_hgt_t_patch (begp:endp)) ; this%forc_hgt_t_patch (:) = nan + allocate(this%forc_hgt_q_patch (begp:endp)) ; this%forc_hgt_q_patch (:) = nan + allocate(this%u10_patch (begp:endp)) ; this%u10_patch (:) = nan + allocate(this%u10_clm_patch (begp:endp)) ; this%u10_clm_patch (:) = nan + allocate(this%va_patch (begp:endp)) ; this%va_patch (:) = nan + allocate(this%vds_patch (begp:endp)) ; this%vds_patch (:) = nan + allocate(this%fv_patch (begp:endp)) ; this%fv_patch (:) = nan + allocate(this%rb1_patch (begp:endp)) ; this%rb1_patch (:) = nan + allocate(this%rb10_patch (begp:endp)) ; this%rb10_patch (:) = spval + allocate(this%ram1_patch (begp:endp)) ; this%ram1_patch (:) = nan + allocate(this%z0m_patch (begp:endp)) ; this%z0m_patch (:) = nan + allocate(this%z0mv_patch (begp:endp)) ; this%z0mv_patch (:) = nan + allocate(this%z0hv_patch (begp:endp)) ; this%z0hv_patch (:) = nan + allocate(this%z0qv_patch (begp:endp)) ; this%z0qv_patch (:) = nan + allocate(this%z0mg_col (begc:endc)) ; this%z0mg_col (:) = nan + allocate(this%z0qg_col (begc:endc)) ; this%z0qg_col (:) = nan + allocate(this%z0hg_col (begc:endc)) ; this%z0hg_col (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(frictionvel_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%z0mg_col(begc:endc) = spval + call hist_addfld1d (fname='Z0MG', units='m', & + avgflag='A', long_name='roughness length over ground, momentum', & + ptr_col=this%z0mg_col, default='inactive') + + this%z0hg_col(begc:endc) = spval + call hist_addfld1d (fname='Z0HG', units='m', & + avgflag='A', long_name='roughness length over ground, sensible heat', & + ptr_col=this%z0hg_col, default='inactive') + + this%z0qg_col(begc:endc) = spval + call hist_addfld1d (fname='Z0QG', units='m', & + avgflag='A', long_name='roughness length over ground, latent heat', & + ptr_col=this%z0qg_col, default='inactive') + + this%va_patch(begp:endp) = spval + call hist_addfld1d (fname='VA', units='m/s', & + avgflag='A', long_name='atmospheric wind speed plus convective velocity', & + ptr_patch=this%va_patch, default='inactive') + + this%u10_clm_patch(begp:endp) = spval + call hist_addfld1d (fname='U10', units='m/s', & + avgflag='A', long_name='10-m wind', & + ptr_patch=this%u10_clm_patch) + + if (use_cn) then + this%u10_patch(begp:endp) = spval + call hist_addfld1d (fname='U10_DUST', units='m/s', & + avgflag='A', long_name='10-m wind for dust model', & + ptr_patch=this%u10_patch, default='inactive') + end if + + if (use_cn) then + this%ram1_patch(begp:endp) = spval + call hist_addfld1d (fname='RAM1', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_patch=this%ram1_patch, default='inactive') + end if + + if (use_cn) then + this%fv_patch(begp:endp) = spval + call hist_addfld1d (fname='FV', units='m/s', & + avgflag='A', long_name='friction velocity for dust model', & + ptr_patch=this%fv_patch, default='inactive') + end if + + if (use_cn) then + this%z0hv_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0HV', units='m', & + avgflag='A', long_name='roughness length over vegetation, sensible heat', & + ptr_patch=this%z0hv_patch, default='inactive') + end if + + if (use_cn) then + this%z0m_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0M', units='m', & + avgflag='A', long_name='momentum roughness length', & + ptr_patch=this%z0m_patch, default='inactive') + end if + + if (use_cn) then + this%z0mv_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0MV', units='m', & + avgflag='A', long_name='roughness length over vegetation, momentum', & + ptr_patch=this%z0mv_patch, default='inactive') + end if + + if (use_cn) then + this%z0qv_patch(begp:endp) = spval + call hist_addfld1d (fname='Z0QV', units='m', & + avgflag='A', long_name='roughness length over vegetation, latent heat', & + ptr_patch=this%z0qv_patch, default='inactive') + end if + + if (use_luna) then + call hist_addfld1d (fname='RB10', units='s/m', & + avgflag='A', long_name='10 day running mean boundary layer resistance', & + ptr_patch=this%rb10_patch, default='inactive') + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! Initialize module surface albedos to reasonable values + ! + ! !ARGUMENTS: + class(frictionvel_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p, c, l ! indices + !----------------------------------------------------------------------- + + ! Added 5/4/04, PET: initialize forc_hgt_u (gridcell-level), + ! since this is not initialized before first call to CNVegStructUpdate, + ! and it is required to set the upper bound for canopy top height. + ! Changed 3/21/08, KO: still needed but don't have sufficient information + ! to set this properly (e.g., patch-level displacement height and roughness + ! length). So leave at 30m. + + if (use_cn) then + do p = bounds%begp, bounds%endp + this%forc_hgt_u_patch(p) = 30._r8 + end do + end if + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%lakpoi(l)) then !lake + this%z0mg_col(c) = 0.0004_r8 + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(frictionvel_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='Z0MG', xtype=ncd_double, & + dim1name='column', & + long_name='ground momentum roughness length', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%z0mg_col) + + if(use_luna)then + call restartvar(ncid=ncid, flag=flag, varname='rb10', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean boundary layer resistance at the pacth', units='s/m', & + interpinic_flag='interp', readvar=readvar, data=this%rb10_patch) + endif + + end subroutine Restart + + !------------------------------------------------------------------------------ + subroutine FrictionVelocity(lbn, ubn, fn, filtern, & + displa, z0m, z0h, z0q, & + obu, iter, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm, frictionvel_inst, landunit_index) + ! + ! !DESCRIPTION: + ! Calculation of the friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + ! The scheme is based on the work of Zeng et al. (1998): + ! Intercomparison of bulk aerodynamic algorithms for the computation + ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + ! Vol. 11, 2628-2644. + ! + ! !USES: + use clm_varcon, only : vkc + use clm_varctl, only : iulog + ! + ! !ARGUMENTS: + integer , intent(in) :: lbn, ubn ! pft/landunit array bounds + integer , intent(in) :: fn ! number of filtered pft/landunit elements + integer , intent(in) :: filtern(fn) ! pft/landunit filter + real(r8) , intent(in) :: displa ( lbn: ) ! displacement height (m) [lbn:ubn] + real(r8) , intent(in) :: z0m ( lbn: ) ! roughness length over vegetation, momentum [m] [lbn:ubn] + real(r8) , intent(in) :: z0h ( lbn: ) ! roughness length over vegetation, sensible heat [m] [lbn:ubn] + real(r8) , intent(in) :: z0q ( lbn: ) ! roughness length over vegetation, latent heat [m] [lbn:ubn] + real(r8) , intent(in) :: obu ( lbn: ) ! monin-obukhov length (m) [lbn:ubn] + integer , intent(in) :: iter ! iteration number + real(r8) , intent(in) :: ur ( lbn: ) ! wind speed at reference height [m/s] [lbn:ubn] + real(r8) , intent(in) :: um ( lbn: ) ! wind speed including the stablity effect [m/s] [lbn:ubn] + real(r8) , intent(out) :: ustar ( lbn: ) ! friction velocity [m/s] [lbn:ubn] + real(r8) , intent(out) :: temp1 ( lbn: ) ! relation for potential temperature profile [lbn:ubn] + real(r8) , intent(out) :: temp12m ( lbn: ) ! relation for potential temperature profile applied at 2-m [lbn:ubn] + real(r8) , intent(out) :: temp2 ( lbn: ) ! relation for specific humidity profile [lbn:ubn] + real(r8) , intent(out) :: temp22m ( lbn: ) ! relation for specific humidity profile applied at 2-m [lbn:ubn] + real(r8) , intent(inout) :: fm ( lbn: ) ! diagnose 10m wind (DUST only) [lbn:ubn] + type(frictionvel_type) , intent(inout) :: frictionvel_inst + logical , intent(in), optional :: landunit_index ! optional argument that defines landunit or pft level + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: zetam = 1.574_r8 ! transition point of flux-gradient relation (wind profile) + real(r8), parameter :: zetat = 0.465_r8 ! transition point of flux-gradient relation (temp. profile) + integer :: f ! pft/landunit filter index + integer :: n ! pft/landunit index + integer :: g ! gridcell index + integer :: pp ! pfti,pftf index + real(r8) :: zldis(lbn:ubn) ! reference height "minus" zero displacement heght [m] + real(r8) :: zeta(lbn:ubn) ! dimensionless height used in Monin-Obukhov theory + real(r8) :: tmp1,tmp2,tmp3,tmp4 ! Used to diagnose the 10 meter wind + real(r8) :: fmnew ! Used to diagnose the 10 meter wind + real(r8) :: fm10 ! Used to diagnose the 10 meter wind + real(r8) :: zeta10 ! Used to diagnose the 10 meter wind + real(r8) :: vds_tmp ! Temporary for dry deposition velocity + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(displa) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(z0m) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(z0h) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(z0q) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(obu) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(ur) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(um) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(ustar) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(temp1) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(temp12m) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(temp2) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(temp22m) == (/ubn/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fm) == (/ubn/)), errMsg(__FILE__, __LINE__)) + + associate( & + pfti => lun%patchi , & ! Input: [integer (:) ] beginning pfti index for landunit + pftf => lun%patchf , & ! Input: [integer (:) ] final pft index for landunit + + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at pft level [m] + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at pft level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Input: [real(r8) (:) ] observational height of specific humidity at pft level [m] + vds => frictionvel_inst%vds_patch , & ! Output: [real(r8) (:) ] dry deposition velocity term (m/s) (for SO4 NH4NO3) + u10 => frictionvel_inst%u10_patch , & ! Output: [real(r8) (:) ] 10-m wind (m/s) (for dust model) + u10_clm => frictionvel_inst%u10_clm_patch , & ! Output: [real(r8) (:) ] 10-m wind (m/s) + va => frictionvel_inst%va_patch , & ! Output: [real(r8) (:) ] atmospheric wind speed plus convective velocity (m/s) + fv => frictionvel_inst%fv_patch & ! Output: [real(r8) (:) ] friction velocity (m/s) (for dust model) + ) + + ! Adjustment factors for unstable (moz < 0) or stable (moz > 0) conditions. + + do f = 1, fn + n = filtern(f) + if (present(landunit_index)) then + g = lun%gridcell(n) + else + g = patch%gridcell(n) + end if + + ! Wind profile + + if (present(landunit_index)) then + zldis(n) = forc_hgt_u_patch(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_u_patch(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetam) then + ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))& + - StabilityFunc1(-zetam) & + + StabilityFunc1(z0m(n)/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) + else if (zeta(n) < 0._r8) then + ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n))& + - StabilityFunc1(zeta(n))& + + StabilityFunc1(z0m(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n)) + 5._r8*zeta(n) -5._r8*z0m(n)/obu(n)) + else + ustar(n) = vkc*um(n)/(log(obu(n)/z0m(n))+5._r8-5._r8*z0m(n)/obu(n) & + +(5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + if (zeta(n) < 0._r8) then + vds_tmp = 2.e-3_r8*ustar(n) * ( 1._r8 + (300._r8/(-obu(n)))**0.666_r8) + else + vds_tmp = 2.e-3_r8*ustar(n) + endif + + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + vds(pp) = vds_tmp + end do + else + vds(n) = vds_tmp + end if + + ! Calculate a 10-m wind (10m + z0m + d) + ! For now, this will not be the same as the 10-m wind calculated for the dust + ! model because the CLM stability functions are used here, not the LSM stability + ! functions used in the dust model. We will eventually change the dust model to be + ! consistent with the following formulation. + ! Note that the 10-m wind calculated this way could actually be larger than the + ! atmospheric forcing wind because 1) this includes the convective velocity, 2) + ! this includes the 1 m/s minimum wind threshold + + ! If forcing height is less than or equal to 10m, then set 10-m wind to um + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + if (zldis(n)-z0m(n) <= 10._r8) then + u10_clm(pp) = um(n) + else + if (zeta(n) < -zetam) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) & + - StabilityFunc1(-zetam) & + + StabilityFunc1((10._r8+z0m(n))/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) ) + else if (zeta(n) < 0._r8) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + - StabilityFunc1(zeta(n)) & + + StabilityFunc1((10._r8+z0m(n))/obu(n))) ) + else if (zeta(n) <= 1._r8) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) ) + else + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) & + + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) ) + + end if + end if + va(pp) = um(n) + end do + else + if (zldis(n)-z0m(n) <= 10._r8) then + u10_clm(n) = um(n) + else + if (zeta(n) < -zetam) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) & + - StabilityFunc1(-zetam) & + + StabilityFunc1((10._r8+z0m(n))/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) ) + else if (zeta(n) < 0._r8) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + - StabilityFunc1(zeta(n)) & + + StabilityFunc1((10._r8+z0m(n))/obu(n))) ) + else if (zeta(n) <= 1._r8) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) ) + else + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) & + + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) ) + end if + end if + va(n) = um(n) + end if + + ! Temperature profile + + if (present(landunit_index)) then + zldis(n) = forc_hgt_t_patch(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_t_patch(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp1(n) = vkc/(log(zldis(n)/z0h(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0h(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp1(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n)) + else + temp1(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + ! Humidity profile + + if (present(landunit_index)) then + if (forc_hgt_q_patch(pfti(n)) == forc_hgt_t_patch(pfti(n)) .and. z0q(n) == z0h(n)) then + temp2(n) = temp1(n) + else + zldis(n) = forc_hgt_q_patch(pfti(n))-displa(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + end if + else + if (forc_hgt_q_patch(n) == forc_hgt_t_patch(n) .and. z0q(n) == z0h(n)) then + temp2(n) = temp1(n) + else + zldis(n) = forc_hgt_q_patch(n)-displa(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + endif + endif + + ! Temperature profile applied at 2-m + + zldis(n) = 2.0_r8 + z0h(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp12m(n) = vkc/(log(zldis(n)/z0h(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0h(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp12m(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n)) + else + temp12m(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + ! Humidity profile applied at 2-m + + if (z0q(n) == z0h(n)) then + temp22m(n) = temp12m(n) + else + zldis(n) = 2.0_r8 + z0q(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - & + StabilityFunc2(-zetat) + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp22m(n) = vkc/(log(zldis(n)/z0q(n)) - & + StabilityFunc2(zeta(n))+StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp22m(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp22m(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + end if + + ! diagnose 10-m wind for dust model (dstmbl.F) + ! Notes from C. Zender's dst.F: + ! According to Bon96 p. 62, the displacement height d (here displa) is + ! 0.0 <= d <= 0.34 m in dust source regions (i.e., regions w/o trees). + ! Therefore d <= 0.034*z1 and may safely be neglected. + ! Code from LSM routine SurfaceTemperature was used to obtain u10 + + if (present(landunit_index)) then + zldis(n) = forc_hgt_u_patch(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_u_patch(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (min(zeta(n), 1._r8) < 0._r8) then + tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8 + tmp2 = log((1._r8+tmp1*tmp1)/2._r8) + tmp3 = log((1._r8+tmp1)/2._r8) + fmnew = 2._r8*tmp3 + tmp2 - 2._r8*atan(tmp1) + 1.5707963_r8 + else + fmnew = -5._r8*min(zeta(n),1._r8) + endif + if (iter == 1) then + fm(n) = fmnew + else + fm(n) = 0.5_r8 * (fm(n)+fmnew) + end if + zeta10 = min(10._r8/obu(n), 1._r8) + if (zeta(n) == 0._r8) zeta10 = 0._r8 + if (zeta10 < 0._r8) then + tmp1 = (1.0_r8 - 16.0_r8 * zeta10)**0.25_r8 + tmp2 = log((1.0_r8 + tmp1*tmp1)/2.0_r8) + tmp3 = log((1.0_r8 + tmp1)/2.0_r8) + fm10 = 2.0_r8*tmp3 + tmp2 - 2.0_r8*atan(tmp1) + 1.5707963_r8 + else ! not stable + fm10 = -5.0_r8 * zeta10 + end if + if (present(landunit_index)) then + tmp4 = log( max( 1.0_r8, forc_hgt_u_patch(pfti(n)) / 10._r8) ) + else + tmp4 = log( max( 1.0_r8, forc_hgt_u_patch(n) / 10._r8) ) + end if + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + u10(pp) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10) + fv(pp) = ustar(n) + end do + else + u10(n) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10) + fv(n) = ustar(n) + end if + + end do + + end associate + end subroutine FrictionVelocity + + !------------------------------------------------------------------------------ + real(r8) function StabilityFunc1(zeta) + ! + ! !DESCRIPTION: + ! Stability function for rib < 0. + ! + ! !USES: + use shr_const_mod, only: SHR_CONST_PI + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + ! + ! !LOCAL VARIABLES: + real(r8) :: chik, chik2 + !------------------------------------------------------------------------------ + + chik2 = sqrt(1._r8-16._r8*zeta) + chik = sqrt(chik2) + StabilityFunc1 = 2._r8*log((1._r8+chik)*0.5_r8) & + + log((1._r8+chik2)*0.5_r8)-2._r8*atan(chik)+SHR_CONST_PI*0.5_r8 + + end function StabilityFunc1 + + !------------------------------------------------------------------------------ + real(r8) function StabilityFunc2(zeta) + ! + ! !DESCRIPTION: + ! Stability function for rib < 0. + ! + ! !USES: + use shr_const_mod, only: SHR_CONST_PI + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + ! + ! !LOCAL VARIABLES: + real(r8) :: chik2 + !------------------------------------------------------------------------------ + + chik2 = sqrt(1._r8-16._r8*zeta) + StabilityFunc2 = 2._r8*log((1._r8+chik2)*0.5_r8) + + end function StabilityFunc2 + + !----------------------------------------------------------------------- + subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) + ! + ! !DESCRIPTION: + ! Initialization of the Monin-Obukhov length. + ! The scheme is based on the work of Zeng et al. (1998): + ! Intercomparison of bulk aerodynamic algorithms for the computation + ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + ! Vol. 11, 2628-2644. + ! + ! !USES: + use clm_varcon, only : grav + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: ur ! wind speed at reference height [m/s] + real(r8), intent(in) :: thv ! virtual potential temperature (kelvin) + real(r8), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] + real(r8), intent(in) :: z0m ! roughness length, momentum [m] + real(r8), intent(out) :: um ! wind speed including the stability effect [m/s] + real(r8), intent(out) :: obu ! monin-obukhov length (m) + ! + ! !LOCAL VARIABLES: + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: rib ! bulk Richardson number + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: ustar ! friction velocity [m/s] + !----------------------------------------------------------------------- + + ! Initial values of u* and convective velocity + + ustar=0.06_r8 + wc=0.5_r8 + if (dthv >= 0._r8) then + um=max(ur,0.1_r8) + else + um=sqrt(ur*ur+wc*wc) + endif + + rib=grav*zldis*dthv/(thv*um*um) + + if (rib >= 0._r8) then ! neutral or stable + zeta = rib*log(zldis/z0m)/(1._r8-5._r8*min(rib,0.19_r8)) + zeta = min(2._r8,max(zeta,0.01_r8 )) + else ! unstable + zeta=rib*log(zldis/z0m) + zeta = max(-100._r8,min(zeta,-0.01_r8 )) + endif + + obu=zldis/zeta + + end subroutine MoninObukIni + +end module FrictionVelocityMod diff --git a/components/clm/src/biogeophys/HumanIndexMod.F90 b/components/clm/src/biogeophys/HumanIndexMod.F90 new file mode 100644 index 0000000000..163e1826e8 --- /dev/null +++ b/components/clm/src/biogeophys/HumanIndexMod.F90 @@ -0,0 +1,1302 @@ +module HumanIndexMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: HumanIndexMod +! +! !DESCRIPTION: +! Calculates Wetbulb Temperature, Stull Wet Bulb Temperature, +! Heat Index, Apparent Temperature, Simplified Wet Bulb +! Globe Temperature, Humidex, Discomfort Index, Stull +! Discomfort Index, Temperature Humidity Comfort Index, +! Temperature Humidity Physiology Index, Swamp Cooler +! Temperature, Kelvin to Celsius, Vapor Pressure, & QSat_2 +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type +! !PUBLIC TYPES: + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: HumanIndexReadNML ! Read in the namelist for HumanIndex + public :: Wet_Bulb ! Wet bulb temperature + public :: Wet_BulbS ! Wet bulb temperature from relative humidity + public :: HeatIndex ! Heat index + public :: AppTemp ! Apparant temperature + public :: swbgt ! Simplified Wetbulb Globe temperature + public :: hmdex ! humidex, human discomfort based on heat and humidity + public :: dis_coi ! Discomfort index + public :: dis_coiS ! Discomfort index from relative humidity + public :: THIndex ! Temperature humidity index + public :: SwampCoolEff ! Swamp Cooling efficiency + public :: KtoC ! Convert Kelvin to Celcius + public :: VaporPres ! Vapor pressure + public :: QSat_2 ! Saturation mix. ratio and the change in sat. mix rat. with respect to Temp + +! +! !PUBLIC MEMBER DATA: + logical, public :: calc_human_stress_indices = .true. ! If should calculate the set of human stress indices + type, public :: humanindex_type + real(r8), pointer :: tc_ref2m_patch (:) ! Patch 2 m height surface air temperature (C) + real(r8), pointer :: vap_ref2m_patch (:) ! Patch 2 m height vapor pressure (Pa) + real(r8), pointer :: appar_temp_ref2m_patch (:) ! Patch 2 m apparent temperature (C) + real(r8), pointer :: appar_temp_ref2m_r_patch (:) ! Patch Rural 2 m apparent temperature (C) + real(r8), pointer :: swbgt_ref2m_patch (:) ! Patch 2 m Simplified Wetbulb Globe temperature (C) + real(r8), pointer :: swbgt_ref2m_r_patch (:) ! Patch Rural 2 m Simplified Wetbulb Globe temperature (C) + real(r8), pointer :: humidex_ref2m_patch (:) ! Patch 2 m Humidex (C) + real(r8), pointer :: humidex_ref2m_r_patch (:) ! Patch Rural 2 m Humidex (C) + real(r8), pointer :: wbt_ref2m_patch (:) ! Patch 2 m Stull Wet Bulb temperature (C) + real(r8), pointer :: wbt_ref2m_r_patch (:) ! Patch Rural 2 m Stull Wet Bulb temperature (C) + real(r8), pointer :: wb_ref2m_patch (:) ! Patch 2 m Wet Bulb temperature (C) + real(r8), pointer :: wb_ref2m_r_patch (:) ! Patch Rural 2 m Wet Bulb temperature (C) + real(r8), pointer :: teq_ref2m_patch (:) ! Patch 2 m height Equivalent temperature (K) + real(r8), pointer :: teq_ref2m_r_patch (:) ! Patch Rural 2 m Equivalent temperature (K) + real(r8), pointer :: ept_ref2m_patch (:) ! Patch 2 m height Equivalent Potential temperature (K) + real(r8), pointer :: ept_ref2m_r_patch (:) ! Patch Rural 2 m height Equivalent Potential temperature (K) + real(r8), pointer :: discomf_index_ref2m_patch (:) ! Patch 2 m Discomfort Index temperature (C) + real(r8), pointer :: discomf_index_ref2m_r_patch (:) ! Patch Rural 2 m Discomfort Index temperature (C) + real(r8), pointer :: discomf_index_ref2mS_patch (:) ! Patch 2 m height Discomfort Index Stull temperature (C) + real(r8), pointer :: discomf_index_ref2mS_r_patch(:) ! Patch Rural 2 m Discomfort Index Stull temperature (K) + real(r8), pointer :: nws_hi_ref2m_patch (:) ! Patch 2 m NWS Heat Index (C) + real(r8), pointer :: nws_hi_ref2m_r_patch (:) ! Patch Rural 2 m NWS Heat Index (C) + real(r8), pointer :: thip_ref2m_patch (:) ! Patch 2 m Temperature Humidity Index Physiology (C) + real(r8), pointer :: thip_ref2m_r_patch (:) ! Patch Rural 2 m Temperature Humidity Index Physiology (C) + real(r8), pointer :: thic_ref2m_patch (:) ! Patch 2 m Temperature Humidity Index Comfort (C) + real(r8), pointer :: thic_ref2m_r_patch (:) ! Patch Rural 2 m Temperature Humidity Index Comfort (C) + real(r8), pointer :: swmp65_ref2m_patch (:) ! Patch 2 m Swamp Cooler temperature 65% effi (C) + real(r8), pointer :: swmp65_ref2m_r_patch (:) ! Patch Rural 2 m Swamp Cooler temperature 65% effi (C) + real(r8), pointer :: swmp80_ref2m_patch (:) ! Patch 2 m Swamp Cooler temperature 80% effi (C) + real(r8), pointer :: swmp80_ref2m_r_patch (:) ! Patch Rural 2 m Swamp Cooler temperature 80% effi (C) + real(r8), pointer :: appar_temp_ref2m_u_patch (:) ! Patch Urban 2 m apparent temperature (C) + real(r8), pointer :: swbgt_ref2m_u_patch (:) ! Patch Urban 2 m Simplified Wetbulb Globe temperature (C) + real(r8), pointer :: humidex_ref2m_u_patch (:) ! Patch Urban 2 m Humidex (C) + real(r8), pointer :: wbt_ref2m_u_patch (:) ! Patch Urban 2 m Stull Wet Bulb temperature (C) + real(r8), pointer :: wb_ref2m_u_patch (:) ! Patch Urban 2 m Wet Bulb temperature (C) + real(r8), pointer :: teq_ref2m_u_patch (:) ! Patch Urban 2 m Equivalent + real(r8), pointer :: ept_ref2m_u_patch (:) ! Patch Urban 2 m height Equivalent Potential temperature (K) + real(r8), pointer :: discomf_index_ref2m_u_patch (:) !Urban 2 m Discomfort Index temperature (C) + real(r8), pointer :: discomf_index_ref2mS_u_patch(:) !Urban 2 m Discomfort Index Stull temperature (K) + real(r8), pointer :: nws_hi_ref2m_u_patch (:) !Urban 2 m NWS Heat Index (C) + real(r8), pointer :: thip_ref2m_u_patch (:) !Urban 2 m Temperature Humidity Index Physiology (C) + real(r8), pointer :: thic_ref2m_u_patch (:) !Urban 2 m Temperature Humidity Index Comfort (C) + real(r8), pointer :: swmp65_ref2m_u_patch (:) !Urban 2 m Swamp Cooler temperature 65% effi (C) + real(r8), pointer :: swmp80_ref2m_u_patch (:) !Urban 2 m Swamp Cooler temperature 80% effi (C) temperature (K) + contains + procedure, public :: Init ! Public initialization + procedure, private :: InitAllocate ! Private allocation method + procedure, private :: InitHistory ! Private history setup method + end type humanindex_type +! +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-07-12 +! Modified 03-14-12--- filter routines for WB +! +! Modified 08-12-12--- filter for below zero calculation. +! Added WB = T at 0 and below +! Modified 05-13-13--- Adding additional Metrics. +! Added Apparent Temperature (Australian BOM) +! Added Simplified Wetbulb Globe Temperature +! Added Humidex +! Added Discomfort Index +! The previous Metrics were from Keith Oleson +! Added Temperature Humidity Index +! Added Swamp Cooler Efficiency +! +! Modified 05-16-13--- Added Current Vapor Pressure and +! Kelvin to Celsius and converted all +! equations that use these inputs +! Modified 08-30-13--- Finalized Comments. Added a new +! qsat algorithm. Changed wet bulb calculations +! to calculate over the large range of atmospheric +! conditions. +! Modified 03-21-14--- Changed Specific Humidity to Mixing +! Ratio. +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Init +! +! !INTERFACE: +subroutine Init(this, bounds ) +! +! !DESCRIPTION: Initialize human index object +! +! !USES: +! !ARGUMENTS: + implicit none + class(humanindex_type) :: this + type(bounds_type) , intent(in) :: bounds +! !LOCAL VARIABLES: + type(bounds_type) :: bounds_tmp +!EOP +!----------------------------------------------------------------------- + if ( calc_human_stress_indices ) then + call this%InitAllocate ( bounds ) + call this%InitHistory ( bounds ) + else + ! Associate statements need humanindex_inst to be allocated + ! So allocate with size 1 when not being used + bounds_tmp%begp = 1 + bounds_tmp%endp = 1 + call this%InitAllocate ( bounds ) + end if + +end subroutine Init + +!------------------------------------------------------------------------ +subroutine InitAllocate(this, bounds) +! +! !DESCRIPTION: +! Initialize module data structure +! +! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) +! +! !ARGUMENTS: + class(humanindex_type) :: this + type(bounds_type), intent(in) :: bounds +! +! !LOCAL VARIABLES: + integer :: begp, endp +!------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + + allocate(this%vap_ref2m_patch (begp:endp)) ; this%vap_ref2m_patch (:) = nan + allocate(this%humidex_ref2m_u_patch (begp:endp)) ; this%humidex_ref2m_u_patch (:) = nan + allocate(this%humidex_ref2m_patch (begp:endp)) ; this%humidex_ref2m_patch (:) = nan + allocate(this%humidex_ref2m_r_patch (begp:endp)) ; this%humidex_ref2m_r_patch (:) = nan + allocate(this%nws_hi_ref2m_patch (begp:endp)) ; this%nws_hi_ref2m_patch (:) = nan + allocate(this%nws_hi_ref2m_r_patch (begp:endp)) ; this%nws_hi_ref2m_r_patch (:) = nan + allocate(this%thip_ref2m_patch (begp:endp)) ; this%thip_ref2m_patch (:) = nan + allocate(this%thip_ref2m_r_patch (begp:endp)) ; this%thip_ref2m_r_patch (:) = nan + allocate(this%thic_ref2m_patch (begp:endp)) ; this%thic_ref2m_patch (:) = nan + allocate(this%thic_ref2m_r_patch (begp:endp)) ; this%thic_ref2m_r_patch (:) = nan + allocate(this%nws_hi_ref2m_u_patch (begp:endp)) ; this%nws_hi_ref2m_u_patch (:) = nan + allocate(this%thip_ref2m_u_patch (begp:endp)) ; this%thip_ref2m_u_patch (:) = nan + allocate(this%thic_ref2m_u_patch (begp:endp)) ; this%thic_ref2m_u_patch (:) = nan + allocate(this%tc_ref2m_patch (begp:endp)) ; this%tc_ref2m_patch (:) = nan + allocate(this%appar_temp_ref2m_patch (begp:endp)) ; this%appar_temp_ref2m_patch (:) = nan + allocate(this%appar_temp_ref2m_r_patch (begp:endp)) ; this%appar_temp_ref2m_r_patch (:) = nan + allocate(this%swbgt_ref2m_patch (begp:endp)) ; this%swbgt_ref2m_patch (:) = nan + allocate(this%swbgt_ref2m_r_patch (begp:endp)) ; this%swbgt_ref2m_r_patch (:) = nan + allocate(this%wbt_ref2m_patch (begp:endp)) ; this%wbt_ref2m_patch (:) = nan + allocate(this%wbt_ref2m_r_patch (begp:endp)) ; this%wbt_ref2m_r_patch (:) = nan + allocate(this%wb_ref2m_patch (begp:endp)) ; this%wb_ref2m_patch (:) = nan + allocate(this%wb_ref2m_r_patch (begp:endp)) ; this%wb_ref2m_r_patch (:) = nan + allocate(this%teq_ref2m_patch (begp:endp)) ; this%teq_ref2m_patch (:) = nan + allocate(this%teq_ref2m_r_patch (begp:endp)) ; this%teq_ref2m_r_patch (:) = nan + allocate(this%ept_ref2m_patch (begp:endp)) ; this%ept_ref2m_patch (:) = nan + allocate(this%ept_ref2m_r_patch (begp:endp)) ; this%ept_ref2m_r_patch (:) = nan + allocate(this%discomf_index_ref2m_patch (begp:endp)) ; this%discomf_index_ref2m_patch (:) = nan + allocate(this%discomf_index_ref2m_r_patch(begp:endp)) ; this%discomf_index_ref2m_r_patch(:) = nan + allocate(this%discomf_index_ref2mS_patch(begp:endp)) ; this%discomf_index_ref2mS_patch (:) = nan + allocate(this%discomf_index_ref2mS_r_patch(begp:endp)) ; this%discomf_index_ref2mS_r_patch(:) = nan + allocate(this%discomf_index_ref2mS_u_patch(begp:endp)) ; this%discomf_index_ref2mS_u_patch(:) = nan + allocate(this%swmp65_ref2m_patch (begp:endp)) ; this%swmp65_ref2m_patch (:) = nan + allocate(this%swmp65_ref2m_r_patch (begp:endp)) ; this%swmp65_ref2m_r_patch (:) = nan + allocate(this%swmp80_ref2m_patch (begp:endp)) ; this%swmp80_ref2m_patch (:) = nan + allocate(this%swmp80_ref2m_r_patch (begp:endp)) ; this%swmp80_ref2m_r_patch (:) = nan + allocate(this%swmp80_ref2m_u_patch (begp:endp)) ; this%swmp80_ref2m_u_patch (:) = nan + allocate(this%appar_temp_ref2m_u_patch (begp:endp)) ; this%appar_temp_ref2m_u_patch (:) = nan + allocate(this%swbgt_ref2m_u_patch (begp:endp)) ; this%swbgt_ref2m_u_patch (:) = nan + allocate(this%wbt_ref2m_u_patch (begp:endp)) ; this%wbt_ref2m_u_patch (:) = nan + allocate(this%wbt_ref2m_u_patch (begp:endp)) ; this%wbt_ref2m_u_patch (:) = nan + allocate(this%wb_ref2m_u_patch (begp:endp)) ; this%wb_ref2m_u_patch (:) = nan + allocate(this%teq_ref2m_u_patch (begp:endp)) ; this%teq_ref2m_u_patch (:) = nan + allocate(this%ept_ref2m_u_patch (begp:endp)) ; this%ept_ref2m_u_patch (:) = nan + allocate(this%discomf_index_ref2m_u_patch(begp:endp)) ; this%discomf_index_ref2m_u_patch(:) = nan + allocate(this%swmp65_ref2m_u_patch (begp:endp)) ; this%swmp65_ref2m_u_patch (:) = nan +end subroutine InitAllocate + + +!------------------------------------------------------------------------ +subroutine InitHistory(this, bounds) +! +! !DESCRIPTION: +! Initialize history data +! +! !USES: + use clm_varcon , only : spval + use histFileMod , only : hist_addfld1d +! +! !ARGUMENTS: + class(humanindex_type) :: this + type(bounds_type), intent(in) :: bounds +! +! !LOCAL VARIABLES: + integer :: begp, endp +!------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + + this%appar_temp_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='APPAR_TEMP', units='C', & + avgflag='A', long_name='2 m apparent temperature', & + ptr_patch=this%appar_temp_ref2m_patch) + + this%appar_temp_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='APPAR_TEMP_U', units='C', & + avgflag='A', long_name='Urban 2 m apparent temperature', & + ptr_patch=this%appar_temp_ref2m_u_patch, set_nourb=spval) + + this%appar_temp_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='APPAR_TEMP_R', units='C', & + avgflag='A', long_name='Rural 2 m apparent temperature', & + ptr_patch=this%appar_temp_ref2m_r_patch, set_spec=spval) + + this%swbgt_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='SWBGT', units='C', & + avgflag='A', long_name='2 m Simplified Wetbulb Globe Temp', & + ptr_patch=this%swbgt_ref2m_patch) + + this%swbgt_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='SWBGT_U', units='C', & + avgflag='A', long_name='Urban 2 m Simplified Wetbulb Globe Temp', & + ptr_patch=this%swbgt_ref2m_u_patch, set_nourb=spval) + + this%swbgt_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='SWBGT_R', units='C', & + avgflag='A', long_name='Rural 2 m Simplified Wetbulb Globe Temp', & + ptr_patch=this%swbgt_ref2m_r_patch, set_spec=spval) + + this%humidex_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='HUMIDEX', units='C', & + avgflag='A', long_name='2 m Humidex', & + ptr_patch=this%humidex_ref2m_patch) + + this%humidex_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='HUMIDEX_U', units='C', & + avgflag='A', long_name='Urban 2 m Humidex', & + ptr_patch=this%humidex_ref2m_u_patch, set_nourb=spval) + + this%humidex_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='HUMIDEX_R', units='C', & + avgflag='A', long_name='Rural 2 m Humidex', & + ptr_patch=this%humidex_ref2m_r_patch, set_spec=spval) + + this%wbt_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='WBT', units='C', & + avgflag='A', long_name='2 m Stull Wet Bulb', & + ptr_patch=this%wbt_ref2m_u_patch, set_nourb=spval) + + this%wbt_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='WBT_R', units='C', & + avgflag='A', long_name='Rural 2 m Stull Wet Bulb', & + ptr_patch=this%wbt_ref2m_r_patch, set_spec=spval) + + this%wb_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='WBA', units='C', & + avgflag='A', long_name='2 m Wet Bulb', & + ptr_patch=this%wb_ref2m_patch) + + this%wb_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='WBA_U', units='C', & + avgflag='A', long_name='Urban 2 m Wet Bulb', & + ptr_patch=this%wb_ref2m_u_patch, set_nourb=spval) + + this%wb_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='WBA_R', units='C', & + avgflag='A', long_name='Rural 2 m Wet Bulb', & + ptr_patch=this%wb_ref2m_r_patch, set_spec=spval) + + this%teq_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='TEQ', units='K', & + avgflag='A', long_name='2 m Equiv Temp', & + ptr_patch=this%teq_ref2m_patch) + + this%teq_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='TEQ_U', units='K', & + avgflag='A', long_name='Urban 2 m Equiv Temp', & + ptr_patch=this%teq_ref2m_u_patch, set_nourb=spval) + + this%teq_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='TEQ_R', units='K', & + avgflag='A', long_name='Rural 2 m Equiv Temp', & + ptr_patch=this%teq_ref2m_r_patch, set_spec=spval) + + this%ept_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='EPT', units='K', & + avgflag='A', long_name='2 m Equiv Pot Temp', & + ptr_patch=this%ept_ref2m_patch) + + this%ept_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='EPT_U', units='K', & + avgflag='A', long_name='Urban 2 m Equiv Pot Temp', & + ptr_patch=this%ept_ref2m_u_patch, set_nourb=spval) + + this%ept_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='EPT_R', units='K', & + avgflag='A', long_name='Rural 2 m Equiv Pot Temp', & + ptr_patch=this%ept_ref2m_r_patch, set_spec=spval) + + this%discomf_index_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOI', units='C', & + avgflag='A', long_name='2 m Discomfort Index', & + ptr_patch=this%discomf_index_ref2m_patch) + + this%discomf_index_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOI_U', units='C', & + avgflag='A', long_name='Urban 2 m Discomfort Index', & + ptr_patch=this%discomf_index_ref2m_u_patch, set_nourb=spval) + + this%discomf_index_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOI_R', units='C', & + avgflag='A', long_name='Rural 2 m Discomfort Index', & + ptr_patch=this%discomf_index_ref2m_r_patch, set_spec=spval) + + this%discomf_index_ref2mS_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOIS', units='C', & + avgflag='A', long_name='2 m Stull Discomfort Index', & + ptr_patch=this%discomf_index_ref2mS_patch) + + this%discomf_index_ref2mS_u_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOIS_U', units='C', & + avgflag='A', long_name='Urban 2 m Stull Discomfort Index', & + ptr_patch=this%discomf_index_ref2mS_u_patch, set_nourb=spval) + + this%discomf_index_ref2mS_r_patch(begp:endp) = spval + call hist_addfld1d (fname='DISCOIS_R', units='C', & + avgflag='A', long_name='Rural 2 m Stull Discomfort Index', & + ptr_patch=this%discomf_index_ref2mS_r_patch, set_spec=spval) + + this%nws_hi_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='HIA', units='C', & + avgflag='A', long_name='2 m NWS Heat Index', & + ptr_patch=this%nws_hi_ref2m_patch) + + this%nws_hi_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='HIA_U', units='C', & + avgflag='A', long_name='Urban 2 m NWS Heat Index', & + ptr_patch=this%nws_hi_ref2m_u_patch, set_nourb=spval) + + this%nws_hi_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='HIA_R', units='C', & + avgflag='A', long_name='Rural 2 m NWS Heat Index', & + ptr_patch=this%nws_hi_ref2m_r_patch, set_spec=spval) + + this%thip_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='THIP', units='C', & + avgflag='A', long_name='2 m Temp Hum Index Physiology', & + ptr_patch=this%thip_ref2m_patch) + + this%thip_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='THIP_U', units='C', & + avgflag='A', long_name='Urban 2 m Temp Hum Index Physiology', & + ptr_patch=this%thip_ref2m_u_patch, set_nourb=spval) + + this%thip_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='THIP_R', units='C', & + avgflag='A', long_name='Rural 2 m Temp Hum Index Physiology', & + ptr_patch=this%thip_ref2m_r_patch, set_spec=spval) + + this%thic_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='THIC', units='C', & + avgflag='A', long_name='2 m Temp Hum Index Comfort', & + ptr_patch=this%thic_ref2m_patch) + + this%thic_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='THIC_U', units='C', & + avgflag='A', long_name='Urban 2 m Temp Hum Index Comfort', & + ptr_patch=this%thic_ref2m_u_patch, set_nourb=spval) + + this%thic_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='THIC_R', units='C', & + avgflag='A', long_name='Rural 2 m Temp Hum Index Comfort', & + ptr_patch=this%thic_ref2m_r_patch, set_spec=spval) + + this%swmp65_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP65', units='C', & + avgflag='A', long_name='2 m Swamp Cooler Temp 65% Eff', & + ptr_patch=this%swmp65_ref2m_patch) + + this%swmp65_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP65_U', units='C', & + avgflag='A', long_name='Urban 2 m Swamp Cooler Temp 65% Eff', & + ptr_patch=this%swmp65_ref2m_u_patch, set_nourb=spval) + + this%swmp65_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP65_R', units='C', & + avgflag='A', long_name='Rural 2 m Swamp Cooler Temp 65% Eff', & + ptr_patch=this%swmp65_ref2m_r_patch, set_spec=spval) + + this%swmp80_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP80', units='C', & + avgflag='A', long_name='2 m Swamp Cooler Temp 80% Eff', & + ptr_patch=this%swmp80_ref2m_patch) + + this%swmp80_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP80_U', units='C', & + avgflag='A', long_name='Urban 2 m Swamp Cooler Temp 80% Eff', & + ptr_patch=this%swmp80_ref2m_u_patch, set_nourb=spval) + + this%swmp80_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='SWMP80_R', units='C', & + avgflag='A', long_name='Rural 2 m Swamp Cooler Temp 80% Eff', & + ptr_patch=this%swmp80_ref2m_r_patch, set_spec=spval) + +end subroutine InitHistory + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: HumanIndexReadNML +! +! !INTERFACE: + subroutine HumanIndexReadNML( NLFilename ) +! +! !DESCRIPTION: +! +! !USES: + use shr_mpi_mod , only : shr_mpi_bcast + use abortutils , only : endrun + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg +! +! !ARGUMENTS: + implicit none + character(len=*), intent(IN) :: NLFilename ! Namelist filename +! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'UrbanReadNML' ! subroutine name +!EOP +!----------------------------------------------------------------------- + namelist / clm_humanindex_inparm / calc_human_stress_indices + + ! ---------------------------------------------------------------------- + ! Read namelist from input namelist filename + ! ---------------------------------------------------------------------- + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in clm_humanindex_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'clm_humanindex_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clm_humanindex_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading clm_humanindex_inparm namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if + + ! Broadcast namelist variables read in + call shr_mpi_bcast(calc_human_stress_indices, mpicom) + + end subroutine HumanIndexReadNML + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: AppTemp +! +! !INTERFACE: + subroutine AppTemp (Tc_1, vap_pres, u10_m, app_temp) +! +! !DESCRIPTION: +! Apparent Temperature (Australian BOM): Here we use equation 22 +! where AT is a function of air temperature (C), water +! vapor pressure (kPa), and 10-m wind speed (m/s). vap_pres +! from Erich Fischer (consistent with CLM equations) +! +! Reference: Steadman, R.G., 1994: Norms of apparent temperature +! in Australia, Aust. Met. Mag., 43, 1-16. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_1 ! temperature (C) + real(r8), intent(in) :: vap_pres ! Vapor Pressure (pa) + real(r8), intent(in) :: u10_m ! Winds at 10m (m/s) + real(r8), intent(out) :: app_temp ! Apparent Temperature (C) +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + app_temp = Tc_1 + 3.30_r8*vap_pres/1000._r8 - 0.70_r8*u10_m - 4.0_r8 + + end subroutine AppTemp +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: swbgt +! +! !INTERFACE: + subroutine swbgt (Tc_2, vap_pres, s_wbgt) +! +! !DESCRIPTION: +! Simplified Wet Bulb Globe Temperature: +! Requires air temperature (C), water vapor pressure (hPa) +! +! Reference: Willett, K.M., and S. Sherwood, 2010: Exceedance of heat +! index thresholds for 15 regions under a warming +! climate using the wet-bulb globe temperature, +! Int. J. Climatol., doi:10.1002/joc.2257 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_2 ! temperature (C) + real(r8), intent(in) :: vap_pres ! Vapor Pressure (pa) + real(r8), intent(out) :: s_wbgt ! Simplified Wet Bulb Globe Temperature (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + s_wbgt = 0.567_r8*(Tc_2) + 0.393_r8*vap_pres/100._r8 + 3.94_r8 + + end subroutine swbgt +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hmdex +! +! !INTERFACE: + subroutine hmdex (Tc_3, vap_pres, humidex) +! +! !DESCRIPTION: +! Humidex: +! Requires air temperature (C), water vapor pressure (hPa) +! Reference: Masterson, J., and F. Richardson, 1979: Humidex, a +! method of quantifying human discomfort due to +! excessive heat and humidity, CLI 1-79, Environment +! Canada, Atmosheric Environment Service, Downsview, Ontario +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_3 ! temperature (C) + real(r8), intent(in) :: vap_pres ! Vapor Pressure (Pa) + real(r8), intent(out) :: humidex ! Humidex (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + humidex = Tc_3 + ((5._r8/9._r8) * (vap_pres/100._r8 - 10._r8)) + + end subroutine hmdex +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: dis_coi +! +! !INTERFACE: + subroutine dis_coi (Tc_4, wb_t, discoi) +! +! !DESCRIPTION: +! Discomfort Index +! The wet bulb temperature is from Davies-Jones, 2008. +! Requires air temperature (C), wet bulb temperature (C) +! Reference: Epstein, Y., and D.S. Moran, 2006: Thermal comfort and the heat stress indices, +! Ind. Health, 44, 388-398. +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_4 ! temperature (C) + real(r8), intent(in) :: wb_t ! Wet Bulb Temperature (C) + real(r8), intent(out) :: discoi ! Discomfort Index (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + discoi = 0.5_r8*wb_t + 0.5_r8*Tc_4 + + end subroutine dis_coi +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: dis_coiS +! +! !INTERFACE: + subroutine dis_coiS (Tc_5, relhum, wbt_s, discois) +! +! !DESCRIPTION: +! Discomfort Index +! The wet bulb temperature is from Stull, 2011. +! Requires air temperature (C), wet bulb temperature (C) +! Reference: Epstein, Y., and D.S. Moran, 2006: Thermal comfort and the heat stress indices, +! Ind. Health, 44, 388-398. +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_5 ! temperature (C) + real(r8), intent(in) :: wbt_s ! Wet Bulb Temperature (C) + real(r8), intent(in) :: relhum ! Relative Humidity (%) + real(r8), intent(out) :: discois ! Discomfort Index (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: Tc ! 2-m temperature with limit (C) + real(r8) :: rh ! 2-m relative humidity with limit (%) + real(r8) :: rh_min ! Minimum 2-m relative humidity (%) + +! +!----------------------------------------------------------------------- + Tc = min(Tc_5,50._r8) + rh = min(relhum,99._r8) + rh = max(rh,5._r8) + rh_min = Tc*(-2.27_r8)+27.7_r8 + if (Tc < -20._r8 .or. rh < rh_min) then + ! wbt_s calculation invalid + discois = Tc + else + ! wbt_s calculation valid + discois = 0.5_r8*wbt_s + 0.5_r8*Tc + end if + + end subroutine dis_coiS +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Wet_Bulb +! +! !INTERFACE: + subroutine Wet_Bulb (Tin_1,vape,pin,relhum,qin,Teq,epott,wb_it) + +! +! !DESCRIPTION: +! Calculates Wet Bulb Temperature, Theta_wb, Theta_e, Moist Pot Temp, +! Lifting Cond Temp, and Equiv Temp using Davies-Jones 2008 Method. +! 1st calculates the lifting cond temperature (Bolton 1980 eqn 22). +! Then calculates the moist pot temp (Bolton 1980 eqn 24). Then +! calculates Equivalent Potential Temperature (Bolton 1980 eqn 39). +! From equivalent pot temp, equiv temp and Theta_w (Davies-Jones +! 2008 eqn 3.5-3.8). An accurate 'first guess' of wet bulb temperature +! is determined (Davies-Jones 2008 eqn 4.8-4.11). Newton-Raphson +! is used for 2 iterations, determining final wet bulb temperature +! (Davies-Jones 2008 eqn 2.6). +! Requires Temperature,Vapor Pressure,Atmospheric Pressure,Relative Humidity,Mixing Ratio +! Reference: Bolton: The computation of equivalent potential temperature. +! Monthly weather review (1980) vol. 108 (7) pp. 1046-1053 +! Davies-Jones: An efficient and accurate method for computing the +! wet-bulb temperature along pseudoadiabats. Monthly Weather Review +! (2008) vol. 136 (7) pp. 2764-2785 +! Flatau et al: Polynomial fits to saturation vapor pressure. +! Journal of Applied Meteorology (1992) vol. 31 pp. 1507-1513 +! Note: Pressure needs to be in mb, mixing ratio needs to be in +! kg/kg in some equations, and in g/kg in others. +! Calculates Iteration via Newton-Raphson Method. Only 2 iterations. +! Reference: Davies-Jones: An efficient and accurate method for computing the +! wet-bulb temperature along pseudoadiabats. Monthly Weather Review +! (2008) vol. 136 (7) pp. 2764-2785 +! Flatau et al: Polynomial fits to saturation vapor pressure. +! Journal of Applied Meteorology (1992) vol. 31 pp. 1507-1513 +! Note: Pressure needs to be in mb, mixing ratio needs to be in +! kg/kg in some equations. +! +! !REVISION HISTORY: +! +! Created by Jonathan R Buzan 03-07-12 +! Modified JRBuzan 06-29-13: Major Revision. Changes all Calculations to be based +! upon Bolton eqn 39. Uses Derivatives in Davies-Jones +! 2008 for calculation of vapor pressure. +! Modified JRBuzan 03-21-14: Minor Revision. Changed specific humidity to mixing +! ratio. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tin_1 ! 2-m air temperature (K) + real(r8), intent(in) :: vape ! Vapor Pressure (Pa) + real(r8), intent(in) :: pin ! Atmospheric Pressure (Pa) + real(r8), intent(in) :: relhum ! Relative Humidity (%) + real(r8), intent(in) :: qin ! Specific Humidity (kg/kg) + + real(r8), intent(out) :: Teq ! Equivalent Temperature (K) + real(r8), intent(out) :: epott ! Equivalent Potential Temperature (K) + real(r8), intent(out) :: wb_it ! Constant used for extreme cold temparatures (K) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: k1 ! Quadratic Parameter (C) + real(r8) :: k2 ! Quadratic Parameter scaled by X (C) + real(r8) :: pmb ! Atmospheric Surface Pressure (mb) + real(r8) :: D ! Linear Interpolation of X + + real(r8) :: constA = 2675._r8 ! Constant used for extreme cold temparatures (K) + real(r8) :: grms = 1000._r8 ! Gram per Kilogram (g/kg) + real(r8) :: p0 = 1000._r8 ! surface pressure (mb) + real(r8) :: C ! Temperature of Freezing (K) + + real(r8) :: hot ! Dimensionless Quantity used for changing temperature regimes + real(r8) :: cold ! Dimensionless Quantity used for changing temperature regimes + + real(r8) :: kappad = 0.2854_r8 ! Heat Capacity + real(r8) :: T1 ! Temperature (K) + real(r8) :: vapemb ! Vapor Pressure (mb) + real(r8) :: mixr ! Mixing Ratio (g/kg) + + real(r8) :: es_mb_teq ! saturated vapour pressure for wrt TEQ (mb) + real(r8) :: de_mbdTeq ! Derivative of Saturated Vapor pressure wrt TEQ (mb/K) + real(r8) :: dlnes_mbdTeq ! Log derivative of the sat. vap pressure wrt TEQ (mb/K) + real(r8) :: rs_teq ! Mixing Ratio wrt TEQ (kg/kg) + real(r8) :: rsdTeq ! Derivative of Mixing Ratio wrt TEQ (kg/kg/K) + real(r8) :: foftk_teq ! Function of EPT wrt TEQ + real(r8) :: fdTeq ! Derivative of Function of EPT wrt TEQ + + real(r8) :: wb_temp ! Wet Bulb Temperature First Guess (C) + real(r8) :: es_mb_wb_temp ! Vapor Pressure wrt Wet Bulb Temp (mb) + real(r8) :: de_mbdwb_temp ! Derivative of Sat. Vapor Pressure wrt WB Temp (mb/K) + real(r8) :: dlnes_mbdwb_temp ! Log Derivative of sat. vap. pressure wrt WB Temp (mb/K) + real(r8) :: rs_wb_temp ! Mixing Ratio wrt WB Temp (kg/kg) + real(r8) :: rsdwb_temp ! Derivative of Mixing Ratio wrt WB Temp (kg/kg/K) + real(r8) :: foftk_wb_temp ! Function of EPT wrt WB Temp + real(r8) :: fdwb_temp ! Derivative of function of EPT wrt WB Temp + + real(r8) :: tl ! Lifting Condensation Temperature (K) + real(r8) :: theta_dl ! Moist Potential Temperature (K) + real(r8) :: pi ! Non dimensional Pressure + real(r8) :: X ! Ratio of equivalent temperature to freezing scaled by Heat Capacity + + integer :: j ! Iteration Step Number +!----------------------------------------------------------------------- + + C = SHR_CONST_TKFRZ ! Freezing Temperature + pmb = pin*0.01_r8 ! pa to mb + vapemb = vape*0.01_r8 ! pa to mb + T1 = Tin_1 ! Use holder for T + mixr = qin/(1._r8 - qin) * grms ! change specific humidity to mixing ratio (g/kg) + + ! Calculate Equivalent Pot. Temp (pmb, T, mixing ratio (g/kg), pott, epott) + ! Calculate Parameters for Wet Bulb Temp (epott, pmb) + pi = (pmb/p0)**(kappad) + D = (0.1859_r8*pmb/p0 + 0.6512)**(-1._r8) + k1 = -38.5_r8*pi*pi +137.81_r8*pi -53.737_r8 + k2 = -4.392_r8*pi*pi +56.831_r8*pi -0.384_r8 + + ! Calculate lifting condensation level. first eqn + ! uses vapor pressure (mb) + ! 2nd eqn uses relative humidity. + ! first equation: Bolton 1980 Eqn 21. + ! tl = (2840._r8/(3.5_r8*log(T1) - log(vapemb) - 4.805_r8)) + 55._r8 + ! second equation: Bolton 1980 Eqn 22. relhum = relative humidity + tl = (1._r8/((1._r8/((T1 - 55._r8))) - (log(relhum/100._r8)/2840._r8))) + 55._r8 + + ! Theta_DL: Bolton 1980 Eqn 24. + theta_dl = T1*((p0/(pmb-vapemb))**kappad)*((T1/tl)**(mixr*0.00028_r8)) + + ! EPT: Bolton 1980 Eqn 39. + epott = theta_dl*exp(((3.036_r8/tl)-0.00178_r8)*mixr*(1._r8 + 0.000448_r8*mixr)) + Teq = epott*pi ! Equivalent Temperature at pressure + X = (C/Teq)**3.504_r8 + + ! Calculates the regime requirements of wet bulb equations. + if (Teq > 355.15_r8) then + hot = 1.0_r8 + else + hot = 0.0_r8 + endif + + if ((X >= 1._r8) .AND. (X <= D)) then + cold = 0._r8 + else + cold = 1._r8 + endif + + ! Calculate Wet Bulb Temperature, initial guess + ! Extremely cold regime if X.gt.D then need to + ! calculate dlnesTeqdTeq + if (X > D) then + call QSat_2(Teq, pin, es_mb_teq, de_mbdTeq, dlnes_mbdTeq, rs_teq, rsdTeq, foftk_teq, fdTeq) + wb_temp = Teq - C - ((constA*rs_teq)/(1._r8 + (constA*rs_teq*dlnes_mbdTeq))) + else + wb_temp = k1 - 1.21_r8 * cold - 1.45_r8 * hot - (k2 - 1.21_r8 * cold) * X + (0.58_r8 / X) * hot + endif + + ! Newton-Raphson Method 2 iteration + ! May need to put in a second iteration. Probably best with a do loop. + do j = 0, 1 + call QSat_2(wb_temp+C, pin, es_mb_wb_temp, de_mbdwb_temp, dlnes_mbdwb_temp, & + rs_wb_temp, rsdwb_temp, foftk_wb_temp, fdwb_temp) + wb_temp = wb_temp - ((foftk_wb_temp - X)/fdwb_temp) + wb_it = wb_temp + end do + + end subroutine Wet_Bulb +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Wet_BulbS +! +! !INTERFACE: + subroutine Wet_BulbS (Tc_6,rh,wbt) + +! +! !DESCRIPTION: +! Reference: Stull, R., 2011: Wet-bulb temperature from relative humidity +! and air temperature, J. Appl. Meteor. Climatol., doi:10.1175/JAMC-D-11-0143.1 +! Note: Requires air temperature (C) and relative humidity (%) +! Note: Pressure needs to be in mb, mixing ratio needs to be in +! kg/kg in some equations. +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-07-12 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_6 ! Temperature (C) + real(r8), intent(in) :: rh ! Relative Humidity (%) + real(r8), intent(out) :: wbt ! Wet Bulb Temperature (C) +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! + wbt = Tc_6 * atan(0.151977_r8*sqrt(rh + 8.313659_r8)) + & + atan(Tc_6+rh) - atan(rh-1.676331_r8) + & + 0.00391838_r8*rh**(3._r8/2._r8)*atan(0.023101_r8*rh) - & + 4.686035_r8 + + end subroutine Wet_BulbS +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: HeatIndex +! +! !INTERFACE: + subroutine HeatIndex (Tc_7, rh, hi) +! +! !DESCRIPTION: +! National Weather Service Heat Index +! Requires air temperature (F), relative humidity (%) +! Valid for air temperatures above 20C. If below this set heatindex to air temperature. +! Reference: Steadman. The assessment of sultriness. Part I: +! A temperature-humidity index based on human physiology +! and clothing science. J Appl Meteorol (1979) vol. 18 (7) pp. 861-873 +! Lans P. Rothfusz. "The heat index 'equation' (or +! more than you ever wanted to know about heat index)", +! Scientific Services Division (NWS Southern Region Headquarters), 1 July 1990 +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-07-12 +! Modified JRBuzan 03-10-12 +! Modified JRBuzan 05-14-13: removed testing algorithm +! Switched output to Celsius +! Used Boundary Conditions from +! Keith Oleson +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_7 ! temperature (C) + real(r8), intent(in) :: rh ! relative humidity (%) + real(r8), intent(out) :: hi ! Heat Index (C) +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: tf +! +!----------------------------------------------------------------------- + tf = (Tc_7) * 9._r8/5._r8 + 32._r8 ! fahrenheit + + if (tf < 68._r8) then + hi = tf + else + hi = -42.379_r8 + 2.04901523_r8*tf & + + 10.14333127_r8*rh & + + (-0.22475541_r8*tf*rh) & + + (-6.83783e-3_r8*tf**2._r8) & + + (-5.481717e-2_r8*rh**2._r8) & + + 1.22874e-3_r8*(tf**2._r8)*rh & + + 8.5282e-4_r8*tf*rh**2._r8 & + + (-1.99e-6_r8*(tf**2._r8)*(rh**2._r8)) + endif + hi = (hi - 32._r8) * 5._r8/9._r8 ! Celsius + + end subroutine HeatIndex +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: THIndex +! +! !INTERFACE: + subroutine THIndex (Tc_8, wb_t, thic, thip) +! +! !DESCRIPTION: +! Temperature Humidity Index +! The wet bulb temperature is Davies-Jones 2008 (subroutine WetBulb) +! Requires air temperature (C), wet bulb temperature (C) +! Calculates two forms of the index: Comfort and Physiology +! Reference: NWSCR (1976): Livestock hot weather stress. +! Regional operations manual letter C-31-76. +! National Weather Service Central Region, USA +! Ingram: Evaporative cooling in the pig. Nature (1965) +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-15-13 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_8 ! temperature (C) + real(r8), intent(in) :: wb_t ! Wet Bulb Temperature (C) + real(r8), intent(out) :: thic ! Temperature Humidity Index Comfort (C) + real(r8), intent(out) :: thip ! Temperature Humidity Index Physiology (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! +! real(r8) :: + +! +!----------------------------------------------------------------------- + thic = 0.72_r8*wb_t + 0.72_r8*(Tc_8) + 40.6_r8 + thip = 0.63_r8*wb_t + 1.17_r8*(Tc_8) + 32._r8 + + end subroutine THIndex +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SwampCoolEff +! +! !INTERFACE: + subroutine SwampCoolEff (Tc_9, wb_t, tswmp80, tswmp65) +! +! !DESCRIPTION: +! Swamp Cooler Efficiency +! The wet bulb temperature is Davies-Jones 2008 (subroutine WetBulb) +! Requires air temperature (C), wet bulb temperature (C) +! Assumes that the Swamp Cooler Efficiency 80% (properly maintained) +! and 65% (improperly maintained). +! Reference: Koca et al: Evaporative cooling pads: test +! procedure and evaluation. Applied engineering +! in agriculture (1991) vol. 7 +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-15-13 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: Tc_9 ! temperature (C) + real(r8), intent(in) :: wb_t ! Wet Bulb Temperature (C) + real(r8), intent(out) :: tswmp80 ! Swamp Cooler Temp 80% Efficient (C) + real(r8), intent(out) :: tswmp65 ! Swamp Cooler Temp 65% Efficient (C) + +! +! !CALLED FROM: +! subroutine LakeFluxes in module LakeFluxesMod +! subroutine CanopyFluxes in module CanopyFluxesMod +! subroutine UrbanFluxes in module UrbanFluxesMod +! subroutine BareGroundFluxes in module BareGroundFluxesMod +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: neu80 = 0.80_r8 ! 80% Efficient + real(r8) :: neu65 = 0.65_r8 ! 65% Efficient + +! +!----------------------------------------------------------------------- + tswmp80 = Tc_9 - neu80*(Tc_9 - wb_t) + tswmp65 = Tc_9 - neu65*(Tc_9 - wb_t) + + end subroutine SwampCoolEff +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: KtoC +! +! !INTERFACE: + subroutine KtoC (T_k, T_c) +! +! !DESCRIPTION: +! Converts Kelvins to Celsius +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-16-13 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T_k ! temperature (K) + real(r8), intent(out) :: T_c ! temperature (C) + +! +! !CALLED FROM: +! subroutines within this module +! +! !LOCAL VARIABLES: +!EOP +! +! real(r8) :: + +! +!----------------------------------------------------------------------- + T_c = T_k - SHR_CONST_TKFRZ + + end subroutine KtoC +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: VaporPres +! +! !INTERFACE: + subroutine VaporPres (rh, e, erh) +! +! !DESCRIPTION: +! Calculates Vapor Pressure +! Vapor Pressure from Erich Fischer (consistent with CLM +! equations, Keith Oleson) +! !REVISION HISTORY: +! Created by Jonathan R Buzan 03-16-13 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: rh ! Relative Humidity (%) + real(r8), intent(in) :: e ! Saturated Vapor Pressure (Pa) + real(r8), intent(out) :: erh ! Vapor Pressure (Pa) + +! +! !CALLED FROM: +! subroutines within this module +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + erh = (rh/100._r8) *e ! Pa + + end subroutine VaporPres +!EOP +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: QSat_2 +! +! !INTERFACE: + subroutine QSat_2 (T_k, p_t, es_mb, de_mbdT, dlnes_mbdT, rs, rsdT, foftk, fdT) +! +! !DESCRIPTION: +! Computes saturation mixing ratio and the change in saturation +! mixing ratio with respect to temperature. Uses Bolton eqn 10, 39. +! Davies-Jones eqns 2.3,A.1-A.10 +! Reference: Bolton: The computation of equivalent potential temperature. +! Monthly weather review (1980) vol. 108 (7) pp. 1046-1053 +! Davies-Jones: An efficient and accurate method for computing the +! wet-bulb temperature along pseudoadiabats. Monthly Weather Review +! (2008) vol. 136 (7) pp. 2764-2785 +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T_k ! temperature (K) + real(r8), intent(in) :: p_t ! surface atmospheric pressure (pa) + real(r8), intent(out) :: es_mb ! vapor pressure (pa) + real(r8), intent(out) :: de_mbdT ! d(es)/d(T) + real(r8), intent(out) :: dlnes_mbdT ! dln(es)/d(T) + real(r8), intent(out) :: rs ! humidity (kg/kg) + real(r8), intent(out) :: rsdT ! d(qs)/d(T) + real(r8), intent(out) :: foftk ! Davies-Jones eqn 2.3 + real(r8), intent(out) :: fdT ! d(f)/d(T) + +! +! !CALLED FROM: +! subroutines within this module +! +! !REVISION HISTORY: +! Created by: Jonathan R Buzan 08/08/13 +! +! !LOCAL VARIABLES: +!EOP +! +! + real(r8) :: lambd_a = 3.504_r8 ! Inverse of Heat Capacity + real(r8) :: alpha = 17.67_r8 ! Constant to calculate vapour pressure + real(r8) :: beta = 243.5_r8 ! Constant to calculate vapour pressure + real(r8) :: epsilon = 0.6220_r8 ! Conversion between pressure/mixing ratio + real(r8) :: es_C = 6.112_r8 ! Vapor Pressure at Freezing STD (mb) + real(r8) :: vkp = 0.2854_r8 ! Heat Capacity + real(r8) :: y0 = 3036._r8 ! constant + real(r8) :: y1 = 1.78_r8 ! constant + real(r8) :: y2 = 0.448_r8 ! constant + real(r8) :: Cf = SHR_CONST_TKFRZ ! Freezing Temp (K) + real(r8) :: refpres = 1000._r8 ! Reference Pressure (mb) + real(r8) :: p_tmb ! Pressure (mb) + real(r8) :: ndimpress ! Non-dimensional Pressure + real(r8) :: prersdt ! Place Holder for derivative humidity + real(r8) :: pminuse ! Vapor Pressure Difference (mb) + real(r8) :: tcfbdiff ! Temp diff ref (C) + real(r8) :: p0ndplam ! dimensionless pressure modified by ref pressure + + real(r8) :: rsy2rs2 ! Constant function of humidity + real(r8) :: oty2rs ! Constant function of humidity + real(r8) :: y0tky1 ! Constant function of Temp + + real(r8) :: d2e_mbdT2 ! d2(es)/d(T)2 + real(r8) :: d2rsdT2 ! d2(r)/d(T)2 + real(r8) :: goftk ! g(T) exponential in f(T) + real(r8) :: gdT ! d(g)/d(T) + real(r8) :: d2gdT2 ! d2(g)/d(T)2 + + real(r8) :: d2fdT2 ! d2(f)/d(T)2 (K) +! +!----------------------------------------------------------------------- + ! Constants used to calculate es(T) + ! Clausius-Clapeyron + p_tmb = p_t*0.01_r8 + tcfbdiff = T_k - Cf + beta + es_mb = es_C*exp(alpha*(T_k - Cf)/(tcfbdiff)) + dlnes_mbdT = alpha*beta/((tcfbdiff)*(tcfbdiff)) + pminuse = p_tmb - es_mb + de_mbdT = es_mb*dlnes_mbdT + d2e_mbdT2 = dlnes_mbdT*(de_mbdT - 2*es_mb/(tcfbdiff)) + + ! Constants used to calculate rs(T) + ndimpress = (p_tmb/refpres)**vkp + p0ndplam = refpres*ndimpress**lambd_a + rs = epsilon*es_mb/(p0ndplam - es_mb) + prersdt = epsilon*p_tmb/((pminuse)*(pminuse)) + rsdT = prersdt*de_mbdT + d2rsdT2 = prersdt*(d2e_mbdT2 -de_mbdT*de_mbdT*(2._r8/(pminuse))) + + ! Constants used to calculate g(T) + rsy2rs2 = rs + y2*rs*rs + oty2rs = 1._r8 + 2._r8*y2*rs + y0tky1 = y0/T_k - y1 + goftk = y0tky1*(rs + y2*rs*rs) + gdT = - y0*(rsy2rs2)/(T_k*T_k) + (y0tky1)*(oty2rs)*rsdT + d2gdT2 = 2._r8*y0*rsy2rs2/(T_k*T_k*T_k) - 2._r8*y0*rsy2rs2*(oty2rs)*rsdT + & + y0tky1*2._r8*y2*rsdT*rsdT + y0tky1*oty2rs*d2rsdT2 + + ! Calculations for used to calculate f(T,ndimpress) + foftk = ((Cf/T_k)**lambd_a)*(1._r8 - es_mb/p0ndplam)**(vkp*lambd_a)* & + exp(-lambd_a*goftk) + fdT = -lambd_a*(1._r8/T_k + vkp*de_mbdT/pminuse + gdT) + d2fdT2 = lambd_a*(1._r8/(T_k*T_k) - vkp*de_mbdT*de_mbdT/(pminuse*pminuse) - & + vkp*d2e_mbdT2/pminuse - d2gdT2) + + end subroutine QSat_2 +!EOP +!----------------------------------------------------------------------- + +end module HumanIndexMod + diff --git a/components/clm/src/biogeophys/HydrologyDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 new file mode 100644 index 0000000000..75adfd56c9 --- /dev/null +++ b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 @@ -0,0 +1,260 @@ +module HydrologyDrainageMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates soil/snow hydrology with drainage (subsurface runoff) + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varctl , only : iulog, use_vichydro + use clm_varcon , only : e_ice, denh2o, denice, rpi, spval + use atm2lndType , only : atm2lnd_type + use glc2lndMod , only : glc2lnd_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use IrrigationMod , only : irrigation_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: HydrologyDrainage ! Calculates soil/snow hydrolog with drainage + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine HydrologyDrainage(bounds, & + num_nolakec, filter_nolakec, & + num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + num_do_smb_c, filter_do_smb_c, & + atm2lnd_inst, glc2lnd_inst, temperature_inst, & + soilhydrology_inst, soilstate_inst, waterstate_inst, waterflux_inst, & + irrigation_inst) + ! + ! !DESCRIPTION: + ! Calculates soil/snow hydrology with drainage (subsurface runoff) + ! + ! !USES: + use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop + use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, icol_shadewall + use clm_varcon , only : denh2o, denice, secspday + use clm_varctl , only : glc_snow_persistence_max_days, use_vichydro + use clm_varpar , only : nlevgrnd, nlevurb + use clm_time_manager , only : get_step_size, get_nstep + use SoilHydrologyMod , only : CLMVICMap, Drainage + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(in) :: num_do_smb_c ! number of bareland columns in which SMB is calculated, in column filter + integer , intent(in) :: filter_do_smb_c(:) ! column filter for bare land SMB columns + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(glc2lnd_type) , intent(in) :: glc2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(irrigation_type) , intent(in) :: irrigation_inst + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,j,fc ! indices + real(r8) :: dtime ! land model time step (sec) + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + ctype => col%itype , & ! Input: [integer (:) ] column type + + qflx_floodg => atm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] gridcell flux of flood water from RTM + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + + glc_dyn_runoff_routing => glc2lnd_inst%glc_dyn_runoff_routing_grc,& ! Input: [real(r8) (:) ] whether we're doing runoff routing appropriate for having a dynamic icesheet + + wa => soilhydrology_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) + + h2ocan => waterstate_inst%h2ocan_col , & ! Input: [real(r8) (:) ] canopy water (mm H2O) + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + begwb => waterstate_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step + endwb => waterstate_inst%endwb_col , & ! Output: [real(r8) (:) ] water mass end of the time step + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + snow_persistence => waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered + + qflx_evap_tot => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_glcice_melt => waterflux_inst%qflx_glcice_melt_col , & ! Input: [real(r8) (:)] ice melt (positive definite) (mm H2O/s) + qflx_h2osfc_surf => waterflux_inst%qflx_h2osfc_surf_col , & ! Output: [real(r8) (:) ] surface water runoff (mm/s) + qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] sub-surface runoff from perched zwt (mm H2O /s) + qflx_rsub_sat => waterflux_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] + qflx_drain => waterflux_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_surf => waterflux_inst%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_infl => waterflux_inst%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) + qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes + qflx_runoff => waterflux_inst%qflx_runoff_col , & ! Output: [real(r8) (:) ] total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + qflx_runoff_u => waterflux_inst%qflx_runoff_u_col , & ! Output: [real(r8) (:) ] Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + qflx_runoff_r => waterflux_inst%qflx_runoff_r_col , & ! Output: [real(r8) (:) ] Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+]` + qflx_glcice => waterflux_inst%qflx_glcice_col , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O /s) + qflx_glcice_frz => waterflux_inst%qflx_glcice_frz_col , & ! Output: [real(r8) (:) ] ice growth (positive definite) (mm H2O/s) + + qflx_irrig => irrigation_inst%qflx_irrig_col & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) + ) + + ! Determine time step and step size + + dtime = get_step_size() + + if (use_vichydro) then + call CLMVICMap(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, waterstate_inst) + endif + + call Drainage(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc,& + temperature_inst, soilhydrology_inst, soilstate_inst, & + waterstate_inst, waterflux_inst) + + do j = 1, nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if ((ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall & + .or. ctype(c) == icol_roof) .and. j > nlevurb) then + else + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + end if + end do + end do + + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + + if (ctype(c) == icol_roof .or. ctype(c) == icol_sunwall & + .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_road_imperv) then + endwb(c) = h2ocan(c) + h2osno(c) + else + ! add h2osfc to water balance + endwb(c) = h2ocan(c) + h2osno(c) + h2osfc(c) + wa(c) + + end if + end do + + do j = 1, nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if ((ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall & + .or. ctype(c) == icol_roof) .and. j > nlevurb) then + + else + endwb(c) = endwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end if + end do + end do + + ! Prior to summing up wetland/ice hydrology, calculate land ice contributions/sinks + ! to this hydrology. + ! 1) Generate SMB from capped-snow amount. This is done over istice_mec + ! columns, and also any other columns included in do_smb_c filter, where + ! perennial snow has remained for at least snow_persistence_max. + ! 2) If using glc_dyn_runoff_routing=T, zero qflx_snwcp_ice: qflx_snwcp_ice is the flux + ! sent to ice runoff, but for glc_dyn_runoff_routing=T, we do NOT want this to be + ! sent to ice runoff (instead it is sent to CISM). + + do c = bounds%begc,bounds%endc + qflx_glcice_frz(c) = 0._r8 + end do + do fc = 1,num_do_smb_c + c = filter_do_smb_c(fc) + l = col%landunit(c) + g = col%gridcell(c) + ! In the following, we convert glc_snow_persistence_max_days to r8 to avoid overflow + if ( (snow_persistence(c) >= (real(glc_snow_persistence_max_days, r8) * secspday)) & + .or. lun%itype(l) == istice_mec) then + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + if (glc_dyn_runoff_routing(g)) qflx_snwcp_ice(c) = 0._r8 + end if + end do + + ! Determine wetland and land ice hydrology (must be placed here + ! since need snow updated from CombineSnowLayers) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + g = col%gridcell(c) + + if (lun%itype(l)==istwet .or. lun%itype(l)==istice & + .or. lun%itype(l)==istice_mec) then + + qflx_drain(c) = 0._r8 + qflx_drain_perched(c) = 0._r8 + qflx_h2osfc_surf(c) = 0._r8 + qflx_surf(c) = 0._r8 + qflx_infl(c) = 0._r8 + qflx_qrgwl(c) = forc_rain(c) + forc_snow(c) + qflx_floodg(g) - qflx_evap_tot(c) - qflx_snwcp_ice(c) - & + (endwb(c)-begwb(c))/dtime + + ! With glc_dyn_runoff_routing = false (the less realistic way, typically used + ! when NOT coupling to CISM), excess snow immediately runs off, whereas melting + ! ice stays in place and does not run off. The reverse is true with + ! glc_dyn_runoff_routing = true: in this case, melting ice runs off, and excess + ! snow is sent to CISM, where it is converted to ice. These corrections are + ! done here: + + if (glc_dyn_runoff_routing(g) .and. lun%itype(l)==istice_mec) then + ! If glc_dyn_runoff_routing=T, add meltwater from istice_mec ice columns to the runoff. + ! Note: The meltwater contribution is computed in PhaseChanges (part of Biogeophysics2) + qflx_qrgwl(c) = qflx_qrgwl(c) + qflx_glcice_melt(c) + ! Also subtract the freezing component of qflx_glcice: this ice is added to + ! CISM's ice column rather than running off. (This is analogous to the + ! subtraction of qflx_snwcp_ice from qflx_qrgwl above, which accounts for + ! snow that should be put into ice runoff rather than liquid runoff. But for + ! glc_dyn_runoff_routing=true, qflx_snwcp_ice has been zeroed out, and has + ! been put into qflx_glcice_frz.) + qflx_qrgwl(c) = qflx_qrgwl(c) - qflx_glcice_frz(c) + endif + + else if (lun%urbpoi(l) .and. ctype(c) /= icol_road_perv) then + + qflx_drain_perched(c) = 0._r8 + qflx_h2osfc_surf(c) = 0._r8 + qflx_rsub_sat(c) = spval + + end if + + qflx_runoff(c) = qflx_drain(c) + qflx_surf(c) + qflx_h2osfc_surf(c) + qflx_qrgwl(c) + qflx_drain_perched(c) + + if ((lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) .and. col%active(c)) then + qflx_runoff(c) = qflx_runoff(c) - qflx_irrig(c) + end if + if (lun%urbpoi(l)) then + qflx_runoff_u(c) = qflx_runoff(c) + else if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + qflx_runoff_r(c) = qflx_runoff(c) + end if + + end do + + end associate + + end subroutine HydrologyDrainage + +end module HydrologyDrainageMod diff --git a/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 new file mode 100644 index 0000000000..57a87484ae --- /dev/null +++ b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -0,0 +1,480 @@ +Module HydrologyNoDrainageMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate snow and soil temperatures including phase change + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varctl , only : iulog, use_vichydro + use clm_varcon , only : e_ice, denh2o, denice, rpi, spval + use atm2lndType , only : atm2lnd_type + use AerosolMod , only : aerosol_type + use EnergyFluxType , only : energyflux_type + use TemperatureType , only : temperature_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: HydrologyNoDrainage ! Calculates soil/snow hydrology without drainage + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine HydrologyNoDrainage(bounds, & + num_nolakec, filter_nolakec, & + num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + num_snowc, filter_snowc, & + num_nosnowc, filter_nosnowc, & + atm2lnd_inst, soilstate_inst, energyflux_inst, temperature_inst, & + waterflux_inst, waterstate_inst, & + soilhydrology_inst, aerosol_inst, & + soil_water_retention_curve) + ! + ! !DESCRIPTION: + ! This is the main subroutine to execute the calculation of soil/snow + ! hydrology + ! Calling sequence is: + ! -> SnowWater: change of snow mass and snow water onto soil + ! -> SurfaceRunoff: surface runoff + ! -> Infiltration: infiltration into surface soil layer + ! -> SoilWater: soil water movement between layers + ! -> Tridiagonal tridiagonal matrix solution + ! -> Drainage: subsurface runoff + ! -> SnowCompaction: compaction of snow layers + ! -> CombineSnowLayers: combine snow layers that are thinner than minimum + ! -> DivideSnowLayers: subdivide snow layers that are thicker than maximum + ! + ! !USES: + use clm_varcon , only : denh2o, denice, hfus, grav, tfrz + use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop, istdlak + use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall + use column_varcon , only : icol_shadewall + use clm_varctl , only : use_cn + use clm_varpar , only : nlevgrnd, nlevsno, nlevsoi, nlevurb + use clm_time_manager , only : get_step_size, get_nstep + use SnowHydrologyMod , only : SnowCompaction, CombineSnowLayers, DivideSnowLayers + use SnowHydrologyMod , only : SnowWater, BuildSnowFilter + use SoilHydrologyMod , only : CLMVICMap, SurfaceRunoff, Infiltration, WaterTable + use SoilWaterMovementMod , only : SoilWater + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(inout) :: num_snowc ! number of column snow points + integer , intent(inout) :: filter_snowc(:) ! column filter for snow points + integer , intent(inout) :: num_nosnowc ! number of column non-snow points + integer , intent(inout) :: filter_nosnowc(:) ! column filter for non-snow points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,j,fc ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: psi,vwc,fsattmp,psifrz ! temporary variables for soilpsi calculation + real(r8) :: watdry ! temporary + real(r8) :: rwat(bounds%begc:bounds%endc) ! soil water wgted by depth to maximum depth of 0.5 m + real(r8) :: swat(bounds%begc:bounds%endc) ! same as rwat but at saturation + real(r8) :: rz(bounds%begc:bounds%endc) ! thickness of soil layers contributing to rwat (m) + real(r8) :: tsw ! volumetric soil water to 0.5 m + real(r8) :: stsw ! volumetric soil water to 0.5 m at saturation + real(r8) :: fracl ! fraction of soil layer contributing to 10cm total soil water + real(r8) :: s_node ! soil wetness (-) + real(r8) :: icefrac(bounds%begc:bounds%endc,1:nlevsoi) + !----------------------------------------------------------------------- + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + ctype => col%itype , & ! Input: [integer (:) ] column type + + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + dTdz_top => temperature_inst%dTdz_top_col , & ! Output: [real(r8) (:) ] temperature gradient in top layer (col) [K m-1] ! + snot_top => temperature_inst%snot_top_col , & ! Output: [real(r8) (:) ] snow temperature in top layer (col) [K] + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground temperature (Kelvin) + t_grnd_u => temperature_inst%t_grnd_u_col , & ! Output: [real(r8) (:) ] Urban ground temperature (Kelvin) + t_grnd_r => temperature_inst%t_grnd_r_col , & ! Output: [real(r8) (:) ] Rural ground temperature (Kelvin) + t_soi_10cm => temperature_inst%t_soi10cm_col , & ! Output: [real(r8) (:) ] soil temperature in top 10cm of soil (Kelvin) + tsoi17 => temperature_inst%t_soi17cm_col , & ! Output: [real(r8) (:) ] soil temperature in top 17cm of soil (Kelvin) + + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height of snow covered area (m) + snowdp => waterstate_inst%snowdp_col , & ! Input: [real(r8) (:) ] area-averaged snow height (m) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. snow cover fraction (col) [frc] + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + begwb => waterstate_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] + snw_rds_top => waterstate_inst%snw_rds_top_col , & ! Output: [real(r8) (:) ] effective snow grain size, top layer(col) [microns] + sno_liq_top => waterstate_inst%sno_liq_top_col , & ! Output: [real(r8) (:) ] liquid water fraction in top snow layer (col) [frc] + snowice => waterstate_inst%snowice_col , & ! Output: [real(r8) (:) ] average snow ice lens + snowliq => waterstate_inst%snowliq_col , & ! Output: [real(r8) (:) ] average snow liquid water + snow_persistence => waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered + h2osoi_liqice_10cm => waterstate_inst%h2osoi_liqice_10cm_col , & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + h2osno_top => waterstate_inst%h2osno_top_col , & ! Output: [real(r8) (:) ] mass of snow in top layer (col) [kg] + wf => waterstate_inst%wf_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m + wf2 => waterstate_inst%wf2_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + smp_l => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix potential [mm] + smpmin => soilstate_inst%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) + soilpsi => soilstate_inst%soilpsi_col & ! Output: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + ) + + ! Determine step size + + dtime = get_step_size() + + ! Determine initial snow/no-snow filters (will be modified possibly by + ! routines CombineSnowLayers and DivideSnowLayers below + + call BuildSnowFilter(bounds, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + ! Determine the change of snow mass and the snow water onto soil + + call SnowWater(bounds, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & + atm2lnd_inst, waterflux_inst, waterstate_inst, aerosol_inst) + + ! mapping soilmoist from CLM to VIC layers for runoff calculations + if (use_vichydro) then + call CLMVICMap(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, waterstate_inst) + end if + + call SurfaceRunoff(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + soilhydrology_inst, soilstate_inst, waterflux_inst, waterstate_inst) + + call Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc,& + energyflux_inst, soilhydrology_inst, soilstate_inst, temperature_inst, & + waterflux_inst, waterstate_inst) + + call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + soilhydrology_inst, soilstate_inst, waterflux_inst, waterstate_inst, temperature_inst, & + soil_water_retention_curve) + + if (use_vichydro) then + ! mapping soilmoist from CLM to VIC layers for runoff calculations + call CLMVICMap(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, waterstate_inst) + end if + + call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + soilhydrology_inst, soilstate_inst, temperature_inst, waterstate_inst, waterflux_inst) + + ! Natural compaction and metamorphosis. + call SnowCompaction(bounds, num_snowc, filter_snowc, & + temperature_inst, waterstate_inst) + + ! Combine thin snow elements + call CombineSnowLayers(bounds, num_snowc, filter_snowc, & + aerosol_inst, temperature_inst, waterflux_inst, waterstate_inst) + + ! Divide thick snow elements + call DivideSnowLayers(bounds, num_snowc, filter_snowc, & + aerosol_inst, temperature_inst, waterstate_inst, is_lake=.false.) + + ! Set empty snow layers to zero + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j <= snl(c) .and. snl(c) > -nlevsno) then + h2osoi_ice(c,j) = 0._r8 + h2osoi_liq(c,j) = 0._r8 + t_soisno(c,j) = 0._r8 + dz(c,j) = 0._r8 + z(c,j) = 0._r8 + zi(c,j-1) = 0._r8 + end if + end do + end do + + ! Build new snow filter + + call BuildSnowFilter(bounds, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + ! For columns where snow exists, accumulate 'time-covered-by-snow' counters. + ! Otherwise, re-zero counter, since it is bareland + + do fc = 1, num_snowc + c = filter_snowc(fc) + snow_persistence(c) = snow_persistence(c) + dtime + end do + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + snow_persistence(c) = 0._r8 + enddo + + ! Vertically average t_soisno and sum of h2osoi_liq and h2osoi_ice + ! over all snow layers for history output + + do fc = 1, num_nolakec + c = filter_nolakec(fc) + snowice(c) = 0._r8 + snowliq(c) = 0._r8 + end do + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + snowice(c) = snowice(c) + h2osoi_ice(c,j) + snowliq(c) = snowliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Calculate column average snow depth + do c = bounds%begc,bounds%endc + snowdp(c) = snow_depth(c) * frac_sno_eff(c) + end do + + ! Determine ground temperature, ending water balance and volumetric soil water + ! Calculate soil temperature and total water (liq+ice) in top 10cm of soil + ! Calculate soil temperature and total water (liq+ice) in top 17cm of soil + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + t_soi_10cm(c) = 0._r8 + tsoi17(c) = 0._r8 + h2osoi_liqice_10cm(c) = 0._r8 + end if + end do + do j = 1, nlevsoi + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + ! soil T at top 17 cm added by F. Li and S. Levis + if (zi(c,j) <= 0.17_r8) then + fracl = 1._r8 + tsoi17(c) = tsoi17(c) + t_soisno(c,j)*dz(c,j)*fracl + else + if (zi(c,j) > 0.17_r8 .and. zi(c,j-1) < 0.17_r8) then + fracl = (0.17_r8 - zi(c,j-1))/dz(c,j) + tsoi17(c) = tsoi17(c) + t_soisno(c,j)*dz(c,j)*fracl + end if + end if + + if (zi(c,j) <= 0.1_r8) then + fracl = 1._r8 + t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + else + if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) < 0.1_r8) then + fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) + t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + end if + end if + end if + end do + end do + + ! TODO - if this block of code is moved out of here - the SoilHydrology + ! will NOT effect t_grnd, t_grnd_u or t_grnd_r + + do fc = 1, num_nolakec + + c = filter_nolakec(fc) + l = col%landunit(c) + + ! t_grnd is weighted average of exposed soil and snow + if (snl(c) < 0) then + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + (1 - frac_sno_eff(c)- frac_h2osfc(c)) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = (1 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + endif + + if (lun%urbpoi(l)) then + t_grnd_u(c) = t_soisno(c,snl(c)+1) + else + t_soi_10cm(c) = t_soi_10cm(c)/0.1_r8 + tsoi17(c) = tsoi17(c)/0.17_r8 ! F. Li and S. Levis + end if + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + t_grnd_r(c) = t_soisno(c,snl(c)+1) + end if + + end do + + do j = 1, nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if ((ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall & + .or. ctype(c) == icol_roof) .and. j > nlevurb) then + else + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + end if + end do + end do + + if (use_cn) then + ! Update soilpsi. + ! ZMS: Note this could be merged with the following loop updating smp_l in the future. + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + if (h2osoi_liq(c,j) > 0._r8) then + + vwc = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + + ! the following limit set to catch very small values of + ! fractional saturation that can crash the calculation of psi + + ! use the same contants used in the supercool so that psi for frozen soils is consistent + fsattmp = max(vwc/watsat(c,j), 0.001_r8) + psi = sucsat(c,j) * (-9.8e-6_r8) * (fsattmp)**(-bsw(c,j)) ! Mpa + soilpsi(c,j) = min(max(psi,-15.0_r8),0._r8) + + else + soilpsi(c,j) = -15.0_r8 + end if + end do + end do + end if + + ! Update smp_l for history and for ch4Mod. + ! ZMS: Note, this form, which seems to be the same as used in SoilWater, DOES NOT distinguish between + ! ice and water volume, in contrast to the soilpsi calculation above. It won't be used in ch4Mod if + ! t_soisno <= tfrz, though. + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + s_node = min(1.0_r8, s_node) + + smp_l(c,j) = -sucsat(c,j)*s_node**(-bsw(c,j)) + smp_l(c,j) = max(smpmin(c), smp_l(c,j)) + end do + end do + + if (use_cn) then + ! Available soil water up to a depth of 0.05 m. + ! Potentially available soil water (=whc) up to a depth of 0.05 m. + ! Water content as fraction of whc up to a depth of 0.05 m. + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + rwat(c) = 0._r8 + swat(c) = 0._r8 + rz(c) = 0._r8 + end do + + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + !if (z(c,j)+0.5_r8*dz(c,j) <= 0.5_r8) then + if (z(c,j)+0.5_r8*dz(c,j) <= 0.05_r8) then + watdry = watsat(c,j) * (316230._r8/sucsat(c,j)) ** (-1._r8/bsw(c,j)) + rwat(c) = rwat(c) + (h2osoi_vol(c,j)-watdry) * dz(c,j) + swat(c) = swat(c) + (watsat(c,j) -watdry) * dz(c,j) + rz(c) = rz(c) + dz(c,j) + end if + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (rz(c) /= 0._r8) then + tsw = rwat(c)/rz(c) + stsw = swat(c)/rz(c) + else + watdry = watsat(c,1) * (316230._r8/sucsat(c,1)) ** (-1._r8/bsw(c,1)) + tsw = h2osoi_vol(c,1) - watdry + stsw = watsat(c,1) - watdry + end if + wf(c) = tsw/stsw + end do + + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (z(c,j)+0.5_r8*dz(c,j) <= 0.17_r8) then + watdry = watsat(c,j) * (316230._r8/sucsat(c,j)) ** (-1._r8/bsw(c,j)) + rwat(c) = rwat(c) + (h2osoi_vol(c,j)-watdry) * dz(c,j) + swat(c) = swat(c) + (watsat(c,j) -watdry) * dz(c,j) + rz(c) = rz(c) + dz(c,j) + end if + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (rz(c) /= 0._r8) then + tsw = rwat(c)/rz(c) + stsw = swat(c)/rz(c) + else + watdry = watsat(c,1) * (316230._r8/sucsat(c,1)) ** (-1._r8/bsw(c,1)) + tsw = h2osoi_vol(c,1) - watdry + stsw = watsat(c,1) - watdry + end if + wf2(c) = tsw/stsw + end do + end if + + ! top-layer diagnostics + do fc = 1, num_snowc + c = filter_snowc(fc) + h2osno_top(c) = h2osoi_ice(c,snl(c)+1) + h2osoi_liq(c,snl(c)+1) + enddo + + ! Zero variables in columns without snow + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + + h2osno_top(c) = 0._r8 + snw_rds(c,:) = 0._r8 + + ! top-layer diagnostics (spval is not averaged when computing history fields) + snot_top(c) = spval + dTdz_top(c) = spval + snw_rds_top(c) = spval + sno_liq_top(c) = spval + end do + + end associate + + end subroutine HydrologyNoDrainage + +end Module HydrologyNoDrainageMod diff --git a/components/clm/src/biogeophys/IrrigationMod.F90 b/components/clm/src/biogeophys/IrrigationMod.F90 new file mode 100644 index 0000000000..858e89dc57 --- /dev/null +++ b/components/clm/src/biogeophys/IrrigationMod.F90 @@ -0,0 +1,716 @@ +module IrrigationMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates irrigation flux. + ! + ! Usage: + ! + ! - Call CalcIrrigationNeeded in order to compute whether and how much irrigation is + ! needed for the next call to ApplyIrrigation. This should be called once per + ! timestep. + ! + ! - Call ApplyIrrigation in order to calculate qflx_irrig. This should be called + ! exactly once per time step, before the first time qflx_irrig is needed by other + ! parts of the code. It is acceptable for this to be called earlier in the timestep + ! than CalcIrrigationNeeded. + ! + ! - Access the timestep's irrigation flux via qflx_irrig_patch or + ! qflx_irrig_col. These should be treated as read-only. + ! + ! Design notes: + ! + ! In principle, ApplyIrrigation and CalcIrrigationNeeded could be combined into a + ! single routine. However, right now that is challenging, because qflx_irrig is + ! needed earlier in the driver loop than when btran becomes available (and + ! CalcIrrigationNeeded depends on btran). (And qflx_irrig is also used late in the + ! driver loop - so it wouldn't work, for example, to calculate qflx_irrig after btran + ! is computed, and then save it on the restart file for the next iteration of the + ! driver loop: then the uses of qflx_irrig early and late in the driver loop would be + ! inconsistent.) + ! + ! If we could have access to btran earlier in the driver loop, so that + ! CalcIrrigationNeeded could be called before the first time qflx_irrig is needed, + ! then there might be some advantage to combining ApplyIrrigation and + ! CalcIrrigationNeeded - or at least calling these two routines from the same place. + ! In particular: this separation of the irrigation calculation into two routines that + ! are done at different times in the driver loop makes it harder and less desirable to + ! nest the irrigation object within some other object: Doing so might make it harder + ! to do the two separate steps at the right time, and would lead to less clarity about + ! how these two steps are ordered with respect to the rest of the driver loop. So if + ! we start trying to create a hierarchy of objects in CLM, we may want to rethink this + ! design. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type, get_proc_global + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : isecspday, degpsec, denh2o, spval + use clm_varpar , only : nlevgrnd + use clm_time_manager , only : get_step_size + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + + ! !PUBLIC TYPES: + + ! This type is public (and its components are public, too) to aid unit testing + type, public :: irrigation_params_type + ! Note that we give default initialization values here. Once these parameters are + ! moved to the params file, we'll probably want to get rid of this default + ! initialization. + + ! Minimum LAI for irrigation + real(r8) :: irrig_min_lai = 0.0_r8 + + ! BTRAN threshold for irrigation + ! Irrigate when btran falls below 0.999999 rather than 1 to allow for round-off error + real(r8) :: irrig_btran_thresh = 0.999999_r8 + + ! Time of day to check whether we need irrigation, seconds (0 = midnight). + ! We start applying the irrigation in the time step FOLLOWING this time, + ! since we won't begin irrigating until the next call to ApplyIrrigation + integer :: irrig_start_time = isecspday/4 + + ! Desired amount of time to irrigate per day (sec). Actual time may + ! differ if this is not a multiple of dtime. Irrigation won't work properly + ! if dtime > secsperday + integer :: irrig_length = isecspday/6 + + ! Determines target soil moisture level for irrigation. If h2osoi_liq_so + ! is the soil moisture level at which stomata are fully open and + ! h2osoi_liq_sat is the soil moisture level at saturation (eff_porosity), + ! then the target soil moisture level is + ! (h2osoi_liq_so + irrig_factor*(h2osoi_liq_sat - h2osoi_liq_so)). + ! A value of 0 means that the target soil moisture level is h2osoi_liq_so. + ! A value of 1 means that the target soil moisture level is h2osoi_liq_sat + real(r8) :: irrig_factor = 0.7_r8 + + end type irrigation_params_type + + + type, public :: irrigation_type + private + ! Public data members + ! Note: these should be treated as read-only by other modules + real(r8), pointer, public :: qflx_irrig_patch(:) ! patch irrigation flux (mm H2O/s) + real(r8), pointer, public :: qflx_irrig_col (:) ! col irrigation flux (mm H2O/s) + + ! Private data members; set in initialization: + type(irrigation_params_type) :: params + integer :: dtime ! land model time step (sec) + integer :: irrig_nsteps_per_day ! number of time steps per day in which we irrigate + real(r8), pointer :: relsat_so_patch(:,:) ! relative saturation at which smp = smpso (i.e., full stomatal opening) [patch, nlevgrnd] + + ! Private data members; time-varying: + real(r8), pointer :: irrig_rate_patch (:) ! current irrigation rate [mm/s] + integer , pointer :: n_irrig_steps_left_patch (:) ! number of time steps for which we still need to irrigate today (if 0, ignore) + + contains + ! Public routines + ! COMPILER_BUG(wjs, 2014-10-15, pgi 14.7) Add an "Irrigation" prefix to some generic routines like "Init" + ! (without this workaround, pgi compilation fails in restFileMod) + procedure, public :: Init => IrrigationInit + procedure, public :: InitForTesting ! version of Init meant for unit testing + procedure, public :: Restart + procedure, public :: ApplyIrrigation + procedure, public :: CalcIrrigationNeeded + procedure, public :: Clean => IrrigationClean ! deallocate memory + + ! Public simply to support unit testing; should not be used from CLM code + procedure, public, nopass :: IrrigationDeficit ! compute the irrigation deficit for one layer of one point + + ! Private routines + procedure, private :: InitAllocate => IrrigationInitAllocate + procedure, private :: InitHistory => IrrigationInitHistory + procedure, private :: InitCold => IrrigationInitCold + procedure, private :: CalcIrrigNstepsPerDay ! given dtime, calculate irrig_nsteps_per_day + procedure, private :: PointNeedsCheckForIrrig ! whether a given point needs to be checked for irrigation now + end type irrigation_type + + interface irrigation_params_type + module procedure irrigation_params_constructor + end interface irrigation_params_type + +contains + + ! ======================================================================== + ! Constructors + ! ======================================================================== + + !----------------------------------------------------------------------- + function irrigation_params_constructor(irrig_min_lai, irrig_btran_thresh, & + irrig_start_time, irrig_length, irrig_factor) & + result(this) + ! + ! !DESCRIPTION: + ! Create an irrigation_params instance + ! + ! !USES: + ! + ! !ARGUMENTS: + type(irrigation_params_type) :: this ! function result + real(r8), intent(in) :: irrig_min_lai + real(r8), intent(in) :: irrig_btran_thresh + integer , intent(in) :: irrig_start_time + integer , intent(in) :: irrig_length + real(r8), intent(in) :: irrig_factor + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'irrigation_params_constructor' + !----------------------------------------------------------------------- + + this%irrig_min_lai = irrig_min_lai + this%irrig_btran_thresh = irrig_btran_thresh + this%irrig_start_time = irrig_start_time + this%irrig_length = irrig_length + this%irrig_factor = irrig_factor + + end function irrigation_params_constructor + + + ! ======================================================================== + ! Infrastructure routines (initialization, restart, etc.) + ! ======================================================================== + + !------------------------------------------------------------------------ + subroutine IrrigationInit(this, bounds, soilstate_inst, soil_water_retention_curve) + use SoilStateType , only : soilstate_type + + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds, soilstate_inst, soil_water_retention_curve) + end subroutine IrrigationInit + + !----------------------------------------------------------------------- + subroutine InitForTesting(this, bounds, params, dtime, relsat_so) + ! + ! !DESCRIPTION: + ! Does initialization needed for unit testing. Allows caller to prescribe values of + ! some internal variables. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(irrigation_params_type) , intent(in) :: params + integer , intent(in) :: dtime ! model time step (sec) + real(r8) , intent(in) :: relsat_so( bounds%begp: , 1: ) ! relative saturation at which smp = smpso [patch, nlevgrnd] + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'InitForTesting' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(relsat_so) == (/bounds%endp, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + call this%InitAllocate(bounds) + this%params = params + this%dtime = dtime + this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(dtime) + this%relsat_so_patch(:,:) = relsat_so(:,:) + + end subroutine InitForTesting + + + !----------------------------------------------------------------------- + subroutine IrrigationInitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize irrigation data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + + character(len=*), parameter :: subname = 'InitAllocate' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%qflx_irrig_patch (begp:endp)) ; this%qflx_irrig_patch (:) = nan + allocate(this%qflx_irrig_col (begc:endc)) ; this%qflx_irrig_col (:) = nan + allocate(this%relsat_so_patch (begp:endp,nlevgrnd)) ; this%relsat_so_patch(:,:) = nan + allocate(this%irrig_rate_patch (begp:endp)) ; this%irrig_rate_patch (:) = nan + allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 + + end subroutine IrrigationInitAllocate + + !----------------------------------------------------------------------- + subroutine IrrigationInitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize irrigation history fields + ! + ! !USES: + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + + this%qflx_irrig_patch(begp:endp) = spval + call hist_addfld1d (fname='QIRRIG', units='mm/s', & + avgflag='A', long_name='water added through irrigation', & + ptr_patch=this%qflx_irrig_patch) + + end subroutine IrrigationInitHistory + + !----------------------------------------------------------------------- + subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention_curve) + ! + ! !DESCRIPTION: + ! Do cold-start initialization for irrigation data structure + ! + ! !USES: + use pftconMod , only : pftcon + use SoilStateType , only : soilstate_type + use pftconMod , only : noveg + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(soilstate_type) , intent(in) :: soilstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: c ! col index + integer :: j ! level index + + character(len=*), parameter :: subname = 'InitCold' + !----------------------------------------------------------------------- + + associate( & + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) (constant) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (constant) + smpso => pftcon%smpso & ! Input: soil water potential at full stomatal opening (mm) (constant) + ) + + do j = 1, nlevgrnd + do p = bounds%begp, bounds%endp + c = patch%column(p) + if (patch%itype(p) /= noveg) then + call soil_water_retention_curve%soil_suction_inverse( & + smp_target = smpso(patch%itype(p)), & + smpsat = sucsat(c,j), & + bsw = bsw(c,j), & + s_target = this%relsat_so_patch(p,j)) + end if + end do + end do + + this%dtime = get_step_size() + this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(this%dtime) + + end associate + + end subroutine IrrigationInitCold + + !----------------------------------------------------------------------- + pure function CalcIrrigNstepsPerDay(this, dtime) result(irrig_nsteps_per_day) + ! + ! !DESCRIPTION: + ! Given dtime (sec), determine number of irrigation steps per day + ! + ! !USES: + ! + ! !ARGUMENTS: + integer :: irrig_nsteps_per_day ! function result + class(irrigation_type) , intent(in) :: this + integer , intent(in) :: dtime ! model time step (sec) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'CalcIrrigNstepsPerDay' + !----------------------------------------------------------------------- + + irrig_nsteps_per_day = ((this%params%irrig_length + (dtime - 1))/dtime) ! round up + + end function CalcIrrigNstepsPerDay + + + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Handle restart of irrigation variables + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_inqvdlen, ncd_double, ncd_int + use restUtilMod + ! + ! !ARGUMENTS: + class(irrigation_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define' + ! + ! !LOCAL VARIABLES: + logical :: do_io + integer :: dimlen ! dimension length + integer :: nump_global ! total number of patchs, globally + integer :: err_code ! error code + logical :: readvar ! determine if variable is on initial file + + character(len=*), parameter :: subname = 'Restart' + !----------------------------------------------------------------------- + + ! Get expected total number of points, for later error checks + call get_proc_global(np=nump_global) + + do_io = .true. + readvar = .false. + if (flag == 'read') then + ! On a read, confirm that this variable has the expected size; if not, don't read + ! it (instead give it a default value). This is needed to support older initial + ! conditions for which this variable had a different size. + call ncd_inqvdlen(ncid, 'n_irrig_steps_left', 1, dimlen, err_code) + if (dimlen /= nump_global) then + do_io = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='n_irrig_steps_left', xtype=ncd_int, & + dim1name='pft', & + long_name='number of irrigation time steps left', units='#', & + interpinic_flag='interp', readvar=readvar, data=this%n_irrig_steps_left_patch) + end if + if (flag=='read' .and. .not. readvar) then + this%n_irrig_steps_left_patch = 0 + end if + + do_io = .true. + readvar = .false. + if (flag == 'read') then + ! On a read, confirm that this variable has the expected size; if not, don't read + ! it (instead give it a default value). This is needed to support older initial + ! conditions for which this variable had a different size. + call ncd_inqvdlen(ncid, 'irrig_rate', 1, dimlen, err_code) + if (dimlen /= nump_global) then + do_io = .false. + end if + end if + if (do_io) then + call restartvar(ncid=ncid, flag=flag, varname='irrig_rate', xtype=ncd_double, & + dim1name='pft', & + long_name='irrigation rate', units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%irrig_rate_patch) + end if + if (flag=='read' .and. .not. readvar) then + this%irrig_rate_patch = 0.0_r8 + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine IrrigationClean(this) + ! + ! !DESCRIPTION: + ! Deallocate memory + ! + ! !ARGUMENTS: + class(irrigation_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Clean' + !----------------------------------------------------------------------- + + deallocate(this%qflx_irrig_patch) + deallocate(this%qflx_irrig_col) + deallocate(this%relsat_so_patch) + deallocate(this%irrig_rate_patch) + deallocate(this%n_irrig_steps_left_patch) + + end subroutine IrrigationClean + + + ! ======================================================================== + ! Science routines + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine ApplyIrrigation(this, bounds) + ! + ! !DESCRIPTION: + ! Apply the irrigation computed by CalcIrrigationNeeded to qflx_irrig. + ! + ! Should be called once, AND ONLY ONCE, per time step. After this is called, you may + ! access qflx_irrig_patch or qflx_irrig_col. + ! + ! !USES: + use subgridAveMod, only : p2c + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + + character(len=*), parameter :: subname = 'ApplyIrrigation' + !----------------------------------------------------------------------- + + ! This should be called exactly once per time step, so that this counter decrease + ! works correctly. + + do p = bounds%begp, bounds%endp + if (this%n_irrig_steps_left_patch(p) > 0) then + this%qflx_irrig_patch(p) = this%irrig_rate_patch(p) + this%n_irrig_steps_left_patch(p) = this%n_irrig_steps_left_patch(p) - 1 + else + this%qflx_irrig_patch(p) = 0._r8 + end if + end do + + call p2c (bounds = bounds, & + parr = this%qflx_irrig_patch(bounds%begp:bounds%endp), & + carr = this%qflx_irrig_col(bounds%begc:bounds%endc), & + p2c_scale_type = 'unity') + + end subroutine ApplyIrrigation + + + !----------------------------------------------------------------------- + subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedvegp, & + time_prev, elai, btran, rootfr, t_soisno, eff_porosity, h2osoi_liq) + ! + ! !DESCRIPTION: + ! Calculate whether and how much irrigation is needed for each column. However, this + ! does NOT actually set the irrigation flux. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_TKFRZ + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + + ! time of day (in seconds since 0Z) at start of timestep + integer, intent(in) :: time_prev + + ! number of points in filter_exposedvegp + integer, intent(in) :: num_exposedvegp + + ! patch filter for non-snow-covered veg + integer, intent(in) :: filter_exposedvegp(:) + + ! one-sided leaf area index with burying by snow [patch] + real(r8), intent(in) :: elai( bounds%begp: ) + + ! transpiration wetness factor (0 to 1) [patch] + real(r8), intent(in) :: btran( bounds%begp: ) + + ! fraction of roots in each soil later [patch] + real(r8), intent(in) :: rootfr( bounds%begp: , 1: ) + + ! col soil temperature (K) [col, nlevgrnd] (note that this does NOT contain the snow levels) + real(r8), intent(in) :: t_soisno( bounds%begc: , 1: ) + + ! effective porosity (0 to 1) [col, nlevgrnd] + real(r8), intent(in) :: eff_porosity( bounds%begc: , 1: ) + + ! column liquid water (kg/m2) [col, nlevgrnd] (note that this does NOT contain the snow levels) + real(r8), intent(in) :: h2osoi_liq( bounds%begc: , 1: ) + + ! + ! !LOCAL VARIABLES: + integer :: f ! filter index + integer :: p ! patch index + integer :: c ! column index + integer :: g ! gridcell index + integer :: j ! level + + ! difference between desired soil moisture level for this layer and current soil moisture level [kg/m2] + real(r8) :: deficit + + ! where do we need to check soil moisture to see if we need to irrigate? + logical :: check_for_irrig(bounds%begp:bounds%endp) + + ! set to true if we have encountered a frozen soil layer + logical :: frozen_soil(bounds%begp:bounds%endp) + + character(len=*), parameter :: subname = 'CalcIrrigationNeeded' + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(elai) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(btran) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rootfr) == (/bounds%endp, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(eff_porosity) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + + ! Determine if irrigation is needed (over irrigated soil columns) + + ! First, determine in what grid cells we need to bother 'measuring' soil water, to see if we need irrigation + ! Also set n_irrig_steps_left for these grid cells + ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 + ! in this case, we'll irrigate by 0 for the given number of time steps + + do f = 1, num_exposedvegp + p = filter_exposedvegp(f) + g = patch%gridcell(p) + check_for_irrig(p) = this%PointNeedsCheckForIrrig( & + pft_type=patch%itype(p), elai=elai(p), btran=btran(p), & + time_prev=time_prev, londeg=grc%londeg(g)) + + if (check_for_irrig(p)) then + this%n_irrig_steps_left_patch(p) = this%irrig_nsteps_per_day + this%irrig_rate_patch(p) = 0._r8 ! reset; we'll add to this later + end if + end do + + ! Now 'measure' soil water for the grid cells identified above and see if the soil is + ! dry enough to warrant irrigation + ! (Note: frozen_soil could probably be a column-level variable, but that would be + ! slightly less robust to potential future modifications) + frozen_soil(bounds%begp : bounds%endp) = .false. + do j = 1,nlevgrnd + do f = 1, num_exposedvegp + p = filter_exposedvegp(f) + c = patch%column(p) + if (check_for_irrig(p) .and. .not. frozen_soil(p)) then + ! if level L was frozen, then we don't look at any levels below L + if (t_soisno(c,j) <= SHR_CONST_TKFRZ) then + frozen_soil(p) = .true. + else if (rootfr(p,j) > 0._r8) then + deficit = this%IrrigationDeficit( & + relsat_so = this%relsat_so_patch(p,j), & + h2osoi_liq = h2osoi_liq(c,j), & + eff_porosity = eff_porosity(c,j), & + dz = col%dz(c,j), & + irrig_factor = this%params%irrig_factor) + + ! Add deficit to irrig_rate, converting units from mm to mm/sec + this%irrig_rate_patch(p) = this%irrig_rate_patch(p) + & + deficit/(this%dtime*this%irrig_nsteps_per_day) + + end if ! else if (rootfr(p,j) > 0) + end if ! if (check_for_irrig(p) .and. .not. frozen_soil(p)) + end do ! do f + end do ! do j + + + end subroutine CalcIrrigationNeeded + + !----------------------------------------------------------------------- + pure function PointNeedsCheckForIrrig(this, pft_type, elai, btran, time_prev, londeg) & + result(check_for_irrig) + ! + ! !DESCRIPTION: + ! Determine whether a given patch needs to be checked for irrigation now. + ! + ! !USES: + use pftconMod, only : pftcon + ! + ! !ARGUMENTS: + logical :: check_for_irrig ! function result + class(irrigation_type), intent(in) :: this + integer , intent(in) :: pft_type ! type of pft in this patch + real(r8), intent(in) :: elai ! one-sided leaf area index with burying by snow + real(r8), intent(in) :: btran ! transpiration wetness factor (0 to 1) + integer , intent(in) :: time_prev ! time of day (in seconds since 0Z) at start of timestep + real(r8), intent(in) :: londeg ! longitude (degrees) + ! + ! !LOCAL VARIABLES: + ! local time at start of time step (seconds after solar midnight) + integer :: local_time + + ! number of seconds since the prescribed irrigation start time + integer :: seconds_since_irrig_start_time + + character(len=*), parameter :: subname = 'PointNeedsCheckForIrrig' + !----------------------------------------------------------------------- + + if (pftcon%irrigated(pft_type) == 1._r8 .and. & + elai > this%params%irrig_min_lai .and. & + btran < this%params%irrig_btran_thresh) then + ! see if it's the right time of day to start irrigating: + local_time = modulo(time_prev + nint(londeg/degpsec), isecspday) + seconds_since_irrig_start_time = modulo(local_time - this%params%irrig_start_time, isecspday) + if (seconds_since_irrig_start_time < this%dtime) then + check_for_irrig = .true. + else + check_for_irrig = .false. + end if + else + check_for_irrig = .false. + end if + + end function PointNeedsCheckForIrrig + + + + !----------------------------------------------------------------------- + pure function IrrigationDeficit(relsat_so, h2osoi_liq, eff_porosity, dz, irrig_factor) & + result(deficit) + ! + ! !DESCRIPTION: + ! Compute irrigation deficit for a given soil layer at a given point. This is the + ! difference between the desired soil moisture level for this layer and the current + ! soil moisture level. [kg/m2] + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: deficit ! function result + real(r8), intent(in) :: relsat_so ! relative saturation at which smp = smpso + real(r8), intent(in) :: h2osoi_liq ! current liquid water in layer (kg/m2) + real(r8), intent(in) :: eff_porosity ! effective porosity (0 to 1) + real(r8), intent(in) :: dz ! level thickness (m) + real(r8), intent(in) :: irrig_factor ! factor determining the target soil moisture level for irrigation (0 to 1) + ! + ! !LOCAL VARIABLES: + + ! partial volume of liquid water in layer for which smp_node = smpso [0 to 1] + real(r8) :: vol_liq_so + + ! liquid water corresponding to vol_liq_so for this layer [kg/m2] + real(r8) :: h2osoi_liq_so + + ! liquid water corresponding to eff_porosity for this layer [kg/m2] + real(r8) :: h2osoi_liq_sat + + character(len=*), parameter :: subname = 'IrrigationDeficit' + !----------------------------------------------------------------------- + + vol_liq_so = eff_porosity * relsat_so + h2osoi_liq_so = vol_liq_so * denh2o * dz + h2osoi_liq_sat = eff_porosity * denh2o * dz + deficit = max((h2osoi_liq_so + irrig_factor*(h2osoi_liq_sat - h2osoi_liq_so)) - h2osoi_liq, 0._r8) + + end function IrrigationDeficit + +end module IrrigationMod diff --git a/components/clm/src/biogeophys/LakeCon.F90 b/components/clm/src/biogeophys/LakeCon.F90 new file mode 100644 index 0000000000..a42a3d0137 --- /dev/null +++ b/components/clm/src/biogeophys/LakeCon.F90 @@ -0,0 +1,178 @@ +module LakeCon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing constants and parameters for the Lake code + ! (CLM4-LISSS, documented in Subin et al. 2011, JAMES) + ! Also contains time constant variables for Lake code + ! Created by Zack Subin, 2011 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varctl , only : iulog + use spmdMod , only : masterproc + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: LakeConInit + !----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Lake Model non-tuneable constants + !------------------------------------------------------------------ + + ! temperature of maximum water density (K) + ! This is from Hostetler and Bartlein (1990); more updated sources suggest 277.13 K. + real(r8), parameter :: tdmax = 277._r8 + + !------------------------------------------------------------------ + ! Lake Model tuneable constants + !------------------------------------------------------------------ + + ! lake emissivity. This is used for both frozen and unfrozen lakes. + ! This is pulled in from CLM4 and the reference is unclear. + real(r8), parameter :: emg_lake = 0.97_r8 + + ! The fraction of the visible (e.g. vis not nir from atm) sunlight + ! absorbed in ~1 m of water (the surface layer za_lake). + ! This is roughly the fraction over 700 nm but may depend on the details + ! of atmospheric radiative transfer. As long as NIR = 700 nm and up, this can be zero. + real(r8) :: betavis = 0.0_r8 + + ! Momentum Roughness length over frozen lakes without snow (m) + ! Typical value found in the literature, and consistent with Mironov expressions. + ! See e.g. Morris EM 1989, Andreas EL 1987, Guest & Davidson 1991 (as cited in Vavrus 1996) + real(r8), parameter :: z0frzlake = 0.001_r8 + + ! Base of surface light absorption layer for lakes (m) + real(r8), parameter :: za_lake = 0.6_r8 + + ! For calculating prognostic roughness length + real(r8), parameter :: cur0 = 0.01_r8 ! min. Charnock parameter + real(r8), parameter :: cus = 0.1_r8 ! empirical constant for roughness under smooth flow + real(r8), parameter :: curm = 0.1_r8 ! maximum Charnock parameter + + ! The following will be set in initLake based on namelists. !TODO - fix this commend + real(r8) :: fcrit ! critical dimensionless fetch for Charnock parameter. + real(r8) :: minz0lake ! (m) Minimum allowed roughness length for unfrozen lakes. + + ! For calculating enhanced diffusivity + real(r8), parameter :: n2min = 7.5e-5_r8 ! (s^-2) (yields diffusivity about 6 times km) ! Fang & Stefan 1996 + + ! Note, this will be adjusted in initLake if the timestep is not 1800 s. + ! Lake top numerics can oscillate with 0.01m top layer and 1800 s timestep. + ! The problem is that the surface flux is fixed during the calculation of the top + ! layer temperature in the diffusion and not corrected for the tendency of the top layer. + ! This thickness will be added to all minimum and maximum snow layer thicknesses compared to that used over non-lakes. + ! Analysis of the CFL condition suggests that the minimum snow layer thickness for 1800 s needs + ! to be at least ~1.2 cm for the bulk snow values of conductivity and heat capacity + ! and as much as 2.3 cm for pure ice. + ! Alternatively, a check could be done in LakeTemperature in case + ! t_grnd(c) - t_soisno(c,snl(c)+1) changed sign after the Crank-Nicholson step. + ! Such an approach, while perhaps allowing additional snow layer resolution, has not been tested. + ! The approach used over non-lakes is to have a first-order surface flux correction. + ! We choose not to do that here because t_grnd can vary independently of the top model + ! layer temperature, while it is fixed to the top layer temperature if tbot > tfrz and + ! the lake is frozen, or if there is an unstable density gradient in the top unfrozen lake layer. + real(r8) :: lsadz = 0.03_r8 ! m + + !! The following will be set in initLake based on namelists. + real(r8) :: pudz ! (m) Optional minimum total ice thickness required to allow lake puddling. + ! Currently used for sensitivity tests only. + real(r8) :: depthcrit ! (m) Depth beneath which to increase mixing. See discussion in Subin et al. 2011 + real(r8) :: mixfact ! Mixing increase factor. + + !!!!!!!!!!! + ! Namelists (some of these have not been extensively tested and are hardwired to default values currently). + !!!!!!!!!!! + + ! used in LakeFluxes + ! true => use old fcrit & minz0 as per Subin et al 2011 form + ! See initLakeMod for details. Difference is very small for + ! small lakes and negligible for large lakes. Currently hardwired off. + logical, public :: lake_use_old_fcrit_minz0 = .false. + + ! used in LakeTemperature + ! Increase mixing by a large factor for deep lakes + ! Crude but enhanced performance at all 4 deep lakes tested. + ! See Subin et al 2011 (JAMES) for details + + ! (m) minimum lake depth to invoke deepmixing + real(r8), public :: deepmixing_depthcrit = 25._r8 + + ! factor to increase mixing by + real(r8), public :: deepmixing_mixfact = 10._r8 + + ! true => Suppress enhanced diffusion. Small differences. + ! Currently hardwired .false. + ! See Subin et al 2011 for details. + ! Enhanced diffusion is intended for under ice and at large depths. + ! It is a much smaller change on its own than the "deepmixing" + ! above, but it increases the effect of deepmixing under ice and for large depths. + logical, public :: lake_no_ed = .false. + + ! puddling (not extensively tested and currently hardwired off) + ! used in LakeTemperature and SurfaceAlbedo + + ! true => suppress convection when greater than minimum amount + ! of ice is present. This also effectively sets lake_no_melt_icealb. + logical, public :: lakepuddling = .false. + + ! (m) minimum amount of total ice nominal thickness before + ! convection is suppressed + real(r8), public :: lake_puddle_thick = 0.2_r8 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine LakeConInit() + ! + ! !DESCRIPTION: + ! Initialize time invariant variables for S Lake code + !------------------------------------------------------------------------ + + if (masterproc) write (iulog,*) 'Attempting to initialize time invariant variables for lakes' + + ! Set LakeCon constants according to namelist fields + if (lake_use_old_fcrit_minz0) then + ! critical dimensionless fetch for Charnock parameter. From Vickers & Mahrt 1997 + ! but converted to use u instead of u* (Form used in Subin et al. 2011) + fcrit = 22._r8 + + ! (m) Minimum allowed roughness length for unfrozen lakes. + ! (Used in Subin et al. 2011) + minz0lake = 1.e-5_r8 + else + ! Vickers & Mahrt 1997 + fcrit = 100._r8 + + ! (m) Minimum allowed roughness length for unfrozen lakes. + ! Now set low so it is only to avoid floating point exceptions. + minz0lake = 1.e-10_r8 + end if + + if (lakepuddling) then + ! (m) Minimum total ice thickness required to allow lake puddling. Default is 0.2m. + ! This option has not been extensively tested. + ! This option turns on lake_no_melt_icealb, as the decrease in albedo will be based + ! on whether there is water over nice, not purely a function of ice top temperature. + pudz = lake_puddle_thick + end if + + ! (m) Depth beneath which to increase mixing. See discussion in Subin et al. 2011 + depthcrit = deepmixing_depthcrit + + ! Mixing increase factor. ! Defaults are 25 m, increase by 10. + ! Note some other namelists will be used directly in lake physics during model integration. + mixfact = deepmixing_mixfact + + if (masterproc) write (iulog,*) 'Successfully initialized time invariant variables for lakes' + + end subroutine LakeConInit + +end module LakeCon diff --git a/components/clm/src/biogeophys/LakeFluxesMod.F90 b/components/clm/src/biogeophys/LakeFluxesMod.F90 new file mode 100644 index 0000000000..cd87559de1 --- /dev/null +++ b/components/clm/src/biogeophys/LakeFluxesMod.F90 @@ -0,0 +1,671 @@ +module LakeFluxesMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates surface fluxes and temperature for lakes. + ! Created by Zack Subin, 2009 + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use LakeStateType , only : lakestate_type + use SolarAbsorbedType , only : solarabs_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use HumanIndexMod , only : humanindex_type + use GridcellType , only : grc + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: LakeFluxes + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine LakeFluxes(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, & + atm2lnd_inst, solarabs_inst, frictionvel_inst, temperature_inst, & + energyflux_inst, waterstate_inst, waterflux_inst, lakestate_inst, & + humanindex_inst) + ! + ! !DESCRIPTION: + ! Calculates lake temperatures and surface fluxes. + ! Lakes have variable depth, possible snow layers above, freezing & thawing of lake water, + ! and soil layers with active temperature and gas diffusion below. + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! !USES: + use clm_varpar , only : nlevlak + use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, tkwat, tkice, tkair + use clm_varcon , only : sb, vkc, grav, denh2o, tfrz, spval, zsno + use clm_varctl , only : use_lch4 + use LakeCon , only : betavis, z0frzlake, tdmax, emg_lake + use LakeCon , only : lake_use_old_fcrit_minz0 + use LakeCon , only : minz0lake, cur0, cus, curm, fcrit + use QSatMod , only : QSat + use FrictionVelocityMod , only : FrictionVelocity, MoninObukIni + use HumanIndexMod , only : calc_human_stress_indices, Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & + swbgt, hmdex, dis_coi, dis_coiS, THIndex, & + SwampCoolEff, KtoC, VaporPres + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_lakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakep ! number of column non-lake points in pft filter + integer , intent(in) :: filter_lakep(:) ! patch filter for non-lake points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(lakestate_type) , intent(inout) :: lakestate_inst + type(humanindex_type) , intent(inout) :: humanindex_inst + ! + ! !LOCAL VARIABLES: + real(r8), pointer :: z0mg_col(:) ! roughness length over ground, momentum [m] + real(r8), pointer :: z0hg_col(:) ! roughness length over ground, sensible heat [m] + real(r8), pointer :: z0qg_col(:) ! roughness length over ground, latent heat [m] + integer , parameter :: niters = 4 ! maximum number of iterations for surface temperature + real(r8), parameter :: beta1 = 1._r8 ! coefficient of convective velocity (in computing W_*) [-] + real(r8), parameter :: zii = 1000._r8 ! convective boundary height [m] + integer :: i,fc,fp,g,c,p ! do loop or array index + integer :: fncopy ! number of values in pft filter copy + integer :: fnold ! previous number of pft filter values + integer :: fpcopy(num_lakep) ! patch filter copy for iteration loop + integer :: iter ! iteration index + integer :: nmozsgn(bounds%begp:bounds%endp) ! number of times moz changes sign + integer :: jtop(bounds%begc:bounds%endc) ! top level for each column (no longer all 1) + real(r8) :: ax ! used in iteration loop for calculating t_grnd (numerator of NR solution) + real(r8) :: bx ! used in iteration loop for calculating t_grnd (denomin. of NR solution) + real(r8) :: degdT ! d(eg)/dT + real(r8) :: dqh(bounds%begp:bounds%endp) ! diff of humidity between ref. height and surface + real(r8) :: dth(bounds%begp:bounds%endp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dzsur(bounds%begc:bounds%endc) ! 1/2 the top layer thickness (m) + real(r8) :: eg ! water vapor pressure at temperature T [pa] + real(r8) :: htvp(bounds%begc:bounds%endc) ! latent heat of vapor of water (or sublimation) [j/kg] + real(r8) :: obu(bounds%begp:bounds%endp) ! monin-obukhov length (m) + real(r8) :: obuold(bounds%begp:bounds%endp) ! monin-obukhov length of previous iteration + real(r8) :: qsatg(bounds%begc:bounds%endc) ! saturated humidity [kg/kg] + real(r8) :: qsatgdT(bounds%begc:bounds%endc) ! d(qsatg)/dT + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: ram(bounds%begp:bounds%endp) ! aerodynamical resistance [s/m] + real(r8) :: rah(bounds%begp:bounds%endp) ! thermal resistance [s/m] + real(r8) :: raw(bounds%begp:bounds%endp) ! moisture resistance [s/m] + real(r8) :: stftg3(bounds%begp:bounds%endp) ! derivative of fluxes w.r.t ground temperature + real(r8) :: temp1(bounds%begp:bounds%endp) ! relation for potential temperature profile + real(r8) :: temp12m(bounds%begp:bounds%endp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(bounds%begp:bounds%endp) ! relation for specific humidity profile + real(r8) :: temp22m(bounds%begp:bounds%endp) ! relation for specific humidity profile applied at 2-m + real(r8) :: tgbef(bounds%begc:bounds%endc) ! initial ground temperature + real(r8) :: thm(bounds%begp:bounds%endp) ! intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + real(r8) :: thv(bounds%begc:bounds%endc) ! virtual potential temperature (kelvin) + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: tksur(bounds%begc:bounds%endc) ! thermal conductivity of snow/soil (w/m/kelvin) + real(r8) :: tsur(bounds%begc:bounds%endc) ! top layer temperature + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: um(bounds%begp:bounds%endp) ! wind speed including the stablity effect [m/s] + real(r8) :: ur(bounds%begp:bounds%endp) ! wind speed at reference height [m/s] + real(r8) :: ustar(bounds%begp:bounds%endp) ! friction velocity [m/s] + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: zldis(bounds%begp:bounds%endp) ! reference height "minus" zero displacement height [m] + real(r8) :: displa(bounds%begp:bounds%endp) ! displacement (always zero) [m] + real(r8) :: z0mg(bounds%begp:bounds%endp) ! roughness length over ground, momentum [m] + real(r8) :: z0hg(bounds%begp:bounds%endp) ! roughness length over ground, sensible heat [m] + real(r8) :: z0qg(bounds%begp:bounds%endp) ! roughness length over ground, latent heat [m] + real(r8) :: u2m ! 2 m wind speed (m/s) + real(r8) :: fm(bounds%begp:bounds%endp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: bw ! partial density of water (ice + liquid) + real(r8) :: t_grnd_temp ! Used in surface flux correction over frozen ground + real(r8) :: betaprime(bounds%begc:bounds%endc) ! Effective beta: sabg_lyr(p,jtop) for snow layers, beta otherwise + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + real(r8) :: sabg_nir ! NIR that is absorbed (W/m^2) + + ! For calculating roughness lengths + real(r8) :: cur ! Charnock parameter (-) + real(r8) :: fetch(bounds%begc:bounds%endc) ! Fetch (m) + real(r8) :: sqre0 ! root of roughness Reynolds number + real(r8), parameter :: kva0 = 1.51e-5_r8 ! kinematic viscosity of air (m^2/s) at 20C and 1.013e5 Pa + real(r8) :: kva0temp ! (K) temperature for kva0; will be set below + real(r8), parameter :: kva0pres = 1.013e5_r8 ! (Pa) pressure for kva0 + real(r8) :: kva ! kinematic viscosity of air at ground temperature and forcing pressure + real(r8), parameter :: prn = 0.713 ! Prandtl # for air at neutral stability + real(r8), parameter :: sch = 0.66 ! Schmidt # for water in air at neutral stability + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness for soil or snow (m) + dz_lake => col%dz_lake , & ! Input: [real(r8) (:,:) ] layer thickness for lake (m) + lakedepth => col%lakedepth , & ! Input: [real(r8) (:) ] variable lake depth (m) + + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_th => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric potential temperature (Kelvin) + forc_q => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_rho => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] + forc_u => atm2lnd_inst%forc_u_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in east direction (m/s) + forc_v => atm2lnd_inst%forc_v_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in north direction (m/s) + + fsds_nir_d => solarabs_inst%fsds_nir_d_patch , & ! Input: [real(r8) (:) ] incident direct beam nir solar radiation (W/m**2) + fsds_nir_i => solarabs_inst%fsds_nir_i_patch , & ! Input: [real(r8) (:) ] incident diffuse nir solar radiation (W/m**2) + fsr_nir_d => solarabs_inst%fsr_nir_d_patch , & ! Input: [real(r8) (:) ] reflected direct beam nir solar radiation (W/m**2) + fsr_nir_i => solarabs_inst%fsr_nir_i_patch , & ! Input: [real(r8) (:) ] reflected diffuse nir solar radiation (W/m**2) + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Input: [real(r8) (:,:) ] absorbed solar radiation (pft,lyr) [W/m2] + sabg_chk => solarabs_inst%sabg_chk_patch , & ! Output: [real(r8) (:) ] sum of soil/snow using current fsno, for balance check + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + + savedtke1 => lakestate_inst%savedtke1_col , & ! Input: [real(r8) (:) ] top level eddy conductivity from previous timestep (W/mK) + lakefetch => lakestate_inst%lakefetch_col , & ! Input: [real(r8) (:) ] lake fetch from surface data (m) + + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + + t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil (or snow) temperature (Kelvin) + + u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:)] 10 m height winds (m/s) + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at pft level [m] + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at pft level [m] + forc_hgt_q_patch => frictionvel_inst%forc_hgt_q_patch , & ! Input: [real(r8) (:) ] observational height of specific humidity at pft level [m] + ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + + q_ref2m => waterstate_inst%q_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface specific humidity (kg/kg) + rh_ref2m => waterstate_inst%rh_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) + + tc_ref2m => humanindex_inst%tc_ref2m_patch , & ! Output: [real(r8) (:)] 2 m height surface air temperature (C) + vap_ref2m => humanindex_inst%vap_ref2m_patch , & ! Output: [real(r8) (:)] 2 m height vapor pressure (Pa) + appar_temp_ref2m => humanindex_inst%appar_temp_ref2m_patch , & ! Output: [real(r8) (:)] 2 m apparent temperature (C) + swbgt_ref2m => humanindex_inst%swbgt_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Simplified Wetbulb Globe temperature (C) + humidex_ref2m => humanindex_inst%humidex_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Humidex (C) + wbt_ref2m => humanindex_inst%wbt_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Stull Wet Bulb temperature (C) + wb_ref2m => humanindex_inst%wb_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Wet Bulb temperature (C) + teq_ref2m => humanindex_inst%teq_ref2m_patch , & ! Output: [real(r8) (:)] 2 m height Equivalent temperature (K) + ept_ref2m => humanindex_inst%ept_ref2m_patch , & ! Output: [real(r8) (:)] 2 m height Equivalent Potential temperature (K) + discomf_index_ref2m => humanindex_inst%discomf_index_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Discomfort Index temperature (C) + discomf_index_ref2mS => humanindex_inst%discomf_index_ref2mS_patch, & ! Output: [real(r8) (:)] 2 m height Discomfort Index Stull temperature (C) + nws_hi_ref2m => humanindex_inst%nws_hi_ref2m_patch , & ! Output: [real(r8) (:)] 2 m NWS Heat Index (C) + thip_ref2m => humanindex_inst%thip_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Temperature Humidity Index Physiology (C) + thic_ref2m => humanindex_inst%thic_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Temperature Humidity Index Comfort (C) + swmp65_ref2m => humanindex_inst%swmp65_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Swamp Cooler temperature 65% effi (C) + swmp80_ref2m => humanindex_inst%swmp80_ref2m_patch , & ! Output: [real(r8) (:)] 2 m Swamp Cooler temperature 80% effi (C) + + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_patch , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_patch , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) [+] + qflx_prec_grnd => waterflux_inst%qflx_prec_grnd_patch , & ! Output: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] + + t_veg => temperature_inst%t_veg_patch , & ! Output: [real(r8) (:) ] vegetation temperature (Kelvin) + t_ref2m => temperature_inst%t_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground temperature (Kelvin) + + eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Output: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Output: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_soil_grnd => energyflux_inst%eflx_soil_grnd_patch , & ! Output: [real(r8) (:) ] soil heat flux (W/m**2) [+ = into soil] + eflx_lh_tot => energyflux_inst%eflx_lh_tot_patch , & ! Output: [real(r8) (:) ] total latent heat flux (W/m8*2) [+ to atm] + eflx_lh_grnd => energyflux_inst%eflx_lh_grnd_patch , & ! Output: [real(r8) (:) ] ground evaporation heat flux (W/m**2) [+ to atm] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [real(r8) (:) ] net heat flux into ground (W/m**2) + taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) + tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) + + ks => lakestate_inst%ks_col , & ! Output: [real(r8) (:) ] coefficient passed to LakeTemperature + ws => lakestate_inst%ws_col , & ! Output: [real(r8) (:) ] surface friction velocity (m/s) + betaprime => lakestate_inst%betaprime_col , & ! Output: [real(r8) (:) ] fraction of solar rad absorbed at surface: equal to NIR fraction + ram1_lake => lakestate_inst%ram1_lake_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + ust_lake => lakestate_inst%ust_lake_col , & ! Output: [real(r8) (:) ] friction velocity (m/s) + lake_raw => lakestate_inst%lake_raw_col , & ! Output: [real(r8) (:) ] aerodynamic resistance for moisture (s/m) + + begp => bounds%begp , & + endp => bounds%endp & + ) + + ! the following cause a crash if they are set as associated + z0mg_col => frictionvel_inst%z0mg_col + z0hg_col => frictionvel_inst%z0hg_col + z0qg_col => frictionvel_inst%z0qg_col + + kva0temp = 20._r8 + tfrz + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + g = col%gridcell(c) + + ! Set fetch for prognostic roughness length-- if not found in surface data. + ! This is poorly constrained, and should eventually be based on global lake data + ! For now, base on lake depth, assuming that small lakes are likely to be shallower + ! The dependence will be weak, especially for large fetch + ! http://www.chebucto.ns.ca/ccn/info/Science/SWCS/DATA/morphology.html#zr, based on + ! Hutchinson, G.E. 1957 A treatise on limnology v.1. Geography, Physics and Chemistry, + ! and Wetzel, R.G., and Likens, G.E.. 1991. Limnological Analyses, suggests lakes usually have + ! depths less than 2% of their diameter. + + if (lakefetch(c) > 0._r8) then ! fetch available in surface data + fetch(c) = lakefetch(c) + else ! Estimate crudely based on lake depth + if (lakedepth(c) < 4._r8) then + fetch(c) = 100._r8 ! Roughly the smallest lakes resolveable in the GLWD + else + fetch(c) = 25._r8*lakedepth(c) + end if + end if + + ! Initialize roughness lengths + + if (t_grnd(c) > tfrz) then ! for unfrozen lake + z0mg(p) = z0mg_col(c) + kva = kva0 * (t_grnd(c)/kva0temp)**1.5_r8 * kva0pres/forc_pbot(c) ! kinematic viscosity of air + sqre0 = (max(z0mg(p)*ust_lake(c)/kva,0.1_r8))**0.5_r8 ! Square root of roughness Reynolds number + z0hg(p) = z0mg(p) * exp( -vkc/prn*( 4._r8*sqre0 - 3.2_r8) ) ! SH roughness length + z0qg(p) = z0mg(p) * exp( -vkc/sch*( 4._r8*sqre0 - 4.2_r8) ) ! LH roughness length + z0qg(p) = max(z0qg(p), minz0lake) + z0hg(p) = max(z0hg(p), minz0lake) + else if (snl(c) == 0) then ! frozen lake with ice + z0mg(p) = z0frzlake + z0hg(p) = z0mg(p)/exp(0.13_r8 * (ust_lake(c)*z0mg(p)/1.5e-5_r8)**0.45_r8) ! Consistent with BareGroundFluxes + z0qg(p) = z0hg(p) + else ! use roughness over snow as in Biogeophysics1 + z0mg(p) = zsno + z0hg(p) = z0mg(p)/exp(0.13_r8 * (ust_lake(c)*z0mg(p)/1.5e-5_r8)**0.45_r8) ! Consistent with BareGroundFluxes + z0qg(p) = z0hg(p) + end if + + ! Surface temperature and fluxes + + forc_hgt_u_patch(p) = forc_hgt_u_patch(p) + z0mg(p) + forc_hgt_t_patch(p) = forc_hgt_t_patch(p) + z0mg(p) + forc_hgt_q_patch(p) = forc_hgt_q_patch(p) + z0mg(p) + + ! Find top layer + jtop(c) = snl(c) + 1 + + if (snl(c) < 0) then + betaprime(c) = sabg_lyr(p,jtop(c))/max(1.e-5_r8,sabg(p)) ! Assuming one pft + dzsur(c) = dz(c,jtop(c))/2._r8 + else ! no snow layers + ! Calculate the NIR fraction of absorbed solar. + sabg_nir = fsds_nir_d(p) + fsds_nir_i(p) - fsr_nir_d(p) - fsr_nir_i(p) + sabg_nir = min(sabg_nir, sabg(p)) + betaprime(c) = sabg_nir/max(1.e-5_r8,sabg(p)) + ! Some fraction of the "visible" may be absorbed in the surface layer. + betaprime(c) = betaprime(c) + (1._r8-betaprime(c))*betavis + dzsur(c) = dz_lake(c,1)/2._r8 + end if + + sabg_chk(p) = sabg(p) + ! Originally dzsur was 1*dz, but it should it be 1/2 dz. + + ! Saturated vapor pressure, specific humidity and their derivatives + ! at lake surface + + call QSat(t_grnd(c), forc_pbot(c), eg, degdT, qsatg(c), qsatgdT(c)) + + ! Potential, virtual potential temperature, and wind speed at the + ! reference height + + thm(p) = forc_t(c) + 0.0098_r8*forc_hgt_t_patch(p) ! intermediate variable + thv(c) = forc_th(c)*(1._r8+0.61_r8*forc_q(c)) ! virtual potential T + end do + + + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + g = patch%gridcell(p) + + nmozsgn(p) = 0 + obuold(p) = 0._r8 + displa(p) = 0._r8 + + ! Latent heat + + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + ! Zack Subin, 3/26/09: Changed to ground temperature rather than the air temperature above. + + ! Initialize stability variables + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-t_grnd(c) + dqh(p) = forc_q(c)-qsatg(c) + dthv = dth(p)*(1._r8+0.61_r8*forc_q(c))+0.61_r8*forc_th(c)*dqh(p) + zldis(p) = forc_hgt_u_patch(p) - 0._r8 + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg(p), um(p), obu(p)) + + end do + + iter = 1 + fncopy = num_lakep + fpcopy(1:num_lakep) = filter_lakep(1:num_lakep) + + ! Begin stability iteration + + ITERATION : do while (iter <= niters .and. fncopy > 0) + + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + call FrictionVelocity(begp, endp, fncopy, fpcopy, & + displa(begp:endp), z0mg(begp:endp), z0hg(begp:endp), z0qg(begp:endp), & + obu(begp:endp), iter, ur(begp:endp), um(begp:endp), ustar(begp:endp), & + temp1(begp:endp), temp2(begp:endp), temp12m(begp:endp), temp22m(begp:endp), fm(begp:endp), & + frictionvel_inst) + + do fp = 1, fncopy + p = fpcopy(fp) + c = patch%column(p) + g = patch%gridcell(p) + + tgbef(c) = t_grnd(c) + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + tksur(c) = savedtke1(c) + ! Set this to the eddy conductivity from the last + ! timestep, as the molecular conductivity will be orders of magnitude too small. + ! It will be initialized in initLakeMod to the molecular conductivity for the first timestep if arbinit. + tsur(c) = t_lake(c,1) + else if (snl(c) == 0) then !frozen but no snow layers + tksur(c) = tkice ! This is an approximation because the whole layer may not be frozen, and it is not + ! accounting for the physical (but not nominal) expansion of the frozen layer. + tsur(c) = t_lake(c,1) + else + !Need to calculate thermal conductivity of the top snow layer + bw = (h2osoi_ice(c,jtop(c))+h2osoi_liq(c,jtop(c)))/dz(c,jtop(c)) + tksur(c) = tkair + (7.75e-5_r8 *bw + 1.105e-6_r8*bw*bw)*(tkice-tkair) + tsur(c) = t_soisno(c,jtop(c)) + end if + + ! Determine aerodynamic resistances + + ram(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah(p) = 1._r8/(temp1(p)*ustar(p)) + raw(p) = 1._r8/(temp2(p)*ustar(p)) + if (use_lch4) then + lake_raw(c) = raw(p) ! Pass out for calculating ground ch4 conductance + end if + ram1(p) = ram(p) ! pass value to global variable + ram1_lake(p) = ram1(p) ! for history + + ! Get derivative of fluxes with respect to ground temperature + + stftg3(p) = emg_lake*sb*tgbef(c)*tgbef(c)*tgbef(c) + + ! Changed surface temperature from t_lake(c,1) to tsur(c). + ! Also adjusted so that if there are snow layers present, the top layer absorption + ! from SNICAR is assigned to the surface skin. + ax = betaprime(c)*sabg(p) + emg_lake*forc_lwrad(c) + 3._r8*stftg3(p)*tgbef(c) & + + forc_rho(c)*cpair/rah(p)*thm(p) & + - htvp(c)*forc_rho(c)/raw(p)*(qsatg(c)-qsatgdT(c)*tgbef(c) - forc_q(c)) & + + tksur(c)*tsur(c)/dzsur(c) + !Changed sabg(p) to betaprime(c)*sabg(p). + bx = 4._r8*stftg3(p) + forc_rho(c)*cpair/rah(p) & + + htvp(c)*forc_rho(c)/raw(p)*qsatgdT(c) + tksur(c)/dzsur(c) + + t_grnd(c) = ax/bx + + ! Update htvp + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + + ! Surface fluxes of momentum, sensible and latent heat + ! using ground temperatures from previous time step + + eflx_sh_grnd(p) = forc_rho(c)*cpair*(t_grnd(c)-thm(p))/rah(p) + qflx_evap_soi(p) = forc_rho(c)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c))-forc_q(c))/raw(p) + + ! Re-calculate saturated vapor pressure, specific humidity and their + ! derivatives at lake surface + + call QSat(t_grnd(c), forc_pbot(c), eg, degdT, qsatg(c), qsatgdT(c)) + + dth(p)=thm(p)-t_grnd(c) + dqh(p)=forc_q(c)-qsatg(c) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + + thvstar=tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar + zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p)+wc*wc) + end if + obu(p) = zldis(p)/zeta + + if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 + + obuold(p) = obu(p) + + if (t_grnd(c) > tfrz .and. snl(c) == 0) then ! t_grnd hasn't been corrected yet if snow layers but above frz + ! Update roughness lengths using approach in Subin et al. 2011 + ! Also allow wave development (phase speed) to be depth-limited as well as fetch-limited + if (lake_use_old_fcrit_minz0) then + ! Original formulation in Subin et al. 2011; converted Vickers & Mahrt 1997 to use u instead of u* + ! assuming u = 0.1 u*. + ! That probably slightly overestimates the dimensionless fetch as u* is often smaller than 0.1 u + cur = cur0 + curm* exp( max( -(fetch(c)*grav/ur(p)/ur(p))**(1._r8/3._r8)/fcrit, & ! Fetch-limited + -(lakedepth(c)*grav/ur(p)/ur(p))**0.5_r8 ) ) ! depth-limited + ! In this case fcrit is 22, not 100 in clm_varcon + else + ! Fetch relationship from Vickers & Mahrt 1997 + cur = cur0 + curm* exp( max( -(fetch(c)*grav/ustar(p)/ustar(p))**(1._r8/3._r8)/fcrit, & ! Fetch-limited + -(lakedepth(c)*grav/ur(p)/ur(p))**0.5_r8 ) ) ! depth-limited + end if + + + kva = kva0 * (t_grnd(c)/kva0temp)**1.5_r8 * kva0pres/forc_pbot(c) ! kinematic viscosity of air + z0mg(p) = max(cus*kva/max(ustar(p),1.e-4_r8), cur*ustar(p)*ustar(p)/grav) ! momentum roughness length + ! This lower limit on ustar is just to prevent floating point exceptions and + ! should not be important + z0mg(p) = max(z0mg(p), minz0lake) ! This limit is redundant with current values. + sqre0 = (max(z0mg(p)*ustar(p)/kva,0.1_r8))**0.5_r8 ! Square root of roughness Reynolds number + z0hg(p) = z0mg(p) * exp( -vkc/prn*( 4._r8*sqre0 - 3.2_r8) ) ! SH roughness length + z0qg(p) = z0mg(p) * exp( -vkc/sch*( 4._r8*sqre0 - 4.2_r8) ) ! LH roughness length + z0qg(p) = max(z0qg(p), minz0lake) + z0hg(p) = max(z0hg(p), minz0lake) + else if (snl(c) == 0) then + ! in case it was above freezing and now below freezing + z0mg(p) = z0frzlake + z0hg(p) = z0mg(p)/exp(0.13_r8 * (ustar(p)*z0mg(p)/1.5e-5_r8)**0.45_r8) ! Consistent with BareGroundFluxes + z0qg(p) = z0hg(p) + else ! Snow layers + ! z0mg won't have changed + z0hg(p) = z0mg(p)/exp(0.13_r8 * (ustar(p)*z0mg(p)/1.5e-5_r8)**0.45_r8) ! Consistent with BareGroundFluxes + z0qg(p) = z0hg(p) + end if + + end do ! end of filtered pft loop + + iter = iter + 1 + if (iter <= niters ) then + ! Rebuild copy of pft filter for next pass through the ITERATION loop + + fnold = fncopy + fncopy = 0 + do fp = 1, fnold + p = fpcopy(fp) + if (nmozsgn(p) < 3) then + fncopy = fncopy + 1 + fpcopy(fncopy) = p + end if + end do ! end of filtered pft loop + end if + + end do ITERATION ! end of stability iteration + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + g = patch%gridcell(p) + + ! If there is snow on the ground or lake is frozen and t_grnd > tfrz: reset t_grnd = tfrz. + ! Re-evaluate ground fluxes. + ! [ZMS 1/7/11] Only for resolved snow layers, as unresolved snow does not have a temperature state and + ! can accumulate on unfrozen lakes in LakeHydrology; will be melted in LakeTemperature or bring lake top + ! to freezing. + ! note that qsatg and qsatgdT should be f(tgbef) (PET: not sure what this + ! comment means) + ! Zack Subin, 3/27/09: Since they are now a function of whatever t_grnd was before cooling + ! to freezing temperature, then this value should be used in the derivative correction term. + ! Allow convection if ground temp is colder than lake but warmer than 4C, or warmer than + ! lake which is warmer than freezing but less than 4C. + if ( (snl(c) < 0 .or. t_lake(c,1) <= tfrz) .and. t_grnd(c) > tfrz) then + t_grnd_temp = t_grnd(c) + t_grnd(c) = tfrz + eflx_sh_grnd(p) = forc_rho(c)*cpair*(t_grnd(c)-thm(p))/rah(p) + qflx_evap_soi(p) = forc_rho(c)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-t_grnd_temp) - forc_q(c))/raw(p) + else if ( (t_lake(c,1) > t_grnd(c) .and. t_grnd(c) > tdmax) .or. & + (t_lake(c,1) < t_grnd(c) .and. t_lake(c,1) > tfrz .and. t_grnd(c) < tdmax) ) then + ! Convective mixing will occur at surface + t_grnd_temp = t_grnd(c) + t_grnd(c) = t_lake(c,1) + eflx_sh_grnd(p) = forc_rho(c)*cpair*(t_grnd(c)-thm(p))/rah(p) + qflx_evap_soi(p) = forc_rho(c)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-t_grnd_temp) - forc_q(c))/raw(p) + end if + + ! Update htvp + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + + ! Net longwave from ground to atmosphere + ! eflx_lwrad_out(p) = (1._r8-emg_lake)*forc_lwrad(c) + stftg3(p)*(-3._r8*tgbef(c)+4._r8*t_grnd(c)) + ! What is tgbef doing in this equation? Can't it be exact now? --Zack Subin, 4/14/09 + + eflx_lwrad_out(p) = (1._r8-emg_lake)*forc_lwrad(c) + emg_lake*sb*t_grnd(c)**4._r8 + + ! Ground heat flux + + eflx_soil_grnd(p) = sabg(p) + forc_lwrad(c) - eflx_lwrad_out(p) - & + eflx_sh_grnd(p) - htvp(c)*qflx_evap_soi(p) + ! The original code in Biogeophysiclake had a bug that calculated incorrect fluxes but conserved energy. + ! This is kept as the full sabg (not just that absorbed at surface) so that the energy balance check will be correct. + !This is the effective energy flux into the ground including the lake [and now snow in CLM 4] solar absorption + !below the surface. This also keeps the output FGR similar to non-lakes by including the light & heat flux. + ! The variable eflx_gnet will be used to pass the actual heat flux + !from the ground interface into the lake. + + taux(p) = -forc_rho(c)*forc_u(g)/ram(p) + tauy(p) = -forc_rho(c)*forc_v(g)/ram(p) + + eflx_sh_tot(p) = eflx_sh_grnd(p) + qflx_evap_tot(p) = qflx_evap_soi(p) + eflx_lh_tot(p) = htvp(c)*qflx_evap_soi(p) + eflx_lh_grnd(p) = htvp(c)*qflx_evap_soi(p) + + ! 2 m height air temperature + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + + ! 2 m height specific humidity + q_ref2m(p) = forc_q(c) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(c), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + + ! Human Heat Stress + + if ( calc_human_stress_indices )then + call KtoC(t_ref2m(p), tc_ref2m(p)) + call VaporPres(rh_ref2m(p), e_ref2m, vap_ref2m(p)) + call Wet_Bulb(t_ref2m(p), vap_ref2m(p), forc_pbot(c), rh_ref2m(p), & + q_ref2m(p), teq_ref2m(p), ept_ref2m(p), wb_ref2m(p)) + call Wet_BulbS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p)) + call HeatIndex(tc_ref2m(p), rh_ref2m(p), nws_hi_ref2m(p)) + call AppTemp(tc_ref2m(p), vap_ref2m(p), u10_clm(p), appar_temp_ref2m(p)) + call swbgt(tc_ref2m(p), vap_ref2m(p), swbgt_ref2m(p)) + call hmdex(tc_ref2m(p), vap_ref2m(p), humidex_ref2m(p)) + call dis_coi(tc_ref2m(p), wb_ref2m(p), discomf_index_ref2m(p)) + call dis_coiS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p), discomf_index_ref2mS(p)) + call THIndex(tc_ref2m(p), wb_ref2m(p), thic_ref2m(p), thip_ref2m(p)) + call SwampCoolEff(tc_ref2m(p), wb_ref2m(p), swmp80_ref2m(p), swmp65_ref2m(p)) + end if + + + ! Energy residual used for melting snow + ! Effectively moved to LakeTemp + + eflx_gnet(p) = betaprime(c) * sabg(p) + forc_lwrad(c) - (eflx_lwrad_out(p) + & + eflx_sh_tot(p) + eflx_lh_tot(p)) + ! This is the actual heat flux from the ground interface into the lake, not including + ! the light that penetrates the surface. + + !u2m = max(1.0_r8,ustar(p)/vkc*log(2._r8/z0mg(p))) + ! u2 often goes below 1 m/s; it seems like the only reason for this minimum is to + ! keep it from being zero in the ks equation below; 0.1 m/s is a better limit for + ! stable conditions --ZS + u2m = max(0.1_r8,ustar(p)/vkc*log(2._r8/z0mg(p))) + + ws(c) = 1.2e-03_r8 * u2m + ks(c) = 6.6_r8*sqrt(abs(sin(grc%lat(g))))*(u2m**(-1.84_r8)) + + ! Update column roughness lengths and friction velocity + z0mg_col(c) = z0mg(p) + z0hg_col(c) = z0hg(p) + z0qg_col(c) = z0qg(p) + ust_lake(c) = ustar(p) + + end do + + ! The following are needed for global average on history tape. + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + t_veg(p) = forc_t(c) + eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(c) + qflx_prec_grnd(p) = forc_rain(c) + forc_snow(c) + + ! Because they will be used in pft2col initialize here. + ! This will be overwritten in LakeHydrology + qflx_snwcp_ice(p) = 0._r8 + qflx_snwcp_liq(p) = 0._r8 + + end do + + end associate + + end subroutine LakeFluxes + +end module LakeFluxesMod diff --git a/components/clm/src/biogeophys/LakeHydrologyMod.F90 b/components/clm/src/biogeophys/LakeHydrologyMod.F90 new file mode 100644 index 0000000000..2319c15f16 --- /dev/null +++ b/components/clm/src/biogeophys/LakeHydrologyMod.F90 @@ -0,0 +1,697 @@ +module LakeHydrologyMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculation of Lake Hydrology. Full hydrology, aerosol deposition, etc. of snow layers is + ! done. However, there is no infiltration, and the water budget is balanced with + ! qflx_qrgwl. Lake water mass is kept constant. The soil is simply maintained at + ! volumetric saturation if ice melting frees up pore space. Likewise, if the water + ! portion alone at some point exceeds pore capacity, it is reduced. This is consistent + ! with the possibility of initializing the soil layer with excess ice. + ! + ! If snow layers are present over an unfrozen lake, and the top layer of the lake + ! is capable of absorbing the latent heat without going below freezing, + ! the snow-water is runoff and the latent heat is subtracted from the lake. + ! + ! Minimum snow layer thickness for lakes has been increased to avoid instabilities with 30 min timestep. + ! Also frost / dew is prevented from being added to top snow layers that have already melted during the phase change step. + ! + ! ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use ColumnType , only : col + use PatchType , only : patch + use atm2lndType , only : atm2lnd_type + use AerosolMod , only : aerosol_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use LakeStateType , only : lakestate_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: LakeHydrology ! Calculates soil/snow hydrology + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine LakeHydrology(bounds, & + num_lakec, filter_lakec, num_lakep, filter_lakep, & + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, waterflux_inst, & + energyflux_inst, aerosol_inst, lakestate_inst) + ! + ! !DESCRIPTION: + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! Sequence is: + ! LakeHydrology: + ! Do needed tasks from CanopyHydrology, Biogeophysics2, & top of SoilHydrology. + ! -> SnowWater: change of snow mass and snow water onto soil + ! -> SnowCompaction: compaction of snow layers + ! -> CombineSnowLayers: combine snow layers that are thinner than minimum + ! -> DivideSnowLayers: subdivide snow layers that are thicker than maximum + ! + ! Add water to soil if melting has left it with open pore space. + ! If snow layers are found above a lake with unfrozen top layer, whose top + ! layer has enough heat to melt all the snow ice without freezing, do so + ! and eliminate the snow layers. + ! Cleanup and do water balance. + ! + ! !USES: + use clm_varcon , only : denh2o, denice, spval, hfus, tfrz, cpliq, cpice + use clm_varpar , only : nlevsno, nlevgrnd, nlevsoi + use clm_varctl , only : iulog + use clm_time_manager, only : get_step_size + use SnowHydrologyMod, only : SnowCompaction, CombineSnowLayers, SnowWater, BuildSnowFilter + use SnowHydrologyMod, only : DivideSnowLayers + use LakeCon , only : lsadz + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + integer , intent(in) :: num_lakep ! number of pft lake points in column filter + integer , intent(in) :: filter_lakep(:) ! patch filter for lake points + integer , intent(out) :: num_shlakesnowc ! number of column snow points + integer , intent(out) :: filter_shlakesnowc(:) ! column filter for snow points + integer , intent(out) :: num_shlakenosnowc ! number of column non-snow points + integer , intent(out) :: filter_shlakenosnowc(:) ! column filter for non-snow points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + type(lakestate_type) , intent(inout) :: lakestate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,fp,g,l,c,j,fc,jtop ! indices + real(r8) :: dtime ! land model time step (sec) + integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) + real(r8) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] + real(r8) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + real(r8) :: fracsnow(bounds%begp:bounds%endp) ! frac of precipitation that is snow + real(r8) :: fracrain(bounds%begp:bounds%endp) ! frac of precipitation that is rain + real(r8) :: qflx_prec_grnd_snow(bounds%begp:bounds%endp) ! snow precipitation incident on ground [mm/s] + real(r8) :: qflx_prec_grnd_rain(bounds%begp:bounds%endp) ! rain precipitation incident on ground [mm/s] + real(r8) :: qflx_evap_soi_lim ! temporary evap_soi limited by top snow layer content [mm/s] + real(r8) :: h2osno_temp ! temporary h2osno [kg/m^2] + real(r8) :: sumsnowice(bounds%begc:bounds%endc) ! sum of snow ice if snow layers found above unfrozen lake [kg/m&2] + logical :: unfrozen(bounds%begc:bounds%endc) ! true if top lake layer is unfrozen with snow layers above + real(r8) :: heatrem ! used in case above [J/m^2] + real(r8) :: heatsum(bounds%begc:bounds%endc) ! used in case above [J/m^2] + real(r8) :: snowmass ! liquid+ice snow mass in a layer [kg/m2] + real(r8) :: snowcap_scl_fct ! temporary factor used to correct for snow capping + real(r8), parameter :: snow_bd = 250._r8 ! assumed snow bulk density (for lakes w/out resolved snow layers) [kg/m^3] + ! Should only be used for frost below. + !----------------------------------------------------------------------- + + associate( & + pcolumn => patch%column , & ! Input: [integer (:) ] pft's column index + pgridcell => patch%gridcell , & ! Input: [integer (:) ] pft's gridcell index + cgridcell => col%gridcell , & ! Input: [integer (:) ] column's gridcell + clandunit => col%landunit , & ! Input: [integer (:) ] column's landunit + dz_lake => col%dz_lake , & ! Input: [real(r8) (:,:) ] layer thickness for lake (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + forc_rain => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] + forc_snow => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric temperature (Kelvin) + qflx_floodg => atm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] gridcell flux of flood water from RTM + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + + t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] snow temperature (Kelvin) + dTdz_top => temperature_inst%dTdz_top_col , & ! Output: [real(r8) (:) ] temperature gradient in top layer K m-1] !TOD + snot_top => temperature_inst%snot_top_col , & ! Output: [real(r8) (:) ] snow temperature in top layer [K] !TODO + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + begwb => waterstate_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step + endwb => waterstate_inst%endwb_col , & ! Output: [real(r8) (:) ] water mass end of the time step + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] + snw_rds_top => waterstate_inst%snw_rds_top_col , & ! Output: [real(r8) (:) ] effective snow grain size, top layer [microns] + h2osno_top => waterstate_inst%h2osno_top_col , & ! Output: [real(r8) (:) ] mass of snow in top layer [kg] + sno_liq_top => waterstate_inst%sno_liq_top_col , & ! Output: [real(r8) (:) ] liquid water fraction in top snow layer [frc] + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Output: [real(r8) (:) ] needed for snicar code + frac_iceold => waterstate_inst%frac_iceold_col , & ! Output: [real(r8) (:,:) ] fraction of ice relative to the tot water + snow_depth => waterstate_inst%snow_depth_col , & ! Output: [real(r8) (:) ] snow height (m) + h2osno => waterstate_inst%h2osno_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) + snowice => waterstate_inst%snowice_col , & ! Output: [real(r8) (:) ] average snow ice lens + snowliq => waterstate_inst%snowliq_col , & ! Output: [real(r8) (:) ] average snow liquid water + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] volumetric soil water [m3/m3] + + qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Output: [real(r8) (:) ] column flux of flood water from RTM + qflx_prec_grnd => waterflux_inst%qflx_prec_grnd_patch , & ! Output: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] + qflx_snow_grnd_patch => waterflux_inst%qflx_snow_grnd_patch , & ! Output: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] + qflx_rain_grnd => waterflux_inst%qflx_rain_grnd_patch , & ! Output: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] + qflx_rain_grnd_col => waterflux_inst%qflx_rain_grnd_col , & ! Output: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_sub_snow => waterflux_inst%qflx_sub_snow_patch , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_patch , & ! Output: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_dew_snow => waterflux_inst%qflx_dew_snow_patch , & ! Output: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_patch , & ! Output: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_patch , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_patch , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) [+] + qflx_snomelt => waterflux_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) + qflx_prec_grnd_col => waterflux_inst%qflx_prec_grnd_col , & ! Output: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] + qflx_evap_grnd_col => waterflux_inst%qflx_evap_grnd_col , & ! Output: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_dew_grnd_col => waterflux_inst%qflx_dew_grnd_col , & ! Output: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_dew_snow_col => waterflux_inst%qflx_dew_snow_col , & ! Output: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_sub_snow_col => waterflux_inst%qflx_sub_snow_col , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Output: [real(r8) (:) ] snow on ground after interception (mm H2O/s) [+] + qflx_evap_tot_col => waterflux_inst%qflx_evap_tot_col , & ! Output: [real(r8) (:) ] pft quantity averaged to the column (assuming one pft) + qflx_snwcp_ice_col => waterflux_inst%qflx_snwcp_ice_col , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + qflx_snwcp_liq_col => waterflux_inst%qflx_snwcp_liq_col , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) [+] + qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] perched wt sub-surface runoff (mm H2O /s) !TODO - move this to somewhere else + qflx_h2osfc_surf => waterflux_inst%qflx_h2osfc_surf_col , & ! Output: [real(r8) (:) ] surface water runoff (mm H2O /s) + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Output: [real(r8) (:) ] drainage from snow pack + qflx_rsub_sat => waterflux_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] + qflx_surf => waterflux_inst%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_drain => waterflux_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_infl => waterflux_inst%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) + qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes + qflx_runoff => waterflux_inst%qflx_runoff_col , & ! Output: [real(r8) (:) ] total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + qflx_top_soil => waterflux_inst%qflx_top_soil_col , & ! Output: [real(r8) (:) ] net water input into soil from top (mm/s) + qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Output: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + + eflx_snomelt => energyflux_inst%eflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_soil_grnd => energyflux_inst%eflx_soil_grnd_patch , & ! Output: [real(r8) (:) ] heat flux into snow / lake (W/m**2) [+ = into soil] + eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [reay(r8) (:) ] net heat flux into ground (W/m**2) + eflx_grnd_lake => energyflux_inst%eflx_grnd_lake_patch , & ! Output: [real(r8) (:) ] net heat flux into lake / snow surface, excluding light transmission (W/m**2) + + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Output: [real(r8) (:,:) ] mass fraction of lake layer that is frozen + + begc => bounds%begc, & + endc => bounds%endc & + ) + + ! Determine step size + + dtime = get_step_size() + + ! Add soil water to water balance. + do j = 1, nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + begwb(c) = begwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end do + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Do precipitation onto ground, etc., from CanopyHydrology + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + + qflx_prec_grnd_snow(p) = forc_snow(c) + qflx_prec_grnd_rain(p) = forc_rain(c) + qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) + + if (do_capsnow(c)) then + qflx_snwcp_ice(p) = qflx_prec_grnd_snow(p) + qflx_snwcp_liq(p) = qflx_prec_grnd_rain(p) + qflx_snow_grnd_patch(p) = 0._r8 + qflx_rain_grnd(p) = 0._r8 + else + qflx_snwcp_ice(p) = 0._r8 + qflx_snwcp_liq(p) = 0._r8 + qflx_snow_grnd_patch(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) + qflx_rain_grnd(p) = qflx_prec_grnd_rain(p) ! liquid water onto ground (mm/s) + end if + ! Assuming one PFT; needed for below + qflx_snow_grnd_col(c) = qflx_snow_grnd_patch(p) + qflx_rain_grnd_col(c) = qflx_rain_grnd(p) + + end do ! (end pft loop) + + ! Determine snow height and snow water + + do fc = 1, num_lakec + c = filter_lakec(fc) + + ! Use Alta relationship, Anderson(1976); LaChapelle(1961), + ! U.S.Department of Agriculture Forest Service, Project F, + ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification. + + if (do_capsnow(c)) then + dz_snowf = 0._r8 + else + if (forc_t(c) > tfrz + 2._r8) then + bifall=50._r8 + 1.7_r8*(17.0_r8)**1.5_r8 + else if (forc_t(c) > tfrz - 15._r8) then + bifall=50._r8 + 1.7_r8*(forc_t(c) - tfrz + 15._r8)**1.5_r8 + else + bifall=50._r8 + end if + dz_snowf = qflx_snow_grnd_col(c)/bifall + snow_depth(c) = snow_depth(c) + dz_snowf*dtime + h2osno(c) = h2osno(c) + qflx_snow_grnd_col(c)*dtime ! snow water equivalent (mm) + end if + + ! When the snow accumulation exceeds 40 mm, initialize snow layer + ! Currently, the water temperature for the precipitation is simply set + ! as the surface air temperature + + newnode = 0 ! flag for when snow node will be initialized + if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_r8 .and. snow_depth(c) >= 0.01_r8 + lsadz) then + newnode = 1 + snl(c) = -1 + dz(c,0) = snow_depth(c) ! meter + z(c,0) = -0.5_r8*dz(c,0) + zi(c,-1) = -dz(c,0) + t_soisno(c,0) = min(tfrz, forc_t(c)) ! K + h2osoi_ice(c,0) = h2osno(c) ! kg/m2 + h2osoi_liq(c,0) = 0._r8 ! kg/m2 + frac_iceold(c,0) = 1._r8 + + ! intitialize SNICAR variables for fresh snow: + call aerosol_inst%Reset(column=c) + call waterstate_inst%Reset(column=c) + + end if + + ! The change of ice partial density of surface node due to precipitation. + ! Only ice part of snowfall is added here, the liquid part will be added + ! later. + + if (snl(c) < 0 .and. newnode == 0) then + h2osoi_ice(c,snl(c)+1) = h2osoi_ice(c,snl(c)+1)+dtime*qflx_snow_grnd_col(c) + dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime + end if + + end do + + ! Calculate sublimation and dew, adapted from HydrologyLake and Biogeophysics2. + + do fp = 1,num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + jtop = snl(c)+1 + + qflx_evap_grnd(p) = 0._r8 + qflx_sub_snow(p) = 0._r8 + qflx_dew_snow(p) = 0._r8 + qflx_dew_grnd(p) = 0._r8 + + if (jtop <= 0) then ! snow layers + j = jtop + ! Assign ground evaporation to sublimation from soil ice or to dew + ! on snow or ground + + if (qflx_evap_soi(p) >= 0._r8) then + ! for evaporation partitioning between liquid evap and ice sublimation, + ! use the ratio of liquid to (liquid+ice) in the top layer to determine split + ! Since we're not limiting evap over lakes, but still can't remove more from top + ! snow layer than there is there, create temp. limited evap_soi. + qflx_evap_soi_lim = min(qflx_evap_soi(p), (h2osoi_liq(c,j)+h2osoi_ice(c,j))/dtime) + if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._r8) then + qflx_evap_grnd(p) = max(qflx_evap_soi_lim*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8) + else + qflx_evap_grnd(p) = 0._r8 + end if + qflx_sub_snow(p) = qflx_evap_soi_lim - qflx_evap_grnd(p) + else + ! if (t_grnd(c) < tfrz) then + ! Causes rare blowup when thin snow layer should completely melt and has a high temp after thermal physics, + ! but then is not eliminated in SnowHydrology because of this added frost. Also see below removal of + ! completely melted single snow layer. + if (t_grnd(c) < tfrz .and. t_soisno(c,j) < tfrz) then + qflx_dew_snow(p) = abs(qflx_evap_soi(p)) + ! If top layer is only snow layer, SnowHydrology won't eliminate it if dew is added. + else if (j < 0 .or. (t_grnd(c) == tfrz .and. t_soisno(c,j) == tfrz)) then + qflx_dew_grnd(p) = abs(qflx_evap_soi(p)) + end if + end if + ! Update the patch-level qflx_snowcap + ! This was moved in from Hydrology2 to keep all patch-level + ! calculations out of Hydrology2 + if (do_capsnow(c)) then + qflx_snwcp_ice(p) = qflx_snwcp_ice(p) + qflx_dew_snow(p) + qflx_snwcp_liq(p) = qflx_snwcp_liq(p) + qflx_dew_grnd(p) + end if + + else ! No snow layers + if (qflx_evap_soi(p) >= 0._r8) then + ! Sublimation: do not allow for more sublimation than there is snow + ! after melt. Remaining surface evaporation used for infiltration. + qflx_sub_snow(p) = min(qflx_evap_soi(p), h2osno(c)/dtime) + qflx_evap_grnd(p) = qflx_evap_soi(p) - qflx_sub_snow(p) + else + if (t_grnd(c) < tfrz-0.1_r8) then + qflx_dew_snow(p) = abs(qflx_evap_soi(p)) + else + qflx_dew_grnd(p) = abs(qflx_evap_soi(p)) + end if + end if + + ! Update snow pack for dew & sub. + + h2osno_temp = h2osno(c) + if (do_capsnow(c)) then + h2osno(c) = h2osno(c) - qflx_sub_snow(p)*dtime + qflx_snwcp_ice(p) = qflx_snwcp_ice(p) + qflx_dew_snow(p) + qflx_snwcp_liq(p) = qflx_snwcp_liq(p) + qflx_dew_grnd(p) + else + h2osno(c) = h2osno(c) + (-qflx_sub_snow(p)+qflx_dew_snow(p))*dtime + end if + if (h2osno_temp > 0._r8) then + snow_depth(c) = snow_depth(c) * h2osno(c) / h2osno_temp + else + snow_depth(c) = h2osno(c)/snow_bd !Assume a constant snow bulk density = 250. + end if + + h2osno(c) = max(h2osno(c), 0._r8) + end if + + qflx_snwcp_ice_col(c) = qflx_snwcp_ice(p) + qflx_snwcp_liq_col(c) = qflx_snwcp_liq(p) + + + end do + + ! patch averages must be done here -- BEFORE SNOW CALCULATIONS AS THEY USE IT. + ! for output to history tape and other uses + ! (note that pft2col is called before LakeHydrology, so we can't use that routine + ! to do these column -> pft averages) + do fp = 1,num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + + qflx_evap_tot_col(c) = qflx_evap_tot(p) + qflx_prec_grnd_col(c) = qflx_prec_grnd(p) + qflx_evap_grnd_col(c) = qflx_evap_grnd(p) + qflx_dew_grnd_col(c) = qflx_dew_grnd(p) + qflx_dew_snow_col(c) = qflx_dew_snow(p) + qflx_sub_snow_col(c) = qflx_sub_snow(p) + enddo + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Determine initial snow/no-snow filters (will be modified possibly by + ! routines CombineSnowLayers and DivideSnowLayers below) + + call BuildSnowFilter(bounds, num_lakec, filter_lakec, & + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc) + + ! specify snow fraction + do fc = 1, num_lakec + c = filter_lakec(fc) + if (h2osno(c) > 0.0_r8) then + frac_sno_eff(c) = 1._r8 + else + frac_sno_eff(c) = 0._r8 + endif + enddo + + ! Determine the change of snow mass and the snow water onto soil + + call SnowWater(bounds, & + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc, & + atm2lnd_inst, waterflux_inst, waterstate_inst, aerosol_inst) + + ! Determine soil hydrology + ! Here this consists only of making sure that soil is saturated even as it melts and + ! pore space opens up. Conversely, if excess ice is melting and the liquid water exceeds the + ! saturation value, then remove water. + + do j = 1,nlevsoi !nlevgrnd + ! changed to nlevsoi on 8/11/10 to make consistent with non-lake bedrock + do fc = 1, num_lakec + c = filter_lakec(fc) + + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + ! Could have changed during phase change! (Added 8/11/10) + + if (h2osoi_vol(c,j) < watsat(c,j)) then + h2osoi_liq(c,j) = (watsat(c,j)*dz(c,j) - h2osoi_ice(c,j)/denice)*denh2o + ! h2osoi_vol will be updated below, and this water addition will come from qflx_qrgwl + else if (h2osoi_liq(c,j) > watsat(c,j)*denh2o*dz(c,j)) then + h2osoi_liq(c,j) = watsat(c,j)*denh2o*dz(c,j) + ! Another way to do this would be: if h2osoi_vol > watsat then remove min(h2osoi_liq, + !(h2osoi_vol-watsat)*dz*denh2o) from h2osoi_liq. The question is whether the excess ice + ! melts first or last (or simultaneously) to the pore ice. Because excess ice is often in chunks, + ! requiring greater convergence of heat to melt, assume it melts last. + ! This will also improve the initialization behavior or in an occasionally warm year, the excess ice + ! won't start going away if a layer is briefly at freezing. + + ! Allow up to 10% excess ice over watsat in refreezing soil, + ! e.g. heaving soil. (As with > 10% excess ice modeling, and for the lake water, + ! the thermal conductivity will be adjusted down to compensate for the fact that the nominal dz is smaller + ! than the real soil volume.) The current solution is consistent but perhaps unrealistic in real soils, + ! where slow drainage may occur during freezing; drainage is only assumed to occur here when >10% excess + ! ice melts. The latter is more likely to be permanent rather than seasonal anyway. Attempting to remove the + ! ice volume after some has already frozen during the timestep would not conserve energy unless this were + ! incorporated into the ice stream. + + end if + + end do + end do + !!!!!!!!!! + + ! Natural compaction and metamorphosis. + + call SnowCompaction(bounds, num_shlakesnowc, filter_shlakesnowc, & + temperature_inst, waterstate_inst) + + ! Combine thin snow elements + + call CombineSnowLayers(bounds, num_shlakesnowc, filter_shlakesnowc, & + aerosol_inst, temperature_inst, waterflux_inst, waterstate_inst) + + ! Divide thick snow elements + + call DivideSnowLayers(bounds, num_shlakesnowc, filter_shlakesnowc, & + aerosol_inst, temperature_inst, waterstate_inst, is_lake=.true.) + + ! Check for single completely unfrozen snow layer over lake. Modeling this ponding is unnecessary and + ! can cause instability after the timestep when melt is completed, as the temperature after melt can be + ! excessive because the fluxes were calculated with a fixed ground temperature of freezing, but the + ! phase change was unable to restore the temperature to freezing. + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + + j = 0 + + if (snl(c) == -1) then + if (h2osoi_ice(c,j) > 0._r8 .and. t_soisno(c,j) > tfrz) then + + ! Take extra heat of layer and release to sensible heat in order + ! to maintain energy conservation. + heatrem = (cpliq*h2osoi_liq(c,j))*(t_soisno(c,j) - tfrz) + t_soisno(c,j) = tfrz + eflx_sh_tot(p) = eflx_sh_tot(p) + heatrem/dtime + eflx_sh_grnd(p) = eflx_sh_grnd(p) + heatrem/dtime + eflx_soil_grnd(p) = eflx_soil_grnd(p) - heatrem/dtime + eflx_gnet(p) = eflx_gnet(p) - heatrem/dtime + eflx_grnd_lake(p) = eflx_grnd_lake(p) - heatrem/dtime + else if (h2osoi_ice(c,j) == 0._r8) then + ! Remove layer + ! Take extra heat of layer and release to sensible heat in order + ! to maintain energy conservation. + heatrem = cpliq*h2osoi_liq(c,j)*(t_soisno(c,j) - tfrz) + eflx_sh_tot(p) = eflx_sh_tot(p) + heatrem/dtime + eflx_sh_grnd(p) = eflx_sh_grnd(p) + heatrem/dtime + eflx_soil_grnd(p) = eflx_soil_grnd(p) - heatrem/dtime + eflx_gnet(p) = eflx_gnet(p) - heatrem/dtime + eflx_grnd_lake(p) = eflx_grnd_lake(p) - heatrem/dtime + qflx_sl_top_soil(c) = qflx_sl_top_soil(c) + h2osno(c)/dtime + snl(c) = 0 + h2osno(c) = 0._r8 + snow_depth(c) = 0._r8 + ! Rest of snow layer book-keeping will be done below. + else + eflx_grnd_lake(p) = eflx_gnet(p) + end if + end if + end do + + ! Check for snow layers above lake with unfrozen top layer. Mechanically, + ! the snow will fall into the lake and melt or turn to ice. If the top layer has + ! sufficient heat to melt the snow without freezing, then that will be done. + ! Otherwise, the top layer will undergo freezing, but only if the top layer will + ! not freeze completely. Otherwise, let the snow layers persist and melt by diffusion. + + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (t_lake(c,1) > tfrz .and. lake_icefrac(c,1) == 0._r8 .and. snl(c) < 0) then + unfrozen(c) = .true. + else + unfrozen(c) = .false. + end if + end do + + do j = -nlevsno+1,0 + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (unfrozen(c)) then + if (j == -nlevsno+1) then + sumsnowice(c) = 0._r8 + heatsum(c) = 0._r8 + end if + if (j >= snl(c)+1) then + sumsnowice(c) = sumsnowice(c) + h2osoi_ice(c,j) + heatsum(c) = heatsum(c) + h2osoi_ice(c,j)*cpice*(tfrz - t_soisno(c,j)) & + + h2osoi_liq(c,j)*cpliq*(tfrz - t_soisno(c,j)) + end if + end if + end do + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (unfrozen(c)) then + heatsum(c) = heatsum(c) + sumsnowice(c)*hfus + heatrem = (t_lake(c,1) - tfrz)*cpliq*denh2o*dz_lake(c,1) - heatsum(c) + + if (heatrem + denh2o*dz_lake(c,1)*hfus > 0._r8) then + ! Remove snow and subtract the latent heat from the top layer. + qflx_snomelt(c) = qflx_snomelt(c) + h2osno(c)/dtime + + eflx_snomelt(c) = eflx_snomelt(c) + h2osno(c)*hfus/dtime + + ! update drainage from snow pack for this case + qflx_snow_drain(c) = qflx_snow_drain(c) + qflx_snomelt(c) + + qflx_sl_top_soil(c) = qflx_sl_top_soil(c) + h2osno(c) + + h2osno(c) = 0._r8 + snow_depth(c) = 0._r8 + snl(c) = 0 + ! The rest of the bookkeeping for the removed snow will be done below. + if (heatrem > 0._r8) then ! simply subtract the heat from the layer + t_lake(c,1) = t_lake(c,1) - heatrem/(cpliq*denh2o*dz_lake(c,1)) + else !freeze part of the layer + t_lake(c,1) = tfrz + lake_icefrac(c,1) = -heatrem/(denh2o*dz_lake(c,1)*hfus) + end if + end if + end if + end do + + ! Set empty snow layers to zero + + do j = -nlevsno+1,0 + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (j <= snl(c) .and. snl(c) > -nlevsno) then + h2osoi_ice(c,j) = 0._r8 + h2osoi_liq(c,j) = 0._r8 + t_soisno(c,j) = 0._r8 + dz(c,j) = 0._r8 + z(c,j) = 0._r8 + zi(c,j-1) = 0._r8 + end if + end do + end do + + ! Build new snow filter + + call BuildSnowFilter(bounds, num_lakec, filter_lakec, & + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc) + + ! Vertically average t_soisno and sum of h2osoi_liq and h2osoi_ice + ! over all snow layers for history output + + do fc = 1, num_lakec + c = filter_lakec(fc) + snowice(c) = 0._r8 + snowliq(c) = 0._r8 + end do + + do j = -nlevsno+1, 0 + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (j >= snl(c)+1) then + snowice(c) = snowice(c) + h2osoi_ice(c,j) + snowliq(c) = snowliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Determine ending water balance and volumetric soil water + + do fc = 1, num_lakec + c = filter_lakec(fc) + endwb(c) = h2osno(c) + end do + + do j = 1, nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + endwb(c) = endwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + end do + end do + + do fp = 1,num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + qflx_drain_perched(c) = 0._r8 + qflx_h2osfc_surf(c) = 0._r8 + qflx_rsub_sat(c) = 0._r8 + qflx_infl(c) = 0._r8 + qflx_surf(c) = 0._r8 + qflx_drain(c) = 0._r8 + + ! Insure water balance using qflx_qrgwl + qflx_qrgwl(c) = forc_rain(c) + forc_snow(c) - qflx_evap_tot(p) - qflx_snwcp_ice(p) - & + (endwb(c)-begwb(c))/dtime + qflx_floodg(g) + qflx_floodc(c) = qflx_floodg(g) + qflx_runoff(c) = qflx_drain(c) + qflx_qrgwl(c) + qflx_top_soil(c) = qflx_prec_grnd_rain(p) + qflx_snomelt(c) + + enddo + + ! top-layer diagnostics + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + h2osno_top(c) = h2osoi_ice(c,snl(c)+1) + h2osoi_liq(c,snl(c)+1) + end do + + ! Zero variables in columns without snow + do fc = 1, num_shlakenosnowc + c = filter_shlakenosnowc(fc) + + h2osno_top(c) = 0._r8 + snw_rds(c,:) = 0._r8 + + ! top-layer diagnostics (spval is not averaged when computing history fields) + snot_top(c) = spval + dTdz_top(c) = spval + snw_rds_top(c) = spval + sno_liq_top(c) = spval + end do + + end associate + + end subroutine LakeHydrology + +end module LakeHydrologyMod diff --git a/components/clm/src/biogeophys/LakeStateType.F90 b/components/clm/src/biogeophys/LakeStateType.F90 new file mode 100644 index 0000000000..b4397c7fba --- /dev/null +++ b/components/clm/src/biogeophys/LakeStateType.F90 @@ -0,0 +1,289 @@ +module LakeStateType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Lake data types and associated procesures + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : spval, grlnd + use decompMod , only : bounds_type + use spmdMod , only : masterproc + use abortUtils , only : endrun + use LandunitType , only : lun + use ColumnType , only : col + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + type, public :: lakestate_type + ! Time constant variables + real(r8), pointer :: lakefetch_col (:) ! col lake fetch from surface data (m) + real(r8), pointer :: etal_col (:) ! col lake extinction coefficient from surface data (1/m) + + ! Time varying variables + real(r8), pointer :: lake_raw_col (:) ! col aerodynamic resistance for moisture (s/m) + real(r8), pointer :: ks_col (:) ! col coefficient for calculation of decay of eddy diffusivity with depth + real(r8), pointer :: ws_col (:) ! col surface friction velocity (m/s) + real(r8), pointer :: ust_lake_col (:) ! col friction velocity (m/s) + real(r8), pointer :: betaprime_col (:) ! col effective beta: sabg_lyr(p,jtop) for snow layers, beta otherwise + real(r8), pointer :: savedtke1_col (:) ! col top level eddy conductivity from previous timestep (W/mK) + real(r8), pointer :: lake_icefrac_col (:,:) ! col mass fraction of lake layer that is frozen + real(r8), pointer :: lake_icethick_col (:) ! col ice thickness (m) (integrated if lakepuddling) + real(r8), pointer :: lakeresist_col (:) ! col [s/m] (Needed for calc. of grnd_ch4_cond) + real(r8), pointer :: ram1_lake_patch (:) ! patch aerodynamical resistance (s/m) + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type lakestate_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(lakestate_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate ( bounds ) + call this%InitHistory ( bounds ) + call this%InitCold ( bounds ) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate module variables and data structures + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varpar , only: nlevlak, nlevsno + ! + ! !ARGUMENTS: + class(lakestate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !--------------------------------------------------------------------- + + ! Initialize savedtke1 to spval so that c->g averaging will be done correctly + ! TODO: can this be now be set to nan??? + ! Initialize ust_lake to spval to detect input from restart file if not arbinit + ! TODO: can this be removed now??? + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%etal_col (begc:endc)) ; this%etal_col (:) = nan + allocate(this%lakefetch_col (begc:endc)) ; this%lakefetch_col (:) = nan + allocate(this%lakeresist_col (begc:endc)) ; this%lakeresist_col (:) = nan + allocate(this%savedtke1_col (begc:endc)) ; this%savedtke1_col (:) = spval + allocate(this%lake_icefrac_col (begc:endc,1:nlevlak)) ; this%lake_icefrac_col (:,:) = nan + allocate(this%lake_icethick_col (begc:endc)) ; this%lake_icethick_col (:) = nan + allocate(this%ust_lake_col (begc:endc)) ; this%ust_lake_col (:) = spval + allocate(this%ram1_lake_patch (begp:endp)) ; this%ram1_lake_patch (:) = nan + allocate(this%lake_raw_col (begc:endc)) ; this%lake_raw_col (:) = nan + allocate(this%ks_col (begc:endc)) ; this%ks_col (:) = nan + allocate(this%ws_col (begc:endc)) ; this%ws_col (:) = nan + allocate(this%betaprime_col (begc:endc)) ; this%betaprime_col (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(lakestate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%lake_icefrac_col(begc:endc,:) = spval + call hist_addfld2d (fname='LAKEICEFRAC', units='unitless', type2d='levlak', & + avgflag='A', long_name='lake layer ice mass fraction', & + ptr_col=this%lake_icefrac_col) + + this%lake_icethick_col(begc:endc) = spval ! This will be more useful than LAKEICEFRAC for many users. + call hist_addfld1d (fname='LAKEICETHICK', units='m', & + avgflag='A', long_name='thickness of lake ice (including physical expansion on freezing)', & + ptr_col=this%lake_icethick_col, set_nolake=spval) + + this%savedtke1_col(begc:endc) = spval + call hist_addfld1d (fname='TKE1', units='W/(mK)', & + avgflag='A', long_name='top lake level eddy thermal conductivity', & + ptr_col=this%savedtke1_col) + + this%ram1_lake_patch(begp:endp) = spval + call hist_addfld1d (fname='RAM_LAKE', units='s/m', & + avgflag='A', long_name='aerodynamic resistance for momentum (lakes only)', & + ptr_patch=this%ram1_lake_patch, set_nolake=spval, default='inactive') + + this%ust_lake_col(begc:endc) = spval + call hist_addfld1d (fname='UST_LAKE', units='m/s', & + avgflag='A', long_name='friction velocity (lakes only)', & + ptr_col=this%ust_lake_col, set_nolake=spval, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize time constant and time varying module variables + ! + ! !USES: + use clm_varctl , only : fsurdat + use clm_varctl , only : iulog + use clm_varpar , only : nlevlak + use clm_varcon , only : tkwat + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use ncdio_pio , only : ncd_pio_openfile, ncd_inqfdims, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen + ! + ! !ARGUMENTS: + class(lakestate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,g,i,j,l,lev + logical :: readvar + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: locfn ! local filename + real(r8) :: depthratio ! ratio of lake depth to standard deep lake depth + real(r8) ,pointer :: lakefetch_in (:) ! read in - lakefetch + real(r8) ,pointer :: etal_in (:) ! read in - etal + !----------------------------------------------------------------------- + + !------------------------------------------------- + ! Initialize time constant variables + !------------------------------------------------- + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + ! Read lake eta + allocate(etal_in(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='ETALAKE', flag='read', data=etal_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + if (masterproc) then + write(iulog,*) 'WARNING:: ETALAKE not found on surface data set. All lake columns will have eta', & + ' set equal to default value as a function of depth.' + end if + etal_in(:) = -1._r8 + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%etal_col(c) = etal_in(g) + end do + deallocate(etal_in) + + ! Read lake fetch + allocate(lakefetch_in(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='LAKEFETCH', flag='read', data=lakefetch_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + if (masterproc) then + write(iulog,*) 'WARNING:: LAKEFETCH not found on surface data set. All lake columns will have fetch', & + ' set equal to default value as a function of depth.' + end if + lakefetch_in(:) = -1._r8 + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + this%lakefetch_col(c) = lakefetch_in(g) + end do + deallocate(lakefetch_in) + + call ncd_pio_closefile(ncid) + + !------------------------------------------------- + ! Initialize time varying variables + !------------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%lakpoi(l)) then + + ! Set lake ice fraction and top eddy conductivity from previous timestep + ! Always initialize with no ice to prevent excessive ice sheets from forming when + ! starting with old lake model that has unrealistically cold lake conseratures. + ! Keep lake temperature as is, and the energy deficit below freezing (which is no smaller + ! than it would have been with prognostic ice, as the temperature would then have been higher + ! and more heat would have flowed out of the lake) will be converted to ice in the first timestep. + this%lake_icefrac_col(c,1:nlevlak) = 0._r8 + + ! Set lake top eddy conductivity from previous timestep + this%savedtke1_col(c) = tkwat + + ! Set column friction vlocity + this%ust_lake_col(c) = 0.1_r8 + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(lakestate_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='LAKE_ICEFRAC', xtype=ncd_double, & + dim1name='column', dim2name='levlak', switchdim=.true., & + long_name='lake layer ice fraction', units='kg/kg', & + interpinic_flag='interp', readvar=readvar, data=this%lake_icefrac_col) + + call restartvar(ncid=ncid, flag=flag, varname='SAVEDTKE1', xtype=ncd_double, & + dim1name='column', & + long_name='top lake layer eddy conductivity', units='W/(m K)', & + interpinic_flag='interp', readvar=readvar, data=this%savedtke1_col) + + call restartvar(ncid=ncid, flag=flag, varname='USTLAKE', xtype=ncd_double, & + dim1name='column', & + long_name='friction velocity for lakes', units='m/s', & + interpinic_flag='interp', readvar=readvar, data=this%ust_lake_col) + + end subroutine Restart + +end module LakeStateType + diff --git a/components/clm/src/biogeophys/LakeTemperatureMod.F90 b/components/clm/src/biogeophys/LakeTemperatureMod.F90 new file mode 100644 index 0000000000..f7d9964feb --- /dev/null +++ b/components/clm/src/biogeophys/LakeTemperatureMod.F90 @@ -0,0 +1,1472 @@ +module LakeTemperatureMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates surface fluxes and temperature for lakes. + ! Created by Zack Subin, 2009 + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use ch4Mod , only : ch4_type + use EnergyFluxType , only : energyflux_type + use LakeStateType , only : lakestate_type + use SoilStateType , only : soilstate_type + use SolarAbsorbedType , only : solarabs_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: LakeTemperature ! Calculates Lake related temperature + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: SoilThermProp_Lake ! Set therm conductivities and heat cap of snow/soil layers + private :: PhaseChange_Lake ! Calculation of the phase change within snow/soil/lake layers + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine LakeTemperature(bounds, num_lakec, filter_lakec, num_lakep, filter_lakep, & + solarabs_inst, soilstate_inst, waterstate_inst, waterflux_inst, ch4_inst, & + energyflux_inst, temperature_inst, lakestate_inst) + ! + ! !DESCRIPTION: + ! Calculates temperatures in the 25-45 layer column of (possible) snow, + ! lake water, soil, and bedrock beneath lake. + ! Snow and soil temperatures are determined as in Laketemperature, except + ! for appropriate boundary conditions at the top of the snow (the flux is fixed + ! to be the ground heat flux calculated in LakeFluxes), the bottom of the snow + ! (adjacent to top lake layer), and the top of the soil (adjacent to the bottom + ! lake layer). Also, the soil is kept fully saturated. + ! The whole column is solved simultaneously as one tridiagonal matrix. + ! Major changes from CLM4: + ! i) Lake water layers can freeze by any fraction and release latent heat; thermal + ! and mechanical properties are adjusted for ice fraction. + ! ii) Convective mixing (though not eddy diffusion) still occurs for frozen lakes. + ! iii) No sunlight is absorbed in the lake if there are snow layers (except for that allowed through + ! to the top "soil" layer by SNICAR) + ! iv) Light is allowed to reach the top soil layer (where it is assumed to be completely absorbed). + ! v) Lakes have variable depth, set ultimately in surface data set but now in initLakeMod. + ! vi) The extinction coefficient is now variable with depth. + ! vii) The fraction of shortwave absorbed at the surface is now the NIR fraction, rather than a fixed parameter. + ! viii) Enhanced background diffusion and option for increased mixing for deep lakes is added. + ! See discussion in Subin et al. 2011 + ! + ! Lakes are allowed to have variable depth, set in initLakeMod. + ! + ! Use the Crank-Nicholson method to set up tridiagonal system of equations to + ! solve for ts at time n+1, where the temperature equation for layer i is + ! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1 + ! + ! The solution conserves energy as: + ! + ! + ! cv*([ts(top soisno layer)] n+1 - [ts(top soisno layer)] n)*dz(top soisno layer)/dt + ... + + ! cv*([ts(nlevlak+nlevgrnd)] n+1 - [ts(nlevlak+nlevgrnd)] n)*dz(nlevlak+nlevgrnd)/dt = eflx_soil_grnd + ! cv is not constant. + ! ts is with respect to freezing temperature, as there is a discontinuity in cv at this temperature. + ! + ! where: + ! [ts] n = old temperature (kelvin) + ! [ts] n+1 = new temperature (kelvin) + ! eflx_soil_grnd = energy flux into lake (w/m**2) + ! = betaprime*sabg + forc_lwrad - eflx_lwrad_out - eflx_sh_tot - eflx_lh_tot + ! (This is now the same as the ground heat flux.) + ! + phi(1) + ... + phi(nlevlak) + phi(top soil level) + ! betaprime = beta (NIR fraction) for no snow layers, and sabg_lyr(p,jtop)/sabg(p) for snow layers. + ! + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! Outline: + ! 1 ) Initialization + ! 2 ) Lake density + ! 3 ) Diffusivity + ! 4 ) Heat source term from solar radiation penetrating lake + ! 5 ) Set thermal props and find initial energy content + ! 6 ) Set up vectors for tridiagonal matrix solution + ! 7 ) Solve tridiagonal and back-substitute + ! 8 ) (Optional) Do first energy check using temperature change at constant heat capacity. + ! 9 ) Phase change + ! 9.5) (Optional) Do second energy check using temperature change and latent heat, + ! considering changed heat capacity. Also do soil water balance check. + ! 10 ) Convective mixing + ! 11 ) Do final energy check to detect small numerical errors (especially from convection) + ! and dump small imbalance into sensible heat, or pass large errors to BalanceCheckMod for abort. + ! + ! !USES: + use LakeCon , only : betavis, za_lake, n2min, tdmax, pudz, depthcrit, mixfact + use LakeCon , only : lakepuddling, lake_no_ed + use QSatMod , only : QSat + use TridiagonalMod , only : Tridiagonal + use clm_varpar , only : nlevlak, nlevgrnd, nlevsno + use clm_time_manager , only : get_step_size + use clm_varcon , only : hfus, cpliq, cpice, tkwat, tkice, denice + use clm_varcon , only : vkc, grav, denh2o, tfrz, cnfac + use clm_varctl , only : iulog, use_lch4 + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_lakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for non-lake points + integer , intent(in) :: num_lakep ! number of column non-lake points in pft filter + integer , intent(in) :: filter_lakep(:) ! patch filter for non-lake points + type(solarabs_type) , intent(in) :: solarabs_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(ch4_type) , intent(inout) :: ch4_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(lakestate_type) , intent(inout) :: lakestate_inst + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: p0 = 1._r8 ! neutral value of turbulent prandtl number + integer :: i,j,fc,fp,g,c,p ! do loop or array index + real(r8) :: dtime ! land model time step (sec) + real(r8) :: beta(bounds%begc:bounds%endc) ! fraction of solar rad absorbed at surface: equal to NIR fraction + ! of surface absorbed shortwave + real(r8) :: eta ! light extinction coefficient (/m): depends on lake type + real(r8) :: cwat ! specific heat capacity of water (j/m**3/kelvin) + real(r8) :: cice_eff ! effective heat capacity of ice (using density of + ! water because layer depth is not adjusted when freezing + real(r8) :: cfus ! effective heat of fusion per unit volume + ! using water density as above + real(r8) :: km ! molecular diffusion coefficient (m**2/s) + real(r8) :: tkice_eff ! effective conductivity since layer depth is constant + real(r8) :: a(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! "a" vector for tridiagonal matrix + real(r8) :: b(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! "b" vector for tridiagonal matrix + real(r8) :: c1(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! "c" vector for tridiagonal matrix + real(r8) :: r(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! "r" vector for tridiagonal solution + real(r8) :: rhow(bounds%begc:bounds%endc,nlevlak) ! density of water (kg/m**3) + real(r8) :: phi(bounds%begc:bounds%endc,nlevlak) ! solar radiation absorbed by layer (w/m**2) + real(r8) :: kme(bounds%begc:bounds%endc,nlevlak) ! molecular + eddy diffusion coefficient (m**2/s) + real(r8) :: rsfin ! relative flux of solar radiation into layer + real(r8) :: rsfout ! relative flux of solar radiation out of layer + real(r8) :: phi_soil(bounds%begc:bounds%endc) ! solar radiation into top soil layer (W/m**2) + real(r8) :: ri ! richardson number + real(r8) :: fin(bounds%begc:bounds%endc) ! net heat flux into lake at ground interface (w/m**2) + real(r8) :: ocvts(bounds%begc:bounds%endc) ! (cwat*(t_lake[n ])*dz + real(r8) :: ncvts(bounds%begc:bounds%endc) ! (cwat*(t_lake[n+1])*dz + real(r8) :: ke ! eddy diffusion coefficient (m**2/s) + real(r8) :: zin ! depth at top of layer (m) + real(r8) :: zout ! depth at bottom of layer (m) + real(r8) :: drhodz ! d [rhow] /dz (kg/m**4) + real(r8) :: n2 ! brunt-vaisala frequency (/s**2) + real(r8) :: num ! used in calculating ri + real(r8) :: den ! used in calculating ri + real(r8) :: tav_froz(bounds%begc:bounds%endc) ! used in aver temp for convectively mixed layers (C) + real(r8) :: tav_unfr(bounds%begc:bounds%endc) ! " + real(r8) :: nav(bounds%begc:bounds%endc) ! used in aver temp for convectively mixed layers + real(r8) :: phidum ! temporary value of phi + real(r8) :: iceav(bounds%begc:bounds%endc) ! used in calc aver ice for convectively mixed layers + real(r8) :: qav(bounds%begc:bounds%endc) ! used in calc aver heat content for conv. mixed layers + integer :: jtop(bounds%begc:bounds%endc) ! top level for each column (no longer all 1) + real(r8) :: cv (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! heat capacity of soil/snow [J/(m2 K)] + real(r8) :: tk (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! thermal conductivity of soil/snow [W/(m K)] + ! (at interface below, except for j=0) + real(r8) :: cv_lake (bounds%begc:bounds%endc,1:nlevlak) ! heat capacity [J/(m2 K)] + real(r8) :: tk_lake (bounds%begc:bounds%endc,1:nlevlak) ! thermal conductivity at layer node [W/(m K)] + real(r8) :: cvx (bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! heat capacity for whole column [J/(m2 K)] + real(r8) :: tkix(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! thermal conductivity at layer interfaces + ! for whole column [W/(m K)] + real(r8) :: tx(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! temperature of whole column [K] + real(r8) :: tktopsoillay(bounds%begc:bounds%endc) ! thermal conductivity [W/(m K)] + real(r8) :: fnx(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! heat diffusion through the layer interface below [W/m2] + real(r8) :: phix(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! solar source term for whole column [W/m**2] + real(r8) :: zx(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! interface depth (+ below surface) for whole column [m] + real(r8) :: dzm ! used in computing tridiagonal matrix [m] + real(r8) :: dzp ! used in computing tridiagonal matrix [m] + integer :: jprime ! j - nlevlak + real(r8) :: factx(bounds%begc:bounds%endc,-nlevsno+1:nlevlak+nlevgrnd) ! coefficient used in computing tridiagonal matrix + real(r8) :: t_lake_bef(bounds%begc:bounds%endc,1:nlevlak) ! beginning lake temp for energy conservation check [K] + real(r8) :: t_soisno_bef(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! beginning soil temp for E cons. check [K] + real(r8) :: lhabs(bounds%begc:bounds%endc) ! total per-column latent heat abs. from phase change (J/m^2) + real(r8) :: esum1(bounds%begc:bounds%endc) ! temp for checking energy (J/m^2) + real(r8) :: esum2(bounds%begc:bounds%endc) ! "" + real(r8) :: zsum(bounds%begc:bounds%endc) ! temp for putting ice at the top during convection (m) + real(r8) :: wsum(bounds%begc:bounds%endc) ! temp for checking water (kg/m^2) + real(r8) :: wsum_end(bounds%begc:bounds%endc) ! temp for checking water (kg/m^2) + real(r8) :: sabg_col(bounds%begc:bounds%endc) ! absorbed ground solar for column (W/m^2) + real(r8) :: sabg_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:1) ! absorbed ground solar in layer for column (W/m^2) + real(r8) :: sabg_nir ! NIR that is absorbed (W/m^2) + integer :: jconvect(bounds%begc:bounds%endc) ! Lowest level where convection occurs + integer :: jconvectbot(bounds%begc:bounds%endc) ! Hightest level where bottom-originating convection occurs + logical :: bottomconvect(bounds%begc:bounds%endc) ! Convection originating in bottom layer of lake triggers special convection loop + real(r8) :: fangkm ! (m^2/s) extra diffusivity based on Fang & Stefan 1996, citing Ellis, 1991 + + ! They think that mixing energy will generally get into lake to make + ! diffusivity exceed molecular; the energy is damped out according to the Brunt-Vaisala + ! frequency, yielding a maximum diffusivity for neutral stability of about 6 times molecular + ! For puddling + logical :: puddle(bounds%begc:bounds%endc) + real(r8) :: icesum(bounds%begc:bounds%endc) ! m + logical :: frzn(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- + + associate( & + dz_lake => col%dz_lake , & ! Input: [real(r8) (:,:) ] layer thickness for lake (m) + z_lake => col%z_lake , & ! Input: [real(r8) (:,:) ] layer depth for lake (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness for snow & soil (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth for snow & soil (m) + snl => col%snl , & ! Input: [integer (:) ] negative of number of snow layers + lakedepth => col%lakedepth , & ! Input: [real(r8) (:) ] column lake depth (m) + + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Input: [real(r8) (:,:) ] absorbed solar radiation (pft,lyr) [W/m2] + fsds_nir_d => solarabs_inst%fsds_nir_d_patch , & ! Input: [real(r8) (:) ] incident direct beam nir solar radiation (W/m**2) + fsds_nir_i => solarabs_inst%fsds_nir_i_patch , & ! Input: [real(r8) (:) ] incident diffuse nir solar radiation (W/m**2) + fsr_nir_d => solarabs_inst%fsr_nir_d_patch , & ! Input: [real(r8) (:) ] reflected direct beam nir solar radiation (W/m**2) + fsr_nir_i => solarabs_inst%fsr_nir_i_patch , & ! Input: [real(r8) (:) ] reflected diffuse nir solar radiation (W/m**2) + + etal => lakestate_inst%etal_col , & ! Input: [real(r8) (:) ] extinction coefficient from surface data (1/m) + ks => lakestate_inst%ks_col , & ! Input: [real(r8) (:) ] coefficient passed to LakeTemperature + ws => lakestate_inst%ws_col , & ! Input: [real(r8) (:) ] surface friction velocity (m/s) + lake_raw => lakestate_inst%lake_raw_col , & ! Input: [real(r8) (:) ] aerodynamic resistance for moisture (s/m) + + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) [for snow & soil layers] + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) [for snow & soil layers] + frac_iceold => waterstate_inst%frac_iceold_col , & ! Output: [real(r8) (:,:) ] fraction of ice relative to the tot water + + qflx_snofrz_col => waterflux_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (kg m-2 s-1) [+] + + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil (or snow) temperature (Kelvin) + t_lake => temperature_inst%t_lake_col , & ! Output: [real(r8) (:,:) ] col lake temperature (Kelvin) + hc_soi => temperature_inst%hc_soi_col , & ! Output: [real(r8) (:) ] soil heat content (MJ/m2) + hc_soisno => temperature_inst%hc_soisno_col , & ! Output: [real(r8) (:) ] soil plus snow plus lake heat content (MJ/m2) + + beta => lakestate_inst%betaprime_col , & ! Output: [real(r8) (:) ] col effective beta: sabg_lyr(p,jtop) for snow layers, beta otherwise + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Output: [real(r8) (:,:) ] col mass fraction of lake layer that is frozen + lake_icethick => lakestate_inst%lake_icethick_col , & ! Output: [real(r8) (:) ] col ice thickness (m) (integrated if lakepuddling) + savedtke1 => lakestate_inst%savedtke1_col , & ! Output: [real(r8) (:) ] col top level eddy conductivity (W/mK) + lakeresist => lakestate_inst%lakeresist_col , & ! Output: [real(r8) (:) ] col (Needed for calc. of grnd_ch4_cond) (s/m) + + grnd_ch4_cond => ch4_inst%grnd_ch4_cond_col , & ! Output: [real(r8) (:) ] tracer conductance for boundary layer [m/s] (only over lake points) + + eflx_soil_grnd => energyflux_inst%eflx_soil_grnd_patch , & ! Output: [real(r8) (:) ] heat flux into snow / lake (W/m**2) [+ = into soil] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [real(r8) ( :) ] net heat flux into ground (W/m**2) at the surface interface + errsoi => energyflux_inst%errsoi_col & ! Output: [real(r8) (:) ] soil/lake energy conservation error (W/m**2) + ) + + ! 1!) Initialization + ! Determine step size + + dtime = get_step_size() + + ! Initialize constants + cwat = cpliq*denh2o ! water heat capacity per unit volume + cice_eff = cpice*denh2o !use water density because layer depth is not adjusted + !for freezing + cfus = hfus*denh2o ! latent heat per unit volume + tkice_eff = tkice * denice/denh2o !effective conductivity since layer depth is constant + km = tkwat/cwat ! a constant (molecular diffusivity) + + ! Needed for Lahey compiler which doesn't seem to allow shortcircuit logic for undefined variables. + puddle(bounds%begc:bounds%endc) = .false. + frzn(bounds%begc:bounds%endc) = .false. + + ! Begin calculations + + do fc = 1, num_lakec + c = filter_lakec(fc) + + ! Initialize quantities needed below + + ocvts(c) = 0._r8 + ncvts(c) = 0._r8 + esum1(c) = 0._r8 + esum2(c) = 0._r8 + hc_soisno(c) = 0._r8 + hc_soi(c) = 0._r8 + if (use_lch4) then + jconvect(c) = 0 + jconvectbot(c) = nlevlak+1 + lakeresist(c) = 0._r8 + end if + bottomconvect(bounds%begc:bounds%endc) = .false. + + qflx_snofrz_col(c) = 0._r8 + end do + + ! Initialize set of previous time-step variables as in DriverInit, + ! which is currently not called over lakes. This has to be done + ! here because phase change will occur in this routine. + ! Ice fraction of snow at previous time step + + do j = -nlevsno+1,0 + do fc = 1, num_lakec + c = filter_lakec(fc) + if (j >= snl(c) + 1) then + frac_iceold(c,j) = h2osoi_ice(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + end if + end do + end do + + ! Prepare for lake layer temperature calculations below + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + + ! fin(c) = betaprime * sabg(p) + forc_lwrad(c) - (eflx_lwrad_out(p) + & + ! eflx_sh_tot(p) + eflx_lh_tot(p)) + ! fin(c) now passed from LakeFluxes as eflx_gnet + fin(c) = eflx_gnet(p) + + ! Calculate the NIR fraction of absorbed solar. This will now be the "beta" parameter. + ! Total NIR absorbed: + sabg_nir = fsds_nir_d(p) + fsds_nir_i(p) - fsr_nir_d(p) - fsr_nir_i(p) + sabg_nir = min(sabg_nir, sabg(p)) + beta(c) = sabg_nir/max(1.e-5_r8,sabg(p)) + beta(c) = beta(c) + (1._r8-beta(c))*betavis + + end do + + ! 2!) Lake density + + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + rhow(c,j) = (1._r8 - lake_icefrac(c,j)) * & + 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,j)-tdmax))**1.68_r8 ) & + + lake_icefrac(c,j)*denice + ! Allow for ice fraction; assume constant ice density. + ! This is not the correct average-weighting but that's OK because the density will only + ! be used for convection for lakes with ice, and the ice fraction will dominate the + ! density differences between layers. + ! Using this average will make sure that surface ice is treated properly during + ! convective mixing. + end do + end do + + ! 3!) Diffusivity and implied thermal "conductivity" = diffusivity * cwat + do j = 1, nlevlak-1 + do fc = 1, num_lakec + c = filter_lakec(fc) + drhodz = (rhow(c,j+1)-rhow(c,j)) / (z_lake(c,j+1)-z_lake(c,j)) + n2 = grav / rhow(c,j) * drhodz + + ! Fixed sign error here: our z goes up going down into the lake, so no negative + ! sign is needed to make this positive unlike in Hostetler. --ZS + num = 40._r8 * n2 * (vkc*z_lake(c,j))**2._r8 + den = max( (ws(c)**2._r8) * exp(-2._r8*ks(c)*z_lake(c,j)), 1.e-10_r8 ) + ri = ( -1._r8 + sqrt( max(1._r8+num/den, 0._r8) ) ) / 20._r8 + + if (lakepuddling .and. j == 1) frzn(c) = .false. + + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0 .and. & + (.not. lakepuddling .or. (lake_icefrac(c,j) == 0._r8 .and. .not. frzn(c))) ) then + ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._r8+37._r8*ri*ri) + kme(c,j) = km + ke + + if (.not. lake_no_ed) then + fangkm = 1.039e-8_r8 * max(n2,n2min)**(-0.43_r8) ! Fang & Stefan 1996, citing Ellis et al 1991 + kme(c,j) = kme(c,j) + fangkm + end if + if (lakedepth(c) >= depthcrit) then + kme(c,j) = kme(c,j) * mixfact + end if + + tk_lake(c,j) = kme(c,j)*cwat + else + kme(c,j) = km + if (.not. lake_no_ed) then + fangkm = 1.039e-8_r8 * max(n2,n2min)**(-0.43_r8) + kme(c,j) = kme(c,j) + fangkm + if (lakedepth(c) >= depthcrit) then + kme(c,j) = kme(c,j) * mixfact + end if + tk_lake(c,j) = kme(c,j)*cwat*tkice_eff / ( (1._r8-lake_icefrac(c,j))*tkice_eff & + + kme(c,j)*cwat*lake_icefrac(c,j) ) + else + tk_lake(c,j) = tkwat*tkice_eff / ( (1._r8-lake_icefrac(c,j))*tkice_eff & + + tkwat*lake_icefrac(c,j) ) + ! Assume the resistances add as for the calculation of conductivities at layer interfaces. + end if + if (lakepuddling) frzn(c) = .true. + ! Prevent eddy mixing beneath frozen layers even when surface is unfrozen. + end if + end do + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + + j = nlevlak + kme(c,nlevlak) = kme(c,nlevlak-1) + + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0 .and. & + (.not. lakepuddling .or. (lake_icefrac(c,j) == 0._r8 .and. .not. frzn(c)) ) ) then + tk_lake(c,j) = tk_lake(c,j-1) + else + if (.not. lake_no_ed) then + tk_lake(c,j) = kme(c,j)*cwat*tkice_eff / ( (1._r8-lake_icefrac(c,j))*tkice_eff & + + kme(c,j)*cwat*lake_icefrac(c,j) ) + else + tk_lake(c,j) = tkwat*tkice_eff / ( (1._r8-lake_icefrac(c,j))*tkice_eff & + + tkwat*lake_icefrac(c,j) ) + end if + end if + + ! Use in surface flux calculation for next timestep. + savedtke1(c) = kme(c,1)*cwat ! Will only be used if unfrozen + ! set number of column levels for use by Tridiagonal below + jtop(c) = snl(c) + 1 + end do + + ! 4!) Heat source term + do j = 1, nlevlak + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + + ! If no eta from surface data, + ! Set eta, the extinction coefficient, according to L Hakanson, Aquatic Sciences, 1995 + ! (regression of Secchi Depth with lake depth for small glacial basin lakes), and the + ! Poole & Atkins expression for extinction coeffient of 1.7 / Secchi Depth (m). + if (etal(c) > 0._r8) then ! use eta from surface data + eta = etal(c) + else + eta = 1.1925_r8*max(lakedepth(c),1._r8)**(-0.424_r8) + end if + + zin = z_lake(c,j) - 0.5_r8*dz_lake(c,j) + zout = z_lake(c,j) + 0.5_r8*dz_lake(c,j) + rsfin = exp( -eta*max( zin-za_lake,0._r8 ) ) + rsfout = exp( -eta*max( zout-za_lake,0._r8 ) ) + + ! Let rsfout for bottom layer go into soil. + ! This looks like it should be robust even for pathological cases, + ! like lakes thinner than za_lake. + + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + phidum = (rsfin-rsfout) * sabg(p) * (1._r8-beta(c)) + if (j == nlevlak) then + phi_soil(c) = rsfout * sabg(p) * (1._r8-beta(c)) + end if + else if (j == 1 .and. snl(c) == 0) then !if frozen but no snow layers + phidum = sabg(p) * (1._r8-beta(c)) + ! This should be improved upon; Mironov 2002 suggests that SW can penetrate thin ice and may + ! cause spring convection. + else if (j == 1) then + phidum = sabg_lyr(p,j) + !some radiation absorbed in snow layers, the rest in the top layer of lake + !radiation absorbed in snow layers will be applied below + else + phidum = 0._r8 + if (j == nlevlak) phi_soil(c) = 0._r8 + end if + phi(c,j) = phidum + + end do + end do + + ! 5!) Set thermal properties and check initial energy content. + + ! For lake + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._r8-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + end do + end do + + ! For snow / soil + call SoilThermProp_Lake(bounds, num_lakec, filter_lakec, & + tk(bounds%begc:bounds%endc, :), & + cv(bounds%begc:bounds%endc, :), & + tktopsoillay(bounds%begc:bounds%endc), & + soilstate_inst, waterstate_inst, temperature_inst) + + ! Sum cv*t_lake for energy check + ! Include latent heat term, and use tfrz as reference temperature + ! to prevent abrupt change in heat content due to changing heat capacity with phase change. + + ! This will need to be over all soil / lake / snow layers. Lake is below. + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + ocvts(c) = ocvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & + + cfus*dz_lake(c,j)*(1._r8-lake_icefrac(c,j)) + t_lake_bef(c,j) = t_lake(c,j) + end do + end do + + ! Now do for soil / snow layers + do j = -nlevsno + 1, nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j >= jtop(c)) then + ocvts(c) = ocvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + + hfus*h2osoi_liq(c,j) + if (j == 1 .and. h2osno(c) > 0._r8 .and. j == jtop(c)) then + ocvts(c) = ocvts(c) - h2osno(c)*hfus + end if + t_soisno_bef(c,j) = t_soisno(c,j) + end if + end do + end do + + !!!!!!!!!!!!!!!!!!! + ! 6!) Set up vector r and vectors a, b, c1 that define tridiagonal matrix + + ! Heat capacity and resistance of snow without snow layers (<1cm) is ignored during diffusion, + ! but its capacity to absorb latent heat may be used during phase change. + + ! Transfer sabg and sabg_lyr to column level + do j = -nlevsno+1,1 + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + + if (j >= jtop(c)) then + if (j == jtop(c)) sabg_col(c) = sabg(p) + sabg_lyr_col(c,j) = sabg_lyr(p,j) + end if + end do + end do + + ! Set up interface depths, zx, heat capacities, cvx, solar source terms, phix, and temperatures, tx. + do j = -nlevsno+1, nlevlak+nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + + jprime = j - nlevlak + + if (j >= jtop(c)) then + if (j < 1) then !snow layer + zx(c,j) = z(c,j) + cvx(c,j) = cv(c,j) + if (j == jtop(c)) then ! no absorption because it has already been assigned to the surface + ! interface + phix(c,j) = 0._r8 + else + phix(c,j) = sabg_lyr_col(c,j) !New for SNICAR + end if + tx(c,j) = t_soisno(c,j) + else if (j <= nlevlak) then !lake layer + zx(c,j) = z_lake(c,j) + cvx(c,j) = cv_lake(c,j) + phix(c,j) = phi(c,j) + tx(c,j) = t_lake(c,j) + else !soil layer + zx(c,j) = zx(c,nlevlak) + dz_lake(c,nlevlak)/2._r8 + z(c,jprime) + cvx(c,j) = cv(c,jprime) + if (j == nlevlak + 1) then !top soil layer + phix(c,j) = phi_soil(c) + else !middle or bottom soil layer + phix(c,j) = 0._r8 + end if + tx(c,j) = t_soisno(c,jprime) + end if + end if + + end do + end do + + ! Determine interface thermal conductivities, tkix + + do j = -nlevsno+1, nlevlak+nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + + jprime = j - nlevlak + + if (j >= jtop(c)) then + if (j < 0) then !non-bottom snow layer + tkix(c,j) = tk(c,j) + else if (j == 0) then !bottom snow layer + dzp = zx(c,j+1) - zx(c,j) + tkix(c,j) = tk_lake(c,1)*tk(c,j)*dzp / & + (tk(c,j)*z_lake(c,1) + tk_lake(c,1)*(-z(c,j)) ) + ! tk(c,0) is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake + else if (j < nlevlak) then !non-bottom lake layer + tkix(c,j) = ( tk_lake(c,j)*tk_lake(c,j+1) * (dz_lake(c,j+1)+dz_lake(c,j)) ) & + / ( tk_lake(c,j)*dz_lake(c,j+1) + tk_lake(c,j+1)*dz_lake(c,j) ) + else if (j == nlevlak) then !bottom lake layer + dzp = zx(c,j+1) - zx(c,j) + tkix(c,j) = (tktopsoillay(c)*tk_lake(c,j)*dzp / & + (tktopsoillay(c)*dz_lake(c,j)/2._r8 + tk_lake(c,j)*z(c,1) ) ) + ! tktopsoillay is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake + else !soil layer + tkix(c,j) = tk(c,jprime) + end if + end if + + end do + end do + + + ! Determine heat diffusion through the layer interface and factor used in computing + ! tridiagonal matrix and set up vector r and vectors a, b, c1 that define tridiagonal + ! matrix and solve system + + do j = -nlevsno+1, nlevlak+nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + if (j >= jtop(c)) then + if (j < nlevlak+nlevgrnd) then !top or interior layer + factx(c,j) = dtime/cvx(c,j) + fnx(c,j) = tkix(c,j)*(tx(c,j+1)-tx(c,j))/(zx(c,j+1)-zx(c,j)) + else !bottom soil layer + factx(c,j) = dtime/cvx(c,j) + fnx(c,j) = 0._r8 !not used + end if + end if + enddo + end do + + do j = -nlevsno+1,nlevlak+nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + if (j >= jtop(c)) then + if (j == jtop(c)) then !top layer + dzp = zx(c,j+1)-zx(c,j) + a(c,j) = 0._r8 + b(c,j) = 1+(1._r8-cnfac)*factx(c,j)*tkix(c,j)/dzp + c1(c,j) = -(1._r8-cnfac)*factx(c,j)*tkix(c,j)/dzp + r(c,j) = tx(c,j) + factx(c,j)*( fin(c) + phix(c,j) + cnfac*fnx(c,j) ) + else if (j < nlevlak+nlevgrnd) then !middle layer + dzm = (zx(c,j)-zx(c,j-1)) + dzp = (zx(c,j+1)-zx(c,j)) + a(c,j) = - (1._r8-cnfac)*factx(c,j)* tkix(c,j-1)/dzm + b(c,j) = 1._r8+ (1._r8-cnfac)*factx(c,j)*(tkix(c,j)/dzp + tkix(c,j-1)/dzm) + c1(c,j) = - (1._r8-cnfac)*factx(c,j)* tkix(c,j)/dzp + r(c,j) = tx(c,j) + cnfac*factx(c,j)*( fnx(c,j) - fnx(c,j-1) ) + factx(c,j)*phix(c,j) + else !bottom soil layer + dzm = (zx(c,j)-zx(c,j-1)) + a(c,j) = - (1._r8-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + b(c,j) = 1._r8+ (1._r8-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + c1(c,j) = 0._r8 + r(c,j) = tx(c,j) - cnfac*factx(c,j)*fnx(c,j-1) + end if + end if + enddo + end do + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! 7!) Solve for tdsolution + + call Tridiagonal(bounds, -nlevsno + 1, nlevlak + nlevgrnd, & + jtop(bounds%begc:bounds%endc), & + num_lakec, filter_lakec, & + a(bounds%begc:bounds%endc, :), & + b(bounds%begc:bounds%endc, :), & + c1(bounds%begc:bounds%endc, :), & + r(bounds%begc:bounds%endc, :), & + tx(bounds%begc:bounds%endc, :)) + + ! Set t_soisno and t_lake + do j = -nlevsno+1, nlevlak + nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + + jprime = j - nlevlak + + ! Don't do anything with invalid snow layers. + if (j >= jtop(c)) then + if (j < 1) then !snow layer + t_soisno(c,j) = tx(c,j) + else if (j <= nlevlak) then !lake layer + t_lake(c,j) = tx(c,j) + else !soil layer + t_soisno(c,jprime) = tx(c,j) + end if + end if + end do + end do + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 8!) Sum energy content and total energy into lake for energy check. Any errors will be from the + ! Tridiagonal solution. + ! This section was for debugging only and has been removed. See original "ch4" branch code. + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 9!) Phase change + call PhaseChange_Lake(bounds, num_lakec, filter_lakec, & + cv(bounds%begc:bounds%endc, :), & + cv_lake(bounds%begc:bounds%endc, :), & + lhabs(bounds%begc:bounds%endc), & + waterstate_inst, waterflux_inst, temperature_inst, & + energyflux_inst, lakestate_inst) + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 9.5!) Second energy check and water check. Now check energy balance before and after phase + ! change, considering the possibility of changed heat capacity during phase change, by + ! using initial heat capacity in the first step, final heat capacity in the second step, + ! and differences from tfrz only to avoid enthalpy correction for (cpliq-cpice)*melt*tfrz. + ! Also check soil water sum. + ! This section was for debugging only and has been removed. See original "ch4" branch code. + + !!!!!!!!!!!!!!!!!!!!!!!!!! + ! 10!) Convective mixing: make sure fracice*dz is conserved, heat content c*dz*T is conserved, and + ! all ice ends up at the top. Done over all lakes even if frozen. + ! Either an unstable density profile or ice in a layer below an incompletely frozen layer will trigger. + + !Recalculate density + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + rhow(c,j) = (1._r8 - lake_icefrac(c,j)) * & + 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,j)-tdmax))**1.68_r8 ) & + + lake_icefrac(c,j)*denice + end do + end do + + if (lakepuddling) then + ! For sensitivity tests + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j == 1) then + icesum(c) = 0._r8 + puddle(c) = .false. + end if + + icesum(c) = icesum(c) + lake_icefrac(c,j)*dz(c,j) + + if (j == nlevlak) then + if (icesum(c) >= pudz) puddle(c) = .true. + end if + end do + end do + end if + + ! ZMS: The algorithm here, from CLM2-4 and presumably Hostetler, starts at the top and proceeds down; + ! each time it finds an unstable density profile the lake is mixed from this point to the top fully. + ! Occasionally in deep temperate lakes, the unstable profile can originate at the bottom because of small amounts of + ! heat coming from the sediments. To prevent an unrealistic complete overturning, convection starting in the bottom + ! layer is treated separately, mixing from the bottom up only one level at a time until + ! a stable density profile is attained, rather than mixing all the way to the top immediately. + + ! First examine top nlevlak-1 layers. + do j = 1, nlevlak-2 + do fc = 1, num_lakec + c = filter_lakec(fc) + qav(c) = 0._r8 + nav(c) = 0._r8 + iceav(c) = 0._r8 + end do + + do i = 1, j+1 + do fc = 1, num_lakec + c = filter_lakec(fc) + if ( (.not. lakepuddling .or. .not. puddle(c) ) .and. (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._r8 .and. lake_icefrac(c,j+1) > 0._r8) ) ) then + qav(c) = qav(c) + dz_lake(c,i)*(t_lake(c,i)-tfrz) * & + ((1._r8 - lake_icefrac(c,i))*cwat + lake_icefrac(c,i)*cice_eff) + !tav(c) = tav(c) + t_lake(c,i)*dz_lake(c,i) + iceav(c) = iceav(c) + lake_icefrac(c,i)*dz_lake(c,i) + nav(c) = nav(c) + dz_lake(c,i) + if (use_lch4) then + jconvect(c) = j+1 + end if + end if + end do + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + + if ( (.not. lakepuddling .or. .not. puddle(c) ) .and. (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._r8 .and. lake_icefrac(c,j+1) > 0._r8) ) ) then + qav(c) = qav(c)/nav(c) + iceav(c) = iceav(c)/nav(c) + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + if (qav(c) > 0._r8) then + tav_froz(c) = 0._r8 !Celsius + tav_unfr(c) = qav(c) / ((1._r8 - iceav(c))*cwat) + else if (qav(c) < 0._r8) then + tav_froz(c) = qav(c) / (iceav(c)*cice_eff) + tav_unfr(c) = 0._r8 !Celsius + else + tav_froz(c) = 0._r8 + tav_unfr(c) = 0._r8 + end if + end if + end do + + do i = 1, j+1 + do fc = 1, num_lakec + c = filter_lakec(fc) + if (nav(c) > 0._r8) then + + !Put all the ice at the top.! + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + !For the layer with both ice & water, be careful to use the average temperature + !that preserves the correct total heat content given what the heat capacity of that + !layer will actually be. + if (i == 1) zsum(c) = 0._r8 + if ((zsum(c)+dz_lake(c,i))/nav(c) <= iceav(c)) then + lake_icefrac(c,i) = 1._r8 + t_lake(c,i) = tav_froz(c) + tfrz + else if (zsum(c)/nav(c) < iceav(c)) then + lake_icefrac(c,i) = (iceav(c)*nav(c) - zsum(c)) / dz_lake(c,i) + ! Find average value that preserves correct heat content. + t_lake(c,i) = ( lake_icefrac(c,i)*tav_froz(c)*cice_eff & + + (1._r8 - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & + / ( lake_icefrac(c,i)*cice_eff + (1-lake_icefrac(c,i))*cwat ) + tfrz + else + lake_icefrac(c,i) = 0._r8 + t_lake(c,i) = tav_unfr(c) + tfrz + end if + zsum(c) = zsum(c) + dz_lake(c,i) + + rhow(c,i) = (1._r8 - lake_icefrac(c,i)) * & + 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,i)-tdmax))**1.68_r8 ) & + + lake_icefrac(c,i)*denice + end if + end do + end do + end do + + ! Now check bottom layer + j = nlevlak-1 + do fc = 1, num_lakec + c = filter_lakec(fc) + + if ( (.not. lakepuddling .or. .not. puddle(c) ) .and. (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._r8 .and. lake_icefrac(c,j+1) > 0._r8) ) ) then + ! convection originating in bottom layer. Could be coming from sediments-- be careful not to + ! unnecessarily mix all the way to the top of the lake + bottomconvect(c) = .true. + end if + end do + + ! Start mixing from bottom up. Only mix as high as the unstable density profile persists. + do j = nlevlak-1, 1, -1 + do fc = 1, num_lakec + c = filter_lakec(fc) + qav(c) = 0._r8 + nav(c) = 0._r8 + iceav(c) = 0._r8 + end do + + do i = j, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + if ( bottomconvect(c) .and. & + (.not. lakepuddling .or. .not. puddle(c) ) .and. (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._r8 .and. lake_icefrac(c,j+1) > 0._r8) ) ) then + qav(c) = qav(c) + dz_lake(c,i)*(t_lake(c,i)-tfrz) * & + ((1._r8 - lake_icefrac(c,i))*cwat + lake_icefrac(c,i)*cice_eff) + !tav(c) = tav(c) + t_lake(c,i)*dz_lake(c,i) + iceav(c) = iceav(c) + lake_icefrac(c,i)*dz_lake(c,i) + nav(c) = nav(c) + dz_lake(c,i) + if (use_lch4) then + jconvectbot(c) = j + end if + end if + end do + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + + if ( bottomconvect(c) .and. & + (.not. lakepuddling .or. .not. puddle(c) ) .and. (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._r8 .and. lake_icefrac(c,j+1) > 0._r8) ) ) then + qav(c) = qav(c)/nav(c) + iceav(c) = iceav(c)/nav(c) + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + if (qav(c) > 0._r8) then + tav_froz(c) = 0._r8 !Celsius + tav_unfr(c) = qav(c) / ((1._r8 - iceav(c))*cwat) + else if (qav(c) < 0._r8) then + tav_froz(c) = qav(c) / (iceav(c)*cice_eff) + tav_unfr(c) = 0._r8 !Celsius + else + tav_froz(c) = 0._r8 + tav_unfr(c) = 0._r8 + end if + end if + end do + + do i = j, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + if (bottomconvect(c) .and. nav(c) > 0._r8) then + + !Put all the ice at the top.! + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + !For the layer with both ice & water, be careful to use the average temperature + !that preserves the correct total heat content given what the heat capacity of that + !layer will actually be. + + if (i == j) zsum(c) = 0._r8 + if ((zsum(c)+dz_lake(c,i))/nav(c) <= iceav(c)) then + lake_icefrac(c,i) = 1._r8 + t_lake(c,i) = tav_froz(c) + tfrz + else if (zsum(c)/nav(c) < iceav(c)) then + lake_icefrac(c,i) = (iceav(c)*nav(c) - zsum(c)) / dz_lake(c,i) + ! Find average value that preserves correct heat content. + t_lake(c,i) = ( lake_icefrac(c,i)*tav_froz(c)*cice_eff & + + (1._r8 - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & + / ( lake_icefrac(c,i)*cice_eff + (1-lake_icefrac(c,i))*cwat ) + tfrz + else + lake_icefrac(c,i) = 0._r8 + t_lake(c,i) = tav_unfr(c) + tfrz + end if + zsum(c) = zsum(c) + dz_lake(c,i) + + rhow(c,i) = (1._r8 - lake_icefrac(c,i)) * & + 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,i)-tdmax))**1.68_r8 ) & + + lake_icefrac(c,i)*denice + end if + end do + end do + end do + + ! Calculate lakeresist and grnd_ch4_cond for CH4 Module + ! The CH4 will diffuse directly from the top soil layer to the atmosphere, so + ! the whole lake resistance is included. + + if (use_lch4) then + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j > jconvect(c) .and. j < jconvectbot(c)) then ! Assume resistance is zero for levels that convect + lakeresist(c) = lakeresist(c) + dz(c,j)/kme(c,j) ! dz/eddy or molecular diffusivity + end if + + if (j == nlevlak) then ! Calculate grnd_ch4_cond + grnd_ch4_cond(c) = 1._r8 / (lakeresist(c) + lake_raw(c)) + + ! Lake water R + aerodynamic R + ! Snow will be considered in methane routine + ! No methane conduction through frozen lake + if (lake_icefrac(c,1) > 0.1_r8) grnd_ch4_cond(c) = 0._r8 + end if + + end do + end do + end if + + !!!!!!!!!!!!!!!!!!!!!!! + ! 11!) Re-evaluate thermal properties and sum energy content. + ! For lake + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._r8-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + end do + end do + + ! For snow / soil + call SoilThermProp_Lake(bounds, num_lakec, filter_lakec, & + tk(bounds%begc:bounds%endc, :), & + cv(bounds%begc:bounds%endc, :), & + tktopsoillay(bounds%begc:bounds%endc), & + soilstate_inst, waterstate_inst, temperature_inst) + + + ! Do as above to sum energy content + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + ncvts(c) = ncvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & + + cfus*dz_lake(c,j)*(1._r8-lake_icefrac(c,j)) + fin(c) = fin(c) + phi(c,j) + ! New for CLM 4 + hc_soisno(c) = hc_soisno(c) + cv_lake(c,j)*t_lake(c,j)/1.e6 + end do + end do + + do j = -nlevsno + 1, nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j >= jtop(c)) then + ncvts(c) = ncvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + + hfus*h2osoi_liq(c,j) + if (j < 1) fin(c) = fin(c) + phix(c,j) !For SNICAR + if (j == 1 .and. h2osno(c) > 0._r8 .and. j == jtop(c)) then + ncvts(c) = ncvts(c) - h2osno(c)*hfus + end if + hc_soisno(c) = hc_soisno(c) + cv(c,j)*t_soisno(c,j)/1.e6 + if (j >= 1) hc_soi(c) = hc_soi(c) + cv(c,j)*t_soisno(c,j)/1.e6 + end if + if (j == 1) fin(c) = fin(c) + phi_soil(c) + end do + end do + + + ! Check energy conservation. + do fp = 1, num_lakep + p = filter_lakep(fp) + c = patch%column(p) + errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) + if (abs(errsoi(c)) < 0.10_r8) then ! else send to Balance Check and abort + eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) + eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) + eflx_gnet(p) = eflx_gnet(p) + errsoi(c) + if (abs(errsoi(c)) > 1.e-3_r8) then + write(iulog,*)'errsoi incorporated into sensible heat in LakeTemperature: c, (W/m^2):', c, errsoi(c) + end if + errsoi(c) = 0._r8 + end if + + end do + ! This loop assumes only one point per column. + + ! lake_icethick diagnostic. + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + if (j == 1) lake_icethick(c) = 0._r8 + + lake_icethick(c) = lake_icethick(c) + lake_icefrac(c,j)*dz_lake(c,j)*denh2o/denice + ! Convert from nominal to physical thickness + end do + end do + + end associate + end subroutine LakeTemperature + + !----------------------------------------------------------------------- + subroutine SoilThermProp_Lake (bounds, num_lakec, filter_lakec, tk, cv, tktopsoillay, & + soilstate_inst, waterstate_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Calculation of thermal conductivities and heat capacities of + ! snow/soil layers + ! (1) The volumetric heat capacity is calculated as a linear combination + ! in terms of the volumetric fraction of the constituent phases. + ! + ! (2) The thermal conductivity of soil is computed from the algorithm of + ! Johansen (as reported by Farouki 1981), and of snow is from the + ! formulation used in SNTHERM (Jordan 1991). + ! The thermal conductivities at the interfaces between two neighboring + ! layers (j, j+1) are derived from an assumption that the flux across + ! the interface is equal to that from the node j to the interface and the + ! flux from the interface to the node j+1. + ! + ! For lakes, the proper soil layers (not snow) should always be saturated. + ! + ! !USES: + use clm_varcon , only : denh2o, denice, tfrz, tkwat, tkice, tkair + use clm_varcon , only : cpice, cpliq, thk_bedrock + use clm_varpar , only : nlevsno, nlevsoi, nlevgrnd + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_lakec ! number of column lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + real(r8) , intent(out) :: cv( bounds%begc: , -nlevsno+1: ) ! heat capacity [J/(m2 K)] [col, lev] + real(r8) , intent(out) :: tk( bounds%begc: , -nlevsno+1: ) ! thermal conductivity [W/(m K)] [col, lev] + real(r8) , intent(out) :: tktopsoillay( bounds%begc: ) ! thermal conductivity [W/(m K)] [col] + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + + ! + ! !LOCAL VARIABLES: + integer :: l,c,j ! indices + integer :: fc ! lake filtered column indices + real(r8) :: bw ! partial density of water (ice + liquid) + real(r8) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(r8) :: dke ! kersten number + real(r8) :: fl ! fraction of liquid or unfrozen water to total water + real(r8) :: satw ! relative total water content of soil. + real(r8) :: thk(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! thermal conductivity of layer + real(r8) :: xicevol ! (virtual excess ice volume per nominal soil volume) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(cv) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tktopsoillay) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl , & ! Input: [integer (:)] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:)] layer thickness (m) + zi => col%zi , & ! Input: [real(r8) (:,:)] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:)] layer depth (m) + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:)] volumetric soil water at saturation (porosity) + tksatu => soilstate_inst%tksatu_col , & ! Input: [real(r8) (:,:)] thermal conductivity, saturated soil [W/m-K] + tkmg => soilstate_inst%tkmg_col , & ! Input: [real(r8) (:,:)] thermal conductivity, soil minerals [W/m-K] + tkdry => soilstate_inst%tkdry_col , & ! Input: [real(r8) (:,:)] thermal conductivity, dry soil (W/m/Kelvin) + csol => soilstate_inst%csol_col , & ! Input: [real(r8) (:,:)] heat capacity, soil solids (J/m**3/Kelvin) + + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:)] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:)] ice lens (kg/m2) + + t_soisno => temperature_inst%t_soisno_col & ! Input: [real(r8) (:,:)] soil temperature (Kelvin) + ) + + ! Thermal conductivity of soil from Farouki (1981) + + do j = -nlevsno+1,nlevgrnd + do fc = 1, num_lakec + c = filter_lakec(fc) + + ! Only examine levels from 1->nlevsoi + if (j >= 1 .and. j <= nlevsoi) then + ! l = clandunit(c) + ! if (ityplun(l) /= istwet .AND. ityplun(l) /= istice) then + ! This could be altered later for allowing this to be over glaciers. + + ! Soil should be saturated in LakeHydrology + satw = 1._r8 + ! ZMS: Note the following needs to be updated for the corrections to be merged into SoilTemperature. + ! They are especially important here because of no supercooled water. + fl = h2osoi_liq(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j)) + if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil + dke = max(0._r8, log10(satw) + 1.0_r8) + dksat = tksatu(c,j) + else ! Frozen soil + dke = satw + dksat = tkmg(c,j)*0.249_r8**(fl*watsat(c,j))*2.29_r8**watsat(c,j) + endif + thk(c,j) = dke*dksat + (1._r8-dke)*tkdry(c,j) + satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j)) + ! Hydrology routine won't let the excess be liquid. + if (satw > 1._r8) then + xicevol = (satw-1._r8)*watsat(c,j) + thk(c,j) = (thk(c,j) + xicevol*tkice)/(1._r8 + xicevol)/(1._r8 + xicevol) + ! Use simple mean because excess ice is likely to be in chunks, thus conductivities add + ! rather than the usual addition of resistances. + ! Conductivity is reduced by the extra virtual volume fraction, as dz is not changing. + end if + ! See discussion in LakeHydrology. This is the simplest way to treat thermal cycling near + ! freezing even if not modeling excess ice, to assume up to 10% excess ice over watsat after refreezing. + ! Assume some ground heaving rather than drainage of the water while it's freezing. + ! This allows for energy conservation and for the final allowed ice volume to be independent + ! of the timestep or precise freezing trajectory. + ! Does real sediment under lakes heave or drain? Could revisit later. + elseif (j > nlevsoi) then + thk(c,j) = thk_bedrock + endif + + ! Thermal conductivity of snow, which from Jordan (1991) pp. 18 + ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 + if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then + bw = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dz(c,j) + thk(c,j) = tkair + (7.75e-5_r8 *bw + 1.105e-6_r8*bw*bw)*(tkice-tkair) + end if + + end do + end do + + ! Thermal conductivity at the layer interface + + ! Have to correct for the fact that bottom snow layer and top soil layer border lake. + ! For the first case, the snow layer conductivity for the middle of the layer will be returned. + ! Because the interfaces are below the soil layers, the conductivity for the top soil layer + ! will have to be returned separately. + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + if (j >= snl(c)+1 .AND. j <= nlevgrnd-1 .AND. j /= 0) then + tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) & + /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j))) + else if (j == 0 .and. j >= snl(c)+1) then + tk(c,j) = thk(c,j) + else if (j == nlevgrnd) then + tk(c,j) = 0._r8 + end if + ! For top soil layer. + if (j == 1) tktopsoillay(c) = thk(c,j) + end do + end do + + ! Soil heat capacity, from de Vires (1963) + + do j = 1, nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + cv(c,j) = csol(c,j)*(1-watsat(c,j))*dz(c,j) + & + (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + ! if (j == 1) then + ! if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8) then + ! cv(c,j) = cv(c,j) + cpice*h2osno(c) + ! end if + ! end if + ! Won't worry about heat capacity for thin snow on lake with no snow layers. + ! Its temperature will be assigned based on air temperature anyway if a new node is formed. + enddo + end do + + ! Snow heat capacity + + do j = -nlevsno+1,0 + do fc = 1,num_lakec + c = filter_lakec(fc) + if (snl(c)+1 < 1 .and. j >= snl(c)+1) then + cv(c,j) = cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j) + end if + end do + end do + + end associate + + end subroutine SoilThermProp_Lake + + !----------------------------------------------------------------------- + subroutine PhaseChange_Lake (bounds, num_lakec, filter_lakec, cv, cv_lake, lhabs, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst, lakestate_inst) + ! + ! !DESCRIPTION: + ! Calculation of the phase change within snow, soil, & lake layers: + ! (1) Check the conditions for which the phase change may take place, + ! i.e., the layer temperature is great than the freezing point + ! and the ice mass is not equal to zero (i.e. melting), + ! or the layer temperature is less than the freezing point + ! and the liquid water mass is greater than zero (i.e. melting). No supercooling. + ! (2) Assess the amount of phase change from the energy excess (or deficit) + ! after setting the layer temperature to freezing point, depending on + ! how much water or ice is available. + ! (3) Re-adjust the ice and liquid mass, and the layer temperature: either to + ! the freezing point if enough water or ice is available to fully compensate, + ! or to a remaining temperature. + ! The specific heats are adjusted during phase change for precise energy conservation. + ! Errors will be trapped at the end of LakeTemperature. + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varcon , only : tfrz, hfus, denh2o, denice, cpliq, cpice + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_lakec ! number of lake columns + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + real(r8) , intent(inout) :: cv( bounds%begc: , -nlevsno+1: ) ! heat capacity [J/(m2 K)] [col, lev] + real(r8) , intent(inout) :: cv_lake( bounds%begc: , 1: ) ! heat capacity [J/(m2 K)] [col, levlak] + real(r8) , intent(out) :: lhabs( bounds%begc: ) ! total per-column latent heat abs. (J/m^2) [col] + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(lakestate_type) , intent(inout) :: lakestate_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,g ! do loop index + integer :: fc ! lake filtered column indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: heatavail ! available energy for melting or freezing (J/m^2) + real(r8) :: heatrem ! energy residual or loss after melting or freezing + real(r8) :: melt ! actual melting (+) or freezing (-) [kg/m2] + !real(r8), parameter :: smallnumber = 1.e-7_r8 ! to prevent tiny residuals from rounding error + real(r8), parameter :: smallnumber = 1.e-12_r8 ! The above actually was enough to cause a 0.1 W/m^2 energy imbalance + ! when the bottom lake layer started freezing in a 50m Arctic lake + logical :: dophasechangeflag + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(cv) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(cv_lake) == (/bounds%endc, nlevlak/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lhabs) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + dz_lake => col%dz_lake , & ! Input: [real(r8) (:,:) ] lake layer thickness (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + snow_depth => waterstate_inst%snow_depth_col , & ! Output: [real(r8) (:) ] snow height (m) + h2osno => waterstate_inst%h2osno_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen + + qflx_snofrz_lyr => waterflux_inst%qflx_snofrz_lyr_col , & ! Input: [real(r8) (:,:) ] snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Output: [real(r8) (:) ] drainage from snow column + qflx_snomelt => waterflux_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) + qflx_snofrz_col => waterflux_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (kg m-2 s-1) [+] + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_lake => temperature_inst%t_lake_col , & ! Input: [real(r8) (:,:) ] lake temperature (Kelvin) + imelt => temperature_inst%imelt_col , & ! Output: [integer (:,:) ] flag for melting (=1), freezing (=2), Not=0 (new) + + eflx_snomelt => energyflux_inst%eflx_snomelt_col & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) + ) + + ! Get step size + + dtime = get_step_size() + + ! Initialization + + do fc = 1,num_lakec + c = filter_lakec(fc) + + qflx_snomelt(c) = 0._r8 + eflx_snomelt(c) = 0._r8 + lhabs(c) = 0._r8 + qflx_snow_drain(c) = 0._r8 + end do + + do j = -nlevsno+1,0 + do fc = 1,num_lakec + c = filter_lakec(fc) + + qflx_snofrz_lyr(c,j) = 0._r8 + ! Do for all possible snow layers in case snl changes over timestep. ! Bug corrected ZMS 10/14/11 + imelt(c,j) = 0 + end do + end do + + ! Check for case of snow without snow layers and top lake layer temp above freezing. + + do fc = 1,num_lakec + c = filter_lakec(fc) + + if (snl(c) == 0 .and. h2osno(c) > 0._r8 .and. t_lake(c,1) > tfrz) then + heatavail = (t_lake(c,1) - tfrz) * cv_lake(c,1) + melt = min(h2osno(c), heatavail/hfus) + heatrem = max(heatavail - melt*hfus, 0._r8) + !catch small negative value to keep t at tfrz + t_lake(c,1) = tfrz + heatrem/(cv_lake(c,1)) + snow_depth(c) = snow_depth(c)*(1._r8 - melt/h2osno(c)) + h2osno(c) = h2osno(c) - melt + lhabs(c) = lhabs(c) + melt*hfus + qflx_snomelt(c) = qflx_snomelt(c) + melt/dtime + qflx_snow_drain(c) = qflx_snow_drain(c) + melt/dtime + ! Prevent tiny residuals + if (h2osno(c) < smallnumber) h2osno(c) = 0._r8 + if (snow_depth(c) < smallnumber) snow_depth(c) = 0._r8 + end if + end do + + ! Lake phase change + + do j = 1,nlevlak + do fc = 1,num_lakec + c = filter_lakec(fc) + + dophasechangeflag = .false. + if (t_lake(c,j) > tfrz .and. lake_icefrac(c,j) > 0._r8) then ! melting + dophasechangeflag = .true. + heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) + melt = min(lake_icefrac(c,j)*denh2o*dz_lake(c,j), heatavail/hfus) + !denh2o is used because layer thickness is not adjusted for freezing + heatrem = max(heatavail - melt*hfus, 0._r8) + !catch small negative value to keep t at tfrz + else if (t_lake(c,j) < tfrz .and. lake_icefrac(c,j) < 1._r8) then !freezing + dophasechangeflag = .true. + heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) + melt = max(-(1._r8-lake_icefrac(c,j))*denh2o*dz_lake(c,j), heatavail/hfus) + !denh2o is used because layer thickness is not adjusted for freezing + heatrem = min(heatavail - melt*hfus, 0._r8) + !catch small positive value to keep t at tfrz + end if + ! Update temperature and ice fraction. + if (dophasechangeflag) then + lake_icefrac(c,j) = lake_icefrac(c,j) - melt/(denh2o*dz_lake(c,j)) + lhabs(c) = lhabs(c) + melt*hfus + ! Update heat capacity + cv_lake(c,j) = cv_lake(c,j) + melt*(cpliq-cpice) + t_lake(c,j) = tfrz + heatrem/cv_lake(c,j) + ! Prevent tiny residuals + if (lake_icefrac(c,j) > 1._r8 - smallnumber) lake_icefrac(c,j) = 1._r8 + if (lake_icefrac(c,j) < smallnumber) lake_icefrac(c,j) = 0._r8 + end if + end do + end do + + ! Snow & soil phase change + ! Currently, does not do freezing point depression. + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_lakec + c = filter_lakec(fc) + dophasechangeflag = .false. + + if (j >= snl(c) + 1) then + + if (t_soisno(c,j) > tfrz .and. h2osoi_ice(c,j) > 0._r8) then ! melting + dophasechangeflag = .true. + heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) + melt = min(h2osoi_ice(c,j), heatavail/hfus) + heatrem = max(heatavail - melt*hfus, 0._r8) + !catch small negative value to keep t at tfrz + if (j <= 0) then !snow + imelt(c,j) = 1 + qflx_snomelt(c) = qflx_snomelt(c) + melt/dtime + end if + else if (t_soisno(c,j) < tfrz .and. h2osoi_liq(c,j) > 0._r8) then !freezing + dophasechangeflag = .true. + heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) + melt = max(-h2osoi_liq(c,j), heatavail/hfus) + heatrem = min(heatavail - melt*hfus, 0._r8) + !catch small positive value to keep t at tfrz + if (j <= 0) then !snow + imelt(c,j) = 2 + !qflx_snomelt(c) = qflx_snomelt(c) + melt + ! Does this works for both signs of melt in SnowHydrology? I think + ! qflx_snomelt(c) is just output. + ! It looks like qflx_snomelt is just supposed to be positive. + ! New variable for CLM 4 + qflx_snofrz_lyr(c,j) = -melt/dtime + end if + end if + + ! Update temperature and soil components. + if (dophasechangeflag) then + h2osoi_ice(c,j) = h2osoi_ice(c,j) - melt + h2osoi_liq(c,j) = h2osoi_liq(c,j) + melt + lhabs(c) = lhabs(c) + melt*hfus + ! Update heat capacity + cv(c,j) = cv(c,j) + melt*(cpliq-cpice) + t_soisno(c,j) = tfrz + heatrem/cv(c,j) + ! Prevent tiny residuals + if (h2osoi_ice(c,j) < smallnumber) h2osoi_ice(c,j) = 0._r8 + if (h2osoi_liq(c,j) < smallnumber) h2osoi_liq(c,j) = 0._r8 + end if + + end if + end do + end do + + ! Update eflx_snomelt(c) + do fc = 1,num_lakec + c = filter_lakec(fc) + eflx_snomelt(c) = qflx_snomelt(c)*hfus + end do + do j = -nlevsno+1,0 + do fc = 1,num_lakec + c = filter_lakec(fc) + qflx_snofrz_col(c) = qflx_snofrz_col(c) + qflx_snofrz_lyr(c,j) + end do + end do + + end associate + + end subroutine PhaseChange_Lake + + end module LakeTemperatureMod + diff --git a/components/clm/src/biogeophys/LunaMod.F90 b/components/clm/src/biogeophys/LunaMod.F90 new file mode 100644 index 0000000000..904d6b573d --- /dev/null +++ b/components/clm/src/biogeophys/LunaMod.F90 @@ -0,0 +1,1259 @@ +module LunaMod + +#include "shr_assert.h" + + !********************************************************************************************************************************************************************** + ! !DESCRIPTION: + ! Calculates the photosynthetic capacities based on a prescribed leaf nitrogen content, using the LUNA model, developed by Chonggang Xu, Ashehad Ali and Rosie Fisher + ! Currently only works for C3 plants. See Xu et al 2012; Ali et al 2015a. Ecological Applications. http://dx.doi.org/10.1890/14-2111.1. and Ali et al 2015b.In Review. + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : rgas, tfrz,spval + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varcon , only : namep + use clm_varpar , only : nlevcan + use decompMod , only : bounds_type + use pftconMod , only : pftcon + use FrictionvelocityMod , only : frictionvel_type + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use TemperatureType , only : temperature_type + use PatchType , only : patch + use GridcellType , only : grc + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use WaterstateType , only : waterstate_type + !use EDPhotosynthesisMod , only : vcmaxc, jmaxc + + + implicit none + save + + !------------------------------------------------------------------------------ + ! PRIVATE MEMBER FUNCTIONS: + public :: Update_Photosynthesis_Capacity !subroutine to update the canopy nitrogen profile + public :: NitrogenAllocation !subroutine to update the Vcmax25 and Jmax25 at the leaf level + public :: Acc24_Climate_LUNA !subroutine to accumulate 24 hr climates + public :: Acc240_Climate_LUNA !subroutine to accumulate 10 day climates + public :: Clear24_Climate_LUNA !subroutine to clear 24 hr climates + private :: NUEref !Calculate the Nitrogen use effieciency based on reference CO2 and leaf temperature + private :: NUE !Calculate the Nitrogen use effieciency based on current CO2 and leaf temperature + private :: JmxTLeuning !Calculate the temperature response for Jmax, based on Leunning 2002 Plant, Cell & Environment + private :: JmxTKattge !Calculate the temperature response for Jmax, based on Kattge and Knorr 2007 + private :: VcmxTLeuning !Calculate the temperature response for Vcmax, based on Leunning 2002 Plant, Cell & Environment + private :: VcmxTKattge !Calculate the temperature response for Vcmax, based on Kattge and Knorr 2007 + private :: RespTBernacchi !Calculate the temperature response for respiration, following Bernacchi PCE 2001 + private :: Photosynthesis_luna !calculate the photosynthetic rate for nitrogen allocation + private :: Quadratic !Calculate the soultion using the quadratic formula + + !------------------------------------------------------------------------------ + !Constants + real(r8), parameter :: Cv = 1.2e-5_r8 * 3600.0 ! conversion factor from umol CO2 to g carbon + real(r8), parameter :: Kc25 = 40.49_r8 ! Mechanis constant of CO2 for rubisco(Pa), Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + real(r8), parameter :: Ko25 = 27840_r8 ! Mechanis constant of O2 for rubisco(Pa), Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + real(r8), parameter :: Cp25 = 4.275_r8 ! CO2 compensation point at 25C (Pa), Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + real(r8), parameter :: Fc25 = 294.2_r8 ! Fc25 = 6.22*47.3 #see Rogers (2014) Photosynthesis Research + real(r8), parameter :: Fj25 = 1257.0_r8 ! Fj25 = 8.06*156 # #see COSTE 2005 and Xu et al 2012 + real(r8), parameter :: NUEr25 = 33.69_r8 ! nitrogen use efficiency for respiration, see Xu et al 2012 + real(r8), parameter :: Cb = 1.78_r8 ! nitrogen use effiency for choloraphyll for light capture, see Evans 1989 + real(r8), parameter :: O2ref = 209460.0_r8 ! ppm of O2 in the air + real(r8), parameter :: CO2ref = 380.0_r8 ! reference CO2 concentration for calculation of reference NUE. + real(r8), parameter :: forc_pbot_ref = 101325.0_r8 ! reference air pressure for calculation of reference NUE + real(r8), parameter :: Q10Enz = 2.0_r8 ! Q10 value for enzyme decay rate + real(r8), parameter :: Jmaxb0 = 0.0311_r8 ! the baseline proportion of nitrogen allocated for electron transport (J) + real(r8), parameter :: Jmaxb1 = 0.1745_r8 ! the baseline proportion of nitrogen allocated for electron transport (J) + real(r8), parameter :: Wc2Wjb0 = 0.8054_r8 ! the baseline ratio of rubisco limited rate vs light limited photosynthetic rate (Wc:Wj) + real(r8), parameter :: relhExp = 6.0999_r8 ! electron transport parameters related to relative humidity + real(r8), parameter :: Enzyme_turnover_daily = 0.1_r8 ! the daily turnover rate for photosynthetic enzyme at 25oC in view of ~7 days of half-life time for Rubisco (Suzuki et al. 2001) + real(r8), parameter :: NMCp25 = 0.715_r8 ! estimated by assuming 80% maintenance respiration is used for photosynthesis enzyme maintenance + real(r8), parameter :: Trange1 = 5.0_r8 ! lower temperature limit (oC) for nitrogen optimization + real(r8), parameter :: Trange2 = 42.0_r8 ! upper temperature limit (oC) for nitrogen optimization + real(r8), parameter :: SNC = 0.004_r8 ! structural nitrogen concentration (g N g-1 dry mass carbon) + real(r8), parameter :: mp = 9.0_r8 ! slope of stomatal conductance; this is used to estimate model parameter, but may need to be updated from the physiology file, + real(r8), parameter :: PARLowLim = 200.0_r8 ! minimum photosynthetically active radiation for nitrogen optimization + real(r8), parameter :: minrelh = 0.25_r8 ! minimum relative humdity for nitrogen optimization + !------------------------------------------------------------------------------ + + contains + + !********************************************************************************************************************************************************************** + ! this subroutine updates the photosynthetic capacity as determined by Vcmax25 and Jmax25 + subroutine Update_Photosynthesis_Capacity(bounds, fn, filterp, & + dayl_factor, atm2lnd_inst, temperature_inst, canopystate_inst, photosyns_inst, & + surfalb_inst, solarabs_inst, waterstate_inst, frictionvel_inst) + ! + ! !DESCRIPTION: + ! Calculates Nitrogen fractionation within the leaf, based on optimum calculated fractions in rubisco, cholorophyll, + ! Respiration and Storage. Based on Xu et al. 2012 and Ali et al 2015.In Review + + ! + ! !REVISION HISTORY: + ! version 1.0, by Chonggang Xu, Ashehad Ali and Rosie Fisher. July 14 2015. + ! version 0.1, by Chonggang Xu, Ashehad Ali and Rosie Fisher. October 30 2014. + + ! CALLED FROM: + ! subroutine CanopyFluxes + + ! !USES: + use clm_time_manager , only : get_step_size, is_end_curr_day + use clm_varpar , only : nlevcan_ed, nclmax, nlevsoi, mxpft + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : use_cn + use quadraticMod , only : quadratic + use CNSharedParamsMod , only : CNParamsShareInst + use shr_infnan_mod, only : isnan => shr_infnan_isnan + + implicit none + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength + + + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + + + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit in variables + + integer :: c,CL,f,g,iv,j,p,ps ! indices + integer :: NCL_p ! number of canopy layers in patch + integer :: ft ! plant functional type + integer :: z ! the index across leaf layers + real (r8) :: PNstoreopt,PNlcopt,PNetopt,PNrespopt,PNcbopt ! the optimal nitrogen allocations + real (r8) :: PNstoreold,PNlcold,PNetold,PNrespold,PNcbold ! the previous time step nitrogen allocations + real (r8) :: delta_fn ! daily change in nitrogen investiment + real (r8) :: relCLNCa ! the relative factor for LNCa due to canopy location and seasonal growth + real (r8) :: relSLNCa ! the relative factor for LNCa due to seasonal growth + real (r8) :: relRad ! the realtive radiation to the top of the canopy + real (r8) :: FNCmtar ! target functional nitrogen content (g N/g leaf c) + real (r8) :: LMA ! leaf mass per unit area (g leaf c/m2 leaf) + real (r8) :: PARTop ! photosynthetic active radiation on the top of canopy (umol/m2/s) + real (r8) :: RadTop ! short-wave radiation on the top of canopy (w/m2) + real (r8) :: TRad ! total short-wave radiation on the top of canopy (w/m2) + real (r8) :: PARi10 ! 10-day mean photosynthetic active radiation on in the canopy (umol/m2/s) + real (r8) :: PARimx10 ! 10-day mean maximum photosynthetic active radiation on in the canopy (umol/m2/s) + real (r8) :: tleaf10 ! 10-day mean leaf temperature (oC) + real (r8) :: tleafd10 ! 10-day mean daytime leaf temperature (oC) + real (r8) :: tleafn10 ! 10-day mean nighttime leaf temperature (oC) + real (r8) :: hourpd ! hours per day (hours) + real (r8) :: CO2a10 ! 10-day mean air co2 concentration (pa) + real (r8) :: O2a10 ! 10-day mean air o2 concentration (pa) + real (r8) :: max_daily_pchg ! maximum daily percentrage change for nitrogen allocation + real (r8) :: max_daily_decay ! maximum daily decay for nitrogen allocation + real (r8) :: radk ! light extintion factor + real (r8) :: FNCa ! leaf functional nitrogen content (g/m2) + real (r8) :: FNCa_z(1:nlevcan) ! profile of leaf functional nitrogen content (g/m2) + real (r8) :: fnps ! fraction of light absorbed by non-photosynthetic pigments + real (r8) :: radmax2mean ! ratio of max radiation to mean + real (r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) + real (r8) :: EnzTurnoverTFactor ! temperature adjust factor for enzyme decay + real (r8) :: vcmax25 ! Predicted vcmax25 from EDN model umol CO2/m**2/s + real (r8) :: jmax25 ! Predicted jmax25 from EDN model umol electrons/m**2/s + real (r8) :: dtime ! stepsize in seconds + real (r8) :: rb10v ! 10-day mean boundary layer resistance + real (r8) :: relh10 ! 10-day mean relative humidity (unitless) + real (r8) :: tair10 ! 10-day running mean of the 2m temperature (oC) + real (r8) :: rabsorb ! ratio of absorbed raditation to the total incident radiation + real (r8) :: tlaii ! total leaf area index for a certain canopy layer + real (r8) :: SNCa ! structural leaf nitrogen content (g N/m2 leaf) + real (r8) :: vcmx25_opt ! optimal Vc,max25 (umol CO2/m**2/s) + real (r8) :: jmx25_opt ! optimal Jmax25 (umol electron/m**2/s) + real (r8) :: chg ! change in Vcmax25 or Jmax25 + real (r8) :: chg_constrn ! constrained change in Vcmax25 or Jmax25 + logical :: is_end_day ! is end of current day + !------------------------------------------------------------------------------------------------------------------------------------------------- + associate( & + c3psn => pftcon%c3psn , & ! photosynthetic pathway: 0. = c4, 1. = c3 + slatop => pftcon%slatop , & ! specific leaf area at top of canopy, projected area basis [m^2/gC] + leafcn => pftcon%leafcn , & ! leaf C:N (gC/gN) + forc_pbot10 => atm2lnd_inst%forc_pbot240_downscaled_patch , & ! Input: [real(r8) (:) ] 10 day mean atmospheric pressure(Pa) + CO2_p240 => atm2lnd_inst%forc_pco2_240_patch , & ! Input: [real(r8) (:) ] 10-day mean CO2 partial pressure (Pa) + O2_p240 => atm2lnd_inst%forc_po2_240_patch , & ! Input: [real(r8) (:) ] 10-day mean O2 partial pressure (Pa) + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index + dayl => grc%dayl , & ! Input: [real(r8) (:) ] daylength (s) + sabv => solarabs_inst%sabv_patch , & ! Input: [real(r8) (:) ] patch solar radiation absorbed by vegetation (W/m**2) + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + rhol => pftcon%rhol , & ! Input: [real(r8) (:) ] leaf reflectance: 1=vis, 2=nir + taul => pftcon%taul , & ! Input: [real(r8) (:) ] leaf transmittance: 1=vis, 2=nir + par240d_z => solarabs_inst%par240d_z_patch , & ! Input: [real(r8) (:,:) ] 10-day running mean of daytime patch absorbed PAR for leaves in canopy layer (W/m**2) + par24d_z => solarabs_inst%par24d_z_patch , & ! Input: [real(r8) (:,:) ] daily accumulated absorbed PAR for leaves in canopy layer (W/m**2) + par240x_z => solarabs_inst%par240x_z_patch , & ! Input: [real(r8) (:,:) ] 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2) + par24x_z => solarabs_inst%par24x_z_patch , & ! Input: [real(r8) (:,:) ] daily maximum of patch absorbed PAR for leaves in canopy layer (W/m**2) + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + lnc => photosyns_inst%lnca_patch , & ! Input: [real(r8) (:) ] top leaf layer leaf N concentration (gN leaf/m^2) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + t_veg_day => temperature_inst%t_veg_day_patch , & ! Input: [real(r8) (:) ] daytime mean vegetation temperature (Kelvin) + t_veg_night => temperature_inst%t_veg_night_patch , & ! Input: [real(r8) (:) ] nighttime mean vegetation temperature (Kelvin) + t_veg10_day => temperature_inst%t_veg10_day_patch , & ! Input: [real(r8) (:) ] 10-day mean daytime vegetation temperature (Kelvin) + t_veg10_night => temperature_inst%t_veg10_night_patch , & ! Input: [real(r8) (:) ] 10-day mean nighttime vegetation temperature (Kelvin) + rh10_p => waterstate_inst%rh10_af_patch , & ! Input: [real(r8) (:) ] 10-day mean canopy air relative humidity at the pacth (unitless) + rb10_p => frictionvel_inst%rb10_patch , & ! Input: [real(r8) (:) ] 10-day mean boundary layer resistance at the pacth (s/m) + gpp_day => photosyns_inst%fpsn24_patch , & ! Input: [real(r8) (:) ] patch 24 hours mean gpp(umol CO2/m**2 ground/day) for canopy layer + vcmx25_z => photosyns_inst%vcmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Vc,max25 (umol/m2 leaf/s) for canopy layer + jmx25_z => photosyns_inst%jmx25_z_patch , & ! Output: [real(r8) (:,:) ] patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + pnlc_z => photosyns_inst%pnlc_z_patch , & ! Output: [real(r8) (:,:) ] patch proportion of leaf nitrogen allocated for light capture for canopy layer + enzs_z => photosyns_inst%enzs_z_patch & ! Output: [real(r8) (:,:) ] enzyme decay status 1.0-fully active; 0-all decayed during stress + ) + !---------------------------------------------------------------------------------------------------------------------------------------------------------- + !set timestep + + !Initialize enzyme decay Q10 + dtime = get_step_size() + + is_end_day = is_end_curr_day() + fnps = 0.15_r8 + call t_startf('LUNA') + do f = 1,fn + p = filterp(f) + ft = patch%itype(p) + g = patch%gridcell(p) + c = patch%column(p) + !---------------------------------------------------- + !store the daily mean climate conditions + if(t_veg_day(p).ne.spval) then !check whether it is the first day + !------------------------------------------ + !get the climate driver + CO2a10 = CO2_p240(p) + O2a10 = O2_p240(p) + hourpd = dayl(g) / 3600._r8 + tleafd10 = t_veg10_day(p) - tfrz + tleafn10 = t_veg10_night(p) - tfrz + tleaf10 = (dayl(g)*tleafd10 +(86400._r8-dayl(g)) * tleafd10)/86400._r8 + tair10 = t10(p)- tfrz + relh10 = min(1.0_r8, rh10_p(p)) + rb10v = rb10_p(p) + !-------------------------------------------------------------------- + !calculate the enzyme ternover rate + EnzTurnoverTFactor = Q10Enz**(0.1_r8*(min(40.0_r8, tleaf10) - 25.0_r8)) + max_daily_pchg = EnzTurnoverTFactor * Enzyme_turnover_daily + !----------------------------------------------------------------- + rabsorb = 1.0_r8-rhol(ft,1)-taul(ft,1) + !Implemented the nitrogen allocation model + if(tlai(p) > 0.0)then + RadTop = par240d_z(p,1)/rabsorb + PARTop = RadTop*4.6 !conversion from w/m2 to umol/m2/s. PAR is still in umol photons, not electrons. Also the par240d_z is only for radiation at visible range. Hence 4.6 not 2.3 multiplier. + !------------------------------------------------------------- + !the nitrogen allocation model, may need to be feed from the parameter file in CLM + if (nint(c3psn(ft)) == 1)then + if(gpp_day(p)>0.0 )then !only optimize if there is growth and it is C3 plants + !------------------------------------------------------------- + do z = 1, nrad(p) + if(tlai_z(p,z)>0.0_r8)then + qabs = par240d_z(p,z)/rabsorb + PARi10 = qabs * 4.6_r8 + else + PARi10 = 0.0_r8 + endif + !----------------------------------------------------------------------- + relRad = PARi10/PARTop + relCLNCa = 0.1802_r8*log(relRad)+1.0_r8 !see Ali et al 2015. + relCLNCa = max(0.2_r8,relCLNCa) + relCLNCa = min(1.0_r8,relCLNCa) + relSLNCa = 1.0_r8 + !------------------------------------------------------------------ + SNCa = 1.0_r8/slatop(ft) * SNC + if(0.9_r8 * lnc(p)> SNCa)then + FNCa_z(z)= relCLNCa*(lnc(p)-SNCa) + else + FNCa_z(z)= relCLNCa*0.1_r8*lnc(p) + endif + enddo + + !---------------------------------------------------------------------- + !nitrogen allocation model + do z = 1 , nrad(p) + + !------------------------------------------------------------------------------------------- + !for sun lit leaves + FNCa = FNCa_z(z) + radmax2mean = par240x_z(p,z) / par240d_z(p,z) + if(tlai_z(p,z)>0.0_r8)then + qabs = par240d_z(p,z)/rabsorb + PARi10 = qabs * 4.6_r8 + else + PARi10 = 0.0_r8 + endif + PARimx10 = PARi10*radmax2mean + !----------------------------------------------------------------------------------------------------- + !nitrogen allocastion model-start + PNlcold = PNlc_z(p,z) + PNetold = 0.0_r8 + PNrespold = 0.0_r8 + PNcbold = 0.0_r8 + call NitrogenAllocation(FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, hourpd, & + tair10, tleafd10, tleafn10, & + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp, PNstoreold, PNlcold, PNetold, PNrespold, & + PNcbold, PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + vcmx25_opt= PNcbopt * FNCa * Fc25 + jmx25_opt= PNetopt * FNCa * Fj25 + + chg = vcmx25_opt-vcmx25_z(p, z) + chg_constrn = min(abs(chg),vcmx25_z(p, z)*max_daily_pchg) + vcmx25_z(p, z) = vcmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn + + chg = jmx25_opt-jmx25_z(p, z) + chg_constrn = min(abs(chg),jmx25_z(p, z)*max_daily_pchg) + jmx25_z(p, z) = jmx25_z(p, z)+sign(1.0_r8,chg)*chg_constrn + + PNlc_z(p, z)= PNlcopt + + if(enzs_z(p,z)<1.0) then + enzs_z(p,z) = enzs_z(p,z)* (1.0_r8 + max_daily_pchg) + endif + !nitrogen allocastion model-end + !----------------------------------------------------------------------------------------------------- + if(isnan(vcmx25_z(p, z)).or. vcmx25_z(p, z)>1000._r8 .or. vcmx25_z(p, z)<0._r8)then + write(iulog, *) 'Error: Vc,mx25 become unrealistic (NaN,>1000, or negative) for patch=', p, 'z=', z + write(iulog, *) 'LUNA env:',FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, & + hourpd, tair10, tleafd10, tleafn10 + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + if(isnan(jmx25_z(p, z)).or.jmx25_z(p, z)>1000._r8 .or. jmx25_z(p, z)<0._r8)then + write(iulog, *) 'Error: Jmx25 become unrealistic (NaN,>1000, or negative)for patch=', p, 'z=', z + write(iulog, *) 'LUNA env:', FNCa,forc_pbot10(p), relh10, CO2a10, O2a10, PARi10, PARimx10, rb10v, & + hourpd, tair10, tleafd10, tleafn10 + call endrun(msg=errmsg(__FILE__, __LINE__)) + + endif + enddo ! finished loop of leaf layers + else !decay during drought or winter + max_daily_decay = min(0.5_r8, 0.1_r8 * max_daily_pchg)!assume enzyme turnover under maintenance is 10 times lower than enzyme change under growth + do z = 1 , nrad(p) + if(enzs_z(p,z)>0.5_r8) then !decay is set at only 50% of original enzyme in view that plant will need to maintain their basic functionality + enzs_z(p,z) = enzs_z(p,z)* (1.0_r8 - max_daily_decay) + jmx25_z(p, z) = jmx25_z(p, z)* (1.0_r8 - max_daily_decay) + vcmx25_z(p, z) = vcmx25_z(p, z)* (1.0_r8 - max_daily_decay) + endif + end do + endif !checking for growth + endif !checking for LAI + endif !if not C3 plants + endif !the first daycheck + end do !fn loop + call t_stopf('LUNA') + end associate + +end subroutine Update_Photosynthesis_Capacity + + + +subroutine Acc240_Climate_LUNA(bounds, fn, filterp, oair, cair, & + rb,rh, temperature_inst, photosyns_inst, & + surfalb_inst, solarabs_inst, waterstate_inst, frictionvel_inst) + ! + ! !DESCRIPTION: + ! Accumulate the 10-day running mean climates for LUNA model + + ! + ! !REVISION HISTORY: + ! version 1.0, by Chonggang Xu July 14 2015. + + ! CALLED FROM: + ! subroutine CanopyFluxes + + ! !USES: + use clm_time_manager , only : get_step_size, is_end_curr_day + implicit none + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) + real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) + real(r8) , intent(in) :: rh( bounds%begp: ) ! canopy air relative humidity + + type(temperature_type) , intent(inout) :: temperature_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit in variables + + integer :: c,f,g,iv,j,p ! indices + integer :: ft ! plant functional type + integer :: z ! the index across leaf layers + real (r8) :: dtime ! stepsize in seconds + real (r8) :: TRad ! total short-wave radiation on the top of canopy (w/m2) + real (r8) :: tlaii ! total leaf area index for a certain canopy layer + real (r8) :: t_veg_dayi ! daytime mean vegetation temperature (Kelvin) + real (r8) :: t_veg_nighti ! nighttime mean vegetation temperature (Kelvin) + real (r8) :: par24d_z_i(1:nlevcan) ! daytime mean radiation (w/m**2) + logical :: is_end_day ! is end of current day + !------------------------------------------------------------------------------------------------------------------------------------------------- + associate( & + par24d_z => solarabs_inst%par24d_z_patch , & ! Input: [real(r8) (:,:) ] daily accumulated absorbed PAR for leaves in canopy layer (W/m**2) + par24x_z => solarabs_inst%par24x_z_patch , & ! Input: [real(r8) (:,:) ] daily maximum of patch absorbed PAR for leaves in canopy layer (W/m**2) + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + t_veg_day => temperature_inst%t_veg_day_patch , & ! Input: [real(r8) (:) ] daytime accumulative vegetation temperature (Kelvin*nsteps) + t_veg_night => temperature_inst%t_veg_night_patch , & ! Input: [real(r8) (:) ] nighttime accumulative vegetation temperature (Kelvin*nsteps) + nnightsteps => temperature_inst%nnightsteps_patch , & ! Input: [integer (:) ] number of nighttime steps in 24 hours from mid-night, LUNA specific + ndaysteps => temperature_inst%ndaysteps_patch , & ! Input: [integer (:) ] number of daytime steps in 24 hours from mid-night, LUNA specific + t_veg10_day => temperature_inst%t_veg10_day_patch , & ! Output: [real(r8) (:) ] 10-day mean vegetation temperature (Kelvin) + t_veg10_night => temperature_inst%t_veg10_night_patch , & ! Output: [real(r8) (:) ] 10-day mean vegetation temperature (Kelvin) + rh10_p => waterstate_inst%rh10_af_patch , & ! Output: [real(r8) (:) ] 10-day mean canopy air relative humidity at the pacth (s/m) + rb10_p => frictionvel_inst%rb10_patch , & ! Output: [real(r8) (:) ] 10-day mean boundary layer resistance at the pacth (s/m) + par240d_z => solarabs_inst%par240d_z_patch , & ! Output: [real(r8) (:,:) ] 10-day running mean of daytime patch absorbed PAR for leaves in canopy layer (W/m**2) + par240x_z => solarabs_inst%par240x_z_patch & ! Output: [real(r8) (:,:) ] 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2) + + ) + !---------------------------------------------------------------------------------------------------------------------------------------------------------- + !set timestep + + !Initialize enzyme decay Q10 + dtime = get_step_size() + is_end_day = is_end_curr_day() + do f = 1,fn + p = filterp(f) + ft = patch%itype(p) + g = patch%gridcell(p) + c = patch%column(p) + if(t_veg_day(p).ne.spval) then !check whether it is the first day + !--------------------------------------------------------- + !calculate the 10 day running mean radiations + if(ndaysteps(p)>0.0) then + par24d_z_i=par24d_z(p,:)/(dtime * ndaysteps(p)) + else + par24d_z_i = 0._r8 + endif + if(par240d_z(p,1).eq. spval)then !first day set as the same of first day environmental conditions + par240x_z(p,:)= par24x_z(p,:) + par240d_z(p,:)= par24d_z_i + else + par240x_z(p,:)= 0.9_r8 * par240x_z(p,:) + 0.1_r8 * par24x_z(p,:) + par240d_z(p,:)= 0.9_r8 * par240d_z(p,:) + 0.1_r8 * par24d_z_i + endif + !------------------------------------------------------- + !calculate the 10 day running mean daytime temperature + if(ndaysteps(p)>0.0)then + t_veg_dayi = t_veg_day(p) / ndaysteps(p) + else + t_veg_dayi = t_veg_night(p) / nnightsteps(p) + endif + if(t_veg10_day(p).eq. spval)then + t_veg10_day(p) = t_veg_dayi + endif + t_veg10_day(p) = 0.9_r8 * t_veg10_day(p)+ 0.1_r8 * t_veg_dayi + !------------------------------------------------------- + !calculate the 10 day running mean nighttime temperature + if(nnightsteps(p)>0)then + t_veg_nighti = t_veg_night(p) / nnightsteps(p) + else + t_veg_nighti = t_veg_day(p) / ndaysteps(p) + endif + if(t_veg10_night(p).eq. spval)then + t_veg10_night(p) = t_veg_nighti + endif + t_veg10_night(p) = 0.9_r8 * t_veg10_night(p) + 0.1_r8 * t_veg_nighti + !-------------------------------------------------------------------- + if(rh10_p(p).eq. spval)then + rh10_p(p) = rh(p) + endif + rh10_p(p) = 0.9_r8 * rh10_p(p) + 0.1_r8 * min(1.0_r8, rh(p)) + + if(rb10_p(p).eq. spval)then + rb10_p(p) = rb(p) + endif + rb10_p(p) = 0.9_r8 * rb10_p(p) + 0.1_r8 * rb(p) + endif !the first day check + end do !fn loop + end associate +end subroutine Acc240_Climate_LUNA + + +subroutine Acc24_Climate_LUNA(bounds, fn, filterp, canopystate_inst, photosyns_inst, & + surfalb_inst, solarabs_inst,temperature_inst) + ! + ! !DESCRIPTION: + ! Accumulate the 24 hr climates for LUNA model + + ! + ! !REVISION HISTORY: + ! version 1.0, by Chonggang Xu July 14 2015. + + ! CALLED FROM: + ! subroutine CanopyFluxes + + ! !USES: + use clm_time_manager , only : get_step_size + implicit none + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + + + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(temperature_type) , intent(inout) :: temperature_inst + + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit in variables + + integer :: c,f,g,iv,j,p ! indices + integer :: ft ! plant functional type + integer :: z ! the index across leaf layers + real (r8) :: dtime ! stepsize in seconds + real (r8) :: TRad ! total short-wave radiation on the top of canopy (w/m2) + real (r8) :: tlaii ! total leaf area index for a certain canopy layer + + !------------------------------------------------------------------------------------------------------------------------------------------------- + associate( & + sabv => solarabs_inst%sabv_patch , & ! Input: [real(r8) (:) ] patch solar radiation absorbed by vegetation (W/m**2) + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + par_sun_z => solarabs_inst%parsun_z_patch , & ! Input: [real(r8) (:,:) ] par absorbed per unit lai for sunlit canopy layer (w/m**2) + par_sha_z => solarabs_inst%parsha_z_patch , & ! Input: [real(r8) (:,:) ] par absorbed per unit lai for shaded canopy layer (w/m**2) + lai_sun_z => canopystate_inst%laisun_z_patch , & ! Input: [real(r8) (:,:) ] leaf area index for sunlit canopy layer + lai_sha_z => canopystate_inst%laisha_z_patch , & ! Input: [real(r8) (:,:) ] leaf area index for canopy shaded layer + par24d_z => solarabs_inst%par24d_z_patch , & ! Input: [real(r8) (:,:) ] daily accumulated absorbed PAR for leaves in canopy layer (W/m**2) + par24x_z => solarabs_inst%par24x_z_patch , & ! Input: [real(r8) (:,:) ] daily maximum of patch absorbed PAR for leaves in canopy layer (W/m**2) + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + gpp => photosyns_inst%fpsn_patch , & ! Input: [real(r8) (:) ] patch instaneous gpp (umol CO2/m**2 ground/s) for canopy layer + gpp_day => photosyns_inst%fpsn24_patch , & ! Output: [real(r8) (:) ] patch 24 hours acculative gpp(umol CO2/m**2 ground/day) from mid-night + t_veg_day => temperature_inst%t_veg_day_patch , & ! Output: [real(r8) (:) ] daytime mean vegetation temperature (Kelvin) + t_veg_night => temperature_inst%t_veg_night_patch , & ! Output: [real(r8) (:) ] nighttime mean vegetation temperature (Kelvin) + nnightsteps => temperature_inst%nnightsteps_patch , & ! Output: [integer (:) ] number of nighttime steps in 24 hours from mid-night, LUNA specific + ndaysteps => temperature_inst%ndaysteps_patch & ! Output: [integer (:) ] number of daytime steps in 24 hours from mid-night, LUNA specific + ) + !---------------------------------------------------------------------------------------------------------------------------------------------------------- + !set timestep + + !Initialize enzyme decay Q10 + dtime = get_step_size() + do f = 1,fn + p = filterp(f) + ft = patch%itype(p) + g = patch%gridcell(p) + c = patch%column(p) + !---------------------------------------------------- + !store the daily mean climate conditions + if(t_veg_day(p).ne.spval) then !check whether it is the first day + if(sabv(p)>0)then + t_veg_day(p) = t_veg_day(p) + t_veg(p) + ndaysteps(p) = ndaysteps(p) + 1 + else + t_veg_night(p) = t_veg_night(p) + t_veg(p) + nnightsteps(p) = nnightsteps(p) + 1 + endif + do z = 1, nrad(p) + !average of sunlit and shaded leaves + tlaii = lai_sun_z(p,z) + lai_sha_z(p,z) + if(tlaii > 0._r8)then + TRad = (par_sun_z(p,z)*lai_sun_z(p,z)+par_sha_z(p,z)*lai_sha_z(p,z))/tlaii + par24d_z(p,z)= par24d_z(p,z)+ dtime * TRad + if(TRad > par24x_z(p,z))then + par24x_z(p,z) = TRad + endif + endif + enddo + gpp_day(p) = gpp_day(p) + dtime * gpp(p) + endif !first day check + end do !fn loop + end associate +end subroutine Acc24_Climate_LUNA + + + + +subroutine Clear24_Climate_LUNA(bounds, fn, filterp, canopystate_inst, photosyns_inst, & + surfalb_inst, solarabs_inst,temperature_inst) + ! + ! !DESCRIPTION: + ! Zero out the 24 hr climates for LUNA model + + ! + ! !REVISION HISTORY: + ! version 1.0, by Chonggang Xu July 14 2015. + + ! CALLED FROM: + ! subroutine CanopyFluxes + + ! !USES: + use clm_time_manager , only : get_step_size, is_end_curr_day + implicit none + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + + + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(temperature_type) , intent(inout) :: temperature_inst + + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit in variables + + integer :: c,f,g,iv,j,p ! indices + integer :: ft ! plant functional type + integer :: z ! the index across leaf layers + real (r8) :: dtime ! stepsize in seconds + logical :: is_end_day ! is end of current day + !------------------------------------------------------------------------------------------------------------------------------------------------- + associate( & + par24d_z => solarabs_inst%par24d_z_patch , & ! Output: [real(r8) (:,:) ] daily accumulated absorbed PAR for leaves in canopy layer (W/m**2) + par24x_z => solarabs_inst%par24x_z_patch , & ! Output: [real(r8) (:,:) ] daily maximum of patch absorbed PAR for leaves in canopy layer (W/m**2) + gpp_day => photosyns_inst%fpsn24_patch , & ! Output: [real(r8) (:) ] patch 24 hours acculative gpp(umol CO2/m**2 ground/day) from mid-night + t_veg_day => temperature_inst%t_veg_day_patch , & ! Output: [real(r8) (:) ] daytime mean vegetation temperature (Kelvin) + t_veg_night => temperature_inst%t_veg_night_patch , & ! Output: [real(r8) (:) ] nighttime mean vegetation temperature (Kelvin) + nnightsteps => temperature_inst%nnightsteps_patch , & ! Output: [integer (:) ] number of nighttime steps in 24 hours from mid-night, LUNA specific + ndaysteps => temperature_inst%ndaysteps_patch & ! Output: [integer (:) ] number of daytime steps in 24 hours from mid-night, LUNA specific + ) + !---------------------------------------------------------------------------------------------------------------------------------------------------------- + !set timestep + + !Initialize enzyme decay Q10 + dtime = get_step_size() + is_end_day = is_end_curr_day() + do f = 1,fn + p = filterp(f) + ft = patch%itype(p) + g = patch%gridcell(p) + c = patch%column(p) + !------------------------------------------------------------------------------ + !clear out the daily state variables at the begining of simulations + t_veg_day(p) = 0.0_r8 + t_veg_night(p) = 0.0_r8 + par24d_z(p,:) = 0.0_r8 + par24x_z(p,:) = 0.0_r8 + gpp_day(p) = 0.0_r8 + nnightsteps(p) = 0.0_r8 + ndaysteps(p) = 0.0_r8 + + end do !fn loop + end associate +end subroutine Clear24_Climate_LUNA + + +!************************************************************************************************************************************************ +!Use the LUNA model to calculate the Nitrogen partioning +subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PARimx10,rb10, hourpd, tair10, tleafd10, tleafn10, & + Jmaxb0, Jmaxb1, Wc2Wjb0, relhExp,& + PNstoreold, PNlcold, PNetold, PNrespold, PNcbold, & + PNstoreopt, PNlcopt, PNetopt, PNrespopt, PNcbopt) + implicit none + real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) + real(r8), intent (in) :: forc_pbot10 !10-day mean air pressure (Pa) + real(r8), intent (in) :: relh10 !10-day mean relative humidity (unitless) + real(r8), intent (in) :: CO2a10 !10-day meanCO2 concentration in the air (Pa) + real(r8), intent (in) :: O2a10 !10-day mean O2 concentration in the air (Pa) + real(r8), intent (in) :: PARi10 !10-day mean photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8), intent (in) :: PARimx10 !10-day mean 24hr maximum photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8), intent (in) :: rb10 !10-day mean boundary layer resistance + real(r8), intent (in) :: hourpd !hours of light in a the day (hrs) + real(r8), intent (in) :: tair10 !10-day running mean of the 2m temperature (oC) + real(r8), intent (in) :: tleafd10 !10-day running mean of daytime leaf temperature (oC) + real(r8), intent (in) :: tleafn10 !10-day running mean of nighttime leaf temperature (oC) + real(r8), intent (in) :: Jmaxb0 !baseline proportion of nitrogen allocated for electron transport rate (unitless) + real(r8), intent (in) :: Jmaxb1 !coefficient determining the response of electron transport rate to light availability (unitless) + real(r8), intent (in) :: Wc2Wjb0 !the baseline ratio of rubisco-limited rate vs light-limited photosynthetic rate (Wc:Wj) + real(r8), intent (in) :: relhExp !specifies the impact of relative humidity on electron transport rate (unitless) + real(r8), intent (in) :: PNstoreold !old value of the proportion of nitrogen allocated to storage (unitless) + real(r8), intent (in) :: PNlcold !old value of the proportion of nitrogen allocated to light capture (unitless) + real(r8), intent (in) :: PNetold !old value of the proportion of nitrogen allocated to electron transport (unitless) + real(r8), intent (in) :: PNrespold !old value of the proportion of nitrogen allocated to respiration (unitless) + real(r8), intent (in) :: PNcbold !old value of the proportion of nitrogen allocated to carboxylation (unitless) + real(r8), intent (out):: PNstoreopt !optimal proportion of nitrogen for storage + real(r8), intent (out):: PNlcopt !optimal proportion of nitrogen for light capture + real(r8), intent (out):: PNetopt !optimal proportion of nitrogen for electron transport + real(r8), intent (out):: PNrespopt !optimal proportion of nitrogen for respiration + real(r8), intent (out):: PNcbopt !optial proportion of nitrogen for carboxyaltion + + !------------------------------------------------------------------------------------------------------------------------------- + !intermediate variables + real(r8) :: Carboncost1 !absolute amount of carbon cost associated with maintenance respiration due to deccrease in light capture nitrogen(g dry mass per day) + real(r8) :: Carboncost2 !absolute amount of carbon cost associated with maintenance respiration due to increase in light capture nitrogen(g dry mass per day) + real(r8) :: Carbongain1 !absolute amount of carbon gain associated with maintenance respiration due to deccrease in light capture nitrogen(g dry mass per day) + real(r8) :: Carbongain2 !absolute amount of carbon gain associated with maintenance respiration due to increase in light capture nitrogen(g dry mass per day) + real(r8) :: Fc !the temperature adjustment factor for Vcmax + real(r8) :: Fj !the temperature adjustment factor for Jmax + real(r8) :: PNlc !the current nitrogen allocation proportion for light capture + real(r8) :: Jmax !the maximum electron transport rate (umol/m2/s) + real(r8) :: JmaxCoef !coefficient determining the response of electron transport rate to light availability (unitless) and humidity + real(r8) :: Jmaxb0act !base value of Jmax (umol/m2/s) + real(r8) :: JmaxL !the electron transport rate with maximum daily radiation (umol/m2/s) + real(r8) :: JmeanL !the electron transport rate with mean radiation (umol/m2/s) + real(r8) :: Nstore !absolute amount of nitrogen allocated to storage (gN/m2 leaf) + real(r8) :: Nresp !absolute amount of nitrogen allocated to respiration (gN/m2 leaf) + real(r8) :: Nlc !absolute amount of nitrogen allocated to light capture (gN/m2 leaf) + real(r8) :: Net !absolute amount of nitrogen allocated to electron transport (gN/m2 leaf) + real(r8) :: Ncb !absolute amount of nitrogen allocated to carboxylation (gN/m2 leaf) + real(r8) :: Nresp1 !absolute amount of nitrogen allocated to respiration due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: Nlc1 !absolute amount of nitrogen allocated to light capture due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: Net1 !absolute amount of nitrogen allocated to electron transport due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: Ncb1 !absolute amount of nitrogen allocated to carboyxlation due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: Nresp2 !absolute amount of nitrogen allocated to respiration due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: Nlc2 !absolute amount of nitrogen allocated to light capture due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: Net2 !absolute amount of nitrogen allocated to electron transport due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: Ncb2 !absolute amount of nitrogen allocated to carboxylation due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: PSN !g carbon photosynthesized per day per unit(m2) of leaf + real(r8) :: RESP !g carbon respired per day per unit(m2) of leaf due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: PSN1 !g carbon photosynthesized per day per unit(m2) of leaf due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: RESP1 !g carbon respired per day per unit(m2) of leaf due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: PSN2 !g carbon photosynthesized per day per unit(m2) of leaf due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: RESP2 !g carbon respired per day per unit(m2) of leaf + real(r8) :: Npsntarget !absolute amount of target nitrogen for photosynthesis(gN/m2 leaf) + real(r8) :: Npsntarget1 !absolute amount of target nitrogen for photosynthesis due to increase in light capture nitrogen(gN/m2 leaf) + real(r8) :: Npsntarget2 !absolute amount of target nitrogen for photosynthesis due to decrease in light capture nitrogen(gN/m2 leaf) + real(r8) :: NUEj !nitrogen use efficiency for electron transport under current environmental conditions + real(r8) :: NUEc !nitrogen use efficiency for carboxylation under current environmental conditions + real(r8) :: NUEjref !nitrogen use efficiency for electron transport under reference environmental conditions (25oC and 385ppm Co2) + real(r8) :: NUEcref !nitrogen use efficiency for carboxylation under reference environmental conditions (25oC and 385ppm Co2) + real(r8) :: NUEr !nitrogen use efficiency for respiration + real(r8) :: PARi10c !10-day mean constrained photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8) :: PARimx10c !10-day mean constrained 24hr maximum photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8) :: Kj2Kcref !the ratio of rubisco-limited photosynthetic rate (Wc) to light limited photosynthetic rate (Wj) + real(r8) :: PNlcoldi !old value of the proportion of nitrogen allocated to light capture (unitless) + real(r8) :: Kj2Kc !the ratio of Wc to Wj under changed conditions + real(r8) :: Kc !conversion factors for Vc,max to Wc + real(r8) :: Kj !conversion factor for electron transport rate to Wj + real(r8) :: theta !efficiency of light energy conversion (unitless) + real(r8) :: chg_per_step !the nitrogen change per interation + real(r8) :: Vcmaxnight !Vcmax during night (umol/m2/s) + real(r8) :: ci !inter-cellular CO2 concentration (Pa) + real(r8) :: theta_cj !interpolation coefficient + real(r8) :: tleafd10c !10-day mean daytime leaf temperature, contrained for physiological range (oC) + real(r8) :: tleafn10c !10-day mean leaf temperature for night, constrained for physiological range (oC) + real(r8) :: Vcmax !the maximum carboxyaltion rate (umol/m2/s) + integer :: KcKjFlag !flag to indicate whether to update the Kc and Kj using the photosynthesis subroutine; 0--Kc and Kj need to be calculated; 1--Kc and Kj is prescribed. + integer :: jj !index record fo the number of iterations + integer :: increase_flag !whether to increase or decrease + + call NUEref(NUEjref, NUEcref, Kj2Kcref) + theta_cj = 0.95_r8 + Nstore = PNstoreold * FNCa !proportion of storage nitrogen in functional nitrogen + Nlc = PNlcold * FNCa !proportion of light capturing nitrogen in functional nitrogen + Net = PNetold * FNCa !proportion of light harvesting (electron transport) nitrogen in functional nitrogen + Nresp = PNrespold * FNCa !proportion of respirational nitrogen in functional nitrogen + Ncb = PNcbold * FNCa !proportion of carboxylation nitrogen in functional nitrogen + if (Nlc > FNCa * 0.5_r8) Nlc = 0.5_r8 * FNCa + chg_per_step = 0.02* FNCa + PNlc = PNlcold + PNlcoldi = PNlcold - 0.001_r8 + PARi10c = max(PARLowLim, PARi10) + PARimx10c = max(PARLowLim, PARimx10) + increase_flag = 0 + jj = 1 + tleafd10c = min(max(tleafd10, Trange1), Trange2) !constrain the physiological range + tleafn10c = min(max(tleafn10, Trange1), Trange2) !constrain the physiological range + ci = 0.7_r8 * CO2a10 + JmaxCoef = Jmaxb1 * ((hourpd / 12.0_r8)**2.0_r8) * (1.0_r8 - exp(-relhExp * max(relh10 - minrelh, 0.0_r8) / & + (1.0_r8 - minrelh))) + do while (PNlcoldi .NE. PNlc .and. jj < 100) + Fc = VcmxTKattge(tair10, tleafd10c) * Fc25 + Fj = JmxTKattge(tair10, tleafd10c) * Fj25 + NUEr = Cv * NUEr25 * (RespTBernacchi(tleafd10c) * hourpd + RespTBernacchi(tleafn10c) * (24.0_r8 - hourpd)) !nitrogen use efficiency for respiration (g biomass/m2/day/g N) + !**************************************************** + !Nitrogen Allocation Scheme: store the initial value + !**************************************************** + KcKjFlag = 0 + call NUE(O2a10, ci, tair10, tleafd10c, NUEj, NUEc, Kj2Kc) + call Nitrogen_investments (KcKjFlag,FNCa, Nlc, forc_pbot10, relh10, CO2a10,O2a10, PARi10c, PARimx10c,rb10, hourpd, tair10, & + tleafd10c,tleafn10c, & + Kj2Kc, Wc2Wjb0, JmaxCoef, Fc,Fj, NUEc, NUEj, NUEcref, NUEjref, NUEr, Kc, Kj, ci, & + Vcmax, Jmax,JmeanL,JmaxL, Net, Ncb, Nresp, PSN, RESP) + + Npsntarget = Nlc + Ncb + Net !target nitrogen allocated to photosynthesis, which may be lower or higher than Npsn_avail + PNlcoldi = Nlc / FNCa + Nstore = FNCa - Npsntarget - Nresp + !------------------------------------------------------------------------------------ + !test the increase of light capture nitrogen + if (Nstore > 0.0_r8 .and.(increase_flag .eq. 1 .or. jj .eq. 1)) then + Nlc2 = Nlc + chg_per_step + if (Nlc2 / FNCa > 0.95_r8) Nlc2 = 0.95_r8 * FNCa + KcKjFlag = 1 + call Nitrogen_investments (KcKjFlag,FNCa, Nlc2, forc_pbot10, relh10, CO2a10,O2a10, PARi10c, PARimx10c,rb10, hourpd, & + tair10, tleafd10c,tleafn10c, & + Kj2Kc, Wc2Wjb0, JmaxCoef, Fc,Fj, NUEc, NUEj, NUEcref, NUEjref,NUEr, Kc, Kj, ci, & + Vcmax, Jmax,JmeanL,JmaxL, Net2, Ncb2, Nresp2, PSN2, RESP2) + + Npsntarget2 = Nlc2 + Ncb2 + Net2 + !update the nitrogen change + Carboncost2 = (Npsntarget2 - Npsntarget) * NMCp25 * Cv * (RespTBernacchi(tleafd10c) * hourpd + & + RespTBernacchi(tleafn10c) * (24.0_r8 - hourpd)) + Carbongain2 = PSN2 - PSN + if(Carbongain2 > Carboncost2 .and. (Npsntarget2 + Nresp2 < 0.95_r8 * FNCa))then + Nlc = Nlc2 + Net = Net2 + Ncb = Ncb2 + Nstore = FNCa - Npsntarget2 - Nresp2 + if (jj == 1) increase_flag = 1 + end if + end if + !------------------------------------------------------------------------------------ + !test the decrease of light capture nitrogen + if (increase_flag == 0) then + if (Nstore < 0.0_r8) then + Nlc1 = Nlc * 0.8_r8 !bigger step of decrease if it is negative + else + Nlc1 = Nlc - chg_per_step + end if + if (Nlc1 < 0.05_r8) Nlc1 = 0.05_r8 + KcKjFlag = 1 + call Nitrogen_investments (KcKjFlag,FNCa, Nlc1,forc_pbot10, relh10, CO2a10,O2a10, PARi10c, PARimx10c,rb10, hourpd, & + tair10, tleafd10c,tleafn10c, & + Kj2Kc, Wc2Wjb0, JmaxCoef, Fc,Fj, NUEc, NUEj, NUEcref, NUEjref,NUEr, Kc, Kj, ci,& + Vcmax, Jmax,JmeanL,JmaxL, Net1, Ncb1, Nresp1, PSN1, RESP1) + Npsntarget1 = Nlc1 + Ncb1 + Net1 + Carboncost1 = (Npsntarget - Npsntarget1) * NMCp25 * Cv * (RespTBernacchi(tleafd10c) * hourpd + & + RespTBernacchi(tleafn10c) * (24.0_r8 - hourpd)) + Carbongain1 = PSN - PSN1 + if((Carbongain1 < Carboncost1 .and. Nlc1 > 0.05_r8) .or. (Npsntarget + Nresp) > 0.95_r8 * FNCa)then + Nlc = Nlc1 + Net = Net1 + Ncb = Ncb1 + Nstore = FNCa - Npsntarget1 - Nresp1 + end if + end if + PNlc = Nlc / FNCa + jj = jj + 1 + end do + PNlcopt = Nlc / FNCa + PNstoreopt = Nstore / FNCa + PNcbopt = Ncb / FNCa + PNetopt = Net / FNCa + PNrespopt = Nresp / FNCa + +end subroutine NitrogenAllocation + +!***************************************************************************************************************** +!calcualte the nitrogen investment for electron transport, carb10oxylation, respiration given a specified value +!of nitrogen allocation in light capture [Nlc]. This equation are based on Ali et al 2015b. + +subroutine Nitrogen_investments (KcKjFlag, FNCa, Nlc, forc_pbot10, relh10, & + CO2a10, O2a10, PARi10, PARimx10, rb10, hourpd, tair10, tleafd10, tleafn10, & + Kj2Kc, Wc2Wjb0, JmaxCoef, Fc, Fj, NUEc, NUEj, NUEcref, NUEjref, NUEr, Kc, & + Kj, ci, Vcmax, Jmax, JmeanL, JmaxL, Net, Ncb, Nresp, PSN, RESP) + implicit none + integer, intent (in) :: KcKjFlag !flag to indicate whether to update the Kc and Kj using the photosynthesis subroutine; 0--Kc and Kj need to be calculated; 1--Kc and Kj is prescribed. + real(r8), intent (in) :: FNCa !Area based functional nitrogen content (g N/m2 leaf) + real(r8), intent (in) :: Nlc !nitrogen content for light capture(g N/m2 leaf) + real(r8), intent (in) :: forc_pbot10 !10-day mean air pressure (Pa) + real(r8), intent (in) :: relh10 !10-day mean relative humidity (unitless) + real(r8), intent (in) :: CO2a10 !10-day mean CO2 concentration in the air (Pa) + real(r8), intent (in) :: O2a10 !10-day mean O2 concentration in the air (Pa) + real(r8), intent (in) :: PARi10 !10-day mean photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8), intent (in) :: PARimx10 !10-day mean 24hr maximum photosynthetic active radiation on in a canopy (umol/m2/s) + real(r8), intent (in) :: rb10 !10-day mean boundary layer resistance (s/m) + real(r8), intent (in) :: hourpd !hours of light in a the day (hrs) + real(r8), intent (in) :: tair10 !10-day running mean of the 2m temperature (oC) + real(r8), intent (in) :: tleafd10 !10-day mean daytime leaf temperature (oC) + real(r8), intent (in) :: tleafn10 !10-day mean nighttime leaf temperature (oC) + real(r8), intent (in) :: Kj2Kc !ratio: Kj / Kc + real(r8), intent (in) :: Wc2Wjb0 !the baseline ratio of rubisco-limited rate vs light-limited photosynthetic rate (Wc:Wj) + real(r8), intent (in) :: JmaxCoef !coefficient determining the response of electron transport rate to light availability (unitless) and humidity + real(r8), intent (in) :: Fc !the temperature adjustment factor for Vcmax + real(r8), intent (in) :: Fj !the temperature adjustment factor for Jmax + real(r8), intent (in) :: NUEc !nitrogen use efficiency for carboxylation + real(r8), intent (in) :: NUEj !nitrogen use efficiency for electron transport + real(r8), intent (in) :: NUEcref !nitrogen use efficiency for carboxylation under reference climates + real(r8), intent (in) :: NUEjref !nitrogen use efficiency for electron transport under reference climates + real(r8), intent (in) :: NUEr !nitrogen use efficiency for respiration + real(r8), intent (inout) :: Kc !conversion factors from Vc,max to Wc + real(r8), intent (inout) :: Kj !conversion factor from electron transport rate to Wj + real(r8), intent (inout) :: ci !inter-cellular CO2 concentration (Pa) + real(r8), intent (out) :: Vcmax !the maximum carboxyaltion rate (umol/m2/s) + real(r8), intent (out) :: Jmax !the maximum electron transport rate (umol/m2/s) + real(r8), intent (out) :: JmaxL !the electron transport rate with maximum daily radiation (umol/m2/s) + real(r8), intent (out) :: JmeanL !the electron transport rate with mean radiation (umol/m2/s) + real(r8), intent (out) :: Net !nitrogen content for electron transport(g N/m2 leaf) + real(r8), intent (out) :: Ncb !nitrogen content for carboxylation(g N/m2 leaf) + real(r8), intent (out) :: Nresp !nitrogen content for respiration(g N/m2 leaf) + real(r8), intent (out) :: PSN !daily photosynthetic rate(g C/day/m2 leaf) + real(r8), intent (out) :: RESP !daily respiration rate(g C/day/m2 leaf) + !------------------------------------------------------------------------------------------------------------------------------- + !intermediate variables + real(r8) :: A !Gross photosynthetic rate (umol CO2/m2/s) + real(r8) :: Wc2Wj !ratio: Wc/Wj + real(r8) :: ELTRNabsorb !absorbed electron rate, umol electron/m2 leaf /s + real(r8) :: Jmaxb0act !base value of Jmax (umol/m2/s) + real(r8) :: theta_cj !interpolation coefficient + real(r8) :: theta !light absorption rate (0-1) + real(r8) :: Vcmaxnight !Vcmax during night (umol/m2/s) + real(r8) :: Wc !rubisco-limited photosynthetic rate (umol/m2/s) + real(r8) :: Wj !light limited photosynthetic rate (umol/m2/s) + real(r8) :: NUECHG !the nitrogen use efficiency change under current conidtions compared to reference climate conditions (25oC and 385 ppm ) + + theta_cj = 0.95_r8 + theta = 0.292_r8 / (1.0_r8 + 0.076_r8 / (Nlc * Cb)) + ELTRNabsorb = theta * PARi10 + Jmaxb0act = Jmaxb0 * FNCa * Fj + Jmax = Jmaxb0act + JmaxCoef * ELTRNabsorb + JmaxL = theta * PARimx10 / (sqrt(1.0_r8 + (theta * PARimx10 / Jmax)**2.0_r8)) + NUEchg = (NUEc / NUEcref) * (NUEjref / NUEj) + Wc2Wj = Wc2Wjb0 * (NUEchg**0.5_r8) + Wc2Wj = min(1.0_r8, Wc2Wj) + Vcmax = Wc2Wj * JmaxL * Kj2Kc + JmeanL = theta * PARi10 / (sqrt(1.0_r8 + (ELTRNabsorb / Jmax)**2.0_r8)) + if(KcKjFlag.eq.0)then !update the Kc,Kj, anc ci information + call Photosynthesis_luna(forc_pbot10, tleafd10, relh10, CO2a10, O2a10,rb10, Vcmax, JmeanL, ci, Kc, Kj, A) + else + Wc = Kc * Vcmax + Wj = Kj * JmeanL + A = (1.0_r8 - theta_cj) * max(Wc, Wj) + theta_cj * min(Wc, Wj) + endif + PSN = Cv * A * hourpd + Vcmaxnight = VcmxTKattge(tair10, tleafn10) / VcmxTKattge(tair10, tleafd10) * Vcmax + RESP = Cv * 0.015_r8 * (Vcmax * hourpd + Vcmaxnight * (24.0_r8 - hourpd)) + Net = Jmax / Fj + Ncb = Vcmax / Fc + Nresp = RESP / NUEr + +end subroutine Nitrogen_investments + + + +!******************************************************************************************************************** +! Calculate the photosynthesis by solving the following 3 equations for 3 unknowns (A, gs, Ci): Farquahr's non-linear equation (A versus Ci), +! Ball-Berry equation (gs versus A) and the diffusion equation (A = gs * (Ca - Ci). The approach taken is the following; Solve the 3 equations for +! two phases. First phase is where Rubisco is limiting (Wc <= Wj) and second phase is where light is limiting (Wj > Wc). + +subroutine Photosynthesis_luna(forc_pbot, tleafd, relh, CO2a,O2a, rb, Vcmax, JmeanL, ci, Kc, Kj, A) + implicit none + real(r8), intent (in) :: forc_pbot !air presure (Pa) + real(r8), intent (in) :: tleafd !daytime leaf temperature (oC) + real(r8), intent (in) :: relh !relative humidity (unitless) + real(r8), intent (in) :: CO2a !atmospheric CO2 partial pressure(Pa) + real(r8), intent (in) :: O2a !atmospheric O2 partial pressure(Pa) + real(r8), intent (in) :: rb !boundary layer resistance (s/m) + real(r8), intent (in) :: Vcmax !maximum carboxylation rate (umol/m2/s) + real(r8), intent (in) :: JmeanL !average electron transport rate (umol/m2/s) + real(r8), intent (out):: ci !inter-cellular CO2 concentration (ppm) + real(r8), intent (out):: Kc !conversion factors for Vc,max to Wc + real(r8), intent (out):: Kj !conversion factors for Jmax to Wj + real(r8), intent (out):: A !g dry mass photosynthesized per day + + !------------------------------------------------------------------------------------------------------------------------------- + !intermediate variables + real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model + real(r8) :: cf !conversion factor of resistance: m**2/umol -> s/m + real(r8) :: bp !maximum stomatal resistance + real(r8) :: mpe !plant functional type dependent parameter for stomatal conductance + real(r8) :: rs !stomatal resistance (s/m) + real(r8) :: r1 !root1 of quadratic equations + real(r8) :: r2 !root2 of quadratic equations + real(r8) :: Wc !rubisco-limited photosynthetic rate (umol/m2/s) + real(r8) :: Wj !light-limited photosynthetic rate (umol/m2/s) + real(r8) :: k_o !Michaelis-menten constant for O2 in Farquhar's model + real(r8) :: k_c !Michaelis-menten constant for CO2 in Farquhar's model + real(r8) :: CO2c !partial pressure of CO2 (Pa) + real(r8) :: O2c !partial pressure of oxygen (Pa) + real(r8) :: c_p !Michaelis-menten constant for Farquhar's model related to rubisco specificity factor + real(r8) :: tdayk !daytime temperature in Kelvin + real(r8) :: ciold !old value of inter-cellular CO2 concentration for convergence check + real(r8) :: bbb !Ball-Berry minimum leaf conductance (umol H20/m2/s) + real(r8) :: mbb !Ball-Berry slope of conductance photosynthesis relationship (stressed) + real(r8) :: gs_mol !leaf stomatal conductance (umol H20/m2/s) + real(r8) :: gb_mol !leaf boundary layer conductance (umol H20/m2/s) + real(r8) :: aquad !terms of quadratic equations + real(r8) :: bquad !terms of quadratic equations + real(r8) :: cquad !terms of quadratic equations + real(r8) :: phi !terms of quadratic equations + real(r8) :: rsmax0 !maximum stomata conductance (s/m) + real(r8) :: tleaf !daytime leaf temperature (oC) + real(r8) :: tleafk !the temperature of the leaf in Kelvin + real(r8) :: theta_cj !the interpolation coefficient for Wj and Wc + real(r8) :: relhc !constrained relative humidity (unitless) + integer :: i !index record the number of iterations + + theta_cj = 0.95_r8 + rsmax0 = 2.0_r8 * 1.0e4_r8 + bp = 2000.0_r8 + tleaf = tleafd + tleafk = tleaf + tfrz + aquad = 1.0_r8 + relhc = max(minrelh, relh) + bbb = 1.0_r8 / bp + mbb = mp + CO2c = CO2a + O2c = O2a + ci = 0.7_r8 * CO2c + ciold = ci - 0.02_r8 + cf = forc_pbot / (8.314_r8 * tleafk) * 1.0e6_r8 + gb_mol = cf / rb + k_c = kc25 * exp((79430.0_r8 / (8.314_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + k_o = ko25 * exp((36380.0_r8 / (8.314_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + c_p = Cp25 * exp((37830.0_r8 / (8.314_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25_r8) / (tfrz + tleaf))) + awc = k_c * (1.0_r8 + O2c / k_o) + i = 1 + do while (abs(ci - ciold) > 0.01_r8 .and. i < 100) ! for RUBISCO limitation + i = i + 1 + ciold = ci + Kc = max(ci - c_p, 0.0_r8) / (ci + awc) + Wc = Kc * Vcmax + gs_mol = bbb + mbb * Wc / CO2c * forc_pbot * relhc + phi = forc_pbot * (1.37_r8 * gs_mol + 1.6_r8 * gb_mol) / (gb_mol * gs_mol) + bquad = awc - CO2c + phi * Vcmax + cquad = -(c_p * phi * Vcmax + awc * CO2c) + call Quadratic(aquad, bquad, cquad, r1, r2) + ci = max(r1, r2) + if (ci < 0.0_r8) ci = c_p + 0.5_r8 * ciold + end do + Kj = max(ci - c_p, 0.0_r8) / (4.0_r8 * ci + 8.0_r8 * c_p) + Kc = max(ci - c_p, 0.0_r8) / (ci + awc) + Wc = Kc * Vcmax + Wj = Kj * JmeanL + ciold = ci - 0.02_r8 + if (Wj < Wc) then !light limitation + i = 1 + do while (abs(ci - ciold) > 0.01_r8 .and. i < 100) + i = i + 1 + ciold = ci + gs_mol = bbb + mbb * Wj / CO2c * forc_pbot * relhc + phi = forc_pbot * (1.37_r8 * gs_mol + 1.6_r8 * gb_mol) / (gb_mol * gs_mol) + bquad = 2.0_r8 * c_p - CO2c + phi * JmeanL / 4.0_r8 + cquad = -(c_p * phi * JmeanL / 4.0_r8 + 2.0_r8 * c_p * CO2c) + call Quadratic(aquad, bquad, cquad, r1, r2) + ci = max(r1, r2) + if (ci < 0.0_r8) ci = c_p + 0.5_r8 * ciold + Kj = max(ci - c_p, 0.0_r8) / (4.0_r8 * ci + 8.0_r8 * c_p) + Wj = Kj * JmeanL + end do + Kj = max(ci - c_p, 0.0_r8) / (4.0_r8 * ci + 8.0_r8 * c_p) + Kc = max(ci - c_p, 0.0_r8) / (ci + awc) + Wc = Kc * Vcmax + Wj = Kj * JmeanL + end if + A = (1.0_r8 - theta_cj) * max(Wc, Wj) + theta_cj * min(Wc, Wj) !use this instead of the quadratic to avoid values not in the range of wc and wj + rs = cf / gs_mol + rs = min(rsmax0, rs) + +end subroutine Photosynthesis_luna + + + +!********************************************************************************************************************************************************************** +!Calculate the reference nitrogen use effieciency dependence on CO2 and leaf temperature + +subroutine NUEref(NUEjref,NUEcref,Kj2Kcref) + implicit none + real(r8), intent (out):: NUEjref !nitrogen use efficiency for electron transport under refernce environmental conditions (25oC and 385 ppm co2) + real(r8), intent (out):: NUEcref !nitrogen use efficiency for carboxylation under reference environmental conditions (25oC and 385 ppm co2) + real(r8), intent (out):: Kj2Kcref !the ratio of Wc to Wj under reference (25oC and 385 ppm co2) conditions + !--------------------------------------------- + !intermediate variables + real(r8) :: Fj !the temperature adjust factor for Jmax + real(r8) :: Fc !the temperatuer adjust factor for Vcmax + real(r8) :: tgrow !10 day mean growth temperature (oC), 24 hour mean temperature + real(r8) :: tleaf !leaf temperature (oC) + real(r8) :: CO2c !CO2 concentration (ppm) + real(r8) :: O2c !O2 concentration (ppm) + real(r8) :: k_o !Rubsico O2 specifity + real(r8) :: k_c !Rubsico CO2 specifity + real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model + real(r8) :: c_p !CO2 compenstation point (Pa) + real(r8) :: ci !leaf internal [CO2] (Pa) + real(r8) :: Kc !converstion factor from Vcmax to Wc + real(r8) :: Kj !converstion factor from J to Wc + + tgrow = 25.0_r8 + tleaf = 25.0_r8 + Fc = VcmxTKattge(tgrow, tleaf) * Fc25 + Fj = JmxTKattge(tgrow, tleaf) * Fj25 + CO2c = co2ref * forc_pbot_ref * 1.0e-6_r8 !pa + O2c = O2ref * forc_pbot_ref * 1.0e-6_r8 !pa + k_c = Kc25 * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + k_o = Ko25 * exp((36380.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + c_p = Cp25 * exp((37830.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + awc = k_c * (1.0_r8+O2c/k_o) + ci = 0.7_r8 * CO2c + Kj = max( ci-c_p,0.0_r8 ) / ( 4.0_r8*ci + 8.0_r8*c_p ) + Kc = max( ci-c_p,0.0_r8 ) / (ci+awc) + NUEjref = Kj * Fj + NUEcref = Kc * Fc + Kj2Kcref = Kj / Kc + +end subroutine NUEref + + +!******************************************************************************************************************** +!Calculate the Nitrogen use effieciency dependence on CO2 and leaf temperature + +subroutine NUE(O2a, ci, tgrow, tleaf, NUEj,NUEc,Kj2Kc) + implicit none + real(r8), intent (in) :: o2a !air O2 partial presuure (Pa) + real(r8), intent (in) :: ci !leaf inter-cellular [CO2] (PPM) + real(r8), intent (in) :: tgrow !10 day growth temperature (oC), 24 hour mean temperature + real(r8), intent (in) :: tleaf !leaf temperature (oC) + real(r8), intent (out):: NUEj !nitrogen use efficiency for electron transport under refernce environmental conditions (25oC and 385 ppm co2) + real(r8), intent (out):: NUEc !nitrogen use efficiency for carboxylation under reference environmental conditions (25oC and 385 ppm co2) + real(r8), intent (out):: Kj2Kc !the ratio of Kj to Kc + !------------------------------------------------ + !intermediate variables + real(r8) :: Fj !the temperatuer adjust factor for Jmax + real(r8) :: Fc !the temperatuer adjust factor for Vcmax + real(r8) :: Kc !conversion factor from Vcmax to Wc + real(r8) :: Kj !conversion factor from J to W + real(r8) :: k_o !Rubsico O2 specifity + real(r8) :: k_c !Rubsico CO2 specifity + real(r8) :: awc !second deminator term for rubsico limited carboxylation rate based on Farquhar model + real(r8) :: c_p !CO2 compenstation point (Pa) + + Fc = VcmxTKattge(tgrow, tleaf) * Fc25 + Fj = JmxTKattge(tgrow, tleaf) * Fj25 + k_c = Kc25 * exp((79430.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + k_o = Ko25 * exp((36380.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + c_p = Cp25 * exp((37830.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + awc = k_c * ( 1.0_r8 + O2a/k_o ) + Kj = max( ci-c_p,0.0_r8 ) / ( 4.0_r8*ci + 8.0_r8*c_p ) + Kc = max( ci-c_p,0.0_r8 ) / ( ci+awc ) + NUEj = Kj * Fj + NUEc = Kc * Fc + Kj2Kc = Kj / Kc +end subroutine NUE + +!************************************************************************************************************************************************ +!Calculate the temperature response for Vcmax; assuming temperature acclimation as in CLM4.5, based on Kattge and Knorr 2007 + +real(r8) function VcmxTKattge(tgrow, tleaf) + implicit none + real(r8), intent(in):: tgrow !daytime and nightime growth temperature (oC) + real(r8), intent(in):: tleaf !leaf temperature (oC) + real(r8) :: TlimVcmx !Vcmax activation energy + real(r8) :: Vcmxf1 !Vcmax coef1 + real(r8) :: Vcmxf2 !Vcmax coef2 + real(r8) :: Vcmxf3 !Vcmax coef3 + + TlimVcmx = 668.39_r8- 1.07_r8 * (min(max(tgrow, 11.0_r8), 35.0_r8)) + Vcmxf1 = 1.0_r8 + exp((TlimVcmx * (25.0_r8 + tfrz) - 200000.0_r8) / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) + Vcmxf2 = exp((72000.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1.0_r8 - (tfrz+ 25.0_r8) / (tfrz + tleaf))) + Vcmxf3 = 1.0_r8 + exp((TlimVcmx * (tleaf + tfrz) - 200000.0_r8) / (rgas*1.e-3_r8 * (tleaf + tfrz))) + VcmxTKattge = Vcmxf1 * Vcmxf2 / Vcmxf3 + +end function VcmxTKattge + +!************************************************************************************************************************************************ +!Calculate the temperature response for Jmax; assuming temperature acclimation as in CLM4.5, based on Kattge and Knorr 2007 + +real(r8) function JmxTKattge(tgrow, tleaf) + implicit none + real(r8), intent(in):: tgrow !daytime and nightime growth temperature (oC) + real(r8), intent(in):: tleaf !leaf temperature (oC) + real(r8) :: TlimJmx !Jmax activation energy + real(r8) :: Jmxf1 !Jmax coef1 + real(r8) :: Jmxf2 !Jmax coef2 + real(r8) :: Jmxf3 !Jmax coef3 + + TlimJmx = 659.7_r8 - 0.75_r8 * (min(max(tgrow, 11.0_r8), 35.0_r8)) + Jmxf1 = 1.0_r8 + exp((TlimJmx * (25.0_r8 + tfrz) - 200000.0_r8) / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) + Jmxf2 = exp((50000.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1._r8 - (tfrz + 25.0_r8) / (tleaf+tfrz))) + Jmxf3 = 1.0_r8 + exp((TlimJmx * (tleaf + tfrz) - 200000.0_r8) / (rgas*1.e-3_r8 * (tleaf + tfrz))) + JmxTKattge = Jmxf1 * Jmxf2 / Jmxf3 + +end function JmxTKattge + +!******************************************************************************************************************** +!Calculate the temperature response for Vcmax; without assuming temperature acclimation and following Leunning 2002 Plant, Cell & Environment + +real(r8) function VcmxTLeuning(tgrow, tleaf) + implicit none + real(r8), intent(in) :: tgrow !daytime and nightime growth temperature (oC) + real(r8), intent(in) :: tleaf !leaf temperature (oC) + real(r8) :: TlimVcmx !Vcmax activation energy + real(r8) :: Vcmxf1 !Vcmax coef1 + real(r8) :: Vcmxf2 !Vcmax coef2 + real(r8) :: Vcmxf3 !Vcmax coef3 + + TlimVcmx = 486.0_r8 + Vcmxf1 = 1.0_r8 + exp((TlimVcmx * (25.0_r8 + tfrz) - 149252.0_r8) / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) + Vcmxf2 = exp((73637.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1._r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + Vcmxf3 = 1.0_r8 + exp((TlimVcmx * (tleaf + tfrz) - 149252.0_r8) / (rgas*1.e-3_r8 * (tleaf + tfrz))) + VcmxTLeuning = Vcmxf1 * Vcmxf2 / Vcmxf3 + +end function VcmxTLeuning + +!******************************************************************************************************************** +!Calculate the temperature response for Jmax; without assuming temperature acclimation and following Leunning 2002 Plant, Cell & Environment +real(r8) function JmxTLeuning(tgrow, tleaf) + implicit none + real(r8), intent(in):: tgrow !daytime and nightime growth temperature (oC) + real(r8), intent(in):: tleaf !leaf temperature (oC) + real(r8) :: TlimJmx !Jmax activation energy + real(r8) :: Jmxf1 !Jmax coef1 + real(r8) :: Jmxf2 !Jmax coef2 + real(r8) :: Jmxf3 !Jmax coef3 + + TlimJmx = 495.0_r8 + Jmxf1 = 1.0_r8 + exp((TlimJmx * (25.0_r8 + tfrz) - 152044.0_r8) / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) + Jmxf2 = exp((50300.0_r8 / (rgas*1.e-3_r8 * (25.0_r8 + tfrz))) * (1._r8 - (tfrz + 25.0_r8) / (tfrz + tleaf))) + Jmxf3 = 1.0_r8 + exp((TlimJmx * (tleaf + tfrz) - 152044.0_r8) / (rgas*1.e-3_r8 * (tleaf + tfrz))) + JmxTLeuning = Jmxf1 * Jmxf2 / Jmxf3 + +end function JmxTLeuning + +!******************************************************************************************************************** +!Calculate the temperature response for respiration, following Bernacchi PCE 2001 + +real(r8) function RespTBernacchi(tleaf) + implicit none + real(r8), intent(in):: tleaf !leaf temperature (oC) + RespTBernacchi= exp(18.72_r8-46.39_r8/(rgas*1.e-6_r8 *(tleaf+tfrz))) + +end function RespTBernacchi + + +!******************************************************************************************************************** +!Calculate the soultion using the quadratic formula + +subroutine Quadratic(a,b,c,r1,r2) + implicit none + real(r8), intent(in) :: a !coefficient a + real(r8), intent(in) :: b !coefficient b + real(r8), intent(in) :: c !coefficient c + real(r8), intent(out) :: r1 !root one + real(r8), intent(out) :: r2 !root one + real(r8) :: q ! temporary term for quadratic solution + + r1 = 1.0e36_r8 + r2 = 1.0e36_r8 + + if (a == 0.0_r8) return + + if (b .GE. 0.0_r8) then + q = -0.5_r8 * (b + sqrt(b*b - 4.0_r8*a*c)) + else + q = -0.5_r8 * (b - sqrt(b*b - 4.0_r8*a*c)) + end if + + r1 = q / a + + if (q .NE. 0.0_r8)then + r2 = c / q + else + r2 = 1.0e36_r8 + end if + +end subroutine Quadratic + + +end module LunaMod + diff --git a/components/clm/src/biogeophys/OzoneBaseMod.F90 b/components/clm/src/biogeophys/OzoneBaseMod.F90 new file mode 100644 index 0000000000..c50818f380 --- /dev/null +++ b/components/clm/src/biogeophys/OzoneBaseMod.F90 @@ -0,0 +1,146 @@ +module OzoneBaseMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Define the interface for ozone_type, which calculates ozone-induced stress. The type + ! defined here is abstract; it will get instantiated as a concrete type that extends + ! this base type (e.g., an ozone-off or ozone-on version). + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + + implicit none + save + private + + ! !PUBLIC TYPES: + type, abstract, public :: ozone_base_type + private + + ! Public data members + ! These should be treated as read-only by other modules (except that they can be + ! modified by extensions of the ozone_base_type) + real(r8), pointer, public :: o3coefvsha_patch(:) ! ozone coefficient for photosynthesis, shaded leaves (0 - 1) + real(r8), pointer, public :: o3coefvsun_patch(:) ! ozone coefficient for photosynthesis, sunlit leaves (0 - 1) + real(r8), pointer, public :: o3coefgsha_patch(:) ! ozone coefficient for conductance, shaded leaves (0 - 1) + real(r8), pointer, public :: o3coefgsun_patch(:) ! ozone coefficient for conductance, sunlit leaves (0 - 1) + + + contains + ! The following routines need to be implemented by all type extensions + procedure(Init_interface) , public, deferred :: Init + procedure(Restart_interface) , public, deferred :: Restart + procedure(CalcOzoneStress_interface) , public, deferred :: CalcOzoneStress + + ! The following routines should only be called by extensions of the ozone_base_type + procedure, public :: InitAllocateBase + procedure, public :: InitColdBase + + end type ozone_base_type + + abstract interface + + subroutine Init_interface(this, bounds) + use decompMod, only : bounds_type + import :: ozone_base_type + + class(ozone_base_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + end subroutine Init_interface + + subroutine Restart_interface(this, bounds, ncid, flag) + use decompMod , only : bounds_type + use ncdio_pio , only : file_desc_t + import :: ozone_base_type + + class(ozone_base_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define' + end subroutine Restart_interface + + subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_exposedvegp, & + forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) + use decompMod , only : bounds_type + use shr_kind_mod , only : r8 => shr_kind_r8 + import :: ozone_base_type + + class(ozone_base_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa) + real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K) + real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m) + real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m) + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) + real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m) + real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow + end subroutine CalcOzoneStress_interface + + end interface + +contains + + !----------------------------------------------------------------------- + subroutine InitAllocateBase(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate variables in the base class + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(ozone_base_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitAllocateBase' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + allocate(this%o3coefvsha_patch(begp:endp)) ; this%o3coefvsha_patch(:) = nan + allocate(this%o3coefvsun_patch(begp:endp)) ; this%o3coefvsun_patch(:) = nan + allocate(this%o3coefgsha_patch(begp:endp)) ; this%o3coefgsha_patch(:) = nan + allocate(this%o3coefgsun_patch(begp:endp)) ; this%o3coefgsun_patch(:) = nan + + end subroutine InitAllocateBase + + + !----------------------------------------------------------------------- + subroutine InitColdBase(this, bounds) + ! + ! !DESCRIPTION: + ! Do cold start initialization for variables in the base class. Note that this + ! initialization will be the same for all ozone implementations, including the + ! ozone-off implementation. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(ozone_base_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitColdBase' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + this%o3coefvsha_patch(begp:endp) = 1._r8 + this%o3coefvsun_patch(begp:endp) = 1._r8 + this%o3coefgsha_patch(begp:endp) = 1._r8 + this%o3coefgsun_patch(begp:endp) = 1._r8 + + end subroutine InitColdBase + +end module OzoneBaseMod diff --git a/components/clm/src/biogeophys/OzoneFactoryMod.F90 b/components/clm/src/biogeophys/OzoneFactoryMod.F90 new file mode 100644 index 0000000000..2b28587a99 --- /dev/null +++ b/components/clm/src/biogeophys/OzoneFactoryMod.F90 @@ -0,0 +1,53 @@ +module OzoneFactoryMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Factory to create an instance of ozone_base_type. This module figures out the + ! particular type to return. + ! + ! !USES: + use decompMod , only : bounds_type + + implicit none + save + private + + ! + ! !PUBLIC ROUTINES: + public :: create_and_init_ozone_type ! create an object of class ozone_base_type + +contains + + !----------------------------------------------------------------------- + function create_and_init_ozone_type(bounds) result(ozone) + ! + ! !DESCRIPTION: + ! Create and initialize an object of ozone_base_type, and return this object. The + ! particular type is determined based on the use_ozone namelist parameter. + ! + ! !USES: + use clm_varctl , only : use_ozone + use OzoneBaseMod , only : ozone_base_type + use OzoneOffMod , only : ozone_off_type + use OzoneMod , only : ozone_type + ! + ! !ARGUMENTS: + class(ozone_base_type), allocatable :: ozone ! function result + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_and_init_ozone_type' + !----------------------------------------------------------------------- + + if (use_ozone) then + allocate(ozone, source = ozone_type()) + else + allocate(ozone, source = ozone_off_type()) + end if + + call ozone%Init(bounds) + + end function create_and_init_ozone_type + +end module OzoneFactoryMod diff --git a/components/clm/src/biogeophys/OzoneMod.F90 b/components/clm/src/biogeophys/OzoneMod.F90 new file mode 100644 index 0000000000..162e4fee32 --- /dev/null +++ b/components/clm/src/biogeophys/OzoneMod.F90 @@ -0,0 +1,520 @@ +module OzoneMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates ozone-induced stress. + ! + ! Note that the ozone calculations need to happen AFTER rssun and rsshade are computed + ! by the Photosynthesis routine. However, Photosynthesis also uses the ozone stress + ! computed here. Thus, the ozone stress computed in timestep i is applied in timestep + ! (i+1), requiring these stresses to be saved on the restart file. + ! + ! Developed by Danica Lombardozzi. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod, only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : spval + use shr_log_mod , only : errMsg => shr_log_errMsg + use OzoneBaseMod, only : ozone_base_type + use abortutils , only : endrun + + implicit none + save + private + + ! !PUBLIC TYPES: + type, extends(ozone_base_type), public :: ozone_type + private + ! Private data members + real(r8), pointer :: o3uptakesha_patch(:) ! ozone dose, shaded leaves (mmol O3/m^2) + real(r8), pointer :: o3uptakesun_patch(:) ! ozone dose, sunlit leaves (mmol O3/m^2) + + ! NOTE(wjs, 2014-09-29) tlai_old_patch really belongs alongside tlai_patch in + ! CanopyStateType. But there are problems with any way I can think to implement + ! that: + ! + ! - Updating tlai_old from a call in clm_driver, just before tlai is updated: This + ! is problematic to do correctly because tlai is updated in different places + ! depending on whether you're using SP, CN or ED. + ! + ! - Updating tlai_old within each routine that updates tlai: This feels fragile, + ! since it depends on each scheme remembering to do this update at the correct + ! time. + ! + ! - Making tlai a private member of CanopyFluxes, with getter and setter methods. + ! Then the setter method would also set tlai_old. This feels like the most robust + ! solution, but we don't have any precedent for using getters and setters for data + ! arrays. + real(r8), pointer :: tlai_old_patch(:) ! tlai from last time step + + contains + ! Public routines + procedure, public :: Init + procedure, public :: Restart + procedure, public :: CalcOzoneStress + + ! Private routines + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + ! Calculate ozone stress for a single point, for just sunlit or shaded leaves + procedure, private, nopass :: CalcOzoneStressOnePoint + end type ozone_type + + interface ozone_type + module procedure constructor + end interface ozone_type + + ! !PRIVATE TYPES: + + ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying + ! value, obtained from ATM + real(r8), parameter :: forc_ozone = 100._r8 * 1.e-9_r8 ! ozone partial pressure [mol/mol] + + ! TODO(wjs, 2014-09-29) The following parameters should eventually be moved to the + ! params file. Parameters differentiated on veg type should be put on the params file + ! with a pft dimension. + + ! o3:h2o resistance ratio defined by Sitch et al. 2007 + real(r8), parameter :: ko3 = 1.67_r8 + + ! LAI threshold for LAIs that asymptote and don't reach 0 + real(r8), parameter :: lai_thresh = 0.5_r8 + + ! threshold below which o3flux is set to 0 (nmol m^-2 s^-1) + real(r8), parameter :: o3_flux_threshold = 0.8_r8 + + ! o3 intercepts and slopes for photosynthesis + real(r8), parameter :: needleleafPhotoInt = 0.8390_r8 ! units = unitless + real(r8), parameter :: needleleafPhotoSlope = 0._r8 ! units = per mmol m^-2 + real(r8), parameter :: broadleafPhotoInt = 0.8752_r8 ! units = unitless + real(r8), parameter :: broadleafPhotoSlope = 0._r8 ! units = per mmol m^-2 + real(r8), parameter :: nonwoodyPhotoInt = 0.8021_r8 ! units = unitless + real(r8), parameter :: nonwoodyPhotoSlope = -0.0009_r8 ! units = per mmol m^-2 + + ! o3 intercepts and slopes for conductance + real(r8), parameter :: needleleafCondInt = 0.7823_r8 ! units = unitless + real(r8), parameter :: needleleafCondSlope = 0.0048_r8 ! units = per mmol m^-2 + real(r8), parameter :: broadleafCondInt = 0.9125_r8 ! units = unitless + real(r8), parameter :: broadleafCondSlope = 0._r8 ! units = per mmol m^-2 + real(r8), parameter :: nonwoodyCondInt = 0.7511_r8 ! units = unitless + real(r8), parameter :: nonwoodyCondSlope = 0._r8 ! units = per mmol m^-2 + +contains + + ! ======================================================================== + ! Infrastructure routines (initialization, restart, etc.) + ! ======================================================================== + + !----------------------------------------------------------------------- + function constructor() result(ozone) + ! + ! !DESCRIPTION: + ! Return an instance of ozone_type + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ozone_type) :: ozone ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'constructor' + !----------------------------------------------------------------------- + + ! DO NOTHING (simply return a variable of the appropriate type) + + ! Eventually this should call the Init routine (or replace the Init routine + ! entirely). But I think it would be confusing to do that until we switch everything + ! to use a constructor rather than the init routine. + + end function constructor + + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize ozone data structure + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + +#ifdef __PGI + ! COMPILER_BUG(wjs, 2014-12-01, pgi 14.7) With pgi 14.7, variables that are defined + ! in ozone_type (as opposed to ozone_base_type) get resized to 0 at some point at run + ! time. Presumably pgi isn't tracking the dynamic type information properly. I can't + ! find a workaround for this problem. I'm hopeful that it will be resolved in pgi 15. + ! (This is documented in bug 2094.) + call endrun(msg='Ozone code currently is not supported with PGI, due to a compiler bug& + & present in pgi14.7 and earlier') +#endif + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Allocate memory for ozone data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + call this%InitAllocateBase(bounds) + + allocate(this%o3uptakesha_patch(begp:endp)) ; this%o3uptakesha_patch(:) = nan + allocate(this%o3uptakesun_patch(begp:endp)) ; this%o3uptakesun_patch(:) = nan + allocate(this%tlai_old_patch(begp:endp)) ; this%tlai_old_patch(:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize ozone history variables + ! + ! !USES: + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + this%o3uptakesun_patch(begp:endp) = spval + call hist_addfld1d (fname='O3UPTAKESUN', units='mmol/m^2', & + avgflag='A', long_name='total ozone flux into sunlit leaves', & + ptr_patch=this%o3uptakesun_patch) + + this%o3uptakesha_patch(begp:endp) = spval + call hist_addfld1d (fname='O3UPTAKESHA', units='mmol/m^2', & + avgflag='A', long_name='total ozone flux into shaded leaves', & + ptr_patch=this%o3uptakesha_patch) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Perform cold-start initialization for ozone + ! + ! !ARGUMENTS: + class(ozone_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + + character(len=*), parameter :: subname = 'InitCold' + !----------------------------------------------------------------------- + + begp = bounds%begp + endp = bounds%endp + + call this%InitColdBase(bounds) + + this%o3uptakesha_patch(begp:endp) = 0._r8 + this%o3uptakesun_patch(begp:endp) = 0._r8 + this%tlai_old_patch(begp:endp) = 0._r8 + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Handle restart of ozone variables. + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_inqvdlen, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(ozone_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define' + ! + ! !LOCAL VARIABLES: + logical :: readvar + + character(len=*), parameter :: subname = 'Restart' + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='o3_tlaiold', xtype=ncd_double, & + dim1name='pft', & + long_name='one-sided leaf area index, from previous timestep, for ozone calculations', units='', & + readvar=readvar, interpinic_flag='interp', data=this%tlai_old_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3uptakesha', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone uptake for shaded leaves', units='mmol m^-3', & + readvar=readvar, interpinic_flag='interp', data=this%o3uptakesha_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3uptakesun', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone uptake for sunlit leaves', units='mmol m^-3', & + readvar=readvar, interpinic_flag='interp', data=this%o3uptakesun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3coefvsun', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone coefficient for photosynthesis for sunlit leaves', units='unitless', & + readvar=readvar, interpinic_flag='interp', data=this%o3coefvsun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3coefgsun', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone coefficient for stomatal conductance for sunlit leaves', units='unitless', & + readvar=readvar, interpinic_flag='interp', data=this%o3coefgsun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3coefvsha', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone coefficient for photosynthesis for shaded leaves', units='unitless', & + readvar=readvar, interpinic_flag='interp', data=this%o3coefvsha_patch) + + call restartvar(ncid=ncid, flag=flag, varname='o3coefgsha', xtype=ncd_double, & + dim1name='pft', & + long_name='ozone coefficient for stomatal conductance for shaded leaves', units='unitless', & + readvar=readvar, interpinic_flag='interp', data=this%o3coefgsha_patch) + + end subroutine Restart + + ! ======================================================================== + ! Science routines + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & + forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! !USES: + use PatchType , only : patch + ! + ! !ARGUMENTS: + class(ozone_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa) + real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K) + real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m) + real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m) + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) + real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m) + real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow + ! + ! !LOCAL VARIABLES: + integer :: fp ! filter index + integer :: p ! patch index + integer :: c ! column index + + character(len=*), parameter :: subname = 'CalcOzoneStress' + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(forc_pbot) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(forc_th) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rssun) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rssha) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rb) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(ram) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tlai) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + associate( & + o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef + o3coefgsun => this%o3coefgsun_patch , & ! Output: [real(r8) (:)] ozone coef + o3uptakesha => this%o3uptakesha_patch , & ! Output: [real(r8) (:)] ozone dose + o3uptakesun => this%o3uptakesun_patch , & ! Output: [real(r8) (:)] ozone dose + tlai_old => this%tlai_old_patch & ! Output: [real(r8) (:)] tlai from last time step + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + c = patch%column(p) + + ! Ozone stress for shaded leaves + call CalcOzoneStressOnePoint( & + forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), & + rs=rssha(p), rb=rb(p), ram=ram(p), & + tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), & + o3uptake=o3uptakesha(p), o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) + + ! Ozone stress for sunlit leaves + call CalcOzoneStressOnePoint( & + forc_ozone=forc_ozone, forc_pbot=forc_pbot(c), forc_th=forc_th(c), & + rs=rssun(p), rb=rb(p), ram=ram(p), & + tlai=tlai(p), tlai_old=tlai_old(p), pft_type=patch%itype(p), & + o3uptake=o3uptakesun(p), o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) + + tlai_old(p) = tlai(p) + + end do + + end associate + + end subroutine CalcOzoneStress + + !----------------------------------------------------------------------- + subroutine CalcOzoneStressOnePoint( & + forc_ozone, forc_pbot, forc_th, & + rs, rb, ram, & + tlai, tlai_old, pft_type, & + o3uptake, o3coefv, o3coefg) + ! + ! !DESCRIPTION: + ! Calculates ozone stress for a single point, for just sunlit or shaded leaves + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_RGAS + use pftconMod , only : pftcon + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + real(r8) , intent(in) :: forc_ozone ! ozone partial pressure (mol/mol) + real(r8) , intent(in) :: forc_pbot ! atmospheric pressure (Pa) + real(r8) , intent(in) :: forc_th ! atmospheric potential temperature (K) + real(r8) , intent(in) :: rs ! leaf stomatal resistance (s/m) + real(r8) , intent(in) :: rb ! boundary layer resistance (s/m) + real(r8) , intent(in) :: ram ! aerodynamical resistance (s/m) + real(r8) , intent(in) :: tlai ! one-sided leaf area index, no burying by snow + real(r8) , intent(in) :: tlai_old ! tlai from last time step + integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays + real(r8) , intent(inout) :: o3uptake ! ozone entering the leaf + real(r8) , intent(out) :: o3coefv ! ozone coefficient for photosynthesis (0 - 1) + real(r8) , intent(out) :: o3coefg ! ozone coefficient for conductance (0 - 1) + ! + ! !LOCAL VARIABLES: + integer :: dtime ! land model time step (sec) + real(r8) :: dtimeh ! time step in hours + real(r8) :: o3concnmolm3 ! o3 concentration (nmol/m^3) + real(r8) :: o3flux ! instantaneous o3 flux (nmol m^-2 s^-1) + real(r8) :: o3fluxcrit ! instantaneous o3 flux beyond threshold (nmol m^-2 s^-1) + real(r8) :: o3fluxperdt ! o3 flux per timestep (mmol m^-2) + real(r8) :: heal ! o3uptake healing rate based on % of new leaves growing (mmol m^-2) + real(r8) :: leafturn ! leaf turnover time / mortality rate (per hour) + real(r8) :: decay ! o3uptake decay rate based on leaf lifetime (mmol m^-2) + real(r8) :: photoInt ! intercept for photosynthesis + real(r8) :: photoSlope ! slope for photosynthesis + real(r8) :: condInt ! intercept for conductance + real(r8) :: condSlope ! slope for conductance + + character(len=*), parameter :: subname = 'CalcOzoneStressOnePoint' + !----------------------------------------------------------------------- + + ! convert o3 from mol/mol to nmol m^-3 + o3concnmolm3 = forc_ozone * 1.e9_r8 * (forc_pbot/(forc_th*SHR_CONST_RGAS*0.001_r8)) + + ! calculate instantaneous flux + o3flux = o3concnmolm3/ (ko3*rs+ rb + ram) + + ! apply o3 flux threshold + if (o3flux < o3_flux_threshold) then + o3fluxcrit = 0._r8 + else + o3fluxcrit = o3flux - o3_flux_threshold + endif + + dtime = get_step_size() + dtimeh = dtime / 3600._r8 + + ! calculate o3 flux per timestep + o3fluxperdt = o3fluxcrit * dtime * 0.000001_r8 + + if (tlai > lai_thresh) then + ! checking if new leaf area was added + if (tlai - tlai_old > 0) then + ! minimizing o3 damage to new leaves + heal = max(0._r8,(((tlai-tlai_old)/tlai)*o3fluxperdt)) + else + heal = 0._r8 + endif + + if (pftcon%evergreen(pft_type) == 1) then + leafturn = 1._r8/(pftcon%leaf_long(pft_type)*365._r8*24._r8) + else + leafturn = 0._r8 + endif + + ! o3 uptake decay based on leaf lifetime for evergreen plants + decay = o3uptake * leafturn * dtimeh + !cumulative uptake (mmol m^-2) + o3uptake = max(0._r8, o3uptake + o3fluxperdt - decay - heal) + + else + o3uptake = 0._r8 + end if + + + if (o3uptake == 0._r8) then + ! No o3 damage if no o3 uptake + o3coefv = 1._r8 + o3coefg = 1._r8 + else + ! Determine parameter values for this pft + ! TODO(wjs, 2014-10-01) Once these parameters are moved into the params file, this + ! logic can be removed. + if (pft_type>3) then + if (pftcon%woody(pft_type)==0) then + photoInt = nonwoodyPhotoInt + photoSlope = nonwoodyPhotoSlope + condInt = nonwoodyCondInt + condSlope = nonwoodyCondSlope + else + photoInt = broadleafPhotoInt + photoSlope = broadleafPhotoSlope + condInt = broadleafCondInt + condSlope = broadleafCondSlope + end if + else + photoInt = needleleafPhotoInt + photoSlope = needleleafPhotoSlope + condInt = needleleafCondInt + condSlope = needleleafCondSlope + end if + + ! Apply parameter values to compute o3 coefficients + o3coefv = max(0._r8, min(1._r8, photoInt + photoSlope * o3uptake)) + o3coefg = max(0._r8, min(1._r8, condInt + condSlope * o3uptake)) + + end if + + end subroutine CalcOzoneStressOnePoint + + +end module OzoneMod diff --git a/components/clm/src/biogeophys/OzoneOffMod.F90 b/components/clm/src/biogeophys/OzoneOffMod.F90 new file mode 100644 index 0000000000..4e2cb86666 --- /dev/null +++ b/components/clm/src/biogeophys/OzoneOffMod.F90 @@ -0,0 +1,115 @@ +module OzoneOffMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Provides an implementatio of ozone_base_type for the ozone-off case. Note that very + ! little needs to be done in this case, so this module mainly provides empty + ! implementations to satisfy the interface. + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use OzoneBaseMod, only : ozone_base_type + + implicit none + save + private + + ! !PUBLIC TYPES: + type, extends(ozone_base_type), public :: ozone_off_type + private + contains + procedure, public :: Init + procedure, public :: Restart + procedure, public :: CalcOzoneStress + end type ozone_off_type + + interface ozone_off_type + module procedure constructor + end interface ozone_off_type + +contains + + !----------------------------------------------------------------------- + function constructor() result(ozone_off) + ! + ! !DESCRIPTION: + ! Return an instance of ozone_off_type + ! + ! !USES: + ! + ! !ARGUMENTS: + type(ozone_off_type) :: ozone_off ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'constructor' + !----------------------------------------------------------------------- + + ! DO NOTHING (simply return a variable of the appropriate type) + + ! Eventually this should call the Init routine (or replace the Init routine + ! entirely). But I think it would be confusing to do that until we switch everything + ! to use a constructor rather than the init routine. + + end function constructor + + + subroutine Init(this, bounds) + class(ozone_off_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + + call this%InitAllocateBase(bounds) + call this%InitColdBase(bounds) + end subroutine Init + + subroutine Restart(this, bounds, ncid, flag) + use ncdio_pio , only : file_desc_t + + class(ozone_off_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read', 'write' or 'define' + + ! DO NOTHING + + end subroutine Restart + + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & + forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) + + class(ozone_off_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp ! number of points in filter_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) ! patch filter for non-snow-covered veg + real(r8) , intent(in) :: forc_pbot( bounds%begc: ) ! atmospheric pressure (Pa) + real(r8) , intent(in) :: forc_th( bounds%begc: ) ! atmospheric potential temperature (K) + real(r8) , intent(in) :: rssun( bounds%begp: ) ! leaf stomatal resistance, sunlit leaves (s/m) + real(r8) , intent(in) :: rssha( bounds%begp: ) ! leaf stomatal resistance, shaded leaves (s/m) + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) + real(r8) , intent(in) :: ram( bounds%begp: ) ! aerodynamical resistance (s/m) + real(r8) , intent(in) :: tlai( bounds%begp: ) ! one-sided leaf area index, no burying by snow + + ! Enforce expected array sizes (mainly so that a debug-mode threaded test with + ! ozone-off can pick up problems with the call to this routine) + SHR_ASSERT_ALL((ubound(forc_pbot) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(forc_th) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rssun) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rssha) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rb) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(ram) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tlai) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + ! Explicitly set outputs to 1. This isn't really needed, because they should still be + ! at 1 from cold-start initialization, but do this for clarity here. + + this%o3coefvsha_patch(bounds%begp:bounds%endp) = 1._r8 + this%o3coefvsun_patch(bounds%begp:bounds%endp) = 1._r8 + this%o3coefgsha_patch(bounds%begp:bounds%endp) = 1._r8 + this%o3coefgsun_patch(bounds%begp:bounds%endp) = 1._r8 + + end subroutine CalcOzoneStress + +end module OzoneOffMod diff --git a/components/clm/src/biogeophys/PhotosynthesisMod.F90 b/components/clm/src/biogeophys/PhotosynthesisMod.F90 new file mode 100644 index 0000000000..41e48ac35e --- /dev/null +++ b/components/clm/src/biogeophys/PhotosynthesisMod.F90 @@ -0,0 +1,1964 @@ +module PhotosynthesisMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use abortutils , only : endrun + use clm_varctl , only : use_c13, use_c14, use_cn, use_cndv, use_ed, use_luna + use clm_varctl , only : iulog + use clm_varpar , only : nlevcan + use clm_varcon , only : namep, c14ratio, spval + use decompMod , only : bounds_type + use QuadraticMod , only : quadratic + use pftconMod , only : pftcon + use C14BombSpikeMod , only : C14BombSpike, use_c14_bombspike + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use CNvegStateType , only : cnveg_state_type + use OzoneBaseMod , only : ozone_base_type + use LandunitType , only : lun + use PatchType , only : patch + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Photosynthesis ! Leaf stomatal resistance and leaf photosynthesis + public :: PhotosynthesisTotal ! Determine of total photosynthesis + public :: Fractionation ! C13 fractionation during photosynthesis + + ! !PRIVATE MEMBER FUNCTIONS: + private :: hybrid ! hybrid solver for ci + private :: ci_func ! ci function + private :: brent ! brent solver for root of a single variable function + private :: ft ! photosynthesis temperature response + private :: fth ! photosynthesis temperature inhibition + private :: fth25 ! scaling factor for photosynthesis temperature inhibition + + ! !PUBLIC VARIABLES: + type, public :: photosyns_type + + logical , pointer, private :: c3flag_patch (:) ! patch true if C3 and false if C4 + real(r8), pointer, private :: ac_patch (:,:) ! patch Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: aj_patch (:,:) ! patch RuBP-limited gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ap_patch (:,:) ! patch product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: ag_patch (:,:) ! patch co-limited gross leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: an_patch (:,:) ! patch net leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: vcmax_z_patch (:,:) ! patch maximum rate of carboxylation (umol co2/m**2/s) + real(r8), pointer, private :: cp_patch (:) ! patch CO2 compensation point (Pa) + real(r8), pointer, private :: kc_patch (:) ! patch Michaelis-Menten constant for CO2 (Pa) + real(r8), pointer, private :: ko_patch (:) ! patch Michaelis-Menten constant for O2 (Pa) + real(r8), pointer, private :: qe_patch (:) ! patch quantum efficiency, used only for C4 (mol CO2 / mol photons) + real(r8), pointer, private :: tpu_z_patch (:,:) ! patch triose phosphate utilization rate (umol CO2/m**2/s) + real(r8), pointer, private :: kp_z_patch (:,:) ! patch initial slope of CO2 response curve (C4 plants) + real(r8), pointer, private :: theta_cj_patch (:) ! patch empirical curvature parameter for ac, aj photosynthesis co-limitation + real(r8), pointer, private :: bbb_patch (:) ! patch Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + real(r8), pointer, private :: mbb_patch (:) ! patch Ball-Berry slope of conductance-photosynthesis relationship + real(r8), pointer, private :: gs_mol_patch (:,:) ! patch leaf stomatal conductance (umol H2O/m**2/s) + real(r8), pointer, private :: gb_mol_patch (:) ! patch leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), pointer, private :: rh_leaf_patch (:) ! patch fractional humidity at leaf surface (dimensionless) + + real(r8), pointer, private :: alphapsnsun_patch (:) ! patch sunlit 13c fractionation ([]) + real(r8), pointer, private :: alphapsnsha_patch (:) ! patch shaded 13c fractionation ([]) + + real(r8), pointer, public :: rc13_canair_patch (:) ! patch C13O2/C12O2 in canopy air + real(r8), pointer, public :: rc13_psnsun_patch (:) ! patch C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer, public :: rc13_psnsha_patch (:) ! patch C13O2/C12O2 in shaded canopy psn flux + + real(r8), pointer, public :: psnsun_patch (:) ! patch sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: psnsha_patch (:) ! patch shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, public :: c13_psnsun_patch (:) ! patch c13 sunlit leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c13_psnsha_patch (:) ! patch c13 shaded leaf photosynthesis (umol 13CO2/m**2/s) + real(r8), pointer, public :: c14_psnsun_patch (:) ! patch c14 sunlit leaf photosynthesis (umol 14CO2/m**2/s) + real(r8), pointer, public :: c14_psnsha_patch (:) ! patch c14 shaded leaf photosynthesis (umol 14CO2/m**2/s) + + real(r8), pointer, private :: psnsun_z_patch (:,:) ! patch canopy layer: sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_z_patch (:,:) ! patch canopy layer: shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wc_patch (:) ! patch Rubsico-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wc_patch (:) ! patch Rubsico-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wj_patch (:) ! patch RuBP-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wj_patch (:) ! patch RuBP-limited shaded leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsun_wp_patch (:) ! patch product-limited sunlit leaf photosynthesis (umol CO2/m**2/s) + real(r8), pointer, private :: psnsha_wp_patch (:) ! patch product-limited shaded leaf photosynthesis (umol CO2/m**2/s) + + real(r8), pointer, public :: fpsn_patch (:) ! patch photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wc_patch (:) ! patch Rubisco-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wj_patch (:) ! patch RuBP-limited photosynthesis (umol CO2/m**2 ground/s) + real(r8), pointer, private :: fpsn_wp_patch (:) ! patch product-limited photosynthesis (umol CO2/m**2 ground/s) + + real(r8), pointer, public :: lnca_patch (:) ! top leaf layer leaf N concentration (gN leaf/m^2) + + real(r8), pointer, public :: lmrsun_patch (:) ! patch sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, public :: lmrsha_patch (:) ! patch shaded leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsun_z_patch (:,:) ! patch canopy layer: sunlit leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), pointer, private :: lmrsha_z_patch (:,:) ! patch canopy layer: shaded leaf maintenance respiration rate (umol CO2/m**2/s) + + real(r8), pointer, public :: cisun_z_patch (:,:) ! patch intracellular sunlit leaf CO2 (Pa) + real(r8), pointer, public :: cisha_z_patch (:,:) ! patch intracellular shaded leaf CO2 (Pa) + + real(r8), pointer, private :: rssun_z_patch (:,:) ! patch canopy layer: sunlit leaf stomatal resistance (s/m) + real(r8), pointer, private :: rssha_z_patch (:,:) ! patch canopy layer: shaded leaf stomatal resistance (s/m) + real(r8), pointer, public :: rssun_patch (:) ! patch sunlit stomatal resistance (s/m) + real(r8), pointer, public :: rssha_patch (:) ! patch shaded stomatal resistance (s/m) + + ! ED specific variables + real(r8), pointer, public :: psncanopy_patch (:) ! patch sunlit leaf photosynthesis (umol CO2 /m**2/ s) (ED specific) + real(r8), pointer, public :: lmrcanopy_patch (:) ! sunlit leaf maintenance respiration rate (umol CO2/m**2/s) (ED specific) + + ! LUNA specific variables + real(r8), pointer, public :: vcmx25_z_patch (:,:) ! patch leaf Vc,max25 (umol CO2/m**2/s) for canopy layer + real(r8), pointer, public :: jmx25_z_patch (:,:) ! patch leaf Jmax25 (umol electron/m**2/s) for canopy layer + real(r8), pointer, public :: pnlc_z_patch (:,:) ! patch proportion of leaf nitrogen allocated for light capture for canopy layer + real(r8), pointer, public :: enzs_z_patch (:,:) ! enzyme decay status 1.0-fully active; 0-all decayed during stress + real(r8), pointer, public :: fpsn24_patch (:) ! 24 hour mean patch photosynthesis (umol CO2/m**2 ground/day) + contains + + ! Public procedures + procedure, public :: Init + procedure, public :: Restart + procedure, public :: TimeStepInit + procedure, public :: NewPatchInit + + ! Private procedures + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type photosyns_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate (bounds) + call this%InitHistory (bounds) + call this%InitCold (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%c3flag_patch (begp:endp)) ; this%c3flag_patch (:) =.false. + allocate(this%ac_patch (begp:endp,1:nlevcan)) ; this%ac_patch (:,:) = nan + allocate(this%aj_patch (begp:endp,1:nlevcan)) ; this%aj_patch (:,:) = nan + allocate(this%ap_patch (begp:endp,1:nlevcan)) ; this%ap_patch (:,:) = nan + allocate(this%ag_patch (begp:endp,1:nlevcan)) ; this%ag_patch (:,:) = nan + allocate(this%an_patch (begp:endp,1:nlevcan)) ; this%an_patch (:,:) = nan + allocate(this%vcmax_z_patch (begp:endp,1:nlevcan)) ; this%vcmax_z_patch (:,:) = nan + allocate(this%cp_patch (begp:endp)) ; this%cp_patch (:) = nan + allocate(this%kc_patch (begp:endp)) ; this%kc_patch (:) = nan + allocate(this%ko_patch (begp:endp)) ; this%ko_patch (:) = nan + allocate(this%qe_patch (begp:endp)) ; this%qe_patch (:) = nan + allocate(this%tpu_z_patch (begp:endp,1:nlevcan)) ; this%tpu_z_patch (:,:) = nan + allocate(this%kp_z_patch (begp:endp,1:nlevcan)) ; this%kp_z_patch (:,:) = nan + allocate(this%theta_cj_patch (begp:endp)) ; this%theta_cj_patch (:) = nan + allocate(this%bbb_patch (begp:endp)) ; this%bbb_patch (:) = nan + allocate(this%mbb_patch (begp:endp)) ; this%mbb_patch (:) = nan + allocate(this%gb_mol_patch (begp:endp)) ; this%gb_mol_patch (:) = nan + allocate(this%gs_mol_patch (begp:endp,1:nlevcan)) ; this%gs_mol_patch (:,:) = nan + allocate(this%rh_leaf_patch (begp:endp)) ; this%rh_leaf_patch (:) = nan + + allocate(this%psnsun_patch (begp:endp)) ; this%psnsun_patch (:) = nan + allocate(this%psnsha_patch (begp:endp)) ; this%psnsha_patch (:) = nan + allocate(this%c13_psnsun_patch (begp:endp)) ; this%c13_psnsun_patch (:) = nan + allocate(this%c13_psnsha_patch (begp:endp)) ; this%c13_psnsha_patch (:) = nan + allocate(this%c14_psnsun_patch (begp:endp)) ; this%c14_psnsun_patch (:) = nan + allocate(this%c14_psnsha_patch (begp:endp)) ; this%c14_psnsha_patch (:) = nan + + allocate(this%psnsun_z_patch (begp:endp,1:nlevcan)) ; this%psnsun_z_patch (:,:) = nan + allocate(this%psnsha_z_patch (begp:endp,1:nlevcan)) ; this%psnsha_z_patch (:,:) = nan + allocate(this%psnsun_wc_patch (begp:endp)) ; this%psnsun_wc_patch (:) = nan + allocate(this%psnsha_wc_patch (begp:endp)) ; this%psnsha_wc_patch (:) = nan + allocate(this%psnsun_wj_patch (begp:endp)) ; this%psnsun_wj_patch (:) = nan + allocate(this%psnsha_wj_patch (begp:endp)) ; this%psnsha_wj_patch (:) = nan + allocate(this%psnsun_wp_patch (begp:endp)) ; this%psnsun_wp_patch (:) = nan + allocate(this%psnsha_wp_patch (begp:endp)) ; this%psnsha_wp_patch (:) = nan + allocate(this%fpsn_patch (begp:endp)) ; this%fpsn_patch (:) = nan + allocate(this%fpsn_wc_patch (begp:endp)) ; this%fpsn_wc_patch (:) = nan + allocate(this%fpsn_wj_patch (begp:endp)) ; this%fpsn_wj_patch (:) = nan + allocate(this%fpsn_wp_patch (begp:endp)) ; this%fpsn_wp_patch (:) = nan + + allocate(this%lnca_patch (begp:endp)) ; this%lnca_patch (:) = nan + + allocate(this%lmrsun_z_patch (begp:endp,1:nlevcan)) ; this%lmrsun_z_patch (:,:) = nan + allocate(this%lmrsha_z_patch (begp:endp,1:nlevcan)) ; this%lmrsha_z_patch (:,:) = nan + allocate(this%lmrsun_patch (begp:endp)) ; this%lmrsun_patch (:) = nan + allocate(this%lmrsha_patch (begp:endp)) ; this%lmrsha_patch (:) = nan + + allocate(this%alphapsnsun_patch (begp:endp)) ; this%alphapsnsun_patch (:) = nan + allocate(this%alphapsnsha_patch (begp:endp)) ; this%alphapsnsha_patch (:) = nan + allocate(this%rc13_canair_patch (begp:endp)) ; this%rc13_canair_patch (:) = nan + allocate(this%rc13_psnsun_patch (begp:endp)) ; this%rc13_psnsun_patch (:) = nan + allocate(this%rc13_psnsha_patch (begp:endp)) ; this%rc13_psnsha_patch (:) = nan + + allocate(this%cisun_z_patch (begp:endp,1:nlevcan)) ; this%cisun_z_patch (:,:) = nan + allocate(this%cisha_z_patch (begp:endp,1:nlevcan)) ; this%cisha_z_patch (:,:) = nan + + allocate(this%rssun_z_patch (begp:endp,1:nlevcan)) ; this%rssun_z_patch (:,:) = nan + allocate(this%rssha_z_patch (begp:endp,1:nlevcan)) ; this%rssha_z_patch (:,:) = nan + allocate(this%rssun_patch (begp:endp)) ; this%rssun_patch (:) = nan + allocate(this%rssha_patch (begp:endp)) ; this%rssha_patch (:) = nan + + allocate(this%psncanopy_patch (begp:endp)) ; this%psncanopy_patch (:) = nan + allocate(this%lmrcanopy_patch (begp:endp)) ; this%lmrcanopy_patch (:) = nan + if(use_luna)then + allocate(this%vcmx25_z_patch (begp:endp,1:nlevcan)) ; this%vcmx25_z_patch (:,:) = 30._r8 + allocate(this%jmx25_z_patch (begp:endp,1:nlevcan)) ; this%jmx25_z_patch (:,:) = 60._r8 + allocate(this%pnlc_z_patch (begp:endp,1:nlevcan)) ; this%pnlc_z_patch (:,:) = 0.01_r8 + allocate(this%fpsn24_patch (begp:endp)) ; this%fpsn24_patch (:) = nan + allocate(this%enzs_z_patch (begp:endp,1:nlevcan)) ; this%enzs_z_patch (:,:) = 1._r8 + endif + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + + this%rh_leaf_patch(begp:endp) = spval + call hist_addfld1d (fname='RH_LEAF', units='fraction', & + avgflag='A', long_name='fractional humidity at leaf surface', & + ptr_patch=this%rh_leaf_patch, set_spec=spval, default='inactive') + + this%fpsn_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN', units='umol/m2s', & + avgflag='A', long_name='photosynthesis', & + ptr_patch=this%fpsn_patch, set_lake=0._r8, set_urb=0._r8) + + this%fpsn_wc_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WC', units='umol/m2s', & + avgflag='A', long_name='Rubisco-limited photosynthesis', & + ptr_patch=this%fpsn_wc_patch, set_lake=0._r8, set_urb=0._r8) + + this%fpsn_wj_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WJ', units='umol/m2s', & + avgflag='A', long_name='RuBP-limited photosynthesis', & + ptr_patch=this%fpsn_wj_patch, set_lake=0._r8, set_urb=0._r8) + + this%fpsn_wp_patch(begp:endp) = spval + call hist_addfld1d (fname='FPSN_WP', units='umol/m2s', & + avgflag='A', long_name='Product-limited photosynthesis', & + ptr_patch=this%fpsn_wp_patch, set_lake=0._r8, set_urb=0._r8) + + if (use_cn) then + this%psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='sunlit leaf photosynthesis', & + ptr_patch=this%psnsun_patch) + + this%psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='shaded leaf photosynthesis', & + ptr_patch=this%psnsha_patch) + end if + + if ( use_c13 ) then + this%c13_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 sunlit leaf photosynthesis', & + ptr_patch=this%c13_psnsun_patch) + + this%c13_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='C13_PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 shaded leaf photosynthesis', & + ptr_patch=this%c13_psnsha_patch) + end if + + if ( use_c14 ) then + this%c14_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='C14 sunlit leaf photosynthesis', & + ptr_patch=this%c14_psnsun_patch) + + this%c14_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='C14_PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='C14 shaded leaf photosynthesis', & + ptr_patch=this%c14_psnsha_patch) + end if + + if ( use_c13 ) then + this%rc13_canair_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_CANAIR', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for canopy air', & + ptr_patch=this%rc13_canair_patch) + + this%rc13_psnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_PSNSUN', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for sunlit photosynthesis', & + ptr_patch=this%rc13_psnsun_patch) + + this%rc13_psnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='RC13_PSNSHA', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for shaded photosynthesis', & + ptr_patch=this%rc13_psnsha_patch) + endif + + ! Canopy physiology + + if ( use_c13 ) then + this%alphapsnsun_patch(begp:endp) = spval + call hist_addfld1d (fname='ALPHAPSNSUN', units='proportion', & + avgflag='A', long_name='sunlit c13 fractionation', & + ptr_patch=this%alphapsnsun_patch, default='inactive') + + this%alphapsnsha_patch(begp:endp) = spval + call hist_addfld1d (fname='ALPHAPSNSHA', units='proportion', & + avgflag='A', long_name='shaded c13 fractionation', & + ptr_patch=this%alphapsnsha_patch, default='inactive') + endif + + this%rssun_patch(begp:endp) = spval + call hist_addfld1d (fname='RSSUN', units='s/m', & + avgflag='M', long_name='sunlit leaf stomatal resistance', & + ptr_patch=this%rssun_patch, set_lake=spval, set_urb=spval, default='inactive') + + this%rssha_patch(begp:endp) = spval + call hist_addfld1d (fname='RSSHA', units='s/m', & + avgflag='M', long_name='shaded leaf stomatal resistance', & + ptr_patch=this%rssha_patch, set_lake=spval, set_urb=spval, default='inactive') + + if(use_luna)then + if(nlevcan>1)then + call hist_addfld2d (fname='Vcmx25Z', units='umol/m2/s', type2d='nlevcan', & + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=this%vcmx25_z_patch,default='inactive') + + call hist_addfld2d (fname='Jmx25Z', units='umol/m2/s', type2d='nlevcan', & + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=this%jmx25_z_patch,default='inactive') + + call hist_addfld2d (fname='PNLCZ', units='unitless', type2d='nlevcan', & + avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & + ptr_patch=this%pnlc_z_patch,default='inactive') + else + ptr_1d => this%vcmx25_z_patch(:,1) + call hist_addfld1d (fname='Vcmx25Z', units='umol/m2/s',& + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=ptr_1d,default='inactive') + ptr_1d => this%jmx25_z_patch(:,1) + call hist_addfld1d (fname='Jmx25Z', units='umol/m2/s',& + avgflag='A', long_name='canopy profile of vcmax25 predicted by LUNA model', & + ptr_patch=ptr_1d,default='inactive') + ptr_1d => this%pnlc_z_patch(:,1) + call hist_addfld1d (fname='PNLCZ', units='unitless', & + avgflag='A', long_name='Proportion of nitrogen allocated for light capture', & + ptr_patch=ptr_1d,default='inactive') + + endif + this%fpsn24_patch = spval + call hist_addfld1d (fname='FPSN24', units='umol CO2/m**2 ground/day',& + avgflag='A', long_name='24 hour accumulative patch photosynthesis starting from mid-night', & + ptr_patch=this%fpsn24_patch,default='inactive') + + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + l = patch%landunit(p) + + this%lmrcanopy_patch(p) = 0.0_r8 + + this%alphapsnsun_patch(p) = spval + this%alphapsnsha_patch(p) = spval + + if (lun%ifspecial(l)) then + this%psnsun_patch(p) = 0._r8 + this%psnsha_patch(p) = 0._r8 + if ( use_c13 ) then + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + endif + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + endif + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + if ( use_c13 ) then + call restartvar(ncid=ncid, flag=flag, varname='rc13_canair', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_canair_patch) + + call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsun', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsun_patch) + + call restartvar(ncid=ncid, flag=flag, varname='rc13_psnsha', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rc13_psnsha_patch) + endif + + if(use_luna) then + call restartvar(ncid=ncid, flag=flag, varname='vcmx25_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%vcmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='jmx25_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Maximum carboxylation rate at 25 celcius for canopy layers', units='umol CO2/m**2/s', & + interpinic_flag='interp', readvar=readvar, data=this%jmx25_z_patch) + call restartvar(ncid=ncid, flag=flag, varname='pnlc_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='proportion of leaf nitrogen allocated for light capture', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%pnlc_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='enzs_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='enzyme decay status during stress: 1.0-fully active; 0.0-all decayed', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%enzs_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='gpp24', xtype=ncd_double, & + dim1name='pft', long_name='accumulative gross primary production', units='umol CO2/m**2 ground/day', & + interpinic_flag='interp', readvar=readvar, data=this%fpsn24_patch) + endif + + end subroutine Restart + + !------------------------------------------------------------------------------ + subroutine TimeStepInit (this, bounds) + ! + ! Time step initialization + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop, istice, istice_mec, istwet + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l ! indices + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + l = patch%landunit(p) + if (.not. lun%lakpoi(l)) then + this%psnsun_patch(p) = 0._r8 + this%psnsun_wc_patch(p) = 0._r8 + this%psnsun_wj_patch(p) = 0._r8 + this%psnsun_wp_patch(p) = 0._r8 + + this%psnsha_patch(p) = 0._r8 + this%psnsha_wc_patch(p) = 0._r8 + this%psnsha_wj_patch(p) = 0._r8 + this%psnsha_wp_patch(p) = 0._r8 + + this%fpsn_patch(p) = 0._r8 + this%fpsn_wc_patch(p) = 0._r8 + this%fpsn_wj_patch(p) = 0._r8 + this%fpsn_wp_patch(p) = 0._r8 + + if ( use_c13 ) then + this%alphapsnsun_patch(p) = 0._r8 + this%alphapsnsha_patch(p) = 0._r8 + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + endif + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + endif + end if + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop & + .or. lun%itype(l) == istice .or. lun%itype(l) == istice_mec & + .or. lun%itype(l) == istwet) then + if (use_c13) then + this%rc13_canair_patch(p) = 0._r8 + this%rc13_psnsun_patch(p) = 0._r8 + this%rc13_psnsha_patch(p) = 0._r8 + end if + end if + end do + + end subroutine TimeStepInit + + !------------------------------------------------------------------------------ + subroutine NewPatchInit (this, p) + ! + ! For new run-time pft, modify state and flux variables to maintain + ! carbon and nitrogen balance with dynamic pft-weights. + ! Called from dyn_cnbal_patch + ! + ! !ARGUMENTS: + class(photosyns_type) :: this + integer, intent(in) :: p + !----------------------------------------------------------------------- + + if ( use_c13 ) then + this%alphapsnsun_patch(p) = 0._r8 + this%alphapsnsha_patch(p) = 0._r8 + this%rc13_canair_patch(p) = 0._r8 + this%rc13_psnsun_patch(p) = 0._r8 + this%rc13_psnsha_patch(p) = 0._r8 + endif + + this%psnsun_patch(p) = 0._r8 + this%psnsha_patch(p) = 0._r8 + + if (use_c13) then + this%c13_psnsun_patch(p) = 0._r8 + this%c13_psnsha_patch(p) = 0._r8 + end if + if ( use_c14 ) then + this%c14_psnsun_patch(p) = 0._r8 + this%c14_psnsha_patch(p) = 0._r8 + end if + + end subroutine NewPatchInit + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine Photosynthesis ( bounds, fn, filterp, & + esat_tv, eair, oair, cair, rb, btran, & + dayl_factor, atm2lnd_inst, temperature_inst, surfalb_inst, solarabs_inst, & + canopystate_inst, ozone_inst, photosyns_inst, cnveg_nitrogenstate_inst, phase) + ! + ! !DESCRIPTION: + ! Leaf photosynthesis and stomatal conductance calculation as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy + ! + ! !USES: + use clm_varcon , only : rgas, tfrz + use clm_varctl , only : cnallocate_carbon_only + use clm_varctl , only : lnc_opt, reduce_dayl_factor, vcmax_opt + use pftconMod , only : nbrdlf_dcd_tmp_shrub, npcropmin + + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + real(r8) , intent(in) :: esat_tv( bounds%begp: ) ! saturation vapor pressure at t_veg (Pa) [pft] + real(r8) , intent(in) :: eair( bounds%begp: ) ! vapor pressure of canopy air (Pa) [pft] + real(r8) , intent(in) :: oair( bounds%begp: ) ! Atmospheric O2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: cair( bounds%begp: ) ! Atmospheric CO2 partial pressure (Pa) [pft] + real(r8) , intent(in) :: rb( bounds%begp: ) ! boundary layer resistance (s/m) [pft] + real(r8) , intent(in) :: btran( bounds%begp: ) ! transpiration wetness factor (0 to 1) [pft] + real(r8) , intent(in) :: dayl_factor( bounds%begp: ) ! scalar (0-1) for daylength + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(temperature_type) , intent(in) :: temperature_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(canopystate_type) , intent(in) :: canopystate_inst + class(ozone_base_type) , intent(in) :: ozone_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + character(len=*) , intent(in) :: phase ! 'sun' or 'sha' + + ! + ! !LOCAL VARIABLES: + ! + ! Leaf photosynthesis parameters + real(r8) :: jmax_z(bounds%begp:bounds%endp,nlevcan) ! maximum electron transport rate (umol electrons/m**2/s) + !real(r8) :: lnc(bounds%begp:bounds%endp) ! leaf N concentration (gN leaf/m^2) + real(r8) :: bbbopt(bounds%begp:bounds%endp)! Ball-Berry minimum leaf conductance, unstressed (umol H2O/m**2/s) + real(r8) :: mbbopt(bounds%begp:bounds%endp)! Ball-Berry slope of conductance-photosynthesis relationship, unstressed + real(r8) :: kn(bounds%begp:bounds%endp) ! leaf nitrogen decay coefficient + real(r8) :: vcmax25top ! canopy top: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25top ! canopy top: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25top ! canopy top: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25top ! canopy top: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25top ! canopy top: initial slope of CO2 response curve (C4 plants) at 25C + + real(r8) :: vcmax25 ! leaf layer: maximum rate of carboxylation at 25C (umol CO2/m**2/s) + real(r8) :: jmax25 ! leaf layer: maximum electron transport rate at 25C (umol electrons/m**2/s) + real(r8) :: tpu25 ! leaf layer: triose phosphate utilization rate at 25C (umol CO2/m**2/s) + real(r8) :: lmr25 ! leaf layer: leaf maintenance respiration rate at 25C (umol CO2/m**2/s) + real(r8) :: kp25 ! leaf layer: Initial slope of CO2 response curve (C4 plants) at 25C + real(r8) :: kc25 ! Michaelis-Menten constant for CO2 at 25C (Pa) + real(r8) :: ko25 ! Michaelis-Menten constant for O2 at 25C (Pa) + real(r8) :: cp25 ! CO2 compensation point at 25C (Pa) + + real(r8) :: vcmaxha ! activation energy for vcmax (J/mol) + real(r8) :: jmaxha ! activation energy for jmax (J/mol) + real(r8) :: tpuha ! activation energy for tpu (J/mol) + real(r8) :: lmrha ! activation energy for lmr (J/mol) + real(r8) :: kcha ! activation energy for kc (J/mol) + real(r8) :: koha ! activation energy for ko (J/mol) + real(r8) :: cpha ! activation energy for cp (J/mol) + + real(r8) :: vcmaxhd ! deactivation energy for vcmax (J/mol) + real(r8) :: jmaxhd ! deactivation energy for jmax (J/mol) + real(r8) :: tpuhd ! deactivation energy for tpu (J/mol) + real(r8) :: lmrhd ! deactivation energy for lmr (J/mol) + + real(r8) :: vcmaxse ! entropy term for vcmax (J/mol/K) + real(r8) :: jmaxse ! entropy term for jmax (J/mol/K) + real(r8) :: tpuse ! entropy term for tpu (J/mol/K) + real(r8) :: lmrse ! entropy term for lmr (J/mol/K) + + real(r8) :: vcmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: jmaxc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: tpuc ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: lmrc ! scaling factor for high temperature inhibition (25 C = 1.0) + + real(r8) :: fnps ! fraction of light absorbed by non-photosynthetic pigments + real(r8) :: theta_psii ! empirical curvature parameter for electron transport rate + + real(r8) :: theta_ip ! empirical curvature parameter for ap photosynthesis co-limitation + + ! Other + integer :: f,p,c,iv ! indices + real(r8) :: cf ! s m**2/umol -> s/m + real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: gb ! leaf boundary layer conductance (m/s) + real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) + real(r8) :: gs ! leaf stomatal conductance (m/s) + real(r8) :: hs ! fractional humidity at leaf surface (dimensionless) + real(r8) :: sco ! relative specificity of rubisco + real(r8) :: ft ! photosynthesis temperature response (statement function) + real(r8) :: fth ! photosynthesis temperature inhibition (statement function) + real(r8) :: fth25 ! ccaling factor for photosynthesis temperature inhibition (statement function) + real(r8) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8) :: ha ! activation energy in photosynthesis temperature function (J/mol) + real(r8) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) + real(r8) :: ciold ! previous value of Ci for convergence check + real(r8) :: gs_mol_err ! gs_mol for error check + real(r8) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8) :: qabs ! PAR absorbed by PS II (umol photons/m**2/s) + real(r8) :: aquad,bquad,cquad ! terms for quadratic equations + real(r8) :: r1,r2 ! roots of quadratic equation + real(r8) :: ceair ! vapor pressure of air, constrained (Pa) + real(r8) :: fnr ! (gRubisco/gN in Rubisco) + real(r8) :: act25 ! (umol/mgRubisco/min) Rubisco activity at 25 C + integer :: niter ! iteration loop index + real(r8) :: nscaler ! leaf nitrogen scaling coefficient + + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + + real(r8) :: psn_wc_z(bounds%begp:bounds%endp,nlevcan) ! Rubisco-limited contribution to psn_z (umol CO2/m**2/s) + real(r8) :: psn_wj_z(bounds%begp:bounds%endp,nlevcan) ! RuBP-limited contribution to psn_z (umol CO2/m**2/s) + real(r8) :: psn_wp_z(bounds%begp:bounds%endp,nlevcan) ! product-limited contribution to psn_z (umol CO2/m**2/s) + + real(r8) :: psncan ! canopy sum of psn_z + real(r8) :: psncan_wc ! canopy sum of psn_wc_z + real(r8) :: psncan_wj ! canopy sum of psn_wj_z + real(r8) :: psncan_wp ! canopy sum of psn_wp_z + real(r8) :: lmrcan ! canopy sum of lmr_z + real(r8) :: gscan ! canopy sum of leaf conductance + real(r8) :: laican ! canopy sum of lai_z + real(r8) :: rh_can + + real(r8) , pointer :: lai_z (:,:) + real(r8) , pointer :: par_z (:,:) + real(r8) , pointer :: vcmaxcint (:) + real(r8) , pointer :: alphapsn (:) + real(r8) , pointer :: psn (:) + real(r8) , pointer :: psn_wc (:) + real(r8) , pointer :: psn_wj (:) + real(r8) , pointer :: psn_wp (:) + real(r8) , pointer :: psn_z (:,:) + real(r8) , pointer :: lmr (:) + real(r8) , pointer :: lmr_z (:,:) + real(r8) , pointer :: rs (:) + real(r8) , pointer :: rs_z (:,:) + real(r8) , pointer :: ci_z (:,:) + real(r8) , pointer :: o3coefv (:) ! o3 coefficient used in photo calculation + real(r8) , pointer :: o3coefg (:) ! o3 coefficient used in rs calculation + real(r8) , pointer :: alphapsnsun (:) + real(r8) , pointer :: alphapsnsha (:) + + !integer :: lnc_opt + !integer :: reduce_dayl_factor + !integer :: vcmax_opt + real(r8) :: sum_nscaler + real(r8) :: total_lai + integer :: nptreemax + !------------------------------------------------------------------------------ + + ! Temperature and soil water response functions + + ft(tl,ha) = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + fth(tl,hd,se,scaleFactor) = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + fth25(hd,se) = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + + ! Enforce expected array sizes + + SHR_ASSERT_ALL((ubound(esat_tv) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(eair) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(oair) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(cair) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rb) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(btran) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dayl_factor) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + associate( & + c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 + leafcn => pftcon%leafcn , & ! Input: leaf C:N (gC/gN) + flnr => pftcon%flnr , & ! Input: fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + fnitr => pftcon%fnitr , & ! Input: foliage nitrogen limitation factor (-) + slatop => pftcon%slatop , & ! Input: specific leaf area at top of canopy, projected area basis [m^2/gC] + i_vc => pftcon%i_vc , & ! Input: [real(r8) (:) ] + s_vc => pftcon%s_vc , & ! Input: [real(r8) (:) ] + i_vca => pftcon%i_vca , & ! Input: [real(r8) (:) ] + s_vca => pftcon%s_vca , & ! Input: [real(r8) (:) ] + i_vcad => pftcon%i_vcad , & ! Input: [real(r8) (:) ] + s_vcad => pftcon%s_vcad , & ! Input: [real(r8) (:) ] + i_flnr => pftcon%i_flnr , & ! Input: [real(r8) (:) ] + s_flnr => pftcon%s_flnr , & ! Input: [real(r8) (:) ] + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:) ] (gN/m2) leaf N + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) + tgcm => temperature_inst%thm_patch , & ! Input: [real(r8) (:) ] air temperature at agcm reference height (kelvin) + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] pft number of canopy layers, above snow for radiative transfer + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] pft total leaf area index for canopy layer + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8)(:) ] one-sided leaf area index, no burying by snow + vcmx25_z => photosyns_inst%vcmx25_z_patch , & ! Input: [real(r8) (:,:) ] Vc,max25 (umol co2 /m**2/ s) [always +] + jmx25_z => photosyns_inst%jmx25_z_patch , & ! Input: [real(r8) (:,:) ] Jmax25 (umol electron /m**2/ s) [always +] + + c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 + ac => photosyns_inst%ac_patch , & ! Output: [real(r8) (:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_patch , & ! Output: [real(r8) (:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_patch , & ! Output: [real(r8) (:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_patch , & ! Output: [real(r8) (:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + an => photosyns_inst%an_patch , & ! Output: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + gb_mol => photosyns_inst%gb_mol_patch , & ! Output: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) + gs_mol => photosyns_inst%gs_mol_patch , & ! Output: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_patch , & ! Output: [real(r8) (:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + tpu_z => photosyns_inst%tpu_z_patch , & ! Output: [real(r8) (:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_patch , & ! Output: [real(r8) (:,:) ] initial slope of CO2 response curve (C4 plants) + theta_cj => photosyns_inst%theta_cj_patch , & ! Output: [real(r8) (:) ] empirical curvature parameter for ac, aj photosynthesis co-limitation + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + rh_leaf => photosyns_inst%rh_leaf_patch , & ! Output: [real(r8) (:) ] fractional humidity at leaf surface (dimensionless) + lnc => photosyns_inst%lnca_patch & ! Output: [real(r8) (:) ] top leaf layer leaf N concentration (gN leaf/m^2) + ) + + if (phase == 'sun') then + par_z => solarabs_inst%parsun_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z => canopystate_inst%laisun_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint => surfalb_inst%vcmaxcintsun_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn => photosyns_inst%alphapsnsun_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv => ozone_inst%o3coefvsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg => ozone_inst%o3coefgsun_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z => photosyns_inst%cisun_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs => photosyns_inst%rssun_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z => photosyns_inst%rssun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr => photosyns_inst%lmrsun_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z => photosyns_inst%lmrsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn => photosyns_inst%psnsun_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z => photosyns_inst%psnsun_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc => photosyns_inst%psnsun_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj => photosyns_inst%psnsun_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp => photosyns_inst%psnsun_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + else if (phase == 'sha') then + par_z => solarabs_inst%parsha_z_patch ! Input: [real(r8) (:,:) ] par absorbed per unit lai for canopy layer (w/m**2) + lai_z => canopystate_inst%laisha_z_patch ! Input: [real(r8) (:,:) ] leaf area index for canopy layer, sunlit or shaded + vcmaxcint => surfalb_inst%vcmaxcintsha_patch ! Input: [real(r8) (:) ] leaf to canopy scaling coefficient + alphapsn => photosyns_inst%alphapsnsha_patch ! Input: [real(r8) (:) ] 13C fractionation factor for PSN () + o3coefv => ozone_inst%o3coefvsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in photosynthesis calculation + o3coefg => ozone_inst%o3coefgsha_patch ! Input: [real(r8) (:) ] O3 coefficient used in rs calculation + ci_z => photosyns_inst%cisha_z_patch ! Output: [real(r8) (:,:) ] intracellular leaf CO2 (Pa) + rs => photosyns_inst%rssha_patch ! Output: [real(r8) (:) ] leaf stomatal resistance (s/m) + rs_z => photosyns_inst%rssha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf stomatal resistance (s/m) + lmr => photosyns_inst%lmrsha_patch ! Output: [real(r8) (:) ] leaf maintenance respiration rate (umol CO2/m**2/s) + lmr_z => photosyns_inst%lmrsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + psn => photosyns_inst%psnsha_patch ! Output: [real(r8) (:) ] foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_z => photosyns_inst%psnsha_z_patch ! Output: [real(r8) (:,:) ] canopy layer: foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wc => photosyns_inst%psnsha_wc_patch ! Output: [real(r8) (:) ] Rubisco-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wj => photosyns_inst%psnsha_wj_patch ! Output: [real(r8) (:) ] RuBP-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + psn_wp => photosyns_inst%psnsha_wp_patch ! Output: [real(r8) (:) ] product-limited foliage photosynthesis (umol co2 /m**2/ s) [always +] + end if + + !==============================================================================! + ! Photosynthesis and stomatal conductance parameters, from: + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + !==============================================================================! + + ! vcmax25 parameters, from CN + + fnr = 7.16_r8 + act25 = 3.6_r8 !umol/mgRubisco/min + ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s + act25 = act25 * 1000.0_r8 / 60.0_r8 + + ! Activation energy, from: + ! Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! Bernacchi et al (2003) Plant, Cell and Environment 26:1419-1430 + ! except TPU from: Harley et al (1992) Plant, Cell and Environment 15:271-282 + + kcha = 79430._r8 + koha = 36380._r8 + cpha = 37830._r8 + vcmaxha = 72000._r8 + jmaxha = 50000._r8 + tpuha = 72000._r8 + lmrha = 46390._r8 + + ! High temperature deactivation, from: + ! Leuning (2002) Plant, Cell and Environment 25:1205-1210 + ! The factor "c" scales the deactivation to a value of 1.0 at 25C + + vcmaxhd = 200000._r8 + jmaxhd = 200000._r8 + tpuhd = 200000._r8 + lmrhd = 150650._r8 + lmrse = 490._r8 + lmrc = fth25 (lmrhd, lmrse) + + ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + + fnps = 0.15_r8 + theta_psii = 0.7_r8 + theta_ip = 0.95_r8 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + ! C3 or C4 photosynthesis logical variable + + if (nint(c3psn(patch%itype(p))) == 1) then + c3flag(p) = .true. + else if (nint(c3psn(patch%itype(p))) == 0) then + c3flag(p) = .false. + end if + + ! C3 and C4 dependent parameters + + if (c3flag(p)) then + qe(p) = 0._r8 + theta_cj(p) = 0.98_r8 + bbbopt(p) = 10000._r8 + mbbopt(p) = 9._r8 + else + qe(p) = 0.05_r8 + theta_cj(p) = 0.80_r8 + bbbopt(p) = 40000._r8 + mbbopt(p) = 4._r8 + end if + + ! Soil water stress applied to Ball-Berry parameters + + bbb(p) = max (bbbopt(p)*btran(p), 1._r8) + mbb(p) = mbbopt(p) + + ! kc, ko, cp, from: Bernacchi et al (2001) Plant, Cell and Environment 24:253-259 + ! + ! kc25 = 404.9 umol/mol + ! ko25 = 278.4 mmol/mol + ! cp25 = 42.75 umol/mol + ! + ! Derive sco from cp and O2 using present-day O2 (0.209 mol/mol) and re-calculate + ! cp to account for variation in O2 using cp = 0.5 O2 / sco + ! + + kc25 = (404.9_r8 / 1.e06_r8) * forc_pbot(c) + ko25 = (278.4_r8 / 1.e03_r8) * forc_pbot(c) + sco = 0.5_r8 * 0.209_r8 / (42.75_r8 / 1.e06_r8) + cp25 = 0.5_r8 * oair(p) / sco + + kc(p) = kc25 * ft(t_veg(p), kcha) + ko(p) = ko25 * ft(t_veg(p), koha) + cp(p) = cp25 * ft(t_veg(p), cpha) + + end do + + ! Multi-layer parameters scaled by leaf nitrogen profile. + ! Loop through each canopy layer to calculate nitrogen profile using + ! cumulative lai at the midpoint of the layer + + do f = 1, fn + p = filterp(f) + + if (lnc_opt .eqv. .false.) then + ! Leaf nitrogen concentration at the top of the canopy (g N leaf / m**2 leaf) + lnc(p) = 1._r8 / (slatop(patch%itype(p)) * leafcn(patch%itype(p))) + end if + + ! Using the actual nitrogen allocated to the leaf after + ! uptake rather than fixing leaf nitrogen based on SLA and CN + ! ratio + if (lnc_opt .eqv. .true.) then + ! nlevcan and nrad(p) look like the same variable ?? check this later + sum_nscaler = 0.0_r8 + laican = 0.0_r8 + total_lai = 0.0_r8 + + do iv = 1, nrad(p) + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + total_lai = tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + total_lai = total_lai + tlai_z(p,iv) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + if (nlevcan == 1) then + nscaler = 1.0_r8 + else if (nlevcan > 1) then + nscaler = exp(-kn(p) * laican) + end if + + sum_nscaler = sum_nscaler + nscaler + + end do + + if (tlai(p) > 0.0_r8 .AND. sum_nscaler > 0.0_r8) then + ! dividing by LAI to convert total leaf nitrogen + ! from m2 ground to m2 leaf; dividing by sum_nscaler to + ! convert total leaf N to leaf N at canopy top + lnc(p) = leafn(p) / (tlai(p) * sum_nscaler) + else + lnc(p) = 0.0_r8 + end if + + end if + + + ! reduce_dayl_factor .eqv. .false. + if (reduce_dayl_factor .eqv. .true.) then + if (dayl_factor(p) > 0.25_r8) then ! added by BG + ! dayl_factor(p) = 1.0_r8 + end if + end if + + + ! vcmax_opt = 3 + if (vcmax_opt == 0) then + ! vcmax25 at canopy top, as in CN but using lnc at top of the canopy + vcmax25top = lnc(p) * flnr(patch%itype(p)) * fnr * act25 * dayl_factor(p) + if (.not. use_cn) then + vcmax25top = vcmax25top * fnitr(patch%itype(p)) + else + if ( CNAllocate_Carbon_only() ) vcmax25top = vcmax25top * fnitr(patch%itype(p)) + end if + end if + + if (vcmax_opt == 1) then + vcmax25top = ( i_vc(patch%itype(p)) + s_vc(patch%itype(p)) * lnc(p) ) * dayl_factor(p) + end if + + if (vcmax_opt == 2) then + vcmax25top = ( i_vca(patch%itype(p)) + s_vca(patch%itype(p)) * lnc(p) ) * dayl_factor(p) + end if + + if (vcmax_opt == 3) then + vcmax25top = ( i_vcad(patch%itype(p)) + s_vcad(patch%itype(p)) * lnc(p) ) * dayl_factor(p) + end if + + if (vcmax_opt == 4) then + nptreemax = 9 ! is this number correct? check later + if (patch%itype(p) >= nptreemax) then ! if not tree + ! for shrubs and herbs + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) + s_flnr(patch%itype(p)) * lnc(p) ) * fnr * act25 * & + dayl_factor(p) + else + ! if tree + vcmax25top = lnc(p) * ( i_flnr(patch%itype(p)) * exp(s_flnr(patch%itype(p)) * lnc(p)) ) * fnr * act25 * & + dayl_factor(p) + ! for trees + end if + end if + + + ! Parameters derived from vcmax25top. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + ! used jmax25 = 1.97 vcmax25, from Wullschleger (1993) Journal of Experimental Botany 44:907-920. + + jmax25top = (2.59_r8 - 0.035_r8*min(max((t10(p)-tfrz),11._r8),35._r8)) * vcmax25top + tpu25top = 0.167_r8 * vcmax25top + kp25top = 20000._r8 * vcmax25top + + ! Nitrogen scaling factor. Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 used + ! kn = 0.11. Here, derive kn from vcmax25 as in Lloyd et al (2010) Biogeosciences, 7, 1833-1859 + ! Remove daylength factor from vcmax25 so that kn is based on maximum vcmax25 + ! But not used as defined here if using sun/shade big leaf code. Instead, + ! will use canopy integrated scaling factors from SurfaceAlbedo. + + if (dayl_factor(p) .eq. 0._r8) then + kn(p) = 0._r8 + else + kn(p) = exp(0.00963_r8 * vcmax25top/dayl_factor(p) - 2.43_r8) + end if + + if (use_cn) then + ! Leaf maintenance respiration to match the base rate used in CN + ! but with the new temperature functions for C3 and C4 plants. + ! + ! Base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + ! + ! Base rate is at 20C. Adjust to 25C using the CN Q10 = 1.5 + ! + ! CN respiration has units: g C / g N [leaf] / s. This needs to be + ! converted from g C / g N [leaf] / s to umol CO2 / m**2 [leaf] / s + ! + ! Then scale this value at the top of the canopy for canopy depth + + lmr25top = 2.525e-6_r8 * (1.5_r8 ** ((25._r8 - 20._r8)/10._r8)) + lmr25top = lmr25top * lnc(p) / 12.e-06_r8 + + else + ! Leaf maintenance respiration in proportion to vcmax25top + + if (c3flag(p)) then + lmr25top = vcmax25top * 0.015_r8 + else + lmr25top = vcmax25top * 0.025_r8 + end if + end if + + ! Loop through canopy layers (above snow). Respiration needs to be + ! calculated every timestep. Others are calculated only if daytime + + laican = 0._r8 + do iv = 1, nrad(p) + + ! Cumulative lai at middle of layer + + if (iv == 1) then + laican = 0.5_r8 * tlai_z(p,iv) + else + laican = laican + 0.5_r8 * (tlai_z(p,iv-1)+tlai_z(p,iv)) + end if + + ! Scale for leaf nitrogen profile. If multi-layer code, use explicit + ! profile. If sun/shade big leaf code, use canopy integrated factor. + + if (nlevcan == 1) then + nscaler = vcmaxcint(p) + else if (nlevcan > 1) then + nscaler = exp(-kn(p) * laican) + end if + + ! Maintenance respiration + + lmr25 = lmr25top * nscaler + + if(use_luna.and.c3flag(p).and.(.not.use_cn))then + lmr25 = 0.015_r8 * vcmx25_z(p,iv) + endif + + if (c3flag(p)) then + lmr_z(p,iv) = lmr25 * ft(t_veg(p), lmrha) * fth(t_veg(p), lmrhd, lmrse, lmrc) + else + lmr_z(p,iv) = lmr25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + lmr_z(p,iv) = lmr_z(p,iv) / (1._r8 + exp( 1.3_r8*(t_veg(p)-(tfrz+55._r8)) )) + end if + + if (par_z(p,iv) <= 0._r8) then ! night time + + vcmax_z(p,iv) = 0._r8 + jmax_z(p,iv) = 0._r8 + tpu_z(p,iv) = 0._r8 + kp_z(p,iv) = 0._r8 + + if ( use_c13 ) then + alphapsn(p) = 1._r8 + end if + + else ! day time + + if(use_luna.and.c3flag(p))then + vcmax25 = vcmx25_z(p,iv) + jmax25 = jmx25_z(p,iv) + tpu25 = 0.167_r8 * vcmax25 + else + vcmax25 = vcmax25top * nscaler + jmax25 = jmax25top * nscaler + tpu25 = tpu25top * nscaler + endif + kp25 = kp25top * nscaler + + ! Adjust for temperature + + vcmaxse = 668.39_r8 - 1.07_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + jmaxse = 659.70_r8 - 0.75_r8 * min(max((t10(p)-tfrz),11._r8),35._r8) + tpuse = vcmaxse + vcmaxc = fth25 (vcmaxhd, vcmaxse) + jmaxc = fth25 (jmaxhd, jmaxse) + tpuc = fth25 (tpuhd, tpuse) + vcmax_z(p,iv) = vcmax25 * ft(t_veg(p), vcmaxha) * fth(t_veg(p), vcmaxhd, vcmaxse, vcmaxc) + jmax_z(p,iv) = jmax25 * ft(t_veg(p), jmaxha) * fth(t_veg(p), jmaxhd, jmaxse, jmaxc) + tpu_z(p,iv) = tpu25 * ft(t_veg(p), tpuha) * fth(t_veg(p), tpuhd, tpuse, tpuc) + + if (.not. c3flag(p)) then + vcmax_z(p,iv) = vcmax25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.2_r8*((tfrz+15._r8)-t_veg(p)) )) + vcmax_z(p,iv) = vcmax_z(p,iv) / (1._r8 + exp( 0.3_r8*(t_veg(p)-(tfrz+40._r8)) )) + end if + + kp_z(p,iv) = kp25 * 2._r8**((t_veg(p)-(tfrz+25._r8))/10._r8) + + end if + + ! Adjust for soil water + + vcmax_z(p,iv) = vcmax_z(p,iv) * btran(p) + lmr_z(p,iv) = lmr_z(p,iv) * btran(p) + + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Leaf-level photosynthesis and stomatal conductance + !==============================================================================! + + rsmax0 = 2.e4_r8 + + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + ! Leaf boundary layer conductance, umol/m**2/s + + cf = forc_pbot(c)/(rgas*1.e-3_r8*tgcm(p))*1.e06_r8 + gb = 1._r8/rb(p) + gb_mol(p) = gb * cf + + ! Loop through canopy layers (above snow). Only do calculations if daytime + + do iv = 1, nrad(p) + + if (par_z(p,iv) <= 0._r8) then ! night time + + ac(p,iv) = 0._r8 + aj(p,iv) = 0._r8 + ap(p,iv) = 0._r8 + ag(p,iv) = 0._r8 + an(p,iv) = ag(p,iv) - lmr_z(p,iv) + psn_z(p,iv) = 0._r8 + psn_wc_z(p,iv) = 0._r8 + psn_wj_z(p,iv) = 0._r8 + psn_wp_z(p,iv) = 0._r8 + rs_z(p,iv) = min(rsmax0, 1._r8/bbb(p) * cf) + ci_z(p,iv) = 0._r8 + rh_leaf(p) = 0._r8 + + else ! day time + + !now the constraint is no longer needed, Jinyun Tang + ceair = min( eair(p), esat_tv(p) ) + rh_can = ceair / esat_tv(p) + + ! Electron transport rate for C3 plants. Convert par from W/m2 to + ! umol photons/m**2/s using the factor 4.6 + + qabs = 0.5_r8 * (1._r8 - fnps) * par_z(p,iv) * 4.6_r8 + aquad = theta_psii + bquad = -(qabs + jmax_z(p,iv)) + cquad = qabs * jmax_z(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + je = min(r1,r2) + + ! Iterative loop for ci beginning with initial guess + + if (c3flag(p)) then + ci_z(p,iv) = 0.7_r8 * cair(p) + else + ci_z(p,iv) = 0.4_r8 * cair(p) + end if + + niter = 0 + + ! Increment iteration counter. Stop if too many iterations + + niter = niter + 1 + + ! Save old ci + + ciold = ci_z(p,iv) + + !find ci and stomatal conductance + call hybrid(ciold, p, iv, c, gb_mol(p), je, cair(p), oair(p), & + lmr_z(p,iv), par_z(p,iv), rh_can, gs_mol(p,iv), niter, & + atm2lnd_inst, photosyns_inst) + + ! End of ci iteration. Check for an < 0, in which case gs_mol = bbb + + if (an(p,iv) < 0._r8) gs_mol(p,iv) = bbb(p) + + ! Final estimates for cs and ci (needed for early exit of ci iteration when an < 0) + + cs = cair(p) - 1.4_r8/gb_mol(p) * an(p,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + ci_z(p,iv) = cair(p) - an(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv)) + + ! Convert gs_mol (umol H2O/m**2/s) to gs (m/s) and then to rs (s/m) + + gs = gs_mol(p,iv) / cf + rs_z(p,iv) = min(1._r8/gs, rsmax0) + rs_z(p,iv) = rs_z(p,iv) / o3coefg(p) + + ! Photosynthesis. Save rate-limiting photosynthesis + + psn_z(p,iv) = ag(p,iv) + psn_z(p,iv) = psn_z(p,iv) * o3coefv(p) + + psn_wc_z(p,iv) = 0._r8 + psn_wj_z(p,iv) = 0._r8 + psn_wp_z(p,iv) = 0._r8 + + if (ac(p,iv) <= aj(p,iv) .and. ac(p,iv) <= ap(p,iv)) then + psn_wc_z(p,iv) = psn_z(p,iv) + else if (aj(p,iv) < ac(p,iv) .and. aj(p,iv) <= ap(p,iv)) then + psn_wj_z(p,iv) = psn_z(p,iv) + else if (ap(p,iv) < ac(p,iv) .and. ap(p,iv) < aj(p,iv)) then + psn_wp_z(p,iv) = psn_z(p,iv) + end if + + ! Make sure iterative solution is correct + + if (gs_mol(p,iv) < 0._r8) then + write (iulog,*)'Negative stomatal conductance:' + write (iulog,*)'p,iv,gs_mol= ',p,iv,gs_mol(p,iv) + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + + ! Compare with Ball-Berry model: gs_mol = m * an * hs/cs p + b + + hs = (gb_mol(p)*ceair + gs_mol(p,iv)*esat_tv(p)) / ((gb_mol(p)+gs_mol(p,iv))*esat_tv(p)) + rh_leaf(p) = hs + gs_mol_err = mbb(p)*max(an(p,iv), 0._r8)*hs/cs*forc_pbot(c) + bbb(p) + + if (abs(gs_mol(p,iv)-gs_mol_err) > 1.e-01_r8) then + write (iulog,*) 'Ball-Berry error check - stomatal conductance error:' + write (iulog,*) gs_mol(p,iv), gs_mol_err + end if + + end if ! night or day if branch + end do ! canopy layer loop + end do ! patch loop + + !==============================================================================! + ! Canopy photosynthesis and stomatal conductance + !==============================================================================! + + ! Sum canopy layer fluxes and then derive effective leaf-level fluxes (per + ! unit leaf area), which are used in other parts of the model. Here, laican + ! sums to either laisun or laisha. + + do f = 1, fn + p = filterp(f) + + psncan = 0._r8 + psncan_wc = 0._r8 + psncan_wj = 0._r8 + psncan_wp = 0._r8 + lmrcan = 0._r8 + gscan = 0._r8 + laican = 0._r8 + do iv = 1, nrad(p) + psncan = psncan + psn_z(p,iv) * lai_z(p,iv) + psncan_wc = psncan_wc + psn_wc_z(p,iv) * lai_z(p,iv) + psncan_wj = psncan_wj + psn_wj_z(p,iv) * lai_z(p,iv) + psncan_wp = psncan_wp + psn_wp_z(p,iv) * lai_z(p,iv) + lmrcan = lmrcan + lmr_z(p,iv) * lai_z(p,iv) + gscan = gscan + lai_z(p,iv) / (rb(p)+rs_z(p,iv)) + laican = laican + lai_z(p,iv) + end do + if (laican > 0._r8) then + psn(p) = psncan / laican + psn_wc(p) = psncan_wc / laican + psn_wj(p) = psncan_wj / laican + psn_wp(p) = psncan_wp / laican + lmr(p) = lmrcan / laican + rs(p) = laican / gscan - rb(p) + else + psn(p) = 0._r8 + psn_wc(p) = 0._r8 + psn_wj(p) = 0._r8 + psn_wp(p) = 0._r8 + lmr(p) = 0._r8 + rs(p) = 0._r8 + end if + end do + + end associate + + end subroutine Photosynthesis + + !------------------------------------------------------------------------------ + subroutine PhotosynthesisTotal (fn, filterp, & + atm2lnd_inst, canopystate_inst, photosyns_inst) + ! + ! Determine total photosynthesis + ! + ! !ARGUMENTS: + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + ! !LOCAL VARIABLES: + integer :: f,fp,p,l,g ! indices + real(r8) :: rc14_atm + !----------------------------------------------------------------------- + + associate( & + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + forc_pc13o2 => atm2lnd_inst%forc_pc13o2_grc , & ! Input: [real(r8) (:) ] partial pressure c13o2 (Pa) + forc_po2 => atm2lnd_inst%forc_po2_grc , & ! Input: [real(r8) (:) ] partial pressure o2 (Pa) + + laisun => canopystate_inst%laisun_patch , & ! Input: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Input: [real(r8) (:) ] shaded leaf area + + psnsun => photosyns_inst%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_inst%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf photosynthesis (umol CO2 /m**2/ s) + rc13_canair => photosyns_inst%rc13_canair_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in canopy air + rc13_psnsun => photosyns_inst%rc13_psnsun_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in sunlit canopy psn flux + rc13_psnsha => photosyns_inst%rc13_psnsha_patch , & ! Output: [real(r8) (:) ] C13O2/C12O2 in shaded canopy psn flux + alphapsnsun => photosyns_inst%alphapsnsun_patch , & ! Output: [real(r8) (:) ] fractionation factor in sunlit canopy psn flux + alphapsnsha => photosyns_inst%alphapsnsha_patch , & ! Output: [real(r8) (:) ] fractionation factor in shaded canopy psn flux + psnsun_wc => photosyns_inst%psnsun_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wj => photosyns_inst%psnsun_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsun_wp => photosyns_inst%psnsun_wp_patch , & ! Output: [real(r8) (:) ] product-limited sunlit leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wc => photosyns_inst%psnsha_wc_patch , & ! Output: [real(r8) (:) ] Rubsico-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wj => photosyns_inst%psnsha_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + psnsha_wp => photosyns_inst%psnsha_wp_patch , & ! Output: [real(r8) (:) ] product-limited shaded leaf photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_inst%c13_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 13CO2 /m**2/ s) + c13_psnsha => photosyns_inst%c13_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 13CO2 /m**2/ s) + c14_psnsun => photosyns_inst%c14_psnsun_patch , & ! Output: [real(r8) (:) ] sunlit leaf photosynthesis (umol 14CO2 /m**2/ s) + c14_psnsha => photosyns_inst%c14_psnsha_patch , & ! Output: [real(r8) (:) ] shaded leaf photosynthesis (umol 14CO2 /m**2/ s) + fpsn => photosyns_inst%fpsn_patch , & ! Output: [real(r8) (:) ] photosynthesis (umol CO2 /m**2 /s) + fpsn_wc => photosyns_inst%fpsn_wc_patch , & ! Output: [real(r8) (:) ] Rubisco-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wj => photosyns_inst%fpsn_wj_patch , & ! Output: [real(r8) (:) ] RuBP-limited photosynthesis (umol CO2 /m**2 /s) + fpsn_wp => photosyns_inst%fpsn_wp_patch & ! Output: [real(r8) (:) ] product-limited photosynthesis (umol CO2 /m**2 /s) + ) + + if ( use_c14 ) then + if (use_c14_bombspike) then + !call C14BombSpike(rc14_atm) + else + rc14_atm = c14ratio + end if + end if + + do f = 1, fn + p = filterp(f) + g = patch%gridcell(p) + + if (.not. use_ed) then + fpsn(p) = psnsun(p) *laisun(p) + psnsha(p) *laisha(p) + fpsn_wc(p) = psnsun_wc(p)*laisun(p) + psnsha_wc(p)*laisha(p) + fpsn_wj(p) = psnsun_wj(p)*laisun(p) + psnsha_wj(p)*laisha(p) + fpsn_wp(p) = psnsun_wp(p)*laisun(p) + psnsha_wp(p)*laisha(p) + end if + + if (use_cn) then + if ( use_c13 ) then + rc13_canair(p) = forc_pc13o2(g)/(forc_pco2(g) - forc_pc13o2(g)) + rc13_psnsun(p) = rc13_canair(p)/alphapsnsun(p) + rc13_psnsha(p) = rc13_canair(p)/alphapsnsha(p) + c13_psnsun(p) = psnsun(p) * (rc13_psnsun(p)/(1._r8+rc13_psnsun(p))) + c13_psnsha(p) = psnsha(p) * (rc13_psnsha(p)/(1._r8+rc13_psnsha(p))) + + ! use fixed c13 ratio with del13C of -25 to test the overall c13 structure + ! c13_psnsun(p) = 0.01095627 * psnsun(p) + ! c13_psnsha(p) = 0.01095627 * psnsha(p) + endif + if ( use_c14 ) then + c14_psnsun(p) = rc14_atm * psnsun(p) + c14_psnsha(p) = rc14_atm * psnsha(p) + endif + end if + + end do + + end associate + + end subroutine PhotosynthesisTotal + + !------------------------------------------------------------------------------ + subroutine Fractionation(bounds, fn, filterp, & + atm2lnd_inst, canopystate_inst, cnveg_state_inst, solarabs_inst, surfalb_inst, photosyns_inst, & + phase) + ! + ! !DESCRIPTION: + ! C13 fractionation during photosynthesis is calculated here after the nitrogen + ! limitation is taken into account in the CNAllocation module. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! patch filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(cnveg_state_type) , intent(in) :: cnveg_state_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(photosyns_type) , intent(in) :: photosyns_inst + character(len=*) , intent(in) :: phase ! 'sun' or 'sha' + ! + ! !LOCAL VARIABLES: + real(r8) , pointer :: par_z (:,:) ! needed for backwards compatiblity + real(r8) , pointer :: alphapsn (:) ! needed for backwards compatiblity + integer :: f,p,c,g,iv ! indices + real(r8) :: co2(bounds%begp:bounds%endp) ! atmospheric co2 partial pressure (pa) + real(r8) :: ci + !------------------------------------------------------------------------------ + + associate( & + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_pco2 => atm2lnd_inst%forc_pco2_grc , & ! Input: [real(r8) (:) ] partial pressure co2 (Pa) + + c3psn => pftcon%c3psn , & ! Input: photosynthetic pathway: 0. = c4, 1. = c3 + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + + downreg => cnveg_state_inst%downreg_patch , & ! Input: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + an => photosyns_inst%an_patch , & ! Input: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + gb_mol => photosyns_inst%gb_mol_patch , & ! Input: [real(r8) (:) ] leaf boundary layer conductance (umol H2O/m**2/s) + gs_mol => photosyns_inst%gs_mol_patch & ! Input: [real(r8) (:,:) ] leaf stomatal conductance (umol H2O/m**2/s) + ) + + if (phase == 'sun') then + par_z => solarabs_inst%parsun_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) + alphapsn => photosyns_inst%alphapsnsun_patch ! Output: [real(r8) (:)] + else if (phase == 'sha') then + par_z => solarabs_inst%parsha_z_patch ! Input : [real(r8) (:,:)] par absorbed per unit lai for canopy layer (w/m**2) + alphapsn => photosyns_inst%alphapsnsha_patch ! Output: [real(r8) (:)] + end if + + do f = 1, fn + p = filterp(f) + c= patch%column(p) + g= patch%gridcell(p) + + co2(p) = forc_pco2(g) + do iv = 1,nrad(p) + if (par_z(p,iv) <= 0._r8) then ! night time + alphapsn(p) = 1._r8 + else ! day time + ci = co2(p) - ((an(p,iv) * (1._r8-downreg(p)) ) * & + forc_pbot(c) * & + (1.4_r8*gs_mol(p,iv)+1.6_r8*gb_mol(p)) / (gb_mol(p)*gs_mol(p,iv))) + alphapsn(p) = 1._r8 + (((c3psn(patch%itype(p)) * & + (4.4_r8 + (22.6_r8*(ci/co2(p))))) + & + ((1._r8 - c3psn(patch%itype(p))) * 4.4_r8))/1000._r8) + end if + end do + end do + + end associate + + end subroutine Fractionation + + !------------------------------------------------------------------------------- + subroutine hybrid(x0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& + rh_can, gs_mol,iter, & + atm2lnd_inst, photosyns_inst) + ! + !! DESCRIPTION: + ! use a hybrid solver to find the root of equation + ! f(x) = x- h(x), + !we want to find x, s.t. f(x) = 0. + !the hybrid approach combines the strength of the newton secant approach (find the solution domain) + !and the bisection approach implemented with the Brent's method to guarrantee convergence. + + ! + !! REVISION HISTORY: + !Dec 14/2012: created by Jinyun Tang + ! + !!USES: + ! + !! ARGUMENTS: + implicit none + real(r8), intent(inout) :: x0 !initial guess and final value of the solution + real(r8), intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8), intent(in) :: rh_can ! canopy air relative humidity + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + integer, intent(in) :: p, iv, c ! pft, c3/c4, and column index + real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + integer, intent(out) :: iter !number of iterations used, for record only + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type), intent(inout) :: photosyns_inst + ! + !! LOCAL VARIABLES + real(r8) :: a, b + real(r8) :: fa, fb + real(r8) :: x1, f0, f1 + real(r8) :: x, dx + real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy + real(r8), parameter :: eps1= 1.e-4_r8 + integer, parameter :: itmax = 40 !maximum number of iterations + real(r8) :: tol,minx,minf + + call ci_func(x0, f0, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(f0 == 0._r8)return + + minx=x0 + minf=f0 + x1 = x0 * 0.99_r8 + + call ci_func(x1,f1, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(f1==0._r8)then + x0 = x1 + return + endif + if(f1itmax)then + !in case of failing to converge within itmax iterations + !stop at the minimum function + !this happens because of some other issues besides the stomatal conductance calculation + !and it happens usually in very dry places and more likely with c4 plants. + + call ci_func(minx,f1, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + exit + endif + enddo + + end subroutine hybrid + + !------------------------------------------------------------------------------ + subroutine brent(x, x1,x2,f1, f2, tol, ip, iv, ic, gb_mol, je, cair, oair,& + lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + ! + !!DESCRIPTION: + !Use Brent's method to find the root of a single variable function ci_func, which is known to exist between x1 and x2. + !The found root will be updated until its accuracy is tol. + + !!REVISION HISTORY: + !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 + ! + !!ARGUMENTS: + real(r8), intent(out) :: x ! indepedent variable of the single value function ci_func(x) + real(r8), intent(in) :: x1, x2, f1, f2 ! minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: tol ! the error tolerance + real(r8), intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8), intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8), intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8), intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8), intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8), intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8), intent(in) :: rh_can ! inside canopy relative humidity + integer, intent(in) :: ip, iv, ic ! pft, c3/c4, and column index + real(r8), intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type), intent(inout) :: photosyns_inst + ! + !!LOCAL VARIABLES: + integer, parameter :: ITMAX=20 !maximum number of iterations + real(r8), parameter :: EPS=1.e-2_r8 !relative error tolerance + integer :: iter + real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,tol1,xm + !------------------------------------------------------------------------------ + + a=x1 + b=x2 + fa=f1 + fb=f2 + if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then + write(iulog,*) 'root must be bracketed for brent' + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + c=b + fc=fb + iter = 0 + do + if(iter==ITMAX)exit + iter=iter+1 + if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then + c=a !Rename a, b, c and adjust bounding interval d. + fc=fa + d=b-a + e=d + endif + if( abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + endif + tol1=2._r8*EPS*abs(b)+0.5_r8*tol !Convergence check. + xm=0.5_r8*(c-b) + if(abs(xm) <= tol1 .or. fb == 0.)then + x=b + return + endif + if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then + s=fb/fa !Attempt inverse quadratic interpolation. + if(a == c) then + p=2._r8*xm*s + q=1._r8-s + else + q=fa/fc + r=fb/fc + p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) + q=(q-1._r8)*(r-1._r8)*(s-1._r8) + endif + if(p > 0._r8) q=-q !Check whether in bounds. + p=abs(p) + if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then + e=d !Accept interpolation. + d=p/q + else + d=xm !Interpolation failed, use bisection. + e=d + endif + else !Bounds decreasing too slowly, use bisection. + d=xm + e=d + endif + a=b !Move last best guess to a. + fa=fb + if(abs(d) > tol1) then !Evaluate new trial root. + b=b+d + else + b=b+sign(tol1,xm) + endif + + call ci_func(b, fb, ip, iv, ic, gb_mol, je, cair, oair, lmr_z, par_z, rh_can, gs_mol, & + atm2lnd_inst, photosyns_inst) + + if(fb==0._r8)exit + + enddo + + if(iter==ITMAX)write(iulog,*) 'brent exceeding maximum iterations', b, fb + x=b + + return + end subroutine brent + + !------------------------------------------------------------------------------- + function ft(tl, ha) result(ans) + ! + !!DESCRIPTION: + ! photosynthesis temperature response + ! + ! !REVISION HISTORY + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + !!USES + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8), intent(in) :: ha ! activation energy in photosynthesis temperature function (J/mol) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = exp( ha / (rgas*1.e-3_r8*(tfrz+25._r8)) * (1._r8 - (tfrz+25._r8)/tl) ) + + return + end function ft + + !------------------------------------------------------------------------------- + function fth(tl,hd,se,scaleFactor) result(ans) + ! + !!DESCRIPTION: + !photosynthesis temperature inhibition + ! + ! !REVISION HISTORY + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: tl ! leaf temperature in photosynthesis temperature function (K) + real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8), intent(in) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + real(r8), intent(in) :: scaleFactor ! scaling factor for high temperature inhibition (25 C = 1.0) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = scaleFactor / ( 1._r8 + exp( (-hd+se*tl) / (rgas*1.e-3_r8*tl) ) ) + + return + end function fth + + !------------------------------------------------------------------------------- + function fth25(hd,se)result(ans) + ! + !!DESCRIPTION: + ! scaling factor for photosynthesis temperature inhibition + ! + ! !REVISION HISTORY: + ! Jinyun Tang separated it out from Photosynthesis, Feb. 07/2013 + ! + !!USES + use clm_varcon , only : rgas, tfrz + ! + ! !ARGUMENTS: + real(r8), intent(in) :: hd ! deactivation energy in photosynthesis temperature function (J/mol) + real(r8), intent(in) :: se ! entropy term in photosynthesis temperature function (J/mol/K) + ! + ! !LOCAL VARIABLES: + real(r8) :: ans + !------------------------------------------------------------------------------- + + ans = 1._r8 + exp( (-hd+se*(tfrz+25._r8)) / (rgas*1.e-3_r8*(tfrz+25._r8)) ) + + return + end function fth25 + + !------------------------------------------------------------------------------ + subroutine ci_func(ci, fval, p, iv, c, gb_mol, je, cair, oair, lmr_z, par_z,& + rh_can, gs_mol, atm2lnd_inst, photosyns_inst) + ! + !! DESCRIPTION: + ! evaluate the function + ! f(ci)=ci - (ca - (1.37rb+1.65rs))*patm*an + ! + ! remark: I am attempting to maintain the original code structure, also + ! considering one may be interested to output relevant variables for the + ! photosynthesis model, I have decided to add these relevant variables to + ! the relevant data types. + ! + !!ARGUMENTS: + real(r8) , intent(in) :: ci ! intracellular leaf CO2 (Pa) + real(r8) , intent(in) :: lmr_z ! canopy layer: leaf maintenance respiration rate (umol CO2/m**2/s) + real(r8) , intent(in) :: par_z ! par absorbed per unit lai for canopy layer (w/m**2) + real(r8) , intent(in) :: gb_mol ! leaf boundary layer conductance (umol H2O/m**2/s) + real(r8) , intent(in) :: je ! electron transport rate (umol electrons/m**2/s) + real(r8) , intent(in) :: cair ! Atmospheric CO2 partial pressure (Pa) + real(r8) , intent(in) :: oair ! Atmospheric O2 partial pressure (Pa) + real(r8) , intent(in) :: rh_can ! canopy air realtive humidity + integer , intent(in) :: p, iv, c ! pft, vegetation type and column indexes + real(r8) , intent(out) :: fval ! return function of the value f(ci) + real(r8) , intent(out) :: gs_mol ! leaf stomatal conductance (umol H2O/m**2/s) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + ! + !local variables + real(r8) :: ai ! intermediate co-limited photosynthesis (umol CO2/m**2/s) + real(r8) :: cs ! CO2 partial pressure at leaf surface (Pa) + + real(r8) :: aquad, bquad, cquad ! terms for quadratic equations + real(r8) :: r1, r2 ! roots of quadratic equation + real(r8) :: fnps ! fraction of light absorbed by non-photosynthetic pigments + real(r8) :: theta_psii ! empirical curvature parameter for electron transport rate + real(r8) :: theta_ip ! empirical curvature parameter for ap photosynthesis co-limitation + !------------------------------------------------------------------------------ + + associate(& + forc_pbot => atm2lnd_inst%forc_pbot_downscaled_col , & ! Output: [real(r8) (:) ] atmospheric pressure (Pa) + c3flag => photosyns_inst%c3flag_patch , & ! Output: [logical (:) ] true if C3 and false if C4 + ac => photosyns_inst%ac_patch , & ! Output: [real(r8) (:,:) ] Rubisco-limited gross photosynthesis (umol CO2/m**2/s) + aj => photosyns_inst%aj_patch , & ! Output: [real(r8) (:,:) ] RuBP-limited gross photosynthesis (umol CO2/m**2/s) + ap => photosyns_inst%ap_patch , & ! Output: [real(r8) (:,:) ] product-limited (C3) or CO2-limited (C4) gross photosynthesis (umol CO2/m**2/s) + ag => photosyns_inst%ag_patch , & ! Output: [real(r8) (:,:) ] co-limited gross leaf photosynthesis (umol CO2/m**2/s) + an => photosyns_inst%an_patch , & ! Output: [real(r8) (:,:) ] net leaf photosynthesis (umol CO2/m**2/s) + vcmax_z => photosyns_inst%vcmax_z_patch , & ! Input: [real(r8) (:,:) ] maximum rate of carboxylation (umol co2/m**2/s) + cp => photosyns_inst%cp_patch , & ! Output: [real(r8) (:) ] CO2 compensation point (Pa) + kc => photosyns_inst%kc_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for CO2 (Pa) + ko => photosyns_inst%ko_patch , & ! Output: [real(r8) (:) ] Michaelis-Menten constant for O2 (Pa) + qe => photosyns_inst%qe_patch , & ! Output: [real(r8) (:) ] quantum efficiency, used only for C4 (mol CO2 / mol photons) + tpu_z => photosyns_inst%tpu_z_patch , & ! Output: [real(r8) (:,:) ] triose phosphate utilization rate (umol CO2/m**2/s) + kp_z => photosyns_inst%kp_z_patch , & ! Output: [real(r8) (:,:) ] initial slope of CO2 response curve (C4 plants) + theta_cj => photosyns_inst%theta_cj_patch , & ! Output: [real(r8) (:) ] empirical curvature parameter for ac, aj photosynthesis co-limitation + bbb => photosyns_inst%bbb_patch , & ! Output: [real(r8) (:) ] Ball-Berry minimum leaf conductance (umol H2O/m**2/s) + mbb => photosyns_inst%mbb_patch & ! Output: [real(r8) (:) ] Ball-Berry slope of conductance-photosynthesis relationship + ) + + ! Miscellaneous parameters, from Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 + fnps = 0.15_r8 + theta_psii = 0.7_r8 + theta_ip = 0.95_r8 + + if (c3flag(p)) then + ! C3: Rubisco-limited photosynthesis + ac(p,iv) = vcmax_z(p,iv) * max(ci-cp(p), 0._r8) / (ci+kc(p)*(1._r8+oair/ko(p))) + + ! C3: RuBP-limited photosynthesis + aj(p,iv) = je * max(ci-cp(p), 0._r8) / (4._r8*ci+8._r8*cp(p)) + + ! C3: Product-limited photosynthesis + ap(p,iv) = 3._r8 * tpu_z(p,iv) + + else + + ! C4: Rubisco-limited photosynthesis + ac(p,iv) = vcmax_z(p,iv) + + ! C4: RuBP-limited photosynthesis + aj(p,iv) = qe(p) * par_z * 4.6_r8 + + ! C4: PEP carboxylase-limited (CO2-limited) + ap(p,iv) = kp_z(p,iv) * max(ci, 0._r8) / forc_pbot(c) + + end if + + ! Gross photosynthesis. First co-limit ac and aj. Then co-limit ap + + aquad = theta_cj(p) + bquad = -(ac(p,iv) + aj(p,iv)) + cquad = ac(p,iv) * aj(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ai = min(r1,r2) + + aquad = theta_ip + bquad = -(ai + ap(p,iv)) + cquad = ai * ap(p,iv) + call quadratic (aquad, bquad, cquad, r1, r2) + ag(p,iv) = min(r1,r2) + + ! Net photosynthesis. Exit iteration if an < 0 + + an(p,iv) = ag(p,iv) - lmr_z + if (an(p,iv) < 0._r8) then + fval = 0._r8 + return + endif + ! Quadratic gs_mol calculation with an known. Valid for an >= 0. + ! With an <= 0, then gs_mol = bbb + + cs = cair - 1.4_r8/gb_mol * an(p,iv) * forc_pbot(c) + cs = max(cs,1.e-06_r8) + aquad = cs + bquad = cs*(gb_mol - bbb(p)) - mbb(p)*an(p,iv)*forc_pbot(c) + cquad = -gb_mol*(cs*bbb(p) + mbb(p)*an(p,iv)*forc_pbot(c)*rh_can) + call quadratic (aquad, bquad, cquad, r1, r2) + gs_mol = max(r1,r2) + + ! Derive new estimate for ci + + fval =ci - cair + an(p,iv) * forc_pbot(c) * (1.4_r8*gs_mol+1.6_r8*gb_mol) / (gb_mol*gs_mol) + + end associate + + end subroutine ci_func + +end module PhotosynthesisMod diff --git a/components/clm/src/biogeophys/QSatMod.F90 b/components/clm/src/biogeophys/QSatMod.F90 new file mode 100644 index 0000000000..0b1819e467 --- /dev/null +++ b/components/clm/src/biogeophys/QSatMod.F90 @@ -0,0 +1,167 @@ +module QSatMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Computes saturation mixing ratio and the change in saturation + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: QSat + public :: rhoSat + !----------------------------------------------------------------------- + + ! For water vapor (temperature range 0C-100C) + real(r8), parameter :: a0 = 6.11213476_r8 + real(r8), parameter :: a1 = 0.444007856_r8 + real(r8), parameter :: a2 = 0.143064234e-01_r8 + real(r8), parameter :: a3 = 0.264461437e-03_r8 + real(r8), parameter :: a4 = 0.305903558e-05_r8 + real(r8), parameter :: a5 = 0.196237241e-07_r8 + real(r8), parameter :: a6 = 0.892344772e-10_r8 + real(r8), parameter :: a7 = -0.373208410e-12_r8 + real(r8), parameter :: a8 = 0.209339997e-15_r8 + ! For derivative:water vapor + real(r8), parameter :: b0 = 0.444017302_r8 + real(r8), parameter :: b1 = 0.286064092e-01_r8 + real(r8), parameter :: b2 = 0.794683137e-03_r8 + real(r8), parameter :: b3 = 0.121211669e-04_r8 + real(r8), parameter :: b4 = 0.103354611e-06_r8 + real(r8), parameter :: b5 = 0.404125005e-09_r8 + real(r8), parameter :: b6 = -0.788037859e-12_r8 + real(r8), parameter :: b7 = -0.114596802e-13_r8 + real(r8), parameter :: b8 = 0.381294516e-16_r8 + ! For ice (temperature range -75C-0C) + real(r8), parameter :: c0 = 6.11123516_r8 + real(r8), parameter :: c1 = 0.503109514_r8 + real(r8), parameter :: c2 = 0.188369801e-01_r8 + real(r8), parameter :: c3 = 0.420547422e-03_r8 + real(r8), parameter :: c4 = 0.614396778e-05_r8 + real(r8), parameter :: c5 = 0.602780717e-07_r8 + real(r8), parameter :: c6 = 0.387940929e-09_r8 + real(r8), parameter :: c7 = 0.149436277e-11_r8 + real(r8), parameter :: c8 = 0.262655803e-14_r8 + ! For derivative:ice + real(r8), parameter :: d0 = 0.503277922_r8 + real(r8), parameter :: d1 = 0.377289173e-01_r8 + real(r8), parameter :: d2 = 0.126801703e-02_r8 + real(r8), parameter :: d3 = 0.249468427e-04_r8 + real(r8), parameter :: d4 = 0.313703411e-06_r8 + real(r8), parameter :: d5 = 0.257180651e-08_r8 + real(r8), parameter :: d6 = 0.133268878e-10_r8 + real(r8), parameter :: d7 = 0.394116744e-13_r8 + real(r8), parameter :: d8 = 0.498070196e-16_r8 +contains + + + + !----------------------------------------------------------------------- + subroutine QSat (T, p, es, esdT, qs, qsdT) + ! + ! !DESCRIPTION: + ! Computes saturation mixing ratio and the change in saturation + ! mixing ratio with respect to temperature. + ! Reference: Polynomial approximations from: + ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation + ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T ! temperature (K) + real(r8), intent(in) :: p ! surface atmospheric pressure (pa) + real(r8), intent(out) :: es ! vapor pressure (pa) + real(r8), intent(out) :: esdT ! d(es)/d(T) + real(r8), intent(out) :: qs ! humidity (kg/kg) + real(r8), intent(out) :: qsdT ! d(qs)/d(T) + ! + ! !LOCAL VARIABLES: + real(r8) :: T_limit + real(r8) :: td,vp,vp1,vp2 + !----------------------------------------------------------------------- + + T_limit = T - SHR_CONST_TKFRZ + if (T_limit > 100.0_r8) T_limit=100.0_r8 + if (T_limit < -75.0_r8) T_limit=-75.0_r8 + + td = T_limit + if (td >= 0.0_r8) then + es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + + else + es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + + endif + + es = es * 100._r8 ! pa + + esdT = esdT * 100._r8 ! pa/K + + + vp = 1.0_r8 / (p - 0.378_r8*es) + vp1 = 0.622_r8 * vp + vp2 = vp1 * vp + + qs = es * vp1 ! kg/kg + qsdT = esdT * vp2 * p ! 1 / K + + + end subroutine QSat + + + +!------------------------------------------------------------------------------- + subroutine rhoSat(T, rho, rhodT) + ! compute the saturated vapor pressure density and its derivative against the temperature + ! jyt + use clm_varcon, only: rwat + use shr_const_mod, only: SHR_CONST_TKFRZ + + implicit none + real(r8), intent(in) :: T + real(r8), intent(out) :: rho + real(r8), optional, intent(out) :: rhodT + + + !------------------ + + real(r8) :: T_limit + real(r8) :: td, es, esdT + + T_limit = T - SHR_CONST_TKFRZ + if (T_limit > 100.0_r8) T_limit=100.0_r8 + if (T_limit < -75.0_r8) T_limit=-75.0_r8 + + td = T_limit + if (td >= 0.0_r8) then + es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else + es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + endif + + es = es * 100._r8 ! pa + rho = es/(rwat*T) !kg m^-3 + if(present(rhodT))rhodT= esdT/(rwat*T)-rho/T !kg m^-3 K^-1 + end subroutine rhoSat +end module QSatMod diff --git a/components/clm/src/biogeophys/RootBiophysMod.F90 b/components/clm/src/biogeophys/RootBiophysMod.F90 new file mode 100644 index 0000000000..f165a96a78 --- /dev/null +++ b/components/clm/src/biogeophys/RootBiophysMod.F90 @@ -0,0 +1,131 @@ +module RootBiophysMod + +#include "shr_assert.h" + + !-------------------------------------------------------------------------------------- + ! DESCRIPTION: + ! module contains subroutine for root biophysics + ! + ! HISTORY + ! created by Jinyun Tang, Mar 1st, 2014 + implicit none + private + ! + public :: init_vegrootfr + public :: init_rootprof + integer, parameter :: zeng_2001_root = 0 !the zeng 2001 root profile function + + integer :: root_prof_method !select the type of root profile parameterization + !-------------------------------------------------------------------------------------- + +contains + + !-------------------------------------------------------------------------------------- + subroutine init_rootprof() + ! + !DESCRIPTION + ! initialize methods for root profile calculation + + root_prof_method = zeng_2001_root + + end subroutine init_rootprof + + !-------------------------------------------------------------------------------------- + subroutine init_vegrootfr(bounds, nlevsoi, nlevgrnd, rootfr) + ! + !DESCRIPTION + !initialize plant root profiles + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_assert_mod , only : shr_assert + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: nlevsoi ! number of hydactive layers + integer, intent(in) :: nlevgrnd ! number of soil layers + real(r8), intent(out):: rootfr(bounds%begp: , 1: ) ! + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'init_vegrootfr' ! subroutine name + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL((ubound(rootfr) == (/bounds%endp, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + select case (root_prof_method) + case (zeng_2001_root) + rootfr(bounds%begp:bounds%endp, 1 : nlevsoi) = zeng2001_rootfr(bounds, nlevsoi) + + !case (jackson_1996_root) + !jackson root, 1996, to be defined later + !rootfr(bounds%begp:bounds%endp, 1 : ubj) = jackson1996_rootfr(bounds, ubj, pcolumn, ivt, zi) + !case (schenk_jackson_2002_root) + !schenk and Jackson root, 2002, to be defined later + !rootfr(bounds%begp:bounds%endp, 1 : ubj) = schenk2002_rootfr(bounds, ubj, pcolumn, ivt, zi) + case default + call endrun(subname // ':: a root fraction function must be specified!') + end select + rootfr(bounds%begp:bounds%endp,nlevsoi+1:nlevgrnd)=0._r8 + + end subroutine init_vegrootfr + + !-------------------------------------------------------------------------------------- + function zeng2001_rootfr(bounds, ubj) result(rootfr) + ! + ! DESCRIPTION + ! compute root profile for soil water uptake + ! using equation from Zeng 2001, J. Hydrometeorology + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_assert_mod , only : shr_assert + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use pftconMod , only : noveg, pftcon + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj ! ubnd + ! + ! !RESULT + real(r8) :: rootfr(bounds%begp:bounds%endp , 1:ubj ) ! + ! + ! !LOCAL VARIABLES: + integer :: p, lev, c + !------------------------------------------------------------------------ + + !(computing from surface, d is depth in meter): + ! Y = 1 -1/2 (exp(-ad)+exp(-bd) under the constraint that + ! Y(d =0.1m) = 1-beta^(10 cm) and Y(d=d_obs)=0.99 with + ! beta & d_obs given in Zeng et al. (1998). + + do p = bounds%begp,bounds%endp + + if (patch%itype(p) /= noveg) then + c = patch%column(p) + do lev = 1, ubj-1 + rootfr(p,lev) = .5_r8*( & + exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev-1)) & + + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev-1)) & + - exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,lev )) & + - exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,lev )) ) + end do + rootfr(p,ubj) = .5_r8*( & + exp(-pftcon%roota_par(patch%itype(p)) * col%zi(c,ubj-1)) & + + exp(-pftcon%rootb_par(patch%itype(p)) * col%zi(c,ubj-1)) ) + + else + rootfr(p,1:ubj) = 0._r8 + endif + + enddo + return + + end function zeng2001_rootfr + +end module RootBiophysMod diff --git a/components/clm/src/biogeophys/SnowHydrologyMod.F90 b/components/clm/src/biogeophys/SnowHydrologyMod.F90 new file mode 100644 index 0000000000..5fb04f046a --- /dev/null +++ b/components/clm/src/biogeophys/SnowHydrologyMod.F90 @@ -0,0 +1,1491 @@ +! -*- mode: f90; indent-tabs-mode: nil; f90-do-indent:3; f90-if-indent:3; f90-type-indent:3; f90-program-indent:2; f90-associate-indent:0; f90-continuation-indent:5 -*- +module SnowHydrologyMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate snow hydrology. + ! - Using as input aerosol deposition from atmosphere model calculate + ! aerosol fluxes and masses in each layer - need for surface albedo calculation + ! - Change of snow mass and the snow water onto soil + ! - Change in snow layer thickness due to compaction + ! - Combine snow layers less than a min thickness + ! - Subdivide snow layers if they exceed maximum thickness + ! - Construct snow/no-snow filters + + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varpar , only : nlevsno + use clm_varctl , only : iulog + use clm_varcon , only : namec + use atm2lndType , only : atm2lnd_type + use AerosolMod , only : aerosol_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SnowWater ! Change of snow mass and the snow water onto soil + public :: SnowCompaction ! Change in snow layer thickness due to compaction + public :: CombineSnowLayers ! Combine snow layers less than a min thickness + public :: DivideSnowLayers ! Subdivide snow layers if they exceed maximum thickness + public :: InitSnowLayers ! Initialize cold-start snow layer thickness + public :: BuildSnowFilter ! Construct snow/no-snow filters + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: Combo ! Returns the combined variables: dz, t, wliq, wice. + private :: MassWeightedSnowRadius ! Mass weighted snow grain size + ! + ! !PUBLIC DATA MEMBERS: + ! Aerosol species indices: + ! 1= hydrophillic black carbon + ! 2= hydrophobic black carbon + ! 3= hydrophilic organic carbon + ! 4= hydrophobic organic carbon + ! 5= dust species 1 + ! 6= dust species 2 + ! 7= dust species 3 + ! 8= dust species 4 + ! + real(r8), public, parameter :: scvng_fct_mlt_bcphi = 0.20_r8 ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_bcpho = 0.03_r8 ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_ocphi = 0.20_r8 ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_ocpho = 0.03_r8 ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst1 = 0.02_r8 ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst2 = 0.02_r8 ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst3 = 0.01_r8 ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst4 = 0.01_r8 ! scavenging factor for dust species 4 inclusion in meltwater [frc] + + ! Definition of snow pack vertical structure + ! Hardcoded maximum of 12 snowlayers, this is checked elsewhere (controlMod.F90) + ! The bottom layer has no limit on thickness, hence 11 elements in dzmax_* arrays + real(r8), parameter :: dzmin(12) = & ! minimum of top snow layer + (/ 0.010_r8, 0.015_r8, 0.025_r8, 0.055_r8, 0.115_r8, 0.235_r8, & + 0.475_r8, 0.955_r8, 1.915_r8, 3.835_r8, 7.675_r8, 15.355_r8 /) + real(r8), parameter :: dzmax_l(11) = & ! maximum thickness of layer when no layers beneath + (/ 0.03_r8, 0.07_r8, 0.18_r8, 0.41_r8, 0.88_r8, 1.83_r8, & + 3.74_r8, 7.57_r8, 15.24_r8, 30.59_r8, 61.3_r8 /) + real(r8), parameter :: dzmax_u(11) = & ! maximum thickness of layer when layers beneath + (/ 0.02_r8, 0.05_r8, 0.11_r8, 0.23_r8, 0.47_r8, 0.95_r8, & + 1.91_r8, 3.83_r8, 7.67_r8, 15.35_r8, 30.71_r8 /) + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SnowWater(bounds, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & + atm2lnd_inst, waterflux_inst, waterstate_inst, aerosol_inst) + ! + ! !DESCRIPTION: + ! Evaluate the change of snow mass and the snow water onto soil. + ! Water flow within snow is computed by an explicit and non-physical + ! based scheme, which permits a part of liquid water over the holding + ! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to + ! percolate into the underlying layer. Except for cases where the + ! porosity of one of the two neighboring layers is less than 0.05, zero + ! flow is assumed. The water flow out of the bottom of the snow pack will + ! participate as the input of the soil water and runoff. This subroutine + ! uses a filter for columns containing snow which must be constructed prior + ! to being called. + ! + ! !USES: + use clm_varcon , only : denh2o, denice, wimp, ssi + use landunit_varcon , only : istsoil + use clm_time_manager , only : get_step_size + use AerosolMod , only : AerosolFluxes + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_snowc ! number of snow points in column filter + integer , intent(in) :: filter_snowc(:) ! column filter for snow points + integer , intent(in) :: num_nosnowc ! number of non-snow points in column filter + integer , intent(in) :: filter_nosnowc(:) ! column filter for non-snow points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(aerosol_type) , intent(inout) :: aerosol_inst + ! + ! !LOCAL VARIABLES: + integer :: g ! gridcell loop index + integer :: c, j, fc, l ! do loop/array indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: qin(bounds%begc:bounds%endc) ! water flow into the elmement (mm/s) + real(r8) :: qout(bounds%begc:bounds%endc) ! water flow out of the elmement (mm/s) + real(r8) :: qin_bc_phi (bounds%begc:bounds%endc) ! flux of hydrophilic BC into layer [kg] + real(r8) :: qout_bc_phi (bounds%begc:bounds%endc) ! flux of hydrophilic BC out of layer [kg] + real(r8) :: qin_bc_pho (bounds%begc:bounds%endc) ! flux of hydrophobic BC into layer [kg] + real(r8) :: qout_bc_pho (bounds%begc:bounds%endc) ! flux of hydrophobic BC out of layer [kg] + real(r8) :: qin_oc_phi (bounds%begc:bounds%endc) ! flux of hydrophilic OC into layer [kg] + real(r8) :: qout_oc_phi (bounds%begc:bounds%endc) ! flux of hydrophilic OC out of layer [kg] + real(r8) :: qin_oc_pho (bounds%begc:bounds%endc) ! flux of hydrophobic OC into layer [kg] + real(r8) :: qout_oc_pho (bounds%begc:bounds%endc) ! flux of hydrophobic OC out of layer [kg] + real(r8) :: qin_dst1 (bounds%begc:bounds%endc) ! flux of dust species 1 into layer [kg] + real(r8) :: qout_dst1 (bounds%begc:bounds%endc) ! flux of dust species 1 out of layer [kg] + real(r8) :: qin_dst2 (bounds%begc:bounds%endc) ! flux of dust species 2 into layer [kg] + real(r8) :: qout_dst2 (bounds%begc:bounds%endc) ! flux of dust species 2 out of layer [kg] + real(r8) :: qin_dst3 (bounds%begc:bounds%endc) ! flux of dust species 3 into layer [kg] + real(r8) :: qout_dst3 (bounds%begc:bounds%endc) ! flux of dust species 3 out of layer [kg] + real(r8) :: qin_dst4 (bounds%begc:bounds%endc) ! flux of dust species 4 into layer [kg] + real(r8) :: qout_dst4 (bounds%begc:bounds%endc) ! flux of dust species 4 out of layer [kg] + real(r8) :: wgdif ! ice mass after minus sublimation + real(r8) :: vol_liq(bounds%begc:bounds%endc,-nlevsno+1:0) ! partial volume of liquid water in layer + real(r8) :: vol_ice(bounds%begc:bounds%endc,-nlevsno+1:0) ! partial volume of ice lens in layer + real(r8) :: eff_porosity(bounds%begc:bounds%endc,-nlevsno+1:0) ! effective porosity = porosity - vol_ice + real(r8) :: mss_liqice(bounds%begc:bounds%endc,-nlevsno+1:0) ! mass of liquid+ice in a layer + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + int_snow => waterstate_inst%int_snow_col , & ! Output: [real(r8) (:) ] integrated snowfall [mm] + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + + qflx_snomelt => waterflux_inst%qflx_snomelt_col , & ! Input: [real(r8) (:) ] snow melt (mm H2O /s) + qflx_rain_grnd => waterflux_inst%qflx_rain_grnd_col , & ! Input: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] + qflx_sub_snow => waterflux_inst%qflx_sub_snow_col , & ! Input: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_dew_snow => waterflux_inst%qflx_dew_snow_col , & ! Input: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_col , & ! Input: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col,& ! Output: [real(r8) (:) ] net snow melt + qflx_top_soil => waterflux_inst%qflx_top_soil_col , & ! Output: [real(r8) (:) ] net water input into soil from top (mm/s) + + mss_bcphi => aerosol_inst%mss_bcphi_col , & ! Output: [real(r8) (:,:) ] hydrophillic BC mass in snow (col,lyr) [kg] + mss_bcpho => aerosol_inst%mss_bcpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic BC mass in snow (col,lyr) [kg] + mss_ocphi => aerosol_inst%mss_ocphi_col , & ! Output: [real(r8) (:,:) ] hydrophillic OC mass in snow (col,lyr) [kg] + mss_ocpho => aerosol_inst%mss_ocpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic OC mass in snow (col,lyr) [kg] + mss_dst1 => aerosol_inst%mss_dst1_col , & ! Output: [real(r8) (:,:) ] mass of dust species 1 in snow (col,lyr) [kg] + mss_dst2 => aerosol_inst%mss_dst2_col , & ! Output: [real(r8) (:,:) ] mass of dust species 2 in snow (col,lyr) [kg] + mss_dst3 => aerosol_inst%mss_dst3_col , & ! Output: [real(r8) (:,:) ] mass of dust species 3 in snow (col,lyr) [kg] + mss_dst4 => aerosol_inst%mss_dst4_col , & ! Output: [real(r8) (:,:) ] mass of dust species 4 in snow (col,lyr) [kg] + + begc => bounds%begc , & + endc => bounds%endc & + ) + + ! Determine model time step + + dtime = get_step_size() + + ! Renew the mass of ice lens (h2osoi_ice) and liquid (h2osoi_liq) in the + ! surface snow layer resulting from sublimation (frost) / evaporation (condense) + + do fc = 1,num_snowc + c = filter_snowc(fc) + l=col%landunit(c) + + if (do_capsnow(c)) then + wgdif = h2osoi_ice(c,snl(c)+1) - frac_sno_eff(c)*qflx_sub_snow(c)*dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0._r8) then + h2osoi_ice(c,snl(c)+1) = 0._r8 + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) & + - frac_sno_eff(c)*qflx_evap_grnd(c) * dtime + else + wgdif = h2osoi_ice(c,snl(c)+1) & + + frac_sno_eff(c) * (qflx_dew_snow(c) - qflx_sub_snow(c)) * dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0._r8) then + h2osoi_ice(c,snl(c)+1) = 0._r8 + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + & + frac_sno_eff(c) * (qflx_rain_grnd(c) + qflx_dew_grnd(c) & + - qflx_evap_grnd(c)) * dtime + end if + ! if negative, reduce deeper layer's liquid water content sequentially + if(h2osoi_liq(c,snl(c)+1) < 0._r8) then + do j = snl(c)+1, 1 + wgdif=h2osoi_liq(c,j) + if (wgdif >= 0._r8) exit + h2osoi_liq(c,j) = 0._r8 + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + wgdif + enddo + end if + end do + + ! Porosity and partial volume + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + ! need to scale dz by frac_sno to convert to grid cell average depth + vol_ice(c,j) = min(1._r8, h2osoi_ice(c,j)/(dz(c,j)*frac_sno_eff(c)*denice)) + eff_porosity(c,j) = 1._r8 - vol_ice(c,j) + vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*frac_sno_eff(c)*denh2o)) + end if + end do + end do + + ! Capillary forces within snow are usually two or more orders of magnitude + ! less than those of gravity. Only gravity terms are considered. + ! the genernal expression for water flow is "K * ss**3", however, + ! no effective parameterization for "K". Thus, a very simple consideration + ! (not physically based) is introduced: + ! when the liquid water of layer exceeds the layer's holding + ! capacity, the excess meltwater adds to the underlying neighbor layer. + + ! Also compute aerosol fluxes through snowpack in this loop: + ! 1) compute aerosol mass in each layer + ! 2) add aerosol mass flux from above layer to mass of this layer + ! 3) qout_xxx is mass flux of aerosol species xxx out bottom of + ! layer in water flow, proportional to (current) concentration + ! of aerosol in layer multiplied by a scavenging ratio. + ! 4) update mass of aerosol in top layer, accordingly + ! 5) update mass concentration of aerosol accordingly + + do c = bounds%begc,bounds%endc + qin(c) = 0._r8 + qin_bc_phi (c) = 0._r8 + qin_bc_pho (c) = 0._r8 + qin_oc_phi (c) = 0._r8 + qin_oc_pho (c) = 0._r8 + qin_dst1 (c) = 0._r8 + qin_dst2 (c) = 0._r8 + qin_dst3 (c) = 0._r8 + qin_dst4 (c) = 0._r8 + end do + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + + h2osoi_liq(c,j) = h2osoi_liq(c,j) + qin(c) + + mss_bcphi(c,j) = mss_bcphi(c,j) + qin_bc_phi(c) + mss_bcpho(c,j) = mss_bcpho(c,j) + qin_bc_pho(c) + mss_ocphi(c,j) = mss_ocphi(c,j) + qin_oc_phi(c) + mss_ocpho(c,j) = mss_ocpho(c,j) + qin_oc_pho(c) + + mss_dst1(c,j) = mss_dst1(c,j) + qin_dst1(c) + mss_dst2(c,j) = mss_dst2(c,j) + qin_dst2(c) + mss_dst3(c,j) = mss_dst3(c,j) + qin_dst3(c) + mss_dst4(c,j) = mss_dst4(c,j) + qin_dst4(c) + + if (j <= -1) then + ! No runoff over snow surface, just ponding on surface + if (eff_porosity(c,j) < wimp .OR. eff_porosity(c,j+1) < wimp) then + qout(c) = 0._r8 + else + ! dz must be scaled by frac_sno to obtain gridcell average value + qout(c) = max(0._r8,(vol_liq(c,j) & + - ssi*eff_porosity(c,j))*dz(c,j)*frac_sno_eff(c)) + qout(c) = min(qout(c),(1._r8-vol_ice(c,j+1) & + - vol_liq(c,j+1))*dz(c,j+1)*frac_sno_eff(c)) + end if + else + qout(c) = max(0._r8,(vol_liq(c,j) & + - ssi*eff_porosity(c,j))*dz(c,j)*frac_sno_eff(c)) + end if + qout(c) = qout(c)*1000._r8 + h2osoi_liq(c,j) = h2osoi_liq(c,j) - qout(c) + qin(c) = qout(c) + + ! mass of ice+water: in extremely rare circumstances, this can + ! be zero, even though there is a snow layer defined. In + ! this case, set the mass to a very small value to + ! prevent division by zero. + + mss_liqice(c,j) = h2osoi_liq(c,j)+h2osoi_ice(c,j) + if (mss_liqice(c,j) < 1E-30_r8) then + mss_liqice(c,j) = 1E-30_r8 + endif + + ! BCPHI: + ! 1. flux with meltwater: + qout_bc_phi(c) = qout(c)*scvng_fct_mlt_bcphi*(mss_bcphi(c,j)/mss_liqice(c,j)) + if (qout_bc_phi(c) > mss_bcphi(c,j)) then + qout_bc_phi(c) = mss_bcphi(c,j) + endif + mss_bcphi(c,j) = mss_bcphi(c,j) - qout_bc_phi(c) + qin_bc_phi(c) = qout_bc_phi(c) + + ! BCPHO: + ! 1. flux with meltwater: + qout_bc_pho(c) = qout(c)*scvng_fct_mlt_bcpho*(mss_bcpho(c,j)/mss_liqice(c,j)) + if (qout_bc_pho(c) > mss_bcpho(c,j)) then + qout_bc_pho(c) = mss_bcpho(c,j) + endif + mss_bcpho(c,j) = mss_bcpho(c,j) - qout_bc_pho(c) + qin_bc_pho(c) = qout_bc_pho(c) + + ! OCPHI: + ! 1. flux with meltwater: + qout_oc_phi(c) = qout(c)*scvng_fct_mlt_ocphi*(mss_ocphi(c,j)/mss_liqice(c,j)) + if (qout_oc_phi(c) > mss_ocphi(c,j)) then + qout_oc_phi(c) = mss_ocphi(c,j) + endif + mss_ocphi(c,j) = mss_ocphi(c,j) - qout_oc_phi(c) + qin_oc_phi(c) = qout_oc_phi(c) + + ! OCPHO: + ! 1. flux with meltwater: + qout_oc_pho(c) = qout(c)*scvng_fct_mlt_ocpho*(mss_ocpho(c,j)/mss_liqice(c,j)) + if (qout_oc_pho(c) > mss_ocpho(c,j)) then + qout_oc_pho(c) = mss_ocpho(c,j) + endif + mss_ocpho(c,j) = mss_ocpho(c,j) - qout_oc_pho(c) + qin_oc_pho(c) = qout_oc_pho(c) + + ! DUST 1: + ! 1. flux with meltwater: + qout_dst1(c) = qout(c)*scvng_fct_mlt_dst1*(mss_dst1(c,j)/mss_liqice(c,j)) + if (qout_dst1(c) > mss_dst1(c,j)) then + qout_dst1(c) = mss_dst1(c,j) + endif + mss_dst1(c,j) = mss_dst1(c,j) - qout_dst1(c) + qin_dst1(c) = qout_dst1(c) + + ! DUST 2: + ! 1. flux with meltwater: + qout_dst2(c) = qout(c)*scvng_fct_mlt_dst2*(mss_dst2(c,j)/mss_liqice(c,j)) + if (qout_dst2(c) > mss_dst2(c,j)) then + qout_dst2(c) = mss_dst2(c,j) + endif + mss_dst2(c,j) = mss_dst2(c,j) - qout_dst2(c) + qin_dst2(c) = qout_dst2(c) + + ! DUST 3: + ! 1. flux with meltwater: + qout_dst3(c) = qout(c)*scvng_fct_mlt_dst3*(mss_dst3(c,j)/mss_liqice(c,j)) + if (qout_dst3(c) > mss_dst3(c,j)) then + qout_dst3(c) = mss_dst3(c,j) + endif + mss_dst3(c,j) = mss_dst3(c,j) - qout_dst3(c) + qin_dst3(c) = qout_dst3(c) + + ! DUST 4: + ! 1. flux with meltwater: + qout_dst4(c) = qout(c)*scvng_fct_mlt_dst4*(mss_dst4(c,j)/mss_liqice(c,j)) + if (qout_dst4(c) > mss_dst4(c,j)) then + qout_dst4(c) = mss_dst4(c,j) + endif + mss_dst4(c,j) = mss_dst4(c,j) - qout_dst4(c) + qin_dst4(c) = qout_dst4(c) + + end if + end do + end do + + ! Compute aerosol fluxes through snowpack and aerosol deposition fluxes into top layere + + call AerosolFluxes(bounds, num_snowc, filter_snowc, & + atm2lnd_inst, aerosol_inst) + + ! Adjust layer thickness for any water+ice content changes in excess of previous + ! layer thickness. Strictly speaking, only necessary for top snow layer, but doing + ! it for all snow layers will catch problems with older initial files. + ! Layer interfaces (zi) and node depths (z) do not need adjustment here because they + ! are adjusted in CombineSnowLayers and are not used up to that point. + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + dz(c,j) = max(dz(c,j),h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice) + end if + end do + end do + + do fc = 1, num_snowc + c = filter_snowc(fc) + ! Qout from snow bottom + qflx_snow_drain(c) = qflx_snow_drain(c) + (qout(c) / dtime) + + qflx_top_soil(c) = (qout(c) / dtime) & + + (1.0_r8 - frac_sno_eff(c)) * qflx_rain_grnd(c) + int_snow(c) = int_snow(c) + frac_sno_eff(c) & + * (qflx_dew_snow(c) + qflx_dew_grnd(c) + qflx_rain_grnd(c)) * dtime + end do + + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + qflx_snow_drain(c) = qflx_snomelt(c) + + qflx_top_soil(c) = qflx_rain_grnd(c) + qflx_snomelt(c) + ! reset accumulated snow when no snow present + if (h2osno(c) <= 0) int_snow(c) = 0. + if (h2osno(c) <= 0) frac_sno(c) = 0. + end do + + end associate + end subroutine SnowWater + + !----------------------------------------------------------------------- + subroutine SnowCompaction(bounds, num_snowc, filter_snowc, & + temperature_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Determine the change in snow layer thickness due to compaction and + ! settling. + ! Three metamorphisms of changing snow characteristics are implemented, + ! i.e., destructive, overburden, and melt. The treatments of the former + ! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution + ! due to melt metamorphism is simply taken as a ratio of snow ice + ! fraction after the melting versus before the melting. + ! + ! !USES: + use clm_time_manager, only : get_step_size + use clm_varcon , only : denice, denh2o, tfrz, rpi + use landunit_varcon , only : istice_mec, istdlak, istsoil, istcrop + use clm_varctl , only : subgridflag + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_snowc ! number of column snow points in column filter + integer , intent(in) :: filter_snowc(:) ! column filter for snow points + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: j, l, c, fc ! indices + real(r8):: dtime ! land model time step (sec) + ! parameters + real(r8), parameter :: c2 = 23.e-3_r8 ! [m3/kg] + real(r8), parameter :: c3 = 2.777e-6_r8 ! [1/s] + real(r8), parameter :: c4 = 0.04_r8 ! [1/K] + real(r8), parameter :: c5 = 2.0_r8 ! + real(r8), parameter :: dm = 100.0_r8 ! Upper Limit on Destructive Metamorphism Compaction [kg/m3] + real(r8), parameter :: eta0 = 9.e+5_r8 ! The Viscosity Coefficient Eta0 [kg-s/m2] + ! + real(r8) :: burden(bounds%begc:bounds%endc) ! pressure of overlying snow [kg/m2] + real(r8) :: ddz1 ! Rate of settling of snowpack due to destructive metamorphism. + real(r8) :: ddz2 ! Rate of compaction of snowpack due to overburden. + real(r8) :: ddz3 ! Rate of compaction of snowpack due to melt [1/s] + real(r8) :: dexpf ! expf=exp(-c4*(273.15-t_soisno)). + real(r8) :: fi ! Fraction of ice relative to the total water content at current time step + real(r8) :: td ! t_soisno - tfrz [K] + real(r8) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s] + real(r8) :: void ! void (1 - vol_ice - vol_liq) + real(r8) :: wx ! water mass (ice+liquid) [kg/m2] + real(r8) :: bi ! partial density of ice [kg/m3] + real(r8) :: wsum ! snowpack total water mass (ice+liquid) [kg/m2] + real(r8) :: fsno_melt + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + n_melt => col%n_melt , & ! Input: [real(r8) (:) ] SCA shape parameter + ltype => lun%itype , & ! Input: [integer (:) ] landunit type + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + imelt => temperature_inst%imelt_col , & ! Input: [integer (:,:) ] flag for melting (=1), freezing (=2), Not=0 + + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] snow covered fraction + swe_old => waterstate_inst%swe_old_col , & ! Input: [real(r8) (:,:) ] initial swe values + int_snow => waterstate_inst%int_snow_col , & ! Input: [real(r8) (:) ] integrated snowfall [mm] + frac_iceold => waterstate_inst%frac_iceold_col , & ! Input: [real(r8) (:,:) ] fraction of ice relative to the tot water + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + + dz => col%dz & ! Output: [real(r8) (: ,:) ] layer depth (m) + ) + + ! Get time step + + dtime = get_step_size() + + ! Begin calculation - note that the following column loops are only invoked if snl(c) < 0 + + burden(bounds%begc : bounds%endc) = 0._r8 + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + + wx = h2osoi_ice(c,j) + h2osoi_liq(c,j) + void = 1._r8 - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o) / dz(c,j) + wx = (h2osoi_ice(c,j) + h2osoi_liq(c,j)) + void = 1._r8 - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o)& + /(frac_sno(c) * dz(c,j)) + + ! Allow compaction only for non-saturated node and higher ice lens node. + if (void > 0.001_r8 .and. h2osoi_ice(c,j) > .1_r8) then + + bi = h2osoi_ice(c,j) / (frac_sno(c) * dz(c,j)) + fi = h2osoi_ice(c,j) / wx + td = tfrz-t_soisno(c,j) + dexpf = exp(-c4*td) + + ! Settling as a result of destructive metamorphism + + ddz1 = -c3*dexpf + if (bi > dm) ddz1 = ddz1*exp(-46.0e-3_r8*(bi-dm)) + + ! Liquid water term + + if (h2osoi_liq(c,j) > 0.01_r8*dz(c,j)*frac_sno(c)) ddz1=ddz1*c5 + + ! Compaction due to overburden + + ddz2 = -(burden(c)+wx/2._r8)*exp(-0.08_r8*td - c2*bi)/eta0 + + ! Compaction occurring during melt + + if (imelt(c,j) == 1) then + if(subgridflag==1 .and. (ltype(col%landunit(c)) == istsoil .or. ltype(col%landunit(c)) == istcrop)) then + ! first term is delta mass over mass + ddz3 = max(0._r8,min(1._r8,(swe_old(c,j) - wx)/wx)) + + ! 2nd term is delta fsno over fsno, allowing for negative values for ddz3 + wsum = sum(h2osoi_liq(c,snl(c)+1:0)+h2osoi_ice(c,snl(c)+1:0)) + fsno_melt = 1. - (acos(2.*min(1._r8,wsum/int_snow(c)) - 1._r8)/rpi)**(n_melt(c)) + + ddz3 = ddz3 - max(0._r8,(fsno_melt - frac_sno(c))/frac_sno(c)) + ddz3 = -1._r8/dtime * ddz3 + else + ddz3 = - 1._r8/dtime * max(0._r8,(frac_iceold(c,j) - fi)/frac_iceold(c,j)) + endif + else + ddz3 = 0._r8 + end if + + ! Time rate of fractional change in dz (units of s-1) + + pdzdtc = ddz1 + ddz2 + ddz3 + + ! The change in dz due to compaction + ! Limit compaction to be no greater than fully saturated layer thickness + + dz(c,j) = max(dz(c,j) * (1._r8+pdzdtc*dtime),(h2osoi_ice(c,j)/denice+ h2osoi_liq(c,j)/denh2o)/frac_sno(c)) + end if + + ! Pressure of overlying snow + + burden(c) = burden(c) + wx + + end if + end do + end do + + end associate + end subroutine SnowCompaction + + !----------------------------------------------------------------------- + subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & + aerosol_inst, temperature_inst, waterflux_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Combine snow layers that are less than a minimum thickness or mass + ! If the snow element thickness or mass is less than a prescribed minimum, + ! then it is combined with a neighboring element. The subroutine + ! clm\_combo.f90 then executes the combination of mass and energy. + ! + ! !USES: + use landunit_varcon , only : istsoil, istdlak, istsoil, istwet, istice, istice_mec, istcrop + use LakeCon , only : lsadz + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(inout) :: num_snowc ! number of column snow points in column filter + integer , intent(inout) :: filter_snowc(:) ! column filter for snow points + type(aerosol_type) , intent(inout) :: aerosol_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c, fc ! column indices + integer :: i,k ! loop indices + integer :: j,l ! node indices + integer :: msn_old(bounds%begc:bounds%endc) ! number of top snow layer + integer :: mssi(bounds%begc:bounds%endc) ! node index + integer :: neibor ! adjacent node selected for combination + real(r8):: zwice(bounds%begc:bounds%endc) ! total ice mass in snow + real(r8):: zwliq (bounds%begc:bounds%endc) ! total liquid water in snow + real(r8):: dzminloc(size(dzmin)) ! minimum of top snow layer (local) + real(r8):: dtime !land model time step (sec) + + !----------------------------------------------------------------------- + + associate( & + ltype => lun%itype , & ! Input: [integer (:) ] landunit type + urbpoi => lun%urbpoi , & ! Input: [logical (:) ] true => landunit is an urban point + + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + + mss_bcphi => aerosol_inst%mss_bcphi_col , & ! Output: [real(r8) (:,:) ] hydrophilic BC mass in snow (col,lyr) [kg] + mss_bcpho => aerosol_inst%mss_bcpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic BC mass in snow (col,lyr) [kg] + mss_ocphi => aerosol_inst%mss_ocphi_col , & ! Output: [real(r8) (:,:) ] hydrophilic OC mass in snow (col,lyr) [kg] + mss_ocpho => aerosol_inst%mss_ocpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic OC mass in snow (col,lyr) [kg] + mss_dst1 => aerosol_inst%mss_dst1_col , & ! Output: [real(r8) (:,:) ] dust species 1 mass in snow (col,lyr) [kg] + mss_dst2 => aerosol_inst%mss_dst2_col , & ! Output: [real(r8) (:,:) ] dust species 2 mass in snow (col,lyr) [kg] + mss_dst3 => aerosol_inst%mss_dst3_col , & ! Output: [real(r8) (:,:) ] dust species 3 mass in snow (col,lyr) [kg] + mss_dst4 => aerosol_inst%mss_dst4_col , & ! Output: [real(r8) (:,:) ] dust species 4 mass in snow (col,lyr) [kg] + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + int_snow => waterstate_inst%int_snow_col , & ! Input: [real(r8) (:) ] integrated snowfall [mm] + h2osno => waterstate_inst%h2osno_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] + + qflx_sl_top_soil => waterflux_inst%qflx_sl_top_soil_col , & ! Output: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + + snl => col%snl , & ! Output: [integer (:) ] number of snow layers + dz => col%dz , & ! Output: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Output: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z & ! Output: [real(r8) (:,:) ] layer thickness (m) + ) + + ! Determine model time step + + dtime = get_step_size() + + ! Check the mass of ice lens of snow, when the total is less than a small value, + ! combine it with the underlying neighbor. + + dzminloc(:) = dzmin(:) ! dzmin will stay constant between timesteps + + ! Add lsadz to dzmin for lakes + ! Determine whether called from LakeHydrology + ! Note: this assumes that this function is called separately with the lake-snow and non-lake-snow filters. + if (num_snowc > 0) then + c = filter_snowc(1) + l = col%landunit(c) + if (ltype(l) == istdlak) then ! Called from LakeHydrology + dzminloc(:) = dzmin(:) + lsadz + end if + end if + + do fc = 1, num_snowc + c = filter_snowc(fc) + + msn_old(c) = snl(c) + qflx_sl_top_soil(c) = 0._r8 + end do + + ! The following loop is NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + l = col%landunit(c) + do j = msn_old(c)+1,0 + ! use 0.01 to avoid runaway ice buildup + if (h2osoi_ice(c,j) <= .01_r8) then + if (ltype(l) == istsoil .or. urbpoi(l) .or. ltype(l) == istcrop) then + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + + if (j == 0) then + qflx_sl_top_soil(c) = (h2osoi_liq(c,j) + h2osoi_ice(c,j))/dtime + end if + + if (j /= 0) dz(c,j+1) = dz(c,j+1) + dz(c,j) + + ! NOTE: Temperature, and similarly snw_rds, of the + ! underlying snow layer are NOT adjusted in this case. + ! Because the layer being eliminated has a small mass, + ! this should not make a large difference, but it + ! would be more thorough to do so. + if (j /= 0) then + mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j) + mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j) + mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j) + mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j) + mss_dst1(c,j+1) = mss_dst1(c,j+1) + mss_dst1(c,j) + mss_dst2(c,j+1) = mss_dst2(c,j+1) + mss_dst2(c,j) + mss_dst3(c,j+1) = mss_dst3(c,j+1) + mss_dst3(c,j) + mss_dst4(c,j+1) = mss_dst4(c,j+1) + mss_dst4(c,j) + end if + + else if (ltype(l) /= istsoil .and. .not. urbpoi(l) .and. ltype(l) /= istcrop .and. j /= 0) then + + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + dz(c,j+1) = dz(c,j+1) + dz(c,j) + + mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j) + mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j) + mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j) + mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j) + mss_dst1(c,j+1) = mss_dst1(c,j+1) + mss_dst1(c,j) + mss_dst2(c,j+1) = mss_dst2(c,j+1) + mss_dst2(c,j) + mss_dst3(c,j+1) = mss_dst3(c,j+1) + mss_dst3(c,j) + mss_dst4(c,j+1) = mss_dst4(c,j+1) + mss_dst4(c,j) + + end if + + ! shift all elements above this down one. + if (j > snl(c)+1 .and. snl(c) < -1) then + do i = j, snl(c)+2, -1 + ! If the layer closest to the surface is less than 0.1 mm and the ltype is not + ! urban, soil or crop, the h2osoi_liq and h2osoi_ice associated with this layer is sent + ! to qflx_qrgwl later on in the code. To keep track of this for the snow balance + ! error check, we add this to qflx_sl_top_soil here + if (ltype(l) /= istsoil .and. ltype(l) /= istcrop .and. .not. urbpoi(l) .and. i == 0) then + qflx_sl_top_soil(c) = (h2osoi_liq(c,i) + h2osoi_ice(c,i))/dtime + end if + + t_soisno(c,i) = t_soisno(c,i-1) + h2osoi_liq(c,i) = h2osoi_liq(c,i-1) + h2osoi_ice(c,i) = h2osoi_ice(c,i-1) + + mss_bcphi(c,i) = mss_bcphi(c,i-1) + mss_bcpho(c,i) = mss_bcpho(c,i-1) + mss_ocphi(c,i) = mss_ocphi(c,i-1) + mss_ocpho(c,i) = mss_ocpho(c,i-1) + mss_dst1(c,i) = mss_dst1(c,i-1) + mss_dst2(c,i) = mss_dst2(c,i-1) + mss_dst3(c,i) = mss_dst3(c,i-1) + mss_dst4(c,i) = mss_dst4(c,i-1) + snw_rds(c,i) = snw_rds(c,i-1) + + dz(c,i) = dz(c,i-1) + end do + end if + snl(c) = snl(c) + 1 + end if + end do + end do + + do fc = 1, num_snowc + c = filter_snowc(fc) + h2osno(c) = 0._r8 + snow_depth(c) = 0._r8 + zwice(c) = 0._r8 + zwliq(c) = 0._r8 + end do + + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + snow_depth(c) = snow_depth(c) + dz(c,j) + zwice(c) = zwice(c) + h2osoi_ice(c,j) + zwliq(c) = zwliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Check the snow depth - all snow gone + ! The liquid water assumes ponding on soil surface. + + do fc = 1, num_snowc + c = filter_snowc(fc) + l = col%landunit(c) + if (snow_depth(c) > 0._r8) then + if ((ltype(l) == istdlak .and. snow_depth(c) < 0.01_r8 + lsadz ) .or. & + ((ltype(l) /= istdlak) .and. ((frac_sno_eff(c)*snow_depth(c) < 0.01_r8) & + .or. (h2osno(c)/(frac_sno_eff(c)*snow_depth(c)) < 50._r8)))) then + + snl(c) = 0 + h2osno(c) = zwice(c) + + mss_bcphi(c,:) = 0._r8 + mss_bcpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_ocpho(c,:) = 0._r8 + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + + if (h2osno(c) <= 0._r8) snow_depth(c) = 0._r8 + ! this is where water is transfered from layer 0 (snow) to layer 1 (soil) + if (ltype(l) == istsoil .or. urbpoi(l) .or. ltype(l) == istcrop) then + h2osoi_liq(c,0) = 0.0_r8 + h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c) + end if + if (ltype(l) == istwet) then + h2osoi_liq(c,0) = 0.0_r8 + endif + if (ltype(l) == istice .or. ltype(l)==istice_mec) then + h2osoi_liq(c,0) = 0.0_r8 + endif + endif + end if + if (h2osno(c) <= 0._r8) then + snow_depth(c) = 0._r8 + frac_sno(c) = 0._r8 + frac_sno_eff(c) = 0._r8 + int_snow(c) = 0._r8 + endif + end do + + ! Check the snow depth - snow layers combined + ! The following loop IS NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + + ! Two or more layers + + if (snl(c) < -1) then + + msn_old(c) = snl(c) + mssi(c) = 1 + + do i = msn_old(c)+1,0 + if ((frac_sno_eff(c)*dz(c,i) < dzminloc(mssi(c))) .or. & + ((h2osoi_ice(c,i) + h2osoi_liq(c,i))/(frac_sno_eff(c)*dz(c,i)) < 50._r8)) then + if (i == snl(c)+1) then + ! If top node is removed, combine with bottom neighbor. + neibor = i + 1 + else if (i == 0) then + ! If the bottom neighbor is not snow, combine with the top neighbor. + neibor = i - 1 + else + ! If none of the above special cases apply, combine with the thinnest neighbor + neibor = i + 1 + if ((dz(c,i-1)+dz(c,i)) < (dz(c,i+1)+dz(c,i))) neibor = i-1 + end if + + ! Node l and j are combined and stored as node j. + if (neibor > i) then + j = neibor + l = i + else + j = i + l = neibor + end if + + ! this should be included in 'Combo' for consistency, + ! but functionally it is the same to do it here + mss_bcphi(c,j)=mss_bcphi(c,j)+mss_bcphi(c,l) + mss_bcpho(c,j)=mss_bcpho(c,j)+mss_bcpho(c,l) + mss_ocphi(c,j)=mss_ocphi(c,j)+mss_ocphi(c,l) + mss_ocpho(c,j)=mss_ocpho(c,j)+mss_ocpho(c,l) + mss_dst1(c,j)=mss_dst1(c,j)+mss_dst1(c,l) + mss_dst2(c,j)=mss_dst2(c,j)+mss_dst2(c,l) + mss_dst3(c,j)=mss_dst3(c,j)+mss_dst3(c,l) + mss_dst4(c,j)=mss_dst4(c,j)+mss_dst4(c,l) + + ! mass-weighted combination of effective grain size: + snw_rds(c,j) = (snw_rds(c,j)*(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + & + snw_rds(c,l)*(h2osoi_liq(c,l)+h2osoi_ice(c,l))) / & + (h2osoi_liq(c,j)+h2osoi_ice(c,j)+h2osoi_liq(c,l)+h2osoi_ice(c,l)) + + call Combo (dz(c,j), h2osoi_liq(c,j), h2osoi_ice(c,j), & + t_soisno(c,j), dz(c,l), h2osoi_liq(c,l), h2osoi_ice(c,l), t_soisno(c,l) ) + + ! Now shift all elements above this down one. + if (j-1 > snl(c)+1) then + + do k = j-1, snl(c)+2, -1 + t_soisno(c,k) = t_soisno(c,k-1) + h2osoi_ice(c,k) = h2osoi_ice(c,k-1) + h2osoi_liq(c,k) = h2osoi_liq(c,k-1) + + mss_bcphi(c,k) = mss_bcphi(c,k-1) + mss_bcpho(c,k) = mss_bcpho(c,k-1) + mss_ocphi(c,k) = mss_ocphi(c,k-1) + mss_ocpho(c,k) = mss_ocpho(c,k-1) + mss_dst1(c,k) = mss_dst1(c,k-1) + mss_dst2(c,k) = mss_dst2(c,k-1) + mss_dst3(c,k) = mss_dst3(c,k-1) + mss_dst4(c,k) = mss_dst4(c,k-1) + snw_rds(c,k) = snw_rds(c,k-1) + + dz(c,k) = dz(c,k-1) + end do + end if + + ! Decrease the number of snow layers + snl(c) = snl(c) + 1 + if (snl(c) >= -1) EXIT + + else + + ! The layer thickness is greater than the prescribed minimum value + mssi(c) = mssi(c) + 1 + + end if + end do + + end if + + end do + + ! Reset the node depth and the depth of layer interface + + do j = 0, -nlevsno+1, -1 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c) + 1) then + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end associate + end subroutine CombineSnowLayers + + !----------------------------------------------------------------------- + subroutine DivideSnowLayers(bounds, num_snowc, filter_snowc, & + aerosol_inst, temperature_inst, waterstate_inst, is_lake) + ! + ! !DESCRIPTION: + ! Subdivides snow layers if they exceed their prescribed maximum thickness. + ! + ! !USES: + use clm_varcon, only : tfrz + use LakeCon , only : lsadz + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_snowc ! number of column snow points in column filter + integer , intent(in) :: filter_snowc(:) ! column filter for snow points + type(aerosol_type) , intent(inout) :: aerosol_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + logical , intent(in) :: is_lake !TODO - this should be examined and removed in the future + ! + ! !LOCAL VARIABLES: + integer :: j, c, fc, k ! indices + real(r8) :: drr ! thickness of the combined [m] + integer :: msno ! number of snow layer 1 (top) to msno (bottom) + real(r8) :: dzsno(bounds%begc:bounds%endc,nlevsno) ! Snow layer thickness [m] + real(r8) :: swice(bounds%begc:bounds%endc,nlevsno) ! Partial volume of ice [m3/m3] + real(r8) :: swliq(bounds%begc:bounds%endc,nlevsno) ! Partial volume of liquid water [m3/m3] + real(r8) :: tsno(bounds%begc:bounds%endc ,nlevsno) ! Nodel temperature [K] + real(r8) :: zwice ! temporary + real(r8) :: zwliq ! temporary + real(r8) :: propor ! temporary + real(r8) :: dtdz ! temporary + ! temporary variables mimicking the structure of other layer division variables + real(r8) :: mbc_phi(bounds%begc:bounds%endc,nlevsno) ! mass of BC in each snow layer + real(r8) :: zmbc_phi ! temporary + real(r8) :: mbc_pho(bounds%begc:bounds%endc,nlevsno) ! mass of BC in each snow layer + real(r8) :: zmbc_pho ! temporary + real(r8) :: moc_phi(bounds%begc:bounds%endc,nlevsno) ! mass of OC in each snow layer + real(r8) :: zmoc_phi ! temporary + real(r8) :: moc_pho(bounds%begc:bounds%endc,nlevsno) ! mass of OC in each snow layer + real(r8) :: zmoc_pho ! temporary + real(r8) :: mdst1(bounds%begc:bounds%endc,nlevsno) ! mass of dust 1 in each snow layer + real(r8) :: zmdst1 ! temporary + real(r8) :: mdst2(bounds%begc:bounds%endc,nlevsno) ! mass of dust 2 in each snow layer + real(r8) :: zmdst2 ! temporary + real(r8) :: mdst3(bounds%begc:bounds%endc,nlevsno) ! mass of dust 3 in each snow layer + real(r8) :: zmdst3 ! temporary + real(r8) :: mdst4(bounds%begc:bounds%endc,nlevsno) ! mass of dust 4 in each snow layer + real(r8) :: zmdst4 ! temporary + real(r8) :: rds(bounds%begc:bounds%endc,nlevsno) + ! Variables for consistency check + real(r8) :: dztot(bounds%begc:bounds%endc) + real(r8) :: snwicetot(bounds%begc:bounds%endc) + real(r8) :: snwliqtot(bounds%begc:bounds%endc) + real(r8) :: offset ! temporary + !----------------------------------------------------------------------- + + associate( & + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Output: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] + + mss_bcphi => aerosol_inst%mss_bcphi_col , & ! Output: [real(r8) (:,:) ] hydrophilic BC mass in snow (col,lyr) [kg] + mss_bcpho => aerosol_inst%mss_bcpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic BC mass in snow (col,lyr) [kg] + mss_ocphi => aerosol_inst%mss_ocphi_col , & ! Output: [real(r8) (:,:) ] hydrophilic OC mass in snow (col,lyr) [kg] + mss_ocpho => aerosol_inst%mss_ocpho_col , & ! Output: [real(r8) (:,:) ] hydrophobic OC mass in snow (col,lyr) [kg] + mss_dst1 => aerosol_inst%mss_dst1_col , & ! Output: [real(r8) (:,:) ] dust species 1 mass in snow (col,lyr) [kg] + mss_dst2 => aerosol_inst%mss_dst2_col , & ! Output: [real(r8) (:,:) ] dust species 2 mass in snow (col,lyr) [kg] + mss_dst3 => aerosol_inst%mss_dst3_col , & ! Output: [real(r8) (:,:) ] dust species 3 mass in snow (col,lyr) [kg] + mss_dst4 => aerosol_inst%mss_dst4_col , & ! Output: [real(r8) (:,:) ] dust species 4 mass in snow (col,lyr) [kg] + + snl => col%snl , & ! Output: [integer (:) ] number of snow layers + dz => col%dz , & ! Output: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Output: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z & ! Output: [real(r8) (:,:) ] layer thickness (m) + ) + + if ( is_lake ) then + ! Initialize for consistency check + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + + if (j == -nlevsno+1) then + dztot(c) = 0._r8 + snwicetot(c) = 0._r8 + snwliqtot(c) = 0._r8 + end if + + if (j >= snl(c)+1) then + dztot(c) = dztot(c) + dz(c,j) + snwicetot(c) = snwicetot(c) + h2osoi_ice(c,j) + snwliqtot(c) = snwliqtot(c) + h2osoi_liq(c,j) + end if + end do + end do + end if + + ! Begin calculation - note that the following column loops are only invoked + ! for snow-covered columns + + do j = 1,nlevsno + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j <= abs(snl(c))) then + if (is_lake) then + dzsno(c,j) = dz(c,j+snl(c)) + else + dzsno(c,j) = frac_sno(c)*dz(c,j+snl(c)) + end if + swice(c,j) = h2osoi_ice(c,j+snl(c)) + swliq(c,j) = h2osoi_liq(c,j+snl(c)) + tsno(c,j) = t_soisno(c,j+snl(c)) + + mbc_phi(c,j) = mss_bcphi(c,j+snl(c)) + mbc_pho(c,j) = mss_bcpho(c,j+snl(c)) + moc_phi(c,j) = mss_ocphi(c,j+snl(c)) + moc_pho(c,j) = mss_ocpho(c,j+snl(c)) + mdst1(c,j) = mss_dst1(c,j+snl(c)) + mdst2(c,j) = mss_dst2(c,j+snl(c)) + mdst3(c,j) = mss_dst3(c,j+snl(c)) + mdst4(c,j) = mss_dst4(c,j+snl(c)) + rds(c,j) = snw_rds(c,j+snl(c)) + end if + end do + end do + + loop_snowcolumns: do fc = 1, num_snowc + c = filter_snowc(fc) + + msno = abs(snl(c)) + + ! Now traverse layers from top to bottom in a dynamic way, as the total + ! number of layers (msno) may increase during the loop. + ! Impose k < nlevsno; the special case 'k == nlevsno' is not relevant, + ! as it is neither allowed to subdivide nor does it have layers below. + k = 1 + loop_layers: do while( k <= msno .and. k < nlevsno ) + + ! Current layer is bottom layer + if (k == msno) then + + if (is_lake) then + offset = 2._r8 * lsadz + else + offset = 0._r8 + end if + + if (dzsno(c,k) > dzmax_l(k) + offset) then + ! Subdivide layer into two layers with equal thickness, water + ! content, ice content and temperature + msno = msno + 1 + dzsno(c,k) = dzsno(c,k) / 2.0_r8 + dzsno(c,k+1) = dzsno(c,k) + swice(c,k) = swice(c,k) / 2.0_r8 + swice(c,k+1) = swice(c,k) + swliq(c,k) = swliq(c,k) / 2.0_r8 + swliq(c,k+1) = swliq(c,k) + + if (k == 1) then + ! special case + tsno(c,k+1) = tsno(c,k) + else + ! use temperature gradient + dtdz = (tsno(c,k-1) - tsno(c,k))/((dzsno(c,k-1)+2*dzsno(c,k))/2.0_r8) + tsno(c,k+1) = tsno(c,k) - dtdz*dzsno(c,k)/2.0_r8 + if (tsno(c,k+1) >= tfrz) then + tsno(c,k+1) = tsno(c,k) + else + tsno(c,k) = tsno(c,k) + dtdz*dzsno(c,k)/2.0_r8 + endif + end if + + mbc_phi(c,k) = mbc_phi(c,k) / 2.0_r8 + mbc_phi(c,k+1) = mbc_phi(c,k) + mbc_pho(c,k) = mbc_pho(c,k) / 2.0_r8 + mbc_pho(c,k+1) = mbc_pho(c,k) + moc_phi(c,k) = moc_phi(c,k) / 2.0_r8 + moc_phi(c,k+1) = moc_phi(c,k) + moc_pho(c,k) = moc_pho(c,k) / 2.0_r8 + moc_pho(c,k+1) = moc_pho(c,k) + mdst1(c,k) = mdst1(c,k) / 2.0_r8 + mdst1(c,k+1) = mdst1(c,k) + mdst2(c,k) = mdst2(c,k) / 2.0_r8 + mdst2(c,k+1) = mdst2(c,k) + mdst3(c,k) = mdst3(c,k) / 2.0_r8 + mdst3(c,k+1) = mdst3(c,k) + mdst4(c,k) = mdst4(c,k) / 2.0_r8 + mdst4(c,k+1) = mdst4(c,k) + + rds(c,k+1) = rds(c,k) + end if + end if + + ! There are layers below (note this is not exclusive with previous + ! if-statement, since msno may have increased in the previous if-statement) + if (k < msno) then + + if (is_lake) then + offset = lsadz + else + offset = 0._r8 + end if + + if (dzsno(c,k) > dzmax_u(k) + offset ) then + ! Only dump excess snow to underlying layer in a conservative fashion. + ! Other quantities will depend on the height of the excess snow: a ratio is used for this. + drr = dzsno(c,k) - dzmax_u(k) - offset + + propor = drr/dzsno(c,k) + zwice = propor*swice(c,k) + zwliq = propor*swliq(c,k) + zmbc_phi = propor*mbc_phi(c,k) + zmbc_pho = propor*mbc_pho(c,k) + zmoc_phi = propor*moc_phi(c,k) + zmoc_pho = propor*moc_pho(c,k) + zmdst1 = propor*mdst1(c,k) + zmdst2 = propor*mdst2(c,k) + zmdst3 = propor*mdst3(c,k) + zmdst4 = propor*mdst4(c,k) + + propor = (dzmax_u(k)+offset)/dzsno(c,k) + swice(c,k) = propor*swice(c,k) + swliq(c,k) = propor*swliq(c,k) + mbc_phi(c,k) = propor*mbc_phi(c,k) + mbc_pho(c,k) = propor*mbc_pho(c,k) + moc_phi(c,k) = propor*moc_phi(c,k) + moc_pho(c,k) = propor*moc_pho(c,k) + mdst1(c,k) = propor*mdst1(c,k) + mdst2(c,k) = propor*mdst2(c,k) + mdst3(c,k) = propor*mdst3(c,k) + mdst4(c,k) = propor*mdst4(c,k) + + ! Set depth layer k to maximum allowed value + dzsno(c,k) = dzmax_u(k) + offset + + mbc_phi(c,k+1) = mbc_phi(c,k+1)+zmbc_phi ! (combo) + mbc_pho(c,k+1) = mbc_pho(c,k+1)+zmbc_pho ! (combo) + moc_phi(c,k+1) = moc_phi(c,k+1)+zmoc_phi ! (combo) + moc_pho(c,k+1) = moc_pho(c,k+1)+zmoc_pho ! (combo) + mdst1(c,k+1) = mdst1(c,k+1)+zmdst1 ! (combo) + mdst2(c,k+1) = mdst2(c,k+1)+zmdst2 ! (combo) + mdst3(c,k+1) = mdst3(c,k+1)+zmdst3 ! (combo) + mdst4(c,k+1) = mdst4(c,k+1)+zmdst4 ! (combo) + + ! Mass-weighted combination of radius + rds(c,k+1) = MassWeightedSnowRadius( rds(c,k), rds(c,k+1), & + (swliq(c,k+1)+swice(c,k+1)), (zwliq+zwice) ) + + call Combo (dzsno(c,k+1), swliq(c,k+1), swice(c,k+1), tsno(c,k+1), drr, & + zwliq, zwice, tsno(c,k)) + end if + end if + k = k+1 + end do loop_layers + + snl(c) = -msno + + end do loop_snowcolumns + + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + if (is_lake) then + dz(c,j) = dzsno(c,j-snl(c)) + else + dz(c,j) = dzsno(c,j-snl(c))/frac_sno(c) + end if + h2osoi_ice(c,j) = swice(c,j-snl(c)) + h2osoi_liq(c,j) = swliq(c,j-snl(c)) + t_soisno(c,j) = tsno(c,j-snl(c)) + mss_bcphi(c,j) = mbc_phi(c,j-snl(c)) + mss_bcpho(c,j) = mbc_pho(c,j-snl(c)) + mss_ocphi(c,j) = moc_phi(c,j-snl(c)) + mss_ocpho(c,j) = moc_pho(c,j-snl(c)) + mss_dst1(c,j) = mdst1(c,j-snl(c)) + mss_dst2(c,j) = mdst2(c,j-snl(c)) + mss_dst3(c,j) = mdst3(c,j-snl(c)) + mss_dst4(c,j) = mdst4(c,j-snl(c)) + snw_rds(c,j) = rds(c,j-snl(c)) + + end if + end do + end do + + ! Consistency check + if (is_lake) then + do j = -nlevsno + 1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + + if (j >= snl(c)+1) then + dztot(c) = dztot(c) - dz(c,j) + snwicetot(c) = snwicetot(c) - h2osoi_ice(c,j) + snwliqtot(c) = snwliqtot(c) - h2osoi_liq(c,j) + end if + + if (j == 0) then + if ( abs(dztot(c)) > 1.e-10_r8 .or. abs(snwicetot(c)) > 1.e-7_r8 .or. & + abs(snwliqtot(c)) > 1.e-7_r8 ) then + write(iulog,*)'Inconsistency in SnowDivision_Lake! c, remainders', & + 'dztot, snwicetot, snwliqtot = ',c,dztot(c),snwicetot(c),snwliqtot(c) + call endrun(decomp_index=c, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + end if + end if + end do + end do + end if + + do j = 0, -nlevsno+1, -1 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end associate + end subroutine DivideSnowLayers + + !----------------------------------------------------------------------- + subroutine InitSnowLayers (bounds, snow_depth) + ! + ! !DESCRIPTION: + ! Initialize snow layer depth from specified total depth. + ! + ! !USES: + use clm_varcon , only : spval + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: snow_depth(bounds%begc:) + ! + ! + ! LOCAL VARAIBLES: + integer :: c,l,j ! indices + real(r8) :: minbound, maxbound ! helper variables + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL((ubound(snow_depth) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl, & ! Output: [integer (:) ] number of snow layers + dz => col%dz, & ! Output: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevgrnd) + z => col%z, & ! Output: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevgrnd) + zi => col%zi & ! Output: [real(r8) (:,:) ] interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + ) + + loop_columns: do c = bounds%begc,bounds%endc + l = col%landunit(c) + + dz(c,-nlevsno+1: 0) = spval + z (c,-nlevsno+1: 0) = spval + zi(c,-nlevsno :-1) = spval + + ! Special case: lake + if (lun%lakpoi(l)) then + snl(c) = 0 + dz(c,-nlevsno+1:0) = 0._r8 + z(c,-nlevsno+1:0) = 0._r8 + zi(c,-nlevsno+0:0) = 0._r8 + cycle + end if + + ! LvK 9-JUN-2015: in CanopyHydrologyMod , snow_depth is scaled with frac_sno + ! Here we do not apply scaling to snow_depth, so inconsistent? TODO + + ! Special case: too little snow for snowpack existence + if (snow_depth(c) < dzmin(1)) then + snl(c) = 0 + dz(c,-nlevsno+1:0) = 0._r8 + z(c,-nlevsno+1:0) = 0._r8 + zi(c,-nlevsno+0:0) = 0._r8 + cycle + end if + + ! There has to be at least one snow layer + snl(c) = -1 + minbound = dzmin(1) + maxbound = dzmax_l(1) + + if (snow_depth(c) >= minbound .and. snow_depth(c) <= maxbound) then + ! Special case: single layer + dz(c,0) = snow_depth(c) + + else + ! Search for appropriate number of layers (snl) by increasing the number + ! the number of layers and check for matching bounds. + snl(c) = snl(c) - 1 + minbound = maxbound + maxbound = sum(dzmax_u(1:-snl(c))) + + do while(snow_depth(c) > maxbound .and. -snl(c) < nlevsno ) + snl(c) = snl(c) - 1 + minbound = maxbound + maxbound = sum(dzmax_u(1:-snl(c))) + end do + + ! Set thickness of all layers except bottom two + do j = 1, -snl(c)-2 + dz(c,j+snl(c)) = dzmax_u(j) + enddo + + ! Determine whether the two bottom layers should be equal in size, + ! or not. The rule here is: always create equal size when possible. + if (snow_depth(c) <= sum(dzmax_u(1:-snl(c)-2)) + 2 * dzmax_u(-snl(c)-1)) then + dz(c,-1) = (snow_depth(c) - sum(dzmax_u(1:-snl(c)-2))) / 2._r8 + dz(c,0) = dz(c,-1) + else + dz(c,-1) = dzmax_u(-snl(c)-1) + dz(c,0) = snow_depth(c) - sum(dzmax_u(1:-snl(c)-1)) + endif + endif + + ! Initialize the node depth and the depth of layer interface + do j = 0, snl(c)+1, -1 + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end do + + end do loop_columns + + end associate + end subroutine InitSnowLayers + + + !----------------------------------------------------------------------- + subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) + ! + ! !DESCRIPTION: + ! Combines two elements and returns the following combined + ! variables: dz, t, wliq, wice. + ! The combined temperature is based on the equation: + ! the sum of the enthalpies of the two elements = + ! that of the combined element. + ! + ! !USES: + use clm_varcon, only : cpice, cpliq, tfrz, hfus + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] + real(r8), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] + real(r8), intent(in) :: wice2 ! ice of element 2 [kg/m2] + real(r8), intent(in) :: t2 ! nodal temperature of element 2 [K] + real(r8), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] + real(r8), intent(inout) :: wliq ! liquid water of element 1 + real(r8), intent(inout) :: wice ! ice of element 1 [kg/m2] + real(r8), intent(inout) :: t ! nodel temperature of elment 1 [K] + ! + ! !LOCAL VARIABLES: + real(r8) :: dzc ! Total thickness of nodes 1 and 2 (dzc=dz+dz2). + real(r8) :: wliqc ! Combined liquid water [kg/m2] + real(r8) :: wicec ! Combined ice [kg/m2] + real(r8) :: tc ! Combined node temperature [K] + real(r8) :: h ! enthalpy of element 1 [J/m2] + real(r8) :: h2 ! enthalpy of element 2 [J/m2] + real(r8) :: hc ! temporary + !----------------------------------------------------------------------- + + dzc = dz+dz2 + wicec = (wice+wice2) + wliqc = (wliq+wliq2) + h = (cpice*wice+cpliq*wliq) * (t-tfrz)+hfus*wliq + h2= (cpice*wice2+cpliq*wliq2) * (t2-tfrz)+hfus*wliq2 + + hc = h + h2 + tc = tfrz + (hc - hfus*wliqc) / (cpice*wicec + cpliq*wliqc) + + dz = dzc + wice = wicec + wliq = wliqc + t = tc + + end subroutine Combo + + !----------------------------------------------------------------------- + function MassWeightedSnowRadius( rds1, rds2, swtot, zwtot ) result(mass_weighted_snowradius) + ! + ! !DESCRIPTION: + ! Calculate the mass weighted snow radius when two layers are combined + ! + ! !USES: + use AerosolMod , only : snw_rds_min + use SnowSnicarMod, only : snw_rds_max + implicit none + ! !ARGUMENTS: + real(r8), intent(IN) :: rds1 ! Layer 1 radius + real(r8), intent(IN) :: rds2 ! Layer 2 radius + real(r8), intent(IN) :: swtot ! snow water total layer 2 + real(r8), intent(IN) :: zwtot ! snow water total layer 1 + real(r8) :: mass_weighted_snowradius ! resulting bounded mass weighted snow radius + + SHR_ASSERT( (swtot+zwtot > 0.0_r8), errMsg(__FILE__, __LINE__)) + mass_weighted_snowradius = (rds2*swtot + rds1*zwtot)/(swtot+zwtot) + + if ( mass_weighted_snowradius > snw_rds_max ) then + mass_weighted_snowradius = snw_rds_max + else if ( mass_weighted_snowradius < snw_rds_min ) then + mass_weighted_snowradius = snw_rds_min + end if + end function MassWeightedSnowRadius + + !----------------------------------------------------------------------- + subroutine BuildSnowFilter(bounds, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + ! + ! !DESCRIPTION: + ! Constructs snow filter for use in vectorized loops for snow hydrology. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(out) :: num_snowc ! number of column snow points in column filter + integer , intent(out) :: filter_snowc(:) ! column filter for snow points + integer , intent(out) :: num_nosnowc ! number of column non-snow points in column filter + integer , intent(out) :: filter_nosnowc(:) ! column filter for non-snow points + ! + ! !LOCAL VARIABLES: + integer :: fc, c + !----------------------------------------------------------------------- + + ! Build snow/no-snow filters for other subroutines + + num_snowc = 0 + num_nosnowc = 0 + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%snl(c) < 0) then + num_snowc = num_snowc + 1 + filter_snowc(num_snowc) = c + else + num_nosnowc = num_nosnowc + 1 + filter_nosnowc(num_nosnowc) = c + end if + end do + end subroutine BuildSnowFilter + +end module SnowHydrologyMod diff --git a/components/clm/src/biogeophys/SnowSnicarMod.F90 b/components/clm/src/biogeophys/SnowSnicarMod.F90 new file mode 100644 index 0000000000..117d38804d --- /dev/null +++ b/components/clm/src/biogeophys/SnowSnicarMod.F90 @@ -0,0 +1,1419 @@ +module SnowSnicarMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate albedo of snow containing impurities + ! and the evolution of snow effective radius + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varcon , only : namec + use shr_const_mod , only : SHR_CONST_RHOICE + use abortutils , only : endrun + use decompMod , only : bounds_type + use AerosolMod , only : snw_rds_min + use WaterStateType , only : waterstate_type + use WaterFluxType , only : waterflux_type + use TemperatureType , only : temperature_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + ! + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SNICAR_RT ! Snow albedo and vertically-resolved solar absorption + public :: SnowAge_grain ! Snow effective grain size evolution + public :: SnowAge_init ! Initial read in of snow-aging file + public :: SnowOptics_init ! Initial read in of snow-optics file + ! + ! !PUBLIC DATA MEMBERS: + integer, public, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack + ! (indices described above) [nbr] + logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC) + ! in snowpack radiative calculations + logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations + + ! !PRIVATE DATA MEMBERS: + integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr] + integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] + integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] + + integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] + integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] + integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx] + integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] + + integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns] + integer, parameter :: snw_rds_min_tbl = 30 ! minimium effective radius defined in Mie lookup table [microns] + real(r8), parameter :: snw_rds_max = 1500._r8 ! maximum allowed snow effective radius [microns] + real(r8), parameter :: snw_rds_refrz = 1000._r8 ! effective radius of re-frozen snow [microns] + + real(r8), parameter :: min_snw = 1.0E-30_r8 ! minimum snow mass required for SNICAR RT calculation [kg m-2] + + !real(r8), parameter :: C1_liq_Brun89 = 1.28E-17_r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89 + real(r8), parameter :: C1_liq_Brun89 = 0._r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89: zeroed to accomodate dry snow aging + real(r8), parameter :: C2_liq_Brun89 = 4.22E-13_r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89: corrected for LWC in units of percent + + real(r8), parameter :: tim_cns_bc_rmv = 2.2E-8_r8 ! time constant for removal of BC in snow on sea-ice + ! [s-1] (50% mass removal/year) + real(r8), parameter :: tim_cns_oc_rmv = 2.2E-8_r8 ! time constant for removal of OC in snow on sea-ice + ! [s-1] (50% mass removal/year) + real(r8), parameter :: tim_cns_dst_rmv = 2.2E-8_r8 ! time constant for removal of dust in snow on sea-ice + ! [s-1] (50% mass removal/year) + + ! scaling of the snow aging rate (tuning option): + logical :: flg_snoage_scl = .false. ! flag for scaling the snow aging rate by some arbitrary factor + real(r8), parameter :: xdrdt = 1.0_r8 ! arbitrary factor applied to snow aging rate + + ! snow and aerosol Mie parameters: + ! (arrays declared here, but are set in iniTimeConst) + ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um)) + + ! direct-beam weighted ice optical properties + real(r8) :: ss_alb_snw_drc(idx_Mie_snw_mx,numrad_snw) + real(r8) :: asm_prm_snw_drc(idx_Mie_snw_mx,numrad_snw) + real(r8) :: ext_cff_mss_snw_drc(idx_Mie_snw_mx,numrad_snw) + + ! diffuse radiation weighted ice optical properties + real(r8) :: ss_alb_snw_dfs(idx_Mie_snw_mx,numrad_snw) + real(r8) :: asm_prm_snw_dfs(idx_Mie_snw_mx,numrad_snw) + real(r8) :: ext_cff_mss_snw_dfs(idx_Mie_snw_mx,numrad_snw) + + ! hydrophiliic BC + real(r8) :: ss_alb_bc1(numrad_snw) + real(r8) :: asm_prm_bc1(numrad_snw) + real(r8) :: ext_cff_mss_bc1(numrad_snw) + + ! hydrophobic BC + real(r8) :: ss_alb_bc2(numrad_snw) + real(r8) :: asm_prm_bc2(numrad_snw) + real(r8) :: ext_cff_mss_bc2(numrad_snw) + + ! hydrophobic OC + real(r8) :: ss_alb_oc1(numrad_snw) + real(r8) :: asm_prm_oc1(numrad_snw) + real(r8) :: ext_cff_mss_oc1(numrad_snw) + + ! hydrophilic OC + real(r8) :: ss_alb_oc2(numrad_snw) + real(r8) :: asm_prm_oc2(numrad_snw) + real(r8) :: ext_cff_mss_oc2(numrad_snw) + + ! dust species 1: + real(r8) :: ss_alb_dst1(numrad_snw) + real(r8) :: asm_prm_dst1(numrad_snw) + real(r8) :: ext_cff_mss_dst1(numrad_snw) + + ! dust species 2: + real(r8) :: ss_alb_dst2(numrad_snw) + real(r8) :: asm_prm_dst2(numrad_snw) + real(r8) :: ext_cff_mss_dst2(numrad_snw) + + ! dust species 3: + real(r8) :: ss_alb_dst3(numrad_snw) + real(r8) :: asm_prm_dst3(numrad_snw) + real(r8) :: ext_cff_mss_dst3(numrad_snw) + + ! dust species 4: + real(r8) :: ss_alb_dst4(numrad_snw) + real(r8) :: asm_prm_dst4(numrad_snw) + real(r8) :: ext_cff_mss_dst4(numrad_snw) + + ! best-fit parameters for snow aging defined over: + ! 11 temperatures from 225 to 273 K + ! 31 temperature gradients from 0 to 300 K/m + ! 8 snow densities from 0 to 350 kg/m3 + ! (arrays declared here, but are set in iniTimeConst) + real(r8), pointer :: snowage_tau(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) + real(r8), pointer :: snowage_kappa(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) + real(r8), pointer :: snowage_drdt0(:,:,:) ! idx_rhos_max,idx_Tgrd_max,idx_T_max) + ! + ! !REVISION HISTORY: + ! Created by Mark Flanner + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen, flg_slr_in, h2osno_liq, h2osno_ice, snw_rds, & + mss_cnc_aer_in, albsfc, albout, flx_abs, waterstate_inst) + ! + ! !DESCRIPTION: + ! Determine reflectance of, and vertically-resolved solar absorption in, + ! snow with impurities. + ! + ! Original references on physical models of snow reflectance include: + ! Wiscombe and Warren [1980] and Warren and Wiscombe [1980], + ! Journal of Atmospheric Sciences, 37, + ! + ! The multi-layer solution for multiple-scattering used here is from: + ! Toon et al. [1989], Rapid calculation of radiative heating rates + ! and photodissociation rates in inhomogeneous multiple scattering atmospheres, + ! J. Geophys. Res., 94, D13, 16287-16301 + ! + ! The implementation of the SNICAR model in CLM/CSIM is described in: + ! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], + ! Present-day climate forcing and response from black carbon in snow, + ! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 + ! + ! !USES: + use clm_varpar , only : nlevsno, numrad + use clm_time_manager , only : get_nstep + use shr_const_mod , only : SHR_CONST_PI + ! + ! !ARGUMENTS: + integer , intent(in) :: flg_snw_ice ! flag: =1 when called from CLM, =2 when called from CSIM + type (bounds_type), intent(in) :: bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter + integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points + real(r8) , intent(in) :: coszen ( bounds%begc: ) ! cosine of solar zenith angle for next time step (col) [unitless] + integer , intent(in) :: flg_slr_in ! flag: =1 for direct-beam incident flux,=2 for diffuse incident flux + real(r8) , intent(in) :: h2osno_liq ( bounds%begc: , -nlevsno+1: ) ! liquid water content (col,lyr) [kg/m2] + real(r8) , intent(in) :: h2osno_ice ( bounds%begc: , -nlevsno+1: ) ! ice content (col,lyr) [kg/m2] + integer , intent(in) :: snw_rds ( bounds%begc: , -nlevsno+1: ) ! snow effective radius (col,lyr) [microns, m^-6] + real(r8) , intent(in) :: mss_cnc_aer_in ( bounds%begc: , -nlevsno+1: , 1: ) ! mass concentration of all aerosol species (col,lyr,aer) [kg/kg] + real(r8) , intent(in) :: albsfc ( bounds%begc: , 1: ) ! albedo of surface underlying snow (col,bnd) [frc] + real(r8) , intent(out) :: albout ( bounds%begc: , 1: ) ! snow albedo, averaged into 2 bands (=0 if no sun or no snow) (col,bnd) [frc] + real(r8) , intent(out) :: flx_abs ( bounds%begc: , -nlevsno+1: , 1: ) ! absorbed flux in each layer per unit flux incident (col, lyr, bnd) + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + ! + ! variables for snow radiative transfer calculations + + ! Local variables representing single-column values of arrays: + integer :: snl_lcl ! negative number of snow layers [nbr] + integer :: snw_rds_lcl(-nlevsno+1:0) ! snow effective radius [m^-6] + real(r8):: flx_slrd_lcl(1:numrad_snw) ! direct beam incident irradiance [W/m2] (set to 1) + real(r8):: flx_slri_lcl(1:numrad_snw) ! diffuse incident irradiance [W/m2] (set to 1) + real(r8):: mss_cnc_aer_lcl(-nlevsno+1:0,1:sno_nbr_aer) ! aerosol mass concentration (lyr,aer_nbr) [kg/kg] + real(r8):: h2osno_lcl ! total column snow mass [kg/m2] + real(r8):: h2osno_liq_lcl(-nlevsno+1:0) ! liquid water mass [kg/m2] + real(r8):: h2osno_ice_lcl(-nlevsno+1:0) ! ice mass [kg/m2] + real(r8):: albsfc_lcl(1:numrad_snw) ! albedo of underlying surface [frc] + real(r8):: ss_alb_snw_lcl(-nlevsno+1:0) ! single-scatter albedo of ice grains (lyr) [frc] + real(r8):: asm_prm_snw_lcl(-nlevsno+1:0) ! asymmetry parameter of ice grains (lyr) [frc] + real(r8):: ext_cff_mss_snw_lcl(-nlevsno+1:0) ! mass extinction coefficient of ice grains (lyr) [m2/kg] + real(r8):: ss_alb_aer_lcl(sno_nbr_aer) ! single-scatter albedo of aerosol species (aer_nbr) [frc] + real(r8):: asm_prm_aer_lcl(sno_nbr_aer) ! asymmetry parameter of aerosol species (aer_nbr) [frc] + real(r8):: ext_cff_mss_aer_lcl(sno_nbr_aer) ! mass extinction coefficient of aerosol species (aer_nbr) [m2/kg] + + + ! Other local variables + integer :: APRX_TYP ! two-stream approximation type + ! (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr] + integer :: DELTA ! flag to use Delta approximation (Joseph, 1976) + ! (1= use, 0= don't use) + real(r8):: flx_wgt(1:numrad_snw) ! weights applied to spectral bands, + ! specific to direct and diffuse cases (bnd) [frc] + + integer :: flg_nosnl ! flag: =1 if there is snow, but zero snow layers, + ! =0 if at least 1 snow layer [flg] + integer :: trip ! flag: =1 to redo RT calculation if result is unrealistic + integer :: flg_dover ! defines conditions for RT redo (explained below) + + real(r8):: albedo ! temporary snow albedo [frc] + real(r8):: flx_sum ! temporary summation variable for NIR weighting + real(r8):: albout_lcl(numrad_snw) ! snow albedo by band [frc] + real(r8):: flx_abs_lcl(-nlevsno+1:1,numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc] + + real(r8):: L_snw(-nlevsno+1:0) ! h2o mass (liquid+solid) in snow layer (lyr) [kg/m2] + real(r8):: tau_snw(-nlevsno+1:0) ! snow optical depth (lyr) [unitless] + real(r8):: L_aer(-nlevsno+1:0,sno_nbr_aer) ! aerosol mass in snow layer (lyr,nbr_aer) [kg/m2] + real(r8):: tau_aer(-nlevsno+1:0,sno_nbr_aer) ! aerosol optical depth (lyr,nbr_aer) [unitless] + real(r8):: tau_sum ! cumulative (snow+aerosol) optical depth [unitless] + real(r8):: tau_clm(-nlevsno+1:0) ! column optical depth from layer bottom to snowpack top (lyr) [unitless] + real(r8):: omega_sum ! temporary summation of single-scatter albedo of all aerosols [frc] + real(r8):: g_sum ! temporary summation of asymmetry parameter of all aerosols [frc] + + real(r8):: tau(-nlevsno+1:0) ! weighted optical depth of snow+aerosol layer (lyr) [unitless] + real(r8):: omega(-nlevsno+1:0) ! weighted single-scatter albedo of snow+aerosol layer (lyr) [frc] + real(r8):: g(-nlevsno+1:0) ! weighted asymmetry parameter of snow+aerosol layer (lyr) [frc] + real(r8):: tau_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) optical depth of snow+aerosol layer + ! (lyr) [unitless] + real(r8):: omega_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) SSA of snow+aerosol layer (lyr) [frc] + real(r8):: g_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) asymmetry paramater of snow+aerosol layer + ! (lyr) [frc] + + integer :: nstep ! current timestep [nbr] (debugging only) + integer :: g_idx, c_idx, l_idx ! gridcell, column, and landunit indices [idx] + integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= numrad_snw) [idx] + integer :: rds_idx ! snow effective radius index for retrieving + ! Mie parameters from lookup table [idx] + integer :: snl_btm ! index of bottom snow layer (0) [idx] + integer :: snl_top ! index of top snow layer (-4 to 0) [idx] + integer :: fc ! column filter index + integer :: i ! layer index [idx] + integer :: j ! aerosol number index [idx] + integer :: n ! tridiagonal matrix index [idx] + integer :: m ! secondary layer index [idx] + + real(r8):: F_direct(-nlevsno+1:0) ! direct-beam radiation at bottom of layer interface (lyr) [W/m^2] + real(r8):: F_net(-nlevsno+1:0) ! net radiative flux at bottom of layer interface (lyr) [W/m^2] + real(r8):: F_abs(-nlevsno+1:0) ! net absorbed radiative energy (lyr) [W/m^2] + real(r8):: F_abs_sum ! total absorbed energy in column [W/m^2] + real(r8):: F_sfc_pls ! upward radiative flux at snowpack top [W/m^2] + real(r8):: F_btm_net ! net flux at bottom of snowpack [W/m^2] + real(r8):: F_sfc_net ! net flux at top of snowpack [W/m^2] + real(r8):: energy_sum ! sum of all energy terms; should be 0.0 [W/m^2] + real(r8):: F_direct_btm ! direct-beam radiation at bottom of snowpack [W/m^2] + real(r8):: mu_not ! cosine of solar zenith angle (used locally) [frc] + + integer :: err_idx ! counter for number of times through error loop [nbr] + real(r8):: lat_coord ! gridcell latitude (debugging only) + real(r8):: lon_coord ! gridcell longitude (debugging only) + integer :: sfctype ! underlying surface type (debugging only) + real(r8):: pi ! 3.1415... + + ! intermediate variables for radiative transfer approximation: + real(r8):: gamma1(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma2(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma3(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma4(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: lambda(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: GAMMA(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: mu_one ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: e1(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e2(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e3(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e4(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: C_pls_btm(-nlevsno+1:0) ! intermediate variable: upward flux at bottom interface (lyr) [W/m2] + real(r8):: C_mns_btm(-nlevsno+1:0) ! intermediate variable: downward flux at bottom interface (lyr) [W/m2] + real(r8):: C_pls_top(-nlevsno+1:0) ! intermediate variable: upward flux at top interface (lyr) [W/m2] + real(r8):: C_mns_top(-nlevsno+1:0) ! intermediate variable: downward flux at top interface (lyr) [W/m2] + real(r8):: A(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: B(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: D(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: E(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: AS(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: DS(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: X(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: Y(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osno_liq) == (/bounds%endc, 0/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osno_ice) == (/bounds%endc, 0/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(snw_rds) == (/bounds%endc, 0/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(mss_cnc_aer_in) == (/bounds%endc, 0, sno_nbr_aer/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsfc) == (/bounds%endc, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albout) == (/bounds%endc, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(flx_abs) == (/bounds%endc, 1, numrad/)), errMsg(__FILE__, __LINE__)) + + associate(& + snl => col%snl , & ! Input: [integer (:)] negative number of snow layers (col) [nbr] + + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:)] snow liquid water equivalent (col) [kg/m2] + frac_sno => waterstate_inst%frac_sno_eff_col & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) + ) + + ! Define constants + pi = SHR_CONST_PI + + ! always use Delta approximation for snow + DELTA = 1 + + ! Get current timestep + nstep = get_nstep() + + ! Loop over all non-urban columns + ! (when called from CSIM, there is only one column) + do fc = 1,num_nourbanc + c_idx = filter_nourbanc(fc) + + + ! Zero absorbed radiative fluxes: + do i=-nlevsno+1,1,1 + flx_abs_lcl(:,:) = 0._r8 + flx_abs(c_idx,i,:) = 0._r8 + enddo + + ! set snow/ice mass to be used for RT: + if (flg_snw_ice == 1) then + h2osno_lcl = h2osno(c_idx) + else + h2osno_lcl = h2osno_ice(c_idx,0) + endif + + + ! Qualifier for computing snow RT: + ! 1) sunlight from atmosphere model + ! 2) minimum amount of snow on ground. + ! Otherwise, set snow albedo to zero + if ((coszen(c_idx) > 0._r8) .and. (h2osno_lcl > min_snw)) then + + ! Set variables specific to CLM + if (flg_snw_ice == 1) then + ! If there is snow, but zero snow layers, we must create a layer locally. + ! This layer is presumed to have the fresh snow effective radius. + if (snl(c_idx) > -1) then + flg_nosnl = 1 + snl_lcl = -1 + h2osno_ice_lcl(0) = h2osno_lcl + h2osno_liq_lcl(0) = 0._r8 + snw_rds_lcl(0) = nint(snw_rds_min) + else + flg_nosnl = 0 + snl_lcl = snl(c_idx) + h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) + h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) + snw_rds_lcl(:) = snw_rds(c_idx,:) + endif + + snl_btm = 0 + snl_top = snl_lcl+1 + + ! for debugging only + l_idx = col%landunit(c_idx) + g_idx = col%gridcell(c_idx) + sfctype = lun%itype(l_idx) + lat_coord = grc%latdeg(g_idx) + lon_coord = grc%londeg(g_idx) + + + ! Set variables specific to CSIM + else + flg_nosnl = 0 + snl_lcl = -1 + h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) + h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) + snw_rds_lcl(:) = snw_rds(c_idx,:) + snl_btm = 0 + snl_top = 0 + sfctype = -1 + lat_coord = -90 + lon_coord = 0 + endif + + ! Set local aerosol array + do j=1,sno_nbr_aer + mss_cnc_aer_lcl(:,j) = mss_cnc_aer_in(c_idx,:,j) + enddo + + + ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos + albsfc_lcl(1) = albsfc(c_idx,1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) + + + ! Error check for snow grain size: + do i=snl_top,snl_btm,1 + if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then + write (iulog,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds." + write (iulog,*) "NSTEP= ", nstep + write (iulog,*) "flg_snw_ice= ", flg_snw_ice + write (iulog,*) "column: ", c_idx, " level: ", i, " snl(c)= ", snl_lcl + write (iulog,*) "lat= ", lat_coord, " lon= ", lon_coord + write (iulog,*) "h2osno(c)= ", h2osno_lcl + call endrun(decomp_index=c_idx, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + enddo + + ! Incident flux weighting parameters + ! - sum of all VIS bands must equal 1 + ! - sum of all NIR bands must equal 1 + ! + ! Spectral bands (5-band case) + ! Band 1: 0.3-0.7um (VIS) + ! Band 2: 0.7-1.0um (NIR) + ! Band 3: 1.0-1.2um (NIR) + ! Band 4: 1.2-1.5um (NIR) + ! Band 5: 1.5-5.0um (NIR) + ! + ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere + ! + ! 3-band weights + if (numrad_snw==3) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.66628670195247_r8 + flx_wgt(3) = 0.33371329804753_r8 + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.77887652162877_r8 + flx_wgt(3) = 0.22112347837123_r8 + endif + + ! 5-band weights + elseif(numrad_snw==5) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.49352158521175_r8 + flx_wgt(3) = 0.18099494230665_r8 + flx_wgt(4) = 0.12094898498813_r8 + flx_wgt(5) = 0.20453448749347_r8 + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.58581507618433_r8 + flx_wgt(3) = 0.20156903770812_r8 + flx_wgt(4) = 0.10917889346386_r8 + flx_wgt(5) = 0.10343699264369_r8 + endif + endif + + ! Loop over snow spectral bands + do bnd_idx = 1,numrad_snw + + mu_not = coszen(c_idx) ! must set here, because of error handling + flg_dover = 1 ! default is to redo + err_idx = 0 ! number of times through loop + + do while (flg_dover > 0) + + ! DEFAULT APPROXIMATIONS: + ! VIS: Delta-Eddington + ! NIR (all): Delta-Hemispheric Mean + ! WARNING: DO NOT USE DELTA-EDDINGTON FOR NIR DIFFUSE - this sometimes results in negative albedo + ! + ! ERROR CONDITIONS: + ! Conditions which cause "trip", resulting in redo of RT approximation: + ! 1. negative absorbed flux + ! 2. total absorbed flux greater than incident flux + ! 3. negative albedo + ! NOTE: These errors have only been encountered in spectral bands 4 and 5 + ! + ! ERROR HANDLING + ! 1st error (flg_dover=2): switch approximation (Edd->HM or HM->Edd) + ! 2nd error (flg_dover=3): change zenith angle by 0.02 (this happens about 1 in 10^6 cases) + ! 3rd error (flg_dover=4): switch approximation with new zenith + ! Subsequent errors: repeatedly change zenith and approximations... + + if (bnd_idx == 1) then + if (flg_dover == 2) then + APRX_TYP = 3 + elseif (flg_dover == 3) then + APRX_TYP = 1 + if (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + endif + elseif (flg_dover == 4) then + APRX_TYP = 3 + else + APRX_TYP = 1 + endif + + else + if (flg_dover == 2) then + APRX_TYP = 1 + elseif (flg_dover == 3) then + APRX_TYP = 3 + if (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + endif + elseif (flg_dover == 4) then + APRX_TYP = 1 + else + APRX_TYP = 3 + endif + + endif + + ! Set direct or diffuse incident irradiance to 1 + ! (This has to be within the bnd loop because mu_not is adjusted in rare cases) + if (flg_slr_in == 1) then + flx_slrd_lcl(bnd_idx) = 1._r8/(mu_not*pi) ! this corresponds to incident irradiance of 1.0 + flx_slri_lcl(bnd_idx) = 0._r8 + else + flx_slrd_lcl(bnd_idx) = 0._r8 + flx_slri_lcl(bnd_idx) = 1._r8 + endif + + ! Pre-emptive error handling: aerosols can reap havoc on these absorptive bands. + ! Since extremely high soot concentrations have a negligible effect on these bands, zero them. + if ( (numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then + mss_cnc_aer_lcl(:,:) = 0._r8 + endif + + if ( (numrad_snw == 3).and.(bnd_idx == 3) ) then + mss_cnc_aer_lcl(:,:) = 0._r8 + endif + + ! Define local Mie parameters based on snow grain size and aerosol species, + ! retrieved from a lookup table. + if (flg_slr_in == 1) then + do i=snl_top,snl_btm,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (direct radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_drc(rds_idx,bnd_idx) + asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,bnd_idx) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_drc(rds_idx,bnd_idx) + enddo + elseif (flg_slr_in == 2) then + do i=snl_top,snl_btm,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (diffuse radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_dfs(rds_idx,bnd_idx) + asm_prm_snw_lcl(i) = asm_prm_snw_dfs(rds_idx,bnd_idx) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_dfs(rds_idx,bnd_idx) + enddo + endif + + ! aerosol species 1 optical properties + ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + + ! aerosol species 2 optical properties + ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) + asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) + ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) + + ! aerosol species 3 optical properties + ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) + asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) + ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) + + ! aerosol species 4 optical properties + ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) + asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) + ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) + + ! aerosol species 5 optical properties + ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) + asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) + ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) + + ! aerosol species 6 optical properties + ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) + asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) + ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) + + ! aerosol species 7 optical properties + ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) + asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) + ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) + + ! aerosol species 8 optical properties + ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) + asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) + ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) + + + ! 1. snow and aerosol layer column mass (L_snw, L_aer [kg/m^2]) + ! 2. optical Depths (tau_snw, tau_aer) + ! 3. weighted Mie properties (tau, omega, g) + + ! Weighted Mie parameters of each layer + do i=snl_top,snl_btm,1 + L_snw(i) = h2osno_ice_lcl(i)+h2osno_liq_lcl(i) + tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i) + + do j=1,sno_nbr_aer + L_aer(i,j) = L_snw(i)*mss_cnc_aer_lcl(i,j) + tau_aer(i,j) = L_aer(i,j)*ext_cff_mss_aer_lcl(j) + enddo + + tau_sum = 0._r8 + omega_sum = 0._r8 + g_sum = 0._r8 + + do j=1,sno_nbr_aer + tau_sum = tau_sum + tau_aer(i,j) + omega_sum = omega_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)) + g_sum = g_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)*asm_prm_aer_lcl(j)) + enddo + + tau(i) = tau_sum + tau_snw(i) + omega(i) = (1/tau(i))*(omega_sum+(ss_alb_snw_lcl(i)*tau_snw(i))) + g(i) = (1/(tau(i)*omega(i)))*(g_sum+ (asm_prm_snw_lcl(i)*ss_alb_snw_lcl(i)*tau_snw(i))) + enddo + + ! DELTA transformations, if requested + if (DELTA == 1) then + do i=snl_top,snl_btm,1 + g_star(i) = g(i)/(1+g(i)) + omega_star(i) = ((1-(g(i)**2))*omega(i)) / (1-(omega(i)*(g(i)**2))) + tau_star(i) = (1-(omega(i)*(g(i)**2)))*tau(i) + enddo + else + do i=snl_top,snl_btm,1 + g_star(i) = g(i) + omega_star(i) = omega(i) + tau_star(i) = tau(i) + enddo + endif + + ! Total column optical depth: + ! tau_clm(i) = total optical depth above the bottom of layer i + tau_clm(snl_top) = 0._r8 + do i=snl_top+1,snl_btm,1 + tau_clm(i) = tau_clm(i-1)+tau_star(i-1) + enddo + + ! Direct radiation at bottom of snowpack: + F_direct_btm = albsfc_lcl(bnd_idx)*mu_not * & + exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx) + + ! Intermediates + ! Gamma values are approximation-specific. + + ! Eddington + if (APRX_TYP==1) then + do i=snl_top,snl_btm,1 + gamma1(i) = (7-(omega_star(i)*(4+(3*g_star(i)))))/4 + gamma2(i) = -(1-(omega_star(i)*(4-(3*g_star(i)))))/4 + gamma3(i) = (2-(3*g_star(i)*mu_not))/4 + gamma4(i) = 1-gamma3(i) + mu_one = 0.5 + enddo + + ! Quadrature + elseif (APRX_TYP==2) then + do i=snl_top,snl_btm,1 + gamma1(i) = (3**0.5)*(2-(omega_star(i)*(1+g_star(i))))/2 + gamma2(i) = omega_star(i)*(3**0.5)*(1-g_star(i))/2 + gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2 + gamma4(i) = 1-gamma3(i) + mu_one = 1/(3**0.5) + enddo + + ! Hemispheric Mean + elseif (APRX_TYP==3) then + do i=snl_top,snl_btm,1 + gamma1(i) = 2 - (omega_star(i)*(1+g_star(i))) + gamma2(i) = omega_star(i)*(1-g_star(i)) + gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2 + gamma4(i) = 1-gamma3(i) + mu_one = 0.5 + enddo + endif + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,1 + lambda(i) = sqrt(abs((gamma1(i)**2) - (gamma2(i)**2))) + GAMMA(i) = gamma2(i)/(gamma1(i)+lambda(i)) + + e1(i) = 1+(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e2(i) = 1-(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e3(i) = GAMMA(i) + exp(-lambda(i)*tau_star(i)) + e4(i) = GAMMA(i) - exp(-lambda(i)*tau_star(i)) + enddo !enddo over snow layers + + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,1 + if (flg_slr_in == 1) then + + C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)-(1/mu_not))*gamma3(i))+ & + (gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_mns_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)+(1/mu_not))*gamma4(i))+ & + (gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_pls_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)-(1/mu_not))* & + gamma3(i))+(gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_mns_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)+(1/mu_not))* & + gamma4(i))+(gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + else + C_pls_btm(i) = 0._r8 + C_mns_btm(i) = 0._r8 + C_pls_top(i) = 0._r8 + C_mns_top(i) = 0._r8 + endif + enddo + + ! Coefficients for tridiaganol matrix solution + do i=2*snl_lcl+1,0,1 + + !Boundary values for i=1 and i=2*snl_lcl, specifics for i=odd and i=even + if (i==(2*snl_lcl+1)) then + A(i) = 0 + B(i) = e1(snl_top) + D(i) = -e2(snl_top) + E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top) + + elseif(i==0) then + A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm)) + B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm)) + D(i) = 0 + E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm)) + + elseif(mod(i,2)==-1) then ! If odd and i>=3 (n=1 for i=3) + n=floor(i/2.0) + A(i) = (e2(n)*e3(n))-(e4(n)*e1(n)) + B(i) = (e1(n)*e1(n+1))-(e3(n)*e3(n+1)) + D(i) = (e3(n)*e4(n+1))-(e1(n)*e2(n+1)) + E(i) = (e3(n)*(C_pls_top(n+1)-C_pls_btm(n)))+(e1(n)*(C_mns_btm(n)-C_mns_top(n+1))) + + elseif(mod(i,2)==0) then ! If even and i<=2*snl_lcl + n=(i/2) + A(i) = (e2(n+1)*e1(n))-(e3(n)*e4(n+1)) + B(i) = (e2(n)*e2(n+1))-(e4(n)*e4(n+1)) + D(i) = (e1(n+1)*e4(n+1))-(e2(n+1)*e3(n+1)) + E(i) = (e2(n+1)*(C_pls_top(n+1)-C_pls_btm(n)))+(e4(n+1)*(C_mns_top(n+1)-C_mns_btm(n))) + endif + enddo + + AS(0) = A(0)/B(0) + DS(0) = E(0)/B(0) + + do i=-1,(2*snl_lcl+1),-1 + X(i) = 1/(B(i)-(D(i)*AS(i+1))) + AS(i) = A(i)*X(i) + DS(i) = (E(i)-(D(i)*DS(i+1)))*X(i) + enddo + + Y(2*snl_lcl+1) = DS(2*snl_lcl+1) + do i=(2*snl_lcl+2),0,1 + Y(i) = DS(i)-(AS(i)*Y(i-1)) + enddo + + ! Downward direct-beam and net flux (F_net) at the base of each layer: + do i=snl_top,snl_btm,1 + F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*exp(-(tau_clm(i)+tau_star(i))/mu_not) + F_net(i) = (Y(2*i-1)*(e1(i)-e3(i))) + (Y(2*i)*(e2(i)-e4(i))) + & + C_pls_btm(i) - C_mns_btm(i) - F_direct(i) + enddo + + ! Upward flux at snowpack top: + F_sfc_pls = (Y(2*snl_lcl+1)*(exp(-lambda(snl_top)*tau_star(snl_top))+ & + GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* & + tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top) + + ! Net flux at bottom = absorbed radiation by underlying surface: + F_btm_net = -F_net(snl_btm) + + + ! Bulk column albedo and surface net flux + albedo = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + + trip = 0 + ! Absorbed flux in each layer + do i=snl_top,snl_btm,1 + if(i==snl_top) then + F_abs(i) = F_net(i)-F_sfc_net + else + F_abs(i) = F_net(i)-F_net(i-1) + endif + flx_abs_lcl(i,bnd_idx) = F_abs(i) + + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,bnd_idx) < -0.00001) then + trip = 1 + endif + enddo + + flx_abs_lcl(1,bnd_idx) = F_btm_net + + if (flg_nosnl == 1) then + ! If there are no snow layers (but still snow), all absorbed energy must be in top soil layer + !flx_abs_lcl(:,bnd_idx) = 0._r8 + !flx_abs_lcl(1,bnd_idx) = F_abs(0) + F_btm_net + + ! changed on 20070408: + ! OK to put absorbed energy in the fictitous snow layer because routine SurfaceRadiation + ! handles the case of no snow layers. Then, if a snow layer is addded between now and + ! SurfaceRadiation (called in CanopyHydrology), absorbed energy will be properly distributed. + flx_abs_lcl(0,bnd_idx) = F_abs(0) + flx_abs_lcl(1,bnd_idx) = F_btm_net + + endif + + !Underflow check (we've already tripped the error condition above) + do i=snl_top,1,1 + if (flx_abs_lcl(i,bnd_idx) < 0._r8) then + flx_abs_lcl(i,bnd_idx) = 0._r8 + endif + enddo + + F_abs_sum = 0._r8 + do i=snl_top,snl_btm,1 + F_abs_sum = F_abs_sum + F_abs(i) + enddo + + + !ERROR check: absorption greater than incident flux + ! (should make condition more generic than "1._r8") + if (F_abs_sum > 1._r8) then + trip = 1 + endif + + !ERROR check: + if ((albedo < 0._r8).and.(trip==0)) then + trip = 1 + endif + + ! Set conditions for redoing RT calculation + if ((trip == 1).and.(flg_dover == 1)) then + flg_dover = 2 + elseif ((trip == 1).and.(flg_dover == 2)) then + flg_dover = 3 + elseif ((trip == 1).and.(flg_dover == 3)) then + flg_dover = 4 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx < 20)) then + flg_dover = 3 + err_idx = err_idx + 1 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx >= 20)) then + flg_dover = 0 + write(iulog,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice + write(iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) + write(iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + write(iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write(iulog,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) + write(iulog,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) + write(iulog,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) + write(iulog,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) + write(iulog,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) + write(iulog,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) + l_idx = col%landunit(c_idx) + write(iulog,*) "column index: ", c_idx + write(iulog,*) "landunit type", lun%itype(l_idx) + write(iulog,*) "frac_sno: ", frac_sno(c_idx) + call endrun(decomp_index=c_idx, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + else + flg_dover = 0 + endif + + enddo !enddo while (flg_dover > 0) + + ! Energy conservation check: + ! Incident direct+diffuse radiation equals (absorbed+bulk_transmitted+bulk_reflected) + energy_sum = (mu_not*pi*flx_slrd_lcl(bnd_idx)) + flx_slri_lcl(bnd_idx) - (F_abs_sum + F_btm_net + F_sfc_pls) + if (abs(energy_sum) > 0.00001_r8) then + write (iulog,"(a,e12.6,a,i6,a,i6)") "SNICAR ERROR: Energy conservation error of : ", energy_sum, & + " at timestep: ", nstep, " at column: ", c_idx + call endrun(decomp_index=c_idx, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + + albout_lcl(bnd_idx) = albedo + + ! Check that albedo is less than 1 + if (albout_lcl(bnd_idx) > 1.0) then + + write (iulog,*) "SNICAR ERROR: Albedo > 1.0 at c: ", c_idx, " NSTEP= ",nstep + write (iulog,*) "SNICAR STATS: bnd_idx= ",bnd_idx + write (iulog,*) "SNICAR STATS: albout_lcl(bnd)= ",albout_lcl(bnd_idx), & + " albsfc_lcl(bnd_idx)= ",albsfc_lcl(bnd_idx) + write (iulog,*) "SNICAR STATS: landtype= ", sfctype + write (iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write (iulog,*) "SNICAR STATS: coszen= ", coszen(c_idx), " flg_slr= ", flg_slr_in + + write (iulog,*) "SNICAR STATS: soot(-4)= ", mss_cnc_aer_lcl(-4,1) + write (iulog,*) "SNICAR STATS: soot(-3)= ", mss_cnc_aer_lcl(-3,1) + write (iulog,*) "SNICAR STATS: soot(-2)= ", mss_cnc_aer_lcl(-2,1) + write (iulog,*) "SNICAR STATS: soot(-1)= ", mss_cnc_aer_lcl(-1,1) + write (iulog,*) "SNICAR STATS: soot(0)= ", mss_cnc_aer_lcl(0,1) + + write (iulog,*) "SNICAR STATS: L_snw(-4)= ", L_snw(-4) + write (iulog,*) "SNICAR STATS: L_snw(-3)= ", L_snw(-3) + write (iulog,*) "SNICAR STATS: L_snw(-2)= ", L_snw(-2) + write (iulog,*) "SNICAR STATS: L_snw(-1)= ", L_snw(-1) + write (iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + + write (iulog,*) "SNICAR STATS: snw_rds(-4)= ", snw_rds(c_idx,-4) + write (iulog,*) "SNICAR STATS: snw_rds(-3)= ", snw_rds(c_idx,-3) + write (iulog,*) "SNICAR STATS: snw_rds(-2)= ", snw_rds(c_idx,-2) + write (iulog,*) "SNICAR STATS: snw_rds(-1)= ", snw_rds(c_idx,-1) + write (iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) + + call endrun(decomp_index=c_idx, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + + enddo ! loop over wvl bands + + + ! Weight output NIR albedo appropriately + albout(c_idx,1) = albout_lcl(1) + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) + end do + albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + + ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately + flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) + do i=snl_top,1,1 + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) + enddo + flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end do + + ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo + elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then + albout(c_idx,1) = albsfc(c_idx,1) + albout(c_idx,2) = albsfc(c_idx,2) + + ! There is either zero snow, or no sun + else + albout(c_idx,1) = 0._r8 + albout(c_idx,2) = 0._r8 + endif ! if column has snow and coszen > 0 + + enddo ! loop over all columns + + end associate + + end subroutine SNICAR_RT + + !----------------------------------------------------------------------- + subroutine SnowAge_grain(bounds, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & + waterflux_inst, waterstate_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Updates the snow effective grain size (radius). + ! Contributions to grain size evolution are from: + ! 1. vapor redistribution (dry snow) + ! 2. liquid water redistribution (wet snow) + ! 3. re-freezing of liquid water + ! + ! Vapor redistribution: Method is to retrieve 3 best-bit parameters that + ! depend on snow temperature, temperature gradient, and density, + ! that are derived from the microphysical model described in: + ! Flanner and Zender (2006), Linking snowpack microphysics and albedo + ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. + ! The parametric equation has the form: + ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where: + ! r is the effective radius, + ! tau and kappa are best-fit parameters, + ! drdt_0 is the initial rate of change of effective radius, and + ! dr_fresh is the difference between the current and fresh snow states + ! (r_current - r_fresh). + ! + ! Liquid water redistribution: Apply the grain growth function from: + ! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of + ! liquid-water content, Annals of Glaciology, 13, 22-26. + ! There are two parameters that describe the grain growth rate as + ! a function of snow liquid water content (LWC). The "LWC=0" parameter + ! is zeroed here because we are accounting for dry snowing with a + ! different representation + ! + ! Re-freezing of liquid water: Assume that re-frozen liquid water clumps + ! into an arbitrarily large effective grain size (snw_rds_refrz). + ! The phenomenon is observed (Grenfell), but so far unquantified, as far as + ! I am aware. + ! + ! !USES: + use clm_time_manager , only : get_step_size, get_nstep + use clm_varpar , only : nlevsno + use clm_varcon , only : spval + use shr_const_mod , only : SHR_CONST_RHOICE, SHR_CONST_PI + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_snowc ! number of column snow points in column filter + integer , intent(in) :: filter_snowc(:) ! column filter for snow points + integer , intent(in) :: num_nosnowc ! number of column non-snow points in column filter + integer , intent(in) :: filter_nosnowc(:) ! column filter for non-snow points + type(waterflux_type) , intent(in) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: snl_top ! top snow layer index [idx] + integer :: snl_btm ! bottom snow layer index [idx] + integer :: i ! layer index [idx] + integer :: c_idx ! column index [idx] + integer :: fc ! snow column filter index [idx] + integer :: T_idx ! snow aging lookup table temperature index [idx] + integer :: Tgrd_idx ! snow aging lookup table temperature gradient index [idx] + integer :: rhos_idx ! snow aging lookup table snow density index [idx] + real(r8) :: t_snotop ! temperature at upper layer boundary [K] + real(r8) :: t_snobtm ! temperature at lower layer boundary [K] + real(r8) :: dTdz(bounds%begc:bounds%endc,-nlevsno:0) ! snow temperature gradient (col,lyr) [K m-1] + real(r8) :: bst_tau ! snow aging parameter retrieved from lookup table [hour] + real(r8) :: bst_kappa ! snow aging parameter retrieved from lookup table [unitless] + real(r8) :: bst_drdt0 ! snow aging parameter retrieved from lookup table [um hr-1] + real(r8) :: dr ! incremental change in snow effective radius [um] + real(r8) :: dr_wet ! incremental change in snow effective radius from wet growth [um] + real(r8) :: dr_fresh ! difference between fresh snow r_e and current r_e [um] + real(r8) :: newsnow ! fresh snowfall [kg m-2] + real(r8) :: refrzsnow ! re-frozen snow [kg m-2] + real(r8) :: frc_newsnow ! fraction of layer mass that is new snow [frc] + real(r8) :: frc_oldsnow ! fraction of layer mass that is old snow [frc] + real(r8) :: frc_refrz ! fraction of layer mass that is re-frozen snow [frc] + real(r8) :: frc_liq ! fraction of layer mass that is liquid water[frc] + real(r8) :: dtime ! land model time step [sec] + real(r8) :: rhos ! snow density [kg m-3] + real(r8) :: h2osno_lyr ! liquid + solid H2O in snow layer [kg m-2] + real(r8) :: cdz(-nlevsno+1:0) ! column average layer thickness [m] + !--------------------------------------------------------------------------! + + associate( & + snl => col%snl , & ! Input: [integer (:) ] negative number of snow layers (col) [nbr] + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (col,lyr) [m] + + qflx_snow_grnd_col => waterflux_inst%qflx_snow_grnd_col , & ! Input: [real(r8) (:) ] snow on ground after interception (col) [kg m-2 s-1] + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess precipitation due to snow capping [kg m-2 s-1] + qflx_snofrz_lyr => waterflux_inst%qflx_snofrz_lyr_col , & ! Input: [real(r8) (:,:) ] snow freezing rate (col,lyr) [kg m-2 s-1] + + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (col) [mm H2O] + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg m-2] + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice content (col,lyr) [kg m-2] + snw_rds => waterstate_inst%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective grain radius (col,lyr) [microns, m-6] + snw_rds_top => waterstate_inst%snw_rds_top_col , & ! Output: [real(r8) (:) ] effective grain radius, top layer (col) [microns, m-6] + sno_liq_top => waterstate_inst%sno_liq_top_col , & ! Output: [real(r8) (:) ] liquid water fraction (mass) in top snow layer (col) [frc] + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil and snow temperature (col,lyr) [K] + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (col) [K] + snot_top => temperature_inst%snot_top_col , & ! Output: [real(r8) (:) ] temperature in top snow layer (col) [K] + dTdz_top => temperature_inst%dTdz_top_col & ! Output: [real(r8) (:) ] temperature gradient in top layer (col) [K m-1] + ) + + + ! set timestep and step interval + dtime = get_step_size() + + ! loop over columns that have at least one snow layer + do fc = 1, num_snowc + c_idx = filter_snowc(fc) + + snl_btm = 0 + snl_top = snl(c_idx) + 1 + + cdz(snl_top:snl_btm)=frac_sno(c_idx)*dz(c_idx,snl_top:snl_btm) + + ! loop over snow layers + do i=snl_top,snl_btm,1 + ! + !********** 1. DRY SNOW AGING *********** + ! + h2osno_lyr = h2osoi_liq(c_idx,i) + h2osoi_ice(c_idx,i) + + ! temperature gradient + if (i == snl_top) then + ! top layer + t_snotop = t_soisno(c_idx,snl_top) + t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) & + + t_soisno(c_idx,i)*dz(c_idx,i+1)) & + / (dz(c_idx,i)+dz(c_idx,i+1)) + else + t_snotop = (t_soisno(c_idx,i-1)*dz(c_idx,i) & + + t_soisno(c_idx,i)*dz(c_idx,i-1)) & + / (dz(c_idx,i)+dz(c_idx,i-1)) + t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) & + + t_soisno(c_idx,i)*dz(c_idx,i+1)) & + / (dz(c_idx,i)+dz(c_idx,i+1)) + endif + + dTdz(c_idx,i) = abs((t_snotop - t_snobtm) / cdz(i)) + + ! snow density + rhos = (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)) / cdz(i) + + ! make sure rhos doesn't drop below 50 (see rhos_idx below) + rhos=max(50._r8,rhos) + + ! best-fit table indecies + T_idx = nint((t_soisno(c_idx,i)-223) / 5) + 1 + Tgrd_idx = nint(dTdz(c_idx,i) / 10) + 1 + rhos_idx = nint((rhos-50) / 50) + 1 + + ! boundary check: + if (T_idx < idx_T_min) then + T_idx = idx_T_min + endif + if (T_idx > idx_T_max) then + T_idx = idx_T_max + endif + if (Tgrd_idx < idx_Tgrd_min) then + Tgrd_idx = idx_Tgrd_min + endif + if (Tgrd_idx > idx_Tgrd_max) then + Tgrd_idx = idx_Tgrd_max + endif + if (rhos_idx < idx_rhos_min) then + rhos_idx = idx_rhos_min + endif + if (rhos_idx > idx_rhos_max) then + rhos_idx = idx_rhos_max + endif + + ! best-fit parameters + bst_tau = snowage_tau(rhos_idx,Tgrd_idx,T_idx) + bst_kappa = snowage_kappa(rhos_idx,Tgrd_idx,T_idx) + bst_drdt0 = snowage_drdt0(rhos_idx,Tgrd_idx,T_idx) + + + ! change in snow effective radius, using best-fit parameters + dr_fresh = snw_rds(c_idx,i)-snw_rds_min + dr = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa)) * (dtime/3600) + + ! + !********** 2. WET SNOW AGING *********** + ! + ! We are assuming wet and dry evolution occur simultaneously, and + ! the contributions from both can be summed. + ! This is justified by setting the linear offset constant C1_liq_Brun89 to zero [Brun, 1989] + + ! liquid water faction + frc_liq = min(0.1_r8, (h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)))) + + !dr_wet = 1E6_r8*(dtime*(C1_liq_Brun89 + C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*(snw_rds(c_idx,i)/1E6)**(2))) + !simplified, units of microns: + dr_wet = 1E18_r8*(dtime*(C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*snw_rds(c_idx,i)**(2))) + + dr = dr + dr_wet + + ! + !********** 3. SNOWAGE SCALING (TURNED OFF BY DEFAULT) ************* + ! + ! Multiply rate of change of effective radius by some constant, xdrdt + if (flg_snoage_scl) then + dr = dr*xdrdt + endif + + + ! + !********** 4. INCREMENT EFFECTIVE RADIUS, ACCOUNTING FOR: *********** + ! DRY AGING + ! WET AGING + ! FRESH SNOW + ! RE-FREEZING + ! + ! new snowfall [kg/m2] + if (do_capsnow(c_idx)) then + newsnow = max(0._r8, (qflx_snwcp_ice(c_idx)*dtime)) + else + newsnow = max(0._r8, (qflx_snow_grnd_col(c_idx)*dtime)) + endif + + ! snow that has re-frozen [kg/m2] + refrzsnow = max(0._r8, (qflx_snofrz_lyr(c_idx,i)*dtime)) + + ! fraction of layer mass that is re-frozen + frc_refrz = refrzsnow / h2osno_lyr + + ! fraction of layer mass that is new snow + if (i == snl_top) then + frc_newsnow = newsnow / h2osno_lyr + else + frc_newsnow = 0._r8 + endif + + if ((frc_refrz + frc_newsnow) > 1._r8) then + frc_refrz = frc_refrz / (frc_refrz + frc_newsnow) + frc_newsnow = 1._r8 - frc_refrz + frc_oldsnow = 0._r8 + else + frc_oldsnow = 1._r8 - frc_refrz - frc_newsnow + endif + + ! mass-weighted mean of fresh snow, old snow, and re-frozen snow effective radius + snw_rds(c_idx,i) = (snw_rds(c_idx,i)+dr)*frc_oldsnow + snw_rds_min*frc_newsnow + snw_rds_refrz*frc_refrz + ! + !********** 5. CHECK BOUNDARIES *********** + ! + ! boundary check + if (snw_rds(c_idx,i) < snw_rds_min) then + snw_rds(c_idx,i) = snw_rds_min + endif + + if (snw_rds(c_idx,i) > snw_rds_max) then + snw_rds(c_idx,i) = snw_rds_max + end if + + ! set top layer variables for history files + if (i == snl_top) then + snot_top(c_idx) = t_soisno(c_idx,i) + dTdz_top(c_idx) = dTdz(c_idx,i) + snw_rds_top(c_idx) = snw_rds(c_idx,i) + sno_liq_top(c_idx) = h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)) + endif + + enddo + enddo + + ! Special case: snow on ground, but not enough to have defined a snow layer: + ! set snw_rds to fresh snow grain size: + do fc = 1, num_nosnowc + c_idx = filter_nosnowc(fc) + if (h2osno(c_idx) > 0._r8) then + snw_rds(c_idx,0) = snw_rds_min + endif + enddo + + end associate + + end subroutine SnowAge_grain + + !----------------------------------------------------------------------- + subroutine SnowOptics_init( ) + + use fileutils , only : getfil + use CLM_varctl , only : fsnowoptics + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + + type(file_desc_t) :: ncid ! netCDF file id + character(len=256) :: locfn ! local filename + character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name + integer :: ier ! error status + + ! + ! Open optics file: + if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' + call getfil (fsnowoptics, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + + ! direct-beam snow Mie parameters: + call ncd_io('ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + + ! diffuse snow Mie parameters + call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + + ! BC species 1 Mie parameters + call ncd_io( 'ss_alb_bcphil', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphil', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphil', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + + ! BC species 2 Mie parameters + call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + + ! OC species 1 Mie parameters + call ncd_io( 'ss_alb_ocphil', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphil', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphil', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + + ! OC species 2 Mie parameters + call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + + + call ncd_pio_closefile(ncid) + if (masterproc) then + + write(iulog,*) 'Successfully read snow optical properties' + ! print some diagnostics: + write (iulog,*) 'SNICAR: Mie single scatter albedos for direct-beam ice, rds=100um: ', & + ss_alb_snw_drc(71,1), ss_alb_snw_drc(71,2), ss_alb_snw_drc(71,3), & + ss_alb_snw_drc(71,4), ss_alb_snw_drc(71,5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for diffuse ice, rds=100um: ', & + ss_alb_snw_dfs(71,1), ss_alb_snw_dfs(71,2), ss_alb_snw_dfs(71,3), & + ss_alb_snw_dfs(71,4), ss_alb_snw_dfs(71,5) + if (DO_SNO_OC) then + write (iulog,*) 'SNICAR: Including OC aerosols from snow radiative transfer calculations' + else + write (iulog,*) 'SNICAR: Excluding OC aerosols from snow radiative transfer calculations' + endif + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic BC: ', & + ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic BC: ', & + ss_alb_bc2(1), ss_alb_bc2(2), ss_alb_bc2(3), ss_alb_bc2(4), ss_alb_bc2(5) + if (DO_SNO_OC) then + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic OC: ', & + ss_alb_oc1(1), ss_alb_oc1(2), ss_alb_oc1(3), ss_alb_oc1(4), ss_alb_oc1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic OC: ', & + ss_alb_oc2(1), ss_alb_oc2(2), ss_alb_oc2(3), ss_alb_oc2(4), ss_alb_oc2(5) + endif + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 1: ', & + ss_alb_dst1(1), ss_alb_dst1(2), ss_alb_dst1(3), ss_alb_dst1(4), ss_alb_dst1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 2: ', & + ss_alb_dst2(1), ss_alb_dst2(2), ss_alb_dst2(3), ss_alb_dst2(4), ss_alb_dst2(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 3: ', & + ss_alb_dst3(1), ss_alb_dst3(2), ss_alb_dst3(3), ss_alb_dst3(4), ss_alb_dst3(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 4: ', & + ss_alb_dst4(1), ss_alb_dst4(2), ss_alb_dst4(3), ss_alb_dst4(4), ss_alb_dst4(5) + write(iulog,*) + end if + + end subroutine SnowOptics_init + + !----------------------------------------------------------------------- + subroutine SnowAge_init( ) + use CLM_varctl , only : fsnowaging + use fileutils , only : getfil + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + + type(file_desc_t) :: ncid ! netCDF file id + character(len=256) :: locfn ! local filename + character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name + integer :: varid ! netCDF id's + integer :: ier ! error status + + ! Open snow aging (effective radius evolution) file: + allocate(snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + allocate(snowage_kappa(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + + if(masterproc) write(iulog,*) 'Attempting to read snow aging parameters .....' + call getfil (fsnowaging, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowaging) + + ! snow aging parameters + + call ncd_io('tau', snowage_tau, 'read', ncid, posNOTonfile=.true.) + call ncd_io('kappa', snowage_kappa, 'read', ncid, posNOTonfile=.true.) + call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, posNOTonfile=.true.) + + call ncd_pio_closefile(ncid) + if (masterproc) then + + write(iulog,*) 'Successfully read snow aging properties' + + ! print some diagnostics: + write (iulog,*) 'SNICAR: snowage tau for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_tau(3,11,9) + write (iulog,*) 'SNICAR: snowage kappa for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_kappa(3,11,9) + write (iulog,*) 'SNICAR: snowage dr/dt_0 for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_drdt0(3,11,9) + endif + + end subroutine SnowAge_init + + end module SnowSnicarMod diff --git a/components/clm/src/biogeophys/SoilFluxesMod.F90 b/components/clm/src/biogeophys/SoilFluxesMod.F90 new file mode 100644 index 0000000000..67961c1cb5 --- /dev/null +++ b/components/clm/src/biogeophys/SoilFluxesMod.F90 @@ -0,0 +1,445 @@ +module SoilFluxesMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Updates surface fluxes based on the new ground temperature. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : iulog + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, max_patch_per_col + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use EnergyFluxType , only : energyflux_type + use SolarAbsorbedType , only : solarabs_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use WaterfluxType , only : waterflux_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilFluxes ! Calculate soil/snow and ground temperatures + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & + num_nolakec, filter_nolakec, num_nolakep, filter_nolakep, & + atm2lnd_inst, solarabs_inst, temperature_inst, canopystate_inst, & + waterstate_inst, energyflux_inst, waterflux_inst) + ! + ! !DESCRIPTION: + ! Update surface fluxes based on the new ground temperature + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varcon , only : hvap, cpair, grav, vkc, tfrz, sb + use landunit_varcon , only : istsoil, istcrop + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv + use subgridAveMod , only : p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + integer , intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(temperature_type) , intent(in) :: temperature_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,g,j,pi,l ! indices + integer :: fc,fp ! lake filtered column and pft indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: egsmax(bounds%begc:bounds%endc) ! max. evaporation which soil can provide at one time step + real(r8) :: egirat(bounds%begc:bounds%endc) ! ratio of topsoil_evap_tot : egsmax + real(r8) :: tinc(bounds%begc:bounds%endc) ! temperature difference of two time step + real(r8) :: sumwt(bounds%begc:bounds%endc) ! temporary + real(r8) :: evaprat(bounds%begp:bounds%endp) ! ratio of qflx_evap_soi/topsoil_evap_tot + real(r8) :: save_qflx_evap_soi ! temporary storage for qflx_evap_soi + real(r8) :: topsoil_evap_tot(bounds%begc:bounds%endc) ! column-level total evaporation from top soil layer + real(r8) :: eflx_lwrad_del(bounds%begp:bounds%endp) ! update due to eflx_lwrad + real(r8) :: t_grnd0(bounds%begc:bounds%endc) ! t_grnd of previous time step + real(r8) :: lw_grnd + real(r8) :: fsno_eff + !----------------------------------------------------------------------- + + associate( & + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of veg not covered by snow (0/1 now) [-] + + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + do_capsnow => waterstate_inst%do_capsnow_col , & ! Input: [logical (:) ] true => do snow capping + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) (new) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) + + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + + emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:) ] soil/snow temperature before update + t_h2osfc_bef => temperature_inst%t_h2osfc_bef_col , & ! Input: [real(r8) (:) ] saved surface water temperature + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + xmf => temperature_inst%xmf_col , & ! Input: [real(r8) (:) ] + xmf_h2osfc => temperature_inst%xmf_h2osfc_col , & ! Input: [real(r8) (:) ] + fact => temperature_inst%fact_col , & ! Input: [real(r8) (:) ] + c_h2osfc => temperature_inst%c_h2osfc_col , & ! Input: [real(r8) (:) ] + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of vapor of water (or sublimation) [j/kg] + eflx_building_heat_errsoi=> energyflux_inst%eflx_building_heat_errsoi_col , & ! Input: [real(r8) (:)] heat flux to interior surface of walls and roof for errsoi check (W m-2) + eflx_wasteheat_patch => energyflux_inst%eflx_wasteheat_patch , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac_patch => energyflux_inst%eflx_heat_from_ac_patch , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_traffic_patch => energyflux_inst%eflx_traffic_patch , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + dlrad => energyflux_inst%dlrad_patch , & ! Input: [real(r8) (:) ] downward longwave radiation below the canopy [W/m2] + ulrad => energyflux_inst%ulrad_patch , & ! Input: [real(r8) (:) ] upward longwave radiation above the canopy [W/m2] + cgrnds => energyflux_inst%cgrnds_patch , & ! Input: [real(r8) (:) ] deriv, of soil sensible heat flux wrt soil temp [w/m2/k] + cgrndl => energyflux_inst%cgrndl_patch , & ! Input: [real(r8) (:) ] deriv of soil latent heat flux wrt soil temp [w/m**2/k] + + qflx_evap_can => waterflux_inst%qflx_evap_can_patch , & ! Output: [real(r8) (:) ] evaporation from leaves and stems (mm H2O/s) (+ = to atm) + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_evap_veg => waterflux_inst%qflx_evap_veg_patch , & ! Output: [real(r8) (:) ] vegetation evaporation (mm H2O/s) (+ = to atm) + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_patch , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_patch , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_patch , & ! Output: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_sub_snow => waterflux_inst%qflx_sub_snow_patch , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_dew_snow => waterflux_inst%qflx_dew_snow_patch , & ! Output: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_patch , & ! Output: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Output: [real(r8) (:) ] evaporation flux from snow (W/m**2) [+ to atm] + qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_sh_veg => energyflux_inst%eflx_sh_veg_patch , & ! Output: [real(r8) (:) ] sensible heat flux from leaves (W/m**2) [+ to atm] + eflx_soil_grnd => energyflux_inst%eflx_soil_grnd_patch , & ! Output: [real(r8) (:) ] soil heat flux (W/m**2) [+ = into soil] + eflx_soil_grnd_u => energyflux_inst%eflx_soil_grnd_u_patch , & ! Output: [real(r8) (:) ] urban soil heat flux (W/m**2) [+ = into soil] + eflx_soil_grnd_r => energyflux_inst%eflx_soil_grnd_r_patch , & ! Output: [real(r8) (:) ] rural soil heat flux (W/m**2) [+ = into soil] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_tot_u => energyflux_inst%eflx_sh_tot_u_patch , & ! Output: [real(r8) (:) ] urban total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_tot_r => energyflux_inst%eflx_sh_tot_r_patch , & ! Output: [real(r8) (:) ] rural total sensible heat flux (W/m**2) [+ to atm] + eflx_lh_tot => energyflux_inst%eflx_lh_tot_patch , & ! Output: [real(r8) (:) ] total latent heat flux (W/m**2) [+ to atm] + eflx_lh_tot_u => energyflux_inst%eflx_lh_tot_u_patch , & ! Output: [real(r8) (:) ] urban total latent heat flux (W/m**2) [+ to atm] + eflx_lh_tot_r => energyflux_inst%eflx_lh_tot_r_patch , & ! Output: [real(r8) (:) ] rural total latent heat flux (W/m**2) [+ to atm] + eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Output: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Output: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_lwrad_net_r => energyflux_inst%eflx_lwrad_net_r_patch , & ! Output: [real(r8) (:) ] rural net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_lwrad_out_r => energyflux_inst%eflx_lwrad_out_r_patch , & ! Output: [real(r8) (:) ] rural emitted infrared (longwave) rad (W/m**2) + eflx_lwrad_net_u => energyflux_inst%eflx_lwrad_net_u_patch , & ! Output: [real(r8) (:) ] urban net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_lwrad_out_u => energyflux_inst%eflx_lwrad_out_u_patch , & ! Output: [real(r8) (:) ] urban emitted infrared (longwave) rad (W/m**2) + eflx_lh_vege => energyflux_inst%eflx_lh_vege_patch , & ! Output: [real(r8) (:) ] veg evaporation heat flux (W/m**2) [+ to atm] + eflx_lh_vegt => energyflux_inst%eflx_lh_vegt_patch , & ! Output: [real(r8) (:) ] veg transpiration heat flux (W/m**2) [+ to atm] + eflx_lh_grnd => energyflux_inst%eflx_lh_grnd_patch , & ! Output: [real(r8) (:) ] ground evaporation heat flux (W/m**2) [+ to atm] + errsoi_col => energyflux_inst%errsoi_col , & ! Output: [real(r8) (:) ] column-level soil/lake energy conservation error (W/m**2) + errsoi_patch => energyflux_inst%errsoi_patch & ! Output: [real(r8) (:) ] patch-level soil/lake energy conservation error (W/m**2) + ) + + ! Get step size + + dtime = get_step_size() + + call t_startf('bgp2_loop_1') + do fc = 1,num_nolakec + c = filter_nolakec(fc) + j = col%snl(c)+1 + + ! Calculate difference in soil temperature from last time step, for + ! flux corrections + + if (col%snl(c) < 0) then + t_grnd0(c) = frac_sno_eff(c) * tssbef(c,col%snl(c)+1) & + + (1 - frac_sno_eff(c) - frac_h2osfc(c)) * tssbef(c,1) & + + frac_h2osfc(c) * t_h2osfc_bef(c) + else + t_grnd0(c) = (1 - frac_h2osfc(c)) * tssbef(c,1) + frac_h2osfc(c) * t_h2osfc_bef(c) + endif + + tinc(c) = t_grnd(c) - t_grnd0(c) + + ! Determine ratio of topsoil_evap_tot + + egsmax(c) = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) / dtime + + ! added to trap very small negative soil water,ice + + if (egsmax(c) < 0._r8) then + egsmax(c) = 0._r8 + end if + end do + + ! A preliminary pft loop to determine if corrections are required for + ! excess evaporation from the top soil layer... Includes new logic + ! to distribute the corrections between patches on the basis of their + ! evaporative demands. + ! egirat holds the ratio of demand to availability if demand is + ! greater than availability, or 1.0 otherwise. + ! Correct fluxes to present soil temperature + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + eflx_sh_grnd(p) = eflx_sh_grnd(p) + tinc(c)*cgrnds(p) + qflx_evap_soi(p) = qflx_evap_soi(p) + tinc(c)*cgrndl(p) + + ! set ev_snow, ev_soil for urban landunits here + l = patch%landunit(p) + if (lun%urbpoi(l)) then + qflx_ev_snow(p) = qflx_evap_soi(p) + qflx_ev_soil(p) = 0._r8 + qflx_ev_h2osfc(p) = 0._r8 + else + qflx_ev_snow(p) = qflx_ev_snow(p) + tinc(c)*cgrndl(p) + qflx_ev_soil(p) = qflx_ev_soil(p) + tinc(c)*cgrndl(p) + qflx_ev_h2osfc(p) = qflx_ev_h2osfc(p) + tinc(c)*cgrndl(p) + endif + end do + + ! Set the column-average qflx_evap_soi as the weighted average over all patches + ! but only count the patches that are evaporating + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + topsoil_evap_tot(c) = 0._r8 + sumwt(c) = 0._r8 + end do + + do pi = 1,max_patch_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + topsoil_evap_tot(c) = topsoil_evap_tot(c) + qflx_evap_soi(p) * patch%wtcol(p) + end if + end if + end do + end do + call t_stopf('bgp2_loop_1') + call t_startf('bgp2_loop_2') + + ! Calculate ratio for rescaling patch-level fluxes to meet availability + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (topsoil_evap_tot(c) > egsmax(c)) then + egirat(c) = (egsmax(c)/topsoil_evap_tot(c)) + else + egirat(c) = 1.0_r8 + end if + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + j = col%snl(c)+1 + + ! Correct soil fluxes for possible evaporation in excess of top layer water + ! excess energy is added to the sensible heat flux from soil + + if (egirat(c) < 1.0_r8) then + save_qflx_evap_soi = qflx_evap_soi(p) + qflx_evap_soi(p) = qflx_evap_soi(p) * egirat(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) + (save_qflx_evap_soi - qflx_evap_soi(p))*htvp(c) + qflx_ev_snow(p) = qflx_ev_snow(p) * egirat(c) + qflx_ev_soil(p) = qflx_ev_soil(p) * egirat(c) + qflx_ev_h2osfc(p) = qflx_ev_h2osfc(p) * egirat(c) + end if + + ! Ground heat flux + + if (.not. lun%urbpoi(l)) then + lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & + +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + + eflx_soil_grnd(p) = ((1._r8- frac_sno_eff(c))*sabg_soil(p) + frac_sno_eff(c)*sabg_snow(p)) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - emg(c)*sb*lw_grnd - emg(c)*sb*t_grnd0(c)**3*(4._r8*tinc(c)) & + - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_soil_grnd_r(p) = eflx_soil_grnd(p) + end if + else + ! For all urban columns we use the net longwave radiation (eflx_lwrad_net) since + ! the term (emg*sb*tssbef(col%snl+1)**4) is not the upward longwave flux because of + ! interactions between urban columns. + + eflx_lwrad_del(p) = 4._r8*emg(c)*sb*t_grnd0(c)**3*tinc(c) + + ! Include transpiration term because needed for pervious road + ! and wasteheat and traffic flux + eflx_soil_grnd(p) = sabg(p) + dlrad(p) & + - eflx_lwrad_net(p) - eflx_lwrad_del(p) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & + + eflx_wasteheat_patch(p) + eflx_heat_from_ac_patch(p) + eflx_traffic_patch(p) + eflx_soil_grnd_u(p) = eflx_soil_grnd(p) + end if + + ! Total fluxes (vegetation + ground) + + eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) + qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) + eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_lh_tot_r(p)= eflx_lh_tot(p) + eflx_sh_tot_r(p)= eflx_sh_tot(p) + else if (lun%urbpoi(l)) then + eflx_lh_tot_u(p)= eflx_lh_tot(p) + eflx_sh_tot_u(p)= eflx_sh_tot(p) + end if + + ! Assign ground evaporation to sublimation from soil ice or to dew + ! on snow or ground + + qflx_evap_grnd(p) = 0._r8 + qflx_sub_snow(p) = 0._r8 + qflx_dew_snow(p) = 0._r8 + qflx_dew_grnd(p) = 0._r8 + + if (qflx_ev_snow(p) >= 0._r8) then + ! for evaporation partitioning between liquid evap and ice sublimation, + ! use the ratio of liquid to (liquid+ice) in the top layer to determine split + if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0.) then + qflx_evap_grnd(p) = max(qflx_ev_snow(p)*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8) + else + qflx_evap_grnd(p) = 0. + end if + qflx_sub_snow(p) = qflx_ev_snow(p) - qflx_evap_grnd(p) + else + if (t_grnd(c) < tfrz) then + qflx_dew_snow(p) = abs(qflx_ev_snow(p)) + else + qflx_dew_grnd(p) = abs(qflx_ev_snow(p)) + end if + end if + + ! Update the patch-level qflx_snwcp + ! This was moved in from Hydrology2 to keep all patch-level + ! calculations out of Hydrology2 + + if (col%snl(c) < 0 .and. do_capsnow(c)) then + qflx_snwcp_liq(p) = qflx_snwcp_liq(p)+frac_sno_eff(c)*qflx_dew_grnd(p) + qflx_snwcp_ice(p) = qflx_snwcp_ice(p)+frac_sno_eff(c)*qflx_dew_snow(p) + end if + + ! Variables needed by history tape + + qflx_evap_can(p) = qflx_evap_veg(p) - qflx_tran_veg(p) + eflx_lh_vege(p) = (qflx_evap_veg(p) - qflx_tran_veg(p)) * hvap + eflx_lh_vegt(p) = qflx_tran_veg(p) * hvap + eflx_lh_grnd(p) = qflx_evap_soi(p) * htvp(c) + + end do + call t_stopf('bgp2_loop_2') + call t_startf('bgp2_loop_3') + + ! Soil Energy balance check + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + errsoi_patch(p) = eflx_soil_grnd(p) - xmf(c) - xmf_h2osfc(c) & + - frac_h2osfc(c)*(t_h2osfc(c)-t_h2osfc_bef(c)) & + *(c_h2osfc(c)/dtime) + + ! For urban sunwall, shadewall, and roof columns, the "soil" energy balance check + ! must include the heat flux from the interior of the building. + if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall .or. col%itype(c)==icol_roof) then + errsoi_patch(p) = errsoi_patch(p) + eflx_building_heat_errsoi(c) + end if + end do + do j = -nlevsno+1,nlevgrnd + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + + if ((col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) .or. ( j <= nlevurb)) then + ! area weight heat absorbed by snow layers + if (j >= col%snl(c)+1 .and. j < 1) errsoi_patch(p) = errsoi_patch(p) & + - frac_sno_eff(c)*(t_soisno(c,j)-tssbef(c,j))/fact(c,j) + if (j >= 1) errsoi_patch(p) = errsoi_patch(p) & + - (t_soisno(c,j)-tssbef(c,j))/fact(c,j) + end if + end do + end do + call t_stopf('bgp2_loop_3') + call t_startf('bgp2_loop_4') + + ! Outgoing long-wave radiation from vegetation + ground + ! For conservation we put the increase of ground longwave to outgoing + ! For urban patches, ulrad=0 and (1-fracveg_nosno)=1, and eflx_lwrad_out and eflx_lwrad_net + ! are calculated in UrbanRadiation. The increase of ground longwave is added directly + ! to the outgoing longwave and the net longwave. + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + j = col%snl(c)+1 + + if (.not. lun%urbpoi(l)) then + lw_grnd=(frac_sno_eff(c)*tssbef(c,col%snl(c)+1)**4 & + +(1._r8-frac_sno_eff(c)-frac_h2osfc(c))*tssbef(c,1)**4 & + +frac_h2osfc(c)*t_h2osfc_bef(c)**4) + + eflx_lwrad_out(p) = ulrad(p) & + + (1-frac_veg_nosno(p))*(1.-emg(c))*forc_lwrad(c) & + + (1-frac_veg_nosno(p))*emg(c)*sb*lw_grnd & + + 4._r8*emg(c)*sb*t_grnd0(c)**3*tinc(c) + + eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_lwrad_net_r(p) = eflx_lwrad_out(p) - forc_lwrad(c) + eflx_lwrad_out_r(p) = eflx_lwrad_out(p) + end if + else + eflx_lwrad_out(p) = eflx_lwrad_out(p) + eflx_lwrad_del(p) + eflx_lwrad_net(p) = eflx_lwrad_net(p) + eflx_lwrad_del(p) + eflx_lwrad_net_u(p) = eflx_lwrad_net_u(p) + eflx_lwrad_del(p) + eflx_lwrad_out_u(p) = eflx_lwrad_out(p) + end if + end do + + ! lake balance for errsoi is not over pft + ! therefore obtain column-level radiative temperature + + call p2c(bounds, num_nolakec, filter_nolakec, & + errsoi_patch(bounds%begp:bounds%endp), & + errsoi_col(bounds%begc:bounds%endc)) + + call t_stopf('bgp2_loop_4') + + end associate + + end subroutine SoilFluxes + +end module SoilFluxesMod + diff --git a/components/clm/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 b/components/clm/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 new file mode 100644 index 0000000000..b4522ab269 --- /dev/null +++ b/components/clm/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 @@ -0,0 +1,557 @@ +module SoilHydrologyInitTimeConstMod + + !------------------------------------------------------------------------------ + ! DESCRIPTION: + ! Initialize time constant variables for SoilHydrologyType + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use SoilHydrologyType , only : soilhydrology_type + use LandunitType , only : lun + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilHydrologyInitTimeConst + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: initSoilParVIC ! Convert default CLM soil properties to VIC parameters + private :: initCLMVICMap ! Initialize map from VIC to CLM layers + private :: linear_interp ! function for linear interperation + !----------------------------------------------------------------------- + ! +contains + + !----------------------------------------------------------------------- + subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst) + ! + ! !USES: + use shr_const_mod , only : shr_const_pi + use shr_spfn_mod , only : shr_spfn_erf + use abortutils , only : endrun + use clm_varctl , only : fsurdat, paramfile, iulog, use_vichydro + use clm_varpar , only : more_vertlayers, nlevsoifl, toplev_equalspace + use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb, nlayer, nlayert + use clm_varcon , only : zsoi, dzsoi, zisoi, spval, nlvic, dzvic, pc, grlnd + use landunit_varcon , only : istice, istwet, istsoil, istdlak, istcrop, istice_mec + use column_varcon , only : icol_shadewall, icol_road_perv, icol_road_imperv, icol_roof, icol_sunwall + use fileutils , only : getfil + use organicFileMod , only : organicrd + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,j,l,g,lev,nlevs + integer :: ivic,ivicstrt,ivicend + real(r8) :: maxslope, slopemax, minslope + real(r8) :: d, fd, dfdd, slope0,slopebeta + real(r8) ,pointer :: tslope(:) + logical :: readvar + type(file_desc_t) :: ncid + character(len=256) :: locfn + real(r8) :: clay,sand ! temporaries + real(r8) :: om_frac ! organic matter fraction + real(r8) :: organic_max ! organic matter (kg/m3) where soil is assumed to act like peat + real(r8) ,pointer :: b2d (:) ! read in - VIC b + real(r8) ,pointer :: ds2d (:) ! read in - VIC Ds + real(r8) ,pointer :: dsmax2d (:) ! read in - VIC Dsmax + real(r8) ,pointer :: ws2d (:) ! read in - VIC Ws + real(r8), pointer :: sandcol (:,:) ! column level sand fraction for calculating VIC parameters + real(r8), pointer :: claycol (:,:) ! column level clay fraction for calculating VIC parameters + real(r8), pointer :: om_fraccol (:,:) ! column level organic matter fraction for calculating VIC parameters + real(r8) ,pointer :: sand3d (:,:) ! read in - soil texture: percent sand + real(r8) ,pointer :: clay3d (:,:) ! read in - soil texture: percent clay + real(r8) ,pointer :: organic3d (:,:) ! read in - organic matter: kg/m3 + real(r8) ,pointer :: zisoifl (:) ! original soil interface depth + real(r8) ,pointer :: zsoifl (:) ! original soil midpoint + real(r8) ,pointer :: dzsoifl (:) ! original soil thickness + !----------------------------------------------------------------------- + ! ----------------------------------------------------------------- + ! Initialize frost table + ! ----------------------------------------------------------------- + + soilhydrology_inst%wa_col(bounds%begc:bounds%endc) = 5000._r8 + soilhydrology_inst%zwt_col(bounds%begc:bounds%endc) = 0._r8 + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (.not. lun%lakpoi(l)) then !not lake + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_perv) then + soilhydrology_inst%wa_col(c) = 4800._r8 + soilhydrology_inst%zwt_col(c) = (25._r8 + col%zi(c,nlevsoi)) - soilhydrology_inst%wa_col(c)/0.2_r8 /1000._r8 ! One meter below soil column + else + soilhydrology_inst%wa_col(c) = spval + soilhydrology_inst%zwt_col(c) = spval + end if + ! initialize frost_table, zwt_perched + soilhydrology_inst%zwt_perched_col(c) = spval + soilhydrology_inst%frost_table_col(c) = spval + else + soilhydrology_inst%wa_col(c) = 4000._r8 + soilhydrology_inst%zwt_col(c) = (25._r8 + col%zi(c,nlevsoi)) - soilhydrology_inst%wa_col(c)/0.2_r8 /1000._r8 ! One meter below soil column + ! initialize frost_table, zwt_perched to bottom of soil column + soilhydrology_inst%zwt_perched_col(c) = col%zi(c,nlevsoi) + soilhydrology_inst%frost_table_col(c) = col%zi(c,nlevsoi) + end if + end if + end do + + ! Initialize VIC variables + + if (use_vichydro) then + + allocate(b2d (bounds%begg:bounds%endg)) + allocate(ds2d (bounds%begg:bounds%endg)) + allocate(dsmax2d (bounds%begg:bounds%endg)) + allocate(ws2d (bounds%begg:bounds%endg)) + allocate(sandcol (bounds%begc:bounds%endc,1:nlevgrnd )) + allocate(claycol (bounds%begc:bounds%endc,1:nlevgrnd )) + allocate(om_fraccol (bounds%begc:bounds%endc,1:nlevgrnd )) + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + call ncd_io(ncid=ncid, varname='binfl', flag='read', data=b2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: binfl NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='Ds', flag='read', data=ds2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Ds NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='Dsmax', flag='read', data=dsmax2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Dsmax NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='Ws', flag='read', data=ws2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: Ws NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_pio_closefile(ncid) + + !define the depth of VIC soil layers here + nlvic(1) = 3 + nlvic(2) = toplev_equalspace - nlvic(1) + nlvic(3) = nlevsoi - (nlvic(1) + nlvic(2)) + + dzvic(:) = 0._r8 + ivicstrt = 1 + + do ivic = 1,nlayer + ivicend = ivicstrt+nlvic(ivic)-1 + do j = ivicstrt,ivicend + dzvic(ivic) = dzvic(ivic)+dzsoi(j) + end do + ivicstrt = ivicend+1 + end do + + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + soilhydrology_inst%b_infil_col(c) = b2d(g) + soilhydrology_inst%ds_col(c) = ds2d(g) + soilhydrology_inst%dsmax_col(c) = dsmax2d(g) + soilhydrology_inst%Wsvic_col(c) = ws2d(g) + end do + + do c = bounds%begc, bounds%endc + soilhydrology_inst%max_infil_col(c) = spval + soilhydrology_inst%i_0_col(c) = spval + do lev = 1, nlayer + soilhydrology_inst%ice_col(c,lev) = spval + soilhydrology_inst%moist_col(c,lev) = spval + soilhydrology_inst%moist_vol_col(c,lev) = spval + soilhydrology_inst%max_moist_col(c,lev) = spval + soilhydrology_inst%porosity_col(c,lev) = spval + soilhydrology_inst%expt_col(c,lev) = spval + soilhydrology_inst%ksat_col(c,lev) = spval + soilhydrology_inst%phi_s_col(c,lev) = spval + soilhydrology_inst%depth_col(c,lev) = spval + sandcol(c,lev) = spval + claycol(c,lev) = spval + om_fraccol(c,lev) = spval + end do + end do + + allocate(sand3d(bounds%begg:bounds%endg,nlevsoifl)) + allocate(clay3d(bounds%begg:bounds%endg,nlevsoifl)) + allocate(organic3d(bounds%begg:bounds%endg,nlevsoifl)) + + call organicrd(organic3d) + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: PCT_SAND NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: PCT_CLAY NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_pio_closefile(ncid) + + ! Determine organic_max + call getfil (paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='organic_max', flag='read', data=organic_max, readvar=readvar) + if ( .not. readvar ) then + call endrun(msg=' ERROR: organic_max not on param file'//errMsg(__FILE__, __LINE__)) + end if + call ncd_pio_closefile(ncid) + + ! get original soil depths to be used in interpolation of sand and clay + allocate(zsoifl(1:nlevsoifl), zisoifl(0:nlevsoifl), dzsoifl(1:nlevsoifl)) + do j = 1, nlevsoifl + zsoifl(j) = 0.025*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths + enddo + + dzsoifl(1) = 0.5_r8*(zsoifl(1)+zsoifl(2)) !thickness b/n two interfaces + do j = 2,nlevsoifl-1 + dzsoifl(j)= 0.5_r8*(zsoifl(j+1)-zsoifl(j-1)) + enddo + dzsoifl(nlevsoifl) = zsoifl(nlevsoifl)-zsoifl(nlevsoifl-1) + + zisoifl(0) = 0._r8 + do j = 1, nlevsoifl-1 + zisoifl(j) = 0.5_r8*(zsoifl(j)+zsoifl(j+1)) !interface depths + enddo + zisoifl(nlevsoifl) = zsoifl(nlevsoifl) + 0.5_r8*dzsoifl(nlevsoifl) + + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + l = col%landunit(c) + + if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types + if (lun%itype(l)==istwet .or. lun%itype(l)==istice .or. lun%itype(l)==istice_mec) then + ! do nothing + else if (lun%urbpoi(l) .and. (col%itype(c) /= icol_road_perv) .and. (col%itype(c) /= icol_road_imperv) )then + ! do nothing + else + do lev = 1,nlevgrnd + if ( more_vertlayers )then + ! duplicate clay and sand values from last soil layer + if (lev .eq. 1) then + clay = clay3d(g,1) + sand = sand3d(g,1) + om_frac = organic3d(g,1)/organic_max + else if (lev <= nlevsoi) then + do j = 1,nlevsoifl-1 + if (zisoi(lev) >= zisoifl(j) .AND. zisoi(lev) < zisoifl(j+1)) then + clay = clay3d(g,j+1) + sand = sand3d(g,j+1) + om_frac = organic3d(g,j+1)/organic_max + endif + end do + else + clay = clay3d(g,nlevsoifl) + sand = sand3d(g,nlevsoifl) + om_frac = 0._r8 + endif + else + ! duplicate clay and sand values from 10th soil layer + if (lev <= nlevsoi) then + clay = clay3d(g,lev) + sand = sand3d(g,lev) + om_frac = (organic3d(g,lev)/organic_max)**2._r8 + else + clay = clay3d(g,nlevsoi) + sand = sand3d(g,nlevsoi) + om_frac = 0._r8 + endif + end if + + if (lun%urbpoi(l)) om_frac = 0._r8 + claycol(c,lev) = clay + sandcol(c,lev) = sand + om_fraccol(c,lev) = om_frac + end do + end if + end if ! end of if not lake + + if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types + if (lun%urbpoi(l)) then + if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall .or. col%itype(c)==icol_roof) then + ! do nothing + else + soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic + soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd) + + ! create weights to map soil moisture profiles (10 layer) to 3 layers for VIC hydrology, M.Huang + call initCLMVICMap(c, soilhydrology_inst) + call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst) + end if + else + soilhydrology_inst%depth_col(c, 1:nlayer) = dzvic + soilhydrology_inst%depth_col(c, nlayer+1:nlayert) = col%dz(c, nlevsoi+1:nlevgrnd) + + ! create weights to map soil moisture profiles (10 layer) to 3 layers for VIC hydrology, M.Huang + call initCLMVICMap(c, soilhydrology_inst) + call initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst) + end if + end if ! end of if not lake + + end do ! end of loop over columns + + deallocate(b2d, ds2d, dsmax2d, ws2d) + deallocate(sandcol, claycol, om_fraccol) + deallocate(sand3d, clay3d, organic3d) + deallocate(zisoifl, zsoifl, dzsoifl) + + end if ! end of if use_vichydro + + associate(micro_sigma => col%micro_sigma) + do c = bounds%begc, bounds%endc + + ! determine h2osfc threshold ("fill & spill" concept) + ! set to zero for no h2osfc (w/frac_infclust =large) + + soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8 + if (micro_sigma(c) > 1.e-6_r8 .and. (soilhydrology_inst%h2osfcflag /= 0)) then + d = 0.0 + do p = 1,4 + fd = 0.5*(1.0_r8+shr_spfn_erf(d/(micro_sigma(c)*sqrt(2.0)))) - pc + dfdd = exp(-d**2/(2.0*micro_sigma(c)**2))/(micro_sigma(c)*sqrt(2.0*shr_const_pi)) + d = d - fd/dfdd + enddo + soilhydrology_inst%h2osfc_thresh_col(c) = 0.5*d*(1.0_r8+shr_spfn_erf(d/(micro_sigma(c)*sqrt(2.0)))) + & + micro_sigma(c)/sqrt(2.0*shr_const_pi)*exp(-d**2/(2.0*micro_sigma(c)**2)) + soilhydrology_inst%h2osfc_thresh_col(c) = 1.e3_r8 * soilhydrology_inst%h2osfc_thresh_col(c) !convert to mm from meters + else + soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8 + endif + + if (soilhydrology_inst%h2osfcflag == 0) then + soilhydrology_inst%h2osfc_thresh_col(c) = 0._r8 ! set to zero for no h2osfc (w/frac_infclust =large) + endif + + ! set decay factor + soilhydrology_inst%hkdepth_col(c) = 1._r8/2.5_r8 + + end do + end associate + + end subroutine SoilhydrologyInitTimeConst + + !----------------------------------------------------------------------- + subroutine initSoilParVIC(c, claycol, sandcol, om_fraccol, soilhydrology_inst) + ! + ! !DESCRIPTION: + ! Convert default CLM soil properties to VIC parameters + ! to be used for runoff simulations (added by M. Huang) + ! + ! !USES: + use clm_varpar, only : nlevsoi, nlayert, nlayer + ! + ! !ARGUMENTS: + integer , intent(in) :: c ! column index + real(r8) , pointer :: sandcol(:,:) ! read in - soil texture: percent sand + real(r8) , pointer :: claycol(:,:) ! read in - soil texture: percent clay + real(r8) , pointer :: om_fraccol(:,:) ! read in - organic matter: kg/m3 + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + + ! !LOCAL VARIABLES: + real(r8) :: om_watsat = 0.9_r8 ! porosity of organic soil + real(r8) :: om_hksat = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_tkm = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K] + real(r8) :: om_sucsat = 10.3_r8 ! saturated suction for organic matter (Letts, 2000) + real(r8) :: om_csol = 2.5_r8 ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986) + real(r8) :: om_tkd = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981) + real(r8) :: om_b = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) + real(r8) :: om_expt = 3._r8+2._r8*2.7_r8 ! soil expt for VIC + real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) + real(r8) :: pc = 0.5_r8 ! percolation threshold + real(r8) :: pcbeta = 0.139_r8 ! percolation exponent + real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s] + real(r8) :: perc_frac ! "percolating" fraction of organic soil + real(r8) :: perc_norm ! normalize to 1 when 100% organic soil + real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil + real(r8) :: uncon_frac ! fraction of "unconnected" soil + real(r8) :: temp_sum_frac ! sum of node fractions in each VIC layer + real(r8) :: sandvic(1:nlayert) ! temporary, weighted averaged sand% for VIC layers + real(r8) :: clayvic(1:nlayert) ! temporary, weighted averaged clay% for VIC layers + real(r8) :: om_fracvic(1:nlayert) ! temporary, weighted averaged organic matter fract for VIC layers + integer :: i, j ! indices + !------------------------------------------------------------------------------------------- + + ! soilhydrology_inst%depth_col(:,:) Output: layer depth of upper layer(m) + ! soilhydrology_inst%vic_clm_fract_col(:,:,:) Output: fraction of VIC layers in CLM layers + ! soilhydrology_inst%c_param_col(:) Output: baseflow exponent (Qb) + ! soilhydrology_inst%expt_col(:,:) Output: pore-size distribution related paramter(Q12) + ! soilhydrology_inst%ksat_col(:,:) Output: Saturated hydrologic conductivity (mm/s) + ! soilhydrology_inst%phi_s_col(:,:) Output: soil moisture dissusion parameter + ! soilhydrology_inst%porosity_col(:,:) Output: soil porosity + ! soilhydrology_inst%max_moist_col(:,:) Output: maximum soil moisture (ice + liq) + + ! map parameters between VIC layers and CLM layers + soilhydrology_inst%c_param_col(c) = 2._r8 + + ! map the CLM layers to VIC layers + do i = 1, nlayer + + sandvic(i) = 0._r8 + clayvic(i) = 0._r8 + om_fracvic(i) = 0._r8 + temp_sum_frac = 0._r8 + do j = 1, nlevsoi + sandvic(i) = sandvic(i) + sandcol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j) + clayvic(i) = clayvic(i) + claycol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j) + om_fracvic(i) = om_fracvic(i) + om_fraccol(c,j) * soilhydrology_inst%vic_clm_fract_col(c,i,j) + temp_sum_frac = temp_sum_frac + soilhydrology_inst%vic_clm_fract_col(c,i,j) + end do + + !average soil properties, M.Huang, 08/11/2010 + sandvic(i) = sandvic(i)/temp_sum_frac + clayvic(i) = clayvic(i)/temp_sum_frac + om_fracvic(i) = om_fracvic(i)/temp_sum_frac + + !make sure sand, clay and om fractions are between 0 and 100% + sandvic(i) = min(100._r8 , sandvic(i)) + clayvic(i) = min(100._r8 , clayvic(i)) + om_fracvic(i) = min(100._r8 , om_fracvic(i)) + sandvic(i) = max(0._r8 , sandvic(i)) + clayvic(i) = max(0._r8 , clayvic(i)) + om_fracvic(i) = max(0._r8 , om_fracvic(i)) + + !calculate other parameters based on teh percentages + soilhydrology_inst%porosity_col(c, i) = 0.489_r8 - 0.00126_r8*sandvic(i) + soilhydrology_inst%expt_col(c, i) = 3._r8+ 2._r8*(2.91_r8 + 0.159_r8*clayvic(i)) + xksat = 0.0070556 *( 10.**(-0.884+0.0153*sandvic(i)) ) + + !consider organic matter, M.Huang + soilhydrology_inst%expt_col(c, i) = & + (1._r8 - om_fracvic(i))*soilhydrology_inst%expt_col(c, i) + om_fracvic(i)*om_expt + soilhydrology_inst%porosity_col(c,i) = & + (1._r8 - om_fracvic(i))*soilhydrology_inst%porosity_col(c,i) + om_watsat*om_fracvic(i) + + ! perc_frac is zero unless perf_frac greater than percolation threshold + if (om_fracvic(i) > pc) then + perc_norm=(1._r8 - pc)**(-pcbeta) + perc_frac=perc_norm*(om_fracvic(i) - pc)**pcbeta + else + perc_frac=0._r8 + endif + ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil + uncon_frac=(1._r8-om_fracvic(i))+(1._r8-perc_frac)*om_fracvic(i) + + ! uncon_hksat is series addition of mineral/organic conductivites + if (om_fracvic(i) < 1._r8) then + uncon_hksat=uncon_frac/((1._r8-om_fracvic(i))/xksat & + +((1._r8-perc_frac)*om_fracvic(i))/om_hksat) + else + uncon_hksat = 0._r8 + end if + + soilhydrology_inst%ksat_col(c,i) = & + uncon_frac*uncon_hksat + (perc_frac*om_fracvic(i))*om_hksat + + soilhydrology_inst%max_moist_col(c,i) = & + soilhydrology_inst%porosity_col(c,i) * soilhydrology_inst%depth_col(c,i) * 1000._r8 !in mm! + + soilhydrology_inst%phi_s_col(c,i) = & + -(exp((1.54_r8 - 0.0095_r8*sandvic(i) + & + 0.0063_r8*(100.0_r8-sandvic(i)-clayvic(i)))*log(10.0_r8))*9.8e-5_r8) + + end do ! end of loop over layers + + end subroutine initSoilParVIC + + !----------------------------------------------------------------------- + subroutine initCLMVICMap(c, soilhydrology_inst) + ! + ! !DESCRIPTION: + ! Calculates mapping between CLM and VIC layers + ! added by AWang, modified by M.Huang for CLM4 + ! NOTE: in CLM h2osoil_liq unit is kg/m2, in VIC moist is mm + ! h2osoi_ice is actually water equavlent ice content. + ! + ! !USES: + use clm_varpar , only : nlevsoi, nlayer + ! + ! !ARGUMENTS: + integer , intent(in) :: c + type(soilhydrology_type), intent(inout) :: soilhydrology_inst + ! + ! !REVISION HISTORY: + ! Created by Maoyi Huang + ! 11/13/2012, Maoyi Huang: rewrite the mapping modules in CLM4VIC + ! + ! !LOCAL VARIABLES + real(r8) :: sum_frac(1:nlayer) ! sum of fraction for each layer + real(r8) :: deltal(1:nlayer+1) ! temporary + real(r8) :: zsum ! temporary + real(r8) :: lsum ! temporary + real(r8) :: temp ! temporary + integer :: i, j, fc + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + depth => soilhydrology_inst%depth_col , & ! Input: [real(r8) (:,:) ] layer depth of VIC (m) + vic_clm_fract => soilhydrology_inst%vic_clm_fract_col & ! Output: [real(r8) (:,:,:) ] fraction of VIC layers in clm layers + ) + + ! set fraction of VIC layer in each CLM layer + + lsum = 0._r8 + do i = 1, nlayer + deltal(i) = depth(c,i) + end do + do i = 1, nlayer + zsum = 0._r8 + sum_frac(i) = 0._r8 + do j = 1, nlevsoi + if( (zsum < lsum) .and. (zsum + dz(c,j) >= lsum )) then + call linear_interp(lsum, temp, zsum, zsum + dz(c,j), 0._r8, 1._r8) + vic_clm_fract(c,i,j) = 1._r8 - temp + if(lsum + deltal(i) < zsum + dz(c,j)) then + call linear_interp(lsum + deltal(i), temp, zsum, zsum + dz(c,j), 1._r8, 0._r8) + vic_clm_fract(c,i,j) = vic_clm_fract(c,i,j) - temp + end if + else if( (zsum < lsum + deltal(i)) .and. (zsum + dz(c,j) >= lsum + deltal(i)) ) then + call linear_interp(lsum + deltal(i), temp, zsum, zsum + dz(c,j), 0._r8, 1._r8) + vic_clm_fract(c,i,j) = temp + if(zsum<=lsum) then + call linear_interp(lsum, temp, zsum, zsum + dz(c,j), 0._r8, 1._r8) + vic_clm_fract(c,i,j) = vic_clm_fract(c,i,j) - temp + end if + else if( (zsum >= lsum .and. zsum + dz(c,j) <= lsum + deltal(i)) ) then + vic_clm_fract(c,i,j) = 1._r8 + else + vic_clm_fract(c,i,j) = 0._r8 + end if + zsum = zsum + dz(c,j) + sum_frac(i) = sum_frac(i) + vic_clm_fract(c,i,j) + end do ! end CLM layer calculation + lsum = lsum + deltal(i) + end do ! end VIC layer calcultion + + end associate + + end subroutine initCLMVICMap + + !------------------------------------------------------------------- + subroutine linear_interp(x,y, x0, x1, y0, y1) + ! + ! !DESCRIPTION: + ! Provides linear interpolation + ! + ! !ARGUMENTS: + real(r8), intent(in) :: x, x0, y0, x1, y1 + real(r8), intent(out) :: y + !------------------------------------------------------------------- + + y = y0 + (x - x0) * (y1 - y0) / (x1 - x0) + + end subroutine linear_interp + +end module SoilHydrologyInitTimeConstMod diff --git a/components/clm/src/biogeophys/SoilHydrologyMod.F90 b/components/clm/src/biogeophys/SoilHydrologyMod.F90 new file mode 100644 index 0000000000..378fcec6f7 --- /dev/null +++ b/components/clm/src/biogeophys/SoilHydrologyMod.F90 @@ -0,0 +1,1467 @@ +module SoilHydrologyMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate soil hydrology + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varctl , only : iulog, use_vichydro + use clm_varcon , only : e_ice, denh2o, denice, rpi + use EnergyFluxType , only : energyflux_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use TemperatureType , only : temperature_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceRunoff ! Calculate surface runoff + public :: Infiltration ! Calculate infiltration into surface soil layer + public :: WaterTable ! Calculate water table before imposing drainage + public :: Drainage ! Calculate subsurface drainage + public :: CLMVICMap + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SurfaceRunoff (bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, waterflux_inst, & + waterstate_inst) + ! + ! !DESCRIPTION: + ! Calculate surface runoff + ! + ! !USES: + use clm_varcon , only : denice, denh2o, wimp, pondmx_urban + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_imperv, icol_road_perv + use clm_varpar , only : nlevsoi, maxpatch_pft + use clm_time_manager, only : get_step_size + use clm_varpar , only : nlayer, nlayert + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,fc,g,l,i !indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: xs(bounds%begc:bounds%endc) !excess soil water above urban ponding limit + real(r8) :: vol_ice(bounds%begc:bounds%endc,1:nlevsoi) !partial volume of ice lens in layer + real(r8) :: fff(bounds%begc:bounds%endc) !decay factor (m-1) + real(r8) :: s1 !variable to calculate qinmax + real(r8) :: su !variable to calculate qinmax + real(r8) :: v !variable to calculate qinmax + real(r8) :: qinmax !maximum infiltration capacity (mm/s) + real(r8) :: A(bounds%begc:bounds%endc) !fraction of the saturated area + real(r8) :: ex(bounds%begc:bounds%endc) !temporary variable (exponent) + real(r8) :: top_moist(bounds%begc:bounds%endc) !temporary, soil moisture in top VIC layers + real(r8) :: top_max_moist(bounds%begc:bounds%endc) !temporary, maximum soil moisture in top VIC layers + real(r8) :: top_ice(bounds%begc:bounds%endc) !temporary, ice len in top VIC layers + character(len=32) :: subname = 'SurfaceRunoff' !subroutine name + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] minus number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + wtfact => soilstate_inst%wtfact_col , & ! Input: [real(r8) (:) ] maximum saturated fraction for a gridcell + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + + qflx_snow_h2osfc => waterflux_inst%qflx_snow_h2osfc_col , & ! Input: [real(r8) (:) ] snow falling on surface water (mm/s) + qflx_floodc => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column flux of flood water from RTM + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_top_soil => waterflux_inst%qflx_top_soil_col , & ! Output: [real(r8) (:) ] net water input into soil from top (mm/s) + qflx_surf => waterflux_inst%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) + + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + max_moist => soilhydrology_inst%max_moist_col , & ! Input: [real(r8) (:,:) ] maximum soil moisture (ice + liq, mm) + frost_table => soilhydrology_inst%frost_table_col , & ! Input: [real(r8) (:) ] frost table depth (m) + zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) + b_infil => soilhydrology_inst%b_infil_col , & ! Input: [real(r8) (:) ] VIC b infiltration parameter + moist => soilhydrology_inst%moist_col , & ! Input: [real(r8) (:,:) ] soil moisture in each VIC layers (liq, mm) + hkdepth => soilhydrology_inst%hkdepth_col , & ! Input: [real(r8) (:) ] decay factor (m) + origflag => soilhydrology_inst%origflag , & ! Input: logical + fcov => soilhydrology_inst%fcov_col , & ! Output: [real(r8) (:) ] fractional impermeable area + fsat => soilhydrology_inst%fsat_col , & ! Output: [real(r8) (:) ] fractional area with water table at surface + fracice => soilhydrology_inst%fracice_col , & ! Output: [real(r8) (:,:) ] fractional impermeability (-) + icefrac => soilhydrology_inst%icefrac_col , & ! Output: [real(r8) (:,:) ] + ice => soilhydrology_inst%ice_col , & ! Output: [real(r8) (:,:) ] ice len in each VIC layers(ice, mm) + max_infil => soilhydrology_inst%max_infil_col , & ! Output: [real(r8) (:) ] maximum infiltration capacity in VIC (mm) + i_0 => soilhydrology_inst%i_0_col & ! Output: [real(r8) (:) ] column average soil moisture in top VIC layers (mm) + ) + + ! Get time step + + dtime = get_step_size() + + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Porosity of soil, partial volume of ice and liquid, fraction of ice in each layer, + ! fractional impermeability + + vol_ice(c,j) = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + if (origflag == 1) then + icefrac(c,j) = min(1._r8,h2osoi_ice(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j))) + else + icefrac(c,j) = min(1._r8,vol_ice(c,j)/watsat(c,j)) + endif + + fracice(c,j) = max(0._r8,exp(-3._r8*(1._r8-icefrac(c,j)))- exp(-3._r8))/(1.0_r8-exp(-3._r8)) + end do + end do + + ! Saturated fraction + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + fff(c) = 0.5_r8 + if (use_vichydro) then + top_moist(c) = 0._r8 + top_ice(c) = 0._r8 + top_max_moist(c) = 0._r8 + do j = 1, nlayer - 1 + top_ice(c) = top_ice(c) + ice(c,j) + top_moist(c) = top_moist(c) + moist(c,j) + ice(c,j) + top_max_moist(c) = top_max_moist(c) + max_moist(c,j) + end do + if(top_moist(c)> top_max_moist(c)) top_moist(c)= top_max_moist(c) + top_ice(c) = max(0._r8,top_ice(c)) + max_infil(c) = (1._r8+b_infil(c)) * top_max_moist(c) + ex(c) = b_infil(c) / (1._r8 + b_infil(c)) + A(c) = 1._r8 - (1._r8 - top_moist(c) / top_max_moist(c))**ex(c) + i_0(c) = max_infil(c) * (1._r8 - (1._r8 - A(c))**(1._r8/b_infil(c))) + fsat(c) = A(c) !for output + else + fsat(c) = wtfact(c) * exp(-0.5_r8*fff(c)*zwt(c)) + end if + + ! use perched water table to determine fsat (if present) + if ( frost_table(c) > zwt(c)) then + if (use_vichydro) then + fsat(c) = A(c) + else + fsat(c) = wtfact(c) * exp(-0.5_r8*fff(c)*zwt(c)) + end if + else + if ( frost_table(c) > zwt_perched(c)) then + fsat(c) = wtfact(c) * exp(-0.5_r8*fff(c)*zwt_perched(c))!*( frost_table(c) - zwt_perched(c))/4.0 + endif + endif + if (origflag == 1) then + if (use_vichydro) then + call endrun(msg="VICHYDRO is not available for origflag=1"//errmsg(__FILE__, __LINE__)) + else + fcov(c) = (1._r8 - fracice(c,1)) * fsat(c) + fracice(c,1) + end if + else + fcov(c) = fsat(c) + endif + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! assume qinmax large relative to qflx_top_soil in control + if (origflag == 1) then + qflx_surf(c) = fcov(c) * qflx_top_soil(c) + else + ! only send fast runoff directly to streams + qflx_surf(c) = fsat(c) * qflx_top_soil(c) + endif + end do + + ! Determine water in excess of ponding limit for urban roof and impervious road. + ! Excess goes to surface runoff. No surface runoff for sunwall and shadewall. + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then + + ! If there are snow layers then all qflx_top_soil goes to surface runoff + if (snl(c) < 0) then + qflx_surf(c) = max(0._r8,qflx_top_soil(c)) + else + xs(c) = max(0._r8, & + h2osoi_liq(c,1)/dtime + qflx_top_soil(c) - qflx_evap_grnd(c) - & + pondmx_urban/dtime) + if (xs(c) > 0.) then + h2osoi_liq(c,1) = pondmx_urban + else + h2osoi_liq(c,1) = max(0._r8,h2osoi_liq(c,1)+ & + (qflx_top_soil(c)-qflx_evap_grnd(c))*dtime) + end if + qflx_surf(c) = xs(c) + end if + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then + qflx_surf(c) = 0._r8 + end if + ! send flood water flux to runoff for all urban columns + qflx_surf(c) = qflx_surf(c) + qflx_floodc(c) + + end do + + ! remove stormflow and snow on h2osfc from qflx_top_soil + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + ! add flood water flux to qflx_top_soil + qflx_top_soil(c) = qflx_top_soil(c) + qflx_snow_h2osfc(c) + qflx_floodc(c) + end do + + end associate + + end subroutine SurfaceRunoff + + !----------------------------------------------------------------------- + subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + energyflux_inst, soilhydrology_inst, soilstate_inst, temperature_inst, & + waterflux_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Calculate infiltration into surface soil layer (minus the evaporation) + ! + ! !USES: + use shr_const_mod , only : shr_const_pi + use clm_varpar , only : nlayer, nlayert + use clm_varpar , only : nlevsoi + use clm_varcon , only : denh2o, denice, roverg, wimp, pc, mu, tfrz + use column_varcon , only : icol_roof, icol_road_imperv, icol_sunwall, icol_shadewall, icol_road_perv + use landunit_varcon , only : istsoil, istcrop + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(energyflux_type) , intent(in) :: energyflux_inst + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,l,fc ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: s1,su,v ! variable to calculate qinmax + real(r8) :: qinmax ! maximum infiltration capacity (mm/s) + real(r8) :: vol_ice(bounds%begc:bounds%endc,1:nlevsoi) ! partial volume of ice lens in layer + real(r8) :: alpha_evap(bounds%begc:bounds%endc) ! fraction of total evap from h2osfc + real(r8) :: qflx_evap(bounds%begc:bounds%endc) ! local evaporation array + real(r8) :: qflx_h2osfc_drain(bounds%begc:bounds%endc) ! bottom drainage from h2osfc + real(r8) :: qflx_in_h2osfc(bounds%begc:bounds%endc) ! surface input to h2osfc + real(r8) :: qflx_in_soil(bounds%begc:bounds%endc) ! surface input to soil + real(r8) :: qflx_infl_excess(bounds%begc:bounds%endc) ! infiltration excess runoff -> h2osfc + real(r8) :: frac_infclust ! fraction of submerged area that is connected + real(r8) :: fsno ! copy of frac_sno + real(r8) :: k_wet ! linear reservoir coefficient for h2osfc + real(r8) :: fac ! soil wetness of surface layer + real(r8) :: psit ! negative potential of soil + real(r8) :: hr ! relative humidity + real(r8) :: wx ! partial volume of ice and water of surface layer + real(r8) :: z_avg + real(r8) :: rho_avg + real(r8) :: fmelt + real(r8) :: f_sno + real(r8) :: imped + real(r8) :: d + real(r8) :: h2osoi_vol + real(r8) :: basis ! temporary, variable soil moisture holding capacity + ! in top VIC layers for runoff calculation + real(r8) :: rsurf_vic ! temp VIC surface runoff + real(r8) :: top_moist(bounds%begc:bounds%endc) ! temporary, soil moisture in top VIC layers + real(r8) :: top_max_moist(bounds%begc:bounds%endc) ! temporary, maximum soil moisture in top VIC layers + real(r8) :: top_ice(bounds%begc:bounds%endc) ! temporary, ice len in top VIC layers + real(r8) :: top_icefrac ! temporary, ice fraction in top VIC layers + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] minus number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + h2osfc => waterstate_inst%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) + + qflx_ev_soil => waterflux_inst%qflx_ev_soil_col , & ! Input: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_evap_soi => waterflux_inst%qflx_evap_soi_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_evap_grnd => waterflux_inst%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_top_soil => waterflux_inst%qflx_top_soil_col , & ! Input: [real(r8) (:) ] net water input into soil from top (mm/s) + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_col , & ! Input: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + qflx_surf => waterflux_inst%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_h2osfc_surf => waterflux_inst%qflx_h2osfc_surf_col , & ! Output: [real(r8) (:) ] surface water runoff (mm/s) + qflx_infl => waterflux_inst%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) + + smpmin => soilstate_inst%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Output: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + + h2osfc_thresh => soilhydrology_inst%h2osfc_thresh_col, & ! Input: [real(r8) (:) ] level at which h2osfc "percolates" + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) + fcov => soilhydrology_inst%fcov_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + b_infil => soilhydrology_inst%b_infil_col , & ! Input: [real(r8) (:) ] VIC b infiltration parameter + frost_table => soilhydrology_inst%frost_table_col , & ! Input: [real(r8) (:) ] frost table depth (m) + fsat => soilhydrology_inst%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + moist => soilhydrology_inst%moist_col , & ! Input: [real(r8) (:,:) ] soil moisture in each VIC layers (liq, mm) + max_moist => soilhydrology_inst%max_moist_col , & ! Input: [real(r8) (:,:) ] maximum soil moisture (ice + liq, mm) + max_infil => soilhydrology_inst%max_infil_col , & ! Input: [real(r8) (:) ] maximum infiltration capacity in VIC (mm) + ice => soilhydrology_inst%ice_col , & ! Input: [real(r8) (:,:) ] ice len in each VIC layers(ice, mm) + i_0 => soilhydrology_inst%i_0_col , & ! Input: [real(r8) (:) ] column average soil moisture in top VIC layers (mm) + h2osfcflag => soilhydrology_inst%h2osfcflag , & ! Input: logical + icefrac => soilhydrology_inst%icefrac_col & ! Output: [real(r8) (:,:) ] fraction of ice + ) + + dtime = get_step_size() + + ! Infiltration into surface soil layer (minus the evaporation) + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + ! Porosity of soil, partial volume of ice and liquid + vol_ice(c,j) = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity(c,j) = max(0.01_r8,watsat(c,j)-vol_ice(c,j)) + icefrac(c,j) = min(1._r8,vol_ice(c,j)/watsat(c,j)) + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + ! partition moisture fluxes between soil and h2osfc + if (lun%itype(col%landunit(c)) == istsoil .or. lun%itype(col%landunit(c))==istcrop) then + + ! explicitly use frac_sno=0 if snl=0 + if (snl(c) >= 0) then + fsno=0._r8 + ! if no snow layers, sublimation is removed from h2osoi_ice in drainage + qflx_evap(c)=qflx_evap_grnd(c) + else + fsno=frac_sno(c) + qflx_evap(c)=qflx_ev_soil(c) + endif + + !1. partition surface inputs between soil and h2osfc + qflx_in_soil(c) = (1._r8 - frac_h2osfc(c)) * (qflx_top_soil(c) - qflx_surf(c)) + qflx_in_h2osfc(c) = frac_h2osfc(c) * (qflx_top_soil(c) - qflx_surf(c)) + + !2. remove evaporation (snow treated in SnowHydrology) + qflx_in_soil(c) = qflx_in_soil(c) - (1.0_r8 - fsno - frac_h2osfc(c))*qflx_evap(c) + qflx_in_h2osfc(c) = qflx_in_h2osfc(c) - frac_h2osfc(c) * qflx_ev_h2osfc(c) + + !3. determine maximum infiltration rate + if (use_vichydro) then + top_moist(c)= 0._r8 + top_ice(c)=0._r8 + top_max_moist(c)= 0._r8 + do j = 1, nlayer - 1 + top_ice(c) = top_ice(c) + ice(c,j) + top_moist(c) = top_moist(c) + moist(c,j) + ice(c,j) + top_max_moist(c) = top_max_moist(c) + max_moist(c,j) + end do + top_icefrac = min(1._r8,top_ice(c)/top_max_moist(c)) + if(qflx_in_soil(c) <= 0._r8) then + rsurf_vic = 0._r8 + else if(max_infil(c) <= 0._r8) then + rsurf_vic = qflx_in_soil(c) + else if((i_0(c) + qflx_in_soil(c)*dtime) > max_infil(c)) then !(Eq.(3a) Wood et al. 1992) + rsurf_vic = (qflx_in_soil(c)*dtime - top_max_moist(c) + top_moist(c))/dtime + else !(Eq.(3b) Wood et al. 1992) + basis = 1._r8 - (i_0(c) + qflx_in_soil(c)*dtime)/max_infil(c) + rsurf_vic = (qflx_in_soil(c)*dtime - top_max_moist(c) + top_moist(c) & + + top_max_moist(c) * basis**(1._r8 + b_infil(c)))/dtime + end if + rsurf_vic = min(qflx_in_soil(c), rsurf_vic) + qinmax = (1._r8 - fsat(c)) * 10._r8**(-e_ice*top_icefrac)*(qflx_in_soil(c) - rsurf_vic) + else + qinmax=(1._r8 - fsat(c)) * minval(10._r8**(-e_ice*(icefrac(c,1:3)))*hksat(c,1:3)) + end if + qflx_infl_excess(c) = max(0._r8,qflx_in_soil(c) - (1.0_r8 - frac_h2osfc(c))*qinmax) + + !4. soil infiltration and h2osfc "run-on" + qflx_infl(c) = qflx_in_soil(c) - qflx_infl_excess(c) + qflx_in_h2osfc(c) = qflx_in_h2osfc(c) + qflx_infl_excess(c) + + !5. surface runoff from h2osfc + if (h2osfcflag==1) then + ! calculate runoff from h2osfc ------------------------------------- + if (frac_h2osfc(c) <= pc) then + frac_infclust=0.0_r8 + else + frac_infclust=(frac_h2osfc(c)-pc)**mu + endif + endif + + ! limit runoff to value of storage above S(pc) + if(h2osfc(c) >= h2osfc_thresh(c) .and. h2osfcflag/=0) then + ! spatially variable k_wet + k_wet=1.0_r8 * sin((rpi/180.) * col%topo_slope(c)) + qflx_h2osfc_surf(c) = k_wet * frac_infclust * (h2osfc(c) - h2osfc_thresh(c)) + + qflx_h2osfc_surf(c)=min(qflx_h2osfc_surf(c),(h2osfc(c) - h2osfc_thresh(c))/dtime) + else + qflx_h2osfc_surf(c)= 0._r8 + endif + + ! cutoff lower limit + if ( qflx_h2osfc_surf(c) < 1.0e-8) qflx_h2osfc_surf(c) = 0._r8 + + ! use this for non-h2osfc code + if(h2osfcflag==0) then + qflx_h2osfc_surf(c)= 0._r8 + ! shift infiltration excess from h2osfc input to surface runoff + qflx_in_h2osfc(c) = qflx_in_h2osfc(c) - qflx_infl_excess(c) + qflx_surf(c)= qflx_surf(c) + qflx_infl_excess(c) + qflx_infl_excess(c) = 0._r8 + endif + + qflx_in_h2osfc(c) = qflx_in_h2osfc(c) - qflx_h2osfc_surf(c) + + !6. update h2osfc prior to calculating bottom drainage from h2osfc + h2osfc(c) = h2osfc(c) + qflx_in_h2osfc(c) * dtime + + !-- if all water evaporates, there will be no bottom drainage + if (h2osfc(c) < 0.0) then + qflx_infl(c) = qflx_infl(c) + h2osfc(c)/dtime + h2osfc(c) = 0.0 + qflx_h2osfc_drain(c)= 0._r8 + else + qflx_h2osfc_drain(c)=min(frac_h2osfc(c)*qinmax,h2osfc(c)/dtime) + endif + + if(h2osfcflag==0) then + qflx_h2osfc_drain(c)= max(0._r8,h2osfc(c)/dtime) !ensure no h2osfc + endif + + !7. remove drainage from h2osfc and add to qflx_infl + h2osfc(c) = h2osfc(c) - qflx_h2osfc_drain(c) * dtime + qflx_infl(c) = qflx_infl(c) + qflx_h2osfc_drain(c) + else + ! non-vegetated landunits (i.e. urban) use original CLM4 code + if (snl(c) >= 0) then + ! when no snow present, sublimation is removed in Drainage + qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) - qflx_evap_grnd(c) + else + qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) & + - (1.0_r8 - frac_sno(c)) * qflx_ev_soil(c) + end if + qflx_h2osfc_surf(c) = 0._r8 + endif + + enddo + + ! No infiltration for impervious urban surfaces + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (col%itype(c) /= icol_road_perv) then + qflx_infl(c) = 0._r8 + end if + end do + + end associate + + end subroutine Infiltration + + !----------------------------------------------------------------------- + subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + soilhydrology_inst, soilstate_inst, temperature_inst, waterstate_inst, waterflux_inst) + ! + ! !DESCRIPTION: + ! Calculate watertable, considering aquifer recharge but no drainage. + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varcon , only : pondmx, tfrz, watmin,denice,denh2o + use clm_varpar , only : nlevsoi + use column_varcon , only : icol_roof, icol_road_imperv + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,fc,i ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: xs(bounds%begc:bounds%endc) ! water needed to bring soil moisture to watmin (mm) + real(r8) :: dzmm(bounds%begc:bounds%endc,1:nlevsoi) ! layer thickness (mm) + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + real(r8) :: rsub_bot(bounds%begc:bounds%endc) ! subsurface runoff - bottom drainage (mm/s) + real(r8) :: rsub_top(bounds%begc:bounds%endc) ! subsurface runoff - topographic control (mm/s) + real(r8) :: fff(bounds%begc:bounds%endc) ! decay factor (m-1) + real(r8) :: xsi(bounds%begc:bounds%endc) ! excess soil water above saturation at layer i (mm) + real(r8) :: rous ! aquifer yield (-) + real(r8) :: wh ! smpfz(jwt)-z(jwt) (mm) + real(r8) :: ws ! summation of pore space of layers below water table (mm) + real(r8) :: s_node ! soil wetness (-) + real(r8) :: dzsum ! summation of dzmm of layers below water table (mm) + real(r8) :: icefracsum ! summation of icefrac*dzmm of layers below water table (-) + real(r8) :: fracice_rsub(bounds%begc:bounds%endc) ! fractional impermeability of soil layers (-) + real(r8) :: ka ! hydraulic conductivity of the aquifer (mm/s) + real(r8) :: dza ! fff*(zwt-z(jwt)) (-) + real(r8) :: available_h2osoi_liq ! available soil liquid water in a layer + real(r8) :: imped + real(r8) :: rsub_top_tot + real(r8) :: rsub_top_layer + real(r8) :: qcharge_tot + real(r8) :: qcharge_layer + real(r8) :: theta_unsat + real(r8) :: f_unsat + real(r8) :: s_y + integer :: k,k_frz,k_perch + real(r8) :: sat_lev + real(r8) :: s1 + real(r8) :: s2 + real(r8) :: m + real(r8) :: b + real(r8) :: q_perch + real(r8) :: q_perch_max + real(r8) :: dflag=0._r8 + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] + + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_col , & ! Input: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_dew_snow => waterflux_inst%qflx_dew_snow_col , & ! Input: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + + zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) + zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Output: [real(r8) (:) ] perched water table depth (m) + frost_table => soilhydrology_inst%frost_table_col , & ! Output: [real(r8) (:) ] frost table depth (m) + wa => soilhydrology_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + qcharge => soilhydrology_inst%qcharge_col , & ! Input: [real(r8) (:) ] aquifer recharge rate (mm/s) + origflag => soilhydrology_inst%origflag , & ! Input: logical + + qflx_sub_snow => waterflux_inst%qflx_sub_snow_col , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_drain => waterflux_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] perched wt sub-surface runoff (mm H2O /s) + qflx_rsub_sat => waterflux_inst%qflx_rsub_sat_col & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] + ) + + ! Get time step + + dtime = get_step_size() + + ! Convert layer thicknesses from m to mm + + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + dzmm(c,j) = dz(c,j)*1.e3_r8 + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_drain(c) = 0._r8 + qflx_rsub_sat(c) = 0._r8 + qflx_drain_perched(c) = 0._r8 + end do + + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + end do + + !============================== QCHARGE ========================================= + ! Water table changes due to qcharge + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + !scs: use analytical expression for aquifer specific yield + rous = watsat(c,nlevsoi) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,nlevsoi))**(-1./bsw(c,nlevsoi))) + rous=max(rous,0.02_r8) + + !-- water table is below the soil column -------------------------------------- + if(jwt(c) == nlevsoi) then + wa(c) = wa(c) + qcharge(c) * dtime + zwt(c) = zwt(c) - (qcharge(c) * dtime)/1000._r8/rous + else + !-- water table within soil layers 1-9 ------------------------------------- + ! try to raise water table to account for qcharge + qcharge_tot = qcharge(c) * dtime + if(qcharge_tot > 0.) then !rising water table + do j = jwt(c)+1, 1,-1 + !scs: use analytical expression for specific yield + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + + qcharge_layer=min(qcharge_tot,(s_y*(zwt(c) - zi(c,j-1))*1.e3)) + qcharge_layer=max(qcharge_layer,0._r8) + + if(s_y > 0._r8) zwt(c) = zwt(c) - qcharge_layer/s_y/1000._r8 + + qcharge_tot = qcharge_tot - qcharge_layer + if (qcharge_tot <= 0.) exit + enddo + else ! deepening water table (negative qcharge) + do j = jwt(c)+1, nlevsoi + !scs: use analytical expression for specific yield + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + + qcharge_layer=max(qcharge_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) + qcharge_layer=min(qcharge_layer,0._r8) + qcharge_tot = qcharge_tot - qcharge_layer + if (qcharge_tot >= 0.) then + zwt(c) = zwt(c) - qcharge_layer/s_y/1000._r8 + exit + else + zwt(c) = zi(c,j) + endif + + enddo + if (qcharge_tot > 0.) zwt(c) = zwt(c) - qcharge_tot/1000._r8/rous + endif + + !-- recompute jwt for following calculations --------------------------------- + ! allow jwt to equal zero when zwt is in top layer + jwt(c) = nlevsoi + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + endif + enddo + + + !== BASEFLOW ================================================== + ! perched water table code + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! define frost table as first frozen layer with unfrozen layer above it + if(t_soisno(c,1) > tfrz) then + k_frz=nlevsoi + else + k_frz=1 + endif + + do k=2, nlevsoi + if (t_soisno(c,k-1) > tfrz .and. t_soisno(c,k) <= tfrz) then + k_frz=k + exit + endif + enddo + + frost_table(c)=z(c,k_frz) + + ! initialize perched water table to frost table, and qflx_drain_perched(c) to zero + zwt_perched(c)=frost_table(c) + + !=================== water table above frost table ============================= + ! if water table is above frost table, do not use topmodel baseflow formulation + if (zwt(c) < frost_table(c) .and. t_soisno(c,k_frz) <= tfrz & + .and. origflag == 0) then + else + !=================== water table below frost table ============================= + !-- compute possible perched water table *and* groundwater table afterwards + ! locate perched water table from bottom up starting at frost table + ! sat_lev is an arbitrary saturation level used to determine perched water table + sat_lev=0.9 + + k_perch=1 + do k=k_frz,1,-1 + h2osoi_vol(c,k) = h2osoi_liq(c,k)/(dz(c,k)*denh2o) & + + h2osoi_ice(c,k)/(dz(c,k)*denice) + + if (h2osoi_vol(c,k)/watsat(c,k) <= sat_lev) then + k_perch=k + exit + endif + enddo + + ! if frost_table = nlevsoi, only compute perched water table if frozen + if (t_soisno(c,k_frz) > tfrz) k_perch=k_frz + + ! if perched water table exists + if (k_frz > k_perch) then + ! interpolate between k_perch and k_perch+1 to find perched water table height + s1 = (h2osoi_liq(c,k_perch)/(dz(c,k_perch)*denh2o) & + + h2osoi_ice(c,k_perch)/(dz(c,k_perch)*denice))/watsat(c,k_perch) + s2 = (h2osoi_liq(c,k_perch+1)/(dz(c,k_perch+1)*denh2o) & + + h2osoi_ice(c,k_perch+1)/(dz(c,k_perch+1)*denice))/watsat(c,k_perch+1) + + m=(z(c,k_perch+1)-z(c,k_perch))/(s2-s1) + b=z(c,k_perch+1)-m*s2 + zwt_perched(c)=max(0._r8,m*sat_lev+b) + + endif !k_frz > k_perch + endif + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Renew the ice and liquid mass due to condensation + + if (snl(c)+1 >= 1) then + + ! make consistent with how evap_grnd removed in infiltration + h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_dew_grnd(c) * dtime + h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_dew_snow(c) * dtime + if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then + qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime + h2osoi_ice(c,1) = 0._r8 + else + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_sub_snow(c) * dtime + end if + end if + end do + + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + ! Renew the ice and liquid mass due to condensation for urban roof and impervious road + + if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then + if (snl(c)+1 >= 1) then + h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_dew_grnd(c) * dtime + h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_dew_snow(c) * dtime) + if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then + qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime + h2osoi_ice(c,1) = 0._r8 + else + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_sub_snow(c) * dtime) + end if + end if + end if + + end do + + end associate + + end subroutine WaterTable + + !----------------------------------------------------------------------- + subroutine Drainage(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + temperature_inst, soilhydrology_inst, soilstate_inst, waterstate_inst, waterflux_inst) + ! + ! !DESCRIPTION: + ! Calculate subsurface drainage + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevsoi, nlevgrnd, nlayer, nlayert + use clm_varcon , only : pondmx, tfrz, watmin,rpi, secspday, nlvic + use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(temperature_type) , intent(in) :: temperature_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'Drainage' ! subroutine name + integer :: c,j,fc,i ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: xs(bounds%begc:bounds%endc) ! water needed to bring soil moisture to watmin (mm) + real(r8) :: dzmm(bounds%begc:bounds%endc,1:nlevsoi) ! layer thickness (mm) + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + real(r8) :: rsub_bot(bounds%begc:bounds%endc) ! subsurface runoff - bottom drainage (mm/s) + real(r8) :: rsub_top(bounds%begc:bounds%endc) ! subsurface runoff - topographic control (mm/s) + real(r8) :: fff(bounds%begc:bounds%endc) ! decay factor (m-1) + real(r8) :: xsi(bounds%begc:bounds%endc) ! excess soil water above saturation at layer i (mm) + real(r8) :: xsia(bounds%begc:bounds%endc) ! available pore space at layer i (mm) + real(r8) :: xs1(bounds%begc:bounds%endc) ! excess soil water above saturation at layer 1 (mm) + real(r8) :: smpfz(1:nlevsoi) ! matric potential of layer right above water table (mm) + real(r8) :: wtsub ! summation of hk*dzmm for layers below water table (mm**2/s) + real(r8) :: rous ! aquifer yield (-) + real(r8) :: wh ! smpfz(jwt)-z(jwt) (mm) + real(r8) :: wh_zwt ! water head at the water table depth (mm) + real(r8) :: ws ! summation of pore space of layers below water table (mm) + real(r8) :: s_node ! soil wetness (-) + real(r8) :: dzsum ! summation of dzmm of layers below water table (mm) + real(r8) :: icefracsum ! summation of icefrac*dzmm of layers below water table (-) + real(r8) :: fracice_rsub(bounds%begc:bounds%endc) ! fractional impermeability of soil layers (-) + real(r8) :: ka ! hydraulic conductivity of the aquifer (mm/s) + real(r8) :: dza ! fff*(zwt-z(jwt)) (-) + real(r8) :: available_h2osoi_liq ! available soil liquid water in a layer + real(r8) :: rsub_top_max + real(r8) :: h2osoi_vol + real(r8) :: imped + real(r8) :: rsub_top_tot + real(r8) :: rsub_top_layer + real(r8) :: qcharge_tot + real(r8) :: qcharge_layer + real(r8) :: theta_unsat + real(r8) :: f_unsat + real(r8) :: s_y + integer :: k,k_frz,k_perch + real(r8) :: sat_lev + real(r8) :: s1 + real(r8) :: s2 + real(r8) :: m + real(r8) :: b + real(r8) :: q_perch + real(r8) :: q_perch_max + real(r8) :: vol_ice + real(r8) :: dsmax_tmp(bounds%begc:bounds%endc) ! temporary variable for ARNO subsurface runoff calculation + real(r8) :: rsub_tmp ! temporary variable for ARNO subsurface runoff calculation + real(r8) :: frac ! temporary variable for ARNO subsurface runoff calculation + real(r8) :: rel_moist ! relative moisture, temporary variable + real(r8) :: wtsub_vic ! summation of hk*dzmm for layers in the third VIC layer + !----------------------------------------------------------------------- + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + hk_l => soilstate_inst%hk_l_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity (mm/s) + + depth => soilhydrology_inst%depth_col , & ! Input: [real(r8) (:,:) ] VIC soil depth + c_param => soilhydrology_inst%c_param_col , & ! Input: [real(r8) (:) ] baseflow exponent (Qb) + Dsmax => soilhydrology_inst%dsmax_col , & ! Input: [real(r8) (:) ] max. velocity of baseflow (mm/day) + max_moist => soilhydrology_inst%max_moist_col , & ! Input: [real(r8) (:,:) ] maximum soil moisture (ice + liq) + moist => soilhydrology_inst%moist_col , & ! Input: [real(r8) (:,:) ] soil layer moisture (mm) + Ds => soilhydrology_inst%ds_col , & ! Input: [real(r8) (:) ] fracton of Dsmax where non-linear baseflow begins + Wsvic => soilhydrology_inst%Wsvic_col , & ! Input: [real(r8) (:) ] fraction of maximum soil moisutre where non-liear base flow occurs + icefrac => soilhydrology_inst%icefrac_col , & ! Output: [real(r8) (:,:) ] fraction of ice in layer + hkdepth => soilhydrology_inst%hkdepth_col , & ! Input: [real(r8) (:) ] decay factor (m) + frost_table => soilhydrology_inst%frost_table_col , & ! Input: [real(r8) (:) ] frost table depth (m) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zwt_perched => soilhydrology_inst%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) + wa => soilhydrology_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) + ice => soilhydrology_inst%ice_col , & ! Input: [real(r8) (:,:) ] soil layer moisture (mm) + qcharge => soilhydrology_inst%qcharge_col , & ! Input: [real(r8) (:) ] aquifer recharge rate (mm/s) + origflag => soilhydrology_inst%origflag , & ! Input: logical + h2osfcflag => soilhydrology_inst%h2osfcflag , & ! Input: logical + + qflx_snwcp_liq => waterflux_inst%qflx_snwcp_liq_col , & ! Output: [real(r8) (:) ] excess rainfall due to snow capping (mm H2O /s) [+] + qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Output: [real(r8) (:) ] excess snowfall due to snow capping (mm H2O /s) [+] + qflx_dew_grnd => waterflux_inst%qflx_dew_grnd_col , & ! Output: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_dew_snow => waterflux_inst%qflx_dew_snow_col , & ! Output: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s) [+] + qflx_sub_snow => waterflux_inst%qflx_sub_snow_col , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) [+] + qflx_drain => waterflux_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_qrgwl => waterflux_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes (mm H2O /s) + qflx_rsub_sat => waterflux_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] + qflx_drain_perched => waterflux_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] perched wt sub-surface runoff (mm H2O /s) + + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + ) + + ! Get time step + + dtime = get_step_size() + + ! Convert layer thicknesses from m to mm + + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + dzmm(c,j) = dz(c,j)*1.e3_r8 + + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + icefrac(c,j) = min(1._r8,vol_ice/watsat(c,j)) + end do + end do + + ! Initial set + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_drain(c) = 0._r8 + rsub_bot(c) = 0._r8 + qflx_rsub_sat(c) = 0._r8 + rsub_top(c) = 0._r8 + fracice_rsub(c) = 0._r8 + end do + + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + end do + + rous = 0.2_r8 + + !== BASEFLOW ================================================== + ! perched water table code + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! specify maximum drainage rate + q_perch_max = 1.e-5_r8 * sin(col%topo_slope(c) * (rpi/180._r8)) + + ! if layer containing water table is frozen, compute the following: + ! frost table, perched water table, and drainage from perched saturated layer + + ! define frost table as first frozen layer with unfrozen layer above it + if(t_soisno(c,1) > tfrz) then + k_frz=nlevsoi + else + k_frz=1 + endif + + do k=2, nlevsoi + if (t_soisno(c,k-1) > tfrz .and. t_soisno(c,k) <= tfrz) then + k_frz=k + exit + endif + enddo + + frost_table(c)=z(c,k_frz) + + ! initialize perched water table to frost table, and qflx_drain_perched(c) to zero + zwt_perched(c)=frost_table(c) + qflx_drain_perched(c) = 0._r8 + + !=================== water table above frost table ============================= + ! if water table is above frost table, do not use topmodel baseflow formulation + + if (zwt(c) < frost_table(c) .and. t_soisno(c,k_frz) <= tfrz & + .and. origflag == 0) then + ! compute drainage from perched saturated region + wtsub = 0._r8 + q_perch = 0._r8 + do k = jwt(c)+1, k_frz + imped=10._r8**(-e_ice*(0.5_r8*(icefrac(c,k)+icefrac(c,min(nlevsoi, k+1))))) + q_perch = q_perch + imped*hksat(c,k)*dzmm(c,k) + wtsub = wtsub + dzmm(c,k) + end do + if (wtsub > 0._r8) q_perch = q_perch/wtsub + + qflx_drain_perched(c) = q_perch_max * q_perch & + *(frost_table(c) - zwt(c)) + + ! remove drainage from perched saturated layers + rsub_top_tot = - qflx_drain_perched(c) * dtime + do k = jwt(c)+1, k_frz + rsub_top_layer=max(rsub_top_tot,-(h2osoi_liq(c,k)-watmin)) + rsub_top_layer=min(rsub_top_layer,0._r8) + rsub_top_tot = rsub_top_tot - rsub_top_layer + + h2osoi_liq(c,k) = h2osoi_liq(c,k) + rsub_top_layer + + if (rsub_top_tot >= 0.) then + zwt(c) = zwt(c) - rsub_top_layer/eff_porosity(c,k)/1000._r8 + exit + else + zwt(c) = zi(c,k) + endif + enddo + + ! if rsub_top_tot is greater than available water (above frost table), + ! then decrease qflx_drain_perched by residual amount for water balance + qflx_drain_perched(c) = qflx_drain_perched(c) + rsub_top_tot/dtime + + !-- recompute jwt --------------------------------------------------------- + ! allow jwt to equal zero when zwt is in top layer + jwt(c) = nlevsoi + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + else + !=================== water table below frost table ============================= + !-- compute possible perched water table *and* groundwater table afterwards + ! locate perched water table from bottom up starting at frost table + ! sat_lev is an arbitrary saturation level used to determine perched water table + sat_lev=0.9 + + k_perch=1 + do k=k_frz,1,-1 + h2osoi_vol = h2osoi_liq(c,k)/(dz(c,k)*denh2o) & + + h2osoi_ice(c,k)/(dz(c,k)*denice) + + if (h2osoi_vol/watsat(c,k) <= sat_lev) then + k_perch=k + exit + endif + enddo + + ! if frost_table = nlevsoi, only compute perched water table if frozen + if (t_soisno(c,k_frz) > tfrz) k_perch=k_frz + + ! if perched water table exists + if (k_frz > k_perch) then + ! interpolate between k_perch and k_perch+1 to find perched water table height + s1 = (h2osoi_liq(c,k_perch)/(dz(c,k_perch)*denh2o) & + + h2osoi_ice(c,k_perch)/(dz(c,k_perch)*denice))/watsat(c,k_perch) + s2 = (h2osoi_liq(c,k_perch+1)/(dz(c,k_perch+1)*denh2o) & + + h2osoi_ice(c,k_perch+1)/(dz(c,k_perch+1)*denice))/watsat(c,k_perch+1) + + m=(z(c,k_perch+1)-z(c,k_perch))/(s2-s1) + b=z(c,k_perch+1)-m*s2 + zwt_perched(c)=max(0._r8,m*sat_lev+b) + + ! compute drainage from perched saturated region + wtsub = 0._r8 + q_perch = 0._r8 + do k = k_perch, k_frz + imped=10._r8**(-e_ice*(0.5_r8*(icefrac(c,k)+icefrac(c,min(nlevsoi, k+1))))) + q_perch = q_perch + imped*hksat(c,k)*dzmm(c,k) + wtsub = wtsub + dzmm(c,k) + end do + if (wtsub > 0._r8) q_perch = q_perch/wtsub + + qflx_drain_perched(c) = q_perch_max * q_perch & + *(frost_table(c) - zwt_perched(c)) + + ! no perched water table drainage if using original formulation + if(origflag == 1) qflx_drain_perched(c) = 0._r8 + + ! remove drainage from perched saturated layers + rsub_top_tot = - qflx_drain_perched(c) * dtime + do k = k_perch+1, k_frz + rsub_top_layer=max(rsub_top_tot,-(h2osoi_liq(c,k)-watmin)) + rsub_top_layer=min(rsub_top_layer,0._r8) + rsub_top_tot = rsub_top_tot - rsub_top_layer + + h2osoi_liq(c,k) = h2osoi_liq(c,k) + rsub_top_layer + + if (rsub_top_tot >= 0.) then + zwt_perched(c) = zwt_perched(c) - rsub_top_layer/eff_porosity(c,k)/1000._r8 + exit + else + zwt_perched(c) = zi(c,k) + endif + + enddo + + ! if rsub_top_tot is greater than available water (above frost table), + ! then decrease qflx_drain_perched by residual amount for water balance + qflx_drain_perched(c) = qflx_drain_perched(c) + rsub_top_tot/dtime + + else + qflx_drain_perched(c) = 0._r8 + endif !k_frz > k_perch + + !-- Topographic runoff ---------------------------------------------------------------------- + fff(c) = 1._r8/ hkdepth(c) + dzsum = 0._r8 + icefracsum = 0._r8 + do j = max(jwt(c),1), nlevsoi + dzsum = dzsum + dzmm(c,j) + icefracsum = icefracsum + icefrac(c,j) * dzmm(c,j) + end do + ! add ice impedance factor to baseflow + if(origflag == 1) then + if (use_vichydro) then + call endrun(msg="VICHYDRO is not available for origflag=1"//errmsg(__FILE__, __LINE__)) + else + fracice_rsub(c) = max(0._r8,exp(-3._r8*(1._r8-(icefracsum/dzsum))) & + - exp(-3._r8))/(1.0_r8-exp(-3._r8)) + imped=(1._r8 - fracice_rsub(c)) + rsub_top_max = 5.5e-3_r8 + end if + else + if (use_vichydro) then + imped=10._r8**(-e_ice*min(1.0_r8,ice(c,nlayer)/max_moist(c,nlayer))) + dsmax_tmp(c) = Dsmax(c) * dtime/ secspday !mm/day->mm/dtime + rsub_top_max = dsmax_tmp(c) + else + imped=10._r8**(-e_ice*(icefracsum/dzsum)) + rsub_top_max = 10._r8 * sin((rpi/180.) * col%topo_slope(c)) + end if + endif + if (use_vichydro) then + ! ARNO model for the bottom soil layer (based on bottom soil layer + ! moisture from previous time step + ! use watmin instead for resid_moist to be consistent with default hydrology + rel_moist = (moist(c,nlayer) - watmin)/(max_moist(c,nlayer)-watmin) + frac = (Ds(c) * rsub_top_max )/Wsvic(c) + rsub_tmp = (frac * rel_moist)/dtime + if(rel_moist > Wsvic(c))then + frac = (rel_moist - Wsvic(c))/(1.0_r8 - Wsvic(c)) + rsub_tmp = rsub_tmp + (rsub_top_max * (1.0_r8 - Ds(c)/Wsvic(c)) *frac**c_param(c))/dtime + end if + rsub_top(c) = imped * rsub_tmp + ! make sure baseflow isn't negative + rsub_top(c) = max(0._r8, rsub_top(c)) + else + rsub_top(c) = imped * rsub_top_max* exp(-fff(c)*zwt(c)) + end if + + ! use analytical expression for aquifer specific yield + rous = watsat(c,nlevsoi) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,nlevsoi))**(-1./bsw(c,nlevsoi))) + rous=max(rous,0.02_r8) + + !-- water table is below the soil column -------------------------------------- + if(jwt(c) == nlevsoi) then + wa(c) = wa(c) - rsub_top(c) * dtime + zwt(c) = zwt(c) + (rsub_top(c) * dtime)/1000._r8/rous + h2osoi_liq(c,nlevsoi) = h2osoi_liq(c,nlevsoi) + max(0._r8,(wa(c)-5000._r8)) + wa(c) = min(wa(c), 5000._r8) + else + !-- water table within soil layers 1-9 ------------------------------------- + !============================== RSUB_TOP ========================================= + !-- Now remove water via rsub_top + rsub_top_tot = - rsub_top(c) * dtime + !should never be positive... but include for completeness + if(rsub_top_tot > 0.) then !rising water table + + call endrun(msg="RSUB_TOP IS POSITIVE in Drainage!"//errmsg(__FILE__, __LINE__)) + + else ! deepening water table + if (use_vichydro) then + wtsub_vic = 0._r8 + do j = (nlvic(1)+nlvic(2)+1), nlevsoi + wtsub_vic = wtsub_vic + hk_l(c,j)*dzmm(c,j) + end do + + do j = (nlvic(1)+nlvic(2)+1), nlevsoi + rsub_top_layer=max(rsub_top_tot, rsub_top_tot*hk_l(c,j)*dzmm(c,j)/wtsub_vic) + rsub_top_layer=min(rsub_top_layer,0._r8) + h2osoi_liq(c,j) = h2osoi_liq(c,j) + rsub_top_layer + rsub_top_tot = rsub_top_tot - rsub_top_layer + end do + else + do j = jwt(c)+1, nlevsoi + ! use analytical expression for specific yield + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + + rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) + rsub_top_layer=min(rsub_top_layer,0._r8) + h2osoi_liq(c,j) = h2osoi_liq(c,j) + rsub_top_layer + + rsub_top_tot = rsub_top_tot - rsub_top_layer + + if (rsub_top_tot >= 0.) then + zwt(c) = zwt(c) - rsub_top_layer/s_y/1000._r8 + + exit + else + zwt(c) = zi(c,j) + endif + enddo + end if + + !-- remove residual rsub_top --------------------------------------------- + zwt(c) = zwt(c) - rsub_top_tot/1000._r8/rous + wa(c) = wa(c) + rsub_top_tot + endif + + !-- recompute jwt --------------------------------------------------------- + ! allow jwt to equal zero when zwt is in top layer + jwt(c) = nlevsoi + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + end if! end of jwt if construct + + zwt(c) = max(0.0_r8,zwt(c)) + zwt(c) = min(80._r8,zwt(c)) + + endif + + end do + + ! excessive water above saturation added to the above unsaturated layer like a bucket + ! if column fully saturated, excess water goes to runoff + + do j = nlevsoi,2,-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + xsi(c) = max(h2osoi_liq(c,j)-eff_porosity(c,j)*dzmm(c,j),0._r8) + h2osoi_liq(c,j) = min(eff_porosity(c,j)*dzmm(c,j), h2osoi_liq(c,j)) + h2osoi_liq(c,j-1) = h2osoi_liq(c,j-1) + xsi(c) + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + !scs: watmin addition to fix water balance errors + xs1(c) = max(max(h2osoi_liq(c,1)-watmin,0._r8)- & + max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)-watmin)),0._r8) + h2osoi_liq(c,1) = h2osoi_liq(c,1) - xs1(c) + + if (lun%urbpoi(col%landunit(c))) then + qflx_rsub_sat(c) = xs1(c) / dtime + else + if(h2osfcflag == 1) then + ! send this water up to h2osfc rather than sending to drainage + h2osfc(c) = h2osfc(c) + xs1(c) + qflx_rsub_sat(c) = 0._r8 + else + ! use original code to send water to drainage (non-h2osfc case) + qflx_rsub_sat(c) = xs1(c) / dtime + endif + endif + ! add in ice check + xs1(c) = max(max(h2osoi_ice(c,1),0._r8)-max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_liq(c,1))),0._r8) + h2osoi_ice(c,1) = min(max(0._r8,pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_liq(c,1)), h2osoi_ice(c,1)) + qflx_snwcp_ice(c) = qflx_snwcp_ice(c) + xs1(c) / dtime + end do + + ! Limit h2osoi_liq to be greater than or equal to watmin. + ! Get water needed to bring h2osoi_liq equal watmin from lower layer. + ! If insufficient water in soil layers, get from aquifer water + + do j = 1, nlevsoi-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin - h2osoi_liq(c,j) + ! deepen water table if water is passed from below zwt layer + if(j == jwt(c)) then + zwt(c) = zwt(c) + xs(c)/eff_porosity(c,j)/1000._r8 + endif + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j ) = h2osoi_liq(c,j ) + xs(c) + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) - xs(c) + end do + end do + + ! Get water for bottom layer from layers above if possible + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin-h2osoi_liq(c,j) + searchforwater: do i = nlevsoi-1, 1, -1 + available_h2osoi_liq = max(h2osoi_liq(c,i)-watmin-xs(c),0._r8) + if (available_h2osoi_liq >= xs(c)) then + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + h2osoi_liq(c,i) = h2osoi_liq(c,i) - xs(c) + xs(c) = 0._r8 + exit searchforwater + else + h2osoi_liq(c,j) = h2osoi_liq(c,j) + available_h2osoi_liq + h2osoi_liq(c,i) = h2osoi_liq(c,i) - available_h2osoi_liq + xs(c) = xs(c) - available_h2osoi_liq + end if + end do searchforwater + else + xs(c) = 0._r8 + end if + ! Needed in case there is no water to be found + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + ! Instead of removing water from aquifer where it eventually + ! shows up as excess drainage to the ocean, take it back out of + ! drainage + rsub_top(c) = rsub_top(c) - xs(c)/dtime + + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Sub-surface runoff and drainage + + qflx_drain(c) = qflx_rsub_sat(c) + rsub_top(c) + + ! Set imbalance for snow capping + + qflx_qrgwl(c) = qflx_snwcp_liq(c) + + end do + + ! No drainage for urban columns (except for pervious road as computed above) + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (col%itype(c) /= icol_road_perv) then + qflx_drain(c) = 0._r8 + ! This must be done for roofs and impervious road (walls will be zero) + qflx_qrgwl(c) = qflx_snwcp_liq(c) + end if + end do + + end associate + + end subroutine Drainage + + !----------------------------------------------------------------------- + subroutine CLMVICMap(bounds, numf, filter, & + soilhydrology_inst, waterstate_inst) + ! + ! !DESCRIPTION: + ! Performs the mapping from CLM layers to VIC layers + ! Specifically, 10 (or 23 when more_vertlayers == .true.) + ! CLM hydrologically active soil layers are mapped to three VIC layers + ! by assigning the first nlvic(1) layers to VIC layer 1 + ! the next nlvic(2) layers to VIC alyer 2 + ! and the remaining to VIC layer 3 + ! mapping from VIC to CLM layers, M.Huang + ! + ! !USES: + use clm_varcon , only : denh2o, denice, watmin + use clm_varpar , only : nlevsoi, nlayer, nlayert, nlevgrnd + use decompMod , only : bounds_type + ! + ! !REVISION HISTORY: + ! Created by Maoyi Huang + ! 11/13/2012, Maoyi Huang: rewrite the mapping modules in CLM4VIC + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: numf ! number of column soil points in column filter + integer , intent(in) :: filter(:) ! column filter for soil points + type(waterstate_type) , intent(in) :: waterstate_inst + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + ! + ! !LOCAL VARIABLES + real(r8) :: ice0(1:nlayer) ! last step ice lens (mm) (new) + real(r8) :: moist0(1:nlayer) ! last step soil water (mm) (new) + integer :: i, j, c, fc + ! note: in CLM4 h2osoil_liq unit is kg/m2, in VIC moist is mm + ! h2osoi_ice is actually water equivalent ice content. + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + + depth => soilhydrology_inst%depth_col , & ! Input: [real(r8) (:,:) ] layer depth of upper layer (m) + porosity => soilhydrology_inst%porosity_col , & ! Input: [real(r8) (:,:) ] soil porisity (1-bulk_density/soil_density) + max_moist => soilhydrology_inst%max_moist_col , & ! Input: [real(r8) (:,:) ] max layer moist + ice (mm) + vic_clm_fract => soilhydrology_inst%vic_clm_fract_col , & ! Input: [real(r8) (:,:,:) ] fraction of VIC layers in each CLM layer + moist => soilhydrology_inst%moist_col , & ! Output: [real(r8) (:,:) ] liquid water (mm) + ice => soilhydrology_inst%ice_col , & ! Output: [real(r8) (:,:) ] ice lens (mm) + moist_vol => soilhydrology_inst%moist_vol_col & ! Output: [real(r8) (:,:) ] volumetric soil moisture for VIC soil layers + ) + + ! map CLM to VIC + do fc = 1, numf + c = filter(fc) + do i = 1, nlayer + ice0(i) = ice(c,i) + moist0(i) = moist(c,i) + ice(c,i) = 0._r8 + moist(c,i) = 0._r8 + do j = 1, nlevsoi + ice(c,i) = ice(c,i) + h2osoi_ice(c,j) * vic_clm_fract(c,i,j) + moist(c,i) = moist(c,i) + h2osoi_liq(c,j) * vic_clm_fract(c,i,j) + end do + ice(c,i) = min((moist0(i) + ice0(i)), ice(c,i)) + ice(c,i) = max(0._r8, ice(c,i)) + moist(c,i) = max(watmin, moist(c,i)) + moist(c,i) = min(max_moist(c,i)-ice(c,i), moist(c,i)) + moist_vol(c,i) = moist(c,i)/(depth(c,i)*denice) + ice(c,i)/(depth(c,i)*denh2o) + moist_vol(c,i) = min(porosity(c,i), moist_vol(c,i)) + moist_vol(c,i) = max(0.01_r8, moist_vol(c,i)) + end do + + ! hydrologic inactive layers + ice(c, nlayer+1:nlayert) = h2osoi_ice(c, nlevsoi+1:nlevgrnd) + moist(c, nlayer+1:nlayert) = h2osoi_liq(c, nlevsoi+1:nlevgrnd) + moist_vol(c, nlayer+1:nlayert) = h2osoi_vol(c, nlevsoi+1:nlevgrnd) + end do + + end associate + + end subroutine CLMVICMap + +end module SoilHydrologyMod diff --git a/components/clm/src/biogeophys/SoilHydrologyType.F90 b/components/clm/src/biogeophys/SoilHydrologyType.F90 new file mode 100644 index 0000000000..e55936ce68 --- /dev/null +++ b/components/clm/src/biogeophys/SoilHydrologyType.F90 @@ -0,0 +1,313 @@ +Module SoilHydrologyType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varpar , only : nlevgrnd, nlayer, nlayert, nlevsoi + use clm_varcon , only : spval + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + save + ! + type, public :: soilhydrology_type + + integer :: h2osfcflag ! true => surface water is active (namelist) + integer :: origflag ! used to control soil hydrology properties (namelist) + + ! NON-VIC + real(r8), pointer :: frost_table_col (:) ! col frost table depth + real(r8), pointer :: zwt_col (:) ! col water table depth + real(r8), pointer :: zwts_col (:) ! col water table depth, the shallower of the two water depths + real(r8), pointer :: zwt_perched_col (:) ! col perched water table depth + real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) + real(r8), pointer :: qcharge_col (:) ! col aquifer recharge rate (mm/s) + real(r8), pointer :: fracice_col (:,:) ! col fractional impermeability (-) + real(r8), pointer :: icefrac_col (:,:) ! col fraction of ice + real(r8), pointer :: fcov_col (:) ! col fractional impermeable area + real(r8), pointer :: fsat_col (:) ! col fractional area with water table at surface + real(r8), pointer :: h2osfc_thresh_col (:) ! col level at which h2osfc "percolates" (time constant) + + ! VIC + real(r8), pointer :: hkdepth_col (:) ! col VIC decay factor (m) (time constant) + real(r8), pointer :: b_infil_col (:) ! col VIC b infiltration parameter (time constant) + real(r8), pointer :: ds_col (:) ! col VIC fracton of Dsmax where non-linear baseflow begins (time constant) + real(r8), pointer :: dsmax_col (:) ! col VIC max. velocity of baseflow (mm/day) (time constant) + real(r8), pointer :: Wsvic_col (:) ! col VIC fraction of maximum soil moisutre where non-liear base flow occurs (time constant) + real(r8), pointer :: porosity_col (:,:) ! col VIC porosity (1-bulk_density/soil_density) + real(r8), pointer :: vic_clm_fract_col (:,:,:) ! col VIC fraction of VIC layers in CLM layers + real(r8), pointer :: depth_col (:,:) ! col VIC layer depth of upper layer + real(r8), pointer :: c_param_col (:) ! col VIC baseflow exponent (Qb) + real(r8), pointer :: expt_col (:,:) ! col VIC pore-size distribution related paramter(Q12) + real(r8), pointer :: ksat_col (:,:) ! col VIC Saturated hydrologic conductivity + real(r8), pointer :: phi_s_col (:,:) ! col VIC soil moisture dissusion parameter + real(r8), pointer :: moist_col (:,:) ! col VIC soil moisture (kg/m2) for VIC soil layers + real(r8), pointer :: moist_vol_col (:,:) ! col VIC volumetric soil moisture for VIC soil layers + real(r8), pointer :: max_moist_col (:,:) ! col VIC max layer moist + ice (mm) + real(r8), pointer :: max_infil_col (:) ! col VIC maximum infiltration rate calculated in VIC + real(r8), pointer :: i_0_col (:) ! col VIC average saturation in top soil layers + real(r8), pointer :: ice_col (:,:) ! col VIC soil ice (kg/m2) for VIC soil layers + + contains + + ! Public routines + procedure, public :: Init + procedure, public :: Restart + + ! Private routines + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, private :: ReadNL + + end type soilhydrology_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, NLFilename) + + class(soilhydrology_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename + + call this%ReadNL(NLFilename) + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(soilhydrology_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%frost_table_col (begc:endc)) ; this%frost_table_col (:) = nan + allocate(this%zwt_col (begc:endc)) ; this%zwt_col (:) = nan + allocate(this%zwt_perched_col (begc:endc)) ; this%zwt_perched_col (:) = nan + allocate(this%zwts_col (begc:endc)) ; this%zwts_col (:) = nan + + allocate(this%wa_col (begc:endc)) ; this%wa_col (:) = nan + allocate(this%qcharge_col (begc:endc)) ; this%qcharge_col (:) = nan + allocate(this%fracice_col (begc:endc,nlevgrnd)) ; this%fracice_col (:,:) = nan + allocate(this%icefrac_col (begc:endc,nlevgrnd)) ; this%icefrac_col (:,:) = nan + allocate(this%fcov_col (begc:endc)) ; this%fcov_col (:) = nan + allocate(this%fsat_col (begc:endc)) ; this%fsat_col (:) = nan + allocate(this%h2osfc_thresh_col (begc:endc)) ; this%h2osfc_thresh_col (:) = nan + + allocate(this%hkdepth_col (begc:endc)) ; this%hkdepth_col (:) = nan + allocate(this%b_infil_col (begc:endc)) ; this%b_infil_col (:) = nan + allocate(this%ds_col (begc:endc)) ; this%ds_col (:) = nan + allocate(this%dsmax_col (begc:endc)) ; this%dsmax_col (:) = nan + allocate(this%Wsvic_col (begc:endc)) ; this%Wsvic_col (:) = nan + allocate(this%depth_col (begc:endc,nlayert)) ; this%depth_col (:,:) = nan + allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = nan + allocate(this%vic_clm_fract_col (begc:endc,nlayer, nlevsoi)) ; this%vic_clm_fract_col (:,:,:) = nan + allocate(this%c_param_col (begc:endc)) ; this%c_param_col (:) = nan + allocate(this%expt_col (begc:endc,nlayer)) ; this%expt_col (:,:) = nan + allocate(this%ksat_col (begc:endc,nlayer)) ; this%ksat_col (:,:) = nan + allocate(this%phi_s_col (begc:endc,nlayer)) ; this%phi_s_col (:,:) = nan + allocate(this%moist_col (begc:endc,nlayert)) ; this%moist_col (:,:) = nan + allocate(this%moist_vol_col (begc:endc,nlayert)) ; this%moist_vol_col (:,:) = nan + allocate(this%max_moist_col (begc:endc,nlayer)) ; this%max_moist_col (:,:) = nan + allocate(this%max_infil_col (begc:endc)) ; this%max_infil_col (:) = nan + allocate(this%i_0_col (begc:endc)) ; this%i_0_col (:) = nan + allocate(this%ice_col (begc:endc,nlayert)) ; this%ice_col (:,:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(soilhydrology_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + this%wa_col(begc:endc) = spval + call hist_addfld1d (fname='WA', units='mm', & + avgflag='A', long_name='water in the unconfined aquifer (vegetated landunits only)', & + ptr_col=this%wa_col, l2g_scale_type='veg') + + this%qcharge_col(begc:endc) = spval + call hist_addfld1d (fname='QCHARGE', units='mm/s', & + avgflag='A', long_name='aquifer recharge rate (vegetated landunits only)', & + ptr_col=this%qcharge_col, l2g_scale_type='veg') + + this%fcov_col(begc:endc) = spval + call hist_addfld1d (fname='FCOV', units='unitless', & + avgflag='A', long_name='fractional impermeable area', & + ptr_col=this%fcov_col, l2g_scale_type='veg') + + this%fsat_col(begc:endc) = spval + call hist_addfld1d (fname='FSAT', units='unitless', & + avgflag='A', long_name='fractional area with water table at surface', & + ptr_col=this%fsat_col, l2g_scale_type='veg') + + this%frost_table_col(begc:endc) = spval + call hist_addfld1d (fname='FROST_TABLE', units='m', & + avgflag='A', long_name='frost table depth (vegetated landunits only)', & + ptr_col=this%frost_table_col, l2g_scale_type='veg') + + this%zwt_col(begc:endc) = spval + call hist_addfld1d (fname='ZWT', units='m', & + avgflag='A', long_name='water table depth (vegetated landunits only)', & + ptr_col=this%zwt_col, l2g_scale_type='veg') + + this%zwt_perched_col(begc:endc) = spval + call hist_addfld1d (fname='ZWT_PERCH', units='m', & + avgflag='A', long_name='perched water table depth (vegetated landunits only)', & + ptr_col=this%zwt_perched_col, l2g_scale_type='veg') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soilhydrology_type) :: this + type(bounds_type) , intent(in) :: bounds + !----------------------------------------------------------------------- + + ! Nothing for now + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio , only : file_desc_t, ncd_io, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(soilhydrology_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='FROST_TABLE', xtype=ncd_double, & + dim1name='column', & + long_name='frost table depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%frost_table_col) + if (flag == 'read' .and. .not. readvar) then + this%frost_table_col(bounds%begc:bounds%endc) = col%zi(bounds%begc:bounds%endc,nlevsoi) + end if + + call restartvar(ncid=ncid, flag=flag, varname='WA', xtype=ncd_double, & + dim1name='column', & + long_name='water in the unconfined aquifer', units='mm', & + interpinic_flag='interp', readvar=readvar, data=this%wa_col) + + call restartvar(ncid=ncid, flag=flag, varname='ZWT', xtype=ncd_double, & + dim1name='column', & + long_name='water table depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%zwt_col) + + call restartvar(ncid=ncid, flag=flag, varname='ZWT_PERCH', xtype=ncd_double, & + dim1name='column', & + long_name='perched water table depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%zwt_perched_col) + if (flag == 'read' .and. .not. readvar) then + this%zwt_perched_col(bounds%begc:bounds%endc) = col%zi(bounds%begc:bounds%endc,nlevsoi) + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine ReadNL( this, NLFilename ) + ! + ! !DESCRIPTION: + ! Read namelist for SoilHydrology + ! + ! !USES: + use shr_mpi_mod , only : shr_mpi_bcast + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use clm_nlUtilsMod , only : find_nlgroup_name + use clm_varctl , only : iulog + use abortutils , only : endrun + ! + ! !ARGUMENTS: + class(soilhydrology_type) :: this + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + integer :: origflag=0 !use to control soil hydraulic properties + integer :: h2osfcflag=1 !If surface water is active or not + character(len=32) :: subname = 'SoilHydrology_readnl' ! subroutine name + !----------------------------------------------------------------------- + + namelist / clm_soilhydrology_inparm / h2osfcflag, origflag + + ! preset values + + origflag = 0 + h2osfcflag = 1 + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in clm_soilhydrology_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call find_nlgroup_name(unitn, 'clm_soilhydrology_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clm_soilhydrology_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading clm_soilhydrology_inparm namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if + + call shr_mpi_bcast(h2osfcflag, mpicom) + call shr_mpi_bcast(origflag, mpicom) + + this%h2osfcflag = h2osfcflag + this%origflag = origflag + + end subroutine ReadNL + + end Module SoilHydrologyType diff --git a/components/clm/src/biogeophys/SoilMoistStressMod.F90 b/components/clm/src/biogeophys/SoilMoistStressMod.F90 new file mode 100644 index 0000000000..f7029a1728 --- /dev/null +++ b/components/clm/src/biogeophys/SoilMoistStressMod.F90 @@ -0,0 +1,513 @@ +module SoilMoistStressMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculates soil moisture stress for plant gpp and transpiration + ! + ! After discussion with other developers, I have now removed all functions that + ! return array, and decalared all variables that will be modified as intent(inout). + ! The initialization will be done whenever the variable is initialized. This avoids + ! code crash when initialization is not done appropriately, and make the code safer + ! during the long-term maintenance + ! + ! Created by Jinyun Tang, Feb., 2014 + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: calc_root_moist_stress + public :: calc_effective_soilporosity + public :: calc_effective_snowporosity + public :: calc_volumetric_h2oliq + public :: set_perchroot_opt + public :: init_root_moist_stress + ! + ! !PRIVATE DATA MEMBERS: + integer :: root_moist_stress_method + integer, parameter :: moist_stress_clm_default = 0 !default method for calculating root moisture stress + logical, private :: perchroot = .false. ! true => btran is based only on unfrozen soil levels + logical, private :: perchroot_alt = .false. ! true => btran is based on active layer (defined over two years); + !-------------------------------------------------------------------------------- + +contains + + !-------------------------------------------------------------------------------- + subroutine init_root_moist_stress() + ! + !DESCRIPTION + !specify the method to compute root soil moisture stress + ! + implicit none + + root_moist_stress_method = moist_stress_clm_default + end subroutine init_root_moist_stress + + !-------------------------------------------------------------------------------- + subroutine set_perchroot_opt(perchroot_global, perchroot_alt_global) + ! + !DESCRIPTIONS + !set up local perchroot logical switches, in the future, this wil be + !read in as namelist + ! + ! !ARGUMENTS: + implicit none + logical, intent(in) :: perchroot_global + logical, intent(in) :: perchroot_alt_global + !------------------------------------------------------------------------------ + + perchroot = perchroot_global + perchroot_alt = perchroot_alt_global + + end subroutine set_perchroot_opt + + !-------------------------------------------------------------------------------- + subroutine calc_effective_soilporosity(bounds, ubj, numf, filter, & + watsat, h2osoi_ice, denice, eff_por) + ! + ! !DESCRIPTIONS + ! compute the effective soil porosity + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use ColumnType , only : col + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj ! lbinning level indices + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(:) ! filter + real(r8) , intent(in) :: watsat( bounds%begc: , 1: ) ! soil porosity + real(r8) , intent(in) :: h2osoi_ice( bounds%begc: , 1: ) ! ice water content, kg H2o/m2 + real(r8) , intent(in) :: denice ! ice density, kg/m3 + real(r8) , intent(inout) :: eff_por( bounds%begc: ,1: ) ! effective porosity + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc !indices + real(r8):: vol_ice !volumetric ice + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(watsat) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_ice) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(eff_por) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + + !main calculation loop + !it assumes the soil layers start from 1 + do j = 1, ubj + do fc = 1, numf + c = filter(fc) + !compute the volumetric ice content + vol_ice=min(watsat(c,j), h2osoi_ice(c,j)/(denice*col%dz(c,j))) + + !compute the maximum soil space to fill liquid water and air + eff_por(c,j) = watsat(c,j) - vol_ice + enddo + enddo + end subroutine calc_effective_soilporosity + + !-------------------------------------------------------------------------------- + subroutine calc_effective_snowporosity(bounds, lbj, jtop, numf, filter, & + h2osoi_ice, denice, eff_por) + ! + ! !DESCRIPTIONS + ! compute the effective porosity snow + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use shr_log_mod , only : errMsg => shr_log_errMsg + use ColumnType , only : col + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: lbj !ubing level indices + integer , intent(in) :: jtop( bounds%begc: ) !top level for each column [col] + integer , intent(in) :: numf !filter dimension + integer , intent(in) :: filter(:) !filter + real(r8) , intent(in) :: h2osoi_ice( bounds%begc: , lbj: ) !ice water content, kg H2o/m2 + real(r8) , intent(in) :: denice !ice density, kg/m3 + real(r8) , intent(inout) :: eff_por( bounds%begc: ,lbj: ) !returning effective porosity + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc !indices + integer :: ubj + real(r8) :: vol_ice !volumetric ice + !------------------------------------------------------------------------------ + + ubj = 0 + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_ice) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(eff_por) == (/bounds%endc,0/)) , errMsg(__FILE__, __LINE__)) + + !main calculation loop + + !it assumes snow layer ends at 0 + do j = lbj,0 + do fc = 1, numf + c = filter(fc) + if (j>=jtop(c)) then + !compute the volumetric ice content + vol_ice=min(1._r8, h2osoi_ice(c,j)/(denice*col%dz(c,j))) + + !compute the maximum snow void space to fill liquid water and air + eff_por(c,j) = 1._r8 - vol_ice + endif + enddo + enddo + + end subroutine calc_effective_snowporosity + + !-------------------------------------------------------------------------------- + subroutine calc_volumetric_h2oliq(bounds, jtop, lbj, ubj, numf, filter,& + eff_porosity, h2osoi_liq, denh2o, vol_liq) + ! + ! !DESCRIPTIONS + ! compute the volumetric liquid water content + ! + ! + ! !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use ColumnType , only : col + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col] + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(:) ! filter + real(r8) , intent(in) :: eff_porosity(bounds%begc: , lbj: ) ! effective soil porosity + real(r8) , intent(in) :: h2osoi_liq(bounds%begc: , lbj: ) ! liquid water content [kg H2o/m2] + real(r8) , intent(in) :: denh2o ! water density [kg/m3] + real(r8) , intent(inout) :: vol_liq(bounds%begc: , lbj: ) ! volumetric liquid water content + ! + ! !LOCAL VARIABLES: + integer :: c, j, fc ! indices + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(eff_porosity) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(vol_liq) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + + !main calculation loop + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtop(c))then + !volume of liquid is no greater than effective void space + vol_liq(c,j) = min(eff_porosity(c,j), h2osoi_liq(c,j)/(col%dz(c,j)*denh2o)) + endif + enddo + enddo + + end subroutine calc_volumetric_h2oliq + + !-------------------------------------------------------------------------------- + subroutine normalize_unfrozen_rootfr(bounds, ubj, fn, filterp, & + canopystate_inst, soilstate_inst, temperature_inst, rootfr_unf) + ! + ! !DESCRIPTIONS + ! normalize root fraction for total unfrozen depth + ! + ! !USES + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : tfrz !temperature where water freezes [K], this is taken as constant at the moment + use decompMod , only : bounds_type + use CanopyStateType , only : canopystate_type + use EnergyFluxType , only : energyflux_type + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use WaterSTateType , only : waterstate_type + use SimpleMathMod , only : array_normalization + use PatchType , only : patch + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: ubj !ubinning level indices + integer , intent(in) :: fn !filter dimension + integer , intent(in) :: filterp(:) !filter + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + real(r8) , intent(inout) :: rootfr_unf(bounds%begp:bounds%endp, 1:ubj) !normalized root fraction in unfrozen layers + ! + ! !LOCAL VARIABLES: + !real(r8) :: rootsum(bounds%begp:bounds%endp) + integer :: p, c, j, f !indices + !------------------------------------------------------------------------------ + + associate( & + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col , & ! Input: [real(r8) (:) ] prior year maximum annual depth of thaw + altmax_indx => canopystate_inst%altmax_indx_col & ! Input: [real(r8) (:) ] maximum annual depth of thaw + ) + + ! main calculation loop + ! Initialize rootfr_unf to zero. + ! I found it necessary to ensure the pgi compiler not + ! to complain with float point exception. However, it raises a question how + ! to make sure those values that are initialized with nan or spval are not reset + ! to zero within similar coding style. Jinyun Tang, May 23, 2014. + + ! Define rootfraction for unfrozen soil only + if (perchroot .or. perchroot_alt) then + if (perchroot_alt) then + ! use total active layer (defined ass max thaw depth for current and prior year) + do j = 1, ubj + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + if ( j <= max(altmax_lastyear_indx(c), altmax_indx(c), 1) )then + rootfr_unf(p,j) = rootfr(p,j) + else + rootfr_unf(p,j) = 0._r8 + end if + end do + end do + else + ! use instantaneous temperature + do j = 1, ubj + do f = 1, fn + p = filterp(f) + c = patch%column(p) + + if (t_soisno(c,j) >= tfrz) then + rootfr_unf(p,j) = rootfr(p,j) + else + rootfr_unf(p,j) = 0._r8 + end if + end do + end do + + end if ! perchroot_alt + end if ! perchroot + + !normalize the root fraction for each pft + call array_normalization(bounds%begp, bounds%endp, 1, ubj, & + fn, filterp, rootfr_unf(bounds%begp:bounds%endp, 1:ubj)) + + end associate + + end subroutine normalize_unfrozen_rootfr + + !-------------------------------------------------------------------------------- + subroutine calc_root_moist_stress_clm45default(bounds, & + nlevgrnd, fn, filterp, rootfr_unf, & + temperature_inst, soilstate_inst, energyflux_inst, waterstate_inst, & + soil_water_retention_curve) + ! + ! DESCRIPTIONS + ! compute the root water stress using the default clm45 approach + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varcon , only : tfrz !temperature where water freezes [K], this is taken as constant at the moment + use pftconMod , only : pftcon + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use EnergyFluxType , only : energyflux_type + use WaterSTateType , only : waterstate_type + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use PatchType , only : patch + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: nlevgrnd !number of vertical layers + integer , intent(in) :: fn !number of filters + integer , intent(in) :: filterp(:) !filter array + real(r8) , intent(in) :: rootfr_unf(bounds%begp: , 1: ) + type(energyflux_type) , intent(inout) :: energyflux_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + real(r8), parameter :: btran0 = 0.0_r8 ! initial value + real(r8) :: smp_node, s_node !temporary variables + real(r8) :: smp_node_lf !temporary variable + integer :: p, f, j, c, l !indices + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(rootfr_unf) == (/bounds%endp, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + smpso => pftcon%smpso , & ! Input: soil water potential at full stomatal opening (mm) + smpsc => pftcon%smpsc , & ! Input: soil water potential at full stomatal closure (mm) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (constant) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) (constant) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (constant) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer + rootr => soilstate_inst%rootr_patch , & ! Output: [real(r8) (:,:) ] effective fraction of roots in each soil layer + + btran => energyflux_inst%btran_patch , & ! Output: [real(r8) (:) ] transpiration wetness factor (0 to 1) (integrated soil water stress) + btran2 => energyflux_inst%btran2_patch , & ! Output: [real(r8) (:) ] integrated soil water stress square + rresis => energyflux_inst%rresis_patch , & ! Output: [real(r8) (:,:) ] root soil water stress (resistance) by layer (0-1) (nlevgrnd) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + h2osoi_liqvol => waterstate_inst%h2osoi_liqvol_col & ! Output: [real(r8) (:,:) ] liquid volumetric moisture, will be used for BeTR + ) + + do j = 1,nlevgrnd + do f = 1, fn + p = filterp(f) + c = patch%column(p) + l = patch%landunit(p) + + ! Root resistance factors + ! rootr effectively defines the active root fraction in each layer + if (h2osoi_liqvol(c,j) .le. 0._r8 .or. t_soisno(c,j) .le. tfrz-2._r8) then + rootr(p,j) = 0._r8 + else + s_node = max(h2osoi_liqvol(c,j)/eff_porosity(c,j),0.01_r8) + + !smp_node = max(smpsc(patch%itype(p)), -sucsat(c,j)*s_node**(-bsw(c,j))) + call soil_water_retention_curve%soil_suction(sucsat(c,j), s_node, bsw(c,j), smp_node) + smp_node = max(smpsc(patch%itype(p)), smp_node) + + rresis(p,j) = min( (eff_porosity(c,j)/watsat(c,j))* & + (smp_node - smpsc(patch%itype(p))) / (smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8) + + + if (.not. (perchroot .or. perchroot_alt) ) then + rootr(p,j) = rootfr(p,j)*rresis(p,j) + else + rootr(p,j) = rootfr_unf(p,j)*rresis(p,j) + end if + + !it is possible to further separate out a btran function, but I will leave it for the moment, jyt + btran(p) = btran(p) + max(rootr(p,j),0._r8) + + !smp_node_lf = max(smpsc(patch%itype(p)), -sucsat(c,j)*(h2osoi_vol(c,j)/watsat(c,j))**(-bsw(c,j))) + s_node = h2osoi_vol(c,j)/watsat(c,j) + + call soil_water_retention_curve%soil_suction(sucsat(c,j), s_node, bsw(c,j), smp_node_lf) + + !smp_node_lf = -sucsat(c,j)*(h2osoi_vol(c,j)/watsat(c,j))**(-bsw(c,j)) + smp_node_lf = max(smpsc(patch%itype(p)), smp_node_lf) + btran2(p) = btran2(p) +rootfr(p,j)*min((smp_node_lf - smpsc(patch%itype(p))) / & + (smpso(patch%itype(p)) - smpsc(patch%itype(p))), 1._r8) + endif + end do + end do + + ! Normalize root resistances to get layer contribution to ET + do j = 1,nlevgrnd + do f = 1, fn + p = filterp(f) + if (btran(p) > btran0) then + rootr(p,j) = rootr(p,j)/btran(p) + else + rootr(p,j) = 0._r8 + end if + end do + end do + end associate + + end subroutine calc_root_moist_stress_clm45default + + !-------------------------------------------------------------------------------- + subroutine calc_root_moist_stress(bounds, nlevgrnd, fn, filterp, & + canopystate_inst, energyflux_inst, soilstate_inst, temperature_inst, & + waterstate_inst, soil_water_retention_curve) + ! + ! DESCRIPTIONS + ! compute the root water stress using different approaches + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : tfrz !temperature where water freezes [K], this is taken as constant at the moment + use decompMod , only : bounds_type + use CanopyStateType , only : canopystate_type + use EnergyFluxType , only : energyflux_type + use TemperatureType , only : temperature_type + use SoilStateType , only : soilstate_type + use WaterSTateType , only : waterstate_type + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use abortutils , only : endrun + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: nlevgrnd + integer , intent(in) :: fn + integer , intent(in) :: filterp(:) + type(canopystate_type) , intent(in) :: canopystate_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + integer :: p, f, j, c, l ! indices + real(r8) :: smp_node, s_node ! temporary variables + real(r8) :: rootfr_unf(bounds%begp:bounds%endp,1:nlevgrnd) ! Rootfraction defined for unfrozen layers only. + character(len=32) :: subname = 'calc_root_moist_stress' ! subroutine name + !------------------------------------------------------------------------------ + + !define normalized rootfraction for unfrozen soil + !define normalized rootfraction for unfrozen soil + rootfr_unf(bounds%begp:bounds%endp,1:nlevgrnd) = 0._r8 + + call normalize_unfrozen_rootfr(bounds, & + ubj = nlevgrnd, & + fn = fn, & + filterp = filterp, & + canopystate_inst=canopystate_inst, & + soilstate_inst=soilstate_inst, & + temperature_inst=temperature_inst, & + rootfr_unf=rootfr_unf(bounds%begp:bounds%endp,1:nlevgrnd)) + + !suppose h2osoi_liq, eff_porosity are already computed somewhere else + + select case (root_moist_stress_method) + !add other methods later + case (moist_stress_clm_default) + + call calc_root_moist_stress_clm45default(bounds, & + nlevgrnd = nlevgrnd, & + fn = fn, & + filterp = filterp, & + energyflux_inst=energyflux_inst, & + temperature_inst=temperature_inst, & + soilstate_inst=soilstate_inst, & + waterstate_inst=waterstate_inst, & + rootfr_unf=rootfr_unf(bounds%begp:bounds%endp,1:nlevgrnd), & + soil_water_retention_curve=soil_water_retention_curve) + + case default + call endrun(subname // ':: a root moisture stress function must be specified!') + end select + + end subroutine calc_root_moist_stress + +end module SoilMoistStressMod diff --git a/components/clm/src/biogeophys/SoilStateInitTimeConstMod.F90 b/components/clm/src/biogeophys/SoilStateInitTimeConstMod.F90 new file mode 100644 index 0000000000..29a5a0ab8d --- /dev/null +++ b/components/clm/src/biogeophys/SoilStateInitTimeConstMod.F90 @@ -0,0 +1,639 @@ +module SoilStateInitTimeConstMod + + !------------------------------------------------------------------------------ + ! DESCRIPTION: + ! Set hydraulic and thermal properties + ! + ! !USES + use SoilStateType , only : soilstate_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilStateInitTimeConst + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: ReadNL + ! + ! !PRIVATE DATA: + ! Control variables (from namelist) + logical, private :: organic_frac_squared ! If organic fraction should be squared (as in CLM4.5) + !----------------------------------------------------------------------- + ! +contains + + !----------------------------------------------------------------------- + subroutine ReadNL( nlfilename ) + ! + ! !DESCRIPTION: + ! Read namelist for SoilStateType + ! + ! !USES: + use shr_mpi_mod , only : shr_mpi_bcast + use shr_log_mod , only : errMsg => shr_log_errMsg + use fileutils , only : getavu, relavu, opnfil + use clm_nlUtilsMod , only : find_nlgroup_name + use clm_varctl , only : iulog + use spmdMod , only : mpicom, masterproc + use abortUtils , only : endrun + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: nlfilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'SoilState_readnl' ! subroutine name + !----------------------------------------------------------------------- + + character(len=*), parameter :: nl_name = 'clm_soilstate_inparm' ! Namelist name + ! MUST agree with name in namelist and read + namelist / clm_soilstate_inparm / organic_frac_squared + + ! preset values + + organic_frac_squared = .false. + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in '//nl_name//' namelist' + call opnfil (nlfilename, unitn, 'F') + call find_nlgroup_name(unitn, nl_name, status=ierr) + if (ierr == 0) then + read(unit=unitn, nml=clm_soilstate_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading '//nl_name//' namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if + + call shr_mpi_bcast(organic_frac_squared, mpicom) + + end subroutine ReadNL + + !----------------------------------------------------------------------- + subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen + use clm_varpar , only : more_vertlayers, numpft, numrad + use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlevsoifl, nlayer, nlayert, nlevurb, nlevsno + use clm_varcon , only : zsoi, dzsoi, zisoi, spval + use clm_varcon , only : secspday, pc, mu, denh2o, denice, grlnd + use clm_varctl , only : use_cn, use_lch4, use_ed + use clm_varctl , only : iulog, fsurdat, paramfile + use landunit_varcon , only : istice, istdlak, istwet, istsoil, istcrop, istice_mec + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv + use fileutils , only : getfil + use organicFileMod , only : organicrd + use FuncPedotransferMod , only : pedotransf, get_ipedof + use RootBiophysMod , only : init_vegrootfr + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilstate_type) , intent(inout) :: soilstate_inst + character(len=*) , intent(in) :: nlfilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: p, lev, c, l, g, j ! indices + real(r8) :: om_frac ! organic matter fraction + real(r8) :: om_tkm = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K] + real(r8) :: om_watsat_lake = 0.9_r8 ! porosity of organic soil + real(r8) :: om_hksat_lake = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_sucsat_lake = 10.3_r8 ! saturated suction for organic matter (Letts, 2000) + real(r8) :: om_b_lake = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) (lake) + real(r8) :: om_watsat ! porosity of organic soil + real(r8) :: om_hksat ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_sucsat ! saturated suction for organic matter (mm)(Letts, 2000) + real(r8) :: om_csol = 2.5_r8 ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986) + real(r8) :: om_tkd = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981) + real(r8) :: om_b ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) + real(r8) :: zsapric = 0.5_r8 ! depth (m) that organic matter takes on characteristics of sapric peat + real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) + real(r8) :: pcalpha = 0.5_r8 ! percolation threshold + real(r8) :: pcbeta = 0.139_r8 ! percolation exponent + real(r8) :: pc_lake = 0.5_r8 ! percolation threshold + real(r8) :: perc_frac ! "percolating" fraction of organic soil + real(r8) :: perc_norm ! normalize to 1 when 100% organic soil + real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil + real(r8) :: uncon_frac ! fraction of "unconnected" soil + real(r8) :: bd ! bulk density of dry soil material [kg/m^3] + real(r8) :: tkm ! mineral conductivity + real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s] + real(r8) :: clay,sand ! temporaries + real(r8) :: organic_max ! organic matter (kg/m3) where soil is assumed to act like peat + integer :: dimid ! dimension id + logical :: readvar + type(file_desc_t) :: ncid ! netcdf id + real(r8) ,pointer :: zsoifl (:) ! Output: [real(r8) (:)] original soil midpoint + real(r8) ,pointer :: zisoifl (:) ! Output: [real(r8) (:)] original soil interface depth + real(r8) ,pointer :: dzsoifl (:) ! Output: [real(r8) (:)] original soil thickness + real(r8) ,pointer :: gti (:) ! read in - fmax + real(r8) ,pointer :: sand3d (:,:) ! read in - soil texture: percent sand (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: clay3d (:,:) ! read in - soil texture: percent clay (needs to be a pointer for use in ncdio) + real(r8) ,pointer :: organic3d (:,:) ! read in - organic matter: kg/m3 (needs to be a pointer for use in ncdio) + character(len=256) :: locfn ! local filename + integer :: ipedof + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + do c = begc,endc + soilstate_inst%smpmin_col(c) = -1.e8_r8 + end do + + ! -------------------------------------------------------------------- + ! Read namelist + ! -------------------------------------------------------------------- + + call ReadNL( nlfilename ) + + ! -------------------------------------------------------------------- + ! Initialize root fraction (computing from surface, d is depth in meter): + ! -------------------------------------------------------------------- + + ! Currently pervious road has same properties as soil + do c = begc,endc + l = col%landunit(c) + + if (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv) then + do lev = 1, nlevgrnd + soilstate_inst%rootfr_road_perv_col(c,lev) = 0._r8 + enddo + do lev = 1,nlevsoi + soilstate_inst%rootfr_road_perv_col(c,lev) = 0.1_r8 ! uniform profile + end do + end if + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + soilstate_inst%rootfr_col (c,nlevsoi+1:nlevgrnd) = 0._r8 + else + ! Inactive CH4 columns + ! (Also includes (lun%itype(l)==istdlak .and. allowlakeprod), which used to be + ! in a separate branch of the conditional) + soilstate_inst%rootfr_col (c,:) = spval + end if + end do + + ! Initialize root fraction + ! Note that ED has its own root fraction root fraction routine and should not + ! use the following since it depends on patch%itype - which ED should not use + + if (.not. use_ed) then + call init_vegrootfr(bounds, nlevsoi, nlevgrnd, & + soilstate_inst%rootfr_patch(begp:endp,1:nlevgrnd)) + end if + + ! -------------------------------------------------------------------- + ! dynamic memory allocation + ! -------------------------------------------------------------------- + + allocate(sand3d(begg:endg,nlevsoifl)) + allocate(clay3d(begg:endg,nlevsoifl)) + + ! Determine organic_max from parameter file + + call getfil (paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_io(ncid=ncid, varname='organic_max', flag='read', data=organic_max, readvar=readvar) + if ( .not. readvar ) call endrun(msg=' ERROR: organic_max not on param file'//errMsg(__FILE__, __LINE__)) + call ncd_pio_closefile(ncid) + + ! -------------------------------------------------------------------- + ! Read surface dataset + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqdlen(ncid,dimid,nlevsoifl,name='nlevsoi') + if ( .not. more_vertlayers )then + if ( nlevsoifl /= nlevsoi )then + call endrun(msg=' ERROR: Number of soil layers on file does NOT match the number being used'//& + errMsg(__FILE__, __LINE__)) + end if + else + ! read in layers, interpolate to high resolution grid later + end if + + ! Read in organic matter dataset + + allocate(organic3d(begg:endg,nlevsoifl)) + call organicrd(organic3d) + + ! Read in sand and clay data + + call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: PCT_SAND NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: PCT_CLAY NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + + do p = begp,endp + g = patch%gridcell(p) + if ( sand3d(g,1)+clay3d(g,1) == 0.0_r8 )then + if ( any( sand3d(g,:)+clay3d(g,:) /= 0.0_r8 ) )then + call endrun(msg='found depth points that do NOT sum to zero when surface does'//& + errMsg(__FILE__, __LINE__)) + end if + sand3d(g,:) = 1.0_r8 + clay3d(g,:) = 1.0_r8 + end if + if ( any( sand3d(g,:)+clay3d(g,:) == 0.0_r8 ) )then + call endrun(msg='after setting, found points sum to zero'//errMsg(__FILE__, __LINE__)) + end if + + soilstate_inst%sandfrac_patch(p) = sand3d(g,1)/100.0_r8 + soilstate_inst%clayfrac_patch(p) = clay3d(g,1)/100.0_r8 + end do + + ! Read fmax + + allocate(gti(begg:endg)) + call ncd_io(ncid=ncid, varname='FMAX', flag='read', data=gti, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: FMAX NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + do c = begc, endc + g = col%gridcell(c) + soilstate_inst%wtfact_col(c) = gti(g) + end do + deallocate(gti) + + ! Close file + + call ncd_pio_closefile(ncid) + + ! -------------------------------------------------------------------- + ! get original soil depths to be used in interpolation of sand and clay + ! -------------------------------------------------------------------- + + allocate(zsoifl(1:nlevsoifl), zisoifl(0:nlevsoifl), dzsoifl(1:nlevsoifl)) + do j = 1, nlevsoifl + zsoifl(j) = 0.025*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths + enddo + + dzsoifl(1) = 0.5_r8*(zsoifl(1)+zsoifl(2)) !thickness b/n two interfaces + do j = 2,nlevsoifl-1 + dzsoifl(j)= 0.5_r8*(zsoifl(j+1)-zsoifl(j-1)) + enddo + dzsoifl(nlevsoifl) = zsoifl(nlevsoifl)-zsoifl(nlevsoifl-1) + + zisoifl(0) = 0._r8 + do j = 1, nlevsoifl-1 + zisoifl(j) = 0.5_r8*(zsoifl(j)+zsoifl(j+1)) !interface depths + enddo + zisoifl(nlevsoifl) = zsoifl(nlevsoifl) + 0.5_r8*dzsoifl(nlevsoifl) + + ! -------------------------------------------------------------------- + ! Set soil hydraulic and thermal properties: non-lake + ! -------------------------------------------------------------------- + + ! urban roof, sunwall and shadewall thermal properties used to + ! derive thermal conductivity and heat capacity are set to special + ! value because thermal conductivity and heat capacity for urban + ! roof, sunwall and shadewall are prescribed in SoilThermProp.F90 + ! in SoilPhysicsMod.F90 + + + do c = begc, endc + g = col%gridcell(c) + l = col%landunit(c) + + if (lun%itype(l)==istwet .or. lun%itype(l)==istice .or. lun%itype(l)==istice_mec) then + + do lev = 1,nlevgrnd + soilstate_inst%bsw_col(c,lev) = spval + soilstate_inst%watsat_col(c,lev) = spval + soilstate_inst%watfc_col(c,lev) = spval + soilstate_inst%hksat_col(c,lev) = spval + soilstate_inst%sucsat_col(c,lev) = spval + soilstate_inst%watdry_col(c,lev) = spval + soilstate_inst%watopt_col(c,lev) = spval + soilstate_inst%bd_col(c,lev) = spval + if (lev <= nlevsoi) then + soilstate_inst%cellsand_col(c,lev) = spval + soilstate_inst%cellclay_col(c,lev) = spval + soilstate_inst%cellorg_col(c,lev) = spval + end if + end do + + do lev = 1,nlevgrnd + soilstate_inst%tkmg_col(c,lev) = spval + soilstate_inst%tksatu_col(c,lev) = spval + soilstate_inst%tkdry_col(c,lev) = spval + if (lun%itype(l)==istwet .and. lev > nlevsoi) then + soilstate_inst%csol_col(c,lev) = csol_bedrock + else + soilstate_inst%csol_col(c,lev)= spval + endif + end do + + else if (lun%urbpoi(l) .and. (col%itype(c) /= icol_road_perv) .and. (col%itype(c) /= icol_road_imperv) )then + + ! Urban Roof, sunwall, shadewall properties set to special value + do lev = 1,nlevgrnd + soilstate_inst%watsat_col(c,lev) = spval + soilstate_inst%watfc_col(c,lev) = spval + soilstate_inst%bsw_col(c,lev) = spval + soilstate_inst%hksat_col(c,lev) = spval + soilstate_inst%sucsat_col(c,lev) = spval + soilstate_inst%watdry_col(c,lev) = spval + soilstate_inst%watopt_col(c,lev) = spval + soilstate_inst%bd_col(c,lev) = spval + if (lev <= nlevsoi) then + soilstate_inst%cellsand_col(c,lev) = spval + soilstate_inst%cellclay_col(c,lev) = spval + soilstate_inst%cellorg_col(c,lev) = spval + end if + end do + + do lev = 1,nlevgrnd + soilstate_inst%tkmg_col(c,lev) = spval + soilstate_inst%tksatu_col(c,lev) = spval + soilstate_inst%tkdry_col(c,lev) = spval + soilstate_inst%csol_col(c,lev) = spval + end do + + else + + do lev = 1,nlevgrnd + + if ( more_vertlayers )then ! duplicate clay and sand values from last soil layer + + if (lev .eq. 1) then + clay = clay3d(g,1) + sand = sand3d(g,1) + om_frac = organic3d(g,1)/organic_max + else if (lev <= nlevsoi) then + do j = 1,nlevsoifl-1 + if (zisoi(lev) >= zisoifl(j) .AND. zisoi(lev) < zisoifl(j+1)) then + clay = clay3d(g,j+1) + sand = sand3d(g,j+1) + om_frac = organic3d(g,j+1)/organic_max + endif + end do + else + clay = clay3d(g,nlevsoifl) + sand = sand3d(g,nlevsoifl) + om_frac = 0._r8 + endif + else + if (lev <= nlevsoi) then ! duplicate clay and sand values from 10th soil layer + clay = clay3d(g,lev) + sand = sand3d(g,lev) + if ( organic_frac_squared )then + om_frac = (organic3d(g,lev)/organic_max)**2._r8 + else + om_frac = organic3d(g,lev)/organic_max + end if + else + clay = clay3d(g,nlevsoi) + sand = sand3d(g,nlevsoi) + om_frac = 0._r8 + endif + end if + + if (lun%itype(l) == istdlak) then + + if (lev <= nlevsoi) then + soilstate_inst%cellsand_col(c,lev) = sand + soilstate_inst%cellclay_col(c,lev) = clay + soilstate_inst%cellorg_col(c,lev) = om_frac*organic_max + end if + + else if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types + + if (lun%urbpoi(l)) then + om_frac = 0._r8 ! No organic matter for urban + end if + + if (lev <= nlevsoi) then + soilstate_inst%cellsand_col(c,lev) = sand + soilstate_inst%cellclay_col(c,lev) = clay + soilstate_inst%cellorg_col(c,lev) = om_frac*organic_max + end if + + ! Note that the following properties are overwritten for urban impervious road + ! layers that are not soil in SoilThermProp.F90 within SoilTemperatureMod.F90 + + !determine the type of pedotransfer function to be used based on soil order + !I will use the following implementation to further explore the ET problem, now + !I set soil order to 0 for all soils. Jinyun Tang, Mar 20, 2014 + + ipedof=get_ipedof(0) + call pedotransf(ipedof, sand, clay, & + soilstate_inst%watsat_col(c,lev), soilstate_inst%bsw_col(c,lev), soilstate_inst%sucsat_col(c,lev), xksat) + + om_watsat = max(0.93_r8 - 0.1_r8 *(zsoi(lev)/zsapric), 0.83_r8) + om_b = min(2.7_r8 + 9.3_r8 *(zsoi(lev)/zsapric), 12.0_r8) + om_sucsat = min(10.3_r8 - 0.2_r8 *(zsoi(lev)/zsapric), 10.1_r8) + om_hksat = max(0.28_r8 - 0.2799_r8*(zsoi(lev)/zsapric), 0.0001_r8) + + soilstate_inst%bd_col(c,lev) = (1._r8 - soilstate_inst%watsat_col(c,lev))*2.7e3_r8 + soilstate_inst%watsat_col(c,lev) = (1._r8 - om_frac) * soilstate_inst%watsat_col(c,lev) + om_watsat*om_frac + tkm = (1._r8-om_frac) * (8.80_r8*sand+2.92_r8*clay)/(sand+clay)+om_tkm*om_frac ! W/(m K) + soilstate_inst%bsw_col(c,lev) = (1._r8-om_frac) * (2.91_r8 + 0.159_r8*clay) + om_frac*om_b + soilstate_inst%sucsat_col(c,lev) = (1._r8-om_frac) * soilstate_inst%sucsat_col(c,lev) + om_sucsat*om_frac + soilstate_inst%hksat_min_col(c,lev) = xksat + + ! perc_frac is zero unless perf_frac greater than percolation threshold + if (om_frac > pcalpha) then + perc_norm=(1._r8 - pcalpha)**(-pcbeta) + perc_frac=perc_norm*(om_frac - pcalpha)**pcbeta + else + perc_frac=0._r8 + endif + + ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil + uncon_frac=(1._r8-om_frac)+(1._r8-perc_frac)*om_frac + + ! uncon_hksat is series addition of mineral/organic conductivites + if (om_frac < 1._r8) then + uncon_hksat=uncon_frac/((1._r8-om_frac)/xksat & + +((1._r8-perc_frac)*om_frac)/om_hksat) + else + uncon_hksat = 0._r8 + end if + soilstate_inst%hksat_col(c,lev) = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat + + soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev)) + + soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev) + + soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*soilstate_inst%bd_col(c,lev) + 64.7_r8) / & + (2.7e3_r8 - 0.947_r8*soilstate_inst%bd_col(c,lev)))*(1._r8-om_frac) + om_tkd*om_frac + + soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) + & + om_csol*om_frac)*1.e6_r8 ! J/(m3 K) + + if (lev > nlevsoi) then + soilstate_inst%csol_col(c,lev) = csol_bedrock + endif + + soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & + (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) + soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & + (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) + + !! added by K.Sakaguchi for beta from Lee and Pielke, 1992 + ! water content at field capacity, defined as hk = 0.1 mm/day + ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / secspday (day/sec) + soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * & + (0.1_r8 / (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8)) + end if + end do + + ! Urban pervious and impervious road + if (col%itype(c) == icol_road_imperv) then + ! Impervious road layers -- same as above except set watdry and watopt as missing + do lev = 1,nlevgrnd + soilstate_inst%watdry_col(c,lev) = spval + soilstate_inst%watopt_col(c,lev) = spval + end do + else if (col%itype(c) == icol_road_perv) then + ! pervious road layers - set in UrbanInitTimeConst + end if + + end if + end do + + ! -------------------------------------------------------------------- + ! Set soil hydraulic and thermal properties: lake + ! -------------------------------------------------------------------- + + do c = begc, endc + g = col%gridcell(c) + l = col%landunit(c) + + if (lun%itype(l)==istdlak) then + + do lev = 1,nlevgrnd + if ( lev <= nlevsoi )then + clay = soilstate_inst%cellclay_col(c,lev) + sand = soilstate_inst%cellsand_col(c,lev) + if ( organic_frac_squared )then + om_frac = (soilstate_inst%cellorg_col(c,lev)/organic_max)**2._r8 + else + om_frac = soilstate_inst%cellorg_col(c,lev)/organic_max + end if + else + clay = soilstate_inst%cellclay_col(c,nlevsoi) + sand = soilstate_inst%cellsand_col(c,nlevsoi) + om_frac = 0.0_r8 + end if + + soilstate_inst%watsat_col(c,lev) = 0.489_r8 - 0.00126_r8*sand + + soilstate_inst%bsw_col(c,lev) = 2.91 + 0.159*clay + + soilstate_inst%sucsat_col(c,lev) = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) ) + + bd = (1._r8-soilstate_inst%watsat_col(c,lev))*2.7e3_r8 + + soilstate_inst%watsat_col(c,lev) = (1._r8 - om_frac)*soilstate_inst%watsat_col(c,lev) + om_watsat_lake * om_frac + + tkm = (1._r8-om_frac)*(8.80_r8*sand+2.92_r8*clay)/(sand+clay) + om_tkm * om_frac ! W/(m K) + + soilstate_inst%bsw_col(c,lev) = (1._r8-om_frac)*(2.91_r8 + 0.159_r8*clay) + om_frac * om_b_lake + + soilstate_inst%sucsat_col(c,lev) = (1._r8-om_frac)*soilstate_inst%sucsat_col(c,lev) + om_sucsat_lake * om_frac + + xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s + + ! perc_frac is zero unless perf_frac greater than percolation threshold + if (om_frac > pc_lake) then + perc_norm = (1._r8 - pc_lake)**(-pcbeta) + perc_frac = perc_norm*(om_frac - pc_lake)**pcbeta + else + perc_frac = 0._r8 + endif + + ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil + uncon_frac = (1._r8-om_frac) + (1._r8-perc_frac)*om_frac + + ! uncon_hksat is series addition of mineral/organic conductivites + if (om_frac < 1._r8) then + xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s + uncon_hksat = uncon_frac/((1._r8-om_frac)/xksat + ((1._r8-perc_frac)*om_frac)/om_hksat_lake) + else + uncon_hksat = 0._r8 + end if + + soilstate_inst%hksat_col(c,lev) = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat_lake + soilstate_inst%tkmg_col(c,lev) = tkm ** (1._r8- soilstate_inst%watsat_col(c,lev)) + soilstate_inst%tksatu_col(c,lev) = soilstate_inst%tkmg_col(c,lev)*0.57_r8**soilstate_inst%watsat_col(c,lev) + soilstate_inst%tkdry_col(c,lev) = ((0.135_r8*bd + 64.7_r8) / (2.7e3_r8 - 0.947_r8*bd))*(1._r8-om_frac) + & + om_tkd * om_frac + soilstate_inst%csol_col(c,lev) = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) + & + om_csol * om_frac)*1.e6_r8 ! J/(m3 K) + if (lev > nlevsoi) then + soilstate_inst%csol_col(c,lev) = csol_bedrock + endif + + soilstate_inst%watdry_col(c,lev) = soilstate_inst%watsat_col(c,lev) & + * (316230._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) + soilstate_inst%watopt_col(c,lev) = soilstate_inst%watsat_col(c,lev) & + * (158490._r8/soilstate_inst%sucsat_col(c,lev)) ** (-1._r8/soilstate_inst%bsw_col(c,lev)) + + !! added by K.Sakaguchi for beta from Lee and Pielke, 1992 + ! water content at field capacity, defined as hk = 0.1 mm/day + ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / (# seconds/day) + soilstate_inst%watfc_col(c,lev) = soilstate_inst%watsat_col(c,lev) * (0.1_r8 / & + (soilstate_inst%hksat_col(c,lev)*secspday))**(1._r8/(2._r8*soilstate_inst%bsw_col(c,lev)+3._r8)) + end do + endif + + end do + + ! -------------------------------------------------------------------- + ! Initialize threshold soil moisture and mass fracion of clay limited to 0.20 + ! -------------------------------------------------------------------- + + do c = begc,endc + g = col%gridcell(c) + + soilstate_inst%gwc_thr_col(c) = 0.17_r8 + 0.14_r8 * clay3d(g,1) * 0.01_r8 + soilstate_inst%mss_frc_cly_vld_col(c) = min(clay3d(g,1) * 0.01_r8, 0.20_r8) + end do + + ! -------------------------------------------------------------------- + ! Deallocate memory + ! -------------------------------------------------------------------- + + deallocate(sand3d, clay3d, organic3d) + deallocate(zisoifl, zsoifl, dzsoifl) + + end subroutine SoilStateInitTimeConst + +end module SoilStateInitTimeConstMod diff --git a/components/clm/src/biogeophys/SoilStateType.F90 b/components/clm/src/biogeophys/SoilStateType.F90 new file mode 100644 index 0000000000..efe2c06ce2 --- /dev/null +++ b/components/clm/src/biogeophys/SoilStateType.F90 @@ -0,0 +1,292 @@ +module SoilStateType + + !------------------------------------------------------------------------------ + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, nlayer, nlevsno + use clm_varcon , only : spval + use clm_varctl , only : use_cn, use_lch4 + use clm_varctl , only : iulog, hist_wrtch4diag + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + type, public :: soilstate_type + + ! sand/ clay/ organic matter + real(r8), pointer :: sandfrac_patch (:) ! patch sand fraction + real(r8), pointer :: clayfrac_patch (:) ! patch clay fraction + real(r8), pointer :: mss_frc_cly_vld_col (:) ! col mass fraction clay limited to 0.20 + real(r8), pointer :: cellorg_col (:,:) ! col organic matter for gridcell containing column (1:nlevsoi) + real(r8), pointer :: cellsand_col (:,:) ! sand value for gridcell containing column (1:nlevsoi) + real(r8), pointer :: cellclay_col (:,:) ! clay value for gridcell containing column (1:nlevsoi) + real(r8), pointer :: bd_col (:,:) ! col bulk density of dry soil material [kg/m^3] (CN) + + ! hydraulic properties + real(r8), pointer :: hksat_col (:,:) ! col hydraulic conductivity at saturation (mm H2O /s) + real(r8), pointer :: hksat_min_col (:,:) ! col mineral hydraulic conductivity at saturation (hksat) (mm/s) + real(r8), pointer :: hk_l_col (:,:) ! col hydraulic conductivity (mm/s) + real(r8), pointer :: smp_l_col (:,:) ! col soil matric potential (mm) + real(r8), pointer :: smpmin_col (:) ! col restriction for min of soil potential (mm) + real(r8), pointer :: bsw_col (:,:) ! col Clapp and Hornberger "b" (nlevgrnd) + real(r8), pointer :: watsat_col (:,:) ! col volumetric soil water at saturation (porosity) + real(r8), pointer :: watdry_col (:,:) ! col btran parameter for btran = 0 + real(r8), pointer :: watopt_col (:,:) ! col btran parameter for btran = 1 + real(r8), pointer :: watfc_col (:,:) ! col volumetric soil water at field capacity (nlevsoi) + real(r8), pointer :: sucsat_col (:,:) ! col minimum soil suction (mm) (nlevgrnd) + real(r8), pointer :: soilbeta_col (:) ! col factor that reduces ground evaporation L&P1992(-) + real(r8), pointer :: soilalpha_col (:) ! col factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: soilalpha_u_col (:) ! col urban factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: soilpsi_col (:,:) ! col soil water potential in each soil layer (MPa) (CN) + real(r8), pointer :: wtfact_col (:) ! col maximum saturated fraction for a gridcell + real(r8), pointer :: porosity_col (:,:) ! col soil porisity (1-bulk_density/soil_density) (VIC) + real(r8), pointer :: eff_porosity_col (:,:) ! col effective porosity = porosity - vol_ice (nlevgrnd) + real(r8), pointer :: gwc_thr_col (:) ! col threshold soil moisture based on clay content + + ! thermal conductivity / heat capacity + real(r8), pointer :: thk_col (:,:) ! col thermal conductivity of each layer [W/m-K] + real(r8), pointer :: tkmg_col (:,:) ! col thermal conductivity, soil minerals [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: tkdry_col (:,:) ! col thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) + real(r8), pointer :: tksatu_col (:,:) ! col thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: csol_col (:,:) ! col heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) + + ! roots + real(r8), pointer :: rootr_patch (:,:) ! patch effective fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootr_col (:,:) ! col effective fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootfr_col (:,:) ! col fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootfr_patch (:,:) ! patch fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road + real(r8), pointer :: rootfr_road_perv_col (:,:) ! col effective fraction of roots in each soil layer of urban pervious road + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type soilstate_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(soilstate_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !ARGUMENTS: + class(soilstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%mss_frc_cly_vld_col (begc:endc)) ; this%mss_frc_cly_vld_col (:) = nan + allocate(this%sandfrac_patch (begp:endp)) ; this%sandfrac_patch (:) = nan + allocate(this%clayfrac_patch (begp:endp)) ; this%clayfrac_patch (:) = nan + allocate(this%cellorg_col (begc:endc,nlevsoi)) ; this%cellorg_col (:,:) = nan + allocate(this%cellsand_col (begc:endc,nlevsoi)) ; this%cellsand_col (:,:) = nan + allocate(this%cellclay_col (begc:endc,nlevsoi)) ; this%cellclay_col (:,:) = nan + allocate(this%bd_col (begc:endc,nlevgrnd)) ; this%bd_col (:,:) = nan + + allocate(this%hksat_col (begc:endc,nlevgrnd)) ; this%hksat_col (:,:) = spval + allocate(this%hksat_min_col (begc:endc,nlevgrnd)) ; this%hksat_min_col (:,:) = spval + allocate(this%hk_l_col (begc:endc,nlevgrnd)) ; this%hk_l_col (:,:) = nan + allocate(this%smp_l_col (begc:endc,nlevgrnd)) ; this%smp_l_col (:,:) = nan + allocate(this%smpmin_col (begc:endc)) ; this%smpmin_col (:) = nan + + allocate(this%bsw_col (begc:endc,nlevgrnd)) ; this%bsw_col (:,:) = nan + allocate(this%watsat_col (begc:endc,nlevgrnd)) ; this%watsat_col (:,:) = nan + allocate(this%watdry_col (begc:endc,nlevgrnd)) ; this%watdry_col (:,:) = spval + allocate(this%watopt_col (begc:endc,nlevgrnd)) ; this%watopt_col (:,:) = spval + allocate(this%watfc_col (begc:endc,nlevgrnd)) ; this%watfc_col (:,:) = nan + allocate(this%sucsat_col (begc:endc,nlevgrnd)) ; this%sucsat_col (:,:) = spval + allocate(this%soilbeta_col (begc:endc)) ; this%soilbeta_col (:) = nan + allocate(this%soilalpha_col (begc:endc)) ; this%soilalpha_col (:) = nan + allocate(this%soilalpha_u_col (begc:endc)) ; this%soilalpha_u_col (:) = nan + allocate(this%soilpsi_col (begc:endc,nlevgrnd)) ; this%soilpsi_col (:,:) = nan + allocate(this%wtfact_col (begc:endc)) ; this%wtfact_col (:) = nan + allocate(this%porosity_col (begc:endc,nlayer)) ; this%porosity_col (:,:) = spval + allocate(this%eff_porosity_col (begc:endc,nlevgrnd)) ; this%eff_porosity_col (:,:) = spval + allocate(this%gwc_thr_col (begc:endc)) ; this%gwc_thr_col (:) = nan + + allocate(this%thk_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%thk_col (:,:) = nan + allocate(this%tkmg_col (begc:endc,nlevgrnd)) ; this%tkmg_col (:,:) = nan + allocate(this%tkdry_col (begc:endc,nlevgrnd)) ; this%tkdry_col (:,:) = nan + allocate(this%tksatu_col (begc:endc,nlevgrnd)) ; this%tksatu_col (:,:) = nan + allocate(this%csol_col (begc:endc,nlevgrnd)) ; this%csol_col (:,:) = nan + + allocate(this%rootr_patch (begp:endp,1:nlevgrnd)) ; this%rootr_patch (:,:) = nan + allocate(this%rootr_col (begc:endc,nlevgrnd)) ; this%rootr_col (:,:) = nan + allocate(this%rootr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootr_road_perv_col (:,:) = nan + allocate(this%rootfr_patch (begp:endp,1:nlevgrnd)) ; this%rootfr_patch (:,:) = nan + allocate(this%rootfr_col (begc:endc,1:nlevgrnd)) ; this%rootfr_col (:,:) = nan + allocate(this%rootfr_road_perv_col (begc:endc,1:nlevgrnd)) ; this%rootfr_road_perv_col (:,:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use histFileMod , only: hist_addfld1d, hist_addfld2d, no_snow_normal + ! + ! !ARGUMENTS: + class(soilstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begp, endp + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + + if (use_lch4) then + if (hist_wrtch4diag) then + active = "active" + else + active = "inactive" + end if + else + active = "inactive" + end if + call hist_addfld2d (fname='SMP', units='mm', type2d='levgrnd', & + avgflag='A', long_name='soil matric potential (vegetated landunits only)', & + ptr_col=this%smp_l_col, set_spec=spval, l2g_scale_type='veg', default=active) + + if (use_cn) then + this%bsw_col(begc:endc,:) = spval + call hist_addfld2d (fname='bsw', units='unitless', type2d='levgrnd', & + avgflag='A', long_name='clap and hornberger B', & + ptr_col=this%bsw_col, default='inactive') + end if + + if (use_cn) then + this%rootfr_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ROOTFR', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='fraction of roots in each soil layer', & + ptr_patch=this%rootfr_patch, default='inactive') + end if + + if (use_cn) then + this%rootr_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ROOTR', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective fraction of roots in each soil layer', & + ptr_patch=this%rootr_patch, default='inactive') + end if + + if (use_cn) then + this%rootr_col(begc:endc,:) = spval + call hist_addfld2d (fname='ROOTR_COLUMN', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective fraction of roots in each soil layer', & + ptr_col=this%rootr_col, default='inactive') + + end if + + if (use_cn) then + this%soilpsi_col(begc:endc,:) = spval + call hist_addfld2d (fname='SOILPSI', units='MPa', type2d='levgrnd', & + avgflag='A', long_name='soil water potential in each soil layer', & + ptr_col=this%soilpsi_col) + end if + + this%thk_col(begc:endc,-nlevsno+1:0) = spval + data2dptr => this%thk_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_TK', units='W/m-K', type2d='levsno', & + avgflag='A', long_name='Thermal conductivity', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%hk_l_col(begc:endc,:) = spval + call hist_addfld2d (fname='HK', units='mm/s', type2d='levgrnd', & + avgflag='A', long_name='hydraulic conductivity (vegetated landunits only)', & + ptr_col=this%hk_l_col, set_spec=spval, l2g_scale_type='veg', default='inactive') + + this%soilalpha_col(begc:endc) = spval + call hist_addfld1d (fname='SoilAlpha', units='unitless', & + avgflag='A', long_name='factor limiting ground evap', & + ptr_col=this%soilalpha_col, set_urb=spval) + + this%soilalpha_u_col(begc:endc) = spval + call hist_addfld1d (fname='SoilAlpha_U', units='unitless', & + avgflag='A', long_name='urban factor limiting ground evap', & + ptr_col=this%soilalpha_u_col, set_nourb=spval) + + if (use_cn) then + this%watsat_col(begc:endc,:) = spval + call hist_addfld2d (fname='watsat', units='m^3/m^3', type2d='levgrnd', & + avgflag='A', long_name='water saturated', & + ptr_col=this%watsat_col, default='inactive') + end if + + if (use_cn) then + this%eff_porosity_col(begc:endc,:) = spval + call hist_addfld2d (fname='EFF_POROSITY', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective porosity = porosity - vol_ice', & + ptr_col=this%eff_porosity_col, default='inactive') + end if + + if (use_cn) then + this%watfc_col(begc:endc,:) = spval + call hist_addfld2d (fname='watfc', units='m^3/m^3', type2d='levgrnd', & + avgflag='A', long_name='water field capacity', & + ptr_col=this%watfc_col, default='inactive') + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! Initialize module surface albedos to reasonable values + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soilstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + !----------------------------------------------------------------------- + + ! Nothing for now + + end subroutine InitCold + +end module SoilStateType diff --git a/components/clm/src/biogeophys/SoilTemperatureMod.F90 b/components/clm/src/biogeophys/SoilTemperatureMod.F90 new file mode 100644 index 0000000000..a9ff51e880 --- /dev/null +++ b/components/clm/src/biogeophys/SoilTemperatureMod.F90 @@ -0,0 +1,4752 @@ +module SoilTemperatureMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates snow and soil temperatures including phase change + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : iulog + use UrbanParamsType , only : urbanparams_type + use atm2lndType , only : atm2lnd_type + use CanopyStateType , only : canopystate_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use SolarAbsorbedType , only : solarabs_type + use SoilStateType , only : soilstate_type + use EnergyFluxType , only : energyflux_type + use TemperatureType , only : temperature_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilTemperature + ! + ! -> SoilTemperature: soil/snow and ground temperatures + ! -> SoilTermProp thermal conductivities and heat capacities + ! -> Tridiagonal tridiagonal matrix solution + ! -> PhaseChange phase change of liquid/ice contents + ! + ! (1) Snow and soil temperatures + ! o The volumetric heat capacity is calculated as a linear combination + ! in terms of the volumetric fraction of the constituent phases. + ! o The thermal conductivity of soil is computed from + ! the algorithm of Johansen (as reported by Farouki 1981), and the + ! conductivity of snow is from the formulation used in + ! SNTHERM (Jordan 1991). + ! o Boundary conditions: + ! F = Rnet - Hg - LEg (top), F= 0 (base of the soil column). + ! o Soil / snow temperature is predicted from heat conduction + ! in 10 soil layers and up to nlevsno snow layers. + ! The thermal conductivities at the interfaces between two + ! neighboring layers (j, j+1) are derived from an assumption that + ! the flux across the interface is equal to that from the node j + ! to the interface and the flux from the interface to the node j+1. + ! The equation is solved using the Crank-Nicholson method and + ! results in a tridiagonal system equation. + ! (2) Phase change + ! + ! The following is only public for the sake of unit testing; it should not be called + ! directly by CLM code outside this module + public :: ComputeGroundHeatFluxAndDeriv ! Computes G and dG/dT on surface of standing water, snow and soil + public :: ComputeHeatDiffFluxAndFactor ! Heat diffusion at layer interface and factor used in setting up of banded matrix + public :: SetRHSVec ! Sets up the RHS vector for the numerical solution of temperature for snow/standing-water/soil + public :: SetRHSVec_Snow ! Sets up the RHS vector corresponding to snow layers for Urban+Non-Urban columns + public :: SetRHSVec_SnowUrban ! Sets up the RHS vector corresponding to snow layers for Urban columns + public :: SetRHSVec_SnowUrbanNonRoad ! Sets up the RHS vector corresponding to snow layers for Urban columns that are sunwall, shadewall, and roof columns + public :: SetRHSVec_SnowUrbanRoad ! Sets up the RHS vector corresponding to snow layers for Urban columns that are pervious, and impervious columns + public :: SetRHSVec_SnowNonUrban ! Sets up the RHS vector corresponding to snow layers for Non-Urban columns + public :: SetRHSVec_StandingSurfaceWater ! Sets up the RHS vector corresponding to standing water layers for Urban+Non-Urban columns + public :: SetRHSVec_Soil ! Sets up the RHS vector corresponding to soil layers for Urban+Non-Urban columns + public :: SetRHSVec_SoilUrban ! Sets up the RHS vector corresponding to soil layers for Urban columns + public :: SetRHSVec_SoilUrbanNonRoad ! Sets up the RHS vector corresponding to soil layers for Urban columns that are pervious, and impervious columns + public :: SetRHSVec_SoilUrbanRoad ! Sets up the RHS vector corresponding to soil layers for Urban columns that are pervious, and impervious columns + public :: SetRHSVec_SoilNonUrban ! Sets up the RHS vector corresponding to soil layers for Non-Urban columns + public :: SetRHSVec_Soil_StandingSurfaceWater ! Adds contribution from standing water in the RHS vector corresponding to soil layers + public :: SetMatrix ! Sets up the matrix for the numerical solution of temperature for snow/standing-water/soil + public :: AssembleMatrixFromSubmatrices ! Assemble the full matrix from submatrices. + public :: SetMatrix_Snow ! Set up the matrix entries corresponding to snow layers for Urban+Non-Urban columns + public :: SetMatrix_SnowUrban ! Set up the matrix entries corresponding to snow layers for Urban column + public :: SetMatrix_SnowUrbanNonRoad ! Set up the matrix entries corresponding to snow layers for Urban column that are sunwall, shadewall, and roof columns + public :: SetMatrix_SnowUrbanRoad ! Set up the matrix entries corresponding to snow layers for Urban column that are pervious, and impervious columns + public :: SetMatrix_SnowNonUrban ! Set up the matrix entries corresponding to snow layers for Non-Urban column + public :: SetMatrix_Snow_Soil ! Set up the matrix entries corresponding to snow-soil interaction + public :: SetMatrix_Snow_SoilUrban ! Set up the matrix entries corresponding to snow-soil interaction for Urban column + public :: SetMatrix_Snow_SoilUrbanNonRoad ! Set up the matrix entries corresponding to snow-soil interaction for Urban column that are sunwall, shadewall, and roof columns + public :: SetMatrix_Snow_SoilUrbanRoad ! Set up the matrix entries corresponding to snow-soil interaction for Urban column that are pervious, and impervious columns + public :: SetMatrix_Snow_SoilNonUrban ! Set up the matrix entries corresponding to snow-soil interaction for Non-Urban column + public :: SetMatrix_Soil ! Set up the matrix entries corresponding to soil layers for Urban+Non-Urban columns + public :: SetMatrix_SoilUrban ! Set up the matrix entries corresponding to soil layers for Urban column + public :: SetMatrix_SoilUrbanNonRoad ! Set up the matrix entries corresponding to soil layers for Urban column that are sunwall, shadewall, and roof columns + public :: SetMatrix_SoilUrbanRoad ! Set up the matrix entries corresponding to soil layers for Urban column that are pervious, and impervious columns + public :: SetMatrix_SoilNonUrban ! Set up the matrix entries corresponding to soil layers for Non-Urban column + public :: SetMatrix_Soil_Snow ! Set up the matrix entries corresponding to soil-snow interction for Urban+Non-Urban columns + public :: SetMatrix_Soil_SnowUrban ! Set up the matrix entries corresponding to soil-snow interction for Urban column + public :: SetMatrix_Soil_SnowUrbanNonRoad ! Set up the matrix entries corresponding to soil-snow interction for Urban column that are sunwall, shadewall, and roof columns + public :: SetMatrix_Soil_SnowUrbanRoad ! Set up the matrix entries corresponding to soil-snow interction for Urban column that are pervious, and impervious columns + public :: SetMatrix_Soil_SnowNonUrban ! Set up the matrix entries corresponding to soil-snow interction for Non-Urban column + public :: SetMatrix_StandingSurfaceWater ! Set up the matrix entries corresponding to standing surface water + public :: SetMatrix_StandingSurfaceWater_Soil ! Set up the matrix entries corresponding to standing surface water-soil interaction + public :: SetMatrix_Soil_StandingSurfaceWater ! Set up the matrix entries corresponding to soil-standing surface water interction + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: SoilThermProp ! Set therm conduct. and heat cap of snow/soil layers + private :: PhaseChangeH2osfc ! When surface water freezes move ice to bottom snow layer + private :: PhaseChange_beta ! Calculation of the phase change within snow and soil layers + private :: BuildingHAC ! Building Heating and Cooling for simpler method (introduced in CLM4.5) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilTemperature(bounds, num_urbanl, filter_urbanl, num_nolakec, filter_nolakec, & + atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstate_inst, waterflux_inst,& + solarabs_inst, soilstate_inst, energyflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Snow and soil temperatures including phase change + ! o The volumetric heat capacity is calculated as a linear combination + ! in terms of the volumetric fraction of the constituent phases. + ! o The thermal conductivity of soil is computed from + ! the algorithm of Johansen (as reported by Farouki 1981), and the + ! conductivity of snow is from the formulation used in + ! SNTHERM (Jordan 1991). + ! o Boundary conditions: + ! F = Rnet - Hg - LEg (top), F= 0 (base of the soil column). + ! o Soil / snow temperature is predicted from heat conduction + ! in 10 soil layers and up to nlevsno snow layers. + ! The thermal conductivities at the interfaces between two + ! neighboring layers (j, j+1) are derived from an assumption that + ! the flux across the interface is equal to that from the node j + ! to the interface and the flux from the interface to the node j+1. + ! The equation is solved using the Crank-Nicholson method and + ! results in a tridiagonal system equation. + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + use clm_varctl , only : iulog + use clm_varcon , only : cnfac, cpice, cpliq, denh2o + use landunit_varcon , only : istice, istice_mec, istsoil, istcrop + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv + use landunit_varcon , only : istwet, istice, istice_mec, istsoil, istcrop + use BandDiagonalMod , only : BandDiagonal + use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp + use UrbBuildTempOleson2015Mod, only : BuildingTemperature + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,l,g,pi ! indices + integer :: fc ! lake filtered column indices + integer :: fl ! urban filtered landunit indices + integer :: jtop(bounds%begc:bounds%endc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + real(r8) :: cv (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! heat capacity [J/(m2 K)] + real(r8) :: tk (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! thermal conductivity [W/(m K)] + real(r8) :: fn (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! heat diffusion through the layer interface [W/m2] + real(r8) :: fn1(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! heat diffusion through the layer interface [W/m2] + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: sabg_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:1) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) :: eflx_gnet_top ! net energy flux into surface layer, patch-level [W/m2] + real(r8) :: hs_top(bounds%begc:bounds%endc) ! net energy flux into surface layer (col) [W/m2] + logical :: cool_on(bounds%begl:bounds%endl) ! is urban air conditioning on? + logical :: heat_on(bounds%begl:bounds%endl) ! is urban heating on? + real(r8) :: fn_h2osfc(bounds%begc:bounds%endc) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8) :: dz_h2osfc(bounds%begc:bounds%endc) ! height of standing surface water [m] + integer, parameter :: nband=5 + real(r8) :: bmatrix(bounds%begc:bounds%endc,nband,-nlevsno:nlevgrnd) ! banded matrix for numerical solution of temperature + real(r8) :: tvector(bounds%begc:bounds%endc,-nlevsno:nlevgrnd) ! initial temperature solution [Kelvin] + real(r8) :: rvector(bounds%begc:bounds%endc,-nlevsno:nlevgrnd) ! RHS vector for numerical solution of temperature + real(r8) :: tk_h2osfc(bounds%begc:bounds%endc) ! thermal conductivity of h2osfc [W/(m K)] [col] + real(r8) :: dhsdT(bounds%begc:bounds%endc) ! temperature derivative of "hs" [col] + real(r8) :: hs_soil(bounds%begc:bounds%endc) ! heat flux on soil [W/m2] + real(r8) :: hs_top_snow(bounds%begc:bounds%endc) ! heat flux on top snow layer [W/m2] + real(r8) :: hs_h2osfc(bounds%begc:bounds%endc) ! heat flux on standing water [W/m2] + integer :: jbot(bounds%begc:bounds%endc) ! bottom level at each column + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + ctype => col%itype , & ! Input: [integer (:) ] column type + + + t_building_max => urbanparams_inst%t_building_max , & ! Input: [real(r8) (:) ] maximum internal building air temperature (K) + t_building_min => urbanparams_inst%t_building_min , & ! Input: [real(r8) (:) ] minimum internal building air temperature (K) + + + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + + + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface water (mm) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + + + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Input: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Input: [real(r8) (:) ] evaporation flux from snow (W/m**2) [+ to atm] + qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Input: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_patch , & ! Input: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + + + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg_chk => solarabs_inst%sabg_chk_patch , & ! Output: [real(r8) (:) ] sum of soil/snow using current fsno, for balance check + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Input: [real(r8) (:,:) ] absorbed solar radiation (pft,lyr) [W/m2] + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of vapor of water (or sublimation) [j/kg] + cgrnd => energyflux_inst%cgrnd_patch , & ! Input: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] + dlrad => energyflux_inst%dlrad_patch , & ! Input: [real(r8) (:) ] downward longwave radiation blow the canopy [W/m2] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Input: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Input: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] + eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Input: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Input: [real(r8) (:) ] sensible heat flux from surface water (W/m**2) [+ to atm] + eflx_bot => energyflux_inst%eflx_bot_col , & ! Input: [real(r8) (:) ] heat flux from beneath column (W/m**2) [+ = upward] + eflx_fgr12 => energyflux_inst%eflx_fgr12_col , & ! Input: [real(r8) (:) ] heat flux between soil layer 1 and 2 (W/m2) + eflx_fgr => energyflux_inst%eflx_fgr_col , & ! Input: [real(r8) (:,:) ] (rural) soil downward heat flux (W/m2) (1:nlevgrnd) + eflx_traffic => energyflux_inst%eflx_traffic_lun , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_traffic_patch => energyflux_inst%eflx_traffic_patch , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_wasteheat => energyflux_inst%eflx_wasteheat_lun , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_wasteheat_patch => energyflux_inst%eflx_wasteheat_patch , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac => energyflux_inst%eflx_heat_from_ac_lun , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_heat_from_ac_patch => energyflux_inst%eflx_heat_from_ac_patch , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_anthro => energyflux_inst%eflx_anthro_patch , & ! Input: [real(r8) (:) ] total anthropogenic heat flux (W/m**2) + dgnetdT => energyflux_inst%dgnetdT_patch , & ! Output: [real(r8) (:) ] temperature derivative of ground net heat flux + eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [real(r8) (:) ] net ground heat flux into the surface (W/m**2) + eflx_building_heat_errsoi => energyflux_inst%eflx_building_heat_errsoi_col, & ! Output: [real(r8) (:)] heat flux from urban building interior to walls, roof (W/m**2) + eflx_urban_ac_col => energyflux_inst%eflx_urban_ac_col , & ! Output: [real(r8) (:) ] urban air conditioning flux (W/m**2) + eflx_urban_heat_col => energyflux_inst%eflx_urban_heat_col , & ! Output: [real(r8) (:) ] urban heating flux (W/m**2) + + emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity + hc_soi => temperature_inst%hc_soi_col , & ! Input: [real(r8) (:) ] soil heat content (MJ/m2) ! TODO: make a module variable + hc_soisno => temperature_inst%hc_soisno_col , & ! Input: [real(r8) (:) ] soil plus snow plus lake heat content (MJ/m2) !TODO: make a module variable + tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:) ] temperature at previous time step [K] + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Output: [real(r8) (:) ] surface water temperature + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + t_grnd => temperature_inst%t_grnd_col , & ! Output: [real(r8) (:) ] ground surface temperature [K] + t_building => temperature_inst%t_building_lun , & ! Output: [real(r8) (:) ] internal building air temperature (K) + t_roof_inner => temperature_inst%t_roof_inner_lun , & ! Input: [real(r8) (:) ] roof inside surface temperature (K) + t_sunw_inner => temperature_inst%t_sunw_inner_lun , & ! Input: [real(r8) (:) ] sunwall inside surface temperature (K) + t_shdw_inner => temperature_inst%t_shdw_inner_lun , & ! Input: [real(r8) (:) ] shadewall inside surface temperature (K) + xmf => temperature_inst%xmf_col , & ! Output: [real(r8) (:) ] melting or freezing within a time step [kg/m2] + xmf_h2osfc => temperature_inst%xmf_h2osfc_col , & ! Output: [real(r8) (:) ] latent heat of phase change of surface water [col] + fact => temperature_inst%fact_col , & ! Output: [real(r8) (:) ] used in computing tridiagonal matrix [col, lev] + c_h2osfc => temperature_inst%c_h2osfc_col , & ! Output: [real(r8) (:) ] heat capacity of surface water [col] + + begc => bounds%begc , & + endc => bounds%endc & + ) + + ! Get step size + + dtime = get_step_size() + + if ( IsSimpleBuildTemp() ) call BuildingHAC( bounds, num_urbanl, & + filter_urbanl, temperature_inst, & + urbanparams_inst, cool_on, heat_on ) + + + ! set up compact matrix for band diagonal solver, requires additional + ! sub/super diagonals (1 each), and one additional row for t_h2osfc + jtop = -9999 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + jtop(c) = snl(c) + ! compute jbot + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) ) then + jbot(c) = nlevurb + else + jbot(c) = nlevgrnd + endif + end do + + !------------------------------------------------------ + ! Compute ground surface and soil temperatures + !------------------------------------------------------ + + ! Thermal conductivity and Heat capacity + + tk_h2osfc(begc:endc) = nan + call SoilThermProp(bounds, num_nolakec, filter_nolakec, & + tk(begc:endc, :), & + cv(begc:endc, :), & + tk_h2osfc(begc:endc), & + urbanparams_inst, temperature_inst, waterstate_inst, soilstate_inst) + + ! Net ground heat flux into the surface and its temperature derivative + ! Added a patches loop here to get the average of hs and dhsdT over + ! all Patches on the column. Precalculate the terms that do not depend on PFT. + + call ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & + hs_h2osfc( begc:endc ), & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col( begc:endc, -nlevsno+1: ), & + atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstate_inst, & + waterflux_inst, solarabs_inst, energyflux_inst, temperature_inst) + + ! Determine heat diffusion through the layer interface and factor used in computing + ! banded diagonal matrix and set up vector r and vectors a, b, c that define banded + ! diagonal matrix and solve system + + call ComputeHeatDiffFluxAndFactor(bounds, num_nolakec, filter_nolakec, & + dtime, & + tk( begc:endc, -nlevsno+1: ), & + cv( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + energyflux_inst, temperature_inst) + + ! compute thermal properties of h2osfc + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + dz_h2osfc(c) = max(1.0e-6_r8,1.0e-3*h2osfc(c)) + c_h2osfc(c) = cpliq*denh2o*dz_h2osfc(c) !"areametric" heat capacity [J/K/m^2] + enddo + + + ! Set up vector r and vectors a, b, c that define tridiagonal + + call SetRHSVec(bounds, num_nolakec, filter_nolakec, & + dtime, & + hs_h2osfc( begc:endc ), & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + c_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + temperature_inst, & + waterstate_inst, & + rvector( begc:endc, -nlevsno: )) + + ! Set up the banded diagonal matrix + + call SetMatrix(bounds, num_nolakec, filter_nolakec, & + dtime, & + nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + c_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + waterstate_inst, & + bmatrix( begc:endc, 1:, -nlevsno: )) + + ! initialize initial temperature vector + + tvector(begc:endc, :) = nan + do fc = 1,num_nolakec + c = filter_nolakec(fc) + do j = snl(c)+1, 0 + tvector(c,j-1) = t_soisno(c,j) + end do + + ! surface water layer has two coefficients + tvector(c,0) = t_h2osfc(c) + + ! soil layers; top layer will have one offset and one extra coefficient + tvector(c,1:nlevgrnd) = t_soisno(c,1:nlevgrnd) + + enddo + + call t_startf( 'SoilTempBandDiag') + + ! Solve the system + + call BandDiagonal(bounds, -nlevsno, nlevgrnd, jtop(begc:endc), jbot(begc:endc), & + num_nolakec, filter_nolakec, nband, bmatrix(begc:endc, :, :), & + rvector(begc:endc, :), tvector(begc:endc, :)) + call t_stopf( 'SoilTempBandDiag') + + ! return temperatures to original array + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + do j = snl(c)+1, 0 + t_soisno(c,j) = tvector(c,j-1) !snow layers + end do + t_soisno(c,1:nlevgrnd) = tvector(c,1:nlevgrnd) !soil layers + + if (frac_h2osfc(c) == 0._r8) then + t_h2osfc(c)=t_soisno(c,1) + else + t_h2osfc(c) = tvector(c,0) !surface water + endif + enddo + + ! Melting or Freezing + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) .and. j <= nlevurb) then + if (j >= snl(c)+1) then + if (j <= nlevurb-1) then + fn1(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j == nlevurb) then + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + if ( IsSimpleBuildTemp() )then + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + ! Note new formulation for fn, this will be used below in net energey flux computations + fn1(c,j) = tk(c,j) * (t_building(l) - t_soisno(c,j))/(zi(c,j) - z(c,j)) + fn(c,j) = tk(c,j) * (t_building(l) - tssbef(c,j))/(zi(c,j) - z(c,j)) + + else + ! the bottom "soil" layer and the equations are derived assuming a prognostic inner + ! surface temperature. + if (ctype(c) == icol_sunwall) then + fn1(c,j) = tk(c,j) * (t_sunw_inner(l) - t_soisno(c,j))/(zi(c,j) - z(c,j)) + fn(c,j) = tk(c,j) * (t_sunw_inner(l) - tssbef(c,j))/(zi(c,j) - z(c,j)) + else if (ctype(c) == icol_shadewall) then + fn1(c,j) = tk(c,j) * (t_shdw_inner(l) - t_soisno(c,j))/(zi(c,j) - z(c,j)) + fn(c,j) = tk(c,j) * (t_shdw_inner(l) - tssbef(c,j))/(zi(c,j) - z(c,j)) + else if (ctype(c) == icol_roof) then + fn1(c,j) = tk(c,j) * (t_roof_inner(l) - t_soisno(c,j))/(zi(c,j) - z(c,j)) + fn(c,j) = tk(c,j) * (t_roof_inner(l) - tssbef(c,j))/(zi(c,j) - z(c,j)) + end if + end if + end if + end if + else if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) then + if (j >= snl(c)+1) then + if (j <= nlevgrnd-1) then + fn1(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j == nlevgrnd) then + fn1(c,j) = 0._r8 + end if + end if + end if + end do + end do + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_roof) then + eflx_building_heat_errsoi(c) = cnfac*fn(c,nlevurb) + (1._r8-cnfac)*fn1(c,nlevurb) + else + eflx_building_heat_errsoi(c) = 0._r8 + end if + if ( IsSimpleBuildTemp() )then + if (cool_on(l)) then + eflx_urban_ac_col(c) = abs(eflx_building_heat_errsoi(c)) + eflx_urban_heat_col(c) = 0._r8 + else if (heat_on(l)) then + eflx_urban_ac_col(c) = 0._r8 + eflx_urban_heat_col(c) = abs(eflx_building_heat_errsoi(c)) + else + eflx_urban_ac_col(c) = 0._r8 + eflx_urban_heat_col(c) = 0._r8 + end if + end if + end if + end do + + ! compute phase change of h2osfc + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + xmf_h2osfc(c) = 0. + end do + + call PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & + dhsdT(bounds%begc:bounds%endc), & + waterstate_inst, waterflux_inst, temperature_inst) + + call Phasechange_beta (bounds, num_nolakec, filter_nolakec, & + dhsdT(bounds%begc:bounds%endc), & + soilstate_inst, waterstate_inst, waterflux_inst, energyflux_inst, temperature_inst) + + if ( IsProgBuildTemp() )then + call BuildingTemperature(bounds, num_urbanl, filter_urbanl, num_nolakec, filter_nolakec, & + tk(bounds%begc:bounds%endc, :), urbanparams_inst, & + temperature_inst, energyflux_inst) + end if + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + ! this expression will (should) work whether there is snow or not + if (snl(c) < 0) then + if(frac_h2osfc(c) /= 0._r8) then + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) * t_soisno(c,1) & + + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = frac_sno_eff(c) * t_soisno(c,snl(c)+1) & + + (1.0_r8 - frac_sno_eff(c)) * t_soisno(c,1) + end if + + else + if(frac_h2osfc(c) /= 0._r8) then + t_grnd(c) = (1 - frac_h2osfc(c)) * t_soisno(c,1) + frac_h2osfc(c) * t_h2osfc(c) + else + t_grnd(c) = t_soisno(c,1) + end if + endif + end do + + ! Initialize soil heat content + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + hc_soisno(c) = 0._r8 + hc_soi(c) = 0._r8 + end if + eflx_fgr12(c)= 0._r8 + end do + + ! Calculate soil heat content and soil plus snow heat content + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + + if (j == 1) then ! this only needs to be done once + eflx_fgr12(c) = -cnfac*fn(c,1) - (1._r8-cnfac)*fn1(c,1) + end if + if (j > 0 .and. j < nlevgrnd .and. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) then + eflx_fgr(c,j) = -cnfac*fn(c,j) - (1._r8-cnfac)*fn1(c,j) + else if (j == nlevgrnd .and. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) then + eflx_fgr(c,j) = 0._r8 + end if + + if (.not. lun%urbpoi(l)) then + if (j >= snl(c)+1) then + hc_soisno(c) = hc_soisno(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8 + endif + if (j >= 1) then + hc_soi(c) = hc_soi(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8 + end if + end if + end do + end do + + end associate + + end subroutine SoilTemperature + + !----------------------------------------------------------------------- + subroutine SoilThermProp (bounds, num_nolakec, filter_nolakec, & + tk, cv, tk_h2osfc, & + urbanparams_inst, temperature_inst, waterstate_inst, soilstate_inst) + + ! + ! !DESCRIPTION: + ! Calculation of thermal conductivities and heat capacities of + ! snow/soil layers + ! (1) The volumetric heat capacity is calculated as a linear combination + ! in terms of the volumetric fraction of the constituent phases. + ! + ! (2) The thermal conductivity of soil is computed from the algorithm of + ! Johansen (as reported by Farouki 1981), and of snow is from the + ! formulation used in SNTHERM (Jordan 1991). + ! The thermal conductivities at the interfaces between two neighboring + ! layers (j, j+1) are derived from an assumption that the flux across + ! the interface is equal to that from the node j to the interface and the + ! flux from the interface to the node j+1. + ! + ! !USES: + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, nlevsoi + use clm_varcon , only : denh2o, denice, tfrz, tkwat, tkice, tkair, cpice, cpliq, thk_bedrock + use landunit_varcon , only : istice, istice_mec, istwet + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(out) :: cv( bounds%begc: , -nlevsno+1: ) ! heat capacity [J/(m2 K) ] [col, lev] + real(r8) , intent(out) :: tk( bounds%begc: , -nlevsno+1: ) ! thermal conductivity at the layer interface [W/(m K) ] [col, lev] + real(r8) , intent(out) :: tk_h2osfc( bounds%begc: ) ! thermal conductivity of h2osfc [W/(m K) ] [col] + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + ! + ! !LOCAL VARIABLES: + integer :: l,c,j ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(r8) :: dke ! kersten number + real(r8) :: fl ! volume fraction of liquid or unfrozen water to total water + real(r8) :: satw ! relative total water content of soil. + real(r8) :: zh2osfc + !----------------------------------------------------------------------- + + call t_startf( 'SoilThermProp' ) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(cv) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + nlev_improad => urbanparams_inst%nlev_improad , & ! Input: [integer (:) ] number of impervious road layers + tk_wall => urbanparams_inst%tk_wall , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban wall + tk_roof => urbanparams_inst%tk_roof , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban roof + tk_improad => urbanparams_inst%tk_improad , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban impervious road + cv_wall => urbanparams_inst%cv_wall , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban wall + cv_roof => urbanparams_inst%cv_roof , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban roof + cv_improad => urbanparams_inst%cv_improad , & ! Input: [real(r8) (:,:) ] thermal conductivity of urban impervious road + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fractional snow covered area + h2osfc => waterstate_inst%h2osfc_col , & ! Input: [real(r8) (:) ] surface (mm H2O) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + bw => waterstate_inst%bw_col , & ! Output: [real(r8) (:,:) ] partial density of water in the snow pack (ice + liquid) [kg/m3] + + tkmg => soilstate_inst%tkmg_col , & ! Input: [real(r8) (:,:) ] thermal conductivity, soil minerals [W/m-K] + tkdry => soilstate_inst%tkdry_col , & ! Input: [real(r8) (:,:) ] thermal conductivity, dry soil (W/m/Kelvin) + csol => soilstate_inst%csol_col , & ! Input: [real(r8) (:,:) ] heat capacity, soil solids (J/m**3/Kelvin) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + tksatu => soilstate_inst%tksatu_col , & ! Input: [real(r8) (:,:) ] thermal conductivity, saturated soil [W/m-K] + thk => soilstate_inst%thk_col & ! Output: [real(r8) (:,:) ] thermal conductivity of each layer [W/m-K] + ) + + ! Thermal conductivity of soil from Farouki (1981) + ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB) + ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol., + ! 41, 1011-1026. + + do j = -nlevsno+1,nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + + ! Only examine levels from 1->nlevgrnd + if (j >= 1) then + l = col%landunit(c) + if ((col%itype(c) == icol_sunwall .OR. col%itype(c) == icol_shadewall) .and. j <= nlevurb) then + thk(c,j) = tk_wall(l,j) + else if (col%itype(c) == icol_roof .and. j <= nlevurb) then + thk(c,j) = tk_roof(l,j) + else if (col%itype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then + thk(c,j) = tk_improad(l,j) + else if (lun%itype(l) /= istwet .AND. lun%itype(l) /= istice .AND. lun%itype(l) /= istice_mec & + .AND. col%itype(c) /= icol_sunwall .AND. col%itype(c) /= icol_shadewall .AND. & + col%itype(c) /= icol_roof) then + + satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j)) + satw = min(1._r8, satw) + if (satw > .1e-6_r8) then + if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil + dke = max(0._r8, log10(satw) + 1.0_r8) + else ! Frozen soil + dke = satw + end if + fl = (h2osoi_liq(c,j)/(denh2o*dz(c,j))) / (h2osoi_liq(c,j)/(denh2o*dz(c,j)) + & + h2osoi_ice(c,j)/(denice*dz(c,j))) + dksat = tkmg(c,j)*tkwat**(fl*watsat(c,j))*tkice**((1._r8-fl)*watsat(c,j)) + thk(c,j) = dke*dksat + (1._r8-dke)*tkdry(c,j) + else + thk(c,j) = tkdry(c,j) + endif + if (j > nlevsoi) thk(c,j) = thk_bedrock + else if (lun%itype(l) == istice .OR. lun%itype(l) == istice_mec) then + thk(c,j) = tkwat + if (t_soisno(c,j) < tfrz) thk(c,j) = tkice + else if (lun%itype(l) == istwet) then + if (j > nlevsoi) then + thk(c,j) = thk_bedrock + else + thk(c,j) = tkwat + if (t_soisno(c,j) < tfrz) thk(c,j) = tkice + endif + endif + endif + + ! Thermal conductivity of snow, which from Jordan (1991) pp. 18 + ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 + if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then + bw(c,j) = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/(frac_sno(c)*dz(c,j)) + thk(c,j) = tkair + (7.75e-5_r8 *bw(c,j) + 1.105e-6_r8*bw(c,j)*bw(c,j))*(tkice-tkair) + end if + + end do + end do + + ! Thermal conductivity at the layer interface + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) .and. j <= nlevurb) then + if (j >= snl(c)+1 .AND. j <= nlevurb-1) then + tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) & + /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j))) + else if (j == nlevurb) then + + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + tk(c,j) = thk(c,j) + end if + else if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) then + if (j >= snl(c)+1 .AND. j <= nlevgrnd-1) then + tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) & + /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j))) + else if (j == nlevgrnd) then + tk(c,j) = 0._r8 + end if + end if + end do + end do + + ! calculate thermal conductivity of h2osfc + do fc = 1, num_nolakec + c = filter_nolakec(fc) + zh2osfc=1.0e-3*(0.5*h2osfc(c)) !convert to [m] from [mm] + tk_h2osfc(c)= tkwat*thk(c,1)*(z(c,1)+zh2osfc) & + /(tkwat*z(c,1)+thk(c,1)*zh2osfc) + enddo + + ! Soil heat capacity, from de Vires (1963) + ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB) + ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol., + ! 41, 1011-1026. + + do j = 1, nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if ((col%itype(c) == icol_sunwall .OR. col%itype(c) == icol_shadewall) .and. j <= nlevurb) then + cv(c,j) = cv_wall(l,j) * dz(c,j) + else if (col%itype(c) == icol_roof .and. j <= nlevurb) then + cv(c,j) = cv_roof(l,j) * dz(c,j) + else if (col%itype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then + cv(c,j) = cv_improad(l,j) * dz(c,j) + else if (lun%itype(l) /= istwet .AND. lun%itype(l) /= istice .AND. lun%itype(l) /= istice_mec & + .AND. col%itype(c) /= icol_sunwall .AND. col%itype(c) /= icol_shadewall .AND. & + col%itype(c) /= icol_roof) then + cv(c,j) = csol(c,j)*(1-watsat(c,j))*dz(c,j) + (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + else if (lun%itype(l) == istwet) then + cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + if (j > nlevsoi) cv(c,j) = csol(c,j)*dz(c,j) + else if (lun%itype(l) == istice .OR. lun%itype(l) == istice_mec) then + cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + endif + if (j == 1) then + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8) then + cv(c,j) = cv(c,j) + cpice*h2osno(c) + end if + end if + enddo + end do + + ! Snow heat capacity + + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (snl(c)+1 < 1 .and. j >= snl(c)+1) then + cv(c,j) = cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j) + end if + end do + end do + call t_stopf( 'SoilThermProp' ) + + end associate + + end subroutine SoilThermProp + + !----------------------------------------------------------------------- + subroutine PhaseChangeH2osfc (bounds, num_nolakec, filter_nolakec, & + dhsdT, waterstate_inst, waterflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Only freezing is considered. When water freezes, move ice to bottom snow layer. + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varcon , only : tfrz, hfus, grav, denice, cnfac, cpice + use clm_varpar , only : nlevsno, nlevgrnd + use clm_varctl , only : iulog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(in) :: dhsdT ( bounds%begc: ) ! temperature derivative of "hs" [col ] + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,g !do loop index + integer :: fc !lake filtered column indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: temp1 !temporary variables [kg/m2 ] + real(r8) :: hm(bounds%begc:bounds%endc) !energy residual [W/m2 ] + real(r8) :: xm(bounds%begc:bounds%endc) !melting or freezing within a time step [kg/m2 ] + real(r8) :: tinc !t(n+1)-t(n) (K) + real(r8) :: smp !frozen water potential (mm) + real(r8) :: rho_avg + real(r8) :: z_avg + real(r8) :: dcv(bounds%begc:bounds%endc)!change in cv due to additional ice + real(r8) :: c1 + real(r8) :: c2 + !----------------------------------------------------------------------- + + call t_startf( 'PhaseChangeH2osfc' ) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + frac_sno => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) (new) + h2osfc => waterstate_inst%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) + int_snow => waterstate_inst%int_snow_col , & ! Output: [real(r8) (:) ] integrated snowfall [mm] + snow_depth => waterstate_inst%snow_depth_col , & ! Output: [real(r8) (:) ] snow height (m) + + qflx_h2osfc_to_ice => waterflux_inst%qflx_h2osfc_to_ice_col , & ! Output: [real(r8) (:) ] conversion of h2osfc to ice + + fact => temperature_inst%fact_col , & + c_h2osfc => temperature_inst%c_h2osfc_col , & + xmf_h2osfc => temperature_inst%xmf_h2osfc_col, & + t_soisno => temperature_inst%t_soisno_col , & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + t_h2osfc => temperature_inst%t_h2osfc_col & ! Output: [real(r8) (:) ] surface water temperature + ) + + ! Get step size + + dtime = get_step_size() + + ! Initialization + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + xmf_h2osfc(c) = 0._r8 + hm(c) = 0._r8 + xm(c) = 0._r8 + qflx_h2osfc_to_ice(c) = 0._r8 + end do + + ! Freezing identification + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! If liquid exists below melt point, freeze some to ice. + if ( frac_h2osfc(c) > 0._r8 .AND. t_h2osfc(c) <= tfrz) then + tinc = tfrz - t_h2osfc(c) + t_h2osfc(c) = tfrz + + ! energy absorbed beyond freezing temperature + hm(c) = dhsdT(c)*tinc - tinc*c_h2osfc(c)/dtime + + ! mass of water converted from liquid to ice + xm(c) = hm(c)*dtime/hfus + temp1 = h2osfc(c) + xm(c) + + ! compute change in cv due to additional ice + dcv(c)=cpice*min(abs(xm(c)),h2osfc(c)) + + z_avg=frac_sno(c)*snow_depth(c) + if (z_avg > 0._r8) then + rho_avg=min(800._r8,h2osno(c)/z_avg) + else + rho_avg=200._r8 + endif + + !===================== xm < h2osfc ==================================== + if(temp1 >= 0._r8) then ! add some frozen water to snow column + + ! add ice to snow column + h2osno(c) = h2osno(c) - xm(c) + int_snow(c) = int_snow(c) - xm(c) + if(snl(c) < 0) h2osoi_ice(c,0) = h2osoi_ice(c,0) - xm(c) + + + ! remove ice from h2osfc + h2osfc(c) = h2osfc(c) + xm(c) + + xmf_h2osfc(c) = frac_h2osfc(c)*hm(c) + + qflx_h2osfc_to_ice(c) = -xm(c)/dtime + + ! update snow depth + if (frac_sno(c) > 0 .and. snl(c) < 0) then + snow_depth(c)=h2osno(c)/(rho_avg*frac_sno(c)) + else + snow_depth(c)=h2osno(c)/denice + endif + + !========================= xm > h2osfc ============================= + else !all h2osfc converted to ice + + rho_avg=(h2osno(c)*rho_avg + h2osfc(c)*denice)/(h2osno(c) + h2osfc(c)) + h2osno(c) = h2osno(c) + h2osfc(c) + int_snow(c) = int_snow(c) + h2osfc(c) + + qflx_h2osfc_to_ice(c) = h2osfc(c)/dtime + + ! excess energy is used to cool ice layer + if(snl(c) < 0) h2osoi_ice(c,0) = h2osoi_ice(c,0) + h2osfc(c) + + ! NOTE: should compute and then use the heat capacity of frozen h2osfc layer + ! rather than using heat capacity of the liquid layer. But this causes + ! balance check errors as it doesn't know about it. + + ! cool frozen h2osfc layer with extra heat + t_h2osfc(c) = t_h2osfc(c) - temp1*hfus/(dtime*dhsdT(c) - c_h2osfc(c)) + + xmf_h2osfc(c) = frac_h2osfc(c)*(hm(c) - temp1*hfus/dtime) + + ! next, determine equilibrium temperature of combined ice/snow layer + if (snl(c) == 0) then + !initialize for next time step + t_soisno(c,0) = t_h2osfc(c) + else if (snl(c) == -1) then + c1=frac_sno(c)*(dtime/fact(c,0) - dhsdT(c)*dtime) + if ( frac_h2osfc(c) /= 0.0_r8 )then + c2=frac_h2osfc(c)*(c_h2osfc(c) - dtime*dhsdT(c)) + + else + c2=0.0_r8 + end if + t_soisno(c,0) = (c1*t_soisno(c,0)+ c2*t_h2osfc(c)) & + /(c1 + c2) + t_h2osfc(c) = t_soisno(c,0) + + else + c1=frac_sno(c)/fact(c,0)*dtime + if ( frac_h2osfc(c) /= 0.0_r8 )then + c2=frac_h2osfc(c)*(c_h2osfc(c) - dtime*dhsdT(c)) + else + c2=0.0_r8 + end if + t_soisno(c,0) = (c1*t_soisno(c,0)+ c2*t_h2osfc(c)) & + /(c1 + c2) + t_h2osfc(c) = t_soisno(c,0) + endif + + ! set h2osfc to zero (all liquid converted to ice) + h2osfc(c) = 0._r8 + + ! update snow depth + if (frac_sno(c) > 0 .and. snl(c) < 0) then + snow_depth(c)=h2osno(c)/(rho_avg*frac_sno(c)) + else + snow_depth(c)=h2osno(c)/denice + endif + + endif + endif + enddo + call t_stopf( 'PhaseChangeH2osfc' ) + + end associate + + end subroutine PhaseChangeH2osfc + + !----------------------------------------------------------------------- + subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & + soilstate_inst, waterstate_inst, waterflux_inst, energyflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Calculation of the phase change within snow and soil layers: + ! (1) Check the conditions for which the phase change may take place, + ! i.e., the layer temperature is great than the freezing point + ! and the ice mass is not equal to zero (i.e. melting), + ! or the layer temperature is less than the freezing point + ! and the liquid water mass is greater than the allowable supercooled + ! liquid water calculated from freezing point depression (i.e. freezing). + ! (2) Assess the rate of phase change from the energy excess (or deficit) + ! after setting the layer temperature to freezing point. + ! (3) Re-adjust the ice and liquid mass, and the layer temperature + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevsno, nlevgrnd,nlevurb + use clm_varctl , only : iulog + use clm_varcon , only : tfrz, hfus, grav + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv + use landunit_varcon , only : istsoil, istcrop, istice_mec + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(in) :: dhsdT ( bounds%begc: ) ! temperature derivative of "hs" [col] + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,g,l !do loop index + integer :: fc !lake filtered column indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: heatr !energy residual or loss after melting or freezing + real(r8) :: temp1 !temporary variables [kg/m2] + real(r8) :: hm(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) !energy residual [W/m2] + real(r8) :: xm(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) !melting or freezing within a time step [kg/m2] + real(r8) :: wmass0(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd)!initial mass of ice and liquid (kg/m2) + real(r8) :: wice0 (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd)!initial mass of ice (kg/m2) + real(r8) :: wliq0 (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd)!initial mass of liquid (kg/m2) + real(r8) :: supercool(bounds%begc:bounds%endc,nlevgrnd) !supercooled water in soil (kg/m2) + real(r8) :: propor !proportionality constant (-) + real(r8) :: tinc(bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) !t(n+1)-t(n) (K) + real(r8) :: smp !frozen water potential (mm) + !----------------------------------------------------------------------- + + call t_startf( 'PhaseChangebeta' ) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + h2osno => waterstate_inst%h2osno_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) (new) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) (new) + + qflx_snow_drain => waterflux_inst%qflx_snow_drain_col , & ! Output: [real(r8) (:) ] drainage from snow pack + qflx_snofrz_lyr => waterflux_inst%qflx_snofrz_lyr_col , & ! Output: [real(r8) (:,:) ] snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + qflx_snofrz_col => waterflux_inst%qflx_snofrz_col , & ! Output: [real(r8) (:) ] column-integrated snow freezing rate (positive definite) [kg m-2 s-1] + qflx_glcice => waterflux_inst%qflx_glcice_col , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] + qflx_glcice_melt => waterflux_inst%qflx_glcice_melt_col , & ! Output: [real(r8) (:) ] ice melt (positive definite) (mm H2O/s) + qflx_snomelt => waterflux_inst%qflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt (mm H2O /s) + + eflx_snomelt => energyflux_inst%eflx_snomelt_col , & ! Output: [real(r8) (:) ] snow melt heat flux (W/m**2) + eflx_snomelt_r => energyflux_inst%eflx_snomelt_r_col , & ! Output: [real(r8) (:) ] rural snow melt heat flux (W/m**2) + eflx_snomelt_u => energyflux_inst%eflx_snomelt_u_col , & ! Output: [real(r8) (:) ] urban snow melt heat flux (W/m**2) + + xmf => temperature_inst%xmf_col , & + fact => temperature_inst%fact_col , & + + imelt => temperature_inst%imelt_col , & ! Output: [integer (:,:) ] flag for melting (=1), freezing (=2), Not=0 (new) + t_soisno => temperature_inst%t_soisno_col & ! Output: [real(r8) (:,:) ] soil temperature (Kelvin) + ) + + ! Get step size + + dtime = get_step_size() + + ! Initialization + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + + qflx_snomelt(c) = 0._r8 + xmf(c) = 0._r8 + qflx_snofrz_lyr(c,-nlevsno+1:0) = 0._r8 + qflx_snofrz_col(c) = 0._r8 + qflx_glcice_melt(c) = 0._r8 + qflx_snow_drain(c) = 0._r8 + end do + + do j = -nlevsno+1,nlevgrnd ! all layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (j >= snl(c)+1) then + + ! Initialization + imelt(c,j) = 0 + hm(c,j) = 0._r8 + xm(c,j) = 0._r8 + wice0(c,j) = h2osoi_ice(c,j) + wliq0(c,j) = h2osoi_liq(c,j) + wmass0(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j) + endif ! end of snow layer if-block + end do ! end of column-loop + enddo ! end of level-loop + + !-- snow layers --------------------------------------------------- + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (j >= snl(c)+1) then + + ! Melting identification + ! If ice exists above melt point, melt some to liquid. + if (h2osoi_ice(c,j) > 0._r8 .AND. t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + ! tinc(c,j) = t_soisno(c,j) - tfrz + tinc(c,j) = tfrz - t_soisno(c,j) + t_soisno(c,j) = tfrz + endif + + ! Freezing identification + ! If liquid exists below melt point, freeze some to ice. + if (h2osoi_liq(c,j) > 0._r8 .AND. t_soisno(c,j) < tfrz) then + imelt(c,j) = 2 + ! tinc(c,j) = t_soisno(c,j) - tfrz + tinc(c,j) = tfrz - t_soisno(c,j) + t_soisno(c,j) = tfrz + endif + endif ! end of snow layer if-block + end do ! end of column-loop + enddo ! end of level-loop + + !-- soil layers --------------------------------------------------- + do j = 1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + supercool(c,j) = 0.0_r8 + ! add in urban condition if-block + if ((col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) .or. ( j <= nlevurb)) then + + + + if (h2osoi_ice(c,j) > 0. .AND. t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + ! tinc(c,j) = t_soisno(c,j) - tfrz + tinc(c,j) = tfrz - t_soisno(c,j) + t_soisno(c,j) = tfrz + endif + + ! from Zhao (1997) and Koren (1999) + supercool(c,j) = 0.0_r8 + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop .or. col%itype(c) == icol_road_perv) then + if(t_soisno(c,j) < tfrz) then + smp = hfus*(tfrz-t_soisno(c,j))/(grav*t_soisno(c,j)) * 1000._r8 !(mm) + supercool(c,j) = watsat(c,j)*(smp/sucsat(c,j))**(-1._r8/bsw(c,j)) + supercool(c,j) = supercool(c,j)*dz(c,j)*1000._r8 ! (mm) + endif + endif + + if (h2osoi_liq(c,j) > supercool(c,j) .AND. t_soisno(c,j) < tfrz) then + imelt(c,j) = 2 + ! tinc(c,j) = t_soisno(c,j) - tfrz + tinc(c,j) = tfrz - t_soisno(c,j) + t_soisno(c,j) = tfrz + endif + + ! If snow exists, but its thickness is less than the critical value (0.01 m) + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. j == 1) then + if (t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + ! tincc,j) = t_soisno(c,j) - tfrz + tinc(c,j) = tfrz - t_soisno(c,j) + t_soisno(c,j) = tfrz + endif + endif + + endif + + end do + enddo + + + do j = -nlevsno+1,nlevgrnd ! all layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + if ((col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) .or. ( j <= nlevurb)) then + + if (j >= snl(c)+1) then + + ! Calculate the energy surplus and loss for melting and freezing + if (imelt(c,j) > 0) then + + ! added unique cases for this calculation, + ! to account for absorbed solar radiation in each layer + + !================================================================== + if (j == snl(c)+1) then ! top layer + hm(c,j) = dhsdT(c)*tinc(c,j) - tinc(c,j)/fact(c,j) + + if ( j==1 .and. frac_h2osfc(c) /= 0.0_r8 ) then + hm(c,j) = hm(c,j) - frac_h2osfc(c)*(dhsdT(c)*tinc(c,j)) + end if + else if (j == 1) then + hm(c,j) = (1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c)) & + *dhsdT(c)*tinc(c,j) - tinc(c,j)/fact(c,j) + else ! non-interfacial snow/soil layers + hm(c,j) = - tinc(c,j)/fact(c,j) + endif + endif + + ! These two errors were checked carefully (Y. Dai). They result from the + ! computed error of "Tridiagonal-Matrix" in subroutine "thermal". + if (imelt(c,j) == 1 .AND. hm(c,j) < 0._r8) then + hm(c,j) = 0._r8 + imelt(c,j) = 0 + endif + if (imelt(c,j) == 2 .AND. hm(c,j) > 0._r8) then + hm(c,j) = 0._r8 + imelt(c,j) = 0 + endif + + ! The rate of melting and freezing + + if (imelt(c,j) > 0 .and. abs(hm(c,j)) > 0._r8) then + xm(c,j) = hm(c,j)*dtime/hfus ! kg/m2 + + ! If snow exists, but its thickness is less than the critical value + ! (1 cm). Note: more work is needed to determine how to tune the + ! snow depth for this case + if (j == 1) then + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. xm(c,j) > 0._r8) then + temp1 = h2osno(c) ! kg/m2 + h2osno(c) = max(0._r8,temp1-xm(c,j)) + propor = h2osno(c)/temp1 + snow_depth(c) = propor * snow_depth(c) + heatr = hm(c,j) - hfus*(temp1-h2osno(c))/dtime ! W/m2 + if (heatr > 0._r8) then + xm(c,j) = heatr*dtime/hfus ! kg/m2 + hm(c,j) = heatr ! W/m2 + else + xm(c,j) = 0._r8 + hm(c,j) = 0._r8 + endif + qflx_snomelt(c) = max(0._r8,(temp1-h2osno(c)))/dtime ! kg/(m2 s) + xmf(c) = hfus*qflx_snomelt(c) + qflx_snow_drain(c) = qflx_snomelt(c) + endif + endif + + heatr = 0._r8 + if (xm(c,j) > 0._r8) then + h2osoi_ice(c,j) = max(0._r8, wice0(c,j)-xm(c,j)) + heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + else if (xm(c,j) < 0._r8) then + if (j <= 0) then + h2osoi_ice(c,j) = min(wmass0(c,j), wice0(c,j)-xm(c,j)) ! snow + else + if (wmass0(c,j) < supercool(c,j)) then + h2osoi_ice(c,j) = 0._r8 + else + h2osoi_ice(c,j) = min(wmass0(c,j) - supercool(c,j),wice0(c,j)-xm(c,j)) + endif + endif + heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + endif + + h2osoi_liq(c,j) = max(0._r8,wmass0(c,j)-h2osoi_ice(c,j)) + + if (abs(heatr) > 0._r8) then + if (j == snl(c)+1) then + + if(j==1) then + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8-(1.0_r8 - frac_h2osfc(c))*fact(c,j)*dhsdT(c)) + else + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8-fact(c,j)*dhsdT(c)) + endif + + else if (j == 1) then + + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr & + /(1._r8-(1.0_r8 - frac_sno_eff(c) - frac_h2osfc(c))*fact(c,j)*dhsdT(c)) + else + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr + endif + + if (j <= 0) then ! snow + if (h2osoi_liq(c,j)*h2osoi_ice(c,j)>0._r8) t_soisno(c,j) = tfrz + end if + endif ! end of heatr > 0 if-block + + if (j >= 1) then + xmf(c) = xmf(c) + hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + else + xmf(c) = xmf(c) + frac_sno_eff(c)*hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + endif + + if (imelt(c,j) == 1 .AND. j < 1) then + qflx_snomelt(c) = qflx_snomelt(c) + max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime + + + endif + + ! layer freezing mass flux (positive): + if (imelt(c,j) == 2 .AND. j < 1) then + qflx_snofrz_lyr(c,j) = max(0._r8,(h2osoi_ice(c,j)-wice0(c,j)))/dtime + endif + + endif + + endif ! end of snow layer if-block + + endif + + ! For glacier_mec columns, compute negative ice flux from melted ice. + ! Note that qflx_glcice can also include a positive component from excess snow, + ! as computed in HydrologyDrainageMod.F90. + + l = col%landunit(c) + if (lun%itype(l)==istice_mec) then + + if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater + ! melting corresponds to a negative ice flux + qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime + qflx_glcice(c) = qflx_glcice(c) - h2osoi_liq(c,j)/dtime + + ! convert layer back to pure ice by "borrowing" ice from below the column + h2osoi_ice(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j) + h2osoi_liq(c,j) = 0._r8 + + endif ! liquid water is present + endif ! istice_mec + + end do ! end of column-loop + enddo ! end of level-loop + + ! Needed for history file output + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + eflx_snomelt(c) = qflx_snomelt(c) * hfus + l = col%landunit(c) + if (lun%urbpoi(l)) then + eflx_snomelt_u(c) = eflx_snomelt(c) + else if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + eflx_snomelt_r(c) = eflx_snomelt(c) + end if + end do + + call t_stopf( 'PhaseChangebeta' ) + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + qflx_snofrz_col(c) = qflx_snofrz_col(c) + qflx_snofrz_lyr(c,j) + end do + end do + + end associate + + end subroutine Phasechange_beta + + !----------------------------------------------------------------------- + subroutine ComputeGroundHeatFluxAndDeriv(bounds, num_nolakec, filter_nolakec, & + hs_h2osfc, hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, & + atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstate_inst, & + waterflux_inst, solarabs_inst, energyflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Computes ground heat flux on: + ! (1) The surface of standing water, + ! (2) The surface of snow, + ! (3) The surface of soil, and + ! (4) Net energy flux into soil surface. + ! Additionally, derivative of ground heat flux w.r.t to temeprature + ! + ! !USES: + use clm_varcon , only : sb, hvap + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, max_patch_per_col + use UrbanParamsType, only : IsSimpleBuildTemp + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec( : ) ! column filter for non-lake points + real(r8) , intent(out) :: hs_h2osfc( bounds%begc: ) ! heat flux on standing water [W/m2] + real(r8) , intent(out) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8) , intent(out) :: hs_soil( bounds%begc: ) ! heat flux on soil [W/m2] + real(r8) , intent(out) :: hs_top (bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8) , intent(out) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8) , intent(out) :: sabg_lyr_col( bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,p,l,g,pi ! indices + integer :: fc ! lake filtered column indices + real(r8) :: hs(bounds%begc:bounds%endc) ! net energy flux into the surface (w/m2) + real(r8) :: lwrad_emit(bounds%begc:bounds%endc) ! emitted longwave radiation + real(r8) :: dlwrad_emit(bounds%begc:bounds%endc) ! time derivative of emitted longwave radiation + integer :: lyr_top ! index of top layer of snowpack (-4 to 0) [idx] + real(r8) :: eflx_gnet_top ! net energy flux into surface layer, patch-level [W/m2] + real(r8) :: lwrad_emit_snow(bounds%begc:bounds%endc) ! + real(r8) :: lwrad_emit_soil(bounds%begc:bounds%endc) ! + real(r8) :: lwrad_emit_h2osfc(bounds%begc:bounds%endc) ! + real(r8) :: eflx_gnet_snow ! + real(r8) :: eflx_gnet_soil ! + real(r8) :: eflx_gnet_h2osfc ! + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc,1/)), errMsg(__FILE__, __LINE__)) + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + + qflx_ev_snow => waterflux_inst%qflx_ev_snow_patch , & ! Input: [real(r8) (:) ] evaporation flux from snow (W/m**2) [+ to atm] + qflx_ev_soil => waterflux_inst%qflx_ev_soil_patch , & ! Input: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_ev_h2osfc => waterflux_inst%qflx_ev_h2osfc_patch , & ! Input: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Input: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + + emg => temperature_inst%emg_col , & ! Input: [real(r8) (:) ] ground emissivity + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature [K] + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of vapor of water (or sublimation) [j/kg] + cgrnd => energyflux_inst%cgrnd_patch , & ! Input: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp [w/m2/k] + dlrad => energyflux_inst%dlrad_patch , & ! Input: [real(r8) (:) ] downward longwave radiation blow the canopy [W/m2] + eflx_traffic => energyflux_inst%eflx_traffic_lun , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_wasteheat => energyflux_inst%eflx_wasteheat_lun , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac => energyflux_inst%eflx_heat_from_ac_lun , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Input: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] + eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Input: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Input: [real(r8) (:) ] sensible heat flux from surface water (W/m**2) [+ to atm] + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Input: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Input: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_wasteheat_patch => energyflux_inst%eflx_wasteheat_patch , & ! Input: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac_patch => energyflux_inst%eflx_heat_from_ac_patch , & ! Input: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_traffic_patch => energyflux_inst%eflx_traffic_patch , & ! Input: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_anthro => energyflux_inst%eflx_anthro_patch , & ! Input: [real(r8) (:) ] total anthropogenic heat flux (W/m**2) + eflx_gnet => energyflux_inst%eflx_gnet_patch , & ! Output: [real(r8) (:) ] net ground heat flux into the surface (W/m**2) + dgnetdT => energyflux_inst%dgnetdT_patch , & ! Output: [real(r8) (:) ] temperature derivative of ground net heat flux + + sabg => solarabs_inst%sabg_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg_chk => solarabs_inst%sabg_chk_patch , & ! Output: [real(r8) (:) ] sum of soil/snow using current fsno, for balance check + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Output: [real(r8) (:,:) ] absorbed solar radiation (pft,lyr) [W/m2] + + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Net ground heat flux into the surface and its temperature derivative + ! Added a pfts loop here to get the average of hs and dhsdT over + ! all PFTs on the column. Precalculate the terms that do not depend on PFT. + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + lwrad_emit(c) = emg(c) * sb * t_grnd(c)**4 + dlwrad_emit(c) = 4._r8*emg(c) * sb * t_grnd(c)**3 + + ! fractionate lwrad_emit; balanced in CanopyFluxes & Biogeophysics2 + lwrad_emit_snow(c) = emg(c) * sb * t_soisno(c,snl(c)+1)**4 + lwrad_emit_soil(c) = emg(c) * sb * t_soisno(c,1)**4 + lwrad_emit_h2osfc(c) = emg(c) * sb * t_h2osfc(c)**4 + end do + + hs_soil(begc:endc) = 0._r8 + hs_h2osfc(begc:endc) = 0._r8 + hs(begc:endc) = 0._r8 + dhsdT(begc:endc) = 0._r8 + do pi = 1,max_patch_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + l = patch%landunit(p) + g = patch%gridcell(p) + + if (patch%active(p)) then + if (.not. lun%urbpoi(l)) then + eflx_gnet(p) = sabg(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit(c) & + - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + ! save sabg for balancecheck, in case frac_sno is set to zero later + sabg_chk(p) = frac_sno_eff(c) * sabg_snow(p) + (1._r8 - frac_sno_eff(c) ) * sabg_soil(p) + + eflx_gnet_snow = sabg_snow(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_snow(c) & + - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) + + eflx_gnet_soil = sabg_soil(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_soil(c) & + - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) + + eflx_gnet_h2osfc = sabg_soil(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) - lwrad_emit_h2osfc(c) & + - (eflx_sh_h2osfc(p)+qflx_ev_h2osfc(p)*htvp(c)) + else + ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of + ! interactions between urban columns. + + ! All wasteheat and traffic flux goes into canyon floor + if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + eflx_wasteheat_patch(p) = eflx_wasteheat(l)/(1._r8-lun%wtlunit_roof(l)) + eflx_heat_from_ac_patch(p) = eflx_heat_from_ac(l)/(1._r8-lun%wtlunit_roof(l)) + eflx_traffic_patch(p) = eflx_traffic(l)/(1._r8-lun%wtlunit_roof(l)) + else + eflx_wasteheat_patch(p) = 0._r8 + eflx_heat_from_ac_patch(p) = 0._r8 + eflx_traffic_patch(p) = 0._r8 + end if + ! Include transpiration term because needed for previous road + ! and include wasteheat and traffic flux + eflx_gnet(p) = sabg(p) + dlrad(p) & + - eflx_lwrad_net(p) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & + + eflx_wasteheat_patch(p) + eflx_heat_from_ac_patch(p) + eflx_traffic_patch(p) + if ( IsSimpleBuildTemp() ) then + eflx_anthro(p) = eflx_wasteheat_patch(p) + eflx_traffic_patch(p) + end if + eflx_gnet_snow = eflx_gnet(p) + eflx_gnet_soil = eflx_gnet(p) + eflx_gnet_h2osfc = eflx_gnet(p) + end if + dgnetdT(p) = - cgrnd(p) - dlwrad_emit(c) + hs(c) = hs(c) + eflx_gnet(p) * patch%wtcol(p) + dhsdT(c) = dhsdT(c) + dgnetdT(p) * patch%wtcol(p) + ! separate surface fluxes for soil/snow + hs_soil(c) = hs_soil(c) + eflx_gnet_soil * patch%wtcol(p) + hs_h2osfc(c) = hs_h2osfc(c) + eflx_gnet_h2osfc * patch%wtcol(p) + + end if + end if + end do + end do + + ! Additional calculations with SNICAR: + ! Set up tridiagonal matrix in a new manner. There is now + ! absorbed solar radiation in each snow layer, instead of + ! only the surface. Following the current implementation, + ! absorbed solar flux should be: S + ((delS/delT)*dT), + ! where S is absorbed radiation, and T is temperature. Now, + ! assume delS/delT is zero, then it is OK to just add S + ! to each layer + + ! Initialize: + sabg_lyr_col(begc:endc,-nlevsno+1:1) = 0._r8 + hs_top(begc:endc) = 0._r8 + hs_top_snow(begc:endc) = 0._r8 + + do pi = 1,max_patch_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + lyr_top = snl(c) + 1 + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + g = patch%gridcell(p) + l = patch%landunit(p) + if (.not. lun%urbpoi(l)) then + + eflx_gnet_top = sabg_lyr(p,lyr_top) + dlrad(p) + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit(c) - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + + hs_top(c) = hs_top(c) + eflx_gnet_top*patch%wtcol(p) + + eflx_gnet_snow = sabg_lyr(p,lyr_top) + dlrad(p) + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit_snow(c) - (eflx_sh_snow(p)+qflx_ev_snow(p)*htvp(c)) + + eflx_gnet_soil = sabg_lyr(p,lyr_top) + dlrad(p) + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(c) & + - lwrad_emit_soil(c) - (eflx_sh_soil(p)+qflx_ev_soil(p)*htvp(c)) + + hs_top_snow(c) = hs_top_snow(c) + eflx_gnet_snow*patch%wtcol(p) + + do j = lyr_top,1,1 + sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * patch%wtcol(p) + enddo + else + + hs_top(c) = hs_top(c) + eflx_gnet(p)*patch%wtcol(p) + hs_top_snow(c) = hs_top_snow(c) + eflx_gnet(p)*patch%wtcol(p) + sabg_lyr_col(c,lyr_top) = sabg_lyr_col(c,lyr_top) + sabg(p) * patch%wtcol(p) + + endif + endif + + endif + enddo + enddo + + end associate + + end subroutine ComputeGroundHeatFluxAndDeriv + + !----------------------------------------------------------------------- + subroutine ComputeHeatDiffFluxAndFactor(bounds, num_nolakec, filter_nolakec, dtime, & + tk, cv, fn, fact, & + energyflux_inst, temperature_inst) + ! + ! !DESCRIPTION: + ! Computes: + ! (1) Heat diffusion at the interface of layers. + ! (2) Factor used in computing tridiagonal matrix + ! + ! !USES: + use clm_varcon , only : capr, cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + use UrbanParamsType, only : IsSimpleBuildTemp + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(in) :: dtime ! land model time step (sec) + real(r8) , intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8) , intent(in) :: cv (bounds%begc: ,-nlevsno+1: ) ! heat capacity [J/(m2 K)] + real(r8) , intent(out) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8) , intent(out) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + type(energyflux_type) , intent(in) :: energyflux_inst + type(temperature_type) , intent(in) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(cv) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate(& + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + ctype => col%itype , & ! Input: [integer (:) ] column type + t_building => temperature_inst%t_building_lun , & ! Input: [real(r8) (:) ] internal building temperature (K) + t_roof_inner => temperature_inst%t_roof_inner_lun , & ! Input: [real(r8) (:) ] roof inside surface temperature (K) + t_sunw_inner => temperature_inst%t_sunw_inner_lun , & ! Input: [real(r8) (:) ] sunwall inside surface temperature (K) + t_shdw_inner => temperature_inst%t_shdw_inner_lun , & ! Input: [real(r8) (:) ] shadewall inside surface temperature (K) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + eflx_bot => energyflux_inst%eflx_bot_col & ! Input: [real(r8) (:) ] heat flux from beneath column (W/m**2) [+ = upward] + ) + + ! Determine heat diffusion through the layer interface and factor used in computing + ! tridiagonal matrix and set up vector r and vectors a, b, c that define tridiagonal + ! matrix and solve system + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) .and. j <= nlevurb) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + fact(c,j) = dtime/cv(c,j) + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j <= nlevurb-1) then + fact(c,j) = dtime/cv(c,j) + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + dzm = (z(c,j)-z(c,j-1)) + else if (j == nlevurb) then + fact(c,j) = dtime/cv(c,j) + if ( IsSimpleBuildTemp() )then + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + fn(c,j) = tk(c,j) * (t_building(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j)) + else + ! the bottom "soil" layer and the equations are derived assuming a prognostic inner + ! surface temperature. + if (ctype(c) == icol_sunwall) then + fn(c,j) = tk(c,j) * (t_sunw_inner(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j)) + else if (ctype(c) == icol_shadewall) then + fn(c,j) = tk(c,j) * (t_shdw_inner(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j)) + else if (ctype(c) == icol_roof) then + fn(c,j) = tk(c,j) * (t_roof_inner(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j)) + end if + end if + end if + end if + else if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + fact(c,j) = dtime/cv(c,j) * dz(c,j) / (0.5_r8*(z(c,j)-zi(c,j-1)+capr*(z(c,j+1)-zi(c,j-1)))) + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j <= nlevgrnd-1) then + fact(c,j) = dtime/cv(c,j) + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + dzm = (z(c,j)-z(c,j-1)) + else if (j == nlevgrnd) then + fact(c,j) = dtime/cv(c,j) + fn(c,j) = eflx_bot(c) + end if + end if + end if + end do + end do + + end associate + + end subroutine ComputeHeatDiffFluxAndFactor + + !----------------------------------------------------------------------- + subroutine SetRHSVec(bounds, num_nolakec, filter_nolakec, dtime, & + hs_h2osfc, hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, tk, & + tk_h2osfc, fact, fn, c_h2osfc, dz_h2osfc, & + temperature_inst, waterstate_inst, rvector) + + ! + ! !DESCRIPTION: + ! Setup the RHS-Vector for the numerical solution of temperature for snow, + ! standing surface water and soil layers. + ! + ! |===========| + ! | Snow | + ! !===========| + ! rvector = | SSW | + ! !===========| + ! ! Soil | + ! !===========| + ! + ! !USES: + use clm_varcon , only : cnfac, cpliq + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(in) :: dtime ! land model time step (sec) + real(r8) , intent(in) :: hs_h2osfc( bounds%begc: ) ! heat flux on standing water [W/m2] + real(r8) , intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8) , intent(in) :: hs_soil( bounds%begc: ) ! heat flux on soil [W/m2] + real(r8) , intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8) , intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8) , intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) , intent(in) :: tk( bounds%begc: , -nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8) , intent(in) :: tk_h2osfc( bounds%begc: ) ! thermal conductivity of h2osfc [W/(m K)] [col] + real(r8) , intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8) , intent(in) :: fn( bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8) , intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8) , intent(in) :: dz_h2osfc( bounds%begc: ) ! Thickness of standing water [m] + real(r8) , intent(out) :: rvector( bounds%begc: , -nlevsno: ) ! RHS vector used in numerical solution of temperature + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: rt (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! "r" vector for tridiagonal solution + real(r8) :: fn_h2osfc(bounds%begc:bounds%endc) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8) :: rt_snow(bounds%begc:bounds%endc,-nlevsno:-1) ! RHS vector corresponding to snow layers + real(r8) :: rt_ssw(bounds%begc:bounds%endc,1) ! RHS vector corresponding to standing surface water + real(r8) :: rt_soil(bounds%begc:bounds%endc,1:nlevgrnd) ! RHS vector corresponding to soil layer + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rvector) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + t_h2osfc => temperature_inst%t_h2osfc_col , & ! Input: [real(r8) (:) ] surface water temperature + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] eff. fraction of ground covered by snow (0 to 1) + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + rvector(begc:endc, :) = nan + + ! Set entries in RHS vector for snow layers + call SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + t_soisno ( begc:endc, -nlevsno+1: ), & + t_h2osfc ( begc:endc ), & + rt_snow( begc:endc, -nlevsno:)) + + ! Set entries in RHS vector for surface water layer + call SetRHSVec_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, & + dtime, & + hs_h2osfc( begc:endc ), & + dhsdT( begc:endc ), & + tk_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fn_h2osfc( begc:endc ), & + t_soisno ( begc:endc, -nlevsno+1: ), & + t_h2osfc ( begc:endc), & + rt_ssw( begc:endc, 1:1)) + + ! Set entries in RHS vector for soil layers + call SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + frac_h2osfc ( begc:endc), & + frac_sno_eff( begc:endc), & + t_soisno ( begc:endc, -nlevsno+1: ), & + rt_soil( begc:endc, 1: )) + + ! Combine the RHS vector + do fc = 1,num_nolakec + c = filter_nolakec(fc) + rvector(c, -nlevsno:-1) = rt_snow(c, -nlevsno:-1) + rvector(c, 0 ) = rt_ssw(c, 1 ) + rvector(c, 1:nlevgrnd) = rt_soil(c, 1:nlevgrnd ) + end do + + end associate + + end subroutine SetRHSVec + + !----------------------------------------------------------------------- + subroutine SetRHSVec_Snow(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, t_h2osfc, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to snow layers. + ! + ! !USES: + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(in) :: t_h2osfc(bounds%begc:) ! surface water temperature (Kelvin) + real(r8), intent(out) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, -1/)), errMsg(__FILE__, __LINE__)) + + associate( & + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + rt(begc:endc, : ) = nan + + call SetRHSVec_SnowUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + t_soisno ( begc:endc, -nlevsno+1: ), & + t_h2osfc ( begc:endc ), & + rt( begc:endc, -nlevsno:)) + + call SetRHSVec_SnowNonUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + t_soisno ( begc:endc, -nlevsno+1: ), & + rt( begc:endc, -nlevsno:)) + + end associate + + end subroutine SetRHSVec_Snow + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SnowUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, t_h2osfc, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to snow layers for urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(in) :: t_h2osfc(bounds%begc:) ! surface water temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, -1/)), errMsg(__FILE__, __LINE__)) + + associate( & + begc => bounds%begc, & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetRHSVec_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, -nlevsno:)) + + call SetRHSVec_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + t_soisno( begc:endc, -nlevsno+1: ), & + t_h2osfc( begc:endc), & + rt( begc:endc, -nlevsno:)) + + end associate + + end subroutine SetRHSVec_SnowUrban + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to snow layers for urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8) , intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8) , intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8) , intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8) , intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) , intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8) , intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8) , intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8) , intent(inout) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: rt_snow_urban(bounds%begc:bounds%endc,-nlevsno:-1) ! rhs vector entries for urban columns + real(r8) :: rt_snow_nonurban(bounds%begc:bounds%endc,-nlevsno:-1) ! rhs vector entries for non-urban columns + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, -1/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:) ] layer thickness (m) + ) + + ! + ! urban columns ------------------------------------------------------------------ + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + ! changed hs to hs_top + rt(c,j-1) = t_soisno(c,j) + fact(c,j)*( hs_top(c) - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + rt(c,j-1) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + rt(c,j-1) = rt(c,j-1) + (fact(c,j)*sabg_lyr_col(c,j)) + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SnowUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, t_h2osfc, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to snow layers for urban road + ! (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(in) :: t_h2osfc(bounds%begc: ) ! surface water temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: rt_snow_urban(bounds%begc:bounds%endc,-nlevsno:-1) ! + real(r8) :: rt_snow_nonurban(bounds%begc:bounds%endc,-nlevsno:-1) ! + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, -1/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:) ] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + rt(c,j-1) = t_soisno(c,j) + fact(c,j)*( hs_top_snow(c) & + - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + + rt(c,j-1) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + rt(c,j-1) = rt(c,j-1) + fact(c,j)*sabg_lyr_col(c,j) + + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SnowUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SnowNonUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_top, dhsdT, sabg_lyr_col, & + fact, fn, t_soisno, rt) + + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to snow layers for non-urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow( bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_top( bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT( bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col( bounds%begc: , -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: , -nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: , -nlevsno: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_top_snow) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hs_top) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, -1/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:) ] layer thickness (m) + ) + + ! + ! non-urban columns -------------------------------------------------------------- + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + rt(c,j-1) = t_soisno(c,j) + fact(c,j)*( hs_top_snow(c) & + - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + + else + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + + rt(c,j-1) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + rt(c,j-1) = rt(c,j-1) + fact(c,j)*sabg_lyr_col(c,j) + + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SnowNonUrban + + !----------------------------------------------------------------------- + subroutine SetRHSVec_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, dtime, & + hs_h2osfc, dhsdT, tk_h2osfc, c_h2osfc, dz_h2osfc, fn_h2osfc, & + t_soisno, t_h2osfc, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to standing surface water + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: dtime ! land model time step (sec) + real(r8), intent(in) :: hs_h2osfc(bounds%begc: ) ! + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(out) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(in) :: t_h2osfc(bounds%begc:) ! surface water temperature temperature (Kelvin) + real(r8), intent(out) :: rt(bounds%begc: , 1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc,1/)), errMsg(__FILE__, __LINE__)) + + ! Initialize + rt(bounds%begc:bounds%endc, : ) = nan + + ! + ! surface water ------------------------------------------------------------------ + ! + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + fn_h2osfc(c)=tk_h2osfc(c)*(t_soisno(c,1)-t_h2osfc(c))/dzm + rt(c,1)= t_h2osfc(c) + (dtime/c_h2osfc(c)) & + *( hs_h2osfc(c) - dhsdT(c)*t_h2osfc(c) + cnfac*fn_h2osfc(c) )!rhs for h2osfc + + enddo + + end subroutine SetRHSVec_StandingSurfaceWater + + !----------------------------------------------------------------------- + subroutine SetRHSVec_Soil(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + frac_h2osfc, frac_sno_eff, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! fractional area with surface water greater than zero + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(out) :: rt(bounds%begc: ,1: ) ! rhs vector entries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + rt(begc:endc, : ) = nan + + call SetRHSVec_SoilUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + frac_sno_eff( begc:endc ), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, 1: )) + + call SetRHSVec_SoilNonUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + frac_sno_eff(begc:endc), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, 1: )) + + call SetRHSVec_Soil_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + frac_h2osfc(begc:endc), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, 1: )) + + end associate + + end subroutine SetRHSVec_Soil + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SoilUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + frac_sno_eff, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers for urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: ,1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetRHSVec_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, 1: )) + + call SetRHSVec_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow( begc:endc ), & + hs_soil( begc:endc ), & + hs_top( begc:endc ), & + dhsdT( begc:endc ), & + sabg_lyr_col (begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + fn( begc:endc, -nlevsno+1: ), & + fn_h2osfc( begc:endc ), & + c_h2osfc( begc:endc ), & + frac_sno_eff( begc:endc ), & + t_soisno( begc:endc, -nlevsno+1: ), & + rt( begc:endc, 1: )) + + end associate + + end subroutine SetRHSVec_SoilUrban + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers for urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: ,1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:) ] layer thickness (m) + ) + + ! + ! urban columns ------------------------------------------------------------------ + ! + do j = 1,nlevurb + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + ! changed hs to hs_top + rt(c,j) = t_soisno(c,j) + fact(c,j)*( hs_top(c) - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else if (j <= nlevurb-1) then + ! if this is a snow layer or the top soil layer, + ! add absorbed solar flux to factor 'rt' + if (j == 1) then + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + rt(c,j) = rt(c,j) + (fact(c,j)*sabg_lyr_col(c,j)) + else + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + endif + + else if (j == nlevurb) then + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + rt(c,j) = t_soisno(c,j) + fact(c,j)*( fn(c,j) - cnfac*fn(c,j-1) ) + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SoilUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + frac_sno_eff, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers for urban road + ! (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: ,1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:) ] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = 1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j == col%snl(c)+1) then + rt(c,j) = t_soisno(c,j) + fact(c,j)*( hs_top_snow(c) & + - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else if (j == 1) then + ! this is the snow/soil interface layer + rt(c,j) = t_soisno(c,j) + fact(c,j) & + *((1._r8-frac_sno_eff(c))*(hs_soil(c) - dhsdT(c)*t_soisno(c,j)) & + + cnfac*(fn(c,j) - frac_sno_eff(c) * fn(c,j-1))) + + rt(c,j) = rt(c,j) + frac_sno_eff(c)*fact(c,j)*sabg_lyr_col(c,j) + + else if (j <= nlevgrnd-1) then + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + + else if (j == nlevgrnd) then + rt(c,j) = t_soisno(c,j) - cnfac*fact(c,j)*fn(c,j-1) + fact(c,j)*fn(c,j) + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SoilUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetRHSVec_SoilNonUrban(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + frac_sno_eff, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers. + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fractional area with surface water greater than zero + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: ,1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! non-urban columns -------------------------------------------------------------- + ! + do j = 1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j == col%snl(c)+1) then + rt(c,j) = t_soisno(c,j) + fact(c,j)*( hs_top_snow(c) & + - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else if (j == 1) then + ! this is the snow/soil interface layer + rt(c,j) = t_soisno(c,j) + fact(c,j) & + *((1._r8-frac_sno_eff(c))*(hs_soil(c) - dhsdT(c)*t_soisno(c,j)) & + + cnfac*(fn(c,j) - frac_sno_eff(c) * fn(c,j-1))) + + rt(c,j) = rt(c,j) + frac_sno_eff(c)*fact(c,j)*sabg_lyr_col(c,j) + + else if (j <= nlevgrnd-1) then + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + + else if (j == nlevgrnd) then + rt(c,j) = t_soisno(c,j) - cnfac*fact(c,j)*fn(c,j-1) + fact(c,j)*fn(c,j) + end if + end if + enddo + end do + + end associate + + end subroutine SetRHSVec_SoilNonUrban + + !----------------------------------------------------------------------- + subroutine SetRHSVec_Soil_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, & + hs_top_snow, hs_soil, hs_top, dhsdT, sabg_lyr_col, fact, fn, fn_h2osfc, c_h2osfc, & + frac_h2osfc, t_soisno, rt) + ! + ! !DESCRIPTION: + ! Sets up RHS vector corresponding to soil layers. + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: hs_top_snow(bounds%begc: ) ! heat flux on top snow layer [W/m2] + real(r8), intent(in) :: hs_soil(bounds%begc: ) ! heat flux on soil [W/m2] + real(r8), intent(in) :: hs_top(bounds%begc: ) ! net energy flux into surface layer (col) [W/m2] + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: sabg_lyr_col(bounds%begc:, -nlevsno+1: ) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: fn (bounds%begc: ,-nlevsno+1: ) ! heat diffusion through the layer interface [W/m2] + real(r8), intent(in) :: fn_h2osfc (bounds%begc: ) ! heat diffusion through standing-water/soil interface [W/m2] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! fractional area with surface water greater than zero + real(r8), intent(in) :: t_soisno(bounds%begc:, -nlevsno+1:) ! soil temperature (Kelvin) + real(r8), intent(inout) :: rt(bounds%begc: ,1: ) ! rhs vector entries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(hs_soil) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sabg_lyr_col) == (/bounds%endc, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fn_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + ! + ! surface water ----------------------------------------------------------------- + ! + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ( frac_h2osfc(c) /= 0.0_r8 )then + rt(c,1)=rt(c,1) & + -frac_h2osfc(c)*fact(c,1)*((hs_soil(c) - dhsdT(c)*t_soisno(c,1)) & + +cnfac*fn_h2osfc(c)) + end if + end do + + end subroutine SetRHSVec_Soil_StandingSurfaceWater + + !----------------------------------------------------------------------- + subroutine SetMatrix(bounds, num_nolakec, filter_nolakec, dtime, nband, & + dhsdT, tk, tk_h2osfc, fact, c_h2osfc, dz_h2osfc, waterstate_inst, bmatrix) + ! + ! !DESCRIPTION: + ! Setup the matrix for the numerical solution of temperature for snow, + ! standing surface water and soil layers. + ! + ! + ! |===========|===========|===========| + ! | Snow | | Snow-Soil | + ! !===========|===========|===========| + ! bmatrix = | | SSW | SSW-Soil | + ! !===========|===========|===========| + ! ! Soil-Snow | Soil-SSW | Soil | + ! !===========|===========|===========| + ! + ! + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: dtime ! land model time step (sec) + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(out) :: bmatrix(bounds%begc: , 1:,-nlevsno: ) ! matrix for numerical solution of temperature + type(waterstate_type), intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: at (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! "a" vector for tridiagonal matrix + real(r8) :: bt (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! "b" vector for tridiagonal matrix + real(r8) :: ct (bounds%begc:bounds%endc,-nlevsno+1:nlevgrnd) ! "c" vector for tridiagonal matrix + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: bmatrix_snow(bounds%begc:bounds%endc,nband,-nlevsno:-1 ) ! block-diagonal matrix for snow layers + real(r8) :: bmatrix_ssw(bounds%begc:bounds%endc,nband, 0:0 ) ! block-diagonal matrix for standing surface water + real(r8) :: bmatrix_soil(bounds%begc:bounds%endc,nband, 1:nlevgrnd) ! block-diagonal matrix for soil layers + real(r8) :: bmatrix_snow_soil(bounds%begc:bounds%endc,nband,-1:-1) ! off-diagonal matrix for snow-soil interaction + real(r8) :: bmatrix_ssw_soil(bounds%begc:bounds%endc,nband, 0:0 ) ! off-diagonal matrix for standing surface water-soil interaction + real(r8) :: bmatrix_soil_snow(bounds%begc:bounds%endc,nband, 1:1 ) ! off-diagonal matrix for soil-snow interaction + real(r8) :: bmatrix_soil_ssw(bounds%begc:bounds%endc,nband, 1:1 ) ! off-diagonal matrix for soil-standing surface water interaction + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z , & ! Input: [real(r8) (:,:) ] layer thickness (m) + frac_h2osfc => waterstate_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_sno_eff => waterstate_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Assemble smaller matrices + + call SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_snow( begc:endc, 1:, -nlevsno: )) + + call SetMatrix_Snow_Soil(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: )) + + call SetMatrix_Soil(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + frac_h2osfc(begc:endc), & + frac_sno_eff(begc:endc), & + bmatrix_soil( begc:endc, 1:, 1: )) + + call SetMatrix_Soil_Snow(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil_snow( begc:endc, 1:, 1: )) + + call SetMatrix_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, dtime, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + c_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + bmatrix_ssw( begc:endc, 1:, 0: )) + + call SetMatrix_StandingSurfaceWater_Soil(bounds, num_nolakec, filter_nolakec, dtime, nband, & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + c_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + bmatrix_ssw_soil( begc:endc, 1:, 0: )) + + call SetMatrix_Soil_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, nband, & + tk_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + dz_h2osfc( begc:endc ), & + frac_h2osfc(begc:endc), & + bmatrix_soil_ssw( begc:endc, 1:, 1: )) + + call AssembleMatrixFromSubmatrices(bounds, num_nolakec, filter_nolakec, nband, & + bmatrix_snow( begc:endc, 1:, -nlevsno: ), & + bmatrix_ssw( begc:endc, 1:, 0: ), & + bmatrix_soil( begc:endc, 1:, 1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: ), & + bmatrix_ssw_soil( begc:endc, 1:, 0: ), & + bmatrix_soil_snow( begc:endc, 1:, 1: ), & + bmatrix_soil_ssw( begc:endc, 1:, 1: ), & + bmatrix( begc:endc, 1:, -nlevsno: )) + + end associate + + end subroutine SetMatrix + + !----------------------------------------------------------------------- + subroutine AssembleMatrixFromSubmatrices(bounds, num_nolakec, filter_nolakec, nband, & + bmatrix_snow, bmatrix_ssw, bmatrix_soil, bmatrix_snow_soil, & + bmatrix_ssw_soil, bmatrix_soil_snow, bmatrix_soil_ssw, bmatrix) + + ! + ! !DESCRIPTION: + ! Assemble the full matrix from submatrices. + ! + ! Non-zero pattern of bmatrix (assuming 5 snow layers): + ! + ! SNOW-LAYERS + ! | + ! | STANDING-SURFACE-WATER + ! | | + ! | | SOIL-LAYERS + ! | | | + ! v v v + ! + ! -5 -4 -3 -2 -1| 0| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + ! ============================================================== + ! -5 | x x | | | + ! -4 | x x x | | | + ! -3 | x x x | | | + ! -2 | x x x| | | + ! -1 | x x| | x | + ! ============================================================== + ! 0 | | x| x | + ! ============================================================== + ! 1 | x| x| x x | + ! 2 | | | x x x | + ! 3 | | | x x x | + ! 4 | | | x x x | + ! 5 | | | x x x | + ! 6 | | | x x x | + ! 7 | | | x x x | + ! 8 | | | x x x | + ! 9 | | | x x x | + ! 10 | | | x x x | + ! 11 | | | x x x | + ! 12 | | | x x x | + ! 13 | | | x x x | + ! 14 | | | x x x| + ! 15 | | | x x| + ! ============================================================== + ! + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: bmatrix_snow(bounds%begc: , 1: , -nlevsno: ) ! block-diagonal matrix for snow layers [col, nband, nlevsno] + real(r8), intent(in) :: bmatrix_ssw(bounds%begc: , 1: , 0: ) ! block-diagonal matrix for standing surface water [col, nband, 0:0] + real(r8), intent(in) :: bmatrix_soil(bounds%begc: , 1: , 1: ) ! block-diagonal matrix for soil layers [col, nband, nlevgrnd] + real(r8), intent(in) :: bmatrix_snow_soil(bounds%begc: , 1: , -1: ) ! off-diagonal matrix for snow-soil interaction [col, nband, -1:-1] + real(r8), intent(in) :: bmatrix_ssw_soil(bounds%begc: , 1: , 0: ) ! off-diagonal matrix for standing surface water-soil interaction [col, nband, 0:0] + real(r8), intent(in) :: bmatrix_soil_snow(bounds%begc: , 1: , 1: ) ! off-diagonal matrix for soil-snow interaction [col, nband, 1:1] + real(r8), intent(in) :: bmatrix_soil_ssw(bounds%begc: , 1: , 1: ) ! off-diagonal matrix for soil-standing surface water interaction [col, nband, 1:1] + real(r8), intent(out) :: bmatrix(bounds%begc: , 1: , -nlevsno: ) ! full matrix used in numerical solution of temperature [col, nband, -nlevsno:nlevgrnd] + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + integer :: fc ! lake filtered column indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_ssw) == (/bounds%endc, nband, 0/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_ssw_soil) == (/bounds%endc, nband, 0/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_ssw) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + ! Assemble the full matrix + + bmatrix(bounds%begc:bounds%endc, :, :) = 0.0_r8 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! Snow + bmatrix(c,2:3,-nlevsno ) = bmatrix_snow(c,2:3,-nlevsno ) + bmatrix(c,2:4,-nlevsno+1:-2) = bmatrix_snow(c,2:4,-nlevsno+1:-2) + bmatrix(c,3:4,-1 ) = bmatrix_snow(c,3:4,-1 ) + + ! Snow-Soil + bmatrix(c,1,-1) = bmatrix_snow_soil(c,1,-1) + + ! StandingSurfaceWater + bmatrix(c,3,0) = bmatrix_ssw(c,3,0) + + ! StandingSurfaceWater-Soil + bmatrix(c,2,0) = bmatrix_ssw_soil(c,2,0) + + ! Soil + bmatrix(c,2:3,1 ) = bmatrix_soil(c,2:3,1 ) + bmatrix(c,2:4,2:nlevgrnd-1) = bmatrix_soil(c,2:4,2:nlevgrnd-1) + bmatrix(c,3:4,nlevgrnd ) = bmatrix_soil(c,3:4,nlevgrnd ) + + ! Soil-Snow + bmatrix(c,5,1) = bmatrix_soil_snow(c,5,1) + + ! Soil-StandingSurfaceWater + bmatrix(c,4,1) = bmatrix_soil_ssw(c,4,1) + + end do + + end subroutine AssembleMatrixFromSubmatrices + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, fact, frac_sno_eff, bmatrix_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal snow layers + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(out) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + bmatrix_snow(begc:endc, :, :) = 0.0_r8 + + call SetMatrix_SnowUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow( begc:endc, 1:, -nlevsno: )) + + call SetMatrix_SnowNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow( begc:endc, 1:, -nlevsno: )) + + end associate + + end subroutine SetMatrix_Snow + + !----------------------------------------------------------------------- + subroutine SetMatrix_SnowUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, fact, bmatrix_snow) + + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal snow layers for + ! urban soil columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetMatrix_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow( begc:endc, 1:, -nlevsno: )) + + call SetMatrix_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow( begc:endc, 1:, -nlevsno: )) + + end associate + + end subroutine SetMatrix_SnowUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, fact, bmatrix_snow) + + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal snow layers for + ! urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban non-road columns --------------------------------------------------------- + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow(c,4,j-1) = 0._r8 + bmatrix_snow(c,3,j-1) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + if ( j /= 0) then + bmatrix_snow(c,2,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + end if + else if (j <= nlevurb-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow(c,4,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bmatrix_snow(c,3,j-1) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + if (j /= 0) then + bmatrix_snow(c,2,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SnowUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, fact, bmatrix_snow) + + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal snow layers for + ! urban road (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow(c,4,j-1) = 0._r8 + bmatrix_snow(c,3,j-1) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + if ( j /= 0) then + bmatrix_snow(c,2,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + end if + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow(c,4,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bmatrix_snow(c,3,j-1) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + if ( j /= 0) then + bmatrix_snow(c,2,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SnowUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_SnowNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, fact, bmatrix_snow) + + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal snow layers for non-urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow(bounds%begc: , 1:, -nlevsno: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! non-urban landunits ------------------------------------------------------------ + ! + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow(c,4,j-1) = 0._r8 + bmatrix_snow(c,3,j-1) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + if ( j /= 0) then + bmatrix_snow(c,2,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + end if + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow(c,4,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bmatrix_snow(c,3,j-1) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + if ( j /= 0) then + bmatrix_snow(c,2,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SnowNonUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow_Soil(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_snow_soil) + + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to snow-soil interaction + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(out) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + bmatrix_snow_soil(begc:endc, :, :) = 0.0_r8 + + call SetMatrix_Snow_SoilUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: )) + + call SetMatrix_Snow_SoilNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: )) + + end associate + + end subroutine SetMatrix_Snow_Soil + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow_SoilUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_snow_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to snow-soil interaction for urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetMatrix_Snow_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: )) + + call SetMatrix_Snow_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_snow_soil( begc:endc, 1:, -1: )) + + end associate + + end subroutine SetMatrix_Snow_SoilUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_snow_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to snow-soil interaction for + ! urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + ! + ! urban non-road columns --------------------------------------------------------- + ! + do j = 0,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow_soil(c,1,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevurb-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow_soil(c,1,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_Snow_SoilUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_snow_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to snow-soil interaction for + ! urban road (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = 0,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow_soil(c,1,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow_soil(c,1,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_Snow_SoilUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_Snow_SoilNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_snow_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to snow-soil interaction for + ! non-urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_snow_soil(bounds%begc: , 1:,-1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_snow_soil) == (/bounds%endc, nband, -1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! non-urban columns -------------------------------------------------------------- + ! + do j = 0,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_snow_soil(c,1,j-1) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_snow_soil(c,1,j-1) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_Snow_SoilNonUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, tk_h2osfc, dz_h2osfc, fact, frac_h2osfc, frac_sno_eff, bmatrix_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal soil layers. + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! fractional area with surface water greater than zero + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(out) :: bmatrix_soil(bounds%begc: , 1:, 1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + bmatrix_soil(begc:endc, :, :) = 0.0_r8 + + call SetMatrix_SoilUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil( begc:endc, 1:, 1: )) + + call SetMatrix_SoilNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil( begc:endc, 1:, 1: )) + + ! the solution will be organized as (snow:h2osfc:soil) to minimize + ! bandwidth; this requires a 5-element band instead of 3 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + ! diagonal element correction for presence of h2osfc + if ( frac_h2osfc(c) /= 0.0_r8 ) then + bmatrix_soil(c,3,1)=bmatrix_soil(c,3,1)+ frac_h2osfc(c) & + *((1._r8-cnfac)*fact(c,1)*tk_h2osfc(c)/dzm + fact(c,1)*dhsdT(c)) + end if + + enddo + + end associate + + end subroutine SetMatrix_Soil + + !----------------------------------------------------------------------- + subroutine SetMatrix_SoilUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, tk_h2osfc, dz_h2osfc, fact, frac_sno_eff, bmatrix_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal soil layers for + ! urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil(bounds%begc: , 1:, 1: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetMatrix_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_soil( begc:endc, 1:, 1: )) + + call SetMatrix_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT( begc:endc ), & + tk( begc:endc, -nlevsno+1: ), & + tk_h2osfc( begc:endc ), & + dz_h2osfc( begc:endc ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil( begc:endc, 1:, 1: )) + + end associate + + end subroutine SetMatrix_SoilUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_SoilUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, tk_h2osfc, dz_h2osfc, fact, bmatrix_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal soil layers for + ! urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_soil(bounds%begc: , 1:, 1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + zi => col%zi , & ! Input: [real(r8) (:,:)] interface level below a "z" level (m) + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban non-road columns --------------------------------------------------------- + ! + do j = 1,nlevurb + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + if (j /= 1) then + bmatrix_soil(c,4,j) = 0._r8 + end if + bmatrix_soil(c,3,j) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + bmatrix_soil(c,2,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevurb-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + if (j /= 1) then + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + end if + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + else if (j == nlevurb) then + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prognostic inner + ! surface temperature. + dzm = ( z(c,j)-z(c,j-1)) + dzp = (zi(c,j)-z(c,j)) + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm) + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm + tk(c,j)/dzp) + bmatrix_soil(c,2,j) = 0._r8 + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SoilUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_SoilUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, tk_h2osfc, dz_h2osfc, fact, frac_sno_eff, bmatrix_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal soil layers for + ! urban road (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil(bounds%begc: , 1:, 1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = 1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + if (j /= 1) then + bmatrix_soil(c,4,j) = 0._r8 + end if + bmatrix_soil(c,3,j) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + bmatrix_soil(c,2,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j == 1) then + ! this is the snow/soil interface layer + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + if (j /= 1) then + bmatrix_soil(c,4,j) = - frac_sno_eff(c) * (1._r8-cnfac) * fact(c,j) & + * tk(c,j-1)/dzm + end if + bmatrix_soil(c,3,j) = 1._r8 + (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp & + + frac_sno_eff(c) * tk(c,j-1)/dzm) & + - (1._r8 - frac_sno_eff(c))*fact(c,j)*dhsdT(c) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + else if (j == nlevgrnd) then + dzm = (z(c,j)-z(c,j-1)) + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + bmatrix_soil(c,2,j) = 0._r8 + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SoilUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_SoilNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + dhsdT, tk, tk_h2osfc, dz_h2osfc, fact, frac_sno_eff, bmatrix_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal soil layers. + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil(bounds%begc: , 1:, 1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil) == (/bounds%endc, nband, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! non-urban columns -------------------------------------------------------------- + ! + do j = 1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + if (j /= 1) then + bmatrix_soil(c,4,j) = 0._r8 + end if + bmatrix_soil(c,3,j) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + bmatrix_soil(c,2,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j == 1) then + ! this is the snow/soil interface layer + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + if (j /= 1) then + bmatrix_soil(c,4,j) = - frac_sno_eff(c) * (1._r8-cnfac) * fact(c,j) & + * tk(c,j-1)/dzm + end if + bmatrix_soil(c,3,j) = 1._r8 + (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp & + + frac_sno_eff(c) * tk(c,j-1)/dzm) & + - (1._r8 - frac_sno_eff(c))*fact(c,j)*dhsdT(c) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + bmatrix_soil(c,2,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + else if (j == nlevgrnd) then + dzm = (z(c,j)-z(c,j-1)) + bmatrix_soil(c,4,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + bmatrix_soil(c,3,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + bmatrix_soil(c,2,j) = 0._r8 + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_SoilNonUrban + + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_Snow(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, frac_sno_eff, bmatrix_soil_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil-snow interaction + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(out) :: bmatrix_soil_snow(bounds%begc: , 1: ,1: ) ! matrix enteries + !------------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + associate( & + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + ! Initialize + bmatrix_soil_snow(begc:endc, :, :) = 0.0_r8 + + call SetMatrix_Soil_SnowUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil_snow( begc:endc, 1:, 1: )) + + call SetMatrix_Soil_SnowNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil_snow( begc:endc, 1:, 1: )) + + end associate + + end subroutine SetMatrix_Soil_Snow + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_SnowUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, frac_sno_eff, bmatrix_soil_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil-snow interaction for + ! urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil_snow(bounds%begc: , 1: ,1: ) ! matrix enteries + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + associate(& + begc => bounds%begc , & ! Input: [integer ] beginning column index + endc => bounds%endc & ! Input: [integer ] ending column index + ) + + call SetMatrix_Soil_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + bmatrix_soil_snow( begc:endc, 1:, 1: )) + + call SetMatrix_Soil_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk( begc:endc, -nlevsno+1: ), & + fact( begc:endc, -nlevsno+1: ), & + frac_sno_eff(begc:endc), & + bmatrix_soil_snow( begc:endc, 1:, 1: )) + + end associate + + endsubroutine SetMatrix_Soil_SnowUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_SnowUrbanNonRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, bmatrix_soil_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil-snow interaction for + ! urban sunwall/shadewall/roof columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(inout) :: bmatrix_soil_snow(bounds%begc: , 1: ,1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + associate( & + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + ! + ! + do j = 1,1 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if ((col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_soil_snow(c,5,j) = 0._r8 + else if (j <= nlevurb-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + bmatrix_soil_snow(c,5,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + end if + end if + end if + end if + enddo + end do + + end associate + + end subroutine SetMatrix_Soil_SnowUrbanNonRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_SnowUrbanRoad(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, frac_sno_eff, bmatrix_soil_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil-snow interaction for + ! urban road (impervious + pervious) columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_road_imperv, icol_road_perv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil_snow(bounds%begc: , 1: ,1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! urban road columns ------------------------------------------------------------- + ! + do j = 1,1 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_imperv .or. col%itype(c) == icol_road_perv) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_soil_snow(c,5,j) = 0._r8 + else if (j == 1) then + ! this is the snow/soil interface layer + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + + bmatrix_soil_snow(c,5,j) = - frac_sno_eff(c) * (1._r8-cnfac) * fact(c,j) & + * tk(c,j-1)/dzm + end if + end if + end if + end if + end do + end do + + end associate + + end subroutine SetMatrix_Soil_SnowUrbanRoad + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_SnowNonUrban(bounds, num_nolakec, filter_nolakec, nband, & + tk, fact, frac_sno_eff, bmatrix_soil_snow) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil-snow interaction for + ! non urban columns + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: frac_sno_eff(bounds%begc: ) ! fraction of ground covered by snow (0 to 1) + real(r8), intent(inout) :: bmatrix_soil_snow(bounds%begc: , 1: ,1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: j,c,l ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_sno_eff) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_snow) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + associate(& + z => col%z & ! Input: [real(r8) (:,:)] layer thickness (m) + ) + + ! + ! non-urban columns -------------------------------------------------------------- + ! + do j = 1,1 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + if (j >= col%snl(c)+1) then + if (j == col%snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + bmatrix_soil_snow(c,5,j) = 0._r8 + else if (j == 1) then + ! this is the snow/soil interface layer + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + + bmatrix_soil_snow(c,5,j) = -frac_sno_eff(c) * (1._r8-cnfac) * fact(c,j) & + * tk(c,j-1)/dzm + end if + end if + end if + end do + end do + + end associate + + end subroutine SetMatrix_Soil_SnowNonUrban + + !----------------------------------------------------------------------- + subroutine SetMatrix_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, dtime, nband, & + dhsdT, tk, tk_h2osfc, fact, c_h2osfc, dz_h2osfc, bmatrix_ssw) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to internal standing water layer + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: dtime ! land model time step (sec) + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: dhsdT(bounds%begc: ) ! temperature derivative of "hs" [col] + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(out) :: bmatrix_ssw(bounds%begc: , 1:, 0: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(dhsdT) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_ssw) == (/bounds%endc, nband, 0/)), errMsg(__FILE__, __LINE__)) + + ! Initialize + bmatrix_ssw(bounds%begc:bounds%endc, :, :) = 0.0_r8 + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + bmatrix_ssw(c,3,0)= 1+(1._r8-cnfac)*(dtime/c_h2osfc(c)) & + *tk_h2osfc(c)/dzm -(dtime/c_h2osfc(c))*dhsdT(c) !interaction from atm + + enddo + + end subroutine SetMatrix_StandingSurfaceWater + + !----------------------------------------------------------------------- + subroutine SetMatrix_StandingSurfaceWater_Soil(bounds, num_nolakec, filter_nolakec, dtime, nband, & + tk, tk_h2osfc, fact, c_h2osfc, dz_h2osfc, bmatrix_ssw_soil) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to standing surface water-soil layer interaction + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + real(r8), intent(in) :: dtime ! land model time step (sec) + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk(bounds%begc: ,-nlevsno+1: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: c_h2osfc( bounds%begc: ) ! heat capacity of surface water [col] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(out) :: bmatrix_ssw_soil(bounds%begc: , 1: ,0: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_ssw_soil) == (/bounds%endc, nband, 0/)), errMsg(__FILE__, __LINE__)) + + ! Initialize + bmatrix_ssw_soil(bounds%begc:bounds%endc, :, :) = 0.0_r8 + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + bmatrix_ssw_soil(c,2,0)= -(1._r8-cnfac)*(dtime/c_h2osfc(c))*tk_h2osfc(c)/dzm !flux to top soil layer + + enddo + + end subroutine SetMatrix_StandingSurfaceWater_Soil + + !----------------------------------------------------------------------- + subroutine SetMatrix_Soil_StandingSurfaceWater(bounds, num_nolakec, filter_nolakec, nband, & + tk_h2osfc, fact, dz_h2osfc, frac_h2osfc, bmatrix_soil_ssw) + ! + ! !DESCRIPTION: + ! Setup the matrix entries corresponding to soil layer-standing surface water interaction + ! + ! !USES: + use clm_varcon , only : cnfac + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varpar , only : nlevsno, nlevgrnd + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: nband ! number of bands of the tridigonal matrix + real(r8), intent(in) :: tk_h2osfc(bounds%begc: ) ! thermal conductivity [W/(m K)] + real(r8), intent(in) :: fact( bounds%begc: , -nlevsno+1: ) ! used in computing tridiagonal matrix [col, lev] + real(r8), intent(in) :: dz_h2osfc(bounds%begc: ) ! Thickness of standing water [m] + real(r8), intent(in) :: frac_h2osfc(bounds%begc: ) ! fractional area with surface water greater than zero + real(r8), intent(out) :: bmatrix_soil_ssw(bounds%begc: , 1:, 1: ) ! matrix enteries + ! + ! !LOCAL VARIABLES: + integer :: c ! indices + integer :: fc ! lake filtered column indices + real(r8) :: dzm ! used in computing tridiagonal matrix + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(fact) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dz_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_h2osfc) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bmatrix_soil_ssw) == (/bounds%endc, nband, 1/)), errMsg(__FILE__, __LINE__)) + + ! Initialize + bmatrix_soil_ssw(bounds%begc:bounds%endc, :, :) = 0.0_r8 + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + ! surface water layer has two coefficients + dzm=(0.5*dz_h2osfc(c)+col%z(c,1)) + + ! top soil layer has sub coef shifted to 2nd super diagonal + if ( frac_h2osfc(c) /= 0.0_r8 )then + bmatrix_soil_ssw(c,4,1)= - frac_h2osfc(c) * (1._r8-cnfac) * fact(c,1) & + * tk_h2osfc(c)/dzm !flux from h2osfc + end if + enddo + + end subroutine SetMatrix_Soil_StandingSurfaceWater + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: BuildingHAC + ! + ! !INTERFACE: + subroutine BuildingHAC( bounds, num_urbanl, filter_urbanl, temperature_inst, urbanparams_inst, cool_on, heat_on ) + ! !DESCRIPTION: + ! Simpler method to manage building temperature (first introduced in CLM4.5). Restricts building + ! temperature to within bounds, and determine's if heating or cooling is on. + ! !USES: + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + type(temperature_type), intent(inout) :: temperature_inst ! Temperature variables + type(urbanparams_type), intent(in) :: urbanparams_inst ! urban parameters + logical, intent(out) :: cool_on(bounds%begl:) ! is urban air conditioning on? + logical, intent(out) :: heat_on(bounds%begl:) ! is urban heating on? + !----------------------------------------------------------------------- + ! !LOCAL VARIABLES: + integer :: fl,l ! indices + !EOP + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(cool_on) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(heat_on) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + associate(& + urbpoi => lun%urbpoi , & ! Input: [logical (:)] true => landunit is an urban point + + t_building => temperature_inst%t_building_lun , & ! Input: [real(r8) (:)] internal building air temperature (K) + + t_building_max => urbanparams_inst%t_building_max , & ! Input: [real(r8) (:)] maximum internal building air temperature (K) + t_building_min => urbanparams_inst%t_building_min & ! Input: [real(r8) (:)] minimum internal building air temperature (K) + ) + ! Restrict internal building temperature to between min and max + ! and determine if heating or air conditioning is on + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + cool_on(l) = .false. + heat_on(l) = .false. + if (t_building(l) > t_building_max(l)) then + t_building(l) = t_building_max(l) + cool_on(l) = .true. + heat_on(l) = .false. + else if (t_building(l) < t_building_min(l)) then + t_building(l) = t_building_min(l) + cool_on(l) = .false. + heat_on(l) = .true. + end if + end if + end do + + end associate + + end subroutine BuildingHAC + + !----------------------------------------------------------------------- + +end module SoilTemperatureMod + diff --git a/components/clm/src/biogeophys/SoilWaterMovementMod.F90 b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 new file mode 100644 index 0000000000..b087b91629 --- /dev/null +++ b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 @@ -0,0 +1,828 @@ +module SoilWaterMovementMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! DESCRIPTION + ! module contains different subroutines to couple soil and root water interactions + ! + ! created by Jinyun Tang, Mar 12, 2014 + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilWater ! Calculate soil hydrology + public :: init_soilwater_movement + ! + ! !PRIVATE DATA MEMBERS: + integer, parameter :: zengdecker_2009 = 0 + integer :: soilroot_water_method !0: use the Zeng and deck method, this will be readin from namelist in the future + + ! + ! The following is only public for the sake of unit testing; it should not be called + ! directly by CLM code outside this module + public :: Compute_EffecRootFrac_And_VertTranSink + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine init_soilwater_movement() + ! + !DESCRIPTION + !specify method for doing soil&root water interactions + ! + ! !ARGUMENTS: + !------------------------------------------------------------------------------ + + soilroot_water_method = zengdecker_2009 + + end subroutine init_soilwater_movement + + !----------------------------------------------------------------------- + subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + waterflux_inst, waterstate_inst, temperature_inst, soil_water_retention_curve) + ! + ! DESCRIPTION + ! select one subroutine to do the soil and root water coupling + ! + !USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : nlevsoi + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varpar , only : nlevsoi + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterFluxType , only : waterflux_type + use WaterStateType , only : waterstate_type + use ColumnType , only : col + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use clm_varcon , only : denh2o, denice + use clm_varctl, only : use_flexibleCN + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'SoilWater' ! subroutine name + real(r8) :: xs(bounds%begc:bounds%endc) !excess soil water above urban ponding limit + real(r8) :: watmin + integer :: fc, c, j + + !------------------------------------------------------------------------------ + + associate( & + wa => soilhydrology_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + ) + select case(soilroot_water_method) + + case (zengdecker_2009) + + call soilwater_zengdecker2009(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + waterflux_inst, waterstate_inst, temperature_inst, soil_water_retention_curve) + + case default + + call endrun(subname // ':: a SoilWater implementation must be specified!') + + end select + + if (use_flexibleCN) then + !a work around of the negative liquid water. Jinyun Tang, Jan 14, 2015 + watmin = 0.001_r8 + + do j = 1, nlevsoi-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < 0._r8) then + xs(c) = watmin - h2osoi_liq(c,j) + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j ) = h2osoi_liq(c,j ) + xs(c) + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) - xs(c) + end do + end do + + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin-h2osoi_liq(c,j) + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + wa(c) = wa(c) - xs(c) + end do + + !update volumetric soil moisture for bgc calculation + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) & + + h2osoi_ice(c,j)/(dz(c,j)*denice) + enddo + enddo + end if + end associate + end subroutine SoilWater + + !----------------------------------------------------------------------- + subroutine Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, & + filter_hydrologyc, vert_tran_sink, waterflux_inst, soilstate_inst) + ! + ! Generic routine to apply transpiration as a sink condition that + ! is vertically distributed over the soil column. Should be + ! applicable to any Richards solver that is not coupled to plant + ! hydraulics. + ! + !USES: + use decompMod , only : bounds_type + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : nlevsoi, max_patch_per_col + use SoilStateType , only : soilstate_type + use WaterFluxType , only : waterflux_type + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + real(r8) , intent(out) :: vert_tran_sink(bounds%begc:,1:) ! vertically distributed transpiration sink (mm H2O/s) (+ = to atm) + type(waterflux_type) , intent(inout) :: waterflux_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,fc,j ! do loop indices + integer :: pi ! patch index + real(r8) :: temp(bounds%begc:bounds%endc) ! accumulator for rootr weighting + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(vert_tran_sink) == (/bounds%endc, nlevsoi/)), errMsg(__FILE__, __LINE__)) + + associate(& + qflx_tran_veg_col => waterflux_inst%qflx_tran_veg_col , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_tran_veg_patch => waterflux_inst%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + rootr_col => soilstate_inst%rootr_col , & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer + rootr_patch => soilstate_inst%rootr_patch & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer + ) + + ! First step is to calculate the column-level effective rooting + ! fraction in each soil layer. This is done outside the usual + ! PATCH-to-column averaging routines because it is not a simple + ! weighted average of the PATCH level rootr arrays. Instead, the + ! weighting depends on both the per-unit-area transpiration + ! of the PATCH and the PATCHEs area relative to all PATCHES. + + temp(bounds%begc : bounds%endc) = 0._r8 + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + rootr_col(c,j) = 0._r8 + end do + end do + + do pi = 1,max_patch_per_col + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + rootr_col(c,j) = rootr_col(c,j) + rootr_patch(p,j) * qflx_tran_veg_patch(p) * patch%wtcol(p) + end if + end if + end do + end do + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + if (patch%active(p)) then + temp(c) = temp(c) + qflx_tran_veg_patch(p) * patch%wtcol(p) + end if + end if + end do + end do + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (temp(c) /= 0._r8) then + rootr_col(c,j) = rootr_col(c,j)/temp(c) + end if + vert_tran_sink(c,j) = rootr_col(c,j)*qflx_tran_veg_col(c) + end do + end do + + end associate + + end subroutine Compute_EffecRootFrac_And_VertTranSink + + !----------------------------------------------------------------------- + subroutine soilwater_zengdecker2009(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + waterflux_inst, waterstate_inst, temperature_inst, soil_water_retention_curve) + ! + ! !DESCRIPTION: + ! Soil hydrology + ! Soil moisture is predicted from a 10-layer model (as with soil + ! temperature), in which the vertical soil moisture transport is governed + ! by infiltration, runoff, gradient diffusion, gravity, and root + ! extraction through canopy transpiration. The net water applied to the + ! surface layer is the snowmelt plus precipitation plus the throughfall + ! of canopy dew minus surface runoff and evaporation. + ! CLM3.5 uses a zero-flow bottom boundary condition. + ! + ! The vertical water flow in an unsaturated porous media is described by + ! Darcy's law, and the hydraulic conductivity and the soil negative + ! potential vary with soil water content and soil texture based on the work + ! of Clapp and Hornberger (1978) and Cosby et al. (1984). The equation is + ! integrated over the layer thickness, in which the time rate of change in + ! water mass must equal the net flow across the bounding interface, plus the + ! rate of internal source or sink. The terms of water flow across the layer + ! interfaces are linearly expanded by using first-order Taylor expansion. + ! The equations result in a tridiagonal system equation. + ! + ! Note: length units here are all millimeter + ! (in temperature subroutine uses same soil layer + ! structure required but lengths are m) + ! + ! Richards equation: + ! + ! d wat d d wat d psi + ! ----- = - -- [ k(----- ----- - 1) ] + S + ! dt dz dz d wat + ! + ! where: wat = volume of water per volume of soil (mm**3/mm**3) + ! psi = soil matrix potential (mm) + ! dt = time step (s) + ! z = depth (mm) + ! dz = thickness (mm) + ! qin = inflow at top (mm h2o /s) + ! qout= outflow at bottom (mm h2o /s) + ! s = source/sink flux (mm h2o /s) + ! k = hydraulic conductivity (mm h2o /s) + ! + ! d qin d qin + ! qin[n+1] = qin[n] + -------- d wat(j-1) + --------- d wat(j) + ! d wat(j-1) d wat(j) + ! ==================|================= + ! < qin + ! + ! d wat(j)/dt * dz = qin[n+1] - qout[n+1] + S(j) + ! + ! > qout + ! ==================|================= + ! d qout d qout + ! qout[n+1] = qout[n] + --------- d wat(j) + --------- d wat(j+1) + ! d wat(j) d wat(j+1) + ! + ! + ! Solution: linearize k and psi about d wat and use tridiagonal + ! system of equations to solve for d wat, + ! where for layer j + ! + ! + ! r_j = a_j [d wat_j-1] + b_j [d wat_j] + c_j [d wat_j+1] + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_LATICE, SHR_CONST_G + use decompMod , only : bounds_type + use clm_varcon , only : wimp,grav,hfus,tfrz + use clm_varcon , only : e_ice,denh2o, denice + use clm_varpar , only : nlevsoi, max_patch_per_col, nlevgrnd + use clm_time_manager , only : get_step_size + use column_varcon , only : icol_roof, icol_road_imperv + use clm_varctl , only : use_flexibleCN + use TridiagonalMod , only : Tridiagonal + use abortutils , only : endrun + use SoilStateType , only : soilstate_type + use SoilHydrologyType , only : soilhydrology_type + use TemperatureType , only : temperature_type + use WaterFluxType , only : waterflux_type + use WaterStateType , only : waterstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use PatchType , only : patch + use ColumnType , only : col + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(soilhydrology_type), intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + ! + ! !LOCAL VARIABLES: + integer :: p,c,fc,j ! do loop indices + integer :: jtop(bounds%begc:bounds%endc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + real(r8) :: hk(bounds%begc:bounds%endc,1:nlevsoi) ! hydraulic conductivity [mm h2o/s] + real(r8) :: dhkdw(bounds%begc:bounds%endc,1:nlevsoi) ! d(hk)/d(vol_liq) + real(r8) :: amx(bounds%begc:bounds%endc,1:nlevsoi+1) ! "a" left off diagonal of tridiagonal matrix + real(r8) :: bmx(bounds%begc:bounds%endc,1:nlevsoi+1) ! "b" diagonal column for tridiagonal matrix + real(r8) :: cmx(bounds%begc:bounds%endc,1:nlevsoi+1) ! "c" right off diagonal tridiagonal matrix + real(r8) :: rmx(bounds%begc:bounds%endc,1:nlevsoi+1) ! "r" forcing term of tridiagonal matrix + real(r8) :: zmm(bounds%begc:bounds%endc,1:nlevsoi+1) ! layer depth [mm] + real(r8) :: dzmm(bounds%begc:bounds%endc,1:nlevsoi+1) ! layer thickness [mm] + real(r8) :: den ! used in calculating qin, qout + real(r8) :: dqidw0(bounds%begc:bounds%endc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i-1)) + real(r8) :: dqidw1(bounds%begc:bounds%endc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i)) + real(r8) :: dqodw1(bounds%begc:bounds%endc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i)) + real(r8) :: dqodw2(bounds%begc:bounds%endc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i+1)) + real(r8) :: dsmpdw(bounds%begc:bounds%endc,1:nlevsoi+1) ! d(smp)/d(vol_liq) + real(r8) :: num ! used in calculating qin, qout + real(r8) :: qin(bounds%begc:bounds%endc,1:nlevsoi+1) ! flux of water into soil layer [mm h2o/s] + real(r8) :: qout(bounds%begc:bounds%endc,1:nlevsoi+1) ! flux of water out of soil layer [mm h2o/s] + real(r8) :: s_node ! soil wetness + real(r8) :: s1 ! "s" at interface of layer + real(r8) :: s2 ! k*s**(2b+2) + real(r8) :: smp(bounds%begc:bounds%endc,1:nlevsoi) ! soil matrix potential [mm] + real(r8) :: sdamp ! extrapolates soiwat dependence of evaporation + integer :: pi ! patch index + real(r8) :: temp(bounds%begc:bounds%endc) ! accumulator for rootr weighting + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + real(r8) :: smp1,dsmpdw1,wh,wh_zwt,ka + real(r8) :: dwat2(bounds%begc:bounds%endc,1:nlevsoi+1) + real(r8) :: dzq ! used in calculating qin, qout (difference in equilbirium matric potential) + real(r8) :: zimm(bounds%begc:bounds%endc,0:nlevsoi) ! layer interface depth [mm] + real(r8) :: zq(bounds%begc:bounds%endc,1:nlevsoi+1) ! equilibrium matric potential for each layer [mm] + real(r8) :: vol_eq(bounds%begc:bounds%endc,1:nlevsoi+1) ! equilibrium volumetric water content + real(r8) :: tempi ! temp variable for calculating vol_eq + real(r8) :: temp0 ! temp variable for calculating vol_eq + real(r8) :: voleq1 ! temp variable for calculating vol_eq + real(r8) :: zwtmm(bounds%begc:bounds%endc) ! water table depth [mm] + real(r8) :: imped(bounds%begc:bounds%endc,1:nlevsoi) + real(r8) :: vol_ice(bounds%begc:bounds%endc,1:nlevsoi) + real(r8) :: z_mid + real(r8) :: vwc_zwt(bounds%begc:bounds%endc) + real(r8) :: vwc_liq(bounds%begc:bounds%endc,1:nlevsoi+1) ! liquid volumetric water content + real(r8) :: smp_grad(bounds%begc:bounds%endc,1:nlevsoi+1) + real(r8) :: dsmpds !temporary variable + real(r8) :: dhkds !temporary variable + real(r8) :: hktmp !temporary variable + real(r8) :: vert_tran_sink(bounds%begc:bounds%endc,1:nlevsoi) ! vertically distributed transpiration sink (mm H2O/s) (+ = to atm) + !----------------------------------------------------------------------- + + associate(& + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + + origflag => soilhydrology_inst%origflag , & ! Input: constant + qcharge => soilhydrology_inst%qcharge_col , & ! Input: [real(r8) (:) ] aquifer recharge rate (mm/s) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + fracice => soilhydrology_inst%fracice_col , & ! Input: [real(r8) (:,:) ] fractional impermeability (-) + icefrac => soilhydrology_inst%icefrac_col , & ! Input: [real(r8) (:,:) ] fraction of ice + hkdepth => soilhydrology_inst%hkdepth_col , & ! Input: [real(r8) (:) ] decay factor (m) + + smpmin => soilstate_inst%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + eff_porosity => soilstate_inst%eff_porosity_col , & ! Input: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + smp_l => soilstate_inst%smp_l_col , & ! Input: [real(r8) (:,:) ] soil matrix potential [mm] + hk_l => soilstate_inst%hk_l_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity (mm/s) + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice water (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + + qflx_deficit => waterflux_inst%qflx_deficit_col , & ! Input: [real(r8) (:) ] water deficit to keep non-negative liquid water content + qflx_infl => waterflux_inst%qflx_infl_col , & ! Input: [real(r8) (:) ] infiltration (mm H2O /s) + + qflx_rootsoi => waterflux_inst%qflx_rootsoi_col , & ! Output: [real(r8) (:,:) ] vegetation/soil water exchange (m H2O/s) (+ = to atm) + qflx_tran_veg_col => waterflux_inst%qflx_tran_veg_col , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + rootr_col => soilstate_inst%rootr_col , & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer + t_soisno => temperature_inst%t_soisno_col & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + ) + + ! Get time step + + dtime = get_step_size() + + call Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, & + filter_hydrologyc, vert_tran_sink(bounds%begc:bounds%endc, 1:), & + waterflux_inst, soilstate_inst) + + ! Because the depths in this routine are in mm, use local + ! variable arrays instead of pointers + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zmm(c,j) = z(c,j)*1.e3_r8 + dzmm(c,j) = dz(c,j)*1.e3_r8 + zimm(c,j) = zi(c,j)*1.e3_r8 + + ! calculate icefrac up here + vol_ice(c,j) = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + icefrac(c,j) = min(1._r8,vol_ice(c,j)/watsat(c,j)) + vwc_liq(c,j) = max(h2osoi_liq(c,j),1.0e-6_r8)/(dz(c,j)*denh2o) + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zimm(c,0) = 0.0_r8 + zwtmm(c) = zwt(c)*1.e3_r8 + end do + + ! compute jwt index + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + + ! compute vwc at water table depth (mainly for case when t < tfrz) + ! this will only be used when zwt is below the soil column + vwc_zwt(c) = watsat(c,nlevsoi) + if(t_soisno(c,jwt(c)+1) < tfrz) then + vwc_zwt(c) = vwc_liq(c,nlevsoi) + do j = nlevsoi,nlevgrnd + if(zwt(c) <= zi(c,j)) then + smp1 = hfus*(tfrz-t_soisno(c,j))/(grav*t_soisno(c,j)) * 1000._r8 !(mm) + !smp1 = max(0._r8,smp1) + smp1 = max(sucsat(c,nlevsoi),smp1) + vwc_zwt(c) = watsat(c,nlevsoi)*(smp1/sucsat(c,nlevsoi))**(-1._r8/bsw(c,nlevsoi)) + ! for temperatures close to tfrz, limit vwc to total water content + vwc_zwt(c) = min(vwc_zwt(c), 0.5*(watsat(c,nlevsoi) + h2osoi_vol(c,nlevsoi)) ) + exit + endif + enddo + endif + end do + + ! calculate the equilibrium water content based on the water table depth + + do j=1,nlevsoi + do fc=1, num_hydrologyc + c = filter_hydrologyc(fc) + if ((zwtmm(c) <= zimm(c,j-1))) then + vol_eq(c,j) = watsat(c,j) + + ! use the weighted average from the saturated part (depth > wtd) and the equilibrium solution for the + ! rest of the layer, the equilibrium solution is based on Clapp-Hornberg parameterization + ! and no extension to full range swrc is needed + + else if ((zwtmm(c) .lt. zimm(c,j)) .and. (zwtmm(c) .gt. zimm(c,j-1))) then + tempi = 1.0_r8 + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + voleq1 = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j-1))*(tempi-temp0) + vol_eq(c,j) = (voleq1*(zwtmm(c)-zimm(c,j-1)) + watsat(c,j)*(zimm(c,j)-zwtmm(c)))/(zimm(c,j)-zimm(c,j-1)) + vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j)) + vol_eq(c,j) = max(vol_eq(c,j),0.0_r8) + else + tempi = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + vol_eq(c,j) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zimm(c,j)-zimm(c,j-1))*(tempi-temp0) + vol_eq(c,j) = max(vol_eq(c,j),0.0_r8) + vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j)) + endif + zq(c,j) = -sucsat(c,j)*(max(vol_eq(c,j)/watsat(c,j),0.01_r8))**(-bsw(c,j)) + zq(c,j) = max(smpmin(c), zq(c,j)) + end do + end do + + ! If water table is below soil column calculate zq for the 11th layer + j = nlevsoi + do fc=1, num_hydrologyc + c = filter_hydrologyc(fc) + if(jwt(c) == nlevsoi) then + tempi = 1._r8 + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + vol_eq(c,j+1) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j))*(tempi-temp0) + vol_eq(c,j+1) = max(vol_eq(c,j+1),0.0_r8) + vol_eq(c,j+1) = min(watsat(c,j),vol_eq(c,j+1)) + zq(c,j+1) = -sucsat(c,j)*(max(vol_eq(c,j+1)/watsat(c,j),0.01_r8))**(-bsw(c,j)) + zq(c,j+1) = max(smpmin(c), zq(c,j+1)) + end if + end do + + ! Hydraulic conductivity and soil matric potential and their derivatives + + sdamp = 0._r8 + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + ! compute hydraulic conductivity based on liquid water content only + + if (origflag == 1) then + s1 = 0.5_r8*(h2osoi_vol(c,j) + h2osoi_vol(c,min(nlevsoi, j+1))) / & + (0.5_r8*(watsat(c,j)+watsat(c,min(nlevsoi, j+1)))) + else + s1 = 0.5_r8*(vwc_liq(c,j) + vwc_liq(c,min(nlevsoi, j+1))) / & + (0.5_r8*(watsat(c,j)+watsat(c,min(nlevsoi, j+1)))) + endif + s1 = min(1._r8, s1) + s2 = hksat(c,j)*s1**(2._r8*bsw(c,j)+2._r8) + + ! replace fracice with impedance factor, as in zhao 97,99 + if (origflag == 1) then + imped(c,j)=(1._r8-0.5_r8*(fracice(c,j)+fracice(c,min(nlevsoi, j+1)))) + else + imped(c,j)=10._r8**(-e_ice*(0.5_r8*(icefrac(c,j)+icefrac(c,min(nlevsoi, j+1))))) + endif + hk(c,j) = imped(c,j)*s1*s2 + dhkdw(c,j) = imped(c,j)*(2._r8*bsw(c,j)+3._r8)*s2* & + (1._r8/(watsat(c,j)+watsat(c,min(nlevsoi, j+1)))) + + !compute un-restricted hydraulic conductivity + !call soil_water_retention_curve%soil_hk(hksat(c,j), imped(c,j), s1, bsw(c,j), hktmp, dhkds) + !if(hktmp/=hk(c,j))write(10,*)'diff',hktmp,hk(c,j) + ! call endrun('bad in hk') + !endif + !apply ice impedance + !hk(c,j) = imped(c,j)*hk(c,j) + !dhkdw(c,j) = imped(c,j) * dhkds * (1._r8/(watsat(c,j)+watsat(c,min(nlevsoi, j+1)))) + + + ! compute matric potential and derivative based on liquid water content only + if (origflag == 1) then + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + else + s_node = max(vwc_liq(c,j)/watsat(c,j), 0.01_r8) + endif + s_node = min(1.0_r8, s_node) + + !call soil_water_retention_curve%soil_suction(sucsat(c,j), s_node, bsw(c,j), smp(c,j), dsmpds) + + smp(c,j) = -sucsat(c,j)*s_node**(-bsw(c,j)) + smp(c,j) = max(smpmin(c), smp(c,j)) + !do not turn on the line below, which will cause bit to bit error, jyt, 2014 Mar 6 + !dsmpdw(c,j) = dsmpds/watsat(c,j) + + if (origflag == 1) then + dsmpdw(c,j) = -bsw(c,j)*smp(c,j)/(s_node*watsat(c,j)) + else + dsmpdw(c,j) = -bsw(c,j)*smp(c,j)/vwc_liq(c,j) + endif + + smp_l(c,j) = smp(c,j) + hk_l(c,j) = hk(c,j) + + end do + end do + + ! aquifer (11th) layer + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zmm(c,nlevsoi+1) = 0.5*(1.e3_r8*zwt(c) + zmm(c,nlevsoi)) + if(jwt(c) < nlevsoi) then + dzmm(c,nlevsoi+1) = dzmm(c,nlevsoi) + else + dzmm(c,nlevsoi+1) = (1.e3_r8*zwt(c) - zmm(c,nlevsoi)) + end if + end do + + ! Set up r, a, b, and c vectors for tridiagonal solution + + ! Node j=1 (top) + + j = 1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qin(c,j) = qflx_infl(c) + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp(c,j+1)-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den + rmx(c,j) = qin(c,j) - qout(c,j) - vert_tran_sink(c,j) + amx(c,j) = 0._r8 + bmx(c,j) = dzmm(c,j)*(sdamp+1._r8/dtime) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + + end do + + ! Nodes j=2 to j=nlevsoi-1 + + do j = 2, nlevsoi - 1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp(c,j+1)-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den + rmx(c,j) = qin(c,j) - qout(c,j) - vert_tran_sink(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + + end do + end do + + ! Node j=nlevsoi (bottom) + + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if(j > jwt(c)) then !water table is in soil column + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + qout(c,j) = 0._r8 + dqodw1(c,j) = 0._r8 + rmx(c,j) = qin(c,j) - qout(c,j) - vert_tran_sink(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = 0._r8 + + ! next set up aquifer layer; hydrologically inactive + rmx(c,j+1) = 0._r8 + amx(c,j+1) = 0._r8 + bmx(c,j+1) = dzmm(c,j+1)/dtime + cmx(c,j+1) = 0._r8 + else ! water table is below soil column + + ! compute aquifer soil moisture as average of layer 10 and saturation + if(origflag == 1) then + s_node = max(0.5*(1.0_r8+h2osoi_vol(c,j)/watsat(c,j)), 0.01_r8) + else + s_node = max(0.5*((vwc_zwt(c)+vwc_liq(c,j))/watsat(c,j)), 0.01_r8) + endif + s_node = min(1.0_r8, s_node) + + ! compute smp for aquifer layer + !call soil_water_retention_curve%soil_suction(sucsat(c,j), s_node, bsw(c,j), smp1, dsmpds) + smp1 = -sucsat(c,j)*s_node**(-bsw(c,j)) + smp1 = max(smpmin(c), smp1) + + ! compute dsmpdw for aquifer layer + !dsmpdw1 = dsmpds/watsat(c,j) + dsmpdw1 = -bsw(c,j)*smp1/(s_node*watsat(c,j)) + + ! first set up bottom layer of soil column + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp1-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw1 + num*dhkdw(c,j))/den + + rmx(c,j) = qin(c,j) - qout(c,j) - vert_tran_sink(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + + ! next set up aquifer layer; den/num unchanged, qin=qout + qin(c,j+1) = qout(c,j) + dqidw0(c,j+1) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqidw1(c,j+1) = -( hk(c,j)*dsmpdw1 + num*dhkdw(c,j))/den + qout(c,j+1) = 0._r8 ! zero-flow bottom boundary condition + dqodw1(c,j+1) = 0._r8 ! zero-flow bottom boundary condition + rmx(c,j+1) = qin(c,j+1) - qout(c,j+1) + amx(c,j+1) = -dqidw0(c,j+1) + bmx(c,j+1) = dzmm(c,j+1)/dtime - dqidw1(c,j+1) + dqodw1(c,j+1) + cmx(c,j+1) = 0._r8 + endif + end do + + + + ! Solve for dwat + + jtop(bounds%begc : bounds%endc) = 1 + call Tridiagonal(bounds, 1, nlevsoi+1, & + jtop(bounds%begc:bounds%endc), & + num_hydrologyc, filter_hydrologyc, & + amx(bounds%begc:bounds%endc, :), & + bmx(bounds%begc:bounds%endc, :), & + cmx(bounds%begc:bounds%endc, :), & + rmx(bounds%begc:bounds%endc, :), & + dwat2(bounds%begc:bounds%endc, :) ) + + ! Renew the mass of liquid water + ! also compute qcharge from dwat in aquifer layer + ! update in drainage for case jwt < nlevsoi + + do fc = 1,num_hydrologyc + c = filter_hydrologyc(fc) + do j = 1, nlevsoi + h2osoi_liq(c,j) = h2osoi_liq(c,j) + dwat2(c,j)*dzmm(c,j) + end do + + ! calculate qcharge for case jwt < nlevsoi + if(jwt(c) < nlevsoi) then + wh_zwt = 0._r8 !since wh_zwt = -sucsat - zq_zwt, where zq_zwt = -sucsat + + ! Recharge rate qcharge to groundwater (positive to aquifer) + s_node = max(h2osoi_vol(c,jwt(c)+1)/watsat(c,jwt(c)+1), 0.01_r8) + s1 = min(1._r8, s_node) + + !scs: this is the expression for unsaturated hk + ka = imped(c,jwt(c)+1)*hksat(c,jwt(c)+1) & + *s1**(2._r8*bsw(c,jwt(c)+1)+3._r8) + + !compute unsaturated hk, this shall be tested later, because it + !is not bit for bit + !call soil_water_retention_curve%soil_hk(hksat(c,jwt(c)+1), s1, bsw(c,jwt(c)+1), ka) + !apply ice impedance + !ka = imped(c,jwt(c)+1) * ka + ! Recharge rate qcharge to groundwater (positive to aquifer) + smp1 = max(smpmin(c), smp(c,max(1,jwt(c)))) + wh = smp1 - zq(c,max(1,jwt(c))) + + !scs: original formulation + if(jwt(c) == 0) then + qcharge(c) = -ka * (wh_zwt-wh) /((zwt(c)+1.e-3)*1000._r8) + else + ! qcharge(c) = -ka * (wh_zwt-wh)/((zwt(c)-z(c,jwt(c)))*1000._r8) + !scs: 1/2, assuming flux is at zwt interface, saturation deeper than zwt + qcharge(c) = -ka * (wh_zwt-wh)/((zwt(c)-z(c,jwt(c)))*1000._r8*2.0) + endif + + ! To limit qcharge (for the first several timesteps) + qcharge(c) = max(-10.0_r8/dtime,qcharge(c)) + qcharge(c) = min( 10.0_r8/dtime,qcharge(c)) + else + ! if water table is below soil column, compute qcharge from dwat2(11) + qcharge(c) = dwat2(c,nlevsoi+1)*dzmm(c,nlevsoi+1)/dtime + endif + end do + + ! compute the water deficit and reset negative liquid water content + ! Jinyun Tang + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_deficit(c) = 0._r8 + do j = 1, nlevsoi + if(h2osoi_liq(c,j)<0._r8)then + qflx_deficit(c) = qflx_deficit(c) - h2osoi_liq(c,j) + endif + enddo + enddo + if (use_flexibleCN) then + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_rootsoi(c,j) = qflx_tran_veg_col(c) * rootr_col(c,j) * 1.e-3_r8 ![m H2O/s] + enddo + enddo + end if + end associate + + end subroutine soilwater_zengdecker2009 + + end module SoilWaterMovementMod diff --git a/components/clm/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 b/components/clm/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 new file mode 100644 index 0000000000..c7810228df --- /dev/null +++ b/components/clm/src/biogeophys/SoilWaterRetentionCurveClappHornberg1978Mod.F90 @@ -0,0 +1,134 @@ +module SoilWaterRetentionCurveClappHornberg1978Mod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Implementation of soil_water_retention_curve_type using the Clapp-Hornberg 1978 + ! parameterizations. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + implicit none + save + private + ! + ! !PUBLIC TYPES: + public :: soil_water_retention_curve_clapp_hornberg_1978_type + + type, extends(soil_water_retention_curve_type) :: & + soil_water_retention_curve_clapp_hornberg_1978_type + private + contains + procedure :: soil_hk ! compute hydraulic conductivity + procedure :: soil_suction ! compute soil suction potential + procedure :: soil_suction_inverse ! compute relative saturation at which soil suction is equal to a target value + end type soil_water_retention_curve_clapp_hornberg_1978_type + + interface soil_water_retention_curve_clapp_hornberg_1978_type + ! initialize a new soil_water_retention_curve_clapp_hornberg_1978_type object + module procedure constructor + end interface soil_water_retention_curve_clapp_hornberg_1978_type + +contains + + !----------------------------------------------------------------------- + type(soil_water_retention_curve_clapp_hornberg_1978_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an object of type soil_water_retention_curve_clapp_hornberg_1978_type. + ! For now, this is simply a place-holder. + !----------------------------------------------------------------------- + + end function constructor + + !----------------------------------------------------------------------- + subroutine soil_hk(this, hksat, imped, s, bsw, hk, dhkds) + ! + ! !DESCRIPTION: + ! Compute hydraulic conductivity + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this + real(r8), intent(in) :: hksat !saturated hydraulic conductivity [mm/s] + real(r8), intent(in) :: imped !ice impedance + real(r8), intent(in) :: s !reletive saturation, [0, 1] + real(r8), intent(in) :: bsw !shape parameter + real(r8), intent(out):: hk !hydraulic conductivity [mm/s] + real(r8), optional, intent(out):: dhkds !d[hk]/ds [mm/s] + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'soil_hk' + !----------------------------------------------------------------------- + + !compute hydraulic conductivity + hk=imped*hksat*s**(2._r8*bsw+3._r8) + + !compute the derivative + if(present(dhkds))then + dhkds=(2._r8*bsw+3._r8)*hk/s + endif + + end subroutine soil_hk + + !----------------------------------------------------------------------- + subroutine soil_suction(this, smpsat, s, bsw, smp, dsmpds) + ! + ! !DESCRIPTION: + ! Compute soil suction potential + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this + real(r8), intent(in) :: smpsat !minimum soil suction, positive [mm] + real(r8), intent(in) :: s !reletive saturation, [0, 1] + real(r8), intent(in) :: bsw !shape parameter + real(r8), intent(out) :: smp !soil suction, negative, [mm] + real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm] + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'soil_suction' + !----------------------------------------------------------------------- + + !compute soil suction potential, negative + smp = -smpsat*s**(-bsw) + + !compute derivative + if(present(dsmpds))then + dsmpds=-bsw*smp/s + endif + + end subroutine soil_suction + + !----------------------------------------------------------------------- + subroutine soil_suction_inverse(this, smp_target, smpsat, bsw, s_target) + ! + ! !DESCRIPTION: + ! Compute relative saturation at which soil suction is equal to a target value. + ! This is done by inverting the soil_suction equation to solve for s. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_clapp_hornberg_1978_type), intent(in) :: this + real(r8) , intent(in) :: smp_target ! target soil suction, negative [mm] + real(r8) , intent(in) :: smpsat ! minimum soil suction, positive [mm] + real(r8) , intent(in) :: bsw ! shape parameter + real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1] + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'soil_suction_inverse' + !----------------------------------------------------------------------- + + s_target = (-smp_target/smpsat)**(-1/bsw) + + end subroutine soil_suction_inverse + + +end module SoilWaterRetentionCurveClappHornberg1978Mod + diff --git a/components/clm/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 b/components/clm/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 new file mode 100644 index 0000000000..a2286814c3 --- /dev/null +++ b/components/clm/src/biogeophys/SoilWaterRetentionCurveFactoryMod.F90 @@ -0,0 +1,60 @@ +module SoilWaterRetentionCurveFactoryMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Factory to create an instance of soil_water_retention_curve_type. This module figures + ! out the particular type to return. + ! + ! !USES: + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + implicit none + save + private + ! + ! !PUBLIC ROUTINES: + public :: create_soil_water_retention_curve ! create an object of class soil_water_retention_curve_type + +contains + + !----------------------------------------------------------------------- + function create_soil_water_retention_curve() result(soil_water_retention_curve) + ! + ! !DESCRIPTION: + ! Create and return an object of soil_water_retention_curve_type. The particular type + ! is determined based on a namelist parameter. + ! + ! !USES: + use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use SoilWaterRetentionCurveClappHornberg1978Mod, only : soil_water_retention_curve_clapp_hornberg_1978_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), allocatable :: soil_water_retention_curve ! function result + ! + ! !LOCAL VARIABLES: + + ! For now, hard-code the method. Eventually this will be set from namelist, either by + ! this routine (appropriate if the 'method' is in its own namelist group), or do the + ! namelist read outside this module and pass the method in as a parameter (appropriate + ! if the 'method' is part of a larger namelist group). + character(len=*), parameter :: method = "clapphornberg_1978" + + character(len=*), parameter :: subname = 'create_soil_water_retention_curve' + !----------------------------------------------------------------------- + + select case (method) + + case ("clapphornberg_1978") + allocate(soil_water_retention_curve, & + source=soil_water_retention_curve_clapp_hornberg_1978_type()) + + case default + write(iulog,*) subname//' ERROR: unknown method: ', method + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end select + + end function create_soil_water_retention_curve + +end module SoilWaterRetentionCurveFactoryMod diff --git a/components/clm/src/biogeophys/SoilWaterRetentionCurveMod.F90 b/components/clm/src/biogeophys/SoilWaterRetentionCurveMod.F90 new file mode 100644 index 0000000000..8fdcaa6186 --- /dev/null +++ b/components/clm/src/biogeophys/SoilWaterRetentionCurveMod.F90 @@ -0,0 +1,100 @@ +module SoilWaterRetentionCurveMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abstract base class for functions to compute soil water retention curve + ! + ! !USES: + implicit none + save + private + ! + ! !PUBLIC TYPES: + public :: soil_water_retention_curve_type + + type, abstract :: soil_water_retention_curve_type + private + contains + ! compute hydraulic conductivity + procedure(soil_hk_interface), deferred :: soil_hk + + ! compute soil suction potential + procedure(soil_suction_interface), deferred :: soil_suction + + ! compute relative saturation at which soil suction is equal to a target value + procedure(soil_suction_inverse_interface), deferred :: soil_suction_inverse + end type soil_water_retention_curve_type + + abstract interface + + ! Note: The following interfaces are set up based on the arguments needed for the + ! clapphornberg1978 implementations. It's likely that these interfaces are not + ! totally general for all desired implementations. In that case, we'll need to think + ! about how to support different interfaces. Some possible solutions are: + ! + ! - Make the interfaces contain all possible inputs that are needed by any + ! implementation; each implementation will then ignore the inputs it doesn't need. + ! + ! - For inputs that are needed only by particular implementations - and particularly + ! for inputs that are constant in time (e.g., this is the case for bsw, I think): + ! pass these into the constructor, and save pointers to these inputs as components + ! of the child type that needs them. Then they aren't needed as inputs to the + ! individual routines, allowing the interfaces for these routines to remain more + ! consistent between different implementations. + + subroutine soil_hk_interface(this, hksat, imped, s, bsw, hk, dhkds) + ! !DESCRIPTION: + ! Compute hydraulic conductivity + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + real(r8), intent(in) :: hksat !saturated hydraulic conductivity [mm/s] + real(r8), intent(in) :: imped !ice impedance + real(r8), intent(in) :: s !reletive saturation, [0, 1] + real(r8), intent(in) :: bsw !shape parameter + real(r8), intent(out):: hk !hydraulic conductivity [mm/s] + real(r8), optional, intent(out):: dhkds !d[hk]/ds [mm/s] + end subroutine soil_hk_interface + + + subroutine soil_suction_interface(this, smpsat, s, bsw, smp, dsmpds) + ! !DESCRIPTION: + ! Compute soil suction potential + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + real(r8), intent(in) :: smpsat !minimum soil suction, positive [mm] + real(r8), intent(in) :: s !reletive saturation, [0, 1] + real(r8), intent(in) :: bsw !shape parameter + real(r8), intent(out) :: smp !soil suction, negative, [mm] + real(r8), optional, intent(out) :: dsmpds !d[smp]/ds, [mm] + end subroutine soil_suction_interface + + subroutine soil_suction_inverse_interface(this, smp_target, smpsat, bsw, s_target) + ! !DESCRIPTION: + ! Compute relative saturation at which soil suction is equal to a target value. + ! This is done by inverting the soil_suction equation to solve for s. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + import :: soil_water_retention_curve_type + ! + ! !ARGUMENTS: + class(soil_water_retention_curve_type), intent(in) :: this + real(r8) , intent(in) :: smp_target ! target soil suction, negative [mm] + real(r8) , intent(in) :: smpsat ! minimum soil suction, positive [mm] + real(r8) , intent(in) :: bsw ! shape parameter + real(r8) , intent(out) :: s_target ! relative saturation at which smp = smp_target [0,1] + end subroutine soil_suction_inverse_interface + + end interface + +end module SoilWaterRetentionCurveMod diff --git a/components/clm/src/biogeophys/SolarAbsorbedType.F90 b/components/clm/src/biogeophys/SolarAbsorbedType.F90 new file mode 100644 index 0000000000..b434038ad6 --- /dev/null +++ b/components/clm/src/biogeophys/SolarAbsorbedType.F90 @@ -0,0 +1,408 @@ +module SolarAbsorbedType + + !------------------------------------------------------------------------------ + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_log_mod , only: errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varcon , only : spval + use clm_varctl , only : use_luna + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC DATA MEMBERS: + type, public :: solarabs_type + + ! Solar reflected + real(r8), pointer :: fsr_patch (:) ! patch solar radiation reflected (W/m**2) + + ! Solar Absorbed + real(r8), pointer :: fsa_patch (:) ! patch solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_u_patch (:) ! patch urban solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_r_patch (:) ! patch rural solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: parsun_z_patch (:,:) ! patch absorbed PAR for sunlit leaves in canopy layer (W/m**2) + real(r8), pointer :: parsha_z_patch (:,:) ! patch absorbed PAR for shaded leaves in canopy layer (W/m**2) + real(r8), pointer :: par240d_z_patch (:,:) ! 10-day running mean of daytime patch absorbed PAR for leaves in canopy layer (W/m**2) + real(r8), pointer :: par240x_z_patch (:,:) ! 10-day running mean of maximum patch absorbed PAR for leaves in canopy layer (W/m**2) + real(r8), pointer :: par24d_z_patch (:,:) ! daily accumulated absorbed PAR for leaves in canopy layer from midnight to current step(J/m**2) + real(r8), pointer :: par24x_z_patch (:,:) ! daily max of patch absorbed PAR for leaves in canopy layer from midnight to current step(W/m**2) + real(r8), pointer :: sabg_soil_patch (:) ! patch solar radiation absorbed by soil (W/m**2) + real(r8), pointer :: sabg_snow_patch (:) ! patch solar radiation absorbed by snow (W/m**2) + real(r8), pointer :: sabg_patch (:) ! patch solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: sabg_chk_patch (:) ! patch fsno weighted sum (W/m**2) + real(r8), pointer :: sabg_lyr_patch (:,:) ! patch absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2] + real(r8), pointer :: sabg_pen_patch (:) ! patch (rural) shortwave radiation penetrating top soisno layer [W/m2] + + real(r8), pointer :: sub_surf_abs_SW_col (:) ! col percent of solar radiation absorbed below first snow layer + real(r8), pointer :: sabv_patch (:) ! patch solar radiation absorbed by vegetation (W/m**2) + + real(r8), pointer :: sabs_roof_dir_lun (:,:) ! lun direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif_lun (:,:) ! lun diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir_lun (:,:) ! lun direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif_lun (:,:) ! lun diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir_lun (:,:) ! lun direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif_lun (:,:) ! lun diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir_lun (:,:) ! lun direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif_lun (:,:) ! lun diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir_lun (:,:) ! lun direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif_lun (:,:) ! lun diffuse solar absorbed by pervious road per unit ground area per unit incident flux + + ! Currently needed by lake code + ! TODO (MV 8/20/2014) should be moved in the future + real(r8), pointer :: fsds_nir_d_patch (:) ! patch incident direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_i_patch (:) ! patch incident diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_d_ln_patch (:) ! patch incident direct beam nir solar radiation at local noon (W/m**2) + real(r8), pointer :: fsr_nir_d_patch (:) ! patch reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_i_patch (:) ! patch reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_d_ln_patch (:) ! patch reflected direct beam nir solar radiation at local noon (W/m**2) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, public :: Restart + + end type solarabs_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(solarabs_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! Allocate module variables and data structures + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevcan, nlevcan, numrad, nlevsno + ! + ! !ARGUMENTS: + class(solarabs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begl = bounds%begl; endl = bounds%endl + + allocate(this%fsa_patch (begp:endp)) ; this%fsa_patch (:) = nan + allocate(this%fsa_u_patch (begp:endp)) ; this%fsa_u_patch (:) = nan + allocate(this%fsa_r_patch (begp:endp)) ; this%fsa_r_patch (:) = nan + allocate(this%parsun_z_patch (begp:endp,1:nlevcan)) ; this%parsun_z_patch (:,:) = nan + allocate(this%parsha_z_patch (begp:endp,1:nlevcan)) ; this%parsha_z_patch (:,:) = nan + if(use_luna)then + allocate(this%par240d_z_patch (begp:endp,1:nlevcan)) ; this%par240d_z_patch (:,:) = spval + allocate(this%par240x_z_patch (begp:endp,1:nlevcan)) ; this%par240x_z_patch (:,:) = spval + allocate(this%par24d_z_patch (begp:endp,1:nlevcan)) ; this%par24d_z_patch (:,:) = spval + allocate(this%par24x_z_patch (begp:endp,1:nlevcan)) ; this%par24x_z_patch (:,:) = spval + endif + allocate(this%sabv_patch (begp:endp)) ; this%sabv_patch (:) = nan + allocate(this%sabg_patch (begp:endp)) ; this%sabg_patch (:) = nan + allocate(this%sabg_lyr_patch (begp:endp,-nlevsno+1:1)) ; this%sabg_lyr_patch (:,:) = nan + allocate(this%sabg_pen_patch (begp:endp)) ; this%sabg_pen_patch (:) = nan + allocate(this%sabg_soil_patch (begp:endp)) ; this%sabg_soil_patch (:) = nan + allocate(this%sabg_snow_patch (begp:endp)) ; this%sabg_snow_patch (:) = nan + allocate(this%sabg_chk_patch (begp:endp)) ; this%sabg_chk_patch (:) = nan + allocate(this%sabs_roof_dir_lun (begl:endl,1:numrad)) ; this%sabs_roof_dir_lun (:,:) = nan + allocate(this%sabs_roof_dif_lun (begl:endl,1:numrad)) ; this%sabs_roof_dif_lun (:,:) = nan + allocate(this%sabs_sunwall_dir_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dir_lun (:,:) = nan + allocate(this%sabs_sunwall_dif_lun (begl:endl,1:numrad)) ; this%sabs_sunwall_dif_lun (:,:) = nan + allocate(this%sabs_shadewall_dir_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dir_lun (:,:) = nan + allocate(this%sabs_shadewall_dif_lun (begl:endl,1:numrad)) ; this%sabs_shadewall_dif_lun (:,:) = nan + allocate(this%sabs_improad_dir_lun (begl:endl,1:numrad)) ; this%sabs_improad_dir_lun (:,:) = nan + allocate(this%sabs_improad_dif_lun (begl:endl,1:numrad)) ; this%sabs_improad_dif_lun (:,:) = nan + allocate(this%sabs_perroad_dir_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dir_lun (:,:) = nan + allocate(this%sabs_perroad_dif_lun (begl:endl,1:numrad)) ; this%sabs_perroad_dif_lun (:,:) = nan + allocate(this%sub_surf_abs_SW_col (begc:endc)) ; this%sub_surf_abs_SW_col (:) = nan + allocate(this%fsr_patch (begp:endp)) ; this%fsr_patch (:) = nan + allocate(this%fsr_nir_d_patch (begp:endp)) ; this%fsr_nir_d_patch (:) = nan + allocate(this%fsr_nir_i_patch (begp:endp)) ; this%fsr_nir_i_patch (:) = nan + allocate(this%fsr_nir_d_ln_patch (begp:endp)) ; this%fsr_nir_d_ln_patch (:) = nan + allocate(this%fsds_nir_d_patch (begp:endp)) ; this%fsds_nir_d_patch (:) = nan + allocate(this%fsds_nir_i_patch (begp:endp)) ; this%fsds_nir_i_patch (:) = nan + allocate(this%fsds_nir_d_ln_patch (begp:endp)) ; this%fsds_nir_d_ln_patch (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clm_varctl , only : use_snicar_frc + use clm_varpar , only : nlevsno + use histFileMod , only : hist_addfld1d, hist_addfld2d + use histFileMod , only : no_snow_normal + ! + ! !ARGUMENTS: + class(solarabs_type) :: this + type(bounds_type), intent(in) :: bounds + + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr_1d(:) ! pointer to 1d patch array + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + this%fsa_patch(begp:endp) = spval + call hist_addfld1d (fname='FSA', units='W/m^2', & + avgflag='A', long_name='absorbed solar radiation', & + ptr_patch=this%fsa_patch, c2l_scale_type='urbanf') + + this%fsa_r_patch(begp:endp) = spval + call hist_addfld1d (fname='FSA_R', units='W/m^2', & + avgflag='A', long_name='Rural absorbed solar radiation', & + ptr_patch=this%fsa_r_patch, set_spec=spval) + + this%fsa_u_patch(begp:endp) = spval + call hist_addfld1d (fname='FSA_U', units='W/m^2', & + avgflag='A', long_name='Urban absorbed solar radiation', & + ptr_patch=this%fsa_u_patch, c2l_scale_type='urbanf', set_nourb=spval) + + this%fsr_patch(begp:endp) = spval + call hist_addfld1d (fname='FSR', units='W/m^2', & + avgflag='A', long_name='reflected solar radiation', & + ptr_patch=this%fsr_patch, c2l_scale_type='urbanf') + ! Rename of FSR for Urban intercomparision project + call hist_addfld1d (fname='SWup', units='W/m^2', & + avgflag='A', long_name='upwelling shortwave radiation', & + ptr_patch=this%fsr_patch, c2l_scale_type='urbanf', default='inactive') + + this%sabg_lyr_patch(begp:endp,-nlevsno+1:0) = spval + data2dptr => this%sabg_lyr_patch(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_ABS', units='W/m^2', type2d='levsno', & + avgflag='A', long_name='Absorbed solar radiation in each snow layer', & + ptr_patch=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%sabv_patch(begp:endp) = spval + call hist_addfld1d (fname='SABV', units='W/m^2', & + avgflag='A', long_name='solar rad absorbed by veg', & + ptr_patch=this%sabv_patch, c2l_scale_type='urbanf') + + this%sabg_patch(begp:endp) = spval + call hist_addfld1d (fname='SABG', units='W/m^2', & + avgflag='A', long_name='solar rad absorbed by ground', & + ptr_patch=this%sabg_patch, c2l_scale_type='urbanf') + + this%sabg_pen_patch(begp:endp) = spval + call hist_addfld1d (fname='SABG_PEN', units='watt/m^2', & + avgflag='A', long_name='Rural solar rad penetrating top soil or snow layer', & + ptr_patch=this%sabg_pen_patch, set_spec=spval) + + ! Currently needed by lake code - TODO should not be here + this%fsds_nir_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSND', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation', & + ptr_patch=this%fsds_nir_d_patch) + + this%fsds_nir_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir incident solar radiation', & + ptr_patch=this%fsds_nir_i_patch) + + this%fsds_nir_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSNDLN', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation at local noon', & + ptr_patch=this%fsds_nir_d_ln_patch) + + this%fsr_nir_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRND', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation', & + ptr_patch=this%fsr_nir_d_patch, c2l_scale_type='urbanf') + + this%fsr_nir_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir reflected solar radiation', & + ptr_patch=this%fsr_nir_i_patch, c2l_scale_type='urbanf') + + this%fsr_nir_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRNDLN', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation at local noon', & + ptr_patch=this%fsr_nir_d_ln_patch, c2l_scale_type='urbanf') + + this%sub_surf_abs_SW_col(begc:endc) = spval + call hist_addfld1d (fname='SNOINTABS', units='%', & + avgflag='A', long_name='Percent of incoming solar absorbed by lower snow layers', & + ptr_col=this%sub_surf_abs_SW_col, set_lake=spval, set_urb=spval) + + if(use_luna)then + ptr_1d => this%par240d_z_patch(:,1) + call hist_addfld1d (fname='PAR240DZ', units='W/m^2', & + avgflag='A', long_name='10-day running mean of daytime patch absorbed PAR for leaves for top canopy layer', & + ptr_patch=ptr_1d, default='inactive') + ptr_1d => this%par240x_z_patch(:,1) + call hist_addfld1d (fname='PAR240XZ', units='W/m^2', & + avgflag='A', long_name='10-day running mean of maximum patch absorbed PAR for leaves for top canopy layer', & + ptr_patch=ptr_1d, default='inactive') + + endif + + end subroutine InitHistory + + !------------------------------------------------------------------------ + subroutine InitCold(this, bounds) + ! + ! Initialize module surface albedos to reasonable values + ! + use landunit_varcon, only : istsoil, istcrop + ! + ! !ARGUMENTS: + class(solarabs_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begl, endl + !----------------------------------------------------------------------- + + begl = bounds%begl; endl = bounds%endl + + this%sabs_roof_dir_lun (begl:endl, :) = 0._r8 + this%sabs_roof_dif_lun (begl:endl, :) = 0._r8 + this%sabs_sunwall_dir_lun (begl:endl, :) = 0._r8 + this%sabs_sunwall_dif_lun (begl:endl, :) = 0._r8 + this%sabs_shadewall_dir_lun (begl:endl, :) = 0._r8 + this%sabs_shadewall_dif_lun (begl:endl, :) = 0._r8 + this%sabs_improad_dir_lun (begl:endl, :) = 0._r8 + this%sabs_improad_dif_lun (begl:endl, :) = 0._r8 + this%sabs_perroad_dir_lun (begl:endl, :) = 0._r8 + this%sabs_perroad_dif_lun (begl:endl, :) = 0._r8 + + end subroutine InitCold + + !--------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use shr_infnan_mod , only : shr_infnan_isnan + use clm_varctl , only : use_snicar_frc, iulog + use spmdMod , only : masterproc + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(solarabs_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + integer :: p + !--------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='sabs_roof_dir', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by roof per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_roof_dir_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_roof_dif', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by roof per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_roof_dif_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_sunwall_dir', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by sunwall per unit wall area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_sunwall_dir_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_sunwall_dif', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by sunwall per unit wall area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_sunwall_dif_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_shadewall_dir', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by shadewall per unit wall area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_shadewall_dir_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_shadewall_dif', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by shadewall per unit wall area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_shadewall_dif_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_improad_dir', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by impervious road per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_improad_dir_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_improad_dif', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by impervious road per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_improad_dif_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_perroad_dir', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by pervious road per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_perroad_dir_lun) + + call restartvar(ncid=ncid, flag=flag, varname='sabs_perroad_dif', xtype=ncd_double, dim1name='landunit', & + dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by pervious road per unit ground area per unit incident flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%sabs_perroad_dif_lun) + + if(use_luna)then + call restartvar(ncid=ncid, flag=flag, varname='par240d', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='10-day running mean of daytime absorbed PAR for leaves in canopy layer', units='W/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%par240d_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='par24d', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Accumulative daytime absorbed PAR for leaves in canopy layer for 24 hours', units='J/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%par24d_z_patch ) + + call restartvar(ncid=ncid, flag=flag, varname='par240x', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='10-day running mean of maximum absorbed PAR for leaves in canopy layers', units='W/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%par240x_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='par24x', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Maximum absorbed PAR for leaves in canopy layer in 24 hours', units='J/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%par24x_z_patch ) + + call restartvar(ncid=ncid, flag=flag, varname='parsun', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Instaneous absorbed PAR for sunlit leaves in canopy layer', units='W/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%parsun_z_patch ) + call restartvar(ncid=ncid, flag=flag, varname='parsha', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='Instaneous absorbed PAR for shaded leaves in canopy layer', units='W/m**2 leaf', & + interpinic_flag='interp', readvar=readvar, data=this%parsha_z_patch ) + + endif + + end subroutine Restart + +end module SolarAbsorbedType diff --git a/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 new file mode 100644 index 0000000000..ee0ab6e861 --- /dev/null +++ b/components/clm/src/biogeophys/SurfaceAlbedoMod.F90 @@ -0,0 +1,1594 @@ +module SurfaceAlbedoMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Performs surface albedo calculations + ! + ! !PUBLIC TYPES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use landunit_varcon , only : istsoil, istcrop + use clm_varcon , only : grlnd, namep + use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan + use clm_varctl , only : fsurdat, iulog, use_snicar_frc + use pftconMod , only : pftcon + use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC + use AerosolMod , only : aerosol_type + use CanopyStateType , only : canopystate_type + use LakeStateType , only : lakestate_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use EDSurfaceAlbedoMod, only : ED_Norman_Radiation + use CanopyHydrologyMod, only : IsSnowvegFlagOn, IsSnowvegFlagOnRad + ! + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceAlbedoInitTimeConst + public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: SoilAlbedo ! Determine ground surface albedo + private :: TwoStream ! Two-stream fluxes for canopy radiative transfer + ! + ! !PUBLIC DATA MEMBERS: + ! The CLM default albice values are too high. + ! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) + ! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. + + ! albedo land ice by waveband (1=vis, 2=nir) + real(r8), public :: albice(numrad) = (/ 0.80_r8, 0.55_r8 /) + + ! namelist default setting for inputting alblakwi + real(r8), public :: lake_melt_icealb(numrad) = (/ 0.10_r8, 0.10_r8/) + + ! albedo frozen lakes by waveband (1=vis, 2=nir) + ! unclear what the reference is for this + real(r8), private :: alblak(numrad) = (/0.60_r8, 0.40_r8/) + + ! albedo of melting lakes due to puddling, open water, or white ice + ! From D. Mironov (2010) Boreal Env. Research + ! To revert albedo of melting lakes to the cold snow-free value, set + ! lake_melt_icealb namelist to 0.60, 0.40 like alblak above. + real(r8), private :: alblakwi(numrad) + + ! Coefficient for calculating ice "fraction" for lake surface albedo + ! From D. Mironov (2010) Boreal Env. Research + real(r8), parameter :: calb = 95.6_r8 + + ! + ! !PRIVATE DATA MEMBERS: + ! Snow in vegetation canopy namelist options. + logical, private :: snowveg_onrad = .true. ! snowveg_flag = 'ON_RAD' + + ! + ! !PRIVATE DATA FUNCTIONS: + real(r8), allocatable, private :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir) + real(r8), allocatable, private :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir) + integer , allocatable, private :: isoicol(:) ! column soil color class + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SurfaceAlbedoInitTimeConst(bounds) + ! + ! !DESCRIPTION: + ! Initialize module time constant variables + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use fileutils , only : getfil + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_pio_openfile, ncd_pio_closefile + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,g ! indices + integer :: mxsoil_color ! maximum number of soil color classes + type(file_desc_t) :: ncid ! netcdf id + character(len=256) :: locfn ! local filename + integer :: ier ! error status + logical :: readvar + integer ,pointer :: soic2d (:) ! read in - soil color + !--------------------------------------------------------------------- + + ! Allocate module variable for soil color + + allocate(isoicol(bounds%begc:bounds%endc)) + + ! Determine soil color and number of soil color classes + ! if number of soil color classes is not on input dataset set it to 8 + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, readvar=readvar) + if ( .not. readvar ) mxsoil_color = 8 + + allocate(soic2d(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: SOIL_COLOR NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + end if + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + isoicol(c) = soic2d(g) + end do + deallocate(soic2d) + + call ncd_pio_closefile(ncid) + + ! Determine saturated and dry soil albedos for n color classes and + ! numrad wavebands (1=vis, 2=nir) + + allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier) + if (ier /= 0) then + write(iulog,*)'allocation error for albsat, albdry' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (masterproc) then + write(iulog,*) 'Attempting to read soil colo data .....' + end if + + if (mxsoil_color == 8) then + albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/) + albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/) + else if (mxsoil_color == 20) then + albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,& + 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/) + albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,& + 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,& + 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,& + 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/) + else + write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Set alblakwi + alblakwi(:) = lake_melt_icealb(:) + + end subroutine SurfaceAlbedoInitTimeConst + + !----------------------------------------------------------------------- + subroutine SurfaceAlbedo(bounds, & + num_nourbanc, filter_nourbanc, & + num_nourbanp, filter_nourbanp, & + num_urbanc , filter_urbanc, & + num_urbanp , filter_urbanp, & + nextsw_cday , declinp1, & + ed_allsites_inst, aerosol_inst, canopystate_inst, waterstate_inst, & + lakestate_inst, temperature_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Surface albedo and two-stream fluxes + ! Surface albedos. Also fluxes (per unit incoming direct and diffuse + ! radiation) reflected, transmitted, and absorbed by vegetation. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! The calling sequence is: + ! -> SurfaceAlbedo: albedos for next time step + ! -> SoilAlbedo: soil/lake/glacier/wetland albedos + ! -> SNICAR_RT: snow albedos: direct beam (SNICAR) + ! -> SNICAR_RT: snow albedos: diffuse (SNICAR) + ! -> TwoStream: absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif) + ! + ! Note that this is called with the "inactive_and_active" version of the filters, because + ! the variables computed here are needed over inactive points that might later become + ! active (due to landuse change). Thus, this routine cannot depend on variables that are + ! only computed over active points. + ! + ! !USES: + use shr_orb_mod + use clm_time_manager , only : get_nstep + use abortutils , only : endrun + use clm_varctl , only : subgridflag, use_snicar_frc, use_ed + use EDTypesMod , only : ed_site_type + use EDSurfaceAlbedoMod + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter + integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points + integer , intent(in) :: num_nourbanp ! number of patches in non-urban filter + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanc ! number of columns in urban filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + integer , intent(in) :: num_urbanp ! number of patches in urban filter + integer , intent(in) :: filter_urbanp(:) ! patch filter for rban points + real(r8) , intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) + real(r8) , intent(in) :: declinp1 ! declination angle (radians) for next time step + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg: ) + type(aerosol_type) , intent(in) :: aerosol_inst + type(canopystate_type) , intent(in) :: canopystate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + integer :: i ! index for layers [idx] + integer :: aer ! index for sno_nbr_aer + real(r8) :: extkn ! nitrogen allocation coefficient + integer :: fp,fc,g,c,p,iv ! indices + integer :: ib ! band index + integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + real(r8) :: dinc ! lai+sai increment for canopy layer + real(r8) :: dincmax ! maximum lai+sai increment for canopy layer + real(r8) :: dincmax_sum ! cumulative sum of maximum lai+sai increment for canopy layer + real(r8) :: laisum ! sum of canopy layer lai for error check + real(r8) :: saisum ! sum of canopy layer sai for error check + integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) + integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) + integer :: num_vegsol ! number of vegetated patches where coszen>0 + integer :: num_novegsol ! number of vegetated patches where coszen>0 + integer :: filter_vegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 + integer :: filter_novegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 + real(r8) :: wl (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is LAI + real(r8) :: ws (bounds%begp:bounds%endp) ! fraction of LAI+SAI that is SAI + real(r8) :: blai(bounds%begp:bounds%endp) ! lai buried by snow: tlai - elai + real(r8) :: bsai(bounds%begp:bounds%endp) ! sai buried by snow: tsai - esai + real(r8) :: coszen_gcell (bounds%begg:bounds%endg) ! cosine solar zenith angle for next time step (grc) + real(r8) :: coszen_patch (bounds%begp:bounds%endp) ! cosine solar zenith angle for next time step (patch) + real(r8) :: rho(bounds%begp:bounds%endp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI + real(r8) :: tau(bounds%begp:bounds%endp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI + real(r8) :: albsfc (bounds%begc:bounds%endc,numrad) ! albedo of surface underneath snow (col,bnd) + real(r8) :: albsnd(bounds%begc:bounds%endc,numrad) ! snow albedo (direct) + real(r8) :: albsni(bounds%begc:bounds%endc,numrad) ! snow albedo (diffuse) + real(r8) :: albsnd_pur (bounds%begc:bounds%endc,numrad) ! direct pure snow albedo (radiative forcing) + real(r8) :: albsni_pur (bounds%begc:bounds%endc,numrad) ! diffuse pure snow albedo (radiative forcing) + real(r8) :: albsnd_bc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without BC (radiative forcing) + real(r8) :: albsni_bc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without BC (radiative forcing) + real(r8) :: albsnd_oc (bounds%begc:bounds%endc,numrad) ! direct snow albedo without OC (radiative forcing) + real(r8) :: albsni_oc (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without OC (radiative forcing) + real(r8) :: albsnd_dst (bounds%begc:bounds%endc,numrad) ! direct snow albedo without dust (radiative forcing) + real(r8) :: albsni_dst (bounds%begc:bounds%endc,numrad) ! diffuse snow albedo without dust (radiative forcing) + real(r8) :: flx_absd_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (direct) [frc] + real(r8) :: flx_absi_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (diffuse) [frc] + real(r8) :: foo_snw (bounds%begc:bounds%endc,-nlevsno+1:1,numrad) ! dummy array for forcing calls + real(r8) :: h2osno_liq (bounds%begc:bounds%endc,-nlevsno+1:0) ! liquid snow content (col,lyr) [kg m-2] + real(r8) :: h2osno_ice (bounds%begc:bounds%endc,-nlevsno+1:0) ! ice content in snow (col,lyr) [kg m-2] + integer :: snw_rds_in (bounds%begc:bounds%endc,-nlevsno+1:0) ! snow grain size sent to SNICAR (col,lyr) [microns] + real(r8) :: mss_cnc_aer_in_frc_pur (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_bc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_oc (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_dst (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_fdb (bounds%begc:bounds%endc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1] + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer , parameter :: nband =numrad ! number of solar radiation waveband classes + !----------------------------------------------------------------------- + + associate(& + rhol => pftcon%rhol , & ! Input: leaf reflectance: 1=vis, 2=nir + rhos => pftcon%rhos , & ! Input: stem reflectance: 1=vis, 2=nir + taul => pftcon%taul , & ! Input: leaf transmittance: 1=vis, 2=nir + taus => pftcon%taus , & ! Input: stem transmittance: 1=vis, 2=nir + + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index, no burying by snow + tsai => canopystate_inst%tsai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index, no burying by snow + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] + snw_rds => waterstate_inst%snw_rds_col , & ! Input: [real(r8) (:,:) ] snow grain radius (col,lyr) [microns] + + mss_cnc_bcphi => aerosol_inst%mss_cnc_bcphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic BC (col,lyr) [kg/kg] + mss_cnc_bcpho => aerosol_inst%mss_cnc_bcpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic BC (col,lyr) [kg/kg] + mss_cnc_ocphi => aerosol_inst%mss_cnc_ocphi_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophilic OC (col,lyr) [kg/kg] + mss_cnc_ocpho => aerosol_inst%mss_cnc_ocpho_col , & ! Input: [real(r8) (:,:) ] mass concentration of hydrophobic OC (col,lyr) [kg/kg] + mss_cnc_dst1 => aerosol_inst%mss_cnc_dst1_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] + mss_cnc_dst2 => aerosol_inst%mss_cnc_dst2_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] + mss_cnc_dst3 => aerosol_inst%mss_cnc_dst3_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] + mss_cnc_dst4 => aerosol_inst%mss_cnc_dst4_col , & ! Input: [real(r8) (:,:) ] mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] + + fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + tlai_z => surfalb_inst%tlai_z_patch , & ! Output: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Output: [real(r8) (:,:) ] tsai increment for canopy layer + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax + ncan => surfalb_inst%ncan_patch , & ! Output: [integer (:) ] number of canopy layers + nrad => surfalb_inst%nrad_patch , & ! Output: [integer (:) ] number of canopy layers, above snow for radiative transfer + coszen_col => surfalb_inst%coszen_col , & ! Output: [real(r8) (:) ] cosine of solar zenith angle + albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] + albsoi => surfalb_inst%albsoi_col , & ! Output: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] + albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) + albgri_pur => surfalb_inst%albgri_pur_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (diffuse) + albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (direct) + albgri_bc => surfalb_inst%albgri_bc_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (diffuse) + albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (direct) + albgri_oc => surfalb_inst%albgri_oc_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (diffuse) + albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (direct) + albgri_dst => surfalb_inst%albgri_dst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (diffuse) + albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Output: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] + albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux + flx_absdv => surfalb_inst%flx_absdv_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] + flx_absdn => surfalb_inst%flx_absdn_col , & ! Output: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] + flx_absiv => surfalb_inst%flx_absiv_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] + flx_absin => surfalb_inst%flx_absin_col , & ! Output: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + ) + + ! Cosine solar zenith angle for next time step + + do g = bounds%begg,bounds%endg + coszen_gcell(g) = shr_orb_cosz (nextsw_cday, grc%lat(g), grc%lon(g), declinp1) + end do + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + coszen_col(c) = coszen_gcell(g) + end do + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + coszen_patch(p) = coszen_gcell(g) + end do + + ! Initialize output because solar radiation only done if coszen > 0 + + do ib = 1, numrad + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + albsod(c,ib) = 0._r8 + albsoi(c,ib) = 0._r8 + albgrd(c,ib) = 0._r8 + albgri(c,ib) = 0._r8 + albgrd_pur(c,ib) = 0._r8 + albgri_pur(c,ib) = 0._r8 + albgrd_bc(c,ib) = 0._r8 + albgri_bc(c,ib) = 0._r8 + albgrd_oc(c,ib) = 0._r8 + albgri_oc(c,ib) = 0._r8 + albgrd_dst(c,ib) = 0._r8 + albgri_dst(c,ib) = 0._r8 + do i=-nlevsno+1,1,1 + flx_absdv(c,i) = 0._r8 + flx_absdn(c,i) = 0._r8 + flx_absiv(c,i) = 0._r8 + flx_absin(c,i) = 0._r8 + enddo + end do + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + albd(p,ib) = 1._r8 + albi(p,ib) = 1._r8 + fabd(p,ib) = 0._r8 + fabd_sun(p,ib) = 0._r8 + fabd_sha(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + fabi_sun(p,ib) = 0._r8 + fabi_sha(p,ib) = 0._r8 + ftdd(p,ib) = 0._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 0._r8 + end do + + end do ! end of numrad loop + + ! SoilAlbedo called before SNICAR_RT + ! so that reflectance of soil beneath snow column is known + ! ahead of time for snow RT calculation. + + ! Snow albedos + ! Note that snow albedo routine will only compute nonzero snow albedos + ! where h2osno> 0 and coszen > 0 + + ! Ground surface albedos + ! Note that ground albedo routine will only compute nonzero snow albedos + ! where coszen > 0 + + call SoilAlbedo(bounds, & + num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + albsnd(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + lakestate_inst, temperature_inst, waterstate_inst, surfalb_inst) + + ! set variables to pass to SNICAR. + + flg_snw_ice = 1 ! calling from CLM, not CSIM + do c=bounds%begc,bounds%endc + albsfc(c,:) = albsoi(c,:) + h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) + h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0) + snw_rds_in(c,:) = nint(snw_rds(c,:)) + end do + + ! zero aerosol input arrays + do aer = 1, sno_nbr_aer + do i = -nlevsno+1, 0 + do c = bounds%begc, bounds%endc + mss_cnc_aer_in_frc_pur(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_bc(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_oc(c,i,aer) = 0._r8 + mss_cnc_aer_in_frc_dst(c,i,aer) = 0._r8 + mss_cnc_aer_in_fdb(c,i,aer) = 0._r8 + end do + end do + end do + + ! Set aerosol input arrays + ! feedback input arrays have been zeroed + ! set soot and dust aerosol concentrations: + if (DO_SNO_AER) then + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + + ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: + ! 1) Knowledge of their optical properties is primitive + ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, + ! it has a negligible darkening effect. + if (DO_SNO_OC) then + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + endif + + ! If radiative forcing is being calculated, first estimate clean-snow albedo + + if (use_snicar_frc) then + ! 1. BC input array: + ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + ! BC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_bc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_bc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + ! 2. OC input array: + ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) + + ! OC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_oc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_oc(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + endif + + ! 3. DUST input array: + ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) + endif + + ! DUST FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_dst(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_dst(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + ! 4. ALL AEROSOL FORCING CALCULATION + ! (pure snow albedo) + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd_pur(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_frc_pur(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni_pur(bounds%begc:bounds%endc, :), & + foo_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + end if + + ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsnd(bounds%begc:bounds%endc, :), & + flx_absd_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + coszen_col(bounds%begc:bounds%endc), & + flg_slr, & + h2osno_liq(bounds%begc:bounds%endc, :), & + h2osno_ice(bounds%begc:bounds%endc, :), & + snw_rds_in(bounds%begc:bounds%endc, :), & + mss_cnc_aer_in_fdb(bounds%begc:bounds%endc, :, :), & + albsfc(bounds%begc:bounds%endc, :), & + albsni(bounds%begc:bounds%endc, :), & + flx_absi_snw(bounds%begc:bounds%endc, :, :), & + waterstate_inst) + + ! ground albedos and snow-fraction weighting of snow absorption factors + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen_col(c) > 0._r8) then + ! ground albedo was originally computed in SoilAlbedo, but is now computed here + ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR. + albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) + albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) + + ! albedos for radiative forcing calculations: + if (use_snicar_frc) then + ! BC forcing albedo + albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) + albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) + + if (DO_SNO_OC) then + ! OC forcing albedo + albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) + albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) + endif + + ! dust forcing albedo + albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c) + albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c) + + ! pure snow albedo for all-aerosol radiative forcing + albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c) + albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c) + end if + + ! also in this loop (but optionally in a different loop for vectorized code) + ! weight snow layer radiative absorption factors based on snow fraction and soil albedo + ! (NEEDED FOR ENERGY CONSERVATION) + do i = -nlevsno+1,1,1 + if (subgridflag == 0) then + if (ib == 1) then + flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + elseif (ib == 2) then + flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + endif + else + if (ib == 1) then + flx_absdv(c,i) = flx_absd_snw(c,i,ib)*(1.-albsnd(c,ib)) + flx_absiv(c,i) = flx_absi_snw(c,i,ib)*(1.-albsni(c,ib)) + elseif (ib == 2) then + flx_absdn(c,i) = flx_absd_snw(c,i,ib)*(1.-albsnd(c,ib)) + flx_absin(c,i) = flx_absi_snw(c,i,ib)*(1.-albsni(c,ib)) + endif + endif + enddo + endif + enddo + enddo + + ! For diagnostics, set snow albedo to spval over non-snow non-urban points + ! so that it is not averaged in history buffer (OPTIONAL) + ! TODO - this is set to 0 not spval - seems wrong since it will be averaged in + + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if ((coszen_col(c) > 0._r8) .and. (h2osno(c) > 0._r8)) then + albsnd_hst(c,ib) = albsnd(c,ib) + albsni_hst(c,ib) = albsni(c,ib) + else + albsnd_hst(c,ib) = 0._r8 + albsni_hst(c,ib) = 0._r8 + endif + enddo + enddo + + ! Create solar-vegetated filter for the following calculations + + num_vegsol = 0 + num_novegsol = 0 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (coszen_patch(p) > 0._r8) then + if ((lun%itype(patch%landunit(p)) == istsoil .or. & + lun%itype(patch%landunit(p)) == istcrop ) & + .and. (elai(p) + esai(p)) > 0._r8) then + num_vegsol = num_vegsol + 1 + filter_vegsol(num_vegsol) = p + else + num_novegsol = num_novegsol + 1 + filter_novegsol(num_novegsol) = p + end if + end if + end do + + ! Weight reflectance/transmittance by lai and sai + ! Only perform on vegetated patches where coszen > 0 + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + wl(p) = elai(p) / max( elai(p)+esai(p), mpe ) + ws(p) = esai(p) / max( elai(p)+esai(p), mpe ) + end do + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + rho(p,ib) = max( rhol(patch%itype(p),ib)*wl(p) + rhos(patch%itype(p),ib)*ws(p), mpe ) + tau(p,ib) = max( taul(patch%itype(p),ib)*wl(p) + taus(patch%itype(p),ib)*ws(p), mpe ) + end do + end do + + ! Diagnose number of canopy layers for radiative transfer, in increments of dincmax. + ! Add to number of layers so long as cumulative leaf+stem area does not exceed total + ! leaf+stem area. Then add any remaining leaf+stem area to next layer and exit the loop. + ! Do this first for elai and esai (not buried by snow) and then for the part of the + ! canopy that is buried by snow. + ! ------------------ + ! tlai_z = leaf area increment for a layer + ! tsai_z = stem area increment for a layer + ! nrad = number of canopy layers above snow + ! ncan = total number of canopy layers + ! + ! tlai_z summed from 1 to nrad = elai + ! tlai_z summed from 1 to ncan = tlai + + ! tsai_z summed from 1 to nrad = esai + ! tsai_z summed from 1 to ncan = tsai + ! ------------------ + ! + ! Canopy layering needs to be done for all "num_nourbanp" not "num_vegsol" + ! because layering is needed for all time steps regardless of radiation + ! + ! Sun/shade big leaf code uses only one layer (nrad = ncan = 1), triggered by + ! nlevcan = 1 + + dincmax = 0.25_r8 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + + if (nlevcan == 1) then + nrad(p) = 1 + ncan(p) = 1 + tlai_z(p,1) = elai(p) + tsai_z(p,1) = esai(p) + else if (nlevcan > 1) then + if (elai(p)+esai(p) == 0._r8) then + nrad(p) = 0 + else + dincmax_sum = 0._r8 + do iv = 1, nlevcan + dincmax_sum = dincmax_sum + dincmax + if (((elai(p)+esai(p))-dincmax_sum) > 1.e-06_r8) then + nrad(p) = iv + dinc = dincmax + tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) + tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) + else + nrad(p) = iv + dinc = dincmax - (dincmax_sum - (elai(p)+esai(p))) + tlai_z(p,iv) = dinc * elai(p) / max(elai(p)+esai(p), mpe) + tsai_z(p,iv) = dinc * esai(p) / max(elai(p)+esai(p), mpe) + exit + end if + end do + + ! Mimumum of 4 canopy layers + + if (nrad(p) < 4) then + nrad(p) = 4 + do iv = 1, nrad(p) + tlai_z(p,iv) = elai(p) / nrad(p) + tsai_z(p,iv) = esai(p) / nrad(p) + end do + end if + end if + end if + + ! Error check: make sure cumulative of increments does not exceed total + + laisum = 0._r8 + saisum = 0._r8 + do iv = 1, nrad(p) + laisum = laisum + tlai_z(p,iv) + saisum = saisum + tsai_z(p,iv) + end do + if (abs(laisum-elai(p)) > 1.e-06_r8 .or. abs(saisum-esai(p)) > 1.e-06_r8) then + write (iulog,*) 'multi-layer canopy error 01 in SurfaceAlbedo: ',& + nrad(p),elai(p),laisum,esai(p),saisum + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + + ! Repeat to find canopy layers buried by snow + + if (nlevcan > 1) then + blai(p) = tlai(p) - elai(p) + bsai(p) = tsai(p) - esai(p) + if (blai(p)+bsai(p) == 0._r8) then + ncan(p) = nrad(p) + else + dincmax_sum = 0._r8 + do iv = nrad(p)+1, nlevcan + dincmax_sum = dincmax_sum + dincmax + if (((blai(p)+bsai(p))-dincmax_sum) > 1.e-06_r8) then + ncan(p) = iv + dinc = dincmax + tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) + tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) + else + ncan(p) = iv + dinc = dincmax - (dincmax_sum - (blai(p)+bsai(p))) + tlai_z(p,iv) = dinc * blai(p) / max(blai(p)+bsai(p), mpe) + tsai_z(p,iv) = dinc * bsai(p) / max(blai(p)+bsai(p), mpe) + exit + end if + end do + end if + + ! Error check: make sure cumulative of increments does not exceed total + + laisum = 0._r8 + saisum = 0._r8 + do iv = 1, ncan(p) + laisum = laisum + tlai_z(p,iv) + saisum = saisum + tsai_z(p,iv) + end do + if (abs(laisum-tlai(p)) > 1.e-06_r8 .or. abs(saisum-tsai(p)) > 1.e-06_r8) then + write (iulog,*) 'multi-layer canopy error 02 in SurfaceAlbedo: ',nrad(p),ncan(p) + write (iulog,*) tlai(p),elai(p),blai(p),laisum,tsai(p),esai(p),bsai(p),saisum + call endrun(decomp_index=p, clmlevel=namep, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + end do + + ! Zero fluxes for active canopy layers + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + do iv = 1, nrad(p) + fabd_sun_z(p,iv) = 0._r8 + fabd_sha_z(p,iv) = 0._r8 + fabi_sun_z(p,iv) = 0._r8 + fabi_sha_z(p,iv) = 0._r8 + fsun_z(p,iv) = 0._r8 + end do + end do + + ! Default leaf to canopy scaling coefficients, used when coszen <= 0. + ! This is the leaf nitrogen profile integrated over the full canopy. + ! Integrate exp(-kn*x) over x=0 to x=elai and assign to shaded canopy, + ! because sunlit fraction is 0. Canopy scaling coefficients are set in + ! TwoStream for coszen > 0. So kn must be set here and in TwoStream. + + extkn = 0.30_r8 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (nlevcan == 1) then + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn + if (elai(p) > 0._r8) then + vcmaxcintsha(p) = vcmaxcintsha(p) / elai(p) + else + vcmaxcintsha(p) = 0._r8 + end if + else if (nlevcan > 1) then + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = 0._r8 + end if + end do + + ! Calculate surface albedos and fluxes + ! Only perform on vegetated pfts where coszen > 0 + + if (use_ed) then + + call ED_Norman_Radiation (bounds, & + filter_vegsol, num_vegsol, filter_nourbanp, num_nourbanp, & + coszen_patch(bounds%begp:bounds%endp), ed_allsites_inst(bounds%begg:bounds%endg), & + surfalb_inst) + + else + + call TwoStream (bounds, filter_vegsol, num_vegsol, & + coszen_patch(bounds%begp:bounds%endp), & + rho(bounds%begp:bounds%endp, :), & + tau(bounds%begp:bounds%endp, :), & + canopystate_inst, temperature_inst, waterstate_inst, surfalb_inst) + + endif + + ! Determine values for non-vegetated patches where coszen > 0 + + do ib = 1,numrad + do fp = 1,num_novegsol + p = filter_novegsol(fp) + c = patch%column(p) + fabd(p,ib) = 0._r8 + fabd_sun(p,ib) = 0._r8 + fabd_sha(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + fabi_sun(p,ib) = 0._r8 + fabi_sha(p,ib) = 0._r8 + ftdd(p,ib) = 1._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 1._r8 + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + end do + end do + + end associate + + end subroutine SurfaceAlbedo + + !----------------------------------------------------------------------- + subroutine SoilAlbedo (bounds, & + num_nourbanc, filter_nourbanc, & + coszen, albsnd, albsni, & + lakestate_inst, temperature_inst, waterstate_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Determine ground surface albedo, accounting for snow + ! + ! !USES: + use clm_varpar , only : numrad + use clm_varcon , only : tfrz + use landunit_varcon , only : istice, istice_mec, istdlak + use LakeCon , only : lakepuddling + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban points in column filter + integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points + real(r8), intent(in) :: coszen( bounds%begc: ) ! cos solar zenith angle next time step [col] + real(r8), intent(in) :: albsnd( bounds%begc: , 1: ) ! snow albedo (direct) [col, numrad] + real(r8), intent(in) :: albsni( bounds%begc: , 1: ) ! snow albedo (diffuse) [col, numrad] + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + ! + integer, parameter :: nband =numrad ! number of solar radiation waveband classes + integer :: fc ! non-urban filter column index + integer :: c,l ! indices + integer :: ib ! waveband number (1=vis, 2=nir) + real(r8) :: inc ! soil water correction factor for soil albedo + integer :: soilcol ! soilcolor + real(r8) :: sicefr ! Lake surface ice fraction (based on D. Mironov 2010) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsnd) == (/bounds%endc, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsni) == (/bounds%endc, numrad/)), errMsg(__FILE__, __LINE__)) + + associate(& + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (Kelvin) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water [m3/m3] + + lake_icefrac => lakestate_inst%lake_icefrac_col , & ! Input: [real(r8) (:,:) ] mass fraction of lake layer that is frozen + + albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Output: [real(r8) (:,:) ] soil albedo (direct) + albsoi => surfalb_inst%albsoi_col & ! Output: [real(r8) (:,:) ] soil albedo (diffuse) + ) + + ! Compute soil albedos + + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen(c) > 0._r8) then + l = col%landunit(c) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! soil + inc = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8) + soilcol = isoicol(c) + ! changed from local variable to clm_type: + !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + !albsoi = albsod + albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + albsoi(c,ib) = albsod(c,ib) + else if (lun%itype(l) == istice .or. lun%itype(l) == istice_mec) then ! land ice + ! changed from local variable to clm_type: + !albsod = albice(ib) + !albsoi = albsod + albsod(c,ib) = albice(ib) + albsoi(c,ib) = albsod(c,ib) + ! unfrozen lake, wetland + else if (t_grnd(c) > tfrz .or. (lakepuddling .and. lun%itype(l) == istdlak .and. t_grnd(c) == tfrz .and. & + lake_icefrac(c,1) < 1._r8 .and. lake_icefrac(c,2) > 0._r8) ) then + + albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) + ! This expression is apparently from BATS according to Yongjiu Dai. + + ! The diffuse albedo should be an average over the whole sky of an angular-dependent direct expression. + ! The expression above may have been derived to encompass both (e.g. Henderson-Sellers 1986), + ! but I'll assume it applies more appropriately to the direct form for now. + + ! ZMS: Attn EK, currently restoring this for wetlands even though it is wrong in order to try to get + ! bfb baseline comparison when no lakes are present. I'm assuming wetlands will be phased out anyway. + if (lun%itype(l) == istdlak) then + albsoi(c,ib) = 0.10_r8 + else + albsoi(c,ib) = albsod(c,ib) + end if + + else ! frozen lake, wetland + ! Introduce crude surface frozen fraction according to D. Mironov (2010) + ! Attn EK: This formulation is probably just as good for "wetlands" if they are not phased out. + ! Tenatively I'm restricting this to lakes because I haven't tested it for wetlands. But if anything + ! the albedo should be lower when melting over frozen ground than a solid frozen lake. + ! + if (lun%itype(l) == istdlak .and. .not. lakepuddling .and. snl(c) == 0) then + ! Need to reference snow layers here because t_grnd could be over snow or ice + ! but we really want the ice surface temperature with no snow + sicefr = 1._r8 - exp(-calb * (tfrz - t_grnd(c))/tfrz) + albsod(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), & + 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8)) + albsoi(c,ib) = sicefr*alblak(ib) + (1._r8-sicefr)*max(alblakwi(ib), 0.10_r8) + ! Make sure this is no less than the open water albedo above. + ! Setting lake_melt_icealb(:) = alblak(:) in namelist reverts the melting albedo to the cold + ! snow-free value. + else + albsod(c,ib) = alblak(ib) + albsoi(c,ib) = albsod(c,ib) + end if + end if + + ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT + ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at + ! this point, snow albedo is not yet known. + end if + end do + end do + + end associate + end subroutine SoilAlbedo + + !----------------------------------------------------------------------- + subroutine TwoStream (bounds, & + filter_vegsol, num_vegsol, & + coszen, rho, tau, & + canopystate_inst, temperature_inst, waterstate_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Two-stream fluxes for canopy radiative transfer + ! Use two-stream approximation of Dickinson (1983) Adv Geophysics + ! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 + ! to calculate fluxes absorbed by vegetation, reflected by vegetation, + ! and transmitted through vegetation for unit incoming direct or diffuse + ! flux given an underlying surface with known albedo. + ! Calculate sunlit and shaded fluxes as described by + ! Bonan et al (2011) JGR, 116, doi:10.1029/2010JG001593 and extended to + ! a multi-layer canopy to calculate APAR profile + ! + ! !USES: + use clm_varpar, only : numrad, nlevcan + use clm_varcon, only : omegas, tfrz, betads, betais + use clm_varctl, only : iulog + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: filter_vegsol (:) ! filter for vegetated patches with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated patches where coszen>0 + real(r8), intent(in) :: coszen( bounds%begp: ) ! cosine solar zenith angle for next time step [pft] + real(r8), intent(in) :: rho( bounds%begp: , 1: ) ! leaf/stem refl weighted by fraction LAI and SAI [pft, numrad] + real(r8), intent(in) :: tau( bounds%begp: , 1: ) ! leaf/stem tran weighted by fraction LAI and SAI [pft, numrad] + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,p,c,iv ! array indices + integer :: ib ! waveband number + real(r8) :: cosz ! 0.001 <= coszen <= 1.000 + real(r8) :: asu ! single scattering albedo + real(r8) :: chil(bounds%begp:bounds%endp) ! -0.4 <= xl <= 0.6 + real(r8) :: gdir(bounds%begp:bounds%endp) ! leaf projection in solar direction (0 to 1) + real(r8) :: twostext(bounds%begp:bounds%endp)! optical depth of direct beam per unit leaf area + real(r8) :: avmu(bounds%begp:bounds%endp) ! average diffuse optical depth + real(r8) :: omega(bounds%begp:bounds%endp,numrad) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8) :: omegal ! omega for leaves + real(r8) :: betai ! upscatter parameter for diffuse radiation + real(r8) :: betail ! betai for leaves + real(r8) :: betad ! upscatter parameter for direct beam radiation + real(r8) :: betadl ! betad for leaves + real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary + real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 ! temporary + real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 ! temporary + real(r8) :: phi1,phi2,sigma ! temporary + real(r8) :: temp1 ! temporary + real(r8) :: temp0 (bounds%begp:bounds%endp) ! temporary + real(r8) :: temp2(bounds%begp:bounds%endp) ! temporary + real(r8) :: t1 ! temporary + real(r8) :: a1,a2 ! parameter for sunlit/shaded leaf radiation absorption + real(r8) :: v,dv,u,du ! temporary for flux derivatives + real(r8) :: dh2,dh3,dh5,dh6,dh7,dh8,dh9,dh10 ! temporary for flux derivatives + real(r8) :: da1,da2 ! temporary for flux derivatives + real(r8) :: d_ftid,d_ftii ! ftid, ftii derivative with respect to lai+sai + real(r8) :: d_fabd,d_fabi ! fabd, fabi derivative with respect to lai+sai + real(r8) :: d_fabd_sun,d_fabd_sha ! fabd_sun, fabd_sha derivative with respect to lai+sai + real(r8) :: d_fabi_sun,d_fabi_sha ! fabi_sun, fabi_sha derivative with respect to lai+sai + real(r8) :: laisum ! cumulative lai+sai for canopy layer (at middle of layer) + real(r8) :: extkb ! direct beam extinction coefficient + real(r8) :: extkn ! nitrogen allocation coefficient + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rho) == (/bounds%endp, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tau) == (/bounds%endp, numrad/)), errMsg(__FILE__, __LINE__)) + + associate(& + xl => pftcon%xl , & ! Input: ecophys const - leaf/stem orientation index + + t_veg => temperature_inst%t_veg_patch , & ! Input: [real(r8) (:) ] vegetation temperature (Kelvin) + + fwet => waterstate_inst%fwet_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is wet (0 to 1) + fcansno => waterstate_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Input: [real(r8) (:,:) ] tsai increment for canopy layer + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) (column-level) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse)(column-level) + fsun_z => surfalb_inst%fsun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit fraction of canopy layer + vcmaxcintsun => surfalb_inst%vcmaxcintsun_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, sunlit leaf vcmax + vcmaxcintsha => surfalb_inst%vcmaxcintsha_patch , & ! Output: [real(r8) (:) ] leaf to canopy scaling coefficient, shaded leaf vcmax + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flx + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flx + ftii => surfalb_inst%ftii_patch & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flx + ) + + ! Calculate two-stream parameters that are independent of waveband: + ! chil, gdir, twostext, avmu, and temp0 and temp2 (used for asu) + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + + ! note that the following limit only acts on cosz values > 0 and less than + ! 0.001, not on values cosz = 0, since these zero have already been filtered + ! out in filter_vegsol + cosz = max(0.001_r8, coszen(p)) + + chil(p) = min( max(xl(patch%itype(p)), -0.4_r8), 0.6_r8 ) + if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8 + phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) + phi2 = 0.877_r8 * (1._r8-2._r8*phi1) + gdir(p) = phi1 + phi2*cosz + twostext(p) = gdir(p)/cosz + avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 + temp0(p) = gdir(p) + phi2*cosz + temp1 = phi1*cosz + temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) ) + end do + + ! Loop over all wavebands to calculate for the full canopy the scattered fluxes + ! reflected upward and transmitted downward by the canopy and the flux absorbed by the + ! canopy for a unit incoming direct beam and diffuse flux at the top of the canopy given + ! an underlying surface of known albedo. + ! + ! Output: + ! ------------------ + ! Direct beam fluxes + ! ------------------ + ! albd - Upward scattered flux above canopy (per unit direct beam flux) + ! ftid - Downward scattered flux below canopy (per unit direct beam flux) + ! ftdd - Transmitted direct beam flux below canopy (per unit direct beam flux) + ! fabd - Flux absorbed by canopy (per unit direct beam flux) + ! fabd_sun - Sunlit portion of fabd + ! fabd_sha - Shaded portion of fabd + ! fabd_sun_z - absorbed sunlit leaf direct PAR (per unit sunlit lai+sai) for each canopy layer + ! fabd_sha_z - absorbed shaded leaf direct PAR (per unit shaded lai+sai) for each canopy layer + ! ------------------ + ! Diffuse fluxes + ! ------------------ + ! albi - Upward scattered flux above canopy (per unit diffuse flux) + ! ftii - Downward scattered flux below canopy (per unit diffuse flux) + ! fabi - Flux absorbed by canopy (per unit diffuse flux) + ! fabi_sun - Sunlit portion of fabi + ! fabi_sha - Shaded portion of fabi + ! fabi_sun_z - absorbed sunlit leaf diffuse PAR (per unit sunlit lai+sai) for each canopy layer + ! fabi_sha_z - absorbed shaded leaf diffuse PAR (per unit shaded lai+sai) for each canopy layer + + ! Set status of snowveg_flag + snowveg_onrad = IsSnowvegFlagOnRad() + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + c = patch%column(p) + + ! Calculate two-stream parameters omega, betad, and betai. + ! Omega, betad, betai are adjusted for snow. Values for omega*betad + ! and omega*betai are calculated and then divided by the new omega + ! because the product omega*betai, omega*betad is used in solution. + ! Also, the transmittances and reflectances (tau, rho) are linear + ! weights of leaf and stem values. + + omegal = rho(p,ib) + tau(p,ib) + asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p) + betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu + betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) & + * ((1._r8+chil(p))/2._r8)**2) / omegal + + ! Adjust omega, betad, and betai for intercepted snow + + if (snowveg_onrad) then + tmp0 = (1._r8-fcansno(p))*omegal + fcansno(p)*omegas(ib) + tmp1 = ( (1._r8-fcansno(p))*omegal*betadl + fcansno(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fcansno(p))*omegal*betail + fcansno(p)*omegas(ib)*betais ) / tmp0 + else + if (t_veg(p) > tfrz) then !no snow + tmp0 = omegal + tmp1 = betadl + tmp2 = betail + else + tmp0 = (1._r8-fwet(p))*omegal + fwet(p)*omegas(ib) + tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0 + end if + end if + + omega(p,ib) = tmp0 + betad = tmp1 + betai = tmp2 + + ! Common terms + + b = 1._r8 - omega(p,ib) + omega(p,ib)*betai + c1 = omega(p,ib)*betai + tmp0 = avmu(p)*twostext(p) + d = tmp0 * omega(p,ib)*betad + f = tmp0 * omega(p,ib)*(1._r8-betad) + tmp1 = b*b - c1*c1 + h = sqrt(tmp1) / avmu(p) + sigma = tmp0*tmp0 - tmp1 + p1 = b + avmu(p)*h + p2 = b - avmu(p)*h + p3 = b + tmp0 + p4 = b - tmp0 + + ! Absorbed, reflected, transmitted fluxes per unit incoming radiation + ! for full canopy + + t1 = min(h*(elai(p)+esai(p)), 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*(elai(p)+esai(p)), 40._r8) + s2 = exp(-t1) + + ! Direct beam + + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + + albd(p,ib) = h1/sigma + h2 + h3 + ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1 + ftdd(p,ib) = s2 + fabd(p,ib) = 1._r8 - albd(p,ib) - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib) + + a1 = h1 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h2 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h3 * (1._r8 - s2/s1) / (twostext(p) - h) + + a2 = h4 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h5 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h6 * (1._r8 - s2/s1) / (twostext(p) - h) + + fabd_sun(p,ib) = (1._r8 - omega(p,ib)) * ( 1._r8 - s2 + 1._r8 / avmu(p) * (a1 + a2) ) + fabd_sha(p,ib) = fabd(p,ib) - fabd_sun(p,ib) + + ! Diffuse + + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + albi(p,ib) = h7 + h8 + ftii(p,ib) = h9*s1 + h10/s1 + fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib) + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + fabi_sun(p,ib) = (1._r8 - omega(p,ib)) / avmu(p) * (a1 + a2) + fabi_sha(p,ib) = fabi(p,ib) - fabi_sun(p,ib) + + ! Repeat two-stream calculations for each canopy layer to calculate derivatives. + ! tlai_z and tsai_z are the leaf+stem area increment for a layer. Derivatives are + ! calculated at the center of the layer. Derivatives are needed only for the + ! visible waveband to calculate absorbed PAR (per unit lai+sai) for each canopy layer. + ! Derivatives are calculated first per unit lai+sai and then normalized for sunlit + ! or shaded fraction of canopy layer. + + ! Sun/shade big leaf code uses only one layer, with canopy integrated values from above + ! and also canopy-integrated scaling coefficients + + if (ib == 1) then + if (nlevcan == 1) then + + ! sunlit fraction of canopy + fsun_z(p,1) = (1._r8 - s2) / t1 + + ! absorbed PAR (per unit sun/shade lai+sai) + laisum = elai(p)+esai(p) + fabd_sun_z(p,1) = fabd_sun(p,ib) / (fsun_z(p,1)*laisum) + fabi_sun_z(p,1) = fabi_sun(p,ib) / (fsun_z(p,1)*laisum) + fabd_sha_z(p,1) = fabd_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + fabi_sha_z(p,1) = fabi_sha(p,ib) / ((1._r8 - fsun_z(p,1))*laisum) + + ! leaf to canopy scaling coefficients + extkn = 0.30_r8 + extkb = twostext(p) + vcmaxcintsun(p) = (1._r8 - exp(-(extkn+extkb)*elai(p))) / (extkn + extkb) + vcmaxcintsha(p) = (1._r8 - exp(-extkn*elai(p))) / extkn - vcmaxcintsun(p) + if (elai(p) > 0._r8) then + vcmaxcintsun(p) = vcmaxcintsun(p) / (fsun_z(p,1)*elai(p)) + vcmaxcintsha(p) = vcmaxcintsha(p) / ((1._r8 - fsun_z(p,1))*elai(p)) + else + vcmaxcintsun(p) = 0._r8 + vcmaxcintsha(p) = 0._r8 + end if + + else if (nlevcan > 1) then + do iv = 1, nrad(p) + + ! Cumulative lai+sai at center of layer + + if (iv == 1) then + laisum = 0.5_r8 * (tlai_z(p,iv)+tsai_z(p,iv)) + else + laisum = laisum + 0.5_r8 * ((tlai_z(p,iv-1)+tsai_z(p,iv-1))+(tlai_z(p,iv)+tsai_z(p,iv))) + end if + + ! Coefficients s1 and s2 depend on cumulative lai+sai. s2 is the sunlit fraction + + t1 = min(h*laisum, 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*laisum, 40._r8) + s2 = exp(-t1) + fsun_z(p,iv) = s2 + + ! =============== + ! Direct beam + ! =============== + + ! Coefficients h1-h6 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + + a1 = h1 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h2 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h3 * (1._r8 - s2/s1) / (twostext(p) - h) + + a2 = h4 / sigma * (1._r8 - s2*s2) / (2._r8 * twostext(p)) & + + h5 * (1._r8 - s2*s1) / (twostext(p) + h) & + + h6 * (1._r8 - s2/s1) / (twostext(p) - h) + + ! Derivatives for h2, h3, h5, h6 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = tmp6 * tmp2 / s1 - p2 * tmp7 + du = h * tmp6 * tmp2 / s1 + twostext(p) * p2 * tmp7 + dh2 = (v * du - u * dv) / (v * v) + + u = -tmp6 * tmp3 * s1 + p1 * tmp7 + du = h * tmp6 * tmp3 * s1 - twostext(p) * p1 * tmp7 + dh3 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = -h4/sigma * tmp4 / s1 - tmp9 + du = -h * h4/sigma * tmp4 / s1 + twostext(p) * tmp9 + dh5 = (v * du - u * dv) / (v * v) + + u = h4/sigma * tmp5 * s1 + tmp9 + du = -h * h4/sigma * tmp5 * s1 - twostext(p) * tmp9 + dh6 = (v * du - u * dv) / (v * v) + + da1 = h1/sigma * s2*s2 + h2 * s2*s1 + h3 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh2 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh3 + da2 = h4/sigma * s2*s2 + h5 * s2*s1 + h6 * s2/s1 & + + (1._r8 - s2*s1) / (twostext(p) + h) * dh5 & + + (1._r8 - s2/s1) / (twostext(p) - h) * dh6 + + ! Flux derivatives + + d_ftid = -twostext(p)*h4/sigma*s2 - h*h5*s1 + h*h6/s1 + dh5*s1 + dh6/s1 + d_fabd = -(dh2+dh3) + (1._r8-albgrd(c,ib))*twostext(p)*s2 - (1._r8-albgri(c,ib))*d_ftid + d_fabd_sun = (1._r8 - omega(p,ib)) * (twostext(p)*s2 + 1._r8 / avmu(p) * (da1 + da2)) + d_fabd_sha = d_fabd - d_fabd_sun + + fabd_sun_z(p,iv) = max(d_fabd_sun, 0._r8) + fabd_sha_z(p,iv) = max(d_fabd_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabd_sun_z(p,iv) = fabd_sun_z(p,iv) / fsun_z(p,iv) + fabd_sha_z(p,iv) = fabd_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + ! =============== + ! Diffuse + ! =============== + + ! Coefficients h7-h10 and a1,a2 depend of cumulative lai+sai + + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + a1 = h7 * (1._r8 - s2*s1) / (twostext(p) + h) + h8 * (1._r8 - s2/s1) / (twostext(p) - h) + a2 = h9 * (1._r8 - s2*s1) / (twostext(p) + h) + h10 * (1._r8 - s2/s1) / (twostext(p) - h) + + ! Derivatives for h7, h8, h9, h10 and a1, a2 + + v = d1 + dv = h * p1 * tmp2 / s1 + h * p2 * tmp3 * s1 + + u = c1 * tmp2 / s1 + du = h * c1 * tmp2 / s1 + dh7 = (v * du - u * dv) / (v * v) + + u = -c1 * tmp3 * s1 + du = h * c1 * tmp3 * s1 + dh8 = (v * du - u * dv) / (v * v) + + v = d2 + dv = h * tmp4 / s1 + h * tmp5 * s1 + + u = tmp4 / s1 + du = h * tmp4 / s1 + dh9 = (v * du - u * dv) / (v * v) + + u = -tmp5 * s1 + du = h * tmp5 * s1 + dh10 = (v * du - u * dv) / (v * v) + + da1 = h7*s2*s1 + h8*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh7 + (1._r8-s2/s1)/(twostext(p)-h)*dh8 + da2 = h9*s2*s1 + h10*s2/s1 + (1._r8-s2*s1)/(twostext(p)+h)*dh9 + (1._r8-s2/s1)/(twostext(p)-h)*dh10 + + ! Flux derivatives + + d_ftii = -h * h9 * s1 + h * h10 / s1 + dh9 * s1 + dh10 / s1 + d_fabi = -(dh7+dh8) - (1._r8-albgri(c,ib))*d_ftii + d_fabi_sun = (1._r8 - omega(p,ib)) / avmu(p) * (da1 + da2) + d_fabi_sha = d_fabi - d_fabi_sun + + fabi_sun_z(p,iv) = max(d_fabi_sun, 0._r8) + fabi_sha_z(p,iv) = max(d_fabi_sha, 0._r8) + + ! Flux derivatives are APARsun and APARsha per unit (LAI+SAI). Need + ! to normalize derivatives by sunlit or shaded fraction to get + ! APARsun per unit (LAI+SAI)sun and APARsha per unit (LAI+SAI)sha + + fabi_sun_z(p,iv) = fabi_sun_z(p,iv) / fsun_z(p,iv) + fabi_sha_z(p,iv) = fabi_sha_z(p,iv) / (1._r8 - fsun_z(p,iv)) + + end do ! end of canopy layer loop + end if + end if + + end do ! end of pft loop + end do ! end of radiation band loop + + end associate + +end subroutine TwoStream + +end module SurfaceAlbedoMod diff --git a/components/clm/src/biogeophys/SurfaceAlbedoType.F90 b/components/clm/src/biogeophys/SurfaceAlbedoType.F90 new file mode 100644 index 0000000000..e0f86c21f0 --- /dev/null +++ b/components/clm/src/biogeophys/SurfaceAlbedoType.F90 @@ -0,0 +1,633 @@ +module SurfaceAlbedoType + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : numrad, nlevcan, nlevsno + use abortutils , only : endrun + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC DATA MEMBERS: + type, public :: surfalb_type + + real(r8), pointer :: coszen_col (:) ! col cosine of solar zenith angle + real(r8), pointer :: albd_patch (:,:) ! patch surface albedo (direct) (numrad) + real(r8), pointer :: albi_patch (:,:) ! patch surface albedo (diffuse) (numrad) + real(r8), pointer :: albgrd_pur_col (:,:) ! col pure snow ground direct albedo (numrad) + real(r8), pointer :: albgri_pur_col (:,:) ! col pure snow ground diffuse albedo (numrad) + real(r8), pointer :: albgrd_bc_col (:,:) ! col ground direct albedo without BC (numrad) + real(r8), pointer :: albgri_bc_col (:,:) ! col ground diffuse albedo without BC (numrad) + real(r8), pointer :: albgrd_oc_col (:,:) ! col ground direct albedo without OC (numrad) + real(r8), pointer :: albgri_oc_col (:,:) ! col ground diffuse albedo without OC (numrad) + real(r8), pointer :: albgrd_dst_col (:,:) ! col ground direct albedo without dust (numrad) + real(r8), pointer :: albgri_dst_col (:,:) ! col ground diffuse albedo without dust (numrad) + real(r8), pointer :: albgrd_col (:,:) ! col ground albedo (direct) (numrad) + real(r8), pointer :: albgri_col (:,:) ! col ground albedo (diffuse) (numrad) + real(r8), pointer :: albsod_col (:,:) ! col soil albedo: direct (col,bnd) [frc] + real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc] + real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] + + real(r8), pointer :: ftdd_patch (:,:) ! patch down direct flux below canopy per unit direct flx (numrad) + real(r8), pointer :: ftid_patch (:,:) ! patch down diffuse flux below canopy per unit direct flx (numrad) + real(r8), pointer :: ftii_patch (:,:) ! patch down diffuse flux below canopy per unit diffuse flx (numrad) + real(r8), pointer :: fabd_patch (:,:) ! patch flux absorbed by canopy per unit direct flux (numrad) + real(r8), pointer :: fabd_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit direct flux (numrad) + real(r8), pointer :: fabd_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit direct flux (numrad) + real(r8), pointer :: fabi_patch (:,:) ! patch flux absorbed by canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabi_sun_patch (:,:) ! patch flux absorbed by sunlit canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabi_sha_patch (:,:) ! patch flux absorbed by shaded canopy per unit diffuse flux (numrad) + real(r8), pointer :: fabd_sun_z_patch (:,:) ! patch absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabd_sha_z_patch (:,:) ! patch absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabi_sun_z_patch (:,:) ! patch absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: fabi_sha_z_patch (:,:) ! patch absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + real(r8), pointer :: flx_absdv_col (:,:) ! col absorbed flux per unit incident direct flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absdn_col (:,:) ! col absorbed flux per unit incident direct flux: NIR (col,lyr) [frc] + real(r8), pointer :: flx_absiv_col (:,:) ! col absorbed flux per unit incident diffuse flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absin_col (:,:) ! col absorbed flux per unit incident diffuse flux: NIR (col,lyr) [frc] + + real(r8) , pointer :: fsun_z_patch (:,:) ! patch patch sunlit fraction of canopy layer + real(r8) , pointer :: tlai_z_patch (:,:) ! patch tlai increment for canopy layer + real(r8) , pointer :: tsai_z_patch (:,:) ! patch tsai increment for canopy layer + integer , pointer :: ncan_patch (:) ! patch number of canopy layers + integer , pointer :: nrad_patch (:) ! patch number of canopy layers, above snow for radiative transfer + real(r8) , pointer :: vcmaxcintsun_patch (:) ! patch leaf to canopy scaling coefficient, sunlit leaf vcmax + real(r8) , pointer :: vcmaxcintsha_patch (:) ! patch leaf to canopy scaling coefficient, shaded leaf vcmax + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, public :: Restart + + end type surfalb_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(surfalb_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! Allocate module variables and data structures + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varcon , only: spval, ispval + ! + ! !ARGUMENTS: + class(surfalb_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%coszen_col (begc:endc)) ; this%coszen_col (:) = nan + allocate(this%albgrd_col (begc:endc,numrad)) ; this%albgrd_col (:,:) = nan + allocate(this%albgri_col (begc:endc,numrad)) ; this%albgri_col (:,:) = nan + allocate(this%albsnd_hst_col (begc:endc,numrad)) ; this%albsnd_hst_col (:,:) = spval + allocate(this%albsni_hst_col (begc:endc,numrad)) ; this%albsni_hst_col (:,:) = spval + allocate(this%albsod_col (begc:endc,numrad)) ; this%albsod_col (:,:) = spval + allocate(this%albsoi_col (begc:endc,numrad)) ; this%albsoi_col (:,:) = spval + allocate(this%albgrd_pur_col (begc:endc,numrad)) ; this%albgrd_pur_col (:,:) = nan + allocate(this%albgri_pur_col (begc:endc,numrad)) ; this%albgri_pur_col (:,:) = nan + allocate(this%albgrd_bc_col (begc:endc,numrad)) ; this%albgrd_bc_col (:,:) = nan + allocate(this%albgri_bc_col (begc:endc,numrad)) ; this%albgri_bc_col (:,:) = nan + allocate(this%albgrd_oc_col (begc:endc,numrad)) ; this%albgrd_oc_col (:,:) = nan + allocate(this%albgri_oc_col (begc:endc,numrad)) ; this%albgri_oc_col (:,:) = nan + allocate(this%albgrd_dst_col (begc:endc,numrad)) ; this%albgrd_dst_col (:,:) = nan + allocate(this%albgri_dst_col (begc:endc,numrad)) ; this%albgri_dst_col (:,:) = nan + allocate(this%albd_patch (begp:endp,numrad)) ; this%albd_patch (:,:) = nan + allocate(this%albi_patch (begp:endp,numrad)) ; this%albi_patch (:,:) = nan + + allocate(this%ftdd_patch (begp:endp,numrad)) ; this%ftdd_patch (:,:) = nan + allocate(this%ftid_patch (begp:endp,numrad)) ; this%ftid_patch (:,:) = nan + allocate(this%ftii_patch (begp:endp,numrad)) ; this%ftii_patch (:,:) = nan + allocate(this%fabd_patch (begp:endp,numrad)) ; this%fabd_patch (:,:) = nan + allocate(this%fabd_sun_patch (begp:endp,numrad)) ; this%fabd_sun_patch (:,:) = nan + allocate(this%fabd_sha_patch (begp:endp,numrad)) ; this%fabd_sha_patch (:,:) = nan + allocate(this%fabi_patch (begp:endp,numrad)) ; this%fabi_patch (:,:) = nan + allocate(this%fabi_sun_patch (begp:endp,numrad)) ; this%fabi_sun_patch (:,:) = nan + allocate(this%fabi_sha_patch (begp:endp,numrad)) ; this%fabi_sha_patch (:,:) = nan + allocate(this%fabd_sun_z_patch (begp:endp,nlevcan)) ; this%fabd_sun_z_patch (:,:) = 0._r8 + allocate(this%fabd_sha_z_patch (begp:endp,nlevcan)) ; this%fabd_sha_z_patch (:,:) = 0._r8 + allocate(this%fabi_sun_z_patch (begp:endp,nlevcan)) ; this%fabi_sun_z_patch (:,:) = 0._r8 + allocate(this%fabi_sha_z_patch (begp:endp,nlevcan)) ; this%fabi_sha_z_patch (:,:) = 0._r8 + allocate(this%flx_absdv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdv_col (:,:) = spval + allocate(this%flx_absdn_col (begc:endc,-nlevsno+1:1)) ; this%flx_absdn_col (:,:) = spval + allocate(this%flx_absiv_col (begc:endc,-nlevsno+1:1)) ; this%flx_absiv_col (:,:) = spval + allocate(this%flx_absin_col (begc:endc,-nlevsno+1:1)) ; this%flx_absin_col (:,:) = spval + + allocate(this%fsun_z_patch (begp:endp,nlevcan)) ; this%fsun_z_patch (:,:) = 0._r8 + allocate(this%tlai_z_patch (begp:endp,nlevcan)) ; this%tlai_z_patch (:,:) = 0._r8 + allocate(this%tsai_z_patch (begp:endp,nlevcan)) ; this%tsai_z_patch (:,:) = 0._r8 + allocate(this%ncan_patch (begp:endp)) ; this%ncan_patch (:) = 0 + allocate(this%nrad_patch (begp:endp)) ; this%nrad_patch (:) = 0 + allocate(this%vcmaxcintsun_patch (begp:endp)) ; this%vcmaxcintsun_patch (:) = nan + allocate(this%vcmaxcintsha_patch (begp:endp)) ; this%vcmaxcintsha_patch (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varcon , only: spval + use histFileMod , only: hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(surfalb_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + this%coszen_col(begc:endc) = spval + call hist_addfld1d (fname='COSZEN', units='none', & + avgflag='A', long_name='cosine of solar zenith angle', & + ptr_col=this%coszen_col, default='inactive') + + this%albgri_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (direct)', & + ptr_col=this%albgrd_col, default='inactive') + + this%albgri_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (indirect)', & + ptr_col=this%albgri_col, default='inactive') + + this%albd_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ALBD', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (direct)', & + ptr_patch=this%albd_patch, default='inactive', c2l_scale_type='urbanf') + + this%albi_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ALBI', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (indirect)', & + ptr_patch=this%albi_patch, default='inactive', c2l_scale_type='urbanf') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! Initialize module surface albedos to reasonable values + ! + ! !ARGUMENTS: + class(surfalb_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begp, endp + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%albgrd_col (begc:endc, :) = 0.2_r8 + this%albgri_col (begc:endc, :) = 0.2_r8 + this%albsod_col (begc:endc, :) = 0.2_r8 + this%albsoi_col (begc:endc, :) = 0.2_r8 + this%albsnd_hst_col (begc:endc, :) = 0.6_r8 + this%albsni_hst_col (begc:endc, :) = 0.6_r8 + this%albd_patch (begp:endp, :) = 0.2_r8 + this%albi_patch (begp:endp, :) = 0.2_r8 + + this%albgrd_pur_col (begc:endc, :) = 0.2_r8 + this%albgri_pur_col (begc:endc, :) = 0.2_r8 + this%albgrd_bc_col (begc:endc, :) = 0.2_r8 + this%albgri_bc_col (begc:endc, :) = 0.2_r8 + this%albgrd_oc_col (begc:endc, :) = 0.2_r8 + this%albgri_oc_col (begc:endc, :) = 0.2_r8 + this%albgrd_dst_col (begc:endc, :) = 0.2_r8 + this%albgri_dst_col (begc:endc, :) = 0.2_r8 + + this%fabi_patch (begp:endp, :) = 0.0_r8 + this%fabd_patch (begp:endp, :) = 0.0_r8 + this%fabi_sun_patch (begp:endp, :) = 0.0_r8 + this%fabd_sun_patch (begp:endp, :) = 0.0_r8 + this%fabd_sha_patch (begp:endp, :) = 0.0_r8 + this%fabi_sha_patch (begp:endp, :) = 0.0_r8 + this%ftdd_patch (begp:endp, :) = 1.0_r8 + this%ftid_patch (begp:endp, :) = 0.0_r8 + this%ftii_patch (begp:endp, :) = 1.0_r8 + + end subroutine InitCold + + !--------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag, & + tlai_patch, tsai_patch) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use clm_varctl , only : use_snicar_frc, iulog + use spmdMod , only : masterproc + use decompMod , only : bounds_type + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen + use restUtilMod + ! + ! !ARGUMENTS: + class(surfalb_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + real(r8) , intent(in) :: tlai_patch(bounds%begp:) + real(r8) , intent(in) :: tsai_patch(bounds%begp:) + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + integer :: iv + integer :: begp, endp + integer :: begc, endc + !--------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(tlai_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(tsai_patch) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + call restartvar(ncid=ncid, flag=flag, varname='coszen', xtype=ncd_double, & + dim1name='column', & + long_name='cosine of solar zenith angle', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%coszen_col) + + call restartvar(ncid=ncid, flag=flag, varname='albd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='albi', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (diffuse) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (indirect) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgri_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsod', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='soil albedo (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albsod_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsoi', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='soil albedo (indirect) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albsoi_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsnd_hst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (direct) (0 to 1)', units='proportion', & + interpinic_flag='interp', readvar=readvar, data=this%albsnd_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsni_hst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (diffuse) (0 to 1)', units='proportion', & + interpinic_flag='interp', readvar=readvar, data=this%albsni_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='tlai_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='tlai increment for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tlai_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) then + write(iulog,*) "can't find tlai_z in restart (or initial) file..." + write(iulog,*) "Initialize tlai_z to tlai/nlevcan" + end if + do iv=1,nlevcan + this%tlai_z_patch(begp:endp,iv) = tlai_patch(begp:endp) / nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='tsai_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='tsai increment for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tsai_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) then + write(iulog,*) "can't find tsai_z in restart (or initial) file..." + write(iulog,*) "Initialize tsai_z to tsai/nlevcan" + end if + do iv=1,nlevcan + this%tsai_z_patch(begp:endp,iv) = tsai_patch(begp:endp) / nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='ncan', xtype=ncd_int, & + dim1name='pft', long_name='number of canopy layers', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ncan_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find ncan in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize ncan to nlevcan" + this%ncan_patch(begp:endp) = nlevcan + end if + + call restartvar(ncid=ncid, flag=flag, varname='nrad', xtype=ncd_int, & + dim1name='pft', long_name='number of canopy layers, above snow for radiative transfer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nrad_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find nrad in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize nrad to nlevcan" + this%nrad_patch(begp:endp) = nlevcan + end if + + call restartvar(ncid=ncid, flag=flag, varname='fsun_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='sunlit fraction for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fsun_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fsun_z in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fsun_z to 0" + do iv=1,nlevcan + this%fsun_z_patch(begp:endp,iv) = 0._r8 + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='vcmaxcintsun', xtype=ncd_double, & + dim1name='pft', long_name='sunlit canopy scaling coefficient', units='', & + interpinic_flag='interp', readvar=readvar, data=this%vcmaxcintsun_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find vcmaxcintsun in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize vcmaxcintsun to 1" + this%vcmaxcintsun_patch(begp:endp) = 1._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='vcmaxcintsha', xtype=ncd_double, & + dim1name='pft', long_name='shaded canopy scaling coefficient', units='', & + interpinic_flag='interp', readvar=readvar, data=this%vcmaxcintsha_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find vcmaxcintsha in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize vcmaxcintsha to 1" + this%vcmaxcintsha_patch(begp:endp) = 1._r8 + end if + + if (use_snicar_frc) then + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_bc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (direct) (0 to 1)', units='', & + interpinic_flag='interp',readvar=readvar, data=this%albgrd_bc_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_bc in initial file..." + if (masterproc) write(iulog,*) "Initialize albgrd_bc to albgrd" + this%albgrd_bc_col(begc:endc,:) = this%albgrd_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgri_bc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (diffuse) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgri_bc_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_bc in initial file..." + if (masterproc) write(iulog,*) "Initialize albgri_bc to albgri" + this%albgri_bc_col(begc:endc,:) = this%albgri_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_pur', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_pur_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_pur in initial file..." + if (masterproc) write(iulog,*) "Initialize albgrd_pur to albgrd" + this%albgrd_pur_col(begc:endc,:) = this%albgrd_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgri_pur', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (diffuse) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgri_pur_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_pur in initial file..." + if (masterproc) write(iulog,*) "Initialize albgri_pur to albgri" + this%albgri_pur_col(begc:endc,:) = this%albgri_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_oc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_oc_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_oc in initial file..." + if (masterproc) write(iulog,*) "Initialize albgrd_oc to albgrd" + this%albgrd_oc_col(begc:endc,:) = this%albgrd_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgri_oc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (diffuse) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgri_oc_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_oc in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgri_oc to albgri" + this%albgri_oc_col(begc:endc,:) = this%albgri_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_dst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (direct) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_dst_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_dst in initial file..." + if (masterproc) write(iulog,*) "Initialize albgrd_dst to albgrd" + this%albgrd_dst_col(begc:endc,:) = this%albgrd_col(begc:endc,:) + end if + + call restartvar(ncid=ncid, flag=flag, varname='albgri_dst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (diffuse) (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%albgri_dst_col) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_dst in initial file..." + if (masterproc) write(iulog,*) "Initialize albgri_dst to albgri" + this%albgri_dst_col(begc:endc,:) = this%albgri_col(begc:endc,:) + end if + + end if ! end of if-use_snicar_frc + + ! patch type physical state variable - fabd + call restartvar(ncid=ncid, flag=flag, varname='fabd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by veg per unit direct flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fabi', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by veg per unit diffuse flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabi_patch) + + call restartvar(ncid=ncid, flag=flag, varname='fabd_sun', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by sunlit leaf per unit direct flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabd_sun_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabd_sun in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabd_sun to fabd/2" + this%fabd_sun_patch(begp:endp,:) = this%fabd_patch(begp:endp,:)/2._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabd_sha', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by shaded leaf per unit direct flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabd_sha_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabd_sha in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabd_sha to fabd/2" + this%fabd_sha_patch(begp:endp,:) = this%fabd_patch(begp:endp,:)/2._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabi_sun', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by sunlit leaf per unit diffuse flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabi_sun_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabi_sun in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabi_sun to fabi/2" + this%fabi_sun_patch(begp:endp,:) = this%fabi_patch(begp:endp,:)/2._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabi_sha', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by shaded leaf per unit diffuse flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabi_sha_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabi_sha in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabi_sha to fabi/2" + this%fabi_sha_patch(begp:endp,:) = this%fabi_patch(begp:endp,:)/2._r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabd_sun_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='absorbed sunlit leaf direct PAR (per unit lai+sai) for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabd_sun_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabd_sun_z in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabd_sun_z to (fabd/2)/nlevcan" + do iv=1,nlevcan + this%fabd_sun_z_patch(begp:endp,iv) = (this%fabd_patch(begp:endp,1)/2._r8)/nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabd_sha_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='absorbed shaded leaf direct PAR (per unit lai+sai) for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabd_sha_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabd_sha_z in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabd_sha_z to (fabd/2)/nlevcan" + do iv=1,nlevcan + this%fabd_sha_z_patch(begp:endp,iv) = (this%fabd_patch(begp:endp,1)/2._r8)/nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabi_sun_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='absorbed sunlit leaf diffuse PAR (per unit lai+sai) for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabi_sun_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabi_sun_z in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabi_sun_z to (fabi/2)/nlevcan" + do iv=1,nlevcan + this%fabi_sun_z_patch(begp:endp,iv) = (this%fabi_patch(begp:endp,1)/2._r8)/nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='fabi_sha_z', xtype=ncd_double, & + dim1name='pft', dim2name='levcan', switchdim=.true., & + long_name='absorbed shaded leaf diffuse PAR (per unit lai+sai) for canopy layer', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fabi_sha_z_patch) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find fabi_sha_z in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize fabi_sha_z to (fabi/2)/nlevcan" + do iv=1,nlevcan + this%fabi_sha_z_patch(begp:endp,iv) = & + (this%fabi_patch(begp:endp,1)/2._r8)/nlevcan + end do + end if + + call restartvar(ncid=ncid, flag=flag, varname='ftdd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down direct flux below veg per unit direct flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ftdd_patch) + + call restartvar(ncid=ncid, flag=flag, varname='ftid', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down diffuse flux below veg per unit direct flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ftid_patch) + + call restartvar(ncid=ncid, flag=flag, varname='ftii', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down diffuse flux below veg per unit diffuse flux', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ftii_patch) + + !-------------------------------- + ! variables needed for SNICAR + !-------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='flx_absdv', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, & + long_name='snow layer flux absorption factors (direct, VIS)', units='fraction', & + interpinic_flag='interp', readvar=readvar, data=this%flx_absdv_col) + + call restartvar(ncid=ncid, flag=flag, varname='flx_absdn', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, & + long_name='snow layer flux absorption factors (direct, NIR)', units='fraction', & + interpinic_flag='interp', readvar=readvar, data=this%flx_absdn_col) + + call restartvar(ncid=ncid, flag=flag, varname='flx_absiv', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, & + long_name='snow layer flux absorption factors (diffuse, VIS)', units='fraction', & + interpinic_flag='interp', readvar=readvar, data=this%flx_absiv_col) + + call restartvar(ncid=ncid, flag=flag, varname='flx_absin', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., lowerb2=-nlevsno+1, upperb2=1, & + long_name='snow layer flux absorption factors (diffuse, NIR)', units='fraction', & + interpinic_flag='interp', readvar=readvar, data=this%flx_absin_col) + + end subroutine Restart + +end module SurfaceAlbedoType diff --git a/components/clm/src/biogeophys/SurfaceRadiationMod.F90 b/components/clm/src/biogeophys/SurfaceRadiationMod.F90 new file mode 100644 index 0000000000..b38f56b2fb --- /dev/null +++ b/components/clm/src/biogeophys/SurfaceRadiationMod.F90 @@ -0,0 +1,991 @@ +module SurfaceRadiationMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Calculate solar fluxes absorbed by vegetation and ground surface + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : use_snicar_frc, use_ed + use decompMod , only : bounds_type + use clm_varcon , only : namec + use atm2lndType , only : atm2lnd_type + use WaterstateType , only : waterstate_type + use CanopyStateType , only : canopystate_type + use SurfaceAlbedoType , only : surfalb_type + use SolarAbsorbedType , only : solarabs_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use EDtypesMod , only : ed_patch_type, ed_site_type, numpft_ed, map_clmpatch_to_edpatch + ! + ! !PRIVATE TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceRadiation ! Solar fluxes absorbed by veg and ground surface + ! + ! !PRIVATE DATA: + type, public :: surfrad_type + real(r8), pointer, private :: sfc_frc_aer_patch (:) ! patch surface forcing of snow with all aerosols (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_bc_patch (:) ! patch surface forcing of snow with BC (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_oc_patch (:) ! patch surface forcing of snow with OC (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_dst_patch (:) ! patch surface forcing of snow with dust (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_aer_sno_patch (:) ! patch surface forcing of snow with all aerosols, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_bc_sno_patch (:) ! patch surface forcing of snow with BC, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_oc_sno_patch (:) ! patch surface forcing of snow with OC, averaged only when snow is present (patch) [W/m2] + real(r8), pointer, private :: sfc_frc_dst_sno_patch (:) ! patch surface forcing of snow with dust, averaged only when snow is present (patch) [W/m2] + + real(r8), pointer, private :: parveg_ln_patch (:) ! patch absorbed par by vegetation at local noon (W/m**2) + + real(r8), pointer, private :: fsr_sno_vd_patch (:) ! patch reflected direct beam vis solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_nd_patch (:) ! patch reflected direct beam NIR solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_vi_patch (:) ! patch reflected diffuse vis solar radiation from snow (W/m**2) + real(r8), pointer, private :: fsr_sno_ni_patch (:) ! patch reflected diffuse NIR solar radiation from snow (W/m**2) + + real(r8), pointer, private :: fsr_vis_d_patch (:) ! patch reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer, private :: fsr_vis_i_patch (:) ! patch reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer, private :: fsr_vis_d_ln_patch (:) ! patch reflected direct beam vis solar radiation at local noon (W/m**2) + + real(r8), pointer, private :: fsds_sno_vd_patch (:) ! patch incident visible, direct radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_nd_patch (:) ! patch incident near-IR, direct radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_vi_patch (:) ! patch incident visible, diffuse radiation on snow (for history files) [W/m2] + real(r8), pointer, private :: fsds_sno_ni_patch (:) ! patch incident near-IR, diffuse radiation on snow (for history files) [W/m2] + + real(r8), pointer, private :: fsds_vis_d_patch (:) ! patch incident direct beam vis solar radiation (W/m**2) + real(r8), pointer, private :: fsds_vis_i_patch (:) ! patch incident diffuse vis solar radiation (W/m**2) + real(r8), pointer, private :: fsds_vis_d_ln_patch (:) ! patch incident direct beam vis solar radiation at local noon (W/m**2) + real(r8), pointer, private :: fsds_vis_i_ln_patch (:) ! patch incident diffuse beam vis solar radiation at local noon (W/m**2) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type surfrad_type + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + allocate(this%sfc_frc_aer_patch (begp:endp)) ; this%sfc_frc_aer_patch (:) = nan + allocate(this%sfc_frc_bc_patch (begp:endp)) ; this%sfc_frc_bc_patch (:) = nan + allocate(this%sfc_frc_oc_patch (begp:endp)) ; this%sfc_frc_oc_patch (:) = nan + allocate(this%sfc_frc_dst_patch (begp:endp)) ; this%sfc_frc_dst_patch (:) = nan + allocate(this%sfc_frc_aer_sno_patch (begp:endp)) ; this%sfc_frc_aer_sno_patch (:) = nan + allocate(this%sfc_frc_bc_sno_patch (begp:endp)) ; this%sfc_frc_bc_sno_patch (:) = nan + allocate(this%sfc_frc_oc_sno_patch (begp:endp)) ; this%sfc_frc_oc_sno_patch (:) = nan + allocate(this%sfc_frc_dst_sno_patch (begp:endp)) ; this%sfc_frc_dst_sno_patch (:) = nan + + allocate(this%parveg_ln_patch (begp:endp)) ; this%parveg_ln_patch (:) = nan + + allocate(this%fsr_vis_d_patch (begp:endp)) ; this%fsr_vis_d_patch (:) = nan + allocate(this%fsr_vis_d_ln_patch (begp:endp)) ; this%fsr_vis_d_ln_patch (:) = nan + allocate(this%fsr_vis_i_patch (begp:endp)) ; this%fsr_vis_i_patch (:) = nan + allocate(this%fsr_sno_vd_patch (begp:endp)) ; this%fsr_sno_vd_patch (:) = nan + allocate(this%fsr_sno_nd_patch (begp:endp)) ; this%fsr_sno_nd_patch (:) = nan + allocate(this%fsr_sno_vi_patch (begp:endp)) ; this%fsr_sno_vi_patch (:) = nan + allocate(this%fsr_sno_ni_patch (begp:endp)) ; this%fsr_sno_ni_patch (:) = nan + + allocate(this%fsds_vis_d_patch (begp:endp)) ; this%fsds_vis_d_patch (:) = nan + allocate(this%fsds_vis_i_patch (begp:endp)) ; this%fsds_vis_i_patch (:) = nan + allocate(this%fsds_vis_d_ln_patch (begp:endp)) ; this%fsds_vis_d_ln_patch (:) = nan + allocate(this%fsds_vis_i_ln_patch (begp:endp)) ; this%fsds_vis_i_ln_patch (:) = nan + allocate(this%fsds_sno_vd_patch (begp:endp)) ; this%fsds_sno_vd_patch (:) = nan + allocate(this%fsds_sno_nd_patch (begp:endp)) ; this%fsds_sno_nd_patch (:) = nan + allocate(this%fsds_sno_vi_patch (begp:endp)) ; this%fsds_sno_vi_patch (:) = nan + allocate(this%fsds_sno_ni_patch (begp:endp)) ; this%fsds_sno_ni_patch (:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! History fields initialization + ! + ! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : spval + use histFileMod , only : hist_addfld1d, hist_addfld2d + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + if (use_snicar_frc) then + this%sfc_frc_aer_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & + ptr_patch=this%sfc_frc_aer_patch, set_urb=spval) + + this%sfc_frc_aer_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_aer_sno_patch, set_urb=spval) + + this%sfc_frc_bc_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow (land) ', & + ptr_patch=this%sfc_frc_bc_patch, set_urb=spval) + + this%sfc_frc_bc_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_bc_sno_patch, set_urb=spval) + + this%sfc_frc_oc_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & + ptr_patch=this%sfc_frc_oc_patch, set_urb=spval) + + this%sfc_frc_oc_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_oc_sno_patch, set_urb=spval) + + this%sfc_frc_dst_patch(begp:endp) = spval + call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow (land) ', & + ptr_patch=this%sfc_frc_dst_patch, set_urb=spval) + + this%sfc_frc_dst_sno_patch(begp:endp) = spval + call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', & + ptr_patch=this%sfc_frc_dst_sno_patch, set_urb=spval) + end if + + this%fsds_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation', & + ptr_patch=this%fsds_vis_d_patch) + + this%fsds_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation', & + ptr_patch=this%fsds_vis_i_patch) + + this%fsr_vis_d_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation', & + ptr_patch=this%fsr_vis_d_patch, c2l_scale_type='urbanf') + + this%fsr_vis_i_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation', & + ptr_patch=this%fsr_vis_i_patch, c2l_scale_type='urbanf') + + this%fsds_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation at local noon', & + ptr_patch=this%fsds_vis_d_ln_patch) + + this%fsds_vis_i_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSDSVILN', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation at local noon', & + ptr_patch=this%fsds_vis_i_ln_patch) + + this%parveg_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='PARVEGLN', units='W/m^2', & + avgflag='A', long_name='absorbed par by vegetation at local noon', & + ptr_patch=this%parveg_ln_patch) + + this%fsr_vis_d_ln_patch(begp:endp) = spval + call hist_addfld1d (fname='FSRVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation at local noon', & + ptr_patch=this%fsr_vis_d_ln_patch, c2l_scale_type='urbanf') + + this%fsds_sno_vd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation on snow', & + ptr_patch=this%fsds_sno_vd_patch, default='inactive') + + this%fsds_sno_nd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation on snow', & + ptr_patch=this%fsds_sno_nd_patch, default='inactive') + + this%fsds_sno_vi_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation on snow', & + ptr_patch=this%fsds_sno_vi_patch, default='inactive') + + this%fsds_sno_ni_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir incident solar radiation on snow', & + ptr_patch=this%fsds_sno_ni_patch, default='inactive') + + this%fsr_sno_vd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_vd_patch, default='inactive') + + this%fsr_sno_nd_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRND', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_nd_patch, default='inactive') + + this%fsr_sno_vi_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_vi_patch, default='inactive') + + this%fsr_sno_ni_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir reflected solar radiation from snow', & + ptr_patch=this%fsr_sno_ni_patch, default='inactive') + + end subroutine InitHistory + + !------------------------------------------------------------------------ + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(surfrad_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l + !----------------------------------------------------------------------- + + ! nothing for now + + end subroutine InitCold + + !------------------------------------------------------------------------------ + subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & + num_urbanp, filter_urbanp, num_urbanc, filter_urbanc, & + ed_allsites_inst, atm2lnd_inst, waterstate_inst, canopystate_inst, & + surfalb_inst, solarabs_inst, surfrad_inst) + ! + ! !DESCRIPTION: + ! Solar fluxes absorbed by vegetation and ground surface + ! Note possible problem when land is on different grid than atmosphere. + ! Land may have sun above the horizon (coszen > 0) but atmosphere may + ! have sun below the horizon (forc_solad = 0 and forc_solai = 0). This is okay + ! because all fluxes (absorbed, reflected, transmitted) are multiplied + ! by the incoming flux and all will equal zero. + ! Atmosphere may have sun above horizon (forc_solad > 0 and forc_solai > 0) but + ! land may have sun below horizon. This is okay because fabd, fabi, + ! ftdd, ftid, and ftii all equal zero so that sabv=sabg=fsa=0. Also, + ! albd and albi equal one so that fsr=forc_solad+forc_solai. In other words, all + ! the radiation is reflected. NDVI should equal zero in this case. + ! However, the way the code is currently implemented this is only true + ! if (forc_solad+forc_solai)|vis = (forc_solad+forc_solai)|nir. + ! Output variables are parsun,parsha,sabv,sabg,fsa,fsr,ndvi + ! + ! !USES: + use clm_varpar , only : numrad, nlevsno + use clm_varcon , only : spval, degpsec, isecspday + use landunit_varcon , only : istsoil, istcrop + use clm_varctl , only : subgridflag, use_snicar_frc, iulog + use clm_time_manager , only : get_curr_date, get_step_size + use SnowSnicarMod , only : DO_SNO_OC + use abortutils , only : endrun + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanp ! number of patches in non-urban points in patch filter + integer , intent(in) :: filter_nourbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanp ! number of patches in non-urban points in patch filter + integer , intent(in) :: filter_urbanp(:) ! patch filter for non-urban points + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + type(ed_site_type) , intent(inout), target :: ed_allsites_inst( bounds%begg:) + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(surfrad_type) , intent(inout) :: surfrad_inst + ! + ! !LOCAL VARIABLES: + integer , parameter :: nband = numrad ! number of solar radiation waveband classes + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer :: fp ! non-urban filter patch index + integer :: p ! patch index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! grid cell index + integer :: ib ! waveband number (1=vis, 2=nir) + integer :: iv ! canopy layer + real(r8) :: absrad ! absorbed solar radiation (W/m**2) + integer :: i ! layer index [idx] + real(r8) :: rnir ! reflected solar radiation [nir] (W/m**2) + real(r8) :: rvis ! reflected solar radiation [vis] (W/m**2) + real(r8) :: trd(bounds%begp:bounds%endp,numrad) ! transmitted solar radiation: direct (W/m**2) + real(r8) :: tri(bounds%begp:bounds%endp,numrad) ! transmitted solar radiation: diffuse (W/m**2) + real(r8) :: cad(bounds%begp:bounds%endp,numrad) ! direct beam absorbed by canopy (W/m**2) + real(r8) :: cai(bounds%begp:bounds%endp,numrad) ! diffuse radiation absorbed by canopy (W/m**2) + integer :: local_secp1 ! seconds into current date in local time + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day,secs ! calendar info for current time step + real(r8) :: sabg_snl_sum ! temporary, absorbed energy in all active snow layers [W/m2] + real(r8) :: absrad_pur ! temp: absorbed solar radiation by pure snow [W/m2] + real(r8) :: absrad_bc ! temp: absorbed solar radiation without BC [W/m2] + real(r8) :: absrad_oc ! temp: absorbed solar radiation without OC [W/m2] + real(r8) :: absrad_dst ! temp: absorbed solar radiation without dust [W/m2] + real(r8) :: sabg_pur(bounds%begp:bounds%endp) ! solar radiation absorbed by ground with pure snow [W/m2] + real(r8) :: sabg_bc(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without BC [W/m2] + real(r8) :: sabg_oc(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without OC [W/m2] + real(r8) :: sabg_dst(bounds%begp:bounds%endp) ! solar radiation absorbed by ground without dust [W/m2] + real(r8) :: parveg(bounds%begp:bounds%endp) ! absorbed par by vegetation (W/m**2) + ! + integer, parameter :: noonsec = isecspday / 2 ! seconds at local noon + ! + !ED specific variables + real(r8) :: errsol(bounds%begp:bounds%endp) ! solar radiation error Wm-2 + real(r8) :: sunlai ! intermediate for calculating canopy fsun + real(r8) :: shalai ! intermediate for calculating canopy fsha + integer :: CL ! Canopy Layer index + integer :: FT ! clm patch index + real :: gaib, rib ! for debugging + type (ed_patch_type), pointer :: currentPatch ! Import fapar matrix for each patch from ED data structure. + !------------------------------------------------------------------------------ + + associate( & + snl => col%snl , & ! Input: [integer (:) ] negative number of snow layers [nbr] + + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (W/m**2) + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse radiation (W/m**2) + + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + + nrad => surfalb_inst%nrad_patch , & ! Input: [integer (:) ] number of canopy layers, above snow for radiative transfer + fsun_z => surfalb_inst%fsun_z_patch , & ! Input: [real(r8) (:,:) ] sunlit fraction of canopy layer + tlai_z => surfalb_inst%tlai_z_patch , & ! Input: [real(r8) (:,:) ] tlai increment for canopy layer + tsai_z => surfalb_inst%tsai_z_patch , & ! Input: [real(r8) (:,:) ] tsai increment for canopy layer + coszen => surfalb_inst%coszen_col , & ! Input: [real(r8) (:) ] column cosine of solar zenith angle + albgrd => surfalb_inst%albgrd_col , & ! Input: [real(r8) (:,:) ] ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Input: [real(r8) (:,:) ] ground albedo (diffuse) + albsod => surfalb_inst%albsod_col , & ! Input: [real(r8) (:,:) ] direct-beam soil albedo (col,bnd) [frc] + albgrd_oc => surfalb_inst%albgrd_oc_col , & ! Input: [real(r8) (:,:) ] ground albedo without OC (direct) (col,bnd) + albgri_oc => surfalb_inst%albgri_oc_col , & ! Input: [real(r8) (:,:) ] ground albedo without OC (diffuse) (col,bnd) + albgrd_dst => surfalb_inst%albgrd_dst_col , & ! Input: [real(r8) (:,:) ] ground albedo without dust (direct) (col,bnd) + albgri_dst => surfalb_inst%albgri_dst_col , & ! Input: [real(r8) (:,:) ] ground albedo without dust (diffuse) (col,bnd) + albsnd_hst => surfalb_inst%albsnd_hst_col , & ! Input: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) [frc] + albsni_hst => surfalb_inst%albsni_hst_col , & ! Input: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd + flx_absdv => surfalb_inst%flx_absdv_col , & ! Input: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): VIS [frc] + flx_absdn => surfalb_inst%flx_absdn_col , & ! Input: [real(r8) (:,:) ] direct flux absorption factor (col,lyr): NIR [frc] + flx_absiv => surfalb_inst%flx_absiv_col , & ! Input: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): VIS [frc] + flx_absin => surfalb_inst%flx_absin_col , & ! Input: [real(r8) (:,:) ] diffuse flux absorption factor (col,lyr): NIR [frc] + albsoi => surfalb_inst%albsoi_col , & ! Input: [real(r8) (:,:) ] diffuse soil albedo (col,bnd) [frc] + albd => surfalb_inst%albd_patch , & ! Input: [real(r8) (:,:) ] surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Input: [real(r8) (:,:) ] surface albedo (diffuse) + fabd => surfalb_inst%fabd_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Input: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Input: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Input: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Input: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux + fabd_sun_z => surfalb_inst%fabd_sun_z_patch , & ! Input: [real(r8) (:,:) ] absorbed sunlit leaf direct PAR (per unit lai+sai) for each canopy layer + fabd_sha_z => surfalb_inst%fabd_sha_z_patch , & ! Input: [real(r8) (:,:) ] absorbed shaded leaf direct PAR (per unit lai+sai) for each canopy layer + fabi_sun_z => surfalb_inst%fabi_sun_z_patch , & ! Input: [real(r8) (:,:) ] absorbed sunlit leaf diffuse PAR (per unit lai+sai) for each canopy layer + fabi_sha_z => surfalb_inst%fabi_sha_z_patch , & ! Input: [real(r8) (:,:) ] absorbed shaded leaf diffuse PAR (per unit lai+sai) for each canopy layer + albgrd_pur => surfalb_inst%albgrd_pur_col , & ! Input: [real(r8) (:,:) ] pure snow ground albedo (direct) + albgri_pur => surfalb_inst%albgri_pur_col , & ! Input: [real(r8) (:,:) ] pure snow ground albedo (diffuse) + albgrd_bc => surfalb_inst%albgrd_bc_col , & ! Input: [real(r8) (:,:) ] ground albedo without BC (direct) (col,bnd) + albgri_bc => surfalb_inst%albgri_bc_col , & ! Input: [real(r8) (:,:) ] ground albedo without BC (diffuse) (col,bnd) + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + laisun => canopystate_inst%laisun_patch , & ! Output: [real(r8) (:) ] sunlit leaf area + laisha => canopystate_inst%laisha_patch , & ! Output: [real(r8) (:) ] shaded leaf area + laisun_z => canopystate_inst%laisun_z_patch , & ! Output: [real(r8) (:,:) ] sunlit leaf area for canopy layer + laisha_z => canopystate_inst%laisha_z_patch , & ! Output: [real(r8) (:,:) ] shaded leaf area for canopy layer + fsun => canopystate_inst%fsun_patch , & ! Output: [real(r8) (:) ] sunlit fraction of canopy + + fsa => solarabs_inst%fsa_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed (total) (W/m**2) + fsr => solarabs_inst%fsr_patch , & ! Output: [real(r8) (:) ] solar radiation reflected (W/m**2) + sabv => solarabs_inst%sabv_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + sabg => solarabs_inst%sabg_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + sabg_pen => solarabs_inst%sabg_pen_patch , & ! Output: [real(r8) (:) ] solar (rural) radiation penetrating top soisno layer (W/m**2) + sabg_soil => solarabs_inst%sabg_soil_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by soil (W/m**2) + sabg_snow => solarabs_inst%sabg_snow_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by snow (W/m**2) + sabg_lyr => solarabs_inst%sabg_lyr_patch , & ! Output: [real(r8) (:,:) ] absorbed radiative flux (patch,lyr) [W/m2] + parsun_z => solarabs_inst%parsun_z_patch , & ! Output: [real(r8) (:,:) ] absorbed PAR for sunlit leaves in canopy layer + parsha_z => solarabs_inst%parsha_z_patch , & ! Output: [real(r8) (:,:) ] absorbed PAR for shaded leaves in canopy layer + fsr_nir_d => solarabs_inst%fsr_nir_d_patch , & ! Output: [real(r8) (:) ] reflected direct beam nir solar radiation (W/m**2) + fsr_nir_i => solarabs_inst%fsr_nir_i_patch , & ! Output: [real(r8) (:) ] reflected diffuse nir solar radiation (W/m**2) + fsr_nir_d_ln => solarabs_inst%fsr_nir_d_ln_patch , & ! Output: [real(r8) (:) ] reflected direct beam nir solar rad at local noon (W/m**2) + fsds_nir_d => solarabs_inst%fsds_nir_d_patch , & ! Output: [real(r8) (:) ] incident direct beam nir solar radiation (W/m**2) + fsds_nir_d_ln => solarabs_inst%fsds_nir_d_ln_patch , & ! Output: [real(r8) (:) ] incident direct beam nir solar rad at local noon (W/m**2) + fsds_nir_i => solarabs_inst%fsds_nir_i_patch , & ! Output: [real(r8) (:) ] incident diffuse nir solar radiation (W/m**2) + fsa_r => solarabs_inst%fsa_r_patch , & ! Output: [real(r8) (:) ] rural solar radiation absorbed (total) (W/m**2) + sub_surf_abs_SW => solarabs_inst%sub_surf_abs_SW_col , & ! Output: [real(r8) (:) ] percent of solar radiation absorbed below first snow layer (W/M**2) + + parveg_ln => surfrad_inst%parveg_ln_patch , & ! Output: [real(r8) (:) ] absorbed par by vegetation at local noon (W/m**2) + fsr_vis_d => surfrad_inst%fsr_vis_d_patch , & ! Output: [real(r8) (:) ] reflected direct beam vis solar radiation (W/m**2) + fsr_vis_i => surfrad_inst%fsr_vis_i_patch , & ! Output: [real(r8) (:) ] reflected diffuse vis solar radiation (W/m**2) + fsds_vis_i_ln => surfrad_inst%fsds_vis_i_ln_patch , & ! Output: [real(r8) (:) ] incident diffuse beam vis solar rad at local noon (W/m**2) + fsr_vis_d_ln => surfrad_inst%fsr_vis_d_ln_patch , & ! Output: [real(r8) (:) ] reflected direct beam vis solar rad at local noon (W/m**2) + fsds_vis_d => surfrad_inst%fsds_vis_d_patch , & ! Output: [real(r8) (:) ] incident direct beam vis solar radiation (W/m**2) + fsds_vis_i => surfrad_inst%fsds_vis_i_patch , & ! Output: [real(r8) (:) ] incident diffuse vis solar radiation (W/m**2) + fsds_vis_d_ln => surfrad_inst%fsds_vis_d_ln_patch , & ! Output: [real(r8) (:) ] incident direct beam vis solar rad at local noon (W/m**2) + sfc_frc_aer => surfrad_inst%sfc_frc_aer_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with all aerosols (patch) [W/m2] + sfc_frc_aer_sno => surfrad_inst%sfc_frc_aer_sno_patch, & ! Output: [real(r8) (:) ] surface forcing of snow with all aerosols, averaged only when snow is present (patch) [W/m2] + sfc_frc_bc => surfrad_inst%sfc_frc_bc_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with BC (patch) [W/m2] + sfc_frc_bc_sno => surfrad_inst%sfc_frc_bc_sno_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with BC, averaged only when snow is present (patch) [W/m2] + sfc_frc_oc => surfrad_inst%sfc_frc_oc_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with OC (patch) [W/m2] + sfc_frc_oc_sno => surfrad_inst%sfc_frc_oc_sno_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with OC, averaged only when snow is present (patch) [W/m2] + sfc_frc_dst => surfrad_inst%sfc_frc_dst_patch , & ! Output: [real(r8) (:) ] surface forcing of snow with dust (patch) [W/m2] + sfc_frc_dst_sno => surfrad_inst%sfc_frc_dst_sno_patch, & ! Output: [real(r8) (:) ] surface forcing of snow with dust, averaged only when snow is present (patch) [W/m2] + fsr_sno_vd => surfrad_inst%fsr_sno_vd_patch , & ! Output: [real(r8) (:) ] reflected visible, direct radiation from snow (for history files) (patch) [W/m2] + fsr_sno_nd => surfrad_inst%fsr_sno_nd_patch , & ! Output: [real(r8) (:) ] reflected near-IR, direct radiation from snow (for history files) (patch) [W/m2] + fsr_sno_vi => surfrad_inst%fsr_sno_vi_patch , & ! Output: [real(r8) (:) ] reflected visible, diffuse radiation from snow (for history files) (patch) [W/m2] + fsr_sno_ni => surfrad_inst%fsr_sno_ni_patch , & ! Output: [real(r8) (:) ] reflected near-IR, diffuse radiation from snow (for history files) (patch) [W/m2] + fsds_sno_vd => surfrad_inst%fsds_sno_vd_patch , & ! Output: [real(r8) (:) ] incident visible, direct radiation on snow (for history files) (patch) [W/m2] + fsds_sno_nd => surfrad_inst%fsds_sno_nd_patch , & ! Output: [real(r8) (:) ] incident near-IR, direct radiation on snow (for history files) (patch) [W/m2] + fsds_sno_vi => surfrad_inst%fsds_sno_vi_patch , & ! Output: [real(r8) (:) ] incident visible, diffuse radiation on snow (for history files) (patch) [W/m2] + fsds_sno_ni => surfrad_inst%fsds_sno_ni_patch & ! Output: [real(r8) (:) ] incident near-IR, diffuse radiation on snow (for history files) (patch) [W/m2] + ) + + ! Determine seconds off current time step + + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Initialize fluxes + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = patch%landunit(p) + g = patch%gridcell(p) + + sabg_soil(p) = 0._r8 + sabg_snow(p) = 0._r8 + sabg(p) = 0._r8 + sabv(p) = 0._r8 + fsa(p) = 0._r8 + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = 0._r8 + end if + sabg_lyr(p,:) = 0._r8 + sabg_pur(p) = 0._r8 + sabg_bc(p) = 0._r8 + sabg_oc(p) = 0._r8 + sabg_dst(p) = 0._r8 + + if( use_ed )then ! use_ed + + if ( patch%is_veg(p) ) then + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + currentPatch%ed_parsun_z(:,:,:) = 0._r8 + currentPatch%ed_parsha_z(:,:,:) = 0._r8 + currentPatch%ed_laisun_z(:,:,:) = 0._r8 + currentPatch%ed_laisha_z(:,:,:) = 0._r8 + fsun(p) = 0._r8 + endif + + else ! not use_ed + + do iv = 1, nrad(p) + parsun_z(p,iv) = 0._r8 + parsha_z(p,iv) = 0._r8 + laisun_z(p,iv) = 0._r8 + laisha_z(p,iv) = 0._r8 + end do + + end if ! end of if-use_ed + + end do + + ! Loop over patches to calculate laisun_z and laisha_z for each layer. + ! Derive canopy laisun, laisha, and fsun from layer sums. + ! If sun/shade big leaf code, nrad=1 and fsun_z(p,1) and tlai_z(p,1) from + ! SurfaceAlbedo is canopy integrated so that layer value equals canopy value. + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + + if( use_ed )then + + ! currentPatch%f_sun is calculated in the surface_albedo routine... + if (patch%is_veg(p)) then + fsun(p) = 0._r8 + sunlai = 0._r8 + shalai = 0._r8 + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + do CL = 1, currentPatch%NCL_p + do FT = 1,numpft_ed + do iv = 1, currentPatch%nrad(CL,ft) !NORMAL CASE. + ! FIX(SPM,040114) ** Should this be elai or tlai? Surely we only do radiation for elai? + currentPatch%ed_laisun_z(CL,ft,iv) = currentPatch%elai_profile(CL,ft,iv) * & + currentPatch%f_sun(CL,ft,iv) + currentPatch%ed_laisha_z(CL,ft,iv) = currentPatch%elai_profile(CL,ft,iv) * & + (1._r8 - currentPatch%f_sun(CL,ft,iv)) + end do + sunlai = sunlai + sum(currentPatch%ed_laisun_z(CL,ft,1: currentPatch%nrad(CL,ft))) + shalai = shalai + sum(currentPatch%ed_laisha_z(CL,ft,1: currentPatch%nrad(CL,ft))) + !needed for the VOC emissions, etc. + end do + end do + if(sunlai+shalai > 0._r8)then + fsun(p) = sunlai / (sunlai+shalai) + else + fsun(p) = 0._r8 + endif + if(fsun(p) > 1._r8)then + write(iulog,*) 'too much leaf area in profile', fsun(p),currentPatch%lai,sunlai,shalai + endif + + else ! not is_veg + + fsun(p) = 0.0_r8 + + end if !end of is_veg + + else ! use_ed false. revert to normal multi-layer canopy. + + laisun(p) = 0._r8 + laisha(p) = 0._r8 + do iv = 1, nrad(p) + laisun_z(p,iv) = tlai_z(p,iv) * fsun_z(p,iv) + laisha_z(p,iv) = tlai_z(p,iv) * (1._r8 - fsun_z(p,iv)) + laisun(p) = laisun(p) + laisun_z(p,iv) + laisha(p) = laisha(p) + laisha_z(p,iv) + end do + if (elai(p) > 0._r8) then + fsun(p) = laisun(p) / elai(p) + else + fsun(p) = 0._r8 + end if + + end if ! end of if-use_ed + + end do ! end of fp = 1,num_nourbanp loop + + do ib = 1, numrad + do fp = 1,num_urbanp + p = filter_urbanp(fp) + if (ib == 1) then + fsun(p) = 0._r8 + end if + end do + end do + + ! Loop over nband wavebands + do ib = 1, nband + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + ! Absorbed by canopy + + cad(p,ib) = forc_solad(g,ib)*fabd(p,ib) + cai(p,ib) = forc_solai(g,ib)*fabi(p,ib) + sabv(p) = sabv(p) + cad(p,ib) + cai(p,ib) + fsa(p) = fsa(p) + cad(p,ib) + cai(p,ib) + if (ib == 1) then + parveg(p) = cad(p,ib) + cai(p,ib) + end if + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = fsa_r(p) + cad(p,ib) + cai(p,ib) + end if + + ! Absorbed PAR profile through canopy + ! If sun/shade big leaf code, nrad=1 and fluxes from SurfaceAlbedo + ! are canopy integrated so that layer values equal big leaf values. + + if (ib == 1) then + + if ( use_ed ) then + + if (patch%is_veg(p)) then + currentPatch => map_clmpatch_to_edpatch(ed_allsites_inst(g), p) + do CL = 1, currentPatch%NCL_p + do FT = 1,numpft_ed + do iv = 1, currentPatch%nrad(CL,ft) + currentPatch%ed_parsun_z(CL,ft,iv) = & + forc_solad(g,ib)*currentPatch%fabd_sun_z(CL,ft,iv) + & + forc_solai(g,ib)*currentPatch%fabi_sun_z(CL,ft,iv) + currentPatch%ed_parsha_z(CL,ft,iv) = & + forc_solad(g,ib)*currentPatch%fabd_sha_z(CL,ft,iv) + & + forc_solai(g,ib)*currentPatch%fabi_sha_z(CL,ft,iv) + end do !iv + end do !FT + end do !CL + end if ! is_veg check + + else ! not use_ed + + do iv = 1, nrad(p) + parsun_z(p,iv) = forc_solad(g,ib)*fabd_sun_z(p,iv) + forc_solai(g,ib)*fabi_sun_z(p,iv) + parsha_z(p,iv) = forc_solad(g,ib)*fabd_sha_z(p,iv) + forc_solai(g,ib)*fabi_sha_z(p,iv) + end do + + end if ! end of use_ed + + end if ! end of if ib is 1 + + ! Transmitted = solar fluxes incident on ground + + trd(p,ib) = forc_solad(g,ib)*ftdd(p,ib) + tri(p,ib) = forc_solad(g,ib)*ftid(p,ib) + forc_solai(g,ib)*ftii(p,ib) + ! Solar radiation absorbed by ground surface + ! calculate absorbed solar by soil/snow separately + absrad = trd(p,ib)*(1._r8-albsod(c,ib)) + tri(p,ib)*(1._r8-albsoi(c,ib)) + sabg_soil(p) = sabg_soil(p) + absrad + absrad = trd(p,ib)*(1._r8-albsnd_hst(c,ib)) + tri(p,ib)*(1._r8-albsni_hst(c,ib)) + sabg_snow(p) = sabg_snow(p) + absrad + absrad = trd(p,ib)*(1._r8-albgrd(c,ib)) + tri(p,ib)*(1._r8-albgri(c,ib)) + sabg(p) = sabg(p) + absrad + fsa(p) = fsa(p) + absrad + if (lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) then + fsa_r(p) = fsa_r(p) + absrad + end if + if (snl(c) == 0) then + sabg_snow(p) = sabg(p) + sabg_soil(p) = sabg(p) + endif + ! if no subgrid fluxes, make sure to set both components equal to weighted average + if (subgridflag == 0) then + sabg_snow(p) = sabg(p) + sabg_soil(p) = sabg(p) + endif + + if (use_snicar_frc) then + ! Solar radiation absorbed by ground surface without BC + absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib)) + sabg_bc(p) = sabg_bc(p) + absrad_bc + + ! Solar radiation absorbed by ground surface without OC + absrad_oc = trd(p,ib)*(1._r8-albgrd_oc(c,ib)) + tri(p,ib)*(1._r8-albgri_oc(c,ib)) + sabg_oc(p) = sabg_oc(p) + absrad_oc + + ! Solar radiation absorbed by ground surface without dust + absrad_dst = trd(p,ib)*(1._r8-albgrd_dst(c,ib)) + tri(p,ib)*(1._r8-albgri_dst(c,ib)) + sabg_dst(p) = sabg_dst(p) + absrad_dst + + ! Solar radiation absorbed by ground surface without any aerosols + absrad_pur = trd(p,ib)*(1._r8-albgrd_pur(c,ib)) + tri(p,ib)*(1._r8-albgri_pur(c,ib)) + sabg_pur(p) = sabg_pur(p) + absrad_pur + end if + + end do ! end of patch loop + end do ! end nbands loop + + ! compute absorbed flux in each snow layer and top soil layer, + ! based on flux factors computed in the radiative transfer portion of SNICAR. + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + sabg_snl_sum = 0._r8 + + sub_surf_abs_SW(c) = 0._r8 + + ! CASE1: No snow layers: all energy is absorbed in top soil layer + if (snl(c) == 0) then + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,1) = sabg(p) + sabg_snl_sum = sabg_lyr(p,1) + + ! CASE 2: Snow layers present: absorbed radiation is scaled according to + ! flux factors computed by SNICAR + else + do i = -nlevsno+1,1,1 + sabg_lyr(p,i) = flx_absdv(c,i)*trd(p,1) + flx_absdn(c,i)*trd(p,2) + & + flx_absiv(c,i)*tri(p,1) + flx_absin(c,i)*tri(p,2) + ! summed radiation in active snow layers: + if (i >= snl(c)+1) then + sabg_snl_sum = sabg_snl_sum + sabg_lyr(p,i) + endif + if (i > snl(c)+1) then ! if snow layer is below surface snow layer + !accumulate subsurface flux as a diagnostic for history file + sub_surf_abs_SW(c) = sub_surf_abs_SW(c) + sabg_lyr(p,i) + endif + enddo + + ! Divide absorbed by total, to get % absorbed in subsurface + if (sabg_snl_sum /= 0._r8) then + sub_surf_abs_SW(c) = sub_surf_abs_SW(c)/sabg_snl_sum + else + sub_surf_abs_SW(c) = 0._r8 + endif + + ! Error handling: The situation below can occur when solar radiation is + ! NOT computed every timestep. + ! When the number of snow layers has changed in between computations of the + ! absorbed solar energy in each layer, we must redistribute the absorbed energy + ! to avoid physically unrealistic conditions. The assumptions made below are + ! somewhat arbitrary, but this situation does not arise very frequently. + ! This error handling is implemented to accomodate any value of the + ! radiation frequency. + ! change condition to match sabg_snow isntead of sabg + if (abs(sabg_snl_sum-sabg_snow(p)) > 0.00001_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-nlevsno+1:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-nlevsno+1:-1) = 0._r8 + sabg_lyr(p,0) = sabg_snow(p)*0.6_r8 + sabg_lyr(p,1) = sabg_snow(p)*0.4_r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg_snow(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg_snow(p)*0.25_r8 + endif + endif + + ! If shallow snow depth, all solar radiation absorbed in top or top two snow layers + ! to prevent unrealistic timestep soil warming + if (subgridflag == 0) then + if (snow_depth(c) < 0.10_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-nlevsno+1:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-nlevsno+1:-1) = 0._r8 + sabg_lyr(p,0) = sabg(p) + sabg_lyr(p,1) = 0._r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8 + endif + endif + endif + endif + + ! This situation should not happen: + if (abs(sum(sabg_lyr(p,:))-sabg_snow(p)) > 0.00001_r8) then + write(iulog,*)"SNICAR ERROR: Absorbed ground radiation not equal to summed snow layer radiation" + write(iulog,*)"Diff = ",sum(sabg_lyr(p,:))-sabg_snow(p) + write(iulog,*)"sabg_snow(p)= ",sabg_snow(p) + write(iulog,*)"sabg_sum(p) = ",sum(sabg_lyr(p,:)) + write(iulog,*)"snl(c) = ",snl(c) + write(iulog,*)"flx_absdv1 = ",trd(p,1)*(1.-albgrd(c,1)) + write(iulog,*)"flx_absdv2 = ",sum(flx_absdv(c,:))*trd(p,1) + write(iulog,*)"flx_absiv1 = ",tri(p,1)*(1.-albgri(c,1)) + write(iulog,*)"flx_absiv2 = ",sum(flx_absiv(c,:))*tri(p,1) + write(iulog,*)"flx_absdn1 = ",trd(p,2)*(1.-albgrd(c,2)) + write(iulog,*)"flx_absdn2 = ",sum(flx_absdn(c,:))*trd(p,2) + write(iulog,*)"flx_absin1 = ",tri(p,2)*(1.-albgri(c,2)) + write(iulog,*)"flx_absin2 = ",sum(flx_absin(c,:))*tri(p,2) + write(iulog,*)"albgrd_nir = ",albgrd(c,2) + write(iulog,*)"coszen = ",coszen(c) + call endrun(decomp_index=c, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + + ! Diagnostic: shortwave penetrating ground (e.g. top layer) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + sabg_pen(p) = sabg(p) - sabg_lyr(p, snl(c)+1) + end if + + if (use_snicar_frc) then + + ! BC aerosol forcing (patch-level): + sfc_frc_bc(p) = sabg(p) - sabg_bc(p) + + ! OC aerosol forcing (patch-level): + if (DO_SNO_OC) then + sfc_frc_oc(p) = sabg(p) - sabg_oc(p) + else + sfc_frc_oc(p) = 0._r8 + endif + + ! dust aerosol forcing (patch-level): + sfc_frc_dst(p) = sabg(p) - sabg_dst(p) + + ! all-aerosol forcing (patch-level): + sfc_frc_aer(p) = sabg(p) - sabg_pur(p) + + ! forcings averaged only over snow: + if (frac_sno(c) > 0._r8) then + sfc_frc_bc_sno(p) = sfc_frc_bc(p)/frac_sno(c) + sfc_frc_oc_sno(p) = sfc_frc_oc(p)/frac_sno(c) + sfc_frc_dst_sno(p) = sfc_frc_dst(p)/frac_sno(c) + sfc_frc_aer_sno(p) = sfc_frc_aer(p)/frac_sno(c) + else + sfc_frc_bc_sno(p) = spval + sfc_frc_oc_sno(p) = spval + sfc_frc_dst_sno(p) = spval + sfc_frc_aer_sno(p) = spval + endif + end if + enddo + + ! Radiation diagnostics + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + + ! NDVI and reflected solar radiation + + rvis = albd(p,1)*forc_solad(g,1) + albi(p,1)*forc_solai(g,1) + rnir = albd(p,2)*forc_solad(g,2) + albi(p,2)*forc_solai(g,2) + fsr(p) = rvis + rnir + + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + fsr_vis_d(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d(p) = albd(p,2)*forc_solad(g,2) + fsr_vis_i(p) = albi(p,1)*forc_solai(g,1) + fsr_nir_i(p) = albi(p,2)*forc_solai(g,2) + + local_secp1 = secs + nint((grc%londeg(g)/degpsec)/dtime)*dtime + local_secp1 = mod(local_secp1,isecspday) + if (local_secp1 == isecspday/2) then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + fsr_vis_d_ln(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d_ln(p) = albd(p,2)*forc_solad(g,2) + fsds_vis_i_ln(p) = forc_solai(g,1) + parveg_ln(p) = parveg(p) + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + fsds_vis_i_ln(p) = spval + parveg_ln(p) = spval + end if + + ! diagnostic variables (downwelling and absorbed radiation partitioning) for history files + ! (OPTIONAL) + c = patch%column(p) + if (snl(c) < 0) then + fsds_sno_vd(p) = forc_solad(g,1) + fsds_sno_nd(p) = forc_solad(g,2) + fsds_sno_vi(p) = forc_solai(g,1) + fsds_sno_ni(p) = forc_solai(g,2) + + fsr_sno_vd(p) = fsds_vis_d(p)*albsnd_hst(c,1) + fsr_sno_nd(p) = fsds_nir_d(p)*albsnd_hst(c,2) + fsr_sno_vi(p) = fsds_vis_i(p)*albsni_hst(c,1) + fsr_sno_ni(p) = fsds_nir_i(p)*albsni_hst(c,2) + else + fsds_sno_vd(p) = spval + fsds_sno_nd(p) = spval + fsds_sno_vi(p) = spval + fsds_sno_ni(p) = spval + + fsr_sno_vd(p) = spval + fsr_sno_nd(p) = spval + fsr_sno_vi(p) = spval + fsr_sno_ni(p) = spval + endif + end do + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + g = patch%gridcell(p) + + local_secp1 = secs + nint((grc%londeg(g)/degpsec)/dtime)*dtime + local_secp1 = mod(local_secp1,isecspday) + + if(elai(p)==0.0_r8.and.fabd(p,1)>0._r8)then + ! FIX(SPM, 051314) - is this necessary ? puts lots of info in + ! lnd.log + write(iulog,*) 'absorption without LAI',elai(p),tlai(p),fabd(p,1),p + endif + ! Solar incident + + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + + ! Determine local noon incident solar + if (local_secp1 == noonsec) then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + fsds_vis_i_ln(p) = forc_solai(g,1) + parveg_ln(p) = 0._r8 + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + fsds_vis_i_ln(p) = spval + parveg_ln(p) = spval + endif + + ! Solar reflected + ! per unit ground area (roof, road) and per unit wall area (sunwall, shadewall) + + fsr_vis_d(p) = albd(p,1) * forc_solad(g,1) + fsr_nir_d(p) = albd(p,2) * forc_solad(g,2) + fsr_vis_i(p) = albi(p,1) * forc_solai(g,1) + fsr_nir_i(p) = albi(p,2) * forc_solai(g,2) + + ! Determine local noon reflected solar + if (local_secp1 == noonsec) then + fsr_vis_d_ln(p) = fsr_vis_d(p) + fsr_nir_d_ln(p) = fsr_nir_d(p) + else + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + endif + fsr(p) = fsr_vis_d(p) + fsr_nir_d(p) + fsr_vis_i(p) + fsr_nir_i(p) + end do + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + g = patch%gridcell(p) + if (use_ed) then + errsol(p) = (fsa(p) + fsr(p) - (forc_solad(g,1) + forc_solad(g,2) + forc_solai(g,1) + forc_solai(g,2))) + if(abs(errsol(p)) > 0.1_r8)then + g = patch%gridcell(p) + write(iulog,*) 'sol error in surf rad',p,g, errsol(p), patch%is_veg(p) + endif + end if + end do + + end associate + + end subroutine SurfaceRadiation + +end module SurfaceRadiationMod diff --git a/components/clm/src/biogeophys/SurfaceResistanceMod.F90 b/components/clm/src/biogeophys/SurfaceResistanceMod.F90 new file mode 100644 index 0000000000..93b7212964 --- /dev/null +++ b/components/clm/src/biogeophys/SurfaceResistanceMod.F90 @@ -0,0 +1,186 @@ +module SurfaceResistanceMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines for calculation of surface resistances of the different tracers + ! transported with BeTR. The surface here refers to water and soil, not including canopy + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod , only: SHR_CONST_TKFRZ + use clm_varctl , only: iulog + use SoilStateType , only: soilstate_type + use WaterStateType, only: waterstate_type + + implicit none + save + private + integer :: soil_stress_method !choose the method for soil resistance calculation + + integer, parameter :: leepielke_1992 = 0 ! + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: calc_soilevap_stress + public :: do_soilevap_beta + public :: init_soil_stress + ! + ! !REVISION HISTORY: + ! 6/25/2013 Created by Jinyun Tang + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine init_soil_stress() + ! + !DESCRIPTIONS + ! initialize method for soil stress calculation + implicit none + + soil_stress_method = leepielke_1992 + + end subroutine init_soil_stress + + !------------------------------------------------------------------------------ + subroutine calc_soilevap_stress(bounds, num_nolakec, filter_nolakec, & + soilstate_inst, waterstate_inst) + ! + ! DESCRIPTIONS + ! compute the stress factor for soil evaporation calculation + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_PI + use decompMod , only : bounds_type + use ColumnType , only : col + use LandunitType , only : lun + use abortutils , only : endrun + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec + integer , intent(in) :: filter_nolakec(:) + type(soilstate_type) , intent(inout) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + + character(len=32) :: subname = 'calc_soilevap_stress' ! subroutine name + associate( & + soilbeta => soilstate_inst%soilbeta_col & ! Output: [real(r8) (:)] factor that reduces ground evaporation + ) + + !select the right method and do the calculation + select case (soil_stress_method) + + case (leepielke_1992) + call calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, & + soilstate_inst, waterstate_inst, soilbeta(bounds%begc:bounds%endc)) + + case default + call endrun(subname // ':: a soilevap stress function must be specified!') + end select + + end associate + + end subroutine calc_soilevap_stress + + !------------------------------------------------------------------------------ + subroutine calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, & + soilstate_inst, waterstate_inst, soilbeta) + ! + ! DESCRIPTION + ! compute the lee-pielke beta factor to scal actual soil evaporation from potential evaporation + ! + ! USES + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_PI + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use clm_varcon , only : denh2o, denice + use landunit_varcon , only : istice, istice_mec, istwet, istsoil, istcrop + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_imperv, icol_road_perv + use ColumnType , only : col + use LandunitType , only : lun + ! + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec + integer , intent(in) :: filter_nolakec(:) + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + real(r8) , intent(inout) :: soilbeta(bounds%begc:bounds%endc) + + !local variables + real(r8) :: fac, fac_fc, wx !temporary variables + integer :: c, l, fc !indices + + SHR_ASSERT_ALL((ubound(soilbeta) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:)] volumetric soil water at saturation (porosity) + watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:)] volumetric soil water at field capacity + + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:)] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:)] liquid water (kg/m2) + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) + frac_h2osfc => waterstate_inst%frac_h2osfc_col & ! Input: [real(r8) (:)] fraction of ground covered by surface water (0 to 1) + ) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice & + .AND. lun%itype(l)/=istice_mec) then + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + wx = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/col%dz(c,1) + fac = min(1._r8, wx/watsat(c,1)) + fac = max( fac, 0.01_r8 ) + !! Lee and Pielke 1992 beta, added by K.Sakaguchi + if (wx < watfc(c,1) ) then !when water content of ths top layer is less than that at F.C. + fac_fc = min(1._r8, wx/watfc(c,1)) !eqn5.66 but divided by theta at field capacity + fac_fc = max( fac_fc, 0.01_r8 ) + ! modify soil beta by snow cover. soilbeta for snow surface is one + soilbeta(c) = (1._r8-frac_sno(c)-frac_h2osfc(c)) & + *0.25_r8*(1._r8 - cos(SHR_CONST_PI*fac_fc))**2._r8 & + + frac_sno(c)+ frac_h2osfc(c) + else !when water content of ths top layer is more than that at F.C. + soilbeta(c) = 1._r8 + end if + else if (col%itype(c) == icol_road_perv) then + soilbeta(c) = 0._r8 + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall) then + soilbeta(c) = 0._r8 + else if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then + soilbeta(c) = 0._r8 + endif + else + soilbeta(c) = 1._r8 + endif + enddo + + end associate + + end subroutine calc_beta_leepielke1992 + + !------------------------------------------------------------------------------ + function do_soilevap_beta()result(lres) + ! + !DESCRIPTION + ! return true if the moisture stress for soil evaporation is computed as beta factor + ! otherwise false + implicit none + logical :: lres + + if(soil_stress_method==leepielke_1992)then + lres=.true. + else + lres=.false. + endif + return + + end function do_soilevap_beta + +end module SurfaceResistanceMod diff --git a/components/clm/src/biogeophys/TemperatureType.F90 b/components/clm/src/biogeophys/TemperatureType.F90 new file mode 100644 index 0000000000..a1998fcea9 --- /dev/null +++ b/components/clm/src/biogeophys/TemperatureType.F90 @@ -0,0 +1,1457 @@ +module TemperatureType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : use_ed, use_cndv, iulog ,use_luna + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevlak, nlevurb, crop_prog + use clm_varcon , only : spval, ispval + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + save + private + ! + type, public :: temperature_type + + ! Temperatures + real(r8), pointer :: t_veg_patch (:) ! patch vegetation temperature (Kelvin) + real(r8), pointer :: t_veg_day_patch (:) ! patch daytime accumulative vegetation temperature (Kelvinx*nsteps), LUNA specific, from midnight to current step + real(r8), pointer :: t_veg_night_patch (:) ! patch night-time accumulative vegetation temperature (Kelvin*nsteps), LUNA specific, from midnight to current step + real(r8), pointer :: t_veg10_day_patch (:) ! 10 day running mean of patch daytime time vegetation temperature (Kelvin), LUNA specific, but can be reused + real(r8), pointer :: t_veg10_night_patch (:) ! 10 day running mean of patch night time vegetation temperature (Kelvin), LUNA specific, but can be reused + integer, pointer :: ndaysteps_patch (:) ! number of daytime steps accumulated from mid-night, LUNA specific + integer, pointer :: nnightsteps_patch (:) ! number of nighttime steps accumulated from mid-night, LUNA specific + real(r8), pointer :: t_h2osfc_col (:) ! col surface water temperature + real(r8), pointer :: t_h2osfc_bef_col (:) ! col surface water temperature from time-step before + real(r8), pointer :: t_ssbef_col (:,:) ! col soil/snow temperature before update (-nlevsno+1:nlevgrnd) + real(r8), pointer :: t_soisno_col (:,:) ! col soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: t_soi10cm_col (:) ! col soil temperature in top 10cm of soil (Kelvin) + real(r8), pointer :: t_soi17cm_col (:) ! col soil temperature in top 17cm of soil (Kelvin) + real(r8), pointer :: t_lake_col (:,:) ! col lake temperature (Kelvin) (1:nlevlak) + real(r8), pointer :: t_grnd_col (:) ! col ground temperature (Kelvin) + real(r8), pointer :: t_grnd_r_col (:) ! col rural ground temperature (Kelvin) + real(r8), pointer :: t_grnd_u_col (:) ! col urban ground temperature (Kelvin) (needed by Hydrology2Mod) + real(r8), pointer :: t_building_lun (:) ! lun internal building air temperature (K) + real(r8), pointer :: t_roof_inner_lun (:) ! lun roof inside surface temperature (K) + real(r8), pointer :: t_sunw_inner_lun (:) ! lun sunwall inside surface temperature (K) + real(r8), pointer :: t_shdw_inner_lun (:) ! lun shadewall inside surface temperature (K) + real(r8), pointer :: t_floor_lun (:) ! lun floor temperature (K) + real(r8), pointer :: snot_top_col (:) ! col temperature of top snow layer [K] + real(r8), pointer :: dTdz_top_col (:) ! col temperature gradient in top layer [K m-1] + real(r8), pointer :: dt_veg_patch (:) ! patch change in t_veg, last iteration (Kelvin) + + real(r8), pointer :: dt_grnd_col (:) ! col change in t_grnd, last iteration (Kelvin) + real(r8), pointer :: thv_col (:) ! col virtual potential temperature (kelvin) + real(r8), pointer :: thm_patch (:) ! patch intermediate variable (forc_t+0.0098*forc_hgt_t_patch) + real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature + real(r8), pointer :: t_a5min_patch (:) ! patch 5-day running mean of min 2-m temperature + + real(r8), pointer :: taf_lun (:) ! lun urban canopy air temperature (K) + + real(r8), pointer :: t_ref2m_patch (:) ! patch 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_r_patch (:) ! patch rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_u_patch (:) ! patch urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_min_patch (:) ! patch daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_r_patch (:) ! patch daily minimum of average 2 m height surface air temperature - rural(K) + real(r8), pointer :: t_ref2m_min_u_patch (:) ! patch daily minimum of average 2 m height surface air temperature - urban (K) + real(r8), pointer :: t_ref2m_max_patch (:) ! patch daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_r_patch (:) ! patch daily maximum of average 2 m height surface air temperature - rural(K) + real(r8), pointer :: t_ref2m_max_u_patch (:) ! patch daily maximum of average 2 m height surface air temperature - urban (K) + real(r8), pointer :: t_ref2m_min_inst_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_inst_r_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - rural (K) + real(r8), pointer :: t_ref2m_min_inst_u_patch (:) ! patch instantaneous daily min of average 2 m height surface air temp - urban (K) + real(r8), pointer :: t_ref2m_max_inst_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_r_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - rural (K) + real(r8), pointer :: t_ref2m_max_inst_u_patch (:) ! patch instantaneous daily max of average 2 m height surface air temp - urban (K) + + ! Accumulated quantities + ! + ! TODO(wjs, 2014-08-05) Move these to the module(s) where they are used, to improve + ! modularity. In cases where they are used by two completely different modules, + ! which only use the same variable out of convenience, introduce a duplicate (point + ! being: that way one parameterization is free to change the exact meaning of its + ! accumulator without affecting the other). + ! + real(r8), pointer :: t_veg24_patch (:) ! patch 24hr average vegetation temperature (K) + real(r8), pointer :: t_veg240_patch (:) ! patch 240hr average vegetation temperature (Kelvin) + real(r8), pointer :: gdd0_patch (:) ! patch growing degree-days base 0C from planting (ddays) + real(r8), pointer :: gdd8_patch (:) ! patch growing degree-days base 8C from planting (ddays) + real(r8), pointer :: gdd10_patch (:) ! patch growing degree-days base 10C from planting (ddays) + real(r8), pointer :: gdd020_patch (:) ! patch 20-year average of gdd0 (ddays) + real(r8), pointer :: gdd820_patch (:) ! patch 20-year average of gdd8 (ddays) + real(r8), pointer :: gdd1020_patch (:) ! patch 20-year average of gdd10 (ddays) + + ! Heat content + real(r8), pointer :: beta_col (:) ! coefficient of convective velocity [-] + real(r8), pointer :: hc_soi_col (:) ! col soil heat content (MJ/m2) + real(r8), pointer :: hc_soisno_col (:) ! col soil plus snow heat content (MJ/m2) + real(r8), pointer :: heat1_grc (:) ! grc initial gridcell total heat content + real(r8), pointer :: heat2_grc (:) ! grc post land cover change total heat content + + ! Flags + integer , pointer :: imelt_col (:,:) ! flag for melting (=1), freezing (=2), Not=0 (-nlevsno+1:nlevgrnd) + + ! Emissivities + real(r8), pointer :: emv_patch (:) ! patch vegetation emissivity + real(r8), pointer :: emg_col (:) ! col ground emissivity + + ! Misc + real(r8), pointer :: xmf_col (:) ! total latent heat of phase change of ground water + real(r8), pointer :: xmf_h2osfc_col (:) ! latent heat of phase change of surface water + real(r8), pointer :: fact_col (:,:) ! used in computing tridiagonal matrix + real(r8), pointer :: c_h2osfc_col (:) ! heat capacity of surface water + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars + + end type temperature_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, & + em_roof_lun, em_wall_lun, em_improad_lun, em_perroad_lun, & + is_simple_buildtemp, is_prog_buildtemp) + ! + ! !DESCRIPTION: + ! + ! Initialization of the data type. Allocate data, setup variables + ! for history output, and initialize values needed for a cold-start. + ! + class(temperature_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: em_roof_lun(bounds%begl:) + real(r8) , intent(in) :: em_wall_lun(bounds%begl:) + real(r8) , intent(in) :: em_improad_lun(bounds%begl:) + real(r8) , intent(in) :: em_perroad_lun(bounds%begl:) + logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used + logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used + + call this%InitAllocate ( bounds ) + call this%InitHistory ( bounds, is_simple_buildtemp, is_prog_buildtemp ) + call this%InitCold ( bounds, & + em_roof_lun(bounds%begl:bounds%endl), & + em_wall_lun(bounds%begl:bounds%endl), & + em_improad_lun(bounds%begl:bounds%endl), & + em_perroad_lun(bounds%begl:bounds%endl), & + is_simple_buildtemp, is_prog_buildtemp) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize and allocate data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + begg = bounds%begg; endg= bounds%endg + + ! Temperatures + allocate(this%t_veg_patch (begp:endp)) ; this%t_veg_patch (:) = nan + if(use_luna) then + allocate(this%t_veg_day_patch (begp:endp)) ; this%t_veg_day_patch (:) = spval + allocate(this%t_veg_night_patch (begp:endp)) ; this%t_veg_night_patch (:) = spval + allocate(this%t_veg10_day_patch (begp:endp)) ; this%t_veg10_day_patch (:) = spval + allocate(this%t_veg10_night_patch (begp:endp)) ; this%t_veg10_night_patch (:) = spval + allocate(this%ndaysteps_patch (begp:endp)) ; this%ndaysteps_patch (:) = ispval + allocate(this%nnightsteps_patch (begp:endp)) ; this%nnightsteps_patch (:) = ispval + endif + allocate(this%t_h2osfc_col (begc:endc)) ; this%t_h2osfc_col (:) = nan + allocate(this%t_h2osfc_bef_col (begc:endc)) ; this%t_h2osfc_bef_col (:) = nan + allocate(this%t_ssbef_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%t_ssbef_col (:,:) = nan + allocate(this%t_soisno_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%t_soisno_col (:,:) = nan + allocate(this%t_lake_col (begc:endc,1:nlevlak)) ; this%t_lake_col (:,:) = nan + allocate(this%t_grnd_col (begc:endc)) ; this%t_grnd_col (:) = nan + allocate(this%t_grnd_r_col (begc:endc)) ; this%t_grnd_r_col (:) = nan + allocate(this%t_grnd_u_col (begc:endc)) ; this%t_grnd_u_col (:) = nan + allocate(this%t_building_lun (begl:endl)) ; this%t_building_lun (:) = nan + allocate(this%t_roof_inner_lun (begl:endl)) ; this%t_roof_inner_lun (:) = nan + allocate(this%t_sunw_inner_lun (begl:endl)) ; this%t_sunw_inner_lun (:) = nan + allocate(this%t_shdw_inner_lun (begl:endl)) ; this%t_shdw_inner_lun (:) = nan + allocate(this%t_floor_lun (begl:endl)) ; this%t_floor_lun (:) = nan + allocate(this%snot_top_col (begc:endc)) ; this%snot_top_col (:) = nan + allocate(this%dTdz_top_col (begc:endc)) ; this%dTdz_top_col (:) = nan + allocate(this%dt_veg_patch (begp:endp)) ; this%dt_veg_patch (:) = nan + + allocate(this%t_soi10cm_col (begc:endc)) ; this%t_soi10cm_col (:) = nan + allocate(this%t_soi17cm_col (begc:endc)) ; this%t_soi17cm_col (:) = spval + allocate(this%dt_grnd_col (begc:endc)) ; this%dt_grnd_col (:) = nan + allocate(this%thv_col (begc:endc)) ; this%thv_col (:) = nan + allocate(this%thm_patch (begp:endp)) ; this%thm_patch (:) = nan + allocate(this%t_a10_patch (begp:endp)) ; this%t_a10_patch (:) = nan + allocate(this%t_a10min_patch (begp:endp)) ; this%t_a10min_patch (:) = nan + allocate(this%t_a5min_patch (begp:endp)) ; this%t_a5min_patch (:) = nan + + allocate(this%taf_lun (begl:endl)) ; this%taf_lun (:) = nan + + allocate(this%t_ref2m_patch (begp:endp)) ; this%t_ref2m_patch (:) = nan + allocate(this%t_ref2m_r_patch (begp:endp)) ; this%t_ref2m_r_patch (:) = nan + allocate(this%t_ref2m_u_patch (begp:endp)) ; this%t_ref2m_u_patch (:) = nan + allocate(this%t_ref2m_min_patch (begp:endp)) ; this%t_ref2m_min_patch (:) = nan + allocate(this%t_ref2m_min_r_patch (begp:endp)) ; this%t_ref2m_min_r_patch (:) = nan + allocate(this%t_ref2m_min_u_patch (begp:endp)) ; this%t_ref2m_min_u_patch (:) = nan + allocate(this%t_ref2m_max_patch (begp:endp)) ; this%t_ref2m_max_patch (:) = nan + allocate(this%t_ref2m_max_r_patch (begp:endp)) ; this%t_ref2m_max_r_patch (:) = nan + allocate(this%t_ref2m_max_u_patch (begp:endp)) ; this%t_ref2m_max_u_patch (:) = nan + allocate(this%t_ref2m_max_inst_patch (begp:endp)) ; this%t_ref2m_max_inst_patch (:) = nan + allocate(this%t_ref2m_max_inst_r_patch (begp:endp)) ; this%t_ref2m_max_inst_r_patch (:) = nan + allocate(this%t_ref2m_max_inst_u_patch (begp:endp)) ; this%t_ref2m_max_inst_u_patch (:) = nan + allocate(this%t_ref2m_min_inst_patch (begp:endp)) ; this%t_ref2m_min_inst_patch (:) = nan + allocate(this%t_ref2m_min_inst_r_patch (begp:endp)) ; this%t_ref2m_min_inst_r_patch (:) = nan + allocate(this%t_ref2m_min_inst_u_patch (begp:endp)) ; this%t_ref2m_min_inst_u_patch (:) = nan + + ! Accumulated fields + allocate(this%t_veg24_patch (begp:endp)) ; this%t_veg24_patch (:) = nan + allocate(this%t_veg240_patch (begp:endp)) ; this%t_veg240_patch (:) = nan + allocate(this%gdd0_patch (begp:endp)) ; this%gdd0_patch (:) = spval + allocate(this%gdd8_patch (begp:endp)) ; this%gdd8_patch (:) = spval + allocate(this%gdd10_patch (begp:endp)) ; this%gdd10_patch (:) = spval + allocate(this%gdd020_patch (begp:endp)) ; this%gdd020_patch (:) = spval + allocate(this%gdd820_patch (begp:endp)) ; this%gdd820_patch (:) = spval + allocate(this%gdd1020_patch (begp:endp)) ; this%gdd1020_patch (:) = spval + + ! Heat content + allocate(this%beta_col (begc:endc)) ; this%beta_col (:) = nan + allocate(this%hc_soi_col (begc:endc)) ; this%hc_soi_col (:) = nan + allocate(this%hc_soisno_col (begc:endc)) ; this%hc_soisno_col (:) = nan + allocate(this%heat1_grc (begg:endg)) ; this%heat1_grc (:) = nan + allocate(this%heat2_grc (begg:endg)) ; this%heat2_grc (:) = nan + + ! flags + allocate(this%imelt_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%imelt_col (:,:) = huge(1) + + ! emissivities + allocate(this%emv_patch (begp:endp)) ; this%emv_patch (:) = nan + allocate(this%emg_col (begc:endc)) ; this%emg_col (:) = nan + + allocate(this%xmf_col (begc:endc)) ; this%xmf_col (:) = nan + allocate(this%xmf_h2osfc_col (begc:endc)) ; this%xmf_h2osfc_col (:) = nan + allocate(this%fact_col (begc:endc, -nlevsno+1:nlevgrnd)) ; this%fact_col (:,:) = nan + allocate(this%c_h2osfc_col (begc:endc)) ; this%c_h2osfc_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) + ! + ! !DESCRIPTION: + ! Setup the fields that can be output on history files. + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varctl , only : use_cn, use_cndv + use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type), intent(in) :: bounds + logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used + logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + character(10) :: active + character(100) :: lname + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + begg = bounds%begg; endg= bounds%endg + + this%t_h2osfc_col(begc:endc) = spval + call hist_addfld1d (fname='TH2OSFC', units='K', & + avgflag='A', long_name='surface water temperature', & + ptr_col=this%t_h2osfc_col) + + this%t_grnd_u_col(begc:endc) = spval + call hist_addfld1d (fname='TG_U', units='K', & + avgflag='A', long_name='Urban ground temperature', & + ptr_col=this%t_grnd_u_col, set_nourb=spval, c2l_scale_type='urbans') + + this%t_lake_col(begc:endc,:) = spval + call hist_addfld2d (fname='TLAKE', units='K', type2d='levlak', & + avgflag='A', long_name='lake temperature', & + ptr_col=this%t_lake_col) + + this%t_soisno_col(begc:endc,-nlevsno+1:0) = spval + data2dptr => this%t_soisno_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_T', units='K', type2d='levsno', & + avgflag='A', long_name='Snow temperatures', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%t_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='TSA', units='K', & + avgflag='A', long_name='2m air temperature', & + ptr_patch=this%t_ref2m_patch) + + this%t_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='TSA_R', units='K', & + avgflag='A', long_name='Rural 2m air temperature', & + ptr_patch=this%t_ref2m_r_patch, set_spec=spval) + + this%t_ref2m_min_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMNAV', units='K', & + avgflag='A', long_name='daily minimum of average 2-m temperature', & + ptr_patch=this%t_ref2m_min_patch) + + this%t_ref2m_max_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMXAV', units='K', & + avgflag='A', long_name='daily maximum of average 2-m temperature', & + ptr_patch=this%t_ref2m_max_patch) + + this%t_ref2m_min_r_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMNAV_R', units='K', & + avgflag='A', long_name='Rural daily minimum of average 2-m temperature', & + ptr_patch=this%t_ref2m_min_r_patch, set_spec=spval) + + this%t_ref2m_max_r_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMXAV_R', units='K', & + avgflag='A', long_name='Rural daily maximum of average 2-m temperature', & + ptr_patch=this%t_ref2m_max_r_patch, set_spec=spval) + + this%t_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='TSA_U', units='K', & + avgflag='A', long_name='Urban 2m air temperature', & + ptr_patch=this%t_ref2m_u_patch, set_nourb=spval) + + this%t_ref2m_min_u_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMNAV_U', units='K', & + avgflag='A', long_name='Urban daily minimum of average 2-m temperature', & + ptr_patch=this%t_ref2m_min_u_patch, set_nourb=spval) + + this%t_ref2m_max_u_patch(begp:endp) = spval + call hist_addfld1d (fname='TREFMXAV_U', units='K', & + avgflag='A', long_name='Urban daily maximum of average 2-m temperature', & + ptr_patch=this%t_ref2m_max_u_patch, set_nourb=spval) + + this%t_veg_patch(begp:endp) = spval + call hist_addfld1d (fname='TV', units='K', & + avgflag='A', long_name='vegetation temperature', & + ptr_patch=this%t_veg_patch) + + this%t_grnd_col(begc:endc) = spval + call hist_addfld1d (fname='TG', units='K', & + avgflag='A', long_name='ground temperature', & + ptr_col=this%t_grnd_col, c2l_scale_type='urbans') + + this%t_grnd_r_col(begc:endc) = spval + call hist_addfld1d (fname='TG_R', units='K', & + avgflag='A', long_name='Rural ground temperature', & + ptr_col=this%t_grnd_r_col, set_spec=spval) + + this%t_soisno_col(begc:endc,:) = spval + call hist_addfld2d (fname='TSOI', units='K', type2d='levgrnd', & + avgflag='A', long_name='soil temperature (vegetated landunits only)', & + ptr_col=this%t_soisno_col, l2g_scale_type='veg') + + this%t_soisno_col(begc:endc,:) = spval + call hist_addfld2d (fname='TSOI_ICE', units='K', type2d='levgrnd', & + avgflag='A', long_name='soil temperature (ice landunits only)', & + ptr_col=this%t_soisno_col, l2g_scale_type='ice') + + this%t_soi10cm_col(begc:endc) = spval + call hist_addfld1d (fname='TSOI_10CM', units='K', & + avgflag='A', long_name='soil temperature in top 10cm of soil', & + ptr_col=this%t_soi10cm_col, set_urb=spval) + + if (use_cndv .or. crop_prog) then + active = "active" + else + active = "inactive" + end if + this%t_a10_patch(begp:endp) = spval + call hist_addfld1d (fname='T10', units='K', & + avgflag='A', long_name='10-day running mean of 2-m temperature', & + ptr_patch=this%t_a10_patch, default=active) + + if (use_cn .and. crop_prog )then + this%t_a5min_patch(begp:endp) = spval + call hist_addfld1d (fname='A5TMIN', units='K', & + avgflag='A', long_name='5-day running mean of min 2-m temperature', & + ptr_patch=this%t_a5min_patch, default='inactive') + end if + + if (use_cn .and. crop_prog )then + this%t_a10min_patch(begp:endp) = spval + call hist_addfld1d (fname='A10TMIN', units='K', & + avgflag='A', long_name='10-day running mean of min 2-m temperature', & + ptr_patch=this%t_a10min_patch, default='inactive') + end if + + this%t_building_lun(begl:endl) = spval + if ( is_simple_buildtemp )then + lname = 'internal urban building temperature' + else if ( is_prog_buildtemp )then + lname = 'internal urban building air temperature' + end if + call hist_addfld1d(fname='TBUILD', units='K', & + avgflag='A', long_name=lname, & + ptr_lunit=this%t_building_lun, set_nourb=spval, l2g_scale_type='unity') + + if ( is_prog_buildtemp )then + this%t_roof_inner_lun(begl:endl) = spval + call hist_addfld1d(fname='TROOF_INNER', units='K', & + avgflag='A', long_name='roof inside surface temperature', & + ptr_lunit=this%t_roof_inner_lun, set_nourb=spval, l2g_scale_type='unity') + + this%t_sunw_inner_lun(begl:endl) = spval + call hist_addfld1d(fname='TSUNW_INNER', units='K', & + avgflag='A', long_name='sunwall inside surface temperature', & + ptr_lunit=this%t_sunw_inner_lun, set_nourb=spval, l2g_scale_type='unity') + + this%t_shdw_inner_lun(begl:endl) = spval + call hist_addfld1d(fname='TSHDW_INNER', units='K', & + avgflag='A', long_name='shadewall inside surface temperature', & + ptr_lunit=this%t_shdw_inner_lun, set_nourb=spval, l2g_scale_type='unity') + + this%t_floor_lun(begl:endl) = spval + call hist_addfld1d(fname='TFLOOR', units='K', & + avgflag='A', long_name='floor temperature', & + ptr_lunit=this%t_floor_lun, set_nourb=spval, l2g_scale_type='unity') + end if + + this%hc_soi_col(begc:endc) = spval + call hist_addfld1d (fname='HCSOI', units='MJ/m2', & + avgflag='A', long_name='soil heat content', & + ptr_col=this%hc_soi_col, set_lake=spval, set_urb=spval, l2g_scale_type='veg') + + this%hc_soisno_col(begc:endc) = spval + call hist_addfld1d (fname='HC', units='MJ/m2', & + avgflag='A', long_name='heat content of soil/snow/lake', & + ptr_col=this%hc_soisno_col, set_urb=spval) + + this%heat1_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_HEAT1', units='J/m^2', & + avgflag='A', long_name='initial gridcell total heat content', & + ptr_lnd=this%heat1_grc) + + this%heat2_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_HEAT2', units='J/m^2', & + avgflag='A', long_name='post land cover change total heat content', & + ptr_lnd=this%heat2_grc, default='inactive') + + this%snot_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNOTTOPL', units='K/m', & + avgflag='A', long_name='snow temperature (top layer)', & + ptr_col=this%snot_top_col, set_urb=spval, default='inactive') + + this%dTdz_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNOdTdzL', units='K/m', & + avgflag='A', long_name='top snow layer temperature gradient (land)', & + ptr_col=this%dTdz_top_col, set_urb=spval, default='inactive') + + if (use_cn) then + this%dt_veg_patch(begp:endp) = spval + call hist_addfld1d (fname='DT_VEG', units='K', & + avgflag='A', long_name='change in t_veg, last iteration', & + ptr_patch=this%dt_veg_patch, default='inactive') + end if + + if (use_cn ) then + this%emv_patch(begp:endp) = spval + call hist_addfld1d (fname='EMV', units='proportion', & + avgflag='A', long_name='vegetation emissivity', & + ptr_patch=this%emv_patch, default='inactive') + end if + + if (use_cn) then + this%emg_col(begc:endc) = spval + call hist_addfld1d (fname='EMG', units='proportion', & + avgflag='A', long_name='ground emissivity', & + ptr_col=this%emg_col, default='inactive') + end if + + if (use_cn) then + this%beta_col(begc:endc) = spval + call hist_addfld1d (fname='BETA', units='none', & + avgflag='A', long_name='coefficient of convective velocity', & + ptr_col=this%beta_col, default='inactive') + end if + + ! Accumulated quantities + + this%t_veg24_patch(begp:endp) = spval + call hist_addfld1d (fname='TV24', units='K', & + avgflag='A', long_name='vegetation temperature (last 24hrs)', & + ptr_patch=this%t_veg24_patch, default='inactive') + + this%t_veg240_patch(begp:endp) = spval + call hist_addfld1d (fname='TV240', units='K', & + avgflag='A', long_name='vegetation temperature (last 240hrs)', & + ptr_patch=this%t_veg240_patch, default='inactive') + + if (crop_prog) then + this%gdd0_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD0', units='ddays', & + avgflag='A', long_name='Growing degree days base 0C from planting', & + ptr_patch=this%gdd0_patch, default='inactive') + end if + + if (crop_prog) then + this%gdd8_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD8', units='ddays', & + avgflag='A', long_name='Growing degree days base 8C from planting', & + ptr_patch=this%gdd8_patch, default='inactive') + + this%gdd10_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD10', units='ddays', & + avgflag='A', long_name='Growing degree days base 10C from planting', & + ptr_patch=this%gdd10_patch, default='inactive') + + this%gdd020_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD020', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 0C from planting', & + ptr_patch=this%gdd020_patch, default='inactive') + + this%gdd820_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD820', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 8C from planting', & + ptr_patch=this%gdd820_patch, default='inactive') + + this%gdd1020_patch(begp:endp) = spval + call hist_addfld1d (fname='GDD1020', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 10C from planting', & + ptr_patch=this%gdd1020_patch, default='inactive') + + end if + if(use_luna)then + call hist_addfld1d (fname='TVEGD10', units='Kelvin', & + avgflag='A', long_name='10 day running mean of patch daytime vegetation temperature', & + ptr_patch=this%t_veg10_day_patch, default='inactive') + call hist_addfld1d (fname='TVEGN10', units='Kelvin', & + avgflag='A', long_name='10 day running mean of patch night-time vegetation temperature', & + ptr_patch=this%t_veg10_night_patch, default='inactive') + endif + + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, & + em_roof_lun, em_wall_lun, em_improad_lun, em_perroad_lun, & + is_simple_buildtemp, is_prog_buildtemp) + ! + ! !DESCRIPTION: + ! Initialize cold start conditions for module variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varcon , only : denice, denh2o, sb + use landunit_varcon, only : istice, istwet, istsoil, istdlak, istice_mec + use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall + use column_varcon , only : icol_shadewall, icol_road_perv + use clm_varctl , only : iulog, use_vancouver, use_mexicocity + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: em_roof_lun(bounds%begl:) + real(r8) , intent(in) :: em_wall_lun(bounds%begl:) + real(r8) , intent(in) :: em_improad_lun(bounds%begl:) + real(r8) , intent(in) :: em_perroad_lun(bounds%begl:) + logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used + logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used + ! + ! !LOCAL VARIABLES: + integer :: j,l,c,p ! indices + integer :: nlevs ! number of levels + real(r8) :: snowbd ! temporary calculation of snow bulk density (kg/m3) + real(r8) :: fmelt ! snowbd/100 + integer :: lev + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(em_roof_lun) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_wall_lun) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_improad_lun) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_perroad_lun) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + associate(snl => col%snl) ! Output: [integer (:) ] number of snow layers + + ! Set snow/soil temperature + ! t_lake only has valid values over non-lake + ! t_soisno, t_grnd and t_veg have valid values over all land + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + this%t_soisno_col(c,-nlevsno+1:nlevgrnd) = spval + + ! Snow level temperatures - all land points + if (snl(c) < 0) then + do j = snl(c)+1, 0 + this%t_soisno_col(c,j) = 250._r8 + end do + end if + + ! Below snow temperatures - nonlake points (lake points are set below) + if (.not. lun%lakpoi(l)) then + + if (lun%itype(l)==istice .or. lun%itype(l)==istice_mec) then + this%t_soisno_col(c,1:nlevgrnd) = 250._r8 + + else if (lun%itype(l) == istwet) then + this%t_soisno_col(c,1:nlevgrnd) = 277._r8 + + else if (lun%urbpoi(l)) then + if (use_vancouver) then + if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + ! Set road top layer to initial air temperature and interpolate other + ! layers down to 20C in bottom layer + do j = 1, nlevgrnd + this%t_soisno_col(c,j) = 297.56 - (j-1) * ((297.56-293.16)/(nlevgrnd-1)) + end do + ! Set wall and roof layers to initial air temperature + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_roof) then + this%t_soisno_col(c,1:nlevurb) = 297.56 + else + this%t_soisno_col(c,1:nlevgrnd) = 283._r8 + end if + else if (use_mexicocity) then + if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + ! Set road top layer to initial air temperature and interpolate other + ! layers down to 22C in bottom layer + do j = 1, nlevgrnd + this%t_soisno_col(c,j) = 289.46 - (j-1) * ((289.46-295.16)/(nlevgrnd-1)) + end do + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. col%itype(c) == icol_roof) then + ! Set wall and roof layers to initial air temperature + this%t_soisno_col(c,1:nlevurb) = 289.46 + else + this%t_soisno_col(c,1:nlevgrnd) = 283._r8 + end if + else + if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + this%t_soisno_col(c,1:nlevgrnd) = 274._r8 + else if (col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall & + .or. col%itype(c) == icol_roof) then + ! Set sunwall, shadewall, roof to fairly high temperature to avoid initialization + ! shock from large heating/air conditioning flux + this%t_soisno_col(c,1:nlevurb) = 292._r8 + end if + end if + else + this%t_soisno_col(c,1:nlevgrnd) = 274._r8 + + endif + endif + end do + + ! Initialize internal building temperature, inner temperatures of building + ! surfaces, and floor temperature + if ( is_prog_buildtemp )then + do l = bounds%begl, bounds%endl + do c = lun%coli(l),lun%colf(l) + if (col%itype(c) == icol_roof) then + this%t_roof_inner_lun(l) = this%t_soisno_col(c,nlevurb) + this%t_building_lun(l) = this%t_soisno_col(c,nlevurb) ! arbitrarily set to roof temperature + this%t_floor_lun(l) = this%t_soisno_col(c,nlevurb) ! arbitrarily set to roof temperature + else if (col%itype(c) == icol_sunwall) then + this%t_sunw_inner_lun(l) = this%t_soisno_col(c,nlevurb) + else if (col%itype(c) == icol_shadewall) then + this%t_shdw_inner_lun(l) = this%t_soisno_col(c,nlevurb) + end if + end do + end do + end if + + ! Set Ground temperatures + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + if (lun%lakpoi(l)) then + this%t_grnd_col(c) = 277._r8 + else + this%t_grnd_col(c) = this%t_soisno_col(c,snl(c)+1) + end if + this%t_soi17cm_col(c) = this%t_grnd_col(c) + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%lakpoi(l)) then ! lake + this%t_lake_col(c,1:nlevlak) = this%t_grnd_col(c) + this%t_soisno_col(c,1:nlevgrnd) = this%t_grnd_col(c) + end if + end do + + ! Set t_h2osfc_col + + this%t_h2osfc_col(bounds%begc:bounds%endc) = 274._r8 + + ! Set t_veg, t_ref2m, t_ref2m_u and tref2m_r + + do p = bounds%begp, bounds%endp + c = patch%column(p) + l = patch%landunit(p) + + if (use_vancouver) then + this%t_veg_patch(p) = 297.56 + else if (use_mexicocity) then + this%t_veg_patch(p) = 289.46 + else + this%t_veg_patch(p) = 283._r8 + end if + + if (use_vancouver) then + this%t_ref2m_patch(p) = 297.56 + else if (use_mexicocity) then + this%t_ref2m_patch(p) = 289.46 + else + this%t_ref2m_patch(p) = 283._r8 + end if + + if (lun%urbpoi(l)) then + if (use_vancouver) then + this%t_ref2m_u_patch(p) = 297.56 + else if (use_mexicocity) then + this%t_ref2m_u_patch(p) = 289.46 + else + this%t_ref2m_u_patch(p) = 283._r8 + end if + else + if (.not. lun%ifspecial(l)) then + if (use_vancouver) then + this%t_ref2m_r_patch(p) = 297.56 + else if (use_mexicocity) then + this%t_ref2m_r_patch(p) = 289.46 + else + this%t_ref2m_r_patch(p) = 283._r8 + end if + else + this%t_ref2m_r_patch(p) = spval + end if + end if + + end do + + end associate + + do l = bounds%begl, bounds%endl + if (lun%urbpoi(l)) then + if (use_vancouver) then + this%taf_lun(l) = 297.56_r8 + else if (use_mexicocity) then + this%taf_lun(l) = 289.46_r8 + else + this%taf_lun(l) = 283._r8 + end if + end if + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + if (col%itype(c) == icol_roof ) this%emg_col(c) = em_roof_lun(l) + if (col%itype(c) == icol_sunwall ) this%emg_col(c) = em_wall_lun(l) + if (col%itype(c) == icol_shadewall ) this%emg_col(c) = em_wall_lun(l) + if (col%itype(c) == icol_road_imperv) this%emg_col(c) = em_improad_lun(l) + if (col%itype(c) == icol_road_perv ) this%emg_col(c) = em_perroad_lun(l) + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, is_simple_buildtemp, is_prog_buildtemp) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + logical , intent(in) :: is_simple_buildtemp ! Simple building temp is being used + logical , intent(in) :: is_prog_buildtemp ! Prognostic building temp is being used + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='T_SOISNO', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='soil-snow temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_soisno_col) + + call restartvar(ncid=ncid, flag=flag, varname='T_VEG', xtype=ncd_double, & + dim1name='pft', & + long_name='vegetation temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_veg_patch) + + call restartvar(ncid=ncid, flag=flag, varname='TH2OSFC', xtype=ncd_double, & + dim1name='column', & + long_name='surface water temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_h2osfc_col) + if (flag=='read' .and. .not. readvar) then + this%t_h2osfc_col(bounds%begc:bounds%endc) = 274.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='T_LAKE', xtype=ncd_double, & + dim1name='column', dim2name='levlak', switchdim=.true., & + long_name='lake temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_lake_col) + + call restartvar(ncid=ncid, flag=flag, varname='T_GRND', xtype=ncd_double, & + dim1name='column', & + long_name='ground temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_grnd_col) + + call restartvar(ncid=ncid, flag=flag, varname='T_GRND_R', xtype=ncd_double, & + dim1name='column', & + long_name='rural ground temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_grnd_r_col) + + call restartvar(ncid=ncid, flag=flag, varname='T_GRND_U', xtype=ncd_double, & + dim1name='column', & + long_name='urban ground temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_grnd_u_col) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M', xtype=ncd_double, & + dim1name='pft', & + long_name='2m height surface air temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_patch) + if (flag=='read' .and. .not. readvar) call endrun(msg=errMsg(__FILE__, __LINE__)) + + call restartvar(ncid=ncid, flag=flag, varname="T_REF2M_R", xtype=ncd_double, & + dim1name='pft', & + long_name='Rural 2m height surface air temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_r_patch) + + call restartvar(ncid=ncid, flag=flag, varname="T_REF2M_U", xtype=ncd_double, dim1name='pft', & + long_name='Urban 2m height surface air temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_u_patch) + + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN', xtype=ncd_double, & + dim1name='pft', & + long_name='daily minimum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural daily minimum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_r_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_U', xtype=ncd_double, dim1name='pft', & + long_name='urban daily minimum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_u_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX', xtype=ncd_double, & + dim1name='pft', & + long_name='daily maximum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural daily maximum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_r_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_U', xtype=ncd_double, dim1name='pft', & + long_name='urban daily maximum of average 2 m height surface air temperature (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_u_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST', xtype=ncd_double, & + dim1name='pft', & + long_name='instantaneous daily min of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural instantaneous daily min of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_r_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MIN_INST_U', xtype=ncd_double, dim1name='pft', & + long_name='urban instantaneous daily min of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_min_inst_u_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST', xtype=ncd_double, & + dim1name='pft', & + long_name='instantaneous daily max of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural instantaneous daily max of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_r_patch) + + call restartvar(ncid=ncid, flag=flag, varname='T_REF2M_MAX_INST_U', xtype=ncd_double, dim1name='pft', & + long_name='urban instantaneous daily max of average 2 m height surface air temp (K)', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_ref2m_max_inst_u_patch) + + call restartvar(ncid=ncid, flag=flag, varname='taf', xtype=ncd_double, dim1name='landunit', & + long_name='urban canopy air temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%taf_lun) + + if (crop_prog) then + call restartvar(ncid=ncid, flag=flag, varname='gdd1020', xtype=ncd_double, & + dim1name='pft', long_name='20 year average of growing degree-days base 10C from planting', units='ddays', & + interpinic_flag='interp', readvar=readvar, data=this%gdd1020_patch) + + call restartvar(ncid=ncid, flag=flag, varname='gdd820', xtype=ncd_double, & + dim1name='pft', long_name='20 year average of growing degree-days base 8C from planting', units='ddays', & + interpinic_flag='interp', readvar=readvar, data=this%gdd820_patch) + + call restartvar(ncid=ncid, flag=flag, varname='gdd020', xtype=ncd_double, & + dim1name='pft', long_name='20 year average of growing degree-days base 0C from planting', units='ddays', & + interpinic_flag='interp', readvar=readvar, data=this%gdd020_patch) + end if + + if(use_luna)then + call restartvar(ncid=ncid, flag=flag, varname='tvegd10', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean daytime vegetation temperature', units='Kelvin', & + interpinic_flag='interp', readvar=readvar, data=this%t_veg10_day_patch ) + call restartvar(ncid=ncid, flag=flag, varname='tvegd', xtype=ncd_double, & + dim1name='pft', long_name='accumulative daytime vegetation temperature', units='Kelvin*steps', & + interpinic_flag='interp', readvar=readvar, data=this%t_veg_day_patch ) + call restartvar(ncid=ncid, flag=flag, varname='tvegn10', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean nighttime vegetation temperature', units='Kelvin', & + interpinic_flag='interp', readvar=readvar, data=this%t_veg10_night_patch ) + call restartvar(ncid=ncid, flag=flag, varname='tvegn', xtype=ncd_double, & + dim1name='pft', long_name='accumulative nighttime vegetation temperature', units='Kelvin*steps', & + interpinic_flag='interp', readvar=readvar, data=this%t_veg_night_patch ) + call restartvar(ncid=ncid, flag=flag, varname='tair10', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean air temperature', units='Kelvin', & + interpinic_flag='interp', readvar=readvar, data=this%t_a10_patch ) + call restartvar(ncid=ncid, flag=flag, varname='ndaysteps', xtype=ncd_double, & + dim1name='pft', long_name='accumulative daytime steps', units='steps', & + interpinic_flag='interp', readvar=readvar, data=this%ndaysteps_patch ) + call restartvar(ncid=ncid, flag=flag, varname='nnightsteps', xtype=ncd_double, & + dim1name='pft', long_name='accumulative nighttime steps', units='steps', & + interpinic_flag='interp', readvar=readvar, data=this%nnightsteps_patch ) + endif + + if ( is_prog_buildtemp )then + ! landunit type physical state variable - t_building + call restartvar(ncid=ncid, flag=flag, varname='t_building', xtype=ncd_double, & + dim1name='landunit', & + long_name='internal building air temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_building_lun) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find t_building in initial file..." + if (masterproc) write(iulog,*) "Initialize t_building to taf" + this%t_building_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl) + end if + + ! landunit type physical state variable - t_roof_inner + call restartvar(ncid=ncid, flag=flag, varname='t_roof_inner', xtype=ncd_double, & + dim1name='landunit', & + long_name='roof inside surface temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_roof_inner_lun) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find t_roof_inner in initial file..." + if (masterproc) write(iulog,*) "Initialize t_roof_inner to taf" + this%t_roof_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl) + end if + + ! landunit type physical state variable - t_sunw_inner + call restartvar(ncid=ncid, flag=flag, varname='t_sunw_inner', xtype=ncd_double, & + dim1name='landunit', & + long_name='sunwall inside surface temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_sunw_inner_lun) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find t_sunw_inner in initial file..." + if (masterproc) write(iulog,*) "Initialize t_sunw_inner to taf" + this%t_sunw_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl) + end if + + ! landunit type physical state variable - t_shdw_inner + call restartvar(ncid=ncid, flag=flag, varname='t_shdw_inner', xtype=ncd_double, & + dim1name='landunit', & + long_name='shadewall inside surface temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_shdw_inner_lun) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find t_shdw_inner in initial file..." + if (masterproc) write(iulog,*) "Initialize t_shdw_inner to taf" + this%t_shdw_inner_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl) + end if + + ! landunit type physical state variable - t_floor + call restartvar(ncid=ncid, flag=flag, varname='t_floor', xtype=ncd_double, & + dim1name='landunit', & + long_name='floor temperature', units='K', & + interpinic_flag='interp', readvar=readvar, data=this%t_floor_lun) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "can't find t_floor in initial file..." + if (masterproc) write(iulog,*) "Initialize t_floor to taf" + this%t_floor_lun(bounds%begl:bounds%endl) = this%taf_lun(bounds%begl:bounds%endl) + end if + end if + + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! Each interval and accumulation type is unique to each field processed. + ! Routine [initAccBuffer] defines the fields to be processed + ! and the type of accumulation. + ! Routine [updateAccVars] does the actual accumulation for a given field. + ! Fields are accumulated by calls to subroutine [update_accum_field]. + ! To accumulate a field, it must first be defined in subroutine [initAccVars] + ! and then accumulated by calls to [updateAccVars]. + ! Four types of accumulations are possible: + ! o average over time interval + ! o running mean over time interval + ! o running accumulation over time interval + ! Time average fields are only valid at the end of the averaging interval. + ! Running means are valid once the length of the simulation exceeds the + ! averaging interval. Accumulated fields are continuously accumulated. + ! The trigger value "-99999." resets the accumulation to zero. + ! + ! !USES + use accumulMod , only : init_accum_field + use clm_time_manager , only : get_step_size + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + real(r8) :: dtime + integer, parameter :: not_used = huge(1) + !--------------------------------------------------------------------- + + dtime = get_step_size() + + this%t_veg24_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='T_VEG24', units='K', & + desc='24hr average of vegetation temperature', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%t_veg240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='T_VEG240', units='K', & + desc='240hr average of vegetation temperature', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field(name='TREFAV', units='K', & + desc='average over an hour of 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field(name='TREFAV_U', units='K', & + desc='average over an hour of urban 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field(name='TREFAV_R', units='K', & + desc='average over an hour of rural 2-m temperature', accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! The following is a running mean. The accumulation period is set to -10 for a 10-day running mean. + call init_accum_field (name='T10', units='K', & + desc='10-day running mean of 2-m temperature', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8) + + if ( crop_prog )then + call init_accum_field (name='TDM10', units='K', & + desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) + + call init_accum_field (name='TDM5', units='K', & + desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & + subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) + end if + + if ( use_ed ) then + + call init_accum_field (name='ED_GDD0', units='K', & + desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end if + + if ( crop_prog )then + + ! All GDD summations are relative to the planting date (Kucharik & Brye 2003) + call init_accum_field (name='GDD0', units='K', & + desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDD8', units='K', & + desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDD10', units='K', & + desc='growing degree-days base 10C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end if + + if (use_cndv) then + ! 30-day average of 2m temperature. + call init_accum_field (name='TDA', units='K', & + desc='30-day average of 2-m temperature', accum_type='timeavg', accum_period=-30, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + end if + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES + use accumulMod , only : init_accum_field, extract_accum_field + use clm_time_manager , only : get_nstep + use clm_varctl , only : nsrest, nsrStartup + use abortutils , only : endrun + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Allocate needed dynamic memory for single level pft field + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)' in ' + call endrun(msg="extract_accum_hist allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + ! Determine time step + nstep = get_nstep() + + call extract_accum_field ('T_VEG24', rbufslp, nstep) + this%t_veg24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('T_VEG240', rbufslp, nstep) + this%t_veg240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('T10', rbufslp, nstep) + this%t_a10_patch(begp:endp) = rbufslp(begp:endp) + + if (crop_prog) then + call extract_accum_field ('TDM10', rbufslp, nstep) + this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) + + call extract_accum_field ('TDM5', rbufslp, nstep) + this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) + end if + + ! Initialize variables that are to be time accumulated + ! Initialize 2m ref temperature max and min values + + if (nsrest == nsrStartup) then + this%t_ref2m_max_patch(begp:endp) = spval + this%t_ref2m_max_r_patch(begp:endp) = spval + this%t_ref2m_max_u_patch(begp:endp) = spval + + this%t_ref2m_min_patch(begp:endp) = spval + this%t_ref2m_min_r_patch(begp:endp) = spval + this%t_ref2m_min_u_patch(begp:endp) = spval + + this%t_ref2m_max_inst_patch(begp:endp) = -spval + this%t_ref2m_max_inst_r_patch(begp:endp) = -spval + this%t_ref2m_max_inst_u_patch(begp:endp) = -spval + + this%t_ref2m_min_inst_patch(begp:endp) = spval + this%t_ref2m_min_inst_r_patch(begp:endp) = spval + this%t_ref2m_min_inst_u_patch(begp:endp) = spval + end if + + if ( use_ed ) then + call extract_accum_field ('ED_GDD0', rbufslp, nstep) + this%gdd0_patch(begp:endp) = rbufslp(begp:endp) + end if + + if ( crop_prog ) then + + call extract_accum_field ('GDD0', rbufslp, nstep) + this%gdd0_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('GDD8', rbufslp, nstep) ; + this%gdd8_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('GDD10', rbufslp, nstep) + this%gdd10_patch(begp:endp) = rbufslp(begp:endp) + + end if + + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine UpdateAccVars (this, bounds) + ! + ! USES + use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date + use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + ! + ! !ARGUMENTS: + class(temperature_type) :: this + type(bounds_type) , intent(in) :: bounds + + ! + ! !LOCAL VARIABLES: + integer :: m,g,l,c,p ! indices + integer :: ier ! error status + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: year ! year (0, ...) for nstep + integer :: month ! month (1, ..., 12) for nstep + integer :: day ! day of month (1, ..., 31) for nstep + integer :: secs ! seconds into current date for nstep + logical :: end_cd ! temporary for is_end_curr_day() value + integer :: begp, endp + real(r8), pointer :: rbufslp(:) ! temporary single level - pft level + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + dtime = get_step_size() + nstep = get_nstep() + call get_curr_date (year, month, day, secs) + + ! Allocate needed dynamic memory for single level pft field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate and extract T_VEG24 & T_VEG240 + do p = begp,endp + rbufslp(p) = this%t_veg_patch(p) + end do + call update_accum_field ('T_VEG24' , rbufslp , nstep) + call extract_accum_field ('T_VEG24' , this%t_veg24_patch , nstep) + call update_accum_field ('T_VEG240', rbufslp , nstep) + call extract_accum_field ('T_VEG240', this%t_veg240_patch , nstep) + + ! Accumulate and extract TREFAV - hourly average 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV', this%t_ref2m_patch, nstep) + call extract_accum_field ('TREFAV', rbufslp, nstep) + end_cd = is_end_curr_day() + do p = begp,endp + if (rbufslp(p) /= spval) then + this%t_ref2m_max_inst_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_patch(p)) + this%t_ref2m_min_inst_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_patch(p)) + endif + if (end_cd) then + this%t_ref2m_max_patch(p) = this%t_ref2m_max_inst_patch(p) + this%t_ref2m_min_patch(p) = this%t_ref2m_min_inst_patch(p) + this%t_ref2m_max_inst_patch(p) = -spval + this%t_ref2m_min_inst_patch(p) = spval + else if (secs == dtime) then + this%t_ref2m_max_patch(p) = spval + this%t_ref2m_min_patch(p) = spval + endif + end do + + ! Accumulate and extract TREFAV_U - hourly average urban 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV_U', this%t_ref2m_u_patch, nstep) + call extract_accum_field ('TREFAV_U', rbufslp, nstep) + do p = begp,endp + l = patch%landunit(p) + if (rbufslp(p) /= spval) then + this%t_ref2m_max_inst_u_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_u_patch(p)) + this%t_ref2m_min_inst_u_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_u_patch(p)) + endif + if (end_cd) then + if (lun%urbpoi(l)) then + this%t_ref2m_max_u_patch(p) = this%t_ref2m_max_inst_u_patch(p) + this%t_ref2m_min_u_patch(p) = this%t_ref2m_min_inst_u_patch(p) + this%t_ref2m_max_inst_u_patch(p) = -spval + this%t_ref2m_min_inst_u_patch(p) = spval + end if + else if (secs == dtime) then + this%t_ref2m_max_u_patch(p) = spval + this%t_ref2m_min_u_patch(p) = spval + endif + end do + + ! Accumulate and extract TREFAV_R - hourly average rural 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV_R', this%t_ref2m_r_patch, nstep) + call extract_accum_field ('TREFAV_R', rbufslp, nstep) + do p = begp,endp + l = patch%landunit(p) + if (rbufslp(p) /= spval) then + this%t_ref2m_max_inst_r_patch(p) = max(rbufslp(p), this%t_ref2m_max_inst_r_patch(p)) + this%t_ref2m_min_inst_r_patch(p) = min(rbufslp(p), this%t_ref2m_min_inst_r_patch(p)) + endif + if (end_cd) then + if (.not.(lun%ifspecial(l))) then + this%t_ref2m_max_r_patch(p) = this%t_ref2m_max_inst_r_patch(p) + this%t_ref2m_min_r_patch(p) = this%t_ref2m_min_inst_r_patch(p) + this%t_ref2m_max_inst_r_patch(p) = -spval + this%t_ref2m_min_inst_r_patch(p) = spval + end if + else if (secs == dtime) then + this%t_ref2m_max_r_patch(p) = spval + this%t_ref2m_min_r_patch(p) = spval + endif + end do + + call update_accum_field ('T10', this%t_ref2m_patch, nstep) + call extract_accum_field ('T10', this%t_a10_patch, nstep) + + if ( crop_prog )then + ! Accumulate and extract TDM10 + + do p = begp,endp + rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? + if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& + end do !'min_inst' not initialized? + call update_accum_field ('TDM10', rbufslp, nstep) + call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) + + ! Accumulate and extract TDM5 + + do p = begp,endp + rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? + if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& + end do !'min_inst' not initialized? + call update_accum_field ('TDM5', rbufslp, nstep) + call extract_accum_field ('TDM5', this%t_a5min_patch, nstep) + + ! Accumulate and extract GDD0 + + do p = begp,endp + g = patch%gridcell(p) + if (month==1 .and. day==1 .and. secs==dtime) then + rbufslp(p) = accumResetVal ! reset gdd + else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(26._r8, this%t_ref2m_patch(p)-SHR_CONST_TKFRZ)) * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD0', rbufslp, nstep) + call extract_accum_field ('GDD0', this%gdd0_patch, nstep) + + ! Accumulate and extract GDD8 + + do p = begp,endp + g = patch%gridcell(p) + if (month==1 .and. day==1 .and. secs==dtime) then + rbufslp(p) = accumResetVal ! reset gdd + else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(30._r8, & + this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 8._r8))) * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD8', rbufslp, nstep) + call extract_accum_field ('GDD8', this%gdd8_patch, nstep) + + ! Accumulate and extract GDD10 + + do p = begp,endp + g = patch%gridcell(p) + if (month==1 .and. day==1 .and. secs==dtime) then + rbufslp(p) = accumResetVal ! reset gdd + else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(30._r8, & + this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 10._r8))) * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD10', rbufslp, nstep) + call extract_accum_field ('GDD10', this%gdd10_patch, nstep) + + end if + + ! Accumulate and extract T10 + !(acumulates TSA as 10-day running mean) + + deallocate(rbufslp) + + end subroutine UpdateAccVars + +end module TemperatureType diff --git a/components/clm/src/biogeophys/TridiagonalMod.F90 b/components/clm/src/biogeophys/TridiagonalMod.F90 new file mode 100644 index 0000000000..81a091c00f --- /dev/null +++ b/components/clm/src/biogeophys/TridiagonalMod.F90 @@ -0,0 +1,115 @@ +module TridiagonalMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: Tridiagonal + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Tridiagonal (bounds, lbj, ubj, jtop, numf, filter, a, b, c, r, u) + ! + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevurb + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varctl , only : iulog + use decompMod , only : bounds_type + use ColumnType , only : col + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col] + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(:) ! filter + real(r8), intent(in) :: a( bounds%begc: , lbj: ) ! "a" left off diagonal of tridiagonal matrix [col, j] + real(r8), intent(in) :: b( bounds%begc: , lbj: ) ! "b" diagonal column for tridiagonal matrix [col, j] + real(r8), intent(in) :: c( bounds%begc: , lbj: ) ! "c" right off diagonal tridiagonal matrix [col, j] + real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" forcing term of tridiagonal matrix [col, j] + real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j] + ! + integer :: j,ci,fc !indices + real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) !temporary + real(r8) :: bet(bounds%begc:bounds%endc) !temporary + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(a) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(b) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(c) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(r) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(u) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + + ! Solve the matrix + + do fc = 1,numf + ci = filter(fc) + bet(ci) = b(ci,jtop(ci)) + end do + + do j = lbj, ubj + do fc = 1,numf + ci = filter(fc) + if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall & + .or. col%itype(ci) == icol_roof) .and. j <= nlevurb) then + if (j >= jtop(ci)) then + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if + end if + else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall & + .and. col%itype(ci) /= icol_roof) then + if (j >= jtop(ci)) then + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if + end if + end if + end do + end do + + do j = ubj-1,lbj,-1 + do fc = 1,numf + ci = filter(fc) + if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall & + .or. col%itype(ci) == icol_roof) .and. j <= nlevurb-1) then + if (j >= jtop(ci)) then + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall & + .and. col%itype(ci) /= icol_roof) then + if (j >= jtop(ci)) then + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + end if + end do + end do + + end subroutine Tridiagonal + +end module TridiagonalMod diff --git a/components/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 b/components/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 new file mode 100644 index 0000000000..cdd4ad8d7f --- /dev/null +++ b/components/clm/src/biogeophys/UrbBuildTempOleson2015Mod.F90 @@ -0,0 +1,933 @@ +module UrbBuildTempOleson2015Mod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculates internal building air temperature + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use perf_mod , only : t_startf, t_stopf + use clm_varctl , only : iulog + use UrbanParamsType , only : urbanparams_type + use EnergyFluxType , only : energyflux_type + use TemperatureType , only : temperature_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: BuildingTemperature ! Calculation of interior building air temperature, inner + ! surface temperatures of walls and roof, and floor temperature + !----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BuildingTemperature +! +! !INTERFACE: + subroutine BuildingTemperature (bounds, num_urbanl, filter_urbanl, num_nolakec, & + filter_nolakec, tk, urbanparams_inst, temperature_inst, & + energyflux_inst ) +! +! !DESCRIPTION: +! Solve for t_building, inner surface temperatures of roof, sunw, shdw, and floor temperature +! Five equations, five unknowns (t_roof_inner,t_sunw_inner,t_shdw_inner,t_floor,t_building at n+1) +! Derived from energy balance equations at each surface and building air +! rd (radiation), cd (conduction), cv (convection) +! qrd_roof + qcd_roof + qcv_roof = 0 +! qrd_sunw + qcd_sunw + qcv_sunw = 0 +! qrd_shdw + qcd_shdw + qcv_shdw = 0 +! qrd_floor + qcd_floor + qcv_floor = 0 +! Vbld*rho_dair*cpair*(dt_building/dt) = sum(Asfc*hcv_sfc*(t_sfc - t_building) +! + Vvent*rho_dair*cpair*(taf - t_building) +! where Vlbd is volume of building air, +! rho_dair is density of dry air at t_building (kg m-3), +! cpair is specific heat of dry air (J kg-1 K-1), +! dt_building is change in interior building temperature (K), +! dt is timestep (s), +! Asfc is surface area of roof, sunw, shdw, floor (m2) +! hcv_sfc is convective heat transfer coefficient for roof, sunw, shdw, floor (W m-2 K-1) +! t_sfc is inner surface temperature of roof, sunw, shdw, floor (K) +! t_building is interior building temperature (K) +! Vvent is ventilation airflow rate (m3 s-1) +! taf is urban canyon air temperature (K) +! +! This methodology was introduced as part of CLM5.0. +! +! Conduction fluxes are obtained from terms of soil temperature equations +! Radiation fluxes are obtained from linearizing the longwave radiation equations taking into +! account view factors for each surface. + +! qrd is positive away from the surface toward room air, so qrd = emitted - absorbed, +! so positive qrd will result in a decrease in temperature +! qcd_floor is positive away from surface toward room air, so positive +! qcd will result in a decrease in temperature +! qcv is positive toward room air, so positive qcv (t_surface > t_room) will +! result in a decrease in temperature + +! The LAPACK routine DGESV is used to compute the solution to the real system of linear equations +! a * x = b, +! where a is an n-by-n matrix and x and b are n-by-nrhs matrices. +! +! The LU decomposition with partial pivoting and row interchanges is +! used to factor a as +! a = P * L * U, +! where P is a permutation matrix, L is unit lower triangular, and U is +! upper triangular. The factored form of a is then used to solve the +! system of equations a * x = b. + +! The following is from LAPACK documentation +! DGESV computes the solution to system of linear equations A * X = B for GE matrices +! +! =========== DOCUMENTATION =========== +! +! Online html documentation available at +! http://www.netlib.org/lapack/explore-html/ +! +! Download DGESV + dependencies +! +! [TGZ] +! +! [ZIP] +! +! [TXT] +! +! Definition: +! =========== +! +! SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO ) +! +! .. Scalar Arguments .. +! INTEGER INFO, LDA, LDB, N, NRHS +! .. +! .. Array Arguments .. +! INTEGER IPIV( * ) +! DOUBLE PRECISION A( LDA, * ), B( LDB, * ) +! .. +! +! +! ============= +! +! +! DGESV computes the solution to a real system of linear equations +! A * X = B, +! where A is an N-by-N matrix and X and B are N-by-NRHS matrices. +! +! The LU decomposition with partial pivoting and row interchanges is +! used to factor A as +! A = P * L * U, +! where P is a permutation matrix, L is unit lower triangular, and U is +! upper triangular. The factored form of A is then used to solve the +! system of equations A * X = B. +! +! Arguments: +! ========== +! +! \param[in] N +! N is INTEGER +! The number of linear equations, i.e., the order of the +! matrix A. N >= 0. +! +! \param[in] NRHS +! NRHS is INTEGER +! The number of right hand sides, i.e., the number of columns +! of the matrix B. NRHS >= 0. +! +! \param[in,out] A +! A is DOUBLE PRECISION array, dimension (LDA,N) +! On entry, the N-by-N coefficient matrix A. +! On exit, the factors L and U from the factorization +! A = P*L*U; the unit diagonal elements of L are not stored. +! +! \param[in] LDA +! LDA is INTEGER +! The leading dimension of the array A. LDA >= max(1,N). +! +! \param[out] IPIV +! IPIV is INTEGER array, dimension (N) +! The pivot indices that define the permutation matrix P; +! row i of the matrix was interchanged with row IPIV(i). +! +! \param[in,out] B +! B is DOUBLE PRECISION array, dimension (LDB,NRHS) +! On entry, the N-by-NRHS matrix of right hand side matrix B. +! On exit, if INFO = 0, the N-by-NRHS solution matrix X. +! +! \param[in] LDB +! LDB is INTEGER +! The leading dimension of the array B. LDB >= max(1,N). +! +! \param[out] INFO +! INFO is INTEGER +! = 0: successful exit +! < 0: if INFO = -i, the i-th argument had an illegal value +! > 0: if INFO = i, U(i,i) is exactly zero. The factorization +! has been completed, but the factor U is exactly +! singular, so the solution could not be computed. +! +! Authors: +! ======== +! +! \author Univ. of Tennessee +! \author Univ. of California Berkeley +! \author Univ. of Colorado Denver +! \author NAG Ltd. +! +! \date November 2011 +! +! \ingroup doubleGEsolve + +! !CALLED FROM: +! subroutine SoilTemperature in this module +! +! !REVISION HISTORY: +! 08/17/12 Keith Oleson: Initial code + +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager, only : get_step_size + use clm_varcon , only : rair, pstd, cpair, sb, hcv_roof, hcv_roof_enhanced, & + hcv_floor, hcv_floor_enhanced, hcv_sunw, hcv_shdw, & + em_roof_int, em_floor_int, em_sunw_int, em_shdw_int, & + dz_floor, dens_floor, cp_floor, vent_ach + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_varctl , only : iulog + use abortutils , only : endrun + use clm_varpar , only : nlevurb, nlevsno, nlevgrnd + use UrbanParamsType , only : urban_hac, urban_hac_off, urban_hac_on, urban_wasteheat_on +! +! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8), intent(in) :: tk(bounds%begc: , -nlevsno+1: ) ! thermal conductivity (W m-1 K-1) [col, j] + type(urbanparams_type), intent(in) :: urbanparams_inst ! urban parameters + type(temperature_type), intent(inout) :: temperature_inst ! temperature variables + type(energyflux_type) , intent(inout) :: energyflux_inst ! energy flux variables +! +! !LOCAL VARIABLES: + integer, parameter :: neq = 5 ! number of equation/unknowns + integer :: fc,fl,c,l ! indices + real(r8) :: dtime ! land model time step (s) + real(r8) :: t_roof_inner_bef(bounds%begl:bounds%endl) ! roof inside surface temperature at previous time step (K) + real(r8) :: t_sunw_inner_bef(bounds%begl:bounds%endl) ! sunwall inside surface temperature at previous time step (K) + real(r8) :: t_shdw_inner_bef(bounds%begl:bounds%endl) ! shadewall inside surface temperature at previous time step (K) + real(r8) :: t_floor_bef(bounds%begl:bounds%endl) ! floor temperature at previous time step (K) + real(r8) :: t_building_bef(bounds%begl:bounds%endl) ! internal building air temperature at previous time step [K] + real(r8) :: t_building_bef_hac(bounds%begl:bounds%endl)! internal building air temperature before applying HAC [K] + real(r8) :: hcv_roofi(bounds%begl:bounds%endl) ! roof convective heat transfer coefficient (W m-2 K-1) + real(r8) :: hcv_sunwi(bounds%begl:bounds%endl) ! sunwall convective heat transfer coefficient (W m-2 K-1) + real(r8) :: hcv_shdwi(bounds%begl:bounds%endl) ! shadewall convective heat transfer coefficient (W m-2 K-1) + real(r8) :: hcv_floori(bounds%begl:bounds%endl) ! floor convective heat transfer coefficient (W m-2 K-1) + real(r8) :: em_roofi(bounds%begl:bounds%endl) ! roof inside surface emissivity (-) + real(r8) :: em_sunwi(bounds%begl:bounds%endl) ! sunwall inside surface emissivity (-) + real(r8) :: em_shdwi(bounds%begl:bounds%endl) ! shadewall inside surface emissivity (-) + real(r8) :: em_floori(bounds%begl:bounds%endl) ! floor inside surface emissivity (-) + real(r8) :: dz_floori(bounds%begl:bounds%endl) ! concrete floor thickness (m) + real(r8) :: cp_floori(bounds%begl:bounds%endl) ! concrete floor volumetric heat capacity (J m-3 K-1) + real(r8) :: cv_floori(bounds%begl:bounds%endl) ! intermediate calculation for concrete floor (W m-2 K-1) + real(r8) :: rho_dair(bounds%begl:bounds%endl) ! density of dry air at standard pressure and t_building (kg m-3) + real(r8) :: vf_rf(bounds%begl:bounds%endl) ! view factor of roof for floor (-) + real(r8) :: vf_fr(bounds%begl:bounds%endl) ! view factor of floor for roof (-) + real(r8) :: vf_wf(bounds%begl:bounds%endl) ! view factor of wall for floor (-) + real(r8) :: vf_fw(bounds%begl:bounds%endl) ! view factor of floor for wall (-) + real(r8) :: vf_rw(bounds%begl:bounds%endl) ! view factor of roof for wall (-) + real(r8) :: vf_wr(bounds%begl:bounds%endl) ! view factor of wall for roof (-) + real(r8) :: vf_ww(bounds%begl:bounds%endl) ! view factor of wall for wall (-) + real(r8) :: zi_roof_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb roof (m) + real(r8) :: z_roof_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb roof (m) + real(r8) :: zi_sunw_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb sunwall (m) + real(r8) :: z_sunw_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb sunwall (m) + real(r8) :: zi_shdw_innerl(bounds%begl:bounds%endl) ! interface depth of nlevurb shadewall (m) + real(r8) :: z_shdw_innerl(bounds%begl:bounds%endl) ! node depth of nlevurb shadewall (m) + real(r8) :: t_roof_innerl_bef(bounds%begl:bounds%endl) ! roof temperature at nlevurb node depth at previous time step (K) + real(r8) :: t_sunw_innerl_bef(bounds%begl:bounds%endl) ! sunwall temperature at nlevurb node depth at previous time step (K) + real(r8) :: t_shdw_innerl_bef(bounds%begl:bounds%endl) ! shadewall temperature at nlevurb node depth at previous time step (K) + real(r8) :: t_roof_innerl(bounds%begl:bounds%endl) ! roof temperature at nlevurb node depth (K) + real(r8) :: t_sunw_innerl(bounds%begl:bounds%endl) ! sunwall temperature at nlevurb node depth (K) + real(r8) :: t_shdw_innerl(bounds%begl:bounds%endl) ! shadewall temperature at nlevurb node depth (K) + real(r8) :: tk_roof_innerl(bounds%begl:bounds%endl) ! roof thermal conductivity at nlevurb interface depth (W m-1 K-1) + real(r8) :: tk_sunw_innerl(bounds%begl:bounds%endl) ! sunwall thermal conductivity at nlevurb interface depth (W m-1 K-1) + real(r8) :: tk_shdw_innerl(bounds%begl:bounds%endl) ! shadewall thermal conductivity at nlevurb interface depth (W m-1 K-1) + real(r8) :: qrd_roof(bounds%begl:bounds%endl) ! roof inside net longwave for energy balance check (W m-2) + real(r8) :: qrd_sunw(bounds%begl:bounds%endl) ! sunwall inside net longwave for energy balance check (W m-2) + real(r8) :: qrd_shdw(bounds%begl:bounds%endl) ! shadewall inside net longwave for energy balance check (W m-2) + real(r8) :: qrd_floor(bounds%begl:bounds%endl) ! floor inside net longwave for energy balance check (W m-2) + real(r8) :: qrd_building(bounds%begl:bounds%endl) ! building inside net longwave for energy balance check (W m-2) + real(r8) :: qcv_roof(bounds%begl:bounds%endl) ! roof inside convection flux for energy balance check (W m-2) + real(r8) :: qcv_sunw(bounds%begl:bounds%endl) ! sunwall inside convection flux for energy balance check (W m-2) + real(r8) :: qcv_shdw(bounds%begl:bounds%endl) ! shadewall inside convection flux for energy balance check (W m-2) + real(r8) :: qcv_floor(bounds%begl:bounds%endl) ! floor inside convection flux for energy balance check (W m-2) + real(r8) :: qcd_roof(bounds%begl:bounds%endl) ! roof inside conduction flux for energy balance check (W m-2) + real(r8) :: qcd_sunw(bounds%begl:bounds%endl) ! sunwall inside conduction flux for energy balance check (W m-2) + real(r8) :: qcd_shdw(bounds%begl:bounds%endl) ! shadewall inside conduction flux for energy balance check (W m-2) + real(r8) :: qcd_floor(bounds%begl:bounds%endl) ! floor inside conduction flux for energy balance check (W m-2) + real(r8) :: enrgy_bal_roof(bounds%begl:bounds%endl) ! roof inside energy balance (W m-2) + real(r8) :: enrgy_bal_sunw(bounds%begl:bounds%endl) ! sunwall inside energy balance (W m-2) + real(r8) :: enrgy_bal_shdw(bounds%begl:bounds%endl) ! shadewall inside energy balance (W m-2) + real(r8) :: enrgy_bal_floor(bounds%begl:bounds%endl) ! floor inside energy balance (W m-2) + real(r8) :: enrgy_bal_buildair(bounds%begl:bounds%endl)! building air energy balance (W m-2) + real(r8) :: sum ! sum of view factors for floor, wall, roof + integer :: n ! number of linear equations (= neq) + integer :: nrhs ! number of right hand sides (= 1) + real(r8) :: a(neq,neq) ! n-by-n coefficient matrix a + integer :: lda ! leading dimension of the matrix a + integer :: ldb ! leading dimension of the matrix b + real(r8) :: result(neq) ! on entry, the right hand side of matrix b + ! on exit, if info = 0, the n-by-nrhs solution matrix x + integer :: info ! exit information for LAPACK routine dgesv + integer :: ipiv(neq) ! the pivot indices that define the permutation matrix P +!EOP +!----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(tk) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + associate(& + clandunit => col%landunit , & ! Input: [integer (:)] column's landunit + ctype => col%itype , & ! Input: [integer (:)] column type + zi => col%zi , & ! Input: [real(r8) (:,:)] interface level below a "z" level (m) + z => col%z , & ! Input: [real(r8) (:,:)] layer thickness (m) + + ht_roof => lun%ht_roof , & ! Input: [real(r8) (:)] height of urban roof (m) + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:)] ratio of building height to street hwidth (-) + wtlunit_roof => lun%wtlunit_roof , & ! Input: [real(r8) (:)] weight of roof with respect to landunit + urbpoi => lun%urbpoi , & ! Input: [logical (:)] true => landunit is an urban point + + taf => temperature_inst%taf_lun , & ! Input: [real(r8) (:)] urban canopy air temperature (K) + tssbef => temperature_inst%t_ssbef_col , & ! Input: [real(r8) (:,:)] temperature at previous time step (K) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:)] soil temperature (K) + t_roof_inner => temperature_inst%t_roof_inner_lun , & ! InOut: [real(r8) (:)] roof inside surface temperature (K) + t_sunw_inner => temperature_inst%t_sunw_inner_lun , & ! InOut: [real(r8) (:)] sunwall inside surface temperature (K) + t_shdw_inner => temperature_inst%t_shdw_inner_lun , & ! InOut: [real(r8) (:)] shadewall inside surface temperature (K) + t_floor => temperature_inst%t_floor_lun , & ! InOut: [real(r8) (:)] floor temperature (K) + t_building => temperature_inst%t_building_lun , & ! InOut: [real(r8) (:)] internal building air temperature (K) + + t_building_max => urbanparams_inst%t_building_max , & ! Input: [real(r8) (:)] maximum internal building air temperature (K) + t_building_min => urbanparams_inst%t_building_min , & ! Input: [real(r8) (:)] minimum internal building air temperature (K) + + eflx_building => energyflux_inst%eflx_building_lun , & ! Output: [real(r8) (:)] building heat flux from change in interior building air temperature (W/m**2) + eflx_urban_ac => energyflux_inst%eflx_urban_ac_lun , & ! Output: [real(r8) (:)] urban air conditioning flux (W/m**2) + eflx_urban_heat => energyflux_inst%eflx_urban_heat_lun & ! Output: [real(r8) (:)] urban heating flux (W/m**2) + ) + + ! Get step size + + dtime = get_step_size() + + ! 1. Save t_* at previous time step + ! 2. Set convective heat transfer coefficients (Bueno et al. 2012, GMD). + ! An alternative is Salamanca et al. 2010, TAC, where they are all set to 8 W m-2 K-1. + ! See clm_varcon.F90 + ! 3. Set inner surface emissivities (Bueno et al. 2012, GMD). + ! 4. Set concrete floor properties (Salamanca et al. 2010, TAC). + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + t_roof_inner_bef(l) = t_roof_inner(l) + t_sunw_inner_bef(l) = t_sunw_inner(l) + t_shdw_inner_bef(l) = t_shdw_inner(l) + t_floor_bef(l) = t_floor(l) + t_building_bef(l) = t_building(l) + if (t_roof_inner_bef(l) .le. t_building_bef(l)) then + hcv_roofi(l) = hcv_roof_enhanced + else + hcv_roofi(l) = hcv_roof + end if + if (t_floor_bef(l) .ge. t_building_bef(l)) then + hcv_floori(l) = hcv_floor_enhanced + else + hcv_floori(l) = hcv_floor + end if + hcv_sunwi(l) = hcv_sunw + hcv_shdwi(l) = hcv_shdw + em_roofi(l) = em_roof_int + em_sunwi(l) = em_sunw_int + em_shdwi(l) = em_shdw_int + em_floori(l) = em_floor_int + ! Concrete floor thickness (m) + dz_floori(l) = dz_floor + ! Concrete floor volumetric heat capacity (J m-3 K-1) + cp_floori(l) = cp_floor + ! Intermediate calculation for concrete floor (W m-2 K-1) + cv_floori(l) = (dz_floori(l) * cp_floori(l)) / dtime + ! Density of dry air at standard pressure and t_building (kg m-3) + rho_dair(l) = pstd / (rair*t_building_bef(l)) + end if + end do + + ! Get terms from soil temperature equations to compute conduction flux + ! Negative is toward surface - heat added + ! Note that the conduction flux here is in W m-2 wall area but for purposes of solving the set of + ! simultaneous equations this must be converted to W m-2 ground area. This is done below when + ! setting up the equation coefficients. + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (urbpoi(l)) then + if (ctype(c) == icol_roof) then + zi_roof_innerl(l) = zi(c,nlevurb) + z_roof_innerl(l) = z(c,nlevurb) + t_roof_innerl_bef(l) = tssbef(c,nlevurb) + t_roof_innerl(l) = t_soisno(c,nlevurb) + tk_roof_innerl(l) = tk(c,nlevurb) + else if (ctype(c) == icol_sunwall) then + zi_sunw_innerl(l) = zi(c,nlevurb) + z_sunw_innerl(l) = z(c,nlevurb) + t_sunw_innerl_bef(l) = tssbef(c,nlevurb) + t_sunw_innerl(l) = t_soisno(c,nlevurb) + tk_sunw_innerl(l) = tk(c,nlevurb) + else if (ctype(c) == icol_shadewall) then + zi_shdw_innerl(l) = zi(c,nlevurb) + z_shdw_innerl(l) = z(c,nlevurb) + t_shdw_innerl_bef(l) = tssbef(c,nlevurb) + t_shdw_innerl(l) = t_soisno(c,nlevurb) + tk_shdw_innerl(l) = tk(c,nlevurb) + end if + end if + end do + + ! Calculate view factors + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + + vf_rf(l) = sqrt(1._r8 + canyon_hwr(l)**2._r8) - canyon_hwr(l) + vf_fr(l) = vf_rf(l) + + ! This view factor implicitly converts from per unit wall area to per unit floor area + vf_wf(l) = 0.5_r8*(1._r8 - vf_rf(l)) + + ! This view factor implicitly converts from per unit floor area to per unit wall area + vf_fw(l) = vf_wf(l) / canyon_hwr(l) + + ! This view factor implicitly converts from per unit roof area to per unit wall area + vf_rw(l) = vf_fw(l) + + ! This view factor implicitly converts from per unit wall area to per unit roof area + vf_wr(l) = vf_wf(l) + + vf_ww(l) = 1._r8 - vf_rw(l) - vf_fw(l) + + end if + end do + + ! error check -- make sure view factor sums to one for floor, wall, and roof + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + + sum = vf_rf(l) + 2._r8*vf_wf(l) + if (abs(sum-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban floor view factor error',sum + write (iulog,*) 'clm model is stopping' + call endrun() + endif + sum = vf_rw(l) + vf_fw(l) + vf_ww(l) + if (abs(sum-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban wall view factor error',sum + write (iulog,*) 'clm model is stopping' + call endrun() + endif + sum = vf_fr(l) + vf_wr(l) + vf_wr(l) + if (abs(sum-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban roof view factor error',sum + write (iulog,*) 'clm model is stopping' + call endrun() + endif + + endif + end do + + n = neq + nrhs = 1 + lda = neq + ldb = neq + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + + ! ROOF + a(1,1) = 0.5_r8*hcv_roofi(l) & + + 0.5_r8*tk_roof_innerl(l)/(zi_roof_innerl(l) - z_roof_innerl(l)) & + + 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8 & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l) + + a(1,2) = - 4._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) + + a(1,3) = - 4._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) + + a(1,4) = - 4._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l) + + a(1,5) = - 0.5_r8*hcv_roofi(l) + + result(1) = 0.5_r8*tk_roof_innerl(l)*t_roof_innerl(l)/(zi_roof_innerl(l) - z_roof_innerl(l)) & + - 0.5_r8*tk_roof_innerl(l)*(t_roof_inner_bef(l)-t_roof_innerl_bef(l))/(zi_roof_innerl(l) & + - z_roof_innerl(l)) & + - 3._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l) & + - 3._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l) & + - 3._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l) & + + 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8 & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) + + ! SUNWALL + a(2,1) = - 4._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) + + a(2,2) = 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) & + + 0.5_r8*tk_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) & + + 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8 & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) + + a(2,3) = - 4._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) + + a(2,4) = - 4._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) + a(2,5) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + + result(2) = 0.5_r8*tk_sunw_innerl(l)*t_sunw_innerl(l)/(zi_sunw_innerl(l) - z_sunw_innerl(l))*canyon_hwr(l) & + - 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l)-t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) & + - z_sunw_innerl(l))*canyon_hwr(l) & + - 3._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & + - 3._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l) & + - 3._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & + + 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8 & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) + + ! SHADEWALL + a(3,1) = - 4._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) + + a(3,2) = - 4._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) + + a(3,3) = 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) & + + 0.5_r8*tk_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) & + + 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8 & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) + + a(3,4) = - 4._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) + + a(3,5) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + + result(3) = 0.5_r8*tk_shdw_innerl(l)*t_shdw_innerl(l)/(zi_shdw_innerl(l) - z_shdw_innerl(l))*canyon_hwr(l) & + - 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l)-t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) & + - z_shdw_innerl(l))*canyon_hwr(l) & + - 3._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & + - 3._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l) & + - 3._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & + + 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8 & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) + + ! FLOOR + a(4,1) = - 4._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l) + + a(4,2) = - 4._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) + + a(4,3) = - 4._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l) + + a(4,4) = (cv_floori(l) + 0.5_r8*hcv_floori(l)) & + + 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8 & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l) + + a(4,5) = - 0.5_r8*hcv_floori(l) + + result(4) = cv_floori(l)*t_floor_bef(l) & + - 3._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l) & + - 3._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l) & + - 3._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l) & + + 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8 & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 3._r8*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 3._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 3._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 3._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l)) + + ! Building air temperature + a(5,1) = - 0.5_r8*hcv_roofi(l) + a(5,2) = - 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + + a(5,3) = - 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + + a(5,4) = - 0.5_r8*hcv_floori(l) + + a(5,5) = ((ht_roof(l)*rho_dair(l)*cpair)/dtime) + & + ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair + & + 0.5_r8*hcv_roofi(l) + & + 0.5_r8*hcv_sunwi(l)*canyon_hwr(l) + & + 0.5_r8*hcv_shdwi(l)*canyon_hwr(l) + & + 0.5_r8*hcv_floori(l) + + result(5) = (ht_roof(l)*rho_dair(l)*cpair/dtime)*t_building_bef(l) & + + ((ht_roof(l)*vent_ach)/3600._r8)*rho_dair(l)*cpair*taf(l) & + + 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) & + + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + + 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l)) + + ! Solve equations + call dgesv(n, nrhs, a, lda, ipiv, result, ldb, info) + + ! If dgesv fails, abort + if (info /= 0) then + write(iulog,*)'fl: ',fl + write(iulog,*)'l: ',l + write(iulog,*)'dgesv info: ',info + write (iulog,*) 'dgesv error' + write (iulog,*) 'clm model is stopping' + call endrun() + end if + ! Assign new temperatures + t_roof_inner(l) = result(1) + t_sunw_inner(l) = result(2) + t_shdw_inner(l) = result(3) + t_floor(l) = result(4) + t_building(l) = result(5) + end if + end do + + ! Energy balance checks + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + qrd_roof(l) = - em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wr(l) & + - 4._r8*em_roofi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wr(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wr(l) & + - 4._r8*em_roofi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wr(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fr(l) & + - 4._r8*em_roofi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fr(l)*(t_floor(l) - t_floor_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(1._r8-em_floori(l))*vf_fr(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wr(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wr(l)*(t_floor(l) & + - t_floor_bef(l)) & + + em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8 & + + 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*(t_roof_inner(l) - t_roof_inner_bef(l)) + + qrd_sunw(l) = - em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & + - 4._r8*em_sunwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_ww(l) & + - 4._r8*em_sunwi(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_ww(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & + - 4._r8*em_sunwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(t_floor(l) - t_floor_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_shdwi(l))*vf_ww(l)*(t_floor(l) & + - t_floor_bef(l)) & + + em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8 & + + 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*(t_sunw_inner(l) - t_sunw_inner_bef(l)) + + qrd_shdw(l) = - em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rw(l) & + - 4._r8*em_shdwi(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rw(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_ww(l) & + - 4._r8*em_shdwi(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_ww(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**4._r8*vf_fw(l) & + - 4._r8*em_shdwi(l)*em_floori(l)*sb*t_floor_bef(l)**3._r8*vf_fw(l)*(t_floor(l) - t_floor_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rf(l)*(1._r8-em_floori(l))*vf_fw(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rw(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_sunwi(l))*vf_ww(l)*(t_floor(l) & + - t_floor_bef(l)) & + + em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8 & + + 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*(t_shdw_inner(l) - t_shdw_inner_bef(l)) + + qrd_floor(l) = - em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8*vf_rf(l) & + - 4._r8*em_floori(l)*em_roofi(l)*sb*t_roof_inner_bef(l)**3._r8*vf_rf(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8*vf_wf(l) & + - 4._r8*em_floori(l)*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3._r8*vf_wf(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8*vf_wf(l) & + - 4._r8*em_floori(l)*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3._r8*vf_wf(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_floori(l)*sb*t_floor_bef(l)**4._r8)*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*vf_fw(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_floor(l) & + - t_floor_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_sunwi(l)*sb*t_sunw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 4._r8*em_sunwi(l)*sb*t_sunw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_sunw_inner(l) & + - t_sunw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_wr(l)*(1._r8-em_roofi(l))*vf_rf(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_shdwi(l)*sb*t_shdw_inner_bef(l)**4._r8)*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 4._r8*em_shdwi(l)*sb*t_shdw_inner_bef(l)**3.*vf_ww(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_shdw_inner(l) & + - t_shdw_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_sunwi(l))*vf_wf(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + - (em_roofi(l)*sb*t_roof_inner_bef(l)**4._r8)*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l) & + - 4._r8*em_roofi(l)*sb*t_roof_inner_bef(l)**3.*vf_rw(l)*(1._r8-em_shdwi(l))*vf_wf(l)*(t_roof_inner(l) & + - t_roof_inner_bef(l)) & + + em_floori(l)*sb*t_floor_bef(l)**4._r8 & + + 4._r8*em_floori(l)*sb*t_floor_bef(l)**3.*(t_floor(l) - t_floor_bef(l)) + + qrd_building(l) = qrd_roof(l) + canyon_hwr(l)*(qrd_sunw(l) + qrd_shdw(l)) + qrd_floor(l) + + if (abs(qrd_building(l)) > .10_r8 ) then + write (iulog,*) 'urban inside building net longwave radiation balance error ',qrd_building(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + qcv_roof(l) = 0.5_r8*hcv_roofi(l)*(t_roof_inner(l) - t_building(l)) + 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) & + - t_building_bef(l)) + qcd_roof(l) = 0.5_r8*tk_roof_innerl(l)*(t_roof_inner(l) - t_roof_innerl(l))/(zi_roof_innerl(l) - z_roof_innerl(l)) & + + 0.5_r8*tk_roof_innerl(l)*(t_roof_inner_bef(l) - t_roof_innerl_bef(l))/(zi_roof_innerl(l) & + - z_roof_innerl(l)) + enrgy_bal_roof(l) = qrd_roof(l) + qcv_roof(l) + qcd_roof(l) + if (abs(enrgy_bal_roof(l)) > .10_r8 ) then + write (iulog,*) 'urban inside roof energy balance error ',enrgy_bal_roof(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + qcv_sunw(l) = 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l)) + 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) & + - t_building_bef(l)) + qcd_sunw(l) = 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner(l) - t_sunw_innerl(l))/(zi_sunw_innerl(l) - z_sunw_innerl(l)) & + + 0.5_r8*tk_sunw_innerl(l)*(t_sunw_inner_bef(l) - t_sunw_innerl_bef(l))/(zi_sunw_innerl(l) & + - z_sunw_innerl(l)) + enrgy_bal_sunw(l) = qrd_sunw(l) + qcv_sunw(l)*canyon_hwr(l) + qcd_sunw(l)*canyon_hwr(l) + if (abs(enrgy_bal_sunw(l)) > .10_r8 ) then + write (iulog,*) 'urban inside sunwall energy balance error ',enrgy_bal_sunw(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + qcv_shdw(l) = 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l)) + 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) & + - t_building_bef(l)) + qcd_shdw(l) = 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner(l) - t_shdw_innerl(l))/(zi_shdw_innerl(l) - z_shdw_innerl(l)) & + + 0.5_r8*tk_shdw_innerl(l)*(t_shdw_inner_bef(l) - t_shdw_innerl_bef(l))/(zi_shdw_innerl(l) & + - z_shdw_innerl(l)) + enrgy_bal_shdw(l) = qrd_shdw(l) + qcv_shdw(l)*canyon_hwr(l) + qcd_shdw(l)*canyon_hwr(l) + if (abs(enrgy_bal_shdw(l)) > .10_r8 ) then + write (iulog,*) 'urban inside shadewall energy balance error ',enrgy_bal_shdw(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + qcv_floor(l) = 0.5_r8*hcv_floori(l)*(t_floor(l) - t_building(l)) + 0.5_r8*hcv_floori(l)*(t_floor_bef(l) & + - t_building_bef(l)) + qcd_floor(l) = cv_floori(l)*(t_floor(l) - t_floor_bef(l)) + enrgy_bal_floor(l) = qrd_floor(l) + qcv_floor(l) + qcd_floor(l) + if (abs(enrgy_bal_floor(l)) > .10_r8 ) then + write (iulog,*) 'urban inside floor energy balance error ',enrgy_bal_floor(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + enrgy_bal_buildair(l) = (ht_roof(l)*rho_dair(l)*cpair/dtime)*(t_building(l) - t_building_bef(l)) & + - ht_roof(l)*(vent_ach/3600._r8)*rho_dair(l)*cpair*(taf(l) - t_building(l)) & + - 0.5_r8*hcv_roofi(l)*(t_roof_inner(l) - t_building(l)) & + - 0.5_r8*hcv_roofi(l)*(t_roof_inner_bef(l) - t_building_bef(l)) & + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner(l) - t_building(l))*canyon_hwr(l) & + - 0.5_r8*hcv_sunwi(l)*(t_sunw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner(l) - t_building(l))*canyon_hwr(l) & + - 0.5_r8*hcv_shdwi(l)*(t_shdw_inner_bef(l) - t_building_bef(l))*canyon_hwr(l) & + - 0.5_r8*hcv_floori(l)*(t_floor(l) - t_building(l)) & + - 0.5_r8*hcv_floori(l)*(t_floor_bef(l) - t_building_bef(l)) + if (abs(enrgy_bal_buildair(l)) > .10_r8 ) then + write (iulog,*) 'urban building air energy balance error ',enrgy_bal_buildair(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + end if + end do + + ! Restrict internal building air temperature to between min and max + ! Calculate heating or air conditioning flux from energy required to change + ! internal building air temperature to t_building_min or t_building_max. + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (urbpoi(l)) then + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + t_building_bef_hac(l) = t_building(l) +! rho_dair(l) = pstd / (rair*t_building(l)) + + if (t_building_bef_hac(l) > t_building_max(l)) then + t_building(l) = t_building_max(l) + eflx_urban_ac(l) = wtlunit_roof(l) * abs( (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building(l) & + - (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building_bef_hac(l) ) + else if (t_building_bef_hac(l) < t_building_min(l)) then + t_building(l) = t_building_min(l) + eflx_urban_heat(l) = wtlunit_roof(l) * abs( (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building(l) & + - (ht_roof(l) * rho_dair(l) * cpair / dtime) * t_building_bef_hac(l) ) + else + eflx_urban_ac(l) = 0._r8 + eflx_urban_heat(l) = 0._r8 + end if + else + eflx_urban_ac(l) = 0._r8 + eflx_urban_heat(l) = 0._r8 + end if + eflx_building(l) = wtlunit_roof(l) * (ht_roof(l) * rho_dair(l)*cpair/dtime) * (t_building(l) - t_building_bef(l)) + end if + end do + + end associate + end subroutine BuildingTemperature + + !----------------------------------------------------------------------- + +end module UrbBuildTempOleson2015Mod diff --git a/components/clm/src/biogeophys/UrbanAlbedoMod.F90 b/components/clm/src/biogeophys/UrbanAlbedoMod.F90 new file mode 100644 index 0000000000..0ab937c335 --- /dev/null +++ b/components/clm/src/biogeophys/UrbanAlbedoMod.F90 @@ -0,0 +1,1265 @@ +module UrbanAlbedoMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate solar and longwave radiation, and turbulent fluxes for urban landunit + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : numrad + use clm_varcon , only : isecspday, degpsec, namel + use clm_varctl , only : iulog + use abortutils , only : endrun + use UrbanParamsType , only : urbanparams_type + use WaterstateType , only : waterstate_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanAlbedo ! Urban physics - albedos + ! + ! PRIVATE MEMBER FUNCTIONS + private :: SnowAlbedo ! Snow albedos + private :: incident_direct ! Direct beam solar rad incident on walls and road in urban canyon + private :: incident_diffuse ! Diffuse solar rad incident on walls and road in urban canyon + private :: net_solar ! Solar radiation absorbed by road and both walls in urban canyon + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & + num_urbanc, filter_urbanc, num_urbanp, filter_urbanp, & + waterstate_inst, urbanparams_inst, solarabs_inst, surfalb_inst) + ! + ! !DESCRIPTION: + ! Determine urban landunit component albedos + ! + ! Note that this is called with the "inactive_and_active" version of the filters, because + ! the variables computed here are needed over inactive points that might later become + ! active (due to landuse change). Thus, this routine cannot depend on variables that are + ! only computed over active points. + ! + ! !USES: + use shr_orb_mod , only : shr_orb_decl, shr_orb_cosz + use clm_varcon , only : sb + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv, icol_road_imperv + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban patches in clump + integer , intent(in) :: filter_urbanp(:) ! urban pft filter + type(waterstate_type) , intent(in) :: waterstate_inst + type(urbanparams_type) , intent(inout) :: urbanparams_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(surfalb_type) , intent(inout) :: surfalb_inst + ! + ! !LOCAL VARIABLES: + integer :: fl,fp,fc,g,l,p,c,ib ! indices + integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + integer :: num_solar ! counter + real(r8) :: coszen (bounds%begl:bounds%endl) ! cosine solar zenith angle for next time step (landunit) + real(r8) :: zen (bounds%begl:bounds%endl) ! solar zenith angle (radians) + real(r8) :: sdir (bounds%begl:bounds%endl, numrad) ! direct beam solar radiation on horizontal surface + real(r8) :: sdif (bounds%begl:bounds%endl, numrad) ! diffuse solar radiation on horizontal surface + real(r8) :: sdir_road (bounds%begl:bounds%endl, numrad) ! direct beam solar radiation incident on road + real(r8) :: sdif_road (bounds%begl:bounds%endl, numrad) ! diffuse solar radiation incident on road + real(r8) :: sdir_sunwall (bounds%begl:bounds%endl, numrad) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8) :: sdif_sunwall (bounds%begl:bounds%endl, numrad) ! diffuse solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8) :: sdir_shadewall (bounds%begl:bounds%endl, numrad) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8) :: sdif_shadewall (bounds%begl:bounds%endl, numrad) ! diffuse solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8) :: albsnd_roof (bounds%begl:bounds%endl, numrad) ! snow albedo for roof (direct) + real(r8) :: albsni_roof (bounds%begl:bounds%endl, numrad) ! snow albedo for roof (diffuse) + real(r8) :: albsnd_improad (bounds%begl:bounds%endl, numrad) ! snow albedo for impervious road (direct) + real(r8) :: albsni_improad (bounds%begl:bounds%endl, numrad) ! snow albedo for impervious road (diffuse) + real(r8) :: albsnd_perroad (bounds%begl:bounds%endl, numrad) ! snow albedo for pervious road (direct) + real(r8) :: albsni_perroad (bounds%begl:bounds%endl, numrad) ! snow albedo for pervious road (diffuse) + real(r8) :: alb_roof_dir_s (bounds%begl:bounds%endl, numrad) ! direct roof albedo with snow effects + real(r8) :: alb_roof_dif_s (bounds%begl:bounds%endl, numrad) ! diffuse roof albedo with snow effects + real(r8) :: alb_improad_dir_s (bounds%begl:bounds%endl, numrad) ! direct impervious road albedo with snow effects + real(r8) :: alb_perroad_dir_s (bounds%begl:bounds%endl, numrad) ! direct pervious road albedo with snow effects + real(r8) :: alb_improad_dif_s (bounds%begl:bounds%endl, numrad) ! diffuse impervious road albedo with snow effects + real(r8) :: alb_perroad_dif_s (bounds%begl:bounds%endl, numrad) ! diffuse pervious road albedo with snow effects + real(r8) :: sref_roof_dir (bounds%begl:bounds%endl, numrad) ! direct solar reflected by roof per unit ground area per unit incident flux + real(r8) :: sref_roof_dif (bounds%begl:bounds%endl, numrad) ! diffuse solar reflected by roof per unit ground area per unit incident flux + real(r8) :: sref_sunwall_dir (bounds%begl:bounds%endl, numrad) ! direct solar reflected by sunwall per unit wall area per unit incident flux + real(r8) :: sref_sunwall_dif (bounds%begl:bounds%endl, numrad) ! diffuse solar reflected by sunwall per unit wall area per unit incident flux + real(r8) :: sref_shadewall_dir (bounds%begl:bounds%endl, numrad) ! direct solar reflected by shadewall per unit wall area per unit incident flux + real(r8) :: sref_shadewall_dif (bounds%begl:bounds%endl, numrad) ! diffuse solar reflected by shadewall per unit wall area per unit incident flux + real(r8) :: sref_improad_dir (bounds%begl:bounds%endl, numrad) ! direct solar reflected by impervious road per unit ground area per unit incident flux + real(r8) :: sref_improad_dif (bounds%begl:bounds%endl, numrad) ! diffuse solar reflected by impervious road per unit ground area per unit incident flux + real(r8) :: sref_perroad_dir (bounds%begl:bounds%endl, numrad) ! direct solar reflected by pervious road per unit ground area per unit incident flux + real(r8) :: sref_perroad_dif (bounds%begl:bounds%endl, numrad) ! diffuse solar reflected by pervious road per unit ground area per unit incident flux + !----------------------------------------------------------------------- + + associate( & + ctype => col%itype , & ! Input: [integer (:) ] column type + coli => lun%coli , & ! Input: [integer (:) ] beginning column index for landunit + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:) ] ratio of building height to street width + wtroad_perv => lun%wtroad_perv , & ! Input: [real(r8) (:) ] weight of pervious road wrt total road + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + + alb_roof_dir => urbanparams_inst%alb_roof_dir , & ! Output: [real(r8) (:,:) ] direct roof albedo + alb_roof_dif => urbanparams_inst%alb_roof_dif , & ! Output: [real(r8) (:,:) ] diffuse roof albedo + alb_improad_dir => urbanparams_inst%alb_improad_dir , & ! Output: [real(r8) (:,:) ] direct impervious road albedo + alb_improad_dif => urbanparams_inst%alb_improad_dif , & ! Output: [real(r8) (:,:) ] diffuse imprevious road albedo + alb_perroad_dir => urbanparams_inst%alb_perroad_dir , & ! Output: [real(r8) (:,:) ] direct pervious road albedo + alb_perroad_dif => urbanparams_inst%alb_perroad_dif , & ! Output: [real(r8) (:,:) ] diffuse pervious road albedo + alb_wall_dir => urbanparams_inst%alb_wall_dir , & ! Output: [real(r8) (:,:) ] direct wall albedo + alb_wall_dif => urbanparams_inst%alb_wall_dif , & ! Output: [real(r8) (:,:) ] diffuse wall albedo + + sabs_roof_dir => solarabs_inst%sabs_roof_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by roof per unit ground area per unit incident flux + sabs_roof_dif => solarabs_inst%sabs_roof_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by roof per unit ground area per unit incident flux + sabs_sunwall_dir => solarabs_inst%sabs_sunwall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by sunwall per unit wall area per unit incident flux + sabs_sunwall_dif => solarabs_inst%sabs_sunwall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by sunwall per unit wall area per unit incident flux + sabs_shadewall_dir => solarabs_inst%sabs_shadewall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by shadewall per unit wall area per unit incident flux + sabs_shadewall_dif => solarabs_inst%sabs_shadewall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by shadewall per unit wall area per unit incident flux + sabs_improad_dir => solarabs_inst%sabs_improad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by impervious road per unit ground area per unit incident flux + sabs_improad_dif => solarabs_inst%sabs_improad_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by impervious road per unit ground area per unit incident flux + sabs_perroad_dir => solarabs_inst%sabs_perroad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by pervious road per unit ground area per unit incident flux + sabs_perroad_dif => solarabs_inst%sabs_perroad_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by pervious road per unit ground area per unit incident flux + + fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux + fabd_sun => surfalb_inst%fabd_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit direct flux + fabd_sha => surfalb_inst%fabd_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit direct flux + fabi => surfalb_inst%fabi_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit diffuse flux + fabi_sun => surfalb_inst%fabi_sun_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by sunlit canopy per unit diffuse flux + fabi_sha => surfalb_inst%fabi_sha_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by shaded canopy per unit diffuse flux + ftdd => surfalb_inst%ftdd_patch , & ! Output: [real(r8) (:,:) ] down direct flux below canopy per unit direct flux + ftid => surfalb_inst%ftid_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit direct flux + ftii => surfalb_inst%ftii_patch , & ! Output: [real(r8) (:,:) ] down diffuse flux below canopy per unit diffuse flux + albgrd => surfalb_inst%albgrd_col , & ! Output: [real(r8) (:,:) ] urban col ground albedo (direct) + albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] urban col ground albedo (diffuse) + albd => surfalb_inst%albd_patch , & ! Output [real(r8) (:,:) ] urban pft surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] urban pft surface albedo (diffuse) + + begl => bounds%begl , & + endl => bounds%endl & + ) + + ! ---------------------------------------------------------------------------- + ! Solar declination and cosine solar zenith angle and zenith angle for + ! next time step + ! ---------------------------------------------------------------------------- + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + coszen(l) = surfalb_inst%coszen_col(coli(l)) ! Assumes coszen for each column are the same + zen(l) = acos(coszen(l)) + end do + + ! Initialize output because solar radiation only done if coszen > 0 + + do ib = 1, numrad + do fc = 1,num_urbanc + c = filter_urbanc(fc) + albgrd(c,ib) = 0._r8 + albgri(c,ib) = 0._r8 + end do + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + l = patch%landunit(p) + albd(p,ib) = 1._r8 + albi(p,ib) = 1._r8 + fabd(p,ib) = 0._r8 + fabd_sun(p,ib) = 0._r8 + fabd_sha(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + fabi_sun(p,ib) = 0._r8 + fabi_sha(p,ib) = 0._r8 + if (coszen(l) > 0._r8) then + ftdd(p,ib) = 1._r8 + else + ftdd(p,ib) = 0._r8 + end if + ftid(p,ib) = 0._r8 + if (coszen(l) > 0._r8) then + ftii(p,ib) = 1._r8 + else + ftii(p,ib) = 0._r8 + end if + end do + end do + + ! ---------------------------------------------------------------------------- + ! Urban Code + ! ---------------------------------------------------------------------------- + + num_solar = 0 + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) num_solar = num_solar + 1 + end do + + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + sabs_roof_dir(l,ib) = 0._r8 + sabs_roof_dif(l,ib) = 0._r8 + sabs_sunwall_dir(l,ib) = 0._r8 + sabs_sunwall_dif(l,ib) = 0._r8 + sabs_shadewall_dir(l,ib) = 0._r8 + sabs_shadewall_dif(l,ib) = 0._r8 + sabs_improad_dir(l,ib) = 0._r8 + sabs_improad_dif(l,ib) = 0._r8 + sabs_perroad_dir(l,ib) = 0._r8 + sabs_perroad_dif(l,ib) = 0._r8 + sref_roof_dir(l,ib) = 1._r8 + sref_roof_dif(l,ib) = 1._r8 + sref_sunwall_dir(l,ib) = 1._r8 + sref_sunwall_dif(l,ib) = 1._r8 + sref_shadewall_dir(l,ib) = 1._r8 + sref_shadewall_dif(l,ib) = 1._r8 + sref_improad_dir(l,ib) = 1._r8 + sref_improad_dif(l,ib) = 1._r8 + sref_perroad_dir(l,ib) = 1._r8 + sref_perroad_dif(l,ib) = 1._r8 + end do + end do + + ! ---------------------------------------------------------------------------- + ! Only do the rest if all coszen are positive + ! ---------------------------------------------------------------------------- + + if (num_solar > 0)then + + ! Set constants - solar fluxes are per unit incoming flux + + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + sdir(l,ib) = 1._r8 + sdif(l,ib) = 1._r8 + end do + end do + + ! Incident direct beam radiation for + ! (a) roof and (b) road and both walls in urban canyon + + if (num_urbanl > 0) then + call incident_direct (bounds, & + num_urbanl, filter_urbanl, & + canyon_hwr(begl:endl), & + coszen(begl:endl), & + zen(begl:endl), & + sdir(begl:endl, :), & + sdir_road(begl:endl, :), & + sdir_sunwall(begl:endl, :), & + sdir_shadewall(begl:endl, :)) + end if + + ! Incident diffuse radiation for + ! (a) roof and (b) road and both walls in urban canyon. + + if (num_urbanl > 0) then + call incident_diffuse (bounds, & + num_urbanl, filter_urbanl, & + canyon_hwr(begl:endl), & + sdif(begl:endl, :), & + sdif_road(begl:endl, :), & + sdif_sunwall(begl:endl, :), & + sdif_shadewall(begl:endl, :), & + urbanparams_inst) + end if + + ! Get snow albedos for roof and impervious and pervious road + if (num_urbanl > 0) then + ic = 0 + call SnowAlbedo(bounds, & + num_urbanc, filter_urbanc, & + coszen(begl:endl), & + ic, & + albsnd_roof(begl:endl, :), & + albsnd_improad(begl:endl, :), & + albsnd_perroad(begl:endl, :), & + waterstate_inst) + + ic = 1 + call SnowAlbedo(bounds, & + num_urbanc, filter_urbanc, & + coszen(begl:endl), & + ic, & + albsni_roof(begl:endl, :), & + albsni_improad(begl:endl, :), & + albsni_perroad(begl:endl, :), & + waterstate_inst) + end if + + ! Combine snow-free and snow albedos + do ib = 1,numrad + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + if (ctype(c) == icol_roof) then + alb_roof_dir_s(l,ib) = alb_roof_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_roof(l,ib)*frac_sno(c) + alb_roof_dif_s(l,ib) = alb_roof_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_roof(l,ib)*frac_sno(c) + else if (ctype(c) == icol_road_imperv) then + alb_improad_dir_s(l,ib) = alb_improad_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_improad(l,ib)*frac_sno(c) + alb_improad_dif_s(l,ib) = alb_improad_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_improad(l,ib)*frac_sno(c) + else if (ctype(c) == icol_road_perv) then + alb_perroad_dir_s(l,ib) = alb_perroad_dir(l,ib)*(1._r8-frac_sno(c)) & + + albsnd_perroad(l,ib)*frac_sno(c) + alb_perroad_dif_s(l,ib) = alb_perroad_dif(l,ib)*(1._r8-frac_sno(c)) & + + albsni_perroad(l,ib)*frac_sno(c) + end if + end do + end do + + ! Reflected and absorbed solar radiation per unit incident radiation + ! for road and both walls in urban canyon allowing for multiple reflection + ! Reflected and absorbed solar radiation per unit incident radiation for roof + + if (num_urbanl > 0) then + call net_solar (bounds, & + num_urbanl, filter_urbanl, & + coszen (begl:endl), & + canyon_hwr (begl:endl), & + wtroad_perv (begl:endl), & + sdir (begl:endl, :), & + sdif (begl:endl, :), & + alb_improad_dir_s (begl:endl, :), & + alb_perroad_dir_s (begl:endl, :), & + alb_wall_dir (begl:endl, :), & + alb_roof_dir_s (begl:endl, :), & + alb_improad_dif_s (begl:endl, :), & + alb_perroad_dif_s (begl:endl, :), & + alb_wall_dif (begl:endl, :), & + alb_roof_dif_s (begl:endl, :), & + sdir_road (begl:endl, :), & + sdir_sunwall (begl:endl, :), & + sdir_shadewall (begl:endl, :), & + sdif_road (begl:endl, :), & + sdif_sunwall (begl:endl, :), & + sdif_shadewall (begl:endl, :), & + sref_improad_dir (begl:endl, :), & + sref_perroad_dir (begl:endl, :), & + sref_sunwall_dir (begl:endl, :), & + sref_shadewall_dir (begl:endl, :), & + sref_roof_dir (begl:endl, :), & + sref_improad_dif (begl:endl, :), & + sref_perroad_dif (begl:endl, :), & + sref_sunwall_dif (begl:endl, :), & + sref_shadewall_dif (begl:endl, :), & + sref_roof_dif (begl:endl, :), & + urbanparams_inst, solarabs_inst) + end if + + ! ---------------------------------------------------------------------------- + ! Map urban output to surfalb_inst components + ! ---------------------------------------------------------------------------- + + ! Set albgrd and albgri (ground albedos) and albd and albi (surface albedos) + + do ib = 1,numrad + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + if (ctype(c) == icol_roof) then + albgrd(c,ib) = sref_roof_dir(l,ib) + albgri(c,ib) = sref_roof_dif(l,ib) + else if (ctype(c) == icol_sunwall) then + albgrd(c,ib) = sref_sunwall_dir(l,ib) + albgri(c,ib) = sref_sunwall_dif(l,ib) + else if (ctype(c) == icol_shadewall) then + albgrd(c,ib) = sref_shadewall_dir(l,ib) + albgri(c,ib) = sref_shadewall_dif(l,ib) + else if (ctype(c) == icol_road_perv) then + albgrd(c,ib) = sref_perroad_dir(l,ib) + albgri(c,ib) = sref_perroad_dif(l,ib) + else if (ctype(c) == icol_road_imperv) then + albgrd(c,ib) = sref_improad_dir(l,ib) + albgri(c,ib) = sref_improad_dif(l,ib) + endif + end do + do fp = 1,num_urbanp + p = filter_urbanp(fp) + c = patch%column(p) + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + end do + end do + end if + + end associate + + end subroutine UrbanAlbedo + + !----------------------------------------------------------------------- + subroutine SnowAlbedo (bounds , & + num_urbanc, filter_urbanc, coszen, ind , & + albsn_roof, albsn_improad, albsn_perroad, & + waterstate_inst) + ! + ! !DESCRIPTION: + ! Determine urban snow albedos + ! + ! !USES: + use column_varcon, only : icol_roof, icol_road_perv, icol_road_imperv + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + integer , intent(in) :: ind ! 0=direct beam, 1=diffuse radiation + real(r8), intent(in) :: coszen ( bounds%begl: ) ! cosine solar zenith angle [landunit] + real(r8), intent(out):: albsn_roof ( bounds%begl: , 1: ) ! roof snow albedo by waveband [landunit, numrad] + real(r8), intent(out):: albsn_improad ( bounds%begl: , 1: ) ! impervious road snow albedo by waveband [landunit, numrad] + real(r8), intent(out):: albsn_perroad ( bounds%begl: , 1: ) ! pervious road snow albedo by waveband [landunit, numrad] + type(waterstate_type), intent(in) :: waterstate_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c,l ! indices + ! + ! These values are derived from Marshall (1989) assuming soot content of 1.5e-5 + ! (three times what LSM uses globally). Note that snow age effects are ignored here. + real(r8), parameter :: snal0 = 0.66_r8 ! vis albedo of urban snow + real(r8), parameter :: snal1 = 0.56_r8 ! nir albedo of urban snow + !----------------------------------------------------------------------- + + ! this code assumes that numrad = 2 , with the following + ! index values: 1 = visible, 2 = NIR + SHR_ASSERT_ALL(numrad == 2, errMsg(__FILE__, __LINE__)) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsn_roof) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsn_improad) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(albsn_perroad) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + + associate( & + h2osno => waterstate_inst%h2osno_col & ! Input: [real(r8) (:) ] snow water (mm H2O) + ) + + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + if (coszen(l) > 0._r8 .and. h2osno(c) > 0._r8) then + if (col%itype(c) == icol_roof) then + albsn_roof(l,1) = snal0 + albsn_roof(l,2) = snal1 + else if (col%itype(c) == icol_road_imperv) then + albsn_improad(l,1) = snal0 + albsn_improad(l,2) = snal1 + else if (col%itype(c) == icol_road_perv) then + albsn_perroad(l,1) = snal0 + albsn_perroad(l,2) = snal1 + end if + else + if (col%itype(c) == icol_roof) then + albsn_roof(l,1) = 0._r8 + albsn_roof(l,2) = 0._r8 + else if (col%itype(c) == icol_road_imperv) then + albsn_improad(l,1) = 0._r8 + albsn_improad(l,2) = 0._r8 + else if (col%itype(c) == icol_road_perv) then + albsn_perroad(l,1) = 0._r8 + albsn_perroad(l,2) = 0._r8 + end if + end if + end do + + end associate + + end subroutine SnowAlbedo + + !----------------------------------------------------------------------- + subroutine incident_direct (bounds , & + num_urbanl, filter_urbanl, canyon_hwr, coszen, zen , & + sdir, sdir_road, sdir_sunwall, sdir_shadewall) + ! + ! !DESCRIPTION: + ! Direct beam solar radiation incident on walls and road in urban canyon + ! + ! Sun + ! / + ! roof / + ! ------ /--- - + ! | / | | + ! sunlit wall | / | shaded wall h + ! | / | | + ! -----/----- - + ! road + ! <--- w ---> + ! + ! Method: + ! Road = Horizontal surface. Account for shading by wall. Integrate over all canyon orientations + ! Wall (sunlit) = Adjust horizontal radiation for 90 degree surface. Account for shading by opposing wall. + ! Integrate over all canyon orientations + ! Wall (shaded) = 0 + ! + ! Conservation check: Total incoming direct beam (sdir) = sdir_road + (sdir_shadewall + sdir_sunwall)*canyon_hwr + ! Multiplication by canyon_hwr scales wall fluxes (per unit wall area) to per unit ground area + ! + ! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in + ! atmospheric models. Boundary-Layer Meteorology 94:357-397 + ! + ! This analytical solution from Masson (2000) agrees with the numerical solution to + ! within 0.6 W/m**2 for sdir = 1000 W/m**2 and for all H/W from 0.1 to 10 by 0.1 + ! and all solar zenith angles from 1 to 90 deg by 1 + ! + ! !USES: + use clm_varcon, only : rpi + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8), intent(in) :: canyon_hwr( bounds%begl: ) ! ratio of building height to street width [landunit] + real(r8), intent(in) :: coszen( bounds%begl: ) ! cosine solar zenith angle [landunit] + real(r8), intent(in) :: zen( bounds%begl: ) ! solar zenith angle (radians) [landunit] + real(r8), intent(in) :: sdir( bounds%begl: , 1: ) ! direct beam solar radiation incident on horizontal surface [landunit, numrad] + real(r8), intent(out) :: sdir_road( bounds%begl: , 1: ) ! direct beam solar radiation incident on road per unit incident flux [landunit, numrad] + real(r8), intent(out) :: sdir_sunwall( bounds%begl: , 1: ) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux [landunit, numrad] + real(r8), intent(out) :: sdir_shadewall( bounds%begl: , 1: ) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux [landunit, numrad] + ! + ! !LOCAL VARIABLES: + integer :: fl,l,i,ib ! indices + logical :: numchk = .false. ! true => perform numerical check of analytical solution + real(r8) :: theta0(bounds%begl:bounds%endl) ! critical canyon orientation for which road is no longer illuminated + real(r8) :: tanzen(bounds%begl:bounds%endl) ! tan(zenith angle) + real(r8) :: swall_projected ! direct beam solar radiation (per unit ground area) incident on wall + real(r8) :: err1(bounds%begl:bounds%endl) ! energy conservation error + real(r8) :: err2(bounds%begl:bounds%endl) ! energy conservation error + real(r8) :: err3(bounds%begl:bounds%endl) ! energy conservation error + real(r8) :: sumr ! sum of sroad for each orientation (0 <= theta <= pi/2) + real(r8) :: sumw ! sum of swall for each orientation (0 <= theta <= pi/2) + real(r8) :: num ! number of orientations + real(r8) :: theta ! canyon orientation relative to sun (0 <= theta <= pi/2) + real(r8) :: zen0 ! critical solar zenith angle for which sun begins to illuminate road + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(canyon_hwr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(zen) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_road) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_sunwall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_shadewall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + theta0(l) = asin(min( (1._r8/(canyon_hwr(l)*tan(max(zen(l),0.000001_r8)))), 1._r8 )) + tanzen(l) = tan(zen(l)) + end if + end do + + do ib = 1,numrad + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + sdir_shadewall(l,ib) = 0._r8 + + ! incident solar radiation on wall and road integrated over all canyon orientations (0 <= theta <= pi/2) + + sdir_road(l,ib) = sdir(l,ib) * & + (2._r8*theta0(l)/rpi - 2./rpi*canyon_hwr(l)*tanzen(l)*(1._r8-cos(theta0(l)))) + sdir_sunwall(l,ib) = 2._r8 * sdir(l,ib) * ((1._r8/canyon_hwr(l))* & + (0.5_r8-theta0(l)/rpi) + (1._r8/rpi)*tanzen(l)*(1._r8-cos(theta0(l)))) + + ! conservation check for road and wall. need to use wall fluxes converted to ground area + + swall_projected = (sdir_shadewall(l,ib) + sdir_sunwall(l,ib)) * canyon_hwr(l) + err1(l) = sdir(l,ib) - (sdir_road(l,ib) + swall_projected) + else + sdir_road(l,ib) = 0._r8 + sdir_sunwall(l,ib) = 0._r8 + sdir_shadewall(l,ib) = 0._r8 + endif + end do + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + if (abs(err1(l)) > 0.001_r8) then + write (iulog,*) 'urban direct beam solar radiation balance error',err1(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + endif + end do + + ! numerical check of analytical solution + ! sum sroad and swall over all canyon orientations (0 <= theta <= pi/2) + + if (numchk) then + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + sumr = 0._r8 + sumw = 0._r8 + num = 0._r8 + do i = 1, 9000 + theta = i/100._r8 * rpi/180._r8 + zen0 = atan(1._r8/(canyon_hwr(l)*sin(theta))) + if (zen(l) >= zen0) then + sumr = sumr + 0._r8 + sumw = sumw + sdir(l,ib) / canyon_hwr(l) + else + sumr = sumr + sdir(l,ib) * (1._r8-canyon_hwr(l)*sin(theta)*tanzen(l)) + sumw = sumw + sdir(l,ib) * sin(theta)*tanzen(l) + end if + num = num + 1._r8 + end do + err2(l) = sumr/num - sdir_road(l,ib) + err3(l) = sumw/num - sdir_sunwall(l,ib) + endif + end do + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + if (abs(err2(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban road incident direct beam solar radiation error',err2(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + if (abs(err3(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban wall incident direct beam solar radiation error',err3(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + end if + end do + end if + + end do + + end subroutine incident_direct + + !----------------------------------------------------------------------- + subroutine incident_diffuse (bounds, & + num_urbanl, filter_urbanl, canyon_hwr, & + sdif, sdif_road, sdif_sunwall, sdif_shadewall, & + urbanparams_inst) + ! + ! !DESCRIPTION: + ! Diffuse solar radiation incident on walls and road in urban canyon + ! Conservation check: Total incoming diffuse + ! (sdif) = sdif_road + (sdif_shadewall + sdif_sunwall)*canyon_hwr + ! Multiplication by canyon_hwr scales wall fluxes (per unit wall area) to per unit ground area + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8) , intent(in) :: canyon_hwr ( bounds%begl: ) ! ratio of building height to street width [landunit] + real(r8) , intent(in) :: sdif ( bounds%begl: , 1: ) ! diffuse solar radiation incident on horizontal surface [landunit, numrad] + real(r8) , intent(out) :: sdif_road ( bounds%begl: , 1: ) ! diffuse solar radiation incident on road [landunit, numrad] + real(r8) , intent(out) :: sdif_sunwall ( bounds%begl: , 1: ) ! diffuse solar radiation (per unit wall area) incident on sunlit wall [landunit, numrad] + real(r8) , intent(out) :: sdif_shadewall ( bounds%begl: , 1: ) ! diffuse solar radiation (per unit wall area) incident on shaded wall [landunit, numrad] + type(urbanparams_type), intent(in) :: urbanparams_inst + ! + ! !LOCAL VARIABLES: + integer :: l, fl, ib ! indices + real(r8) :: err(bounds%begl:bounds%endl) ! energy conservation error (W/m**2) + real(r8) :: swall_projected ! diffuse solar radiation (per unit ground area) incident on wall (W/m**2) + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(canyon_hwr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_road) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_sunwall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_shadewall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + + associate( & + vf_sr => urbanparams_inst%vf_sr , & ! Input: [real(r8) (:) ] view factor of sky for road + vf_sw => urbanparams_inst%vf_sw & ! Input: [real(r8) (:) ] view factor of sky for one wall + ) + + do ib = 1, numrad + + ! diffuse solar and conservation check. need to convert wall fluxes to ground area + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + sdif_road(l,ib) = sdif(l,ib) * vf_sr(l) + sdif_sunwall(l,ib) = sdif(l,ib) * vf_sw(l) + sdif_shadewall(l,ib) = sdif(l,ib) * vf_sw(l) + + swall_projected = (sdif_shadewall(l,ib) + sdif_sunwall(l,ib)) * canyon_hwr(l) + err(l) = sdif(l,ib) - (sdif_road(l,ib) + swall_projected) + end do + + ! error check + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + if (abs(err(l)) > 0.001_r8) then + write (iulog,*) 'urban diffuse solar radiation balance error',err(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + end do + + end do + + end associate + + end subroutine incident_diffuse + + !----------------------------------------------------------------------- + subroutine net_solar (bounds , & + num_urbanl, filter_urbanl, coszen, canyon_hwr, wtroad_perv, sdir, sdif , & + alb_improad_dir, alb_perroad_dir, alb_wall_dir, alb_roof_dir , & + alb_improad_dif, alb_perroad_dif, alb_wall_dif, alb_roof_dif , & + sdir_road, sdir_sunwall, sdir_shadewall, & + sdif_road, sdif_sunwall, sdif_shadewall, & + sref_improad_dir, sref_perroad_dir, sref_sunwall_dir, sref_shadewall_dir, sref_roof_dir , & + sref_improad_dif, sref_perroad_dif, sref_sunwall_dif, sref_shadewall_dif, sref_roof_dif , & + urbanparams_inst, solarabs_inst) + ! + ! !DESCRIPTION: + ! Solar radiation absorbed by road and both walls in urban canyon allowing + ! for multiple reflection. + ! + ! !ARGUMENTS: + type (bounds_type), intent(in) :: bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8), intent(in) :: coszen ( bounds%begl: ) ! cosine solar zenith angle [landunit] + real(r8), intent(in) :: canyon_hwr ( bounds%begl: ) ! ratio of building height to street width [landunit] + real(r8), intent(in) :: wtroad_perv ( bounds%begl: ) ! weight of pervious road wrt total road [landunit] + real(r8), intent(in) :: sdir ( bounds%begl: , 1: ) ! direct beam solar radiation incident on horizontal surface [landunit, numrad] + real(r8), intent(in) :: sdif ( bounds%begl: , 1: ) ! diffuse solar radiation on horizontal surface [landunit, numrad] + real(r8), intent(in) :: alb_improad_dir ( bounds%begl: , 1: ) ! direct impervious road albedo [landunit, numrad] + real(r8), intent(in) :: alb_perroad_dir ( bounds%begl: , 1: ) ! direct pervious road albedo [landunit, numrad] + real(r8), intent(in) :: alb_wall_dir ( bounds%begl: , 1: ) ! direct wall albedo [landunit, numrad] + real(r8), intent(in) :: alb_roof_dir ( bounds%begl: , 1: ) ! direct roof albedo [landunit, numrad] + real(r8), intent(in) :: alb_improad_dif ( bounds%begl: , 1: ) ! diffuse impervious road albedo [landunit, numrad] + real(r8), intent(in) :: alb_perroad_dif ( bounds%begl: , 1: ) ! diffuse pervious road albedo [landunit, numrad] + real(r8), intent(in) :: alb_wall_dif ( bounds%begl: , 1: ) ! diffuse wall albedo [landunit, numrad] + real(r8), intent(in) :: alb_roof_dif ( bounds%begl: , 1: ) ! diffuse roof albedo [landunit, numrad] + real(r8), intent(in) :: sdir_road ( bounds%begl: , 1: ) ! direct beam solar radiation incident on road per unit incident flux [landunit, numrad] + real(r8), intent(in) :: sdir_sunwall ( bounds%begl: , 1: ) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux [landunit, numrad] + real(r8), intent(in) :: sdir_shadewall ( bounds%begl: , 1: ) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux [landunit, numrad] + real(r8), intent(in) :: sdif_road ( bounds%begl: , 1: ) ! diffuse solar radiation incident on road per unit incident flux [landunit, numrad] + real(r8), intent(in) :: sdif_sunwall ( bounds%begl: , 1: ) ! diffuse solar radiation (per unit wall area) incident on sunlit wall per unit incident flux [landunit, numrad] + real(r8), intent(in) :: sdif_shadewall ( bounds%begl: , 1: ) ! diffuse solar radiation (per unit wall area) incident on shaded wall per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_improad_dir ( bounds%begl: , 1: ) ! direct solar rad reflected by impervious road (per unit ground area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_perroad_dir ( bounds%begl: , 1: ) ! direct solar rad reflected by pervious road (per unit ground area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_improad_dif ( bounds%begl: , 1: ) ! diffuse solar rad reflected by impervious road (per unit ground area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_perroad_dif ( bounds%begl: , 1: ) ! diffuse solar rad reflected by pervious road (per unit ground area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_sunwall_dir ( bounds%begl: , 1: ) ! direct solar rad reflected by sunwall (per unit wall area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_sunwall_dif ( bounds%begl: , 1: ) ! diffuse solar rad reflected by sunwall (per unit wall area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_shadewall_dir ( bounds%begl: , 1: ) ! direct solar rad reflected by shadewall (per unit wall area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_shadewall_dif ( bounds%begl: , 1: ) ! diffuse solar rad reflected by shadewall (per unit wall area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_roof_dir ( bounds%begl: , 1: ) ! direct solar rad reflected by roof (per unit ground area) per unit incident flux [landunit, numrad] + real(r8), intent(inout) :: sref_roof_dif ( bounds%begl: , 1: ) ! diffuse solar rad reflected by roof (per unit ground area) per unit incident flux [landunit, numrad] + type(urbanparams_type), intent(in) :: urbanparams_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + ! + ! !LOCAL VARIABLES + real(r8) :: wtroad_imperv(bounds%begl:bounds%endl) ! weight of impervious road wrt total road + real(r8) :: sabs_canyon_dir(bounds%begl:bounds%endl) ! direct solar rad absorbed by canyon per unit incident flux + real(r8) :: sabs_canyon_dif(bounds%begl:bounds%endl) ! diffuse solar rad absorbed by canyon per unit incident flux + real(r8) :: sref_canyon_dir(bounds%begl:bounds%endl) ! direct solar reflected by canyon per unit incident flux + real(r8) :: sref_canyon_dif(bounds%begl:bounds%endl) ! diffuse solar reflected by canyon per unit incident flux + + real(r8) :: improad_a_dir(bounds%begl:bounds%endl) ! absorbed direct solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_a_dif(bounds%begl:bounds%endl) ! absorbed diffuse solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_dir(bounds%begl:bounds%endl) ! reflected direct solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_dif(bounds%begl:bounds%endl) ! reflected diffuse solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_sky_dir(bounds%begl:bounds%endl) ! improad_r_dir to sky per unit incident flux + real(r8) :: improad_r_sunwall_dir(bounds%begl:bounds%endl) ! improad_r_dir to sunlit wall per unit incident flux + real(r8) :: improad_r_shadewall_dir(bounds%begl:bounds%endl) ! improad_r_dir to shaded wall per unit incident flux + real(r8) :: improad_r_sky_dif(bounds%begl:bounds%endl) ! improad_r_dif to sky per unit incident flux + real(r8) :: improad_r_sunwall_dif(bounds%begl:bounds%endl) ! improad_r_dif to sunlit wall per unit incident flux + real(r8) :: improad_r_shadewall_dif(bounds%begl:bounds%endl) ! improad_r_dif to shaded wall per unit incident flux + + real(r8) :: perroad_a_dir(bounds%begl:bounds%endl) ! absorbed direct solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_a_dif(bounds%begl:bounds%endl) ! absorbed diffuse solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_dir(bounds%begl:bounds%endl) ! reflected direct solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_dif(bounds%begl:bounds%endl) ! reflected diffuse solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_sky_dir(bounds%begl:bounds%endl) ! perroad_r_dir to sky per unit incident flux + real(r8) :: perroad_r_sunwall_dir(bounds%begl:bounds%endl) ! perroad_r_dir to sunlit wall per unit incident flux + real(r8) :: perroad_r_shadewall_dir(bounds%begl:bounds%endl) ! perroad_r_dir to shaded wall per unit incident flux + real(r8) :: perroad_r_sky_dif(bounds%begl:bounds%endl) ! perroad_r_dif to sky per unit incident flux + real(r8) :: perroad_r_sunwall_dif(bounds%begl:bounds%endl) ! perroad_r_dif to sunlit wall per unit incident flux + real(r8) :: perroad_r_shadewall_dif(bounds%begl:bounds%endl) ! perroad_r_dif to shaded wall per unit incident flux + + real(r8) :: road_a_dir(bounds%begl:bounds%endl) ! absorbed direct solar for total road after "n" reflections per unit incident flux + real(r8) :: road_a_dif(bounds%begl:bounds%endl) ! absorbed diffuse solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_dir(bounds%begl:bounds%endl) ! reflected direct solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_dif(bounds%begl:bounds%endl) ! reflected diffuse solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_sky_dir(bounds%begl:bounds%endl) ! road_r_dir to sky per unit incident flux + real(r8) :: road_r_sunwall_dir(bounds%begl:bounds%endl) ! road_r_dir to sunlit wall per unit incident flux + real(r8) :: road_r_shadewall_dir(bounds%begl:bounds%endl) ! road_r_dir to shaded wall per unit incident flux + real(r8) :: road_r_sky_dif(bounds%begl:bounds%endl) ! road_r_dif to sky per unit incident flux + real(r8) :: road_r_sunwall_dif(bounds%begl:bounds%endl) ! road_r_dif to sunlit wall per unit incident flux + real(r8) :: road_r_shadewall_dif(bounds%begl:bounds%endl) ! road_r_dif to shaded wall per unit incident flux + + real(r8) :: sunwall_a_dir(bounds%begl:bounds%endl) ! absorbed direct solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_a_dif(bounds%begl:bounds%endl) ! absorbed diffuse solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_dir(bounds%begl:bounds%endl) ! reflected direct solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_dif(bounds%begl:bounds%endl) ! reflected diffuse solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_sky_dir(bounds%begl:bounds%endl) ! sunwall_r_dir to sky per unit incident flux + real(r8) :: sunwall_r_road_dir(bounds%begl:bounds%endl) ! sunwall_r_dir to road per unit incident flux + real(r8) :: sunwall_r_shadewall_dir(bounds%begl:bounds%endl) ! sunwall_r_dir to opposing (shaded) wall per unit incident flux + real(r8) :: sunwall_r_sky_dif(bounds%begl:bounds%endl) ! sunwall_r_dif to sky per unit incident flux + real(r8) :: sunwall_r_road_dif(bounds%begl:bounds%endl) ! sunwall_r_dif to road per unit incident flux + real(r8) :: sunwall_r_shadewall_dif(bounds%begl:bounds%endl) ! sunwall_r_dif to opposing (shaded) wall per unit incident flux + + real(r8) :: shadewall_a_dir(bounds%begl:bounds%endl) ! absorbed direct solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_a_dif(bounds%begl:bounds%endl) ! absorbed diffuse solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_dir(bounds%begl:bounds%endl) ! reflected direct solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_dif(bounds%begl:bounds%endl) ! reflected diffuse solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_sky_dir(bounds%begl:bounds%endl) ! shadewall_r_dir to sky per unit incident flux + real(r8) :: shadewall_r_road_dir(bounds%begl:bounds%endl) ! shadewall_r_dir to road per unit incident flux + real(r8) :: shadewall_r_sunwall_dir(bounds%begl:bounds%endl) ! shadewall_r_dir to opposing (sunlit) wall per unit incident flux + real(r8) :: shadewall_r_sky_dif(bounds%begl:bounds%endl) ! shadewall_r_dif to sky per unit incident flux + real(r8) :: shadewall_r_road_dif(bounds%begl:bounds%endl) ! shadewall_r_dif to road per unit incident flux + real(r8) :: shadewall_r_sunwall_dif(bounds%begl:bounds%endl) ! shadewall_r_dif to opposing (sunlit) wall per unit incident flux + + real(r8) :: canyon_alb_dir(bounds%begl:bounds%endl) ! direct canyon albedo + real(r8) :: canyon_alb_dif(bounds%begl:bounds%endl) ! diffuse canyon albedo + + real(r8) :: stot(bounds%begl:bounds%endl) ! sum of radiative terms + real(r8) :: stot_dir(bounds%begl:bounds%endl) ! sum of direct radiative terms + real(r8) :: stot_dif(bounds%begl:bounds%endl) ! sum of diffuse radiative terms + + integer :: l,fl,ib ! indices + integer :: iter_dir,iter_dif ! iteration counter + real(r8) :: crit ! convergence criterion + real(r8) :: err ! energy conservation error + integer :: pass + integer, parameter :: n = 50 ! number of interations + real(r8) :: sabs_road ! temporary for absorption over road + real(r8) :: sref_road ! temporary for reflected over road + real(r8), parameter :: errcrit = .00001_r8 ! error criteria + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(coszen) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(canyon_hwr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(wtroad_perv) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_improad_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_perroad_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_wall_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_roof_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_improad_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_perroad_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_wall_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(alb_roof_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_road) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_sunwall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdir_shadewall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_road) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_sunwall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sdif_shadewall) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_improad_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_perroad_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_improad_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_perroad_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_sunwall_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_sunwall_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_shadewall_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_shadewall_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_roof_dir) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sref_roof_dif) == (/bounds%endl, numrad/)), errMsg(__FILE__, __LINE__)) + + associate( & + vf_sr => urbanparams_inst%vf_sr , & ! Input: [real(r8) (:) ] view factor of sky for road + vf_wr => urbanparams_inst%vf_wr , & ! Input: [real(r8) (:) ] view factor of one wall for road + vf_sw => urbanparams_inst%vf_sw , & ! Input: [real(r8) (:) ] view factor of sky for one wall + vf_rw => urbanparams_inst%vf_rw , & ! Input: [real(r8) (:) ] view factor of road for one wall + vf_ww => urbanparams_inst%vf_ww , & ! Input: [real(r8) (:) ] view factor of opposing wall for one wall + + sabs_roof_dir => solarabs_inst%sabs_roof_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by roof per unit ground area per unit incident flux + sabs_roof_dif => solarabs_inst%sabs_roof_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by roof per unit ground area per unit incident flux + sabs_sunwall_dir => solarabs_inst%sabs_sunwall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by sunwall per unit wall area per unit incident flux + sabs_sunwall_dif => solarabs_inst%sabs_sunwall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by sunwall per unit wall area per unit incident flux + sabs_shadewall_dir => solarabs_inst%sabs_shadewall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by shadewall per unit wall area per unit incident flux + sabs_shadewall_dif => solarabs_inst%sabs_shadewall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by shadewall per unit wall area per unit incident flux + sabs_improad_dir => solarabs_inst%sabs_improad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by impervious road per unit ground area per unit incident flux + sabs_improad_dif => solarabs_inst%sabs_improad_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by impervious road per unit ground area per unit incident flux + sabs_perroad_dir => solarabs_inst%sabs_perroad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by pervious road per unit ground area per unit incident flux + sabs_perroad_dif => solarabs_inst%sabs_perroad_dif_lun & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by pervious road per unit ground area per unit incident flux + ) + + ! Calculate impervious road + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + wtroad_imperv(l) = 1._r8 - wtroad_perv(l) + end do + + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + + ! initial absorption and reflection for road and both walls. + ! distribute reflected radiation to sky, road, and walls + ! according to appropriate view factor. radiation reflected to + ! road and walls will undergo multiple reflections within the canyon. + ! do separately for direct beam and diffuse radiation. + + ! direct beam + + road_a_dir(l) = 0.0_r8 + road_r_dir(l) = 0.0_r8 + improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * sdir_road(l,ib) + improad_r_dir(l) = alb_improad_dir(l,ib) * sdir_road(l,ib) + improad_r_sky_dir(l) = improad_r_dir(l) * vf_sr(l) + improad_r_sunwall_dir(l) = improad_r_dir(l) * vf_wr(l) + improad_r_shadewall_dir(l) = improad_r_dir(l) * vf_wr(l) + road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) + road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) + + perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * sdir_road(l,ib) + perroad_r_dir(l) = alb_perroad_dir(l,ib) * sdir_road(l,ib) + perroad_r_sky_dir(l) = perroad_r_dir(l) * vf_sr(l) + perroad_r_sunwall_dir(l) = perroad_r_dir(l) * vf_wr(l) + perroad_r_shadewall_dir(l) = perroad_r_dir(l) * vf_wr(l) + road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) + road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) + + road_r_sky_dir(l) = road_r_dir(l) * vf_sr(l) + road_r_sunwall_dir(l) = road_r_dir(l) * vf_wr(l) + road_r_shadewall_dir(l) = road_r_dir(l) * vf_wr(l) + + sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_sunwall(l,ib) + sunwall_r_dir(l) = alb_wall_dir(l,ib) * sdir_sunwall(l,ib) + sunwall_r_sky_dir(l) = sunwall_r_dir(l) * vf_sw(l) + sunwall_r_road_dir(l) = sunwall_r_dir(l) * vf_rw(l) + sunwall_r_shadewall_dir(l) = sunwall_r_dir(l) * vf_ww(l) + + shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * sdir_shadewall(l,ib) + shadewall_r_dir(l) = alb_wall_dir(l,ib) * sdir_shadewall(l,ib) + shadewall_r_sky_dir(l) = shadewall_r_dir(l) * vf_sw(l) + shadewall_r_road_dir(l) = shadewall_r_dir(l) * vf_rw(l) + shadewall_r_sunwall_dir(l) = shadewall_r_dir(l) * vf_ww(l) + + ! diffuse + + road_a_dif(l) = 0.0_r8 + road_r_dif(l) = 0.0_r8 + improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * sdif_road(l,ib) + improad_r_dif(l) = alb_improad_dif(l,ib) * sdif_road(l,ib) + improad_r_sky_dif(l) = improad_r_dif(l) * vf_sr(l) + improad_r_sunwall_dif(l) = improad_r_dif(l) * vf_wr(l) + improad_r_shadewall_dif(l) = improad_r_dif(l) * vf_wr(l) + road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) + road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) + + perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * sdif_road(l,ib) + perroad_r_dif(l) = alb_perroad_dif(l,ib) * sdif_road(l,ib) + perroad_r_sky_dif(l) = perroad_r_dif(l) * vf_sr(l) + perroad_r_sunwall_dif(l) = perroad_r_dif(l) * vf_wr(l) + perroad_r_shadewall_dif(l) = perroad_r_dif(l) * vf_wr(l) + road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) + road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) + + road_r_sky_dif(l) = road_r_dif(l) * vf_sr(l) + road_r_sunwall_dif(l) = road_r_dif(l) * vf_wr(l) + road_r_shadewall_dif(l) = road_r_dif(l) * vf_wr(l) + + sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_sunwall(l,ib) + sunwall_r_dif(l) = alb_wall_dif(l,ib) * sdif_sunwall(l,ib) + sunwall_r_sky_dif(l) = sunwall_r_dif(l) * vf_sw(l) + sunwall_r_road_dif(l) = sunwall_r_dif(l) * vf_rw(l) + sunwall_r_shadewall_dif(l) = sunwall_r_dif(l) * vf_ww(l) + + shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * sdif_shadewall(l,ib) + shadewall_r_dif(l) = alb_wall_dif(l,ib) * sdif_shadewall(l,ib) + shadewall_r_sky_dif(l) = shadewall_r_dif(l) * vf_sw(l) + shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) + shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) + + ! initialize sum of direct and diffuse solar absorption and reflection for road and both walls + + sabs_improad_dir(l,ib) = improad_a_dir(l) + sabs_perroad_dir(l,ib) = perroad_a_dir(l) + sabs_sunwall_dir(l,ib) = sunwall_a_dir(l) + sabs_shadewall_dir(l,ib) = shadewall_a_dir(l) + + sabs_improad_dif(l,ib) = improad_a_dif(l) + sabs_perroad_dif(l,ib) = perroad_a_dif(l) + sabs_sunwall_dif(l,ib) = sunwall_a_dif(l) + sabs_shadewall_dif(l,ib) = shadewall_a_dif(l) + + sref_improad_dir(l,ib) = improad_r_sky_dir(l) + sref_perroad_dir(l,ib) = perroad_r_sky_dir(l) + sref_sunwall_dir(l,ib) = sunwall_r_sky_dir(l) + sref_shadewall_dir(l,ib) = shadewall_r_sky_dir(l) + + sref_improad_dif(l,ib) = improad_r_sky_dif(l) + sref_perroad_dif(l,ib) = perroad_r_sky_dif(l) + sref_sunwall_dif(l,ib) = sunwall_r_sky_dif(l) + sref_shadewall_dif(l,ib) = shadewall_r_sky_dif(l) + endif + + end do + + ! absorption and reflection for walls and road with multiple reflections + ! (i.e., absorb and reflect initial reflection in canyon and allow for + ! subsequent scattering) + ! + ! (1) absorption and reflection of scattered solar radiation + ! road: reflected fluxes from walls need to be projected to ground area + ! wall: reflected flux from road needs to be projected to wall area + ! + ! (2) add absorbed radiation for ith reflection to total absorbed + ! + ! (3) distribute reflected radiation to sky, road, and walls according to view factors + ! + ! (4) add solar reflection to sky for ith reflection to total reflection + ! + ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. + ! small convergence criteria is required to ensure solar radiation is conserved + ! + ! do separately for direct beam and diffuse + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + + ! reflected direct beam + + do iter_dir = 1, n + ! step (1) + + stot(l) = (sunwall_r_road_dir(l) + shadewall_r_road_dir(l))*canyon_hwr(l) + + road_a_dir(l) = 0.0_r8 + road_r_dir(l) = 0.0_r8 + improad_a_dir(l) = (1._r8-alb_improad_dir(l,ib)) * stot(l) + improad_r_dir(l) = alb_improad_dir(l,ib) * stot(l) + road_a_dir(l) = road_a_dir(l) + improad_a_dir(l)*wtroad_imperv(l) + road_r_dir(l) = road_r_dir(l) + improad_r_dir(l)*wtroad_imperv(l) + perroad_a_dir(l) = (1._r8-alb_perroad_dir(l,ib)) * stot(l) + perroad_r_dir(l) = alb_perroad_dir(l,ib) * stot(l) + road_a_dir(l) = road_a_dir(l) + perroad_a_dir(l)*wtroad_perv(l) + road_r_dir(l) = road_r_dir(l) + perroad_r_dir(l)*wtroad_perv(l) + + stot(l) = road_r_sunwall_dir(l)/canyon_hwr(l) + shadewall_r_sunwall_dir(l) + sunwall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) + sunwall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + + stot(l) = road_r_shadewall_dir(l)/canyon_hwr(l) + sunwall_r_shadewall_dir(l) + shadewall_a_dir(l) = (1._r8-alb_wall_dir(l,ib)) * stot(l) + shadewall_r_dir(l) = alb_wall_dir(l,ib) * stot(l) + + ! step (2) + + sabs_improad_dir(l,ib) = sabs_improad_dir(l,ib) + improad_a_dir(l) + sabs_perroad_dir(l,ib) = sabs_perroad_dir(l,ib) + perroad_a_dir(l) + sabs_sunwall_dir(l,ib) = sabs_sunwall_dir(l,ib) + sunwall_a_dir(l) + sabs_shadewall_dir(l,ib) = sabs_shadewall_dir(l,ib) + shadewall_a_dir(l) + + ! step (3) + + improad_r_sky_dir(l) = improad_r_dir(l) * vf_sr(l) + improad_r_sunwall_dir(l) = improad_r_dir(l) * vf_wr(l) + improad_r_shadewall_dir(l) = improad_r_dir(l) * vf_wr(l) + + perroad_r_sky_dir(l) = perroad_r_dir(l) * vf_sr(l) + perroad_r_sunwall_dir(l) = perroad_r_dir(l) * vf_wr(l) + perroad_r_shadewall_dir(l) = perroad_r_dir(l) * vf_wr(l) + + road_r_sky_dir(l) = road_r_dir(l) * vf_sr(l) + road_r_sunwall_dir(l) = road_r_dir(l) * vf_wr(l) + road_r_shadewall_dir(l) = road_r_dir(l) * vf_wr(l) + + sunwall_r_sky_dir(l) = sunwall_r_dir(l) * vf_sw(l) + sunwall_r_road_dir(l) = sunwall_r_dir(l) * vf_rw(l) + sunwall_r_shadewall_dir(l) = sunwall_r_dir(l) * vf_ww(l) + + shadewall_r_sky_dir(l) = shadewall_r_dir(l) * vf_sw(l) + shadewall_r_road_dir(l) = shadewall_r_dir(l) * vf_rw(l) + shadewall_r_sunwall_dir(l) = shadewall_r_dir(l) * vf_ww(l) + + ! step (4) + + sref_improad_dir(l,ib) = sref_improad_dir(l,ib) + improad_r_sky_dir(l) + sref_perroad_dir(l,ib) = sref_perroad_dir(l,ib) + perroad_r_sky_dir(l) + sref_sunwall_dir(l,ib) = sref_sunwall_dir(l,ib) + sunwall_r_sky_dir(l) + sref_shadewall_dir(l,ib) = sref_shadewall_dir(l,ib) + shadewall_r_sky_dir(l) + + ! step (5) + + crit = max(road_a_dir(l), sunwall_a_dir(l), shadewall_a_dir(l)) + if (crit < errcrit) exit + end do + if (iter_dir >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, direct beam' + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + + ! reflected diffuse + + do iter_dif = 1, n + ! step (1) + + stot(l) = (sunwall_r_road_dif(l) + shadewall_r_road_dif(l))*canyon_hwr(l) + road_a_dif(l) = 0.0_r8 + road_r_dif(l) = 0.0_r8 + improad_a_dif(l) = (1._r8-alb_improad_dif(l,ib)) * stot(l) + improad_r_dif(l) = alb_improad_dif(l,ib) * stot(l) + road_a_dif(l) = road_a_dif(l) + improad_a_dif(l)*wtroad_imperv(l) + road_r_dif(l) = road_r_dif(l) + improad_r_dif(l)*wtroad_imperv(l) + perroad_a_dif(l) = (1._r8-alb_perroad_dif(l,ib)) * stot(l) + perroad_r_dif(l) = alb_perroad_dif(l,ib) * stot(l) + road_a_dif(l) = road_a_dif(l) + perroad_a_dif(l)*wtroad_perv(l) + road_r_dif(l) = road_r_dif(l) + perroad_r_dif(l)*wtroad_perv(l) + + stot(l) = road_r_sunwall_dif(l)/canyon_hwr(l) + shadewall_r_sunwall_dif(l) + sunwall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) + sunwall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) + + stot(l) = road_r_shadewall_dif(l)/canyon_hwr(l) + sunwall_r_shadewall_dif(l) + shadewall_a_dif(l) = (1._r8-alb_wall_dif(l,ib)) * stot(l) + shadewall_r_dif(l) = alb_wall_dif(l,ib) * stot(l) + + ! step (2) + + sabs_improad_dif(l,ib) = sabs_improad_dif(l,ib) + improad_a_dif(l) + sabs_perroad_dif(l,ib) = sabs_perroad_dif(l,ib) + perroad_a_dif(l) + sabs_sunwall_dif(l,ib) = sabs_sunwall_dif(l,ib) + sunwall_a_dif(l) + sabs_shadewall_dif(l,ib) = sabs_shadewall_dif(l,ib) + shadewall_a_dif(l) + + ! step (3) + + improad_r_sky_dif(l) = improad_r_dif(l) * vf_sr(l) + improad_r_sunwall_dif(l) = improad_r_dif(l) * vf_wr(l) + improad_r_shadewall_dif(l) = improad_r_dif(l) * vf_wr(l) + + perroad_r_sky_dif(l) = perroad_r_dif(l) * vf_sr(l) + perroad_r_sunwall_dif(l) = perroad_r_dif(l) * vf_wr(l) + perroad_r_shadewall_dif(l) = perroad_r_dif(l) * vf_wr(l) + + road_r_sky_dif(l) = road_r_dif(l) * vf_sr(l) + road_r_sunwall_dif(l) = road_r_dif(l) * vf_wr(l) + road_r_shadewall_dif(l) = road_r_dif(l) * vf_wr(l) + + sunwall_r_sky_dif(l) = sunwall_r_dif(l) * vf_sw(l) + sunwall_r_road_dif(l) = sunwall_r_dif(l) * vf_rw(l) + sunwall_r_shadewall_dif(l) = sunwall_r_dif(l) * vf_ww(l) + + shadewall_r_sky_dif(l) = shadewall_r_dif(l) * vf_sw(l) + shadewall_r_road_dif(l) = shadewall_r_dif(l) * vf_rw(l) + shadewall_r_sunwall_dif(l) = shadewall_r_dif(l) * vf_ww(l) + + ! step (4) + + sref_improad_dif(l,ib) = sref_improad_dif(l,ib) + improad_r_sky_dif(l) + sref_perroad_dif(l,ib) = sref_perroad_dif(l,ib) + perroad_r_sky_dif(l) + sref_sunwall_dif(l,ib) = sref_sunwall_dif(l,ib) + sunwall_r_sky_dif(l) + sref_shadewall_dif(l,ib) = sref_shadewall_dif(l,ib) + shadewall_r_sky_dif(l) + + ! step (5) + + crit = max(road_a_dif(l), sunwall_a_dif(l), shadewall_a_dif(l)) + if (crit < errcrit) exit + end do + if (iter_dif >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, diffuse' + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + + ! total reflected by canyon - sum of solar reflection to sky from canyon. + ! project wall fluxes to horizontal surface + + sref_canyon_dir(l) = 0.0_r8 + sref_canyon_dif(l) = 0.0_r8 + sref_canyon_dir(l) = sref_canyon_dir(l) + sref_improad_dir(l,ib)*wtroad_imperv(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + sref_improad_dif(l,ib)*wtroad_imperv(l) + sref_canyon_dir(l) = sref_canyon_dir(l) + sref_perroad_dir(l,ib)*wtroad_perv(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + sref_perroad_dif(l,ib)*wtroad_perv(l) + sref_canyon_dir(l) = sref_canyon_dir(l) + (sref_sunwall_dir(l,ib) + sref_shadewall_dir(l,ib))*canyon_hwr(l) + sref_canyon_dif(l) = sref_canyon_dif(l) + (sref_sunwall_dif(l,ib) + sref_shadewall_dif(l,ib))*canyon_hwr(l) + + ! total absorbed by canyon. project wall fluxes to horizontal surface + + sabs_canyon_dir(l) = 0.0_r8 + sabs_canyon_dif(l) = 0.0_r8 + sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_improad_dir(l,ib)*wtroad_imperv(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_improad_dif(l,ib)*wtroad_imperv(l) + sabs_canyon_dir(l) = sabs_canyon_dir(l) + sabs_perroad_dir(l,ib)*wtroad_perv(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + sabs_perroad_dif(l,ib)*wtroad_perv(l) + sabs_canyon_dir(l) = sabs_canyon_dir(l) + (sabs_sunwall_dir(l,ib) + sabs_shadewall_dir(l,ib))*canyon_hwr(l) + sabs_canyon_dif(l) = sabs_canyon_dif(l) + (sabs_sunwall_dif(l,ib) + sabs_shadewall_dif(l,ib))*canyon_hwr(l) + + ! conservation check. note: previous conservation checks confirm partioning of total direct + ! beam and diffuse radiation from atmosphere to road and walls is conserved as + ! sdir (from atmosphere) = sdir_road + (sdir_sunwall + sdir_shadewall)*canyon_hwr + ! sdif (from atmosphere) = sdif_road + (sdif_sunwall + sdif_shadewall)*canyon_hwr + + stot_dir(l) = sdir_road(l,ib) + (sdir_sunwall(l,ib) + sdir_shadewall(l,ib))*canyon_hwr(l) + stot_dif(l) = sdif_road(l,ib) + (sdif_sunwall(l,ib) + sdif_shadewall(l,ib))*canyon_hwr(l) + + err = stot_dir(l) + stot_dif(l) & + - (sabs_canyon_dir(l) + sabs_canyon_dif(l) + sref_canyon_dir(l) + sref_canyon_dif(l)) + if (abs(err) > 0.001_r8 ) then + write(iulog,*)'urban net solar radiation balance error for ib=',ib,' err= ',err + write(iulog,*)' l= ',l,' ib= ',ib + write(iulog,*)' stot_dir = ',stot_dir(l) + write(iulog,*)' stot_dif = ',stot_dif(l) + write(iulog,*)' sabs_canyon_dir = ',sabs_canyon_dir(l) + write(iulog,*)' sabs_canyon_dif = ',sabs_canyon_dif(l) + write(iulog,*)' sref_canyon_dir = ',sref_canyon_dir(l) + write(iulog,*)' sref_canyon_dif = ',sref_canyon_dir(l) + write(iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + + ! canyon albedo + + canyon_alb_dif(l) = sref_canyon_dif(l) / max(stot_dif(l), 1.e-06_r8) + canyon_alb_dir(l) = sref_canyon_dir(l) / max(stot_dir(l), 1.e-06_r8) + end if + + end do ! end of landunit loop + + ! Refected and absorbed solar radiation per unit incident radiation for roof + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (coszen(l) > 0._r8) then + sref_roof_dir(l,ib) = alb_roof_dir(l,ib) * sdir(l,ib) + sref_roof_dif(l,ib) = alb_roof_dif(l,ib) * sdif(l,ib) + sabs_roof_dir(l,ib) = sdir(l,ib) - sref_roof_dir(l,ib) + sabs_roof_dif(l,ib) = sdif(l,ib) - sref_roof_dif(l,ib) + end if + end do + + end do ! end of radiation band loop + + end associate + + end subroutine net_solar + +end module UrbanAlbedoMod + diff --git a/components/clm/src/biogeophys/UrbanFluxesMod.F90 b/components/clm/src/biogeophys/UrbanFluxesMod.F90 new file mode 100644 index 0000000000..f2c208db22 --- /dev/null +++ b/components/clm/src/biogeophys/UrbanFluxesMod.F90 @@ -0,0 +1,1112 @@ +module UrbanFluxesMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate solar and longwave radiation, and turbulent fluxes for urban landunit + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : numrad + use clm_varcon , only : isecspday, degpsec, namel + use clm_varctl , only : iulog + use abortutils , only : endrun + use UrbanParamsType , only : urbanparams_type + use UrbanParamsType , only : urban_wasteheat_on, urban_hac_on, urban_hac + use UrbanParamsType , only : IsSimpleBuildTemp + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use FrictionVelocityMod , only : frictionvel_type + use EnergyFluxType , only : energyflux_type + use WaterfluxType , only : waterflux_type + use HumanIndexMod , only : humanindex_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanFluxes ! Urban physics - turbulent fluxes + !----------------------------------------------------------------------- + + ! !PRIVATE FUNCTIONS: + private :: wasteheat ! Figure out the energy flux from urban heating and cooling + private :: simple_wasteheatfromac ! Calculate waste heat from air-conditioning with the simpler method (CLM4.5) + private :: calc_simple_internal_building_temp ! Calculate internal building temperature by simpler method (CLM4.5) + +contains + + !----------------------------------------------------------------------- + subroutine UrbanFluxes (bounds, num_nourbanl, filter_nourbanl, & + num_urbanl, filter_urbanl, num_urbanc, filter_urbanc, num_urbanp, filter_urbanp, & + atm2lnd_inst, urbanparams_inst, soilstate_inst, temperature_inst, & + waterstate_inst, frictionvel_inst, energyflux_inst, waterflux_inst, & + humanindex_inst) + ! + ! !DESCRIPTION: + ! Turbulent and momentum fluxes from urban canyon (consisting of roof, sunwall, + ! shadewall, pervious and impervious road). + + ! !USES: + use clm_varcon , only : cpair, vkc, spval, grav, pondmx_urban, rpi, rgas + use clm_varcon , only : ht_wasteheat_factor, ac_wasteheat_factor, wasteheat_limit + use column_varcon , only : icol_shadewall, icol_road_perv, icol_road_imperv + use column_varcon , only : icol_roof, icol_sunwall + use filterMod , only : filter + use FrictionVelocityMod , only : FrictionVelocity, MoninObukIni + use QSatMod , only : QSat + use clm_varpar , only : maxpatch_urb, nlevurb, nlevgrnd + use clm_time_manager , only : get_curr_date, get_step_size, get_nstep + use HumanIndexMod , only : calc_human_stress_indices, Wet_Bulb, Wet_BulbS, HeatIndex, AppTemp, & + swbgt, hmdex, dis_coi, dis_coiS, THIndex, & + SwampCoolEff, KtoC, VaporPres + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanl ! number of non-urban landunits in clump + integer , intent(in) :: filter_nourbanl(:) ! non-urban landunit filter + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban patches in clump + integer , intent(in) :: filter_urbanp(:) ! urban pft filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(soilstate_type) , intent(inout) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(humanindex_type) , intent(inout) :: humanindex_inst + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: sub="UrbanFluxes" + integer :: fp,fc,fl,f,p,c,l,g,j,pi,i ! indices + + real(r8) :: canyontop_wind(bounds%begl:bounds%endl) ! wind at canyon top (m/s) + real(r8) :: canyon_u_wind(bounds%begl:bounds%endl) ! u-component of wind speed inside canyon (m/s) + real(r8) :: canyon_wind(bounds%begl:bounds%endl) ! net wind speed inside canyon (m/s) + real(r8) :: canyon_resistance(bounds%begl:bounds%endl) ! resistance to heat and moisture transfer from canyon road/walls to canyon air (s/m) + + real(r8) :: ur(bounds%begl:bounds%endl) ! wind speed at reference height (m/s) + real(r8) :: ustar(bounds%begl:bounds%endl) ! friction velocity (m/s) + real(r8) :: ramu(bounds%begl:bounds%endl) ! aerodynamic resistance (s/m) + real(r8) :: rahu(bounds%begl:bounds%endl) ! thermal resistance (s/m) + real(r8) :: rawu(bounds%begl:bounds%endl) ! moisture resistance (s/m) + real(r8) :: temp1(bounds%begl:bounds%endl) ! relation for potential temperature profile + real(r8) :: temp12m(bounds%begl:bounds%endl) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(bounds%begl:bounds%endl) ! relation for specific humidity profile + real(r8) :: temp22m(bounds%begl:bounds%endl) ! relation for specific humidity profile applied at 2-m + real(r8) :: thm_g(bounds%begl:bounds%endl) ! intermediate variable (forc_t+0.0098*forc_hgt_t) + real(r8) :: thv_g(bounds%begl:bounds%endl) ! virtual potential temperature (K) + real(r8) :: dth(bounds%begl:bounds%endl) ! diff of virtual temp. between ref. height and surface + real(r8) :: dqh(bounds%begl:bounds%endl) ! diff of humidity between ref. height and surface + real(r8) :: zldis(bounds%begl:bounds%endl) ! reference height "minus" zero displacement height (m) + real(r8) :: um(bounds%begl:bounds%endl) ! wind speed including the stablity effect (m/s) + real(r8) :: obu(bounds%begl:bounds%endl) ! Monin-Obukhov length (m) + real(r8) :: taf_numer(bounds%begl:bounds%endl) ! numerator of taf equation (K m/s) + real(r8) :: taf_denom(bounds%begl:bounds%endl) ! denominator of taf equation (m/s) + real(r8) :: qaf_numer(bounds%begl:bounds%endl) ! numerator of qaf equation (kg m/kg s) + real(r8) :: qaf_denom(bounds%begl:bounds%endl) ! denominator of qaf equation (m/s) + real(r8) :: wtas(bounds%begl:bounds%endl) ! sensible heat conductance for urban air to atmospheric air (m/s) + real(r8) :: wtaq(bounds%begl:bounds%endl) ! latent heat conductance for urban air to atmospheric air (m/s) + real(r8) :: wts_sum(bounds%begl:bounds%endl) ! sum of wtas, wtus_roof, wtus_road_perv, wtus_road_imperv, wtus_sunwall, wtus_shadewall + real(r8) :: wtq_sum(bounds%begl:bounds%endl) ! sum of wtaq, wtuq_roof, wtuq_road_perv, wtuq_road_imperv, wtuq_sunwall, wtuq_shadewall + real(r8) :: beta(bounds%begl:bounds%endl) ! coefficient of convective velocity + real(r8) :: zii(bounds%begl:bounds%endl) ! convective boundary layer height (m) + real(r8) :: fm(bounds%begl:bounds%endl) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: wtus(bounds%begc:bounds%endc) ! sensible heat conductance for urban columns (scaled) (m/s) + real(r8) :: wtuq(bounds%begc:bounds%endc) ! latent heat conductance for urban columns (scaled) (m/s) + integer :: iter ! iteration index + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: wtus_roof(bounds%begl:bounds%endl) ! sensible heat conductance for roof (scaled) (m/s) + real(r8) :: wtuq_roof(bounds%begl:bounds%endl) ! latent heat conductance for roof (scaled) (m/s) + real(r8) :: wtus_road_perv(bounds%begl:bounds%endl) ! sensible heat conductance for pervious road (scaled) (m/s) + real(r8) :: wtuq_road_perv(bounds%begl:bounds%endl) ! latent heat conductance for pervious road (scaled) (m/s) + real(r8) :: wtus_road_imperv(bounds%begl:bounds%endl) ! sensible heat conductance for impervious road (scaled) (m/s) + real(r8) :: wtuq_road_imperv(bounds%begl:bounds%endl) ! latent heat conductance for impervious road (scaled) (m/s) + real(r8) :: wtus_sunwall(bounds%begl:bounds%endl) ! sensible heat conductance for sunwall (scaled) (m/s) + real(r8) :: wtuq_sunwall(bounds%begl:bounds%endl) ! latent heat conductance for sunwall (scaled) (m/s) + real(r8) :: wtus_shadewall(bounds%begl:bounds%endl) ! sensible heat conductance for shadewall (scaled) (m/s) + real(r8) :: wtuq_shadewall(bounds%begl:bounds%endl) ! latent heat conductance for shadewall (scaled) (m/s) + real(r8) :: wtus_roof_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for roof (not scaled) (m/s) + real(r8) :: wtuq_roof_unscl(bounds%begl:bounds%endl) ! latent heat conductance for roof (not scaled) (m/s) + real(r8) :: wtus_road_perv_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for pervious road (not scaled) (m/s) + real(r8) :: wtuq_road_perv_unscl(bounds%begl:bounds%endl) ! latent heat conductance for pervious road (not scaled) (m/s) + real(r8) :: wtus_road_imperv_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for impervious road (not scaled) (m/s) + real(r8) :: wtuq_road_imperv_unscl(bounds%begl:bounds%endl) ! latent heat conductance for impervious road (not scaled) (m/s) + real(r8) :: wtus_sunwall_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for sunwall (not scaled) (m/s) + real(r8) :: wtuq_sunwall_unscl(bounds%begl:bounds%endl) ! latent heat conductance for sunwall (not scaled) (m/s) + real(r8) :: wtus_shadewall_unscl(bounds%begl:bounds%endl) ! sensible heat conductance for shadewall (not scaled) (m/s) + real(r8) :: wtuq_shadewall_unscl(bounds%begl:bounds%endl) ! latent heat conductance for shadewall (not scaled) (m/s) + real(r8) :: wc ! convective velocity (m/s) + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: eflx_sh_grnd_scale(bounds%begp:bounds%endp) ! scaled sensible heat flux from ground (W/m**2) [+ to atm] + real(r8) :: qflx_evap_soi_scale(bounds%begp:bounds%endp) ! scaled soil evaporation (mm H2O/s) (+ = to atm) + real(r8) :: eflx_wasteheat_roof(bounds%begl:bounds%endl) ! sensible heat flux from urban heating/cooling sources of waste heat for roof (W/m**2) + real(r8) :: eflx_wasteheat_sunwall(bounds%begl:bounds%endl) ! sensible heat flux from urban heating/cooling sources of waste heat for sunwall (W/m**2) + real(r8) :: eflx_wasteheat_shadewall(bounds%begl:bounds%endl) ! sensible heat flux from urban heating/cooling sources of waste heat for shadewall (W/m**2) + real(r8) :: eflx_heat_from_ac_roof(bounds%begl:bounds%endl) ! sensible heat flux put back into canyon due to heat removal by AC for roof (W/m**2) + real(r8) :: eflx_heat_from_ac_sunwall(bounds%begl:bounds%endl) ! sensible heat flux put back into canyon due to heat removal by AC for sunwall (W/m**2) + real(r8) :: eflx_heat_from_ac_shadewall(bounds%begl:bounds%endl) ! sensible heat flux put back into canyon due to heat removal by AC for shadewall (W/m**2) + real(r8) :: eflx(bounds%begl:bounds%endl) ! total sensible heat flux for error check (W/m**2) + real(r8) :: qflx(bounds%begl:bounds%endl) ! total water vapor flux for error check (kg/m**2/s) + real(r8) :: eflx_scale(bounds%begl:bounds%endl) ! sum of scaled sensible heat fluxes for urban columns for error check (W/m**2) + real(r8) :: qflx_scale(bounds%begl:bounds%endl) ! sum of scaled water vapor fluxes for urban columns for error check (kg/m**2/s) + real(r8) :: eflx_err(bounds%begl:bounds%endl) ! sensible heat flux error (W/m**2) + real(r8) :: qflx_err(bounds%begl:bounds%endl) ! water vapor flux error (kg/m**2/s) + real(r8) :: fwet_roof ! fraction of roof surface that is wet (-) + real(r8) :: fwet_road_imperv ! fraction of impervious road surface that is wet (-) + integer :: local_secp1(bounds%begl:bounds%endl) ! seconds into current date in local time (sec) + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day,secs ! calendar info for current time step + logical :: found ! flag in search loop + integer :: indexl ! index of first found in search loop + integer :: nstep ! time step number + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + ! + real(r8), parameter :: lapse_rate = 0.0098_r8 ! Dry adiabatic lapse rate (K/m) + integer , parameter :: niters = 3 ! maximum number of iterations for surface temperature + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + ctype => col%itype , & ! Input: [integer (:) ] column type + z_0_town => lun%z_0_town , & ! Input: [real(r8) (:) ] momentum roughness length of urban landunit (m) + z_d_town => lun%z_d_town , & ! Input: [real(r8) (:) ] displacement height of urban landunit (m) + ht_roof => lun%ht_roof , & ! Input: [real(r8) (:) ] height of urban roof (m) + wtlunit_roof => lun%wtlunit_roof , & ! Input: [real(r8) (:) ] weight of roof with respect to landunit + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:) ] ratio of building height to street width + wtroad_perv => lun%wtroad_perv , & ! Input: [real(r8) (:) ] weight of pervious road wrt total road + + forc_t => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric temperature (K) + forc_th => atm2lnd_inst%forc_th_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric potential temperature (K) + forc_rho => atm2lnd_inst%forc_rho_not_downscaled_grc , & ! Input: [real(r8) (:) ] density (kg/m**3) + forc_q => atm2lnd_inst%forc_q_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric specific humidity (kg/kg) + forc_pbot => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:) ] atmospheric pressure (Pa) + forc_u => atm2lnd_inst%forc_u_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in east direction (m/s) + forc_v => atm2lnd_inst%forc_v_grc , & ! Input: [real(r8) (:) ] atmospheric wind speed in north direction (m/s) + + wind_hgt_canyon => urbanparams_inst%wind_hgt_canyon , & ! Input: [real(r8) (:) ] height above road at which wind in canyon is to be computed (m) + eflx_traffic_factor => urbanparams_inst%eflx_traffic_factor , & ! Input: [real(r8) (:) ] multiplicative urban traffic factor for sensible heat flux + + rootr_road_perv => soilstate_inst%rootr_road_perv_col , & ! Input: [real(r8) (:,:) ] effective fraction of roots in each soil layer for urban pervious road + soilalpha_u => soilstate_inst%soilalpha_u_col , & ! Input: [real(r8) (:) ] Urban factor that reduces ground saturated specific humidity (-) + rootr => soilstate_inst%rootr_patch , & ! Output: [real(r8) (:,:) ] effective fraction of roots in each soil layer + + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground surface temperature (K) + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (K) + t_ref2m => temperature_inst%t_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (K) + t_ref2m_u => temperature_inst%t_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m height surface air temperature (K) + t_veg => temperature_inst%t_veg_patch , & ! Output: [real(r8) (:) ] vegetation temperature (K) + taf => temperature_inst%taf_lun , & ! Output: [real(r8) (:) ] urban canopy air temperature (K) + + + tc_ref2m => humanindex_inst%tc_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface air temperature (C) + vap_ref2m => humanindex_inst%vap_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height vapor pressure (Pa) + appar_temp_ref2m => humanindex_inst%appar_temp_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m apparent temperature (C) + appar_temp_ref2m_u => humanindex_inst%appar_temp_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m apparent temperature (C) + swbgt_ref2m => humanindex_inst%swbgt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Simplified Wetbulb Globe temperature (C) + swbgt_ref2m_u => humanindex_inst%swbgt_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Simplified Wetbulb Globe temperature (C) + humidex_ref2m => humanindex_inst%humidex_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Humidex (C) + humidex_ref2m_u => humanindex_inst%humidex_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Humidex (C) + wbt_ref2m => humanindex_inst%wbt_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Stull Wet Bulb temperature (C) + wbt_ref2m_u => humanindex_inst%wbt_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Stull Wet Bulb temperature (C) + wb_ref2m => humanindex_inst%wb_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Wet Bulb temperature (C) + wb_ref2m_u => humanindex_inst%wb_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Wet Bulb temperature (C) + teq_ref2m => humanindex_inst%teq_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent temperature (K) + teq_ref2m_u => humanindex_inst%teq_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Equivalent temperature (K) + ept_ref2m => humanindex_inst%ept_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height Equivalent Potential temperature (K) + ept_ref2m_u => humanindex_inst%ept_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m height Equivalent Potential temperature (K) + discomf_index_ref2m => humanindex_inst%discomf_index_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Discomfort Index temperature (C) + discomf_index_ref2m_u => humanindex_inst%discomf_index_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Discomfort Index temperature (C) + discomf_index_ref2mS => humanindex_inst%discomf_index_ref2mS_patch , & ! Output: [real(r8) (:) ] 2 m height Discomfort Index Stull temperature (C) + discomf_index_ref2mS_u => humanindex_inst%discomf_index_ref2mS_u_patch, & ! Output: [real(r8) (:) ] Urban 2 m Discomfort Index Stull temperature (K) + nws_hi_ref2m => humanindex_inst%nws_hi_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m NWS Heat Index (C) + nws_hi_ref2m_u => humanindex_inst%nws_hi_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m NWS Heat Index (C) + thip_ref2m => humanindex_inst%thip_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Physiology (C) + thip_ref2m_u => humanindex_inst%thip_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Temperature Humidity Index Physiology (C) + thic_ref2m => humanindex_inst%thic_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Temperature Humidity Index Comfort (C) + thic_ref2m_u => humanindex_inst%thic_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Temperature Humidity Index Comfort (C) + swmp65_ref2m => humanindex_inst%swmp65_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 65% effi (C) + swmp65_ref2m_u => humanindex_inst%swmp65_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Swamp Cooler temperature 65% effi (C) + swmp80_ref2m => humanindex_inst%swmp80_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m Swamp Cooler temperature 80% effi (C) + swmp80_ref2m_u => humanindex_inst%swmp80_ref2m_u_patch , & ! Output: [real(r8) (:) ] Urban 2 m Swamp Cooler temperature 80% effi (C) + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + dqgdT => waterstate_inst%dqgdT_col , & ! Input: [real(r8) (:) ] temperature derivative of "qg" + qg => waterstate_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface (kg/kg) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + qaf => waterstate_inst%qaf_lun , & ! Output: [real(r8) (:) ] urban canopy air specific humidity (kg/kg) + q_ref2m => waterstate_inst%q_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface specific humidity (kg/kg) + rh_ref2m => waterstate_inst%rh_ref2m_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) + rh_ref2m_u => waterstate_inst%rh_ref2m_u_patch , & ! Output: [real(r8) (:) ] 2 m height surface relative humidity (%) + + forc_hgt_u_patch => frictionvel_inst%forc_hgt_u_patch , & ! Input: [real(r8) (:) ] observational height of wind at patch-level (m) + forc_hgt_t_patch => frictionvel_inst%forc_hgt_t_patch , & ! Input: [real(r8) (:) ] observational height of temperature at patch-level (m) + ram1 => frictionvel_inst%ram1_patch , & ! Output: [real(r8) (:) ] aerodynamical resistance (s/m) + u10_clm => frictionvel_inst%u10_clm_patch , & ! Input: [real(r8) (:) ] 10 m height winds (m/s) + + htvp => energyflux_inst%htvp_col , & ! Input: [real(r8) (:) ] latent heat of evaporation (/sublimation) (J/kg) + dlrad => energyflux_inst%dlrad_patch , & ! Output: [real(r8) (:) ] downward longwave radiation below the canopy (W/m**2) + ulrad => energyflux_inst%ulrad_patch , & ! Output: [real(r8) (:) ] upward longwave radiation above the canopy (W/m**2) + cgrnds => energyflux_inst%cgrnds_patch , & ! Output: [real(r8) (:) ] deriv, of soil sensible heat flux wrt soil temp (W/m**2/K) + cgrndl => energyflux_inst%cgrndl_patch , & ! Output: [real(r8) (:) ] deriv of soil latent heat flux wrt soil temp (W/m**2/K) + cgrnd => energyflux_inst%cgrnd_patch , & ! Output: [real(r8) (:) ] deriv. of soil energy flux wrt to soil temp (W/m**2/K) + eflx_sh_grnd => energyflux_inst%eflx_sh_grnd_patch , & ! Output: [real(r8) (:) ] sensible heat flux from ground (W/m**2) [+ to atm] + eflx_sh_tot => energyflux_inst%eflx_sh_tot_patch , & ! Output: [real(r8) (:) ] total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_tot_u => energyflux_inst%eflx_sh_tot_u_patch , & ! Output: [real(r8) (:) ] urban total sensible heat flux (W/m**2) [+ to atm] + eflx_sh_snow => energyflux_inst%eflx_sh_snow_patch , & ! Output: [real(r8) (:) ] sensible heat flux from snow (W/m**2) [+ to atm] + eflx_sh_soil => energyflux_inst%eflx_sh_soil_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_sh_h2osfc => energyflux_inst%eflx_sh_h2osfc_patch , & ! Output: [real(r8) (:) ] sensible heat flux from soil (W/m**2) [+ to atm] + eflx_traffic => energyflux_inst%eflx_traffic_lun , & ! Output: [real(r8) (:) ] traffic sensible heat flux (W/m**2) + eflx_wasteheat => energyflux_inst%eflx_wasteheat_lun , & ! Output: [real(r8) (:) ] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_urban_ac => energyflux_inst%eflx_urban_ac_lun , & ! Input: [real(r8) (:) ] urban air conditioning flux (W/m**2) + eflx_heat_from_ac => energyflux_inst%eflx_heat_from_ac_lun , & ! Output: [real(r8) (:) ] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_urban_heat => energyflux_inst%eflx_urban_heat_lun , & ! Input: [real(r8) (:) ] urban heating flux (W/m**2) + eflx_urban_ac_col => energyflux_inst%eflx_urban_ac_col , & ! Input: [real(r8) (:) ] urban air conditioning flux (W/m**2) + eflx_urban_heat_col => energyflux_inst%eflx_urban_heat_col , & ! Input: [real(r8) (:) ] urban heating flux (W/m**2) + taux => energyflux_inst%taux_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: e-w (kg/m/s**2) + tauy => energyflux_inst%tauy_patch , & ! Output: [real(r8) (:) ] wind (shear) stress: n-s (kg/m/s**2) + + qflx_evap_soi => waterflux_inst%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) + qflx_tran_veg => waterflux_inst%qflx_tran_veg_patch , & ! Output: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_evap_veg => waterflux_inst%qflx_evap_veg_patch , & ! Output: [real(r8) (:) ] vegetation evaporation (mm H2O/s) (+ = to atm) + qflx_evap_tot => waterflux_inst%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg + + begl => bounds%begl , & + endl => bounds%endl & + ) + + ! Define fields that appear on the restart file for non-urban landunits + + do fl = 1,num_nourbanl + l = filter_nourbanl(fl) + taf(l) = spval + qaf(l) = spval + end do + + ! Get time step + nstep = get_nstep() + + ! Set constants (same as in Biogeophysics1Mod) + beta(begl:endl) = 1._r8 ! Should be set to the same values as in Biogeophysics1Mod + zii(begl:endl) = 1000._r8 ! Should be set to the same values as in Biogeophysics1Mod + + ! Get current date + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Compute canyontop wind using Masson (2000) + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + local_secp1(l) = secs + nint((grc%londeg(g)/degpsec)/dtime)*dtime + local_secp1(l) = mod(local_secp1(l),isecspday) + + ! Error checks + + if (ht_roof(l) - z_d_town(l) <= z_0_town(l)) then + write (iulog,*) 'aerodynamic parameter error in UrbanFluxes' + write (iulog,*) 'h_r - z_d <= z_0' + write (iulog,*) 'ht_roof, z_d_town, z_0_town: ', ht_roof(l), z_d_town(l), & + z_0_town(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + if (forc_hgt_u_patch(lun%patchi(l)) - z_d_town(l) <= z_0_town(l)) then + write (iulog,*) 'aerodynamic parameter error in UrbanFluxes' + write (iulog,*) 'h_u - z_d <= z_0' + write (iulog,*) 'forc_hgt_u_patch, z_d_town, z_0_town: ', forc_hgt_u_patch(lun%patchi(l)), z_d_town(l), & + z_0_town(l) + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + + ! Magnitude of atmospheric wind + + ur(l) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + + ! Canyon top wind + + canyontop_wind(l) = ur(l) * & + log( (ht_roof(l)-z_d_town(l)) / z_0_town(l) ) / & + log( (forc_hgt_u_patch(lun%patchi(l))-z_d_town(l)) / z_0_town(l) ) + + ! U component of canyon wind + + if (canyon_hwr(l) < 0.5_r8) then ! isolated roughness flow + canyon_u_wind(l) = canyontop_wind(l) * exp( -0.5_r8*canyon_hwr(l)* & + (1._r8-(wind_hgt_canyon(l)/ht_roof(l))) ) + else if (canyon_hwr(l) < 1.0_r8) then ! wake interference flow + canyon_u_wind(l) = canyontop_wind(l) * (1._r8+2._r8*(2._r8/rpi - 1._r8)* & + (ht_roof(l)/(ht_roof(l)/canyon_hwr(l)) - 0.5_r8)) * & + exp(-0.5_r8*canyon_hwr(l)*(1._r8-(wind_hgt_canyon(l)/ht_roof(l)))) + else ! skimming flow + canyon_u_wind(l) = canyontop_wind(l) * (2._r8/rpi) * & + exp(-0.5_r8*canyon_hwr(l)*(1._r8-(wind_hgt_canyon(l)/ht_roof(l)))) + end if + + end do + + ! Compute fluxes - Follows CLM approach for bare soils (Oleson et al 2004) + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + thm_g(l) = forc_t(g) + lapse_rate*forc_hgt_t_patch(lun%patchi(l)) + thv_g(l) = forc_th(g)*(1._r8+0.61_r8*forc_q(g)) + dth(l) = thm_g(l)-taf(l) + dqh(l) = forc_q(g)-qaf(l) + dthv = dth(l)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(l) + zldis(l) = forc_hgt_u_patch(lun%patchi(l)) - z_d_town(l) + + ! Initialize Monin-Obukhov length and wind speed including convective velocity + + call MoninObukIni(ur(l), thv_g(l), dthv, zldis(l), z_0_town(l), um(l), obu(l)) + + end do + + ! Initialize conductances + wtus_roof(begl:endl) = 0._r8 + wtus_road_perv(begl:endl) = 0._r8 + wtus_road_imperv(begl:endl) = 0._r8 + wtus_sunwall(begl:endl) = 0._r8 + wtus_shadewall(begl:endl) = 0._r8 + wtuq_roof(begl:endl) = 0._r8 + wtuq_road_perv(begl:endl) = 0._r8 + wtuq_road_imperv(begl:endl) = 0._r8 + wtuq_sunwall(begl:endl) = 0._r8 + wtuq_shadewall(begl:endl) = 0._r8 + wtus_roof_unscl(begl:endl) = 0._r8 + wtus_road_perv_unscl(begl:endl) = 0._r8 + wtus_road_imperv_unscl(begl:endl) = 0._r8 + wtus_sunwall_unscl(begl:endl) = 0._r8 + wtus_shadewall_unscl(begl:endl) = 0._r8 + wtuq_roof_unscl(begl:endl) = 0._r8 + wtuq_road_perv_unscl(begl:endl) = 0._r8 + wtuq_road_imperv_unscl(begl:endl) = 0._r8 + wtuq_sunwall_unscl(begl:endl) = 0._r8 + wtuq_shadewall_unscl(begl:endl) = 0._r8 + + ! Start stability iteration + + do iter = 1,niters + + ! Get friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + + if (num_urbanl > 0) then + call FrictionVelocity(begl, endl, & + num_urbanl, filter_urbanl, & + z_d_town(begl:endl), z_0_town(begl:endl), z_0_town(begl:endl), z_0_town(begl:endl), & + obu(begl:endl), iter, ur(begl:endl), um(begl:endl), ustar(begl:endl), & + temp1(begl:endl), temp2(begl:endl), temp12m(begl:endl), temp22m(begl:endl), fm(begl:endl), & + frictionvel_inst, landunit_index=.true.) + end if + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + ! Determine aerodynamic resistance to fluxes from urban canopy air to + ! atmosphere + + ramu(l) = 1._r8/(ustar(l)*ustar(l)/um(l)) + rahu(l) = 1._r8/(temp1(l)*ustar(l)) + rawu(l) = 1._r8/(temp2(l)*ustar(l)) + + ! Determine magnitude of canyon wind by using horizontal wind determined + ! previously and vertical wind from friction velocity (Masson 2000) + + canyon_wind(l) = sqrt(canyon_u_wind(l)**2._r8 + ustar(l)**2._r8) + + ! Determine canyon_resistance (currently this single resistance determines the + ! resistance from urban surfaces (roof, pervious and impervious road, sunlit and + ! shaded walls) to urban canopy air, since it is only dependent on wind speed + ! Also from Masson 2000. + + canyon_resistance(l) = cpair * forc_rho(g) / (11.8_r8 + 4.2_r8*canyon_wind(l)) + + end do + + ! This is the first term in the equation solutions for urban canopy air temperature + ! and specific humidity (numerator) and is a landunit quantity + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + taf_numer(l) = thm_g(l)/rahu(l) + taf_denom(l) = 1._r8/rahu(l) + qaf_numer(l) = forc_q(g)/rawu(l) + qaf_denom(l) = 1._r8/rawu(l) + + ! First term needed for derivative of heat fluxes + wtas(l) = 1._r8/rahu(l) + wtaq(l) = 1._r8/rawu(l) + + end do + + + ! Gather other terms for other urban columns for numerator and denominator of + ! equations for urban canopy air temperature and specific humidity + + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + + if (ctype(c) == icol_roof) then + + ! scaled sensible heat conductance + wtus(c) = wtlunit_roof(l)/canyon_resistance(l) + wtus_roof(l) = wtus(c) + ! unscaled sensible heat conductance + wtus_roof_unscl(l) = 1._r8/canyon_resistance(l) + + if (snow_depth(c) > 0._r8) then + fwet_roof = min(snow_depth(c)/0.05_r8, 1._r8) + else + fwet_roof = (max(0._r8, h2osoi_liq(c,1)+h2osoi_ice(c,1))/pondmx_urban)**0.666666666666_r8 + fwet_roof = min(fwet_roof,1._r8) + end if + if (qaf(l) > qg(c)) then + fwet_roof = 1._r8 + end if + ! scaled latent heat conductance + wtuq(c) = fwet_roof*(wtlunit_roof(l)/canyon_resistance(l)) + wtuq_roof(l) = wtuq(c) + ! unscaled latent heat conductance + wtuq_roof_unscl(l) = fwet_roof*(1._r8/canyon_resistance(l)) + if ( IsSimpleBuildTemp() ) call simple_wasteheatfromac( & + eflx_urban_ac_col(c), eflx_urban_heat_col(c), eflx_wasteheat_roof(l), & + eflx_heat_from_ac_roof(l) ) + + else if (ctype(c) == icol_road_perv) then + + ! scaled sensible heat conductance + wtus(c) = wtroad_perv(l)*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtus_road_perv(l) = wtus(c) + ! unscaled sensible heat conductance + wtus_road_perv_unscl(l) = 1._r8/canyon_resistance(l) + + ! scaled latent heat conductance + wtuq(c) = wtroad_perv(l)*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtuq_road_perv(l) = wtuq(c) + ! unscaled latent heat conductance + wtuq_road_perv_unscl(l) = 1._r8/canyon_resistance(l) + + else if (ctype(c) == icol_road_imperv) then + + ! scaled sensible heat conductance + wtus(c) = (1._r8-wtroad_perv(l))*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtus_road_imperv(l) = wtus(c) + ! unscaled sensible heat conductance + wtus_road_imperv_unscl(l) = 1._r8/canyon_resistance(l) + + if (snow_depth(c) > 0._r8) then + fwet_road_imperv = min(snow_depth(c)/0.05_r8, 1._r8) + else + fwet_road_imperv = (max(0._r8, h2osoi_liq(c,1)+h2osoi_ice(c,1))/pondmx_urban)**0.666666666666_r8 + fwet_road_imperv = min(fwet_road_imperv,1._r8) + end if + if (qaf(l) > qg(c)) then + fwet_road_imperv = 1._r8 + end if + ! scaled latent heat conductance + wtuq(c) = fwet_road_imperv*(1._r8-wtroad_perv(l))*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtuq_road_imperv(l) = wtuq(c) + ! unscaled latent heat conductance + wtuq_road_imperv_unscl(l) = fwet_road_imperv*(1._r8/canyon_resistance(l)) + + else if (ctype(c) == icol_sunwall) then + + ! scaled sensible heat conductance + wtus(c) = canyon_hwr(l)*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtus_sunwall(l) = wtus(c) + ! unscaled sensible heat conductance + wtus_sunwall_unscl(l) = 1._r8/canyon_resistance(l) + + ! scaled latent heat conductance + wtuq(c) = 0._r8 + wtuq_sunwall(l) = wtuq(c) + ! unscaled latent heat conductance + wtuq_sunwall_unscl(l) = 0._r8 + if ( IsSimpleBuildTemp() ) call simple_wasteheatfromac( eflx_urban_ac_col(c), & + eflx_urban_heat_col(c), eflx_wasteheat_sunwall(l), & + eflx_heat_from_ac_sunwall(l) ) + + else if (ctype(c) == icol_shadewall) then + + ! scaled sensible heat conductance + wtus(c) = canyon_hwr(l)*(1._r8-wtlunit_roof(l))/canyon_resistance(l) + wtus_shadewall(l) = wtus(c) + ! unscaled sensible heat conductance + wtus_shadewall_unscl(l) = 1._r8/canyon_resistance(l) + + ! scaled latent heat conductance + wtuq(c) = 0._r8 + wtuq_shadewall(l) = wtuq(c) + ! unscaled latent heat conductance + wtuq_shadewall_unscl(l) = 0._r8 + if ( IsSimpleBuildTemp() ) call simple_wasteheatfromac( eflx_urban_ac_col(c), & + eflx_urban_heat_col(c), eflx_wasteheat_shadewall(l), & + eflx_heat_from_ac_shadewall(l) ) + + else + write(iulog,*) 'c, ctype, pi = ', c, ctype(c), pi + write(iulog,*) 'Column indices for: shadewall, sunwall, road_imperv, road_perv, roof: ' + write(iulog,*) icol_shadewall, icol_sunwall, icol_road_imperv, icol_road_perv, icol_roof + call endrun(decomp_index=l, clmlevel=namel, msg="ERROR, ctype out of range"//errmsg(__FILE__, __LINE__)) + end if + + taf_numer(l) = taf_numer(l) + t_grnd(c)*wtus(c) + taf_denom(l) = taf_denom(l) + wtus(c) + qaf_numer(l) = qaf_numer(l) + qg(c)*wtuq(c) + qaf_denom(l) = qaf_denom(l) + wtuq(c) + + end do + + ! Calculate new urban canopy air temperature and specific humidity + + call wasteheat( bounds, num_urbanl, filter_urbanl, eflx_wasteheat_roof, eflx_wasteheat_sunwall, & + eflx_wasteheat_shadewall, eflx_heat_from_ac_roof, eflx_heat_from_ac_sunwall, & + eflx_heat_from_ac_shadewall, energyflux_inst ) + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + ! Calculate traffic heat flux + ! Only comes from impervious road + eflx_traffic(l) = (1._r8-wtlunit_roof(l))*(1._r8-wtroad_perv(l))* & + eflx_traffic_factor(l) + + taf(l) = taf_numer(l)/taf_denom(l) + qaf(l) = qaf_numer(l)/qaf_denom(l) + + wts_sum(l) = wtas(l) + wtus_roof(l) + wtus_road_perv(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l) + + wtq_sum(l) = wtaq(l) + wtuq_roof(l) + wtuq_road_perv(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l) + + end do + + ! This section of code is not required if niters = 1 + ! Determine stability using new taf and qaf + ! TODO: Some of these constants replicate what is in FrictionVelocity and BareGround fluxes should consildate. EBK + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + dth(l) = thm_g(l)-taf(l) + dqh(l) = forc_q(g)-qaf(l) + tstar = temp1(l)*dth(l) + qstar = temp2(l)*dqh(l) + thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar + zeta = zldis(l)*vkc*grav*thvstar/(ustar(l)**2*thv_g(l)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(l) = max(ur(l),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta(l)*(-grav*ustar(l)*thvstar*zii(l)/thv_g(l))**0.333_r8 + um(l) = sqrt(ur(l)*ur(l) + wc*wc) + end if + + obu(l) = zldis(l)/zeta + end do + + end do ! end iteration + + ! Determine fluxes from canyon surfaces + + ! the following initializations are needed to ensure that the values are 0 over non- + ! active urban Patches + eflx_sh_grnd_scale(bounds%begp : bounds%endp) = 0._r8 + qflx_evap_soi_scale(bounds%begp : bounds%endp) = 0._r8 + + do f = 1, num_urbanp + + p = filter_urbanp(f) + c = patch%column(p) + g = patch%gridcell(p) + l = patch%landunit(p) + + ram1(p) = ramu(l) !pass value to global variable + + ! Upward and downward canopy longwave are zero + + ulrad(p) = 0._r8 + dlrad(p) = 0._r8 + + ! Derivative of sensible and latent heat fluxes with respect to + ! ground temperature + + if (ctype(c) == icol_roof) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_road_perv(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_roof_unscl(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_road_perv(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_roof_unscl(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_road_perv) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_road_perv_unscl(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_roof(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_road_perv_unscl(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_road_imperv) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_road_imperv_unscl(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_roof(l) + & + wtuq_road_perv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_road_imperv_unscl(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_sunwall) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_road_imperv(l) + wtus_shadewall(l)) * & + (wtus_sunwall_unscl(l)/wts_sum(l)) + cgrndl(p) = 0._r8 + else if (ctype(c) == icol_shadewall) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_road_imperv(l) + wtus_sunwall(l)) * & + (wtus_shadewall_unscl(l)/wts_sum(l)) + cgrndl(p) = 0._r8 + end if + cgrnd(p) = cgrnds(p) + cgrndl(p)*htvp(c) + + ! Surface fluxes of momentum, sensible and latent heat + + taux(p) = -forc_rho(g)*forc_u(g)/ramu(l) + tauy(p) = -forc_rho(g)*forc_v(g)/ramu(l) + + ! Use new canopy air temperature + dth(l) = taf(l) - t_grnd(c) + + if (ctype(c) == icol_roof) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_roof_unscl(l)*dth(l) + eflx_sh_snow(p) = 0._r8 + eflx_sh_soil(p) = 0._r8 + eflx_sh_h2osfc(p)= 0._r8 + else if (ctype(c) == icol_road_perv) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_road_perv_unscl(l)*dth(l) + eflx_sh_snow(p) = 0._r8 + eflx_sh_soil(p) = 0._r8 + eflx_sh_h2osfc(p)= 0._r8 + else if (ctype(c) == icol_road_imperv) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_road_imperv_unscl(l)*dth(l) + eflx_sh_snow(p) = 0._r8 + eflx_sh_soil(p) = 0._r8 + eflx_sh_h2osfc(p)= 0._r8 + else if (ctype(c) == icol_sunwall) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_sunwall_unscl(l)*dth(l) + eflx_sh_snow(p) = 0._r8 + eflx_sh_soil(p) = 0._r8 + eflx_sh_h2osfc(p)= 0._r8 + else if (ctype(c) == icol_shadewall) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_shadewall_unscl(l)*dth(l) + eflx_sh_snow(p) = 0._r8 + eflx_sh_soil(p) = 0._r8 + eflx_sh_h2osfc(p)= 0._r8 + end if + + eflx_sh_tot(p) = eflx_sh_grnd(p) + eflx_sh_tot_u(p) = eflx_sh_tot(p) + + dqh(l) = qaf(l) - qg(c) + + if (ctype(c) == icol_roof) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_roof_unscl(l)*dqh(l) + else if (ctype(c) == icol_road_perv) then + ! Evaporation assigned to soil term if dew or snow + ! or if no liquid water available in soil column + if (dqh(l) > 0._r8 .or. frac_sno(c) > 0._r8 .or. soilalpha_u(c) <= 0._r8) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_road_perv_unscl(l)*dqh(l) + qflx_tran_veg(p) = 0._r8 + ! Otherwise, evaporation assigned to transpiration term + else + qflx_evap_soi(p) = 0._r8 + qflx_tran_veg(p) = -forc_rho(g)*wtuq_road_perv_unscl(l)*dqh(l) + end if + qflx_evap_veg(p) = qflx_tran_veg(p) + else if (ctype(c) == icol_road_imperv) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_road_imperv_unscl(l)*dqh(l) + else if (ctype(c) == icol_sunwall) then + qflx_evap_soi(p) = 0._r8 + else if (ctype(c) == icol_shadewall) then + qflx_evap_soi(p) = 0._r8 + end if + + ! SCALED sensible and latent heat flux for error check + eflx_sh_grnd_scale(p) = -forc_rho(g)*cpair*wtus(c)*dth(l) + qflx_evap_soi_scale(p) = -forc_rho(g)*wtuq(c)*dqh(l) + + end do + + ! Check to see that total sensible and latent heat equal the sum of + ! the scaled heat fluxes above + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + eflx(l) = -(forc_rho(g)*cpair/rahu(l))*(thm_g(l) - taf(l)) + qflx(l) = -(forc_rho(g)/rawu(l))*(forc_q(g) - qaf(l)) + eflx_scale(l) = sum(eflx_sh_grnd_scale(lun%patchi(l):lun%patchf(l))) + qflx_scale(l) = sum(qflx_evap_soi_scale(lun%patchi(l):lun%patchf(l))) + eflx_err(l) = eflx_scale(l) - eflx(l) + qflx_err(l) = qflx_scale(l) - qflx(l) + end do + + found = .false. + do fl = 1, num_urbanl + l = filter_urbanl(fl) + if (abs(eflx_err(l)) > 0.01_r8) then + found = .true. + indexl = l + exit + end if + end do + if ( found ) then + write(iulog,*)'WARNING: Total sensible heat does not equal sum of scaled heat fluxes for urban columns ',& + ' nstep = ',nstep,' indexl= ',indexl,' eflx_err= ',eflx_err(indexl) + if (abs(eflx_err(indexl)) > .01_r8) then + write(iulog,*)'clm model is stopping - error is greater than .01 W/m**2' + write(iulog,*)'eflx_scale = ',eflx_scale(indexl) + write(iulog,*)'eflx_sh_grnd_scale: ',eflx_sh_grnd_scale(lun%patchi(indexl):lun%patchf(indexl)) + write(iulog,*)'eflx = ',eflx(indexl) + call endrun(decomp_index=indexl, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + found = .false. + do fl = 1, num_urbanl + l = filter_urbanl(fl) + ! 4.e-9 kg/m**2/s = 0.01 W/m**2 + if (abs(qflx_err(l)) > 4.e-9_r8) then + found = .true. + indexl = l + exit + end if + end do + if ( found ) then + write(iulog,*)'WARNING: Total water vapor flux does not equal sum of scaled water vapor fluxes for urban columns ',& + ' nstep = ',nstep,' indexl= ',indexl,' qflx_err= ',qflx_err(indexl) + if (abs(qflx_err(indexl)) > 4.e-9_r8) then + write(iulog,*)'clm model is stopping - error is greater than 4.e-9 kg/m**2/s' + write(iulog,*)'qflx_scale = ',qflx_scale(indexl) + write(iulog,*)'qflx = ',qflx(indexl) + call endrun(decomp_index=indexl, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + end if + + ! Gather terms required to determine internal building temperature + + if ( IsSimpleBuildTemp() ) call calc_simple_internal_building_temp( & + bounds, num_urbanc, filter_urbanc, num_urbanl, filter_urbanl, & + temperature_inst) + + ! No roots for urban except for pervious road + + do j = 1, nlevgrnd + do f = 1, num_urbanp + p = filter_urbanp(f) + c = patch%column(p) + if (ctype(c) == icol_road_perv) then + rootr(p,j) = rootr_road_perv(c,j) + else + rootr(p,j) = 0._r8 + end if + end do + end do + + do f = 1, num_urbanp + + p = filter_urbanp(f) + c = patch%column(p) + g = patch%gridcell(p) + l = patch%landunit(p) + + ! Use urban canopy air temperature and specific humidity to represent + ! 2-m temperature and humidity + + t_ref2m(p) = taf(l) + q_ref2m(p) = qaf(l) + t_ref2m_u(p) = taf(l) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + rh_ref2m_u(p) = rh_ref2m(p) + + ! Human Heat Stress + if ( calc_human_stress_indices )then + + call KtoC(t_ref2m(p), tc_ref2m(p)) + call VaporPres(rh_ref2m(p), e_ref2m, vap_ref2m(p)) + call Wet_Bulb(t_ref2m(p), vap_ref2m(p), forc_pbot(g), rh_ref2m(p), q_ref2m(p), & + teq_ref2m(p), ept_ref2m(p), wb_ref2m(p)) + call Wet_BulbS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p)) + call HeatIndex(tc_ref2m(p), rh_ref2m(p), nws_hi_ref2m(p)) + call AppTemp(tc_ref2m(p), vap_ref2m(p), u10_clm(p), appar_temp_ref2m(p)) + call swbgt(tc_ref2m(p), vap_ref2m(p), swbgt_ref2m(p)) + call hmdex(tc_ref2m(p), vap_ref2m(p), humidex_ref2m(p)) + call dis_coi(tc_ref2m(p), wb_ref2m(p), discomf_index_ref2m(p)) + call dis_coiS(tc_ref2m(p), rh_ref2m(p), wbt_ref2m(p), discomf_index_ref2mS(p)) + call THIndex(tc_ref2m(p), wb_ref2m(p), thic_ref2m(p), thip_ref2m(p)) + call SwampCoolEff(tc_ref2m(p), wb_ref2m(p), swmp80_ref2m(p), swmp65_ref2m(p)) + + teq_ref2m_u(p) = teq_ref2m(p) + ept_ref2m_u(p) = ept_ref2m(p) + wb_ref2m_u(p) = wb_ref2m(p) + wbt_ref2m_u(p) = wbt_ref2m(p) + nws_hi_ref2m_u(p) = nws_hi_ref2m(p) + appar_temp_ref2m_u(p) = appar_temp_ref2m(p) + swbgt_ref2m_u(p) = swbgt_ref2m(p) + humidex_ref2m_u(p) = humidex_ref2m(p) + discomf_index_ref2m_u(p) = discomf_index_ref2m(p) + discomf_index_ref2mS_u(p) = discomf_index_ref2mS(p) + thic_ref2m_u(p) = thic_ref2m(p) + thip_ref2m_u(p) = thip_ref2m(p) + swmp80_ref2m_u(p) = swmp80_ref2m(p) + swmp65_ref2m_u(p) = swmp65_ref2m(p) + end if + + ! Variables needed by history tape + + t_veg(p) = forc_t(g) + + end do + + end associate + + end subroutine UrbanFluxes + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: wasteheat + ! + ! !INTERFACE: + subroutine wasteheat( bounds, num_urbanl, filter_urbanl, eflx_wasteheat_roof, eflx_wasteheat_sunwall, & + eflx_wasteheat_shadewall, eflx_heat_from_ac_roof, eflx_heat_from_ac_sunwall, & + eflx_heat_from_ac_shadewall, energyflux_inst ) + ! !DESCRIPTION: + ! + ! Calculate the wasteheat flux from urban heating or air-conditioning. + ! + ! !USES: + use clm_varcon , only : ht_wasteheat_factor, ac_wasteheat_factor, & + wasteheat_limit + use EnergyFluxType , only : energyflux_type + use UrbanParamsType , only : IsProgBuildTemp + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8) , intent(in) :: eflx_wasteheat_roof(bounds%begl:bounds%endl) + real(r8) , intent(in) :: eflx_wasteheat_sunwall(bounds%begl:bounds%endl) + real(r8) , intent(in) :: eflx_wasteheat_shadewall(bounds%begl:bounds%endl) + real(r8) , intent(in) :: eflx_heat_from_ac_roof(bounds%begl:bounds%endl) + real(r8) , intent(in) :: eflx_heat_from_ac_sunwall(bounds%begl:bounds%endl) + real(r8) , intent(in) :: eflx_heat_from_ac_shadewall(bounds%begl:bounds%endl) + type(energyflux_type) , intent(inout) :: energyflux_inst ! data on landunit energy flux + + ! !LOCAL VARIABLES: + integer fl, l, g + !EOP + !----------------------------------------------------------------------- + + associate(& + lgridcell => lun%gridcell , & ! Input: [integer (:) ] gridcell of corresponding landunit + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:)] ratio of building height to street width + wtlunit_roof => lun%wtlunit_roof , & ! Input: [real(r8) (:)] weight of roof with respect to landunit + eflx_wasteheat => energyflux_inst%eflx_wasteheat_lun , & ! Output: [real(r8) (:)] sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + eflx_heat_from_ac=> energyflux_inst%eflx_heat_from_ac_lun , & ! Output: [real(r8) (:)] sensible heat flux put back into canyon due to removal by AC (W/m**2) + eflx_urban_ac => energyflux_inst%eflx_urban_ac_lun , & ! Input: [real(r8) (:)] urban air conditioning flux (W/m**2) + eflx_urban_heat => energyflux_inst%eflx_urban_heat_lun & ! Input: [real(r8) (:)] urban heating flux (W/m**2) + ) + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + if ( IsSimpleBuildTemp() )then + ! Total waste heat and heat from AC is sum of heat for walls and roofs + ! accounting for different surface areas + eflx_wasteheat(l) = wtlunit_roof(l)*eflx_wasteheat_roof(l) + & + (1._r8-wtlunit_roof(l))*(canyon_hwr(l)*(eflx_wasteheat_sunwall(l) + & + eflx_wasteheat_shadewall(l))) + + else if ( IsProgBuildTemp() )then + ! wasteheat from heating/cooling + if (trim(urban_hac) == urban_wasteheat_on) then + eflx_wasteheat(l) = ac_wasteheat_factor * eflx_urban_ac(l) + & + ht_wasteheat_factor * eflx_urban_heat(l) + else + eflx_wasteheat(l) = 0._r8 + end if + end if + + ! Limit wasteheat to ensure that we don't get any unrealistically strong + ! positive feedbacks due to AC in a warmer climate + eflx_wasteheat(l) = min(eflx_wasteheat(l),wasteheat_limit) + + if ( IsSimpleBuildTemp() )then + eflx_heat_from_ac(l) = wtlunit_roof(l)*eflx_heat_from_ac_roof(l) + & + (1._r8-wtlunit_roof(l))*(canyon_hwr(l)*(eflx_heat_from_ac_sunwall(l) + & + eflx_heat_from_ac_shadewall(l))) + + else if ( IsProgBuildTemp() )then + ! If air conditioning on, always replace heat removed with heat into canyon + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + eflx_heat_from_ac(l) = abs(eflx_urban_ac(l)) + else + eflx_heat_from_ac(l) = 0._r8 + end if + end if + end do + end associate + end subroutine wasteheat + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: simple_wasteheatfromac + ! + ! !INTERFACE: + subroutine simple_wasteheatfromac( eflx_urban_ac, eflx_urban_heat, eflx_wasteheat, & + eflx_heat_from_ac ) + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + ! Calculate waste heat from Air conditioning with the simpler method introduced + ! in CLM4.5. + ! + ! !USES: + use clm_varcon , only : ht_wasteheat_factor, ac_wasteheat_factor + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: eflx_urban_ac + real(r8), intent(in) :: eflx_urban_heat + real(r8), intent(out) :: eflx_wasteheat + real(r8), intent(out) :: eflx_heat_from_ac + + ! wasteheat from heating/cooling + if (trim(urban_hac) == urban_wasteheat_on) then + eflx_wasteheat = ac_wasteheat_factor * eflx_urban_ac + & + ht_wasteheat_factor * eflx_urban_heat + else + eflx_wasteheat = 0._r8 + end if + + ! If air conditioning on, always replace heat removed with heat into canyon + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + eflx_heat_from_ac = abs(eflx_urban_ac) + else + eflx_heat_from_ac = 0._r8 + end if + + end subroutine simple_wasteheatfromac + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: calc_simple_internal_building_temp + ! + ! !INTERFACE: + subroutine calc_simple_internal_building_temp( bounds, num_urbanc, filter_urbanc, & + num_urbanl, filter_urbanl, temperature_inst ) + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + ! Calculate the internal building temperature, based on the simpler method introduced + ! in CLM4.5. + ! + ! !USES: + use clm_varpar , only : nlevurb + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use LandunitType , only : landunit_type + use ColumnType , only : column_type + use TemperatureType, only : temperature_type + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + type(temperature_type), intent(inout) :: temperature_inst ! temperature variables + ! !LOCAL VARIABLES: + ! Gather terms required to determine internal building temperature + integer :: fl,fc,l,c ! indices + real(r8) :: t_sunwall_innerl(bounds%begl:bounds%endl) ! temp of inner layer of sunwall (K) + real(r8) :: t_shadewall_innerl(bounds%begl:bounds%endl) ! temp of inner layer of shadewall (K) + real(r8) :: t_roof_innerl(bounds%begl:bounds%endl) ! temp of inner layer of roof (K) + real(r8) :: lngth_roof ! length of roof (m) + !EOP + !----------------------------------------------------------------------- + + associate(& + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:)] soil temperature (K) + ht_roof => lun%ht_roof , & ! Input: [real(r8) (:)] height of urban roof (m) + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:)] ratio of building height to street width + wtlunit_roof => lun%wtlunit_roof , & ! Input: [real(r8) (:)] weight of roof with respect to landunit + t_building => temperature_inst%t_building_lun & ! Output: [real(r8) (:)] internal building temperature (K) + ) + + do fc = 1,num_urbanc + c = filter_urbanc(fc) + l = col%landunit(c) + + if (col%itype(c) == icol_roof ) then + t_roof_innerl(l) = t_soisno(c,nlevurb) + else if (col%itype(c) == icol_sunwall ) then + t_sunwall_innerl(l) = t_soisno(c,nlevurb) + else if (col%itype(c) == icol_shadewall) then + t_shadewall_innerl(l) = t_soisno(c,nlevurb) + end if + + end do + + ! Calculate internal building temperature + do fl = 1, num_urbanl + l = filter_urbanl(fl) + + lngth_roof = (ht_roof(l)/canyon_hwr(l))*wtlunit_roof(l)/(1._r8-wtlunit_roof(l)) + t_building(l) = (ht_roof(l)*(t_shadewall_innerl(l) + t_sunwall_innerl(l)) & + +lngth_roof*t_roof_innerl(l))/(2._r8*ht_roof(l)+lngth_roof) + end do + + end associate + + end subroutine calc_simple_internal_building_temp + + !----------------------------------------------------------------------- + +end module UrbanFluxesMod diff --git a/components/clm/src/biogeophys/UrbanParamsType.F90 b/components/clm/src/biogeophys/UrbanParamsType.F90 new file mode 100644 index 0000000000..d5cb543e7c --- /dev/null +++ b/components/clm/src/biogeophys/UrbanParamsType.F90 @@ -0,0 +1,971 @@ +module UrbanParamsType + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Urban Constants + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + use clm_varctl , only : iulog, fsurdat + use clm_varcon , only : namel, grlnd, spval + use LandunitType , only : lun + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanReadNML ! Read in the urban namelist items + public :: UrbanInput ! Read in urban input data + public :: CheckUrban ! Check validity of urban points + public :: IsSimpleBuildTemp ! If using the simple building temperature method + public :: IsProgBuildTemp ! If using the prognostic building temperature method + ! + ! !PRIVATE TYPE + type urbinp_type + real(r8), pointer :: canyon_hwr (:,:) + real(r8), pointer :: wtlunit_roof (:,:) + real(r8), pointer :: wtroad_perv (:,:) + real(r8), pointer :: em_roof (:,:) + real(r8), pointer :: em_improad (:,:) + real(r8), pointer :: em_perroad (:,:) + real(r8), pointer :: em_wall (:,:) + real(r8), pointer :: alb_roof_dir (:,:,:) + real(r8), pointer :: alb_roof_dif (:,:,:) + real(r8), pointer :: alb_improad_dir (:,:,:) + real(r8), pointer :: alb_improad_dif (:,:,:) + real(r8), pointer :: alb_perroad_dir (:,:,:) + real(r8), pointer :: alb_perroad_dif (:,:,:) + real(r8), pointer :: alb_wall_dir (:,:,:) + real(r8), pointer :: alb_wall_dif (:,:,:) + real(r8), pointer :: ht_roof (:,:) + real(r8), pointer :: wind_hgt_canyon (:,:) + real(r8), pointer :: tk_wall (:,:,:) + real(r8), pointer :: tk_roof (:,:,:) + real(r8), pointer :: tk_improad (:,:,:) + real(r8), pointer :: cv_wall (:,:,:) + real(r8), pointer :: cv_roof (:,:,:) + real(r8), pointer :: cv_improad (:,:,:) + real(r8), pointer :: thick_wall (:,:) + real(r8), pointer :: thick_roof (:,:) + integer, pointer :: nlev_improad (:,:) + real(r8), pointer :: t_building_min (:,:) + real(r8), pointer :: t_building_max (:,:) + end type urbinp_type + type (urbinp_type), public :: urbinp ! urban input derived type + + ! !PUBLIC TYPE + type, public :: urbanparams_type + real(r8), allocatable :: wind_hgt_canyon (:) ! lun height above road at which wind in canyon is to be computed (m) + real(r8), allocatable :: em_roof (:) ! lun roof emissivity + real(r8), allocatable :: em_improad (:) ! lun impervious road emissivity + real(r8), allocatable :: em_perroad (:) ! lun pervious road emissivity + real(r8), allocatable :: em_wall (:) ! lun wall emissivity + real(r8), allocatable :: alb_roof_dir (:,:) ! lun direct roof albedo + real(r8), allocatable :: alb_roof_dif (:,:) ! lun diffuse roof albedo + real(r8), allocatable :: alb_improad_dir (:,:) ! lun direct impervious road albedo + real(r8), allocatable :: alb_improad_dif (:,:) ! lun diffuse impervious road albedo + real(r8), allocatable :: alb_perroad_dir (:,:) ! lun direct pervious road albedo + real(r8), allocatable :: alb_perroad_dif (:,:) ! lun diffuse pervious road albedo + real(r8), allocatable :: alb_wall_dir (:,:) ! lun direct wall albedo + real(r8), allocatable :: alb_wall_dif (:,:) ! lun diffuse wall albedo + + integer , pointer :: nlev_improad (:) ! lun number of impervious road layers (-) + real(r8), pointer :: tk_wall (:,:) ! lun thermal conductivity of urban wall (W/m/K) + real(r8), pointer :: tk_roof (:,:) ! lun thermal conductivity of urban roof (W/m/K) + real(r8), pointer :: tk_improad (:,:) ! lun thermal conductivity of urban impervious road (W/m/K) + real(r8), pointer :: cv_wall (:,:) ! lun heat capacity of urban wall (J/m^3/K) + real(r8), pointer :: cv_roof (:,:) ! lun heat capacity of urban roof (J/m^3/K) + real(r8), pointer :: cv_improad (:,:) ! lun heat capacity of urban impervious road (J/m^3/K) + real(r8), pointer :: thick_wall (:) ! lun total thickness of urban wall (m) + real(r8), pointer :: thick_roof (:) ! lun total thickness of urban roof (m) + + real(r8), pointer :: vf_sr (:) ! lun view factor of sky for road + real(r8), pointer :: vf_wr (:) ! lun view factor of one wall for road + real(r8), pointer :: vf_sw (:) ! lun view factor of sky for one wall + real(r8), pointer :: vf_rw (:) ! lun view factor of road for one wall + real(r8), pointer :: vf_ww (:) ! lun view factor of opposing wall for one wall + + real(r8), pointer :: t_building_max (:) ! lun maximum internal building air temperature (K) + real(r8), pointer :: t_building_min (:) ! lun minimum internal building air temperature (K) + real(r8), pointer :: eflx_traffic_factor (:) ! lun multiplicative traffic factor for sensible heat flux from urban traffic (-) + contains + + procedure, public :: Init + + end type urbanparams_type + ! + ! !Urban control variables + character(len= *), parameter, public :: urban_hac_off = 'OFF' + character(len= *), parameter, public :: urban_hac_on = 'ON' + character(len= *), parameter, public :: urban_wasteheat_on = 'ON_WASTEHEAT' + character(len= 16), public :: urban_hac = urban_hac_off + logical, public :: urban_traffic = .false. ! urban traffic fluxes + + ! !PRIVATE MEMBER DATA: + logical, private :: ReadNamelist = .false. ! If namelist was read yet or not + integer, parameter, private :: BUILDING_TEMP_METHOD_SIMPLE = 0 ! Simple method introduced in CLM4.5 + integer, parameter, private :: BUILDING_TEMP_METHOD_PROG = 1 ! Prognostic method introduced in CLM5.0 + integer, private :: building_temp_method = BUILDING_TEMP_METHOD_PROG ! Method to calculate the building temperature + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + ! + ! Allocate module variables and data structures + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevcan, nlevcan, numrad, nlevgrnd, nlevurb + use clm_varpar , only : nlevsoi, nlevgrnd + use clm_varctl , only : use_vancouver, use_mexicocity + use clm_varcon , only : vkc + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv, icol_road_imperv, icol_road_perv + use landunit_varcon , only : isturb_MIN + ! + ! !ARGUMENTS: + class(urbanparams_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: j,l,c,p,g ! indices + integer :: nc,fl,ib ! indices + integer :: dindx ! urban density type index + integer :: ier ! error status + real(r8) :: sumvf ! sum of view factors for wall or road + real(r8), parameter :: alpha = 4.43_r8 ! coefficient used to calculate z_d_town + real(r8), parameter :: beta = 1.0_r8 ! coefficient used to calculate z_d_town + real(r8), parameter :: C_d = 1.2_r8 ! drag coefficient as used in Grimmond and Oke (1999) + real(r8) :: plan_ai ! plan area index - ratio building area to plan area (-) + real(r8) :: frontal_ai ! frontal area index of buildings (-) + real(r8) :: build_lw_ratio ! building short/long side ratio (-) + integer :: begl, endl + integer :: begc, endc + integer :: begp, endp + integer :: begg, endg + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begl = bounds%begl; endl = bounds%endl + begg = bounds%begg; endg = bounds%endg + + ! Allocate urbanparams data structure + + if ( nlevurb > 0 )then + allocate(this%tk_wall (begl:endl,nlevurb)) ; this%tk_wall (:,:) = nan + allocate(this%tk_roof (begl:endl,nlevurb)) ; this%tk_roof (:,:) = nan + allocate(this%cv_wall (begl:endl,nlevurb)) ; this%cv_wall (:,:) = nan + allocate(this%cv_roof (begl:endl,nlevurb)) ; this%cv_roof (:,:) = nan + end if + allocate(this%t_building_max (begl:endl)) ; this%t_building_max (:) = nan + allocate(this%t_building_min (begl:endl)) ; this%t_building_min (:) = nan + allocate(this%tk_improad (begl:endl,nlevurb)) ; this%tk_improad (:,:) = nan + allocate(this%cv_improad (begl:endl,nlevurb)) ; this%cv_improad (:,:) = nan + allocate(this%thick_wall (begl:endl)) ; this%thick_wall (:) = nan + allocate(this%thick_roof (begl:endl)) ; this%thick_roof (:) = nan + allocate(this%nlev_improad (begl:endl)) ; this%nlev_improad (:) = huge(1) + allocate(this%vf_sr (begl:endl)) ; this%vf_sr (:) = nan + allocate(this%vf_wr (begl:endl)) ; this%vf_wr (:) = nan + allocate(this%vf_sw (begl:endl)) ; this%vf_sw (:) = nan + allocate(this%vf_rw (begl:endl)) ; this%vf_rw (:) = nan + allocate(this%vf_ww (begl:endl)) ; this%vf_ww (:) = nan + allocate(this%wind_hgt_canyon (begl:endl)) ; this%wind_hgt_canyon (:) = nan + allocate(this%em_roof (begl:endl)) ; this%em_roof (:) = nan + allocate(this%em_improad (begl:endl)) ; this%em_improad (:) = nan + allocate(this%em_perroad (begl:endl)) ; this%em_perroad (:) = nan + allocate(this%em_wall (begl:endl)) ; this%em_wall (:) = nan + allocate(this%alb_roof_dir (begl:endl,numrad)) ; this%alb_roof_dir (:,:) = nan + allocate(this%alb_roof_dif (begl:endl,numrad)) ; this%alb_roof_dif (:,:) = nan + allocate(this%alb_improad_dir (begl:endl,numrad)) ; this%alb_improad_dir (:,:) = nan + allocate(this%alb_perroad_dir (begl:endl,numrad)) ; this%alb_perroad_dir (:,:) = nan + allocate(this%alb_improad_dif (begl:endl,numrad)) ; this%alb_improad_dif (:,:) = nan + allocate(this%alb_perroad_dif (begl:endl,numrad)) ; this%alb_perroad_dif (:,:) = nan + allocate(this%alb_wall_dir (begl:endl,numrad)) ; this%alb_wall_dir (:,:) = nan + allocate(this%alb_wall_dif (begl:endl,numrad)) ; this%alb_wall_dif (:,:) = nan + allocate(this%eflx_traffic_factor (begl:endl)) ; this%eflx_traffic_factor (:) = nan + + ! Initialize time constant urban variables + + do l = bounds%begl,bounds%endl + + ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom + if (lun%urbpoi(l)) then + + g = lun%gridcell(l) + dindx = lun%itype(l) - isturb_MIN + 1 + + this%wind_hgt_canyon(l) = urbinp%wind_hgt_canyon(g,dindx) + do ib = 1,numrad + this%alb_roof_dir (l,ib) = urbinp%alb_roof_dir (g,dindx,ib) + this%alb_roof_dif (l,ib) = urbinp%alb_roof_dif (g,dindx,ib) + this%alb_improad_dir(l,ib) = urbinp%alb_improad_dir(g,dindx,ib) + this%alb_perroad_dir(l,ib) = urbinp%alb_perroad_dir(g,dindx,ib) + this%alb_improad_dif(l,ib) = urbinp%alb_improad_dif(g,dindx,ib) + this%alb_perroad_dif(l,ib) = urbinp%alb_perroad_dif(g,dindx,ib) + this%alb_wall_dir (l,ib) = urbinp%alb_wall_dir (g,dindx,ib) + this%alb_wall_dif (l,ib) = urbinp%alb_wall_dif (g,dindx,ib) + end do + this%em_roof (l) = urbinp%em_roof (g,dindx) + this%em_improad(l) = urbinp%em_improad(g,dindx) + this%em_perroad(l) = urbinp%em_perroad(g,dindx) + this%em_wall (l) = urbinp%em_wall (g,dindx) + + ! Landunit level initialization for urban wall and roof layers and interfaces + + lun%canyon_hwr(l) = urbinp%canyon_hwr(g,dindx) + lun%wtroad_perv(l) = urbinp%wtroad_perv(g,dindx) + lun%ht_roof(l) = urbinp%ht_roof(g,dindx) + lun%wtlunit_roof(l) = urbinp%wtlunit_roof(g,dindx) + + this%tk_wall(l,:) = urbinp%tk_wall(g,dindx,:) + this%tk_roof(l,:) = urbinp%tk_roof(g,dindx,:) + this%tk_improad(l,:) = urbinp%tk_improad(g,dindx,:) + this%cv_wall(l,:) = urbinp%cv_wall(g,dindx,:) + this%cv_roof(l,:) = urbinp%cv_roof(g,dindx,:) + this%cv_improad(l,:) = urbinp%cv_improad(g,dindx,:) + this%thick_wall(l) = urbinp%thick_wall(g,dindx) + this%thick_roof(l) = urbinp%thick_roof(g,dindx) + this%nlev_improad(l) = urbinp%nlev_improad(g,dindx) + this%t_building_min(l) = urbinp%t_building_min(g,dindx) + this%t_building_max(l) = urbinp%t_building_max(g,dindx) + + ! Inferred from Sailor and Lu 2004 + if (urban_traffic) then + this%eflx_traffic_factor(l) = 3.6_r8 * (lun%canyon_hwr(l)-0.5_r8) + 1.0_r8 + else + this%eflx_traffic_factor(l) = 0.0_r8 + end if + + if (use_vancouver .or. use_mexicocity) then + ! Freely evolving + this%t_building_max(l) = 380.00_r8 + this%t_building_min(l) = 200.00_r8 + else + if (urban_hac == urban_hac_off) then + ! Overwrite values read in from urbinp by freely evolving values + this%t_building_max(l) = 380.00_r8 + this%t_building_min(l) = 200.00_r8 + end if + end if + + !---------------------------------------------------------------------------------- + ! View factors for road and one wall in urban canyon (depends only on canyon_hwr) + ! --------------------------------------------------------------------------------------- + ! WALL | + ! ROAD | + ! wall | + ! -----\ /----- - - |\----------/ + ! | \ vsr / | | r | | \ vww / s + ! | \ / | h o w | \ / k + ! wall | \ / | wall | a | | \ / y + ! |vwr \ / vwr| | d | |vrw \ / vsw + ! ------\/------ - - |-----\/----- + ! road wall | + ! <----- w ----> | + ! <---- h --->| + ! + ! vsr = view factor of sky for road vrw = view factor of road for wall + ! vwr = view factor of one wall for road vww = view factor of opposing wall for wall + ! vsw = view factor of sky for wall + ! vsr + vwr + vwr = 1 vrw + vww + vsw = 1 + ! + ! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in + ! atmospheric models. Boundary-Layer Meteorology 94:357-397 + ! + ! - Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in + ! Grimmond and Oke (1999) + ! --------------------------------------------------------------------------------------- + + ! road -- sky view factor -> 1 as building height -> 0 + ! and -> 0 as building height -> infinity + + this%vf_sr(l) = sqrt(lun%canyon_hwr(l)**2 + 1._r8) - lun%canyon_hwr(l) + this%vf_wr(l) = 0.5_r8 * (1._r8 - this%vf_sr(l)) + + ! one wall -- sky view factor -> 0.5 as building height -> 0 + ! and -> 0 as building height -> infinity + + this%vf_sw(l) = 0.5_r8 * (lun%canyon_hwr(l) + 1._r8 - sqrt(lun%canyon_hwr(l)**2+1._r8)) / lun%canyon_hwr(l) + this%vf_rw(l) = this%vf_sw(l) + this%vf_ww(l) = 1._r8 - this%vf_sw(l) - this%vf_rw(l) + + ! error check -- make sure view factor sums to one for road and wall + sumvf = this%vf_sr(l) + 2._r8*this%vf_wr(l) + if (abs(sumvf-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban road view factor error',sumvf + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + sumvf = this%vf_sw(l) + this%vf_rw(l) + this%vf_ww(l) + if (abs(sumvf-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban wall view factor error',sumvf + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + + !---------------------------------------------------------------------------------- + ! Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in + ! Grimmond and Oke (1999) + !---------------------------------------------------------------------------------- + + ! Calculate plan area index + plan_ai = lun%canyon_hwr(l)/(lun%canyon_hwr(l) + 1._r8) + + ! Building shape shortside/longside ratio (e.g. 1 = square ) + ! This assumes the building occupies the entire canyon length + build_lw_ratio = plan_ai + + ! Calculate frontal area index + frontal_ai = (1._r8 - plan_ai) * lun%canyon_hwr(l) + + ! Adjust frontal area index for different building configuration + frontal_ai = frontal_ai * sqrt(1/build_lw_ratio) * sqrt(plan_ai) + + ! Calculate displacement height + if (use_vancouver) then + lun%z_d_town(l) = 3.5_r8 + else if (use_mexicocity) then + lun%z_d_town(l) = 10.9_r8 + else + lun%z_d_town(l) = (1._r8 + alpha**(-plan_ai) * (plan_ai - 1._r8)) * lun%ht_roof(l) + end if + + ! Calculate the roughness length + if (use_vancouver) then + lun%z_0_town(l) = 0.35_r8 + else if (use_mexicocity) then + lun%z_0_town(l) = 2.2_r8 + else + lun%z_0_town(l) = lun%ht_roof(l) * (1._r8 - lun%z_d_town(l) / lun%ht_roof(l)) * & + exp(-1.0_r8 * (0.5_r8 * beta * C_d / vkc**2 * & + (1 - lun%z_d_town(l) / lun%ht_roof(l)) * frontal_ai)**(-0.5_r8)) + end if + + else ! Not urban point + + this%eflx_traffic_factor(l) = spval + this%t_building_max(l) = spval + this%t_building_min(l) = spval + + this%vf_sr(l) = spval + this%vf_wr(l) = spval + this%vf_sw(l) = spval + this%vf_rw(l) = spval + this%vf_ww(l) = spval + + end if + end do + + ! Deallocate memory for urbinp datatype + + call UrbanInput(bounds%begg, bounds%endg, mode='finalize') + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine UrbanInput(begg, endg, mode) + ! + ! !DESCRIPTION: + ! Allocate memory and read in urban input data + ! + ! !USES: + use clm_varpar , only : numrad, nlevurb + use landunit_varcon , only : numurbl + use fileutils , only : getavu, relavu, getfil, opnfil + use spmdMod , only : masterproc + use domainMod , only : ldomain + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_inqvdlen, ncd_inqfdims + use ncdio_pio , only : ncd_pio_openfile, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: begg, endg + character(len=*), intent(in) :: mode + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: dimid ! netCDF id + integer :: nw,n,k,i,j,ni,nj,ns ! indices + integer :: nlevurb_i ! input grid: number of urban vertical levels + integer :: numrad_i ! input grid: number of solar bands (VIS/NIR) + integer :: numurbl_i ! input grid: number of urban landunits + integer :: ier,ret ! error status + logical :: isgrid2d ! true => file is 2d + logical :: readvar ! true => variable is on dataset + logical :: has_numurbl ! true => numurbl dimension is on dataset + character(len=32) :: subname = 'UrbanInput' ! subroutine name + !----------------------------------------------------------------------- + + if ( nlevurb == 0 ) return + + if (mode == 'initialize') then + + ! Read urban data + + if (masterproc) then + write(iulog,*)' Reading in urban input data from fsurdat file ...' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + if (masterproc) then + write(iulog,*) subname,trim(fsurdat) + end if + + ! Check whether this file has new-format urban data + call ncd_inqdid(ncid, 'numurbl', dimid, dimexist=has_numurbl) + + ! If file doesn't have numurbl, then it is old-format urban; + ! in this case, set nlevurb to zero + if (.not. has_numurbl) then + nlevurb = 0 + write(iulog,*)'PCT_URBAN is not multi-density, nlevurb set to 0' + end if + + if ( nlevurb == 0 ) return + + ! Allocate dynamic memory + allocate(urbinp%canyon_hwr(begg:endg, numurbl), & + urbinp%wtlunit_roof(begg:endg, numurbl), & + urbinp%wtroad_perv(begg:endg, numurbl), & + urbinp%em_roof(begg:endg, numurbl), & + urbinp%em_improad(begg:endg, numurbl), & + urbinp%em_perroad(begg:endg, numurbl), & + urbinp%em_wall(begg:endg, numurbl), & + urbinp%alb_roof_dir(begg:endg, numurbl, numrad), & + urbinp%alb_roof_dif(begg:endg, numurbl, numrad), & + urbinp%alb_improad_dir(begg:endg, numurbl, numrad), & + urbinp%alb_perroad_dir(begg:endg, numurbl, numrad), & + urbinp%alb_improad_dif(begg:endg, numurbl, numrad), & + urbinp%alb_perroad_dif(begg:endg, numurbl, numrad), & + urbinp%alb_wall_dir(begg:endg, numurbl, numrad), & + urbinp%alb_wall_dif(begg:endg, numurbl, numrad), & + urbinp%ht_roof(begg:endg, numurbl), & + urbinp%wind_hgt_canyon(begg:endg, numurbl), & + urbinp%tk_wall(begg:endg, numurbl,nlevurb), & + urbinp%tk_roof(begg:endg, numurbl,nlevurb), & + urbinp%tk_improad(begg:endg, numurbl,nlevurb), & + urbinp%cv_wall(begg:endg, numurbl,nlevurb), & + urbinp%cv_roof(begg:endg, numurbl,nlevurb), & + urbinp%cv_improad(begg:endg, numurbl,nlevurb), & + urbinp%thick_wall(begg:endg, numurbl), & + urbinp%thick_roof(begg:endg, numurbl), & + urbinp%nlev_improad(begg:endg, numurbl), & + urbinp%t_building_min(begg:endg, numurbl), & + urbinp%t_building_max(begg:endg, numurbl), & + stat=ier) + if (ier /= 0) then + call endrun(msg="Allocation error "//errmsg(__FILE__, __LINE__)) + endif + + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun(msg=errmsg(__FILE__, __LINE__)) + end if + + call ncd_inqdid(ncid, 'nlevurb', dimid) + call ncd_inqdlen(ncid, dimid, nlevurb_i) + if (nlevurb_i /= nlevurb) then + write(iulog,*)trim(subname)// ': parameter nlevurb= ',nlevurb, & + 'does not equal input dataset nlevurb= ',nlevurb_i + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + + call ncd_inqdid(ncid, 'numrad', dimid) + call ncd_inqdlen(ncid, dimid, numrad_i) + if (numrad_i /= numrad) then + write(iulog,*)trim(subname)// ': parameter numrad= ',numrad, & + 'does not equal input dataset numrad= ',numrad_i + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + call ncd_inqdid(ncid, 'numurbl', dimid) + call ncd_inqdlen(ncid, dimid, numurbl_i) + if (numurbl_i /= numurbl) then + write(iulog,*)trim(subname)// ': parameter numurbl= ',numurbl, & + 'does not equal input dataset numurbl= ',numurbl_i + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + call ncd_io(ncid=ncid, varname='CANYON_HWR', flag='read', data=urbinp%canyon_hwr,& + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg='ERROR: CANYON_HWR NOT on fsurdat file '//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='WTLUNIT_ROOF', flag='read', data=urbinp%wtlunit_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: WTLUNIT_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='WTROAD_PERV', flag='read', data=urbinp%wtroad_perv, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: WTROAD_PERV NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='EM_ROOF', flag='read', data=urbinp%em_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: EM_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='EM_IMPROAD', flag='read', data=urbinp%em_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: EM_IMPROAD NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='EM_PERROAD', flag='read', data=urbinp%em_perroad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: EM_PERROAD NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='EM_WALL', flag='read', data=urbinp%em_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: EM_WALL NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='HT_ROOF', flag='read', data=urbinp%ht_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: HT_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='WIND_HGT_CANYON', flag='read', data=urbinp%wind_hgt_canyon, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: WIND_HGT_CANYON NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='THICK_WALL', flag='read', data=urbinp%thick_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: THICK_WALL NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='THICK_ROOF', flag='read', data=urbinp%thick_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: THICK_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='NLEV_IMPROAD', flag='read', data=urbinp%nlev_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: NLEV_IMPROAD NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='T_BUILDING_MIN', flag='read', data=urbinp%t_building_min, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: T_BUILDING_MIN NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='T_BUILDING_MAX', flag='read', data=urbinp%t_building_max, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: T_BUILDING_MAX NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_IMPROAD_DIR', flag='read', data=urbinp%alb_improad_dir, & + dim1name=grlnd, readvar=readvar) + if (.not.readvar) then + call endrun( msg=' ERROR: ALB_IMPROAD_DIR NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_IMPROAD_DIF', flag='read', data=urbinp%alb_improad_dif, & + dim1name=grlnd, readvar=readvar) + if (.not.readvar) then + call endrun( msg=' ERROR: ALB_IMPROAD_DIF NOT on fsurdat file'//errmsg(__FILE__, __LINE__) ) + end if + + call ncd_io(ncid=ncid, varname='ALB_PERROAD_DIR', flag='read',data=urbinp%alb_perroad_dir, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_PERROAD_DIR NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_PERROAD_DIF', flag='read',data=urbinp%alb_perroad_dif, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_PERROAD_DIF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_ROOF_DIR', flag='read', data=urbinp%alb_roof_dir, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_ROOF_DIR NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_ROOF_DIF', flag='read', data=urbinp%alb_roof_dif, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_ROOF_DIF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_WALL_DIR', flag='read', data=urbinp%alb_wall_dir, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_WALL_DIR NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='ALB_WALL_DIF', flag='read', data=urbinp%alb_wall_dif, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: ALB_WALL_DIF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='TK_IMPROAD', flag='read', data=urbinp%tk_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: TK_IMPROAD NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='TK_ROOF', flag='read', data=urbinp%tk_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: TK_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='TK_WALL', flag='read', data=urbinp%tk_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: TK_WALL NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='CV_IMPROAD', flag='read', data=urbinp%cv_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: CV_IMPROAD NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='CV_ROOF', flag='read', data=urbinp%cv_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: CV_ROOF NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid, varname='CV_WALL', flag='read', data=urbinp%cv_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: CV_WALL NOT on fsurdat file'//errmsg(__FILE__, __LINE__)) + end if + + call ncd_pio_closefile(ncid) + if (masterproc) then + write(iulog,*)' Sucessfully read urban input data' + write(iulog,*) + end if + + else if (mode == 'finalize') then + + if ( nlevurb == 0 ) return + + deallocate(urbinp%canyon_hwr, & + urbinp%wtlunit_roof, & + urbinp%wtroad_perv, & + urbinp%em_roof, & + urbinp%em_improad, & + urbinp%em_perroad, & + urbinp%em_wall, & + urbinp%alb_roof_dir, & + urbinp%alb_roof_dif, & + urbinp%alb_improad_dir, & + urbinp%alb_perroad_dir, & + urbinp%alb_improad_dif, & + urbinp%alb_perroad_dif, & + urbinp%alb_wall_dir, & + urbinp%alb_wall_dif, & + urbinp%ht_roof, & + urbinp%wind_hgt_canyon, & + urbinp%tk_wall, & + urbinp%tk_roof, & + urbinp%tk_improad, & + urbinp%cv_wall, & + urbinp%cv_roof, & + urbinp%cv_improad, & + urbinp%thick_wall, & + urbinp%thick_roof, & + urbinp%nlev_improad, & + urbinp%t_building_min, & + urbinp%t_building_max, & + stat=ier) + if (ier /= 0) then + call endrun(msg='initUrbanInput: deallocation error '//errmsg(__FILE__, __LINE__)) + end if + else + write(iulog,*)'initUrbanInput error: mode ',trim(mode),' not supported ' + call endrun(msg=errmsg(__FILE__, __LINE__)) + end if + + end subroutine UrbanInput + + !----------------------------------------------------------------------- + subroutine CheckUrban(begg, endg, pcturb, caller) + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Confirm that we have valid urban data for all points with pct urban > 0. If this isn't + ! true, abort with a message. + ! + ! !USES: + use clm_instur , only : urban_valid + use landunit_varcon , only : numurbl + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: begg, endg ! beg & end grid cell indices + real(r8) , intent(in) :: pcturb(begg:,:) ! % urban + character(len=*), intent(in) :: caller ! identifier of caller, for more meaningful error messages + ! + ! !REVISION HISTORY: + ! Created by Bill Sacks 7/2013, mostly by moving code from surfrd_special + ! + ! !LOCAL VARIABLES: + logical :: found + integer :: nl, n + integer :: nindx, dindx + integer :: nlev + !----------------------------------------------------------------------- + + found = .false. + do nl = begg,endg + do n = 1, numurbl + if ( pcturb(nl,n) > 0.0_r8 ) then + if ( .not. urban_valid(nl) .or. & + urbinp%canyon_hwr(nl,n) <= 0._r8 .or. & + urbinp%em_improad(nl,n) <= 0._r8 .or. & + urbinp%em_perroad(nl,n) <= 0._r8 .or. & + urbinp%em_roof(nl,n) <= 0._r8 .or. & + urbinp%em_wall(nl,n) <= 0._r8 .or. & + urbinp%ht_roof(nl,n) <= 0._r8 .or. & + urbinp%thick_roof(nl,n) <= 0._r8 .or. & + urbinp%thick_wall(nl,n) <= 0._r8 .or. & + urbinp%t_building_max(nl,n) <= 0._r8 .or. & + urbinp%t_building_min(nl,n) <= 0._r8 .or. & + urbinp%wind_hgt_canyon(nl,n) <= 0._r8 .or. & + urbinp%wtlunit_roof(nl,n) <= 0._r8 .or. & + urbinp%wtroad_perv(nl,n) <= 0._r8 .or. & + any(urbinp%alb_improad_dir(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_improad_dif(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_perroad_dir(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_perroad_dif(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_roof_dir(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_roof_dif(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_wall_dir(nl,n,:) <= 0._r8) .or. & + any(urbinp%alb_wall_dif(nl,n,:) <= 0._r8) .or. & + any(urbinp%tk_roof(nl,n,:) <= 0._r8) .or. & + any(urbinp%tk_wall(nl,n,:) <= 0._r8) .or. & + any(urbinp%cv_roof(nl,n,:) <= 0._r8) .or. & + any(urbinp%cv_wall(nl,n,:) <= 0._r8)) then + found = .true. + nindx = nl + dindx = n + exit + else + if (urbinp%nlev_improad(nl,n) > 0) then + nlev = urbinp%nlev_improad(nl,n) + if ( any(urbinp%tk_improad(nl,n,1:nlev) <= 0._r8) .or. & + any(urbinp%cv_improad(nl,n,1:nlev) <= 0._r8)) then + found = .true. + nindx = nl + dindx = n + exit + end if + end if + end if + if (found) exit + end if + end do + end do + if ( found ) then + write(iulog,*) trim(caller), ' ERROR: no valid urban data for nl=',nindx + write(iulog,*)'density type: ',dindx + write(iulog,*)'urban_valid: ',urban_valid(nindx) + write(iulog,*)'canyon_hwr: ',urbinp%canyon_hwr(nindx,dindx) + write(iulog,*)'em_improad: ',urbinp%em_improad(nindx,dindx) + write(iulog,*)'em_perroad: ',urbinp%em_perroad(nindx,dindx) + write(iulog,*)'em_roof: ',urbinp%em_roof(nindx,dindx) + write(iulog,*)'em_wall: ',urbinp%em_wall(nindx,dindx) + write(iulog,*)'ht_roof: ',urbinp%ht_roof(nindx,dindx) + write(iulog,*)'thick_roof: ',urbinp%thick_roof(nindx,dindx) + write(iulog,*)'thick_wall: ',urbinp%thick_wall(nindx,dindx) + write(iulog,*)'t_building_max: ',urbinp%t_building_max(nindx,dindx) + write(iulog,*)'t_building_min: ',urbinp%t_building_min(nindx,dindx) + write(iulog,*)'wind_hgt_canyon: ',urbinp%wind_hgt_canyon(nindx,dindx) + write(iulog,*)'wtlunit_roof: ',urbinp%wtlunit_roof(nindx,dindx) + write(iulog,*)'wtroad_perv: ',urbinp%wtroad_perv(nindx,dindx) + write(iulog,*)'alb_improad_dir: ',urbinp%alb_improad_dir(nindx,dindx,:) + write(iulog,*)'alb_improad_dif: ',urbinp%alb_improad_dif(nindx,dindx,:) + write(iulog,*)'alb_perroad_dir: ',urbinp%alb_perroad_dir(nindx,dindx,:) + write(iulog,*)'alb_perroad_dif: ',urbinp%alb_perroad_dif(nindx,dindx,:) + write(iulog,*)'alb_roof_dir: ',urbinp%alb_roof_dir(nindx,dindx,:) + write(iulog,*)'alb_roof_dif: ',urbinp%alb_roof_dif(nindx,dindx,:) + write(iulog,*)'alb_wall_dir: ',urbinp%alb_wall_dir(nindx,dindx,:) + write(iulog,*)'alb_wall_dif: ',urbinp%alb_wall_dif(nindx,dindx,:) + write(iulog,*)'tk_roof: ',urbinp%tk_roof(nindx,dindx,:) + write(iulog,*)'tk_wall: ',urbinp%tk_wall(nindx,dindx,:) + write(iulog,*)'cv_roof: ',urbinp%cv_roof(nindx,dindx,:) + write(iulog,*)'cv_wall: ',urbinp%cv_wall(nindx,dindx,:) + if (urbinp%nlev_improad(nindx,dindx) > 0) then + nlev = urbinp%nlev_improad(nindx,dindx) + write(iulog,*)'tk_improad: ',urbinp%tk_improad(nindx,dindx,1:nlev) + write(iulog,*)'cv_improad: ',urbinp%cv_improad(nindx,dindx,1:nlev) + end if + call endrun(msg=errmsg(__FILE__, __LINE__)) + end if + + end subroutine CheckUrban + + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: UrbanReadNML + ! + ! !INTERFACE: + ! + subroutine UrbanReadNML ( NLFilename ) + ! + ! !DESCRIPTION: + ! + ! Read in the urban namelist + ! + ! !USES: + use shr_mpi_mod , only : shr_mpi_bcast + use abortutils , only : endrun + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + implicit none + ! + ! !ARGUMENTS: + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'UrbanReadNML' ! subroutine name + + namelist / clmu_inparm / urban_hac, urban_traffic, building_temp_method + !EOP + !----------------------------------------------------------------------- + + ! ---------------------------------------------------------------------- + ! Read namelist from input namelist filename + ! ---------------------------------------------------------------------- + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in clmu_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'clmu_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clmu_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading clmu_inparm namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if + + ! Broadcast namelist variables read in + call shr_mpi_bcast(urban_hac, mpicom) + call shr_mpi_bcast(urban_traffic, mpicom) + call shr_mpi_bcast(building_temp_method, mpicom) + + ! + if (urban_traffic) then + write(iulog,*)'Urban traffic fluxes are not implemented currently' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + ! + write(iulog,*) ' urban air conditioning/heating and wasteheat = ', urban_hac + write(iulog,*) ' urban traffic flux = ', urban_traffic + + ReadNamelist = .true. + + end subroutine UrbanReadNML + + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: IsSimpleBuildTemp + ! + ! !INTERFACE: + ! + logical function IsSimpleBuildTemp( ) + ! + ! !DESCRIPTION: + ! + ! If the simple building temperature method is being used + ! + ! !USES: + implicit none + !EOP + !----------------------------------------------------------------------- + + if ( .not. ReadNamelist )then + write(iulog,*)'Testing on building_temp_method before urban namelist was read in' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + IsSimpleBuildTemp = building_temp_method == BUILDING_TEMP_METHOD_SIMPLE + + end function IsSimpleBuildTemp + + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: IsProgBuildTemp + ! + ! !INTERFACE: + ! + logical function IsProgBuildTemp( ) + ! + ! !DESCRIPTION: + ! + ! If the prognostic building temperature method is being used + ! + ! !USES: + implicit none + !EOP + !----------------------------------------------------------------------- + + if ( .not. ReadNamelist )then + write(iulog,*)'Testing on building_temp_method before urban namelist was read in' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + IsProgBuildTemp = building_temp_method == BUILDING_TEMP_METHOD_PROG + + end function IsProgBuildTemp + + !----------------------------------------------------------------------- + +end module UrbanParamsType + + + + diff --git a/components/clm/src/biogeophys/UrbanRadiationMod.F90 b/components/clm/src/biogeophys/UrbanRadiationMod.F90 new file mode 100644 index 0000000000..529fad343f --- /dev/null +++ b/components/clm/src/biogeophys/UrbanRadiationMod.F90 @@ -0,0 +1,717 @@ +module UrbanRadiationMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate solar and longwave radiation, and turbulent fluxes for urban landunit + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : numrad + use clm_varcon , only : isecspday, degpsec, namel + use clm_varctl , only : iulog + use abortutils , only : endrun + use UrbanParamsType , only : urbanparams_type + use atm2lndType , only : atm2lnd_type + use WaterStateType , only : waterstate_type + use TemperatureType , only : temperature_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use UrbanParamsType , only : urbanparams_type + use EnergyFluxType , only : energyflux_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanRadiation ! Urban physics - radiative fluxes + ! + ! PRIVATE MEMBER FUNCTIONS + private :: net_longwave ! Net longwave radiation for road and both walls in urban canyon + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine UrbanRadiation (bounds , & + num_nourbanl, filter_nourbanl , & + num_urbanl, filter_urbanl , & + num_urbanc, filter_urbanc , & + num_urbanp, filter_urbanp , & + atm2lnd_inst, waterstate_inst, temperature_inst, urbanparams_inst, & + solarabs_inst, surfalb_inst, energyflux_inst) + ! + ! !DESCRIPTION: + ! Solar fluxes absorbed and reflected by roof and canyon (walls, road). + ! Also net and upward longwave fluxes. + + ! !USES: + use clm_varcon , only : spval, sb, tfrz + use column_varcon , only : icol_road_perv, icol_road_imperv + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_time_manager , only : get_curr_date, get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nourbanl ! number of non-urban landunits in clump + integer , intent(in) :: filter_nourbanl(:) ! non-urban landunit filter + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(:) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban patches in clump + integer , intent(in) :: filter_urbanp(:) ! urban pft filter + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(solarabs_type) , intent(inout) :: solarabs_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fp,fl,p,c,l,g ! indices + integer :: local_secp1 ! seconds into current date in local time + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day ! temporaries (not used) + integer :: secs ! seconds into current date + + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + real(r8), parameter :: snoem = 0.97_r8 ! snow emissivity (should use value from Biogeophysics1) + + real(r8) :: lwnet_roof(bounds%begl:bounds%endl) ! net (outgoing-incoming) longwave radiation (per unit ground area), roof (W/m**2) + real(r8) :: lwnet_improad(bounds%begl:bounds%endl) ! net (outgoing-incoming) longwave radiation (per unit ground area), impervious road (W/m**2) + real(r8) :: lwnet_perroad(bounds%begl:bounds%endl) ! net (outgoing-incoming) longwave radiation (per unit ground area), pervious road (W/m**2) + real(r8) :: lwnet_sunwall(bounds%begl:bounds%endl) ! net (outgoing-incoming) longwave radiation (per unit wall area), sunlit wall (W/m**2) + real(r8) :: lwnet_shadewall(bounds%begl:bounds%endl)! net (outgoing-incoming) longwave radiation (per unit wall area), shaded wall (W/m**2) + real(r8) :: lwnet_canyon(bounds%begl:bounds%endl) ! net (outgoing-incoming) longwave radiation for canyon, per unit ground area (W/m**2) + real(r8) :: lwup_roof(bounds%begl:bounds%endl) ! upward longwave radiation (per unit ground area), roof (W/m**2) + real(r8) :: lwup_improad(bounds%begl:bounds%endl) ! upward longwave radiation (per unit ground area), impervious road (W/m**2) + real(r8) :: lwup_perroad(bounds%begl:bounds%endl) ! upward longwave radiation (per unit ground area), pervious road (W/m**2) + real(r8) :: lwup_sunwall(bounds%begl:bounds%endl) ! upward longwave radiation, (per unit wall area), sunlit wall (W/m**2) + real(r8) :: lwup_shadewall(bounds%begl:bounds%endl) ! upward longwave radiation, (per unit wall area), shaded wall (W/m**2) + real(r8) :: lwup_canyon(bounds%begl:bounds%endl) ! upward longwave radiation for canyon, per unit ground area (W/m**2) + real(r8) :: t_roof(bounds%begl:bounds%endl) ! roof temperature (K) + real(r8) :: t_improad(bounds%begl:bounds%endl) ! imppervious road temperature (K) + real(r8) :: t_perroad(bounds%begl:bounds%endl) ! pervious road temperature (K) + real(r8) :: t_sunwall(bounds%begl:bounds%endl) ! sunlit wall temperature (K) + real(r8) :: t_shadewall(bounds%begl:bounds%endl) ! shaded wall temperature (K) + real(r8) :: lwdown(bounds%begl:bounds%endl) ! atmospheric downward longwave radiation (W/m**2) + real(r8) :: em_roof_s(bounds%begl:bounds%endl) ! roof emissivity with snow effects + real(r8) :: em_improad_s(bounds%begl:bounds%endl) ! impervious road emissivity with snow effects + real(r8) :: em_perroad_s(bounds%begl:bounds%endl) ! pervious road emissivity with snow effects + !----------------------------------------------------------------------- + + associate( & + ctype => col%itype , & ! Input: [integer (:) ] column type + coli => lun%coli , & ! Input: [integer (:) ] beginning column index for landunit + colf => lun%colf , & ! Input: [integer (:) ] ending column index for landunit + canyon_hwr => lun%canyon_hwr , & ! Input: [real(r8) (:) ] ratio of building height to street width + wtroad_perv => lun%wtroad_perv , & ! Input: [real(r8) (:) ] weight of pervious road wrt total road + + forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (vis=forc_sols , nir=forc_soll ) (W/m**2) + forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] diffuse beam radiation (vis=forc_sols , nir=forc_soll ) (W/m**2) + forc_solar => atm2lnd_inst%forc_solar_grc , & ! Input: [real(r8) (:) ] incident solar radiation (W/m**2) + forc_lwrad => atm2lnd_inst%forc_lwrad_not_downscaled_grc , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) + + frac_sno => waterstate_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:) ] 2 m height surface air temperature (K) + t_grnd => temperature_inst%t_grnd_col , & ! Input: [real(r8) (:) ] ground temperature (K) + + em_roof => urbanparams_inst%em_roof , & ! Input: [real(r8) (:) ] roof emissivity + em_improad => urbanparams_inst%em_improad , & ! Input: [real(r8) (:) ] impervious road emissivity + em_perroad => urbanparams_inst%em_perroad , & ! Input: [real(r8) (:) ] pervious road emissivity + em_wall => urbanparams_inst%em_wall , & ! Input: [real(r8) (:) ] wall emissivity + + albd => surfalb_inst%albd_patch , & ! Input: [real(r8) (:,:) ] pft surface albedo (direct) + albi => surfalb_inst%albi_patch , & ! Input: [real(r8) (:,:) ] pft surface albedo (diffuse) + + sabs_roof_dir => solarabs_inst%sabs_roof_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by roof per unit ground area per unit incident flux + sabs_roof_dif => solarabs_inst%sabs_roof_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by roof per unit ground area per unit incident flux + sabs_sunwall_dir => solarabs_inst%sabs_sunwall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by sunwall per unit wall area per unit incident flux + sabs_sunwall_dif => solarabs_inst%sabs_sunwall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by sunwall per unit wall area per unit incident flux + sabs_shadewall_dir => solarabs_inst%sabs_shadewall_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by shadewall per unit wall area per unit incident flux + sabs_shadewall_dif => solarabs_inst%sabs_shadewall_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by shadewall per unit wall area per unit incident flux + sabs_improad_dir => solarabs_inst%sabs_improad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by impervious road per unit ground area per unit incident flux + sabs_improad_dif => solarabs_inst%sabs_improad_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by impervious road per unit ground area per unit incident flux + sabs_perroad_dir => solarabs_inst%sabs_perroad_dir_lun , & ! Output: [real(r8) (:,:) ] direct solar absorbed by pervious road per unit ground area per unit incident flux + sabs_perroad_dif => solarabs_inst%sabs_perroad_dif_lun , & ! Output: [real(r8) (:,:) ] diffuse solar absorbed by pervious road per unit ground area per unit incident flux + sabg => solarabs_inst%sabg_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by ground (W/m**2) + sabv => solarabs_inst%sabv_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + fsa => solarabs_inst%fsa_patch , & ! Output: [real(r8) (:) ] solar radiation absorbed (total) (W/m**2) + fsa_u => solarabs_inst%fsa_u_patch , & ! Output: [real(r8) (:) ] urban solar radiation absorbed (total) (W/m**2) + + eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Output: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) + eflx_lwrad_net => energyflux_inst%eflx_lwrad_net_patch , & ! Output: [real(r8) (:) ] net infrared (longwave) rad (W/m**2) [+ = to atm] + eflx_lwrad_net_u => energyflux_inst%eflx_lwrad_net_u_patch , & ! Output: [real(r8) (:) ] urban net infrared (longwave) rad (W/m**2) [+ = to atm] + + begl => bounds%begl , & + endl => bounds%endl & + ) + + ! Define fields that appear on the restart file for non-urban landunits + + do fl = 1,num_nourbanl + l = filter_nourbanl(fl) + sabs_roof_dir(l,:) = spval + sabs_roof_dif(l,:) = spval + sabs_sunwall_dir(l,:) = spval + sabs_sunwall_dif(l,:) = spval + sabs_shadewall_dir(l,:) = spval + sabs_shadewall_dif(l,:) = spval + sabs_improad_dir(l,:) = spval + sabs_improad_dif(l,:) = spval + sabs_perroad_dir(l,:) = spval + sabs_perroad_dif(l,:) = spval + end do + + ! Set input forcing fields + do fl = 1,num_urbanl + l = filter_urbanl(fl) + g = lun%gridcell(l) + + ! Need to set the following temperatures to some defined value even if it + ! does not appear in the urban landunit for the net_longwave computation + + t_roof(l) = 19._r8 + tfrz + t_sunwall(l) = 19._r8 + tfrz + t_shadewall(l) = 19._r8 + tfrz + t_improad(l) = 19._r8 + tfrz + t_perroad(l) = 19._r8 + tfrz + + ! Initial assignment of emissivity + em_roof_s(l) = em_roof(l) + em_improad_s(l) = em_improad(l) + em_perroad_s(l) = em_perroad(l) + + ! Set urban temperatures and emissivity including snow effects. + do c = coli(l),colf(l) + if (ctype(c) == icol_roof ) then + t_roof(l) = t_grnd(c) + em_roof_s(l) = em_roof(l)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_road_imperv) then + t_improad(l) = t_grnd(c) + em_improad_s(l) = em_improad(l)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_road_perv ) then + t_perroad(l) = t_grnd(c) + em_perroad_s(l) = em_perroad(l)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_sunwall ) then + t_sunwall(l) = t_grnd(c) + else if (ctype(c) == icol_shadewall ) then + t_shadewall(l) = t_grnd(c) + end if + end do + lwdown(l) = forc_lwrad(g) + end do + + ! Net longwave radiation for road and both walls in urban canyon allowing for multiple re-emission + + if (num_urbanl > 0) then + call net_longwave (bounds, & + num_urbanl, filter_urbanl, & + canyon_hwr(begl:endl), & + wtroad_perv(begl:endl), & + lwdown(begl:endl), & + em_roof_s(begl:endl), & + em_improad_s(begl:endl), & + em_perroad_s(begl:endl), & + em_wall(begl:endl), & + t_roof(begl:endl), & + t_improad(begl:endl), & + t_perroad(begl:endl), & + t_sunwall(begl:endl), & + t_shadewall(begl:endl), & + lwnet_roof(begl:endl), & + lwnet_improad(begl:endl), & + lwnet_perroad(begl:endl), & + lwnet_sunwall(begl:endl), & + lwnet_shadewall(begl:endl), & + lwnet_canyon(begl:endl), & + lwup_roof(begl:endl), & + lwup_improad(begl:endl), & + lwup_perroad(begl:endl), & + lwup_sunwall(begl:endl), & + lwup_shadewall(begl:endl), & + lwup_canyon(begl:endl), & + urbanparams_inst) + end if + + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Determine variables needed for history output and communication with atm + ! Loop over urban patches in clump + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + ! Solar absorbed and longwave out and net + ! per unit ground area (roof, road) and per unit wall area (sunwall, shadewall) + ! Each urban pft has its own column - this is used in the logic below + + if (ctype(c) == icol_roof) then + eflx_lwrad_out(p) = lwup_roof(l) + eflx_lwrad_net(p) = lwnet_roof(l) + eflx_lwrad_net_u(p) = lwnet_roof(l) + sabg(p) = sabs_roof_dir(l,1)*forc_solad(g,1) + & + sabs_roof_dif(l,1)*forc_solai(g,1) + & + sabs_roof_dir(l,2)*forc_solad(g,2) + & + sabs_roof_dif(l,2)*forc_solai(g,2) + + else if (ctype(c) == icol_sunwall) then + eflx_lwrad_out(p) = lwup_sunwall(l) + eflx_lwrad_net(p) = lwnet_sunwall(l) + eflx_lwrad_net_u(p) = lwnet_sunwall(l) + sabg(p) = sabs_sunwall_dir(l,1)*forc_solad(g,1) + & + sabs_sunwall_dif(l,1)*forc_solai(g,1) + & + sabs_sunwall_dir(l,2)*forc_solad(g,2) + & + sabs_sunwall_dif(l,2)*forc_solai(g,2) + + else if (ctype(c) == icol_shadewall) then + eflx_lwrad_out(p) = lwup_shadewall(l) + eflx_lwrad_net(p) = lwnet_shadewall(l) + eflx_lwrad_net_u(p) = lwnet_shadewall(l) + sabg(p) = sabs_shadewall_dir(l,1)*forc_solad(g,1) + & + sabs_shadewall_dif(l,1)*forc_solai(g,1) + & + sabs_shadewall_dir(l,2)*forc_solad(g,2) + & + sabs_shadewall_dif(l,2)*forc_solai(g,2) + + else if (ctype(c) == icol_road_perv) then + eflx_lwrad_out(p) = lwup_perroad(l) + eflx_lwrad_net(p) = lwnet_perroad(l) + eflx_lwrad_net_u(p) = lwnet_perroad(l) + sabg(p) = sabs_perroad_dir(l,1)*forc_solad(g,1) + & + sabs_perroad_dif(l,1)*forc_solai(g,1) + & + sabs_perroad_dir(l,2)*forc_solad(g,2) + & + sabs_perroad_dif(l,2)*forc_solai(g,2) + + else if (ctype(c) == icol_road_imperv) then + eflx_lwrad_out(p) = lwup_improad(l) + eflx_lwrad_net(p) = lwnet_improad(l) + eflx_lwrad_net_u(p) = lwnet_improad(l) + sabg(p) = sabs_improad_dir(l,1)*forc_solad(g,1) + & + sabs_improad_dif(l,1)*forc_solai(g,1) + & + sabs_improad_dir(l,2)*forc_solad(g,2) + & + sabs_improad_dif(l,2)*forc_solai(g,2) + end if + + sabv(p) = 0._r8 + fsa(p) = sabv(p) + sabg(p) + fsa_u(p) = fsa(p) + + end do ! end loop over urban patches + + end associate + + end subroutine UrbanRadiation + + !----------------------------------------------------------------------- + subroutine net_longwave (bounds , & + num_urbanl, filter_urbanl, canyon_hwr, wtroad_perv , & + lwdown, em_roof, em_improad, em_perroad, em_wall , & + t_roof, t_improad, t_perroad, t_sunwall, t_shadewall , & + lwnet_roof, lwnet_improad, lwnet_perroad, lwnet_sunwall, lwnet_shadewall, lwnet_canyon , & + lwup_roof, lwup_improad, lwup_perroad, lwup_sunwall, lwup_shadewall, lwup_canyon, & + urbanparams_inst) + ! + ! !DESCRIPTION: + ! Net longwave radiation for road and both walls in urban canyon allowing for + ! multiple reflection. Also net longwave radiation for urban roof. + ! + ! !USES: + use clm_varcon , only : sb + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(:) ! urban landunit filter + real(r8), intent(in) :: canyon_hwr( bounds%begl: ) ! ratio of building height to street width [landunit] + real(r8), intent(in) :: wtroad_perv( bounds%begl: ) ! weight of pervious road wrt total road [landunit] + + real(r8), intent(in) :: lwdown( bounds%begl: ) ! atmospheric longwave radiation (W/m**2) [landunit] + real(r8), intent(in) :: em_roof( bounds%begl: ) ! roof emissivity [landunit] + real(r8), intent(in) :: em_improad( bounds%begl: ) ! impervious road emissivity [landunit] + real(r8), intent(in) :: em_perroad( bounds%begl: ) ! pervious road emissivity [landunit] + real(r8), intent(in) :: em_wall( bounds%begl: ) ! wall emissivity [landunit] + + real(r8), intent(in) :: t_roof( bounds%begl: ) ! roof temperature (K) [landunit] + real(r8), intent(in) :: t_improad( bounds%begl: ) ! impervious road temperature (K) [landunit] + real(r8), intent(in) :: t_perroad( bounds%begl: ) ! ervious road temperature (K) [landunit] + real(r8), intent(in) :: t_sunwall( bounds%begl: ) ! sunlit wall temperature (K) [landunit] + real(r8), intent(in) :: t_shadewall( bounds%begl: ) ! shaded wall temperature (K) [landunit] + + real(r8), intent(out) :: lwnet_roof( bounds%begl: ) ! net (outgoing-incoming) longwave radiation, roof (W/m**2) [landunit] + real(r8), intent(out) :: lwnet_improad( bounds%begl: ) ! net (outgoing-incoming) longwave radiation, impervious road (W/m**2) [landunit] + real(r8), intent(out) :: lwnet_perroad( bounds%begl: ) ! net (outgoing-incoming) longwave radiation, pervious road (W/m**2) [landunit] + real(r8), intent(out) :: lwnet_sunwall( bounds%begl: ) ! net (outgoing-incoming) longwave radiation (per unit wall area), sunlit wall (W/m**2) [landunit] + real(r8), intent(out) :: lwnet_shadewall( bounds%begl: ) ! net (outgoing-incoming) longwave radiation (per unit wall area), shaded wall (W/m**2) [landunit] + real(r8), intent(out) :: lwnet_canyon( bounds%begl: ) ! net (outgoing-incoming) longwave radiation for canyon, per unit ground area (W/m**2) [landunit] + + real(r8), intent(out) :: lwup_roof( bounds%begl: ) ! upward longwave radiation, roof (W/m**2) [landunit] + real(r8), intent(out) :: lwup_improad( bounds%begl: ) ! upward longwave radiation, impervious road (W/m**2) [landunit] + real(r8), intent(out) :: lwup_perroad( bounds%begl: ) ! upward longwave radiation, pervious road (W/m**2) [landunit] + real(r8), intent(out) :: lwup_sunwall( bounds%begl: ) ! upward longwave radiation (per unit wall area), sunlit wall (W/m**2) [landunit] + real(r8), intent(out) :: lwup_shadewall( bounds%begl: ) ! upward longwave radiation (per unit wall area), shaded wall (W/m**2) [landunit] + real(r8), intent(out) :: lwup_canyon( bounds%begl: ) ! upward longwave radiation for canyon, per unit ground area (W/m**2) [landunit] + ! + type(urbanparams_type) , intent(in) :: urbanparams_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: lwdown_road(bounds%begl:bounds%endl) ! atmospheric longwave radiation for total road (W/m**2) + real(r8) :: lwdown_sunwall(bounds%begl:bounds%endl) ! atmospheric longwave radiation (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: lwdown_shadewall(bounds%begl:bounds%endl) ! atmospheric longwave radiation (per unit wall area) for shaded wall (W/m**2) + real(r8) :: lwtot(bounds%begl:bounds%endl) ! incoming longwave radiation (W/m**2) + + real(r8) :: improad_a(bounds%begl:bounds%endl) ! absorbed longwave for improad (W/m**2) + real(r8) :: improad_r(bounds%begl:bounds%endl) ! reflected longwave for improad (W/m**2) + real(r8) :: improad_r_sky(bounds%begl:bounds%endl) ! improad_r to sky (W/m**2) + real(r8) :: improad_r_sunwall(bounds%begl:bounds%endl) ! improad_r to sunlit wall (W/m**2) + real(r8) :: improad_r_shadewall(bounds%begl:bounds%endl) ! improad_r to shaded wall (W/m**2) + real(r8) :: improad_e(bounds%begl:bounds%endl) ! emitted longwave for improad (W/m**2) + real(r8) :: improad_e_sky(bounds%begl:bounds%endl) ! improad_e to sky (W/m**2) + real(r8) :: improad_e_sunwall(bounds%begl:bounds%endl) ! improad_e to sunlit wall (W/m**2) + real(r8) :: improad_e_shadewall(bounds%begl:bounds%endl) ! improad_e to shaded wall (W/m**2) + + real(r8) :: perroad_a(bounds%begl:bounds%endl) ! absorbed longwave for perroad (W/m**2) + real(r8) :: perroad_r(bounds%begl:bounds%endl) ! reflected longwave for perroad (W/m**2) + real(r8) :: perroad_r_sky(bounds%begl:bounds%endl) ! perroad_r to sky (W/m**2) + real(r8) :: perroad_r_sunwall(bounds%begl:bounds%endl) ! perroad_r to sunlit wall (W/m**2) + real(r8) :: perroad_r_shadewall(bounds%begl:bounds%endl) ! perroad_r to shaded wall (W/m**2) + real(r8) :: perroad_e(bounds%begl:bounds%endl) ! emitted longwave for perroad (W/m**2) + real(r8) :: perroad_e_sky(bounds%begl:bounds%endl) ! perroad_e to sky (W/m**2) + real(r8) :: perroad_e_sunwall(bounds%begl:bounds%endl) ! perroad_e to sunlit wall (W/m**2) + real(r8) :: perroad_e_shadewall(bounds%begl:bounds%endl) ! perroad_e to shaded wall (W/m**2) + + real(r8) :: road_a(bounds%begl:bounds%endl) ! absorbed longwave for total road (W/m**2) + real(r8) :: road_r(bounds%begl:bounds%endl) ! reflected longwave for total road (W/m**2) + real(r8) :: road_r_sky(bounds%begl:bounds%endl) ! total road_r to sky (W/m**2) + real(r8) :: road_r_sunwall(bounds%begl:bounds%endl) ! total road_r to sunlit wall (W/m**2) + real(r8) :: road_r_shadewall(bounds%begl:bounds%endl) ! total road_r to shaded wall (W/m**2) + real(r8) :: road_e(bounds%begl:bounds%endl) ! emitted longwave for total road (W/m**2) + real(r8) :: road_e_sky(bounds%begl:bounds%endl) ! total road_e to sky (W/m**2) + real(r8) :: road_e_sunwall(bounds%begl:bounds%endl) ! total road_e to sunlit wall (W/m**2) + real(r8) :: road_e_shadewall(bounds%begl:bounds%endl) ! total road_e to shaded wall (W/m**2) + + real(r8) :: sunwall_a(bounds%begl:bounds%endl) ! absorbed longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_r(bounds%begl:bounds%endl) ! reflected longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_r_sky(bounds%begl:bounds%endl) ! sunwall_r to sky (W/m**2) + real(r8) :: sunwall_r_road(bounds%begl:bounds%endl) ! sunwall_r to road (W/m**2) + real(r8) :: sunwall_r_shadewall(bounds%begl:bounds%endl) ! sunwall_r to opposing (shaded) wall (W/m**2) + real(r8) :: sunwall_e(bounds%begl:bounds%endl) ! emitted longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_e_sky(bounds%begl:bounds%endl) ! sunwall_e to sky (W/m**2) + real(r8) :: sunwall_e_road(bounds%begl:bounds%endl) ! sunwall_e to road (W/m**2) + real(r8) :: sunwall_e_shadewall(bounds%begl:bounds%endl) ! sunwall_e to opposing (shaded) wall (W/m**2) + + real(r8) :: shadewall_a(bounds%begl:bounds%endl) ! absorbed longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_r(bounds%begl:bounds%endl) ! reflected longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_r_sky(bounds%begl:bounds%endl) ! shadewall_r to sky (W/m**2) + real(r8) :: shadewall_r_road(bounds%begl:bounds%endl) ! shadewall_r to road (W/m**2) + real(r8) :: shadewall_r_sunwall(bounds%begl:bounds%endl) ! shadewall_r to opposing (sunlit) wall (W/m**2) + real(r8) :: shadewall_e(bounds%begl:bounds%endl) ! emitted longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_e_sky(bounds%begl:bounds%endl) ! shadewall_e to sky (W/m**2) + real(r8) :: shadewall_e_road(bounds%begl:bounds%endl) ! shadewall_e to road (W/m**2) + real(r8) :: shadewall_e_sunwall(bounds%begl:bounds%endl) ! shadewall_e to opposing (sunlit) wall (W/m**2) + integer :: l,fl,iter ! indices + integer, parameter :: n = 50 ! number of interations + real(r8) :: crit ! convergence criterion (W/m**2) + real(r8) :: err ! energy conservation error (W/m**2) + real(r8) :: wtroad_imperv(bounds%begl:bounds%endl) ! weight of impervious road wrt total road + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + + SHR_ASSERT_ALL((ubound(canyon_hwr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(wtroad_perv) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwdown) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_roof) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_improad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_perroad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(em_wall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_roof) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_improad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_perroad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_sunwall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_shadewall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_roof) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_improad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_perroad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_sunwall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_shadewall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwnet_canyon) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_roof) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_improad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_perroad) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_sunwall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_shadewall) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(lwup_canyon) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + associate( & + vf_sr => urbanparams_inst%vf_sr , & ! Input: [real(r8) (:)] view factor of sky for road + vf_wr => urbanparams_inst%vf_wr , & ! Input: [real(r8) (:)] view factor of one wall for road + vf_sw => urbanparams_inst%vf_sw , & ! Input: [real(r8) (:)] view factor of sky for one wall + vf_rw => urbanparams_inst%vf_rw , & ! Input: [real(r8) (:)] view factor of road for one wall + vf_ww => urbanparams_inst%vf_ww & ! Input: [real(r8) (:)] view factor of opposing wall for one wall + ) + + ! Calculate impervious road + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + wtroad_imperv(l) = 1._r8 - wtroad_perv(l) + end do + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + ! atmospheric longwave radiation incident on walls and road in urban canyon. + ! check for conservation (need to convert wall fluxes to ground area). + ! lwdown (from atmosphere) = lwdown_road + (lwdown_sunwall + lwdown_shadewall)*canyon_hwr + + lwdown_road(l) = lwdown(l) * vf_sr(l) + lwdown_sunwall(l) = lwdown(l) * vf_sw(l) + lwdown_shadewall(l) = lwdown(l) * vf_sw(l) + + err = lwdown(l) - (lwdown_road(l) + (lwdown_shadewall(l) + lwdown_sunwall(l))*canyon_hwr(l)) + if (abs(err) > 0.10_r8 ) then + write(iulog,*) 'urban incident atmospheric longwave radiation balance error',err + write(iulog,*) 'l = ',l + write(iulog,*) 'lwdown = ',lwdown(l) + write(iulog,*) 'vf_sr = ',vf_sr(l) + write(iulog,*) 'vf_sw = ',vf_sw(l) + write(iulog,*) 'canyon_hwr = ',canyon_hwr(l) + write(iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + end do + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + ! initial absorption, reflection, and emission for road and both walls. + ! distribute reflected and emitted radiation to sky, road, and walls according + ! to appropriate view factor. radiation reflected to road and walls will + ! undergo multiple reflections within the canyon. + + road_a(l) = 0.0_r8 + road_r(l) = 0.0_r8 + road_e(l) = 0.0_r8 + improad_a(l) = em_improad(l) * lwdown_road(l) + improad_r(l) = (1._r8-em_improad(l)) * lwdown_road(l) + improad_r_sky(l) = improad_r(l) * vf_sr(l) + improad_r_sunwall(l) = improad_r(l) * vf_wr(l) + improad_r_shadewall(l) = improad_r(l) * vf_wr(l) + improad_e(l) = em_improad(l) * sb * (t_improad(l)**4) + improad_e_sky(l) = improad_e(l) * vf_sr(l) + improad_e_sunwall(l) = improad_e(l) * vf_wr(l) + improad_e_shadewall(l) = improad_e(l) * vf_wr(l) + road_a(l) = road_a(l) + improad_a(l)*wtroad_imperv(l) + road_r(l) = road_r(l) + improad_r(l)*wtroad_imperv(l) + road_e(l) = road_e(l) + improad_e(l)*wtroad_imperv(l) + + perroad_a(l) = em_perroad(l) * lwdown_road(l) + perroad_r(l) = (1._r8-em_perroad(l)) * lwdown_road(l) + perroad_r_sky(l) = perroad_r(l) * vf_sr(l) + perroad_r_sunwall(l) = perroad_r(l) * vf_wr(l) + perroad_r_shadewall(l) = perroad_r(l) * vf_wr(l) + perroad_e(l) = em_perroad(l) * sb * (t_perroad(l)**4) + perroad_e_sky(l) = perroad_e(l) * vf_sr(l) + perroad_e_sunwall(l) = perroad_e(l) * vf_wr(l) + perroad_e_shadewall(l) = perroad_e(l) * vf_wr(l) + road_a(l) = road_a(l) + perroad_a(l)*wtroad_perv(l) + road_r(l) = road_r(l) + perroad_r(l)*wtroad_perv(l) + road_e(l) = road_e(l) + perroad_e(l)*wtroad_perv(l) + + road_r_sky(l) = road_r(l) * vf_sr(l) + road_r_sunwall(l) = road_r(l) * vf_wr(l) + road_r_shadewall(l) = road_r(l) * vf_wr(l) + road_e_sky(l) = road_e(l) * vf_sr(l) + road_e_sunwall(l) = road_e(l) * vf_wr(l) + road_e_shadewall(l) = road_e(l) * vf_wr(l) + + sunwall_a(l) = em_wall(l) * lwdown_sunwall(l) + sunwall_r(l) = (1._r8-em_wall(l)) * lwdown_sunwall(l) + sunwall_r_sky(l) = sunwall_r(l) * vf_sw(l) + sunwall_r_road(l) = sunwall_r(l) * vf_rw(l) + sunwall_r_shadewall(l) = sunwall_r(l) * vf_ww(l) + sunwall_e(l) = em_wall(l) * sb * (t_sunwall(l)**4) + sunwall_e_sky(l) = sunwall_e(l) * vf_sw(l) + sunwall_e_road(l) = sunwall_e(l) * vf_rw(l) + sunwall_e_shadewall(l) = sunwall_e(l) * vf_ww(l) + + shadewall_a(l) = em_wall(l) * lwdown_shadewall(l) + shadewall_r(l) = (1._r8-em_wall(l)) * lwdown_shadewall(l) + shadewall_r_sky(l) = shadewall_r(l) * vf_sw(l) + shadewall_r_road(l) = shadewall_r(l) * vf_rw(l) + shadewall_r_sunwall(l) = shadewall_r(l) * vf_ww(l) + shadewall_e(l) = em_wall(l) * sb * (t_shadewall(l)**4) + shadewall_e_sky(l) = shadewall_e(l) * vf_sw(l) + shadewall_e_road(l) = shadewall_e(l) * vf_rw(l) + shadewall_e_sunwall(l) = shadewall_e(l) * vf_ww(l) + + ! initialize sum of net and upward longwave radiation for road and both walls + + lwnet_improad(l) = improad_e(l) - improad_a(l) + lwnet_perroad(l) = perroad_e(l) - perroad_a(l) + lwnet_sunwall(l) = sunwall_e(l) - sunwall_a(l) + lwnet_shadewall(l) = shadewall_e(l) - shadewall_a(l) + + lwup_improad(l) = improad_r_sky(l) + improad_e_sky(l) + lwup_perroad(l) = perroad_r_sky(l) + perroad_e_sky(l) + lwup_sunwall(l) = sunwall_r_sky(l) + sunwall_e_sky(l) + lwup_shadewall(l) = shadewall_r_sky(l) + shadewall_e_sky(l) + + end do + + ! now account for absorption and reflection within canyon of fluxes from road and walls + ! allowing for multiple reflections + ! + ! (1) absorption and reflection. note: emission from road and walls absorbed by walls and roads + ! only occurs in first iteration. zero out for later iterations. + ! + ! road: fluxes from walls need to be projected to ground area + ! wall: fluxes from road need to be projected to wall area + ! + ! (2) add net longwave for ith reflection to total net longwave + ! + ! (3) distribute reflected radiation to sky, road, and walls according to view factors + ! + ! (4) add upward longwave radiation to sky from road and walls for ith reflection to total + ! + ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. + ! small convergence criteria is required to ensure radiation is conserved + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + do iter = 1, n + ! step (1) + + lwtot(l) = (sunwall_r_road(l) + sunwall_e_road(l) & + + shadewall_r_road(l) + shadewall_e_road(l))*canyon_hwr(l) + road_a(l) = 0.0_r8 + road_r(l) = 0.0_r8 + improad_r(l) = (1._r8-em_improad(l)) * lwtot(l) + improad_a(l) = em_improad(l) * lwtot(l) + road_a(l) = road_a(l) + improad_a(l)*wtroad_imperv(l) + road_r(l) = road_r(l) + improad_r(l)*wtroad_imperv(l) + perroad_r(l) = (1._r8-em_perroad(l)) * lwtot(l) + perroad_a(l) = em_perroad(l) * lwtot(l) + road_a(l) = road_a(l) + perroad_a(l)*wtroad_perv(l) + road_r(l) = road_r(l) + perroad_r(l)*wtroad_perv(l) + + lwtot(l) = (road_r_sunwall(l) + road_e_sunwall(l))/canyon_hwr(l) & + + (shadewall_r_sunwall(l) + shadewall_e_sunwall(l)) + sunwall_a(l) = em_wall(l) * lwtot(l) + sunwall_r(l) = (1._r8-em_wall(l)) * lwtot(l) + + lwtot(l) = (road_r_shadewall(l) + road_e_shadewall(l))/canyon_hwr(l) & + + (sunwall_r_shadewall(l) + sunwall_e_shadewall(l)) + shadewall_a(l) = em_wall(l) * lwtot(l) + shadewall_r(l) = (1._r8-em_wall(l)) * lwtot(l) + + sunwall_e_road(l) = 0._r8 + shadewall_e_road(l) = 0._r8 + road_e_sunwall(l) = 0._r8 + shadewall_e_sunwall(l) = 0._r8 + road_e_shadewall(l) = 0._r8 + sunwall_e_shadewall(l) = 0._r8 + + ! step (2) + + lwnet_improad(l) = lwnet_improad(l) - improad_a(l) + lwnet_perroad(l) = lwnet_perroad(l) - perroad_a(l) + lwnet_sunwall(l) = lwnet_sunwall(l) - sunwall_a(l) + lwnet_shadewall(l) = lwnet_shadewall(l) - shadewall_a(l) + + ! step (3) + + improad_r_sky(l) = improad_r(l) * vf_sr(l) + improad_r_sunwall(l) = improad_r(l) * vf_wr(l) + improad_r_shadewall(l) = improad_r(l) * vf_wr(l) + + perroad_r_sky(l) = perroad_r(l) * vf_sr(l) + perroad_r_sunwall(l) = perroad_r(l) * vf_wr(l) + perroad_r_shadewall(l) = perroad_r(l) * vf_wr(l) + + road_r_sky(l) = road_r(l) * vf_sr(l) + road_r_sunwall(l) = road_r(l) * vf_wr(l) + road_r_shadewall(l) = road_r(l) * vf_wr(l) + + sunwall_r_sky(l) = sunwall_r(l) * vf_sw(l) + sunwall_r_road(l) = sunwall_r(l) * vf_rw(l) + sunwall_r_shadewall(l) = sunwall_r(l) * vf_ww(l) + + shadewall_r_sky(l) = shadewall_r(l) * vf_sw(l) + shadewall_r_road(l) = shadewall_r(l) * vf_rw(l) + shadewall_r_sunwall(l) = shadewall_r(l) * vf_ww(l) + + ! step (4) + + lwup_improad(l) = lwup_improad(l) + improad_r_sky(l) + lwup_perroad(l) = lwup_perroad(l) + perroad_r_sky(l) + lwup_sunwall(l) = lwup_sunwall(l) + sunwall_r_sky(l) + lwup_shadewall(l) = lwup_shadewall(l) + shadewall_r_sky(l) + + ! step (5) + + crit = max(road_a(l), sunwall_a(l), shadewall_a(l)) + if (crit < .001_r8) exit + end do + if (iter >= n) then + write (iulog,*) 'urban net longwave radiation error: no convergence' + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + endif + + ! total net longwave radiation for canyon. project wall fluxes to horizontal surface + + lwnet_canyon(l) = 0.0_r8 + lwnet_canyon(l) = lwnet_canyon(l) + lwnet_improad(l)*wtroad_imperv(l) + lwnet_canyon(l) = lwnet_canyon(l) + lwnet_perroad(l)*wtroad_perv(l) + lwnet_canyon(l) = lwnet_canyon(l) + (lwnet_sunwall(l) + lwnet_shadewall(l))*canyon_hwr(l) + + ! total emitted longwave for canyon. project wall fluxes to horizontal + + lwup_canyon(l) = 0.0_r8 + lwup_canyon(l) = lwup_canyon(l) + lwup_improad(l)*wtroad_imperv(l) + lwup_canyon(l) = lwup_canyon(l) + lwup_perroad(l)*wtroad_perv(l) + lwup_canyon(l) = lwup_canyon(l) + (lwup_sunwall(l) + lwup_shadewall(l))*canyon_hwr(l) + + ! conservation check. note: previous conservation check confirms partioning of incident + ! atmospheric longwave radiation to road and walls is conserved as + ! lwdown (from atmosphere) = lwdown_improad + lwdown_perroad + (lwdown_sunwall + lwdown_shadewall)*canyon_hwr + + err = lwnet_canyon(l) - (lwup_canyon(l) - lwdown(l)) + if (abs(err) > .10_r8 ) then + write (iulog,*) 'urban net longwave radiation balance error',err + write (iulog,*) 'clm model is stopping' + call endrun(decomp_index=l, clmlevel=namel, msg=errmsg(__FILE__, __LINE__)) + end if + + end do + + ! Net longwave radiation for roof + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + lwup_roof(l) = em_roof(l)*sb*(t_roof(l)**4) + (1._r8-em_roof(l))*lwdown(l) + lwnet_roof(l) = lwup_roof(l) - lwdown(l) + end do + + end associate + + end subroutine net_longwave + +end module UrbanRadiationMod diff --git a/components/clm/src/biogeophys/WaterStateType.F90 b/components/clm/src/biogeophys/WaterStateType.F90 new file mode 100644 index 0000000000..87c63bbc2b --- /dev/null +++ b/components/clm/src/biogeophys/WaterStateType.F90 @@ -0,0 +1,1042 @@ +module WaterstateType + +#include "shr_assert.h" + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Module variables for hydrology + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varctl , only : use_vancouver, use_mexicocity, use_cn, iulog, use_luna + use clm_varpar , only : nlevgrnd, nlevurb, nlevsno + use clm_varcon , only : spval + use LandunitType , only : lun + use ColumnType , only : col + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + type, public :: waterstate_type + + logical , pointer :: do_capsnow_col (:) ! col true => do snow capping + real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) + real(r8), pointer :: snow_persistence_col (:) ! col length of time that ground has had non-zero snow thickness (sec) + real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) + real(r8), pointer :: snowice_col (:) ! col average snow ice lens + real(r8), pointer :: snowliq_col (:) ! col average snow liquid water + real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) + real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics + real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] + + real(r8), pointer :: smp_l_col (:,:) ! col liquid phase soil matric potential, mm + real(r8), pointer :: h2osno_col (:) ! col snow water (mm H2O) + real(r8), pointer :: h2osno_old_col (:) ! col snow mass for previous time step (kg/m2) (new) + real(r8), pointer :: h2osoi_liq_col (:,:) ! col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_ice_col (:,:) ! col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) + real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity + real(r8), pointer :: h2osoi_liqvol_col (:,:) ! col volumetric liquid water content (v/v) + real(r8), pointer :: h2ocan_patch (:) ! patch canopy water (mm H2O) + real(r8), pointer :: h2ocan_col (:) ! col canopy water (mm H2O) + real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O) + real(r8), pointer :: snocan_patch (:) ! patch canopy snow water (mm H2O) + real(r8), pointer :: liqcan_patch (:) ! patch canopy liquid water (mm H2O) + real(r8), pointer :: snounload_patch (:) ! Canopy snow unloading (mm H2O) + real(r8), pointer :: swe_old_col (:,:) ! col initial snow water + real(r8), pointer :: liq1_grc (:) ! grc initial gridcell total h2o liq content + real(r8), pointer :: liq2_grc (:) ! grc post land cover change total liq content + real(r8), pointer :: ice1_grc (:) ! grc initial gridcell total h2o ice content + real(r8), pointer :: ice2_grc (:) ! grc post land cover change total ice content + real(r8), pointer :: tws_grc (:) ! grc total water storage (mm H2O) + + real(r8), pointer :: snw_rds_col (:,:) ! col snow grain radius (col,lyr) [m^-6, microns] + real(r8), pointer :: snw_rds_top_col (:) ! col snow grain radius (top layer) [m^-6, microns] + real(r8), pointer :: h2osno_top_col (:) ! col top-layer mass of snow [kg] + real(r8), pointer :: sno_liq_top_col (:) ! col snow liquid water fraction (mass), top layer [fraction] + + real(r8), pointer :: q_ref2m_patch (:) ! patch 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: rh_ref2m_patch (:) ! patch 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_r_patch (:) ! patch 2 m height surface relative humidity - rural (%) + real(r8), pointer :: rh_ref2m_u_patch (:) ! patch 2 m height surface relative humidity - urban (%) + real(r8), pointer :: rh_af_patch (:) ! patch fractional humidity of canopy air (dimensionless) ! private + real(r8), pointer :: rh10_af_patch (:) ! 10-day mean patch fractional humidity of canopy air (dimensionless) + real(r8), pointer :: qg_snow_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_soil_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_h2osfc_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: qg_col (:) ! col ground specific humidity [kg/kg] + real(r8), pointer :: dqgdT_col (:) ! col d(qg)/dT + real(r8), pointer :: qaf_lun (:) ! lun urban canopy air specific humidity (kg/kg) + + ! Fractions + real(r8), pointer :: frac_sno_col (:) ! col fraction of ground covered by snow (0 to 1) + real(r8), pointer :: frac_sno_eff_col (:) ! col fraction of ground covered by snow (0 to 1) + real(r8), pointer :: frac_iceold_col (:,:) ! col fraction of ice relative to the tot water (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: frac_h2osfc_col (:) ! col fractional area with surface water greater than zero + real(r8), pointer :: wf_col (:) ! col soil water as frac. of whc for top 0.05 m (0-1) + real(r8), pointer :: wf2_col (:) ! col soil water as frac. of whc for top 0.17 m (0-1) + real(r8), pointer :: fwet_patch (:) ! patch canopy fraction that is wet (0 to 1) + real(r8), pointer :: fcansno_patch (:) ! patch canopy fraction that is snow covered (0 to 1) + real(r8), pointer :: fdry_patch (:) ! patch canopy fraction of foliage that is green and dry [-] (new) + + ! Balance Checks + + real(r8), pointer :: begwb_patch (:) ! water mass begining of the time step + real(r8), pointer :: begwb_col (:) ! water mass begining of the time step + real(r8), pointer :: endwb_patch (:) ! water mass end of the time step + real(r8), pointer :: endwb_col (:) ! water mass end of the time step + real(r8), pointer :: errh2o_patch (:) ! water conservation error (mm H2O) + real(r8), pointer :: errh2o_col (:) ! water conservation error (mm H2O) + real(r8), pointer :: errh2osno_col (:) ! snow water conservation error(mm H2O) + + contains + + procedure :: Init + procedure :: Restart + procedure, public :: Reset + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type waterstate_type + + ! minimum allowed snow effective radius (also "fresh snow" value) [microns] + real(r8), public, parameter :: snw_rds_min = 54.526_r8 + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, & + h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col) + + class(waterstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(inout) :: h2osno_input_col(bounds%begc:) + real(r8) , intent(inout) :: snow_depth_input_col(bounds%begc:) + real(r8) , intent(inout) :: watsat_col(bounds%begc:, 1:) ! volumetric soil water at saturation (porosity) + real(r8) , intent(inout) :: t_soisno_col(bounds%begc:, -nlevsno+1:) ! col soil temperature (Kelvin) + +#ifdef __PGI +# if __PGIC__ == 14 && __PGIC_MINOR__ == 7 + ! COMPILER_BUG(bja, 2015-04, pgi 14.7-?) occurs at: call this%InitCold(...) + ! PGF90-F-0000-Internal compiler error. normalize_forall_array: non-conformable + ! not sure why this fixes things.... + real(r8), allocatable :: workaround_for_pgi_internal_compiler_error(:) +# endif +#endif + + call this%InitAllocate(bounds) + + call this%InitHistory(bounds) + + call this%InitCold(bounds, & + h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + begg = bounds%begg; endg= bounds%endg + + allocate(this%do_capsnow_col (begc:endc)) + allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan + allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan + allocate(this%snowdp_col (begc:endc)) ; this%snowdp_col (:) = nan + allocate(this%snowice_col (begc:endc)) ; this%snowice_col (:) = nan + allocate(this%snowliq_col (begc:endc)) ; this%snowliq_col (:) = nan + allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan + allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan + allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan + + allocate(this%smp_l_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%smp_l_col (:,:) = nan + allocate(this%h2osno_col (begc:endc)) ; this%h2osno_col (:) = nan + allocate(this%h2osno_old_col (begc:endc)) ; this%h2osno_old_col (:) = nan + allocate(this%h2osoi_liqice_10cm_col (begc:endc)) ; this%h2osoi_liqice_10cm_col (:) = nan + allocate(this%h2osoi_vol_col (begc:endc, 1:nlevgrnd)) ; this%h2osoi_vol_col (:,:) = nan + allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan + allocate(this%h2osoi_liqvol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liqvol_col (:,:) = nan + allocate(this%h2osoi_ice_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_ice_col (:,:) = nan + allocate(this%h2osoi_liq_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liq_col (:,:) = nan + allocate(this%h2ocan_patch (begp:endp)) ; this%h2ocan_patch (:) = nan + allocate(this%h2ocan_col (begc:endc)) ; this%h2ocan_col (:) = nan + allocate(this%snocan_patch (begp:endp)) ; this%snocan_patch (:) = nan + allocate(this%liqcan_patch (begp:endp)) ; this%liqcan_patch (:) = nan + allocate(this%snounload_patch (begp:endp)) ; this%snounload_patch (:) = nan + allocate(this%h2osfc_col (begc:endc)) ; this%h2osfc_col (:) = nan + allocate(this%swe_old_col (begc:endc,-nlevsno+1:0)) ; this%swe_old_col (:,:) = nan + allocate(this%liq1_grc (begg:endg)) ; this%liq1_grc (:) = nan + allocate(this%liq2_grc (begg:endg)) ; this%liq2_grc (:) = nan + allocate(this%ice1_grc (begg:endg)) ; this%ice1_grc (:) = nan + allocate(this%ice2_grc (begg:endg)) ; this%ice2_grc (:) = nan + allocate(this%tws_grc (begg:endg)) ; this%tws_grc (:) = nan + + allocate(this%snw_rds_col (begc:endc,-nlevsno+1:0)) ; this%snw_rds_col (:,:) = nan + allocate(this%snw_rds_top_col (begc:endc)) ; this%snw_rds_top_col (:) = nan + allocate(this%h2osno_top_col (begc:endc)) ; this%h2osno_top_col (:) = nan + allocate(this%sno_liq_top_col (begc:endc)) ; this%sno_liq_top_col (:) = nan + + allocate(this%qg_snow_col (begc:endc)) ; this%qg_snow_col (:) = nan + allocate(this%qg_soil_col (begc:endc)) ; this%qg_soil_col (:) = nan + allocate(this%qg_h2osfc_col (begc:endc)) ; this%qg_h2osfc_col (:) = nan + allocate(this%qg_col (begc:endc)) ; this%qg_col (:) = nan + allocate(this%dqgdT_col (begc:endc)) ; this%dqgdT_col (:) = nan + allocate(this%qaf_lun (begl:endl)) ; this%qaf_lun (:) = nan + allocate(this%q_ref2m_patch (begp:endp)) ; this%q_ref2m_patch (:) = nan + allocate(this%rh_ref2m_patch (begp:endp)) ; this%rh_ref2m_patch (:) = nan + allocate(this%rh_ref2m_u_patch (begp:endp)) ; this%rh_ref2m_u_patch (:) = nan + allocate(this%rh_ref2m_r_patch (begp:endp)) ; this%rh_ref2m_r_patch (:) = nan + allocate(this%rh_af_patch (begp:endp)) ; this%rh_af_patch (:) = nan + allocate(this%rh10_af_patch (begp:endp)) ; this%rh10_af_patch (:) = spval + + allocate(this%frac_sno_col (begc:endc)) ; this%frac_sno_col (:) = nan + allocate(this%frac_sno_eff_col (begc:endc)) ; this%frac_sno_eff_col (:) = nan + allocate(this%frac_iceold_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%frac_iceold_col (:,:) = nan + allocate(this%frac_h2osfc_col (begc:endc)) ; this%frac_h2osfc_col (:) = nan + allocate(this%wf_col (begc:endc)) ; this%wf_col (:) = nan + allocate(this%wf2_col (begc:endc)) ; + allocate(this%fwet_patch (begp:endp)) ; this%fwet_patch (:) = nan + allocate(this%fcansno_patch (begp:endp)) ; this%fcansno_patch (:) = nan + allocate(this%fdry_patch (begp:endp)) ; this%fdry_patch (:) = nan + + allocate(this%begwb_patch (begp:endp)) ; this%begwb_patch (:) = nan + allocate(this%begwb_col (begc:endc)) ; this%begwb_col (:) = nan + allocate(this%endwb_patch (begp:endp)) ; this%endwb_patch (:) = nan + allocate(this%endwb_col (begc:endc)) ; this%endwb_col (:) = nan + allocate(this%errh2o_patch (begp:endp)) ; this%errh2o_patch (:) = nan + allocate(this%errh2o_col (begc:endc)) ; this%errh2o_col (:) = nan + allocate(this%errh2osno_col (begc:endc)) ; this%errh2osno_col (:) = nan + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varctl , only : create_glacier_mec_landunit, use_cn, use_lch4 + use clm_varctl , only : hist_wrtch4diag + use clm_varpar , only : nlevsno, crop_prog + use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal, no_snow_zero + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + ! h2osno also includes snow that is part of the soil column (an + ! initial snow layer is only created if h2osno > 10mm). + + data2dptr => this%h2osoi_liq_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_LIQH2O', units='kg/m2', type2d='levsno', & + avgflag='A', long_name='Snow liquid water content', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + data2dptr => this%h2osoi_ice_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_ICE', units='kg/m2', type2d='levsno', & + avgflag='A', long_name='Snow ice content', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%h2osoi_vol_col(begc:endc,:) = spval + call hist_addfld2d (fname='H2OSOI', units='mm3/mm3', type2d='levgrnd', & + avgflag='A', long_name='volumetric soil water (vegetated landunits only)', & + ptr_col=this%h2osoi_vol_col, l2g_scale_type='veg') + + this%h2osoi_liq_col(begc:endc,:) = spval + call hist_addfld2d (fname='SOILLIQ', units='kg/m2', type2d='levgrnd', & + avgflag='A', long_name='soil liquid water (vegetated landunits only)', & + ptr_col=this%h2osoi_liq_col, l2g_scale_type='veg') + + this%h2osoi_ice_col(begc:endc,:) = spval + call hist_addfld2d (fname='SOILICE', units='kg/m2', type2d='levgrnd', & + avgflag='A', long_name='soil ice (vegetated landunits only)', & + ptr_col=this%h2osoi_ice_col, l2g_scale_type='veg') + + this%h2osoi_liqice_10cm_col(begc:endc) = spval + call hist_addfld1d (fname='SOILWATER_10CM', units='kg/m2', & + avgflag='A', long_name='soil liquid water + ice in top 10cm of soil (veg landunits only)', & + ptr_col=this%h2osoi_liqice_10cm_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') + + this%h2ocan_patch(begp:endp) = spval + call hist_addfld1d (fname='H2OCAN', units='mm', & + avgflag='A', long_name='intercepted water', & + ptr_patch=this%h2ocan_patch, set_lake=0._r8) + + this%snocan_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOCAN', units='mm', & + avgflag='A', long_name='intercepted snow', & + ptr_patch=this%snocan_patch, set_lake=0._r8) + + this%liqcan_patch(begp:endp) = spval + call hist_addfld1d (fname='LIQCAN', units='mm', & + avgflag='A', long_name='intercepted liquid water', & + ptr_patch=this%liqcan_patch, set_lake=0._r8) + + this%snounload_patch(begp:endp) = spval + call hist_addfld1d (fname='SNOUNLOAD', units='mm', & + avgflag='A', long_name='Canopy snow unloading', & + ptr_patch=this%snounload_patch, set_lake=0._r8) + + call hist_addfld1d (fname='H2OSNO', units='mm', & + avgflag='A', long_name='snow depth (liquid water)', & + ptr_col=this%h2osno_col, c2l_scale_type='urbanf') + + this%liq1_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_LIQ1', units='mm', & + avgflag='A', long_name='initial gridcell total liq content', & + ptr_lnd=this%liq1_grc) + + this%liq2_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_LIQ2', units='mm', & + avgflag='A', long_name='post landuse change gridcell total liq content', & + ptr_lnd=this%liq2_grc, default='inactive') + + this%ice1_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_ICE1', units='mm', & + avgflag='A', long_name='initial gridcell total ice content', & + ptr_lnd=this%ice1_grc) + + this%ice2_grc(begg:endg) = spval + call hist_addfld1d (fname='GC_ICE2', units='mm', & + avgflag='A', long_name='post land cover change total ice content', & + ptr_lnd=this%ice2_grc, default='inactive') + + this%h2osfc_col(begc:endc) = spval + call hist_addfld1d (fname='H2OSFC', units='mm', & + avgflag='A', long_name='surface water depth', & + ptr_col=this%h2osfc_col) + + this%tws_grc(begg:endg) = spval + call hist_addfld1d (fname='TWS', units='mm', & + avgflag='A', long_name='total water storage', & + ptr_lnd=this%tws_grc) + + ! Humidity + + this%q_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='Q2M', units='kg/kg', & + avgflag='A', long_name='2m specific humidity', & + ptr_patch=this%q_ref2m_patch) + + this%rh_ref2m_patch(begp:endp) = spval + call hist_addfld1d (fname='RH2M', units='%', & + avgflag='A', long_name='2m relative humidity', & + ptr_patch=this%rh_ref2m_patch) + + this%rh_ref2m_r_patch(begp:endp) = spval + call hist_addfld1d (fname='RH2M_R', units='%', & + avgflag='A', long_name='Rural 2m specific humidity', & + ptr_patch=this%rh_ref2m_r_patch, set_spec=spval) + + this%rh_ref2m_u_patch(begp:endp) = spval + call hist_addfld1d (fname='RH2M_U', units='%', & + avgflag='A', long_name='Urban 2m relative humidity', & + ptr_patch=this%rh_ref2m_u_patch, set_nourb=spval) + + this%rh_af_patch(begp:endp) = spval + call hist_addfld1d (fname='RHAF', units='fraction', & + avgflag='A', long_name='fractional humidity of canopy air', & + ptr_patch=this%rh_af_patch, set_spec=spval, default='inactive') + + if(use_luna)then + call hist_addfld1d (fname='RHAF10', units='fraction', & + avgflag='A', long_name='10 day running mean of fractional humidity of canopy air', & + ptr_patch=this%rh10_af_patch, set_spec=spval, default='inactive') + endif + + ! Fractions + + this%frac_h2osfc_col(begc:endc) = spval + call hist_addfld1d (fname='FH2OSFC', units='unitless', & + avgflag='A', long_name='fraction of ground covered by surface water', & + ptr_col=this%frac_h2osfc_col) + + this%frac_sno_col(begc:endc) = spval + call hist_addfld1d (fname='FSNO', units='unitless', & + avgflag='A', long_name='fraction of ground covered by snow', & + ptr_col=this%frac_sno_col, c2l_scale_type='urbanf') + + this%frac_sno_eff_col(begc:endc) = spval + call hist_addfld1d (fname='FSNO_EFF', units='unitless', & + avgflag='A', long_name='effective fraction of ground covered by snow', & + ptr_col=this%frac_sno_eff_col, c2l_scale_type='urbanf')!, default='inactive') + + if (use_cn) then + this%fwet_patch(begp:endp) = spval + call hist_addfld1d (fname='FWET', units='proportion', & + avgflag='A', long_name='fraction of canopy that is wet', & + ptr_patch=this%fwet_patch, default='inactive') + end if + + if (use_cn) then + this%fcansno_patch(begp:endp) = spval + call hist_addfld1d (fname='FCANSNO', units='proportion', & + avgflag='A', long_name='fraction of canopy that is wet', & + ptr_patch=this%fcansno_patch, default='inactive') + end if + + if (use_cn) then + this%fdry_patch(begp:endp) = spval + call hist_addfld1d (fname='FDRY', units='proportion', & + avgflag='A', long_name='fraction of foliage that is green and dry', & + ptr_patch=this%fdry_patch, default='inactive') + end if + + if (use_cn)then + this%frac_iceold_col(begc:endc,:) = spval + call hist_addfld2d (fname='FRAC_ICEOLD', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='fraction of ice relative to the tot water', & + ptr_col=this%frac_iceold_col, default='inactive') + end if + + ! Snow properties - these will be vertically averaged over the snow profile + + this%snow_depth_col(begc:endc) = spval + call hist_addfld1d (fname='SNOW_DEPTH', units='m', & + avgflag='A', long_name='snow height of snow covered area', & + ptr_col=this%snow_depth_col, c2l_scale_type='urbanf')!, default='inactive') + + this%snowdp_col(begc:endc) = spval + call hist_addfld1d (fname='SNOWDP', units='m', & + avgflag='A', long_name='gridcell mean snow height', & + ptr_col=this%snowdp_col, c2l_scale_type='urbanf') + + this%snowliq_col(begc:endc) = spval + call hist_addfld1d (fname='SNOWLIQ', units='kg/m2', & + avgflag='A', long_name='snow liquid water', & + ptr_col=this%snowliq_col) + + this%snowice_col(begc:endc) = spval + call hist_addfld1d (fname='SNOWICE', units='kg/m2', & + avgflag='A', long_name='snow ice', & + ptr_col=this%snowice_col) + + this%int_snow_col(begc:endc) = spval + call hist_addfld1d (fname='INT_SNOW', units='mm', & + avgflag='A', long_name='accumulated swe (vegetated landunits only)', & + ptr_col=this%int_snow_col, l2g_scale_type='veg') + + if (create_glacier_mec_landunit) then + this%snow_persistence_col(begc:endc) = spval + call hist_addfld1d (fname='SNOW_PERSISTENCE', units='seconds', & + avgflag='I', long_name='Length of time of continuous snow cover (nat. veg. landunits only)', & + ptr_col=this%snow_persistence_col, l2g_scale_type='natveg') + end if + + if (use_cn) then + this%wf_col(begc:endc) = spval + call hist_addfld1d (fname='WF', units='proportion', & + avgflag='A', long_name='soil water as frac. of whc for top 0.05 m', & + ptr_col=this%wf_col) + end if + + this%h2osno_top_col(begc:endc) = spval + call hist_addfld1d (fname='H2OSNO_TOP', units='kg/m2', & + avgflag='A', long_name='mass of snow in top snow layer', & + ptr_col=this%h2osno_top_col, set_urb=spval) + + this%snw_rds_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNORDSL', units='m^-6', & + avgflag='A', long_name='top snow layer effective grain radius', & + ptr_col=this%snw_rds_top_col, set_urb=spval, default='inactive') + + this%sno_liq_top_col(begc:endc) = spval + call hist_addfld1d (fname='SNOLIQFL', units='fraction', & + avgflag='A', long_name='top snow layer liquid water fraction (land)', & + ptr_col=this%sno_liq_top_col, set_urb=spval, default='inactive') + + ! We determine the fractional time (and fraction of the grid cell) over which each + ! snow layer existed by running the snow averaging routine on a field whose value is 1 + ! everywhere + data2dptr => this%snow_layer_unity_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_EXISTENCE', units='unitless', type2d='levsno', & + avgflag='A', long_name='Fraction of averaging period for which each snow layer existed', & + ptr_col=data2dptr, no_snow_behavior=no_snow_zero, default='inactive') + + this%bw_col(begc:endc,-nlevsno+1:0) = spval + data2dptr => this%bw_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_BW', units='kg/m3', type2d='levsno', & + avgflag='A', long_name='Partial density of water in the snow pack (ice + liquid)', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%snw_rds_col(begc:endc,-nlevsno+1:0) = spval + data2dptr => this%snw_rds_col(:,-nlevsno+1:0) + call hist_addfld2d (fname='SNO_GS', units='Microns', type2d='levsno', & + avgflag='A', long_name='Mean snow grain size', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + this%errh2o_col(begc:endc) = spval + call hist_addfld1d (fname='ERRH2O', units='mm', & + avgflag='A', long_name='total water conservation error', & + ptr_col=this%errh2o_col) + + this%errh2osno_col(begc:endc) = spval + call hist_addfld1d (fname='ERRH2OSNO', units='mm', & + avgflag='A', long_name='imbalance in snow depth (liquid water)', & + ptr_col=this%errh2osno_col, c2l_scale_type='urbanf') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, & + h2osno_input_col, snow_depth_input_col, watsat_col, t_soisno_col) + ! + ! !DESCRIPTION: + ! Initialize time constant variables and cold start conditions + ! + ! !USES: + use shr_const_mod , only : shr_const_pi + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_spfn_mod , only : shr_spfn_erf + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb + use landunit_varcon , only : istice, istwet, istsoil, istdlak, istcrop, istice_mec + use column_varcon , only : icol_shadewall, icol_road_perv + use column_varcon , only : icol_road_imperv, icol_roof, icol_sunwall + use clm_varcon , only : denice, denh2o, spval, sb, bdsno + use clm_varcon , only : h2osno_max, zlnd, tfrz, spval, pc + use clm_varctl , only : fsurdat, iulog + use spmdMod , only : masterproc + use abortutils , only : endrun + use fileutils , only : getfil + use ncdio_pio , only : file_desc_t, ncd_io + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: h2osno_input_col(bounds%begc:) + real(r8) , intent(in) :: snow_depth_input_col(bounds%begc:) + real(r8) , intent(in) :: watsat_col(bounds%begc:, 1:) ! volumetric soil water at saturation (porosity) + real(r8) , intent(in) :: t_soisno_col(bounds%begc:, -nlevsno+1:) ! col soil temperature (Kelvin) + ! + ! !LOCAL VARIABLES: + integer :: p,c,j,l,g,lev,nlevs + real(r8) :: maxslope, slopemax, minslope + real(r8) :: d, fd, dfdd, slope0,slopebeta + real(r8) ,pointer :: std (:) + logical :: readvar + type(file_desc_t) :: ncid + character(len=256) :: locfn + real(r8) :: snowbd ! temporary calculation of snow bulk density (kg/m3) + real(r8) :: fmelt ! snowbd/100 + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(h2osno_input_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(snow_depth_input_col) == (/bounds%endc/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc,nlevgrnd/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno_col) == (/bounds%endc,nlevgrnd/)) , errMsg(__FILE__, __LINE__)) + + ! The first three arrays are initialized from the input argument + do c = bounds%begc,bounds%endc + this%h2osno_col(c) = h2osno_input_col(c) + this%int_snow_col(c) = h2osno_input_col(c) + this%snow_depth_col(c) = snow_depth_input_col(c) + this%snow_persistence_col(c) = 0._r8 + this%snow_layer_unity_col(c,:) = 1._r8 + end do + + do c = bounds%begc,bounds%endc + this%wf_col(c) = spval + this%wf2_col(c) = spval + end do + + do l = bounds%begl, bounds%endl + if (lun%urbpoi(l)) then + if (use_vancouver) then + this%qaf_lun(l) = 0.0111_r8 + else if (use_mexicocity) then + this%qaf_lun(l) = 0.00248_r8 + else + this%qaf_lun(l) = 1.e-4_r8 ! Arbitrary set since forc_q is not yet available + end if + end if + end do + + associate(snl => col%snl) + + this%h2osfc_col(bounds%begc:bounds%endc) = 0._r8 + this%h2ocan_patch(bounds%begp:bounds%endp) = 0._r8 + this%h2ocan_col(bounds%begc:bounds%endc) = 0._r8 + this%snocan_patch(bounds%begp:bounds%endp) = 0._r8 + this%liqcan_patch(bounds%begp:bounds%endp) = 0._r8 + this%snounload_patch(bounds%begp:bounds%endp) = 0._r8 + this%frac_h2osfc_col(bounds%begc:bounds%endc) = 0._r8 + + this%fwet_patch(bounds%begp:bounds%endp) = 0._r8 + this%fdry_patch(bounds%begp:bounds%endp) = 0._r8 + this%fcansno_patch(bounds%begp:bounds%endp) = 0._r8 + !-------------------------------------------- + ! Set snow water + !-------------------------------------------- + + ! Note: Glacier_mec columns are initialized with half the maximum snow cover. + ! This gives more realistic values of qflx_glcice sooner in the simulation + ! for columns with net ablation, at the cost of delaying ice formation + ! in columns with net accumulation. + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + ! From Bonan 1996 (LSM technical note) + this%frac_sno_col(c) = min( this%snow_depth_col(c)/0.05_r8, 1._r8) + else + this%frac_sno_col(c) = 0._r8 + ! snow cover fraction as in Niu and Yang 2007 + if(this%snow_depth_col(c) > 0.0) then + snowbd = min(400._r8, this%h2osno_col(c)/this%snow_depth_col(c)) !bulk density of snow (kg/m3) + fmelt = (snowbd/100.)**1. + ! 100 is the assumed fresh snow density; 1 is a melting factor that could be + ! reconsidered, optimal value of 1.5 in Niu et al., 2007 + this%frac_sno_col(c) = tanh( this%snow_depth_col(c) /(2.5 * zlnd * fmelt) ) + endif + end if + end do + + do c = bounds%begc,bounds%endc + if (snl(c) < 0) then + this%snw_rds_col(c,snl(c)+1:0) = snw_rds_min + this%snw_rds_col(c,-nlevsno+1:snl(c)) = 0._r8 + this%snw_rds_top_col(c) = snw_rds_min + elseif (this%h2osno_col(c) > 0._r8) then + this%snw_rds_col(c,0) = snw_rds_min + this%snw_rds_col(c,-nlevsno+1:-1) = 0._r8 + this%snw_rds_top_col(c) = spval + this%sno_liq_top_col(c) = spval + else + this%snw_rds_col(c,:) = 0._r8 + this%snw_rds_top_col(c) = spval + this%sno_liq_top_col(c) = spval + endif + end do + + !-------------------------------------------- + ! Set soil water + !-------------------------------------------- + + ! volumetric water is set first and liquid content and ice lens are obtained + ! NOTE: h2osoi_vol, h2osoi_liq and h2osoi_ice only have valid values over soil + ! and urban pervious road (other urban columns have zero soil water) + + this%h2osoi_vol_col(bounds%begc:bounds%endc, 1:) = spval + this%h2osoi_liq_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval + this%h2osoi_ice_col(bounds%begc:bounds%endc,-nlevsno+1:) = spval + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (.not. lun%lakpoi(l)) then !not lake + + ! volumetric water + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + nlevs = nlevgrnd + do j = 1, nlevs + if (j > nlevsoi) then + this%h2osoi_vol_col(c,j) = 0.0_r8 + else + this%h2osoi_vol_col(c,j) = 0.15_r8 + endif + end do + else if (lun%urbpoi(l)) then + if (col%itype(c) == icol_road_perv) then + nlevs = nlevgrnd + do j = 1, nlevs + if (j <= nlevsoi) then + this%h2osoi_vol_col(c,j) = 0.3_r8 + else + this%h2osoi_vol_col(c,j) = 0.0_r8 + end if + end do + else if (col%itype(c) == icol_road_imperv) then + nlevs = nlevgrnd + do j = 1, nlevs + this%h2osoi_vol_col(c,j) = 0.0_r8 + end do + else + nlevs = nlevurb + do j = 1, nlevs + this%h2osoi_vol_col(c,j) = 0.0_r8 + end do + end if + else if (lun%itype(l) == istwet) then + nlevs = nlevgrnd + do j = 1, nlevs + if (j > nlevsoi) then + this%h2osoi_vol_col(c,j) = 0.0_r8 + else + this%h2osoi_vol_col(c,j) = 1.0_r8 + endif + end do + else if (lun%itype(l) == istice .or. lun%itype(l) == istice_mec) then + nlevs = nlevgrnd + do j = 1, nlevs + this%h2osoi_vol_col(c,j) = 1.0_r8 + end do + endif + do j = 1, nlevs + this%h2osoi_vol_col(c,j) = min(this%h2osoi_vol_col(c,j), watsat_col(c,j)) + if (t_soisno_col(c,j) <= SHR_CONST_TKFRZ) then + this%h2osoi_ice_col(c,j) = col%dz(c,j)*denice*this%h2osoi_vol_col(c,j) + this%h2osoi_liq_col(c,j) = 0._r8 + else + this%h2osoi_ice_col(c,j) = 0._r8 + this%h2osoi_liq_col(c,j) = col%dz(c,j)*denh2o*this%h2osoi_vol_col(c,j) + endif + end do + do j = -nlevsno+1, 0 + if (j > snl(c)) then + this%h2osoi_ice_col(c,j) = col%dz(c,j)*250._r8 + this%h2osoi_liq_col(c,j) = 0._r8 + end if + end do + end if + end do + + !-------------------------------------------- + ! Set Lake water + !-------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%lakpoi(l)) then + do j = -nlevsno+1, 0 + if (j > snl(c)) then + this%h2osoi_ice_col(c,j) = col%dz(c,j)*bdsno + this%h2osoi_liq_col(c,j) = 0._r8 + end if + end do + do j = 1,nlevgrnd + if (j <= nlevsoi) then ! soil + this%h2osoi_vol_col(c,j) = watsat_col(c,j) + this%h2osoi_liq_col(c,j) = spval + this%h2osoi_ice_col(c,j) = spval + else ! bedrock + this%h2osoi_vol_col(c,j) = 0._r8 + end if + end do + end if + end do + + !-------------------------------------------- + ! For frozen layers !TODO - does the following make sense ???? it seems to overwrite everything + !-------------------------------------------- + + do c = bounds%begc, bounds%endc + do j = 1,nlevgrnd + if (t_soisno_col(c,j) <= tfrz) then + this%h2osoi_ice_col(c,j) = col%dz(c,j)*denice*this%h2osoi_vol_col(c,j) + this%h2osoi_liq_col(c,j) = 0._r8 + else + this%h2osoi_ice_col(c,j) = 0._r8 + this%h2osoi_liq_col(c,j) = col%dz(c,j)*denh2o*this%h2osoi_vol_col(c,j) + endif + end do + end do + + end associate + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, & + watsat_col) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use spmdMod , only : masterproc + use clm_varcon , only : denice, denh2o, pondmx, watmin, spval + use landunit_varcon , only : istcrop, istdlak, istsoil + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use clm_time_manager , only : is_first_step + use clm_varctl , only : bound_h2osoi + use ncdio_pio , only : file_desc_t, ncd_io, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + real(r8) , intent(in) :: watsat_col (bounds%begc:, 1:) ! volumetric soil water at saturation (porosity) + ! + ! !LOCAL VARIABLES: + integer :: c,l,j,nlevs + logical :: readvar + real(r8) :: maxwatsat ! maximum porosity + real(r8) :: excess ! excess volumetric soil water + real(r8) :: totwat ! total soil water (mm) + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc,nlevgrnd/)) , errMsg(__FILE__, __LINE__)) + + call restartvar(ncid=ncid, flag=flag, varname='INT_SNOW', xtype=ncd_double, & + dim1name='column', & + long_name='accuumulated snow', units='mm', & + interpinic_flag='interp', readvar=readvar, data=this%int_snow_col) + if (flag=='read' .and. .not. readvar) then + this%int_snow_col(:) = 0.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='H2OSFC', xtype=ncd_double, & + dim1name='column', & + long_name='surface water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%h2osfc_col) + if (flag=='read' .and. .not. readvar) then + this%h2osfc_col(bounds%begc:bounds%endc) = 0.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='H2OSNO', xtype=ncd_double, & + dim1name='column', & + long_name='snow water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%h2osno_col) + + call restartvar(ncid=ncid, flag=flag, varname='H2OSOI_LIQ', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='liquid water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%h2osoi_liq_col) + + call restartvar(ncid=ncid, flag=flag, varname='H2OSOI_ICE', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='ice lens', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%h2osoi_ice_col) + + call restartvar(ncid=ncid, flag=flag, varname='H2OCAN', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%h2ocan_patch) + + call restartvar(ncid=ncid, flag=flag, varname='SNOCAN', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy snow water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%snocan_patch) + + ! NOTE(wjs, 2015-07-01) In old restart files, there was no LIQCAN variable. However, + ! H2OCAN had similar meaning. So if we can't find LIQCAN, use H2OCAN to initialize + ! liqcan_patch. + call restartvar(ncid=ncid, flag=flag, varname='LIQCAN:H2OCAN', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy liquid water', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%liqcan_patch) + + call restartvar(ncid=ncid, flag=flag, varname='SNOUNLOAD', xtype=ncd_double, & + dim1name='pft', & + long_name='Canopy snow unloading', units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%snounload_patch) + + if(use_luna)then + call restartvar(ncid=ncid, flag=flag, varname='rh10', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean boundary layer relatie humidity', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%rh10_af_patch) + endif + + ! Determine volumetric soil water (for read only) + if (flag == 'read' ) then + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if ( col%itype(c) == icol_sunwall .or. & + col%itype(c) == icol_shadewall .or. & + col%itype(c) == icol_roof )then + nlevs = nlevurb + else + nlevs = nlevgrnd + end if + if ( lun%itype(l) /= istdlak ) then ! This calculation is now done for lakes in initLake. + do j = 1,nlevs + this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) & + + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice) + end do + end if + end do + end if + + ! If initial run -- ensure that water is properly bounded (read only) + if (flag == 'read' ) then + if ( is_first_step() .and. bound_h2osoi) then + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if ( col%itype(c) == icol_sunwall .or. col%itype(c) == icol_shadewall .or. & + col%itype(c) == icol_roof )then + nlevs = nlevurb + else + nlevs = nlevgrnd + end if + do j = 1,nlevs + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%h2osoi_liq_col(c,j) = max(0._r8,this%h2osoi_liq_col(c,j)) + this%h2osoi_ice_col(c,j) = max(0._r8,this%h2osoi_ice_col(c,j)) + this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) & + + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice) + if (j == 1) then + maxwatsat = (watsat_col(c,j)*col%dz(c,j)*1000.0_r8 + pondmx) / (col%dz(c,j)*1000.0_r8) + else + maxwatsat = watsat_col(c,j) + end if + if (this%h2osoi_vol_col(c,j) > maxwatsat) then + excess = (this%h2osoi_vol_col(c,j) - maxwatsat)*col%dz(c,j)*1000.0_r8 + totwat = this%h2osoi_liq_col(c,j) + this%h2osoi_ice_col(c,j) + this%h2osoi_liq_col(c,j) = this%h2osoi_liq_col(c,j) - & + (this%h2osoi_liq_col(c,j)/totwat) * excess + this%h2osoi_ice_col(c,j) = this%h2osoi_ice_col(c,j) - & + (this%h2osoi_ice_col(c,j)/totwat) * excess + end if + this%h2osoi_liq_col(c,j) = max(watmin,this%h2osoi_liq_col(c,j)) + this%h2osoi_ice_col(c,j) = max(watmin,this%h2osoi_ice_col(c,j)) + this%h2osoi_vol_col(c,j) = this%h2osoi_liq_col(c,j)/(col%dz(c,j)*denh2o) & + + this%h2osoi_ice_col(c,j)/(col%dz(c,j)*denice) + end if + end do + end do + end if + + endif ! end if if-read flag + + call restartvar(ncid=ncid, flag=flag, varname='FH2OSFC', xtype=ncd_double, & + dim1name='column',& + long_name='fraction of ground covered by h2osfc (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%frac_h2osfc_col) + if (flag == 'read' .and. .not. readvar) then + this%frac_h2osfc_col(bounds%begc:bounds%endc) = 0.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='SNOW_DEPTH', xtype=ncd_double, & + dim1name='column', & + long_name='snow depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=this%snow_depth_col) + + call restartvar(ncid=ncid, flag=flag, varname='SNOW_PERS', xtype=ncd_double, & + dim1name='column', & + long_name='continuous snow cover time', units='sec', & + interpinic_flag='interp', readvar=readvar, data=this%snow_persistence_col) + if (flag=='read' .and. .not. readvar) then + this%snow_persistence_col(:) = 0.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='frac_sno_eff', xtype=ncd_double, & + dim1name='column', & + long_name='fraction of ground covered by snow (0 to 1)',units='unitless', & + interpinic_flag='interp', readvar=readvar, data=this%frac_sno_eff_col) + if (flag == 'read' .and. .not. readvar) then + this%frac_sno_eff_col(bounds%begc:bounds%endc) = 0.0_r8 + end if + + call restartvar(ncid=ncid, flag=flag, varname='frac_sno', xtype=ncd_double, & + dim1name='column', & + long_name='fraction of ground covered by snow (0 to 1)',units='unitless',& + interpinic_flag='interp', readvar=readvar, data=this%frac_sno_col) + + call restartvar(ncid=ncid, flag=flag, varname='FWET', xtype=ncd_double, & + dim1name='pft', & + long_name='fraction of canopy that is wet (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fwet_patch) + + call restartvar(ncid=ncid, flag=flag, varname='FCANSNO', xtype=ncd_double, & + dim1name='pft', & + long_name='fraction of canopy that is snow covered (0 to 1)', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fcansno_patch) + + ! column type physical state variable - snw_rds + call restartvar(ncid=ncid, flag=flag, varname='snw_rds', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer effective radius', units='um', & + interpinic_flag='interp', readvar=readvar, data=this%snw_rds_col) + if (flag == 'read' .and. .not. readvar) then + + ! initial run, not restart: initialize snw_rds + if (masterproc) then + write(iulog,*) "SNICAR: This is an initial run (not a restart), and grain size/aerosol " // & + "mass data are not defined in initial condition file. Initialize snow " // & + "effective radius to fresh snow value, and snow/aerosol masses to zero." + endif + + do c= bounds%begc, bounds%endc + if (col%snl(c) < 0) then + this%snw_rds_col(c,col%snl(c)+1:0) = snw_rds_min + this%snw_rds_col(c,-nlevsno+1:col%snl(c)) = 0._r8 + this%snw_rds_top_col(c) = snw_rds_min + this%sno_liq_top_col(c) = this%h2osoi_liq_col(c,col%snl(c)+1) / & + (this%h2osoi_liq_col(c,col%snl(c)+1)+this%h2osoi_ice_col(c,col%snl(c)+1)) + elseif (this%h2osno_col(c) > 0._r8) then + this%snw_rds_col(c,0) = snw_rds_min + this%snw_rds_col(c,-nlevsno+1:-1) = 0._r8 + this%snw_rds_top_col(c) = spval + this%sno_liq_top_col(c) = spval + else + this%snw_rds_col(c,:) = 0._r8 + this%snw_rds_top_col(c) = spval + this%sno_liq_top_col(c) = spval + endif + enddo + endif + + call restartvar(ncid=ncid, flag=flag, varname='qaf', xtype=ncd_double, dim1name='landunit', & + long_name='urban canopy specific humidity', units='kg/kg', & + interpinic_flag='interp', readvar=readvar, data=this%qaf_lun) + + if (use_cn) then + call restartvar(ncid=ncid, flag=flag, varname='wf', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%wf_col) + end if + + + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Reset(this, column) + ! + ! !DESCRIPTION: + ! Intitialize SNICAR variables for fresh snow column + ! + ! !ARGUMENTS: + class(waterstate_type) :: this + integer , intent(in) :: column ! column index + !----------------------------------------------------------------------- + + this%snw_rds_col(column,0) = snw_rds_min + + end subroutine Reset + +end module WaterstateType diff --git a/components/clm/src/biogeophys/WaterfluxType.F90 b/components/clm/src/biogeophys/WaterfluxType.F90 new file mode 100644 index 0000000000..3f65072b8e --- /dev/null +++ b/components/clm/src/biogeophys/WaterfluxType.F90 @@ -0,0 +1,545 @@ +module WaterfluxType + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC TYPES: + type, public :: waterflux_type + + ! water fluxes are in units or mm/s + + real(r8), pointer :: qflx_prec_grnd_patch (:) ! patch water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_rain_grnd_patch (:) ! patch rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_rain_grnd_col (:) ! col rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_patch (:) ! patch snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_col (:) ! col snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_sub_snow_patch (:) ! patch sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow_col (:) ! col sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_evap_soi_patch (:) ! patch soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_soi_col (:) ! col soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_veg_patch (:) ! patch vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_veg_col (:) ! col vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can_patch (:) ! patch evaporation from leaves and stems (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can_col (:) ! col evaporation from leaves and stems (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot_patch (:) ! patch pft_qflx_evap_soi + pft_qflx_evap_veg + qflx_tran_veg + real(r8), pointer :: qflx_evap_tot_col (:) ! col col_qflx_evap_soi + col_qflx_evap_veg + qflx_tran_veg + real(r8), pointer :: qflx_evap_grnd_patch (:) ! patch ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_evap_grnd_col (:) ! col ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_snwcp_liq_patch (:) ! patch excess rainfall due to snow capping (mm H2O /s) + real(r8), pointer :: qflx_snwcp_liq_col (:) ! col excess rainfall due to snow capping (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice_patch (:) ! patch excess snowfall due to snow capping (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice_col (:) ! col excess snowfall due to snow capping (mm H2O /s) + real(r8), pointer :: qflx_tran_veg_patch (:) ! patch vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg_col (:) ! col vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_dew_snow_patch (:) ! patch surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow_col (:) ! col surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd_patch (:) ! patch ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd_col (:) ! col ground surface dew formation (mm H2O /s) [+] (+ = to atm); usually eflx_bot >= 0) + real(r8), pointer :: qflx_prec_intr_patch (:) ! patch interception of precipitation [mm/s] + real(r8), pointer :: qflx_prec_intr_col (:) ! col interception of precipitation [mm/s] + real(r8), pointer :: qflx_snowindunload_patch (:) ! patch canopy snow wind unloading (mm H2O /s) + real(r8), pointer :: qflx_snowindunload_col (:) ! col canopy snow wind unloading (mm H2O /s) + real(r8), pointer :: qflx_snotempunload_patch (:) ! patch canopy snow temp unloading (mm H2O /s) + real(r8), pointer :: qflx_snotempunload_col (:) ! col canopy snow temp unloading (mm H2O /s) + + real(r8), pointer :: qflx_ev_snow_patch (:) ! patch evaporation heat flux from snow (W/m**2) [+ to atm] + real(r8), pointer :: qflx_ev_snow_col (:) ! col evaporation heat flux from snow (W/m**2) [+ to atm] + real(r8), pointer :: qflx_ev_soil_patch (:) ! patch evaporation heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: qflx_ev_soil_col (:) ! col evaporation heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (W/m**2) [+ to atm] + + real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] + real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] + real(r8), pointer :: qflx_infl_col (:) ! col infiltration (mm H2O /s) + real(r8), pointer :: qflx_surf_col (:) ! col surface runoff (mm H2O /s) + real(r8), pointer :: qflx_drain_col (:) ! col sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_top_soil_col (:) ! col net water input into soil from top (mm/s) + real(r8), pointer :: qflx_h2osfc_to_ice_col (:) ! col conversion of h2osfc to ice + real(r8), pointer :: qflx_h2osfc_surf_col (:) ! col surface water runoff + real(r8), pointer :: qflx_snow_h2osfc_col (:) ! col snow falling on surface water + real(r8), pointer :: qflx_drain_perched_col (:) ! col sub-surface runoff from perched wt (mm H2O /s) + real(r8), pointer :: qflx_deficit_col (:) ! col water deficit to keep non-negative liquid water content (mm H2O) + real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level + real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s) + real(r8), pointer :: qflx_snow_drain_col (:) ! col drainage from snow pack + real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_u_col (:) ! col urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + real(r8), pointer :: qflx_rsub_sat_col (:) ! col soil saturation excess [mm/s] + real(r8), pointer :: qflx_snofrz_lyr_col (:,:) ! col snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + real(r8), pointer :: qflx_snofrz_col (:) ! col column-integrated snow freezing rate (positive definite) (col) [kg m-2 s-1] + real(r8), pointer :: qflx_glcice_col (:) ! col net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC + real(r8), pointer :: qflx_glcice_frz_col (:) ! col ice growth (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_glcice_melt_col (:) ! col ice melt (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_drain_vr_col (:,:) ! col liquid water losted as drainage (m /time step) + real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s) + real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s) + + ! Dynamic land cover change + real(r8), pointer :: qflx_liq_dynbal_grc (:) ! grc liq dynamic land cover change conversion runoff flux + real(r8), pointer :: qflx_ice_dynbal_grc (:) ! grc ice dynamic land cover change conversion runoff flux + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type waterflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(waterflux_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) ! same as "call initAllocate_type(hydro, bounds)" + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + ! + ! !ARGUMENTS: + class(waterflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan + allocate(this%qflx_prec_grnd_patch (begp:endp)) ; this%qflx_prec_grnd_patch (:) = nan + allocate(this%qflx_rain_grnd_patch (begp:endp)) ; this%qflx_rain_grnd_patch (:) = nan + allocate(this%qflx_snow_grnd_patch (begp:endp)) ; this%qflx_snow_grnd_patch (:) = nan + allocate(this%qflx_sub_snow_patch (begp:endp)) ; this%qflx_sub_snow_patch (:) = 0.0_r8 + allocate(this%qflx_snwcp_liq_patch (begp:endp)) ; this%qflx_snwcp_liq_patch (:) = nan + allocate(this%qflx_snwcp_ice_patch (begp:endp)) ; this%qflx_snwcp_ice_patch (:) = nan + allocate(this%qflx_tran_veg_patch (begp:endp)) ; this%qflx_tran_veg_patch (:) = nan + + allocate(this%qflx_snowindunload_patch (begp:endp)) ; this%qflx_snowindunload_patch (:) = nan + allocate(this%qflx_snowindunload_col (begp:endp)) ; this%qflx_snowindunload_col (:) = nan + allocate(this%qflx_snotempunload_patch (begp:endp)) ; this%qflx_snotempunload_patch (:) = nan + allocate(this%qflx_snotempunload_col (begp:endp)) ; this%qflx_snotempunload_col (:) = nan + + allocate(this%qflx_dew_grnd_patch (begp:endp)) ; this%qflx_dew_grnd_patch (:) = nan + allocate(this%qflx_dew_snow_patch (begp:endp)) ; this%qflx_dew_snow_patch (:) = nan + + allocate(this%qflx_prec_intr_col (begc:endc)) ; this%qflx_prec_intr_col (:) = nan + allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan + allocate(this%qflx_rain_grnd_col (begc:endc)) ; this%qflx_rain_grnd_col (:) = nan + allocate(this%qflx_snow_grnd_col (begc:endc)) ; this%qflx_snow_grnd_col (:) = nan + allocate(this%qflx_sub_snow_col (begc:endc)) ; this%qflx_sub_snow_col (:) = 0.0_r8 + allocate(this%qflx_snwcp_liq_col (begc:endc)) ; this%qflx_snwcp_liq_col (:) = nan + allocate(this%qflx_snwcp_ice_col (begc:endc)) ; this%qflx_snwcp_ice_col (:) = nan + allocate(this%qflx_tran_veg_col (begc:endc)) ; this%qflx_tran_veg_col (:) = nan + allocate(this%qflx_evap_veg_col (begc:endc)) ; this%qflx_evap_veg_col (:) = nan + allocate(this%qflx_evap_can_col (begc:endc)) ; this%qflx_evap_can_col (:) = nan + allocate(this%qflx_evap_soi_col (begc:endc)) ; this%qflx_evap_soi_col (:) = nan + allocate(this%qflx_evap_tot_col (begc:endc)) ; this%qflx_evap_tot_col (:) = nan + allocate(this%qflx_evap_grnd_col (begc:endc)) ; this%qflx_evap_grnd_col (:) = nan + allocate(this%qflx_dew_grnd_col (begc:endc)) ; this%qflx_dew_grnd_col (:) = nan + allocate(this%qflx_dew_snow_col (begc:endc)) ; this%qflx_dew_snow_col (:) = nan + allocate(this%qflx_evap_veg_patch (begp:endp)) ; this%qflx_evap_veg_patch (:) = nan + allocate(this%qflx_evap_can_patch (begp:endp)) ; this%qflx_evap_can_patch (:) = nan + allocate(this%qflx_evap_soi_patch (begp:endp)) ; this%qflx_evap_soi_patch (:) = nan + allocate(this%qflx_evap_tot_patch (begp:endp)) ; this%qflx_evap_tot_patch (:) = nan + allocate(this%qflx_evap_grnd_patch (begp:endp)) ; this%qflx_evap_grnd_patch (:) = nan + + allocate( this%qflx_ev_snow_patch (begp:endp)) ; this%qflx_ev_snow_patch (:) = nan + allocate( this%qflx_ev_snow_col (begc:endc)) ; this%qflx_ev_snow_col (:) = nan + allocate( this%qflx_ev_soil_patch (begp:endp)) ; this%qflx_ev_soil_patch (:) = nan + allocate( this%qflx_ev_soil_col (begc:endc)) ; this%qflx_ev_soil_col (:) = nan + allocate( this%qflx_ev_h2osfc_patch (begp:endp)) ; this%qflx_ev_h2osfc_patch (:) = nan + allocate( this%qflx_ev_h2osfc_col (begc:endc)) ; this%qflx_ev_h2osfc_col (:) = nan + + allocate(this%qflx_drain_vr_col (begc:endc,1:nlevsoi)) ; this%qflx_drain_vr_col (:,:) = nan + allocate(this%qflx_adv_col (begc:endc,0:nlevsoi)) ; this%qflx_adv_col (:,:) = nan + allocate(this%qflx_rootsoi_col (begc:endc,1:nlevsoi)) ; this%qflx_rootsoi_col (:,:) = nan + allocate(this%qflx_infl_col (begc:endc)) ; this%qflx_infl_col (:) = nan + allocate(this%qflx_surf_col (begc:endc)) ; this%qflx_surf_col (:) = nan + allocate(this%qflx_drain_col (begc:endc)) ; this%qflx_drain_col (:) = nan + allocate(this%qflx_top_soil_col (begc:endc)) ; this%qflx_top_soil_col (:) = nan + allocate(this%qflx_h2osfc_to_ice_col (begc:endc)) ; this%qflx_h2osfc_to_ice_col (:) = nan + allocate(this%qflx_h2osfc_surf_col (begc:endc)) ; this%qflx_h2osfc_surf_col (:) = nan + allocate(this%qflx_snow_h2osfc_col (begc:endc)) ; this%qflx_snow_h2osfc_col (:) = nan + allocate(this%qflx_snomelt_col (begc:endc)) ; this%qflx_snomelt_col (:) = nan + allocate(this%qflx_snow_drain_col (begc:endc)) ; this%qflx_snow_drain_col (:) = nan + allocate(this%qflx_snofrz_col (begc:endc)) ; this%qflx_snofrz_col (:) = nan + allocate(this%qflx_snofrz_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snofrz_lyr_col (:,:) = nan + allocate(this%qflx_qrgwl_col (begc:endc)) ; this%qflx_qrgwl_col (:) = nan + allocate(this%qflx_drain_perched_col (begc:endc)) ; this%qflx_drain_perched_col (:) = nan + allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan + allocate(this%qflx_floodc_col (begc:endc)) ; this%qflx_floodc_col (:) = nan + allocate(this%qflx_sl_top_soil_col (begc:endc)) ; this%qflx_sl_top_soil_col (:) = nan + allocate(this%qflx_runoff_col (begc:endc)) ; this%qflx_runoff_col (:) = nan + allocate(this%qflx_runoff_r_col (begc:endc)) ; this%qflx_runoff_r_col (:) = nan + allocate(this%qflx_runoff_u_col (begc:endc)) ; this%qflx_runoff_u_col (:) = nan + allocate(this%qflx_rsub_sat_col (begc:endc)) ; this%qflx_rsub_sat_col (:) = nan + allocate(this%qflx_glcice_col (begc:endc)) ; this%qflx_glcice_col (:) = nan + allocate(this%qflx_glcice_frz_col (begc:endc)) ; this%qflx_glcice_frz_col (:) = nan + allocate(this%qflx_glcice_melt_col (begc:endc)) ; this%qflx_glcice_melt_col (:) = nan + allocate(this%snow_sources_col (begc:endc)) ; this%snow_sources_col (:) = nan + allocate(this%snow_sinks_col (begc:endc)) ; this%snow_sinks_col (:) = nan + + allocate(this%qflx_liq_dynbal_grc (begg:endg)) ; this%qflx_liq_dynbal_grc (:) = nan + allocate(this%qflx_ice_dynbal_grc (begg:endg)) ; this%qflx_ice_dynbal_grc (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !USES: + use clm_varctl , only : create_glacier_mec_landunit, use_cn + use histFileMod , only : hist_addfld1d + ! + ! !ARGUMENTS: + class(waterflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + + this%qflx_top_soil_col(begc:endc) = spval + call hist_addfld1d (fname='QTOPSOIL', units='mm/s', & + avgflag='A', long_name='water input to surface', & + ptr_col=this%qflx_top_soil_col, c2l_scale_type='urbanf', default='inactive') + + this%qflx_infl_col(begc:endc) = spval + call hist_addfld1d (fname='QINFL', units='mm/s', & + avgflag='A', long_name='infiltration', & + ptr_col=this%qflx_infl_col, c2l_scale_type='urbanf') + + this%qflx_surf_col(begc:endc) = spval + call hist_addfld1d (fname='QOVER', units='mm/s', & + avgflag='A', long_name='surface runoff', & + ptr_col=this%qflx_surf_col, c2l_scale_type='urbanf') + + this%qflx_qrgwl_col(begc:endc) = spval + call hist_addfld1d (fname='QRGWL', units='mm/s', & + avgflag='A', long_name='surface runoff at glaciers (liquid only), wetlands, lakes', & + ptr_col=this%qflx_qrgwl_col, c2l_scale_type='urbanf') + + this%qflx_drain_col(begc:endc) = spval + call hist_addfld1d (fname='QDRAI', units='mm/s', & + avgflag='A', long_name='sub-surface drainage', & + ptr_col=this%qflx_drain_col, c2l_scale_type='urbanf') + + this%qflx_liq_dynbal_grc(begg:endg) = spval + call hist_addfld1d (fname='QFLX_LIQ_DYNBAL', units='mm/s', & + avgflag='A', long_name='liq dynamic land cover change conversion runoff flux', & + ptr_lnd=this%qflx_liq_dynbal_grc) + + this%qflx_ice_dynbal_grc(begg:endg) = spval + call hist_addfld1d (fname='QFLX_ICE_DYNBAL', units='mm/s', & + avgflag='A', long_name='ice dynamic land cover change conversion runoff flux', & + ptr_lnd=this%qflx_ice_dynbal_grc) + + this%qflx_runoff_col(begc:endc) = spval + call hist_addfld1d (fname='QRUNOFF', units='mm/s', & + avgflag='A', & + long_name='total liquid runoff (does not include QSNWCPICE) not including correction for land use change', & + ptr_col=this%qflx_runoff_col, c2l_scale_type='urbanf') + + this%qflx_runoff_u_col(begc:endc) = spval + call hist_addfld1d (fname='QRUNOFF_U', units='mm/s', & + avgflag='A', long_name='Urban total runoff', & + ptr_col=this%qflx_runoff_u_col, set_nourb=spval, c2l_scale_type='urbanf') + + this%qflx_runoff_r_col(begc:endc) = spval + call hist_addfld1d (fname='QRUNOFF_R', units='mm/s', & + avgflag='A', long_name='Rural total runoff', & + ptr_col=this%qflx_runoff_r_col, set_spec=spval) + + this%qflx_snow_drain_col(begc:endc) = spval + call hist_addfld1d (fname='QFLX_SNOW_DRAIN', units='mm/s', & + avgflag='A', long_name='drainage from snow pack', & + ptr_col=this%qflx_snow_drain_col, c2l_scale_type='urbanf') + + this%qflx_snomelt_col(begc:endc) = spval + call hist_addfld1d (fname='QSNOMELT', units='mm/s', & + avgflag='A', long_name='snow melt', & + ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf') + + this%qflx_snofrz_col(begc:endc) = spval + call hist_addfld1d (fname='QSNOFRZ', units='kg/m2/s', & + avgflag='A', long_name='column-integrated snow freezing rate', & + ptr_col=this%qflx_snofrz_col, set_lake=spval, c2l_scale_type='urbanf') + + if (create_glacier_mec_landunit) then + this%qflx_glcice_col(begc:endc) = spval + call hist_addfld1d (fname='QICE', units='mm/s', & + avgflag='A', long_name='ice growth/melt', & + ptr_col=this%qflx_glcice_col, l2g_scale_type='ice') + end if + + if (create_glacier_mec_landunit) then + this%qflx_glcice_frz_col(begc:endc) = spval + call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & + avgflag='A', long_name='ice growth', & + ptr_col=this%qflx_glcice_frz_col, l2g_scale_type='ice') + end if + + if (create_glacier_mec_landunit) then + this%qflx_glcice_melt_col(begc:endc) = spval + call hist_addfld1d (fname='QICE_MELT', units='mm/s', & + avgflag='A', long_name='ice melt', & + ptr_col=this%qflx_glcice_melt_col, l2g_scale_type='ice') + end if + + this%qflx_prec_intr_patch(begp:endp) = spval + call hist_addfld1d (fname='QINTR', units='mm/s', & + avgflag='A', long_name='interception', & + ptr_patch=this%qflx_prec_intr_patch, set_lake=0._r8) + + this%qflx_prec_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='QDRIP', units='mm/s', & + avgflag='A', long_name='throughfall', & + ptr_patch=this%qflx_prec_grnd_patch, c2l_scale_type='urbanf') + + this%qflx_evap_soi_patch(begp:endp) = spval + call hist_addfld1d (fname='QSOIL', units='mm/s', & + avgflag='A', long_name= 'Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew)', & + ptr_patch=this%qflx_evap_soi_patch, c2l_scale_type='urbanf') + + this%qflx_evap_can_patch(begp:endp) = spval + call hist_addfld1d (fname='QVEGE', units='mm/s', & + avgflag='A', long_name='canopy evaporation', & + ptr_patch=this%qflx_evap_can_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%qflx_tran_veg_patch(begp:endp) = spval + call hist_addfld1d (fname='QVEGT', units='mm/s', & + avgflag='A', long_name='canopy transpiration', & + ptr_patch=this%qflx_tran_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%qflx_snwcp_liq_patch(begp:endp) = spval + call hist_addfld1d (fname='QSNWCPLIQ', units='mm H2O/s', & + avgflag='A', long_name='excess rainfall due to snow capping', & + ptr_patch=this%qflx_snwcp_liq_patch, c2l_scale_type='urbanf', default='inactive') + + this%qflx_snowindunload_patch(begp:endp) = spval + call hist_addfld1d (fname='QSNOWINDUNLOAD', units='mm/s', & + avgflag='A', long_name='canopy snow wind unloading', & + ptr_patch=this%qflx_snowindunload_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + this%qflx_snotempunload_patch(begp:endp) = spval + call hist_addfld1d (fname='QSNOTEMPUNLOAD', units='mm/s', & + avgflag='A', long_name='canopy snow temp unloading', & + ptr_patch=this%qflx_snotempunload_patch, set_lake=0._r8, c2l_scale_type='urbanf') + + ! Use qflx_snwcp_ice_col rather than qflx_snwcp_ice_patch, because the column version + ! is the final version, which includes some additional corrections beyond the patch-level version + this%qflx_snwcp_ice_patch(begp:endp) = spval + call hist_addfld1d (fname='QSNWCPICE', units='mm H2O/s', & + avgflag='A', long_name='excess snowfall due to snow capping not including correction for land use change', & + ptr_col=this%qflx_snwcp_ice_col, c2l_scale_type='urbanf') + + if (use_cn) then + this%qflx_rain_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_RAIN_GRND', units='mm H2O/s', & + avgflag='A', long_name='rain on ground after interception', & + ptr_patch=this%qflx_rain_grnd_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_snow_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_SNOW_GRND', units='mm H2O/s', & + avgflag='A', long_name='snow on ground after interception', & + ptr_patch=this%qflx_snow_grnd_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_evap_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_EVAP_GRND', units='mm H2O/s', & + avgflag='A', long_name='ground surface evaporation', & + ptr_patch=this%qflx_evap_grnd_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_evap_veg_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_EVAP_VEG', units='mm H2O/s', & + avgflag='A', long_name='vegetation evaporation', & + ptr_patch=this%qflx_evap_veg_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_evap_tot_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_EVAP_TOT', units='mm H2O/s', & + avgflag='A', long_name='qflx_evap_soi + qflx_evap_can + qflx_tran_veg', & + ptr_patch=this%qflx_evap_tot_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_dew_grnd_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_DEW_GRND', units='mm H2O/s', & + avgflag='A', long_name='ground surface dew formation', & + ptr_patch=this%qflx_dew_grnd_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_sub_snow_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_SUB_SNOW', units='mm H2O/s', & + avgflag='A', long_name='sublimation rate from snow pack', & + ptr_patch=this%qflx_sub_snow_patch, default='inactive', c2l_scale_type='urbanf') + end if + + if (use_cn) then + this%qflx_dew_snow_patch(begp:endp) = spval + call hist_addfld1d (fname='QFLX_DEW_SNOW', units='mm H2O/s', & + avgflag='A', long_name='surface dew added to snow pacK', & + ptr_patch=this%qflx_dew_snow_patch, default='inactive', c2l_scale_type='urbanf') + end if + + this%qflx_h2osfc_surf_col(begc:endc) = spval + call hist_addfld1d (fname='QH2OSFC', units='mm/s', & + avgflag='A', long_name='surface water runoff', & + ptr_col=this%qflx_h2osfc_surf_col) + + this%qflx_drain_perched_col(begc:endc) = spval + call hist_addfld1d (fname='QDRAI_PERCH', units='mm/s', & + avgflag='A', long_name='perched wt drainage', & + ptr_col=this%qflx_drain_perched_col, c2l_scale_type='urbanf') + + this%qflx_rsub_sat_col(begc:endc) = spval + call hist_addfld1d (fname='QDRAI_XS', units='mm/s', & + avgflag='A', long_name='saturation excess drainage', & + ptr_col=this%qflx_rsub_sat_col, c2l_scale_type='urbanf') + + ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at any + ! given time step but only if there is at least one snow layer (for all landunits + ! except lakes). Also note that monthly average files of snow_sources and snow_sinks + ! sinks must be weighted by number of days in the month to diagnose, for example, an + ! annual value of the change in h2osno. + + this%snow_sources_col(begc:endc) = spval + call hist_addfld1d (fname='SNOW_SOURCES', units='mm/s', & + avgflag='A', long_name='snow sources (liquid water)', & + ptr_col=this%snow_sources_col, c2l_scale_type='urbanf') + + this%snow_sinks_col(begc:endc) = spval + call hist_addfld1d (fname='SNOW_SINKS', units='mm/s', & + avgflag='A', long_name='snow sinks (liquid water)', & + ptr_col=this%snow_sinks_col, c2l_scale_type='urbanf') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop + ! + ! !ARGUMENTS: + class(waterflux_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,c,l + !----------------------------------------------------------------------- + + this%qflx_evap_grnd_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_dew_grnd_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_dew_snow_patch (bounds%begp:bounds%endp) = 0.0_r8 + + this%qflx_evap_grnd_col(bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_dew_grnd_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_dew_snow_col (bounds%begc:bounds%endc) = 0.0_r8 + + this%qflx_h2osfc_surf_col(bounds%begc:bounds%endc) = 0._r8 + this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 + + ! needed for CNNLeaching + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%qflx_drain_col(c) = 0._r8 + this%qflx_surf_col(c) = 0._r8 + end if + end do + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio, only : file_desc_t, ncd_double + use restUtilMod + ! + ! !ARGUMENTS: + class(waterflux_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + !----------------------------------------------------------------------- + + ! needed for SNICAR + call restartvar(ncid=ncid, flag=flag, varname='qflx_snofrz_lyr', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer ice freezing rate', units='kg m-2 s-1', & + interpinic_flag='interp', readvar=readvar, data=this%qflx_snofrz_lyr_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize qflx_snofrz_lyr to zero + this%qflx_snofrz_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 + endif + + call restartvar(ncid=ncid, flag=flag, varname='qflx_snow_drain:qflx_snow_melt', xtype=ncd_double, & + dim1name='column', & + long_name='drainage from snow column', units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%qflx_snow_drain_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize qflx_snow_drain to zero + this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 + endif + + end subroutine Restart + +end module WaterfluxType diff --git a/components/clm/src/biogeophys/test/CMakeLists.txt b/components/clm/src/biogeophys/test/CMakeLists.txt new file mode 100644 index 0000000000..94bc536d1e --- /dev/null +++ b/components/clm/src/biogeophys/test/CMakeLists.txt @@ -0,0 +1,4 @@ +add_subdirectory(Daylength_test) +add_subdirectory(Irrigation_test) +add_subdirectory(HumanStress_test) +add_subdirectory(SnowHydrology_test) \ No newline at end of file diff --git a/components/clm/src/biogeophys/test/Daylength_test/CMakeLists.txt b/components/clm/src/biogeophys/test/Daylength_test/CMakeLists.txt new file mode 100644 index 0000000000..129f227972 --- /dev/null +++ b/components/clm/src/biogeophys/test/Daylength_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(daylength test_daylength_exe + "test_daylength.pf" "") + +target_link_libraries(test_daylength_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/biogeophys/test/Daylength_test/test_daylength.pf b/components/clm/src/biogeophys/test/Daylength_test/test_daylength.pf new file mode 100644 index 0000000000..b326a1190a --- /dev/null +++ b/components/clm/src/biogeophys/test/Daylength_test/test_daylength.pf @@ -0,0 +1,76 @@ +module test_daylength + + ! Tests of the daylength function in DaylengthMod + + use pfunit_mod + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod, only : SHR_CONST_PI + use DaylengthMod , only : daylength + + implicit none + save + + real(r8), parameter :: tol = 1.e-3_r8 + +contains + + @Test + subroutine test_standard_points() + ! Tests multiple points, not edge cases + + @assertEqual([26125.331269192659_r8, 33030.159082987258_r8], daylength([-1.4_r8, -1.3_r8], 0.1_r8), tolerance=tol) + end subroutine test_standard_points + + + @Test + subroutine test_near_poles() + ! Tests points near the north and south pole, which should result in full night and + ! full day + + @assertEqual([0.0_r8, 86400.0_r8], daylength([-1.5_r8, 1.5_r8], 0.1_r8), tolerance=tol) + end subroutine test_near_poles + + + @Test + subroutine test_north_pole() + ! Tests north pole point, including rounding error + + @assertEqual(86400._r8, daylength(SHR_CONST_PI/2.0_r8, 0.1_r8), tolerance=tol) + @assertEqual(86400._r8, daylength(SHR_CONST_PI/1.999999999999999_r8, 0.1_r8), tolerance=tol) + end subroutine test_north_pole + + + @Test + subroutine test_south_pole() + ! Tests north pole point, including rounding error + + @assertEqual(0._r8, daylength(-1.0_r8 * SHR_CONST_PI/2.0_r8, 0.1_r8), tolerance=tol) + @assertEqual(0._r8, daylength(-1.0_r8 * SHR_CONST_PI/1.999999999999999_r8, 0.1_r8), tolerance=tol) + end subroutine test_south_pole + + + @Test + subroutine test_error_in_decl() + + @assertIsNaN(daylength(-1.0_r8, -3.0_r8)) + end subroutine test_error_in_decl + + + @Test + subroutine test_error_in_lat_scalar() + + @assertIsNaN(daylength(3.0_r8, 0.1_r8)) + end subroutine test_error_in_lat_scalar + + @Test + subroutine test_error_in_lat_array() + real(r8) :: my_result(2) + + my_result = daylength([1.0_r8, 3.0_r8], 0.1_r8) + @assertIsFinite(my_result(1)) + @assertIsNaN(my_result(2)) + end subroutine test_error_in_lat_array + + +end module test_daylength diff --git a/components/clm/src/biogeophys/test/HumanStress_test/CMakeLists.txt b/components/clm/src/biogeophys/test/HumanStress_test/CMakeLists.txt new file mode 100644 index 0000000000..d2583a3a47 --- /dev/null +++ b/components/clm/src/biogeophys/test/HumanStress_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(humanstress test_humanstress_exe + "test_humanstress.pf" "") + +target_link_libraries(test_humanstress_exe clm csm_share) diff --git a/components/clm/src/biogeophys/test/HumanStress_test/test_humanstress.pf b/components/clm/src/biogeophys/test/HumanStress_test/test_humanstress.pf new file mode 100644 index 0000000000..0713e3d906 --- /dev/null +++ b/components/clm/src/biogeophys/test/HumanStress_test/test_humanstress.pf @@ -0,0 +1,28 @@ +module test_humanstress + + ! Tests of the humanstress functions in HumanIndexMod + + use pfunit_mod + + use shr_kind_mod , only : r8 => shr_kind_r8 + use HumanIndexMod, only : Wet_BulbS + + implicit none + save + + real(r8), parameter :: tol = 1.e-8_r8 + +contains + + @Test + subroutine test_standard_WetBulb() + real(r8) :: wbt ! Wet bulb temp + + call Wet_BulbS( 0.0_r8, 0.0_r8, wbt ) + @assertEqual( -3.6531108341574_r8, wbt, tolerance=tol) + call Wet_BulbS( 0.0_r8, 100.0_r8, wbt ) + @assertEqual( -0.13165370616986_r8, wbt, tolerance=tol) + end subroutine test_standard_WetBulb + + +end module test_humanstress diff --git a/components/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt b/components/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt new file mode 100644 index 0000000000..195e0484de --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/CMakeLists.txt @@ -0,0 +1,13 @@ +set (pfunit_sources + test_irrigation_deficit.pf + test_irrigation_singlepatch.pf + test_irrigation_multipatch.pf) + +# extra sources used for this test, which are not .pf files +set (extra_sources + IrrigationWrapperMod.F90) + +create_pFUnit_test(irrigation test_irrigation_exe + "${pfunit_sources}" "${extra_sources}") + +target_link_libraries(test_irrigation_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/biogeophys/test/Irrigation_test/IrrigationWrapperMod.F90 b/components/clm/src/biogeophys/test/Irrigation_test/IrrigationWrapperMod.F90 new file mode 100644 index 0000000000..0b782353bd --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/IrrigationWrapperMod.F90 @@ -0,0 +1,303 @@ +module IrrigationWrapperMod + + ! This module provides a wrapper around the irrigation class, for the sake of testing. + ! + ! It defines a type that holds the parameters needed to set up a test of irrigation. + ! + ! In addition, it provides a wrapper to the public interface of Irrigation, which calls + ! the Irrigation routines with the appropriate arguments. This way, if the argument + ! list changes, we only need to change the call in one place, rather than in every test. + ! + ! Finally, it provides a routine that does the setup needed for most tests of + ! irrigation, and a complementary routine to do the teardown. + + use shr_kind_mod , only : r8 => shr_kind_r8 + use IrrigationMod , only : irrigation_type, irrigation_params_type + use clm_varpar , only : nlevgrnd + use PatchType , only : patch + use ColumnType , only : col + use GridcellType , only : grc + use unittestSubgridMod + + implicit none + save + private + + type, public :: irrigation_inputs_type + ! Irrigation parameters + type(irrigation_params_type) :: irrigation_params + + ! State variables + real(r8), allocatable :: elai(:) + real(r8), allocatable :: btran(:) + real(r8), allocatable :: rootfr(:,:) + real(r8), allocatable :: t_soisno(:,:) + real(r8), allocatable :: eff_porosity(:,:) + real(r8), allocatable :: h2osoi_liq(:,:) + real(r8), allocatable :: relsat_so(:,:) + + ! Previous model time + integer :: time_prev + contains + ! Computes irrigation deficit for every patch and level + procedure :: computeDeficits + + ! Wrapper that calls both CalcIrrigationNeeded and ApplyIrrigation + procedure :: calculateAndApplyIrrigation + end type irrigation_inputs_type + + integer , parameter, public :: dtime = 1800 ! model time step, seconds + + ! Public routines: + public :: setupIrrigation ! Do the setup needed for most tests + public :: teardownIrrigation ! Teardown stuff set up by setupIrrigation + + ! Private routines: + + ! These routines setup and teardown the external environment used by Irrigation - i.e., + ! things accessed via 'use' statements + private :: setupEnvironment + private :: teardownEnvironment + + interface irrigation_inputs_type + module procedure constructor + end interface irrigation_inputs_type + +contains + + !----------------------------------------------------------------------- + type(irrigation_inputs_type) function constructor() + ! + ! !DESCRIPTION: + ! Creates an irrigation_inputs_type object. + ! + ! Values are set up such that there is some irrigation deficit everywhere, and + ! irrigation would start in the following call to CalcIrrigationNeeded (followed by + ! ApplyIrrigation). Values are set the same for every patch/column, and are the same + ! at every level EXCEPT for relsat_so, which varies linearly by level and patch number. + ! + ! Assumes that nlevgrnd has been set, and that all necessary subgrid setup has been + ! completed. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: p,j + ! + !----------------------------------------------------------------------- + + ! Set parameters + constructor%irrigation_params = irrigation_params_type( & + irrig_min_lai = 0.0_r8, & + irrig_btran_thresh = 0.99_r8, & + irrig_start_time = 21600, & + irrig_length = 14400, & + irrig_factor = 0.7_r8) + + + ! ------------------------------------------------------------------------ + ! Set state variables + ! ------------------------------------------------------------------------ + + allocate(constructor%elai(bounds%begp:bounds%endp), source=10._r8) + allocate(constructor%btran(bounds%begp:bounds%endp), source=0._r8) + allocate(constructor%rootfr(bounds%begp:bounds%endp, nlevgrnd), source=1._r8/nlevgrnd) + allocate(constructor%t_soisno(bounds%begc:bounds%endc, nlevgrnd), source=1000._r8) + allocate(constructor%eff_porosity(bounds%begc:bounds%endc, nlevgrnd), source=1._r8) + allocate(constructor%h2osoi_liq(bounds%begc:bounds%endc, nlevgrnd), source=0._r8) + allocate(constructor%relsat_so(bounds%begp:bounds%endp, nlevgrnd)) + + do j = 1, nlevgrnd + do p = bounds%begp, bounds%endp + constructor%relsat_so(p,j) = 0.1_r8 * j * (p - bounds%begp + 1) + end do + end do + + ! Set time_prev to the irrig_start_time minus 1 hour (since we're using a longitude + ! about 1 hour east of 0Z) + constructor%time_prev = constructor%irrigation_params%irrig_start_time - 3600 + + end function constructor + + !----------------------------------------------------------------------- + subroutine computeDeficits(this, irrigation, deficits) + ! + ! !DESCRIPTION: + ! Computes irrigation deficit for each patch and layer. + ! + ! Allocates the 'deficits' variable, and gives it a lower bound of bounds%begp + ! + ! The motivation for this function is: For most of the irrigation tests, we assume + ! that the IrrigationDeficit function is working correctly, and we want to test the + ! code that builds on top of these computed deficits. By having this function, we can + ! avoid having to hard-code the deficits in each test. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(irrigation_inputs_type), intent(in) :: this + class(irrigation_type), intent(in) :: irrigation + real(r8), allocatable, intent(out) :: deficits(:,:) + ! + ! !LOCAL VARIABLES: + integer :: p, c, j + + character(len=*), parameter :: subname = 'computeDeficits' + !----------------------------------------------------------------------- + + allocate(deficits(bounds%begp:bounds%endp, nlevgrnd)) + do j = 1, nlevgrnd + do p = bounds%begp, bounds%endp + c = patch%column(p) + deficits(p,j) = irrigation%IrrigationDeficit(& + relsat_so = this%relsat_so(p,j), & + h2osoi_liq = this%h2osoi_liq(c,j), & + eff_porosity = this%eff_porosity(c,j), & + dz = col%dz(c,j), & + irrig_factor = this%irrigation_params%irrig_factor) + end do + end do + + end subroutine computeDeficits + + !----------------------------------------------------------------------- + subroutine calculateAndApplyIrrigation(this, irrigation, numf, filter) + ! + ! !DESCRIPTION: + ! Call CalculateIrrigationNeeded with the given irrigation parameters. Then call + ! ApplyIrrigation. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(irrigation_inputs_type), intent(in) :: this + class(irrigation_type), intent(inout) :: irrigation + integer :: numf ! number of points in filter + integer :: filter(:) ! filter over which we run irrigation + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'calculateAndApplyIrrigation' + !----------------------------------------------------------------------- + + call irrigation%CalcIrrigationNeeded(& + bounds=bounds, & + num_exposedvegp = numf, & + filter_exposedvegp = filter, & + time_prev = this%time_prev, & + elai = this%elai, & + btran = this%btran, & + rootfr = this%rootfr, & + t_soisno = this%t_soisno, & + eff_porosity = this%eff_porosity, & + h2osoi_liq = this%h2osoi_liq) + + call irrigation%ApplyIrrigation(bounds) + + end subroutine calculateAndApplyIrrigation + + + ! ======================================================================== + ! Procedures not tied to irrigation_inputs_type, but included in this same module for + ! convenience. + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine setupIrrigation(irrigation_inputs, irrigation, maxpft) + ! + ! !DESCRIPTION: + ! Do the setup needed for most tests. + ! + ! Before calling this, you must set up the subgrid structure. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(irrigation_inputs_type), intent(out) :: irrigation_inputs + type(irrigation_type), intent(out) :: irrigation + integer, intent(in) :: maxpft ! max pft type + ! + ! !LOCAL VARIABLES: + !----------------------------------------------------------------------- + + irrigation_inputs = irrigation_inputs_type() + call setupEnvironment(maxpft=maxpft) + call irrigation%InitForTesting(bounds, irrigation_inputs%irrigation_params, & + dtime, irrigation_inputs%relsat_so) + + end subroutine setupIrrigation + + !----------------------------------------------------------------------- + subroutine teardownIrrigation(irrigation_inputs, irrigation) + ! + ! !DESCRIPTION: + ! Teardown stuff set up by setupIrrigation + ! + ! Note: nothing is done with irrigation_inputs, but it is included in the argument + ! list for symmetry with the setup routine, in case anything needs to be done with it + ! in the future. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(irrigation_inputs_type), intent(inout) :: irrigation_inputs + type(irrigation_type), intent(inout) :: irrigation + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'teardownIrrigation' + !----------------------------------------------------------------------- + + call irrigation%Clean() + call teardownEnvironment() + + end subroutine teardownIrrigation + + + + !----------------------------------------------------------------------- + subroutine setupEnvironment(maxpft) + ! + ! !DESCRIPTION: + ! Sets up the external environment used by Irrigation - i.e., things accessed via + ! 'use' statements. + ! + ! Assumes nlevgrnd has been set, and that all necessary subgrid setup has been + ! completed. + ! + ! !USES: + use pftconMod , only : pftcon + use clm_varpar, only : mxpft + ! + ! !ARGUMENTS: + integer, intent(in) :: maxpft ! max pft type that needs to be supported + ! + !----------------------------------------------------------------------- + + allocate(pftcon%irrigated(0:mxpft), source=1.0_r8) + + col%dz(:,1:nlevgrnd) = 1.0_r8 + + ! slightly greater than 1 hour offset + grc%londeg(:) = 15.1_r8 + + end subroutine setupEnvironment + + !----------------------------------------------------------------------- + subroutine teardownEnvironment() + ! + ! !DESCRIPTION: + ! Tears down the environment set up by setupEnvironment. Should be called after each + ! test. Note that this does NOT deallocate the subgrid variables - that cleanup + ! needs to be done separately. + ! + ! !USES: + use pftconMod, only : pftcon + ! + !----------------------------------------------------------------------- + + deallocate(pftcon%irrigated) + + end subroutine teardownEnvironment + +end module IrrigationWrapperMod diff --git a/components/clm/src/biogeophys/test/Irrigation_test/README b/components/clm/src/biogeophys/test/Irrigation_test/README new file mode 100644 index 0000000000..3619bfddba --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/README @@ -0,0 +1,68 @@ +--- Some design notes --- + +There are a couple of important points about IrrigationMod that motivated how I +set up these tests: + +(1) There are two main routines in the public interface: CalcIrrigationNeeded + and ApplyIrrigation. CalcIrrigationNeeded does not have any effects that are + directly visible; instead, it sets some variables that are later used by + ApplyIrrigation. (These two routines are separated because they need to be + called at different points in the driver.) + +(2) Within CalcIrrigationNeeded, there is a filter loop inside a loop over + levels. (The looping was done in this order for the sake of vectorization, + despite the fact that the code - and possibly the testing - would haven + simpler if the loop nesting were reversed. But this seems typical of + multi-level code throughout CLM.) Furthermore, there is some interaction + between levels (in that a frozen layer j prevents any irrigation demand from + being counted below level j). + +Because of these considerations, it was not straightforward to pull out routines +that could operate on a single point, and just do the testing on these +single-point routines. So instead, I am just testing the public, multi-point +routines. However, for simplicity, most of my tests just use a single point in +the arrays - and then I have just enough multi-point tests to ensure that the +routines truly do work with multiple points. + +Furthermore, I have been influenced lately by advice to "test behavior, not +methods", and to test through the public interface. And in this case, it +actually feels easier to convince myself that the code is doing the right thing +if I set up my tests to operate similarly to how CLM itself will interact with +IrrigationMod - that is, calling CalcIrrigationNeeded followed by +ApplyIrrigation, then examining the resulting qflx_irrig. Thus, that is what I +do in my tests - as opposed to, say, testing CalcIrrigationNeeded by itself and +viewing resulting variables that aren't usually available through the public +interface; or as opposed to breaking the current routines down into smaller +methods just for the sake of testability. Testing through the public interface +also feels like it will make the tests more robust (with fewer changes needed) +if the private implementation changes. + +However, in cases where it's easier to pull out a single-point implementation of +an algorithm, with a relatively trivial wrapper to handle the looping over +multiple points, I'd probably still come down in favor of just testing the +single-point implementation - since doing so is significantly simpler, even if +it means you're testing something that should be private. + + +--- Motivation for use of a testCase --- + +The main purpose of using a TestCase here is so that the tearDown is done +automatically, rather than having to call this teardown manually from each +test. This is important because, if an assertion fails, a test immediately +exits. That means that manual teardown is skipped, whereas this automatic +teardown still happens. This, in turn, is important so that the remaining tests +can still run properly. + +--- Notes about separation into multiple files --- + +I have separated tests based on what needs to be done for the setup and teardown +of each test. Tests that need identical setup and teardown (or lack thereof) are +grouped together. + +IrrigationWrapperMod contains routines that are used by both the singlepatch and +multipatch tests. In terms of setup and teardown: I have put setup stuff in here +that is in common for both the singlepatch and multipatch tests. I then do the +symmetrical teardown here, as well (e.g., if a variable foo is allocated in +IrrigationWrapperMod, I also deallocate it in the teardown routine in +IrrigationWrapperMod). The setup done in the .pf files themselves is stuff that +differs between singlepatch and multipatch (or between individual tests). diff --git a/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_deficit.pf b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_deficit.pf new file mode 100644 index 0000000000..757c9679b6 --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_deficit.pf @@ -0,0 +1,57 @@ +module test_irrigation_deficit + + ! Tests of IrrigationDeficit + + ! Note that these tests do not require setting up a subgrid structure, or even doing + ! any setup for the irrigation object + + use pfunit_mod + use IrrigationMod, only : irrigation_type + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + +contains + + @Test + subroutine irrigation_deficit_is_correct() + use clm_varcon, only : denh2o + type(irrigation_type) :: irrigation + real(r8) :: relsat_so, h2osoi_liq, eff_porosity, dz + real(r8) :: h2osoi_liq_so, h2osoi_liq_sat + real(r8) :: irrig_factor + real(r8) :: deficit + real(r8) :: expected + + relsat_so = 0.1_r8 + h2osoi_liq = 100.0_r8 + eff_porosity = 0.5_r8 + dz = 2._r8 + irrig_factor = 0.7_r8 + h2osoi_liq_so = relsat_so * eff_porosity * dz * denh2o + h2osoi_liq_sat = eff_porosity * denh2o * dz + expected = h2osoi_liq_so + irrig_factor*(h2osoi_liq_sat - h2osoi_liq_so) - h2osoi_liq + + deficit = irrigation%IrrigationDeficit(& + relsat_so=relsat_so, h2osoi_liq=h2osoi_liq, eff_porosity=eff_porosity, dz=dz, irrig_factor=irrig_factor) + + @assertEqual(expected, deficit, tolerance=tol) + + end subroutine irrigation_deficit_is_correct + + @Test + subroutine irrigation_deficit_returns_zero_when_no_deficit() + type(irrigation_type) :: irrigation + real(r8) :: deficit + + deficit = irrigation%IrrigationDeficit(& + relsat_so=0.1_r8, h2osoi_liq = 1.e9_r8, eff_porosity=0.5_r8, dz=2._r8, irrig_factor=0.7_r8) + + @assertEqual(0._r8, deficit) + + end subroutine irrigation_deficit_returns_zero_when_no_deficit + +end module test_irrigation_deficit diff --git a/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_multipatch.pf b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_multipatch.pf new file mode 100644 index 0000000000..c152d1898b --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_multipatch.pf @@ -0,0 +1,172 @@ +module test_irrigation_multipatch + + ! Tests of IrrigationMod that involve multiple patches + + use pfunit_mod + use unittestSubgridMod + use IrrigationWrapperMod + use IrrigationMod, only : irrigation_type + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varpar, only : nlevgrnd + use landunit_varcon, only : istsoil + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + + @TestCase + type, extends(TestCase) :: TestIrrigationMultiPatch + ! numf and filter don't really need to be in the TestCase class (they could be + ! declared in each test routine), but I include them here for symmetry with the + ! singlepatch tests + integer :: numf + integer, allocatable :: filter(:) + type(irrigation_type) :: irrigation + type(irrigation_inputs_type) :: irrigation_inputs + contains + procedure :: setUp + procedure :: tearDown + end type TestIrrigationMultiPatch + +contains + + subroutine setUp(this) + class(TestIrrigationMultiPatch), intent(inout) :: this + + ! Set up in this module is test-specific, so nothing is done in this shared setup + ! routine. + end subroutine setUp + + subroutine tearDown(this) + class(TestIrrigationMultiPatch), intent(inout) :: this + + call teardownIrrigation(this%irrigation_inputs, this%irrigation) + call unittest_subgrid_teardown() + end subroutine tearDown + + @Test + subroutine irrigation_flux_is_correct_for_multiple_patches(this) + use unittestFilterBuilderMod, only : filter_from_range + class(TestIrrigationMultiPatch), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected1, expected2, expected_col + real(r8), parameter :: wt1 = 0.75_r8 + real(r8), parameter :: wt2 = 0.25_r8 + + + ! Setup grid + nlevgrnd = 3 + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=wt1) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=wt2) + call unittest_subgrid_setup_end() + call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) + + ! Other setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + expected1 = sum(deficits(bounds%begp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected1, this%irrigation%qflx_irrig_patch(bounds%begp), tolerance=tol) + expected2 = sum(deficits(bounds%endp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected2, this%irrigation%qflx_irrig_patch(bounds%endp), tolerance=tol) + ! Make sure this test had some power, by ensuring that the two points differ: + @assertTrue(expected1 /= expected2) + ! Check column-level flux, too + expected_col = expected1*wt1 + expected2*wt2 + @assertEqual(expected_col, this%irrigation%qflx_irrig_col(bounds%begc), tolerance=tol) + + end subroutine irrigation_flux_is_correct_for_multiple_patches + + @Test + subroutine irrigation_only_happens_within_filter(this) + class(TestIrrigationMultiPatch), intent(inout) :: this + + ! Setup grid: 3 columns, each with one patch + nlevgrnd = 3 + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_subgrid_setup_end() + this%numf = 1 + allocate(this%filter(1)) + this%filter = [bounds%begp + 1] + + ! Other setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + ! Irrigation happens within filter + @assertTrue(this%irrigation%qflx_irrig_patch(bounds%begp + 1) > 0._r8) + ! Irrigation does NOT happen outside filter + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%endp)) + + end subroutine irrigation_only_happens_within_filter + + @Test + subroutine test_multiple_patches_with_different_frozen_soil(this) + ! The point of this test is to exercise the somewhat complex logic for determining + ! frozen soil across multiple patches, due to the nesting of the p loop inside the + ! nlevgrnd loop (rather than the other way around). + + use unittestFilterBuilderMod, only : filter_from_range + class(TestIrrigationMultiPatch), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup grid: 3 columns, each with one patch + nlevgrnd = 3 + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=1, wtcol=1.0_r8) + call unittest_subgrid_setup_end() + call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) + + ! Other setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + ! first column has frozen soil + this%irrigation_inputs%t_soisno(bounds%begc, :) = 272._r8 + ! second column has layer 2 frozen + this%irrigation_inputs%t_soisno(bounds%begc+1, 2) = 272._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + ! First patch should have no irrigation, because soil is all frozen + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + ! Second patch should have irrigation just based on top layer, because 2nd layer is frozen + expected = deficits(bounds%begp+1, 1) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp+1), tolerance=tol) + ! Third patch should have irrigation from all layers + expected = sum(deficits(bounds%endp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%endp), tolerance=tol) + + end subroutine test_multiple_patches_with_different_frozen_soil + +end module test_irrigation_multipatch diff --git a/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_singlepatch.pf b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_singlepatch.pf new file mode 100644 index 0000000000..671c582202 --- /dev/null +++ b/components/clm/src/biogeophys/test/Irrigation_test/test_irrigation_singlepatch.pf @@ -0,0 +1,305 @@ +module test_irrigation_singlepatch + + ! Tests of IrrigationMod that just involve a single patch + + use pfunit_mod + use unittestSubgridMod + use IrrigationWrapperMod + use IrrigationMod, only : irrigation_type + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varpar, only : nlevgrnd + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + + @TestCase + type, extends(TestCase) :: TestIrrigation + integer :: numf + integer, allocatable :: filter(:) + type(irrigation_type) :: irrigation + type(irrigation_inputs_type) :: irrigation_inputs + contains + procedure :: setUp + procedure :: tearDown + end type TestIrrigation + +contains + + subroutine setUp(this) + ! Set up subgrid structure for a single patch; also set up the filter for this single + ! patch. + + use unittestSimpleSubgridSetupsMod, only : setup_single_veg_patch + use unittestFilterBuilderMod, only : filter_from_range + class(TestIrrigation), intent(inout) :: this + + ! Need nlevgrnd at least 3 for some tests to be meaningful + nlevgrnd = 3 + + call setup_single_veg_patch(pft_type=1) + call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) + + end subroutine setUp + + subroutine tearDown(this) + class(TestIrrigation), intent(inout) :: this + + call teardownIrrigation(this%irrigation_inputs, this%irrigation) + call unittest_subgrid_teardown() + end subroutine tearDown + + @Test + subroutine irrigation_flux_is_correct(this) + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + expected = sum(deficits(bounds%begp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp), tolerance=tol) + + end subroutine irrigation_flux_is_correct + + @Test + subroutine no_irrigation_for_unirrigated_pfts(this) + use pftconMod, only : pftcon + use PatchType, only : patch + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=2) + patch%itype(bounds%begp) = 2 + pftcon%irrigated(1:2) = [1.0, 0.0] + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_for_unirrigated_pfts + + @Test + subroutine no_irrigation_for_lai0(this) + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + this%irrigation_inputs%elai(bounds%begp) = 0._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_for_lai0 + + @Test + subroutine no_irrigation_for_btran1(this) + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + this%irrigation_inputs%btran(bounds%begp) = 1._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_for_btran1 + + @Test + subroutine no_irrigation_at_wrong_time(this) + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + ! Set previous time to be one time step before the time when we would start irrigating + this%irrigation_inputs%time_prev = this%irrigation_inputs%time_prev - dtime + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_at_wrong_time + + @Test + subroutine irrigation_should_happen_for_big_longitude(this) + use GridcellType, only : grc + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + ! Use a big longitude and a time_prev that should lead to irrigation at that longitude + ! The main point of this is to test the modulo in the local_time calculation + grc%londeg(:) = 359.9_r8 + this%irrigation_inputs%time_prev = this%irrigation_inputs%irrigation_params%irrig_start_time + dtime + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertTrue(this%irrigation%qflx_irrig_patch(bounds%begp) > 0._r8) + + end subroutine irrigation_should_happen_for_big_longitude + + @Test + subroutine irrigation_continues_at_same_rate_for_multiple_time_steps(this) + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + + ! Call irrigation routines + ! First call the routines to get irrigation started. Then increment time, and also + ! adjust the soil water amount. Irrigation should continue at the original rate. + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + expected = sum(deficits(bounds%begp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + this%irrigation_inputs%time_prev = this%irrigation_inputs%time_prev + dtime + this%irrigation_inputs%h2osoi_liq = 100._r8 + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp), tolerance=tol) + + end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps + + @Test + subroutine irrigation_continues_for_correct_number_of_time_steps(this) + class(TestIrrigation), intent(inout) :: this + integer :: time + integer :: expected_num_time_steps + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + ! The following assumes that dtime divides evenly into to irrigation length; + ! if not, it will be off by one + expected_num_time_steps = this%irrigation_inputs%irrigation_params%irrig_length / dtime + + ! Ensure that irrigation flux is still non-zero after the expected number of time + ! steps + do time = 1, expected_num_time_steps + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + this%irrigation_inputs%time_prev = this%irrigation_inputs%time_prev + dtime + end do + @assertTrue(this%irrigation%qflx_irrig_patch(bounds%begp) > 0._r8) + + ! Ensure that irrigation flux goes to 0 in the following time step + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine irrigation_continues_for_correct_number_of_time_steps + + @Test + subroutine irrigation_flux_is_correct_on_second_day(this) + ! Loops through to a point where irrigation gets to 0, then resets time to the irrig + ! start time and does another set of calls to the irrigation routines. Ensures that + ! we're back to the intended flux. + + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + integer :: time_prev_orig + integer :: time + integer :: expected_num_time_steps + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + time_prev_orig = this%irrigation_inputs%time_prev + + ! Call irrigation routines for long enough that irrigation should go to 0 + expected_num_time_steps = this%irrigation_inputs%irrigation_params%irrig_length / dtime + do time = 1, expected_num_time_steps + 1 + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + this%irrigation_inputs%time_prev = this%irrigation_inputs%time_prev + dtime + end do + ! The following assertion is mainly here to make sure the test is working as intended + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + ! Now reset time, change soil moisture, and make sure that irrigation happens as expected + this%irrigation_inputs%time_prev = time_prev_orig + this%irrigation_inputs%h2osoi_liq(:,:) = 100._r8 + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + expected = sum(deficits(bounds%begp,:)) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp), tolerance=tol) + + end subroutine irrigation_flux_is_correct_on_second_day + + @Test + subroutine irrigation_flux_excludes_layers_without_roots(this) + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + this%irrigation_inputs%rootfr(bounds%begp, 2) = 0._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + ! Subtract the deficit from layer 2, since we don't have roots there: + expected = (sum(deficits(bounds%begp,:)) - deficits(bounds%begp, 2)) & + / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp), tolerance=tol) + + end subroutine irrigation_flux_excludes_layers_without_roots + + @Test + subroutine no_irrigation_for_frozen_soil(this) + class(TestIrrigation), intent(inout) :: this + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + this%irrigation_inputs%t_soisno(bounds%begc, :) = 272._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + @assertEqual(0._r8, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_for_frozen_soil + + @Test + subroutine no_irrigation_below_frozen_soil_layer(this) + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call setupIrrigation(this%irrigation_inputs, this%irrigation, maxpft=1) + this%irrigation_inputs%t_soisno(bounds%begc, 2) = 272._r8 + + ! Call irrigation routines + call this%irrigation_inputs%calculateAndApplyIrrigation(this%irrigation, this%numf, this%filter) + + ! Check result + call this%irrigation_inputs%computeDeficits(this%irrigation, deficits) + ! Only include deficit from top layer, since 2nd layer is frozen + expected = deficits(bounds%begp, 1) / this%irrigation_inputs%irrigation_params%irrig_length + @assertEqual(expected, this%irrigation%qflx_irrig_patch(bounds%begp)) + + end subroutine no_irrigation_below_frozen_soil_layer + +end module test_irrigation_singlepatch diff --git a/components/clm/src/biogeophys/test/SnowHydrology_test/CMakeLists.txt b/components/clm/src/biogeophys/test/SnowHydrology_test/CMakeLists.txt new file mode 100644 index 0000000000..b18b2d696d --- /dev/null +++ b/components/clm/src/biogeophys/test/SnowHydrology_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(SnowHydrology test_SnowHydrology_exe + "test_SnowHydrology.pf" "") + +target_link_libraries(test_SnowHydrology_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/biogeophys/test/SnowHydrology_test/README b/components/clm/src/biogeophys/test/SnowHydrology_test/README new file mode 100644 index 0000000000..e43325dda6 --- /dev/null +++ b/components/clm/src/biogeophys/test/SnowHydrology_test/README @@ -0,0 +1,4 @@ +The unit tests of InitSnowLayers were put here largely for the sake of working +out some bugs in the initial implementation. Since this code is only used during +cold start (and thus is not critical), these unit tests can be removed if they +become a maintenance problem. diff --git a/components/clm/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology.pf b/components/clm/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology.pf new file mode 100644 index 0000000000..7975643830 --- /dev/null +++ b/components/clm/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology.pf @@ -0,0 +1,73 @@ +module test_SnowHydrology + + ! Tests of SnowHydrologyMod + + use pfunit_mod + use SnowHydrologyMod + use shr_kind_mod, only : r8 => shr_kind_r8 + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod + use ColumnType, only : col + use clm_varpar, only : nlevsno + + implicit none + + @TestCase + type, extends(TestCase) :: TestSnowHydrology + contains + procedure :: setUp + procedure :: tearDown + end type TestSnowHydrology + +contains + + subroutine setUp(this) + class(TestSnowHydrology), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestSnowHydrology), intent(inout) :: this + call unittest_subgrid_teardown() + end subroutine tearDown + + @Test + subroutine test_initSnowLayers_depth0_snl(this) + class(TestSnowHydrology), intent(inout) :: this + real(r8), allocatable :: snow_depth(:) + + ! Setup + nlevsno = 5 + call setup_single_veg_patch(pft_type = 1) + allocate(snow_depth(bounds%begc:bounds%endc)) + snow_depth(:) = 0._r8 + col%zi(bounds%begc:bounds%endc,0) = 0._r8 ! Normally initialized elsewhere (initVerticalMod) + + ! Exercise + call InitSnowLayers(bounds, snow_depth) + + ! Verify + @assertEqual(0, col%snl(bounds%begc)) + + end subroutine test_initSnowLayers_depth0_snl + + @Test + subroutine test_initSnowLayers_depth1_snl(this) + class(TestSnowHydrology), intent(inout) :: this + real(r8), allocatable :: snow_depth(:) + + ! Setup + nlevsno = 5 + call setup_single_veg_patch(pft_type = 1) + allocate(snow_depth(bounds%begc:bounds%endc)) + snow_depth(:) = 1._r8 + col%zi(bounds%begc:bounds%endc,0) = 0._r8 ! Normally initialized elsewhere (initVerticalMod) + + ! Exercise + call InitSnowLayers(bounds, snow_depth) + + ! Verify + @assertEqual(-5, col%snl(bounds%begc)) + + end subroutine test_initSnowLayers_depth1_snl + +end module test_SnowHydrology diff --git a/components/clm/src/cpl/clm_cpl_indices.F90 b/components/clm/src/cpl/clm_cpl_indices.F90 new file mode 100644 index 0000000000..6b89d9ba07 --- /dev/null +++ b/components/clm/src/cpl/clm_cpl_indices.F90 @@ -0,0 +1,299 @@ +module clm_cpl_indices + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing the indices for the fields passed between CLM and + ! the driver. Includes the River Transport Model fields (RTM) and the + ! fields needed by the land-ice component (sno). + ! + ! !USES: + + use shr_sys_mod, only : shr_sys_abort + implicit none + + SAVE + private ! By default make data private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_cpl_indices_set ! Set the coupler indices + ! + ! !PUBLIC DATA MEMBERS: + ! + integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits + ! (from coupler) - must equal maxpatch_glcmec from namelist + + ! lnd -> drv (required) + + integer, public ::index_l2x_Flrl_rofl ! lnd->rtm input fluxes + integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input fluxes + + integer, public ::index_l2x_Sl_t ! temperature + integer, public ::index_l2x_Sl_tref ! 2m reference temperature + integer, public ::index_l2x_Sl_qref ! 2m reference specific humidity + integer, public ::index_l2x_Sl_avsdr ! albedo: direct , visible + integer, public ::index_l2x_Sl_anidr ! albedo: direct , near-ir + integer, public ::index_l2x_Sl_avsdf ! albedo: diffuse, visible + integer, public ::index_l2x_Sl_anidf ! albedo: diffuse, near-ir + integer, public ::index_l2x_Sl_snowh ! snow height + integer, public ::index_l2x_Sl_u10 ! 10m wind + integer, public ::index_l2x_Sl_ddvel ! dry deposition velocities (optional) + integer, public ::index_l2x_Sl_fv ! friction velocity + integer, public ::index_l2x_Sl_ram1 ! aerodynamical resistance + integer, public ::index_l2x_Sl_soilw ! volumetric soil water + integer, public ::index_l2x_Fall_taux ! wind stress, zonal + integer, public ::index_l2x_Fall_tauy ! wind stress, meridional + integer, public ::index_l2x_Fall_lat ! latent heat flux + integer, public ::index_l2x_Fall_sen ! sensible heat flux + integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux + integer, public ::index_l2x_Fall_evap ! evaporation water flux + integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net + integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0 + integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1 + integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2 + integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3 + integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4 + integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature + integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height + integer, allocatable, public ::index_l2x_Flgl_qice(:) ! glc MEC ice flux + + integer, public ::index_x2l_Sa_methane + integer, public ::index_l2x_Fall_methane + + integer, public :: nflds_l2x = 0 + + ! drv -> lnd (required) + + integer, public ::index_x2l_Sa_z ! bottom atm level height + integer, public ::index_x2l_Sa_u ! bottom atm level zon wind + integer, public ::index_x2l_Sa_v ! bottom atm level mer wind + integer, public ::index_x2l_Sa_ptem ! bottom atm level pot temp + integer, public ::index_x2l_Sa_shum ! bottom atm level spec hum + integer, public ::index_x2l_Sa_pbot ! bottom atm level pressure + integer, public ::index_x2l_Sa_tbot ! bottom atm level temp + integer, public ::index_x2l_Faxa_lwdn ! downward lw heat flux + integer, public ::index_x2l_Faxa_rainc ! prec: liquid "convective" + integer, public ::index_x2l_Faxa_rainl ! prec: liquid "large scale" + integer, public ::index_x2l_Faxa_snowc ! prec: frozen "convective" + integer, public ::index_x2l_Faxa_snowl ! prec: frozen "large scale" + integer, public ::index_x2l_Faxa_swndr ! sw: nir direct downward + integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward + integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward + integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward + integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2 + integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2 + integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition + integer, public ::index_x2l_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition + + integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof (flood) flux + integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, allocatable, public ::index_x2l_Sg_ice_covered(:) ! Fraction of glacier from glc model + integer, allocatable, public ::index_x2l_Sg_topo(:) ! Topo height from glc model + integer, allocatable, public ::index_x2l_Flgg_hflx(:) ! Heat flux from glc model + + integer, public ::index_x2l_Sg_icemask + integer, public ::index_x2l_Sg_icemask_coupled_fluxes + + integer, public :: nflds_x2l = 0 + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine clm_cpl_indices_set( ) + ! + ! !DESCRIPTION: + ! Set the coupler indices needed by the land model coupler + ! interface. + ! + ! !USES: + use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields + use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra + use mct_mod , only: mct_aVect_clean, mct_avect_nRattr + use seq_drydep_mod , only: drydep_fields_token, lnd_drydep + use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n + use clm_varctl , only: use_voc + use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string + ! + ! !ARGUMENTS: + implicit none + ! + ! !REVISION HISTORY: + ! Author: Mariana Vertenstein + ! 01/2011, Erik Kluzek: Added protex headers + ! + ! !LOCAL VARIABLES: + type(mct_aVect) :: l2x ! temporary, land to coupler + type(mct_aVect) :: x2l ! temporary, coupler to land + integer :: num + character(len=:), allocatable :: nec_str ! string version of glc elev. class number + character(len=64) :: name + character(len=32) :: subname = 'clm_cpl_indices_set' ! subroutine name + !----------------------------------------------------------------------- + + ! Determine attribute vector indices + + ! create temporary attribute vectors + call mct_aVect_init(x2l, rList=seq_flds_x2l_fields, lsize=1) + nflds_x2l = mct_avect_nRattr(x2l) + + call mct_aVect_init(l2x, rList=seq_flds_l2x_fields, lsize=1) + nflds_l2x = mct_avect_nRattr(l2x) + + !------------------------------------------------------------- + ! clm -> drv + !------------------------------------------------------------- + + index_l2x_Flrl_rofl = mct_avect_indexra(l2x,'Flrl_rofl') + index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi') + + index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t') + index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh') + index_l2x_Sl_avsdr = mct_avect_indexra(l2x,'Sl_avsdr') + index_l2x_Sl_anidr = mct_avect_indexra(l2x,'Sl_anidr') + index_l2x_Sl_avsdf = mct_avect_indexra(l2x,'Sl_avsdf') + index_l2x_Sl_anidf = mct_avect_indexra(l2x,'Sl_anidf') + index_l2x_Sl_tref = mct_avect_indexra(l2x,'Sl_tref') + index_l2x_Sl_qref = mct_avect_indexra(l2x,'Sl_qref') + index_l2x_Sl_u10 = mct_avect_indexra(l2x,'Sl_u10') + index_l2x_Sl_ram1 = mct_avect_indexra(l2x,'Sl_ram1') + index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv') + index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet') + if ( lnd_drydep )then + index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token)) + else + index_l2x_Sl_ddvel = 0 + end if + + index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux') + index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy') + index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat') + index_l2x_Fall_sen = mct_avect_indexra(l2x,'Fall_sen') + index_l2x_Fall_lwup = mct_avect_indexra(l2x,'Fall_lwup') + index_l2x_Fall_evap = mct_avect_indexra(l2x,'Fall_evap') + index_l2x_Fall_swnet = mct_avect_indexra(l2x,'Fall_swnet') + index_l2x_Fall_flxdst1 = mct_avect_indexra(l2x,'Fall_flxdst1') + index_l2x_Fall_flxdst2 = mct_avect_indexra(l2x,'Fall_flxdst2') + index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3') + index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4') + + index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet') + + index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet') + + ! MEGAN fluxes + ! use_voc is a temporary logic to enable turning off MEGAN fluxes when prognostic crop + ! is used + if (shr_megan_mechcomps_n>0 .and. use_voc) then + index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token)) + else + index_l2x_Fall_flxvoc = 0 + endif + + !------------------------------------------------------------- + ! drv -> clm + !------------------------------------------------------------- + + index_x2l_Sa_z = mct_avect_indexra(x2l,'Sa_z') + index_x2l_Sa_u = mct_avect_indexra(x2l,'Sa_u') + index_x2l_Sa_v = mct_avect_indexra(x2l,'Sa_v') + index_x2l_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet') + index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet') + + index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet') + + index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr') + + index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + index_x2l_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + index_x2l_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + index_x2l_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + index_x2l_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + index_x2l_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + index_x2l_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + index_x2l_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + index_x2l_Faxa_bcphidry = mct_avect_indexra(x2l,'Faxa_bcphidry') + index_x2l_Faxa_bcphodry = mct_avect_indexra(x2l,'Faxa_bcphodry') + index_x2l_Faxa_bcphiwet = mct_avect_indexra(x2l,'Faxa_bcphiwet') + index_x2l_Faxa_ocphidry = mct_avect_indexra(x2l,'Faxa_ocphidry') + index_x2l_Faxa_ocphodry = mct_avect_indexra(x2l,'Faxa_ocphodry') + index_x2l_Faxa_ocphiwet = mct_avect_indexra(x2l,'Faxa_ocphiwet') + index_x2l_Faxa_dstdry1 = mct_avect_indexra(x2l,'Faxa_dstdry1') + index_x2l_Faxa_dstdry2 = mct_avect_indexra(x2l,'Faxa_dstdry2') + index_x2l_Faxa_dstdry3 = mct_avect_indexra(x2l,'Faxa_dstdry3') + index_x2l_Faxa_dstdry4 = mct_avect_indexra(x2l,'Faxa_dstdry4') + index_x2l_Faxa_dstwet1 = mct_avect_indexra(x2l,'Faxa_dstwet1') + index_x2l_Faxa_dstwet2 = mct_avect_indexra(x2l,'Faxa_dstwet2') + index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3') + index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4') + + index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood') + + !------------------------------------------------------------- + ! glc coupling + !------------------------------------------------------------- + + index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask') + index_x2l_Sg_icemask_coupled_fluxes = mct_avect_indexra(x2l,'Sg_icemask_coupled_fluxes') + + glc_nec = glc_get_num_elevation_classes() + + ! If glc_nec > 0, then create coupling fields for all glc elevation classes + ! (1:glc_nec) plus bare land (index 0). Note that, if glc_nec = 0, then we don't even + ! need the bare land (0) index. + if (glc_nec > 0) then + allocate(index_l2x_Sl_tsrf(0:glc_nec)) + allocate(index_l2x_Sl_topo(0:glc_nec)) + allocate(index_l2x_Flgl_qice(0:glc_nec)) + allocate(index_x2l_Sg_ice_covered(0:glc_nec)) + allocate(index_x2l_Sg_topo(0:glc_nec)) + allocate(index_x2l_Flgg_hflx(0:glc_nec)) + + do num = 0,glc_nec + nec_str = glc_elevclass_as_string(num) + + name = 'Sg_ice_covered' // nec_str + index_x2l_Sg_ice_covered(num) = mct_avect_indexra(x2l,trim(name)) + name = 'Sg_topo' // nec_str + index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name)) + name = 'Flgg_hflx' // nec_str + index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name)) + + name = 'Sl_tsrf' // nec_str + index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Sl_topo' // nec_str + index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Flgl_qice' // nec_str + index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name)) + end do + end if + + call mct_aVect_clean(x2l) + call mct_aVect_clean(l2x) + + end subroutine clm_cpl_indices_set + +!======================================================================= + +end module clm_cpl_indices diff --git a/components/clm/src/cpl/lnd_comp_esmf.F90 b/components/clm/src/cpl/lnd_comp_esmf.F90 new file mode 100644 index 0000000000..c49066a6fb --- /dev/null +++ b/components/clm/src/cpl/lnd_comp_esmf.F90 @@ -0,0 +1,806 @@ +module lnd_comp_esmf + +#ifdef ESMF_INTERFACE + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Interface of the active land model component of CESM the CLM (Community Land Model) + ! with the main CESM driver. This is a thin interface taking CESM driver information + ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM and outputing + ! if in ESMF (Earth System Modelling Framework) format. + ! + ! !USES: + use esmf + use esmfshr_util_mod + use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL + use shr_string_mod , only : shr_string_listGetNum + use abortutils , only : endrun + use domainMod , only : ldomain + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use clm_varctl , only : iulog + use clm_initializeMod , only : lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst + use clm_cpl_indices + use lnd_import_export + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + SAVE + private ! By default make data private + ! + public :: lnd_register_esmf ! register clm initial, run, final methods + public :: lnd_init_esmf ! clm initialization + public :: lnd_run_esmf ! clm run phase + public :: lnd_final_esmf ! clm finalization/cleanup + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: lnd_distgrid_esmf ! Distribute clm grid + private :: lnd_domain_esmf ! Set the land model domain information + !--------------------------------------------------------------------------- + +contains + + !--------------------------------------------------------------------------- + subroutine lnd_register_esmf(comp, rc) + ! + ! !DESCRIPTION: + ! Register the clm initial, run, and final phase methods with ESMF. + ! + ! !ARGUMENTS: + type(ESMF_GridComp) :: comp ! CLM grid component + integer, intent(out) :: rc ! return status + !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + lnd_init_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + lnd_run_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + lnd_final_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine lnd_register_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + ! + ! !USES: + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst, lnd2glc_inst + use clm_varctl , only : finidat,single_column, clm_varctl_set, noland + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use spmdMod , only : masterproc, spmd_init + use seq_timemgr_mod , only : seq_timemgr_EClockGetData + use seq_infodata_mod , only : seq_infodata_start_type_cont + use seq_infodata_mod , only : seq_infodata_start_type_brnch + use seq_infodata_mod , only : seq_infodata_start_type_start + use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use seq_flds_mod + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + ! + ! !LOCAL VARIABLES: + integer :: mpicom_lnd, mpicom_vm, gsize + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: dom, l2x, x2l + type(ESMF_VM) :: vm + 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 + real(r8) :: scmlat ! single-column latitude + real(r8) :: scmlon ! single-column longitude + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + 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) + 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 + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit,shrloglev ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds + integer :: LNDID ! cesm ID value + integer :: nfields + real(R8), pointer :: fptr(:, :) + character(len=32), parameter :: sub = 'lnd_init_esmf' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + character(ESMF_MAXSTR) :: convCIM, purpComp + !----------------------------------------------------------------------- + + ! Determine indices + + call clm_cpl_indices_set() + + rc = ESMF_SUCCESS + + ! duplicate the mpi communicator from the current VM + + call ESMF_VMGetCurrent(vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) + if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="ID", value=LNDID, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call spmd_init( mpicom_lnd, LNDID ) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_init_esmf:start::',lbnum) + endif +#endif + + inst_name = seq_comm_name(LNDID) + inst_index = seq_comm_inst(LNDID) + inst_suffix = seq_comm_suffix(LNDID) + + ! Initialize io log unit + + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Use infodata to set orbital values + + call ESMF_AttributeGet(export_state, name="orb_eccen", value=eccen, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_mvelpp", value=mvelpp, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_lambm0", value=lambm0, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_obliqr", value=obliqr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Consistency check on namelist filename + + call control_setNL("lnd_in"//trim(inst_suffix)) + + ! Initialize clm + ! initialize1 reads namelist, grid and surface data + ! initialize2 performs rest of initialization + + 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 ) + + call ESMF_AttributeGet(export_state, name="case_name", value=caseid, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="case_desc", value=ctitle, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="single_column", value=single_column, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="scmlat", value=scmlat, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="scmlon", value=scmlon, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="brnch_retain_casename", value=brnch_retain_casename, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="start_type", value=starttype, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="model_version", value=version, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="hostname", value=hostname, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="username", value=username, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + 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) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + nsrest = nsrContinue + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + nsrest = nsrBranch + else + call endrun( sub//' ERROR: unknown starttype' ) + end if + + call clm_varctl_set( & + caseid_in=caseid, ctitle_in=ctitle, & + brnch_retain_casename_in=brnch_retain_casename, & + single_column_in=single_column, scmlat_in=scmlat, & + scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & + hostname_in=hostname, username_in=username ) + + call initialize1( ) + + ! If no land then exit out of initialization + + if ( noland) then + call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) + if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) + if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + end if + + ! Determine if aerosol and dust deposition come from atmosphere component + + rc = ESMF_SUCCESS + + call ESMF_AttributeGet(export_state, name="atm_aero", value=atm_aero, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if + + !----------------------------------------- + ! Initialize distgrid + !----------------------------------------- + + call get_proc_bounds(bounds) + + distgrid = lnd_distgrid_esmf(bounds, gsize) + + call ESMF_AttributeSet(export_state, name="gsize", value=gsize, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Set arrayspec for dom, l2x and x2l + !----------------------------------------- + + call ESMF_ArraySpecSet(arrayspec, rank=2, typekind=ESMF_TYPEKIND_R8, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Create dom + !----------------------------------------- + + nfields = shr_string_listGetNum(trim(seq_flds_dom_fields)) + + dom = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="domain", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(dom, name="mct_names", value=trim(seq_flds_dom_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Set values of dom + call lnd_domain_esmf(bounds, dom) + + !----------------------------------------- + ! Create l2x + !----------------------------------------- + + ! 1d undistributed index of fields, 2d is packed data + + nfields = shr_string_listGetNum(trim(seq_flds_l2x_fields)) + + l2x = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="d2x", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(l2x, name="mct_names", value=trim(seq_flds_l2x_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Create x2l + !----------------------------------------- + + nfields = shr_string_listGetNum(trim(seq_flds_x2l_fields)) + + x2l = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="x2d", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(x2l, name="mct_names", value=trim(seq_flds_x2l_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Add esmf arrays to import and export state + !----------------------------------------- + + call ESMF_StateAdd(export_state, (/dom/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(export_state, (/l2x/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(import_state, (/x2l/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Finish initializing clm + + 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) write(iulog,*)'dtime_sync= ',dtime_sync,& + ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) + 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 ESMF_ArrayGet(l2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_export(bounds, lnd2atm_inst, lnd2glc_inst, fptr) + + ! Set land modes + + call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.true., rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Get nextsw_cday + + call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call set_nextsw_cday( nextsw_cday ) + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_esmf:end::',lbnum) + call memmon_reset_addr() + endif +#endif + +#ifdef USE_ESMF_METADATA + convCIM = "CIM" + purpComp = "Model Component Simulation Description" + + call ESMF_AttributeAdd(comp, & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "ShortName", "CLM", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "LongName", & + "Community Land Model", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "Description", & + "The Community Land Model version 4.0 is " // & + "the land model used in the CESM1.0. " // & + "More information on the CLM project " // & + "and access to previous CLM model versions and " // & + "documentation can be found via the CLM Web Page.", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ModelType", "Land", & + convention=convCIM, purpose=purpComp, rc=rc) +#endif + + end subroutine lnd_init_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Run clm model + ! + ! !USES: + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_orb_mod , only : shr_orb_decl + use clm_initializeMod , only : lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst + use clm_driver , only : clm_drv + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use clm_time_manager , only : get_curr_date, get_nstep, get_curr_calday, get_step_size + use clm_time_manager , only : advance_timestep, set_nextsw_cday,update_rad_dtime + use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn + use seq_timemgr_mod , only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use spmdMod , only : masterproc, mpicom + use perf_mod , only : t_startf, t_stopf, t_barrierf + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + ! + ! !LOCAL VARIABLES: + type(ESMF_Array) :: l2x, x2l, dom + real(R8), pointer :: fptr(:, :) + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CLM current date (YYYYMMDD) + integer :: yr ! CLM current year + integer :: mon ! CLM current month + integer :: day ! CLM current day + integer :: tod ! CLM current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + 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 ! clm calday plus dtime offset + 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 + integer :: shrlogunit,shrloglev ! old values + integer :: lbnum ! input to memory diagnostic + integer :: g,i,ka ! counters + real(r8):: recip ! recip + logical :: glcrun_alarm ! if true, sno data is averaged and sent to glc this step + type(bounds_type) :: bounds ! bounds + logical,save :: first_call = .true. ! first call work + character(len=32) :: rdate ! date char string for restart file names + character(len=32), parameter :: sub = "lnd_run_esmf" + !--------------------------------------------------------------------------- + + call get_proc_bounds(bounds) + + call t_startf ('lc_lnd_run1') + rc = ESMF_SUCCESS + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_esmf:start::',lbnum) + endif +#endif + + ! Reset shr logging to my log file + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Determine time of next atmospheric shortwave calculation + + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=ymd, curr_tod=tod_sync, & + curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) + call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call set_nextsw_cday( nextsw_cday ) + dtime = get_step_size() + + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync + nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) + rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) + + call t_stopf ('lc_lnd_run1') + + ! Map ESMF to CLM data type + + call t_startf ('lc_lnd_import') + + call ESMF_StateGet(import_state, itemName="x2d", array=x2l, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(x2l, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_import( bounds, fptr, atm2lnd_inst, glc2lnd_inst ) + + call t_stopf ('lc_lnd_import') + + ! Use infodata to set orbital values if it was updated at run time + + call ESMF_AttributeGet(export_state, name="orb_eccen", value=eccen, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_mvelpp", value=mvelpp, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_lambm0", value=lambm0, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_obliqr", value=obliqr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Loop over time steps in coupling interval + + call t_startf ('lc_lnd_run2') + + dosend = .false. + do while(.not. dosend) + + ! 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 + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine doalb based on nextsw_cday sent from atm model + + nstep = get_nstep() + caldayp1 = get_curr_calday(offset=dtime) + doalb = abs(nextsw_cday- caldayp1) < 1.e-10_r8 + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run clm + + call t_barrierf('sync_clm_run', mpicom) + call t_startf ('clm_run') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) + call t_stopf ('clm_run') + + ! Map CLM data type to MCT + ! Reset landfrac on atmosphere grid to have the right domain + + call t_startf ('lc_lnd_export') + call ESMF_StateGet(export_state, itemName="d2x", array=l2x, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(l2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_export(bounds, lnd2atm_inst, lnd2glc_inst, fptr) + call t_stopf ('lc_lnd_export') + + ! Advance clm time step + + call t_startf ('lc_clm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_clm2_adv_timestep') + + end do + + call t_stopf ('lc_lnd_run2') + call t_startf('lc_lnd_run3') + + ! Check that internal clock is in sync with master clock + + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) + end if + + ! Reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_esmf:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + call t_stopf ('lc_lnd_run3') + + end subroutine lnd_run_esmf + + !--------------------------------------------------------------------------- + + subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Finalize land surface model + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Destroy ESMF objects + call esmfshr_util_StateArrayDestroy(export_state,'domain',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine lnd_final_esmf + + !--------------------------------------------------------------------------- + function lnd_DistGrid_esmf(bounds, gsize) + ! + ! !DESCRIPTION: + ! Setup distributed grid for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(out) :: gsize ! grid size + ! + ! RETURN: + type(ESMF_DistGrid) :: lnd_DistGrid_esmf ! Resulting distributed grid + ! + ! !LOCAL VARIABLES: + integer,allocatable :: gindex(:) ! grid indices + integer :: n ! indices + integer :: rc ! error code + !--------------------------------------------------------------------------- + + ! number the local grid + + allocate(gindex(bounds%begg:bounds%endg)) + do n = bounds%begg, bounds%endg + gindex(n) = ldecomp%gdc2glo(n) + end do + gsize = ldomain%ni * ldomain%nj + + lnd_distgrid_esmf = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + deallocate(gindex) + + end function lnd_DistGrid_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_domain_esmf( bounds, dom) + ! + ! !DESCRIPTION: + ! Send the land model domain information to the coupler + ! + ! !USES: + use clm_varcon , only : re + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + type(ESMF_Array) , intent(inout) :: dom ! CLM domain data + ! + ! !LOCAL VARIABLES: + integer :: g,i ! index + integer :: klon,klat,karea,kmask,kfrac ! domain fields + real(R8), pointer :: fptr (:,:) + integer :: rc ! return code + !--------------------------------------------------------------------------- + + ! Initialize domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + + call ESMF_ArrayGet(dom, localDe=0, farrayPtr=fptr, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + klon = esmfshr_util_ArrayGetIndex(dom,'lon ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + klat = esmfshr_util_ArrayGetIndex(dom,'lat ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + karea = esmfshr_util_ArrayGetIndex(dom,'area',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kmask = esmfshr_util_ArrayGetIndex(dom,'mask',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kfrac = esmfshr_util_ArrayGetIndex(dom,'frac',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + + fptr(:,:) = -9999.0_R8 + fptr(kmask,:) = -0.0_R8 + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + fptr(klon, i) = ldomain%lonc(g) + fptr(klat, i) = ldomain%latc(g) + fptr(karea, i) = ldomain%area(g)/(re*re) + fptr(kmask, i) = real(ldomain%mask(g), r8) + fptr(kfrac, i) = real(ldomain%frac(g), r8) + end do + + end subroutine lnd_domain_esmf + !--------------------------------------------------------------------------- + +#endif + +end module lnd_comp_esmf diff --git a/components/clm/src/cpl/lnd_comp_mct.F90 b/components/clm/src/cpl/lnd_comp_mct.F90 new file mode 100644 index 0000000000..7c395afda3 --- /dev/null +++ b/components/clm/src/cpl/lnd_comp_mct.F90 @@ -0,0 +1,644 @@ +module lnd_comp_mct + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Interface of the active land model component of CESM the CLM (Community Land Model) + ! with the main CESM driver. This is a thin interface taking CESM driver information + ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM. + ! + ! !uses: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mct_mod , only : mct_avect, mct_gsmap + use decompmod , only : bounds_type, ldecomp + use lnd_import_export, only : lnd_import, lnd_export + ! + ! !public member functions: + implicit none + save + private ! by default make data private + ! + ! !public member functions: + public :: lnd_init_mct ! clm initialization + public :: lnd_run_mct ! clm run phase + public :: lnd_final_mct ! clm finalization/cleanup + ! + ! !private member functions: + private :: lnd_setgsmap_mct ! set the land model mct gs map + private :: lnd_domain_mct ! set the land model domain information + !--------------------------------------------------------------------------- + +contains + + !==================================================================================== + + subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + ! + ! !USES: + use abortutils , only : endrun + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_initializeMod, only : initialize1, initialize2, lnd2atm_inst, lnd2glc_inst + use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use decompMod , only : get_proc_bounds + use domainMod , only : ldomain + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod , only : seq_timemgr_EClockGetData + use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, & + seq_infodata_start_type_start, seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch + use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields + use spmdMod , only : masterproc, spmd_init + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_cpl_indices , only : clm_cpl_indices_set + use mct_mod + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock + type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data + type(mct_aVect), intent(inout) :: x2l_l, l2x_l ! land model import and export states + character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read + ! + ! !LOCAL VARIABLES: + integer :: LNDID ! Land identifyer + integer :: mpicom_lnd ! MPI communicator + type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map + type(mct_gGrid), pointer :: dom_l ! Land model domain + type(seq_infodata_type), pointer :: infodata ! CESM driver level info data + 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 + real(r8) :: scmlon ! single-column longitude + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + 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) + 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 + type(bounds_type) :: bounds ! bounds + character(len=32), parameter :: sub = 'lnd_init_mct' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + !----------------------------------------------------------------------- + + ! Set cdata data + + call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, & + gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) + + ! Determine attriute vector indices + + call clm_cpl_indices_set() + + ! Initialize clm MPI communicator + + call spmd_init( mpicom_lnd, LNDID ) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_init_mct:start::',lbnum) + endif +#endif + + inst_name = seq_comm_name(LNDID) + inst_index = seq_comm_inst(LNDID) + inst_suffix = seq_comm_suffix(LNDID) + + ! Initialize io log unit + + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Use infodata to set orbital values + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Consistency check on namelist filename + + call control_setNL("lnd_in"//trim(inst_suffix)) + + ! Initialize clm + ! initialize1 reads namelist, grid and surface data (need this to initialize gsmap) + ! initialize2 performs rest of initialization + + 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 ) + 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 ) + 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) + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + nsrest = nsrContinue + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + nsrest = nsrBranch + else + call endrun( sub//' ERROR: unknown starttype' ) + end if + + call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, & + brnch_retain_casename_in=brnch_retain_casename, & + single_column_in=single_column, scmlat_in=scmlat, & + scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & + hostname_in=hostname, username_in=username) + + ! Read namelist, grid and surface data + + call initialize1( ) + + ! If no land then exit out of initialization + + if ( noland ) then + call seq_infodata_PutData( infodata, lnd_present =.false.) + call seq_infodata_PutData( infodata, lnd_prognostic=.false.) + return + end if + + ! Determine if aerosol and dust deposition come from atmosphere component + + call seq_infodata_GetData(infodata, atm_aero=atm_aero ) + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if + + ! Initialize clm gsMap, clm domain and clm attribute vectors + + call get_proc_bounds( bounds ) + + call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) + + call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) + + call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) + call mct_aVect_zero(x2l_l) + + call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) + call mct_aVect_zero(l2x_l) + + ! Finish initializing clm + + 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, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) + + ! Fill in infodata settings + + call seq_infodata_PutData(infodata, lnd_prognostic=.true.) + call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) + + ! Get infodata info + + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + call set_nextsw_cday(nextsw_cday) + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine lnd_init_mct + + !==================================================================================== + + subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Run clm model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_initializeMod, only : lnd2atm_inst, atm2lnd_inst, lnd2glc_inst, glc2lnd_inst + use clm_driver , only : clm_drv + use clm_time_manager, only : get_curr_date, get_nstep, get_curr_calday, get_step_size + use clm_time_manager, only : advance_timestep, set_nextsw_cday,update_rad_dtime + use decompMod , only : get_proc_bounds + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod , only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn + use seq_timemgr_mod , only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use seq_infodata_mod, only : seq_infodata_type, seq_infodata_GetData + use spmdMod , only : masterproc, mpicom + use perf_mod , only : t_startf, t_stopf, t_barrierf + use shr_orb_mod , only : shr_orb_decl + use mct_mod + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + ! + ! !LOCAL VARIABLES: + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CLM current date (YYYYMMDD) + integer :: yr ! CLM current year + integer :: mon ! CLM current month + integer :: day ! CLM current day + integer :: tod ! CLM current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + 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 ! clm calday plus dtime offset + integer :: shrlogunit,shrloglev ! old values for share log unit and log level + integer :: lbnum ! input to memory diagnostic + integer :: g,i,lsize ! counters + real(r8) :: calday ! calendar day for nstep + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 + real(r8) :: eccf ! earth orbit eccentricity factor + real(r8) :: recip ! reciprical + logical,save :: first_call = .true. ! first call work + type(seq_infodata_type),pointer :: infodata ! CESM information from the driver + type(mct_gGrid), pointer :: dom_l ! Land model domain data + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + character(len=32), parameter :: sub = "lnd_run_mct" + !--------------------------------------------------------------------------- + + ! Determine processor bounds + + call get_proc_bounds(bounds) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:start::',lbnum) + endif +#endif + + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Determine time of next atmospheric shortwave calculation + call seq_cdata_setptrs(cdata_l, infodata=infodata, dom=dom_l) + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=ymd, curr_tod=tod_sync, & + curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + + call set_nextsw_cday( nextsw_cday ) + dtime = get_step_size() + + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync + nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) + rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) + + ! Map MCT to land data type + ! Perform downscaling if appropriate + + + ! Map to clm (only when state and/or fluxes need to be updated) + + call t_startf ('lc_lnd_import') + call lnd_import( bounds, x2l_l%rattr, atm2lnd_inst, glc2lnd_inst ) + call t_stopf ('lc_lnd_import') + + ! Use infodata to set orbital values if updated mid-run + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Loop over time steps in coupling interval + + dosend = .false. + do while(.not. dosend) + + ! 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 + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine doalb based on nextsw_cday sent from atm model + + nstep = get_nstep() + caldayp1 = get_curr_calday(offset=dtime) + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run clm + + call t_barrierf('sync_clm_run1', mpicom) + call t_startf ('clm_run') + call t_startf ('shr_orb_decl') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call t_stopf ('shr_orb_decl') + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) + call t_stopf ('clm_run') + + ! Create l2x_l export state - add river runoff input to l2x_l if appropriate + + call t_startf ('lc_lnd_export') + call lnd_export(bounds, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) + call t_stopf ('lc_lnd_export') + + ! Advance clm time step + + call t_startf ('lc_clm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_clm2_adv_timestep') + + end do + + ! Check that internal clock is in sync with master clock + + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) + end if + + ! Reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + + end subroutine lnd_run_mct + + !==================================================================================== + + subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Finalize land surface model + + use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn + use seq_timemgr_mod ,only : seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use mct_mod + use esmf + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + !--------------------------------------------------------------------------- + + ! fill this in + end subroutine lnd_final_mct + + !==================================================================================== + + subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + ! + ! !DESCRIPTION: + ! Set the MCT GS map for the land model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use domainMod , only : ldomain + use mct_mod , only : mct_gsMap, mct_gsMap_init + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: mpicom_lnd ! MPI communicator for the clm land model + integer , intent(in) :: LNDID ! Land model identifyer number + type(mct_gsMap) , intent(out) :: gsMap_lnd ! Resulting MCT GS map for the land model + ! + ! !LOCAL VARIABLES: + integer,allocatable :: gindex(:) ! Number the local grid points + integer :: i, j, n, gi ! Indices + integer :: lsize,gsize ! GS Map size + integer :: ier ! Error code + !--------------------------------------------------------------------------- + + ! Build the land grid numbering for MCT + ! NOTE: Numbering scheme is: West to East and South to North + ! starting at south pole. Should be the same as what's used in SCRIP + + allocate(gindex(bounds%begg:bounds%endg),stat=ier) + + ! number the local grid + + do n = bounds%begg, bounds%endg + gindex(n) = ldecomp%gdc2glo(n) + end do + lsize = bounds%endg - bounds%begg + 1 + gsize = ldomain%ni * ldomain%nj + + call mct_gsMap_init( gsMap_lnd, gindex, mpicom_lnd, LNDID, lsize, gsize ) + + deallocate(gindex) + + end subroutine lnd_SetgsMap_mct + + !==================================================================================== + + subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) + ! + ! !DESCRIPTION: + ! Send the land model domain information to the coupler + ! + ! !USES: + use clm_varcon , only: re + use domainMod , only: ldomain + use spmdMod , only: iam + use mct_mod , only: mct_gsMap, mct_gGrid, mct_gGrid_importIAttr + use mct_mod , only: mct_gGrid_importRAttr, mct_gGrid_init, mct_gsMap_orderedPoints + use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: lsize ! land model domain data size + type(mct_gsMap), intent(inout) :: gsMap_l ! Output land model MCT GS map + type(mct_ggrid), intent(out) :: dom_l ! Output domain information for land model + ! + ! Local Variables + integer :: g,i,j ! index + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + !--------------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + ! + call mct_gGrid_init( GGrid=dom_l, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_l, iam, idata) + call mct_gGrid_importIAttr(dom_l,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_l,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_l,"mask" ,data,lsize) + ! + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + ! + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%lonc(g) + end do + call mct_gGrid_importRattr(dom_l,"lon",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%latc(g) + end do + call mct_gGrid_importRattr(dom_l,"lat",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%area(g)/(re*re) + end do + call mct_gGrid_importRattr(dom_l,"area",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%mask(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"mask",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%frac(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine lnd_domain_mct + +end module lnd_comp_mct diff --git a/components/clm/src/cpl/lnd_import_export.F90 b/components/clm/src/cpl/lnd_import_export.F90 new file mode 100644 index 0000000000..26021f5e35 --- /dev/null +++ b/components/clm/src/cpl/lnd_import_export.F90 @@ -0,0 +1,328 @@ +module lnd_import_export + + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + use abortutils , only: endrun + use decompmod , only: bounds_type + use lnd2atmType , only: lnd2atm_type + use lnd2glcMod , only: lnd2glc_type + use atm2lndType , only: atm2lnd_type + use glc2lndMod , only: glc2lnd_type + use clm_cpl_indices + ! + implicit none + !=============================================================================== + +contains + + !=============================================================================== + subroutine lnd_import( bounds, x2l, atm2lnd_inst, glc2lnd_inst) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the input data from the coupler to the land model + ! + ! !USES: + use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use domainMod , only: ldomain + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type + ! + ! !LOCAL VARIABLES: + integer :: g,i,nstep,ier ! indices, number of steps, and error code + real(r8) :: forc_rainc ! rainxy Atm flux mm/s + real(r8) :: e ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + 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_rainl ! rainxy Atm flux mm/s + real(r8) :: forc_snowc ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl ! snowfxl Atm flux mm/s + real(r8) :: co2_ppmv_diag ! temporary + real(r8) :: co2_ppmv_prog ! temporary + real(r8) :: co2_ppmv_val ! temporary + integer :: co2_type_idx ! integer flag for co2_type options + real(r8) :: esatw ! saturation vapor pressure over water (Pa) + real(r8) :: esati ! saturation vapor pressure over ice (Pa) + real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water + 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 + integer :: num ! counter + character(len=32), parameter :: sub = 'lnd_import_mct' + + ! 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)))))) + !--------------------------------------------------------------------------- + + co2_type_idx = 0 + if (co2_type == 'prognostic') then + co2_type_idx = 1 + else if (co2_type == 'diagnostic') then + co2_type_idx = 2 + end if + if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) + else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) + end if + + ! Note that the precipitation fluxes received from the coupler + ! are in units of kg/s/m^2. To convert these precipitation rates + ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + + ! Determine flooding input, sign convention is positive downward and + ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, + ! change the sign to indicate addition of water to system. + + atm2lnd_inst%forc_flood_grc(g) = -x2l(index_x2l_Flrr_flood,i) + + atm2lnd_inst%volr_grc(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8) + + ! Determine required receive fields + + atm2lnd_inst%forc_hgt_grc(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m + atm2lnd_inst%forc_u_grc(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s + atm2lnd_inst%forc_v_grc(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s + atm2lnd_inst%forc_solad_grc(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2 + atm2lnd_inst%forc_solad_grc(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2 + atm2lnd_inst%forc_solai_grc(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2 + atm2lnd_inst%forc_solai_grc(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2 + + atm2lnd_inst%forc_th_not_downscaled_grc(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K + atm2lnd_inst%forc_q_not_downscaled_grc(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg + atm2lnd_inst%forc_pbot_not_downscaled_grc(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa + atm2lnd_inst%forc_t_not_downscaled_grc(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K + atm2lnd_inst%forc_lwrad_not_downscaled_grc(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2 + + forc_rainc = x2l(index_x2l_Faxa_rainc,i) ! mm/s + forc_rainl = x2l(index_x2l_Faxa_rainl,i) ! mm/s + forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s + forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s + + ! atmosphere coupling, for prognostic/prescribed aerosols + atm2lnd_inst%forc_aer_grc(g,1) = x2l(index_x2l_Faxa_bcphidry,i) + atm2lnd_inst%forc_aer_grc(g,2) = x2l(index_x2l_Faxa_bcphodry,i) + atm2lnd_inst%forc_aer_grc(g,3) = x2l(index_x2l_Faxa_bcphiwet,i) + atm2lnd_inst%forc_aer_grc(g,4) = x2l(index_x2l_Faxa_ocphidry,i) + atm2lnd_inst%forc_aer_grc(g,5) = x2l(index_x2l_Faxa_ocphodry,i) + atm2lnd_inst%forc_aer_grc(g,6) = x2l(index_x2l_Faxa_ocphiwet,i) + atm2lnd_inst%forc_aer_grc(g,7) = x2l(index_x2l_Faxa_dstwet1,i) + atm2lnd_inst%forc_aer_grc(g,8) = x2l(index_x2l_Faxa_dstdry1,i) + atm2lnd_inst%forc_aer_grc(g,9) = x2l(index_x2l_Faxa_dstwet2,i) + atm2lnd_inst%forc_aer_grc(g,10) = x2l(index_x2l_Faxa_dstdry2,i) + atm2lnd_inst%forc_aer_grc(g,11) = x2l(index_x2l_Faxa_dstwet3,i) + atm2lnd_inst%forc_aer_grc(g,12) = x2l(index_x2l_Faxa_dstdry3,i) + atm2lnd_inst%forc_aer_grc(g,13) = x2l(index_x2l_Faxa_dstwet4,i) + atm2lnd_inst%forc_aer_grc(g,14) = x2l(index_x2l_Faxa_dstdry4,i) + + ! Determine optional receive fields + + if (index_x2l_Sa_co2prog /= 0) then + co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic + else + co2_ppmv_prog = co2_ppmv + end if + + if (index_x2l_Sa_co2diag /= 0) then + co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic + else + co2_ppmv_diag = co2_ppmv + end if + + if (index_x2l_Sa_methane /= 0) then + atm2lnd_inst%forc_pch4_grc(g) = x2l(index_x2l_Sa_methane,i) + endif + + ! Determine derived quantities for required fields + + forc_t = atm2lnd_inst%forc_t_not_downscaled_grc(g) + forc_q = atm2lnd_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_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) + + atm2lnd_inst%forc_rain_not_downscaled_grc(g) = forc_rainc + forc_rainl + atm2lnd_inst%forc_snow_not_downscaled_grc(g) = forc_snowc + forc_snowl + + 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) + atm2lnd_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat) + ! Make sure relative humidity is properly bounded + ! atm2lnd_inst%forc_rh_grc(g) = min( 100.0_r8, atm2lnd_inst%forc_rh_grc(g) ) + ! atm2lnd_inst%forc_rh_grc(g) = max( 0.0_r8, atm2lnd_inst%forc_rh_grc(g) ) + + ! Determine derived quantities for optional fields + ! Note that the following does unit conversions from ppmv to partial pressures (Pa) + ! Note that forc_pbot is in Pa + + if (co2_type_idx == 1) then + co2_ppmv_val = co2_ppmv_prog + else if (co2_type_idx == 2) then + co2_ppmv_val = co2_ppmv_diag + else + co2_ppmv_val = co2_ppmv + end if + atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot + if (use_c13) then + atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot + end if + + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + glc2lnd_inst%frac_grc(g,num) = x2l(index_x2l_Sg_ice_covered(num),i) + glc2lnd_inst%topo_grc(g,num) = x2l(index_x2l_Sg_topo(num),i) + glc2lnd_inst%hflx_grc(g,num) = x2l(index_x2l_Flgg_hflx(num),i) + end do + glc2lnd_inst%icemask_grc(g) = x2l(index_x2l_Sg_icemask,i) + glc2lnd_inst%icemask_coupled_fluxes_grc(g) = x2l(index_x2l_Sg_icemask_coupled_fluxes,i) + end if + + end do + + end subroutine lnd_import + + !=============================================================================== + + subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the data to be sent from the clm model to the coupler + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog, create_glacier_mec_landunit + use clm_time_manager , only : get_nstep, get_step_size + use seq_drydep_mod , only : n_drydep + use shr_megan_mod , only : shr_megan_mechcomps_n + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + type(lnd2atm_type), intent(inout) :: lnd2atm_inst ! clm land to atmosphere exchange data type + type(lnd2glc_type), intent(inout) :: lnd2glc_inst ! clm land to atmosphere exchange data type + real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid + ! + ! !LOCAL VARIABLES: + integer :: g,i ! indices + integer :: ier ! error status + integer :: nstep ! time step index + integer :: dtime ! time step + integer :: num ! counter + !--------------------------------------------------------------------------- + + ! cesm sign convention is that fluxes are positive downward + + l2x(:,:) = 0.0_r8 + + do g = bounds%begg,bounds%endg + i = 1 + (g-bounds%begg) + l2x(index_l2x_Sl_t,i) = lnd2atm_inst%t_rad_grc(g) + l2x(index_l2x_Sl_snowh,i) = lnd2atm_inst%h2osno_grc(g) + l2x(index_l2x_Sl_avsdr,i) = lnd2atm_inst%albd_grc(g,1) + l2x(index_l2x_Sl_anidr,i) = lnd2atm_inst%albd_grc(g,2) + l2x(index_l2x_Sl_avsdf,i) = lnd2atm_inst%albi_grc(g,1) + l2x(index_l2x_Sl_anidf,i) = lnd2atm_inst%albi_grc(g,2) + l2x(index_l2x_Sl_tref,i) = lnd2atm_inst%t_ref2m_grc(g) + l2x(index_l2x_Sl_qref,i) = lnd2atm_inst%q_ref2m_grc(g) + l2x(index_l2x_Sl_u10,i) = lnd2atm_inst%u_ref10m_grc(g) + l2x(index_l2x_Fall_taux,i) = -lnd2atm_inst%taux_grc(g) + l2x(index_l2x_Fall_tauy,i) = -lnd2atm_inst%tauy_grc(g) + l2x(index_l2x_Fall_lat,i) = -lnd2atm_inst%eflx_lh_tot_grc(g) + l2x(index_l2x_Fall_sen,i) = -lnd2atm_inst%eflx_sh_tot_grc(g) + l2x(index_l2x_Fall_lwup,i) = -lnd2atm_inst%eflx_lwrad_out_grc(g) + l2x(index_l2x_Fall_evap,i) = -lnd2atm_inst%qflx_evap_tot_grc(g) + l2x(index_l2x_Fall_swnet,i) = lnd2atm_inst%fsa_grc(g) + if (index_l2x_Fall_fco2_lnd /= 0) then + l2x(index_l2x_Fall_fco2_lnd,i) = -lnd2atm_inst%nee_grc(g) + end if + + ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC + ! These are now standard fields, but the check on the index makes sure the driver handles them + if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = lnd2atm_inst%ram1_grc(g) + if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = lnd2atm_inst%fv_grc(g) + if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = lnd2atm_inst%h2osoi_vol_grc(g,1) + if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -lnd2atm_inst%flxdst_grc(g,1) + if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -lnd2atm_inst%flxdst_grc(g,2) + if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -lnd2atm_inst%flxdst_grc(g,3) + if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -lnd2atm_inst%flxdst_grc(g,4) + + + ! for dry dep velocities + if (index_l2x_Sl_ddvel /= 0 ) then + l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = & + lnd2atm_inst%ddvel_grc(g,:n_drydep) + end if + + ! for MEGAN VOC emis fluxes + if (index_l2x_Fall_flxvoc /= 0 ) then + l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = & + -lnd2atm_inst%flxvoc_grc(g,:shr_megan_mechcomps_n) + end if + + if (index_l2x_Fall_methane /= 0) then + l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g) + endif + + ! sign convention is positive downward with + ! hierarchy of atm/glc/lnd/rof/ice/ocn. so water sent from land to rof is positive + + l2x(index_l2x_Flrl_rofl,i) = lnd2atm_inst%qflx_rofliq_grc(g) + l2x(index_l2x_Flrl_rofi,i) = lnd2atm_inst%qflx_rofice_grc(g) + + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + l2x(index_l2x_Sl_tsrf(num),i) = lnd2glc_inst%tsrf_grc(g,num) + l2x(index_l2x_Sl_topo(num),i) = lnd2glc_inst%topo_grc(g,num) + l2x(index_l2x_Flgl_qice(num),i) = lnd2glc_inst%qice_grc(g,num) + end do + end if + + end do + + end subroutine lnd_export + +end module lnd_import_export diff --git a/components/clm/src/dyn_subgrid/CMakeLists.txt b/components/clm/src/dyn_subgrid/CMakeLists.txt new file mode 100644 index 0000000000..8d5f00b6f9 --- /dev/null +++ b/components/clm/src/dyn_subgrid/CMakeLists.txt @@ -0,0 +1,23 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +set(genf90_files + dynVarMod.F90.in + dynVarTimeInterpMod.F90.in + dynVarTimeUninterpMod.F90.in + ) + +process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_SOURCE_DIR} clm_genf90_sources) + +sourcelist_to_parent(clm_genf90_sources) + +list(APPEND clm_sources "${clm_genf90_sources}") + +list(APPEND clm_sources + dynPriorWeightsMod.F90 + dynTimeInfoMod.F90 + dynLandunitAreaMod.F90 + dynInitColumnsMod.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/dyn_subgrid/dynCNDVMod.F90 b/components/clm/src/dyn_subgrid/dynCNDVMod.F90 new file mode 100644 index 0000000000..2bea506938 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynCNDVMod.F90 @@ -0,0 +1,110 @@ +module dynCNDVMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Handle weight updates associated with prognostic dynamic vegetation (CNDV) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use LandunitType , only : lun + use PatchType , only : patch + use CNDVType , only : dgvs_type + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dynCNDV_init ! initialize CNDV weight updates + public :: dynCNDV_interp ! interpolate CNDV weight updates to the time step + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine dynCNDV_init(bounds, dgvs_inst) + ! + ! !DESCRIPTION: + ! Initialize time interpolation of cndv pft weights from annual to time step + ! + ! Should be called once, in model initialization + ! + ! !USES: + use clm_varctl, only : nsrest, nsrStartup + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + integer :: ier, p ! error status, do-loop index + character(len=32) :: subname='dynCNDV_init' ! subroutine name + !----------------------------------------------------------------------- + + if (nsrest == nsrStartup) then + do p = bounds%begp,bounds%endp + dgvs_inst%fpcgrid_patch(p) = patch%wtcol(p) + dgvs_inst%fpcgridold_patch(p) = patch%wtcol(p) + end do + end if + + end subroutine dynCNDV_init + + !----------------------------------------------------------------------- + subroutine dynCNDV_interp( bounds, dgvs_inst) + ! + ! !DESCRIPTION: + ! Time interpolate cndv pft weights from annual to time step + ! + ! !USES: + use clm_time_manager, only : get_curr_date, get_step_size, get_nstep, get_curr_yearfrac + use landunit_varcon , only : istsoil ! CNDV incompatible with dynLU + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + integer :: c,g,l,p ! indices + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: wt1 ! time interpolation weights (weight of time 1) + real(r8) :: dtime ! model time step + real(r8) :: days_per_year ! days per year + integer :: nstep ! time step number + integer :: year ! year (0, ...) at nstep + 1 + integer :: mon ! month (1, ..., 12) at nstep + 1 + integer :: day ! day of month (1, ..., 31) at nstep + 1 + integer :: sec ! seconds into current date at nstep + 1 + character(len=32) :: subname='dynCNDV_interp' ! subroutine name + !----------------------------------------------------------------------- + + ! Interpolate pft weight to current time step + ! Map interpolated pctpft to subgrid weights + ! assumes maxpatch_pft = numpft + 1, each landunit has 1 column, + ! SCAM not defined and create_croplandunit = .false. + + nstep = get_nstep() + dtime = get_step_size() + + wt1 = 1.0_r8 - get_curr_yearfrac(offset = -int(dtime)) + + call get_curr_date(year, mon, day, sec, offset=int(dtime)) + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + + if (lun%itype(l) == istsoil .and. lun%wtgcell(l) > 0._r8) then ! CNDV incompatible with dynLU + patch%wtcol(p) = dgvs_inst%fpcgrid_patch(p) + & + wt1 * (dgvs_inst%fpcgridold_patch(p) - dgvs_inst%fpcgrid_patch(p)) + + if (mon==1 .and. day==1 .and. sec==dtime .and. nstep>0) then + dgvs_inst%fpcgridold_patch(p) = dgvs_inst%fpcgrid_patch(p) + end if + end if + end do + + end subroutine dynCNDV_interp + +end module dynCNDVMod diff --git a/components/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 b/components/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 new file mode 100644 index 0000000000..1ce449b9bc --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynConsBiogeochemMod.F90 @@ -0,0 +1,2314 @@ +module dynConsBiogeochemMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Handle conservation of biogeochemical quantities (C & N) with dynamic land cover. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog, use_c13, use_c14 + use pftconMod , only : pftcon + use CanopyStateType , only : canopystate_type + use PhotosynthesisMod , only : photosyns_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilBiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilBiogeochem_carbonflux_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dyn_cnbal_patch + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine dyn_cnbal_patch(bounds, prior_weights, first_step_cold_start, & + canopystate_inst, photosyns_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! Modify patch-level state and flux variables to maintain carbon and nitrogen balance with + ! dynamic patch-weights. + ! + ! !USES: + use shr_const_mod , only : SHR_CONST_PDB + use landunit_varcon , only : istsoil, istcrop + use clm_varpar , only : numveg, nlevdecomp, max_patch_per_col + use clm_varcon , only : c13ratio, c14ratio + use clm_time_manager , only : get_step_size + use dynPriorWeightsMod , only : prior_weights_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(prior_weights_type) , intent(in) :: prior_weights ! weights prior to the subgrid weight updates + logical , intent(in) :: first_step_cold_start ! true if this is the first step since cold start + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + ! + ! !LOCAL VARIABLES: + integer :: pi,p,c,l,g,j ! indices + integer :: ier ! error code + real(r8) :: dwt ! change in patch weight (relative to column) + real(r8) :: dt ! land model time step (sec) + real(r8) :: init_h2ocan ! initial canopy water mass + real(r8) :: new_h2ocan ! canopy water mass after weight shift + real(r8), allocatable :: dwt_leafc_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_leafn_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemc_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemn_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_frootc_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable :: dwt_livecrootc_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable :: dwt_deadcrootc_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_frootn_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_livecrootn_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_deadcrootn_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable :: conv_cflux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable :: prod10_cflux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable :: prod100_cflux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: conv_nflux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod10_nflux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod100_nflux(:) ! patch-level mass loss due to weight shift + real(r8) :: t1,t2,wt_new,wt_old + real(r8) :: init_state, change_state, new_state + real(r8) :: tot_leaf, pleaf, pstor, pxfer + real(r8) :: leafc_seed, leafn_seed + real(r8) :: deadstemc_seed, deadstemn_seed + real(r8), pointer :: dwt_ptr0, dwt_ptr1, dwt_ptr2, dwt_ptr3, ptr + character(len=32) :: subname='dyn_cbal' ! subroutine name + !! C13 + real(r8), allocatable :: dwt_leafc13_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemc13_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable, target :: dwt_frootc13_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_livecrootc13_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_deadcrootc13_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: conv_c13flux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod10_c13flux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod100_c13flux(:) ! patch-level mass loss due to weight shift + real(r8) :: c3_del13c ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c4_del13c ! typical del13C for C4 photosynthesis (permil, relative to PDB) + real(r8) :: c3_r1_c13 ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8) :: c4_r1_c13 ! isotope ratio (13c/12c) for C4 photosynthesis + real(r8) :: c3_r2_c13 ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8) :: c4_r2_c13 ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis + real(r8) :: leafc13_seed, deadstemc13_seed + !! C14 + real(r8), allocatable :: dwt_leafc14_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemc14_seed(:) ! patch-level mass gain due to seeding of new area + real(r8), allocatable, target :: dwt_frootc14_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_livecrootc14_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_deadcrootc14_to_litter(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: conv_c14flux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod10_c14flux(:) ! patch-level mass loss due to weight shift + real(r8), allocatable, target :: prod100_c14flux(:) ! patch-level mass loss due to weight shift + real(r8) :: c3_del14c ! typical del14C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c4_del14c ! typical del14C for C4 photosynthesis (permil, relative to PDB) + real(r8) :: c3_r1_c14 ! isotope ratio (14c/12c) for C3 photosynthesis + real(r8) :: c4_r1_c14 ! isotope ratio (14c/12c) for C4 photosynthesis + real(r8) :: c3_r2_c14 ! isotope ratio (14c/[12c+14c]) for C3 photosynthesis + real(r8) :: c4_r2_c14 ! isotope ratio (14c/[12c+14c]) for C4 photosynthesis + real(r8) :: leafc14_seed, deadstemc14_seed + !----------------------------------------------------------------------- + + ! Allocate patch-level mass loss arrays + allocate(dwt_leafc_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafc_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_leafn_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafn_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadstemc_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemc_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadstemn_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemn_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_frootc_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootc_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_livecrootc_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootc_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadcrootc_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootc_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_frootn_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootn_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_livecrootn_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootn_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadcrootn_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootn_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(conv_cflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_cflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod10_cflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_cflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod100_cflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_cflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(conv_nflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_nflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod10_nflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_nflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod100_nflux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_nflux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if ( use_c13 ) then + allocate(dwt_leafc13_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafc13_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadstemc13_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemc13_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_frootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootc13_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_livecrootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootc13_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadcrootc13_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootc13_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(conv_c13flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_c13flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod10_c13flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_c13flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod100_c13flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_c13flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + endif + if ( use_c14 ) then + allocate(dwt_leafc14_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafc14_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadstemc14_seed(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemc14_seed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_frootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootc14_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_livecrootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootc14_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(dwt_deadcrootc14_to_litter(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootc14_to_litter' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(conv_c14flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_c14flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod10_c14flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_c14flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(prod100_c14flux(bounds%begp:bounds%endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_c14flux' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + endif + + ! Get time step + dt = real( get_step_size(), r8 ) + + do p = bounds%begp,bounds%endp + c = patch%column(p) + ! initialize all the patch-level local flux arrays + dwt_leafc_seed(p) = 0._r8 + dwt_leafn_seed(p) = 0._r8 + dwt_deadstemc_seed(p) = 0._r8 + dwt_deadstemn_seed(p) = 0._r8 + dwt_frootc_to_litter(p) = 0._r8 + dwt_livecrootc_to_litter(p) = 0._r8 + dwt_deadcrootc_to_litter(p) = 0._r8 + dwt_frootn_to_litter(p) = 0._r8 + dwt_livecrootn_to_litter(p) = 0._r8 + dwt_deadcrootn_to_litter(p) = 0._r8 + conv_cflux(p) = 0._r8 + prod10_cflux(p) = 0._r8 + prod100_cflux(p) = 0._r8 + conv_nflux(p) = 0._r8 + prod10_nflux(p) = 0._r8 + prod100_nflux(p) = 0._r8 + + if ( use_c13 ) then + dwt_leafc13_seed(p) = 0._r8 + dwt_deadstemc13_seed(p) = 0._r8 + dwt_frootc13_to_litter(p) = 0._r8 + dwt_livecrootc13_to_litter(p) = 0._r8 + dwt_deadcrootc13_to_litter(p) = 0._r8 + conv_c13flux(p) = 0._r8 + prod10_c13flux(p) = 0._r8 + prod100_c13flux(p) = 0._r8 + endif + + if ( use_c14 ) then + dwt_leafc14_seed(p) = 0._r8 + dwt_deadstemc14_seed(p) = 0._r8 + dwt_frootc14_to_litter(p) = 0._r8 + dwt_livecrootc14_to_litter(p) = 0._r8 + dwt_deadcrootc14_to_litter(p) = 0._r8 + conv_c14flux(p) = 0._r8 + prod10_c14flux(p) = 0._r8 + prod100_c14flux(p) = 0._r8 + endif + + l = patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + ! calculate the change in weight for the timestep + ! + ! If this is the first time step since cold start, then we set dwt to 0 to avoid + ! doing any adjustments on the first time step after cold start. This is because + ! we expect big transients in the first time step, since transient subgrid + ! weights aren't updated in initialization. + if (first_step_cold_start) then + dwt = 0._r8 + else + dwt = patch%wtcol(p)-prior_weights%pwtcol(p) + end if + CNveg_state_inst%lfpftd_patch(p) = -dwt + + ! Patches for which weight increases on this timestep + if (dwt > 0._r8) then + + ! first identify Patches that are initiating on this timestep + ! and set all the necessary state and flux variables + if (prior_weights%pwtcol(p) == 0._r8) then + + ! set initial conditions for PFT that is being initiated + ! in this time step. Based on the settings in cnIniTimeVar. + + ! patch-level carbon state variables + cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 + cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 + cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 + cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 + cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 + cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 + cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 + cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 + cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 + cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 + cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 + cnveg_carbonstate_inst%totc_patch(p) = 0._r8 + cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 + + if ( use_c13 ) then + ! patch-level carbon-13 state variables + c13_cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%totc_patch(p) = 0._r8 + c13_cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 + endif + + if ( use_c14 ) then + ! patch-level carbon-14 state variables + c14_cnveg_carbonstate_inst%leafc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%leafc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%frootc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%frootc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livestemc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadstemc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livecrootc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadcrootc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%gresp_storage_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%cpool_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%xsmrpool_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%ctrunc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%dispvegc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%storvegc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%totc_patch(p) = 0._r8 + c14_cnveg_carbonstate_inst%totvegc_patch(p) = 0._r8 + endif + + ! patch-level nitrogen state variables + cnveg_nitrogenstate_inst%leafn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%leafn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%leafn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%frootn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%frootn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%frootn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livestemn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadstemn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livecrootn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadcrootn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%retransn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%npool_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%ntrunc_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%dispvegn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%storvegn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%totvegn_patch(p) = 0._r8 + cnveg_nitrogenstate_inst%totn_patch (p) = 0._r8 + + ! initialize same flux and epv variables that are set + canopystate_inst%laisun_patch(p) = 0._r8 + canopystate_inst%laisha_patch(p) = 0._r8 + + cnveg_state_inst%dormant_flag_patch(p) = 1._r8 + cnveg_state_inst%days_active_patch(p) = 0._r8 + cnveg_state_inst%onset_flag_patch(p) = 0._r8 + cnveg_state_inst%onset_counter_patch(p) = 0._r8 + cnveg_state_inst%onset_gddflag_patch(p) = 0._r8 + cnveg_state_inst%onset_fdd_patch(p) = 0._r8 + cnveg_state_inst%onset_gdd_patch(p) = 0._r8 + cnveg_state_inst%onset_swi_patch(p) = 0._r8 + cnveg_state_inst%offset_flag_patch(p) = 0._r8 + cnveg_state_inst%offset_counter_patch(p) = 0._r8 + cnveg_state_inst%offset_fdd_patch(p) = 0._r8 + cnveg_state_inst%offset_swi_patch(p) = 0._r8 + cnveg_state_inst%lgsf_patch(p) = 0._r8 + cnveg_state_inst%bglfr_patch(p) = 0._r8 + cnveg_state_inst%bgtr_patch(p) = 0._r8 + cnveg_state_inst%annavg_t2m_patch(p) = cnveg_state_inst%annavg_t2m_col(c) + cnveg_state_inst%tempavg_t2m_patch(p) = 0._r8 + cnveg_state_inst%c_allometry_patch(p) = 0._r8 + cnveg_state_inst%n_allometry_patch(p) = 0._r8 + cnveg_state_inst%tempsum_potential_gpp_patch(p) = 0._r8 + cnveg_state_inst%annsum_potential_gpp_patch(p) = 0._r8 + cnveg_state_inst%tempmax_retransn_patch(p) = 0._r8 + cnveg_state_inst%annmax_retransn_patch(p) = 0._r8 + cnveg_state_inst%downreg_patch(p) = 0._r8 + + cnveg_carbonflux_inst%xsmrpool_recover_patch(p) = 0._r8 + cnveg_carbonflux_inst%plant_calloc_patch(p) = 0._r8 + cnveg_carbonflux_inst%excess_cflux_patch(p) = 0._r8 + cnveg_carbonflux_inst%prev_leafc_to_litter_patch(p) = 0._r8 + cnveg_carbonflux_inst%prev_frootc_to_litter_patch(p) = 0._r8 + cnveg_carbonflux_inst%availc_patch(p) = 0._r8 + cnveg_carbonflux_inst%gpp_before_downreg_patch(p) = 0._r8 + + cnveg_carbonflux_inst%tempsum_npp_patch(p) = 0._r8 + cnveg_carbonflux_inst%annsum_npp_patch(p) = 0._r8 + + cnveg_nitrogenflux_inst%plant_ndemand_patch(p) = 0._r8 + cnveg_nitrogenflux_inst%avail_retransn_patch(p) = 0._r8 + cnveg_nitrogenflux_inst%plant_nalloc_patch(p) = 0._r8 + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%xsmrpool_c13ratio_patch(p) = c13ratio + end if + + call photosyns_inst%NewPatchinit(p) + + end if ! end initialization of new patch + + ! (still in dwt > 0 block) + + ! set the seed sources for leaf and deadstem + ! leaf source is split later between leaf, leaf_storage, leaf_xfer + leafc_seed = 0._r8 + leafn_seed = 0._r8 + deadstemc_seed = 0._r8 + deadstemn_seed = 0._r8 + if ( use_c13 ) then + leafc13_seed = 0._r8 + deadstemc13_seed = 0._r8 + endif + if ( use_c14 ) then + leafc14_seed = 0._r8 + deadstemc14_seed = 0._r8 + endif + if (patch%itype(p) /= 0) then + leafc_seed = 1._r8 + leafn_seed = leafc_seed / pftcon%leafcn(patch%itype(p)) + if (pftcon%woody(patch%itype(p)) == 1._r8) then + deadstemc_seed = 0.1_r8 + deadstemn_seed = deadstemc_seed / pftcon%deadwdcn(patch%itype(p)) + end if + + if ( use_c13 ) then + ! 13c state is initialized assuming del13c = -28 permil for C3, and -13 permil for C4. + ! That translates to ratios of (13c/(12c+13c)) of 0.01080455 for C3, and 0.01096945 for C4 + ! based on the following formulae: + ! r1 (13/12) = PDB + (del13c * PDB)/1000.0 + ! r2 (13/(13+12)) = r1/(1+r1) + ! PDB = 0.0112372_R8 (ratio of 13C/12C in Pee Dee Belemnite, C isotope standard) + c3_del13c = -28._r8 + c4_del13c = -13._r8 + c3_r1_c13 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + c3_r2_c13 = c3_r1_c13/(1._r8 + c3_r1_c13) + c4_r1_c13 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) + c4_r2_c13 = c4_r1_c13/(1._r8 + c4_r1_c13) + + if (pftcon%c3psn(patch%itype(p)) == 1._r8) then + leafc13_seed = leafc_seed * c3_r2_c13 + deadstemc13_seed = deadstemc_seed * c3_r2_c13 + else + leafc13_seed = leafc_seed * c4_r2_c13 + deadstemc13_seed = deadstemc_seed * c4_r2_c13 + end if + endif + + if ( use_c14 ) then + ! 14c state is initialized assuming initial "modern" 14C of 1.e-12 + if (pftcon%c3psn(patch%itype(p)) == 1._r8) then + leafc14_seed = leafc_seed * c14ratio + deadstemc14_seed = deadstemc_seed * c14ratio + else + leafc14_seed = leafc_seed * c14ratio + deadstemc14_seed = deadstemc_seed * c14ratio + end if + endif + end if + + ! When PATCH area expands (dwt > 0), the patch-level mass density + ! is modified to conserve the original patch mass distributed + ! over the new (larger) area, plus a term to account for the + ! introduction of new seed source for leaf and deadstem + t1 = prior_weights%pwtcol(p)/patch%wtcol(p) + t2 = dwt/patch%wtcol(p) + + tot_leaf = cnveg_carbonstate_inst%leafc_patch(p) + & + cnveg_carbonstate_inst%leafc_storage_patch(p) + & + cnveg_carbonstate_inst%leafc_xfer_patch(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + ! when adding seed source to non-zero leaf state, use current proportions + pleaf = cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf + pstor = cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf + pxfer = cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(patch%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + cnveg_carbonstate_inst%leafc_patch(p) = cnveg_carbonstate_inst%leafc_patch(p) *t1 & + + leafc_seed*pleaf*t2 + cnveg_carbonstate_inst%leafc_storage_patch(p) = cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & + + leafc_seed*pstor*t2 + cnveg_carbonstate_inst%leafc_xfer_patch(p) = cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & + + leafc_seed*pxfer*t2 + cnveg_carbonstate_inst%frootc_patch(p) = cnveg_carbonstate_inst%frootc_patch(p) *t1 + cnveg_carbonstate_inst%frootc_storage_patch(p) = cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 + cnveg_carbonstate_inst%frootc_xfer_patch(p) = cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 + cnveg_carbonstate_inst%livestemc_patch(p) = cnveg_carbonstate_inst%livestemc_patch(p) *t1 + cnveg_carbonstate_inst%livestemc_storage_patch(p) = cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 + cnveg_carbonstate_inst%livestemc_xfer_patch(p) = cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 + cnveg_carbonstate_inst%deadstemc_patch(p) = cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & + + deadstemc_seed*t2 + cnveg_carbonstate_inst%deadstemc_storage_patch(p) = cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 + cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 + cnveg_carbonstate_inst%livecrootc_patch(p) = cnveg_carbonstate_inst%livecrootc_patch(p) *t1 + cnveg_carbonstate_inst%livecrootc_storage_patch(p) = cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 + cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 + cnveg_carbonstate_inst%deadcrootc_patch(p) = cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 + cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 + cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 + cnveg_carbonstate_inst%gresp_storage_patch(p) = cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 + cnveg_carbonstate_inst%gresp_xfer_patch(p) = cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 + cnveg_carbonstate_inst%cpool_patch(p) = cnveg_carbonstate_inst%cpool_patch(p) *t1 + cnveg_carbonstate_inst%xsmrpool_patch(p) = cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 + cnveg_carbonstate_inst%ctrunc_patch(p) = cnveg_carbonstate_inst%ctrunc_patch(p) *t1 + cnveg_carbonstate_inst%dispvegc_patch(p) = cnveg_carbonstate_inst%dispvegc_patch(p) *t1 + cnveg_carbonstate_inst%storvegc_patch(p) = cnveg_carbonstate_inst%storvegc_patch(p) *t1 + cnveg_carbonstate_inst%totc_patch(p) = cnveg_carbonstate_inst%totc_patch(p) *t1 + cnveg_carbonstate_inst%totvegc_patch(p) = cnveg_carbonstate_inst%totvegc_patch(p) *t1 + + if ( use_c13 ) then + ! patch-level carbon-13 state variables + tot_leaf = & + c13_cnveg_carbonstate_inst%leafc_patch(p) + & + c13_cnveg_carbonstate_inst%leafc_storage_patch(p) + & + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + pleaf = c13_cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf + pstor = c13_cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf + pxfer = c13_cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(patch%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + c13_cnveg_carbonstate_inst%leafc_patch(p) = c13_cnveg_carbonstate_inst%leafc_patch(p) *t1 & + + leafc13_seed*pleaf*t2 + c13_cnveg_carbonstate_inst%leafc_storage_patch(p) = c13_cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & + + leafc13_seed*pstor*t2 + c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & + + leafc13_seed*pxfer*t2 + c13_cnveg_carbonstate_inst%frootc_patch(p) = c13_cnveg_carbonstate_inst%frootc_patch(p) *t1 + c13_cnveg_carbonstate_inst%frootc_storage_patch(p) = c13_cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%livestemc_patch(p) = c13_cnveg_carbonstate_inst%livestemc_patch(p) *t1 + c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) = c13_cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = c13_cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%deadstemc_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & + + deadstemc13_seed*t2 + c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = c13_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%livecrootc_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_patch(p) *t1 + c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%deadcrootc_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 + c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = c13_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%gresp_storage_patch(p) = c13_cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 + c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) = c13_cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 + c13_cnveg_carbonstate_inst%cpool_patch(p) = c13_cnveg_carbonstate_inst%cpool_patch(p) *t1 + c13_cnveg_carbonstate_inst%xsmrpool_patch(p) = c13_cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 + c13_cnveg_carbonstate_inst%ctrunc_patch(p) = c13_cnveg_carbonstate_inst%ctrunc_patch(p) *t1 + c13_cnveg_carbonstate_inst%dispvegc_patch(p) = c13_cnveg_carbonstate_inst%dispvegc_patch(p) *t1 + c13_cnveg_carbonstate_inst%storvegc_patch(p) = c13_cnveg_carbonstate_inst%storvegc_patch(p) *t1 + c13_cnveg_carbonstate_inst%totc_patch(p) = c13_cnveg_carbonstate_inst%totc_patch(p) *t1 + c13_cnveg_carbonstate_inst%totvegc_patch(p) = c13_cnveg_carbonstate_inst%totvegc_patch(p) *t1 + + endif + + if ( use_c14 ) then + ! patch-level carbon-14 state variables + tot_leaf = & + c14_cnveg_carbonstate_inst%leafc_patch(p) + & + c14_cnveg_carbonstate_inst%leafc_storage_patch(p) + & + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + pleaf = c14_cnveg_carbonstate_inst%leafc_patch(p)/tot_leaf + pstor = c14_cnveg_carbonstate_inst%leafc_storage_patch(p)/tot_leaf + pxfer = c14_cnveg_carbonstate_inst%leafc_xfer_patch(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(patch%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + c14_cnveg_carbonstate_inst%leafc_patch(p) = c14_cnveg_carbonstate_inst%leafc_patch(p) *t1 & + + leafc14_seed*pleaf*t2 + c14_cnveg_carbonstate_inst%leafc_storage_patch(p) = c14_cnveg_carbonstate_inst%leafc_storage_patch(p) *t1 & + + leafc14_seed*pstor*t2 + c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) = c14_cnveg_carbonstate_inst%leafc_xfer_patch(p) *t1 & + + leafc14_seed*pxfer*t2 + c14_cnveg_carbonstate_inst%frootc_patch(p) = c14_cnveg_carbonstate_inst%frootc_patch(p) *t1 + c14_cnveg_carbonstate_inst%frootc_storage_patch(p) = c14_cnveg_carbonstate_inst%frootc_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%frootc_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%livestemc_patch(p) = c14_cnveg_carbonstate_inst%livestemc_patch(p) *t1 + c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) = c14_cnveg_carbonstate_inst%livestemc_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) = c14_cnveg_carbonstate_inst%livestemc_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%deadstemc_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_patch(p) *t1 & + + deadstemc14_seed*t2 + c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) = c14_cnveg_carbonstate_inst%deadstemc_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%livecrootc_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_patch(p) *t1 + c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%livecrootc_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%deadcrootc_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_patch(p) *t1 + c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) = c14_cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%gresp_storage_patch(p) = c14_cnveg_carbonstate_inst%gresp_storage_patch(p) *t1 + c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) = c14_cnveg_carbonstate_inst%gresp_xfer_patch(p) *t1 + c14_cnveg_carbonstate_inst%cpool_patch(p) = c14_cnveg_carbonstate_inst%cpool_patch(p) *t1 + c14_cnveg_carbonstate_inst%xsmrpool_patch(p) = c14_cnveg_carbonstate_inst%xsmrpool_patch(p) *t1 + c14_cnveg_carbonstate_inst%ctrunc_patch(p) = c14_cnveg_carbonstate_inst%ctrunc_patch(p) *t1 + c14_cnveg_carbonstate_inst%dispvegc_patch(p) = c14_cnveg_carbonstate_inst%dispvegc_patch(p) *t1 + c14_cnveg_carbonstate_inst%storvegc_patch(p) = c14_cnveg_carbonstate_inst%storvegc_patch(p) *t1 + c14_cnveg_carbonstate_inst%totc_patch(p) = c14_cnveg_carbonstate_inst%totc_patch(p) *t1 + c14_cnveg_carbonstate_inst%totvegc_patch(p) = c14_cnveg_carbonstate_inst%totvegc_patch(p) *t1 + endif + + tot_leaf = cnveg_nitrogenstate_inst%leafn_patch(p) + & + cnveg_nitrogenstate_inst%leafn_storage_patch(p) + & + cnveg_nitrogenstate_inst%leafn_xfer_patch(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + pleaf = cnveg_nitrogenstate_inst%leafn_patch(p)/tot_leaf + pstor = cnveg_nitrogenstate_inst%leafn_storage_patch(p)/tot_leaf + pxfer = cnveg_nitrogenstate_inst%leafn_xfer_patch(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(patch%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + ! patch-level nitrogen state variables + cnveg_nitrogenstate_inst%leafn_patch(p) = cnveg_nitrogenstate_inst%leafn_patch(p) *t1 & + + leafn_seed*pleaf*t2 + cnveg_nitrogenstate_inst%leafn_storage_patch(p) = cnveg_nitrogenstate_inst%leafn_storage_patch(p) *t1 & + + leafn_seed*pstor*t2 + cnveg_nitrogenstate_inst%leafn_xfer_patch(p) = cnveg_nitrogenstate_inst%leafn_xfer_patch(p) *t1 & + + leafn_seed*pxfer*t2 + cnveg_nitrogenstate_inst%frootn_patch(p) = cnveg_nitrogenstate_inst%frootn_patch(p) *t1 + cnveg_nitrogenstate_inst%frootn_storage_patch(p) = cnveg_nitrogenstate_inst%frootn_storage_patch(p) *t1 + cnveg_nitrogenstate_inst%frootn_xfer_patch(p) = cnveg_nitrogenstate_inst%frootn_xfer_patch(p) *t1 + cnveg_nitrogenstate_inst%livestemn_patch(p) = cnveg_nitrogenstate_inst%livestemn_patch(p) *t1 + cnveg_nitrogenstate_inst%livestemn_storage_patch(p) = cnveg_nitrogenstate_inst%livestemn_storage_patch(p) *t1 + cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) = cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) *t1 + cnveg_nitrogenstate_inst%deadstemn_patch(p) = cnveg_nitrogenstate_inst%deadstemn_patch(p) *t1 & + + deadstemn_seed*t2 + cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) = cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) *t1 + cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) = cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) *t1 + cnveg_nitrogenstate_inst%livecrootn_patch(p) = cnveg_nitrogenstate_inst%livecrootn_patch(p) *t1 + cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) = cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) *t1 + cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) = cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) *t1 + cnveg_nitrogenstate_inst%deadcrootn_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_patch(p) *t1 + cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) *t1 + cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) = cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) *t1 + cnveg_nitrogenstate_inst%retransn_patch(p) = cnveg_nitrogenstate_inst%retransn_patch(p) *t1 + cnveg_nitrogenstate_inst%npool_patch(p) = cnveg_nitrogenstate_inst%npool_patch(p) *t1 + cnveg_nitrogenstate_inst%ntrunc_patch(p) = cnveg_nitrogenstate_inst%ntrunc_patch(p) *t1 + cnveg_nitrogenstate_inst%dispvegn_patch(p) = cnveg_nitrogenstate_inst%dispvegn_patch(p) *t1 + cnveg_nitrogenstate_inst%storvegn_patch(p) = cnveg_nitrogenstate_inst%storvegn_patch(p) *t1 + cnveg_nitrogenstate_inst%totvegn_patch(p) = cnveg_nitrogenstate_inst%totvegn_patch(p) *t1 + cnveg_nitrogenstate_inst%totn_patch(p) = cnveg_nitrogenstate_inst%totn_patch(p) *t1 + + ! update temporary seed source arrays + ! These are calculated in terms of the required contributions from + ! column-level seed source + dwt_leafc_seed(p) = leafc_seed * dwt + if ( use_c13 ) then + dwt_leafc13_seed(p) = leafc13_seed * dwt + dwt_deadstemc13_seed(p) = deadstemc13_seed * dwt + endif + if ( use_c14 ) then + dwt_leafc14_seed(p) = leafc14_seed * dwt + dwt_deadstemc14_seed(p) = deadstemc14_seed * dwt + endif + dwt_leafn_seed(p) = leafn_seed * dwt + dwt_deadstemc_seed(p) = deadstemc_seed * dwt + dwt_deadstemn_seed(p) = deadstemn_seed * dwt + + else if (dwt < 0._r8) then + + ! if the pft lost weight on the timestep, then the carbon and nitrogen state + ! variables are directed to litter, CWD, and wood product pools. + + ! N.B. : the conv_cflux, prod10_cflux, and prod100_cflux fluxes are accumulated + ! as negative values, but the fluxes for pft-to-litter are accumulated as + ! positive values + + ! set local weight variables for this pft + wt_new = patch%wtcol(p) + wt_old = prior_weights%pwtcol(p) + + !--------------- + ! C state update + !--------------- + + ! leafc + ptr => cnveg_carbonstate_inst%leafc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! leafc_storage + ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! leafc_xfer + ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! frootc + ptr => cnveg_carbonstate_inst%frootc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) + init_state + end if + + ! frootc_storage + ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! frootc_xfer + ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc + ptr => cnveg_carbonstate_inst%livestemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc_storage + ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc_xfer + ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadstemc + ptr => cnveg_carbonstate_inst%deadstemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state * pftcon%pconv(patch%itype(p)) + prod10_cflux(p) = prod10_cflux(p) + change_state * pftcon%pprod10(patch%itype(p)) + prod100_cflux(p) = prod100_cflux(p) + change_state * pftcon%pprod100(patch%itype(p)) + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state * pftcon%pconv(patch%itype(p)) + prod10_cflux(p) = prod10_cflux(p) - init_state * pftcon%pprod10(patch%itype(p)) + prod100_cflux(p) = prod100_cflux(p) - init_state * pftcon%pprod100(patch%itype(p)) + end if + + ! deadstemc_storage + ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadstemc_xfer + ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livecrootc + ptr => cnveg_carbonstate_inst%livecrootc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) + init_state + end if + + ! livecrootc_storage + ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livecrootc_xfer + ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadcrootc + ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) + init_state + end if + + ! deadcrootc_storage + ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadcrootc_xfer + ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! gresp_storage + ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! gresp_xfer + ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! cpool + ptr => cnveg_carbonstate_inst%cpool_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! xsmrpool + ptr => cnveg_carbonstate_inst%xsmrpool_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! pft_ctrunc + ptr => cnveg_carbonstate_inst%ctrunc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + if ( use_c13 ) then + !------------------- + ! C13 state update + !------------------- + + ! set pointers to the conversion and product pool fluxes for this pft + ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes + dwt_ptr1 => conv_c13flux(p) + dwt_ptr2 => prod10_c13flux(p) + dwt_ptr3 => prod100_c13flux(p) + + ! leafc + ptr => cnveg_carbonstate_inst%leafc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_storage + ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_xfer + ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc + ptr => cnveg_carbonstate_inst%frootc_patch(p) + dwt_ptr0 => dwt_frootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! frootc_storage + ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc_xfer + ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc + ptr => cnveg_carbonstate_inst%livestemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_storage + ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_xfer + ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc + ptr => cnveg_carbonstate_inst%deadstemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 + change_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 + change_state * pftcon%pprod100(patch%itype(p)) + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 - init_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 - init_state * pftcon%pprod100(patch%itype(p)) + end if + + ! deadstemc_storage + ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc_xfer + ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc + ptr => cnveg_carbonstate_inst%livecrootc_patch(p) + dwt_ptr0 => dwt_livecrootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! livecrootc_storage + ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc_xfer + ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc + ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) + dwt_ptr0 => dwt_deadcrootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! deadcrootc_storage + ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc_xfer + ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_storage + ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_xfer + ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! cpool + ptr => cnveg_carbonstate_inst%cpool_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! pft_ctrunc + ptr => cnveg_carbonstate_inst%ctrunc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + endif + + if ( use_c14 ) then + !------------------- + ! C14 state update + !------------------- + + ! set pointers to the conversion and product pool fluxes for this patch + ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes + dwt_ptr1 => conv_c14flux(p) + dwt_ptr2 => prod10_c14flux(p) + dwt_ptr3 => prod100_c14flux(p) + + ! leafc + ptr => cnveg_carbonstate_inst%leafc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_storage + ptr => cnveg_carbonstate_inst%leafc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_xfer + ptr => cnveg_carbonstate_inst%leafc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc + ptr => cnveg_carbonstate_inst%frootc_patch(p) + dwt_ptr0 => dwt_frootc14_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! frootc_storage + ptr => cnveg_carbonstate_inst%frootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc_xfer + ptr => cnveg_carbonstate_inst%frootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc + ptr => cnveg_carbonstate_inst%livestemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_storage + ptr => cnveg_carbonstate_inst%livestemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_xfer + ptr => cnveg_carbonstate_inst%livestemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc + ptr => cnveg_carbonstate_inst%deadstemc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 + change_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 + change_state * pftcon%pprod100(patch%itype(p)) + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 - init_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 - init_state * pftcon%pprod100(patch%itype(p)) + end if + + ! deadstemc_storage + ptr => cnveg_carbonstate_inst%deadstemc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc_xfer + ptr => cnveg_carbonstate_inst%deadstemc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc + ptr => cnveg_carbonstate_inst%livecrootc_patch(p) + dwt_ptr0 => dwt_livecrootc14_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! livecrootc_storage + ptr => cnveg_carbonstate_inst%livecrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc_xfer + ptr => cnveg_carbonstate_inst%livecrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc + ptr => cnveg_carbonstate_inst%deadcrootc_patch(p) + dwt_ptr0 => dwt_deadcrootc14_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! deadcrootc_storage + ptr => cnveg_carbonstate_inst%deadcrootc_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc_xfer + ptr => cnveg_carbonstate_inst%deadcrootc_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_storage + ptr => cnveg_carbonstate_inst%gresp_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_xfer + ptr => cnveg_carbonstate_inst%gresp_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! cpool + ptr => cnveg_carbonstate_inst%cpool_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! pft_ctrunc + ptr => cnveg_carbonstate_inst%ctrunc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + endif + + + !--------------- + ! N state update + !--------------- + + ! set pointers to the conversion and product pool fluxes for this patch + ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes + dwt_ptr1 => conv_nflux(p) + dwt_ptr2 => prod10_nflux(p) + dwt_ptr3 => prod100_nflux(p) + + ! leafn + ptr => cnveg_nitrogenstate_inst%leafn_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafn_storage + ptr => cnveg_nitrogenstate_inst%leafn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafn_xfer + ptr => cnveg_nitrogenstate_inst%leafn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootn + ptr => cnveg_nitrogenstate_inst%frootn_patch(p) + dwt_ptr0 => dwt_frootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! frootn_storage + ptr => cnveg_nitrogenstate_inst%frootn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootn_xfer + ptr => cnveg_nitrogenstate_inst%frootn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn + ptr => cnveg_nitrogenstate_inst%livestemn_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn_storage + ptr => cnveg_nitrogenstate_inst%livestemn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn_xfer + ptr => cnveg_nitrogenstate_inst%livestemn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemn + ptr => cnveg_nitrogenstate_inst%deadstemn_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 + change_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 + change_state * pftcon%pprod100(patch%itype(p)) + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state * pftcon%pconv(patch%itype(p)) + dwt_ptr2 = dwt_ptr2 - init_state * pftcon%pprod10(patch%itype(p)) + dwt_ptr3 = dwt_ptr3 - init_state * pftcon%pprod100(patch%itype(p)) + end if + + ! deadstemn_storage + ptr => cnveg_nitrogenstate_inst%deadstemn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemn_xfer + ptr => cnveg_nitrogenstate_inst%deadstemn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootn + ptr => cnveg_nitrogenstate_inst%livecrootn_patch(p) + dwt_ptr0 => dwt_livecrootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! livecrootn_storage + ptr => cnveg_nitrogenstate_inst%livecrootn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootn_xfer + ptr => cnveg_nitrogenstate_inst%livecrootn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootn + ptr => cnveg_nitrogenstate_inst%deadcrootn_patch(p) + dwt_ptr0 => dwt_deadcrootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! deadcrootn_storage + ptr => cnveg_nitrogenstate_inst%deadcrootn_storage_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootn_xfer + ptr => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! retransn + ptr => cnveg_nitrogenstate_inst%retransn_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! npool + ptr => cnveg_nitrogenstate_inst%npool_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! pft_ntrunc + ptr => cnveg_nitrogenstate_inst%ntrunc_patch(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + end if ! weight decreasing + end if ! is soil + end do ! patch loop + + ! calculate column-level seeding fluxes + do pi = 1,max_patch_per_col + do c = bounds%begc, bounds%endc + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + + ! C fluxes + cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) = & + cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) + dwt_leafc_seed(p)/dt + cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) = & + cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) + dwt_deadstemc_seed(p)/dt + + if ( use_c13 ) then + c13_cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) = & + c13_cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) + dwt_leafc13_seed(p)/dt + c13_cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) = & + c13_cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) + dwt_deadstemc13_seed(p)/dt + endif + + if ( use_c14 ) then + c14_cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) = & + c14_cnveg_carbonflux_inst%dwt_seedc_to_leaf_col(c) + dwt_leafc14_seed(p)/dt + c14_cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) = & + c14_cnveg_carbonflux_inst%dwt_seedc_to_deadstem_col(c) + dwt_deadstemc14_seed(p)/dt + endif + + ! N fluxes + cnveg_nitrogenflux_inst%dwt_seedn_to_leaf_col(c) = & + cnveg_nitrogenflux_inst%dwt_seedn_to_leaf_col(c) + dwt_leafn_seed(p)/dt + cnveg_nitrogenflux_inst%dwt_seedn_to_deadstem_col(c) = & + cnveg_nitrogenflux_inst%dwt_seedn_to_deadstem_col(c) + dwt_deadstemn_seed(p)/dt + end if + end do + end do + + + ! calculate patch-to-column for fluxes into litter and CWD pools + do j = 1, nlevdecomp + do pi = 1,max_patch_per_col + do c = bounds%begc, bounds%endc + if ( pi <= col%npatches(c) ) then + p = col%patchi(c) + pi - 1 + + ! fine root litter carbon fluxes + cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) = & + cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) + & + (dwt_frootc_to_litter(p)*pftcon%fr_flab(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) = & + cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) + & + (dwt_frootc_to_litter(p)*pftcon%fr_fcel(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) = & + cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) + & + (dwt_frootc_to_litter(p)*pftcon%fr_flig(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + + ! fine root litter nitrogen fluxes + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_met_n_col(c,j) = & + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_met_n_col(c,j) + & + (dwt_frootn_to_litter(p)*pftcon%fr_flab(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_cel_n_col(c,j) = & + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_cel_n_col(c,j) + & + (dwt_frootn_to_litter(p)*pftcon%fr_fcel(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_lig_n_col(c,j) = & + cnveg_nitrogenflux_inst%dwt_frootn_to_litr_lig_n_col(c,j) + & + (dwt_frootn_to_litter(p)*pftcon%fr_flig(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + ! livecroot fluxes to cwd + cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) = & + cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) + & + (dwt_livecrootc_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + cnveg_nitrogenflux_inst%dwt_livecrootn_to_cwdn_col(c,j) = & + cnveg_nitrogenflux_inst%dwt_livecrootn_to_cwdn_col(c,j) + & + (dwt_livecrootn_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + ! deadcroot fluxes to cwd + cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) = & + cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) + & + (dwt_deadcrootc_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + cnveg_nitrogenflux_inst%dwt_deadcrootn_to_cwdn_col(c,j) = & + cnveg_nitrogenflux_inst%dwt_deadcrootn_to_cwdn_col(c,j) + & + (dwt_deadcrootn_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + if ( use_c13 ) then + ! C13 fine root litter fluxes + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) = & + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_flab(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) = & + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_fcel(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) = & + c13_cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_flig(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + ! livecroot fluxes to cwd + c13_cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) = & + c13_cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) + & + (dwt_livecrootc13_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + ! deadcroot fluxes to cwd + c13_cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) = & + c13_cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) + & + (dwt_deadcrootc13_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + endif + + if ( use_c14 ) then + ! C14 fine root litter fluxes + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) = & + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_met_c_col(c,j) + & + (dwt_frootc14_to_litter(p)*pftcon%fr_flab(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) = & + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_cel_c_col(c,j) + & + (dwt_frootc14_to_litter(p)*pftcon%fr_fcel(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) = & + c14_cnveg_carbonflux_inst%dwt_frootc_to_litr_lig_c_col(c,j) + & + (dwt_frootc14_to_litter(p)*pftcon%fr_flig(patch%itype(p)))/dt & + * soilbiogeochem_state_inst%froot_prof_patch(p,j) + + ! livecroot fluxes to cwd + c14_cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) = & + c14_cnveg_carbonflux_inst%dwt_livecrootc_to_cwdc_col(c,j) + & + (dwt_livecrootc14_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + + ! deadcroot fluxes to cwd + c14_cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) = & + c14_cnveg_carbonflux_inst%dwt_deadcrootc_to_cwdc_col(c,j) + & + (dwt_deadcrootc14_to_litter(p))/dt * soilbiogeochem_state_inst%croot_prof_patch(p,j) + endif + + end if + end do + end do + end do + + ! calculate patch-to-column for fluxes into product pools and conversion flux + do pi = 1,max_patch_per_col + do c = bounds%begc,bounds%endc + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + ! column-level fluxes are accumulated as positive fluxes. + ! column-level C flux updates + cnveg_carbonflux_inst%dwt_conv_cflux_col(c) = & + cnveg_carbonflux_inst%dwt_conv_cflux_col(c) - conv_cflux(p)/dt + cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) = & + cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) - prod10_cflux(p)/dt + cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) = & + cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) - prod100_cflux(p)/dt + + ! These magic constants should be replaced with: nbrdlf_evr_trp_tree and nbrdlf_dcd_trp_tree + if(patch%itype(p)==4.or.patch%itype(p)==6)then + soilbiogeochem_carbonflux_inst%lf_conv_cflux_col(c) = & + soilbiogeochem_carbonflux_inst%lf_conv_cflux_col(c) - conv_cflux(p)/dt + end if + + if ( use_c13 ) then + ! C13 column-level flux updates + c13_cnveg_carbonflux_inst%dwt_conv_cflux_col(c) = & + c13_cnveg_carbonflux_inst%dwt_conv_cflux_col(c) - conv_c13flux(p)/dt + c13_cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) = & + c13_cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) - prod10_c13flux(p)/dt + c13_cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) = & + c13_cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) - prod100_c13flux(p)/dt + endif + + if ( use_c14 ) then + ! C14 column-level flux updates + c14_cnveg_carbonflux_inst%dwt_conv_cflux_col(c) = & + c14_cnveg_carbonflux_inst%dwt_conv_cflux_col(c) - conv_c14flux(p)/dt + c14_cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) = & + c14_cnveg_carbonflux_inst%dwt_prod10c_gain_col(c) - prod10_c14flux(p)/dt + c14_cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) = & + c14_cnveg_carbonflux_inst%dwt_prod100c_gain_col(c) - prod100_c14flux(p)/dt + endif + + ! column-level N flux updates + cnveg_nitrogenflux_inst%dwt_conv_nflux_col(c) = & + cnveg_nitrogenflux_inst%dwt_conv_nflux_col(c) - conv_nflux(p)/dt + cnveg_nitrogenflux_inst%dwt_prod10n_gain_col(c) = & + cnveg_nitrogenflux_inst%dwt_prod10n_gain_col(c) - prod10_nflux(p)/dt + cnveg_nitrogenflux_inst%dwt_prod100n_gain_col(c) = & + cnveg_nitrogenflux_inst%dwt_prod100n_gain_col(c) - prod100_nflux(p)/dt + + end if + end do + end do + + ! Deallocate patch-level flux arrays + deallocate(dwt_leafc_seed) + deallocate(dwt_leafn_seed) + deallocate(dwt_deadstemc_seed) + deallocate(dwt_deadstemn_seed) + deallocate(dwt_frootc_to_litter) + deallocate(dwt_livecrootc_to_litter) + deallocate(dwt_deadcrootc_to_litter) + deallocate(dwt_frootn_to_litter) + deallocate(dwt_livecrootn_to_litter) + deallocate(dwt_deadcrootn_to_litter) + deallocate(conv_cflux) + deallocate(prod10_cflux) + deallocate(prod100_cflux) + deallocate(conv_nflux) + deallocate(prod10_nflux) + deallocate(prod100_nflux) + + if ( use_c13 ) then + deallocate(dwt_leafc13_seed) + deallocate(dwt_deadstemc13_seed) + deallocate(dwt_frootc13_to_litter) + deallocate(dwt_livecrootc13_to_litter) + deallocate(dwt_deadcrootc13_to_litter) + deallocate(conv_c13flux) + deallocate(prod10_c13flux) + deallocate(prod100_c13flux) + endif + + if ( use_c14 ) then + deallocate(dwt_leafc14_seed) + deallocate(dwt_deadstemc14_seed) + deallocate(dwt_frootc14_to_litter) + deallocate(dwt_livecrootc14_to_litter) + deallocate(dwt_deadcrootc14_to_litter) + deallocate(conv_c14flux) + deallocate(prod10_c14flux) + deallocate(prod100_c14flux) + endif + + end subroutine dyn_cnbal_patch + +end module dynConsBiogeochemMod diff --git a/components/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 b/components/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 new file mode 100644 index 0000000000..8a3e7507a2 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynConsBiogeophysMod.F90 @@ -0,0 +1,366 @@ +module dynConsBiogeophysMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Handle conservation of biogeophysical quantities (water & energy) with dynamic land + ! cover. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use UrbanParamsType , only : urbanparams_type + use EnergyFluxType , only : energyflux_type + use LakeStateType , only : lakestate_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dyn_hwcontent_init ! compute grid-level heat and water content, before land cover change + public :: dyn_hwcontent_final ! compute grid-level heat and water content, after land cover change; also compute dynbal fluxes + ! + ! !PRIVATE MEMBER FUNCTIONS + private :: dyn_hwcontent ! do the actual computation of grid-level heat and water content + !--------------------------------------------------------------------------- + +contains + + !--------------------------------------------------------------------------- + subroutine dyn_hwcontent_init(bounds, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst) + ! + ! !DESCRIPTION: + ! Initialize variables used for dyn_hwcontent, and compute grid cell-level heat + ! and water content before land cover change + ! + ! Should be called BEFORE any subgrid weight updates this time step + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + !------------------------------------------------------------------------------- + + ! initialize heat and water content and dynamic balance fields to zero + do g = bounds%begg, bounds%endg + waterstate_inst%liq2_grc(g) = 0._r8 + waterstate_inst%liq1_grc(g) = 0._r8 + waterstate_inst%ice2_grc(g) = 0._r8 + waterstate_inst%ice1_grc(g) = 0._r8 + + waterflux_inst%qflx_liq_dynbal_grc(g) = 0._r8 + waterflux_inst%qflx_ice_dynbal_grc(g) = 0._r8 + + temperature_inst%heat2_grc(g) = 0._r8 + temperature_inst%heat1_grc(g) = 0._r8 + + energyflux_inst%eflx_dynbal_grc(g) = 0._r8 + enddo + + call dyn_hwcontent( bounds, & + waterstate_inst%liq1_grc(bounds%begg:bounds%endg), & + waterstate_inst%ice1_grc(bounds%begg:bounds%endg), & + temperature_inst%heat1_grc(bounds%begg:bounds%endg) , & + urbanparams_inst, soilstate_inst, soilhydrology_inst, & + temperature_inst, waterstate_inst, lakestate_inst) + + end subroutine dyn_hwcontent_init + + !--------------------------------------------------------------------------- + subroutine dyn_hwcontent_final(bounds, first_step_cold_start, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst) + ! + ! !DESCRIPTION: + ! Compute grid cell-level heat and water content after land cover change, and compute + ! the dynbal fluxes + ! + ! Should be called AFTER all subgrid weight updates this time step + ! + ! !USES: + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + logical , intent(in) :: first_step_cold_start ! true if this is the first step since cold start + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + real(r8) :: dtime ! land model time step (sec) + !--------------------------------------------------------------------------- + + call dyn_hwcontent( bounds, & + waterstate_inst%liq2_grc(bounds%begg:bounds%endg), & + waterstate_inst%ice2_grc(bounds%begg:bounds%endg), & + temperature_inst%heat2_grc(bounds%begg:bounds%endg) , & + urbanparams_inst, soilstate_inst, soilhydrology_inst, & + temperature_inst, waterstate_inst, lakestate_inst) + + ! Do not do any adjustments on the first time step after cold start. This is because + ! we expect big transients in this first time step, since transient subgrid weights + ! aren't updated in initialization. + if (first_step_cold_start) then + do g = bounds%begg, bounds%endg + waterflux_inst%qflx_liq_dynbal_grc (g) = 0._r8 + waterflux_inst%qflx_ice_dynbal_grc (g) = 0._r8 + energyflux_inst%eflx_dynbal_grc (g) = 0._r8 + end do + + else + dtime = get_step_size() + do g = bounds%begg, bounds%endg + waterflux_inst%qflx_liq_dynbal_grc (g) = & + (waterstate_inst%liq2_grc (g) - waterstate_inst%liq1_grc (g))/dtime + waterflux_inst%qflx_ice_dynbal_grc (g) = & + (waterstate_inst%ice2_grc (g) - waterstate_inst%ice1_grc (g))/dtime + energyflux_inst%eflx_dynbal_grc (g) = & + (temperature_inst%heat2_grc(g) - temperature_inst%heat1_grc(g))/dtime + end do + end if + + end subroutine dyn_hwcontent_final + + !--------------------------------------------------------------------------- + subroutine dyn_hwcontent(bounds, gcell_liq, gcell_ice, gcell_heat, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, & + temperature_inst, waterstate_inst, lakestate_inst) + + ! !DESCRIPTION: + ! Compute grid-level heat and water content to track conservation with respect to + ! dynamic land cover. + + ! !USES: + use landunit_varcon , only : istsoil, istice, istwet, istdlak, istice_mec, istcrop + use column_varcon , only : icol_road_perv, icol_road_imperv, icol_roof, icol_sunwall, icol_shadewall + use clm_varcon , only : cpice, cpliq, denh2o + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, nlevlak + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(out) :: gcell_liq ( bounds%begg: ) ! [gridcell] + real(r8) , intent(out) :: gcell_ice ( bounds%begg: ) ! [gridcell] + real(r8) , intent(out) :: gcell_heat( bounds%begg: ) ! [gridcell] + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(lakestate_type) , intent(in) :: lakestate_inst + ! + ! !LOCAL VARIABLES: + integer :: li,lf ! loop initial/final indicies + integer :: ci,cf ! loop initial/final indicies + integer :: pi,pf ! loop initial/final indicies + + integer :: g,l,c,p,k ! loop indicies (grid,lunit,column,pft,vertical level) + + real(r8) :: wtgcell ! weight relative to grid cell + real(r8) :: wtcol ! weight relative to column + real(r8) :: liq ! sum of liquid water at column level + real(r8) :: ice ! sum of frozen water at column level + real(r8) :: heat ! sum of heat content at column level + real(r8) :: cv ! heat capacity [J/(m^2 K)] + + integer ,pointer :: nlev_improad(:) ! number of impervious road layers + real(r8),pointer :: cv_wall(:,:) ! thermal conductivity of urban wall + real(r8),pointer :: cv_roof(:,:) ! thermal conductivity of urban roof + real(r8),pointer :: cv_improad(:,:) ! thermal conductivity of urban impervious road + integer ,pointer :: snl(:) ! number of snow layers + real(r8),pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8),pointer :: h2osno(:) ! snow water (mm H2O) + real(r8),pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8),pointer :: h2osoi_ice(:,:) ! frozen water (kg/m2) + real(r8),pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8),pointer :: csol(:,:) ! heat capacity, soil solids (J/m**3/Kelvin) + real(r8),pointer :: wa_col(:) ! water in the unconfined aquifer (mm) + real(r8),pointer :: dz(:,:) ! layer depth (m) + !------------------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(gcell_liq) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(gcell_ice) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(gcell_heat) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + + snl => col%snl + dz => col%dz + nlev_improad => urbanparams_inst%nlev_improad + cv_wall => urbanparams_inst%cv_wall + cv_roof => urbanparams_inst%cv_roof + cv_improad => urbanparams_inst%cv_improad + watsat => soilstate_inst%watsat_col + csol => soilstate_inst%csol_col + wa_col => soilhydrology_inst%wa_col + t_soisno => temperature_inst%t_soisno_col + h2osoi_liq => waterstate_inst%h2osoi_liq_col + h2osoi_ice => waterstate_inst%h2osoi_ice_col + h2osno => waterstate_inst%h2osno_col + + ! Get relevant sizes + + do g = bounds%begg,bounds%endg ! loop over grid cells + gcell_liq (g) = 0.0_r8 ! sum for one grid cell + gcell_ice (g) = 0.0_r8 ! sum for one grid cell + gcell_heat (g) = 0.0_r8 ! sum for one grid cell + end do + + do l = bounds%begl,bounds%endl + g = lun%gridcell(l) + ci = lun%coli(l) + cf = lun%colf(l) + do c = ci,cf ! loop over columns + + liq = 0.0_r8 ! sum for one column + ice = 0.0_r8 + heat = 0.0_r8 + + !--- water & ice, above ground only --- + if ( (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop ) & + .or. (lun%itype(l) == istwet ) & + .or. (lun%itype(l) == istice ) & + .or. (lun%itype(l) == istice_mec ) & + .or. (lun%urbpoi(l) .and. col%itype(c) == icol_roof ) & + .or. (lun%urbpoi(l) .and. col%itype(c) == icol_road_imperv) & + .or. (lun%itype(l) == istdlak ) & + .or. (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv )) then + + if ( snl(c) < 0 ) then + do k = snl(c)+1,0 ! loop over snow layers + liq = liq + h2osoi_liq(c,k) + ice = ice + h2osoi_ice(c,k) + end do + else ! no snow layers exist + ice = ice + waterstate_inst%h2osno_col(c) + end if + end if + + !--- water & ice, below ground only --- + if ( (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop ) & + .or. (lun%itype(l) == istwet ) & + .or. (lun%itype(l) == istice ) & + .or. (lun%itype(l) == istdlak ) & + .or. (lun%itype(l) == istice_mec ) & + .or. (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv )) then + do k = 1,nlevgrnd + liq = liq + h2osoi_liq(c,k) + ice = ice + h2osoi_ice(c,k) + end do + end if + + !--- water & ice, below ground, for lakes --- + if ( lun%itype(l) == istdlak ) then + do k = 1,nlevlak + liq = liq + (1 - lakestate_inst%lake_icefrac_col(c,k)) * col%dz_lake(c,k) * denh2o + ice = ice + lakestate_inst%lake_icefrac_col(c,k) * col%dz_lake(c,k) * denh2o + ! lake layers do not change thickness when freezing, so denh2o should be used + ! (thermal properties are appropriately adjusted; see LakeTemperatureMod) + end do + end if + + !--- water in aquifer --- + if ( (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop ) & + .or. (lun%itype(l) == istwet ) & + .or. (lun%itype(l) == istice ) & + .or. (lun%itype(l) == istice_mec ) & + .or. (lun%urbpoi(l) .and. col%itype(c) == icol_road_perv )) then + liq = liq + soilhydrology_inst%wa_col(c) + end if + + !--- water in canopy (at pft level) --- + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then ! note: soil specified at LU level + do p = col%patchi(c),col%patchf(c) ! loop over patches + if (patch%active(p)) then + liq = liq + waterstate_inst%h2ocan_patch(p) * patch%wtcol(p) + end if + end do + end if + + !--- heat content, below ground only --- + if (nlevurb > 0) then + do k = 1,nlevurb + if (col%itype(c)==icol_sunwall .OR. col%itype(c)==icol_shadewall) then + cv = cv_wall(l,k) * dz(c,k) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + else if (col%itype(c) == icol_roof) then + cv = cv_roof(l,k) * dz(c,k) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end if + end do + end if + do k = 1,nlevgrnd + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall & + .and. col%itype(c) /= icol_roof) then + if (col%itype(c) == icol_road_imperv .and. k >= 1 .and. k <= nlev_improad(l)) then + cv = cv_improad(l,k) * dz(c,k) + else if (lun%itype(l) /= istwet .AND. lun%itype(l) /= istice .AND. lun%itype(l) /= istice_mec) then + cv = csol(c,k)*(1-watsat(c,k))*dz(c,k) + (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq) + else + cv = (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq) + endif + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end if + end do + + !--- heat content, below ground in lake water, for lakes --- + do k = 1,nlevlak + if (lun%itype(l) == istdlak) then + cv = denh2o*col%dz_lake(c,k)*( lakestate_inst%lake_icefrac_col(c,k)*cpice + & + (1 - lakestate_inst%lake_icefrac_col(c,k))*cpliq ) + heat = heat + cv*temperature_inst%t_lake_col(c,k) / 1.e6_r8 + end if + end do + + !--- heat content, above ground only --- + if ( snl(c) < 0 ) then + do k = snl(c)+1,0 ! loop over snow layers + cv = cpliq*h2osoi_liq(c,k) + cpice*h2osoi_ice(c,k) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end do + else if ( h2osno(c) > 0.0_r8 .and. lun%itype(l) /= istdlak) then + ! the heat capacity (not latent heat) of snow without snow layers + ! is currently ignored in LakeTemperature, so it should be ignored here + k = 1 + cv = cpice*h2osno(c) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end if + + !--- scale x/m^2 column-level values into x/m^2 gridcell-level values --- + gcell_liq (g) = gcell_liq (g) + liq * col%wtgcell(c) + gcell_ice (g) = gcell_ice (g) + ice * col%wtgcell(c) + gcell_heat (g) = gcell_heat (g) + heat * col%wtgcell(c) + + end do ! column loop + end do ! landunit loop + + end subroutine dyn_hwcontent + +end module dynConsBiogeophysMod diff --git a/components/clm/src/dyn_subgrid/dynEDMod.F90 b/components/clm/src/dyn_subgrid/dynEDMod.F90 new file mode 100644 index 0000000000..1c9ae9a874 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynEDMod.F90 @@ -0,0 +1,43 @@ +module dynEDMod + + !----------------------------------------------------------------------- + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use landunit_varcon, only : istsoil + use PatchType , only : patch + use ColumnType , only : col + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dyn_ED ! transfers weights calculated internally by ED into wtcol. + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine dyn_ED( bounds ) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + + ! !LOCAL VARIABLES: + integer :: p,c ! indices + !------------------------------------------------------------------------ + + do p = bounds%begp,bounds%endp + c = patch%column(p) + if (col%itype(c) == istsoil) then + if (patch%is_veg(p) .or. patch%is_bareground(p)) then + patch%wtcol(p) = patch%wt_ed(p) + else + patch%wtcol(p) = 0.0_r8 + end if + end if + end do + + end subroutine dyn_ED + +end module dynEDMod diff --git a/components/clm/src/dyn_subgrid/dynFileMod.F90 b/components/clm/src/dyn_subgrid/dynFileMod.F90 new file mode 100644 index 0000000000..16e7d1ad5b --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynFileMod.F90 @@ -0,0 +1,88 @@ +module dynFileMod + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains a derived type that is essentially a file_desc_t, but also adds a + ! time_info_type object. This is used for tracking time information for a single + ! dynamic landuse file. + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use dynTimeInfoMod , only : time_info_type, year_position_type + use ncdio_pio , only : file_desc_t, ncd_pio_openfile, ncd_inqdid, ncd_inqdlen, ncd_io + use abortutils , only : endrun + implicit none + private + ! + ! !PUBLIC TYPES: + public :: dyn_file_type + + type, extends(file_desc_t) :: dyn_file_type + type(time_info_type) :: time_info ! time information for this file + end type dyn_file_type + + interface dyn_file_type + module procedure constructor ! initialize a new dyn_file_type object + end interface dyn_file_type + !----------------------------------------------------------------------- + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + !----------------------------------------------------------------------- + type(dyn_file_type) function constructor(filename, year_position) + ! + ! !DESCRIPTION: + ! Initialize a dyn_file_type object + ! + ! Opens the file associated with filename for reading, reads the 'YEAR' variable from + ! this file (assumed to have dimension 'time'), and initializes a dyn_time_info object + ! based on this YEAR variable and the current model year. + ! + ! year_position is a flag saying how to obtain the model year relative to the current + ! timestep; it must be one of the parameters defined in dynTimeInfoMod (e.g., + ! YEAR_POSITION_START_OF_TIMESTEP or YEAR_POSITION_END_OF_TIMESTEP) + ! + ! !USES: + use fileutils , only : getfil + ! + ! !ARGUMENTS: + character(len=*) , intent(in) :: filename + type(year_position_type) , intent(in) :: year_position + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + integer :: ier ! error code + integer :: ntimes ! number of time samples + integer :: varid ! netcdf variable ID + integer, allocatable :: years(:) ! years in the file + + character(len=*), parameter :: subname = 'dyn_file_type constructor' + !----------------------------------------------------------------------- + + ! Obtain file + + call getfil(filename, locfn, 0) + call ncd_pio_openfile(constructor, locfn, 0) + + ! Obtain years + + call ncd_inqdid(constructor, 'time', varid) + call ncd_inqdlen(constructor, varid, ntimes) + allocate(years(ntimes), stat=ier) + if (ier /= 0) then + call endrun(msg=' allocation error for years'//errMsg(__FILE__, __LINE__)) + end if + call ncd_io(ncid=constructor, varname='YEAR', flag='read', data=years) + + ! Initialize object containing time information for the file + + constructor%time_info = time_info_type(years, year_position) + + deallocate(years) + + end function constructor + +end module dynFileMod diff --git a/components/clm/src/dyn_subgrid/dynHarvestMod.F90 b/components/clm/src/dyn_subgrid/dynHarvestMod.F90 new file mode 100644 index 0000000000..4376a1c214 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynHarvestMod.F90 @@ -0,0 +1,626 @@ +module dynHarvestMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle reading of the harvest data, as well as the state updates that happen as a + ! result of harvest. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use abortutils , only : endrun + use dynFileMod , only : dyn_file_type + use dynVarTimeUninterpMod , only : dyn_var_time_uninterp_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use pftconMod , only : pftcon + use clm_varcon , only : grlnd + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dynHarvest_init ! initialize data structures for harvest information + public :: dynHarvest_interp ! get harvest data for current time step, if needed + public :: CNHarvest ! harvest mortality routine for CN code + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: CNHarvestPftToColumn ! gather patch-level harvest fluxes to the column level + ! + ! !PRIVATE TYPES: + + ! Note that, since we have our own dynHarvest_file object (distinct from dynpft_file), + ! we could theoretically have a separate file providing harvest data from that providing + ! the pftdyn data + type(dyn_file_type), target :: dynHarvest_file ! information for the file containing harvest data + + ! Define the underlying harvest variables + integer, parameter :: num_harvest_inst = 5 + character(len=64), parameter :: harvest_varnames(num_harvest_inst) = & + [character(len=64) :: 'HARVEST_VH1', 'HARVEST_VH2', 'HARVEST_SH1', 'HARVEST_SH2', 'HARVEST_SH3'] + + type(dyn_var_time_uninterp_type) :: harvest_inst(num_harvest_inst) ! value of each harvest variable + + real(r8) , allocatable :: harvest(:) ! harvest rates + logical :: do_harvest ! whether we're in a period when we should do harvest + !--------------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine dynHarvest_init(bounds, harvest_filename) + ! + ! !DESCRIPTION: + ! Initialize data structures for harvest information. + ! This should be called once, during model initialization. + ! + ! !USES: + use dynVarTimeUninterpMod , only : dyn_var_time_uninterp_type + use dynTimeInfoMod , only : YEAR_POSITION_END_OF_TIMESTEP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! proc-level bounds + character(len=*) , intent(in) :: harvest_filename ! name of file containing harvest information + ! + ! !LOCAL VARIABLES: + integer :: varnum ! counter for harvest variables + integer :: num_points ! number of spatial points + integer :: ier ! error code + + character(len=*), parameter :: subname = 'dynHarvest_init' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + allocate(harvest(bounds%begg:bounds%endg),stat=ier) + if (ier /= 0) then + call endrun(msg=' allocation error for harvest'//errMsg(__FILE__, __LINE__)) + end if + + ! Get the year from the END of the timestep for compatibility with how things were + ! done before, even though that doesn't necessarily make the most sense conceptually. + dynHarvest_file = dyn_file_type(harvest_filename, YEAR_POSITION_END_OF_TIMESTEP) + + ! Get initial harvest data + num_points = (bounds%endg - bounds%begg + 1) + do varnum = 1, num_harvest_inst + harvest_inst(varnum) = dyn_var_time_uninterp_type( & + dyn_file=dynHarvest_file, varname=harvest_varnames(varnum), & + dim1name=grlnd, conversion_factor=1.0_r8, & + do_check_sums_equal_1=.false., data_shape=[num_points]) + end do + + end subroutine dynHarvest_init + + + !----------------------------------------------------------------------- + subroutine dynHarvest_interp(bounds) + ! + ! !DESCRIPTION: + ! Get harvest data for model time, when needed. + ! + ! Note that harvest data are stored as rates (not weights) and so time interpolation + ! is not necessary - the harvest rate is held constant through the year. This is + ! consistent with the treatment of changing PFT weights, where interpolation of the + ! annual endpoint weights leads to a constant rate of change in PFT weight through the + ! year, with abrupt changes in the rate at annual boundaries. + ! + ! !USES: + use dynTimeInfoMod , only : time_info_type + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! proc-level bounds + ! + ! !LOCAL VARIABLES: + integer :: varnum ! counter for harvest variables + real(r8), allocatable :: this_data(:) ! data for a single harvest variable + + character(len=*), parameter :: subname = 'dynHarvest_interp' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + call dynHarvest_file%time_info%set_current_year() + + ! Get total harvest for this time step + harvest(bounds%begg:bounds%endg) = 0._r8 + + if (dynHarvest_file%time_info%is_before_time_series()) then + ! Turn off harvest before the start of the harvest time series + do_harvest = .false. + else + ! Note that do_harvest stays true even past the end of the time series. This + ! means that harvest rates will be maintained at the rate given in the last + ! year of the file for all years past the end of this specified time series. + do_harvest = .true. + allocate(this_data(bounds%begg:bounds%endg)) + do varnum = 1, num_harvest_inst + call harvest_inst(varnum)%get_current_data(this_data) + harvest(bounds%begg:bounds%endg) = harvest(bounds%begg:bounds%endg) + & + this_data(bounds%begg:bounds%endg) + end do + deallocate(this_data) + end if + + end subroutine dynHarvest_interp + + + !----------------------------------------------------------------------- + subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilbiogeochem_state_inst, cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, & + cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Harvest mortality routine for coupled carbon-nitrogen code (CN) + ! + ! !USES: + use pftconMod , only : noveg, nbrdlf_evr_shrub + use clm_varcon , only : secspday + use clm_time_manager, only : get_days_per_year + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: g ! gridcell index + integer :: fp ! patch filter index + real(r8):: am ! rate for fractional harvest mortality (1/yr) + real(r8):: m ! rate for fractional harvest mortality (1/s) + real(r8):: days_per_year ! days per year + !----------------------------------------------------------------------- + + associate(& + ivt => patch%itype , & ! Input: [integer (:)] pft vegetation type + + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C + frootc => cnveg_carbonstate_inst%frootc_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C + livestemc => cnveg_carbonstate_inst%livestemc_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C + deadstemc => cnveg_carbonstate_inst%deadstemc_patch , & ! Input: [real(r8) (:)] (gC/m2) dead stem C + livecrootc => cnveg_carbonstate_inst%livecrootc_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C + deadcrootc => cnveg_carbonstate_inst%deadcrootc_patch , & ! Input: [real(r8) (:)] (gC/m2) dead coarse root C + xsmrpool => cnveg_carbonstate_inst%xsmrpool_patch , & ! Input: [real(r8) (:)] (gC/m2) abstract C pool to meet excess MR demand + leafc_storage => cnveg_carbonstate_inst%leafc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C storage + frootc_storage => cnveg_carbonstate_inst%frootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C storage + livestemc_storage => cnveg_carbonstate_inst%livestemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C storage + deadstemc_storage => cnveg_carbonstate_inst%deadstemc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead stem C storage + livecrootc_storage => cnveg_carbonstate_inst%livecrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C storage + deadcrootc_storage => cnveg_carbonstate_inst%deadcrootc_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) dead coarse root C storage + gresp_storage => cnveg_carbonstate_inst%gresp_storage_patch , & ! Input: [real(r8) (:)] (gC/m2) growth respiration storage + leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C transfer + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) fine root C transfer + livestemc_xfer => cnveg_carbonstate_inst%livestemc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) live stem C transfer + deadstemc_xfer => cnveg_carbonstate_inst%deadstemc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) dead stem C transfer + livecrootc_xfer => cnveg_carbonstate_inst%livecrootc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) live coarse root C transfer + deadcrootc_xfer => cnveg_carbonstate_inst%deadcrootc_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) dead coarse root C transfer + gresp_xfer => cnveg_carbonstate_inst%gresp_xfer_patch , & ! Input: [real(r8) (:)] (gC/m2) growth respiration transfer + + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N + frootn => cnveg_nitrogenstate_inst%frootn_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N + livestemn => cnveg_nitrogenstate_inst%livestemn_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N + deadstemn => cnveg_nitrogenstate_inst%deadstemn_patch , & ! Input: [real(r8) (:)] (gN/m2) dead stem N + livecrootn => cnveg_nitrogenstate_inst%livecrootn_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N + deadcrootn => cnveg_nitrogenstate_inst%deadcrootn_patch , & ! Input: [real(r8) (:)] (gN/m2) dead coarse root N + retransn => cnveg_nitrogenstate_inst%retransn_patch , & ! Input: [real(r8) (:)] (gN/m2) plant pool of retranslocated N + leafn_storage => cnveg_nitrogenstate_inst%leafn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N storage + frootn_storage => cnveg_nitrogenstate_inst%frootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N storage + livestemn_storage => cnveg_nitrogenstate_inst%livestemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N storage + deadstemn_storage => cnveg_nitrogenstate_inst%deadstemn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead stem N storage + livecrootn_storage => cnveg_nitrogenstate_inst%livecrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N storage + deadcrootn_storage => cnveg_nitrogenstate_inst%deadcrootn_storage_patch , & ! Input: [real(r8) (:)] (gN/m2) dead coarse root N storage + leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) leaf N transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) fine root N transfer + livestemn_xfer => cnveg_nitrogenstate_inst%livestemn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) live stem N transfer + deadstemn_xfer => cnveg_nitrogenstate_inst%deadstemn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) dead stem N transfer + livecrootn_xfer => cnveg_nitrogenstate_inst%livecrootn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) live coarse root N transfer + deadcrootn_xfer => cnveg_nitrogenstate_inst%deadcrootn_xfer_patch , & ! Input: [real(r8) (:)] (gN/m2) dead coarse root N transfer + + hrv_leafc_to_litter => cnveg_carbonflux_inst%hrv_leafc_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootc_to_litter => cnveg_carbonflux_inst%hrv_frootc_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemc_to_litter => cnveg_carbonflux_inst%hrv_livestemc_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemc_to_prod10c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_patch , & ! Output: [real(r8) (:)] + hrv_deadstemc_to_prod100c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_patch , & ! Output: [real(r8) (:)] + hrv_livecrootc_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootc_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_xsmrpool_to_atm => cnveg_carbonflux_inst%hrv_xsmrpool_to_atm_patch , & ! Output: [real(r8) (:)] + hrv_leafc_storage_to_litter => cnveg_carbonflux_inst%hrv_leafc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootc_storage_to_litter => cnveg_carbonflux_inst%hrv_frootc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemc_storage_to_litter => cnveg_carbonflux_inst%hrv_livestemc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemc_storage_to_litter => cnveg_carbonflux_inst%hrv_deadstemc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livecrootc_storage_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootc_storage_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_gresp_storage_to_litter => cnveg_carbonflux_inst%hrv_gresp_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_leafc_xfer_to_litter => cnveg_carbonflux_inst%hrv_leafc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_frootc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemc_xfer_to_litter => cnveg_carbonflux_inst%hrv_livestemc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemc_xfer_to_litter => cnveg_carbonflux_inst%hrv_deadstemc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livecrootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_gresp_xfer_to_litter => cnveg_carbonflux_inst%hrv_gresp_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + + hrv_leafn_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootn_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemn_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemn_to_prod10n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod10n_patch , & ! Output: [real(r8) (:)] + hrv_deadstemn_to_prod100n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod100n_patch , & ! Output: [real(r8) (:)] + hrv_livecrootn_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootn_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_retransn_to_litter => cnveg_nitrogenflux_inst%hrv_retransn_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_leafn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_deadstemn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livecrootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_storage_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_leafn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_frootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livestemn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadstemn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_deadstemn_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_livecrootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_xfer_to_litter_patch , & ! Output: [real(r8) (:)] + hrv_deadcrootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_xfer_to_litter_patch & ! Output: [real(r8) (:)] + ) + + + days_per_year = get_days_per_year() + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + g = patch%gridcell(p) + + ! If this is a tree pft, then + ! get the annual harvest "mortality" rate (am) from harvest array + ! and convert to rate per second + if (ivt(p) > noveg .and. ivt(p) < nbrdlf_evr_shrub) then + + if (do_harvest) then + am = harvest(g) + m = am/(days_per_year * secspday) + else + m = 0._r8 + end if + + ! patch-level harvest carbon fluxes + ! displayed pools + hrv_leafc_to_litter(p) = leafc(p) * m + hrv_frootc_to_litter(p) = frootc(p) * m + hrv_livestemc_to_litter(p) = livestemc(p) * m + hrv_deadstemc_to_prod10c(p) = deadstemc(p) * m * pftcon%pprodharv10(ivt(p)) + hrv_deadstemc_to_prod100c(p) = deadstemc(p) * m * (1.0_r8 - pftcon%pprodharv10(ivt(p))) + hrv_livecrootc_to_litter(p) = livecrootc(p) * m + hrv_deadcrootc_to_litter(p) = deadcrootc(p) * m + hrv_xsmrpool_to_atm(p) = xsmrpool(p) * m + + ! storage pools + hrv_leafc_storage_to_litter(p) = leafc_storage(p) * m + hrv_frootc_storage_to_litter(p) = frootc_storage(p) * m + hrv_livestemc_storage_to_litter(p) = livestemc_storage(p) * m + hrv_deadstemc_storage_to_litter(p) = deadstemc_storage(p) * m + hrv_livecrootc_storage_to_litter(p) = livecrootc_storage(p) * m + hrv_deadcrootc_storage_to_litter(p) = deadcrootc_storage(p) * m + hrv_gresp_storage_to_litter(p) = gresp_storage(p) * m + + ! transfer pools + hrv_leafc_xfer_to_litter(p) = leafc_xfer(p) * m + hrv_frootc_xfer_to_litter(p) = frootc_xfer(p) * m + hrv_livestemc_xfer_to_litter(p) = livestemc_xfer(p) * m + hrv_deadstemc_xfer_to_litter(p) = deadstemc_xfer(p) * m + hrv_livecrootc_xfer_to_litter(p) = livecrootc_xfer(p) * m + hrv_deadcrootc_xfer_to_litter(p) = deadcrootc_xfer(p) * m + hrv_gresp_xfer_to_litter(p) = gresp_xfer(p) * m + + ! patch-level harvest mortality nitrogen fluxes + ! displayed pools + hrv_leafn_to_litter(p) = leafn(p) * m + hrv_frootn_to_litter(p) = frootn(p) * m + hrv_livestemn_to_litter(p) = livestemn(p) * m + hrv_deadstemn_to_prod10n(p) = deadstemn(p) * m * pftcon%pprodharv10(ivt(p)) + hrv_deadstemn_to_prod100n(p) = deadstemn(p) * m * (1.0_r8 - pftcon%pprodharv10(ivt(p))) + hrv_livecrootn_to_litter(p) = livecrootn(p) * m + hrv_deadcrootn_to_litter(p) = deadcrootn(p) * m + hrv_retransn_to_litter(p) = retransn(p) * m + + ! storage pools + hrv_leafn_storage_to_litter(p) = leafn_storage(p) * m + hrv_frootn_storage_to_litter(p) = frootn_storage(p) * m + hrv_livestemn_storage_to_litter(p) = livestemn_storage(p) * m + hrv_deadstemn_storage_to_litter(p) = deadstemn_storage(p) * m + hrv_livecrootn_storage_to_litter(p) = livecrootn_storage(p) * m + hrv_deadcrootn_storage_to_litter(p) = deadcrootn_storage(p) * m + + ! transfer pools + hrv_leafn_xfer_to_litter(p) = leafn_xfer(p) * m + hrv_frootn_xfer_to_litter(p) = frootn_xfer(p) * m + hrv_livestemn_xfer_to_litter(p) = livestemn_xfer(p) * m + hrv_deadstemn_xfer_to_litter(p) = deadstemn_xfer(p) * m + hrv_livecrootn_xfer_to_litter(p) = livecrootn_xfer(p) * m + hrv_deadcrootn_xfer_to_litter(p) = deadcrootn_xfer(p) * m + + end if ! end tree block + + end do ! end of pft loop + + ! gather all patch-level litterfall fluxes from harvest to the column + ! for litter C and N inputs + + call CNHarvestPftToColumn(num_soilc, filter_soilc, & + soilbiogeochem_state_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) + + end associate + + end subroutine CNHarvest + + !----------------------------------------------------------------------- + subroutine CNHarvestPftToColumn (num_soilc, filter_soilc, & + soilbiogeochem_state_inst, CNVeg_carbonflux_inst, cnveg_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! called at the end of CNHarvest to gather all patch-level harvest litterfall fluxes + ! to the column level and assign them to the three litter pools + ! + ! !USES: + use clm_varpar , only : maxpatch_pft, nlevdecomp + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! soil column filter + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: fc,c,pi,p,j ! indices + !----------------------------------------------------------------------- + + associate( & + ivt => patch%itype , & ! Input: [integer (:) ] pft vegetation type + wtcol => patch%wtcol , & ! Input: [real(r8) (:) ] pft weight relative to column (0-1) + + lf_flab => pftcon%lf_flab , & ! Input: leaf litter labile fraction + lf_fcel => pftcon%lf_fcel , & ! Input: leaf litter cellulose fraction + lf_flig => pftcon%lf_flig , & ! Input: leaf litter lignin fraction + fr_flab => pftcon%fr_flab , & ! Input: fine root litter labile fraction + fr_fcel => pftcon%fr_fcel , & ! Input: fine root litter cellulose fraction + fr_flig => pftcon%fr_flig , & ! Input: fine root litter lignin fraction + + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch , & ! Input: [real(r8) (:,:) ] (1/m) profile of stems + + hrv_leafc_to_litter => cnveg_carbonflux_inst%hrv_leafc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_to_litter => cnveg_carbonflux_inst%hrv_frootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_to_litter => cnveg_carbonflux_inst%hrv_livestemc_to_litter_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemc_to_prod10c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemc_to_prod100c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafc_storage_to_litter => cnveg_carbonflux_inst%hrv_leafc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_storage_to_litter => cnveg_carbonflux_inst%hrv_frootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_storage_to_litter => cnveg_carbonflux_inst%hrv_livestemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemc_storage_to_litter => cnveg_carbonflux_inst%hrv_deadstemc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_storage_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_storage_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_gresp_storage_to_litter => cnveg_carbonflux_inst%hrv_gresp_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafc_xfer_to_litter => cnveg_carbonflux_inst%hrv_leafc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_frootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemc_xfer_to_litter => cnveg_carbonflux_inst%hrv_livestemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemc_xfer_to_litter => cnveg_carbonflux_inst%hrv_deadstemc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_livecrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootc_xfer_to_litter => cnveg_carbonflux_inst%hrv_deadcrootc_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_gresp_xfer_to_litter => cnveg_carbonflux_inst%hrv_gresp_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + chrv_deadstemc_to_prod10c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod10c_col , & ! InOut: [real(r8) (:) ] + chrv_deadstemc_to_prod100c => cnveg_carbonflux_inst%hrv_deadstemc_to_prod100c_col , & ! InOut: [real(r8) (:) ] + harvest_c_to_litr_met_c => cnveg_carbonflux_inst%harvest_c_to_litr_met_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with harvest to litter metabolic pool (gC/m3/s) + harvest_c_to_litr_cel_c => cnveg_carbonflux_inst%harvest_c_to_litr_cel_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with harvest to litter cellulose pool (gC/m3/s) + harvest_c_to_litr_lig_c => cnveg_carbonflux_inst%harvest_c_to_litr_lig_c_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with harvest to litter lignin pool (gC/m3/s) + harvest_c_to_cwdc => cnveg_carbonflux_inst%harvest_c_to_cwdc_col , & ! InOut: [real(r8) (:,:) ] C fluxes associated with harvest to CWD pool (gC/m3/s) + + hrv_leafn_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootn_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemn_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_to_litter_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemn_to_prod10n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod10n_patch , & ! Input: [real(r8) (:) ] + phrv_deadstemn_to_prod100n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod100n_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootn_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootn_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_retransn_to_litter => cnveg_nitrogenflux_inst%hrv_retransn_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_deadstemn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootn_storage_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_storage_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_leafn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_leafn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_frootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_frootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livestemn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_livestemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadstemn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_deadstemn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_livecrootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_livecrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + hrv_deadcrootn_xfer_to_litter => cnveg_nitrogenflux_inst%hrv_deadcrootn_xfer_to_litter_patch , & ! Input: [real(r8) (:) ] + chrv_deadstemn_to_prod10n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod10n_col , & ! InOut: [real(r8) (:) ] + chrv_deadstemn_to_prod100n => cnveg_nitrogenflux_inst%hrv_deadstemn_to_prod100n_col , & ! InOut: [real(r8) (:) ] + harvest_n_to_litr_met_n => cnveg_nitrogenflux_inst%harvest_n_to_litr_met_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with harvest to litter metabolic pool (gN/m3/s) + harvest_n_to_litr_cel_n => cnveg_nitrogenflux_inst%harvest_n_to_litr_cel_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with harvest to litter cellulose pool (gN/m3/s) + harvest_n_to_litr_lig_n => cnveg_nitrogenflux_inst%harvest_n_to_litr_lig_n_col , & ! InOut: [real(r8) (:,:) ] N fluxes associated with harvest to litter lignin pool (gN/m3/s) + harvest_n_to_cwdn => cnveg_nitrogenflux_inst%harvest_n_to_cwdn_col & ! InOut: [real(r8) (:,:) ] N fluxes associated with harvest to CWD pool (gN/m3/s) + ) + + do j = 1, nlevdecomp + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + ! leaf harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_cel_c(c,j) = harvest_c_to_litr_cel_c(c,j) + & + hrv_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_lig_c(c,j) = harvest_c_to_litr_lig_c(c,j) + & + hrv_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_cel_c(c,j) = harvest_c_to_litr_cel_c(c,j) + & + hrv_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_lig_c(c,j) = harvest_c_to_litr_lig_c(c,j) + & + hrv_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood harvest mortality carbon fluxes + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livestemc_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_livecrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_cwdc(c,j) = harvest_c_to_cwdc(c,j) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! storage harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! transfer harvest mortality carbon fluxes + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_leafc_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_c_to_litr_met_c(c,j) = harvest_c_to_litr_met_c(c,j) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! leaf harvest mortality nitrogen fluxes + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_n_to_litr_cel_n(c,j) = harvest_n_to_litr_cel_n(c,j) + & + hrv_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) * leaf_prof(p,j) + harvest_n_to_litr_lig_n(c,j) = harvest_n_to_litr_lig_n(c,j) + & + hrv_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) * leaf_prof(p,j) + + ! fine root litter nitrogen fluxes + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_n_to_litr_cel_n(c,j) = harvest_n_to_litr_cel_n(c,j) + & + hrv_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) * froot_prof(p,j) + harvest_n_to_litr_lig_n(c,j) = harvest_n_to_litr_lig_n(c,j) + & + hrv_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) * froot_prof(p,j) + + ! wood harvest mortality nitrogen fluxes + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_livestemn_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_livecrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_n_to_cwdn(c,j) = harvest_n_to_cwdn(c,j) + & + hrv_deadcrootn_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! retranslocated N pool harvest mortality fluxes + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_retransn_to_litter(p) * wtcol(p) * leaf_prof(p,j) + + ! storage harvest mortality nitrogen fluxes + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_leafn_storage_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_frootn_storage_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_livestemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_deadstemn_storage_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_livecrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_deadcrootn_storage_to_litter(p) * wtcol(p) * croot_prof(p,j) + + ! transfer harvest mortality nitrogen fluxes + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_leafn_xfer_to_litter(p) * wtcol(p) * leaf_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_frootn_xfer_to_litter(p) * wtcol(p) * froot_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_livestemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_deadstemn_xfer_to_litter(p) * wtcol(p) * stem_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_livecrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + harvest_n_to_litr_met_n(c,j) = harvest_n_to_litr_met_n(c,j) + & + hrv_deadcrootn_xfer_to_litter(p) * wtcol(p) * croot_prof(p,j) + + end if + end if + + end do + + end do + end do + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + + if (patch%active(p)) then + + + ! wood harvest mortality carbon fluxes to product pools + chrv_deadstemc_to_prod10c(c) = chrv_deadstemc_to_prod10c(c) + & + phrv_deadstemc_to_prod10c(p) * wtcol(p) + chrv_deadstemc_to_prod100c(c) = chrv_deadstemc_to_prod100c(c) + & + phrv_deadstemc_to_prod100c(p) * wtcol(p) + + + ! wood harvest mortality nitrogen fluxes to product pools + chrv_deadstemn_to_prod10n(c) = chrv_deadstemn_to_prod10n(c) + & + phrv_deadstemn_to_prod10n(p) * wtcol(p) + chrv_deadstemn_to_prod100n(c) = chrv_deadstemn_to_prod100n(c) + & + phrv_deadstemn_to_prod100n(p) * wtcol(p) + end if + end if + + end do + + end do + + end associate + + end subroutine CNHarvestPftToColumn + +end module dynHarvestMod diff --git a/components/clm/src/dyn_subgrid/dynInitColumnsMod.F90 b/components/clm/src/dyn_subgrid/dynInitColumnsMod.F90 new file mode 100644 index 0000000000..24303da51d --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynInitColumnsMod.F90 @@ -0,0 +1,301 @@ +module dynInitColumnsMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Handle initialization of columns that just switched from inactive to active + ! + ! !USES: +#include "shr_assert.h" + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varcon , only : ispval, namec + use TemperatureType , only : temperature_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + ! The following is the public interface to the routines in this module: + public :: initialize_new_columns ! Do initialization for all columns that are newly-active in this time step + + ! The following are public only for unit testing purposes, and should not be called + ! directly by application code: + public :: initial_template_col_crop ! Find column to use as a template for a crop column that has newly become active + public :: initial_template_col ! Find column to serve as a template for the initialization of another column in the same grid cell + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: initial_template_col_dispatcher ! Find column to use as a template; dispatcher to the appropriate routine based on landunit type + private :: initial_template_col_soil ! Find column to use as a template for a vegetated column that has newly become active + private :: copy_state ! Copy a subset of state variables from template column to newly-active column + + !--------------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine initialize_new_columns(bounds, cactive_prior, temperature_inst) + ! + ! !DESCRIPTION: + ! Do initialization for all columns that are newly-active in this time step + ! + ! !USES: + use GetGlobalValuesMod , only : GetGlobalWrite + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + logical , intent(in) :: cactive_prior( bounds%begc: ) ! column-level active flags from prior time step + type(temperature_type) , intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + integer :: c ! column index + integer :: c_template ! index of template column + + character(len=*), parameter :: subname = 'initialize_new_columns' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(cactive_prior) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + do c = bounds%begc, bounds%endc + ! If this column is newly-active, then we need to initialize it using the routines in this module + if (col%active(c) .and. .not. cactive_prior(c)) then + c_template = initial_template_col_dispatcher(bounds, c, cactive_prior(bounds%begc:bounds%endc)) + if (c_template /= ispval) then + call copy_state(c, c_template, temperature_inst) + else + write(iulog,*) subname// ' WARNING: No template column found to initialize newly-active column' + write(iulog,*) '-- keeping the state that was already in memory, possibly from arbitrary initialization' + call GetGlobalWrite(decomp_index=c, clmlevel=namec) + end if + end if + end do + + end subroutine initialize_new_columns + + + !----------------------------------------------------------------------- + function initial_template_col_dispatcher(bounds, c_new, cactive_prior) result(c_template) + ! + ! !DESCRIPTION: + ! Find column to use as a template for the given column that has newly become active; + ! this is a dispatcher that calls the appropriate routine based on the landunit type of c_new. + ! + ! Returns ispval if there is no column to use for initialization + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop, istice, istice_mec, istdlak, istwet, isturb_MIN, isturb_MAX + ! + ! !ARGUMENTS: + integer :: c_template ! function result + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: c_new ! column index that needs initialization + logical , intent(in) :: cactive_prior( bounds%begc: ) ! column-level active flags from prior time step + ! + ! !LOCAL VARIABLES: + integer :: l ! landunit index + integer :: ltype ! landunit type + + character(len=*), parameter :: subname = 'initial_template_col_dispatcher' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(cactive_prior) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + l = col%landunit(c_new) + ltype = lun%itype(l) + select case(ltype) + case(istsoil) + c_template = initial_template_col_soil(c_new) + case(istcrop) + c_template = initial_template_col_crop(bounds, c_new, cactive_prior(bounds%begc:bounds%endc)) + case(istice) + write(iulog,*) subname// ' ERROR: Ability to initialize a newly-active glacier column not yet implemented' + write(iulog,*) 'Expectation is that only ice_mec columns can grow' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + case(istice_mec) + write(iulog,*) subname// ' ERROR: Ability to initialize a newly-active glacier mec column not yet implemented' + write(iulog,*) 'Expectation is that glacier mec columns should be active from the start of the run wherever they can grow' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + case(istdlak) + write(iulog,*) subname// ' ERROR: Ability to initialize a newly-active lake column not yet implemented' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + case(istwet) + write(iulog,*) subname// ' ERROR: Ability to initialize a newly-active wetland column not yet implemented' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + case(isturb_MIN:isturb_MAX) + write(iulog,*) subname// ' ERROR: Ability to initialize a newly-active urban column not yet implemented' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + case default + write(iulog,*) subname// ' ERROR: Unknown landunit type: ', ltype + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end select + + end function initial_template_col_dispatcher + + + !----------------------------------------------------------------------- + function initial_template_col_soil(c_new) result(c_template) + ! + ! !DESCRIPTION: + ! Find column to use as a template for a vegetated column that has newly become active. + ! + ! For now, we assume that the only vegetated columns that can newly become active are + ! ones with 0 weight on the grid cell (i.e., virtual columns). For these, we simply + ! keep the state at the current value (likely arbitrary initial conditions), and so + ! return ispval from this function. Within this function, we check this assumption. + ! + ! !USES: + use clm_varcon, only : ispval + ! + ! !ARGUMENTS: + integer :: c_template ! function result + integer , intent(in) :: c_new ! column index that needs initialization + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'initial_template_col_soil' + !----------------------------------------------------------------------- + + if (col%wtgcell(c_new) > 0._r8) then + write(iulog,*) subname// ' ERROR: Expectation is that the only vegetated columns that& + & can newly become active are ones with 0 weight on the grid cell' + call endrun(decomp_index=c_new, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + + c_template = ispval + + end function initial_template_col_soil + + !----------------------------------------------------------------------- + function initial_template_col_crop(bounds, c_new, cactive_prior) result(c_template) + ! + ! !DESCRIPTION: + ! Find column to use as a template for a crop column that has newly become active + ! + ! Returns ispval if there is no column to use for initialization + ! + ! !USES: + use clm_varcon, only : ispval + use landunit_varcon, only : istsoil, istcrop + ! + ! !ARGUMENTS: + integer :: c_template ! function result + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: c_new ! column index that needs initialization + logical , intent(in) :: cactive_prior( bounds%begc: ) ! column-level active flags from prior time step + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'initial_template_col_crop' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(cactive_prior) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + ! First try to find an active column on the vegetated landunit; if there is none, then + ! find the first active column on the crop landunit; if there is none, then + ! template_col will be ispval + c_template = initial_template_col(bounds, c_new, istsoil, cactive_prior(bounds%begc:bounds%endc)) + if (c_template == ispval) then + c_template = initial_template_col(bounds, c_new, istcrop, cactive_prior(bounds%begc:bounds%endc)) + end if + + end function initial_template_col_crop + + + !----------------------------------------------------------------------- + function initial_template_col(bounds, c_new, landunit_type, cactive_prior) result(c_template) + ! + ! !DESCRIPTION: + ! Finds a column to serve as a template for the initialization of another column in + ! the same grid cell. + ! + ! Looks for a landunit of the type given by landunit_type (e.g., istsoil, + ! istcrop). Looks for the first active column on this landunit type, in the same grid + ! cell; order of columns within a landunit is arbitrary (given by their order in + ! memory). Returns the column index of the first such column found. If there are no + ! active columns in this landunit in this grid cell, returns ispval. + ! + ! Note that, in checking 'active', we use the active flags from the prior time step, + ! so that we don't identify a point that just became active for the first time in this + ! time step. + ! + ! !USES: + use clm_varcon, only : ispval + ! + ! !ARGUMENTS: + integer :: c_template ! function return value + + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: c_new ! column index that needs initialization + integer , intent(in) :: landunit_type ! landunit type from which we want to find a template column (e.g., istsoil) + logical , intent(in) :: cactive_prior( bounds%begc: ) ! column-level active flags from prior time step + ! + ! !LOCAL VARIABLES: + logical :: found ! whether a suitable template column has been found + integer :: g,l,c ! indices of grid cell, landunit, column + + character(len=*), parameter :: subname = 'initial_template_col' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(cactive_prior) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + found = .false. + g = col%gridcell(c_new) + l = grc%landunit_indices(landunit_type, g) + + ! If this landunit exists on this grid cell... + if (l /= ispval) then + + ! Loop through columns on this landunit; stop if as soon as we find an active + ! column: that will serve as the template + c = lun%coli(l) + do while (.not. found .and. c <= lun%colf(l)) + if (cactive_prior(c)) then + found = .true. + else + c = c + 1 + end if + end do + end if + + if (found) then + c_template = c + else + c_template = ispval + end if + + end function initial_template_col + + !----------------------------------------------------------------------- + subroutine copy_state(c_new, c_template, temperature_inst) + ! + ! !DESCRIPTION: + ! Copy a subset of state variables from a template column (c_template) to a newly- + ! active column (c_new) + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: c_new ! index of newly-active column + integer, intent(in) :: c_template ! index of column to use as a template + type(temperature_type), intent(inout) :: temperature_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'copy_state' + !----------------------------------------------------------------------- + + ! For now, just copy t_soisno + ! TODO: Figure out what else should be copied + temperature_inst%t_soisno_col(c_new,:) = temperature_inst%t_soisno_col(c_template,:) + + end subroutine copy_state + + + +end module dynInitColumnsMod diff --git a/components/clm/src/dyn_subgrid/dynLandunitAreaMod.F90 b/components/clm/src/dyn_subgrid/dynLandunitAreaMod.F90 new file mode 100644 index 0000000000..5f4125f661 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynLandunitAreaMod.F90 @@ -0,0 +1,163 @@ +module dynLandunitAreaMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Handle dynamic landunit weights + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varcon , only : ispval, namel + use landunit_varcon, only : isturb_hd, isturb_md, isturb_tbd + use landunit_varcon, only : istsoil, istcrop, istice, istdlak, istwet, max_lunit + use decompMod , only : bounds_type + use abortutils , only : endrun + use GridcellType , only : grc + use LandunitType , only : lun + ! + implicit none + private + ! + public :: update_landunit_weights ! update landunit weights for all grid cells + + ! The following is only public for the sake of unit testing; it should not be called + ! directly by CLM code outside this module + public :: update_landunit_weights_one_gcell + !----------------------------------------------------------------------- + +contains + + + !----------------------------------------------------------------------- + subroutine update_landunit_weights(bounds) + ! + ! !DESCRIPTION: + ! Update landunit weights for all grid cells. + ! + ! Assumes lun%wtgcell has been updated for all landunits whose areas are specified by + ! the dynamic subgrid code. Update lun%wtgcell for all other landunits (including + ! possibly changing some values of lun%wtgcell for landunits whose areas are + ! specified, e.g., if there are conflicts between glacier area and crop area). + ! + ! !USES: + use subgridWeightsMod, only : get_landunit_weight, set_landunit_weight + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + integer :: ltype ! landunit type + real(r8) :: landunit_weights(max_lunit) ! weight of each landunit on a single grid cell + + character(len=*), parameter :: subname = 'update_landunit_weights' + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + + ! Determine current landunit weights. Landunits that don't exist on this grid cell + ! get a weight of 0 + do ltype = 1, max_lunit + landunit_weights(ltype) = get_landunit_weight(g, ltype) + end do + + ! Adjust weights so they sum to 100% + call update_landunit_weights_one_gcell(landunit_weights) + + ! Put the new landunit weights back into lun%wtgcell + do ltype = 1, max_lunit + call set_landunit_weight(g, ltype, landunit_weights(ltype)) + end do + + end do + + end subroutine update_landunit_weights + + + !----------------------------------------------------------------------- + subroutine update_landunit_weights_one_gcell(landunit_weights) + ! + ! !DESCRIPTION: + ! Update landunit weights for a single grid cell. + ! + ! This should be called with a vector of landunit weights for this grid cell, which is + ! updated in-place. Element #1 in this vector is the weight of landunit #1 (e.g., + ! istsoil, assuming istsoil==1), element #2 is the weight of landunit #2 (e.g., + ! istcrop, assuming istcrop==2), etc. Landunits that do not exist in this grid cell + ! should be given a weight of 0 in the vector. + ! + ! After the execution of this routine, sum(landunit_weights) will be 1 within a small + ! roundoff-level tolerance. This is achieved by growing or shrinking landunits as + ! needed. + ! + ! !ARGUMENTS: + real(r8), intent(inout) :: landunit_weights(:) ! weight of each landunit; this is updated in-place + ! + ! !LOCAL VARIABLES: + real(r8) :: landunit_sum ! sum of all landunit weights on this grid cell + real(r8) :: excess ! excess landunit weight that needs to be removed + integer :: decrease_index ! the current index into decrease_order + integer :: cur_landunit ! the current element of decrease_order that we're dealing with + + ! This parameter specifies the order in which landunit areas are decreased when the + ! specified areas add to greater than 100%. Landunits not listed here can never be + ! decreased unless the forcings say they should be decreased. In particular, note + ! that istice_mec doesn't appear here, so that the istice_mec area always will match + ! the areas specified by GLC. In general, the code will NOT be robust if more than + ! one landunit is excluded from this list. Meaning: since istice_mec is excluded from + ! this list, all other landunits should appear in this list! + integer, parameter :: decrease_order(8) = & + (/istsoil, istcrop, isturb_md, isturb_hd, isturb_tbd, istwet, istdlak, istice/) + + real(r8), parameter :: tol = 1.e-14 ! tolerance for making sure sum of landunit weights equals 1 + + character(len=*), parameter :: subname = 'update_landunit_weights_one_gcell' + !----------------------------------------------------------------------- + + SHR_ASSERT((size(landunit_weights) == max_lunit), errMsg(__FILE__, __LINE__)) + + landunit_sum = sum(landunit_weights) + + ! If landunits sum to ~ 100% already, we're done + if (abs(landunit_sum - 1._r8) <= tol) then + ! Do nothing + + ! If landunits sum to < 100%, increase natural vegetation so sum is 100% + else if (landunit_sum < 1._r8) then + landunit_weights(istsoil) = landunit_weights(istsoil) + (1._r8 - landunit_sum) + + ! If landunits sum to > 100%, decrease areas in priority order + else + decrease_index = 1 + excess = landunit_sum - 1._r8 + do while ((excess > tol) .and. decrease_index <= size(decrease_order)) + ! Decrease weight of the next landunit, but not below 0 + cur_landunit = decrease_order(decrease_index) + landunit_weights(cur_landunit) = landunit_weights(cur_landunit) - excess + if (landunit_weights(cur_landunit) < 0._r8) then + landunit_weights(cur_landunit) = 0._r8 + end if + + ! Update variables for next loop iteration + landunit_sum = sum(landunit_weights) + excess = landunit_sum - 1._r8 + decrease_index = decrease_index + 1 + end do + end if + + ! Confirm that landunit sum is now equal to 100%, within tolerance + landunit_sum = sum(landunit_weights) + if (abs(landunit_sum - 1._r8) > tol) then + write(iulog,*) subname//' ERROR: After all landunit adjustments, landunit weights still do not equal 100%' + write(iulog,*) 'landunit_sum = ', landunit_sum + write(iulog,*) 'landunit_weights = ', landunit_weights + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine update_landunit_weights_one_gcell + +end module dynLandunitAreaMod diff --git a/components/clm/src/dyn_subgrid/dynPriorWeightsMod.F90 b/components/clm/src/dyn_subgrid/dynPriorWeightsMod.F90 new file mode 100644 index 0000000000..268b152082 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynPriorWeightsMod.F90 @@ -0,0 +1,90 @@ +module dynPriorWeightsMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Defines a derived type and associated methods for working with prior subgrid weights + ! (i.e., before the weight updates of this time step) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use ColumnType , only : col + use PatchType , only : patch + ! + implicit none + private + ! + ! !PUBLIC TYPES: + public :: prior_weights_type + + type prior_weights_type + ! Components are public for ease-of-use and efficiency. However, these components + ! should be treated as read-only! + real(r8), allocatable, public :: pwtcol(:) ! prior pft weight on the column + logical , allocatable, public :: cactive(:) ! prior col%active flags + contains + procedure :: set_prior_weights ! set prior weights to current weights + end type prior_weights_type + + interface prior_weights_type + module procedure constructor ! initialize a prior_weights_type object + end interface prior_weights_type + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + ! ---------------------------------------------------------------------- + type(prior_weights_type) function constructor(bounds) + ! + ! !DESCRIPTION: + ! Initialize a prior_weights_type object + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! processor bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'prior_weights_type constructor' + ! ---------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + allocate(constructor%pwtcol(bounds%begp:bounds%endp)) + allocate(constructor%cactive(bounds%begc:bounds%endc)) + end function constructor + + + ! ====================================================================== + ! Public methods + ! ====================================================================== + + ! ---------------------------------------------------------------------- + subroutine set_prior_weights(this, bounds) + ! + ! !DESCRIPTION: + ! Set prior weights to current weights + ! + ! !ARGUMENTS: + class(prior_weights_type) , intent(inout) :: this ! this object + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p, c ! patch & col indices + ! ---------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + this%pwtcol(p) = patch%wtcol(p) + end do + + do c = bounds%begc, bounds%endc + this%cactive(c) = col%active(c) + end do + end subroutine set_prior_weights + +end module dynPriorWeightsMod diff --git a/components/clm/src/dyn_subgrid/dynSubgridControlMod.F90 b/components/clm/src/dyn_subgrid/dynSubgridControlMod.F90 new file mode 100644 index 0000000000..6a55031dad --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynSubgridControlMod.F90 @@ -0,0 +1,252 @@ +module dynSubgridControlMod + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! Defines a class for storing and querying control flags related to dynamic subgrid + ! operation. + ! + ! Note that this is implemented (essentially) as a singleton, so the only instance of + ! this class is stored in this module. This is done for convenience, to avoid having to + ! pass around the single instance just to query these control flags. + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : fname_len + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: dynSubgridControl_init + public :: get_flanduse_timeseries ! return the value of the flanduse_timeseries file name + public :: get_do_transient_pfts ! return the value of the do_transient_pfts control flag + public :: get_do_transient_crops ! return the value of the do_transient_crops control flag + public :: get_do_harvest ! return the value of the do_harvest control flag + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: read_namelist ! read namelist variables + private :: check_namelist_consistency ! check consistency of namelist settings + ! + ! !PRIVATE TYPES: + type dyn_subgrid_control_type + private + character(len=fname_len) :: flanduse_timeseries = ' ' ! transient landuse dataset + logical :: do_transient_pfts = .false. ! whether to apply transient natural PFTs from dataset + logical :: do_transient_crops = .false. ! whether to apply transient crops from dataset + logical :: do_harvest = .false. ! whether to apply harvest from dataset + end type dyn_subgrid_control_type + + type(dyn_subgrid_control_type) :: dyn_subgrid_control_inst + +contains + + !----------------------------------------------------------------------- + subroutine dynSubgridControl_init + ! + ! !DESCRIPTION: + ! Initialize the dyn_subgrid_control settings. + ! + ! !USES: + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'dynSubgridControl_init' + !----------------------------------------------------------------------- + + call read_namelist + if (masterproc) then + call check_namelist_consistency + end if + + end subroutine dynSubgridControl_init + + !----------------------------------------------------------------------- + subroutine read_namelist + ! + ! !DESCRIPTION: + ! Read dyn_subgrid_control namelist variables + ! + ! !USES: + use fileutils , only : getavu, relavu + use clm_nlUtilsMod , only : find_nlgroup_name + use controlMod , only : NLFilename + use clm_varctl , only : iulog + use spmdMod , only : masterproc, mpicom + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + ! temporary variables corresponding to the components of dyn_subgrid_control_type: + character(len=fname_len) :: flanduse_timeseries + logical :: do_transient_pfts + logical :: do_transient_crops + logical :: do_harvest + ! other local variables: + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + + character(len=*), parameter :: subname = 'read_namelist' + !----------------------------------------------------------------------- + + namelist /dynamic_subgrid/ & + flanduse_timeseries, & + do_transient_pfts, & + do_transient_crops, & + do_harvest + + ! Initialize options to default values, in case they are not specified in the namelist + flanduse_timeseries = ' ' + do_transient_pfts = .false. + do_transient_crops = .false. + do_harvest = .false. + + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'dynamic_subgrid', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=dynamic_subgrid, iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading dynamic_subgrid namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast (flanduse_timeseries, mpicom) + call shr_mpi_bcast (do_transient_pfts, mpicom) + call shr_mpi_bcast (do_transient_crops, mpicom) + call shr_mpi_bcast (do_harvest, mpicom) + + dyn_subgrid_control_inst = dyn_subgrid_control_type( & + flanduse_timeseries = flanduse_timeseries, & + do_transient_pfts = do_transient_pfts, & + do_transient_crops = do_transient_crops, & + do_harvest = do_harvest) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'dynamic_subgrid settings:' + write(iulog,nml=dynamic_subgrid) + write(iulog,*) ' ' + end if + + end subroutine read_namelist + + !----------------------------------------------------------------------- + subroutine check_namelist_consistency + ! + ! !DESCRIPTION: + ! Check consistency of namelist settingsn + ! + ! !USES: + use clm_varctl , only : iulog, use_cndv, use_ed, use_crop, use_cn + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'check_namelist_consistency' + !----------------------------------------------------------------------- + + if (dyn_subgrid_control_inst%flanduse_timeseries == ' ') then + if (dyn_subgrid_control_inst%do_transient_pfts) then + write(iulog,*) 'ERROR: do_transient_pfts can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (dyn_subgrid_control_inst%do_transient_crops) then + write(iulog,*) 'ERROR: do_transient_crops can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (dyn_subgrid_control_inst%do_harvest) then + write(iulog,*) 'ERROR: do_harvest can only be true if you are running with' + write(iulog,*) 'a flanduse_timeseries file (currently flanduse_timeseries is blank)' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + if (dyn_subgrid_control_inst%do_transient_pfts) then + if (use_cndv) then + write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_cndv' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (use_ed) then + write(iulog,*) 'ERROR: do_transient_pfts is incompatible with use_ed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + if (dyn_subgrid_control_inst%do_transient_crops) then + if (.not. use_crop) then + write(iulog,*) 'ERROR: do_transient_crops can only be true if use_crop is true' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (use_ed) then + write(iulog,*) 'ERROR: do_transient_crops has not been tested with use_ed;' + write(iulog,*) 'for now these two options cannot be combined' + end if + end if + + if (dyn_subgrid_control_inst%do_harvest) then + if (.not. use_cn) then + write(iulog,*) 'ERROR: do_harvest can only be true if use_cn is true' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (use_ed) then + write(iulog,*) 'ERROR: do_harvest currently does not work with use_ed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + end subroutine check_namelist_consistency + + !----------------------------------------------------------------------- + character(len=fname_len) function get_flanduse_timeseries() + ! !DESCRIPTION: + ! Return the value of the flanduse_timeseries file name + !----------------------------------------------------------------------- + + get_flanduse_timeseries = dyn_subgrid_control_inst%flanduse_timeseries + + end function get_flanduse_timeseries + + !----------------------------------------------------------------------- + logical function get_do_transient_pfts() + ! !DESCRIPTION: + ! Return the value of the do_transient_pfts control flag + !----------------------------------------------------------------------- + + get_do_transient_pfts = dyn_subgrid_control_inst%do_transient_pfts + + end function get_do_transient_pfts + + !----------------------------------------------------------------------- + logical function get_do_transient_crops() + ! !DESCRIPTION: + ! Return the value of the do_transient_crops control flag + !----------------------------------------------------------------------- + + get_do_transient_crops = dyn_subgrid_control_inst%do_transient_crops + + end function get_do_transient_crops + + !----------------------------------------------------------------------- + logical function get_do_harvest() + ! !DESCRIPTION: + ! Return the value of the do_harvest control flag + !----------------------------------------------------------------------- + + get_do_harvest = dyn_subgrid_control_inst%do_harvest + + end function get_do_harvest + +end module dynSubgridControlMod diff --git a/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 b/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 new file mode 100644 index 0000000000..1371c30119 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynSubgridDriverMod.F90 @@ -0,0 +1,284 @@ +module dynSubgridDriverMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! + ! !DESCRIPTION: + ! High-level routines for dynamic subgrid areas (prescribed transient Patches, CNDV, and + ! dynamic landunits). + ! + ! !USES: + use dynSubgridControlMod , only : dynSubgridControl_init, get_flanduse_timeseries + use dynSubgridControlMod , only : get_do_transient_pfts, get_do_transient_crops + use dynSubgridControlMod , only : get_do_harvest + use dynPriorWeightsMod , only : prior_weights_type + use UrbanParamsType , only : urbanparams_type + use CNDVType , only : dgvs_type + use CanopyStateType , only : canopystate_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemStateType , only : soilBiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilBiogeochem_carbonflux_type + use EnergyFluxType , only : energyflux_type + use LakeStateType , only : lakestate_type + use PhotosynthesisMod , only : photosyns_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use TemperatureType , only : temperature_type + use glc2lndMod , only : glc2lnd_type + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + ! + public :: dynSubgrid_init ! initialize transient land cover + public :: dynSubgrid_driver ! top-level driver for transient land cover + ! + ! !PRIVATE TYPES: + type(prior_weights_type) :: prior_weights ! saved weights from before the subgrid weight updates + !--------------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine dynSubgrid_init(bounds, dgvs_inst) + ! + ! !DESCRIPTION: + ! Initialize objects needed for prescribed transient PFTs, CNDV, and/or dynamic + ! landunits. + ! + ! This should be called from initialization. + ! + ! Note that no subgrid weights are updated here - so in initialization, weights will + ! stay at the values read from the surface dataset, then there will be a potentially + ! large adjustment of weights in the first time step. The reason why no weights are + ! updated here is that prognostic subgrid weight information (e.g., glacier cover + ! from CISM) is not available in initialization; thus, for consistency, we also avoid + ! applying prescribed transient weights in initialization. + ! + ! However, the above note is only relevant for a cold start run: For a restart run or + ! a run with initial conditions, subgrid weights will be read from the restart file + ! after this routine is called. + ! + ! Note that dynpft_init needs to be called from outside any loops over clumps - so + ! this routine needs to be called from outside any loops over clumps. + ! + ! !USES: + use clm_varctl , only : use_cndv + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use dynpftFileMod , only : dynpft_init + use dyncropFileMod , only : dyncrop_init + use dynHarvestMod , only : dynHarvest_init + use dynCNDVMod , only : dynCNDV_init + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! processor-level bounds + type(dgvs_type) , intent(inout) :: dgvs_inst + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'dynSubgrid_init' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + call dynSubgridControl_init + prior_weights = prior_weights_type(bounds) + + ! Initialize stuff for prescribed transient Patches + if (get_do_transient_pfts()) then + call dynpft_init(bounds, dynpft_filename=get_flanduse_timeseries()) + end if + + ! Initialize stuff for prescribed transient crops + if (get_do_transient_crops()) then + call dyncrop_init(bounds, dyncrop_filename=get_flanduse_timeseries()) + end if + + ! Initialize stuff for harvest. Note that, currently, the harvest data are on the + ! flanduse_timeseries file. However, this could theoretically be changed so that the + ! harvest data were separated from the pftdyn data, allowing them to differ in the + ! years over which they apply. + if (get_do_harvest()) then + call dynHarvest_init(bounds, harvest_filename=get_flanduse_timeseries()) + end if + + if (use_cndv) then + call dynCNDV_init(bounds, dgvs_inst) + end if + + end subroutine dynSubgrid_init + + !----------------------------------------------------------------------- + subroutine dynSubgrid_driver(bounds_proc, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst, & + canopystate_inst, photosyns_inst, dgvs_inst, glc2lnd_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_state_inst, soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! Update subgrid weights for prescribed transient PFTs, CNDV, and/or dynamic + ! landunits. Also do related adjustments (water & energy, carbon & nitrogen). + ! + ! This should be called every time step in CLM's run loop. + ! + ! Note that this routine operates partly at the proc-level (outside an OMP region), + ! and partly at the clump level (inside OMP regions). Thus, this must be called from + ! OUTSIDE any loops over clumps in the driver. + ! + ! !USES: + use clm_time_manager , only : is_first_step + use clm_varctl , only : is_cold_start + use clm_varctl , only : use_cndv, use_cn, create_glacier_mec_landunit, use_ed + use decompMod , only : bounds_type, get_proc_clumps, get_clump_bounds + use decompMod , only : BOUNDS_LEVEL_PROC + use dynLandunitAreaMod , only : update_landunit_weights + use dynInitColumnsMod , only : initialize_new_columns + use dynConsBiogeophysMod , only : dyn_hwcontent_init, dyn_hwcontent_final + use dynConsBiogeochemMod , only : dyn_cnbal_patch + use dynpftFileMod , only : dynpft_interp + use dynCropFileMod , only : dyncrop_interp + use dynHarvestMod , only : dynHarvest_interp + use dynCNDVMod , only : dynCNDV_interp + use dynEDMod , only : dyn_ED + use reweightMod , only : reweight_wrapup + use subgridWeightsMod , only : compute_higher_order_weights, set_subgrid_diagnostic_fields + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds_proc ! processor-level bounds + type(urbanparams_type) , intent(in) :: urbanparams_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(lakestate_type) , intent(in) :: lakestate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + type(canopystate_type) , intent(inout) :: canopystate_inst + type(photosyns_type) , intent(inout) :: photosyns_inst + type(dgvs_type) , intent(inout) :: dgvs_inst + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + integer :: nclumps ! number of clumps on this processor + integer :: nc ! clump index + type(bounds_type) :: bounds_clump ! clump-level bounds + logical :: first_step_cold_start ! true if this is the first step since cold start + + character(len=*), parameter :: subname = 'dynSubgrid_driver' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds_proc%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + nclumps = get_proc_clumps() + first_step_cold_start = (is_first_step() .and. is_cold_start) + + ! ========================================================================== + ! Do initialization, prior to land cover change + ! ========================================================================== + + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + + call dyn_hwcontent_init(bounds_clump, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst) + + call prior_weights%set_prior_weights(bounds_clump) + end do + !$OMP END PARALLEL DO + + ! ========================================================================== + ! Do land cover change that requires I/O, and thus must be outside a threaded region + ! ========================================================================== + + if (get_do_transient_pfts()) then + call dynpft_interp(bounds_proc) + end if + + if (get_do_transient_crops()) then + call dyncrop_interp(bounds_proc) + end if + + if (get_do_harvest()) then + call dynHarvest_interp(bounds_proc) + end if + + ! ========================================================================== + ! Do everything else related to land cover change + ! ========================================================================== + + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + + if (use_cndv) then + call dynCNDV_interp(bounds_clump, dgvs_inst) + end if + + if (use_ed) then + call dyn_ED(bounds_clump) + end if + + if (create_glacier_mec_landunit) then + call glc2lnd_inst%update_glc2lnd(bounds_clump) + end if + + ! Everything following this point in this loop only needs to be called if we have + ! actually changed some weights in this time step. This is also required in the + ! first time step of the run to update filters to reflect state of CISM + ! (particularly mask that is past through coupler). + + call update_landunit_weights(bounds_clump) + + call compute_higher_order_weights(bounds_clump) + + ! Here: filters are re-made + call reweight_wrapup(bounds_clump, & + glc2lnd_inst%icemask_grc(bounds_clump%begg:bounds_clump%endg)) + + call set_subgrid_diagnostic_fields(bounds_clump) + + call initialize_new_columns(bounds_clump, & + prior_weights%cactive(bounds_clump%begc:bounds_clump%endc), & + temperature_inst) + + call dyn_hwcontent_final(bounds_clump, first_step_cold_start, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst) + + if (use_cn) then + call dyn_cnbal_patch(bounds_clump, prior_weights, first_step_cold_start, & + canopystate_inst, photosyns_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_state_inst) + end if + + end do + !$OMP END PARALLEL DO + + end subroutine dynSubgrid_driver + +end module dynSubgridDriverMod diff --git a/components/clm/src/dyn_subgrid/dynTimeInfoMod.F90 b/components/clm/src/dyn_subgrid/dynTimeInfoMod.F90 new file mode 100644 index 0000000000..ff3400db50 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynTimeInfoMod.F90 @@ -0,0 +1,372 @@ +module dynTimeInfoMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains a derived type and associated methods for storing and working with time + ! information for a single dynamic landuse file. The assumption is that there is a + ! single time sample per year. + ! + ! !USES: + use clm_varctl , only : iulog + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + ! + implicit none + private + ! + ! !PUBLIC TYPES: + + ! The following provides an enumeration that defines possible values for one of the + ! components of time_info_type. The public instances of the type (defined below) + ! effectively define the enumeration. + type, public :: year_position_type + private + integer :: flag + end type year_position_type + type(year_position_type), parameter, public :: & + YEAR_POSITION_START_OF_TIMESTEP = year_position_type(1), & + YEAR_POSITION_END_OF_TIMESTEP = year_position_type(2) + + type, public :: time_info_type + private + ! Static information about the file: + integer :: nyears ! number of years in the file + integer, allocatable :: years(:) ! all years in this file + + ! Other static information: + type(year_position_type) :: year_position ! how to obtain the model year relative to the current timestep + + ! Information that potentially changes each time step: + integer :: time_index_lower ! lower bound index of the current interval + integer :: time_index_upper ! upper bound index of the current interval + + contains + procedure :: set_current_year ! should be called every time step to update info with the current model year + procedure :: get_time_index_lower ! get lower bound index of current interval + procedure :: get_time_index_upper ! get upper bound index of current interval + procedure :: get_yearfrac ! get the fractional position in the current year + procedure :: get_year ! get the year associated with a given time index + procedure :: is_within_bounds ! return true if we are currently within the bounds of this file + procedure :: is_before_time_series ! returns true if we are currently prior to the bounds of this file + procedure :: is_after_time_series ! returns true if we are currently after the bounds of this file + ! (if the last year of the file is (e.g.) 2005, then this is TRUE if the current year is 2005) + + procedure, private :: set_info_from_year ! given the current model year, sets object data appropriately + procedure, private :: year_in_current_interval ! returns true if the current year is in the current interval + end type time_info_type + + interface time_info_type + module procedure constructor ! initialize a time_info_type object + end interface time_info_type + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + !----------------------------------------------------------------------- + type(time_info_type) function constructor(my_years, year_position) + ! + ! !DESCRIPTION: + ! Initialize a time_info_type object + ! + ! !ARGUMENTS: + + ! all years in this file: + integer, intent(in) :: my_years(:) + + ! how to obtain the model year relative to the current timestep; must be one of: + ! - YEAR_POSITION_START_OF_TIMESTEP: use the year at the start of the timestep + ! - YEAR_POSITION_END_OF_TIMESTEP: use the year at the end of the timestep + type(year_position_type), intent(in) :: year_position + !----------------------------------------------------------------------- + + constructor%nyears = size(my_years) + allocate(constructor%years(constructor%nyears)) + constructor%years = my_years + constructor%year_position = year_position + + ! Set time_index_lower and time_index_upper arbitrarily; they'll get set correctly by set_current_year + constructor%time_index_lower = 1 + constructor%time_index_upper = 1 + + ! Set time_index_lower and time_index_upper to their correct values + call constructor%set_current_year() + + end function constructor + + + ! ====================================================================== + ! Public methods + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine set_current_year(this) + ! + ! !DESCRIPTION: + ! Update time information (time_index_lower and time_index_upper), based on the + ! current model year. + ! + ! Should be called every time step + ! + ! !USES: + use clm_time_manager , only : get_curr_date, get_prev_date + ! + ! !ARGUMENTS: + class(time_info_type), intent(inout) :: this ! this object + ! + ! !LOCAL VARIABLES: + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + + character(len=*), parameter :: subname = 'set_current_year' + !----------------------------------------------------------------------- + + select case (this%year_position%flag) + case (YEAR_POSITION_START_OF_TIMESTEP%flag) + call get_prev_date(year, mon, day, sec) + case (YEAR_POSITION_END_OF_TIMESTEP%flag) + call get_curr_date(year, mon, day, sec) + case default + write(iulog,*) subname, ': unknown year position: ', this%year_position%flag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + call this%set_info_from_year(year) + + end subroutine set_current_year + + + ! ---------------------------------------------------------------------- + ! Various getter routines + ! ---------------------------------------------------------------------- + + !----------------------------------------------------------------------- + pure integer function get_time_index_lower(this) + ! !DESCRIPTION: Get lower bound index of current interval + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + !----------------------------------------------------------------------- + + get_time_index_lower = this%time_index_lower + end function get_time_index_lower + + !----------------------------------------------------------------------- + pure integer function get_time_index_upper(this) + ! !DESCRIPTION: Get upper bound index of current interval + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + !----------------------------------------------------------------------- + + get_time_index_upper = this%time_index_upper + end function get_time_index_upper + + !----------------------------------------------------------------------- + real(r8) function get_yearfrac(this) + ! + ! !DESCRIPTION: + ! Get the fractional position in the current year (0 at midnight on Jan 1, and 1 at + ! the end of Dec 31). + ! + ! This function uses the year_position metadata of this object to determine whether + ! the fractional position in the year should be determined based on the start or end + ! of the current timestep. + ! + ! !USES: + use clm_time_manager, only : get_curr_yearfrac, get_prev_yearfrac + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_yearfrac' + !----------------------------------------------------------------------- + + select case (this%year_position%flag) + case (YEAR_POSITION_START_OF_TIMESTEP%flag) + get_yearfrac = get_prev_yearfrac() + case (YEAR_POSITION_END_OF_TIMESTEP%flag) + get_yearfrac = get_curr_yearfrac() + case default + write(iulog,*) subname, ': unknown year position: ', this%year_position%flag + call endrun(errMsg(__FILE__, __LINE__)) + end select + + end function get_yearfrac + + + !----------------------------------------------------------------------- + integer function get_year(this, nt) + ! !DESCRIPTION: Get the year associated with time index nt + ! + ! Note this can't be a pure function because of the call to shr_assert + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + integer , intent(in) :: nt ! time index + + character(len=*), parameter :: subname = 'get_year' + !----------------------------------------------------------------------- + + SHR_ASSERT(1 <= nt .and. nt <= this%nyears, subname // ': nt out of bounds') + get_year = this%years(nt) + end function get_year + + !----------------------------------------------------------------------- + pure logical function is_within_bounds(this) + ! !DESCRIPTION: Returns true if we are currently within the bounds of this file + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + !----------------------------------------------------------------------- + + is_within_bounds = ((.not. this%is_before_time_series()) .and. & + (.not. this%is_after_time_series())) + + end function is_within_bounds + + !----------------------------------------------------------------------- + pure logical function is_before_time_series(this) + ! !DESCRIPTION: Returns true if we are currently prior to the bounds of this file + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + !----------------------------------------------------------------------- + + if (this%time_index_upper == 1) then + is_before_time_series = .true. + else + is_before_time_series = .false. + end if + end function is_before_time_series + + !----------------------------------------------------------------------- + pure logical function is_after_time_series(this) + ! !DESCRIPTION: Returns true if we are currently after the bounds of this file + ! + ! If the last year of the file is (e.g.) 2005, then this is TRUE if the current year + ! is 2005 + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this + !----------------------------------------------------------------------- + + if (this%time_index_lower == this%nyears) then + is_after_time_series = .true. + else + is_after_time_series = .false. + end if + end function is_after_time_series + + ! ====================================================================== + ! Private methods + ! ====================================================================== + + !----------------------------------------------------------------------- + pure logical function year_in_current_interval(this, cur_year) + ! !DESCRIPTION: + ! Returns true if the current year is in the current interval + ! + ! !ARGUMENTS: + class(time_info_type), intent(in) :: this ! this object + integer, intent(in) :: cur_year ! current model year + !----------------------------------------------------------------------- + + if (this%years(this%time_index_lower) == cur_year .and. this%years(this%time_index_upper) == (cur_year + 1)) then + ! Normal case: we're within the time series, in the same interval as before + year_in_current_interval = .true. + else if (this%is_before_time_series() .and. cur_year < this%years(1)) then + ! We were and still are before the time series + year_in_current_interval = .true. + else if (this%is_after_time_series() .and. cur_year >= this%years(this%nyears)) then + ! We were and still are after the time series + year_in_current_interval = .true. + else + year_in_current_interval = .false. + end if + + end function year_in_current_interval + + !----------------------------------------------------------------------- + subroutine set_info_from_year(this, cur_year) + ! + ! !DESCRIPTION: + ! Given the current model year, sets time information (time_index_lower and + ! time_index_upper) appropriately. + ! + ! !ARGUMENTS: + class(time_info_type), intent(inout) :: this ! this object + integer, intent(in) :: cur_year ! current model year + ! + ! !LOCAL VARIABLES: + logical :: found ! has the correct interval been found? + integer :: n ! interval index + + character(len=*), parameter :: subname = 'set_info_from_year' + !----------------------------------------------------------------------- + + ! Determine if current date spans the years + ! + ! If current year is less than first timeseries year, then use the first year from + ! dynamic land cover file for both time_index_lower and time_index_upper, forcing constant weights until the + ! model year enters the dynamic land cover dataset timeseries range. + ! + ! If current year is equal to or greater than the last timeseries year, then use the + ! last year for both time_index_lower and time_index_upper, forcing constant weights for the remainder of the + ! simulation. + ! + ! This mechanism permits the introduction of a dynamic pft period in the middle of a + ! simulation, with constant weights before and after the dynamic period. + + associate( & + nyears => this%nyears, & + years => this%years, & + time_index_lower => this%time_index_lower, & + time_index_upper => this%time_index_upper) + + if (year_in_current_interval(this, cur_year)) then + ! DO NOTHING - NT1 AND NT2 ARE ALREADY CORRECT + else + if (cur_year < years(1)) then + ! prior to the first interval + time_index_lower = 1 + time_index_upper = 1 + else if (cur_year >= years(nyears)) then + ! past the last interval + time_index_lower = nyears + time_index_upper = nyears + else + ! within the time bounds of the file + found = .false. + do n = 1, nyears-1 + if (cur_year == years(n)) then + time_index_lower = n + time_index_upper = n + 1 + found = .true. + exit + end if + end do + if (.not. found) then + write(iulog,*) subname//' ERROR: model year not found in pftdyn timeseries' + write(iulog,*)'model year = ',cur_year + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + end if + + SHR_ASSERT(time_index_upper <= nyears, subname // ': time_index_upper should not be greater than nyears') + + end associate + + end subroutine set_info_from_year + +end module dynTimeInfoMod diff --git a/components/clm/src/dyn_subgrid/dynVarMod.F90.in b/components/clm/src/dyn_subgrid/dynVarMod.F90.in new file mode 100644 index 0000000000..30b9e0fe5a --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynVarMod.F90.in @@ -0,0 +1,321 @@ +module dynVarMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains a derived type and associated methods for working with a single dynamic + ! subgrid variable, which may or may not need time interpolation. + ! + ! This is an abstract type that needs to be extended by a specific derived type + ! (dyn_var_time_uninterp_type or dyn_var_time_interp_type). Besides the lack of + ! definition of some methods, also note that it does NOT define the data + ! themselves. This is because different type extensions have different needs for what + ! data are stored - and particularly whether they need data at just time_index_lower, or data at both + ! time_index_lower and time_index_upper. + ! + ! The use of this class (or its extensions) is: + ! In initialization: + ! - create a new object using the appropriate constructor (a constructor for one of + ! the children of dyn_var_type) + ! - call get_current_data to get the initial data + ! + ! Each time through the run loop: + ! - call get_current_data to get the current value of the data + ! + ! Note that, because of the reads that are done here, the methods of this class should + ! NOT be called from inside threaded regions or loops over clumps + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use dynFileMod , only : dyn_file_type + use dynTimeInfoMod , only : time_info_type + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + implicit none + private + ! + ! !PUBLIC TYPES: + + ! maximum number of real dimensions allowed for the underlying variables stored in + ! dyn_var_type + integer, parameter, public :: dyn_var_max_dims = 2 + + public :: dyn_var_type + + ! This is an abstract base class that should be extended. + ! + ! Any type extension needs to define the following methods: + ! - get_current_data_1d + ! - get_current_data_2d + ! - read_data_if_needed + ! + ! In addition, a type extension needs to define the data field(s); these are not defined + ! in the base class because different type extensions have different needs for what data + ! are stored - and particularly whether they need data at just time_index_lower, or data at both time_index_lower + ! and time_index_upper. + ! + ! Although this base class doesn't define the data themselves, note that the + ! implementation here assumes that the data will be stored as a 1-d vector, even if the + ! data are truly 2-d. i.e., the type extension should define its data as: + ! real(r8), allocatable :: data_at_tlower(:) + type, abstract :: dyn_var_type + private + type(dyn_file_type), pointer :: dyn_file ! pointer to the file containing this variable + character(len=256) :: varname ! variable name on file + character(len=256) :: dim1name ! dim1name on file + real(r8) :: conversion_factor ! data are DIVIDED by conversion_factor immediately after reading them + + ! Only relevant for 2-d variables: should we check to make sure that all sums equal 1? + logical :: do_check_sums_equal_1 + + ! Shape of data; max number of dimensions is given by dyn_var_max_dims in dynVarMod. + ! First dimension is the spatial dimension. + ! This is a pointer rather than an allocatable to work around a pgi compiler bug + ! (pgi 13.9) + integer, pointer :: data_shape(:) + contains + ! Public methods: + + ! The following are public only for the sake of type extensions of this base class; + ! they should not be used outside of these type extensions + procedure :: set_metadata ! Set metadata that are common to all type extensions of this base class + procedure :: get_dyn_file ! Get the dyn_file component + procedure :: get_data_shape ! Get the data_shape component + procedure :: read_variable ! Wrapper to read a time slice of the variable + + ! The following need to be defined by any type extensions; they need to be public so + ! they can be overridden, but they should not be used outside of type extensions + procedure(get_current_data_1d_interface), deferred :: get_current_data_1d ! Get the current value of the data, for a 1-d variable + procedure(get_current_data_2d_interface), deferred :: get_current_data_2d ! Get the current value of the daat, for a 2-d variable + procedure(read_data_if_needed_interface), deferred :: read_data_if_needed ! Read the next time slice of data, if necessary + + ! Private methods: + procedure, private :: read_variable_1d ! Read a time slice of a 1-d variable + procedure, private :: read_variable_2d ! Read a time slice of a 2-d variable + end type dyn_var_type + + abstract interface + + subroutine read_data_if_needed_interface(this) + ! !DESCRIPTION: + ! Determine if new data need to be read from the file; if so, read them. + ! + ! !USES: + import :: dyn_var_type + ! + ! !ARGUMENTS: + class(dyn_var_type), intent(inout) :: this ! this object + end subroutine read_data_if_needed_interface + + ! DIMS 1,2 + subroutine get_current_data_{DIMS}d_interface(this, cur_data) + ! !DESCRIPTION: + ! Get the current (possibly interpolated) value of the data, in cur_data. cur_data + ! should have the same dimensionality as the underlying data, as given by the + ! data_shape argument that was passed to the constructor. + ! + ! If necessary, new data are read from the file. + ! + ! Should be called once per time step, AFTER calling set_current_year on the + ! underlying dyn_file variable + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + import :: dyn_var_type + ! + ! !ARGUMENTS: + class(dyn_var_type) , intent(inout) :: this ! this object + real(r8) , intent(out) :: cur_data{DIMSTR} ! current value of data + end subroutine get_current_data_{DIMS}d_interface + + end interface + + +contains + + ! ====================================================================== + ! Public methods + ! + ! The following are public only for the sake of type extensions of this base class. + ! They should not be used outside these type extensions. + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine set_metadata(this, dyn_file, varname, dim1name, conversion_factor, & + do_check_sums_equal_1, data_shape) + ! + ! !DESCRIPTION: + ! Set metadata that are common to all type extensions of this base class + ! + ! !USES: + ! + ! !ARGUMENTS: + class(dyn_var_type) , intent(inout) :: this ! this object + type(dyn_file_type) , target, intent(in) :: dyn_file ! file containing this variable + character(len=*) , intent(in) :: varname ! variable name on file + character(len=*) , intent(in) :: dim1name ! dim1name on file + real(r8) , intent(in) :: conversion_factor ! data are DIVIDED by conversion_factor immediately after reading them + + ! Only relevant for 2-d variables: should we check to make sure that all sums equal 1? + logical, intent(in) :: do_check_sums_equal_1 + + ! Shape of data; max number of dimensions is given by dyn_var_max_dims in dynVarMod. + ! First dimension is the spatial dimension. + integer, intent(in) :: data_shape(:) + + ! + ! !LOCAL VARIABLES: + integer :: ndims ! number of dimensions in data + + character(len=*), parameter :: subname = 'set_metadata' + !----------------------------------------------------------------------- + + ndims = size(data_shape) + + ! Do some error checking on the inputs + SHR_ASSERT(ndims <= dyn_var_max_dims, subname//' ERROR: ndims must be <= dyn_var_max_dims') + if (do_check_sums_equal_1) then + SHR_ASSERT(ndims == 2, subname//' ERROR: do_check_sums_equal_1 only valid for ndims==2') + end if + + ! Set metadata for this variable + this%dyn_file => dyn_file + this%varname = varname + this%dim1name = dim1name + this%conversion_factor = conversion_factor + this%do_check_sums_equal_1 = do_check_sums_equal_1 + allocate(this%data_shape(ndims)) + this%data_shape = data_shape + + end subroutine set_metadata + + + !----------------------------------------------------------------------- + function get_dyn_file(this) + ! + ! !DESCRIPTION: + ! Get the dyn_file component of this object + ! + ! !ARGUMENTS: + type(dyn_file_type) , pointer :: get_dyn_file + class(dyn_var_type) , intent(in) :: this ! this object + !----------------------------------------------------------------------- + get_dyn_file => this%dyn_file + end function get_dyn_file + + !----------------------------------------------------------------------- + function get_data_shape(this) + ! + ! !DESCRIPTION: + ! Get the data_shape component of this object + ! + ! !ARGUMENTS: + integer , allocatable :: get_data_shape(:) + class(dyn_var_type) , intent(in) :: this ! this object + !----------------------------------------------------------------------- + allocate(get_data_shape(size(this%data_shape))) + get_data_shape = this%data_shape + end function get_data_shape + + + !----------------------------------------------------------------------- + subroutine read_variable(this, nt, data) + ! + ! !DESCRIPTION: + ! Wrapper to read a time slice of the variable; result goes in the data argument. + ! + ! !USES: + use spmdMod , only : masterproc + ! + ! !ARGUMENTS: + class(dyn_var_type) , intent(inout) :: this ! this object + integer , intent(in) :: nt ! time index to read + real(r8) , intent(out) :: data(:) ! variable holding data read from file + ! + ! !LOCAL VARIABLES: + integer :: ndims ! number of dimensions of the underlying variable + + character(len=*), parameter :: subname = 'read_variable' + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Get data for variable ', trim(this%varname), ' for year ', & + this%dyn_file%time_info%get_year(nt) + end if + + ndims = size(this%data_shape) + if (ndims == 1) then + call read_variable_1d(this, nt, data) + else if (ndims == 2) then + call read_variable_2d(this, nt, data) + else + call endrun(msg='ERROR: read_variable can only handle 1 or 2 dimensions'//& + errMsg(__FILE__, __LINE__)) + end if + + end subroutine read_variable + + + ! ====================================================================== + ! Private methods + ! ====================================================================== + + ! DIMS 1,2 + !----------------------------------------------------------------------- + subroutine read_variable_{DIMS}d(this, nt, data) + ! + ! !DESCRIPTION: + ! Read a time slice of a {DIMS}-d variable + ! This routine applies the conversion given by conversion_factor. + ! + ! !USES: + use ncdio_pio , only : ncd_io + use surfrdUtilsMod , only : check_sums_equal_1 + ! + ! !ARGUMENTS: + class(dyn_var_type) , intent(inout) :: this ! this object (needs to be intent(inout) because this%dynfile is intent(inout) in the ncd_io call) + integer , intent(in) :: nt ! time index to read + ! variable holding data read from file (note that this is 1-d regardless of the + ! dimensionality of the underlying data) + real(r8) , intent(out) :: data(:) + ! + ! !LOCAL VARIABLES: + real(r8), pointer :: arrayl{DIMSTR} ! temporary array to hold data (needs to be a pointer) + logical :: readvar ! whether variable was read + + character(len=*), parameter :: subname = 'read_variable_{DIMS}d' + !----------------------------------------------------------------------- + + ! The following doesn't seem to be allowed: + ! allocate(arrayl(this%data_shape)) + ! So instead we have to do this in a more ugly way: +#if ({DIMS}==1) + allocate(arrayl(this%data_shape(1))) +#elif ({DIMS}==2) + allocate(arrayl(this%data_shape(1), this%data_shape(2))) +#endif + + call ncd_io(ncid=this%dyn_file, varname=this%varname, flag='read', data=arrayl, & + dim1name=this%dim1name, nt=nt, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: ' // trim(this%varname) // ' NOT on file'//& + errMsg(__FILE__, __LINE__)) + end if + + arrayl = arrayl / this%conversion_factor + + ! The following needs to be in an ifdef because the check_sums_equal_1 interface + ! requires a 2-d array +#if ({DIMS}==2) + if (this%do_check_sums_equal_1) then + call check_sums_equal_1(arrayl, 1, this%varname, subname) + end if +#endif + + data = reshape(arrayl, shape(data)) + deallocate(arrayl) + end subroutine read_variable_{DIMS}d + +end module dynVarMod diff --git a/components/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in b/components/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in new file mode 100644 index 0000000000..614b3d4d33 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynVarTimeInterpMod.F90.in @@ -0,0 +1,219 @@ +module dynVarTimeInterpMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains a derived type and associated methods that extend the base class, + ! dyn_var_type. The type defined here is for variables that SHOULD be interpolated in + ! time. For variables of this type, the data have the value given on year Y of the file + ! at midnight on Jan. 1 at the start of year Y. The value then gets linearly + ! interpolated over the year, so that by Dec. 31 of year Y, the value is close to the + ! file's value at year Y+1. Before the start of the time series, the data are fixed at + ! their value from the first year in the file; after the end of the time series, the + ! data are fixed at their value from the last year in the file. If the last year on the + ! file is X, then the data are fixed at this last value (and thus do not vary) + ! throughout year X. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use dynVarMod , only : dyn_var_type + + implicit none + private + ! + ! !PUBLIC TYPES: + public :: dyn_var_time_interp_type + + type, extends(dyn_var_type) :: dyn_var_time_interp_type + private + ! Note that data are stored as 1-d, then converted to the appropriate dimensionality + ! as needed + real(r8), allocatable :: data_at_tlower(:) ! data at time time_index_lower + real(r8), allocatable :: data_at_tupper(:) ! data at time time_index_upper + + integer :: time_index_lower ! current time_index_lower curresponding to data_at_tlower + integer :: time_index_upper ! current time_index_upper curresponding to data_at_tupper + contains + generic :: get_current_data => & ! Get the current value of the data + get_current_data_1d, get_current_data_2d + procedure :: get_current_data_1d ! Get the current value of the data, for a 1-d variable + procedure :: get_current_data_2d ! Get the current value of the data, for a 2-d variable + procedure :: read_data_if_needed ! Read the next time slice of data, if necessary + end type dyn_var_time_interp_type + + interface dyn_var_time_interp_type + module procedure constructor ! initialize a new dyn_var_time_interp object + end interface dyn_var_time_interp_type + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + !----------------------------------------------------------------------- + type(dyn_var_time_interp_type) function constructor( & + dyn_file, varname, dim1name, conversion_factor, & + do_check_sums_equal_1, data_shape) + ! + ! !DESCRIPTION: + ! Creates an object of type dyn_var_time_interp_type. This also reads the first + ! set of data. + ! + ! Assumes that dyn_file has already been initialized. + ! + ! !USES: + use dynFileMod , only : dyn_file_type + use dynTimeInfoMod , only : time_info_type + ! + ! !ARGUMENTS: + type(dyn_file_type), target, intent(in) :: dyn_file ! file containing this variable + character(len=*), intent(in) :: varname ! variable name on file + character(len=*), intent(in) :: dim1name ! dim1name on file + real(r8), intent(in) :: conversion_factor ! data are DIVIDED by conversion_factor immediately after reading them + + ! Only relevant for 2-d variables: should we check to make sure that all sums equal 1? + logical, intent(in) :: do_check_sums_equal_1 + + ! Shape of data; max number of dimensions is given by dyn_var_max_dims in dynVarMod. + ! First dimension is the spatial dimension. + integer, intent(in) :: data_shape(:) + !----------------------------------------------------------------------- + + ! Set metadata common to all dyn_var_type objects + call constructor%set_metadata( & + dyn_file=dyn_file, & + varname=varname, & + dim1name=dim1name, & + conversion_factor=conversion_factor, & + do_check_sums_equal_1=do_check_sums_equal_1, & + data_shape=data_shape) + + ! Allocate space for data + allocate(constructor%data_at_tlower(product(data_shape))) + allocate(constructor%data_at_tupper(product(data_shape))) + + ! Read first set of data + constructor%time_index_lower = dyn_file%time_info%get_time_index_lower() + constructor%time_index_upper = dyn_file%time_info%get_time_index_upper() + call constructor%read_variable(constructor%time_index_lower, constructor%data_at_tlower) + call constructor%read_variable(constructor%time_index_upper, constructor%data_at_tupper) + end function constructor + + ! ====================================================================== + ! Public methods + ! ====================================================================== + + ! The following specific procedures are NOT actually public, but they can be accessed + ! via the generic type-bound procedure, get_current_data + + ! DIMS 1,2 + !----------------------------------------------------------------------- + subroutine get_current_data_{DIMS}d(this, cur_data) + ! + ! !DESCRIPTION: + ! Get the current, interpolated value of the data, in cur_data. cur_data should have + ! the same dimensionality as the underlying data, as given by the data_shape argument + ! that was passed to the constructor. + ! + ! If necessary, new data are read from the file. + ! + ! Should be called once per time step, AFTER calling set_current_year on the + ! underlying dyn_file variable + ! + ! !USES: + use dynFileMod , only : dyn_file_type + ! + ! !ARGUMENTS: + class(dyn_var_time_interp_type) , intent(inout) :: this ! this object + real(r8) , intent(out) :: cur_data{DIMSTR} ! current value of data + ! + ! !LOCAL VARIABLES: + type(dyn_file_type), pointer :: dyn_file ! the dyn_file of this object + integer :: ndims ! ndims of data in 'this' + real(r8) :: wt1 ! weight of time1 (the left-hand time point) + real(r8), allocatable :: cur_data_1d(:) ! 1-d version of data at the current time + character(len=*), parameter :: subname = 'get_current_data_{DIMS}d' + !----------------------------------------------------------------------- + + ! Do some error checking + ndims = size(this%get_data_shape()) + SHR_ASSERT({DIMS} == ndims, subname//' ERROR: # dims of output argument must match ndims') + SHR_ASSERT_ALL((shape(cur_data) == this%get_data_shape()), subname//' ERROR: shape of cur_data must match shape of data') + + ! Get current data, using a temporal weighting of the data at time 1 and the data at + ! time 2 + call this%read_data_if_needed() + allocate(cur_data_1d(size(this%data_at_tlower))) + + dyn_file => this%get_dyn_file() + wt1 = 1.0_r8 - dyn_file%time_info%get_yearfrac() + + cur_data_1d(:) = this%data_at_tupper(:) + wt1*(this%data_at_tlower(:) - this%data_at_tupper(:)) + cur_data = reshape(cur_data_1d, shape(cur_data)) + deallocate(cur_data_1d) + + end subroutine get_current_data_{DIMS}d + + ! ====================================================================== + ! Private methods + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine read_data_if_needed(this) + ! + ! !DESCRIPTION: + ! Determine if new data need to be read from the file; if so, read them. + ! + ! We need to read new data (or at least copy them) if the current time on dyn_file + ! disagrees with the time for which we currently have stored data, for either time time_index_lower + ! or time time_index_upper + ! + ! !USES: + use dynFileMod , only : dyn_file_type + use dynTimeInfoMod , only : time_info_type + ! + ! !ARGUMENTS: + class(dyn_var_time_interp_type), intent(inout) :: this ! this object + ! + ! !LOCAL VARIABLES: + type(dyn_file_type), pointer :: dyn_file ! the dyn_file of this object + integer :: time_index_lower_cur ! current value of time_index_lower on dyn_fileb + integer :: time_index_upper_cur ! current value of time_index_upper on dyn_fileb + + character(len=*), parameter :: subname = 'read_data_if_needed' + !----------------------------------------------------------------------- + + dyn_file => this%get_dyn_file() + time_index_lower_cur = dyn_file%time_info%get_time_index_lower() + time_index_upper_cur = dyn_file%time_info%get_time_index_upper() + + ! If time_index_lower time has changed, get a new set of data for time time_index_lower + if (time_index_lower_cur /= this%time_index_lower) then + + ! The typical case is that we have moved forward by a single time; thus we can + ! avoid an extra read by simply setting the new data at time_index_lower equal to the old data + ! at time_index_upper + if (time_index_lower_cur == this%time_index_upper) then + this%data_at_tlower(:) = this%data_at_tupper(:) + + ! Otherwise, handle the general (but atypical) case where we have not moved + ! forward by a single time + else + call this%read_variable(time_index_lower_cur, this%data_at_tlower) + end if + + this%time_index_lower = time_index_lower_cur + end if + + ! If time_index_upper time has changed, read a new set of data for time time_index_upper + if (time_index_upper_cur /= this%time_index_upper) then + call this%read_variable(time_index_upper_cur, this%data_at_tupper) + this%time_index_upper = time_index_upper_cur + end if + + end subroutine read_data_if_needed + + +end module dynVarTimeInterpMod diff --git a/components/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90.in b/components/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90.in new file mode 100644 index 0000000000..41ae67b3ac --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynVarTimeUninterpMod.F90.in @@ -0,0 +1,174 @@ +module dynVarTimeUninterpMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains a derived type and associated methods that extend the base class, + ! dyn_var_type. The type defined here is for variables that should NOT be interpolated + ! in time. For variables of this type, the data will snap to their new value at the + ! beginning of each year, and then stay fixed throughout the year. Before the start of + ! the time series, the data are fixed at their value from the first year in the file; + ! after the end of the time series, the data are fixed at their value from the last year + ! in the file. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use dynVarMod , only : dyn_var_type + + implicit none + private + save + + ! !PUBLIC TYPES: + public :: dyn_var_time_uninterp_type + + type, extends(dyn_var_type) :: dyn_var_time_uninterp_type + private + ! Note that data are stored as 1-d, then converted to the appropriate dimensionality + ! as needed + real(r8), allocatable :: data_at_tlower(:) ! data at time time_index_lower + integer :: time_index_lower ! current time_index_lower corresponding to the data + contains + generic :: get_current_data => & ! Get the current value of the data + get_current_data_1d, get_current_data_2d + procedure :: get_current_data_1d ! Get the current value of the data, for a 1-d variable + procedure :: get_current_data_2d ! Get the current value of the data, for a 2-d variable + procedure :: read_data_if_needed ! Read the next time slice of data, if necessary + end type dyn_var_time_uninterp_type + + interface dyn_var_time_uninterp_type + module procedure constructor ! initialize a new dyn_var_time_uninterp_type object + end interface dyn_var_time_uninterp_type + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + !----------------------------------------------------------------------- + type(dyn_var_time_uninterp_type) function constructor( & + dyn_file, varname, dim1name, conversion_factor, & + do_check_sums_equal_1, data_shape) + ! + ! !DESCRIPTION: + ! Creates an object of type dyn_var_time_uninterp_type. This also reads the first + ! set of data. + ! + ! Assumes that dyn_file has already been initialized. + ! + ! !USES: + use dynFileMod , only : dyn_file_type + use dynTimeInfoMod , only : time_info_type + ! + ! !ARGUMENTS: + type(dyn_file_type), target, intent(in) :: dyn_file ! file containing this variable + character(len=*), intent(in) :: varname ! variable name on file + character(len=*), intent(in) :: dim1name ! dim1name on file + real(r8), intent(in) :: conversion_factor ! data are DIVIDED by conversion_factor immediately after reading them + + ! Only relevant for 2-d variables: should we check to make sure that all sums equal 1? + logical, intent(in) :: do_check_sums_equal_1 + + ! Shape of data; max number of dimensions is given by dyn_var_max_dims in dynVarMod. + ! First dimension is the spatial dimension. + integer, intent(in) :: data_shape(:) + !----------------------------------------------------------------------- + + ! Set metadata common to all dyn_var_type objects + call constructor%set_metadata( & + dyn_file=dyn_file, & + varname=varname, & + dim1name=dim1name, & + conversion_factor=conversion_factor, & + do_check_sums_equal_1=do_check_sums_equal_1, & + data_shape=data_shape) + + ! Allocate space for data + allocate(constructor%data_at_tlower(product(data_shape))) + + ! Read first set of data + constructor%time_index_lower = dyn_file%time_info%get_time_index_lower() + call constructor%read_variable(constructor%time_index_lower, constructor%data_at_tlower) + end function constructor + + ! ====================================================================== + ! Public methods + ! ====================================================================== + + ! The following specific procedures are NOT actually public, but they can be accessed + ! via the generic type-bound procedure, get_current_data + + ! DIMS 1,2 + !----------------------------------------------------------------------- + subroutine get_current_data_{DIMS}d(this, cur_data) + ! + ! !DESCRIPTION: + ! Get the current value of the data, in cur_data. cur_data should have the same + ! dimensionality as the underlying data, as given by the data_shape argument that was + ! passed to the constructor. + ! + ! If necessary, new data are read from the file. + ! + ! Should be called once per time step, AFTER calling set_current_year on the + ! underlying dyn_file variable + ! + ! !ARGUMENTS: + class(dyn_var_time_uninterp_type) , intent(inout) :: this ! this object + real(r8) , intent(out) :: cur_data{DIMSTR} ! current value of data + ! + ! !LOCAL VARIABLES: + integer :: ndims ! ndims of data in 'this' + + character(len=*), parameter :: subname = 'get_current_data_{DIMS}d' + !----------------------------------------------------------------------- + + ! Do some error checking + ndims = size(this%get_data_shape()) + SHR_ASSERT({DIMS} == ndims, subname//' ERROR: # dims of output argument must match ndims') + SHR_ASSERT_ALL((shape(cur_data) == this%get_data_shape()), subname//' ERROR: shape of cur_data must match shape of data') + + ! Get current data + call this%read_data_if_needed() + cur_data = reshape(this%data_at_tlower, shape(cur_data)) + + end subroutine get_current_data_{DIMS}d + + ! ====================================================================== + ! Private methods + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine read_data_if_needed(this) + ! + ! !DESCRIPTION: + ! Determine if new data need to be read from the file; if so, read them. + ! + ! We need to read new data if the current time on dyn_file disagrees with the time + ! for which we currently have stored data. + ! + ! !USES: + use dynFileMod , only : dyn_file_type + use dynTimeInfoMod , only : time_info_type + ! + ! !ARGUMENTS: + class(dyn_var_time_uninterp_type), intent(inout) :: this ! this object + ! + ! !LOCAL VARIABLES: + type(dyn_file_type), pointer :: dyn_file ! the dyn_file of this object + integer :: time_index_lower_cur ! current value of time_index_lower on dyn_file + + character(len=*), parameter :: subname = 'read_data_if_needed' + !----------------------------------------------------------------------- + + dyn_file => this%get_dyn_file() + time_index_lower_cur = dyn_file%time_info%get_time_index_lower() + if (time_index_lower_cur /= this%time_index_lower) then + call this%read_variable(time_index_lower_cur, this%data_at_tlower) + this%time_index_lower = time_index_lower_cur + end if + end subroutine read_data_if_needed + + +end module dynVarTimeUninterpMod diff --git a/components/clm/src/dyn_subgrid/dyncropFileMod.F90 b/components/clm/src/dyn_subgrid/dyncropFileMod.F90 new file mode 100644 index 0000000000..ea99926c49 --- /dev/null +++ b/components/clm/src/dyn_subgrid/dyncropFileMod.F90 @@ -0,0 +1,178 @@ +module dyncropFileMod + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle reading of the dataset that specifies transient areas the crop landunit as + ! well as the breakdown of each crop. + ! + ! !USES: +#include "shr_assert.h" + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use dynFileMod , only : dyn_file_type + use dynVarTimeUninterpMod , only : dyn_var_time_uninterp_type + use clm_varctl , only : iulog + use clm_varcon , only : grlnd, namec + use abortutils , only : endrun + use spmdMod , only : masterproc, mpicom + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + save + public :: dyncrop_init ! initialize information read from landuse.timeseries dataset + public :: dyncrop_interp ! get crop data for the current time step, if needed + ! + ! ! PRIVATE TYPES + type(dyn_file_type), target :: dyncrop_file ! information for the file containing transient crop data + type(dyn_var_time_uninterp_type) :: wtcrop ! weight of the crop landunit + type(dyn_var_time_uninterp_type) :: wtcft ! weight of each CFT relative to the crop landunit + + ! Names of variables on file + character(len=*), parameter :: crop_varname = 'PCT_CROP' + character(len=*), parameter :: cft_varname = 'PCT_CFT' + !--------------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine dyncrop_init(bounds, dyncrop_filename) + ! + ! !DESCRIPTION: + ! Initialize dataset containing transient crop info (position it to the right time + ! samples that bound the initial model date) + ! + ! !USES: + use clm_varpar , only : cft_size + use ncdio_pio , only : check_dim + use dynTimeInfoMod , only : YEAR_POSITION_START_OF_TIMESTEP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! proc-level bounds + character(len=*) , intent(in) :: dyncrop_filename ! name of file containing transient crop information + ! + ! !LOCAL VARIABLES: + integer :: num_points ! number of spatial points + integer :: wtcft_shape(2) ! shape of the wtcft data + + character(len=*), parameter :: subname = 'dyncrop_init' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + if (masterproc) then + write(iulog,*) 'Attempting to read crop dynamic landuse data .....' + end if + + ! Get the year from the START of the timestep; this way, we'll update crop areas + ! starting after the year boundary. This is consistent with the timing of glacier + ! updates, and will likely be consistent with the timing of crop updates determined + ! prognostically, if crop areas are ever determined prognostically rather than + ! prescribed ahead of time. + dyncrop_file = dyn_file_type(dyncrop_filename, YEAR_POSITION_START_OF_TIMESTEP) + call check_dim(dyncrop_file, 'cft', cft_size) + + ! read data PCT_CROP and PCT_CFT corresponding to correct year + ! + ! Note: if you want to change transient crops so that they are interpolated, rather + ! than jumping to each year's value on Jan 1 of that year, simply change wtcrop and + ! wtcft to be of type dyn_var_time_interp_type (rather than + ! dyn_var_time_uninterp_type), and change the following constructors to construct + ! variables of dyn_var_time_interp_type. That's all you need to do. + num_points = (bounds%endg - bounds%begg + 1) + wtcrop = dyn_var_time_uninterp_type( & + dyn_file = dyncrop_file, varname=crop_varname, & + dim1name=grlnd, conversion_factor=100._r8, & + do_check_sums_equal_1=.false., data_shape=[num_points]) + wtcft_shape = [num_points, cft_size] + wtcft = dyn_var_time_uninterp_type( & + dyn_file = dyncrop_file, varname=cft_varname, & + dim1name=grlnd, conversion_factor=100._r8, & + do_check_sums_equal_1=.true., data_shape=wtcft_shape) + + end subroutine dyncrop_init + + !----------------------------------------------------------------------- + subroutine dyncrop_interp(bounds) + ! + ! !DESCRIPTION: + ! Get crop cover for model time, when needed. + ! + ! Sets col%wtlunit and lun%wtgcell for crop landunits. + ! + ! Note that crop cover currently jumps to its new value at the start of the year. + ! However, as mentioned above, this behavior can be changed to time interpolation + ! simply by making wtcrop and wtcft dyn_var_time_interp_type variables rather than + ! dyn_var_time_uninterp_type. + ! + ! !USES: + use landunit_varcon , only : istcrop + use clm_varpar , only : cft_lb, cft_ub + use subgridWeightsMod , only : set_landunit_weight + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! proc-level bounds + ! + ! !LOCAL VARIABLES: + integer :: m,p,c,l,g ! indices + real(r8), allocatable :: wtcrop_cur(:) ! current weight of the crop landunit + real(r8), allocatable :: wtcft_cur(:,:) ! current cft weights + logical , allocatable :: col_set(:) ! whether we have set the weight for each column + + character(len=*), parameter :: subname = 'dyncrop_interp' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + call dyncrop_file%time_info%set_current_year() + + ! Set new landunit area + allocate(wtcrop_cur(bounds%begg:bounds%endg)) + call wtcrop%get_current_data(wtcrop_cur) + do g = bounds%begg, bounds%endg + call set_landunit_weight(g, istcrop, wtcrop_cur(g)) + end do + deallocate(wtcrop_cur) + + ! Set new CFT weights + ! + ! Assumes that memory has been allocated for all CFTs on the crop landunit, and that + ! each crop is on its own column. + allocate(wtcft_cur(bounds%begg:bounds%endg, cft_lb:cft_ub)) + call wtcft%get_current_data(wtcft_cur) + + allocate(col_set(bounds%begc:bounds%endc)) + col_set(:) = .false. + + do p = bounds%begp, bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + c = patch%column(p) + + if (lun%itype(l) == istcrop) then + m = patch%itype(p) + + ! The following assumes there is a single CFT on each crop column. The + ! error-check with col_set helps ensure this is the case. + + if (col_set(c)) then + write(iulog,*) subname//' ERROR: attempt to set a column that has already been set.' + write(iulog,*) 'This may happen if there are multiple crops on a single column.' + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + + col%wtlunit(c) = wtcft_cur(g,m) + col_set(c) = .true. + end if + end do + + deallocate(wtcft_cur) + deallocate(col_set) + + end subroutine dyncrop_interp + +end module dyncropFileMod diff --git a/components/clm/src/dyn_subgrid/dynpftFileMod.F90 b/components/clm/src/dyn_subgrid/dynpftFileMod.F90 new file mode 100644 index 0000000000..b369e2ba3a --- /dev/null +++ b/components/clm/src/dyn_subgrid/dynpftFileMod.F90 @@ -0,0 +1,284 @@ +module dynpftFileMod + +#include "shr_assert.h" + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle reading of the pftdyn dataset, which specifies transient areas of natural Patches + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC + use dynFileMod , only : dyn_file_type + use dynVarTimeInterpMod , only : dyn_var_time_interp_type + use clm_varctl , only : iulog + use abortutils , only : endrun + use spmdMod , only : masterproc, mpicom + use clm_varcon , only : grlnd, nameg + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + private + save + public :: dynpft_init ! initialize information read from pftdyn dataset + public :: dynpft_interp ! interpolate pftdyn information to current time step + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: dynpft_check_consistency ! check consistency with surface dataset + private :: dynpft_read_consistency_nl ! read namelist associated with consistency checks + ! + ! ! PRIVATE TYPES + type(dyn_file_type), target :: dynpft_file ! information for the pftdyn file + type(dyn_var_time_interp_type) :: wtpatch ! weight of each patch relative to the natural veg landunit + + character(len=*), parameter :: varname = 'PCT_NAT_PFT' ! name of variable on file + !--------------------------------------------------------------------------- + +contains + + + !----------------------------------------------------------------------- + subroutine dynpft_init(bounds, dynpft_filename) + ! + ! !DESCRIPTION: + ! Initialize dynamic pft dataset (position it to the right time samples + ! that bound the initial model date) + ! + ! !USES: + use clm_varpar , only : numpft, maxpatch_pft, natpft_size + use ncdio_pio + use dynTimeInfoMod , only : YEAR_POSITION_END_OF_TIMESTEP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! proc-level bounds + character(len=*) , intent(in) :: dynpft_filename ! name of file containing transient pft information + ! + ! !LOCAL VARIABLES: + integer :: wtpatch_shape(2) ! shape of the wtpatch data + + character(len= 32) :: subname='dynpft_init'! subroutine name + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + ! Error check + + if ( maxpatch_pft /= numpft+1 )then + call endrun(msg=' maxpatch_pft does NOT equal numpft+1 -- this is invalid for dynamic PFT case'//& + errMsg(__FILE__, __LINE__) ) + end if + + if (masterproc) then + write(iulog,*) 'Attempting to read pft dynamic landuse data .....' + end if + + ! Get the year from the END of the timestep for compatibility with how things were + ! done before, even though that doesn't necessarily make the most sense conceptually. + dynpft_file = dyn_file_type(dynpft_filename, YEAR_POSITION_END_OF_TIMESTEP) + + ! Consistency checks + call check_dim(dynpft_file, 'natpft', natpft_size) + call dynpft_check_consistency(bounds) + + ! read data PCT_NAT_PFT corresponding to correct year + ! + ! Note: if you want to change PCT_NAT_PFT so that it is NOT interpolated, but instead + ! jumps to each year's value on Jan 1 of that year, simply change wtpatch to be of type + ! dyn_var_time_uninterp_type (rather than dyn_var_time_interp_type), and change the + ! following constructor to construct a variable of dyn_var_time_uninterp_type. That's + ! all you need to do. + + wtpatch_shape = [(bounds%endg-bounds%begg+1), natpft_size] + wtpatch = dyn_var_time_interp_type( & + dyn_file=dynpft_file, varname=varname, & + dim1name=grlnd, conversion_factor=100._r8, & + do_check_sums_equal_1=.true., data_shape=wtpatch_shape) + + end subroutine dynpft_init + + !----------------------------------------------------------------------- + subroutine dynpft_check_consistency(bounds) + ! + ! !DESCRIPTION: + ! Check consistency between dynpft file and surface dataset. + ! + ! This is done by assuming that PCT_NAT_PFT at time 1 in the pftdyn file agrees with + ! PCT_NAT_PFT on the surface dataset. + ! + ! !USES: + use clm_instur, only : wt_nat_patch + use clm_varpar, only : natpft_size + use ncdio_pio + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! proc-level bounds + ! + ! !LOCAL VARIABLES: + logical :: check_dynpft_consistency ! whether to do the consistency check in this routine + integer :: g ! index + real(r8), pointer :: wtpatch_time1(:,:) ! weight of each pft in each grid cell at first time + logical :: readvar ! whether variable was read + real(r8), parameter :: tol = 1.e-13_r8 ! tolerance for checking equality + + character(len=*), parameter :: subname = 'dynpft_check_consistency' + !----------------------------------------------------------------------- + + call dynpft_read_consistency_nl(check_dynpft_consistency) + + if (check_dynpft_consistency) then + + ! Read first time slice of PCT_NAT_PFT + + allocate(wtpatch_time1(bounds%begg:bounds%endg, natpft_size)) + call ncd_io(ncid=dynpft_file, varname=varname, flag='read', data=wtpatch_time1, & + dim1name=grlnd, nt=1, readvar=readvar) + if (.not. readvar) then + call endrun(msg=' ERROR: ' // trim(varname) // ' NOT on landuse_timeseries file'//& + errMsg(__FILE__, __LINE__)) + end if + + ! Convert from PCT to weight on grid cell + wtpatch_time1(bounds%begg:bounds%endg,:) = wtpatch_time1(bounds%begg:bounds%endg,:) / 100._r8 + + ! Compare with values read from surface dataset + do g = bounds%begg, bounds%endg + if (any(abs(wtpatch_time1(g,:) - wt_nat_patch(g,:)) > tol)) then + write(iulog,*) subname//' mismatch between PCT_NAT_PFT at initial time and that obtained from surface dataset' + write(iulog,*) 'On landuse_timeseries file: ', wtpatch_time1(g,:) + write(iulog,*) 'On surface dataset: ', wt_nat_patch(g,:) + write(iulog,*) ' ' + write(iulog,*) 'Confirm that the year of your surface dataset' + write(iulog,*) 'corresponds to the first year of your landuse_timeseries file' + write(iulog,*) '(e.g., for a landuse_timeseries file starting at year 1850, which is typical,' + write(iulog,*) 'you should be using an 1850 surface dataset),' + write(iulog,*) 'and that your landuse_timeseries file is compatible with the surface dataset.' + write(iulog,*) ' ' + write(iulog,*) 'If you are confident that you are using the correct landuse_timeseries file' + write(iulog,*) 'and the correct surface dataset, then you can bypass this check by setting:' + write(iulog,*) ' check_dynpft_consistency = .false.' + write(iulog,*) 'in user_nl_clm' + write(iulog,*) ' ' + call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + deallocate(wtpatch_time1) + + end if + + end subroutine dynpft_check_consistency + + !----------------------------------------------------------------------- + subroutine dynpft_read_consistency_nl(check_dynpft_consistency) + ! + ! !DESCRIPTION: + ! Read namelist settings related to pftdyn consistency checks + ! + ! !USES: + use fileutils , only : getavu, relavu + use clm_nlUtilsMod , only : find_nlgroup_name + use controlMod , only : NLFilename + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + logical, intent(out) :: check_dynpft_consistency ! whether to do the consistency check + ! + ! !LOCAL VARIABLES: + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + + character(len=*), parameter :: subname = 'dynpft_read_consistency_nl' + !----------------------------------------------------------------------- + + namelist /dynpft_consistency_checks/ & + check_dynpft_consistency + + ! Set default namelist values + check_dynpft_consistency = .true. + + ! Read namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'dynpft_consistency_checks', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=dynpft_consistency_checks,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading dynpft_consistency_checks namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast (check_dynpft_consistency, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'dynpft_consistency_checks settings:' + write(iulog,nml=dynpft_consistency_checks) + write(iulog,*) ' ' + end if + + end subroutine dynpft_read_consistency_nl + + + + !----------------------------------------------------------------------- + subroutine dynpft_interp(bounds) + ! + ! !DESCRIPTION: + ! Time interpolate dynamic pft data to get pft weights for model time. + ! + ! Sets pft%wtcol + ! + ! !USES: + use landunit_varcon , only : istsoil + use clm_varpar , only : natpft_lb, natpft_ub + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! proc-level bounds + ! + ! !LOCAL VARIABLES: + integer :: m,p,l,g ! indices + real(r8), allocatable :: wtpatch_cur(:,:) ! current pft weights + character(len=32) :: subname='dynpft_interp' ! subroutine name + !----------------------------------------------------------------------- + + ! assumes that maxpatch_pft = numpft + 1, that each landunit has only 1 column, + ! and SCAM and CNDV have not been defined + ! + ! NOTE(wjs, 2014-12-10) I'm not sure if there is still the requirement that SCAM + ! hasn't been defined + + SHR_ASSERT_ALL(bounds%level == BOUNDS_LEVEL_PROC, subname // ': argument must be PROC-level bounds') + + ! Get pft weights for this time step + + call dynpft_file%time_info%set_current_year() + + allocate(wtpatch_cur(bounds%begg:bounds%endg, natpft_lb:natpft_ub)) + call wtpatch%get_current_data(wtpatch_cur) + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + + if (lun%itype(l) == istsoil) then + m = patch%itype(p) + + ! Note that the following assignment assumes that all Patches share a single column + patch%wtcol(p) = wtpatch_cur(g,m) + end if + + end do + + deallocate(wtpatch_cur) + + end subroutine dynpft_interp + +end module dynpftFileMod diff --git a/components/clm/src/dyn_subgrid/test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/CMakeLists.txt new file mode 100644 index 0000000000..a8e39af4aa --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/CMakeLists.txt @@ -0,0 +1,4 @@ +add_subdirectory(dynInitColumns_test) +add_subdirectory(dynLandunitArea_test) +add_subdirectory(dynVar_test) +add_subdirectory(dynTimeInfo_test) diff --git a/components/clm/src/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt new file mode 100644 index 0000000000..59e6d13bb3 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynInitColumns_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(dynInitColumns test_dynInitColumns_exe + "test_init_columns.pf" "") + +target_link_libraries(test_dynInitColumns_exe clm csm_share) diff --git a/components/clm/src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf b/components/clm/src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf new file mode 100644 index 0000000000..b6a90e5b1d --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynInitColumns_test/test_init_columns.pf @@ -0,0 +1,230 @@ +module test_init_columns + + ! Tests of the dynInitColumns module + + use pfunit_mod + use unittestSubgridMod + use dynInitColumnsMod + use ColumnType , only : col + use LandunitType , only : lun + use GridcellType , only : grc + use decompMod , only : bounds_type + use clm_varcon , only : ispval + use clm_varpar , only : nlevsno, nlevgrnd + use shr_kind_mod , only : r8 => shr_kind_r8 + use TemperatureType , only : temperature_type + + implicit none + save + + logical, allocatable, private :: cactive_prior(:) + integer :: c_new ! column index of the new column to initialize in some tests + integer :: l1 ! index of the landunit with landunit type 1 + integer :: l2 ! index of the landunit with landunit type 2 + + type(temperature_type) :: temperature_vars + +contains + + subroutine setup() + ! Set up variables needed for tests: various subgrid type variables, along with + ! bounds and cactive_prior. + ! + ! col%active and cactive_prior need to be set by specific tests + integer :: c, lev + + ! Set up subgrid structure + ! The weights (of both landunits and columns) and column types in the following are + ! arbitrary, since they are not important for these tests + + call unittest_subgrid_setup_start() + + call unittest_add_gridcell() + + call unittest_add_landunit(my_gi=gi, ltype=3, wtgcell=0.25_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8) + + call unittest_add_landunit(my_gi=gi, ltype=1, wtgcell=0.5_r8) + l1 = li + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + ! This column (the second column on the landunit with ltype=1) will be the target for + ! some tests of initialization of a new column + c_new = ci + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + + call unittest_add_landunit(my_gi=gi, ltype=2, wtgcell=0.25_r8) + l2 = li + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.25_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=0.5_r8) + + call unittest_subgrid_setup_end() + + col%active(begc:endc) = .false. + allocate(cactive_prior(bounds%begc:bounds%endc), source=.false.) + + nlevgrnd=10 + allocate(temperature_vars%t_soisno_col(bounds%begc:bounds%endc, -nlevsno+1:nlevgrnd)) + do lev = -nlevsno+1, nlevgrnd + do c = bounds%begc, bounds%endc + temperature_vars%t_soisno_col(c, lev) = c*1000 + lev + end do + end do + end subroutine setup + + subroutine cleanup() + ! clean up stuff set up in setup() + + call unittest_subgrid_teardown() + + deallocate(cactive_prior) + deallocate(temperature_vars%t_soisno_col) + + end subroutine cleanup + + ! ------------------------------------------------------------------------ + ! Tests of initial_template_col + ! ------------------------------------------------------------------------ + + @Test + subroutine test_initial_template_no_landunit() + ! no landunit of the given landunit_type on this grid cell + call setup() + cactive_prior(:) = .true. + grc%landunit_indices(2,gi) = ispval + @assertEqual(ispval, initial_template_col(bounds, c_new, 2, cactive_prior)) + call cleanup() + end subroutine test_initial_template_no_landunit + + @Test + subroutine test_initial_template_no_active() + ! no active columns on the given landunit_type + integer :: template_col + call setup() + cactive_prior(:) = .true. + cactive_prior(lun%coli(l2):lun%colf(l2)) = .false. + @assertEqual(ispval, initial_template_col(bounds, c_new, 2, cactive_prior)) + call cleanup() + end subroutine test_initial_template_no_active + + @Test + subroutine test_initial_template_all_active() + ! all active columns on the given landunit type; should take the first + call setup() + cactive_prior(:) = .true. + @assertEqual(lun%coli(l2), initial_template_col(bounds, c_new, 2, cactive_prior)) + call cleanup() + end subroutine test_initial_template_all_active + + @Test + subroutine test_initial_template_second_active() + ! first col on the given landunit is inactive, second is active; should take the + ! second (ignoring the inactive column) + call setup() + cactive_prior(:) = .true. + cactive_prior(lun%coli(l2)) = .false. + @assertEqual(lun%coli(l2)+1, initial_template_col(bounds, c_new, 2, cactive_prior)) + call cleanup() + end subroutine test_initial_template_second_active + + ! ------------------------------------------------------------------------ + ! Tests of initial_template_col_crop + ! ------------------------------------------------------------------------ + + @Test + subroutine test_crop_active_in_soil_and_crop() + ! there are active columns both on the soil & crop landunits; should take the soil one + call setup() + cactive_prior(:) = .true. + @assertEqual(lun%coli(l1), initial_template_col_crop(bounds, c_new, cactive_prior)) + call cleanup() + end subroutine test_crop_active_in_soil_and_crop + + @Test + subroutine test_crop_no_soil() + ! no soil landunit, should take a crop column + call setup() + cactive_prior(:) = .true. + grc%landunit_indices(1,gi) = ispval + @assertEqual(lun%coli(l2), initial_template_col_crop(bounds, c_new, cactive_prior)) + call cleanup() + end subroutine test_crop_no_soil + + @Test + subroutine test_crop_no_soil_or_crop() + ! no soil or crop landunits, should give ispval + call setup() + cactive_prior(:) = .true. + grc%landunit_indices(1:2,gi) = ispval + @assertEqual(ispval, initial_template_col_crop(bounds, c_new, cactive_prior)) + call cleanup() + end subroutine test_crop_no_soil_or_crop + + ! ------------------------------------------------------------------------ + ! Tests of initialize_new_columns + ! + ! Note that, although we don't have any explicit tests of copy_state, its behavior is + ! implicitly tested through these tests + ! ------------------------------------------------------------------------ + + @Test + subroutine test_initialize_new_columns_none() + ! Nothing to initialize + real(r8), allocatable :: t_soisno_expected(:,:) + call setup() + ! col%active and cactive_prior are a mix of true/true, false/false and false/true, so + ! there's nothing to initialize + col%active(:) = .true. + cactive_prior(:) = .true. + col%active(lun%coli(l2)+1) = .false. + cactive_prior(lun%coli(l2)+1) = .false. + col%active(lun%coli(l2)+2) = .false. + t_soisno_expected = temperature_vars%t_soisno_col + call initialize_new_columns(bounds, cactive_prior, temperature_vars) + @assertEqual(t_soisno_expected, temperature_vars%t_soisno_col) + call cleanup() + end subroutine test_initialize_new_columns_none + + @Test + subroutine test_initialize_new_columns_ispval() + ! Something to initialize, but template_col results in ispval: state should remain + ! the same as before + real(r8), allocatable :: t_soisno_expected(:,:) + call setup() + col%active(:) = .false. + col%active(lun%coli(l2)+1) = .true. + ! all cactive_prior points were false, so there's nothing to use as a template: + cactive_prior(:) = .false. + t_soisno_expected = temperature_vars%t_soisno_col + call initialize_new_columns(bounds, cactive_prior, temperature_vars) + @assertEqual(t_soisno_expected, temperature_vars%t_soisno_col) + call cleanup() + end subroutine test_initialize_new_columns_ispval + + @Test + subroutine test_initialize_new_columns_copy_state() + ! Something to initialize, which results in a state copy + real(r8), allocatable :: t_soisno_expected(:,:) + integer :: source_col, dest_col + + call setup() + + col%active(:) = .false. + dest_col = lun%coli(l2) + 1 + col%active(dest_col) = .true. + + cactive_prior(:) = .false. + source_col = lun%coli(l1) + 1 + cactive_prior(source_col) = .true. + + t_soisno_expected = temperature_vars%t_soisno_col + t_soisno_expected(dest_col,:) = temperature_vars%t_soisno_col(source_col,:) + call initialize_new_columns(bounds, cactive_prior, temperature_vars) + @assertEqual(t_soisno_expected, temperature_vars%t_soisno_col) + call cleanup() + end subroutine test_initialize_new_columns_copy_state + +end module test_init_columns diff --git a/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt new file mode 100644 index 0000000000..2547dc4a17 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/CMakeLists.txt @@ -0,0 +1,9 @@ +set(pfunit_sources + test_update_landunit_weights_one_gcell.pf + test_update_landunit_weights.pf) + +create_pFUnit_test(dynLandunitArea test_dynLandunitArea_exe + "${pfunit_sources}" "") + +target_link_libraries(test_dynLandunitArea_exe clm csm_share) + diff --git a/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf new file mode 100644 index 0000000000..8e2c5acd91 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf @@ -0,0 +1,147 @@ +module test_update_landunit_weights + + ! Tests of the update_landunit_weights routine in the dynLandunitArea module + + use pfunit_mod + use unittestSubgridMod + use dynLandunitAreaMod + use shr_kind_mod , only : r8 => shr_kind_r8 + use landunit_varcon , only : istsoil, istcrop, istice, istice_mec, istdlak, istwet + use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md + use GridcellType , only : grc + use LandunitType , only : lun + use decompMod , only : bounds_type + + implicit none + save + + real(r8), parameter :: tol = 1.e-14_r8 + +contains + + subroutine setup_start() + call unittest_subgrid_setup_start() + end subroutine setup_start + + subroutine setup_end() + call unittest_subgrid_setup_end() + end subroutine setup_end + + subroutine teardown() + call unittest_subgrid_teardown() + end subroutine teardown + + + @Test + subroutine test_one_gcell_all_lunits() + ! Test update_landunit_weights with a single grid cell, which has all landunits + ! present + + integer :: index_soil, index_crop, index_icemec, index_urbmd + real(r8) :: expected(begl:endl) + + call setup_start() + call unittest_add_gridcell() + ! Add all landunits, deliberately out of order; the weights sum to 1: + call unittest_add_landunit(my_gi=gi, ltype=5, wtgcell=0.16_r8) + call unittest_add_landunit(my_gi=gi, ltype=1, wtgcell=0.14_r8) + call unittest_add_landunit(my_gi=gi, ltype=6, wtgcell=0.08_r8) + call unittest_add_landunit(my_gi=gi, ltype=2, wtgcell=0.25_r8) + call unittest_add_landunit(my_gi=gi, ltype=7, wtgcell=0.06_r8) + call unittest_add_landunit(my_gi=gi, ltype=3, wtgcell=0.05_r8) + call unittest_add_landunit(my_gi=gi, ltype=8, wtgcell=0.04_r8) + call unittest_add_landunit(my_gi=gi, ltype=4, wtgcell=0.20_r8) + call unittest_add_landunit(my_gi=gi, ltype=9, wtgcell=0.02_r8) + call setup_end() + + ! In the following, we assume that the first few elements of decrease_order are: + ! istsoil, istcrop, isturb_md + + ! First increase the area of istice_mec: weights of istice_mec + istsoil + istcrop + 0.01 + index_soil = grc%landunit_indices(istsoil,gi) + index_crop = grc%landunit_indices(istcrop,gi) + index_icemec = grc%landunit_indices(istice_mec,gi) + index_urbmd = grc%landunit_indices(isturb_md,gi) + lun%wtgcell(index_icemec) = lun%wtgcell(index_icemec) + lun%wtgcell(index_soil) + lun%wtgcell(index_crop) + 0.01_r8 + + ! Now set the expected outcome + expected = lun%wtgcell + expected(index_soil) = 0._r8 + expected(index_crop) = 0._r8 + expected(index_urbmd) = expected(index_urbmd) - 0.01_r8 + + call update_landunit_weights(bounds) + @assertEqual(expected(bounds%begl:bounds%endl), lun%wtgcell(bounds%begl:bounds%endl), tolerance=tol) + + call teardown() + end subroutine test_one_gcell_all_lunits + + @Test + subroutine test_one_gcell_some_lunits() + ! Test update_landunit_weights with a single grid cell, which has only some landunits + ! present + + integer :: index_wet, index_icemec, index_crop + real(r8) :: expected(begl:endl) + + call setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istwet, wtgcell=0.3_r8) + index_wet = li + call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=0.8_r8) + index_icemec = li + call unittest_add_landunit(my_gi=gi, ltype=istcrop, wtgcell=0.5_r8) + index_crop = li + call setup_end() + + ! In the following, we assume that crop is decreased before wetland: + expected(index_icemec) = 0.8_r8 + expected(index_crop) = 0.0_r8 + expected(index_wet) = 0.2_r8 + + call update_landunit_weights(bounds) + @assertEqual(expected(bounds%begl:bounds%endl), lun%wtgcell(bounds%begl:bounds%endl), tolerance=tol) + + call teardown() + end subroutine test_one_gcell_some_lunits + + @Test + subroutine test_multiple_gcells() + ! Test update_landunit_weights with multiple grid cells + + integer :: g1, g2, g3 + real(r8) :: expected(begl:endl) + + call setup_start() + + call unittest_add_gridcell() + g1 = gi + call unittest_add_gridcell() + g2 = gi + call unittest_add_gridcell() + g3 = gi + + ! Deliberately add landunits out-of-order + call unittest_add_landunit(my_gi=g2, ltype=istice_mec, wtgcell=0.8_r8) + call unittest_add_landunit(my_gi=g3, ltype=istcrop, wtgcell=0.6_r8) + call unittest_add_landunit(my_gi=g1, ltype=isturb_md, wtgcell=0.45_r8) + call unittest_add_landunit(my_gi=g3, ltype=istice_mec, wtgcell=0.4_r8) + call unittest_add_landunit(my_gi=g1, ltype=istcrop, wtgcell=0.7_r8) + call unittest_add_landunit(my_gi=g2, ltype=istsoil, wtgcell=0.1_r8) + + call setup_end() + + ! grid cell 1 needs decrease in crop + ! grid cell 2 needs increase in soil + ! grid cell 3 stays the same + expected = lun%wtgcell + expected(grc%landunit_indices(istcrop,g1)) = 0.55_r8 + expected(grc%landunit_indices(istsoil,g2)) = 0.2_r8 + + call update_landunit_weights(bounds) + @assertEqual(expected(bounds%begl:bounds%endl), lun%wtgcell(bounds%begl:bounds%endl), tolerance=tol) + + call teardown() + end subroutine test_multiple_gcells + +end module test_update_landunit_weights diff --git a/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf new file mode 100644 index 0000000000..d28bf78295 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf @@ -0,0 +1,135 @@ +module test_update_landunit_weights_one_gcell + + ! Tests of the update_landunit_weights_one_gcell routine in the dynLandunitArea module + + use pfunit_mod + use dynLandunitAreaMod + use landunit_varcon, only : istsoil, istcrop, isturb_md, istice, istice_mec, max_lunit + use shr_kind_mod , only : r8 => shr_kind_r8 + + + implicit none + save + + real(r8), parameter :: tol = 1.e-14_r8 + +contains + + function create_landunit_weights() + ! Create default version of the landunit weights + real(r8), dimension(max_lunit), allocatable :: create_landunit_weights(:) + + create_landunit_weights = [.25_r8, .2_r8, .16_r8, .14_r8, .08_r8, .06_r8, .05_r8, .04_r8, .02_r8] + end function create_landunit_weights + + @Test + subroutine test_no_change() + ! Test with no changes needed in landunit areas, because they already add to 100% + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + expected = landunit_weights + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights) + end subroutine test_no_change + + @Test + subroutine test_less_than_1() + ! Test with the input summing to less than 1, which should result in an increase in + ! the natural vegetated area + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + landunit_weights(istice_mec) = landunit_weights(istice_mec) - 0.01_r8 + expected = landunit_weights + expected(istsoil) = landunit_weights(istsoil) + 0.01_r8 + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights, tolerance=tol) + end subroutine test_less_than_1 + + @Test + subroutine test_greater_than_1_one_change() + ! Test with the input summing to greater than 1, resulting in a change in a single + ! landunit + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + landunit_weights(istice_mec) = landunit_weights(istice_mec) + 0.01_r8 + expected = landunit_weights + expected(istsoil) = landunit_weights(istsoil) - 0.01_r8 + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights, tolerance=tol) + end subroutine test_greater_than_1_one_change + + @Test + subroutine test_greater_than_1_multiple_changes() + ! Test with the input summing to greater than 1, resulting in a change in multiple + ! landunits (but not all landunits) + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + + ! In the following, we assume that the first few elements of decrease_order are: + ! istsoil, istcrop, isturb_md + landunit_weights(istice_mec) = landunit_weights(istice_mec) + & + landunit_weights(istsoil) + landunit_weights(istcrop) + 0.01_r8 + expected = landunit_weights + expected(istsoil) = 0._r8 + expected(istcrop) = 0._r8 + expected(isturb_md) = expected(isturb_md) - 0.01_r8 + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights, tolerance=tol) + end subroutine test_greater_than_1_multiple_changes + + @Test + subroutine test_greater_than_1_all_changes() + ! Test with the input summing to greater than 1, resulting in a change in ALL + ! landunits (except istice_mec, which is the one set manually here, and which can + ! never change) + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + landunit_weights(istice_mec) = 0.99_r8 + + ! In the following, we assume that the last element of decrease_order is istice (not + ! to be confused with istice_mec) + expected(:) = 0._r8 + expected(istice_mec) = 0.99_r8 + expected(istice) = 0.01_r8 + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights, tolerance=tol) + end subroutine test_greater_than_1_all_changes + + @Test + subroutine test_greater_than_1_all_changes_to_0() + ! Similar to test_greater_than_1_all_changes, but now all landunits except istice_mec + ! are reduced to 0 + + real(r8) :: landunit_weights(max_lunit) + real(r8) :: expected(max_lunit) + + landunit_weights = create_landunit_weights() + landunit_weights(istice_mec) = 1.0_r8 + expected(:) = 0._r8 + expected(istice_mec) = 1.0_r8 + + call update_landunit_weights_one_gcell(landunit_weights) + @assertEqual(expected, landunit_weights, tolerance=tol) + end subroutine test_greater_than_1_all_changes_to_0 + +end module test_update_landunit_weights_one_gcell diff --git a/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt new file mode 100644 index 0000000000..3e2e20e756 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(dynTimeInfo test_dynTimeInfo_exe + "test_dynTimeInfo.pf" "") + +target_link_libraries(test_dynTimeInfo_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf b/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf new file mode 100644 index 0000000000..cdb1e394ec --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynTimeInfo_test/test_dynTimeInfo.pf @@ -0,0 +1,559 @@ +module test_dynTimeInfo + + ! Tests of the dynTimeInfo class + + use pfunit_mod + use dynTimeInfoMod + use shr_kind_mod, only: r8 => shr_kind_r8 + use unittestTimeManagerMod, only : unittest_timemgr_setup, unittest_timemgr_teardown + use unittestTimeManagerMod, only : set_date => unittest_timemgr_set_curr_date + use unittestTimeManagerMod, only : set_year => unittest_timemgr_set_curr_year + + implicit none + save + + integer, parameter :: dtime = 1800 + + @TestCase + type, extends(TestCase) :: TestDynTimeInfo + contains + procedure :: setUp + procedure :: tearDown + end type TestDynTimeInfo + +contains + + subroutine setUp(this) + class(TestDynTimeInfo), intent(inout) :: this + + call unittest_timemgr_setup(dtime=dtime) + + ! Make sure the date is set to the start of the year (such that the year differs + ! between the start and end of the timestep), to make sure that the appropriate + ! year_position is being used. + call set_date(yr=1, mon=1, day=1, tod=0) + end subroutine setUp + + subroutine tearDown(this) + class(TestDynTimeInfo), intent(inout) :: this + + call unittest_timemgr_teardown() + end subroutine tearDown + + ! ---------------------------------------------------------------------- + ! Tests of the constructor + ! ---------------------------------------------------------------------- + + @Test + subroutine test_constructor_normal_a(this) + ! test constructor in the normal case that cur_year is within the time bounds + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11, 12, 13, 14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(2, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_constructor_normal_a + + @Test + subroutine test_constructor_normal_b(this) + ! another test of the constructor in the normal case that cur_year is within the time + ! bounds; this one tests the last interval + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11, 12, 13, 14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(3, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_constructor_normal_b + + @Test + subroutine test_constructor_early(this) + ! test constructor in the case when cur_year is prior to the first interval + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11, 12, 13], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(1, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_constructor_early + + @Test + subroutine test_constructor_late_a(this) + ! test constructor in the case when cur_year is just barely past the last interval + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11, 12, 13], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(3, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_constructor_late_a + + @Test + subroutine test_constructor_late_b(this) + ! test constructor in the case when cur_year is more than a year past the last interval + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11, 12, 13], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(3, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_constructor_late_b + + @Test + subroutine test_constructor_single_interval(this) + ! test constructor with a single interval (2 years) + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11, 12], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(2, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_constructor_single_interval + + @Test + subroutine test_constructor_single_year(this) + ! test constructor with a single year + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(1, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_constructor_single_year + + + ! ---------------------------------------------------------------------- + ! Tests of get_yearfrac + ! ---------------------------------------------------------------------- + + @Test + subroutine test_getYearfrac_positionEnd_returnsCorrectValue(this) + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_date(yr=11, mon=1, day=1, tod=0) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(0._r8, my_info%get_yearfrac()) + end subroutine test_getYearfrac_positionEnd_returnsCorrectValue + + @Test + subroutine test_getYearfrac_positionStart_returnsCorrectValue(this) + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_date(yr=11, mon=1, day=1, tod=dtime) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_START_OF_TIMESTEP) + + @assertEqual(0._r8, my_info%get_yearfrac()) + end subroutine test_getYearfrac_positionStart_returnsCorrectValue + + ! ---------------------------------------------------------------------- + ! Tests of get_year + ! ---------------------------------------------------------------------- + + @Test + subroutine test_get_year(this) + ! Test the get_year routine + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertEqual(11, my_info%get_year(1)) + @assertEqual(12, my_info%get_year(2)) + @assertEqual(14, my_info%get_year(4)) + end subroutine test_get_year + + + ! ---------------------------------------------------------------------- + ! Tests of is_before_time_series and is_after_time_series + ! ---------------------------------------------------------------------- + + @Test + subroutine test_is_before_after_early(this) + ! Test is_before_time_series and is_after_time_series, when year is before the time + ! series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertTrue(my_info%is_before_time_series()) + @assertFalse(my_info%is_after_time_series()) + end subroutine test_is_before_after_early + + @Test + subroutine test_is_before_after_first(this) + ! Test is_before_time_series and is_after_time_series, when year is the first year in + ! the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertFalse(my_info%is_before_time_series()) + @assertFalse(my_info%is_after_time_series()) + end subroutine test_is_before_after_first + + @Test + subroutine test_is_before_after_mid(this) + ! Test is_before_time_series and is_after_time_series, when year is in the middle of + ! the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(12) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertFalse(my_info%is_before_time_series()) + @assertFalse(my_info%is_after_time_series()) + end subroutine test_is_before_after_mid + + @Test + subroutine test_is_before_after_last(this) + ! Test is_before_time_series and is_after_time_series, when year is in the last + ! interval of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertFalse(my_info%is_before_time_series()) + @assertFalse(my_info%is_after_time_series()) + end subroutine test_is_before_after_last + + @Test + subroutine test_is_before_after_late(this) + ! Test is_before_time_series and is_after_time_series, when year is just past the end + ! of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertFalse(my_info%is_before_time_series()) + @assertTrue(my_info%is_after_time_series()) + end subroutine test_is_before_after_late + + @Test + subroutine test_is_before_after_very_late(this) + ! Test is_before_time_series and is_after_time_series, when year is far past the end + ! of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(15) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + + @assertFalse(my_info%is_before_time_series()) + @assertTrue(my_info%is_after_time_series()) + end subroutine test_is_before_after_very_late + + + + ! ---------------------------------------------------------------------- + ! Tests of set_current_year - typical scenarios + ! ---------------------------------------------------------------------- + + + @Test + subroutine test_update_no_change_early(this) + ! Test an update with no change in years, prior to start of time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call my_info%set_current_year() + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(1, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_no_change_early + + @Test + subroutine test_update_no_change_normal(this) + ! Test a normal update, no change in years + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call my_info%set_current_year() + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(2, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_update_no_change_normal + + @Test + subroutine test_update_no_change_late(this) + ! Test an update with no change in years, just past the end of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_no_change_late + + @Test + subroutine test_update_no_change_very_late(this) + ! Test an update with no change in years, significantly past the end of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(15) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_no_change_very_late + + @Test + subroutine test_update_early(this) + ! Test an update, with a change in years, both before the start of the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(9) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(10) + call my_info%set_current_year() + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(1, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_early + + @Test + subroutine test_update_early_to_normal(this) + ! Test an update, with a change in years, from before the time series to inside it + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(11) + call my_info%set_current_year() + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(2, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_update_early_to_normal + + @Test + subroutine test_update_normal(this) + ! Test an update, with a change in years, both within the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(12) + call my_info%set_current_year() + + @assertEqual(2, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + @assertTrue(my_info%is_within_bounds()) + end subroutine test_update_normal + + @Test + subroutine test_update_normal_to_late(this) + ! Test an update, with a change in years, from within the time series to after it + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(14) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_normal_to_late + + @Test + subroutine test_update_late(this) + ! Test an update, with a change in years, starting just after the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(15) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_late + + @Test + subroutine test_update_very_late(this) + ! Test an update, with a change in years, both significantly after the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(15) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(16) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + @assertFalse(my_info%is_within_bounds()) + end subroutine test_update_very_late + + ! ---------------------------------------------------------------------- + ! Tests of set_current_year - year decreasing + ! ---------------------------------------------------------------------- + + @Test + subroutine test_update_decreasing_early(this) + ! Test an update with decreasing years, starting before the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(9) + call my_info%set_current_year() + + @assertEqual(1, my_info%get_time_index_lower()) + @assertEqual(1, my_info%get_time_index_upper()) + end subroutine test_update_decreasing_early + + @Test + subroutine test_update_decreasing_normal(this) + ! Test an update with decreasing years, starting within the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(12) + call my_info%set_current_year() + + @assertEqual(2, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + end subroutine test_update_decreasing_normal + + @Test + subroutine test_update_decreasing_late(this) + ! Test an update with decreasing years, starting after the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(13) + call my_info%set_current_year() + + @assertEqual(3, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + end subroutine test_update_decreasing_late + + ! ---------------------------------------------------------------------- + ! Tests of set_current_year - year increasing by more than 1 + ! ---------------------------------------------------------------------- + + @Test + subroutine test_update_by2_early(this) + ! Test an update by 2 years, starting before the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(10) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(12) + call my_info%set_current_year() + + @assertEqual(2, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + end subroutine test_update_by2_early + + @Test + subroutine test_update_by2_normal(this) + ! Test an update by 2 years, starting within the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(11) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(13) + call my_info%set_current_year() + + @assertEqual(3, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + end subroutine test_update_by2_normal + + @Test + subroutine test_update_by2_late(this) + ! Test an update by 2 years, starting after the time series + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(14) + my_info = time_info_type([11,12,13,14], YEAR_POSITION_END_OF_TIMESTEP) + call set_year(16) + call my_info%set_current_year() + + @assertEqual(4, my_info%get_time_index_lower()) + @assertEqual(4, my_info%get_time_index_upper()) + end subroutine test_update_by2_late + + ! ---------------------------------------------------------------------- + ! Tests of alternative values of year_position + ! ---------------------------------------------------------------------- + + @Test + subroutine test_year_position_start_of_timestep(this) + ! make sure that, for year_position = YEAR_POSITION_START_OF_TIMESTEP, we truly get + ! the year from the start of the timestep + class(TestDynTimeInfo), intent(inout) :: this + type(time_info_type) :: my_info + + call set_year(13) + my_info = time_info_type([11, 12, 13, 14], YEAR_POSITION_START_OF_TIMESTEP) + + @assertEqual(2, my_info%get_time_index_lower()) + @assertEqual(3, my_info%get_time_index_upper()) + end subroutine test_year_position_start_of_timestep + +end module test_dynTimeInfo diff --git a/components/clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt b/components/clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt new file mode 100644 index 0000000000..2fadf5d844 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynVar_test/CMakeLists.txt @@ -0,0 +1,12 @@ +set (pfunit_sources + test_dynVarTimeUninterp.pf + test_dynVarTimeInterp.pf) + +# extra sources used for this test, which are not .pf files +set (extra_sources + test_dynVarShared.F90) + +create_pfUnit_test(dynVar test_dynVar_exe + "${pfunit_sources}" "${extra_sources}") + +target_link_libraries(test_dynVar_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 new file mode 100644 index 0000000000..be793ee8cb --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarShared.F90 @@ -0,0 +1,49 @@ +module test_dynVarShared + ! Shared code to set up tests of dyn_var_type and its extensions + + use shr_kind_mod, only : r8 => shr_kind_r8 + use dynFileMod, only : dyn_file_type + use ncdio_pio, only : ncd_set_var + + implicit none + private + save + + public :: create_dyn_file + +contains + + function create_dyn_file() result(dyn_file) + ! Set up a dyn_file variable for tests. Assumes we're using the mock version of + ! dynFileMod. + ! + ! The years in the mock "file" go from 11 - 14. + + ! The "file" contains two variables: foo_1d, which is a 1-d variable (i.e., just space + ! & time, no level dimension); and foo_2d, which is a 2-d variable (i.e., includes a + ! level dimension) + + type(dyn_file_type) :: dyn_file + + real(r8) :: data1d(3,4) ! space & time only + real(r8) :: data2d(6,4) ! space & level & time; first two dimensions are [2,3] + + dyn_file = dyn_file_type([11,12,13,14]) + + data1d = reshape([1._r8, 2._r8, 3._r8, & ! year 11 + 4._r8, 5._r8, 6._r8, & ! year 12 + 7._r8, 8._r8, 9._r8, & ! year 13 + 10._r8,11._r8,12._r8], & ! year 14 + [3, 4]) + call ncd_set_var(dyn_file, 'foo_1d', data1d, [3]) + + data2d = reshape([ 1._r8, 2._r8, 3._r8, 4._r8, 5._r8, 6._r8, & ! year 11 + 7._r8, 8._r8, 9._r8, 10._r8, 11._r8, 12._r8, & ! year 12 + 13._r8, 14._r8, 15._r8, 16._r8, 17._r8, 18._r8, & ! year 13 + 19._r8, 20._r8, 21._r8, 22._r8, 23._r8, 24._r8],& ! year 14 + [6, 4]) + call ncd_set_var(dyn_file, 'foo_2d', data2d, [2, 3]) + + end function create_dyn_file + +end module test_dynVarShared diff --git a/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf new file mode 100644 index 0000000000..e50acf09a4 --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeInterp.pf @@ -0,0 +1,356 @@ +module test_dynVarTimeInterp + + ! Tests of dyn_var_time_interp + + use pfunit_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + use dynVarTimeInterpMod, only : dyn_var_time_interp_type + use test_dynVarShared + use dynFileMod, only : dyn_file_type + use ncdio_pio, only : ncd_get_read_times, ncd_reset_read_times + use unittestTimeManagerMod, only : unittest_timemgr_setup, unittest_timemgr_teardown + use unittestTimeManagerMod, only : set_date => unittest_timemgr_set_curr_date + use unittestTimeManagerMod, only : set_year => unittest_timemgr_set_curr_year + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + + @TestCase + type, extends(TestCase) :: TestDynVarTimeInterp + contains + procedure :: setUp + procedure :: tearDown + end type TestDynVarTimeInterp + +contains + + subroutine setUp(this) + class(TestDynVarTimeInterp), intent(inout) :: this + + ! Set the date to be 3/4 of the way into the year, so that interpolated values will + ! truly need to interpolate between the two years' values (rather than using, say, + ! Jan 1 at 0Z). + integer, parameter :: curr_yr = 1 + integer, parameter :: curr_mon = 10 + integer, parameter :: curr_day = 1 + integer, parameter :: curr_tod = 64800 + + call unittest_timemgr_setup() + call set_date(yr=curr_yr, mon=curr_mon, day=curr_day, tod=curr_tod) + end subroutine setUp + + subroutine tearDown(this) + class(TestDynVarTimeInterp), intent(inout) :: this + + call unittest_timemgr_teardown() + end subroutine tearDown + + @Test + subroutine test_get_current_data_1d_noReads(this) + ! Test get_current_data_1d with no reads after initialization + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + call var%get_current_data(data) + expected = [4.0_r8, 5.0_r8, 6.0_r8]*0.25_r8 + & + [7.0_r8, 8.0_r8, 9.0_r8]*0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call didn't trigger i/o: + @assertFalse(any(ncd_get_read_times(dyn_file, 'foo_1d'))) + + end subroutine test_get_current_data_1d_noReads + + @Test + subroutine test_get_current_data_1d_noReads_update(this) + ! Test get_current_data_1d with no reads after initialization, although it has an + ! set_current_year call that shouldn't do anything + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! make sure that a call to set_current_year with an unchanged year doesn't affect things at all + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + expected = [4.0_r8, 5.0_r8, 6.0_r8]*0.25_r8 + & + [7.0_r8, 8.0_r8, 9.0_r8]*0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call didn't trigger i/o: + @assertFalse(any(ncd_get_read_times(dyn_file, 'foo_1d'))) + + end subroutine test_get_current_data_1d_noReads_update + + + @Test + subroutine test_get_current_data_1d_noReads_conversion(this) + ! Test get_current_data_1d with no reads after initialization, with a conversion + ! factor + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=2.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + call var%get_current_data(data) + expected = [4.0_r8, 5.0_r8, 6.0_r8]*0.25_r8 + & + [7.0_r8, 8.0_r8, 9.0_r8]*0.75_r8 + expected = expected / 2.0_r8 + @assertEqual(expected, data, tolerance=tol) + + end subroutine test_get_current_data_1d_noReads_conversion + + + @Test + subroutine test_get_current_data_1d_yearsIncreaseBy1(this) + ! Test get_current_data_1d, where we move into the next interval so that both year + ! endpoints increase by 1. This should cause a read of new year 2's data, but + ! shouldn't need to read new year's 1 data + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + logical, allocatable :: read_times(:) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! advance to the next year, which should force a read + call set_year(13) + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + expected = [7.0_r8, 8.0_r8, 9.0_r8]*0.25_r8 + & + [10.0_r8, 11.0_r8, 12.0_r8]*0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call DID trigger i/o in this case. + ! However, it should only have triggered i/o for year 4, since year 3 should already + ! have been stored + read_times = ncd_get_read_times(dyn_file, 'foo_1d') + @assertTrue(read_times(4)) + @assertFalse(any(read_times(1:3))) + + end subroutine test_get_current_data_1d_yearsIncreaseBy1 + + @Test + subroutine test_get_current_data_1d_yearsIncreaseBy2(this) + ! Test get_current_data_1d, where we move forward by two intervals, so that both year + ! endpoints increase by 2. This should cause a read for both new end points. + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + logical, allocatable :: read_times(:) + + ! Set up test data + call set_year(11) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! advance by two years, which should force a read + call set_year(13) + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + expected = [7.0_r8, 8.0_r8, 9.0_r8]*0.25_r8 + & + [10.0_r8, 11.0_r8, 12.0_r8]*0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call DID trigger i/o in this case, for + ! both years 3 and 4. + read_times = ncd_get_read_times(dyn_file, 'foo_1d') + @assertTrue(read_times(3)) + @assertTrue(read_times(4)) + @assertFalse(any(read_times(1:2))) + + end subroutine test_get_current_data_1d_yearsIncreaseBy2 + + @Test + subroutine test_get_current_data_1d_year2Changes(this) + ! Test get_current_data_1d, where year 2 changes but not year 1. This would be the + ! case when we start prior to the time series, then enter the time series. In this + ! case, we should read year 2, but not year 1 data. + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + logical, allocatable :: read_times(:) + + ! Set up test data + call set_year(10) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! advance by a year, into the time series + call set_year(11) + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + expected = [1.0_r8, 2.0_r8, 3.0_r8]*0.25_r8 + & + [4.0_r8, 5.0_r8, 6.0_r8]*0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call DID trigger i/o in this case, but + ! just for year 2 + read_times = ncd_get_read_times(dyn_file, 'foo_1d') + @assertFalse(read_times(1)) + @assertTrue(read_times(2)) + @assertFalse(any(read_times(3:4))) + + end subroutine test_get_current_data_1d_year2Changes + + + @Test + subroutine test_get_current_data_1d_year1Changes(this) + ! Test get_current_data_1d, where year 1 changes but not year 2. This would be the + ! case when we start in the last interval of the time series, then exit the time + ! series. + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(3) + real(r8) :: expected(3) + logical, allocatable :: read_times(:) + + ! Set up test data + call set_year(13) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! advance by a year, past the end of the time series + call set_year(14) + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + expected = [10._r8, 11._r8, 12._r8] + @assertEqual(expected, data, tolerance=tol) + + ! Make sure that the above get_current_data call did NOT trigger i/o in this case + ! (year 2 is the same as before; year 1 should have gotten its data from the old year 2) + @assertFalse(any(ncd_get_read_times(dyn_file, 'foo_1d'))) + + end subroutine test_get_current_data_1d_year1Changes + + @Test + subroutine test_get_current_data_2d(this) + ! Test get_current_data_2d + class(TestDynVarTimeInterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_interp_type) :: var + real(r8) :: data(2,3) + real(r8) :: expected_time1(2,3), expected_time2(2,3), expected(2,3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_interp_type( & + dyn_file=dyn_file, & + varname='foo_2d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & ! setting this to false to avoid needing to set up the test data carefully + data_shape = shape(data)) + + call var%get_current_data(data) + expected_time1 = reshape([ 7._r8, 8._r8, 9._r8, 10._r8, 11._r8, 12._r8], [2,3]) + expected_time2 = reshape([13._r8, 14._r8, 15._r8, 16._r8, 17._r8, 18._r8], [2,3]) + expected = expected_time1 * 0.25_r8 + expected_time2 * 0.75_r8 + @assertEqual(expected, data, tolerance=tol) + + end subroutine test_get_current_data_2d + + +end module test_dynVarTimeInterp diff --git a/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf new file mode 100644 index 0000000000..9f41a8c1ac --- /dev/null +++ b/components/clm/src/dyn_subgrid/test/dynVar_test/test_dynVarTimeUninterp.pf @@ -0,0 +1,198 @@ +module test_dynVarTimeUninterp + + ! Tests of dyn_var_time_uninterp + + use pfunit_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + use dynVarTimeUninterpMod, only : dyn_var_time_uninterp_type + use test_dynVarShared + use dynFileMod, only : dyn_file_type + use ncdio_pio, only : ncd_get_read_times, ncd_reset_read_times + use unittestTimeManagerMod, only : unittest_timemgr_setup, unittest_timemgr_teardown + use unittestTimeManagerMod, only : set_year => unittest_timemgr_set_curr_year + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + + @TestCase + type, extends(TestCase) :: TestDynVarTimeUninterp + contains + procedure :: setUp + procedure :: tearDown + end type TestDynVarTimeUninterp + +contains + + subroutine setUp(this) + class(TestDynVarTimeUninterp), intent(inout) :: this + + call unittest_timemgr_setup() + end subroutine setUp + + subroutine tearDown(this) + class(TestDynVarTimeUninterp), intent(inout) :: this + + call unittest_timemgr_teardown() + end subroutine tearDown + + @Test + subroutine test_get_current_data_1d_noReads(this) + ! Test get_current_data_1d with no reads after initialization + class(TestDynVarTimeUninterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_uninterp_type) :: var + real(r8) :: data(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_uninterp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + call var%get_current_data(data) + @assertEqual([4.0_r8, 5.0_r8, 6.0_r8], data) + + ! Make sure that the above get_current_data call didn't trigger i/o: + @assertFalse(any(ncd_get_read_times(dyn_file, 'foo_1d'))) + + end subroutine test_get_current_data_1d_noReads + + + @Test + subroutine test_get_current_data_1d_noReads_update(this) + ! Test get_current_data_1d with no reads after initialization, although it has an + ! set_current_year call that shouldn't do anything + class(TestDynVarTimeUninterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_uninterp_type) :: var + real(r8) :: data(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_uninterp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! make sure that a call to set_current_year with an unchanged year doesn't affect things at all + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + @assertEqual([4.0_r8, 5.0_r8, 6.0_r8], data) + + ! Make sure that the above get_current_data call didn't trigger i/o: + @assertFalse(any(ncd_get_read_times(dyn_file, 'foo_1d'))) + + end subroutine test_get_current_data_1d_noReads_update + + + @Test + subroutine test_get_current_data_1d_noReads_conversion(this) + ! Test get_current_data_1d with no reads after initialization, with a conversion + ! factor + class(TestDynVarTimeUninterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_uninterp_type) :: var + real(r8) :: data(3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_uninterp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=2.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call var%get_current_data(data) + @assertEqual([2.0_r8, 2.5_r8, 3.0_r8], data, tolerance=tol) + + end subroutine test_get_current_data_1d_noReads_conversion + + + @Test + subroutine test_get_current_data_1d_doRead(this) + ! Test get_current_data_1d with an extra read after initialization + class(TestDynVarTimeUninterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_uninterp_type) :: var + real(r8) :: data(3) + logical, allocatable :: read_times(:) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_uninterp_type( & + dyn_file=dyn_file, & + varname='foo_1d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & + data_shape = shape(data)) + + call ncd_reset_read_times(dyn_file, 'foo_1d') + + ! advance to the next year, which should force a read + call set_year(13) + call dyn_file%time_info%set_current_year() + + call var%get_current_data(data) + @assertEqual([7.0_r8, 8.0_r8, 9.0_r8], data) + + ! Make sure that the get_current_data call DID trigger i/o in this case: + read_times = ncd_get_read_times(dyn_file, 'foo_1d') + @assertTrue(read_times(3)) + @assertFalse(any(read_times([1,2,4]))) + + end subroutine test_get_current_data_1d_doRead + + + @Test + subroutine test_get_current_data_2d(this) + ! Test get_current_data_2d + class(TestDynVarTimeUninterp), intent(inout) :: this + + type(dyn_file_type), target :: dyn_file + type(dyn_var_time_uninterp_type) :: var + real(r8) :: data(2,3) + real(r8) :: expected(2,3) + + ! Set up test data + call set_year(12) + dyn_file = create_dyn_file() + var = dyn_var_time_uninterp_type( & + dyn_file=dyn_file, & + varname='foo_2d', & + dim1name='grlnd', & + conversion_factor=1.0_r8, & + do_check_sums_equal_1 = .false., & ! setting this to false to avoid needing to set up the test data carefully + data_shape = shape(data)) + + call var%get_current_data(data) + expected = reshape([7._r8, 8._r8, 9._r8, 10._r8, 11._r8, 12._r8], [2,3]) + @assertEqual(expected, data) + + end subroutine test_get_current_data_2d + +end module test_dynVarTimeUninterp diff --git a/components/clm/src/main/CMakeLists.txt b/components/clm/src/main/CMakeLists.txt new file mode 100644 index 0000000000..ec53570868 --- /dev/null +++ b/components/clm/src/main/CMakeLists.txt @@ -0,0 +1,31 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources + ColumnType.F90 + pftconMod.F90 + FuncPedotransferMod.F90 + GridcellType.F90 + LandunitType.F90 + PatchType.F90 + abortutils.F90 + atm2lndMod.F90 + atm2lndType.F90 + accumulMod.F90 + clm_varcon.F90 + clm_varctl.F90 + clm_varpar.F90 + clm_varsur.F90 + column_varcon.F90 + decompMod.F90 + initSubgridMod.F90 + landunit_varcon.F90 + lnd2glcMod.F90 + ncdio_utils.F90 + organicFileMod.F90 + subgridAveMod.F90 + subgridWeightsMod.F90 + surfrdUtilsMod.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/main/ColumnType.F90 b/components/clm/src/main/ColumnType.F90 new file mode 100644 index 0000000000..8f230aff91 --- /dev/null +++ b/components/clm/src/main/ColumnType.F90 @@ -0,0 +1,144 @@ +module ColumnType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Column data type allocation and initialization + ! -------------------------------------------------------- + ! column types can have values of + ! -------------------------------------------------------- + ! 1 => (istsoil) soil (vegetated or bare soil) + ! 2 => (istcrop) crop (only for crop configuration) + ! 3 => (istice) land ice + ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 5 => (istdlak) deep lake + ! 6 => (istwet) wetland + ! 71 => (icol_roof) urban roof + ! 72 => (icol_sunwall) urban sunwall + ! 73 => (icol_shadewall) urban shadewall + ! 74 => (icol_road_imperv) urban impervious road + ! 75 => (icol_road_perv) urban pervious road + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak + use clm_varcon , only : spval, ispval + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: column_type + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: landunit (:) ! index into landunit level quantities + real(r8), pointer :: wtlunit (:) ! weight (relative to landunit) + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + integer , pointer :: patchi (:) ! beginning patch index for each column + integer , pointer :: patchf (:) ! ending patch index for each column + integer , pointer :: npatches (:) ! number of patches for each column + + ! topological mapping functionality + integer , pointer :: itype (:) ! column type + logical , pointer :: active (:) ! true=>do computations on this column + + ! topography + real(r8), pointer :: glc_topo (:) ! surface elevation (m) + real(r8), pointer :: micro_sigma (:) ! microtopography pdf sigma (m) + real(r8), pointer :: n_melt (:) ! SCA shape parameter + real(r8), pointer :: topo_slope (:) ! gridcell topographic slope + real(r8), pointer :: topo_std (:) ! gridcell elevation standard deviation + + ! vertical levels + integer , pointer :: snl (:) ! number of snow layers + real(r8), pointer :: dz (:,:) ! layer thickness (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: z (:,:) ! layer depth (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: zi (:,:) ! interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + real(r8), pointer :: zii (:) ! convective boundary height [m] + real(r8), pointer :: dz_lake (:,:) ! lake layer thickness (m) (1:nlevlak) + real(r8), pointer :: z_lake (:,:) ! layer depth for lake (m) + real(r8), pointer :: lakedepth (:) ! variable lake depth (m) + + contains + + procedure, public :: Init + procedure, public :: Clean + + end type column_type + + type(column_type), public, target :: col !column data structure (soil/snow/canopy columns) + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, begc, endc) + ! + ! !ARGUMENTS: + class(column_type) :: this + integer, intent(in) :: begc,endc + !------------------------------------------------------------------------ + + ! The following is set in initGridCellsMod + allocate(this%gridcell (begc:endc)) ; this%gridcell (:) = ispval + allocate(this%wtgcell (begc:endc)) ; this%wtgcell (:) = nan + allocate(this%landunit (begc:endc)) ; this%landunit (:) = ispval + allocate(this%wtlunit (begc:endc)) ; this%wtlunit (:) = nan + allocate(this%patchi (begc:endc)) ; this%patchi (:) = ispval + allocate(this%patchf (begc:endc)) ; this%patchf (:) = ispval + allocate(this%npatches (begc:endc)) ; this%npatches (:) = ispval + allocate(this%itype (begc:endc)) ; this%itype (:) = ispval + allocate(this%active (begc:endc)) ; this%active (:) = .false. + + ! The following is set in initVerticalMod + allocate(this%snl (begc:endc)) ; this%snl (:) = ispval !* cannot be averaged up + allocate(this%dz (begc:endc,-nlevsno+1:nlevgrnd)) ; this%dz (:,:) = nan + allocate(this%z (begc:endc,-nlevsno+1:nlevgrnd)) ; this%z (:,:) = nan + allocate(this%zi (begc:endc,-nlevsno+0:nlevgrnd)) ; this%zi (:,:) = nan + allocate(this%zii (begc:endc)) ; this%zii (:) = nan + allocate(this%lakedepth (begc:endc)) ; this%lakedepth (:) = spval + allocate(this%dz_lake (begc:endc,nlevlak)) ; this%dz_lake (:,:) = nan + allocate(this%z_lake (begc:endc,nlevlak)) ; this%z_lake (:,:) = nan + + allocate(this%glc_topo (begc:endc)) ; this%glc_topo (:) = nan + allocate(this%micro_sigma (begc:endc)) ; this%micro_sigma (:) = nan + allocate(this%n_melt (begc:endc)) ; this%n_melt (:) = nan + allocate(this%topo_slope (begc:endc)) ; this%topo_slope (:) = nan + allocate(this%topo_std (begc:endc)) ; this%topo_std (:) = nan + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine Clean(this) + ! + ! !ARGUMENTS: + class(column_type) :: this + !------------------------------------------------------------------------ + + deallocate(this%gridcell ) + deallocate(this%wtgcell ) + deallocate(this%landunit ) + deallocate(this%wtlunit ) + deallocate(this%patchi ) + deallocate(this%patchf ) + deallocate(this%npatches ) + deallocate(this%itype ) + deallocate(this%active ) + deallocate(this%snl ) + deallocate(this%dz ) + deallocate(this%z ) + deallocate(this%zi ) + deallocate(this%zii ) + deallocate(this%lakedepth ) + deallocate(this%dz_lake ) + deallocate(this%z_lake ) + deallocate(this%glc_topo ) + deallocate(this%micro_sigma) + deallocate(this%n_melt ) + deallocate(this%topo_slope ) + deallocate(this%topo_std ) + + end subroutine Clean + + +end module ColumnType diff --git a/components/clm/src/main/FuncPedotransferMod.F90 b/components/clm/src/main/FuncPedotransferMod.F90 new file mode 100644 index 0000000000..41e751344e --- /dev/null +++ b/components/clm/src/main/FuncPedotransferMod.F90 @@ -0,0 +1,141 @@ +module FuncPedotransferMod +! +!DESCRIPTIONS: +!module contains different pedotransfer functions to +!compute the mineral soil hydraulic properties. +!currenty, only the Clapp-Hornberg formulation is used. +!HISTORY: +!created by Jinyun Tang, Mar.1st, 2014 +implicit none + private + public :: pedotransf + public :: get_ipedof + public :: init_pedof + + integer, parameter :: cosby_1984_table5 = 0 !by default uses this form + integer, parameter :: cosby_1984_table4 = 1 + integer, parameter :: noilhan_lacarrere_1995 = 2 + integer :: ipedof0 +contains + + subroutine init_pedof() + ! + !DESCRIPTIONS + !initialize the default pedotransfer function + implicit none + + + ipedof0 = cosby_1984_table5 !the default pedotransfer function + end subroutine init_pedof + + subroutine pedotransf(ipedof, sand, clay, watsat, bsw, sucsat, xksat) + !pedotransfer function to compute hydraulic properties of mineral soil + !based on input soil texture + + use shr_kind_mod , only : r8 => shr_kind_r8 + use abortutils , only : endrun + implicit none + integer, intent(in) :: ipedof !type of pedotransfer function, use the default pedotransfer function + real(r8), intent(in) :: sand !% sand + real(r8), intent(in) :: clay !% clay + real(r8), intent(out):: watsat !v/v saturate moisture + real(r8), intent(out):: bsw !b shape parameter + real(r8), intent(out):: sucsat !mm, soil matric potential + real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity + + character(len=32) :: subname = 'pedotransf' ! subroutine name + select case (ipedof) + case (cosby_1984_table4) + call pedotransf_cosby1984_table4(sand, clay, watsat, bsw, sucsat, xksat) + case (noilhan_lacarrere_1995) + call pedotransf_noilhan_lacarrere1995(sand, clay, watsat, bsw, sucsat, xksat) + case (cosby_1984_table5) + call pedotransf_cosby1984_table5(sand, clay, watsat, bsw, sucsat, xksat) + case default + call endrun(subname // ':: a pedotransfer function must be specified!') + end select + + end subroutine pedotransf + +!------------------------------------------------------------------------------------------ + subroutine pedotransf_cosby1984_table4(sand, clay, watsat, bsw, sucsat, xksat) + ! + !DESCRIPTIONS + !compute hydraulic properties based on functions derived from Table 4 in cosby et al, 1984 + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: sand !% sand + real(r8), intent(in) :: clay !% clay + real(r8), intent(out):: watsat !v/v saturate moisture + real(r8), intent(out):: bsw !b shape parameter + real(r8), intent(out):: sucsat !mm, soil matric potential + real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity + + !Cosby et al. Table 4 + watsat = 0.505_r8-0.00142_r8*sand-0.00037*clay + bsw = 3.10+0.157*clay-0.003*sand + sucsat = 10._r8 * ( 10._r8**(1.54_r8-0.0095_r8*sand+0.0063*(100._r8-sand-clay))) + xksat = 0.0070556 *(10.**(-0.60+0.0126*sand-0.0064*clay) ) !mm/s now use table 4. + + end subroutine pedotransf_cosby1984_table4 + +!------------------------------------------------------------------------------------------ + subroutine pedotransf_cosby1984_table5(sand, clay, watsat, bsw, sucsat, xksat) + ! + !DESCRIPTIONS + !compute hydraulic properties based on functions derived from Table 5 in cosby et al, 1984 + + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: sand !% sand + real(r8), intent(in) :: clay !% clay + real(r8), intent(out):: watsat !v/v saturate moisture + real(r8), intent(out):: bsw !b shape parameter + real(r8), intent(out):: sucsat !mm, soil matric potential + real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity + + !Cosby et al. Table 5 + watsat = 0.489_r8 - 0.00126_r8*sand + bsw = 2.91 + 0.159*clay + sucsat = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) ) + xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s, from table 5 + + end subroutine pedotransf_cosby1984_table5 + +!------------------------------------------------------------------------------------------ + subroutine pedotransf_noilhan_lacarrere1995(sand, clay, watsat, bsw, sucsat, xksat) + ! + !DESCRIPTIONS + !compute hydraulic properties based on functions derived from Noilhan and Lacarrere, 1995 + + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: sand !% sand + real(r8), intent(in) :: clay !% clay + real(r8), intent(out):: watsat !v/v saturate moisture + real(r8), intent(out):: bsw !b shape parameter + real(r8), intent(out):: sucsat !mm, soil matric potential + real(r8), intent(out):: xksat !mm/s, saturated hydraulic conductivity + + !Noilhan and Lacarrere, 1995 + watsat = -0.00108*sand+0.494305 + bsw = 0.137*clay + 3.501 + sucsat = 10._r8**(-0.0088*sand+2.85) + xksat = 10._r8**(-0.0582*clay-0.00091*sand+0.000529*clay**2._r8-0.0001203*sand**2._r8-1.38) + end subroutine pedotransf_noilhan_lacarrere1995 +!------------------------------------------------------------------------------------------ + function get_ipedof(soil_order)result(ipedof) + ! + ! DESCRIPTION + ! select the pedotransfer function to be used + implicit none + integer, intent(in) :: soil_order + + integer :: ipedof + + if(soil_order==0)then + ipedof=ipedof0 + endif + + end function get_ipedof +end module FuncpedotransferMod diff --git a/components/clm/src/main/GetGlobalValuesMod.F90 b/components/clm/src/main/GetGlobalValuesMod.F90 new file mode 100644 index 0000000000..3421c54a8e --- /dev/null +++ b/components/clm/src/main/GetGlobalValuesMod.F90 @@ -0,0 +1,149 @@ +module GetGlobalValuesMod + + !----------------------------------------------------------------------- + ! Obtain and Write Global Index information + !----------------------------------------------------------------------- + implicit none + private + + ! PUBLIC MEMBER FUNCTIONS: + + public :: GetGlobalIndex + public :: GetGlobalWrite + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + integer function GetGlobalIndex(decomp_index, clmlevel) + + !---------------------------------------------------------------- + ! Description + ! Determine global index space value for target point at given clmlevel + ! + ! Uses: + use shr_log_mod, only: errMsg => shr_log_errMsg + use decompMod , only: bounds_type, get_clmlevel_gsmap, get_proc_bounds + use spmdMod , only: iam + use clm_varcon , only: nameg, namel, namec, namep + use clm_varctl , only: iulog + use mct_mod + ! + ! Arguments + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + ! + ! Local Variables: + type(bounds_type) :: bounds_proc ! processor bounds + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmap_ordered ! gsmap ordered points + integer :: beg_index ! beginning proc index for clmlevel + !---------------------------------------------------------------- + + call get_proc_bounds(bounds_proc) + + if (trim(clmlevel) == nameg) then + beg_index = bounds_proc%begg + else if (trim(clmlevel) == namel) then + beg_index = bounds_proc%begl + else if (trim(clmlevel) == namec) then + beg_index = bounds_proc%begc + else if (trim(clmlevel) == namep) then + beg_index = bounds_proc%begp + else + call shr_sys_abort('clmlevel of '//trim(clmlevel)//' not supported' // & + errmsg(__FILE__, __LINE__)) + end if + + call get_clmlevel_gsmap(clmlevel=trim(clmlevel), gsmap=gsmap) + call mct_gsmap_op(gsmap, iam, gsmap_ordered) + GetGlobalIndex = gsmap_ordered(decomp_index - beg_index + 1) + deallocate(gsmap_ordered) + + end function GetGlobalIndex + + !----------------------------------------------------------------------- + subroutine GetGlobalWrite(decomp_index, clmlevel) + + !----------------------------------------------------------------------- + ! Description: + ! Write global index information for input local indices + ! + use shr_sys_mod , only : shr_sys_flush + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_varcon , only : nameg, namel, namec, namep + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! Arguments: + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + ! + ! Local Variables: + integer :: igrc, ilun, icol, ipft + !----------------------------------------------------------------------- + + if (trim(clmlevel) == nameg) then + + igrc = decomp_index + write(iulog,*)'local gridcell index = ',igrc + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + + else if (trim(clmlevel) == namel) then + + ilun = decomp_index + igrc = lun%gridcell(ilun) + write(iulog,*)'local landunit index = ',ilun + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'landunit type = ',lun%itype(decomp_index) + + else if (trim(clmlevel) == namec) then + + icol = decomp_index + ilun = col%landunit(icol) + igrc = col%gridcell(icol) + write(iulog,*)'local column index = ',icol + write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec) + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'column type = ',col%itype(icol) + write(iulog,*)'landunit type = ',lun%itype(ilun) + + else if (trim(clmlevel) == namep) then + + ipft = decomp_index + icol = patch%column(ipft) + ilun = patch%landunit(ipft) + igrc = patch%gridcell(ipft) + write(iulog,*)'local patch index = ',ipft + write(iulog,*)'global patch index = ',GetGlobalIndex(decomp_index=ipft, clmlevel=namep) + write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec) + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'pft type = ',patch%itype(ipft) + write(iulog,*)'column type = ',col%itype(icol) + write(iulog,*)'landunit type = ',lun%itype(ilun) + + else + call shr_sys_abort('clmlevel '//trim(clmlevel)//'not supported '//errmsg(__FILE__, __LINE__)) + + end if + + call shr_sys_flush(iulog) + + end subroutine GetGlobalWrite + +end module GetGlobalValuesMod diff --git a/components/clm/src/main/GridcellType.F90 b/components/clm/src/main/GridcellType.F90 new file mode 100644 index 0000000000..973b44d080 --- /dev/null +++ b/components/clm/src/main/GridcellType.F90 @@ -0,0 +1,99 @@ +module GridcellType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Gridcell data type allocation + ! -------------------------------------------------------- + ! gridcell types can have values of + ! -------------------------------------------------------- + ! 1 => default + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use landunit_varcon, only : max_lunit + use clm_varcon , only : ispval + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: gridcell_type + + ! topological mapping functionality, local 1d gdc arrays + integer , pointer :: gindex (:) ! global index + real(r8), pointer :: area (:) ! total land area, gridcell (km^2) + real(r8), pointer :: lat (:) ! latitude (radians) + real(r8), pointer :: lon (:) ! longitude (radians) + real(r8), pointer :: latdeg (:) ! latitude (degrees) + real(r8), pointer :: londeg (:) ! longitude (degrees) + + ! Daylength + real(r8) , pointer :: max_dayl (:) ! maximum daylength for this grid cell (s) + real(r8) , pointer :: dayl (:) ! daylength (seconds) + real(r8) , pointer :: prev_dayl (:) ! daylength from previous timestep (seconds) + + ! indices into landunit-level arrays for landunits in this grid cell (ispval implies + ! this landunit doesn't exist on this grid cell) [1:max_lunit, begg:endg] + ! (note that the spatial dimension is last here, in contrast to most 2-d variables; + ! this is for efficiency, since most loops will go over g in the outer loop, and + ! landunit type in the inner loop) + integer , pointer :: landunit_indices (:,:) + + contains + + procedure, public :: Init + procedure, public :: Clean + + end type gridcell_type + type(gridcell_type), public, target :: grc !gridcell data structure + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, begg, endg) + ! + ! !ARGUMENTS: + class(gridcell_type) :: this + integer, intent(in) :: begg, endg + !------------------------------------------------------------------------ + + ! The following is set in InitGridCells + allocate(this%gindex (begg:endg)) ; this%gindex (:) = ispval + allocate(this%area (begg:endg)) ; this%area (:) = nan + allocate(this%lat (begg:endg)) ; this%lat (:) = nan + allocate(this%lon (begg:endg)) ; this%lon (:) = nan + allocate(this%latdeg (begg:endg)) ; this%latdeg (:) = nan + allocate(this%londeg (begg:endg)) ; this%londeg (:) = nan + + ! This is initiailized in module DayLength + allocate(this%max_dayl (begg:endg)) ; this%max_dayl (:) = nan + allocate(this%dayl (begg:endg)) ; this%dayl (:) = nan + allocate(this%prev_dayl (begg:endg)) ; this%prev_dayl (:) = nan + + allocate(this%landunit_indices(1:max_lunit, begg:endg)); this%landunit_indices(:,:) = ispval + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine Clean(this) + ! + ! !ARGUMENTS: + class(gridcell_type) :: this + !------------------------------------------------------------------------ + + deallocate(this%gindex ) + deallocate(this%area ) + deallocate(this%lat ) + deallocate(this%lon ) + deallocate(this%latdeg ) + deallocate(this%londeg ) + deallocate(this%max_dayl ) + deallocate(this%dayl ) + deallocate(this%prev_dayl ) + deallocate(this%landunit_indices ) + + end subroutine Clean + +end module GridcellType diff --git a/components/clm/src/main/LandunitType.F90 b/components/clm/src/main/LandunitType.F90 new file mode 100644 index 0000000000..bb6ac80d6a --- /dev/null +++ b/components/clm/src/main/LandunitType.F90 @@ -0,0 +1,140 @@ +module LandunitType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Landunit data type allocation + ! -------------------------------------------------------- + ! landunits types can have values of (see landunit_varcon.F90) + ! -------------------------------------------------------- + ! 1 => (istsoil) soil (vegetated or bare soil landunit) + ! 2 => (istcrop) crop (only for crop configuration) + ! 3 => (istice) land ice + ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 5 => (istdlak) deep lake + ! 6 => (istwet) wetland + ! 7 => (isturb_tbd) urban tbd + ! 8 => (isturb_hd) urban hd + ! 9 => (isturb_md) urban md + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : ispval + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: landunit_type + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + integer , pointer :: coli (:) ! beginning column index per landunit + integer , pointer :: colf (:) ! ending column index for each landunit + integer , pointer :: ncolumns (:) ! number of columns for each landunit + integer , pointer :: patchi (:) ! beginning patch index for each landunit + integer , pointer :: patchf (:) ! ending patch index for each landunit + integer , pointer :: npatches (:) ! number of patches for each landunit + + ! topological mapping functionality + integer , pointer :: itype (:) ! landunit type + logical , pointer :: ifspecial (:) ! true=>landunit is not vegetated + logical , pointer :: lakpoi (:) ! true=>lake point + logical , pointer :: urbpoi (:) ! true=>urban point + logical , pointer :: glcmecpoi (:) ! true=>glacier_mec point + logical , pointer :: active (:) ! true=>do computations on this landunit + + ! urban properties + real(r8), pointer :: canyon_hwr (:) ! urban landunit canyon height to width ratio (-) + real(r8), pointer :: wtroad_perv (:) ! urban landunit weight of pervious road column to total road (-) + real(r8), pointer :: wtlunit_roof (:) ! weight of roof with respect to urban landunit (-) + real(r8), pointer :: ht_roof (:) ! height of urban roof (m) + real(r8), pointer :: z_0_town (:) ! urban landunit momentum roughness length (m) + real(r8), pointer :: z_d_town (:) ! urban landunit displacement height (m) + + contains + + procedure, public :: Init ! Allocate and initialize + procedure, public :: Clean ! Clean up memory + + end type landunit_type + ! Singleton instance of the landunitType + type(landunit_type), public, target :: lun !geomorphological landunits + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, begl, endl) + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Allocate memory and initialize to signalling NaN to require + ! data be properly initialized somewhere else. + ! + ! !ARGUMENTS: + class(landunit_type) :: this + integer, intent(in) :: begl,endl + !------------------------------------------------------------------------ + + ! The following is set in InitGridCellsMod + allocate(this%gridcell (begl:endl)); this%gridcell (:) = ispval + allocate(this%wtgcell (begl:endl)); this%wtgcell (:) = nan + allocate(this%coli (begl:endl)); this%coli (:) = ispval + allocate(this%colf (begl:endl)); this%colf (:) = ispval + allocate(this%ncolumns (begl:endl)); this%ncolumns (:) = ispval + allocate(this%patchi (begl:endl)); this%patchi (:) = ispval + allocate(this%patchf (begl:endl)); this%patchf (:) = ispval + allocate(this%npatches (begl:endl)); this%npatches (:) = ispval + allocate(this%itype (begl:endl)); this%itype (:) = ispval + allocate(this%ifspecial (begl:endl)); this%ifspecial (:) = .false. + allocate(this%lakpoi (begl:endl)); this%lakpoi (:) = .false. + allocate(this%urbpoi (begl:endl)); this%urbpoi (:) = .false. + allocate(this%glcmecpoi (begl:endl)); this%glcmecpoi (:) = .false. + + ! The following is initialized in routine setActive in module reweightMod + allocate(this%active (begl:endl)) + + ! The following is set in routine urbanparams_inst%Init in module UrbanParamsType + allocate(this%canyon_hwr (begl:endl)); this%canyon_hwr (:) = nan + allocate(this%wtroad_perv (begl:endl)); this%wtroad_perv (:) = nan + allocate(this%ht_roof (begl:endl)); this%ht_roof (:) = nan + allocate(this%wtlunit_roof (begl:endl)); this%wtlunit_roof (:) = nan + allocate(this%z_0_town (begl:endl)); this%z_0_town (:) = nan + allocate(this%z_d_town (begl:endl)); this%z_d_town (:) = nan + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine Clean(this) + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Clean up memory use + ! + ! !ARGUMENTS: + class(landunit_type) :: this + !------------------------------------------------------------------------ + + deallocate(this%gridcell ) + deallocate(this%wtgcell ) + deallocate(this%coli ) + deallocate(this%colf ) + deallocate(this%ncolumns ) + deallocate(this%patchi ) + deallocate(this%patchf ) + deallocate(this%npatches ) + deallocate(this%itype ) + deallocate(this%ifspecial ) + deallocate(this%lakpoi ) + deallocate(this%urbpoi ) + deallocate(this%glcmecpoi ) + deallocate(this%active ) + deallocate(this%canyon_hwr ) + deallocate(this%wtroad_perv ) + deallocate(this%ht_roof ) + deallocate(this%wtlunit_roof ) + deallocate(this%z_0_town ) + deallocate(this%z_d_town ) + + end subroutine Clean + +end module LandunitType diff --git a/components/clm/src/main/PatchType.F90 b/components/clm/src/main/PatchType.F90 new file mode 100644 index 0000000000..cc52e1822c --- /dev/null +++ b/components/clm/src/main/PatchType.F90 @@ -0,0 +1,197 @@ +module PatchType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Patch data type allocation + ! -------------------------------------------------------- + ! patch types can have values of + ! -------------------------------------------------------- + ! 0 => not_vegetated + ! 1 => needleleaf_evergreen_temperate_tree + ! 2 => needleleaf_evergreen_boreal_tree + ! 3 => needleleaf_deciduous_boreal_tree + ! 4 => broadleaf_evergreen_tropical_tree + ! 5 => broadleaf_evergreen_temperate_tree + ! 6 => broadleaf_deciduous_tropical_tree + ! 7 => broadleaf_deciduous_temperate_tree + ! 8 => broadleaf_deciduous_boreal_tree + ! 9 => broadleaf_evergreen_shrub + ! 10 => broadleaf_deciduous_temperate_shrub + ! 11 => broadleaf_deciduous_boreal_shrub + ! 12 => c3_arctic_grass + ! 13 => c3_non-arctic_grass + ! 14 => c4_grass + ! 15 => c3_crop + ! 16 => c3_irrigated + ! 17 => temperate_corn + ! 18 => irrigated_temperate_corn + ! 19 => spring_wheat + ! 20 => irrigated_spring_wheat + ! 21 => winter_wheat + ! 22 => irrigated_winter_wheat + ! 23 => temperate_soybean + ! 24 => irrigated_temperate_soybean + ! 25 => barley + ! 26 => irrigated_barley + ! 27 => winter_barley + ! 28 => irrigated_winter_barley + ! 29 => rye + ! 30 => irrigated_rye + ! 31 => winter_rye + ! 32 => irrigated_winter_rye + ! 33 => cassava + ! 34 => irrigated_cassava + ! 35 => citrus + ! 36 => irrigated_citrus + ! 37 => cocoa + ! 38 => irrigated_cocoa + ! 39 => coffee + ! 40 => irrigated_coffee + ! 41 => cotton + ! 42 => irrigated_cotton + ! 43 => datepalm + ! 44 => irrigated_datepalm + ! 45 => foddergrass + ! 46 => irrigated_foddergrass + ! 47 => grapes + ! 48 => irrigated_grapes + ! 49 => groundnuts + ! 50 => irrigated_groundnuts + ! 51 => millet + ! 52 => irrigated_millet + ! 53 => oilpalm + ! 54 => irrigated_oilpalm + ! 55 => potatoes + ! 56 => irrigated_potatoes + ! 57 => pulses + ! 58 => irrigated_pulses + ! 59 => rapeseed + ! 60 => irrigated_rapeseed + ! 61 => rice + ! 62 => irrigated_rice + ! 63 => sorghum + ! 64 => irrigated_sorghum + ! 65 => sugarbeet + ! 66 => irrigated_sugarbeet + ! 67 => sugarcane + ! 68 => irrigated_sugarcane + ! 69 => sunflower + ! 70 => irrigated_sunflower + ! 71 => miscanthus + ! 72 => irrigated_miscanthus + ! 73 => switchgrass + ! 74 => irrigated_switchgrass + ! 75 => tropical_corn + ! 76 => irrigated_tropical_corn + ! 77 => tropical_soybean + ! 78 => irrigated_tropical_soybean + ! -------------------------------------------------------- + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : ispval + use clm_varctl , only : use_ed + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: patch_type + + ! g/l/c/p hierarchy, local g/l/c/p cells only + integer , pointer :: column (:) ! index into column level quantities + real(r8), pointer :: wtcol (:) ! weight (relative to column) + integer , pointer :: landunit (:) ! index into landunit level quantities + real(r8), pointer :: wtlunit (:) ! weight (relative to landunit) + integer , pointer :: gridcell (:) ! index into gridcell level quantities + real(r8), pointer :: wtgcell (:) ! weight (relative to gridcell) + + ! Non-ED only + integer , pointer :: itype (:) ! patch vegetation + integer , pointer :: mxy (:) ! m index for laixy(i,j,m),etc. (undefined for special landunits) + logical , pointer :: active (:) ! true=>do computations on this patch + + ! ED only + logical , pointer :: is_veg (:) + logical , pointer :: is_bareground (:) + real(r8), pointer :: wt_ed (:) !TODO mv ? can this be removed + + contains + + procedure, public :: Init + procedure, public :: Clean + + end type patch_type + type(patch_type), public, target :: patch ! patch type data structure + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, begp, endp) + ! + ! !ARGUMENTS: + class(patch_type) :: this + integer, intent(in) :: begp,endp + ! + ! LOCAL VARAIBLES: + !------------------------------------------------------------------------ + + ! The following is set in InitGridCells + + allocate(this%gridcell (begp:endp)); this%gridcell (:) = ispval + allocate(this%wtgcell (begp:endp)); this%wtgcell (:) = nan + + allocate(this%landunit (begp:endp)); this%landunit (:) = ispval + allocate(this%wtlunit (begp:endp)); this%wtlunit (:) = nan + + allocate(this%column (begp:endp)); this%column (:) = ispval + allocate(this%wtcol (begp:endp)); this%wtcol (:) = nan + + allocate(this%mxy (begp:endp)); this%mxy (:) = ispval + allocate(this%active (begp:endp)); this%active (:) = .false. + + ! TODO (MV, 10-17-14): The following must be commented out because + ! currently the logic checking if patch%itype(p) is not equal to noveg + ! is used in RootBiogeophysMod in zeng2001_rootfr- a filter is not used + ! in that routine - which would elimate this problem + + ! if (.not. use_ed) then + allocate(this%itype (begp:endp)); this%itype (:) = ispval + ! end if + + if (use_ed) then + allocate(this%is_veg (begp:endp)); this%is_veg (:) = .false. + allocate(this%is_bareground (begp:endp)); this%is_bareground (:) = .false. + allocate(this%wt_ed (begp:endp)); this%wt_ed (:) = nan + end if + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine Clean(this) + ! + ! !ARGUMENTS: + class(patch_type) :: this + !------------------------------------------------------------------------ + + deallocate(this%gridcell) + deallocate(this%wtgcell ) + deallocate(this%landunit) + deallocate(this%wtlunit ) + deallocate(this%column ) + deallocate(this%wtcol ) + deallocate(this%itype ) + deallocate(this%mxy ) + deallocate(this%active ) + + if (use_ed) then + deallocate(this%is_veg) + deallocate(this%is_bareground) + deallocate(this%wt_ed) + end if + + end subroutine Clean + +end module PatchType diff --git a/components/clm/src/main/abortutils.F90 b/components/clm/src/main/abortutils.F90 new file mode 100644 index 0000000000..cd91e53a7d --- /dev/null +++ b/components/clm/src/main/abortutils.F90 @@ -0,0 +1,81 @@ +module abortutils + + !----------------------------------------------------------------------- + ! !MODULE: abortutils + ! + ! !DESCRIPTION: + ! Abort the model for abnormal termination + !----------------------------------------------------------------------- + + private + save + + public :: endrun + + interface endrun + module procedure endrun_vanilla + module procedure endrun_globalindex + end interface + +CONTAINS + + !----------------------------------------------------------------------- + subroutine endrun_vanilla(msg) + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in), optional :: msg ! string to be printed + !----------------------------------------------------------------------- + + if (present (msg)) then + write(iulog,*)'ENDRUN:', msg + else + write(iulog,*)'ENDRUN: called without a message string' + end if + + call shr_sys_abort() + + end subroutine endrun_vanilla + + !----------------------------------------------------------------------- + subroutine endrun_globalindex(decomp_index, clmlevel, msg) + + !----------------------------------------------------------------------- + ! Description: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + use GetGlobalValuesMod, only: GetGlobalWrite + ! + ! Arguments: + implicit none + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + character(len=*) , intent(in), optional :: msg ! string to be printed + ! + ! Local Variables: + integer :: igrc, ilun, icol + !----------------------------------------------------------------------- + + write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) + call GetGlobalWrite(decomp_index, clmlevel) + + if (present (msg)) then + write(iulog,*)'ENDRUN:', msg + else + write(iulog,*)'ENDRUN: called without a message string' + end if + + call shr_sys_abort() + + end subroutine endrun_globalindex + +end module abortutils diff --git a/components/clm/src/main/accumulMod.F90 b/components/clm/src/main/accumulMod.F90 new file mode 100644 index 0000000000..59cb26ec58 --- /dev/null +++ b/components/clm/src/main/accumulMod.F90 @@ -0,0 +1,620 @@ +module accumulMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! This module contains generic subroutines that can be used to + ! define, accumulate and extract user-specified fields over + ! user-defined intervals. Each interval and accumulation type is + ! unique to each field processed. + ! Subroutine [init_accumulator] defines the values of the accumulated + ! field data structure. Subroutine [update_accum_field] does + ! the actual accumulation for a given field. + ! Four types of accumulations are possible: + ! - Average over time interval. Time average fields are only + ! valid at the end of the averaging interval. + ! - Running mean over time interval. Running means are valid once the + ! length of the simulation exceeds the + ! - Running accumulation over time interval. Accumulated fields are + ! continuously accumulated. The trigger value "-99999." resets + ! the accumulation to zero. + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: accumulRest ! Write/read restart of accumulation fields + public :: init_accum_field ! Initialize an accumulator field + public :: print_accum_fields ! Print info about accumulator fields + public :: extract_accum_field ! Extracts the current value of an accumulator field + public :: update_accum_field ! Update the current value of an accumulator field + + interface extract_accum_field + module procedure extract_accum_field_sl ! Extract current val of single-level accumulator field + module procedure extract_accum_field_ml ! Extract current val of multi-level accumulator field + end interface + interface update_accum_field ! Updates the current value of an accumulator field + module procedure update_accum_field_sl ! Update single-level accumulator field + module procedure update_accum_field_ml ! Update multi-level accumulator field + end interface + private + ! + ! !PRIVATE TYPES: + type accum_field + character(len= 8) :: name !field name + character(len=128) :: desc !field description + character(len= 8) :: units !field units + character(len= 8) :: acctype !accumulation type: ["timeavg","runmean","runaccum"] + character(len= 8) :: type1d !subgrid type: ["gridcell","landunit","column" or "pft"] + character(len= 8) :: type2d !type2d ('','levsoi','numrad',..etc. ) + integer :: beg1d !subgrid type beginning index + integer :: end1d !subgrid type ending index + integer :: num1d !total subgrid points + integer :: numlev !number of vertical levels in field + real(r8) :: initval !initial value of accumulated field + real(r8), pointer :: val(:,:) !accumulated field + integer :: period !field accumulation period (in model time steps) + end type accum_field + + real(r8), parameter, public :: accumResetVal = -99999._r8 ! used to do an annual reset ( put in for bug 1858) + + integer, parameter :: max_accum = 100 !maximum number of accumulated fields + type (accum_field) :: accum(max_accum) !array accumulated fields + integer :: naccflds = 0 !accumulator field counter + + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_accum_field (name, units, desc, & + accum_type, accum_period, numlev, subgrid_type, init_value, type2d) + ! + ! !DESCRIPTION: + ! Initialize accumulation fields. This subroutine sets: + ! o name of accumulated field + ! o units of accumulated field + ! o accumulation type of accumulated field + ! o description of accumulated fields: accdes + ! o accumulation period for accumulated field (in iterations) + ! o initial value of accumulated field + ! + ! !USES: + use shr_const_mod, only: SHR_CONST_CDAY + use clm_time_manager, only : get_step_size + use decompMod, only : get_proc_bounds, get_proc_global + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + character(len=*), intent(in) :: units !field units + character(len=*), intent(in) :: desc !field description + character(len=*), intent(in) :: accum_type !field type: tavg, runm, runa, ins + integer , intent(in) :: accum_period !field accumulation period + character(len=*), intent(in) :: subgrid_type !["gridcell","landunit","column" or "patch"] + integer , intent(in) :: numlev !number of vertical levels + real(r8), intent(in) :: init_value !field initial or reset value + character(len=*), intent(in), optional :: type2d !level type (optional) - needed if numlev > 1 + ! + ! !LOCAL VARIABLES: + integer :: nf ! field index + integer :: beg1d,end1d ! beggining and end subgrid indices + integer :: num1d ! total number subgrid indices + integer :: begp, endp ! per-proc beginning and ending patch indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: begCohort, endCohort ! per-proc beg end cohort indices + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of patches across all processors + integer :: numCohort ! total number of cohorts across all processors + !------------------------------------------------------------------------ + + ! Determine necessary indices + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort ) + call get_proc_global(numg, numl, numc, nump, numCohort) + + ! update field index + ! Consistency check that number of accumulated does not exceed maximum. + + naccflds = naccflds + 1 + if (naccflds > max_accum) then + write(iulog,*) 'ACCUMULINIT error: user-defined accumulation fields ', & + 'equal to ',naccflds,' exceeds max_accum' + call shr_sys_abort() + end if + nf = naccflds + + ! Note accumulation period must be converted from days + ! to number of iterations + + accum(nf)%name = trim(name) + accum(nf)%units = trim(units) + accum(nf)%desc = trim(desc) + accum(nf)%acctype = trim(accum_type) + accum(nf)%initval = init_value + accum(nf)%period = accum_period + if (accum(nf)%period < 0) then + accum(nf)%period = -accum(nf)%period * nint(SHR_CONST_CDAY) / get_step_size() + end if + + select case (trim(subgrid_type)) + case ('gridcell') + beg1d = begg + end1d = endg + num1d = numg + case ('landunit') + beg1d = begl + end1d = endl + num1d = numl + case ('column') + beg1d = begc + end1d = endc + num1d = numc + case ('pft') + beg1d = begp + end1d = endp + num1d = nump + case default + write(iulog,*)'ACCUMULINIT: unknown subgrid type ',subgrid_type + call shr_sys_abort () + end select + + accum(nf)%type1d = trim(subgrid_type) + accum(nf)%beg1d = beg1d + accum(nf)%end1d = end1d + accum(nf)%num1d = num1d + accum(nf)%numlev = numlev + + if (present(type2d)) then + accum(nf)%type2d = type2d + else + accum(nf)%type2d = ' ' + end if + + ! Allocate and initialize accumulation field + + allocate(accum(nf)%val(beg1d:end1d,numlev)) + accum(nf)%val(beg1d:end1d,numlev) = init_value + + end subroutine init_accum_field + + !------------------------------------------------------------------------ + subroutine print_accum_fields() + ! + ! !DESCRIPTION: + ! Diagnostic printout of accumulated fields + ! + ! !USES: + use spmdMod, only : masterproc + ! + ! !ARGUMENTS: + implicit none + ! + integer :: i,nf !indices + !------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) + write(iulog,*) 'Initializing variables for time accumulation .....' + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Accumulated fields' + write(iulog,1002) + write(iulog,'(72a1)') ("_",i=1,71) + do nf = 1, naccflds + if (accum(nf)%period /= huge(1)) then + write(iulog,1003) nf,accum(nf)%name,accum(nf)%units,& + accum(nf)%acctype, accum(nf)%period, accum(nf)%initval, & + accum(nf)%desc + else + write(iulog,1004) nf,accum(nf)%name,accum(nf)%units,& + accum(nf)%acctype, accum(nf)%initval, accum(nf)%desc + endif + end do + write(iulog,'(72a1)') ("_",i=1,71) + write(iulog,*) + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Successfully initialized variables for accumulation' + write(iulog,*) + endif + +1002 format(' No',' Name ',' Units ',' Type ','Period',' Inival',' Description') +1003 format((1x,i2),(1x,a8),(1x,a8),(1x,a8), (1x,i5),(1x,f4.0),(1x,a40)) +1004 format((1x,i2),(1x,a8),(1x,a8),(1x,a8),' N.A.',(1x,f4.0),(1x,a40)) + + end subroutine print_accum_fields + + !------------------------------------------------------------------------ + subroutine extract_accum_field_sl (name, field, nstep) + ! + ! !DESCRIPTION: + ! Extract single-level accumulated field. + ! This routine extracts the field values from the multi-level + ! accumulation field. It extracts the current value except if + ! the field type is a time average. In this case, an absurd value + ! is assigned to indicate the time average is not yet valid. + ! + ! !USES: + use clm_varcon, only : spval, ispval + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:) :: field !field values for current time step + integer , intent(in) :: nstep !timestep index + ! + ! !LOCAL VARIABLES: + integer :: i,k,nf !indices + integer :: beg,end !subgrid beginning,ending indices + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'EXTRACT_ACCUM_FIELD_SL error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',& + size(field,dim=1),' and should be ',end-beg+1 + call shr_sys_abort + endif + + ! extract field + + if (accum(nf)%acctype == 'timeavg' .and. & + mod(nstep,accum(nf)%period) /= 0) then + do k = beg,end + field(k) = spval !assign absurd value when avg not ready + end do + else + do k = beg,end + field(k) = accum(nf)%val(k,1) + end do + end if + + end subroutine extract_accum_field_sl + + !------------------------------------------------------------------------ + subroutine extract_accum_field_ml (name, field, nstep) + ! + ! !DESCRIPTION: + ! Extract mutli-level accumulated field. + ! This routine extracts the field values from the multi-level + ! accumulation field. It extracts the current value except if + ! the field type is a time average. In this case, an absurd value + ! is assigned to indicate the time average is not yet valid. + ! + ! !USES: + use clm_varcon, only : spval + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:,:) :: field !field values for current time step + integer, intent(in) :: nstep !timestep index + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,nf !indices + integer :: beg,end !subgrid beginning,ending indices + integer :: numlev !number of vertical levels + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'EXTRACT_ACCUM_FIELD_ML error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + numlev = accum(nf)%numlev + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',& + size(field,dim=1),' and should be ',end-beg+1 + call shr_sys_abort + else if (size(field,dim=2) /= numlev) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of second dimension of field iis ',& + size(field,dim=2),' and should be ',numlev + call shr_sys_abort + endif + + !extract field + + if (accum(nf)%acctype == 'timeavg' .and. & + mod(nstep,accum(nf)%period) /= 0) then + do j = 1,numlev + do k = beg,end + field(k,j) = spval !assign absurd value when avg not ready + end do + end do + else + do j = 1,numlev + do k = beg,end + field(k,j) = accum(nf)%val(k,j) + end do + end do + end if + + end subroutine extract_accum_field_ml + + !------------------------------------------------------------------------ + subroutine update_accum_field_sl (name, field, nstep) + ! + ! !DESCRIPTION: + ! Accumulate single level field over specified time interval. + ! The appropriate field is accumulated in the array [accval]. + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:) :: field !field values for current time step + integer , intent(in) :: nstep !time step index + ! + ! !LOCAL VARIABLES: + integer :: i,k,nf !indices + integer :: accper !temporary accumulation period + integer :: beg,end !subgrid beginning,ending indices + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'UPDATE_ACCUM_FIELD_SL error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_SL for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',size(field,dim=1),& + ' and should be ',end-beg+1 + call shr_sys_abort + endif + + ! accumulate field + + if (accum(nf)%acctype /= 'timeavg' .AND. & + accum(nf)%acctype /= 'runmean' .AND. & + accum(nf)%acctype /= 'runaccum') then + write(iulog,*) 'UPDATE_ACCUM_FIELD_SL error: incorrect accumulation type' + write(iulog,*) ' was specified for field ',name + write(iulog,*)' accumulation type specified is ',accum(nf)%acctype + write(iulog,*)' only [timeavg, runmean, runaccum] are currently acceptable' + call shr_sys_abort() + end if + + + ! reset accumulated field value if necessary and update + ! accumulation field + ! running mean never reset + + if (accum(nf)%acctype == 'timeavg') then + + !time average field reset every accumulation period + !normalize at end of accumulation period + + if ((mod(nstep,accum(nf)%period) == 1 .or. accum(nf)%period == 1) .and. (nstep /= 0))then + accum(nf)%val(beg:end,1) = 0._r8 + end if + accum(nf)%val(beg:end,1) = accum(nf)%val(beg:end,1) + field(beg:end) + if (mod(nstep,accum(nf)%period) == 0) then + accum(nf)%val(beg:end,1) = accum(nf)%val(beg:end,1) / accum(nf)%period + endif + + else if (accum(nf)%acctype == 'runmean') then + + !running mean - reset accumulation period until greater than nstep + + accper = min (nstep,accum(nf)%period) + accum(nf)%val(beg:end,1) = ((accper-1)*accum(nf)%val(beg:end,1) + field(beg:end)) / accper + + else if (accum(nf)%acctype == 'runaccum') then + + !running accumulation field reset at trigger -99999 + + do k = beg,end + if (nint(field(k)) == -99999) then + accum(nf)%val(k,1) = 0._r8 + end if + end do + accum(nf)%val(beg:end,1) = min(max(accum(nf)%val(beg:end,1) + field(beg:end), 0._r8), 99999._r8) + + end if + + end subroutine update_accum_field_sl + + !------------------------------------------------------------------------ + subroutine update_accum_field_ml (name, field, nstep) + ! + ! !DESCRIPTION: + ! Accumulate multi level field over specified time interval. + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:,:) :: field !field values for current time step + integer , intent(in) :: nstep !time step index + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,nf !indices + integer :: accper !temporary accumulation period + integer :: beg,end !subgrid beginning,ending indices + integer :: numlev !number of vertical levels + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'UPDATE_ACCUM_FIELD_ML error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + numlev = accum(nf)%numlev + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',size(field,dim=1),& + ' and should be ',end-beg+1 + call shr_sys_abort + else if (size(field,dim=2) /= numlev) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name + write(iulog,*)'size of second dimension of field is ',size(field,dim=2),& + ' and should be ',numlev + call shr_sys_abort + endif + + ! accumulate field + + if (accum(nf)%acctype /= 'timeavg' .AND. & + accum(nf)%acctype /= 'runmean' .AND. & + accum(nf)%acctype /= 'runaccum') then + write(iulog,*) 'UPDATE_ACCUM_FIELD_ML error: incorrect accumulation type' + write(iulog,*) ' was specified for field ',name + write(iulog,*)' accumulation type specified is ',accum(nf)%acctype + write(iulog,*)' only [timeavg, runmean, runaccum] are currently acceptable' + call shr_sys_abort() + end if + + ! accumulate field + + ! reset accumulated field value if necessary and update + ! accumulation field + ! running mean never reset + + if (accum(nf)%acctype == 'timeavg') then + + !time average field reset every accumulation period + !normalize at end of accumulation period + + if ((mod(nstep,accum(nf)%period) == 1 .or. accum(nf)%period == 1) .and. (nstep /= 0))then + accum(nf)%val(beg:end,1:numlev) = 0._r8 + endif + accum(nf)%val(beg:end,1:numlev) = accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev) + if (mod(nstep,accum(nf)%period) == 0) then + accum(nf)%val(beg:end,1:numlev) = accum(nf)%val(beg:end,1:numlev) / accum(nf)%period + endif + + else if (accum(nf)%acctype == 'runmean') then + + !running mean - reset accumulation period until greater than nstep + + accper = min (nstep,accum(nf)%period) + accum(nf)%val(beg:end,1:numlev) = & + ((accper-1)*accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev)) / accper + + else if (accum(nf)%acctype == 'runaccum') then + + !running accumulation field reset at trigger -99999 + + do j = 1,numlev + do k = beg,end + if (nint(field(k,j)) == -99999) then + accum(nf)%val(k,j) = 0._r8 + end if + end do + end do + accum(nf)%val(beg:end,1:numlev) = & + min(max(accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev), 0._r8), 99999._r8) + + end if + + end subroutine update_accum_field_ml + + !------------------------------------------------------------------------ + subroutine accumulRest( ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write accumulation restart data + ! + ! !USES: + use clm_varcon , only : ispval + use restUtilMod , only : restartvar + use ncdio_pio , only : file_desc_t, ncd_double, ncd_int + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid !netcdf unit + character(len=*) , intent(in) :: flag !'define','read', or 'write' + ! + ! !LOCAL VARIABLES: + integer :: nf ! indices + logical :: readvar ! determine if variable is on initial file + character(len=128) :: varname ! temporary + character(len= 32) :: subname='AccumRest' ! subroutine name + !------------------------------------------------------------------------ + + do nf = 1,naccflds + + ! Note = below need to allocate rbuf for single level variables, since + ! accum(nf)%val is always 2d + + varname = trim(accum(nf)%name) // '_VALUE' + if (accum(nf)%numlev == 1) then + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name=accum(nf)%type1d, & + long_name=accum(nf)%desc, units=accum(nf)%units, & + interpinic_flag='interp', & + data=accum(nf)%val, readvar=readvar) + else + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name=accum(nf)%type1d, dim2name=accum(nf)%type2d, & + long_name=accum(nf)%desc, units=accum(nf)%units, & + interpinic_flag='interp', & + data=accum(nf)%val, readvar=readvar) + end if + + varname = trim(accum(nf)%name) // '_PERIOD' + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_int, & + long_name='', units='time steps', & + imissing_value=ispval, ifill_value=huge(1), & + interpinic_flag='copy', & + data=accum(nf)%period, readvar=readvar) + + end do + + end subroutine accumulRest + +end module accumulMod diff --git a/components/clm/src/main/atm2lndMod.F90 b/components/clm/src/main/atm2lndMod.F90 new file mode 100644 index 0000000000..c6be648a6d --- /dev/null +++ b/components/clm/src/main/atm2lndMod.F90 @@ -0,0 +1,589 @@ +module atm2lndMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle atm2lnd forcing + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. + use clm_varcon , only : rair, grav, cpair, hfus, tfrz, denh2o, spval + use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, iulog + use abortutils , only : endrun + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: downscale_forcings ! Downscale atm forcing fields from gridcell to column + + ! The following routines are public for the sake of unit testing; they should not be + ! called by production code outside this module + public :: partition_precip ! Partition precipitation into rain/snow + public :: sens_heat_from_precip_conversion ! Compute sensible heat flux needed to compensate for rain-snow conversion + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: repartition_rain_snow_one_col ! Re-partition precipitation for a single column + private :: downscale_longwave ! Downscale longwave radiation from gridcell to column + private :: build_normalization ! Compute normalization factors so that downscaled fields are conservative + private :: check_downscale_consistency ! Check consistency of downscaling + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine downscale_forcings(bounds,num_do_smb_c,filter_do_smb_c, & + atm2lnd_inst, eflx_sh_precip_conversion) + ! + ! !DESCRIPTION: + ! Downscale atmospheric forcing fields from gridcell to column. + ! + ! Note that the downscaling procedure can result in changes in grid cell mean values + ! compared to what was provided by the atmosphere. We conserve fluxes of mass and + ! energy, but allow states such as temperature to differ. + ! + ! For most variables, downscaling is done over columns defined by filter_do_smb_c. But + ! we also do direct copies of gridcell-level forcings into column-level forcings over + ! all other active columns. In addition, precipitation (rain vs. snow partitioning) + ! is adjusted everywhere. + ! + ! !USES: + use clm_varcon , only : rair, cpair, grav, lapse_glcmec + use landunit_varcon , only : istice_mec + use domainMod , only : ldomain + use QsatMod , only : Qsat + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_do_smb_c ! number of columns in filter_do_smb_c + integer , intent(in) :: filter_do_smb_c(:) ! filter_do_smb_c giving columns over which downscaling should be done + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst + real(r8) , intent(out) :: eflx_sh_precip_conversion(bounds%begc:) ! sensible heat flux from precipitation conversion (W/m**2) [+ to atm] + ! + ! !LOCAL VARIABLES: + integer :: g, l, c, fc ! indices + integer :: clo, cc + + ! temporaries for topo downscaling + real(r8) :: hsurf_g,hsurf_c,Hbot + real(r8) :: zbot_g, tbot_g, pbot_g, thbot_g, qbot_g, qs_g, es_g + real(r8) :: zbot_c, tbot_c, pbot_c, thbot_c, qbot_c, qs_c, es_c + real(r8) :: egcm_c, rhos_c + real(r8) :: dum1, dum2 + + character(len=*), parameter :: subname = 'downscale_forcings' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(eflx_sh_precip_conversion) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate(& + ! Gridcell-level non-downscaled fields: + forc_t_g => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_th_g => atm2lnd_inst%forc_th_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin) + forc_q_g => atm2lnd_inst%forc_q_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg) + forc_pbot_g => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric pressure (Pa) + forc_rho_g => atm2lnd_inst%forc_rho_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3) + + ! Column-level downscaled fields: + forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Output: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_th_c => atm2lnd_inst%forc_th_downscaled_col , & ! Output: [real(r8) (:)] atmospheric potential temperature (Kelvin) + forc_q_c => atm2lnd_inst%forc_q_downscaled_col , & ! Output: [real(r8) (:)] atmospheric specific humidity (kg/kg) + forc_pbot_c => atm2lnd_inst%forc_pbot_downscaled_col , & ! Output: [real(r8) (:)] atmospheric pressure (Pa) + forc_rho_c => atm2lnd_inst%forc_rho_downscaled_col & ! Output: [real(r8) (:)] atmospheric density (kg/m**3) + ) + + ! Initialize column forcing (needs to be done for ALL active columns) + do c = bounds%begc,bounds%endc + if (col%active(c)) then + g = col%gridcell(c) + + forc_t_c(c) = forc_t_g(g) + forc_th_c(c) = forc_th_g(g) + forc_q_c(c) = forc_q_g(g) + forc_pbot_c(c) = forc_pbot_g(g) + forc_rho_c(c) = forc_rho_g(g) + end if + end do + + ! Downscale forc_t, forc_th, forc_q, forc_pbot, and forc_rho to columns. + ! For glacier_mec columns the downscaling is based on surface elevation. + ! For other columns the downscaling is a simple copy (above). + do fc = 1, num_do_smb_c + c = filter_do_smb_c(fc) + l = col%landunit(c) + g = col%gridcell(c) + + ! This is a simple downscaling procedure + ! Note that forc_hgt, forc_u, and forc_v are not downscaled. + + hsurf_g = ldomain%topo(g) ! gridcell sfc elevation + hsurf_c = col%glc_topo(c) ! column sfc elevation + tbot_g = forc_t_g(g) ! atm sfc temp + thbot_g = forc_th_g(g) ! atm sfc pot temp + qbot_g = forc_q_g(g) ! atm sfc spec humid + pbot_g = forc_pbot_g(g) ! atm sfc pressure + zbot_g = atm2lnd_inst%forc_hgt_grc(g) ! atm ref height + zbot_c = zbot_g + tbot_c = tbot_g-lapse_glcmec*(hsurf_c-hsurf_g) ! sfc temp for column + Hbot = rair*0.5_r8*(tbot_g+tbot_c)/grav ! scale ht at avg temp + pbot_c = pbot_g*exp(-(hsurf_c-hsurf_g)/Hbot) ! column sfc press + + ! Derivation of potential temperature calculation: + ! + ! The textbook definition would be: + ! thbot_c = tbot_c * (p0/pbot_c)^(rair/cpair) + ! + ! Note that pressure is related to scale height as: + ! pbot_c = p0 * exp(-zbot_c/H) + ! + ! Using Hbot in place of H, we get: + ! pbot_c = p0 * exp(-zbot_c/Hbot) + ! + ! Plugging this in to the textbook definition, then manipulating, we get: + ! thbot_c = tbot_c * (p0/(p0*exp(-zbot_c/Hbot)))^(rair/cpair) + ! = tbot_c * (1/exp(-zbot_c/Hbot))^(rair/cpair) + ! = tbot_c * (exp(zbot_c/Hbot))^(rair/cpair) + ! = tbot_c * exp((zbot_c/Hbot) * (rair/cpair)) + + thbot_c= tbot_c*exp((zbot_c/Hbot)*(rair/cpair)) ! pot temp calc + + call Qsat(tbot_g,pbot_g,es_g,dum1,qs_g,dum2) + call Qsat(tbot_c,pbot_c,es_c,dum1,qs_c,dum2) + + qbot_c = qbot_g*(qs_c/qs_g) + egcm_c = qbot_c*pbot_c/(0.622+0.378*qbot_c) + rhos_c = (pbot_c-0.378*egcm_c) / (rair*tbot_c) + + forc_t_c(c) = tbot_c + forc_th_c(c) = thbot_c + forc_q_c(c) = qbot_c + forc_pbot_c(c) = pbot_c + forc_rho_c(c) = rhos_c + + end do + + call partition_precip(bounds, atm2lnd_inst, & + eflx_sh_precip_conversion(bounds%begc:bounds%endc)) + + call downscale_longwave(bounds, num_do_smb_c, filter_do_smb_c, atm2lnd_inst) + + call check_downscale_consistency(bounds, atm2lnd_inst) + + end associate + + end subroutine downscale_forcings + + !----------------------------------------------------------------------- + subroutine partition_precip(bounds, atm2lnd_inst, eflx_sh_precip_conversion) + ! + ! !DESCRIPTION: + ! Partition precipitation into rain/snow based on temperature. + ! + ! Note that, unlike the other downscalings done here, this is currently applied over + ! all points - not just those within the do_smb filter. + ! + ! !USES: + use clm_varctl , only : repartition_rain_snow + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst + real(r8), intent(inout) :: eflx_sh_precip_conversion(bounds%begc:) ! sensible heat flux from precipitation conversion (W/m**2) [+ to atm] + ! + ! !LOCAL VARIABLES: + integer :: c,g ! indices + real(r8) :: rain_old ! rain before conversion + real(r8) :: snow_old ! snow before conversion + + character(len=*), parameter :: subname = 'partition_precip' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(eflx_sh_precip_conversion) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + associate(& + ! Gridcell-level non-downscaled fields: + forc_rain_g => atm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] rain rate [mm/s] + forc_snow_g => atm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] snow rate [mm/s] + + ! Column-level downscaled fields: + forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_rain_c => atm2lnd_inst%forc_rain_downscaled_col , & ! Output: [real(r8) (:)] rain rate [mm/s] + forc_snow_c => atm2lnd_inst%forc_snow_downscaled_col & ! Output: [real(r8) (:)] snow rate [mm/s] + ) + + ! Initialize column forcing + do c = bounds%begc,bounds%endc + if (col%active(c)) then + g = col%gridcell(c) + forc_rain_c(c) = forc_rain_g(g) + forc_snow_c(c) = forc_snow_g(g) + eflx_sh_precip_conversion(c) = 0._r8 + end if + end do + + ! Optionally, convert rain to snow or vice versa based on forc_t_c + if (repartition_rain_snow) then + do c = bounds%begc, bounds%endc + if (col%active(c)) then + rain_old = forc_rain_c(c) + snow_old = forc_snow_c(c) + call repartition_rain_snow_one_col(& + temperature = forc_t_c(c), & + rain = forc_rain_c(c), & + snow = forc_snow_c(c)) + call sens_heat_from_precip_conversion(& + rain_old = rain_old, & + snow_old = snow_old, & + rain_new = forc_rain_c(c), & + snow_new = forc_snow_c(c), & + sens_heat_flux = eflx_sh_precip_conversion(c)) + end if + end do + end if + + end associate + + end subroutine partition_precip + + !----------------------------------------------------------------------- + subroutine repartition_rain_snow_one_col(temperature, rain, snow) + ! + ! !DESCRIPTION: + ! Re-partition precipitation into rain/snow for a single column. + ! + ! Rain and snow variables should be set initially, and are updated here + ! + ! !USES: + use shr_precip_mod, only : shr_precip_partition_rain_snow_ramp + ! + ! !ARGUMENTS: + real(r8) , intent(in) :: temperature ! near-surface temperature (K) + real(r8) , intent(inout) :: rain ! atm rain rate [mm/s] + real(r8) , intent(inout) :: snow ! atm snow rate [(mm water equivalent)/s] + ! + ! !LOCAL VARIABLES: + real(r8) :: frac_rain ! fraction of precipitation that should become rain + real(r8) :: total_precip + + character(len=*), parameter :: subname = 'repartition_rain_snow_one_col' + !----------------------------------------------------------------------- + + call shr_precip_partition_rain_snow_ramp(temperature, frac_rain) + + total_precip = rain + snow + rain = total_precip * frac_rain + snow = total_precip - rain + + end subroutine repartition_rain_snow_one_col + + !----------------------------------------------------------------------- + subroutine sens_heat_from_precip_conversion(rain_old, snow_old, rain_new, snow_new, & + sens_heat_flux) + ! + ! !DESCRIPTION: + ! Given old and new rain and snow amounts, compute the sensible heat flux needed to + ! compensate for the rain-snow conversion. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(in) :: rain_old ! [mm/s] + real(r8), intent(in) :: snow_old ! [(mm water equivalent)/s] + real(r8), intent(in) :: rain_new ! [mm/s] + real(r8), intent(in) :: snow_new ! [(mm water equivalent)/s] + real(r8), intent(out) :: sens_heat_flux ! [W/m^2] + ! + ! !LOCAL VARIABLES: + real(r8) :: total_old + real(r8) :: total_new + real(r8) :: rain_to_snow ! net conversion of rain to snow + + real(r8), parameter :: mm_to_m = 1.e-3_r8 ! multiply by this to convert from mm to m + real(r8), parameter :: tol = 1.e-13_r8 ! relative tolerance for error checks + + character(len=*), parameter :: subname = 'sens_heat_from_precip_conversion' + !----------------------------------------------------------------------- + + total_old = rain_old + snow_old + total_new = rain_new + snow_new + SHR_ASSERT(abs(total_new - total_old) <= (tol * total_old), subname//' ERROR: mismatch between old and new totals') + + ! rain to snow releases energy, so results in a positive heat flux to atm + rain_to_snow = snow_new - snow_old + sens_heat_flux = rain_to_snow * mm_to_m * denh2o * hfus + + end subroutine sens_heat_from_precip_conversion + + + !----------------------------------------------------------------------- + subroutine downscale_longwave(bounds, num_do_smb_c, filter_do_smb_c, atm2lnd_inst) + ! + ! !DESCRIPTION: + ! Downscale longwave radiation from gridcell to column + ! Must be done AFTER temperature downscaling + ! + ! !USES: + use domainMod , only : ldomain + use landunit_varcon , only : istice_mec + use clm_varcon , only : lapse_glcmec + use clm_varctl , only : glcmec_downscale_longwave + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_do_smb_c ! number of columns in filter_do_smb_c + integer , intent(in) :: filter_do_smb_c(:) ! filter_do_smb_c giving columns over which downscaling should be done (currently glcmec columns) + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst + ! + ! !LOCAL VARIABLES: + integer :: c,l,g,fc ! indices + real(r8) :: hsurf_c ! column-level elevation (m) + real(r8) :: hsurf_g ! gridcell-level elevation (m) + + real(r8), dimension(bounds%begg : bounds%endg) :: sum_lwrad_g ! weighted sum of column-level lwrad + real(r8), dimension(bounds%begg : bounds%endg) :: sum_wts_g ! sum of weights that contribute to sum_lwrad_g + real(r8), dimension(bounds%begg : bounds%endg) :: lwrad_norm_g ! normalization factors + real(r8), dimension(bounds%begg : bounds%endg) :: newsum_lwrad_g ! weighted sum of column-level lwrad after normalization + + character(len=*), parameter :: subname = 'downscale_longwave' + !----------------------------------------------------------------------- + + associate(& + ! Gridcell-level fields: + forc_t_g => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_lwrad_g => atm2lnd_inst%forc_lwrad_not_downscaled_grc, & ! Input: [real(r8) (:)] downward longwave (W/m**2) + + ! Column-level (downscaled) fields: + forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_lwrad_c => atm2lnd_inst%forc_lwrad_downscaled_col & ! Output: [real(r8) (:)] downward longwave (W/m**2) + ) + + ! Initialize column forcing (needs to be done for ALL active columns) + do c = bounds%begc, bounds%endc + if (col%active(c)) then + g = col%gridcell(c) + forc_lwrad_c(c) = forc_lwrad_g(g) + end if + end do + + ! Optionally, downscale the longwave radiation, conserving energy + if (glcmec_downscale_longwave) then + + ! Initialize variables related to normalization + do g = bounds%begg, bounds%endg + sum_lwrad_g(g) = 0._r8 + sum_wts_g(g) = 0._r8 + newsum_lwrad_g(g) = 0._r8 + end do + + ! Do the downscaling + do fc = 1, num_do_smb_c + c = filter_do_smb_c(fc) + l = col%landunit(c) + g = col%gridcell(c) + + hsurf_g = ldomain%topo(g) + hsurf_c = col%glc_topo(c) + + ! Here we assume that deltaLW = (dLW/dT)*(dT/dz)*deltaz + ! We get dLW/dT = 4*eps*sigma*T^3 = 4*LW/T from the Stefan-Boltzmann law, + ! evaluated at the mean temp. + ! We assume the same temperature lapse rate as above. + + forc_lwrad_c(c) = forc_lwrad_g(g) - & + 4.0_r8 * forc_lwrad_g(g)/(0.5_r8*(forc_t_c(c)+forc_t_g(g))) * & + lapse_glcmec * (hsurf_c - hsurf_g) + + ! Keep track of the gridcell-level weighted sum for later normalization. + ! + ! This gridcell-level weighted sum just includes points for which we do the + ! downscaling (e.g., glc_mec points). Thus the contributing weights + ! generally do not add to 1. So to do the normalization properly, we also + ! need to keep track of the weights that have contributed to this sum. + sum_lwrad_g(g) = sum_lwrad_g(g) + col%wtgcell(c)*forc_lwrad_c(c) + sum_wts_g(g) = sum_wts_g(g) + col%wtgcell(c) + end do + + + ! Normalize forc_lwrad_c(c) to conserve energy + + call build_normalization(orig_field=forc_lwrad_g(bounds%begg:bounds%endg), & + sum_field=sum_lwrad_g(bounds%begg:bounds%endg), & + sum_wts=sum_wts_g(bounds%begg:bounds%endg), & + norms=lwrad_norm_g(bounds%begg:bounds%endg)) + + do fc = 1, num_do_smb_c + c = filter_do_smb_c(fc) + l = col%landunit(c) + g = col%gridcell(c) + + forc_lwrad_c(c) = forc_lwrad_c(c) * lwrad_norm_g(g) + newsum_lwrad_g(g) = newsum_lwrad_g(g) + col%wtgcell(c)*forc_lwrad_c(c) + end do + + + ! Make sure that, after normalization, the grid cell mean is conserved + + do g = bounds%begg, bounds%endg + if (sum_wts_g(g) > 0._r8) then + if (abs((newsum_lwrad_g(g) / sum_wts_g(g)) - forc_lwrad_g(g)) > 1.e-8_r8) then + write(iulog,*) 'g, newsum_lwrad_g, sum_wts_g, forc_lwrad_g: ', & + g, newsum_lwrad_g(g), sum_wts_g(g), forc_lwrad_g(g) + call endrun(msg=' ERROR: Energy conservation error downscaling longwave'//& + errMsg(__FILE__, __LINE__)) + end if + end if + end do + + end if ! glcmec_downscale_longwave + + end associate + + end subroutine downscale_longwave + + !----------------------------------------------------------------------- + subroutine build_normalization(orig_field, sum_field, sum_wts, norms) + ! + ! !DESCRIPTION: + ! Build an array of normalization factors that can be applied to a downscaled forcing + ! field, in order to force the mean of the new field to be the same as the mean of + ! the old field (for conservation). + ! + ! This allows for the possibility that only a subset of columns are downscaled. Only + ! the columns that are adjusted should be included in the weighted sum, sum_field; + ! sum_wts gives the sum of contributing weights on the grid cell level. + + ! For example, if a grid cell has an original forcing value of 1.0, and contains 4 + ! columns with the following weights on the gridcell, and the following values after + ! normalization: + ! + ! col #: 1 2 3 4 + ! weight: 0.1 0.2 0.3 0.4 + ! downscaled?: yes yes no no + ! value: 0.9 1.1 1.0 1.0 + ! + ! Then we would have: + ! orig_field(g) = 1.0 + ! sum_field(g) = 0.1*0.9 + 0.2*1.1 = 0.31 + ! sum_wts(g) = 0.1 + 0.2 = 0.3 + ! norms(g) = 1.0 / (0.31 / 0.3) = 0.9677 + ! + ! The field can then be normalized as: + ! forc_lwrad_c(c) = forc_lwrad_c(c) * lwrad_norm_g(g) + ! where lwrad_norm_g is the array of norms computed by this routine + + ! + ! !ARGUMENTS: + real(r8), intent(in) :: orig_field(:) ! the original field, at the grid cell level + real(r8), intent(in) :: sum_field(:) ! the new weighted sum across columns (dimensioned by grid cell) + real(r8), intent(in) :: sum_wts(:) ! sum of the weights used to create sum_field (dimensioned by grid cell) + real(r8), intent(out) :: norms(:) ! computed normalization factors + !----------------------------------------------------------------------- + + SHR_ASSERT((size(orig_field) == size(norms)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT((size(sum_field) == size(norms)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT((size(sum_wts) == size(norms)), errMsg(__FILE__, __LINE__)) + + where (sum_wts == 0._r8) + ! Avoid divide by zero; if sum_wts is 0, then the normalization doesn't matter, + ! because the adjusted values won't affect the grid cell mean. + norms = 1.0_r8 + + elsewhere (sum_field == 0._r8) + ! Avoid divide by zero; this should only happen if the gridcell-level value is 0, + ! in which case the normalization doesn't matter + norms = 1.0_r8 + + elsewhere + ! The standard case + norms = orig_field / (sum_field / sum_wts) + + end where + + end subroutine build_normalization + + + !----------------------------------------------------------------------- + subroutine check_downscale_consistency(bounds, atm2lnd_inst) + ! + ! !DESCRIPTION: + ! Check consistency of downscaling + ! + ! Note that this operates over more than just the filter used for the downscaling, + ! because it checks some things outside that filter. + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(in) :: atm2lnd_inst + ! + ! !LOCAL VARIABLES: + integer :: g, l, c ! indices + character(len=*), parameter :: subname = 'check_downscale_consistency' + !----------------------------------------------------------------------- + + associate(& + ! Gridcell-level fields: + forc_t_g => atm2lnd_inst%forc_t_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_th_g => atm2lnd_inst%forc_th_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin) + forc_q_g => atm2lnd_inst%forc_q_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg) + forc_pbot_g => atm2lnd_inst%forc_pbot_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric pressure (Pa) + forc_rho_g => atm2lnd_inst%forc_rho_not_downscaled_grc , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3) + forc_rain_g => atm2lnd_inst%forc_rain_not_downscaled_grc , & ! Input: [real(r8) (:)] rain rate [mm/s] + forc_snow_g => atm2lnd_inst%forc_snow_not_downscaled_grc , & ! Input: [real(r8) (:)] snow rate [mm/s] + forc_lwrad_g => atm2lnd_inst%forc_lwrad_not_downscaled_grc , & ! Input: [real(r8) (:)] downward longwave (W/m**2) + + ! Column-level (downscaled) fields: + forc_t_c => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:)] atmospheric temperature (Kelvin) + forc_th_c => atm2lnd_inst%forc_th_downscaled_col , & ! Input: [real(r8) (:)] atmospheric potential temperature (Kelvin) + forc_q_c => atm2lnd_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:)] atmospheric specific humidity (kg/kg) + forc_pbot_c => atm2lnd_inst%forc_pbot_downscaled_col , & ! Input: [real(r8) (:)] atmospheric pressure (Pa) + forc_rho_c => atm2lnd_inst%forc_rho_downscaled_col , & ! Input: [real(r8) (:)] atmospheric density (kg/m**3) + forc_rain_c => atm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:)] rain rate [mm/s] + forc_snow_c => atm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:)] snow rate [mm/s] + forc_lwrad_c => atm2lnd_inst%forc_lwrad_downscaled_col & ! Input: [real(r8) (:)] downward longwave (W/m**2) + ) + + ! Make sure that, for urban points, the column-level forcing fields are identical to + ! the gridcell-level forcing fields. This is needed because the urban-specific code + ! sometimes uses the gridcell-level forcing fields (and it would take a large + ! refactor to change this to use column-level fields). + ! + ! However, do NOT check rain & snow: these ARE downscaled for urban points (as for + ! all other points), and the urban code does not refer to the gridcell-level versions + ! of these fields. + + do c = bounds%begc, bounds%endc + if (col%active(c)) then + l = col%landunit(c) + g = col%gridcell(c) + + if (lun%urbpoi(l)) then + if (forc_t_c(c) /= forc_t_g(g) .or. & + forc_th_c(c) /= forc_th_g(g) .or. & + forc_q_c(c) /= forc_q_g(g) .or. & + forc_pbot_c(c) /= forc_pbot_g(g) .or. & + forc_rho_c(c) /= forc_rho_g(g) .or. & + forc_lwrad_c(c) /= forc_lwrad_g(g)) then + write(iulog,*) subname//' ERROR: column-level forcing differs from gridcell-level forcing for urban point' + write(iulog,*) 'c, g = ', c, g + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if ! inequal + end if ! urbpoi + end if ! active + end do + + end associate + + end subroutine check_downscale_consistency + +end module atm2lndMod diff --git a/components/clm/src/main/atm2lndType.F90 b/components/clm/src/main/atm2lndType.F90 new file mode 100644 index 0000000000..c230962c3b --- /dev/null +++ b/components/clm/src/main/atm2lndType.F90 @@ -0,0 +1,873 @@ +module atm2lndType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle atm2lnd, lnd2atm mapping + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. + use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval + use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_ed, use_luna + use decompMod , only : bounds_type + use abortutils , only : endrun + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC DATA TYPES: + !---------------------------------------------------- + ! atmosphere -> land variables structure + ! + ! NOTE: + ! IF there are forcing variables that are downscaled - then the + ! non-downscaled versions SHOULD NOT be used in the code. Currently + ! the non-downscaled versions are only used n a handful of places in + ! the code (and needs to be used in lnd_import_export and the + ! downscaling routines), but in general should NOT be used in new + ! code. Instead use the datatype variables that have a _col suffix + ! which gives the downscaled versions of these fields. + !---------------------------------------------------- + type, public :: atm2lnd_type + + ! atm->lnd not downscaled + real(r8), pointer :: forc_u_grc (:) => null() ! atm wind speed, east direction (m/s) + real(r8), pointer :: forc_v_grc (:) => null() ! atm wind speed, north direction (m/s) + real(r8), pointer :: forc_wind_grc (:) => null() ! atmospheric wind speed + real(r8), pointer :: forc_hgt_grc (:) => null() ! atmospheric reference height (m) + real(r8), pointer :: forc_hgt_u_grc (:) => null() ! obs height of wind [m] (new) + real(r8), pointer :: forc_hgt_t_grc (:) => null() ! obs height of temperature [m] (new) + real(r8), pointer :: forc_hgt_q_grc (:) => null() ! obs height of humidity [m] (new) + real(r8), pointer :: forc_vp_grc (:) => null() ! atmospheric vapor pressure (Pa) + real(r8), pointer :: forc_rh_grc (:) => null() ! atmospheric relative humidity (%) + real(r8), pointer :: forc_psrf_grc (:) => null() ! surface pressure (Pa) + real(r8), pointer :: forc_pco2_grc (:) => null() ! CO2 partial pressure (Pa) + real(r8), pointer :: forc_pco2_240_patch (:) => null() ! 10-day mean CO2 partial pressure (Pa) + real(r8), pointer :: forc_solad_grc (:,:) => null() ! direct beam radiation (numrad) (vis=forc_sols , nir=forc_soll ) + real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) + real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation + real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) + real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) + real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa) + real(r8), pointer :: forc_aer_grc (:,:) => null() ! aerosol deposition array + real(r8), pointer :: forc_pch4_grc (:) => null() ! CH4 partial pressure (Pa) + + real(r8), pointer :: forc_t_not_downscaled_grc (:) => null() ! not downscaled atm temperature (Kelvin) + real(r8), pointer :: forc_th_not_downscaled_grc (:) => null() ! not downscaled atm potential temperature (Kelvin) + real(r8), pointer :: forc_q_not_downscaled_grc (:) => null() ! not downscaled atm specific humidity (kg/kg) + real(r8), pointer :: forc_pbot_not_downscaled_grc (:) => null() ! not downscaled atm pressure (Pa) + real(r8), pointer :: forc_pbot240_downscaled_patch (:) => null() ! 10-day mean downscaled atm pressure (Pa) + real(r8), pointer :: forc_rho_not_downscaled_grc (:) => null() ! not downscaled atm density (kg/m**3) + real(r8), pointer :: forc_rain_not_downscaled_grc (:) => null() ! not downscaled atm rain rate [mm/s] + real(r8), pointer :: forc_snow_not_downscaled_grc (:) => null() ! not downscaled atm snow rate [mm/s] + real(r8), pointer :: forc_lwrad_not_downscaled_grc (:) => null() ! not downscaled atm downwrd IR longwave radiation (W/m**2) + + ! atm->lnd downscaled + real(r8), pointer :: forc_t_downscaled_col (:) => null() ! downscaled atm temperature (Kelvin) + real(r8), pointer :: forc_th_downscaled_col (:) => null() ! downscaled atm potential temperature (Kelvin) + real(r8), pointer :: forc_q_downscaled_col (:) => null() ! downscaled atm specific humidity (kg/kg) + real(r8), pointer :: forc_pbot_downscaled_col (:) => null() ! downscaled atm pressure (Pa) + real(r8), pointer :: forc_rho_downscaled_col (:) => null() ! downscaled atm density (kg/m**3) + real(r8), pointer :: forc_rain_downscaled_col (:) => null() ! downscaled atm rain rate [mm/s] + real(r8), pointer :: forc_snow_downscaled_col (:) => null() ! downscaled atm snow rate [mm/s] + real(r8), pointer :: forc_lwrad_downscaled_col (:) => null() ! downscaled atm downwrd IR longwave radiation (W/m**2) + + ! rof->lnd + real(r8), pointer :: forc_flood_grc (:) => null() ! rof flood (mm/s) + real(r8), pointer :: volr_grc (:) => null() ! rof volr (m3) + + ! anomaly forcing + real(r8), pointer :: af_precip_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_uwind_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_vwind_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_tbot_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_pbot_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_shum_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_swdn_grc (:) => null() ! anomaly forcing + real(r8), pointer :: af_lwdn_grc (:) => null() ! anomaly forcing + real(r8), pointer :: bc_precip_grc (:) => null() ! anomaly forcing - add bias correction + + ! time averaged quantities + real(r8) , pointer :: fsd24_patch (:) => null() ! patch 24hr average of direct beam radiation + real(r8) , pointer :: fsd240_patch (:) => null() ! patch 240hr average of direct beam radiation + real(r8) , pointer :: fsi24_patch (:) => null() ! patch 24hr average of diffuse beam radiation + real(r8) , pointer :: fsi240_patch (:) => null() ! patch 240hr average of diffuse beam radiation + real(r8) , pointer :: prec365_patch (:) => null() ! patch 365-day running mean of tot. precipitation + real(r8) , pointer :: prec60_patch (:) => null() ! patch 60-day running mean of tot. precipitation (mm/s) + real(r8) , pointer :: prec10_patch (:) => null() ! patch 10-day running mean of tot. precipitation (mm/s) + real(r8) , pointer :: prec24_patch (:) => null() ! patch 24-hour running mean of tot. precipitation (mm/s) + real(r8) , pointer :: rh24_patch (:) => null() ! patch 24-hour running mean of relative humidity + real(r8) , pointer :: wind24_patch (:) => null() ! patch 24-hour running mean of wind + real(r8) , pointer :: t_mo_patch (:) => null() ! patch 30-day average temperature (Kelvin) + real(r8) , pointer :: t_mo_min_patch (:) => null() ! patch annual min of t_mo (Kelvin) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, public :: InitAccBuffer + procedure, public :: InitAccVars + procedure, public :: UpdateAccVars + procedure, public :: Restart + procedure, public :: Clean + + end type atm2lnd_type + !---------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize atm2lnd derived type + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + real(r8) :: ival = 0.0_r8 ! initial value + integer :: begg, endg + integer :: begc, endc + integer :: begp, endp + !------------------------------------------------------------------------ + + begg = bounds%begg; endg= bounds%endg + begc = bounds%begc; endc= bounds%endc + begp = bounds%begp; endp= bounds%endp + + ! atm->lnd + allocate(this%forc_u_grc (begg:endg)) ; this%forc_u_grc (:) = ival + allocate(this%forc_v_grc (begg:endg)) ; this%forc_v_grc (:) = ival + allocate(this%forc_wind_grc (begg:endg)) ; this%forc_wind_grc (:) = ival + allocate(this%forc_rh_grc (begg:endg)) ; this%forc_rh_grc (:) = ival + allocate(this%forc_hgt_grc (begg:endg)) ; this%forc_hgt_grc (:) = ival + allocate(this%forc_hgt_u_grc (begg:endg)) ; this%forc_hgt_u_grc (:) = ival + allocate(this%forc_hgt_t_grc (begg:endg)) ; this%forc_hgt_t_grc (:) = ival + allocate(this%forc_hgt_q_grc (begg:endg)) ; this%forc_hgt_q_grc (:) = ival + allocate(this%forc_vp_grc (begg:endg)) ; this%forc_vp_grc (:) = ival + allocate(this%forc_psrf_grc (begg:endg)) ; this%forc_psrf_grc (:) = ival + allocate(this%forc_pco2_grc (begg:endg)) ; this%forc_pco2_grc (:) = ival + allocate(this%forc_solad_grc (begg:endg,numrad)) ; this%forc_solad_grc (:,:) = ival + allocate(this%forc_solai_grc (begg:endg,numrad)) ; this%forc_solai_grc (:,:) = ival + allocate(this%forc_solar_grc (begg:endg)) ; this%forc_solar_grc (:) = ival + allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival + allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival + allocate(this%forc_po2_grc (begg:endg)) ; this%forc_po2_grc (:) = ival + allocate(this%forc_aer_grc (begg:endg,14)) ; this%forc_aer_grc (:,:) = ival + allocate(this%forc_pch4_grc (begg:endg)) ; this%forc_pch4_grc (:) = ival + if(use_luna)then + allocate(this%forc_pco2_240_patch (begp:endp)) ; this%forc_pco2_240_patch (:) = ival + allocate(this%forc_po2_240_patch (begp:endp)) ; this%forc_po2_240_patch (:) = ival + allocate(this%forc_pbot240_downscaled_patch(begp:endp)) ; this%forc_pbot240_downscaled_patch (:) = ival + endif + + ! atm->lnd not downscaled + allocate(this%forc_t_not_downscaled_grc (begg:endg)) ; this%forc_t_not_downscaled_grc (:) = ival + allocate(this%forc_q_not_downscaled_grc (begg:endg)) ; this%forc_q_not_downscaled_grc (:) = ival + allocate(this%forc_pbot_not_downscaled_grc (begg:endg)) ; this%forc_pbot_not_downscaled_grc (:) = ival + allocate(this%forc_th_not_downscaled_grc (begg:endg)) ; this%forc_th_not_downscaled_grc (:) = ival + allocate(this%forc_rho_not_downscaled_grc (begg:endg)) ; this%forc_rho_not_downscaled_grc (:) = ival + allocate(this%forc_lwrad_not_downscaled_grc (begg:endg)) ; this%forc_lwrad_not_downscaled_grc (:) = ival + allocate(this%forc_rain_not_downscaled_grc (begg:endg)) ; this%forc_rain_not_downscaled_grc (:) = ival + allocate(this%forc_snow_not_downscaled_grc (begg:endg)) ; this%forc_snow_not_downscaled_grc (:) = ival + + ! atm->lnd downscaled + allocate(this%forc_t_downscaled_col (begc:endc)) ; this%forc_t_downscaled_col (:) = ival + allocate(this%forc_q_downscaled_col (begc:endc)) ; this%forc_q_downscaled_col (:) = ival + allocate(this%forc_pbot_downscaled_col (begc:endc)) ; this%forc_pbot_downscaled_col (:) = ival + allocate(this%forc_th_downscaled_col (begc:endc)) ; this%forc_th_downscaled_col (:) = ival + allocate(this%forc_rho_downscaled_col (begc:endc)) ; this%forc_rho_downscaled_col (:) = ival + allocate(this%forc_lwrad_downscaled_col (begc:endc)) ; this%forc_lwrad_downscaled_col (:) = ival + allocate(this%forc_rain_downscaled_col (begc:endc)) ; this%forc_rain_downscaled_col (:) = ival + allocate(this%forc_snow_downscaled_col (begc:endc)) ; this%forc_snow_downscaled_col (:) = ival + + ! rof->lnd + allocate(this%forc_flood_grc (begg:endg)) ; this%forc_flood_grc (:) = ival + allocate(this%volr_grc (begg:endg)) ; this%volr_grc (:) = ival + + ! anomaly forcing + allocate(this%bc_precip_grc (begg:endg)) ; this%bc_precip_grc (:) = ival + allocate(this%af_precip_grc (begg:endg)) ; this%af_precip_grc (:) = ival + allocate(this%af_uwind_grc (begg:endg)) ; this%af_uwind_grc (:) = ival + allocate(this%af_vwind_grc (begg:endg)) ; this%af_vwind_grc (:) = ival + allocate(this%af_tbot_grc (begg:endg)) ; this%af_tbot_grc (:) = ival + allocate(this%af_pbot_grc (begg:endg)) ; this%af_pbot_grc (:) = ival + allocate(this%af_shum_grc (begg:endg)) ; this%af_shum_grc (:) = ival + allocate(this%af_swdn_grc (begg:endg)) ; this%af_swdn_grc (:) = ival + allocate(this%af_lwdn_grc (begg:endg)) ; this%af_lwdn_grc (:) = ival + + allocate(this%fsd24_patch (begp:endp)) ; this%fsd24_patch (:) = nan + allocate(this%fsd240_patch (begp:endp)) ; this%fsd240_patch (:) = nan + allocate(this%fsi24_patch (begp:endp)) ; this%fsi24_patch (:) = nan + allocate(this%fsi240_patch (begp:endp)) ; this%fsi240_patch (:) = nan + allocate(this%prec10_patch (begp:endp)) ; this%prec10_patch (:) = nan + allocate(this%prec60_patch (begp:endp)) ; this%prec60_patch (:) = nan + allocate(this%prec365_patch (begp:endp)) ; this%prec365_patch (:) = nan + if (use_ed) then + allocate(this%prec24_patch (begp:endp)) ; this%prec24_patch (:) = nan + allocate(this%rh24_patch (begp:endp)) ; this%rh24_patch (:) = nan + allocate(this%wind24_patch (begp:endp)) ; this%wind24_patch (:) = nan + end if + allocate(this%t_mo_patch (begp:endp)) ; this%t_mo_patch (:) = nan + allocate(this%t_mo_min_patch (begp:endp)) ; this%t_mo_min_patch (:) = spval ! TODO - initialize this elsewhere + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg, endg + integer :: begc, endc + integer :: begp, endp + !--------------------------------------------------------------------- + + begg = bounds%begg; endg= bounds%endg + begc = bounds%begc; endc= bounds%endc + begp = bounds%begp; endp= bounds%endp + + this%forc_flood_grc(begg:endg) = spval + call hist_addfld1d (fname='QFLOOD', units='mm/s', & + avgflag='A', long_name='runoff from river flooding', & + ptr_lnd=this%forc_flood_grc) + + this%volr_grc(begg:endg) = spval + call hist_addfld1d (fname='VOLR', units='m3', & + avgflag='A', long_name='river channel water storage', & + ptr_lnd=this%volr_grc) + + this%forc_wind_grc(begg:endg) = spval + call hist_addfld1d (fname='WIND', units='m/s', & + avgflag='A', long_name='atmospheric wind velocity magnitude', & + ptr_lnd=this%forc_wind_grc) + ! Rename of WIND for Urban intercomparision project + call hist_addfld1d (fname='Wind', units='m/s', & + avgflag='A', long_name='atmospheric wind velocity magnitude', & + ptr_gcell=this%forc_wind_grc, default = 'inactive') + + this%forc_hgt_grc(begg:endg) = spval + call hist_addfld1d (fname='ZBOT', units='m', & + avgflag='A', long_name='atmospheric reference height', & + ptr_lnd=this%forc_hgt_grc) + + this%forc_solar_grc(begg:endg) = spval + call hist_addfld1d (fname='FSDS', units='W/m^2', & + avgflag='A', long_name='atmospheric incident solar radiation', & + ptr_lnd=this%forc_solar_grc) + + this%forc_pco2_grc(begg:endg) = spval + call hist_addfld1d (fname='PCO2', units='Pa', & + avgflag='A', long_name='atmospheric partial pressure of CO2', & + ptr_lnd=this%forc_pco2_grc) + + this%forc_solar_grc(begg:endg) = spval + call hist_addfld1d (fname='SWdown', units='W/m^2', & + avgflag='A', long_name='atmospheric incident solar radiation', & + ptr_gcell=this%forc_solar_grc, default='inactive') + + this%forc_rh_grc(begg:endg) = spval + call hist_addfld1d (fname='RH', units='%', & + avgflag='A', long_name='atmospheric relative humidity', & + ptr_gcell=this%forc_rh_grc, default='inactive') + + if (use_lch4) then + this%forc_pch4_grc(begg:endg) = spval + call hist_addfld1d (fname='PCH4', units='Pa', & + avgflag='A', long_name='atmospheric partial pressure of CH4', & + ptr_lnd=this%forc_pch4_grc) + end if + + this%forc_t_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='Tair', units='K', & + avgflag='A', long_name='atmospheric air temperature', & + ptr_gcell=this%forc_t_not_downscaled_grc, default='inactive') + + this%forc_pbot_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='PSurf', units='Pa', & + avgflag='A', long_name='surface pressure', & + ptr_gcell=this%forc_pbot_not_downscaled_grc, default='inactive') + + this%forc_rain_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='Rainf', units='mm/s', & + avgflag='A', long_name='atmospheric rain', & + ptr_gcell=this%forc_rain_not_downscaled_grc, default='inactive') + + this%forc_lwrad_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='LWdown', units='W/m^2', & + avgflag='A', long_name='atmospheric longwave radiation', & + ptr_gcell=this%forc_lwrad_not_downscaled_grc, default='inactive') + + this%forc_rain_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='RAIN', units='mm/s', & + avgflag='A', long_name='atmospheric rain', & + ptr_lnd=this%forc_rain_not_downscaled_grc) + + this%forc_snow_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='SNOW', units='mm/s', & + avgflag='A', long_name='atmospheric snow', & + ptr_lnd=this%forc_snow_not_downscaled_grc) + + this%forc_rain_downscaled_col(begc:endc) = spval + call hist_addfld1d (fname='RAIN_REPARTITIONED', units='mm/s', & + avgflag='A', long_name='atmospheric rain, after rain/snow repartitioning based on temperature', & + ptr_col=this%forc_rain_downscaled_col) + + this%forc_snow_downscaled_col(begc:endc) = spval + call hist_addfld1d (fname='SNOW_REPARTITIONED', units='mm/s', & + avgflag='A', long_name='atmospheric snow, after rain/snow repartitioning based on temperature', & + ptr_col=this%forc_snow_downscaled_col) + + this%forc_t_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='TBOT', units='K', & + avgflag='A', long_name='atmospheric air temperature', & + ptr_lnd=this%forc_t_not_downscaled_grc) + + this%forc_th_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='THBOT', units='K', & + avgflag='A', long_name='atmospheric air potential temperature', & + ptr_lnd=this%forc_th_not_downscaled_grc) + + this%forc_q_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='QBOT', units='kg/kg', & + avgflag='A', long_name='atmospheric specific humidity', & + ptr_lnd=this%forc_q_not_downscaled_grc) + ! Rename of QBOT for Urban intercomparision project + this%forc_q_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='Qair', units='kg/kg', & + avgflag='A', long_name='atmospheric specific humidity', & + ptr_lnd=this%forc_q_not_downscaled_grc, default='inactive') + + this%forc_lwrad_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='FLDS', units='W/m^2', & + avgflag='A', long_name='atmospheric longwave radiation', & + ptr_lnd=this%forc_lwrad_not_downscaled_grc) + + this%forc_pbot_not_downscaled_grc(begg:endg) = spval + call hist_addfld1d (fname='PBOT', units='Pa', & + avgflag='A', long_name='atmospheric pressure', & + ptr_lnd=this%forc_pbot_not_downscaled_grc) + + ! Time averaged quantities + this%fsi24_patch(begp:endp) = spval + call hist_addfld1d (fname='FSI24', units='K', & + avgflag='A', long_name='indirect radiation (last 24hrs)', & + ptr_patch=this%fsi24_patch, default='inactive') + + this%fsi240_patch(begp:endp) = spval + call hist_addfld1d (fname='FSI240', units='K', & + avgflag='A', long_name='indirect radiation (last 240hrs)', & + ptr_patch=this%fsi240_patch, default='inactive') + + this%fsd24_patch(begp:endp) = spval + call hist_addfld1d (fname='FSD24', units='K', & + avgflag='A', long_name='direct radiation (last 24hrs)', & + ptr_patch=this%fsd24_patch, default='inactive') + + this%fsd240_patch(begp:endp) = spval + call hist_addfld1d (fname='FSD240', units='K', & + avgflag='A', long_name='direct radiation (last 240hrs)', & + ptr_patch=this%fsd240_patch, default='inactive') + + if (use_cndv) then + call hist_addfld1d (fname='TDA', units='K', & + avgflag='A', long_name='daily average 2-m temperature', & + ptr_patch=this%t_mo_patch) + end if + + if(use_luna)then + this%forc_pco2_240_patch = spval + call hist_addfld1d (fname='PCO2_240', units='Pa', & + avgflag='A', long_name='10 day running mean of CO2 pressure', & + ptr_patch=this%forc_pco2_240_patch, default='inactive') + this%forc_po2_240_patch = spval + call hist_addfld1d (fname='PO2_240', units='Pa', & + avgflag='A', long_name='10 day running mean of O2 pressure', & + ptr_patch=this%forc_po2_240_patch, default='inactive') + this%forc_pbot240_downscaled_patch = spval + call hist_addfld1d (fname='PBOT_240', units='Pa', & + avgflag='A', long_name='10 day running mean of air pressure', & + ptr_patch=this%forc_pbot240_downscaled_patch, default='inactive') + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitAccBuffer (this, bounds) + ! + ! !DESCRIPTION: + ! Initialize accumulation buffer for all required module accumulated fields + ! This routine set defaults values that are then overwritten by the + ! restart file for restart or branch runs + ! + ! !USES + use clm_varcon , only : spval + use accumulMod , only : init_accum_field + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + !--------------------------------------------------------------------- + + this%fsd24_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSD24', units='W/m2', & + desc='24hr average of direct solar radiation', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%fsd240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSD240', units='W/m2', & + desc='240hr average of direct solar radiation', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%fsi24_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSI24', units='W/m2', & + desc='24hr average of diffuse solar radiation', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + this%fsi240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='FSI240', units='W/m2', & + desc='240hr average of diffuse solar radiation', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + if (use_cn) then + call init_accum_field (name='PREC10', units='MM H2O/S', & + desc='10-day running mean of total precipitation', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='PREC60', units='MM H2O/S', & + desc='60-day running mean of total precipitation', accum_type='runmean', accum_period=-60, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if + + if (use_cndv) then + ! The following is a running mean with the accumulation period is set to -365 for a 365-day running mean. + call init_accum_field (name='PREC365', units='MM H2O/S', & + desc='365-day running mean of total precipitation', accum_type='runmean', accum_period=-365, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if + + if ( use_ed ) then + call init_accum_field (name='PREC24', units='m', & + desc='24hr sum of precipitation', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! Fudge - this neds to be initialized from the restat file eventually. + call init_accum_field (name='RH24', units='m', & + desc='24hr average of RH', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=100._r8) + + call init_accum_field (name='WIND24', units='m', & + desc='24hr average of wind', accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if + + if(use_luna) then + this%forc_po2_240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='po2_240', units='Pa', & + desc='10-day running mean of parial O2 pressure', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=21223._r8) + + this%forc_pco2_240_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='pco2_240', units='Pa', & + desc='10-day running mean of parial CO2 pressure', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=28._r8) + + this%forc_pbot240_downscaled_patch(bounds%begp:bounds%endp) = spval + call init_accum_field (name='pbot240', units='Pa', & + desc='10-day running mean of air pressure', accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=101325._r8) + + endif + + end subroutine InitAccBuffer + + !----------------------------------------------------------------------- + subroutine InitAccVars(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module variables that are associated with + ! time accumulated fields. This routine is called for both an initial run + ! and a restart run (and must therefore must be called after the restart file + ! is read in and the accumulation buffer is obtained) + ! + ! !USES + use accumulMod , only : extract_accum_field + use clm_time_manager , only : get_nstep + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)' in ' + call endrun(msg="extract_accum_hist allocation error for rbufslp"//& + errMsg(__FILE__, __LINE__)) + endif + + ! Determine time step + nstep = get_nstep() + + call extract_accum_field ('FSD24', rbufslp, nstep) + this%fsd24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('FSD240', rbufslp, nstep) + this%fsd240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('FSI24', rbufslp, nstep) + this%fsi24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('FSI240', rbufslp, nstep) + this%fsi240_patch(begp:endp) = rbufslp(begp:endp) + + if (use_cn) then + call extract_accum_field ('PREC10', rbufslp, nstep) + this%prec10_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('PREC60', rbufslp, nstep) + this%prec60_patch(begp:endp) = rbufslp(begp:endp) + end if + + if (use_cndv) then + call extract_accum_field ('PREC365' , rbufslp, nstep) + this%prec365_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('TDA', rbufslp, nstep) + this%t_mo_patch(begp:endp) = rbufslp(begp:endp) + end if + + if (use_ed) then + call extract_accum_field ('PREC24', rbufslp, nstep) + this%prec24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('RH24', rbufslp, nstep) + this%rh24_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('WIND24', rbufslp, nstep) + this%wind24_patch(begp:endp) = rbufslp(begp:endp) + end if + + if(use_luna) then + call extract_accum_field ('po2_240', rbufslp, nstep) + this%forc_po2_240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('pco2_240', rbufslp, nstep) + this%forc_pco2_240_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('pbot240', rbufslp, nstep) + this%forc_pbot240_downscaled_patch(begp:endp) = rbufslp(begp:endp) + + endif + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + subroutine UpdateAccVars (this, bounds) + ! + ! USES + use clm_time_manager, only : get_nstep + use accumulMod , only : update_accum_field, extract_accum_field + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,c,p ! indices + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: ier ! error status + integer :: begp, endp + real(r8), pointer :: rbufslp(:) ! temporary single level - patch level + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + + nstep = get_nstep() + + ! Allocate needed dynamic memory for single level patch field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + ! Accumulate and extract forc_solad24 & forc_solad240 + do p = begp,endp + g = patch%gridcell(p) + rbufslp(p) = this%forc_solad_grc(g,1) + end do + call update_accum_field ('FSD240', rbufslp , nstep) + call extract_accum_field ('FSD240', this%fsd240_patch , nstep) + call update_accum_field ('FSD24' , rbufslp , nstep) + call extract_accum_field ('FSD24' , this%fsd24_patch , nstep) + + ! Accumulate and extract forc_solai24 & forc_solai240 + do p = begp,endp + g = patch%gridcell(p) + rbufslp(p) = this%forc_solai_grc(g,1) + end do + call update_accum_field ('FSI24' , rbufslp , nstep) + call extract_accum_field ('FSI24' , this%fsi24_patch , nstep) + call update_accum_field ('FSI240', rbufslp , nstep) + call extract_accum_field ('FSI240', this%fsi240_patch , nstep) + + do p = begp,endp + c = patch%column(p) + rbufslp(p) = this%forc_rain_downscaled_col(c) + this%forc_snow_downscaled_col(c) + end do + + if (use_cn) then + ! Accumulate and extract PREC60 (accumulates total precipitation as 60-day running mean) + call update_accum_field ('PREC60', rbufslp, nstep) + call extract_accum_field ('PREC60', this%prec60_patch, nstep) + + ! Accumulate and extract PREC10 (accumulates total precipitation as 10-day running mean) + call update_accum_field ('PREC10', rbufslp, nstep) + call extract_accum_field ('PREC10', this%prec10_patch, nstep) + end if + + if (use_cndv) then + ! Accumulate and extract PREC365 (accumulates total precipitation as 365-day running mean) + call update_accum_field ('PREC365', rbufslp, nstep) + call extract_accum_field ('PREC365', this%prec365_patch, nstep) + + ! Accumulate and extract TDA (accumulates TBOT as 30-day average) and + ! also determines t_mo_min + + do p = begp,endp + c = patch%column(p) + rbufslp(p) = this%forc_t_downscaled_col(c) + end do + call update_accum_field ('TDA', rbufslp, nstep) + call extract_accum_field ('TDA', rbufslp, nstep) + do p = begp,endp + this%t_mo_patch(p) = rbufslp(p) + this%t_mo_min_patch(p) = min(this%t_mo_min_patch(p), rbufslp(p)) + end do + + end if + + if (use_ed) then + call update_accum_field ('PREC24', rbufslp, nstep) + call extract_accum_field ('PREC24', this%prec24_patch, nstep) + + do p = bounds%begp,bounds%endp + c = patch%column(p) + rbufslp(p) = this%forc_wind_grc(g) + end do + call update_accum_field ('WIND24', rbufslp, nstep) + call extract_accum_field ('WIND24', this%wind24_patch, nstep) + + do p = bounds%begp,bounds%endp + c = patch%column(p) + rbufslp(p) = this%forc_rh_grc(g) + end do + call update_accum_field ('RH24', rbufslp, nstep) + call extract_accum_field ('RH24', this%rh24_patch, nstep) + end if + + if(use_luna) then + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + rbufslp(p) = this%forc_pco2_grc(g) + enddo + call update_accum_field ('pco2_240', rbufslp, nstep) + call extract_accum_field ('pco2_240', this%forc_pco2_240_patch, nstep) + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + rbufslp(p) = this%forc_po2_grc(g) + enddo + call update_accum_field ('po2_240', rbufslp, nstep) + call extract_accum_field ('po2_240', this%forc_po2_240_patch, nstep) + + do p = bounds%begp,bounds%endp + c = patch%column(p) + rbufslp(p) = this%forc_pbot_downscaled_col(c) + enddo + call update_accum_field ('pbot240', rbufslp, nstep) + call extract_accum_field ('pbot240', this%forc_pbot240_downscaled_patch, nstep) + + endif + + deallocate(rbufslp) + + end subroutine UpdateAccVars + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(atm2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + ! + ! !LOCAL VARIABLES: + logical :: readvar + !------------------------------------------------------------------------ + + call restartvar(ncid=ncid, flag=flag, varname='qflx_floodg', xtype=ncd_double, & + dim1name='gridcell', & + long_name='flood water flux', units='mm/s', & + interpinic_flag='skip', readvar=readvar, data=this%forc_flood_grc) + if (flag == 'read' .and. .not. readvar) then + ! initial run, readvar=readvar, not restart: initialize flood to zero + this%forc_flood_grc = 0._r8 + endif + + if (use_cndv) then + call restartvar(ncid=ncid, flag=flag, varname='T_MO_MIN', xtype=ncd_double, & + dim1name='pft', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%t_mo_min_patch) + end if + + if(use_luna)then + call restartvar(ncid=ncid, flag=flag, varname='pco2_240', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean CO2 partial pressure', units='Pa', & + interpinic_flag='interp', readvar=readvar, data=this%forc_pco2_240_patch ) + call restartvar(ncid=ncid, flag=flag, varname='po2_240', xtype=ncd_double, & + dim1name='pft', long_name='10-day mean O2 partial pressure', units='Pa', & + interpinic_flag='interp', readvar=readvar, data=this%forc_po2_240_patch ) + call restartvar(ncid=ncid, flag=flag, varname='pbot240', xtype=ncd_double, & + dim1name='pft', long_name='10 day mean atmospheric pressure(Pa)', units='Pa', & + interpinic_flag='interp', readvar=readvar, data=this%forc_pbot240_downscaled_patch ) + endif + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Clean(this) + ! + ! !DESCRIPTION: + ! Finalize this instance + ! + ! !USES: + ! + ! !ARGUMENTS: + class(atm2lnd_type), intent(inout) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Clean' + !----------------------------------------------------------------------- + + ! atm->lnd + deallocate(this%forc_u_grc) + deallocate(this%forc_v_grc) + deallocate(this%forc_wind_grc) + deallocate(this%forc_rh_grc) + deallocate(this%forc_hgt_grc) + deallocate(this%forc_hgt_u_grc) + deallocate(this%forc_hgt_t_grc) + deallocate(this%forc_hgt_q_grc) + deallocate(this%forc_vp_grc) + deallocate(this%forc_psrf_grc) + deallocate(this%forc_pco2_grc) + deallocate(this%forc_solad_grc) + deallocate(this%forc_solai_grc) + deallocate(this%forc_solar_grc) + deallocate(this%forc_ndep_grc) + deallocate(this%forc_pc13o2_grc) + deallocate(this%forc_po2_grc) + deallocate(this%forc_aer_grc) + deallocate(this%forc_pch4_grc) + + ! atm->lnd not downscaled + deallocate(this%forc_t_not_downscaled_grc) + deallocate(this%forc_q_not_downscaled_grc) + deallocate(this%forc_pbot_not_downscaled_grc) + deallocate(this%forc_th_not_downscaled_grc) + deallocate(this%forc_rho_not_downscaled_grc) + deallocate(this%forc_lwrad_not_downscaled_grc) + deallocate(this%forc_rain_not_downscaled_grc) + deallocate(this%forc_snow_not_downscaled_grc) + + ! atm->lnd downscaled + deallocate(this%forc_t_downscaled_col) + deallocate(this%forc_q_downscaled_col) + deallocate(this%forc_pbot_downscaled_col) + deallocate(this%forc_th_downscaled_col) + deallocate(this%forc_rho_downscaled_col) + deallocate(this%forc_lwrad_downscaled_col) + deallocate(this%forc_rain_downscaled_col) + deallocate(this%forc_snow_downscaled_col) + + ! rof->lnd + deallocate(this%forc_flood_grc) + deallocate(this%volr_grc) + + ! anomaly forcing + deallocate(this%bc_precip_grc) + deallocate(this%af_precip_grc) + deallocate(this%af_uwind_grc) + deallocate(this%af_vwind_grc) + deallocate(this%af_tbot_grc) + deallocate(this%af_pbot_grc) + deallocate(this%af_shum_grc) + deallocate(this%af_swdn_grc) + deallocate(this%af_lwdn_grc) + + deallocate(this%fsd24_patch) + deallocate(this%fsd240_patch) + deallocate(this%fsi24_patch) + deallocate(this%fsi240_patch) + deallocate(this%prec10_patch) + deallocate(this%prec60_patch) + deallocate(this%prec365_patch) + if (use_ed) then + deallocate(this%prec24_patch) + deallocate(this%rh24_patch) + deallocate(this%wind24_patch) + end if + deallocate(this%t_mo_patch) + deallocate(this%t_mo_min_patch) + + end subroutine Clean + + +end module atm2lndType diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 new file mode 100644 index 0000000000..840d619505 --- /dev/null +++ b/components/clm/src/main/clm_driver.F90 @@ -0,0 +1,1404 @@ +module clm_driver + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! This module provides the main CLM driver physics calling sequence. Most + ! computations occurs over ``clumps'' of gridcells (and associated subgrid + ! scale entities) assigned to each MPI process. Computation is further + ! parallelized by looping over clumps on each process using shared memory OpenMP. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : wrtdia, iulog, create_glacier_mec_landunit, use_ed + use clm_varctl , only : use_cn, use_cndv, use_lch4, use_voc, use_noio, use_c13, use_c14 + use clm_time_manager , only : get_step_size, get_curr_date, get_ref_date, get_nstep, is_beg_curr_day + use clm_time_manager , only : get_prev_date + use clm_varpar , only : nlevsno, nlevgrnd, crop_prog + use spmdMod , only : masterproc, mpicom + use decompMod , only : get_proc_clumps, get_clump_bounds, get_proc_bounds, bounds_type + use filterMod , only : filter, filter_inactive_and_active + use filterMod , only : setExposedvegpFilter + use histFileMod , only : hist_update_hbuf, hist_htapes_wrapup + use restFileMod , only : restFile_write, restFile_filename + use abortutils , only : endrun + ! + use dynSubgridDriverMod , only : dynSubgrid_driver + use BalanceCheckMod , only : BeginWaterBalance, BalanceCheck + ! + use CanopyTemperatureMod , only : CanopyTemperature ! (formerly Biogeophysics1Mod) + use SoilTemperatureMod , only : SoilTemperature + use LakeTemperatureMod , only : LakeTemperature + ! + use BareGroundFluxesMod , only : BareGroundFluxes + use CanopyFluxesMod , only : CanopyFluxes + use SoilFluxesMod , only : SoilFluxes ! (formerly Biogeophysics2Mod) + use UrbanFluxesMod , only : UrbanFluxes + use LakeFluxesMod , only : LakeFluxes + ! + use HydrologyNoDrainageMod , only : HydrologyNoDrainage ! (formerly Hydrology2Mod) + use HydrologyDrainageMod , only : HydrologyDrainage ! (formerly Hydrology2Mod) + use CanopyHydrologyMod , only : CanopyHydrology ! (formerly Hydrology1Mod) + use LakeHydrologyMod , only : LakeHydrology + ! + use AerosolMod , only : AerosolMasses + use SnowSnicarMod , only : SnowAge_grain + use SurfaceAlbedoMod , only : SurfaceAlbedo + use UrbanAlbedoMod , only : UrbanAlbedo + ! + use SurfaceRadiationMod , only : SurfaceRadiation + use UrbanRadiationMod , only : UrbanRadiation + ! + use CNDriverMod , only : CNDriverNoLeaching, CNDriverLeaching, CNDriverSummary + use CNVegStructUpdateMod , only : CNVegStructUpdate + use CNAnnualUpdateMod , only : CNAnnualUpdate + use SoilBiogeochemVerticalProfileMod , only : SoilBiogeochemVerticalProfile + use CNFireMod , only : CNFireInterp + use CNDVDriverMod , only : CNDVDriver, CNDVHIST + use SatellitePhenologyMod , only : SatellitePhenology, interpMonthlyVeg + use ndepStreamMod , only : ndep_interp + use ActiveLayerMod , only : alt_calc + use ch4Mod , only : ch4 + use DUSTMod , only : DustDryDep, DustEmission + use VOCEmissionMod , only : VOCEmission + use EDMainMod , only : ed_driver + ! + use filterMod , only : setFilters + ! + use atm2lndMod , only : downscale_forcings + use lnd2atmMod , only : lnd2atm + use lnd2glcMod , only : lnd2glc_type + ! + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use DryDepVelocity , only : depvel_compute + ! + use DaylengthMod , only : UpdateDaylength + use perf_mod + ! + use clm_initializeMod , only : nutrient_competition_method + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use clm_instMod + use clm_initializeMod , only : soil_water_retention_curve + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_drv ! Main clm driver + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: clm_drv_patch2col + private :: clm_drv_init ! Initialization of variables needed from previous timestep + private :: write_diagnostic ! Write diagnostic information to log file + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) + ! + ! !DESCRIPTION: + ! + ! First phase of the clm driver calling the clm physics. An outline of + ! the calling tree is given in the description of this module. + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + logical , intent(in) :: doalb ! true if time for surface albedo calc + real(r8), intent(in) :: nextsw_cday ! calendar day for nstep+1 + real(r8), intent(in) :: declinp1 ! declination angle for next time step + real(r8), intent(in) :: declin ! declination angle for current time step + logical, intent(in) :: rstwr ! true => write restart file this step + logical, intent(in) :: nlend ! true => end of run on this step + character(len=*),intent(in) :: rdate ! restart file time stamp for name + ! + ! !LOCAL VARIABLES: + integer :: nstep ! time step number + real(r8) :: dtime ! land model time step (sec) + integer :: nc, c, p, l, g ! indices + integer :: nclumps ! number of clumps on this processor + integer :: yrp1 ! year (0, ...) for nstep+1 + integer :: monp1 ! month (1, ..., 12) for nstep+1 + integer :: dayp1 ! day of month (1, ..., 31) for nstep+1 + integer :: secp1 ! seconds into current date for nstep+1 + integer :: yr ! year (0, ...) + integer :: mon ! month (1, ..., 12) + integer :: day ! day of month (1, ..., 31) + integer :: sec ! seconds of the day + integer :: yr_prev ! year (0, ...) at start of timestep + integer :: mon_prev ! month (1, ..., 12) at start of timestep + integer :: day_prev ! day of month (1, ..., 31) at start of timestep + integer :: sec_prev ! seconds of the day at start of timestep + integer :: ncdate ! current date + integer :: nbdate ! base date (reference date) + integer :: kyr ! thousand years, equals 2 at end of first year + character(len=256) :: filer ! restart file name + integer :: ier ! error code + type(bounds_type) :: bounds_clump + type(bounds_type) :: bounds_proc + + ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Workaround for internal compiler error with + ! pgi 14.7 ('normalize_forall_array: non-conformable'), which appears in the call to + ! CalcIrrigationNeeded. Simply declaring this variable makes the ICE go away. + real(r8), allocatable :: dummy1_to_make_pgi_happy(:) + !----------------------------------------------------------------------- + + ! Determine processor bounds and clumps for this processor + + call get_proc_bounds(bounds_proc) + nclumps = get_proc_clumps() + + ! Update time-related info + + call cnveg_state_inst%CropRestIncYear() + + ! ============================================================================ + ! Specified phenology + ! ============================================================================ + + if (use_cn) then + ! For dry-deposition need to call CLMSP so that mlaidiff is obtained + if ( n_drydep > 0 .and. drydep_method == DD_XLND ) then + call t_startf('interpMonthlyVeg') + call interpMonthlyVeg(bounds_proc, canopystate_inst) + call t_stopf('interpMonthlyVeg') + endif + + else + ! Determine weights for time interpolation of monthly vegetation data. + ! This also determines whether it is time to read new monthly vegetation and + ! obtain updated leaf area index [mlai1,mlai2], stem area index [msai1,msai2], + ! vegetation top [mhvt1,mhvt2] and vegetation bottom [mhvb1,mhvb2]. The + ! weights obtained here are used in subroutine SatellitePhenology to obtain time + ! interpolated values. + if (doalb .or. ( n_drydep > 0 .and. drydep_method == DD_XLND )) then + call t_startf('interpMonthlyVeg') + call interpMonthlyVeg(bounds_proc, canopystate_inst) + call t_stopf('interpMonthlyVeg') + end if + + end if + + ! ================================================================================== + ! Determine decomp vertical profiles + ! + ! These routines (alt_calc & decomp_vertprofiles) need to be called before + ! pftdyn_cnbal, and it appears that they need to be called before pftdyn_interp and + ! the associated filter updates, too (otherwise we get a carbon balance error) + ! ================================================================================== + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + + ! BUG(wjs, 2014-12-15, bugz 2107) Because of the placement of the following + ! routines (alt_calc and SoilBiogeochemVerticalProfile) in the driver sequence - + ! they are called very early in each timestep, before weights are adjusted and + ! filters are updated - it may be necessary for these routines to compute values + ! over inactive as well as active points (since some inactive points may soon + ! become active) - so that's what is done now. Currently, it seems to be okay to do + ! this, because the variables computed here seem to only depend on quantities that + ! are valid over inactive as well as active points. + + call t_startf("decomp_vert") + call alt_calc(filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc, & + temperature_inst, canopystate_inst) + + if (use_cn) then + call SoilBiogeochemVerticalProfile(bounds_clump , & + filter_inactive_and_active(nc)%num_soilc, filter_inactive_and_active(nc)%soilc , & + filter_inactive_and_active(nc)%num_soilp, filter_inactive_and_active(nc)%soilp , & + canopystate_inst, soilstate_inst, soilbiogeochem_state_inst) + end if + + call t_stopf("decomp_vert") + end do + !$OMP END PARALLEL DO + + ! ============================================================================ + ! Initialize the mass balance checks for carbon and nitrogen, and zero fluxes for + ! transient land cover + ! ============================================================================ + + if (use_cn) then + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + + call t_startf('begcnbal') + + call cn_balance_inst%BeginCNBalance( & + bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + + call cnveg_carbonflux_inst%ZeroDWT(bounds_clump) + if (use_c13) then + call c13_cnveg_carbonflux_inst%ZeroDWT(bounds_clump) + end if + if (use_c14) then + call c14_cnveg_carbonflux_inst%ZeroDWT(bounds_clump) + end if + call cnveg_nitrogenflux_inst%ZeroDWT(bounds_clump) + call cnveg_carbonstate_inst%ZeroDWT(bounds_clump) + call cnveg_nitrogenstate_inst%ZeroDWT(bounds_clump) + + call soilbiogeochem_carbonflux_inst%ZeroDWT(bounds_clump) + if (use_c13) then + call c13_soilbiogeochem_carbonflux_inst%ZeroDWT(bounds_clump) + end if + if (use_c14) then + call c14_soilbiogeochem_carbonflux_inst%ZeroDWT(bounds_clump) + end if + + call t_stopf('begcnbal') + end do + !$OMP END PARALLEL DO + end if + + ! ============================================================================ + ! Update subgrid weights with dynamic landcover (prescribed transient patches, + ! CNDV, and or dynamic landunits), and do related adjustments. Note that this + ! call needs to happen outside loops over nclumps. + ! ============================================================================ + + call t_startf('dyn_subgrid') + call dynSubgrid_driver(bounds_proc, & + urbanparams_inst, soilstate_inst, soilhydrology_inst, lakestate_inst, & + waterstate_inst, waterflux_inst, temperature_inst, energyflux_inst, & + canopystate_inst, photosyns_inst, dgvs_inst, glc2lnd_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & + cnveg_carbonflux_inst, c13_cnveg_carbonflux_inst, c14_cnveg_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_state_inst, soilbiogeochem_carbonflux_inst) + call t_stopf('dyn_subgrid') + + ! ============================================================================ + ! Initialize the mass balance checks for water. + ! + ! Currently, I believe this needs to be done after weights are updated for + ! prescribed transient patches or CNDV, because column-level water is not + ! generally conserved when weights change (instead the difference is put in + ! the grid cell-level terms, qflx_liq_dynbal, etc.). In the future, we may + ! want to change the balance checks to ensure that the grid cell-level water + ! is conserved, considering qflx_liq_dynbal; in this case, the call to + ! BeginWaterBalance should be moved to before the weight updates. + ! ============================================================================ + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + + call t_startf('begwbal') + call BeginWaterBalance(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_hydrologyc, filter(nc)%hydrologyc, & + soilhydrology_inst, waterstate_inst) + call t_stopf('begwbal') + end do + !$OMP END PARALLEL DO + + ! ============================================================================ + ! Update dynamic N deposition field, on albedo timestep + ! currently being done outside clumps loop, but no reason why it couldn't be + ! re-written to go inside. + ! ============================================================================ + + if (use_cn) then + call t_startf('ndep_interp') + call ndep_interp(bounds_proc, atm2lnd_inst) + call CNFireInterp(bounds_proc) + call t_stopf('ndep_interp') + end if + + ! ============================================================================ + ! Initialize variables from previous time step, downscale atm forcings, and + ! Determine canopy interception and precipitation onto ground surface. + ! Determine the fraction of foliage covered by water and the fraction + ! of foliage that is dry and transpiring. Initialize snow layer if the + ! snow accumulation exceeds 10 mm. + ! ============================================================================ + + ! Get time as of beginning of time step + call get_prev_date(yr_prev, mon_prev, day_prev, sec_prev) + + !$OMP PARALLEL DO PRIVATE (nc,l,c, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + + call t_startf('drvinit') + + call UpdateDaylength(bounds_clump, declin) + + ! Initialze variables needed for new driver time step + call clm_drv_init(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + filter(nc)%num_soilp , filter(nc)%soilp, & + canopystate_inst, waterstate_inst, waterflux_inst, energyflux_inst) + + call downscale_forcings(bounds_clump, & + filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & + atm2lnd_inst, & + eflx_sh_precip_conversion = energyflux_inst%eflx_sh_precip_conversion_col(bounds_clump%begc:bounds_clump%endc)) + + call t_stopf('drvinit') + + ! Update filters that depend on variables set in clm_drv_init + + call setExposedvegpFilter(bounds_clump, & + canopystate_inst%frac_veg_nosno_patch(bounds_clump%begp:bounds_clump%endp)) + + ! Irrigation flux + + call irrigation_inst%ApplyIrrigation(bounds_clump) + + ! ============================================================================ + ! Canopy Hydrology + ! (1) water storage of intercepted precipitation + ! (2) direct throughfall and canopy drainage of precipitation + ! (3) fraction of foliage covered by water and the fraction is dry and transpiring + ! (4) snow layer initialization if the snow accumulation exceeds 10 mm. + ! ============================================================================ + + call t_startf('canhydro') + call CanopyHydrology(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + atm2lnd_inst, canopystate_inst, temperature_inst, & + aerosol_inst, waterstate_inst, waterflux_inst, & + irrigation_inst) + call t_stopf('canhydro') + + ! ============================================================================ + ! Surface Radiation + ! ============================================================================ + + call t_startf('surfrad') + + ! Surface Radiation primarily for non-urban columns + + call SurfaceRadiation(bounds_clump, & + filter(nc)%num_nourbanp, filter(nc)%nourbanp, & + filter(nc)%num_urbanp, filter(nc)%urbanp, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), atm2lnd_inst, & + waterstate_inst, canopystate_inst, surfalb_inst, solarabs_inst, surfrad_inst) + + ! Surface Radiation for only urban columns + + call UrbanRadiation(bounds_clump, & + filter(nc)%num_nourbanl, filter(nc)%nourbanl, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp, & + atm2lnd_inst, waterstate_inst, temperature_inst, urbanparams_inst, & + solarabs_inst, surfalb_inst, energyflux_inst) + + call t_stopf('surfrad') + + ! ============================================================================ + ! Determine leaf temperature and surface fluxes based on ground + ! temperature from previous time step. + ! ============================================================================ + + call t_startf('bgp1') + call CanopyTemperature(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + atm2lnd_inst, canopystate_inst, soilstate_inst, frictionvel_inst, & + waterstate_inst, waterflux_inst, energyflux_inst, temperature_inst) + call t_stopf('bgp1') + + ! ============================================================================ + ! Determine fluxes + ! ============================================================================ + + call t_startf('bgflux') + + ! Bareground fluxes for all patches except lakes and urban landunits + + call BareGroundFluxes(bounds_clump, & + filter(nc)%num_noexposedvegp, filter(nc)%noexposedvegp, & + atm2lnd_inst, soilstate_inst, & + frictionvel_inst, ch4_inst, energyflux_inst, temperature_inst, & + waterflux_inst, waterstate_inst, photosyns_inst, humanindex_inst) + call t_stopf('bgflux') + + ! non-bareground fluxes for all patches except lakes and urban landunits + ! Calculate canopy temperature, latent and sensible fluxes from the canopy, + ! and leaf water change by evapotranspiration + + call t_startf('canflux') + call CanopyFluxes(bounds_clump, & + filter(nc)%num_exposedvegp, filter(nc)%exposedvegp, & + ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), & + atm2lnd_inst, canopystate_inst, cnveg_state_inst, & + energyflux_inst, frictionvel_inst, soilstate_inst, solarabs_inst, surfalb_inst, & + temperature_inst, waterflux_inst, waterstate_inst, ch4_inst, ozone_inst, photosyns_inst, & + humanindex_inst, soil_water_retention_curve, cnveg_nitrogenstate_inst) + call t_stopf('canflux') + + ! Fluxes for all urban landunits + + call t_startf('uflux') + call UrbanFluxes(bounds_clump, & + filter(nc)%num_nourbanl, filter(nc)%nourbanl, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp, & + atm2lnd_inst, urbanparams_inst, soilstate_inst, temperature_inst, & + waterstate_inst, frictionvel_inst, energyflux_inst, waterflux_inst, & + humanindex_inst) + call t_stopf('uflux') + + ! Fluxes for all lake landunits + + call t_startf('bgplake') + call LakeFluxes(bounds_clump, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_lakep, filter(nc)%lakep, & + atm2lnd_inst, solarabs_inst, frictionvel_inst, temperature_inst, & + energyflux_inst, waterstate_inst, waterflux_inst, lakestate_inst,& + humanindex_inst) + + ! ============================================================================ + ! Determine irrigation needed for future time steps + ! ============================================================================ + + ! This needs to be called after btran is computed + + call irrigation_inst%CalcIrrigationNeeded( & + bounds = bounds_clump, & + num_exposedvegp = filter(nc)%num_exposedvegp, & + filter_exposedvegp = filter(nc)%exposedvegp, & + time_prev = sec_prev, & + elai = canopystate_inst%elai_patch(bounds_clump%begp:bounds_clump%endp), & + btran = energyflux_inst%btran_patch(bounds_clump%begp:bounds_clump%endp), & + rootfr = soilstate_inst%rootfr_patch(bounds_clump%begp:bounds_clump%endp , 1:nlevgrnd), & + t_soisno = temperature_inst%t_soisno_col(bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & + eff_porosity = soilstate_inst%eff_porosity_col(bounds_clump%begc:bounds_clump%endc, 1:nlevgrnd), & + h2osoi_liq = waterstate_inst%h2osoi_liq_col(bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd)) + + ! ============================================================================ + ! DUST and VOC emissions + ! ============================================================================ + + call t_startf('bgc') + + ! Dust mobilization (C. Zender's modified codes) + call DustEmission(bounds_clump, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + atm2lnd_inst, soilstate_inst, canopystate_inst, waterstate_inst, & + frictionvel_inst, dust_inst) + + ! Dust dry deposition (C. Zender's modified codes) + call DustDryDep(bounds_clump, & + atm2lnd_inst, frictionvel_inst, dust_inst) + + ! VOC emission (A. Guenther's MEGAN (2006) model) + if (use_voc) then + call VOCEmission(bounds_clump, & + filter(nc)%num_soilp, filter(nc)%soilp, & + atm2lnd_inst, canopystate_inst, photosyns_inst, temperature_inst, & + vocemis_inst) + end if + + call t_stopf('bgc') + + ! ============================================================================ + ! Determine temperatures + ! ============================================================================ + + ! Set lake temperature + + call LakeTemperature(bounds_clump, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_lakep, filter(nc)%lakep, & + solarabs_inst, soilstate_inst, waterstate_inst, waterflux_inst, ch4_inst, & + energyflux_inst, temperature_inst, lakestate_inst) + call t_stopf('bgplake') + + ! Set soil/snow temperatures including ground temperature + + call t_startf('soiltemperature') + call SoilTemperature(bounds_clump, & + filter(nc)%num_urbanl , filter(nc)%urbanl, & + filter(nc)%num_nolakec , filter(nc)%nolakec, & + atm2lnd_inst, urbanparams_inst, canopystate_inst, waterstate_inst, waterflux_inst, & + solarabs_inst, soilstate_inst, energyflux_inst, temperature_inst) + call t_stopf('soiltemperature') + + ! ============================================================================ + ! update surface fluxes for new ground temperature. + ! ============================================================================ + + call t_startf('bgp2') + call SoilFluxes(bounds_clump, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + atm2lnd_inst, solarabs_inst, temperature_inst, canopystate_inst, waterstate_inst, & + energyflux_inst, waterflux_inst) + call t_stopf('bgp2') + + ! ============================================================================ + ! Perform averaging from patch level to column level + ! ============================================================================ + + call t_startf('patch2col') + call clm_drv_patch2col(bounds_clump, filter(nc)%num_nolakec, filter(nc)%nolakec, & + waterstate_inst, energyflux_inst, waterflux_inst) + call t_stopf('patch2col') + + ! ============================================================================ + ! Vertical (column) soil and surface hydrology + ! ============================================================================ + + ! Note that filter_snowc and filter_nosnowc are returned by + ! LakeHydrology after the new snow filter is built + + call t_startf('hydro without drainage') + + call HydrologyNoDrainage(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_hydrologyc, filter(nc)%hydrologyc, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_snowc, filter(nc)%snowc, & + filter(nc)%num_nosnowc, filter(nc)%nosnowc, & + atm2lnd_inst, soilstate_inst, energyflux_inst, temperature_inst, & + waterflux_inst, waterstate_inst, soilhydrology_inst, aerosol_inst, & + soil_water_retention_curve) + + ! Calculate column-integrated aerosol masses, and + ! mass concentrations for radiative calculations and output + ! (based on new snow level state, after SnowFilter is rebuilt. + ! NEEDS TO BE AFTER SnowFiler is rebuilt, otherwise there + ! can be zero snow layers but an active column in filter) + + call AerosolMasses( bounds_clump, & + num_on=filter(nc)%num_snowc, filter_on=filter(nc)%snowc, & + num_off=filter(nc)%num_nosnowc, filter_off=filter(nc)%nosnowc, & + waterflux_inst=waterflux_inst, & + waterstate_inst=waterstate_inst, & + aerosol_inst=aerosol_inst) + + call t_stopf('hydro without drainage') + + ! ============================================================================ + ! Lake hydrology + ! ============================================================================ + + ! Note that filter_lakesnowc and filter_lakenosnowc are returned by + ! LakeHydrology after the new snow filter is built + + call t_startf('hylake') + call LakeHydrology(bounds_clump, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_lakep, filter(nc)%lakep, & + filter(nc)%num_lakesnowc, filter(nc)%lakesnowc, & + filter(nc)%num_lakenosnowc, filter(nc)%lakenosnowc, & + atm2lnd_inst, temperature_inst, soilstate_inst, waterstate_inst, waterflux_inst, & + energyflux_inst, aerosol_inst, lakestate_inst) + + ! Calculate column-integrated aerosol masses, and + ! mass concentrations for radiative calculations and output + ! (based on new snow level state, after SnowFilter is rebuilt. + ! NEEDS TO BE AFTER SnowFiler is rebuilt, otherwise there + ! can be zero snow layers but an active column in filter) + + call AerosolMasses(bounds_clump, & + num_on=filter(nc)%num_lakesnowc, filter_on=filter(nc)%lakesnowc, & + num_off=filter(nc)%num_lakenosnowc, filter_off=filter(nc)%lakenosnowc, & + waterflux_inst=waterflux_inst, & + waterstate_inst=waterstate_inst, & + aerosol_inst=aerosol_inst) + + ! Must be done here because must use a snow filter for lake columns + + call SnowAge_grain(bounds_clump, & + filter(nc)%num_lakesnowc, filter(nc)%lakesnowc, & + filter(nc)%num_lakenosnowc, filter(nc)%lakenosnowc, & + waterflux_inst, waterstate_inst, temperature_inst) + + call t_stopf('hylake') + + ! ============================================================================ + ! ! Fraction of soil covered by snow (Z.-L. Yang U. Texas) + ! ============================================================================ + + do c = bounds_clump%begc,bounds_clump%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + ! Urban landunit use Bonan 1996 (LSM Technical Note) + waterstate_inst%frac_sno_col(c) = min( waterstate_inst%snow_depth_col(c)/0.05_r8, 1._r8) + end if + end do + + ! ============================================================================ + ! Snow aging routine based on Flanner and Zender (2006), Linking snowpack + ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of + ! wet-snow metamorphism in respect of liquid-water content, Ann. Glaciol. + ! ============================================================================ + ! Note the snow filters here do not include lakes + ! TODO: move this up + + call t_startf('snow_init') + call SnowAge_grain(bounds_clump, & + filter(nc)%num_snowc, filter(nc)%snowc, & + filter(nc)%num_nosnowc, filter(nc)%nosnowc, & + waterflux_inst, waterstate_inst, temperature_inst) + call t_stopf('snow_init') + + ! ============================================================================ + ! Ecosystem dynamics: Uses CN, CNDV, or static parameterizations + ! ============================================================================ + + ! FIX(SPM,032414) push these checks into the routines below and/or make this consistent. + + ! fully prognostic canopy structure and C-N biogeochemistry + ! - CNDV defined: prognostic biogeography; else prescribed + ! - crop model: crop algorithms called from within CNDriver + + if (use_cn) then + call t_startf('ecosysdyn') + call CNDriverNoLeaching(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & + cnveg_state_inst, & + cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_state_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & + atm2lnd_inst, waterstate_inst, waterflux_inst, & + canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & + dgvs_inst, photosyns_inst, soilhydrology_inst, energyflux_inst, & + nutrient_competition_method) + + call CNAnnualUpdate(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + cnveg_state_inst, cnveg_carbonflux_inst) + call t_stopf('ecosysdyn') + + end if + + ! Prescribed biogeography - prescribed canopy structure, some prognostic carbon fluxes + + if ((.not. use_cn) .and. (.not. use_ed) .and. (doalb)) then + call SatellitePhenology(bounds_clump, filter(nc)%num_nolakep, filter(nc)%nolakep, & + waterstate_inst, canopystate_inst) + end if + + ! Ecosystem demography + + if (use_ed) then + call ed_clm_inst%SetValues( bounds_clump, 0._r8 ) + end if + + ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) + + call t_startf('depvel') + call depvel_compute(bounds_clump, & + atm2lnd_inst, canopystate_inst, waterstate_inst, frictionvel_inst, & + photosyns_inst, drydepvel_inst) + call t_stopf('depvel') + + ! Calculation of methane fluxes + + if (use_lch4) then + call t_startf('ch4') + call ch4 (bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_soilp, filter(nc)%soilp, & + atm2lnd_inst, lakestate_inst, canopystate_inst, soilstate_inst, soilhydrology_inst, & + temperature_inst, energyflux_inst, waterstate_inst, waterflux_inst, & + cnveg_carbonflux_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenflux_inst, ch4_inst, lnd2atm_inst) + call t_stopf('ch4') + end if + + ! ============================================================================ + ! Calculate soil/snow hydrology with drainage (subsurface runoff) + ! ============================================================================ + + call t_startf('hydro2 drainage') + + call HydrologyDrainage(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_hydrologyc, filter(nc)%hydrologyc, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & + atm2lnd_inst, glc2lnd_inst, temperature_inst, & + soilhydrology_inst, soilstate_inst, waterstate_inst, waterflux_inst, & + irrigation_inst) + + call t_stopf('hydro2 drainage') + + ! ============================================================================ + ! - Update the nitrogen leaching rate as a function of soluble mineral N + ! and total soil water outflow. + ! - Call to all CN summary routines + ! - On the radiation time step, use C state variables to diagnose + ! vegetation structure (LAI, SAI, height) + ! ============================================================================ + + if (use_cn) then + + ! Update the nitrogen leaching rate as a function of soluble mineral N + ! and total soil water outflow. + + call CNDriverLeaching(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + waterstate_inst, waterflux_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + SoilBiogeochem_nitrogenflux_inst, SoilBiogeochem_nitrogenstate_inst) + + ! Call to all CN summary routines + + call CNDriverSummary(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + cnveg_state_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, & + c13_cnveg_carbonflux_inst, c13_cnveg_carbonstate_inst, & + c14_cnveg_carbonflux_inst, c14_cnveg_carbonstate_inst, & + cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_carbonstate_inst, & + c13_soilbiogeochem_carbonflux_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & + soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + + ! On the radiation time step, use C state variables to calculate + ! vegetation structure (LAI, SAI, height) + + if (doalb) then + call CNVegStructUpdate(filter(nc)%num_soilp, filter(nc)%soilp, & + waterstate_inst, frictionvel_inst, dgvs_inst, cnveg_state_inst, & + cnveg_carbonstate_inst, canopystate_inst) + end if + + end if + + ! ============================================================================ + ! Check the energy and water balance and also carbon and nitrogen balance + ! ============================================================================ + + call t_startf('balchk') + call BalanceCheck(bounds_clump, & + filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & + atm2lnd_inst, glc2lnd_inst, solarabs_inst, waterflux_inst, & + waterstate_inst, irrigation_inst, energyflux_inst, canopystate_inst) + call t_stopf('balchk') + + ! ============================================================================ + ! Check the carbon and nitrogen balance + ! ============================================================================ + + if (use_cn) then + nstep = get_nstep() + if (nstep < 2 )then + if (masterproc) then + write(iulog,*) '--WARNING-- skipping CN balance check for first timestep' + end if + else + call t_startf('cnbalchk') + + call cn_balance_inst%CBalanceCheck( & + bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & + soilbiogeochem_carbonflux_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst) + + call cn_balance_inst%NBalanceCheck( & + bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & + soilbiogeochem_nitrogenflux_inst, cnveg_nitrogenflux_inst, cnveg_nitrogenstate_inst) + + call t_stopf('cnbalchk') + end if + end if + + ! ============================================================================ + ! Determine albedos for next time step + ! ============================================================================ + + if (doalb) then + + ! Albedos for non-urban columns + call t_startf('surfalb') + call SurfaceAlbedo(bounds_clump, & + filter_inactive_and_active(nc)%num_nourbanc, & + filter_inactive_and_active(nc)%nourbanc, & + filter_inactive_and_active(nc)%num_nourbanp, & + filter_inactive_and_active(nc)%nourbanp, & + filter_inactive_and_active(nc)%num_urbanc, & + filter_inactive_and_active(nc)%urbanc, & + filter_inactive_and_active(nc)%num_urbanp, & + filter_inactive_and_active(nc)%urbanp, & + nextsw_cday, declinp1, & + ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), & + aerosol_inst, canopystate_inst, waterstate_inst, & + lakestate_inst, temperature_inst, surfalb_inst) + call t_stopf('surfalb') + + ! Albedos for urban columns + if (filter_inactive_and_active(nc)%num_urbanl > 0) then + call t_startf('urbsurfalb') + call UrbanAlbedo(bounds_clump, & + filter_inactive_and_active(nc)%num_urbanl, & + filter_inactive_and_active(nc)%urbanl, & + filter_inactive_and_active(nc)%num_urbanc, & + filter_inactive_and_active(nc)%urbanc, & + filter_inactive_and_active(nc)%num_urbanp, & + filter_inactive_and_active(nc)%urbanp, & + waterstate_inst, urbanparams_inst, & + solarabs_inst, surfalb_inst) + call t_stopf('urbsurfalb') + end if + + end if + + end do + !$OMP END PARALLEL DO + + ! ============================================================================ + ! Determine gridcell averaged properties to send to atm + ! ============================================================================ + + call t_startf('lnd2atm') + call lnd2atm(bounds_proc, & + atm2lnd_inst, surfalb_inst, temperature_inst, frictionvel_inst, & + waterstate_inst, waterflux_inst, energyflux_inst, & + solarabs_inst, cnveg_carbonflux_inst, drydepvel_inst, & + vocemis_inst, dust_inst, ch4_inst, lnd2atm_inst) + call t_stopf('lnd2atm') + + ! ============================================================================ + ! Determine gridcell averaged properties to send to glc + ! ============================================================================ + + if (create_glacier_mec_landunit) then + call t_startf('lnd2glc') + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + call lnd2glc_inst%update_lnd2glc(bounds_clump, & + filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & + temperature_inst, waterflux_inst, & + init=.false.) + end do + !$OMP END PARALLEL DO + call t_stopf('lnd2glc') + end if + + ! ============================================================================ + ! Write global average diagnostics to standard output + ! ============================================================================ + + nstep = get_nstep() + if (wrtdia) call mpi_barrier(mpicom,ier) + call t_startf('wrtdiag') + call write_diagnostic(bounds_proc, wrtdia, nstep, lnd2atm_inst) + call t_stopf('wrtdiag') + + ! ============================================================================ + ! Update accumulators + ! ============================================================================ + + ! FIX(SPM,032414) double check why this isn't called for ED + ! FIX(SPM, 082814) - in the ED branch RF and I commented out the if(.not. + ! use_ed) then statement ... double check if this is required and why + + if (nstep > 0) then + call t_startf('accum') + + call atm2lnd_inst%UpdateAccVars(bounds_proc) + + call temperature_inst%UpdateAccVars(bounds_proc) + + call canopystate_inst%UpdateAccVars(bounds_proc) + + if (use_ed) then + call ed_phenology_inst%accumulateAndExtract(bounds_proc, & + temperature_inst%t_ref2m_patch(bounds_proc%begp:bounds_proc%endp), & + patch%gridcell(bounds_proc%begp:bounds_proc%endp), & + grc%latdeg(bounds_proc%begg:bounds_proc%endg), & + mon, day, sec) + endif + + if (use_cndv) then + ! COMPILER_BUG(wjs, 2014-11-30, pgi 14.7) For pgi 14.7 to be happy when + ! compiling this threaded, I needed to change the dummy arguments to be + ! pointers, and get rid of the explicit bounds in the subroutine call. + ! call dgvs_inst%UpdateAccVars(bounds_proc, & + ! t_a10_patch=temperature_inst%t_a10_patch(bounds_proc%begp:bounds_proc%endp), & + ! t_ref2m_patch=temperature_inst%t_ref2m_patch(bounds_proc%begp:bounds_proc%endp)) + call dgvs_inst%UpdateAccVars(bounds_proc, & + t_a10_patch=temperature_inst%t_a10_patch, & + t_ref2m_patch=temperature_inst%t_ref2m_patch) + end if + + if (crop_prog) then + call crop_inst%CropUpdateAccVars(bounds_proc, & + temperature_inst%t_ref2m_patch, temperature_inst%t_soisno_col, cnveg_state_inst) + end if + + call t_stopf('accum') + end if + + ! ============================================================================ + ! Update history buffer + ! ============================================================================ + + call t_startf('hbuf') + call hist_update_hbuf(bounds_proc) + call t_stopf('hbuf') + + ! ============================================================================ + ! Call dv (dynamic vegetation) at last time step of year + ! NOTE: monp1, dayp1, and secp1 correspond to nstep+1 + ! ============================================================================ + + if (use_cndv) then + call t_startf('d2dgvm') + dtime = get_step_size() + call get_curr_date(yrp1, monp1, dayp1, secp1, offset=int(dtime)) + if (monp1==1 .and. dayp1==1 .and. secp1==dtime .and. nstep>0) then + + ! Get date info. kyr is used in lpj(). At end of first year, kyr = 2. + call get_curr_date(yr, mon, day, sec) + ncdate = yr*10000 + mon*100 + day + call get_ref_date(yr, mon, day, sec) + nbdate = yr*10000 + mon*100 + day + kyr = ncdate/10000 - nbdate/10000 + 1 + + if (masterproc) write(iulog,*) 'End of year. CNDV called now: ncdate=', & + ncdate,' nbdate=',nbdate,' kyr=',kyr,' nstep=', nstep + + nclumps = get_proc_clumps() + + !$OMP PARALLEL DO PRIVATE (nc,bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + call CNDVDriver(bounds_clump, & + filter(nc)%num_natvegp, filter(nc)%natvegp, kyr, & + atm2lnd_inst, cnveg_carbonflux_inst, cnveg_carbonstate_inst, dgvs_inst) + end do + !$OMP END PARALLEL DO + end if + call t_stopf('d2dgvm') + end if + + ! ============================================================================ + ! Call ED model on daily timestep + ! ============================================================================ + + if ( use_ed .and. is_beg_curr_day() ) then ! run ED at the start of each day + + if ( masterproc ) then + write(iulog,*) 'edtime ed call edmodel ',get_nstep() + end if + + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + + call get_clump_bounds(nc, bounds_clump) + + call ed_driver( bounds_clump, & + ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), & + ed_clm_inst, ed_phenology_inst, & + atm2lnd_inst, soilstate_inst, temperature_inst, & + waterstate_inst, canopystate_inst) + + call setFilters( bounds_clump, glc2lnd_inst%icemask_grc ) + + !reset surface albedo fluxes in case there is a mismatch between elai and canopy absorbtion. + call SurfaceAlbedo(bounds_clump, & + filter_inactive_and_active(nc)%num_nourbanc, & + filter_inactive_and_active(nc)%nourbanc, & + filter_inactive_and_active(nc)%num_nourbanp, & + filter_inactive_and_active(nc)%nourbanp, & + filter_inactive_and_active(nc)%num_urbanc, & + filter_inactive_and_active(nc)%urbanc, & + filter_inactive_and_active(nc)%num_urbanp, & + filter_inactive_and_active(nc)%urbanp, & + nextsw_cday, declinp1, & + ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), & + aerosol_inst, canopystate_inst, waterstate_inst, & + lakestate_inst, temperature_inst, surfalb_inst) + + end do + !$OMP END PARALLEL DO + + end if ! use_ed branch + + ! ============================================================================ + ! History/Restart output + ! ============================================================================ + + if (.not. use_noio) then + + call t_startf('clm_drv_io') + + ! Create history and write history tapes if appropriate + call t_startf('clm_drv_io_htapes') + + call hist_htapes_wrapup( rstwr, nlend, bounds_proc, & + soilstate_inst%watsat_col(bounds_proc%begc:bounds_proc%endc, 1:), & + soilstate_inst%sucsat_col(bounds_proc%begc:bounds_proc%endc, 1:), & + soilstate_inst%bsw_col(bounds_proc%begc:bounds_proc%endc, 1:), & + soilstate_inst%hksat_col(bounds_proc%begc:bounds_proc%endc, 1:)) + + call t_stopf('clm_drv_io_htapes') + + ! Write to CNDV history buffer if appropriate + if (use_cndv) then + if (monp1==1 .and. dayp1==1 .and. secp1==dtime .and. nstep>0) then + call t_startf('clm_drv_io_hdgvm') + call CNDVHist( bounds_proc, dgvs_inst ) + if (masterproc) write(iulog,*) 'Annual CNDV calculations are complete' + call t_stopf('clm_drv_io_hdgvm') + end if + end if + + ! Write restart/initial files if appropriate + if (rstwr) then + call t_startf('clm_drv_io_wrest') + filer = restFile_filename(rdate=rdate) + + call restFile_write( bounds_proc, filer, rdate=rdate ) + + call t_stopf('clm_drv_io_wrest') + end if + call t_stopf('clm_drv_io') + + end if + + end subroutine clm_drv + + !----------------------------------------------------------------------- + subroutine clm_drv_init(bounds, & + num_nolakec, filter_nolakec, & + num_nolakep, filter_nolakep, & + num_soilp , filter_soilp, & + canopystate_inst, waterstate_inst, waterflux_inst, energyflux_inst) + ! + ! !DESCRIPTION: + ! Initialization of clm driver variables needed from previous timestep + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno + use clm_varcon , only : h2osno_max + use landunit_varcon , only : istice_mec + use CanopyStateType , only : canopystate_type + use WaterStateType , only : waterstate_type + use WaterFluxType , only : waterflux_type + use EnergyFluxType , only : energyflux_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + integer , intent(in) :: num_nolakep ! number of non-lake points in patch filter + integer , intent(in) :: filter_nolakep(:) ! patch filter for non-lake points + integer , intent(in) :: num_soilp ! number of soil points in patch filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(canopystate_type), intent(inout) :: canopystate_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: l, c, p, f, j ! indices + integer :: fp, fc ! filter indices + !----------------------------------------------------------------------- + + associate( & + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + + h2osno => waterstate_inst%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + do_capsnow => waterstate_inst%do_capsnow_col , & ! Output: [logical (:) ] true => do snow capping + h2osno_old => waterstate_inst%h2osno_old_col , & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step + frac_iceold => waterstate_inst%frac_iceold_col , & ! Output: [real(r8) (:,:) ] fraction of ice relative to the tot water + + elai => canopystate_inst%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow + esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow + frac_veg_nosno => canopystate_inst%frac_veg_nosno_patch , & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + frac_veg_nosno_alb => canopystate_inst%frac_veg_nosno_alb_patch , & ! Output: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] + + qflx_glcice => waterflux_inst%qflx_glcice_col , & ! Output: [real(r8) (:) ] flux of new glacier ice (mm H2O/s) [+ = ice grows] + + eflx_bot => energyflux_inst%eflx_bot_col , & ! Output: [real(r8) (:) ] heat flux from beneath soil/ice column (W/m**2) + + cisun_z => photosyns_inst%cisun_z_patch , & ! Output: [real(r8) (:) ] intracellular sunlit leaf CO2 (Pa) + cisha_z => photosyns_inst%cisha_z_patch & ! Output: [real(r8) (:) ] intracellular shaded leaf CO2 (Pa) + ) + + ! Initialize intracellular CO2 (Pa) parameters each timestep for use in VOCEmission + do p = bounds%begp,bounds%endp + cisun_z(p,:) = -999._r8 + cisha_z(p,:) = -999._r8 + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + ! Save snow mass at previous time step + h2osno_old(c) = h2osno(c) + + ! Decide whether to cap snow + if (h2osno(c) > h2osno_max) then + do_capsnow(c) = .true. + else + do_capsnow(c) = .false. + end if + + ! Reset flux from beneath soil/ice column + eflx_bot(c) = 0._r8 + + ! Initialize qflx_glcice everywhere, to zero. + qflx_glcice(c) = 0._r8 + + end do + + ! Initialize fraction of vegetation not covered by snow + + do p = bounds%begp,bounds%endp + if (patch%active(p)) then + frac_veg_nosno(p) = frac_veg_nosno_alb(p) + else + frac_veg_nosno(p) = 0._r8 + end if + end do + + ! Initialize set of previous time-step variables + ! Ice fraction of snow at previous time step + + do j = -nlevsno+1,0 + do f = 1, num_nolakec + c = filter_nolakec(f) + if (j >= snl(c) + 1) then + frac_iceold(c,j) = h2osoi_ice(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + end if + end do + end do + + end associate + + end subroutine clm_drv_init + + !----------------------------------------------------------------------- + subroutine clm_drv_patch2col (bounds, num_nolakec, filter_nolakec, & + waterstate_inst, energyflux_inst, waterflux_inst) + ! + ! !DESCRIPTION: + ! Averages over all patchs for variables defined over both soil and lake + ! to provide the column-level averages of state and flux variables + ! defined at the patch level. + ! + ! !USES: + use WaterStateType , only : waterstate_type + use WaterFluxType , only : waterflux_type + use EnergyFluxType , only : energyflux_type + use subgridAveMod , only : p2c + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(:) ! column filter for non-lake points + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(energyflux_type) , intent(inout) :: energyflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,fc ! indices + integer :: num_allc ! number of active column points + integer :: filter_allc(bounds%endp-bounds%begp+1) ! filter for all active column points + ! ----------------------------------------------------------------- + + ! Set up a filter for all active column points + + fc = 0 + do c = bounds%begc,bounds%endc + if (col%active(c)) then + fc = fc + 1 + filter_allc(fc) = c + end if + end do + num_allc = fc + + ! Note: lake points are excluded from many of the following + ! averages. For some fields, this is because the field doesn't + ! apply over lakes. However, for many others, this is because the + ! field is computed in LakeHydrologyMod, which is called after + ! this routine; thus, for lakes, the column-level values of these + ! fields are explicitly set in LakeHydrologyMod. (The fields that + ! are included here for lakes are computed elsewhere, e.g., in + ! LakeFluxesMod.) + + ! Averaging for patch water state variables + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterstate_inst%h2ocan_patch(bounds%begp:bounds%endp), & + waterstate_inst%h2ocan_col(bounds%begc:bounds%endc)) + + ! Averaging for patch evaporative flux variables + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_ev_snow_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_ev_snow_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_ev_soil_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_ev_soil_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_ev_h2osfc_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_ev_h2osfc_col(bounds%begc:bounds%endc)) + + ! Averaging for patch water flux variables + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_evap_soi_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_evap_soi_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_evap_tot_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_evap_tot_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_rain_grnd_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_rain_grnd_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_snow_grnd_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_snow_grnd_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_allc, filter_allc, & + waterflux_inst%qflx_snwcp_liq_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_snwcp_liq_col(bounds%begc:bounds%endc)) + !TODO - WJS has suggested that at this point qflx_snwcp_liq_patch should + ! now be set to nan in order to ensure that this variable is not used + ! for the remainder of the timestep - other variables where this should + ! occur in this routine should be examined as well + + ! For lakes, this field is initially set in LakeFluxesMod (which + ! is called before this routine; hence it is appropriate to + ! include lake columns in this p2c call. However, it is later + ! overwritten in LakeHydrologyMod, both on the patch and the column + ! level. + + call p2c (bounds, num_allc, filter_allc, & + waterflux_inst%qflx_snwcp_ice_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_snwcp_ice_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_tran_veg_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_tran_veg_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_evap_grnd_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_evap_grnd_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_allc, filter_allc, & + waterflux_inst%qflx_evap_soi_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_evap_soi_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_prec_grnd_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_prec_grnd_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_dew_grnd_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_dew_grnd_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_sub_snow_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_sub_snow_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_inst%qflx_dew_snow_patch(bounds%begp:bounds%endp), & + waterflux_inst%qflx_dew_snow_col(bounds%begc:bounds%endc)) + + end subroutine clm_drv_patch2col + + !------------------------------------------------------------------------ + subroutine write_diagnostic (bounds, wrtdia, nstep, lnd2atm_inst) + ! + ! !DESCRIPTION: + ! Write diagnostic surface temperature output each timestep. Written to + ! be fast but not bit-for-bit because order of summations can change each + ! timestep. + ! + ! !USES: + use decompMod , only : get_proc_global + use spmdMod , only : masterproc, npes, MPI_REAL8 + use spmdMod , only : MPI_STATUS_SIZE, mpicom, MPI_SUM + use shr_sys_mod, only : shr_sys_flush + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + use lnd2atmType, only : lnd2atm_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + logical , intent(in) :: wrtdia !true => write diagnostic + integer , intent(in) :: nstep !model time step + type(lnd2atm_type) , intent(in) :: lnd2atm_inst + ! + ! !REVISION HISTORY: + ! Created by Mariana Vertenstein + ! + ! !LOCAL VARIABLES: + integer :: p ! loop index + integer :: numg ! total number of gridcells across all processors + integer :: ier ! error status + real(r8):: psum ! partial sum of ts + real(r8):: tsum ! sum of ts + real(r8):: tsxyav ! average ts for diagnostic output + integer :: status(MPI_STATUS_SIZE) ! mpi status + !------------------------------------------------------------------------ + + call get_proc_global(ng=numg) + + if (wrtdia) then + + call t_barrierf('sync_write_diag', mpicom) + psum = sum(lnd2atm_inst%t_rad_grc(bounds%begg:bounds%endg)) + call mpi_reduce(psum, tsum, 1, MPI_REAL8, MPI_SUM, 0, mpicom, ier) + if (ier/=0) then + write(iulog,*) 'write_diagnostic: Error in mpi_reduce()' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (masterproc) then + tsxyav = tsum / numg + write(iulog,1000) nstep, tsxyav + call shr_sys_flush(iulog) + end if + + else + + if (masterproc) then + write(iulog,*)'clm: completed timestep ',nstep + call shr_sys_flush(iulog) + end if + + endif + +1000 format (1x,'nstep = ',i10,' TS = ',f21.15) + + end subroutine write_diagnostic + +end module clm_driver diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 new file mode 100644 index 0000000000..b4bdb6b5c6 --- /dev/null +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -0,0 +1,725 @@ +module clm_initializeMod + + !----------------------------------------------------------------------- + ! Performs land model initialization + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use decompMod , only : bounds_type, get_proc_bounds + use abortutils , only : endrun + use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch, is_cold_start + use clm_varctl , only : create_glacier_mec_landunit, iulog + use clm_varctl , only : use_lch4, use_cn, use_cndv, use_voc, use_c13, use_c14, use_ed + use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, wt_glc_mec, topo_glc_mec + use perf_mod , only : t_startf, t_stopf + use readParamsMod , only : readParameters + use ncdio_pio , only : file_desc_t + use GridcellType , only : grc ! instance + use LandunitType , only : lun ! instance + use ColumnType , only : col ! instance + use PatchType , only : patch ! instance + use EDVecCohortType , only : ed_vec_cohort ! instance, used for domain decomp + use clm_instMod + ! + implicit none + public ! By default everything is public + ! + public :: initialize1 ! Phase one initialization + public :: initialize2 ! Phase two initialization + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine initialize1( ) + ! + ! !DESCRIPTION: + ! CLM initialization first phase + ! + ! !USES: + use clm_varpar , only: clm_varpar_init, natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec + use clm_varcon , only: clm_varcon_init + use landunit_varcon , only: landunit_varcon_init, max_lunit, istice_mec + use column_varcon , only: col_itype_to_icemec_class + use clm_varctl , only: fsurdat, fatmlndfrc, flndtopo, fglcmask, noland, version + use pftconMod , only: pftcon + use decompInitMod , only: decompInit_lnd, decompInit_clumps, decompInit_glcp + use domainMod , only: domain_check, ldomain, domain_init + use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid, surfrd_get_topo, surfrd_get_data + use controlMod , only: control_init, control_print + use ncdio_pio , only: ncd_pio_init + use initGridCellsMod , only: initGridCells + use ch4varcon , only: ch4conrd + use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + ! + ! !LOCAL VARIABLES: + integer :: ier ! error status + integer :: i,j,n,k,c,l,g ! indices + integer :: nl ! gdc and glo lnd indices + integer :: ns, ni, nj ! global grid sizes + integer :: begg, endg ! processor bounds + integer :: icemec_class ! current icemec class (1..maxpatch_glcmec) + type(bounds_type) :: bounds_proc + integer ,pointer :: amask(:) ! global land mask + character(len=32) :: subname = 'initialize1' ! subroutine name + !----------------------------------------------------------------------- + + call t_startf('clm_init1') + + ! ------------------------------------------------------------------------ + ! Initialize run control variables, timestep + ! ------------------------------------------------------------------------ + + if ( masterproc )then + write(iulog,*) trim(version) + write(iulog,*) + write(iulog,*) 'Attempting to initialize the land model .....' + write(iulog,*) + call shr_sys_flush(iulog) + endif + + call control_init() + call clm_varpar_init() + call clm_varcon_init( IsSimpleBuildTemp() ) + call landunit_varcon_init() + call ncd_pio_init() + + if (masterproc) call control_print() + + ! ------------------------------------------------------------------------ + ! Read in global land grid and land mask (amask)- needed to set decomposition + ! ------------------------------------------------------------------------ + + ! global memory for amask is allocate in surfrd_get_glomask - must be + ! deallocated below + if (masterproc) then + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + call shr_sys_flush(iulog) + endif + call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) + + ! Exit early if no valid land points + if ( all(amask == 0) )then + if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' + noland = .true. + return + end if + + ! ------------------------------------------------------------------------ + ! Determine clm gridcell decomposition and processor bounds for gridcells + ! ------------------------------------------------------------------------ + + call decompInit_lnd(ni, nj, amask) + deallocate(amask) + + ! *** Get JUST gridcell processor bounds *** + ! Remaining bounds (landunits, columns, patches) will be determined + ! after the call to decompInit_glcp - so get_proc_bounds is called + ! twice and the gridcell information is just filled in twice + + call get_proc_bounds(begg, endg) + + ! ------------------------------------------------------------------------ + ! Get grid and land fraction (set ldomain) + ! ------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) + call shr_sys_flush(iulog) + endif + if (create_glacier_mec_landunit) then + call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc, fglcmask) + else + call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) + endif + if (masterproc) then + call domain_check(ldomain) + endif + ldomain%mask = 1 !!! TODO - is this needed? + + ! Get topo if appropriate (set ldomain%topo) + + if (flndtopo /= " ") then + if (masterproc) then + write(iulog,*) 'Attempting to read atm topo from ',trim(flndtopo) + call shr_sys_flush(iulog) + endif + call surfrd_get_topo(ldomain, flndtopo) + endif + + ! Initialize urban model input (initialize urbinp data structure) + ! This needs to be called BEFORE the call to surfrd_get_data since + ! that will call surfrd_get_special which in turn calls check_urban + + call UrbanInput(begg, endg, mode='initialize') + + ! Allocate surface grid dynamic memory (just gridcell bounds dependent) + + allocate (wt_lunit (begg:endg, max_lunit )) + allocate (urban_valid (begg:endg )) + allocate (wt_nat_patch (begg:endg, natpft_lb:natpft_ub )) + allocate (wt_cft (begg:endg, cft_lb:cft_ub )) + if (create_glacier_mec_landunit) then + allocate (wt_glc_mec (begg:endg, maxpatch_glcmec)) + allocate (topo_glc_mec(begg:endg, maxpatch_glcmec)) + else + allocate (wt_glc_mec (1,1)) + allocate (topo_glc_mec(1,1)) + endif + + ! Read list of Patches and their corresponding parameter values + ! Independent of model resolution, Needs to stay before surfrd_get_data + + call pftcon%Init() + + ! Read surface dataset and set up subgrid weight arrays + + call surfrd_get_data(begg, endg, ldomain, fsurdat) + + ! ------------------------------------------------------------------------ + ! Determine decomposition of subgrid scale landunits, columns, patches + ! ------------------------------------------------------------------------ + + if (create_glacier_mec_landunit) then + call decompInit_clumps(ns, ni, nj, ldomain%glcmask) + else + call decompInit_clumps(ns, ni, nj) + endif + + ! *** Get ALL processor bounds - for gridcells, landunit, columns and patches *** + + call get_proc_bounds(bounds_proc) + + ! Allocate memory for subgrid data structures + ! This is needed here BEFORE the following call to initGridcells + ! Note that the assumption is made that none of the subgrid initialization + ! can depend on other elements of the subgrid in the calls below + + call grc%Init (bounds_proc%begg, bounds_proc%endg) + call lun%Init (bounds_proc%begl, bounds_proc%endl) + call col%Init (bounds_proc%begc, bounds_proc%endc) + call patch%Init(bounds_proc%begp, bounds_proc%endp) + if ( use_ed ) then + call ed_vec_cohort%Init(bounds_proc%begCohort,bounds_proc%endCohort) + end if + + ! Build hierarchy and topological info for derived types + ! This is needed here for the following call to decompInit_glcp + + call initGridCells() + + ! Set global seg maps for gridcells, landlunits, columns and patches + + if (create_glacier_mec_landunit) then + call decompInit_glcp(ns, ni, nj, ldomain%glcmask) + else + call decompInit_glcp(ns, ni, nj) + endif + + ! ------------------------------------------------------------------------ + ! Remainder of initialization1 + ! ------------------------------------------------------------------------ + + ! Set CH4 Model Parameters from namelist. + ! Need to do before initTimeConst so that it knows whether to + ! look for several optional parameters on surfdata file. + + if (use_lch4) then + call ch4conrd() + end if + + ! Deallocate surface grid dynamic memory for variables that aren't needed elsewhere. + ! Some things are kept until the end of initialize2; urban_valid is kept through the + ! end of the run for error checking. + + deallocate (wt_lunit, wt_cft, wt_glc_mec) + + call t_stopf('clm_init1') + + ! initialize glc_topo + ! TODO - does this belong here? + do c = bounds_proc%begc, bounds_proc%endc + l = col%landunit(c) + g = col%gridcell(c) + + if (lun%itype(l) == istice_mec) then + ! For ice_mec landunits, initialize glc_topo based on surface dataset; this + ! will get overwritten in the run loop by values sent from CISM + icemec_class = col_itype_to_icemec_class(col%itype(c)) + col%glc_topo(c) = topo_glc_mec(g, icemec_class) + else + ! For other landunits, arbitrarily initialize glc_topo to 0 m; for landunits + ! where this matters, this will get overwritten in the run loop by values sent + ! from CISM + col%glc_topo(c) = 0._r8 + end if + end do + + end subroutine initialize1 + + + !----------------------------------------------------------------------- + subroutine initialize2( ) + ! + ! !DESCRIPTION: + ! CLM initialization - second phase + ! + ! !USES: + use shr_orb_mod , only : shr_orb_decl + use shr_scam_mod , only : shr_scam_getCloseLatLon + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use accumulMod , only : print_accum_fields + use clm_varpar , only : nlevsno, crop_prog + use clm_varcon , only : spval + use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat + use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_ed + use clm_varorb , only : eccen, mvelpp, lambm0, obliqr + use clm_time_manager , only : get_step_size, get_curr_calday + use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep + use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart + use C14BombSpikeMod , only : C14_init_BombSpike, use_c14_bombspike + use DaylengthMod , only : InitDaylength, daylength + use decompMod , only : get_proc_clumps, get_proc_bounds, get_clump_bounds, bounds_type + use dynSubgridDriverMod , only : dynSubgrid_init + use fileutils , only : getfil + use filterMod , only : allocFilters, filter + use initInterpMod , only : initInterp + use reweightMod , only : reweight_wrapup + use subgridWeightsMod , only : init_subgrid_weights_mod + use histFileMod , only : hist_htapes_build, htapes_fieldlist, hist_printflds + use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal + use restFileMod , only : restFile_getfile, restFile_open, restFile_close + use restFileMod , only : restFile_read, restFile_write + use ndepStreamMod , only : ndep_init, ndep_interp + use CNDriverMod , only : CNDriverInit + use EDInitMod , only : ed_init + use LakeCon , only : LakeConInit + use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg + use SnowSnicarMod , only : SnowAge_init, SnowOptics_init + use lnd2atmMod , only : lnd2atm_minimal + use NutrientCompetitionFactoryMod, only : create_nutrient_competition_method + ! + ! !ARGUMENTS + ! + ! !LOCAL VARIABLES: + integer :: c,i,g,j,k,l,p! indices + integer :: yr ! current year (0, ...) + integer :: mon ! current month (1 -> 12) + integer :: day ! current day (1 -> 31) + integer :: ncsec ! current time of day [seconds] + integer :: nc ! clump index + integer :: nclumps ! number of clumps on this processor + character(len=256) :: fnamer ! name of netcdf restart file + character(len=256) :: pnamer ! full pathname of netcdf restart file + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + real(r8) :: dtime ! time step increment (sec) + integer :: nstep ! model time step + real(r8) :: calday ! calendar day for nstep + real(r8) :: caldaym1 ! calendar day for nstep-1 + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinm1 ! solar declination angle in radians for nstep-1 + real(r8) :: eccf ! earth orbit eccentricity factor + type(bounds_type) :: bounds_proc ! processor bounds + type(bounds_type) :: bounds_clump ! clump bounds + logical :: lexist + integer :: closelatidx,closelonidx + real(r8) :: closelat,closelon + real(r8) :: max_decl ! temporary, for calculation of max_dayl + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + character(len=32) :: subname = 'initialize2' + !---------------------------------------------------------------------- + + call t_startf('clm_init2') + + ! ------------------------------------------------------------------------ + ! Determine processor bounds and clumps for this processor + ! ------------------------------------------------------------------------ + + call get_proc_bounds(bounds_proc) + nclumps = get_proc_clumps() + + ! ------------------------------------------------------------------------ + ! Read in parameters files + ! ------------------------------------------------------------------------ + + allocate(nutrient_competition_method, & + source=create_nutrient_competition_method()) + + if (use_cn .or. use_ed) then + call readParameters(nutrient_competition_method) + end if + + ! ------------------------------------------------------------------------ + ! Initialize time manager + ! ------------------------------------------------------------------------ + + if (nsrest == nsrStartup) then + call timemgr_init() + else + call restFile_getfile(file=fnamer, path=pnamer) + call restFile_open( flag='read', file=fnamer, ncid=ncid ) + call timemgr_restart_io( ncid=ncid, flag='read' ) + call restFile_close( ncid=ncid ) + call timemgr_restart() + end if + + ! ------------------------------------------------------------------------ + ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly) + ! ------------------------------------------------------------------------ + + call t_startf('init_orbd') + + calday = get_curr_calday() + call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) + + dtime = get_step_size() + caldaym1 = get_curr_calday(offset=-int(dtime)) + call shr_orb_decl( caldaym1, eccen, mvelpp, lambm0, obliqr, declinm1, eccf ) + + call t_stopf('init_orbd') + + call InitDaylength(bounds_proc, declin=declin, declinm1=declinm1) + + ! Initialize maximum daylength, based on latitude and maximum declination + ! maximum declination hardwired for present-day orbital parameters, + ! +/- 23.4667 degrees = +/- 0.409571 radians, use negative value for S. Hem + + do g = bounds_proc%begg,bounds_proc%endg + max_decl = 0.409571 + if (grc%lat(g) < 0._r8) max_decl = -max_decl + grc%max_dayl(g) = daylength(grc%lat(g), max_decl) + end do + + ! History file variables + + if (use_cn) then + call hist_addfld1d (fname='DAYL', units='s', & + avgflag='A', long_name='daylength', & + ptr_gcell=grc%dayl, default='inactive') + + call hist_addfld1d (fname='PREV_DAYL', units='s', & + avgflag='A', long_name='daylength from previous timestep', & + ptr_gcell=grc%prev_dayl, default='inactive') + end if + + ! ------------------------------------------------------------------------ + ! Initialize component data structures + ! ------------------------------------------------------------------------ + + ! Note: new logic is in place that sets all the history fields to spval so + ! there is no guesswork in the initialization to nans of the allocated variables + + ! First put in history calls for subgrid data structures - these cannot appear in the + ! module for the subgrid data definition due to circular dependencies that are introduced + + data2dptr => col%dz(:,-nlevsno+1:0) + col%dz(bounds_proc%begc:bounds_proc%endc,:) = spval + call hist_addfld2d (fname='SNO_Z', units='m', type2d='levsno', & + avgflag='A', long_name='Snow layer thicknesses', & + ptr_col=data2dptr, no_snow_behavior=no_snow_normal, default='inactive') + + col%zii(bounds_proc%begc:bounds_proc%endc) = spval + call hist_addfld1d (fname='ZII', units='m', & + avgflag='A', long_name='convective boundary height', & + ptr_col=col%zii, default='inactive') + + ! If single-column determine closest latitude and longitude + + if (single_column) then + call getfil (fsurdat, locfn, 0) + call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & + closelat, closelon, closelatidx, closelonidx) + end if + + ! Initialize instances of all derived types as well as time constant variables + + call clm_instInit(bounds_proc) + + ! Initialize SNICAR optical and aging parameters + + call SnowOptics_init( ) ! SNICAR optical parameters: + call SnowAge_init( ) ! SNICAR aging parameters: + + call hist_printflds() + + ! ------------------------------------------------------------------------ + ! Initializate dynamic subgrid weights (for prescribed transient Patches, CNDV + ! and/or dynamic landunits); note that these will be overwritten in a + ! restart run + ! ------------------------------------------------------------------------ + + call t_startf('init_dyn_subgrid') + call init_subgrid_weights_mod(bounds_proc) + call dynSubgrid_init(bounds_proc, dgvs_inst) + call t_stopf('init_dyn_subgrid') + + ! ------------------------------------------------------------------------ + ! Initialize modules (after time-manager initialization in most cases) + ! ------------------------------------------------------------------------ + + if (use_cn) then + call CNDriverInit(bounds_proc) + + if (n_drydep > 0 .and. drydep_method == DD_XLND) then + ! Must do this also when drydeposition is used so that estimates of monthly + ! differences in LAI can be computed + call SatellitePhenologyInit(bounds_proc) + end if + + if ( use_c14 .and. use_c14_bombspike ) then + call C14_init_BombSpike() + end if + else + call SatellitePhenologyInit(bounds_proc) + end if + + ! ------------------------------------------------------------------------ + ! On restart only - process the history namelist. + ! ------------------------------------------------------------------------ + + ! Later the namelist from the restart file will be used. This allows basic + ! checking to make sure you didn't try to change the history namelist on restart. + + if (nsrest == nsrContinue ) then + call htapes_fieldlist() + end if + + ! ------------------------------------------------------------------------ + ! Read restart/initial info + ! ------------------------------------------------------------------------ + + is_cold_start = .false. + + if (nsrest == nsrStartup) then + + if (finidat == ' ') then + if (finidat_interp_source == ' ') then + is_cold_start = .true. + if (masterproc) then + write(iulog,*)'Using cold start initial conditions ' + end if + else + if (masterproc) then + write(iulog,*)'Interpolating initial conditions from ',trim(finidat_interp_source),& + ' and creating new initial conditions ', trim(finidat_interp_dest) + end if + end if + else + if (masterproc) then + write(iulog,*)'Reading initial conditions from ',trim(finidat) + end if + call getfil( finidat, fnamer, 0 ) + call restFile_read(bounds_proc, fnamer) + end if + + else if ((nsrest == nsrContinue) .or. (nsrest == nsrBranch)) then + + if (masterproc) then + write(iulog,*)'Reading restart file ',trim(fnamer) + end if + call restFile_read(bounds_proc, fnamer) + + end if + + ! ------------------------------------------------------------------------ + ! Initialize filters and weights + ! ------------------------------------------------------------------------ + + call t_startf('init_filters') + call allocFilters() + call t_stopf('init_filters') + + ! ------------------------------------------------------------------------ + ! If appropriate, create interpolated initial conditions + ! ------------------------------------------------------------------------ + + if (nsrest == nsrStartup .and. finidat_interp_source /= ' ') then + + ! Check that finidat is not cold start - abort if it is + if (finidat /= ' ') then + call endrun(msg='ERROR clm_initializeMod: '//& + 'finidat and finidat_interp_source cannot both be non-blank') + end if + + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + call reweight_wrapup(bounds_clump, & + glc2lnd_inst%icemask_grc(bounds_clump%begg:bounds_clump%endg)) + end do + !$OMP END PARALLEL DO + + ! Create new template file using cold start + call restFile_write(bounds_proc, finidat_interp_dest) + + ! Interpolate finidat onto new template file + call getfil( finidat_interp_source, fnamer, 0 ) + call initInterp(filei=fnamer, fileo=finidat_interp_dest, bounds=bounds_proc) + + ! Read new interpolated conditions file back in + call restFile_read(bounds_proc, finidat_interp_dest) + + ! Reset finidat to now be finidat_interp_dest + ! (to be compatible with routines still using finidat) + finidat = trim(finidat_interp_dest) + + end if + + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + call reweight_wrapup(bounds_clump, & + glc2lnd_inst%icemask_grc(bounds_clump%begg:bounds_clump%endg)) + end do + !$OMP END PARALLEL DO + + ! ------------------------------------------------------------------------ + ! Initialize nitrogen deposition + ! ------------------------------------------------------------------------ + + if (use_cn) then + call t_startf('init_ndep') + call ndep_init(bounds_proc) + call ndep_interp(bounds_proc, atm2lnd_inst) + call t_stopf('init_ndep') + end if + + ! ------------------------------------------------------------------------ + ! Initialize active history fields. + ! ------------------------------------------------------------------------ + + ! This is only done if not a restart run. If a restart run, then this + ! information has already been obtained from the restart data read above. + ! Note that routine hist_htapes_build needs time manager information, + ! so this call must be made after the restart information has been read. + + if (nsrest /= nsrContinue) then + call hist_htapes_build() + end if + + ! ------------------------------------------------------------------------ + ! Initialize variables that are associated with accumulated fields. + ! ------------------------------------------------------------------------ + + ! The following is called for both initial and restart runs and must + ! must be called after the restart file is read + + call atm2lnd_inst%initAccVars(bounds_proc) + call temperature_inst%initAccVars(bounds_proc) + if (use_ed) then + call ed_phenology_inst%initAccVars(bounds_proc) + endif + call canopystate_inst%initAccVars(bounds_proc) + if (use_cndv) then + call dgvs_inst%initAccVars(bounds_proc) + end if + if (crop_prog) then + call crop_inst%initAccVars(bounds_proc) + end if + + !------------------------------------------------------------ + ! Read monthly vegetation + !------------------------------------------------------------ + + ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation + ! to get estimates of monthly LAI + + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + call readAnnualVegetation(bounds_proc, canopystate_inst) + if (nsrest == nsrStartup .and. finidat /= ' ') then + ! Call interpMonthlyVeg for dry-deposition so that mlaidiff will be calculated + ! This needs to be done even if CN or CNDV is on! + call interpMonthlyVeg(bounds_proc, canopystate_inst) + end if + end if + + !------------------------------------------------------------ + ! Determine gridcell averaged properties to send to atm + !------------------------------------------------------------ + + if (nsrest == nsrStartup) then + call t_startf('init_map2gc') + call lnd2atm_minimal(bounds_proc, & + waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst) + call t_stopf('init_map2gc') + end if + + !------------------------------------------------------------ + ! Initialize sno export state to send to glc + !------------------------------------------------------------ + + if (create_glacier_mec_landunit) then + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + + call t_startf('init_lnd2glc') + call lnd2glc_inst%update_lnd2glc(bounds_clump, & + filter(nc)%num_do_smb_c, filter(nc)%do_smb_c, & + temperature_inst, waterflux_inst, init=.true.) + call t_stopf('init_lnd2glc') + end do + !$OMP END PARALLEL DO + end if + + !------------------------------------------------------------ + ! Deallocate wt_nat_patch + !------------------------------------------------------------ + + ! wt_nat_patch was allocated in initialize1, but needed to be kept around through + ! initialize2 for some consistency checking; now it can be deallocated + + deallocate(wt_nat_patch) + + ! -------------------------------------------------------------- + ! Initialise the ED model state structure + ! -------------------------------------------------------------- + + if ( use_ed ) then + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds_clump) + call ed_init( bounds_clump, ed_allsites_inst(bounds_clump%begg:bounds_clump%endg), ed_clm_inst, & + ed_phenology_inst, waterstate_inst, canopystate_inst) + end do + + endif ! use_ed + + ! topo_glc_mec was allocated in initialize1, but needed to be kept around through + ! initialize2 because it is used to initialize other variables; now it can be + ! deallocated + + deallocate(topo_glc_mec) + + !------------------------------------------------------------ + ! Write log output for end of initialization + !------------------------------------------------------------ + + call t_startf('init_wlog') + if (masterproc) then + write(iulog,*) 'Successfully initialized the land model' + if (nsrest == nsrStartup) then + write(iulog,*) 'begin initial run at: ' + else + write(iulog,*) 'begin continuation run at:' + end if + call get_curr_date(yr, mon, day, ncsec) + write(iulog,*) ' nstep= ',get_nstep(), ' year= ',yr,' month= ',mon,& + ' day= ',day,' seconds= ',ncsec + write(iulog,*) + write(iulog,'(72a1)') ("*",i=1,60) + write(iulog,*) + endif + call t_stopf('init_wlog') + + call t_stopf('clm_init2') + + end subroutine initialize2 + +end module clm_initializeMod diff --git a/components/clm/src/main/clm_instMod.F90 b/components/clm/src/main/clm_instMod.F90 new file mode 100644 index 0000000000..1ad760640e --- /dev/null +++ b/components/clm/src/main/clm_instMod.F90 @@ -0,0 +1,565 @@ +module clm_instMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Instances and definitions of all data types + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varpar , only : crop_prog, ndecomp_pools, nlevdecomp_full + use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_ed, use_voc + use clm_varctl , only : use_century_decomp + use clm_varcon , only : h2osno_max, bdsno, c13ratio, c14ratio + use landunit_varcon , only : istice, istice_mec, istsoil + use perf_mod , only : t_startf, t_stopf + + !----------------------------------------- + ! Constants + !----------------------------------------- + + use UrbanParamsType , only : urbanparams_type ! Constants + use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use CNDVType , only : dgv_ecophyscon ! Constants + use EDEcophysConType , only : EDecophyscon ! ED Constants + + !----------------------------------------- + ! Definition of component types + !----------------------------------------- + + use AerosolMod , only : aerosol_type + use CanopyStateType , only : canopystate_type + use ch4Mod , only : ch4_type + use CNBalanceCheckMod , only : cn_balance_type + use CNVegStateType , only : cnveg_state_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use CNDVType , only : dgvs_type + use CropType , only : crop_type + use DryDepVelocity , only : drydepvel_type + use DUSTMod , only : dust_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use IrrigationMod , only : irrigation_type + use LakeStateType , only : lakestate_type + use OzoneBaseMod , only : ozone_base_type + use OzoneFactoryMod , only : create_and_init_ozone_type + use PhotosynthesisMod , only : photosyns_type + use SoilHydrologyType , only : soilhydrology_type + use SoilStateType , only : soilstate_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceRadiationMod , only : surfrad_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterFluxType , only : waterflux_type + use WaterStateType , only : waterstate_type + use UrbanParamsType , only : urbanparams_type + use HumanIndexMod , only : humanindex_type + use VOCEmissionMod , only : vocemis_type + use atm2lndType , only : atm2lnd_type + use lnd2atmType , only : lnd2atm_type + use lnd2glcMod , only : lnd2glc_type + use glc2lndMod , only : glc2lnd_type + use glcDiagnosticsMod , only : glc_diagnostics_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use EDTypesMod , only : ed_site_type + use EDPhenologyType , only : ed_phenology_type + use EDCLMLinkMod , only : ed_clm_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use NutrientCompetitionMethodMod , only : nutrient_competition_method_type + ! + use SoilStateInitTimeConstMod , only : SoilStateInitTimeConst + use SoilHydrologyInitTimeConstMod , only : SoilHydrologyInitTimeConst + use SurfaceAlbedoMod , only : SurfaceAlbedoInitTimeConst + use LakeCon , only : LakeConInit + ! + implicit none + public ! By default everything is public + ! + !----------------------------------------- + ! Instances of component types + !----------------------------------------- + + ! Physics types + type(aerosol_type) :: aerosol_inst + type(canopystate_type) :: canopystate_inst + type(energyflux_type) :: energyflux_inst + type(frictionvel_type) :: frictionvel_inst + type(irrigation_type) :: irrigation_inst + type(lakestate_type) :: lakestate_inst + class(ozone_base_type), allocatable :: ozone_inst + type(photosyns_type) :: photosyns_inst + type(soilstate_type) :: soilstate_inst + type(soilhydrology_type) :: soilhydrology_inst + type(solarabs_type) :: solarabs_inst + type(surfalb_type) :: surfalb_inst + type(surfrad_type) :: surfrad_inst + type(temperature_type) :: temperature_inst + type(urbanparams_type) :: urbanparams_inst + type(humanindex_type) :: humanindex_inst + type(waterflux_type) :: waterflux_inst + type(waterstate_type) :: waterstate_inst + type(atm2lnd_type) :: atm2lnd_inst + type(glc2lnd_type) :: glc2lnd_inst + type(lnd2atm_type) :: lnd2atm_inst + type(lnd2glc_type) :: lnd2glc_inst + type(glc_diagnostics_type) :: glc_diagnostics_inst + class(soil_water_retention_curve_type) , allocatable :: soil_water_retention_curve + + ! CN vegetation types + type(cnveg_state_type) :: cnveg_state_inst + type(cnveg_carbonstate_type) :: cnveg_carbonstate_inst + type(cnveg_carbonstate_type) :: c13_cnveg_carbonstate_inst + type(cnveg_carbonstate_type) :: c14_cnveg_carbonstate_inst + type(cnveg_carbonflux_type) :: cnveg_carbonflux_inst + type(cnveg_carbonflux_type) :: c13_cnveg_carbonflux_inst + type(cnveg_carbonflux_type) :: c14_cnveg_carbonflux_inst + type(cnveg_nitrogenstate_type) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) :: cnveg_nitrogenflux_inst + type(cn_balance_type) :: cn_balance_inst + class(nutrient_competition_method_type), allocatable :: nutrient_competition_method + + ! Soil biogeochem types + type(soilbiogeochem_state_type) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonflux_type) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) :: soilbiogeochem_nitrogenflux_inst + + ! General biogeochem types + type(ch4_type) :: ch4_inst + type(dgvs_type) :: dgvs_inst + type(crop_type) :: crop_inst + type(dust_type) :: dust_inst + type(vocemis_type) :: vocemis_inst + type(drydepvel_type) :: drydepvel_inst + + ! ED types passed in from top level + type(ed_site_type), allocatable, target :: ed_allsites_inst(:) + type(ed_phenology_type) :: ed_phenology_inst + type(ed_clm_type) :: ed_clm_inst + ! + public :: clm_instInit + public :: clm_instRest + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine clm_instInit(bounds) + ! + ! !USES: + use clm_varpar , only : nlevsno, numpft, crop_prog + use controlMod , only : nlfilename, fsurdat + use domainMod , only : ldomain + use SoilBiogeochemDecompCascadeBGCMod , only : init_decompcascade_bgc + use SoilBiogeochemDecompCascadeCNMod , only : init_decompcascade_cn + use SoilBiogeochemDecompCascadeContype , only : init_decomp_cascade_constants + use EDEcophysConType , only : EDecophysconInit + use EDPftVarcon , only : EDpftvarcon_inst + use initVerticalMod , only : initVertical + use accumulMod , only : print_accum_fields + use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve + ! + ! !ARGUMENTS + type(bounds_type), intent(in) :: bounds ! processor bounds + ! + ! !LOCAL VARIABLES: + integer :: c,l,g + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + real(r8), allocatable :: h2osno_col(:) + real(r8), allocatable :: snow_depth_col(:) + + integer :: dummy_to_make_pgi_happy + !---------------------------------------------------------------------- + + ! Note: h2osno_col and snow_depth_col are initialized as local variable + ! since they are needed to initialize vertical data structures + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + begl = bounds%begl; endl = bounds%endl + + allocate (h2osno_col(begc:endc)) + allocate (snow_depth_col(begc:endc)) + + ! snow water + ! Note: Glacier_mec columns are initialized with half the maximum snow cover. + ! This gives more realistic values of qflx_glcice sooner in the simulation + ! for columns with net ablation, at the cost of delaying ice formation + ! in columns with net accumulation. + do c = begc,endc + l = col%landunit(c) + g = col%gridcell(c) + + if (lun%itype(l)==istice) then + h2osno_col(c) = h2osno_max + elseif (lun%itype(l)==istice_mec .or. & + (lun%itype(l)==istsoil .and. abs(grc%latdeg(g)) >= 60._r8)) then + ! In order to speed equilibration of the snow pack, initialize non-zero snow + ! thickness in some places. This is mainly of interest for glacier spinup. + ! However, putting in an explicit dependence on glcmask is problematic, because + ! that means that answers change simply due to changing glcmask (which may be + ! done simply to have additional virtual columns for the sake of diagnostics). + ! Thus, we apply this non-zero initialization at all high latitude soil points. + h2osno_col(c) = 0.5_r8 * h2osno_max ! 50 cm if h2osno_max = 1 m + else + h2osno_col(c) = 0._r8 + endif + snow_depth_col(c) = h2osno_col(c) / bdsno + end do + + ! Initialize urban constants + + call urbanparams_inst%Init(bounds) + call humanindex_inst%Init(bounds) + + ! Initialize vertical data components + + call initVertical(bounds, & + snow_depth_col(begc:endc), & + urbanparams_inst%thick_wall(begl:endl), & + urbanparams_inst%thick_roof(begl:endl)) + + ! Initialize clm->drv and drv->clm data structures + + call atm2lnd_inst%Init( bounds ) + call lnd2atm_inst%Init( bounds ) + + ! Initialize glc2lnd and lnd2glc even if running without create_glacier_mec_landunit, + ! because at least some variables (such as the icemask) are referred to in code that + ! is executed even when running without glc_mec. + + call glc2lnd_inst%Init( bounds ) + call lnd2glc_inst%Init( bounds ) + + ! Initialization of public data types + + call temperature_inst%Init(bounds, & + urbanparams_inst%em_roof(begl:endl), & + urbanparams_inst%em_wall(begl:endl), & + urbanparams_inst%em_improad(begl:endl), & + urbanparams_inst%em_perroad(begl:endl), & + IsSimpleBuildTemp(), IsProgBuildTemp() ) + + call canopystate_inst%Init(bounds) + + call soilstate_inst%Init(bounds) + call SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) ! sets hydraulic and thermal soil properties + + call waterstate_inst%Init(bounds, & + h2osno_col(begc:endc), & + snow_depth_col(begc:endc), & + soilstate_inst%watsat_col(begc:endc, 1:), & + temperature_inst%t_soisno_col(begc:endc, -nlevsno+1:) ) + + call waterflux_inst%Init(bounds) + + ! COMPILER_BUG(wjs, 2014-11-29, pgi 14.7) Without the following assignment, the + ! assertion in energyflux_inst%Init fails with pgi 14.7 on yellowstone, presumably due + ! to a compiler bug. + dummy_to_make_pgi_happy = ubound(temperature_inst%t_grnd_col, 1) + call energyflux_inst%Init(bounds, temperature_inst%t_grnd_col(begc:endc), & + IsSimpleBuildTemp(), IsProgBuildTemp() ) + + call aerosol_inst%Init(bounds) + + call frictionvel_inst%Init(bounds) + + call lakestate_inst%Init(bounds) + call LakeConInit() + + allocate(ozone_inst, source = create_and_init_ozone_type(bounds)) + + call photosyns_inst%Init(bounds) + + call soilhydrology_inst%Init(bounds, nlfilename) + call SoilHydrologyInitTimeConst(bounds, soilhydrology_inst) ! sets time constant properties + + call solarabs_inst%Init(bounds) + + call surfalb_inst%Init(bounds) + call SurfaceAlbedoInitTimeConst(bounds) + + call surfrad_inst%Init(bounds) + + call dust_inst%Init(bounds) + + call glc_diagnostics_inst%Init(bounds) + + ! Once namelist options are added to control the soil water retention curve method, + ! we'll need to either pass the namelist file as an argument to this routine, or pass + ! the namelist value itself (if the namelist is read elsewhere). + + allocate(soil_water_retention_curve, & + source=create_soil_water_retention_curve()) + + call irrigation_inst%init(bounds, soilstate_inst, soil_water_retention_curve) + + ! Note - always initialize the memory for ch4_inst + call ch4_inst%Init(bounds, soilstate_inst%cellorg_col(begc:endc, 1:), fsurdat) + + ! Note - always initialize the memory for cnveg_state_inst (used in biogeophys/) + call cnveg_state_inst%Init(bounds) + + if (use_voc ) then + call vocemis_inst%Init(bounds) + end if + + call drydepvel_inst%Init(bounds) + + if (use_cn) then + + ! Note - always initialize the memory for the c13_xxx_inst and + ! c14_xxx_inst data structure so that they can be used in + ! associate statements (nag compiler complains otherwise) + + ! Note that SoillBiogeochem types must ALWAYS be allocated first - since CNVeg_xxxType + ! can reference SoilBiogeochem types (for both carbon and nitrogen) + + ! Initialize soilbiogeochem_state_inst + + call soilbiogeochem_state_inst%Init(bounds) + + ! Initialize decompcascade constants + ! Note that init_decompcascade_bgc and init_decompcascade_cn need + ! soilbiogeochem_state_inst to be initialized + + call init_decomp_cascade_constants() + if (use_century_decomp) then + call init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_inst) + else + call init_decompcascade_cn(bounds, soilbiogeochem_state_inst) + end if + + ! Initalize soilbiogeochem carbon and nitrogen types + + call soilbiogeochem_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8) + if (use_c13) then + call c13_soilbiogeochem_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & + c12_soilbiogeochem_carbonstate_inst=soilbiogeochem_carbonstate_inst) + end if + if (use_c14) then + call c14_soilbiogeochem_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & + c12_soilbiogeochem_carbonstate_inst=soilbiogeochem_carbonstate_inst) + end if + call soilbiogeochem_nitrogenstate_inst%Init(bounds, & + soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools), & + soilbiogeochem_carbonstate_inst%decomp_cpools_col(begc:endc,1:ndecomp_pools), & + soilbiogeochem_carbonstate_inst%decomp_cpools_1m_col(begc:endc, 1:ndecomp_pools)) + + call soilbiogeochem_carbonflux_inst%Init(bounds, carbon_type='c12') + if (use_c13) then + call c13_soilbiogeochem_carbonflux_inst%Init(bounds, carbon_type='c13') + end if + if (use_c14) then + call c14_soilbiogeochem_carbonflux_inst%Init(bounds, carbon_type='c14') + end if + call soilbiogeochem_nitrogenflux_inst%Init(bounds) + + ! Initalize cnveg carbon and nitrogen types + + call cnveg_carbonstate_inst%Init(bounds, carbon_type='c12', ratio=1._r8) + if (use_c13) then + call c13_cnveg_carbonstate_inst%Init(bounds, carbon_type='c13', ratio=c13ratio, & + c12_cnveg_carbonstate_inst=cnveg_carbonstate_inst) + end if + if (use_c14) then + call c14_cnveg_carbonstate_inst%Init(bounds, carbon_type='c14', ratio=c14ratio, & + c12_cnveg_carbonstate_inst=cnveg_carbonstate_inst) + end if + call cnveg_carbonflux_inst%Init(bounds, carbon_type='c12') + if (use_c13) then + call c13_cnveg_carbonflux_inst%Init(bounds, carbon_type='c13') + end if + if (use_c14) then + call c14_cnveg_carbonflux_inst%Init(bounds, carbon_type='c14') + end if + call cnveg_nitrogenstate_inst%Init(bounds, & + cnveg_carbonstate_inst%leafc_patch(begp:endp), & + cnveg_carbonstate_inst%leafc_storage_patch(begp:endp), & + cnveg_carbonstate_inst%frootc_patch(begp:endp), & + cnveg_carbonstate_inst%frootc_storage_patch(begp:endp), & + cnveg_carbonstate_inst%deadstemc_patch(begp:endp)) + call cnveg_nitrogenflux_inst%Init(bounds) + + call cn_balance_inst%Init(bounds) + + ! Note - always initialize the memory for the dgvs_inst data structure so + ! that it can be used in associate statements (nag compiler complains otherwise) + + call dgvs_inst%Init(bounds) + + call crop_inst%Init(bounds) + + end if ! end of if use_cn + + ! NOTE (MV, 10-24-2014): because ed_allsites is currently passed as arguments to + ! biogeophys routines in the present implementation - it needs to be allocated - + ! if use_ed is not set, then this will not contain any significant memory + ! if use_ed is true, then the actual memory for all of the ED data structures + ! is allocated in the call to EDInitMod - called from clm_initialize + + allocate (ed_allsites_inst(bounds%begg:bounds%endg)) + if (use_ed) then + call ed_clm_inst%Init(bounds) + call ed_phenology_inst%Init(bounds) + call EDecophysconInit( EDpftvarcon_inst, numpft) + end if + + deallocate (h2osno_col) + deallocate (snow_depth_col) + + ! ------------------------------------------------------------------------ + ! Initialize accumulated fields + ! ------------------------------------------------------------------------ + + ! The time manager needs to be initialized before this called is made, since + ! the step size is needed. + + call t_startf('init_accflds') + + call atm2lnd_inst%InitAccBuffer(bounds) + + call temperature_inst%InitAccBuffer(bounds) + + if (use_ed) then + call ed_phenology_inst%initAccBuffer(bounds) + endif + + call canopystate_inst%InitAccBuffer(bounds) + + if (use_cndv) then + call dgvs_inst%InitAccBuffer(bounds) + end if + + if (crop_prog) then + call crop_inst%InitAccBuffer(bounds) + end if + + call print_accum_fields() + + call t_stopf('init_accflds') + + end subroutine clm_instInit + + !----------------------------------------------------------------------- + subroutine clm_instRest(bounds, ncid, flag) + ! + ! !USES: + use ncdio_pio , only : file_desc_t + use EDRestVectorMod , only : EDRest + use UrbanParamsType , only : IsSimpleBuildTemp, IsProgBuildTemp + ! + ! !DESCRIPTION: + ! Define/write/read CLM restart file. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'define', 'write', 'read' + !----------------------------------------------------------------------- + + call atm2lnd_inst%restart (bounds, ncid, flag=flag) + + call canopystate_inst%restart (bounds, ncid, flag=flag) + + call energyflux_inst%restart (bounds, ncid, flag=flag, & + is_simple_buildtemp=IsSimpleBuildTemp(), is_prog_buildtemp=IsProgBuildTemp()) + + call frictionvel_inst% restart (bounds, ncid, flag=flag) + + call lakestate_inst%restart (bounds, ncid, flag=flag) + + call ozone_inst%restart (bounds, ncid, flag=flag) + + call photosyns_inst%restart (bounds, ncid, flag=flag) + + call soilhydrology_inst%restart (bounds, ncid, flag=flag) + + call solarabs_inst%restart (bounds, ncid, flag=flag) + + call temperature_inst%restart (bounds, ncid, flag=flag, & + is_simple_buildtemp=IsSimpleBuildTemp(), is_prog_buildtemp=IsProgBuildTemp()) + + call waterflux_inst%restart (bounds, ncid, flag=flag) + + call waterstate_inst%restart (bounds, ncid, flag=flag, & + watsat_col=soilstate_inst%watsat_col(bounds%begc:bounds%endc,:)) + + call irrigation_inst%restart (bounds, ncid, flag=flag) + + call aerosol_inst%restart (bounds, ncid, flag=flag, & + h2osoi_ice_col=waterstate_inst%h2osoi_ice_col(bounds%begc:bounds%endc,:), & + h2osoi_liq_col=waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,:)) + + call surfalb_inst%restart (bounds, ncid, flag=flag, & + tlai_patch=canopystate_inst%tlai_patch(bounds%begp:bounds%endp), & + tsai_patch=canopystate_inst%tsai_patch(bounds%begp:bounds%endp)) + + if (use_lch4) then + call ch4_inst%restart(bounds, ncid, flag=flag) + end if + + if (use_cn) then + + call soilbiogeochem_state_inst%restart(bounds, ncid, flag=flag) + call soilbiogeochem_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12') + if (use_c13) then + call c13_soilbiogeochem_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & + c12_soilbiogeochem_carbonstate_inst=soilbiogeochem_carbonstate_inst) + end if + if (use_c14) then + call c14_soilbiogeochem_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c14', & + c12_soilbiogeochem_carbonstate_inst=soilbiogeochem_carbonstate_inst) + end if + call soilbiogeochem_carbonflux_inst%restart(bounds, ncid, flag=flag) + call soilbiogeochem_nitrogenstate_inst%restart(bounds, ncid, flag=flag) + call soilbiogeochem_nitrogenflux_inst%restart(bounds, ncid, flag=flag) + + call cnveg_state_inst%restart(bounds, ncid, flag=flag) + call cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c12') + if (use_c13) then + call c13_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c13', & + c12_cnveg_carbonstate_inst=cnveg_carbonstate_inst) + end if + if (use_c14) then + call c14_cnveg_carbonstate_inst%restart(bounds, ncid, flag=flag, carbon_type='c14', & + c12_cnveg_carbonstate_inst=cnveg_carbonstate_inst) + end if + call cnveg_carbonflux_inst%restart(bounds, ncid, flag=flag) + call cnveg_nitrogenstate_inst%restart(bounds, ncid, flag=flag) + call cnveg_nitrogenflux_inst%restart(bounds, ncid, flag=flag) + + end if + + if (use_cndv) then + call dgvs_inst%Restart(bounds, ncid, flag=flag) + end if + + if (use_ed) then + call EDRest ( bounds, ncid, flag, ed_allsites_inst(bounds%begg:bounds%endg), & + ed_clm_inst, ed_phenology_inst, waterstate_inst, canopystate_inst ) + end if + + end subroutine clm_instRest + +end module clm_instMod + diff --git a/components/clm/src/main/clm_varcon.F90 b/components/clm/src/main/clm_varcon.F90 new file mode 100644 index 0000000000..ebfdebb2c0 --- /dev/null +++ b/components/clm/src/main/clm_varcon.F90 @@ -0,0 +1,256 @@ +module clm_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing various model constants. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_G,SHR_CONST_STEBOL,SHR_CONST_KARMAN, & + SHR_CONST_RWV,SHR_CONST_RDAIR,SHR_CONST_CPFW, & + SHR_CONST_CPICE,SHR_CONST_CPDAIR,SHR_CONST_LATVAP, & + SHR_CONST_LATSUB,SHR_CONST_LATICE,SHR_CONST_RHOFW, & + SHR_CONST_RHOICE,SHR_CONST_TKFRZ,SHR_CONST_REARTH, & + SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, & + SHR_CONST_RGAS, SHR_CONST_PSTD + use clm_varpar , only: numrad, nlevgrnd, nlevlak, nlevdecomp_full + use clm_varpar , only: ngases + use clm_varpar , only: nlayer + + ! + ! !PUBLIC TYPES: + implicit none + save + !----------------------------------------------------------------------- + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_varcon_init ! initialize constants in clm_varcon + ! + ! !REVISION HISTORY: + ! Created by Mariana Vertenstein + ! 27 February 2008: Keith Oleson; Add forcing height and aerodynamic parameters + !----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Initialize mathmatical constants + !------------------------------------------------------------------ + + real(r8) :: rpi = SHR_CONST_PI + + !------------------------------------------------------------------ + ! Initialize physical constants + !------------------------------------------------------------------ + + real(r8), parameter :: n_melt=0.7 ! fsca shape parameter + real(r8), parameter :: e_ice=6.0 ! soil ice impedance factor + real(r8), parameter :: pc = 0.4 ! threshold probability + real(r8), parameter :: mu = 0.13889 ! connectivity exponent + real(r8) :: grav = SHR_CONST_G ! gravity constant [m/s2] + real(r8) :: sb = SHR_CONST_STEBOL ! stefan-boltzmann constant [W/m2/K4] + real(r8) :: vkc = SHR_CONST_KARMAN ! von Karman constant [-] + real(r8) :: rwat = SHR_CONST_RWV ! gas constant for water vapor [J/(kg K)] + real(r8) :: rair = SHR_CONST_RDAIR ! gas constant for dry air [J/kg/K] + real(r8) :: roverg = SHR_CONST_RWV/SHR_CONST_G*1000._r8 ! Rw/g constant = (8.3144/0.018)/(9.80616)*1000. mm/K + real(r8) :: cpliq = SHR_CONST_CPFW ! Specific heat of water [J/kg-K] + real(r8) :: cpice = SHR_CONST_CPICE ! Specific heat of ice [J/kg-K] + real(r8) :: cpair = SHR_CONST_CPDAIR ! specific heat of dry air [J/kg/K] + real(r8) :: hvap = SHR_CONST_LATVAP ! Latent heat of evap for water [J/kg] + real(r8) :: hsub = SHR_CONST_LATSUB ! Latent heat of sublimation [J/kg] + real(r8) :: hfus = SHR_CONST_LATICE ! Latent heat of fusion for ice [J/kg] + real(r8) :: denh2o = SHR_CONST_RHOFW ! density of liquid water [kg/m3] + real(r8) :: denice = SHR_CONST_RHOICE ! density of ice [kg/m3] + real(r8) :: rgas = SHR_CONST_RGAS ! universal gas constant [J/K/kmole] + real(r8) :: pstd = SHR_CONST_PSTD ! standard pressure [Pa] + real(r8) :: tkair = 0.023_r8 ! thermal conductivity of air [W/m/K] + real(r8) :: tkice = 2.290_r8 ! thermal conductivity of ice [W/m/K] + real(r8) :: tkwat = 0.57_r8 ! thermal conductivity of water [W/m/K] + real(r8) :: tfrz = SHR_CONST_TKFRZ ! freezing temperature [K] + real(r8), parameter :: tcrit = 2.5_r8 ! critical temperature to determine rain or snow + real(r8) :: o2_molar_const = 0.209_r8 ! constant atmospheric O2 molar ratio (mol/mol) + real(r8) :: oneatm = 1.01325e5_r8 ! one standard atmospheric pressure [Pa] + real(r8) :: bdsno = 250._r8 ! bulk density snow (kg/m**3) + real(r8) :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting + real(r8) :: tlsai_crit = 2.0_r8 ! critical value of elai+esai for which aerodynamic parameters are maximum + real(r8) :: watmin = 0.01_r8 ! minimum soil moisture (mm) + + real(r8) :: re = SHR_CONST_REARTH*0.001_r8 ! radius of earth (km) + + real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second + real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day + integer, public, parameter :: isecspday= secspday ! Integer seconds per day + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + integer , public, parameter :: ispval = -9999 ! special value for int data + ! (keep this negative to avoid conflicts with possible valid values) + + ! These are tunable constants from clm2_3 + + real(r8) :: zlnd = 0.01_r8 ! Roughness length for soil [m] + real(r8) :: zsno = 0.0024_r8 ! Roughness length for snow [m] + real(r8) :: csoilc = 0.004_r8 ! Drag coefficient for soil under canopy [-] + real(r8) :: capr = 0.34_r8 ! Tuning factor to turn first layer T into surface T + real(r8) :: cnfac = 0.5_r8 ! Crank Nicholson factor between 0 and 1 + real(r8) :: ssi = 0.033_r8 ! Irreducible water saturation of snow + real(r8) :: wimp = 0.05_r8 ! Water impremeable if porosity less than wimp + real(r8) :: pondmx = 0.0_r8 ! Ponding depth (mm) + real(r8) :: pondmx_urban = 1.0_r8 ! Ponding depth for urban roof and impervious road (mm) + + real(r8) :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock + ! (Clauser and Huenges, 1995)(W/m/K) + + !!! C13 + real(r8), parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C + real(r8), parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C + real(r8) :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere + + !!! C14 + real(r8) :: c14ratio = 1.e-12_r8 + ! real(r8) :: c14ratio = 1._r8 ! debug lets set to 1 to try to avoid numerical errors + + !------------------------------------------------------------------ + ! Urban building temperature constants + !------------------------------------------------------------------ + real(r8) :: ht_wasteheat_factor = 0.2_r8 ! wasteheat factor for urban heating (-) + real(r8) :: ac_wasteheat_factor = 0.6_r8 ! wasteheat factor for urban air conditioning (-) + real(r8) :: em_roof_int = 0.9_r8 ! emissivity of interior surface of roof (Bueno et al. 2012, GMD) + real(r8) :: em_sunw_int = 0.9_r8 ! emissivity of interior surface of sunwall (Bueno et al. 2012, GMD) + real(r8) :: em_shdw_int = 0.9_r8 ! emissivity of interior surface of shadewall Bueno et al. 2012, GMD) + real(r8) :: em_floor_int = 0.9_r8 ! emissivity of interior surface of floor (Bueno et al. 2012, GMD) + real(r8) :: hcv_roof = 0.948_r8 ! interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8) :: hcv_roof_enhanced = 4.040_r8 ! enhanced (t_roof_int <= t_room) interior convective heat transfer coefficient for roof (Bueno et al. 2012, GMD) !(W m-2 K-1) + real(r8) :: hcv_floor = 0.948_r8 ! interior convective heat transfer coefficient for floor (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8) :: hcv_floor_enhanced = 4.040_r8 ! enhanced (t_floor_int >= t_room) interior convective heat transfer coefficient for floor (Bueno et al. !2012, GMD) (W m-2 K-1) + real(r8) :: hcv_sunw = 3.076_r8 ! interior convective heat transfer coefficient for sunwall (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8) :: hcv_shdw = 3.076_r8 ! interior convective heat transfer coefficient for shadewall (Bueno et al. 2012, GMD) (W m-2 K-1) + real(r8) :: dz_floor = 0.1_r8 ! floor thickness - concrete (Salmanca et al. 2010, TAC) (m) + real(r8), parameter :: dens_floor = 2.35e3_r8 ! density of floor - concrete (Salmanca et al. 2010, TAC) (kg m-3) + real(r8), parameter :: sh_floor = 880._r8 ! specific heat of floor - concrete (Salmanca et al. 2010, TAC) (J kg-1 K-1) + real(r8) :: cp_floor = dens_floor*sh_floor ! volumetric heat capacity of floor - concrete (Salmanca et al. 2010, TAC) (J m-3 K-1) + real(r8) :: vent_ach = 0.3 ! ventilation rate (air exchanges per hour) + + real(r8) :: wasteheat_limit = 100._r8 ! limit on wasteheat (W/m2) + + !------------------------------------------------------------------ + + real(r8) :: h2osno_max = -999.0_r8 ! max allowed snow thickness (mm H2O) + real(r8), parameter :: lapse_glcmec = 0.006_r8 ! surface temperature lapse rate (deg m-1) + ! Pritchard et al. (GRL, 35, 2008) use 0.006 + + integer, private :: i ! loop index + + !real(r8), parameter :: nitrif_n2o_loss_frac = 0.02_r8 ! fraction of N lost as N2O in nitrification (Parton et al., 2001) + real(r8), parameter :: nitrif_n2o_loss_frac = 6.e-4_r8 ! fraction of N lost as N2O in nitrification (Li et al., 2000) + real(r8), parameter :: frac_minrlztn_to_no3 = 0.2_r8 ! fraction of N mineralized that is dieverted to the nitrification stream (Parton et al., 2001) + + !------------------------------------------------------------------ + ! Set subgrid names + !------------------------------------------------------------------ + + character(len=16), parameter :: grlnd = 'lndgrid' ! name of lndgrid + character(len=16), parameter :: namea = 'gridcellatm' ! name of atmgrid + character(len=16), parameter :: nameg = 'gridcell' ! name of gridcells + character(len=16), parameter :: namel = 'landunit' ! name of landunits + character(len=16), parameter :: namec = 'column' ! name of columns + character(len=16), parameter :: namep = 'pft' ! name of patches + character(len=16), parameter :: nameCohort = 'cohort' ! name of cohorts (ED specific) + + !------------------------------------------------------------------ + ! Initialize miscellaneous radiation constants + !------------------------------------------------------------------ + + real(r8) :: betads = 0.5_r8 ! two-stream parameter betad for snow + real(r8) :: betais = 0.5_r8 ! two-stream parameter betai for snow + real(r8) :: omegas(numrad) ! two-stream parameter omega for snow by band + data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ + + ! Lake Model Constants will be defined in LakeCon. + + !------------------------------------------------------------------ + ! Soil depths are constants for now; lake depths can vary by gridcell + ! zlak and dzlak correspond to the default 50 m lake depth. + ! The values for the following arrays are set in routine iniTimeConst + !------------------------------------------------------------------ + + real(r8), allocatable :: zlak(:) !lake z (layers) + real(r8), allocatable :: dzlak(:) !lake dz (thickness) + real(r8), allocatable :: zsoi(:) !soil z (layers) + real(r8), allocatable :: dzsoi(:) !soil dz (thickness) + real(r8), allocatable :: zisoi(:) !soil zi (interfaces) + real(r8), allocatable :: dzsoi_decomp(:) !soil dz (thickness) + integer , allocatable :: nlvic(:) !number of CLM layers in each VIC layer (#) + real(r8), allocatable :: dzvic(:) !soil dz (thickness) of each VIC layer + real(r8) ,allocatable :: zsoifl(:) !original soil midpoint (used in interpolation of sand and clay) + real(r8) ,allocatable :: zisoifl(:) !original soil interface depth (used in interpolation of sand and clay) + real(r8) ,allocatable :: dzsoifl(:) !original soil thickness (used in interpolation of sand and clay) + + !------------------------------------------------------------------ + ! (Non-tunable) Constants for the CH4 submodel (Tuneable constants in ch4varcon) + !------------------------------------------------------------------ + ! Note some of these constants are also used in CNNitrifDenitrifMod + + real(r8), parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol) + + real(r8) :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #) + data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4 + data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2 + data (s_con(3,i),i=1,4) /1911_r8, -113.7_r8, 2.967_r8, -0.02943_r8/ ! CO2 + + real(r8) :: d_con_w(ngases,3) ! water diffusivity constants (spp, #) (mult. by 10^-4) + data (d_con_w(1,i),i=1,3) /0.9798_r8, 0.02986_r8, 0.0004381_r8/ ! CH4 + data (d_con_w(2,i),i=1,3) /1.172_r8, 0.03443_r8, 0.0005048_r8/ ! O2 + data (d_con_w(3,i),i=1,3) /0.939_r8, 0.02671_r8, 0.0004095_r8/ ! CO2 + + real(r8) :: d_con_g(ngases,2) ! gas diffusivity constants (spp, #) (cm^2/s) (mult. by 10^-9) + data (d_con_g(1,i),i=1,2) /0.1875_r8, 0.0013_r8/ ! CH4 + data (d_con_g(2,i),i=1,2) /0.1759_r8, 0.00117_r8/ ! O2 + data (d_con_g(3,i),i=1,2) /0.1325_r8, 0.0009_r8/ ! CO2 + + real(r8) :: c_h_inv(ngases) ! constant (K) for Henry's law (4.12, Wania) + data c_h_inv(1:3) /1600._r8, 1500._r8, 2400._r8/ ! CH4, O2, CO2 + + real(r8) :: kh_theta(ngases) ! Henry's constant (L.atm/mol) at standard temperature (298K) + data kh_theta(1:3) /714.29_r8, 769.23_r8, 29.4_r8/ ! CH4, O2, CO2 + + real(r8) :: kh_tbase = 298._r8 ! base temperature for calculation of Henry's constant (K) + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine clm_varcon_init( is_simple_buildtemp ) + ! + ! !DESCRIPTION: + ! This subroutine initializes constant arrays in clm_varcon. + ! MUST be called after clm_varpar_init. + ! + ! !USES: + use clm_varpar, only: nlevgrnd, nlevlak, nlevdecomp_full, nlevsoifl, nlayer + ! + ! !ARGUMENTS: + implicit none + logical, intent(in) :: is_simple_buildtemp ! If simple building temp method is being used + ! + ! !REVISION HISTORY: + ! Created by E. Kluzek +!------------------------------------------------------------------------------ + + allocate( zlak(1:nlevlak )) + allocate( dzlak(1:nlevlak )) + allocate( zsoi(1:nlevgrnd )) + allocate( dzsoi(1:nlevgrnd )) + allocate( zisoi(0:nlevgrnd )) + allocate( dzsoi_decomp(1:nlevdecomp_full )) + allocate( nlvic(1:nlayer )) + allocate( dzvic(1:nlayer )) + allocate( zsoifl(1:nlevsoifl )) + allocate( zisoifl(0:nlevsoifl )) + allocate( dzsoifl(1:nlevsoifl )) + + ! Zero out wastheat factors for simpler building temperature method (introduced in CLM4.5) + if ( is_simple_buildtemp )then + ht_wasteheat_factor = 0.0_r8 + ac_wasteheat_factor = 0.0_r8 + end if + + end subroutine clm_varcon_init + +end module clm_varcon diff --git a/components/clm/src/main/clm_varctl.F90 b/components/clm/src/main/clm_varctl.F90 new file mode 100644 index 0000000000..629a0d2b5e --- /dev/null +++ b/components/clm/src/main/clm_varctl.F90 @@ -0,0 +1,376 @@ +module clm_varctl + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing run control variables + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8, SHR_KIND_CL + use shr_sys_mod , only: shr_sys_abort ! cannot use endrun here due to circular dependency + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + public :: clm_varctl_set ! Set variables + public :: cnallocate_carbon_only_set + public :: cnallocate_carbon_only + ! + private + save + ! + ! !PUBLIC TYPES: + ! + integer , parameter, public :: iundef = -9999999 + real(r8), parameter, public :: rundef = -9999999._r8 + integer , parameter, public :: fname_len = SHR_KIND_CL ! max length of file names in this module + !---------------------------------------------------------- + ! + ! Run control variables + ! + ! case id + character(len=256), public :: caseid = ' ' + + ! case title + character(len=256), public :: ctitle = ' ' + + ! Type of run + integer, public :: nsrest = iundef + logical, public :: is_cold_start = .false. + + ! Startup from initial conditions + integer, public, parameter :: nsrStartup = 0 + + ! Continue from restart files + integer, public, parameter :: nsrContinue = 1 + + ! Branch from restart files + integer, public, parameter :: nsrBranch = 2 + + ! true => allow case name to remain the same for branch run + ! by default this is not allowed + logical, public :: brnch_retain_casename = .false. + + !true => no valid land points -- do NOT run + logical, public :: noland = .false. + + ! Hostname of machine running on + character(len=256), public :: hostname = ' ' + + ! username of user running program + character(len=256), public :: username = ' ' + + ! description of this source + character(len=256), public :: source = "Community Land Model CLM4.0" + + ! version of program + character(len=256), public :: version = " " + + ! dataset conventions + character(len=256), public :: conventions = "CF-1.0" + + !---------------------------------------------------------- + ! Unit Numbers + !---------------------------------------------------------- + ! + integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 + + !---------------------------------------------------------- + ! Output NetCDF files + !---------------------------------------------------------- + + logical, public :: outnc_large_files = .true. ! large file support for output NetCDF files + + !---------------------------------------------------------- + ! Run input files + !---------------------------------------------------------- + + character(len=fname_len), public :: finidat = ' ' ! initial conditions file name + character(len=fname_len), public :: fsurdat = ' ' ! surface data file name + character(len=fname_len), public :: fatmgrid = ' ' ! atm grid file name + character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid + character(len=fname_len), public :: fatmtopo = ' ' ! topography on atm grid + character(len=fname_len), public :: flndtopo = ' ' ! topography on lnd grid + character(len=fname_len), public :: paramfile = ' ' ! ASCII data file with PFT physiological constants + character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run + character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name + character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name + + !---------------------------------------------------------- + ! Flag to turn on MEGAN VOC's + !---------------------------------------------------------- + + logical, public :: use_voc = .true. + + !---------------------------------------------------------- + ! Interpolation of finidat if requested + !---------------------------------------------------------- + + logical, public :: bound_h2osoi = .true. ! for debugging + + ! If finidat_interp_source is non-blank and finidat is blank then interpolation will be done from + ! finidat_interp_source to finidat_interp_dest + + character(len=fname_len), public :: finidat_interp_source = ' ' + character(len=fname_len), public :: finidat_interp_dest = 'finidat_interp_dest.nc' + + !---------------------------------------------------------- + ! Irrigate logic + !---------------------------------------------------------- + + ! do not irrigate by default + logical, public :: irrigate = .false. + + !---------------------------------------------------------- + ! Landunit logic + !---------------------------------------------------------- + + ! true => separate crop landunit is not created by default + logical, public :: create_crop_landunit = .false. + + !---------------------------------------------------------- + ! Other subgrid logic + !---------------------------------------------------------- + + ! true => make ALL patches, cols & landunits active (even if weight is 0) + logical, public :: all_active = .false. + + !---------------------------------------------------------- + ! BGC logic and datasets + !---------------------------------------------------------- + + ! values of 'prognostic','diagnostic','constant' + character(len=16), public :: co2_type = 'constant' + + ! State of the model for the accelerated decomposition (AD) spinup. + ! 0 (default) = normal model; 1 = AD SPINUP + integer, public :: spinup_state = 0 + + ! true => anoxia is applied to heterotrophic respiration also considered in CH4 model + ! default value reset in controlMod + logical, public :: anoxia = .true. + + ! used to override an error check on reading in restart files + logical, public :: override_bgc_restart_mismatch_dump = .false. + + ! Set in CNAllocationInit (TODO - had to move it here to avoid circular dependency) + logical, private:: carbon_only + + ! Set in CNNDynamicsInit + ! NOTE (mvertens, 2014-9 had to move it here to avoid confusion when carbon data types + ! wehre split - TODO - should move it our of this module) + ! NOTE(bandre, 2013-10) according to Charlie Koven, nfix_timeconst + ! is currently used as a flag and rate constant. + ! Rate constant: time over which to exponentially relax the npp flux for N fixation term + ! (days) time over which to exponentially relax the npp flux for N fixation term + ! flag: (if <= 0. or >= 365; use old annual method). + ! Default value is junk that should always be overwritten by the namelist or init function! + ! + real(r8), public :: nfix_timeconst = -1.2345_r8 + + !---------------------------------------------------------- + ! Physics + !---------------------------------------------------------- + + ! use subgrid fluxes + integer, public :: subgridflag = 1 + + ! true => repartition rain/snow from atm based on temperature + logical, public :: repartition_rain_snow = .false. + + ! true => write global average diagnostics to std out + logical, public :: wrtdia = .false. + + ! atmospheric CO2 molar ratio (by volume) (umol/mol) + real(r8), public :: co2_ppmv = 355._r8 ! + + !---------------------------------------------------------- + ! C isotopes + !---------------------------------------------------------- + + logical, public :: use_c13 = .false. ! true => use C-13 model + logical, public :: use_c14 = .false. ! true => use C-14 model + + !---------------------------------------------------------- + ! ED switches + !---------------------------------------------------------- + + logical, public :: use_ed = .false. ! true => use ED + logical, public :: use_ed_spit_fire = .false. ! true => use spitfire model + + !---------------------------------------------------------- + ! LUNA switches + !---------------------------------------------------------- + + logical, public :: use_luna = .false. ! true => use LUNA + + !---------------------------------------------------------- + ! flexibleCN + !---------------------------------------------------------- + ! TODO(bja, 2015-08) some of these need to be moved into the + ! appropriate module. + logical, public :: use_flexibleCN = .false. + logical, public :: MM_Nuptake_opt = .false. + logical, public :: dynamic_plant_alloc_opt = .false. + logical, public :: downreg_opt = .true. + integer, public :: plant_ndemand_opt = 0 + logical, public :: substrate_term_opt = .true. + logical, public :: nscalar_opt = .true. + logical, public :: temp_scalar_opt = .true. + logical, public :: CNratio_floating = .false. + logical, public :: lnc_opt = .false. + logical, public :: reduce_dayl_factor = .false. + integer, public :: vcmax_opt = 0 + integer, public :: CN_residual_opt = 0 + integer, public :: CN_partition_opt = 0 + integer, public :: carbon_excess_opt = 0 + integer, public :: carbon_storage_excess_opt = 0 + integer, public :: CN_evergreen_phenology_opt = 0 + + !---------------------------------------------------------- + ! lai streams switch for Sat. Phenology + !---------------------------------------------------------- + + logical, public :: use_lai_streams = .false. ! true => use lai streams in SatellitePhenologyMod.F90 + + !---------------------------------------------------------- + ! glacier_mec control variables: default values (may be overwritten by namelist) + ! NOTE: glc_smb must have the same values for CLM and GLC + !---------------------------------------------------------- + + ! glacier_mec landunit is not created (set in controlMod) + logical , public :: create_glacier_mec_landunit = .false. + + ! if true, pass surface mass balance info to GLC + logical , public :: glc_smb = .true. + + ! if false, pass positive-degree-day info to GLC + + ! true => CLM glacier area & topography changes dynamically + logical , public :: glc_do_dynglacier = .false. + + ! true => downscale longwave radiation + logical , public :: glcmec_downscale_longwave = .true. + + ! number of days before one considers the perennially snow-covered point 'land ice' + integer , public :: glc_snow_persistence_max_days = 7300 + + ! glacier mask file name + character(len=fname_len), public :: fglcmask = ' ' + ! + !---------------------------------------------------------- + ! single column control variables + !---------------------------------------------------------- + + logical, public :: single_column = .false. ! true => single column mode + real(r8), public :: scmlat = rundef ! single column lat + real(r8), public :: scmlon = rundef ! single column lon + + !---------------------------------------------------------- + ! instance control + !---------------------------------------------------------- + + integer, public :: inst_index + character(len=16), public :: inst_name + character(len=16), public :: inst_suffix + + !---------------------------------------------------------- + ! Decomp control variables + !---------------------------------------------------------- + + ! number of segments per clump for decomp + integer, public :: nsegspc = 20 + + !---------------------------------------------------------- + ! Derived variables (run, history and restart file) + !---------------------------------------------------------- + + ! directory name for local restart pointer file + character(len=256), public :: rpntdir = '.' + + ! file name for local restart pointer file + character(len=256), public :: rpntfil = 'rpointer.lnd' + + ! moved hist_wrtch4diag from histFileMod.F90 to here - caused compiler error with intel + ! namelist: write CH4 extra diagnostic output + logical, public :: hist_wrtch4diag = .false. + + !---------------------------------------------------------- + ! Migration of CPP variables + !---------------------------------------------------------- + + logical, public :: use_nofire = .false. + logical, public :: use_lch4 = .false. + logical, public :: use_nitrif_denitrif = .false. + logical, public :: use_vertsoilc = .false. + logical, public :: use_extralakelayers = .false. + logical, public :: use_vichydro = .false. + logical, public :: use_century_decomp = .false. + logical, public :: use_cn = .false. + logical, public :: use_cndv = .false. + logical, public :: use_crop = .false. + logical, public :: use_ozone = .false. + logical, public :: use_snicar_frc = .false. + logical, public :: use_vancouver = .false. + logical, public :: use_mexicocity = .false. + logical, public :: use_noio = .false. + + !---------------------------------------------------------- + ! To retrieve namelist + !---------------------------------------------------------- + character(len=SHR_KIND_CL), public :: NLFilename_in ! Namelist filename + ! + logical, private :: clmvarctl_isset = .false. + !----------------------------------------------------------------------- + +contains + + !--------------------------------------------------------------------------- + subroutine clm_varctl_set( caseid_in, ctitle_in, brnch_retain_casename_in, & + single_column_in, scmlat_in, scmlon_in, nsrest_in, & + version_in, hostname_in, username_in) + ! + ! !DESCRIPTION: + ! Set input control variables. + ! + ! !ARGUMENTS: + character(len=256), optional, intent(IN) :: caseid_in ! case id + character(len=256), optional, intent(IN) :: ctitle_in ! case title + logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to remain the + ! same for branch run + logical, optional, intent(IN) :: single_column_in ! true => single column mode + real(r8), optional, intent(IN) :: scmlat_in ! single column lat + real(r8), optional, intent(IN) :: scmlon_in ! single column lon + integer, optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch + character(len=256), optional, intent(IN) :: version_in ! model version + character(len=256), optional, intent(IN) :: hostname_in ! hostname running on + character(len=256), optional, intent(IN) :: username_in ! username running job + !----------------------------------------------------------------------- + + if ( clmvarctl_isset )then + call shr_sys_abort(' ERROR:: control variables already set, cannot call this routine') + end if + + if ( present(caseid_in ) ) caseid = caseid_in + if ( present(ctitle_in ) ) ctitle = ctitle_in + if ( present(single_column_in) ) single_column = single_column_in + if ( present(scmlat_in ) ) scmlat = scmlat_in + if ( present(scmlon_in ) ) scmlon = scmlon_in + if ( present(nsrest_in ) ) nsrest = nsrest_in + if ( present(brnch_retain_casename_in) ) brnch_retain_casename = brnch_retain_casename_in + if ( present(version_in ) ) version = version_in + if ( present(username_in ) ) username = username_in + if ( present(hostname_in ) ) hostname = hostname_in + + end subroutine clm_varctl_set + + ! Set module carbon_only flag + subroutine cnallocate_carbon_only_set(carbon_only_in) + logical, intent(in) :: carbon_only_in + carbon_only = carbon_only_in + end subroutine cnallocate_carbon_only_set + + ! Get module carbon_only flag + logical function CNAllocate_Carbon_only() + cnallocate_carbon_only = carbon_only + end function CNAllocate_Carbon_only + +end module clm_varctl diff --git a/components/clm/src/main/clm_varpar.F90 b/components/clm/src/main/clm_varpar.F90 new file mode 100644 index 0000000000..2300c22522 --- /dev/null +++ b/components/clm/src/main/clm_varpar.F90 @@ -0,0 +1,186 @@ +module clm_varpar + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing CLM parameters + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varctl , only: use_extralakelayers, use_vertsoilc, use_crop + use clm_varctl , only: use_century_decomp, use_c13, use_c14 + use clm_varctl , only: iulog, create_crop_landunit, irrigate + use clm_varctl , only: use_vichydro + ! + ! !PUBLIC TYPES: + implicit none + save + ! + logical, public :: more_vertlayers = .false. ! true => run with more vertical soil layers + + ! Note - model resolution is read in from the surface dataset + + integer, parameter :: nlev_equalspace = 15 + integer, parameter :: toplev_equalspace = 6 + integer :: nlevsoi ! number of hydrologically active soil layers + integer :: nlevsoifl ! number of soil layers on input file + integer :: nlevgrnd ! number of ground layers + ! (includes lower layers that are hydrologically inactive) + integer :: nlevurb ! number of urban layers + integer :: nlevlak ! number of lake layers + integer :: nlevdecomp ! number of biogeochemically active soil layers + integer :: nlevdecomp_full ! number of biogeochemical layers + ! (includes lower layers that are biogeochemically inactive) + integer :: nlevsno = -1 ! maximum number of snow layers + integer, parameter :: ngases = 3 ! CH4, O2, & CO2 + integer, parameter :: nlevcan = 1 ! number of leaf layers in canopy layer + !ED variables + integer, parameter :: nlevcan_ed = 40 ! number of leaf layers in canopy layer + integer, parameter :: nclmax = 2 ! max number of canopy layers + integer, parameter :: numwat = 5 ! number of water types (soil, ice, 2 lakes, wetland) + integer, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir + integer, parameter :: ivis = 1 ! index for visible band + integer, parameter :: inir = 2 ! index for near-infrared band + integer, parameter :: numsolar = 2 ! number of solar type bands: direct, diffuse + integer, parameter :: ndst = 4 ! number of dust size classes (BGC only) + integer, parameter :: dst_src_nbr = 3 ! number of size distns in src soil (BGC only) + integer, parameter :: sz_nbr = 200 ! number of sub-grid bins in large bin of dust size distribution (BGC only) + integer, parameter :: mxpft = 78 ! maximum number of PFT's for any mode; + ! FIX(RF,032414) might we set some of these automatically from reading pft-physiology? + integer, parameter :: numveg = 16 ! number of veg types (without specific crop) + integer, parameter :: nlayer = 3 ! number of VIC soil layer --Added by AWang + integer :: nlayert ! number of VIC soil layer + 3 lower thermal layers + + integer :: numpft = mxpft ! actual # of pfts (without bare) + integer :: numcft = 64 ! actual # of crops + logical :: crop_prog = .true. ! If prognostic crops is turned on + integer :: maxpatch_urb= 5 ! max number of urban patches (columns) in urban landunit + + integer :: maxpatch_pft ! max number of plant functional types in naturally vegetated landunit (namelist setting) + + ! constants for decomposition cascade + + integer :: i_met_lit + integer :: i_cel_lit + integer :: i_lig_lit + integer :: i_cwd + + integer :: ndecomp_pools + integer :: ndecomp_cascade_transitions + + ! Indices used in surface file read and set in clm_varpar_init + + integer :: natpft_lb ! In PATCH arrays, lower bound of Patches on the natural veg landunit (i.e., bare ground index) + integer :: natpft_ub ! In PATCH arrays, upper bound of Patches on the natural veg landunit + integer :: natpft_size ! Number of Patches on natural veg landunit (including bare ground) + integer :: cft_lb ! In PATCH arrays, lower bound of Patches on the crop landunit + integer :: cft_ub ! In PATCH arrays, upper bound of Patches on the crop landunit + integer :: cft_size ! Number of Patches on crop landunit + + integer :: maxpatch_glcmec ! max number of elevation classes + integer :: max_patch_per_col + + real(r8) :: mach_eps ! machine epsilon + ! + ! !PUBLIC MEMBER FUNCTIONS: + public clm_varpar_init ! set parameters + ! + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine clm_varpar_init() + ! + ! !DESCRIPTION: + ! Initialize module variables + ! + ! !ARGUMENTS: + implicit none + ! + ! !LOCAL VARIABLES: + ! + character(len=32) :: subname = 'clm_varpar_init' ! subroutine name + !------------------------------------------------------------------------------ + + ! Crop settings and consistency checks + + if (use_crop) then + numpft = mxpft ! actual # of patches (without bare) + numcft = 64 ! actual # of crops + crop_prog = .true. ! If prognostic crops is turned on + else + numpft = numveg ! actual # of patches (without bare) + numcft = 2 ! actual # of crops + crop_prog = .false. ! If prognostic crops is turned on + end if + + ! For arrays containing all Patches (natural veg & crop), determine lower and upper bounds + ! for (1) Patches on the natural vegetation landunit (includes bare ground, and includes + ! crops if create_crop_landunit=false), and (2) CFTs on the crop landunit (no elements + ! if create_crop_landunit=false) + + if (create_crop_landunit) then + natpft_size = (numpft + 1) - numcft ! note that numpft doesn't include bare ground -- thus we add 1 + cft_size = numcft + else + natpft_size = numpft + 1 ! note that numpft doesn't include bare ground -- thus we add 1 + cft_size = 0 + end if + + natpft_lb = 0 + natpft_ub = natpft_lb + natpft_size - 1 + cft_lb = natpft_ub + 1 + cft_ub = cft_lb + cft_size - 1 + + max_patch_per_col= max(numpft+1, numcft, maxpatch_urb) + mach_eps = epsilon(1.0_r8) + + nlevsoifl = 10 + nlevurb = 5 + if ( .not. more_vertlayers )then + nlevsoi = nlevsoifl + nlevgrnd = 15 + else + nlevsoi = 8 + nlev_equalspace + nlevgrnd = 15 + nlev_equalspace + end if + + if (use_vichydro) then + nlayert = nlayer + (nlevgrnd -nlevsoi) + endif + + ! here is a switch to set the number of soil levels for the biogeochemistry calculations. + ! currently it works on either a single level or on nlevsoi and nlevgrnd levels + if (use_vertsoilc) then + nlevdecomp = nlevsoi + nlevdecomp_full = nlevgrnd + else + nlevdecomp = 1 + nlevdecomp_full = 1 + end if + + if (.not. use_extralakelayers) then + nlevlak = 10 ! number of lake layers + else + nlevlak = 25 ! number of lake layers (Yields better results for site simulations) + end if + + if (use_century_decomp) then + ndecomp_pools = 7 + ndecomp_cascade_transitions = 10 + i_met_lit = 1 + i_cel_lit = 2 + i_lig_lit = 3 + i_cwd = 4 + else + ndecomp_pools = 8 + ndecomp_cascade_transitions = 9 + i_met_lit = 1 + i_cel_lit = 2 + i_lig_lit = 3 + i_cwd = 4 + end if + + end subroutine clm_varpar_init + +end module clm_varpar diff --git a/components/clm/src/main/clm_varsur.F90 b/components/clm/src/main/clm_varsur.F90 new file mode 100644 index 0000000000..41e2618576 --- /dev/null +++ b/components/clm/src/main/clm_varsur.F90 @@ -0,0 +1,40 @@ +module clm_instur + + !----------------------------------------------------------------------- + ! Module containing 2-d surface boundary data information + ! surface boundary data, these are all "gdc" local + ! Note that some of these need to be pointers (as opposed to just allocatable arrays) to + ! match the ncd_io interface; for consistency, we make them all pointers + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! weight of each landunit on the grid cell + real(r8), pointer :: wt_lunit(:,:) + + ! whether we have valid urban data in each grid cell + logical , pointer :: urban_valid(:) + + ! for natural veg landunit, weight of each patch on the landunit (adds to 1.0 on the + ! landunit for all all grid cells, even! those without any natural pft) + ! (second dimension goes natpft_lb:natpft_ub) + real(r8), pointer :: wt_nat_patch(:,:) + + ! for crop landunit, weight of each cft on the landunit (adds to 1.0 on the + ! landunit for all all grid cells, even those without any crop) + ! (second dimension goes cft_lb:cft_ub) + real(r8), pointer :: wt_cft(:,:) + + ! for glc_mec landunits, weight of glacier in each elevation class (adds to 1.0 on the + ! landunit for all grid cells, even those without any glacier) + real(r8), pointer :: wt_glc_mec(:,:) + + ! subgrid glacier_mec sfc elevation + real(r8), pointer :: topo_glc_mec(:,:) + !----------------------------------------------------------------------- + +end module clm_instur diff --git a/components/clm/src/main/column_varcon.F90 b/components/clm/src/main/column_varcon.F90 new file mode 100644 index 0000000000..5407816813 --- /dev/null +++ b/components/clm/src/main/column_varcon.F90 @@ -0,0 +1,88 @@ +module column_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing landunit indices and associated variables and routines. + ! + ! !USES: +#include "shr_assert.h" + use shr_log_mod , only : errMsg => shr_log_errMsg + use landunit_varcon, only : isturb_MIN + ! + ! !PUBLIC TYPES: + implicit none + save + private + + !------------------------------------------------------------------ + ! Initialize column type constants + !------------------------------------------------------------------ + + ! urban column types + + integer, parameter, public :: icol_roof = isturb_MIN*10 + 1 + integer, parameter, public :: icol_sunwall = isturb_MIN*10 + 2 + integer, parameter, public :: icol_shadewall = isturb_MIN*10 + 3 + integer, parameter, public :: icol_road_imperv = isturb_MIN*10 + 4 + integer, parameter, public :: icol_road_perv = isturb_MIN*10 + 5 + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: icemec_class_to_col_itype ! convert an icemec class (1..maxpatch_glcmec) into col%itype + public :: col_itype_to_icemec_class ! convert col%itype into an icemec class (1..maxpatch_glcmec) + +contains + + !----------------------------------------------------------------------- + function icemec_class_to_col_itype(icemec_class) result(col_itype) + ! + ! !DESCRIPTION: + ! Convert an icemec class (1..maxpatch_glcmec) into col%itype + ! + ! !USES: + use clm_varpar, only : maxpatch_glcmec + use landunit_varcon, only : istice_mec + ! + ! !ARGUMENTS: + integer :: col_itype ! function result + integer, intent(in) :: icemec_class ! icemec class, between 1 and maxpatch_glcmec + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'icemec_class_to_col_itype' + !----------------------------------------------------------------------- + + SHR_ASSERT((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), errMsg(__FILE__, __LINE__)) + + col_itype = istice_mec*100 + icemec_class + + end function icemec_class_to_col_itype + + !----------------------------------------------------------------------- + function col_itype_to_icemec_class(col_itype) result(icemec_class) + ! + ! !DESCRIPTION: + ! Convert a col%itype value (for an icemec landunit) into an icemec class (1..maxpatch_glcmec) + ! + ! !USES: + use clm_varpar, only : maxpatch_glcmec + use landunit_varcon, only : istice_mec + ! + ! !ARGUMENTS: + integer :: icemec_class ! function result + integer, intent(in) :: col_itype ! col%itype value for an icemec landunit + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'col_itype_to_icemec_class' + !----------------------------------------------------------------------- + + icemec_class = col_itype - istice_mec*100 + + ! The following assertion is here to ensure that col_itype is really from an + ! istice_mec landunit + SHR_ASSERT((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), errMsg(__FILE__, __LINE__)) + + end function col_itype_to_icemec_class + +end module column_varcon diff --git a/components/clm/src/main/controlMod.F90 b/components/clm/src/main/controlMod.F90 new file mode 100644 index 0000000000..3d64eb8808 --- /dev/null +++ b/components/clm/src/main/controlMod.F90 @@ -0,0 +1,850 @@ +module controlMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module which initializes run control variables. The following possible + ! namelist variables are set default values and possibly read in on startup + ! + ! Note: For definitions of namelist variables see + ! ../../bld/namelist_files/namelist_definition.xml + ! Display the file in a browser to see it neatly formatted in html. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8, SHR_KIND_CL + use shr_nl_mod , only: shr_nl_find_group_name + use shr_const_mod , only: SHR_CONST_CDAY + use shr_log_mod , only: errMsg => shr_log_errMsg + use abortutils , only: endrun + use spmdMod , only: masterproc + use decompMod , only: clump_pproc + use clm_varcon , only: h2osno_max + use clm_varpar , only: maxpatch_pft, maxpatch_glcmec, more_vertlayers, numrad, nlevsno + use histFileMod , only: max_tapes, max_namlen + use histFileMod , only: hist_empty_htapes, hist_dov2xy, hist_avgflag_pertape, hist_type1d_pertape + use histFileMod , only: hist_nhtfrq, hist_ndens, hist_mfilt, hist_fincl1, hist_fincl2, hist_fincl3 + use histFileMod , only: hist_fincl4, hist_fincl5, hist_fincl6, hist_fexcl1, hist_fexcl2, hist_fexcl3 + use histFileMod , only: hist_fexcl4, hist_fexcl5, hist_fexcl6 + use LakeCon , only: deepmixing_depthcrit, deepmixing_mixfact + use CanopyfluxesMod , only: perchroot, perchroot_alt + use CanopyHydrologyMod , only: CanopyHydrology_readnl + use SurfaceAlbedoMod , only: albice, lake_melt_icealb + use UrbanParamsType , only: UrbanReadNML + use HumanIndexMod , only: HumanIndexReadNML + use CNSharedParamsMod , only: anoxia_wtsat + use C14BombSpikeMod , only: use_c14_bombspike, atm_c14_filename + use SoilBiogeochemCompetitionMod , only: suplnitro, suplnNon + use SoilBiogeochemLittVertTranspMod , only: som_adv_flux, max_depth_cryoturb + use SoilBiogeochemVerticalProfileMod , only: exponential_rooting_profile, rootprof_exp, surfprof_exp, pftspecific_rootingprofile + use SoilBiogeochemNitrifDenitrifMod , only: no_frozen_nitrif_denitrif + use clm_varctl + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: control_setNL ! Set namelist filename + public :: control_init ! initial run control information + public :: control_print ! print run control information + ! + ! + ! !PRIVATE TYPES: + character(len= 7) :: runtyp(4) ! run type + character(len=SHR_KIND_CL) :: NLFilename = 'lnd.stdin' ! Namelist filename + +#if (defined _OPENMP) + integer, external :: omp_get_max_threads ! max number of threads that can execute concurrently in a single parallel region +#endif + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine control_setNL( NLfile ) + ! + ! !DESCRIPTION: + ! Set the namelist filename to use + ! + ! !ARGUMENTS: + character(len=*), intent(IN) :: NLFile ! Namelist filename + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'control_setNL' ! subroutine name + logical :: lexist ! File exists + !------------------------------------------------------------------------ + + ! Error checking... + if ( len_trim(NLFile) == 0 )then + call endrun(msg=' error: nlfilename entered is not set'//errMsg(__FILE__, __LINE__)) + end if + inquire (file = trim(NLFile), exist = lexist) + if ( .not. lexist )then + call endrun(msg=' error: NLfilename entered does NOT exist:'//& + trim(NLFile)//errMsg(__FILE__, __LINE__)) + end if + if ( len_trim(NLFile) > len(NLFilename) )then + call endrun(msg=' error: entered NLFile is too long'//errMsg(__FILE__, __LINE__)) + end if + ! Set the filename + NLFilename = NLFile + NLFilename_in = NLFilename ! For use in external namelists and to avoid creating dependencies on controlMod + end subroutine control_setNL + + !------------------------------------------------------------------------ + subroutine control_init( ) + ! + ! !DESCRIPTION: + ! Initialize CLM run control information + ! + ! !USES: + use clm_time_manager , only : set_timemgr_init + use fileutils , only : getavu, relavu + ! + ! !LOCAL VARIABLES: + integer :: i ! loop indices + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + integer :: dtime ! Integer time-step + integer :: override_nsrest ! If want to override the startup type sent from driver + !------------------------------------------------------------------------ + + ! ---------------------------------------------------------------------- + ! Namelist Variables + ! ---------------------------------------------------------------------- + + ! Time step + namelist / clm_inparm/ & + dtime + + ! CLM namelist settings + + namelist /clm_inparm / & + fatmlndfrc, finidat, nrevsn, & + finidat_interp_source, finidat_interp_dest + + ! Input datasets + + namelist /clm_inparm/ & + fsurdat, fatmtopo, flndtopo, & + paramfile, fsnowoptics, fsnowaging + + ! History, restart options + + namelist /clm_inparm/ & + hist_empty_htapes, hist_dov2xy, & + hist_avgflag_pertape, hist_type1d_pertape, & + hist_nhtfrq, hist_ndens, hist_mfilt, & + hist_fincl1, hist_fincl2, hist_fincl3, & + hist_fincl4, hist_fincl5, hist_fincl6, & + hist_fexcl1, hist_fexcl2, hist_fexcl3, & + hist_fexcl4, hist_fexcl5, hist_fexcl6 + namelist /clm_inparm/ hist_wrtch4diag + + ! BGC info + + namelist /clm_inparm/ & + suplnitro + namelist /clm_inparm/ & + nfix_timeconst + namelist /clm_inparm/ & + spinup_state, override_bgc_restart_mismatch_dump + + namelist /clm_inparm / & + co2_type + + namelist /clm_inparm / & + perchroot, perchroot_alt + + namelist /clm_inparm / & + anoxia, anoxia_wtsat + + namelist /clm_inparm / & + deepmixing_depthcrit, deepmixing_mixfact, lake_melt_icealb + ! lake_melt_icealb is of dimension numrad + + ! Glacier_mec info + namelist /clm_inparm/ & + maxpatch_glcmec, glc_smb, glc_do_dynglacier, & + glcmec_downscale_longwave, glc_snow_persistence_max_days, fglcmask, & + nlevsno, h2osno_max + + ! Other options + + namelist /clm_inparm/ & + clump_pproc, wrtdia, & + create_crop_landunit, nsegspc, co2_ppmv, override_nsrest, & + albice, more_vertlayers, subgridflag, irrigate, all_active, & + repartition_rain_snow + + ! vertical soil mixing variables + namelist /clm_inparm/ & + som_adv_flux, max_depth_cryoturb + + ! C and N input vertical profiles + namelist /clm_inparm/ & + exponential_rooting_profile, rootprof_exp, surfprof_exp, pftspecific_rootingprofile + + namelist /clm_inparm / no_frozen_nitrif_denitrif + + namelist /clm_inparm / use_c13, use_c14 + + namelist /clm_inparm / use_ed, use_ed_spit_fire + + ! CLM 5.0 nitrogen flags + namelist /clm_inparm/ use_flexibleCN, use_luna + + namelist /clm_nitrogen/ MM_Nuptake_opt, dynamic_plant_alloc_opt, downreg_opt, & + plant_ndemand_opt, substrate_term_opt, nscalar_opt, temp_scalar_opt, & + CNratio_floating, lnc_opt, reduce_dayl_factor, vcmax_opt, CN_residual_opt, & + CN_partition_opt, carbon_excess_opt, carbon_storage_excess_opt, & + CN_evergreen_phenology_opt + + namelist /clm_inparm / use_lai_streams + + namelist /clm_inparm/ & + use_c14_bombspike, atm_c14_filename + + ! All old cpp-ifdefs are below and have been converted to namelist variables + + ! max number of plant functional types in naturally vegetated landunit + namelist /clm_inparm/ maxpatch_pft + + namelist /clm_inparm/ & + use_nofire, use_lch4, use_nitrif_denitrif, use_vertsoilc, use_extralakelayers, & + use_vichydro, use_century_decomp, use_cn, use_cndv, use_crop, use_ozone, & + use_snicar_frc, use_vancouver, use_mexicocity, use_noio + + + ! ---------------------------------------------------------------------- + ! Default values + ! ---------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to initialize run control settings .....' + endif + + runtyp(:) = 'missing' + runtyp(nsrStartup + 1) = 'initial' + runtyp(nsrContinue + 1) = 'restart' + runtyp(nsrBranch + 1) = 'branch ' + + ! Set clumps per procoessor + +#if (defined _OPENMP) + clump_pproc = omp_get_max_threads() +#else + clump_pproc = 1 +#endif + + override_nsrest = nsrest + + if (masterproc) then + + ! ---------------------------------------------------------------------- + ! Read namelist from standard input. + ! ---------------------------------------------------------------------- + + if ( len_trim(NLFilename) == 0 )then + call endrun(msg=' error: nlfilename not set'//errMsg(__FILE__, __LINE__)) + end if + unitn = getavu() + write(iulog,*) 'Read in clm_inparm namelist from: ', trim(NLFilename) + open( unitn, file=trim(NLFilename), status='old' ) + call shr_nl_find_group_name(unitn, 'clm_inparm', status=ierr) + if (ierr == 0) then + read(unitn, clm_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='ERROR reading clm_inparm namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + call shr_nl_find_group_name(unitn, 'clm_nitrogen', status=ierr) + if (ierr == 0) then + read(unitn, clm_nitrogen, iostat=ierr) + if (ierr /= 0) then + call endrun(msg='ERROR reading clm_nitrogen namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + ! ---------------------------------------------------------------------- + ! Consistency checks on input namelist. + ! ---------------------------------------------------------------------- + + call set_timemgr_init( dtime_in=dtime ) + + ! History and restart files + + do i = 1, max_tapes + if (hist_nhtfrq(i) == 0) then + hist_mfilt(i) = 1 + else if (hist_nhtfrq(i) < 0) then + hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime)) + endif + end do + + ! Override start-type (can only override to branch (3) and only + ! if the driver is a startup type + if ( override_nsrest /= nsrest )then + if ( override_nsrest /= nsrBranch .and. nsrest /= nsrStartup )then + call endrun(msg= ' ERROR: can ONLY override clm start-type ' // & + 'to branch type and ONLY if driver is a startup type'// & + errMsg(__FILE__, __LINE__)) + end if + call clm_varctl_set( nsrest_in=override_nsrest ) + end if + + if (maxpatch_glcmec > 0) then + create_glacier_mec_landunit = .true. + else + create_glacier_mec_landunit = .false. + end if + + if (use_crop .and. (use_c13 .or. use_c14)) then + call endrun(msg=' ERROR:: CROP and C13/C14 can NOT be on at the same time'//& + errMsg(__FILE__, __LINE__)) + end if + + if (use_crop .and. .not. create_crop_landunit) then + call endrun(msg=' ERROR: prognostic crop Patches require create_crop_landunit=.true.'//& + errMsg(__FILE__, __LINE__)) + end if + + if (.not. use_crop .and. irrigate) then + call endrun(msg=' ERROR: irrigate = .true. requires CROP model active.'//& + errMsg(__FILE__, __LINE__)) + end if + + if (use_lch4 .and. use_vertsoilc) then + anoxia = .true. + else + anoxia = .false. + end if + + ! ---------------------------------------------------------------------- + !TURN OFF MEGAN VOCs if crop prognostic is on + ! This is a temporary place holder and should be removed once MEGAN VOCs and + ! crop ar compatible + if (use_crop) then + use_voc = .false. + end if + + ! ---------------------------------------------------------------------- + ! ABORT if use_cn AND use_ed are both true + if (use_ed .and. use_cn) then + call endrun(msg=' ERROR: use_cn and use_ed cannot both be set to true.'//& + errMsg(__FILE__, __LINE__)) + end if + + ! If nfix_timeconst is equal to the junk default value, then it was not specified + ! by the user namelist and we need to assign it the correct default value. If the + ! user specified it in the namelist, we leave it alone. + + if (nfix_timeconst == -1.2345_r8) then + if (use_nitrif_denitrif) then + nfix_timeconst = 10._r8 + else + nfix_timeconst = 0._r8 + end if + end if + + ! If nlevsno, h2osno_max are equal to their junk default value, then they were not specified + ! by the user namelist and we generate an error message. Also check nlevsno for bounds. + if (nlevsno < 3 .or. nlevsno > 12) then + write(iulog,*)'ERROR: nlevsno = ',nlevsno,' is not supported, must be in range 3-12.' + call endrun(msg=' ERROR: invalid value for nlevsno in CLM namelist. '//& + errMsg(__FILE__, __LINE__)) + endif + if (h2osno_max <= 0.0_r8) then + write(iulog,*)'ERROR: h2osno_max = ',h2osno_max,' is not supported, must be greater than 0.0.' + call endrun(msg=' ERROR: invalid value for h2osno_max in CLM namelist. '//& + errMsg(__FILE__, __LINE__)) + endif + + endif ! end of if-masterproc if-block + + ! ---------------------------------------------------------------------- + ! Read in other namelists for other modules + ! ---------------------------------------------------------------------- + !I call init_hydrology to set up default hydrology sub-module methods. + !For future version, I suggest to put the following two calls inside their + !own modules, which are called from their own initializing methods + call init_hydrology( NLFilename ) + + call CanopyHydrology_readnl ( NLFilename ) + call UrbanReadNML ( NLFilename ) + call HumanIndexReadNML ( NLFilename ) + + ! ---------------------------------------------------------------------- + ! Broadcast all control information if appropriate + ! ---------------------------------------------------------------------- + + call control_spmd() + + ! ---------------------------------------------------------------------- + ! consistency checks + ! ---------------------------------------------------------------------- + + ! Consistency settings for co2 type + if (co2_type /= 'constant' .and. co2_type /= 'prognostic' .and. co2_type /= 'diagnostic') then + write(iulog,*)'co2_type = ',co2_type,' is not supported' + call endrun(msg=' ERROR:: choices are constant, prognostic or diagnostic'//& + errMsg(__FILE__, __LINE__)) + end if + + ! Check on run type + if (nsrest == iundef) then + call endrun(msg=' ERROR:: must set nsrest'//& + errMsg(__FILE__, __LINE__)) + end if + if (nsrest == nsrBranch .and. nrevsn == ' ') then + call endrun(msg=' ERROR: need to set restart data file name'//& + errMsg(__FILE__, __LINE__)) + end if + + ! Consistency settings for co2_ppvm + if ( (co2_ppmv <= 0.0_r8) .or. (co2_ppmv > 3000.0_r8) ) then + call endrun(msg=' ERROR: co2_ppmv is out of a reasonable range'//& + errMsg(__FILE__, __LINE__)) + end if + + ! Consistency settings for nrevsn + + if (nsrest == nsrStartup ) nrevsn = ' ' + if (nsrest == nsrContinue) nrevsn = 'set by restart pointer file file' + if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then + call endrun(msg=' ERROR: nsrest NOT set to a valid value'//& + errMsg(__FILE__, __LINE__)) + end if + + ! Single Column + if ( single_column .and. (scmlat == rundef .or. scmlon == rundef ) ) then + call endrun(msg=' ERROR:: single column mode on -- but scmlat and scmlon are NOT set'//& + errMsg(__FILE__, __LINE__)) + if (.not. use_lch4 .and. anoxia) then + call endrun(msg='ERROR:: anoxia is turned on, but this currently requires turning on the CH4 submodel'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + if (masterproc) then + write(iulog,*) 'Successfully initialized run control settings' + write(iulog,*) + endif + + end subroutine control_init + + !------------------------------------------------------------------------ + subroutine control_spmd() + ! + ! !DESCRIPTION: + ! Distribute namelist data all processors. All program i/o is + ! funnelled through the master processor. Processor 0 either + ! reads restart/history data from the disk and distributes + ! it to all processors, or collects data from + ! all processors and writes it to disk. + ! + ! !USES: + use spmdMod, only : mpicom, MPI_CHARACTER, MPI_INTEGER, MPI_LOGICAL, MPI_REAL8 + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer ier !error code + !----------------------------------------------------------------------- + + ! run control variables + call mpi_bcast (caseid, len(caseid), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (ctitle, len(ctitle), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (version, len(version), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hostname, len(hostname), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (username, len(username), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (nsrest, 1, MPI_INTEGER, 0, mpicom, ier) + + call mpi_bcast (use_nofire, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_lch4, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_nitrif_denitrif, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_vertsoilc, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_extralakelayers, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_vichydro, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_century_decomp, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_cn, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_cndv, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_crop, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_voc, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_ozone, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_snicar_frc, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_vancouver, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_mexicocity, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_noio, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! initial file variables + call mpi_bcast (nrevsn, len(nrevsn), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (finidat, len(finidat), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (finidat_interp_source, len(finidat_interp_source), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (finidat_interp_dest, len(finidat_interp_dest), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsurdat, len(fsurdat), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fatmtopo, len(fatmtopo) ,MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (flndtopo, len(flndtopo) ,MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) + + ! Irrigation + call mpi_bcast(irrigate, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! Landunit generation + call mpi_bcast(create_crop_landunit, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! Other subgrid logic + call mpi_bcast(all_active, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! max number of plant functional types in naturally vegetated landunit + call mpi_bcast(maxpatch_pft, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! BGC + call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier) + if (use_cn) then + call mpi_bcast (suplnitro, len(suplnitro), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (nfix_timeconst, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (spinup_state, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (override_bgc_restart_mismatch_dump, 1, MPI_LOGICAL, 0, mpicom, ier) + end if + + ! isotopes + call mpi_bcast (use_c13, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_c14, 1, MPI_LOGICAL, 0, mpicom, ier) + + call mpi_bcast (use_ed, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_ed_spit_fire, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! flexibleCN nitrogen model + call mpi_bcast (use_flexibleCN, 1, MPI_LOGICAL, 0, mpicom, ier) + ! TODO(bja, 2015-08) need to move some of these into a module with limited scope. + call mpi_bcast (MM_Nuptake_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (dynamic_plant_alloc_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (downreg_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (plant_ndemand_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (substrate_term_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (nscalar_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (temp_scalar_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (CNratio_floating, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (lnc_opt, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (reduce_dayl_factor, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (vcmax_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (CN_residual_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (CN_partition_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (carbon_excess_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (carbon_storage_excess_opt, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (CN_evergreen_phenology_opt, 1, MPI_INTEGER, 0, mpicom, ier) + + call mpi_bcast (use_luna, 1, MPI_LOGICAL, 0, mpicom, ier) + + call mpi_bcast (use_lai_streams, 1, MPI_LOGICAL, 0, mpicom, ier) + + if (use_cn .and. use_vertsoilc) then + ! vertical soil mixing variables + call mpi_bcast (som_adv_flux, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (max_depth_cryoturb, 1, MPI_REAL8, 0, mpicom, ier) + + ! C and N input vertical profiles + call mpi_bcast (exponential_rooting_profile, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (rootprof_exp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (surfprof_exp, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (pftspecific_rootingprofile, 1, MPI_LOGICAL, 0, mpicom, ier) + end if + + if (use_cn .and. use_nitrif_denitrif) then + call mpi_bcast (no_frozen_nitrif_denitrif, 1, MPI_LOGICAL, 0, mpicom, ier) + end if + + if (use_cn) then + call mpi_bcast (use_c14_bombspike, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (atm_c14_filename, len(atm_c14_filename), MPI_CHARACTER, 0, mpicom, ier) + end if + + call mpi_bcast (perchroot, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (perchroot_alt, 1, MPI_LOGICAL, 0, mpicom, ier) + if (use_lch4) then + call mpi_bcast (anoxia, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (anoxia_wtsat, 1, MPI_LOGICAL, 0, mpicom, ier) + end if + + ! lakes + call mpi_bcast (deepmixing_depthcrit, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (deepmixing_mixfact, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (lake_melt_icealb, numrad, MPI_REAL8, 0, mpicom, ier) + + ! physics variables + call mpi_bcast (nsegspc, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (subgridflag , 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (repartition_rain_snow, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (wrtdia, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (scmlat, 1, MPI_REAL8,0, mpicom, ier) + call mpi_bcast (scmlon, 1, MPI_REAL8,0, mpicom, ier) + call mpi_bcast (co2_ppmv, 1, MPI_REAL8,0, mpicom, ier) + call mpi_bcast (albice, 2, MPI_REAL8,0, mpicom, ier) + call mpi_bcast (more_vertlayers,1, MPI_LOGICAL, 0, mpicom, ier) + + ! snow pack variables + call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (h2osno_max, 1, MPI_REAL8, 0, mpicom, ier) + + ! glacier_mec variables + call mpi_bcast (create_glacier_mec_landunit, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (maxpatch_glcmec, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (glc_smb, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (glc_do_dynglacier, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (glcmec_downscale_longwave, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (glc_snow_persistence_max_days, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (fglcmask, len(fglcmask), MPI_CHARACTER, 0, mpicom, ier) + + ! history file variables + call mpi_bcast (hist_empty_htapes, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (hist_dov2xy, size(hist_dov2xy), MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (hist_nhtfrq, size(hist_nhtfrq), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_mfilt, size(hist_mfilt), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_ndens, size(hist_ndens), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_avgflag_pertape, size(hist_avgflag_pertape), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_type1d_pertape, max_namlen*size(hist_type1d_pertape), MPI_CHARACTER, 0, mpicom, ier) + if (use_lch4) then + call mpi_bcast (hist_wrtch4diag, 1, MPI_LOGICAL, 0, mpicom, ier) + end if + call mpi_bcast (hist_fexcl1, max_namlen*size(hist_fexcl1), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl2, max_namlen*size(hist_fexcl2), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl3, max_namlen*size(hist_fexcl3), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl4, max_namlen*size(hist_fexcl4), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl5, max_namlen*size(hist_fexcl5), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl6, max_namlen*size(hist_fexcl6), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl1, (max_namlen+2)*size(hist_fincl1), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl2, (max_namlen+2)*size(hist_fincl2), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl3, (max_namlen+2)*size(hist_fincl3), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl4, (max_namlen+2)*size(hist_fincl4), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl5, (max_namlen+2)*size(hist_fincl5), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl6, (max_namlen+2)*size(hist_fincl6), MPI_CHARACTER, 0, mpicom, ier) + + ! restart file variables + + call mpi_bcast (rpntfil, len(rpntfil), MPI_CHARACTER, 0, mpicom, ier) + + ! clump decomposition variables + + call mpi_bcast (clump_pproc, 1, MPI_INTEGER, 0, mpicom, ier) + + end subroutine control_spmd + + !------------------------------------------------------------------------ + subroutine control_print () + ! + ! !DESCRIPTION: + ! Write out the clm namelist run control variables + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer i !loop index + !------------------------------------------------------------------------ + + write(iulog,*) 'define run:' + write(iulog,*) ' source = ',trim(source) + write(iulog,*) ' model_version = ',trim(version) + write(iulog,*) ' run type = ',runtyp(nsrest+1) + write(iulog,*) ' case title = ',trim(ctitle) + write(iulog,*) ' username = ',trim(username) + write(iulog,*) ' hostname = ',trim(hostname) + write(iulog,*) 'process control parameters:' + write(iulog,*) ' use_nofire = ', use_nofire + write(iulog,*) ' use_lch4 = ', use_lch4 + write(iulog,*) ' use_nitrif_denitrif = ', use_nitrif_denitrif + write(iulog,*) ' use_vertsoilc = ', use_vertsoilc + write(iulog,*) ' use_extralakelayers = ', use_extralakelayers + write(iulog,*) ' use_vichydro = ', use_vichydro + write(iulog,*) ' use_century_decomp = ', use_century_decomp + write(iulog,*) ' use_cn = ', use_cn + write(iulog,*) ' use_cndv = ', use_cndv + write(iulog,*) ' use_crop = ', use_crop + write(iulog,*) ' use_ozone = ', use_ozone + write(iulog,*) ' use_snicar_frc = ', use_snicar_frc + write(iulog,*) ' use_vancouver = ', use_vancouver + write(iulog,*) ' use_mexicocity = ', use_mexicocity + write(iulog,*) ' use_noio = ', use_noio + + write(iulog,*) 'input data files:' + write(iulog,*) ' PFT physiology and parameters file = ',trim(paramfile) + if (fsurdat == ' ') then + write(iulog,*) ' fsurdat, surface dataset not set' + else + write(iulog,*) ' surface data = ',trim(fsurdat) + end if + if (fatmlndfrc == ' ') then + write(iulog,*) ' fatmlndfrc not set, setting frac/mask to 1' + else + write(iulog,*) ' land frac data = ',trim(fatmlndfrc) + end if + if (flndtopo == ' ') then + write(iulog,*) ' flndtopo not set' + else + write(iulog,*) ' land topographic data = ',trim(flndtopo) + end if + if (fatmtopo == ' ') then + write(iulog,*) ' fatmtopo not set' + else + write(iulog,*) ' atm topographic data = ',trim(fatmtopo) + end if + if (use_cn) then + if (suplnitro /= suplnNon)then + write(iulog,*) ' Supplemental Nitrogen mode is set to run over Patches: ', & + trim(suplnitro) + end if + + if (nfix_timeconst /= 0._r8) then + write(iulog,*) ' nfix_timeconst, timescale for smoothing npp in N fixation term: ', nfix_timeconst + else + write(iulog,*) ' nfix_timeconst == zero, use standard N fixation scheme. ' + end if + + write(iulog,*) ' spinup_state, (0 = normal mode; 1 = AD spinup) : ', spinup_state + if ( spinup_state .eq. 0 ) then + write(iulog,*) ' model is currently NOT in AD spinup mode.' + else if ( spinup_state .eq. 1 ) then + write(iulog,*) ' model is currently in AD spinup mode.' + else + call endrun(msg=' error: spinup_state can only have integer value of 0 or 1'//& + errMsg(__FILE__, __LINE__)) + end if + + write(iulog,*) ' override_bgc_restart_mismatch_dump : ', override_bgc_restart_mismatch_dump + end if + + if (use_cn .and. use_vertsoilc) then + write(iulog, *) ' som_adv_flux, the advection term in soil mixing (m/s) : ', som_adv_flux + write(iulog, *) ' max_depth_cryoturb (m) : ', max_depth_cryoturb + + write(iulog, *) ' exponential_rooting_profile : ', exponential_rooting_profile + write(iulog, *) ' rootprof_exp : ', rootprof_exp + write(iulog, *) ' surfprof_exp : ', surfprof_exp + write(iulog, *) ' pftspecific_rootingprofile : ', pftspecific_rootingprofile + end if + + if (use_cn .and. .not. use_nitrif_denitrif) then + write(iulog, *) ' no_frozen_nitrif_denitrif : ', no_frozen_nitrif_denitrif + end if + + if (use_cn) then + write(iulog, *) ' use_c13 : ', use_c13 + write(iulog, *) ' use_c14 : ', use_c14 + write(iulog, *) ' use_c14_bombspike : ', use_c14_bombspike + write(iulog, *) ' atm_c14_filename : ', atm_c14_filename + end if + + if (fsnowoptics == ' ') then + write(iulog,*) ' snow optical properties file NOT set' + else + write(iulog,*) ' snow optical properties file = ',trim(fsnowoptics) + endif + if (fsnowaging == ' ') then + write(iulog,*) ' snow aging parameters file NOT set' + else + write(iulog,*) ' snow aging parameters file = ',trim(fsnowaging) + endif + + write(iulog,*) ' Number of snow layers =', nlevsno + write(iulog,*) ' Max snow depth (mm) =', h2osno_max + if (repartition_rain_snow) then + write(iulog,*) 'Rain vs. snow will be repartitioned based on surface temperature' + else + write(iulog,*) 'Rain vs. snow will NOT be repartitioned based on surface temperature' + end if + + if (create_glacier_mec_landunit) then + write(iulog,*) ' glc number of elevation classes =', maxpatch_glcmec + write(iulog,*) ' glc glacier mask file = ',trim(fglcmask) + if (glcmec_downscale_longwave) then + write(iulog,*) ' Longwave radiation will be downscaled' + else + write(iulog,*) ' Longwave radiation will NOT be downscaled' + endif + if (glc_do_dynglacier) then + write(iulog,*) ' glc CLM glacier areas and topography WILL evolve dynamically' + else + write(iulog,*) ' glc CLM glacier areas and topography will NOT evolve dynamically' + end if + if (glc_smb) then + write(iulog,*) ' glc surface mass balance will be passed to ice sheet model' + else + write(iulog,*) ' glc positive-degree-day info will be passed to ice sheet model' + endif + write(iulog,*) ' glc snow persistence max days = ', glc_snow_persistence_max_days + endif + + if (nsrest == nsrStartup .and. finidat == ' ') write(iulog,*) ' initial data created by model' + if (nsrest == nsrStartup .and. finidat /= ' ') write(iulog,*) ' initial data = ',trim(finidat) + if (nsrest /= nsrStartup) write(iulog,*) ' restart data = ',trim(nrevsn) + write(iulog,*) ' atmospheric forcing data is from cesm atm model' + write(iulog,*) 'Restart parameters:' + write(iulog,*)' restart pointer file directory = ',trim(rpntdir) + write(iulog,*)' restart pointer file name = ',trim(rpntfil) + write(iulog,*) 'model physics parameters:' + + if ( trim(co2_type) == 'constant' )then + write(iulog,*) ' CO2 volume mixing ratio (umol/mol) = ', co2_ppmv + else + write(iulog,*) ' CO2 volume mixing ratio = ', co2_type + end if + + write(iulog,*) ' land-ice albedos (unitless 0-1) = ', albice + write(iulog,*) ' more vertical layers = ', more_vertlayers + if (nsrest == nsrContinue) then + write(iulog,*) 'restart warning:' + write(iulog,*) ' Namelist not checked for agreement with initial run.' + write(iulog,*) ' Namelist should not differ except for ending time step and run type' + end if + if (nsrest == nsrBranch) then + write(iulog,*) 'branch warning:' + write(iulog,*) ' Namelist not checked for agreement with initial run.' + write(iulog,*) ' Surface data set and reference date should not differ from initial run' + end if + write(iulog,*) ' maxpatch_pft = ',maxpatch_pft + write(iulog,*) ' nsegspc = ',nsegspc + ! New fields + write(iulog,*) ' perchroot (plant water stress based on unfrozen layers only) = ',perchroot + write(iulog,*) ' perchroot (plant water stress based on time-integrated active layer only) = ',perchroot + if (use_lch4) then + write(iulog,*) ' anoxia (applied to soil decomposition) = ',anoxia + write(iulog,*) ' anoxia_wtsat (weight anoxia by inundated fraction) = ',anoxia_wtsat + end if + ! Lakes + write(iulog,*) + write(iulog,*) 'Lake Model Namelists:' + write(iulog,*) 'Increased mixing relative to Hostetler wind-driven eddy expression ',& + 'will be used for deep lakes exceeding depth ', deepmixing_depthcrit,& + ' by a factor of ', deepmixing_mixfact, '.' + write(iulog,*) 'Albedo over melting lakes will approach values (visible, NIR):', lake_melt_icealb, & + 'as compared with 0.60, 0.40 for cold frozen lakes with no snow.' + + write(iulog, *) 'plant nitrogen model namelists:' + write(iulog, *) ' use_flexibleCN = ', use_flexibleCN + if (use_flexibleCN) then + write(iulog, *) ' MM_Nuptake_opt = ', MM_Nuptake_opt + write(iulog, *) ' dynamic_plant_alloc_opt = ', dynamic_plant_alloc_opt + write(iulog, *) ' downreg_opt = ', downreg_opt + write(iulog, *) ' plant_ndemand_opt = ', plant_ndemand_opt + write(iulog, *) ' substrate_term_opt = ', substrate_term_opt + write(iulog, *) ' nscalar_opt = ', nscalar_opt + write(iulog, *) ' temp_scalar_opt = ', temp_scalar_opt + write(iulog, *) ' CNratio_floating = ', CNratio_floating + write(iulog, *) ' lnc_opt = ', lnc_opt + write(iulog, *) ' reduce_dayl_factor = ', reduce_dayl_factor + write(iulog, *) ' vcmax_opt = ', vcmax_opt + write(iulog, *) ' CN_residual_opt = ', CN_residual_opt + write(iulog, *) ' CN_partition_opt = ', CN_partition_opt + write(iulog, *) ' carbon_excess_opt = ', carbon_excess_opt + write(iulog, *) ' carbon_storage_excess_opt = ', carbon_storage_excess_opt + write(iulog, *) ' CN_evergreen_phenology_opt = ', CN_evergreen_phenology_opt + end if + write(iulog, *) ' use_luna = ', use_luna + end subroutine control_print + +end module controlMod diff --git a/components/clm/src/main/decompInitMod.F90 b/components/clm/src/main/decompInitMod.F90 new file mode 100644 index 0000000000..a21c7af598 --- /dev/null +++ b/components/clm/src/main/decompInitMod.F90 @@ -0,0 +1,893 @@ +module decompInitMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Module provides a descomposition into a clumped data structure which can + ! be mapped back to atmosphere physics chunks. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, iam, npes, mpicom, comp_id + use abortutils , only : endrun + use clm_varctl , only : iulog, use_ed + use clm_varcon , only : grlnd + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use EDVecCohortType , only : ed_vec_cohort + use decompMod + use mct_mod + ! + ! !PUBLIC TYPES: + implicit none + ! + ! !PUBLIC MEMBER FUNCTIONS: + public decompInit_lnd ! initializes lnd grid decomposition into clumps and processors + public decompInit_clumps ! initializes atm grid decomposition into clumps + public decompInit_glcp ! initializes g,l,c,p decomp info + ! + ! !PRIVATE TYPES: + private + integer, pointer :: lcid(:) ! temporary for setting ldecomp + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine decompInit_lnd(lni,lnj,amask) + ! + ! !DESCRIPTION: + ! This subroutine initializes the land surface decomposition into a clump + ! data structure. This assumes each pe has the same number of clumps + ! set by clump_pproc + ! + ! !USES: + use clm_varctl, only : nsegspc + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: amask(:) + integer , intent(in) :: lni,lnj ! domain global size + ! + ! !LOCAL VARIABLES: + integer :: lns ! global domain size + integer :: ln,lj ! indices + integer :: ag,an,ai,aj ! indices + integer :: numg ! number of land gridcells + logical :: seglen1 ! is segment length one + real(r8):: seglen ! average segment length + real(r8):: rcid ! real value of cid + integer :: cid,pid ! indices + integer :: n,m,ng ! indices + integer :: ier ! error code + integer :: beg,end,lsize,gsize ! used for gsmap init + integer, pointer :: gindex(:) ! global index for gsmap init + integer, pointer :: clumpcnt(:) ! clump index counter + !------------------------------------------------------------------------------ + + lns = lni * lnj + + !--- set and verify nclumps --- + if (clump_pproc > 0) then + nclumps = clump_pproc * npes + if (nclumps < npes) then + write(iulog,*) 'decompInit_lnd(): Number of gridcell clumps= ',nclumps, & + ' is less than the number of processes = ', npes + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + else + write(iulog,*)'clump_pproc= ',clump_pproc,' must be greater than 0' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! allocate and initialize procinfo and clumps + ! beg and end indices initialized for simple addition of cells later + + allocate(procinfo%cid(clump_pproc), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error for procinfo%cid' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + procinfo%nclumps = clump_pproc + procinfo%cid(:) = -1 + procinfo%ncells = 0 + procinfo%nlunits = 0 + procinfo%ncols = 0 + procinfo%npatches = 0 + procinfo%nCohorts = 0 + procinfo%begg = 1 + procinfo%begl = 1 + procinfo%begc = 1 + procinfo%begp = 1 + procinfo%begCohort = 1 + procinfo%endg = 0 + procinfo%endl = 0 + procinfo%endc = 0 + procinfo%endp = 0 + procinfo%endCohort = 0 + + allocate(clumps(nclumps), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error for clumps' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + clumps(:)%owner = -1 + clumps(:)%ncells = 0 + clumps(:)%nlunits = 0 + clumps(:)%ncols = 0 + clumps(:)%npatches = 0 + clumps(:)%nCohorts = 0 + clumps(:)%begg = 1 + clumps(:)%begl = 1 + clumps(:)%begc = 1 + clumps(:)%begp = 1 + clumps(:)%begCohort = 1 + clumps(:)%endg = 0 + clumps(:)%endl = 0 + clumps(:)%endc = 0 + clumps(:)%endp = 0 + clumps(:)%endCohort = 0 + + ! assign clumps to proc round robin + cid = 0 + do n = 1,nclumps + pid = mod(n-1,npes) + if (pid < 0 .or. pid > npes-1) then + write(iulog,*) 'decompInit_lnd(): round robin pid error ',n,pid,npes + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + clumps(n)%owner = pid + if (iam == pid) then + cid = cid + 1 + if (cid < 1 .or. cid > clump_pproc) then + write(iulog,*) 'decompInit_lnd(): round robin pid error ',n,pid,npes + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + procinfo%cid(cid) = n + endif + enddo + + ! count total land gridcells + numg = 0 + do ln = 1,lns + if (amask(ln) == 1) then + numg = numg + 1 + endif + enddo + + if (npes > numg) then + write(iulog,*) 'decompInit_lnd(): Number of processes exceeds number ', & + 'of land grid cells',npes,numg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (nclumps > numg) then + write(iulog,*) 'decompInit_lnd(): Number of clumps exceeds number ', & + 'of land grid cells',nclumps,numg + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (float(numg)/float(nclumps) < float(nsegspc)) then + seglen1 = .true. + seglen = 1.0_r8 + else + seglen1 = .false. + seglen = dble(numg)/(dble(nsegspc)*dble(nclumps)) + endif + + if (masterproc) then + write(iulog,*) ' decomp precompute numg,nclumps,seglen1,avg_seglen,nsegspc=', & + numg,nclumps,seglen1,& + sngl(seglen),sngl(dble(numg)/(seglen*dble(nclumps))) + end if + + ! Assign gridcells to clumps (and thus pes) --- + + allocate(lcid(lns)) + lcid(:) = 0 + ng = 0 + do ln = 1,lns + if (amask(ln) == 1) then + ng = ng + 1 + + !--- give to clumps in order based on nsegspc + if (seglen1) then + cid = mod(ng-1,nclumps) + 1 + else + rcid = (dble(ng-1)/dble(numg))*dble(nsegspc)*dble(nclumps) + cid = mod(int(rcid),nclumps) + 1 + endif + lcid(ln) = cid + + !--- give gridcell cell to pe that owns cid --- + !--- this needs to be done to subsequently use function + !--- get_proc_bounds(begg,endg) + if (iam == clumps(cid)%owner) then + procinfo%ncells = procinfo%ncells + 1 + endif + if (iam > clumps(cid)%owner) then + procinfo%begg = procinfo%begg + 1 + endif + if (iam >= clumps(cid)%owner) then + procinfo%endg = procinfo%endg + 1 + endif + + !--- give gridcell to cid --- + !--- increment the beg and end indices --- + clumps(cid)%ncells = clumps(cid)%ncells + 1 + do m = 1,nclumps + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then + clumps(m)%begg = clumps(m)%begg + 1 + endif + + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then + clumps(m)%endg = clumps(m)%endg + 1 + endif + enddo + + end if + enddo + + ! Set ldecomp + + allocate(ldecomp%gdc2glo(numg), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error1 for ldecomp, etc' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + allocate(clumpcnt(nclumps),stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error1 for clumpcnt' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ldecomp%gdc2glo(:) = 0 + ag = 0 + + ! clumpcnt is the start gdc index of each clump + + clumpcnt = 0 + ag = 1 + do pid = 0,npes-1 + do cid = 1,nclumps + if (clumps(cid)%owner == pid) then + clumpcnt(cid) = ag + ag = ag + clumps(cid)%ncells + endif + enddo + enddo + + ! now go through gridcells one at a time and increment clumpcnt + ! in order to set gdc2glo + + do aj = 1,lnj + do ai = 1,lni + an = (aj-1)*lni + ai + cid = lcid(an) + if (cid > 0) then + ag = clumpcnt(cid) + ldecomp%gdc2glo(ag) = an + clumpcnt(cid) = clumpcnt(cid) + 1 + end if + end do + end do + + deallocate(clumpcnt) + + ! Set gsMap_lnd_gdc2glo (the global index here includes mask=0 or ocean points) + + call get_proc_bounds(beg, end) + allocate(gindex(beg:end)) + do n = beg,end + gindex(n) = ldecomp%gdc2glo(n) + enddo + lsize = end-beg+1 + gsize = lni * lnj + call mct_gsMap_init(gsMap_lnd_gdc2glo, gindex, mpicom, comp_id, lsize, gsize) + deallocate(gindex) + + ! Diagnostic output + + if (masterproc) then + write(iulog,*)' Surface Grid Characteristics' + write(iulog,*)' longitude points = ',lni + write(iulog,*)' latitude points = ',lnj + write(iulog,*)' total number of land gridcells = ',numg + write(iulog,*)' Decomposition Characteristics' + write(iulog,*)' clumps per process = ',clump_pproc + write(iulog,*)' gsMap Characteristics' + write(iulog,*) ' lnd gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo) + write(iulog,*) + end if + + call shr_sys_flush(iulog) + + end subroutine decompInit_lnd + + !------------------------------------------------------------------------------ + subroutine decompInit_clumps(lns,lni,lnj,glcmask) + ! + ! !DESCRIPTION: + ! This subroutine initializes the land surface decomposition into a clump + ! data structure. This assumes each pe has the same number of clumps + ! set by clump_pproc + ! + ! !USES: + use subgridMod, only : subgrid_get_gcellinfo + use spmdMod + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , pointer, optional :: glcmask(:) ! glc mask + ! + ! !LOCAL VARIABLES: + integer :: ln,an ! indices + integer :: i,g,l,k ! indices + integer :: cid,pid ! indices + integer :: n,m,np ! indices + integer :: anumg ! lnd num gridcells + integer :: icells ! temporary + integer :: begg, endg ! temporary + integer :: ilunits ! temporary + integer :: icols ! temporary + integer :: ipatches ! temporary + integer :: icohorts ! temporary + integer :: ier ! error code + integer, allocatable :: allvecg(:,:) ! temporary vector "global" + integer, allocatable :: allvecl(:,:) ! temporary vector "local" + integer :: ntest + character(len=32), parameter :: subname = 'decompInit_clumps' + !------------------------------------------------------------------------------ + + !--- assign gridcells to clumps (and thus pes) --- + call get_proc_bounds(begg, endg) + + allocate(allvecl(nclumps,5)) ! local clumps [gcells,lunit,cols,patches,coh] + allocate(allvecg(nclumps,5)) ! global clumps [gcells,lunit,cols,patches,coh] + + ! Determine the number of gridcells, landunits, columns, and patches, cohorts + ! on this processor + ! Determine number of landunits, columns and patches for each global + ! gridcell index (an) that is associated with the local gridcell index (ln) + + ilunits=0 + icols=0 + ipatches=0 + icohorts=0 + + allvecg= 0 + allvecl= 0 + do anumg = begg,endg + an = ldecomp%gdc2glo(anumg) + cid = lcid(an) + ln = anumg + if (present(glcmask)) then + call subgrid_get_gcellinfo (ln, nlunits=ilunits, ncols=icols, npatches=ipatches, & + ncohorts=icohorts, glcmask=glcmask(ln)) + else + call subgrid_get_gcellinfo (ln, nlunits=ilunits, ncols=icols, npatches=ipatches, & + ncohorts=icohorts ) + endif + allvecl(cid,1) = allvecl(cid,1) + 1 + allvecl(cid,2) = allvecl(cid,2) + ilunits ! number of landunits for local clump cid + allvecl(cid,3) = allvecl(cid,3) + icols ! number of columns for local clump cid + allvecl(cid,4) = allvecl(cid,4) + ipatches ! number of patches for local clump cid + allvecl(cid,5) = allvecl(cid,5) + icohorts ! number of cohorts for local clump cid + enddo + call mpi_allreduce(allvecl,allvecg,size(allvecg),MPI_INTEGER,MPI_SUM,mpicom,ier) + + ! Determine overall total gridcells, landunits, columns and patches and distribute + ! gridcells over clumps + + numg = 0 + numl = 0 + numc = 0 + nump = 0 + numCohort = 0 + + do cid = 1,nclumps + icells = allvecg(cid,1) ! number of all clump cid gridcells (over all processors) + ilunits = allvecg(cid,2) ! number of all clump cid landunits (over all processors) + icols = allvecg(cid,3) ! number of all clump cid columns (over all processors) + ipatches = allvecg(cid,4) ! number of all clump cid patches (over all processors) + icohorts = allvecg(cid,5) ! number of all clump cid cohorts (over all processors) + + !--- overall total --- + numg = numg + icells ! total number of gridcells + numl = numl + ilunits ! total number of landunits + numc = numc + icols ! total number of columns + nump = nump + ipatches ! total number of patches + numCohort = numCohort + icohorts ! total number of cohorts + + !--- give gridcell to cid --- + !--- increment the beg and end indices --- + clumps(cid)%nlunits = clumps(cid)%nlunits + ilunits + clumps(cid)%ncols = clumps(cid)%ncols + icols + clumps(cid)%npatches = clumps(cid)%npatches + ipatches + clumps(cid)%nCohorts = clumps(cid)%nCohorts + icohorts + + do m = 1,nclumps + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then + clumps(m)%begl = clumps(m)%begl + ilunits + clumps(m)%begc = clumps(m)%begc + icols + clumps(m)%begp = clumps(m)%begp + ipatches + clumps(m)%begCohort = clumps(m)%begCohort + icohorts + endif + + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then + clumps(m)%endl = clumps(m)%endl + ilunits + clumps(m)%endc = clumps(m)%endc + icols + clumps(m)%endp = clumps(m)%endp + ipatches + clumps(m)%endCohort = clumps(m)%endCohort + icohorts + endif + enddo + + !--- give gridcell to the proc that owns the cid --- + !--- increment the beg and end indices --- + if (iam == clumps(cid)%owner) then + procinfo%nlunits = procinfo%nlunits + ilunits + procinfo%ncols = procinfo%ncols + icols + procinfo%npatches = procinfo%npatches + ipatches + procinfo%nCohorts = procinfo%nCohorts + icohorts + endif + + if (iam > clumps(cid)%owner) then + procinfo%begl = procinfo%begl + ilunits + procinfo%begc = procinfo%begc + icols + procinfo%begp = procinfo%begp + ipatches + procinfo%begCohort = procinfo%begCohort + icohorts + endif + + if (iam >= clumps(cid)%owner) then + procinfo%endl = procinfo%endl + ilunits + procinfo%endc = procinfo%endc + icols + procinfo%endp = procinfo%endp + ipatches + procinfo%endCohort = procinfo%endCohort + icohorts + endif + enddo + + do n = 1,nclumps + if (clumps(n)%ncells /= allvecg(n,1) .or. & + clumps(n)%nlunits /= allvecg(n,2) .or. & + clumps(n)%ncols /= allvecg(n,3) .or. & + clumps(n)%npatches /= allvecg(n,4) .or. & + clumps(n)%nCohorts /= allvecg(n,5)) then + + write(iulog ,*) 'decompInit_glcp(): allvecg error ncells ',iam,n,clumps(n)%ncells ,allvecg(n,1) + write(iulog ,*) 'decompInit_glcp(): allvecg error lunits ',iam,n,clumps(n)%nlunits ,allvecg(n,2) + write(iulog ,*) 'decompInit_glcp(): allvecg error ncols ',iam,n,clumps(n)%ncols ,allvecg(n,3) + write(iulog ,*) 'decompInit_glcp(): allvecg error patches',iam,n,clumps(n)%npatches ,allvecg(n,4) + write(iulog ,*) 'decompInit_glcp(): allvecg error cohorts',iam,n,clumps(n)%nCohorts ,allvecg(n,5) + + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + enddo + + deallocate(allvecg,allvecl) + deallocate(lcid) + + end subroutine decompInit_clumps + + !------------------------------------------------------------------------------ + subroutine decompInit_glcp(lns,lni,lnj,glcmask) + ! + ! !DESCRIPTION: + ! Determine gsMaps for landunits, columns, patchesand cohorts + ! + ! !USES: + use spmdMod + use spmdGathScatMod + use subgridMod, only : subgrid_get_gcellinfo + use mct_mod + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , pointer, optional :: glcmask(:) ! glc mask + ! + ! !LOCAL VARIABLES: + integer :: gi,li,ci,pi,coi ! indices + integer :: i,g,k,l,n,np ! indices + integer :: cid,pid ! indices + integer :: begg,endg ! beg,end gridcells + integer :: begl,endl ! beg,end landunits + integer :: begc,endc ! beg,end columns + integer :: begp,endp ! beg,end patches + integer :: begCohort,endCohort! beg,end patches + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of patches across all processors + integer :: numCohort ! ED cohorts + integer :: icells ! temporary + integer :: ilunits ! temporary + integer :: icols ! temporary + integer :: ipatches ! temporary + integer :: icohorts ! temporary + integer :: ier ! error code + integer :: npmin,npmax,npint ! do loop values for printing + integer :: clmin,clmax ! do loop values for printing + integer :: locsize,globsize ! used for gsMap init + integer :: ng ! number of gridcells in gsMap_lnd_gdc2glo + integer :: val1, val2 ! temporaries + integer, pointer :: gindex(:) ! global index for gsMap init + integer, pointer :: arrayglob(:) ! temporaroy + integer, pointer :: gstart(:), gcount(:) + integer, pointer :: lstart(:), lcount(:) + integer, pointer :: cstart(:), ccount(:) + integer, pointer :: pstart(:), pcount(:) + integer, pointer :: coStart(:), coCount(:) + integer, pointer :: ioff(:) + integer, parameter :: dbug=1 ! 0 = min, 1=normal, 2=much, 3=max + character(len=32), parameter :: subname = 'decompInit_glcp' + !------------------------------------------------------------------------------ + + !init + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort) + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort) + + ! Determine global seg megs + + allocate(gstart(begg:endg)) + gstart(:) = 0 + allocate(gcount(begg:endg)) + gcount(:) = 0 + allocate(lstart(begg:endg)) + lstart(:) = 0 + allocate(lcount(begg:endg)) + lcount(:) = 0 + allocate(cstart(begg:endg)) + cstart(:) = 0 + allocate(ccount(begg:endg)) + ccount(:) = 0 + allocate(pstart(begg:endg)) + pstart(:) = 0 + allocate(pcount(begg:endg)) + pcount(:) = 0 + if ( use_ed ) then + allocate(coStart(begg:endg)) + coStart(:) = 0 + endif + allocate(coCount(begg:endg)) + coCount(:) = 0 + allocate(ioff(begg:endg)) + ioff(:) = 0 + + ! Determine gcount, lcount, ccount and pcount + + do gi = begg,endg + if (present(glcmask)) then + call subgrid_get_gcellinfo (gi, nlunits=ilunits, ncols=icols, npatches=ipatches, & + ncohorts=icohorts, glcmask=glcmask(gi)) + else + call subgrid_get_gcellinfo (gi, nlunits=ilunits, ncols=icols, npatches=ipatches, & + ncohorts=icohorts ) + endif + gcount(gi) = 1 ! number of gridcells for local gridcell index gi + lcount(gi) = ilunits ! number of landunits for local gridcell index gi + ccount(gi) = icols ! number of columns for local gridcell index gi + pcount(gi) = ipatches ! number of patches for local gridcell index gi + coCount(gi) = icohorts ! number of ED cohorts for local gricell index gi + enddo + + ! Determine gstart, lstart, cstart, pstart, coStart for the OUTPUT 1d data structures + + ! gather the gdc subgrid counts to masterproc in glo order + ! compute glo ordered start indices from the counts + ! scatter the subgrid start indices back out to the gdc gridcells + ! set the local gindex array for the subgrid from the subgrid start and count arrays + + ng = mct_gsmap_gsize(gsmap_lnd_gdc2glo) + allocate(arrayglob(ng)) + + arrayglob(:) = 0 + call gather_data_to_master(gcount, arrayglob, grlnd) + if (masterproc) then + val1 = arrayglob(1) + arrayglob(1) = 1 + do n = 2,ng + val2 = arrayglob(n) + arrayglob(n) = arrayglob(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(gstart, arrayglob, grlnd) + + ! lstart for gridcell (n) is the total number of the landunits + ! over gridcells 1->n-1 + + arrayglob(:) = 0 + call gather_data_to_master(lcount, arrayglob, grlnd) + if (masterproc) then + val1 = arrayglob(1) + arrayglob(1) = 1 + do n = 2,ng + val2 = arrayglob(n) + arrayglob(n) = arrayglob(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(lstart, arrayglob, grlnd) + + arrayglob(:) = 0 + call gather_data_to_master(ccount, arrayglob, grlnd) + if (masterproc) then + val1 = arrayglob(1) + arrayglob(1) = 1 + do n = 2,ng + val2 = arrayglob(n) + arrayglob(n) = arrayglob(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(cstart, arrayglob, grlnd) + + arrayglob(:) = 0 + call gather_data_to_master(pcount, arrayglob, grlnd) + if (masterproc) then + val1 = arrayglob(1) + arrayglob(1) = 1 + do n = 2,ng + val2 = arrayglob(n) + arrayglob(n) = arrayglob(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(pstart, arrayglob, grlnd) + + if ( use_ed ) then + arrayglob(:) = 0 + call gather_data_to_master(coCount, arrayglob, grlnd) + if (masterproc) then + val1 = arrayglob(1) + arrayglob(1) = 1 + do n = 2,ng + val2 = arrayglob(n) + arrayglob(n) = arrayglob(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(coStart, arrayglob, grlnd) + endif + + deallocate(arrayglob) + + ! Gridcell gsmap (compressed, no ocean points) + + allocate(gindex(begg:endg)) + i = begg-1 + do gi = begg,endg + if (gcount(gi) < 1) then + write(iulog,*) 'decompInit_glcp warning count g ',k,iam,g,gcount(g) + endif + do l = 1,gcount(gi) + i = i + 1 + if (i < begg .or. i > endg) then + write(iulog,*) 'decompInit_glcp error i ',i,begg,endg + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + gindex(i) = gstart(gi) + l - 1 + enddo + enddo + if (i /= endg) then + write(iulog,*) 'decompInit_glcp error size ',i,begg,endg + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + locsize = endg-begg+1 + globsize = numg + call mct_gsMap_init(gsmap_gce_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) + deallocate(gindex) + + ! Landunit gsmap + + allocate(gindex(begl:endl)) + ioff(:) = 0 + do li = begl,endl + gi = lun%gridcell(li) !===this is determined internally from how landunits are spread out in memory + gindex(li) = lstart(gi) + ioff(gi) !=== the output gindex is ALWAYS the same regardless of how landuntis are spread out in memory + ioff(gi) = ioff(gi) + 1 + ! check that this is less than [lstart(gi) + lcount(gi)] + enddo + locsize = endl-begl+1 + globsize = numl + call mct_gsMap_init(gsmap_lun_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) + deallocate(gindex) + + ! Column gsmap + + allocate(gindex(begc:endc)) + ioff(:) = 0 + do ci = begc,endc + gi = col%gridcell(ci) + gindex(ci) = cstart(gi) + ioff(gi) + ioff(gi) = ioff(gi) + 1 + ! check that this is less than [cstart(gi) + ccount(gi)] + enddo + locsize = endc-begc+1 + globsize = numc + call mct_gsMap_init(gsmap_col_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) + deallocate(gindex) + + ! PATCH gsmap + + allocate(gindex(begp:endp)) + ioff(:) = 0 + do pi = begp,endp + gi = patch%gridcell(pi) + gindex(pi) = pstart(gi) + ioff(gi) + ioff(gi) = ioff(gi) + 1 + ! check that this is less than [pstart(gi) + pcount(gi)] + enddo + locsize = endp-begp+1 + globsize = nump + call mct_gsMap_init(gsmap_patch_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) + deallocate(gindex) + + if ( use_ed ) then + ! ED cohort gsMap + allocate(gindex(begCohort:endCohort)) + ioff(:) = 0 + do coi = begCohort,endCohort + gi = ed_vec_cohort%gridcell(coi) !function call to get gcell for this cohort idx + gindex(coi) = coStart(gi) + ioff(gi) + ioff(gi) = ioff(gi) + 1 + enddo + locsize = endCohort-begCohort+1 + globsize = numCohort + call mct_gsMap_init(gsMap_cohort_gdc2glo, gindex, mpicom, comp_id, locsize, globsize) + deallocate(gindex) + endif + + ! Deallocate start/count arrays + deallocate(gstart, gcount) + deallocate(lstart, lcount) + deallocate(cstart, ccount) + deallocate(pstart, pcount) + if ( use_ed ) then + deallocate(coStart,coCount) + endif + deallocate(ioff) + + ! Diagnostic output + + if (masterproc) then + write(iulog,*)' Surface Grid Characteristics' + write(iulog,*)' longitude points = ',lni + write(iulog,*)' latitude points = ',lnj + write(iulog,*)' total number of gridcells = ',numg + write(iulog,*)' total number of landunits = ',numl + write(iulog,*)' total number of columns = ',numc + write(iulog,*)' total number of patches = ',nump + write(iulog,*)' total number of cohorts = ',numCohort + write(iulog,*)' Decomposition Characteristics' + write(iulog,*)' clumps per process = ',clump_pproc + write(iulog,*)' gsMap Characteristics' + write(iulog,*) ' lnd gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo) + write(iulog,*) ' gce gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo) + write(iulog,*) ' lun gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo) + write(iulog,*) ' col gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_col_gdc2glo) + write(iulog,*) ' patch gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_patch_gdc2glo) + write(iulog,*) ' coh gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_cohort_gdc2glo) + write(iulog,*) + end if + + ! Write out clump and proc info, one pe at a time, + ! barrier to control pes overwriting each other on stdout + + call shr_sys_flush(iulog) + call mpi_barrier(mpicom,ier) + npmin = 0 + npmax = npes-1 + npint = 1 + if (dbug == 0) then + npmax = 0 + elseif (dbug == 1) then + npmax = min(npes-1,4) + elseif (dbug == 2) then + npint = npes/8 + endif + do np = npmin,npmax,npint + pid = np + if (dbug == 1) then + if (np == 2) pid=npes/2-1 + if (np == 3) pid=npes-2 + if (np == 4) pid=npes-1 + endif + pid = max(pid,0) + pid = min(pid,npes-1) + + if (iam == pid) then + write(iulog,*) + write(iulog,*)'proc= ',pid,& + ' beg gridcell= ',procinfo%begg, & + ' end gridcell= ',procinfo%endg, & + ' total gridcells per proc= ',procinfo%ncells + write(iulog,*)'proc= ',pid,& + ' beg landunit= ',procinfo%begl, & + ' end landunit= ',procinfo%endl, & + ' total landunits per proc= ',procinfo%nlunits + write(iulog,*)'proc= ',pid,& + ' beg column = ',procinfo%begc, & + ' end column = ',procinfo%endc, & + ' total columns per proc = ',procinfo%ncols + write(iulog,*)'proc= ',pid,& + ' beg patch = ',procinfo%begp, & + ' end patch = ',procinfo%endp, & + ' total patches per proc = ',procinfo%npatches + write(iulog,*)'proc= ',pid,& + ' beg coh = ',procinfo%begCohort, & + ' end coh = ',procinfo%endCohort, & + ' total coh per proc = ',procinfo%nCohorts + write(iulog,*)'proc= ',pid,& + ' lnd ngseg = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo), & + ' lnd nlseg = ',mct_gsMap_nlseg(gsMap_lnd_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' gce ngseg = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo), & + ' gce nlseg = ',mct_gsMap_nlseg(gsMap_gce_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' lun ngseg = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo), & + ' lun nlseg = ',mct_gsMap_nlseg(gsMap_lun_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' col ngseg = ',mct_gsMap_ngseg(gsMap_col_gdc2glo), & + ' col nlseg = ',mct_gsMap_nlseg(gsMap_col_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' patch ngseg = ',mct_gsMap_ngseg(gsMap_patch_gdc2glo), & + ' patch nlseg = ',mct_gsMap_nlseg(gsMap_patch_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' coh ngseg = ',mct_gsMap_ngseg(gsMap_cohort_gdc2glo), & + ' coh nlseg = ',mct_gsMap_nlseg(gsMap_cohort_gdc2glo,iam) + write(iulog,*)'proc= ',pid,' nclumps = ',procinfo%nclumps + + clmin = 1 + clmax = procinfo%nclumps + if (dbug == 1) then + clmax = 1 + elseif (dbug == 0) then + clmax = -1 + endif + do n = clmin,clmax + cid = procinfo%cid(n) + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg gridcell= ',clumps(cid)%begg, & + ' end gridcell= ',clumps(cid)%endg, & + ' total gridcells per clump= ',clumps(cid)%ncells + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg landunit= ',clumps(cid)%begl, & + ' end landunit= ',clumps(cid)%endl, & + ' total landunits per clump = ',clumps(cid)%nlunits + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg column = ',clumps(cid)%begc, & + ' end column = ',clumps(cid)%endc, & + ' total columns per clump = ',clumps(cid)%ncols + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg patch = ',clumps(cid)%begp, & + ' end patch = ',clumps(cid)%endp, & + ' total patches per clump = ',clumps(cid)%npatches + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg cohort = ',clumps(cid)%begCohort, & + ' end cohort = ',clumps(cid)%endCohort, & + ' total cohorts per clump = ',clumps(cid)%nCohorts + end do + end if + call shr_sys_flush(iulog) + call mpi_barrier(mpicom,ier) + end do + call shr_sys_flush(iulog) + + end subroutine decompInit_glcp + +end module decompInitMod diff --git a/components/clm/src/main/decompMod.F90 b/components/clm/src/main/decompMod.F90 new file mode 100644 index 0000000000..09488b4896 --- /dev/null +++ b/components/clm/src/main/decompMod.F90 @@ -0,0 +1,392 @@ +module decompMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Module provides a descomposition into a clumped data structure which can + ! be mapped back to atmosphere physics chunks. + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + ! Must use shr_sys_abort rather than endrun here to avoid circular dependency + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort + use mct_mod , only : mct_gsMap + ! + ! !PUBLIC TYPES: + implicit none + integer, public :: clump_pproc ! number of clumps per MPI process + + ! Define possible bounds levels + integer, parameter, public :: BOUNDS_LEVEL_PROC = 1 + integer, parameter, public :: BOUNDS_LEVEL_CLUMP = 2 + ! + ! !PUBLIC MEMBER FUNCTIONS: + + public get_proc_clumps ! number of clumps for this processor + public get_proc_total ! total no. of gridcells, landunits, columns and patchs for any processor + public get_proc_global ! total gridcells, landunits, columns, patchs across all processors + public get_clmlevel_gsize ! get global size associated with clmlevel + public get_clmlevel_gsmap ! get gsmap associated with clmlevel + + interface get_clump_bounds + module procedure get_clump_bounds_old + module procedure get_clump_bounds_new + end interface + public get_clump_bounds ! clump beg and end gridcell,landunit,column,patch + + interface get_proc_bounds + module procedure get_proc_bounds_old + module procedure get_proc_bounds_new + end interface + public get_proc_bounds ! this processor beg and end gridcell,landunit,column,patch + + ! !PRIVATE MEMBER FUNCTIONS: + ! + ! !PRIVATE TYPES: + private ! (now mostly public for decompinitmod) + + integer,public :: nclumps ! total number of clumps across all processors + integer,public :: numg ! total number of gridcells on all procs + integer,public :: numl ! total number of landunits on all procs + integer,public :: numc ! total number of columns on all procs + integer,public :: nump ! total number of patchs on all procs + integer,public :: numCohort ! total number of ED cohorts on all procs + + type bounds_type + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending patch index + integer :: begCohort, endCohort ! beginning and ending cohort indices + + integer :: level ! whether defined on the proc or clump level + integer :: clump_index ! if defined on the clump level, this gives the clump index + end type bounds_type + public bounds_type + + !---global information on each pe + type processor_type + integer :: nclumps ! number of clumps for processor_type iam + integer,pointer :: cid(:) ! clump indices + integer :: ncells ! number of gridcells in proc + integer :: nlunits ! number of landunits in proc + integer :: ncols ! number of columns in proc + integer :: npatches ! number of patchs in proc + integer :: nCohorts ! number of cohorts in proc + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending patch index + integer :: begCohort, endCohort ! beginning and ending cohort indices + end type processor_type + public processor_type + type(processor_type),public :: procinfo + + !---global information on each pe + type clump_type + integer :: owner ! process id owning clump + integer :: ncells ! number of gridcells in clump + integer :: nlunits ! number of landunits in clump + integer :: ncols ! number of columns in clump + integer :: npatches ! number of patchs in clump + integer :: nCohorts ! number of cohorts in proc + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending patch index + integer :: begCohort, endCohort ! beginning and ending cohort indices + end type clump_type + public clump_type + type(clump_type),public, allocatable :: clumps(:) + + !---global information on each pe + !--- glo = 1d global sn ordered + !--- gdc = 1d global dc ordered compressed + type decomp_type + integer,pointer :: gdc2glo(:) ! 1d gdc to 1d glo + end type decomp_type + public decomp_type + type(decomp_type),public,target :: ldecomp + + type(mct_gsMap) ,public,target :: gsMap_lnd_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_gce_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_lun_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_col_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_patch_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_cohort_gdc2glo + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine get_clump_bounds_new (n, bounds) + ! + ! !DESCRIPTION: + ! Determine clump bounds + ! + ! !ARGUMENTS: + integer, intent(in) :: n ! processor clump index + type(bounds_type), intent(out) :: bounds ! clump bounds + ! + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname = 'get_clump_bounds' ! Subroutine name + integer :: cid ! clump id +#ifdef _OPENMP + integer, external :: OMP_GET_MAX_THREADS + integer, external :: OMP_GET_NUM_THREADS + integer, external :: OMP_GET_THREAD_NUM +#endif + !------------------------------------------------------------------------------ + ! Make sure this IS being called from a threaded region +#ifdef _OPENMP + ! FIX(SPM, 090314) - for debugging ED and openMP + !write(iulog,*) 'SPM omp debug decompMod 1 ', & + !OMP_GET_NUM_THREADS(),OMP_GET_MAX_THREADS(),OMP_GET_THREAD_NUM() + + if ( OMP_GET_NUM_THREADS() == 1 .and. OMP_GET_MAX_THREADS() > 1 )then + call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a non-threaded region)') + end if +#endif + + cid = procinfo%cid(n) + bounds%begp = clumps(cid)%begp + bounds%endp = clumps(cid)%endp + bounds%begc = clumps(cid)%begc + bounds%endc = clumps(cid)%endc + bounds%begl = clumps(cid)%begl + bounds%endl = clumps(cid)%endl + bounds%begg = clumps(cid)%begg + bounds%endg = clumps(cid)%endg + bounds%begCohort = clumps(cid)%begCohort + bounds%endCohort = clumps(cid)%endCohort + + bounds%level = BOUNDS_LEVEL_CLUMP + bounds%clump_index = n + + end subroutine get_clump_bounds_new + + !------------------------------------------------------------------------------ + subroutine get_clump_bounds_old (n, begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort) + integer, intent(in) :: n ! proc clump index + integer, intent(out) :: begp, endp ! clump beg and end patch indices + integer, intent(out) :: begc, endc ! clump beg and end column indices + integer, intent(out) :: begl, endl ! clump beg and end landunit indices + integer, intent(out) :: begg, endg ! clump beg and end gridcell indices + integer, intent(out) :: begCohort, endCohort ! cohort beg and end gridcell indices + integer :: cid ! clump id + !------------------------------------------------------------------------------ + + cid = procinfo%cid(n) + begp = clumps(cid)%begp + endp = clumps(cid)%endp + begc = clumps(cid)%begc + endc = clumps(cid)%endc + begl = clumps(cid)%begl + endl = clumps(cid)%endl + begg = clumps(cid)%begg + endg = clumps(cid)%endg + begCohort = clumps(cid)%begCohort + endCohort = clumps(cid)%endCohort + end subroutine get_clump_bounds_old + + !------------------------------------------------------------------------------ + subroutine get_proc_bounds_new (bounds) + ! + ! !DESCRIPTION: + ! Retrieve processor bounds + ! + ! !ARGUMENTS: + type(bounds_type), intent(out) :: bounds ! processor bounds bounds + ! + ! !LOCAL VARIABLES: +#ifdef _OPENMP + integer, external :: OMP_GET_NUM_THREADS + integer, external :: OMP_GET_MAX_THREADS + integer, external :: OMP_GET_THREAD_NUM +#endif + character(len=32), parameter :: subname = 'get_proc_bounds' ! Subroutine name + !------------------------------------------------------------------------------ + ! Make sure this is NOT being called from a threaded region +#ifdef _OPENMP + ! FIX(SPM, 090314) - for debugging ED and openMP + !write(*,*) 'SPM omp debug decompMod 2 ', & + !OMP_GET_NUM_THREADS(),OMP_GET_MAX_THREADS(),OMP_GET_THREAD_NUM() + + if ( OMP_GET_NUM_THREADS() > 1 )then + call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a threaded region') + end if +#endif + + bounds%begp = procinfo%begp + bounds%endp = procinfo%endp + bounds%begc = procinfo%begc + bounds%endc = procinfo%endc + bounds%begl = procinfo%begl + bounds%endl = procinfo%endl + bounds%begg = procinfo%begg + bounds%endg = procinfo%endg + bounds%begCohort = procinfo%begCohort + bounds%endCohort = procinfo%endCohort + + bounds%level = BOUNDS_LEVEL_PROC + bounds%clump_index = -1 ! irrelevant for proc, so assigned a bogus value + + end subroutine get_proc_bounds_new + + !------------------------------------------------------------------------------ + subroutine get_proc_bounds_old (begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort) + + integer, optional, intent(out) :: begp, endp ! proc beg and end patch indices + integer, optional, intent(out) :: begc, endc ! proc beg and end column indices + integer, optional, intent(out) :: begl, endl ! proc beg and end landunit indices + integer, optional, intent(out) :: begg, endg ! proc beg and end gridcell indices + integer, optional, intent(out) :: begCohort, endCohort ! cohort beg and end gridcell indices + !------------------------------------------------------------------------------ + + if (present(begp)) begp = procinfo%begp + if (present(endp)) endp = procinfo%endp + if (present(begc)) begc = procinfo%begc + if (present(endc)) endc = procinfo%endc + if (present(begl)) begl = procinfo%begl + if (present(endl)) endl = procinfo%endl + if (present(begg)) begg = procinfo%begg + if (present(endg)) endg = procinfo%endg + if (present(begCohort)) begCohort = procinfo%begCohort + if (present(endCohort)) endCohort = procinfo%endCohort + end subroutine get_proc_bounds_old + + !------------------------------------------------------------------------------ + subroutine get_proc_total(pid, ncells, nlunits, ncols, npatches, nCohorts) + ! + ! !DESCRIPTION: + ! Count up gridcells, landunits, columns, and patchs on process. + ! + ! !ARGUMENTS: + integer, intent(in) :: pid ! proc id + integer, intent(out) :: ncells ! total number of gridcells on the processor + integer, intent(out) :: nlunits ! total number of landunits on the processor + integer, intent(out) :: ncols ! total number of columns on the processor + integer, intent(out) :: npatches ! total number of patchs on the processor + integer, intent(out) :: nCohorts! total number of cohorts on the processor + ! + ! !LOCAL VARIABLES: + integer :: cid ! clump index + !------------------------------------------------------------------------------ + + npatches = 0 + nlunits = 0 + ncols = 0 + ncells = 0 + nCohorts = 0 + do cid = 1,nclumps + if (clumps(cid)%owner == pid) then + ncells = ncells + clumps(cid)%ncells + nlunits = nlunits + clumps(cid)%nlunits + ncols = ncols + clumps(cid)%ncols + npatches = npatches + clumps(cid)%npatches + nCohorts = nCohorts + clumps(cid)%nCohorts + end if + end do + end subroutine get_proc_total + + !------------------------------------------------------------------------------ + subroutine get_proc_global(ng, nl, nc, np, nCohorts) + ! + ! !DESCRIPTION: + ! Return number of gridcells, landunits, columns, and patchs across all processes. + ! + ! !ARGUMENTS: + integer, optional, intent(out) :: ng ! total number of gridcells across all processors + integer, optional, intent(out) :: nl ! total number of landunits across all processors + integer, optional, intent(out) :: nc ! total number of columns across all processors + integer, optional, intent(out) :: np ! total number of patchs across all processors + integer, optional, intent(out) :: nCohorts ! total number ED cohorts + !------------------------------------------------------------------------------ + + if (present(np)) np = nump + if (present(nc)) nc = numc + if (present(nl)) nl = numl + if (present(ng)) ng = numg + if (present(nCohorts)) nCohorts = numCohort + + end subroutine get_proc_global + + !------------------------------------------------------------------------------ + integer function get_proc_clumps() + ! + ! !DESCRIPTION: + ! Return the number of clumps. + !------------------------------------------------------------------------------ + + get_proc_clumps = procinfo%nclumps + + end function get_proc_clumps + + !----------------------------------------------------------------------- + integer function get_clmlevel_gsize (clmlevel) + ! + ! !DESCRIPTION: + ! Determine 1d size from clmlevel + ! + ! !USES: + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: clmlevel !type of clm 1d array + !----------------------------------------------------------------------- + + select case (clmlevel) + case(grlnd) + get_clmlevel_gsize = ldomain%ns + case(nameg) + get_clmlevel_gsize = numg + case(namel) + get_clmlevel_gsize = numl + case(namec) + get_clmlevel_gsize = numc + case(namep) + get_clmlevel_gsize = nump + case(nameCohort) + get_clmlevel_gsize = numCohort + case default + write(iulog,*) 'get_clmlevel_gsize does not match clmlevel type: ', trim(clmlevel) + call shr_sys_abort() + end select + + end function get_clmlevel_gsize + + !----------------------------------------------------------------------- + subroutine get_clmlevel_gsmap (clmlevel, gsmap) + ! + ! !DESCRIPTION: + ! Compute arguments for gatherv, scatterv for vectors + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: clmlevel ! type of input data + type(mct_gsmap) , pointer :: gsmap + !---------------------------------------------------------------------- + + select case (clmlevel) + case(grlnd) + gsmap => gsmap_lnd_gdc2glo + case(nameg) + gsmap => gsmap_gce_gdc2glo + case(namel) + gsmap => gsmap_lun_gdc2glo + case(namec) + gsmap => gsmap_col_gdc2glo + case(namep) + gsmap => gsmap_patch_gdc2glo + case(nameCohort) + gsmap => gsMap_cohort_gdc2glo + case default + write(iulog,*) 'get_clmlevel_gsmap: Invalid expansion character: ',trim(clmlevel) + call shr_sys_abort() + end select + + end subroutine get_clmlevel_gsmap + +end module decompMod diff --git a/components/clm/src/main/dtypes.h b/components/clm/src/main/dtypes.h new file mode 100644 index 0000000000..aa1dc3bd0f --- /dev/null +++ b/components/clm/src/main/dtypes.h @@ -0,0 +1,6 @@ +#define TYPETEXT 100 +#define TYPEREAL 101 +#define TYPEDOUBLE 102 +#define TYPEINT 103 +#define TYPELONG 104 +#define TYPELOGICAL 105 diff --git a/components/clm/src/main/filterMod.F90 b/components/clm/src/main/filterMod.F90 new file mode 100644 index 0000000000..c08d4e1819 --- /dev/null +++ b/components/clm/src/main/filterMod.F90 @@ -0,0 +1,561 @@ +module filterMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module of filters used for processing columns and pfts of particular + ! types, including lake, non-lake, urban, soil, snow, non-snow, and + ! naturally-vegetated patches. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : iulog + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type clumpfilter + integer, pointer :: natvegp(:) ! CNDV nat-vegetated (present) filter (pfts) + integer :: num_natvegp ! number of pfts in nat-vegetated filter + + integer, pointer :: pcropp(:) ! prognostic crop filter (pfts) + integer :: num_pcropp ! number of pfts in prognostic crop filter + integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (pfts) + integer :: num_soilnopcropp ! number of pfts in soil w/o prog crops + + integer, pointer :: lakep(:) ! lake filter (pfts) + integer :: num_lakep ! number of pfts in lake filter + integer, pointer :: nolakep(:) ! non-lake filter (pfts) + integer :: num_nolakep ! number of pfts in non-lake filter + integer, pointer :: lakec(:) ! lake filter (columns) + integer :: num_lakec ! number of columns in lake filter + integer, pointer :: nolakec(:) ! non-lake filter (columns) + integer :: num_nolakec ! number of columns in non-lake filter + + integer, pointer :: soilc(:) ! soil filter (columns) + integer :: num_soilc ! number of columns in soil filter + integer, pointer :: soilp(:) ! soil filter (pfts) + integer :: num_soilp ! number of pfts in soil filter + + integer, pointer :: snowc(:) ! snow filter (columns) + integer :: num_snowc ! number of columns in snow filter + integer, pointer :: nosnowc(:) ! non-snow filter (columns) + integer :: num_nosnowc ! number of columns in non-snow filter + + integer, pointer :: lakesnowc(:) ! snow filter (columns) + integer :: num_lakesnowc ! number of columns in snow filter + integer, pointer :: lakenosnowc(:) ! non-snow filter (columns) + integer :: num_lakenosnowc ! number of columns in non-snow filter + + integer, pointer :: exposedvegp(:) ! patches where frac_veg_nosno is non-zero + integer :: num_exposedvegp ! number of patches in exposedvegp filter + integer, pointer :: noexposedvegp(:)! patches where frac_veg_nosno is 0 (does NOT include lake or urban) + integer :: num_noexposedvegp ! number of patches in noexposedvegp filter + + integer, pointer :: hydrologyc(:) ! hydrology filter (columns) + integer :: num_hydrologyc ! number of columns in hydrology filter + + integer, pointer :: urbanl(:) ! urban filter (landunits) + integer :: num_urbanl ! number of landunits in urban filter + integer, pointer :: nourbanl(:) ! non-urban filter (landunits) + integer :: num_nourbanl ! number of landunits in non-urban filter + + integer, pointer :: urbanc(:) ! urban filter (columns) + integer :: num_urbanc ! number of columns in urban filter + integer, pointer :: nourbanc(:) ! non-urban filter (columns) + integer :: num_nourbanc ! number of columns in non-urban filter + + integer, pointer :: urbanp(:) ! urban filter (pfts) + integer :: num_urbanp ! number of pfts in urban filter + integer, pointer :: nourbanp(:) ! non-urban filter (pfts) + integer :: num_nourbanp ! number of pfts in non-urban filter + + integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (pfts) + integer :: num_nolakeurbanp ! number of pfts in non-lake, non-urban filter + + integer, pointer :: icemecc(:) ! glacier mec filter (cols) + integer :: num_icemecc ! number of columns in glacier mec filter + + integer, pointer :: do_smb_c(:) ! glacier+bareland SMB calculations-on filter (cols) + integer :: num_do_smb_c ! number of columns in glacier+bareland SMB mec filter + + end type clumpfilter + public clumpfilter + + ! This is the standard set of filters, which should be used in most places in the code. + ! These filters only include 'active' points. + type(clumpfilter), allocatable, public :: filter(:) + + ! --- DO NOT USING THE FOLLOWING VARIABLE UNLESS YOU KNOW WHAT YOU'RE DOING! --- + ! + ! This is a separate set of filters that contains both inactive and active points. It is + ! rarely appropriate to use these, but they are needed in a few places, e.g., where + ! quantities are computed before weights, active flags and filters are updated due to + ! landuse change. Note that, for the handful of filters that are computed outside of + ! setFiltersOneGroup (including the CNDV natvegp filter and the snow filters), these + ! filters are NOT included in this variable - so they can only be used from the main + ! 'filter' variable. + ! + ! Ideally, we would like to restructure the initialization code and driver ordering so + ! that this version of the filters is never needed. At that point, we could remove this + ! filter_inactive_and_active variable, and simplify filterMod to look the way it did + ! before this variable was added (i.e., when there was only a single group of filters). + ! + type(clumpfilter), allocatable, public :: filter_inactive_and_active(:) + ! + public allocFilters ! allocate memory for filters + public setFilters ! set filters + public setExposedvegpFilter ! set the exposedvegp and noexposedvegp filters + + private allocFiltersOneGroup ! allocate memory for one group of filters + private setFiltersOneGroup ! set one group of filters + ! + ! !REVISION HISTORY: + ! Created by Mariana Vertenstein + ! 11/13/03, Peter Thornton: Added soilp and num_soilp + ! Jan/08, S. Levis: Added crop-related filters + ! June/13, Bill Sacks: Change main filters to just work over 'active' points; + ! add filter_inactive_and_active + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine allocFilters() + ! + ! !DESCRIPTION: + ! Allocate CLM filters. + ! + ! !REVISION HISTORY: + ! Created by Bill Sacks + !------------------------------------------------------------------------ + + call allocFiltersOneGroup(filter) + call allocFiltersOneGroup(filter_inactive_and_active) + + end subroutine allocFilters + + !------------------------------------------------------------------------ + subroutine allocFiltersOneGroup(this_filter) + ! + ! !DESCRIPTION: + ! Allocate CLM filters, for one group of filters. + ! + ! !USES: + use decompMod , only : get_proc_clumps, get_clump_bounds + ! + ! !ARGUMENTS: + type(clumpfilter), intent(inout), allocatable :: this_filter(:) ! the filter to allocate + ! + ! LOCAL VARAIBLES: + integer :: nc ! clump index + integer :: nclumps ! total number of clumps on this processor + integer :: ier ! error status + type(bounds_type) :: bounds + !------------------------------------------------------------------------ + + ! Determine clump variables for this processor + + nclumps = get_proc_clumps() + + ier = 0 + if( .not. allocated(this_filter)) then + allocate(this_filter(nclumps), stat=ier) + end if + if (ier /= 0) then + write(iulog,*) 'allocFiltersOneGroup(): allocation error for clumpsfilters' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Loop over clumps on this processor + +!$OMP PARALLEL DO PRIVATE (nc,bounds) + do nc = 1, nclumps + call get_clump_bounds(nc, bounds) + + allocate(this_filter(nc)%lakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%nolakep(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%nolakeurbanp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%lakec(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%nolakec(bounds%endc-bounds%begc+1)) + + allocate(this_filter(nc)%soilc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%soilp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%snowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%nosnowc(bounds%endc-bounds%begc+1)) + + allocate(this_filter(nc)%lakesnowc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%lakenosnowc(bounds%endc-bounds%begc+1)) + + allocate(this_filter(nc)%exposedvegp(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%noexposedvegp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%natvegp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%hydrologyc(bounds%endc-bounds%begc+1)) + + allocate(this_filter(nc)%urbanp(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%nourbanp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%urbanc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%nourbanc(bounds%endc-bounds%begc+1)) + + allocate(this_filter(nc)%urbanl(bounds%endl-bounds%begl+1)) + allocate(this_filter(nc)%nourbanl(bounds%endl-bounds%begl+1)) + + allocate(this_filter(nc)%pcropp(bounds%endp-bounds%begp+1)) + allocate(this_filter(nc)%soilnopcropp(bounds%endp-bounds%begp+1)) + + allocate(this_filter(nc)%icemecc(bounds%endc-bounds%begc+1)) + allocate(this_filter(nc)%do_smb_c(bounds%endc-bounds%begc+1)) + + end do +!$OMP END PARALLEL DO + + end subroutine allocFiltersOneGroup + + !------------------------------------------------------------------------ + subroutine setFilters(bounds, icemask_grc) + ! + ! !DESCRIPTION: + ! Set CLM filters. + use decompMod , only : BOUNDS_LEVEL_CLUMP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: icemask_grc( bounds%begg: ) ! ice sheet grid coverage mask [gridcell] + !------------------------------------------------------------------------ + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + + call setFiltersOneGroup(bounds, & + filter, include_inactive = .false., & + icemask_grc = icemask_grc(bounds%begg:bounds%endg)) + + ! At least as of June, 2013, the 'inactive_and_active' version of the filters is + ! static in time. Thus, we could have some logic saying whether we're in + ! initialization, and if so, skip this call. But this is problematic for two reasons: + ! (1) it requires that the caller of this routine (currently reweight_wrapup) know + ! whether it is in initialization; and (2) it assumes that the filter definitions + ! won't be changed in the future in a way that creates some variability in time. So + ! for now, it seems cleanest and safest to just update these filters whenever the main + ! filters are updated. But if this proves to be a performance problem, we could + ! introduce an argument saying whether we're in initialization, and if so, skip this + ! call. + + call setFiltersOneGroup(bounds, & + filter_inactive_and_active, include_inactive = .true., & + icemask_grc = icemask_grc(bounds%begg:bounds%endg)) + + end subroutine setFilters + + + !------------------------------------------------------------------------ + subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, icemask_grc ) + ! + ! !DESCRIPTION: + ! Set CLM filters for one group of filters. + ! + ! "Standard" filters only include active points. However, this routine can be used to set + ! alternative filters that also apply over inactive points, by setting include_inactive = + ! .true. + ! + ! This routine sets filters that are determined by subgrid type, "active" status of + ! patch, col or landunit, and the like. Filters based on model state (e.g., snow + ! cover) should generally be set elsewhere, to ensure that the routine that sets them + ! is called at the right time in the driver loop. + ! + ! !USES: + use decompMod , only : BOUNDS_LEVEL_CLUMP + use pftconMod , only : npcropmin + use landunit_varcon , only : istsoil, istcrop, istice_mec + use column_varcon , only : icol_road_perv + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(clumpfilter) , intent(inout) :: this_filter(:) ! the group of filters to set + logical , intent(in) :: include_inactive ! whether inactive points should be included in the filters + real(r8) , intent(in) :: icemask_grc( bounds%begg: ) ! ice sheet grid coverage mask [gridcell] + ! + ! LOCAL VARAIBLES: + integer :: nc ! clump index + integer :: c,l,p ! column, landunit, patch indices + integer :: fl ! lake filter index + integer :: fnl,fnlu ! non-lake filter index + integer :: fs ! soil filter index + integer :: f, fn ! general indices + integer :: g !gridcell index + !------------------------------------------------------------------------ + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(icemask_grc) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + + nc = bounds%clump_index + + ! Create lake and non-lake filters at column-level + + fl = 0 + fnl = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l =col%landunit(c) + if (lun%lakpoi(l)) then + fl = fl + 1 + this_filter(nc)%lakec(fl) = c + else + fnl = fnl + 1 + this_filter(nc)%nolakec(fnl) = c + end if + end if + end do + this_filter(nc)%num_lakec = fl + this_filter(nc)%num_nolakec = fnl + + ! Create lake and non-lake filters at patch-level + + fl = 0 + fnl = 0 + fnlu = 0 + do p = bounds%begp,bounds%endp + if (patch%active(p) .or. include_inactive) then + l =patch%landunit(p) + if (lun%lakpoi(l) ) then + fl = fl + 1 + this_filter(nc)%lakep(fl) = p + else + fnl = fnl + 1 + this_filter(nc)%nolakep(fnl) = p + if (.not. lun%urbpoi(l)) then + fnlu = fnlu + 1 + this_filter(nc)%nolakeurbanp(fnlu) = p + end if + end if + end if + end do + this_filter(nc)%num_lakep = fl + this_filter(nc)%num_nolakep = fnl + this_filter(nc)%num_nolakeurbanp = fnlu + + ! Create soil filter at column-level + + fs = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l =col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + this_filter(nc)%soilc(fs) = c + end if + end if + end do + this_filter(nc)%num_soilc = fs + + ! Create soil filter at patch-level + + fs = 0 + do p = bounds%begp,bounds%endp + if (patch%active(p) .or. include_inactive) then + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + this_filter(nc)%soilp(fs) = p + end if + end if + end do + this_filter(nc)%num_soilp = fs + + ! Create column-level hydrology filter (soil and Urban pervious road cols) + + f = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l =col%landunit(c) + if (lun%itype(l) == istsoil .or. col%itype(c) == icol_road_perv .or. & + lun%itype(l) == istcrop) then + f = f + 1 + this_filter(nc)%hydrologyc(f) = c + end if + end if + end do + this_filter(nc)%num_hydrologyc = f + + ! Create prognostic crop and soil w/o prog. crop filters at patch-level + ! according to where the crop model should be used + + fl = 0 + fnl = 0 + do p = bounds%begp,bounds%endp + if (patch%active(p) .or. include_inactive) then + if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types + fl = fl + 1 + this_filter(nc)%pcropp(fl) = p + else + l =patch%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fnl = fnl + 1 + this_filter(nc)%soilnopcropp(fnl) = p + end if + end if + end if + end do + this_filter(nc)%num_pcropp = fl + this_filter(nc)%num_soilnopcropp = fnl ! This wasn't being set before... + + ! Create landunit-level urban and non-urban filters + + f = 0 + fn = 0 + do l = bounds%begl,bounds%endl + if (lun%active(l) .or. include_inactive) then + if (lun%urbpoi(l)) then + f = f + 1 + this_filter(nc)%urbanl(f) = l + else + fn = fn + 1 + this_filter(nc)%nourbanl(fn) = l + end if + end if + end do + this_filter(nc)%num_urbanl = f + this_filter(nc)%num_nourbanl = fn + + ! Create column-level urban and non-urban filters + + f = 0 + fn = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l = col%landunit(c) + if (lun%urbpoi(l)) then + f = f + 1 + this_filter(nc)%urbanc(f) = c + else + fn = fn + 1 + this_filter(nc)%nourbanc(fn) = c + end if + end if + end do + this_filter(nc)%num_urbanc = f + this_filter(nc)%num_nourbanc = fn + + ! Create patch-level urban and non-urban filters + + f = 0 + fn = 0 + do p = bounds%begp,bounds%endp + if (patch%active(p) .or. include_inactive) then + l = patch%landunit(p) + if (lun%urbpoi(l)) then + f = f + 1 + this_filter(nc)%urbanp(f) = p + else + fn = fn + 1 + this_filter(nc)%nourbanp(fn) = p + end if + end if + end do + this_filter(nc)%num_urbanp = f + this_filter(nc)%num_nourbanp = fn + + f = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l = col%landunit(c) + if (lun%itype(l) == istice_mec) then + f = f + 1 + this_filter(nc)%icemecc(f) = c + end if + end if + end do + this_filter(nc)%num_icemecc = f + + f = 0 + do c = bounds%begc,bounds%endc + if (col%active(c) .or. include_inactive) then + l = col%landunit(c) + g = col%gridcell(c) + if ( lun%itype(l) == istice_mec .or. & + (lun%itype(l) == istsoil .and. icemask_grc(g) > 0.)) then + f = f + 1 + this_filter(nc)%do_smb_c(f) = c + end if + end if + end do + this_filter(nc)%num_do_smb_c = f + + ! Note: snow filters are reconstructed each time step in + ! LakeHydrology and SnowHydrology + ! Note: CNDV "pft present" filter is reconstructed each time CNDV is run + + end subroutine setFiltersOneGroup + + !----------------------------------------------------------------------- + subroutine setExposedvegpFilter(bounds, frac_veg_nosno) + ! + ! !DESCRIPTION: + ! Sets the exposedvegp and noexposedvegp filters for one clump. + ! + ! The exposedvegp filter includes points for which frac_veg_nosno > 0. noexposedvegp + ! includes points for which frac_veg_nosno <= 0. However, note that neither filter + ! includes urban or lake points! + ! + ! Should be called from within a loop over clumps. + ! + ! Only sets this filter in the main 'filter' variable, NOT in + ! filter_inactive_and_active. + ! + ! Note that this is done separately from the main setFilters routine, because it may + ! need to be called at a different time in the driver loop. + ! + ! !USES: + use decompMod , only : BOUNDS_LEVEL_CLUMP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: frac_veg_nosno( bounds%begp: ) ! fraction of vegetation not covered by snow [patch] + ! + ! !LOCAL VARIABLES: + integer :: nc ! clump index + integer :: fp ! filter index + integer :: p ! patch index + integer :: fe, fn ! filter counts + + character(len=*), parameter :: subname = 'setExposedvegpFilter' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(frac_veg_nosno) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + + nc = bounds%clump_index + + fe = 0 + fn = 0 + do fp = 1, filter(nc)%num_nolakeurbanp + p = filter(nc)%nolakeurbanp(fp) + if (frac_veg_nosno(p) > 0) then + fe = fe + 1 + filter(nc)%exposedvegp(fe) = p + else + fn = fn + 1 + filter(nc)%noexposedvegp(fn) = p + end if + end do + filter(nc)%num_exposedvegp = fe + filter(nc)%num_noexposedvegp = fn + + end subroutine setExposedvegpFilter + + +end module filterMod diff --git a/components/clm/src/main/findHistFields.pl b/components/clm/src/main/findHistFields.pl new file mode 100755 index 0000000000..4e0b0501c5 --- /dev/null +++ b/components/clm/src/main/findHistFields.pl @@ -0,0 +1,544 @@ +#!/usr/bin/env perl +# +# This perl script reads in the histFldsMod.F90 file to find the total list of history +# fields that can be added for this model version, regardless of namelist options, or +# CPP processing. +# +use strict; +#use warnings; +#use diagnostics; + +use Cwd; +use English; +use Getopt::Long; +use IO::File; +use File::Glob ':glob'; + +# Set the directory that contains the CLM configuration scripts. If the command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume +# the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script + # is in + # the user's PATH +my $cmdline = "@ARGV"; # Command line arguments to script +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +my $nm = "${ProgName}::"; # name to use if script dies +if ($ProgDir) { + $cfgdir = $ProgDir; +} else { + $cfgdir = $cwd; +} +# The namelist definition file contains entries for all namelist variables that +# can be output by build-namelist. +my $nl_definition_file = "$cfgdir/../../bld/namelist_files/namelist_definition_clm4_5.xml"; +(-f "$nl_definition_file") or die <<"EOF"; +** $ProgName - Cannot find namelist definition file \"$nl_definition_file\" ** +EOF +print "Using namelist definition file $nl_definition_file\n"; + +# The Build::NamelistDefinition module provides utilities to get the list of +# megan compounds + +#The root directory to cesm utils Tools +my $cesm_tools = "$cfgdir/../../../../cime/utils/"; + +(-f "$cesm_tools/perl5lib/Build/NamelistDefinition.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/NamelistDefinition.pm\" in directory + \"$cesm_tools/perl5lib\" ** +EOF +# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules +my @dirs = ( $cfgdir, "$cesm_tools/perl5lib"); +unshift @INC, @dirs; +require Build::NamelistDefinition; +# Create a namelist definition object. This object provides a method for verifying that +# the +# output namelist variables are in the definition file, and are output in the correct +# namelist groups. +my $definition = Build::NamelistDefinition->new($nl_definition_file); + + +my $mxname = 0; +my $mxlongn = 0; +my %fields; +my $fldnamevar = "fieldname_var"; + +sub matchKeyword { +# +# Match a keyword +# + my $keyword = shift; + my $line = shift; + my $fh = shift; + + my $match = undef; + if ( $line =~ /$keyword/ ) { + if ( $line =~ /$keyword\s*=\s*['"]([^'"]+)['"]/ ) { + $match = $1; + } elsif ( $line =~ /$keyword\s*=\s*&\s*$/ ) { + $line = <$fh>; + if ( $line =~ /^\s*['"]([^'"]+)['"]/ ) { + $match = $1; + } else { + die "ERROR: Trouble getting keyword string\n Line: $line"; + } + } else { + if ( $line =~ /fname\s*=\s*fieldname/ ) { + print STDERR "Found variable used for fieldname = $line\n"; + $match = $fldnamevar; + } elsif ( $line =~ /fname\s*=\s*trim\(fname\)/ ) { + $match = undef; + } elsif ( $line =~ /units\s*=\s*units/ ) { + $match = undef; + } elsif ( $line =~ /long_name\s*=\s*long_name/ ) { + $match = undef; + } elsif ( $line =~ /long_name\s*=\s*longname/ ) { + print STDERR "Found variable used for longname = $line\n"; + $match = "longname_var"; + } else { + die "ERROR: Still have a match on $keyword\n Line: $line"; + } + } + } + return( $match ); +} + +sub getFieldInfo { +# +# Get field Information +# + my $fh = shift; + my $line = shift; + + my $fname = undef; + my $units = undef; + my $longn = undef; + my $endin = undef; + do { + if ( $line =~ /MEG_/ ) { + $line =~ s|'//'_'|_'|g; + $line =~ s|'//trim\(meg_cmp\%name\)|megancmpd'|gi; + if ( $line =~ /meg_cmp\%name/ ) { + die "ERROR: Still have meg_cmp in a line\n"; + } + } + if ( ! defined($fname) ) { + $fname = &matchKeyword( "fname", $line, $fh ); + } + if ( ! defined($units) ) { + $units = &matchKeyword( "units", $line, $fh ); + } + if ( ! defined($longn) ) { + $longn = &matchKeyword( "long_name", $line, $fh ); + } + if ( $line =~ /\)\s*$/ ) { + $endin = 1; + } + if ( ! defined($endin) ) { $line = <$fh>; } + + } until( (defined($fname) && defined($units) && defined($longn)) || + ! defined($line) || defined($endin) ); + if ( ! defined($fname) ) { + die "ERROR: name undefined for field ending with: $line\n"; + } + return( $fname, $longn, $units ); +} + +sub setField { +# +# Set the field +# + my $name = shift; + my $longn = shift; + my $units = shift; + + if ( defined($name) && $name ne $fldnamevar ) { + if ( length($name) > $mxname ) { $mxname = length($name); } + if ( length($longn) > $mxlongn ) { $mxlongn = length($longn); } + my $len; + if ( length($longn) > 90 ) { + $len = 110; + } elsif ( length($longn) > 60 ) { + $len = 90; + } else { + $len = 60; + } + $fields{$name}{'field'} = sprintf( "%-${len}s\t(%s)", $longn, $units ); + $fields{$name}{'longn'} = $longn; + $fields{$name}{'units'} = $units; + } +} + +sub XML_Header { +# +# Write out header to history fields file +# + my $outfh = shift; + my $outfilename = shift; + my $filename = shift; + + print STDERR " Write out header to history fields file to: $outfilename\n"; + my $svnurl = '$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_0_40/models/lnd/clm/src/main/findHistFields.pl $'; + my $svnid = '$Id: findHistFields.pl 34757 2012-02-15 18:38:05Z erik $'; + print $outfh <<"EOF"; + + +\<\?xml-stylesheet type="text\/xsl" href="history_fields.xsl"\?\> + +\<\!-- + List of history file field names, long-names and units for all the fields output + by CLM. This was created by reading in the file: $filename + SVN version information: + $svnurl + $svnid +--\> + +\ +EOF +} + +sub XML_Footer { +# +# Write out footer to history fields file +# + my $outfh = shift; + + print STDERR " Write out footer to history fields file\n"; + print $outfh "\n\n"; +} + +my $pwd = `pwd`; +chomp( $pwd ); +my @megcmpds = $definition->get_valid_values( "megan_cmpds", 'noquotes'=>1 ); +my @filenames = ( + "$pwd/../biogeochem/ch4Mod.F90", + "$pwd/../biogeochem/CNDVType.F90", + "$pwd/../biogeochem/CNFireMod.F90", + "$pwd/../biogeochem/CNVegCarbonFluxType.F90", + "$pwd/../biogeochem/CNVegCarbonStateType.F90", + "$pwd/../biogeochem/CNVegNitrogenFluxType.F90", + "$pwd/../biogeochem/CNVegNitrogenStateType.F90", + "$pwd/../biogeochem/CNVegStateType.F90", + "$pwd/../biogeochem/CropType.F90", + "$pwd/../biogeochem/DUSTMod.F90", + "$pwd/../biogeochem/VOCEmissionMod.F90", + "$pwd/../biogeophys/AerosolMod.F90", + "$pwd/../biogeophys/CanopyStateType.F90", + "$pwd/../biogeophys/EnergyFluxType.F90", + "$pwd/../biogeophys/FrictionVelocityMod.F90", + "$pwd/../biogeophys/HumanIndexMod.F90", + "$pwd/../biogeophys/IrrigationMod.F90", + "$pwd/../biogeophys/LakeStateType.F90", + "$pwd/../biogeophys/OzoneMod.F90", + "$pwd/../biogeophys/PhotosynthesisMod.F90", + "$pwd/../biogeophys/SoilHydrologyType.F90", + "$pwd/../biogeophys/SoilStateType.F90", + "$pwd/../biogeophys/SolarAbsorbedType.F90", + "$pwd/../biogeophys/SurfaceAlbedoType.F90", + "$pwd/../biogeophys/SurfaceRadiationMod.F90", + "$pwd/../biogeophys/TemperatureType.F90", + "$pwd/../biogeophys/WaterfluxType.F90", + "$pwd/../biogeophys/WaterStateType.F90", + "$pwd/atm2lndType.F90", + "$pwd/clm_initializeMod.F90", + "$pwd/glc2lndMod.F90", + "$pwd/glcDiagnosticsMod.F90", + "$pwd/histFileMod.F90", + "$pwd/lnd2atmType.F90", + "$pwd/lnd2glcMod.F90", + "$pwd/subgridWeightsMod.F90", + "$pwd/../soilbiogeochem/SoilBiogeochemCarbonFluxType.F90", + "$pwd/../soilbiogeochem/SoilBiogeochemCarbonStateType.F90", + "$pwd/../soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90", + "$pwd/../soilbiogeochem/SoilBiogeochemNitrogenStateType.F90", + "$pwd/../soilbiogeochem/SoilBiogeochemStateType.F90", + ); + +# +# Loop over all files that have hist_addfld calls in them +# +foreach my $filename ( @filenames ) { + + my $fh = IO::File->new($filename, '<') or die "** $ProgName - can't open history Fields file: $filename\n"; + # + # Read in the list of fields from the source file + # + while (my $line = <$fh>) { + + # Comments + if ($line =~ /(.*)\!/) { + $line = $1; + } + if ($line =~ /end subroutine/) { + last; + } + my $format = "\n\n"; + if ($line =~ /call\s*hist_addfld/i ) { + (my $name, my $longn, my $units) = &getFieldInfo( $fh, $line ); + if ( $name ne "MEG_megancmpd" ) { + &setField( $name, $longn, $units ); + printf( , $format, $name, $units, $longn ); + } else { + foreach my $megcmpd ( @megcmpds ) { + my $name = "MEG_${megcmpd}"; + &setField( $name, $longn, $units ); + printf( , $format, $name, $units, $longn ); + } + } + } + } + close( $fh ); +} +print STDERR " mxname = $mxname\n"; +print STDERR " mxlongn = $mxlongn\n"; +my %pool_name = ( + L1=> { hist=>'LITR1', long=>'litter 1' }, + L2=> { hist=>'LITR2', long=>'litter 2' }, + L3=> { hist=>'LITR3', long=>'litter 3' }, + CWD=>{ hist=>'CWD', long=>'coarse woody debris' }, + S1=> { hist=>'SOIL1', long=>'soil 1' }, + S2=> { hist=>'SOIL2', long=>'soil 2' }, + S3=> { hist=>'SOIL3', long=>'soil 3' }, + S4=> { hist=>'SOIL4', long=>'soil 4' }, + atm=>{ hist=>'atmosphere', long=>'atmosphere' }, + ); + +my %vrt_suffix = ( C=>" C", "C_vr"=>" C (vertically resolved)", C_1m=>" C to 1 meter", + C_30cm=>" C to 30 cm", C_activelayer=>" C in active layer", + N=>" C", "N_vr"=>" N (vertically resolved)", N_1m=>" N to 1 meter", + N_30cm=>" N to 30 cm", N_activelayer=>" N in active layer", + ); +my %firelist = ( + C_TO_FIRE=>" C fire loss", C_TO_FIRE_vr=>" C fire loss", + N_TO_FIRE=>" N fire loss", N_TO_FIRE_vr=>" N fire loss", + ); +my %leechlist = ( + C_TO_LEACHING=>" C leaching loss", C_TNDNCY_VERT_TRANSPORT=>" C tendency due to vertical transport", + N_TO_LEACHING=>" N leaching loss", N_TNDNCY_VERT_TRANSPORT=>" N tendency due to vertical transport", + ); +# +# Add fields that are looped over +# +my $name, my $longn, my $units; +foreach my $pool ( keys(%pool_name) ) { + my $fname = $pool_name{$pool}{'hist'}; + foreach my $fld ( keys(%vrt_suffix) ) { + $name = $fname . $fld; + $longn = $pool_name{$pool}{'hist'} . $vrt_suffix{$fld}; + $units; + if ( $fld eq "C_vr" ) { + $units = "gC/m^3"; + } elsif ( $fld eq "N_vr" ) { + $units = "gN/m^3"; + } elsif ( $fld =~ /^N/) { + $units = "gN/m^2"; + } else { + $units = "gC/m^2"; + } + &setField( $name, $longn, $units ); + if ( $fld eq "C" || $fld eq "C_vr" ) { + foreach my $ciso ( "C13", "C14" ) { + $name = $ciso."_".$fname . $fld; + $longn = $ciso." ".$pool_name{$pool}{'long'} . $vrt_suffix{$fld}; + if ( $fld eq "C_vr" ) { + $units = "g${ciso}m^3"; + } else { + $units = "g${ciso}/m^2"; + } + &setField( $name, $longn, $units ); + } + } + if ( $fld =~ "C_1m" || $fld eq "C_30m" || $fld eq "C_activelayer" ) { + foreach my $ciso ( "C14" ) { + $name = $ciso."_".$fname . $fld; + $longn = $ciso." ".$pool_name{$pool}{'long'} . $vrt_suffix{$fld}; + $units = "g${ciso}/m^2"; + &setField( $name, $longn, $units ); + } + } + } + # Fire list + if ( $fname =~ /^CWD/ || $fname =~ /^LIT/ ) { + foreach my $fld ( keys(%firelist) ) { + $name = "M_".$fname . $fld; + $longn = $firelist{$fname}; + $units; + if ( $fld =~ /_vr$/ ) { + $units = "gC/m^3"; + } else { + $units = "gC/m^2"; + } + &setField( $name, $longn, $units ); + # Carbon isotopes (C13/C14) + if ( $fld =~ /^C/ ) { + foreach my $ciso ( "C13", "C14" ) { + $name = "${ciso}_M_".$fname . $fld; + $longn = $ciso.$firelist{$fname}; + if ( $fld =~ /_vr$/ ) { + $units = "g${ciso}/m^3"; + } else { + $units = "g${ciso}/m^2"; + } + &setField( $name, $longn, $units ); + } + } + } + } + # Potential loss coefficient + $name = "K_".$fname; + $longn = $pool_name{$pool}{'long'} . " potential loss coefficient"; + $units = "1/s"; + &setField( $name, $longn, $units ); + # + # Not CWD + # + if ( $fname !~ /^CWD/ ) { + foreach my $fld ( keys(%leechlist) ) { + $name = "M_".$fname . $fld; + $longn = $leechlist{$fname}; + my $elm; + if ( $fld =~ /^N/ ) { + $elm = "N"; + } else { + $elm = "C"; + } + if ( $fld =~ /VERT$/ ) { + $units = "g${elm}/m^3"; + } else { + $units = "g${elm}/m^2"; + } + &setField( $name, $longn, $units ); + } + } +} +my %translist = ( + # CN transitions + L1S1 =>{d=>"L1", r=>"S1"}, L2S2 =>{d=>"L2", r=>"S2"}, + L3S3 =>{d=>"L3", r=>"S3"}, S1S2 =>{d=>"S1", r=>"S2"}, + S2S3 =>{d=>"S2", r=>"S3"}, S3S4 =>{d=>"S3", r=>"S4"}, + S4 =>{d=>"S4", r=>"atm"}, + CWDL2=>{d=>"CWD", r=>"L2"}, CWDL3=>{d=>"CWD", r=>"L3"}, + # CENTURY transitions NOT already given above + L2S1 =>{d=>"L2", r=>"S1"}, L3S2 =>{d=>"L3", r=>"S2"}, + S1S3 =>{d=>"S1", r=>"S3"}, S2S1 =>{d=>"S2", r=>"S1"}, + S3S1 =>{d=>"S3", r=>"S1"}, + ); +# +# Transition list (NOT complete) +# +my $unitsvr; +foreach my $trans ( keys(%translist) ) { + my $donor = $translist{$trans}{'d'}; + my $rcvr = $translist{$trans}{'r'}; + if ( $trans ne "${donor}${rcvr}" && ($rcvr ne "atm" || $trans ne $donor) ) { + die "ERROR: Either bad transition name: $trans or bad donor: $donor or receiver: +$rcvr\n"; + } + # Carbon isotopes + foreach my $ciso ( "", "C13", "C14" ) { + if ( $ciso eq "" ) { + $units = "gC/m^2/s"; + $unitsvr = "gC/m^3/s"; + } else { + $units = "g${ciso}/m^2/s"; + $unitsvr = "g${ciso}/m^3/s"; + } + if ( $donor ne "CWD" ) { + my $ii = 0; + foreach my $trans2 ( keys(%translist) ) { + if ($donor eq $translist{$trans}{'d'} ) { $ii = $ii + 1; } + } + # HR + if ( $ii == 1 ) { + $name = $pool_name{$donor}{'hist'}."_HR"; + } else { + $name = $pool_name{$donor}{'hist'}."_HR_$rcvr"; + } + if ( $ciso ne "" ) { + $name = "${ciso}$name"; + } + $longn = 'Het. Resp. from '.$pool_name{$donor}{'long'}; + # vertically integrated fluxes + &setField( $name, $longn, $units ); + # vertically resolved version + &setField( "${name}_vr", $longn, $unitsvr ); + } + if ( $rcvr ne "atm" ) { + # transfer + $name = $pool_name{$donor}{'hist'}. "C_TO_" . + $pool_name{$rcvr}{'hist'}. "C"; + $longn = "decomp of " . $pool_name{$donor}{'long'}. " C to " . + $pool_name{$rcvr}{'long'}. " C"; + if ( $ciso ne "" ) { + $name = "${ciso}$name"; + } + # vertically integrated fluxes + &setField( $name, $longn, $units ); + # vertically resolved version + &setField( "${name}_vr", $longn, $unitsvr ); + } + } + + #-- mineralization/immobilization fluxes (none from CWD) + if ( $donor ne "CWD" ) { + $units = "gN/m^2/s"; + $unitsvr = "gN/m^3/s"; + if ( $rcvr ne "atm" ) { + $name = "SMINN_TO_".$pool_name{$rcvr}{'hist'}. "N_$donor"; + } else { + $name = $pool_name{$donor}{'hist'}. "N_TO_SMINN"; + } + $longn = "mineral N flux for decomp. of " . $pool_name{$donor}{'hist'}; + # vertically integrated fluxes + &setField( $name, $longn, $units ); + # vertically resolved fluxes + &setField( "${name}_vr", $longn, $unitsvr ); + # transfer fluxes + if ( $rcvr ne "atm" ) { + $name = $pool_name{$donor}{'hist'}. "N_TO_" . + $pool_name{$rcvr}{'hist'}. "N"; + $longn = "decomp of " . $pool_name{$donor}{'long'}. " N to " . + $pool_name{$rcvr}{'long'}. " N"; + # vertically integrated fluxes + &setField( $name, $longn, $units ); + # vertically resolved fluxes + &setField( "${name}_vr", $longn, $unitsvr ); + } + # NITRIF_DENITRIF + $name = "SMINN_TO_DENIT_$trans"; + $longn = "denitrification for decomp. of " . $pool_name{$donor}{'long'} . + "to ". $pool_name{$rcvr}{'hist'}; + &setField( $name, $longn, "gN/m^2" ); + # vertically resolved fluxes + &setField( "${name}_vr", $longn, "gN/m^3" ); + } +} + +# +# List the fields in a neatly ordered list +# And Output to an XML file +# +my $outfilename = "$pwd/../../bld/namelist_files/history_fields_clm4_5.xml"; + +my $outfh = IO::File->new($outfilename, '>') or die "** $ProgName - can't open output history Fields XML file: $outfilename\n"; +foreach my $filename ( @filenames ) { +&XML_Header( $outfh, $outfilename, $filename ); +foreach my $name ( sort(keys(%fields)) ) { + my $len; + if ( length($name) > 20 ) { + $len = 40; + } else { + $len = 20; + } + printf( "%-${len}s = %s\n", $name, $fields{$name}{'field'} ); + printf( $outfh "\n\n", + $name, $fields{$name}{'units'}, $fields{$name}{'longn'} ); +} +} + +&XML_Footer( $outfh ); +close( $outfh ); diff --git a/components/clm/src/main/glc2lndMod.F90 b/components/clm/src/main/glc2lndMod.F90 new file mode 100644 index 0000000000..0fe96fb620 --- /dev/null +++ b/components/clm/src/main/glc2lndMod.F90 @@ -0,0 +1,501 @@ +module glc2lndMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle arrays used for exchanging data from glc to clm. + ! For now glc datais send and received on the lnd decomposition and grid. + ! + ! The fields sent from the lnd component to the glc component via + ! the coupler are labeled 's2x', or sno to coupler. + ! The fields received by the lnd component from the glc component + ! via the coupler are labeled 'x2s', or coupler to sno. + ! 'Sno' is a misnomer in that the exchanged data are related to + ! the ice beneath the snow, not the snow itself. But by CESM convention, + ! 'ice' refers to sea ice, not land ice. + ! + ! !USES: + use decompMod , only : bounds_type + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : maxpatch_glcmec + use clm_varctl , only : iulog, glc_smb + use abortutils , only : endrun + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !REVISION HISTORY: + ! Created by William Lipscomb, Dec. 2007, based on clm_atmlnd.F90. + ! + ! !PUBLIC TYPES: + implicit none + private + save + + ! glc -> land variables structure + type, public :: glc2lnd_type + + real(r8), pointer :: frac_grc (:,:) => null() + real(r8), pointer :: topo_grc (:,:) => null() + real(r8), pointer :: hflx_grc (:,:) => null() + + ! Total ice sheet grid coverage mask (0-1) + ! (true ice sheet mask, received from glc, in contrast to glcmask, which is just a + ! guess available at initialization) + real(r8), pointer :: icemask_grc (:) => null() + + ! icemask_coupled_fluxes_grc is like icemask_grc, but the mask only contains icesheet + ! points that potentially send non-zero fluxes to the coupler. i.e., it does not + ! contain icesheets that are diagnostic only, because for those diagnostic ice sheets + ! (which do not send calving fluxes to the coupler), we need to use the non-dynamic + ! form of runoff routing in CLM in order to conserve water properly. + ! + ! (However, note that this measure of "diagnostic-only" does not necessarily + ! correspond to whether CLM is updating its glacier areas there - for example, we + ! could theoretically have an icesheet whose areas are evolving, and CLM is updating + ! its glacier areas to match, but where we're zeroing out the fluxes sent to the + ! coupler, and so we're using the non-dynamic form of runoff routing in CLM.) + real(r8), pointer :: icemask_coupled_fluxes_grc (:) => null() + + ! Where we should do runof routing that is appropriate for having a dynamic icesheet underneath. + logical , pointer :: glc_dyn_runoff_routing_grc (:) => null() + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, public :: update_glc2lnd + + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + procedure, private :: check_glc2lnd_icemask ! sanity-check icemask from GLC + procedure, private :: check_glc2lnd_icemask_coupled_fluxes ! sanity-check icemask_coupled_fluxes from GLC + procedure, private :: update_glc2lnd_dyn_runoff_routing ! update glc_dyn_runoff_routing field based on input from GLC + procedure, private :: update_glc2lnd_fracs ! update subgrid fractions based on input from GLC + procedure, private :: update_glc2lnd_topo ! update column-level topographic heights based on input from GLC + + end type glc2lnd_type + + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(glc2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize glc variables required by the land + ! + ! !ARGUMENTS: + class (glc2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg,endg + !------------------------------------------------------------------------ + + begg = bounds%begg; endg = bounds%endg + + allocate(this%frac_grc (begg:endg,0:maxpatch_glcmec)) ; this%frac_grc (:,:) = nan + allocate(this%topo_grc (begg:endg,0:maxpatch_glcmec)) ; this%topo_grc (:,:) = nan + allocate(this%hflx_grc (begg:endg,0:maxpatch_glcmec)) ; this%hflx_grc (:,:) = nan + allocate(this%icemask_grc (begg:endg)) ; this%icemask_grc (:) = nan + allocate(this%icemask_coupled_fluxes_grc (begg:endg)) ; this%icemask_coupled_fluxes_grc (:) = nan + allocate(this%glc_dyn_runoff_routing_grc (begg:endg)) ; this%glc_dyn_runoff_routing_grc (:) = .false. + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod, only : hist_addfld1d + use clm_varcon , only : spval + ! + ! !ARGUMENTS: + class(glc2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg, endg + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + begg = bounds%begg + endg = bounds%endg + + if (maxpatch_glcmec > 0) then + this%icemask_grc(begg:endg) = spval + call hist_addfld1d (fname='ICE_MASK', units='unitless', & + avgflag='I', long_name='Ice sheet mask coverage', & + ptr_gcell=this%icemask_grc) + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + class(glc2lnd_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg, endg + + character(len=*), parameter :: subname = 'InitCold' + !----------------------------------------------------------------------- + + begg = bounds%begg + endg = bounds%endg + + this%frac_grc(begg:endg, :) = 0.0_r8 + this%topo_grc(begg:endg, :) = 0.0_r8 + this%hflx_grc(begg:endg, :) = 0.0_r8 + + ! glcmask (from a file) provides a rough guess of the icemask (from CISM); thus, in + ! initialization, set icemask equal to glcmask; icemask will later get updated at + ! the start of the run loop, as soon as we have data from CISM + this%icemask_grc(begg:endg) = ldomain%glcmask(begg:endg) + + ! initialize icemask_coupled_fluxes to 0; this seems safest in case we aren't coupled + ! to CISM (to ensure that we use the uncoupled form of runoff routing) + this%icemask_coupled_fluxes_grc(begg:endg) = 0.0_r8 + + call this%update_glc2lnd_dyn_runoff_routing(bounds) + + end subroutine InitCold + + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write glc2lnd information to/from restart file. + ! + ! !USES: + use ncdio_pio , only : ncd_double, file_desc_t + use decompMod , only : bounds_type + use restUtilMod + ! + ! !ARGUMENTS: + class(glc2lnd_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + ! + ! !LOCAL VARIABLES: + logical :: readvar ! determine if variable is on initial file + + character(len=*), parameter :: subname = 'Restart' + !----------------------------------------------------------------------- + + call restartvar(ncid=ncid, flag=flag, varname='icemask', xtype=ncd_double, & + dim1name='gridcell', & + long_name='total ice-sheet grid coverage mask', units='fraction', & + interpinic_flag='skip', readvar=readvar, data=this%icemask_grc) + + end subroutine Restart + + + !----------------------------------------------------------------------- + subroutine update_glc2lnd(this, bounds) + ! + ! !DESCRIPTION: + ! Update values to derived-type CLM variables based on input from GLC (via the coupler) + ! + ! icemask, icemask_coupled_fluxes, glc_dyn_runoff_routing, and topo are always updated + ! (although note that this routine should only be called when + ! create_glacier_mec_landunit is true, or some similar condition; this should be + ! controlled in a conditional around the call to this routine); fracs are updated if + ! glc_do_dynglacier is true + ! + ! !USES: + use clm_varctl , only : glc_do_dynglacier + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'update_glc2lnd' + !----------------------------------------------------------------------- + + ! Note that nothing is needed to update icemask or icemask_coupled_fluxes here, + ! because these values have already been set in lnd_import_export. However, we do + ! some sanity-checking of those fields here. + call this%check_glc2lnd_icemask(bounds) + call this%check_glc2lnd_icemask_coupled_fluxes(bounds) + + call this%update_glc2lnd_dyn_runoff_routing(bounds) + + if (glc_do_dynglacier) then + call this%update_glc2lnd_fracs(bounds) + end if + + call this%update_glc2lnd_topo(bounds) + + end subroutine update_glc2lnd + + !----------------------------------------------------------------------- + subroutine check_glc2lnd_icemask(this, bounds) + ! + ! !DESCRIPTION: + ! Do a sanity check on the icemask received from CISM via coupler. + ! + ! !USES: + use domainMod , only : ldomain + use clm_varcon, only : nameg + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + + character(len=*), parameter :: subname = 'check_glc2lnd_icemask' + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + + ! Ensure that icemask is a subset of glcmask. This is needed because we allocated + ! memory based on glcmask, so it is a problem if the ice sheet tries to expand + ! beyond the area defined by glcmask. + + if (this%icemask_grc(g) > 0._r8 .and. ldomain%glcmask(g) == 0._r8) then + write(iulog,*) subname//' ERROR: icemask must be a subset of glcmask.' + write(iulog,*) 'You can fix this problem by adding more grid cells' + write(iulog,*) 'to the mask defined by the fglcmask file.' + write(iulog,*) '(Change grid cells to 1 everywhere that CISM can operate.)' + call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine check_glc2lnd_icemask + + !----------------------------------------------------------------------- + subroutine check_glc2lnd_icemask_coupled_fluxes(this, bounds) + ! + ! !DESCRIPTION: + ! Do a sanity check on the icemask_coupled_fluxes field received from CISM via coupler. + ! + ! !USES: + use clm_varcon, only : nameg + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + + character(len=*), parameter :: subname = 'check_glc2lnd_icemask_coupled_fluxes' + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + + ! Ensure that icemask_coupled_fluxes is a subset of icemask. Although there + ! currently is no code in CLM that depends on this relationship, it seems helpful + ! to ensure that this intuitive relationship holds, so that code developed in the + ! future can rely on it. + + if (this%icemask_coupled_fluxes_grc(g) > 0._r8 .and. this%icemask_grc(g) == 0._r8) then + write(iulog,*) subname//' ERROR: icemask_coupled_fluxes must be a subset of icemask.' + call endrun(decomp_index=g, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine check_glc2lnd_icemask_coupled_fluxes + + !----------------------------------------------------------------------- + subroutine update_glc2lnd_dyn_runoff_routing(this, bounds) + ! + ! !DESCRIPTION: + ! Update glc_dyn_runoff_routing field based on updated icemask_coupled_fluxes field + ! + ! !USES: + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + + character(len=*), parameter :: subname = 'update_glc2lnd_dyn_runoff_routing' + !----------------------------------------------------------------------- + + ! Wherever we have an icesheet that is computing and sending fluxes to the coupler - + ! which particularly means it is computing a calving flux - we will use the + ! "glc_dyn_runoff_routing" scheme. In other places - including places where CISM is + ! not running at all, as well as places where CISM is running in diagnostic-only mode + ! and therefore is not sending a calving flux - we use the alternative + ! glc_dyn_runoff_routing=false scheme. This is needed to conserve water correctly in + ! the absence of a calving flux. + + do g = bounds%begg, bounds%endg + if (this%icemask_coupled_fluxes_grc(g) > 0._r8) then + this%glc_dyn_runoff_routing_grc(g) = .true. + else + this%glc_dyn_runoff_routing_grc(g) = .false. + end if + end do + + end subroutine update_glc2lnd_dyn_runoff_routing + + + + !----------------------------------------------------------------------- + subroutine update_glc2lnd_fracs(this, bounds) + ! + ! !DESCRIPTION: + ! Update subgrid fractions based on input from GLC (via the coupler) + ! + ! The weights updated here are some col%wtlunit and lun%wtgcell values + ! + ! !USES: + use clm_varcon , only : ispval + use landunit_varcon , only : istice_mec + use column_varcon , only : col_itype_to_icemec_class + use subgridWeightsMod , only : set_landunit_weight + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: g,c ! indices + real(r8):: area_ice_mec ! area of the ice_mec landunit + integer :: l_ice_mec ! index of the ice_mec landunit + integer :: icemec_class ! current icemec class (1..maxpatch_glcmec) + logical :: frac_assigned(1:maxpatch_glcmec) ! whether this%frac has been assigned for each elevation class + logical :: error ! if an error was found + + character(len=*), parameter :: subname = 'update_glc2lnd_fracs' + !----------------------------------------------------------------------- + + do g = bounds%begg, bounds%endg + ! Values from GLC are only valid within the icemask, so we only update CLM's areas there + if (this%icemask_grc(g) > 0._r8) then + + ! Set total icemec landunit area + area_ice_mec = sum(this%frac_grc(g, 1:maxpatch_glcmec)) + call set_landunit_weight(g, istice_mec, area_ice_mec) + + ! If new landunit area is greater than 0, then update column areas + ! (If new landunit area is 0, col%wtlunit is arbitrary, so we might as well keep the existing values) + if (area_ice_mec > 0) then + ! Determine index of the glc_mec landunit + l_ice_mec = grc%landunit_indices(istice_mec, g) + if (l_ice_mec == ispval) then + write(iulog,*) subname//' ERROR: no ice_mec landunit found within the icemask, for g = ', g + call endrun() + end if + + frac_assigned(1:maxpatch_glcmec) = .false. + do c = lun%coli(l_ice_mec), lun%colf(l_ice_mec) + icemec_class = col_itype_to_icemec_class(col%itype(c)) + col%wtlunit(c) = this%frac_grc(g, icemec_class) / lun%wtgcell(l_ice_mec) + frac_assigned(icemec_class) = .true. + end do + + ! Confirm that all elevation classes that have non-zero area according to + ! this%frac have been assigned to a column in CLM's data structures + error = .false. + do icemec_class = 1, maxpatch_glcmec + if (this%frac_grc(g, icemec_class) > 0._r8 .and. & + .not. frac_assigned(icemec_class)) then + error = .true. + end if + end do + if (error) then + write(iulog,*) subname//' ERROR: at least one glc_mec column has non-zero area from the coupler,' + write(iulog,*) 'but there was no slot in memory for this column; g = ', g + write(iulog,*) 'this%frac_grc(g, 1:maxpatch_glcmec) = ', & + this%frac_grc(g, 1:maxpatch_glcmec) + write(iulog,*) 'frac_assigned(1:maxpatch_glcmec) = ', & + frac_assigned(1:maxpatch_glcmec) + call endrun() + end if ! error + end if ! area_ice_mec > 0 + end if ! this%icemask_grc(g) > 0 + end do ! g + + end subroutine update_glc2lnd_fracs + + !----------------------------------------------------------------------- + subroutine update_glc2lnd_topo(this, bounds) + ! + ! !DESCRIPTION: + ! Update column-level topographic heights based on input from GLC (via the coupler) + ! + ! !USES: + use landunit_varcon , only : istice_mec + use column_varcon , only : col_itype_to_icemec_class + ! + ! !ARGUMENTS: + class(glc2lnd_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: c, l, g ! indices + integer :: icemec_class ! current icemec class (1..maxpatch_glcmec) + + character(len=*), parameter :: subname = 'update_glc2lnd_topo' + !----------------------------------------------------------------------- + + ! It is tempting to use the do_smb_c filter here, since we only need glc_topo inside + ! this filter. But the problem with using the filter is that this routine is called + ! before the filters are updated to reflect the updated weights. As long as + ! glacier_mec, natural veg and any other landunit within the smb filter are always + ! active, regardless of their weights, this isn't a problem. But we don't want to + ! build in assumptions that those rules will be in place regarding active flags. + ! Other ways around this problem would be: + ! (1) Use the inactive_and_active filter - but we're trying to avoid use of that + ! filter if possible, because it can be confusing + ! (2) Call this topo update routine later in the driver loop, after filters have been + ! updated - but that leads to greater complexity in the driver loop. + ! So it seems simplest just to take the minor performance hit of setting glc_topo + ! over all columns, even those outside the do_smb_c filter. + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + g = col%gridcell(c) + + ! Values from GLC are only valid within the icemask, so we only update CLM's topo values there + if (this%icemask_grc(g) > 0._r8) then + if (lun%itype(l) == istice_mec) then + icemec_class = col_itype_to_icemec_class(col%itype(c)) + else + ! If not on a glaciated column, assign topography to the bare-land value determined by GLC. + icemec_class = 0 + end if + + col%glc_topo(c) = this%topo_grc(g, icemec_class) + end if + end do + + end subroutine update_glc2lnd_topo + +end module glc2lndMod + diff --git a/components/clm/src/main/glcDiagnosticsMod.F90 b/components/clm/src/main/glcDiagnosticsMod.F90 new file mode 100644 index 0000000000..2b26a2008c --- /dev/null +++ b/components/clm/src/main/glcDiagnosticsMod.F90 @@ -0,0 +1,185 @@ +module glcDiagnosticsMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Computes and outputs a number of glacier-related diagnostic quantities + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: glc_diagnostics_type + private + + real(r8), pointer :: gris_mask_grc (:) ! Greenland ice sheet mask + real(r8), pointer :: gris_area_grc (:) ! Greenland ice-covered area per gridcell (km^2) + real(r8), pointer :: aais_mask_grc (:) ! Antarctic ice sheet mask + real(r8), pointer :: aais_area_grc (:) ! Antarctic ice-covered area per gridcell (km^2) + + contains + + procedure, public :: Init + + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: calc_timeconst_diagnostics ! calculate time-constant diagnostics (which can be computed once, at initialization) + + end type glc_diagnostics_type + + !------------------------------------------------------------------------ + +contains + + !----------------------------------------------------------------------- + subroutine Init(this, bounds) + ! !ARGUMENTS: + class(glc_diagnostics_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'Init' + !----------------------------------------------------------------------- + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + + call this%calc_timeconst_diagnostics(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds) + ! !ARGUMENTS: + class(glc_diagnostics_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! LOCAL VARAIBLES: + integer :: begg, endg + + character(len=*), parameter :: subname = 'InitAllocate' + !----------------------------------------------------------------------- + + begg = bounds%begg; endg=bounds%endg + + allocate(this%gris_mask_grc (begg:endg)) ; this%gris_mask_grc (:) = nan + allocate(this%gris_area_grc (begg:endg)) ; this%gris_area_grc (:) = nan + allocate(this%aais_mask_grc (begg:endg)) ; this%aais_mask_grc (:) = nan + allocate(this%aais_area_grc (begg:endg)) ; this%aais_area_grc (:) = nan + + end subroutine InitAllocate + + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use clm_varctl , only : create_glacier_mec_landunit + use histFileMod , only: hist_addfld1d + use clm_varcon , only : spval + ! + ! !ARGUMENTS: + class(glc_diagnostics_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg, endg + + character(len=*), parameter :: subname = 'InitHistory' + !----------------------------------------------------------------------- + + begg = bounds%begg + endg = bounds%endg + + if (create_glacier_mec_landunit) then + + this%gris_mask_grc(begg:endg) = spval + call hist_addfld1d (fname='gris_mask', units='unitless', & + avgflag='A', long_name='Greenland mask', & + ptr_gcell= this%gris_mask_grc) + + this%gris_area_grc(begg:endg) = spval + call hist_addfld1d (fname='gris_area', units='km^2', & + avgflag='A', long_name='Greenland ice area', & + ptr_gcell= this%gris_area_grc) + + this%aais_mask_grc(begg:endg) = spval + call hist_addfld1d (fname='aais_mask', units='unitless', & + avgflag='A', long_name='Antarctic mask', & + ptr_gcell= this%aais_mask_grc) + + this%aais_area_grc(begg:endg) = spval + call hist_addfld1d (fname='aais_area', units='km^2', & + avgflag='A', long_name='Antarctic ice area', & + ptr_gcell= this%aais_area_grc) + + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine calc_timeconst_diagnostics(this, bounds) + ! + ! !DESCRIPTION: + ! Calculate time-constant glacier-related diagnostic fields (this only needs to be + ! called once, at initialization) + ! + ! !USES: + use domainMod, only : ldomain + ! + ! !ARGUMENTS: + class(glc_diagnostics_type), intent(inout) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: gdc ! gridcell index + + character(len=*), parameter :: subname = 'calc_timeconst_diagnostics' + !----------------------------------------------------------------------- + + do gdc = bounds%begg, bounds%endg + + ! Make ice sheet masks + + this%gris_mask_grc(gdc) = 0._r8 + this%gris_area_grc(gdc) = 0._r8 + this%aais_mask_grc(gdc) = 0._r8 + this%aais_area_grc(gdc) = 0._r8 + + ! Greenland mask + if ( (ldomain%latc(gdc) > 58. .and. ldomain%latc(gdc) <= 67. .and. & + ldomain%lonc(gdc) > 302. .and. ldomain%lonc(gdc) < 330.) & + .or. & + (ldomain%latc(gdc) > 67. .and. ldomain%latc(gdc) <= 70. .and. & + ldomain%lonc(gdc) > 300. .and. ldomain%lonc(gdc) < 345.) & + .or. & + (ldomain%latc(gdc) > 70. .and. ldomain%latc(gdc) <= 75. .and. & + ldomain%lonc(gdc) > 295. .and. ldomain%lonc(gdc) < 350.) & + .or. & + (ldomain%latc(gdc) > 75. .and. ldomain%latc(gdc) <= 79. .and. & + ldomain%lonc(gdc) > 285. .and. ldomain%lonc(gdc) < 350.) & + .or. & + (ldomain%latc(gdc) > 79. .and. ldomain%latc(gdc) < 85. .and. & + ldomain%lonc(gdc) > 290. .and. ldomain%lonc(gdc) < 355.) ) then + + this%gris_mask_grc(gdc) = 1.0_r8 + + elseif (ldomain%latc(gdc) < -60.) then + + this%aais_mask_grc(gdc) = 1.0_r8 + + endif ! Greenland or Antarctic grid cell + + end do + + end subroutine calc_timeconst_diagnostics + + + +end module glcDiagnosticsMod diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 new file mode 100644 index 0000000000..9f49e70e24 --- /dev/null +++ b/components/clm/src/main/histFileMod.F90 @@ -0,0 +1,4741 @@ +module histFileMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing methods to for CLM history file handling. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_flush + use spmdMod , only : masterproc + use abortutils , only : endrun + use clm_varctl , only : iulog, use_vertsoilc + use clm_varcon , only : spval, ispval, dzsoi_decomp + use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort + use decompMod , only : get_proc_bounds, get_proc_global, bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use ncdio_pio + ! + implicit none + save + private + ! + ! !PUBLIC TYPES: + ! + ! Constants + ! + integer , public, parameter :: max_tapes = 6 ! max number of history tapes + integer , public, parameter :: max_flds = 2500 ! max number of history fields + integer , public, parameter :: max_namlen = 64 ! maximum number of characters for field name + + ! Possible ways to treat multi-layer snow fields at times when no snow is present in a + ! given layer. Note that the public parameters are the only ones that can be used by + ! calls to hist_addfld2d; the private parameters are just used internally by the + ! histFile implementation. + integer , private, parameter :: no_snow_MIN = 1 ! minimum valid value for this flag + integer , public , parameter :: no_snow_normal = 1 ! normal treatment, which should be used for most fields (use spval when snow layer not present) + integer , public , parameter :: no_snow_zero = 2 ! average in a 0 value for times when the snow layer isn't present + integer , private, parameter :: no_snow_MAX = 2 ! maximum valid value for this flag + integer , private, parameter :: no_snow_unset = no_snow_MIN - 1 ! flag specifying that field is NOT a multi-layer snow field + ! + ! Counters + ! + integer , public :: ntapes = 0 ! index of max history file requested + ! + ! Namelist + ! + integer :: ni ! implicit index below + logical, public :: & + hist_empty_htapes = .false. ! namelist: flag indicates no default history fields + integer, public :: & + hist_ndens(max_tapes) = 2 ! namelist: output density of netcdf history files + integer, public :: & + hist_mfilt(max_tapes) = 30 ! namelist: number of time samples per tape + logical, public :: & + hist_dov2xy(max_tapes) = (/.true.,(.true.,ni=2,max_tapes)/) ! namelist: true=> do grid averaging + integer, public :: & + hist_nhtfrq(max_tapes) = (/0, (-24, ni=2,max_tapes)/) ! namelist: history write freq(0=monthly) + character(len=1), public :: & + hist_avgflag_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape averaging flag + character(len=max_namlen), public :: & + hist_type1d_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape type1d + + character(len=max_namlen+2), public :: & + fincl(max_flds,max_tapes) ! namelist-equivalence list of fields to add + + character(len=max_namlen+2), public :: & + hist_fincl1(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl2(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl3(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl4(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl5(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl6(max_flds) = ' ' ! namelist: list of fields to add + + character(len=max_namlen+2), public :: & + fexcl(max_flds,max_tapes) ! namelist-equivalence list of fields to remove + + character(len=max_namlen+2), public :: & + hist_fexcl1(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl2(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl3(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl4(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl5(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl6(max_flds) = ' ' ! namelist: list of fields to remove + + logical, private :: if_disphist(max_tapes) ! restart, true => save history file + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: hist_addfld1d ! Add a 1d single-level field to the master field list + public :: hist_addfld2d ! Add a 2d multi-level field to the master field list + public :: hist_addfld_decomp ! Add a 2d multi-level field to the master field list + public :: hist_add_subscript ! Add a 2d subscript dimension + public :: hist_printflds ! Print summary of master field list + public :: hist_htapes_build ! Initialize history file handler for initial or continue run + public :: hist_update_hbuf ! Updates history buffer for all fields and tapes + public :: hist_htapes_wrapup ! Write history tape(s) + public :: hist_restart_ncd ! Read/write history file restart data + public :: htapes_fieldlist ! Define the contents of each history file based on namelist + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: masterlist_make_active ! Add a field to a history file default "on" list + private :: masterlist_addfld ! Add a field to the master field list + private :: masterlist_change_timeavg ! Override default history tape contents for specific tape + private :: htape_addfld ! Add a field to the active list for a history tape + private :: htape_create ! Define contents of history file t + private :: htape_add_ltype_metadata ! Add global metadata defining landunit types + private :: htape_add_natpft_metadata ! Add global metadata defining natpft types + private :: htape_add_cft_metadata ! Add global metadata defining cft types + private :: htape_timeconst ! Write time constant values to history tape + private :: htape_timeconst3D ! Write time constant 3D values to primary history tape + private :: hfields_normalize ! Normalize history file fields by number of accumulations + private :: hfields_zero ! Zero out accumulation and hsitory buffers for a tape + private :: hfields_write ! Write a variable to a history tape + private :: hfields_1dinfo ! Define/output 1d subgrid info if appropriate + private :: hist_update_hbuf_field_1d ! Updates history buffer for specific field and tape + private :: hist_update_hbuf_field_2d ! Updates history buffer for specific field and tape + private :: hist_set_snow_field_2d ! Set values in history field dimensioned by levsno + private :: list_index ! Find index of field in exclude list + private :: set_hist_filename ! Determine history dataset filenames + private :: getname ! Retrieve name portion of input "inname" + private :: getflag ! Retrieve flag + private :: pointer_index ! Track data pointer indices + private :: max_nFields ! The max number of fields on any tape + ! + ! !PRIVATE TYPES: + ! Constants + ! + integer, parameter :: max_chars = 128 ! max chars for char variables + integer, parameter :: max_subs = 100 ! max number of subscripts + integer :: num_subs = 0 ! actual number of subscripts + character(len=32) :: subs_name(max_subs) ! name of subscript + integer :: subs_dim(max_subs) ! dimension of subscript + ! + type field_info + character(len=max_namlen) :: name ! field name + character(len=max_chars) :: long_name ! long name + character(len=max_chars) :: units ! units + character(len=8) :: type1d ! pointer to first dimension type from data type (nameg, etc) + character(len=8) :: type1d_out ! hbuf first dimension type from data type (nameg, etc) + character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + integer :: beg1d ! on-node 1d clm pointer start index + integer :: end1d ! on-node 1d clm pointer end index + integer :: num1d ! size of clm pointer first dimension (all nodes) + integer :: beg1d_out ! on-node 1d hbuf pointer start index + integer :: end1d_out ! on-node 1d hbuf pointer end index + integer :: num1d_out ! size of hbuf first dimension (all nodes) + integer :: num2d ! size of hbuf second dimension (e.g. number of vertical levels) + integer :: hpindex ! history pointer index + character(len=8) :: p2c_scale_type ! scale factor when averaging patch to column + character(len=8) :: c2l_scale_type ! scale factor when averaging column to landunit + character(len=8) :: l2g_scale_type ! scale factor when averaging landunit to gridcell + integer :: no_snow_behavior ! for multi-layer snow fields, flag saying how to treat times when a given snow layer is absent + end type field_info + + type master_entry + type (field_info) :: field ! field information + logical :: actflag(max_tapes) ! active/inactive flag + character(len=1) :: avgflag(max_tapes) ! time averaging flag ("X","A","M" or "I",) + end type master_entry + + type history_entry + type (field_info) :: field ! field information + character(len=1) :: avgflag ! time averaging flag + real(r8), pointer :: hbuf(:,:) ! history buffer (dimensions: dim1d x num2d) + integer , pointer :: nacs(:,:) ! accumulation counter (dimensions: dim1d x num2d) + end type history_entry + + type history_tape + integer :: nflds ! number of active fields on tape + integer :: ntimes ! current number of time samples on tape + integer :: mfilt ! maximum number of time samples per tape + integer :: nhtfrq ! number of time samples per tape + integer :: ncprec ! netcdf output precision + logical :: dov2xy ! true => do xy average for all fields + logical :: is_endhist ! true => current time step is end of history interval + real(r8) :: begtime ! time at beginning of history averaging interval + type (history_entry) :: hlist(max_flds) ! array of active history tape entries + end type history_tape + + type clmpoint_rs ! Pointer to real scalar data (1D) + real(r8), pointer :: ptr(:) + end type clmpoint_rs + type clmpoint_ra ! Pointer to real array data (2D) + real(r8), pointer :: ptr(:,:) + end type clmpoint_ra + + ! Pointers into datatype arrays + integer, parameter :: max_mapflds = 2500 ! Maximum number of fields to track + type (clmpoint_rs) :: clmptr_rs(max_mapflds) ! Real scalar data (1D) + type (clmpoint_ra) :: clmptr_ra(max_mapflds) ! Real array data (2D) + ! + ! Master list: an array of master_entry entities + ! + type (master_entry) :: masterlist(max_flds) ! master field list + ! + ! History tape: an array of history_tape entities (only active fields) + ! + type (history_tape) :: tape(max_tapes) ! array history tapes + ! + ! Namelist input + ! + ! Counters + ! + integer :: nfmaster = 0 ! number of fields in master field list + ! + ! Other variables + ! + character(len=max_chars) :: locfnh(max_tapes) ! local history file names + character(len=max_chars) :: locfnhr(max_tapes) ! local history restart file names + logical :: htapes_defined = .false. ! flag indicates history contents have been defined + ! + ! NetCDF Id's + ! + type(file_desc_t) :: nfid(max_tapes) ! file ids + type(file_desc_t) :: ncid_hist(max_tapes) ! file ids for history restart files + integer :: time_dimid ! time dimension id + integer :: hist_interval_dimid ! time bounds dimension id + integer :: strlen_dimid ! string dimension id + ! + ! Time Constant variable names and filename + ! + character(len=max_chars) :: TimeConst3DVars_Filename = ' ' + character(len=max_chars) :: TimeConst3DVars = ' ' + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine hist_printflds() + ! + ! !DESCRIPTION: + ! Print summary of master field list. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer nf + character(len=*),parameter :: subname = 'CLM_hist_printflds' + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) trim(subname),' : number of master fields = ',nfmaster + write(iulog,*)' ******* MASTER FIELD LIST *******' + do nf = 1,nfmaster + write(iulog,9000)nf, masterlist(nf)%field%name, masterlist(nf)%field%units +9000 format (i5,1x,a32,1x,a16) + end do + call shr_sys_flush(iulog) + end if + + end subroutine hist_printflds + + !----------------------------------------------------------------------- + subroutine masterlist_addfld (fname, type1d, type1d_out, & + type2d, num2d, units, avgflag, long_name, hpindex, & + p2c_scale_type, c2l_scale_type, l2g_scale_type, & + no_snow_behavior) + ! + ! !DESCRIPTION: + ! Add a field to the master field list. Put input arguments of + ! field name, units, number of levels, averaging flag, and long name + ! into a type entry in the global master field list (masterlist). + ! + ! The optional argument no_snow_behavior should be given when this is a multi-layer + ! snow field, and should be absent otherwise. It should take on one of the no_snow_* + ! parameters defined above + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type1d ! 1d data type + character(len=*), intent(in) :: type1d_out ! 1d output type + character(len=*), intent(in) :: type2d ! 2d output type + integer , intent(in) :: num2d ! size of second dimension (e.g. number of vertical levels) + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + integer , intent(in) :: hpindex ! data type index for history buffer output + character(len=*), intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + integer, intent(in), optional :: no_snow_behavior ! if a multi-layer snow field, behavior to use for absent snow layers + ! + ! !LOCAL VARIABLES: + integer :: n ! loop index + integer :: f ! masterlist index + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + type(bounds_type) :: bounds + character(len=*),parameter :: subname = 'masterlist_addfld' + !------------------------------------------------------------------------ + + ! Determine bounds + + call get_proc_bounds(bounds) + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump) + + ! Ensure that new field is not all blanks + + if (fname == ' ') then + write(iulog,*) trim(subname),' ERROR: blank field name not allowed' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Ensure that new field doesn't already exist + + do n = 1,nfmaster + if (masterlist(n)%field%name == fname) then + write(iulog,*) trim(subname),' ERROR:', fname, ' already on list' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do + + ! Increase number of fields on master field list + + nfmaster = nfmaster + 1 + f = nfmaster + + ! Check number of fields in master list against maximum number for master list + + if (nfmaster > max_flds) then + write(iulog,*) trim(subname),' ERROR: too many fields for primary history file ', & + '-- max_flds,nfmaster=', max_flds, nfmaster + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Add field to master list + + masterlist(f)%field%name = fname + masterlist(f)%field%long_name = long_name + masterlist(f)%field%units = units + masterlist(f)%field%type1d = type1d + masterlist(f)%field%type1d_out = type1d_out + masterlist(f)%field%type2d = type2d + masterlist(f)%field%num2d = num2d + masterlist(f)%field%hpindex = hpindex + masterlist(f)%field%p2c_scale_type = p2c_scale_type + masterlist(f)%field%c2l_scale_type = c2l_scale_type + masterlist(f)%field%l2g_scale_type = l2g_scale_type + + select case (type1d) + case (grlnd) + masterlist(f)%field%beg1d = bounds%begg + masterlist(f)%field%end1d = bounds%endg + masterlist(f)%field%num1d = numg + case (nameg) + masterlist(f)%field%beg1d = bounds%begg + masterlist(f)%field%end1d = bounds%endg + masterlist(f)%field%num1d = numg + case (namel) + masterlist(f)%field%beg1d = bounds%begl + masterlist(f)%field%end1d = bounds%endl + masterlist(f)%field%num1d = numl + case (namec) + masterlist(f)%field%beg1d = bounds%begc + masterlist(f)%field%end1d = bounds%endc + masterlist(f)%field%num1d = numc + case (namep) + masterlist(f)%field%beg1d = bounds%begp + masterlist(f)%field%end1d = bounds%endp + masterlist(f)%field%num1d = nump + case default + write(iulog,*) trim(subname),' ERROR: unknown 1d output type= ',type1d + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + if (present(no_snow_behavior)) then + masterlist(f)%field%no_snow_behavior = no_snow_behavior + else + masterlist(f)%field%no_snow_behavior = no_snow_unset + end if + + ! The following two fields are used only in master field list, + ! NOT in the runtime active field list + ! ALL FIELDS IN THE MASTER LIST ARE INITIALIZED WITH THE ACTIVE + ! FLAG SET TO FALSE + + masterlist(f)%avgflag(:) = avgflag + masterlist(f)%actflag(:) = .false. + + end subroutine masterlist_addfld + + !----------------------------------------------------------------------- + subroutine hist_htapes_build () + ! + ! !DESCRIPTION: + ! Initialize history file for initial or continuation run. For example, + ! on an initial run, this routine initializes ``ntapes'' history files. + ! On a restart run, this routine only initializes history files declared + ! beyond what existed on the previous run. Files which already existed on + ! the previous run have already been initialized (i.e. named and opened) + ! in routine restart\_history. Loop over tapes and fields per tape setting + ! appropriate variables and calling appropriate routines + ! + ! !USES: + use clm_time_manager, only: get_prev_time + use clm_varcon , only: secspday + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: i ! index + integer :: ier ! error code + integer :: t, f ! tape, field indices + integer :: day, sec ! day and seconds from base date + character(len=*),parameter :: subname = 'hist_htapes_build' + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) trim(subname),' Initializing clm2 history files' + write(iulog,'(72a1)') ("-",i=1,60) + call shr_sys_flush(iulog) + endif + + ! Define field list information for all history files. + ! Update ntapes to reflect number of active history files + ! Note - branch runs can have additional auxiliary history files + ! declared). + + call htapes_fieldlist() + + ! Determine if gridcell (xy) averaging is done for all fields on tape + + do t=1,ntapes + tape(t)%dov2xy = hist_dov2xy(t) + if (masterproc) then + write(iulog,*)trim(subname),' hist tape = ',t,& + ' written with dov2xy= ',tape(t)%dov2xy + end if + end do + + ! Set number of time samples in each history file and + ! Note - the following entries will be overwritten by history restart + ! Note - with netcdf, only 1 (ncd_double) and 2 (ncd_float) are allowed + + do t=1,ntapes + tape(t)%ntimes = 0 + tape(t)%dov2xy = hist_dov2xy(t) + tape(t)%nhtfrq = hist_nhtfrq(t) + tape(t)%mfilt = hist_mfilt(t) + if (hist_ndens(t) == 1) then + tape(t)%ncprec = ncd_double + else + tape(t)%ncprec = ncd_float + endif + end do + + ! Set time of beginning of current averaging interval + ! First etermine elapased time since reference date + + call get_prev_time(day, sec) + do t=1,ntapes + tape(t)%begtime = day + sec/secspday + end do + + if (masterproc) then + write(iulog,*) trim(subname),' Successfully initialized clm2 history files' + write(iulog,'(72a1)') ("-",i=1,60) + call shr_sys_flush(iulog) + endif + + end subroutine hist_htapes_build + + !----------------------------------------------------------------------- + subroutine masterlist_make_active (name, tape_index, avgflag) + ! + ! !DESCRIPTION: + ! Add a field to the default ``on'' list for a given history file. + ! Also change the default time averaging flag if requested. + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: name ! field name + integer, intent(in) :: tape_index ! history tape index + character(len=1), intent(in), optional :: avgflag ! time averaging flag + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + logical :: found ! flag indicates field found in masterlist + character(len=*),parameter :: subname = 'masterlist_make_active' + !----------------------------------------------------------------------- + + ! Check validity of input arguments + + if (tape_index > max_tapes) then + write(iulog,*) trim(subname),' ERROR: tape index=', tape_index, ' is too big' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (present(avgflag)) then + if ( avgflag /= ' ' .and. & + avgflag /= 'A' .and. avgflag /= 'I' .and. & + avgflag /= 'X' .and. avgflag /= 'M') then + write(iulog,*) trim(subname),' ERROR: unknown averaging flag=', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end if + + ! Look through master list for input field name. + ! When found, set active flag for that tape to true. + ! Also reset averaging flag if told to use other than default. + + found = .false. + do f = 1,nfmaster + if (trim(name) == trim(masterlist(f)%field%name)) then + masterlist(f)%actflag(tape_index) = .true. + if (present(avgflag)) then + if (avgflag/= ' ') masterlist(f)%avgflag(tape_index) = avgflag + end if + found = .true. + exit + end if + end do + if (.not. found) then + write(iulog,*) trim(subname),' ERROR: field=', name, ' not found' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine masterlist_make_active + + !----------------------------------------------------------------------- + subroutine masterlist_change_timeavg (t) + ! + ! !DESCRIPTION: + ! Override default history tape contents for a specific tape. + ! Copy the flag into the master field list. + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! history tape index + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + character(len=1) :: avgflag ! lcl equiv of hist_avgflag_pertape(t) + character(len=*),parameter :: subname = 'masterlist_change_timeavg' + !----------------------------------------------------------------------- + + avgflag = hist_avgflag_pertape(t) + + do f = 1,nfmaster + select case (avgflag) + case ('A') + masterlist(f)%avgflag(t) = avgflag + case ('I') + masterlist(f)%avgflag(t) = avgflag + case ('X') + masterlist(f)%avgflag(t) = avgflag + case ('M') + masterlist(f)%avgflag(t) = avgflag + case default + write(iulog,*) trim(subname),' ERROR: unknown avgflag=',avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + end do + + end subroutine masterlist_change_timeavg + + !----------------------------------------------------------------------- + subroutine htapes_fieldlist() + ! + ! !DESCRIPTION: + ! Define the contents of each history file based on namelist + ! input for initial or branch run, and restart data if a restart run. + ! Use arrays fincl and fexcl to modify default history tape contents. + ! Then sort the result alphanumerically. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: t, f ! tape, field indices + integer :: ff ! index into include, exclude and fprec list + character(len=max_namlen) :: name ! field name portion of fincl (i.e. no avgflag separator) + character(len=max_namlen) :: mastername ! name from masterlist field + character(len=1) :: avgflag ! averaging flag + character(len=1) :: prec_acc ! history buffer precision flag + character(len=1) :: prec_wrt ! history buffer write precision flag + type (history_entry) :: tmp ! temporary used for swapping + character(len=*),parameter :: subname = 'htapes_fieldlist' + !----------------------------------------------------------------------- + + ! Override averaging flag for all fields on a particular tape + ! if namelist input so specifies + + do t=1,max_tapes + if (hist_avgflag_pertape(t) /= ' ') then + call masterlist_change_timeavg (t) + end if + end do + + fincl(:,1) = hist_fincl1(:) + fincl(:,2) = hist_fincl2(:) + fincl(:,3) = hist_fincl3(:) + fincl(:,4) = hist_fincl4(:) + fincl(:,5) = hist_fincl5(:) + fincl(:,6) = hist_fincl6(:) + + fexcl(:,1) = hist_fexcl1(:) + fexcl(:,2) = hist_fexcl2(:) + fexcl(:,3) = hist_fexcl3(:) + fexcl(:,4) = hist_fexcl4(:) + fexcl(:,5) = hist_fexcl5(:) + fexcl(:,6) = hist_fexcl6(:) + + + ! First ensure contents of fincl and fexcl are valid names + + do t = 1,max_tapes + f = 1 + do while (f < max_flds .and. fincl(f,t) /= ' ') + name = getname (fincl(f,t)) + do ff = 1,nfmaster + mastername = masterlist(ff)%field%name + if (name == mastername) exit + end do + if (name /= mastername) then + write(iulog,*) trim(subname),' ERROR: ', trim(name), ' in fincl(', f, ') ',& + 'for history tape ',t,' not found' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + f = f + 1 + end do + + f = 1 + do while (f < max_flds .and. fexcl(f,t) /= ' ') + do ff = 1,nfmaster + mastername = masterlist(ff)%field%name + if (fexcl(f,t) == mastername) exit + end do + if (fexcl(f,t) /= mastername) then + write(iulog,*) trim(subname),' ERROR: ', fexcl(f,t), ' in fexcl(', f, ') ', & + 'for history tape ',t,' not found' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + f = f + 1 + end do + end do + + tape(:)%nflds = 0 + do t = 1,max_tapes + + ! Loop through the masterlist set of field names and determine if any of those + ! are in the FINCL or FEXCL arrays + ! The call to list_index determines the index in the FINCL or FEXCL arrays + ! that the masterlist field corresponds to + ! Add the field to the tape if specified via namelist (FINCL[1-max_tapes]), + ! or if it is on by default and was not excluded via namelist (FEXCL[1-max_tapes]). + + do f = 1,nfmaster + mastername = masterlist(f)%field%name + call list_index (fincl(1,t), mastername, ff) + + if (ff > 0) then + + ! if field is in include list, ff > 0 and htape_addfld + ! will not be called for field + + avgflag = getflag (fincl(ff,t)) + call htape_addfld (t, f, avgflag) + + else if (.not. hist_empty_htapes) then + + ! find index of field in exclude list + + call list_index (fexcl(1,t), mastername, ff) + + ! if field is in exclude list, ff > 0 and htape_addfld + ! will not be called for field + ! if field is not in exclude list, ff =0 and htape_addfld + ! will be called for field (note that htape_addfld will be + ! called below only if field is not in exclude list OR in + ! include list + + if (ff == 0 .and. masterlist(f)%actflag(t)) then + call htape_addfld (t, f, ' ') + end if + + end if + end do + + ! Specification of tape contents now complete. + ! Sort each list of active entries + + do f = tape(t)%nflds-1,1,-1 + do ff = 1,f + if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then + + tmp = tape(t)%hlist(ff) + tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) + tape(t)%hlist(ff+1) = tmp + + else if (tape(t)%hlist(ff)%field%name == tape(t)%hlist(ff+1)%field%name) then + + write(iulog,*) trim(subname),' ERROR: Duplicate field ', & + tape(t)%hlist(ff)%field%name, & + 't,ff,name=',t,ff,tape(t)%hlist(ff+1)%field%name + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end if + end do + end do + + if (masterproc) then + if (tape(t)%nflds > 0) then + write(iulog,*) trim(subname),' : Included fields tape ',t,'=',tape(t)%nflds + end if + do f = 1,tape(t)%nflds + write(iulog,*) f,' ',tape(t)%hlist(f)%field%name, & + tape(t)%hlist(f)%field%num2d,' ',tape(t)%hlist(f)%avgflag + end do + call shr_sys_flush(iulog) + end if + end do + + ! Determine total number of active history tapes + + ntapes = 0 + do t = max_tapes,1,-1 + if (tape(t)%nflds > 0) then + ntapes = t + exit + end if + end do + + ! Ensure there are no "holes" in tape specification, i.e. empty tapes. + ! Enabling holes should not be difficult if necessary. + + do t = 1,ntapes + if (tape(t)%nflds == 0) then + write(iulog,*) trim(subname),' ERROR: Tape ',t,' is empty' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end do + + ! Check that the number of history files declared does not exceed + ! the maximum allowed. + + if (ntapes > max_tapes) then + write(iulog,*) trim(subname),' ERROR: Too many history files declared, max_tapes=',max_tapes + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Change 1d output per tape output flag if requested - only for history + ! tapes where 2d xy averaging is not enabled + + do t = 1,ntapes + if (hist_type1d_pertape(t) /= ' ' .and. (.not. hist_dov2xy(t))) then + select case (trim(hist_type1d_pertape(t))) + case ('PFTS','COLS', 'LAND', 'GRID') + if ( masterproc ) & + write(iulog,*)'history tape ',t,' will have 1d output type of ',hist_type1d_pertape(t) + case default + write(iulog,*) trim(subname),' ERROR: unknown namelist type1d per tape=',hist_type1d_pertape(t) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + end if + end do + + if (masterproc) then + write(iulog,*) 'There will be a total of ',ntapes,' history tapes' + do t=1,ntapes + write(iulog,*) + if (hist_nhtfrq(t) == 0) then + write(iulog,*)'History tape ',t,' write frequency is MONTHLY' + else + write(iulog,*)'History tape ',t,' write frequency = ',hist_nhtfrq(t) + endif + if (hist_dov2xy(t)) then + write(iulog,*)'All fields on history tape ',t,' are grid averaged' + else + write(iulog,*)'All fields on history tape ',t,' are not grid averaged' + end if + write(iulog,*)'Number of time samples on history tape ',t,' is ',hist_mfilt(t) + write(iulog,*)'Output precision on history tape ',t,'=',hist_ndens(t) + write(iulog,*) + end do + call shr_sys_flush(iulog) + end if + + ! Set flag indicating h-tape contents are now defined (needed by masterlist_addfld) + + htapes_defined = .true. + + + end subroutine htapes_fieldlist + + !----------------------------------------------------------------------- + subroutine htape_addfld (t, f, avgflag) + ! + ! !DESCRIPTION: + ! Add a field to the active list for a history tape. Copy the data from + ! the master field list to the active list for the tape. + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! history tape index + integer, intent(in) :: f ! field index from master field list + character(len=1), intent(in) :: avgflag ! time averaging flag + ! + ! !LOCAL VARIABLES: + integer :: n ! field index on defined tape + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: num2d ! size of second dimension (e.g. .number of vertical levels) + integer :: beg1d_out,end1d_out ! history output per-proc 1d beginning and ending indices + integer :: num1d_out ! history output 1d size + type(bounds_type) :: bounds + character(len=*),parameter :: subname = 'htape_addfld' + !----------------------------------------------------------------------- + + ! Ensure that it is not to late to add a field to the history tape + + if (htapes_defined) then + write(iulog,*) trim(subname),' ERROR: attempt to add field ', & + masterlist(f)%field%name, ' after history files are set' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + tape(t)%nflds = tape(t)%nflds + 1 + n = tape(t)%nflds + + ! Copy field information + + tape(t)%hlist(n)%field = masterlist(f)%field + + ! Determine bounds + + call get_proc_bounds(bounds) + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump) + + ! Modify type1d_out if necessary + + if (hist_dov2xy(t)) then + + ! If xy output averaging is requested, set output 1d type to grlnd + ! ***NOTE- the following logic is what permits non lat/lon grids to + ! be written to clm history file + + type1d = tape(t)%hlist(n)%field%type1d + + if (type1d == nameg .or. & + type1d == namel .or. & + type1d == namec .or. & + type1d == namep) then + tape(t)%hlist(n)%field%type1d_out = grlnd + end if + if (type1d == grlnd) then + tape(t)%hlist(n)%field%type1d_out = grlnd + end if + + else if (hist_type1d_pertape(t) /= ' ') then + + ! Set output 1d type based on namelist setting of hist_type1d_pertape + ! Only applies to tapes when xy output is not required + + type1d = tape(t)%hlist(n)%field%type1d + + select case (trim(hist_type1d_pertape(t))) + case('GRID') + tape(t)%hlist(n)%field%type1d_out = nameg + case('LAND') + tape(t)%hlist(n)%field%type1d_out = namel + case('COLS') + tape(t)%hlist(n)%field%type1d_out = namec + case ('PFTS') + tape(t)%hlist(n)%field%type1d_out = namep + case default + write(iulog,*) trim(subname),' ERROR: unknown input hist_type1d_pertape= ', hist_type1d_pertape(t) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + endif + + ! Determine output 1d dimensions + + type1d_out = tape(t)%hlist(n)%field%type1d_out + if (type1d_out == grlnd) then + beg1d_out = bounds%begg + end1d_out = bounds%endg + num1d_out = numg + else if (type1d_out == nameg) then + beg1d_out = bounds%begg + end1d_out = bounds%endg + num1d_out = numg + else if (type1d_out == namel) then + beg1d_out = bounds%begl + end1d_out = bounds%endl + num1d_out = numl + else if (type1d_out == namec) then + beg1d_out = bounds%begc + end1d_out = bounds%endc + num1d_out = numc + else if (type1d_out == namep) then + beg1d_out = bounds%begp + end1d_out = bounds%endp + num1d_out = nump + else + write(iulog,*) trim(subname),' ERROR: incorrect value of type1d_out= ',type1d_out + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + tape(t)%hlist(n)%field%beg1d_out = beg1d_out + tape(t)%hlist(n)%field%end1d_out = end1d_out + tape(t)%hlist(n)%field%num1d_out = num1d_out + + ! Alloccate and initialize history buffer and related info + + num2d = tape(t)%hlist(n)%field%num2d + allocate (tape(t)%hlist(n)%hbuf(beg1d_out:end1d_out,num2d)) + allocate (tape(t)%hlist(n)%nacs(beg1d_out:end1d_out,num2d)) + tape(t)%hlist(n)%hbuf(:,:) = 0._r8 + tape(t)%hlist(n)%nacs(:,:) = 0 + + ! Set time averaging flag based on masterlist setting or + ! override the default averaging flag with namelist setting + + select case (avgflag) + case (' ') + tape(t)%hlist(n)%avgflag = masterlist(f)%avgflag(t) + case ('A','I','X','M') + tape(t)%hlist(n)%avgflag = avgflag + case default + write(iulog,*) trim(subname),' ERROR: unknown avgflag=', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + end subroutine htape_addfld + + !----------------------------------------------------------------------- + subroutine hist_update_hbuf(bounds) + ! + ! !DESCRIPTION: + ! Accumulate (or take min, max, etc. as appropriate) input field + ! into its history buffer for appropriate tapes. + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: t ! tape index + integer :: f ! field index + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + character(len=*),parameter :: subname = 'hist_update_hbuf' + character(len=8) :: type2d ! hbuf second dimension type ["levgrnd","levlak","numrad","ltype","natpft","cft","glc_nec","elevclas","subname(n)"] + !----------------------------------------------------------------------- + + do t = 1,ntapes +!$OMP PARALLEL DO PRIVATE (f, num2d) + do f = 1,tape(t)%nflds + num2d = tape(t)%hlist(f)%field%num2d + if ( num2d == 1) then + call hist_update_hbuf_field_1d (t, f, bounds) + else + call hist_update_hbuf_field_2d (t, f, bounds, num2d) + end if + end do +!$OMP END PARALLEL DO + end do + + end subroutine hist_update_hbuf + + !----------------------------------------------------------------------- + subroutine hist_update_hbuf_field_1d (t, f, bounds) + ! + ! !DESCRIPTION: + ! Accumulate (or take min, max, etc. as appropriate) input field + ! into its history buffer for appropriate tapes. + ! + ! This canNOT be called from within a threaded region (see comment below regarding the + ! call to p2g, and the lack of explicit bounds on its arguments; see also bug 1786) + ! + ! !USES: + use subgridAveMod , only : p2g, c2g, l2g + use landunit_varcon , only : istice_mec + use decompMod , only : BOUNDS_LEVEL_PROC + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! field index + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: hpindex ! history pointer index + integer :: k ! gridcell, landunit, column or patch index + integer :: beg1d,end1d ! beginning and ending indices + logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) + logical :: valid ! true => history operation is valid + logical :: map2gcell ! true => map clm pointer field to gridcell + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=1) :: avgflag ! time averaging flag + character(len=8) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=8) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + real(r8), pointer :: field(:) ! clm 1d pointer field + logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft) (this refers to a point being active, NOT a history field being active) + real(r8) :: field_gcell(bounds%begg:bounds%endg) ! gricell level field (used if mapping to gridcell is done) + integer j + character(len=*),parameter :: subname = 'hist_update_hbuf_field_1d' + integer k_offset ! offset for mapping sliced subarray pointers when outputting variables in PFT/col vector form + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, errMsg(__FILE__, __LINE__)) + + avgflag = tape(t)%hlist(f)%avgflag + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + type1d = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + hpindex = tape(t)%hlist(f)%field%hpindex + field => clmptr_rs(hpindex)%ptr + + ! set variables to check weights when allocate all pfts + + map2gcell = .false. + if (type1d_out == nameg .or. type1d_out == grlnd) then + if (type1d == namep) then + ! In this and the following calls, we do NOT explicitly subset field using + ! bounds (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because, + ! for some fields, the lower bound has been reset to 1 due to taking a pointer + ! to an array slice. Thus, this code will NOT work properly if done within a + ! threaded region! (See also bug 1786) + call p2g(bounds, & + field, & + field_gcell(bounds%begg:bounds%endg), & + p2c_scale_type, c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namec) then + call c2g(bounds, & + field, & + field_gcell(bounds%begg:bounds%endg), & + c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namel) then + call l2g(bounds, & + field, & + field_gcell(bounds%begg:bounds%endg), & + l2g_scale_type) + map2gcell = .true. + end if + end if + + if (map2gcell) then ! Map to gridcell + + ! note that in this case beg1d = begg and end1d=endg + select case (avgflag) + case ('I') ! Instantaneous + do k = bounds%begg,bounds%endg + if (field_gcell(k) /= spval) then + hbuf(k,1) = field_gcell(k) + else + hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('A') ! Time average + do k = bounds%begg,bounds%endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k) + nacs(k,1) = nacs(k,1) + 1 + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case ('X') ! Maximum over time + do k = bounds%begg,bounds%endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8 + hbuf(k,1) = max( hbuf(k,1), field_gcell(k) ) + else + hbuf(k,1) = spval + endif + nacs(k,1) = 1 + end do + case ('M') ! Minimum over time + do k = bounds%begg,bounds%endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8 + hbuf(k,1) = min( hbuf(k,1), field_gcell(k) ) + else + hbuf(k,1) = spval + endif + nacs(k,1) = 1 + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + else ! Do not map to gridcell + + ! For data defined on the pft, col or landunit, we need to check if a point is active + ! to determine whether that point should be assigned spval + if (type1d == namep) then + check_active = .true. + active => patch%active + else if (type1d == namec) then + check_active = .true. + active => col%active + else if (type1d == namel) then + check_active = .true. + active =>lun%active + else + check_active = .false. + end if + + select case (avgflag) + case ('I') ! Instantaneous + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + hbuf(k,1) = field(k) + else + hbuf(k,1) = spval + end if + else + hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('A') ! Time average + ! create mappings for array slice pointers (which go from 1 to size(field) rather than beg1d to end1d) + if ( end1d .eq. ubound(field,1) ) then + k_offset = 0 + else + k_offset = 1 - beg1d + endif + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k+k_offset) /= spval) then ! add k_offset + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k+k_offset) ! add k_offset + nacs(k,1) = nacs(k,1) + 1 + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case ('X') ! Maximum over time + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8 + hbuf(k,1) = max( hbuf(k,1), field(k) ) + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('M') ! Minimum over time + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8 + hbuf(k,1) = min( hbuf(k,1), field(k) ) + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + end if + + end subroutine hist_update_hbuf_field_1d + + !----------------------------------------------------------------------- + subroutine hist_update_hbuf_field_2d (t, f, bounds, num2d) + ! + ! !DESCRIPTION: + ! Accumulate (or take min, max, etc. as appropriate) input field + ! into its history buffer for appropriate tapes. + ! + ! This canNOT be called from within a threaded region (see comment below regarding the + ! call to p2g, and the lack of explicit bounds on its arguments; see also bug 1786) + ! + ! !USES: + use subgridAveMod , only : p2g, c2g, l2g + use landunit_varcon , only : istice_mec + use decompMod , only : BOUNDS_LEVEL_PROC + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! field index + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num2d ! size of second dimension + ! + ! !LOCAL VARIABLES: + integer :: hpindex ! history pointer index + integer :: k ! gridcell, landunit, column or patch index + integer :: j ! level index + integer :: beg1d,end1d ! beginning and ending indices + logical :: check_active ! true => check 'active' flag of each point (this refers to a point being active, NOT a history field being active) + logical :: valid ! true => history operation is valid + logical :: map2gcell ! true => map clm pointer field to gridcell + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=1) :: avgflag ! time averaging flag + character(len=8) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=8) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + integer :: no_snow_behavior ! for multi-layer snow fields, behavior to use when a given layer is absent + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + real(r8), pointer :: field(:,:) ! clm 2d pointer field + logical :: field_allocated! whether 'field' was allocated here + logical , pointer :: active(:) ! flag saying whether each point is active (used for type1d = landunit/column/pft) + !(this refers to a point being active, NOT a history field being active) + real(r8) :: field_gcell(bounds%begg:bounds%endg,num2d) ! gricell level field (used if mapping to gridcell is done) + character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, errMsg(__FILE__, __LINE__)) + + avgflag = tape(t)%hlist(f)%avgflag + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + type1d = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + no_snow_behavior = tape(t)%hlist(f)%field%no_snow_behavior + hpindex = tape(t)%hlist(f)%field%hpindex + + if (no_snow_behavior /= no_snow_unset) then + ! For multi-layer snow fields, build a special output variable that handles + ! missing snow layers appropriately + + ! Note, regarding bug 1786: The following allocation is not what we would want if + ! this routine were operating in a threaded region (or, more generally, within a + ! loop over nclumps) - in that case we would want to use the bounds information for + ! this clump. But currently that's not possible because the bounds of some fields + ! have been reset to 1 - see also bug 1786. Similarly, if we wanted to allow + ! operation within a loop over clumps, we would need to pass 'bounds' to + ! hist_set_snow_field_2d rather than relying on beg1d & end1d (which give the proc, + ! bounds not the clump bounds) + + allocate(field(lbound(clmptr_ra(hpindex)%ptr, 1) : ubound(clmptr_ra(hpindex)%ptr, 1), 1:num2d)) + field_allocated = .true. + + call hist_set_snow_field_2d(field, clmptr_ra(hpindex)%ptr, no_snow_behavior, type1d, & + beg1d, end1d) + else + field => clmptr_ra(hpindex)%ptr(:,1:num2d) + field_allocated = .false. + end if + + ! set variables to check weights when allocate all pfts + + map2gcell = .false. + if (type1d_out == nameg .or. type1d_out == grlnd) then + if (type1d == namep) then + ! In this and the following calls, we do NOT explicitly subset field using + ! (e.g., we do NOT do field(bounds%begp:bounds%endp). This is because, + ! for some fields, the lower bound has been reset to 1 due to taking a pointer + ! to an array slice. Thus, this code will NOT work properly if done within a + ! threaded region! (See also bug 1786) + call p2g(bounds, num2d, & + field, & + field_gcell(bounds%begg:bounds%endg, :), & + p2c_scale_type, c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namec) then + call c2g(bounds, num2d, & + field, & + field_gcell(bounds%begg:bounds%endg, :), & + c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namel) then + call l2g(bounds, num2d, & + field, & + field_gcell(bounds%begg:bounds%endg, :), & + l2g_scale_type) + map2gcell = .true. + end if + end if + + if (map2gcell) then ! Map to gridcell + + ! note that in this case beg1d = begg and end1d=endg + select case (avgflag) + case ('I') ! Instantaneous + do j = 1,num2d + do k = bounds%begg,bounds%endg + if (field_gcell(k,j) /= spval) then + hbuf(k,j) = field_gcell(k,j) + else + hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('A') ! Time average + do j = 1,num2d + do k = bounds%begg,bounds%endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j) + nacs(k,j) = nacs(k,j) + 1 + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + endif + end do + end do + case ('X') ! Maximum over time + do j = 1,num2d + do k = bounds%begg,bounds%endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8 + hbuf(k,j) = max( hbuf(k,j), field_gcell(k,j) ) + else + hbuf(k,j) = spval + endif + nacs(k,j) = 1 + end do + end do + case ('M') ! Minimum over time + do j = 1,num2d + do k = bounds%begg,bounds%endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8 + hbuf(k,j) = min( hbuf(k,j), field_gcell(k,j) ) + else + hbuf(k,j) = spval + endif + nacs(k,j) = 1 + end do + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + else ! Do not map to gridcell + + ! For data defined on the pft, col or landunit, we need to check if a point is active + ! to determine whether that point should be assigned spval + if (type1d == namep) then + check_active = .true. + active => patch%active + else if (type1d == namec) then + check_active = .true. + active => col%active + else if (type1d == namel) then + check_active = .true. + active =>lun%active + else + check_active = .false. + end if + + ! Note that since field points to an array section the + ! bounds are field(1:end1d-beg1d+1, num2d) - therefore + ! need to do the shifting below + + select case (avgflag) + case ('I') ! Instantaneous + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + hbuf(k,j) = field(k-beg1d+1,j) + else + hbuf(k,j) = spval + end if + else + hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('A') ! Time average + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j) + nacs(k,j) = nacs(k,j) + 1 + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + end do + end do + case ('X') ! Maximum over time + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8 + hbuf(k,j) = max( hbuf(k,j), field(k-beg1d+1,j) ) + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('M') ! Minimum over time + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (check_active) then + if (.not. active(k)) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8 + hbuf(k,j) = min( hbuf(k,j), field(k-beg1d+1,j)) + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + end if + + if (field_allocated) then + deallocate(field) + end if + + end subroutine hist_update_hbuf_field_2d + + !----------------------------------------------------------------------- + subroutine hist_set_snow_field_2d (field_out, field_in, no_snow_behavior, type1d, beg1d, end1d) + ! + ! !DESCRIPTION: + ! Set values in history field dimensioned by levsno. + ! + ! This routine handles what to do when a given snow layer doesn't exist for a given + ! point, based on the no_snow_behavior argument. Options are: + ! + ! - no_snow_normal: This is the normal behavior, which applies to most snow fields: + ! Use spval (missing value flag). This means that temporal averages will just + ! consider times when a particular snow layer actually existed + ! + ! - no_snow_zero: Average in a 0 value for times when the snow layer isn't present + ! + ! Input and output fields can be defined at the patch or column level + ! + ! !ARGUMENTS: + integer , intent(in) :: beg1d ! beginning spatial index + integer , intent(in) :: end1d ! ending spatial index + real(r8) , intent(out) :: field_out( beg1d: , 1: ) ! output field [point, lev] + real(r8) , intent(in) :: field_in ( beg1d: , 1: ) ! input field [point, lev] + integer , intent(in) :: no_snow_behavior ! behavior to use when a snow layer is absent + character(len=*), intent(in) :: type1d ! 1d clm pointer type ("column" or "pft") + ! + ! !LOCAL VARIABLES: + integer :: num_levels ! total number of possible snow layers + integer :: point + integer :: level + integer :: num_snow_layers ! number of snow layers that exist at a point + integer :: num_nonexistent_layers + integer :: c ! column index + real(r8):: no_snow_val ! value to use when a snow layer is missing + character(len=*), parameter :: subname = 'hist_set_snow_field_2d' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(field_out, 1) == end1d), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(field_in , 1) == end1d), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(field_out, 2) == ubound(field_in, 2)), errMsg(__FILE__, __LINE__)) + + associate(& + snl => col%snl & ! Input: [integer (:)] number of snow layers (negative) + ) + + num_levels = ubound(field_in, 2) + + ! Determine no_snow_val + select case (no_snow_behavior) + case (no_snow_normal) + no_snow_val = spval + case (no_snow_zero) + no_snow_val = 0._r8 + case default + write(iulog,*) trim(subname), ' ERROR: unrecognized no_snow_behavior: ', & + no_snow_behavior + call endrun() + end select + + do point = beg1d, end1d + + ! Get number of snow layers at this point + + if (type1d == namec) then + c = point + else if (type1d == namep) then + c = patch%column(point) + else + write(iulog,*) trim(subname), ' ERROR: Only implemented for patch and col-level fields' + write(iulog,*) 'type1d = ', trim(type1d) + call endrun() + end if + + num_snow_layers = abs(snl(c)) + num_nonexistent_layers = num_levels - num_snow_layers + + ! Fill output field appropriately for each layer + ! When only a subset of snow layers exist, it is the LAST num_snow_layers that exist + + do level = 1, num_nonexistent_layers + field_out(point, level) = no_snow_val + end do + do level = (num_nonexistent_layers + 1), num_levels + field_out(point, level) = field_in(point, level) + end do + + end do + + end associate + + end subroutine hist_set_snow_field_2d + + + !----------------------------------------------------------------------- + subroutine hfields_normalize (t) + ! + ! !DESCRIPTION: + ! Normalize fields on a history file by the number of accumulations. + ! Loop over fields on the tape. Need averaging flag and number of + ! accumulations to perform normalization. + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + integer :: k ! 1d index + integer :: j ! 2d index + logical :: aflag ! averaging flag + integer :: beg1d_out,end1d_out ! hbuf 1d beginning and ending indices + integer :: num2d ! hbuf size of second dimension (e.g. number of vertical levels) + character(len=1) :: avgflag ! averaging flag + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + character(len=*),parameter :: subname = 'hfields_normalize' + !----------------------------------------------------------------------- + + ! Normalize by number of accumulations for time averaged case + + do f = 1,tape(t)%nflds + avgflag = tape(t)%hlist(f)%avgflag + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + num2d = tape(t)%hlist(f)%field%num2d + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (avgflag == 'A') then + aflag = .true. + else + aflag = .false. + end if + + do j = 1, num2d + do k = beg1d_out, end1d_out + if (aflag .and. nacs(k,j) /= 0) then + hbuf(k,j) = hbuf(k,j) / float(nacs(k,j)) + end if + end do + end do + end do + + end subroutine hfields_normalize + + !----------------------------------------------------------------------- + subroutine hfields_zero (t) + ! + ! !DESCRIPTION: + ! Zero out accumulation and history buffers for a given history tape. + ! Loop through fields on the tape. + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + character(len=*),parameter :: subname = 'hfields_zero' + !----------------------------------------------------------------------- + + do f = 1,tape(t)%nflds + tape(t)%hlist(f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(f)%nacs(:,:) = 0 + end do + + end subroutine hfields_zero + + !----------------------------------------------------------------------- + subroutine htape_create (t, histrest) + ! + ! !DESCRIPTION: + ! Define contents of history file t. Issue the required netcdf + ! wrapper calls to define the history file contents. + ! + ! !USES: + use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, nlevurb, numrad, nlevcan + use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec, nlevdecomp_full + use landunit_varcon , only : max_lunit + use clm_varctl , only : caseid, ctitle, fsurdat, finidat, paramfile + use clm_varctl , only : version, hostname, username, conventions, source + use domainMod , only : ldomain + use fileutils , only : get_filename + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + logical, intent(in), optional :: histrest ! if creating the history restart file + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + integer :: p,c,l,n ! indices + integer :: ier ! error code + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + integer :: dimid ! dimension id temporary + integer :: dim1id(1) ! netCDF dimension id + integer :: dim2id(2) ! netCDF dimension id + integer :: ndims ! dimension counter + integer :: omode ! returned mode from netCDF call + integer :: ncprec ! output netCDF write precision + integer :: ret ! netCDF error status + integer :: nump ! total number of pfts across all processors + integer :: numc ! total number of columns across all processors + integer :: numl ! total number of landunits across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numa ! total number of atm cells across all processors + logical :: avoid_pnetcdf ! whether we should avoid using pnetcdf + logical :: lhistrest ! local history restart flag + type(file_desc_t) :: lnfid ! local file id + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len=256) :: name ! name of attribute + character(len=256) :: units ! units of attribute + character(len=256) :: str ! global attribute string + character(len= 1) :: avgflag ! time averaging flag + character(len=*),parameter :: subname = 'htape_create' + !----------------------------------------------------------------------- + + if ( present(histrest) )then + lhistrest = histrest + else + lhistrest = .false. + end if + + ! Determine necessary indices + + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump) + + ! define output write precsion for tape + + ncprec = tape(t)%ncprec + + ! BUG(wjs, 2014-10-20, bugz 1730) Workaround for + ! http://bugs.cgd.ucar.edu/show_bug.cgi?id=1730 + ! - 1-d hist files have problems with pnetcdf. A better workaround in terms of + ! performance is to keep pnetcdf, but set PIO_BUFFER_SIZE_LIMIT=0, but that can't be + ! done on a per-file basis. + if (.not. tape(t)%dov2xy) then + avoid_pnetcdf = .true. + else + avoid_pnetcdf = .false. + end if + + ! Create new netCDF file. It will be in define mode + + if ( .not. lhistrest )then + if (masterproc) then + write(iulog,*) trim(subname),' : Opening netcdf htape ', & + trim(locfnh(t)) + call shr_sys_flush(iulog) + end if + call ncd_pio_createfile(lnfid, trim(locfnh(t)), avoid_pnetcdf=avoid_pnetcdf) + call ncd_putatt(lnfid, ncd_global, 'title', 'CLM History file information' ) + call ncd_putatt(lnfid, ncd_global, 'comment', & + "NOTE: None of the variables are weighted by land fraction!" ) + else + if (masterproc) then + write(iulog,*) trim(subname),' : Opening netcdf rhtape ', & + trim(locfnhr(t)) + call shr_sys_flush(iulog) + end if + call ncd_pio_createfile(lnfid, trim(locfnhr(t)), avoid_pnetcdf=avoid_pnetcdf) + call ncd_putatt(lnfid, ncd_global, 'title', & + 'CLM Restart History information, required to continue a simulation' ) + call ncd_putatt(lnfid, ncd_global, 'comment', & + "This entire file NOT needed for startup or branch simulations") + end if + + ! Create global attributes. Attributes are used to store information + ! about the data set. Global attributes are information about the + ! data set as a whole, as opposed to a single variable + + call ncd_putatt(lnfid, ncd_global, 'Conventions', trim(conventions)) + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(lnfid, ncd_global, 'history' , trim(str)) + call ncd_putatt(lnfid, ncd_global, 'source' , trim(source)) + call ncd_putatt(lnfid, ncd_global, 'hostname', trim(hostname)) + call ncd_putatt(lnfid, ncd_global, 'username', trim(username)) + call ncd_putatt(lnfid, ncd_global, 'version' , trim(version)) + + str = & + '$Id: histFileMod.F90 42903 2012-12-21 15:32:10Z muszala $' + call ncd_putatt(lnfid, ncd_global, 'revision_id', trim(str)) + call ncd_putatt(lnfid, ncd_global, 'case_title', trim(ctitle)) + call ncd_putatt(lnfid, ncd_global, 'case_id', trim(caseid)) + str = get_filename(fsurdat) + call ncd_putatt(lnfid, ncd_global, 'Surface_dataset', trim(str)) + if (finidat == ' ') then + str = 'arbitrary initialization' + else + str = get_filename(finidat) + endif + call ncd_putatt(lnfid, ncd_global, 'Initial_conditions_dataset', trim(str)) + str = get_filename(paramfile) + call ncd_putatt(lnfid, ncd_global, 'PFT_physiological_constants_dataset', trim(str)) + + ! Define dimensions. + ! Time is an unlimited dimension. Character string is treated as an array of characters. + + ! Global uncompressed dimensions (including non-land points) + if (ldomain%isgrid2d) then + call ncd_defdim(lnfid, 'lon' , ldomain%ni, dimid) + call ncd_defdim(lnfid, 'lat' , ldomain%nj, dimid) + else + call ncd_defdim(lnfid, trim(grlnd), ldomain%ns, dimid) + end if + + ! Global compressed dimensions (not including non-land points) + call ncd_defdim(lnfid, trim(nameg), numg, dimid) + call ncd_defdim(lnfid, trim(namel), numl, dimid) + call ncd_defdim(lnfid, trim(namec), numc, dimid) + call ncd_defdim(lnfid, trim(namep), nump, dimid) + + ! "level" dimensions + call ncd_defdim(lnfid, 'levgrnd', nlevgrnd, dimid) + if (nlevurb > 0) then + call ncd_defdim(lnfid, 'levurb' , nlevurb, dimid) + end if + call ncd_defdim(lnfid, 'levlak' , nlevlak, dimid) + call ncd_defdim(lnfid, 'numrad' , numrad , dimid) + call ncd_defdim(lnfid, 'levsno' , nlevsno , dimid) + call ncd_defdim(lnfid, 'ltype', max_lunit, dimid) + call ncd_defdim(lnfid, 'nlevcan',nlevcan, dimid) + call htape_add_ltype_metadata(lnfid) + call ncd_defdim(lnfid, 'natpft', natpft_size, dimid) + if (cft_size > 0) then + call ncd_defdim(lnfid, 'cft', cft_size, dimid) + call htape_add_cft_metadata(lnfid) + end if + if (maxpatch_glcmec > 0) then + call ncd_defdim(lnfid, 'glc_nec' , maxpatch_glcmec , dimid) + ! elevclas (in contrast to glc_nec) includes elevation class 0 (bare land) + ! (although on the history file it will go 1:(nec+1) rather than 0:nec) + call ncd_defdim(lnfid, 'elevclas' , maxpatch_glcmec + 1, dimid) + end if + + do n = 1,num_subs + call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid) + end do + call ncd_defdim(lnfid, 'string_length', 8, strlen_dimid) + call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) + + if ( .not. lhistrest )then + call ncd_defdim(lnfid, 'hist_interval', 2, hist_interval_dimid) + call ncd_defdim(lnfid, 'time', ncd_unlimited, time_dimid) + nfid(t) = lnfid + if (masterproc)then + write(iulog,*) trim(subname), & + ' : Successfully defined netcdf history file ',t + call shr_sys_flush(iulog) + end if + else + ncid_hist(t) = lnfid + if (masterproc)then + write(iulog,*) trim(subname), & + ' : Successfully defined netcdf restart history file ',t + call shr_sys_flush(iulog) + end if + end if + + end subroutine htape_create + + !----------------------------------------------------------------------- + subroutine htape_add_ltype_metadata(lnfid) + ! + ! !DESCRIPTION: + ! Add global metadata defining landunit types + ! + ! !USES: + use landunit_varcon, only : max_lunit, landunit_names, landunit_name_length + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: lnfid ! local file id + ! + ! !LOCAL VARIABLES: + integer :: ltype ! landunit type + character(len=*), parameter :: att_prefix = 'ltype_' ! prefix for attributes + character(len=len(att_prefix)+landunit_name_length) :: attname ! attribute name + + character(len=*), parameter :: subname = 'htape_add_ltype_metadata' + !----------------------------------------------------------------------- + + do ltype = 1, max_lunit + attname = att_prefix // landunit_names(ltype) + call ncd_putatt(lnfid, ncd_global, attname, ltype) + end do + + end subroutine htape_add_ltype_metadata + + !----------------------------------------------------------------------- + subroutine htape_add_natpft_metadata(lnfid) + ! + ! !DESCRIPTION: + ! Add global metadata defining natpft types + ! + ! !USES: + use clm_varpar, only : natpft_lb, natpft_ub + use pftconMod , only : pftname_len, pftname + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: lnfid ! local file id + ! + ! !LOCAL VARIABLES: + integer :: ptype ! patch type + integer :: ptype_1_indexing ! patch type, translated to 1 indexing + character(len=*), parameter :: att_prefix = 'natpft_' ! prefix for attributes + character(len=len(att_prefix)+pftname_len) :: attname ! attribute name + + character(len=*), parameter :: subname = 'htape_add_natpft_metadata' + !----------------------------------------------------------------------- + + do ptype = natpft_lb, natpft_ub + ptype_1_indexing = ptype + (1 - natpft_lb) + attname = att_prefix // pftname(ptype) + call ncd_putatt(lnfid, ncd_global, attname, ptype_1_indexing) + end do + + end subroutine htape_add_natpft_metadata + + !----------------------------------------------------------------------- + subroutine htape_add_cft_metadata(lnfid) + ! + ! !DESCRIPTION: + ! Add global metadata defining natpft types + ! + ! !USES: + use clm_varpar, only : cft_lb, cft_ub + use pftconMod , only : pftname_len, pftname + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: lnfid ! local file id + ! + ! !LOCAL VARIABLES: + integer :: ptype ! patch type + integer :: ptype_1_indexing ! patch type, translated to 1 indexing + character(len=*), parameter :: att_prefix = 'cft_' ! prefix for attributes + character(len=len(att_prefix)+pftname_len) :: attname ! attribute name + + character(len=*), parameter :: subname = 'htape_add_cft_metadata' + !----------------------------------------------------------------------- + + do ptype = cft_lb, cft_ub + ptype_1_indexing = ptype + (1 - cft_lb) + attname = att_prefix // pftname(ptype) + call ncd_putatt(lnfid, ncd_global, attname, ptype_1_indexing) + end do + + end subroutine htape_add_cft_metadata + + !----------------------------------------------------------------------- + subroutine htape_timeconst3D(t, & + bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode) + ! + ! !DESCRIPTION: + ! Write time constant 3D variables to history tapes. + ! Only write out when this subroutine is called (normally only for + ! primary history files at very first time-step, nstep=0). + ! Issue the required netcdf wrapper calls to define the history file + ! contents. + ! + ! !USES: + use subgridAveMod , only : c2g + use clm_varpar , only : nlevgrnd ,nlevlak + use shr_string_mod , only : shr_string_listAppend + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + integer , intent(in) :: t ! tape index + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) + real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) + character(len=*) , intent(in) :: mode ! 'define' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: c,l,lev,ifld ! indices + integer :: ier ! error status + character(len=max_chars) :: long_name ! variable long name + character(len=max_namlen):: varname ! variable name + character(len=max_namlen):: units ! variable units + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to grid cells + ! + real(r8), pointer :: histi(:,:) ! temporary + real(r8), pointer :: histo(:,:) ! temporary + integer, parameter :: nflds = 6 ! Number of 3D time-constant fields + character(len=*),parameter :: subname = 'htape_timeconst3D' + character(len=*),parameter :: varnames(nflds) = (/ & + 'ZSOI ', & + 'DZSOI ', & + 'WATSAT', & + 'SUCSAT', & + 'BSW ', & + 'HKSAT ' & + /) + real(r8), pointer :: histil(:,:) ! temporary + real(r8), pointer :: histol(:,:) + integer, parameter :: nfldsl = 2 + character(len=*),parameter :: varnamesl(nfldsl) = (/ & + 'ZLAKE ', & + 'DZLAKE' & + /) + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sucsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bsw_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hksat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + !------------------------------------------------------------------------------- + !*** Non-time varying 3D fields *** + !*** Only write out when this subroutine is called *** + !*** Normally only called once for primary tapes *** + !------------------------------------------------------------------------------- + + if (mode == 'define') then + + do ifld = 1,nflds + ! Field indices MUST match varnames array order above! + if (ifld == 1) then + long_name='soil depth'; units = 'm' + else if (ifld == 2) then + long_name='soil thickness'; units = 'm' + else if (ifld == 3) then + long_name='saturated soil water content (porosity)'; units = 'mm3/mm3' + else if (ifld == 4) then + long_name='saturated soil matric potential'; units = 'mm' + else if (ifld == 5) then + long_name='slope of soil water retention curve'; units = 'unitless' + else if (ifld == 6) then + long_name='saturated hydraulic conductivity'; units = 'unitless' + else + call endrun(msg=' ERROR: bad 3D time-constant field index'//errMsg(__FILE__, __LINE__)) + end if + if (tape(t)%dov2xy) then + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& + dim1name='lon', dim2name='lat', dim3name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + dim1name=grlnd, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + dim1name=namec, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + call shr_string_listAppend(TimeConst3DVars,varnames(ifld)) + end do + + else if (mode == 'write') then + + allocate(histi(bounds%begc:bounds%endc,nlevgrnd), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histi' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Write time constant fields + + if (tape(t)%dov2xy) then + allocate(histo(bounds%begg:bounds%endg,nlevgrnd), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histo' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + do ifld = 1,nflds + + ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are + ! currently constant in space, except for urban points, so their scale type + ! doesn't matter at the moment as long as it excludes urban points. I am using + ! 'nonurb' so that the values are output everywhere where the fields are + ! constant (i.e., everywhere except urban points). For the other fields, I am + ! using 'veg' to be consistent with the l2g_scale_type that is now used for many + ! of the 3-d time-variant fields; in theory, though, one might want versions of + ! these variables output for different landunits. + + ! Field indices MUST match varnames array order above! + if (ifld == 1) then ! ZSOI + l2g_scale_type = 'nonurb' + else if (ifld == 2) then ! DZSOI + l2g_scale_type = 'nonurb' + else if (ifld == 3) then ! WATSAT + l2g_scale_type = 'veg' + else if (ifld == 4) then ! SUCSAT + l2g_scale_type = 'veg' + else if (ifld == 5) then ! BSW + l2g_scale_type = 'veg' + else if (ifld == 6) then ! HKSAT + l2g_scale_type = 'veg' + end if + + histi(:,:) = spval + do lev = 1,nlevgrnd + do c = bounds%begc,bounds%endc + l = col%landunit(c) + ! Field indices MUST match varnames array order above! + if (ifld ==1) histi(c,lev) = col%z(c,lev) + if (ifld ==2) histi(c,lev) = col%dz(c,lev) + if (ifld ==3) histi(c,lev) = watsat_col(c,lev) + if (ifld ==4) histi(c,lev) = sucsat_col(c,lev) + if (ifld ==5) histi(c,lev) = bsw_col(c,lev) + if (ifld ==6) histi(c,lev) = hksat_col(c,lev) + end do + end do + if (tape(t)%dov2xy) then + histo(:,:) = spval + + call c2g(bounds, nlevgrnd, & + histi(bounds%begc:bounds%endc, :), & + histo(bounds%begg:bounds%endg, :), & + c2l_scale_type='unity', l2g_scale_type=l2g_scale_type) + + if (ldomain%isgrid2d) then + call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & + data=histo, ncid=nfid(t), flag='write') + else + call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & + data=histo, ncid=nfid(t), flag='write') + end if + else + call ncd_io(varname=trim(varnames(ifld)), dim1name=namec, & + data=histi, ncid=nfid(t), flag='write') + end if + end do + + if (tape(t)%dov2xy) deallocate(histo) + deallocate(histi) + + end if ! (define/write mode + + if (mode == 'define') then + do ifld = 1,nfldsl + ! Field indices MUST match varnamesl array order above! + if (ifld == 1) then + long_name='lake layer node depth'; units = 'm' + else if (ifld == 2) then + long_name='lake layer thickness'; units = 'm' + else + call endrun(msg=' ERROR: bad 3D time-constant field index'//errMsg(__FILE__, __LINE__)) + end if + if (tape(t)%dov2xy) then + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec,& + dim1name='lon', dim2name='lat', dim3name='levlak', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & + dim1name=grlnd, dim2name='levlak', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & + dim1name=namec, dim2name='levlak', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + call shr_string_listAppend(TimeConst3DVars,varnamesl(ifld)) + end do + + else if (mode == 'write') then + + allocate(histil(bounds%begc:bounds%endc,nlevlak), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histil' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Write time constant fields + + if (tape(t)%dov2xy) then + allocate(histol(bounds%begg:bounds%endg,nlevlak), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histol' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + do ifld = 1,nfldsl + histil(:,:) = spval + do lev = 1,nlevlak + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%lakpoi(l)) then + ! Field indices MUST match varnamesl array order above! + if (ifld ==1) histil(c,lev) = col%z_lake(c,lev) + if (ifld ==2) histil(c,lev) = col%dz_lake(c,lev) + end if + end do + end do + if (tape(t)%dov2xy) then + histol(:,:) = spval + call c2g(bounds, nlevlak, & + histil(bounds%begc:bounds%endc, :), & + histol(bounds%begg:bounds%endg, :), & + c2l_scale_type='unity', l2g_scale_type='lake') + if (ldomain%isgrid2d) then + call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & + data=histol, ncid=nfid(t), flag='write') + else + call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & + data=histol, ncid=nfid(t), flag='write') + end if + else + call ncd_io(varname=trim(varnamesl(ifld)), dim1name=namec, & + data=histil, ncid=nfid(t), flag='write') + end if + end do + + if (tape(t)%dov2xy) deallocate(histol) + deallocate(histil) + + end if ! (define/write mode + + end subroutine htape_timeconst3D + + !----------------------------------------------------------------------- + subroutine htape_timeconst(t, mode) + ! + ! !DESCRIPTION: + ! Write time constant values to primary history tape. + ! Issue the required netcdf wrapper calls to define the history file + ! contents. + ! + ! !USES: + use clm_varcon , only : zsoi, zlak, secspday + use domainMod , only : ldomain, lon1d, lat1d + use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time + use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: vid,n,i,j,m ! indices + integer :: nstep ! current step + integer :: mcsec ! seconds of current date + integer :: mdcur ! current day + integer :: mscur ! seconds of current day + integer :: mcdate ! current date + integer :: yr,mon,day,nbsec ! year,month,day,seconds components of a date + integer :: hours,minutes,secs ! hours,minutes,seconds of hh:mm:ss + character(len= 10) :: basedate ! base date (yyyymmdd) + character(len= 8) :: basesec ! base seconds + character(len= 8) :: cdate ! system date + character(len= 8) :: ctime ! system time + real(r8):: time ! current time + real(r8):: timedata(2) ! time interval boundaries + integer :: dim1id(1) ! netCDF dimension id + integer :: dim2id(2) ! netCDF dimension id + integer :: varid ! netCDF variable id + character(len=max_chars) :: long_name ! variable long name + character(len=max_namlen):: varname ! variable name + character(len=max_namlen):: units ! variable units + character(len=max_namlen):: cal ! calendar from the time-manager + character(len=max_namlen):: caldesc ! calendar description to put on file + character(len=256):: str ! global attribute string + real(r8), pointer :: histo(:,:) ! temporary + integer :: status + real(r8) :: zsoi_1d(1) + character(len=*),parameter :: subname = 'htape_timeconst' + !----------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + !*** Time constant grid variables only on first time-sample of file *** + !------------------------------------------------------------------------------- + + if (tape(t)%ntimes == 1) then + if (mode == 'define') then + call ncd_defvar(varname='levgrnd', xtype=tape(t)%ncprec, & + dim1name='levgrnd', & + long_name='coordinate soil levels', units='m', ncid=nfid(t)) + call ncd_defvar(varname='levlak', xtype=tape(t)%ncprec, & + dim1name='levlak', & + long_name='coordinate lake levels', units='m', ncid=nfid(t)) + call ncd_defvar(varname='levdcmp', xtype=tape(t)%ncprec, dim1name='levdcmp', & + long_name='coordinate soil levels', units='m', ncid=nfid(t)) + elseif (mode == 'write') then + if ( masterproc ) write(iulog, *) ' zsoi:',zsoi + call ncd_io(varname='levgrnd', data=zsoi, ncid=nfid(t), flag='write') + call ncd_io(varname='levlak' , data=zlak, ncid=nfid(t), flag='write') + if (use_vertsoilc) then + call ncd_io(varname='levdcmp', data=zsoi, ncid=nfid(t), flag='write') + else + zsoi_1d(1) = 1._r8 + call ncd_io(varname='levdcmp', data=zsoi_1d, ncid=nfid(t), flag='write') + end if + endif + endif + + !------------------------------------------------------------------------------- + !*** Time definition variables *** + !------------------------------------------------------------------------------- + + ! For define mode -- only do this for first time-sample + if (mode == 'define' .and. tape(t)%ntimes == 1) then + call get_ref_date(yr, mon, day, nbsec) + nstep = get_nstep() + hours = nbsec / 3600 + minutes = (nbsec - hours*3600) / 60 + secs = (nbsec - hours*3600 - minutes*60) + write(basedate,80) yr,mon,day +80 format(i4.4,'-',i2.2,'-',i2.2) + write(basesec ,90) hours, minutes, secs +90 format(i2.2,':',i2.2,':',i2.2) + + dim1id(1) = time_dimid + str = 'days since ' // basedate // " " // basesec + call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & + long_name='time',units=str) + cal = get_calendar() + if ( trim(cal) == NO_LEAP_C )then + caldesc = "noleap" + else if ( trim(cal) == GREGORIAN_C )then + caldesc = "gregorian" + end if + call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t), varid, 'bounds', 'time_bounds') + + dim1id(1) = time_dimid + call ncd_defvar(nfid(t) , 'mcdate', ncd_int, 1, dim1id , varid, & + long_name = 'current date (YYYYMMDD)') + call ncd_defvar(nfid(t) , 'mcsec' , ncd_int, 1, dim1id , varid, & + long_name = 'current seconds of current date', units='s') + call ncd_defvar(nfid(t) , 'mdcur' , ncd_int, 1, dim1id , varid, & + long_name = 'current day (from base day)') + call ncd_defvar(nfid(t) , 'mscur' , ncd_int, 1, dim1id , varid, & + long_name = 'current seconds of current day') + call ncd_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & + long_name = 'time step') + + dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid + call ncd_defvar(nfid(t), 'time_bounds', ncd_double, 2, dim2id, varid, & + long_name = 'history time interval endpoints') + + dim2id(1) = strlen_dimid; dim2id(2) = time_dimid + call ncd_defvar(nfid(t), 'date_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t), 'time_written', ncd_char, 2, dim2id, varid) + + if ( len_trim(TimeConst3DVars_Filename) > 0 )then + call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars_filename', & + trim(TimeConst3DVars_Filename)) + end if + if ( len_trim(TimeConst3DVars) > 0 )then + call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars', & + trim(TimeConst3DVars)) + end if + + elseif (mode == 'write') then + + call get_curr_time (mdcur, mscur) + call get_curr_date (yr, mon, day, mcsec) + mcdate = yr*10000 + mon*100 + day + nstep = get_nstep() + + call ncd_io('mcdate', mcdate, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mcsec' , mcsec , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mdcur' , mdcur , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mscur' , mscur , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('nstep' , nstep , 'write', nfid(t), nt=tape(t)%ntimes) + + time = mdcur + mscur/secspday + call ncd_io('time' , time , 'write', nfid(t), nt=tape(t)%ntimes) + + timedata(1) = tape(t)%begtime + timedata(2) = time + call ncd_io('time_bounds', timedata, 'write', nfid(t), nt=tape(t)%ntimes) + + call getdatetime (cdate, ctime) + call ncd_io('date_written', cdate, 'write', nfid(t), nt=tape(t)%ntimes) + + call ncd_io('time_written', ctime, 'write', nfid(t), nt=tape(t)%ntimes) + + endif + + !------------------------------------------------------------------------------- + !*** Grid definition variables *** + !------------------------------------------------------------------------------- + ! For define mode -- only do this for first time-sample + if (mode == 'define' .and. tape(t)%ntimes == 1) then + + if (ldomain%isgrid2d) then + call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, dim1name='lon', & + long_name='coordinate longitude', units='degrees_east', & + ncid=nfid(t), missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='coordinate longitude', units='degrees_east', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, dim1name='lat', & + long_name='coordinate latitude', units='degrees_north', & + ncid=nfid(t), missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='coordinate latitude', units='degrees_north', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat',& + long_name='grid cell areas', units='km^2', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='grid cell areas', units='km^2', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='topo', xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat',& + long_name='grid cell topography', units='m', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='topo', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='grid cell topography', units='m', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat', & + long_name='land fraction', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='land fraction', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='landmask', xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + else + call ncd_defvar(varname='landmask', xtype=ncd_int, & + dim1name=grlnd, & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='pftmask' , xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + else + call ncd_defvar(varname='pftmask' , xtype=ncd_int, & + dim1name=grlnd, & + long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + end if + + else if (mode == 'write') then + + ! Most of this is constant and only needs to be done on tape(t)%ntimes=1 + ! But, some may change for dynamic PATCH mode for example + + if (ldomain%isgrid2d) then + call ncd_io(varname='lon', data=lon1d, ncid=nfid(t), flag='write') + call ncd_io(varname='lat', data=lat1d, ncid=nfid(t), flag='write') + else + call ncd_io(varname='lon', data=ldomain%lonc, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='lat', data=ldomain%latc, dim1name=grlnd, ncid=nfid(t), flag='write') + end if + call ncd_io(varname='area' , data=ldomain%area, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='landfrac', data=ldomain%frac, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='landmask', data=ldomain%mask, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='pftmask' , data=ldomain%pftm, dim1name=grlnd, ncid=nfid(t), flag='write') + + end if ! (define/write mode + + end subroutine htape_timeconst + + !----------------------------------------------------------------------- + subroutine hfields_write(t, mode) + ! + ! !DESCRIPTION: + ! Write history tape. Issue the call to write the variable. + ! + ! !USES: + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + integer :: k ! 1d index + integer :: c,l,p ! indices + integer :: beg1d_out ! on-node 1d hbuf pointer start index + integer :: end1d_out ! on-node 1d hbuf pointer end index + integer :: num1d_out ! size of hbuf first dimension (overall all nodes) + integer :: num2d ! hbuf second dimension size + integer :: nt ! time index + integer :: ier ! error status + character(len=1) :: avgflag ! time averaging flag + character(len=max_chars) :: long_name! long name + character(len=max_chars) :: units ! units + character(len=max_namlen):: varname ! variable name + character(len=32) :: avgstr ! time averaging type + character(len=8) :: type1d_out ! history output 1d type + character(len=8) :: type2d ! history output 2d type + character(len=32) :: dim1name ! temporary + character(len=32) :: dim2name ! temporary + real(r8), pointer :: histo(:,:) ! temporary + real(r8), pointer :: hist1do(:) ! temporary + character(len=*),parameter :: subname = 'hfields_write' +!----------------------------------------------------------------------- + + ! Write/define 1d topological info + + if (.not. tape(t)%dov2xy) then + if (mode == 'define') then + call hfields_1dinfo(t, mode='define') + else if (mode == 'write') then + call hfields_1dinfo(t, mode='write') + end if + end if + + ! Define time-dependent variables create variables and attributes for field list + + do f = 1,tape(t)%nflds + + ! Set history field variables + + varname = tape(t)%hlist(f)%field%name + long_name = tape(t)%hlist(f)%field%long_name + units = tape(t)%hlist(f)%field%units + avgflag = tape(t)%hlist(f)%avgflag + type1d_out = tape(t)%hlist(f)%field%type1d_out + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + num1d_out = tape(t)%hlist(f)%field%num1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + nt = tape(t)%ntimes + + if (mode == 'define') then + + select case (avgflag) + case ('A') + avgstr = 'mean' + case ('I') + avgstr = 'instantaneous' + case ('X') + avgstr = 'maximum' + case ('M') + avgstr = 'minimum' + case default + write(iulog,*) trim(subname),' ERROR: unknown time averaging flag (avgflag)=',avgflag + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + if (type1d_out == grlnd) then + if (ldomain%isgrid2d) then + dim1name = 'lon' ; dim2name = 'lat' + else + dim1name = trim(grlnd); dim2name = 'undefined' + end if + else + dim1name = type1d_out ; dim2name = 'undefined' + endif + + if (dim2name == 'undefined') then + if (num2d == 1) then + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=type2d, dim3name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + end if + else + if (num2d == 1) then + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=dim2name, dim3name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, dim4name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + end if + endif + + else if (mode == 'write') then + + ! Determine output buffer + + histo => tape(t)%hlist(f)%hbuf + + ! Allocate dynamic memory + + if (num2d == 1) then + allocate(hist1do(beg1d_out:end1d_out), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + hist1do(beg1d_out:end1d_out) = histo(beg1d_out:end1d_out,1) + end if + + ! Write history output. Always output land and ocean runoff on xy grid. + + if (num2d == 1) then + call ncd_io(flag='write', varname=varname, & + dim1name=type1d_out, data=hist1do, ncid=nfid(t), nt=nt) + else + call ncd_io(flag='write', varname=varname, & + dim1name=type1d_out, data=histo, ncid=nfid(t), nt=nt) + end if + + + ! Deallocate dynamic memory + + if (num2d == 1) then + deallocate(hist1do) + end if + + end if + + end do + + end subroutine hfields_write + + !----------------------------------------------------------------------- + subroutine hfields_1dinfo(t, mode) + ! + ! !DESCRIPTION: + ! Write/define 1d info for history tape. + ! + ! !USES: + use decompMod , only : ldecomp + use domainMod , only : ldomain, ldomain + ! + ! !ARGUMENTS: + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: f ! field index + integer :: k ! 1d index + integer :: g,c,l,p ! indices + integer :: ier ! errir status + real(r8), pointer :: rgarr(:) ! temporary + real(r8), pointer :: rcarr(:) ! temporary + real(r8), pointer :: rlarr(:) ! temporary + real(r8), pointer :: rparr(:) ! temporary + integer , pointer :: igarr(:) ! temporary + integer , pointer :: icarr(:) ! temporary + integer , pointer :: ilarr(:) ! temporary + integer , pointer :: iparr(:) ! temporary + type(file_desc_t) :: ncid ! netcdf file + type(bounds_type) :: bounds + character(len=*),parameter :: subname = 'hfields_1dinfo' +!----------------------------------------------------------------------- + + call get_proc_bounds(bounds) + + ncid = nfid(t) + + if (mode == 'define') then + + ! Define gridcell info + + call ncd_defvar(varname='grid1d_lon', xtype=ncd_double, dim1name=nameg, & + long_name='gridcell longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='grid1d_lat', xtype=ncd_double, dim1name=nameg, & + long_name='gridcell latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='grid1d_ixy', xtype=ncd_int, dim1name=nameg, & + long_name='2d longitude index of corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='grid1d_jxy', xtype=ncd_int, dim1name=nameg, & + long_name='2d latitude index of corresponding gridcell', ncid=ncid) + + ! Define landunit info + + call ncd_defvar(varname='land1d_lon', xtype=ncd_double, dim1name=namel, & + long_name='landunit longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='land1d_lat', xtype=ncd_double, dim1name=namel, & + long_name='landunit latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='land1d_ixy', xtype=ncd_int, dim1name=namel, & + long_name='2d longitude index of corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, & + long_name='2d latitude index of corresponding landunit', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', & + ! long_name='1d grid index of corresponding landunit', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, & + long_name='landunit weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='land1d_ityplunit', xtype=ncd_int, dim1name=namel, & + long_name='landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + call ncd_defvar(varname='land1d_active', xtype=ncd_log, dim1name=namel, & + long_name='true => do computations on this landunit', ncid=ncid) + + ! Define column info + + call ncd_defvar(varname='cols1d_lon', xtype=ncd_double, dim1name=namec, & + long_name='column longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='cols1d_lat', xtype=ncd_double, dim1name=namec, & + long_name='column latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='cols1d_ixy', xtype=ncd_int, dim1name=namec, & + long_name='2d longitude index of corresponding column', ncid=ncid) + + call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, & + long_name='2d latitude index of corresponding column', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', & + ! long_name='1d grid index of corresponding column', ncid=ncid) + + !call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', & + ! long_name='1d landunit index of corresponding column', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, & + long_name='column weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='cols1d_wtlunit', xtype=ncd_double, dim1name=namec, & + long_name='column weight relative to corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='cols1d_itype_lunit', xtype=ncd_int, dim1name=namec, & + long_name='column landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + call ncd_defvar(varname='cols1d_active', xtype=ncd_log, dim1name=namec, & + long_name='true => do computations on this column', ncid=ncid) + + ! Define patch info + + call ncd_defvar(varname='pfts1d_lon', xtype=ncd_double, dim1name=namep, & + long_name='pft longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='pfts1d_lat', xtype=ncd_double, dim1name=namep, & + long_name='pft latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='pfts1d_ixy', xtype=ncd_int, dim1name=namep, & + long_name='2d longitude index of corresponding pft', ncid=ncid) + + call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, & + long_name='2d latitude index of corresponding pft', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', & + ! long_name='1d grid index of corresponding pft', ncid=ncid) + + !call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', & + ! long_name='1d landunit index of corresponding pft', ncid=ncid) + + !call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', & + ! long_name='1d column index of corresponding pft', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='pfts1d_wtcol', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding column', ncid=ncid) + + call ncd_defvar(varname='pfts1d_itype_veg', xtype=ncd_int, dim1name=namep, & + long_name='pft vegetation type', ncid=ncid) + + call ncd_defvar(varname='pfts1d_itype_lunit', xtype=ncd_int, dim1name=namep, & + long_name='pft landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + call ncd_defvar(varname='pfts1d_active', xtype=ncd_log, dim1name=namep, & + long_name='true => do computations on this pft', ncid=ncid) + + else if (mode == 'write') then + + ! Determine bounds + + allocate(& + rgarr(bounds%begg:bounds%endg),& + rlarr(bounds%begl:bounds%endl),& + rcarr(bounds%begc:bounds%endc),& + rparr(bounds%begp:bounds%endp),& + stat=ier) + if (ier /= 0) then + call endrun(msg=' hfields_1dinfo allocation error of rarrs'//errMsg(__FILE__, __LINE__)) + end if + + allocate(& + igarr(bounds%begg:bounds%endg),& + ilarr(bounds%begl:bounds%endl),& + icarr(bounds%begc:bounds%endc),& + iparr(bounds%begp:bounds%endp),stat=ier) + if (ier /= 0) then + call endrun(msg=' hfields_1dinfo allocation error of iarrs'//errMsg(__FILE__, __LINE__)) + end if + + ! Write gridcell info + + call ncd_io(varname='grid1d_lon', data=grc%londeg, dim1name=nameg, ncid=ncid, flag='write') + call ncd_io(varname='grid1d_lat', data=grc%latdeg, dim1name=nameg, ncid=ncid, flag='write') + do g = bounds%begg,bounds%endg + igarr(g)= mod(ldecomp%gdc2glo(g)-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='grid1d_ixy', data=igarr , dim1name=nameg, ncid=ncid, flag='write') + do g = bounds%begg,bounds%endg + igarr(g)= (ldecomp%gdc2glo(g) - 1)/ldomain%ni + 1 + enddo + call ncd_io(varname='grid1d_jxy', data=igarr , dim1name=nameg, ncid=ncid, flag='write') + + ! Write landunit info + + do l = bounds%begl,bounds%endl + rlarr(l) = grc%londeg(lun%gridcell(l)) + enddo + call ncd_io(varname='land1d_lon', data=rlarr, dim1name=namel, ncid=ncid, flag='write') + do l = bounds%begl,bounds%endl + rlarr(l) = grc%latdeg(lun%gridcell(l)) + enddo + call ncd_io(varname='land1d_lat', data=rlarr, dim1name=namel, ncid=ncid, flag='write') + do l= bounds%begl,bounds%endl + ilarr(l) = mod(ldecomp%gdc2glo(lun%gridcell(l))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='land1d_ixy', data=ilarr, dim1name=namel, ncid=ncid, flag='write') + do l = bounds%begl,bounds%endl + ilarr(l) = (ldecomp%gdc2glo(lun%gridcell(l))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='land1d_jxy' , data=ilarr , dim1name=namel, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 + !call ncd_io(varname='land1d_gi' , data=lun%gridcell, dim1name=namel, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='land1d_wtgcell' , data=lun%wtgcell , dim1name=namel, ncid=ncid, flag='write') + call ncd_io(varname='land1d_ityplunit', data=lun%itype , dim1name=namel, ncid=ncid, flag='write') + call ncd_io(varname='land1d_active' , data=lun%active , dim1name=namel, ncid=ncid, flag='write') + + ! Write column info + + do c = bounds%begc,bounds%endc + rcarr(c) = grc%londeg(col%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lon', data=rcarr, dim1name=namec, ncid=ncid, flag='write') + do c = bounds%begc,bounds%endc + rcarr(c) = grc%latdeg(col%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lat', data=rcarr, dim1name=namec, ncid=ncid, flag='write') + do c = bounds%begc,bounds%endc + icarr(c) = mod(ldecomp%gdc2glo(col%gridcell(c))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='cols1d_ixy', data=icarr, dim1name=namec, ncid=ncid, flag='write') + do c = bounds%begc,bounds%endc + icarr(c) = (ldecomp%gdc2glo(col%gridcell(c))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='cols1d_jxy' , data=icarr ,dim1name=namec, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 + !call ncd_io(varname='cols1d_gi' , data=col%gridcell, dim1name=namec, ncid=ncid, flag='write') + !call ncd_io(varname='cols1d_li' , data=col%landunit, dim1name=namec, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='cols1d_wtgcell', data=col%wtgcell , dim1name=namec, ncid=ncid, flag='write') + call ncd_io(varname='cols1d_wtlunit', data=col%wtlunit , dim1name=namec, ncid=ncid, flag='write') + do c = bounds%begc,bounds%endc + icarr(c) = lun%itype(col%landunit(c)) + enddo + call ncd_io(varname='cols1d_itype_lunit', data=icarr , dim1name=namec, ncid=ncid, flag='write') + call ncd_io(varname='cols1d_active' , data=col%active , dim1name=namec, ncid=ncid, flag='write') + + ! Write patch info + + do p = bounds%begp,bounds%endp + rparr(p) = grc%londeg(patch%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lon', data=rparr, dim1name=namep, ncid=ncid, flag='write') + do p = bounds%begp,bounds%endp + rparr(p) = grc%latdeg(patch%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lat', data=rparr, dim1name=namep, ncid=ncid, flag='write') + do p = bounds%begp,bounds%endp + iparr(p) = mod(ldecomp%gdc2glo(patch%gridcell(p))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='pfts1d_ixy', data=iparr, dim1name=namep, ncid=ncid, flag='write') + do p = bounds%begp,bounds%endp + iparr(p) = (ldecomp%gdc2glo(patch%gridcell(p))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_io(varname='pfts1d_gi' , data=patch%gridcell, dim1name=namep, ncid=ncid, flag='write') + !call ncd_io(varname='pfts1d_li' , data=patch%landunit, dim1name=namep, ncid=ncid, flag='write') + !call ncd_io(varname='pfts1d_ci' , data=patch%column , dim1name=namep, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='pfts1d_wtgcell' , data=patch%wtgcell , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtlunit' , data=patch%wtlunit , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtcol' , data=patch%wtcol , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_itype_veg', data=patch%itype , dim1name=namep, ncid=ncid, flag='write') + + do p = bounds%begp,bounds%endp + iparr(p) = lun%itype(patch%landunit(p)) + enddo + call ncd_io(varname='pfts1d_itype_lunit', data=iparr , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_active' , data=patch%active , dim1name=namep, ncid=ncid, flag='write') + + deallocate(rgarr,rlarr,rcarr,rparr) + deallocate(igarr,ilarr,icarr,iparr) + + end if + + end subroutine hfields_1dinfo + + !----------------------------------------------------------------------- + subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & + watsat_col, sucsat_col, bsw_col, hksat_col) + ! + ! !DESCRIPTION: + ! Write history tape(s) + ! Determine if next time step is beginning of history interval and if so: + ! increment the current time sample counter, open a new history file + ! and if needed (i.e., when ntim = 1), write history data to current + ! history file, reset field accumulation counters to zero. + ! If primary history file is full or at the last time step of the simulation, + ! write restart dataset and close all history fiels. + ! If history file is full or at the last time step of the simulation: + ! close history file + ! and reset time sample counter to zero if file is full. + ! Daily-averaged data for the first day in September are written on + ! date = 00/09/02 with mscur = 0. + ! Daily-averaged data for the first day in month mm are written on + ! date = yyyy/mm/02 with mscur = 0. + ! Daily-averaged data for the 30th day (last day in September) are written + ! on date = 0000/10/01 mscur = 0. + ! Daily-averaged data for the last day in month mm are written on + ! date = yyyy/mm+1/01 with mscur = 0. + ! + ! !USES: + use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time, get_prev_date + use clm_varcon , only : secspday + use perf_mod , only : t_startf, t_stopf + use clm_varpar , only : nlevgrnd + ! + ! !ARGUMENTS: + logical, intent(in) :: rstwr ! true => write restart file this step + logical, intent(in) :: nlend ! true => end of run on this step + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: watsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: sucsat_col( bounds%begc:,1: ) + real(r8) , intent(in) :: bsw_col( bounds%begc:,1: ) + real(r8) , intent(in) :: hksat_col( bounds%begc:,1: ) + ! + ! !LOCAL VARIABLES: + integer :: t ! tape index + integer :: f ! field index + integer :: ier ! error code + integer :: nstep ! current step + integer :: day ! current day (1 -> 31) + integer :: mon ! current month (1 -> 12) + integer :: yr ! current year (0 -> ...) + integer :: mdcur ! current day + integer :: mscur ! seconds of current day + integer :: mcsec ! current time of day [seconds] + integer :: daym1 ! nstep-1 day (1 -> 31) + integer :: monm1 ! nstep-1 month (1 -> 12) + integer :: yrm1 ! nstep-1 year (0 -> ...) + integer :: mcsecm1 ! nstep-1 time of day [seconds] + real(r8):: time ! current time + character(len=256) :: str ! global attribute string + logical :: if_stop ! true => last time step of run + logical, save :: do_3Dtconst = .true. ! true => write out 3D time-constant data + character(len=*),parameter :: subname = 'hist_htapes_wrapup' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(watsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sucsat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(bsw_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(hksat_col) == (/bounds%endc, nlevgrnd/)), errMsg(__FILE__, __LINE__)) + + ! get current step + + nstep = get_nstep() + + ! Set calendar for current time step + + call get_curr_date (yr, mon, day, mcsec) + call get_curr_time (mdcur, mscur) + time = mdcur + mscur/secspday + + ! Set calendar for current for previous time step + + call get_prev_date (yrm1, monm1, daym1, mcsecm1) + + ! Loop over active history tapes, create new history files if necessary + ! and write data to history files if end of history interval. + do t = 1, ntapes + + ! Skip nstep=0 if monthly average + + if (nstep==0 .and. tape(t)%nhtfrq==0) cycle + + ! Determine if end of history interval + tape(t)%is_endhist = .false. + if (tape(t)%nhtfrq==0) then !monthly average + if (mon /= monm1) tape(t)%is_endhist = .true. + else + if (mod(nstep,tape(t)%nhtfrq) == 0) tape(t)%is_endhist = .true. + end if + + ! If end of history interval + + if (tape(t)%is_endhist) then + + ! Normalize history buffer if time averaged + + call hfields_normalize(t) + + ! Increment current time sample counter. + + tape(t)%ntimes = tape(t)%ntimes + 1 + + ! Create history file if appropriate and build time comment + + ! If first time sample, generate unique history file name, open file, + ! define dims, vars, etc. + + + if (tape(t)%ntimes == 1) then + call t_startf('hist_htapes_wrapup_define') + locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & + hist_mfilt=tape(t)%mfilt, hist_file=t) + if (masterproc) then + write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t)), & + ' at nstep = ',get_nstep() + write(iulog,*)'calling htape_create for file t = ',t + endif + call htape_create (t) + + ! Define time-constant field variables + call htape_timeconst(t, mode='define') + + ! Define 3D time-constant field variables only to first primary tape + if ( do_3Dtconst .and. t == 1 ) then + call htape_timeconst3D(t, & + bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='define') + TimeConst3DVars_Filename = trim(locfnh(t)) + end if + + ! Define model field variables + call hfields_write(t, mode='define') + + ! Exit define model + call ncd_enddef(nfid(t)) + call t_stopf('hist_htapes_wrapup_define') + endif + + call t_startf('hist_htapes_wrapup_tconst') + ! Write time constant history variables + call htape_timeconst(t, mode='write') + + ! Write 3D time constant history variables only to first primary tape + if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then + call htape_timeconst3D(t, & + bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='write') + do_3Dtconst = .false. + end if + + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & + trim(locfnh(t)),' at nstep = ',get_nstep(), & + ' for history time interval beginning at ', tape(t)%begtime, & + ' and ending at ',time + write(iulog,*) + call shr_sys_flush(iulog) + endif + + ! Update beginning time of next interval + tape(t)%begtime = time + call t_stopf('hist_htapes_wrapup_tconst') + + ! Write history time samples + call t_startf('hist_htapes_wrapup_write') + call hfields_write(t, mode='write') + call t_stopf('hist_htapes_wrapup_write') + + ! Zero necessary history buffers + call hfields_zero(t) + + end if + + end do ! end loop over history tapes + + ! Determine if file needs to be closed + + call hist_do_disp (ntapes, tape(:)%ntimes, tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) + + ! Close open history file + ! Auxilary files may have been closed and saved off without being full, + ! must reopen the files + + do t = 1, ntapes + if (if_disphist(t)) then + if (tape(t)%ntimes /= 0) then + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Closing local history file ',& + trim(locfnh(t)),' at nstep = ', get_nstep() + write(iulog,*) + endif + call ncd_pio_closefile(nfid(t)) + if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt)) then + call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) + end if + else + if (masterproc) then + write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' + end if + endif + endif + end do + + ! Reset number of time samples to zero if file is full + + do t = 1, ntapes + if (if_disphist(t) .and. tape(t)%ntimes==tape(t)%mfilt) then + tape(t)%ntimes = 0 + end if + end do + + end subroutine hist_htapes_wrapup + + !----------------------------------------------------------------------- + subroutine hist_restart_ncd (bounds, ncid, flag, rdate) + ! + ! !DESCRIPTION: + ! Read/write history file restart data. + ! If the current history file(s) are not full, file(s) are opened + ! so that subsequent time samples are added until the file is full. + ! A new history file is used on a branch run. + ! + ! !USES: + use clm_varctl , only : nsrest, caseid, inst_suffix, nsrStartup, nsrBranch + use fileutils , only : getfil + use domainMod , only : ldomain + use clm_varpar , only : nlevgrnd, nlevlak, numrad, nlevdecomp_full + use clm_time_manager, only : is_restart + use restUtilMod , only : iflag_skip + use pio + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf file + character(len=*) , intent(in) :: flag !'read' or 'write' + character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name + ! + ! !LOCAL VARIABLES: + integer :: max_nflds ! Max number of fields + integer :: num1d,beg1d,end1d ! 1d size, beginning and ending indices + integer :: num1d_out,beg1d_out,end1d_out ! 1d size, beginning and ending indices + integer :: num2d ! 2d size (e.g. number of vertical levels) + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + character(len=max_namlen) :: name ! variable name + character(len=max_namlen) :: name_acc ! accumulator variable name + character(len=max_namlen) :: long_name ! long name of variable + character(len=max_chars) :: long_name_acc ! long name for accumulator + character(len=max_chars) :: units ! units of variable + character(len=max_chars) :: units_acc ! accumulator units + character(len=max_chars) :: fname ! full name of history file + character(len=max_chars) :: locrest(max_tapes) ! local history restart file names + + character(len=max_namlen),allocatable :: tname(:) + character(len=max_chars), allocatable :: tunits(:),tlongname(:) + character(len=8), allocatable :: tmpstr(:,:) + character(len=1), allocatable :: tavgflag(:) + integer :: start(2) + + character(len=1) :: hnum ! history file index + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type + character(len=8) :: type2d ! history buffer 2d type + character(len=32) :: dim1name ! temporary + character(len=32) :: dim2name ! temporary + type(var_desc_t) :: name_desc ! variable descriptor for name + type(var_desc_t) :: longname_desc ! variable descriptor for long_name + type(var_desc_t) :: units_desc ! variable descriptor for units + type(var_desc_t) :: type1d_desc ! variable descriptor for type1d + type(var_desc_t) :: type1d_out_desc ! variable descriptor for type1d_out + type(var_desc_t) :: type2d_desc ! variable descriptor for type2d + type(var_desc_t) :: avgflag_desc ! variable descriptor for avgflag + type(var_desc_t) :: p2c_scale_type_desc ! variable descriptor for p2c_scale_type + type(var_desc_t) :: c2l_scale_type_desc ! variable descriptor for c2l_scale_type + type(var_desc_t) :: l2g_scale_type_desc ! variable descriptor for l2g_scale_type + integer :: status ! error status + integer :: dimid ! dimension ID + integer :: k ! 1d index + integer :: ntapes_onfile ! number of history tapes on the restart file + integer :: nflds_onfile ! number of history fields on the restart file + integer :: t ! tape index + integer :: f ! field index + integer :: varid ! variable id + integer, allocatable :: itemp(:) ! temporary + real(r8), pointer :: hbuf(:,:) ! history buffer + real(r8), pointer :: hbuf1d(:) ! 1d history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + integer , pointer :: nacs1d(:) ! 1d accumulation counter + integer :: ier ! error code + type(Var_desc_t) :: vardesc ! netCDF variable description + character(len=*),parameter :: subname = 'hist_restart_ncd' +!------------------------------------------------------------------------ + + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump) + + ! If branch run, initialize file times and return + + if (flag == 'read') then + if (nsrest == nsrBranch) then + do t = 1,ntapes + tape(t)%ntimes = 0 + end do + return + end if + ! If startup run just return + if (nsrest == nsrStartup) then + RETURN + end if + endif + + ! Read history file data only for restart run (not for branch run) + + ! + ! First when writing out and in define mode, create files and define all variables + ! + !================================================ + if (flag == 'define') then + !================================================ + + if (.not. present(rdate)) then + call endrun(msg=' variable rdate must be present for writing restart files'//& + errMsg(__FILE__, __LINE__)) + end if + + ! + ! On master restart file add ntapes/max_chars dimension + ! and then add the history and history restart filenames + ! + call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) + call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) + + call ncd_defvar(ncid=ncid, varname='locfnh', xtype=ncd_char, & + long_name="History filename", & + comment="This variable NOT needed for startup or branch simulations", & + dim1name='max_chars', dim2name="ntapes" ) + ier = PIO_inq_varid(ncid, 'locfnh', vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) + + call ncd_defvar(ncid=ncid, varname='locfnhr', xtype=ncd_char, & + long_name="Restart history filename", & + comment="This variable NOT needed for startup or branch simulations", & + dim1name='max_chars', dim2name="ntapes" ) + ier = PIO_inq_varid(ncid, 'locfnhr', vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_skip) + + ! max_nflds is the maximum number of fields on any tape + ! max_flds is the maximum number possible number of fields + + max_nflds = max_nFields() + + ! Loop over tapes - write out namelist information to each restart-history tape + ! only read/write accumulators and counters if needed + + do t = 1,ntapes + + ! Create the restart history filename and open it + write(hnum,'(i1.1)') t-1 + locfnhr(t) = "./" // trim(caseid) //".clm2"// trim(inst_suffix) & + // ".rh" // hnum //"."// trim(rdate) //".nc" + + call htape_create( t, histrest=.true. ) + + ! Add read/write accumultators and counters if needed + if (.not. tape(t)%is_endhist) then + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + long_name = tape(t)%hlist(f)%field%long_name + units = tape(t)%hlist(f)%field%units + name_acc = trim(name) // "_acc" + units_acc = "unitless positive integer" + long_name_acc = trim(long_name) // " accumulator number of samples" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (type1d_out == grlnd) then + if (ldomain%isgrid2d) then + dim1name = 'lon' ; dim2name = 'lat' + else + dim1name = trim(grlnd); dim2name = 'undefined' + end if + else + dim1name = type1d_out ; dim2name = 'undefined' + endif + + if (dim2name == 'undefined') then + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if + else + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if + endif + end do + endif + + ! + ! Add namelist information to each restart history tape + ! + call ncd_defdim( ncid_hist(t), 'fname_lenp2' , max_namlen+2, dimid) + call ncd_defdim( ncid_hist(t), 'fname_len' , max_namlen , dimid) + call ncd_defdim( ncid_hist(t), 'len1' , 1 , dimid) + call ncd_defdim( ncid_hist(t), 'scalar' , 1 , dimid) + call ncd_defdim( ncid_hist(t), 'max_chars' , max_chars , dimid) + call ncd_defdim( ncid_hist(t), 'max_nflds' , max_nflds , dimid) + call ncd_defdim( ncid_hist(t), 'max_flds' , max_flds , dimid) + + call ncd_defvar(ncid=ncid_hist(t), varname='nhtfrq', xtype=ncd_int, & + long_name="Frequency of history writes", & + comment="Namelist item", & + units="absolute value of negative is in hours, 0=monthly, positive is time-steps", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='mfilt', xtype=ncd_int, & + long_name="Number of history time samples on a file", units="unitless", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='ncprec', xtype=ncd_int, & + long_name="Flag for data precision", flag_values=(/1,2/), & + comment="Namelist item", & + nvalid_range=(/1,2/), & + flag_meanings=(/"single-precision", "double-precision"/), & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='dov2xy', xtype=ncd_log, & + long_name="Output on 2D grid format (TRUE) or vector format (FALSE)", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='fincl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to include", & + dim1name='fname_lenp2', dim2name='max_flds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='fexcl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to exclude", & + dim1name='fname_lenp2', dim2name='max_flds' ) + + call ncd_defvar(ncid=ncid_hist(t), varname='nflds', xtype=ncd_int, & + long_name="Number of fields on file", units="unitless", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='ntimes', xtype=ncd_int, & + long_name="Number of time steps on file", units="time-step", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='is_endhist', xtype=ncd_log, & + long_name="End of history file", dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='begtime', xtype=ncd_double, & + long_name="Beginning time", units="time units", & + dim1name='scalar') + + call ncd_defvar(ncid=ncid_hist(t), varname='num2d', xtype=ncd_int, & + long_name="Size of second dimension", units="unitless", & + dim1name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='hpindex', xtype=ncd_int, & + long_name="History pointer index", units="unitless", & + dim1name='max_nflds' ) + + call ncd_defvar(ncid=ncid_hist(t), varname='avgflag', xtype=ncd_char, & + long_name="Averaging flag", & + units="A=Average, X=Maximum, M=Minimum, I=Instantaneous", & + dim1name='len1', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='name', xtype=ncd_char, & + long_name="Fieldnames", & + dim1name='fname_len', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='long_name', xtype=ncd_char, & + long_name="Long descriptive names for fields", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='units', xtype=ncd_char, & + long_name="Units for each history field output", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type1d', xtype=ncd_char, & + long_name="1st dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type1d_out', xtype=ncd_char, & + long_name="1st output dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type2d', xtype=ncd_char, & + long_name="2nd dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='p2c_scale_type', xtype=ncd_char, & + long_name="PFT to column scale type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='c2l_scale_type', xtype=ncd_char, & + long_name="column to landunit scale type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='l2g_scale_type', xtype=ncd_char, & + long_name="landunit to gridpoint scale type", & + dim1name='string_length', dim2name='max_nflds' ) + + call ncd_enddef(ncid_hist(t)) + + end do ! end of ntapes loop + + RETURN + + ! + ! First write out namelist information to each restart history file + ! + !================================================ + else if (flag == 'write') then + !================================================ + + ! Add history filenames to master restart file + do t = 1,ntapes + call ncd_io('locfnh', locfnh(t), 'write', ncid, nt=t) + call ncd_io('locfnhr', locfnhr(t), 'write', ncid, nt=t) + end do + + fincl(:,1) = hist_fincl1(:) + fincl(:,2) = hist_fincl2(:) + fincl(:,3) = hist_fincl3(:) + fincl(:,4) = hist_fincl4(:) + fincl(:,5) = hist_fincl5(:) + fincl(:,6) = hist_fincl6(:) + + fexcl(:,1) = hist_fexcl1(:) + fexcl(:,2) = hist_fexcl2(:) + fexcl(:,3) = hist_fexcl3(:) + fexcl(:,4) = hist_fexcl4(:) + fexcl(:,5) = hist_fexcl5(:) + fexcl(:,6) = hist_fexcl6(:) + + max_nflds = max_nFields() + + start(1)=1 + + + ! + ! Add history namelist data to each history restart tape + ! + allocate(itemp(max_nflds)) + + do t = 1,ntapes + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='write') + + itemp(:) = 0 + do f=1,tape(t)%nflds + itemp(f) = tape(t)%hlist(f)%field%num2d + end do + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') + + itemp(:) = 0 + do f=1,tape(t)%nflds + itemp(f) = tape(t)%hlist(f)%field%hpindex + end do + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='write') + + call ncd_io('nflds', tape(t)%nflds, 'write', ncid_hist(t) ) + call ncd_io('ntimes', tape(t)%ntimes, 'write', ncid_hist(t) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'write', ncid_hist(t) ) + call ncd_io('mfilt', tape(t)%mfilt, 'write', ncid_hist(t) ) + call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t) ) + call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t) ) + allocate(tmpstr(tape(t)%nflds,6 ),tname(tape(t)%nflds), & + tavgflag(tape(t)%nflds),tunits(tape(t)%nflds),tlongname(tape(t)%nflds)) + do f=1,tape(t)%nflds + tname(f) = tape(t)%hlist(f)%field%name + tunits(f) = tape(t)%hlist(f)%field%units + tlongname(f) = tape(t)%hlist(f)%field%long_name + tmpstr(f,1) = tape(t)%hlist(f)%field%type1d + tmpstr(f,2) = tape(t)%hlist(f)%field%type1d_out + tmpstr(f,3) = tape(t)%hlist(f)%field%type2d + tavgflag(f) = tape(t)%hlist(f)%avgflag + tmpstr(f,4) = tape(t)%hlist(f)%field%p2c_scale_type + tmpstr(f,5) = tape(t)%hlist(f)%field%c2l_scale_type + tmpstr(f,6) = tape(t)%hlist(f)%field%l2g_scale_type + end do + call ncd_io( 'name', tname, 'write',ncid_hist(t)) + call ncd_io('long_name', tlongname, 'write', ncid_hist(t)) + call ncd_io('units', tunits, 'write',ncid_hist(t)) + call ncd_io('type1d', tmpstr(:,1), 'write', ncid_hist(t)) + call ncd_io('type1d_out', tmpstr(:,2), 'write', ncid_hist(t)) + call ncd_io('type2d', tmpstr(:,3), 'write', ncid_hist(t)) + call ncd_io('avgflag',tavgflag , 'write', ncid_hist(t)) + call ncd_io('p2c_scale_type', tmpstr(:,4), 'write', ncid_hist(t)) + call ncd_io('c2l_scale_type', tmpstr(:,5), 'write', ncid_hist(t)) + call ncd_io('l2g_scale_type', tmpstr(:,6), 'write', ncid_hist(t)) + deallocate(tname,tlongname,tunits,tmpstr,tavgflag) + enddo + deallocate(itemp) + + ! + ! Read in namelist information + ! + !================================================ + else if (flag == 'read') then + !================================================ + + call ncd_inqdlen(ncid,dimid,ntapes_onfile, name='ntapes') + if ( is_restart() .and. ntapes_onfile /= ntapes )then + write(iulog,*) 'ntapes = ', ntapes, ' ntapes_onfile = ', ntapes_onfile + call endrun(msg=' ERROR: number of ntapes different than on restart file!,'// & + ' you can NOT change history options on restart!' //& + errMsg(__FILE__, __LINE__)) + end if + if ( is_restart() .and. ntapes > 0 )then + call ncd_io('locfnh', locfnh(1:ntapes), 'read', ncid ) + call ncd_io('locfnhr', locrest(1:ntapes), 'read', ncid ) + do t = 1,ntapes + call strip_null(locrest(t)) + call strip_null(locfnh(t)) + end do + end if + + ! Determine necessary indices - the following is needed if model decomposition is different on restart + + start(1)=1 + + if ( is_restart() )then + do t = 1,ntapes + + call getfil( locrest(t), locfnhr(t), 0 ) + call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t)), ncd_nowrite) + + if ( t == 1 )then + + call ncd_inqdlen(ncid_hist(1),dimid,max_nflds,name='max_nflds') + + allocate(itemp(max_nflds)) + end if + + call ncd_inqvid(ncid_hist(t), 'name', varid, name_desc) + call ncd_inqvid(ncid_hist(t), 'long_name', varid, longname_desc) + call ncd_inqvid(ncid_hist(t), 'units', varid, units_desc) + call ncd_inqvid(ncid_hist(t), 'type1d', varid, type1d_desc) + call ncd_inqvid(ncid_hist(t), 'type1d_out', varid, type1d_out_desc) + call ncd_inqvid(ncid_hist(t), 'type2d', varid, type2d_desc) + call ncd_inqvid(ncid_hist(t), 'avgflag', varid, avgflag_desc) + call ncd_inqvid(ncid_hist(t), 'p2c_scale_type', varid, p2c_scale_type_desc) + call ncd_inqvid(ncid_hist(t), 'c2l_scale_type', varid, c2l_scale_type_desc) + call ncd_inqvid(ncid_hist(t), 'l2g_scale_type', varid, l2g_scale_type_desc) + + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='read') + + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='read') + + call ncd_io('nflds', nflds_onfile, 'read', ncid_hist(t) ) + if ( nflds_onfile /= tape(t)%nflds )then + write(iulog,*) 'nflds = ', tape(t)%nflds, ' nflds_onfile = ', nflds_onfile + call endrun(msg=' ERROR: number of fields different than on restart file!,'// & + ' you can NOT change history options on restart!' //& + errMsg(__FILE__, __LINE__)) + end if + call ncd_io('ntimes', tape(t)%ntimes, 'read', ncid_hist(t) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'read', ncid_hist(t) ) + call ncd_io('mfilt', tape(t)%mfilt, 'read', ncid_hist(t) ) + call ncd_io('ncprec', tape(t)%ncprec, 'read', ncid_hist(t) ) + call ncd_io('begtime', tape(t)%begtime, 'read', ncid_hist(t) ) + + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='read') + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='read') + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='read') + do f=1,tape(t)%nflds + tape(t)%hlist(f)%field%num2d = itemp(f) + end do + + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='read') + do f=1,tape(t)%nflds + tape(t)%hlist(f)%field%hpindex = itemp(f) + end do + + do f=1,tape(t)%nflds + start(2) = f + call ncd_io( name_desc, tape(t)%hlist(f)%field%name, & + 'read', ncid_hist(t), start ) + call ncd_io( longname_desc, tape(t)%hlist(f)%field%long_name, & + 'read', ncid_hist(t), start ) + call ncd_io( units_desc, tape(t)%hlist(f)%field%units, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_desc, tape(t)%hlist(f)%field%type1d, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_out_desc, tape(t)%hlist(f)%field%type1d_out, & + 'read', ncid_hist(t), start ) + call ncd_io( type2d_desc, tape(t)%hlist(f)%field%type2d, & + 'read', ncid_hist(t), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(f)%avgflag, & + 'read', ncid_hist(t), start ) + call ncd_io( p2c_scale_type_desc, tape(t)%hlist(f)%field%p2c_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( c2l_scale_type_desc, tape(t)%hlist(f)%field%c2l_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( l2g_scale_type_desc, tape(t)%hlist(f)%field%l2g_scale_type, & + 'read', ncid_hist(t), start ) + call strip_null(tape(t)%hlist(f)%field%name) + call strip_null(tape(t)%hlist(f)%field%long_name) + call strip_null(tape(t)%hlist(f)%field%units) + call strip_null(tape(t)%hlist(f)%field%type1d) + call strip_null(tape(t)%hlist(f)%field%type1d_out) + call strip_null(tape(t)%hlist(f)%field%type2d) + call strip_null(tape(t)%hlist(f)%field%p2c_scale_type) + call strip_null(tape(t)%hlist(f)%field%c2l_scale_type) + call strip_null(tape(t)%hlist(f)%field%l2g_scale_type) + call strip_null(tape(t)%hlist(f)%avgflag) + + type1d_out = trim(tape(t)%hlist(f)%field%type1d_out) + select case (trim(type1d_out)) + case (grlnd) + num1d_out = numg + beg1d_out = bounds%begg + end1d_out = bounds%endg + case (nameg) + num1d_out = numg + beg1d_out = bounds%begg + end1d_out = bounds%endg + case (namel) + num1d_out = numl + beg1d_out = bounds%begl + end1d_out = bounds%endl + case (namec) + num1d_out = numc + beg1d_out = bounds%begc + end1d_out = bounds%endc + case (namep) + num1d_out = nump + beg1d_out = bounds%begp + end1d_out = bounds%endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d output type=',trim(type1d_out) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + tape(t)%hlist(f)%field%num1d_out = num1d_out + tape(t)%hlist(f)%field%beg1d_out = beg1d_out + tape(t)%hlist(f)%field%end1d_out = end1d_out + + num2d = tape(t)%hlist(f)%field%num2d + allocate (tape(t)%hlist(f)%hbuf(beg1d_out:end1d_out,num2d), & + tape(t)%hlist(f)%nacs(beg1d_out:end1d_out,num2d), & + stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f=',t,f + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + tape(t)%hlist(f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(f)%nacs(:,:) = 0 + + type1d = tape(t)%hlist(f)%field%type1d + select case (type1d) + case (grlnd) + num1d = numg + beg1d = bounds%begg + end1d = bounds%endg + case (nameg) + num1d = numg + beg1d = bounds%begg + end1d = bounds%endg + case (namel) + num1d = numl + beg1d = bounds%begl + end1d = bounds%endl + case (namec) + num1d = numc + beg1d = bounds%begc + end1d = bounds%endc + case (namep) + num1d = nump + beg1d = bounds%begp + end1d = bounds%endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d type=',type1d + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + tape(t)%hlist(f)%field%num1d = num1d + tape(t)%hlist(f)%field%beg1d = beg1d + tape(t)%hlist(f)%field%end1d = end1d + + end do ! end of flds loop + + ! If history file is not full, open it + + if (tape(t)%ntimes /= 0) then + call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) + end if + + end do ! end of tapes loop + + hist_fincl1(:) = fincl(:,1) + hist_fincl2(:) = fincl(:,2) + hist_fincl3(:) = fincl(:,3) + hist_fincl4(:) = fincl(:,4) + hist_fincl5(:) = fincl(:,5) + hist_fincl6(:) = fincl(:,6) + + hist_fexcl1(:) = fexcl(:,1) + hist_fexcl2(:) = fexcl(:,2) + hist_fexcl3(:) = fexcl(:,3) + hist_fexcl4(:) = fexcl(:,4) + hist_fexcl5(:) = fexcl(:,5) + hist_fexcl6(:) = fexcl(:,6) + + end if + + if ( allocated(itemp) ) deallocate(itemp) + + end if + + !====================================================================== + ! Read/write history file restart data. + ! If the current history file(s) are not full, file(s) are opened + ! so that subsequent time samples are added until the file is full. + ! A new history file is used on a branch run. + !====================================================================== + + if (flag == 'write') then + + do t = 1,ntapes + if (.not. tape(t)%is_endhist) then + + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) + nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) + + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if + + end do + + end if ! end of is_endhist block + + call ncd_pio_closefile(ncid_hist(t)) + + end do ! end of ntapes loop + + else if (flag == 'read') then + + ! Read history restart information if history files are not full + + do t = 1,ntapes + + if (.not. tape(t)%is_endhist) then + + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) + + hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) + nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if + end do + + end if + + call ncd_pio_closefile(ncid_hist(t)) + + end do + + end if + + end subroutine hist_restart_ncd + + !----------------------------------------------------------------------- + integer function max_nFields() + ! + ! !DESCRIPTION: + ! Get the maximum number of fields on all tapes. + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: t ! index + character(len=*),parameter :: subname = 'max_nFields' + !----------------------------------------------------------------------- + + max_nFields = 0 + do t = 1,ntapes + max_nFields = max(max_nFields, tape(t)%nflds) + end do + return + end function max_nFields + + !----------------------------------------------------------------------- + character(len=max_namlen) function getname (inname) + ! + ! !DESCRIPTION: + ! Retrieve name portion of inname. If an averaging flag separater character + ! is present (:) in inname, lop it off. + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: inname + ! + ! !LOCAL VARIABLES: + integer :: length + integer :: i + character(len=*),parameter :: subname = 'getname' + !----------------------------------------------------------------------- + + length = len (inname) + + if (length < max_namlen .or. length > max_namlen+2) then + write(iulog,*) trim(subname),' ERROR: bad length=',length + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + getname = ' ' + do i = 1,max_namlen + if (inname(i:i) == ':') exit + getname(i:i) = inname(i:i) + end do + + end function getname + + !----------------------------------------------------------------------- + character(len=1) function getflag (inname) + ! + ! !DESCRIPTION: + ! Retrieve flag portion of inname. If an averaging flag separater character + ! is present (:) in inname, return the character after it as the flag + ! + ! !ARGUMENTS: + character(len=*) inname ! character string + ! + ! !LOCAL VARIABLES: + integer :: length ! length of inname + integer :: i ! loop index + character(len=*),parameter :: subname = 'getflag' + !----------------------------------------------------------------------- + + length = len (inname) + + if (length < max_namlen .or. length > max_namlen+2) then + write(iulog,*) trim(subname),' ERROR: bad length=',length + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + getflag = ' ' + do i = 1,length + if (inname(i:i) == ':') then + getflag = inname(i+1:i+1) + exit + end if + end do + + end function getflag + + !----------------------------------------------------------------------- + subroutine list_index (list, name, index) + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: list(max_flds) ! input list of names, possibly ":" delimited + character(len=max_namlen), intent(in) :: name ! name to be searched for + integer, intent(out) :: index ! index of "name" in "list" + ! + ! !LOCAL VARIABLES: + !EOP + character(len=max_namlen) :: listname ! input name with ":" stripped off. + integer f ! field index + character(len=*),parameter :: subname = 'list_index' + !----------------------------------------------------------------------- + + ! Only list items + + index = 0 + do f=1,max_flds + listname = getname (list(f)) + if (listname == ' ') exit + if (listname == name) then + index = f + exit + end if + end do + + end subroutine list_index + + !----------------------------------------------------------------------- + character(len=256) function set_hist_filename (hist_freq, hist_mfilt, hist_file) + ! + ! !DESCRIPTION: + ! Determine history dataset filenames. + ! + ! !USES: + use clm_varctl, only : caseid, inst_suffix + use clm_time_manager, only : get_curr_date, get_prev_date + ! + ! !ARGUMENTS: + integer, intent(in) :: hist_freq !history file frequency + integer, intent(in) :: hist_mfilt !history file number of time-samples + integer, intent(in) :: hist_file !history file index + ! + ! !LOCAL VARIABLES: + !EOP + character(len=256) :: cdate !date char string + character(len= 1) :: hist_index !p,1 or 2 (currently) + integer :: day !day (1 -> 31) + integer :: mon !month (1 -> 12) + integer :: yr !year (0 -> ...) + integer :: sec !seconds into current day + character(len=*),parameter :: subname = 'set_hist_filename' + !----------------------------------------------------------------------- + + if (hist_freq == 0 .and. hist_mfilt == 1) then !monthly + call get_prev_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2)') yr,mon + else !other + call get_curr_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec + endif + write(hist_index,'(i1.1)') hist_file - 1 + set_hist_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".h"//hist_index//"."//trim(cdate)//".nc" + + end function set_hist_filename + + !----------------------------------------------------------------------- + subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, & + ptr_atm, p2c_scale_type, c2l_scale_type, & + l2g_scale_type, set_lake, set_nolake, set_urb, set_nourb, & + set_noglcmec, set_spec, default) + ! + ! !DESCRIPTION: + ! Initialize a single level history field. The pointer, ptrhist, + ! is a pointer to the data type array that the history buffer will use. + ! The value of type1d passed to masterlist\_add\_fld determines which of the + ! 1d type of the output and the beginning and ending indices the history + ! buffer field). Default history contents for given field on all tapes + ! are set by calling [masterlist\_make\_active] for the appropriate tape. + ! After the masterlist is built, routine [htapes\_build] is called for an + ! initial or branch run to initialize the actual history tapes. + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from data type) + real(r8) , optional, pointer :: ptr_gcell(:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:) ! pointer to patch array + real(r8) , optional, pointer :: ptr_lnd(:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_atm(:) ! pointer to atm array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_noglcmec ! value to set non-glacier_mec to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,g ! indices + integer :: hpindex ! history buffer pointer index + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type + character(len=8) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column + character(len=8) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits + character(len=8) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells + type(bounds_type):: bounds ! boudns + character(len=16):: l_default ! local version of 'default' + character(len=*),parameter :: subname = 'hist_addfld1d' +!------------------------------------------------------------------------ + + ! Determine processor bounds + + call get_proc_bounds(bounds) + + ! History buffer pointer + + hpindex = pointer_index() + + if (present(ptr_lnd)) then + l_type1d = grlnd + l_type1d_out = grlnd + clmptr_rs(hpindex)%ptr => ptr_lnd + + else if (present(ptr_gcell)) then + l_type1d = nameg + l_type1d_out = nameg + clmptr_rs(hpindex)%ptr => ptr_gcell + + else if (present(ptr_lunit)) then + l_type1d = namel + l_type1d_out = namel + clmptr_rs(hpindex)%ptr => ptr_lunit + if (present(set_lake)) then + do l = bounds%begl,bounds%endl + if (lun%lakpoi(l)) ptr_lunit(l) = set_lake + end do + end if + if (present(set_nolake)) then + do l = bounds%begl,bounds%endl + if (.not.(lun%lakpoi(l))) ptr_lunit(l) = set_nolake + end do + end if + if (present(set_urb)) then + do l = bounds%begl,bounds%endl + if (lun%urbpoi(l)) ptr_lunit(l) = set_urb + end do + end if + if (present(set_nourb)) then + do l = bounds%begl,bounds%endl + if (.not.(lun%urbpoi(l))) ptr_lunit(l) = set_nourb + end do + end if + if (present(set_spec)) then + do l = bounds%begl,bounds%endl + if (lun%ifspecial(l)) ptr_lunit(l) = set_spec + end do + end if + + else if (present(ptr_col)) then + l_type1d = namec + l_type1d_out = namec + clmptr_rs(hpindex)%ptr => ptr_col + if (present(set_lake)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%lakpoi(l)) ptr_col(c) = set_lake + end do + end if + if (present(set_nolake)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (.not.(lun%lakpoi(l))) ptr_col(c) = set_nolake + end do + end if + if (present(set_urb)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%urbpoi(l)) ptr_col(c) = set_urb + end do + end if + if (present(set_nourb)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (.not.(lun%urbpoi(l))) ptr_col(c) = set_nourb + end do + end if + if (present(set_spec)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%ifspecial(l)) ptr_col(c) = set_spec + end do + end if + if (present(set_noglcmec)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (.not.(lun%glcmecpoi(l))) ptr_col(c) = set_noglcmec + end do + endif + + else if (present(ptr_patch)) then + l_type1d = namep + l_type1d_out = namep + clmptr_rs(hpindex)%ptr => ptr_patch + if (present(set_lake)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%lakpoi(l)) ptr_patch(p) = set_lake + end do + end if + if (present(set_nolake)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (.not.(lun%lakpoi(l))) ptr_patch(p) = set_nolake + end do + end if + if (present(set_urb)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%urbpoi(l)) ptr_patch(p) = set_urb + end do + end if + if (present(set_nourb)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (.not.(lun%urbpoi(l))) ptr_patch(p) = set_nourb + end do + end if + if (present(set_spec)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%ifspecial(l)) ptr_patch(p) = set_spec + end do + end if + if (present(set_noglcmec)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (.not.(lun%glcmecpoi(l))) ptr_patch(p) = set_noglcmec + end do + end if + else + write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', & + ' choices are [ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_patch] ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end if + + ! Set scaling factor + + scale_type_p2c = 'unity' + scale_type_c2l = 'unity' + scale_type_l2g = 'unity' + + if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type + if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type + if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type + if (present(type1d_out)) l_type1d_out = type1d_out + + ! Add field to masterlist + + call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, & + type2d='unset', num2d=1, & + units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g) + + l_default = 'active' + if (present(default)) then + l_default = default + end if + if (trim(l_default) == 'inactive') then + return + else + call masterlist_make_active (name=trim(fname), tape_index=1) + end if + + end subroutine hist_addfld1d + + !----------------------------------------------------------------------- + subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, ptr_atm, & + p2c_scale_type, c2l_scale_type, l2g_scale_type, & + set_lake, set_nolake, set_urb, set_nourb, set_spec, & + no_snow_behavior, default) + ! + ! !DESCRIPTION: + ! Initialize a single level history field. The pointer, ptrhist, + ! is a pointer to the data type array that the history buffer will use. + ! The value of type1d passed to masterlist\_add\_fld determines which of the + ! 1d type of the output and the beginning and ending indices the history + ! buffer field). Default history contents for given field on all tapes + ! are set by calling [masterlist\_make\_active] for the appropriatae tape. + ! After the masterlist is built, routine [htapes\_build] is called for an + ! initial or branch run to initialize the actual history tapes. + ! + ! !USES: + use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, numrad, nlevdecomp_full, nlevcan + use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec + use landunit_varcon , only : max_lunit + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type2d ! 2d output type + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from data type) + real(r8) , optional, pointer :: ptr_atm(:,:) ! pointer to atm array + real(r8) , optional, pointer :: ptr_lnd(:,:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_gcell(:,:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:,:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to patch array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + integer , optional, intent(in) :: no_snow_behavior ! if a multi-layer snow field, behavior to use for absent snow layers (should be one of the public no_snow_* parameters defined above) + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,g ! indices + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + integer :: hpindex ! history buffer index + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type + character(len=8) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column + character(len=8) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits + character(len=8) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells + type(bounds_type):: bounds + character(len=16):: l_default ! local version of 'default' + character(len=*),parameter :: subname = 'hist_addfld2d' +!------------------------------------------------------------------------ + + call get_proc_bounds(bounds) + + ! Error-check no_snow_behavior optional argument: It should be present if and only if + ! type2d is 'levsno', and its value should be one of the public no_snow_* parameters + ! defined above. + if (present(no_snow_behavior)) then + if (type2d /= 'levsno') then + write(iulog,*) trim(subname), & + ' ERROR: Only specify no_snow_behavior for fields with dimension levsno' + call endrun() + end if + + if (no_snow_behavior < no_snow_MIN .or. no_snow_behavior > no_snow_MAX) then + write(iulog,*) trim(subname), & + ' ERROR: Invalid value for no_snow_behavior: ', no_snow_behavior + call endrun() + end if + + else ! no_snow_behavior is absent + if (type2d == 'levsno') then + write(iulog,*) trim(subname), & + ' ERROR: must specify no_snow_behavior for fields with dimension levsno' + call endrun() + end if + end if + + ! Determine second dimension size + + select case (type2d) + case ('levgrnd') + num2d = nlevgrnd + case ('levlak') + num2d = nlevlak + case ('numrad') + num2d = numrad + case ('levdcmp') + num2d = nlevdecomp_full + case('ltype') + num2d = max_lunit + case('natpft') + num2d = natpft_size + case('cft') + if (cft_size > 0) then + num2d = cft_size + else + write(iulog,*) trim(subname),' ERROR: 2d type =', trim(type2d), & + ' only valid for cft_size > 0' + call endrun() + end if + case ('glc_nec') + if (maxpatch_glcmec > 0) then + num2d = maxpatch_glcmec + else + write(iulog,*) trim(subname),' ERROR: 2d type =', trim(type2d), & + ' only valid for maxpatch_glcmec > 0' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + case ('elevclas') + if (maxpatch_glcmec > 0) then + ! add one because indexing starts at 0 (elevclas, unlike glc_nec, includes the + ! bare ground "elevation class") + num2d = maxpatch_glcmec + 1 + else + write(iulog,*) trim(subname),' ERROR: 2d type =', trim(type2d), & + ' only valid for maxpatch_glcmec > 0' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + case ('levsno') + num2d = nlevsno + case ('nlevcan') + num2d = nlevcan + case default + write(iulog,*) trim(subname),' ERROR: unsupported 2d type ',type2d, & + ' currently supported types for multi level fields are: ', & + '[levgrnd,levlak,numrad,levdcmp,levtrc,ltype,natpft,cft,glc_nec,elevclas,levsno]' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + ! History buffer pointer + + hpindex = pointer_index() + + if (present(ptr_lnd)) then + l_type1d = grlnd + l_type1d_out = grlnd + clmptr_ra(hpindex)%ptr => ptr_lnd + + else if (present(ptr_gcell)) then + l_type1d = nameg + l_type1d_out = nameg + clmptr_ra(hpindex)%ptr => ptr_gcell + + else if (present(ptr_lunit)) then + l_type1d = namel + l_type1d_out = namel + clmptr_ra(hpindex)%ptr => ptr_lunit + if (present(set_lake)) then + do l = bounds%begl,bounds%endl + if (lun%lakpoi(l)) ptr_lunit(l,:) = set_lake + end do + end if + if (present(set_nolake)) then + do l = bounds%begl,bounds%endl + if (.not.(lun%lakpoi(l))) ptr_lunit(l,:) = set_nolake + end do + end if + if (present(set_urb)) then + do l = bounds%begl,bounds%endl + if (lun%urbpoi(l)) ptr_lunit(l,:) = set_urb + end do + end if + if (present(set_nourb)) then + do l = bounds%begl,bounds%endl + if (.not.(lun%urbpoi(l))) ptr_lunit(l,:) = set_nourb + end do + end if + if (present(set_spec)) then + do l = bounds%begl,bounds%endl + if (lun%ifspecial(l)) ptr_lunit(l,:) = set_spec + end do + end if + + else if (present(ptr_col)) then + l_type1d = namec + l_type1d_out = namec + clmptr_ra(hpindex)%ptr => ptr_col + if (present(set_lake)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%lakpoi(l)) ptr_col(c,:) = set_lake + end do + end if + if (present(set_nolake)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (.not.(lun%lakpoi(l))) ptr_col(c,:) = set_nolake + end do + end if + if (present(set_urb)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%urbpoi(l)) ptr_col(c,:) = set_urb + end do + end if + if (present(set_nourb)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (.not.(lun%urbpoi(l))) ptr_col(c,:) = set_nourb + end do + end if + if (present(set_spec)) then + do c = bounds%begc,bounds%endc + l =col%landunit(c) + if (lun%ifspecial(l)) ptr_col(c,:) = set_spec + end do + end if + + else if (present(ptr_patch)) then + l_type1d = namep + l_type1d_out = namep + clmptr_ra(hpindex)%ptr => ptr_patch + if (present(set_lake)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%lakpoi(l)) ptr_patch(p,:) = set_lake + end do + end if + if (present(set_nolake)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (.not.(lun%lakpoi(l))) ptr_patch(p,:) = set_nolake + end do + end if + if (present(set_urb)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%urbpoi(l)) ptr_patch(p,:) = set_urb + end do + end if + if (present(set_nourb)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (.not.(lun%urbpoi(l))) ptr_patch(p,:) = set_nourb + end do + end if + if (present(set_spec)) then + do p = bounds%begp,bounds%endp + l =patch%landunit(p) + if (lun%ifspecial(l)) ptr_patch(p,:) = set_spec + end do + end if + + else + write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', & + ' choices are ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_patch' + call endrun(msg=errMsg(__FILE__, __LINE__)) + + end if + + ! Set scaling factor + + scale_type_p2c = 'unity' + scale_type_c2l = 'unity' + scale_type_l2g = 'unity' + + if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type + if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type + if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type + if (present(type1d_out)) l_type1d_out = type1d_out + + ! Add field to masterlist + + call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, & + type2d=type2d, num2d=num2d, & + units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g, & + no_snow_behavior=no_snow_behavior) + + l_default = 'active' + if (present(default)) then + l_default = default + end if + if (trim(l_default) == 'inactive') then + return + else + call masterlist_make_active (name=trim(fname), tape_index=1) + end if + + end subroutine hist_addfld2d + + !----------------------------------------------------------------------- + subroutine hist_addfld_decomp (fname, type2d, units, avgflag, long_name, ptr_col, ptr_patch, default) + + ! + ! !USES: + use clm_varpar , only : nlevdecomp_full, crop_prog + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type2d ! 2d output type + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to patch array + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + ! + ! !LOCAL VARIABLES: + real(r8), pointer :: ptr_1d(:) + !----------------------------------------------------------------------- + + if (present(ptr_col)) then + + ! column-level data + if (present(default)) then + if ( nlevdecomp_full > 1 ) then + call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, & + avgflag=avgflag, long_name=long_name, & + ptr_col=ptr_col, default=default) + else + ptr_1d => ptr_col(:,1) + call hist_addfld1d (fname=trim(fname), units=units, & + avgflag=avgflag, long_name=long_name, & + ptr_col=ptr_1d, default=default) + endif + else + if ( nlevdecomp_full > 1 ) then + call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, & + avgflag=avgflag, long_name=long_name, & + ptr_col=ptr_col) + else + ptr_1d => ptr_col(:,1) + call hist_addfld1d (fname=trim(fname), units=units, & + avgflag=avgflag, long_name=long_name, & + ptr_col=ptr_1d) + endif + endif + + else if (present(ptr_patch)) then + + ! patch-level data + if (present(default)) then + if ( nlevdecomp_full > 1 ) then + call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, & + avgflag=avgflag, long_name=long_name, & + ptr_patch=ptr_patch, default=default) + else + ptr_1d => ptr_patch(:,1) + call hist_addfld1d (fname=trim(fname), units=units, & + avgflag=avgflag, long_name=long_name, & + ptr_patch=ptr_1d, default=default) + endif + else + if ( nlevdecomp_full > 1 ) then + call hist_addfld2d (fname=trim(fname), units=units, type2d=type2d, & + avgflag=avgflag, long_name=long_name, & + ptr_patch=ptr_patch) + else + ptr_1d => ptr_patch(:,1) + call hist_addfld1d (fname=trim(fname), units=units, & + avgflag=avgflag, long_name=long_name, & + ptr_patch=ptr_1d) + endif + endif + + else + write(iulog, *) ' error: hist_addfld_decomp needs either patch or column level pointer' + write(iulog, *) fname + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + end subroutine hist_addfld_decomp + + !----------------------------------------------------------------------- + integer function pointer_index () + ! + ! !DESCRIPTION: + ! Set the current pointer index and increment the value of the index. + ! + ! !ARGUMENTS: + ! + integer, save :: lastindex = 1 + character(len=*),parameter :: subname = 'pointer_index' + !----------------------------------------------------------------------- + + pointer_index = lastindex + lastindex = lastindex + 1 + if (lastindex > max_mapflds) then + write(iulog,*) trim(subname),' ERROR: ',& + ' lastindex = ',lastindex,' greater than max_mapflds= ',max_mapflds + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + end function pointer_index + + !----------------------------------------------------------------------- + subroutine hist_add_subscript(name, dim) + ! + ! !DESCRIPTION: + ! Add a history variable to the output history tape. + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: name ! name of subscript + integer , intent(in) :: dim ! dimension of subscript + ! + ! !LOCAL VARIABLES: + character(len=*),parameter :: subname = 'hist_add_subscript' + !----------------------------------------------------------------------- + + num_subs = num_subs + 1 + if (num_subs > max_subs) then + write(iulog,*) trim(subname),' ERROR: ',& + ' num_subs = ',num_subs,' greater than max_subs= ',max_subs + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + subs_name(num_subs) = name + subs_dim(num_subs) = dim + + end subroutine hist_add_subscript + + !----------------------------------------------------------------------- + + subroutine strip_null(str) + character(len=*), intent(inout) :: str + integer :: i + do i=1,len(str) + if(ichar(str(i:i))==0) str(i:i)=' ' + end do + end subroutine strip_null + + !------------------------------------------------------------------------ + subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, rstwr, nlend) + ! + ! !DESCRIPTION: + ! Determine logic for closeing and/or disposing history file + ! Sets values for if_disphist, if_stop (arguments) + ! 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 + integer, intent(in) :: hist_mfilt(ntapes) !maximum number of time samples per tape + logical, intent(out) :: if_stop !true => last time step of run + logical, intent(out) :: if_disphist(ntapes) !true => save and dispose history file + logical, intent(in) :: rstwr + logical, intent(in) :: nlend + ! + ! !LOCAL VARIABLES: + integer :: t ! history tape index + logical :: rest_now ! temporary + logical :: stop_now ! temporary + !------------------------------------------------------------------------ + + rest_now = .false. + stop_now = .false. + + if (nlend) stop_now = .true. + if (rstwr) rest_now = .true. + + if_stop = stop_now + + if (stop_now) then + ! End of run - dispose all history files + + if_disphist(1:ntapes) = .true. + + else if (rest_now) then + ! Restart - dispose all history files + + do t = 1,ntapes + if_disphist(t) = .true. + end do + else + ! Dispose + + if_disphist(1:ntapes) = .false. + do t = 1,ntapes + if (hist_ntimes(t) == hist_mfilt(t)) then + if_disphist(t) = .true. + endif + end do + endif + + end subroutine hist_do_disp + +end module histFileMod + diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 new file mode 100644 index 0000000000..4c455b4d14 --- /dev/null +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -0,0 +1,551 @@ +module initGridCellsMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Initializes sub-grid mapping for each land grid cell. This module handles the high- + ! level logic that determines how the subgrid structure is set up in a CLM run. It + ! makes use of lower-level routines in initSubgridMod, which contains stuff that is + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc,iam + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_varcon , only : namep, namec, namel, nameg + use decompMod , only : bounds_type, ldecomp + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use initSubgridMod , only : clm_ptrs_compdown, clm_ptrs_check + use initSubgridMod , only : add_landunit, add_column, add_patch + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public initGridcells ! initialize sub-grid gridcell mapping + ! + ! !PRIVATE MEMBER FUNCTIONS: + private set_cohort_decomp + private set_landunit_veg_compete + private set_landunit_wet_ice_lake + private set_landunit_crop_noncompete + private set_landunit_urban + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine initGridcells + ! + ! !DESCRIPTION: + ! Initialize sub-grid mapping and allocates space for derived type hierarchy. + ! For each land gridcell determine landunit, column and patch properties. + ! + ! !USES + use domainMod , only : ldomain + use decompMod , only : get_proc_bounds, get_clump_bounds, get_proc_clumps + use subgridWeightsMod , only : compute_higher_order_weights + use landunit_varcon , only : istsoil, istice, istwet, istdlak, istice_mec + use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop + use clm_varctl , only : create_glacier_mec_landunit, use_ed + use shr_const_mod , only : SHR_CONST_PI + ! + ! !LOCAL VARIABLES: + integer :: nc,li,ci,pi,gdc ! indices + integer :: nclumps ! number of clumps on this processor + type(bounds_type) :: bounds_proc + type(bounds_type) :: bounds_clump + !------------------------------------------------------------------------ + + ! Notes about how this routine is arranged, and its implications for the arrangement + ! of 1-d vectors in memory: + ! + ! (1) There is an outer loop over clumps; this results in all of a clump's points (at + ! the gridcell, landunit, column & patch level) being contiguous. This is important + ! for the use of begg:endg, etc., and also for performance. + ! + ! (2) Next, there is a section for each landunit, with the loop over grid cells + ! happening separately for each landunit. This means that, within a given clump, + ! points with the same landunit are grouped together (this is true at the + ! landunit, column and patch levels). Thus, different landunits for a given grid + ! cell are separated in memory. This improves performance in the many parts of + ! the code that operate over a single landunit, or two similar landunits. + ! + ! Example: landunit-level array: For a processor with 2 clumps, each of which has 2 + ! grid cells, each of which has 3 landunits, the layout of a landunit-level array + ! looks like the following: + ! + ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12 + ! ------------------------------------------------------------ + ! Clump index: 1 1 1 1 1 1 2 2 2 2 2 2 + ! Gridcell: 1 2 1 2 1 2 3 4 3 4 3 4 + ! Landunit type: 1 1 2 2 3 3 1 1 2 2 3 3 + ! + ! Example: patch-level array: For a processor with 1 clump, which has 2 grid cells, each + ! of which has 2 landunits, each of which has 3 patchs, the layout of a patch-level array + ! looks like the following: + ! + ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12 + ! ------------------------------------------------------------ + ! Gridcell: 1 1 1 2 2 2 1 1 1 2 2 2 + ! Landunit type: 1 1 1 1 1 1 2 2 2 2 2 2 + ! PATCH type: 1 2 3 1 2 3 1 2 3 1 2 3 + ! + ! So note that clump index is most slowly varying, followed by landunit type, + ! followed by gridcell, followed by column and patch type. + ! + ! Cohort layout + ! Array index: 1 2 3 4 5 6 7 8 9 10 11 12 + ! ------------------------------------------------------------ + ! Gridcell: 1 1 2 2 3 3 1 1 2 2 3 3 + ! Cohort: 1 2 1 2 1 2 1 2 1 2 1 2 + + nclumps = get_proc_clumps() + + ! FIX(SPM,032414) add private vars for cohort and perhaps patch dimension + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump, li, ci, pi, gdc) + do nc = 1, nclumps + + call get_clump_bounds(nc, bounds_clump) + + ! For each land gridcell on global grid determine landunit, column and patch properties + + li = bounds_clump%begl-1 + ci = bounds_clump%begc-1 + pi = bounds_clump%begp-1 + + ! Determine naturally vegetated landunit + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_veg_compete( & + ltype=istsoil, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + ! Determine crop landunit + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_crop_noncompete( & + ltype=istcrop, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + ! Determine urban tall building district landunit + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_urban( & + ltype=isturb_tbd, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + + end do + + ! Determine urban high density landunit + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_urban( & + ltype=isturb_hd, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + ! Determine urban medium density landunit + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_urban( & + ltype=isturb_md, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + ! Determine lake, wetland and glacier landunits + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_wet_ice_lake( & + ltype=istdlak, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_wet_ice_lake( & + ltype=istwet, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_wet_ice_lake( & + ltype=istice, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true.) + end do + + if (create_glacier_mec_landunit) then + do gdc = bounds_clump%begg,bounds_clump%endg + call set_landunit_wet_ice_lake( & + ltype=istice_mec, gi=gdc, li=li, ci=ci, pi=pi, & + setdata=.true., & + glcmask = ldomain%glcmask(gdc)) + end do + endif + + if ( use_ed ) then + ! cohort decomp + call set_cohort_decomp( bounds_clump=bounds_clump ) + end if + + ! Ensure that we have set the expected number of patchs, cols and landunits for this clump + SHR_ASSERT(li == bounds_clump%endl, errMsg(__FILE__, __LINE__)) + SHR_ASSERT(ci == bounds_clump%endc, errMsg(__FILE__, __LINE__)) + SHR_ASSERT(pi == bounds_clump%endp, errMsg(__FILE__, __LINE__)) + + ! Set some other gridcell-level variables + + do gdc = bounds_clump%begg,bounds_clump%endg + grc%gindex(gdc) = ldecomp%gdc2glo(gdc) + grc%area(gdc) = ldomain%area(gdc) + grc%latdeg(gdc) = ldomain%latc(gdc) + grc%londeg(gdc) = ldomain%lonc(gdc) + grc%lat(gdc) = grc%latdeg(gdc) * SHR_CONST_PI/180._r8 + grc%lon(gdc) = grc%londeg(gdc) * SHR_CONST_PI/180._r8 + enddo + + ! Fill in subgrid datatypes + + call clm_ptrs_compdown(bounds_clump) + + ! By putting this check within the loop over clumps, we ensure that (for example) + ! if a clump is responsible for landunit L, then that same clump is also + ! responsible for all columns and patchs in L. + call clm_ptrs_check(bounds_clump) + + ! Set patch%wtlunit, patch%wtgcell and col%wtgcell + call compute_higher_order_weights(bounds_clump) + + end do + !$OMP END PARALLEL DO + + end subroutine initGridcells + + !------------------------------------------------------------------------ + subroutine set_cohort_decomp ( bounds_clump ) + ! + ! !DESCRIPTION: + ! Set gridcell decomposition for cohorts + ! + use EDTypesMod , only : cohorts_per_gcell + use EDVecCohortType , only : ed_vec_cohort + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds_clump + ! + ! !LOCAL VARIABLES: + integer c, gi + !------------------------------------------------------------------------ + + gi = bounds_clump%begg + + do c = bounds_clump%begCohort, bounds_clump%endCohort + + ed_vec_cohort%gridcell(c) = gi + if ( mod(c, cohorts_per_gcell ) == 0 ) gi = gi + 1 + + end do + + end subroutine set_cohort_decomp + + !------------------------------------------------------------------------ + subroutine set_landunit_veg_compete (ltype, gi, li, ci, pi, setdata) + ! + ! !DESCRIPTION: + ! Initialize vegetated landunit with competition + ! + ! !USES + use clm_instur, only : wt_lunit, wt_nat_patch + use subgridMod, only : subgrid_get_gcellinfo + use clm_varpar, only : numpft, maxpatch_pft, numcft, natpft_lb, natpft_ub + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + logical , intent(in) :: setdata ! set info or just compute + ! + ! !LOCAL VARIABLES: + integer :: m ! index + integer :: npatches ! number of patches in landunit + integer :: pitype ! patch itype + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + !------------------------------------------------------------------------ + + ! Set decomposition properties + + call subgrid_get_gcellinfo(gi, nveg=npatches) + wtlunit2gcell = wt_lunit(gi, ltype) + + if (npatches > 0) then + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + + ! Assume one column on the landunit + call add_column(ci=ci, li=li, ctype=1, wtlunit=1.0_r8) + + do m = natpft_lb,natpft_ub + call add_patch(pi=pi, ci=ci, ptype=m, wtcol=wt_nat_patch(gi,m)) + end do + end if + + end subroutine set_landunit_veg_compete + + !------------------------------------------------------------------------ + subroutine set_landunit_wet_ice_lake (ltype, gi, li, ci, pi, setdata, glcmask) + ! + ! !DESCRIPTION: + ! Initialize wet_ice_lake landunits that are non-urban (lake, wetland, glacier, glacier_mec) + ! + ! !USES + use clm_varpar , only : maxpatch_glcmec + use clm_instur , only : wt_lunit, wt_glc_mec + use landunit_varcon , only : istwet, istdlak, istice, istice_mec + use column_varcon , only : icemec_class_to_col_itype + use subgridMod , only : subgrid_get_gcellinfo + use pftconMod , only : noveg + + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + logical , intent(in) :: setdata ! set info or just compute + integer , intent(in), optional :: glcmask ! = 1 where glc requires sfc mass balance + ! + ! !LOCAL VARIABLES: + integer :: m ! index + integer :: c ! column loop index + integer :: ier ! error status + integer :: npatches ! number of pfts in landunit + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + real(r8) :: wtcol2lunit ! col weight in landunit + !------------------------------------------------------------------------ + + ! Set decomposition properties + + if (ltype == istwet) then + call subgrid_get_gcellinfo(gi, nwetland=npatches) + else if (ltype == istdlak) then + call subgrid_get_gcellinfo(gi, nlake=npatches) + else if (ltype == istice) then + call subgrid_get_gcellinfo(gi, nglacier=npatches) + else if (ltype == istice_mec) then + call subgrid_get_gcellinfo(gi, nglacier_mec=npatches, glcmask = glcmask) + else + write(iulog,*)' set_landunit_wet_ice_lake: ltype of ',ltype,' not valid' + write(iulog,*)' only istwet, istdlak, istice and istice_mec ltypes are valid' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + wtlunit2gcell = wt_lunit(gi, ltype) + + if (npatches > 0) then + + if (npatches /=1 .and. ltype /= istice_mec) then + write(iulog,*)' set_landunit_wet_ice_lake: compete landunit must'// & + ' have one patch ' + write(iulog,*)' current value of npatches=',npatches + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (ltype==istice_mec) then ! multiple columns per landunit + + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + + ! Determine column and properties + ! (Each column has its own pft) + ! + ! For grid cells with glcmask = 1, make sure all the elevations classes + ! are populated, even if some have zero fractional area. This ensures that the + ! ice sheet component, glc, will receive a surface mass balance in each elevation + ! class wherever the SMB is needed. + ! Columns with zero weight are referred to as "virtual" columns. + + do m = 1, maxpatch_glcmec + + wtcol2lunit = wt_glc_mec(gi,m) + + if (wtcol2lunit > 0._r8 .or. glcmask == 1) then + call add_column(ci=ci, li=li, ctype=icemec_class_to_col_itype(m), wtlunit=wtcol2lunit) + call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8) + endif + enddo + + else + + ! Currently assume that each landunit only has only one column + ! and that each column has its own pft + + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + call add_column(ci=ci, li=li, ctype=ltype, wtlunit=1.0_r8) + call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8) + + end if ! ltype = istice_mec + endif ! npatches > 0 + + end subroutine set_landunit_wet_ice_lake + + !------------------------------------------------------------------------ + + subroutine set_landunit_crop_noncompete (ltype, gi, li, ci, pi, setdata) + ! + ! !DESCRIPTION: + ! Initialize crop landunit without competition + ! + ! Note about the ltype input argument: This provides the value for this landunit index + ! (i.e., the crop landunit index). This may differ from the landunit's 'itype' value, + ! since itype is istsoil if we are running with create_crop_landunit but crop_prog = false. + ! + ! !USES + use clm_instur , only : wt_lunit, wt_cft + use landunit_varcon , only : istcrop, istsoil + use subgridMod , only : subgrid_get_gcellinfo + use clm_varctl , only : create_crop_landunit + use clm_varpar , only : maxpatch_pft, numcft, crop_prog, cft_lb, cft_ub + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + logical , intent(in) :: setdata ! set info or just compute + ! + ! !LOCAL VARIABLES: + integer :: my_ltype ! landunit type for crops + integer :: m ! index + integer :: npatches ! number of pfts in landunit + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + !------------------------------------------------------------------------ + + ! Set decomposition properties + + call subgrid_get_gcellinfo(gi, ncrop=npatches) + wtlunit2gcell = wt_lunit(gi, ltype) + + if (npatches > 0) then + + ! Note that we cannot simply use the 'ltype' argument to set itype here, + ! because ltype will always indicate istcrop + if ( crop_prog )then + my_ltype = istcrop + else + my_ltype = istsoil + end if + + call add_landunit(li=li, gi=gi, ltype=my_ltype, wtgcell=wtlunit2gcell) + + ! Set column and patch properties for this landunit + ! (each column has its own pft) + + if (create_crop_landunit) then + do m = cft_lb, cft_ub + call add_column(ci=ci, li=li, ctype=((istcrop*100) + m), wtlunit=wt_cft(gi,m)) + call add_patch(pi=pi, ci=ci, ptype=m, wtcol=1.0_r8) + end do + end if + + end if + + end subroutine set_landunit_crop_noncompete + + !------------------------------------------------------------------------------ + + subroutine set_landunit_urban (ltype, gi, li, ci, pi, setdata) + ! + ! !DESCRIPTION: + ! Initialize urban landunits + ! + ! !USES + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv, icol_road_imperv + use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, isturb_MIN + use clm_varpar , only : maxpatch_urb + use clm_instur , only : wt_lunit + use subgridMod , only : subgrid_get_gcellinfo + use UrbanParamsType , only : urbinp + use decompMod , only : ldecomp + use pftconMod , only : noveg + ! + ! !ARGUMENTS: + integer , intent(in) :: ltype ! landunit type + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! patch index + logical , intent(in) :: setdata ! set info or just compute + ! + ! !LOCAL VARIABLES: + integer :: c ! column loop index + integer :: m ! index + integer :: n ! urban density type index + integer :: ctype ! column type + integer :: npatches ! number of pfts in landunit + real(r8) :: wtlunit2gcell ! weight relative to gridcell of landunit + real(r8) :: wtcol2lunit ! weight of column with respect to landunit + real(r8) :: wtlunit_roof ! weight of roof with respect to landunit + real(r8) :: wtroad_perv ! weight of pervious road column with respect to total road + integer :: ier ! error status + !------------------------------------------------------------------------ + + ! Set decomposition properties, and set variables specific to urban density type + + select case (ltype) + case (isturb_tbd) + call subgrid_get_gcellinfo(gi, nurban_tbd=npatches) + case (isturb_hd) + call subgrid_get_gcellinfo(gi, nurban_hd=npatches) + case (isturb_md) + call subgrid_get_gcellinfo(gi, nurban_md=npatches) + case default + write(iulog,*)' set_landunit_urban: unknown ltype: ', ltype + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + + wtlunit2gcell = wt_lunit(gi, ltype) + + n = ltype - isturb_MIN + 1 + wtlunit_roof = urbinp%wtlunit_roof(gi,n) + wtroad_perv = urbinp%wtroad_perv(gi,n) + + if (npatches > 0) then + + call add_landunit(li=li, gi=gi, ltype=ltype, wtgcell=wtlunit2gcell) + + ! Loop through columns for this landunit and set the column and patch properties + ! For the urban landunits it is assumed that each column has its own pft + + do m = 1, maxpatch_urb + + if (m == 1) then + ctype = icol_roof + wtcol2lunit = wtlunit_roof + else if (m == 2) then + ctype = icol_sunwall + wtcol2lunit = (1. - wtlunit_roof)/3 + else if (m == 3) then + ctype = icol_shadewall + wtcol2lunit = (1. - wtlunit_roof)/3 + else if (m == 4) then + ctype = icol_road_imperv + wtcol2lunit = ((1. - wtlunit_roof)/3) * (1.-wtroad_perv) + else if (m == 5) then + ctype = icol_road_perv + wtcol2lunit = ((1. - wtlunit_roof)/3) * (wtroad_perv) + end if + + call add_column(ci=ci, li=li, ctype=ctype, wtlunit=wtcol2lunit) + + call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8) + + end do ! end of loop through urban columns-pfts + end if + + end subroutine set_landunit_urban + +end module initGridCellsMod diff --git a/components/clm/src/main/initInterp.F90 b/components/clm/src/main/initInterp.F90 new file mode 100644 index 0000000000..d03c11c9fa --- /dev/null +++ b/components/clm/src/main/initInterp.F90 @@ -0,0 +1,1316 @@ +module initInterpMod + + !----------------------------------------------------------------------- + ! Interpolate initial conditions file from one resolution and/or landmask + ! to another resolution and/or landmask + !----------------------------------------------------------------------- + + use shr_kind_mod , only: r8 => shr_kind_r8, r4 => shr_kind_r4 + use shr_const_mod , only: SHR_CONST_PI, SHR_CONST_REARTH + use shr_sys_mod , only: shr_sys_flush + use shr_infnan_mod , only: shr_infnan_isnan + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_string_mod , only: shr_string_listGetName + use clm_varctl , only: iulog + use abortutils , only: endrun + use spmdMod , only: masterproc + use restUtilMod , only: iflag_interp, iflag_copy, iflag_skip + use restUtilMod , only: iflag_noswitchdim, iflag_switchdim + use ncdio_utils , only: find_var_on_file + use clm_varcon , only: spval, re + use ncdio_pio + use pio + + implicit none + private + save + + ! Public methods + + public :: initInterp + + ! Private methods + + private :: check_dim_subgrid + private :: check_dim_level + private :: findMinDist + private :: set_subgrid_dist + private :: set_subgrid_glob + private :: set_mindist + private :: is_sametype + private :: is_baresoil + private :: interp_0d_copy + private :: interp_1d_double + private :: interp_1d_int + private :: interp_2d_double + + ! Private data + + integer :: ipft_not_vegetated + integer :: icol_vegetated_or_bare_soil + integer :: ilun_vegetated_or_bare_soil + integer :: ilun_landice_multiple_elevation_classes + character(len=8) :: created_glacier_mec_landunits + logical :: override_missing = .true. ! override missing types with closest bare-soil + + type, public :: subgrid_type + character(len=16) :: name ! pft, column, landunit + integer , pointer :: ptype(:) => null() ! used for patch type + integer , pointer :: ctype(:) => null() ! used for patch or col type + integer , pointer :: ltype(:) => null() ! used for pft, col or lun type + real(r8), pointer :: topoglc(:) => null() + real(r8), pointer :: lat(:) + real(r8), pointer :: lon(:) + real(r8), pointer :: coslat(:) + end type subgrid_type + +contains + + !======================================================================= + + subroutine initInterp (filei, fileo, bounds) + + !----------------------------------------------------------------------- + ! Read initial data from netCDF instantaneous initial data history file + !----------------------------------------------------------------------- + + use decompMod, only: bounds_type + + ! -------------------------------------------------------------------- + ! arguments + character(len=*) , intent(in) :: filei !input initial dataset + character(len=*) , intent(in) :: fileo !output initial dataset + type(bounds_type) , intent(in) :: bounds + ! + ! local variables + integer :: i,j,k,l,m,n ! loop indices + integer :: begi, endi ! beginning/ending indices + integer :: bego, endo ! beginning/ending indices + integer :: begp_i, endp_i ! input file patch bounds + integer :: begp_o, endp_o ! output file patch bounds + integer :: begc_i, endc_i ! input file column bounds + integer :: begc_o, endc_o ! output file column bounds + integer :: begl_i, endl_i ! input file landunit bounds + integer :: begl_o, endl_o ! output file landunit bounds + integer :: begg_i, endg_i ! input file gridcell bounds + integer :: begg_o, endg_o ! output file gridcell bounds + integer :: nlevi,nlevo ! input/output number of levels + type(file_desc_t) :: ncidi, ncido ! input/output pio fileids + integer :: dimleni,dimleno ! input/output dimension length + integer :: nvars ! number of variables + character(len=256) :: varname ! variable name + character(len=256) :: varname_i_options ! possible variable names on input file + character(len=256) :: varname_i ! variable name on input file + character(len=16) :: vec_dimname ! subgrid dimension name + character(len=16) :: lev_dimname ! level dimension name + type(Var_desc_t) :: vardesc ! pio variable descriptor + integer :: levdimi,levdimo ! input/output level dimension (2d fields only) + integer :: vecdimi,vecdimo ! input/output non-level dimension (2d fields only) + integer :: xtypeo ! netCDF variable type + integer :: varido ! netCDF variable id + integer :: ndimso ! netCDF number of dimensions + integer :: dimidso(3) = -1 ! netCDF dimension ids + integer :: dimidsi(3) = -1 ! netCDF dimension ids + integer :: status ! return code + integer :: switchdim_flag ! 1 => level dimension is first dimension + integer :: iflag_interpinic + logical :: switchdimi, switchdimo + real(r8) :: rvalue + integer :: ivalue + integer :: spinup_state_i, spinup_state_o + integer :: decomp_cascade_state_i, decomp_cascade_state_o + integer :: npftsi, ncolsi, nlunsi, ngrcsi + integer :: npftso, ncolso, nlunso, ngrcso + integer , pointer :: pftindx(:) + integer , pointer :: colindx(:) + integer , pointer :: lunindx(:) + integer , pointer :: grcindx(:) + logical , pointer :: pft_activei(:), pft_activeo(:) + logical , pointer :: col_activei(:), col_activeo(:) + logical , pointer :: lun_activei(:), lun_activeo(:) + integer , pointer :: sgridindex(:) + logical , pointer :: activei(:), activeo(:) + !-------------------------------------------------------------------- + + if (masterproc) then + write (iulog,*) '**** Mapping clm initial data from input ',trim(filei),& + ' to output ',trim(fileo),' ****' + end if + + ! -------------------------------------------- + ! Open input and output initial conditions files (both just for reading now) + ! -------------------------------------------- + + call ncd_pio_openfile (ncidi, trim(filei) , 0) + call ncd_pio_openfile (ncido, trim(fileo), ncd_write) + + ! -------------------------------------------- + ! Determine dimensions and error checks on dimensions + ! -------------------------------------------- + + call check_dim_subgrid(ncidi, ncido, dimname ='pft' , dimleni=npftsi, dimleno=npftso) + call check_dim_subgrid(ncidi, ncido, dimname ='column' , dimleni=ncolsi, dimleno=ncolso) + call check_dim_subgrid(ncidi, ncido, dimname ='landunit', dimleni=nlunsi, dimleno=nlunso) + call check_dim_subgrid(ncidi, ncido, dimname ='gridcell', dimleni=ngrcsi, dimleno=ngrcso) + + if (masterproc) then + write (iulog,*) 'input gridcells = ',ngrcsi,' output gridcells = ',ngrcso + write (iulog,*) 'input landuntis = ',nlunsi,' output landunits = ',nlunso + write (iulog,*) 'input columns = ',ncolsi,' output columns = ',ncolso + write (iulog,*) 'input pfts = ',npftsi,' output pfts = ',npftso + end if + + call check_dim_level(ncidi, ncido, dimname='levsno' ) + call check_dim_level(ncidi, ncido, dimname='levsno1') + call check_dim_level(ncidi, ncido, dimname='levcan' ) + call check_dim_level(ncidi, ncido, dimname='levlak' ) + call check_dim_level(ncidi, ncido, dimname='levtot' ) + call check_dim_level(ncidi, ncido, dimname='levgrnd') + call check_dim_level(ncidi, ncido, dimname='numrad' ) + + ! -------------------------------------------- + ! Determine input file global attributes that are needed + ! -------------------------------------------- + + status = pio_get_att(ncidi, pio_global, & + 'ipft_not_vegetated', ipft_not_vegetated) + status = pio_get_att(ncidi, pio_global, & + 'icol_vegetated_or_bare_soil', icol_vegetated_or_bare_soil) + status = pio_get_att(ncidi, pio_global, & + 'ilun_vegetated_or_bare_soil', ilun_vegetated_or_bare_soil) + status = pio_get_att(ncidi, pio_global, & + 'ilun_landice_multiple_elevation_classes', ilun_landice_multiple_elevation_classes) + status = pio_get_att(ncidi, pio_global, & + 'created_glacier_mec_landunits', created_glacier_mec_landunits) + + if (masterproc) then + write(iulog,*)'ipft_not_vegetated = ' ,ipft_not_vegetated + write(iulog,*)'icol_vegetated_or_bare_soil = ' ,icol_vegetated_or_bare_soil + write(iulog,*)'ilun_vegetated_or_bare_soil = ' ,ilun_vegetated_or_bare_soil + write(iulog,*)'ilun_landice_multiple_elevation_classes = ' ,ilun_landice_multiple_elevation_classes + write(iulog,*)'create_glacier_mec_landunits = ',trim(created_glacier_mec_landunits) + end if + + ! -------------------------------------------- + ! Find closest values for pfts, cols, landunits + ! -------------------------------------------- + + begp_i = 1 ; endp_i = npftsi + begc_i = 1 ; endc_i = ncolsi + begl_i = 1 ; endl_i = nlunsi + + begp_o = bounds%begp ; endp_o = bounds%endp + begc_o = bounds%begc ; endc_o = bounds%endc + begl_o = bounds%begl ; endl_o = bounds%endl + + allocate(pft_activei(begp_i:endp_i)) + allocate(col_activei(begc_i:endc_i)) + allocate(lun_activei(begl_i:endl_i)) + + allocate(pft_activeo(begp_o:endp_o)) + allocate(col_activeo(begc_o:endc_o)) + allocate(lun_activeo(begl_o:endl_o)) + + allocate(pftindx(begp_o:endp_o)) + allocate(colindx(begc_o:endc_o)) + allocate(lunindx(begl_o:endl_o)) + + ! For each output pft, find the input pft, pftindx, that is closest + + if (masterproc) then + write(iulog,*)'finding minimum distance for pfts' + end if + vec_dimname = 'pft' + call findMinDist(vec_dimname, begp_i, endp_i, begp_o, endp_o, ncidi, ncido, & + pft_activei, pft_activeo, pftindx ) + + ! For each output column, find the input column, colindx, that is closest + + if (masterproc) then + write(iulog,*)'finding minimum distance for columns' + end if + vec_dimname = 'column' + call findMinDist(vec_dimname, begc_i, endc_i, begc_o, endc_o, ncidi, ncido, & + col_activei, col_activeo, colindx ) + + ! For each output landunit, find the input landunit, lunindx, that is closest + + if (masterproc) then + write(iulog,*)'finding minimum distance for landunits' + end if + vec_dimname = 'landunit' + call findMinDist(vec_dimname, begl_i, endl_i, begl_o, endl_o, ncidi, ncido, & + lun_activei, lun_activeo, lunindx ) + + !------------------------------------------------------------------------ + ! Read input initial data and write output initial data + !------------------------------------------------------------------------ + + ! Only examing the snow interfaces above zi=0 => zisno and zsno have + ! the same level dimension below + + ! Read input initial data and write output initial data + ! Only examing the snow interfaces above zi=0 => zisno and zsno have + ! the same level dimension below + + if (masterproc) then + write(iulog,*)'reading in initial dataset' + end if + ! Get number of output variables and loop over them + status = pio_inquire(ncido, nVariables=nvars) + do varido = 1, nvars + + !--------------------------------------------------- + ! Given varido, get out variable data + !--------------------------------------------------- + + status = pio_inquire_variable(ncido, varid=varido, name=varname, & + xtype=xtypeo, ndims=ndimso, dimids=dimidso) + + !--------------------------------------------------- + ! If variable is zsoi, SKIP this variable + !--------------------------------------------------- + + if ( trim(varname) == 'zsoi' ) then + if (masterproc) then + write(iulog,*) 'Skipping : ',trim(varname) + end if + CYCLE + end if + + !--------------------------------------------------- + ! If interpinic flag is set to skip on output file + ! SKIP this variable + !--------------------------------------------------- + + status = pio_inq_varid (ncido, trim(varname), vardesc) + status = pio_get_att(ncido, vardesc, 'interpinic_flag', iflag_interpinic) + if (iflag_interpinic == iflag_skip) then + if (masterproc) then + write (iulog,*) 'Skipping : ', trim(varname) + end if + CYCLE + end if + + !--------------------------------------------------- + ! Read metadata telling us possible variable names on input file; + ! determine which of these is present on the input file + !--------------------------------------------------- + + ! 'varnames_on_old_files' is a colon-delimited list of possible variable names, + ! enabling backwards compatibility with old input files + status = pio_get_att(ncido, vardesc, 'varnames_on_old_files', varname_i_options) + + ! We expect the first name in the list to match the current variable name. If that + ! isn't true, abort. This check is mainly to catch behavior changes in the code to + ! write this attribute in restUtilMod: Significant changes in behavior there need + ! to be matched by corresponding changes in this module. For example, if + ! restUtilMod changes this attribute to exclude the first name (which, after all, + ! is available via the variable name itself), then code in this module should + ! change accordingly. + call shr_string_listGetName(varname_i_options, 1, varname_i) + if (varname_i /= varname) then + if (masterproc) then + write(iulog,*) 'ERROR: expect first element in varnames_on_old_files to match varname' + write(iulog,*) 'varname = ', trim(varname) + write(iulog,*) 'varnames_on_old_files = ', trim(varname_i_options) + write(iulog,*) 'This likely indicates that the code to write the' + write(iulog,*) 'varnames_on_old_files attribute list has changed behavior.' + end if + call endrun(msg='ERROR: expect first element in varnames_on_old_files to match varname'// & + errMsg(__FILE__, __LINE__)) + end if + + ! Find which of the list of possible variables actually exists on the input file. + call find_var_on_file(ncidi, varname_i_options, varname_i) + + ! Note that, if none of the options are found, varname_i will be set to the first + ! variable in the list, in which case the following code will determine that we + ! should skip this variable. + + !--------------------------------------------------- + ! If variable is on output file - but not on input file + ! SKIP this variable + !--------------------------------------------------- + + call pio_seterrorhandling(ncidi, PIO_BCAST_ERROR) + status = pio_inq_varid(ncidi, name=varname_i, vardesc=vardesc) + call pio_seterrorhandling(ncidi, PIO_INTERNAL_ERROR) + if (status /= PIO_noerr) then + if (masterproc) then + write (iulog,*) 'Skipping : ', trim(varname), ' variable is NOT on input file' + end if + CYCLE + end if + + !--------------------------------------------------- + ! For scalar outut variables + !--------------------------------------------------- + + if ( ndimso == 0 ) then + + if ( trim(varname) .eq. 'spinup_state' ) then + + ! since we are copying soil variables, need to also copy spinup state + ! since otherwise if they are different then it will break the spinup procedure + status = pio_inq_varid(ncidi, trim(varname_i), vardesc) + status = pio_get_var(ncidi, vardesc, spinup_state_i) + status = pio_inq_varid(ncido, trim(varname), vardesc) + status = pio_get_var(ncido, vardesc, spinup_state_o) + if ( spinup_state_i /= spinup_state_o ) then + if (masterproc) then + write (iulog,*) 'Spinup states are different: Copying: ', & + trim(varname_i), ' => ', trim(varname) + end if + status = pio_put_var(ncido, vardesc, spinup_state_i) + else + if (masterproc) then + write (iulog,*) 'Spinup states match: Skipping: ', & + trim(varname_i), ' => ', trim(varname) + end if + endif + + else if ( trim(varname) .eq. 'decomp_cascade_state' ) then + + ! ditto for the decomposition cascade + status = pio_inq_varid(ncidi, trim(varname_i), vardesc) + status = pio_get_var(ncidi, vardesc, decomp_cascade_state_i) + status = pio_inq_varid(ncido, trim(varname), vardesc) + status = pio_get_var(ncido, vardesc, decomp_cascade_state_o) + if ( decomp_cascade_state_i /= decomp_cascade_state_o ) then + call endrun(msg='ERROR: Decomposition cascade states are different'//errMsg(__FILE__, __LINE__)) + else + if (masterproc) then + write (iulog,*) 'Decomposition cascade states match: Skipping: ', & + trim(varname_i), ' => ', trim(varname) + end if + endif + + else if (iflag_interpinic == iflag_copy) then + + call interp_0d_copy(varname, varname_i, xtypeo, ncidi, ncido) + + else if (iflag_interpinic == iflag_skip) then + + if (masterproc) then + write(iulog,*) 'Skipping : ',trim(varname) + end if + + end if + + !--------------------------------------------------- + ! For 1D output variables + !--------------------------------------------------- + + else if ( ndimso == 1 ) then + + status = pio_inq_dimname(ncido, dimidso(1), vec_dimname) + if ( vec_dimname == 'pft' )then + begi = begp_i + endi = endp_i + bego = begp_o + endo = endp_o + activei => pft_activei + activeo => pft_activeo + sgridindex => pftindx + else if ( vec_dimname == 'column' )then + begi = begc_i + endi = endc_i + bego = begc_o + endo = endc_o + activei => col_activei + activeo => col_activeo + sgridindex => colindx + else if ( vec_dimname == 'landunit' )then + begi = begl_i + endi = endl_i + bego = begl_o + endo = endl_o + activei => lun_activei + activeo => lun_activeo + sgridindex => lunindx + else + call endrun(msg='ERROR interpinic: 1D variable '//trim(varname)//& + 'with unknown subgrid dimension: '//trim(vec_dimname)//& + errMsg(__FILE__, __LINE__)) + end if + + if ( xtypeo == pio_int )then + call interp_1d_int ( varname, varname_i, vec_dimname, begi, endi, bego, endo, & + ncidi, ncido, activei, activeo, sgridindex ) + else if ( xtypeo == pio_double )then + call interp_1d_double( varname, varname_i, vec_dimname, begi, endi, bego, endo, & + ncidi, ncido, activei, activeo, sgridindex ) + else + call endrun(msg='ERROR interpinic: 1D variable with unknown type: '//& + trim(varname)//errMsg(__FILE__, __LINE__)) + end if + + !--------------------------------------------------- + ! For 2D output variables + !--------------------------------------------------- + + else if ( ndimso == 2 )then + + if ( xtypeo /= pio_double )then + call endrun(msg='ERROR interpinic: 2D variable with unknown type: '//& + trim(varname)//errMsg(__FILE__, __LINE__)) + end if + ! Determine order of level and subgrid dimension in restart file + status = pio_inq_varid (ncidi, trim(varname_i), vardesc) + status = pio_inquire_variable(ncidi, vardesc=vardesc, dimids=dimidsi) + status = pio_get_att(ncidi, vardesc, 'switchdim_flag', switchdim_flag) + if (switchdim_flag > 0) then + levdimi = dimidsi(1) + vecdimi = dimidsi(2) + switchdimi = .true. + else + levdimi = dimidsi(2) + vecdimi = dimidsi(1) + switchdimi = .false. + end if + status = pio_inq_dimlen(ncidi,levdimi,nlevi) + + status = pio_inq_varid (ncido, trim(varname), vardesc) + status = pio_get_att(ncido, vardesc, 'switchdim_flag', switchdim_flag) + if (switchdim_flag > 0) then + levdimo = dimidso(1) + vecdimo = dimidso(2) + switchdimo = .true. + else + levdimo = dimidso(2) + vecdimo = dimidso(1) + switchdimo = .false. + end if + status = pio_inq_dimlen(ncido,levdimo,nlevo) + status = pio_inq_dimname(ncido, vecdimo, vec_dimname) + status = pio_inq_dimname(ncido, levdimo, lev_dimname) + + if ( vec_dimname == 'pft' )then + begi = begp_i + endi = endp_i + bego = begp_o + endo = endp_o + activei => pft_activei + activeo => pft_activeo + sgridindex => pftindx + else if ( vec_dimname == 'column' )then + begi = begc_i + endi = endc_i + bego = begc_o + endo = endc_o + activei => col_activei + activeo => col_activeo + sgridindex => colindx + else if ( vec_dimname == 'landunit' )then + begi = begl_i + endi = endl_i + bego = begl_o + endo = endl_o + activei => lun_activei + activeo => lun_activeo + sgridindex => lunindx + else + call endrun(msg='ERROR interpinic: 2D variable with unknown subgrid dimension: '//& + trim(varname)//errMsg(__FILE__, __LINE__)) + end if + call interp_2d_double(varname, varname_i, vec_dimname, lev_dimname, & + begi, endi, bego, endo, nlevi, nlevo, switchdimi, switchdimo, & + ncidi, ncido, activei, activeo, sgridindex) + + else + + call endrun(msg='ERROR interpinic: variable NOT scalar, 1D or 2D: '//& + trim(varname)//errMsg(__FILE__, __LINE__)) + + end if + call shr_sys_flush(iulog) + + end do + ! Close input and output files + + call pio_closefile(ncidi) + call pio_closefile(ncido) + + if (masterproc) then + write (iulog,*) ' Successfully created initial condition file mapped from input IC file' + end if + + end subroutine initInterp + + !======================================================================= + + subroutine findMinDist( dimname, begi, endi, bego, endo, ncidi, ncido, & + activei, activeo, minindx) + + ! -------------------------------------------------------------------- + ! + ! Find the PATCH distances based on the column distances already calculated + ! + ! arguments + character(len=*) , intent(inout) :: dimname + integer , intent(in) :: begi, endi + integer , intent(in) :: bego, endo + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + logical , intent(out) :: activei(begi:endi) + logical , intent(out) :: activeo(bego:endo) + integer , intent(out) :: minindx(bego:endo) + ! + ! local variables + type(subgrid_type) :: subgridi + type(subgrid_type) :: subgrido + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*)'calling set_subgrid_glob for ',trim(dimname) + end if + call set_subgrid_glob(begi, endi, dimname, ncidi, activei, subgridi) + + if (masterproc) then + write(iulog,*)'calling set_subgrid_dist',trim(dimname) + end if + call set_subgrid_dist(bego, endo, dimname, ncido, activeo, subgrido) + + if (masterproc) then + write(iulog,*)'calling set_mindist for ',trim(dimname) + end if + call set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgrido, minindx) + + deallocate(subgridi%lat, subgridi%lon, subgridi%coslat) + deallocate(subgrido%lat, subgrido%lon, subgrido%coslat) + + end subroutine findMinDist + + !======================================================================= + + subroutine set_subgrid_dist(beg, end, dimname, ncid, active, subgrid) + + ! -------------------------------------------------------------------- + ! arguments + integer , intent(in) :: beg, end + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(inout) :: dimname + logical , intent(inout) :: active(beg:end) + type(subgrid_type) , intent(inout) :: subgrid + ! + ! local variables + integer :: n + integer, pointer :: itemp(:) + real(r8), parameter :: deg2rad = SHR_CONST_PI/180._r8 + !----------------------------------------------------------------------- + + subgrid%name = dimname + + allocate(itemp(beg:end)) + allocate(subgrid%lat(beg:end), subgrid%lon(beg:end), subgrid%coslat(beg:end)) + if (dimname == 'pft') then + allocate(subgrid%ptype(beg:end), subgrid%ctype(beg:end), subgrid%ltype(beg:end)) + else if (dimname == 'column') then + allocate(subgrid%ctype(beg:end), subgrid%ltype(beg:end)) + else if (dimname == 'landunit') then + allocate(subgrid%ltype(beg:end)) + end if + + ! determine if is_glcmec from global attributes + if (trim(created_glacier_mec_landunits) == 'true') then + if (dimname == 'pft' .or. dimname == 'column') then + allocate(subgrid%topoglc(beg:end)) + end if + end if + + if (dimname == 'pft') then + call ncd_io(ncid=ncid, varname='pfts1d_lon' , flag='read', data=subgrid%lon , dim1name='pft') + call ncd_io(ncid=ncid, varname='pfts1d_lat' , flag='read', data=subgrid%lat , dim1name='pft') + call ncd_io(ncid=ncid, varname='pfts1d_itypveg', flag='read', data=subgrid%ptype, dim1name='pft') + call ncd_io(ncid=ncid, varname='pfts1d_itypcol', flag='read', data=subgrid%ctype, dim1name='pft') + call ncd_io(ncid=ncid, varname='pfts1d_ityplun', flag='read', data=subgrid%ltype, dim1name='pft') + call ncd_io(ncid=ncid, varname='pfts1d_active' , flag='read', data=itemp , dim1name='pft') + if (associated(subgrid%topoglc)) then + call ncd_io(ncid=ncid, varname='pfts1d_topoglc', flag='read', data=subgrid%topoglc, dim1name='pft') + end if + else if (dimname == 'column') then + call ncd_io(ncid=ncid, varname='cols1d_lon' , flag='read', data=subgrid%lon , dim1name='column') + call ncd_io(ncid=ncid, varname='cols1d_lat' , flag='read', data=subgrid%lat , dim1name='column') + call ncd_io(ncid=ncid, varname='cols1d_ityp' , flag='read', data=subgrid%ctype, dim1name='column') + call ncd_io(ncid=ncid, varname='cols1d_ityplun', flag='read', data=subgrid%ltype, dim1name='column') + call ncd_io(ncid=ncid, varname='cols1d_active' , flag='read', data=itemp , dim1name='column') + if (associated(subgrid%topoglc)) then + call ncd_io(ncid=ncid, varname='cols1d_topoglc', flag='read', data=subgrid%topoglc, dim1name='column') + end if + else if (dimname == 'landunit') then + call ncd_io(ncid=ncid, varname='land1d_lon' , flag='read', data=subgrid%lon , dim1name='landunit') + call ncd_io(ncid=ncid, varname='land1d_lat' , flag='read', data=subgrid%lat , dim1name='landunit') + call ncd_io(ncid=ncid, varname='land1d_ityplun', flag='read', data=subgrid%ltype, dim1name='landunit') + call ncd_io(ncid=ncid, varname='land1d_active' , flag='read', data=itemp , dim1name='landunit') + end if + + do n = beg,end + if (itemp(n) > 0) then + active(n) = .true. + else + active(n) = .false. + end if + subgrid%lat(n) = subgrid%lat(n)*deg2rad + subgrid%lon(n) = subgrid%lon(n)*deg2rad + subgrid%coslat(n) = cos(subgrid%lat(n)) + end do + + deallocate(itemp) + + end subroutine set_subgrid_dist + + !======================================================================= + + subroutine set_subgrid_glob(beg, end, dimname, ncid, active, subgrid) + + ! -------------------------------------------------------------------- + ! arguments + integer , intent(in) :: beg, end + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(inout) :: dimname + logical , intent(out) :: active(beg:end) + type(subgrid_type) , intent(inout) :: subgrid + ! + ! local variables + integer :: n + integer , pointer :: itemp(:) + real(r8), parameter :: deg2rad = SHR_CONST_PI/180._r8 + !----------------------------------------------------------------------- + + subgrid%name = dimname + + allocate(itemp(beg:end)) + allocate(subgrid%lat(beg:end), subgrid%lon(beg:end), subgrid%coslat(beg:end)) + if (dimname == 'pft') then + allocate(subgrid%ptype(beg:end), subgrid%ctype(beg:end), subgrid%ltype(beg:end)) + else if (dimname == 'column') then + allocate(subgrid%ctype(beg:end), subgrid%ltype(beg:end)) + else if (dimname == 'landunit') then + allocate(subgrid%ltype(beg:end)) + end if + + ! determine if is_glcmec from global attributes + if (trim(created_glacier_mec_landunits) == 'true') then + if (dimname == 'pft' .or. dimname == 'column') then + allocate(subgrid%topoglc(beg:end)) + end if + end if + + if (dimname == 'pft') then + call ncd_io(ncid=ncid, varname='pfts1d_lon' , flag='read', data=subgrid%lon ) + call ncd_io(ncid=ncid, varname='pfts1d_lat' , flag='read', data=subgrid%lat ) + call ncd_io(ncid=ncid, varname='pfts1d_itypveg', flag='read', data=subgrid%ptype) + call ncd_io(ncid=ncid, varname='pfts1d_itypcol', flag='read', data=subgrid%ctype) + call ncd_io(ncid=ncid, varname='pfts1d_ityplun', flag='read', data=subgrid%ltype) + call ncd_io(ncid=ncid, varname='pfts1d_active' , flag='read', data=itemp) + if (associated(subgrid%topoglc)) then + call ncd_io(ncid=ncid, varname='pfts1d_topoglc', flag='read', data=subgrid%topoglc) + end if + else if (dimname == 'column') then + call ncd_io(ncid=ncid, varname='cols1d_lon' , flag='read', data=subgrid%lon) + call ncd_io(ncid=ncid, varname='cols1d_lat' , flag='read', data=subgrid%lat) + call ncd_io(ncid=ncid, varname='cols1d_ityp' , flag='read', data=subgrid%ctype) + call ncd_io(ncid=ncid, varname='cols1d_ityplun', flag='read', data=subgrid%ltype) + call ncd_io(ncid=ncid, varname='cols1d_active' , flag='read', data=itemp) + if (associated(subgrid%topoglc)) then + call ncd_io(ncid=ncid, varname='cols1d_topoglc', flag='read', data=subgrid%topoglc) + end if + else if (dimname == 'landunit') then + call ncd_io(ncid=ncid, varname='land1d_lon' , flag='read', data=subgrid%lon ) + call ncd_io(ncid=ncid, varname='land1d_lat' , flag='read', data=subgrid%lat ) + call ncd_io(ncid=ncid, varname='land1d_ityplun', flag='read', data=subgrid%ltype) + call ncd_io(ncid=ncid, varname='land1d_active' , flag='read', data=itemp) + end if + + do n = beg,end + if (itemp(n) > 0) then + active(n) = .true. + else + active(n) = .false. + end if + subgrid%lat(n) = subgrid%lat(n)*deg2rad + subgrid%lon(n) = subgrid%lon(n)*deg2rad + subgrid%coslat(n) = cos(subgrid%lat(n)) + end do + + deallocate(itemp) + + end subroutine set_subgrid_glob + + !======================================================================= + + subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgrido, mindist_index) + + ! -------------------------------------------------------------------- + ! arguments + integer , intent(in) :: begi, endi + integer , intent(in) :: bego, endo + logical , intent(in) :: activei(begi:endi) + logical , intent(in) :: activeo(bego:endo) + type(subgrid_type) , intent(in) :: subgridi + type(subgrid_type) , intent(in) :: subgrido + integer , intent(out) :: mindist_index(bego:endo) + ! + ! local variables + real(r8) :: dx,dy + real(r8) :: distmin,dist,hgtdiffmin,hgtdiff + integer :: nsizei, nsizeo + integer :: ni,no,nmin,ier,n,noloc + logical :: closest + ! -------------------------------------------------------------------- + + mindist_index(bego:endo) = 0 + distmin = spval + +!$OMP PARALLEL DO PRIVATE (ni,no,n,nmin,distmin,dx,dy,dist,closest,hgtdiffmin,hgtdiff) + do no = bego,endo + + ! If output type is contained in input dataset ... + if (activeo(no)) then + + nmin = 0 + distmin = spval + hgtdiffmin = spval + do ni = begi,endi + if (activei(ni)) then + if (is_sametype(ni, no, subgridi, subgrido)) then + dy = abs(subgrido%lat(no)-subgridi%lat(ni))*re + dx = abs(subgrido%lon(no)-subgridi%lon(ni))*re * & + 0.5_r8*(subgrido%coslat(no)+subgridi%coslat(ni)) + dist = dx*dx + dy*dy + if (associated(subgridi%topoglc) .and. associated(subgrido%topoglc)) then + hgtdiff = abs(subgridi%topoglc(ni) - subgrido%topoglc(no)) + end if + closest = .false. + if ( dist < distmin ) then + closest = .true. + distmin = dist + nmin = ni + if (associated(subgridi%topoglc) .and. associated(subgrido%topoglc)) then + hgtdiffmin = hgtdiff + end if + end if + if (.not. closest) then + if (associated(subgridi%topoglc) .and. associated(subgrido%topoglc)) then + hgtdiff = abs(subgridi%topoglc(ni) - subgrido%topoglc(no)) + if ((dist == distmin) .and. (hgtdiff < hgtdiffmin)) then + closest = .true. + hgtdiffmin = hgtdiff + distmin = dist + nmin = ni + end if + end if + end if + end if + end if + end do + + ! If output type is not contained in input dataset, then use closest bare soil + if ( override_missing .and. distmin == spval) then + do ni = begi, endi + if (activei(ni)) then + if ( is_baresoil(ni, subgridi)) then + dy = abs(subgrido%lat(no)-subgridi%lat(ni))*re + dx = abs(subgrido%lon(no)-subgridi%lon(ni))*re * & + 0.5_r8*(subgrido%coslat(no)+subgridi%coslat(ni)) + dist = dx*dx + dy*dy + if ( dist < distmin )then + distmin = dist + nmin = ni + end if + end if + end if + end do + end if + + ! Error conditions + if ( distmin == spval )then + write(iulog,*) 'ERROR interpinic set_mindist: Cannot find the closest output ni,no,type= ',& + ni, no,subgridi%name + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + mindist_index(no) = nmin + + end if ! end if activeo block + end do +!$OMP END PARALLEL DO + + end subroutine set_mindist + + !======================================================================= + + logical function is_sametype (ni, no, subgridi, subgrido) + + ! -------------------------------------------------------------------- + ! arguments + integer , intent(in) :: ni + integer , intent(in) :: no + type(subgrid_type), intent(in) :: subgridi + type(subgrid_type), intent(in) :: subgrido + ! -------------------------------------------------------------------- + + is_sametype = .false. + + if (trim(subgridi%name) == 'pft' .and. trim(subgrido%name) == 'pft') then + if ( subgridi%ltype(ni) == ilun_landice_multiple_elevation_classes .and. & + subgrido%ltype(no) == ilun_landice_multiple_elevation_classes) then + is_sametype = .true. + else if (subgridi%ptype(ni) == subgrido%ptype(no) .and. & + subgridi%ctype(ni) == subgrido%ctype(no) .and. & + subgridi%ltype(ni) == subgrido%ltype(no)) then + is_sametype = .true. + end if + else if (trim(subgridi%name) == 'column' .and. trim(subgrido%name) == 'column') then + if ( subgridi%ltype(ni) == ilun_landice_multiple_elevation_classes .and. & + subgrido%ltype(no) == ilun_landice_multiple_elevation_classes ) then + is_sametype = .true. + else if (subgridi%ctype(ni) == subgrido%ctype(no) .and. & + subgridi%ltype(ni) == subgrido%ltype(no)) then + is_sametype = .true. + end if + else if (trim(subgridi%name) == 'landunit' .and. trim(subgrido%name) == 'landunit') then + if (subgridi%ltype(ni) == subgrido%ltype(no)) then + is_sametype = .true. + end if + else + if (masterproc) then + write(iulog,*)'ERROR interpinic: is_sametype check on input and output type not supported' + write(iulog,*)'typei = ',trim(subgridi%name) + write(iulog,*)'typeo = ',trim(subgrido%name) + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end function is_sametype + + !======================================================================= + + logical function is_baresoil (n, subgrid) + + ! -------------------------------------------------------------------- + ! arguments + integer , intent(in) :: n + type(subgrid_type), intent(in) :: subgrid + ! -------------------------------------------------------------------- + + is_baresoil = .false. + + if (subgrid%name == 'pft') then + if (subgrid%ptype(n) == ipft_not_vegetated) then + is_baresoil = .true. + end if + else if (subgrid%name == 'column') then + if (subgrid%ctype(n) == icol_vegetated_or_bare_soil) then + is_baresoil = .true. + end if + else if (subgrid%name == 'landunit') then + if (subgrid%ltype(n) == ilun_vegetated_or_bare_soil) then + is_baresoil = .true. + end if + else + if (masterproc) then + write(iulog,*)'ERROR interpinic: is_baresoil subgrid type ',subgrid%name,' not supported' + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end function is_baresoil + + !======================================================================= + + subroutine interp_0d_copy (varname, varname_i, xtype, ncidi, ncido) + + ! -------------------------------------------------------------------- + ! arguments + character(len=*) , intent(inout) :: varname ! variable name on output file + character(len=*) , intent(in) :: varname_i ! variable name on input file + integer , intent(in) :: xtype + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + ! + ! local variables + integer :: ivalue + real(r8):: rvalue + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Copying : ',trim(varname_i), ' => ', trim(varname) + end if + + if (xtype == pio_int) then + call ncd_io(ncid=ncidi, varname=trim(varname_i), flag='read' , data=ivalue) + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', data=ivalue) + else if (xtype == pio_double) then + call ncd_io(ncid=ncidi, varname=trim(varname_i), flag='read' , data=rvalue) + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', data=rvalue) + else + if (masterproc) then + write(iulog,*)'ERROR interpinic: unhandled case for var ',trim(varname),' stopping' + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine interp_0d_copy + + !======================================================================= + + subroutine interp_1d_double (varname, varname_i, dimname, begi, endi, bego, endo, ncidi, ncido, & + activei, activeo, sgridindex) + + ! ------------------------ arguments --------------------------------- + character(len=*) , intent(inout) :: varname ! variable name on output file + character(len=*) , intent(in) :: varname_i ! variable name on input file + character(len=*) , intent(inout) :: dimname + integer , intent(in) :: begi, endi + integer , intent(in) :: bego, endo + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + logical , intent(in) :: activei(begi:endi) + logical , intent(in) :: activeo(bego:endo) + integer , intent(in) :: sgridindex(bego:endo) + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + integer :: no,ni ! indices + real(r8), pointer :: rbufsli(:) ! input array + real(r8), pointer :: rbufslo(:) ! output array + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Interpolating: ',trim(varname_i), ' => ', trim(varname) + end if + + allocate (rbufsli(begi:endi), rbufslo(bego:endo)) + call ncd_io(ncid=ncidi, varname=trim(varname_i), flag='read', data=rbufsli) + call ncd_io(ncid=ncido, varname=trim(varname), flag='read', data=rbufslo, & + dim1name=dimname) + + do no = bego,endo + if (activeo(no)) then + ni = sgridindex(no) + if (ni > 0) then + if ( shr_infnan_isnan(rbufsli(ni)) ) then + rbufslo(no) = spval + else + rbufslo(no) = rbufsli(ni) + end if + else + rbufslo(no) = spval + end if + else + if ( shr_infnan_isnan(rbufslo(no)) ) then + rbufslo(no) = spval + end if + end if + end do + + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', data=rbufslo, & + dim1name=dimname) + + deallocate(rbufsli, rbufslo) + + end subroutine interp_1d_double + + !======================================================================= + + subroutine interp_1d_int (varname, varname_i, dimname, begi, endi, bego, endo, ncidi, ncido, & + activei, activeo, sgridindex) + + ! ------------------------ arguments --------------------------------- + character(len=*) , intent(inout) :: varname ! variable name on output file + character(len=*) , intent(in) :: varname_i ! variable name on input file + character(len=*) , intent(inout) :: dimname + integer , intent(in) :: begi, endi + integer , intent(in) :: bego, endo + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + logical , intent(in) :: activei(begi:endi) + logical , intent(in) :: activeo(bego:endo) + integer , intent(in) :: sgridindex(bego:endo) + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + integer :: no,ni !indices + integer , pointer :: ibufsli(:) !input array + integer , pointer :: ibufslo(:) !output array + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Interpolating: ',trim(varname_i), ' => ', trim(varname) + end if + + allocate (ibufsli(begi:endi), ibufslo(bego:endo)) + + call ncd_io(ncid=ncidi, varname=trim(varname_i), flag='read', & + data=ibufsli) + call ncd_io(ncid=ncido, varname=trim(varname), flag='read', & + data=ibufslo, dim1name=dimname) + + do no = bego,endo + if (activeo(no)) then + ni = sgridindex(no) + if (ni > 0) then + ibufslo(no) = ibufsli(ni) + end if + end if + end do + + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', & + data=ibufslo, dim1name=dimname) + + deallocate (ibufsli, ibufslo) + + end subroutine interp_1d_int + + !======================================================================= + + subroutine interp_2d_double (varname, varname_i, vec_dimname, lev_dimname, & + begi, endi, bego, endo, nlevi, nlevo, & + switchdimi, switchdimo, ncidi, ncido, activei, activeo, sgridindex) + + ! -------------------------------------------------------------------- + ! arguments + character(len=*) , intent(inout) :: varname ! variable name on output file + character(len=*) , intent(in) :: varname_i ! variable name on input file + character(len=*) , intent(inout) :: vec_dimname + character(len=*) , intent(inout) :: lev_dimname + integer , intent(in) :: begi, endi + integer , intent(in) :: bego, endo + integer , intent(in) :: nlevi, nlevo + logical , intent(inout) :: switchdimi + logical , intent(inout) :: switchdimo + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + logical , intent(in) :: activei(begi:endi) + logical , intent(in) :: activeo(bego:endo) + integer , intent(in) :: sgridindex(bego:endo) + ! + ! local variables + integer :: ni,no ! indices + integer :: ji, jj, index_lower ! indices + integer :: status ! netCDF return code + integer :: lev ! temporary + integer :: start(2), count(2) + logical :: copylevels, doneloop + type(Var_desc_t) :: vardesc ! pio variable descriptor + real(r8), pointer :: rbuf2do(:,:) ! output array + real(r8), pointer :: rbuf2di(:,:) ! input array + real(r8), pointer :: rbuf1di(:) ! input array + real(r8), pointer :: zsoii(:), zsoio(:) + real(r8), parameter :: eps = 1e-6 + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Interpolating: ',trim(varname_i), ' => ', trim(varname) + end if + + allocate(rbuf2do(bego:endo, nlevo)) + call ncd_io(ncid=ncido, varname=trim(varname), flag='read', data=rbuf2do, & + dim1name=trim(vec_dimname), switchdim=switchdimo) + + if (nlevi == nlevo) then + + ! Read in 1 level of input array at a time and do interpolation for just that level + + status = pio_inq_varid(ncidi, trim(varname_i), vardesc) + allocate(rbuf1di(begi:endi)) + do lev = 1,nlevo + if (switchdimi) then + start(1) = lev + count(1) = 1 + start(2) = 1 + count(2) = endi-begi+1 + else + start(1) = 1 + count(1) = endi-begi+1 + start(2) = lev + count(2) = 1 + end if + status = pio_get_var(ncidi, vardesc, start, count, rbuf1di) + do no = bego,endo + if (activeo(no)) then + ni = sgridindex(no) + if (ni > 0) then + rbuf2do(no,lev) = rbuf1di(ni) + end if + else + if ( shr_infnan_isnan(rbuf2do(no,lev)) ) then + rbuf2do(no,lev) = spval + end if + end if + end do + end do + deallocate(rbuf1di) + + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', data=rbuf2do, & + dim1name=trim(vec_dimname), switchdim=switchdimo) + + else if (nlevi < nlevo) then + + ! for the special case when we are regridding from the standard grid to the more + ! vertlayers grid, calculate a linear interpolation from the one grid to the other + + if (switchdimi) then + allocate(rbuf2di(nlevi, begi:endi)) + else + allocate(rbuf2di(begi:endi, nlevi)) + end if + call ncd_io(ncid=ncidi, varname=trim(varname_i), flag='read', data=rbuf2di) + + if ( ( nlevi .eq. 15) .and. (nlevo .eq. 30) ) then + !!! this is the case for variables on the levgrnd grid + allocate(zsoii(nlevi), zsoio(nlevo)) + status = pio_inq_varid(ncidi, 'zsoi', vardesc) + status = pio_get_var(ncidi, vardesc, zsoii) + status = pio_inq_varid(ncido, 'zsoi', vardesc) + status = pio_get_var(ncido, vardesc, zsoio) + else if ( ( nlevi .eq. 20) .and. (nlevo .eq. 35) ) then + !!! this is the case for variables on the levtot grid + allocate(zsoii(nlevi), zsoio(nlevo)) + status = pio_inq_varid(ncidi, 'zsoi', vardesc) + status = pio_get_var(ncidi, vardesc, zsoii(6:20)) + status = pio_inq_varid(ncido, 'zsoi', vardesc) + status = pio_get_var(ncido, vardesc, zsoio(6:35)) + !! need to put in dummy coordinates for the five snow levels + zsoii(1:5) = (/ -5._r8, -4._r8, -3._r8, -2._r8, 0._r8 /) + zsoio(1:5) = (/ -5._r8, -4._r8, -3._r8, -2._r8, 0._r8 /) + else + call endrun(msg='ERROR: vertical grid must be either levgrnd or levtot'//& + errMsg(__FILE__, __LINE__)) + endif + ! + do ji = 1, nlevo + doneloop = .false. + do jj = 1, nlevi + if ( .not. doneloop) then + if ( (abs(zsoio(ji) - zsoii(jj)) < eps ) .or. (jj .eq. nlevi) ) then + doneloop = .true. + copylevels = .true. + index_lower = jj + else if ( (zsoio(ji) > zsoii(jj)) .and. (zsoio(ji) < zsoii(jj+1)) ) then + doneloop = .true. + copylevels = .false. + index_lower = jj + end if + end if + end do + do no = bego,endo + if (activeo(no)) then + ni = sgridindex(no) + if (ni > 0) then + if (switchdimi) then + if ( copylevels) then + rbuf2do(no,ji) = rbuf2di(index_lower,ni) + else + rbuf2do(no,ji) = & + rbuf2di(index_lower+1,ni) & + * (zsoio(ji) - zsoii(index_lower)) & + / (zsoii(index_lower+1) - zsoii(index_lower)) + & + rbuf2di(index_lower,ni) & + * (zsoii(index_lower+1) - zsoio(ji) ) & + / (zsoii(index_lower+1) - zsoii(index_lower)) + end if + else + if ( copylevels) then + rbuf2do(no,ji) = rbuf2di(ni,index_lower) + else + rbuf2do(no,ji) = & + rbuf2di(ni,index_lower+1) & + * (zsoio(ji) - zsoii(index_lower)) & + / (zsoii(index_lower+1) - zsoii(index_lower)) + & + rbuf2di(ni,index_lower) & + * (zsoii(index_lower+1) - zsoio(ji) ) & + / (zsoii(index_lower+1) - zsoii(index_lower)) + end if + end if + end if + end if + end do + end do + deallocate(rbuf2di, zsoii, zsoio) + ! + call ncd_io(ncid=ncido, varname=trim(varname), flag='write', data=rbuf2do, & + dim1name=trim(vec_dimname), switchdim=switchdimo) + + else + + call endrun(msg='ERROR: new grid must have more vertical levels than old grid'//& + errMsg(__FILE__, __LINE__)) + + end if + + deallocate(rbuf2do) + + end subroutine interp_2d_double + + !======================================================================= + + subroutine check_dim_subgrid(ncidi, ncido, dimname, dimleni, dimleno) + + ! -------------------------------------------------------------------- + ! arguments + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + character(len=*) , intent(in) :: dimname + integer , intent(out) :: dimleni + integer , intent(out) :: dimleno + ! + ! local variables + integer :: status + integer :: dimid + ! -------------------------------------------------------------------- + + status = pio_inq_dimid (ncidi, dimname, dimid) + status = pio_inq_dimlen(ncidi, dimid , dimleni) + status = pio_inq_dimid (ncido, dimname, dimid) + status = pio_inq_dimlen(ncido, dimid , dimleno) + + end subroutine check_dim_subgrid + + !======================================================================= + + subroutine check_dim_level(ncidi, ncido, dimname) + + ! -------------------------------------------------------------------- + ! arguments + type(file_desc_t) , intent(inout) :: ncidi + type(file_desc_t) , intent(inout) :: ncido + character(len=*) , intent(in) :: dimname + ! + ! local variables + integer :: status + integer :: dimid + integer :: dimleni, dimleno + ! -------------------------------------------------------------------- + + status = pio_inq_dimid (ncidi, dimname, dimid) + status = pio_inq_dimlen(ncidi, dimid , dimleni) + status = pio_inq_dimid (ncido, dimname, dimid) + status = pio_inq_dimlen(ncido, dimid , dimleno) + + if ( (trim(dimname) == 'levgrnd') .or. (trim(dimname) == 'levtot') ) then + if (dimleni /= dimleno) then + if (masterproc) then + write (iulog,*) 'input and output ',trim(dimname),' values disagree' + write (iulog,*) 'input nlevgrnd = ',dimleni,' output nlevgrnd = ',dimleno + end if + if (dimleni > dimleno) then + if (masterproc) then + write (iulog,*) 'ERROR interpinic: input > output for variable ',trim(dimname),'; not supported, stopping' + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + else if (dimleni/=dimleno) then + !!if (masterproc) then + write (iulog,*) 'ERROR interpinic: input and output ',trim(dimname),' values disagree' + write (iulog,*) 'input dimlen = ',dimleni,' output dimlen = ',dimleno + !!end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine check_dim_level + +end module initInterpMod diff --git a/components/clm/src/main/initSubgridMod.F90 b/components/clm/src/main/initSubgridMod.F90 new file mode 100644 index 0000000000..b863d70d33 --- /dev/null +++ b/components/clm/src/main/initSubgridMod.F90 @@ -0,0 +1,461 @@ +module initSubgridMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Lower-level routines for initializing the subgrid structure. This module is shared + ! between both the production code (via initGridCellsMod) and unit testing code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use clm_varctl , only : iulog, use_ed + use clm_varcon , only : namep, namec, namel + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_ptrs_compdown ! fill in data pointing down + public :: clm_ptrs_check ! checks and writes out a summary of subgrid data + public :: add_landunit ! add an entry in the landunit-level arrays + public :: add_column ! add an entry in the column-level arrays + public :: add_patch ! add an entry in the patch-level arrays + ! + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine clm_ptrs_compdown(bounds) + ! + ! !DESCRIPTION: + ! Assumes the part of the subgrid pointing up has been set. Fills + ! in the data pointing down. Up is p_c, p_l, p_g, c_l, c_g, and l_g. + ! + ! This algorithm assumes all indices besides grid cell are monotonically + ! increasing. (Note that grid cell index is NOT monotonically increasing, + ! hence we cannot set initial & final indices at the grid cell level - + ! grc%luni, grc%lunf, etc.) + ! + ! Algorithm works as follows. The p, c, and l loops march through + ! the full arrays (nump, numc, and numl) checking the "up" indexes. + ! As soon as the "up" index of the current (p,c,l) cell changes relative + ! to the previous (p,c,l) cell, the *i array will be set to point down + ! to that cell. The *f array follows the same logic, so it's always the + ! last "up" index from the previous cell when an "up" index changes. + ! + ! For example, a case where p_c(1:4) = 1 and p_c(5:12) = 2. This + ! subroutine will set c_pi(1) = 1, c_pf(1) = 4, c_pi(2) = 5, c_pf(2) = 12. + ! + ! !USES + use clm_varcon, only : ispval + ! + ! !ARGUMENTS + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: l,c,p ! loop counters + integer :: curg,curl,curc,curp ! tracks g,l,c,p indexes in arrays + integer :: ltype ! landunit type + !------------------------------------------------------------------------------ + + !--- Set the current c,l (curc, curl) to zero for initialization, + !--- these indices track the current "up" index. + !--- Take advantage of locality of l/c/p cells + !--- Loop p through full local begp:endp length + !--- Separately check the p_c, p_l, and p_g indexes for a change in + !--- the "up" index. + !--- If there is a change, verify that the current c,l,g is within the + !--- valid range, and set c_pi, l_pi, or g_pi to that current c,l,g + !--- Constantly update the c_pf, l_pf, and g_pf array. When the + !--- g, l, c index changes, the *_pf array will be set correctly + !--- Do the same for cols setting c_li, c_gi, c_lf, c_gf and + !--- lunits setting l_gi, l_gf. + + curc = 0 + curl = 0 + do p = bounds%begp,bounds%endp + if (patch%column(p) /= curc) then + curc = patch%column(p) + if (curc < bounds%begc .or. curc > bounds%endc) then + write(iulog,*) 'clm_ptrs_compdown ERROR: pcolumn ',p,curc,bounds%begc,bounds%endc + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + endif + col%patchi(curc) = p + endif + col%patchf(curc) = p + col%npatches(curc) = col%patchf(curc) - col%patchi(curc) + 1 + if (patch%landunit(p) /= curl) then + curl = patch%landunit(p) + if (curl < bounds%begl .or. curl > bounds%endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: plandunit ',p,curl,bounds%begl,bounds%endl + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + endif + lun%patchi(curl) = p + endif + lun%patchf(curl) = p + lun%npatches(curl) = lun%patchf(curl) - lun%patchi(curl) + 1 + enddo + + curl = 0 + do c = bounds%begc,bounds%endc + if (col%landunit(c) /= curl) then + curl = col%landunit(c) + if (curl < bounds%begl .or. curl > bounds%endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: clandunit ',c,curl,bounds%begl,bounds%endl + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + endif + lun%coli(curl) = c + endif + lun%colf(curl) = c + lun%ncolumns(curl) = lun%colf(curl) - lun%coli(curl) + 1 + enddo + + ! Determine landunit_indices: indices into landunit-level arrays for each grid cell. + ! Note that landunits not present in a given grid cell are set to ispval. + grc%landunit_indices(:,bounds%begg:bounds%endg) = ispval + do l = bounds%begl,bounds%endl + ltype = lun%itype(l) + curg = lun%gridcell(l) + if (curg < bounds%begg .or. curg > bounds%endg) then + write(iulog,*) 'clm_ptrs_compdown ERROR: landunit_indices ', l,curg,bounds%begg,bounds%endg + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + + if (grc%landunit_indices(ltype, curg) == ispval) then + grc%landunit_indices(ltype, curg) = l + else + write(iulog,*) 'clm_ptrs_compdown ERROR: This landunit type has already been set for this gridcell' + write(iulog,*) 'l, ltype, curg = ', l, ltype, curg + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine clm_ptrs_compdown + + !------------------------------------------------------------------------------ + subroutine clm_ptrs_check(bounds) + ! + ! !DESCRIPTION: + ! Checks and writes out a summary of subgrid data + ! + ! !USES + use clm_varcon, only : ispval + use landunit_varcon, only : max_lunit + ! + ! !ARGUMENTS + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p ! loop counters + integer :: l_prev ! l value of previous point + integer :: ltype ! landunit type + logical :: error ! error flag + !------------------------------------------------------------------------------ + + associate( & + begg => bounds%begg, & + endg => bounds%endg, & + begl => bounds%begl, & + endl => bounds%endl, & + begc => bounds%begc, & + endc => bounds%endc, & + begp => bounds%begp, & + endp => bounds%endp & + ) + + if (masterproc) write(iulog,*) ' ' + if (masterproc) write(iulog,*) '---clm_ptrs_check:' + + !--- check index ranges --- + error = .false. + do g = begg, endg + do ltype = 1, max_lunit + l = grc%landunit_indices(ltype, g) + if (l /= ispval) then + if (l < begl .or. l > endl) error = .true. + end if + end do + end do + if (error) then + write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK' + + error = .false. + if (minval(lun%gridcell(begl:endl)) < begg .or. maxval(lun%gridcell(begl:endl)) > endg) error=.true. + if (minval(lun%coli(begl:endl)) < begc .or. maxval(lun%coli(begl:endl)) > endc) error=.true. + if (minval(lun%colf(begl:endl)) < begc .or. maxval(lun%colf(begl:endl)) > endc) error=.true. + if (minval(lun%patchi(begl:endl)) < begp .or. maxval(lun%patchi(begl:endl)) > endp) error=.true. + if (minval(lun%patchf(begl:endl)) < begp .or. maxval(lun%patchf(begl:endl)) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK' + + error = .false. + if (minval(col%gridcell(begc:endc)) < begg .or. maxval(col%gridcell(begc:endc)) > endg) error=.true. + if (minval(col%landunit(begc:endc)) < begl .or. maxval(col%landunit(begc:endc)) > endl) error=.true. + if (minval(col%patchi(begc:endc)) < begp .or. maxval(col%patchi(begc:endc)) > endp) error=.true. + if (minval(col%patchf(begc:endc)) < begp .or. maxval(col%patchf(begc:endc)) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK' + + error = .false. + if (minval(patch%gridcell(begp:endp)) < begg .or. maxval(patch%gridcell(begp:endp)) > endg) error=.true. + if (minval(patch%landunit(begp:endp)) < begl .or. maxval(patch%landunit(begp:endp)) > endl) error=.true. + if (minval(patch%column(begp:endp)) < begc .or. maxval(patch%column(begp:endp)) > endc) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK' + + !--- check that indices in arrays are monotonically increasing --- + error = .false. + do l=begl+1,endl + if ((lun%itype(l) == lun%itype(l-1)) .and. & + lun%gridcell(l) < lun%gridcell(l-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (lun%coli(l) < lun%coli(l-1)) error = .true. + if (lun%colf(l) < lun%colf(l-1)) error = .true. + if (lun%patchi(l) < lun%patchi(l-1)) error = .true. + if (lun%patchf(l) < lun%patchf(l-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR' + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK' + + error = .false. + do c=begc+1,endc + l = col%landunit(c) + l_prev = col%landunit(c-1) + if ((lun%itype(l) == lun%itype(l_prev)) .and. & + col%gridcell(c) < col%gridcell(c-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (col%landunit(c) < col%landunit(c-1)) error = .true. + if (col%patchi(c) < col%patchi(c-1)) error = .true. + if (col%patchf(c) < col%patchf(c-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR' + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK' + + error = .false. + do p=begp+1,endp + l = patch%landunit(p) + l_prev = patch%landunit(p-1) + if ((lun%itype(l) == lun%itype(l_prev)) .and. & + patch%gridcell(p) < patch%gridcell(p-1)) then + ! grid cell indices should be monotonically increasing for a given landunit type + error = .true. + end if + if (patch%landunit(p) < patch%landunit(p-1)) error = .true. + if (patch%column (p) < patch%column (p-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR' + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK' + + !--- check that the tree is internally consistent --- + error = .false. + do g = begg, endg + do ltype = 1, max_lunit + l = grc%landunit_indices(ltype, g) + + ! skip l == ispval, which implies that this landunit type doesn't exist on this grid cell + if (l /= ispval) then + if (lun%itype(l) /= ltype) error = .true. + if (lun%gridcell(l) /= g) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + endif + do c = lun%coli(l),lun%colf(l) + if (col%gridcell(c) /= g) error = .true. + if (col%landunit(c) /= l) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + endif + do p = col%patchi(c),col%patchf(c) + if (patch%gridcell(p) /= g) error = .true. + if (patch%landunit(p) /= l) error = .true. + if (patch%column(p) /= c) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + endif + enddo ! p + enddo ! c + end if ! l /= ispval + enddo ! ltype + enddo ! g + if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK' + if (masterproc) write(iulog,*) ' ' + + end associate + + end subroutine clm_ptrs_check + + !----------------------------------------------------------------------- + subroutine add_landunit(li, gi, ltype, wtgcell) + ! + ! !DESCRIPTION: + ! Add an entry in the landunit-level arrays. li gives the index of the last landunit + ! added; the new landunit is added at li+1, and the li argument is incremented + ! accordingly. + ! + ! !USES: + use landunit_varcon , only : istsoil, istcrop, istice_mec, istdlak, isturb_MIN, isturb_MAX + ! + ! !ARGUMENTS: + integer , intent(inout) :: li ! input value is index of last landunit added; output value is index of this newly-added landunit + integer , intent(in) :: gi ! grid cell index on which this landunit should be placed + integer , intent(in) :: ltype ! landunit type + real(r8) , intent(in) :: wtgcell ! weight of the landunit relative to the grid cell + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'add_landunit' + !----------------------------------------------------------------------- + + li = li + 1 + + lun%gridcell(li) = gi + lun%wtgcell(li) = wtgcell + lun%itype(li) = ltype + + if (ltype == istsoil .or. ltype == istcrop) then + lun%ifspecial(li) = .false. + else + lun%ifspecial(li) = .true. + end if + + if (ltype == istice_mec) then + lun%glcmecpoi(li) = .true. + else + lun%glcmecpoi(li) = .false. + end if + + if (ltype == istdlak) then + lun%lakpoi(li) = .true. + else + lun%lakpoi(li) = .false. + end if + + if (ltype >= isturb_MIN .and. ltype <= isturb_MAX) then + lun%urbpoi(li) = .true. + else + lun%urbpoi(li) = .false. + end if + + end subroutine add_landunit + + !----------------------------------------------------------------------- + subroutine add_column(ci, li, ctype, wtlunit) + ! + ! !DESCRIPTION: + ! Add an entry in the column-level arrays. ci gives the index of the last column + ! added; the new column is added at ci+1, and the ci argument is incremented + ! accordingly. + ! + ! !ARGUMENTS: + integer , intent(inout) :: ci ! input value is index of last column added; output value is index of this newly-added column + integer , intent(in) :: li ! landunit index on which this column should be placed (assumes this landunit has already been created) + integer , intent(in) :: ctype ! column type + real(r8) , intent(in) :: wtlunit ! weight of the column relative to the landunit + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'add_column' + !----------------------------------------------------------------------- + + ci = ci + 1 + + col%landunit(ci) = li + col%gridcell(ci) = lun%gridcell(li) + col%wtlunit(ci) = wtlunit + col%itype(ci) = ctype + + end subroutine add_column + + !----------------------------------------------------------------------- + subroutine add_patch(pi, ci, ptype, wtcol) + ! + ! !DESCRIPTION: + ! Add an entry in the patch-level arrays. pi gives the index of the last patch added; the + ! new patch is added at pi+1, and the pi argument is incremented accordingly. + ! + ! !USES: + use clm_varcon , only : ispval + use landunit_varcon , only : istsoil, istcrop + use clm_varpar , only : natpft_lb + ! + ! !ARGUMENTS: + integer , intent(inout) :: pi ! input value is index of last patch added; output value is index of this newly-added patch + integer , intent(in) :: ci ! column index on which this patch should be placed (assumes this column has already been created) + integer , intent(in) :: ptype ! patch type + real(r8) , intent(in) :: wtcol ! weight of the patch relative to the column + ! + ! !LOCAL VARIABLES: + integer :: li ! landunit index + integer :: lb_offset ! offset between natpft_lb and 1 + + character(len=*), parameter :: subname = 'add_patch' + !----------------------------------------------------------------------- + + pi = pi + 1 + + patch%column(pi) = ci + li = col%landunit(ci) + patch%landunit(pi) = li + patch%gridcell(pi) = col%gridcell(ci) + + patch%wtcol(pi) = wtcol + + ! TODO (MV, 10-17-14): The following must be commented out because + ! currently patch%itype is used in CanopyTemperatureMod to calculate + ! z0m(p) and displa(p) - and is still called even when ED is on + + !if (.not. use_ed) then + patch%itype(pi) = ptype + !end if + + if (lun%itype(li) == istsoil .or. lun%itype(li) == istcrop) then + lb_offset = 1 - natpft_lb + patch%mxy(pi) = ptype + lb_offset + else + patch%mxy(pi) = ispval + end if + + + end subroutine add_patch + + +end module initSubgridMod diff --git a/components/clm/src/main/initVerticalMod.F90 b/components/clm/src/main/initVerticalMod.F90 new file mode 100644 index 0000000000..f771d6d904 --- /dev/null +++ b/components/clm/src/main/initVerticalMod.F90 @@ -0,0 +1,521 @@ +module initVerticalMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Initialize vertical components of column datatype + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort + use decompMod , only : bounds_type + use spmdMod , only : masterproc + use clm_varpar , only : more_vertlayers, nlevsno, nlevgrnd, nlevlak + use clm_varpar , only : toplev_equalspace, nlev_equalspace + use clm_varpar , only : nlevsoi, nlevsoifl, nlevurb + use clm_varctl , only : fsurdat, iulog + use clm_varctl , only : use_vancouver, use_mexicocity, use_vertsoilc, use_extralakelayers + use clm_varcon , only : zlak, dzlak, zsoi, dzsoi, zisoi, dzsoi_decomp, spval, grlnd + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv + use landunit_varcon , only : istdlak, istice_mec + use fileutils , only : getfil + use LandunitType , only : lun + use ColumnType , only : col + use SnowHydrologyMod , only : InitSnowLayers + use ncdio_pio + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: initVertical + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine initVertical(bounds, snow_depth, thick_wall, thick_roof) + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: snow_depth(bounds%begc:) + real(r8) , intent(in) :: thick_wall(bounds%begl:) + real(r8) , intent(in) :: thick_roof(bounds%begl:) + ! + ! LOCAL VARAIBLES: + integer :: c,l,g,i,j,lev ! indices + type(file_desc_t) :: ncid ! netcdf id + logical :: readvar + integer :: dimid ! dimension id + character(len=256) :: locfn ! local filename + real(r8) ,pointer :: std (:) ! read in - topo_std + real(r8) ,pointer :: tslope (:) ! read in - topo_slope + real(r8) :: slope0 ! temporary + real(r8) :: slopebeta ! temporary + real(r8) :: slopemax ! temporary + integer :: ier ! error status + real(r8) :: scalez = 0.025_r8 ! Soil layer thickness discretization (m) + real(r8) :: thick_equal = 0.2 + real(r8) ,pointer :: lakedepth_in(:) ! read in - lakedepth + real(r8), allocatable :: zurb_wall(:,:) ! wall (layer node depth) + real(r8), allocatable :: zurb_roof(:,:) ! roof (layer node depth) + real(r8), allocatable :: dzurb_wall(:,:) ! wall (layer thickness) + real(r8), allocatable :: dzurb_roof(:,:) ! roof (layer thickness) + real(r8), allocatable :: ziurb_wall(:,:) ! wall (layer interface) + real(r8), allocatable :: ziurb_roof(:,:) ! roof (layer interface) + real(r8) :: depthratio ! ratio of lake depth to standard deep lake depth + integer :: begc, endc + integer :: begl, endl + !------------------------------------------------------------------------ + + begc = bounds%begc; endc= bounds%endc + begl = bounds%begl; endl= bounds%endl + + SHR_ASSERT_ALL((ubound(snow_depth) == (/endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(thick_wall) == (/endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(thick_roof) == (/endl/)), errMsg(__FILE__, __LINE__)) + + ! Open surface dataset to read in data below + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqdlen(ncid, dimid, nlevsoifl, name='nlevsoi') + if ( .not. more_vertlayers )then + if ( nlevsoifl /= nlevsoi )then + call shr_sys_abort(' ERROR: Number of soil layers on file does NOT match the number being used'//& + errMsg(__FILE__, __LINE__)) + end if + else + ! read in layers, interpolate to high resolution grid later + end if + + ! -------------------------------------------------------------------- + ! Define layer structure for soil, lakes, urban walls and roof + ! Vertical profile of snow is not initialized here - but below + ! -------------------------------------------------------------------- + + ! Soil layers and interfaces (assumed same for all non-lake patches) + ! "0" refers to soil surface and "nlevsoi" refers to the bottom of model soil + + if ( more_vertlayers )then + ! replace standard exponential grid with a grid that starts out exponential, + ! then has several evenly spaced layers, then finishes off exponential. + ! this allows the upper soil to behave as standard, but then continues + ! with higher resolution to a deeper depth, so that, for example, permafrost + ! dynamics are not lost due to an inability to resolve temperature, moisture, + ! and biogeochemical dynamics at the base of the active layer + do j = 1, toplev_equalspace + zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths + enddo + + do j = toplev_equalspace+1,toplev_equalspace + nlev_equalspace + zsoi(j) = zsoi(j-1) + thick_equal + enddo + + do j = toplev_equalspace + nlev_equalspace +1, nlevgrnd + zsoi(j) = scalez*(exp(0.5_r8*((j - nlev_equalspace)-0.5_r8))-1._r8) + nlev_equalspace * thick_equal + enddo + else + + do j = 1, nlevgrnd + zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths + enddo + end if + + dzsoi(1) = 0.5_r8*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + do j = 2,nlevgrnd-1 + dzsoi(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1)) + enddo + dzsoi(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1) + + zisoi(0) = 0._r8 + do j = 1, nlevgrnd-1 + zisoi(j) = 0.5_r8*(zsoi(j)+zsoi(j+1)) !interface depths + enddo + zisoi(nlevgrnd) = zsoi(nlevgrnd) + 0.5_r8*dzsoi(nlevgrnd) + + if (masterproc) then + write(iulog, *) 'zsoi', zsoi(:) + write(iulog, *) 'zisoi: ', zisoi(:) + write(iulog, *) 'dzsoi: ', dzsoi(:) + end if + + ! define a vertical grid spacing such that it is the normal dzsoi if nlevdecomp =nlevgrnd, or else 1 meter + if (use_vertsoilc) then + dzsoi_decomp(1) = 0.5_r8*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + do j = 2,nlevgrnd-1 + dzsoi_decomp(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1)) + enddo + dzsoi_decomp(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1) + else + dzsoi_decomp(1) = 1. + end if + if (masterproc) then + write(iulog, *) 'dzsoi_decomp', dzsoi_decomp(:) + end if + + if (nlevurb > 0) then + allocate(zurb_wall(bounds%begl:bounds%endl,nlevurb), & + zurb_roof(bounds%begl:bounds%endl,nlevurb), & + dzurb_wall(bounds%begl:bounds%endl,nlevurb), & + dzurb_roof(bounds%begl:bounds%endl,nlevurb), & + ziurb_wall(bounds%begl:bounds%endl,0:nlevurb), & + ziurb_roof(bounds%begl:bounds%endl,0:nlevurb), & + stat=ier) + if (ier /= 0) then + call shr_sys_abort(' ERROR allocation error for '//& + 'zurb_wall,zurb_roof,dzurb_wall,dzurb_roof,ziurb_wall,ziurb_roof'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + ! Column level initialization for urban wall and roof layers and interfaces + do l = bounds%begl,bounds%endl + + ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom + if (lun%urbpoi(l)) then + if (use_vancouver) then + zurb_wall(l,1) = 0.010_r8/2._r8 + zurb_wall(l,2) = zurb_wall(l,1) + 0.010_r8/2._r8 + 0.020_r8/2._r8 + zurb_wall(l,3) = zurb_wall(l,2) + 0.020_r8/2._r8 + 0.070_r8/2._r8 + zurb_wall(l,4) = zurb_wall(l,3) + 0.070_r8/2._r8 + 0.070_r8/2._r8 + zurb_wall(l,5) = zurb_wall(l,4) + 0.070_r8/2._r8 + 0.030_r8/2._r8 + + zurb_roof(l,1) = 0.010_r8/2._r8 + zurb_roof(l,2) = zurb_roof(l,1) + 0.010_r8/2._r8 + 0.010_r8/2._r8 + zurb_roof(l,3) = zurb_roof(l,2) + 0.010_r8/2._r8 + 0.010_r8/2._r8 + zurb_roof(l,4) = zurb_roof(l,3) + 0.010_r8/2._r8 + 0.010_r8/2._r8 + zurb_roof(l,5) = zurb_roof(l,4) + 0.010_r8/2._r8 + 0.030_r8/2._r8 + + dzurb_wall(l,1) = 0.010_r8 + dzurb_wall(l,2) = 0.020_r8 + dzurb_wall(l,3) = 0.070_r8 + dzurb_wall(l,4) = 0.070_r8 + dzurb_wall(l,5) = 0.030_r8 + write(iulog,*)'Total thickness of wall: ',sum(dzurb_wall(l,:)) + write(iulog,*)'Wall layer thicknesses: ',dzurb_wall(l,:) + + dzurb_roof(l,1) = 0.010_r8 + dzurb_roof(l,2) = 0.010_r8 + dzurb_roof(l,3) = 0.010_r8 + dzurb_roof(l,4) = 0.010_r8 + dzurb_roof(l,5) = 0.030_r8 + write(iulog,*)'Total thickness of roof: ',sum(dzurb_roof(l,:)) + write(iulog,*)'Roof layer thicknesses: ',dzurb_roof(l,:) + + ziurb_wall(l,0) = 0. + ziurb_wall(l,1) = dzurb_wall(l,1) + do j = 2,nlevurb + ziurb_wall(l,j) = sum(dzurb_wall(l,1:j)) + end do + write(iulog,*)'Wall layer interface depths: ',ziurb_wall(l,:) + + ziurb_roof(l,0) = 0. + ziurb_roof(l,1) = dzurb_roof(l,1) + do j = 2,nlevurb + ziurb_roof(l,j) = sum(dzurb_roof(l,1:j)) + end do + write(iulog,*)'Roof layer interface depths: ',ziurb_roof(l,:) + else if (use_mexicocity) then + zurb_wall(l,1) = 0.015_r8/2._r8 + zurb_wall(l,2) = zurb_wall(l,1) + 0.015_r8/2._r8 + 0.120_r8/2._r8 + zurb_wall(l,3) = zurb_wall(l,2) + 0.120_r8/2._r8 + 0.150_r8/2._r8 + zurb_wall(l,4) = zurb_wall(l,3) + 0.150_r8/2._r8 + 0.150_r8/2._r8 + zurb_wall(l,5) = zurb_wall(l,4) + 0.150_r8/2._r8 + 0.015_r8/2._r8 + + zurb_roof(l,1) = 0.010_r8/2._r8 + zurb_roof(l,2) = zurb_roof(l,1) + 0.010_r8/2._r8 + 0.050_r8/2._r8 + zurb_roof(l,3) = zurb_roof(l,2) + 0.050_r8/2._r8 + 0.050_r8/2._r8 + zurb_roof(l,4) = zurb_roof(l,3) + 0.050_r8/2._r8 + 0.050_r8/2._r8 + zurb_roof(l,5) = zurb_roof(l,4) + 0.050_r8/2._r8 + 0.025_r8/2._r8 + + dzurb_wall(l,1) = 0.015_r8 + dzurb_wall(l,2) = 0.120_r8 + dzurb_wall(l,3) = 0.150_r8 + dzurb_wall(l,4) = 0.150_r8 + dzurb_wall(l,5) = 0.015_r8 + write(iulog,*)'Total thickness of wall: ',sum(dzurb_wall(l,:)) + write(iulog,*)'Wall layer thicknesses: ',dzurb_wall(l,:) + + dzurb_roof(l,1) = 0.010_r8 + dzurb_roof(l,2) = 0.050_r8 + dzurb_roof(l,3) = 0.050_r8 + dzurb_roof(l,4) = 0.050_r8 + dzurb_roof(l,5) = 0.025_r8 + write(iulog,*)'Total thickness of roof: ',sum(dzurb_roof(l,:)) + write(iulog,*)'Roof layer thicknesses: ',dzurb_roof(l,:) + + ziurb_wall(l,0) = 0. + ziurb_wall(l,1) = dzurb_wall(l,1) + do j = 2,nlevurb + ziurb_wall(l,j) = sum(dzurb_wall(l,1:j)) + end do + write(iulog,*)'Wall layer interface depths: ',ziurb_wall(l,:) + + ziurb_roof(l,0) = 0. + ziurb_roof(l,1) = dzurb_roof(l,1) + do j = 2,nlevurb + ziurb_roof(l,j) = sum(dzurb_roof(l,1:j)) + end do + write(iulog,*)'Roof layer interface depths: ',ziurb_roof(l,:) + else + do j = 1, nlevurb + zurb_wall(l,j) = (j-0.5)*(thick_wall(l)/float(nlevurb)) !node depths + end do + do j = 1, nlevurb + zurb_roof(l,j) = (j-0.5)*(thick_roof(l)/float(nlevurb)) !node depths + end do + + dzurb_roof(l,1) = 0.5*(zurb_roof(l,1)+zurb_roof(l,2)) !thickness b/n two interfaces + do j = 2,nlevurb-1 + dzurb_roof(l,j)= 0.5*(zurb_roof(l,j+1)-zurb_roof(l,j-1)) + enddo + dzurb_roof(l,nlevurb) = zurb_roof(l,nlevurb)-zurb_roof(l,nlevurb-1) + + dzurb_wall(l,1) = 0.5*(zurb_wall(l,1)+zurb_wall(l,2)) !thickness b/n two interfaces + do j = 2,nlevurb-1 + dzurb_wall(l,j)= 0.5*(zurb_wall(l,j+1)-zurb_wall(l,j-1)) + enddo + dzurb_wall(l,nlevurb) = zurb_wall(l,nlevurb)-zurb_wall(l,nlevurb-1) + + ziurb_wall(l,0) = 0. + do j = 1, nlevurb-1 + ziurb_wall(l,j) = 0.5*(zurb_wall(l,j)+zurb_wall(l,j+1)) !interface depths + enddo + ziurb_wall(l,nlevurb) = zurb_wall(l,nlevurb) + 0.5*dzurb_wall(l,nlevurb) + + ziurb_roof(l,0) = 0. + do j = 1, nlevurb-1 + ziurb_roof(l,j) = 0.5*(zurb_roof(l,j)+zurb_roof(l,j+1)) !interface depths + enddo + ziurb_roof(l,nlevurb) = zurb_roof(l,nlevurb) + 0.5*dzurb_roof(l,nlevurb) + end if + end if + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + if (lun%urbpoi(l)) then + if (col%itype(c)==icol_sunwall .or. col%itype(c)==icol_shadewall) then + col%z(c,1:nlevurb) = zurb_wall(l,1:nlevurb) + col%zi(c,0:nlevurb) = ziurb_wall(l,0:nlevurb) + col%dz(c,1:nlevurb) = dzurb_wall(l,1:nlevurb) + if (nlevurb < nlevgrnd) then + col%z(c,nlevurb+1:nlevgrnd) = spval + col%zi(c,nlevurb+1:nlevgrnd) = spval + col%dz(c,nlevurb+1:nlevgrnd) = spval + end if + else if (col%itype(c)==icol_roof) then + col%z(c,1:nlevurb) = zurb_roof(l,1:nlevurb) + col%zi(c,0:nlevurb) = ziurb_roof(l,0:nlevurb) + col%dz(c,1:nlevurb) = dzurb_roof(l,1:nlevurb) + if (nlevurb < nlevgrnd) then + col%z(c,nlevurb+1:nlevgrnd) = spval + col%zi(c,nlevurb+1:nlevgrnd) = spval + col%dz(c,nlevurb+1:nlevgrnd) = spval + end if + else + col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + end if + else if (lun%itype(l) /= istdlak) then + col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + end if + end do + + if (nlevurb > 0) then + deallocate(zurb_wall, zurb_roof, dzurb_wall, dzurb_roof, ziurb_wall, ziurb_roof) + end if + + !----------------------------------------------- + ! Set lake levels and layers (no interfaces) + !----------------------------------------------- + + allocate(lakedepth_in(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='LAKEDEPTH', flag='read', data=lakedepth_in, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + if (masterproc) then + write(iulog,*) 'WARNING:: LAKEDEPTH not found on surface data set. All lake columns will have lake depth', & + ' set equal to default value.' + end if + lakedepth_in(:) = spval + end if + do c = begc, endc + g = col%gridcell(c) + col%lakedepth(c) = lakedepth_in(g) + end do + deallocate(lakedepth_in) + + ! Lake layers + if (.not. use_extralakelayers) then + dzlak(1) = 0.1_r8 + dzlak(2) = 1._r8 + dzlak(3) = 2._r8 + dzlak(4) = 3._r8 + dzlak(5) = 4._r8 + dzlak(6) = 5._r8 + dzlak(7) = 7._r8 + dzlak(8) = 7._r8 + dzlak(9) = 10.45_r8 + dzlak(10)= 10.45_r8 + + zlak(1) = 0.05_r8 + zlak(2) = 0.6_r8 + zlak(3) = 2.1_r8 + zlak(4) = 4.6_r8 + zlak(5) = 8.1_r8 + zlak(6) = 12.6_r8 + zlak(7) = 18.6_r8 + zlak(8) = 25.6_r8 + zlak(9) = 34.325_r8 + zlak(10)= 44.775_r8 + else + dzlak(1) =0.1_r8 + dzlak(2) =0.25_r8 + dzlak(3) =0.25_r8 + dzlak(4) =0.25_r8 + dzlak(5) =0.25_r8 + dzlak(6) =0.5_r8 + dzlak(7) =0.5_r8 + dzlak(8) =0.5_r8 + dzlak(9) =0.5_r8 + dzlak(10) =0.75_r8 + dzlak(11) =0.75_r8 + dzlak(12) =0.75_r8 + dzlak(13) =0.75_r8 + dzlak(14) =2_r8 + dzlak(15) =2_r8 + dzlak(16) =2.5_r8 + dzlak(17) =2.5_r8 + dzlak(18) =3.5_r8 + dzlak(19) =3.5_r8 + dzlak(20) =3.5_r8 + dzlak(21) =3.5_r8 + dzlak(22) =5.225_r8 + dzlak(23) =5.225_r8 + dzlak(24) =5.225_r8 + dzlak(25) =5.225_r8 + + zlak(1) = dzlak(1)/2._r8 + do i=2,nlevlak + zlak(i) = zlak(i-1) + (dzlak(i-1)+dzlak(i))/2._r8 + end do + end if + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + + if (lun%itype(l) == istdlak) then + + if (col%lakedepth(c) == spval) then + col%lakedepth(c) = zlak(nlevlak) + 0.5_r8*dzlak(nlevlak) + col%z_lake(c,1:nlevlak) = zlak(1:nlevlak) + col%dz_lake(c,1:nlevlak) = dzlak(1:nlevlak) + + else if (col%lakedepth(c) > 1._r8 .and. col%lakedepth(c) < 5000._r8) then + + depthratio = col%lakedepth(c) / (zlak(nlevlak) + 0.5_r8*dzlak(nlevlak)) + col%z_lake(c,1) = zlak(1) + col%dz_lake(c,1) = dzlak(1) + col%dz_lake(c,2:nlevlak-1) = dzlak(2:nlevlak-1)*depthratio + col%dz_lake(c,nlevlak) = dzlak(nlevlak)*depthratio - (col%dz_lake(c,1) - dzlak(1)*depthratio) + do lev=2,nlevlak + col%z_lake(c,lev) = col%z_lake(c,lev-1) + (col%dz_lake(c,lev-1)+col%dz_lake(c,lev))/2._r8 + end do + + else if (col%lakedepth(c) > 0._r8 .and. col%lakedepth(c) <= 1._r8) then + + col%dz_lake(c,:) = col%lakedepth(c) / nlevlak; + col%z_lake(c,1) = col%dz_lake(c,1) / 2._r8; + do lev=2,nlevlak + col%z_lake(c,lev) = col%z_lake(c,lev-1) + (col%dz_lake(c,lev-1)+col%dz_lake(c,lev))/2._r8 + end do + + else + + write(iulog,*)'Bad lake depth: lakedepth: ', col%lakedepth(c) + call shr_sys_abort(errmsg(__FILE__, __LINE__)) + + end if + + col%z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + col%zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + col%dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + end if + end do + + !----------------------------------------------- + ! Set cold-start values for snow levels, snow layers and snow interfaces + !----------------------------------------------- + + call InitSnowLayers(bounds, snow_depth(bounds%begc:bounds%endc)) + + !----------------------------------------------- + ! Read in topographic index and slope + !----------------------------------------------- + + allocate(tslope(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='SLOPE', flag='read', data=tslope, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call shr_sys_abort(' ERROR: TOPOGRAPHIC SLOPE NOT on surfdata file'//& + errMsg(__FILE__, __LINE__)) + end if + do c = begc,endc + g = col%gridcell(c) + ! check for near zero slopes, set minimum value + col%topo_slope(c) = max(tslope(g), 0.2_r8) + end do + deallocate(tslope) + + allocate(std(bounds%begg:bounds%endg)) + call ncd_io(ncid=ncid, varname='STD_ELEV', flag='read', data=std, dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call shr_sys_abort(' ERROR: TOPOGRAPHIC STDdev (STD_ELEV) NOT on surfdata file'//& + errMsg(__FILE__, __LINE__)) + end if + do c = begc,endc + g = col%gridcell(c) + ! Topographic variables + col%topo_std(c) = std(g) + end do + deallocate(std) + + !----------------------------------------------- + ! SCA shape function defined + !----------------------------------------------- + + do c = begc,endc + l = col%landunit(c) + + if (lun%itype(l)==istice_mec) then + ! ice_mec columns already account for subgrid topographic variability through + ! their use of multiple elevation classes; thus, to avoid double-accounting for + ! topographic variability in these columns, we ignore topo_std and use a value + ! of n_melt that assumes little topographic variability within the column + col%n_melt(c) = 10._r8 + else + col%n_melt(c) = 200.0/max(10.0_r8, col%topo_std(c)) + end if + + ! microtopographic parameter, units are meters (try smooth function of slope) + + slopebeta = 3._r8 + slopemax = 0.4_r8 + slope0 = slopemax**(-1._r8/slopebeta) + col%micro_sigma(c) = (col%topo_slope(c) + slope0)**(-slopebeta) + end do + + call ncd_pio_closefile(ncid) + + end subroutine initVertical + +end module initVerticalMod diff --git a/components/clm/src/main/init_hydrology.F90 b/components/clm/src/main/init_hydrology.F90 new file mode 100644 index 0000000000..42e7227550 --- /dev/null +++ b/components/clm/src/main/init_hydrology.F90 @@ -0,0 +1,36 @@ +subroutine init_hydrology( NLFilename ) +! +!DESCRIPTION +! Initialize implementation methods for different hydrology sub-modules +! This is created for unit-based sensitivity tests +! created by Jinyun Tang, Mar 22, 2014. + + ! !USES: + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + + use FuncPedotransferMod, only : init_pedof + use RootBiophysMod, only : init_rootprof + use SoilWaterMovementMod, only : init_soilwater_movement + use SurfaceResistanceMod, only : init_soil_stress + use SoilMoistStressMod, only : init_root_moist_stress +implicit none + + character(len=*), intent(IN) :: NLFilename ! Namelist filename + + !In future versions, a namelist will be created here to + !set up options for different sub-models, the namelist file + !will also be passed into this different initializing methods + !to read in their local parameters, Jinyun Tang, Mar 29, 2014 + + call init_pedof + + call init_rootprof + + call init_soilwater_movement + + call init_soil_stress + +end subroutine init_hydrology diff --git a/components/clm/src/main/landunit_varcon.F90 b/components/clm/src/main/landunit_varcon.F90 new file mode 100644 index 0000000000..cb1eb8d9dd --- /dev/null +++ b/components/clm/src/main/landunit_varcon.F90 @@ -0,0 +1,102 @@ +module landunit_varcon + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing landunit indices and associated variables and routines. + ! + ! !USES: + ! + ! + ! !PUBLIC TYPES: + implicit none + private + + !------------------------------------------------------------------ + ! Initialize landunit type constants + !------------------------------------------------------------------ + + integer, parameter, public :: istsoil = 1 !soil landunit type (natural vegetation) + integer, parameter, public :: istcrop = 2 !crop landunit type + integer, parameter, public :: istice = 3 !land ice landunit type (glacier) + integer, parameter, public :: istice_mec = 4 !land ice (multiple elevation classes) landunit type + integer, parameter, public :: istdlak = 5 !deep lake landunit type (now used for all lakes) + integer, parameter, public :: istwet = 6 !wetland landunit type (swamp, marsh, etc.) + + integer, parameter, public :: isturb_MIN = 7 !minimum urban type index + integer, parameter, public :: isturb_tbd = 7 !urban tbd landunit type + integer, parameter, public :: isturb_hd = 8 !urban hd landunit type + integer, parameter, public :: isturb_md = 9 !urban md landunit type + integer, parameter, public :: isturb_MAX = 9 !maximum urban type index + + integer, parameter, public :: max_lunit = 9 !maximum value that lun%itype can have + !(i.e., largest value in the above list) + + integer, parameter, public :: landunit_name_length = 40 ! max length of landunit names + character(len=landunit_name_length), public :: landunit_names(max_lunit) ! name of each landunit type + + ! parameters that depend on the above constants + + integer, parameter, public :: numurbl = isturb_MAX - isturb_MIN + 1 ! number of urban landunits + + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: landunit_varcon_init ! initialize constants in this module + + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: set_landunit_names ! set the landunit_names vector +!----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine landunit_varcon_init() + ! + ! !DESCRIPTION: + ! Initialize constants in landunit_varcon + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'landunit_varcon_init' + !----------------------------------------------------------------------- + + call set_landunit_names() + + end subroutine landunit_varcon_init + + !----------------------------------------------------------------------- + subroutine set_landunit_names + ! + ! !DESCRIPTION: + ! Set the landunit_names vector + ! + ! !USES: + use shr_sys_mod, only : shr_sys_abort + ! + character(len=*), parameter :: not_set = 'NOT_SET' + character(len=*), parameter :: subname = 'set_landunit_names' + !----------------------------------------------------------------------- + + landunit_names(:) = not_set + + landunit_names(istsoil) = 'vegetated_or_bare_soil' + landunit_names(istcrop) = 'crop' + landunit_names(istice) = 'landice' + landunit_names(istice_mec) = 'landice_multiple_elevation_classes' + landunit_names(istdlak) = 'deep_lake' + landunit_names(istwet) = 'wetland' + landunit_names(isturb_tbd) = 'urban_tbd' + landunit_names(isturb_hd) = 'urban_hd' + landunit_names(isturb_md) = 'urban_md' + + if (any(landunit_names == not_set)) then + call shr_sys_abort(trim(subname)//': Not all landunit names set') + end if + + end subroutine set_landunit_names + +end module landunit_varcon diff --git a/components/clm/src/main/lnd2atmMod.F90 b/components/clm/src/main/lnd2atmMod.F90 new file mode 100644 index 0000000000..a774bf716e --- /dev/null +++ b/components/clm/src/main/lnd2atmMod.F90 @@ -0,0 +1,311 @@ +module lnd2atmMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle lnd2atm mapping + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_megan_mod , only : shr_megan_mechcomps_n + use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. + use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval + use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_voc + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use decompMod , only : bounds_type + use subgridAveMod , only : p2g, c2g + use lnd2atmType , only : lnd2atm_type + use atm2lndType , only : atm2lnd_type + use ch4Mod , only : ch4_type + use CNVegCarbonFluxType , only : cnveg_carbonflux_type + use DUSTMod , only : dust_type + use DryDepVelocity , only : drydepvel_type + use VocEmissionMod , only : vocemis_type + use EnergyFluxType , only : energyflux_type + use FrictionVelocityMod , only : frictionvel_type + use SolarAbsorbedType , only : solarabs_type + use SurfaceAlbedoType , only : surfalb_type + use TemperatureType , only : temperature_type + use WaterFluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use GridcellType , only : grc + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: lnd2atm + public :: lnd2atm_minimal + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine lnd2atm_minimal(bounds, & + waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst) + ! + ! !DESCRIPTION: + ! Compute clm_l2a_inst component of gridcell derived type. This routine computes + ! the bare minimum of components necessary to get the first step of a + ! run started. + ! + ! !USES: + use clm_varcon, only : sb + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(waterstate_type) , intent(in) :: waterstate_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(lnd2atm_type) , intent(inout) :: lnd2atm_inst + ! + ! !LOCAL VARIABLES: + integer :: g ! index + real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon + real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen + real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2 + ! The following converts g of C to kg of CO2 + real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC) + !------------------------------------------------------------------------ + + call c2g(bounds, & + waterstate_inst%h2osno_col (bounds%begc:bounds%endc), & + lnd2atm_inst%h2osno_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + do g = bounds%begg,bounds%endg + lnd2atm_inst%h2osno_grc(g) = lnd2atm_inst%h2osno_grc(g)/1000._r8 + end do + + call c2g(bounds, nlevgrnd, & + waterstate_inst%h2osoi_vol_col (bounds%begc:bounds%endc, :), & + lnd2atm_inst%h2osoi_vol_grc (bounds%begg:bounds%endg, :), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(bounds, numrad, & + surfalb_inst%albd_patch (bounds%begp:bounds%endp, :), & + lnd2atm_inst%albd_grc (bounds%begg:bounds%endg, :), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(bounds, numrad, & + surfalb_inst%albi_patch (bounds%begp:bounds%endp, :), & + lnd2atm_inst%albi_grc (bounds%begg:bounds%endg, :), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(bounds, & + energyflux_inst%eflx_lwrad_out_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%eflx_lwrad_out_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + do g = bounds%begg,bounds%endg + lnd2atm_inst%t_rad_grc(g) = sqrt(sqrt(lnd2atm_inst%eflx_lwrad_out_grc(g)/sb)) + end do + + end subroutine lnd2atm_minimal + + !------------------------------------------------------------------------ + subroutine lnd2atm(bounds, & + atm2lnd_inst, surfalb_inst, temperature_inst, frictionvel_inst, & + waterstate_inst, waterflux_inst, energyflux_inst, & + solarabs_inst, cnveg_carbonflux_inst, drydepvel_inst, & + vocemis_inst, dust_inst, ch4_inst, lnd2atm_inst) + ! + ! !DESCRIPTION: + ! Compute lnd2atm_inst component of gridcell derived type + ! + ! !USES: + use ch4varcon , only : ch4offline + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(surfalb_type) , intent(in) :: surfalb_inst + type(temperature_type) , intent(in) :: temperature_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(energyflux_type) , intent(in) :: energyflux_inst + type(solarabs_type) , intent(in) :: solarabs_inst + type(cnveg_carbonflux_type) , intent(in) :: cnveg_carbonflux_inst + type(drydepvel_type) , intent(in) :: drydepvel_inst + type(vocemis_type) , intent(in) :: vocemis_inst + type(dust_type) , intent(in) :: dust_inst + type(ch4_type) , intent(in) :: ch4_inst + type(lnd2atm_type) , intent(inout) :: lnd2atm_inst + ! + ! !LOCAL VARIABLES: + integer :: g ! index + real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon + real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen + real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2 + ! The following converts g of C to kg of CO2 + real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC) + !------------------------------------------------------------------------ + + !---------------------------------------------------- + ! lnd -> atm + !---------------------------------------------------- + + ! First, compute the "minimal" set of fields. + call lnd2atm_minimal(bounds, & + waterstate_inst, surfalb_inst, energyflux_inst, lnd2atm_inst) + + call p2g(bounds, & + temperature_inst%t_ref2m_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%t_ref2m_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + waterstate_inst%q_ref2m_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%q_ref2m_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + frictionvel_inst%u10_clm_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%u_ref10m_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + energyflux_inst%taux_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%taux_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + energyflux_inst%tauy_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%tauy_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + waterflux_inst%qflx_evap_tot_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%qflx_evap_tot_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(bounds, & + solarabs_inst%fsa_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%fsa_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(bounds, & + frictionvel_inst%fv_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%fv_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(bounds, & + frictionvel_inst%ram1_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%ram1_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g( bounds, & + energyflux_inst%eflx_sh_tot_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%eflx_sh_tot_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity',c2l_scale_type='urbanf',l2g_scale_type='unity') + call c2g( bounds, & + energyflux_inst%eflx_sh_precip_conversion_col (bounds%begc:bounds%endc), & + lnd2atm_inst%eflx_sh_precip_conversion_grc (bounds%begg:bounds%endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity') + do g = bounds%begg, bounds%endg + lnd2atm_inst%eflx_sh_tot_grc(g) = lnd2atm_inst%eflx_sh_tot_grc(g) + & + lnd2atm_inst%eflx_sh_precip_conversion_grc(g) - & + energyflux_inst%eflx_dynbal_grc(g) + enddo + + call p2g(bounds, & + energyflux_inst%eflx_lh_tot_patch (bounds%begp:bounds%endp), & + lnd2atm_inst%eflx_lh_tot_grc (bounds%begg:bounds%endg), & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + if (use_cn) then + call c2g(bounds, & + cnveg_carbonflux_inst%nee_col(bounds%begc:bounds%endc), & + lnd2atm_inst%nee_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity') + + if (use_lch4) then + if (.not. ch4offline) then + ! Adjust flux of CO2 by the net conversion of mineralizing C to CH4 + do g = bounds%begg,bounds%endg + ! nem is in g C/m2/sec + lnd2atm_inst%nee_grc(g) = lnd2atm_inst%nee_grc(g) + lnd2atm_inst%nem_grc(g) + end do + end if + end if + + ! Convert from gC/m2/s to kgCO2/m2/s + do g = bounds%begg,bounds%endg + lnd2atm_inst%nee_grc(g) = lnd2atm_inst%nee_grc(g)*convertgC2kgCO2 + end do + else + do g = bounds%begg,bounds%endg + lnd2atm_inst%nee_grc(g) = 0._r8 + end do + end if + + ! drydepvel + if ( n_drydep > 0 .and. drydep_method == DD_XLND ) then + call p2g(bounds, n_drydep, & + drydepvel_inst%velocity_patch (bounds%begp:bounds%endp, :), & + lnd2atm_inst%ddvel_grc (bounds%begg:bounds%endg, :), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + endif + + ! voc emission flux + if (use_voc .and. shr_megan_mechcomps_n>0) then + call p2g(bounds, shr_megan_mechcomps_n, & + vocemis_inst%vocflx_patch(bounds%begp:bounds%endp,:), & + lnd2atm_inst%flxvoc_grc (bounds%begg:bounds%endg,:), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + end if + + ! dust emission flux + call p2g(bounds, ndst, & + dust_inst%flx_mss_vrt_dst_patch(bounds%begp:bounds%endp, :), & + lnd2atm_inst%flxdst_grc (bounds%begg:bounds%endg, :), & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + + ! ch4 flux + if (use_lch4) then + call c2g( bounds, & + ch4_inst%ch4_surf_flux_tot_col (bounds%begc:bounds%endc), & + lnd2atm_inst%flux_ch4_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity' ) + end if + + !---------------------------------------------------- + ! lnd -> rof + !---------------------------------------------------- + + call c2g( bounds, & + waterflux_inst%qflx_runoff_col (bounds%begc:bounds%endc), & + lnd2atm_inst%qflx_rofliq_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + do g = bounds%begg, bounds%endg + lnd2atm_inst%qflx_rofliq_grc(g) = lnd2atm_inst%qflx_rofliq_grc(g) - waterflux_inst%qflx_liq_dynbal_grc(g) + enddo + + call c2g( bounds, & + waterflux_inst%qflx_snwcp_ice_col(bounds%begc:bounds%endc), & + lnd2atm_inst%qflx_rofice_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + do g = bounds%begg, bounds%endg + lnd2atm_inst%qflx_rofice_grc(g) = lnd2atm_inst%qflx_rofice_grc(g) - waterflux_inst%qflx_ice_dynbal_grc(g) + enddo + + ! calculate total water storage for history files + ! first set tws to gridcell total endwb + ! second add river storage as gridcell average depth (1.e-3 converts [m3/km2] to [mm]) + ! TODO - this was in BalanceCheckMod - not sure where it belongs? + + call c2g( bounds, & + waterstate_inst%endwb_col(bounds%begc:bounds%endc), & + waterstate_inst%tws_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + do g = bounds%begg, bounds%endg + waterstate_inst%tws_grc(g) = waterstate_inst%tws_grc(g) + atm2lnd_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 + enddo + + end subroutine lnd2atm + +end module lnd2atmMod diff --git a/components/clm/src/main/lnd2atmType.F90 b/components/clm/src/main/lnd2atmType.F90 new file mode 100644 index 0000000000..30a1f6d7b4 --- /dev/null +++ b/components/clm/src/main/lnd2atmType.F90 @@ -0,0 +1,177 @@ +module lnd2atmType + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle atm2lnd, lnd2atm mapping + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. + use clm_varcon , only : spval + use clm_varctl , only : use_lch4 + use shr_megan_mod , only : shr_megan_mechcomps_n + use seq_drydep_mod, only : n_drydep, drydep_method, DD_XLND + ! + ! !PUBLIC TYPES: + implicit none + private + + ! ---------------------------------------------------- + ! land -> atmosphere variables structure + !---------------------------------------------------- + type, public :: lnd2atm_type + + ! lnd->atm + real(r8), pointer :: t_rad_grc (:) => null() ! radiative temperature (Kelvin) + real(r8), pointer :: t_ref2m_grc (:) => null() ! 2m surface air temperature (Kelvin) + real(r8), pointer :: q_ref2m_grc (:) => null() ! 2m surface specific humidity (kg/kg) + real(r8), pointer :: u_ref10m_grc (:) => null() ! 10m surface wind speed (m/sec) + real(r8), pointer :: h2osno_grc (:) => null() ! snow water (mm H2O) + real(r8), pointer :: h2osoi_vol_grc (:,:) => null() ! volumetric soil water (0~watsat, m3/m3, nlevgrnd) (for dust model) + real(r8), pointer :: albd_grc (:,:) => null() ! (numrad) surface albedo (direct) + real(r8), pointer :: albi_grc (:,:) => null() ! (numrad) surface albedo (diffuse) + real(r8), pointer :: taux_grc (:) => null() ! wind stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy_grc (:) => null() ! wind stress: n-s (kg/m/s**2) + real(r8), pointer :: eflx_lh_tot_grc (:) => null() ! total latent HF (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_grc (:) => null() ! total sensible HF (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_precip_conversion_grc(:) => null() ! sensible HF from precipitation conversion (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lwrad_out_grc (:) => null() ! IR (longwave) radiation (W/m**2) + real(r8), pointer :: qflx_evap_tot_grc (:) => null() ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: fsa_grc (:) => null() ! solar rad absorbed (total) (W/m**2) + real(r8), pointer :: nee_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) + real(r8), pointer :: fv_grc (:) => null() ! friction velocity (m/s) (for dust model) + real(r8), pointer :: flxdst_grc (:,:) => null() ! dust flux (size bins) + real(r8), pointer :: ddvel_grc (:,:) => null() ! dry deposition velocities + real(r8), pointer :: flxvoc_grc (:,:) => null() ! VOC flux (size bins) + real(r8), pointer :: flux_ch4_grc (:) => null() ! net CH4 flux (kg C/m**2/s) [+ to atm] + ! lnd->rof + real(r8), pointer :: qflx_rofliq_grc (:) => null() ! rof liq forcing + real(r8), pointer :: qflx_rofice_grc (:) => null() ! rof ice forcing + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitHistory + + end type lnd2atm_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(lnd2atm_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize lnd2atm derived type + ! + ! !ARGUMENTS: + class (lnd2atm_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + real(r8) :: ival = 0.0_r8 ! initial value + integer :: begg, endg + !------------------------------------------------------------------------ + + begg = bounds%begg; endg= bounds%endg + + allocate(this%t_rad_grc (begg:endg)) ; this%t_rad_grc (:) =ival + allocate(this%t_ref2m_grc (begg:endg)) ; this%t_ref2m_grc (:) =ival + allocate(this%q_ref2m_grc (begg:endg)) ; this%q_ref2m_grc (:) =ival + allocate(this%u_ref10m_grc (begg:endg)) ; this%u_ref10m_grc (:) =ival + allocate(this%h2osno_grc (begg:endg)) ; this%h2osno_grc (:) =ival + allocate(this%h2osoi_vol_grc (begg:endg,1:nlevgrnd)) ; this%h2osoi_vol_grc (:,:) =ival + allocate(this%albd_grc (begg:endg,1:numrad)) ; this%albd_grc (:,:) =ival + allocate(this%albi_grc (begg:endg,1:numrad)) ; this%albi_grc (:,:) =ival + allocate(this%taux_grc (begg:endg)) ; this%taux_grc (:) =ival + allocate(this%tauy_grc (begg:endg)) ; this%tauy_grc (:) =ival + allocate(this%eflx_lwrad_out_grc (begg:endg)) ; this%eflx_lwrad_out_grc (:) =ival + allocate(this%eflx_sh_tot_grc (begg:endg)) ; this%eflx_sh_tot_grc (:) =ival + allocate(this%eflx_sh_precip_conversion_grc(begg:endg)) ; this%eflx_sh_precip_conversion_grc(:) = ival + allocate(this%eflx_lh_tot_grc (begg:endg)) ; this%eflx_lh_tot_grc (:) =ival + allocate(this%qflx_evap_tot_grc (begg:endg)) ; this%qflx_evap_tot_grc (:) =ival + allocate(this%fsa_grc (begg:endg)) ; this%fsa_grc (:) =ival + allocate(this%nee_grc (begg:endg)) ; this%nee_grc (:) =ival + allocate(this%nem_grc (begg:endg)) ; this%nem_grc (:) =ival + allocate(this%ram1_grc (begg:endg)) ; this%ram1_grc (:) =ival + allocate(this%fv_grc (begg:endg)) ; this%fv_grc (:) =ival + allocate(this%flxdst_grc (begg:endg,1:ndst)) ; this%flxdst_grc (:,:) =ival + allocate(this%flux_ch4_grc (begg:endg)) ; this%flux_ch4_grc (:) =ival + allocate(this%qflx_rofliq_grc (begg:endg)) ; this%qflx_rofliq_grc (:) =ival + allocate(this%qflx_rofice_grc (begg:endg)) ; this%qflx_rofice_grc (:) =ival + + if (shr_megan_mechcomps_n>0) then + allocate(this%flxvoc_grc(begg:endg,1:shr_megan_mechcomps_n)); this%flxvoc_grc(:,:)=ival + endif + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + allocate(this%ddvel_grc(begg:endg,1:n_drydep)); this%ddvel_grc(:,:)=ival + end if + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(lnd2atm_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg, endg + !--------------------------------------------------------------------- + + begg = bounds%begg; endg= bounds%endg + + this%eflx_sh_tot_grc(begg:endg) = 0._r8 + call hist_addfld1d (fname='FSH_TO_COUPLER', units='W/m^2', & + avgflag='A', & + long_name='sensible heat sent to coupler (includes corrections for land use change and rain/snow conversion)', & + ptr_lnd=this%eflx_sh_tot_grc) + + this%qflx_rofliq_grc(begg:endg) = 0._r8 + call hist_addfld1d (fname='QRUNOFF_TO_COUPLER', units='mm/s', & + avgflag='A', & + long_name='total liquid runoff sent to coupler (does not include QSNWCPICE) (includes corrections for land use change)', & + ptr_lnd=this%qflx_rofliq_grc) + + this%qflx_rofice_grc(begg:endg) = 0._r8 + call hist_addfld1d (fname='QSNWCPICE_TO_COUPLER', units='mm/s', & + avgflag='A', & + long_name='excess snowfall due to snow capping sent to coupler (includes corrections for land use change)', & + ptr_lnd=this%qflx_rofice_grc) + + if (use_lch4) then + this%flux_ch4_grc(begg:endg) = 0._r8 + call hist_addfld1d (fname='FCH4', units='kgC/m2/s', & + avgflag='A', long_name='Gridcell surface CH4 flux to atmosphere (+ to atm)', & + ptr_lnd=this%flux_ch4_grc) + + this%nem_grc(begg:endg) = spval + call hist_addfld1d (fname='NEM', units='gC/m2/s', & + avgflag='A', long_name='Gridcell net adjustment to NEE passed to atm. for methane production', & + ptr_lnd=this%nem_grc) + end if + + end subroutine InitHistory + +end module lnd2atmType diff --git a/components/clm/src/main/lnd2glcMod.F90 b/components/clm/src/main/lnd2glcMod.F90 new file mode 100644 index 0000000000..74908aa188 --- /dev/null +++ b/components/clm/src/main/lnd2glcMod.F90 @@ -0,0 +1,301 @@ +module lnd2glcMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handle arrays used for exchanging data from land model to glc + ! For now glc datais send and received on the lnd grid and decomposition. + ! + ! The fields sent from the lnd component to the glc component via + ! the coupler are labeled 's2x', or sno to coupler. + ! The fields received by the lnd component from the glc component + ! via the coupler are labeled 'x2s', or coupler to sno. + ! 'Sno' is a misnomer in that the exchanged data are related to + ! the ice beneath the snow, not the snow itself. But by CESM convention, + ! 'ice' refers to sea ice, not land ice. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : get_proc_bounds, bounds_type + use domainMod , only : ldomain + use clm_varpar , only : maxpatch_glcmec + use clm_varctl , only : iulog + use clm_varcon , only : spval, tfrz, namec + use column_varcon , only : col_itype_to_icemec_class + use landunit_varcon , only : istice_mec, istsoil + use abortutils , only : endrun + use WaterFluxType , only : waterflux_type + use TemperatureType , only : temperature_type + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + save + + ! land -> glc variables structure + type, public :: lnd2glc_type + real(r8), pointer :: tsrf_grc(:,:) => null() + real(r8), pointer :: topo_grc(:,:) => null() + real(r8), pointer :: qice_grc(:,:) => null() + + contains + + procedure, public :: Init + procedure, public :: update_lnd2glc + procedure, private :: InitAllocate + procedure, private :: InitHistory + + end type lnd2glc_type + + ! !PUBLIC MEMBER FUNCTIONS: + + ! The following is public simply to support unit testing, and should not generally be + ! called from outside this module. + ! + ! Note that it is not a type-bound procedure, because it doesn't actually involve the + ! lnd2glc_type. This suggests that perhaps it belongs in some other module. + public :: bareland_normalization ! compute normalization factor for fluxes from the bare land portion of the grid cell + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(lnd2glc_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + call this%InitHistory(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize land variables required by glc + ! + ! !USES: + use clm_varcon , only : spval + use histFileMod, only : hist_addfld1d + ! + ! !ARGUMENTS: + class(lnd2glc_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begg,endg + !------------------------------------------------------------------------ + + begg = bounds%begg; endg = bounds%endg + + allocate(this%tsrf_grc(begg:endg,0:maxpatch_glcmec)) ; this%tsrf_grc(:,:)=0.0_r8 + allocate(this%topo_grc(begg:endg,0:maxpatch_glcmec)) ; this%topo_grc(:,:)=0.0_r8 + allocate(this%qice_grc(begg:endg,0:maxpatch_glcmec)) ; this%qice_grc(:,:)=0.0_r8 + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !USES: + use histFileMod, only : hist_addfld1d,hist_addfld2d + ! + ! !ARGUMENTS: + class(lnd2glc_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + real(r8), pointer :: data2dptr(:,:) + integer :: begg, endg + !--------------------------------------------------------------------- + + begg = bounds%begg; endg = bounds%endg + + if (maxpatch_glcmec > 0) then + this%qice_grc(begg:endg,0:maxpatch_glcmec) = spval + ! For this and the following fields, set up a pointer to the field simply for the + ! sake of changing the indexing, so that levels start with an index of 1, as is + ! assumed by histFileMod - so levels go 1:(nec+1) rather than 0:nec + data2dptr => this%qice_grc(:,0:maxpatch_glcmec) + call hist_addfld2d (fname='QICE_FORC', units='mm/s', type2d='elevclas', & + avgflag='A', long_name='qice forcing sent to GLC', & + ptr_lnd=data2dptr, default='inactive') + + this%tsrf_grc(begg:endg,0:maxpatch_glcmec) = spval + data2dptr => this%tsrf_grc(:,0:maxpatch_glcmec) + call hist_addfld2d (fname='TSRF_FORC', units='K', type2d='elevclas', & + avgflag='A', long_name='surface temperature sent to GLC', & + ptr_lnd=data2dptr, default='inactive') + + this%topo_grc(begg:endg,0:maxpatch_glcmec) = spval + data2dptr => this%topo_grc(:,0:maxpatch_glcmec) + call hist_addfld2d (fname='TOPO_FORC', units='m', type2d='elevclas', & + avgflag='A', long_name='topograephic height sent to GLC', & + ptr_lnd=data2dptr, default='inactive') + end if + + end subroutine InitHistory + + + !------------------------------------------------------------------------------ + subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & + temperature_inst, waterflux_inst, init) + ! + ! !DESCRIPTION: + ! Assign values to lnd2glc+ + ! + ! !ARGUMENTS: + class(lnd2glc_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_do_smb_c ! number of columns in filter_do_smb_c + integer , intent(in) :: filter_do_smb_c(:) ! column filter: columns where smb calculations are performed + type(temperature_type) , intent(in) :: temperature_inst + type(waterflux_type) , intent(in) :: waterflux_inst + logical , intent(in) :: init ! if true=>only set a subset of fields + ! + ! !LOCAL VARIABLES: + integer :: c, l, g, n, fc ! indices + logical, allocatable :: fields_assigned(:,:) ! tracks whether fields have already been assigned for each index [begg:endg, 0:maxpatch_glcmec] + real(r8) :: flux_normalization ! factor by which fluxes should be normalized + + character(len=*), parameter :: subname = 'update_lnd2glc' + !------------------------------------------------------------------------------ + + ! Initialize to reasonable defaults + + this%qice_grc(bounds%begg : bounds%endg, :) = 0._r8 + this%tsrf_grc(bounds%begg : bounds%endg, :) = tfrz + this%topo_grc(bounds%begg : bounds%endg, :) = 0._r8 + + ! Fill the lnd->glc data on the clm grid + + allocate(fields_assigned(bounds%begg:bounds%endg, 0:maxpatch_glcmec)) + fields_assigned(:,:) = .false. + + do fc = 1, num_do_smb_c + c = filter_do_smb_c(fc) + l = col%landunit(c) + g = col%gridcell(c) + + ! Set vertical index and a flux normalization, based on whether the column in question is glacier or vegetated. + if (lun%itype(l) == istice_mec) then + n = col_itype_to_icemec_class(col%itype(c)) + flux_normalization = 1.0_r8 + else if (lun%itype(l) == istsoil) then + n = 0 !0-level index (bareland information) + flux_normalization = bareland_normalization(c) + else + ! Other landunit types do not pass information in the lnd2glc fields. + ! Note: for this to be acceptable, we need virtual vegetated columns in any grid + ! cell that is made up solely of glacier plus some other special landunit (e.g., + ! glacier + lake) -- otherwise CISM wouldn't have any information for the non- + ! glaciated portion of the grid cell. + cycle + end if + + ! Make sure we haven't already assigned the coupling fields for this point + ! (this could happen, for example, if there were multiple columns in the + ! istsoil landunit, which we aren't prepared to handle) + if (fields_assigned(g,n)) then + write(iulog,*) subname//' ERROR: attempt to assign coupling fields twice for the same index.' + write(iulog,*) 'One possible cause is having multiple columns in the istsoil landunit,' + write(iulog,*) 'which this routine cannot handle.' + write(iulog,*) 'g, n = ', g, n + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + + ! Send surface temperature, topography, and SMB flux (qice) to coupler. + ! t_soisno and glc_topo are valid even in initialization, so tsrf and topo + ! are set here regardless of the value of init. But qflx_glcice is not valid + ! until the run loop; thus, in initialization, we will use the default value + ! for qice, as set above. + fields_assigned(g,n) = .true. + this%tsrf_grc(g,n) = temperature_inst%t_soisno_col(c,1) + this%topo_grc(g,n) = col%glc_topo(c) + if (.not. init) then + this%qice_grc(g,n) = waterflux_inst%qflx_glcice_col(c) * flux_normalization + + ! Check for bad values of qice + if ( abs(this%qice_grc(g,n)) > 1.0_r8) then + write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, this%qice_grc(g,n) + end if + end if + + end do + + deallocate(fields_assigned) + + end subroutine update_lnd2glc + + !----------------------------------------------------------------------- + real(r8) function bareland_normalization(c) + ! + ! !DESCRIPTION: + ! Compute normalization factor for fluxes from the bare land portion of the grid + ! cell. Fluxes should be multiplied by this factor before being sent to CISM. + ! + ! The point of this is: CISM effectively has two land cover types: glaciated and + ! bare. CLM, on the other hand, subdivides the bare land portion of the grid cell into + ! multiple landunits. However, we currently don't do any sort of averaging of + ! quantities computed in the different "bare land" landunits - instead, we simply send + ! the values computed in the natural vegetated landunit - these fluxes (like SMB) are + ! 0 in the other landunits. To achieve conservation, we need to normalize these + ! natural veg. fluxes by the fraction of the "bare land" area accounted for by the + ! natural veg. landunit. + ! + ! For example, consider a grid cell that is: + ! 60% glacier_mec + ! 30% natural veg + ! 10% lake + ! + ! According to CISM, this grid cell is 60% icesheet, 40% "bare land". Now suppose CLM + ! has an SMB flux of 1m in the natural veg landunit. If we simply sent 1m of ice to + ! CISM, conservation would be broken, since it would also apply 1m of ice to the 10% + ! of the grid cell that CLM says is lake. So, instead, we must multiply the 1m of ice + ! by (0.3/0.4), thus "spreading out" the SMB from the natural veg. landunit, so that + ! 0.75m of ice is grown throughout the bare land portion of CISM. + ! + ! Note: If the non-glaciated area of the grid cell is 0, then we arbitrarily return a + ! normalization factor of 1.0, in order to avoid divide-by-zero errors. + ! + ! Note: We currently aren't careful about how we would handle things if there are + ! multiple columns within the vegetated landunit. If that possibility were introduced, + ! this code - as well as the code in update_clm_s2x - may need to be reworked somewhat. + ! + ! !USES: + use subgridWeightsMod , only : get_landunit_weight + ! + ! !ARGUMENTS: + integer, intent(in) :: c ! column index + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + real(r8) :: area_glacier ! fractional area of the glacier_mec landunit in this grid cell + real(r8) :: area_this_col ! fractional area of column c in the grid cell + + real(r8), parameter :: tol = 1.e-13_r8 ! tolerance for checking subgrid weight equality + character(len=*), parameter :: subname = 'bareland_normalization' + !----------------------------------------------------------------------- + + g = col%gridcell(c) + + area_glacier = get_landunit_weight(g, istice_mec) + + if (abs(area_glacier - 1.0_r8) < tol) then + ! If the whole grid cell is glacier, then the normalization factor is arbitrary; + ! set it to 1 so we don't do any normalization in this case + bareland_normalization = 1.0_r8 + else + area_this_col = col%wtgcell(c) + bareland_normalization = area_this_col / (1.0_r8 - area_glacier) + end if + + end function bareland_normalization + +end module lnd2glcMod + diff --git a/components/clm/src/main/ncdio_pio.F90.in b/components/clm/src/main/ncdio_pio.F90.in new file mode 100644 index 0000000000..707efac36e --- /dev/null +++ b/components/clm/src/main/ncdio_pio.F90.in @@ -0,0 +1,2284 @@ +module ncdio_pio + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: ncdio_pioMod + ! + ! !DESCRIPTION: + ! Generic interfaces to write fields to netcdf files for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl + use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getunit, shr_file_freeunit + use shr_string_mod , only : shr_string_toUpper + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, mpicom, iam, npes + use spmdMod , only : MPI_REAL8, MPI_INTEGER, MPI_LOGICAL + use clm_varcon , only : spval,ispval, grlnd, nameg, namel, namec, namep + use clm_varctl , only : single_column, iulog + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : get_clmlevel_gsize,get_clmlevel_gsmap + use perf_mod , only : t_startf, t_stopf + use fileutils , only : getavu, relavu + use mct_mod , only : mct_gsMap, mct_gsMap_lsize, mct_gsMap_gsize, mct_gsMap_OP + use pio , only : file_desc_t, io_desc_t, iosystem_desc_t, pio_64bit_offset + use pio , only : pio_bcast_error, pio_char, pio_clobber, pio_closefile, pio_createfile, pio_def_dim + use pio , only : pio_def_var, pio_double, pio_enddef, pio_get_att, pio_get_var, pio_global, pio_initdecomp + use pio , only : pio_inq_att, pio_inq_dimid, pio_inq_dimlen, pio_inq_dimname, pio_inq_vardimid, pio_inq_varid + use pio , only : pio_inq_varname, pio_inq_varndims, pio_inquire, pio_int, pio_internal_error + use pio , only : pio_noclobber, pio_noerr, pio_nofill, pio_nowrite, pio_offset_kind, pio_openfile + use pio , only : pio_put_att, pio_put_var, pio_read_darray, pio_real, pio_seterrorhandling + use pio , only : pio_setframe, pio_unlimited, pio_write, pio_write_darray, var_desc_t + use pio , only : pio_iotask_rank, PIO_REARR_SUBSET, PIO_REARR_BOX + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public :: check_var ! determine if variable is on netcdf file + public :: check_att ! check if attribute is on file + public :: check_dim ! validity check on dimension + public :: ncd_pio_openfile ! open a file + public :: ncd_pio_createfile ! create a new file + public :: ncd_pio_closefile ! close a file + public :: ncd_pio_init ! called from clm_comp + public :: ncd_enddef ! end define mode + public :: ncd_putatt ! put attribute + public :: ncd_getatt ! get attribute + public :: ncd_defdim ! define dimension + public :: ncd_inqdid ! inquire dimension id + public :: ncd_inqdname ! inquire dimension name + public :: ncd_inqdlen ! inquire dimension length + public :: ncd_inqfdims ! inquire file dimnesions + public :: ncd_defvar ! define variables + public :: ncd_inqvid ! inquire variable id + public :: ncd_inqvname ! inquire variable name + public :: ncd_inqvdims ! inquire variable ndims + public :: ncd_inqvdids ! inquire variable dimids + public :: ncd_inqvdlen ! inquire variable dimension size + public :: ncd_io ! write local data + + integer,parameter,public :: ncd_int = pio_int + integer,parameter,public :: ncd_log =-pio_int + integer,parameter,public :: ncd_float = pio_real + integer,parameter,public :: ncd_double = pio_double + integer,parameter,public :: ncd_char = pio_char + integer,parameter,public :: ncd_global = pio_global + integer,parameter,public :: ncd_write = pio_write + integer,parameter,public :: ncd_nowrite = pio_nowrite + integer,parameter,public :: ncd_clobber = pio_clobber + integer,parameter,public :: ncd_noclobber = pio_noclobber + integer,parameter,public :: ncd_nofill = pio_nofill + integer,parameter,public :: ncd_unlimited = pio_unlimited + + ! PIO types needed for ncdio_pio interface calls + public file_desc_t + public var_desc_t + + ! + ! !PRIVATE MEMBER FUNCTIONS: + ! + interface ncd_defvar + module procedure ncd_defvar_bynf + module procedure ncd_defvar_bygrid + end interface + + interface ncd_putatt + module procedure ncd_putatt_int + module procedure ncd_putatt_real + module procedure ncd_putatt_char + end interface + + interface ncd_getatt + module procedure ncd_getatt_char + end interface ncd_getatt + + interface ncd_io + module procedure ncd_io_char_var0_start_glob + + !DIMS 0,1 + module procedure ncd_io_{DIMS}d_log_glob + + !DIMS 0,1,2,3 + !TYPE int,double + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + !DIMS 0,1,2 + !TYPE text + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_{DIMS}d_{TYPE} + + !TYPE logical + !DIMS 1 + module procedure ncd_io_{DIMS}d_{TYPE} + end interface + + interface ncd_inqvdlen + module procedure ncd_inqvdlen_byDesc + module procedure ncd_inqvdlen_byName + end interface + + private :: ncd_getiodesc ! obtain iodesc + private :: scam_field_offsets ! get offset to proper lat/lon gridcell for SCAM + + integer,parameter,private :: debug = 0 ! local debug level + + integer , parameter , public :: max_string_len = 256 ! length of strings + real(r8), parameter , public :: fillvalue = 1.e36_r8 ! fill value for netcdf fields + + integer, public :: io_type + + type(iosystem_desc_t), pointer, public :: pio_subsystem + + type iodesc_plus_type + character(len=64) :: name + type(IO_desc_t) :: iodesc + integer :: type + integer :: ndims + integer :: dims(4) + integer :: dimids(4) + end type iodesc_plus_type + integer,parameter ,private :: max_iodesc = 100 + integer ,private :: num_iodesc = 0 + type(iodesc_plus_type) ,private, target :: iodesc_list(max_iodesc) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine ncd_pio_init() + ! + ! !DESCRIPTION: + ! Initial PIO + ! + ! !USES: + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype + use clm_varctl , only : inst_name + !----------------------------------------------------------------------- + + PIO_subsystem => shr_pio_getiosys(inst_name) + io_type = shr_pio_getiotype(inst_name) + + end subroutine ncd_pio_init + + !----------------------------------------------------------------------- + subroutine ncd_pio_openfile(file, fname, mode) + ! + ! !DESCRIPTION: + ! Open a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: file ! Output PIO file handle + character(len=*) , intent(in) :: fname ! Input filename to open + integer , intent(in) :: mode ! file mode + ! + ! !LOCAL VARIABLES: + integer :: ierr + !----------------------------------------------------------------------- + + ierr = pio_openfile(pio_subsystem, file, io_type, fname, mode) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort('ncd_pio_openfile ERROR: Failed to open file') + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened existing file ', trim(fname), file%fh + end if + + end subroutine ncd_pio_openfile + + !----------------------------------------------------------------------- + subroutine ncd_pio_closefile(file) + ! + ! !DESCRIPTION: + ! Close a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file handle to close + !----------------------------------------------------------------------- + + call pio_closefile(file) + + end subroutine ncd_pio_closefile + + !----------------------------------------------------------------------- + subroutine ncd_pio_createfile(file, fname, avoid_pnetcdf) + ! + ! !DESCRIPTION: + ! Create a new NetCDF file with PIO + ! + ! !USES: + use pio, only : pio_iotype_pnetcdf, pio_iotype_netcdf,pio_iotask_rank + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file descriptor + character(len=*) , intent(in) :: fname ! File name to create + + ! BUG(wjs, 2014-10-20, bugz 1730) Workaround for + ! http://bugs.cgd.ucar.edu/show_bug.cgi?id=1730 + logical, intent(in), optional :: avoid_pnetcdf + ! + ! !LOCAL VARIABLES: + logical :: l_avoid_pnetcdf ! local version of avoid_pnetcdf + integer :: my_io_type + integer :: ierr + !----------------------------------------------------------------------- + + l_avoid_pnetcdf = .false. + if (present(avoid_pnetcdf)) then + l_avoid_pnetcdf = avoid_pnetcdf + end if + + my_io_type = io_type + if (l_avoid_pnetcdf) then + if (my_io_type == pio_iotype_pnetcdf) then + my_io_type = pio_iotype_netcdf + if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Workaround for bugz 1730: creating' + write(iulog,*) trim(fname) + write(iulog,*) 'with type netcdf instead of pnetcdf' + end if + end if + end if + + ierr = pio_createfile(pio_subsystem, file, my_io_type, fname, ior(PIO_CLOBBER,PIO_64BIT_OFFSET)) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort( ' ncd_pio_createfile ERROR: Failed to open file to write: '//trim(fname)) + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened file ', trim(fname), ' to write', file%fh + end if + + end subroutine ncd_pio_createfile + + !----------------------------------------------------------------------- + subroutine check_var(ncid, varname, vardesc, readvar, print_err ) + ! + ! !DESCRIPTION: + ! Check if variable is on netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=*) , intent(in) :: varname ! Varible name to check + type(Var_desc_t) , intent(out) :: vardesc ! Output variable descriptor + logical , intent(out) :: readvar ! If variable exists or not + logical, optional , intent(in) :: print_err ! If should print about error + ! + ! !LOCAL VARIABLES: + integer :: ret ! return value + logical :: log_err ! if should log error + character(len=*),parameter :: subname='check_var' ! subroutine name + !----------------------------------------------------------------------- + + + if ( present(print_err) )then + log_err = print_err + else + log_err = .true. + end if + readvar = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid (ncid, varname, vardesc) + if (ret /= PIO_noerr) then + readvar = .false. + if (masterproc .and. log_err) & + write(iulog,*) subname//': variable ',trim(varname),' is not on dataset' + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + end subroutine check_var + + !----------------------------------------------------------------------- + subroutine check_att(ncid, varid, attrib, att_found) + ! + ! !DESCRIPTION: + ! Check if attribute is on file + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + logical ,intent(out) :: att_found ! true if the attribute was found + ! + ! !LOCAL VARIABLES: + integer :: att_type ! attribute type + integer(pio_offset_kind) :: att_len ! attribute length + integer :: status + + character(len=*), parameter :: subname = 'check_att' + !----------------------------------------------------------------------- + + att_found = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + status = PIO_inq_att(ncid, varid, trim(attrib), att_type, att_len) + if (status /= PIO_noerr) then + att_found = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + end subroutine check_att + + !----------------------------------------------------------------------- + subroutine check_dim(ncid, dimname, value) + ! + ! !DESCRIPTION: + ! Validity check on dimension + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! PIO file handle + character(len=*) , intent(in) :: dimname ! Dimension name + integer, intent(in) :: value ! Expected dimension size + ! + ! !LOCAL VARIABLES: + integer :: dimid, dimlen ! temporaries + integer :: status ! error code + character(len=*),parameter :: subname='check_dim' ! subroutine name + !----------------------------------------------------------------------- + + status = pio_inq_dimid (ncid, trim(dimname), dimid) + status = pio_inq_dimlen (ncid, dimid, dimlen) + if (dimlen /= value) then + write(iulog,*) subname//' ERROR: mismatch of input dimension ',dimlen, & + ' with expected value ',value,' for variable ',trim(dimname) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + + end subroutine check_dim + + !----------------------------------------------------------------------- + subroutine ncd_enddef(ncid) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + ! + ! !LOCAL VARIABLES: + integer :: status ! error status + !----------------------------------------------------------------------- + + status = PIO_enddef(ncid) + + end subroutine ncd_enddef + + !----------------------------------------------------------------------- + subroutine ncd_inqdid(ncid,name,dimid,dimexist) + ! + ! !DESCRIPTION: + ! inquire on a dimension id + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! dimension name + integer , intent(out):: dimid ! dimension id + logical,optional , intent(out):: dimexist ! if this dimension exists or not + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(dimexist) )then + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + end if + status = PIO_inq_dimid(ncid,name,dimid) + if ( present(dimexist) )then + if ( status == PIO_NOERR)then + dimexist = .true. + else + dimexist = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + end if + + end subroutine ncd_inqdid + + !----------------------------------------------------------------------- + subroutine ncd_inqdlen(ncid,dimid,len,name) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(inout) :: dimid ! dimension id + integer , intent(out) :: len ! dimension len + character(len=*), optional, intent(in) :: name ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(name) )then + call ncd_inqdid(ncid,name,dimid) + end if + len = -1 + status = PIO_inq_dimlen(ncid,dimid,len) + + end subroutine ncd_inqdlen + + !----------------------------------------------------------------------- + subroutine ncd_inqdname(ncid,dimid,dname) + ! + ! !DESCRIPTION: + ! inquire dim name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: dimid ! dimension id + character(len=*) , intent(out):: dname ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_inq_dimname(ncid,dimid,dname) + + end subroutine ncd_inqdname + + !----------------------------------------------------------------------- + subroutine ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout):: ncid + logical , intent(out) :: isgrid2d + integer , intent(out) :: ni + integer , intent(out) :: nj + integer , intent(out) :: ns + ! + ! !LOCAL VARIABLES: + integer :: dimid ! netCDF id + integer :: ier ! error status + character(len=32) :: subname = 'ncd_inqfdims' ! subroutine name + !----------------------------------------------------------------------- + + if (single_column) then + ni = 1 + nj = 1 + ns = 1 + isgrid2d = .true. + RETURN + end if + + ni = 0 + nj = 0 + + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ier = pio_inq_dimid (ncid, 'lon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'lsmlon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lsmlat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'ni', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'nj', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'gridcell', dimid) + if (ier == PIO_NOERR) then + ier = pio_inq_dimlen(ncid, dimid, ni) + if (ier == PIO_NOERR) nj = 1 + end if + + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + if (ni == 0 .or. nj == 0) then + write(iulog,*) trim(subname),' ERROR: ni,nj = ',ni,nj,' cannot be zero ' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + + if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + + ns = ni*nj + + end subroutine ncd_inqfdims + + !----------------------------------------------------------------------- + subroutine ncd_inqvid(ncid,name,varid,vardesc,readvar) + ! + ! !DESCRIPTION: + ! Inquire on a variable ID + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! variable name + integer , intent(out) :: varid ! variable id + type(Var_desc_t) , intent(out) :: vardesc ! variable descriptor + logical, optional , intent(out) :: readvar ! does variable exist + ! + ! !LOCAL VARIABLES: + integer :: ret ! return code + character(len=*),parameter :: subname='ncd_inqvid' ! subroutine name + !----------------------------------------------------------------------- + + if (present(readvar)) then + readvar = .false. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid(ncid,name,vardesc) + if (ret /= PIO_noerr) then + if (masterproc) write(iulog,*) subname//': variable ',trim(name),' is not on dataset' + readvar = .false. + else + readvar = .true. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + else + ret = PIO_inq_varid(ncid,name,vardesc) + endif + varid = vardesc%varid + + end subroutine ncd_inqvid + + !----------------------------------------------------------------------- + subroutine ncd_inqvdims(ncid,ndims,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimensions + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(out) :: ndims ! variable ndims + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + ndims = -1 + status = PIO_inq_varndims(ncid,vardesc,ndims) + + end subroutine ncd_inqvdims + + !----------------------------------------------------------------------- + subroutine ncd_inqvname(ncid,varid,vname,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: varid ! variable id + character(len=*) , intent(out) :: vname ! variable vname + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + vname = '' + status = PIO_inq_varname(ncid,vardesc,vname) + + end subroutine ncd_inqvname + + !----------------------------------------------------------------------- + subroutine ncd_inqvdids(ncid,dids,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimension ids + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! netcdf file id + integer ,intent(out) :: dids(:) ! variable dids + type(Var_desc_t) ,intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + dids = -1 + status = PIO_inq_vardimid(ncid,vardesc,dids) + + end subroutine ncd_inqvdids + + !----------------------------------------------------------------------- + subroutine ncd_inqvdlen_byDesc(ncid,vardesc,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a vardesc + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + type(Var_desc_t) ,intent(inout) :: vardesc ! variable descriptor + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + integer :: ndims ! number of dimensions + integer, allocatable :: dimids(:) ! dimension IDs + + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_none = 0 + integer, parameter :: error_dimnum_out_of_range = 1 + !----------------------------------------------------------------------- + + err_code = error_none + + call ncd_inqvdims(ncid, ndims, vardesc) + + if (dimnum > 0 .and. dimnum <= ndims) then + allocate(dimids(ndims)) + call ncd_inqvdids(ncid, dimids, vardesc) + call ncd_inqdlen(ncid, dimids(dimnum), dlen) + deallocate(dimids) + else + dlen = dlen_invalid + err_code = error_dimnum_out_of_range + end if + + end subroutine ncd_inqvdlen_byDesc + + + !----------------------------------------------------------------------- + subroutine ncd_inqvdlen_byName(ncid,varname,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a variable name + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! 11: variable not found + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) ,intent(in) :: varname ! variable name + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + type(Var_desc_t) :: vardesc ! variable descriptor + logical :: readvar ! whether the variable was found + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_variable_not_found = 11 + !----------------------------------------------------------------------- + + call check_var(ncid, varname, vardesc, readvar) + if (readvar) then + call ncd_inqvdlen_byDesc(ncid, vardesc, dimnum, dlen, err_code) + else + dlen = dlen_invalid + err_code = error_variable_not_found + end if + + end subroutine ncd_inqvdlen_byName + + + !----------------------------------------------------------------------- + subroutine ncd_putatt_int(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put integer attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + integer ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_putatt_int + + !----------------------------------------------------------------------- + subroutine ncd_putatt_char(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put character attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_putatt_char + + !----------------------------------------------------------------------- + subroutine ncd_putatt_real(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put real attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + real(r8) ,intent(in) :: value ! netcdf attrib value + integer ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + real*4 :: value4 + !----------------------------------------------------------------------- + + value4 = value + + if (xtype == pio_double) then + status = PIO_put_att(ncid,varid,trim(attrib),value) + else + status = PIO_put_att(ncid,varid,trim(attrib),value4) + endif + + end subroutine ncd_putatt_real + + !----------------------------------------------------------------------- + subroutine ncd_getatt_char(ncid,varid,attrib,value) + ! + ! !DESCRIPTION: + ! get a character attribute + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(out) :: value ! netcdf attrib value + ! + ! !LOCAL VARIABLES: + integer :: status + + character(len=*), parameter :: subname = 'ncd_getatt_char' + !----------------------------------------------------------------------- + + status = PIO_get_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_getatt_char + + + !----------------------------------------------------------------------- + subroutine ncd_defdim(ncid,attrib,value,dimid) + ! + ! !DESCRIPTION: + ! define dimension + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + character(len=*) , intent(in) :: attrib ! netcdf attrib + integer , intent(in) :: value ! netcdf attrib value + integer , intent(out):: dimid ! netcdf dimension id + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = pio_def_dim(ncid,attrib,value,dimid) + + end subroutine ncd_defdim + + !----------------------------------------------------------------------- + subroutine ncd_defvar_bynf(ncid, varname, xtype, ndims, dimid, varid, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, comment, flag_meanings, & + flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + integer , intent(in) :: ndims ! number of dims + integer , intent(inout) :: varid ! returned var id + integer , intent(in), optional :: dimid(:) ! dimids + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ldimid(4) ! local dimid + integer :: dimid0(1) ! local dimid + integer :: status ! error status + integer :: lxtype ! local external type (in case logical variable) + type(var_desc_t) :: vardesc ! local vardesc + character(len=128) :: dimname ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bynf' ! subroutine name + !----------------------------------------------------------------------- + + varid = -1 + + dimid0 = 0 + ldimid = 0 + if (present(dimid)) then + ldimid(1:ndims) = dimid(1:ndims) + else ! ndims must be zero if dimid not present + if (ndims /= 0) then + write(iulog,*) subname//' ERROR: dimid not supplied and ndims ne 0 ',trim(varname),ndims + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + endif + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + if (masterproc .and. debug > 1) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + write(iulog,*) subname//' ',trim(varname),lxtype,ndims,ldimid(1:ndims) + endif + + if (ndims > 0) then + status = pio_inq_dimname(ncid,ldimid(ndims),dimname) + end if + + ! Define variable + if (present(dimid)) then + status = PIO_def_var(ncid,trim(varname),lxtype,dimid(1:ndims),vardesc) + else + status = PIO_def_var(ncid,trim(varname),lxtype,dimid0 ,vardesc) + endif + varid = vardesc%varid + + ! + ! Add attributes + ! + if (present(long_name)) then + call ncd_putatt(ncid, varid, 'long_name', trim(long_name)) + end if + if (present(flag_values)) then + status = PIO_put_att(ncid,varid,'flag_values',flag_values) + if ( .not. present(flag_meanings)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_values set -- but not flag_meanings"//errMsg(__FILE__, __LINE__)) + end if + end if + if (present(flag_meanings)) then + if ( .not. present(flag_values)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings set -- but not flag_values"//errMsg(__FILE__, __LINE__) ) + end if + if ( size(flag_values) /= size(flag_meanings) ) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings and flag_values dimension different"//errMsg(__FILE__, __LINE__)) + end if + str = flag_meanings(1) + do n = 1, size(flag_meanings) + if ( index(flag_meanings(n), ' ') /= 0 )then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings has an invalid space in it"//errMsg(__FILE__, __LINE__) ) + end if + if ( n > 1 ) str = trim(str)//" "//flag_meanings(n) + end do + status = PIO_put_att(ncid,varid,'flag_meanings', trim(str) ) + end if + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(cell_method)) then + str = 'time: ' // trim(cell_method) + call ncd_putatt(ncid, varid, 'cell_methods', trim(str)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + end subroutine ncd_defvar_bynf + + !----------------------------------------------------------------------- + subroutine ncd_defvar_bygrid(ncid, varname, xtype, & + dim1name, dim2name, dim3name, dim4name, dim5name, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, switchdim, comment, & + flag_meanings, flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: dim3name ! dimension name + character(len=*) , intent(in), optional :: dim4name ! dimension name + character(len=*) , intent(in), optional :: dim5name ! dimension name + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + logical , intent(in), optional :: switchdim ! true=> permute dim1 and dim2 for output + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ndims ! dimension counter + integer :: dimid(5) ! dimension ids + integer :: varid ! variable id + integer :: itmp ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name + !----------------------------------------------------------------------- + + dimid(:) = 0 + + ! Determine dimension ids for variable + + if (present(dim1name)) call ncd_inqdid(ncid, dim1name, dimid(1)) + if (present(dim2name)) call ncd_inqdid(ncid, dim2name, dimid(2)) + if (present(dim3name)) call ncd_inqdid(ncid, dim3name, dimid(3)) + if (present(dim4name)) call ncd_inqdid(ncid, dim4name, dimid(4)) + if (present(dim5name)) call ncd_inqdid(ncid, dim5name, dimid(5)) + + ! Permute dim1 and dim2 if necessary + + if (present(switchdim)) then + itmp = dimid(2) + dimid(2) = dimid(1) + dimid(1) = itmp + end if + + ! Define variable + + ndims = 0 + if (present(dim1name)) then + do n = 1, size(dimid) + if (dimid(n) /= 0) ndims = ndims + 1 + end do + end if + + call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & + long_name=long_name, units=units, cell_method=cell_method, & + missing_value=missing_value, fill_value=fill_value, & + imissing_value=imissing_value, ifill_value=ifill_value, & + comment=comment, flag_meanings=flag_meanings, & + flag_values=flag_values, nvalid_range=nvalid_range ) + + end subroutine ncd_defvar_bygrid + + !------------------------------------------------------------------------ + subroutine ncd_io_char_var0_start_glob(vardesc, data, flag, ncid, start ) + ! + ! !DESCRIPTION: + ! netcdf I/O of global character array with start indices input + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + type(var_desc_t) , intent(in) :: vardesc ! local vardesc pointer + character(len=*) , intent(inout) :: data ! raw data for this index + integer , intent(in) :: start(:) ! output bounds + ! + ! !LOCAL VARIABLES: + integer :: status ! error code + character(len=*),parameter :: subname='ncd_io_char_var0_start_glob' + !----------------------------------------------------------------------- + + if (flag == 'read') then + + status = pio_get_var(ncid, vardesc, start, data ) + + elseif (flag == 'write') then + + status = pio_put_var(ncid, vardesc, start, data ) + + endif + + end subroutine ncd_io_char_var0_start_glob + + !------------------------------------------------------------------------ + !DIMS 0,1 + subroutine ncd_io_{DIMS}d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global integer variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + logical , intent(inout) :: data{DIMSTR} ! raw data + logical, optional , intent(out) :: readvar ! was var read? + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: start(2), count(2) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer :: idata + integer, pointer :: idata1d(:) ! Temporary integer data to send to file + character(len=32) :: vname ! variable error checking + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_{DIMS}d_log_glob' + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif +#if ({DIMS}==0) + status = pio_get_var(ncid, varid, idata) + if ( idata == 0 )then + data = .false. + else if ( idata == 1 )then + data = .true. + else + call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(__FILE__, __LINE__)) + end if +#else + allocate(idata1d(size(data))) + data = (idata1d == 1) + if ( any(idata1d /= 0 .and. idata1d /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate(idata1d) +#endif + endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + +#if ({DIMS}==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt + call ncd_inqvid (ncid, varname, varid, vardesc) + allocate(idata1d(1)) + if ( data )then + idata1d(1) = 1 + else + idata1d(1) = 0 + end if + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate(idata1d) +#else + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + allocate(idata1d(size(data))) + where( data ) + idata1d = 1 + elsewhere + idata1d = 0 + end where + call ncd_inqvid (ncid, varname, varid, vardesc) + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate( idata1d ) +#endif + + endif ! flag + + end subroutine ncd_io_{DIMS}d_log_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2,3 + !TYPE int,double + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start({DIMS}+1), count({DIMS}+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + {VTYPE} :: temp(1) + character(len=*),parameter :: subname='ncd_io_{DIMS}d_{TYPE}_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if ({DIMS}==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = {DIMS} + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if ({DIMS}==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif ({DIMS}==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif ({DIMS}==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif ({DIMS}==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2 + !TYPE text + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(4), count(4) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_{DIMS}d_{TYPE}_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + + if (varpresent) then + data = ' ' + status = pio_get_var(ncid, varid, data) + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = {DIMS} + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) + +#if ({DIMS}==0) + if (present(nt)) then + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do + start(1) = 1 ; count(1) = len(data) + start(2) = nt; count(2) = 1 + if ( count(1) > size(tmpString) )then + write(iulog,*) subname//' ERROR: input string size is too large:' + end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) + else + status = pio_put_var(ncid, varid, data ) + end if +#elif ({DIMS}==1) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) + start(3) = nt; count(3) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#elif ({DIMS}==2) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !----------------------------------------------------------------------- + + !TYPE int,double,logical + subroutine ncd_io_1d_{TYPE}(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! Local Variables + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: n ! index + integer :: iodnum ! iodesc num in list + integer :: varid ! varid + integer :: ndims ! ndims for var + integer :: ndims_iod ! ndims iodesc for var + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: start(3) ! netcdf start index + integer :: count(3) ! netcdf count index + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer , pointer :: idata(:) ! Temporary integer data to send to file + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_1d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if ({ITYPE}==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid,clmlevel,vardesc,start,count) + if (trim(clmlevel) == grlnd) then + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + else + n=1 + if (present(nt)) then + n=2 + start(2) = nt ; count(2) = 1 + end if + end if +#if ({ITYPE}==TYPELOGICAL) + allocate(idata(size(data))) + status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) +#endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if ({ITYPE}==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if ({ITYPE}==TYPELOGICAL) + allocate(idata(size(data))) + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) +#endif + end if + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if ({ITYPE}==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if ({ITYPE}==TYPELOGICAL) + allocate( idata(size(data)) ) + where( data ) + idata = 1 + elsewhere + idata = 0 + end where + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) + deallocate( idata ) +#elif ({ITYPE}==TYPEINT) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) +#elif ({ITYPE}==TYPEDOUBLE) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) +#endif + else + + if (masterproc) then + write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + end subroutine ncd_io_1d_{TYPE} + + !----------------------------------------------------------------------- + + !TYPE int,double + subroutine ncd_io_2d_{TYPE}(varname, data, dim1name, lowerb2, upperb2, & + flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 2d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output + logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! !LOCAL VARIABLES: +#if ({ITYPE}==TYPEINT) + integer , pointer :: temp(:,:) +#else + real(r8), pointer :: temp(:,:) +#endif + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n,i,j ! indices + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(4) ! netcdf start index + integer :: count(4) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + integer :: lb1,lb2 + integer :: ub1,ub2 + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_2d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + start(:)=0 + count(:)=0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if ({ITYPE}==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + lb1 = lbound(data, dim=1) + ub1 = ubound(data, dim=1) + lb2 = lbound(data, dim=2) + ub2 = ubound(data, dim=2) + + if (present(switchdim)) then + if (present(lowerb2)) lb2 = lowerb2 + if (present(upperb2)) ub2 = upperb2 + allocate(temp(lb2:ub2,lb1:ub1)) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2) + n=3 + if (present(nt)) then + start(4) = nt; count(4) = 1 + n=4 + end if + else + count(2) = size(data,dim=2) + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + end if + if (present(switchdim)) then + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if +#if ({ITYPE}!=TYPEINT) + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( data(i,j) == spval )then + data(i,j) = nan + end if + end do + end do + end if +#endif + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + do j = lb2,ub2 + do i = lb1,ub1 + temp(j,i) = data(i,j) + end do + end do + end if +#if ({ITYPE}==TYPEINT) + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=0) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) + end if +#else + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) + end if + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( isnan(data(i,j)) )then + data(i,j) = spval + end if + end do + end do + end if +#endif + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + if (present(switchdim)) then + deallocate(temp) + end if + + end subroutine ncd_io_2d_{TYPE} + + !----------------------------------------------------------------------- + + !TYPE int,double + subroutine ncd_io_3d_{TYPE}(varname, data, dim1name, flag, ncid, nt, readvar) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 3d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:,:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + ! + ! !LOCAL VARIABLES: + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n ! index + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(5) ! netcdf start index + integer :: count(5) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_3d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 + count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2); + count(4) = size(data,dim=3) + n=4 + if (present(nt)) then + start(5) = nt + count(5) = 1 + n=5 + end if + else + count(2) = size(data,dim=2) + count(3) = size(data,dim=3) + n=3 + if (present(nt)) then + start(4) = nt + count(4) = 1 + n=4 + end if + end if + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + end subroutine ncd_io_3d_{TYPE} + + !------------------------------------------------------------------------ + + subroutine scam_field_offsets( ncid, dim1name, vardesc, start, count, & + found, posNOTonfile) + ! + ! !DESCRIPTION: + ! Read/Write initial data from/to netCDF instantaneous initial data file + ! + ! !USES: + use clm_varctl, only: scmlon,scmlat,single_column + use shr_scam_mod, only: shr_scam_getCloseLatLon + use shr_string_mod, only: shr_string_toLower + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: dim1name ! dimension 1 name + type(Var_desc_t) , intent(inout) :: vardesc ! variable descriptor + integer , intent(out) :: start(:) ! start index + integer , intent(out) :: count(:) ! count to retrieve + logical, optional , intent(out) :: found ! if present return true if found + ! dimensions on file else false if NOT present abort if can't find + logical, optional , intent(in) :: posNOTonfile ! Position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: cc,i,ii ! index variable + integer :: data_offset ! offset into land array 1st column + integer :: ndata ! number of column (or pft points to read) + real(r8) , pointer :: cols1dlon(:) ! holds cols1d_ixy var + real(r8) , pointer :: cols1dlat(:) ! holds cols1d_jxy var + real(r8) , pointer :: pfts1dlon(:) ! holds pfts1d_ixy var + real(r8) , pointer :: pfts1dlat(:) ! holds pfts1d_jxy var + real(r8) , pointer :: land1dlon(:) ! holds land1d_ixy var + real(r8) , pointer :: land1dlat(:) ! holds land1d_jxy var + integer, allocatable :: cols(:) ! grid cell columns for scam + integer, allocatable :: pfts(:) ! grid cell pfts for scam + integer, allocatable :: landunits(:) ! grid cell landunits for scam + integer, allocatable :: dids(:) ! dim ids + integer :: varid ! netCDF variable id + integer :: status ! return code + integer :: latidx,lonidx ! latitude/longitude indices + real(r8) :: closelat,closelon ! closest latitude and longitude indices + integer :: ndims,dimlen ! number of dimensions in desired variable + character(len=32) :: dimname ! dimension name + character(len=32) :: subname = 'scam_field_offsets' + !------------------------------------------------------------------------ + + start(:)=1 + count(:)=1 + + if ( present(posNOTonfile) )then + if ( posNOTonfile )then + if ( .not. present(found) )then + call shr_sys_abort('ERROR: Bad subroutine calling structure posNOTonfile sent, but found was NOT!'//& + errMsg(__FILE__, __LINE__)) + end if + found = .false. + return + end if + end if + + ! find closest land grid cell for this point + + if ( present(found) )then + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx,found) + if ( .not. found ) return + else + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + end if + + call ncd_inqvdims(ncid,ndims,vardesc) + + allocate(dids(ndims)) + status = pio_inq_vardimid(ncid, vardesc, dids) + do i = 1,ndims + status = pio_inq_dimname(ncid,dids(i),dimname) + dimname=shr_string_toLower(dimname) + status = pio_inq_dimlen(ncid,dids(i),dimlen) + if ( trim(dimname)=='nj'.or. trim(dimname)=='lat'.or. trim(dimname)=='lsmlat') then + start(i)=latidx + count(i)=1 + else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then + start(i)=lonidx + count(i)=1 + else if ( trim(dimname)=='column') then + + allocate (cols1dlon(dimlen)) + allocate (cols1dlat(dimlen)) + allocate (cols(dimlen)) + + status = pio_inq_varid(ncid, 'cols1d_lon', varid) + status = pio_get_var(ncid, varid, cols1dlon) + status = pio_inq_varid(ncid, 'cols1d_lat', varid) + status = pio_get_var(ncid, varid, cols1dlat) + + cols(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (cols1dlon(cc) == closelon.and.cols1dlat(cc) == closelat) then + cols(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any columns for this latitude ',latidx,' and longitude ',lonidx + call shr_sys_abort('ERROR:: no columns for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=cols(1) + end if + + deallocate (cols1dlon) + deallocate (cols1dlat) + deallocate (cols) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='pft') then + + allocate (pfts1dlon(dimlen)) + allocate (pfts1dlat(dimlen)) + allocate (pfts(dimlen)) + + status = pio_inq_varid(ncid, 'pfts1d_lon', varid) + status = pio_get_var(ncid, varid, pfts1dlon) + + status = pio_inq_varid(ncid, 'pfts1d_lat', varid) + status = pio_get_var(ncid, varid, pfts1dlat) + + pfts(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (pfts1dlon(cc) == closelon.and.pfts1dlat(cc) == closelat) then + pfts(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any pfts for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no PFTs for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=pfts(1) + end if + + deallocate (pfts1dlon) + deallocate (pfts1dlat) + deallocate (pfts) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='landunit') then + + allocate (land1dlon(dimlen)) + allocate (land1dlat(dimlen)) + allocate (landunits(dimlen)) + + status = pio_inq_varid(ncid, 'land1d_lon', varid) + status = pio_get_var(ncid, varid, land1dlon) + + status = pio_inq_varid(ncid, 'land1d_lat', varid) + status = pio_get_var(ncid, varid, land1dlat) + + landunits(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (land1dlon(cc) == closelon.and.land1dlat(cc) == closelat) then + landunits(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any landunits for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no landunits for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=landunits(1) + end if + + deallocate (land1dlon) + deallocate (land1dlat) + deallocate (landunits) + + start(i) = data_offset + count(i) = ndata + else + start(i)=1 + count(i)=dimlen + end if + enddo + deallocate(dids) + + end subroutine scam_field_offsets + + !------------------------------------------------------------------------ + + subroutine ncd_getiodesc(ncid, clmlevel, ndims, dims, dimids, & + xtype, iodnum, switchdim) + ! + ! !DESCRIPTION: + ! Returns an index to an io descriptor + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=8) , intent(in) :: clmlevel ! clmlevel + integer , intent(in) :: ndims ! ndims for var + integer , intent(in) :: dims(:) ! dim sizes + integer , intent(in) :: dimids(:) ! dim ids + integer , intent(in) :: xtype ! file external type + integer , intent(out) :: iodnum ! iodesc num in list + logical,optional , intent(in) :: switchdim ! switch level dimension and first dim + ! + ! !LOCAL VARIABLES: + integer :: k,m,n,cnt ! indices + integer :: basetype ! pio basetype + integer :: gsmap_lsize ! local size of gsmap + integer :: gsmap_gsize ! global size of gsmap + integer :: fullsize ! size of entire array on cdf + integer :: gsize ! global size of clmlevel + integer :: vsize ! other dimensions + integer :: vsize1, vsize2 ! other dimensions + integer :: status ! error status + logical :: found ! true => found created iodescriptor + integer :: ndims_file ! temporary + character(len=64) dimname_file ! dimension name on file + character(len=64) dimname_iodesc ! dimension name from io descriptor + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmOP ! gsmap ordered points + integer(pio_offset_kind), pointer :: compDOF(:) + character(len=32) :: subname = 'ncd_getiodesc' + !------------------------------------------------------------------------ + + ! Determining if need to create a new io descriptor + n = 1 + found = .false. + do while (n <= num_iodesc .and. .not.found) + if (ndims == iodesc_list(n)%ndims .and. xtype == iodesc_list(n)%type) then + found = .true. + ! First found implies that dimension sizes are the same + do m = 1,ndims + if (dims(m) /= iodesc_list(n)%dims(m)) then + found = .false. + endif + enddo + ! If found - then also check that dimension names are equal - + ! dimension ids in iodescriptor are only used to query dimension + ! names associated with that iodescriptor + if (found) then + status = PIO_inquire(ncid, ndimensions=ndims_file) + do m = 1,ndims + status = PIO_inq_dimname(ncid,dimids(m),dimname_file) + if (iodesc_list(n)%dimids(m) > ndims_file) then + found = .false. + exit + else + status = PIO_inq_dimname(ncid,iodesc_list(n)%dimids(m),dimname_iodesc) + if (trim(dimname_file) /= trim(dimname_iodesc)) then + found = .false. + exit + end if + end if + end do + end if + if (found) then + iodnum = n + if (iodnum > num_iodesc) then + write(iulog,*) trim(subname),' ERROR: iodnum out of range ',iodnum,num_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + RETURN + endif + endif + n = n + 1 + enddo + + ! Creating a new io descriptor + + if (ndims > 0) then + num_iodesc = num_iodesc + 1 + if (num_iodesc > max_iodesc) then + write(iulog,*) trim(subname),' ERROR num_iodesc gt max_iodesc ',max_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + iodnum = num_iodesc + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' creating iodesc at iodnum,ndims,dims(1:ndims),xtype',& + iodnum,ndims,dims(1:ndims),xtype + endif + end if + + if (xtype == pio_double ) then + basetype = PIO_DOUBLE + else if (xtype == pio_real) then + basetype = PIO_DOUBLE + else if (xtype == pio_int) then + basetype = PIO_INT + else + write(iulog,*) trim(subname),'ERROR: no match for xtype = ',xtype + call shr_sys_abort(errMsg(__FILE__,__LINE__)) + end if + + call get_clmlevel_gsmap(clmlevel,gsmap) + gsize = get_clmlevel_gsize(clmlevel) + gsmap_lsize = mct_gsmap_lsize(gsmap,mpicom) + gsmap_gsize = mct_gsmap_gsize(gsmap) + + call mct_gsmap_OP(gsmap,iam,gsmOP) + + fullsize = 1 + do n = 1,ndims + fullsize = fullsize*dims(n) + enddo + + vsize = fullsize / gsize + if (mod(fullsize,gsize) /= 0) then + write(iulog,*) subname,' ERROR in vsize ',fullsize,gsize,vsize + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + allocate(compDOF(gsmap_lsize*vsize)) + + if (present(switchdim)) then + if (switchdim) then + cnt = 0 + do m = 1,gsmap_lsize + do n = 1,vsize + cnt = cnt + 1 + compDOF(cnt) = (gsmOP(m)-1)*vsize + n + enddo + enddo + else + write(iulog,*) subname,' ERROR switch dims present must have switchdim true' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + else ! currently allow for up to two vertical dimensions + if (vsize /= 1 .and. vsize /= dims(ndims)) then + vsize1 = vsize/dims(ndims) + vsize2 = dims(ndims) + if (vsize1*vsize2 /= vsize) then + write(iulog,*)'vsize1= ',vsize1,' vsize2= ',vsize2,' vsize= ',vsize + call shr_sys_abort('error in vsize1 and vsize2 computation'//errMsg(__FILE__, __LINE__)) + end if + cnt = 0 + do k = 1,vsize2 + do n = 1,vsize1 + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (k-1)*vsize1*gsmap_gsize + (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end do + else + cnt = 0 + do n = 1,vsize + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end if + end if + + if (debug > 1) then + do m = 0,npes-1 + if (iam == m) then + write(iulog,*) trim(subname),' sizes1 = ',iam,gsize,gsmap_gsize,gsmap_lsize + write(iulog,*) trim(subname),' sizes2 = ',iam,fullsize,npes,vsize + write(iulog,*) trim(subname),' compDOF = ',iam,size(compDOF),minval(compDOF),maxval(compDOF) + call shr_sys_flush(iulog) + endif + call mpi_barrier(mpicom,status) + enddo + endif + + deallocate(gsmOP) + +! call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_SUBSET) + call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_BOX) + + + deallocate(compDOF) + + iodesc_list(iodnum)%type = xtype + iodesc_list(iodnum)%ndims = ndims + iodesc_list(iodnum)%dims = 0 + iodesc_list(iodnum)%dims(1:ndims) = dims(1:ndims) + iodesc_list(iodnum)%dimids(1:ndims) = dimids(1:ndims) + + end subroutine ncd_getiodesc + +end module ncdio_pio diff --git a/components/clm/src/main/ncdio_utils.F90 b/components/clm/src/main/ncdio_utils.F90 new file mode 100644 index 0000000000..977e10b484 --- /dev/null +++ b/components/clm/src/main/ncdio_utils.F90 @@ -0,0 +1,70 @@ +module ncdio_utils + + !----------------------------------------------------------------------- + ! This module provides higher-level netcdf i/o utilities, which build on ncdio_pio. + ! + ! The main reason for putting these utilities in a separate module (rather than putting + ! them in ncdio_pio) is to enhance testability: These routines can be unit tested with + ! a stub version of ncdio_pio. + use ncdio_pio + ! + implicit none + save + private + + public :: find_var_on_file ! given a list of possible variables, find the one that exists on the file + +contains + + !----------------------------------------------------------------------- + subroutine find_var_on_file(ncid, varname_list, varname_on_file) + ! + ! !DESCRIPTION: + ! Given a colon-delimited list of possible variable names, return the first one that + ! was found on the file. + ! + ! If none are found, arbitrarily return the first variable in the list. (Doing this + ! rather than returning a special flag simplifies the logic elsewhere - allowing the + ! ncd_io call to fail rather than requiring extra error-checking logic.) + ! + ! !USES: + use shr_string_mod, only : shr_string_listGetNum, shr_string_listGetName + ! + ! !ARGUMENTS: + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname_list ! colon-delimited list of possible variable names + character(len=*) , intent(out) :: varname_on_file ! first variable from the list that was found on file + ! + ! !LOCAL VARIABLES: + integer :: num_vars + integer :: n + logical :: found + logical :: readvar + character(len=len(varname_on_file)) :: cur_varname + integer :: varid + type(var_desc_t) :: vardesc + + character(len=*), parameter :: subname = 'find_var_on_file' + !----------------------------------------------------------------------- + + num_vars = shr_string_listGetNum(varname_list) + + found = .false. + n = 1 + do while ((.not. found) .and. (n <= num_vars)) + call shr_string_listGetName(varname_list, n, cur_varname) + call ncd_inqvid(ncid, cur_varname, varid, vardesc, readvar=readvar) + found = readvar + n = n + 1 + end do + + if (found) then + varname_on_file = cur_varname + else + ! If none are found, arbitrarily return the first variable in the list + call shr_string_listGetName(varname_list, 1, varname_on_file) + end if + + end subroutine find_var_on_file + +end module ncdio_utils diff --git a/components/clm/src/main/ndepStreamMod.F90 b/components/clm/src/main/ndepStreamMod.F90 new file mode 100644 index 0000000000..544dc25c60 --- /dev/null +++ b/components/clm/src/main/ndepStreamMod.F90 @@ -0,0 +1,276 @@ +module ndepStreamMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains methods for reading in nitrogen deposition data file + ! Also includes functions for dynamic ndep file handling and + ! interpolation. + ! + ! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_strdata_mod + use shr_stream_mod + use shr_string_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use controlMod , only: NLFilename + use abortutils , only: endrun + use fileutils , only: getavu, relavu + use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use domainMod , only: ldomain + + ! !PUBLIC TYPES: + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public :: ndep_init ! position datasets for dynamic ndep + public :: ndep_interp ! interpolates between two years of ndep file data + public :: clm_domain_mct ! Sets up MCT domain for this resolution + + ! ! PRIVATE TYPES + type(shr_strdata_type) :: sdat ! input data stream + integer :: stream_year_first_ndep ! first year in stream to use + integer :: stream_year_last_ndep ! last year in stream to use + integer :: model_year_align_ndep ! align stream_year_firstndep with + !============================================================================== + +contains + + !============================================================================== + + subroutine ndep_init(bounds) + ! + ! Initialize data stream information. + ! + ! Uses: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! arguments + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_ndep + character(len=CL) :: ndepmapalgo = 'bilinear' + character(*), parameter :: shr_strdata_unset = 'NOT_SET' + character(*), parameter :: subName = "('ndepdyn_init')" + character(*), parameter :: F00 = "('(ndepdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /ndepdyn_nml/ & + stream_year_first_ndep, & + stream_year_last_ndep, & + model_year_align_ndep, & + ndepmapalgo, & + stream_fldFileName_ndep + + ! Default values for namelist + stream_year_first_ndep = 1 ! first year in stream to use + stream_year_last_ndep = 1 ! last year in stream to use + model_year_align_ndep = 1 ! align stream_year_first_ndep with this model year + stream_fldFileName_ndep = ' ' + + ! Read ndepdyn_nml namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call shr_nl_find_group_name(nu_nml, 'ndepdyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndepdyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg=' ERROR reading ndepdyn_nml namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_ndep, mpicom) + call shr_mpi_bcast(stream_year_last_ndep, mpicom) + call shr_mpi_bcast(model_year_align_ndep, mpicom) + call shr_mpi_bcast(stream_fldFileName_ndep, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'ndepdyn stream settings:' + write(iulog,*) ' stream_year_first_ndep = ',stream_year_first_ndep + write(iulog,*) ' stream_year_last_ndep = ',stream_year_last_ndep + write(iulog,*) ' model_year_align_ndep = ',model_year_align_ndep + write(iulog,*) ' stream_fldFileName_ndep = ',stream_fldFileName_ndep + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat,name="clmndep", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep, & + yearLast=stream_year_last_ndep, & + yearAlign=model_year_align_ndep, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep)/),& + fldListFile='NDEP_year', & + fldListModel='NDEP_year', & + fillalgo='none', & + mapalgo=ndepmapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat,'CLMNDEP data') + endif + + end subroutine ndep_init + + !================================================================ + subroutine ndep_interp(bounds, atm2lnd_inst) + + !----------------------------------------------------------------------- + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use atm2lndType , only : atm2lnd_type + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndepdyn') + + ig = 0 + dayspyr = get_days_per_year( ) + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + end subroutine ndep_interp + + !============================================================================== + subroutine clm_domain_mct(bounds, dom_clm) + + !------------------------------------------------------------------- + ! Set domain data type for internal clm grid + use clm_varcon , only : re + use domainMod , only : ldomain + use seq_flds_mod + implicit none + ! + ! arguments + type(bounds_type), intent(in) :: bounds + type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model + ! + ! local variables + integer :: g,i,j ! index + integer :: lsize ! land model domain data size + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + !------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + ! + lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) + call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) + call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) + ! + ! Determine bounds + ! + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + ! + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%lonc(g) + end do + call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%latc(g) + end do + call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%area(g)/(re*re) + end do + call mct_gGrid_importRattr(dom_clm,"area",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%mask(g), r8) + end do + call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%frac(g), r8) + end do + call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine clm_domain_mct + +end module ndepStreamMod + diff --git a/components/clm/src/main/organicFileMod.F90 b/components/clm/src/main/organicFileMod.F90 new file mode 100644 index 0000000000..3adbd5b6f1 --- /dev/null +++ b/components/clm/src/main/organicFileMod.F90 @@ -0,0 +1,113 @@ +module organicFileMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: organicFileMod +! +! !DESCRIPTION: +! Contains methods for reading in organic matter data file which has +! organic matter density for each grid point and soil level +! +! !USES + use abortutils , only : endrun + use clm_varctl , only : iulog + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varcon , only : grlnd +! +! !PUBLIC TYPES: + implicit none + private + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: organicrd ! Read organic matter dataset +! +! !REVISION HISTORY: +! Created by David Lawrence, 4 May 2006 +! Revised by David Lawrence, 21 September 2007 +! Revised by David Lawrence, 14 October 2008 +! +!EOP +! +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: organicrd +! +! !INTERFACE: + subroutine organicrd(organic) +! +! !DESCRIPTION: +! Read the organic matter dataset. +! +! !USES: + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use spmdMod , only : masterproc + use domainMod , only : ldomain + use ncdio_pio +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: organic(:,:) ! organic matter density (kg/m3) +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by David Lawrence, 4 May 2006 +! Revised by David Lawrence, 21 September 2007 +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: ni,nj,ns ! dimension sizes + logical :: isgrid2d ! true => file is 2d + logical :: readvar ! true => variable is on dataset + character(len=32) :: subname = 'organicrd' ! subroutine name +!----------------------------------------------------------------------- + + ! Initialize data to zero - no organic matter dataset + + organic(:,:) = 0._r8 + + ! Read data if file was specified in namelist + + if (fsurdat /= ' ') then + if (masterproc) then + write(iulog,*) 'Attempting to read organic matter data .....' + write(iulog,*) subname,trim(fsurdat) + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun() + end if + + call ncd_io(ncid=ncid, varname='ORGANIC', flag='read', data=organic, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('organicrd: errror reading ORGANIC') + + if ( masterproc )then + write(iulog,*) 'Successfully read organic matter data' + write(iulog,*) + end if + endif + + end subroutine organicrd + +end module organicFileMod diff --git a/components/clm/src/main/paramUtilMod.F90 b/components/clm/src/main/paramUtilMod.F90 new file mode 100644 index 0000000000..75a85e3e6c --- /dev/null +++ b/components/clm/src/main/paramUtilMod.F90 @@ -0,0 +1,131 @@ +module paramUtilMod + ! + ! module that deals with reading parameter files + ! + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + save + private + + interface readNcdio + module procedure readNcdioScalar + module procedure readNcdioArray1d + module procedure readNcdioArray2d + end interface + + public :: readNcdioScalar + public :: readNcdioArray1d + public :: readNcdioArray2d + + public :: readNcdio + +contains + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioScalar(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioScalar + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray1d(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: ) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioArray1d + !----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! + !----------------------------------------------------------------------- + subroutine readNcdioArray2d(ncid, varName, callingName, retVal) + ! + ! read the netcdf file...generic, could be used for any parameter read + ! + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t,ncd_io + + implicit none + + ! arguments + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + character(len=*), intent(in) :: varName ! variable we are reading + character(len=*), intent(in) :: callingName ! calling routine + real(r8), intent(inout) :: retVal( 1: , :) + + ! local vars + character(len=32) :: subname = 'readNcdio::' + character(len=100) :: errCode = ' - Error reading. Var: ' + logical :: readv ! has variable been read in or not + + ! + ! netcdf read here + ! + + call ncd_io(varname=trim(varName),data=retVal, flag='read', ncid=ncid, readvar=readv) + + if ( .not. readv ) then + call endrun(trim(callingName)//trim(subname)//trim(errCode)//trim(varName)) + endif + + end subroutine readNcdioArray2d + !----------------------------------------------------------------------- + +end module paramUtilMod diff --git a/components/clm/src/main/pftconMod.F90 b/components/clm/src/main/pftconMod.F90 new file mode 100644 index 0000000000..cb56dcf29b --- /dev/null +++ b/components/clm/src/main/pftconMod.F90 @@ -0,0 +1,1042 @@ +module pftconMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing vegetation constants and method to + ! read and initialize vegetation (PFT) constants. + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_varpar , only : mxpft, numrad, ivis, inir + use clm_varctl , only : iulog, use_cndv, use_vertsoilc + ! + ! !PUBLIC TYPES: + implicit none + ! + ! Vegetation type constants + ! + integer :: noveg ! value for not vegetated + integer :: ndllf_evr_tmp_tree ! value for Needleleaf evergreen temperate tree + integer :: ndllf_evr_brl_tree ! value for Needleleaf evergreen boreal tree + integer :: ndllf_dcd_brl_tree ! value for Needleleaf deciduous boreal tree + integer :: nbrdlf_evr_trp_tree ! value for Broadleaf evergreen tropical tree + integer :: nbrdlf_evr_tmp_tree ! value for Broadleaf evergreen temperate tree + integer :: nbrdlf_dcd_trp_tree ! value for Broadleaf deciduous tropical tree + integer :: nbrdlf_dcd_tmp_tree ! value for Broadleaf deciduous temperate tree + integer :: nbrdlf_dcd_brl_tree ! value for Broadleaf deciduous boreal tree + integer :: ntree ! value for last type of tree + integer :: nbrdlf_evr_shrub ! value for Broadleaf evergreen shrub + integer :: nbrdlf_dcd_tmp_shrub ! value for Broadleaf deciduous temperate shrub + integer :: nbrdlf_dcd_brl_shrub ! value for Broadleaf deciduous boreal shrub + integer :: nc3_arctic_grass ! value for C3 arctic grass + integer :: nc3_nonarctic_grass ! value for C3 non-arctic grass + integer :: nc4_grass ! value for C4 grass + integer :: npcropmin ! value for first crop + integer :: ntmp_corn ! value for temperate corn, rain fed (rf) + integer :: nirrig_tmp_corn ! value for temperate corn, irrigated (ir) + integer :: nswheat ! value for spring temperate cereal (rf) + integer :: nirrig_swheat ! value for spring temperate cereal (ir) + integer :: nwwheat ! value for winter temperate cereal (rf) + integer :: nirrig_wwheat ! value for winter temperate cereal (ir) + integer :: ntmp_soybean ! value for temperate soybean (rf) + integer :: nirrig_tmp_soybean ! value for temperate soybean (ir) + integer :: nbarley ! value for spring barley (rf) + integer :: nirrig_barley ! value for spring barley (ir) + integer :: nwbarley ! value for winter barley (rf) + integer :: nirrig_wbarley ! value for winter barley (ir) + integer :: nrye ! value for spring rye (rf) + integer :: nirrig_rye ! value for spring rye (ir) + integer :: nwrye ! value for winter rye (rf) + integer :: nirrig_wrye ! value for winter rye (ir) + integer :: ncassava ! ...and so on + integer :: nirrig_cassava + integer :: ncitrus + integer :: nirrig_citrus + integer :: ncocoa + integer :: nirrig_cocoa + integer :: ncoffee + integer :: nirrig_coffee + integer :: ncotton + integer :: nirrig_cotton + integer :: ndatepalm + integer :: nirrig_datepalm + integer :: nfoddergrass + integer :: nirrig_foddergrass + integer :: ngrapes + integer :: nirrig_grapes + integer :: ngroundnuts + integer :: nirrig_groundnuts + integer :: nmillet + integer :: nirrig_millet + integer :: noilpalm + integer :: nirrig_oilpalm + integer :: npotatoes + integer :: nirrig_potatoes + integer :: npulses + integer :: nirrig_pulses + integer :: nrapeseed + integer :: nirrig_rapeseed + integer :: nrice + integer :: nirrig_rice + integer :: nsorghum + integer :: nirrig_sorghum + integer :: nsugarbeet + integer :: nirrig_sugarbeet + integer :: nsugarcane + integer :: nirrig_sugarcane + integer :: nsunflower + integer :: nirrig_sunflower + integer :: nmiscanthus + integer :: nirrig_miscanthus + integer :: nswitchgrass + integer :: nirrig_switchgrass + integer :: ntrp_corn !value for tropical corn (rf) + integer :: nirrig_trp_corn !value for tropical corn (ir) + integer :: ntrp_soybean !value for tropical soybean (rf) + integer :: nirrig_trp_soybean !value for tropical soybean (ir) + integer :: npcropmax ! value for last prognostic crop in list + integer :: npcropmaxknown ! value for last one clm knows how to model + integer :: nc3crop ! value for generic crop (rf) + integer :: nc3irrig ! value for irrigated generic crop (ir) + + ! !PUBLIC TYPES: + type, public :: pftcon_type + + integer , allocatable :: noveg (:) ! value for not vegetated + integer , allocatable :: tree (:) ! tree or not? + + real(r8), allocatable :: dleaf (:) ! characteristic leaf dimension (m) + real(r8), allocatable :: c3psn (:) ! photosynthetic pathway: 0. = c4, 1. = c3 + real(r8), allocatable :: xl (:) ! leaf/stem orientation index + real(r8), allocatable :: rhol (:,:) ! leaf reflectance: 1=vis, 2=nir + real(r8), allocatable :: rhos (:,:) ! stem reflectance: 1=vis, 2=nir + real(r8), allocatable :: taul (:,:) ! leaf transmittance: 1=vis, 2=nir + real(r8), allocatable :: taus (:,:) ! stem transmittance: 1=vis, 2=nir + real(r8), allocatable :: z0mr (:) ! ratio of momentum roughness length to canopy top height (-) + real(r8), allocatable :: displar (:) ! ratio of displacement height to canopy top height (-) + real(r8), allocatable :: roota_par (:) ! CLM rooting distribution parameter [1/m] + real(r8), allocatable :: rootb_par (:) ! CLM rooting distribution parameter [1/m] + real(r8), allocatable :: crop (:) ! crop pft: 0. = not crop, 1. = crop pft + real(r8), allocatable :: irrigated (:) ! irrigated pft: 0. = not, 1. = irrigated + real(r8), allocatable :: smpso (:) ! soil water potential at full stomatal opening (mm) + real(r8), allocatable :: smpsc (:) ! soil water potential at full stomatal closure (mm) + real(r8), allocatable :: fnitr (:) ! foliage nitrogen limitation factor (-) + + ! CN code + real(r8), allocatable :: dwood (:) ! wood density (gC/m3) + real(r8), allocatable :: slatop (:) ! SLA at top of canopy [m^2/gC] + real(r8), allocatable :: dsladlai (:) ! dSLA/dLAI [m^2/gC] + real(r8), allocatable :: leafcn (:) ! leaf C:N [gC/gN] + real(r8), allocatable :: flnr (:) ! fraction of leaf N in Rubisco [no units] + real(r8), allocatable :: woody (:) ! woody lifeform flag (0 or 1) + real(r8), allocatable :: lflitcn (:) ! leaf litter C:N (gC/gN) + real(r8), allocatable :: frootcn (:) ! fine root C:N (gC/gN) + real(r8), allocatable :: livewdcn (:) ! live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8), allocatable :: deadwdcn (:) ! dead wood (xylem and heartwood) C:N (gC/gN) + real(r8), allocatable :: grperc (:) ! growth respiration parameter + real(r8), allocatable :: grpnow (:) ! growth respiration parameter + real(r8), allocatable :: rootprof_beta (:) ! CLM rooting distribution parameter for C and N inputs [unitless] + + ! crop + real(r8), allocatable :: graincn (:) ! grain C:N (gC/gN) + real(r8), allocatable :: mxtmp (:) ! parameter used in accFlds + real(r8), allocatable :: baset (:) ! parameter used in accFlds + real(r8), allocatable :: declfact (:) ! parameter used in CNAllocation + real(r8), allocatable :: bfact (:) ! parameter used in CNAllocation + real(r8), allocatable :: aleaff (:) ! parameter used in CNAllocation + real(r8), allocatable :: arootf (:) ! parameter used in CNAllocation + real(r8), allocatable :: astemf (:) ! parameter used in CNAllocation + real(r8), allocatable :: arooti (:) ! parameter used in CNAllocation + real(r8), allocatable :: fleafi (:) ! parameter used in CNAllocation + real(r8), allocatable :: allconsl (:) ! parameter used in CNAllocation + real(r8), allocatable :: allconss (:) ! parameter used in CNAllocation + real(r8), allocatable :: ztopmx (:) ! parameter used in CNVegStructUpdate + real(r8), allocatable :: laimx (:) ! parameter used in CNVegStructUpdate + real(r8), allocatable :: gddmin (:) ! parameter used in CNPhenology + real(r8), allocatable :: hybgdd (:) ! parameter used in CNPhenology + real(r8), allocatable :: lfemerg (:) ! parameter used in CNPhenology + real(r8), allocatable :: grnfill (:) ! parameter used in CNPhenology + integer , allocatable :: mergetoclmpft (:) ! parameter used in surfrdMod + integer , allocatable :: mxmat (:) ! parameter used in CNPhenology + integer , allocatable :: mnNHplantdate (:) ! minimum planting date for NorthHemisphere (YYYYMMDD) + integer , allocatable :: mxNHplantdate (:) ! maximum planting date for NorthHemisphere (YYYYMMDD) + integer , allocatable :: mnSHplantdate (:) ! minimum planting date for SouthHemisphere (YYYYMMDD) + integer , allocatable :: mxSHplantdate (:) ! maximum planting date for SouthHemisphere (YYYYMMDD) + real(r8), allocatable :: planttemp (:) ! planting temperature used in CNPhenology (K) + real(r8), allocatable :: minplanttemp (:) ! mininum planting temperature used in CNPhenology (K) + real(r8), allocatable :: froot_leaf (:) ! allocation parameter: new fine root C per new leaf C (gC/gC) + real(r8), allocatable :: stem_leaf (:) ! allocation parameter: new stem c per new leaf C (gC/gC) + real(r8), allocatable :: croot_stem (:) ! allocation parameter: new coarse root C per new stem C (gC/gC) + real(r8), allocatable :: flivewd (:) ! allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + real(r8), allocatable :: fcur (:) ! allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + real(r8), allocatable :: fcurdv (:) ! alternate fcur for use with cndv + real(r8), allocatable :: lf_flab (:) ! leaf litter labile fraction + real(r8), allocatable :: lf_fcel (:) ! leaf litter cellulose fraction + real(r8), allocatable :: lf_flig (:) ! leaf litter lignin fraction + real(r8), allocatable :: fr_flab (:) ! fine root litter labile fraction + real(r8), allocatable :: fr_fcel (:) ! fine root litter cellulose fraction + real(r8), allocatable :: fr_flig (:) ! fine root litter lignin fraction + real(r8), allocatable :: leaf_long (:) ! leaf longevity (yrs) + real(r8), allocatable :: evergreen (:) ! binary flag for evergreen leaf habit (0 or 1) + real(r8), allocatable :: stress_decid (:) ! binary flag for stress-deciduous leaf habit (0 or 1) + real(r8), allocatable :: season_decid (:) ! binary flag for seasonal-deciduous leaf habit (0 or 1) + real(r8), allocatable :: pconv (:) ! proportion of deadstem to conversion flux + real(r8), allocatable :: pprod10 (:) ! proportion of deadstem to 10-yr product pool + real(r8), allocatable :: pprod100 (:) ! proportion of deadstem to 100-yr product pool + real(r8), allocatable :: pprodharv10 (:) ! harvest mortality proportion of deadstem to 10-yr pool + + ! pft paraemeters for fire code + real(r8), allocatable :: cc_leaf (:) + real(r8), allocatable :: cc_lstem (:) + real(r8), allocatable :: cc_dstem (:) + real(r8), allocatable :: cc_other (:) + real(r8), allocatable :: fm_leaf (:) + real(r8), allocatable :: fm_lstem (:) + real(r8), allocatable :: fm_dstem (:) + real(r8), allocatable :: fm_other (:) + real(r8), allocatable :: fm_root (:) + real(r8), allocatable :: fm_lroot (:) + real(r8), allocatable :: fm_droot (:) + real(r8), allocatable :: fsr_pft (:) + real(r8), allocatable :: fd_pft (:) + + ! pft parameters for crop code + real(r8), allocatable :: fertnitro (:) ! fertilizer + real(r8), allocatable :: fleafcn (:) ! C:N during grain fill; leaf + real(r8), allocatable :: ffrootcn (:) ! C:N during grain fill; fine root + real(r8), allocatable :: fstemcn (:) ! C:N during grain fill; stem + + real(r8), allocatable :: i_vc (:) + real(r8), allocatable :: s_vc (:) + real(r8), allocatable :: i_vca (:) + real(r8), allocatable :: s_vca (:) + real(r8), allocatable :: i_vcad (:) + real(r8), allocatable :: s_vcad (:) + real(r8), allocatable :: i_flnr (:) + real(r8), allocatable :: s_flnr (:) + + ! pft parameters for CNDV code (from LPJ subroutine pftparameters) + real(r8), allocatable :: pftpar20 (:) ! tree maximum crown area (m2) + real(r8), allocatable :: pftpar28 (:) ! min coldest monthly mean temperature + real(r8), allocatable :: pftpar29 (:) ! max coldest monthly mean temperature + real(r8), allocatable :: pftpar30 (:) ! min growing degree days (>= 5 deg C) + real(r8), allocatable :: pftpar31 (:) ! upper limit of temperature of the warmest month (twmax) + + contains + + procedure, public :: Init + procedure, private :: InitAllocate + procedure, private :: InitRead + + end type pftcon_type + + type(pftcon_type), public :: pftcon ! pft type constants structure + + integer, parameter :: pftname_len = 40 ! max length of pftname + character(len=pftname_len) :: pftname(0:mxpft) ! PFT description + + real(r8), parameter :: reinickerp = 1.6_r8 ! parameter in allometric equation + real(r8), parameter :: dwood = 2.5e5_r8 ! cn wood density (gC/m3); lpj:2.0e5 + real(r8), parameter :: allom1 = 100.0_r8 ! parameters in + real(r8), parameter :: allom2 = 40.0_r8 ! ...allometric + real(r8), parameter :: allom3 = 0.5_r8 ! ...equations + real(r8), parameter :: allom1s = 250.0_r8 ! modified for shrubs by + real(r8), parameter :: allom2s = 8.0_r8 ! X.D.Z + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------ + subroutine Init(this) + + class(pftcon_type) :: this + + call this%InitAllocate() + call this%InitRead() + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate (this) + ! + ! !DESCRIPTION: + ! Read and initialize vegetation (PFT) constants + ! + ! !USES: + ! + ! !ARGUMENTS: + class(pftcon_type) :: this + !----------------------------------------------------------------------- + + allocate( this%noveg (0:mxpft)); this%noveg (:) =huge(1) + allocate( this%tree (0:mxpft)); this%tree (:) =huge(1) + + allocate( this%dleaf (0:mxpft) ) + allocate( this%c3psn (0:mxpft) ) + allocate( this%xl (0:mxpft) ) + allocate( this%rhol (0:mxpft,numrad) ) + allocate( this%rhos (0:mxpft,numrad) ) + allocate( this%taul (0:mxpft,numrad) ) + allocate( this%taus (0:mxpft,numrad) ) + allocate( this%z0mr (0:mxpft) ) + allocate( this%displar (0:mxpft) ) + allocate( this%roota_par (0:mxpft) ) + allocate( this%rootb_par (0:mxpft) ) + allocate( this%crop (0:mxpft) ) + allocate( this%mergetoclmpft (0:mxpft) ) + allocate( this%irrigated (0:mxpft) ) + allocate( this%smpso (0:mxpft) ) + allocate( this%smpsc (0:mxpft) ) + allocate( this%fnitr (0:mxpft) ) + allocate( this%slatop (0:mxpft) ) + allocate( this%dsladlai (0:mxpft) ) + allocate( this%leafcn (0:mxpft) ) + allocate( this%flnr (0:mxpft) ) + allocate( this%woody (0:mxpft) ) + allocate( this%lflitcn (0:mxpft) ) + allocate( this%frootcn (0:mxpft) ) + allocate( this%livewdcn (0:mxpft) ) + allocate( this%deadwdcn (0:mxpft) ) + allocate( this%grperc (0:mxpft) ) + allocate( this%grpnow (0:mxpft) ) + allocate( this%rootprof_beta (0:mxpft) ) + allocate( this%graincn (0:mxpft) ) + allocate( this%mxtmp (0:mxpft) ) + allocate( this%baset (0:mxpft) ) + allocate( this%declfact (0:mxpft) ) + allocate( this%bfact (0:mxpft) ) + allocate( this%aleaff (0:mxpft) ) + allocate( this%arootf (0:mxpft) ) + allocate( this%astemf (0:mxpft) ) + allocate( this%arooti (0:mxpft) ) + allocate( this%fleafi (0:mxpft) ) + allocate( this%allconsl (0:mxpft) ) + allocate( this%allconss (0:mxpft) ) + allocate( this%ztopmx (0:mxpft) ) + allocate( this%laimx (0:mxpft) ) + allocate( this%gddmin (0:mxpft) ) + allocate( this%hybgdd (0:mxpft) ) + allocate( this%lfemerg (0:mxpft) ) + allocate( this%grnfill (0:mxpft) ) + allocate( this%mxmat (0:mxpft) ) + allocate( this%mnNHplantdate (0:mxpft) ) + allocate( this%mxNHplantdate (0:mxpft) ) + allocate( this%mnSHplantdate (0:mxpft) ) + allocate( this%mxSHplantdate (0:mxpft) ) + allocate( this%planttemp (0:mxpft) ) + allocate( this%minplanttemp (0:mxpft) ) + allocate( this%froot_leaf (0:mxpft) ) + allocate( this%stem_leaf (0:mxpft) ) + allocate( this%croot_stem (0:mxpft) ) + allocate( this%flivewd (0:mxpft) ) + allocate( this%fcur (0:mxpft) ) + allocate( this%fcurdv (0:mxpft) ) + allocate( this%lf_flab (0:mxpft) ) + allocate( this%lf_fcel (0:mxpft) ) + allocate( this%lf_flig (0:mxpft) ) + allocate( this%fr_flab (0:mxpft) ) + allocate( this%fr_fcel (0:mxpft) ) + allocate( this%fr_flig (0:mxpft) ) + allocate( this%leaf_long (0:mxpft) ) + allocate( this%evergreen (0:mxpft) ) + allocate( this%stress_decid (0:mxpft) ) + allocate( this%season_decid (0:mxpft) ) + allocate( this%dwood (0:mxpft) ) + allocate( this%pconv (0:mxpft) ) + allocate( this%pprod10 (0:mxpft) ) + allocate( this%pprod100 (0:mxpft) ) + allocate( this%pprodharv10 (0:mxpft) ) + allocate( this%cc_leaf (0:mxpft) ) + allocate( this%cc_lstem (0:mxpft) ) + allocate( this%cc_dstem (0:mxpft) ) + allocate( this%cc_other (0:mxpft) ) + allocate( this%fm_leaf (0:mxpft) ) + allocate( this%fm_lstem (0:mxpft) ) + allocate( this%fm_dstem (0:mxpft) ) + allocate( this%fm_other (0:mxpft) ) + allocate( this%fm_root (0:mxpft) ) + allocate( this%fm_lroot (0:mxpft) ) + allocate( this%fm_droot (0:mxpft) ) + allocate( this%fsr_pft (0:mxpft) ) + allocate( this%fd_pft (0:mxpft) ) + allocate( this%fertnitro (0:mxpft) ) + allocate( this%fleafcn (0:mxpft) ) + allocate( this%ffrootcn (0:mxpft) ) + allocate( this%fstemcn (0:mxpft) ) + allocate( this%i_vc (0:mxpft) ) + allocate( this%s_vc (0:mxpft) ) + allocate( this%i_vca (0:mxpft) ) + allocate( this%s_vca (0:mxpft) ) + allocate( this%i_vcad (0:mxpft) ) + allocate( this%s_vcad (0:mxpft) ) + allocate( this%i_flnr (0:mxpft) ) + allocate( this%s_flnr (0:mxpft) ) + allocate( this%pftpar20 (0:mxpft) ) + allocate( this%pftpar28 (0:mxpft) ) + allocate( this%pftpar29 (0:mxpft) ) + allocate( this%pftpar30 (0:mxpft) ) + allocate( this%pftpar31 (0:mxpft) ) + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitRead(this) + ! + ! !DESCRIPTION: + ! Read and initialize vegetation (PFT) constants + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t + use ncdio_pio , only : ncd_inqdid, ncd_inqdlen + use clm_varctl , only : paramfile, use_ed, use_flexibleCN + use spmdMod , only : masterproc + use EDPftvarcon , only : EDpftconrd + ! + ! !ARGUMENTS: + class(pftcon_type) :: this + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + integer :: i,n,m ! loop indices + integer :: ier ! error code + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + logical :: readv ! read variable in or not + character(len=32) :: subname = 'InitRead' ! subroutine name + character(len=pftname_len) :: expected_pftnames(0:mxpft) + character(len=512) :: msg + !----------------------------------------------------------------------- + ! + ! Expected PFT names: The names expected on the paramfile file and the order they are expected to be in. + ! NOTE: similar types are assumed to be together, first trees (ending with broadleaf_deciduous_boreal_tree + ! then shrubs, ending with broadleaf_deciduous_boreal_shrub, then grasses starting with c3_arctic_grass + ! and finally crops, ending with irrigated_tropical_soybean + ! DO NOT CHANGE THE ORDER -- WITHOUT MODIFYING OTHER PARTS OF THE CODE WHERE THE ORDER MATTERS! + + expected_pftnames( 0) = 'not_vegetated ' + expected_pftnames( 1) = 'needleleaf_evergreen_temperate_tree' + expected_pftnames( 2) = 'needleleaf_evergreen_boreal_tree ' + expected_pftnames( 3) = 'needleleaf_deciduous_boreal_tree ' + expected_pftnames( 4) = 'broadleaf_evergreen_tropical_tree ' + expected_pftnames( 5) = 'broadleaf_evergreen_temperate_tree ' + expected_pftnames( 6) = 'broadleaf_deciduous_tropical_tree ' + expected_pftnames( 7) = 'broadleaf_deciduous_temperate_tree ' + expected_pftnames( 8) = 'broadleaf_deciduous_boreal_tree ' + expected_pftnames( 9) = 'broadleaf_evergreen_shrub ' + expected_pftnames(10) = 'broadleaf_deciduous_temperate_shrub' + expected_pftnames(11) = 'broadleaf_deciduous_boreal_shrub ' + expected_pftnames(12) = 'c3_arctic_grass ' + expected_pftnames(13) = 'c3_non-arctic_grass ' + expected_pftnames(14) = 'c4_grass ' + expected_pftnames(15) = 'c3_crop ' + expected_pftnames(16) = 'c3_irrigated ' + expected_pftnames(17) = 'temperate_corn ' + expected_pftnames(18) = 'irrigated_temperate_corn ' + expected_pftnames(19) = 'spring_wheat ' + expected_pftnames(20) = 'irrigated_spring_wheat ' + expected_pftnames(21) = 'winter_wheat ' + expected_pftnames(22) = 'irrigated_winter_wheat ' + expected_pftnames(23) = 'temperate_soybean ' + expected_pftnames(24) = 'irrigated_temperate_soybean ' + expected_pftnames(25) = 'barley ' + expected_pftnames(26) = 'irrigated_barley ' + expected_pftnames(27) = 'winter_barley ' + expected_pftnames(28) = 'irrigated_winter_barley ' + expected_pftnames(29) = 'rye ' + expected_pftnames(30) = 'irrigated_rye ' + expected_pftnames(31) = 'winter_rye ' + expected_pftnames(32) = 'irrigated_winter_rye ' + expected_pftnames(33) = 'cassava ' + expected_pftnames(34) = 'irrigated_cassava ' + expected_pftnames(35) = 'citrus ' + expected_pftnames(36) = 'irrigated_citrus ' + expected_pftnames(37) = 'cocoa ' + expected_pftnames(38) = 'irrigated_cocoa ' + expected_pftnames(39) = 'coffee ' + expected_pftnames(40) = 'irrigated_coffee ' + expected_pftnames(41) = 'cotton ' + expected_pftnames(42) = 'irrigated_cotton ' + expected_pftnames(43) = 'datepalm ' + expected_pftnames(44) = 'irrigated_datepalm ' + expected_pftnames(45) = 'foddergrass ' + expected_pftnames(46) = 'irrigated_foddergrass ' + expected_pftnames(47) = 'grapes ' + expected_pftnames(48) = 'irrigated_grapes ' + expected_pftnames(49) = 'groundnuts ' + expected_pftnames(50) = 'irrigated_groundnuts ' + expected_pftnames(51) = 'millet ' + expected_pftnames(52) = 'irrigated_millet ' + expected_pftnames(53) = 'oilpalm ' + expected_pftnames(54) = 'irrigated_oilpalm ' + expected_pftnames(55) = 'potatoes ' + expected_pftnames(56) = 'irrigated_potatoes ' + expected_pftnames(57) = 'pulses ' + expected_pftnames(58) = 'irrigated_pulses ' + expected_pftnames(59) = 'rapeseed ' + expected_pftnames(60) = 'irrigated_rapeseed ' + expected_pftnames(61) = 'rice ' + expected_pftnames(62) = 'irrigated_rice ' + expected_pftnames(63) = 'sorghum ' + expected_pftnames(64) = 'irrigated_sorghum ' + expected_pftnames(65) = 'sugarbeet ' + expected_pftnames(66) = 'irrigated_sugarbeet ' + expected_pftnames(67) = 'sugarcane ' + expected_pftnames(68) = 'irrigated_sugarcane ' + expected_pftnames(69) = 'sunflower ' + expected_pftnames(70) = 'irrigated_sunflower ' + expected_pftnames(71) = 'miscanthus ' + expected_pftnames(72) = 'irrigated_miscanthus ' + expected_pftnames(73) = 'switchgrass ' + expected_pftnames(74) = 'irrigated_switchgrass ' + expected_pftnames(75) = 'tropical_corn ' + expected_pftnames(76) = 'irrigated_tropical_corn ' + expected_pftnames(77) = 'tropical_soybean ' + expected_pftnames(78) = 'irrigated_tropical_soybean ' + + ! Set specific vegetation type values + + if (masterproc) then + write(iulog,*) 'Attempting to read PFT physiological data .....' + end if + call getfil (paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid, 'pft', dimid) + call ncd_inqdlen(ncid, dimid, npft) + + if (npft - 1 /= mxpft) then + ! NOTE(bja, 201503) need to subtract 1 because of indexing. + ! NOTE(bja, 201503) fail early because one of the io libs + ! throws a useless abort error message deep inside the stack + ! instead of returning readv so we can get a useful line + ! number. + write(msg, '(a, i4, a, i4, a)') "ERROR: The number of pfts in the input netcdf file (", & + npft, ") does not equal the expected number of pfts (", mxpft, "). " + call endrun(msg=trim(msg)//errMsg(__FILE__, __LINE__)) + end if + + call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('z0mr', this%z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('displar', this%displar, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('dleaf', this%dleaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('c3psn', this%c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('rholvis', this%rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('rholnir', this%rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('rhosvis', this%rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('rhosnir', this% rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('taulvis', this%taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('taulnir', this%taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('tausvis', this%taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('tausnir', this%taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('xl', this%xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('roota_par', this%roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('rootb_par', this%rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('slatop', this%slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('dsladlai', this%dsladlai, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('leafcn', this%leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('flnr', this%flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('smpso', this%smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('smpsc', this%smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fnitr', this%fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('woody', this%woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('lflitcn', this%lflitcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('frootcn', this%frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('livewdcn', this%livewdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('deadwdcn', this%deadwdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('grperc', this%grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('grpnow', this%grpnow, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('froot_leaf', this%froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('stem_leaf', this%stem_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('croot_stem', this%croot_stem, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('flivewd', this%flivewd, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fcur', this%fcur, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fcurdv', this%fcurdv, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('lf_flab', this%lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('lf_fcel', this%lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('lf_flig', this%lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fr_flab', this%fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fr_fcel', this%fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fr_flig', this%fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('leaf_long', this%leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('evergreen', this%evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('stress_decid', this%stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pftpar28', this%pftpar28, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pftpar29', this%pftpar29, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pftpar30', this%pftpar30, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pftpar31', this%pftpar31, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fertnitro', this%fertnitro, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fleafcn', this%fleafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('ffrootcn', this%ffrootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fstemcn', this%fstemcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + if (use_vertsoilc) then + call ncd_io('rootprof_beta', this%rootprof_beta, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + end if + + call ncd_io('pconv', this%pconv, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pprod10', this%pprod10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pprodharv10', this%pprodharv10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('pprod100', this%pprod100, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('graincn', this%graincn, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('mxtmp', this%mxtmp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('baset', this%baset, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('declfact', this%declfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('bfact', this%bfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('aleaff', this%aleaff, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('arootf', this%arootf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('astemf', this%astemf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('arooti', this%arooti, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fleafi', this%fleafi, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('allconsl', this%allconsl, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('allconss', this%allconss, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('crop', this%crop, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('mergetoclmpft', this%mergetoclmpft, 'read', ncid, readvar=readv) + if ( .not. readv ) then + call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + end if + + call ncd_io('irrigated', this%irrigated, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('ztopmx', this%ztopmx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('laimx', this%laimx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('gddmin', this%gddmin, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('hybgdd', this%hybgdd, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('lfemerg', this%lfemerg, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('grnfill', this%grnfill, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('mxmat', this%mxmat, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('cc_leaf', this% cc_leaf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('cc_lstem', this%cc_lstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('cc_dstem', this%cc_dstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('cc_other', this%cc_other, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_leaf', this% fm_leaf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_lstem', this%fm_lstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_dstem', this%fm_dstem, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_other', this%fm_other, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_root', this% fm_root, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_lroot', this%fm_lroot, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fm_droot', this%fm_droot, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fsr_pft', this% fsr_pft, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('fd_pft', this% fd_pft, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('planting_temp', this%planttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('min_planting_temp', this%minplanttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('min_NH_planting_date', this%mnNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('min_SH_planting_date', this%mnSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('max_NH_planting_date', this%mxNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + ! + ! Constants + ! + !MV (10-08-14) TODO is this right - used to be numpft - is it okay to set it to mxpft? + do m = 0,mxpft + this%dwood(m) = dwood + if (m <= ntree) then + this%tree(m) = 1 + else + this%tree(m) = 0 + end if + end do + ! + ! clm 5 nitrogen variables + ! + if (use_flexibleCN) then + call ncd_io('i_vc', this%i_vc, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('s_vc', this%s_vc, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('i_vca', this%i_vca, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('s_vca', this%s_vca, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('i_vcad', this%i_vcad, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('s_vcad', this%s_vcad, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('i_flnr', this%i_flnr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + + call ncd_io('s_flnr', this%s_flnr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(__FILE__, __LINE__)) + end if + + ! + ! ED variables + ! + if ( use_ed ) then + ! The following sets the module variable EDpftcon_inst in EDPftcon + call EDpftconrd ( ncid ) + endif + + call ncd_pio_closefile(ncid) + + do i = 0, mxpft + if (.not. use_ed)then + if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then + write(iulog,*)'pftconrd: pftname is NOT what is expected, name = ', & + trim(pftname(i)), ', expected name = ', trim(expected_pftnames(i)) + call endrun(msg='pftconrd: bad name for pft on paramfile dataset'//errMsg(__FILE__, __LINE__)) + end if + end if + + if ( trim(pftname(i)) == 'not_vegetated' ) noveg = i + if ( trim(pftname(i)) == 'needleleaf_evergreen_temperate_tree' ) ndllf_evr_tmp_tree = i + if ( trim(pftname(i)) == 'needleleaf_evergreen_boreal_tree' ) ndllf_evr_brl_tree = i + if ( trim(pftname(i)) == 'needleleaf_deciduous_boreal_tree' ) ndllf_dcd_brl_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_tropical_tree' ) nbrdlf_evr_trp_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_temperate_tree' ) nbrdlf_evr_tmp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_tropical_tree' ) nbrdlf_dcd_trp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_tree' ) nbrdlf_dcd_tmp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_tree' ) nbrdlf_dcd_brl_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_shrub' ) nbrdlf_evr_shrub = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_shrub' ) nbrdlf_dcd_tmp_shrub = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_shrub' ) nbrdlf_dcd_brl_shrub = i + if ( trim(pftname(i)) == 'c3_arctic_grass' ) nc3_arctic_grass = i + if ( trim(pftname(i)) == 'c3_non-arctic_grass' ) nc3_nonarctic_grass = i + if ( trim(pftname(i)) == 'c4_grass' ) nc4_grass = i + if ( trim(pftname(i)) == 'c3_crop' ) nc3crop = i + if ( trim(pftname(i)) == 'c3_irrigated' ) nc3irrig = i + if ( trim(pftname(i)) == 'temperate_corn' ) ntmp_corn = i + if ( trim(pftname(i)) == 'irrigated_temperate_corn' ) nirrig_tmp_corn = i + if ( trim(pftname(i)) == 'spring_wheat' ) nswheat = i + if ( trim(pftname(i)) == 'irrigated_spring_wheat' ) nirrig_swheat = i + if ( trim(pftname(i)) == 'winter_wheat' ) nwwheat = i + if ( trim(pftname(i)) == 'irrigated_winter_wheat' ) nirrig_wwheat = i + if ( trim(pftname(i)) == 'temperate_soybean' ) ntmp_soybean = i + if ( trim(pftname(i)) == 'irrigated_temperate_soybean' ) nirrig_tmp_soybean = i + if ( trim(pftname(i)) == 'barley' ) nbarley = i + if ( trim(pftname(i)) == 'irrigated_barley' ) nirrig_barley = i + if ( trim(pftname(i)) == 'winter_barley' ) nwbarley = i + if ( trim(pftname(i)) == 'irrigated_winter_barley' ) nirrig_wbarley = i + if ( trim(pftname(i)) == 'rye' ) nrye = i + if ( trim(pftname(i)) == 'irrigated_rye' ) nirrig_rye = i + if ( trim(pftname(i)) == 'winter_rye' ) nwrye = i + if ( trim(pftname(i)) == 'irrigated_winter_rye' ) nirrig_wrye = i + if ( trim(pftname(i)) == 'cassava' ) ncassava = i + if ( trim(pftname(i)) == 'irrigated_cassava' ) nirrig_cassava = i + if ( trim(pftname(i)) == 'citrus' ) ncitrus = i + if ( trim(pftname(i)) == 'irrigated_citrus' ) nirrig_citrus = i + if ( trim(pftname(i)) == 'cocoa' ) ncocoa = i + if ( trim(pftname(i)) == 'irrigated_cocoa' ) nirrig_cocoa = i + if ( trim(pftname(i)) == 'coffee' ) ncoffee = i + if ( trim(pftname(i)) == 'irrigated_coffee' ) nirrig_coffee = i + if ( trim(pftname(i)) == 'cotton' ) ncotton = i + if ( trim(pftname(i)) == 'irrigated_cotton' ) nirrig_cotton = i + if ( trim(pftname(i)) == 'datepalm' ) ndatepalm = i + if ( trim(pftname(i)) == 'irrigated_datepalm' ) nirrig_datepalm = i + if ( trim(pftname(i)) == 'foddergrass' ) nfoddergrass = i + if ( trim(pftname(i)) == 'irrigated_foddergrass' ) nirrig_foddergrass = i + if ( trim(pftname(i)) == 'grapes' ) ngrapes = i + if ( trim(pftname(i)) == 'irrigated_grapes' ) nirrig_grapes = i + if ( trim(pftname(i)) == 'groundnuts' ) ngroundnuts = i + if ( trim(pftname(i)) == 'irrigated_groundnuts' ) nirrig_groundnuts = i + if ( trim(pftname(i)) == 'millet' ) nmillet = i + if ( trim(pftname(i)) == 'irrigated_millet' ) nirrig_millet = i + if ( trim(pftname(i)) == 'oilpalm' ) noilpalm = i + if ( trim(pftname(i)) == 'irrigated_oilpalm' ) nirrig_oilpalm = i + if ( trim(pftname(i)) == 'potatoes' ) npotatoes = i + if ( trim(pftname(i)) == 'irrigated_potatoes' ) nirrig_potatoes = i + if ( trim(pftname(i)) == 'pulses' ) npulses = i + if ( trim(pftname(i)) == 'irrigated_pulses' ) nirrig_pulses = i + if ( trim(pftname(i)) == 'rapeseed' ) nrapeseed = i + if ( trim(pftname(i)) == 'irrigated_rapeseed' ) nirrig_rapeseed = i + if ( trim(pftname(i)) == 'rice' ) nrice = i + if ( trim(pftname(i)) == 'irrigated_rice' ) nirrig_rice = i + if ( trim(pftname(i)) == 'sorghum' ) nsorghum = i + if ( trim(pftname(i)) == 'irrigated_sorghum' ) nirrig_sorghum = i + if ( trim(pftname(i)) == 'sugarbeet' ) nsugarbeet = i + if ( trim(pftname(i)) == 'irrigated_sugarbeet' ) nirrig_sugarbeet = i + if ( trim(pftname(i)) == 'sugarcane' ) nsugarcane = i + if ( trim(pftname(i)) == 'irrigated_sugarcane' ) nirrig_sugarcane = i + if ( trim(pftname(i)) == 'sunflower' ) nsunflower = i + if ( trim(pftname(i)) == 'irrigated_sunflower' ) nirrig_sunflower = i + if ( trim(pftname(i)) == 'miscanthus' ) nmiscanthus = i + if ( trim(pftname(i)) == 'irrigated_miscanthus' ) nirrig_miscanthus = i + if ( trim(pftname(i)) == 'switchgrass' ) nswitchgrass = i + if ( trim(pftname(i)) == 'irrigated_switchgrass' ) nirrig_switchgrass = i + if ( trim(pftname(i)) == 'tropical_corn' ) ntrp_corn = i + if ( trim(pftname(i)) == 'irrigated_tropical_corn' ) nirrig_trp_corn = i + if ( trim(pftname(i)) == 'tropical_soybean' ) ntrp_soybean = i + if ( trim(pftname(i)) == 'irrigated_tropical_soybean' ) nirrig_trp_soybean = i + end do + + ntree = nbrdlf_dcd_brl_tree ! value for last type of tree + npcropmin = ntmp_corn ! first prognostic crop + npcropmax = mxpft ! last prognostic crop in list + npcropmaxknown = maxval(this%mergetoclmpft) ! & last one that clm knows how to model + + if (use_cndv) then + this%fcur(:) = this%fcurdv(:) + end if + ! + ! Do some error checking, but not if ED is on. + ! + ! FIX(SPM,032414) double check if some of these should be on... + + if( .not. use_ed ) then + if ( npcropmax /= mxpft )then + call endrun(msg=' ERROR: npcropmax is NOT the last value'//errMsg(__FILE__, __LINE__)) + end if + do i = 0, mxpft + if ( this%irrigated(i) == 1.0_r8 .and. & + (i == nc3irrig .or. & + i == nirrig_tmp_corn .or. & + i == nirrig_swheat .or. i == nirrig_wwheat .or. & + i == nirrig_tmp_soybean .or. & + i == nirrig_barley .or. i == nirrig_wbarley .or. & + i == nirrig_rye .or. i == nirrig_wrye .or. & + i == nirrig_cassava .or. & + i == nirrig_citrus .or. & + i == nirrig_cocoa .or. i == nirrig_coffee .or. & + i == nirrig_cotton .or. & + i == nirrig_datepalm .or. & + i == nirrig_foddergrass .or. & + i == nirrig_grapes .or. i == nirrig_groundnuts .or. & + i == nirrig_millet .or. & + i == nirrig_oilpalm .or. & + i == nirrig_potatoes .or. i == nirrig_pulses .or. & + i == nirrig_rapeseed .or. i == nirrig_rice .or. & + i == nirrig_sorghum .or. & + i == nirrig_sugarbeet .or. i == nirrig_sugarcane .or. & + i == nirrig_sunflower .or. & + i == nirrig_miscanthus .or. i == nirrig_switchgrass .or. & + i == nirrig_trp_corn .or. & + i == nirrig_trp_soybean) )then + ! correct + else if ( this%irrigated(i) == 0.0_r8 )then + ! correct + else + call endrun(msg=' ERROR: irrigated has wrong values'//errMsg(__FILE__, __LINE__)) + end if + if ( this%crop(i) == 1.0_r8 .and. (i >= nc3crop .and. i <= npcropmax) )then + ! correct + else if ( this%crop(i) == 0.0_r8 )then + ! correct + else + call endrun(msg=' ERROR: crop has wrong values'//errMsg(__FILE__, __LINE__)) + end if + if ( (i /= noveg) .and. (i < npcropmin) .and. & + abs(this%pconv(i) + this%pprod10(i) + this%pprod100(i) - 1.0_r8) > 1.e-7_r8 )then + call endrun(msg=' ERROR: pconv+pprod10+pprod100 do NOT sum to one.'//errMsg(__FILE__, __LINE__)) + end if + if ( this%pprodharv10(i) > 1.0_r8 .or. this%pprodharv10(i) < 0.0_r8 )then + call endrun(msg=' ERROR: pprodharv10 outside of range.'//errMsg(__FILE__, __LINE__)) + end if + end do + end if + + if (masterproc) then + write(iulog,*) 'Successfully read PFT physiological data' + write(iulog,*) + end if + + end subroutine InitRead + +end module pftconMod + diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 new file mode 100644 index 0000000000..ffc9f7dfc0 --- /dev/null +++ b/components/clm/src/main/readParamsMod.F90 @@ -0,0 +1,95 @@ +module readParamsMod + + !----------------------------------------------------------------------- + ! + ! Read parameters + ! module used to read parameters for individual modules and/or for some + ! well defined functionality (eg. ED). + ! + ! ! USES: + use clm_varctl , only : paramfile, iulog, use_ed, use_cn + use spmdMod , only : masterproc + use fileutils , only : getfil + use ncdio_pio , only : ncd_pio_closefile, ncd_pio_openfile + use ncdio_pio , only : file_desc_t , ncd_inqdid, ncd_inqdlen + + implicit none + private + ! + public :: readParameters + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParameters (nutrient_competition_method) + ! + ! ! USES: + use EDSharedParamsMod , only : EDParamsReadShared + use EDParamsMod , only : EDParamsRead + use SFParamsMod , only : SFParamsRead + use CNSharedParamsMod , only : CNParamsReadShared + use CNGapMortalityMod , only : readCNGapMortParams => readParams + use CNMRespMod , only : readCNMRespParams => readParams + use CNPhenologyMod , only : readCNPhenolParams => readParams + use SoilBiogeochemCompetitionMod , only : readSoilBiogeochemCompetitionParams => readParams + use SoilBiogeochemNLeachingMod , only : readSoilBiogeochemNLeachingParams => readParams + use SoilBiogeochemNitrifDenitrifMod , only : readSoilBiogeochemNitrifDenitrifParams => readParams + use SoilBiogeochemLittVertTranspMod , only : readSoilBiogeochemLittVertTranspParams => readParams + use SoilBiogeochemPotentialMod , only : readSoilBiogeochemPotentialParams => readParams + use SoilBiogeochemDecompMod , only : readSoilBiogeochemDecompParams => readParams + use SoilBiogeochemDecompCascadeBGCMod , only : readSoilBiogeochemDecompBgcParams => readParams + use SoilBiogeochemDecompCascadeCNMod , only : readSoilBiogeochemDecompCnParams => readParams + use ch4Mod , only : readCH4Params => readParams + use NutrientCompetitionMethodMod , only : nutrient_competition_method_type + ! + ! !ARGUMENTS: + class(nutrient_competition_method_type), intent(in) :: nutrient_competition_method + ! + ! !LOCAL VARIABLES: + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + character(len=32) :: subname = 'readParameters' + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'paramMod.F90::'//trim(subname)//' :: reading ED '//' parameters ' + end if + + call getfil (paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid,'pft',dimid) + call ncd_inqdlen(ncid,dimid,npft) + + if (use_ed) then + call EDParamsReadShared(ncid) + call EDParamsRead(ncid) + call SFParamsRead(ncid) + end if + + if (use_cn) then + call CNParamsReadShared(ncid) + call nutrient_competition_method%readParams(ncid) + call readCNGapMortParams(ncid) + call readCNMRespParams(ncid) + call readCNPhenolParams(ncid) + end if + + call readSoilBiogeochemCompetitionParams(ncid) + call readSoilBiogeochemDecompBgcParams(ncid) + call readSoilBiogeochemDecompCnParams(ncid) + call readSoilBiogeochemDecompParams(ncid) + call readSoilBiogeochemLittVertTranspParams(ncid) + call readSoilBiogeochemNitrifDenitrifParams(ncid) + call readSoilBiogeochemNLeachingParams(ncid) + call readSoilBiogeochemPotentialParams(ncid) + + call readCH4Params (ncid) + + call ncd_pio_closefile(ncid) + + end subroutine readParameters + +end module readParamsMod diff --git a/components/clm/src/main/restFileMod.F90 b/components/clm/src/main/restFileMod.F90 new file mode 100644 index 0000000000..fe5b3c1e0d --- /dev/null +++ b/components/clm/src/main/restFileMod.F90 @@ -0,0 +1,905 @@ +module restFileMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Reads from or writes to/ the CLM restart file. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use spmdMod , only : masterproc, mpicom + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_time_manager , only : timemgr_restart_io, get_nstep + use subgridRestMod , only : SubgridRest, subgridRest_read_cleanup + use accumulMod , only : accumulRest + use clm_instMod , only : clm_instRest + use histFileMod , only : hist_restart_ncd + use clm_varctl , only : create_glacier_mec_landunit, iulog, use_ed + use clm_varcon , only : nameg, namel, namec, namep, nameCohort + use ncdio_pio , only : file_desc_t, ncd_pio_createfile, ncd_pio_openfile, ncd_global + use ncdio_pio , only : ncd_pio_closefile, ncd_defdim, ncd_putatt, ncd_enddef, check_dim + use ncdio_pio , only : check_att, ncd_getatt + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: restFile_read + public :: restFile_write + public :: restFile_open + public :: restFile_close + public :: restFile_getfile + public :: restFile_filename ! Sets restart filename + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: restFile_read_pfile + private :: restFile_write_pfile ! Writes restart pointer file + private :: restFile_closeRestart ! Close restart file and write restart pointer file + private :: restFile_dimset + private :: restFile_add_ilun_metadata ! Add global metadata defining landunit types + private :: restFile_add_icol_metadata ! Add global metadata defining column types + private :: restFile_add_ipft_metadata ! Add global metadata defining patch types + private :: restFile_dimcheck + private :: restFile_enddef + private :: restFile_check_consistency ! Perform consistency checks on the restart file + private :: restFile_read_consistency_nl ! Read namelist associated with consistency checks + private :: restFile_check_fsurdat ! Check consistency of fsurdat on the restart file + private :: restFile_check_year ! Check consistency of year on the restart file + ! + ! !PRIVATE TYPES: None + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine restFile_write( bounds, file, rdate, noptr) + ! + ! !DESCRIPTION: + ! Define/write CLM restart file. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: file ! output netcdf restart file + character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name + logical , intent(in), optional :: noptr ! if should NOT write to the restart pointer file + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + integer :: i ! index + logical :: ptrfile ! write out the restart pointer file + !----------------------------------------------------------------------- + + if ( present(noptr) )then + ptrfile = .not. noptr + else + ptrfile = .true. + end if + + ! Open file + + call restFile_open( flag='write', file=file, ncid=ncid ) + + ! Define dimensions and variables + + call restFile_dimset ( ncid ) + + call timemgr_restart_io(ncid, flag='define') + + call SubgridRest(bounds, ncid, flag='define' ) + + call accumulRest( ncid, flag='define' ) + + call clm_instRest(bounds, ncid, flag='define') + + if (present(rdate)) then + call hist_restart_ncd (bounds, ncid, flag='define', rdate=rdate ) + end if + + call restFile_enddef( ncid ) + + ! Write variables + + call timemgr_restart_io( ncid, flag='write' ) + + call SubgridRest(bounds, ncid, flag='write' ) + + call accumulRest( ncid, flag='write' ) + + call clm_instRest(bounds, ncid, flag='write') + + call hist_restart_ncd (bounds, ncid, flag='write' ) + + ! Close file + + call restFile_close( ncid ) + call restFile_closeRestart( file ) + + ! Write restart pointer file + + if ( ptrfile ) call restFile_write_pfile( file ) + + ! Write out diagnostic info + + if (masterproc) then + write(iulog,*) 'Successfully wrote out restart data at nstep = ',get_nstep() + write(iulog,'(72a1)') ("-",i=1,60) + end if + + end subroutine restFile_write + + !----------------------------------------------------------------------- + subroutine restFile_read( bounds, file ) + ! + ! !DESCRIPTION: + ! Read a CLM restart file. + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + character(len=*) , intent(in) :: file ! output netcdf restart file + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + integer :: i ! index + !----------------------------------------------------------------------- + + ! Open file + + call restFile_open( flag='read', file=file, ncid=ncid ) + + ! Read file + + call restFile_dimcheck( ncid ) + + call SubgridRest(bounds, ncid, flag='read') + + call accumulRest( ncid, flag='read' ) + + call clm_instRest( bounds, ncid, flag='read' ) + + call hist_restart_ncd (bounds, ncid, flag='read' ) + + ! Do error checking on file + + call restFile_check_consistency(bounds, ncid) + + ! Close file + + call subgridRest_read_cleanup + call restFile_close( ncid ) + + ! Write out diagnostic info + + if (masterproc) then + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Successfully read restart data for restart run' + write(iulog,*) + end if + + end subroutine restFile_read + + !----------------------------------------------------------------------- + subroutine restFile_getfile( file, path ) + ! + ! !DESCRIPTION: + ! Determine and obtain netcdf restart file + ! + ! !USES: + use clm_varctl, only : caseid, nrevsn, nsrest, brnch_retain_casename + use clm_varctl, only : nsrContinue, nsrBranch + use fileutils , only : getfil + ! + ! !ARGUMENTS: + character(len=*), intent(out) :: file ! name of netcdf restart file + character(len=*), intent(out) :: path ! full pathname of netcdf restart file + ! + ! !LOCAL VARIABLES: + integer :: status ! return status + integer :: length ! temporary + character(len=256) :: ftest,ctest ! temporaries + !----------------------------------------------------------------------- + + ! Continue run: + ! Restart file pathname is read restart pointer file + + if (nsrest==nsrContinue) then + call restFile_read_pfile( path ) + call getfil( path, file, 0 ) + end if + + ! Branch run: + ! Restart file pathname is obtained from namelist "nrevsn" + ! Check case name consistency (case name must be different for branch run, + ! unless namelist specification states otherwise) + + if (nsrest==nsrBranch) then + length = len_trim(nrevsn) + if (nrevsn(length-2:length) == '.nc') then + path = trim(nrevsn) + else + path = trim(nrevsn) // '.nc' + end if + call getfil( path, file, 0 ) + + ! tcraig, adding xx. and .clm2 makes this more robust + ctest = 'xx.'//trim(caseid)//'.clm2' + ftest = 'xx.'//trim(file) + status = index(trim(ftest),trim(ctest)) + if (status /= 0 .and. .not.(brnch_retain_casename)) then + if (masterproc) then + write(iulog,*) 'Must change case name on branch run if ',& + 'brnch_retain_casename namelist is not set' + write(iulog,*) 'previous case filename= ',trim(file),& + ' current case = ',trim(caseid), & + ' ctest = ',trim(ctest), & + ' ftest = ',trim(ftest) + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + end subroutine restFile_getfile + + !----------------------------------------------------------------------- + subroutine restFile_read_pfile( pnamer ) + ! + ! !DESCRIPTION: + ! Setup restart file and perform necessary consistency checks + ! + ! !USES: + use fileutils , only : opnfil, getavu, relavu + use clm_varctl, only : rpntfil, rpntdir, inst_suffix + ! + ! !ARGUMENTS: + character(len=*), intent(out) :: pnamer ! full path of restart file + ! + ! !LOCAL VARIABLES: + !EOP + integer :: i ! indices + integer :: nio ! restart unit + integer :: status ! substring check status + character(len=256) :: locfn ! Restart pointer file name + !----------------------------------------------------------------------- + + ! Obtain the restart file from the restart pointer file. + ! For restart runs, the restart pointer file contains the full pathname + ! of the restart file. For branch runs, the namelist variable + ! [nrevsn] contains the full pathname of the restart file. + ! New history files are always created for branch runs. + + if (masterproc) then + write(iulog,*) 'Reading restart pointer file....' + endif + + nio = getavu() + locfn = trim(rpntdir) //'/'// trim(rpntfil)//trim(inst_suffix) + call opnfil (locfn, nio, 'f') + read (nio,'(a256)') pnamer + call relavu (nio) + + if (masterproc) then + write(iulog,*) 'Reading restart data.....' + write(iulog,'(72a1)') ("-",i=1,60) + end if + + end subroutine restFile_read_pfile + + !----------------------------------------------------------------------- + subroutine restFile_closeRestart( file ) + ! + ! !DESCRIPTION: + ! 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 + ! + ! !CALLED FROM: + ! subroutine restart in this module + ! + ! !REVISION HISTORY: + ! Author: Mariana Vertenstein + ! + ! + ! !LOCAL VARIABLES: + !EOP + integer :: i !index + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Successfully wrote local restart file ',trim(file) + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) + end if + + end subroutine restFile_closeRestart + + !----------------------------------------------------------------------- + subroutine restFile_write_pfile( fnamer ) + ! + ! !DESCRIPTION: + ! Open restart pointer file. Write names of current netcdf restart file. + ! + ! !USES: + use clm_varctl, only : rpntdir, rpntfil, inst_suffix + use fileutils , only : relavu + use fileutils , only : getavu, opnfil + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fnamer + ! + ! !LOCAL VARIABLES: + integer :: m ! index + integer :: nio ! restart pointer file + character(len=256) :: filename ! local file name + !----------------------------------------------------------------------- + + if (masterproc) then + nio = getavu() + filename= trim(rpntdir) //'/'// trim(rpntfil)//trim(inst_suffix) + call opnfil( filename, nio, 'f' ) + + write(nio,'(a)') fnamer + call relavu( nio ) + write(iulog,*)'Successfully wrote local restart pointer file' + end if + + end subroutine restFile_write_pfile + + !----------------------------------------------------------------------- + subroutine restFile_open( flag, file, ncid ) + + use clm_time_manager, only : get_nstep + + character(len=*), intent(in) :: flag ! flag to specify read or write + character(len=*), intent(in) :: file ! filename + type(file_desc_t), intent(out):: ncid ! netcdf id + + integer :: omode ! netCDF dummy variable + character(len= 32) :: subname='restFile_open' ! subroutine name + + if (flag == 'write') then + + ! Create new netCDF file (in define mode) and set fill mode + ! to "no fill" to optimize performance + + if (masterproc) then + write(iulog,*) + write(iulog,*)'restFile_open: writing restart dataset at ',& + trim(file), ' at nstep = ',get_nstep() + write(iulog,*) + end if + call ncd_pio_createfile(ncid, trim(file)) + + else if (flag == 'read') then + + ! Open netcdf restart file + + if (masterproc) then + write(iulog,*) 'Reading restart dataset' + end if + call ncd_pio_openfile (ncid, trim(file), 0) + + end if + + end subroutine restFile_open + + !----------------------------------------------------------------------- + character(len=256) function restFile_filename( rdate ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use clm_varctl, only : caseid, inst_suffix + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: rdate ! input date for restart file name + !----------------------------------------------------------------------- + + restFile_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".r."//trim(rdate)//".nc" + if (masterproc) then + write(iulog,*)'writing restart file ',trim(restFile_filename),' for model date = ',rdate + end if + + end function restFile_filename + + !------------------------------------------------------------------------ + subroutine restFile_dimset( ncid ) + ! + ! !DESCRIPTION: + ! Read/Write initial data from/to netCDF instantaneous initial data file + ! + ! !USES: + use clm_time_manager , only : get_nstep + use clm_varctl , only : caseid, ctitle, version, username, hostname, fsurdat + use clm_varctl , only : conventions, source + use dynSubgridControlMod , only : get_flanduse_timeseries + use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevurb, nlevcan + use clm_varpar , only : cft_lb, cft_ub, maxpatch_glcmec + use decompMod , only : get_proc_global + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid + ! + ! !LOCAL VARIABLES: + integer :: dimid ! netCDF dimension id + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: numCohort ! total number of cohorts across all processors + integer :: ier ! error status + integer :: strlen_dimid ! string dimension id + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len=256) :: str + character(len= 32) :: subname='restFile_dimset' ! subroutine name + !------------------------------------------------------------------------ + + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort) + + ! Define dimensions + + call ncd_defdim(ncid , nameg , numg , dimid) + call ncd_defdim(ncid , namel , numl , dimid) + call ncd_defdim(ncid , namec , numc , dimid) + call ncd_defdim(ncid , namep , nump , dimid) + call ncd_defdim(ncid , nameCohort , numCohort , dimid) + + call ncd_defdim(ncid , 'levgrnd' , nlevgrnd , dimid) + call ncd_defdim(ncid , 'levurb' , nlevurb , dimid) + call ncd_defdim(ncid , 'levlak' , nlevlak , dimid) + call ncd_defdim(ncid , 'levsno' , nlevsno , dimid) + call ncd_defdim(ncid , 'levsno1' , nlevsno+1 , dimid) + call ncd_defdim(ncid , 'levtot' , nlevsno+nlevgrnd, dimid) + call ncd_defdim(ncid , 'numrad' , numrad , dimid) + call ncd_defdim(ncid , 'levcan' , nlevcan , dimid) + call ncd_defdim(ncid , 'string_length', 64 , dimid) + if (create_glacier_mec_landunit) then + call ncd_defdim(ncid , 'glc_nec', maxpatch_glcmec, dimid) + end if + + ! Define global attributes + + call ncd_putatt(ncid, NCD_GLOBAL, 'Conventions', trim(conventions)) + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(ncid, NCD_GLOBAL, 'history' , trim(str)) + call ncd_putatt(ncid, NCD_GLOBAL, 'username', trim(username)) + call ncd_putatt(ncid, NCD_GLOBAL, 'host' , trim(hostname)) + call ncd_putatt(ncid, NCD_GLOBAL, 'version' , trim(version)) + call ncd_putatt(ncid, NCD_GLOBAL, 'source' , trim(source)) + str = '$Id: restFileMod.F90 41292 2012-10-26 13:51:45Z erik $' + call ncd_putatt(ncid, NCD_GLOBAL, 'revision_id' , trim(str)) + call ncd_putatt(ncid, NCD_GLOBAL, 'case_title' , trim(ctitle)) + call ncd_putatt(ncid, NCD_GLOBAL, 'case_id' , trim(caseid)) + call ncd_putatt(ncid, NCD_GLOBAL, 'surface_dataset', trim(fsurdat)) + call ncd_putatt(ncid, NCD_GLOBAL, 'flanduse_timeseries', trim(get_flanduse_timeseries())) + call ncd_putatt(ncid, NCD_GLOBAL, 'title', 'CLM Restart information') + if (create_glacier_mec_landunit) then + call ncd_putatt(ncid, ncd_global, 'created_glacier_mec_landunits', 'true') + else + call ncd_putatt(ncid, ncd_global, 'created_glacier_mec_landunits', 'false') + end if + + call restFile_add_ipft_metadata(ncid) + call restFile_add_icol_metadata(ncid) + call restFile_add_ilun_metadata(ncid) + + end subroutine restFile_dimset + + !----------------------------------------------------------------------- + subroutine restFile_add_ilun_metadata(ncid) + ! + ! !DESCRIPTION: + ! Add global metadata defining landunit types + ! + ! !USES: + use landunit_varcon, only : max_lunit, landunit_names, landunit_name_length + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid ! local file id + ! + ! !LOCAL VARIABLES: + integer :: ltype ! landunit type + character(len=*), parameter :: att_prefix = 'ilun_' ! prefix for attributes + character(len=len(att_prefix)+landunit_name_length) :: attname ! attribute name + + character(len=*), parameter :: subname = 'restFile_add_ilun_metadata' + !----------------------------------------------------------------------- + + do ltype = 1, max_lunit + attname = att_prefix // landunit_names(ltype) + call ncd_putatt(ncid, ncd_global, attname, ltype) + end do + + end subroutine restFile_add_ilun_metadata + + !----------------------------------------------------------------------- + subroutine restFile_add_icol_metadata(ncid) + ! + ! !DESCRIPTION: + ! Add global metadata defining column types + ! + ! !USES: + use column_varcon, only : icol_roof, icol_sunwall, icol_shadewall, icol_road_imperv, icol_road_perv + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid ! local file id + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: att_prefix = 'icol_' ! prefix for attributes + + character(len=*), parameter :: subname = 'restFile_add_icol_metadata' + !----------------------------------------------------------------------- + + ! Unlike ilun and ipft, the column names currently do not exist in column_varcon. + ! This is partly because of the trickiness of encoding column values for crop & + ! icemec. + + call ncd_putatt(ncid, ncd_global, att_prefix // 'vegetated_or_bare_soil', 1) + call ncd_putatt(ncid, ncd_global, att_prefix // 'crop' , 2) + call ncd_putatt(ncid, ncd_global, att_prefix // 'crop_noncompete' , '2*100+m, m=cft_lb,cft_ub') + call ncd_putatt(ncid, ncd_global, att_prefix // 'landice' , 3) + call ncd_putatt(ncid, ncd_global, att_prefix // 'landice_multiple_elevation_classes', '4*100+m, m=1,glcnec') + call ncd_putatt(ncid, ncd_global, att_prefix // 'deep_lake' , 5) + call ncd_putatt(ncid, ncd_global, att_prefix // 'wetland' , 6) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_roof' , icol_roof) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_sunwall' , icol_sunwall) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_shadewall' , icol_shadewall) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_impervious_road' , icol_road_imperv) + call ncd_putatt(ncid, ncd_global, att_prefix // 'urban_pervious_road' , icol_road_perv) + + end subroutine restFile_add_icol_metadata + + !----------------------------------------------------------------------- + subroutine restFile_add_ipft_metadata(ncid) + ! + ! !DESCRIPTION: + ! Add global metadata defining patch types + ! + ! !USES: + use clm_varpar, only : natpft_lb, mxpft, cft_lb, cft_ub + use pftconMod , only : pftname_len, pftname + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid ! local file id + ! + ! !LOCAL VARIABLES: + integer :: ptype ! patch type + character(len=*), parameter :: att_prefix = 'ipft_' ! prefix for attributes + character(len=len(att_prefix)+pftname_len) :: attname ! attribute name + + character(len=*), parameter :: subname = 'restFile_add_ipft_metadata' + !----------------------------------------------------------------------- + + do ptype = natpft_lb, mxpft + attname = att_prefix // pftname(ptype) + call ncd_putatt(ncid, ncd_global, attname, ptype) + end do + + call ncd_putatt(ncid, ncd_global, 'cft_lb', cft_lb) + call ncd_putatt(ncid, ncd_global, 'cft_ub', cft_ub) + + end subroutine restFile_add_ipft_metadata + + !----------------------------------------------------------------------- + subroutine restFile_dimcheck( ncid ) + ! + ! !DESCRIPTION: + ! Check dimensions of restart file + ! + ! !USES: + use decompMod, only : get_proc_global + use clm_varpar, only : nlevsno, nlevlak, nlevgrnd, nlevurb + use clm_varctl, only : single_column, nsrest, nsrStartup + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid + ! + ! !LOCAL VARIABLES: + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: numCohort ! total number of cohorts across all processors + character(len=32) :: subname='restFile_dimcheck' ! subroutine name + !----------------------------------------------------------------------- + + ! Get relevant sizes + + if ( .not. single_column .or. nsrest /= nsrStartup )then + call get_proc_global(ng=numg, nl=numl, nc=numc, np=nump, nCohorts=numCohort) + call check_dim(ncid, nameg, numg) + call check_dim(ncid, namel, numl) + call check_dim(ncid, namec, numc) + call check_dim(ncid, namep, nump) + if ( use_ed ) call check_dim(ncid, nameCohort , numCohort) + end if + call check_dim(ncid, 'levsno' , nlevsno) + call check_dim(ncid, 'levgrnd' , nlevgrnd) + call check_dim(ncid, 'levurb' , nlevurb) + call check_dim(ncid, 'levlak' , nlevlak) + + end subroutine restFile_dimcheck + + !----------------------------------------------------------------------- + subroutine restFile_enddef( ncid ) + ! + ! !DESCRIPTION: + ! Read a CLM restart file. + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid + !----------------------------------------------------------------------- + + call ncd_enddef(ncid) + + end subroutine restFile_enddef + + !----------------------------------------------------------------------- + subroutine restFile_close( ncid ) + ! + ! !DESCRIPTION: + ! Read a CLM restart file. + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname='restFile_close' ! subroutine name + !----------------------------------------------------------------------- + + call ncd_pio_closefile(ncid) + + end subroutine restFile_close + + !----------------------------------------------------------------------- + subroutine restFile_check_consistency(bounds, ncid) + ! + ! !DESCRIPTION: + ! Perform some consistency checks on the restart file + ! + ! !USES: + use subgridRestMod, only : subgridRest_check_consistency + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + type(file_desc_t), intent(inout) :: ncid ! netcdf id + ! + ! !LOCAL VARIABLES: + logical :: check_finidat_fsurdat_consistency ! whether to check consistency between fsurdat on finidat file and current fsurdat + logical :: check_finidat_year_consistency ! whether to check consistency between year on finidat file and current year + logical :: check_finidat_pct_consistency ! whether to check consistency between pct_pft on finidat file and surface dataset + + character(len=*), parameter :: subname = 'restFile_check_consistency' + !----------------------------------------------------------------------- + + call restFile_read_consistency_nl( & + check_finidat_fsurdat_consistency, & + check_finidat_year_consistency, & + check_finidat_pct_consistency) + + if (check_finidat_fsurdat_consistency) then + call restFile_check_fsurdat(ncid) + end if + + if (check_finidat_year_consistency) then + call restFile_check_year(ncid) + end if + + if (check_finidat_pct_consistency) then + call subgridRest_check_consistency(bounds) + end if + + end subroutine restFile_check_consistency + + !----------------------------------------------------------------------- + subroutine restFile_read_consistency_nl( & + check_finidat_fsurdat_consistency, & + check_finidat_year_consistency, & + check_finidat_pct_consistency) + + ! + ! !DESCRIPTION: + ! Read namelist settings related to finidat consistency checks + ! + ! !USES: + use fileutils , only : getavu, relavu + use clm_nlUtilsMod , only : find_nlgroup_name + use controlMod , only : NLFilename + use shr_mpi_mod , only : shr_mpi_bcast + ! + ! !ARGUMENTS: + logical, intent(out) :: check_finidat_fsurdat_consistency + logical, intent(out) :: check_finidat_year_consistency + logical, intent(out) :: check_finidat_pct_consistency + ! + ! !LOCAL VARIABLES: + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + + character(len=*), parameter :: subname = 'restFile_read_consistency_nl' + !----------------------------------------------------------------------- + + namelist /finidat_consistency_checks/ & + check_finidat_fsurdat_consistency, & + check_finidat_year_consistency, & + check_finidat_pct_consistency + + ! Set default namelist values + check_finidat_fsurdat_consistency = .true. + check_finidat_year_consistency = .true. + check_finidat_pct_consistency = .true. + + ! Read namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call find_nlgroup_name(nu_nml, 'finidat_consistency_checks', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=finidat_consistency_checks,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg='ERROR reading finidat_consistency_checks namelist'//errMsg(__FILE__, __LINE__)) + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast (check_finidat_fsurdat_consistency, mpicom) + call shr_mpi_bcast (check_finidat_year_consistency, mpicom) + call shr_mpi_bcast (check_finidat_pct_consistency, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'finidat_consistency_checks settings:' + write(iulog,nml=finidat_consistency_checks) + write(iulog,*) ' ' + end if + + end subroutine restFile_read_consistency_nl + + !----------------------------------------------------------------------- + subroutine restFile_check_fsurdat(ncid) + ! + ! !DESCRIPTION: + ! Check consistency of the fsurdat value on the restart file and the current fsurdat + ! + ! !USES: + use fileutils , only : get_filename + use clm_varctl , only : fname_len, fsurdat + use dynSubgridControlMod , only : get_flanduse_timeseries + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid ! netcdf id + ! + ! !LOCAL VARIABLES: + character(len=fname_len) :: fsurdat_rest ! fsurdat from the restart file (includes full path) + character(len=fname_len) :: filename_cur ! current fsurdat file name + character(len=fname_len) :: filename_rest ! fsurdat file name from restart file (does NOT include full path) + + character(len=*), parameter :: subname = 'restFile_check_fsurdat' + !----------------------------------------------------------------------- + + ! Only do this check for a transient run. The problem with doing this check for a non- + ! transient run is the transition from transient to non-transient: It is legitimate to + ! run with an 1850 surface dataset and a pftdyn file, then use the restart file from + ! that run to start a present-day (non-transient) run, which would use a 2000 surface + ! dataset. + if (get_flanduse_timeseries() /= ' ') then + call ncd_getatt(ncid, NCD_GLOBAL, 'surface_dataset', fsurdat_rest) + + ! Compare file names, ignoring path + filename_cur = get_filename(fsurdat) + filename_rest = get_filename(fsurdat_rest) + + if (filename_rest /= filename_cur) then + if (masterproc) then + write(iulog,*) 'ERROR: Initial conditions file (finidat) was generated from a different surface dataset' + write(iulog,*) 'than the one being used for the current simulation (fsurdat).' + write(iulog,*) 'Current fsurdat: ', trim(filename_cur) + write(iulog,*) 'Surface dataset used to generate initial conditions file: ', trim(filename_rest) + write(iulog,*) + write(iulog,*) 'Possible solutions to this problem:' + write(iulog,*) '(1) Make sure you are using the correct surface dataset and initial conditions file' + write(iulog,*) '(2) If you generated the surface dataset and/or initial conditions file yourself,' + write(iulog,*) ' then you may need to manually change the surface_dataset global attribute on the' + write(iulog,*) ' initial conditions file (e.g., using ncatted)' + write(iulog,*) '(3) If you are confident that you are using the correct surface dataset and initial conditions file,' + write(iulog,*) ' yet are still experiencing this error, then you can bypass this check by setting:' + write(iulog,*) ' check_finidat_fsurdat_consistency = .false.' + write(iulog,*) ' in user_nl_clm' + write(iulog,*) ' ' + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + end if + + end subroutine restFile_check_fsurdat + + !----------------------------------------------------------------------- + subroutine restFile_check_year(ncid) + ! + ! !DESCRIPTION: + ! Make sure year on the restart file is consistent with the current model year + ! + ! !USES: + use clm_time_manager , only : get_curr_date, get_rest_date + use clm_varctl , only : fname_len + use dynSubgridControlMod , only : get_flanduse_timeseries + ! + ! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid ! netcdf id + ! + ! !LOCAL VARIABLES: + logical :: att_found ! whether the attribute was found on the netcdf file + character(len=fname_len) :: flanduse_timeseries_rest ! flanduse_timeseries from the restart file + integer :: year ! current model year + integer :: mon ! current model month + integer :: day ! current model day of month + integer :: tod ! current model time of day + integer :: rest_year ! year from restart file + + character(len=*), parameter :: subname = 'restFile_check_year' + !----------------------------------------------------------------------- + + ! Only do this check for a transient run + if (get_flanduse_timeseries() /= ' ') then + ! Determine if the restart file was generated from a transient run; if so, we will + ! do this consistency check. For backwards compatibility, we allow for the + ! possibility that the flanduse_timeseries attribute was not on the restart file; + ! in that case, we act as if the restart file was generated from a non-transient + ! run, thus skipping this check. + call check_att(ncid, NCD_GLOBAL, 'flanduse_timeseries', att_found) + if (att_found) then + call ncd_getatt(ncid, NCD_GLOBAL, 'flanduse_timeseries', flanduse_timeseries_rest) + else + write(iulog,*) ' ' + write(iulog,*) subname//' WARNING: flanduse_timeseries attribute not found on restart file' + write(iulog,*) 'Assuming that the restart file was generated from a non-transient run,' + write(iulog,*) 'and thus skipping the year check' + write(iulog,*) ' ' + + flanduse_timeseries_rest = ' ' + end if + + ! If the restart file was generated from a transient run, then confirm that the + ! year of the restart file matches the current model year. + if (flanduse_timeseries_rest /= ' ') then + call get_curr_date(year, mon, day, tod) + call get_rest_date(ncid, rest_year) + if (year /= rest_year) then + if (masterproc) then + write(iulog,*) 'ERROR: Current model year does not match year on initial conditions file (finidat)' + write(iulog,*) 'Current year: ', year + write(iulog,*) 'Year on initial conditions file: ', rest_year + write(iulog,*) ' ' + write(iulog,*) 'This match is a requirement when both:' + write(iulog,*) '(a) The current run is a transient run, and' + write(iulog,*) '(b) The initial conditions file was generated from a transient run' + write(iulog,*) ' ' + write(iulog,*) 'Possible solutions to this problem:' + write(iulog,*) '(1) Make sure RUN_STARTDATE is set correctly' + write(iulog,*) '(2) Make sure you are using the correct initial conditions file (finidat)' + write(iulog,*) '(3) If you are confident that you are using the correct start date and initial conditions file,' + write(iulog,*) ' yet are still experiencing this error, then you can bypass this check by setting:' + write(iulog,*) ' check_finidat_year_consistency = .false.' + write(iulog,*) ' in user_nl_clm' + write(iulog,*) ' ' + end if + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if ! year /= rest_year + end if ! flanduse_timeseries_rest /= ' ' + end if ! fpftdyn /= ' ' + + end subroutine restFile_check_year + +end module restFileMod + + + diff --git a/components/clm/src/main/reweightMod.F90 b/components/clm/src/main/reweightMod.F90 new file mode 100644 index 0000000000..1e7ae9778d --- /dev/null +++ b/components/clm/src/main/reweightMod.F90 @@ -0,0 +1,57 @@ +module reweightMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Top level driver for things that happen when subgrid weights are changed. This is in + ! a separate module from subgridWeightsMod in order to keep subgridWeightsMod lower- + ! level - and particularly to break its dependency on filterMod. + ! + ! + ! !USES: +#include "shr_assert.h" + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + ! + ! PUBLIC TYPES: + implicit none + save + + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: reweight_wrapup ! do modifications and error-checks after modifying subgrid weights + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine reweight_wrapup(bounds, icemask_grc) + ! + ! !DESCRIPTION: + ! Do additional modifications and error-checks that should be done after modifying subgrid + ! weights + ! + ! This should be called whenever any weights change (e.g., patch weights on the column, + ! landunit weights on the grid cell, etc.). + ! + ! !USES: + use filterMod , only : setFilters + use subgridWeightsMod , only : set_active, check_weights + use decompMod , only : bounds_type, BOUNDS_LEVEL_CLUMP + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! clump bounds + real(r8) , intent(in) :: icemask_grc( bounds%begg: ) ! ice sheet grid coverage mask [gridcell] + !------------------------------------------------------------------------ + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_CLUMP, errMsg(__FILE__, __LINE__)) + + call set_active(bounds) + call check_weights(bounds, active_only=.false.) + call check_weights(bounds, active_only=.true.) + call setFilters(bounds, icemask_grc(bounds%begg:bounds%endg)) + + end subroutine reweight_wrapup + +end module reweightMod diff --git a/components/clm/src/main/subgridAveMod.F90 b/components/clm/src/main/subgridAveMod.F90 new file mode 100644 index 0000000000..154cb91afb --- /dev/null +++ b/components/clm/src/main/subgridAveMod.F90 @@ -0,0 +1,1320 @@ +module subgridAveMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Utilities to perfrom subgrid averaging + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use column_varcon , only : icol_road_perv , icol_road_imperv + use clm_varcon , only : grlnd, nameg, namel, namec, namep,spval + use clm_varctl , only : iulog + use abortutils , only : endrun + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: p2c ! Perform an average patches to columns + public :: p2l ! Perform an average patches to landunits + public :: p2g ! Perform an average patches to gridcells + public :: c2l ! Perform an average columns to landunits + public :: c2g ! Perform an average columns to gridcells + public :: l2g ! Perform an average landunits to gridcells + + interface p2c + module procedure p2c_1d + module procedure p2c_2d + module procedure p2c_1d_filter + module procedure p2c_2d_filter + end interface + interface p2l + module procedure p2l_1d + module procedure p2l_2d + end interface + interface p2g + module procedure p2g_1d + module procedure p2g_2d + end interface + interface c2l + module procedure c2l_1d + module procedure c2l_2d + end interface + interface c2g + module procedure c2g_1d + module procedure c2g_2d + end interface + interface l2g + module procedure l2g_1d + module procedure l2g_2d + end interface + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: build_scale_l2g + private :: create_scale_l2g_lookup + + ! WJS (10-14-11): TODO: + ! + ! - I believe that scale_p2c, scale_c2l and scale_l2g should be included in the sumwt + ! accumulations (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but + ! that requires some more thought to (1) make sure that is correct, and (2) make sure it + ! doesn't break the urban scaling. (See also my notes in create_scale_l2g_lookup.) + ! - Once that is done, you could use a scale of 0, avoiding the need for the use of + ! spval and the special checks that requires. + ! + ! - Currently, there is a lot of repeated code to calculate scale_c2l. This should be + ! cleaned up. + ! - At a minimum, should collect the repeated code into a subroutine to eliminate this + ! repitition + ! - The best thing might be to use a lookup array, as is done for scale_l2g + ! ----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine p2c_1d (bounds, parr, carr, p2c_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to columns. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: parr( bounds%begp: ) ! patch array + real(r8), intent(out) :: carr( bounds%begc: ) ! column array + character(len=*), intent(in) :: p2c_scale_type ! scale type + ! + ! !LOCAL VARIABLES: + integer :: p,c,index ! indices + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + carr(bounds%begc:bounds%endc) = spval + sumwt(bounds%begc:bounds%endc) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then + if (parr(p) /= spval) then + c = patch%column(p) + if (sumwt(c) == 0._r8) carr(c) = 0._r8 + carr(c) = carr(c) + parr(p) * scale_p2c(p) * patch%wtcol(p) + sumwt(c) = sumwt(c) + patch%wtcol(p) + end if + end if + end do + found = .false. + do c = bounds%begc,bounds%endc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c) = carr(c)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c_1d error: sumwt is greater than 1.0' + call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine p2c_1d + + !----------------------------------------------------------------------- + subroutine p2c_2d (bounds, num2d, parr, carr, p2c_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from landunits to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8) , intent(in) :: parr( bounds%begp: , 1: ) ! patch array + real(r8) , intent(out) :: carr( bounds%begc: , 1: ) ! column array + character(len=*) , intent(in) :: p2c_scale_type ! scale type + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,index ! indices + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begc:bounds%endc) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(__FILE__, __LINE__)) + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + carr(bounds%begc : bounds%endc, :) = spval + do j = 1,num2d + sumwt(bounds%begc : bounds%endc) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtcol(p) /= 0._r8) then + if (parr(p,j) /= spval) then + c = patch%column(p) + if (sumwt(c) == 0._r8) carr(c,j) = 0._r8 + carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * patch%wtcol(p) + sumwt(c) = sumwt(c) + patch%wtcol(p) + end if + end if + end do + found = .false. + do c = bounds%begc,bounds%endc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c,j) = carr(c,j)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c_2d error: sumwt is greater than 1.0 at c= ',index,' lev= ',j + call endrun(decomp_index=index, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + end do + end subroutine p2c_2d + + !----------------------------------------------------------------------- + subroutine p2c_1d_filter (bounds, numfc, filterc, patcharr, colarr) + ! + ! !DESCRIPTION: + ! perform patch to column averaging for single level patch arrays + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), intent(in) :: patcharr( bounds%begp: ) + real(r8), intent(out) :: colarr( bounds%begc: ) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,p ! indices + !----------------------------------------------------------------------- + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(patcharr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(colarr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + + do fc = 1,numfc + c = filterc(fc) + colarr(c) = 0._r8 + do p = col%patchi(c), col%patchf(c) + if (patch%active(p)) colarr(c) = colarr(c) + patcharr(p) * patch%wtcol(p) + end do + end do + + end subroutine p2c_1d_filter + + !----------------------------------------------------------------------- + subroutine p2c_2d_filter (lev, numfc, filterc, patcharr, colarr) + ! + ! !DESCRIPTION: + ! perform patch to column averaging for multi level patch arrays + ! + ! !ARGUMENTS: + integer , intent(in) :: lev + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), pointer :: patcharr(:,:) + real(r8), pointer :: colarr(:,:) + ! + ! !LOCAL VARIABLES: + integer :: fc,c,p,j ! indices + !----------------------------------------------------------------------- + + do j = 1,lev + do fc = 1,numfc + c = filterc(fc) + colarr(c,j) = 0._r8 + do p = col%patchi(c), col%patchf(c) + if (patch%active(p)) colarr(c,j) = colarr(c,j) + patcharr(p,j) * patch%wtcol(p) + end do + end do + end do + + end subroutine p2c_2d_filter + + !----------------------------------------------------------------------- + subroutine p2l_1d (bounds, parr, larr, p2c_scale_type, c2l_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to landunits + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: parr( bounds%begp: ) ! input column array + real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights + real(r8) :: scale_p2c(bounds%begc:bounds%endc) ! scale factor for patch->column mapping + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2l_1d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + larr(bounds%begl : bounds%endl) = spval + sumwt(bounds%begl : bounds%endl) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then + c = patch%column(p) + if (parr(p) /= spval .and. scale_c2l(c) /= spval) then + l = patch%landunit(p) + if (sumwt(l) == 0._r8) larr(l) = 0._r8 + larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p) + sumwt(l) = sumwt(l) + patch%wtlunit(p) + end if + end if + end do + found = .false. + do l = bounds%begl,bounds%endl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l) = larr(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'p2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine p2l_1d + + !----------------------------------------------------------------------- + subroutine p2l_2d(bounds, num2d, parr, larr, p2c_scale_type, c2l_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to landunits + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array + real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights + real(r8) :: scale_p2c(bounds%begc:bounds%endc) ! scale factor for patch->column mapping + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(__FILE__, __LINE__)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2l_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2l_2d error: scale type ',p2c_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + larr(bounds%begl : bounds%endl, :) = spval + do j = 1,num2d + sumwt(bounds%begl : bounds%endl) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtlunit(p) /= 0._r8) then + c = patch%column(p) + if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then + l = patch%landunit(p) + if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 + larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * patch%wtlunit(p) + sumwt(l) = sumwt(l) + patch%wtlunit(p) + end if + end if + end do + found = .false. + do l = bounds%begl,bounds%endl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l,j) = larr(l,j)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'p2l_2d error: sumwt is greater than 1.0 at l= ',index,' j= ',j + call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine p2l_2d + + !----------------------------------------------------------------------- + subroutine p2g_1d(bounds, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: parr( bounds%begp: ) ! input patch array + real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + garr(bounds%begg : bounds%endg) = spval + sumwt(bounds%begg : bounds%endg) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then + c = patch%column(p) + l = patch%landunit(p) + if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = patch%gridcell(p) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) + sumwt(g) = sumwt(g) + patch%wtgcell(p) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine p2g_1d + + !----------------------------------------------------------------------- + subroutine p2g_2d(bounds, num2d, parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from patches to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr( bounds%begp: , 1: ) ! input patch array + real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(bounds%begp:bounds%endp) ! scale factor + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(parr) == (/bounds%endp, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + if (p2c_scale_type == 'unity') then + do p = bounds%begp,bounds%endp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + garr(bounds%begg : bounds%endg, :) = spval + do j = 1,num2d + sumwt(bounds%begg : bounds%endg) = 0._r8 + do p = bounds%begp,bounds%endp + if (patch%active(p) .and. patch%wtgcell(p) /= 0._r8) then + c = patch%column(p) + l = patch%landunit(p) + if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = patch%gridcell(p) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * patch%wtgcell(p) + sumwt(g) = sumwt(g) + patch%wtgcell(p) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index) + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine p2g_2d + + !----------------------------------------------------------------------- + subroutine c2l_1d (bounds, carr, larr, c2l_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to landunits + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: carr( bounds%begc: ) ! input column array + real(r8), intent(out) :: larr( bounds%begl: ) ! output landunit array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: c,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping + real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + larr(bounds%begl : bounds%endl) = spval + sumwt(bounds%begl : bounds%endl) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtlunit(c) /= 0._r8) then + if (carr(c) /= spval .and. scale_c2l(c) /= spval) then + l = col%landunit(c) + if (sumwt(l) == 0._r8) larr(l) = 0._r8 + larr(l) = larr(l) + carr(c) * scale_c2l(c) * col%wtlunit(c) + sumwt(l) = sumwt(l) + col%wtlunit(c) + end if + end if + end do + found = .false. + do l = bounds%begl,bounds%endl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l) = larr(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'c2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine c2l_1d + + !----------------------------------------------------------------------- + subroutine c2l_2d (bounds, num2d, carr, larr, c2l_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to landunits + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array + real(r8), intent(out) :: larr( bounds%begl: , 1: ) ! output landunit array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,l,c,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor for column->landunit mapping + real(r8) :: sumwt(bounds%begl:bounds%endl) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(__FILE__, __LINE__)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + larr(bounds%begl : bounds%endl, :) = spval + do j = 1,num2d + sumwt(bounds%begl : bounds%endl) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtlunit(c) /= 0._r8) then + if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then + l = col%landunit(c) + if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 + larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * col%wtlunit(c) + sumwt(l) = sumwt(l) + col%wtlunit(c) + end if + end if + end do + found = .false. + do l = bounds%begl,bounds%endl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l,j) = larr(l,j)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'c2l_2d error: sumwt is greater than 1.0 at l= ',index,' lev= ',j + call endrun(decomp_index=index, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine c2l_2d + + !----------------------------------------------------------------------- + subroutine c2g_1d(bounds, carr, garr, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: carr( bounds%begc: ) ! input column array + real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + garr(bounds%begg : bounds%endg) = spval + sumwt(bounds%begg : bounds%endg) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then + l = col%landunit(c) + if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = col%gridcell(c) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) + sumwt(g) = sumwt(g) + col%wtgcell(c) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine c2g_1d + + !----------------------------------------------------------------------- + subroutine c2g_2d(bounds, num2d, carr, garr, c2l_scale_type, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from columns to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: carr( bounds%begc: , 1: ) ! input column array + real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,c,g,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_c2l(bounds%begc:bounds%endc) ! scale factor + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(carr) == (/bounds%endc, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + if (c2l_scale_type == 'unity') then + do c = bounds%begc,bounds%endc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * lun%canyon_hwr(l) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = bounds%begc,bounds%endc + l = col%landunit(c) + if (lun%urbpoi(l)) then + if (col%itype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * lun%canyon_hwr(l)) / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_road_perv .or. col%itype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*lun%canyon_hwr(l) + 1.) + else if (col%itype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + garr(bounds%begg : bounds%endg,:) = spval + do j = 1,num2d + sumwt(bounds%begg : bounds%endg) = 0._r8 + do c = bounds%begc,bounds%endc + if (col%active(c) .and. col%wtgcell(c) /= 0._r8) then + l = col%landunit(c) + if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = col%gridcell(c) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * col%wtgcell(c) + sumwt(g) = sumwt(g) + col%wtgcell(c) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine c2g_2d + + !----------------------------------------------------------------------- + subroutine l2g_1d(bounds, larr, garr, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from landunits to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + real(r8), intent(in) :: larr( bounds%begl: ) ! input landunit array + real(r8), intent(out) :: garr( bounds%begg: ) ! output gridcell array + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + garr(bounds%begg : bounds%endg) = spval + sumwt(bounds%begg : bounds%endg) = 0._r8 + do l = bounds%begl,bounds%endl + if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then + if (larr(l) /= spval .and. scale_l2g(l) /= spval) then + g = lun%gridcell(l) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + larr(l) * scale_l2g(l) * lun%wtgcell(l) + sumwt(g) = sumwt(g) + lun%wtgcell(l) + end if + end if + end do + found = .false. + do g = bounds%begg, bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'l2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine l2g_1d + + !----------------------------------------------------------------------- + subroutine l2g_2d(bounds, num2d, larr, garr, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Perfrom subgrid-average from landunits to gridcells. + ! Averaging is only done for points that are not equal to "spval". + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: larr( bounds%begl: , 1: ) ! input landunit array + real(r8), intent(out) :: garr( bounds%begg: , 1: ) ! output gridcell array + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + ! + ! !LOCAL VARIABLES: + integer :: j,g,l,index ! indices + integer :: max_lu_per_gcell ! max landunits per gridcell; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_l2g(bounds%begl:bounds%endl) ! scale factor + real(r8) :: sumwt(bounds%begg:bounds%endg) ! sum of weights + !------------------------------------------------------------------------ + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(larr) == (/bounds%endl, num2d/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(garr) == (/bounds%endg, num2d/)), errMsg(__FILE__, __LINE__)) + + call build_scale_l2g(bounds, l2g_scale_type, & + scale_l2g(bounds%begl:bounds%endl)) + + garr(bounds%begg : bounds%endg, :) = spval + do j = 1,num2d + sumwt(bounds%begg : bounds%endg) = 0._r8 + do l = bounds%begl,bounds%endl + if (lun%active(l) .and. lun%wtgcell(l) /= 0._r8) then + if (larr(l,j) /= spval .and. scale_l2g(l) /= spval) then + g = lun%gridcell(l) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * lun%wtgcell(l) + sumwt(g) = sumwt(g) + lun%wtgcell(l) + end if + end if + end do + found = .false. + do g = bounds%begg,bounds%endg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index= g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'l2g_2d error: sumwt is greater than 1.0 at g= ',index,' lev= ',j + call endrun(decomp_index=index, clmlevel=nameg, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine l2g_2d + + !----------------------------------------------------------------------- + subroutine build_scale_l2g(bounds, l2g_scale_type, scale_l2g) + ! + ! !DESCRIPTION: + ! Fill the scale_l2g(bounds%begl:bounds%endl) array with appropriate values for the given l2g_scale_type. + ! This array can later be used to scale each landunit in forming grid cell averages. + ! + ! !USES: + use landunit_varcon, only : max_lunit + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + real(r8) , intent(out) :: scale_l2g( bounds%begl: ) ! scale factor + ! + ! !LOCAL VARIABLES: + real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type + integer :: l ! index + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(scale_l2g) == (/bounds%endl/)), errMsg(__FILE__, __LINE__)) + + call create_scale_l2g_lookup(l2g_scale_type, scale_lookup) + + do l = bounds%begl,bounds%endl + scale_l2g(l) = scale_lookup(lun%itype(l)) + end do + + end subroutine build_scale_l2g + + !----------------------------------------------------------------------- + subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) + ! + ! DESCRIPTION: + ! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for + ! each landunit type depending on l2g_scale_type + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop, istice, istice_mec, istdlak + use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type + !----------------------------------------------------------------------- + + ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------ + ! + ! Since scale_l2g is not currently included in the sumwt accumulations, you need to + ! be careful about the scale values you use. Values of 1 and spval are safe + ! (including having multiple landunits with value 1), but only use other values if + ! you know what you are doing! For example, using a value of 0 is NOT the correct way + ! to exclude a landunit from the average, because the normalization will be done + ! incorrectly in this case: instead, use spval to exclude a landunit from the + ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit + ! double relative weight in general, because the normalization won't be done + ! correctly in this case, either. + ! + ! In the longer-term, I believe that the correct solution to this problem is to + ! include scale_l2g (and the other scale factors) in the sumwt accumulations + ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that + ! requires some more thought to (1) make sure that is correct, and (2) make sure it + ! doesn't break the urban scaling. + ! + ! ----------------------------------------------------------------- + + + ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps + ! the default value will be excluded from grid cell averages. + scale_lookup(:) = spval + + if (l2g_scale_type == 'unity') then + scale_lookup(:) = 1.0_r8 + else if (l2g_scale_type == 'natveg') then + scale_lookup(istsoil) = 1.0_r8 + else if (l2g_scale_type == 'veg') then + scale_lookup(istsoil) = 1.0_r8 + scale_lookup(istcrop) = 1.0_r8 + else if (l2g_scale_type == 'ice') then + scale_lookup(istice) = 1.0_r8 + scale_lookup(istice_mec) = 1.0_r8 + else if (l2g_scale_type == 'nonurb') then + scale_lookup(:) = 1.0_r8 + scale_lookup(isturb_MIN:isturb_MAX) = spval + else if (l2g_scale_type == 'lake') then + scale_lookup(istdlak) = 1.0_r8 + else + write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported' + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine create_scale_l2g_lookup + +end module subgridAveMod diff --git a/components/clm/src/main/subgridMod.F90 b/components/clm/src/main/subgridMod.F90 new file mode 100644 index 0000000000..8bf80e5116 --- /dev/null +++ b/components/clm/src/main/subgridMod.F90 @@ -0,0 +1,263 @@ +module subgridMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! sub-grid data and mapping types and modules + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use abortutils , only : endrun + use clm_varctl , only : iulog + + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public subgrid_get_gcellinfo ! Obtain gridcell properties + !----------------------------------------------------------------------- + +contains + + !------------------------------------------------------------------------------ + subroutine subgrid_get_gcellinfo (gi, & + nlunits, ncols, npatches, ncohorts, & + nveg, & + ncrop, & + nurban_tbd, & + nurban_hd, & + nurban_md, & + nlake, & + nwetland, & + nglacier, & + nglacier_mec, & + glcmask) + ! + ! !DESCRIPTION: + ! Obtain gridcell properties + ! + ! !USES + use clm_varpar , only : natpft_size, cft_size, maxpatch_urb, maxpatch_glcmec + use clm_varctl , only : create_crop_landunit + use clm_instur , only : wt_lunit, urban_valid, wt_glc_mec + use landunit_varcon , only : istsoil, istcrop, istice, istice_mec, istdlak, istwet + use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md + use EDtypesMod , only : cohorts_per_gcell + ! + ! !ARGUMENTS + integer , intent(in) :: gi ! grid cell index + integer , optional, intent(out) :: nlunits ! number of landunits + integer , optional, intent(out) :: ncols ! number of columns + integer , optional, intent(out) :: npatches ! number of patchs + integer , optional, intent(out) :: ncohorts ! number of cohorts + integer , optional, intent(out) :: nveg ! number of vegetated patchs in naturally vegetated landunit + integer , optional, intent(out) :: ncrop ! number of crop patchs in crop landunit + integer , optional, intent(out) :: nurban_tbd ! number of urban patchs (columns) in urban TBD landunit + integer , optional, intent(out) :: nurban_hd ! number of urban patchs (columns) in urban HD landunit + integer , optional, intent(out) :: nurban_md ! number of urban patchs (columns) in urban MD landunit + integer , optional, intent(out) :: nlake ! number of lake patchs (columns) in lake landunit + integer , optional, intent(out) :: nwetland ! number of wetland patchs (columns) in wetland landunit + integer , optional, intent(out) :: nglacier ! number of glacier patchs (columns) in glacier landunit + integer , optional, intent(out) :: nglacier_mec ! number of glacier_mec patchs (columns) in glacier_mec landunit + integer , optional, intent(in) :: glcmask ! = 1 if glc requires surface mass balance in this gridcell + ! + ! !LOCAL VARIABLES: + integer :: m ! loop index + integer :: n ! elevation class index + integer :: ipatches ! number of patches in gridcell + integer :: icols ! number of columns in gridcell + integer :: ilunits ! number of landunits in gridcell + integer :: icohorts ! number of cohorts in gridcell + integer :: npatches_per_lunit ! number of patches in landunit + !------------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------- + ! Initialize patches, columns and landunits counters for gridcell + ! ------------------------------------------------------------------------- + + ipatches = 0 + icols = 0 + ilunits = 0 + icohorts = 0 + + ! ------------------------------------------------------------------------- + ! Set naturally vegetated landunit + ! ------------------------------------------------------------------------- + + ! To support dynamic landunits, we have a naturally vegetated landunit in every grid + ! cell, because it might need to come into existence even if its weight is 0 at the + ! start of the run. And to support transient patches or dynamic vegetation, we always + ! allocate space for ALL patches on this landunit. + + npatches_per_lunit = natpft_size + + ! Assume that the vegetated landunit has one column + ilunits = ilunits + 1 + icols = icols + 1 + + ipatches = ipatches + npatches_per_lunit + + ! + ! number of cohorts per gridcell set here. + ! + icohorts = icohorts + cohorts_per_gcell + + if (present(nveg )) nveg = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set urban landunits + ! ------------------------------------------------------------------------- + + ! To support dynamic landunits, we have all urban landunits in every grid cell that + ! has valid urban parameters, because they might need to come into existence even if + ! their weight is 0 at the start of the run. And for simplicity, we always allocate + ! space for ALL columns on the urban landunits. + + ! Set urban tall building district landunit + + npatches_per_lunit = 0 + if (urban_valid(gi)) then + npatches_per_lunit = maxpatch_urb + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + ipatches = ipatches + npatches_per_lunit + end if + if (present(nurban_tbd )) nurban_tbd = npatches_per_lunit + + ! Set urban high density landunit + + npatches_per_lunit = 0 + if (urban_valid(gi)) then + npatches_per_lunit = maxpatch_urb + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + ipatches = ipatches + npatches_per_lunit + end if + if (present(nurban_hd )) nurban_hd = npatches_per_lunit + + ! Set urban medium density landunit + + npatches_per_lunit = 0 + if (urban_valid(gi)) then + npatches_per_lunit = maxpatch_urb + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + ipatches = ipatches + npatches_per_lunit + end if + if (present(nurban_md )) nurban_md = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set lake landunit + ! ------------------------------------------------------------------------- + + ! We currently do NOT allow the lake landunit to expand via dynamic landunits, so we + ! only need to allocate space for it where its weight is currently non-zero. + + npatches_per_lunit = 0 + if (wt_lunit(gi, istdlak) > 0.0_r8) then + npatches_per_lunit = npatches_per_lunit + 1 + end if + if (npatches_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + end if + ipatches = ipatches + npatches_per_lunit + if (present(nlake )) nlake = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set wetland landunit + ! ------------------------------------------------------------------------- + + ! We currently do NOT allow the wetland landunit to expand via dynamic landunits, so + ! we only need to allocate space for it where its weight is currently non-zero. + + npatches_per_lunit = 0 + if (wt_lunit(gi, istwet) > 0.0_r8) then + npatches_per_lunit = npatches_per_lunit + 1 + end if + if (npatches_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + end if + ipatches = ipatches + npatches_per_lunit + if (present(nwetland )) nwetland = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set glacier landunit + ! ------------------------------------------------------------------------- + + ! We currently do NOT allow the glacier landunit to expand via dynamic landunits, so + ! we only need to allocate space for it where its weight is currently non-zero. (If we + ! have dynamic glacier area, we will be using glacier_mec landunits rather than + ! glacier landunits.) + + npatches_per_lunit = 0 + if (wt_lunit(gi, istice) > 0.0_r8) then + npatches_per_lunit = npatches_per_lunit + 1 + end if + if (npatches_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + end if + ipatches = ipatches + npatches_per_lunit + if (present(nglacier )) nglacier = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set glacier_mec landunit + ! ------------------------------------------------------------------------- + + ! If glcmask = 1, we create a column for each elevation class even if the weight on + ! the grid cell is 0. This is needed for coupling to CISM. In addition, this is + ! currently sufficient to ensure that we have glaciers everywhere they might be + ! needed with dynamic landunits, since CISM won't be able to create glaciers outside + ! of the area specified by glcmask. + + npatches_per_lunit = 0 + do m = 1, maxpatch_glcmec + ! If the landunit has non-zero weight on the grid cell, and this column has + ! non-zero weight on the landunit... + if (wt_lunit(gi, istice_mec) > 0.0_r8 .and. wt_glc_mec(gi, m) > 0.0_r8) then + npatches_per_lunit = npatches_per_lunit + 1 + + elseif (present(glcmask)) then + if (glcmask == 1) then ! create a virtual column + npatches_per_lunit = npatches_per_lunit + 1 + endif ! glcmask = 1 + endif ! wt > 0 + enddo ! maxpatch_glcmec + if (npatches_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + end if + ipatches = ipatches + npatches_per_lunit + if (present(nglacier_mec )) nglacier_mec = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Set crop landunit if appropriate + ! ------------------------------------------------------------------------- + + npatches_per_lunit = 0 + if (create_crop_landunit) then + ! To support dynamic landunits, we have a crop landunit in every grid cell (if + ! create_crop_landunit is true), because it might need to come into existence even + ! if its weight is 0 at the start of the run. + npatches_per_lunit = cft_size + ilunits = ilunits + 1 + icols = icols + npatches_per_lunit + ipatches = ipatches + npatches_per_lunit + end if + if (present(ncrop )) ncrop = npatches_per_lunit + + ! ------------------------------------------------------------------------- + ! Determine return arguments + ! ------------------------------------------------------------------------- + + if (present(nlunits )) nlunits = ilunits + if (present(ncols )) ncols = icols + if (present(npatches )) npatches = ipatches + if (present(ncohorts )) ncohorts = icohorts + + end subroutine subgrid_get_gcellinfo + +end module subgridMod diff --git a/components/clm/src/main/subgridRestMod.F90 b/components/clm/src/main/subgridRestMod.F90 new file mode 100644 index 0000000000..16c83f56d3 --- /dev/null +++ b/components/clm/src/main/subgridRestMod.F90 @@ -0,0 +1,675 @@ +module subgridRestMod + +#include "shr_assert.h" + + !------------------------------------------------------------------------ + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type, BOUNDS_LEVEL_PROC, ldecomp + use domainMod , only : ldomain + use clm_time_manager , only : get_curr_date + use clm_varcon , only : nameg, namel, namec, namep + use clm_varpar , only : nlevsno + use pio , only : file_desc_t + use ncdio_pio , only : ncd_int, ncd_double + use GetGlobalValuesMod , only : GetGlobalIndex + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + use restUtilMod + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: subgridRest ! handle restart of subgrid variables + public :: subgridRest_check_consistency ! check consistency of variables read by subgridRest + public :: subgridRest_read_cleanup ! do cleanup of variables allocated when reading the restart file; should be called after subgridRest and subgridRest_check_consistency are complete + + ! !PRIVATE MEMBER FUNCTIONS: + private :: subgridRest_write_only ! handle restart of subgrid variables that only need to be written, not read + private :: subgridRest_write_and_read ! handle restart of subgrid variables that need to be read as well as written + private :: save_old_weights + + ! !PRIVATE TYPES: + real(r8), allocatable :: pft_wtlunit_before_rest_read(:) ! patch%wtlunit weights - saved values from before the restart read + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine subgridRest( bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Handle restart of subgrid variables + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id + character(len=*) , intent(in) :: flag ! flag to determine if define, write or read data + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname='SubgridRest' ! subroutine name + !------------------------------------------------------------------------ + + if (flag /= 'read') then + call subgridRest_write_only(bounds, ncid, flag) + end if + + call subgridRest_write_and_read(bounds, ncid, flag) + + end subroutine subgridRest + + !----------------------------------------------------------------------- + subroutine subgridRest_write_only(bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Handle restart for variables that only need to be written, not read. This applies + ! to variables that are time-constant and are only put on the restart file for the + ! sake of having some additional metadata there. + ! + ! Note that 'active' flags appear in this routine: they don't need to be read because + ! they can be computed using other info on the restart file (particularly subgrid + ! weights). + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id + character(len=*) , intent(in) :: flag ! flag to determine if define, write or read data + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p,i ! indices + logical :: readvar ! temporary + real(r8), pointer :: rgarr(:) ! temporary + real(r8), pointer :: rlarr(:) ! temporary + real(r8), pointer :: rcarr(:) ! temporary + real(r8), pointer :: rparr(:) ! temporary + integer , pointer :: igarr(:) ! temporary + integer , pointer :: ilarr(:) ! temporary + integer , pointer :: icarr(:) ! temporary + integer , pointer :: iparr(:) ! temporary + + character(len=*), parameter :: subname = 'subgridRest_write_only' + !----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Write gridcell info + !------------------------------------------------------------------ + + allocate(rgarr(bounds%begg:bounds%endg), igarr(bounds%begg:bounds%endg)) + + call restartvar(ncid=ncid, flag=flag, varname='grid1d_lon', xtype=ncd_double, & + dim1name='gridcell', & + long_name='gridcell longitude', units='degrees_east', & + interpinic_flag='skip', readvar=readvar, data=grc%londeg) + + call restartvar(ncid=ncid, flag=flag, varname='grid1d_lat', xtype=ncd_double, & + dim1name='gridcell', & + long_name='gridcell latitude', units='degrees_north', & + interpinic_flag='skip', readvar=readvar, data=grc%latdeg) + + do g=bounds%begg,bounds%endg + igarr(g)= mod(ldecomp%gdc2glo(g)-1,ldomain%ni) + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='grid1d_ixy', xtype=ncd_int, & + dim1name='gridcell', & + long_name='2d longitude index of corresponding gridcell', & + interpinic_flag='skip', readvar=readvar, data=igarr) + + do g=bounds%begg,bounds%endg + igarr(g)= (ldecomp%gdc2glo(g) - 1)/ldomain%ni + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='grid1d_jxy', xtype=ncd_int, & + dim1name='gridcell', & + long_name='2d latitude index of corresponding gridcell', & + interpinic_flag='skip', readvar=readvar, data=igarr) + + deallocate(rgarr,igarr) + + !------------------------------------------------------------------ + ! Write landunit info + !------------------------------------------------------------------ + + allocate(rlarr(bounds%begl:bounds%endl), ilarr(bounds%begl:bounds%endl)) + + do l=bounds%begl,bounds%endl + rlarr(l) = grc%londeg(lun%gridcell(l)) + enddo + + call restartvar(ncid=ncid, flag=flag, varname='land1d_lon', xtype=ncd_double, & + dim1name='landunit', & + long_name='landunit longitude', units='degrees_east', & + interpinic_flag='skip', readvar=readvar, data=rlarr) + + do l=bounds%begl,bounds%endl + rlarr(l) = grc%latdeg(lun%gridcell(l)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='land1d_lat', xtype=ncd_double, & + dim1name='landunit', & + long_name='landunit latitude', units='degrees_north', & + interpinic_flag='skip', readvar=readvar, data=rlarr) + + do l=bounds%begl,bounds%endl + ilarr(l) = mod(ldecomp%gdc2glo(lun%gridcell(l))-1,ldomain%ni) + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='land1d_ixy', xtype=ncd_int, & + dim1name='landunit', & + long_name='2d longitude index of corresponding landunit', & + interpinic_flag='skip', readvar=readvar, data=ilarr) + + do l=bounds%begl,bounds%endl + ilarr(l) = (ldecomp%gdc2glo(lun%gridcell(l))-1)/ldomain%ni + 1 + end do + call restartvar(ncid=ncid, flag=flag, varname='land1d_jxy', xtype=ncd_int, & + dim1name='landunit', & + long_name='2d latitude index of corresponding landunit', & + interpinic_flag='skip', readvar=readvar, data=ilarr) + + do l=bounds%begl,bounds%endl + ilarr(l) = GetGlobalIndex(decomp_index=lun%gridcell(l), clmlevel=nameg) + end do + call restartvar(ncid=ncid, flag=flag, varname='land1d_gridcell_index', xtype=ncd_int, & + dim1name='landunit', & + long_name='gridcell index of corresponding landunit', & + interpinic_flag='skip', readvar=readvar, data=ilarr) + + call restartvar(ncid=ncid, flag=flag, varname='land1d_ityplun', xtype=ncd_int, & + dim1name='landunit', & + long_name='landunit type (see global attributes)', units=' ', & + interpinic_flag='skip', readvar=readvar, data=lun%itype) + + do l=bounds%begl,bounds%endl + if (lun%active(l)) then + ilarr(l) = 1 + else + ilarr(l) = 0 + end if + enddo + call restartvar(ncid=ncid, flag=flag, varname='land1d_active', xtype=ncd_int, & + dim1name='landunit', & + long_name='landunit active flag (1=active, 0=inactive)', & + interpinic_flag='skip', readvar=readvar, data=ilarr) + + deallocate(rlarr, ilarr) + + !------------------------------------------------------------------ + ! Write column info + !------------------------------------------------------------------ + + allocate(rcarr(bounds%begc:bounds%endc), icarr(bounds%begc:bounds%endc)) + + do c= bounds%begc, bounds%endc + rcarr(c) = grc%londeg(col%gridcell(c)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='cols1d_lon', xtype=ncd_double, & + dim1name='column', & + long_name='column longitude', units='degrees_east', & + interpinic_flag='skip', readvar=readvar, data=rcarr) + + do c= bounds%begc, bounds%endc + rcarr(c) = grc%latdeg(col%gridcell(c)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='cols1d_lat', xtype=ncd_double, & + dim1name='column', & + long_name='column latitude', units='degrees_north', & + interpinic_flag='skip', readvar=readvar, data=rcarr) + + do c= bounds%begc, bounds%endc + icarr(c) = mod(ldecomp%gdc2glo(col%gridcell(c))-1,ldomain%ni) + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='cols1d_ixy', xtype=ncd_int, & + dim1name='column', & + long_name='2d longitude index of corresponding column', units=' ', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + do c= bounds%begc, bounds%endc + icarr(c) = (ldecomp%gdc2glo(col%gridcell(c))-1)/ldomain%ni + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='cols1d_jxy', xtype=ncd_int, & + dim1name='column', & + long_name='2d latitude index of corresponding column', units=' ', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + do c= bounds%begc, bounds%endc + icarr(c) = GetGlobalIndex(decomp_index=col%gridcell(c), clmlevel=nameg) + end do + call restartvar(ncid=ncid, flag=flag, varname='cols1d_gridcell_index', xtype=ncd_int, & + dim1name='column', & + long_name='gridcell index of corresponding column', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + do c= bounds%begc, bounds%endc + icarr(c) = GetGlobalIndex(decomp_index=col%landunit(c), clmlevel=namel) + end do + call restartvar(ncid=ncid, flag=flag, varname='cols1d_landunit_index', xtype=ncd_int, & + dim1name='column', & + long_name='landunit index of corresponding column', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + do c= bounds%begc, bounds%endc + icarr(c) = lun%itype(col%landunit(c)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='cols1d_ityplun', xtype=ncd_int, & + dim1name='column', & + long_name='column landunit type (see global attributes)', units=' ', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + call restartvar(ncid=ncid, flag=flag, varname='cols1d_ityp', xtype=ncd_int, & + dim1name='column', & + long_name='column type (see global attributes)', units=' ', & + interpinic_flag='skip', readvar=readvar, data=col%itype) + + do c=bounds%begc,bounds%endc + if (col%active(c)) then + icarr(c) = 1 + else + icarr(c) = 0 + end if + end do + call restartvar(ncid=ncid, flag=flag, varname='cols1d_active', xtype=ncd_int, & + dim1name='column', & + long_name='column active flag (1=active, 0=inactive)', units=' ', & + interpinic_flag='skip', readvar=readvar, data=icarr) + + deallocate(rcarr, icarr) + + !------------------------------------------------------------------ + ! Write patch info + !------------------------------------------------------------------ + + allocate(rparr(bounds%begp:bounds%endp), iparr(bounds%begp:bounds%endp)) + + do p=bounds%begp,bounds%endp + rparr(p) = grc%londeg(patch%gridcell(p)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_lon', xtype=ncd_double, & + dim1name='pft', & + long_name='pft longitude', units='degrees_east', & + interpinic_flag='skip', readvar=readvar, data=rparr) + + do p=bounds%begp,bounds%endp + rparr(p) = grc%latdeg(patch%gridcell(p)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_lat', xtype=ncd_double, & + dim1name='pft', & + long_name='pft latitude', units='degrees_north', & + interpinic_flag='skip', readvar=readvar, data=rparr) + + do p=bounds%begp,bounds%endp + iparr(p) = mod(ldecomp%gdc2glo(patch%gridcell(p))-1,ldomain%ni) + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_ixy', xtype=ncd_int, & + dim1name='pft', & + long_name='2d longitude index of corresponding pft', units='', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + iparr(p) = (ldecomp%gdc2glo(patch%gridcell(p))-1)/ldomain%ni + 1 + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_jxy', xtype=ncd_int, & + dim1name='pft', & + long_name='2d latitude index of corresponding pft', units='', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%gridcell(p), clmlevel=nameg) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_gridcell_index', xtype=ncd_int, & + dim1name='pft', & + long_name='gridcell index of corresponding pft', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%landunit(p), clmlevel=namel) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_landunit_index', xtype=ncd_int, & + dim1name='pft', & + long_name='landunit index of corresponding pft', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%column(p), clmlevel=namec) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_column_index', xtype=ncd_int, & + dim1name='pft', & + long_name='column index of corresponding pft', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_itypveg', xtype=ncd_int, & + dim1name='pft', & + long_name='pft vegetation type', units='', & + interpinic_flag='skip', readvar=readvar, data=patch%itype) + + do p=bounds%begp,bounds%endp + iparr(p) = col%itype(patch%column(p)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_itypcol', xtype=ncd_int, & + dim1name='pft', & + long_name='pft column type (see global attributes)', units='', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + iparr(p) = lun%itype(patch%landunit(p)) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_ityplun', xtype=ncd_int, & + dim1name='pft', & + long_name='pft landunit type (see global attributes)', units='', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + if (patch%active(p)) then + iparr(p) = 1 + else + iparr(p) = 0 + end if + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_active', xtype=ncd_int, & + dim1name='pft', & + long_name='pft active flag (1=active, 0=inactive)', units='', & + interpinic_flag='skip', readvar=readvar, data=iparr) + + do p=bounds%begp,bounds%endp + c = patch%column(p) + rparr(p) = col%glc_topo(c) + enddo + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_topoglc', xtype=ncd_double, & + dim1name='column', & + long_name='mean elevation on glacier elevation classes', units='m', & + interpinic_flag='skip', readvar=readvar, data=rparr) + + deallocate(rparr, iparr) + + end subroutine subgridRest_write_only + + !----------------------------------------------------------------------- + subroutine subgridRest_write_and_read(bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id + character(len=*) , intent(in) :: flag ! flag to determine if define, write or read data + ! + ! !LOCAL VARIABLES: + logical :: readvar ! temporary + real(r8), pointer :: temp2d(:,:) ! temporary for sno column variables + + character(len=*), parameter :: subname = 'subgridRest_write_and_read' + !----------------------------------------------------------------------- + + if (flag == 'read') then + call save_old_weights(bounds) + end if + + call restartvar(ncid=ncid, flag=flag, varname='land1d_wtxy', xtype=ncd_double, & + dim1name='landunit', & + long_name='landunit weight relative to corresponding gridcell', & + interpinic_flag='skip', readvar=readvar, data=lun%wtgcell) + + call restartvar(ncid=ncid, flag=flag, varname='cols1d_wtxy', xtype=ncd_double, & + dim1name='column', & + long_name='column weight relative to corresponding gridcell', units=' ', & + interpinic_flag='skip', readvar=readvar, data=col%wtgcell) + + call restartvar(ncid=ncid, flag=flag, varname='cols1d_wtlnd', xtype=ncd_double, & + dim1name='column', & + long_name='column weight relative to corresponding landunit', units=' ', & + interpinic_flag='skip', readvar=readvar, data=col%wtlunit) + + call restartvar(ncid=ncid, flag=flag, varname='cols1d_topoglc', xtype=ncd_double, & + dim1name='column', & + long_name='mean elevation on glacier elevation classes', units='m', & + interpinic_flag='skip', readvar=readvar, data=col%glc_topo) + + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtxy', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding gridcell', units='', & + interpinic_flag='skip', readvar=readvar, data=patch%wtgcell) + + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtlnd', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding landunit', units='', & + interpinic_flag='skip', readvar=readvar, data=patch%wtlunit) + + call restartvar(ncid=ncid, flag=flag, varname='pfts1d_wtcol', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding column', units='', & + interpinic_flag='skip', readvar=readvar, data=patch%wtcol) + + ! Snow column variables + + call restartvar(ncid=ncid, flag=flag, varname='SNLSNO', xtype=ncd_int, & + dim1name='column', & + long_name='number of snow layers', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=col%snl) + + allocate(temp2d(bounds%begc:bounds%endc,-nlevsno+1:0)) + if (flag == 'write') then + temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) = col%dz(bounds%begc:bounds%endc,-nlevsno+1:0) + end if + call restartvar(ncid=ncid, flag=flag, varname='DZSNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer thickness', units='m', & + interpinic_flag='interp', readvar=readvar, data=temp2d) + if (flag == 'read') then + col%dz(bounds%begc:bounds%endc,-nlevsno+1:0) = temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) + end if + deallocate(temp2d) + + allocate(temp2d(bounds%begc:bounds%endc,-nlevsno+1:0)) + if (flag == 'write') then + temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) = col%z(bounds%begc:bounds%endc,-nlevsno+1:0) + end if + call restartvar(ncid=ncid, flag=flag, varname='ZSNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & + long_name='snow layer depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=temp2d) + if (flag == 'read') then + col%z(bounds%begc:bounds%endc,-nlevsno+1:0) = temp2d(bounds%begc:bounds%endc,-nlevsno+1:0) + end if + deallocate(temp2d) + + allocate(temp2d(bounds%begc:bounds%endc,-nlevsno:-1)) + if (flag == 'write') then + temp2d(bounds%begc:bounds%endc,-nlevsno:-1) = col%zi(bounds%begc:bounds%endc,-nlevsno:-1) + end if + call restartvar(ncid=ncid, flag=flag, varname='ZISNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno, upperb2=-1, & + long_name='snow interface depth', units='m', & + interpinic_flag='interp', readvar=readvar, data=temp2d) + if (flag == 'read') then + col%zi(bounds%begc:bounds%endc,-nlevsno:-1) = temp2d(bounds%begc:bounds%endc,-nlevsno:-1) + end if + deallocate(temp2d) + + end subroutine subgridRest_write_and_read + + !----------------------------------------------------------------------- + subroutine save_old_weights(bounds) + ! + ! !DESCRIPTION: + ! Save old weights, from before the restart read, for later consistency checks. + ! + ! !USES: + type(bounds_type), intent(in) :: bounds ! bounds (expected to be proc-level) + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'save_old_weights' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, subname//' ERROR: expect proc-level bounds') + + allocate(pft_wtlunit_before_rest_read(bounds%begp:bounds%endp)) + pft_wtlunit_before_rest_read(bounds%begp:bounds%endp) = patch%wtlunit(bounds%begp:bounds%endp) + + end subroutine save_old_weights + + + !----------------------------------------------------------------------- + subroutine subgridRest_check_consistency(bounds) + ! + ! !DESCRIPTION: + ! Check consistency of variables read by subgridRest. + ! + ! This should be called AFTER subgridRest is called to read the restart file. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'subgridRest_check_consistency' + !----------------------------------------------------------------------- + + if (do_check_weights()) then + call check_weights(bounds) + end if + + contains + + !----------------------------------------------------------------------- + logical function do_check_weights() + ! + ! !DESCRIPTION: + ! Return true if we should check weights + ! + ! !USES: + use clm_varctl, only : nsrest, nsrContinue, use_cndv, use_ed + use dynSubgridControlMod, only : get_do_transient_pfts + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'do_check_weights' + !----------------------------------------------------------------------- + + if (get_do_transient_pfts()) then + ! Don't check weights for a transient PATCH case, because it's harder to come up with the + ! correct weights to check against + do_check_weights = .false. + else if (nsrest == nsrContinue) then + ! Don't check weights for a restart run + ! + ! WJS (3-25-14): I'm not sure why we don't do the check in this case, but I'm + ! maintaining the logic that used to be in BiogeophysRestMod regarding these + ! weight checks + do_check_weights = .false. + else if (use_cndv) then + ! Don't check weights for a cndv case, because the weights will almost certainly + ! differ from the surface dataset in this case + do_check_weights = .false. + else if (use_ed) then + ! Don't check weights for a ed case, because the weights will almost certainly + ! differ from the surface dataset in this case + do_check_weights = .false. + else + do_check_weights = .true. + end if + + end function do_check_weights + + !----------------------------------------------------------------------- + subroutine check_weights(bounds) + ! + ! !DESCRIPTION: + ! Make sure that patch weights on the landunit agree with the weights read from the + ! surface dataset, for the natural veg landunit. + ! + ! Note that we do NOT do a more general check of all subgrid weights, because it's + ! possible that some other subgrid weights have changed relative to the surface + ! dataset, e.g., due to dynamic landunits. It would probably be possible to do more + ! checking than is done here, but the check here should be sufficient to catch major + ! inconsistencies between the restart file and the surface dataset. + ! + ! !USES: + use landunit_varcon, only : istsoil + use clm_varctl, only : iulog + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: p, l ! indices + real(r8) :: diff ! difference in weights + + real(r8), parameter :: tol = 5.e-3 ! tolerance for checking weights + + character(len=*), parameter :: subname = 'check_weights' + !----------------------------------------------------------------------- + + do p = bounds%begp, bounds%endp + l = patch%landunit(p) + if (lun%itype(l) == istsoil) then + diff = abs(patch%wtlunit(p) - pft_wtlunit_before_rest_read(p)) + if (diff > tol .and. patch%wtgcell(p) > 1.0e-16_r8) then + write(iulog,*) 'ERROR: PATCH weights are SIGNIFICANTLY different between :' + write(iulog,*) 'the restart (finidat) file : ', patch%wtlunit(p) + write(iulog,*) 'and the surface dataset (fsurdat): ', pft_wtlunit_before_rest_read(p) + write(iulog,*) 'weight gridcell: ', patch%wtgcell(p) + write(iulog,*) + write(iulog,*) 'Maximum allowed difference: ', tol + write(iulog,*) 'Difference found: ', diff + write(iulog,*) 'This match is a requirement for non-transient runs' + write(iulog,*) + write(iulog,*) 'Possible solutions to this problem:' + write(iulog,*) '(1) Make sure you are using the intended finidat and fsurdat files' + write(iulog,*) '(2) If you are running a present-day simulation, then make sure that your' + write(iulog,*) ' initial conditions file is from the END of a 20th century transient run' + write(iulog,*) '(3) If you are confident that you are using the correct finidat and fsurdat files,' + write(iulog,*) ' yet are still experiencing this error, then you can bypass this check by setting:' + write(iulog,*) ' check_finidat_pct_consistency = .false.' + write(iulog,*) ' in user_nl_clm' + write(iulog,*) ' In this case, CLM will take the weights from the initial conditions file.' + write(iulog,*) ' ' + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + end if + end if + end do + + end subroutine check_weights + + end subroutine subgridRest_check_consistency + + + !----------------------------------------------------------------------- + subroutine subgridRest_read_cleanup + ! + ! !DESCRIPTION: + ! Do cleanup of variables allocated when reading the restart file + ! + ! Should be called after subgridRest and subgridRest_check_consistency are complete. + ! Note that this must be called after subgridRest is called to read the restart file, + ! in order to avoid a memory leak. + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'subgridRest_read_cleanup' + !----------------------------------------------------------------------- + + deallocate(pft_wtlunit_before_rest_read) + + end subroutine subgridRest_read_cleanup + + +end module subgridRestMod diff --git a/components/clm/src/main/subgridWeightsMod.F90 b/components/clm/src/main/subgridWeightsMod.F90 new file mode 100644 index 0000000000..0ead4cdb45 --- /dev/null +++ b/components/clm/src/main/subgridWeightsMod.F90 @@ -0,0 +1,863 @@ +module subgridWeightsMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Handles modifications, error-checks and diagnostics related to changing subgrid weights + ! + ! ----- Requirements for subgrid weights that are enforced here ----- + ! + ! (These requirements are checked in check_weights/weights_okay) + ! + ! Note: in the following, 'active' refers to a pft, column, landunit or grid cell over + ! which computations are performed, and 'inactive' refers to a pft, column or landunit + ! where computations are NOT performed (grid cells are always active). + ! + ! (1) For all columns, landunits and grid cells, the sum of all subgrid weights of its + ! children (or grandchildren, etc.) is equal to 1. For example: + ! - For all columns, the sum of all patch weights on the column equals 1 + ! - For all landunits, the sum of all col weights on the landunit equals 1 + ! - For all grid cells, the sum of all patch weights on the grid cell equals 1 + ! - etc. + ! + ! (2) For all ACTIVE columns, landunits and grid cells, the sum of all subgrid weights of + ! its ACTIVE children (or grandchildren, etc.) is equal to 1. For example: + ! - For all active columns, the sum of all patch weights on the column equals 1 when + ! just considering active pfts + ! - For all active landunits, the sum of all col weights on the landunit equals 1 when + ! just considering active cols + ! - For ALL grid cells, the sum of all patch weights on the grid cell equals 1 when + ! just considering active pfts -- note that all grid cells are considered active! + ! - etc. + ! + ! (3) For all INACTIVE columns, landunits and grid cells, the sum of all subgrid weights of + ! its ACTIVE children, grandchildren, etc. are equal to either 0 or 1. For example: + ! - For all inactive columns, the sum of all patch weights on the column equals either 0 + ! or 1 when just considering active pfts + ! - For all inactive landunits, the sum of all col weights on the landunit equals + ! either 0 or 1 when just considering active cols + ! - etc. + ! + ! Another way of stating (2) and (3) is that the sum of weights of all ACTIVE pfts, cols + ! or landunits on their parent/grandparent/etc. is always equal to either 0 or 1 -- and + ! must be equal to 1 if this parent/grandparent, etc. is itself active. + ! + ! Note that, together, conditions (1) and (2) imply that any pft, col or landunit whose + ! weight on the grid cell is non-zero must be active. In addition, these conditions imply + ! that any patch whose weight on the column is non-zero must be active if the column is + ! active (and similarly for any patch on an active landunit, and any col on an active + ! landunit). + ! + ! + ! ----- Implications of these requirements for computing subgrid averages ----- + ! + ! The preferred way to average from, say, patch to col is: + ! colval(c) = 0 + ! do p = pfti(c), pftf(c) + ! if (active(p)) colval(c) = colval(c) + pftval(p) * wtcol(p) + ! (where wtcol(p) is the weight of the patch on the column) + ! If column c is active, then the above conditions guarantee that the pwtcol values + ! included in the above sum will sum to 1. If column c is inactive, then the above + ! conditions guarantee that the pwtcol values included in the above sum will sum to + ! either 1 or 0; if they sum to 0, then colval(c) will remain 0. + ! + ! Another acceptable method is the following; this method accommodates some unknown + ! fraction of pftval's being set to spval, and leaves colval set at spval if there are no + ! valid patch values: + ! colval(c) = spval + ! sumwt(c) = 0 + ! do p = pfti(c), pftf(c) + ! if (active(p) .and. wtcol(p) /= 0) then + ! if (pftval(p) /= spval) then + ! if (sumwt(c) == 0) colval(c) = 0 + ! colval(c) = colval(c) + pftval(p) * wtcol(p) + ! sumwt(c) = sumwt(c) + wtcol(p) + ! end if + ! end if + ! end do + ! if (sumwt(c) /= 0) then + ! colval(c) = colval(c) / sumwt(c) + ! end if + ! Note that here we check the condition (active(p) .and. wtcol(p) /= 0). We need to + ! include a check for wtcol(p) /= 0 because we don't want to set colval(c) = 0 for zero- + ! weight pfts in this line: + ! if (sumwt(c) == 0) colval(c) = 0 + ! And we include a check for active(p) because we don't want to assume that pftval(p) has + ! been set to spval for inactive pfts -- we want to allow for the possibility that + ! pftval(p) will be NaN for inactive pfts. + ! + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : iulog, all_active, use_ed + use clm_varcon , only : nameg, namel, namec, namep + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! PUBLIC TYPES: + implicit none + save + + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: init_subgrid_weights_mod ! initialize stuff in this module + public :: compute_higher_order_weights ! given p2c, c2l and l2g weights, compute other weights + public :: set_active ! set 'active' flags at pft, column & landunit level + public :: check_weights ! check subgrid weights + public :: get_landunit_weight ! get the weight of a given landunit on a single grid cell + public :: set_landunit_weight ! set the weight of a given landunit on a single grid cell + public :: is_gcell_all_ltypeX ! determine whether a grid cell is 100% covered by the given landunit type + public :: set_subgrid_diagnostic_fields ! set all subgrid weights diagnostic fields + ! + ! !REVISION HISTORY: + ! Created by Bill Sacks + ! + ! !PRIVATE TYPES: + type subgrid_weights_diagnostics_type + ! This type contains diagnostics on subgrid weights, for output to the history file + real(r8), pointer :: pct_landunit(:,:) ! % of each landunit on the grid cell [begg:endg, 1:max_lunit] + real(r8), pointer :: pct_nat_pft(:,:) ! % of each pft, as % of landunit [begg:endg, natpft_lb:natpft_ub] + real(r8), pointer :: pct_cft(:,:) ! % of each crop functional type, as % of landunit [begg:endg, cft_lb:cft_ub] + real(r8), pointer :: pct_glc_mec(:,:) ! % of each glacier elevation class, as % of landunit [begg:endg, 1:maxpatch_glcmec] + end type subgrid_weights_diagnostics_type + + type(subgrid_weights_diagnostics_type) :: subgrid_weights_diagnostics + + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: is_active_l ! determine whether the given landunit is active + private :: is_active_c ! determine whether the given column is active + private :: is_active_p ! determine whether the given patch is active + private :: weights_okay ! determine if sum of weights satisfies requirements laid out above + private :: set_pct_landunit_diagnostics ! set pct_landunit diagnostic field + private :: set_pct_glc_mec_diagnostics ! set pct_glc_mec diagnostic field + private :: set_pct_pft_diagnostics ! set pct_nat_pft & pct_cft diagnostic fields + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine init_subgrid_weights_mod(bounds) + ! + ! !DESCRIPTION: + ! Initialize stuff in this module + ! + ! !USES: + use landunit_varcon, only : max_lunit + use clm_varpar , only : maxpatch_glcmec, natpft_size, cft_size + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : BOUNDS_LEVEL_PROC + use histFileMod , only : hist_addfld2d + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! proc bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'init_subgrid_weights_mod' + !----------------------------------------------------------------------- + + SHR_ASSERT(bounds%level == BOUNDS_LEVEL_PROC, errMsg(__FILE__, __LINE__)) + + ! ------------------------------------------------------------------------ + ! Allocate variables in subgrid_weights_diagnostics + ! ------------------------------------------------------------------------ + + ! Note that, because these variables are output to the history file, it appears that + ! their lower bounds need to start at 1 (e.g., 1:natpft_size rather than + ! natpft_lb:natpft_ub) + allocate(subgrid_weights_diagnostics%pct_landunit(bounds%begg:bounds%endg, 1:max_lunit)) + subgrid_weights_diagnostics%pct_landunit(:,:) = nan + allocate(subgrid_weights_diagnostics%pct_nat_pft(bounds%begg:bounds%endg, 1:natpft_size)) + subgrid_weights_diagnostics%pct_nat_pft(:,:) = nan + allocate(subgrid_weights_diagnostics%pct_cft(bounds%begg:bounds%endg, 1:cft_size)) + subgrid_weights_diagnostics%pct_cft(:,:) = nan + allocate(subgrid_weights_diagnostics%pct_glc_mec(bounds%begg:bounds%endg, 1:maxpatch_glcmec)) + subgrid_weights_diagnostics%pct_glc_mec(:,:) = nan + + ! ------------------------------------------------------------------------ + ! Add history fields + ! ------------------------------------------------------------------------ + + call hist_addfld2d (fname='PCT_LANDUNIT', units='%', type2d='ltype', & + avgflag='A', long_name='% of each landunit on grid cell', & + ptr_lnd=subgrid_weights_diagnostics%pct_landunit) + + call hist_addfld2d (fname='PCT_NAT_PFT', units='%', type2d='natpft', & + avgflag='A', long_name='% of each PFT on the natural vegetation (i.e., soil) landunit', & + ptr_lnd=subgrid_weights_diagnostics%pct_nat_pft) + + if (cft_size > 0) then + call hist_addfld2d (fname='PCT_CFT', units='%', type2d='cft', & + avgflag='A', long_name='% of each crop on the crop landunit', & + ptr_lnd=subgrid_weights_diagnostics%pct_cft) + end if + + if (maxpatch_glcmec > 0) then + call hist_addfld2d (fname='PCT_GLC_MEC', units='%', type2d='glc_nec', & + avgflag='A', long_name='% of each GLC elevation class on the glc_mec landunit', & + ptr_lnd=subgrid_weights_diagnostics%pct_glc_mec) + end if + + + end subroutine init_subgrid_weights_mod + + + !----------------------------------------------------------------------- + subroutine compute_higher_order_weights(bounds) + ! + ! !DESCRIPTION: + ! Assuming patch%wtcol, col%wtlunit and lun%wtgcell have already been computed, compute + ! the "higher-order" weights: patch%wtlunit, patch%wtgcell and col%wtgcell, for all p and c + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! clump bounds + ! + ! !LOCAL VARIABLES: + integer :: p, c, l ! indices for pft, col & landunit + !------------------------------------------------------------------------ + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + col%wtgcell(c) = col%wtlunit(c) * lun%wtgcell(l) + end do + + do p = bounds%begp, bounds%endp + c = patch%column(p) + patch%wtlunit(p) = patch%wtcol(p) * col%wtlunit(c) + patch%wtgcell(p) = patch%wtcol(p) * col%wtgcell(c) + end do + end subroutine compute_higher_order_weights + + !----------------------------------------------------------------------- + subroutine set_active(bounds) + ! + ! !DESCRIPTION: + ! Set 'active' flags at the pft, column and landunit level + ! (note that grid cells are always active) + ! + ! This should be called whenever any weights change (e.g., patch weights on the column, + ! landunit weights on the grid cell, etc.). + ! + ! Ensures that we don't have any active patch on an inactive column, or an active column on an + ! inactive landunit (since these conditions could lead to garbage data) + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + ! + ! !LOCAL VARIABLES: + integer :: l,c,p ! loop counters + + character(len=*), parameter :: subname = 'set_active' + !------------------------------------------------------------------------ + + do l = bounds%begl,bounds%endl + lun%active(l) = is_active_l(l) + end do + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + col%active(c) = is_active_c(c) + if (col%active(c) .and. .not. lun%active(l)) then + write(iulog,*) trim(subname),' ERROR: active column found on inactive landunit', & + 'at c = ', c, ', l = ', l + call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + do p = bounds%begp,bounds%endp + c = patch%column(p) + patch%active(p) = is_active_p(p) + if (patch%active(p) .and. .not. col%active(c)) then + write(iulog,*) trim(subname),' ERROR: active patch found on inactive column', & + 'at p = ', p, ', c = ', c + call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(__FILE__, __LINE__)) + end if + end do + + end subroutine set_active + + !----------------------------------------------------------------------- + logical function is_active_l(l) + ! + ! !DESCRIPTION: + ! Determine whether the given landunit is active + ! + ! !USES: + use landunit_varcon, only : istsoil, istice, istice_mec + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: l ! landunit index + ! + ! !LOCAL VARIABLES: + integer :: g ! grid cell index + !------------------------------------------------------------------------ + + if (all_active) then + is_active_l = .true. + + else + g =lun%gridcell(l) + + is_active_l = .false. + + ! ------------------------------------------------------------------------ + ! General conditions under which is_active_l NEEDS to be true in order to satisfy + ! the requirements laid out at the top of this module: + ! ------------------------------------------------------------------------ + if (lun%wtgcell(l) > 0) is_active_l = .true. + + ! ------------------------------------------------------------------------ + ! Conditions under which is_active_p is set to true because we want extra virtual landunits: + ! ------------------------------------------------------------------------ + + ! Always run over ice_mec landunits within the glcmask, because this is where glc + ! might need input from virtual (0-weight) landunits. + ! + ! Note that we use glcmask rather than icemask here; the reason is: by using + ! glcmask, we make it easy to add virtual columns, simply by changing the fglcmask + ! file. Since icemask is a subset of glcmask, the only downside of using glcmask + ! rather than icemask is a (typically small) performance cost. + if (lun%itype(l) == istice_mec .and. ldomain%glcmask(g) == 1) is_active_l = .true. + + ! In general, include a virtual natural vegetation landunit. This aids + ! initialization of a new landunit; and for runs that are coupled to CISM, this + ! provides bare land SMB forcing even if there is no vegetated area. + ! + ! However, we do NOT include a virtual vegetated column in grid cells that are 100% + ! standard (non-mec) glacier. This is for performance reasons: for FV 0.9x1.25, + ! excluding these virtual vegetated columns (mostly over Antarctica) leads to a ~ + ! 6% performance improvement (the performance improvement is much less for ne30, + ! though). In such grid cells, we do not need the forcing to CISM (because if we + ! needed forcing to CISM, we'd be using an istice_mec point rather than plain + ! istice). Furthermore, standard glacier landunits cannot retreat (only istice_mec + ! points can retreat, due to coupling with CISM), so we don't need to worry about + ! the glacier retreating in this grid cell, exposing new natural veg area. The + ! only thing that could happen is the growth of some special landunit - e.g., crop + ! - in this grid cell, due to dynamic landunits. We'll live with the fact that + ! initialization of the new crop landunit will be initialized in an un-ideal way + ! in this rare situation. + if (lun%itype(l) == istsoil .and. .not. is_gcell_all_ltypeX(g, istice)) then + is_active_l = .true. + end if + + end if + + end function is_active_l + + !----------------------------------------------------------------------- + logical function is_active_c(c) + ! + ! !DESCRIPTION: + ! Determine whether the given column is active + ! + ! !USES: + use landunit_varcon, only : istice_mec, isturb_MIN, isturb_MAX + use domainMod , only : ldomain + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: c ! column index + ! + ! !LOCAL VARIABLES: + integer :: l ! landunit index + integer :: g ! grid cell index + !------------------------------------------------------------------------ + + if (all_active) then + is_active_c = .true. + + else + l =col%landunit(c) + g =col%gridcell(c) + + is_active_c = .false. + + ! ------------------------------------------------------------------------ + ! General conditions under which is_active_c NEEDS to be true in order to satisfy + ! the requirements laid out at the top of this module: + ! ------------------------------------------------------------------------ + if (lun%active(l) .and. col%wtlunit(c) > 0._r8) is_active_c = .true. + + ! ------------------------------------------------------------------------ + ! Conditions under which is_active_c is set to true because we want extra virtual columns: + ! ------------------------------------------------------------------------ + + ! Always run over all ice_mec columns within the glcmask, because this is where glc + ! might need input from virtual (0-weight) columns + ! + ! Note that we use glcmask rather than icemask here; see comment in is_active_l + ! for the rationale. + if (lun%itype(l) == istice_mec .and. ldomain%glcmask(g) == 1) is_active_c = .true. + + ! We don't really need to run over 0-weight urban columns. But because of some + ! messiness in the urban code (many loops are over the landunit filter, then drill + ! down to columns - so we would need to add 'col%active(c)' conditionals in many + ! places) it keeps the code cleaner to run over 0-weight urban columns. This generally + ! shouldn't add much computation time, since in most places, all urban columns are + ! non-zero weight if the landunit is non-zero weight. + if (lun%active(l) .and. (lun%itype(l) >= isturb_MIN .and. lun%itype(l) <= isturb_MAX)) then + is_active_c = .true. + end if + end if + + end function is_active_c + + !----------------------------------------------------------------------- + logical function is_active_p(p) + ! + ! !DESCRIPTION: + ! Determine whether the given patch is active + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: p ! patch index + ! + ! !LOCAL VARIABLES: + integer :: c ! column index + !------------------------------------------------------------------------ + + if (all_active) then + is_active_p = .true. + + else + c =patch%column(p) + + is_active_p = .false. + + ! ------------------------------------------------------------------------ + ! General conditions under which is_active_p NEEDS to be true in order to satisfy + ! the requirements laid out at the top of this module: + ! ------------------------------------------------------------------------ + if (col%active(c) .and. patch%wtcol(p) > 0._r8) is_active_p = .true. + + end if + + end function is_active_p + + !----------------------------------------------------------------------- + function get_landunit_weight(g, ltype) result(weight) + ! + ! !DESCRIPTION: + ! Get the subgrid weight of a given landunit type on a single grid cell + ! + ! !USES: + use clm_varcon, only : ispval + ! + ! !ARGUMENTS: + real(r8) :: weight ! function result + integer , intent(in) :: g ! grid cell index + integer , intent(in) :: ltype ! landunit type of interest + ! + ! !LOCAL VARIABLES: + integer :: l ! landunit index + + character(len=*), parameter :: subname = 'get_landunit_weight' + !----------------------------------------------------------------------- + + l = grc%landunit_indices(ltype, g) + if (l == ispval) then + weight = 0._r8 + else + weight = lun%wtgcell(l) + end if + + end function get_landunit_weight + + !----------------------------------------------------------------------- + subroutine set_landunit_weight(g, ltype, weight) + ! + ! !DESCRIPTION: + ! Set the subgrid weight of a given landunit type on a single grid cell + ! + ! !USES: + use clm_varcon, only : ispval + ! + ! !ARGUMENTS: + integer , intent(in) :: g ! grid cell index + integer , intent(in) :: ltype ! landunit type of interest + real(r8), intent(in) :: weight ! new weight of this landunit + ! + ! !LOCAL VARIABLES: + integer :: l ! landunit index + + character(len=*), parameter :: subname = 'set_landunit_weight' + !----------------------------------------------------------------------- + + l = grc%landunit_indices(ltype, g) + if (l /= ispval) then + lun%wtgcell(l) = weight + else if (weight > 0._r8) then + write(iulog,*) subname//' ERROR: Attempt to assign non-zero weight to a non-existent landunit' + write(iulog,*) 'g, l, ltype, weight = ', g, l, ltype, weight + call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine set_landunit_weight + + + !----------------------------------------------------------------------- + function is_gcell_all_ltypeX(g, ltype) result(all_ltypeX) + ! + ! !DESCRIPTION: + ! Determine if the given grid cell is 100% covered by the landunit type given by ltype + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + logical :: all_ltypeX ! function result + integer, intent(in) :: g ! grid cell index + integer, intent(in) :: ltype ! landunit type of interest + ! + ! !LOCAL VARIABLES: + real(r8) :: wt_lunit ! subgrid weight of the given landunit + + real(r8), parameter :: tolerance = 1.e-13_r8 ! tolerance for checking whether landunit's weight is 1 + character(len=*), parameter :: subname = 'is_gcell_all_ltypeX' + !------------------------------------------------------------------------------ + + wt_lunit = get_landunit_weight(g, ltype) + if (wt_lunit >= (1._r8 - tolerance)) then + all_ltypeX = .true. + else + all_ltypeX = .false. + end if + + end function is_gcell_all_ltypeX + + !------------------------------------------------------------------------------ + subroutine check_weights (bounds, active_only) + ! + ! !DESCRIPTION: + ! Check subgrid weights. + ! + ! This routine operates in two different modes, depending on the value of active_only. If + ! active_only is true, then we check the sum of weights of the ACTIVE children, + ! grandchildren, etc. of a given point. If active_only is false, then we check the sum of + ! weights of ALL children, grandchildren, etc. of a given point. + ! + ! Normally this routine will be called twice: once with active_only=false, and once with + ! active_only=true. + ! + ! !USES + ! + ! !ARGUMENTS + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + logical, intent(in) :: active_only ! true => check sum of weights just of ACTIVE children, grandchildren, etc. + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p ! loop counters + real(r8), allocatable :: sumwtcol(:), sumwtlunit(:), sumwtgcell(:) + logical :: error_found ! true if we find an error + character(len=*), parameter :: subname = 'check_weights' + !------------------------------------------------------------------------------ + + allocate(sumwtcol(bounds%begc:bounds%endc)) + allocate(sumwtlunit(bounds%begl:bounds%endl)) + allocate(sumwtgcell(bounds%begg:bounds%endg)) + + error_found = .false. + + ! Check patch-level weights + sumwtcol(bounds%begc : bounds%endc) = 0._r8 + sumwtlunit(bounds%begl : bounds%endl) = 0._r8 + sumwtgcell(bounds%begg : bounds%endg) = 0._r8 + + do p = bounds%begp,bounds%endp + c = patch%column(p) + l = patch%landunit(p) + g = patch%gridcell(p) + + if ((active_only .and. patch%active(p)) .or. .not. active_only) then + sumwtcol(c) = sumwtcol(c) + patch%wtcol(p) + sumwtlunit(l) = sumwtlunit(l) + patch%wtlunit(p) + sumwtgcell(g) = sumwtgcell(g) + patch%wtgcell(p) + end if + end do + + do c = bounds%begc,bounds%endc + if (.not. weights_okay(sumwtcol(c), active_only, col%active(c))) then + write(iulog,*) trim(subname),' ERROR: at c = ',c,'total PFT weight is ',sumwtcol(c), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + do l = bounds%begl,bounds%endl + if (.not. weights_okay(sumwtlunit(l), active_only, lun%active(l))) then + write(iulog,*) trim(subname),' ERROR: at l = ',l,'total PFT weight is ',sumwtlunit(l), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + do g = bounds%begg,bounds%endg + if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then + write(iulog,*) trim(subname),' ERROR: at g = ',g,'total PFT weight is ',sumwtgcell(g), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + ! Check col-level weights + sumwtlunit(bounds%begl : bounds%endl) = 0._r8 + sumwtgcell(bounds%begg : bounds%endg) = 0._r8 + + do c = bounds%begc,bounds%endc + l = col%landunit(c) + g = col%gridcell(c) + + if ((active_only .and. col%active(c)) .or. .not. active_only) then + sumwtlunit(l) = sumwtlunit(l) + col%wtlunit(c) + sumwtgcell(g) = sumwtgcell(g) + col%wtgcell(c) + end if + end do + + do l = bounds%begl,bounds%endl + if (.not. weights_okay(sumwtlunit(l), active_only, lun%active(l))) then + write(iulog,*) trim(subname),' ERROR: at l = ',l,'total col weight is ',sumwtlunit(l), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + do g = bounds%begg,bounds%endg + if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then + write(iulog,*) trim(subname),' ERROR: at g = ',g,'total col weight is ',sumwtgcell(g), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + ! Check landunit-level weights + sumwtgcell(bounds%begg : bounds%endg) = 0._r8 + + do l = bounds%begl,bounds%endl + g = lun%gridcell(l) + if ((active_only .and. lun%active(l)) .or. .not. active_only) then + sumwtgcell(g) = sumwtgcell(g) + lun%wtgcell(l) + end if + end do + + do g = bounds%begg,bounds%endg + if (.not. weights_okay(sumwtgcell(g), active_only, i_am_active=.true.)) then + write(iulog,*) trim(subname),' ERROR: at g = ',g,'total lunit weight is ',sumwtgcell(g), & + 'active_only = ', active_only + error_found = .true. + end if + end do + + deallocate(sumwtcol, sumwtlunit, sumwtgcell) + + if (error_found) then + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Success + + end subroutine check_weights + + !----------------------------------------------------------------------- + logical function weights_okay(sumwts, active_weights_only, i_am_active) + ! + ! !DESCRIPTION: + ! Determine if sumwts (the sum of weights of children, grandchildren or + ! great-grandchildren of a column, landunit or grid cell) satisfies the requirements laid + ! out above. + ! + ! The way this is determined depends on the values of two other variables: + ! - active_weights_only: does sumwts just include weights of active children, + ! grandchildren or great-grandchilden? (alternative is that it includes weights of ALL + ! children, grandchildren or great-grandchildren) + ! - i_am_active: true if the column, landunit or grid cell of interest is active + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: sumwts ! sum of weights of children, grandchildren or great-grandchildren + logical , intent(in) :: active_weights_only ! true if sumwts just includes active children, etc. + logical , intent(in) :: i_am_active ! true if the current point is active + ! + ! !LOCAL VARIABLES: + logical :: weights_equal_1 + real(r8), parameter :: tolerance = 1.e-12_r8 ! tolerance for checking whether weights sum to 1 + !------------------------------------------------------------------------ + + weights_equal_1 = (abs(sumwts - 1._r8) <= tolerance) + + if (active_weights_only) then + if (i_am_active) then ! condition (2) above + weights_okay = weights_equal_1 + else ! condition (3) above + weights_okay = (sumwts == 0._r8 .or. weights_equal_1) + end if + else ! condition (1) above + ! (note that i_am_active is irrelevant in this case) + weights_okay = weights_equal_1 + end if + + end function weights_okay + + !----------------------------------------------------------------------- + subroutine set_subgrid_diagnostic_fields(bounds) + ! + ! !DESCRIPTION: + ! Set history fields giving diagnostics about subgrid weights + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_subgrid_diagnostic_fields' + !----------------------------------------------------------------------- + + call set_pct_landunit_diagnostics(bounds) + + ! Note: (MV, 10-17-14): The following has an use_ed if-block around it since + ! the pct_pft_diagnostics referens to patch%itype(p) which is not used by ED + + if (.not. use_ed) then + call set_pct_pft_diagnostics(bounds) + end if + + call set_pct_glc_mec_diagnostics(bounds) + + end subroutine set_subgrid_diagnostic_fields + + !----------------------------------------------------------------------- + subroutine set_pct_landunit_diagnostics(bounds) + ! + ! !DESCRIPTION: + ! Set pct_landunit diagnostic field: % of each landunit on the grid cell + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g, l ! grid cell & landunit indices + integer :: ltype ! landunit type + + character(len=*), parameter :: subname = 'set_pct_landunit_diagnostics' + !----------------------------------------------------------------------- + + subgrid_weights_diagnostics%pct_landunit(bounds%begg:bounds%endg, :) = 0._r8 + + do l = bounds%begl, bounds%endl + g = lun%gridcell(l) + ltype = lun%itype(l) + subgrid_weights_diagnostics%pct_landunit(g, ltype) = lun%wtgcell(l) * 100._r8 + end do + + end subroutine set_pct_landunit_diagnostics + + !----------------------------------------------------------------------- + subroutine set_pct_glc_mec_diagnostics(bounds) + ! + ! !DESCRIPTION: + ! Set pct_glc_mec diagnostic field: % of each glc_mec column on the glc_mec landunit + ! + ! Note: it's safe to call this even if we're not running with glc_mec, but in that + ! case it won't do anything. + ! + ! Note that pct_glc_mec will be 0 for all elevation classes in a grid cell that does + ! not have a glc_mec landunit. However, it will still sum to 100% for a grid cell + ! that has a 0-weight (i.e., virtual) glc_mec landunit. + ! + ! !USES: + use landunit_varcon, only : istice_mec + use column_varcon, only : col_itype_to_icemec_class + use clm_varpar, only : maxpatch_glcmec + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,l,g ! indices + integer :: icemec_class ! icemec class (1..maxpatch_glcmec) + + character(len=*), parameter :: subname = 'set_pct_glc_mec_diagnostics' + !----------------------------------------------------------------------- + + if (maxpatch_glcmec > 0) then + subgrid_weights_diagnostics%pct_glc_mec(bounds%begg:bounds%endg, :) = 0._r8 + + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + l = col%landunit(c) + if (lun%itype(l) == istice_mec) then + icemec_class = col_itype_to_icemec_class(col%itype(c)) + subgrid_weights_diagnostics%pct_glc_mec(g, icemec_class) = col%wtlunit(c) * 100._r8 + end if + end do + end if + + end subroutine set_pct_glc_mec_diagnostics + + !----------------------------------------------------------------------- + subroutine set_pct_pft_diagnostics(bounds) + ! + ! !DESCRIPTION: + ! Set pct_nat_pft & pct_cft diagnostic fields: % of PFTs on their landunit + ! + ! !USES: + use landunit_varcon, only : istsoil, istcrop + use clm_varpar, only : natpft_lb, cft_lb + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,l,g ! indices + integer :: ptype ! patch itype + integer :: ptype_1indexing ! patch itype, translated into 1-indexing for the given landunit type + + character(len=*), parameter :: subname = 'set_pct_pft_diagnostics' + !----------------------------------------------------------------------- + + subgrid_weights_diagnostics%pct_nat_pft(bounds%begg:bounds%endg, :) = 0._r8 + + ! Note that pct_cft will be 0-size if cft_size is 0 (which can happen if we don't + ! have a crop landunit). But it doesn't hurt to have this line setting all elements + ! to 0, and doing this always allows us to avoid extra logic which could be a + ! maintenance problem. + subgrid_weights_diagnostics%pct_cft(bounds%begg:bounds%endg, :) = 0._r8 + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + l = patch%landunit(p) + ptype = patch%itype(p) + if (lun%itype(l) == istsoil) then + ptype_1indexing = ptype + (1 - natpft_lb) + subgrid_weights_diagnostics%pct_nat_pft(g, ptype_1indexing) = patch%wtlunit(p) * 100._r8 + else if (lun%itype(l) == istcrop) then + ptype_1indexing = ptype + (1 - cft_lb) + subgrid_weights_diagnostics%pct_cft(g, ptype_1indexing) = patch%wtlunit(p) * 100._r8 + end if + end do + + end subroutine set_pct_pft_diagnostics + +end module subgridWeightsMod diff --git a/components/clm/src/main/surfrdMod.F90 b/components/clm/src/main/surfrdMod.F90 new file mode 100644 index 0000000000..d39d92dd77 --- /dev/null +++ b/components/clm/src/main/surfrdMod.F90 @@ -0,0 +1,879 @@ +module surfrdMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains methods for reading in surface data file and determining + ! subgrid weights + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varpar , only : nlevsoifl, numpft, numcft + use landunit_varcon , only : numurbl + use clm_varcon , only : grlnd + use clm_varctl , only : iulog, scmlat, scmlon, single_column + use clm_varctl , only : create_glacier_mec_landunit, use_cndv + use surfrdUtilsMod , only : check_sums_equal_1 + use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_io, check_var, ncd_inqfdims, check_dim, ncd_inqdid + use pio + use spmdMod + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) + public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) + public :: surfrd_get_topo ! Read grid topography into domain (after domain decomp) + public :: surfrd_get_data ! Read surface dataset and determine subgrid weights + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: surfrd_special + private :: surfrd_veg_all + private :: surfrd_veg_dgvm + ! + ! !PRIVATE DATA MEMBERS: + ! default multiplication factor for epsilon for error checks + real(r8), private, parameter :: eps_fact = 2._r8 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine surfrd_get_globmask(filename, mask, ni, nj) + ! + ! !DESCRIPTION: + ! Read the surface dataset grid related information: + ! This is the first routine called by clm_initialize + ! NO DOMAIN DECOMPOSITION HAS BEEN SET YET + ! + ! !USES: + use fileutils , only : getfil + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: filename ! grid filename + integer , pointer :: mask(:) ! grid mask + integer , intent(out) :: ni, nj ! global grid sizes + ! + ! !LOCAL VARIABLES: + logical :: isgrid2d + integer :: dimid,varid ! netCDF id's + integer :: ns ! size of grid on file + integer :: n,i,j ! index + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + type(var_desc_t) :: vardesc ! variable descriptor + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name + !----------------------------------------------------------------------- + + if (filename == ' ') then + mask(:) = 1 + RETURN + end if + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions and if grid file is 2d or 1d + + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + if (masterproc) then + write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d + end if + + allocate(mask(ns)) + mask(:) = 1 + + if (isgrid2d) then + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + end if + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + end if + deallocate(idata2d) + else + call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + end if + end if + if (.not. readvar) call endrun( msg=' ERROR: landmask not on fatmlndfrc file'//errMsg(__FILE__, __LINE__)) + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_globmask + + !----------------------------------------------------------------------- + subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) + ! + ! !DESCRIPTION: + ! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED + ! Read the surface dataset grid related information: + ! o real latitude of grid cell (degrees) + ! o real longitude of grid cell (degrees) + ! + ! !USES: + use clm_varcon, only : spval, re + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use fileutils , only : getfil + ! + ! !ARGUMENTS: + integer ,intent(in) :: begg, endg + type(domain_type),intent(inout) :: ldomain ! domain to init + character(len=*) ,intent(in) :: filename ! grid filename + character(len=*) ,optional, intent(in) :: glcfilename ! glc mask filename + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf id + type(file_desc_t) :: ncidg ! netCDF id for glcmask + type(var_desc_t) :: vardesc ! variable descriptor + integer :: beg ! local beg index + integer :: end ! local end index + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: start(1), count(1) ! 1d lat/lon array sections + integer :: ier,ret ! error status + logical :: readvar ! true => variable is on input file + logical :: isgrid2d ! true => file is 2d lat/lon + logical :: istype_domain ! true => input file is of type domain + real(r8), allocatable :: rdata2d(:,:) ! temporary + character(len=16) :: vname ! temporary + character(len=256):: locfn ! local file name + integer :: n ! indices + real(r8):: eps = 1.0e-12_r8 ! lat/lon error tolerance + character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + ! Determine isgrid2d flag for domain + call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine type of file - old style grid file or new style domain file + call check_var(ncid=ncid, varname='LONGXY', vardesc=vardesc, readvar=readvar) + if (readvar) istype_domain = .false. + + call check_var(ncid=ncid, varname='xc', vardesc=vardesc, readvar=readvar) + if (readvar) istype_domain = .true. + + ! Read in area, lon, lat + + if (istype_domain) then + call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + ! convert from radians**2 to km**2 + ldomain%area = ldomain%area * (re**2) + if (.not. readvar) call endrun( msg=' ERROR: area NOT on file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: xc NOT on file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: yc NOT on file'//errMsg(__FILE__, __LINE__)) + else + call ncd_io(ncid=ncid, varname= 'AREA', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: AREA NOT on file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname= 'LONGXY', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: LONGXY NOT on file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname= 'LATIXY', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: LATIXY NOT on file'//errMsg(__FILE__, __LINE__)) + end if + + if (isgrid2d) then + allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) + if (istype_domain) then + vname = 'xc' + else + vname = 'LONGXY' + end if + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lon1d(:) = rdata2d(:,1) + if (istype_domain) then + vname = 'yc' + else + vname = 'LATIXY' + end if + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lat1d(:) = rdata2d(1,:) + deallocate(rdata2d) + end if + + ! Check lat limited to -90,90 + + if (minval(ldomain%latc) < -90.0_r8 .or. & + maxval(ldomain%latc) > 90.0_r8) then + write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & + minval(ldomain%latc),maxval(ldomain%latc) + ! call endrun( msg=' ERROR: lat is outside [-90,90]'//errMsg(__FILE__, __LINE__)) + ! write(iulog,*) trim(subname),' Limiting lat/lon to [-90/90] from ', & + ! minval(domain%latc),maxval(domain%latc) + ! where (ldomain%latc < -90.0_r8) ldomain%latc = -90.0_r8 + ! where (ldomain%latc > 90.0_r8) ldomain%latc = 90.0_r8 + endif + + call ncd_io(ncid=ncid, varname='LANDMASK', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDMASK NOT on fracdata file'//errMsg(__FILE__, __LINE__)) + end if + end if + + call ncd_io(ncid=ncid, varname='LANDFRAC', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: LANDFRAC NOT on fracdata file'//errMsg(__FILE__, __LINE__)) + end if + end if + + call ncd_pio_closefile(ncid) + + if (present(glcfilename)) then + if (masterproc) then + if (glcfilename == ' ') then + write(iulog,*) trim(subname),' ERROR: glc filename must be specified ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end if + call getfil( glcfilename, locfn, 0 ) + call ncd_pio_openfile (ncidg, trim(locfn), 0) + + ldomain%glcmask(:) = 0 + call ncd_io(ncid=ncidg, varname='GLCMASK', flag='read', data=ldomain%glcmask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: GLCMASK NOT in file'//errMsg(__FILE__, __LINE__)) + + ! Make sure the glc mask is a subset of the land mask + do n = begg,endg + if (ldomain%glcmask(n)==1 .and. ldomain%mask(n)==0) then + write(iulog,*)trim(subname),& + 'initialize1: landmask/glcmask mismatch' + write(iulog,*)trim(subname),& + 'glc requires input where landmask = 0, gridcell index', n + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + enddo + call ncd_pio_closefile(ncidg) + endif ! present(glcfilename) + + end subroutine surfrd_get_grid + + !----------------------------------------------------------------------- + subroutine surfrd_get_topo(domain,filename) + ! + ! !DESCRIPTION: + ! Read the topo dataset grid related information: + ! Assume domain has already been initialized and read + ! + ! !USES: + use domainMod , only : domain_type + use fileutils , only : getfil + ! + ! !ARGUMENTS: + type(domain_type),intent(inout) :: domain ! domain to init + character(len=*) ,intent(in) :: filename ! grid filename + ! + ! !LOCAL VARIABLES: + type(file_desc_t) :: ncid ! netcdf file id + integer :: n ! indices + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: ier ! error status + real(r8):: eps = 1.0e-12_r8 ! lat/lon error tolerance + integer :: beg,end ! local beg,end indices + logical :: isgrid2d ! true => file is 2d lat/lon + real(r8),pointer :: lonc(:),latc(:) ! local lat/lon + character(len=256) :: locfn ! local file name + logical :: readvar ! is variable on file + character(len=32) :: subname = 'surfrd_get_topo' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(__FILE__, __LINE__)) + else + write(iulog,*) 'Attempting to read lnd topo from flndtopo ',trim(filename) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + if (domain%ns /= ns) then + write(iulog,*) trim(subname),' ERROR: topo file mismatch ns',& + domain%ns,ns + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + + beg = domain%nbeg + end = domain%nend + + allocate(latc(beg:end),lonc(beg:end)) + + call ncd_io(ncid=ncid, varname='LONGXY', flag='read', data=lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: LONGXY NOT on topodata file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='LATIXY', flag='read', data=latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: LONGXY NOT on topodata file'//errMsg(__FILE__, __LINE__)) + + do n = beg,end + if (abs(latc(n)-domain%latc(n)) > eps .or. & + abs(lonc(n)-domain%lonc(n)) > eps) then + write(iulog,*) trim(subname),' ERROR: topo file mismatch lat,lon',latc(n),& + domain%latc(n),lonc(n),domain%lonc(n),eps + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + enddo + + call ncd_io(ncid=ncid, varname='TOPO', flag='read', data=domain%topo, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: LONGXY NOT on topodata file'//errMsg(__FILE__, __LINE__)) + + deallocate(latc,lonc) + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_topo + + !----------------------------------------------------------------------- + subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat) + ! + ! !DESCRIPTION: + ! Read the surface dataset and create subgrid weights. + ! The model's surface dataset recognizes 6 basic land cover types within a grid + ! cell: lake, wetland, urban, glacier, glacier_mec and vegetated. The vegetated + ! portion of the grid cell is comprised of up to [maxpatch_pft] patches. These + ! subgrid patches are read in explicitly for each grid cell. This is in + ! contrast to LSMv1, where the patches were built implicitly from biome types. + ! o real latitude of grid cell (degrees) + ! o real longitude of grid cell (degrees) + ! o integer surface type: 0 = ocean or 1 = land + ! o integer soil color (1 to 20) for use with soil albedos + ! o real soil texture, %sand, for thermal and hydraulic properties + ! o real soil texture, %clay, for thermal and hydraulic properties + ! o real % of cell covered by lake for use as subgrid patch + ! o real % of cell covered by wetland for use as subgrid patch + ! o real % of cell that is urban for use as subgrid patch + ! o real % of cell that is glacier for use as subgrid patch + ! o real % of cell that is glacier_mec for use as subgrid patch + ! o integer PFTs + ! o real % abundance PFTs (as a percent of vegetated area) + ! + ! !USES: + use clm_varctl , only : create_crop_landunit + use fileutils , only : getfil + use domainMod , only : domain_type, domain_init, domain_clean + use clm_instur , only : wt_lunit, topo_glc_mec + ! + ! !ARGUMENTS: + integer, intent(in) :: begg, endg + type(domain_type),intent(in) :: ldomain ! land domain + character(len=*), intent(in) :: lfsurdat ! surface dataset filename + ! + ! !LOCAL VARIABLES: + type(var_desc_t) :: vardesc ! pio variable descriptor + type(domain_type) :: surfdata_domain ! local domain associated with surface dataset + character(len=256):: locfn ! local file name + integer :: n ! loop indices + integer :: ni,nj,ns ! domain sizes + character(len=16) :: lon_var, lat_var ! names of lat/lon on dataset + logical :: readvar ! true => variable is on dataset + real(r8) :: rmaxlon,rmaxlat ! local min/max vars + type(file_desc_t) :: ncid ! netcdf id + logical :: istype_domain ! true => input file is of type domain + logical :: isgrid2d ! true => intut grid is 2d + character(len=32) :: subname = 'surfrd_get_data' ! subroutine name + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read surface boundary data .....' + if (lfsurdat == ' ') then + write(iulog,*)'lfsurdat must be specified' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + endif + + topo_glc_mec(:,:) = 0._r8 + + ! Read surface data + + call getfil( lfsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Read in patch mask - this variable is only on the surface dataset - but not + ! on the domain dataset + + call ncd_io(ncid=ncid, varname= 'PFTDATA_MASK', flag='read', data=ldomain%pftm, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: pftm NOT on surface dataset'//errMsg(__FILE__, __LINE__)) + + ! Check if fsurdat grid is "close" to fatmlndfrc grid, exit if lats/lon > 0.001 + + call check_var(ncid=ncid, varname='xc', vardesc=vardesc, readvar=readvar) + if (readvar) then + istype_domain = .true. + else + call check_var(ncid=ncid, varname='LONGXY', vardesc=vardesc, readvar=readvar) + if (readvar) then + istype_domain = .false. + else + call endrun( msg=' ERROR: unknown domain type'//errMsg(__FILE__, __LINE__)) + end if + end if + if (istype_domain) then + lon_var = 'xc' + lat_var = 'yc' + else + lon_var = 'LONGXY' + lat_var = 'LATIXY' + end if + if ( masterproc )then + write(iulog,*) trim(subname),' lon_var = ',trim(lon_var),' lat_var =',trim(lat_var) + end if + + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + call domain_init(surfdata_domain, isgrid2d, ni, nj, begg, endg, clmlevel=grlnd) + + call ncd_io(ncid=ncid, varname=lon_var, flag='read', data=surfdata_domain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: lon var NOT on surface dataset'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname=lat_var, flag='read', data=surfdata_domain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: lat var NOT on surface dataset'//errMsg(__FILE__, __LINE__)) + + rmaxlon = 0.0_r8 + rmaxlat = 0.0_r8 + do n = begg,endg + if (ldomain%lonc(n)-surfdata_domain%lonc(n) > 300.) then + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)-360._r8)) + elseif (ldomain%lonc(n)-surfdata_domain%lonc(n) < -300.) then + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)+360._r8)) + else + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n))) + endif + rmaxlat = max(rmaxlat,abs(ldomain%latc(n)-surfdata_domain%latc(n))) + enddo + if (rmaxlon > 0.001_r8 .or. rmaxlat > 0.001_r8) then + write(iulog,*)' ERROR: surfdata/fatmgrid lon/lat mismatch error', rmaxlon,rmaxlat + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + call domain_clean(surfdata_domain) + + ! Obtain special landunit info + + call surfrd_special(begg, endg, ncid, ldomain%ns) + + ! Obtain vegetated landunit info + + call surfrd_veg_all(begg, endg, ncid, ldomain%ns) + + if (use_cndv) then + call surfrd_veg_dgvm(begg, endg) + end if + + call ncd_pio_closefile(ncid) + + call check_sums_equal_1(wt_lunit, begg, 'wt_lunit', subname) + + if ( masterproc )then + write(iulog,*) 'Successfully read surface boundary data' + write(iulog,*) + end if + + end subroutine surfrd_get_data + +!----------------------------------------------------------------------- + subroutine surfrd_special(begg, endg, ncid, ns) + ! + ! !DESCRIPTION: + ! Determine weight with respect to gridcell of all special "patches" as well + ! as soil color and percent sand and clay + ! + ! !USES: + use clm_varpar , only : maxpatch_glcmec, nlevurb + use landunit_varcon , only : isturb_MIN, isturb_MAX, istdlak, istwet, istice, istice_mec + use clm_instur , only : wt_lunit, urban_valid, wt_glc_mec, topo_glc_mec + use UrbanParamsType , only : CheckUrban + ! + ! !ARGUMENTS: + integer , intent(in) :: begg, endg + type(file_desc_t), intent(inout) :: ncid ! netcdf id + integer , intent(in) :: ns ! domain size + ! + ! !LOCAL VARIABLES: + integer :: n,nl,nurb,g ! indices + integer :: dimid,varid ! netCDF id's + real(r8) :: nlevsoidata(nlevsoifl) + logical :: found ! temporary for error check + integer :: nindx ! temporary for error check + integer :: ier ! error status + logical :: readvar + real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier + real(r8),pointer :: pctlak(:) ! percent of grid cell is lake + real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland + real(r8),pointer :: pcturb(:,:) ! percent of grid cell is urbanized + integer ,pointer :: urban_region_id(:) + real(r8),pointer :: pctglc_mec_tot(:) ! percent of grid cell is glacier (sum over classes) + real(r8),pointer :: pcturb_tot(:) ! percent of grid cell is urban (sum over density classes) + real(r8),pointer :: pctspec(:) ! percent of spec lunits wrt gcell + integer :: dens_index ! urban density index + character(len=32) :: subname = 'surfrd_special' ! subroutine name + real(r8) closelat,closelon + integer, parameter :: urban_invalid_region = 0 ! urban_region_id indicating invalid point +!----------------------------------------------------------------------- + + allocate(pctgla(begg:endg)) + allocate(pctlak(begg:endg)) + allocate(pctwet(begg:endg)) + allocate(pcturb(begg:endg,numurbl)) + allocate(pcturb_tot(begg:endg)) + allocate(urban_region_id(begg:endg)) + allocate(pctglc_mec_tot(begg:endg)) + allocate(pctspec(begg:endg)) + + call check_dim(ncid, 'nlevsoi', nlevsoifl) + + ! Obtain non-grid surface properties of surface dataset other than percent patch + + call ncd_io(ncid=ncid, varname='PCT_WETLAND', flag='read', data=pctwet, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_WETLAND NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='PCT_LAKE' , flag='read', data=pctlak, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_LAKE NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='PCT_GLACIER', flag='read', data=pctgla, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_GLACIER NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + ! Read urban info + if (nlevurb == 0) then + ! If PCT_URBAN is not multi-density then set pcturb to zero + pcturb = 0._r8 + urban_valid(begg:endg) = .false. + write(iulog,*)'PCT_URBAN is not multi-density, pcturb set to 0' + else + call ncd_io(ncid=ncid, varname='PCT_URBAN' , flag='read', data=pcturb, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_URBAN NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + call ncd_io(ncid=ncid, varname='URBAN_REGION_ID', flag='read', data=urban_region_id, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg= ' ERROR: URBAN_REGION_ID NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + where (urban_region_id == urban_invalid_region) + urban_valid = .false. + elsewhere + urban_valid = .true. + end where + end if + if ( nlevurb == 0 )then + if ( any(pcturb > 0.0_r8) ) then + call endrun( msg=' ERROR: PCT_URBAN MUST be zero when nlevurb=0'//errMsg(__FILE__, __LINE__)) + end if + end if + + pcturb_tot(:) = 0._r8 + do n = 1, numurbl + do nl = begg,endg + pcturb_tot(nl) = pcturb_tot(nl) + pcturb(nl,n) + enddo + enddo + + if (create_glacier_mec_landunit) then ! call ncd_io_gs_int2d + + call check_dim(ncid, 'nglcec', maxpatch_glcmec ) + call check_dim(ncid, 'nglcecp1', maxpatch_glcmec+1 ) + + call ncd_io(ncid=ncid, varname='PCT_GLC_MEC', flag='read', data=wt_glc_mec, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_GLC_MEC NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + wt_glc_mec(:,:) = wt_glc_mec(:,:) / 100._r8 + call check_sums_equal_1(wt_glc_mec, begg, 'wt_glc_mec', subname) + + call ncd_io(ncid=ncid, varname='TOPO_GLC_MEC', flag='read', data=topo_glc_mec, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: TOPO_GLC_MEC NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + + topo_glc_mec(:,:) = max(topo_glc_mec(:,:), 0._r8) + + + ! Put glacier area into the GLC_MEC landunit rather than the simple glacier landunit + pctglc_mec_tot(:) = pctgla(:) + pctgla(:) = 0._r8 + + pctspec = pctwet + pctlak + pcturb_tot + pctglc_mec_tot + + else + + pctglc_mec_tot(:) = 0._r8 + pctspec = pctwet + pctlak + pcturb_tot + pctgla + + endif + + ! Error check: glacier, lake, wetland, urban sum must be less than 100 + + found = .false. + do nl = begg,endg + if (pctspec(nl) > 100._r8+1.e-04_r8) then + found = .true. + nindx = nl + exit + end if + if (found) exit + end do + if ( found ) then + write(iulog,*)'surfrd error: patch cover>100 for nl=',nindx + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + ! Determine wt_lunit for special landunits + + do nl = begg,endg + + wt_lunit(nl,istdlak) = pctlak(nl)/100._r8 + + wt_lunit(nl,istwet) = pctwet(nl)/100._r8 + + wt_lunit(nl,istice) = pctgla(nl)/100._r8 + + wt_lunit(nl,istice_mec) = pctglc_mec_tot(nl)/100._r8 + + do n = isturb_MIN, isturb_MAX + dens_index = n - isturb_MIN + 1 + wt_lunit(nl,n) = pcturb(nl,dens_index) / 100._r8 + end do + + end do + + call CheckUrban(begg, endg, pcturb(begg:endg,:), subname) + + deallocate(pctgla,pctlak,pctwet,pcturb,pcturb_tot,urban_region_id,pctglc_mec_tot,pctspec) + + end subroutine surfrd_special + + !----------------------------------------------------------------------- + subroutine surfrd_veg_all(begg, endg, ncid, ns) + ! + ! !DESCRIPTION: + ! Determine weight arrays for non-dynamic landuse mode + ! + ! !USES: + use clm_varctl , only : irrigate + use clm_varpar , only : natpft_lb, natpft_ub, natpft_size, cft_lb, cft_ub, cft_size + use clm_varpar , only : crop_prog + use clm_instur , only : wt_lunit, wt_nat_patch, wt_cft + use landunit_varcon , only : istsoil, istcrop + use pftconMod , only : nc3crop, nc3irrig, npcropmax, pftcon + ! + ! !ARGUMENTS: + integer, intent(in) :: begg, endg + type(file_desc_t),intent(inout) :: ncid ! netcdf id + integer ,intent(in) :: ns ! domain size + ! + ! !LOCAL VARIABLES: + integer :: nl, m ! index + integer :: dimid,varid ! netCDF id's + integer :: ier ! error status + logical :: readvar ! is variable on dataset + logical :: cft_dim_exists ! does the dimension 'cft' exist on the dataset? + real(r8),pointer :: arrayl(:) ! local array + character(len=32) :: subname = 'surfrd_veg_all' ! subroutine name +!----------------------------------------------------------------------- + + call check_dim(ncid, 'lsmpft', numpft+1) + call check_dim(ncid, 'natpft', natpft_size) + + if (cft_size > 0) then + call check_dim(ncid, 'cft', cft_size) + else + ! If cft_size == 0, then we expect to be running with a surface dataset that does + ! NOT have a PCT_CFT array, and thus does not have a 'cft' dimension. Make sure + ! that's the case. + call ncd_inqdid(ncid, 'cft', dimid, cft_dim_exists) + if (cft_dim_exists) then + call endrun( msg= ' ERROR: unexpectedly found cft dimension on dataset when cft_size=0'// & + ' (if the surface dataset has a separate crop landunit, then the code'// & + ' must also have a separate crop landunit, and vice versa)'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + ! This temporary array is needed because ncd_io expects a pointer, so we can't + ! directly pass wt_lunit(begg:endg,istsoil) + allocate(arrayl(begg:endg)) + + call ncd_io(ncid=ncid, varname='PCT_NATVEG', flag='read', data=arrayl, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_NATVEG NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + wt_lunit(begg:endg,istsoil) = arrayl(begg:endg) / 100._r8 + + call ncd_io(ncid=ncid, varname='PCT_CROP', flag='read', data=arrayl, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_CROP NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + wt_lunit(begg:endg,istcrop) = arrayl(begg:endg) / 100._r8 + + deallocate(arrayl) + + call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=wt_nat_patch, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_NAT_PFT NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + wt_nat_patch(begg:endg,:) = wt_nat_patch(begg:endg,:) / 100._r8 + call check_sums_equal_1(wt_nat_patch, begg, 'wt_nat_patch', subname) + + if (cft_size > 0) then + call ncd_io(ncid=ncid, varname='PCT_CFT', flag='read', data=wt_cft, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( msg=' ERROR: PCT_CFT NOT on surfdata file'//errMsg(__FILE__, __LINE__)) + wt_cft(begg:endg,:) = wt_cft(begg:endg,:) / 100._r8 + call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname) + + else + ! If cft_size == 0, and thus we aren't reading PCT_CFT, then make sure PCT_CROP is + ! 0 everywhere (PCT_CROP > 0 anywhere requires that we have a PCT_CFT array) + if (any(wt_lunit(begg:endg,istcrop) > 0._r8)) then + call endrun( msg=' ERROR: if PCT_CROP > 0 anywhere, then cft_size must be > 0'// & + ' (if the surface dataset has a separate crop landunit, then the code'// & + ' must also have a separate crop landunit, and vice versa)'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + + ! If no irrigation, merge irrigated CFTs with rainfed + + if (crop_prog .and. .not. irrigate) then + if (masterproc) then + write(iulog,*) trim(subname)//' crop=.T. and irrigate=.F., so merging irrigated pfts with rainfed' + end if + + if (cft_size <= 0) then + call endrun( msg='ERROR: Trying to merge irrigated CFTs with rainfed, but cft_size <= 0'//& + errMsg(__FILE__, __LINE__)) + end if + + do nl = begg,endg + ! Left Hand Side: merged rainfed+irrigated crop pfts from nc3crop to + ! npcropmax-1, stride 2 + ! Right Hand Side: rainfed crop pfts from nc3crop to npcropmax-1, + ! stride 2 + ! plus irrigated crop pfts from nc3irrig to npcropmax, + ! stride 2 + ! where stride 2 means "every other" + wt_cft(nl, nc3crop:npcropmax-1:2) = & + wt_cft(nl, nc3crop:npcropmax-1:2) + wt_cft(nl, nc3irrig:npcropmax:2) + wt_cft(nl, nc3irrig:npcropmax:2) = 0._r8 + end do + + call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname) + end if + + ! Now merge CFTs into the list of crops that the CLM knows how to model + if (crop_prog) then + if (masterproc) then + write(iulog, *) trim(subname) // ' merging wheat, barley, and rye into temperate cereals' + write(iulog, *) trim(subname) // ' clm knows how to model corn, temperate cereals, and soybean' + write(iulog, *) trim(subname) // ' all other crops are lumped with the generic crop pft' + end if + + if (cft_size <= 0) then + call endrun( msg=trim(subname) // & + 'ERROR: Trying to manipulate CFT list, but cft_size <= 0' // & + errMsg(__FILE__, __LINE__)) + end if + + do nl = begg, endg + do m = 1, npcropmax + if (m /= pftcon%mergetoclmpft(m)) then + ! merge wt_cft(nl,m) into wt_cft(nl,mergetoclmpft(m)) and + ! reset wt_cft(nl,m) to zero + wt_cft(nl, pftcon%mergetoclmpft(m)) = wt_cft(nl, pftcon%mergetoclmpft(m)) + wt_cft(nl, m) + wt_cft(nl, m) = 0._r8 + end if + end do + + end do + + call check_sums_equal_1(wt_cft, begg, 'wt_cft', subname) + end if + + end subroutine surfrd_veg_all + + !----------------------------------------------------------------------- + subroutine surfrd_veg_dgvm(begg, endg) + ! + ! !DESCRIPTION: + ! Determine weights for CNDV mode. + ! + ! !USES: + use pftconMod , only : noveg + use clm_instur, only : wt_nat_patch + ! + ! !ARGUMENTS: + integer, intent(in) :: begg, endg + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'surfrd_veg_dgvm' + !----------------------------------------------------------------------- + + ! Bare ground gets 100% weight; all other natural patches are zeroed out + wt_nat_patch(begg:endg, :) = 0._r8 + wt_nat_patch(begg:endg, noveg) = 1._r8 + + call check_sums_equal_1(wt_nat_patch, begg, 'wt_nat_patch', subname) + + end subroutine surfrd_veg_dgvm + +end module surfrdMod diff --git a/components/clm/src/main/surfrdUtilsMod.F90 b/components/clm/src/main/surfrdUtilsMod.F90 new file mode 100644 index 0000000000..9311aadef3 --- /dev/null +++ b/components/clm/src/main/surfrdUtilsMod.F90 @@ -0,0 +1,62 @@ +module surfrdUtilsMod + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains utility methods that can be used when reading surface datasets or similar + ! datasets (such as the landuse_timeseries dataset) + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: check_sums_equal_1 ! Confirm that sum(arr(n,:)) == 1 for all n + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine check_sums_equal_1(arr, lb, name, caller) + ! + ! !DESCRIPTION: + ! Confirm that sum(arr(n,:)) == 1 for all n. If this isn't true for any n, abort with a message. + ! + ! !ARGUMENTS: + integer , intent(in) :: lb ! lower bound of the first dimension of arr + real(r8) , intent(in) :: arr(lb:,:) ! array to check + character(len=*), intent(in) :: name ! name of array + character(len=*), intent(in) :: caller ! identifier of caller, for more meaningful error messages + ! + ! !LOCAL VARIABLES: + logical :: found + integer :: nl + integer :: nindx + real(r8), parameter :: eps = 1.e-14_r8 + !----------------------------------------------------------------------- + + found = .false. + + do nl = lbound(arr, 1), ubound(arr, 1) + if (abs(sum(arr(nl,:)) - 1._r8) > eps) then + found = .true. + nindx = nl + exit + end if + end do + + if (found) then + write(iulog,*) trim(caller), ' ERROR: sum of ', trim(name), ' not 1.0 at nl=', nindx + write(iulog,*) 'sum is: ', sum(arr(nindx,:)) + call endrun(msg=errMsg(__FILE__, __LINE__)) + end if + + end subroutine check_sums_equal_1 + +end module surfrdUtilsMod diff --git a/components/clm/src/main/test/CMakeLists.txt b/components/clm/src/main/test/CMakeLists.txt new file mode 100644 index 0000000000..dda11679dd --- /dev/null +++ b/components/clm/src/main/test/CMakeLists.txt @@ -0,0 +1,4 @@ +add_subdirectory(subgridWeights_test) +add_subdirectory(atm2lnd_test) +add_subdirectory(clm_glclnd_test) +add_subdirectory(ncdio_utils_test) \ No newline at end of file diff --git a/components/clm/src/main/test/atm2lnd_test/CMakeLists.txt b/components/clm/src/main/test/atm2lnd_test/CMakeLists.txt new file mode 100644 index 0000000000..a129ccbc3f --- /dev/null +++ b/components/clm/src/main/test/atm2lnd_test/CMakeLists.txt @@ -0,0 +1,8 @@ +set(pfunit_sources + test_partition_precip.pf + test_sens_heat_from_precip_conversion.pf) + +create_pFUnit_test(atm2lnd test_atm2lnd_exe + "${pfunit_sources}" "") + +target_link_libraries(test_atm2lnd_exe clm csm_share esmf_wrf_timemgr) \ No newline at end of file diff --git a/components/clm/src/main/test/atm2lnd_test/test_partition_precip.pf b/components/clm/src/main/test/atm2lnd_test/test_partition_precip.pf new file mode 100644 index 0000000000..eebcd758f5 --- /dev/null +++ b/components/clm/src/main/test/atm2lnd_test/test_partition_precip.pf @@ -0,0 +1,224 @@ +module test_partition_precip + + ! Tests of atm2lndMod: partition_precip + + use pfunit_mod + use atm2lndMod + use atm2lndType + use shr_kind_mod, only : r8 => shr_kind_r8 + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod + use unittestArrayMod + use clm_varctl, only : repartition_rain_snow + use clm_varcon, only : hfus ! latent heat of fusion for ice [J/kg] + use clm_varcon, only : denh2o ! density of liquid water [kg/m3] + use shr_const_mod, only : SHR_CONST_TKFRZ + + implicit none + + @TestCase + type, extends(TestCase) :: TestPartitionPrecip + type(atm2lnd_type) :: atm2lnd_inst + real(r8), allocatable :: sh_from_conversion(:) + contains + procedure :: setUp + procedure :: tearDown + procedure :: set_inputs + end type TestPartitionPrecip + + real(r8), parameter :: tol = 1.e-13 + real(r8), parameter :: mm_to_m = 1.e-3_r8 ! multiply by this to convert from mm to m + +contains + + subroutine setUp(this) + class(TestPartitionPrecip), intent(inout) :: this + + repartition_rain_snow = .true. + + end subroutine setUp + + subroutine tearDown(this) + class(TestPartitionPrecip), intent(inout) :: this + + call this%atm2lnd_inst%Clean() + call unittest_subgrid_teardown() + end subroutine tearDown + + subroutine set_inputs(this, rain, snow, temperature) + ! set necessary input variables + class(TestPartitionPrecip), intent(inout) :: this + real(r8), intent(in) :: rain(:) + real(r8), intent(in) :: snow(:) + real(r8), intent(in) :: temperature(:) + + ! Allocate necessary variables + call this%atm2lnd_inst%Init(bounds) + this%sh_from_conversion = col_array() + + ! set input variables + this%atm2lnd_inst%forc_rain_not_downscaled_grc(bounds%begg:bounds%endg) = rain(:) + this%atm2lnd_inst%forc_snow_not_downscaled_grc(bounds%begg:bounds%endg) = snow(:) + this%atm2lnd_inst%forc_t_downscaled_col(bounds%begc:bounds%endc) = temperature(:) + end subroutine set_inputs + + @Test + subroutine lowTemp_resultsInCorrectPartitioning(this) + class(TestPartitionPrecip), intent(inout) :: this + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[1._r8], snow=[2._r8], temperature=[270._r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + associate(& + rain_col => this%atm2lnd_inst%forc_rain_downscaled_col, & + snow_col => this%atm2lnd_inst%forc_snow_downscaled_col) + @assertEqual(0._r8, rain_col(begc), tolerance=tol) + @assertEqual(3._r8, snow_col(begc), tolerance=tol) + end associate + end subroutine lowTemp_resultsInCorrectPartitioning + + @Test + subroutine highTemp_resultsInCorrectPartitioning(this) + class(TestPartitionPrecip), intent(inout) :: this + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[1._r8], snow=[2._r8], temperature=[276._r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + associate(& + rain_col => this%atm2lnd_inst%forc_rain_downscaled_col, & + snow_col => this%atm2lnd_inst%forc_snow_downscaled_col) + @assertEqual(3._r8, rain_col(begc), tolerance=tol) + @assertEqual(0._r8, snow_col(begc), tolerance=tol) + end associate + end subroutine highTemp_resultsInCorrectPartitioning + + @Test + subroutine intermediateTemp_resultsInCorrectPartitioning(this) + class(TestPartitionPrecip), intent(inout) :: this + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[1._r8], snow=[2._r8], temperature=[SHR_CONST_TKFRZ + 1.5_r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + associate(& + rain_col => this%atm2lnd_inst%forc_rain_downscaled_col, & + snow_col => this%atm2lnd_inst%forc_snow_downscaled_col) + @assertEqual(3._r8 * 0.75_r8, rain_col(begc), tolerance=tol) + @assertEqual(3._r8 * 0.25_r8, snow_col(begc), tolerance=tol) + end associate + end subroutine intermediateTemp_resultsInCorrectPartitioning + + @Test + subroutine noConversion_resultsInNoHeatFlux(this) + class(TestPartitionPrecip), intent(inout) :: this + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[5._r8], snow=[0._r8], temperature=[290._r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + @assertEqual([0._r8], this%sh_from_conversion) + end subroutine noConversion_resultsInNoHeatFlux + + @Test + subroutine snowToRain_resultsInCorrectHeatFlux(this) + class(TestPartitionPrecip), intent(inout) :: this + real(r8), parameter :: snow_old = 3._r8 ! [mm] + real(r8) :: expected + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[2._r8], snow=[snow_old], temperature=[290._r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + ! Snow to rain extracts energy, so results in a negative heat flux to atm + expected = -1._r8 * snow_old * mm_to_m * denh2o * hfus + @assertEqual([expected], this%sh_from_conversion, tolerance=tol) + end subroutine snowToRain_resultsInCorrectHeatFlux + + @Test + subroutine rainToSnow_resultsInCorrectHeatFlux(this) + class(TestPartitionPrecip), intent(inout) :: this + real(r8), parameter :: rain_old = 2._r8 ! [mm] + real(r8) :: expected + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[rain_old], snow=[3._r8], temperature=[250._r8]) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + ! Rain to snow releases energy, so results in a positive heat flux to atm + expected = rain_old * mm_to_m * denh2o * hfus + @assertEqual([expected], this%sh_from_conversion, tolerance=tol) + end subroutine rainToSnow_resultsInCorrectHeatFlux + + @Test + subroutine repartitionFlagFalse_resultsInNoChange(this) + class(TestPartitionPrecip), intent(inout) :: this + + call setup_single_veg_patch(pft_type=1) + call this%set_inputs(rain=[1._r8], snow=[2._r8], temperature=[250._r8]) + repartition_rain_snow = .false. + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + associate(& + rain_col => this%atm2lnd_inst%forc_rain_downscaled_col, & + snow_col => this%atm2lnd_inst%forc_snow_downscaled_col) + @assertEqual([1._r8], rain_col) + @assertEqual([2._r8], snow_col) + @assertEqual([0._r8], this%sh_from_conversion) + end associate + end subroutine repartitionFlagFalse_resultsInNoChange + + @Test + subroutine multiPoint_resultsInCorrectPartitioning(this) + class(TestPartitionPrecip), intent(inout) :: this + real(r8), parameter :: rain(2) = [1._r8, 3._r8] + real(r8), parameter :: snow(2) = [2._r8, 4._r8] + real(r8), parameter :: temp(2) = [290._r8, 250._r8] + real(r8), parameter :: rain_expected(2) = [3._r8, 0._r8] + real(r8), parameter :: snow_expected(2) = [0._r8, 7._r8] + + call setup_ncells_single_veg_patch(ncells=2, pft_type=1) + call this%set_inputs(rain=rain, snow=snow, temperature=temp) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + associate(& + rain_col => this%atm2lnd_inst%forc_rain_downscaled_col, & + snow_col => this%atm2lnd_inst%forc_snow_downscaled_col) + @assertEqual(rain_expected, rain_col, tolerance=tol) + @assertEqual(snow_expected, snow_col, tolerance=tol) + end associate + + end subroutine multiPoint_resultsInCorrectPartitioning + + @Test + subroutine multiPoint_resultsInCorrectHeatFlux(this) + class(TestPartitionPrecip), intent(inout) :: this + real(r8), parameter :: rain(2) = [1._r8, 3._r8] + real(r8), parameter :: snow(2) = [2._r8, 4._r8] + real(r8), parameter :: temp(2) = [290._r8, 250._r8] + real(r8) :: sens_heat_expected(2) + + call setup_ncells_single_veg_patch(ncells=2, pft_type=1) + call this%set_inputs(rain=rain, snow=snow, temperature=temp) + + call partition_precip(bounds, this%atm2lnd_inst, this%sh_from_conversion) + + ! grid cell 1: converts snow to rain + sens_heat_expected(1) = -1._r8 * snow(1) * mm_to_m * denh2o * hfus + ! grid cell 2: converts rain to snow + sens_heat_expected(2) = rain(2) * mm_to_m * denh2o * hfus + + @assertEqual(sens_heat_expected, this%sh_from_conversion, tolerance=tol) + + end subroutine multiPoint_resultsInCorrectHeatFlux + +end module test_partition_precip diff --git a/components/clm/src/main/test/atm2lnd_test/test_sens_heat_from_precip_conversion.pf b/components/clm/src/main/test/atm2lnd_test/test_sens_heat_from_precip_conversion.pf new file mode 100644 index 0000000000..44ca36b9ec --- /dev/null +++ b/components/clm/src/main/test/atm2lnd_test/test_sens_heat_from_precip_conversion.pf @@ -0,0 +1,43 @@ +module test_sens_heat_from_precip_conversion + + ! Tests of atm2lndMod: sens_heat_from_precip_conversion + ! This module just tests edge cases that would be difficult to test from the + ! multi-point wrapper. + + use pfunit_mod + use atm2lndMod + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varcon, only : hfus ! latent heat of fusion for ice [J/kg] + use clm_varcon, only : denh2o ! density of liquid water [kg/m3] + + implicit none + + real(r8), parameter :: tol = 1.e-13_r8 + real(r8), parameter :: mm_to_m = 1.e-3_r8 ! multiply by this to convert from mm to m + +contains + + @Test + subroutine partialConversion_resultsInCorrectHeatFlux() + real(r8), parameter :: rain_old = 2._r8 ! [mm] + real(r8), parameter :: snow_old = 5._r8 ! [mm] + real(r8), parameter :: rain_new = 6._r8 ! [mm] + real(r8), parameter :: snow_new = 1._r8 ! [mm] + real(r8) :: sens_heat_flux ! [W/m2 to atm] + real(r8) :: expected + + call sens_heat_from_precip_conversion( & + rain_old = rain_old, & + snow_old = snow_old, & + rain_new = rain_new, & + snow_new = snow_new, & + sens_heat_flux = sens_heat_flux) + + ! Snow to rain extracts energy, so results in a negative heat flux to atm + expected = -4._r8 * mm_to_m * denh2o * hfus + @assertEqual(expected, sens_heat_flux, tolerance=tol) + + end subroutine partialConversion_resultsInCorrectHeatFlux + +end module test_sens_heat_from_precip_conversion + diff --git a/components/clm/src/main/test/clm_glclnd_test/CMakeLists.txt b/components/clm/src/main/test/clm_glclnd_test/CMakeLists.txt new file mode 100644 index 0000000000..f7ac27caf5 --- /dev/null +++ b/components/clm/src/main/test/clm_glclnd_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(clm_glclnd test_clm_glclnd_exe + "test_clm_glclnd.pf" "") + +target_link_libraries(test_clm_glclnd_exe clm csm_share) \ No newline at end of file diff --git a/components/clm/src/main/test/clm_glclnd_test/test_clm_glclnd.pf b/components/clm/src/main/test/clm_glclnd_test/test_clm_glclnd.pf new file mode 100644 index 0000000000..03d60684af --- /dev/null +++ b/components/clm/src/main/test/clm_glclnd_test/test_clm_glclnd.pf @@ -0,0 +1,76 @@ +module test_clm_glclnd + + ! Tests of clm_glclnd + + use pfunit_mod + use unittestSubgridMod + use shr_kind_mod, only : r8 => shr_kind_r8 + use lnd2glcMod + use landunit_varcon, only : istsoil, istice_mec + + implicit none + save + + real(r8), parameter :: tol = 1.e-14_r8 + +contains + + ! ------------------------------------------------------------------------ + ! Tests of bareland_normalization + ! ------------------------------------------------------------------------ + + @Test + subroutine test_bareland_normalization_glacier100() + ! glacier 100% of grid cell + integer :: c_soil ! column index of soil column + + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=0.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + c_soil = ci + call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=1.0_r8) + call unittest_subgrid_setup_end() + + @assertEqual(1.0_r8, bareland_normalization(c_soil)) + + call unittest_subgrid_teardown() + end subroutine test_bareland_normalization_glacier100 + + @Test + subroutine test_bareland_normalization_not1() + ! glacier < 100% of grid cell, natural veg < 100% of the remainder + integer :: c_soil ! column index of soil column + + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=0.3_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + c_soil = ci + call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=0.6_r8) + call unittest_subgrid_setup_end() + + @assertEqual(0.75_r8, bareland_normalization(c_soil), tolerance=tol) + + call unittest_subgrid_teardown() + end subroutine test_bareland_normalization_not1 + + @Test + subroutine test_bareland_normalization_1() + ! glacier < 100% of grid cell, natural veg 100% of the remainder + integer :: c_soil ! column index of soil column + + call unittest_subgrid_setup_start() + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=0.4_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + c_soil = ci + call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=0.6_r8) + call unittest_subgrid_setup_end() + + @assertEqual(1.0_r8, bareland_normalization(c_soil)) + + call unittest_subgrid_teardown() + end subroutine test_bareland_normalization_1 + +end module test_clm_glclnd diff --git a/components/clm/src/main/test/ncdio_utils_test/CMakeLists.txt b/components/clm/src/main/test/ncdio_utils_test/CMakeLists.txt new file mode 100644 index 0000000000..95ff84ac1c --- /dev/null +++ b/components/clm/src/main/test/ncdio_utils_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(ncdio_utils test_ncdio_utils_exe + "test_ncdio_utils.pf" "") + +target_link_libraries(test_ncdio_utils_exe clm csm_share) diff --git a/components/clm/src/main/test/ncdio_utils_test/test_ncdio_utils.pf b/components/clm/src/main/test/ncdio_utils_test/test_ncdio_utils.pf new file mode 100644 index 0000000000..e8cbeb37db --- /dev/null +++ b/components/clm/src/main/test/ncdio_utils_test/test_ncdio_utils.pf @@ -0,0 +1,131 @@ +module test_ncdio_utils + + ! Tests of ncdio_utils + + use pfunit_mod + use ncdio_utils + use ncdio_pio ! use the fake version of this module + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + + @TestCase + type, extends(TestCase) :: TestNcdioUtils + contains + procedure :: setUp + procedure :: tearDown + end type TestNcdioUtils + +contains + + subroutine setUp(this) + class(TestNcdioUtils), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestNcdioUtils), intent(inout) :: this + end subroutine tearDown + + ! ======================================================================== + ! Test helpers + ! ======================================================================== + + subroutine add_vars_to_file(ncid, varnames) + ! Add one or more variables to the file, with irrelevant data + type(file_desc_t), intent(inout) :: ncid + character(len=*), intent(in) :: varnames(:) + + integer :: n + + do n = 1, size(varnames) + call ncd_set_var(ncid, varnames(n), reshape([1._r8], [1,1]), [1,1]) + end do + end subroutine add_vars_to_file + + ! ------------------------------------------------------------------------ + ! Tests of find_var_on_file + ! ------------------------------------------------------------------------ + + @Test + subroutine test_find_var_on_file_oneElement_found(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + call add_vars_to_file(ncid, ['foo']) + + call find_var_on_file(ncid, 'foo', actual) + + @assertEqual('foo', actual) + end subroutine test_find_var_on_file_oneElement_found + + @Test + subroutine test_find_var_on_file_oneElement_notFound(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + + call find_var_on_file(ncid, 'foo', actual) + + @assertEqual('foo', actual) + end subroutine test_find_var_on_file_oneElement_notFound + + @Test + subroutine test_find_var_on_file_3Elements_first(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + call add_vars_to_file(ncid, ['foo', 'bar', 'baz']) + + call find_var_on_file(ncid, 'foo:bar:baz', actual) + + @assertEqual('foo', actual) + end subroutine test_find_var_on_file_3Elements_first + + @Test + subroutine test_find_var_on_file_3Elements_second(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + call add_vars_to_file(ncid, ['bar', 'baz']) + + call find_var_on_file(ncid, 'foo:bar:baz', actual) + + @assertEqual('bar', actual) + end subroutine test_find_var_on_file_3Elements_second + + @Test + subroutine test_find_var_on_file_3Elements_third(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + call add_vars_to_file(ncid, ['baz']) + + call find_var_on_file(ncid, 'foo:bar:baz', actual) + + @assertEqual('baz', actual) + end subroutine test_find_var_on_file_3Elements_third + + @Test + subroutine test_find_var_on_file_3Elements_noneFound(this) + class(TestNcdioUtils), intent(inout) :: this + character(len=256) :: actual + type(file_desc_t) :: ncid + + ncid = file_desc_t() + + call find_var_on_file(ncid, 'foo:bar:baz', actual) + + @assertEqual('foo', actual) + end subroutine test_find_var_on_file_3Elements_noneFound + +end module test_ncdio_utils diff --git a/components/clm/src/main/test/subgridWeights_test/CMakeLists.txt b/components/clm/src/main/test/subgridWeights_test/CMakeLists.txt new file mode 100644 index 0000000000..45b4d53b01 --- /dev/null +++ b/components/clm/src/main/test/subgridWeights_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(subgridWeights test_subgridWeights_exe + "test_subgridWeights.pf" "") + +target_link_libraries(test_subgridWeights_exe clm csm_share) \ No newline at end of file diff --git a/components/clm/src/main/test/subgridWeights_test/test_subgridWeights.pf b/components/clm/src/main/test/subgridWeights_test/test_subgridWeights.pf new file mode 100644 index 0000000000..7d29ef0510 --- /dev/null +++ b/components/clm/src/main/test/subgridWeights_test/test_subgridWeights.pf @@ -0,0 +1,86 @@ +module test_subgridWeights + + ! Tests of subgridWeightsMod + + use pfunit_mod + use unittestSubgridMod + use subgridWeightsMod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + save + + real(r8), parameter :: tol = 1.e-14_r8 + +contains + + subroutine setup() + call unittest_subgrid_setup_start() + + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=1, wtgcell=0.25_r8) + call unittest_add_landunit(my_gi=gi, ltype=3, wtgcell=0.75_r8) + + call unittest_subgrid_setup_end() + end subroutine setup + + subroutine teardown() + call unittest_subgrid_teardown() + end subroutine teardown + + ! ------------------------------------------------------------------------ + ! Tests of get_landunit_weight + ! ------------------------------------------------------------------------ + + @Test + subroutine test_get_landunit_weight_no_landunit() + ! no landunit of the given type + call setup() + @assertEqual(0._r8, get_landunit_weight(gi, 2)) + call teardown() + end subroutine test_get_landunit_weight_no_landunit + + @Test + subroutine test_get_landunit_weight_normal() + ! normal case, with a landunit of the given type + call setup() + @assertEqual(0.75_r8, get_landunit_weight(gi, 3), tolerance=tol) + call teardown() + end subroutine test_get_landunit_weight_normal + + ! ------------------------------------------------------------------------ + ! Tests of set_landunit_weight + ! ------------------------------------------------------------------------ + + @Test + subroutine test_set_landunit_weight() + call setup() + call set_landunit_weight(gi, 3, 0.42_r8) + @assertEqual(0.42_r8, get_landunit_weight(gi, 3), tolerance=tol) + call teardown() + end subroutine test_set_landunit_weight + + ! ------------------------------------------------------------------------ + ! Tests of is_gcell_all_ltypeX + ! ------------------------------------------------------------------------ + + @Test + subroutine test_is_gcell_all_ltypeX_false() + ! test with no landunit being 100% + call setup() + @assertFalse(is_gcell_all_ltypeX(gi, 3)) + call teardown() + end subroutine test_is_gcell_all_ltypeX_false + + @Test + subroutine test_is_gcell_all_ltypeX_true() + ! test with a landunit being 100% + call setup() + call set_landunit_weight(gi, 1, 0.0_r8) + call set_landunit_weight(gi, 3, 1.0_r8) + @assertFalse(is_gcell_all_ltypeX(gi, 1)) + @assertTrue(is_gcell_all_ltypeX(gi, 3)) + call teardown() + end subroutine test_is_gcell_all_ltypeX_true + +end module test_subgridWeights diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 new file mode 100644 index 0000000000..8b8d45e604 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -0,0 +1,777 @@ +module SoilBiogeochemCarbonFluxType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevgrnd, nlevdecomp + use clm_varcon , only : spval, ispval, dzsoi_decomp + use landunit_varcon , only : istsoil, istcrop, istdlak + use ch4varcon , only : allowlakeprod + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use ColumnType , only : col + use LandunitType , only : lun + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: soilbiogeochem_carbonflux_type + + ! fire fluxes + real(r8), pointer :: lf_conv_cflux_col (:) ! (gC/m2/s) conversion C flux due to BET and BDT area decreasing (immediate loss to atm) + real(r8), pointer :: somc_fire_col (:) ! (gC/m2/s) carbon emissions due to peat burning + + ! decomposition fluxes + real(r8), pointer :: decomp_cpools_sourcesink_col (:,:,:) ! change in decomposing c pools. Used to update concentrations concurrently with vertical transport (gC/m3/timestep) + real(r8), pointer :: decomp_cascade_hr_vr_col (:,:,:) ! vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + real(r8), pointer :: decomp_cascade_hr_col (:,:) ! vertically-integrated (diagnostic) het. resp. from decomposing C pools (gC/m2/s) + real(r8), pointer :: decomp_cascade_ctransfer_vr_col (:,:,:) ! vertically-resolved C transferred along deomposition cascade (gC/m3/s) + real(r8), pointer :: decomp_cascade_ctransfer_col (:,:) ! vertically-integrated (diagnostic) C transferred along decomposition cascade (gC/m2/s) + real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec) + real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools + real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia + real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability + real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature + real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport + real(r8), pointer :: decomp_cpools_leached_col (:,:) ! (gC/m^2/s) C loss from vertical transport from each decomposing C pool + real(r8), pointer :: decomp_cpools_transport_tendency_col (:,:,:) ! (gC/m^3/s) C tendency due to vertical transport in decomposing C pools + + ! nitrif_denitrif + real(r8), pointer :: phr_vr_col (:,:) ! (gC/m3/s) potential hr (not N-limited) + real(r8), pointer :: fphr_col (:,:) ! fraction of potential heterotrophic respiration + + real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration + real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration + real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res + + contains + + procedure , public :: Init + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: ZeroDWT + procedure , public :: Summary + + end type soilbiogeochem_carbonflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, carbon_type) + + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + + call this%InitAllocate ( bounds) + call this%InitHistory ( bounds, carbon_type ) + call this%InitCold (bounds ) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval + allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval + allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval + allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan + allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan + allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan + allocate(this%somc_fire_col (begc:endc)) ; this%somc_fire_col (:) =nan + allocate(this%lf_conv_cflux_col (begc:endc)) ; this%lf_conv_cflux_col (:) =nan + allocate(this%hr_vr_col (begc:endc,1:nlevdecomp_full)); this%hr_vr_col (:,:) =nan + + allocate(this%decomp_cpools_sourcesink_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_sourcesink_col(:,:,:)= nan + + allocate(this%decomp_cascade_hr_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_cascade_hr_vr_col(:,:,:)= spval + + allocate(this%decomp_cascade_hr_col(begc:endc,1:ndecomp_cascade_transitions)) + this%decomp_cascade_hr_col(:,:)= nan + + allocate(this%decomp_cascade_ctransfer_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_cascade_ctransfer_vr_col(:,:,:)= nan + + allocate(this%decomp_cascade_ctransfer_col(begc:endc,1:ndecomp_cascade_transitions)) + this%decomp_cascade_ctransfer_col(:,:)= nan + + allocate(this%decomp_k_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)) + this%decomp_k_col(:,:,:)= spval + + allocate(this%decomp_cpools_leached_col(begc:endc,1:ndecomp_pools)) + this%decomp_cpools_leached_col(:,:)= nan + + allocate(this%decomp_cpools_transport_tendency_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_transport_tendency_col(:,:,:)= nan + + allocate(this%hr_col (begc:endc)) ; this%hr_col (:) = nan + allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) = nan + allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, carbon_type) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : nlevdecomp, nlevdecomp_full + use clm_varctl , only : hist_wrtch4diag + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type ! one of ['c12', c13','c14'] + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj,c + character(8) :: vr_suffix + character(10) :: active + integer :: begp,endp + integer :: begc,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + !------------------------------- + ! C flux variables - native to column + !------------------------------- + + ! add history fields for all CLAMP CN variables + + if (carbon_type == 'c12') then + + this%hr_col(begc:endc) = spval + call hist_addfld1d (fname='HR', units='gC/m^2/s', & + avgflag='A', long_name='total heterotrophic respiration', & + ptr_col=this%hr_col) + + this%lithr_col(begc:endc) = spval + call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', & + avgflag='A', long_name='litter C heterotrophic respiration', & + ptr_col=this%lithr_col) + call hist_addfld1d (fname='LITHR', units='gC/m^2/s', & + avgflag='A', long_name='litter heterotrophic respiration', & + ptr_col=this%lithr_col) + + this%somhr_col(begc:endc) = spval + call hist_addfld1d (fname='SOILC_HR', units='gC/m^2/s', & + avgflag='A', long_name='soil C heterotrophic respiration', & + ptr_col=this%somhr_col) + call hist_addfld1d (fname='SOMHR', units='gC/m^2/s', & + avgflag='A', long_name='soil organic matter heterotrophic respiration', & + ptr_col=this%somhr_col) + call hist_addfld1d (fname='SOILC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='soil C loss', & + ptr_col=this%somhr_col) + + if (hist_wrtch4diag) then + this%fphr_col(begc:endc,1:nlevgrnd) = spval + call hist_addfld_decomp (fname='FPHR'//trim(vr_suffix), units='unitless', type2d='levdcmp', & + avgflag='A', long_name='fraction of potential HR due to N limitation', & + ptr_col=this%fphr_col) + end if + + this%lf_conv_cflux_col(begc:endc) = spval + call hist_addfld1d (fname='LF_CONV_CFLUX', units='gC/m^2/s', & + avgflag='A', long_name='conversion carbon due to BET and BDT area decreasing', & + ptr_col=this%lf_conv_cflux_col) + + this%somc_fire_col(begc:endc) = spval + call hist_addfld1d (fname='SOMC_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='C loss due to peat burning', & + ptr_col=this%somc_fire_col) + + do k = 1, ndecomp_pools + ! decomposition k + data2dptr => this%decomp_k_col(:,:,k) + fieldname = 'K_'//trim(decomp_cascade_con%decomp_pool_name_history(k)) + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' potential loss coefficient' + call hist_addfld_decomp (fname=fieldname, units='1/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + end do + + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_cascade_transitions + + ! output the vertically integrated fluxes only as default + !-- HR fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + data1dptr => this%decomp_cascade_hr_col(:,l) + ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file + ii = 0 + do jj = 1, ndecomp_cascade_transitions + if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1 + end do + if ( ii == 1 ) then + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR' + else + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l))) + endif + longname = 'Het. Resp. from '//& + trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l))) + call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + endif + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + data1dptr => this%decomp_cascade_ctransfer_col(:,l) + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'C' + longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' + call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + endif + + ! output the vertically resolved fluxes + if ( nlevdecomp_full > 1 ) then + !-- HR fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + data2dptr => this%decomp_cascade_hr_vr_col(:,:,l) + ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file + ii = 0 + do jj = 1, ndecomp_cascade_transitions + if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1 + end do + if ( ii == 1 ) then + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'_HR'//trim(vr_suffix) + else + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'_HR_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))& + //trim(vr_suffix) + endif + longname = 'Het. Resp. from '//& + trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l))) + call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l) + fieldname = & + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& + //'C'//trim(vr_suffix) + longname = 'decomp. of '//& + trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' C to '//& + trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' + call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + end if + + end do + + this%t_scalar_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='T_SCALAR', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='temperature inhibition of decomposition', & + ptr_col=this%t_scalar_col) + + this%w_scalar_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='W_SCALAR', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='Moisture (dryness) inhibition of decomposition', & + ptr_col=this%w_scalar_col) + + this%o_scalar_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='O_SCALAR', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='fraction by which decomposition is reduced due to anoxia', & + ptr_col=this%o_scalar_col) + + this%som_c_leached_col(begc:endc) = spval + call hist_addfld1d (fname='SOM_C_LEACHED', units='gC/m^2/s', & + avgflag='A', long_name='total flux of C from SOM pools due to leaching', & + ptr_col=this%som_c_leached_col)!, default='inactive') + + this%decomp_cpools_leached_col(begc:endc,:) = spval + this%decomp_cpools_transport_tendency_col(begc:endc,:,:) = spval + do k = 1, ndecomp_pools + if ( .not. decomp_cascade_con%is_cwd(k) ) then + data1dptr => this%decomp_cpools_leached_col(:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_LEACHING' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C leaching loss' + call hist_addfld1d (fname=fieldname, units='gC/m^2/s', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr)!, default='inactive') + + data2dptr => this%decomp_cpools_transport_tendency_col(:,:,k) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TNDNCY_VERT_TRANSPORT' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' C tendency due to vertical transport' + call hist_addfld_decomp (fname=fieldname, units='gC/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + end do + + if ( nlevdecomp_full > 1 ) then + this%hr_vr_col(begc:endc,:) = spval + call hist_addfld2d (fname='HR_vr', units='gC/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='total vertically resolved heterotrophic respiration', & + ptr_col=this%hr_vr_col) + endif + + end if + + !------------------------------- + ! C13 flux variables - native to column + !------------------------------- + + if ( carbon_type == 'c13' ) then + + this%hr_col(begc:endc) = spval + call hist_addfld1d (fname='C13_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total heterotrophic respiration', & + ptr_col=this%hr_col) + + this%lithr_col(begc:endc) = spval + call hist_addfld1d (fname='C13_LITHR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall to litter 3 C', & + ptr_col=this%lithr_col) + + this%somhr_col(begc:endc) = spval + call hist_addfld1d (fname='C13_SOMHR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 soil organic matter heterotrophic respiration', & + ptr_col=this%somhr_col) + + + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_cascade_transitions + !-- HR fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + data2dptr => this%decomp_cascade_hr_vr_col(:,:,l) + ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file + ii = 0 + do jj = 1, ndecomp_cascade_transitions + if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1 + end do + if ( ii == 1 ) then + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'_HR'//trim(vr_suffix) + else + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'_HR_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))//& + trim(vr_suffix) + endif + longname = 'C13 Het. Resp. from '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l))) + call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l) + fieldname = 'C13_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& + //'C'//trim(vr_suffix) + longname = 'C13 decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))& + //' C to '//& + trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' + call hist_addfld_decomp (fname=fieldname, units='gC13/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + end do + + end if + + !------------------------------- + ! C14 flux variables - native to column + !------------------------------- + + if (carbon_type == 'c14') then + + this%hr_col(begc:endc) = spval + call hist_addfld1d (fname='C14_HR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 total heterotrophic respiration', & + ptr_col=this%hr_col) + + this%lithr_col(begc:endc) = spval + call hist_addfld1d (fname='C14_LITHR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 fine root C litterfall to litter 3 C', & + ptr_col=this%lithr_col) + + this%somhr_col(begc:endc) = spval + call hist_addfld1d (fname='C14_SOMHR', units='gC14/m^2/s', & + avgflag='A', long_name='C14 soil organic matter heterotrophic respiration', & + ptr_col=this%somhr_col) + + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + + do l = 1, ndecomp_cascade_transitions + !-- HR fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + data2dptr => this%decomp_cascade_hr_vr_col(:,:,l) + + ! check to see if there are multiple pathways that include respiration, and if so, note that in the history file + ii = 0 + do jj = 1, ndecomp_cascade_transitions + if ( decomp_cascade_con%cascade_donor_pool(jj) == decomp_cascade_con%cascade_donor_pool(l) ) ii = ii+1 + end do + if ( ii == 1 ) then + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'_HR'//trim(vr_suffix) + else + fieldname = 'C14_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'_HR_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_receiver_pool(l)))& + //trim(vr_suffix) + endif + longname = 'C14 Het. Resp. from '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l))) + call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + data2dptr => this%decomp_cascade_ctransfer_vr_col(:,:,l) + + fieldname = 'C14_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'C_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& + //'C'//trim(vr_suffix) + longname = 'C14 decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' C to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' C' + call hist_addfld_decomp (fname=fieldname, units='gC14/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + end do + + end if + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + this%fphr_col(c,nlevdecomp+1:nlevgrnd) = 0._r8 !used to be in ch4Mod + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%fphr_col(c,nlevdecomp+1:nlevgrnd) = 0._r8 + else if (lun%itype(l) == istdlak .and. allowlakeprod) then + this%fphr_col(c,:) = spval + else ! Inactive CH4 columns + this%fphr_col(c,:) = spval + end if + + ! also initialize dynamic landcover fluxes so that they have + ! real values on first timestep, prior to calling pftdyn_cnbal + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%lf_conv_cflux_col(c) = 0._r8 + end if + end do + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,l + integer :: num_special_col ! number of good values in special_col filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + !----------------------------------------------------------------------- + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! initialize fields for special filters + + call this%SetValues (num_column=num_special_col, filter_column=special_col, & + value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read', 'write', 'define' + !----------------------------------------------------------------------- + + ! Nothing for now + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon fluxes + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonflux_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k,l ! indices + !------------------------------------------------------------------------ + + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_hr_col(i,l) = value_column + this%decomp_cascade_hr_vr_col(i,j,l) = value_column + this%decomp_cascade_ctransfer_col(i,l) = value_column + this%decomp_cascade_ctransfer_vr_col(i,j,l) = value_column + this%decomp_k_col(i,j,l) = value_column + end do + end do + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_leached_col(i,k) = value_column + end do + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_transport_tendency_col(i,j,k) = value_column + this%decomp_cpools_sourcesink_col(i,j,k) = value_column + end do + end do + end do + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%hr_vr_col(i,j) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + this%hr_col(i) = value_column + this%somc_fire_col(i) = value_column + this%som_c_leached_col(i) = value_column + this%somhr_col(i) = value_column + this%lithr_col(i) = value_column + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine ZeroDwt( this, bounds ) + ! + ! !DESCRIPTION + ! Initialize flux variables needed for dynamic land use. + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, j ! indices + !----------------------------------------------------------------------- + + ! set column-level conversion and product pool fluxes + ! to 0 at the beginning of every timestep + + do c = bounds%begc,bounds%endc + this%lf_conv_cflux_col(c) = 0._r8 + end do + + + end subroutine ZeroDwt + + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !DESCRIPTION: + ! On the radiation time step, column-level carbon summary calculations + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l + integer :: fc + !----------------------------------------------------------------------- + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_c_leached_col(c) = 0._r8 + end do + + ! vertically integrate HR and decomposition cascade fluxes + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cascade_hr_col(c,k) = & + this%decomp_cascade_hr_col(c,k) + & + this%decomp_cascade_hr_vr_col(c,j,k) * dzsoi_decomp(j) + + this%decomp_cascade_ctransfer_col(c,k) = & + this%decomp_cascade_ctransfer_col(c,k) + & + this%decomp_cascade_ctransfer_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + ! total heterotrophic respiration, vertically resolved (HR) + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_vr_col(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_vr_col(c,j) = & + this%hr_vr_col(c,j) + & + this%decomp_cascade_hr_vr_col(c,j,k) + end do + end do + end do + + ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_leached_col(c,l) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_leached_col(c,l) = this%decomp_cpools_leached_col(c,l) + & + this%decomp_cpools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) + end do + end do + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_c_leached_col(c) = this%som_c_leached_col(c) + this%decomp_cpools_leached_col(c,l) + end do + end do + + ! soil organic matter heterotrophic respiration + associate(is_soil => decomp_cascade_con%is_soil) ! TRUE => pool is a soil pool + do k = 1, ndecomp_cascade_transitions + if ( is_soil(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%somhr_col(c) = this%somhr_col(c) + this%decomp_cascade_hr_col(c,k) + end do + end if + end do + end associate + + ! litter heterotrophic respiration (LITHR) + associate(is_litter => decomp_cascade_con%is_litter) ! TRUE => pool is a litter pool + do k = 1, ndecomp_cascade_transitions + if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%lithr_col(c) = this%lithr_col(c) + this%decomp_cascade_hr_col(c,k) + end do + end if + end do + end associate + + ! total heterotrophic respiration (HR) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_col(c) = & + this%lithr_col(c) + & + this%somhr_col(c) + end do + + end subroutine Summary + +end module SoilBiogeochemCarbonFluxType + + diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 new file mode 100644 index 0000000000..1d9ff897e0 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemCarbonStateType.F90 @@ -0,0 +1,910 @@ +module SoilBiogeochemCarbonStateType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, crop_prog, nlevdecomp + use clm_varcon , only : spval, ispval, dzsoi_decomp, zisoi, zsoi + use clm_varctl , only : iulog, use_vertsoilc, spinup_state + use landunit_varcon , only : istcrop, istsoil + use abortutils , only : endrun + use spmdMod , only : masterproc + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: soilbiogeochem_carbonstate_type + + ! all c pools involved in decomposition + real(r8), pointer :: decomp_cpools_vr_col (:,:,:) ! (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + real(r8), pointer :: ctrunc_vr_col (:,:) ! (gC/m3) vertically-resolved column-level sink for C truncation + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: ctrunc_col (:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: totlitc_col (:) ! (gC/m2) total litter carbon + real(r8), pointer :: totlitc_1m_col (:) ! (gC/m2) total litter carbon to 1 meter + real(r8), pointer :: totsomc_col (:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: totsomc_1m_col (:) ! (gC/m2) total soil organic matter carbon to 1 meter + real(r8), pointer :: cwdc_col (:) ! (gC/m2) coarse woody debris C (diagnostic) + real(r8), pointer :: decomp_cpools_1m_col (:,:) ! (gC/m2) Diagnostic: decomposing (litter, cwd, soil) c pools to 1 meter + real(r8), pointer :: decomp_cpools_col (:,:) ! (gC/m2) decomposing (litter, cwd, soil) c pools + + contains + + procedure , public :: Init + procedure , public :: SetValues + procedure , public :: Restart + procedure , public :: Summary + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type soilbiogeochem_carbonstate_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, carbon_type, ratio, c12_soilbiogeochem_carbonstate_inst) + + class(soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type + real(r8) , intent(in) :: ratio + type(soilbiogeochem_carbonstate_type) , intent(in), optional :: c12_soilbiogeochem_carbonstate_inst + + call this%InitAllocate ( bounds) + call this%InitHistory ( bounds, carbon_type ) + if (present(c12_soilbiogeochem_carbonstate_inst)) then + call this%InitCold ( bounds, ratio, c12_soilbiogeochem_carbonstate_inst ) + else + call this%InitCold ( bounds, ratio) + end if + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + !------------------------------------------------------------------------ + + begc = bounds%begc; endc = bounds%endc + + allocate( this%decomp_cpools_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_col (:,:) = nan + allocate( this%decomp_cpools_1m_col (begc :endc,1:ndecomp_pools)) ; this%decomp_cpools_1m_col (:,:) = nan + + allocate( this%ctrunc_vr_col(begc :endc,1:nlevdecomp_full)) ; + this%ctrunc_vr_col (:,:) = nan + + allocate(this%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_cpools_vr_col(:,:,:)= nan + + allocate(this%ctrunc_col (begc :endc)) ; this%ctrunc_col (:) = nan + allocate(this%cwdc_col (begc :endc)) ; this%cwdc_col (:) = nan + allocate(this%totlitc_col (begc :endc)) ; this%totlitc_col (:) = nan + allocate(this%totsomc_col (begc :endc)) ; this%totsomc_col (:) = nan + allocate(this%totlitc_1m_col (begc :endc)) ; this%totlitc_1m_col (:) = nan + allocate(this%totsomc_1m_col (begc :endc)) ; this%totsomc_1m_col (:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds, carbon_type) + ! + ! !USES: + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + character(len=3) , intent(in) :: carbon_type + ! + ! !LOCAL VARIABLES: + integer :: l + integer :: begc ,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + !------------------------------------------------------------------------ + + begc = bounds%begc; endc = bounds%endc + + !------------------------------- + ! C12 state variables - column + !------------------------------- + + if (carbon_type == 'c12') then + + this%decomp_cpools_col(begc:endc,:) = spval + do l = 1, ndecomp_pools + if ( nlevdecomp_full > 1 ) then + data2dptr => this%decomp_cpools_vr_col(:,:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' + call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr) + endif + + data1dptr => this%decomp_cpools_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' + call hist_addfld1d (fname=fieldname, units='gC/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + + if ( nlevdecomp_full > 1 ) then + data1dptr => this%decomp_cpools_1m_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter' + call hist_addfld1d (fname=fieldname, units='gC/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default = 'inactive') + endif + end do + + this%totlitc_col(begc:endc) = spval + call hist_addfld1d (fname='LITTERC', units='gC/m^2', & + avgflag='A', long_name='litter C', & + ptr_col=this%totlitc_col) + call hist_addfld1d (fname='TOTLITC', units='gC/m^2', & + avgflag='A', long_name='total litter carbon', & + ptr_col=this%totlitc_col) + + this%totsomc_col(begc:endc) = spval + call hist_addfld1d (fname='TOTSOMC', units='gC/m^2', & + avgflag='A', long_name='total soil organic matter carbon', & + ptr_col=this%totsomc_col) + call hist_addfld1d (fname='SOILC', units='gC/m^2', & + avgflag='A', long_name='soil C', & + ptr_col=this%totsomc_col) + + if ( nlevdecomp_full > 1 ) then + this%totlitc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='TOTLITC_1m', units='gC/m^2', & + avgflag='A', long_name='total litter carbon to 1 meter depth', & + ptr_col=this%totlitc_1m_col) + end if + + if ( nlevdecomp_full > 1 ) then + this%totsomc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='TOTSOMC_1m', units='gC/m^2', & + avgflag='A', long_name='total soil organic matter carbon to 1 meter depth', & + ptr_col=this%totsomc_1m_col) + end if + + this%ctrunc_col(begc:endc) = spval + call hist_addfld1d (fname='COL_CTRUNC', units='gC/m^2', & + avgflag='A', long_name='column-level sink for C truncation', & + ptr_col=this%ctrunc_col) + end if + + !------------------------------- + ! C13 state variables - column + !------------------------------- + + if ( carbon_type == 'c13' ) then + + this%decomp_cpools_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_pools + if ( nlevdecomp_full > 1 ) then + data2dptr => this%decomp_cpools_vr_col(:,:,l) + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' + call hist_addfld2d (fname=fieldname, units='gC13/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr) + endif + + data1dptr => this%decomp_cpools_col(:,l) + fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + longname = 'C13 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' + call hist_addfld1d (fname=fieldname, units='gC13/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + end do + + this%totlitc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTLITC', units='gC13/m^2', & + avgflag='A', long_name='C13 total litter carbon', & + ptr_col=this%totlitc_col) + + this%totsomc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTSOMC', units='gC13/m^2', & + avgflag='A', long_name='C13 total soil organic matter carbon', & + ptr_col=this%totsomc_col) + + if ( nlevdecomp_full > 1 ) then + this%totlitc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTLITC_1m', units='gC13/m^2', & + avgflag='A', long_name='C13 total litter carbon to 1 meter', & + ptr_col=this%totlitc_1m_col) + end if + + if ( nlevdecomp_full > 1 ) then + this%totsomc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='C13_TOTSOMC_1m', units='gC13/m^2', & + avgflag='A', long_name='C13 total soil organic matter carbon to 1 meter', & + ptr_col=this%totsomc_1m_col) + endif + + this%ctrunc_col(begc:endc) = spval + call hist_addfld1d (fname='C13_COL_CTRUNC', units='gC13/m^2', & + avgflag='A', long_name='C13 column-level sink for C truncation', & + ptr_col=this%ctrunc_col) + endif + + !------------------------------- + ! C14 state variables - column + !------------------------------- + + if ( carbon_type == 'c14' ) then + + this%decomp_cpools_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_pools + if ( nlevdecomp_full > 1 ) then + data2dptr => this%decomp_cpools_vr_col(:,:,l) + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' + call hist_addfld2d (fname=fieldname, units='gC14/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, ptr_col=data2dptr) + endif + + data1dptr => this%decomp_cpools_col(:,l) + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + longname = 'C14 '//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' + call hist_addfld1d (fname=fieldname, units='gC14/m^2', & + avgflag='A', long_name=longname, ptr_col=data1dptr) + + if ( nlevdecomp_full > 1 ) then + data1dptr => this%decomp_cpools_1m_col(:,l) + fieldname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m' + longname = 'C14_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter' + call hist_addfld1d (fname=fieldname, units='gC/m^2', & + avgflag='A', long_name=longname, ptr_col=data1dptr, default='inactive') + endif + end do + + this%totlitc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTLITC', units='gC14/m^2', & + avgflag='A', long_name='C14 total litter carbon', & + ptr_col=this%totlitc_col) + + this%totsomc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTSOMC', units='gC14/m^2', & + avgflag='A', long_name='C14 total soil organic matter carbon', & + ptr_col=this%totsomc_col) + + if ( nlevdecomp_full > 1 ) then + this%totlitc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTLITC_1m', units='gC14/m^2', & + avgflag='A', long_name='C14 total litter carbon to 1 meter', & + ptr_col=this%totlitc_1m_col) + + this%totsomc_1m_col(begc:endc) = spval + call hist_addfld1d (fname='C14_TOTSOMC_1m', units='gC14/m^2', & + avgflag='A', long_name='C14 total soil organic matter carbon to 1 meter', & + ptr_col=this%totsomc_1m_col) + endif + + this%ctrunc_col(begc:endc) = spval + call hist_addfld1d (fname='C14_COL_CTRUNC', units='gC14/m^2', & + avgflag='A', long_name='C14 column-level sink for C truncation', & + ptr_col=this%ctrunc_col) + + endif + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, ratio, c12_soilbiogeochem_carbonstate_inst) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: ratio + type(soilbiogeochem_carbonstate_type), intent(in), optional :: c12_soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: p,c,l,j,k + integer :: fc ! filter index + integer :: num_special_col ! number of good values in special_col filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + !----------------------------------------------------------------------- + + ! initialize column-level variables + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (.not. present(c12_soilbiogeochem_carbonstate_inst)) then !c12 + + do j = 1, nlevdecomp + do k = 1, ndecomp_pools + if (zsoi(j) < 0.3 ) then !! only initialize upper soil column + this%decomp_cpools_vr_col(c,j,k) = decomp_cascade_con%initial_stock(k) + else + this%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + end do + this%ctrunc_vr_col(c,j) = 0._r8 + end do + if ( nlevdecomp > 1 ) then + do j = nlevdecomp+1, nlevdecomp_full + do k = 1, ndecomp_pools + this%decomp_cpools_vr_col(c,j,k) = 0._r8 + end do + this%ctrunc_vr_col(c,j) = 0._r8 + end do + end if + this%decomp_cpools_col(c,1:ndecomp_pools) = decomp_cascade_con%initial_stock(1:ndecomp_pools) + this%decomp_cpools_1m_col(c,1:ndecomp_pools) = decomp_cascade_con%initial_stock(1:ndecomp_pools) + + else + + do j = 1, nlevdecomp + do k = 1, ndecomp_pools + this%decomp_cpools_vr_col(c,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(c,j,k) * ratio + end do + this%ctrunc_vr_col(c,j) = c12_soilbiogeochem_carbonstate_inst%ctrunc_vr_col(c,j) * ratio + end do + if ( nlevdecomp > 1 ) then + do j = nlevdecomp+1, nlevdecomp_full + do k = 1, ndecomp_pools + this%decomp_cpools_vr_col(c,j,k) = 0._r8 + end do + this%ctrunc_vr_col(c,j) = 0._r8 + end do + end if + do k = 1, ndecomp_pools + this%decomp_cpools_col(c,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_col(c,k) * ratio + this%decomp_cpools_1m_col(c,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_1m_col(c,k) * ratio + end do + + endif + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + if (present(c12_soilbiogeochem_carbonstate_inst)) then + this%cwdc_col(c) = c12_soilbiogeochem_carbonstate_inst%cwdc_col(c) * ratio + else + this%cwdc_col(c) = 0._r8 + end if + this%ctrunc_col(c) = 0._r8 + this%totlitc_col(c) = 0._r8 + this%totsomc_col(c) = 0._r8 + this%totlitc_1m_col(c) = 0._r8 + this%totsomc_1m_col(c) = 0._r8 + end if + + end do + + ! now loop through special filters and explicitly set the variables that + ! have to be in place for biogeophysics + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! initialize fields for special filters + + call this%SetValues (num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag, carbon_type, c12_soilbiogeochem_carbonstate_inst ) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) + use clm_time_manager , only : is_restart, get_nstep + use shr_const_mod , only : SHR_CONST_PDB + use clm_varcon , only : c14ratio + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + character(len=3) , intent(in) :: carbon_type ! 'c12' or 'c13' or 'c14' + type(soilbiogeochem_carbonstate_type) , intent(in), optional :: c12_soilbiogeochem_carbonstate_inst + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,l,c + real(r8) :: m ! multiplier for the exit_spinup code + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + character(len=128) :: varname ! temporary + real(r8) :: c3_del13c ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c3_r1 ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8) :: c3_r2 ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + logical :: readvar + integer :: idata + logical :: exit_spinup = .false. + logical :: enter_spinup = .false. + ! spinup state as read from restart file, for determining whether to enter or exit spinup mode. + integer :: restart_file_spinup_state + ! flags for comparing the model and restart decomposition cascades + integer :: decomp_cascade_state, restart_file_decomp_cascade_state + !------------------------------------------------------------------------ + + c3_del13c = -28._r8 + c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + c3_r2 = c3_r1/(1._r8 + c3_r1) + + if (carbon_type == 'c12') then + + call restartvar(ncid=ncid, flag=flag, varname='totlitc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totlitc_col) + + call restartvar(ncid=ncid, flag=flag, varname='totsomc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totsomc_col) + + do k = 1, ndecomp_pools + varname=trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c' + if (use_vertsoilc) then + ptr2d => this%decomp_cpools_vr_col(:,:,k) + call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name='column', long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//& + errMsg(__FILE__, __LINE__)) + end if + end do + + if (use_vertsoilc) then + ptr2d => this%ctrunc_vr_col + call restartvar(ncid=ncid, flag=flag, varname='col_ctrunc_vr', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%ctrunc_vr_col(:,1) ! nlevdecomp = 1; so treat as 1D variable + call restartvar(ncid=ncid, flag=flag, varname='col_ctrunc', xtype=ncd_double, & + dim1name='column', long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//& + errMsg(__FILE__, __LINE__)) + end if + + end if + + !-------------------------------- + ! C13 column carbon state variables + !-------------------------------- + + if ( carbon_type == 'c13' ) then + + call restartvar(ncid=ncid, flag=flag, varname='totlitc_13', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totlitc_col) + if (flag=='read' .and. .not. readvar) then + if (this%totlitc_col(i) /= spval .and. .not. isnan( this%totlitc_col(i) ) ) then + this%totlitc_col(i) = c12_soilbiogeochem_carbonstate_inst%totlitc_col(i) * c3_r2 + end if + end if + + do k = 1, ndecomp_pools + varname = trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c_13' + if (use_vertsoilc) then + ptr2d => this%decomp_cpools_vr_col(:,:,k) + call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name='column', long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col' & + // ' with atmospheric c13 value for: '//trim(varname) + do i = bounds%begc,bounds%endc + do j = 1, nlevdecomp + if (this%decomp_cpools_vr_col(i,j,k) /= spval .and. .not. isnan(this%decomp_cpools_vr_col(i,j,k)) ) then + this%decomp_cpools_vr_col(i,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(i,j,k) * c3_r2 + endif + end do + end do + end if + end do + + if (use_vertsoilc) then + ptr2d => this%ctrunc_vr_col + call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c13_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%ctrunc_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c13", xtype=ncd_double, & + dim1name='column', long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + end if + + !-------------------------------- + ! C14 column carbon state variables + !-------------------------------- + + if ( carbon_type == 'c14' ) then + + call restartvar(ncid=ncid, flag=flag, varname='totlitc_14', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%totlitc_col) + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing this%totlitc_col with atmospheric c14 value' + if (this%totlitc_col(i) /= spval .and. .not. isnan(this%totlitc_col(i)) ) then + this%totlitc_col(i) = c12_soilbiogeochem_carbonstate_inst%totlitc_col(i) * c14ratio + endif + end if + + do k = 1, ndecomp_pools + varname = trim(decomp_cascade_con%decomp_pool_name_restart(k))//'c_14' + if (use_vertsoilc) then + ptr2d => this%decomp_cpools_vr_col(:,:,k) + call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%decomp_cpools_vr_col(:,1,k) ! nlevdecomp = 1; so treat as 1D variable + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name='column', & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + write(iulog,*) 'initializing soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col with atmospheric c14 value for: '//& + trim(varname) + do i = bounds%begc,bounds%endc + do j = 1, nlevdecomp + if (this%decomp_cpools_vr_col(i,j,k) /= spval .and. .not. isnan(this%decomp_cpools_vr_col(i,j,k)) ) then + this%decomp_cpools_vr_col(i,j,k) = c12_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col(i,j,k) * c3_r2 + endif + end do + end do + end if + end do + + if (use_vertsoilc) then + ptr2d => this%ctrunc_vr_col + call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c14_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%ctrunc_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname="col_ctrunc_c14", xtype=ncd_double, & + dim1name='column', long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + + end if + + !-------------------------------- + ! Spinup state + !-------------------------------- + + if (carbon_type == 'c12') then + if (flag == 'write') then + idata = spinup_state + end if + call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, & + long_name='Spinup state of the model that wrote this restart file: ' & + // ' 0 = normal model mode, 1 = AD spinup', units='', & + interpinic_flag='copy', readvar=readvar, data=idata) + if (flag == 'read') then + if (readvar) then + restart_file_spinup_state = idata + else + ! assume, for sake of backwards compatibility, that if spinup_state is not in + ! the restart file then current model state is the same as prior model state + restart_file_spinup_state = spinup_state + if ( masterproc ) then + write(iulog,*) ' CNRest: WARNING! Restart file does not contain info ' & + // ' on spinup state used to generate the restart file. ' + write(iulog,*) ' Assuming the same as current setting: ', spinup_state + end if + end if + end if + + ! now compare the model and restart file spinup states, and either take the + ! model into spinup mode or out of it if they are not identical + ! taking model out of spinup mode requires multiplying each decomposing pool + ! by the associated AD factor. + ! putting model into spinup mode requires dividing each decomposing pool + ! by the associated AD factor. + ! only allow this to occur on first timestep of model run. + + if (flag == 'read' .and. spinup_state /= restart_file_spinup_state ) then + if (spinup_state == 0 .and. restart_file_spinup_state == 1 ) then + if ( masterproc ) write(iulog,*) ' CNRest: taking SOM pools out of AD spinup mode' + exit_spinup = .true. + else if (spinup_state == 1 .and. restart_file_spinup_state == 0 ) then + if ( masterproc ) write(iulog,*) ' CNRest: taking SOM pools into AD spinup mode' + enter_spinup = .true. + else + call endrun(msg=' CNRest: error in entering/exiting spinup. spinup_state ' & + // ' != restart_file_spinup_state, but do not know what to do'//& + errMsg(__FILE__, __LINE__)) + end if + if (get_nstep() >= 2) then + call endrun(msg=' CNRest: error in entering/exiting spinup - should occur only when nstep = 1'//& + errMsg(__FILE__, __LINE__)) + endif + do k = 1, ndecomp_pools + if ( exit_spinup ) then + m = decomp_cascade_con%spinup_factor(k) + else if ( enter_spinup ) then + m = 1. / decomp_cascade_con%spinup_factor(k) + end if + do c = bounds%begc, bounds%endc + do j = 1, nlevdecomp_full + this%decomp_cpools_vr_col(c,j,k) = this%decomp_cpools_vr_col(c,j,k) * m + end do + end do + end do + end if + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set carbon state variables + ! + ! !ARGUMENTS: + class (soilbiogeochem_carbonstate_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do fi = 1,num_column + i = filter_column(fi) + this%cwdc_col(i) = value_column + this%ctrunc_col(i) = value_column + this%totlitc_col(i) = value_column + this%totlitc_1m_col(i) = value_column + this%totsomc_col(i) = value_column + this%totsomc_1m_col(i) = value_column + end do + + do j = 1,nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%ctrunc_vr_col(i,j) = value_column + end do + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_col(i,k) = value_column + this%decomp_cpools_1m_col(i,k) = value_column + end do + end do + + do j = 1,nlevdecomp_full + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cpools_vr_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !DESCRIPTION: + ! Perform column-level carbon summary calculations + ! + ! !ARGUMENTS: + class(soilbiogeochem_carbonstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! vertically integrate each of the decomposing C pools + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_col(c,l) = 0._r8 + end do + end do + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_col(c,l) = & + this%decomp_cpools_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + end do + end do + + if ( nlevdecomp > 1) then + + ! vertically integrate each of the decomposing C pools to 1 meter + maxdepth = 1._r8 + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_1m_col(c,l) = 0._r8 + end do + end do + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + if ( zisoi(j) <= maxdepth ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_1m_col(c,l) = & + this%decomp_cpools_1m_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + elseif ( zisoi(j-1) < maxdepth ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_cpools_1m_col(c,l) = & + this%decomp_cpools_1m_col(c,l) + & + this%decomp_cpools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) + end do + endif + end do + end do + + endif + + ! truncation carbon + do fc = 1,num_soilc + c = filter_soilc(fc) + this%ctrunc_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%ctrunc_col(c) = & + this%ctrunc_col(c) + & + this%ctrunc_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! total litter carbon in the top meter (TOTLITC_1m) + if ( nlevdecomp > 1) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitc_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitc_1m_col(c) = this%totlitc_1m_col(c) + & + this%decomp_cpools_1m_col(c,l) + end do + endif + end do + end if + + ! total soil organic matter carbon in the top meter (TOTSOMC_1m) + if ( nlevdecomp > 1) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomc_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomc_1m_col(c) = this%totsomc_1m_col(c) + this%decomp_cpools_1m_col(c,l) + end do + end if + end do + end if + + ! total litter carbon (TOTLITC) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitc_col(c) = this%totlitc_col(c) + this%decomp_cpools_col(c,l) + end do + endif + end do + + ! total soil organic matter carbon (TOTSOMC) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomc_col(c) = this%totsomc_col(c) + this%decomp_cpools_col(c,l) + end do + end if + end do + + ! coarse woody debris carbon + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdc_col(c) = this%cwdc_col(c) + this%decomp_cpools_col(c,l) + end do + end if + end do + + end subroutine Summary + +end module SoilBiogeochemCarbonStateType diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 new file mode 100644 index 0000000000..931c370826 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -0,0 +1,716 @@ +module SoilBiogeochemCompetitionMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Resolve plant/heterotroph competition for mineral N + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : dzsoi_decomp + use clm_varctl , only : use_nitrif_denitrif + use abortutils , only : endrun + use decompMod , only : bounds_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenUptakeMod , only : SoilBiogeochemNitrogenUptake + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemCompetitionInit ! Initialization + public :: SoilBiogeochemCompetition ! run method + + type :: params_type + real(r8) :: bdnr ! bulk denitrification rate (1/s) + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + end type params_type + ! + type(params_type), private :: params_inst ! params_inst is populated in readParamsMod + ! + ! !PUBLIC DATA MEMBERS: + character(len=* ), public, parameter :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's + character(len=* ), public, parameter :: suplnNon='NONE' ! No supplemental Nitrogen + character(len=15), public :: suplnitro = suplnNon ! Supplemental Nitrogen mode + ! + ! !PRIVATE DATA MEMBERS: + real(r8) :: dt ! decomp timestep (seconds) + real(r8) :: bdnr ! bulk denitrification rate (1/s) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='bdnr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%bdnr=tempr + + tString='compet_plant_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_plant_no3=tempr + + tString='compet_plant_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_plant_nh4=tempr + + tString='compet_decomp_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_decomp_no3=tempr + + tString='compet_decomp_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_decomp_nh4=tempr + + tString='compet_denit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_denit=tempr + + tString='compet_nit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%compet_nit=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemCompetitionInit ( bounds) + ! + ! !DESCRIPTION: + ! + ! !USES: + use clm_varcon , only: secspday + use clm_time_manager, only: get_step_size + use clm_varctl , only: iulog, cnallocate_carbon_only_set + use shr_infnan_mod , only: nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'SoilBiogeochemCompetitionInit' + logical :: carbon_only + !----------------------------------------------------------------------- + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! set space-and-time parameters from parameter file + bdnr = params_inst%bdnr * (dt/secspday) + + ! Change namelist settings into private logical variables + select case(suplnitro) + case(suplnNon) + carbon_only = .false. + case(suplnAll) + carbon_only = .true. + case default + write(iulog,*) 'Supplemental Nitrogen flag (suplnitro) can only be: ', & + suplnNon, ' or ', suplnAll + call endrun(msg='ERROR: supplemental Nitrogen flag is not correct'//& + errMsg(__FILE__, __LINE__)) + end select + + call cnallocate_carbon_only_set(carbon_only) + + end subroutine SoilBiogeochemCompetitionInit + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !USES: + use clm_varctl , only: cnallocate_carbon_only + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions + use clm_varcon , only: nitrif_n2o_loss_frac + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,l,pi,j ! indices + integer :: fc ! filter column index + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + real(r8) :: fpi_no3_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by no3(no units) + real(r8) :: fpi_nh4_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! fraction of potential immobilization supplied by nh4 (no units) + real(r8) :: sum_nh4_demand(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_nh4_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_no3_demand_scaled(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: sum_ndemand_vr(bounds%begc:bounds%endc, 1:nlevdecomp) !total column N demand (gN/m3/s) at a given level + real(r8) :: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: sminn_tot(bounds%begc:bounds%endc) + integer :: nlimit(bounds%begc:bounds%endc,0:nlevdecomp) !flag for N limitation + integer :: nlimit_no3(bounds%begc:bounds%endc,0:nlevdecomp) !flag for NO3 limitation + integer :: nlimit_nh4(bounds%begc:bounds%endc,0:nlevdecomp) !flag for NH4 limitation + real(r8) :: residual_sminn_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_sminn(bounds%begc:bounds%endc) + real(r8) :: residual_smin_nh4_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_smin_no3_vr(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) :: residual_smin_nh4(bounds%begc:bounds%endc) + real(r8) :: residual_smin_no3(bounds%begc:bounds%endc) + real(r8) :: residual_plant_ndemand(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- + + associate( & + fpg => soilbiogeochem_state_inst%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + fpi => soilbiogeochem_state_inst%fpi_col , & ! Output: [real(r8) (:) ] fraction of potential immobilization (no units) + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Output: [real(r8) (:,:) ] fraction of potential immobilization (no units) + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Output: [real(r8) (:,:) ] + plant_ndemand => soilbiogeochem_state_inst%plant_ndemand_col , & ! Input: [real(r8) (:) ] column-level plant N demand + + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + smin_nh4_vr => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + + pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + pot_f_denit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_denit_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux + f_nit_vr => soilbiogeochem_nitrogenflux_inst%f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil nitrification flux + f_denit_vr => soilbiogeochem_nitrogenflux_inst%f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) soil denitrification flux + potential_immob => soilbiogeochem_nitrogenflux_inst%potential_immob_col , & ! Output: [real(r8) (:) ] + actual_immob => soilbiogeochem_nitrogenflux_inst%actual_immob_col , & ! Output: [real(r8) (:) ] + sminn_to_plant => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_col , & ! Output: [real(r8) (:) ] + sminn_to_denit_excess_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_excess_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_no3_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_no3_vr_col , & ! Output: [real(r8) (:,:) ] + actual_immob_nh4_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_nh4_vr_col , & ! Output: [real(r8) (:,:) ] + smin_no3_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + smin_nh4_to_plant_vr => soilbiogeochem_nitrogenflux_inst%smin_nh4_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + n2_n2o_ratio_denit_vr => soilbiogeochem_nitrogenflux_inst%n2_n2o_ratio_denit_vr_col , & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN] + f_n2o_denit_vr => soilbiogeochem_nitrogenflux_inst%f_n2o_denit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from denitrification [gN/m3/s] + f_n2o_nit_vr => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_vr_col , & ! Output: [real(r8) (:,:) ] flux of N2O from nitrification [gN/m3/s] + supplement_to_sminn_vr => soilbiogeochem_nitrogenflux_inst%supplement_to_sminn_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_plant_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_plant_vr_col , & ! Output: [real(r8) (:,:) ] + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Input: [real(r8) (:,:) ] + actual_immob_vr => soilbiogeochem_nitrogenflux_inst%actual_immob_vr_col & ! Output: [real(r8) (:,:) ] + ) + + ! calcualte nitrogen uptake profile + ! nuptake_prof(:,:) = nan + ! call SoilBiogelchemNitrogenUptakeProfile(bounds, & + ! nlevdecomp, num_soilc, filter_soilc, & + ! sminn_vr, dzsoi_decomp, nfixation_prof, nuptake_prof) + + ! column loops to resolve plant/heterotroph competition for mineral N + + if (.not. use_nitrif_denitrif) then + + ! init sminn_tot + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + sminn_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sum_ndemand_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + potential_immob_vr(c,j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + if (sum_ndemand_vr(c,j)*dt < sminn_vr(c,j)) then + + ! N availability is not limiting immobilization or plant + ! uptake, and both can proceed at their potential rates + nlimit(c,j) = 0 + fpi_vr(c,j) = 1.0_r8 + actual_immob_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + else if ( cnallocate_carbon_only()) then !.or. & + ! this code block controls the addition of N to sminn pool + ! to eliminate any N limitation, when Carbon_Only is set. This lets the + ! model behave essentially as a carbon-only model, but with the + ! benefit of keeping track of the N additions needed to + ! eliminate N limitations, so there is still a diagnostic quantity + ! that describes the degree of N limitation at steady-state. + + nlimit(c,j) = 1 + fpi_vr(c,j) = 1.0_r8 + actual_immob_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + supplement_to_sminn_vr(c,j) = sum_ndemand_vr(c,j) - (sminn_vr(c,j)/dt) + else + ! N availability can not satisfy the sum of immobilization and + ! plant growth demands, so these two demands compete for available + ! soil mineral N resource. + + nlimit(c,j) = 1 + if (sum_ndemand_vr(c,j) > 0.0_r8) then + actual_immob_vr(c,j) = (sminn_vr(c,j)/dt)*(potential_immob_vr(c,j) / sum_ndemand_vr(c,j)) + else + actual_immob_vr(c,j) = 0.0_r8 + end if + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_vr(c,j) = actual_immob_vr(c,j) / potential_immob_vr(c,j) + else + fpi_vr(c,j) = 0.0_r8 + end if + + sminn_to_plant_vr(c,j) = (sminn_vr(c,j)/dt) - actual_immob_vr(c,j) + end if + end do + end do + + ! sum up N fluxes to plant + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + end do + end do + + ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. + do fc=1,num_soilc + c = filter_soilc(fc) + residual_sminn(c) = 0._r8 + end do + + ! sum up total N left over after initial plant and immobilization fluxes + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit(c,j) .eq. 0) then + residual_sminn_vr(c,j) = max(sminn_vr(c,j) - (actual_immob_vr(c,j) + sminn_to_plant_vr(c,j) ) * dt, 0._r8) + residual_sminn(c) = residual_sminn(c) + residual_sminn_vr(c,j) * dzsoi_decomp(j) + else + residual_sminn_vr(c,j) = 0._r8 + endif + endif + end do + end do + + ! distribute residual N to plants + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if ( residual_plant_ndemand(c) > 0._r8 .and. residual_sminn(c) > 0._r8 .and. nlimit(c,j) .eq. 0) then + sminn_to_plant_vr(c,j) = sminn_to_plant_vr(c,j) + residual_sminn_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_sminn(c), 1._r8) / dt + endif + end do + end do + + ! re-sum up N fluxes to plant + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + sum_ndemand_vr(c,j) = potential_immob_vr(c,j) + sminn_to_plant_vr(c,j) + end do + end do + + ! under conditions of excess N, some proportion is assumed to + ! be lost to denitrification, in addition to the constant + ! proportion lost in the decomposition pathways + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if ((sminn_to_plant_vr(c,j) + actual_immob_vr(c,j))*dt < sminn_vr(c,j)) then + sminn_to_denit_excess_vr(c,j) = max(bdnr*((sminn_vr(c,j)/dt) - sum_ndemand_vr(c,j)),0._r8) + else + sminn_to_denit_excess_vr(c,j) = 0._r8 + endif + end do + end do + + ! sum up N fluxes to immobilization + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) + potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do fc=1,num_soilc + c = filter_soilc(fc) + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + if (plant_ndemand(c) > 0.0_r8) then + fpg(c) = sminn_to_plant(c) / plant_ndemand(c) + else + fpg(c) = 1.0_r8 + end if + + ! calculate the fraction of immobilization realized (for diagnostic purposes) + if (potential_immob(c) > 0.0_r8) then + fpi(c) = actual_immob(c) / potential_immob(c) + else + fpi(c) = 1.0_r8 + end if + end do + + else !----------NITRIF_DENITRIF-------------! + + ! column loops to resolve plant/heterotroph/nitrifier/denitrifier competition for mineral N + !read constants from external netcdf file + compet_plant_no3 = params_inst%compet_plant_no3 + compet_plant_nh4 = params_inst%compet_plant_nh4 + compet_decomp_no3 = params_inst%compet_decomp_no3 + compet_decomp_nh4 = params_inst%compet_decomp_nh4 + compet_denit = params_inst%compet_denit + compet_nit = params_inst%compet_nit + + ! init total mineral N pools + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + ! sum up total mineral N pools + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + (smin_no3_vr(c,j) + smin_nh4_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + ! define N uptake profile for initial vertical distribution of plant N uptake, assuming plant seeks N from where it is most abundant + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + end do + end do + + ! main column/vertical loop + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + + ! first compete for nh4 + sum_nh4_demand(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + potential_immob_vr(c,j) + pot_f_nit_vr(c,j) + sum_nh4_demand_scaled(c,j) = plant_ndemand(c)* nuptake_prof(c,j) * compet_plant_nh4 + & + potential_immob_vr(c,j)*compet_decomp_nh4 + pot_f_nit_vr(c,j)*compet_nit + + if (sum_nh4_demand(c,j)*dt < smin_nh4_vr(c,j)) then + + ! NH4 availability is not limiting immobilization or plant + ! uptake, and all can proceed at their potential rates + nlimit_nh4(c,j) = 0 + fpi_nh4_vr(c,j) = 1.0_r8 + actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) + smin_nh4_to_plant_vr(c,j) = plant_ndemand(c) * nuptake_prof(c,j) + + f_nit_vr(c,j) = pot_f_nit_vr(c,j) + + else + + ! NH4 availability can not satisfy the sum of immobilization, nitrification, and + ! plant growth demands, so these three demands compete for available + ! soil mineral NH4 resource. + nlimit_nh4(c,j) = 1 + if (sum_nh4_demand(c,j) > 0.0_r8) then + actual_immob_nh4_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(potential_immob_vr(c,j)* & + compet_decomp_nh4 / sum_nh4_demand_scaled(c,j)), potential_immob_vr(c,j)) + smin_nh4_to_plant_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(plant_ndemand(c)* & + nuptake_prof(c,j)*compet_plant_nh4 / sum_nh4_demand_scaled(c,j)), plant_ndemand(c)*nuptake_prof(c,j)) + f_nit_vr(c,j) = min((smin_nh4_vr(c,j)/dt)*(pot_f_nit_vr(c,j)*compet_nit / & + sum_nh4_demand_scaled(c,j)), pot_f_nit_vr(c,j)) + else + actual_immob_nh4_vr(c,j) = 0.0_r8 + smin_nh4_to_plant_vr(c,j) = 0.0_r8 + f_nit_vr(c,j) = 0.0_r8 + end if + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_nh4_vr(c,j) = actual_immob_nh4_vr(c,j) / potential_immob_vr(c,j) + else + fpi_nh4_vr(c,j) = 0.0_r8 + end if + + end if + + ! next compete for no3 + sum_no3_demand(c,j) = (plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + pot_f_denit_vr(c,j) + sum_no3_demand_scaled(c,j) = (plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j))*compet_plant_no3 + & + (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j))*compet_decomp_no3 + pot_f_denit_vr(c,j)*compet_denit + + if (sum_no3_demand(c,j)*dt < smin_no3_vr(c,j)) then + + ! NO3 availability is not limiting immobilization or plant + ! uptake, and all can proceed at their potential rates + nlimit_no3(c,j) = 1 + fpi_no3_vr(c,j) = 1.0_r8 - fpi_nh4_vr(c,j) + actual_immob_no3_vr(c,j) = (potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + smin_no3_to_plant_vr(c,j) = (plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + + f_denit_vr(c,j) = pot_f_denit_vr(c,j) + + else + + ! NO3 availability can not satisfy the sum of immobilization, denitrification, and + ! plant growth demands, so these three demands compete for available + ! soil mineral NO3 resource. + nlimit_no3(c,j) = 1 + if (sum_no3_demand(c,j) > 0.0_r8) then + actual_immob_no3_vr(c,j) = min((smin_no3_vr(c,j)/dt)*((potential_immob_vr(c,j)- & + actual_immob_nh4_vr(c,j))*compet_decomp_no3 / sum_no3_demand_scaled(c,j)), & + potential_immob_vr(c,j)-actual_immob_nh4_vr(c,j)) + smin_no3_to_plant_vr(c,j) = min((smin_no3_vr(c,j)/dt)*((plant_ndemand(c)* & + nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j))*compet_plant_no3 / sum_no3_demand_scaled(c,j)), & + plant_ndemand(c)*nuptake_prof(c,j)-smin_nh4_to_plant_vr(c,j)) + f_denit_vr(c,j) = min((smin_no3_vr(c,j)/dt)*(pot_f_denit_vr(c,j)*compet_denit / & + sum_no3_demand_scaled(c,j)), pot_f_denit_vr(c,j)) + else + actual_immob_no3_vr(c,j) = 0.0_r8 + smin_no3_to_plant_vr(c,j) = 0.0_r8 + f_denit_vr(c,j) = 0.0_r8 + end if + + if (potential_immob_vr(c,j) > 0.0_r8) then + fpi_no3_vr(c,j) = actual_immob_no3_vr(c,j) / potential_immob_vr(c,j) + else + fpi_no3_vr(c,j) = 0.0_r8 + end if + + end if + + ! n2o emissions: n2o from nitr is const fraction, n2o from denitr is calculated in nitrif_denitrif + f_n2o_nit_vr(c,j) = f_nit_vr(c,j) * nitrif_n2o_loss_frac + f_n2o_denit_vr(c,j) = f_denit_vr(c,j) / (1._r8 + n2_n2o_ratio_denit_vr(c,j)) + + + ! this code block controls the addition of N to sminn pool + ! to eliminate any N limitation, when Carbon_Only is set. This lets the + ! model behave essentially as a carbon-only model, but with the + ! benefit of keeping track of the N additions needed to + ! eliminate N limitations, so there is still a diagnostic quantity + ! that describes the degree of N limitation at steady-state. + + if ( cnallocate_carbon_only()) then !.or. & + if ( fpi_no3_vr(c,j) + fpi_nh4_vr(c,j) < 1._r8 ) then + fpi_nh4_vr(c,j) = 1.0_r8 - fpi_no3_vr(c,j) + supplement_to_sminn_vr(c,j) = (potential_immob_vr(c,j) - actual_immob_no3_vr(c,j)) - actual_immob_nh4_vr(c,j) + ! update to new values that satisfy demand + actual_immob_nh4_vr(c,j) = potential_immob_vr(c,j) - actual_immob_no3_vr(c,j) + end if + if ( smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) < plant_ndemand(c)*nuptake_prof(c,j) ) then + supplement_to_sminn_vr(c,j) = supplement_to_sminn_vr(c,j) + & + (plant_ndemand(c)*nuptake_prof(c,j) - smin_no3_to_plant_vr(c,j)) - smin_nh4_to_plant_vr(c,j) ! use old values + smin_nh4_to_plant_vr(c,j) = plant_ndemand(c)*nuptake_prof(c,j) - smin_no3_to_plant_vr(c,j) + end if + sminn_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) + end if + + ! sum up no3 and nh4 fluxes + fpi_vr(c,j) = fpi_no3_vr(c,j) + fpi_nh4_vr(c,j) + sminn_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + smin_nh4_to_plant_vr(c,j) + actual_immob_vr(c,j) = actual_immob_no3_vr(c,j) + actual_immob_nh4_vr(c,j) + end do + end do + + do fc=1,num_soilc + c = filter_soilc(fc) + ! sum up N fluxes to plant after initial competition + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = sminn_to_plant(c) + sminn_to_plant_vr(c,j) * dzsoi_decomp(j) + end do + end do + + ! give plants a second pass to see if there is any mineral N left over with which to satisfy residual N demand. + ! first take frm nh4 pool; then take from no3 pool + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + residual_smin_nh4(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit_nh4(c,j) .eq. 0) then + residual_smin_nh4_vr(c,j) = max(smin_nh4_vr(c,j) - (actual_immob_vr(c,j) + & + smin_nh4_to_plant_vr(c,j) ) * dt, 0._r8) + residual_smin_nh4(c) = residual_smin_nh4(c) + residual_smin_nh4_vr(c,j) * dzsoi_decomp(j) + else + residual_smin_nh4_vr(c,j) = 0._r8 + endif + + if ( residual_smin_nh4(c) > 0._r8 .and. nlimit_nh4(c,j) .eq. 0 ) then + smin_nh4_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + residual_smin_nh4_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_smin_nh4(c), 1._r8) / dt + endif + end if + end do + end do + + ! re-sum up N fluxes to plant after second pass for nh4 + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) + sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + ! + ! and now do second pass for no3 + do fc=1,num_soilc + c = filter_soilc(fc) + residual_plant_ndemand(c) = plant_ndemand(c) - sminn_to_plant(c) + residual_smin_no3(c) = 0._r8 + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (residual_plant_ndemand(c) > 0._r8 ) then + if (nlimit_no3(c,j) .eq. 0) then + residual_smin_no3_vr(c,j) = max(smin_no3_vr(c,j) - (actual_immob_vr(c,j) + & + smin_no3_to_plant_vr(c,j) ) * dt, 0._r8) + residual_smin_no3(c) = residual_smin_no3(c) + residual_smin_no3_vr(c,j) * dzsoi_decomp(j) + else + residual_smin_no3_vr(c,j) = 0._r8 + endif + + if ( residual_smin_no3(c) > 0._r8 .and. nlimit_no3(c,j) .eq. 0) then + smin_no3_to_plant_vr(c,j) = smin_no3_to_plant_vr(c,j) + residual_smin_no3_vr(c,j) * & + min(( residual_plant_ndemand(c) * dt ) / residual_smin_no3(c), 1._r8) / dt + endif + endif + end do + end do + + ! re-sum up N fluxes to plant after second passes of both no3 and nh4 + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_to_plant_vr(c,j) = smin_nh4_to_plant_vr(c,j) + smin_no3_to_plant_vr(c,j) + sminn_to_plant(c) = sminn_to_plant(c) + (sminn_to_plant_vr(c,j)) * dzsoi_decomp(j) + end do + end do + + ! sum up N fluxes to immobilization + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = 0._r8 + potential_immob(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + actual_immob(c) = actual_immob(c) + actual_immob_vr(c,j) * dzsoi_decomp(j) + potential_immob(c) = potential_immob(c) + potential_immob_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do fc=1,num_soilc + c = filter_soilc(fc) + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + if (plant_ndemand(c) > 0.0_r8) then + fpg(c) = sminn_to_plant(c) / plant_ndemand(c) + else + fpg(c) = 1._r8 + end if + + ! calculate the fraction of immobilization realized (for diagnostic purposes) + if (potential_immob(c) > 0.0_r8) then + fpi(c) = actual_immob(c) / potential_immob(c) + else + fpi(c) = 1._r8 + end if + end do ! end of column loops + + end if !end of if_not_use_nitrif_denitrif + + end associate + + end subroutine SoilBiogeochemCompetition + +end module SoilBiogeochemCompetitionMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 new file mode 100644 index 0000000000..0f98910cd2 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeBGCMod.F90 @@ -0,0 +1,950 @@ +module SoilBiogeochemDecompCascadeBGCMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Sets the coeffiecients used in the decomposition cascade submodel. + ! This uses the CENTURY/BGC parameters + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, spinup_state, anoxia, use_lch4, use_vertsoilc + use clm_varcon , only : zsoi + use decompMod , only : bounds_type + use abortutils , only : endrun + use CNSharedParamsMod , only : CNParamsShareInst, anoxia_wtsat, nlev_soildecomp_standard + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: init_decompcascade_bgc + public :: decomp_rate_constants_bgc + ! + ! !PUBLIC DATA MEMBERS + logical , public :: normalize_q10_to_century_tfunc = .true.! do we normalize the century decomp. rates so that they match the CLM Q10 at a given tep? + logical , public :: use_century_tfunc = .false. + real(r8), public :: normalization_tref = 15._r8 ! reference temperature for normalizaion (degrees C) + ! + ! !PRIVATE DATA MEMBERS + type, private :: params_type + real(r8):: cn_s1_bgc !C:N for SOM 1 + real(r8):: cn_s2_bgc !C:N for SOM 2 + real(r8):: cn_s3_bgc !C:N for SOM 3 + + real(r8):: rf_l1s1_bgc !respiration fraction litter 1 -> SOM 1 + real(r8):: rf_l2s1_bgc + real(r8):: rf_l3s2_bgc + + real(r8):: rf_s2s1_bgc + real(r8):: rf_s2s3_bgc + real(r8):: rf_s3s1_bgc + + real(r8):: rf_cwdl2_bgc + real(r8):: rf_cwdl3_bgc + + real(r8):: tau_l1_bgc ! turnover time of litter 1 (yr) + real(r8):: tau_l2_l3_bgc ! turnover time of litter 2 and litter 3 (yr) + real(r8):: tau_s1_bgc ! turnover time of SOM 1 (yr) + real(r8):: tau_s2_bgc ! turnover time of SOM 2 (yr) + real(r8):: tau_s3_bgc ! turnover time of SOM 3 (yr) + real(r8):: tau_cwd_bgc ! corrected fragmentation rate constant CWD + + real(r8) :: cwd_fcel_bgc !cellulose fraction for CWD + real(r8) :: cwd_flig_bgc ! + + real(r8) :: k_frag_bgc !fragmentation rate for CWD + real(r8) :: minpsi_bgc !minimum soil water potential for heterotrophic resp + + integer :: nsompools = 3 + real(r8),allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup + + end type params_type + ! + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNDecompBgcParamsType' + character(len=100) :: errCode = 'Error reading in CN const file ' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! These are not read off of netcdf file + allocate(params_inst%spinup_vector(params_inst%nsompools)) + params_inst%spinup_vector(:) = (/ 1.0_r8, 15.0_r8, 675.0_r8 /) + + ! Read off of netcdf file + tString='tau_l1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_l1_bgc=tempr + + tString='tau_l2_l3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_l2_l3_bgc=tempr + + tString='tau_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_s1_bgc=tempr + + tString='tau_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_s2_bgc=tempr + + tString='tau_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_s3_bgc=tempr + + tString='tau_cwd' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%tau_cwd_bgc=tempr + + tString='cn_s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s1_bgc=tempr + + tString='cn_s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s2_bgc=tempr + + tString='cn_s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s3_bgc=tempr + + tString='rf_l1s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l1s1_bgc=tempr + + tString='rf_l2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l2s1_bgc=tempr + + tString='rf_l3s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l3s2_bgc=tempr + + tString='rf_s2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s2s1_bgc=tempr + + tString='rf_s2s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s2s3_bgc=tempr + + tString='rf_s3s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s3s1_bgc=tempr + + tString='rf_cwdl2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_cwdl2_bgc=tempr + + tString='rf_cwdl3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_cwdl3_bgc=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cwd_fcel_bgc=tempr + + tString='k_frag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_frag_bgc=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%minpsi_bgc=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cwd_flig_bgc=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine init_decompcascade_bgc(bounds, soilbiogeochem_state_inst, soilstate_inst) + ! + ! !DESCRIPTION: + ! initialize rate constants and decomposition pathways following the decomposition cascade of the BGC model. + ! written by C. Koven + ! + ! !USES: + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilstate_type) , intent(in) :: soilstate_inst + ! + ! !LOCAL VARIABLES + !-- properties of each decomposing pool + real(r8) :: rf_l1s1 + real(r8) :: rf_l2s1 + real(r8) :: rf_l3s2 + !real(r8) :: rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + !real(r8) :: rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8), allocatable :: rf_s1s2(:,:) + real(r8), allocatable :: rf_s1s3(:,:) + real(r8) :: rf_s2s1 + real(r8) :: rf_s2s3 + real(r8) :: rf_s3s1 + real(r8) :: rf_cwdl2 + real(r8) :: rf_cwdl3 + real(r8) :: cwd_fcel + real(r8) :: cwd_flig + real(r8) :: cn_s1 + real(r8) :: cn_s2 + real(r8) :: cn_s3 + !real(r8) :: f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + !real(r8) :: f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8), allocatable :: f_s1s2(:,:) + real(r8), allocatable :: f_s1s3(:,:) + real(r8) :: f_s2s1 + real(r8) :: f_s2s3 + + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: i_l1s1 + integer :: i_l2s1 + integer :: i_l3s2 + integer :: i_s1s2 + integer :: i_s1s3 + integer :: i_s2s1 + integer :: i_s2s3 + integer :: i_s3s1 + integer :: i_cwdl2 + integer :: i_cwdl3 + + integer :: c, j ! indices + real(r8) :: t ! temporary variable + !----------------------------------------------------------------------- + + associate( & + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + cellsand => soilstate_inst%cellsand_col , & ! Input: [real(r8) (:,:) ] column 3D sand + + cascade_step_name => decomp_cascade_con%cascade_step_name , & ! Output: [character(len=8) (:) ] name of transition + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + decomp_pool_name_restart => decomp_cascade_con%decomp_pool_name_restart , & ! Output: [character(len=8) (:) ] name of pool for restart files + decomp_pool_name_history => decomp_cascade_con%decomp_pool_name_history , & ! Output: [character(len=8) (:) ] name of pool for history files + decomp_pool_name_long => decomp_cascade_con%decomp_pool_name_long , & ! Output: [character(len=20) (:) ] name of pool for netcdf long names + decomp_pool_name_short => decomp_cascade_con%decomp_pool_name_short , & ! Output: [character(len=8) (:) ] name of pool for netcdf short names + is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool + is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool + is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup + is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material + is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose + is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin + spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) ] factor for AD spinup associated with each pool + ) + + allocate(rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp)) + allocate(f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp)) + + !------- time-constant coefficients ---------- ! + ! set soil organic matter compartment C:N ratios + cn_s1 = params_inst%cn_s1_bgc + cn_s2 = params_inst%cn_s2_bgc + cn_s3 = params_inst%cn_s3_bgc + + ! set respiration fractions for fluxes between compartments + rf_l1s1 = params_inst%rf_l1s1_bgc + rf_l2s1 = params_inst%rf_l2s1_bgc + rf_l3s2 = params_inst%rf_l3s2_bgc + rf_s2s1 = params_inst%rf_s2s1_bgc + rf_s2s3 = params_inst%rf_s2s3_bgc + rf_s3s1 = params_inst%rf_s3s1_bgc + + rf_cwdl2 = params_inst%rf_cwdl2_bgc + rf_cwdl3 = params_inst%rf_cwdl3_bgc + + ! set the cellulose and lignin fractions for coarse woody debris + cwd_fcel = params_inst%cwd_fcel_bgc + cwd_flig = params_inst%cwd_flig_bgc + + ! set path fractions + f_s2s1 = 0.42_r8/(0.45_r8) + f_s2s3 = 0.03_r8/(0.45_r8) + + ! some of these are dependent on the soil texture properties + do c = bounds%begc, bounds%endc + do j = 1, nlevdecomp + t = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - cellsand(c,j)) + f_s1s2(c,j) = 1._r8 - .004_r8 / (1._r8 - t) + f_s1s3(c,j) = .004_r8 / (1._r8 - t) + rf_s1s2(c,j) = t + rf_s1s3(c,j) = t + end do + end do + + !------------------- list of pools and their attributes ------------ + i_litr1 = i_met_lit + floating_cn_ratio_decomp_pools(i_litr1) = .true. + decomp_pool_name_restart(i_litr1) = 'litr1' + decomp_pool_name_history(i_litr1) = 'LITR1' + decomp_pool_name_long(i_litr1) = 'litter 1' + decomp_pool_name_short(i_litr1) = 'L1' + is_litter(i_litr1) = .true. + is_soil(i_litr1) = .false. + is_cwd(i_litr1) = .false. + initial_cn_ratio(i_litr1) = 90._r8 + initial_stock(i_litr1) = 0._r8 + is_metabolic(i_litr1) = .true. + is_cellulose(i_litr1) = .false. + is_lignin(i_litr1) = .false. + + i_litr2 = i_cel_lit + floating_cn_ratio_decomp_pools(i_litr2) = .true. + decomp_pool_name_restart(i_litr2) = 'litr2' + decomp_pool_name_history(i_litr2) = 'LITR2' + decomp_pool_name_long(i_litr2) = 'litter 2' + decomp_pool_name_short(i_litr2) = 'L2' + is_litter(i_litr2) = .true. + is_soil(i_litr2) = .false. + is_cwd(i_litr2) = .false. + initial_cn_ratio(i_litr2) = 90._r8 + initial_stock(i_litr2) = 0._r8 + is_metabolic(i_litr2) = .false. + is_cellulose(i_litr2) = .true. + is_lignin(i_litr2) = .false. + + i_litr3 = i_lig_lit + floating_cn_ratio_decomp_pools(i_litr3) = .true. + decomp_pool_name_restart(i_litr3) = 'litr3' + decomp_pool_name_history(i_litr3) = 'LITR3' + decomp_pool_name_long(i_litr3) = 'litter 3' + decomp_pool_name_short(i_litr3) = 'L3' + is_litter(i_litr3) = .true. + is_soil(i_litr3) = .false. + is_cwd(i_litr3) = .false. + initial_cn_ratio(i_litr3) = 90._r8 + initial_stock(i_litr3) = 0._r8 + is_metabolic(i_litr3) = .false. + is_cellulose(i_litr3) = .false. + is_lignin(i_litr3) = .true. + + ! CWD + floating_cn_ratio_decomp_pools(i_cwd) = .true. + decomp_pool_name_restart(i_cwd) = 'cwd' + decomp_pool_name_history(i_cwd) = 'CWD' + decomp_pool_name_long(i_cwd) = 'coarse woody debris' + decomp_pool_name_short(i_cwd) = 'CWD' + is_litter(i_cwd) = .false. + is_soil(i_cwd) = .false. + is_cwd(i_cwd) = .true. + initial_cn_ratio(i_cwd) = 90._r8 + initial_stock(i_cwd) = 0._r8 + is_metabolic(i_cwd) = .false. + is_cellulose(i_cwd) = .false. + is_lignin(i_cwd) = .false. + + i_soil1 = 5 + floating_cn_ratio_decomp_pools(i_soil1) = .false. + decomp_pool_name_restart(i_soil1) = 'soil1' + decomp_pool_name_history(i_soil1) = 'SOIL1' + decomp_pool_name_long(i_soil1) = 'soil 1' + decomp_pool_name_short(i_soil1) = 'S1' + is_litter(i_soil1) = .false. + is_soil(i_soil1) = .true. + is_cwd(i_soil1) = .false. + initial_cn_ratio(i_soil1) = cn_s1 + initial_stock(i_soil1) = 20._r8 + is_metabolic(i_soil1) = .false. + is_cellulose(i_soil1) = .false. + is_lignin(i_soil1) = .false. + + i_soil2 = 6 + floating_cn_ratio_decomp_pools(i_soil2) = .false. + decomp_pool_name_restart(i_soil2) = 'soil2' + decomp_pool_name_history(i_soil2) = 'SOIL2' + decomp_pool_name_long(i_soil2) = 'soil 2' + decomp_pool_name_short(i_soil2) = 'S2' + is_litter(i_soil2) = .false. + is_soil(i_soil2) = .true. + is_cwd(i_soil2) = .false. + initial_cn_ratio(i_soil2) = cn_s2 + initial_stock(i_soil2) = 20._r8 + is_metabolic(i_soil2) = .false. + is_cellulose(i_soil2) = .false. + is_lignin(i_soil2) = .false. + + i_soil3 = 7 + floating_cn_ratio_decomp_pools(i_soil3) = .false. + decomp_pool_name_restart(i_soil3) = 'soil3' + decomp_pool_name_history(i_soil3) = 'SOIL3' + decomp_pool_name_long(i_soil3) = 'soil 3' + decomp_pool_name_short(i_soil3) = 'S3' + is_litter(i_soil3) = .false. + is_soil(i_soil3) = .true. + is_cwd(i_soil3) = .false. + initial_cn_ratio(i_soil3) = cn_s3 + initial_stock(i_soil3) = 20._r8 + is_metabolic(i_soil3) = .false. + is_cellulose(i_soil3) = .false. + is_lignin(i_soil3) = .false. + + spinup_factor(i_litr1) = 1._r8 + spinup_factor(i_litr2) = 1._r8 + spinup_factor(i_litr3) = 1._r8 + spinup_factor(i_cwd) = 1._r8 + spinup_factor(i_soil1) = params_inst%spinup_vector(1) + spinup_factor(i_soil2) = params_inst%spinup_vector(2) + spinup_factor(i_soil3) = params_inst%spinup_vector(3) + + !---------------- list of transitions and their time-independent coefficients ---------------! + i_l1s1 = 1 + cascade_step_name(i_l1s1) = 'L1S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1 + cascade_donor_pool(i_l1s1) = i_litr1 + cascade_receiver_pool(i_l1s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8 + + i_l2s1 = 2 + cascade_step_name(i_l2s1) = 'L2S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1) = rf_l2s1 + cascade_donor_pool(i_l2s1) = i_litr2 + cascade_receiver_pool(i_l2s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s1)= 1.0_r8 + + i_l3s2 = 3 + cascade_step_name(i_l3s2) = 'L3S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = rf_l3s2 + cascade_donor_pool(i_l3s2) = i_litr3 + cascade_receiver_pool(i_l3s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s2) = 1.0_r8 + + i_s1s2 = 4 + cascade_step_name(i_s1s2) = 'S1S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + cascade_donor_pool(i_s1s2) = i_soil1 + cascade_receiver_pool(i_s1s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = f_s1s2(bounds%begc:bounds%endc,1:nlevdecomp) + + i_s1s3 = 5 + cascade_step_name(i_s1s3) = 'S1S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = rf_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + cascade_donor_pool(i_s1s3) = i_soil1 + cascade_receiver_pool(i_s1s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s3) = f_s1s3(bounds%begc:bounds%endc,1:nlevdecomp) + + i_s2s1 = 6 + cascade_step_name(i_s2s1) = 'S2S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = rf_s2s1 + cascade_donor_pool(i_s2s1) = i_soil2 + cascade_receiver_pool(i_s2s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s1) = f_s2s1 + + i_s2s3 = 7 + cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = f_s2s3 + + i_s3s1 = 8 + cascade_step_name(i_s3s1) = 'S3S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = rf_s3s1 + cascade_donor_pool(i_s3s1) = i_soil3 + cascade_receiver_pool(i_s3s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s1) = 1.0_r8 + + i_cwdl2 = 9 + cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = rf_cwdl2 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 10 + cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = rf_cwdl3 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + + deallocate(rf_s1s2) + deallocate(rf_s1s3) + deallocate(f_s1s2) + deallocate(f_s1s3) + + end associate + + end subroutine init_decompcascade_bgc + + !----------------------------------------------------------------------- + subroutine decomp_rate_constants_bgc(bounds, num_soilc, filter_soilc, & + canopystate_inst, soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! calculate rate constants and decomposition pathways for teh CENTURY decomposition cascade model + ! written by C. Koven based on original CLM4 decomposition cascade + ! + ! !USES: + use clm_time_manager , only : get_days_per_year + use shr_const_mod , only : SHR_CONST_PI + use clm_varcon , only : secspday + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: frw(bounds%begc:bounds%endc) ! rooting fraction weight + real(r8), allocatable:: fr(:,:) ! column-level rooting fraction by soil depth + real(r8):: minpsi, maxpsi ! limits for soil water scalar for decomp + real(r8):: psi ! temporary soilpsi for water scalar + real(r8):: rate_scalar ! combined rate scalar for decomp + real(r8):: k_l1 ! decomposition rate constant litter 1 (1/sec) + real(r8):: k_l2_l3 ! decomposition rate constant litter 2 and litter 3 (1/sec) + real(r8):: k_s1 ! decomposition rate constant SOM 1 (1/sec) + real(r8):: k_s2 ! decomposition rate constant SOM 2 (1/sec) + real(r8):: k_s3 ! decomposition rate constant SOM 3 (1/sec) + real(r8):: k_frag ! fragmentation rate constant CWD (1/sec) + real(r8):: tau_l1 ! turnover time of litter 1 (yr) + real(r8):: tau_l2_l3 ! turnover time of litter 2 and litter 3 (yr) + real(r8):: tau_l3 ! turnover time of litter 3 (yr) + real(r8):: tau_s1 ! turnover time of SOM 1 (yr) + real(r8):: tau_s2 ! turnover time of SOM 2 (yr) + real(r8):: tau_s3 ! turnover time of SOM 3 (yr) + real(r8):: tau_cwd ! corrected fragmentation rate constant CWD + real(r8):: cwdc_loss ! fragmentation rate for CWD carbon (gC/m2/s) + real(r8):: cwdn_loss ! fragmentation rate for CWD nitrogen (gN/m2/s) + real(r8):: Q10 ! temperature dependence + real(r8):: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates + real(r8):: decomp_depth_efolding ! (meters) e-folding depth for reduction in decomposition [ + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: c, fc, j, k, l + real(r8):: catanf ! hyperbolic temperature function from CENTURY + real(r8):: catanf_30 ! reference rate at 30C + real(r8):: t1 ! temperature argument + real(r8):: normalization_factor ! factor by which to offset the decomposition rates frm century to a q10 formulation + real(r8):: days_per_year ! days per year + real(r8):: depth_scalar(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8):: mino2lim !minimum anaerobic decomposition rate + !----------------------------------------------------------------------- + + !----- CENTURY T response function + catanf(t1) = 11.75_r8 +(29.7_r8 / SHR_CONST_PI) * atan( SHR_CONST_PI * 0.031_r8 * ( t1 - 15.4_r8 )) + + associate( & + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + alt_indx => canopystate_inst%alt_indx_col , & ! Input: [integer (:) ] current depth of thaw + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2stress_sat => ch4_inst%o2stress_sat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + o2stress_unsat => ch4_inst%o2stress_unsat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area + + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + mino2lim = CNParamsShareInst%mino2lim + + if ( use_century_tfunc .and. normalize_q10_to_century_tfunc ) then + call endrun(msg='ERROR: cannot have both use_century_tfunc and normalize_q10_to_century_tfunc set as true'//& + errMsg(__FILE__, __LINE__)) + endif + + days_per_year = get_days_per_year() + + ! the belowground parameters from century + tau_l1 = 1./18.5 + tau_l2_l3 = 1./4.9 + tau_s1 = 1./7.3 + tau_s2 = 1./0.2 + tau_s3 = 1./.0045 + + ! century leaves wood decomposition rates open, within range of 0 - 0.5 yr^-1 + tau_cwd = 1./0.3 + + ! Todo: FIX(SPM,032414) - the explicit divide gives different results than when that + ! value is placed in the parameters netcdf file. To get bfb, keep the + ! divide in source. + + !tau_l1 = params_inst%tau_l1_bgc + !tau_l2_l3 = params_inst%tau_l2_l3_bgc + !tau_s1 = params_inst%tau_s1_bgc + !tau_s2 = params_inst%tau_s2_bgc + !tau_s3 = params_inst%tau_s3_bgc + + !set turnover rate of coarse woody debris + !tau_cwd = params_inst%tau_cwd_bgc + + ! set "Q10" parameter + Q10 = CNParamsShareInst%Q10 + + ! set "froz_q10" parameter + froz_q10 = CNParamsShareInst%froz_q10 + + ! Set "decomp_depth_efolding" parameter + decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding + + ! translate to per-second time constant + k_l1 = 1._r8 / (secspday * days_per_year * tau_l1) + k_l2_l3 = 1._r8 / (secspday * days_per_year * tau_l2_l3) + k_s1 = 1._r8 / (secspday * days_per_year * tau_s1) + k_s2 = 1._r8 / (secspday * days_per_year * tau_s2) + k_s3 = 1._r8 / (secspday * days_per_year * tau_s3) + k_frag = 1._r8 / (secspday * days_per_year * tau_cwd) + + ! calc ref rate + catanf_30 = catanf(30._r8) + ! The following code implements the acceleration part of the AD spinup algorithm + + if ( spinup_state .eq. 1 ) then + k_s1 = k_s1 * params_inst%spinup_vector(1) + k_s2 = k_s2 * params_inst%spinup_vector(2) + k_s3 = k_s3 * params_inst%spinup_vector(3) + endif + + i_litr1 = 1 + i_litr2 = 2 + i_litr3 = 3 + i_soil1 = 5 + i_soil2 = 6 + i_soil3 = 7 + + !--- time dependent coefficients-----! + if ( nlevdecomp .eq. 1 ) then + + ! calculate function to weight the temperature and water potential scalars + ! for decomposition control. + + + ! the following normalizes values in fr so that they + ! sum to 1.0 across top nlevdecomp levels on a column + frw(bounds%begc:bounds%endc) = 0._r8 + nlev_soildecomp_standard=5 + allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) + do j=1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + frw(c) = frw(c) + col%dz(c,j) + end do + end do + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (frw(c) /= 0._r8) then + fr(c,j) = col%dz(c,j) / frw(c) + else + fr(c,j) = 0._r8 + end if + end do + end do + + if ( .not. use_century_tfunc ) then + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + else + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))*fr(c,j) + endif + end do + end do + + else + ! original century uses an arctangent function to calculate the temperature dependence of decomposition + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + + t_scalar(c,1)=t_scalar(c,1) +max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30*fr(c,j),0.01_r8) + end do + end do + + endif + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + minpsi = -10.0_r8; + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) w_scalar(c,:) = 0._r8 + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,1) = w_scalar(c,1) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j) + end if + end do + end do + + if (use_lch4) then + if (anoxia_wtsat) then ! Adjust for saturated fraction if unfrozen + do fc = 1,num_soilc + c = filter_soilc(fc) + if (alt_indx(c) >= nlev_soildecomp_standard .and. t_soisno(c,1) > SHR_CONST_TKFRZ) then + w_scalar(c,1) = w_scalar(c,1)*(1._r8 - finundated(c)) + finundated(c) + end if + end do + end if + end if + + if (use_lch4) then + ! Calculate ANOXIA + if (anoxia) then + ! Check for anoxia w/o LCH4 now done in controlMod. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (j==1) o_scalar(c,:) = 0._r8 + + if (.not. anoxia_wtsat) then + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * max(o2stress_unsat(c,j), mino2lim) + else + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * & + (max(o2stress_unsat(c,j), mino2lim)*(1._r8 - finundated(c)) + & + max(o2stress_sat(c,j), mino2lim)*finundated(c) ) + end if + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + deallocate(fr) + + else + + if ( .not. use_century_tfunc ) then + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + else + t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8)) + endif + end do + end do + + else + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + t_scalar(c,j)= max(catanf(t_soisno(c,j)-SHR_CONST_TKFRZ)/catanf_30, 0.01_r8) + end do + end do + + endif + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + minpsi = -10.0_r8; + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi)) + else + w_scalar(c,j) = 0._r8 + end if + if (use_lch4) then + if (anoxia_wtsat .and. t_soisno(c,j) > SHR_CONST_TKFRZ) then ! wet area will have w_scalar of 1 if unfrozen + w_scalar(c,j) = w_scalar(c,j)*(1._r8 - finundated(c)) + finundated(c) + end if + end if + end do + end do + + if (use_lch4) then + ! Calculate ANOXIA + ! Check for anoxia w/o LCH4 now done in controlMod. + + if (anoxia) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. anoxia_wtsat) then + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) + else + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) * (1._r8 - finundated(c)) + & + max(o2stress_sat(c,j), mino2lim) * finundated(c) + end if + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + end if + + if ( normalize_q10_to_century_tfunc ) then + ! scale all decomposition rates by a constant to compensate for offset between original CENTURY temp func and Q10 + normalization_factor = (catanf(normalization_tref)/catanf_30) / (q10**((normalization_tref-25._r8)/10._r8)) + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + t_scalar(c,j) = t_scalar(c,j) * normalization_factor + end do + end do + endif + + if (use_vertsoilc) then + ! add a term to reduce decomposition rate at depth + ! for now used a fixed e-folding depth + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + depth_scalar(c,j) = exp(-zsoi(j)/decomp_depth_efolding) + end do + end do + end if + + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_litr2) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_litr3) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_litr2) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_litr3) = k_l2_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) + end do + end do + end if + + end associate + + end subroutine decomp_rate_constants_bgc + +end module SoilBiogeochemDecompCascadeBGCMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 new file mode 100644 index 0000000000..26fb3149d5 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeCNMod.F90 @@ -0,0 +1,904 @@ +module SoilBiogeochemDecompCascadeCNMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Sets the coeffiecients used in the decomposition cascade submodel. + ! This uses the CN parameters as in CLMCN 4.0 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevsoi, nlevgrnd, nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, spinup_state, anoxia, use_lch4, use_vertsoilc + use clm_varcon , only : zsoi + use decompMod , only : bounds_type + use abortutils , only : endrun + use CNSharedParamsMod , only : CNParamsShareInst, anoxia_wtsat, nlev_soildecomp_standard + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: init_decompcascade_cn + public :: decomp_rate_constants_cn + + type, private :: params_type + real(r8):: cn_s1_cn !C:N for SOM 1 + real(r8):: cn_s2_cn !C:N for SOM 2 + real(r8):: cn_s3_cn !C:N for SOM 3 + real(r8):: cn_s4_cn !C:N for SOM 4 + + real(r8):: rf_l1s1_cn !respiration fraction litter 1 -> SOM 1 + real(r8):: rf_l2s2_cn !respiration fraction litter 2 -> SOM 2 + real(r8):: rf_l3s3_cn !respiration fraction litter 3 -> SOM 3 + real(r8):: rf_s1s2_cn !respiration fraction SOM 1 -> SOM 2 + real(r8):: rf_s2s3_cn !respiration fraction SOM 2 -> SOM 3 + real(r8):: rf_s3s4_cn !respiration fraction SOM 3 -> SOM 4 + + real(r8) :: cwd_fcel_cn !cellulose fraction for CWD + real(r8) :: cwd_flig_cn ! + + real(r8) :: k_l1_cn !decomposition rate for litter 1 + real(r8) :: k_l2_cn !decomposition rate for litter 2 + real(r8) :: k_l3_cn !decomposition rate for litter 3 + real(r8) :: k_s1_cn !decomposition rate for SOM 1 + real(r8) :: k_s2_cn !decomposition rate for SOM 2 + real(r8) :: k_s3_cn !decomposition rate for SOM 3 + real(r8) :: k_s4_cn !decomposition rate for SOM 4 + + real(r8) :: k_frag_cn !fragmentation rate for CWD + real(r8) :: minpsi_cn !minimum soil water potential for heterotrophic resp + + integer :: nsompools = 4 + real(r8), allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup + + end type params_type + ! + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !CALLED FROM: readParamsMod.F90::CNParamsReadFile + ! + ! !REVISION HISTORY: + ! Dec 3 2012 : Created by S. Muszala + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'SoilBiogeochemDecompCnParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + + !EOP + !----------------------------------------------------------------------- + + ! These are not read off of netcdf file + allocate(params_inst%spinup_vector(params_inst%nsompools)) + params_inst%spinup_vector(:) = (/ 1.0_r8, 1.0_r8, 5.0_r8, 70.0_r8 /) + + ! Read off of netcdf file + tString='cn_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s1_cn=tempr + + tString='cn_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s2_cn=tempr + + tString='cn_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s3_cn=tempr + + tString='cn_s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cn_s4_cn=tempr + + tString='rf_l1s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l1s1_cn=tempr + + tString='rf_l2s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l2s2_cn=tempr + + tString='rf_l3s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_l3s3_cn=tempr + + tString='rf_s1s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s1s2_cn=tempr + + tString='rf_s2s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s2s3_cn=tempr + + tString='rf_s3s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rf_s3s4_cn=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cwd_fcel_cn=tempr + + tString='k_l1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_l1_cn=tempr + + tString='k_l2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_l2_cn=tempr + + tString='k_l3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_l3_cn=tempr + + tString='k_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_s1_cn=tempr + + tString='k_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_s2_cn=tempr + + tString='k_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_s3_cn=tempr + + tString='k_s4' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_s4_cn=tempr + + tString='k_frag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_frag_cn=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%minpsi_cn=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%cwd_flig_cn=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine init_decompcascade_cn(bounds, soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! initialize rate constants and decomposition pathways for the BGC model originally implemented in CLM-CN + ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + ! + !-- properties of each pathway along decomposition cascade + !-- properties of each decomposing pool + real(r8) :: rf_l1s1 !respiration fraction litter 1 -> SOM 1 + real(r8) :: rf_l2s2 !respiration fraction litter 2 -> SOM 2 + real(r8) :: rf_l3s3 !respiration fraction litter 3 -> SOM 3 + real(r8) :: rf_s1s2 !respiration fraction SOM 1 -> SOM 2 + real(r8) :: rf_s2s3 !respiration fraction SOM 2 -> SOM 3 + real(r8) :: rf_s3s4 !respiration fraction SOM 3 -> SOM 4 + real(r8) :: cwd_fcel + real(r8) :: cwd_flig + real(r8) :: cn_s1 + real(r8) :: cn_s2 + real(r8) :: cn_s3 + real(r8) :: cn_s4 + + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: i_soil4 + integer :: i_atm + integer :: i_l1s1 + integer :: i_l2s2 + integer :: i_l3s3 + integer :: i_s1s2 + integer :: i_s2s3 + integer :: i_s3s4 + integer :: i_s4atm + integer :: i_cwdl2 + integer :: i_cwdl3 + !----------------------------------------------------------------------- + + associate( & + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Output: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + cascade_step_name => decomp_cascade_con%cascade_step_name , & ! Output: [character(len=8) (:) ] name of transition + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Output: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Output: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + decomp_pool_name_restart => decomp_cascade_con%decomp_pool_name_restart , & ! Output: [character(len=8) (:) ] name of pool for restart files + decomp_pool_name_history => decomp_cascade_con%decomp_pool_name_history , & ! Output: [character(len=8) (:) ] name of pool for history files + decomp_pool_name_long => decomp_cascade_con%decomp_pool_name_long , & ! Output: [character(len=20) (:) ] name of pool for netcdf long names + decomp_pool_name_short => decomp_cascade_con%decomp_pool_name_short , & ! Output: [character(len=8) (:) ] name of pool for netcdf short names + is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool + is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool + is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup + is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material + is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose + is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin + spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) ] factor for AD spinup associated with each pool + ) + + !------- time-constant coefficients ---------- ! + ! set soil organic matter compartment C:N ratios (from Biome-BGC v4.2.0) + cn_s1=params_inst%cn_s1_cn + cn_s2=params_inst%cn_s2_cn + cn_s3=params_inst%cn_s3_cn + cn_s4=params_inst%cn_s4_cn + + ! set respiration fractions for fluxes between compartments + ! (from Biome-BGC v4.2.0) + rf_l1s1=params_inst%rf_l1s1_cn + rf_l2s2=params_inst%rf_l2s2_cn + rf_l3s3=params_inst%rf_l3s3_cn + rf_s1s2=params_inst%rf_s1s2_cn + rf_s2s3=params_inst%rf_s2s3_cn + rf_s3s4=params_inst%rf_s3s4_cn + + ! set the cellulose and lignin fractions for coarse woody debris + cwd_fcel=params_inst%cwd_fcel_cn + cwd_flig=params_inst%cwd_flig_cn + + !------------------- list of pools and their attributes ------------ + + i_litr1 = i_met_lit + floating_cn_ratio_decomp_pools(i_litr1) = .true. + decomp_pool_name_restart(i_litr1) = 'litr1' + decomp_pool_name_history(i_litr1) = 'LITR1' + decomp_pool_name_long(i_litr1) = 'litter 1' + decomp_pool_name_short(i_litr1) = 'L1' + is_litter(i_litr1) = .true. + is_soil(i_litr1) = .false. + is_cwd(i_litr1) = .false. + initial_cn_ratio(i_litr1) = 90._r8 + initial_stock(i_litr1) = 0._r8 + is_metabolic(i_litr1) = .true. + is_cellulose(i_litr1) = .false. + is_lignin(i_litr1) = .false. + + i_litr2 = i_cel_lit + floating_cn_ratio_decomp_pools(i_litr2) = .true. + decomp_pool_name_restart(i_litr2) = 'litr2' + decomp_pool_name_history(i_litr2) = 'LITR2' + decomp_pool_name_long(i_litr2) = 'litter 2' + decomp_pool_name_short(i_litr2) = 'L2' + is_litter(i_litr2) = .true. + is_soil(i_litr2) = .false. + is_cwd(i_litr2) = .false. + initial_cn_ratio(i_litr2) = 90._r8 + initial_stock(i_litr2) = 0._r8 + is_metabolic(i_litr2) = .false. + is_cellulose(i_litr2) = .true. + is_lignin(i_litr2) = .false. + + i_litr3 = i_lig_lit + floating_cn_ratio_decomp_pools(i_litr3) = .true. + decomp_pool_name_restart(i_litr3) = 'litr3' + decomp_pool_name_history(i_litr3) = 'LITR3' + decomp_pool_name_long(i_litr3) = 'litter 3' + decomp_pool_name_short(i_litr3) = 'L3' + is_litter(i_litr3) = .true. + is_soil(i_litr3) = .false. + is_cwd(i_litr3) = .false. + initial_cn_ratio(i_litr3) = 90._r8 + initial_stock(i_litr3) = 0._r8 + is_metabolic(i_litr3) = .false. + is_cellulose(i_litr3) = .false. + is_lignin(i_litr3) = .true. + + floating_cn_ratio_decomp_pools(i_cwd) = .true. + decomp_pool_name_restart(i_cwd) = 'cwd' + decomp_pool_name_history(i_cwd) = 'CWD' + decomp_pool_name_long(i_cwd) = 'coarse woody debris' + decomp_pool_name_short(i_cwd) = 'CWD' + is_litter(i_cwd) = .false. + is_soil(i_cwd) = .false. + is_cwd(i_cwd) = .true. + initial_cn_ratio(i_cwd) = 500._r8 + initial_stock(i_cwd) = 0._r8 + is_metabolic(i_cwd) = .false. + is_cellulose(i_cwd) = .false. + is_lignin(i_cwd) = .false. + + i_soil1 = 5 + floating_cn_ratio_decomp_pools(i_soil1) = .false. + decomp_pool_name_restart(i_soil1) = 'soil1' + decomp_pool_name_history(i_soil1) = 'SOIL1' + decomp_pool_name_long(i_soil1) = 'soil 1' + decomp_pool_name_short(i_soil1) = 'S1' + is_litter(i_soil1) = .false. + is_soil(i_soil1) = .true. + is_cwd(i_soil1) = .false. + initial_cn_ratio(i_soil1) = cn_s1 + initial_stock(i_soil1) = 0._r8 + is_metabolic(i_soil1) = .false. + is_cellulose(i_soil1) = .false. + is_lignin(i_soil1) = .false. + + i_soil2 = 6 + floating_cn_ratio_decomp_pools(i_soil2) = .false. + decomp_pool_name_restart(i_soil2) = 'soil2' + decomp_pool_name_history(i_soil2) = 'SOIL2' + decomp_pool_name_long(i_soil2) = 'soil 2' + decomp_pool_name_short(i_soil2) = 'S2' + is_litter(i_soil2) = .false. + is_soil(i_soil2) = .true. + is_cwd(i_soil2) = .false. + initial_cn_ratio(i_soil2) = cn_s2 + initial_stock(i_soil2) = 0._r8 + is_metabolic(i_soil2) = .false. + is_cellulose(i_soil2) = .false. + is_lignin(i_soil2) = .false. + + i_soil3 = 7 + floating_cn_ratio_decomp_pools(i_soil3) = .false. + decomp_pool_name_restart(i_soil3) = 'soil3' + decomp_pool_name_history(i_soil3) = 'SOIL3' + decomp_pool_name_long(i_soil3) = 'soil 3' + decomp_pool_name_short(i_soil3) = 'S3' + is_litter(i_soil3) = .false. + is_soil(i_soil3) = .true. + is_cwd(i_soil3) = .false. + initial_cn_ratio(i_soil3) = cn_s3 + initial_stock(i_soil3) = 0._r8 + is_metabolic(i_soil3) = .false. + is_cellulose(i_soil3) = .false. + is_lignin(i_soil3) = .false. + + i_soil4 = 8 + floating_cn_ratio_decomp_pools(i_soil4) = .false. + decomp_pool_name_restart(i_soil4) = 'soil4' + decomp_pool_name_history(i_soil4) = 'SOIL4' + decomp_pool_name_long(i_soil4) = 'soil 4' + decomp_pool_name_short(i_soil4) = 'S4' + is_litter(i_soil4) = .false. + is_soil(i_soil4) = .true. + is_cwd(i_soil4) = .false. + initial_cn_ratio(i_soil4) = cn_s4 + initial_stock(i_soil4) = 10._r8 + is_metabolic(i_soil4) = .false. + is_cellulose(i_soil4) = .false. + is_lignin(i_soil4) = .false. + + i_atm = 0 !! for terminal pools (i.e. 100% respiration) + floating_cn_ratio_decomp_pools(i_atm) = .false. + decomp_pool_name_restart(i_atm) = 'atmosphere' + decomp_pool_name_history(i_atm) = 'atmosphere' + decomp_pool_name_long(i_atm) = 'atmosphere' + decomp_pool_name_short(i_atm) = '' + is_litter(i_atm) = .true. + is_soil(i_atm) = .false. + is_cwd(i_atm) = .false. + initial_cn_ratio(i_atm) = 0._r8 + initial_stock(i_atm) = 0._r8 + is_metabolic(i_atm) = .false. + is_cellulose(i_atm) = .false. + is_lignin(i_atm) = .false. + + + spinup_factor(i_litr1) = 1._r8 + spinup_factor(i_litr2) = 1._r8 + spinup_factor(i_litr3) = 1._r8 + spinup_factor(i_cwd) = 1._r8 + spinup_factor(i_soil1) = params_inst%spinup_vector(1) + spinup_factor(i_soil2) = params_inst%spinup_vector(2) + spinup_factor(i_soil3) = params_inst%spinup_vector(3) + spinup_factor(i_soil4) = params_inst%spinup_vector(4) + + + !---------------- list of transitions and their time-independent coefficients ---------------! + i_l1s1 = 1 + cascade_step_name(i_l1s1) = 'L1S1' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = rf_l1s1 + cascade_donor_pool(i_l1s1) = i_litr1 + cascade_receiver_pool(i_l1s1) = i_soil1 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l1s1) = 1.0_r8 + + i_l2s2 = 2 + cascade_step_name(i_l2s2) = 'L2S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = rf_l2s2 + cascade_donor_pool(i_l2s2) = i_litr2 + cascade_receiver_pool(i_l2s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l2s2) = 1.0_r8 + + i_l3s3 = 3 + cascade_step_name(i_l3s3) = 'L3S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = rf_l3s3 + cascade_donor_pool(i_l3s3) = i_litr3 + cascade_receiver_pool(i_l3s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_l3s3) = 1.0_r8 + + i_s1s2 = 4 + cascade_step_name(i_s1s2) = 'S1S2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = rf_s1s2 + cascade_donor_pool(i_s1s2) = i_soil1 + cascade_receiver_pool(i_s1s2) = i_soil2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s1s2) = 1.0_r8 + + i_s2s3 = 5 + cascade_step_name(i_s2s3) = 'S2S3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = rf_s2s3 + cascade_donor_pool(i_s2s3) = i_soil2 + cascade_receiver_pool(i_s2s3) = i_soil3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s2s3) = 1.0_r8 + + i_s3s4 = 6 + cascade_step_name(i_s3s4) = 'S3S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = rf_s3s4 + cascade_donor_pool(i_s3s4) = i_soil3 + cascade_receiver_pool(i_s3s4) = i_soil4 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s3s4) = 1.0_r8 + + i_s4atm = 7 + cascade_step_name(i_s4atm) = 'S4' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1. + cascade_donor_pool(i_s4atm) = i_soil4 + cascade_receiver_pool(i_s4atm) = i_atm + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_s4atm) = 1.0_r8 + + i_cwdl2 = 8 + cascade_step_name(i_cwdl2) = 'CWDL2' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = 0._r8 + cascade_donor_pool(i_cwdl2) = i_cwd + cascade_receiver_pool(i_cwdl2) = i_litr2 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl2) = cwd_fcel + + i_cwdl3 = 9 + cascade_step_name(i_cwdl3) = 'CWDL3' + rf_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = 0._r8 + cascade_donor_pool(i_cwdl3) = i_cwd + cascade_receiver_pool(i_cwdl3) = i_litr3 + pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig + + + end associate + + end subroutine init_decompcascade_cn + + !----------------------------------------------------------------------- + subroutine decomp_rate_constants_cn(bounds, & + num_soilc, filter_soilc, & + canopystate_inst, soilstate_inst, temperature_inst, ch4_inst, soilbiogeochem_carbonflux_inst) + ! + ! !DESCRIPTION: + ! calculate rate constants and decomposition pathways for the BGC model + ! originally implemented in CLM-CN + ! written by C. Koven based on original CLM4 decomposition cascade by P. Thornton + ! + ! !USES: + use clm_time_manager, only : get_step_size + use clm_varcon , only : secspday + use clm_varpar , only : i_cwd + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + ! + ! !LOCAL VARIABLES: + real(r8):: dt ! decomp timestep (seconds) + real(r8):: dtd ! decomp timestep (days) + real(r8):: frw(bounds%begc:bounds%endc) ! rooting fraction weight + real(r8), allocatable:: fr(:,:) ! column-level rooting fraction by soil depth + real(r8):: minpsi, maxpsi ! limits for soil water scalar for decomp + real(r8):: psi ! temporary soilpsi for water scalar + real(r8):: rate_scalar ! combined rate scalar for decomp + real(r8):: k_l1 ! decomposition rate constant litter 1 + real(r8):: k_l2 ! decomposition rate constant litter 2 + real(r8):: k_l3 ! decomposition rate constant litter 3 + real(r8):: k_s1 ! decomposition rate constant SOM 1 + real(r8):: k_s2 ! decomposition rate constant SOM 2 + real(r8):: k_s3 ! decomposition rate constant SOM 3 + real(r8):: k_s4 ! decomposition rate constant SOM 4 + real(r8):: k_frag ! fragmentation rate constant CWD + real(r8):: ck_l1 ! corrected decomposition rate constant litter 1 + real(r8):: ck_l2 ! corrected decomposition rate constant litter 2 + real(r8):: ck_l3 ! corrected decomposition rate constant litter 3 + real(r8):: ck_s1 ! corrected decomposition rate constant SOM 1 + real(r8):: ck_s2 ! corrected decomposition rate constant SOM 2 + real(r8):: ck_s3 ! corrected decomposition rate constant SOM 3 + real(r8):: ck_s4 ! corrected decomposition rate constant SOM 4 + real(r8):: ck_frag ! corrected fragmentation rate constant CWD + real(r8):: cwdc_loss ! fragmentation rate for CWD carbon (gC/m2/s) + real(r8):: cwdn_loss ! fragmentation rate for CWD nitrogen (gN/m2/s) + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: i_soil4 + integer :: c, fc, j, k, l + real(r8):: Q10 ! temperature dependence + real(r8):: froz_q10 ! separate q10 for frozen soil respiration rates. default to same as above zero rates + real(r8):: decomp_depth_efolding ! (meters) e-folding depth for reduction in decomposition [ + real(r8):: depth_scalar(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: mino2lim ! minimum anaerobic decomposition rate as a + ! fraction of potential aerobic rate + !----------------------------------------------------------------------- + + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] soil layer thickness (m) + + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + alt_indx => canopystate_inst%alt_indx_col , & ! Input: [integer (:) ] current depth of thaw + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2stress_sat => ch4_inst%o2stress_sat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + o2stress_unsat => ch4_inst%o2stress_unsat_col , & ! Input: [real(r8) (:,:) ] Ratio of oxygen available to that demanded by roots, aerobes, & methanotrophs (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area (excluding dedicated wetland columns) + + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => soilbiogeochem_carbonflux_inst%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + mino2lim = CNParamsShareInst%mino2lim + + ! set time steps + dt = real( get_step_size(), r8 ) + dtd = dt/secspday + + ! set initial base rates for decomposition mass loss (1/day) + ! (from Biome-BGC v4.2.0, using three SOM pools) + ! Value inside log function is the discrete-time values for a + ! daily time step model, and the result of the log function is + ! the corresponding continuous-time decay rate (1/day), following + ! Olson, 1963. + k_l1=params_inst%k_l1_cn + k_l2=params_inst%k_l2_cn + k_l3=params_inst%k_l3_cn + + k_s1=params_inst%k_s1_cn + k_s2=params_inst%k_s2_cn + k_s3=params_inst%k_s3_cn + k_s4=params_inst%k_s4_cn + + k_frag=params_inst%k_frag_cn + + ! calculate the new discrete-time decay rate for model timestep + k_l1 = 1.0_r8-exp(-k_l1*dtd) + k_l2 = 1.0_r8-exp(-k_l2*dtd) + k_l3 = 1.0_r8-exp(-k_l3*dtd) + + k_s1 = 1.0_r8-exp(-k_s1*dtd) + k_s2 = 1.0_r8-exp(-k_s2*dtd) + k_s3 = 1.0_r8-exp(-k_s3*dtd) + k_s4 = 1.0_r8-exp(-k_s4*dtd) + + k_frag = 1.0_r8-exp(-k_frag*dtd) + + minpsi = params_inst%minpsi_cn + + Q10 = CNParamsShareInst%Q10 + + ! set "froz_q10" parameter + froz_q10 = CNParamsShareInst%froz_q10 + + if (use_vertsoilc) then + ! Set "decomp_depth_efolding" parameter + decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding + end if + + ! The following code implements the acceleration part of the AD spinup + ! algorithm, by multiplying all of the SOM decomposition base rates by 10.0. + + if ( spinup_state .eq. 1 ) then + k_s1 = k_s1 * params_inst%spinup_vector(1) + k_s2 = k_s2 * params_inst%spinup_vector(2) + k_s3 = k_s3 * params_inst%spinup_vector(3) + k_s4 = k_s4 * params_inst%spinup_vector(4) + endif + + i_litr1 = 1 + i_litr2 = 2 + i_litr3 = 3 + i_soil1 = 5 + i_soil2 = 6 + i_soil3 = 7 + i_soil4 = 8 + + + !--- time dependent coefficients-----! + if ( nlevdecomp .eq. 1 ) then + + ! calculate function to weight the temperature and water potential scalars + ! for decomposition control. + + + ! the following normalizes values in fr so that they + ! sum to 1.0 across top nlevdecomp levels on a column + frw(bounds%begc:bounds%endc) = 0._r8 + nlev_soildecomp_standard=5 + allocate(fr(bounds%begc:bounds%endc,nlev_soildecomp_standard)) + do j=1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + frw(c) = frw(c) + dz(c,j) + end do + end do + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (frw(c) /= 0._r8) then + fr(c,j) = dz(c,j) / frw(c) + else + fr(c,j) = 0._r8 + end if + end do + end do + + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) t_scalar(c,:) = 0._r8 + !! use separate (possibly equal) t funcs above and below freezing point + !! t_scalar(c,1)=t_scalar(c,1) + (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + else + t_scalar(c,1)=t_scalar(c,1) + & + (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8))*fr(c,j) + endif + end do + end do + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + if (j==1) w_scalar(c,:) = 0._r8 + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,1) = w_scalar(c,1) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j) + end if + end do + end do + + if (use_lch4) then + if (anoxia_wtsat) then ! Adjust for saturated fraction if unfrozen. + do fc = 1,num_soilc + c = filter_soilc(fc) + if (alt_indx(c) >= nlev_soildecomp_standard .and. t_soisno(c,1) > SHR_CONST_TKFRZ) then + w_scalar(c,1) = w_scalar(c,1)*(1._r8 - finundated(c)) + finundated(c) + end if + end do + end if + end if + + if (use_lch4) then + ! Calculate ANOXIA + if (anoxia) then + ! Check for anoxia w/o LCH4 now done in controlMod. + + do j = 1,nlev_soildecomp_standard + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (j==1) o_scalar(c,:) = 0._r8 + + if (.not. anoxia_wtsat) then + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * max(o2stress_unsat(c,j), mino2lim) + else + o_scalar(c,1) = o_scalar(c,1) + fr(c,j) * & + (max(o2stress_unsat(c,j), mino2lim)*(1._r8 - finundated(c)) + & + max(o2stress_sat(c,j), mino2lim)*finundated(c) ) + end if + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + deallocate(fr) + + else + + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + !! use separate (possibly equal) t funcs above and below freezing point + !! t_scalar(c,j)= (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + if (t_soisno(c,j) >= SHR_CONST_TKFRZ) then + t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + else + t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8)) + endif + end do + end do + + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi)) + else + w_scalar(c,j) = 0._r8 + end if + if (use_lch4) then + if (anoxia_wtsat .and. t_soisno(c,j) > SHR_CONST_TKFRZ) then ! wet area will have w_scalar of 1 if unfrozen + w_scalar(c,j) = w_scalar(c,j)*(1._r8 - finundated(c)) + finundated(c) + end if + end if + end do + end do + + end if + + if (use_lch4) then + ! Calculate ANOXIA + ! Check for anoxia w/o LCH4 now done in controlMod. + + if (anoxia) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. anoxia_wtsat) then + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) + else + o_scalar(c,j) = max(o2stress_unsat(c,j), mino2lim) * (1._r8 - finundated(c)) + & + max(o2stress_sat(c,j), mino2lim) * finundated(c) + end if + end do + end do + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + else + o_scalar(bounds%begc:bounds%endc,1:nlevdecomp) = 1._r8 + end if + + if (use_vertsoilc) then + ! add a term to reduce decomposition rate at depth + ! for now used a fixed e-folding depth + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + depth_scalar(c,j) = exp(-zsoi(j)/decomp_depth_efolding) + end do + end do + end if + + if (use_vertsoilc) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * depth_scalar(c,j) * o_scalar(c,j) / dt + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_k(c,j,i_litr1) = k_l1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr2) = k_l2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_litr3) = k_l3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_cwd) = k_frag * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil1) = k_s1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil2) = k_s2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil3) = k_s3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + decomp_k(c,j,i_soil4) = k_s4 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) / dt + end do + end do + end if + + end associate + + end subroutine decomp_rate_constants_cn + + end module SoilBiogeochemDecompCascadeCNMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 new file mode 100644 index 0000000000..9a125f0ef3 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompCascadeConType.F90 @@ -0,0 +1,97 @@ +module SoilBiogeochemDecompCascadeConType + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Decomposition Cascade Type + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: init_decomp_cascade_constants + ! + type, public :: decomp_cascade_type + !-- properties of each pathway along decomposition cascade + character(len=8) , pointer :: cascade_step_name(:) ! name of transition + integer , pointer :: cascade_donor_pool(:) ! which pool is C taken from for a given decomposition step + integer , pointer :: cascade_receiver_pool(:) ! which pool is C added to for a given decomposition step + + !-- properties of each decomposing pool + logical , pointer :: floating_cn_ratio_decomp_pools(:) ! TRUE => pool has fixed C:N ratio + character(len=8) , pointer :: decomp_pool_name_restart(:) ! name of pool for restart files + character(len=8) , pointer :: decomp_pool_name_history(:) ! name of pool for history files + character(len=20) , pointer :: decomp_pool_name_long(:) ! name of pool for netcdf long names + character(len=8) , pointer :: decomp_pool_name_short(:) ! name of pool for netcdf short names + logical , pointer :: is_litter(:) ! TRUE => pool is a litter pool + logical , pointer :: is_soil(:) ! TRUE => pool is a soil pool + logical , pointer :: is_cwd(:) ! TRUE => pool is a cwd pool + real(r8) , pointer :: initial_cn_ratio(:) ! c:n ratio for initialization of pools + real(r8) , pointer :: initial_stock(:) ! initial concentration for seeding at spinup + logical , pointer :: is_metabolic(:) ! TRUE => pool is metabolic material + logical , pointer :: is_cellulose(:) ! TRUE => pool is cellulose + logical , pointer :: is_lignin(:) ! TRUE => pool is lignin + real(r8) , pointer :: spinup_factor(:) ! factor by which to scale AD and relevant processes by + end type decomp_cascade_type + + type(decomp_cascade_type), public :: decomp_cascade_con + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_decomp_cascade_constants() + ! + ! !DESCRIPTION: + ! Initialize decomposition cascade state + !------------------------------------------------------------------------ + + !-- properties of each pathway along decomposition cascade + allocate(decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions)) + allocate(decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions)) + allocate(decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions)) + + !-- properties of each decomposing pool + allocate(decomp_cascade_con%floating_cn_ratio_decomp_pools(0:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_restart(0:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_history(0:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_long(0:ndecomp_pools)) + allocate(decomp_cascade_con%decomp_pool_name_short(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_litter(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_soil(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_cwd(0:ndecomp_pools)) + allocate(decomp_cascade_con%initial_cn_ratio(0:ndecomp_pools)) + allocate(decomp_cascade_con%initial_stock(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_metabolic(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_cellulose(0:ndecomp_pools)) + allocate(decomp_cascade_con%is_lignin(0:ndecomp_pools)) + allocate(decomp_cascade_con%spinup_factor(0:ndecomp_pools)) + + !-- properties of each pathway along decomposition cascade + decomp_cascade_con%cascade_step_name(1:ndecomp_cascade_transitions) = '' + decomp_cascade_con%cascade_donor_pool(1:ndecomp_cascade_transitions) = 0 + decomp_cascade_con%cascade_receiver_pool(1:ndecomp_cascade_transitions) = 0 + + !-- first initialization of properties of each decomposing pool + decomp_cascade_con%floating_cn_ratio_decomp_pools(0:ndecomp_pools) = .false. + decomp_cascade_con%decomp_pool_name_history(0:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_restart(0:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_long(0:ndecomp_pools) = '' + decomp_cascade_con%decomp_pool_name_short(0:ndecomp_pools) = '' + decomp_cascade_con%is_litter(0:ndecomp_pools) = .false. + decomp_cascade_con%is_soil(0:ndecomp_pools) = .false. + decomp_cascade_con%is_cwd(0:ndecomp_pools) = .false. + decomp_cascade_con%initial_cn_ratio(0:ndecomp_pools) = nan + decomp_cascade_con%initial_stock(0:ndecomp_pools) = nan + decomp_cascade_con%is_metabolic(0:ndecomp_pools) = .false. + decomp_cascade_con%is_cellulose(0:ndecomp_pools) = .false. + decomp_cascade_con%is_lignin(0:ndecomp_pools) = .false. + decomp_cascade_con%spinup_factor(0:ndecomp_pools) = nan + + end subroutine init_decomp_cascade_constants + +end module SoilBiogeochemDecompCascadeConType diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 new file mode 100644 index 0000000000..3d98c29fc2 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemDecompMod.F90 @@ -0,0 +1,251 @@ +module SoilBiogeochemDecompMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in litter and soil decomposition model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use clm_varctl , only : use_nitrif_denitrif, use_lch4 + use clm_varcon , only : dzsoi_decomp + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemDecomp + ! + type, private :: params_type + real(r8) :: dnp !denitrification proportion + end type params_type + ! + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + use abortutils , only: endrun + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='dnp' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%dnp=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemDecomp (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade) + ! + ! !USES: + ! + ! !ARGUMENT: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + real(r8) , intent(inout) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools + real(r8) , intent(inout) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another + real(r8) , intent(inout) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux from one pool to another + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l,m ! indices + integer :: fc ! lake filter column index + integer :: begc,endc ! bounds + integer, parameter :: i_atm = 0 !TODO - this appears in two places - move it to 1 + ! For methane code + real(r8):: hrsum(bounds%begc:bounds%endc,1:nlevdecomp) ! sum of HR (gC/m2/s) + !----------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + + SHR_ASSERT_ALL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(__FILE__, __LINE__)) + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools + + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units) + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ] + gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s) + net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s) + + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability + decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential HR (gC/m3/s) + fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic + ) + + ! column loop to calculate actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N + + ! calculate c:n ratios of applicable pools + do l = 1, ndecomp_pools + if ( floating_cn_ratio_decomp_pools(l) ) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( decomp_npools_vr(c,j,l) > 0._r8 ) then + cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cn_decomp_pools(c,j,l) = initial_cn_ratio(l) + end do + end do + end if + end do + + ! column loop to calculate actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N + + ! upon return from SoilBiogeochemCompetition, the fraction of potential immobilization + ! has been set (soilbiogeochem_state_inst%fpi_vr_col). now finish the decomp calculations. + ! Only the immobilization steps are limited by fpi_vr (pmnf > 0) + ! Also calculate denitrification losses as a simple proportion + ! of mineralization flux. + + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then + if ( pmnf_decomp_cascade(c,j,k) > 0._r8 ) then + p_decomp_cpool_loss(c,j,k) = p_decomp_cpool_loss(c,j,k) * fpi_vr(c,j) + pmnf_decomp_cascade(c,j,k) = pmnf_decomp_cascade(c,j,k) * fpi_vr(c,j) + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8 + end if + else + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = -params_inst%dnp * pmnf_decomp_cascade(c,j,k) + end if + end if + decomp_cascade_hr_vr(c,j,k) = rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + decomp_cascade_ctransfer_vr(c,j,k) = (1._r8 - rf_decomp_cascade(c,j,k)) * p_decomp_cpool_loss(c,j,k) + if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. cascade_receiver_pool(k) /= i_atm) then + decomp_cascade_ntransfer_vr(c,j,k) = p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k)) + else + decomp_cascade_ntransfer_vr(c,j,k) = 0._r8 + endif + if ( cascade_receiver_pool(k) /= 0 ) then + decomp_cascade_sminn_flux_vr(c,j,k) = pmnf_decomp_cascade(c,j,k) + else ! keep sign convention negative for terminal pools + decomp_cascade_sminn_flux_vr(c,j,k) = - pmnf_decomp_cascade(c,j,k) + endif + net_nmin_vr(c,j) = net_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k) + else + decomp_cascade_ntransfer_vr(c,j,k) = 0._r8 + if (.not. use_nitrif_denitrif) then + sminn_to_denit_decomp_cascade_vr(c,j,k) = 0._r8 + end if + decomp_cascade_sminn_flux_vr(c,j,k) = 0._r8 + end if + + end do + end do + end do + + if (use_lch4) then + ! Calculate total fraction of potential HR, for methane code + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + hrsum(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + hrsum(c,j) = hrsum(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + end do + end do + end do + + ! Nitrogen limitation / (low)-moisture limitation + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (phr_vr(c,j) > 0._r8) then + fphr(c,j) = hrsum(c,j) / phr_vr(c,j) * w_scalar(c,j) + fphr(c,j) = max(fphr(c,j), 0.01_r8) ! Prevent overflow errors for 0 respiration + else + fphr(c,j) = 1._r8 + end if + end do + end do + end if + + ! vertically integrate net and gross mineralization fluxes for diagnostic output + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + net_nmin(c) = net_nmin(c) + net_nmin_vr(c,j) * dzsoi_decomp(j) + gross_nmin(c) = gross_nmin(c) + gross_nmin_vr(c,j) * dzsoi_decomp(j) + end do + end do + + end associate + + end subroutine SoilBiogeochemDecomp + +end module SoilBiogeochemDecompMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 new file mode 100644 index 0000000000..a1cc5a1956 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemLittVertTranspMod.F90 @@ -0,0 +1,475 @@ +module SoilBiogeochemLittVertTranspMod + + !----------------------------------------------------------------------- + ! calculate vertical mixing of all decomposing C and N pools + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog, use_c13, use_c14, spinup_state, use_vertsoilc + use clm_varcon , only : secspday + use decompMod , only : bounds_type + use abortutils , only : endrun + use CanopyStateType , only : canopystate_type + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + ! + implicit none + private + ! + public :: readParams + public :: SoilBiogeochemLittVertTransp + + type, private :: params_type + real(r8) :: som_diffus ! Soil organic matter diffusion + real(r8) :: cryoturb_diffusion_k ! The cryoturbation diffusive constant cryoturbation to the active layer thickness + real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur + end type params_type + + type(params_type), private :: params_inst + ! + real(r8), public :: som_adv_flux = 0._r8 + real(r8), public :: max_depth_cryoturb = 3._r8 ! (m) this is the maximum depth of cryoturbation + real(r8) :: som_diffus ! [m^2/sec] = 1 cm^2 / yr + real(r8) :: cryoturb_diffusion_k ! [m^2/sec] = 5 cm^2 / yr = 1m^2 / 200 yr + real(r8) :: max_altdepth_cryoturbation ! (m) maximum active layer thickness for cryoturbation to occur + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + use ncdio_pio , only : file_desc_t,ncd_io + ! + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + character(len=32) :: subname = 'SoilBiogeochemLittVertTranspType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! read in parameters + ! + tString='som_diffus' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + !soilbiogeochem_litt_verttransp_params_inst%som_diffus=tempr + ! FIX(SPM,032414) - can't be pulled out since division makes things not bfb + params_inst%som_diffus = 1e-4_r8 / (secspday * 365._r8) + + tString='cryoturb_diffusion_k' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + !soilbiogeochem_litt_verttransp_params_inst%cryoturb_diffusion_k=tempr + !FIX(SPM,032414) Todo. This constant cannot be on file since the divide makes things + !SPM Todo. This constant cannot be on file since the divide makes things + !not bfb + params_inst%cryoturb_diffusion_k = 5e-4_r8 / (secspday * 365._r8) ! [m^2/sec] = 5 cm^2 / yr = 1m^2 / 200 yr + + tString='max_altdepth_cryoturbation' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%max_altdepth_cryoturbation=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemLittVertTransp(bounds, num_soilc, filter_soilc, & + canopystate_inst, soilbiogeochem_state_inst, & + soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + c13_soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonflux_inst, & + c14_soilbiogeochem_carbonstate_inst, c14_soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! Calculate vertical mixing of soil and litter pools. Also reconcile sources and sinks of these pools + ! calculated in the CStateUpdate1 and NStateUpdate1 subroutines. + ! Advection-diffusion code based on algorithm in Patankar (1980) + ! Initial code by C. Koven and W. Riley + ! + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, ndecomp_pools, nlevdecomp_full + use clm_varcon , only : zsoi, dzsoi_decomp, zisoi + use TridiagonalMod , only : Tridiagonal + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c13_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: c14_soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: diffus (bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity (m2/s) (includes spinup correction, if any) + real(r8) :: adv_flux(bounds%begc:bounds%endc,1:nlevdecomp+1) ! advective flux (m/s) (includes spinup correction, if any) + real(r8) :: aaa ! "A" function in Patankar + real(r8) :: pe ! Pe for "A" function in Patankar + real(r8) :: w_m1, w_p1 ! Weights for calculating harmonic mean of diffusivity + real(r8) :: d_m1, d_p1 ! Harmonic mean of diffusivity + real(r8) :: a_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "a" vector for tridiagonal matrix + real(r8) :: b_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "b" vector for tridiagonal matrix + real(r8) :: c_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "c" vector for tridiagonal matrix + real(r8) :: r_tri(bounds%begc:bounds%endc,0:nlevdecomp+1) ! "r" vector for tridiagonal solution + real(r8) :: d_p1_zp1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for next j (set to zero for no diffusion) + real(r8) :: d_m1_zm1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! diffusivity/delta_z for previous j (set to zero for no diffusion) + real(r8) :: f_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for next j + real(r8) :: f_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! water flux for previous j + real(r8) :: pe_p1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for next j + real(r8) :: pe_m1(bounds%begc:bounds%endc,1:nlevdecomp+1) ! Peclet # for previous j + real(r8) :: dz_node(1:nlevdecomp+1) ! difference between nodes + real(r8) :: epsilon_t (bounds%begc:bounds%endc,1:nlevdecomp+1,1:ndecomp_pools) ! + real(r8) :: conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1) ! + real(r8) :: a_p_0 + real(r8) :: deficit + integer :: ntype + integer :: i_type,s,fc,c,j,l ! indices + integer :: jtop(bounds%begc:bounds%endc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + integer :: zerolev_diffus + real(r8) :: spinup_term ! spinup accelerated decomposition factor, used to accelerate transport as well + real(r8) :: epsilon ! small number + real(r8), pointer :: conc_ptr(:,:,:) ! pointer, concentration state variable being transported + real(r8), pointer :: source(:,:,:) ! pointer, source term + real(r8), pointer :: trcr_tendency_ptr(:,:,:) ! poiner, store the vertical tendency (gain/loss due to vertical transport) + !----------------------------------------------------------------------- + + ! Set statement functions + aaa (pe) = max (0._r8, (1._r8 - 0.1_r8 * abs(pe))**5) ! A function from Patankar, Table 5.2, pg 95 + + associate( & + is_cwd => decomp_cascade_con%is_cwd , & ! Input: [logical (:) ] TRUE => pool is a cwd pool + spinup_factor => decomp_cascade_con%spinup_factor , & ! Input: [real(r8) (:) ] spinup accelerated decomposition factor, used to accelerate transport as well + + altmax => canopystate_inst%altmax_col , & ! Input: [real(r8) (:) ] maximum annual depth of thaw + altmax_lastyear => canopystate_inst%altmax_lastyear_col , & ! Input: [real(r8) (:) ] prior year maximum annual depth of thaw + + som_adv_coef => soilbiogeochem_state_inst%som_adv_coef_col , & ! Output: [real(r8) (:,:) ] SOM advective flux (m/s) + som_diffus_coef => soilbiogeochem_state_inst%som_diffus_coef_col & ! Output: [real(r8) (:,:) ] SOM diffusivity due to bio/cryo-turbation (m2/s) + ) + + !Set parameters of vertical mixing of SOM + som_diffus = params_inst%som_diffus + cryoturb_diffusion_k = params_inst%cryoturb_diffusion_k + max_altdepth_cryoturbation = params_inst%max_altdepth_cryoturbation + + dtime = get_step_size() + + ntype = 2 + if ( use_c13 ) then + ntype = ntype+1 + endif + if ( use_c14 ) then + ntype = ntype+1 + endif + spinup_term = 1._r8 + epsilon = 1.e-30 + + if (use_vertsoilc) then + !------ first get diffusivity / advection terms -------! + ! use different mixing rates for bioturbation and cryoturbation, with fixed bioturbation and cryoturbation set to a maximum depth + do fc = 1, num_soilc + c = filter_soilc (fc) + if (( max(altmax(c), altmax_lastyear(c)) <= max_altdepth_cryoturbation ) .and. & + ( max(altmax(c), altmax_lastyear(c)) > 0._r8) ) then + ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth + do j = 1,nlevdecomp+1 + if ( zisoi(j) < max(altmax(c), altmax_lastyear(c)) ) then + som_diffus_coef(c,j) = cryoturb_diffusion_k + som_adv_coef(c,j) = 0._r8 + else + som_diffus_coef(c,j) = max(cryoturb_diffusion_k * & + ( 1._r8 - ( zisoi(j) - max(altmax(c), altmax_lastyear(c)) ) / & + ( max_depth_cryoturb - max(altmax(c), altmax_lastyear(c)) ) ), 0._r8) ! go linearly to zero between ALT and max_depth_cryoturb + som_adv_coef(c,j) = 0._r8 + endif + end do + elseif ( max(altmax(c), altmax_lastyear(c)) > 0._r8 ) then + ! constant advection, constant diffusion + do j = 1,nlevdecomp+1 + som_adv_coef(c,j) = som_adv_flux + som_diffus_coef(c,j) = som_diffus + end do + else + ! completely frozen soils--no mixing + do j = 1,nlevdecomp+1 + som_adv_coef(c,j) = 0._r8 + som_diffus_coef(c,j) = 0._r8 + end do + endif + end do + + ! Set the distance between the node and the one ABOVE it + dz_node(1) = zsoi(1) + do j = 2,nlevdecomp+1 + dz_node(j)= zsoi(j) - zsoi(j-1) + enddo + + endif + + !------ loop over litter/som types + do i_type = 1, ntype + + select case (i_type) + case (1) ! C + conc_ptr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + case (2) ! N + conc_ptr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col + source => soilbiogeochem_nitrogenflux_inst%decomp_npools_sourcesink_col + trcr_tendency_ptr => soilbiogeochem_nitrogenflux_inst%decomp_npools_transport_tendency_col + case (3) + if ( use_c13 ) then + ! C13 + conc_ptr => c13_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c13_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c13_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + else + ! C14 + conc_ptr => c14_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + endif + case (4) + if ( use_c14 .and. use_c13 ) then + ! C14 + conc_ptr => c14_soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col + source => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_sourcesink_col + trcr_tendency_ptr => c14_soilbiogeochem_carbonflux_inst%decomp_cpools_transport_tendency_col + else + write(iulog,*) 'error. ncase = 4, but c13 and c14 not both enabled.' + call endrun(msg=errMsg(__FILE__, __LINE__)) + endif + end select + + if (use_vertsoilc) then + + do s = 1, ndecomp_pools + + if ( spinup_state .eq. 1 ) then + ! increase transport (both advection and diffusion) by the same factor as accelerated decomposition for a given pool + spinup_term = spinup_factor(s) + else + spinup_term = 1. + endif + + if ( .not. is_cwd(s) ) then + + do j = 1,nlevdecomp+1 + do fc = 1, num_soilc + c = filter_soilc (fc) + ! + if ( abs(som_adv_coef(c,j)) * spinup_term < epsilon ) then + adv_flux(c,j) = epsilon + else + adv_flux(c,j) = som_adv_coef(c,j) * spinup_term + endif + ! + if ( abs(som_diffus_coef(c,j)) * spinup_term < epsilon ) then + diffus(c,j) = epsilon + else + diffus(c,j) = som_diffus_coef(c,j) * spinup_term + endif + ! + end do + end do + + ! Set Pe (Peclet #) and D/dz throughout column + + do fc = 1, num_soilc ! dummy terms here + c = filter_soilc (fc) + conc_trcr(c,0) = 0._r8 + conc_trcr(c,nlevdecomp+1) = 0._r8 + end do + + + do j = 1,nlevdecomp+1 + do fc = 1, num_soilc + c = filter_soilc (fc) + + conc_trcr(c,j) = conc_ptr(c,j,s) + ! dz_tracer below is the difference between gridcell edges (dzsoi_decomp) + ! dz_node_tracer is difference between cell centers + + ! Calculate the D and F terms in the Patankar algorithm + if (j == 1) then + d_m1_zm1(c,j) = 0._r8 + w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1) + if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus + else + d_p1 = 0._r8 + endif + d_p1_zp1(c,j) = d_p1 / dz_node(j+1) + f_m1(c,j) = adv_flux(c,j) ! Include infiltration here + f_p1(c,j) = adv_flux(c,j+1) + pe_m1(c,j) = 0._r8 + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + elseif (j == nlevdecomp+1) then + ! At the bottom, assume no gradient in d_z (i.e., they're the same) + w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j) + if ( diffus(c,j) > 0._r8 .and. diffus(c,j-1) > 0._r8) then + d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus + else + d_m1 = 0._r8 + endif + d_m1_zm1(c,j) = d_m1 / dz_node(j) + d_p1_zp1(c,j) = d_m1_zm1(c,j) ! Set to be the same + f_m1(c,j) = adv_flux(c,j) + !f_p1(c,j) = adv_flux(c,j+1) + f_p1(c,j) = 0._r8 + pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet # + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + else + ! Use distance from j-1 node to interface with j divided by distance between nodes + w_m1 = (zisoi(j-1) - zsoi(j-1)) / dz_node(j) + if ( diffus(c,j-1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_m1 = 1._r8 / ((1._r8 - w_m1) / diffus(c,j) + w_m1 / diffus(c,j-1)) ! Harmonic mean of diffus + else + d_m1 = 0._r8 + endif + w_p1 = (zsoi(j+1) - zisoi(j)) / dz_node(j+1) + if ( diffus(c,j+1) > 0._r8 .and. diffus(c,j) > 0._r8) then + d_p1 = 1._r8 / ((1._r8 - w_p1) / diffus(c,j) + w_p1 / diffus(c,j+1)) ! Harmonic mean of diffus + else + d_p1 = (1._r8 - w_m1) * diffus(c,j) + w_p1 * diffus(c,j+1) ! Arithmetic mean of diffus + endif + d_m1_zm1(c,j) = d_m1 / dz_node(j) + d_p1_zp1(c,j) = d_p1 / dz_node(j+1) + f_m1(c,j) = adv_flux(c,j) + f_p1(c,j) = adv_flux(c,j+1) + pe_m1(c,j) = f_m1(c,j) / d_m1_zm1(c,j) ! Peclet # + pe_p1(c,j) = f_p1(c,j) / d_p1_zp1(c,j) ! Peclet # + end if + enddo ! fc + enddo ! j; nlevdecomp + + + ! Calculate the tridiagonal coefficients + do j = 0,nlevdecomp +1 + do fc = 1, num_soilc + c = filter_soilc (fc) + ! g = cgridcell(c) + + if (j > 0 .and. j < nlevdecomp+1) then + a_p_0 = dzsoi_decomp(j) / dtime + endif + + if (j == 0) then ! top layer (atmosphere) + a_tri(c,j) = 0._r8 + b_tri(c,j) = 1._r8 + c_tri(c,j) = -1._r8 + r_tri(c,j) = 0._r8 + elseif (j == 1) then + a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar + c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8)) + b_tri(c,j) = -a_tri(c,j) - c_tri(c,j) + a_p_0 + r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + (a_p_0 - adv_flux(c,j)) * conc_trcr(c,j) + elseif (j < nlevdecomp+1) then + a_tri(c,j) = -(d_m1_zm1(c,j) * aaa(pe_m1(c,j)) + max( f_m1(c,j), 0._r8)) ! Eqn 5.47 Patankar + c_tri(c,j) = -(d_p1_zp1(c,j) * aaa(pe_p1(c,j)) + max(-f_p1(c,j), 0._r8)) + b_tri(c,j) = -a_tri(c,j) - c_tri(c,j) + a_p_0 + r_tri(c,j) = source(c,j,s) * dzsoi_decomp(j) /dtime + a_p_0 * conc_trcr(c,j) + else ! j==nlevdecomp+1; 0 concentration gradient at bottom + a_tri(c,j) = -1._r8 + b_tri(c,j) = 1._r8 + c_tri(c,j) = 0._r8 + r_tri(c,j) = 0._r8 + endif + enddo ! fc; column + enddo ! j; nlevdecomp + + do fc = 1, num_soilc + c = filter_soilc (fc) + jtop(c) = 0 + enddo + + ! subtract initial concentration and source terms for tendency calculation + do fc = 1, num_soilc + c = filter_soilc (fc) + do j = 1, nlevdecomp + trcr_tendency_ptr(c,j,s) = 0.-(conc_trcr(c,j) + source(c,j,s)) + end do + end do + + ! Solve for the concentration profile for this time step + call Tridiagonal(bounds, 0, nlevdecomp+1, & + jtop(bounds%begc:bounds%endc), & + num_soilc, filter_soilc, & + a_tri(bounds%begc:bounds%endc, :), & + b_tri(bounds%begc:bounds%endc, :), & + c_tri(bounds%begc:bounds%endc, :), & + r_tri(bounds%begc:bounds%endc, :), & + conc_trcr(bounds%begc:bounds%endc,0:nlevdecomp+1)) + + + ! add post-transport concentration to calculate tendency term + do fc = 1, num_soilc + c = filter_soilc (fc) + do j = 1, nlevdecomp + trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) + conc_trcr(c,j) + trcr_tendency_ptr(c,j,s) = trcr_tendency_ptr(c,j,s) / dtime + end do + end do + + + else + ! for CWD pools, just add + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + conc_trcr(c,j) = conc_ptr(c,j,s) + source(c,j,s) + end do + end do + + end if ! not CWD + + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + conc_ptr(c,j,s) = conc_trcr(c,j) + end do + end do + + end do ! s (pool loop) + + else + + !! for single level case, no transport; just update the fluxes calculated in the StateUpdate1 subroutines + do l = 1, ndecomp_pools + do j = 1,nlevdecomp + do fc = 1, num_soilc + c = filter_soilc (fc) + + conc_ptr(c,j,l) = conc_ptr(c,j,l) + source(c,j,l) + + trcr_tendency_ptr(c,j,l) = 0._r8 + + end do + end do + end do + + endif + + end do ! i_type + + end associate + + end subroutine SoilBiogeochemLittVertTransp + +end module SoilBiogeochemLittVertTranspMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 new file mode 100644 index 0000000000..6726d6c618 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNLeachingMod.F90 @@ -0,0 +1,286 @@ +module SoilBiogeochemNLeachingMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for mineral nitrogen dynamics (deposition, fixation, leaching) + ! for coupled carbon-nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varcon , only : dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use WaterStateType , only : waterstate_type + use WaterFluxType , only : waterflux_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemNLeaching + ! + ! !PRIVATE DATA: + type, private :: params_type + real(r8):: sf ! soluble fraction of mineral N (unitless) + real(r8):: sf_no3 ! soluble fraction of NO3 (unitless) + end type params_type + + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read in parameters + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNNDynamicsParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='sf_minn' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%sf=tempr + + tString='sf_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%sf_no3=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNLeaching(bounds, num_soilc, filter_soilc, & + waterstate_inst, waterflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen leaching rate + ! as a function of soluble mineral N and total soil water outflow. + ! + ! !USES: + use clm_varpar , only : nlevdecomp, nlevsoi + use clm_time_manager , only : get_step_size + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(waterstate_type) , intent(in) :: waterstate_inst + type(waterflux_type) , intent(in) :: waterflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: j,c,fc ! indices + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: sf ! soluble fraction of mineral N (unitless) + real(r8) :: sf_no3 ! soluble fraction of NO3 (unitless) + real(r8) :: disn_conc ! dissolved mineral N concentration (gN/kg water) + real(r8) :: tot_water(bounds%begc:bounds%endc) ! total column liquid water (kg water/m2) + real(r8) :: surface_water(bounds%begc:bounds%endc) ! liquid water to shallow surface depth (kg water/m2) + real(r8) :: drain_tot(bounds%begc:bounds%endc) ! total drainage flux (mm H2O /s) + real(r8), parameter :: depth_runoff_Nloss = 0.05 ! (m) depth over which runoff mixes with soil water for N loss to runoff + !----------------------------------------------------------------------- + + associate( & + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + + qflx_drain => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_surf => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] surface runoff (mm H2O /s) + + sminn_vr => soilbiogeochem_nitrogenstate_inst%sminn_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral N + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] + + sminn_leached_vr => soilbiogeochem_nitrogenflux_inst%sminn_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral N leaching (gN/m3/s) + smin_no3_leached_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_leached_vr_col , & ! Output: [real(r8) (:,:) ] rate of mineral NO3 leaching (gN/m3/s) + smin_no3_runoff_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_runoff_vr_col & ! Output: [real(r8) (:,:) ] rate of mineral NO3 loss with runoff (gN/m3/s) + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + if (.not. use_nitrif_denitrif) then + ! set constant sf + sf = params_inst%sf + else + ! Assume that 100% of the soil NO3 is in a soluble form + sf_no3 = params_inst%sf_no3 + end if + + ! calculate the total soil water + tot_water(bounds%begc:bounds%endc) = 0._r8 + do j = 1,nlevsoi + do fc = 1,num_soilc + c = filter_soilc(fc) + tot_water(c) = tot_water(c) + h2osoi_liq(c,j) + end do + end do + + ! for runoff calculation; calculate total water to a given depth + surface_water(bounds%begc:bounds%endc) = 0._r8 + do j = 1,nlevsoi + if ( zisoi(j) <= depth_runoff_Nloss) then + do fc = 1,num_soilc + c = filter_soilc(fc) + surface_water(c) = surface_water(c) + h2osoi_liq(c,j) + end do + elseif ( zisoi(j-1) < depth_runoff_Nloss) then + do fc = 1,num_soilc + c = filter_soilc(fc) + surface_water(c) = surface_water(c) + h2osoi_liq(c,j) * ( (depth_runoff_Nloss - zisoi(j-1)) / col%dz(c,j)) + end do + endif + end do + + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + drain_tot(c) = qflx_drain(c) + end do + + + if (.not. use_nitrif_denitrif) then + + !---------------------------------------- + ! --------- NITRIF_NITRIF OFF------------ + !---------------------------------------- + + do j = 1,nlevdecomp + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_vertsoilc) then + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (tot_water(c) > 0._r8) then + disn_conc = (sf * sminn_vr(c,j) ) / tot_water(c) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + sminn_leached_vr(c,j) = disn_conc * drain_tot(c) + else + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (h2osoi_liq(c,j) > 0._r8) then + disn_conc = (sf * sminn_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) ) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + sminn_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) ) + + end if + + ! limit the flux based on current sminn state + ! only let at most the assumed soluble fraction + ! of sminn be leached on any given timestep + sminn_leached_vr(c,j) = min(sminn_leached_vr(c,j), (sf * sminn_vr(c,j))/dt) + + ! limit the flux to a positive value + sminn_leached_vr(c,j) = max(sminn_leached_vr(c,j), 0._r8) + + end do + end do + + else + + !---------------------------------------- + ! --------- NITRIF_NITRIF ON------------- + !---------------------------------------- + + do j = 1,nlevdecomp + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_vertsoilc) then + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (tot_water(c) > 0._r8) then + disn_conc = (sf_no3 * smin_no3_vr(c,j) )/tot_water(c) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c) + else + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (h2osoi_liq(c,j) > 0._r8) then + disn_conc = (sf_no3 * smin_no3_vr(c,j) * col%dz(c,j) )/(h2osoi_liq(c,j) ) + end if + ! + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + smin_no3_leached_vr(c,j) = disn_conc * drain_tot(c) * h2osoi_liq(c,j) / ( tot_water(c) * col%dz(c,j) ) + ! + ! ensure that leaching rate isn't larger than soil N pool + smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), smin_no3_vr(c,j) / dt ) + ! + ! limit the leaching flux to a positive value + smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8) + ! + ! + ! calculate the N loss from surface runoff, assuming a shallow mixing of surface waters into soil and removal based on runoff + if ( zisoi(j) <= depth_runoff_Nloss ) then + smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * & + h2osoi_liq(c,j) / ( surface_water(c) * col%dz(c,j) ) + elseif ( zisoi(j-1) < depth_runoff_Nloss ) then + smin_no3_runoff_vr(c,j) = disn_conc * qflx_surf(c) * & + h2osoi_liq(c,j) * ((depth_runoff_Nloss - zisoi(j-1)) / & + col%dz(c,j)) / ( surface_water(c) * (depth_runoff_Nloss-zisoi(j-1) )) + else + smin_no3_runoff_vr(c,j) = 0._r8 + endif + ! + ! ensure that runoff rate isn't larger than soil N pool + smin_no3_runoff_vr(c,j) = min(smin_no3_runoff_vr(c,j), smin_no3_vr(c,j) / dt - smin_no3_leached_vr(c,j)) + ! + ! limit the flux to a positive value + smin_no3_runoff_vr(c,j) = max(smin_no3_runoff_vr(c,j), 0._r8) + + + endif + ! limit the flux based on current smin_no3 state + ! only let at most the assumed soluble fraction + ! of smin_no3 be leached on any given timestep + smin_no3_leached_vr(c,j) = min(smin_no3_leached_vr(c,j), (sf_no3 * smin_no3_vr(c,j))/dt) + + ! limit the flux to a positive value + smin_no3_leached_vr(c,j) = max(smin_no3_leached_vr(c,j), 0._r8) + + end do + end do + endif + + end associate + + end subroutine SoilBiogeochemNLeaching + +end module SoilBiogeochemNLeachingMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 new file mode 100644 index 0000000000..fb7eb8ba5d --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNStateUpdate1Mod.F90 @@ -0,0 +1,249 @@ +module SoilBiogeochemNStateUpdate1Mod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module for nitrogen state variable updates, non-mortality fluxes. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use clm_varpar , only : crop_prog, i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_varctl , only : iulog, use_nitrif_denitrif + use clm_varcon , only : nitrif_n2o_loss_frac + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenfluxType , only : soilbiogeochem_nitrogenflux_type + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemNStateUpdate1 + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNStateUpdate1(num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update all the prognostic nitrogen state + ! variables (except for gap-phase mortality and fire fluxes) + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(in) :: soilbiogeochem_state_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,p,j,l,k ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + !----------------------------------------------------------------------- + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + + ndep_prof => soilbiogeochem_state_inst%ndep_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N deposition is distributed through column (1/m) + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Input: [real(r8) (:,:) ] profile over which N fixation is distributed through column (1/m) + + nf => soilbiogeochem_nitrogenflux_inst , & ! Output: + ns => soilbiogeochem_nitrogenstate_inst & ! Output: + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (.not. use_nitrif_denitrif) then + + ! N deposition and fixation + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + + else + + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + + end if + + end do + end do + + ! repeating N dep and fixation for crops + if ( crop_prog )then + do j = 1, nlevdecomp + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + if (.not. use_nitrif_denitrif) then + + ! N deposition and fixation + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) & + + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) & + + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + + else + + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) & + + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) & + + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + + end if + end do + end do + end if + + ! decomposition fluxes + do k = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & + nf%decomp_cascade_ntransfer_vr_col(c,j,k) * dt + end do + end do + end do + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) + & + (nf%decomp_cascade_ntransfer_vr_col(c,j,k) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)) * dt + end do + end do + else ! terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k) * dt + end do + end do + end if + end do + + if (.not. use_nitrif_denitrif) then + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF OFF ------------------- + !-------------------------------------------------------- + + ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes and denitrification fluxes + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & + (nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k))* dt + end do + end do + else + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & + nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k)* dt + + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)* dt + + end do + end do + endif + end do + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! "bulk denitrification" + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_excess_vr_col(c,j) * dt + + ! total plant uptake from mineral N + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_plant_vr_col(c,j)*dt + + ! flux that prevents N limitation (when Carbon_only is set) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + end do + end do + + else + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF ON -------------------- + !-------------------------------------------------------- + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%gross_nmin_vr_col(c,j)*dt + + ! immobilization fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%actual_immob_nh4_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%actual_immob_no3_vr_col(c,j)*dt + + ! plant uptake fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%smin_nh4_to_plant_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%smin_no3_to_plant_vr_col(c,j)*dt + + ! Account for nitrification fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%f_nit_vr_col(c,j) * dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + nf%f_nit_vr_col(c,j) * dt & + * (1._r8 - nitrif_n2o_loss_frac) + + ! Account for denitrification fluxes + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%f_denit_vr_col(c,j) * dt + + ! flux that prevents N limitation (when Carbon_only is set; put all into NH4) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + + ! update diagnostic total + ns%sminn_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + ns%smin_no3_vr_col(c,j) + + end do ! end of column loop + end do + + end if + + end associate + + end subroutine SoilBiogeochemNStateUpdate1 + +end module SoilBiogeochemNStateUpdate1Mod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 new file mode 100644 index 0000000000..4483e81ba2 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrifDenitrifMod.F90 @@ -0,0 +1,392 @@ +module SoilBiogeochemNitrifDenitrifMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate nitrification and denitrification rates + ! + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod , only : SHR_CONST_TKFRZ + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : nlevdecomp + use clm_varcon , only : rpi, grav + use clm_varcon , only : d_con_g, d_con_w, spval, secspday + use clm_varctl , only : use_lch4 + use abortutils , only : endrun + use decompMod , only : bounds_type + use SoilStatetype , only : soilstate_type + use WaterStateType , only : waterstate_type + use TemperatureType , only : temperature_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use ch4Mod , only : ch4_type + use ColumnType , only : col + ! + implicit none + private + ! + public :: readParams + public :: SoilBiogeochemNitrifDenitrif + ! + type, private :: params_type + real(r8) :: k_nitr_max ! maximum nitrification rate constant (1/s) + real(r8) :: surface_tension_water ! surface tension of water(J/m^2), Arah an and Vinten 1995 + real(r8) :: rij_kro_a ! Arah and Vinten 1995) + real(r8) :: rij_kro_alpha ! parameter to calculate anoxic fraction of soil (Arah and Vinten 1995) + real(r8) :: rij_kro_beta ! (Arah and Vinten 1995) + real(r8) :: rij_kro_gamma ! (Arah and Vinten 1995) + real(r8) :: rij_kro_delta ! (Arah and Vinten 1995) + end type params_type + + type(params_type), private :: params_inst + + logical, public :: no_frozen_nitrif_denitrif = .false. ! stop nitrification and denitrification in frozen soils + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + use ncdio_pio, only: file_desc_t,ncd_io + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNNitrifDenitrifParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! read in constants + ! + tString='k_nitr_max' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%k_nitr_max=tempr + + tString='surface_tension_water' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%surface_tension_water=tempr + + tString='rij_kro_a' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rij_kro_a=tempr + + tString='rij_kro_alpha' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rij_kro_alpha=tempr + + tString='rij_kro_beta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rij_kro_beta=tempr + + tString='rij_kro_gamma' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rij_kro_gamma=tempr + + tString='rij_kro_delta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%rij_kro_delta=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNitrifDenitrif(bounds, num_soilc, filter_soilc, & + soilstate_inst, waterstate_inst, temperature_inst, ch4_inst, & + soilbiogeochem_carbonflux_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + ! + ! !DESCRIPTION: + ! calculate nitrification and denitrification rates + ! + ! !USES: + use clm_time_manager , only : get_curr_date, get_step_size + use CNSharedParamsMod , only : anoxia_wtsat, CNParamsShareInst + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(ch4_type) , intent(in) :: ch4_inst + type(soilbiogeochem_carbonflux_type) , intent(in) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(in) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + ! + ! !LOCAL VARIABLES: + integer :: c, fc, reflev, j + real(r8) :: soil_hr_vr(bounds%begc:bounds%endc,1:nlevdecomp) ! total soil respiration rate (g C / m3 / s) + real(r8) :: g_per_m3__to__ug_per_gsoil + real(r8) :: g_per_m3_sec__to__ug_per_gsoil_day + real(r8) :: k_nitr_max ! maximum nitrification rate constant (1/s) + real(r8) :: mu, sigma + real(r8) :: t + real(r8) :: pH(bounds%begc:bounds%endc) + !debug-- put these type structure for outing to hist files + real(r8) :: co2diff_con(2) ! diffusion constants for CO2 + real(r8) :: eps + real(r8) :: f_a + real(r8) :: surface_tension_water ! (J/m^2), Arah and Vinten 1995 + real(r8) :: rij_kro_a ! Arah and Vinten 1995 + real(r8) :: rij_kro_alpha ! Arah and Vinten 1995 + real(r8) :: rij_kro_beta ! Arah and Vinten 1995 + real(r8) :: rij_kro_gamma ! Arah and Vinten 1995 + real(r8) :: rij_kro_delta ! Arah and Vinten 1995 + real(r8) :: rho_w = 1.e3_r8 ! (kg/m3) + real(r8) :: r_max + real(r8) :: r_min(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: ratio_diffusivity_water_gas(bounds%begc:bounds%endc,1:nlevdecomp) + real(r8) :: om_frac + real(r8) :: anaerobic_frac_sat, r_psi_sat, r_min_sat ! scalar values in sat portion for averaging + real(r8) :: organic_max ! organic matter content (kg/m3) where + ! soil is assumed to act like peat + character(len=32) :: subname='nitrif_denitrif' ! subroutine name + !----------------------------------------------------------------------- + + associate( & + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) (nlevgrnd) + watfc => soilstate_inst%watfc_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at field capacity (nlevsoi) + bd => soilstate_inst%bd_col , & ! Input: [real(r8) (:,:) ] bulk density of dry soil material [kg/m3] + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" (nlevgrnd) + cellorg => soilstate_inst%cellorg_col , & ! Input: [real(r8) (:,:) ] column 3D org (kg/m3 organic matter) (nlevgrnd) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + soilpsi => soilstate_inst%soilpsi_col , & ! Input: [real(r8) (:,:) ] soil water potential in each soil layer (MPa) + + h2osoi_vol => waterstate_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + + t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + + o2_decomp_depth_unsat => ch4_inst%o2_decomp_depth_unsat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_o2_unsat => ch4_inst%conc_o2_unsat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + o2_decomp_depth_sat => ch4_inst%o2_decomp_depth_sat_col , & ! Input: [real(r8) (:,:) ] O2 consumption during decomposition in each soil layer (nlevsoi) (mol/m3/s) + conc_o2_sat => ch4_inst%conc_o2_sat_col , & ! Input: [real(r8) (:,:) ] O2 conc in each soil layer (mol/m3) (nlevsoi) + finundated => ch4_inst%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column (excluding dedicated wetland columns) + + smin_nh4_vr => soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 pool + smin_no3_vr => soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col , & ! Input: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 pool + + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Input: [real(r8) (:,:) ] potential hr (not N-limited) + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] soil water scalar for decomp + t_scalar => soilbiogeochem_carbonflux_inst%t_scalar_col , & ! Input: [real(r8) (:,:) ] temperature scalar for decomp + + r_psi => soilbiogeochem_nitrogenflux_inst%r_psi_col , & ! Output: [real(r8) (:,:) ] + anaerobic_frac => soilbiogeochem_nitrogenflux_inst%anaerobic_frac_col , & ! Output: [real(r8) (:,:) ] + ! ! subsets of the n flux calcs (for diagnostic/debugging purposes) + smin_no3_massdens_vr => soilbiogeochem_nitrogenflux_inst%smin_no3_massdens_vr_col , & ! Output: [real(r8) (:,:) ] (ugN / g soil) soil nitrate concentration + k_nitr_t_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_t_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_ph_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_ph_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_h2o_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_h2o_vr_col , & ! Output: [real(r8) (:,:) ] + k_nitr_vr => soilbiogeochem_nitrogenflux_inst%k_nitr_vr_col , & ! Output: [real(r8) (:,:) ] + wfps_vr => soilbiogeochem_nitrogenflux_inst%wfps_vr_col , & ! Output: [real(r8) (:,:) ] + fmax_denit_carbonsubstrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_carbonsubstrate_vr_col , & ! Output: [real(r8) (:,:) ] + fmax_denit_nitrate_vr => soilbiogeochem_nitrogenflux_inst%fmax_denit_nitrate_vr_col , & ! Output: [real(r8) (:,:) ] + f_denit_base_vr => soilbiogeochem_nitrogenflux_inst%f_denit_base_vr_col , & ! Output: [real(r8) (:,:) ] + diffus => soilbiogeochem_nitrogenflux_inst%diffus_col , & ! Output: [real(r8) (:,:) ] diffusivity (unitless fraction of total diffusivity) + ratio_k1 => soilbiogeochem_nitrogenflux_inst%ratio_k1_col , & ! Output: [real(r8) (:,:) ] + ratio_no3_co2 => soilbiogeochem_nitrogenflux_inst%ratio_no3_co2_col , & ! Output: [real(r8) (:,:) ] + soil_co2_prod => soilbiogeochem_nitrogenflux_inst%soil_co2_prod_col , & ! Output: [real(r8) (:,:) ] (ug C / g soil / day) + fr_WFPS => soilbiogeochem_nitrogenflux_inst%fr_WFPS_col , & ! Output: [real(r8) (:,:) ] + soil_bulkdensity => soilbiogeochem_nitrogenflux_inst%soil_bulkdensity_col , & ! Output: [real(r8) (:,:) ] (kg soil / m3) bulk density of soil (including water) + pot_f_nit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_nit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil nitrification flux + pot_f_denit_vr => soilbiogeochem_nitrogenflux_inst%pot_f_denit_vr_col , & ! Output: [real(r8) (:,:) ] (gN/m3/s) potential soil denitrification flux + n2_n2o_ratio_denit_vr => soilbiogeochem_nitrogenflux_inst%n2_n2o_ratio_denit_vr_col & ! Output: [real(r8) (:,:) ] ratio of N2 to N2O production by denitrification [gN/gN] + ) + + ! Set maximum nitrification rate constant + k_nitr_max = 0.1_r8 / secspday ! [1/sec] 10%/day Parton et al., 2001 + + ! Todo: FIX(SPM,032414) - the explicit divide gives different results than when that + ! value is placed in the parameters netcdf file. To get bfb, keep the + ! divide in source. + !k_nitr_max = params_inst%k_nitr_max + + surface_tension_water = params_inst%surface_tension_water + + ! Set parameters from simple-structure model to calculate anoxic fratction (Arah and Vinten 1995) + rij_kro_a = params_inst%rij_kro_a + rij_kro_alpha = params_inst%rij_kro_alpha + rij_kro_beta = params_inst%rij_kro_beta + rij_kro_gamma = params_inst%rij_kro_gamma + rij_kro_delta = params_inst%rij_kro_delta + + organic_max = CNParamsShareInst%organic_max + + pH(bounds%begc:bounds%endc) = 6.5 !!! set all soils with the same pH as placeholder here + co2diff_con(1) = 0.1325_r8 + co2diff_con(2) = 0.0009_r8 + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + !---------------- calculate soil anoxia state + ! calculate gas diffusivity of soil at field capacity here + ! use expression from methane code, but neglect OM for now + f_a = 1._r8 - watfc(c,j) / watsat(c,j) + eps = watsat(c,j)-watfc(c,j) ! Air-filled fraction of total soil volume + + ! use diffusivity calculation including peat + if (use_lch4) then + + if (organic_max > 0._r8) then + om_frac = min(cellorg(c,j)/organic_max, 1._r8) + ! Use first power, not square as in iniTimeConst + else + om_frac = 1._r8 + end if + diffus (c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j)) * 1.e-4_r8 * & + (om_frac * f_a**(10._r8/3._r8) / watsat(c,j)**2 + & + (1._r8-om_frac) * eps**2 * f_a**(3._r8 / bsw(c,j)) ) + + ! calculate anoxic fraction of soils + ! use rijtema and kroess model after Riley et al., 2000 + ! caclulated r_psi as a function of psi + r_min(c,j) = 2 * surface_tension_water / (rho_w * grav * abs(soilpsi(c,j))) + r_max = 2 * surface_tension_water / (rho_w * grav * 0.1_r8) + r_psi(c,j) = sqrt(r_min(c,j) * r_max) + ratio_diffusivity_water_gas(c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j) ) * 1.e-4_r8 / & + ((d_con_w(2,1) + d_con_w(2,2)*t_soisno(c,j) + d_con_w(2,3)*t_soisno(c,j)**2) * 1.e-9_r8) + + if (o2_decomp_depth_unsat(c,j) /= spval .and. conc_o2_unsat(c,j) /= spval .and. & + o2_decomp_depth_unsat(c,j) > 0._r8) then + anaerobic_frac(c,j) = exp(-rij_kro_a * r_psi(c,j)**(-rij_kro_alpha) * & + o2_decomp_depth_unsat(c,j)**(-rij_kro_beta) * & + conc_o2_unsat(c,j)**rij_kro_gamma * (h2osoi_vol(c,j) + ratio_diffusivity_water_gas(c,j) * & + watsat(c,j))**rij_kro_delta) + else + anaerobic_frac(c,j) = 0._r8 + endif + + if (anoxia_wtsat) then ! Average saturated fraction values into anaerobic_frac(c,j). + r_min_sat = 2._r8 * surface_tension_water / (rho_w * grav * abs(grav * 1.e-6_r8 * sucsat(c,j))) + r_psi_sat = sqrt(r_min_sat * r_max) + if (o2_decomp_depth_sat(c,j) /= spval .and. conc_o2_sat(c,j) /= spval .and. & + o2_decomp_depth_sat(c,j) > 0._r8) then + anaerobic_frac_sat = exp(-rij_kro_a * r_psi_sat**(-rij_kro_alpha) * & + o2_decomp_depth_sat(c,j)**(-rij_kro_beta) * & + conc_o2_sat(c,j)**rij_kro_gamma * (watsat(c,j) + ratio_diffusivity_water_gas(c,j) * & + watsat(c,j))**rij_kro_delta) + else + anaerobic_frac_sat = 0._r8 + endif + anaerobic_frac(c,j) = (1._r8 - finundated(c))*anaerobic_frac(c,j) + finundated(c)*anaerobic_frac_sat + end if + + else + ! NITRIF_DENITRIF requires Methane model to be active, + ! otherwise diffusivity will be zeroed out here. EBK CDK 10/18/2011 + anaerobic_frac(c,j) = 0._r8 + diffus (c,j) = 0._r8 + !call endrun(msg=' ERROR: NITRIF_DENITRIF requires Methane model to be active'//errMsg(__FILE__, __LINE__) ) + end if + + + !---------------- nitrification + ! follows CENTURY nitrification scheme (Parton et al., (2001, 1996)) + + ! assume nitrification temp function equal to the HR scalar + k_nitr_t_vr(c,j) = min(t_scalar(c,j), 1._r8) + + ! ph function from Parton et al., (2001, 1996) + k_nitr_ph_vr(c,j) = 0.56 + atan(rpi * 0.45 * (-5.+ pH(c)))/rpi + + ! moisture function-- assume the same moisture function as limits heterotrophic respiration + ! Parton et al. base their nitrification- soil moisture rate constants based on heterotrophic rates-- can we do the same? + k_nitr_h2o_vr(c,j) = w_scalar(c,j) + + ! nitrification constant is a set scalar * temp, moisture, and ph scalars + k_nitr_vr(c,j) = k_nitr_max * k_nitr_t_vr(c,j) * k_nitr_h2o_vr(c,j) * k_nitr_ph_vr(c,j) + + ! first-order decay of ammonium pool with scalar defined above + pot_f_nit_vr(c,j) = max(smin_nh4_vr(c,j) * k_nitr_vr(c,j), 0._r8) + + ! limit to oxic fraction of soils + pot_f_nit_vr(c,j) = pot_f_nit_vr(c,j) * (1._r8 - anaerobic_frac(c,j)) + + ! limit to non-frozen soil layers + if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif) then + pot_f_nit_vr(c,j) = 0._r8 + endif + + + !---------------- denitrification + ! first some input variables an unit conversions + soil_hr_vr(c,j) = phr_vr(c,j) + + ! CENTURY papers give denitrification in units of per gram soil; need to convert from volumetric to mass-based units here + soil_bulkdensity(c,j) = bd(c,j) + h2osoi_liq(c,j)/col%dz(c,j) + + g_per_m3__to__ug_per_gsoil = 1.e3_r8 / soil_bulkdensity(c,j) + + g_per_m3_sec__to__ug_per_gsoil_day = g_per_m3__to__ug_per_gsoil * secspday + + smin_no3_massdens_vr(c,j) = max(smin_no3_vr(c,j), 0._r8) * g_per_m3__to__ug_per_gsoil + + soil_co2_prod(c,j) = (soil_hr_vr(c,j) * (g_per_m3_sec__to__ug_per_gsoil_day)) + + !! maximum potential denitrification rates based on heterotrophic respiration rates or nitrate concentrations, + !! from (del Grosso et al., 2000) + fmax_denit_carbonsubstrate_vr(c,j) = (0.1_r8 * (soil_co2_prod(c,j)**1.3_r8)) & + / g_per_m3_sec__to__ug_per_gsoil_day + ! + fmax_denit_nitrate_vr(c,j) = (1.15_r8 * smin_no3_massdens_vr(c,j)**0.57_r8) & + / g_per_m3_sec__to__ug_per_gsoil_day + + ! find limiting denitrification rate + f_denit_base_vr(c,j) = max(min(fmax_denit_carbonsubstrate_vr(c,j), fmax_denit_nitrate_vr(c,j)),0._r8) + + ! limit to non-frozen soil layers + if ( t_soisno(c,j) <= SHR_CONST_TKFRZ .and. no_frozen_nitrif_denitrif ) then + f_denit_base_vr(c,j) = 0._r8 + endif + + ! limit to anoxic fraction of soils + pot_f_denit_vr(c,j) = f_denit_base_vr(c,j) * anaerobic_frac(c,j) + + ! now calculate the ratio of N2O to N2 from denitrifictaion, following Del Grosso et al., 2000 + ! diffusivity constant (figure 6b) + ratio_k1(c,j) = max(1.7_r8, 38.4_r8 - 350._r8 * diffus(c,j)) + + ! ratio function (figure 7c) + if ( soil_co2_prod(c,j) > 0 ) then + ratio_no3_co2(c,j) = smin_no3_massdens_vr(c,j) / soil_co2_prod(c,j) + else + ! fucntion saturates at large no3/co2 ratios, so set as some nominally large number + ratio_no3_co2(c,j) = 100._r8 + endif + + ! total water limitation function (Del Grosso et al., 2000, figure 7a) + wfps_vr(c,j) = max(min(h2osoi_vol(c,j)/watsat(c, j), 1._r8), 0._r8) * 100._r8 + fr_WFPS(c,j) = max(0.1_r8, 0.015_r8 * wfps_vr(c,j) - 0.32_r8) + if (use_lch4) then + if (anoxia_wtsat) then + fr_WFPS(c,j) = fr_WFPS(c,j)*(1._r8 - finundated(c)) + finundated(c)*1.18_r8 + end if + end if + + ! final ratio expression + n2_n2o_ratio_denit_vr(c,j) = max(0.16*ratio_k1(c,j), ratio_k1(c,j)*exp(-0.8 * ratio_no3_co2(c,j))) * fr_WFPS(c,j) + + end do + + end do + + end associate + + end subroutine SoilBiogeochemNitrifDenitrif + +end module SoilBiogeochemNitrifDenitrifMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 new file mode 100644 index 0000000000..02a14c036d --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -0,0 +1,1255 @@ +module SoilBiogeochemNitrogenFluxType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : nlevdecomp_full, nlevdecomp, crop_prog + use clm_varcon , only : spval, ispval, dzsoi_decomp + use decompMod , only : bounds_type + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use abortutils , only : endrun + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + ! + type, public :: SoilBiogeochem_nitrogenflux_type + + ! deposition fluxes + real(r8), pointer :: ndep_to_sminn_col (:) ! col atmospheric N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: nfix_to_sminn_col (:) ! col symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) + real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) + + ! decomposition fluxes + real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + real(r8), pointer :: decomp_cascade_ntransfer_col (:,:) ! col vert-int (diagnostic) transfer of N from donor to receiver pool along decomp. cascade (gN/m2/s) + real(r8), pointer :: decomp_cascade_sminn_flux_vr_col (:,:,:) ! col vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + real(r8), pointer :: decomp_cascade_sminn_flux_col (:,:) ! col vert-int (diagnostic) mineral N flux for transition along decomposition cascade (gN/m2/s) + + ! Used to update concentrations concurrently with vertical transport + ! vertically-resolved immobilization fluxes + real(r8), pointer :: potential_immob_vr_col (:,:) ! col vertically-resolved potential N immobilization (gN/m3/s) at each level + real(r8), pointer :: potential_immob_col (:) ! col vert-int (diagnostic) potential N immobilization (gN/m2/s) + real(r8), pointer :: actual_immob_vr_col (:,:) ! col vertically-resolved actual N immobilization (gN/m3/s) at each level + real(r8), pointer :: actual_immob_col (:) ! col vert-int (diagnostic) actual N immobilization (gN/m2/s) + real(r8), pointer :: sminn_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil mineral N (gN/m3/s) + real(r8), pointer :: sminn_to_plant_col (:) ! col vert-int (diagnostic) plant uptake of soil mineral N (gN/m2/s) + real(r8), pointer :: supplement_to_sminn_vr_col (:,:) ! col vertically-resolved supplemental N supply (gN/m3/s) + real(r8), pointer :: supplement_to_sminn_col (:) ! col vert-int (diagnostic) supplemental N supply (gN/m2/s) + real(r8), pointer :: gross_nmin_vr_col (:,:) ! col vertically-resolved gross rate of N mineralization (gN/m3/s) + real(r8), pointer :: gross_nmin_col (:) ! col vert-int (diagnostic) gross rate of N mineralization (gN/m2/s) + real(r8), pointer :: net_nmin_vr_col (:,:) ! col vertically-resolved net rate of N mineralization (gN/m3/s) + real(r8), pointer :: net_nmin_col (:) ! col vert-int (diagnostic) net rate of N mineralization (gN/m2/s) + + ! ---------- NITRIF_DENITRIF --------------------- + + ! nitrification / denitrification fluxes + real(r8), pointer :: f_nit_vr_col (:,:) ! col (gN/m3/s) soil nitrification flux + real(r8), pointer :: f_denit_vr_col (:,:) ! col (gN/m3/s) soil denitrification flux + real(r8), pointer :: f_nit_col (:) ! col (gN/m2/s) soil nitrification flux + real(r8), pointer :: f_denit_col (:) ! col (gN/m2/s) soil denitrification flux + + real(r8), pointer :: pot_f_nit_vr_col (:,:) ! col (gN/m3/s) potential soil nitrification flux + real(r8), pointer :: pot_f_denit_vr_col (:,:) ! col (gN/m3/s) potential soil denitrification flux + real(r8), pointer :: pot_f_nit_col (:) ! col (gN/m2/s) potential soil nitrification flux + real(r8), pointer :: pot_f_denit_col (:) ! col (gN/m2/s) potential soil denitrification flux + real(r8), pointer :: n2_n2o_ratio_denit_vr_col (:,:) ! col ratio of N2 to N2O production by denitrification [gN/gN] + real(r8), pointer :: f_n2o_denit_vr_col (:,:) ! col flux of N2o from denitrification [gN/m^3/s] + real(r8), pointer :: f_n2o_denit_col (:) ! col flux of N2o from denitrification [gN/m^2/s] + real(r8), pointer :: f_n2o_nit_vr_col (:,:) ! col flux of N2o from nitrification [gN/m^3/s] + real(r8), pointer :: f_n2o_nit_col (:) ! col flux of N2o from nitrification [gN/m^2/s] + + ! immobilization / uptake fluxes + real(r8), pointer :: actual_immob_no3_vr_col (:,:) ! col vertically-resolved actual immobilization of NO3 (gN/m3/s) + real(r8), pointer :: actual_immob_nh4_vr_col (:,:) ! col vertically-resolved actual immobilization of NH4 (gN/m3/s) + real(r8), pointer :: smin_no3_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NO3 (gN/m3/s) + real(r8), pointer :: smin_nh4_to_plant_vr_col (:,:) ! col vertically-resolved plant uptake of soil NH4 (gN/m3/s) + real(r8), pointer :: actual_immob_no3_col (:) ! col actual immobilization of NO3 (gN/m2/s) + real(r8), pointer :: actual_immob_nh4_col (:) ! col actual immobilization of NH4 (gN/m2/s) + real(r8), pointer :: smin_no3_to_plant_col (:) ! col plant uptake of soil NO3 (gN/m2/s) + real(r8), pointer :: smin_nh4_to_plant_col (:) ! col plant uptake of soil Nh4 (gN/m2/s) + + ! leaching fluxes + real(r8), pointer :: smin_no3_leached_vr_col (:,:) ! col vertically-resolved soil mineral NO3 loss to leaching (gN/m3/s) + real(r8), pointer :: smin_no3_leached_col (:) ! col soil mineral NO3 pool loss to leaching (gN/m2/s) + real(r8), pointer :: smin_no3_runoff_vr_col (:,:) ! col vertically-resolved rate of mineral NO3 loss with runoff (gN/m3/s) + real(r8), pointer :: smin_no3_runoff_col (:) ! col soil mineral NO3 pool loss to runoff (gN/m2/s) + + ! nitrification /denitrification diagnostic quantities + real(r8), pointer :: smin_no3_massdens_vr_col (:,:) ! col (ugN / g soil) soil nitrate concentration + real(r8), pointer :: soil_bulkdensity_col (:,:) ! col (kg soil / m3) bulk density of soil + real(r8), pointer :: k_nitr_t_vr_col (:,:) + real(r8), pointer :: k_nitr_ph_vr_col (:,:) + real(r8), pointer :: k_nitr_h2o_vr_col (:,:) + real(r8), pointer :: k_nitr_vr_col (:,:) + real(r8), pointer :: wfps_vr_col (:,:) + real(r8), pointer :: fmax_denit_carbonsubstrate_vr_col (:,:) + real(r8), pointer :: fmax_denit_nitrate_vr_col (:,:) + real(r8), pointer :: f_denit_base_vr_col (:,:) ! col nitrification and denitrification fluxes + real(r8), pointer :: diffus_col (:,:) ! col diffusivity (m2/s) + real(r8), pointer :: ratio_k1_col (:,:) + real(r8), pointer :: ratio_no3_co2_col (:,:) + real(r8), pointer :: soil_co2_prod_col (:,:) + real(r8), pointer :: fr_WFPS_col (:,:) + + real(r8), pointer :: r_psi_col (:,:) + real(r8), pointer :: anaerobic_frac_col (:,:) + + !----------- no NITRIF_DENITRIF-------------- + + ! denitrification fluxes + real(r8), pointer :: sminn_to_denit_decomp_cascade_vr_col (:,:,:) ! col vertically-resolved denitrification along decomp cascade (gN/m3/s) + real(r8), pointer :: sminn_to_denit_decomp_cascade_col (:,:) ! col vertically-integrated (diagnostic) denitrification along decomp cascade (gN/m2/s) + real(r8), pointer :: sminn_to_denit_excess_vr_col (:,:) ! col vertically-resolved denitrification from excess mineral N pool (gN/m3/s) + real(r8), pointer :: sminn_to_denit_excess_col (:) ! col vertically-integrated (diagnostic) denitrification from excess mineral N pool (gN/m2/s) + + ! leaching fluxes + real(r8), pointer :: sminn_leached_vr_col (:,:) ! col vertically-resolved soil mineral N pool loss to leaching (gN/m3/s) + real(r8), pointer :: sminn_leached_col (:) ! col soil mineral N pool loss to leaching (gN/m2/s) + + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: denit_col (:) ! col total rate of denitrification (gN/m2/s) + real(r8), pointer :: ninputs_col (:) ! col column-level N inputs (gN/m2/s) + real(r8), pointer :: noutputs_col (:) ! col column-level N outputs (gN/m2/s) + real(r8), pointer :: som_n_leached_col (:) ! col total SOM N loss from vertical transport (gN/m^2/s) + real(r8), pointer :: decomp_npools_leached_col (:,:) ! col N loss from vertical transport from each decomposing N pool (gN/m^2/s) + real(r8), pointer :: decomp_npools_transport_tendency_col (:,:,:) ! col N tendency due to vertical transport in decomposing N pools (gN/m^3/s) + + ! all n pools involved in decomposition + real(r8), pointer :: decomp_npools_sourcesink_col (:,:,:) ! col (gN/m3) change in decomposing n pools + ! (sum of all additions and subtractions from stateupdate1). + + contains + + procedure , public :: Init + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: Summary + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type SoilBiogeochem_nitrogenflux_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate (bounds) + call this%InitHistory (bounds) + call this%InitCold (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize nitrogen flux + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + !------------------------------------------------------------------------ + + begc = bounds%begc; endc = bounds%endc + + allocate(this%ndep_to_sminn_col (begc:endc)) ; this%ndep_to_sminn_col (:) = nan + allocate(this%nfix_to_sminn_col (begc:endc)) ; this%nfix_to_sminn_col (:) = nan + allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan + allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan + allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan + allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan + allocate(this%actual_immob_col (begc:endc)) ; this%actual_immob_col (:) = nan + allocate(this%gross_nmin_col (begc:endc)) ; this%gross_nmin_col (:) = nan + allocate(this%net_nmin_col (begc:endc)) ; this%net_nmin_col (:) = nan + allocate(this%denit_col (begc:endc)) ; this%denit_col (:) = nan + allocate(this%supplement_to_sminn_col (begc:endc)) ; this%supplement_to_sminn_col (:) = nan + allocate(this%ninputs_col (begc:endc)) ; this%ninputs_col (:) = nan + allocate(this%noutputs_col (begc:endc)) ; this%noutputs_col (:) = nan + allocate(this%som_n_leached_col (begc:endc)) ; this%som_n_leached_col (:) = nan + + allocate(this%r_psi_col (begc:endc,1:nlevdecomp_full)) ; this%r_psi_col (:,:) = spval + allocate(this%anaerobic_frac_col (begc:endc,1:nlevdecomp_full)) ; this%anaerobic_frac_col (:,:) = spval + allocate(this%potential_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%potential_immob_vr_col (:,:) = nan + allocate(this%actual_immob_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_vr_col (:,:) = nan + allocate(this%sminn_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_to_plant_vr_col (:,:) = nan + allocate(this%supplement_to_sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%supplement_to_sminn_vr_col (:,:) = nan + allocate(this%gross_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%gross_nmin_vr_col (:,:) = nan + allocate(this%net_nmin_vr_col (begc:endc,1:nlevdecomp_full)) ; this%net_nmin_vr_col (:,:) = nan + + allocate(this%f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nit_vr_col (:,:) = nan + allocate(this%f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_vr_col (:,:) = nan + allocate(this%smin_no3_leached_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_leached_vr_col (:,:) = nan + allocate(this%smin_no3_leached_col (begc:endc)) ; this%smin_no3_leached_col (:) = nan + allocate(this%smin_no3_runoff_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_runoff_vr_col (:,:) = nan + allocate(this%smin_no3_runoff_col (begc:endc)) ; this%smin_no3_runoff_col (:) = nan + allocate(this%pot_f_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_nit_vr_col (:,:) = nan + allocate(this%pot_f_nit_col (begc:endc)) ; this%pot_f_nit_col (:) = nan + allocate(this%pot_f_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%pot_f_denit_vr_col (:,:) = nan + allocate(this%pot_f_denit_col (begc:endc)) ; this%pot_f_denit_col (:) = nan + allocate(this%actual_immob_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_no3_vr_col (:,:) = nan + allocate(this%actual_immob_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_nh4_vr_col (:,:) = nan + allocate(this%smin_no3_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_to_plant_vr_col (:,:) = nan + allocate(this%smin_nh4_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_to_plant_vr_col (:,:) = nan + allocate(this%f_nit_col (begc:endc)) ; this%f_nit_col (:) = nan + allocate(this%f_denit_col (begc:endc)) ; this%f_denit_col (:) = nan + allocate(this%n2_n2o_ratio_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%n2_n2o_ratio_denit_vr_col (:,:) = nan + allocate(this%f_n2o_denit_col (begc:endc)) ; this%f_n2o_denit_col (:) = nan + allocate(this%f_n2o_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_denit_vr_col (:,:) = nan + allocate(this%f_n2o_nit_col (begc:endc)) ; this%f_n2o_nit_col (:) = nan + allocate(this%f_n2o_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_nit_vr_col (:,:) = nan + + allocate(this%smin_no3_massdens_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_massdens_vr_col (:,:) = nan + allocate(this%soil_bulkdensity_col (begc:endc,1:nlevdecomp_full)) ; this%soil_bulkdensity_col (:,:) = nan + allocate(this%k_nitr_t_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_t_vr_col (:,:) = nan + allocate(this%k_nitr_ph_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_ph_vr_col (:,:) = nan + allocate(this%k_nitr_h2o_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_h2o_vr_col (:,:) = nan + allocate(this%k_nitr_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_vr_col (:,:) = nan + allocate(this%wfps_vr_col (begc:endc,1:nlevdecomp_full)) ; this%wfps_vr_col (:,:) = nan + allocate(this%f_denit_base_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_denit_base_vr_col (:,:) = nan + allocate(this%diffus_col (begc:endc,1:nlevdecomp_full)) ; this%diffus_col (:,:) = spval + allocate(this%ratio_k1_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_k1_col (:,:) = nan + allocate(this%ratio_no3_co2_col (begc:endc,1:nlevdecomp_full)) ; this%ratio_no3_co2_col (:,:) = spval + allocate(this%soil_co2_prod_col (begc:endc,1:nlevdecomp_full)) ; this%soil_co2_prod_col (:,:) = nan + allocate(this%fr_WFPS_col (begc:endc,1:nlevdecomp_full)) ; this%fr_WFPS_col (:,:) = spval + + allocate(this%fmax_denit_carbonsubstrate_vr_col (begc:endc,1:nlevdecomp_full)) ; + this%fmax_denit_carbonsubstrate_vr_col (:,:) = nan + allocate(this%fmax_denit_nitrate_vr_col (begc:endc,1:nlevdecomp_full)) ; + this%fmax_denit_nitrate_vr_col (:,:) = nan + + allocate(this%decomp_cascade_ntransfer_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_sminn_flux_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_ntransfer_col (begc:endc,1:ndecomp_cascade_transitions )) + allocate(this%decomp_cascade_sminn_flux_col (begc:endc,1:ndecomp_cascade_transitions )) + + this%decomp_cascade_ntransfer_vr_col (:,:,:) = nan + this%decomp_cascade_sminn_flux_vr_col (:,:,:) = nan + this%decomp_cascade_ntransfer_col (:,:) = nan + this%decomp_cascade_sminn_flux_col (:,:) = nan + + allocate(this%sminn_to_denit_decomp_cascade_vr_col (begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions )) + allocate(this%sminn_to_denit_decomp_cascade_col (begc:endc,1:ndecomp_cascade_transitions )) + allocate(this%sminn_to_denit_excess_vr_col (begc:endc,1:nlevdecomp_full )) + allocate(this%sminn_to_denit_excess_col (begc:endc )) + allocate(this%sminn_leached_vr_col (begc:endc,1:nlevdecomp_full )) + allocate(this%sminn_leached_col (begc:endc )) + allocate(this%decomp_npools_leached_col (begc:endc,1:ndecomp_pools )) + allocate(this%decomp_npools_transport_tendency_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools )) + + this%sminn_to_denit_decomp_cascade_vr_col (:,:,:) = nan + this%sminn_to_denit_decomp_cascade_col (:,:) = nan + this%sminn_to_denit_excess_vr_col (:,:) = nan + this%sminn_to_denit_excess_col (:) = nan + this%sminn_leached_vr_col (:,:) = nan + this%sminn_leached_col (:) = nan + this%decomp_npools_leached_col (:,:) = nan + this%decomp_npools_transport_tendency_col (:,:,:) = nan + + allocate(this%decomp_npools_sourcesink_col (begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) + this%decomp_npools_sourcesink_col (:,:,:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use histFileMod , only : hist_addfld1d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l + integer :: begc, endc + character(24) :: fieldname + character(100) :: longname + character(8) :: vr_suffix + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begc = bounds%begc; endc= bounds%endc + + ! add suffix if number of soil decomposition depths is greater than 1 + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + !------------------------------- + ! N flux variables - native to column + !------------------------------- + + this%ndep_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NDEP_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='atmospheric N deposition to soil mineral N', & + ptr_col=this%ndep_to_sminn_col) + + this%nfix_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NFIX_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='symbiotic/asymbiotic N fixation to soil mineral N', & + ptr_col=this%nfix_to_sminn_col) + + do l = 1, ndecomp_cascade_transitions + ! vertically integrated fluxes + !-- mineralization/immobilization fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + this%decomp_cascade_sminn_flux_col(begc:endc,l) = spval + data1dptr => this%decomp_cascade_sminn_flux_col(:,l) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + fieldname = 'SMINN_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l))) + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//& + 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) + else + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'N_TO_SMINN' + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) + endif + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + end if + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + this%decomp_cascade_ntransfer_col(begc:endc,l) = spval + data1dptr => this%decomp_cascade_ntransfer_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N' + longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + end if + + ! vertically resolved fluxes + if ( nlevdecomp_full > 1 ) then + !-- mineralization/immobilization fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + this%decomp_cascade_sminn_flux_vr_col(begc:endc,:,l) = spval + data2dptr => this%decomp_cascade_sminn_flux_vr_col(:,:,l) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + fieldname = 'SMINN_TO_'& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l)))//trim(vr_suffix) + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//& + 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) + else + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'N_TO_SMINN'//trim(vr_suffix) + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) + endif + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + this%decomp_cascade_ntransfer_vr_col(begc:endc,:,l) = spval + data2dptr => this%decomp_cascade_ntransfer_vr_col(:,:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& + //'N'//trim(vr_suffix) + longname = 'decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + + endif + end do + + this%denit_col(begc:endc) = spval + call hist_addfld1d (fname='DENIT', units='gN/m^2/s', & + avgflag='A', long_name='total rate of denitrification', & + ptr_col=this%denit_col) + + this%som_n_leached_col(begc:endc) = spval + call hist_addfld1d (fname='SOM_N_LEACHED', units='gN/m^2/s', & + avgflag='A', long_name='total flux of N from SOM pools due to leaching', & + ptr_col=this%som_n_leached_col, default='inactive') + + do k = 1, ndecomp_pools + if ( .not. decomp_cascade_con%is_cwd(k) ) then + this%decomp_npools_leached_col(begc:endc,k) = spval + data1dptr => this%decomp_npools_leached_col(:,k) + fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TO_LEACHING' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N leaching loss' + call hist_addfld1d (fname=fieldname, units='gN/m^2/s', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default='inactive') + + this%decomp_npools_transport_tendency_col(begc:endc,:,k) = spval + data2dptr => this%decomp_npools_transport_tendency_col(:,:,k) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(k))//'N_TNDNCY_VERT_TRANSPORT' + longname = trim(decomp_cascade_con%decomp_pool_name_long(k))//' N tendency due to vertical transport' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr) + end if + end do + + if (.not. use_nitrif_denitrif) then + do l = 1, ndecomp_cascade_transitions + !-- denitrification fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + this%sminn_to_denit_decomp_cascade_col(begc:endc,l) = spval + data1dptr => this%sminn_to_denit_decomp_cascade_col(:,l) + fieldname = 'SMINN_TO_DENIT_'//trim(decomp_cascade_con%cascade_step_name(l)) + longname = 'denitrification for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + endif + + if ( nlevdecomp_full > 1 ) then + !-- denitrification fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + this%sminn_to_denit_decomp_cascade_vr_col(begc:endc,:,l) = spval + data2dptr => this%sminn_to_denit_decomp_cascade_vr_col(:,:,l) + fieldname = 'SMINN_TO_DENIT_'//trim(decomp_cascade_con%cascade_step_name(l))//trim(vr_suffix) + longname = 'denitrification for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + endif + end do + end if + + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_excess_col(begc:endc) = spval + call hist_addfld1d (fname='SMINN_TO_DENIT_EXCESS', units='gN/m^2/s', & + avgflag='A', long_name='denitrification from excess mineral N pool', & + ptr_col=this%sminn_to_denit_excess_col, default='inactive') + end if + + if (.not. use_nitrif_denitrif) then + this%sminn_leached_col(begc:endc) = spval + call hist_addfld1d (fname='SMINN_LEACHED', units='gN/m^2/s', & + avgflag='A', long_name='soil mineral N pool loss to leaching', & + ptr_col=this%sminn_leached_col) + end if + + if (.not. use_nitrif_denitrif) then + if ( nlevdecomp_full > 1 ) then + this%sminn_to_denit_excess_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMINN_TO_DENIT_EXCESS'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='denitrification from excess mineral N pool', & + ptr_col=this%sminn_to_denit_excess_vr_col, default='inactive') + + this%sminn_leached_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMINN_LEACHED'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='soil mineral N pool loss to leaching', & + ptr_col=this%sminn_leached_vr_col, default='inactive') + endif + end if + + if (use_nitrif_denitrif) then + this%f_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_NIT', units='gN/m^2/s', & + avgflag='A', long_name='nitrification flux', & + ptr_col=this%f_nit_col) + end if + + if (use_nitrif_denitrif) then + this%f_denit_col(begc:endc) = spval + call hist_addfld1d (fname='F_DENIT', units='gN/m^2/s', & + avgflag='A', long_name='denitrification flux', & + ptr_col=this%f_denit_col) + end if + + if (use_nitrif_denitrif) then + this%pot_f_nit_col(begc:endc) = spval + call hist_addfld1d (fname='POT_F_NIT', units='gN/m^2/s', & + avgflag='A', long_name='potential nitrification flux', & + ptr_col=this%pot_f_nit_col) + end if + + if (use_nitrif_denitrif) then + this%pot_f_denit_col(begc:endc) = spval + call hist_addfld1d (fname='POT_F_DENIT', units='gN/m^2/s', & + avgflag='A', long_name='potential denitrification flux', & + ptr_col=this%pot_f_denit_col) + end if + + if (use_nitrif_denitrif) then + this%smin_no3_leached_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NO3_LEACHED', units='gN/m^2/s', & + avgflag='A', long_name='soil NO3 pool loss to leaching', & + ptr_col=this%smin_no3_leached_col) + end if + + if (use_nitrif_denitrif) then + this%smin_no3_runoff_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NO3_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='soil NO3 pool loss to runoff', & + ptr_col=this%smin_no3_runoff_col) + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%f_nit_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='F_NIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='nitrification flux', & + ptr_col=this%f_nit_vr_col) + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%f_denit_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='F_DENIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='denitrification flux', & + ptr_col=this%f_denit_vr_col) + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%pot_f_nit_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='POT_F_NIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='potential nitrification flux', & + ptr_col=this%pot_f_nit_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%pot_f_denit_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='POT_F_DENIT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='potential denitrification flux', & + ptr_col=this%pot_f_denit_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%smin_no3_leached_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NO3_LEACHED'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='soil NO3 pool loss to leaching', & + ptr_col=this%smin_no3_leached_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%smin_no3_runoff_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NO3_RUNOFF'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='soil NO3 pool loss to runoff', & + ptr_col=this%smin_no3_runoff_vr_col, default='inactive') + endif + + if (use_nitrif_denitrif) then + this%n2_n2o_ratio_denit_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='n2_n2o_ratio_denit', units='gN/gN', type2d='levdcmp', & + avgflag='A', long_name='n2_n2o_ratio_denit', & + ptr_col=this%n2_n2o_ratio_denit_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%actual_immob_no3_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='ACTUAL_IMMOB_NO3', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='immobilization of NO3', & + ptr_col=this%actual_immob_no3_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%actual_immob_nh4_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='ACTUAL_IMMOB_NH4', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='immobilization of NH4', & + ptr_col=this%actual_immob_nh4_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%smin_no3_to_plant_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NO3_TO_PLANT', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='plant uptake of NO3', & + ptr_col=this%smin_no3_to_plant_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%smin_nh4_to_plant_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NH4_TO_PLANT', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='plant uptake of NH4', & + ptr_col=this%smin_nh4_to_plant_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%smin_no3_massdens_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NO3_MASSDENS', units='ugN/cm^3 soil', type2d='levdcmp', & + avgflag='A', long_name='SMIN_NO3_MASSDENS', & + ptr_col=this%smin_no3_massdens_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%k_nitr_t_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='K_NITR_T', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='K_NITR_T', & + ptr_col=this%k_nitr_t_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%k_nitr_ph_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='K_NITR_PH', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='K_NITR_PH', & + ptr_col=this%k_nitr_ph_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%k_nitr_h2o_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='K_NITR_H2O', units='unitless', type2d='levdcmp', & + avgflag='A', long_name='K_NITR_H2O', & + ptr_col=this%k_nitr_h2o_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%k_nitr_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='K_NITR', units='1/s', type2d='levdcmp', & + avgflag='A', long_name='K_NITR', & + ptr_col=this%k_nitr_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%wfps_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='WFPS', units='percent', type2d='levdcmp', & + avgflag='A', long_name='WFPS', & + ptr_col=this%wfps_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%fmax_denit_carbonsubstrate_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='FMAX_DENIT_CARBONSUBSTRATE', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='FMAX_DENIT_CARBONSUBSTRATE', & + ptr_col=this%fmax_denit_carbonsubstrate_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%fmax_denit_nitrate_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='FMAX_DENIT_NITRATE', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='FMAX_DENIT_NITRATE', & + ptr_col=this%fmax_denit_nitrate_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%f_denit_base_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='F_DENIT_BASE', units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='F_DENIT_BASE', & + ptr_col=this%f_denit_base_vr_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%diffus_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='diffus', units='m^2/s', type2d='levdcmp', & + avgflag='A', long_name='diffusivity', & + ptr_col=this%diffus_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%ratio_k1_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='ratio_k1', units='none', type2d='levdcmp', & + avgflag='A', long_name='ratio_k1', & + ptr_col=this%ratio_k1_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%ratio_no3_co2_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='ratio_no3_co2', units='ratio', type2d='levdcmp', & + avgflag='A', long_name='ratio_no3_co2', & + ptr_col=this%ratio_no3_co2_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%soil_co2_prod_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='soil_co2_prod', units='ug C / g soil / day', type2d='levdcmp', & + avgflag='A', long_name='soil_co2_prod', & + ptr_col=this%soil_co2_prod_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%fr_WFPS_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='fr_WFPS', units='fraction', type2d='levdcmp', & + avgflag='A', long_name='fr_WFPS', & + ptr_col=this%fr_WFPS_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%soil_bulkdensity_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='soil_bulkdensity', units='kg/m3', type2d='levdcmp', & + avgflag='A', long_name='soil_bulkdensity', & + ptr_col=this%soil_bulkdensity_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%anaerobic_frac_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='anaerobic_frac', units='m3/m3', type2d='levdcmp', & + avgflag='A', long_name='anaerobic_frac', & + ptr_col=this%anaerobic_frac_col, default='inactive') + end if + + if (use_nitrif_denitrif) then + this%r_psi_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='r_psi', units='m', type2d='levdcmp', & + avgflag='A', long_name='r_psi', & + ptr_col=this%r_psi_col, default='inactive') + end if + + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%potential_immob_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='POTENTIAL_IMMOB'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='potential N immobilization', & + ptr_col=this%potential_immob_vr_col, default='inactive') + end if + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%actual_immob_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='ACTUAL_IMMOB'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='actual N immobilization', & + ptr_col=this%actual_immob_vr_col, default='inactive') + end if + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%sminn_to_plant_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMINN_TO_PLANT'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='plant uptake of soil mineral N', & + ptr_col=this%sminn_to_plant_vr_col, default='inactive') + end if + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%supplement_to_sminn_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SUPPLEMENT_TO_SMINN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='supplemental N supply', & + ptr_col=this%supplement_to_sminn_vr_col, default='inactive') + end if + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%gross_nmin_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='GROSS_NMIN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='gross rate of N mineralization', & + ptr_col=this%gross_nmin_vr_col, default='inactive') + end if + + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then + this%net_nmin_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='NET_NMIN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name='net rate of N mineralization', & + ptr_col=this%net_nmin_vr_col, default='inactive') + end if + + this%potential_immob_col(begc:endc) = spval + call hist_addfld1d (fname='POTENTIAL_IMMOB', units='gN/m^2/s', & + avgflag='A', long_name='potential N immobilization', & + ptr_col=this%potential_immob_col) + + this%actual_immob_col(begc:endc) = spval + call hist_addfld1d (fname='ACTUAL_IMMOB', units='gN/m^2/s', & + avgflag='A', long_name='actual N immobilization', & + ptr_col=this%actual_immob_col) + + this%sminn_to_plant_col(begc:endc) = spval + call hist_addfld1d (fname='SMINN_TO_PLANT', units='gN/m^2/s', & + avgflag='A', long_name='plant uptake of soil mineral N', & + ptr_col=this%sminn_to_plant_col) + + this%supplement_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='SUPPLEMENT_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='supplemental N supply', & + ptr_col=this%supplement_to_sminn_col) + + this%gross_nmin_col(begc:endc) = spval + call hist_addfld1d (fname='GROSS_NMIN', units='gN/m^2/s', & + avgflag='A', long_name='gross rate of N mineralization', & + ptr_col=this%gross_nmin_col) + + this%net_nmin_col(begc:endc) = spval + call hist_addfld1d (fname='NET_NMIN', units='gN/m^2/s', & + avgflag='A', long_name='net rate of N mineralization', & + ptr_col=this%net_nmin_col) + + if (use_nitrif_denitrif) then + this%f_n2o_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2O_NIT', units='gN/m^2/s', & + avgflag='A', long_name='nitrification N2O flux', & + ptr_col=this%f_n2o_nit_col) + + this%f_n2o_denit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2O_DENIT', units='gN/m^2/s', & + avgflag='A', long_name='denitrification N2O flux', & + ptr_col=this%f_n2o_denit_col) + end if + + if (crop_prog) then + this%fert_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='fertilizer to soil mineral N', & + ptr_col=this%fert_to_sminn_col) + end if + + if (crop_prog) then + this%soyfixn_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='SOYFIXN_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='Soybean fixation to soil mineral N', & + ptr_col=this%soyfixn_to_sminn_col) + end if + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + use clm_varpar , only : crop_prog + use landunit_varcon , only : istsoil, istcrop + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c,l + integer :: num_special_col ! number of good values in special_col filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + !--------------------------------------------------------------------- + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + !----------------------------------------------- + ! initialize nitrogen flux variables + !----------------------------------------------- + + call this%SetValues (& + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart (this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use clm_varpar, only : crop_prog + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag !'read' or 'write' + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + if (use_nitrif_denitrif) then + ! pot_f_nit_vr + if (use_vertsoilc) then + ptr2d => this%pot_f_nit_vr_col(:,:) + call restartvar(ncid=ncid, flag=flag, varname='pot_f_nit_vr_vr', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='potential soil nitrification flux', units='gN/m3/s', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%pot_f_nit_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname='pot_f_nit_vr', xtype=ncd_double, & + dim1name='column', & + long_name='soil nitrification flux', units='gN/m3/s', & + interpinic_flag='interp', readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg= 'ERROR:: pot_f_nit_vr'//' is required on an initialization dataset' ) + end if + end if + + if (use_nitrif_denitrif) then + ! f_nit_vr + if (use_vertsoilc) then + ptr2d => this%f_nit_vr_col(:,:) + call restartvar(ncid=ncid, flag=flag, varname='f_nit_vr_vr', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='soil nitrification flux', units='gN/m3/s', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%f_nit_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname='f_nit_vr', xtype=ncd_double, & + dim1name='column', & + long_name='soil nitrification flux', units='gN/m3/s', & + interpinic_flag='interp', readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg='ERROR:: f_nit_vr'//' is required on an initialization dataset'//& + errMsg(__FILE__, __LINE__)) + end if + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen flux variables + ! + ! !ARGUMENTS: + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenflux_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_excess_vr_col(i,j) = value_column + this%sminn_leached_vr_col(i,j) = value_column + else + this%f_nit_vr_col(i,j) = value_column + this%f_denit_vr_col(i,j) = value_column + this%smin_no3_leached_vr_col(i,j) = value_column + this%smin_no3_runoff_vr_col(i,j) = value_column + this%n2_n2o_ratio_denit_vr_col(i,j) = value_column + this%pot_f_nit_vr_col(i,j) = value_column + this%pot_f_denit_vr_col(i,j) = value_column + this%actual_immob_no3_vr_col(i,j) = value_column + this%actual_immob_nh4_vr_col(i,j) = value_column + this%smin_no3_to_plant_vr_col(i,j) = value_column + this%smin_nh4_to_plant_vr_col(i,j) = value_column + this%f_n2o_denit_vr_col(i,j) = value_column + this%f_n2o_nit_vr_col(i,j) = value_column + + this%smin_no3_massdens_vr_col(i,j) = value_column + this%k_nitr_t_vr_col(i,j) = value_column + this%k_nitr_ph_vr_col(i,j) = value_column + this%k_nitr_h2o_vr_col(i,j) = value_column + this%k_nitr_vr_col(i,j) = value_column + this%wfps_vr_col(i,j) = value_column + this%fmax_denit_carbonsubstrate_vr_col(i,j) = value_column + this%fmax_denit_nitrate_vr_col(i,j) = value_column + this%f_denit_base_vr_col(i,j) = value_column + + this%diffus_col(i,j) = value_column + this%ratio_k1_col(i,j) = value_column + this%ratio_no3_co2_col(i,j) = value_column + this%soil_co2_prod_col(i,j) = value_column + this%fr_WFPS_col(i,j) = value_column + this%soil_bulkdensity_col(i,j) = value_column + + this%r_psi_col(i,j) = value_column + this%anaerobic_frac_col(i,j) = value_column + end if + this%potential_immob_vr_col(i,j) = value_column + this%actual_immob_vr_col(i,j) = value_column + this%sminn_to_plant_vr_col(i,j) = value_column + this%supplement_to_sminn_vr_col(i,j) = value_column + this%gross_nmin_vr_col(i,j) = value_column + this%net_nmin_vr_col(i,j) = value_column + end do + end do + + do fi = 1,num_column + i = filter_column(fi) + + this%ndep_to_sminn_col(i) = value_column + this%nfix_to_sminn_col(i) = value_column + this%fert_to_sminn_col(i) = value_column + this%soyfixn_to_sminn_col(i) = value_column + this%potential_immob_col(i) = value_column + this%actual_immob_col(i) = value_column + this%sminn_to_plant_col(i) = value_column + this%supplement_to_sminn_col(i) = value_column + this%gross_nmin_col(i) = value_column + this%net_nmin_col(i) = value_column + this%denit_col(i) = value_column + if (use_nitrif_denitrif) then + this%f_nit_col(i) = value_column + this%pot_f_nit_col(i) = value_column + this%f_denit_col(i) = value_column + this%pot_f_denit_col(i) = value_column + this%f_n2o_denit_col(i) = value_column + this%f_n2o_nit_col(i) = value_column + this%smin_no3_leached_col(i) = value_column + this%smin_no3_runoff_col(i) = value_column + else + this%sminn_to_denit_excess_col(i) = value_column + this%sminn_leached_col(i) = value_column + end if + this%ninputs_col(i) = value_column + this%noutputs_col(i) = value_column + this%som_n_leached_col(i) = value_column + end do + + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_leached_col(i,k) = value_column + end do + end do + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_transport_tendency_col(i,j,k) = value_column + end do + end do + end do + + do l = 1, ndecomp_cascade_transitions + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_ntransfer_col(i,l) = value_column + this%decomp_cascade_sminn_flux_col(i,l) = value_column + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_decomp_cascade_col(i,l) = value_column + end if + end do + end do + + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_ntransfer_vr_col(i,j,l) = value_column + this%decomp_cascade_sminn_flux_vr_col(i,j,l) = value_column + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_decomp_cascade_vr_col(i,j,l) = value_column + end if + end do + end do + end do + + do k = 1, ndecomp_pools + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_sourcesink_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !USES: + use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions,ndecomp_pools + use clm_varctl , only: use_nitrif_denitrif + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! filter indices + !----------------------------------------------------------------------- + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = 0._r8 + this%supplement_to_sminn_col(c) = 0._r8 + this%som_n_leached_col(c) = 0._r8 + end do + + ! vertically integrate decomposing N cascade fluxes and soil mineral N fluxes associated with decomposition cascade + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + this%decomp_cascade_ntransfer_col(c,k) = & + this%decomp_cascade_ntransfer_col(c,k) + & + this%decomp_cascade_ntransfer_vr_col(c,j,k) * dzsoi_decomp(j) + + this%decomp_cascade_sminn_flux_col(c,k) = & + this%decomp_cascade_sminn_flux_col(c,k) + & + this%decomp_cascade_sminn_flux_vr_col(c,j,k) * dzsoi_decomp(j) + end do + end do + end do + + if (.not. use_nitrif_denitrif) then + + ! vertically integrate each denitrification flux + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_to_denit_decomp_cascade_col(c,l) = & + this%sminn_to_denit_decomp_cascade_col(c,l) + & + this%sminn_to_denit_decomp_cascade_vr_col(c,j,l) * dzsoi_decomp(j) + end do + end do + end do + + ! vertically integrate bulk denitrification and leaching flux + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_to_denit_excess_col(c) = & + this%sminn_to_denit_excess_col(c) + & + this%sminn_to_denit_excess_vr_col(c,j) * dzsoi_decomp(j) + + this%sminn_leached_col(c) = & + this%sminn_leached_col(c) + & + this%sminn_leached_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! total N denitrification (DENIT) + do l = 1, ndecomp_cascade_transitions + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_decomp_cascade_col(c,l) + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_excess_col(c) + end do + + else + + ! vertically integrate NO3 NH4 N2O fluxes and pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! nitrification and denitrification fluxes + this%f_nit_col(c) = & + this%f_nit_col(c) + & + this%f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_denit_col(c) = & + this%f_denit_col(c) + & + this%f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_nit_col(c) = & + this%pot_f_nit_col(c) + & + this%pot_f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_denit_col(c) = & + this%pot_f_denit_col(c) + & + this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_nit_col(c) = & + this%f_n2o_nit_col(c) + & + this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_denit_col(c) = & + this%f_n2o_denit_col(c) + & + this%f_n2o_denit_vr_col(c,j) * dzsoi_decomp(j) + + ! leaching/runoff flux + this%smin_no3_leached_col(c) = & + this%smin_no3_leached_col(c) + & + this%smin_no3_leached_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_no3_runoff_col(c) = & + this%smin_no3_runoff_col(c) + & + this%smin_no3_runoff_vr_col(c,j) * dzsoi_decomp(j) + + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = this%f_denit_col(c) + end do + + end if + + ! supplementary N supplement_to_sminn + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%supplement_to_sminn_col(c) = & + this%supplement_to_sminn_col(c) + & + this%supplement_to_sminn_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_leached_col(c,l) = 0._r8 + end do + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_leached_col(c,l) = & + this%decomp_npools_leached_col(c,l) + & + this%decomp_npools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) + end do + end do + + do fc = 1,num_soilc + c = filter_soilc(fc) + this%som_n_leached_col(c) = & + this%som_n_leached_col(c) + & + this%decomp_npools_leached_col(c,l) + end do + end do + + end subroutine Summary + +end module soilbiogeochemNitrogenFluxType + diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 new file mode 100644 index 0000000000..06e309bf54 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -0,0 +1,857 @@ +module SoilBiogeochemNitrogenStateType + +#include "shr_assert.h" + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan + use clm_varpar , only : nlevdecomp_full, nlevdecomp, crop_prog + use clm_varcon , only : spval, dzsoi_decomp, zisoi + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp + use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump, spinup_state + use landunit_varcon , only : istcrop, istsoil + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + + type, public :: soilbiogeochem_nitrogenstate_type + + real(r8), pointer :: decomp_npools_vr_col (:,:,:) ! col (gN/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + real(r8), pointer :: sminn_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral N + real(r8), pointer :: ntrunc_vr_col (:,:) ! col (gN/m3) vertically-resolved column-level sink for N truncation + + ! nitrif_denitrif + real(r8), pointer :: smin_no3_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NO3 + real(r8), pointer :: smin_no3_col (:) ! col (gN/m2) soil mineral NO3 pool + real(r8), pointer :: smin_nh4_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4 + real(r8), pointer :: smin_nh4_col (:) ! col (gN/m2) soil mineral NH4 pool + + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools + real(r8), pointer :: decomp_npools_1m_col (:,:) ! col (gN/m2) diagnostic: decomposing (litter, cwd, soil) N pools to 1 meter + real(r8), pointer :: sminn_col (:) ! col (gN/m2) soil mineral N + real(r8), pointer :: ntrunc_col (:) ! col (gN/m2) column-level sink for N truncation + real(r8), pointer :: cwdn_col (:) ! col (gN/m2) Diagnostic: coarse woody debris N + real(r8), pointer :: totlitn_col (:) ! col (gN/m2) total litter nitrogen + real(r8), pointer :: totsomn_col (:) ! col (gN/m2) total soil organic matter nitrogen + real(r8), pointer :: totlitn_1m_col (:) ! col (gN/m2) total litter nitrogen to 1 meter + real(r8), pointer :: totsomn_1m_col (:) ! col (gN/m2) total soil organic matter nitrogen to 1 meter + + contains + + procedure , public :: Init + procedure , public :: Restart + procedure , public :: SetValues + procedure , public :: Summary + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + + end type soilbiogeochem_nitrogenstate_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, & + decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col) + + class(soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: decomp_cpools_vr_col (bounds%begc:, 1:, 1:) + real(r8) , intent(in) :: decomp_cpools_col (bounds%begc:, 1:) + real(r8) , intent(in) :: decomp_cpools_1m_col (bounds%begc:, 1:) + + call this%InitAllocate (bounds ) + + call this%InitHistory (bounds) + + call this%InitCold ( bounds, & + decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc,endc + !------------------------------------------------------------------------ + + begc = bounds%begc; endc = bounds%endc + + allocate(this%sminn_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_vr_col (:,:) = nan + allocate(this%ntrunc_vr_col (begc:endc,1:nlevdecomp_full)) ; this%ntrunc_vr_col (:,:) = nan + allocate(this%smin_no3_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_vr_col (:,:) = nan + allocate(this%smin_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_vr_col (:,:) = nan + allocate(this%smin_no3_col (begc:endc)) ; this%smin_no3_col (:) = nan + allocate(this%smin_nh4_col (begc:endc)) ; this%smin_nh4_col (:) = nan + allocate(this%cwdn_col (begc:endc)) ; this%cwdn_col (:) = nan + allocate(this%sminn_col (begc:endc)) ; this%sminn_col (:) = nan + allocate(this%ntrunc_col (begc:endc)) ; this%ntrunc_col (:) = nan + allocate(this%totlitn_col (begc:endc)) ; this%totlitn_col (:) = nan + allocate(this%totsomn_col (begc:endc)) ; this%totsomn_col (:) = nan + allocate(this%totlitn_1m_col (begc:endc)) ; this%totlitn_1m_col (:) = nan + allocate(this%totsomn_1m_col (begc:endc)) ; this%totsomn_1m_col (:) = nan + allocate(this%decomp_npools_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_col (:,:) = nan + allocate(this%decomp_npools_1m_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_1m_col (:,:) = nan + + allocate(this%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); + this%decomp_npools_vr_col(:,:,:)= nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! add history fields for all CN variables, always set as default='inactive' + ! + ! !USES: + use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools + use clm_varpar , only : nlevdecomp, nlevdecomp_full,crop_prog, nlevgrnd + use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l,ii,jj + character(10) :: active + character(8) :: vr_suffix + integer :: begc,endc + character(24) :: fieldname + character(100) :: longname + real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays + real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + !--------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + + if ( nlevdecomp_full > 1 ) then + this%decomp_npools_vr_col(begc:endc,:,:) = spval + this%decomp_npools_1m_col(begc:endc,:) = spval + end if + this%decomp_npools_col(begc:endc,:) = spval + do l = 1, ndecomp_pools + if ( nlevdecomp_full > 1 ) then + data2dptr => this%decomp_npools_vr_col(:,:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_vr' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N (vertically resolved)' + call hist_addfld2d (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr) + endif + + data1dptr => this%decomp_npools_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N' + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr) + + if ( nlevdecomp_full > 1 ) then + data1dptr => this%decomp_npools_1m_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'N_1m' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' N to 1 meter' + call hist_addfld1d (fname=fieldname, units='gN/m^2', & + avgflag='A', long_name=longname, & + ptr_col=data1dptr, default = 'inactive') + endif + end do + + + if ( nlevdecomp_full > 1 ) then + + this%sminn_col(begc:endc) = spval + call hist_addfld1d (fname='SMINN', units='gN/m^2', & + avgflag='A', long_name='soil mineral N', & + ptr_col=this%sminn_col) + + this%totlitn_1m_col(begc:endc) = spval + call hist_addfld1d (fname='TOTLITN_1m', units='gN/m^2', & + avgflag='A', long_name='total litter N to 1 meter', & + ptr_col=this%totlitn_1m_col) + + this%totsomn_1m_col(begc:endc) = spval + call hist_addfld1d (fname='TOTSOMN_1m', units='gN/m^2', & + avgflag='A', long_name='total soil organic matter N to 1 meter', & + ptr_col=this%totsomn_1m_col) + endif + + this%ntrunc_col(begc:endc) = spval + call hist_addfld1d (fname='COL_NTRUNC', units='gN/m^2', & + avgflag='A', long_name='column-level sink for N truncation', & + ptr_col=this%ntrunc_col) + + ! add suffix if number of soil decomposition depths is greater than 1 + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + + if (use_nitrif_denitrif) then + this%smin_no3_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NO3'//trim(vr_suffix), units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name='soil mineral NO3 (vert. res.)', & + ptr_col=this%smin_no3_vr_col) + + this%smin_nh4_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMIN_NH4'//trim(vr_suffix), units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name='soil mineral NH4 (vert. res.)', & + ptr_col=this%smin_nh4_vr_col) + + if ( nlevdecomp_full > 1 ) then + this%smin_no3_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NO3', units='gN/m^2', & + avgflag='A', long_name='soil mineral NO3', & + ptr_col=this%smin_no3_col) + + this%smin_nh4_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NH4', units='gN/m^2', & + avgflag='A', long_name='soil mineral NH4', & + ptr_col=this%smin_nh4_col) + endif + + this%sminn_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMINN'//trim(vr_suffix), units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name='soil mineral N', & + ptr_col=this%sminn_vr_col, default = 'inactive') + else + this%sminn_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SMINN'//trim(vr_suffix), units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name='soil mineral N', & + ptr_col=this%sminn_vr_col) + end if + + this%totlitn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTLITN', units='gN/m^2', & + avgflag='A', long_name='total litter N', & + ptr_col=this%totlitn_col) + + this%totsomn_col(begc:endc) = spval + call hist_addfld1d (fname='TOTSOMN', units='gN/m^2', & + avgflag='A', long_name='total soil organic matter N', & + ptr_col=this%totsomn_col) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, & + decomp_cpools_vr_col, decomp_cpools_col, decomp_cpools_1m_col) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + use clm_varpar , only : crop_prog + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + class(soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + real(r8) , intent(in) :: decomp_cpools_vr_col(bounds%begc:,:,:) + real(r8) , intent(in) :: decomp_cpools_col(bounds%begc:,:) + real(r8) , intent(in) :: decomp_cpools_1m_col(bounds%begc:,:) + ! + ! !LOCAL VARIABLES: + integer :: fc,g,l,c,j,k ! indices + integer :: num_special_col ! number of good values in special_col filter + integer :: special_col (bounds%endc-bounds%begc+1) ! special landunit filter - columns + !------------------------------------------------------------------------ + + SHR_ASSERT_ALL((ubound(decomp_cpools_col) == (/bounds%endc,ndecomp_pools/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_cpools_1m_col) == (/bounds%endc,ndecomp_pools/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_cpools_vr_col) == (/bounds%endc,nlevdecomp_full,ndecomp_pools/)), errMsg(__FILE__, __LINE__)) + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + ! column nitrogen state variables + this%ntrunc_col(c) = 0._r8 + this%sminn_col(c) = 0._r8 + do j = 1, nlevdecomp + do k = 1, ndecomp_pools + this%decomp_npools_vr_col(c,j,k) = decomp_cpools_vr_col(c,j,k) / decomp_cascade_con%initial_cn_ratio(k) + end do + this%sminn_vr_col(c,j) = 0._r8 + this%ntrunc_vr_col(c,j) = 0._r8 + end do + if ( nlevdecomp > 1 ) then + do j = nlevdecomp+1, nlevdecomp_full + do k = 1, ndecomp_pools + this%decomp_npools_vr_col(c,j,k) = 0._r8 + end do + this%sminn_vr_col(c,j) = 0._r8 + this%ntrunc_vr_col(c,j) = 0._r8 + end do + end if + do k = 1, ndecomp_pools + this%decomp_npools_col(c,k) = decomp_cpools_col(c,k) / decomp_cascade_con%initial_cn_ratio(k) + this%decomp_npools_1m_col(c,k) = decomp_cpools_1m_col(c,k) / decomp_cascade_con%initial_cn_ratio(k) + end do + + if (use_nitrif_denitrif) then + do j = 1, nlevdecomp_full + this%smin_nh4_vr_col(c,j) = 0._r8 + this%smin_no3_vr_col(c,j) = 0._r8 + end do + this%smin_nh4_col(c) = 0._r8 + this%smin_no3_col(c) = 0._r8 + end if + this%totlitn_col(c) = 0._r8 + this%totsomn_col(c) = 0._r8 + this%totlitn_1m_col(c) = 0._r8 + this%totsomn_1m_col(c) = 0._r8 + this%cwdn_col(c) = 0._r8 + + end if + end do + + ! initialize fields for special filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + call this%SetValues (num_column=num_special_col, filter_column=special_col, value_column=0._r8) + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine Restart ( this, bounds, ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write CN restart data for carbon state + ! + ! !USES: + use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) + use clm_time_manager , only : is_restart, get_nstep + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + type(file_desc_t) , intent(inout) :: ncid + character(len=*) , intent(in) :: flag !'read' or 'write' or 'define' + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,l,c + logical :: readvar + integer :: idata + logical :: exit_spinup = .false. + logical :: enter_spinup = .false. + real(r8) :: m ! multiplier for the exit_spinup code + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + character(len=128) :: varname ! temporary + integer :: itemp ! temporary + integer , pointer :: iptemp(:) ! pointer to memory to be allocated + ! spinup state as read from restart file, for determining whether to enter or exit spinup mode. + integer :: restart_file_spinup_state + ! flags for comparing the model and restart decomposition cascades + integer :: decomp_cascade_state, restart_file_decomp_cascade_state + !------------------------------------------------------------------------ + + ! sminn + if (use_vertsoilc) then + ptr2d => this%sminn_vr_col + call restartvar(ncid=ncid, flag=flag, varname="sminn_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%sminn_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname="sminn", xtype=ncd_double, & + dim1name='column', & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg='ERROR::'//trim(varname)//' is required on an initialization dataset'//& + errMsg(__FILE__, __LINE__)) + end if + + ! decomposing N pools + do k = 1, ndecomp_pools + varname=trim(decomp_cascade_con%decomp_pool_name_restart(k))//'n' + if (use_vertsoilc) then + ptr2d => this%decomp_npools_vr_col(:,:,k) + call restartvar(ncid=ncid, flag=flag, varname=trim(varname)//"_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%decomp_npools_vr_col(:,1,k) + call restartvar(ncid=ncid, flag=flag, varname=varname, xtype=ncd_double, & + dim1name='column', & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg='ERROR:: '//trim(varname)//' is required on an initialization dataset'//& + errMsg(__FILE__, __LINE__)) + end if + end do + + if (use_vertsoilc) then + ptr2d => this%ntrunc_vr_col + call restartvar(ncid=ncid, flag=flag, varname="col_ntrunc_vr", xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%ntrunc_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname="col_ntrunc", xtype=ncd_double, & + dim1name='column', & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + + if (use_nitrif_denitrif) then + ! smin_no3_vr + if (use_vertsoilc) then + ptr2d => this%smin_no3_vr_col(:,:) + call restartvar(ncid=ncid, flag=flag, varname='smin_no3_vr', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%smin_no3_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname='smin_no3', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg= 'ERROR:: smin_no3_vr'//' is required on an initialization dataset' ) + end if + end if + + if (use_nitrif_denitrif) then + ! smin_nh4 + if (use_vertsoilc) then + ptr2d => this%smin_nh4_vr_col(:,:) + call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_vr', xtype=ncd_double, & + dim1name='column', dim2name='levgrnd', switchdim=.true., & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%smin_nh4_vr_col(:,1) + call restartvar(ncid=ncid, flag=flag, varname='smin_nh4', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr1d) + end if + if (flag=='read' .and. .not. readvar) then + call endrun(msg= 'ERROR:: smin_nh4_vr'//' is required on an initialization dataset' ) + end if + end if + + ! Set the integrated sminn based on sminn_vr, as is done in CNSummaryMod (this may + ! not be the most appropriate method or place to do this) + + this%sminn_col(bounds%begc:bounds%endc) = 0._r8 + do j = 1, nlevdecomp + do c = bounds%begc, bounds%endc + this%sminn_col(c) = & + this%sminn_col(c) + & + this%sminn_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! decomp_cascade_state - the purpose of this is to check to make sure the bgc used + ! matches what the restart file was generated with. + ! add info about the SOM decomposition cascade + + if (use_century_decomp) then + decomp_cascade_state = 1 + else + decomp_cascade_state = 0 + end if + ! add info about the nitrification / denitrification state + if (use_nitrif_denitrif) then + decomp_cascade_state = decomp_cascade_state + 10 + end if + if (flag == 'write') itemp = decomp_cascade_state + call restartvar(ncid=ncid, flag=flag, varname='decomp_cascade_state', xtype=ncd_int, & + long_name='BGC of the model that wrote this restart file:' & + // ' 1s column: 0 = CLM-CN cascade, 1 = Century cascade;' & + // ' 10s column: 0 = CLM-CN denitrification, 10 = Century denitrification', units='', & + interpinic_flag='skip', readvar=readvar, data=itemp) + if (flag=='read') then + if (.not. readvar) then + ! assume, for sake of backwards compatibility, that if decomp_cascade_state + ! is not in the restart file, then the current model state is the same as + ! the prior model state + restart_file_decomp_cascade_state = decomp_cascade_state + if ( masterproc ) write(iulog,*) ' CNRest: WARNING! Restart file does not ' & + // ' contain info on decomp_cascade_state used to generate the restart file. ' + if ( masterproc ) write(iulog,*) ' Assuming the same as current setting: ', decomp_cascade_state + else + restart_file_decomp_cascade_state = itemp + if (decomp_cascade_state /= restart_file_decomp_cascade_state ) then + if ( masterproc ) then + write(iulog,*) 'CNRest: ERROR--the decomposition cascade differs between the current ' & + // ' model state and the model that wrote the restart file. ' + write(iulog,*) 'The model will be horribly out of equilibrium until after a lengthy spinup. ' + write(iulog,*) 'Stopping here since this is probably an error in configuring the run. ' + write(iulog,*) 'If you really wish to proceed, then override by setting ' + write(iulog,*) 'override_bgc_restart_mismatch_dump to .true. in the namelist' + if ( .not. override_bgc_restart_mismatch_dump ) then + call endrun(msg= ' CNRest: Stopping. Decomposition cascade mismatch error.'//& + errMsg(__FILE__, __LINE__)) + endif + endif + endif + end if + end if + + !-------------------------------- + ! Spinup state + !-------------------------------- + + ! Do nothing for write + ! Note that the call to write spinup_state out was done in soilbiogeochem_carbonstate_inst and + ! cannot be called again because it will try to define the variable twice + ! when the flag below is set to define + if (flag == 'read') then + call restartvar(ncid=ncid, flag=flag, varname='spinup_state', xtype=ncd_int, & + long_name='Spinup state of the model that wrote this restart file: ' & + // ' 0 = normal model mode, 1 = AD spinup', units='', & + interpinic_flag='copy', readvar=readvar, data=idata) + if (readvar) then + restart_file_spinup_state = idata + else + ! assume, for sake of backwards compatibility, that if spinup_state is not in + ! the restart file then current model state is the same as prior model state + restart_file_spinup_state = spinup_state + if ( masterproc ) then + write(iulog,*) ' WARNING! Restart file does not contain info ' & + // ' on spinup state used to generate the restart file. ' + write(iulog,*) ' Assuming the same as current setting: ', spinup_state + end if + end if + end if + + ! now compare the model and restart file spinup states, and either take the + ! model into spinup mode or out of it if they are not identical + ! taking model out of spinup mode requires multiplying each decomposing pool + ! by the associated AD factor. + ! putting model into spinup mode requires dividing each decomposing pool + ! by the associated AD factor. + ! only allow this to occur on first timestep of model run. + + if (flag == 'read' .and. spinup_state /= restart_file_spinup_state ) then + if (spinup_state == 0 .and. restart_file_spinup_state == 1 ) then + if ( masterproc ) write(iulog,*) ' NitrogenStateType Restart: taking SOM pools out of AD spinup mode' + exit_spinup = .true. + else if (spinup_state == 1 .and. restart_file_spinup_state == 0 ) then + if ( masterproc ) write(iulog,*) ' NitrogenStateType Restart: taking SOM pools into AD spinup mode' + enter_spinup = .true. + else + call endrun(msg=' Error in entering/exiting spinup. spinup_state ' & + // ' != restart_file_spinup_state, but do not know what to do'//& + errMsg(__FILE__, __LINE__)) + end if + if (get_nstep() >= 2) then + call endrun(msg=' Error in entering/exiting spinup - should occur only when nstep = 1'//& + errMsg(__FILE__, __LINE__)) + endif + do k = 1, ndecomp_pools + if ( exit_spinup ) then + m = decomp_cascade_con%spinup_factor(k) + else if ( enter_spinup ) then + m = 1. / decomp_cascade_con%spinup_factor(k) + end if + do c = bounds%begc, bounds%endc + do j = 1, nlevdecomp + this%decomp_npools_vr_col(c,j,k) = this%decomp_npools_vr_col(c,j,k) * m + end do + end do + end do + end if + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine SetValues ( this, num_column, filter_column, value_column ) + ! + ! !DESCRIPTION: + ! Set nitrogen state variables + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenstate_type) :: this + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i ! loop index + integer :: j,k ! indices + !------------------------------------------------------------------------ + + do fi = 1,num_column + i = filter_column(fi) + + this%sminn_col(i) = value_column + this%ntrunc_col(i) = value_column + this%cwdn_col(i) = value_column + if (use_nitrif_denitrif) then + this%smin_no3_col(i) = value_column + this%smin_nh4_col(i) = value_column + end if + this%totlitn_col(i) = value_column + this%totsomn_col(i) = value_column + this%totsomn_1m_col(i) = value_column + this%totlitn_1m_col(i) = value_column + end do + + do j = 1,nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%sminn_vr_col(i,j) = value_column + this%ntrunc_vr_col(i,j) = value_column + if (use_nitrif_denitrif) then + this%smin_no3_vr_col(i,j) = value_column + this%smin_nh4_vr_col(i,j) = value_column + end if + end do + end do + + ! column and decomp_pools + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_col(i,k) = value_column + this%decomp_npools_1m_col(i,k) = value_column + end do + end do + + ! column levdecomp, and decomp_pools + do j = 1,nlevdecomp_full + do k = 1, ndecomp_pools + do fi = 1,num_column + i = filter_column(fi) + this%decomp_npools_vr_col(i,j,k) = value_column + end do + end do + end do + + end subroutine SetValues + + !----------------------------------------------------------------------- + subroutine Summary(this, bounds, num_soilc, filter_soilc) + ! + ! !ARGUMENTS: + class (soilbiogeochem_nitrogenstate_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l ! indices + integer :: fc ! lake filter indices + real(r8) :: maxdepth ! depth to integrate soil variables + !----------------------------------------------------------------------- + + ! vertically integrate NO3 NH4 N2O pools + if (use_nitrif_denitrif) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%smin_no3_col(c) = 0._r8 + this%smin_nh4_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%smin_no3_col(c) = & + this%smin_no3_col(c) + & + this%smin_no3_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_nh4_col(c) = & + this%smin_nh4_col(c) + & + this%smin_nh4_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + end if + + ! vertically integrate each of the decomposing N pools + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_col(c,l) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_col(c,l) = & + this%decomp_npools_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + end do + end do + + ! for vertically-resolved soil biogeochemistry, calculate some diagnostics of carbon pools to a given depth + if ( nlevdecomp > 1) then + + do l = 1, ndecomp_pools + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_1m_col(c,l) = 0._r8 + end do + end do + + ! vertically integrate each of the decomposing n pools to 1 meter + maxdepth = 1._r8 + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + if ( zisoi(j) <= maxdepth ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_1m_col(c,l) = & + this%decomp_npools_1m_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * dzsoi_decomp(j) + end do + elseif ( zisoi(j-1) < maxdepth ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%decomp_npools_1m_col(c,l) = & + this%decomp_npools_1m_col(c,l) + & + this%decomp_npools_vr_col(c,j,l) * (maxdepth - zisoi(j-1)) + end do + endif + end do + end do + + ! total litter nitrogen to 1 meter (TOTLITN_1m) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitn_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitn_1m_col(c) = & + this%totlitn_1m_col(c) + & + this%decomp_npools_1m_col(c,l) + end do + end if + end do + + ! total soil organic matter nitrogen to 1 meter (TOTSOMN_1m) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomn_1m_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomn_1m_col(c) = this%totsomn_1m_col(c) + & + this%decomp_npools_1m_col(c,l) + end do + end if + end do + + endif + + ! total litter nitrogen (TOTLITN) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_litter(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totlitn_col(c) = & + this%totlitn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + ! total soil organic matter nitrogen (TOTSOMN) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_soil(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%totsomn_col(c) = this%totsomn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + ! total cwdn + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdn_col(c) = 0._r8 + end do + do l = 1, ndecomp_pools + if ( decomp_cascade_con%is_cwd(l) ) then + do fc = 1,num_soilc + c = filter_soilc(fc) + this%cwdn_col(c) = this%cwdn_col(c) + & + this%decomp_npools_col(c,l) + end do + end if + end do + + ! total sminn + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_col(c) = this%sminn_col(c) + & + this%sminn_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + ! total col_ntrunc + do fc = 1,num_soilc + c = filter_soilc(fc) + this%ntrunc_col(c) = 0._r8 + end do + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%ntrunc_col(c) = this%ntrunc_col(c) + & + this%ntrunc_vr_col(c,j) * dzsoi_decomp(j) + end do + end do + + end subroutine Summary + +end module SoilBiogeochemNitrogenStateType diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 new file mode 100644 index 0000000000..ee3f390a78 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemNitrogenUptakeMod.F90 @@ -0,0 +1,78 @@ +module SoilBiogeochemNitrogenUptakeMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate the nitrogen uptake profile + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: SoilBiogeochemNitrogenUptake + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemNitrogenUptake(bounds, nlevdecomp, num_soilc, filter_soilc, & + sminn_vr, dzsoi_decomp, nfixation_prof, nuptake_prof) + ! + ! DESCRIPTION + ! Calculate the nitrogen uptake profile + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: nlevdecomp ! number of vertical layers + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + real(r8) , intent(in) :: sminn_vr(bounds%begc: , 1: ) ! soil mineral nitrogen profile + real(r8) , intent(in) :: dzsoi_decomp(1: ) ! layer thickness + real(r8) , intent(in) :: nfixation_prof(bounds%begc: , 1: ) ! nitrogen fixation profile + real(r8) , intent(inout) :: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) ! nitrogen uptake profile + ! + ! !LOCAL VARIABLES: + integer :: fc, j, c ! indices + real(r8):: sminn_tot(bounds%begc:bounds%endc) !vertically integrated mineral nitrogen + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL((ubound(dzsoi_decomp) == (/nlevdecomp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sminn_vr) == (/bounds%endc, nlevdecomp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(nfixation_prof) == (/bounds%endc, nlevdecomp/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(nuptake_prof) == (/bounds%endc, nlevdecomp/)) , errMsg(__FILE__, __LINE__)) + + ! init sminn_tot + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + sminn_vr(c,j) * dzsoi_decomp(j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = sminn_vr(c,j) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + + end do + end do + + end subroutine SoilBiogeochemNitrogenUptake + +end module SoilBiogeochemNitrogenUptakeMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 new file mode 100644 index 0000000000..e5be13f4fd --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemPotentialMod.F90 @@ -0,0 +1,247 @@ +module SoilBiogeochemPotentialMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate potential decomp rates and total immobilization demand. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use clm_varpar , only : nlevdecomp, ndecomp_cascade_transitions, ndecomp_pools + use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readParams + public :: SoilBiogeochemPotential + ! + type, private :: params_type + real(r8) :: dnp !denitrification proportion + end type Params_type + ! + type(params_type), private :: params_inst + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readParams ( ncid ) + ! + ! !DESCRIPTION: + ! Read parameters + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + use abortutils , only: endrun + use shr_log_mod , only: errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNDecompParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + tString='dnp' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + params_inst%dnp=tempr + + end subroutine readParams + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemPotential (bounds, num_soilc, filter_soilc, & + soilbiogeochem_state_inst, soilbiogeochem_carbonstate_inst, soilbiogeochem_carbonflux_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst, & + cn_decomp_pools, p_decomp_cpool_loss, pmnf_decomp_cascade) + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + ! + ! !ARGUMENT: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + type(soilbiogeochem_carbonstate_type) , intent(in) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + real(r8) , intent(out) :: cn_decomp_pools(bounds%begc:,1:,1:) ! c:n ratios of applicable pools + real(r8) , intent(out) :: p_decomp_cpool_loss(bounds%begc:,1:,1:) ! potential C loss from one pool to another + real(r8) , intent(out) :: pmnf_decomp_cascade(bounds%begc:,1:,1:) ! potential mineral N flux, from one pool to another + ! + ! !LOCAL VARIABLES: + integer :: c,j,k,l,m !indices + integer :: fc !filter column index + integer :: begc,endc !bounds + real(r8):: immob(bounds%begc:bounds%endc,1:nlevdecomp) !potential N immobilization + real(r8):: ratio !temporary variable + integer, parameter :: i_atm = 0 !TODO - this appears in two places - move it to 1 + !----------------------------------------------------------------------- + + begc = bounds%begc; endc = bounds%endc + + SHR_ASSERT_ALL((ubound(cn_decomp_pools) == (/endc,nlevdecomp,ndecomp_pools/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(p_decomp_cpool_loss) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(pmnf_decomp_cascade) == (/endc,nlevdecomp,ndecomp_cascade_transitions/)) , errMsg(__FILE__, __LINE__)) + + associate( & + cascade_donor_pool => decomp_cascade_con%cascade_donor_pool , & ! Input: [integer (:) ] which pool is C taken from for a given decomposition step + cascade_receiver_pool => decomp_cascade_con%cascade_receiver_pool , & ! Input: [integer (:) ] which pool is C added to for a given decomposition step + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Input: [logical (:) ] TRUE => pool has fixed C:N ratio + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Input: [real(r8) (:) ] c:n ratio for initialization of pools + + fpi_vr => soilbiogeochem_state_inst%fpi_vr_col , & ! Input: [real(r8) (:,:) ] fraction of potential immobilization (no units) + rf_decomp_cascade => soilbiogeochem_state_inst%rf_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] respired fraction in decomposition step (frac) + pathfrac_decomp_cascade => soilbiogeochem_state_inst%pathfrac_decomp_cascade_col , & ! Input: [real(r8) (:,:,:) ] what fraction of C leaving a given pool passes through a given transition (frac) + + decomp_npools_vr => soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + + decomp_cpools_vr => soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col , & ! Input: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + decomp_cascade_ntransfer_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_ntransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) + decomp_cascade_sminn_flux_vr => soilbiogeochem_nitrogenflux_inst%decomp_cascade_sminn_flux_vr_col , & ! Output: [real(r8) (:,:,:) ] vert-res mineral N flux for transition along decomposition cascade (gN/m3/s) + potential_immob_vr => soilbiogeochem_nitrogenflux_inst%potential_immob_vr_col , & ! Output: [real(r8) (:,:) ] + sminn_to_denit_decomp_cascade_vr => soilbiogeochem_nitrogenflux_inst%sminn_to_denit_decomp_cascade_vr_col , & ! Output: [real(r8) (:,:,:) ] + gross_nmin_vr => soilbiogeochem_nitrogenflux_inst%gross_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + net_nmin_vr => soilbiogeochem_nitrogenflux_inst%net_nmin_vr_col , & ! Output: [real(r8) (:,:) ] + gross_nmin => soilbiogeochem_nitrogenflux_inst%gross_nmin_col , & ! Output: [real(r8) (:) ] gross rate of N mineralization (gN/m2/s) + net_nmin => soilbiogeochem_nitrogenflux_inst%net_nmin_col , & ! Output: [real(r8) (:) ] net rate of N mineralization (gN/m2/s) + + w_scalar => soilbiogeochem_carbonflux_inst%w_scalar_col , & ! Input: [real(r8) (:,:) ] fraction by which decomposition is limited by moisture availability + decomp_cascade_hr_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_hr_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_cascade_ctransfer_vr => soilbiogeochem_carbonflux_inst%decomp_cascade_ctransfer_vr_col , & ! Output: [real(r8) (:,:,:) ] vertically-resolved het. resp. from decomposing C pools (gC/m3/s) + decomp_k => soilbiogeochem_carbonflux_inst%decomp_k_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + phr_vr => soilbiogeochem_carbonflux_inst%phr_vr_col , & ! Output: [real(r8) (:,:) ] potential HR (gC/m3/s) + fphr => soilbiogeochem_carbonflux_inst%fphr_col & ! Output: [real(r8) (:,:) ] fraction of potential SOM + LITTER heterotrophic + ) + + ! set initial values for potential C and N fluxes + p_decomp_cpool_loss(begc:endc, :, :) = 0._r8 + pmnf_decomp_cascade(begc:endc, :, :) = 0._r8 + + ! column loop to calculate potential decomp rates and total immobilization demand + + !! calculate c:n ratios of applicable pools + do l = 1, ndecomp_pools + if ( floating_cn_ratio_decomp_pools(l) ) then + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if ( decomp_npools_vr(c,j,l) > 0._r8 ) then + cn_decomp_pools(c,j,l) = decomp_cpools_vr(c,j,l) / decomp_npools_vr(c,j,l) + end if + end do + end do + else + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cn_decomp_pools(c,j,l) = initial_cn_ratio(l) + end do + end do + end if + end do + + ! calculate the non-nitrogen-limited fluxes + ! these fluxes include the "/ dt" term to put them on a + ! per second basis, since the rate constants have been + ! calculated on a per timestep basis. + + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (decomp_cpools_vr(c,j,cascade_donor_pool(k)) > 0._r8 .and. & + decomp_k(c,j,cascade_donor_pool(k)) > 0._r8 ) then + p_decomp_cpool_loss(c,j,k) = decomp_cpools_vr(c,j,cascade_donor_pool(k)) & + * decomp_k(c,j,cascade_donor_pool(k)) * pathfrac_decomp_cascade(c,j,k) + if ( .not. floating_cn_ratio_decomp_pools(cascade_receiver_pool(k)) ) then !! not transition of cwd to litter + + if (cascade_receiver_pool(k) /= i_atm ) then ! not 100% respiration + ratio = 0._r8 + + if (decomp_npools_vr(c,j,cascade_donor_pool(k)) > 0._r8) then + ratio = cn_decomp_pools(c,j,cascade_receiver_pool(k))/cn_decomp_pools(c,j,cascade_donor_pool(k)) + endif + + pmnf_decomp_cascade(c,j,k) = (p_decomp_cpool_loss(c,j,k) * (1.0_r8 - rf_decomp_cascade(c,j,k) - ratio) & + / cn_decomp_pools(c,j,cascade_receiver_pool(k)) ) + + else ! 100% respiration + pmnf_decomp_cascade(c,j,k) = - p_decomp_cpool_loss(c,j,k) / cn_decomp_pools(c,j,cascade_donor_pool(k)) + endif + + else ! CWD -> litter + pmnf_decomp_cascade(c,j,k) = 0._r8 + end if + end if + end do + + end do + end do + + ! Sum up all the potential immobilization fluxes (positive pmnf flux) + ! and all the mineralization fluxes (negative pmnf flux) + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + immob(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pmnf_decomp_cascade(c,j,k) > 0._r8) then + immob(c,j) = immob(c,j) + pmnf_decomp_cascade(c,j,k) + else + gross_nmin_vr(c,j) = gross_nmin_vr(c,j) - pmnf_decomp_cascade(c,j,k) + end if + end do + end do + end do + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + potential_immob_vr(c,j) = immob(c,j) + end do + end do + + ! Add up potential hr for methane calculations + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + phr_vr(c,j) = 0._r8 + end do + end do + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + phr_vr(c,j) = phr_vr(c,j) + rf_decomp_cascade(c,j,k) * p_decomp_cpool_loss(c,j,k) + end do + end do + end do + + end associate + + end subroutine SoilBiogeochemPotential + +end module SoilBiogeochemPotentialMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 new file mode 100644 index 0000000000..12326355ca --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemPrecisionControlMod.F90 @@ -0,0 +1,158 @@ +module SoilBiogeochemPrecisionControlMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! controls on very low values in critical state variables + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : ndecomp_pools + use SoilBiogeochemCarbonStateType , only : soilbiogeochem_carbonstate_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use ColumnType , only : col + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemPrecisionControl + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemPrecisionControl(num_soilc, filter_soilc, & + soilbiogeochem_carbonstate_inst, c13_soilbiogeochem_carbonstate_inst, & + c14_soilbiogeochem_carbonstate_inst, soilbiogeochem_nitrogenstate_inst) + + ! + ! !DESCRIPTION: + ! On the radiation time step, force leaf and deadstem c and n to 0 if + ! they get too small. + ! + ! !USES: + use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif + use clm_varpar , only : nlevdecomp + ! + ! !ARGUMENTS: + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(soilbiogeochem_carbonstate_type) , intent(inout) :: soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c13_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_carbonstate_type) , intent(inout) :: c14_soilbiogeochem_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst + ! + ! !LOCAL VARIABLES: + integer :: c,j,k ! indices + integer :: fc ! filter indices + real(r8):: cc,cn ! truncation terms for column-level corrections + real(r8):: cc13 ! truncation terms for column-level corrections + real(r8):: cc14 ! truncation terms for column-level corrections + real(r8):: ccrit ! critical carbon state value for truncation + real(r8):: ncrit ! critical nitrogen state value for truncation + !----------------------------------------------------------------------- + + ! soilbiogeochem_carbonstate_inst%ctrunc_vr_col Output: [real(r8) (:,:) ] (gC/m3) column-level sink for C truncation + ! soilbiogeochem_carbonstate_inst%decomp_cpools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) c pools + + ! soilbiogeochem_nitrogenstate_inst%ntrunc_vr_col Output: [real(r8) (:,:) ] (gN/m3) column-level sink for N truncation + ! soilbiogeochem_nitrogenstate_inst%decomp_npools_vr_col Output: [real(r8) (:,:,:) ] (gC/m3) vertically-resolved decomposing (litter, cwd, soil) N pools + ! soilbiogeochem_nitrogenstate_inst%smin_nh4_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NH4 + ! soilbiogeochem_nitrogenstate_inst%smin_no3_vr_col Output: [real(r8) (:,:) ] (gN/m3) soil mineral NO3 + + associate(& + cs => soilbiogeochem_carbonstate_inst , & + ns => soilbiogeochem_nitrogenstate_inst , & + c13cs => c13_soilbiogeochem_carbonstate_inst , & + c14cs => c14_soilbiogeochem_carbonstate_inst & + ) + + ! set the critical carbon state value for truncation (gC/m2) + ccrit = 1.e-8_r8 + + ! set the critical nitrogen state value for truncation (gN/m2) + ncrit = 1.e-8_r8 + + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + do j = 1,nlevdecomp + ! initialize the column-level C and N truncation terms + cc = 0._r8 + if ( use_c13 ) cc13 = 0._r8 + if ( use_c14 ) cc14 = 0._r8 + cn = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate both C and N components + + + ! all decomposing pools C and N + do k = 1, ndecomp_pools + + if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then + cc = cc + cs%decomp_cpools_vr_col(c,j,k) + cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + + cn = cn + ns%decomp_npools_vr_col(c,j,k) + ns%decomp_npools_vr_col(c,j,k) = 0._r8 + + if ( use_c13 ) then + cc13 = cc13 + c13cs%decomp_cpools_vr_col(c,j,k) + c13cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + if ( use_c14 ) then + cc14 = cc14 + c14cs%decomp_cpools_vr_col(c,j,k) + c14cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + end if + + end do + + ! not doing precision control on soil mineral N, since it will + ! be getting the N truncation flux anyway. + + cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc + ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn + if ( use_c13 ) then + c13cs%ctrunc_vr_col(c,j) = c13cs%ctrunc_vr_col(c,j) + cc13 + endif + if ( use_c14 ) then + c14cs%ctrunc_vr_col(c,j) = c14cs%ctrunc_vr_col(c,j) + cc14 + endif + end do + + end do ! end of column loop + + if (use_nitrif_denitrif) then + ! remove small negative perturbations for stability purposes, if any should arise. + + do fc = 1,num_soilc + c = filter_soilc(fc) + do j = 1,nlevdecomp + if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then + write(iulog, *) '-10^-12 < smin_no3 < 0. resetting to zero.' + write(iulog, *) 'smin_no3_vr_col(c,j), c, j: ', ns%smin_no3_vr_col(c,j), c, j + ns%smin_no3_vr_col(c,j) = 0._r8 + endif + end if + if (abs(ns%smin_nh4_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_nh4_vr_col(c,j) < 0._r8 ) then + write(iulog, *) '-10^-12 < smin_nh4 < 0. resetting to zero.' + write(iulog, *) 'smin_nh4_vr_col(c,j), c, j: ', ns%smin_nh4_vr_col(c,j), c, j + ns%smin_nh4_vr_col(c,j) = 0._r8 + endif + end if + end do + end do + endif + + end associate + + end subroutine SoilBiogeochemPrecisionControl + +end module SoilBiogeochemPrecisionControlMod diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemStateType.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemStateType.F90 new file mode 100644 index 0000000000..773466cc53 --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemStateType.F90 @@ -0,0 +1,334 @@ +module SoilBiogeochemStateType + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + use spmdMod , only : masterproc + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevsoifl, nlevsoi, crop_prog + use clm_varpar , only : ndecomp_cascade_transitions, nlevdecomp, nlevdecomp_full, more_vertlayers + use clm_varcon , only : spval, ispval, c14ratio, grlnd + use landunit_varcon, only : istsoil, istcrop + use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, crop_prog + use clm_varctl , only : use_vertsoilc, use_cn + use clm_varctl , only : iulog + use LandunitType , only : lun + use ColumnType , only : col + ! + ! !PUBLIC TYPES: + implicit none + private + ! + ! !PUBLIC TYPES: + type, public :: soilbiogeochem_state_type + + real(r8) , pointer :: leaf_prof_patch (:,:) ! (1/m) profile of leaves (vertical profiles for calculating fluxes) + real(r8) , pointer :: froot_prof_patch (:,:) ! (1/m) profile of fine roots (vertical profiles for calculating fluxes) + real(r8) , pointer :: croot_prof_patch (:,:) ! (1/m) profile of coarse roots (vertical profiles for calculating fluxes) + real(r8) , pointer :: stem_prof_patch (:,:) ! (1/m) profile of stems (vertical profiles for calculating fluxes) + real(r8) , pointer :: fpi_vr_col (:,:) ! (no units) fraction of potential immobilization + real(r8) , pointer :: fpi_col (:) ! (no units) fraction of potential immobilization + real(r8), pointer :: fpg_col (:) ! (no units) fraction of potential gpp + real(r8) , pointer :: rf_decomp_cascade_col (:,:,:) ! (frac) respired fraction in decomposition step + real(r8) , pointer :: pathfrac_decomp_cascade_col (:,:,:) ! (frac) what fraction of C leaving a given pool passes through a given transition + real(r8) , pointer :: nfixation_prof_col (:,:) ! (1/m) profile for N fixation additions + real(r8) , pointer :: ndep_prof_col (:,:) ! (1/m) profile for N fixation additions + real(r8) , pointer :: som_adv_coef_col (:,:) ! (m2/s) SOM advective flux + real(r8) , pointer :: som_diffus_coef_col (:,:) ! (m2/s) SOM diffusivity due to bio/cryo-turbation + real(r8) , pointer :: plant_ndemand_col (:) ! column-level plant N demand + + contains + + procedure, public :: Init + procedure, public :: Restart + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type soilbiogeochem_state_type + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(soilbiogeochem_state_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate ( bounds ) + if (use_cn) then + call this%InitHistory ( bounds ) + end if + call this%InitCold ( bounds ) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + class(soilbiogeochem_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + allocate(this%leaf_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%leaf_prof_patch (:,:) = spval + allocate(this%froot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%froot_prof_patch (:,:) = spval + allocate(this%croot_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%croot_prof_patch (:,:) = spval + allocate(this%stem_prof_patch (begp:endp,1:nlevdecomp_full)) ; this%stem_prof_patch (:,:) = spval + allocate(this%fpi_vr_col (begc:endc,1:nlevdecomp_full)) ; this%fpi_vr_col (:,:) = nan + allocate(this%fpi_col (begc:endc)) ; this%fpi_col (:) = nan + allocate(this%fpg_col (begc:endc)) ; this%fpg_col (:) = nan + allocate(this%nfixation_prof_col (begc:endc,1:nlevdecomp_full)) ; this%nfixation_prof_col (:,:) = spval + allocate(this%ndep_prof_col (begc:endc,1:nlevdecomp_full)) ; this%ndep_prof_col (:,:) = spval + allocate(this%som_adv_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_adv_coef_col (:,:) = spval + allocate(this%som_diffus_coef_col (begc:endc,1:nlevdecomp_full)) ; this%som_diffus_coef_col (:,:) = spval + allocate(this%plant_ndemand_col (begc:endc)) ; this%plant_ndemand_col (:) = nan + + allocate(this%rf_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)); + this%rf_decomp_cascade_col(:,:,:) = nan + + allocate(this%pathfrac_decomp_cascade_col(begc:endc,1:nlevdecomp_full,1:ndecomp_cascade_transitions)); + this%pathfrac_decomp_cascade_col(:,:,:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp, no_snow_normal + ! + ! !ARGUMENTS: + class(soilbiogeochem_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + character(8) :: vr_suffix + character(10) :: active + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%croot_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='CROOT_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from coarse roots', & + ptr_patch=this%croot_prof_patch, default='inactive') + + this%froot_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='FROOT_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from fine roots', & + ptr_patch=this%froot_prof_patch, default='inactive') + + this%leaf_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='LEAF_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from leaves', & + ptr_patch=this%leaf_prof_patch, default='inactive') + + this%stem_prof_patch(begp:endp,:) = spval + call hist_addfld_decomp (fname='STEM_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for litter C and N inputs from stems', & + ptr_patch=this%stem_prof_patch, default='inactive') + + this%nfixation_prof_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='NFIXATION_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for biological N fixation', & + ptr_col=this%nfixation_prof_col, default='inactive') + + this%ndep_prof_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='NDEP_PROF', units='1/m', type2d='levdcmp', & + avgflag='A', long_name='profile for atmospheric N deposition', & + ptr_col=this%ndep_prof_col, default='inactive') + + this%som_adv_coef_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SOM_ADV_COEF', units='m/s', type2d='levdcmp', & + avgflag='A', long_name='advection term for vertical SOM translocation', & + ptr_col=this%som_adv_coef_col, default='inactive') + + this%som_diffus_coef_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='SOM_DIFFUS_COEF', units='m^2/s', type2d='levdcmp', & + avgflag='A', long_name='diffusion coefficient for vertical SOM translocation', & + ptr_col=this%som_diffus_coef_col, default='inactive') + + if ( nlevdecomp_full > 1 ) then + this%fpi_col(begc:endc) = spval + call hist_addfld1d (fname='FPI', units='proportion', & + avgflag='A', long_name='fraction of potential immobilization', & + ptr_col=this%fpi_col) + endif + + this%fpg_col(begc:endc) = spval + call hist_addfld1d (fname='FPG', units='proportion', & + avgflag='A', long_name='fraction of potential gpp', & + ptr_col=this%fpg_col) + + if (nlevdecomp > 1) then + vr_suffix = "_vr" + else + vr_suffix = "" + endif + this%fpi_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='FPI'//trim(vr_suffix), units='proportion', type2d='levdcmp', & + avgflag='A', long_name='fraction of potential immobilization', & + ptr_col=this%fpi_vr_col) + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine initCold(this, bounds) + ! + ! !USES: + use spmdMod , only : masterproc + use fileutils , only : getfil + use clm_varctl , only : fsurdat + use ncdio_pio + ! + ! !ARGUMENTS: + class(soilbiogeochem_state_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: g,l,c,p,n,j,m ! indices + integer :: dimid ! dimension id + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + logical :: readvar + character(len=256) :: locfn ! local filename + integer :: begc, endc + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + ! -------------------------------------------------------------------- + ! Open surface dataset + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqdlen(ncid,dimid,nlevsoifl,name='nlevsoi') + if ( .not. more_vertlayers )then + if ( nlevsoifl /= nlevsoi )then + call endrun(msg=' ERROR: Number of soil layers on file does NOT match the number being used'//& + errMsg(__FILE__, __LINE__)) + end if + else + ! read in layers, interpolate to high resolution grid later + end if + + ! -------------------------------------------------------------------- + ! Initialize terms needed for dust model + ! -------------------------------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + this%fpi_col (c) = spval + this%fpg_col (c) = spval + do j = 1,nlevdecomp_full + this%fpi_vr_col(c,j) = spval + end do + end if + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + ! initialize fpi_vr so that levels below nlevsoi are not nans + this%fpi_vr_col(c,1:nlevdecomp_full) = 0._r8 + this%som_adv_coef_col(c,1:nlevdecomp_full) = 0._r8 + this%som_diffus_coef_col(c,1:nlevdecomp_full) = 0._r8 + + ! initialize the profiles for converting to vertically resolved carbon pools + this%nfixation_prof_col(c,1:nlevdecomp_full) = 0._r8 + this%ndep_prof_col(c,1:nlevdecomp_full) = 0._r8 + end if + end do + + end subroutine initCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !USES: + use shr_log_mod, only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc + use abortutils , only : endrun + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(soilbiogeochem_state_type) :: this + type(bounds_type), intent(in) :: bounds + type(file_desc_t), intent(inout) :: ncid + character(len=*) , intent(in) :: flag + ! + ! !LOCAL VARIABLES: + integer, pointer :: temp1d(:) ! temporary + integer :: p,j,c,i ! indices + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: ptr2d(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: ptr1d(:) ! temp. pointers for slicing larger arrays + !----------------------------------------------------------------------- + + if (use_vertsoilc) then + ptr2d => this%fpi_vr_col + call restartvar(ncid=ncid, flag=flag, varname='fpi_vr', xtype=ncd_double, & + dim1name='column',dim2name='levgrnd', switchdim=.true., & + long_name='fraction of potential immobilization', units='unitless', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + else + ptr1d => this%fpi_vr_col(:,1) ! nlevdecomp = 1; so treat as 1D variable + call restartvar(ncid=ncid, flag=flag, varname='fpi', xtype=ncd_double, & + dim1name='column', & + long_name='fraction of potential immobilization', units='unitless', & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + end if + + if (use_vertsoilc) then + ptr2d => this%som_adv_coef_col + call restartvar(ncid=ncid, flag=flag, varname='som_adv_coef_vr', xtype=ncd_double, & + dim1name='column',dim2name='levgrnd', switchdim=.true., & + long_name='SOM advective flux', units='m/s', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + end if + + if (use_vertsoilc) then + ptr2d => this%som_diffus_coef_col + call restartvar(ncid=ncid, flag=flag, varname='som_diffus_coef_vr', xtype=ncd_double, & + dim1name='column',dim2name='levgrnd', switchdim=.true., & + long_name='SOM diffusivity due to bio/cryo-turbation', units='m^2/s', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + end if + + call restartvar(ncid=ncid, flag=flag, varname='fpg', xtype=ncd_double, & + dim1name='column', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fpg_col) + + end subroutine Restart + +end module SoilBiogeochemStateType diff --git a/components/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 b/components/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 new file mode 100644 index 0000000000..b5f2421cff --- /dev/null +++ b/components/clm/src/soilbiogeochem/SoilBiogeochemVerticalProfileMod.F90 @@ -0,0 +1,289 @@ +module SoilBiogeochemVerticalProfileMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Calculate vertical profiles for distributing soil and litter C and N + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + ! + implicit none + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public:: SoilBiogeochemVerticalProfile + ! + logical , public :: exponential_rooting_profile = .true. + logical , public :: pftspecific_rootingprofile = .true. + real(r8), public :: rootprof_exp = 3. ! how steep profile is for root C inputs (1/ e-folding depth) (1/m) + real(r8), public :: surfprof_exp = 10. ! how steep profile is for surface components (1/ e_folding depth) (1/m) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine SoilBiogeochemVerticalProfile(bounds, num_soilc,filter_soilc,num_soilp,filter_soilp, & + canopystate_inst, soilstate_inst, soilbiogeochem_state_inst) + ! + ! !DESCRIPTION: + ! calculate vertical profiles for distributing soil and litter C and N + ! + ! BUG(wjs, 2014-12-15, bugz 2107) + ! Because of this routine's placement in the driver sequence (it is + ! called very early in each timestep, before weights are adjusted and filters are + ! updated), it may be necessary for this routine to compute values over inactive as well + ! as active points (since some inactive points may soon become active) - so that's what + ! is done now. Currently, it seems to be okay to do this, because the variables computed + ! here seem to only depend on quantities that are valid over inactive as well as active + ! points. However, note that this routine is (mistakenly) called from two places + ! currently - the above note applies to its call from the driver, but its call from + ! CNDecompMod uses the standard filters that just apply over active points + ! + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use abortutils , only : endrun + use clm_varcon , only : zsoi, dzsoi, zisoi, dzsoi_decomp + use clm_varpar , only : nlevdecomp, nlevgrnd, nlevdecomp_full, maxpatch_pft + use clm_varctl , only : use_vertsoilc, iulog + use pftconMod , only : noveg, pftcon + use SoilBiogeochemStateType , only : soilbiogeochem_state_type + use CanopyStateType , only : canopystate_type + use SoilStateType , only : soilstate_type + use ColumnType , only : col + use PatchType , only : patch + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(canopystate_type) , intent(in) :: canopystate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(soilbiogeochem_state_type) , intent(inout) :: soilbiogeochem_state_inst + ! + ! !LOCAL VARIABLES: + real(r8) :: surface_prof(1:nlevdecomp) + real(r8) :: surface_prof_tot + real(r8) :: rootfr_tot + real(r8) :: cinput_rootfr(bounds%begp:bounds%endp, 1:nlevdecomp_full) ! pft-native root fraction used for calculating inputs + real(r8) :: col_cinput_rootfr(bounds%begc:bounds%endc, 1:nlevdecomp_full) ! col-native root fraction used for calculating inputs + integer :: c, j, fc, p, fp, pi + integer :: alt_ind + ! debugging temp variables + real(r8) :: froot_prof_sum + real(r8) :: croot_prof_sum + real(r8) :: leaf_prof_sum + real(r8) :: stem_prof_sum + real(r8) :: ndep_prof_sum + real(r8) :: nfixation_prof_sum + real(r8) :: delta = 1.e-10 + integer :: begp, endp + integer :: begc, endc + character(len=32) :: subname = 'SoilBiogeochemVerticalProfile' + !----------------------------------------------------------------------- + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + associate( & + altmax_lastyear_indx => canopystate_inst%altmax_lastyear_indx_col , & ! Input: [integer (:) ] frost table depth (m) + + rootfr => soilstate_inst%rootfr_patch , & ! Input: [real(r8) (:,:) ] fraction of roots in each soil layer (nlevgrnd) + + nfixation_prof => soilbiogeochem_state_inst%nfixation_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions + ndep_prof => soilbiogeochem_state_inst%ndep_prof_col , & ! Input : [real(r8) (:,:) ] (1/m) profile for N fixation additions + leaf_prof => soilbiogeochem_state_inst%leaf_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of leaves + froot_prof => soilbiogeochem_state_inst%froot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of fine roots + croot_prof => soilbiogeochem_state_inst%croot_prof_patch , & ! Output : [real(r8) (:,:) ] (1/m) profile of coarse roots + stem_prof => soilbiogeochem_state_inst%stem_prof_patch & ! Output : [real(r8) (:,:) ] (1/m) profile of stems + ) + + if (use_vertsoilc) then + + ! define a single shallow surface profile for surface additions (leaves, stems, and N deposition) + surface_prof(:) = 0._r8 + do j = 1, nlevdecomp + surface_prof(j) = exp(-surfprof_exp * zsoi(j)) / dzsoi_decomp(j) + end do + + ! initialize profiles to zero + leaf_prof(begp:endp, :) = 0._r8 + froot_prof(begp:endp, :) = 0._r8 + croot_prof(begp:endp, :) = 0._r8 + stem_prof(begp:endp, :) = 0._r8 + nfixation_prof(begc:endc, :) = 0._r8 + ndep_prof(begc:endc, :) = 0._r8 + + cinput_rootfr(begp:endp, :) = 0._r8 + col_cinput_rootfr(begc:endc, :) = 0._r8 + + if ( exponential_rooting_profile ) then + if ( .not. pftspecific_rootingprofile ) then + ! define rooting profile from exponential parameters + do j = 1, nlevdecomp + do fp = 1,num_soilp + p = filter_soilp(fp) + cinput_rootfr(p,j) = exp(-rootprof_exp * zsoi(j)) / dzsoi_decomp(j) + end do + end do + else + ! use beta distribution parameter from Jackson et al., 1996 + do fp = 1,num_soilp + p = filter_soilp(fp) + if (patch%itype(p) /= noveg) then + do j = 1, nlevdecomp + cinput_rootfr(p,j) = ( pftcon%rootprof_beta(patch%itype(p)) ** (zisoi(j-1)*100._r8) - & + pftcon%rootprof_beta(patch%itype(p)) ** (zisoi(j)*100._r8) ) & + / dzsoi_decomp(j) + end do + else + cinput_rootfr(p,1) = 1._r8 / dzsoi_decomp(1) + endif + end do + endif + else + do j = 1, nlevdecomp + ! use standard CLM root fraction profiles + do fp = 1,num_soilp + p = filter_soilp(fp) + cinput_rootfr(p,j) = rootfr(p,j) / dzsoi_decomp(j) + end do + end do + endif + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = patch%column(p) + ! integrate rootfr over active layer of soil column + rootfr_tot = 0._r8 + surface_prof_tot = 0._r8 + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + rootfr_tot = rootfr_tot + cinput_rootfr(p,j) * dzsoi_decomp(j) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) + end do + if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then + ! where there is not permafrost extending to the surface, integrate the profiles over the active layer + ! this is equivalnet to integrating over all soil layers outside of permafrost regions + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + froot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot + croot_prof(p,j) = cinput_rootfr(p,j) / rootfr_tot + ! set all surface processes to shallower profile + leaf_prof(p,j) = surface_prof(j)/ surface_prof_tot + stem_prof(p,j) = surface_prof(j)/ surface_prof_tot + end do + else + ! if fully frozen, or no roots, put everything in the top layer + froot_prof(p,1) = 1./dzsoi_decomp(1) + croot_prof(p,1) = 1./dzsoi_decomp(1) + leaf_prof(p,1) = 1./dzsoi_decomp(1) + stem_prof(p,1) = 1./dzsoi_decomp(1) + endif + + end do + + !! aggregate root profile to column + ! call p2c (decomp, nlevdecomp_full, & + ! cinput_rootfr(bounds%begp:bounds%endp, :), & + ! col_cinput_rootfr(bounds%begc:bounds%endc, :), & + ! 'unity') + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= col%npatches(c)) then + p = col%patchi(c) + pi - 1 + do j = 1,nlevdecomp + col_cinput_rootfr(c,j) = col_cinput_rootfr(c,j) + cinput_rootfr(p,j) * patch%wtcol(p) + end do + end if + end do + end do + + ! repeat for column-native profiles: Ndep and Nfix + do fc = 1,num_soilc + c = filter_soilc(fc) + rootfr_tot = 0._r8 + surface_prof_tot = 0._r8 + ! redo column ntegration over active layer for column-native profiles + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + rootfr_tot = rootfr_tot + col_cinput_rootfr(c,j) * dzsoi_decomp(j) + surface_prof_tot = surface_prof_tot + surface_prof(j) * dzsoi_decomp(j) + end do + if ( (altmax_lastyear_indx(c) > 0) .and. (rootfr_tot > 0._r8) .and. (surface_prof_tot > 0._r8) ) then + do j = 1, min(max(altmax_lastyear_indx(c), 1), nlevdecomp) + nfixation_prof(c,j) = col_cinput_rootfr(c,j) / rootfr_tot + ndep_prof(c,j) = surface_prof(j)/ surface_prof_tot + end do + else + nfixation_prof(c,1) = 1./dzsoi_decomp(1) + ndep_prof(c,1) = 1./dzsoi_decomp(1) + endif + end do + + else + + ! for one layer decomposition model, set profiles to unity + leaf_prof(begp:endp, :) = 1._r8 + froot_prof(begp:endp, :) = 1._r8 + croot_prof(begp:endp, :) = 1._r8 + stem_prof(begp:endp, :) = 1._r8 + nfixation_prof(begc:endc, :) = 1._r8 + ndep_prof(begc:endc, :) = 1._r8 + + end if + + + ! check to make sure integral of all profiles = 1. + do fc = 1,num_soilc + c = filter_soilc(fc) + ndep_prof_sum = 0. + nfixation_prof_sum = 0. + do j = 1, nlevdecomp + ndep_prof_sum = ndep_prof_sum + ndep_prof(c,j) * dzsoi_decomp(j) + nfixation_prof_sum = nfixation_prof_sum + nfixation_prof(c,j) * dzsoi_decomp(j) + end do + if ( ( abs(ndep_prof_sum - 1._r8) > delta ) .or. ( abs(nfixation_prof_sum - 1._r8) > delta ) ) then + write(iulog, *) 'profile sums: ', ndep_prof_sum, nfixation_prof_sum + write(iulog, *) 'c: ', c + write(iulog, *) 'altmax_lastyear_indx: ', altmax_lastyear_indx(c) + write(iulog, *) 'nfixation_prof: ', nfixation_prof(c,:) + write(iulog, *) 'ndep_prof: ', ndep_prof(c,:) + write(iulog, *) 'cinput_rootfr: ', cinput_rootfr(c,:) + write(iulog, *) 'dzsoi_decomp: ', dzsoi_decomp(:) + write(iulog, *) 'surface_prof: ', surface_prof(:) + write(iulog, *) 'npfts(c): ', col%npatches(c) + do p = col%patchi(c), col%patchi(c) + col%npatches(c) -1 + write(iulog, *) 'p, itype(p), wtcol(p): ', p, patch%itype(p), patch%wtcol(p) + write(iulog, *) 'cinput_rootfr(p,:): ', cinput_rootfr(p,:) + end do + call endrun(msg=" ERROR: _prof_sum-1>delta"//errMsg(__FILE__, __LINE__)) + endif + end do + + do fp = 1,num_soilp + p = filter_soilp(fp) + froot_prof_sum = 0. + croot_prof_sum = 0. + leaf_prof_sum = 0. + stem_prof_sum = 0. + do j = 1, nlevdecomp + froot_prof_sum = froot_prof_sum + froot_prof(p,j) * dzsoi_decomp(j) + croot_prof_sum = croot_prof_sum + croot_prof(p,j) * dzsoi_decomp(j) + leaf_prof_sum = leaf_prof_sum + leaf_prof(p,j) * dzsoi_decomp(j) + stem_prof_sum = stem_prof_sum + stem_prof(p,j) * dzsoi_decomp(j) + end do + if ( ( abs(froot_prof_sum - 1._r8) > delta ) .or. ( abs(croot_prof_sum - 1._r8) > delta ) .or. & + ( abs(stem_prof_sum - 1._r8) > delta ) .or. ( abs(leaf_prof_sum - 1._r8) > delta ) ) then + write(iulog, *) 'profile sums: ', froot_prof_sum, croot_prof_sum, leaf_prof_sum, stem_prof_sum + call endrun(msg=' ERROR: sum-1 > delta'//errMsg(__FILE__, __LINE__)) + endif + end do + + end associate + + end subroutine SoilBiogeochemVerticalProfile + +end module SoilBiogeochemVerticalProfileMod diff --git a/components/clm/src/unit_test_shr/CMakeLists.txt b/components/clm/src/unit_test_shr/CMakeLists.txt new file mode 100644 index 0000000000..2779d4fb62 --- /dev/null +++ b/components/clm/src/unit_test_shr/CMakeLists.txt @@ -0,0 +1,9 @@ +list(APPEND clm_sources + unittestTimeManagerMod.F90 + unittestSubgridMod.F90 + unittestSimpleSubgridSetupsMod.F90 + unittestArrayMod.F90 + unittestFilterBuilderMod.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/unit_test_shr/test/CMakeLists.txt b/components/clm/src/unit_test_shr/test/CMakeLists.txt new file mode 100644 index 0000000000..cdb1cdeb72 --- /dev/null +++ b/components/clm/src/unit_test_shr/test/CMakeLists.txt @@ -0,0 +1,2 @@ +add_subdirectory(unittestArray_test) +add_subdirectory(unittestFilterBuilder_test) diff --git a/components/clm/src/unit_test_shr/test/unittestArray_test/CMakeLists.txt b/components/clm/src/unit_test_shr/test/unittestArray_test/CMakeLists.txt new file mode 100644 index 0000000000..9a18380545 --- /dev/null +++ b/components/clm/src/unit_test_shr/test/unittestArray_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(unittestArray test_unittestArray_exe + "test_unittestArray.pf" "") + +target_link_libraries(test_unittestArray_exe clm csm_share) \ No newline at end of file diff --git a/components/clm/src/unit_test_shr/test/unittestArray_test/test_unittestArray.pf b/components/clm/src/unit_test_shr/test/unittestArray_test/test_unittestArray.pf new file mode 100644 index 0000000000..e84c98d2b5 --- /dev/null +++ b/components/clm/src/unit_test_shr/test/unittestArray_test/test_unittestArray.pf @@ -0,0 +1,63 @@ +module test_unittestArray + + ! Tests of unittestArrayMod + + use pfunit_mod + use unittestArrayMod + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod + use shr_kind_mod , only : r8 => shr_kind_r8 + + implicit none + + @TestCase + type, extends(TestCase) :: TestUnittestArray + contains + procedure :: setUp + procedure :: tearDown + end type TestUnittestArray + +contains + + subroutine setUp(this) + class(TestUnittestArray), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestUnittestArray), intent(inout) :: this + + call unittest_subgrid_teardown() + end subroutine tearDown + + @Test + subroutine col_array_returnsColArray(this) + class(TestUnittestArray), intent(inout) :: this + real(r8), allocatable :: arr(:) + + call unittest_subgrid_setup_start() + call create_gridcell_single_veg_patch(1) + call create_gridcell_single_veg_patch(2) + call unittest_subgrid_setup_end() + + arr = col_array() + + @assertEqual((bounds%endc-bounds%begc+1), size(arr)) + + end subroutine col_array_returnsColArray + + @Test + subroutine col_array_setsVal(this) + class(TestUnittestArray), intent(inout) :: this + real(r8), allocatable :: arr(:) + + call unittest_subgrid_setup_start() + call create_gridcell_single_veg_patch(1) + call create_gridcell_single_veg_patch(2) + call unittest_subgrid_setup_end() + + arr = col_array(17._r8) + + @assertEqual([17._r8, 17._r8], arr) + end subroutine col_array_setsVal + +end module test_unittestArray diff --git a/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/CMakeLists.txt b/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/CMakeLists.txt new file mode 100644 index 0000000000..c767479aee --- /dev/null +++ b/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(unittestFilterBuilder test_filterBuilder_exe + "test_filterBuilder.pf" "") + +target_link_libraries(test_filterBuilder_exe clm csm_share) \ No newline at end of file diff --git a/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/test_filterBuilder.pf b/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/test_filterBuilder.pf new file mode 100644 index 0000000000..58674110a9 --- /dev/null +++ b/components/clm/src/unit_test_shr/test/unittestFilterBuilder_test/test_filterBuilder.pf @@ -0,0 +1,46 @@ +module test_filterBuilder + + ! Tests of unittestFilterBuilder + + use pfunit_mod + use unittestFilterBuilderMod + + implicit none + save + +contains + + ! ======================================================================== + ! Tests of filter_from_range + ! ======================================================================== + + @Test + subroutine test_filter_from_range_multipoint() + integer :: numf + integer, allocatable :: filter(:) + + call filter_from_range(start=3, end=5, numf=numf, filter=filter) + @assertEqual(3, numf) + @assertEqual([3,4,5], filter) + end subroutine test_filter_from_range_multipoint + + @Test + subroutine test_filter_from_range_onepoint() + integer :: numf + integer, allocatable :: filter(:) + + call filter_from_range(start=3, end=3, numf=numf, filter=filter) + @assertEqual(1, numf) + @assertEqual([3], filter) + end subroutine test_filter_from_range_onepoint + + @Test + subroutine test_filter_from_range_nopoints() + integer :: numf + integer, allocatable :: filter(:) + + call filter_from_range(start=3, end=1, numf=numf, filter=filter) + @assertEqual(0, numf) + end subroutine test_filter_from_range_nopoints + +end module test_filterBuilder diff --git a/components/clm/src/unit_test_shr/unittestArrayMod.F90 b/components/clm/src/unit_test_shr/unittestArrayMod.F90 new file mode 100644 index 0000000000..8573a01166 --- /dev/null +++ b/components/clm/src/unit_test_shr/unittestArrayMod.F90 @@ -0,0 +1,51 @@ +module unittestArrayMod + + ! Provides utility functions for working with array inputs to (or outputs from) + ! subroutines. + ! + ! The routines here assume that the subgrid structure has been set up via + ! unittestSubgridMod. + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use unittestSubgridMod, only : bounds + + implicit none + private + save + + public :: col_array ! create a column-level array + +contains + + !----------------------------------------------------------------------- + pure function col_array(val) + ! + ! !DESCRIPTION: + ! Creates a column-level array. + ! + ! If val is provided, all elements of the array are set to val; if not, all elements + ! are set to NaN. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), allocatable :: col_array(:) ! function result + real(r8), intent(in), optional :: val ! if provided, all elements in col_array are set to val + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'col_array' + !----------------------------------------------------------------------- + + allocate(col_array(bounds%begc:bounds%endc)) + if (present(val)) then + col_array(:) = val + else + col_array(:) = nan + end if + + end function col_array + + +end module unittestArrayMod diff --git a/components/clm/src/unit_test_shr/unittestFilterBuilderMod.F90 b/components/clm/src/unit_test_shr/unittestFilterBuilderMod.F90 new file mode 100644 index 0000000000..d3ddf4a3a4 --- /dev/null +++ b/components/clm/src/unit_test_shr/unittestFilterBuilderMod.F90 @@ -0,0 +1,44 @@ +module unittestFilterBuilderMod + + ! This module builds simple filters that can be used as inputs to routines that require + ! a filter. + + implicit none + private + save + + public :: filter_from_range ! build a filter that includes all points between a start and end index + +contains + + !----------------------------------------------------------------------- + subroutine filter_from_range(start, end, numf, filter) + ! + ! !DESCRIPTION: + ! Build a filter that includes all points between a start and end index + ! + ! Allocates the 'filter' argument + ! + ! !ARGUMENTS: + integer, intent(in) :: start ! start index to include + integer, intent(in) :: end ! end index to include + integer, intent(out) :: numf ! number of points in the filter + integer, allocatable, intent(out) :: filter(:) + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'filter_from_list' + !----------------------------------------------------------------------- + + numf = end - start + 1 + numf = max(numf, 0) + + allocate(filter(numf)) + do i = 1, numf + filter(i) = start + i - 1 + end do + + end subroutine filter_from_range + +end module unittestFilterBuilderMod diff --git a/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 b/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 new file mode 100644 index 0000000000..41f4b4c077 --- /dev/null +++ b/components/clm/src/unit_test_shr/unittestSimpleSubgridSetupsMod.F90 @@ -0,0 +1,121 @@ +module unittestSimpleSubgridSetupsMod + + ! This module provides wrappers to unittestSubgridMod, which give you a variety of + ! simple subgrid setups. + ! + ! Note that these routines do everything needed with the subgrid setup. So once you + ! call these routines, you cannot add any more gridcells, landunits, etc. + + use unittestSubgridMod + use shr_kind_mod , only : r8 => shr_kind_r8 + use landunit_varcon, only : istsoil + + implicit none + private + save + + ! ------------------------------------------------------------------------ + ! Routines that do everything needed with the subgrid setup, including the begin & end + ! call. Once you call these routines, you cannot add any more gridcells, landunits, etc. + ! ------------------------------------------------------------------------ + + ! Create a grid that has a single gridcell with a single vegetated patch + public :: setup_single_veg_patch + + ! Create a grid that has N grid cells, each with a single vegetated patch + public :: setup_ncells_single_veg_patch + + ! ------------------------------------------------------------------------ + ! Routines that create a single grid cell with certain properties. You can do other + ! subgrid setup (creating other grid cells) before and after this. + ! ------------------------------------------------------------------------ + + ! Create a grid cell that is 100% natural veg, with a single patch + public :: create_gridcell_single_veg_patch + +contains + + ! ======================================================================== + ! Routines that do everything needed with the subgrid setup, including the begin & end + ! call. Once you call these routines, you cannot add any more gridcells, landunits, etc. + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine setup_single_veg_patch(pft_type) + ! + ! !DESCRIPTION: + ! Create a grid that has a single gridcell with a single vegetated patch, with veg + ! type given by the pft_type argument + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: pft_type ! the type of the single vegetated patch + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'setup_single_veg_patch' + !----------------------------------------------------------------------- + + call setup_ncells_single_veg_patch(ncells=1, pft_type=pft_type) + + end subroutine setup_single_veg_patch + + !----------------------------------------------------------------------- + subroutine setup_ncells_single_veg_patch(ncells, pft_type) + ! + ! !DESCRIPTION: + ! Create a grid that has ncells grid cells, each with a single vegetated patch. All + ! vegetated patches have the same type, given by pft_type. + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: ncells ! number of grid cells + integer, intent(in) :: pft_type ! pft type + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'setup_ncells_single_veg_patch' + !----------------------------------------------------------------------- + + call unittest_subgrid_setup_start() + do i = 1, ncells + call create_gridcell_single_veg_patch(pft_type = pft_type) + end do + call unittest_subgrid_setup_end() + + end subroutine setup_ncells_single_veg_patch + + + ! ======================================================================== + ! Routines that create a single grid cell with certain properties. You can do other + ! subgrid setup (creating other grid cells) before and after this. + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine create_gridcell_single_veg_patch(pft_type) + ! + ! !DESCRIPTION: + ! Create a grid cell that is 100% natural veg, with a single patch + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: pft_type ! the type of the single vegetated patch + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_gridcell_single_veg_patch' + !----------------------------------------------------------------------- + + call unittest_add_gridcell() + call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=1.0_r8) + call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + call unittest_add_patch(my_ci=ci, ptype=pft_type, wtcol=1.0_r8) + + end subroutine create_gridcell_single_veg_patch + + +end module unittestSimpleSubgridSetupsMod diff --git a/components/clm/src/unit_test_shr/unittestSubgridMod.F90 b/components/clm/src/unit_test_shr/unittestSubgridMod.F90 new file mode 100644 index 0000000000..bfa37ff5d9 --- /dev/null +++ b/components/clm/src/unit_test_shr/unittestSubgridMod.F90 @@ -0,0 +1,394 @@ +module unittestSubgridMod + + ! Provides routines to aid with the setup of subgrid structure for unit tests that need + ! it. + ! + ! In the setup for a test, the following should be done: + ! + ! (1) call unittest_subgrid_setup_start + ! Note: if explicitly setting nlevsno, that must be done *before* the call to + ! unittest_subgrid_setup_start + ! (2) add grid cells, landunits, columns & pfts as desired, using the routines defined in + ! this module (i.e., using unittest_add_landunit, etc. - NOT directly via add_landunit, etc.) + ! (3) call unittest_subgrid_setup_end + ! + ! Example: To add a single grid cell, with two landunits (nat. veg. and icemec), with a + ! single column on the nat veg landunit, the following can be done: + ! + ! call unittest_subgrid_setup_start() + ! call unittest_add_gridcell() + ! call unittest_add_landunit(my_gi=gi, ltype=istsoil, wtgcell=0.4_r8) + ! call unittest_add_column(my_li=li, ctype=1, wtlunit=1.0_r8) + ! c_soil = ci + ! call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=0.6_r8) + ! call unittest_subgrid_setup_end() + ! + ! A few things to note about this example: + ! (1) Note the use of gi, li and ci to get the index of the most recently-added grid + ! cell / landunit / column + ! (2) Note that not all subgrid information has been filled in: no patches were added + ! to the soil landunit, and no columns or patches were added to the icemec + ! landunit. This is because this extra level of detail wasn't needed for this + ! particular unit test. This omission is perfectly acceptable. + ! + ! In the teardown for a test, the following should be done: + ! + ! (1) call unittest_subgrid_teardown + + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + + implicit none + private + save + + ! ------------------------------------------------------------------------ + ! Public entities + ! ------------------------------------------------------------------------ + + ! Public routines + public :: unittest_subgrid_setup_start ! do the initial setup of subgrid stuff needed for unit testing + public :: unittest_subgrid_setup_end ! do the last part of setup + public :: unittest_subgrid_teardown ! do any teardown needed for the subgrid stuff + public :: unittest_add_gridcell ! add a grid cell + public :: unittest_add_landunit ! add a landunit + public :: unittest_add_column ! add a column + public :: unittest_add_patch ! add a patch + + ! bounds info, which can be passed to routines that need it + ! Note that the end indices here (endg, endl, endc, endp) will be the final indices in + ! use, in contrast to the module-level endg, endl, etc., which give the final indices + ! of the allocated arrays. + type(bounds_type), public, protected :: bounds + + ! Indices of last grid cell / landunit / column / patch added + integer, public, protected :: gi + integer, public, protected :: li + integer, public, protected :: ci + integer, public, protected :: pi + + ! Maximum array sizes at each level + integer, parameter, public :: numg = 3 + integer, parameter, public :: numl = 30 + integer, parameter, public :: numc = 50 + integer, parameter, public :: nump = 100 + + ! Indices of initial grid cell / landunit / column / patch + ! + ! Note that we do NOT start at 1, in order to catch any code that assumes indices start + ! at 1. + integer, parameter, public :: begg = 11 + integer, parameter, public :: begl = 21 + integer, parameter, public :: begc = 31 + integer, parameter, public :: begp = 41 + + ! Indices of final grid cell / landunit / column / patch + ! Note that these are the final indices of the allocated arrays, which may be greater + ! than the final index that is actually used for a given test. + integer, parameter, public :: endg = begg + numg - 1 + integer, parameter, public :: endl = begl + numl - 1 + integer, parameter, public :: endc = begc + numc - 1 + integer, parameter, public :: endp = begp + nump - 1 + + ! ------------------------------------------------------------------------ + ! Private entities + ! ------------------------------------------------------------------------ + + integer, private :: nlevsno_orig ! original value of nlevsno, saved so we can restore it later + logical, private :: nlevsno_set ! whether we set nlevsno here + +contains + + !----------------------------------------------------------------------- + subroutine unittest_subgrid_setup_start + ! + ! !DESCRIPTION: + ! Do the initial setup of subgrid stuff needed for unit testing. This should be + ! called for each test. + ! + ! !USES: + use clm_varpar, only : natpft_lb + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_subgrid_setup_start' + !----------------------------------------------------------------------- + + call initialize_arrays + + ! Initialize local module variables + + gi = begg - 1 + li = begl - 1 + ci = begc - 1 + pi = begp - 1 + + ! Initialize other variables needed for the subgrid setup + + natpft_lb = 0 + + end subroutine unittest_subgrid_setup_start + + !----------------------------------------------------------------------- + subroutine unittest_subgrid_setup_end + ! + ! !DESCRIPTION: + ! Do the last part of setup. This should be called after adding all of the landunits, + ! columns, pfts, etc. for the test. + ! + ! !USES: + use initSubgridMod, only : clm_ptrs_compdown + use subgridWeightsMod, only : compute_higher_order_weights + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_subgrid_setup_end' + !----------------------------------------------------------------------- + + call set_bounds + call clm_ptrs_compdown(bounds) + call compute_higher_order_weights(bounds) + + end subroutine unittest_subgrid_setup_end + + !----------------------------------------------------------------------- + subroutine set_bounds + ! + ! !DESCRIPTION: + ! Create the bounds derived type object + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_bounds' + !----------------------------------------------------------------------- + + bounds%begg = begg + bounds%endg = gi + bounds%begl = begl + bounds%endl = li + bounds%begc = begc + bounds%endc = ci + bounds%begp = begp + bounds%endp = pi + + ! Currently, not setting bounds%level and bounds%clump_index + + end subroutine set_bounds + + + + !----------------------------------------------------------------------- + subroutine initialize_arrays + ! + ! !DESCRIPTION: + ! Allocate subgrid arrays, and initialize them to default values. + ! + ! !USES: + use landunit_varcon , only : max_lunit + use clm_varcon , only : ispval + use GridcellType , only : grc + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : patch + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'initialize_arrays' + !----------------------------------------------------------------------- + + ! column initialization depends on the nlevsno runtime parameter, so we first need to + ! set that + call init_nlevsno() + + call grc%Init(begg, endg) + call lun%Init(begl, endl) + call col%Init(begc, endc) + call patch%init(begp, endp) + + end subroutine initialize_arrays + + !----------------------------------------------------------------------- + subroutine unittest_subgrid_teardown + ! + ! !DESCRIPTION: + ! Do any teardown needed for the subgrid stuff + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_subgrid_teardown' + !----------------------------------------------------------------------- + + call grc%clean + call lun%clean + call col%clean + call patch%clean + + call reset_nlevsno() + + end subroutine unittest_subgrid_teardown + + !----------------------------------------------------------------------- + subroutine unittest_add_gridcell() + ! + ! !DESCRIPTION: + ! Add a grid cell. The index of the just-added grid cell can be obtained from the + ! module-level variable, gi. + ! + ! Unlike add_landunit, add_column and add_patch, this is specific to the unit test + ! code, because no such routine is needed in the production code + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_add_gridcell' + !----------------------------------------------------------------------- + + gi = gi + 1 + + end subroutine unittest_add_gridcell + + !----------------------------------------------------------------------- + subroutine unittest_add_landunit(my_gi, ltype, wtgcell) + ! + ! !DESCRIPTION: + ! Add a landunit, and make it active. The index of the just-added landunit can be + ! obtained from the module-level variable, li. + ! + ! This is simply a wrapper to the routine in initSubgridMod. We provide this for two + ! reasons: + ! + ! (1) To allow the module-level li variable to be protected + ! + ! (2) To insulate most of the unit test code from any changes in the interface to + ! add_landunit + ! + ! !USES: + use initSubgridMod, only : add_landunit + ! + ! !ARGUMENTS: + integer , intent(in) :: my_gi ! grid cell index on which this landunit should be placed + integer , intent(in) :: ltype ! landunit type + real(r8) , intent(in) :: wtgcell ! weight of the landunit relative to the grid cell + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_add_landunit' + !----------------------------------------------------------------------- + + call add_landunit(li=li, gi=my_gi, ltype=ltype, wtgcell=wtgcell) + lun%active(li) = .true. + + end subroutine unittest_add_landunit + + !----------------------------------------------------------------------- + subroutine unittest_add_column(my_li, ctype, wtlunit) + ! + ! !DESCRIPTION: + ! Add a column, and make it active. The index of the just-added column can be obtained + ! from the module-level variable, ci. + ! + ! This is simply a wrapper to the routine in initSubgridMod. We provide this for two + ! reasons: + ! + ! (1) To allow the module-level ci variable to be protected + ! + ! (2) To insulate most of the unit test code from any changes in the interface to + ! add_column + ! + ! !USES: + use initSubgridMod, only : add_column + ! + ! !ARGUMENTS: + integer , intent(in) :: my_li ! landunit index on which this column should be placed + integer , intent(in) :: ctype ! column type + real(r8) , intent(in) :: wtlunit ! weight of the column relative to the land unit + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_add_column' + !----------------------------------------------------------------------- + + call add_column(ci=ci, li=my_li, ctype=ctype, wtlunit=wtlunit) + col%active(ci) = .true. + + end subroutine unittest_add_column + + !----------------------------------------------------------------------- + subroutine unittest_add_patch(my_ci, ptype, wtcol) + ! + ! !DESCRIPTION: + ! Add a patch, and make it active. The index of the just-added patch can be obtained + ! from the module-level variable, pi. + ! + ! This is simply a wrapper to the routine in initSubgridMod. We provide this for two + ! reasons: + ! + ! (1) To allow the module-level pi variable to be protected + ! + ! (2) To insulate most of the unit test code from any changes in the interface to + ! add_patch + ! + ! !USES: + use initSubgridMod, only : add_patch + ! + ! !ARGUMENTS: + integer , intent(in) :: my_ci ! column index on which this patch should be placed + integer , intent(in) :: ptype ! patch type + real(r8) , intent(in) :: wtcol ! weight of the patch relative to the column + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_add_patch' + !----------------------------------------------------------------------- + + call add_patch(pi=pi, ci=my_ci, ptype=ptype, wtcol=wtcol) + patch%active(pi) = .true. + + end subroutine unittest_add_patch + + subroutine init_nlevsno() + ! Initialize nlevsno to a reasonable value, if it is not already set + + use clm_varpar, only : nlevsno + + if (nlevsno <= 0) then + nlevsno_orig = nlevsno + nlevsno = 5 + nlevsno_set = .true. + else + nlevsno_set = .false. + end if + end subroutine init_nlevsno + + subroutine reset_nlevsno + ! If we set nlevsno in init_nlevsno, then reset it to its original value + + use clm_varpar, only : nlevsno + + if (nlevsno_set) then + nlevsno = nlevsno_orig + end if + end subroutine reset_nlevsno + +end module unittestSubgridMod diff --git a/components/clm/src/unit_test_shr/unittestTimeManagerMod.F90 b/components/clm/src/unit_test_shr/unittestTimeManagerMod.F90 new file mode 100644 index 0000000000..ae35754758 --- /dev/null +++ b/components/clm/src/unit_test_shr/unittestTimeManagerMod.F90 @@ -0,0 +1,190 @@ +module unittestTimeManagerMod + + ! This module provides wrappers to the clm_time_manager, which facilitate configuring + ! the time manager as desired for each unit test. + ! + ! In the setup for a test, the following should be done: + ! + ! (1) call unittest_timemgr_setup + ! + ! (2) optionally (if the unit test needs a specific date/time): call + ! unittest_timemgr_set_curr_date + ! + ! In the teardown for any test that called unittest_timemgr_init, the following should + ! be done: + ! + ! (1) call unittest_timemgr_teardown + ! + ! + ! Note that there are still some test-specific routines in clm_time_manager. Those + ! include (a) routines that have info that is closely tied to info already in + ! clm_time_manager (e.g., timemgr_reset, which needs to reset all module data + ! defined in clm_time_manager), and/or (b) routines that modify data that are private to + ! clm_time_manager. The routines in this unittest-specific file, in contrast, tend to be + ! higher-level wrappers. + + implicit none + private + save + + ! Public routines + public :: unittest_timemgr_setup ! do the initial setup of the time manager + public :: unittest_timemgr_set_curr_date ! set the current date + public :: unittest_timemgr_teardown ! tear down the time manager at the end of a test + public :: unittest_timemgr_set_curr_year ! set the current year, keeping other date components unchanged + +contains + + !----------------------------------------------------------------------- + subroutine unittest_timemgr_setup(dtime) + ! + ! !DESCRIPTION: + ! Set up the time manager for each unit test. + ! + ! Should be called once for every test that uses the time manager. + ! + ! !USES: + use ESMF, only : ESMF_Initialize, ESMF_SUCCESS + use clm_time_manager, only : set_timemgr_init, timemgr_init, NO_LEAP_C + ! + ! !ARGUMENTS: + integer, intent(in), optional :: dtime ! time step (seconds) + ! + ! !LOCAL VARIABLES: + integer :: l_dtime ! local version of dtime + integer :: rc ! return code + + integer, parameter :: dtime_default = 1800 ! time step (seconds) + + ! 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 + integer, parameter :: curr_yr = 1 + integer, parameter :: curr_mon = 1 + integer, parameter :: curr_day = 1 + integer, parameter :: curr_tod = 0 + + character(len=*), parameter :: subname = 'unittest_timemgr_setup' + !----------------------------------------------------------------------- + + if (present(dtime)) then + l_dtime = dtime + else + l_dtime = dtime_default + end if + + call ESMF_Initialize(rc=rc) + if (rc /= ESMF_SUCCESS) then + stop 'Error in ESMF_Initialize' + end if + + call set_timemgr_init( & + calendar_in = NO_LEAP_C, & + start_ymd_in = start_ymd, & + 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() + + call unittest_timemgr_set_curr_date( & + yr = curr_yr, & + mon = curr_mon, & + day = curr_day, & + tod = curr_tod) + + end subroutine unittest_timemgr_setup + + !----------------------------------------------------------------------- + subroutine unittest_timemgr_set_curr_date(yr, mon, day, tod) + ! + ! !DESCRIPTION: + ! Set the current model date in the time manager. + ! + ! !USES: + use clm_time_manager, only : for_test_set_curr_date + ! + ! !ARGUMENTS: + integer, intent(in) :: yr ! year + integer, intent(in) :: mon ! month + integer, intent(in) :: day ! day of month + integer, intent(in) :: tod ! time of day (seconds past 0Z) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'unittest_timemgr_set_curr_date' + !----------------------------------------------------------------------- + + call for_test_set_curr_date(yr, mon, day, tod) + + end subroutine unittest_timemgr_set_curr_date + + !----------------------------------------------------------------------- + subroutine unittest_timemgr_set_curr_year(yr) + ! + ! !DESCRIPTION: + ! Set the current model year, keeping other date components unchanged + ! + ! !USES: + use clm_time_manager, only : get_curr_date + ! + ! !ARGUMENTS: + integer, intent(in) :: yr ! new year + ! + ! !LOCAL VARIABLES: + integer :: curr_yr + integer :: curr_mon + integer :: curr_day + integer :: curr_tod + + character(len=*), parameter :: subname = 'unittest_timemgr_set_curr_year' + !----------------------------------------------------------------------- + + call get_curr_date(curr_yr, curr_mon, curr_day, curr_tod) + call unittest_timemgr_set_curr_date(yr, curr_mon, curr_day, curr_tod) + + end subroutine unittest_timemgr_set_curr_year + + + + !----------------------------------------------------------------------- + subroutine unittest_timemgr_teardown + ! + ! !DESCRIPTION: + ! Tear down the time manager from each unit test. + ! + ! Should be called once at the end of every test that set up the time manager. + ! + ! !USES: + use ESMF, only : ESMF_Finalize, ESMF_SUCCESS + use clm_time_manager, only : timemgr_reset + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: rc ! return code + + character(len=*), parameter :: subname = 'unittest_timemgr_teardown' + !----------------------------------------------------------------------- + + call timemgr_reset() + + call ESMF_Finalize(rc=rc) + if (rc /= ESMF_SUCCESS) then + stop 'Error in ESMF_Finalize' + end if + + end subroutine unittest_timemgr_teardown + + +end module unittestTimeManagerMod diff --git a/components/clm/src/unit_test_stubs/CMakeLists.txt b/components/clm/src/unit_test_stubs/CMakeLists.txt new file mode 100644 index 0000000000..38abfb1633 --- /dev/null +++ b/components/clm/src/unit_test_stubs/CMakeLists.txt @@ -0,0 +1,8 @@ +add_subdirectory(csm_share) +add_subdirectory(dyn_subgrid) +add_subdirectory(main) +add_subdirectory(utils) + +sourcelist_to_parent(clm_sources) +sourcelist_to_parent(clm_genf90_sources) +sourcelist_to_parent(share_sources) diff --git a/components/clm/src/unit_test_stubs/csm_share/CMakeLists.txt b/components/clm/src/unit_test_stubs/csm_share/CMakeLists.txt new file mode 100644 index 0000000000..f3f2f3898a --- /dev/null +++ b/components/clm/src/unit_test_stubs/csm_share/CMakeLists.txt @@ -0,0 +1,6 @@ +list(APPEND share_sources + mct_mod_stub.F90 + shr_mpi_mod_stub.F90 + ) + +sourcelist_to_parent(share_sources) diff --git a/components/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 b/components/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 new file mode 100644 index 0000000000..af5ae53b54 --- /dev/null +++ b/components/clm/src/unit_test_stubs/csm_share/mct_mod_stub.F90 @@ -0,0 +1,30 @@ +module mct_mod + + ! This is a stub of mct_mod, which only includes the bare minimum needed to build CLM + ! unit tests + + implicit none + + public :: mct_gsMap + public :: mct_gsMap_OP + + type mct_gsMap + ! Empty, dummy type + end type mct_gsMap + +contains + + subroutine mct_gsMap_OP(GSMap, PEno, Points) + ! Stub routine that simply matches the signature of mct_gsMap_OP + ! this routine allocates the Points array, to match the documented behavior of the + ! real routine. This is needed so that a later deallocate will succeed. But note that + ! it is just allocated to be of size 1, so it cannot be used for any real + ! calculations. + type(mct_gsMap), intent(in) :: GSMap + integer, intent(in) :: PEno + integer,dimension(:),pointer :: Points + + allocate(Points(1)) + end subroutine mct_gsMap_OP + +end module mct_mod diff --git a/components/clm/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 b/components/clm/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 new file mode 100644 index 0000000000..7a51d56ed9 --- /dev/null +++ b/components/clm/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 @@ -0,0 +1,469 @@ +!=============================================================================== +! SVN $Id: shr_mpi_mod.F90 59033 2014-04-11 01:55:15Z santos@ucar.edu $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723/shr/shr_mpi_mod.F90 $ +!=============================================================================== + +Module shr_mpi_mod + +!------------------------------------------------------------------------------- +! PURPOSE: general layer on MPI functions +!------------------------------------------------------------------------------- + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + private + +! PUBLIC: Public interfaces + + public :: shr_mpi_chkerr + public :: shr_mpi_bcast + public :: shr_mpi_commsize + public :: shr_mpi_commrank + public :: shr_mpi_initialized + public :: shr_mpi_abort + public :: shr_mpi_barrier + public :: shr_mpi_init + public :: shr_mpi_finalize + + interface shr_mpi_bcast ; module procedure & + shr_mpi_bcastc0, & + shr_mpi_bcastc1, & + shr_mpi_bcastl0, & + shr_mpi_bcastl1, & + shr_mpi_bcasti0, & + shr_mpi_bcasti1, & + shr_mpi_bcasti2, & + shr_mpi_bcastr0, & + shr_mpi_bcastr1, & + shr_mpi_bcastr2, & + shr_mpi_bcastr3 + end interface + +!=============================================================================== +CONTAINS +!=============================================================================== + +SUBROUTINE shr_mpi_chkerr(rcode,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: rcode ! input MPI error code + character(*), intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_chkerr) ' + +!------------------------------------------------------------------------------- +! PURPOSE: layer on MPI error checking +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_chkerr + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast an integer +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastl0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a logical +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastl0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastc0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a character string +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastc0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastc1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec(:) ! 1D vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a character string +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastc1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a real +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a vector of integers +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastl1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec(:) ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a logical +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastl1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a vector of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_bcastr2) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 2d array of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr2 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + integer, intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + character(*),parameter :: subName = '(shr_mpi_bcasti2) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 2d array of integers +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti2 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr3(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:,:) ! array, 3d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + character(*),parameter :: subName = '(shr_mpi_bcastr3) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 3d array of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr3 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_commsize(comm,size,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: size + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commsize) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI commsize +!------------------------------------------------------------------------------- + size = 1 + +END SUBROUTINE shr_mpi_commsize + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_commrank(comm,rank,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: rank + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commrank) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI commrank +!------------------------------------------------------------------------------- + rank = 0 + +END SUBROUTINE shr_mpi_commrank + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_initialized(flag,string) + + IMPLICIT none + + !----- arguments --- + logical,intent(out) :: flag + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_initialized) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI initialized +!------------------------------------------------------------------------------- + flag = .true. + +END SUBROUTINE shr_mpi_initialized + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_abort(string,rcode) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + integer,optional,intent(in) :: rcode ! optional code + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_abort) ' + integer :: rc ! return code + +!------------------------------------------------------------------------------- +! PURPOSE: MPI abort +!------------------------------------------------------------------------------- + + if ( present(string) .and. present(rcode) ) then + write(s_logunit,*) trim(subName),":",trim(string),rcode + endif + if ( present(rcode) )then + rc = rcode + else + rc = 1001 + end if + stop + +END SUBROUTINE shr_mpi_abort + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_barrier(comm,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_barrier) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI barrier +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_barrier + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_init(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_init) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI init +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_init + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_finalize(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + +!------------------------------------------------------------------------------- +! PURPOSE: MPI finalize +!------------------------------------------------------------------------------- + if ( present(string) ) & + write(s_logunit,*) trim(string) + call shr_mpi_abort("MPI Finalize") + +END SUBROUTINE shr_mpi_finalize + +!=============================================================================== +!=============================================================================== + +END MODULE shr_mpi_mod diff --git a/components/clm/src/unit_test_stubs/dyn_subgrid/CMakeLists.txt b/components/clm/src/unit_test_stubs/dyn_subgrid/CMakeLists.txt new file mode 100644 index 0000000000..af20f4bbd0 --- /dev/null +++ b/components/clm/src/unit_test_stubs/dyn_subgrid/CMakeLists.txt @@ -0,0 +1,5 @@ +list(APPEND clm_sources + dynFileMod_stub.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 b/components/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 new file mode 100644 index 0000000000..a07c8eec13 --- /dev/null +++ b/components/clm/src/unit_test_stubs/dyn_subgrid/dynFileMod_stub.F90 @@ -0,0 +1,47 @@ +module dynFileMod + + ! This is a stub replacement for dynFileMod. It bypasses all of the netcdf-related + ! stuff, instead allowing direct specification of the possible set of years and the + ! current year. Thus, it is essentially just a wrapper to a dyn_time_info variable. + + use dynTimeInfoMod, only : time_info_type, YEAR_POSITION_END_OF_TIMESTEP + use ncdio_pio, only : file_desc_t + implicit none + save + private + + public :: dyn_file_type + + ! Note that this is intended to be used with the fake form of file_desc_t, defined in + ! ncdio_pio_fake.F90 + type, extends(file_desc_t) :: dyn_file_type + type(time_info_type) :: time_info + end type dyn_file_type + + interface dyn_file_type + module procedure constructor ! initialize a new dyn_file_type object + end interface dyn_file_type + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + type(dyn_file_type) function constructor(my_years) + ! Note that this should be used with the fake form of file_desc_t, defined in + ! ncdio_pio_fake.F90 + ! + ! The time_info object is created assuming we want to use + ! year_position=YEAR_POSITION_END_OF_TIMESTEP + + integer, intent(in) :: my_years(:) ! all years desired for the time_info variable + + ! The following only works if we're using the fake form of file_desc_t, defined in + ! ncdio_pio_fake.F90 + constructor%file_desc_t = file_desc_t() + + constructor%time_info = time_info_type(my_years, YEAR_POSITION_END_OF_TIMESTEP) + end function constructor + +end module dynFileMod diff --git a/components/clm/src/unit_test_stubs/main/CMakeLists.txt b/components/clm/src/unit_test_stubs/main/CMakeLists.txt new file mode 100644 index 0000000000..946d8de72e --- /dev/null +++ b/components/clm/src/unit_test_stubs/main/CMakeLists.txt @@ -0,0 +1,19 @@ +set(genf90_files + ncdio_pio_fake.F90.in + ncdio_var.F90.in + ) + +process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_SOURCE_DIR} clm_genf90_sources) + +sourcelist_to_parent(clm_genf90_sources) + +list(APPEND clm_sources "${clm_genf90_sources}") + +list(APPEND clm_sources + GetGlobalValuesMod_stub.F90 + histFileMod_stub.F90 + ncdio_pio_fake.F90 + ncdio_var.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/unit_test_stubs/main/GetGlobalValuesMod_stub.F90 b/components/clm/src/unit_test_stubs/main/GetGlobalValuesMod_stub.F90 new file mode 100644 index 0000000000..1e61fc17be --- /dev/null +++ b/components/clm/src/unit_test_stubs/main/GetGlobalValuesMod_stub.F90 @@ -0,0 +1,19 @@ +module GetGlobalValuesMod + + ! Stub of GetGlobalValuesMod, which satisfies routine signatures with minimal + ! dependencies + + implicit none + + public :: GetGlobalWrite + +contains + + subroutine GetGlobalWrite(decomp_index, clmlevel) + integer, intent(in) :: decomp_index + character(len=*), intent(in) :: clmlevel + + ! do nothing + end subroutine GetGlobalWrite + +end module GetGlobalValuesMod diff --git a/components/clm/src/unit_test_stubs/main/histFileMod_stub.F90 b/components/clm/src/unit_test_stubs/main/histFileMod_stub.F90 new file mode 100644 index 0000000000..54ff7e7872 --- /dev/null +++ b/components/clm/src/unit_test_stubs/main/histFileMod_stub.F90 @@ -0,0 +1,111 @@ +module histFileMod + + ! This is a stub for histFileMod. Currently all it does is provide empty + ! implementations for hist_addfld calls, to satisfy the interface that is expected + ! throughout the CLM code. + + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + save + + integer , public , parameter :: no_snow_normal = 1 ! normal treatment, which should be used for most fields (use spval when snow layer not present) + integer , public , parameter :: no_snow_zero = 2 ! average in a 0 value for times when the snow layer isn't present + + public :: hist_addfld1d + public :: hist_addfld2d + public :: hist_addfld_decomp + +contains + + subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, & + ptr_atm, p2c_scale_type, c2l_scale_type, & + l2g_scale_type, set_lake, set_nolake, set_urb, set_nourb, & + set_noglcmec, set_spec, default) + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from clmtype) + real(r8) , optional, pointer :: ptr_gcell(:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:) ! pointer to pft array + real(r8) , optional, pointer :: ptr_lnd(:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_atm(:) ! pointer to atm array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_noglcmec ! value to set non-glacier_mec to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + + ! Do nothing + + end subroutine hist_addfld1d + + + subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_patch, ptr_lnd, ptr_atm, & + p2c_scale_type, c2l_scale_type, l2g_scale_type, & + set_lake, set_nolake, set_urb, set_nourb, set_spec, & + no_snow_behavior, default) + + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type2d ! 2d output type + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from clmtype) + real(r8) , optional, pointer :: ptr_atm(:,:) ! pointer to atm array + real(r8) , optional, pointer :: ptr_lnd(:,:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_gcell(:,:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:,:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to pft array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_nolake ! value to set non-lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + integer , optional, intent(in) :: no_snow_behavior ! if a multi-layer snow field, behavior to use for absent snow layers (should be one of the public no_snow_* parameters defined above) + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + + ! Do nothing + + end subroutine hist_addfld2d + + subroutine hist_addfld_decomp (fname, type2d, units, avgflag, long_name, ptr_col, ptr_patch, default) + + ! + ! !USES: + use clm_varpar , only : nlevdecomp_full, crop_prog + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type2d ! 2d output type + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array + real(r8) , optional, pointer :: ptr_patch(:,:) ! pointer to pft array + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape + + ! Do nothing + + end subroutine hist_addfld_decomp + +end module histFileMod diff --git a/components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in b/components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in new file mode 100644 index 0000000000..11ad671e41 --- /dev/null +++ b/components/clm/src/unit_test_stubs/main/ncdio_pio_fake.F90.in @@ -0,0 +1,480 @@ +module ncdio_pio + + ! This is a fake replacement for ncdio_pio. It does not interact with external files + ! (or pio for that matter) at all! Instead it essentially provides setters and getters + ! for module-level variables, in order to fake i/o. + + ! Currently it just contains 'read' functionality + + use shr_kind_mod, only : r8 => shr_kind_r8, i4=>shr_kind_i4 + use ncdio_var, only : ncdio_var_type + + ! !PUBLIC TYPES: + implicit none + save + private + + public :: file_desc_t + public :: var_desc_t + + ! Fake replacement for file_desc_t. Instead of relating to a netcdf file, this fake + ! object contains the data faking the file. + type :: file_desc_t + private + ! all of the variables in the file (a linked list would be a more efficient + ! implementation, but I'm going for simplicity over efficiency here) + type(ncdio_var_type), allocatable :: vars(:) + end type file_desc_t + + ! Stub replacement for var_desc_t, to satisfy interfaces that need it + type :: var_desc_t + end type var_desc_t + + integer, parameter, public :: ncd_double = 1 + integer, parameter, public :: ncd_int = 2 + integer, parameter, public :: ncd_log = 3 + + ! + ! !PUBLIC MEMBER FUNCTIONS: + + public :: ncd_io ! do fake i/o (currently only set up to read) + public :: ncd_inqvid ! inquire on a variable id + public :: ncd_set_var ! set data on "file" for one variable + public :: ncd_reset_read_times ! reset the "read_times" sensor variable for a given variable + public :: ncd_get_read_times ! get the value of the "read_times" sensor variable for a given variable + public :: ncd_pio_openfile ! stub: open file + public :: ncd_pio_closefile ! stub: close file + public :: ncd_inqdid ! stub: inquire dimension id + public :: ncd_inqvdlen ! stub: inquire size of a dimension + public :: ncd_inqdlen ! stub: inquire size of a dimension + + interface file_desc_t + module procedure constructor ! initialize a new file_desc_t object + end interface file_desc_t + + ! + ! !PRIVATE TYPES: + + integer, parameter :: var_not_found = -1 ! flag indicating variable wasn't found on file + + ! + ! !PRIVATE MEMBER FUNCTIONS: + + private :: ncd_get_variable_index ! return the index of a given variable + + interface ncd_io + module procedure ncd_io_1d_double + module procedure ncd_io_2d_double + module procedure ncd_io_1d_int + module procedure ncd_io_1d_logical + + !DIMS 0,1,2,3 + !TYPE int,double + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + !DIMS 0,1,2 + !TYPE text + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + end interface ncd_io + +contains + + ! ====================================================================== + ! Constructors + ! ====================================================================== + + !----------------------------------------------------------------------- + type(file_desc_t) function constructor() + ! + ! !DESCRIPTION: + ! Create a new file_desc_t object + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'file_desc_t constructor' + !----------------------------------------------------------------------- + + allocate(constructor%vars(0)) + + end function constructor + + + ! ====================================================================== + ! Fakes for the actual ncdio_pio functionality + ! ====================================================================== + + ! DIMS 1,2 + !----------------------------------------------------------------------- + subroutine ncd_io_{DIMS}d_double(varname, data, dim1name, flag, ncid, nt, readvar) + ! + ! !DESCRIPTION: + ! Fake for the non-glob form of ncd_io_{DIMS}d_double. + ! + ! Note that this assumes we are working with a single time slice (I'm not sure + ! whether the true ncd_io routines carry that assumption) + ! + ! !ARGUMENTS: + character(len=*) , intent(in) :: varname ! variable name + real(r8) , pointer :: data{DIMSTR} ! local decomposition data (no time dimension) + character(len=*) , intent(in) :: dim1name ! dimension name (unused for the fake) + character(len=*) , intent(in) :: flag ! 'read' or 'write' (currently only 'read' is supported) + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + integer, optional , intent(in) :: nt ! time sample index + logical, optional , intent(out) :: readvar ! true => variable is on dataset (read only) + ! + ! !LOCAL VARIABLES: + integer :: varindex ! index of variable of interest + + character(len=*), parameter :: subname = 'ncd_io_{DIMS}d_double' + !----------------------------------------------------------------------- + + if (flag /= 'read') then + write(*,*) subname, ' ERROR: currently only the "read" flag is supported' + stop + end if + + if (.not. present(nt)) then + ! nt is optional so code can build, but any code that is actually run in a unit + ! test should be providing nt + write(*,*) subname, ' ERROR: currently, the nt optional argument must be present' + end if + + varindex = ncd_get_variable_index(ncid, varname) + + if (varindex /= var_not_found) then + call ncid%vars(varindex)%get_data(nt, data) + if (present(readvar)) then + readvar = .true. + end if + else ! varindex == var_not_found + if (present(readvar)) then + readvar = .false. + end if + end if + + end subroutine ncd_io_{DIMS}d_double + + !----------------------------------------------------------------------- + subroutine ncd_inqvid(ncid, name, varid, vardesc, readvar) + ! Fake to inquire on a variable ID + ! + ! Unlike the true implementation, this one never aborts. It is meant to be called + ! with readvar present (in which case the true implementation doesn't abort, either.) + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! variable name + integer , intent(out) :: varid ! variable id + type(Var_desc_t) , intent(out) :: vardesc ! variable descriptor (not set in this implementation) + logical, optional , intent(out) :: readvar ! does variable exist + !----------------------------------------------------------------------- + + varid = ncd_get_variable_index(ncid, name) + + if (present(readvar)) then + if (varid /= var_not_found) then + readvar = .true. + else + readvar = .false. + end if + end if + end subroutine ncd_inqvid + + ! ====================================================================== + ! Stubs for the actual ncdio_pio functionality (do nothing) + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine ncd_pio_openfile(file, fname, mode) + ! + ! !DESCRIPTION: + ! Stub replacement: Open a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: file ! Output PIO file handle + character(len=*) , intent(in) :: fname ! Input filename to open + integer , intent(in) :: mode ! file mode + + end subroutine ncd_pio_openfile + + !----------------------------------------------------------------------- + subroutine ncd_pio_closefile(file) + ! + ! !DESCRIPTION: + ! Stub replacement: Close a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file handle to close + + end subroutine ncd_pio_closefile + + !TYPE int,logical + subroutine ncd_io_1d_{TYPE}(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! Stub replacement: netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + + if (present(readvar)) then + readvar = .false. + end if + + end subroutine ncd_io_1d_{TYPE} + + !------------------------------------------------------------------------ + !DIMS 0,1,2,3 + !TYPE int,double + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! Stub replacement: netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + + if (present(readvar)) then + readvar = .false. + end if + + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2 + !TYPE text + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! Stub replacement: netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + + if (present(readvar)) then + readvar = .false. + end if + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !----------------------------------------------------------------------- + subroutine ncd_inqdid(ncid,name,dimid,dimexist) + ! + ! !DESCRIPTION: + ! Stub replacement for ncd_inqdid. This does nothing useful, but just satisfies the + ! interface. + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! dimension name + integer , intent(out):: dimid ! dimension id + logical,optional , intent(out):: dimexist ! if this dimension exists or not + + dimid = 0 + if (present(dimexist)) then + dimexist = .false. + end if + + end subroutine ncd_inqdid + + !----------------------------------------------------------------------- + subroutine ncd_inqvdlen(ncid,varname,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! Stub replacement for ncd_inqvdlen_byName (note that we currently do not support + ! ncd_inqvdlen_byDesc). This does nothing, but just satisfies the interface for + ! ncd_inqvdlen. + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) ,intent(in) :: varname ! variable name + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + + dlen = 0 + err_code = 0 + + end subroutine ncd_inqvdlen + + !----------------------------------------------------------------------- + subroutine ncd_inqdlen(ncid,dimid,len,name) + ! + ! !DESCRIPTION: + ! Stub replacement for ncd_inqdlen. This does nothing, but just satisfies the + ! interface. + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(inout) :: dimid ! dimension id + integer , intent(out) :: len ! dimension len + character(len=*), optional, intent(in) :: name ! dimension name + + len = 0 + + end subroutine ncd_inqdlen + + ! ====================================================================== + ! Public routines to aid unit testing, specific to this fake replacement + ! ====================================================================== + + !----------------------------------------------------------------------- + subroutine ncd_set_var(ncid, varname, data, data_shape) + ! + ! !DESCRIPTION: + ! Set values for a single variable on this netcdf 'file'. + ! + ! Regardless of the true dimensionality of the undelying data, this should be called + ! with a 2-d data variable. The 2nd dim is time, 1st is everything else compressed + ! into a single dimension. 'data_shape' then gives the true shape of the underlying + ! data, WITHOUT the underlying time dimension + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf 'file' into which we should add this variable + character(len=*) , intent(in) :: varname ! variable name + real(r8) , intent(in) :: data(:,:) ! the data (see notes above) + integer , intent(in) :: data_shape(:) ! true shape of the underlying data, WITHOUT the time dimension + ! + ! !LOCAL VARIABLES: + type(ncdio_var_type) :: newvar ! the new variable + type(ncdio_var_type), allocatable :: new_var_list(:) + character(len=*), parameter :: subname = 'ncd_set_var' + !----------------------------------------------------------------------- + + ! If a variable with this name is already on the file, stop with an error message + if (ncd_get_variable_index(ncid, varname) /= var_not_found) then + write(*,*) subname, ' ERROR: cannot set a variable already on file - ', trim(varname) + end if + + newvar = ncdio_var_type(varname, data, data_shape) + + ! Add newvar to the list. + ! + ! In theory, I think I should be able to do this, but it isn't working, at least with + ! the intel compiler v. 13 on yellowstone: + ! ncid%vars = [ncid%vars, newvar] + ! + ! So I'm using an inefficient method, but that's okay for these purposes + allocate(new_var_list(size(ncid%vars) + 1)) + new_var_list(1:size(ncid%vars)) = ncid%vars(:) + new_var_list(size(ncid%vars)+1) = newvar + call move_alloc(new_var_list, ncid%vars) + + end subroutine ncd_set_var + + + !----------------------------------------------------------------------- + subroutine ncd_reset_read_times(ncid, varname) + ! + ! !DESCRIPTION: + ! Reset the 'read_times' flag for a given variable. This provides a starting point + ! for a future call to ncd_get_read_times - i.e., if ncd_get_read_times were called + ! immediately after ncd_reset_read_times, it would always be false. + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf 'file' to operate on + character(len=*) , intent(in) :: varname ! variable name + ! + ! !LOCAL VARIABLES: + integer :: varindex ! index of variable of interest + + character(len=*), parameter :: subname = 'ncd_reset_read_times' + !----------------------------------------------------------------------- + + varindex = ncd_get_variable_index(ncid, varname) + + if (varindex /= var_not_found) then + call ncid%vars(varindex)%reset_read_times() + else + write(*,*) subname, ' ERROR: could not find variable: ', trim(varname) + stop + end if + + end subroutine ncd_reset_read_times + + + !----------------------------------------------------------------------- + function ncd_get_read_times(ncid, varname) + ! + ! !DESCRIPTION: + ! Return the value of 'read_times' for all times. This tells you whether this variable + ! has been 'read' for each time index since the last call to reset_read_times (or + ! since initialization, if reset_read_times hasn't been called). + ! + ! !ARGUMENTS: + logical, allocatable :: ncd_get_read_times(:) ! function result + class(file_desc_t) , intent(in) :: ncid ! netcdf 'file' to operate on + character(len=*) , intent(in) :: varname ! variable name + ! + ! !LOCAL VARIABLES: + integer :: varindex ! index of variable of interest + + character(len=*), parameter :: subname = 'ncd_get_read_times' + !----------------------------------------------------------------------- + + varindex = ncd_get_variable_index(ncid, varname) + + if (varindex /= var_not_found) then + ncd_get_read_times = ncid%vars(varindex)%get_read_times() + else + write(*,*) subname, ' ERROR: could not find variable: ', trim(varname) + stop + end if + + end function ncd_get_read_times + + + ! ====================================================================== + ! Private routines + ! ====================================================================== + + !----------------------------------------------------------------------- + integer function ncd_get_variable_index(ncid, varname) + ! Return the index of the variable whose name is 'varname' in the ncid structure. If + ! varname is not present, return var_not_found + class(file_desc_t), intent(in) :: ncid + character(len=*), intent(in) :: varname ! variable name to find + + integer :: index + logical :: found + + found = .false. + index = 0 + do while((index < size(ncid%vars)) .and. (.not. found)) + index = index + 1 + if (ncid%vars(index)%get_varname() == varname) then + found = .true. + end if + end do + + if (found) then + ncd_get_variable_index = index + else + ncd_get_variable_index = var_not_found + end if + end function ncd_get_variable_index + +end module ncdio_pio diff --git a/components/clm/src/unit_test_stubs/main/ncdio_var.F90.in b/components/clm/src/unit_test_stubs/main/ncdio_var.F90.in new file mode 100644 index 0000000000..6aab1e327e --- /dev/null +++ b/components/clm/src/unit_test_stubs/main/ncdio_var.F90.in @@ -0,0 +1,141 @@ +module ncdio_var + ! This module is specific to using the ncdio_pio_fake version of ncdio_pio. This + ! provides a derived type for holding a single variable from a fake netcdf file, and + ! associated methods for working with this derived type. + + use shr_kind_mod, only : r8 => shr_kind_r8 + + ! Note that we use shr_assert directly rather than using the macros. This is so we don't + ! have to worry about whether or not NDEBUG is defined (we ALWAYS want to do these + ! assertions here). + use shr_assert_mod , only : shr_assert, shr_assert_all + + implicit none + private + save + + public :: ncdio_var_type + + integer, parameter, public :: max_name = 256 ! max length for a variable name + + ! This type stores a single variable in a fake file, for a single time slice. + type :: ncdio_var_type + private + + character(len=max_name) :: varname ! variable name + + integer :: ntimes ! number of time samples for this variable (length of second dimension) + + ! Second dimension is time, first is everything else. Regardless of the true + ! dimensionality of the underlying data, we compress all dimensions except time into + ! a single dimension, and then reshape it as needed. + real(r8), allocatable :: data(:,:) + + ! True shape of a single time slice of the data. This will have a single element if + ! the data are just spatial, two elements if the data have a space dimension plus a + ! single level dimension, etc. + integer, allocatable :: data_shape(:) + + ! This is a sensing variable, telling you which time indices have been "read" since + ! the last call to reset_read_times + logical, allocatable :: read_times(:) + + contains + generic, public :: get_data => & ! get the value of data for a single time + get_data_1d, get_data_2d + procedure :: get_varname ! get the variable name + procedure :: reset_read_times ! reset the "read_times" sensor variable + procedure :: get_read_times ! return the value of "read_times" for all times + + procedure, private :: get_data_1d + procedure, private :: get_data_2d + end type ncdio_var_type + + interface ncdio_var_type + module procedure constructor + end interface ncdio_var_type + +contains + + !----------------------------------------------------------------------- + type(ncdio_var_type) function constructor(varname, data, data_shape) + ! Create a new object of type ncdio_var_type + + character(len=*), intent(in) :: varname ! variable name + real(r8), intent(in) :: data(:,:) ! the data; 2nd dim is time, 1st is everything else compressed into a single dimension + integer, intent(in) :: data_shape(:) ! true shape of the underlying data, WITHOUT the time dimension + + character(len=*), parameter :: subname = 'ncdio_var_type constructor' + + call shr_assert(product(data_shape) == size(data, 1), subname//' product of data_shape must match length of 1st dim of data') + + constructor%varname = varname + + allocate(constructor%data(size(data,1), size(data,2))) + constructor%data = data + + allocate(constructor%data_shape(size(data_shape))) + constructor%data_shape = data_shape + + constructor%ntimes = size(data, 2) + + allocate(constructor%read_times(constructor%ntimes)) + call constructor%reset_read_times() + end function constructor + + !----------------------------------------------------------------------- + character(len=max_name) function get_varname(this) + ! Get the name associated with this variable + class(ncdio_var_type), intent(in) :: this + + get_varname = this%varname + end function get_varname + + + !----------------------------------------------------------------------- + subroutine reset_read_times(this) + ! Reset the 'read_times' variable. Any call to get_read_time will tell you whether a + ! given time slice has been read since the last call to reset_read_times + class(ncdio_var_type), intent(inout) :: this + + this%read_times(:) = .false. + end subroutine reset_read_times + + !----------------------------------------------------------------------- + function get_read_times(this) + ! Return the value of 'read_times' for all times. This tells you whether this variable + ! has been 'read' for each time index since the last call to reset_read_times (or + ! since initialization, if reset_read_times hasn't been called). + logical, allocatable :: get_read_times(:) + class(ncdio_var_type), intent(in) :: this + + character(len=*), parameter :: subname = 'get_read_times' + + get_read_times = this%read_times + end function get_read_times + + ! DIMS 1,2 + !----------------------------------------------------------------------- + subroutine get_data_{DIMS}d(this, nt, data) + ! Return the value of data at the given time. The output variable ('data') should + ! have the shape of true, underlying data (i.e., multi-dimensional if applicable) but + ! it should NOT have a time dimension because this subroutine returns the data for a + ! single time index + class(ncdio_var_type), intent(inout) :: this + integer, intent(in) :: nt ! time index of interest + real(r8), intent(out) :: data{DIMSTR} + + character(len=*), parameter :: subname = 'get_data_{DIMS}d' + + call shr_assert_all((shape(data) == this%data_shape), subname//' incorrect shape for data') + call shr_assert(1 <= nt .and. nt <= this%ntimes, subname//' nt out of bounds') + + data = reshape(this%data(:,nt), this%data_shape(1:{DIMS})) + + this%read_times(nt) = .true. + + end subroutine get_data_{DIMS}d + +end module ncdio_var + + diff --git a/components/clm/src/unit_test_stubs/utils/CMakeLists.txt b/components/clm/src/unit_test_stubs/utils/CMakeLists.txt new file mode 100644 index 0000000000..ab3474b8c9 --- /dev/null +++ b/components/clm/src/unit_test_stubs/utils/CMakeLists.txt @@ -0,0 +1,16 @@ +set(genf90_files + restUtilMod_stub.F90.in + ) + +process_genf90_source_list("${genf90_files}" ${CMAKE_CURRENT_SOURCE_DIR} clm_genf90_sources) + +sourcelist_to_parent(clm_genf90_sources) + +list(APPEND clm_sources "${clm_genf90_sources}") + +list(APPEND clm_sources + restUtilMod_stub.F90 + spmdMod_stub.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90.in b/components/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90.in new file mode 100644 index 0000000000..73a75ce3c6 --- /dev/null +++ b/components/clm/src/unit_test_stubs/utils/restUtilMod_stub.F90.in @@ -0,0 +1,129 @@ +module restUtilMod + + ! This is a stub for restUtilMod. Currently all it does is provide empty + ! implementations for restartvar, to satisfy the interface that is expected throughout + ! the CLM code + + use shr_kind_mod, only: r8=>shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4 + use ncdio_pio, only : file_desc_t + + implicit none + private + save + + interface restartvar + !DIMS 0,1,2 + !TYPE text,int,double + module procedure restartvar_{DIMS}d_{TYPE} + module procedure restartvar_2d_double_bounds + end interface restartvar + + public :: restartvar + +contains + + !----------------------------------------------------------------------- + !DIMS 0 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , intent(inout) :: data{DIMSTR} + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + + readvar = .false. + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + !DIMS 1,2 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , pointer :: data{DIMSTR} + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + + subroutine restartvar_2d_double_bounds(ncid, flag, varname, xtype, & + dim1name, dim2name, switchdim, lowerb2, upperb2, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: dim1name ! dimension name + character(len=*) , intent(in) :: dim2name ! dimension name + logical , intent(in) :: switchdim + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:,:) ! raw data + logical , intent(out) :: readvar ! was var read? + integer , intent(in), optional :: lowerb2 + integer , intent(in), optional :: upperb2 + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + + readvar = .false. + + end subroutine restartvar_2d_double_bounds + +end module restUtilMod diff --git a/components/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 b/components/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 new file mode 100644 index 0000000000..cb1d3975f0 --- /dev/null +++ b/components/clm/src/unit_test_stubs/utils/spmdMod_stub.F90 @@ -0,0 +1,12 @@ +module spmdMod + ! Stub of spmdMod + + implicit none + save + private + + logical, parameter, public :: masterproc = .true. + integer, parameter, public :: iam = 0 + integer, parameter, public :: mpicom = 0 + integer, parameter, public :: mpi_integer = 0 +end module spmdMod diff --git a/components/clm/src/utils/CMakeLists.txt b/components/clm/src/utils/CMakeLists.txt new file mode 100644 index 0000000000..678977c9b8 --- /dev/null +++ b/components/clm/src/utils/CMakeLists.txt @@ -0,0 +1,11 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources + domainMod.F90 + clm_nlUtilsMod.F90 + clm_time_manager.F90 + fileutils.F90 + ) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src/utils/SimpleMathMod.F90 b/components/clm/src/utils/SimpleMathMod.F90 new file mode 100644 index 0000000000..5649a54263 --- /dev/null +++ b/components/clm/src/utils/SimpleMathMod.F90 @@ -0,0 +1,226 @@ +module SimpleMathMod + +#include "shr_assert.h" + !------------------------------------------------------------------------------ + ! + ! DESCRIPTIONS: + ! module contains simple mathematical functions for arrays + ! Created by Jinyun Tang, Feb., 2014 + +implicit none + + interface array_normalization + module procedure array_normalization_2d, array_normalization_2d_filter + end interface array_normalization + + interface array_div_vector + module procedure array_div_vector_filter, array_div_vector_nofilter + end interface array_div_vector +contains +!-------------------------------------------------------------------------------- + subroutine array_normalization_2d(which_dim, arr2d_inout) + ! + !DESCRIPTIONS + !do normalization for the input array along dimension which_dim + ! + !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + + integer, intent(in) :: which_dim !do normalization along which dimension? + real(r8), intent(inout) :: arr2d_inout(:,:) !input 2d array + + + !local variables + integer :: sz1, sz2 !array size + integer :: j1, j2 !indices + real(r8) :: arr_sum + + sz1 = size(arr2d_inout,1) + sz2 = size(arr2d_inout,2) + + if(which_dim==1)then + !normalize along dimension 1, so loop along dimension 2 + do j2 = 1, sz2 + !obtain the total + arr_sum=0._r8 + do j1 = 1, sz1 + arr_sum=arr_sum+arr2d_inout(j1,j2) + enddo + !normalize with the total if arr_sum is non-zero + if(arr_sum/=0._r8)then + do j1 = 1, sz1 + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr_sum + enddo + endif + enddo + elseif(which_dim==2)then + !normalize along dimension 2, so loop along dimension 1 + do j1 = 1, sz1 + !obtain the total + arr_sum=0._r8 + do j2 = 1, sz2 + arr_sum=arr_sum+arr2d_inout(j1,j2) + enddo + !normalize with the total if arr_sum is non-zero + !I think there should be a safer mask for this to screen off spval values + !Jinyun Tang, May 30, 2014 + if(arr_sum>0._r8 .or. arr_sum < 0._r8)then + do j2 = 1, sz2 + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr_sum + enddo + endif + enddo + endif + return + end subroutine array_normalization_2d + +!-------------------------------------------------------------------------------- + subroutine array_normalization_2d_filter(lbj1, ubj1, lbj2, ubj2, numf, filter, arr2d_inout) + ! + !DESCRIPTIONS + !do normalization with filter for the input array along dimension 2 + + ! + !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + integer, intent(in) :: lbj1 !left bound of dim 1 + integer, intent(in) :: lbj2 !left bound of dim 2 + integer, intent(in) :: ubj1 !right bound of dim 1 + integer, intent(in) :: ubj2 !right bound of dim 2 + integer, intent(in) :: numf !filter size + integer, intent(in) :: filter(:) !filter + real(r8), intent(inout) :: arr2d_inout(lbj1: , lbj2: ) !input 2d array + + + !local variables + integer :: sz1, sz2 !array size + integer :: j2 !indices + integer :: f, p !indices + real(r8) :: arr_sum(lbj1:ubj1) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(arr2d_inout) == (/ubj1, ubj2/)), errMsg(__FILE__, __LINE__)) + + + arr_sum(:) = 0._r8 + do j2 = lbj2, ubj2 + do f = 1, numf + p = filter(f) + !obtain the total + arr_sum(p)=arr_sum(p)+arr2d_inout(p,j2) + enddo + enddo + + !normalize with the total if arr_sum is non-zero + do j2 = lbj2, ubj2 + do f = 1, numf + p = filter(f) + !I found I have to ensure >0._r8 because of some unknown reason, jyt May 23, 2014 + !I will test this later with arr_sum(p)/=0._r8 + if(arr_sum(p)>0._r8 .or. arr_sum(p)<0._r8)then + arr2d_inout(p,j2) = arr2d_inout(p,j2)/arr_sum(p) + endif + enddo + enddo + return + end subroutine array_normalization_2d_filter +!-------------------------------------------------------------------------------- + + subroutine array_div_vector_filter(lbj1, ubj1, lbj2, ubj2, & + arr1d_in, fn, filter, arr2d_inout) + ! + !DESCRIPTIONS + !array divided by a vector, arr2d_in is divided by one + !element in arr1d_in + !It always assumes the filter is along with dimenion 1 + ! + ! USES + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + integer, intent(in) :: lbj1 !left bound of dim 1 + integer, intent(in) :: lbj2 !left bound of dim 2 + integer, intent(in) :: ubj1 !right bound of dim 1 + integer, intent(in) :: ubj2 !right bound of dim 2 + real(r8), intent(in) :: arr1d_in(lbj1: ) !1d scaling factor + integer , intent(in) :: fn + integer , intent(in) :: filter(:) !filter + real(r8), intent(inout) :: arr2d_inout(lbj1: ,lbj2: ) !2d array to be scaled + + integer :: sz + integer :: j, f, p + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(arr2d_inout) == (/ubj1, ubj2/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arr1d_in) == (/ubj1/)), errMsg(__FILE__, __LINE__)) + + + do j = lbj2, ubj2 + do f = 1, fn + p = filter(f) + if (arr1d_in(p) > 0._r8 .or. arr1d_in(p) < 0._r8) then + arr2d_inout(p,j) = arr2d_inout(p,j)/arr1d_in(p) + else + arr2d_inout(p,j) = 0._r8 + end if + end do + end do + return + end subroutine array_div_vector_filter + +!-------------------------------------------------------------------------------- + + subroutine array_div_vector_nofilter(arr1d_in, which_dim, arr2d_inout) + ! + !DESCRIPTIONS + !array divided by a vector, each row in arr2d_in is divided by one + !element in arr1d_in + ! + !USES + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_assert_mod , only : shr_assert + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + real(r8), intent(in) :: arr1d_in(:) !scaling factor + integer, intent(in) :: which_dim !which dimension is scaled + real(r8), intent(inout) :: arr2d_inout(:,:) !2d array to be scaled + + integer :: sz1, sz2 + integer :: j1, j2 + + sz1=size(arr2d_inout,1) + sz2=size(arr2d_inout,2) + + if(which_dim==1)then + ! Enforce expected array sizes + call shr_assert(sz1 == size(arr1d_in), errMsg(__FILE__, __LINE__)) + + do j2 = 1, sz2 + do j1 = 1, sz1 + if(arr1d_in(j1)>0._r8)then + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr1d_in(j1) + endif + enddo + enddo + else + ! Enforce expected array sizes + call shr_assert(sz2 == size(arr1d_in), errMsg(__FILE__, __LINE__)) + + do j2 = 1, sz2 + do j1 = 1, sz1 + if(arr1d_in(j2)>0._r8 .or. arr1d_in(j2)<0._r8)then + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr1d_in(j2) + endif + enddo + enddo + + endif + return + end subroutine array_div_vector_nofilter + +end module SimpleMathMod diff --git a/components/clm/src/utils/clm_nlUtilsMod.F90 b/components/clm/src/utils/clm_nlUtilsMod.F90 new file mode 100644 index 0000000000..68536bd1fb --- /dev/null +++ b/components/clm/src/utils/clm_nlUtilsMod.F90 @@ -0,0 +1,116 @@ +module clm_nlUtilsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_nltUtilsMod +! +! !DESCRIPTION: +! Utilities to handle namelists. +! +! !USES: + +! !PUBLIC TYPES: + implicit none + save + + private ! By default everything is private + +! !PUBLIC MEMBER FUNCTIONS: + public :: find_nlgroup_name ! find a specified namelist group in a file +! +! !REVISION HISTORY: +! Created by B. Eaton +! Move to CLM by E. Kluzek +! +! !PRIVATE MEMBER FUNCTIONS: None +!----------------------------------------------------------------------- +! !PRIVATE DATA MEMBERS: None + +!EOP +!----------------------------------------------------------------------- +contains + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: find_nlgroup_name +! +! !INTERFACE: + subroutine find_nlgroup_name(unit, group, status) +! +! !DESCRIPTION: +! Search a file that contains namelist input for the specified namelist group name. +! Leave the file positioned so that the current record is the first record of the +! input for the specified group. +! +! METHOD: +! Read the file line by line. Each line is searched for an '&' which may only +! be preceded by blanks, immediately followed by the group name which is case +! insensitive. If found then backspace the file so the current record is the +! one containing the group name and return success. Otherwise return -1. +! +! !USES: + use shr_kind_mod , only : CS => shr_kind_cs + use shr_string_mod, only : shr_string_toLower +! +! !ARGUMENTS: + integer, intent(in) :: unit ! fortran unit attached to file + character(len=*), intent(in) :: group ! namelist group name + integer, intent(out) :: status ! 0 for success, -1 if group name not found +! +! !REVISION HISTORY: +! Created by B. Eaton, August 2007 +! Move to CLM E. Kluzek, August 2012 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: len_grp ! length of the groupname + integer :: ios ! io status + character(len=CS) :: inrec ! first shr_kind_CS characters of input record + character(len=CS) :: inrec2 ! left adjusted input record + character(len=len(group)) :: lc_group ! lower-case group name + character(len=32) :: subname = 'find_nlgroup_name' ! subroutine name +!----------------------------------------------------------------------- + len_grp = len_trim(group) + lc_group = shr_string_toLower(group) + + ios = 0 + do while (ios <= 0) + + read(unit, '(a)', iostat=ios, end=100) inrec + + if (ios <= 0) then ! ios < 0 indicates an end of record condition + + ! look for group name in this record + + ! remove leading blanks + inrec2 = adjustl(inrec) + + ! check for leading '&' + if (inrec2(1:1) == '&') then + + ! check for case insensitive group name + if (trim(lc_group) == shr_string_toLower(inrec2(2:len_grp+1))) then + + ! found group name. backspace to leave file position at this record + backspace(unit) + status = 0 + return + + end if + end if + end if + + end do + + 100 continue ! end of file processing + status = -1 + +end subroutine find_nlgroup_name + +!----------------------------------------------------------------------- + +end module clm_nlUtilsMod diff --git a/components/clm/src/utils/clm_time_manager.F90 b/components/clm/src/utils/clm_time_manager.F90 new file mode 100644 index 0000000000..6e34de1ab1 --- /dev/null +++ b/components/clm/src/utils/clm_time_manager.F90 @@ -0,0 +1,1869 @@ +module clm_time_manager + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod , only: shr_sys_abort + use spmdMod , only: masterproc + use clm_varctl , only: iulog + use clm_varcon , only: isecspday + use ESMF + + implicit none + private + + ! 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_rad_step_size, &! return radiation step size in seconds + get_nstep, &! return timestep number + get_curr_date, &! return date components at end of current timestep + get_prev_date, &! return date components at beginning of current timestep + get_start_date, &! return components of the start date + get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date + get_ref_date, &! return components of the reference date + get_perp_date, &! return components of the perpetual date, and current time of day + get_curr_time, &! return components of elapsed time since reference date at end of current timestep + get_prev_time, &! return components of elapsed time since reference date at beg of current timestep + get_curr_calday, &! return calendar day at end of current timestep + get_calday, &! return calendar day from input date + get_calendar, &! return calendar + get_days_per_year, &! return the days per year for current year + get_curr_yearfrac, &! return the fractional position in the current year, as of the end of the current timestep + get_prev_yearfrac, &! return the fractional position in the current year, as of the beginning of the current timestep + get_rest_date, &! return the date from the restart file + set_nextsw_cday, &! set the next radiation calendar day + is_first_step, &! return true on first step of initial run + is_first_restart_step, &! return true on first step of restart or branch run + is_first_step_of_this_run_segment, &! return true on first step of any run segment (initial, restart or branch run) + is_beg_curr_day, &! return true on first timestep in current day + is_end_curr_day, &! return true on last timestep in current day + is_end_curr_month, &! return true on last timestep in current month + is_last_step, &! return true on last timestep + is_perpetual, &! return true if perpetual calendar is in use + is_restart, &! return true if this is a restart run + update_rad_dtime, &! track radiation interval via nstep + timemgr_reset ! reset values to their defaults, and free memory + + ! Public methods, but just to support unit testing: + public :: for_test_set_curr_date ! set the current date and time + + ! Public parameter data + character(len=*), public, parameter :: NO_LEAP_C = 'NO_LEAP' + character(len=*), public, parameter :: GREGORIAN_C = 'GREGORIAN' + + ! Private module data + + ! Private data for input + + character(len=ESMF_MAXSTR), save ::& + calendar = NO_LEAP_C ! Calendar to use in date calculations. + integer, parameter :: uninit_int = -999999999 + real(r8), parameter :: uninit_r8 = -999999999.0 + + ! Input + integer, save ::& + dtime = uninit_int, &! timestep in seconds + dtime_rad = uninit_int, &! radiation interval in seconds + nstep_rad_prev = uninit_int ! radiation interval in seconds + + ! 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 + type(ESMF_Clock), save :: tm_clock ! model clock + type(ESMF_Time), save :: tm_perp_date ! perpetual date + + ! Data required to restart time manager: + integer, save :: rst_step_sec = uninit_int ! timestep size seconds + integer, save :: rst_start_ymd = uninit_int ! start date + integer, save :: rst_start_tod = uninit_int ! start time of day + integer, save :: rst_ref_ymd = uninit_int ! reference date + integer, save :: rst_ref_tod = uninit_int ! reference time of day + integer, save :: rst_curr_ymd = uninit_int ! current date + integer, save :: rst_curr_tod = uninit_int ! current time of day + + integer, save :: rst_nstep_rad_prev ! nstep of previous radiation call + integer, save :: perpetual_ymd = uninit_int ! Perpetual calendar date (YYYYMMDD) + 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 + ! + real(r8) :: nextsw_cday = uninit_r8 ! calday from clock of next radiation computation + + ! Private module methods + + private :: timemgr_spmdbcast + private :: init_calendar + private :: init_clock + private :: calc_nestep + private :: timemgr_print + private :: TimeGetymd + private :: check_timemgr_initialized + + !========================================================================================= +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 ) + + !--------------------------------------------------------------------------------- + ! 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) + ! + character(len=*), parameter :: sub = 'clm::set_timemgr_init' + + if ( timemgr_set ) call shr_sys_abort( sub//":: timemgr_init or timemgr_restart already called" ) + if (present(calendar_in) ) calendar = trim(calendar_in) + if (present(start_ymd_in) ) start_ymd = start_ymd_in + 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 + if ( .not. present(perpetual_ymd_in) .or. perpetual_ymd == uninit_int) & + call shr_sys_abort( sub//":: perpetual_run set but NOT perpetual_ymd" ) + 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 + + !========================================================================================= + + subroutine timemgr_init( ) + + !--------------------------------------------------------------------------------- + ! Initialize the ESMF time manager from the sync clock + ! + ! Arguments + ! + 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 + !--------------------------------------------------------------------------------- + call timemgr_spmdbcast( ) + + ! Initalize calendar + + call init_calendar() + + ! Initalize start date. + + if ( start_ymd == uninit_int ) then + write(iulog,*)sub,': start_ymd must be specified ' + call shr_sys_abort + end if + if ( start_tod == uninit_int ) then + write(iulog,*)sub,': start_tod must be specified ' + call shr_sys_abort + end if + start_date = TimeSetymd( start_ymd, start_tod, "start_date" ) + + ! Initialize current date + + 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 + ref_date = TimeSetymd( ref_ymd, ref_tod, "ref_date" ) + else + ref_date = start_date + end if + + ! Initialize clock + + call init_clock( start_date, ref_date, curr_date, stop_date ) + + ! Initialize date used for perpetual calendar day calculation. + + if (tm_perp_calendar) then + tm_perp_date = TimeSetymd( perpetual_ymd, 0, "tm_perp_date" ) + end if + + ! Print configuration summary to log file (stdout). + + if (masterproc) call timemgr_print() + + timemgr_set = .true. + + end subroutine timemgr_init + + !========================================================================================= + + subroutine init_clock( start_date, ref_date, curr_date, stop_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 + ! + 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_TimeInterval) :: step_size ! timestep size + type(ESMF_Time) :: current ! current date (from clock) + 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') + + ! Initialize the clock + + tm_clock = ESMF_ClockCreate(name="CLM Time-manager clock", timeStep=step_size, startTime=start_date, & + stopTime=stop_date, refTime=ref_date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockSetup') + + ! Advance clock to the current time (in case of a restart) + + call ESMF_ClockGet(tm_clock, currTime=current, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + do while( curr_date > current ) + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + call ESMF_ClockGet(tm_clock, currTime=current ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + end do + end subroutine init_clock + + !========================================================================================= + + function TimeSetymd( ymd, tod, desc ) + !--------------------------------------------------------------------------------- + ! + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + ! + integer, intent(in) :: ymd ! Year, month, day YYYYMMDD + integer, intent(in) :: tod ! Time of day in seconds + character(len=*), intent(in) :: desc ! Description of time to set + + type(ESMF_Time) :: TimeSetymd ! Return value + + character(len=*), parameter :: sub = 'clm::TimeSetymd' + integer :: yr, mon, day ! Year, month, day as integers + integer :: rc ! return code + !--------------------------------------------------------------------------------- + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > isecspday) )then + write(iulog,*) sub//': error yymmdd is a negative number or time-of-day out of bounds', & + ymd, tod + call shr_sys_abort + end if + yr = ymd / 10000 + mon = (ymd - yr*10000) / 100 + day = ymd - yr*10000 - mon*100 + call ESMF_TimeSet( TimeSetymd, yy=yr, mm=mon, dd=day, s=tod, & + calendar=tm_cal, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet: setting '//trim(desc)) + end function TimeSetymd + + !========================================================================================= + + integer function TimeGetymd( date, tod ) + ! + ! Get the date and time of day in ymd from ESMF Time. + ! + type(ESMF_Time), intent(inout) :: date ! Input date to convert to ymd + integer, intent(out), optional :: tod ! Time of day in seconds + + character(len=*), parameter :: sub = 'clm::TimeGetymd' + integer :: yr, mon, day + integer :: rc ! return code + + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + TimeGetymd = yr*10000 + mon*100 + day + if ( present( tod ) )then + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + end if + if ( yr < 0 )then + write(iulog,*) sub//': error year is less than zero', yr + call shr_sys_abort + end if + end function TimeGetymd + + !========================================================================================= + + subroutine timemgr_restart_io( ncid, flag ) + + !--------------------------------------------------------------------------------- + ! Read/Write information needed on restart to a netcdf file. + use ncdio_pio, only: ncd_int, file_desc_t + use restUtilMod + ! + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*), intent(in) :: flag ! 'read' or 'write' + ! + ! Local variables + character(len=*), parameter :: sub = 'clm::timemgr_restart' + integer :: rc ! return code + logical :: readvar ! determine if variable is on initial file + 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 + integer :: rst_caltype ! calendar type + integer, parameter :: noleap = 1 + integer, parameter :: gregorian = 2 + character(len=len(calendar)) :: cal + !--------------------------------------------------------------------------------- + + if (flag == 'write') then + rst_nstep_rad_prev = nstep_rad_prev + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_nstep_rad_prev', xtype=ncd_int, & + long_name='previous_radiation_nstep', units='unitless positive integer', & + ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_nstep_rad_prev) + if (flag == 'read') then + nstep_rad_prev = rst_nstep_rad_prev + end if + + if (flag == 'write') then + cal = to_upper(calendar) + if ( trim(cal) == NO_LEAP_C ) then + rst_caltype = noleap + else if ( trim(cal) == GREGORIAN_C ) then + rst_caltype = gregorian + else + call shr_sys_abort(sub//'ERROR: unrecognized calendar specified= '//trim(calendar)) + end if + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_type', xtype=ncd_int, & + long_name='calendar type', units='unitless', flag_meanings=(/ "NO_LEAP_C", "GREGORIAN" /), & + flag_values=(/ noleap, gregorian /), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_caltype) + if (flag == 'read') then + if ( rst_caltype == noleap ) then + calendar = NO_LEAP_C + else if ( rst_caltype == gregorian ) then + calendar = GREGORIAN_C + else + write(iulog,*)sub,': unrecognized calendar type in restart file: ',rst_caltype + call shr_sys_abort( sub//'ERROR: bad calendar type in restart file') + end if + end if + + if (flag == 'write') then + call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + rst_step_sec = dtime + rst_start_ymd = TimeGetymd( start_date, tod=rst_start_tod ) + rst_ref_ymd = TimeGetymd( ref_date, tod=rst_ref_tod ) + rst_curr_ymd = TimeGetymd( curr_date, tod=rst_curr_tod ) + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_step_sec', xtype=ncd_int, & + long_name='seconds component of timestep size', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_step_sec) + if ((flag == 'read') .and. ( rst_step_sec < 0 .or. rst_step_sec > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_step_sec out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_start_ymd', xtype=ncd_int, & + long_name='start date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_start_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_start_tod', xtype=ncd_int, & + long_name='start time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_start_tod) + if ((flag == 'read') .and. ( rst_start_tod < 0 .or. rst_start_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_strart_tod out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_ref_ymd', xtype=ncd_int, & + long_name='reference date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_ref_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_ref_tod', xtype=ncd_int, & + long_name='reference time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_ref_tod) + if ((flag == 'read') .and. ( rst_start_tod < 0 .or. rst_start_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_ref_tod out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_curr_ymd', xtype=ncd_int, & + long_name='current date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_curr_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_curr_tod', xtype=ncd_int, & + long_name='current time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_curr_tod) + if ((flag == 'read') .and. ( rst_curr_tod < 0 .or. rst_curr_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_ref_ymd out of range') + end if + + end subroutine timemgr_restart_io + + !========================================================================================= + + subroutine timemgr_restart( ) + + !--------------------------------------------------------------------------------- + ! Restart the ESMF time manager using the synclock for ending date. + ! + character(len=*), parameter :: sub = 'clm::timemgr_restart' + 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) :: 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( ) + + ! Initialize calendar from restart info + + call init_calendar() + + ! Initialize the timestep from restart info + + dtime = rst_step_sec + + ! Initialize start date from restart info + + start_date = TimeSetymd( rst_start_ymd, rst_start_tod, "start_date" ) + + ! Initialize current date from restart info + + 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 + + ! Initialize ref date from restart info + + ref_date = TimeSetymd( rst_ref_ymd, rst_ref_tod, "ref_date" ) + + ! Initialize clock + + call init_clock( start_date, ref_date, curr_date, stop_date ) + + ! Advance the timestep. + ! Data from the restart file corresponds to the last timestep of the previous run. + + call advance_timestep() + + ! Set flag that this is the first timestep of the restart run. + + tm_first_restart_step = .true. + + ! Calculate ending time step + + call calc_nestep( ) + + ! Print configuration summary to log file (stdout). + + if (masterproc) call timemgr_print() + + timemgr_set = .true. + + 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( ) + + !--------------------------------------------------------------------------------- + ! Initialize calendar + ! + ! Local variables + ! + character(len=*), parameter :: sub = 'clm::init_calendar' + type(ESMF_CalKind_Flag) :: cal_type ! calendar type + character(len=len(calendar)) :: caltmp + integer :: rc ! return code + !--------------------------------------------------------------------------------- + + caltmp = to_upper(calendar) + if ( trim(caltmp) == NO_LEAP_C ) then + cal_type = ESMF_CALKIND_NOLEAP + else if ( trim(caltmp) == GREGORIAN_C ) then + cal_type = ESMF_CALKIND_GREGORIAN + else + write(iulog,*)sub,': unrecognized calendar specified: ',calendar + call shr_sys_abort + end if + tm_cal = ESMF_CalendarCreate( name=caltmp, calkindflag=cal_type, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_CalendarSet') + end subroutine init_calendar + + !========================================================================================= + + subroutine timemgr_print() + + !--------------------------------------------------------------------------------- + character(len=*), parameter :: sub = 'clm::timemgr_print' + integer :: rc + integer :: yr, mon, day + integer :: & ! Data required to restart time manager: + nstep = uninit_int, &! current step number + step_sec = uninit_int, &! timestep size seconds + start_yr = uninit_int, &! start year + 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 + ref_tod = uninit_int, &! reference time of day + curr_yr = uninit_int, &! current year + curr_mon = uninit_int, &! current month + curr_day = uninit_int, &! current day of month + 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, & + advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + + write(iulog,*)' ******** CLM Time Manager Configuration ********' + + call ESMF_TimeIntervalGet( step, s=step_sec, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + 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') + call ESMF_TimeGet( curr_date, yy=curr_yr, mm=curr_mon, dd=curr_day, & + s=curr_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + write(iulog,*)' Calendar type: ',trim(calendar) + 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 + + if ( tm_perp_calendar ) then + call ESMF_TimeGet( tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + write(iulog,*)' Use perpetual diurnal cycle date (yr mon day): ', & + yr, mon, day + end if + + write(iulog,*)' ************************************************' + + end subroutine timemgr_print + + !========================================================================================= + + subroutine advance_timestep() + + ! Increment the timestep number. + + character(len=*), parameter :: sub = 'clm::advance_timestep' + integer :: rc + + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + + tm_first_restart_step = .false. + + 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 + + call check_timemgr_initialized(sub) + + 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 + + type(ESMF_Time) :: get_curr_ESMF_Time + character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' + integer :: rc + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + end function get_curr_ESMF_Time + + !========================================================================================= + + integer function get_step_size() + + ! Return the step size in seconds. + + character(len=*), parameter :: sub = 'clm::get_step_size' + type(ESMF_TimeInterval) :: step_size ! timestep size + integer :: rc + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, timeStep=step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeIntervalGet(step_size, s=get_step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockTimeIntervalGet') + + end function get_step_size + + !========================================================================================= + + subroutine update_rad_dtime(doalb) + !--------------------------------------------------------------------------------- + ! called only on doalb timesteps to save off radiation nsteps + ! + ! Local Arguments + logical,intent(in) :: doalb + integer :: dtime,nstep + + if (doalb) then + + dtime=get_step_size() + nstep = get_nstep() + + if (nstep_rad_prev == uninit_int ) then + dtime_rad = dtime + nstep_rad_prev = nstep + else + dtime_rad = (nstep - nstep_rad_prev) * dtime + nstep_rad_prev = nstep + endif + end if + end subroutine update_rad_dtime + + !========================================================================================= + + integer function get_rad_step_size() + + character(len=*), parameter :: sub = 'clm::get_rad_step_size' + + call check_timemgr_initialized(sub) + + if (nstep_rad_prev == uninit_int ) then + get_rad_step_size=get_step_size() + else + get_rad_step_size=dtime_rad + end if + + end function get_rad_step_size + + !========================================================================================= + + integer function get_nstep() + + ! Return the timestep number. + + character(len=*), parameter :: sub = 'clm::get_nstep' + integer :: rc + integer(ESMF_KIND_I8) :: step_no + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + get_nstep = step_no + + end function get_nstep + + !========================================================================================= + + subroutine get_curr_date(yr, mon, day, tod, offset) + + !----------------------------------------------------------------------------------------- + ! Return date components valid at end of current timestep with an optional + ! offset (positive or negative) in seconds. + + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_curr_date + + !========================================================================================= + + subroutine get_perp_date(yr, mon, day, tod, offset) + + !----------------------------------------------------------------------------------------- + ! Return time of day valid at end of current timestep and the components + ! of the perpetual date (with an optional offset (positive or negative) in seconds. + + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_perp_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: DelTime + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + ! Get time of day add it to perpetual date + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet(DelTime, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + DelTime + if ( present(offset) )then + call ESMF_TimeIntervalSet(DelTime, s=offset, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + DelTime + end if + ! Get time of day from the result + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + + ! Get the date from the fixed perpetual date (in case it overflows to next day) + call ESMF_TimeGet(tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_perp_date + + !========================================================================================= + + subroutine get_prev_date(yr, mon, day, tod) + + ! Return date components valid at beginning of current timestep. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_prev_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_prev_date + + !========================================================================================= + + subroutine get_start_date(yr, mon, day, tod) + + ! Return date components valid at beginning of initial run. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_start_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, startTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_start_date + + !========================================================================================= + + integer function get_driver_start_ymd( tod ) + + ! Return date of start of simulation from driver (i.e. NOT from restart file) + ! Note: get_start_date gets you the date from the beginning of the simulation + ! on the restart file. + + ! Arguments + integer, optional, intent(out) ::& + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_driver_start_ymd' + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + if ( start_ymd == uninit_int )then + call shr_sys_abort( sub//': error driver start date is NOT set yet' ) + end if + if ( start_ymd < 101 .or. start_ymd > 99991231 )then + call shr_sys_abort( sub//': error driver start date is invalid' ) + end if + if ( present(tod) )then + tod = start_tod + if ( (tod < 0) .or. (tod > isecspday) )then + call shr_sys_abort( sub//': error driver start tod is invalid' ) + end if + end if + get_driver_start_ymd = start_ymd + + end function get_driver_start_ymd + + !========================================================================================= + + subroutine get_ref_date(yr, mon, day, tod) + + ! Return date components of the reference date. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_ref_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, refTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_ref_date + + !========================================================================================= + + subroutine get_curr_time(days, seconds) + + ! Return time components valid at end of current timestep. + ! Current time is the time interval between the current date and the reference date. + + ! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_curr_time' + integer :: rc + type(ESMF_Time) :: cdate, rdate + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, currTime=cdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_ClockGet( tm_clock, refTime=rdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + diff = cdate - rdate + + call ESMF_TimeIntervalGet(diff, d=days, s=seconds, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + end subroutine get_curr_time + + !========================================================================================= + + subroutine get_prev_time(days, seconds) + + ! Return time components valid at beg of current timestep. + ! prev time is the time interval between the prev date and the reference date. + + ! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_prev_time' + integer :: rc + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for prevTime') + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for refTime') + diff = date - ref_date + call ESMF_TimeIntervalGet( diff, d=days, s=seconds, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeintervalGet') + + end subroutine get_prev_time + + !========================================================================================= + + function get_curr_calday(offset) + + ! Return calendar day at end of current timestep with optional offset. + ! Calendar day 1.0 = 0Z on Jan 1. + + ! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + ! Return value + real(r8) :: get_curr_calday + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_curr_calday' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off, diurnal + integer :: year, month, day, tod + !----------------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + if ( tm_perp_calendar ) then + call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + diurnal + end if + + call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + !----------------------------------------------------------------------------------------! + !!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! + !!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! + !!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! + !!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( (get_curr_calday > 366.0) .and. (get_curr_calday <= 367.0) .and. & + (trim(calendar) == GREGORIAN_C) )then + get_curr_calday = get_curr_calday - 1.0_r8 + end if + !!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------------------------! + if ( (get_curr_calday < 1.0) .or. (get_curr_calday > 366.0) )then + write(iulog,*) sub, ' = ', get_curr_calday + if ( present(offset) ) write(iulog,*) 'offset = ', offset + call shr_sys_abort( sub//': error get_curr_calday out of bounds' ) + end if + + end function get_curr_calday + + !========================================================================================= + + function get_calday(ymd, tod) + + ! Return calendar day corresponding to specified time instant. + ! Calendar day 1.0 = 0Z on Jan 1. + + ! Arguments + integer, intent(in) :: & + ymd, &! date in yearmmdd format + tod ! time of day (seconds past 0Z) + + ! Return value + real(r8) :: get_calday + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_calday' + integer :: rc ! return code + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + date = TimeSetymd( ymd, tod, "get_calday" ) + call ESMF_TimeGet( date, dayOfYear_r8=get_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + !----------------------------------------------------------------------------------------! +!!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! +!!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! +!!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! +!!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( (get_calday > 366.0) .and. (get_calday <= 367.0) .and. & + (trim(calendar) == GREGORIAN_C) )then + get_calday = get_calday - 1.0_r8 + end if +!!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------------------------! + if ( (get_calday < 1.0) .or. (get_calday > 366.0) )then + write(iulog,*) sub, ' = ', get_calday + call shr_sys_abort( sub//': error calday out of range' ) + end if + + end function get_calday + + !========================================================================================= + + function get_calendar() + + ! Return calendar + + ! Return value + character(len=ESMF_MAXSTR) :: get_calendar + + get_calendar = calendar + + end function get_calendar + + !========================================================================================= + + integer function get_days_per_year( offset ) + + !--------------------------------------------------------------------------------- + ! Get the number of days per year for currrent year + + ! + ! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_days_per_year' + integer :: yr, mon, day, tod ! current date year, month, day and time-of-day + type(ESMF_Time) :: eDate ! ESMF date + integer :: rc ! ESMF return code + !--------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + if ( present(offset) )then + call get_curr_date(yr, mon, day, tod, offset ) + else + call get_curr_date(yr, mon, day, tod ) + end if + eDate = TimeSetymd( ymd=yr*10000+1231, tod=0, desc="end of year" ) + call ESMF_TimeGet( eDate, dayOfYear=get_days_per_year, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end function get_days_per_year + + !========================================================================================= + + function get_curr_yearfrac( offset ) + + !--------------------------------------------------------------------------------- + ! Get the fractional position in the current year, as of the end of the current + ! timestep. This is 0 at midnight on Jan 1, and 1 at the end of Dec 31. + + ! + ! Arguments + real(r8) :: get_curr_yearfrac ! function result + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: days_per_year ! days per year + + call check_timemgr_initialized(sub) + + cday = get_curr_calday(offset=offset) + days_per_year = get_days_per_year() + + get_curr_yearfrac = (cday - 1._r8)/days_per_year + + end function get_curr_yearfrac + + !========================================================================================= + + function get_prev_yearfrac() + + !--------------------------------------------------------------------------------- + ! Get the fractional position in the current year, as of the beginning of the current + ! timestep. This is 0 at midnight on Jan 1, and 1 at the end of Dec 31. + + ! + ! Arguments + real(r8) :: get_prev_yearfrac ! function result + + character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' + + call check_timemgr_initialized(sub) + + get_prev_yearfrac = get_curr_yearfrac(offset = -dtime) + + end function get_prev_yearfrac + + + !========================================================================================= + + subroutine get_rest_date(ncid, yr) + + !--------------------------------------------------------------------------------- + ! Get the date from the restart file. + ! + ! Currently just returns the year (because the month & day are harder to extract, and + ! currently aren't needed). + use ncdio_pio, only: ncd_io, file_desc_t + ! + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf id for the restart file + integer , intent(out) :: yr ! year from restart file + + integer :: ymd ! yyyymmdd from the restart file + logical :: readvar ! whether the variable was read from the file + + integer, parameter :: year_mask = 10000 ! divide by this to get year from ymd + + character(len=*), parameter :: subname = 'get_rest_date' + !----------------------------------------------------------------------- + + ! Get the date (yyyymmdd) from restart file. + ! Note that we cannot simply use the rst_curr_ymd module variable, because that isn't + ! set under some circumstances + call ncd_io(varname='timemgr_rst_curr_ymd', data=ymd, & + ncid=ncid, flag='read', readvar=readvar) + if (.not. readvar) then + call shr_sys_abort(subname//' ERROR: timemgr_rst_curr_ymd not found on restart file') + end if + + ! Extract the year + yr = ymd / year_mask + end subroutine get_rest_date + + !========================================================================================= + + subroutine set_nextsw_cday( nextsw_cday_in ) + + ! Set the next radiation calendar day, so that radiation step can be calculated + ! + ! Arguments + real(r8), intent(IN) :: nextsw_cday_in ! input calday of next radiation computation + + character(len=*), parameter :: sub = 'clm::set_nextsw_cday' + + nextsw_cday = nextsw_cday_in + + end subroutine set_nextsw_cday + + !========================================================================================= + + function is_beg_curr_day() + + ! Return true if current timestep is first timestep in current day. + + ! Return value + logical :: is_beg_curr_day + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + character(len=*), parameter :: sub = 'clm::is_beg_curr_day' + + call check_timemgr_initialized(sub) + + call get_curr_date(yr, mon, day, tod) + is_beg_curr_day = ( tod == dtime ) + + end function is_beg_curr_day + + !========================================================================================= + + function is_end_curr_day() + + !--------------------------------------------------------------------------------- + ! Return true if current timestep is last timestep in current day. + + ! Return value + logical :: is_end_curr_day + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + character(len=*), parameter :: sub = 'clm::is_end_curr_day' + !--------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call get_curr_date(yr, mon, day, tod) + is_end_curr_day = (tod == 0) + + end function is_end_curr_day + + !========================================================================================= + + logical function is_end_curr_month() + + !--------------------------------------------------------------------------------- + ! Return true if current timestep is last timestep in current month. + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + character(len=*), parameter :: sub = 'clm::is_end_curr_month' + !--------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call get_curr_date(yr, mon, day, tod) + is_end_curr_month = (day == 1 .and. tod == 0) + + end function is_end_curr_month + + !========================================================================================= + + logical function is_first_step() + + !--------------------------------------------------------------------------------- + ! Return true on first step of initial run only. + + ! Local variables + character(len=*), parameter :: sub = 'clm::is_first_step' + integer :: rc + integer :: nstep + integer(ESMF_KIND_I8) :: step_no + !--------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + is_first_step = (nstep == 0) + + end function is_first_step + !========================================================================================= + + logical function is_first_restart_step() + + ! Return true on first step of restart or branch run only. + character(len=*), parameter :: sub = 'clm::is_first_restart_step' + + call check_timemgr_initialized(sub) + + is_first_restart_step = tm_first_restart_step + + end function is_first_restart_step + + !========================================================================================= + + logical function is_first_step_of_this_run_segment() + + ! Return true if this is the first step of this run segment. This will be true for + ! the first step of a startup, restart or branch run. + character(len=*), parameter :: sub = 'clm::is_first_step_of_this_run_segment' + + call check_timemgr_initialized(sub) + + is_first_step_of_this_run_segment = (is_first_step() .or. is_first_restart_step()) + + 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 + !--------------------------------------------------------------------------------- + + call check_timemgr_initialized(sub) + + 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. + character(len=*), parameter :: sub = 'clm::is_perpetual' + + call check_timemgr_initialized(sub) + + is_perpetual = tm_perp_calendar + + end function is_perpetual + + !========================================================================================= + + subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) + + ! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. + ! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + real(r8) :: days ! (ymd2,tod2)-(ymd1,tod1) in days + + ! Local variables + character(len=*), parameter :: sub = 'clm::timemgr_datediff' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + date1 = TimeSetymd( ymd1, tod1, "date1" ) + date2 = TimeSetymd( ymd2, tod2, "date2" ) + diff = date2 - date1 + call ESMF_TimeIntervalGet( diff, d_r8=days, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + days = days + 1.0_r8 + + end subroutine timemgr_datediff + + !========================================================================================= + + subroutine chkrc(rc, mes) + integer, intent(in) :: rc ! return code from time management library + character(len=*), intent(in) :: mes ! error message + if ( rc == ESMF_SUCCESS ) return + write(iulog,*) mes + call shr_sys_abort ('CHKRC') + end subroutine chkrc + + !========================================================================================= + + function to_upper(str) + + !--------------------------------------------------------------------------------- + ! Convert character string to upper case. Use achar and iachar intrinsics + ! to ensure use of ascii collating sequence. + ! + ! !INPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to upper case + ! !RETURN VALUE: + character(len=len(str)) :: to_upper + ! !LOCAL VARIABLES: + integer :: i ! Index + integer :: aseq ! ascii collating sequence + character(len=1) :: ctmp ! Character temporary + !--------------------------------------------------------------------------------- + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= 97 .and. aseq <= 122 ) ctmp = achar(aseq - 32) + to_upper(i:i) = ctmp + end do + + end function to_upper + + !========================================================================================= + + logical function is_restart( ) + ! Determine if restart run + use clm_varctl, only : nsrest, nsrContinue + if (nsrest == nsrContinue) then + is_restart = .true. + else + is_restart = .false. + end if + end function is_restart + + !========================================================================================= + + subroutine timemgr_spmdbcast( ) + + use spmdMod , only : mpicom, MPI_INTEGER + use shr_mpi_mod, only : shr_mpi_bcast + + integer :: ier + + call shr_mpi_bcast (dtime, mpicom) + + end subroutine timemgr_spmdbcast + + !========================================================================================= + + subroutine check_timemgr_initialized(caller) + ! + ! !DESCRIPTION: + ! Checks if the time manager has been initialized. If not, aborts with an error + ! message. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: caller ! name of calling routine + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'check_timemgr_initialized' + !----------------------------------------------------------------------- + + if (.not. timemgr_set) then + call shr_sys_abort(trim(caller)//":: Time manager has not been initialized") + end if + + end subroutine check_timemgr_initialized + + !----------------------------------------------------------------------- + subroutine timemgr_reset() + ! + ! !DESCRIPTION: + ! Reset time manager module data to default values. + ! + ! All unit tests that modify the time manager should call this routine in their + ! teardown section. + ! + ! Note: we could probably get away with doing much less resetting than is currently + ! done here. For example, we could simply set timemgr_set = .false., and deallocate + ! anything that needs deallocation. That would provide the benefit of less + ! maintenance, at the cost of slightly less robustness (in case some variable isn't + ! set in the initialization of a unit test, either because the unit test forgets to + ! call the time manager initialization method, or because the initialization method + ! does not explicitly initialize all variables). + ! + ! !USES: + ! + ! !ARGUMENTS: + ! + ! !LOCAL VARIABLES: + integer :: rc ! return code + + character(len=*), parameter :: sub = 'timemgr_reset' + !----------------------------------------------------------------------- + + ! ------------------------------------------------------------------------ + ! The values in the following section should match the initialization values given in + ! the variable declarations at the top of the module. + ! + ! Note: it would be easier to ensure this match if we introduced a time manager + ! derived type, which had default initialization of its components. Then this routine + ! could simply set to time manager instance to a new instance of the derived type. + ! ------------------------------------------------------------------------ + + calendar = NO_LEAP_C + + dtime = uninit_int + 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 + + rst_step_sec = uninit_int + rst_start_ymd = uninit_int + rst_start_tod = uninit_int + rst_ref_ymd = uninit_int + rst_ref_tod = uninit_int + rst_curr_ymd = uninit_int + rst_curr_tod = uninit_int + + ! note that rst_nstep_rad_prev is NOT initialized in its declaration + rst_nstep_rad_prev = uninit_int + perpetual_ymd = uninit_int + tm_first_restart_step = .false. + tm_perp_calendar = .false. + timemgr_set = .false. + nestep = uninit_int + + nextsw_cday = uninit_r8 + + ! ------------------------------------------------------------------------ + ! Reset other module-level variables to some reasonable default, to ensure that they + ! don't carry over any state from one unit test to the next. + ! ------------------------------------------------------------------------ + + ! Reset tm_cal + call init_calendar() + + ! Reset portions of the clock. Note that this does not fully reset the clock, and so + ! there is still the potential for information in the clock to carry over to the next + ! unit test if the next test does not properly initialize things. + call ESMF_ClockDestroy(tm_clock, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockDestroy') + + ! Note that we do NOT currently reset tm_perp_date, because it's unclear what that + ! should be reset to. Thus, there is potential for its information to carry over to + ! the next unit test if the next test does not properly initialize things. + + end subroutine timemgr_reset + + ! ======================================================================== + ! The following routines are meant to be used just in unit tests + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine for_test_set_curr_date(yr, mon, day, tod) + ! + ! !DESCRIPTION: + ! + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: yr ! year + integer, intent(in) :: mon ! month + integer, intent(in) :: day ! day of month + integer, intent(in) :: tod ! time of day (seconds past 0Z) + ! + ! !LOCAL VARIABLES: + type(ESMF_Time) :: my_time ! ESMF Time corresponding to the inputs + integer :: rc ! return code + + character(len=*), parameter :: sub = 'for_test_set_curr_date' + !----------------------------------------------------------------------- + + call ESMF_TimeSet(my_time, yy=yr, mm=mon, dd=day, s=tod, & + calendar=tm_cal, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet') + + call ESMF_ClockSet(tm_clock, CurrTime=my_time, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockSet') + + end subroutine for_test_set_curr_date + + +end module clm_time_manager diff --git a/components/clm/src/utils/clm_varorb.F90 b/components/clm/src/utils/clm_varorb.F90 new file mode 100644 index 0000000000..47bf51e576 --- /dev/null +++ b/components/clm/src/utils/clm_varorb.F90 @@ -0,0 +1,17 @@ + +module clm_varorb + + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + + ! Orbital information needed as input to orbit_parms + + real(r8) :: eccen ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) + + ! Orbital information after processed by orbit_params + + real(r8) :: obliqr ! Earth's obliquity in radians + real(r8) :: lambm0 ! Mean longitude of perihelion at the vernal equinox (radians) + real(r8) :: mvelpp ! Earth's moving vernal equinox longitude of perihelion plus pi (radians) + +end module clm_varorb diff --git a/components/clm/src/utils/domainMod.F90 b/components/clm/src/utils/domainMod.F90 new file mode 100644 index 0000000000..ea8a42ab6e --- /dev/null +++ b/components/clm/src/utils/domainMod.F90 @@ -0,0 +1,242 @@ +module domainMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: domainMod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use spmdMod , only : masterproc + use clm_varctl , only : iulog +! +! !PUBLIC TYPES: + implicit none + private +! + public :: domain_type + + !--- this typically contains local domain info with arrays dim begg:endg --- + type domain_type + integer :: ns ! global size of domain + integer :: ni,nj ! global axis if 2d (nj=1 if unstructured) + logical :: isgrid2d ! true => global grid is lat/lon + integer :: nbeg,nend ! local beg/end indices + character(len=8) :: clmlevel ! grid type + integer ,pointer :: mask(:) ! land mask: 1 = land, 0 = ocean + real(r8),pointer :: frac(:) ! fractional land + real(r8),pointer :: topo(:) ! topography + real(r8),pointer :: latc(:) ! latitude of grid cell (deg) + real(r8),pointer :: lonc(:) ! longitude of grid cell (deg) + real(r8),pointer :: area(:) ! grid cell area (km**2) + integer ,pointer :: pftm(:) ! pft mask: 1=real, 0=fake, -1=notset + integer ,pointer :: glcmask(:) ! glc mask: 1=sfc mass balance required by GLC component + ! 0=SMB not required (default) + ! (glcmask is just a guess at the appropriate mask, known at initialization - + ! in contrast to icemask, which is the true mask obtained from glc) + character*16 :: set ! flag to check if domain is set + logical :: decomped ! decomposed locally or global copy + end type domain_type + + type(domain_type) , public :: ldomain + real(r8), allocatable, public :: lon1d(:), lat1d(:) ! 1d lat/lons for 2d grids +! +! !PUBLIC MEMBER FUNCTIONS: + public domain_init ! allocates/nans domain types + public domain_clean ! deallocates domain types + public domain_check ! write out domain info +! +! !REVISION HISTORY: +! Originally clm_varsur by Mariana Vertenstein +! Migrated from clm_varsur to domainMod by T Craig +! + character*16,parameter :: set = 'domain_set ' + character*16,parameter :: unset = 'NOdomain_unsetNO' +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_init +! +! !INTERFACE: + subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,clmlevel) + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) +! +! !DESCRIPTION: +! This subroutine allocates and nans the domain type +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype + logical, intent(in) :: isgrid2d ! true => global grid is lat/lon + integer, intent(in) :: ni,nj ! grid size, 2d + integer , intent(in), optional :: nbeg,nend ! beg/end indices + character(len=*), intent(in), optional :: clmlevel ! grid type +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier + integer nb,ne +! +!------------------------------------------------------------------------------ + + nb = 1 + ne = ni*nj + if (present(nbeg)) then + if (present(nend)) then + nb = nbeg + ne = nend + endif + endif + + if (domain%set == set) then + call domain_clean(domain) + endif + allocate(domain%mask(nb:ne),domain%frac(nb:ne),domain%latc(nb:ne), & + domain%pftm(nb:ne),domain%area(nb:ne),domain%lonc(nb:ne), & + domain%topo(nb:ne),domain%glcmask(nb:ne),stat=ier) + if (ier /= 0) then + call shr_sys_abort('domain_init ERROR: allocate mask, frac, lat, lon, area ') + endif + + if (present(clmlevel)) then + domain%clmlevel = clmlevel + endif + + domain%isgrid2d = isgrid2d + domain%ns = ni*nj + domain%ni = ni + domain%nj = nj + domain%nbeg = nb + domain%nend = ne + domain%mask = -9999 + domain%frac = -1.0e36 + domain%topo = 0._r8 + domain%latc = nan + domain%lonc = nan + domain%area = nan + + domain%set = set + if (domain%nbeg == 1 .and. domain%nend == domain%ns) then + domain%decomped = .false. + else + domain%decomped = .true. + endif + + domain%pftm = -9999 + domain%glcmask = 0 + +end subroutine domain_init +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_clean +! +! !INTERFACE: + subroutine domain_clean(domain) +! +! !DESCRIPTION: +! This subroutine deallocates the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier +! +!------------------------------------------------------------------------------ + if (domain%set == set) then + if (masterproc) then + write(iulog,*) 'domain_clean: cleaning ',domain%ni,domain%nj + endif + deallocate(domain%mask,domain%frac,domain%latc, & + domain%lonc,domain%area,domain%pftm, & + domain%topo,domain%glcmask,stat=ier) + if (ier /= 0) then + call shr_sys_abort('domain_clean ERROR: deallocate mask, frac, lat, lon, area ') + endif + else + if (masterproc) then + write(iulog,*) 'domain_clean WARN: clean domain unecessary ' + endif + endif + + domain%clmlevel = unset + domain%ns = huge(1) + domain%ni = huge(1) + domain%nj = huge(1) + domain%nbeg = huge(1) + domain%nend = huge(1) + domain%set = unset + domain%decomped = .true. + +end subroutine domain_clean +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_check +! +! !INTERFACE: + subroutine domain_check(domain) +! +! !DESCRIPTION: +! This subroutine write domain info +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(in) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) ' domain_check set = ',trim(domain%set) + write(iulog,*) ' domain_check decomped = ',domain%decomped + write(iulog,*) ' domain_check ns = ',domain%ns + write(iulog,*) ' domain_check ni,nj = ',domain%ni,domain%nj + write(iulog,*) ' domain_check clmlevel = ',trim(domain%clmlevel) + write(iulog,*) ' domain_check nbeg,nend = ',domain%nbeg,domain%nend + write(iulog,*) ' domain_check lonc = ',minval(domain%lonc),maxval(domain%lonc) + write(iulog,*) ' domain_check latc = ',minval(domain%latc),maxval(domain%latc) + write(iulog,*) ' domain_check mask = ',minval(domain%mask),maxval(domain%mask) + write(iulog,*) ' domain_check frac = ',minval(domain%frac),maxval(domain%frac) + write(iulog,*) ' domain_check topo = ',minval(domain%topo),maxval(domain%topo) + write(iulog,*) ' domain_check area = ',minval(domain%area),maxval(domain%area) + write(iulog,*) ' domain_check pftm = ',minval(domain%pftm),maxval(domain%pftm) + write(iulog,*) ' domain_check glcmask = ',minval(domain%glcmask),maxval(domain%glcmask) + write(iulog,*) ' ' + endif + +end subroutine domain_check + +!------------------------------------------------------------------------------ + +end module domainMod diff --git a/components/clm/src/utils/dtypes.h b/components/clm/src/utils/dtypes.h new file mode 100644 index 0000000000..977e95ad75 --- /dev/null +++ b/components/clm/src/utils/dtypes.h @@ -0,0 +1,6 @@ +#define TYPEDOUBLE 102 +#define TYPEINT 103 +#define TYPETEXT 100 +#define TYPELONG 104 +#define TYPEREAL 101 +#define TYPELOGICAL 105 diff --git a/components/clm/src/utils/fileutils.F90 b/components/clm/src/utils/fileutils.F90 new file mode 100644 index 0000000000..b74af42426 --- /dev/null +++ b/components/clm/src/utils/fileutils.F90 @@ -0,0 +1,179 @@ +module fileutils + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing file I/O utilities + ! + ! !USES: + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use spmdMod , only : masterproc + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: get_filename !Returns filename given full pathname + public :: opnfil !Open local unformatted or formatted file + public :: getfil !Obtain local copy of file + public :: relavu !Close and release Fortran unit no longer in use + public :: getavu !Get next available Fortran unit number + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + character(len=256) function get_filename (fulpath) + ! + ! !DESCRIPTION: + ! Returns filename given full pathname + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !full pathname + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + !------------------------------------------------------------------------ + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i) == '/') go to 10 + end do + i = 0 +10 get_filename = fulpath(i+1:klen) + + return + end function get_filename + + !------------------------------------------------------------------------ + subroutine getfil (fulpath, locfn, iflag) + ! + ! !DESCRIPTION: + ! Obtain local copy of file + ! First check current working directory + ! Next check full pathname[fulpath] on disk + ! + ! !USES: + use shr_file_mod, only: shr_file_get + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname + character(len=*), intent(out) :: locfn !output local file name + integer, intent(in) :: iflag !0=>abort if file not found 1=>do not abort + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + logical lexist !true if local file exists + !------------------------------------------------------------------------ + + ! get local file name from full name + + locfn = get_filename( fulpath ) + if (len_trim(locfn) == 0) then + if (masterproc) write(iulog,*)'(GETFIL): local filename has zero length' + call shr_sys_abort + else + if (masterproc) write(iulog,*)'(GETFIL): attempting to find local file ', & + trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), & + ' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + locfn = fulpath + + inquire (file=fulpath,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + if (masterproc) write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath + if (iflag==0) then + call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) + else + RETURN + endif + endif + + end subroutine getfil + + !------------------------------------------------------------------------ + subroutine opnfil (locfn, iun, form) + ! + ! !DESCRIPTION: + ! Open file locfn in unformatted or formatted form on unit iun + ! + ! !ARGUMENTS: + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, f = formatted + ! + ! !LOCAL VARIABLES: + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted + !------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(iulog,*)'(OPNFIL): local filename has zero length' + call shr_sys_abort + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + call shr_sys_abort + else if ( masterproc )then + write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), & + & ' on unit= ',iun + end if + + end subroutine opnfil + + !------------------------------------------------------------------------ + integer function getavu() + ! + ! !DESCRIPTION: + ! Get next available Fortran unit number. + ! + ! !USES: + use shr_file_mod, only : shr_file_getUnit + !------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + + !------------------------------------------------------------------------ + subroutine relavu (iunit) + ! + ! !DESCRIPTION: + ! Close and release Fortran unit no longer in use! + ! + ! !USES: + use shr_file_mod, only : shr_file_freeUnit + ! + ! !ARGUMENTS: + integer, intent(in) :: iunit !Fortran unit number + !------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/components/clm/src/utils/getdatetime.F90 b/components/clm/src/utils/getdatetime.F90 new file mode 100644 index 0000000000..4126d807e4 --- /dev/null +++ b/components/clm/src/utils/getdatetime.F90 @@ -0,0 +1,53 @@ +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: getdatetime +! +! !INTERFACE: +subroutine getdatetime (cdate, ctime) +! +! !DESCRIPTION: +! A generic Date and Time routine +! +! !USES: + use spmdMod , only : mpicom, masterproc, MPI_CHARACTER +! !ARGUMENTS: + implicit none + character(len=8), intent(out) :: cdate !current date + character(len=8), intent(out) :: ctime !current time +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=8) :: date !current date + character(len=10) :: time !current time + character(len=5) :: zone !zone + integer, dimension(8) :: values !temporary + integer :: ier !MPI error code +!----------------------------------------------------------------------- + if (masterproc) then + + call date_and_time (date, time, zone, values) + + cdate(1:2) = date(5:6) + cdate(3:3) = '/' + cdate(4:5) = date(7:8) + cdate(6:6) = '/' + cdate(7:8) = date(3:4) + + ctime(1:2) = time(1:2) + ctime(3:3) = ':' + ctime(4:5) = time(3:4) + ctime(6:6) = ':' + ctime(7:8) = time(5:6) + + endif + + call mpi_bcast (cdate,len(cdate),MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (ctime,len(ctime),MPI_CHARACTER, 0, mpicom, ier) + + return +end subroutine getdatetime diff --git a/components/clm/src/utils/quadraticMod.F90 b/components/clm/src/utils/quadraticMod.F90 new file mode 100644 index 0000000000..ef3e561bb7 --- /dev/null +++ b/components/clm/src/utils/quadraticMod.F90 @@ -0,0 +1,57 @@ +module quadraticMod + + use abortutils , only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only: errMsg => shr_log_errMsg + use clm_varctl , only: iulog + + implicit none + + public :: quadratic + +contains + + subroutine quadratic (a, b, c, r1, r2) + ! + ! !DESCRIPTION: + !==============================================================================! + !----------------- Solve quadratic equation for its two roots -----------------! + !==============================================================================! + ! Solution from Press et al (1986) Numerical Recipes: The Art of Scientific + ! Computing (Cambridge University Press, Cambridge), pp. 145. + ! + ! !REVISION HISTORY: + ! 4/5/10: Adapted from /home/bonan/ecm/psn/An_gs_iterative.f90 by Keith Oleson + ! + ! !USES: + implicit none + ! + ! !ARGUMENTS: + real(r8), intent(in) :: a,b,c ! Terms for quadratic equation + real(r8), intent(out) :: r1,r2 ! Roots of quadratic equation + ! + ! !LOCAL VARIABLES: + real(r8) :: q ! Temporary term for quadratic solution + !------------------------------------------------------------------------------ + + if (a == 0._r8) then + write (iulog,*) 'Quadratic solution error: a = ',a + call endrun(msg=errmsg(__FILE__, __LINE__)) + end if + + if (b >= 0._r8) then + q = -0.5_r8 * (b + sqrt(b*b - 4._r8*a*c)) + else + q = -0.5_r8 * (b - sqrt(b*b - 4._r8*a*c)) + end if + + r1 = q / a + if (q /= 0._r8) then + r2 = c / q + else + r2 = 1.e36_r8 + end if + + end subroutine quadratic + +end module quadraticMod diff --git a/components/clm/src/utils/restUtilMod.F90.in b/components/clm/src/utils/restUtilMod.F90.in new file mode 100644 index 0000000000..e88c969437 --- /dev/null +++ b/components/clm/src/utils/restUtilMod.F90.in @@ -0,0 +1,500 @@ +module restUtilMod + + !----------------------------------------------------------------------- + ! provies generic routines and types for use with restart files + ! + use shr_kind_mod, only: r8=>shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4 + use shr_sys_mod, only: shr_sys_abort + use spmdMod, only: masterproc + use clm_varctl, only: iulog + use clm_varcon, only: spval, ispval + use ncdio_pio + use pio + use ncdio_utils, only: find_var_on_file + use shr_string_mod, only: shr_string_listGetName + ! + implicit none + save + private + ! save + ! + !----------------------------------------------------------------------- + + interface restartvar + !DIMS 0,1,2 + !TYPE text,int,double + module procedure restartvar_{DIMS}d_{TYPE} + module procedure restartvar_2d_double_bounds + end interface restartvar + + integer,parameter, public :: iflag_interp = 1 + integer,parameter, public :: iflag_copy = 2 + integer,parameter, public :: iflag_skip = 3 + integer,parameter, public :: iflag_noswitchdim = 0 + integer,parameter, public :: iflag_switchdim = 1 + + public :: restartvar + + private :: is_restart + +contains + + !----------------------------------------------------------------------- + !DIMS 0 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + ! Note that varname can be a colon-delimited list of possible variable names (with no + ! spaces around the colons). In this case, when flag = 'read', the input file is + ! searched for each possible variable name in order, starting with the first, until + ! one is found. This mechanism supports backwards compatibility with old restart + ! files, in case variables have been renamed. For example, if variable 'foo' was + ! recently renamed to 'bar', then varname should be 'bar:foo'. For flag = 'write', + ! the first name in the list is used. + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name (or colon-delimited list: see above) + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , intent(inout) :: data{DIMSTR} + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + character(len=len(varname)) :: primary_varname ! first name in the varname list + character(len=len(varname)) :: my_varname ! actual varname to read/write + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + call shr_string_listGetName(varname, 1, primary_varname) + if (flag == 'read') then + call find_var_on_file(ncid, varname, my_varname) + if ((my_varname /= primary_varname) .and. masterproc) then + write(iulog,*) 'Restart file backwards compatibility: Translating: ', & + trim(my_varname), ' => ', trim(primary_varname) + end if + else + my_varname = primary_varname + end if + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + + status = PIO_inq_varid(ncid, trim(my_varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + ! This attribute is written in order to communicate this metadata to initInterp + call ncd_putatt(ncid, varid, 'varnames_on_old_files', trim(varname)) + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if ({ITYPE}!=TYPETEXT) + call ncd_io(varname=trim(my_varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + !DIMS 1,2 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + ! Note that varname can be a colon-delimited list of possible variable names (with no + ! spaces around the colons). In this case, when flag = 'read', the input file is + ! searched for each possible variable name in order, starting with the first, until + ! one is found. This mechanism supports backwards compatibility with old restart + ! files, in case variables have been renamed. For example, if variable 'foo' was + ! recently renamed to 'bar', then varname should be 'bar:foo'. For flag = 'write', + ! the first name in the list is used. + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name (or colon-delimited list: see above) + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , pointer :: data{DIMSTR} + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + character(len=len(varname)) :: primary_varname ! first name in the varname list + character(len=len(varname)) :: my_varname ! actual varname to read/write + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + call shr_string_listGetName(varname, 1, primary_varname) + if (flag == 'read') then + call find_var_on_file(ncid, varname, my_varname) + if ((my_varname /= primary_varname) .and. masterproc) then + write(iulog,*) 'Restart file backwards compatibility: Translating: ', & + trim(my_varname), ' => ', trim(primary_varname) + end if + else + my_varname = primary_varname + end if + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(my_varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + ! This attribute is written in order to communicate this metadata to initInterp + call ncd_putatt(ncid, varid, 'varnames_on_old_files', trim(varname)) + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if ({ITYPE}!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(my_varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(my_varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + + subroutine restartvar_2d_double_bounds(ncid, flag, varname, xtype, & + dim1name, dim2name, switchdim, lowerb2, upperb2, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + ! Note that varname can be a colon-delimited list of possible variable names (with no + ! spaces around the colons). In this case, when flag = 'read', the input file is + ! searched for each possible variable name in order, starting with the first, until + ! one is found. This mechanism supports backwards compatibility with old restart + ! files, in case variables have been renamed. For example, if variable 'foo' was + ! recently renamed to 'bar', then varname should be 'bar:foo'. For flag = 'write', + ! the first name in the list is used. + + !---------------------------------------------------- + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name (or colon-delimited list: see above) + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: dim1name ! dimension name + character(len=*) , intent(in) :: dim2name ! dimension name + logical , intent(in) :: switchdim + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:,:) ! raw data + logical , intent(out) :: readvar ! was var read? + integer , intent(in), optional :: lowerb2 + integer , intent(in), optional :: upperb2 + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + character(len=len(varname)) :: primary_varname ! first name in the varname list + character(len=len(varname)) :: my_varname ! actual varname to read/write + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid ! returned var id + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + call shr_string_listGetName(varname, 1, primary_varname) + if (flag == 'read') then + call find_var_on_file(ncid, varname, my_varname) + if ((my_varname /= primary_varname) .and. masterproc) then + write(iulog,*) 'Restart file backwards compatibility: Translating: ', & + trim(my_varname), ' => ', trim(primary_varname) + end if + else + my_varname = primary_varname + end if + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (switchdim) then + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + dim1name=trim(dim2name), dim2name=trim(dim1name), & + long_name=trim(long_name), units=units) + else + call ncd_defvar(ncid=ncid, varname=trim(my_varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + status = PIO_inq_varid(ncid, trim(my_varname), vardesc) + + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=>nearest_neighbor 2=>copy 3=>skip") + + ! This attribute is written in order to communicate this metadata to initInterp + call ncd_putatt(ncid, varid, 'varnames_on_old_files', trim(varname)) + + if (switchdim) then + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 1) + else + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 0) + end if + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_values', (/0,1/)) + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_0', & + "1st and 2nd dims are same as model representation") + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_1', & + "1st and 2nd dims are switched from model representation") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else + + if (present(lowerb2) .and. present(upperb2)) then + call ncd_io(varname=trim(my_varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + lowerb2=lowerb2, upperb2=upperb2, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(my_varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + ncid=ncid, flag=flag, readvar=readvar) + end if + + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_2d_double_bounds + + + !----------------------------------------------------------------------- + logical function is_restart( ) + ! Determine if restart run + use clm_varctl, only : nsrest, nsrContinue + if (nsrest == nsrContinue) then + is_restart = .true. + else + is_restart = .false. + end if + end function is_restart + +end module restUtilMod diff --git a/components/clm/src/utils/spmdGathScatMod.F90 b/components/clm/src/utils/spmdGathScatMod.F90 new file mode 100644 index 0000000000..209a1d2a4e --- /dev/null +++ b/components/clm/src/utils/spmdGathScatMod.F90 @@ -0,0 +1,536 @@ +module spmdGathScatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: spmdGathScatMod +! +! !DESCRIPTION: +! Perform SPMD gather and scatter operations. +! +! !USES: + use clm_varcon, only: spval, ispval + use decompMod, only : get_clmlevel_gsmap + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmdMod + use mct_mod + use abortutils, only : endrun + use clm_varctl, only : iulog + use perf_mod +! +! !PUBLIC TYPES: + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: + public scatter_data_from_master, gather_data_to_master + + interface scatter_data_from_master + module procedure scatter_1darray_int + module procedure scatter_1darray_real + end interface + + interface gather_data_to_master + module procedure gather_1darray_int + module procedure gather_1darray_real + end interface +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +! + integer,private,parameter :: debug = 0 + +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: scatter_1darray_int +! +! !INTERFACE: + subroutine scatter_1darray_int (alocal, aglobal, clmlevel) +! +! !DESCRIPTION: +! Wrapper routine to scatter int 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , pointer :: alocal(:) ! local data (output) + integer , pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + integer ,pointer :: adata(:) ! local data array + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'scatter_1darray_int' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(istring) == 0) then + istring = trim(fname) + else + istring = trim(istring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + if (debug > 1) call t_startf(trim(subname)//'_pack') + + if (masterproc) then + lsize = size(aglobal,dim=1) + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + allocate(adata(lsize)) + do n2 = lb2,ub2 + adata(1:lsize) = aglobal(1:lsize) + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importIattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_scat') + + call mct_aVect_scatter(AVi, AVo, gsmap, 0, mpicom) + + if (debug > 1) call t_stopf(trim(subname)//'_scat') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + lsize = size(alocal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportIattr(AVo,trim(fname),adata,lsize) + do n1 = lb1,ub1 + alocal(n1) = adata(n1-lb1+1) + enddo + enddo + deallocate(adata) + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVi) + endif + call mct_aVect_clean(AVo) + + call t_stopf(trim(subname)//'_total') + + end subroutine scatter_1darray_int + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: gather_1darray_int +! +! !INTERFACE: + subroutine gather_1darray_int (alocal, aglobal, clmlevel, missing) +! +! !DESCRIPTION: +! Wrapper routine to gather int 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , pointer :: alocal(:) ! local data (output) + integer , pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid + integer ,optional,intent(in) :: missing ! missing value +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + integer ,pointer :: adata(:) ! temporary data array + integer ,pointer :: mvect(:) ! local array for mask + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'gather_1darray_int' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lsize = size(alocal,dim=1) + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + if (present(missing)) then + istring = "mask" + endif + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(istring) == 0) then + istring = trim(fname) + else + istring = trim(istring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + + if (debug > 1) call t_startf(trim(subname)//'_pack') + allocate(adata(lsize)) + do n2 = lb2,ub2 + do n1 = lb1,ub1 + adata(n1-lb1+1) = alocal(n1) + enddo + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importIattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + + if (present(missing)) then + allocate(mvect(lsize)) + do n1 = lb1,ub1 + mvect(n1-lb1+1) = 1 + enddo + call mct_aVect_importIattr(AVi,"mask",mvect,lsize) + deallocate(mvect) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_gath') + + if (present(missing)) then +! tcx wait for update in mct, then get rid of "mask" +! call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom, missing = missing) + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + else + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_gath') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + if (masterproc) then + lsize = size(aglobal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportIattr(AVo,trim(fname),adata,lsize) + aglobal(1:lsize) = adata(1:lsize) + enddo + deallocate(adata) + if (present(missing)) then + allocate(mvect(lsize)) + call mct_aVect_exportIattr(AVo,"mask",mvect,lsize) + do n1 = 1,lsize + if (mvect(n1) == 0) then + do n2 = lb2,ub2 + aglobal(n1) = missing + enddo + endif + enddo + deallocate(mvect) + endif + endif + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVo) + endif + + call mct_aVect_clean(AVi) + + call t_stopf(trim(subname)//'_total') + + end subroutine gather_1darray_int + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: scatter_1darray_real +! +! !INTERFACE: + subroutine scatter_1darray_real (alocal, aglobal, clmlevel) +! +! !DESCRIPTION: +! Wrapper routine to scatter real 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: alocal(:) ! local data (output) + real(r8), pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + real(r8),pointer :: adata(:) ! local data array + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'scatter_1darray_real' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(rstring) == 0) then + rstring = trim(fname) + else + rstring = trim(rstring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + if (debug > 1) call t_startf(trim(subname)//'_pack') + + if (masterproc) then + lsize = size(aglobal,dim=1) + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + allocate(adata(lsize)) + do n2 = lb2,ub2 + adata(1:lsize) = aglobal(1:lsize) + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importRattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_scat') + + call mct_aVect_scatter(AVi, AVo, gsmap, 0, mpicom) + + if (debug > 1) call t_stopf(trim(subname)//'_scat') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + lsize = size(alocal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportRattr(AVo,trim(fname),adata,lsize) + do n1 = lb1,ub1 + alocal(n1) = adata(n1-lb1+1) + enddo + enddo + deallocate(adata) + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVi) + endif + call mct_aVect_clean(AVo) + + call t_stopf(trim(subname)//'_total') + + end subroutine scatter_1darray_real + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: gather_1darray_real +! +! !INTERFACE: + subroutine gather_1darray_real (alocal, aglobal, clmlevel, missing) +! +! !DESCRIPTION: +! Wrapper routine to gather real 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: alocal(:) ! local data (output) + real(r8), pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid + real(r8),optional,intent(in) :: missing ! missing value +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + real(r8),pointer :: adata(:) ! temporary data array + integer ,pointer :: mvect(:) ! local array for mask + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'gather_1darray_real' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lsize = size(alocal,dim=1) + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + if (present(missing)) then + istring = "mask" + endif + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(rstring) == 0) then + rstring = trim(fname) + else + rstring = trim(rstring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + + if (debug > 1) call t_startf(trim(subname)//'_pack') + allocate(adata(lsize)) + do n2 = lb2,ub2 + do n1 = lb1,ub1 + adata(n1-lb1+1) = alocal(n1) + enddo + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importRattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + + if (present(missing)) then + allocate(mvect(lsize)) + do n1 = lb1,ub1 + mvect(n1-lb1+1) = 1 + enddo + call mct_aVect_importIattr(AVi,"mask",mvect,lsize) + deallocate(mvect) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_gath') + + if (present(missing)) then +! tcx wait for update in mct, then get rid of "mask" +! call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom, missing = missing) + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + else + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_gath') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + if (masterproc) then + lsize = size(aglobal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportRattr(AVo,trim(fname),adata,lsize) + aglobal(1:lsize) = adata(1:lsize) + enddo + deallocate(adata) + if (present(missing)) then + allocate(mvect(lsize)) + call mct_aVect_exportIattr(AVo,"mask",mvect,lsize) + do n1 = 1,lsize + if (mvect(n1) == 0) then + do n2 = lb2,ub2 + aglobal(n1) = missing + enddo + endif + enddo + deallocate(mvect) + endif + endif + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVo) + endif + + call mct_aVect_clean(AVi) + + call t_stopf(trim(subname)//'_total') + + end subroutine gather_1darray_real + +end module spmdGathScatMod diff --git a/components/clm/src/utils/spmdMod.F90 b/components/clm/src/utils/spmdMod.F90 new file mode 100644 index 0000000000..6983b96281 --- /dev/null +++ b/components/clm/src/utils/spmdMod.F90 @@ -0,0 +1,142 @@ + +module spmdMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: spmdMod +! +! !DESCRIPTION: +! SPMD initialization +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: iulog + implicit none + + private + +#include + + save + + ! Default settings valid even if there is no spmd + + logical, public :: masterproc ! proc 0 logical for printing msgs + integer, public :: iam ! processor number + integer, public :: npes ! number of processors for clm + integer, public :: mpicom ! communicator group for clm + integer, public :: comp_id ! component id + + ! + ! Public methods + ! + public :: spmd_init ! Initialization + + ! + ! Values from mpif.h that can be used + ! + public :: MPI_INTEGER + public :: MPI_REAL8 + public :: MPI_LOGICAL + public :: MPI_SUM + public :: MPI_MIN + public :: MPI_MAX + public :: MPI_LOR + public :: MPI_STATUS_SIZE + public :: MPI_ANY_SOURCE + public :: MPI_CHARACTER + public :: MPI_COMM_WORLD + public :: MPI_MAX_PROCESSOR_NAME + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: spmd_init( clm_mpicom ) +! +! !INTERFACE: + subroutine spmd_init( clm_mpicom, LNDID ) +! +! !DESCRIPTION: +! MPI initialization (number of cpus, processes, tids, etc) +! +! !USES +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: clm_mpicom + integer, intent(in) :: LNDID +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i,j ! indices + integer :: ier ! return error status + integer :: mylength ! my processor length + logical :: mpi_running ! temporary + integer, allocatable :: length(:) + integer, allocatable :: displ(:) + character*(MPI_MAX_PROCESSOR_NAME), allocatable :: procname(:) + character*(MPI_MAX_PROCESSOR_NAME) :: myprocname +!----------------------------------------------------------------------- + + ! Initialize mpi communicator group + + mpicom = clm_mpicom + + comp_id = LNDID + + ! Get my processor id + + call mpi_comm_rank(mpicom, iam, ier) + if (iam==0) then + masterproc = .true. + else + masterproc = .false. + end if + + ! Get number of processors + + call mpi_comm_size(mpicom, npes, ier) + + ! Get my processor names + + allocate (length(0:npes-1), displ(0:npes-1), procname(0:npes-1)) + + call mpi_get_processor_name (myprocname, mylength, ier) + call mpi_allgather(mylength,1,MPI_INTEGER,length,1,MPI_INTEGER,mpicom,ier) + + do i = 0,npes-1 + displ(i)=i*MPI_MAX_PROCESSOR_NAME + end do + call mpi_gatherv (myprocname,mylength,MPI_CHARACTER, & + procname,length,displ,MPI_CHARACTER,0,mpicom,ier) + if (masterproc) then + write(iulog,100)npes + write(iulog,200) + write(iulog,220) + do i=0,npes-1 + write(iulog,250)i,(procname((i))(j:j),j=1,length(i)) + end do + endif + + deallocate (length, displ, procname) + +100 format(//,i3," pes participating in computation for CLM") +200 format(/,35('-')) +220 format(/,"NODE#",2x,"NAME") +250 format("(",i5,")",2x,100a1,//) + + end subroutine spmd_init + +end module spmdMod diff --git a/components/clm/src/utils/test/CMakeLists.txt b/components/clm/src/utils/test/CMakeLists.txt new file mode 100644 index 0000000000..c69177105c --- /dev/null +++ b/components/clm/src/utils/test/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(clm_time_manager_test) diff --git a/components/clm/src/utils/test/clm_time_manager_test/CMakeLists.txt b/components/clm/src/utils/test/clm_time_manager_test/CMakeLists.txt new file mode 100644 index 0000000000..3651eaf984 --- /dev/null +++ b/components/clm/src/utils/test/clm_time_manager_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(clm_time_manager test_clm_time_manager_exe + "test_clm_time_manager.pf" "") + +target_link_libraries(test_clm_time_manager_exe clm csm_share esmf_wrf_timemgr) diff --git a/components/clm/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf b/components/clm/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf new file mode 100644 index 0000000000..b1369e1972 --- /dev/null +++ b/components/clm/src/utils/test/clm_time_manager_test/test_clm_time_manager.pf @@ -0,0 +1,104 @@ +module test_clm_time_manager + + ! Tests of clm_time_manager + + use pfunit_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_time_manager + use unittestTimeManagerMod, only : unittest_timemgr_setup, unittest_timemgr_teardown + use unittestTimeManagerMod, only : set_date => unittest_timemgr_set_curr_date + + implicit none + save + + real(r8), parameter :: tol = 1.e-13_r8 + integer, parameter :: dtime = 1800 + + @TestCase + type, extends(TestCase) :: TestTimeManager + contains + procedure :: setUp + procedure :: tearDown + end type TestTimeManager + +contains + + subroutine setUp(this) + class(TestTimeManager), intent(inout) :: this + + call unittest_timemgr_setup(dtime=dtime) + end subroutine setUp + + subroutine tearDown(this) + class(TestTimeManager), intent(inout) :: this + + call unittest_timemgr_teardown() + end subroutine tearDown + + @Test + subroutine getStepSize_returnsCorrectValue(this) + class(TestTimeManager), intent(inout) :: this + integer :: step_size + + step_size = get_step_size() + + @assertEqual(dtime, step_size) + end subroutine getStepSize_returnsCorrectValue + + @Test + subroutine getCurrYearfrac_atYearBoundary_returns0(this) + class(TestTimeManager), intent(inout) :: this + real(r8) :: yearfrac + + call set_date(yr=2, mon=1, day=1, tod=0) + + yearfrac = get_curr_yearfrac() + + @assertEqual(0._r8, yearfrac) + end subroutine getCurrYearfrac_atYearBoundary_returns0 + + @Test + subroutine getCurrYearfrac_inMiddleOfYear_returnsCorrectValue(this) + class(TestTimeManager), intent(inout) :: this + real(r8) :: yearfrac + real(r8) :: yearfrac_expected + + call set_date(yr=2, mon=3, day=1, tod=43200) + + yearfrac = get_curr_yearfrac() + + yearfrac_expected = 59.5_r8 / 365._r8 + @assertEqual(yearfrac_expected, yearfrac) + end subroutine getCurrYearfrac_inMiddleOfYear_returnsCorrectValue + + @Test + subroutine getPrevYearfrac_atYearBoundary_returnsLargeValue(this) + class(TestTimeManager), intent(inout) :: this + real(r8) :: yearfrac + integer, parameter :: secs_in_day = 86400 + real(r8) :: yearfrac_expected + + call set_date(yr=2, mon=1, day=1, tod=0) + + yearfrac = get_prev_yearfrac() + + yearfrac_expected = (365._r8 - real(dtime, r8) / real(secs_in_day, r8)) / 365._r8 + @assertEqual(yearfrac_expected, yearfrac) + end subroutine getPrevYearfrac_atYearBoundary_returnsLargeValue + + @Test + subroutine getPrevYearfrac_inMiddleOfYear_returnsCorrectValue(this) + class(TestTimeManager), intent(inout) :: this + real(r8) :: yearfrac + integer, parameter :: secs_in_day = 86400 + real(r8) :: yearfrac_expected + + call set_date(yr=2, mon=3, day=1, tod=43200) + + yearfrac = get_prev_yearfrac() + + yearfrac_expected = (59.5_r8 - real(dtime, r8) / real(secs_in_day, r8)) / 365._r8 + @assertEqual(yearfrac_expected, yearfrac) + end subroutine getPrevYearfrac_inMiddleOfYear_returnsCorrectValue + +end module test_clm_time_manager diff --git a/components/clm/src_clm40/biogeochem/C13SummaryMod.F90 b/components/clm/src_clm40/biogeochem/C13SummaryMod.F90 new file mode 100644 index 0000000000..79d926e6bd --- /dev/null +++ b/components/clm/src_clm40/biogeochem/C13SummaryMod.F90 @@ -0,0 +1,820 @@ +module C13SummaryMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: C13SummaryMod +! +! !DESCRIPTION: +! Module for isotope carbon summary calculations +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: C13Summary +! +! !REVISION HISTORY: +! 7/13/2005: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13Summary +! +! !INTERFACE: +subroutine C13Summary(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, perform pft and column-level carbon +! summary calculations +! +! !USES: + use clmtype + use pft2colMod, only: p2c + use clm_varctl, only: iulog, use_c13 + use shr_sys_mod, only: shr_sys_flush +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 12/9/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss + real(r8), pointer :: er(:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: hr(:) ! (gC/m2/s) total heterotrophic respiration + real(r8), pointer :: litfire(:) ! (gC/m2/s) litter fire losses + real(r8), pointer :: lithr(:) ! (gC/m2/s) litter heterotrophic respiration + real(r8), pointer :: litr1_hr(:) + real(r8), pointer :: litr2_hr(:) + real(r8), pointer :: litr3_hr(:) + real(r8), pointer :: m_cwdc_to_fire(:) + real(r8), pointer :: m_litr1c_to_fire(:) + real(r8), pointer :: m_litr2c_to_fire(:) + real(r8), pointer :: m_litr3c_to_fire(:) + real(r8), pointer :: nee(:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, land-use, and wood products flux, positive for source + real(r8), pointer :: nbp(:) ! (gC/m2/s) net biome production, includes fire, land-use, and wood products flux, positive for sink + real(r8), pointer :: nep(:) ! (gC/m2/s) net ecosystem production, excludes fire, land-use, and wood products flux, positive for sink + real(r8), pointer :: col_ar(:) ! (gC/m2/s) autotrophic respiration (MR + GR) + real(r8), pointer :: col_gpp(:) !GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: col_npp(:) ! (gC/m2/s) net primary production + real(r8), pointer :: col_pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss + real(r8), pointer :: col_rr(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: col_vegfire(:) ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal) + real(r8), pointer :: col_wood_harvestc(:) + real(r8), pointer :: soil1_hr(:) + real(r8), pointer :: soil2_hr(:) + real(r8), pointer :: soil3_hr(:) + real(r8), pointer :: soil4_hr(:) + real(r8), pointer :: somfire(:) ! (gC/m2/s) soil organic matter fire losses + real(r8), pointer :: somhr(:) ! (gC/m2/s) soil organic matter heterotrophic respiration + real(r8), pointer :: sr(:) ! (gC/m2/s) total soil respiration (HR + root resp) + real(r8), pointer :: totfire(:) ! (gC/m2/s) total ecosystem fire losses + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: col_totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: col_totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc(:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totlitc(:) ! (gC/m2) total litter carbon + real(r8), pointer :: totsomc(:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: agnpp(:) ! (gC/m2/s) aboveground NPP + real(r8), pointer :: ar(:) ! (gC/m2/s) autotrophic respiration (MR + GR) + real(r8), pointer :: bgnpp(:) ! (gC/m2/s) belowground NPP + real(r8), pointer :: cpool_deadcroot_gr(:) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) + real(r8), pointer :: cpool_deadstem_gr(:) + real(r8), pointer :: cpool_deadstem_storage_gr(:) + real(r8), pointer :: cpool_froot_gr(:) + real(r8), pointer :: cpool_froot_storage_gr(:) + real(r8), pointer :: cpool_leaf_gr(:) + real(r8), pointer :: cpool_leaf_storage_gr(:) + real(r8), pointer :: cpool_livecroot_gr(:) + real(r8), pointer :: cpool_livecroot_storage_gr(:) + real(r8), pointer :: cpool_livestem_gr(:) + real(r8), pointer :: cpool_livestem_storage_gr(:) + real(r8), pointer :: cpool_to_deadcrootc(:) + real(r8), pointer :: cpool_to_deadstemc(:) + real(r8), pointer :: cpool_to_frootc(:) + real(r8), pointer :: cpool_to_leafc(:) + real(r8), pointer :: cpool_to_livecrootc(:) + real(r8), pointer :: cpool_to_livestemc(:) + real(r8), pointer :: current_gr(:) ! (gC/m2/s) growth resp for new growth displayed in this timestep + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: froot_curmr(:) + real(r8), pointer :: froot_xsmr(:) + real(r8), pointer :: gpp(:) !GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: gr(:) ! (gC/m2/s) total growth respiration + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: leaf_curmr(:) + real(r8), pointer :: leaf_xsmr(:) + real(r8), pointer :: litfall(:) ! (gC/m2/s) litterfall (leaves and fine roots) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: livecroot_mr(:) + real(r8), pointer :: livecroot_curmr(:) + real(r8), pointer :: livecroot_xsmr(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: livestem_curmr(:) + real(r8), pointer :: livestem_xsmr(:) + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_to_fire(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_fire(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_frootc_to_fire(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_fire(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_fire(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_fire(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_fire(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_leafc_to_fire(:) + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_fire(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_to_fire(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_fire(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_to_fire(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) + real(r8), pointer :: mr(:) ! (gC/m2/s) maintenance respiration + real(r8), pointer :: npp(:) ! (gC/m2/s) net primary production + real(r8), pointer :: pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss + real(r8), pointer :: psnshade_to_cpool(:) + real(r8), pointer :: psnsun_to_cpool(:) + real(r8), pointer :: rr(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: storage_gr(:) ! (gC/m2/s) growth resp for growth sent to storage for later display + real(r8), pointer :: transfer_deadcroot_gr(:) + real(r8), pointer :: transfer_deadstem_gr(:) + real(r8), pointer :: transfer_froot_gr(:) + real(r8), pointer :: transfer_gr(:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep + real(r8), pointer :: transfer_leaf_gr(:) + real(r8), pointer :: transfer_livecroot_gr(:) + real(r8), pointer :: transfer_livestem_gr(:) + real(r8), pointer :: wood_harvestc(:) ! (gC/m2/s) pft-level wood harvest (to product pools) + real(r8), pointer :: vegfire(:) ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal) + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) !(gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: dispvegc(:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) !(gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: storvegc(:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + ! for landcover change + real(r8), pointer :: dwt_closs(:) ! (gC/m2/s) total carbon loss from product pools and conversion + real(r8), pointer :: dwt_conv_cflux(:) ! (gC/m2/s) conversion C flux (immediate loss to atm) + real(r8), pointer :: prod10c_loss(:) ! (gC/m2/s) loss from 10-yr wood product pool + real(r8), pointer :: prod100c_loss(:) ! (gC/m2/s) loss from 100-yr wood product pool + real(r8), pointer :: product_closs(:) ! (gC/m2/s) total wood product carbon loss + real(r8), pointer :: prod10c(:) ! (gC/m2) wood product C pool, 10-year lifespan + real(r8), pointer :: prod100c(:) ! (gC/m2) wood product C pool, 100-year lifespan + real(r8), pointer :: totprodc(:) ! (gC/m2) total wood product C +! +! +! local pointers to implicit in/out scalars +! +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + +!EOP +!----------------------------------------------------------------------- + + if (.not. use_c13) then + RETURN + end if + + ! assign local pointers + col_fire_closs => cc13f%col_fire_closs + er => cc13f%er + hr => cc13f%hr + litfire => cc13f%litfire + lithr => cc13f%lithr + litr1_hr => cc13f%litr1_hr + litr2_hr => cc13f%litr2_hr + litr3_hr => cc13f%litr3_hr + m_cwdc_to_fire => cc13f%m_cwdc_to_fire + m_litr1c_to_fire => cc13f%m_litr1c_to_fire + m_litr2c_to_fire => cc13f%m_litr2c_to_fire + m_litr3c_to_fire => cc13f%m_litr3c_to_fire + nee => cc13f%nee + nep => cc13f%nep + nbp => cc13f%nbp + col_ar => pc13f_a%ar + col_gpp => pc13f_a%gpp + col_npp => pc13f_a%npp + col_pft_fire_closs => pc13f_a%pft_fire_closs + col_rr => pc13f_a%rr + col_vegfire => pc13f_a%vegfire + col_wood_harvestc => pc13f_a%wood_harvestc + soil1_hr => cc13f%soil1_hr + soil2_hr => cc13f%soil2_hr + soil3_hr => cc13f%soil3_hr + soil4_hr => cc13f%soil4_hr + somfire => cc13f%somfire + somhr => cc13f%somhr + sr => cc13f%sr + totfire => cc13f%totfire + + ! dynamic landcover pointers + dwt_closs => cc13f%dwt_closs + dwt_conv_cflux => cc13f%dwt_conv_cflux + + ! wood product pointers + prod10c_loss => cc13f%prod10c_loss + prod100c_loss => cc13f%prod100c_loss + product_closs => cc13f%product_closs + prod10c => cc13s%prod10c + prod100c => cc13s%prod100c + totprodc => cc13s%totprodc + + cwdc => cc13s%cwdc + litr1c => cc13s%litr1c + litr2c => cc13s%litr2c + litr3c => cc13s%litr3c + col_totpftc => pc13s_a%totpftc + col_totvegc => pc13s_a%totvegc + soil1c => cc13s%soil1c + soil2c => cc13s%soil2c + soil3c => cc13s%soil3c + soil4c => cc13s%soil4c + totcolc => cc13s%totcolc + totecosysc => cc13s%totecosysc + totlitc => cc13s%totlitc + totsomc => cc13s%totsomc + agnpp => pc13f%agnpp + ar => pc13f%ar + bgnpp => pc13f%bgnpp + cpool_deadcroot_gr => pc13f%cpool_deadcroot_gr + cpool_deadcroot_storage_gr => pc13f%cpool_deadcroot_storage_gr + cpool_deadstem_gr => pc13f%cpool_deadstem_gr + cpool_deadstem_storage_gr => pc13f%cpool_deadstem_storage_gr + cpool_froot_gr => pc13f%cpool_froot_gr + cpool_froot_storage_gr => pc13f%cpool_froot_storage_gr + cpool_leaf_gr => pc13f%cpool_leaf_gr + cpool_leaf_storage_gr => pc13f%cpool_leaf_storage_gr + cpool_livecroot_gr => pc13f%cpool_livecroot_gr + cpool_livecroot_storage_gr => pc13f%cpool_livecroot_storage_gr + cpool_livestem_gr => pc13f%cpool_livestem_gr + cpool_livestem_storage_gr => pc13f%cpool_livestem_storage_gr + cpool_to_deadcrootc => pc13f%cpool_to_deadcrootc + cpool_to_deadstemc => pc13f%cpool_to_deadstemc + cpool_to_frootc => pc13f%cpool_to_frootc + cpool_to_leafc => pc13f%cpool_to_leafc + cpool_to_livecrootc => pc13f%cpool_to_livecrootc + cpool_to_livestemc => pc13f%cpool_to_livestemc + current_gr => pc13f%current_gr + deadcrootc_xfer_to_deadcrootc => pc13f%deadcrootc_xfer_to_deadcrootc + deadstemc_xfer_to_deadstemc => pc13f%deadstemc_xfer_to_deadstemc + frootc_to_litter => pc13f%frootc_to_litter + frootc_xfer_to_frootc => pc13f%frootc_xfer_to_frootc + froot_mr => pc13f%froot_mr + froot_curmr => pc13f%froot_curmr + froot_xsmr => pc13f%froot_xsmr + gpp => pc13f%gpp + gr => pc13f%gr + leafc_to_litter => pc13f%leafc_to_litter + leafc_xfer_to_leafc => pc13f%leafc_xfer_to_leafc + leaf_mr => pc13f%leaf_mr + leaf_curmr => pc13f%leaf_curmr + leaf_xsmr => pc13f%leaf_xsmr + litfall => pc13f%litfall + livecrootc_xfer_to_livecrootc => pc13f%livecrootc_xfer_to_livecrootc + livecroot_mr => pc13f%livecroot_mr + livecroot_curmr => pc13f%livecroot_curmr + livecroot_xsmr => pc13f%livecroot_xsmr + livestemc_xfer_to_livestemc => pc13f%livestemc_xfer_to_livestemc + livestem_mr => pc13f%livestem_mr + livestem_curmr => pc13f%livestem_curmr + livestem_xsmr => pc13f%livestem_xsmr + m_deadcrootc_storage_to_fire => pc13f%m_deadcrootc_storage_to_fire + m_deadcrootc_storage_to_litter => pc13f%m_deadcrootc_storage_to_litter + m_deadcrootc_to_fire => pc13f%m_deadcrootc_to_fire + m_deadcrootc_to_litter => pc13f%m_deadcrootc_to_litter + m_deadcrootc_to_litter_fire => pc13f%m_deadcrootc_to_litter_fire + m_deadcrootc_xfer_to_fire => pc13f%m_deadcrootc_xfer_to_fire + m_deadcrootc_xfer_to_litter => pc13f%m_deadcrootc_xfer_to_litter + m_deadstemc_storage_to_fire => pc13f%m_deadstemc_storage_to_fire + m_deadstemc_storage_to_litter => pc13f%m_deadstemc_storage_to_litter + m_deadstemc_to_fire => pc13f%m_deadstemc_to_fire + m_deadstemc_to_litter => pc13f%m_deadstemc_to_litter + m_deadstemc_to_litter_fire => pc13f%m_deadstemc_to_litter_fire + m_deadstemc_xfer_to_fire => pc13f%m_deadstemc_xfer_to_fire + m_deadstemc_xfer_to_litter => pc13f%m_deadstemc_xfer_to_litter + m_frootc_storage_to_fire => pc13f%m_frootc_storage_to_fire + m_frootc_storage_to_litter => pc13f%m_frootc_storage_to_litter + m_frootc_to_fire => pc13f%m_frootc_to_fire + m_frootc_to_litter => pc13f%m_frootc_to_litter + m_frootc_xfer_to_fire => pc13f%m_frootc_xfer_to_fire + m_frootc_xfer_to_litter => pc13f%m_frootc_xfer_to_litter + m_gresp_storage_to_fire => pc13f%m_gresp_storage_to_fire + m_gresp_storage_to_litter => pc13f%m_gresp_storage_to_litter + m_gresp_xfer_to_fire => pc13f%m_gresp_xfer_to_fire + m_gresp_xfer_to_litter => pc13f%m_gresp_xfer_to_litter + m_leafc_storage_to_fire => pc13f%m_leafc_storage_to_fire + m_leafc_storage_to_litter => pc13f%m_leafc_storage_to_litter + m_leafc_to_fire => pc13f%m_leafc_to_fire + m_leafc_to_litter => pc13f%m_leafc_to_litter + m_leafc_xfer_to_fire => pc13f%m_leafc_xfer_to_fire + m_leafc_xfer_to_litter => pc13f%m_leafc_xfer_to_litter + m_livecrootc_storage_to_fire => pc13f%m_livecrootc_storage_to_fire + m_livecrootc_storage_to_litter => pc13f%m_livecrootc_storage_to_litter + m_livecrootc_to_fire => pc13f%m_livecrootc_to_fire + m_livecrootc_to_litter => pc13f%m_livecrootc_to_litter + m_livecrootc_xfer_to_fire => pc13f%m_livecrootc_xfer_to_fire + m_livecrootc_xfer_to_litter => pc13f%m_livecrootc_xfer_to_litter + m_livestemc_storage_to_fire => pc13f%m_livestemc_storage_to_fire + m_livestemc_storage_to_litter => pc13f%m_livestemc_storage_to_litter + m_livestemc_to_fire => pc13f%m_livestemc_to_fire + m_livestemc_to_litter => pc13f%m_livestemc_to_litter + m_livestemc_xfer_to_fire => pc13f%m_livestemc_xfer_to_fire + m_livestemc_xfer_to_litter => pc13f%m_livestemc_xfer_to_litter + hrv_leafc_to_litter => pc13f%hrv_leafc_to_litter + hrv_leafc_storage_to_litter => pc13f%hrv_leafc_storage_to_litter + hrv_leafc_xfer_to_litter => pc13f%hrv_leafc_xfer_to_litter + hrv_frootc_to_litter => pc13f%hrv_frootc_to_litter + hrv_frootc_storage_to_litter => pc13f%hrv_frootc_storage_to_litter + hrv_frootc_xfer_to_litter => pc13f%hrv_frootc_xfer_to_litter + hrv_livestemc_to_litter => pc13f%hrv_livestemc_to_litter + hrv_livestemc_storage_to_litter => pc13f%hrv_livestemc_storage_to_litter + hrv_livestemc_xfer_to_litter => pc13f%hrv_livestemc_xfer_to_litter + hrv_deadstemc_to_prod10c => pc13f%hrv_deadstemc_to_prod10c + hrv_deadstemc_to_prod100c => pc13f%hrv_deadstemc_to_prod100c + hrv_deadstemc_storage_to_litter => pc13f%hrv_deadstemc_storage_to_litter + hrv_deadstemc_xfer_to_litter => pc13f%hrv_deadstemc_xfer_to_litter + hrv_livecrootc_to_litter => pc13f%hrv_livecrootc_to_litter + hrv_livecrootc_storage_to_litter => pc13f%hrv_livecrootc_storage_to_litter + hrv_livecrootc_xfer_to_litter => pc13f%hrv_livecrootc_xfer_to_litter + hrv_deadcrootc_to_litter => pc13f%hrv_deadcrootc_to_litter + hrv_deadcrootc_storage_to_litter => pc13f%hrv_deadcrootc_storage_to_litter + hrv_deadcrootc_xfer_to_litter => pc13f%hrv_deadcrootc_xfer_to_litter + hrv_gresp_storage_to_litter => pc13f%hrv_gresp_storage_to_litter + hrv_gresp_xfer_to_litter => pc13f%hrv_gresp_xfer_to_litter + hrv_xsmrpool_to_atm => pc13f%hrv_xsmrpool_to_atm + mr => pc13f%mr + npp => pc13f%npp + pft_fire_closs => pc13f%pft_fire_closs + psnshade_to_cpool => pc13f%psnshade_to_cpool + psnsun_to_cpool => pc13f%psnsun_to_cpool + rr => pc13f%rr + storage_gr => pc13f%storage_gr + transfer_deadcroot_gr => pc13f%transfer_deadcroot_gr + transfer_deadstem_gr => pc13f%transfer_deadstem_gr + transfer_froot_gr => pc13f%transfer_froot_gr + transfer_gr => pc13f%transfer_gr + transfer_leaf_gr => pc13f%transfer_leaf_gr + transfer_livecroot_gr => pc13f%transfer_livecroot_gr + transfer_livestem_gr => pc13f%transfer_livestem_gr + vegfire => pc13f%vegfire + wood_harvestc => pc13f%wood_harvestc + cpool => pc13s%cpool + xsmrpool => pc13s%xsmrpool + deadcrootc => pc13s%deadcrootc + deadcrootc_storage => pc13s%deadcrootc_storage + deadcrootc_xfer => pc13s%deadcrootc_xfer + deadstemc => pc13s%deadstemc + deadstemc_storage => pc13s%deadstemc_storage + deadstemc_xfer => pc13s%deadstemc_xfer + dispvegc => pc13s%dispvegc + frootc => pc13s%frootc + frootc_storage => pc13s%frootc_storage + frootc_xfer => pc13s%frootc_xfer + gresp_storage => pc13s%gresp_storage + gresp_xfer => pc13s%gresp_xfer + leafc => pc13s%leafc + leafc_storage => pc13s%leafc_storage + leafc_xfer => pc13s%leafc_xfer + livecrootc => pc13s%livecrootc + livecrootc_storage => pc13s%livecrootc_storage + livecrootc_xfer => pc13s%livecrootc_xfer + livestemc => pc13s%livestemc + livestemc_storage => pc13s%livestemc_storage + livestemc_xfer => pc13s%livestemc_xfer + storvegc => pc13s%storvegc + totpftc => pc13s%totpftc + totvegc => pc13s%totvegc + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! calculate pft-level summary carbon fluxes and states + + ! gross primary production (GPP) + gpp(p) = & + psnsun_to_cpool(p) + & + psnshade_to_cpool(p) + + ! maintenance respiration (MR) + + leaf_mr(p) = leaf_curmr(p) + leaf_xsmr(p) + froot_mr(p) = froot_curmr(p) + froot_xsmr(p) + livestem_mr(p) = livestem_curmr(p) + livestem_xsmr(p) + livecroot_mr(p) = livecroot_curmr(p) + livecroot_xsmr(p) + + mr(p) = & + leaf_mr(p) + & + froot_mr(p) + & + livestem_mr(p) + & + livecroot_mr(p) + ! growth respiration (GR) + ! current GR is respired this time step for new growth displayed in this timestep + current_gr(p) = & + cpool_leaf_gr(p) + & + cpool_froot_gr(p) + & + cpool_livestem_gr(p) + & + cpool_deadstem_gr(p) + & + cpool_livecroot_gr(p) + & + cpool_deadcroot_gr(p) + + ! transfer GR is respired this time step for transfer growth displayed in this timestep + transfer_gr(p) = & + transfer_leaf_gr(p) + & + transfer_froot_gr(p) + & + transfer_livestem_gr(p) + & + transfer_deadstem_gr(p) + & + transfer_livecroot_gr(p) + & + transfer_deadcroot_gr(p) + + ! storage GR is respired this time step for growth sent to storage for later display + storage_gr(p) = & + cpool_leaf_storage_gr(p) + & + cpool_froot_storage_gr(p) + & + cpool_livestem_storage_gr(p) + & + cpool_deadstem_storage_gr(p) + & + cpool_livecroot_storage_gr(p) + & + cpool_deadcroot_storage_gr(p) + + ! GR is the sum of current + transfer + storage GR + gr(p) = & + current_gr(p) + & + transfer_gr(p) + & + storage_gr(p) + + ! autotrophic respiration (AR) + ar(p) = mr(p) + gr(p) + + ! root respiration (RR) + rr(p) = & + froot_mr(p) + & + cpool_froot_gr(p) + & + cpool_livecroot_gr(p) + & + cpool_deadcroot_gr(p) + & + transfer_froot_gr(p) + & + transfer_livecroot_gr(p) + & + transfer_deadcroot_gr(p) + & + cpool_froot_storage_gr(p) + & + cpool_livecroot_storage_gr(p) + & + cpool_deadcroot_storage_gr(p) + + ! net primary production (NPP) + npp(p) = gpp(p) - ar(p) + + ! aboveground NPP: leaf, live stem, dead stem (AGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of AGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + agnpp(p) = & + cpool_to_leafc(p) + & + leafc_xfer_to_leafc(p) + & + cpool_to_livestemc(p) + & + livestemc_xfer_to_livestemc(p) + & + cpool_to_deadstemc(p) + & + deadstemc_xfer_to_deadstemc(p) + + ! belowground NPP: fine root, live coarse root, dead coarse root (BGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of BGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + bgnpp(p) = & + cpool_to_frootc(p) + & + frootc_xfer_to_frootc(p) + & + cpool_to_livecrootc(p) + & + livecrootc_xfer_to_livecrootc(p) + & + cpool_to_deadcrootc(p) + & + deadcrootc_xfer_to_deadcrootc(p) + + ! litterfall (LITFALL) + litfall(p) = & + leafc_to_litter(p) + & + frootc_to_litter(p) + & + m_leafc_to_litter(p) + & + m_leafc_storage_to_litter(p) + & + m_leafc_xfer_to_litter(p) + & + m_frootc_to_litter(p) + & + m_frootc_storage_to_litter(p) + & + m_frootc_xfer_to_litter(p) + & + m_livestemc_to_litter(p) + & + m_livestemc_storage_to_litter(p) + & + m_livestemc_xfer_to_litter(p) + & + m_deadstemc_to_litter(p) + & + m_deadstemc_storage_to_litter(p) + & + m_deadstemc_xfer_to_litter(p) + & + m_livecrootc_to_litter(p) + & + m_livecrootc_storage_to_litter(p) + & + m_livecrootc_xfer_to_litter(p) + & + m_deadcrootc_to_litter(p) + & + m_deadcrootc_storage_to_litter(p) + & + m_deadcrootc_xfer_to_litter(p) + & + m_gresp_storage_to_litter(p) + & + m_gresp_xfer_to_litter(p) + & + m_deadstemc_to_litter_fire(p) + & + m_deadcrootc_to_litter_fire(p) + & + hrv_leafc_to_litter(p) + & + hrv_leafc_storage_to_litter(p) + & + hrv_leafc_xfer_to_litter(p) + & + hrv_frootc_to_litter(p) + & + hrv_frootc_storage_to_litter(p) + & + hrv_frootc_xfer_to_litter(p) + & + hrv_livestemc_to_litter(p) + & + hrv_livestemc_storage_to_litter(p) + & + hrv_livestemc_xfer_to_litter(p) + & + hrv_deadstemc_storage_to_litter(p) + & + hrv_deadstemc_xfer_to_litter(p) + & + hrv_livecrootc_to_litter(p) + & + hrv_livecrootc_storage_to_litter(p)+ & + hrv_livecrootc_xfer_to_litter(p) + & + hrv_deadcrootc_to_litter(p) + & + hrv_deadcrootc_storage_to_litter(p)+ & + hrv_deadcrootc_xfer_to_litter(p) + & + hrv_gresp_storage_to_litter(p) + & + hrv_gresp_xfer_to_litter(p) + + ! pft-level fire losses (VEGFIRE) + vegfire(p) = 0._r8 + + ! pft-level wood harvest + wood_harvestc(p) = & + hrv_deadstemc_to_prod10c(p) + & + hrv_deadstemc_to_prod100c(p) + + ! pft-level carbon losses to fire + pft_fire_closs(p) = & + m_leafc_to_fire(p) + & + m_leafc_storage_to_fire(p) + & + m_leafc_xfer_to_fire(p) + & + m_frootc_to_fire(p) + & + m_frootc_storage_to_fire(p) + & + m_frootc_xfer_to_fire(p) + & + m_livestemc_to_fire(p) + & + m_livestemc_storage_to_fire(p) + & + m_livestemc_xfer_to_fire(p) + & + m_deadstemc_to_fire(p) + & + m_deadstemc_storage_to_fire(p) + & + m_deadstemc_xfer_to_fire(p) + & + m_livecrootc_to_fire(p) + & + m_livecrootc_storage_to_fire(p) + & + m_livecrootc_xfer_to_fire(p) + & + m_deadcrootc_to_fire(p) + & + m_deadcrootc_storage_to_fire(p) + & + m_deadcrootc_xfer_to_fire(p) + & + m_gresp_storage_to_fire(p) + & + m_gresp_xfer_to_fire(p) + + ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC) + dispvegc(p) = & + leafc(p) + & + frootc(p) + & + livestemc(p) + & + deadstemc(p) + & + livecrootc(p) + & + deadcrootc(p) + + ! stored vegetation carbon, excluding cpool (STORVEGC) + storvegc(p) = & + cpool(p) + & + leafc_storage(p) + & + frootc_storage(p) + & + livestemc_storage(p) + & + deadstemc_storage(p) + & + livecrootc_storage(p) + & + deadcrootc_storage(p) + & + leafc_xfer(p) + & + frootc_xfer(p) + & + livestemc_xfer(p) + & + deadstemc_xfer(p) + & + livecrootc_xfer(p) + & + deadcrootc_xfer(p) + & + gresp_storage(p) + & + gresp_xfer(p) + + ! total vegetation carbon, excluding cpool (TOTVEGC) + totvegc(p) = dispvegc(p) + storvegc(p) + + ! total pft-level carbon, including cpool (TOTPFTC) + totpftc(p) = totvegc(p) + xsmrpool(p) + + end do ! end of pfts loop + + ! use p2c routine to get selected column-average pft-level fluxes and states + call p2c(num_soilc, filter_soilc, gpp, col_gpp) + call p2c(num_soilc, filter_soilc, ar, col_ar) + call p2c(num_soilc, filter_soilc, rr, col_rr) + call p2c(num_soilc, filter_soilc, npp, col_npp) + call p2c(num_soilc, filter_soilc, vegfire, col_vegfire) + call p2c(num_soilc, filter_soilc, wood_harvestc, col_wood_harvestc) + call p2c(num_soilc, filter_soilc, totvegc, col_totvegc) + call p2c(num_soilc, filter_soilc, totpftc, col_totpftc) + call p2c(num_soilc, filter_soilc, pft_fire_closs, col_pft_fire_closs) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! litter heterotrophic respiration (LITHR) + lithr(c) = & + litr1_hr(c) + & + litr2_hr(c) + & + litr3_hr(c) + + ! soil organic matter heterotrophic respiration (SOMHR) + somhr(c) = & + soil1_hr(c) + & + soil2_hr(c) + & + soil3_hr(c) + & + soil4_hr(c) + + ! total heterotrophic respiration (HR) + hr(c) = lithr(c) + somhr(c) + + ! total soil respiration, heterotrophic + root respiration (SR) + sr(c) = col_rr(c) + hr(c) + + ! total ecosystem respiration, autotrophic + heterotrophic (ER) + er(c) = col_ar(c) + hr(c) + + ! litter fire losses (LITFIRE) + litfire(c) = 0._r8 + + ! total wood product loss + product_closs(c) = & + prod10c_loss(c) + & + prod100c_loss(c) + + ! soil organic matter fire losses (SOMFIRE) + somfire(c) = 0._r8 + + ! total ecosystem fire losses (TOTFIRE) + totfire(c) = & + litfire(c) + & + somfire(c) + & + col_vegfire(c) + + ! column-level carbon losses to fire, including pft losses + col_fire_closs(c) = & + m_litr1c_to_fire(c) + & + m_litr2c_to_fire(c) + & + m_litr3c_to_fire(c) + & + m_cwdc_to_fire(c) + & + col_pft_fire_closs(c) + + ! column-level carbon losses due to landcover change + dwt_closs(c) = & + dwt_conv_cflux(c) + + ! net ecosystem production, excludes fire flux, positive for sink (NEP) + nep(c) = col_gpp(c) - er(c) + + ! net ecosystem exchange of carbon, includes fire flux, positive for source (NBP) + nbp(c) = nep(c) - col_fire_closs(c) - dwt_closs(c) - product_closs(c) + + ! net ecosystem exchange of carbon, includes fire flux, positive for source (NEE) + nee(c) = -nep(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + + ! total litter carbon (TOTLITC) + totlitc(c) = & + litr1c(c) + & + litr2c(c) + & + litr3c(c) + + ! total soil organic matter carbon (TOTSOMC) + totsomc(c) = & + soil1c(c) + & + soil2c(c) + & + soil3c(c) + & + soil4c(c) + + ! total wood product carbon + totprodc(c) = & + prod10c(c) + & + prod100c(c) + + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + totecosysc(c) = & + cwdc(c) + & + totlitc(c) + & + totsomc(c) + & + totprodc(c) + & + col_totvegc(c) + + ! total column carbon, including veg and cpool (TOTCOLC) + totcolc(c) = & + cwdc(c) + & + totlitc(c) + & + totsomc(c) + & + totprodc(c) + & + col_totpftc(c) + + end do ! end of columns loop + + +end subroutine C13Summary +!----------------------------------------------------------------------- + +end module C13SummaryMod diff --git a/components/clm/src_clm40/biogeochem/CNAllocationMod.F90 b/components/clm/src_clm40/biogeochem/CNAllocationMod.F90 new file mode 100644 index 0000000000..5a760a0bc7 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNAllocationMod.F90 @@ -0,0 +1,902 @@ +module CNAllocationMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNAllocationMod +! +! !DESCRIPTION: +! Module holding routines used in allocation model for coupled carbon +! nitrogen code. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils , only: endrun + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNAllocationInit ! Initialization + public :: CNAllocation ! run method + +! !PUBLIC DATA MEMBERS: + character(len=*), parameter, public :: suplnAll=& ! Supplemental Nitrogen for all PFT's + 'ALL' + character(len=*), parameter, public :: suplnCrp=& ! Supplemental Nitrogen for prognostic Crop + 'PROG_CROP_ONLY' + character(len=*), parameter, public :: suplnNon=& ! No supplemental Nitrogen + 'NONE' + character(len=15), public :: suplnitro = suplnNon ! Supplemental Nitrogen mode +! !PRIVATE DATA MEMBERS: + real(r8):: dt !decomp timestep (seconds) + real(r8):: bdnr !bulk denitrification rate (1/s) + real(r8):: dayscrecover !number of days to recover negative cpool + real(r8), pointer :: arepr(:) !reproduction allocation coefficient + real(r8), pointer :: aroot(:) !root allocation coefficient + real(r8), pointer:: col_plant_ndemand(:) !column-level plant N demand + logical :: Carbon_only = .false. ! Carbon only mode + ! (Nitrogen is prescribed NOT prognostic) + logical :: crop_supln = .false. ! Prognostic crop receives supplemental Nitrogen +! +! !REVISION HISTORY: +! 8/5/03: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNAllocationInit +! +! !INTERFACE: +subroutine CNAllocationInit ( lbc, ubc, lbp, ubp ) +! +! !DESCRIPTION: +! +! !USES: + use clm_varcon , only: secspday + use clm_time_manager, only: get_step_size + use surfrdMod , only: crop_prog + use clm_varctl , only: iulog, use_c13 + use shr_infnan_mod , only: nan => shr_infnan_nan, assignment(=) +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 4/6/11: Created by Erik Kluzek +! +! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocationInit' +!EOP +!----------------------------------------------------------------------- + if ( crop_prog )then + allocate(arepr(lbp:ubp)) + allocate(aroot(lbp:ubp)) + arepr(:) = nan + aroot(:) = nan + end if + allocate(col_plant_ndemand(lbc:ubc)) + col_plant_ndemand(:) = nan + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! set some space-and-time constant parameters + bdnr = 0.5_r8 * (dt/secspday) + dayscrecover = 30.0_r8 + + ! Change namelist settings into private logical variables + select case(suplnitro) + case(suplnNon) + Carbon_only = .false. + crop_supln = .false. + case(suplnCrp) + Carbon_only = .false. + crop_supln = .true. + if ( .not. crop_prog )then + call endrun( trim(subname)//'ERROR: '//trim(suplnCrp)// & + ' can NOT be on when crop is NOT' ) + end if + case(suplnAll) + Carbon_only = .true. + crop_supln = .false. + case default + write(iulog,*) 'Supplemental Nitrogen flag (suplnitro) can only be: ', & + suplnNon, ",", suplnCrp, ', or ', suplnAll + call endrun( trim(subname)//'ERROR: supplemental Nitrogen flag is not correct' ) + end select + +end subroutine CNAllocationInit + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNAllocation +! +! !INTERFACE: +subroutine CNAllocation (lbp, ubp, lbc, ubc, & + num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp ) +! +! !DESCRIPTION: +! +! !USES: + use clmtype + use clm_varctl, only: iulog, use_c13 + use shr_sys_mod, only: shr_sys_flush + use pft2colMod, only: p2c + use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf, & + arooti, fleafi, allconsl, allconss, grperc, grpnow + use clm_varcon, only: secspday, istsoil, istcrop + use clm_varpar, only: max_pft_per_col +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + integer, intent(in) :: num_pcropp ! number of pfts in prognostic crop filter +! +! !CALLED FROM: +! subroutine CNdecompAlloc in module CNdecompMod.F90 +! +! !REVISION HISTORY: +! 8/5/03: Created by Peter Thornton +! 10/23/03, Peter Thornton: migrated to vector data structures +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays +! + ! pft level + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pfti(:) ! initial pft index in landunit + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] + real(r8), pointer :: xsmrpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: psnsun(:) ! sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) ! shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + real(r8), pointer :: c13_psnsun(:) ! C13 sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: c13_psnsha(:) ! C13 shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + real(r8), pointer :: laisun(:) ! sunlit projected leaf area index + real(r8), pointer :: laisha(:) ! shaded projected leaf area index + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: livecroot_mr(:) + real(r8), pointer :: leaf_curmr(:) + real(r8), pointer :: froot_curmr(:) + real(r8), pointer :: livestem_curmr(:) + real(r8), pointer :: livecroot_curmr(:) + real(r8), pointer :: leaf_xsmr(:) + real(r8), pointer :: froot_xsmr(:) + real(r8), pointer :: livestem_xsmr(:) + real(r8), pointer :: livecroot_xsmr(:) + ! column level + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + ! ecophysiological constants + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: froot_leaf(:) ! allocation parameter: new fine root C per new leaf C (gC/gC) + real(r8), pointer :: croot_stem(:) ! allocation parameter: new coarse root C per new stem C (gC/gC) + real(r8), pointer :: stem_leaf(:) ! allocation parameter: new stem c per new leaf C (gC/gC) + real(r8), pointer :: flivewd(:) ! allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) + real(r8), pointer :: frootcn(:) ! fine root C:N (gC/gN) + real(r8), pointer :: livewdcn(:) ! live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8), pointer :: deadwdcn(:) ! dead wood (xylem and heartwood) C:N (gC/gN) + real(r8), pointer :: fcur2(:) ! allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + integer, pointer :: plandunit(:) ! index into landunit level quantities + integer, pointer :: clandunit(:) ! index into landunit level quantities + integer , pointer :: itypelun(:) ! landunit type + logical , pointer :: croplive(:) ! flag, true if planted, not harvested + integer , pointer :: peaklai(:) ! 1: max allowed lai; 0: not at max + real(r8), pointer :: gddmaturity(:)! gdd needed to harvest + real(r8), pointer :: huileaf(:) ! heat unit index needed from planting to leaf emergence + real(r8), pointer :: huigrain(:) ! same to reach vegetative maturity + real(r8), pointer :: hui(:) ! =gdd since planting (gddplant) + real(r8), pointer :: leafout(:) ! =gdd from top soil layer temperature + real(r8), pointer :: aleafi(:) ! saved allocation coefficient from phase 2 + real(r8), pointer :: astemi(:) ! saved allocation coefficient from phase 2 + real(r8), pointer :: aleaf(:) ! leaf allocation coefficient + real(r8), pointer :: astem(:) ! stem allocation coefficient + real(r8), pointer :: graincn(:) ! grain C:N (gC/gN) +! +! local pointers to implicit in/out arrays +! + ! pft level + real(r8), pointer :: gpp(:) ! GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: availc(:) ! C flux available for allocation (gC/m2/s) + real(r8), pointer :: xsmrpool_recover(:) ! C flux assigned to recovery of negative cpool (gC/m2/s) + real(r8), pointer :: c_allometry(:) ! C allocation index (DIM) + real(r8), pointer :: n_allometry(:) ! N allocation index (DIM) + real(r8), pointer :: plant_ndemand(:) ! N flux required to support initial GPP (gN/m2/s) + real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of potential GPP + real(r8), pointer :: tempmax_retransn(:) ! temporary annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: annsum_potential_gpp(:) ! annual sum of potential GPP + real(r8), pointer :: avail_retransn(:) ! N flux available from retranslocation pool (gN/m2/s) + real(r8), pointer :: annmax_retransn(:) ! annual max of retranslocated N pool + real(r8), pointer :: plant_nalloc(:) ! total allocated N flux (gN/m2/s) + real(r8), pointer :: plant_calloc(:) ! total allocated C flux (gC/m2/s) + real(r8), pointer :: excess_cflux(:) ! C flux not allocated due to downregulation (gC/m2/s) + real(r8), pointer :: downreg(:) ! fractional reduction in GPP due to N limitation (DIM) + real(r8), pointer :: annsum_npp(:) ! annual sum of NPP, for wood allocation + real(r8), pointer :: cpool_to_xsmrpool(:) + real(r8), pointer :: psnsun_to_cpool(:) + real(r8), pointer :: psnshade_to_cpool(:) + + real(r8), pointer :: c13_psnsun_to_cpool(:) + real(r8), pointer :: c13_psnshade_to_cpool(:) + + real(r8), pointer :: cpool_to_leafc(:) + real(r8), pointer :: cpool_to_leafc_storage(:) + real(r8), pointer :: cpool_to_frootc(:) + real(r8), pointer :: cpool_to_frootc_storage(:) + real(r8), pointer :: cpool_to_livestemc(:) + real(r8), pointer :: cpool_to_livestemc_storage(:) + real(r8), pointer :: cpool_to_deadstemc(:) + real(r8), pointer :: cpool_to_deadstemc_storage(:) + real(r8), pointer :: cpool_to_livecrootc(:) + real(r8), pointer :: cpool_to_livecrootc_storage(:) + real(r8), pointer :: cpool_to_deadcrootc(:) + real(r8), pointer :: cpool_to_deadcrootc_storage(:) + real(r8), pointer :: cpool_to_gresp_storage(:) ! allocation to growth respiration storage (gC/m2/s) + real(r8), pointer :: retransn_to_npool(:) ! deployment of retranslocated N (gN/m2/s) + real(r8), pointer :: sminn_to_npool(:) ! deployment of soil mineral N uptake (gN/m2/s) + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C (gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage(:) ! allocation to grain C storage (gC/m2/s) + real(r8), pointer :: npool_to_grainn(:) ! allocation to grain N (gN/m2/s) + real(r8), pointer :: npool_to_grainn_storage(:) ! allocation to grain N storage (gN/m2/s) + real(r8), pointer :: npool_to_leafn(:) ! allocation to leaf N (gN/m2/s) + real(r8), pointer :: npool_to_leafn_storage(:) ! allocation to leaf N storage (gN/m2/s) + real(r8), pointer :: npool_to_frootn(:) ! allocation to fine root N (gN/m2/s) + real(r8), pointer :: npool_to_frootn_storage(:) ! allocation to fine root N storage (gN/m2/s) + real(r8), pointer :: npool_to_livestemn(:) + real(r8), pointer :: npool_to_livestemn_storage(:) + real(r8), pointer :: npool_to_deadstemn(:) + real(r8), pointer :: npool_to_deadstemn_storage(:) + real(r8), pointer :: npool_to_livecrootn(:) + real(r8), pointer :: npool_to_livecrootn_storage(:) + real(r8), pointer :: npool_to_deadcrootn(:) + real(r8), pointer :: npool_to_deadcrootn_storage(:) + ! column level + real(r8), pointer :: fpi(:) ! fraction of potential immobilization (no units) + real(r8), pointer :: fpg(:) ! fraction of potential gpp (no units) + real(r8), pointer :: potential_immob(:) + real(r8), pointer :: actual_immob(:) + real(r8), pointer :: sminn_to_plant(:) + real(r8), pointer :: sminn_to_denit_excess(:) + real(r8), pointer :: supplement_to_sminn(:) +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p,l,pi !indices + integer :: fp !lake filter pft index + integer :: fc !lake filter column index + integer :: nlimit !flag for N limitation + real(r8):: mr !maintenance respiration (gC/m2/s) + real(r8):: f1,f2,f3,f4,g1,g2 !allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw !C:N ratios for leaf, fine root, and wood + real(r8):: fcur !fraction of current psn displayed as growth + real(r8):: sum_ndemand !total column N demand (gN/m2/s) + real(r8):: gresp_storage !temporary variable for growth resp to storage + real(r8):: nlc !temporary variable for total new leaf carbon allocation + real(r8):: curmr, curmr_ratio !xsmrpool temporary variables + real(r8) f5 !grain allocation parameter + real(r8) cng !C:N ratio for grain (= cnlw for now; slevis) + real(r8) fleaf !fraction allocated to leaf + + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + ivt => pft%itype + pcolumn => pft%column + plandunit => pft%landunit + clandunit => col%landunit + pfti => col%pfti + itypelun => lun%itype + lgsf => pepv%lgsf + xsmrpool => pcs%xsmrpool + retransn => pns%retransn + psnsun => pcf%psnsun + psnsha => pcf%psnsha + + c13_psnsun => pc13f%psnsun + c13_psnsha => pc13f%psnsha + + laisun => pps%laisun + laisha => pps%laisha + leaf_mr => pcf%leaf_mr + froot_mr => pcf%froot_mr + livestem_mr => pcf%livestem_mr + livecroot_mr => pcf%livecroot_mr + leaf_curmr => pcf%leaf_curmr + froot_curmr => pcf%froot_curmr + livestem_curmr => pcf%livestem_curmr + livecroot_curmr => pcf%livecroot_curmr + leaf_xsmr => pcf%leaf_xsmr + froot_xsmr => pcf%froot_xsmr + livestem_xsmr => pcf%livestem_xsmr + livecroot_xsmr => pcf%livecroot_xsmr + sminn => cns%sminn + woody => pftcon%woody + froot_leaf => pftcon%froot_leaf + croot_stem => pftcon%croot_stem + stem_leaf => pftcon%stem_leaf + flivewd => pftcon%flivewd + leafcn => pftcon%leafcn + frootcn => pftcon%frootcn + livewdcn => pftcon%livewdcn + deadwdcn => pftcon%deadwdcn + fcur2 => pftcon%fcur + gddmaturity => pps%gddmaturity + huileaf => pps%huileaf + huigrain => pps%huigrain + hui => pps%gddplant + leafout => pps%gddtsoi + croplive => pps%croplive + peaklai => pps%peaklai + graincn => pftcon%graincn + ! Assign local pointers to derived type arrays (out) + gpp => pepv%gpp + availc => pepv%availc + xsmrpool_recover => pepv%xsmrpool_recover + c_allometry => pepv%c_allometry + n_allometry => pepv%n_allometry + plant_ndemand => pepv%plant_ndemand + tempsum_potential_gpp => pepv%tempsum_potential_gpp + tempmax_retransn => pepv%tempmax_retransn + annsum_potential_gpp => pepv%annsum_potential_gpp + avail_retransn => pepv%avail_retransn + annmax_retransn => pepv%annmax_retransn + plant_nalloc => pepv%plant_nalloc + plant_calloc => pepv%plant_calloc + excess_cflux => pepv%excess_cflux + downreg => pepv%downreg + annsum_npp => pepv%annsum_npp + cpool_to_xsmrpool => pcf%cpool_to_xsmrpool + psnsun_to_cpool => pcf%psnsun_to_cpool + psnshade_to_cpool => pcf%psnshade_to_cpool + + c13_psnsun_to_cpool => pc13f%psnsun_to_cpool + c13_psnshade_to_cpool => pc13f%psnshade_to_cpool + + cpool_to_leafc => pcf%cpool_to_leafc + cpool_to_leafc_storage => pcf%cpool_to_leafc_storage + cpool_to_frootc => pcf%cpool_to_frootc + cpool_to_frootc_storage => pcf%cpool_to_frootc_storage + cpool_to_livestemc => pcf%cpool_to_livestemc + cpool_to_livestemc_storage => pcf%cpool_to_livestemc_storage + cpool_to_deadstemc => pcf%cpool_to_deadstemc + cpool_to_deadstemc_storage => pcf%cpool_to_deadstemc_storage + cpool_to_livecrootc => pcf%cpool_to_livecrootc + cpool_to_livecrootc_storage => pcf%cpool_to_livecrootc_storage + cpool_to_deadcrootc => pcf%cpool_to_deadcrootc + cpool_to_deadcrootc_storage => pcf%cpool_to_deadcrootc_storage + cpool_to_gresp_storage => pcf%cpool_to_gresp_storage + cpool_to_grainc => pcf%cpool_to_grainc + cpool_to_grainc_storage => pcf%cpool_to_grainc_storage + npool_to_grainn => pnf%npool_to_grainn + npool_to_grainn_storage => pnf%npool_to_grainn_storage + retransn_to_npool => pnf%retransn_to_npool + sminn_to_npool => pnf%sminn_to_npool + npool_to_leafn => pnf%npool_to_leafn + npool_to_leafn_storage => pnf%npool_to_leafn_storage + npool_to_frootn => pnf%npool_to_frootn + npool_to_frootn_storage => pnf%npool_to_frootn_storage + npool_to_livestemn => pnf%npool_to_livestemn + npool_to_livestemn_storage => pnf%npool_to_livestemn_storage + npool_to_deadstemn => pnf%npool_to_deadstemn + npool_to_deadstemn_storage => pnf%npool_to_deadstemn_storage + npool_to_livecrootn => pnf%npool_to_livecrootn + npool_to_livecrootn_storage => pnf%npool_to_livecrootn_storage + npool_to_deadcrootn => pnf%npool_to_deadcrootn + npool_to_deadcrootn_storage => pnf%npool_to_deadcrootn_storage + fpi => cps%fpi + fpg => cps%fpg + potential_immob => cnf%potential_immob + actual_immob => cnf%actual_immob + sminn_to_plant => cnf%sminn_to_plant + sminn_to_denit_excess => cnf%sminn_to_denit_excess + supplement_to_sminn => cnf%supplement_to_sminn + aleafi => pps%aleafi + astemi => pps%astemi + aleaf => pps%aleaf + astem => pps%astem + + ! loop over pfts to assess the total plant N demand + do fp=1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + if (use_c13) then + c13_psnsun_to_cpool(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13_psnshade_to_cpool(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin)then + if (croplive(p)) mr = mr + livestem_mr(p) + end if + + ! carbon flux available for allocation + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + astem(p) = astem(p)+arepr(p) + arepr(p) = 0._r8 + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + if (annsum_potential_gpp(p) > 0.0_r8) then + avail_retransn(p) = (annmax_retransn(p)/2.0)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + + end do ! end pft loop + + ! now use the p2c routine to get the column-averaged plant_ndemand + call p2c(num_soilc,filter_soilc,plant_ndemand,col_plant_ndemand) + + ! column loop to resolve plant/heterotroph competition for mineral N + do fc=1,num_soilc + c = filter_soilc(fc) + l = clandunit(c) + + sum_ndemand = col_plant_ndemand(c) + potential_immob(c) + + if (sum_ndemand*dt < sminn(c)) then + ! N availability is not limiting immobilization of plant + ! uptake, and both can proceed at their potential rates + + nlimit = 0 + fpi(c) = 1.0_r8 + actual_immob(c) = potential_immob(c) + sminn_to_plant(c) = col_plant_ndemand(c) + + ! under conditions of excess N, some proportion is assumed to + ! be lost to denitrification, in addition to the constant + ! proportion lost in the decomposition pathways + + sminn_to_denit_excess(c) = bdnr*((sminn(c)/dt) - sum_ndemand) + else if ( ((.not. Carbon_only) .and. (.not. crop_supln)) .or. & + (crop_supln .and. ( (itypelun(l) /= istcrop) .or. & + ((itypelun(l) == istcrop) .and. (ivt(pfti(c)) < npcropmin) )) ) )then + + ! N availability can not satisfy the sum of immobilization and + ! plant growth demands, so these two demands compete for available + ! soil mineral N resource. + + nlimit = 1 + if (sum_ndemand > 0.0_r8) then + actual_immob(c) = (sminn(c)/dt)*(potential_immob(c) / sum_ndemand) + else + actual_immob(c) = 0.0_r8 + end if + + if (potential_immob(c) > 0.0_r8) then + fpi(c) = actual_immob(c) / potential_immob(c) + else + fpi(c) = 0.0_r8 + end if + + sminn_to_plant(c) = (sminn(c)/dt) - actual_immob(c) + else if ( Carbon_only .or. & + (crop_supln .and. (itypelun(l) == istcrop) .and. & + (ivt(pfti(c)) >= npcropmin)) )then + ! this code block controls the addition of N to sminn pool + ! to eliminate any N limitation, when Carbon_Only is set. This lets the + ! model behave essentially as a carbon-only model, but with the + ! benefit of keeping track of the N additions needed to + ! eliminate N limitations, so there is still a diagnostic quantity + ! that describes the degree of N limitation at steady-state. + + nlimit = 1 + fpi(c) = 1.0_r8 + actual_immob(c) = potential_immob(c) + sminn_to_plant(c) = col_plant_ndemand(c) + supplement_to_sminn(c) = sum_ndemand - (sminn(c)/dt) + else + call endrun( 'This else should NOT be able to happen' ) + end if + + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + + if (col_plant_ndemand(c) > 0.0_r8) then + fpg(c) = sminn_to_plant(c) / col_plant_ndemand(c) + else + fpg(c) = 1.0_r8 + end if + + end do ! end of column loop + + ! start new pft loop to distribute the available N between the + ! competing pfts on the basis of relative demand, and allocate C and N to + ! new growth and storage + + do fp=1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at + ! ndays_active = days/year. This prevents the continued storage of C and N. + ! turning off this correction (PET, 12/11/03), instead using bgtr in + ! phenology algorithm. + !fcur = fcur + (1._r8 - fcur)*lgsf(p) + + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + + ! calculate the associated carbon allocation, and the excess + ! carbon flux that must be accounted for through downregulation + + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + excess_cflux(p) = availc(p) - plant_calloc(p) + + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + psnsun_to_cpool(p) = psnsun_to_cpool(p)*(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + if (use_c13) then + c13_psnsun_to_cpool(p) = c13_psnsun_to_cpool(p)*(1._r8 - downreg(p)) + c13_psnshade_to_cpool(p) = c13_psnshade_to_cpool(p)*(1._r8 - downreg(p)) + endif + end if + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + end do ! end pft loop + +end subroutine CNAllocation + +end module CNAllocationMod diff --git a/components/clm/src_clm40/biogeochem/CNAnnualUpdateMod.F90 b/components/clm/src_clm40/biogeochem/CNAnnualUpdateMod.F90 new file mode 100644 index 0000000000..101d171fb5 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNAnnualUpdateMod.F90 @@ -0,0 +1,195 @@ +module CNAnnualUpdateMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNAnnualUpdateMod +! +! !DESCRIPTION: +! Module for updating annual summation variables +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CNAnnualUpdate +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNAnnualUpdate +! +! !INTERFACE: +subroutine CNAnnualUpdate(lbc, ubc, lbp, ubp, num_soilc, filter_soilc, & + num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update annual summation variables +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size, get_days_per_year + use clm_varcon , only: secspday + use pft2colMod , only: p2c + use clm_varctl , only: use_cn, use_cndv, use_crop +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(ubp-lbp+1) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 10/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: pcolumn(:) ! index into column level + ! quantities +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: annsum_counter(:) ! seconds since last annual accumulator turnover + real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of potential GPP + real(r8), pointer :: annsum_potential_gpp(:) ! annual sum of potential GPP + real(r8), pointer :: tempmax_retransn(:) ! temporary annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: annmax_retransn(:) ! annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: tempavg_t2m(:) ! temporary average 2m air temperature (K) + real(r8), pointer :: annavg_t2m(:) ! annual average 2m air temperature (K) + real(r8), pointer :: tempsum_npp(:) ! temporary sum NPP (gC/m2/yr) + real(r8), pointer :: annsum_npp(:) ! annual sum NPP (gC/m2/yr) + real(r8), pointer :: cannsum_npp(:) ! column annual sum NPP (gC/m2/yr) + real(r8), pointer :: cannavg_t2m(:) !annual average of 2m air temperature, averaged from pft-level (K) + real(r8), pointer :: tempsum_litfall(:) ! temporary sum litfall (gC/m2/yr) + real(r8), pointer :: annsum_litfall(:) ! annual sum litfall (gC/m2/yr) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays + annsum_counter => cps%annsum_counter + tempsum_potential_gpp => pepv%tempsum_potential_gpp + annsum_potential_gpp => pepv%annsum_potential_gpp + tempmax_retransn => pepv%tempmax_retransn + annmax_retransn => pepv%annmax_retransn + tempavg_t2m => pepv%tempavg_t2m + annavg_t2m => pepv%annavg_t2m + tempsum_npp => pepv%tempsum_npp + annsum_npp => pepv%annsum_npp + cannsum_npp => cps%cannsum_npp + cannavg_t2m => cps%cannavg_t2m + tempsum_litfall => pepv%tempsum_litfall + annsum_litfall => pepv%annsum_litfall + pcolumn => pft%column + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + annsum_counter(c) = annsum_counter(c) + dt + end do + + ! In the future -- ONLY use the top if-block and remove the second - which is the same + ! except the ordering of the if/do blocks + + if (use_cndv .or. use_crop) then + if (annsum_counter(filter_soilc(1)) >= get_days_per_year() * secspday) then ! new (slevis) + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! update annual plant ndemand accumulator + annsum_potential_gpp(p) = tempsum_potential_gpp(p) + tempsum_potential_gpp(p) = 0._r8 + + ! update annual total N retranslocation accumulator + annmax_retransn(p) = tempmax_retransn(p) + tempmax_retransn(p) = 0._r8 + + ! update annual average 2m air temperature accumulator + annavg_t2m(p) = tempavg_t2m(p) + tempavg_t2m(p) = 0._r8 + + ! update annual NPP accumulator, convert to annual total + annsum_npp(p) = tempsum_npp(p) * dt + tempsum_npp(p) = 0._r8 + + if (use_cndv) then + ! update annual litfall accumulator, convert to annual total + annsum_litfall(p) = tempsum_litfall(p) * dt + tempsum_litfall(p) = 0._r8 + end if + end do + ! use p2c routine to get selected column-average pft-level fluxes and states + call p2c(num_soilc, filter_soilc, annsum_npp, cannsum_npp) + call p2c(num_soilc, filter_soilc, annavg_t2m, cannavg_t2m) + end if + else + do fp = 1,num_soilp + p = filter_soilp(fp) + ! In the future -- REMOVE this code and use the equivalent code above always + c = pcolumn(p) ! old (slevis) + if (annsum_counter(c) >= get_days_per_year() * secspday) then ! old (slevis) + ! update annual plant ndemand accumulator + annsum_potential_gpp(p) = tempsum_potential_gpp(p) + tempsum_potential_gpp(p) = 0._r8 + + ! update annual total N retranslocation accumulator + annmax_retransn(p) = tempmax_retransn(p) + tempmax_retransn(p) = 0._r8 + + ! update annual average 2m air temperature accumulator + annavg_t2m(p) = tempavg_t2m(p) + tempavg_t2m(p) = 0._r8 + + ! update annual NPP accumulator, convert to annual total + annsum_npp(p) = tempsum_npp(p) * dt + tempsum_npp(p) = 0._r8 + + if (use_cndv) then + ! update annual litfall accumulator, convert to annual total + annsum_litfall(p) = tempsum_litfall(p) * dt + tempsum_litfall(p) = 0._r8 + end if + end if ! old (slevis) + end do + ! use p2c routine to get selected column-average pft-level fluxes and states + call p2c(num_soilc, filter_soilc, annsum_npp, cannsum_npp) + call p2c(num_soilc, filter_soilc, annavg_t2m, cannavg_t2m) + end if + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + if (annsum_counter(c) >= get_days_per_year() * secspday) annsum_counter(c) = 0._r8 + end do + +end subroutine CNAnnualUpdate +!----------------------------------------------------------------------- + +end module CNAnnualUpdateMod diff --git a/components/clm/src_clm40/biogeochem/CNBalanceCheckMod.F90 b/components/clm/src_clm40/biogeochem/CNBalanceCheckMod.F90 new file mode 100644 index 0000000000..09c66dd156 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNBalanceCheckMod.F90 @@ -0,0 +1,396 @@ +module CNBalanceCheckMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNBalanceCheckMod +! +! !DESCRIPTION: +! Module for carbon mass balance checking. +! +! !USES: + use abortutils , only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: iulog + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: BeginCBalance + public :: BeginNBalance + public :: CBalanceCheck + public :: NBalanceCheck +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BeginCBalance +! +! !INTERFACE: +subroutine BeginCBalance(lbc, ubc, num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, calculate the beginning carbon balance for mass +! conservation checks. +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 2/4/05: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool +! +! local pointers to implicit out arrays + real(r8), pointer :: col_begcb(:) ! carbon mass, beginning of time step (gC/m**2) +! +! !OTHER LOCAL VARIABLES: + integer :: c ! indices + integer :: fc ! lake filter indices +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + col_begcb => ccbal%begcb + totcolc => ccs%totcolc + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate beginning column-level carbon balance, + ! for mass conservation check + + col_begcb(c) = totcolc(c) + + end do ! end of columns loop + + +end subroutine BeginCBalance +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BeginNBalance +! +! !INTERFACE: +subroutine BeginNBalance(lbc, ubc, num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, calculate the beginning nitrogen balance for mass +! conservation checks. +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 2/4/05: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: totcoln(:) ! (gN/m2) total column nitrogen, incl veg +! +! local pointers to implicit out arrays + real(r8), pointer :: col_begnb(:) ! nitrogen mass, beginning of time step (gN/m**2) +! +! !OTHER LOCAL VARIABLES: + integer :: c ! indices + integer :: fc ! lake filter indices +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + col_begnb => cnbal%begnb + totcoln => cns%totcoln + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate beginning column-level nitrogen balance, + ! for mass conservation check + + col_begnb(c) = totcoln(c) + + end do ! end of columns loop + +end subroutine BeginNBalance +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CBalanceCheck +! +! !INTERFACE: +subroutine CBalanceCheck(lbc, ubc, num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, perform carbon mass conservation check for column and pft +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 12/9/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arrays + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: gpp(:) ! (gC/m2/s) gross primary production + real(r8), pointer :: er(:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss + real(r8), pointer :: col_hrv_xsmrpool_to_atm(:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: dwt_closs(:) ! (gC/m2/s) total carbon loss from product pools and conversion + real(r8), pointer :: product_closs(:) ! (gC/m2/s) total wood product carbon loss +! +! local pointers to implicit out arrays + real(r8), pointer :: col_cinputs(:) ! (gC/m2/s) total column-level carbon inputs (for balance check) + real(r8), pointer :: col_coutputs(:) ! (gC/m2/s) total column-level carbon outputs (for balance check) + real(r8), pointer :: col_begcb(:) ! carbon mass, beginning of time step (gC/m**2) + real(r8), pointer :: col_endcb(:) ! carbon mass, end of time step (gC/m**2) + real(r8), pointer :: col_errcb(:) ! carbon balance error for the timestep (gC/m**2) +! +! !OTHER LOCAL VARIABLES: + integer :: c,err_index ! indices + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8):: dt ! radiation time step (seconds) +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers to column-level arrays + totcolc => ccs%totcolc + gpp => pcf_a%gpp + er => ccf%er + col_fire_closs => ccf%col_fire_closs + col_hrv_xsmrpool_to_atm => pcf_a%hrv_xsmrpool_to_atm + dwt_closs => ccf%dwt_closs + product_closs => ccf%product_closs + + col_cinputs => ccf%col_cinputs + col_coutputs => ccf%col_coutputs + col_begcb => ccbal%begcb + col_endcb => ccbal%endcb + col_errcb => ccbal%errcb + + ! set time steps + dt = real( get_step_size(), r8 ) + + err_found = .false. + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate the total column-level carbon storage, for mass conservation check + + col_endcb(c) = totcolc(c) + + ! calculate total column-level inputs + + col_cinputs(c) = gpp(c) + + ! calculate total column-level outputs + ! er = ar + hr, col_fire_closs includes pft-level fire losses + + col_coutputs(c) = er(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + col_hrv_xsmrpool_to_atm(c) + + ! calculate the total column-level carbon balance error for this time step + + col_errcb(c) = (col_cinputs(c) - col_coutputs(c))*dt - & + (col_endcb(c) - col_begcb(c)) + + ! check for significant errors + if (abs(col_errcb(c)) > 1e-8_r8) then + err_found = .true. + err_index = c + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column cbalance error = ', col_errcb(c), c + write(iulog,*)'begcb = ',col_begcb(c) + write(iulog,*)'endcb = ',col_endcb(c) + write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) + write(iulog,*)'input mass = ',col_cinputs(c)*dt + write(iulog,*)'output mass = ',col_coutputs(c)*dt + write(iulog,*)'net flux = ',(col_cinputs(c)-col_coutputs(c))*dt + write(iulog,*)'nee = ',ccf%nee(c) * dt + write(iulog,*)'gpp = ',gpp(c) * dt + write(iulog,*)'er = ',er(c) * dt + write(iulog,*)'col_fire_closs = ',col_fire_closs(c) * dt + write(iulog,*)'col_hrv_xsmrpool_to_atm = ',col_hrv_xsmrpool_to_atm(c) * dt + write(iulog,*)'dwt_closs = ',dwt_closs(c) * dt + write(iulog,*)'product_closs = ',product_closs(c) * dt + call endrun + end if + + +end subroutine CBalanceCheck +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NBalanceCheck +! +! !INTERFACE: +subroutine NBalanceCheck(lbc, ubc, num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, perform nitrogen mass conservation check +! for column and pft +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 12/9/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arrays + real(r8), pointer :: totcoln(:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: ndep_to_sminn(:) ! atmospheric N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: nfix_to_sminn(:) ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + real(r8), pointer :: supplement_to_sminn(:) ! supplemental N supply (gN/m2/s) + real(r8), pointer :: denit(:) ! total rate of denitrification (gN/m2/s) + real(r8), pointer :: sminn_leached(:) ! soil mineral N pool loss to leaching (gN/m2/s) + real(r8), pointer :: col_fire_nloss(:) ! total column-level fire N loss (gN/m2/s) + real(r8), pointer :: dwt_nloss(:) ! (gN/m2/s) total nitrogen loss from product pools and conversion + real(r8), pointer :: product_nloss(:) ! (gN/m2/s) total wood product nitrogen loss +! +! local pointers to implicit in/out arrays +! +! local pointers to implicit out arrays + real(r8), pointer :: col_ninputs(:) ! column-level N inputs (gN/m2/s) + real(r8), pointer :: col_noutputs(:) ! column-level N outputs (gN/m2/s) + real(r8), pointer :: col_begnb(:) ! nitrogen mass, beginning of time step (gN/m**2) + real(r8), pointer :: col_endnb(:) ! nitrogen mass, end of time step (gN/m**2) + real(r8), pointer :: col_errnb(:) ! nitrogen balance error for the timestep (gN/m**2) +! +! !OTHER LOCAL VARIABLES: + integer :: c,err_index ! indices + integer :: fc ! lake filter indices + logical :: err_found ! error flag + real(r8):: dt ! radiation time step (seconds) +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to column-level arrays + + totcoln => cns%totcoln + ndep_to_sminn => cnf%ndep_to_sminn + nfix_to_sminn => cnf%nfix_to_sminn + supplement_to_sminn => cnf%supplement_to_sminn + denit => cnf%denit + sminn_leached => cnf%sminn_leached + col_fire_nloss => cnf%col_fire_nloss + dwt_nloss => cnf%dwt_nloss + product_nloss => cnf%product_nloss + + col_ninputs => cnf%col_ninputs + col_noutputs => cnf%col_noutputs + col_begnb => cnbal%begnb + col_endnb => cnbal%endnb + col_errnb => cnbal%errnb + + ! set time steps + dt = real( get_step_size(), r8 ) + + err_found = .false. + ! column loop + do fc = 1,num_soilc + c=filter_soilc(fc) + + ! calculate the total column-level nitrogen storage, for mass conservation check + + col_endnb(c) = totcoln(c) + + ! calculate total column-level inputs + + col_ninputs(c) = ndep_to_sminn(c) + nfix_to_sminn(c) + supplement_to_sminn(c) + + ! calculate total column-level outputs + + col_noutputs(c) = denit(c) + sminn_leached(c) + col_fire_nloss(c) + dwt_nloss(c) + product_nloss(c) + + ! calculate the total column-level nitrogen balance error for this time step + + col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - & + (col_endnb(c) - col_begnb(c)) + + if (abs(col_errnb(c)) > 1e-8_r8) then + err_found = .true. + err_index = c + end if + + end do ! end of columns loop + + if (err_found) then + c = err_index + write(iulog,*)'column nbalance error = ', col_errnb(c), c + write(iulog,*)'begnb = ',col_begnb(c) + write(iulog,*)'endnb = ',col_endnb(c) + write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c) + write(iulog,*)'input mass = ',col_ninputs(c)*dt + write(iulog,*)'output mass = ',col_noutputs(c)*dt + write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt + call endrun + end if + +end subroutine NBalanceCheck +!----------------------------------------------------------------------- + +end module CNBalanceCheckMod diff --git a/components/clm/src_clm40/biogeochem/CNC13FluxMod.F90 b/components/clm/src_clm40/biogeochem/CNC13FluxMod.F90 new file mode 100644 index 0000000000..be20383408 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNC13FluxMod.F90 @@ -0,0 +1,1448 @@ +module CNC13FluxMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: C13FluxMod +! +! !DESCRIPTION: +! Module for 13-carbon flux variable update, non-mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public:: C13Flux1 + public:: C13Flux2 + public:: C13Flux2h + public:: C13Flux3 + private:: CNC13LitterToColumn + private:: CNC13GapPftToColumn + private:: CNC13HarvestPftToColumn + private:: C13FluxCalc +! +! !REVISION HISTORY: +! 4/21/2005: Created by Peter Thornton and Neil Suits +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13Flux1 +! +! !INTERFACE: +subroutine C13Flux1(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, set the 13-carbon flux +! variables (except for gap-phase mortality and fire fluxes) +! +! !USES: + use clmtype + use clm_varctl, only : use_c13 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! +! !LOCAL VARIABLES: +! !OTHER LOCAL VARIABLES: + type(pft_type), pointer :: p + type(column_type), pointer :: c + integer :: fp,pi +! +!EOP +!----------------------------------------------------------------------- + + if (.not. use_c13) then + RETURN + end if + + ! set local pointers + p => pft + c => col + + ! pft-level non-mortality fluxes + + call C13FluxCalc(pc13f%leafc_xfer_to_leafc, pcf%leafc_xfer_to_leafc, & + pc13s%leafc_xfer, pcs%leafc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%frootc_xfer_to_frootc, pcf%frootc_xfer_to_frootc, & + pc13s%frootc_xfer, pcs%frootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livestemc_xfer_to_livestemc, pcf%livestemc_xfer_to_livestemc, & + pc13s%livestemc_xfer, pcs%livestemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%deadstemc_xfer_to_deadstemc, pcf%deadstemc_xfer_to_deadstemc, & + pc13s%deadstemc_xfer, pcs%deadstemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livecrootc_xfer_to_livecrootc, pcf%livecrootc_xfer_to_livecrootc, & + pc13s%livecrootc_xfer, pcs%livecrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%deadcrootc_xfer_to_deadcrootc, pcf%deadcrootc_xfer_to_deadcrootc, & + pc13s%deadcrootc_xfer, pcs%deadcrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%leafc_to_litter, pcf%leafc_to_litter, & + pc13s%leafc, pcs%leafc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%frootc_to_litter, pcf%frootc_to_litter, & + pc13s%frootc, pcs%frootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livestemc_to_deadstemc, pcf%livestemc_to_deadstemc, & + pc13s%livestemc, pcs%livestemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livecrootc_to_deadcrootc, pcf%livecrootc_to_deadcrootc, & + pc13s%livecrootc, pcs%livecrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%leaf_curmr, pcf%leaf_curmr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%froot_curmr, pcf%froot_curmr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livestem_curmr, pcf%livestem_curmr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livecroot_curmr, pcf%livecroot_curmr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%leaf_xsmr, pcf%leaf_xsmr, & + pc13s%totvegc, pcs%totvegc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%froot_xsmr, pcf%froot_xsmr, & + pc13s%totvegc, pcs%totvegc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livestem_xsmr, pcf%livestem_xsmr, & + pc13s%totvegc, pcs%totvegc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livecroot_xsmr, pcf%livecroot_xsmr, & + pc13s%totvegc, pcs%totvegc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_xsmrpool, pcf%cpool_to_xsmrpool, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_leafc, pcf%cpool_to_leafc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_leafc_storage, pcf%cpool_to_leafc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_frootc, pcf%cpool_to_frootc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_frootc_storage, pcf%cpool_to_frootc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_livestemc, pcf%cpool_to_livestemc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_livestemc_storage, pcf%cpool_to_livestemc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_deadstemc, pcf%cpool_to_deadstemc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_deadstemc_storage, pcf%cpool_to_deadstemc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_livecrootc, pcf%cpool_to_livecrootc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_livecrootc_storage, pcf%cpool_to_livecrootc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_deadcrootc, pcf%cpool_to_deadcrootc, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_deadcrootc_storage, pcf%cpool_to_deadcrootc_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_leaf_gr, pcf%cpool_leaf_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_froot_gr, pcf%cpool_froot_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_livestem_gr, pcf%cpool_livestem_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_deadstem_gr, pcf%cpool_deadstem_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_livecroot_gr, pcf%cpool_livecroot_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_deadcroot_gr, pcf%cpool_deadcroot_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_leaf_storage_gr, pcf%cpool_leaf_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_froot_storage_gr, pcf%cpool_froot_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_livestem_storage_gr, pcf%cpool_livestem_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_deadstem_storage_gr, pcf%cpool_deadstem_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_livecroot_storage_gr, pcf%cpool_livecroot_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_deadcroot_storage_gr, pcf%cpool_deadcroot_storage_gr, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%cpool_to_gresp_storage, pcf%cpool_to_gresp_storage, & + pc13s%cpool, pcs%cpool, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_leaf_gr, pcf%transfer_leaf_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_froot_gr, pcf%transfer_froot_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_livestem_gr, pcf%transfer_livestem_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_deadstem_gr, pcf%transfer_deadstem_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_livecroot_gr, pcf%transfer_livecroot_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%transfer_deadcroot_gr, pcf%transfer_deadcroot_gr, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%leafc_storage_to_xfer, pcf%leafc_storage_to_xfer, & + pc13s%leafc_storage, pcs%leafc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%frootc_storage_to_xfer, pcf%frootc_storage_to_xfer, & + pc13s%frootc_storage, pcs%frootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livestemc_storage_to_xfer, pcf%livestemc_storage_to_xfer, & + pc13s%livestemc_storage, pcs%livestemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%deadstemc_storage_to_xfer, pcf%deadstemc_storage_to_xfer, & + pc13s%deadstemc_storage, pcs%deadstemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%livecrootc_storage_to_xfer, pcf%livecrootc_storage_to_xfer, & + pc13s%livecrootc_storage, pcs%livecrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%deadcrootc_storage_to_xfer, pcf%deadcrootc_storage_to_xfer, & + pc13s%deadcrootc_storage, pcs%deadcrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%gresp_storage_to_xfer, pcf%gresp_storage_to_xfer, & + pc13s%gresp_storage, pcs%gresp_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + ! call routine to shift pft-level litterfall fluxes to column, for isotopes + ! the non-isotope version of this routine is called in CNPhenologyMod.F90 + ! For later clean-up, it would be possible to generalize this function to operate on a single + ! pft-to-column flux. + + call CNC13LitterToColumn(num_soilc, filter_soilc) + + ! column-level non-mortality fluxes + + call C13FluxCalc(cc13f%cwdc_to_litr2c, ccf%cwdc_to_litr2c, & + cc13s%cwdc, ccs%cwdc, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%cwdc_to_litr3c, ccf%cwdc_to_litr3c, & + cc13s%cwdc, ccs%cwdc, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr1_hr, ccf%litr1_hr, & + cc13s%litr1c, ccs%litr1c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr1c_to_soil1c, ccf%litr1c_to_soil1c, & + cc13s%litr1c, ccs%litr1c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr2_hr, ccf%litr2_hr, & + cc13s%litr2c, ccs%litr2c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr2c_to_soil2c, ccf%litr2c_to_soil2c, & + cc13s%litr2c, ccs%litr2c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr3_hr, ccf%litr3_hr, & + cc13s%litr3c, ccs%litr3c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%litr3c_to_soil3c, ccf%litr3c_to_soil3c, & + cc13s%litr3c, ccs%litr3c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil1_hr, ccf%soil1_hr, & + cc13s%soil1c, ccs%soil1c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil1c_to_soil2c, ccf%soil1c_to_soil2c, & + cc13s%soil1c, ccs%soil1c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil2_hr, ccf%soil2_hr, & + cc13s%soil2c, ccs%soil2c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil2c_to_soil3c, ccf%soil2c_to_soil3c, & + cc13s%soil2c, ccs%soil2c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil3_hr, ccf%soil3_hr, & + cc13s%soil3c, ccs%soil3c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil3c_to_soil4c, ccf%soil3c_to_soil4c, & + cc13s%soil3c, ccs%soil3c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%soil4_hr, ccf%soil4_hr, & + cc13s%soil4c, ccs%soil4c, & + num_soilc, filter_soilc, 1._r8, 0) + + +! call C13FluxCalc(pc13f%fx, pcf%fx, & +! pc13s%sx, pcs%sx, & +! num_soilp, filter_soilp, 1._r8, 0) + +end subroutine C13Flux1 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13Flux2 +! +! !INTERFACE: +subroutine C13Flux2(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, set the 13-carbon fluxes for gap mortality +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! +! !LOCAL VARIABLES: +! !OTHER LOCAL VARIABLES: + type(pft_type), pointer :: p + type(column_type), pointer :: c + integer :: fp,pi +! +!EOP +!----------------------------------------------------------------------- + ! set local pointers + p => pft + c => col + + ! pft-level gap mortality fluxes + + call C13FluxCalc(pc13f%m_leafc_to_litter, pcf%m_leafc_to_litter, & + pc13s%leafc, pcs%leafc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_leafc_storage_to_litter, pcf%m_leafc_storage_to_litter, & + pc13s%leafc_storage, pcs%leafc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_leafc_xfer_to_litter, pcf%m_leafc_xfer_to_litter, & + pc13s%leafc_xfer, pcs%leafc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_to_litter, pcf%m_frootc_to_litter, & + pc13s%frootc, pcs%frootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_storage_to_litter, pcf%m_frootc_storage_to_litter, & + pc13s%frootc_storage, pcs%frootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_xfer_to_litter, pcf%m_frootc_xfer_to_litter, & + pc13s%frootc_xfer, pcs%frootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_to_litter, pcf%m_livestemc_to_litter, & + pc13s%livestemc, pcs%livestemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_storage_to_litter, pcf%m_livestemc_storage_to_litter, & + pc13s%livestemc_storage, pcs%livestemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_xfer_to_litter, pcf%m_livestemc_xfer_to_litter, & + pc13s%livestemc_xfer, pcs%livestemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_to_litter, pcf%m_deadstemc_to_litter, & + pc13s%deadstemc, pcs%deadstemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_storage_to_litter, pcf%m_deadstemc_storage_to_litter, & + pc13s%deadstemc_storage, pcs%deadstemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_xfer_to_litter, pcf%m_deadstemc_xfer_to_litter, & + pc13s%deadstemc_xfer, pcs%deadstemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_to_litter, pcf%m_livecrootc_to_litter, & + pc13s%livecrootc, pcs%livecrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_storage_to_litter, pcf%m_livecrootc_storage_to_litter, & + pc13s%livecrootc_storage, pcs%livecrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_xfer_to_litter, pcf%m_livecrootc_xfer_to_litter, & + pc13s%livecrootc_xfer, pcs%livecrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_to_litter, pcf%m_deadcrootc_to_litter, & + pc13s%deadcrootc, pcs%deadcrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_storage_to_litter, pcf%m_deadcrootc_storage_to_litter, & + pc13s%deadcrootc_storage, pcs%deadcrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_xfer_to_litter, pcf%m_deadcrootc_xfer_to_litter, & + pc13s%deadcrootc_xfer, pcs%deadcrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_gresp_storage_to_litter, pcf%m_gresp_storage_to_litter, & + pc13s%gresp_storage, pcs%gresp_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_gresp_xfer_to_litter, pcf%m_gresp_xfer_to_litter, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + ! call routine to shift pft-level gap mortality fluxes to column, for isotopes + ! the non-isotope version of this routine is in CNGapMortalityMod.F90. + + call CNC13GapPftToColumn(num_soilc, filter_soilc) + +end subroutine C13Flux2 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13Flux2h +! +! !INTERFACE: +subroutine C13Flux2h(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! set the 13-carbon fluxes for harvest mortality +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! +! !LOCAL VARIABLES: +! !OTHER LOCAL VARIABLES: + type(pft_type), pointer :: p + type(column_type), pointer :: c + integer :: fp,pi +! +!EOP +!----------------------------------------------------------------------- + ! set local pointers + p => pft + c => col + + ! pft-level gap mortality fluxes + + call C13FluxCalc(pc13f%hrv_leafc_to_litter, pcf%hrv_leafc_to_litter, & + pc13s%leafc, pcs%leafc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_leafc_storage_to_litter, pcf%hrv_leafc_storage_to_litter, & + pc13s%leafc_storage, pcs%leafc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_leafc_xfer_to_litter, pcf%hrv_leafc_xfer_to_litter, & + pc13s%leafc_xfer, pcs%leafc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_frootc_to_litter, pcf%hrv_frootc_to_litter, & + pc13s%frootc, pcs%frootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_frootc_storage_to_litter, pcf%hrv_frootc_storage_to_litter, & + pc13s%frootc_storage, pcs%frootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_frootc_xfer_to_litter, pcf%hrv_frootc_xfer_to_litter, & + pc13s%frootc_xfer, pcs%frootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livestemc_to_litter, pcf%hrv_livestemc_to_litter, & + pc13s%livestemc, pcs%livestemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livestemc_storage_to_litter, pcf%hrv_livestemc_storage_to_litter, & + pc13s%livestemc_storage, pcs%livestemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livestemc_xfer_to_litter, pcf%hrv_livestemc_xfer_to_litter, & + pc13s%livestemc_xfer, pcs%livestemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadstemc_to_prod10c, pcf%hrv_deadstemc_to_prod10c, & + pc13s%deadstemc, pcs%deadstemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadstemc_to_prod100c, pcf%hrv_deadstemc_to_prod100c, & + pc13s%deadstemc, pcs%deadstemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadstemc_storage_to_litter, pcf%hrv_deadstemc_storage_to_litter, & + pc13s%deadstemc_storage, pcs%deadstemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadstemc_xfer_to_litter, pcf%hrv_deadstemc_xfer_to_litter, & + pc13s%deadstemc_xfer, pcs%deadstemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livecrootc_to_litter, pcf%hrv_livecrootc_to_litter, & + pc13s%livecrootc, pcs%livecrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livecrootc_storage_to_litter, pcf%hrv_livecrootc_storage_to_litter, & + pc13s%livecrootc_storage, pcs%livecrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_livecrootc_xfer_to_litter, pcf%hrv_livecrootc_xfer_to_litter, & + pc13s%livecrootc_xfer, pcs%livecrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadcrootc_to_litter, pcf%hrv_deadcrootc_to_litter, & + pc13s%deadcrootc, pcs%deadcrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadcrootc_storage_to_litter, pcf%hrv_deadcrootc_storage_to_litter, & + pc13s%deadcrootc_storage, pcs%deadcrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_deadcrootc_xfer_to_litter, pcf%hrv_deadcrootc_xfer_to_litter, & + pc13s%deadcrootc_xfer, pcs%deadcrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_gresp_storage_to_litter, pcf%hrv_gresp_storage_to_litter, & + pc13s%gresp_storage, pcs%gresp_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_gresp_xfer_to_litter, pcf%hrv_gresp_xfer_to_litter, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%hrv_xsmrpool_to_atm, pcf%hrv_xsmrpool_to_atm, & + pc13s%totvegc, pcs%totvegc, & + num_soilp, filter_soilp, 1._r8, 0) + + ! call routine to shift pft-level gap mortality fluxes to column, for isotopes + ! the non-isotope version of this routine is in CNGapMortalityMod.F90. + + call CNC13HarvestPftToColumn(num_soilc, filter_soilc) + +end subroutine C13Flux2h +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13Flux3 +! +! !INTERFACE: +subroutine C13Flux3(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, set the 13-carbon fluxes for fire mortality +! +! !USES: + use clmtype + use pft2colMod, only: p2c +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! +! !LOCAL VARIABLES: +! !OTHER LOCAL VARIABLES: + type(pft_type), pointer :: p + type(column_type), pointer :: c + integer :: fp,pi + real(r8), pointer :: ptrp(:) ! pointer to input pft array + real(r8), pointer :: ptrc(:) ! pointer to output column array +! +!EOP +!----------------------------------------------------------------------- + ! set local pointers + p => pft + c => col + + ! pft-level fire mortality fluxes + + call C13FluxCalc(pc13f%m_leafc_to_fire, pcf%m_leafc_to_fire, & + pc13s%leafc, pcs%leafc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_leafc_storage_to_fire, pcf%m_leafc_storage_to_fire, & + pc13s%leafc_storage, pcs%leafc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_leafc_xfer_to_fire, pcf%m_leafc_xfer_to_fire, & + pc13s%leafc_xfer, pcs%leafc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_to_fire, pcf%m_frootc_to_fire, & + pc13s%frootc, pcs%frootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_storage_to_fire, pcf%m_frootc_storage_to_fire, & + pc13s%frootc_storage, pcs%frootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_frootc_xfer_to_fire, pcf%m_frootc_xfer_to_fire, & + pc13s%frootc_xfer, pcs%frootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_to_fire, pcf%m_livestemc_to_fire, & + pc13s%livestemc, pcs%livestemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_storage_to_fire, pcf%m_livestemc_storage_to_fire, & + pc13s%livestemc_storage, pcs%livestemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livestemc_xfer_to_fire, pcf%m_livestemc_xfer_to_fire, & + pc13s%livestemc_xfer, pcs%livestemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_to_fire, pcf%m_deadstemc_to_fire, & + pc13s%deadstemc, pcs%deadstemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_to_litter_fire, pcf%m_deadstemc_to_litter_fire, & + pc13s%deadstemc, pcs%deadstemc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_storage_to_fire, pcf%m_deadstemc_storage_to_fire, & + pc13s%deadstemc_storage, pcs%deadstemc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadstemc_xfer_to_fire, pcf%m_deadstemc_xfer_to_fire, & + pc13s%deadstemc_xfer, pcs%deadstemc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_to_fire, pcf%m_livecrootc_to_fire, & + pc13s%livecrootc, pcs%livecrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_storage_to_fire, pcf%m_livecrootc_storage_to_fire, & + pc13s%livecrootc_storage, pcs%livecrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_livecrootc_xfer_to_fire, pcf%m_livecrootc_xfer_to_fire, & + pc13s%livecrootc_xfer, pcs%livecrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_to_fire, pcf%m_deadcrootc_to_fire, & + pc13s%deadcrootc, pcs%deadcrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_to_litter_fire, pcf%m_deadcrootc_to_litter_fire, & + pc13s%deadcrootc, pcs%deadcrootc, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_storage_to_fire, pcf%m_deadcrootc_storage_to_fire, & + pc13s%deadcrootc_storage, pcs%deadcrootc_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_deadcrootc_xfer_to_fire, pcf%m_deadcrootc_xfer_to_fire, & + pc13s%deadcrootc_xfer, pcs%deadcrootc_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_gresp_storage_to_fire, pcf%m_gresp_storage_to_fire, & + pc13s%gresp_storage, pcs%gresp_storage, & + num_soilp, filter_soilp, 1._r8, 0) + + call C13FluxCalc(pc13f%m_gresp_xfer_to_fire, pcf%m_gresp_xfer_to_fire, & + pc13s%gresp_xfer, pcs%gresp_xfer, & + num_soilp, filter_soilp, 1._r8, 0) + + ! use routine p2c to calculate the column-level flux of deadstem and deadcrootc to + ! cwdc as the result of fire mortality. + call p2c(num_soilc, filter_soilc, pc13f%m_deadstemc_to_litter_fire, cc13f%m_deadstemc_to_cwdc_fire) + call p2c(num_soilc, filter_soilc, pc13f%m_deadcrootc_to_litter_fire, cc13f%m_deadcrootc_to_cwdc_fire) + + call C13FluxCalc(cc13f%m_litr1c_to_fire, ccf%m_litr1c_to_fire, & + cc13s%litr1c, ccs%litr1c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%m_litr2c_to_fire, ccf%m_litr2c_to_fire, & + cc13s%litr2c, ccs%litr2c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%m_litr3c_to_fire, ccf%m_litr3c_to_fire, & + cc13s%litr3c, ccs%litr3c, & + num_soilc, filter_soilc, 1._r8, 0) + + call C13FluxCalc(cc13f%m_cwdc_to_fire, ccf%m_cwdc_to_fire, & + cc13s%cwdc, ccs%cwdc, & + num_soilc, filter_soilc, 1._r8, 0) + +! call C13FluxCalc(pc13f%fx, pcf%fx, & +! pc13s%sx, pcs%sx, & +! num_soilc, filter_soilc, 1._r8, 0) + +end subroutine C13Flux3 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNC13LitterToColumn +! +! !INTERFACE: +subroutine CNC13LitterToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! called at the end of cn_phenology to gather all pft-level litterfall fluxes +! to the column level and assign them to the three litter pools +! +! !USES: + use clmtype + use clm_varpar, only : max_pft_per_col +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! weight (relative to column) for this pft (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: leafc_to_litr1c(:) + real(r8), pointer :: leafc_to_litr2c(:) + real(r8), pointer :: leafc_to_litr3c(:) + real(r8), pointer :: frootc_to_litr1c(:) + real(r8), pointer :: frootc_to_litr2c(:) + real(r8), pointer :: frootc_to_litr3c(:) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + leafc_to_litter => pc13f%leafc_to_litter + frootc_to_litter => pc13f%frootc_to_litter + npfts => col%npfts + pfti => col%pfti + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to derived type arrays (out) + leafc_to_litr1c => cc13f%leafc_to_litr1c + leafc_to_litr2c => cc13f%leafc_to_litr2c + leafc_to_litr3c => cc13f%leafc_to_litr3c + frootc_to_litr1c => cc13f%frootc_to_litr1c + frootc_to_litr2c => cc13f%frootc_to_litr2c + frootc_to_litr3c => cc13f%frootc_to_litr3c + + do pi = 1,max_pft_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 + if (pwtgcell(p)>0._r8) then + + ! leaf litter carbon fluxes + leafc_to_litr1c(c) = leafc_to_litr1c(c) + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + leafc_to_litr2c(c) = leafc_to_litr2c(c) + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + leafc_to_litr3c(c) = leafc_to_litr3c(c) + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root litter carbon fluxes + frootc_to_litr1c(c) = frootc_to_litr1c(c) + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + frootc_to_litr2c(c) = frootc_to_litr2c(c) + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + frootc_to_litr3c(c) = frootc_to_litr3c(c) + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + end if + end if + + end do + + end do + +end subroutine CNC13LitterToColumn +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNC13GapPftToColumn +! +! !INTERFACE: +subroutine CNC13GapPftToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! gather all pft-level gap mortality fluxes +! to the column level and assign them to the three litter pools (+ cwd pool) +! +! !USES: + use clmtype + use clm_varpar, only : max_pft_per_col, maxpatch_pft +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter +! +! !CALLED FROM: +! subroutine CNphenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! pft weight relative to column (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: m_leafc_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr2c(:) + real(r8), pointer :: m_leafc_to_litr3c(:) + real(r8), pointer :: m_frootc_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr2c(:) + real(r8), pointer :: m_frootc_to_litr3c(:) + real(r8), pointer :: m_livestemc_to_cwdc(:) + real(r8), pointer :: m_deadstemc_to_cwdc(:) + real(r8), pointer :: m_livecrootc_to_cwdc(:) + real(r8), pointer :: m_deadcrootc_to_cwdc(:) + real(r8), pointer :: m_leafc_storage_to_litr1c(:) + real(r8), pointer :: m_frootc_storage_to_litr1c(:) + real(r8), pointer :: m_livestemc_storage_to_litr1c(:) + real(r8), pointer :: m_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: m_gresp_storage_to_litr1c(:) + real(r8), pointer :: m_leafc_xfer_to_litr1c(:) + real(r8), pointer :: m_frootc_xfer_to_litr1c(:) + real(r8), pointer :: m_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_gresp_xfer_to_litr1c(:) +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to column-level arrays + npfts => col%npfts + pfti => col%pfti + m_leafc_to_litr1c => cc13f%m_leafc_to_litr1c + m_leafc_to_litr2c => cc13f%m_leafc_to_litr2c + m_leafc_to_litr3c => cc13f%m_leafc_to_litr3c + m_frootc_to_litr1c => cc13f%m_frootc_to_litr1c + m_frootc_to_litr2c => cc13f%m_frootc_to_litr2c + m_frootc_to_litr3c => cc13f%m_frootc_to_litr3c + m_livestemc_to_cwdc => cc13f%m_livestemc_to_cwdc + m_deadstemc_to_cwdc => cc13f%m_deadstemc_to_cwdc + m_livecrootc_to_cwdc => cc13f%m_livecrootc_to_cwdc + m_deadcrootc_to_cwdc => cc13f%m_deadcrootc_to_cwdc + m_leafc_storage_to_litr1c => cc13f%m_leafc_storage_to_litr1c + m_frootc_storage_to_litr1c => cc13f%m_frootc_storage_to_litr1c + m_livestemc_storage_to_litr1c => cc13f%m_livestemc_storage_to_litr1c + m_deadstemc_storage_to_litr1c => cc13f%m_deadstemc_storage_to_litr1c + m_livecrootc_storage_to_litr1c => cc13f%m_livecrootc_storage_to_litr1c + m_deadcrootc_storage_to_litr1c => cc13f%m_deadcrootc_storage_to_litr1c + m_gresp_storage_to_litr1c => cc13f%m_gresp_storage_to_litr1c + m_leafc_xfer_to_litr1c => cc13f%m_leafc_xfer_to_litr1c + m_frootc_xfer_to_litr1c => cc13f%m_frootc_xfer_to_litr1c + m_livestemc_xfer_to_litr1c => cc13f%m_livestemc_xfer_to_litr1c + m_deadstemc_xfer_to_litr1c => cc13f%m_deadstemc_xfer_to_litr1c + m_livecrootc_xfer_to_litr1c => cc13f%m_livecrootc_xfer_to_litr1c + m_deadcrootc_xfer_to_litr1c => cc13f%m_deadcrootc_xfer_to_litr1c + m_gresp_xfer_to_litr1c => cc13f%m_gresp_xfer_to_litr1c + + ! assign local pointers to pft-level arrays + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + m_leafc_to_litter => pc13f%m_leafc_to_litter + m_frootc_to_litter => pc13f%m_frootc_to_litter + m_livestemc_to_litter => pc13f%m_livestemc_to_litter + m_deadstemc_to_litter => pc13f%m_deadstemc_to_litter + m_livecrootc_to_litter => pc13f%m_livecrootc_to_litter + m_deadcrootc_to_litter => pc13f%m_deadcrootc_to_litter + m_leafc_storage_to_litter => pc13f%m_leafc_storage_to_litter + m_frootc_storage_to_litter => pc13f%m_frootc_storage_to_litter + m_livestemc_storage_to_litter => pc13f%m_livestemc_storage_to_litter + m_deadstemc_storage_to_litter => pc13f%m_deadstemc_storage_to_litter + m_livecrootc_storage_to_litter => pc13f%m_livecrootc_storage_to_litter + m_deadcrootc_storage_to_litter => pc13f%m_deadcrootc_storage_to_litter + m_gresp_storage_to_litter => pc13f%m_gresp_storage_to_litter + m_leafc_xfer_to_litter => pc13f%m_leafc_xfer_to_litter + m_frootc_xfer_to_litter => pc13f%m_frootc_xfer_to_litter + m_livestemc_xfer_to_litter => pc13f%m_livestemc_xfer_to_litter + m_deadstemc_xfer_to_litter => pc13f%m_deadstemc_xfer_to_litter + m_livecrootc_xfer_to_litter => pc13f%m_livecrootc_xfer_to_litter + m_deadcrootc_xfer_to_litter => pc13f%m_deadcrootc_xfer_to_litter + m_gresp_xfer_to_litter => pc13f%m_gresp_xfer_to_litter + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + + if (pwtgcell(p)>0._r8) then + + ! leaf gap mortality carbon fluxes + m_leafc_to_litr1c(c) = m_leafc_to_litr1c(c) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + m_leafc_to_litr2c(c) = m_leafc_to_litr2c(c) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + m_leafc_to_litr3c(c) = m_leafc_to_litr3c(c) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root gap mortality carbon fluxes + m_frootc_to_litr1c(c) = m_frootc_to_litr1c(c) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + m_frootc_to_litr2c(c) = m_frootc_to_litr2c(c) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + m_frootc_to_litr3c(c) = m_frootc_to_litr3c(c) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood gap mortality carbon fluxes + m_livestemc_to_cwdc(c) = m_livestemc_to_cwdc(c) + & + m_livestemc_to_litter(p) * wtcol(p) + m_deadstemc_to_cwdc(c) = m_deadstemc_to_cwdc(c) + & + m_deadstemc_to_litter(p) * wtcol(p) + m_livecrootc_to_cwdc(c) = m_livecrootc_to_cwdc(c) + & + m_livecrootc_to_litter(p) * wtcol(p) + m_deadcrootc_to_cwdc(c) = m_deadcrootc_to_cwdc(c) + & + m_deadcrootc_to_litter(p) * wtcol(p) + + ! storage gap mortality carbon fluxes + m_leafc_storage_to_litr1c(c) = m_leafc_storage_to_litr1c(c) + & + m_leafc_storage_to_litter(p) * wtcol(p) + m_frootc_storage_to_litr1c(c) = m_frootc_storage_to_litr1c(c) + & + m_frootc_storage_to_litter(p) * wtcol(p) + m_livestemc_storage_to_litr1c(c) = m_livestemc_storage_to_litr1c(c) + & + m_livestemc_storage_to_litter(p) * wtcol(p) + m_deadstemc_storage_to_litr1c(c) = m_deadstemc_storage_to_litr1c(c) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) + m_livecrootc_storage_to_litr1c(c) = m_livecrootc_storage_to_litr1c(c) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) + m_deadcrootc_storage_to_litr1c(c) = m_deadcrootc_storage_to_litr1c(c) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) + m_gresp_storage_to_litr1c(c) = m_gresp_storage_to_litr1c(c) + & + m_gresp_storage_to_litter(p) * wtcol(p) + + ! transfer gap mortality carbon fluxes + m_leafc_xfer_to_litr1c(c) = m_leafc_xfer_to_litr1c(c) + & + m_leafc_xfer_to_litter(p) * wtcol(p) + m_frootc_xfer_to_litr1c(c) = m_frootc_xfer_to_litr1c(c) + & + m_frootc_xfer_to_litter(p) * wtcol(p) + m_livestemc_xfer_to_litr1c(c) = m_livestemc_xfer_to_litr1c(c) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) + m_deadstemc_xfer_to_litr1c(c) = m_deadstemc_xfer_to_litr1c(c) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) + m_livecrootc_xfer_to_litr1c(c) = m_livecrootc_xfer_to_litr1c(c) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) + m_deadcrootc_xfer_to_litr1c(c) = m_deadcrootc_xfer_to_litr1c(c) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) + m_gresp_xfer_to_litr1c(c) = m_gresp_xfer_to_litr1c(c) + & + m_gresp_xfer_to_litter(p) * wtcol(p) + + end if + end if + + end do + + end do + +end subroutine CNC13GapPftToColumn +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNC13HarvestPftToColumn +! +! !INTERFACE: +subroutine CNC13HarvestPftToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! gather all pft-level harvest mortality fluxes +! to the column level and assign them to the litter, cwd, and wood product pools +! +! !USES: + use clmtype + use clm_varpar, only : max_pft_per_col, maxpatch_pft +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter +! +! !CALLED FROM: +! subroutine CNphenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! pft weight relative to column (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: phrv_deadstemc_to_prod10c(:) + real(r8), pointer :: phrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: hrv_leafc_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr2c(:) + real(r8), pointer :: hrv_leafc_to_litr3c(:) + real(r8), pointer :: hrv_frootc_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr2c(:) + real(r8), pointer :: hrv_frootc_to_litr3c(:) + real(r8), pointer :: hrv_livestemc_to_cwdc(:) + real(r8), pointer :: chrv_deadstemc_to_prod10c(:) + real(r8), pointer :: chrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_livecrootc_to_cwdc(:) + real(r8), pointer :: hrv_deadcrootc_to_cwdc(:) + real(r8), pointer :: hrv_leafc_storage_to_litr1c(:) + real(r8), pointer :: hrv_frootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_gresp_storage_to_litr1c(:) + real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:) +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to column-level arrays + npfts => col%npfts + pfti => col%pfti + hrv_leafc_to_litr1c => cc13f%hrv_leafc_to_litr1c + hrv_leafc_to_litr2c => cc13f%hrv_leafc_to_litr2c + hrv_leafc_to_litr3c => cc13f%hrv_leafc_to_litr3c + hrv_frootc_to_litr1c => cc13f%hrv_frootc_to_litr1c + hrv_frootc_to_litr2c => cc13f%hrv_frootc_to_litr2c + hrv_frootc_to_litr3c => cc13f%hrv_frootc_to_litr3c + hrv_livestemc_to_cwdc => cc13f%hrv_livestemc_to_cwdc + chrv_deadstemc_to_prod10c => cc13f%hrv_deadstemc_to_prod10c + chrv_deadstemc_to_prod100c => cc13f%hrv_deadstemc_to_prod100c + hrv_livecrootc_to_cwdc => cc13f%hrv_livecrootc_to_cwdc + hrv_deadcrootc_to_cwdc => cc13f%hrv_deadcrootc_to_cwdc + hrv_leafc_storage_to_litr1c => cc13f%hrv_leafc_storage_to_litr1c + hrv_frootc_storage_to_litr1c => cc13f%hrv_frootc_storage_to_litr1c + hrv_livestemc_storage_to_litr1c => cc13f%hrv_livestemc_storage_to_litr1c + hrv_deadstemc_storage_to_litr1c => cc13f%hrv_deadstemc_storage_to_litr1c + hrv_livecrootc_storage_to_litr1c => cc13f%hrv_livecrootc_storage_to_litr1c + hrv_deadcrootc_storage_to_litr1c => cc13f%hrv_deadcrootc_storage_to_litr1c + hrv_gresp_storage_to_litr1c => cc13f%hrv_gresp_storage_to_litr1c + hrv_leafc_xfer_to_litr1c => cc13f%hrv_leafc_xfer_to_litr1c + hrv_frootc_xfer_to_litr1c => cc13f%hrv_frootc_xfer_to_litr1c + hrv_livestemc_xfer_to_litr1c => cc13f%hrv_livestemc_xfer_to_litr1c + hrv_deadstemc_xfer_to_litr1c => cc13f%hrv_deadstemc_xfer_to_litr1c + hrv_livecrootc_xfer_to_litr1c => cc13f%hrv_livecrootc_xfer_to_litr1c + hrv_deadcrootc_xfer_to_litr1c => cc13f%hrv_deadcrootc_xfer_to_litr1c + hrv_gresp_xfer_to_litr1c => cc13f%hrv_gresp_xfer_to_litr1c + + ! assign local pointers to pft-level arrays + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + hrv_leafc_to_litter => pc13f%hrv_leafc_to_litter + hrv_frootc_to_litter => pc13f%hrv_frootc_to_litter + hrv_livestemc_to_litter => pc13f%hrv_livestemc_to_litter + phrv_deadstemc_to_prod10c => pc13f%hrv_deadstemc_to_prod10c + phrv_deadstemc_to_prod100c => pc13f%hrv_deadstemc_to_prod100c + hrv_livecrootc_to_litter => pc13f%hrv_livecrootc_to_litter + hrv_deadcrootc_to_litter => pc13f%hrv_deadcrootc_to_litter + hrv_leafc_storage_to_litter => pc13f%hrv_leafc_storage_to_litter + hrv_frootc_storage_to_litter => pc13f%hrv_frootc_storage_to_litter + hrv_livestemc_storage_to_litter => pc13f%hrv_livestemc_storage_to_litter + hrv_deadstemc_storage_to_litter => pc13f%hrv_deadstemc_storage_to_litter + hrv_livecrootc_storage_to_litter => pc13f%hrv_livecrootc_storage_to_litter + hrv_deadcrootc_storage_to_litter => pc13f%hrv_deadcrootc_storage_to_litter + hrv_gresp_storage_to_litter => pc13f%hrv_gresp_storage_to_litter + hrv_leafc_xfer_to_litter => pc13f%hrv_leafc_xfer_to_litter + hrv_frootc_xfer_to_litter => pc13f%hrv_frootc_xfer_to_litter + hrv_livestemc_xfer_to_litter => pc13f%hrv_livestemc_xfer_to_litter + hrv_deadstemc_xfer_to_litter => pc13f%hrv_deadstemc_xfer_to_litter + hrv_livecrootc_xfer_to_litter => pc13f%hrv_livecrootc_xfer_to_litter + hrv_deadcrootc_xfer_to_litter => pc13f%hrv_deadcrootc_xfer_to_litter + hrv_gresp_xfer_to_litter => pc13f%hrv_gresp_xfer_to_litter + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + + if (pwtgcell(p)>0._r8) then + + ! leaf harvest mortality carbon fluxes + hrv_leafc_to_litr1c(c) = hrv_leafc_to_litr1c(c) + & + hrv_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + hrv_leafc_to_litr2c(c) = hrv_leafc_to_litr2c(c) + & + hrv_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + hrv_leafc_to_litr3c(c) = hrv_leafc_to_litr3c(c) + & + hrv_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root harvest mortality carbon fluxes + hrv_frootc_to_litr1c(c) = hrv_frootc_to_litr1c(c) + & + hrv_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + hrv_frootc_to_litr2c(c) = hrv_frootc_to_litr2c(c) + & + hrv_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + hrv_frootc_to_litr3c(c) = hrv_frootc_to_litr3c(c) + & + hrv_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood harvest mortality carbon fluxes + hrv_livestemc_to_cwdc(c) = hrv_livestemc_to_cwdc(c) + & + hrv_livestemc_to_litter(p) * wtcol(p) + chrv_deadstemc_to_prod10c(c) = chrv_deadstemc_to_prod10c(c) + & + phrv_deadstemc_to_prod10c(p) * wtcol(p) + chrv_deadstemc_to_prod100c(c) = chrv_deadstemc_to_prod100c(c) + & + phrv_deadstemc_to_prod100c(p) * wtcol(p) + hrv_livecrootc_to_cwdc(c) = hrv_livecrootc_to_cwdc(c) + & + hrv_livecrootc_to_litter(p) * wtcol(p) + hrv_deadcrootc_to_cwdc(c) = hrv_deadcrootc_to_cwdc(c) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) + + ! storage harvest mortality carbon fluxes + hrv_leafc_storage_to_litr1c(c) = hrv_leafc_storage_to_litr1c(c) + & + hrv_leafc_storage_to_litter(p) * wtcol(p) + hrv_frootc_storage_to_litr1c(c) = hrv_frootc_storage_to_litr1c(c) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) + hrv_livestemc_storage_to_litr1c(c) = hrv_livestemc_storage_to_litr1c(c) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) + hrv_deadstemc_storage_to_litr1c(c) = hrv_deadstemc_storage_to_litr1c(c) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) + hrv_livecrootc_storage_to_litr1c(c) = hrv_livecrootc_storage_to_litr1c(c) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) + hrv_deadcrootc_storage_to_litr1c(c) = hrv_deadcrootc_storage_to_litr1c(c) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) + hrv_gresp_storage_to_litr1c(c) = hrv_gresp_storage_to_litr1c(c) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) + + ! transfer harvest mortality carbon fluxes + hrv_leafc_xfer_to_litr1c(c) = hrv_leafc_xfer_to_litr1c(c) + & + hrv_leafc_xfer_to_litter(p) * wtcol(p) + hrv_frootc_xfer_to_litr1c(c) = hrv_frootc_xfer_to_litr1c(c) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) + hrv_livestemc_xfer_to_litr1c(c) = hrv_livestemc_xfer_to_litr1c(c) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) + hrv_deadstemc_xfer_to_litr1c(c) = hrv_deadstemc_xfer_to_litr1c(c) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) + hrv_livecrootc_xfer_to_litr1c(c) = hrv_livecrootc_xfer_to_litr1c(c) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) + hrv_deadcrootc_xfer_to_litr1c(c) = hrv_deadcrootc_xfer_to_litr1c(c) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) + hrv_gresp_xfer_to_litr1c(c) = hrv_gresp_xfer_to_litr1c(c) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) + + end if + end if + + end do + + end do + +end subroutine CNC13HarvestPftToColumn +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13FluxCalc +! +! !INTERFACE: +subroutine C13FluxCalc(c13_flux, ctot_flux, c13_state, ctot_state, & + num, filter, frax, diag) +! +! !DESCRIPTION: +! On the radiation time step, set the 13-carbon flux +! variables (except for gap-phase mortality and fire fluxes) +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: c13_flux(:) !OUTPUT 13C flux + real(r8), pointer :: ctot_flux(:) !INPUT totC flux + real(r8), pointer :: c13_state(:) !INPUT 13C state, upstream pool + real(r8), pointer :: ctot_state(:) !INPUT totC state, upstream pool + real(r8), intent(in):: frax !fractionation factor (1 = no fractionation) + integer, intent(in) :: num ! number of filter members + integer, intent(in) :: filter(:) ! filter indices + integer, intent(in) :: diag !0=no diagnostics, 1=print diagnostics +! +! !CALLED FROM: +! subroutine C13Flux1 +! +! !REVISION HISTORY: +! +! !OTHER LOCAL VARIABLES: + integer :: i,f ! indices + real(r8) :: temp +! + ! loop over the supplied filter + do f = 1,num + i = filter(f) + if (ctot_state(i) /= 0._r8) then + c13_flux(i) = ctot_flux(i) * (c13_state(i)/ctot_state(i)) * frax + else + c13_flux(i) = 0._r8 + end if + + if (diag == 1) then + ! put diagnostic print statements here for 13C flux calculations + end if + end do +end subroutine C13FluxCalc +!----------------------------------------------------------------------- + +end module CNC13FluxMod + diff --git a/components/clm/src_clm40/biogeochem/CNC13StateUpdate1Mod.F90 b/components/clm/src_clm40/biogeochem/CNC13StateUpdate1Mod.F90 new file mode 100644 index 0000000000..c63a1ef17c --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNC13StateUpdate1Mod.F90 @@ -0,0 +1,591 @@ +module CNC13StateUpdate1Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: C13StateUpdate1Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, non-mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public:: C13StateUpdate1,C13StateUpdate0 +! +! !REVISION HISTORY: +! 4/21/2005: Created by Peter Thornton and Neil Suits - copied from +! CNCStateUpdate1 for C13 state variables. +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13StateUpdate0 +! +! !INTERFACE: +subroutine C13StateUpdate0(num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update cpool carbon state +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use clm_varctl, only : use_c13 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 7/1/05: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: psnshade_to_cpool(:) + real(r8), pointer :: psnsun_to_cpool(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + + if (.not. use_c13) then + RETURN + end if + + ! assign local pointers at the pft level + cpool => pc13s%cpool + psnshade_to_cpool => pc13f%psnshade_to_cpool + psnsun_to_cpool => pc13f%psnsun_to_cpool + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + ! gross photosynthesis fluxes + cpool(p) = cpool(p) + psnsun_to_cpool(p)*dt + cpool(p) = cpool(p) + psnshade_to_cpool(p)*dt + end do + +end subroutine C13StateUpdate0 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13StateUpdate1 +! +! !INTERFACE: +subroutine C13StateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables (except for gap-phase mortality and fire fluxes) +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! 12/5/03, Peter Thornton: Added livewood turnover fluxes +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays +! + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: cwdc_to_litr2c(:) + real(r8), pointer :: cwdc_to_litr3c(:) + real(r8), pointer :: frootc_to_litr1c(:) + real(r8), pointer :: frootc_to_litr2c(:) + real(r8), pointer :: frootc_to_litr3c(:) + real(r8), pointer :: leafc_to_litr1c(:) + real(r8), pointer :: leafc_to_litr2c(:) + real(r8), pointer :: leafc_to_litr3c(:) + real(r8), pointer :: litr1_hr(:) + real(r8), pointer :: litr1c_to_soil1c(:) + real(r8), pointer :: litr2_hr(:) + real(r8), pointer :: litr2c_to_soil2c(:) + real(r8), pointer :: litr3_hr(:) + real(r8), pointer :: litr3c_to_soil3c(:) + real(r8), pointer :: soil1_hr(:) + real(r8), pointer :: soil1c_to_soil2c(:) + real(r8), pointer :: soil2_hr(:) + real(r8), pointer :: soil2c_to_soil3c(:) + real(r8), pointer :: soil3_hr(:) + real(r8), pointer :: soil3c_to_soil4c(:) + real(r8), pointer :: soil4_hr(:) + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: cpool_to_xsmrpool(:) + real(r8), pointer :: cpool_to_deadcrootc(:) + real(r8), pointer :: cpool_to_deadcrootc_storage(:) + real(r8), pointer :: cpool_to_deadstemc(:) + real(r8), pointer :: cpool_to_deadstemc_storage(:) + real(r8), pointer :: cpool_to_frootc(:) + real(r8), pointer :: cpool_to_frootc_storage(:) + real(r8), pointer :: cpool_to_gresp_storage(:) + real(r8), pointer :: cpool_to_leafc(:) + real(r8), pointer :: cpool_to_leafc_storage(:) + real(r8), pointer :: cpool_to_livecrootc(:) + real(r8), pointer :: cpool_to_livecrootc_storage(:) + real(r8), pointer :: cpool_to_livestemc(:) + real(r8), pointer :: cpool_to_livestemc_storage(:) + real(r8), pointer :: deadcrootc_storage_to_xfer(:) + real(r8), pointer :: deadstemc_storage_to_xfer(:) + real(r8), pointer :: frootc_storage_to_xfer(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: gresp_storage_to_xfer(:) + real(r8), pointer :: leafc_storage_to_xfer(:) + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: livecrootc_storage_to_xfer(:) + real(r8), pointer :: livecrootc_to_deadcrootc(:) + real(r8), pointer :: livestemc_storage_to_xfer(:) + real(r8), pointer :: livestemc_to_deadstemc(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: livecroot_mr(:) + real(r8), pointer :: livestem_curmr(:) + real(r8), pointer :: froot_curmr(:) + real(r8), pointer :: leaf_curmr(:) + real(r8), pointer :: livecroot_curmr(:) + real(r8), pointer :: livestem_xsmr(:) + real(r8), pointer :: froot_xsmr(:) + real(r8), pointer :: leaf_xsmr(:) + real(r8), pointer :: livecroot_xsmr(:) + real(r8), pointer :: cpool_deadcroot_gr(:) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) + real(r8), pointer :: cpool_deadstem_gr(:) + real(r8), pointer :: cpool_deadstem_storage_gr(:) + real(r8), pointer :: cpool_froot_gr(:) + real(r8), pointer :: cpool_froot_storage_gr(:) + real(r8), pointer :: cpool_leaf_gr(:) + real(r8), pointer :: cpool_leaf_storage_gr(:) + real(r8), pointer :: cpool_livecroot_gr(:) + real(r8), pointer :: cpool_livecroot_storage_gr(:) + real(r8), pointer :: cpool_livestem_gr(:) + real(r8), pointer :: cpool_livestem_storage_gr(:) + real(r8), pointer :: transfer_deadcroot_gr(:) + real(r8), pointer :: transfer_deadstem_gr(:) + real(r8), pointer :: transfer_froot_gr(:) + real(r8), pointer :: transfer_leaf_gr(:) + real(r8), pointer :: transfer_livecroot_gr(:) + real(r8), pointer :: transfer_livestem_gr(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) execss maint resp C pool + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + +! local pointers for dynamic landcover fluxes and states + real(r8), pointer :: dwt_seedc_to_leaf(:) + real(r8), pointer :: dwt_seedc_to_deadstem(:) + real(r8), pointer :: dwt_frootc_to_litr1c(:) + real(r8), pointer :: dwt_frootc_to_litr2c(:) + real(r8), pointer :: dwt_frootc_to_litr3c(:) + real(r8), pointer :: dwt_livecrootc_to_cwdc(:) + real(r8), pointer :: dwt_deadcrootc_to_cwdc(:) + real(r8), pointer :: seedc(:) +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers + woody => pftcon%woody + + ! assign local pointers at the column level + cwdc_to_litr2c => cc13f%cwdc_to_litr2c + cwdc_to_litr3c => cc13f%cwdc_to_litr3c + frootc_to_litr1c => cc13f%frootc_to_litr1c + frootc_to_litr2c => cc13f%frootc_to_litr2c + frootc_to_litr3c => cc13f%frootc_to_litr3c + leafc_to_litr1c => cc13f%leafc_to_litr1c + leafc_to_litr2c => cc13f%leafc_to_litr2c + leafc_to_litr3c => cc13f%leafc_to_litr3c + litr1_hr => cc13f%litr1_hr + litr1c_to_soil1c => cc13f%litr1c_to_soil1c + litr2_hr => cc13f%litr2_hr + litr2c_to_soil2c => cc13f%litr2c_to_soil2c + litr3_hr => cc13f%litr3_hr + litr3c_to_soil3c => cc13f%litr3c_to_soil3c + soil1_hr => cc13f%soil1_hr + soil1c_to_soil2c => cc13f%soil1c_to_soil2c + soil2_hr => cc13f%soil2_hr + soil2c_to_soil3c => cc13f%soil2c_to_soil3c + soil3_hr => cc13f%soil3_hr + soil3c_to_soil4c => cc13f%soil3c_to_soil4c + soil4_hr => cc13f%soil4_hr + col_ctrunc => cc13s%col_ctrunc + cwdc => cc13s%cwdc + litr1c => cc13s%litr1c + litr2c => cc13s%litr2c + litr3c => cc13s%litr3c + soil1c => cc13s%soil1c + soil2c => cc13s%soil2c + soil3c => cc13s%soil3c + soil4c => cc13s%soil4c + ! new pointers for dynamic landcover + dwt_seedc_to_leaf => cc13f%dwt_seedc_to_leaf + dwt_seedc_to_deadstem => cc13f%dwt_seedc_to_deadstem + dwt_frootc_to_litr1c => cc13f%dwt_frootc_to_litr1c + dwt_frootc_to_litr2c => cc13f%dwt_frootc_to_litr2c + dwt_frootc_to_litr3c => cc13f%dwt_frootc_to_litr3c + dwt_livecrootc_to_cwdc => cc13f%dwt_livecrootc_to_cwdc + dwt_deadcrootc_to_cwdc => cc13f%dwt_deadcrootc_to_cwdc + seedc => cc13s%seedc + + ! assign local pointers at the pft level + ivt => pft%itype + cpool_deadcroot_gr => pc13f%cpool_deadcroot_gr + cpool_deadcroot_storage_gr => pc13f%cpool_deadcroot_storage_gr + cpool_deadstem_gr => pc13f%cpool_deadstem_gr + cpool_deadstem_storage_gr => pc13f%cpool_deadstem_storage_gr + cpool_froot_gr => pc13f%cpool_froot_gr + cpool_froot_storage_gr => pc13f%cpool_froot_storage_gr + cpool_leaf_gr => pc13f%cpool_leaf_gr + cpool_leaf_storage_gr => pc13f%cpool_leaf_storage_gr + cpool_livecroot_gr => pc13f%cpool_livecroot_gr + cpool_livecroot_storage_gr => pc13f%cpool_livecroot_storage_gr + cpool_livestem_gr => pc13f%cpool_livestem_gr + cpool_livestem_storage_gr => pc13f%cpool_livestem_storage_gr + cpool_to_xsmrpool => pc13f%cpool_to_xsmrpool + cpool_to_deadcrootc => pc13f%cpool_to_deadcrootc + cpool_to_deadcrootc_storage => pc13f%cpool_to_deadcrootc_storage + cpool_to_deadstemc => pc13f%cpool_to_deadstemc + cpool_to_deadstemc_storage => pc13f%cpool_to_deadstemc_storage + cpool_to_frootc => pc13f%cpool_to_frootc + cpool_to_frootc_storage => pc13f%cpool_to_frootc_storage + cpool_to_gresp_storage => pc13f%cpool_to_gresp_storage + cpool_to_leafc => pc13f%cpool_to_leafc + cpool_to_leafc_storage => pc13f%cpool_to_leafc_storage + cpool_to_livecrootc => pc13f%cpool_to_livecrootc + cpool_to_livecrootc_storage => pc13f%cpool_to_livecrootc_storage + cpool_to_livestemc => pc13f%cpool_to_livestemc + cpool_to_livestemc_storage => pc13f%cpool_to_livestemc_storage + deadcrootc_storage_to_xfer => pc13f%deadcrootc_storage_to_xfer + deadcrootc_xfer_to_deadcrootc => pc13f%deadcrootc_xfer_to_deadcrootc + deadstemc_storage_to_xfer => pc13f%deadstemc_storage_to_xfer + deadstemc_xfer_to_deadstemc => pc13f%deadstemc_xfer_to_deadstemc + froot_mr => pc13f%froot_mr + froot_curmr => pc13f%froot_curmr + froot_xsmr => pc13f%froot_xsmr + frootc_storage_to_xfer => pc13f%frootc_storage_to_xfer + frootc_to_litter => pc13f%frootc_to_litter + frootc_xfer_to_frootc => pc13f%frootc_xfer_to_frootc + gresp_storage_to_xfer => pc13f%gresp_storage_to_xfer + leaf_mr => pc13f%leaf_mr + leaf_curmr => pc13f%leaf_curmr + leaf_xsmr => pc13f%leaf_xsmr + leafc_storage_to_xfer => pc13f%leafc_storage_to_xfer + leafc_to_litter => pc13f%leafc_to_litter + leafc_xfer_to_leafc => pc13f%leafc_xfer_to_leafc + livecroot_mr => pc13f%livecroot_mr + livecroot_curmr => pc13f%livecroot_curmr + livecroot_xsmr => pc13f%livecroot_xsmr + livecrootc_storage_to_xfer => pc13f%livecrootc_storage_to_xfer + livecrootc_to_deadcrootc => pc13f%livecrootc_to_deadcrootc + livecrootc_xfer_to_livecrootc => pc13f%livecrootc_xfer_to_livecrootc + livestem_mr => pc13f%livestem_mr + livestem_curmr => pc13f%livestem_curmr + livestem_xsmr => pc13f%livestem_xsmr + livestemc_storage_to_xfer => pc13f%livestemc_storage_to_xfer + livestemc_to_deadstemc => pc13f%livestemc_to_deadstemc + livestemc_xfer_to_livestemc => pc13f%livestemc_xfer_to_livestemc + transfer_deadcroot_gr => pc13f%transfer_deadcroot_gr + transfer_deadstem_gr => pc13f%transfer_deadstem_gr + transfer_froot_gr => pc13f%transfer_froot_gr + transfer_leaf_gr => pc13f%transfer_leaf_gr + transfer_livecroot_gr => pc13f%transfer_livecroot_gr + transfer_livestem_gr => pc13f%transfer_livestem_gr + cpool => pc13s%cpool + xsmrpool => pc13s%xsmrpool + deadcrootc => pc13s%deadcrootc + deadcrootc_storage => pc13s%deadcrootc_storage + deadcrootc_xfer => pc13s%deadcrootc_xfer + deadstemc => pc13s%deadstemc + deadstemc_storage => pc13s%deadstemc_storage + deadstemc_xfer => pc13s%deadstemc_xfer + frootc => pc13s%frootc + frootc_storage => pc13s%frootc_storage + frootc_xfer => pc13s%frootc_xfer + gresp_storage => pc13s%gresp_storage + gresp_xfer => pc13s%gresp_xfer + leafc => pc13s%leafc + leafc_storage => pc13s%leafc_storage + leafc_xfer => pc13s%leafc_xfer + livecrootc => pc13s%livecrootc + livecrootc_storage => pc13s%livecrootc_storage + livecrootc_xfer => pc13s%livecrootc_xfer + livestemc => pc13s%livestemc + livestemc_storage => pc13s%livestemc_storage + livestemc_xfer => pc13s%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level fluxes + + ! plant to litter fluxes + ! leaf litter + litr1c(c) = litr1c(c) + leafc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + leafc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + leafc_to_litr3c(c)*dt + ! fine root litter + litr1c(c) = litr1c(c) + frootc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + frootc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + frootc_to_litr3c(c)*dt + + ! seeding fluxes, from dynamic landcover + seedc(c) = seedc(c) - dwt_seedc_to_leaf(c) * dt + seedc(c) = seedc(c) - dwt_seedc_to_deadstem(c) * dt + + ! fluxes into litter and CWD, from dynamic landcover + litr1c(c) = litr1c(c) + dwt_frootc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + dwt_frootc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + dwt_frootc_to_litr3c(c)*dt + cwdc(c) = cwdc(c) + dwt_livecrootc_to_cwdc(c)*dt + cwdc(c) = cwdc(c) + dwt_deadcrootc_to_cwdc(c)*dt + + ! litter and SOM HR fluxes + litr1c(c) = litr1c(c) - litr1_hr(c)*dt + litr2c(c) = litr2c(c) - litr2_hr(c)*dt + litr3c(c) = litr3c(c) - litr3_hr(c)*dt + soil1c(c) = soil1c(c) - soil1_hr(c)*dt + soil2c(c) = soil2c(c) - soil2_hr(c)*dt + soil3c(c) = soil3c(c) - soil3_hr(c)*dt + soil4c(c) = soil4c(c) - soil4_hr(c)*dt + + ! CWD to litter fluxes + cwdc(c) = cwdc(c) - cwdc_to_litr2c(c)*dt + litr2c(c) = litr2c(c) + cwdc_to_litr2c(c)*dt + cwdc(c) = cwdc(c) - cwdc_to_litr3c(c)*dt + litr3c(c) = litr3c(c) + cwdc_to_litr3c(c)*dt + + ! litter to SOM fluxes + litr1c(c) = litr1c(c) - litr1c_to_soil1c(c)*dt + soil1c(c) = soil1c(c) + litr1c_to_soil1c(c)*dt + litr2c(c) = litr2c(c) - litr2c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) + litr2c_to_soil2c(c)*dt + litr3c(c) = litr3c(c) - litr3c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) + litr3c_to_soil3c(c)*dt + + ! SOM to SOM fluxes + soil1c(c) = soil1c(c) - soil1c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) + soil1c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) - soil2c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) + soil2c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) - soil3c_to_soil4c(c)*dt + soil4c(c) = soil4c(c) + soil3c_to_soil4c(c)*dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + leafc(p) = leafc(p) + leafc_xfer_to_leafc(p)*dt + leafc_xfer(p) = leafc_xfer(p) - leafc_xfer_to_leafc(p)*dt + frootc(p) = frootc(p) + frootc_xfer_to_frootc(p)*dt + frootc_xfer(p) = frootc_xfer(p) - frootc_xfer_to_frootc(p)*dt + if (woody(ivt(p)) == 1._r8) then + livestemc(p) = livestemc(p) + livestemc_xfer_to_livestemc(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) - livestemc_xfer_to_livestemc(p)*dt + deadstemc(p) = deadstemc(p) + deadstemc_xfer_to_deadstemc(p)*dt + deadstemc_xfer(p) = deadstemc_xfer(p) - deadstemc_xfer_to_deadstemc(p)*dt + livecrootc(p) = livecrootc(p) + livecrootc_xfer_to_livecrootc(p)*dt + livecrootc_xfer(p) = livecrootc_xfer(p) - livecrootc_xfer_to_livecrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + deadcrootc_xfer_to_deadcrootc(p)*dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - deadcrootc_xfer_to_deadcrootc(p)*dt + end if + + ! phenology: litterfall fluxes + leafc(p) = leafc(p) - leafc_to_litter(p)*dt + frootc(p) = frootc(p) - frootc_to_litter(p)*dt + + ! livewood turnover fluxes + if (woody(ivt(p)) == 1._r8) then + livestemc(p) = livestemc(p) - livestemc_to_deadstemc(p)*dt + deadstemc(p) = deadstemc(p) + livestemc_to_deadstemc(p)*dt + livecrootc(p) = livecrootc(p) - livecrootc_to_deadcrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + livecrootc_to_deadcrootc(p)*dt + end if + + ! maintenance respiration fluxes + cpool(p) = cpool(p) - cpool_to_xsmrpool(p)*dt + cpool(p) = cpool(p) - leaf_curmr(p)*dt + cpool(p) = cpool(p) - froot_curmr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - livestem_curmr(p)*dt + cpool(p) = cpool(p) - livecroot_curmr(p)*dt + end if + + ! maintenance respiration fluxes + xsmrpool(p) = xsmrpool(p) + cpool_to_xsmrpool(p)*dt + xsmrpool(p) = xsmrpool(p) - leaf_xsmr(p)*dt + xsmrpool(p) = xsmrpool(p) - froot_xsmr(p)*dt + if (woody(ivt(p)) == 1._r8) then + xsmrpool(p) = xsmrpool(p) - livestem_xsmr(p)*dt + xsmrpool(p) = xsmrpool(p) - livecroot_xsmr(p)*dt + end if + + ! allocation fluxes + cpool(p) = cpool(p) - cpool_to_leafc(p)*dt + leafc(p) = leafc(p) + cpool_to_leafc(p)*dt + cpool(p) = cpool(p) - cpool_to_leafc_storage(p)*dt + leafc_storage(p) = leafc_storage(p) + cpool_to_leafc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_frootc(p)*dt + frootc(p) = frootc(p) + cpool_to_frootc(p)*dt + cpool(p) = cpool(p) - cpool_to_frootc_storage(p)*dt + frootc_storage(p) = frootc_storage(p) + cpool_to_frootc_storage(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_to_livestemc(p)*dt + livestemc(p) = livestemc(p) + cpool_to_livestemc(p)*dt + cpool(p) = cpool(p) - cpool_to_livestemc_storage(p)*dt + livestemc_storage(p) = livestemc_storage(p) + cpool_to_livestemc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_deadstemc(p)*dt + deadstemc(p) = deadstemc(p) + cpool_to_deadstemc(p)*dt + cpool(p) = cpool(p) - cpool_to_deadstemc_storage(p)*dt + deadstemc_storage(p) = deadstemc_storage(p) + cpool_to_deadstemc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_livecrootc(p)*dt + livecrootc(p) = livecrootc(p) + cpool_to_livecrootc(p)*dt + cpool(p) = cpool(p) - cpool_to_livecrootc_storage(p)*dt + livecrootc_storage(p) = livecrootc_storage(p) + cpool_to_livecrootc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_deadcrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + cpool_to_deadcrootc(p)*dt + cpool(p) = cpool(p) - cpool_to_deadcrootc_storage(p)*dt + deadcrootc_storage(p) = deadcrootc_storage(p) + cpool_to_deadcrootc_storage(p)*dt + end if + + ! growth respiration fluxes for current growth + cpool(p) = cpool(p) - cpool_leaf_gr(p)*dt + cpool(p) = cpool(p) - cpool_froot_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_livestem_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadstem_gr(p)*dt + cpool(p) = cpool(p) - cpool_livecroot_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadcroot_gr(p)*dt + end if + + ! growth respiration for transfer growth + gresp_xfer(p) = gresp_xfer(p) - transfer_leaf_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_froot_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + gresp_xfer(p) = gresp_xfer(p) - transfer_livestem_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_deadstem_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_livecroot_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_deadcroot_gr(p)*dt + end if + + ! growth respiration at time of storage + cpool(p) = cpool(p) - cpool_leaf_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_froot_storage_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_livestem_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadstem_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_livecroot_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadcroot_storage_gr(p)*dt + end if + + ! growth respiration stored for release during transfer growth + cpool(p) = cpool(p) - cpool_to_gresp_storage(p)*dt + gresp_storage(p) = gresp_storage(p) + cpool_to_gresp_storage(p)*dt + + ! move storage pools into transfer pools + leafc_storage(p) = leafc_storage(p) - leafc_storage_to_xfer(p)*dt + leafc_xfer(p) = leafc_xfer(p) + leafc_storage_to_xfer(p)*dt + frootc_storage(p) = frootc_storage(p) - frootc_storage_to_xfer(p)*dt + frootc_xfer(p) = frootc_xfer(p) + frootc_storage_to_xfer(p)*dt + if (woody(ivt(p)) == 1._r8) then + livestemc_storage(p) = livestemc_storage(p) - livestemc_storage_to_xfer(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) + livestemc_storage_to_xfer(p)*dt + deadstemc_storage(p) = deadstemc_storage(p) - deadstemc_storage_to_xfer(p)*dt + deadstemc_xfer(p) = deadstemc_xfer(p) + deadstemc_storage_to_xfer(p)*dt + livecrootc_storage(p) = livecrootc_storage(p) - livecrootc_storage_to_xfer(p)*dt + livecrootc_xfer(p) = livecrootc_xfer(p) + livecrootc_storage_to_xfer(p)*dt + deadcrootc_storage(p) = deadcrootc_storage(p) - deadcrootc_storage_to_xfer(p)*dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) + deadcrootc_storage_to_xfer(p)*dt + gresp_storage(p) = gresp_storage(p) - gresp_storage_to_xfer(p)*dt + gresp_xfer(p) = gresp_xfer(p) + gresp_storage_to_xfer(p)*dt + end if + + end do ! end of pft loop + +end subroutine C13StateUpdate1 +!----------------------------------------------------------------------- + +end module CNC13StateUpdate1Mod diff --git a/components/clm/src_clm40/biogeochem/CNC13StateUpdate2Mod.F90 b/components/clm/src_clm40/biogeochem/CNC13StateUpdate2Mod.F90 new file mode 100644 index 0000000000..0ded060270 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNC13StateUpdate2Mod.F90 @@ -0,0 +1,576 @@ +module CNC13StateUpdate2Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: C13StateUpdate2Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: C13StateUpdate2 + public:: C13StateUpdate2h +! +! !REVISION HISTORY: +! 4/21/2005: Created by Peter Thornton and Neil Suits - copied from +! CNCStateUpdate2 for C13 state variables. +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13StateUpdate2 +! +! !INTERFACE: +subroutine C13StateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables affected by gap-phase mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use clm_varctl, only : use_c13 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_to_cwdc(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: m_deadstemc_to_cwdc(:) + real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: m_frootc_storage_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr2c(:) + real(r8), pointer :: m_frootc_to_litr3c(:) + real(r8), pointer :: m_frootc_xfer_to_litr1c(:) + real(r8), pointer :: m_gresp_storage_to_litr1c(:) + real(r8), pointer :: m_gresp_xfer_to_litr1c(:) + real(r8), pointer :: m_leafc_storage_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr2c(:) + real(r8), pointer :: m_leafc_to_litr3c(:) + real(r8), pointer :: m_leafc_xfer_to_litr1c(:) + real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: m_livecrootc_to_cwdc(:) + real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_livestemc_storage_to_litr1c(:) + real(r8), pointer :: m_livestemc_to_cwdc(:) + real(r8), pointer :: m_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) !(gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) !(gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer +! +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + + if (.not. use_c13) then + RETURN + end if + + ! assign local pointers at the column level + m_deadcrootc_storage_to_litr1c => cc13f%m_deadcrootc_storage_to_litr1c + m_deadcrootc_to_cwdc => cc13f%m_deadcrootc_to_cwdc + m_deadcrootc_xfer_to_litr1c => cc13f%m_deadcrootc_xfer_to_litr1c + m_deadstemc_storage_to_litr1c => cc13f%m_deadstemc_storage_to_litr1c + m_deadstemc_to_cwdc => cc13f%m_deadstemc_to_cwdc + m_deadstemc_xfer_to_litr1c => cc13f%m_deadstemc_xfer_to_litr1c + m_frootc_storage_to_litr1c => cc13f%m_frootc_storage_to_litr1c + m_frootc_to_litr1c => cc13f%m_frootc_to_litr1c + m_frootc_to_litr2c => cc13f%m_frootc_to_litr2c + m_frootc_to_litr3c => cc13f%m_frootc_to_litr3c + m_frootc_xfer_to_litr1c => cc13f%m_frootc_xfer_to_litr1c + m_gresp_storage_to_litr1c => cc13f%m_gresp_storage_to_litr1c + m_gresp_xfer_to_litr1c => cc13f%m_gresp_xfer_to_litr1c + m_leafc_storage_to_litr1c => cc13f%m_leafc_storage_to_litr1c + m_leafc_to_litr1c => cc13f%m_leafc_to_litr1c + m_leafc_to_litr2c => cc13f%m_leafc_to_litr2c + m_leafc_to_litr3c => cc13f%m_leafc_to_litr3c + m_leafc_xfer_to_litr1c => cc13f%m_leafc_xfer_to_litr1c + m_livecrootc_storage_to_litr1c => cc13f%m_livecrootc_storage_to_litr1c + m_livecrootc_to_cwdc => cc13f%m_livecrootc_to_cwdc + m_livecrootc_xfer_to_litr1c => cc13f%m_livecrootc_xfer_to_litr1c + m_livestemc_storage_to_litr1c => cc13f%m_livestemc_storage_to_litr1c + m_livestemc_to_cwdc => cc13f%m_livestemc_to_cwdc + m_livestemc_xfer_to_litr1c => cc13f%m_livestemc_xfer_to_litr1c + cwdc => cc13s%cwdc + litr1c => cc13s%litr1c + litr2c => cc13s%litr2c + litr3c => cc13s%litr3c + + ! assign local pointers at the pft level + m_deadcrootc_storage_to_litter => pc13f%m_deadcrootc_storage_to_litter + m_deadcrootc_to_litter => pc13f%m_deadcrootc_to_litter + m_deadcrootc_xfer_to_litter => pc13f%m_deadcrootc_xfer_to_litter + m_deadstemc_storage_to_litter => pc13f%m_deadstemc_storage_to_litter + m_deadstemc_to_litter => pc13f%m_deadstemc_to_litter + m_deadstemc_xfer_to_litter => pc13f%m_deadstemc_xfer_to_litter + m_frootc_storage_to_litter => pc13f%m_frootc_storage_to_litter + m_frootc_to_litter => pc13f%m_frootc_to_litter + m_frootc_xfer_to_litter => pc13f%m_frootc_xfer_to_litter + m_gresp_storage_to_litter => pc13f%m_gresp_storage_to_litter + m_gresp_xfer_to_litter => pc13f%m_gresp_xfer_to_litter + m_leafc_storage_to_litter => pc13f%m_leafc_storage_to_litter + m_leafc_to_litter => pc13f%m_leafc_to_litter + m_leafc_xfer_to_litter => pc13f%m_leafc_xfer_to_litter + m_livecrootc_storage_to_litter => pc13f%m_livecrootc_storage_to_litter + m_livecrootc_to_litter => pc13f%m_livecrootc_to_litter + m_livecrootc_xfer_to_litter => pc13f%m_livecrootc_xfer_to_litter + m_livestemc_storage_to_litter => pc13f%m_livestemc_storage_to_litter + m_livestemc_to_litter => pc13f%m_livestemc_to_litter + m_livestemc_xfer_to_litter => pc13f%m_livestemc_xfer_to_litter + deadcrootc => pc13s%deadcrootc + deadcrootc_storage => pc13s%deadcrootc_storage + deadcrootc_xfer => pc13s%deadcrootc_xfer + deadstemc => pc13s%deadstemc + deadstemc_storage => pc13s%deadstemc_storage + deadstemc_xfer => pc13s%deadstemc_xfer + frootc => pc13s%frootc + frootc_storage => pc13s%frootc_storage + frootc_xfer => pc13s%frootc_xfer + gresp_storage => pc13s%gresp_storage + gresp_xfer => pc13s%gresp_xfer + leafc => pc13s%leafc + leafc_storage => pc13s%leafc_storage + leafc_xfer => pc13s%leafc_xfer + livecrootc => pc13s%livecrootc + livecrootc_storage => pc13s%livecrootc_storage + livecrootc_xfer => pc13s%livecrootc_xfer + livestemc => pc13s%livestemc + livestemc_storage => pc13s%livestemc_storage + livestemc_xfer => pc13s%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from gap-phase mortality + + ! leaf to litter + litr1c(c) = litr1c(c) + m_leafc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + m_leafc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + m_leafc_to_litr3c(c) * dt + + ! fine root to litter + litr1c(c) = litr1c(c) + m_frootc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + m_frootc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + m_frootc_to_litr3c(c) * dt + + ! wood to CWD + cwdc(c) = cwdc(c) + m_livestemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_livecrootc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc(c) * dt + + ! storage pools to litter + litr1c(c) = litr1c(c) + m_leafc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_frootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livestemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadstemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livecrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadcrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_gresp_storage_to_litr1c(c) * dt + + ! transfer pools to litter + litr1c(c) = litr1c(c) + m_leafc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_frootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livestemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadstemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livecrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadcrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_gresp_xfer_to_litr1c(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from gap-phase mortality + ! displayed pools + leafc(p) = leafc(p) - m_leafc_to_litter(p) * dt + frootc(p) = frootc(p) - m_frootc_to_litter(p) * dt + livestemc(p) = livestemc(p) - m_livestemc_to_litter(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_litter(p) * dt + livecrootc(p) = livecrootc(p) - m_livecrootc_to_litter(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_litter(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - m_leafc_storage_to_litter(p) * dt + frootc_storage(p) = frootc_storage(p) - m_frootc_storage_to_litter(p) * dt + livestemc_storage(p) = livestemc_storage(p) - m_livestemc_storage_to_litter(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - m_deadstemc_storage_to_litter(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - m_livecrootc_storage_to_litter(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - m_deadcrootc_storage_to_litter(p) * dt + gresp_storage(p) = gresp_storage(p) - m_gresp_storage_to_litter(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - m_leafc_xfer_to_litter(p) * dt + frootc_xfer(p) = frootc_xfer(p) - m_frootc_xfer_to_litter(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - m_livestemc_xfer_to_litter(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - m_deadstemc_xfer_to_litter(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - m_livecrootc_xfer_to_litter(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - m_deadcrootc_xfer_to_litter(p) * dt + gresp_xfer(p) = gresp_xfer(p) - m_gresp_xfer_to_litter(p) * dt + + end do ! end of pft loop + +end subroutine C13StateUpdate2 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13StateUpdate2h +! +! !INTERFACE: +subroutine C13StateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Update all the prognostic carbon state +! variables affected by harvest mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 5/20/09: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_to_cwdc(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_frootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr2c(:) + real(r8), pointer :: hrv_frootc_to_litr3c(:) + real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_gresp_storage_to_litr1c(:) + real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:) + real(r8), pointer :: hrv_leafc_storage_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr2c(:) + real(r8), pointer :: hrv_leafc_to_litr3c(:) + real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_to_cwdc(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_to_cwdc(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: xsmrpool(:) ! (gC/m2) abstract C pool to meet excess MR demand +! +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + hrv_deadcrootc_storage_to_litr1c => cc13f%hrv_deadcrootc_storage_to_litr1c + hrv_deadcrootc_to_cwdc => cc13f%hrv_deadcrootc_to_cwdc + hrv_deadcrootc_xfer_to_litr1c => cc13f%hrv_deadcrootc_xfer_to_litr1c + hrv_deadstemc_storage_to_litr1c => cc13f%hrv_deadstemc_storage_to_litr1c + hrv_deadstemc_xfer_to_litr1c => cc13f%hrv_deadstemc_xfer_to_litr1c + hrv_frootc_storage_to_litr1c => cc13f%hrv_frootc_storage_to_litr1c + hrv_frootc_to_litr1c => cc13f%hrv_frootc_to_litr1c + hrv_frootc_to_litr2c => cc13f%hrv_frootc_to_litr2c + hrv_frootc_to_litr3c => cc13f%hrv_frootc_to_litr3c + hrv_frootc_xfer_to_litr1c => cc13f%hrv_frootc_xfer_to_litr1c + hrv_gresp_storage_to_litr1c => cc13f%hrv_gresp_storage_to_litr1c + hrv_gresp_xfer_to_litr1c => cc13f%hrv_gresp_xfer_to_litr1c + hrv_leafc_storage_to_litr1c => cc13f%hrv_leafc_storage_to_litr1c + hrv_leafc_to_litr1c => cc13f%hrv_leafc_to_litr1c + hrv_leafc_to_litr2c => cc13f%hrv_leafc_to_litr2c + hrv_leafc_to_litr3c => cc13f%hrv_leafc_to_litr3c + hrv_leafc_xfer_to_litr1c => cc13f%hrv_leafc_xfer_to_litr1c + hrv_livecrootc_storage_to_litr1c => cc13f%hrv_livecrootc_storage_to_litr1c + hrv_livecrootc_to_cwdc => cc13f%hrv_livecrootc_to_cwdc + hrv_livecrootc_xfer_to_litr1c => cc13f%hrv_livecrootc_xfer_to_litr1c + hrv_livestemc_storage_to_litr1c => cc13f%hrv_livestemc_storage_to_litr1c + hrv_livestemc_to_cwdc => cc13f%hrv_livestemc_to_cwdc + hrv_livestemc_xfer_to_litr1c => cc13f%hrv_livestemc_xfer_to_litr1c + cwdc => cc13s%cwdc + litr1c => cc13s%litr1c + litr2c => cc13s%litr2c + litr3c => cc13s%litr3c + + ! assign local pointers at the pft level + hrv_deadcrootc_storage_to_litter => pc13f%hrv_deadcrootc_storage_to_litter + hrv_deadcrootc_to_litter => pc13f%hrv_deadcrootc_to_litter + hrv_deadcrootc_xfer_to_litter => pc13f%hrv_deadcrootc_xfer_to_litter + hrv_deadstemc_storage_to_litter => pc13f%hrv_deadstemc_storage_to_litter + hrv_deadstemc_to_prod10c => pc13f%hrv_deadstemc_to_prod10c + hrv_deadstemc_to_prod100c => pc13f%hrv_deadstemc_to_prod100c + hrv_deadstemc_xfer_to_litter => pc13f%hrv_deadstemc_xfer_to_litter + hrv_frootc_storage_to_litter => pc13f%hrv_frootc_storage_to_litter + hrv_frootc_to_litter => pc13f%hrv_frootc_to_litter + hrv_frootc_xfer_to_litter => pc13f%hrv_frootc_xfer_to_litter + hrv_gresp_storage_to_litter => pc13f%hrv_gresp_storage_to_litter + hrv_gresp_xfer_to_litter => pc13f%hrv_gresp_xfer_to_litter + hrv_leafc_storage_to_litter => pc13f%hrv_leafc_storage_to_litter + hrv_leafc_to_litter => pc13f%hrv_leafc_to_litter + hrv_leafc_xfer_to_litter => pc13f%hrv_leafc_xfer_to_litter + hrv_livecrootc_storage_to_litter => pc13f%hrv_livecrootc_storage_to_litter + hrv_livecrootc_to_litter => pc13f%hrv_livecrootc_to_litter + hrv_livecrootc_xfer_to_litter => pc13f%hrv_livecrootc_xfer_to_litter + hrv_livestemc_storage_to_litter => pc13f%hrv_livestemc_storage_to_litter + hrv_livestemc_to_litter => pc13f%hrv_livestemc_to_litter + hrv_livestemc_xfer_to_litter => pc13f%hrv_livestemc_xfer_to_litter + hrv_xsmrpool_to_atm => pc13f%hrv_xsmrpool_to_atm + deadcrootc => pc13s%deadcrootc + deadcrootc_storage => pc13s%deadcrootc_storage + deadcrootc_xfer => pc13s%deadcrootc_xfer + deadstemc => pc13s%deadstemc + deadstemc_storage => pc13s%deadstemc_storage + deadstemc_xfer => pc13s%deadstemc_xfer + frootc => pc13s%frootc + frootc_storage => pc13s%frootc_storage + frootc_xfer => pc13s%frootc_xfer + gresp_storage => pc13s%gresp_storage + gresp_xfer => pc13s%gresp_xfer + leafc => pc13s%leafc + leafc_storage => pc13s%leafc_storage + leafc_xfer => pc13s%leafc_xfer + livecrootc => pc13s%livecrootc + livecrootc_storage => pc13s%livecrootc_storage + livecrootc_xfer => pc13s%livecrootc_xfer + livestemc => pc13s%livestemc + livestemc_storage => pc13s%livestemc_storage + livestemc_xfer => pc13s%livestemc_xfer + xsmrpool => pc13s%xsmrpool + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from harvest mortality + + ! leaf to litter + litr1c(c) = litr1c(c) + hrv_leafc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + hrv_leafc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + hrv_leafc_to_litr3c(c) * dt + + ! fine root to litter + litr1c(c) = litr1c(c) + hrv_frootc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + hrv_frootc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + hrv_frootc_to_litr3c(c) * dt + + ! wood to CWD + cwdc(c) = cwdc(c) + hrv_livestemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + hrv_livecrootc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + hrv_deadcrootc_to_cwdc(c) * dt + + ! wood to product pools - states updated in CNWoodProducts() + + ! storage pools to litter + litr1c(c) = litr1c(c) + hrv_leafc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_frootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livestemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadstemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livecrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadcrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_gresp_storage_to_litr1c(c) * dt + + ! transfer pools to litter + litr1c(c) = litr1c(c) + hrv_leafc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_frootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livestemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadstemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livecrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadcrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_gresp_xfer_to_litr1c(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from harvest mortality + ! displayed pools + leafc(p) = leafc(p) - hrv_leafc_to_litter(p) * dt + frootc(p) = frootc(p) - hrv_frootc_to_litter(p) * dt + livestemc(p) = livestemc(p) - hrv_livestemc_to_litter(p) * dt + deadstemc(p) = deadstemc(p) - hrv_deadstemc_to_prod10c(p) * dt + deadstemc(p) = deadstemc(p) - hrv_deadstemc_to_prod100c(p) * dt + livecrootc(p) = livecrootc(p) - hrv_livecrootc_to_litter(p) * dt + deadcrootc(p) = deadcrootc(p) - hrv_deadcrootc_to_litter(p) * dt + + ! xsmrpool + xsmrpool(p) = xsmrpool(p) - hrv_xsmrpool_to_atm(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - hrv_leafc_storage_to_litter(p) * dt + frootc_storage(p) = frootc_storage(p) - hrv_frootc_storage_to_litter(p) * dt + livestemc_storage(p) = livestemc_storage(p) - hrv_livestemc_storage_to_litter(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - hrv_deadstemc_storage_to_litter(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - hrv_livecrootc_storage_to_litter(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - hrv_deadcrootc_storage_to_litter(p) * dt + gresp_storage(p) = gresp_storage(p) - hrv_gresp_storage_to_litter(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - hrv_leafc_xfer_to_litter(p) * dt + frootc_xfer(p) = frootc_xfer(p) - hrv_frootc_xfer_to_litter(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - hrv_livestemc_xfer_to_litter(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - hrv_deadstemc_xfer_to_litter(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - hrv_livecrootc_xfer_to_litter(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - hrv_deadcrootc_xfer_to_litter(p) * dt + gresp_xfer(p) = gresp_xfer(p) - hrv_gresp_xfer_to_litter(p) * dt + + end do ! end of pft loop + +end subroutine C13StateUpdate2h +!----------------------------------------------------------------------- + +end module CNC13StateUpdate2Mod diff --git a/components/clm/src_clm40/biogeochem/CNC13StateUpdate3Mod.F90 b/components/clm/src_clm40/biogeochem/CNC13StateUpdate3Mod.F90 new file mode 100644 index 0000000000..da8cc85a0d --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNC13StateUpdate3Mod.F90 @@ -0,0 +1,244 @@ +module CNC13StateUpdate3Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: C13StateUpdate3Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: C13StateUpdate3 +! +! !REVISION HISTORY: +! 4/21/2005: Created by Peter Thornton and Neil Suits - copied from +! CNCStateUpdate3 for C13 state variables. +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: C13StateUpdate3 +! +! !INTERFACE: +subroutine C13StateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables affected by fire fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use clm_varctl, only : use_c13 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: m_cwdc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:) + real(r8), pointer :: m_deadstemc_to_cwdc_fire(:) + real(r8), pointer :: m_litr1c_to_fire(:) + real(r8), pointer :: m_litr2c_to_fire(:) + real(r8), pointer :: m_litr3c_to_fire(:) + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) + real(r8), pointer :: m_deadstemc_to_fire(:) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) + real(r8), pointer :: m_frootc_storage_to_fire(:) + real(r8), pointer :: m_frootc_to_fire(:) + real(r8), pointer :: m_frootc_xfer_to_fire(:) + real(r8), pointer :: m_gresp_storage_to_fire(:) + real(r8), pointer :: m_gresp_xfer_to_fire(:) + real(r8), pointer :: m_leafc_storage_to_fire(:) + real(r8), pointer :: m_leafc_to_fire(:) + real(r8), pointer :: m_leafc_xfer_to_fire(:) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) + real(r8), pointer :: m_livecrootc_to_fire(:) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) + real(r8), pointer :: m_livestemc_storage_to_fire(:) + real(r8), pointer :: m_livestemc_to_fire(:) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer +! +! local pointers to implicit out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + + if (.not. use_c13) then + RETURN + end if + + ! assign local pointers at the column level + m_cwdc_to_fire => cc13f%m_cwdc_to_fire + m_deadcrootc_to_cwdc_fire => cc13f%m_deadcrootc_to_cwdc_fire + m_deadstemc_to_cwdc_fire => cc13f%m_deadstemc_to_cwdc_fire + m_litr1c_to_fire => cc13f%m_litr1c_to_fire + m_litr2c_to_fire => cc13f%m_litr2c_to_fire + m_litr3c_to_fire => cc13f%m_litr3c_to_fire + cwdc => cc13s%cwdc + litr1c => cc13s%litr1c + litr2c => cc13s%litr2c + litr3c => cc13s%litr3c + + ! assign local pointers at the column level + m_deadcrootc_storage_to_fire => pc13f%m_deadcrootc_storage_to_fire + m_deadcrootc_to_fire => pc13f%m_deadcrootc_to_fire + m_deadcrootc_to_litter_fire => pc13f%m_deadcrootc_to_litter_fire + m_deadcrootc_xfer_to_fire => pc13f%m_deadcrootc_xfer_to_fire + m_deadstemc_storage_to_fire => pc13f%m_deadstemc_storage_to_fire + m_deadstemc_to_fire => pc13f%m_deadstemc_to_fire + m_deadstemc_to_litter_fire => pc13f%m_deadstemc_to_litter_fire + m_deadstemc_xfer_to_fire => pc13f%m_deadstemc_xfer_to_fire + m_frootc_storage_to_fire => pc13f%m_frootc_storage_to_fire + m_frootc_to_fire => pc13f%m_frootc_to_fire + m_frootc_xfer_to_fire => pc13f%m_frootc_xfer_to_fire + m_gresp_storage_to_fire => pc13f%m_gresp_storage_to_fire + m_gresp_xfer_to_fire => pc13f%m_gresp_xfer_to_fire + m_leafc_storage_to_fire => pc13f%m_leafc_storage_to_fire + m_leafc_to_fire => pc13f%m_leafc_to_fire + m_leafc_xfer_to_fire => pc13f%m_leafc_xfer_to_fire + m_livecrootc_storage_to_fire => pc13f%m_livecrootc_storage_to_fire + m_livecrootc_to_fire => pc13f%m_livecrootc_to_fire + m_livecrootc_xfer_to_fire => pc13f%m_livecrootc_xfer_to_fire + m_livestemc_storage_to_fire => pc13f%m_livestemc_storage_to_fire + m_livestemc_to_fire => pc13f%m_livestemc_to_fire + m_livestemc_xfer_to_fire => pc13f%m_livestemc_xfer_to_fire + deadcrootc => pc13s%deadcrootc + deadcrootc_storage => pc13s%deadcrootc_storage + deadcrootc_xfer => pc13s%deadcrootc_xfer + deadstemc => pc13s%deadstemc + deadstemc_storage => pc13s%deadstemc_storage + deadstemc_xfer => pc13s%deadstemc_xfer + frootc => pc13s%frootc + frootc_storage => pc13s%frootc_storage + frootc_xfer => pc13s%frootc_xfer + gresp_storage => pc13s%gresp_storage + gresp_xfer => pc13s%gresp_xfer + leafc => pc13s%leafc + leafc_storage => pc13s%leafc_storage + leafc_xfer => pc13s%leafc_xfer + livecrootc => pc13s%livecrootc + livecrootc_storage => pc13s%livecrootc_storage + livecrootc_xfer => pc13s%livecrootc_xfer + livestemc => pc13s%livestemc + livestemc_storage => pc13s%livestemc_storage + livestemc_xfer => pc13s%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from fire + + ! pft-level wood to column-level CWD (uncombusted wood) + cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc_fire(c) * dt + cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc_fire(c) * dt + + ! litter and CWD losses to fire + litr1c(c) = litr1c(c) - m_litr1c_to_fire(c) * dt + litr2c(c) = litr2c(c) - m_litr2c_to_fire(c) * dt + litr3c(c) = litr3c(c) - m_litr3c_to_fire(c) * dt + cwdc(c) = cwdc(c) - m_cwdc_to_fire(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from fire + ! displayed pools + leafc(p) = leafc(p) - m_leafc_to_fire(p) * dt + frootc(p) = frootc(p) - m_frootc_to_fire(p) * dt + livestemc(p) = livestemc(p) - m_livestemc_to_fire(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_fire(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_litter_fire(p) * dt + livecrootc(p) = livecrootc(p) - m_livecrootc_to_fire(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_fire(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_litter_fire(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - m_leafc_storage_to_fire(p) * dt + frootc_storage(p) = frootc_storage(p) - m_frootc_storage_to_fire(p) * dt + livestemc_storage(p) = livestemc_storage(p) - m_livestemc_storage_to_fire(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - m_deadstemc_storage_to_fire(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - m_livecrootc_storage_to_fire(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - m_deadcrootc_storage_to_fire(p) * dt + gresp_storage(p) = gresp_storage(p) - m_gresp_storage_to_fire(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - m_leafc_xfer_to_fire(p) * dt + frootc_xfer(p) = frootc_xfer(p) - m_frootc_xfer_to_fire(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - m_livestemc_xfer_to_fire(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - m_deadstemc_xfer_to_fire(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - m_livecrootc_xfer_to_fire(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - m_deadcrootc_xfer_to_fire(p) * dt + gresp_xfer(p) = gresp_xfer(p) - m_gresp_xfer_to_fire(p) * dt + + end do ! end of pft loop + +end subroutine C13StateUpdate3 +!----------------------------------------------------------------------- + +end module CNC13StateUpdate3Mod diff --git a/components/clm/src_clm40/biogeochem/CNCStateUpdate1Mod.F90 b/components/clm/src_clm40/biogeochem/CNCStateUpdate1Mod.F90 new file mode 100644 index 0000000000..881397d3ad --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNCStateUpdate1Mod.F90 @@ -0,0 +1,688 @@ +module CNCStateUpdate1Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CStateUpdate1Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, non-mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! +! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate1 + public:: CStateUpdate0 +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CStateUpdate0 +! +! !INTERFACE: +subroutine CStateUpdate0(num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update cpool carbon state +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 7/1/05: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: psnshade_to_cpool(:) + real(r8), pointer :: psnsun_to_cpool(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the pft level + cpool => pcs%cpool + psnshade_to_cpool => pcf%psnshade_to_cpool + psnsun_to_cpool => pcf%psnsun_to_cpool + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + ! gross photosynthesis fluxes + cpool(p) = cpool(p) + psnsun_to_cpool(p)*dt + cpool(p) = cpool(p) + psnshade_to_cpool(p)*dt + end do + +end subroutine CStateUpdate0 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CStateUpdate1 +! +! !INTERFACE: +subroutine CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables (except for gap-phase mortality and fire fluxes) +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use pftvarcon , only: npcropmin, nc3crop + use surfrdMod , only: crop_prog +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! 12/5/03, Peter Thornton: Added livewood turnover fluxes +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays +! + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: cwdc_to_litr2c(:) ! decomp. of coarse woody debris C to litter 2 C (gC/m2/s) + real(r8), pointer :: cwdc_to_litr3c(:) ! decomp. of coarse woody debris C to litter 3 C (gC/m2/s) + integer , pointer :: harvdate(:) ! harvest date + real(r8), pointer :: xsmrpool_to_atm(:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: grainc_to_litr1c(:) ! grain C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr2c(:) ! grain C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr3c(:) ! grain C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr1c(:) ! livestem C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr2c(:) ! livestem C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr3c(:) ! livestem C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr1c(:) ! fine root C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr2c(:) ! fine root C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr3c(:) ! fine root C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr1c(:) ! leaf C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr2c(:) ! leaf C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr3c(:) ! leaf C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: litr1_hr(:) ! het. resp. from litter 1 C (gC/m2/s) + real(r8), pointer :: litr1c_to_soil1c(:) ! decomp. of litter 1 C to SOM 1 C (gC/m2/s) + real(r8), pointer :: litr2_hr(:) ! het. resp. from litter 2 C (gC/m2/s) + real(r8), pointer :: litr2c_to_soil2c(:) ! decomp. of litter 2 C to SOM 2 C (gC/m2/s) + real(r8), pointer :: litr3_hr(:) ! het. resp. from litter 3 C (gC/m2/s) + real(r8), pointer :: litr3c_to_soil3c(:) ! decomp. of litter 3 C to SOM 3 C (gC/m2/s) + real(r8), pointer :: soil1_hr(:) ! het. resp. from SOM 1 C (gC/m2/s) + real(r8), pointer :: soil1c_to_soil2c(:) ! decomp. of SOM 1 C to SOM 2 C (gC/m2/s) + real(r8), pointer :: soil2_hr(:) ! het. resp. from SOM 2 C (gC/m2/s) + real(r8), pointer :: soil2c_to_soil3c(:) ! decomp. of SOM 2 C to SOM 3 C (gC/m2/s) + real(r8), pointer :: soil3_hr(:) ! het. resp. from SOM 3 C (gC/m2/s) + real(r8), pointer :: soil3c_to_soil4c(:) ! decomp. of SOM 3 C to SOM 4 C (gC/m2/s) + real(r8), pointer :: soil4_hr(:) ! het. resp. from SOM 4 C (gC/m2/s) + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: cpool_to_xsmrpool(:) + real(r8), pointer :: cpool_to_deadcrootc(:) + real(r8), pointer :: cpool_to_deadcrootc_storage(:) + real(r8), pointer :: cpool_to_deadstemc(:) + real(r8), pointer :: cpool_to_deadstemc_storage(:) + real(r8), pointer :: cpool_to_frootc(:) + real(r8), pointer :: cpool_to_frootc_storage(:) + real(r8), pointer :: cpool_to_gresp_storage(:) + real(r8), pointer :: cpool_to_leafc(:) + real(r8), pointer :: cpool_to_leafc_storage(:) + real(r8), pointer :: cpool_to_livecrootc(:) + real(r8), pointer :: cpool_to_livecrootc_storage(:) + real(r8), pointer :: cpool_to_livestemc(:) + real(r8), pointer :: cpool_to_livestemc_storage(:) + real(r8), pointer :: deadcrootc_storage_to_xfer(:) + real(r8), pointer :: deadstemc_storage_to_xfer(:) + real(r8), pointer :: frootc_storage_to_xfer(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: gresp_storage_to_xfer(:) + real(r8), pointer :: leafc_storage_to_xfer(:) + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: livecrootc_storage_to_xfer(:) + real(r8), pointer :: livecrootc_to_deadcrootc(:) + real(r8), pointer :: livestemc_storage_to_xfer(:) + real(r8), pointer :: livestemc_to_deadstemc(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: livecroot_mr(:) + real(r8), pointer :: livestem_curmr(:) + real(r8), pointer :: froot_curmr(:) + real(r8), pointer :: leaf_curmr(:) + real(r8), pointer :: livecroot_curmr(:) + real(r8), pointer :: livestem_xsmr(:) + real(r8), pointer :: froot_xsmr(:) + real(r8), pointer :: leaf_xsmr(:) + real(r8), pointer :: livecroot_xsmr(:) + real(r8), pointer :: cpool_deadcroot_gr(:) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) + real(r8), pointer :: cpool_deadstem_gr(:) + real(r8), pointer :: cpool_deadstem_storage_gr(:) + real(r8), pointer :: cpool_froot_gr(:) + real(r8), pointer :: cpool_froot_storage_gr(:) + real(r8), pointer :: cpool_leaf_gr(:) + real(r8), pointer :: cpool_leaf_storage_gr(:) + real(r8), pointer :: cpool_livecroot_gr(:) + real(r8), pointer :: cpool_livecroot_storage_gr(:) + real(r8), pointer :: cpool_livestem_gr(:) ! live stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livestem_storage_gr(:) ! live stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadcroot_gr(:) ! dead coarse root growth respiration from storage (gC/m2/s) + real(r8), pointer :: transfer_deadstem_gr(:) ! dead stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: transfer_froot_gr(:) ! fine root growth respiration from storage (gC/m2/s) + real(r8), pointer :: transfer_leaf_gr(:) ! leaf growth respiration from storage (gC/m2/s) + real(r8), pointer :: transfer_livecroot_gr(:) ! live coarse root growth respiration from storage (gC/m2/s) + real(r8), pointer :: transfer_livestem_gr(:) ! live stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C (gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage(:) ! allocation to grain C storage (gC/m2/s) + real(r8), pointer :: grainc_storage_to_xfer(:) ! grain C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livestemc_to_litter(:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food(:) ! grain C to food (gC/m2/s) + real(r8), pointer :: grainc_xfer_to_grainc(:) ! grain C growth from storage (gC/m2/s) + real(r8), pointer :: cpool_grain_gr(:) ! grain growth respiration (gC/m2/s) + real(r8), pointer :: cpool_grain_storage_gr(:) ! grain growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_grain_gr(:) ! grain growth respiration from storage (gC/m2/s) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: grainc(:) ! grain C:N (gC/gN) + real(r8), pointer :: grainc_storage(:) ! (gC/m2) grain C storage + real(r8), pointer :: grainc_xfer(:) ! (gC/m2) grain C transfer + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) execss maint resp C pool + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + +! local pointers for dynamic landcover fluxes and states + real(r8), pointer :: dwt_seedc_to_leaf(:) + real(r8), pointer :: dwt_seedc_to_deadstem(:) + real(r8), pointer :: dwt_frootc_to_litr1c(:) + real(r8), pointer :: dwt_frootc_to_litr2c(:) + real(r8), pointer :: dwt_frootc_to_litr3c(:) + real(r8), pointer :: dwt_livecrootc_to_cwdc(:) + real(r8), pointer :: dwt_deadcrootc_to_cwdc(:) + real(r8), pointer :: seedc(:) + +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers + woody => pftcon%woody + + ! assign local pointers at the column level + cwdc_to_litr2c => ccf%cwdc_to_litr2c + cwdc_to_litr3c => ccf%cwdc_to_litr3c + frootc_to_litr1c => ccf%frootc_to_litr1c + frootc_to_litr2c => ccf%frootc_to_litr2c + frootc_to_litr3c => ccf%frootc_to_litr3c + leafc_to_litr1c => ccf%leafc_to_litr1c + leafc_to_litr2c => ccf%leafc_to_litr2c + leafc_to_litr3c => ccf%leafc_to_litr3c + grainc_to_litr1c => ccf%grainc_to_litr1c + grainc_to_litr2c => ccf%grainc_to_litr2c + grainc_to_litr3c => ccf%grainc_to_litr3c + livestemc_to_litr1c => ccf%livestemc_to_litr1c + livestemc_to_litr2c => ccf%livestemc_to_litr2c + livestemc_to_litr3c => ccf%livestemc_to_litr3c + litr1_hr => ccf%litr1_hr + litr1c_to_soil1c => ccf%litr1c_to_soil1c + litr2_hr => ccf%litr2_hr + litr2c_to_soil2c => ccf%litr2c_to_soil2c + litr3_hr => ccf%litr3_hr + litr3c_to_soil3c => ccf%litr3c_to_soil3c + soil1_hr => ccf%soil1_hr + soil1c_to_soil2c => ccf%soil1c_to_soil2c + soil2_hr => ccf%soil2_hr + soil2c_to_soil3c => ccf%soil2c_to_soil3c + soil3_hr => ccf%soil3_hr + soil3c_to_soil4c => ccf%soil3c_to_soil4c + soil4_hr => ccf%soil4_hr + col_ctrunc => ccs%col_ctrunc + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + soil1c => ccs%soil1c + soil2c => ccs%soil2c + soil3c => ccs%soil3c + soil4c => ccs%soil4c + ! new pointers for dynamic landcover + dwt_seedc_to_leaf => ccf%dwt_seedc_to_leaf + dwt_seedc_to_deadstem => ccf%dwt_seedc_to_deadstem + dwt_frootc_to_litr1c => ccf%dwt_frootc_to_litr1c + dwt_frootc_to_litr2c => ccf%dwt_frootc_to_litr2c + dwt_frootc_to_litr3c => ccf%dwt_frootc_to_litr3c + dwt_livecrootc_to_cwdc => ccf%dwt_livecrootc_to_cwdc + dwt_deadcrootc_to_cwdc => ccf%dwt_deadcrootc_to_cwdc + seedc => ccs%seedc + + ! assign local pointers at the pft level + ivt => pft%itype + cpool_deadcroot_gr => pcf%cpool_deadcroot_gr + cpool_deadcroot_storage_gr => pcf%cpool_deadcroot_storage_gr + cpool_deadstem_gr => pcf%cpool_deadstem_gr + cpool_deadstem_storage_gr => pcf%cpool_deadstem_storage_gr + cpool_froot_gr => pcf%cpool_froot_gr + cpool_froot_storage_gr => pcf%cpool_froot_storage_gr + cpool_leaf_gr => pcf%cpool_leaf_gr + cpool_leaf_storage_gr => pcf%cpool_leaf_storage_gr + cpool_livecroot_gr => pcf%cpool_livecroot_gr + cpool_livecroot_storage_gr => pcf%cpool_livecroot_storage_gr + cpool_livestem_gr => pcf%cpool_livestem_gr + cpool_livestem_storage_gr => pcf%cpool_livestem_storage_gr + cpool_to_xsmrpool => pcf%cpool_to_xsmrpool + cpool_to_deadcrootc => pcf%cpool_to_deadcrootc + cpool_to_deadcrootc_storage => pcf%cpool_to_deadcrootc_storage + cpool_to_deadstemc => pcf%cpool_to_deadstemc + cpool_to_deadstemc_storage => pcf%cpool_to_deadstemc_storage + cpool_to_frootc => pcf%cpool_to_frootc + cpool_to_frootc_storage => pcf%cpool_to_frootc_storage + cpool_to_gresp_storage => pcf%cpool_to_gresp_storage + cpool_to_leafc => pcf%cpool_to_leafc + cpool_to_leafc_storage => pcf%cpool_to_leafc_storage + cpool_to_livecrootc => pcf%cpool_to_livecrootc + cpool_to_livecrootc_storage => pcf%cpool_to_livecrootc_storage + cpool_to_livestemc => pcf%cpool_to_livestemc + cpool_to_livestemc_storage => pcf%cpool_to_livestemc_storage + deadcrootc_storage_to_xfer => pcf%deadcrootc_storage_to_xfer + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + deadstemc_storage_to_xfer => pcf%deadstemc_storage_to_xfer + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + froot_mr => pcf%froot_mr + froot_curmr => pcf%froot_curmr + froot_xsmr => pcf%froot_xsmr + frootc_storage_to_xfer => pcf%frootc_storage_to_xfer + frootc_to_litter => pcf%frootc_to_litter + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + gresp_storage_to_xfer => pcf%gresp_storage_to_xfer + leaf_mr => pcf%leaf_mr + leaf_curmr => pcf%leaf_curmr + leaf_xsmr => pcf%leaf_xsmr + leafc_storage_to_xfer => pcf%leafc_storage_to_xfer + leafc_to_litter => pcf%leafc_to_litter + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + livecroot_mr => pcf%livecroot_mr + livecroot_curmr => pcf%livecroot_curmr + livecroot_xsmr => pcf%livecroot_xsmr + livecrootc_storage_to_xfer => pcf%livecrootc_storage_to_xfer + livecrootc_to_deadcrootc => pcf%livecrootc_to_deadcrootc + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + livestem_mr => pcf%livestem_mr + livestem_curmr => pcf%livestem_curmr + livestem_xsmr => pcf%livestem_xsmr + livestemc_storage_to_xfer => pcf%livestemc_storage_to_xfer + livestemc_to_deadstemc => pcf%livestemc_to_deadstemc + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + transfer_deadcroot_gr => pcf%transfer_deadcroot_gr + transfer_deadstem_gr => pcf%transfer_deadstem_gr + transfer_froot_gr => pcf%transfer_froot_gr + transfer_leaf_gr => pcf%transfer_leaf_gr + transfer_livecroot_gr => pcf%transfer_livecroot_gr + transfer_livestem_gr => pcf%transfer_livestem_gr + harvdate => pps%harvdate + xsmrpool_to_atm => pcf%xsmrpool_to_atm + cpool_grain_gr => pcf%cpool_grain_gr + cpool_grain_storage_gr => pcf%cpool_grain_storage_gr + cpool_to_grainc => pcf%cpool_to_grainc + cpool_to_grainc_storage => pcf%cpool_to_grainc_storage + livestemc_to_litter => pcf%livestemc_to_litter + grainc_storage_to_xfer => pcf%grainc_storage_to_xfer + grainc_to_food => pcf%grainc_to_food + grainc_xfer_to_grainc => pcf%grainc_xfer_to_grainc + transfer_grain_gr => pcf%transfer_grain_gr + grainc => pcs%grainc + grainc_storage => pcs%grainc_storage + grainc_xfer => pcs%grainc_xfer + cpool => pcs%cpool + xsmrpool => pcs%xsmrpool + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level fluxes + + ! plant to litter fluxes + ! leaf litter + litr1c(c) = litr1c(c) + leafc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + leafc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + leafc_to_litr3c(c)*dt + ! fine root litter + litr1c(c) = litr1c(c) + frootc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + frootc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + frootc_to_litr3c(c)*dt + if ( crop_prog )then + ! livestem litter + litr1c(c) = litr1c(c) + livestemc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + livestemc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + livestemc_to_litr3c(c)*dt + ! grain litter + litr1c(c) = litr1c(c) + grainc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + grainc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + grainc_to_litr3c(c)*dt + end if + + ! seeding fluxes, from dynamic landcover + seedc(c) = seedc(c) - dwt_seedc_to_leaf(c) * dt + seedc(c) = seedc(c) - dwt_seedc_to_deadstem(c) * dt + + ! fluxes into litter and CWD, from dynamic landcover + litr1c(c) = litr1c(c) + dwt_frootc_to_litr1c(c)*dt + litr2c(c) = litr2c(c) + dwt_frootc_to_litr2c(c)*dt + litr3c(c) = litr3c(c) + dwt_frootc_to_litr3c(c)*dt + cwdc(c) = cwdc(c) + dwt_livecrootc_to_cwdc(c)*dt + cwdc(c) = cwdc(c) + dwt_deadcrootc_to_cwdc(c)*dt + + ! litter and SOM HR fluxes + litr1c(c) = litr1c(c) - litr1_hr(c)*dt + litr2c(c) = litr2c(c) - litr2_hr(c)*dt + litr3c(c) = litr3c(c) - litr3_hr(c)*dt + soil1c(c) = soil1c(c) - soil1_hr(c)*dt + soil2c(c) = soil2c(c) - soil2_hr(c)*dt + soil3c(c) = soil3c(c) - soil3_hr(c)*dt + soil4c(c) = soil4c(c) - soil4_hr(c)*dt + + ! CWD to litter fluxes + cwdc(c) = cwdc(c) - cwdc_to_litr2c(c)*dt + litr2c(c) = litr2c(c) + cwdc_to_litr2c(c)*dt + cwdc(c) = cwdc(c) - cwdc_to_litr3c(c)*dt + litr3c(c) = litr3c(c) + cwdc_to_litr3c(c)*dt + + ! litter to SOM fluxes + litr1c(c) = litr1c(c) - litr1c_to_soil1c(c)*dt + soil1c(c) = soil1c(c) + litr1c_to_soil1c(c)*dt + litr2c(c) = litr2c(c) - litr2c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) + litr2c_to_soil2c(c)*dt + litr3c(c) = litr3c(c) - litr3c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) + litr3c_to_soil3c(c)*dt + + ! SOM to SOM fluxes + soil1c(c) = soil1c(c) - soil1c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) + soil1c_to_soil2c(c)*dt + soil2c(c) = soil2c(c) - soil2c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) + soil2c_to_soil3c(c)*dt + soil3c(c) = soil3c(c) - soil3c_to_soil4c(c)*dt + soil4c(c) = soil4c(c) + soil3c_to_soil4c(c)*dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + leafc(p) = leafc(p) + leafc_xfer_to_leafc(p)*dt + leafc_xfer(p) = leafc_xfer(p) - leafc_xfer_to_leafc(p)*dt + frootc(p) = frootc(p) + frootc_xfer_to_frootc(p)*dt + frootc_xfer(p) = frootc_xfer(p) - frootc_xfer_to_frootc(p)*dt + if (woody(ivt(p)) == 1._r8) then + livestemc(p) = livestemc(p) + livestemc_xfer_to_livestemc(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) - livestemc_xfer_to_livestemc(p)*dt + deadstemc(p) = deadstemc(p) + deadstemc_xfer_to_deadstemc(p)*dt + deadstemc_xfer(p) = deadstemc_xfer(p) - deadstemc_xfer_to_deadstemc(p)*dt + livecrootc(p) = livecrootc(p) + livecrootc_xfer_to_livecrootc(p)*dt + livecrootc_xfer(p) = livecrootc_xfer(p) - livecrootc_xfer_to_livecrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + deadcrootc_xfer_to_deadcrootc(p)*dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - deadcrootc_xfer_to_deadcrootc(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + livestemc(p) = livestemc(p) + livestemc_xfer_to_livestemc(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) - livestemc_xfer_to_livestemc(p)*dt + grainc(p) = grainc(p) + grainc_xfer_to_grainc(p)*dt + grainc_xfer(p) = grainc_xfer(p) - grainc_xfer_to_grainc(p)*dt + end if + + ! phenology: litterfall fluxes + leafc(p) = leafc(p) - leafc_to_litter(p)*dt + frootc(p) = frootc(p) - frootc_to_litter(p)*dt + + ! livewood turnover fluxes + if (woody(ivt(p)) == 1._r8) then + livestemc(p) = livestemc(p) - livestemc_to_deadstemc(p)*dt + deadstemc(p) = deadstemc(p) + livestemc_to_deadstemc(p)*dt + livecrootc(p) = livecrootc(p) - livecrootc_to_deadcrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + livecrootc_to_deadcrootc(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + livestemc(p) = livestemc(p) - livestemc_to_litter(p)*dt + grainc(p) = grainc(p) - grainc_to_food(p)*dt + end if + + ! maintenance respiration fluxes from cpool + cpool(p) = cpool(p) - cpool_to_xsmrpool(p)*dt + cpool(p) = cpool(p) - leaf_curmr(p)*dt + cpool(p) = cpool(p) - froot_curmr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - livestem_curmr(p)*dt + cpool(p) = cpool(p) - livecroot_curmr(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool(p) = cpool(p) - livestem_curmr(p)*dt + end if + + ! maintenance respiration fluxes from xsmrpool + xsmrpool(p) = xsmrpool(p) + cpool_to_xsmrpool(p)*dt + xsmrpool(p) = xsmrpool(p) - leaf_xsmr(p)*dt + xsmrpool(p) = xsmrpool(p) - froot_xsmr(p)*dt + if (woody(ivt(p)) == 1._r8) then + xsmrpool(p) = xsmrpool(p) - livestem_xsmr(p)*dt + xsmrpool(p) = xsmrpool(p) - livecroot_xsmr(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + xsmrpool(p) = xsmrpool(p) - livestem_xsmr(p)*dt + if (harvdate(p) < 999) then ! beginning at harvest, send to atm + xsmrpool_to_atm(p) = xsmrpool_to_atm(p) + xsmrpool(p)/dt + xsmrpool(p) = xsmrpool(p) - xsmrpool_to_atm(p)*dt + end if + end if + + ! allocation fluxes + cpool(p) = cpool(p) - cpool_to_leafc(p)*dt + leafc(p) = leafc(p) + cpool_to_leafc(p)*dt + cpool(p) = cpool(p) - cpool_to_leafc_storage(p)*dt + leafc_storage(p) = leafc_storage(p) + cpool_to_leafc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_frootc(p)*dt + frootc(p) = frootc(p) + cpool_to_frootc(p)*dt + cpool(p) = cpool(p) - cpool_to_frootc_storage(p)*dt + frootc_storage(p) = frootc_storage(p) + cpool_to_frootc_storage(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_to_livestemc(p)*dt + livestemc(p) = livestemc(p) + cpool_to_livestemc(p)*dt + cpool(p) = cpool(p) - cpool_to_livestemc_storage(p)*dt + livestemc_storage(p) = livestemc_storage(p) + cpool_to_livestemc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_deadstemc(p)*dt + deadstemc(p) = deadstemc(p) + cpool_to_deadstemc(p)*dt + cpool(p) = cpool(p) - cpool_to_deadstemc_storage(p)*dt + deadstemc_storage(p) = deadstemc_storage(p) + cpool_to_deadstemc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_livecrootc(p)*dt + livecrootc(p) = livecrootc(p) + cpool_to_livecrootc(p)*dt + cpool(p) = cpool(p) - cpool_to_livecrootc_storage(p)*dt + livecrootc_storage(p) = livecrootc_storage(p) + cpool_to_livecrootc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_deadcrootc(p)*dt + deadcrootc(p) = deadcrootc(p) + cpool_to_deadcrootc(p)*dt + cpool(p) = cpool(p) - cpool_to_deadcrootc_storage(p)*dt + deadcrootc_storage(p) = deadcrootc_storage(p) + cpool_to_deadcrootc_storage(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool(p) = cpool(p) - cpool_to_livestemc(p)*dt + livestemc(p) = livestemc(p) + cpool_to_livestemc(p)*dt + cpool(p) = cpool(p) - cpool_to_livestemc_storage(p)*dt + livestemc_storage(p) = livestemc_storage(p) + cpool_to_livestemc_storage(p)*dt + cpool(p) = cpool(p) - cpool_to_grainc(p)*dt + grainc(p) = grainc(p) + cpool_to_grainc(p)*dt + cpool(p) = cpool(p) - cpool_to_grainc_storage(p)*dt + grainc_storage(p) = grainc_storage(p) + cpool_to_grainc_storage(p)*dt + end if + + ! growth respiration fluxes for current growth + cpool(p) = cpool(p) - cpool_leaf_gr(p)*dt + cpool(p) = cpool(p) - cpool_froot_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_livestem_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadstem_gr(p)*dt + cpool(p) = cpool(p) - cpool_livecroot_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadcroot_gr(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool(p) = cpool(p) - cpool_livestem_gr(p)*dt + cpool(p) = cpool(p) - cpool_grain_gr(p)*dt + end if + + ! growth respiration for transfer growth + gresp_xfer(p) = gresp_xfer(p) - transfer_leaf_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_froot_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + gresp_xfer(p) = gresp_xfer(p) - transfer_livestem_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_deadstem_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_livecroot_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_deadcroot_gr(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_xfer(p) = gresp_xfer(p) - transfer_livestem_gr(p)*dt + gresp_xfer(p) = gresp_xfer(p) - transfer_grain_gr(p)*dt + end if + + ! growth respiration at time of storage + cpool(p) = cpool(p) - cpool_leaf_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_froot_storage_gr(p)*dt + if (woody(ivt(p)) == 1._r8) then + cpool(p) = cpool(p) - cpool_livestem_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadstem_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_livecroot_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_deadcroot_storage_gr(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool(p) = cpool(p) - cpool_livestem_storage_gr(p)*dt + cpool(p) = cpool(p) - cpool_grain_storage_gr(p)*dt + end if + + ! growth respiration stored for release during transfer growth + cpool(p) = cpool(p) - cpool_to_gresp_storage(p)*dt + gresp_storage(p) = gresp_storage(p) + cpool_to_gresp_storage(p)*dt + + ! move storage pools into transfer pools + leafc_storage(p) = leafc_storage(p) - leafc_storage_to_xfer(p)*dt + leafc_xfer(p) = leafc_xfer(p) + leafc_storage_to_xfer(p)*dt + frootc_storage(p) = frootc_storage(p) - frootc_storage_to_xfer(p)*dt + frootc_xfer(p) = frootc_xfer(p) + frootc_storage_to_xfer(p)*dt + if (woody(ivt(p)) == 1._r8) then + livestemc_storage(p) = livestemc_storage(p) - livestemc_storage_to_xfer(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) + livestemc_storage_to_xfer(p)*dt + deadstemc_storage(p) = deadstemc_storage(p) - deadstemc_storage_to_xfer(p)*dt + deadstemc_xfer(p) = deadstemc_xfer(p) + deadstemc_storage_to_xfer(p)*dt + livecrootc_storage(p) = livecrootc_storage(p) - livecrootc_storage_to_xfer(p)*dt + livecrootc_xfer(p) = livecrootc_xfer(p) + livecrootc_storage_to_xfer(p)*dt + deadcrootc_storage(p) = deadcrootc_storage(p) - deadcrootc_storage_to_xfer(p)*dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) + deadcrootc_storage_to_xfer(p)*dt + gresp_storage(p) = gresp_storage(p) - gresp_storage_to_xfer(p)*dt + gresp_xfer(p) = gresp_xfer(p) + gresp_storage_to_xfer(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + livestemc_storage(p) = livestemc_storage(p) - livestemc_storage_to_xfer(p)*dt + livestemc_xfer(p) = livestemc_xfer(p) + livestemc_storage_to_xfer(p)*dt + grainc_storage(p) = grainc_storage(p) - grainc_storage_to_xfer(p)*dt + grainc_xfer(p) = grainc_xfer(p) + grainc_storage_to_xfer(p)*dt + end if + + end do ! end of pft loop + +end subroutine CStateUpdate1 +!----------------------------------------------------------------------- + +end module CNCStateUpdate1Mod diff --git a/components/clm/src_clm40/biogeochem/CNCStateUpdate2Mod.F90 b/components/clm/src_clm40/biogeochem/CNCStateUpdate2Mod.F90 new file mode 100644 index 0000000000..93fcb20e20 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNCStateUpdate2Mod.F90 @@ -0,0 +1,569 @@ +module CNCStateUpdate2Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CStateUpdate2Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate2 + public:: CStateUpdate2h +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CStateUpdate2 +! +! !INTERFACE: +subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables affected by gap-phase mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_to_cwdc(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: m_deadstemc_to_cwdc(:) + real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: m_frootc_storage_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr2c(:) + real(r8), pointer :: m_frootc_to_litr3c(:) + real(r8), pointer :: m_frootc_xfer_to_litr1c(:) + real(r8), pointer :: m_gresp_storage_to_litr1c(:) + real(r8), pointer :: m_gresp_xfer_to_litr1c(:) + real(r8), pointer :: m_leafc_storage_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr2c(:) + real(r8), pointer :: m_leafc_to_litr3c(:) + real(r8), pointer :: m_leafc_xfer_to_litr1c(:) + real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: m_livecrootc_to_cwdc(:) + real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_livestemc_storage_to_litr1c(:) + real(r8), pointer :: m_livestemc_to_cwdc(:) + real(r8), pointer :: m_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) !(gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) !(gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer +! +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + m_deadcrootc_storage_to_litr1c => ccf%m_deadcrootc_storage_to_litr1c + m_deadcrootc_to_cwdc => ccf%m_deadcrootc_to_cwdc + m_deadcrootc_xfer_to_litr1c => ccf%m_deadcrootc_xfer_to_litr1c + m_deadstemc_storage_to_litr1c => ccf%m_deadstemc_storage_to_litr1c + m_deadstemc_to_cwdc => ccf%m_deadstemc_to_cwdc + m_deadstemc_xfer_to_litr1c => ccf%m_deadstemc_xfer_to_litr1c + m_frootc_storage_to_litr1c => ccf%m_frootc_storage_to_litr1c + m_frootc_to_litr1c => ccf%m_frootc_to_litr1c + m_frootc_to_litr2c => ccf%m_frootc_to_litr2c + m_frootc_to_litr3c => ccf%m_frootc_to_litr3c + m_frootc_xfer_to_litr1c => ccf%m_frootc_xfer_to_litr1c + m_gresp_storage_to_litr1c => ccf%m_gresp_storage_to_litr1c + m_gresp_xfer_to_litr1c => ccf%m_gresp_xfer_to_litr1c + m_leafc_storage_to_litr1c => ccf%m_leafc_storage_to_litr1c + m_leafc_to_litr1c => ccf%m_leafc_to_litr1c + m_leafc_to_litr2c => ccf%m_leafc_to_litr2c + m_leafc_to_litr3c => ccf%m_leafc_to_litr3c + m_leafc_xfer_to_litr1c => ccf%m_leafc_xfer_to_litr1c + m_livecrootc_storage_to_litr1c => ccf%m_livecrootc_storage_to_litr1c + m_livecrootc_to_cwdc => ccf%m_livecrootc_to_cwdc + m_livecrootc_xfer_to_litr1c => ccf%m_livecrootc_xfer_to_litr1c + m_livestemc_storage_to_litr1c => ccf%m_livestemc_storage_to_litr1c + m_livestemc_to_cwdc => ccf%m_livestemc_to_cwdc + m_livestemc_xfer_to_litr1c => ccf%m_livestemc_xfer_to_litr1c + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + + ! assign local pointers at the pft level + m_deadcrootc_storage_to_litter => pcf%m_deadcrootc_storage_to_litter + m_deadcrootc_to_litter => pcf%m_deadcrootc_to_litter + m_deadcrootc_xfer_to_litter => pcf%m_deadcrootc_xfer_to_litter + m_deadstemc_storage_to_litter => pcf%m_deadstemc_storage_to_litter + m_deadstemc_to_litter => pcf%m_deadstemc_to_litter + m_deadstemc_xfer_to_litter => pcf%m_deadstemc_xfer_to_litter + m_frootc_storage_to_litter => pcf%m_frootc_storage_to_litter + m_frootc_to_litter => pcf%m_frootc_to_litter + m_frootc_xfer_to_litter => pcf%m_frootc_xfer_to_litter + m_gresp_storage_to_litter => pcf%m_gresp_storage_to_litter + m_gresp_xfer_to_litter => pcf%m_gresp_xfer_to_litter + m_leafc_storage_to_litter => pcf%m_leafc_storage_to_litter + m_leafc_to_litter => pcf%m_leafc_to_litter + m_leafc_xfer_to_litter => pcf%m_leafc_xfer_to_litter + m_livecrootc_storage_to_litter => pcf%m_livecrootc_storage_to_litter + m_livecrootc_to_litter => pcf%m_livecrootc_to_litter + m_livecrootc_xfer_to_litter => pcf%m_livecrootc_xfer_to_litter + m_livestemc_storage_to_litter => pcf%m_livestemc_storage_to_litter + m_livestemc_to_litter => pcf%m_livestemc_to_litter + m_livestemc_xfer_to_litter => pcf%m_livestemc_xfer_to_litter + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from gap-phase mortality + + ! leaf to litter + litr1c(c) = litr1c(c) + m_leafc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + m_leafc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + m_leafc_to_litr3c(c) * dt + + ! fine root to litter + litr1c(c) = litr1c(c) + m_frootc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + m_frootc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + m_frootc_to_litr3c(c) * dt + + ! wood to CWD + cwdc(c) = cwdc(c) + m_livestemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_livecrootc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc(c) * dt + + ! storage pools to litter + litr1c(c) = litr1c(c) + m_leafc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_frootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livestemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadstemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livecrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadcrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_gresp_storage_to_litr1c(c) * dt + + ! transfer pools to litter + litr1c(c) = litr1c(c) + m_leafc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_frootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livestemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadstemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_livecrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_deadcrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + m_gresp_xfer_to_litr1c(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from gap-phase mortality + ! displayed pools + leafc(p) = leafc(p) - m_leafc_to_litter(p) * dt + frootc(p) = frootc(p) - m_frootc_to_litter(p) * dt + livestemc(p) = livestemc(p) - m_livestemc_to_litter(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_litter(p) * dt + livecrootc(p) = livecrootc(p) - m_livecrootc_to_litter(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_litter(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - m_leafc_storage_to_litter(p) * dt + frootc_storage(p) = frootc_storage(p) - m_frootc_storage_to_litter(p) * dt + livestemc_storage(p) = livestemc_storage(p) - m_livestemc_storage_to_litter(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - m_deadstemc_storage_to_litter(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - m_livecrootc_storage_to_litter(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - m_deadcrootc_storage_to_litter(p) * dt + gresp_storage(p) = gresp_storage(p) - m_gresp_storage_to_litter(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - m_leafc_xfer_to_litter(p) * dt + frootc_xfer(p) = frootc_xfer(p) - m_frootc_xfer_to_litter(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - m_livestemc_xfer_to_litter(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - m_deadstemc_xfer_to_litter(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - m_livecrootc_xfer_to_litter(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - m_deadcrootc_xfer_to_litter(p) * dt + gresp_xfer(p) = gresp_xfer(p) - m_gresp_xfer_to_litter(p) * dt + + end do ! end of pft loop + +end subroutine CStateUpdate2 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CStateUpdate2h +! +! !INTERFACE: +subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Update all the prognostic carbon state +! variables affected by harvest mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 5/20/09: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_to_cwdc(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_frootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr2c(:) + real(r8), pointer :: hrv_frootc_to_litr3c(:) + real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_gresp_storage_to_litr1c(:) + real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:) + real(r8), pointer :: hrv_leafc_storage_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr2c(:) + real(r8), pointer :: hrv_leafc_to_litr3c(:) + real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_to_cwdc(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_to_cwdc(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: xsmrpool(:) ! (gC/m2) abstract C pool to meet excess MR demand +! +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) +! +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + hrv_deadcrootc_storage_to_litr1c => ccf%hrv_deadcrootc_storage_to_litr1c + hrv_deadcrootc_to_cwdc => ccf%hrv_deadcrootc_to_cwdc + hrv_deadcrootc_xfer_to_litr1c => ccf%hrv_deadcrootc_xfer_to_litr1c + hrv_deadstemc_storage_to_litr1c => ccf%hrv_deadstemc_storage_to_litr1c + hrv_deadstemc_xfer_to_litr1c => ccf%hrv_deadstemc_xfer_to_litr1c + hrv_frootc_storage_to_litr1c => ccf%hrv_frootc_storage_to_litr1c + hrv_frootc_to_litr1c => ccf%hrv_frootc_to_litr1c + hrv_frootc_to_litr2c => ccf%hrv_frootc_to_litr2c + hrv_frootc_to_litr3c => ccf%hrv_frootc_to_litr3c + hrv_frootc_xfer_to_litr1c => ccf%hrv_frootc_xfer_to_litr1c + hrv_gresp_storage_to_litr1c => ccf%hrv_gresp_storage_to_litr1c + hrv_gresp_xfer_to_litr1c => ccf%hrv_gresp_xfer_to_litr1c + hrv_leafc_storage_to_litr1c => ccf%hrv_leafc_storage_to_litr1c + hrv_leafc_to_litr1c => ccf%hrv_leafc_to_litr1c + hrv_leafc_to_litr2c => ccf%hrv_leafc_to_litr2c + hrv_leafc_to_litr3c => ccf%hrv_leafc_to_litr3c + hrv_leafc_xfer_to_litr1c => ccf%hrv_leafc_xfer_to_litr1c + hrv_livecrootc_storage_to_litr1c => ccf%hrv_livecrootc_storage_to_litr1c + hrv_livecrootc_to_cwdc => ccf%hrv_livecrootc_to_cwdc + hrv_livecrootc_xfer_to_litr1c => ccf%hrv_livecrootc_xfer_to_litr1c + hrv_livestemc_storage_to_litr1c => ccf%hrv_livestemc_storage_to_litr1c + hrv_livestemc_to_cwdc => ccf%hrv_livestemc_to_cwdc + hrv_livestemc_xfer_to_litr1c => ccf%hrv_livestemc_xfer_to_litr1c + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + + ! assign local pointers at the pft level + hrv_deadcrootc_storage_to_litter => pcf%hrv_deadcrootc_storage_to_litter + hrv_deadcrootc_to_litter => pcf%hrv_deadcrootc_to_litter + hrv_deadcrootc_xfer_to_litter => pcf%hrv_deadcrootc_xfer_to_litter + hrv_deadstemc_storage_to_litter => pcf%hrv_deadstemc_storage_to_litter + hrv_deadstemc_to_prod10c => pcf%hrv_deadstemc_to_prod10c + hrv_deadstemc_to_prod100c => pcf%hrv_deadstemc_to_prod100c + hrv_deadstemc_xfer_to_litter => pcf%hrv_deadstemc_xfer_to_litter + hrv_frootc_storage_to_litter => pcf%hrv_frootc_storage_to_litter + hrv_frootc_to_litter => pcf%hrv_frootc_to_litter + hrv_frootc_xfer_to_litter => pcf%hrv_frootc_xfer_to_litter + hrv_gresp_storage_to_litter => pcf%hrv_gresp_storage_to_litter + hrv_gresp_xfer_to_litter => pcf%hrv_gresp_xfer_to_litter + hrv_leafc_storage_to_litter => pcf%hrv_leafc_storage_to_litter + hrv_leafc_to_litter => pcf%hrv_leafc_to_litter + hrv_leafc_xfer_to_litter => pcf%hrv_leafc_xfer_to_litter + hrv_livecrootc_storage_to_litter => pcf%hrv_livecrootc_storage_to_litter + hrv_livecrootc_to_litter => pcf%hrv_livecrootc_to_litter + hrv_livecrootc_xfer_to_litter => pcf%hrv_livecrootc_xfer_to_litter + hrv_livestemc_storage_to_litter => pcf%hrv_livestemc_storage_to_litter + hrv_livestemc_to_litter => pcf%hrv_livestemc_to_litter + hrv_livestemc_xfer_to_litter => pcf%hrv_livestemc_xfer_to_litter + hrv_xsmrpool_to_atm => pcf%hrv_xsmrpool_to_atm + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + xsmrpool => pcs%xsmrpool + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from harvest mortality + + ! leaf to litter + litr1c(c) = litr1c(c) + hrv_leafc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + hrv_leafc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + hrv_leafc_to_litr3c(c) * dt + + ! fine root to litter + litr1c(c) = litr1c(c) + hrv_frootc_to_litr1c(c) * dt + litr2c(c) = litr2c(c) + hrv_frootc_to_litr2c(c) * dt + litr3c(c) = litr3c(c) + hrv_frootc_to_litr3c(c) * dt + + ! wood to CWD + cwdc(c) = cwdc(c) + hrv_livestemc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + hrv_livecrootc_to_cwdc(c) * dt + cwdc(c) = cwdc(c) + hrv_deadcrootc_to_cwdc(c) * dt + + ! wood to product pools - states updated in CNWoodProducts() + + ! storage pools to litter + litr1c(c) = litr1c(c) + hrv_leafc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_frootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livestemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadstemc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livecrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadcrootc_storage_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_gresp_storage_to_litr1c(c) * dt + + ! transfer pools to litter + litr1c(c) = litr1c(c) + hrv_leafc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_frootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livestemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadstemc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_livecrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_deadcrootc_xfer_to_litr1c(c) * dt + litr1c(c) = litr1c(c) + hrv_gresp_xfer_to_litr1c(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from harvest mortality + ! displayed pools + leafc(p) = leafc(p) - hrv_leafc_to_litter(p) * dt + frootc(p) = frootc(p) - hrv_frootc_to_litter(p) * dt + livestemc(p) = livestemc(p) - hrv_livestemc_to_litter(p) * dt + deadstemc(p) = deadstemc(p) - hrv_deadstemc_to_prod10c(p) * dt + deadstemc(p) = deadstemc(p) - hrv_deadstemc_to_prod100c(p) * dt + livecrootc(p) = livecrootc(p) - hrv_livecrootc_to_litter(p) * dt + deadcrootc(p) = deadcrootc(p) - hrv_deadcrootc_to_litter(p) * dt + + ! xsmrpool + xsmrpool(p) = xsmrpool(p) - hrv_xsmrpool_to_atm(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - hrv_leafc_storage_to_litter(p) * dt + frootc_storage(p) = frootc_storage(p) - hrv_frootc_storage_to_litter(p) * dt + livestemc_storage(p) = livestemc_storage(p) - hrv_livestemc_storage_to_litter(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - hrv_deadstemc_storage_to_litter(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - hrv_livecrootc_storage_to_litter(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - hrv_deadcrootc_storage_to_litter(p) * dt + gresp_storage(p) = gresp_storage(p) - hrv_gresp_storage_to_litter(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - hrv_leafc_xfer_to_litter(p) * dt + frootc_xfer(p) = frootc_xfer(p) - hrv_frootc_xfer_to_litter(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - hrv_livestemc_xfer_to_litter(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - hrv_deadstemc_xfer_to_litter(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - hrv_livecrootc_xfer_to_litter(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - hrv_deadcrootc_xfer_to_litter(p) * dt + gresp_xfer(p) = gresp_xfer(p) - hrv_gresp_xfer_to_litter(p) * dt + + end do ! end of pft loop + +end subroutine CStateUpdate2h +!----------------------------------------------------------------------- + +end module CNCStateUpdate2Mod diff --git a/components/clm/src_clm40/biogeochem/CNCStateUpdate3Mod.F90 b/components/clm/src_clm40/biogeochem/CNCStateUpdate3Mod.F90 new file mode 100644 index 0000000000..7499b90f79 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNCStateUpdate3Mod.F90 @@ -0,0 +1,238 @@ +module CNCStateUpdate3Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CStateUpdate3Mod +! +! !DESCRIPTION: +! Module for carbon state variable update, mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CStateUpdate3 +! +! !REVISION HISTORY: +! 7/27/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CStateUpdate3 +! +! !INTERFACE: +subroutine CStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables affected by fire fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays + real(r8), pointer :: m_cwdc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:) + real(r8), pointer :: m_deadstemc_to_cwdc_fire(:) + real(r8), pointer :: m_litr1c_to_fire(:) + real(r8), pointer :: m_litr2c_to_fire(:) + real(r8), pointer :: m_litr3c_to_fire(:) + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) + real(r8), pointer :: m_deadstemc_to_fire(:) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) + real(r8), pointer :: m_frootc_storage_to_fire(:) + real(r8), pointer :: m_frootc_to_fire(:) + real(r8), pointer :: m_frootc_xfer_to_fire(:) + real(r8), pointer :: m_gresp_storage_to_fire(:) + real(r8), pointer :: m_gresp_xfer_to_fire(:) + real(r8), pointer :: m_leafc_storage_to_fire(:) + real(r8), pointer :: m_leafc_to_fire(:) + real(r8), pointer :: m_leafc_xfer_to_fire(:) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) + real(r8), pointer :: m_livecrootc_to_fire(:) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) + real(r8), pointer :: m_livestemc_storage_to_fire(:) + real(r8), pointer :: m_livestemc_to_fire(:) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer +! +! local pointers to implicit out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers at the column level + m_cwdc_to_fire => ccf%m_cwdc_to_fire + m_deadcrootc_to_cwdc_fire => ccf%m_deadcrootc_to_cwdc_fire + m_deadstemc_to_cwdc_fire => ccf%m_deadstemc_to_cwdc_fire + m_litr1c_to_fire => ccf%m_litr1c_to_fire + m_litr2c_to_fire => ccf%m_litr2c_to_fire + m_litr3c_to_fire => ccf%m_litr3c_to_fire + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + + ! assign local pointers at the column level + m_deadcrootc_storage_to_fire => pcf%m_deadcrootc_storage_to_fire + m_deadcrootc_to_fire => pcf%m_deadcrootc_to_fire + m_deadcrootc_to_litter_fire => pcf%m_deadcrootc_to_litter_fire + m_deadcrootc_xfer_to_fire => pcf%m_deadcrootc_xfer_to_fire + m_deadstemc_storage_to_fire => pcf%m_deadstemc_storage_to_fire + m_deadstemc_to_fire => pcf%m_deadstemc_to_fire + m_deadstemc_to_litter_fire => pcf%m_deadstemc_to_litter_fire + m_deadstemc_xfer_to_fire => pcf%m_deadstemc_xfer_to_fire + m_frootc_storage_to_fire => pcf%m_frootc_storage_to_fire + m_frootc_to_fire => pcf%m_frootc_to_fire + m_frootc_xfer_to_fire => pcf%m_frootc_xfer_to_fire + m_gresp_storage_to_fire => pcf%m_gresp_storage_to_fire + m_gresp_xfer_to_fire => pcf%m_gresp_xfer_to_fire + m_leafc_storage_to_fire => pcf%m_leafc_storage_to_fire + m_leafc_to_fire => pcf%m_leafc_to_fire + m_leafc_xfer_to_fire => pcf%m_leafc_xfer_to_fire + m_livecrootc_storage_to_fire => pcf%m_livecrootc_storage_to_fire + m_livecrootc_to_fire => pcf%m_livecrootc_to_fire + m_livecrootc_xfer_to_fire => pcf%m_livecrootc_xfer_to_fire + m_livestemc_storage_to_fire => pcf%m_livestemc_storage_to_fire + m_livestemc_to_fire => pcf%m_livestemc_to_fire + m_livestemc_xfer_to_fire => pcf%m_livestemc_xfer_to_fire + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column level carbon fluxes from fire + + ! pft-level wood to column-level CWD (uncombusted wood) + cwdc(c) = cwdc(c) + m_deadstemc_to_cwdc_fire(c) * dt + cwdc(c) = cwdc(c) + m_deadcrootc_to_cwdc_fire(c) * dt + + ! litter and CWD losses to fire + litr1c(c) = litr1c(c) - m_litr1c_to_fire(c) * dt + litr2c(c) = litr2c(c) - m_litr2c_to_fire(c) * dt + litr3c(c) = litr3c(c) - m_litr3c_to_fire(c) * dt + cwdc(c) = cwdc(c) - m_cwdc_to_fire(c) * dt + + end do ! end of columns loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level carbon fluxes from fire + ! displayed pools + leafc(p) = leafc(p) - m_leafc_to_fire(p) * dt + frootc(p) = frootc(p) - m_frootc_to_fire(p) * dt + livestemc(p) = livestemc(p) - m_livestemc_to_fire(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_fire(p) * dt + deadstemc(p) = deadstemc(p) - m_deadstemc_to_litter_fire(p) * dt + livecrootc(p) = livecrootc(p) - m_livecrootc_to_fire(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_fire(p) * dt + deadcrootc(p) = deadcrootc(p) - m_deadcrootc_to_litter_fire(p) * dt + + ! storage pools + leafc_storage(p) = leafc_storage(p) - m_leafc_storage_to_fire(p) * dt + frootc_storage(p) = frootc_storage(p) - m_frootc_storage_to_fire(p) * dt + livestemc_storage(p) = livestemc_storage(p) - m_livestemc_storage_to_fire(p) * dt + deadstemc_storage(p) = deadstemc_storage(p) - m_deadstemc_storage_to_fire(p) * dt + livecrootc_storage(p) = livecrootc_storage(p) - m_livecrootc_storage_to_fire(p) * dt + deadcrootc_storage(p) = deadcrootc_storage(p) - m_deadcrootc_storage_to_fire(p) * dt + gresp_storage(p) = gresp_storage(p) - m_gresp_storage_to_fire(p) * dt + + ! transfer pools + leafc_xfer(p) = leafc_xfer(p) - m_leafc_xfer_to_fire(p) * dt + frootc_xfer(p) = frootc_xfer(p) - m_frootc_xfer_to_fire(p) * dt + livestemc_xfer(p) = livestemc_xfer(p) - m_livestemc_xfer_to_fire(p) * dt + deadstemc_xfer(p) = deadstemc_xfer(p) - m_deadstemc_xfer_to_fire(p) * dt + livecrootc_xfer(p) = livecrootc_xfer(p) - m_livecrootc_xfer_to_fire(p) * dt + deadcrootc_xfer(p) = deadcrootc_xfer(p) - m_deadcrootc_xfer_to_fire(p) * dt + gresp_xfer(p) = gresp_xfer(p) - m_gresp_xfer_to_fire(p) * dt + + end do ! end of pft loop + +end subroutine CStateUpdate3 +!----------------------------------------------------------------------- + +end module CNCStateUpdate3Mod diff --git a/components/clm/src_clm40/biogeochem/CNDVEcosystemDynIniMod.F90 b/components/clm/src_clm40/biogeochem/CNDVEcosystemDynIniMod.F90 new file mode 100644 index 0000000000..405b43b7ae --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNDVEcosystemDynIniMod.F90 @@ -0,0 +1,93 @@ +module CNDVEcosystemDyniniMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNDVEcosystemDyniniMod +! +! !DESCRIPTION: +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: CNDVEcosystemDynini ! CNDV related initializations +! +! !REVISION HISTORY: +! Created by Sam Levis following DGVMEcosystemDynMod by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNDVEcosystemDynini +! +! !INTERFACE: + subroutine CNDVEcosystemDynini() +! +! !DESCRIPTION: +! CNDV related initializations +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use decompMod , only : get_proc_bounds, get_proc_global + use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Author: Sam Levis (adapted from LPJ initialization subroutines) +! Sam Levis (adapted for CNDV coupling; eliminated redunant parameters) +! +!EOP +! +! !LOCAL VARIABLES: + integer :: g,p,n ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! " column indices + integer :: begl, endl ! " landunit indices + integer :: begg, endg ! " gridcell indices + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + gptr => grc + pptr => pft + + ! --------------------------------------------------------------- + ! Some of the following came from LPJ subroutine initgrid + ! --------------------------------------------------------------- + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + do p = begp,endp + pdgvs%present(p) = .false. + pdgvs%crownarea(p) = 0._r8 + pdgvs%nind(p) = 0._r8 + pcs%leafcmax(p) = 0._r8 + pdgvs%t_mo_min(p) = 1.0e+36_r8 + end do + + do g = begg,endg + gdgvs%agdd20(g) = 0._r8 + gdgvs%tmomin20(g) = SHR_CONST_TKFRZ - 5._r8 !initialize this way for Phenology code + end do + + end subroutine CNDVEcosystemDynini + +end module CNDVEcosystemDyniniMod diff --git a/components/clm/src_clm40/biogeochem/CNDVEstablishmentMod.F90 b/components/clm/src_clm40/biogeochem/CNDVEstablishmentMod.F90 new file mode 100644 index 0000000000..1a445d7ce6 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNDVEstablishmentMod.F90 @@ -0,0 +1,518 @@ +module CNDVEstablishmentMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNDVEstablishmentMod +! +! !DESCRIPTION: +! Calculates establishment of new pfts +! Called once per year +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils , only: endrun +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Establishment +! +! !REVISION HISTORY: +! Module created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Establishment +! +! !INTERFACE: + subroutine Establishment(lbg, ubg, lbp, ubp) +! +! !DESCRIPTION: +! Calculates establishment of new pfts +! Called once per year +! +! !USES: + use clmtype + use clm_varpar , only : numpft + use clm_varcon , only : istsoil + use clm_varctl , only : iulog + use pftvarcon , only : noveg, nc3_arctic_grass + use shr_const_mod, only : SHR_CONST_CDAY, SHR_CONST_PI, SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbg, ubg ! gridcell bounds + integer , intent(in) :: lbp, ubp ! pft bounds +! +! !CALLED FROM: +! subroutine dv in module CNDVMod +! +! !REVISION HISTORY: +! Author: Sam Levis (adapted from Stephen Sitch's LPJ subr. establishment) +! 3/4/02, Peter Thornton: Migrated to new data structures. +! 10/05 , Sam Levis: adapted to work with CN +! 09/07 , Sam Levis: as 10/05 but with current CN +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + logical , pointer :: pftmayexist(:) ! exclude seasonal decid pfts from tropics [1=true, 0=false] + integer , pointer :: plandunit(:) ! landunit of corresponding pft + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: ltype(:) ! landunit type for corresponding pft + real(r8), pointer :: tmomin20(:) ! 20-yr running mean of tmomin + real(r8), pointer :: agdd20(:) ! 20-yr running mean of agdd + real(r8), pointer :: agddtw(:) ! accumulated growing degree days above twmax + real(r8), pointer :: prec365(:) ! 365-day running mean of tot. precipitation + real(r8), pointer :: slatop(:) !specific leaf area at top of canopy, projected area basis [m^2/gC] + real(r8), pointer :: dsladlai(:) !dSLA/dLAI, projected area basis [m^2/gC] + real(r8), pointer :: woody(:) ! ecophys const - woody pft or not + real(r8), pointer :: crownarea_max(:) ! ecophys const - tree maximum crown area [m2] + real(r8), pointer :: twmax(:) ! ecophys const - upper limit of temperature of the warmest month + real(r8), pointer :: reinickerp(:) ! ecophys const - parameter in allometric equation + real(r8), pointer :: dwood(:) ! ecophys const - wood density (gC/m3) + real(r8), pointer :: allom1(:) ! ecophys const - parameter in allometric + real(r8), pointer :: tcmin(:) ! ecophys const - minimum coldest monthly mean temperature + real(r8), pointer :: tcmax(:) ! ecophys const - maximum coldest monthly mean temperature + real(r8), pointer :: gddmin(:) ! ecophys const - minimum growing degree days (at or above 5 C) + real(r8), pointer :: leafcmax(:) ! (gC/m2) ann max leaf C + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: annsum_npp(:) ! annual sum NPP (gC/m2/yr) + real(r8), pointer :: annsum_litfall(:) ! annual sum litfall (gC/m2/yr) +! +! local pointers to implicit in/out arguments +! + integer , pointer :: ivt(:) ! vegetation type for this pft + logical , pointer :: present(:) ! true=> PFT present in patch + real(r8), pointer :: nind(:) ! number of individuals (#/m**2) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: fpcgrid(:) ! foliar projective cover on gridcell (fraction) + real(r8), pointer :: crownarea(:) ! area that each individual tree takes up (m^2) + real(r8), pointer :: greffic(:) ! lpj's growth efficiency + real(r8), pointer :: heatstress(:) +! +!EOP +! +! !OTHER LOCAL VARIABLES: +! + integer :: g,l,p,m ! indices + integer :: fn, filterg(ubg-lbg+1) ! local gridcell filter for error check +! +! gridcell level variables +! + integer :: ngrass(lbg:ubg) ! counter + integer :: npft_estab(lbg:ubg) ! counter + real(r8) :: fpc_tree_total(lbg:ubg) ! total fractional cover of trees in vegetated portion of gridcell + real(r8) :: fpc_total(lbg:ubg) ! old-total fractional vegetated portion of gridcell (without bare ground) + real(r8) :: fpc_total_new(lbg:ubg) ! new-total fractional vegetated portion of gridcell (without bare ground) +! +! pft level variables +! + logical :: survive(lbp:ubp) ! true=>pft survives + logical :: estab(lbp:ubp) ! true=>pft is established + real(r8) :: dstemc(lbp:ubp) ! local copy of deadstemc +! +! local and temporary variables or parameters +! + real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) + real(r8) :: estab_rate !establishment rate + real(r8) :: estab_grid !establishment rate on grid cell + real(r8) :: fpcgridtemp ! temporary + real(r8) :: stemdiam ! stem diameter + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: lai_ind ! LAI per individual + real(r8) :: lm_ind !leaf carbon (gC/ind) + real(r8) :: fpc_ind !individual foliage projective cover + real(r8):: bm_delta + + real(r8), parameter :: ramp_agddtw = 300.0 + +! minimum individual density for persistence of PFT (indiv/m2) +! + real(r8), parameter :: nind_min = 1.0e-10_r8 +! +! minimum precip. for establishment (mm/s) +! + real(r8), parameter :: prec_min_estab = 100._r8/(365._r8*SHR_CONST_CDAY) +! +! maximum sapling establishment rate (indiv/m2) +! + real(r8), parameter :: estab_max = 0.24_r8 +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (gridcell-level) + + agdd20 => gdgvs%agdd20 + tmomin20 => gdgvs%tmomin20 + + ! Assign local pointers to derived type members (landunit-level) + + ltype => lun%itype + + ! Assign local pointers to derived type members (pft-level) + + ivt => pft%itype + pgridcell => pft%gridcell + plandunit => pft%landunit + present => pdgvs%present + nind => pdgvs%nind + fpcgrid => pdgvs%fpcgrid + crownarea => pdgvs%crownarea + greffic => pdgvs%greffic + heatstress => pdgvs%heatstress + annsum_npp => pepv%annsum_npp + annsum_litfall => pepv%annsum_litfall + prec365 => pdgvs%prec365 + agddtw => pdgvs%agddtw + pftmayexist => pdgvs%pftmayexist + + ! Assign local pointers to derived type members (vegetation types) + + crownarea_max => dgv_pftcon%crownarea_max + twmax => dgv_pftcon%twmax + reinickerp => dgv_pftcon%reinickerp + allom1 => dgv_pftcon%allom1 + tcmax => dgv_pftcon%tcmax + tcmin => dgv_pftcon%tcmin + gddmin => dgv_pftcon%gddmin + leafcmax => pcs%leafcmax + deadstemc => pcs%deadstemc + slatop => pftcon%slatop + dsladlai => pftcon%dsladlai + dwood => pftcon%dwood + woody => pftcon%woody + + ! ********************************************************************** + ! Slevis version of LPJ's subr. bioclim + ! Limits based on 20-year running averages of coldest-month mean + ! temperature and growing degree days (5 degree base). + ! For SURVIVAL, coldest month temperature and GDD should be + ! at least as high as PFT-specific limits. + ! For REGENERATION, PFT must be able to survive AND coldest month + ! temperature should be no higher than a PFT-specific limit. + ! ********************************************************************** + + taper = 200._r8 ! make a global constant as with dwood (lpj's wooddens) + + ! Initialize gridcell-level metrics + + do g = lbg, ubg + ngrass(g) = 0 + npft_estab(g) = 0 + fpc_tree_total(g) = 0._r8 + fpc_total(g) = 0._r8 + fpc_total_new(g) = 0._r8 + end do + + do p = lbp, ubp + g = pgridcell(p) + + ! Set the presence of pft for this gridcell + + if (nind(p) == 0._r8) present(p) = .false. + if (.not. present(p)) then + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + survive(p) = .false. + estab(p) = .false. + dstemc(p) = deadstemc(p) + end do + + ! Must go thru all 16 pfts and decide which can/cannot establish or survive + ! Determine present, survive, estab. Note: Even if tmomin20>tcmax, crops + ! and 2nd boreal summergreen tree cannot exist (see + ! EcosystemDynini) because this model cannot simulate such pfts, yet. + ! Note - agddtw is only defined at the pft level and has now been moved + ! to an if-statement below to determine establishment of boreal trees + + do p = lbp, ubp + g = pgridcell(p) + if (tmomin20(g) >= tcmin(ivt(p)) + SHR_CONST_TKFRZ ) then + if (tmomin20(g) <= tcmax(ivt(p)) + SHR_CONST_TKFRZ .and. agdd20(g) >= gddmin(ivt(p))) then + estab(p) = .true. + end if + survive(p) = .true. + ! seasonal decid. pfts that would have occurred in regions without + ! short winter day lengths (see CNPhenology) + if (.not. pftmayexist(p)) then + survive(p) = .false. + estab(p) = .false. + pftmayexist(p) = .true. + end if + end if + end do + + do p = lbp, ubp + g = pgridcell(p) + l = plandunit(p) + + ! Case 1 -- pft ceases to exist -kill pfts not adapted to current climate + + if (present(p) .and. (.not. survive(p) .or. nind(p)= prec_min_estab .and. estab(p)) then + if (twmax(ivt(p)) > 999._r8 .or. agddtw(p) == 0._r8) then + + present(p) = .true. + nind(p) = 0._r8 + ! lpj starts with fpcgrid=0 and calculates + ! seed fpcgrid from the carbon of saplings; + ! with CN we need the seed fpcgrid up front + ! to scale seed leafc to lm_ind to get fpcgrid; + ! sounds circular; also seed fpcgrid depends on sla, + ! so theoretically need diff value for each pft;slevis + fpcgrid(p) = 0.000844_r8 + if (woody(ivt(p)) < 1._r8) then + fpcgrid(p) = 0.05_r8 + end if + + ! Seed carbon for newly established pfts + ! Equiv. to pleaf=1 & pstor=1 set in subr pftwt_cnbal (slevis) + ! ***Dangerous*** to hardwire leafcmax here; find alternative! + ! Consider just assigning nind and fpcgrid for newly + ! established pfts instead of entering the circular procedure + ! outlined in the paragraph above + leafcmax(p) = 1._r8 + if (dstemc(p) <= 0._r8) dstemc(p) = 0.1_r8 + + end if ! conditions required for establishment + end if ! conditions required for establishment + end if ! if soil + + ! Case 3 -- some pfts continue to exist (no change) and some pfts + ! continue to not exist (no change). Do nothing for this case. + + end do + + ! Sapling and grass establishment + ! Calculate total woody FPC, FPC increment and grass cover (= crown area) + ! Calculate total woody FPC and number of woody PFTs present and able to establish + + do p = lbp, ubp + g = pgridcell(p) + if (present(p)) then + if (woody(ivt(p)) == 1._r8) then + fpc_tree_total(g) = fpc_tree_total(g) + fpcgrid(p) + if (estab(p)) npft_estab(g) = npft_estab(g) + 1 + else if (woody(ivt(p)) < 1._r8 .and. ivt(p) > noveg) then !grass + ngrass(g) = ngrass(g) + 1 + end if + end if + end do + + ! Above grid-level establishment counters are required for the next steps. + + do p = lbp, ubp + g = pgridcell(p) + + if (present(p) .and. woody(ivt(p)) == 1._r8 .and. estab(p)) then + + ! Calculate establishment rate over available space, per tree PFT + ! Max establishment rate reduced by shading as tree FPC approaches 1 + ! Total establishment rate partitioned equally among regenerating woody PFTs + + estab_rate = estab_max * (1._r8-exp(5._r8*(fpc_tree_total(g)-1._r8))) / real(npft_estab(g)) + + ! Calculate grid-level establishment rate per woody PFT + ! Space available for woody PFT establishment is fraction of grid cell + ! not currently occupied by woody PFTs + + estab_grid = estab_rate * (1._r8-fpc_tree_total(g)) + + ! Add new saplings to current population + + nind(p) = nind(p) + estab_grid + + !slevis: lpj's lm_ind was the max leaf mass for the year; + !now lm_ind is the max leaf mass for the year calculated in CNFire + !except when a pft is newly established (nind==0); then lm_ind + !is assigned a leafcmax above + + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) ! nind>0 for sure + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 pft area + ! stemdiam derived here from cn's formula for htop found in + ! CNVegStructUpdate and cn's assumption stemdiam=2*htop/taper + ! this derivation neglects upper htop limit enforced elsewhere + stemdiam = (24._r8 * dstemc(p) / (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) + else + stemdiam = 0._r8 + end if + ! Eqn D (now also in Light; need here for 1st yr when pfts haven't established, yet) + crownarea(p) = min(crownarea_max(ivt(p)), allom1(ivt(p))*stemdiam**reinickerp(ivt(p))) + + ! Update LAI and FPC + + if (crownarea(p) > 0._r8) then + if (dsladlai(ivt(p)) > 0._r8) then + ! make lai_ind >= 0.001 to avoid killing plants at this stage + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else ! currently redundant because dsladlai=0 for grasses only + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) ! lpj's formula + end if + else + lai_ind = 0._r8 + end if + + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + + end if ! add new saplings block + if (present(p) .and. woody(ivt(p)) == 1._r8) then + fpc_total_new(g) = fpc_total_new(g) + fpcgrid(p) + end if + end do ! close loop to update fpc_total_new + + ! Adjustments- don't allow trees to exceed 95% of vegetated landunit + + do p = lbp, ubp + g = pgridcell(p) + if (fpc_total_new(g) > 0.95_r8) then + if (woody(ivt(p)) == 1._r8 .and. present(p)) then + nind(p) = nind(p) * 0.95_r8 / fpc_total_new(g) + fpcgrid(p) = fpcgrid(p) * 0.95_r8 / fpc_total_new(g) + end if + fpc_total(g) = 0.95_r8 + + else + fpc_total(g) = fpc_total_new(g) + end if + end do + + ! Section for grasses. Grasses can establish in non-vegetated areas + + do p = lbp, ubp + g = pgridcell(p) + if (present(p) .and. woody(ivt(p)) < 1._r8) then + if (leafcmax(p) <= 0._r8 .or. fpcgrid(p) <= 0._r8 ) then + present(p) = .false. + nind(p) = 0._r8 + else + nind(p) = 1._r8 ! in case these grasses just established + crownarea(p) = 1._r8 + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + if (dsladlai(ivt(p)) > 0._r8) then + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else ! 'if' is currently redundant b/c dsladlai=0 for grasses only + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) + end if + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + fpc_total(g) = fpc_total(g) + fpcgrid(p) + end if + end if + end do ! end of pft-loop + + ! Adjustment of fpc_total > 1 due to grasses (ivt >= nc3_arctic_grass) + + do p = lbp, ubp + g = pgridcell(p) + + if (fpc_total(g) > 1._r8) then + if (ivt(p) >= nc3_arctic_grass .and. fpcgrid(p) > 0._r8) then + fpcgridtemp = fpcgrid(p) + fpcgrid(p) = max(0._r8, fpcgrid(p) - (fpc_total(g)-1._r8)) + fpc_total(g) = fpc_total(g) - fpcgridtemp + fpcgrid(p) + end if + end if + + ! Remove tiny fpcgrid amounts + + if (fpcgrid(p) < 1.e-15_r8) then + fpc_total(g) = fpc_total(g) - fpcgrid(p) + fpcgrid(p) = 0._r8 + present(p) = .false. + nind(p) = 0._r8 + end if + + ! Set the fpcgrid for bare ground if there is bare ground in + ! vegetated landunit and pft is bare ground so that everything + ! can add up to one. + + if (fpc_total(g) < 1._r8 .and. ivt(p) == noveg) then + fpcgrid(p) = 1._r8 - fpc_total(g) + fpc_total(g) = fpc_total(g) + fpcgrid(p) + end if + + end do + + ! Annual calculations used hourly in GapMortality + ! Ultimately may wish to place in separate subroutine... + + do p = lbp, ubp + g = pgridcell(p) + + ! Stress mortality from lpj's subr Mortality + + if (woody(ivt(p)) == 1._r8 .and. nind(p) > 0._r8 .and. & + leafcmax(p) > 0._r8 .and. fpcgrid(p) > 0._r8) then + + if (twmax(ivt(p)) < 999._r8) then + heatstress(p) = max(0._r8, min(1._r8, agddtw(p) / ramp_agddtw)) + else + heatstress(p) = 0._r8 + end if + + ! Net individual living biomass increment + ! NB: lpj's turnover not exactly same as cn's litfall: + ! lpj's sap->heartwood turnover not included in litfall (slevis) + + bm_delta = max(0._r8, annsum_npp(p) - annsum_litfall(p)) + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + + ! Growth efficiency (net biomass increment per unit leaf area) + + if (dsladlai(ivt(p)) > 0._r8) then + greffic(p) = bm_delta / (max(0.001_r8, & + ( ( exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) & + - slatop(ivt(p)) ) / dsladlai(ivt(p)) ))) + else ! currently redundant because dsladlai=0 for grasses only + greffic(p) = bm_delta / (lm_ind * slatop(ivt(p))) + end if + else + greffic(p) = 0. + heatstress(p) = 0. + end if + + end do + + ! Check for error in establishment + fn = 0 + do g = lbg, ubg + if (abs(fpc_total(g) - 1._r8) > 1.e-6) then + fn = fn + 1 + filterg(fn) = g + end if + end do + ! Just print out the first error + if (fn > 0) then + g = filterg(1) + write(iulog,*) 'Error in Establishment: fpc_total =',fpc_total(g), ' at gridcell ',g + call endrun + end if + + end subroutine Establishment + +end module CNDVEstablishmentMod diff --git a/components/clm/src_clm40/biogeochem/CNDVLightMod.F90 b/components/clm/src_clm40/biogeochem/CNDVLightMod.F90 new file mode 100644 index 0000000000..734e49cd8a --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNDVLightMod.F90 @@ -0,0 +1,273 @@ +module CNDVLightMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: LightMod +! +! !DESCRIPTION: +! Calculate light competition +! Update fpc for establishment routine +! Called once per year +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only : SHR_CONST_PI +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Light +! +! !REVISION HISTORY: +! Module created by Sam Levis following DGVMLightMod by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Light +! +! !INTERFACE: + subroutine Light(lbg, ubg, lbp, ubp, num_natvegp, filter_natvegp) +! +! !DESCRIPTION: +! Calculate light competition +! Update fpc for establishment routine +! Called once per year +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbg, ubg ! gridcell bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_natvegp ! number of naturally-vegetated pfts in filter + integer, intent(in) :: filter_natvegp(ubp-lbp+1) ! pft filter for naturally-vegetated points +! +! !CALLED FROM: +! subroutine dv in module CNDVMod +! +! !REVISION HISTORY: +! Author: Sam Levis (adapted from Stephen Sitch's LPJ subroutine light) +! 3/4/02, Peter Thornton: Migrated to new data structures. +! 2005.10: Sam Levis updated to work with CN +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pgridcell(:) ! gridcell index of corresponding pft + integer , pointer :: tree(:) ! ecophys const - tree pft or not + real(r8), pointer :: slatop(:) !specific leaf area at top of canopy, projected area basis [m^2/gC] + real(r8), pointer :: dsladlai(:) !dSLA/dLAI, projected area basis [m^2/gC] + real(r8), pointer :: woody(:) ! ecophys const - woody pft or not + real(r8), pointer :: leafcmax(:) ! (gC/m2) leaf C storage + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: dwood(:) ! ecophys const - wood density (gC/m3) + real(r8), pointer :: reinickerp(:) ! ecophys const - parameter in allomet + real(r8), pointer :: crownarea_max(:) ! ecophys const - tree maximum crown a + real(r8), pointer :: allom1(:) ! ecophys const - parameter in allomet + +! local pointers to implicit inout arguments +! + real(r8), pointer :: crownarea(:) ! area that each individual tree takes up (m^2) + real(r8), pointer :: fpcgrid(:) ! foliar projective cover on gridcell (fraction) + real(r8), pointer :: nind(:) ! number of individuals +! +!EOP +! +! !OTHER LOCAL VARIABLES: + real(r8), parameter :: fpc_tree_max = 0.95_r8 !maximum total tree FPC + integer :: p,fp, g ! indices + real(r8) :: fpc_tree_total(lbg:ubg) + real(r8) :: fpc_inc_tree(lbg:ubg) + real(r8) :: fpc_inc(lbp:ubp) ! foliar projective cover increment (fraction) + real(r8) :: fpc_grass_total(lbg:ubg) + real(r8) :: fpc_shrub_total(lbg:ubg) + real(r8) :: fpc_grass_max(lbg:ubg) + real(r8) :: fpc_shrub_max(lbg:ubg) + integer :: numtrees(lbg:ubg) + real(r8) :: excess + real(r8) :: nind_kill + real(r8) :: lai_ind + real(r8) :: fpc_ind + real(r8) :: fpcgrid_old + real(r8) :: lm_ind !leaf carbon (gC/individual) + real(r8) :: stemdiam ! stem diameter + real(r8) :: stocking ! #stems / ha (stocking density) + real(r8) :: taper ! ratio of height:radius_breast_height (tree allometry) + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type scalar members + + ivt => pft%itype + pgridcell => pft%gridcell + nind => pdgvs%nind + fpcgrid => pdgvs%fpcgrid + leafcmax => pcs%leafcmax + deadstemc => pcs%deadstemc + crownarea => pdgvs%crownarea + crownarea_max => dgv_pftcon%crownarea_max + reinickerp => dgv_pftcon%reinickerp + allom1 => dgv_pftcon%allom1 + dwood => pftcon%dwood + slatop => pftcon%slatop + dsladlai => pftcon%dsladlai + woody => pftcon%woody + tree => pftcon%tree + + taper = 200._r8 ! make a global constant; used in Establishment + ? + + ! Initialize gridcell-level metrics + + do g = lbg, ubg + fpc_tree_total(g) = 0._r8 + fpc_inc_tree(g) = 0._r8 + fpc_grass_total(g) = 0._r8 + fpc_shrub_total(g) = 0._r8 + numtrees(g) = 0 + end do + + do fp = 1,num_natvegp + p = filter_natvegp(fp) + g = pgridcell(p) + + ! Update LAI and FPC as in the last lines of DGVMAllocation + + if (woody(ivt(p))==1._r8) then + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 pft area + ! stemdiam derived here from cn's formula for htop found in + ! CNVegStructUpdate and cn's assumption stemdiam=2*htop/taper + ! this derivation neglects upper htop limit enforced elsewhere + stemdiam = (24._r8 * deadstemc(p) / (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) + else + stemdiam = 0._r8 + end if + crownarea(p) = min(crownarea_max(ivt(p)), allom1(ivt(p))*stemdiam**reinickerp(ivt(p))) ! Eqn D (from Establishment) +! else ! crownarea is 1 and does not need updating + end if + + if (crownarea(p) > 0._r8 .and. nind(p) > 0._r8) then + lm_ind = leafcmax(p) * fpcgrid(p) / nind(p) + if (dsladlai(ivt(p)) > 0._r8) then + lai_ind = max(0.001_r8,((exp(lm_ind*dsladlai(ivt(p)) + log(slatop(ivt(p)))) - & + slatop(ivt(p)))/dsladlai(ivt(p))) / crownarea(p)) + else + lai_ind = lm_ind * slatop(ivt(p)) / crownarea(p) + end if + else + lai_ind = 0._r8 + end if + + fpc_ind = 1._r8 - exp(-0.5_r8*lai_ind) + fpcgrid_old = fpcgrid(p) + fpcgrid(p) = crownarea(p) * nind(p) * fpc_ind + fpc_inc(p) = max(0._r8, fpcgrid(p) - fpcgrid_old) + + if (woody(ivt(p)) == 1._r8) then + if (tree(ivt(p)) == 1) then + numtrees(g) = numtrees(g) + 1 + fpc_tree_total(g) = fpc_tree_total(g) + fpcgrid(p) + fpc_inc_tree(g) = fpc_inc_tree(g) + fpc_inc(p) + else ! if shrubs + fpc_shrub_total(g) = fpc_shrub_total(g) + fpcgrid(p) + end if + else ! if grass + fpc_grass_total(g) = fpc_grass_total(g) + fpcgrid(p) + end if + end do + + do g = lbg, ubg + fpc_grass_max(g) = 1._r8 - min(fpc_tree_total(g), fpc_tree_max) + fpc_shrub_max(g) = max(0._r8, fpc_grass_max(g) - fpc_grass_total(g)) + end do + + ! The gridcell level metrics are now in place; continue... + ! slevis replaced the previous code that updated pfpcgrid + ! with a simpler way of doing so: + ! fpcgrid(p) = fpcgrid(p) - excess + ! Later we may wish to update this subroutine + ! according to Strassmann's recommendations (see relevant pdf) + + do fp = 1,num_natvegp + p = filter_natvegp(fp) + g = pgridcell(p) + + ! light competition + + if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==1._r8) then + + if (fpc_tree_total(g) > fpc_tree_max) then + + if (fpc_inc_tree(g) > 0._r8) then + excess = (fpc_tree_total(g) - fpc_tree_max) * & + fpc_inc(p) / fpc_inc_tree(g) + else + excess = (fpc_tree_total(g) - fpc_tree_max) / & + real(numtrees(g)) + end if + + ! Reduce individual density (and thereby gridcell-level biomass) + ! so that total tree FPC reduced to 'fpc_tree_max' + + if (fpcgrid(p) > 0._r8) then + nind_kill = nind(p) * excess / fpcgrid(p) + nind(p) = max(0._r8, nind(p) - nind_kill) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + else + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + + ! Transfer lost biomass to litter + + end if ! if tree cover exceeds max allowed + else if (woody(ivt(p))==0._r8) then ! grass + + if (fpc_grass_total(g) > fpc_grass_max(g)) then + + ! grass competes with itself if total fpc exceeds 1 + + excess = (fpc_grass_total(g) - fpc_grass_max(g)) * fpcgrid(p) / fpc_grass_total(g) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + + end if + + else if (woody(ivt(p))==1._r8 .and. tree(ivt(p))==0._r8) then ! shrub + + if (fpc_shrub_total(g) > fpc_shrub_max(g)) then + + excess = 1._r8 - fpc_shrub_max(g) / fpc_shrub_total(g) + + ! Reduce individual density (and thereby gridcell-level biomass) + ! so that total shrub FPC reduced to fpc_shrub_max(g) + + if (fpcgrid(p) > 0._r8) then + nind_kill = nind(p) * excess / fpcgrid(p) + nind(p) = max(0._r8, nind(p) - nind_kill) + fpcgrid(p) = max(0._r8, fpcgrid(p) - excess) + else + nind(p) = 0._r8 + fpcgrid(p) = 0._r8 + end if + + end if + + end if ! end of if-tree + + end do + + end subroutine Light + +end module CNDVLightMod diff --git a/components/clm/src_clm40/biogeochem/CNDVMod.F90 b/components/clm/src_clm40/biogeochem/CNDVMod.F90 new file mode 100644 index 0000000000..9db9dd3f18 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNDVMod.F90 @@ -0,0 +1,558 @@ +module CNDVMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNDVMod +! +! !DESCRIPTION: +! Module containing routines to drive the annual dynamic vegetation +! that works with CN, reset related variables, +! and initialize/reset time invariant variables +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use abortutils , only : endrun + use CNVegStructUpdateMod, only : CNVegStructUpdate +! +! !PUBLIC TYPES: + implicit none + private + save +! +! !PUBLIC MEMBER FUNCTIONS: + public dv ! Drives the annual dynamic vegetation that + ! works with CN + public histCNDV ! Output CNDV history file +! +! !REVISION HISTORY: +! Module modified by Sam Levis from similar module DGVMMod +! created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: dv +! +! !INTERFACE: + subroutine dv(lbg, ubg, lbp, ubp, num_natvegp, filter_natvegp, kyr) +! +! !DESCRIPTION: +! Drives the annual dynamic vegetation that works with CN +! +! !USES: + use clmtype + use CNDVLightMod , only : Light + use CNDVEstablishmentMod, only : Establishment +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbg, ubg ! gridcell bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(inout) :: num_natvegp ! number of naturally-vegetated + ! pfts in filter + integer, intent(inout) :: filter_natvegp(ubp-lbp+1) ! filter for + ! naturally-vegetated pfts + integer, intent(in) :: kyr ! used in routine climate20 below +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Sam Levis +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: mxy(:) ! pft m index (for laixy(i,j,m),etc.) + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + real(r8), pointer :: fpcgrid(:) ! foliar projective cover on gridcell (fraction) + real(r8), pointer :: agdd(:) ! accumulated growing degree days above 5 + real(r8), pointer :: t_mo_min(:) ! annual min of t_mo (Kelvin) +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: tmomin20(:) ! 20-yr running mean of tmomin + real(r8), pointer :: agdd20(:) ! 20-yr running mean of agdd +! +!EOP +! +! !LOCAL VARIABLES: + integer :: g,p ! indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (gridcell-level) + + agdd20 => gdgvs%agdd20 + tmomin20 => gdgvs%tmomin20 + + ! Assign local pointers to derived type members (pft-level) + + mxy => pft%mxy + pgridcell => pft%gridcell + fpcgrid => pdgvs%fpcgrid + t_mo_min => pdgvs%t_mo_min + agdd => pdgvs%agdd + + ! ************************************************************************* + ! S. Levis version of LPJ's routine climate20: 'Returns' tmomin20 & agdd20 + ! for use in routine bioclim, which I have placed in routine Establishment + ! Instead of 20-yr running mean of coldest monthly temperature, + ! use 20-yr running mean of minimum 10-day running mean + ! ************************************************************************* + + do p = lbp,ubp + g = pgridcell(p) + if (kyr == 2) then ! slevis: add ".and. start_type==arb_ic" here? + tmomin20(g) = t_mo_min(p) ! NO, b/c want to be able to start dgvm + agdd20(g) = agdd(p) ! w/ clmi file from non-dgvm simulation + end if + tmomin20(g) = (19._r8 * tmomin20(g) + t_mo_min(p)) / 20._r8 + agdd20(g) = (19._r8 * agdd20(g) + agdd(p) ) / 20._r8 + end do + + ! Rebuild filter of present natually-vegetated pfts after Kill() + + call BuildNatVegFilter(lbp, ubp, num_natvegp, filter_natvegp) + + ! Returns fpcgrid and nind + + call Light(lbg, ubg, lbp, ubp, num_natvegp, filter_natvegp) + + ! Returns updated fpcgrid, nind, crownarea, and present. Due to updated + ! present, we do not use the natveg filter in this subroutine. + + call Establishment(lbg, ubg, lbp, ubp) + + ! Reset dgvm variables needed in next yr (too few to keep subr. dvreset) + + do p = lbp,ubp + pcs%leafcmax(p) = 0._r8 + pdgvs%t_mo_min(p) = 1.0e+36_r8 + end do + end subroutine dv + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: histCNDV +! +! !INTERFACE: + subroutine histCNDV() +! +! !DESCRIPTION: +! Create CNDV history file +! +! !USES: + use clmtype + use decompMod , only : get_proc_bounds, get_proc_global + use clm_varpar , only : maxpatch_pft + use domainMod , only : ldomain + use clm_varctl , only : caseid, ctitle, finidat, fsurdat, fpftcon, iulog + use clm_varcon , only : spval + use clm_time_manager, only : get_ref_date, get_nstep, get_curr_date, get_curr_time + use fileutils , only : get_filename + use shr_sys_mod , only : shr_sys_getenv + use spmdMod , only : masterproc + use shr_const_mod , only : SHR_CONST_CDAY + use ncdio_pio +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Sam Levis +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + logical , pointer :: ifspecial(:) ! true=>landunit is not vegetated (landunit-level) + integer , pointer :: pgridcell(:) ! gridcell index of corresponding pft (pft-level) + integer , pointer :: plandunit(:) ! landunit index of corresponding pft (pft-level) + integer , pointer :: mxy(:) ! pft m index (for laixy(i,j,m),etc.) + real(r8), pointer :: fpcgrid(:) ! foliar projective cover on gridcell (fraction) + real(r8), pointer :: nind(:) ! number of individuals (#/m**2) +! +!EOP +! +! !LOCAL VARIABLES: + character(len=256) :: dgvm_fn ! dgvm history filename + type(file_desc_t) :: ncid ! netcdf file id + integer :: ncprec ! output precision + integer :: g,p,l ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: ier ! error status + integer :: mdcur, mscur, mcdate ! outputs from get_curr_time + integer :: yr,mon,day,mcsec ! outputs from get_curr_date + integer :: hours,minutes,secs ! hours,minutes,seconds of hh:mm:ss + integer :: nstep ! time step + integer :: nbsec ! seconds components of a date + integer :: dimid ! dimension, variable id + real(r8):: time ! current time + character(len=256) :: str ! temporary string + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len= 10) :: basedate ! base date (yyyymmdd) + character(len= 8) :: basesec ! base seconds + real(r8), pointer :: rbuf2dg(:,:) ! temporary + character(len=32) :: subname='histCNDV' +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (gridcell-level) + + ! NONE + + ! Assign local pointers to derived type members (landunit-level) + + ifspecial => lun%ifspecial + + ! Assign local pointers to derived subtypes components (pft-level) + + mxy => pft%mxy + pgridcell => pft%gridcell + plandunit => pft%landunit + fpcgrid => pdgvs%fpcgrid + nind => pdgvs%nind + + ! Determine subgrid bounds for this processor and allocate dynamic memory + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + allocate(rbuf2dg(begg:endg,maxpatch_pft), stat=ier) + if (ier /= 0) call endrun('histCNDV: allocation error for rbuf2dg') + + ! Set output precision + + ncprec = ncd_double + + ! ----------------------------------------------------------------------- + ! Create new netCDF file. File will be in define mode + ! ----------------------------------------------------------------------- + + dgvm_fn = set_dgvm_filename() + call ncd_pio_createfile(ncid, trim(dgvm_fn)) + + ! ----------------------------------------------------------------------- + ! Create global attributes. + ! ----------------------------------------------------------------------- + + str = 'CF1.0' + call ncd_putatt (ncid, ncd_global, 'conventions', trim(str)) + + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(ncid, ncd_global,'history', trim(str)) + + call shr_sys_getenv('LOGNAME', str, ier) + if (ier /= 0) call endrun('error: LOGNAME environment variable not defined') + + call ncd_putatt (ncid, ncd_global, 'logname', trim(str)) + + call shr_sys_getenv('HOST', str, ier) + call ncd_putatt (ncid, ncd_global, 'host', trim(str)) + + str = 'Community Land Model: CLM3' + call ncd_putatt (ncid, ncd_global, 'source', trim(str)) + + str = '$Name$' + call ncd_putatt (ncid, ncd_global, 'version', trim(str)) + + str = '$Id$' + call ncd_putatt (ncid, ncd_global, 'revision_id', trim(str)) + + str = ctitle + call ncd_putatt (ncid, ncd_global, 'case_title', trim(str)) + + str = caseid + call ncd_putatt (ncid, ncd_global, 'case_id', trim(str)) + + str = get_filename(fsurdat) + call ncd_putatt(ncid, ncd_global, 'Surface_dataset', trim(str)) + + str = 'arbitrary initialization' + if (finidat /= ' ') str = get_filename(finidat) + call ncd_putatt(ncid, ncd_global, 'Initial_conditions_dataset', trim(str)) + + str = get_filename(fpftcon) + call ncd_putatt(ncid, ncd_global, 'PFT_physiological_constants_dataset', trim(str)) + + ! ----------------------------------------------------------------------- + ! Define dimensions. + ! ----------------------------------------------------------------------- + + if (ldomain%isgrid2d) then + call ncd_defdim (ncid, 'lon' ,ldomain%ni, dimid) + call ncd_defdim (ncid, 'lat' ,ldomain%nj, dimid) + else + call ncd_defdim (ncid, 'gridcell', ldomain%ns, dimid) + end if + call ncd_defdim (ncid, 'pft' , maxpatch_pft , dimid) + call ncd_defdim (ncid, 'time', ncd_unlimited, dimid) + call ncd_defdim (ncid, 'string_length', 80 , dimid) + + ! ----------------------------------------------------------------------- + ! Define variables + ! ----------------------------------------------------------------------- + + ! Define coordinate variables (including time) + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='lon', xtype=ncprec, dim1name='lon', & + long_name='coordinate longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='lat', xtype=ncprec, dim1name='lat', & + long_name='coordinate latitude', units='degrees_north') + end if + + call get_curr_time(mdcur, mscur) + call get_ref_date(yr, mon, day, nbsec) + hours = nbsec / 3600 + minutes = (nbsec - hours*3600) / 60 + secs = (nbsec - hours*3600 - minutes*60) + write(basedate,80) yr,mon,day +80 format(i4.4,'-',i2.2,'-',i2.2) + write(basesec ,90) hours, minutes, secs +90 format(i2.2,':',i2.2,':',i2.2) + str = 'days since ' // basedate // " " // basesec + time = mdcur + mscur/SHR_CONST_CDAY + + call ncd_defvar(ncid=ncid, varname='time', xtype=ncd_double, dim1name='time', & + long_name='time', units=str) + + ! Define surface grid (coordinate variables, latitude, longitude, surface type). + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='longxy', xtype=ncprec, & + dim1name='lon', dim2name='lat', & + long_name='longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='latixy', xtype=ncprec, & + dim1name='lon', dim2name='lat', & + long_name='latitude', units='degrees_north') + + call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='land/ocean mask (0.=ocean and 1.=land)') + else + call ncd_defvar(ncid=ncid, varname='longxy', xtype=ncprec, & + dim1name='gridcell',& + long_name='longitude', units='degrees_east') + + call ncd_defvar(ncid=ncid, varname='latixy', xtype=ncprec, & + dim1name='gridcell',& + long_name='latitude', units='degrees_north') + + call ncd_defvar(ncid=ncid, varname='landmask', xtype=ncd_int, & + dim1name='gridcell', & + long_name='land/ocean mask (0.=ocean and 1.=land)') + end if + + ! Define time information + + call ncd_defvar(ncid=ncid, varname='mcdate', xtype=ncd_int, dim1name='time',& + long_name='current date (YYYYMMDD)') + + call ncd_defvar(ncid=ncid, varname='mcsec', xtype=ncd_int, dim1name='time',& + long_name='current seconds of current date', units='s') + + call ncd_defvar(ncid=ncid, varname='mdcur', xtype=ncd_int, dim1name='time',& + long_name='current day (from base day)') + + call ncd_defvar(ncid=ncid, varname='mscur', xtype=ncd_int, dim1name='time',& + long_name='current seconds of current day', units='s') + + call ncd_defvar(ncid=ncid, varname='nstep', xtype=ncd_int, dim1name='time',& + long_name='time step', units='s') + + ! Define time dependent variables + + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=ncid, varname='FPCGRID', xtype=ncprec, & + dim1name='lon', dim2name='lat', dim3name='pft', dim4name='time', & + long_name='plant functional type cover', units='fraction of vegetated area', & + missing_value=spval, fill_value=spval) + + call ncd_defvar(ncid=ncid, varname='NIND', xtype=ncprec, & + dim1name='lon', dim2name='lat', dim3name='pft', dim4name='time', & + long_name='number of individuals', units='individuals/m2 vegetated land', & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=ncid, varname='FPCGRID', xtype=ncprec, & + dim1name='gridcell', dim2name='pft', dim3name='time', & + long_name='plant functional type cover', units='fraction of vegetated area', & + missing_value=spval, fill_value=spval) + + call ncd_defvar(ncid=ncid, varname='NIND', xtype=ncprec, & + dim1name='gridcell', dim2name='pft', dim3name='time', & + long_name='number of individuals', units='individuals/m2 vegetated land', & + missing_value=spval, fill_value=spval) + end if + + call ncd_enddef(ncid) + + ! ----------------------------------------------------------------------- + ! Write variables + ! ----------------------------------------------------------------------- + + ! Write surface grid (coordinate variables, latitude, longitude, surface type). + + call ncd_io(ncid=ncid, varname='longxy' , data=ldomain%lonc, flag='write', & + dim1name=grlnd) + call ncd_io(ncid=ncid, varname='latixy' , data=ldomain%latc, flag='write', & + dim1name=grlnd) + call ncd_io(ncid=ncid, varname='landmask', data=ldomain%mask, flag='write', & + dim1name=grlnd) + + ! Write current date, current seconds, current day, current nstep + + call get_curr_date(yr, mon, day, mcsec) + mcdate = yr*10000 + mon*100 + day + nstep = get_nstep() + + call ncd_io(ncid=ncid, varname='mcdate', data=mcdate, nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mcsec' , data=mcsec , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mdcur' , data=mdcur , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='mscur' , data=mcsec , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='nstep' , data=nstep , nt=1, flag='write') + call ncd_io(ncid=ncid, varname='time' , data=time , nt=1, flag='write') + + ! Write time dependent variables to CNDV history file + + ! The if .not. ifspecial statment below guarantees that the m index will + ! always lie between 1 and maxpatch_pft + + rbuf2dg(:,:) = 0._r8 + do p = begp,endp + g = pgridcell(p) + l = plandunit(p) + if (.not. ifspecial(l)) rbuf2dg(g,mxy(p)) = fpcgrid(p)*100._r8 + end do + call ncd_io(ncid=ncid, varname='FPCGRID', dim1name=grlnd, data=rbuf2dg, & + nt=1, flag='write') + + rbuf2dg(:,:) = 0._r8 + do p = begp,endp + g = pgridcell(p) + l = plandunit(p) + if (.not. ifspecial(l)) rbuf2dg(g,mxy(p)) = nind(p) + end do + call ncd_io(ncid=ncid, varname='NIND', dim1name=grlnd, data=rbuf2dg, & + nt=1, flag='write') + + ! Deallocate dynamic memory + + deallocate(rbuf2dg) + + !------------------------------------------------------------------ + ! Close and archive netcdf CNDV history file + !------------------------------------------------------------------ + + call ncd_pio_closefile(ncid) + + if (masterproc) then + write(iulog,*)'(histCNDV): Finished writing CNDV history dataset ',& + trim(dgvm_fn), 'at nstep = ',get_nstep() + end if + + end subroutine histCNDV + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: set_dgvm_filename +! +! !INTERFACE: + character(len=256) function set_dgvm_filename () +! +! !DESCRIPTION: +! Determine initial dataset filenames +! +! !USES: + use clm_varctl , only : caseid, inst_suffix + use clm_time_manager , only : get_curr_date +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +! +! !LOCAL VARIABLES: + character(len=256) :: cdate !date char string + integer :: day !day (1 -> 31) + integer :: mon !month (1 -> 12) + integer :: yr !year (0 -> ...) + integer :: sec !seconds into current day +!----------------------------------------------------------------------- + + call get_curr_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec + set_dgvm_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".hv."//trim(cdate)//".nc" + + end function set_dgvm_filename + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BuildNatVegFilter +! +! !INTERFACE: + subroutine BuildNatVegFilter(lbp, ubp, num_natvegp, filter_natvegp) +! +! !DESCRIPTION: +! Reconstruct a filter of naturally-vegetated PFTs for use in DGVM +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(out) :: num_natvegp ! number of pfts in naturally-vegetated filter + integer, intent(out) :: filter_natvegp(ubp-lbp+1) ! pft filter for naturally-vegetated points +! +! !CALLED FROM: +! subroutine lpj in this module +! +! !REVISION HISTORY: +! Author: Forrest Hoffman +! +! !LOCAL VARIABLES: +! local pointers to implicit in arguments + logical , pointer :: present(:) ! whether this pft present in patch +!EOP +! +! !LOCAL VARIABLES: + integer :: p +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (pft-level) + present => pdgvs%present + + num_natvegp = 0 + do p = lbp,ubp + if (present(p)) then + num_natvegp = num_natvegp + 1 + filter_natvegp(num_natvegp) = p + end if + end do + + end subroutine BuildNatVegFilter + +end module CNDVMod diff --git a/components/clm/src_clm40/biogeochem/CNDecompMod.F90 b/components/clm/src_clm40/biogeochem/CNDecompMod.F90 new file mode 100644 index 0000000000..8ae328bb13 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNDecompMod.F90 @@ -0,0 +1,674 @@ +module CNDecompMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNDecompMod +! +! !DESCRIPTION: +! Module holding routines used in litter and soil decomposition model +! for coupled carbon-nitrogen code. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CNDecompAlloc +! +! !REVISION HISTORY: +! 8/15/03: Created by Peter Thornton +! 10/23/03, Peter Thornton: migrated to vector data structures +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNDecompAlloc +! +! !INTERFACE: +subroutine CNDecompAlloc (lbp, ubp, lbc, ubc, num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp) +! +! !DESCRIPTION: +! +! !USES: + use clmtype + use CNAllocationMod , only: CNAllocation + use clm_time_manager, only: get_step_size + use pft2colMod , only: p2c + use clm_varcon , only: secspday + use clm_varctl , only: use_ad_spinup +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + integer, intent(in) :: num_pcropp ! number of pfts in prognostic crop filter +! +! !CALLED FROM: +! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 8/15/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + ! column level + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + real(r8), pointer :: dz(:,:) ! soil layer thickness (m) + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + integer, pointer :: clandunit(:) ! index into landunit level quantities + integer , pointer :: itypelun(:) ! landunit type + ! pft level + real(r8), pointer :: rootfr(:,:) ! fraction of roots in each soil layer (nlevgrnd) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: fpi(:) ! fraction of potential immobilization (no units) + real(r8), pointer :: cwdc_to_litr2c(:) + real(r8), pointer :: cwdc_to_litr3c(:) + real(r8), pointer :: litr1_hr(:) + real(r8), pointer :: litr1c_to_soil1c(:) + real(r8), pointer :: litr2_hr(:) + real(r8), pointer :: litr2c_to_soil2c(:) + real(r8), pointer :: litr3_hr(:) + real(r8), pointer :: litr3c_to_soil3c(:) + real(r8), pointer :: soil1_hr(:) + real(r8), pointer :: soil1c_to_soil2c(:) + real(r8), pointer :: soil2_hr(:) + real(r8), pointer :: soil2c_to_soil3c(:) + real(r8), pointer :: soil3_hr(:) + real(r8), pointer :: soil3c_to_soil4c(:) + real(r8), pointer :: soil4_hr(:) + real(r8), pointer :: cwdn_to_litr2n(:) + real(r8), pointer :: cwdn_to_litr3n(:) + real(r8), pointer :: potential_immob(:) + real(r8), pointer :: litr1n_to_soil1n(:) + real(r8), pointer :: sminn_to_soil1n_l1(:) + real(r8), pointer :: litr2n_to_soil2n(:) + real(r8), pointer :: sminn_to_soil2n_l2(:) + real(r8), pointer :: litr3n_to_soil3n(:) + real(r8), pointer :: sminn_to_soil3n_l3(:) + real(r8), pointer :: soil1n_to_soil2n(:) + real(r8), pointer :: sminn_to_soil2n_s1(:) + real(r8), pointer :: soil2n_to_soil3n(:) + real(r8), pointer :: sminn_to_soil3n_s2(:) + real(r8), pointer :: soil3n_to_soil4n(:) + real(r8), pointer :: sminn_to_soil4n_s3(:) + real(r8), pointer :: soil4n_to_sminn(:) + real(r8), pointer :: sminn_to_denit_l1s1(:) + real(r8), pointer :: sminn_to_denit_l2s2(:) + real(r8), pointer :: sminn_to_denit_l3s3(:) + real(r8), pointer :: sminn_to_denit_s1s2(:) + real(r8), pointer :: sminn_to_denit_s2s3(:) + real(r8), pointer :: sminn_to_denit_s3s4(:) + real(r8), pointer :: sminn_to_denit_s4(:) + real(r8), pointer :: sminn_to_denit_excess(:) + real(r8), pointer :: gross_nmin(:) + real(r8), pointer :: net_nmin(:) +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: c,j !indices + integer :: fc !lake filter column index + real(r8):: dt !decomp timestep (seconds) + real(r8):: dtd !decomp timestep (days) + real(r8), pointer:: fr(:,:) !column-level rooting fraction by soil depth + real(r8):: frw(lbc:ubc) !rooting fraction weight + real(r8):: t_scalar(lbc:ubc) !soil temperature scalar for decomp + real(r8):: minpsi, maxpsi !limits for soil water scalar for decomp + real(r8):: psi !temporary soilpsi for water scalar + real(r8):: w_scalar(lbc:ubc) !soil water scalar for decomp + real(r8):: rate_scalar !combined rate scalar for decomp + real(r8):: cn_l1(lbc:ubc) !C:N for litter 1 + real(r8):: cn_l2(lbc:ubc) !C:N for litter 2 + real(r8):: cn_l3(lbc:ubc) !C:N for litter 3 + real(r8):: cn_s1 !C:N for SOM 1 + real(r8):: cn_s2 !C:N for SOM 2 + real(r8):: cn_s3 !C:N for SOM 3 + real(r8):: cn_s4 !C:N for SOM 4 + real(r8):: rf_l1s1 !respiration fraction litter 1 -> SOM 1 + real(r8):: rf_l2s2 !respiration fraction litter 2 -> SOM 2 + real(r8):: rf_l3s3 !respiration fraction litter 3 -> SOM 3 + real(r8):: rf_s1s2 !respiration fraction SOM 1 -> SOM 2 + real(r8):: rf_s2s3 !respiration fraction SOM 2 -> SOM 3 + real(r8):: rf_s3s4 !respiration fraction SOM 3 -> SOM 4 + real(r8):: k_l1 !decomposition rate constant litter 1 + real(r8):: k_l2 !decomposition rate constant litter 2 + real(r8):: k_l3 !decomposition rate constant litter 3 + real(r8):: k_s1 !decomposition rate constant SOM 1 + real(r8):: k_s2 !decomposition rate constant SOM 2 + real(r8):: k_s3 !decomposition rate constant SOM 3 + real(r8):: k_s4 !decomposition rate constant SOM 3 + real(r8):: k_frag !fragmentation rate constant CWD + real(r8):: ck_l1 !corrected decomposition rate constant litter 1 + real(r8):: ck_l2 !corrected decomposition rate constant litter 2 + real(r8):: ck_l3 !corrected decomposition rate constant litter 3 + real(r8):: ck_s1 !corrected decomposition rate constant SOM 1 + real(r8):: ck_s2 !corrected decomposition rate constant SOM 2 + real(r8):: ck_s3 !corrected decomposition rate constant SOM 3 + real(r8):: ck_s4 !corrected decomposition rate constant SOM 3 + real(r8):: ck_frag !corrected fragmentation rate constant CWD + real(r8):: cwd_fcel !cellulose fraction of coarse woody debris + real(r8):: cwd_flig !lignin fraction of coarse woody debris + real(r8):: cwdc_loss !fragmentation rate for CWD carbon (gC/m2/s) + real(r8):: cwdn_loss !fragmentation rate for CWD nitrogen (gN/m2/s) + real(r8):: plitr1c_loss(lbc:ubc) !potential C loss from litter 1 + real(r8):: plitr2c_loss(lbc:ubc) !potential C loss from litter 2 + real(r8):: plitr3c_loss(lbc:ubc) !potential C loss from litter 3 + real(r8):: psoil1c_loss(lbc:ubc) !potential C loss from SOM 1 + real(r8):: psoil2c_loss(lbc:ubc) !potential C loss from SOM 2 + real(r8):: psoil3c_loss(lbc:ubc) !potential C loss from SOM 3 + real(r8):: psoil4c_loss(lbc:ubc) !potential C loss from SOM 4 + real(r8):: pmnf_l1s1(lbc:ubc) !potential mineral N flux, litter 1 -> SOM 1 + real(r8):: pmnf_l2s2(lbc:ubc) !potential mineral N flux, litter 2 -> SOM 2 + real(r8):: pmnf_l3s3(lbc:ubc) !potential mineral N flux, litter 3 -> SOM 3 + real(r8):: pmnf_s1s2(lbc:ubc) !potential mineral N flux, SOM 1 -> SOM 2 + real(r8):: pmnf_s2s3(lbc:ubc) !potential mineral N flux, SOM 2 -> SOM 3 + real(r8):: pmnf_s3s4(lbc:ubc) !potential mineral N flux, SOM 3 -> SOM 4 + real(r8):: pmnf_s4(lbc:ubc) !potential mineral N flux, SOM 4 + real(r8):: immob(lbc:ubc) !potential N immobilization + real(r8):: ratio !temporary variable + real(r8):: dnp !denitrification proportion + integer :: nlevdecomp ! bottom layer to consider for decomp controls + real(r8):: spinup_scalar !multiplier for AD_SPINUP algorithm +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays + t_soisno => ces%t_soisno + psisat => cps%psisat + soilpsi => cps%soilpsi + dz => cps%dz + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + soil1c => ccs%soil1c + soil2c => ccs%soil2c + soil3c => ccs%soil3c + soil4c => ccs%soil4c + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + fpi => cps%fpi + cwdc_to_litr2c => ccf%cwdc_to_litr2c + cwdc_to_litr3c => ccf%cwdc_to_litr3c + litr1_hr => ccf%litr1_hr + litr1c_to_soil1c => ccf%litr1c_to_soil1c + litr2_hr => ccf%litr2_hr + litr2c_to_soil2c => ccf%litr2c_to_soil2c + litr3_hr => ccf%litr3_hr + litr3c_to_soil3c => ccf%litr3c_to_soil3c + soil1_hr => ccf%soil1_hr + soil1c_to_soil2c => ccf%soil1c_to_soil2c + soil2_hr => ccf%soil2_hr + soil2c_to_soil3c => ccf%soil2c_to_soil3c + soil3_hr => ccf%soil3_hr + soil3c_to_soil4c => ccf%soil3c_to_soil4c + soil4_hr => ccf%soil4_hr + cwdn_to_litr2n => cnf%cwdn_to_litr2n + cwdn_to_litr3n => cnf%cwdn_to_litr3n + potential_immob => cnf%potential_immob + litr1n_to_soil1n => cnf%litr1n_to_soil1n + sminn_to_soil1n_l1 => cnf%sminn_to_soil1n_l1 + litr2n_to_soil2n => cnf%litr2n_to_soil2n + sminn_to_soil2n_l2 => cnf%sminn_to_soil2n_l2 + litr3n_to_soil3n => cnf%litr3n_to_soil3n + sminn_to_soil3n_l3 => cnf%sminn_to_soil3n_l3 + soil1n_to_soil2n => cnf%soil1n_to_soil2n + sminn_to_soil2n_s1 => cnf%sminn_to_soil2n_s1 + soil2n_to_soil3n => cnf%soil2n_to_soil3n + sminn_to_soil3n_s2 => cnf%sminn_to_soil3n_s2 + soil3n_to_soil4n => cnf%soil3n_to_soil4n + sminn_to_soil4n_s3 => cnf%sminn_to_soil4n_s3 + soil4n_to_sminn => cnf%soil4n_to_sminn + sminn_to_denit_l1s1 => cnf%sminn_to_denit_l1s1 + sminn_to_denit_l2s2 => cnf%sminn_to_denit_l2s2 + sminn_to_denit_l3s3 => cnf%sminn_to_denit_l3s3 + sminn_to_denit_s1s2 => cnf%sminn_to_denit_s1s2 + sminn_to_denit_s2s3 => cnf%sminn_to_denit_s2s3 + sminn_to_denit_s3s4 => cnf%sminn_to_denit_s3s4 + sminn_to_denit_s4 => cnf%sminn_to_denit_s4 + sminn_to_denit_excess => cnf%sminn_to_denit_excess + gross_nmin => cnf%gross_nmin + net_nmin => cnf%net_nmin + rootfr => pps%rootfr + clandunit => col%landunit + itypelun => lun%itype + + ! set time steps + dt = real( get_step_size(), r8 ) + dtd = dt/secspday + + ! set soil organic matter compartment C:N ratios (from Biome-BGC v4.2.0) + cn_s1 = 12.0_r8 + cn_s2 = 12.0_r8 + cn_s3 = 10.0_r8 + cn_s4 = 10.0_r8 + + ! set respiration fractions for fluxes between compartments + ! (from Biome-BGC v4.2.0) + rf_l1s1 = 0.39_r8 + rf_l2s2 = 0.55_r8 + rf_l3s3 = 0.29_r8 + rf_s1s2 = 0.28_r8 + rf_s2s3 = 0.46_r8 + rf_s3s4 = 0.55 + + ! set the cellulose and lignin fractions for coarse woody debris + cwd_fcel = 0.76_r8 + cwd_flig = 0.24_r8 + + ! set initial base rates for decomposition mass loss (1/day) + ! (from Biome-BGC v4.2.0, using three SOM pools) + ! Value inside log function is the discrete-time values for a + ! daily time step model, and the result of the log function is + ! the corresponding continuous-time decay rate (1/day), following + ! Olson, 1963. + k_l1 = -log(1.0_r8-0.7_r8) + k_l2 = -log(1.0_r8-0.07_r8) + k_l3 = -log(1.0_r8-0.014_r8) + k_s1 = -log(1.0_r8-0.07_r8) + k_s2 = -log(1.0_r8-0.014_r8) + k_s3 = -log(1.0_r8-0.0014_r8) + k_s4 = -log(1.0_r8-0.0001_r8) + k_frag = -log(1.0_r8-0.001_r8) + + ! calculate the new discrete-time decay rate for model timestep + k_l1 = 1.0_r8-exp(-k_l1*dtd) + k_l2 = 1.0_r8-exp(-k_l2*dtd) + k_l3 = 1.0_r8-exp(-k_l3*dtd) + k_s1 = 1.0_r8-exp(-k_s1*dtd) + k_s2 = 1.0_r8-exp(-k_s2*dtd) + k_s3 = 1.0_r8-exp(-k_s3*dtd) + k_s4 = 1.0_r8-exp(-k_s4*dtd) + k_frag = 1.0_r8-exp(-k_frag*dtd) + + ! The following code implements the acceleration part of the AD spinup + ! algorithm, by multiplying all of the SOM decomposition base rates by 10.0. + + if (use_ad_spinup) then + spinup_scalar = 20._r8 + k_s1 = k_s1 * spinup_scalar + k_s2 = k_s2 * spinup_scalar + k_s3 = k_s3 * spinup_scalar + k_s4 = k_s4 * spinup_scalar + end if + + ! calculate function to weight the temperature and water potential scalars + ! for decomposition control. + + + ! the following normalizes values in fr so that they + ! sum to 1.0 across top nlevdecomp levels on a column + frw(lbc:ubc) = 0._r8 + nlevdecomp=5 + allocate(fr(lbc:ubc,nlevdecomp)) + do j=1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + frw(c) = frw(c) + dz(c,j) + end do + end do + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + if (frw(c) /= 0._r8) then + fr(c,j) = dz(c,j) / frw(c) + else + fr(c,j) = 0._r8 + end if + end do + end do + + ! calculate rate constant scalar for soil temperature + ! assuming that the base rate constants are assigned for non-moisture + ! limiting conditions at 25 C. + ! Peter Thornton: 3/13/09 + ! Replaced the Lloyd and Taylor function with a Q10 formula, with Q10 = 1.5 + ! as part of the modifications made to improve the seasonal cycle of + ! atmospheric CO2 concentration in global simulations. This does not impact + ! the base rates at 25 C, which are calibrated from microcosm studies. + t_scalar(:) = 0._r8 + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + t_scalar(c)=t_scalar(c) + (1.5**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8))*fr(c,j) + end do + end do + + ! calculate the rate constant scalar for soil water content. + ! Uses the log relationship with water potential given in + ! Andren, O., and K. Paustian, 1987. Barley straw decomposition in the field: + ! a comparison of models. Ecology, 68(5):1190-1200. + ! and supported by data in + ! Orchard, V.A., and F.J. Cook, 1983. Relationship between soil respiration + ! and soil moisture. Soil Biol. Biochem., 15(4):447-453. + + minpsi = -10.0_r8; + w_scalar(:) = 0._r8 + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + maxpsi = psisat(c,j) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c) = w_scalar(c) + (log(minpsi/psi)/log(minpsi/maxpsi))*fr(c,j) + end if + end do + end do + + ! set initial values for potential C and N fluxes + plitr1c_loss(:) = 0._r8 + plitr2c_loss(:) = 0._r8 + plitr3c_loss(:) = 0._r8 + psoil1c_loss(:) = 0._r8 + psoil2c_loss(:) = 0._r8 + psoil3c_loss(:) = 0._r8 + psoil4c_loss(:) = 0._r8 + pmnf_l1s1(:) = 0._r8 + pmnf_l2s2(:) = 0._r8 + pmnf_l3s3(:) = 0._r8 + pmnf_s1s2(:) = 0._r8 + pmnf_s2s3(:) = 0._r8 + pmnf_s3s4(:) = 0._r8 + pmnf_s4(:) = 0._r8 + + ! column loop to calculate potential decomp rates and total immobilization + ! demand. + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate litter compartment C:N ratios + if (litr1n(c) > 0._r8) cn_l1(c) = litr1c(c)/litr1n(c) + if (litr2n(c) > 0._r8) cn_l2(c) = litr2c(c)/litr2n(c) + if (litr3n(c) > 0._r8) cn_l3(c) = litr3c(c)/litr3n(c) + + ! calculate the final rate scalar as the product of temperature and water + ! rate scalars, and correct the base decomp rates + + rate_scalar = t_scalar(c) * w_scalar(c) + ck_l1 = k_l1 * rate_scalar + ck_l2 = k_l2 * rate_scalar + ck_l3 = k_l3 * rate_scalar + ck_s1 = k_s1 * rate_scalar + ck_s2 = k_s2 * rate_scalar + ck_s3 = k_s3 * rate_scalar + ck_s4 = k_s4 * rate_scalar + ck_frag = k_frag * rate_scalar + + ! calculate the non-nitrogen-limited fluxes + ! these fluxes include the "/ dt" term to put them on a + ! per second basis, since the rate constants have been + ! calculated on a per timestep basis. + + ! CWD fragmentation -> litter pools + cwdc_loss = cwdc(c) * ck_frag / dt + cwdc_to_litr2c(c) = cwdc_loss * cwd_fcel + cwdc_to_litr3c(c) = cwdc_loss * cwd_flig + cwdn_loss = cwdn(c) * ck_frag / dt + cwdn_to_litr2n(c) = cwdn_loss * cwd_fcel + cwdn_to_litr3n(c) = cwdn_loss * cwd_flig + + ! litter 1 -> SOM 1 + if (litr1c(c) > 0._r8) then + plitr1c_loss(c) = litr1c(c) * ck_l1 / dt + ratio = 0._r8 + if (litr1n(c) > 0._r8) ratio = cn_s1/cn_l1(c) + pmnf_l1s1(c) = (plitr1c_loss(c) * (1.0_r8 - rf_l1s1 - ratio))/cn_s1 + end if + + ! litter 2 -> SOM 2 + if (litr2c(c) > 0._r8) then + plitr2c_loss(c) = litr2c(c) * ck_l2 / dt + ratio = 0._r8 + if (litr2n(c) > 0._r8) ratio = cn_s2/cn_l2(c) + pmnf_l2s2(c) = (plitr2c_loss(c) * (1.0_r8 - rf_l2s2 - ratio))/cn_s2 + end if + + ! litter 3 -> SOM 3 + if (litr3c(c) > 0._r8) then + plitr3c_loss(c) = litr3c(c) * ck_l3 / dt + ratio = 0._r8 + if (litr3n(c) > 0._r8) ratio = cn_s3/cn_l3(c) + pmnf_l3s3(c) = (plitr3c_loss(c) * (1.0_r8 - rf_l3s3 - ratio))/cn_s3 + end if + + ! SOM 1 -> SOM 2 + if (soil1c(c) > 0._r8) then + psoil1c_loss(c) = soil1c(c) * ck_s1 / dt + pmnf_s1s2(c) = (psoil1c_loss(c) * (1.0_r8 - rf_s1s2 - (cn_s2/cn_s1)))/cn_s2 + end if + + ! SOM 2 -> SOM 3 + if (soil2c(c) > 0._r8) then + psoil2c_loss(c) = soil2c(c) * ck_s2 / dt + pmnf_s2s3(c) = (psoil2c_loss(c) * (1.0_r8 - rf_s2s3 - (cn_s3/cn_s2)))/cn_s3 + end if + + ! SOM 3 -> SOM 4 + if (soil3c(c) > 0._r8) then + psoil3c_loss(c) = soil3c(c) * ck_s3 / dt + pmnf_s3s4(c) = (psoil3c_loss(c) * (1.0_r8 - rf_s3s4 - (cn_s4/cn_s3)))/cn_s4 + end if + + ! Loss from SOM 4 is entirely respiration (no downstream pool) + if (soil4c(c) > 0._r8) then + psoil4c_loss(c) = soil4c(c) * ck_s4 / dt + pmnf_s4(c) = -psoil4c_loss(c)/cn_s4 + end if + + ! Sum up all the potential immobilization fluxes (positive pmnf flux) + ! and all the mineralization fluxes (negative pmnf flux) + + immob(c) = 0._r8 + ! litter 1 -> SOM 1 + if (pmnf_l1s1(c) > 0._r8) then + immob(c) = immob(c) + pmnf_l1s1(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_l1s1(c) + end if + + ! litter 2 -> SOM 2 + if (pmnf_l2s2(c) > 0._r8) then + immob(c) = immob(c) + pmnf_l2s2(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_l2s2(c) + end if + + ! litter 3 -> SOM 3 + if (pmnf_l3s3(c) > 0._r8) then + immob(c) = immob(c) + pmnf_l3s3(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_l3s3(c) + end if + + ! SOM 1 -> SOM 2 + if (pmnf_s1s2(c) > 0._r8) then + immob(c) = immob(c) + pmnf_s1s2(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_s1s2(c) + end if + + ! SOM 2 -> SOM 3 + if (pmnf_s2s3(c) > 0._r8) then + immob(c) = immob(c) + pmnf_s2s3(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_s2s3(c) + end if + + ! SOM 3 -> SOM 4 + if (pmnf_s3s4(c) > 0._r8) then + immob(c) = immob(c) + pmnf_s3s4(c) + else + gross_nmin(c) = gross_nmin(c) - pmnf_s3s4(c) + end if + + ! SOM 4 + gross_nmin(c) = gross_nmin(c) - pmnf_s4(c) + + potential_immob(c) = immob(c) + + end do ! end column loop + + ! now that potential N immobilization is known, call allocation + ! to resolve the competition between plants and soil heterotrophs + ! for available soil mineral N resource. + + call CNAllocation(lbp, ubp, lbc,ubc,num_soilc,filter_soilc,num_soilp, & + filter_soilp, num_pcropp) + + ! column loop to calculate actual immobilization and decomp rates, following + ! resolution of plant/heterotroph competition for mineral N + + dnp = 0.01_r8 + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! upon return from CNAllocation, the fraction of potential immobilization + ! has been set (cps%fpi). now finish the decomp calculations. + ! Only the immobilization steps are limited by fpi (pmnf > 0) + ! Also calculate denitrification losses as a simple proportion + ! of mineralization flux. + + ! litter 1 fluxes (labile pool) + if (litr1c(c) > 0._r8) then + if (pmnf_l1s1(c) > 0._r8) then + plitr1c_loss(c) = plitr1c_loss(c) * fpi(c) + pmnf_l1s1(c) = pmnf_l1s1(c) * fpi(c) + sminn_to_denit_l1s1(c) = 0._r8 + else + sminn_to_denit_l1s1(c) = -dnp * pmnf_l1s1(c) + end if + litr1_hr(c) = rf_l1s1 * plitr1c_loss(c) + litr1c_to_soil1c(c) = (1._r8 - rf_l1s1) * plitr1c_loss(c) + if (litr1n(c) > 0._r8) litr1n_to_soil1n(c) = plitr1c_loss(c) / cn_l1(c) + sminn_to_soil1n_l1(c) = pmnf_l1s1(c) + net_nmin(c) = net_nmin(c) - pmnf_l1s1(c) + end if + + ! litter 2 fluxes (cellulose pool) + if (litr2c(c) > 0._r8) then + if (pmnf_l2s2(c) > 0._r8) then + plitr2c_loss(c) = plitr2c_loss(c) * fpi(c) + pmnf_l2s2(c) = pmnf_l2s2(c) * fpi(c) + sminn_to_denit_l2s2(c) = 0._r8 + else + sminn_to_denit_l2s2(c) = -dnp * pmnf_l2s2(c) + end if + litr2_hr(c) = rf_l2s2 * plitr2c_loss(c) + litr2c_to_soil2c(c) = (1._r8 - rf_l2s2) * plitr2c_loss(c) + if (litr2n(c) > 0._r8) litr2n_to_soil2n(c) = plitr2c_loss(c) / cn_l2(c) + sminn_to_soil2n_l2(c) = pmnf_l2s2(c) + net_nmin(c) = net_nmin(c) - pmnf_l2s2(c) + end if + + ! litter 3 fluxes (lignin pool) + if (litr3c(c) > 0._r8) then + if (pmnf_l3s3(c) > 0._r8) then + plitr3c_loss(c) = plitr3c_loss(c) * fpi(c) + pmnf_l3s3(c) = pmnf_l3s3(c) * fpi(c) + sminn_to_denit_l3s3(c) = 0._r8 + else + sminn_to_denit_l3s3(c) = -dnp * pmnf_l3s3(c) + end if + litr3_hr(c) = rf_l3s3 * plitr3c_loss(c) + litr3c_to_soil3c(c) = (1._r8 - rf_l3s3) * plitr3c_loss(c) + if (litr3n(c) > 0._r8) litr3n_to_soil3n(c) = plitr3c_loss(c) / cn_l3(c) + sminn_to_soil3n_l3(c) = pmnf_l3s3(c) + net_nmin(c) = net_nmin(c) - pmnf_l3s3(c) + end if + + ! SOM 1 fluxes (fast rate soil organic matter pool) + if (soil1c(c) > 0._r8) then + if (pmnf_s1s2(c) > 0._r8) then + psoil1c_loss(c) = psoil1c_loss(c) * fpi(c) + pmnf_s1s2(c) = pmnf_s1s2(c) * fpi(c) + sminn_to_denit_s1s2(c) = 0._r8 + else + sminn_to_denit_s1s2(c) = -dnp * pmnf_s1s2(c) + end if + soil1_hr(c) = rf_s1s2 * psoil1c_loss(c) + soil1c_to_soil2c(c) = (1._r8 - rf_s1s2) * psoil1c_loss(c) + soil1n_to_soil2n(c) = psoil1c_loss(c) / cn_s1 + sminn_to_soil2n_s1(c) = pmnf_s1s2(c) + net_nmin(c) = net_nmin(c) - pmnf_s1s2(c) + end if + + ! SOM 2 fluxes (medium rate soil organic matter pool) + if (soil2c(c) > 0._r8) then + if (pmnf_s2s3(c) > 0._r8) then + psoil2c_loss(c) = psoil2c_loss(c) * fpi(c) + pmnf_s2s3(c) = pmnf_s2s3(c) * fpi(c) + sminn_to_denit_s2s3(c) = 0._r8 + else + sminn_to_denit_s2s3(c) = -dnp * pmnf_s2s3(c) + end if + soil2_hr(c) = rf_s2s3 * psoil2c_loss(c) + soil2c_to_soil3c(c) = (1._r8 - rf_s2s3) * psoil2c_loss(c) + soil2n_to_soil3n(c) = psoil2c_loss(c) / cn_s2 + sminn_to_soil3n_s2(c) = pmnf_s2s3(c) + net_nmin(c) = net_nmin(c) - pmnf_s2s3(c) + end if + + ! SOM 3 fluxes (slow rate soil organic matter pool) + if (soil3c(c) > 0._r8) then + if (pmnf_s3s4(c) > 0._r8) then + psoil3c_loss(c) = psoil3c_loss(c) * fpi(c) + pmnf_s3s4(c) = pmnf_s3s4(c) * fpi(c) + sminn_to_denit_s3s4(c) = 0._r8 + else + sminn_to_denit_s3s4(c) = -dnp * pmnf_s3s4(c) + end if + soil3_hr(c) = rf_s3s4 * psoil3c_loss(c) + soil3c_to_soil4c(c) = (1._r8 - rf_s3s4) * psoil3c_loss(c) + soil3n_to_soil4n(c) = psoil3c_loss(c) / cn_s3 + sminn_to_soil4n_s3(c) = pmnf_s3s4(c) + net_nmin(c) = net_nmin(c) - pmnf_s3s4(c) + end if + + ! SOM 4 fluxes (slowest rate soil organic matter pool) + if (soil4c(c) > 0._r8) then + soil4_hr(c) = psoil4c_loss(c) + soil4n_to_sminn(c) = psoil4c_loss(c) / cn_s4 + sminn_to_denit_s4(c) = -dnp * pmnf_s4(c) + net_nmin(c) = net_nmin(c) - pmnf_s4(c) + end if + + end do + + deallocate(fr) + +end subroutine CNDecompAlloc +!----------------------------------------------------------------------- + +end module CNDecompMod diff --git a/components/clm/src_clm40/biogeochem/CNEcosystemDynMod.F90 b/components/clm/src_clm40/biogeochem/CNEcosystemDynMod.F90 new file mode 100644 index 0000000000..62bcc2ca90 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNEcosystemDynMod.F90 @@ -0,0 +1,259 @@ +module CNEcosystemDynMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNEcosystemDynMod +! +! !DESCRIPTION: +! Ecosystem dynamics: phenology, vegetation +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: flanduse_timeseries, use_c13 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: CNEcosystemDynInit ! Ecosystem dynamics initialization + public :: CNEcosystemDyn ! Ecosystem dynamics: phenology, vegetation +! +! !REVISION HISTORY: +! Created by Peter Thornton +! 19 May 2009: PET - modified to include call to harvest routine +! +! +! !PRIVATE MEMBER FUNCTIONS: +! +! !PRIVATE TYPES: +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNEcosystemDynInit +! +! !INTERFACE: + subroutine CNEcosystemDynInit(lbc, ubc, lbp, ubp ) +! +! !DESCRIPTION: +! Initialzation of the CN Ecosystem dynamics. +! +! !USES: + use CNAllocationMod, only : CNAllocationInit + use CNPhenologyMod , only : CNPhenologyInit +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbp, ubp ! pft bounds +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 04/05/11, Erik Kluzek creation +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + call CNAllocationInit ( lbc, ubc, lbp, ubp ) + call CNPhenologyInit ( lbp, ubp ) + + end subroutine CNEcosystemDynInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNEcosystemDyn +! +! !INTERFACE: + subroutine CNEcosystemDyn(lbc, ubc, lbp, ubp, num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb) +! +! !DESCRIPTION: +! The core CN code is executed here. Calculates fluxes for maintenance +! respiration, decomposition, allocation, phenology, and growth respiration. +! These routines happen on the radiation time step so that canopy structure +! stays synchronized with albedo calculations. +! +! !USES: + use clmtype + use spmdMod , only: masterproc + use CNSetValueMod , only: CNZeroFluxes + use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNLeaching + use CNMRespMod , only: CNMResp + use CNDecompMod , only: CNDecompAlloc + use CNPhenologyMod , only: CNPhenology + use CNGRespMod , only: CNGResp + use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 + use CNNStateUpdate1Mod , only: NStateUpdate1 + use CNGapMortalityMod , only: CNGapMortality + use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h + use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h + use CNFireMod , only: CNFireArea, CNFireFluxes + use CNCStateUpdate3Mod , only: CStateUpdate3 + use CNNStateUpdate3Mod , only: NStateUpdate3 + use CNBalanceCheckMod , only: CBalanceCheck, NBalanceCheck + use CNPrecisionControlMod, only: CNPrecisionControl + use CNVegStructUpdateMod , only: CNVegStructUpdate + use CNAnnualUpdateMod , only: CNAnnualUpdate + use CNSummaryMod , only: CSummary, NSummary + + use CNC13StateUpdate1Mod , only: C13StateUpdate1,C13StateUpdate0 + use CNC13StateUpdate2Mod , only: C13StateUpdate2, C13StateUpdate2h + use CNC13StateUpdate3Mod , only: C13StateUpdate3 + use CNC13FluxMod , only: C13Flux1, C13Flux2, C13Flux2h, C13Flux3 + use C13SummaryMod , only: C13Summary + + use pftdynMod , only: CNHarvest + use CNWoodProductsMod , only: CNWoodProducts +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(ubc-lbc+1) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(ubp-lbp+1) ! filter for soil pfts + integer, intent(in) :: num_pcropp ! number of prog. crop pfts in filter + integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts + logical, intent(in) :: doalb ! true = surface albedo calculation time step +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 10/22/03, Peter Thornton: created from EcosystemDyn during migration to +! new vector code. +! 11/3/03, Peter Thornton: removed update of elai, esai, frac_veg_nosno_alb. +! These are now done in CNVegStructUpdate(), which is called +! prior to SurfaceAlbedo(). +! 11/13/03, Peter Thornton: switched from nolake to soil filtering. +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! +! local pointers to implicit out arguments +! +! !OTHER LOCAL VARIABLES: +! +!EOP +!----------------------------------------------------------------------- + + ! if (doalb) then + + ! Call the main CN routines + call CNZeroFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNNDeposition(lbc, ubc) + + call CNNFixation(num_soilc,filter_soilc) + + call CNMResp(lbc, ubc, num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNDecompAlloc(lbp, ubp, lbc, ubc, num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp) + + ! CNphenology needs to be called after CNdecompAlloc, because it + ! depends on current time-step fluxes to new growth on the last + ! litterfall timestep in deciduous systems + + call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp, filter_pcropp, doalb) + + call CNGResp(num_soilp, filter_soilp) + + call CStateUpdate0(num_soilp, filter_soilp) + + if (use_c13) then + call C13StateUpdate0(num_soilp, filter_soilp) + + call C13Flux1(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13StateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNGapMortality(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13Flux2(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13StateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (flanduse_timeseries /= ' ') then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp) + end if + + if (use_c13) then + call C13Flux2h(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13StateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNWoodProducts(num_soilc, filter_soilc) + + call CNFireArea(num_soilc, filter_soilc) + + call CNFireFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNNLeaching(lbc, ubc, num_soilc, filter_soilc) + + if (use_c13) then + call C13Flux3(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call CStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13StateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (doalb) then + call CNVegStructUpdate(num_soilp, filter_soilp) + end if + +! call CNAnnualUpdate(num_soilc, filter_soilc, num_soilp, filter_soilp) + + call CSummary(num_soilc, filter_soilc, num_soilp, filter_soilp) + + if (use_c13) then + call C13Summary(num_soilc, filter_soilc, num_soilp, filter_soilp) + endif + + call NSummary(num_soilc, filter_soilc, num_soilp, filter_soilp) + +! end if !end of if-doalb block + + end subroutine CNEcosystemDyn + +!----------------------------------------------------------------------- +end module CNEcosystemDynMod diff --git a/components/clm/src_clm40/biogeochem/CNFireMod.F90 b/components/clm/src_clm40/biogeochem/CNFireMod.F90 new file mode 100644 index 0000000000..c703adf9bd --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNFireMod.F90 @@ -0,0 +1,668 @@ +module CNFireMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNFireMod +! +! !DESCRIPTION: +! Module holding routines fire mod +! nitrogen code. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_PI,SHR_CONST_TKFRZ + use pft2colMod , only: p2c + use clm_varctl , only: iulog, use_cn, use_cndv + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNFireArea + public :: CNFireFluxes +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNFireArea +! +! !INTERFACE: +subroutine CNFireArea (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! Computes column-level area affected by fire in each timestep +! based on statistical fire model in Thonicke et al. 2001. +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size, get_nstep, get_days_per_year + use clm_varpar , only: max_pft_per_col + use clm_varcon , only: secspday + use clm_varctl , only: use_nofire +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + ! pft-level + real(r8), pointer :: wtcol(:) ! pft weight on the column + integer , pointer :: ivt(:) ! vegetation type for this pft + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + ! column-level + integer , pointer :: npfts(:) ! number of pfts on the column + integer , pointer :: pfti(:) ! pft index array + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: wf(:) ! soil water as frac. of whc for top 0.5 m + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: totlitc(:) ! (gC/m2) total litter C (not including cwdc) + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + ! PET 5/20/08, test to increase fire area + real(r8), pointer :: totvegc(:) ! (gC/m2) total veg C (column-level mean) + ! pointers for column averaging +! +! local pointers to implicit in/out scalars +! + ! column-level + real(r8), pointer :: me(:) ! column-level moisture of extinction (proportion) + real(r8), pointer :: fire_prob(:) ! daily fire probability (0-1) + real(r8), pointer :: mean_fire_prob(:) ! e-folding mean of daily fire probability (0-1) + real(r8), pointer :: fireseasonl(:) ! annual fire season length (days, <= days/year) + real(r8), pointer :: farea_burned(:) ! fractional area burned in this timestep (proportion) + real(r8), pointer :: ann_farea_burned(:) ! annual total fractional area burned (proportion) +! +! !OTHER LOCAL VARIABLES: +! real(r8), parameter:: minfuel = 200.0_r8 ! dead fuel threshold to carry a fire (gC/m2) +! PET, 5/30/08: changed from 200 to 100 gC/m2, since the original paper didn't specify +! the units as carbon, I am assuming that they were in dry biomass, so carbon would be ~50% + real(r8), parameter:: minfuel = 100.0_r8 ! dead fuel threshold to carry a fire (gC/m2) + real(r8), parameter:: me_woody = 0.3_r8 ! moisture of extinction for woody PFTs (proportion) + real(r8), parameter:: me_herb = 0.2_r8 ! moisture of extinction for herbaceous PFTs (proportion) + real(r8), parameter:: ef_time = 1.0_r8 ! e-folding time constant (years) + integer :: fc,c,pi,p ! index variables + real(r8):: dt ! time step variable (s) + real(r8):: fuelc ! temporary column-level litter + cwd C (gC/m2) + integer :: nef ! number of e-folding timesteps + real(r8):: ef_nsteps ! number of e-folding timesteps (real) + integer :: nstep ! current timestep number + real(r8):: m ! top-layer soil moisture (proportion) + real(r8):: mep ! pft-level moisture of extinction [proportion] + real(r8):: s2 ! (mean_fire_prob - 1.0) + real(r8):: dayspyr ! days per year +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type members (pft-level) + wtcol => pft%wtcol + ivt => pft%itype + pwtgcell => pft%wtgcell + woody => pftcon%woody + + ! assign local pointers to derived type members (column-level) + npfts => col%npfts + pfti => col%pfti + wf => cps%wf + me => cps%me + fire_prob => cps%fire_prob + mean_fire_prob => cps%mean_fire_prob + fireseasonl => cps%fireseasonl + farea_burned => cps%farea_burned + ann_farea_burned => cps%ann_farea_burned + t_grnd => ces%t_grnd + totlitc => ccs%totlitc + cwdc => ccs%cwdc + ! PET 5/20/08, test to increase fire area + totvegc => pcs_a%totvegc + + ! pft to column average for moisture of extinction + do fc = 1,num_soilc + c = filter_soilc(fc) + me(c) = 0._r8 + end do + mep = me_woody + do pi = 1,max_pft_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + if (pwtgcell(p)>0._r8) then + if (woody(ivt(p)) == 1) then + mep = me_woody + else + mep = me_herb + end if + end if + me(c) = me(c) + mep*wtcol(p) + end if + end do + end do + + ! Get model step size + dt = real( get_step_size(), r8 ) + + ! Set the number of timesteps for e-folding. + ! When the simulation has run fewer than this number of steps, + ! re-scale the e-folding time to get a stable early estimate. + nstep = get_nstep() + dayspyr = get_days_per_year() + nef = (ef_time*dayspyr*secspday)/dt + ef_nsteps = max(1,min(nstep,nef)) + + ! test code, added 6/6/05, PET + ! setting ef_nsteps to full count regardless of nstep, to see if this + ! gets rid of transient in fire stats for initial run from spunup + ! initial conditions + ef_nsteps = nef + + ! begin column loop to calculate fractional area affected by fire + + do fc = 1, num_soilc + c = filter_soilc(fc) + + ! dead fuel C (total litter + CWD) + fuelc = totlitc(c) + cwdc(c) + ! PET 5/20/08, test to increase fire area + ! PET, 5/30/08. going back to original treatment using dead fuel only + ! fuelc = fuelc + totvegc(c) + + ! m is the fractional soil mositure in the top layer (taken here + ! as the top 0.5 m) + ! PET 5/30/08 - note that this has been changed in Hydrology to use top 5 cm. + m = max(0._r8,wf(c)) + + + ! Calculate the probability of at least one fire in a day + ! in the gridcell. minfuel is the limit for dead fuels below which + ! fire is assumed unable to spread. + + if (t_grnd(c)>SHR_CONST_TKFRZ .and. fuelc>minfuel .and. me(c)>0._r8 .and. m<=me(c)) then + fire_prob(c) = exp(-SHR_CONST_PI * (m/me(c))**2) + else + fire_prob(c) = 0._r8 + end if + + ! Use e-folding to keep a running mean of daily fire probability, + ! which is then used to calculate annual fractional area burned. + ! mean_fire_prob corresponds to the variable s from Thonicke. + ! fireseasonl corresponds to the variable N from Thonicke. + ! ann_farea_burned corresponds to the variable A from Thonicke. + + mean_fire_prob(c) = (mean_fire_prob(c)*(ef_nsteps-1._r8) + fire_prob(c))/ef_nsteps + fireseasonl(c) = mean_fire_prob(c) * dayspyr + s2 = mean_fire_prob(c)-1._r8 + ann_farea_burned(c) = mean_fire_prob(c)*exp(s2/(0.45_r8*(s2**3) + 2.83_r8*(s2**2) + 2.96_r8*s2 + 1.04_r8)) + + ! Estimate the fractional area of the column affected by fire in this time step. + ! Over a year this should sum to a value near the annual + ! fractional area burned from equations above. + + if (fireseasonl(c) > 0._r8) then + farea_burned(c) = (fire_prob(c)/fireseasonl(c)) * ann_farea_burned(c) * (dt/secspday) + else + farea_burned(c) = 0._r8 + end if + + if (use_nofire) then + ! set the fire area 0 if NOFIRE flag is on + farea_burned(c) = 0._r8 + end if + + end do ! end of column loop + +end subroutine CNFireArea +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNFireFluxes +! +! !INTERFACE: +subroutine CNFireFluxes (num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Fire effects routine for coupled carbon-nitrogen code (CN). +! Relies primarily on estimate of fractional area burned in this +! timestep, from CNFireArea(). +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn() +! +! !REVISION HISTORY: +! 7/23/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: nind(:) ! number of individuals (#/m2) + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: resist(:) ! resistance to fire (no units) + integer , pointer :: pcolumn(:) ! pft's column index + real(r8), pointer :: farea_burned(:) ! timestep fractional area burned (proportion) + real(r8), pointer :: m_cwdc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:) + real(r8), pointer :: m_deadstemc_to_cwdc_fire(:) + real(r8), pointer :: m_litr1c_to_fire(:) + real(r8), pointer :: m_litr2c_to_fire(:) + real(r8), pointer :: m_litr3c_to_fire(:) + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: m_cwdn_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:) + real(r8), pointer :: m_deadstemn_to_cwdn_fire(:) + real(r8), pointer :: m_litr1n_to_fire(:) + real(r8), pointer :: m_litr2n_to_fire(:) + real(r8), pointer :: m_litr3n_to_fire(:) + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) + real(r8), pointer :: m_deadstemc_to_fire(:) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) + real(r8), pointer :: m_frootc_storage_to_fire(:) + real(r8), pointer :: m_frootc_to_fire(:) + real(r8), pointer :: m_frootc_xfer_to_fire(:) + real(r8), pointer :: m_gresp_storage_to_fire(:) + real(r8), pointer :: m_gresp_xfer_to_fire(:) + real(r8), pointer :: m_leafc_storage_to_fire(:) + real(r8), pointer :: m_leafc_to_fire(:) + real(r8), pointer :: m_leafc_xfer_to_fire(:) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) + real(r8), pointer :: m_livecrootc_to_fire(:) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) + real(r8), pointer :: m_livestemc_storage_to_fire(:) + real(r8), pointer :: m_livestemc_to_fire(:) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) !(gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafcmax(:) ! (gC/m2) ann max leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) !(gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: m_deadcrootn_storage_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_litter_fire(:) + real(r8), pointer :: m_deadcrootn_xfer_to_fire(:) + real(r8), pointer :: m_deadstemn_storage_to_fire(:) + real(r8), pointer :: m_deadstemn_to_fire(:) + real(r8), pointer :: m_deadstemn_to_litter_fire(:) + real(r8), pointer :: m_deadstemn_xfer_to_fire(:) + real(r8), pointer :: m_frootn_storage_to_fire(:) + real(r8), pointer :: m_frootn_to_fire(:) + real(r8), pointer :: m_frootn_xfer_to_fire(:) + real(r8), pointer :: m_leafn_storage_to_fire(:) + real(r8), pointer :: m_leafn_to_fire(:) + real(r8), pointer :: m_leafn_xfer_to_fire(:) + real(r8), pointer :: m_livecrootn_storage_to_fire(:) + real(r8), pointer :: m_livecrootn_to_fire(:) + real(r8), pointer :: m_livecrootn_xfer_to_fire(:) + real(r8), pointer :: m_livestemn_storage_to_fire(:) + real(r8), pointer :: m_livestemn_to_fire(:) + real(r8), pointer :: m_livestemn_xfer_to_fire(:) + real(r8), pointer :: m_retransn_to_fire(:) + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N +! +! !OTHER LOCAL VARIABLES: + !real(r8), parameter:: wcf = 0.2_r8 ! wood combustion fraction + real(r8), parameter:: wcf = 0.4_r8 ! wood combustion fraction + integer :: c,p ! indices + integer :: fp,fc ! filter indices + real(r8):: f ! rate for fire effects (1/s) + real(r8):: dt ! time step variable (s) +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + + nind => pdgvs%nind + ivt => pft%itype + pcolumn => pft%column + woody => pftcon%woody + resist => pftcon%resist + farea_burned => cps%farea_burned + m_cwdc_to_fire => ccf%m_cwdc_to_fire + m_deadcrootc_to_cwdc_fire => ccf%m_deadcrootc_to_cwdc_fire + m_deadstemc_to_cwdc_fire => ccf%m_deadstemc_to_cwdc_fire + m_litr1c_to_fire => ccf%m_litr1c_to_fire + m_litr2c_to_fire => ccf%m_litr2c_to_fire + m_litr3c_to_fire => ccf%m_litr3c_to_fire + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + m_cwdn_to_fire => cnf%m_cwdn_to_fire + m_deadcrootn_to_cwdn_fire => cnf%m_deadcrootn_to_cwdn_fire + m_deadstemn_to_cwdn_fire => cnf%m_deadstemn_to_cwdn_fire + m_litr1n_to_fire => cnf%m_litr1n_to_fire + m_litr2n_to_fire => cnf%m_litr2n_to_fire + m_litr3n_to_fire => cnf%m_litr3n_to_fire + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + m_deadcrootc_storage_to_fire => pcf%m_deadcrootc_storage_to_fire + m_deadcrootc_to_fire => pcf%m_deadcrootc_to_fire + m_deadcrootc_to_litter_fire => pcf%m_deadcrootc_to_litter_fire + m_deadcrootc_xfer_to_fire => pcf%m_deadcrootc_xfer_to_fire + m_deadstemc_storage_to_fire => pcf%m_deadstemc_storage_to_fire + m_deadstemc_to_fire => pcf%m_deadstemc_to_fire + m_deadstemc_to_litter_fire => pcf%m_deadstemc_to_litter_fire + m_deadstemc_to_litter => pcf%m_deadstemc_to_litter + m_livestemc_to_litter => pcf%m_livestemc_to_litter + m_deadcrootc_to_litter => pcf%m_deadcrootc_to_litter + m_livecrootc_to_litter => pcf%m_livecrootc_to_litter + m_deadstemc_xfer_to_fire => pcf%m_deadstemc_xfer_to_fire + m_frootc_storage_to_fire => pcf%m_frootc_storage_to_fire + m_frootc_to_fire => pcf%m_frootc_to_fire + m_frootc_xfer_to_fire => pcf%m_frootc_xfer_to_fire + m_gresp_storage_to_fire => pcf%m_gresp_storage_to_fire + m_gresp_xfer_to_fire => pcf%m_gresp_xfer_to_fire + m_leafc_storage_to_fire => pcf%m_leafc_storage_to_fire + m_leafc_to_fire => pcf%m_leafc_to_fire + m_leafc_xfer_to_fire => pcf%m_leafc_xfer_to_fire + m_livecrootc_storage_to_fire => pcf%m_livecrootc_storage_to_fire + m_livecrootc_to_fire => pcf%m_livecrootc_to_fire + m_livecrootc_xfer_to_fire => pcf%m_livecrootc_xfer_to_fire + m_livestemc_storage_to_fire => pcf%m_livestemc_storage_to_fire + m_livestemc_to_fire => pcf%m_livestemc_to_fire + m_livestemc_xfer_to_fire => pcf%m_livestemc_xfer_to_fire + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafcmax => pcs%leafcmax + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + m_deadcrootn_storage_to_fire => pnf%m_deadcrootn_storage_to_fire + m_deadcrootn_to_fire => pnf%m_deadcrootn_to_fire + m_deadcrootn_to_litter_fire => pnf%m_deadcrootn_to_litter_fire + m_deadcrootn_xfer_to_fire => pnf%m_deadcrootn_xfer_to_fire + m_deadstemn_storage_to_fire => pnf%m_deadstemn_storage_to_fire + m_deadstemn_to_fire => pnf%m_deadstemn_to_fire + m_deadstemn_to_litter_fire => pnf%m_deadstemn_to_litter_fire + m_deadstemn_xfer_to_fire => pnf%m_deadstemn_xfer_to_fire + m_frootn_storage_to_fire => pnf%m_frootn_storage_to_fire + m_frootn_to_fire => pnf%m_frootn_to_fire + m_frootn_xfer_to_fire => pnf%m_frootn_xfer_to_fire + m_leafn_storage_to_fire => pnf%m_leafn_storage_to_fire + m_leafn_to_fire => pnf%m_leafn_to_fire + m_leafn_xfer_to_fire => pnf%m_leafn_xfer_to_fire + m_livecrootn_storage_to_fire => pnf%m_livecrootn_storage_to_fire + m_livecrootn_to_fire => pnf%m_livecrootn_to_fire + m_livecrootn_xfer_to_fire => pnf%m_livecrootn_xfer_to_fire + m_livestemn_storage_to_fire => pnf%m_livestemn_storage_to_fire + m_livestemn_to_fire => pnf%m_livestemn_to_fire + m_livestemn_xfer_to_fire => pnf%m_livestemn_xfer_to_fire + m_retransn_to_fire => pnf%m_retransn_to_fire + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + retransn => pns%retransn + + + ! Get model step size + + dt = real( get_step_size(), r8 ) + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + + ! get the column-level fractional area burned for this timestep + ! and convert to a rate per second, then scale by the pft-level + ! fire resistance + f = (farea_burned(c) / dt) * (1._r8 - resist(ivt(p))) + + ! apply this rate to the pft state variables to get flux rates + + ! NOTE: the deadstem and deadcroot pools are only partly consumed + ! by fire, and the remaining affected fraction goes to the column-level + ! as litter (coarse woody debris). This is controlled by wcf, the woody + ! combustion fraction. + + ! carbon fluxes + m_leafc_to_fire(p) = leafc(p) * f + m_leafc_storage_to_fire(p) = leafc_storage(p) * f + m_leafc_xfer_to_fire(p) = leafc_xfer(p) * f + m_frootc_to_fire(p) = frootc(p) * f + m_frootc_storage_to_fire(p) = frootc_storage(p) * f + m_frootc_xfer_to_fire(p) = frootc_xfer(p) * f + m_livestemc_to_fire(p) = livestemc(p) * f + m_livestemc_storage_to_fire(p) = livestemc_storage(p) * f + m_livestemc_xfer_to_fire(p) = livestemc_xfer(p) * f + m_deadstemc_to_fire(p) = deadstemc(p) * f*wcf + m_deadstemc_to_litter_fire(p) = deadstemc(p) * f*(1._r8 - wcf) + m_deadstemc_storage_to_fire(p) = deadstemc_storage(p) * f + m_deadstemc_xfer_to_fire(p) = deadstemc_xfer(p) * f + m_livecrootc_to_fire(p) = livecrootc(p) * f + m_livecrootc_storage_to_fire(p) = livecrootc_storage(p) * f + m_livecrootc_xfer_to_fire(p) = livecrootc_xfer(p) * f + m_deadcrootc_to_fire(p) = deadcrootc(p) * f*wcf + m_deadcrootc_to_litter_fire(p) = deadcrootc(p) * f*(1._r8 - wcf) + m_deadcrootc_storage_to_fire(p) = deadcrootc_storage(p) * f + m_deadcrootc_xfer_to_fire(p) = deadcrootc_xfer(p) * f + m_gresp_storage_to_fire(p) = gresp_storage(p) * f + m_gresp_xfer_to_fire(p) = gresp_xfer(p) * f + + ! nitrogen fluxes + m_leafn_to_fire(p) = leafn(p) * f + m_leafn_storage_to_fire(p) = leafn_storage(p) * f + m_leafn_xfer_to_fire(p) = leafn_xfer(p) * f + m_frootn_to_fire(p) = frootn(p) * f + m_frootn_storage_to_fire(p) = frootn_storage(p) * f + m_frootn_xfer_to_fire(p) = frootn_xfer(p) * f + m_livestemn_to_fire(p) = livestemn(p) * f + m_livestemn_storage_to_fire(p) = livestemn_storage(p) * f + m_livestemn_xfer_to_fire(p) = livestemn_xfer(p) * f + m_deadstemn_to_fire(p) = deadstemn(p) * f*wcf + m_deadstemn_to_litter_fire(p) = deadstemn(p) * f*(1._r8 - wcf) + m_deadstemn_storage_to_fire(p) = deadstemn_storage(p) * f + m_deadstemn_xfer_to_fire(p) = deadstemn_xfer(p) * f + m_livecrootn_to_fire(p) = livecrootn(p) * f + m_livecrootn_storage_to_fire(p) = livecrootn_storage(p) * f + m_livecrootn_xfer_to_fire(p) = livecrootn_xfer(p) * f + m_deadcrootn_to_fire(p) = deadcrootn(p) * f*wcf + m_deadcrootn_to_litter_fire(p) = deadcrootn(p) * f*(1._r8 - wcf) + m_deadcrootn_storage_to_fire(p) = deadcrootn_storage(p) * f + m_deadcrootn_xfer_to_fire(p) = deadcrootn_xfer(p) * f + m_retransn_to_fire(p) = retransn(p) * f + + if (use_cndv) then + ! Carbon per individual (c) remains constant in gap mortality & fire + ! but individuals are removed from the population P (#/m2 naturally + ! vegetated area), so + ! + ! c = Cnew*FPC/Pnew = Cold*FPC/Pold + ! + ! where C = carbon/m2 pft area & FPC = pft area/naturally vegetated area. + ! FPC does not change from mortality or fire. FPC changes from Light and + ! Establishment at the end of the year. So... + ! + ! Pnew = Pold * Cnew / Cold + ! + ! where "new" refers to after mortality & fire, while "old" refers to + ! before mortality & fire. For C I use total wood. (slevis) + ! + ! nind calculation placed here for convenience; nind could be updated + ! once per year instead if we saved Cold for that calculation; + ! as is, nind slowly decreases through the year, while fpcgrid remains + ! unchanged; this affects the htop calculation in CNVegStructUpdate + + if (woody(ivt(p)) == 1._r8) then + if (livestemc(p)+deadstemc(p)+m_livestemc_to_litter(p)*dt+ & + m_deadstemc_to_litter(p)*dt > 0._r8) then + nind(p) = nind(p) * (livestemc(p) + deadstemc(p) + & + livecrootc(p) + deadcrootc(p) - dt * & + (m_livestemc_to_fire(p) + & + m_livecrootc_to_fire(p) + & + m_deadstemc_to_fire(p) + & + m_deadcrootc_to_fire(p) + & + m_deadcrootc_to_litter_fire(p) + & + m_deadstemc_to_litter_fire(p))) / & + (livestemc(p) + deadstemc(p) + & + livecrootc(p) + deadcrootc(p) + dt * & + (m_livestemc_to_litter(p) + & + m_livecrootc_to_litter(p) + & + m_deadcrootc_to_litter(p) + & + m_deadstemc_to_litter(p))) + else + nind(p) = 0._r8 + end if + end if + + ! annual dgvm calculations use lm_ind = leafcmax * fpcgrid / nind + ! leafcmax is reset to 0 once per yr + ! could calculate leafcmax in CSummary instead; if so, should remove + ! subtraction of m_leafc_to_fire(p)*dt from the calculation (slevis) + + leafcmax(p) = max(leafc(p)-m_leafc_to_fire(p)*dt, leafcmax(p)) + if (ivt(p) == 0) leafcmax(p) = 0._r8 + end if + + end do ! end of pfts loop + + ! send the fire affected but uncombusted woody fraction to the column-level cwd fluxes + ! use p2c for weighted averaging from pft to column + call p2c(num_soilc, filter_soilc, m_deadstemc_to_litter_fire, m_deadstemc_to_cwdc_fire) + call p2c(num_soilc, filter_soilc, m_deadcrootc_to_litter_fire, m_deadcrootc_to_cwdc_fire) + call p2c(num_soilc, filter_soilc, m_deadstemn_to_litter_fire, m_deadstemn_to_cwdn_fire) + call p2c(num_soilc, filter_soilc, m_deadcrootn_to_litter_fire, m_deadcrootn_to_cwdn_fire) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! get the column-level fractional area burned for this timestep + ! and convert to a rate per second, then scale by the pft-level + ! fire resistance + + f = farea_burned(c) / dt + + ! apply this rate to the column state variables to get flux rates + + ! NOTE: the coarse woody debris pools are only partly consumed + ! by fire. This is controlled by wcf, the woody + ! combustion fraction. For now using the same fraction for standing + ! wood (deadstem and deadcroot pools) and woody litter (cwd pools). + ! May be a good idea later to modify this to use different fractions + ! for different woody pools, or make the combustion fraction a dynamic + ! variable. + + ! carbon fluxes + m_litr1c_to_fire(c) = litr1c(c) * f + m_litr2c_to_fire(c) = litr2c(c) * f + m_litr3c_to_fire(c) = litr3c(c) * f + m_cwdc_to_fire(c) = cwdc(c) * f*wcf + + ! nitrogen fluxes + m_litr1n_to_fire(c) = litr1n(c) * f + m_litr2n_to_fire(c) = litr2n(c) * f + m_litr3n_to_fire(c) = litr3n(c) * f + m_cwdn_to_fire(c) = cwdn(c) * f*wcf + + end do ! end of column loop + +end subroutine CNFireFluxes +!----------------------------------------------------------------------- + +end module CNFireMod diff --git a/components/clm/src_clm40/biogeochem/CNGRespMod.F90 b/components/clm/src_clm40/biogeochem/CNGRespMod.F90 new file mode 100644 index 0000000000..efadd86e98 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNGRespMod.F90 @@ -0,0 +1,221 @@ +module CNGRespMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNGRespMod +! +! !DESCRIPTION: +! Module for growth respiration fluxes, +! for coupled carbon-nitrogen code. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNGResp +! +! !REVISION HISTORY: +! 9/12/03: Created by Peter Thornton +! 10/27/03, Peter Thornton: migrated to vector data structures +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNGResp +! +! !INTERFACE: +subroutine CNGResp(num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic carbon state +! variables +! +! !USES: + use clmtype + use pftvarcon, only : npcropmin, grperc, grpnow +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: cpool_to_leafc(:) + real(r8), pointer :: cpool_to_leafc_storage(:) + real(r8), pointer :: cpool_to_frootc(:) + real(r8), pointer :: cpool_to_frootc_storage(:) + real(r8), pointer :: cpool_to_livestemc(:) + real(r8), pointer :: cpool_to_livestemc_storage(:) + real(r8), pointer :: cpool_to_deadstemc(:) + real(r8), pointer :: cpool_to_deadstemc_storage(:) + real(r8), pointer :: cpool_to_livecrootc(:) + real(r8), pointer :: cpool_to_livecrootc_storage(:) + real(r8), pointer :: cpool_to_deadcrootc(:) ! allocation to dead coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_storage(:) ! allocation to dead coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C (gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage(:) ! allocation to grain C storage (gC/m2/s) + real(r8), pointer :: grainc_xfer_to_grainc(:) ! grain C growth from storage (gC/m2/s) + real(r8), pointer :: leafc_xfer_to_leafc(:) ! leaf C growth from storage (gC/m2/s) + real(r8), pointer :: frootc_xfer_to_frootc(:) ! fine root C growth from storage (gC/m2/s) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) ! live stem C growth from storage (gC/m2/s) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) ! dead stem C growth from storage (gC/m2/s) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) ! live coarse root C growth from storage (gC/m2/s) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) ! dead coarse root C growth from storage (gC/m2/s) + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: cpool_grain_gr(:) + real(r8), pointer :: cpool_grain_storage_gr(:) + real(r8), pointer :: transfer_grain_gr(:) + real(r8), pointer :: cpool_leaf_gr(:) + real(r8), pointer :: cpool_leaf_storage_gr(:) + real(r8), pointer :: transfer_leaf_gr(:) + real(r8), pointer :: cpool_froot_gr(:) + real(r8), pointer :: cpool_froot_storage_gr(:) + real(r8), pointer :: transfer_froot_gr(:) + real(r8), pointer :: cpool_livestem_gr(:) + real(r8), pointer :: cpool_livestem_storage_gr(:) + real(r8), pointer :: transfer_livestem_gr(:) + real(r8), pointer :: cpool_deadstem_gr(:) + real(r8), pointer :: cpool_deadstem_storage_gr(:) + real(r8), pointer :: transfer_deadstem_gr(:) + real(r8), pointer :: cpool_livecroot_gr(:) + real(r8), pointer :: cpool_livecroot_storage_gr(:) + real(r8), pointer :: transfer_livecroot_gr(:) + real(r8), pointer :: cpool_deadcroot_gr(:) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) + real(r8), pointer :: transfer_deadcroot_gr(:) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + ivt => pft%itype + cpool_to_leafc => pcf%cpool_to_leafc + cpool_to_leafc_storage => pcf%cpool_to_leafc_storage + cpool_to_frootc => pcf%cpool_to_frootc + cpool_to_frootc_storage => pcf%cpool_to_frootc_storage + cpool_to_livestemc => pcf%cpool_to_livestemc + cpool_to_livestemc_storage => pcf%cpool_to_livestemc_storage + cpool_to_deadstemc => pcf%cpool_to_deadstemc + cpool_to_deadstemc_storage => pcf%cpool_to_deadstemc_storage + cpool_to_livecrootc => pcf%cpool_to_livecrootc + cpool_to_livecrootc_storage => pcf%cpool_to_livecrootc_storage + cpool_to_deadcrootc => pcf%cpool_to_deadcrootc + cpool_to_deadcrootc_storage => pcf%cpool_to_deadcrootc_storage + cpool_to_grainc => pcf%cpool_to_grainc + cpool_to_grainc_storage => pcf%cpool_to_grainc_storage + grainc_xfer_to_grainc => pcf%grainc_xfer_to_grainc + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + woody => pftcon%woody + + ! Assign local pointers to derived type arrays (out) + cpool_grain_gr => pcf%cpool_grain_gr + cpool_grain_storage_gr => pcf%cpool_grain_storage_gr + transfer_grain_gr => pcf%transfer_grain_gr + cpool_leaf_gr => pcf%cpool_leaf_gr + cpool_leaf_storage_gr => pcf%cpool_leaf_storage_gr + transfer_leaf_gr => pcf%transfer_leaf_gr + cpool_froot_gr => pcf%cpool_froot_gr + cpool_froot_storage_gr => pcf%cpool_froot_storage_gr + transfer_froot_gr => pcf%transfer_froot_gr + cpool_livestem_gr => pcf%cpool_livestem_gr + cpool_livestem_storage_gr => pcf%cpool_livestem_storage_gr + transfer_livestem_gr => pcf%transfer_livestem_gr + cpool_deadstem_gr => pcf%cpool_deadstem_gr + cpool_deadstem_storage_gr => pcf%cpool_deadstem_storage_gr + transfer_deadstem_gr => pcf%transfer_deadstem_gr + cpool_livecroot_gr => pcf%cpool_livecroot_gr + cpool_livecroot_storage_gr => pcf%cpool_livecroot_storage_gr + transfer_livecroot_gr => pcf%transfer_livecroot_gr + cpool_deadcroot_gr => pcf%cpool_deadcroot_gr + cpool_deadcroot_storage_gr => pcf%cpool_deadcroot_storage_gr + transfer_deadcroot_gr => pcf%transfer_deadcroot_gr + + ! Loop through pfts + ! start pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * & + grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + cpool_grain_gr(p) = cpool_to_grainc(p) * grperc(ivt(p)) + cpool_grain_storage_gr(p) = cpool_to_grainc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_grain_gr(p) = grainc_xfer_to_grainc(p) * grperc(ivt(p)) & + * (1._r8 - grpnow(ivt(p))) + end if + + ! leaf and fine root growth respiration + cpool_leaf_gr(p) = cpool_to_leafc(p) * grperc(ivt(p)) + cpool_leaf_storage_gr(p) = cpool_to_leafc_storage(p) * grperc(ivt(p)) * & + grpnow(ivt(p)) + transfer_leaf_gr(p) = leafc_xfer_to_leafc(p) * grperc(ivt(p)) * & + (1._r8 - grpnow(ivt(p))) + cpool_froot_gr(p) = cpool_to_frootc(p) * grperc(ivt(p)) + cpool_froot_storage_gr(p) = cpool_to_frootc_storage(p) * grperc(ivt(p)) * & + grpnow(ivt(p)) + transfer_froot_gr(p) = frootc_xfer_to_frootc(p) * grperc(ivt(p)) * & + (1._r8 - grpnow(ivt(p))) + + if (woody(ivt(p)) == 1._r8) then + cpool_livestem_gr(p) = cpool_to_livestemc(p) * grperc(ivt(p)) + cpool_livestem_storage_gr(p) = cpool_to_livestemc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_livestem_gr(p) = livestemc_xfer_to_livestemc(p) * & + grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + cpool_deadstem_gr(p) = cpool_to_deadstemc(p) * grperc(ivt(p)) + cpool_deadstem_storage_gr(p) = cpool_to_deadstemc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_deadstem_gr(p) = deadstemc_xfer_to_deadstemc(p) * & + grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + cpool_livecroot_gr(p) = cpool_to_livecrootc(p) * grperc(ivt(p)) + cpool_livecroot_storage_gr(p) = cpool_to_livecrootc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_livecroot_gr(p) = livecrootc_xfer_to_livecrootc(p) * & + grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + cpool_deadcroot_gr(p) = cpool_to_deadcrootc(p) * grperc(ivt(p)) + cpool_deadcroot_storage_gr(p) = cpool_to_deadcrootc_storage(p) * & + grperc(ivt(p)) * grpnow(ivt(p)) + transfer_deadcroot_gr(p) = deadcrootc_xfer_to_deadcrootc(p) * & + grperc(ivt(p)) * (1._r8 - grpnow(ivt(p))) + end if + + end do + +end subroutine CNGResp + +end module CNGRespMod diff --git a/components/clm/src_clm40/biogeochem/CNGapMortalityMod.F90 b/components/clm/src_clm40/biogeochem/CNGapMortalityMod.F90 new file mode 100644 index 0000000000..368f796170 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNGapMortalityMod.F90 @@ -0,0 +1,717 @@ +module CNGapMortalityMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNGapMortalityMod +! +! !DESCRIPTION: +! Module holding routines used in gap mortality for coupled carbon +! nitrogen code. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNGapMortality +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNGapMortality +! +! !INTERFACE: +subroutine CNGapMortality (num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Gap-phase mortality routine for coupled carbon-nitrogen code (CN) +! +! !USES: + use clmtype + use clm_time_manager, only: get_days_per_year + use clm_varcon , only: secspday + use clm_varctl , only: use_cndv +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! column filter for soil points + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! pft filter for soil points +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arrays + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: woody(:) ! binary flag for woody lifeform + ! (1=woody, 0=not woody) + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: greffic(:) + real(r8), pointer :: heatstress(:) +! +! local pointers to implicit in/out arrays +! +! local pointers to implicit out arrays + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafn_to_litter(:) + real(r8), pointer :: m_frootn_to_litter(:) + real(r8), pointer :: m_livestemn_to_litter(:) + real(r8), pointer :: m_deadstemn_to_litter(:) + real(r8), pointer :: m_livecrootn_to_litter(:) + real(r8), pointer :: m_deadcrootn_to_litter(:) + real(r8), pointer :: m_retransn_to_litter(:) + real(r8), pointer :: m_leafn_storage_to_litter(:) + real(r8), pointer :: m_frootn_storage_to_litter(:) + real(r8), pointer :: m_livestemn_storage_to_litter(:) + real(r8), pointer :: m_deadstemn_storage_to_litter(:) + real(r8), pointer :: m_livecrootn_storage_to_litter(:) + real(r8), pointer :: m_deadcrootn_storage_to_litter(:) + real(r8), pointer :: m_leafn_xfer_to_litter(:) + real(r8), pointer :: m_frootn_xfer_to_litter(:) + real(r8), pointer :: m_livestemn_xfer_to_litter(:) + real(r8), pointer :: m_deadstemn_xfer_to_litter(:) + real(r8), pointer :: m_livecrootn_xfer_to_litter(:) + real(r8), pointer :: m_deadcrootn_xfer_to_litter(:) +! +! !OTHER LOCAL VARIABLES: + integer :: p ! pft index + integer :: fp ! pft filter index + real(r8):: am ! rate for fractional mortality (1/yr) + real(r8):: m ! rate for fractional mortality (1/s) + real(r8):: mort_max ! asymptotic max mortality rate (/yr) + real(r8), parameter :: k_mort = 0.3 !coeff of growth efficiency in mortality equation +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + woody => pftcon%woody + + ! assign local pointers to pft-level arrays + ivt => pft%itype + leafc => pcs%leafc + frootc => pcs%frootc + livestemc => pcs%livestemc + deadstemc => pcs%deadstemc + livecrootc => pcs%livecrootc + deadcrootc => pcs%deadcrootc + leafc_storage => pcs%leafc_storage + frootc_storage => pcs%frootc_storage + livestemc_storage => pcs%livestemc_storage + deadstemc_storage => pcs%deadstemc_storage + livecrootc_storage => pcs%livecrootc_storage + deadcrootc_storage => pcs%deadcrootc_storage + gresp_storage => pcs%gresp_storage + leafc_xfer => pcs%leafc_xfer + frootc_xfer => pcs%frootc_xfer + livestemc_xfer => pcs%livestemc_xfer + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc_xfer => pcs%deadcrootc_xfer + gresp_xfer => pcs%gresp_xfer + leafn => pns%leafn + frootn => pns%frootn + livestemn => pns%livestemn + deadstemn => pns%deadstemn + livecrootn => pns%livecrootn + deadcrootn => pns%deadcrootn + retransn => pns%retransn + leafn_storage => pns%leafn_storage + frootn_storage => pns%frootn_storage + livestemn_storage => pns%livestemn_storage + deadstemn_storage => pns%deadstemn_storage + livecrootn_storage => pns%livecrootn_storage + deadcrootn_storage => pns%deadcrootn_storage + leafn_xfer => pns%leafn_xfer + frootn_xfer => pns%frootn_xfer + livestemn_xfer => pns%livestemn_xfer + deadstemn_xfer => pns%deadstemn_xfer + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn_xfer => pns%deadcrootn_xfer + m_leafc_to_litter => pcf%m_leafc_to_litter + m_frootc_to_litter => pcf%m_frootc_to_litter + m_livestemc_to_litter => pcf%m_livestemc_to_litter + m_deadstemc_to_litter => pcf%m_deadstemc_to_litter + m_livecrootc_to_litter => pcf%m_livecrootc_to_litter + m_deadcrootc_to_litter => pcf%m_deadcrootc_to_litter + m_leafc_storage_to_litter => pcf%m_leafc_storage_to_litter + m_frootc_storage_to_litter => pcf%m_frootc_storage_to_litter + m_livestemc_storage_to_litter => pcf%m_livestemc_storage_to_litter + m_deadstemc_storage_to_litter => pcf%m_deadstemc_storage_to_litter + m_livecrootc_storage_to_litter => pcf%m_livecrootc_storage_to_litter + m_deadcrootc_storage_to_litter => pcf%m_deadcrootc_storage_to_litter + m_gresp_storage_to_litter => pcf%m_gresp_storage_to_litter + m_leafc_xfer_to_litter => pcf%m_leafc_xfer_to_litter + m_frootc_xfer_to_litter => pcf%m_frootc_xfer_to_litter + m_livestemc_xfer_to_litter => pcf%m_livestemc_xfer_to_litter + m_deadstemc_xfer_to_litter => pcf%m_deadstemc_xfer_to_litter + m_livecrootc_xfer_to_litter => pcf%m_livecrootc_xfer_to_litter + m_deadcrootc_xfer_to_litter => pcf%m_deadcrootc_xfer_to_litter + m_gresp_xfer_to_litter => pcf%m_gresp_xfer_to_litter + m_leafn_to_litter => pnf%m_leafn_to_litter + m_frootn_to_litter => pnf%m_frootn_to_litter + m_livestemn_to_litter => pnf%m_livestemn_to_litter + m_deadstemn_to_litter => pnf%m_deadstemn_to_litter + m_livecrootn_to_litter => pnf%m_livecrootn_to_litter + m_deadcrootn_to_litter => pnf%m_deadcrootn_to_litter + m_retransn_to_litter => pnf%m_retransn_to_litter + m_leafn_storage_to_litter => pnf%m_leafn_storage_to_litter + m_frootn_storage_to_litter => pnf%m_frootn_storage_to_litter + m_livestemn_storage_to_litter => pnf%m_livestemn_storage_to_litter + m_deadstemn_storage_to_litter => pnf%m_deadstemn_storage_to_litter + m_livecrootn_storage_to_litter => pnf%m_livecrootn_storage_to_litter + m_deadcrootn_storage_to_litter => pnf%m_deadcrootn_storage_to_litter + m_leafn_xfer_to_litter => pnf%m_leafn_xfer_to_litter + m_frootn_xfer_to_litter => pnf%m_frootn_xfer_to_litter + m_livestemn_xfer_to_litter => pnf%m_livestemn_xfer_to_litter + m_deadstemn_xfer_to_litter => pnf%m_deadstemn_xfer_to_litter + m_livecrootn_xfer_to_litter => pnf%m_livecrootn_xfer_to_litter + m_deadcrootn_xfer_to_litter => pnf%m_deadcrootn_xfer_to_litter + greffic => pdgvs%greffic + heatstress => pdgvs%heatstress + + ! set the mortality rate based on annual rate + am = 0.02_r8 + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (use_cndv) then + ! Stress mortality from lpj's subr Mortality. + + if (woody(ivt(p)) == 1._r8) then + + if (ivt(p) == 8) then + mort_max = 0.03_r8 ! BDT boreal + else + mort_max = 0.01_r8 ! original value for all pfts + end if + + ! heatstress and greffic calculated in Establishment once/yr + + ! Mortality rate inversely related to growth efficiency + ! (Prentice et al 1993) + am = mort_max / (1._r8 + k_mort * greffic(p)) + + am = min(1._r8, am + heatstress(p)) + else ! lpj didn't set this for grasses; cn does + ! set the mortality rate based on annual rate + am = 0.02_r8 + end if + end if + + m = am/(get_days_per_year() * secspday) + + ! pft-level gap mortality carbon fluxes + ! displayed pools + m_leafc_to_litter(p) = leafc(p) * m + m_frootc_to_litter(p) = frootc(p) * m + m_livestemc_to_litter(p) = livestemc(p) * m + m_deadstemc_to_litter(p) = deadstemc(p) * m + m_livecrootc_to_litter(p) = livecrootc(p) * m + m_deadcrootc_to_litter(p) = deadcrootc(p) * m + + ! storage pools + m_leafc_storage_to_litter(p) = leafc_storage(p) * m + m_frootc_storage_to_litter(p) = frootc_storage(p) * m + m_livestemc_storage_to_litter(p) = livestemc_storage(p) * m + m_deadstemc_storage_to_litter(p) = deadstemc_storage(p) * m + m_livecrootc_storage_to_litter(p) = livecrootc_storage(p) * m + m_deadcrootc_storage_to_litter(p) = deadcrootc_storage(p) * m + m_gresp_storage_to_litter(p) = gresp_storage(p) * m + + ! transfer pools + m_leafc_xfer_to_litter(p) = leafc_xfer(p) * m + m_frootc_xfer_to_litter(p) = frootc_xfer(p) * m + m_livestemc_xfer_to_litter(p) = livestemc_xfer(p) * m + m_deadstemc_xfer_to_litter(p) = deadstemc_xfer(p) * m + m_livecrootc_xfer_to_litter(p) = livecrootc_xfer(p) * m + m_deadcrootc_xfer_to_litter(p) = deadcrootc_xfer(p) * m + m_gresp_xfer_to_litter(p) = gresp_xfer(p) * m + + ! pft-level gap mortality nitrogen fluxes + ! displayed pools + m_leafn_to_litter(p) = leafn(p) * m + m_frootn_to_litter(p) = frootn(p) * m + m_livestemn_to_litter(p) = livestemn(p) * m + m_deadstemn_to_litter(p) = deadstemn(p) * m + m_livecrootn_to_litter(p) = livecrootn(p) * m + m_deadcrootn_to_litter(p) = deadcrootn(p) * m + m_retransn_to_litter(p) = retransn(p) * m + + ! storage pools + m_leafn_storage_to_litter(p) = leafn_storage(p) * m + m_frootn_storage_to_litter(p) = frootn_storage(p) * m + m_livestemn_storage_to_litter(p) = livestemn_storage(p) * m + m_deadstemn_storage_to_litter(p) = deadstemn_storage(p) * m + m_livecrootn_storage_to_litter(p) = livecrootn_storage(p) * m + m_deadcrootn_storage_to_litter(p) = deadcrootn_storage(p) * m + + ! transfer pools + m_leafn_xfer_to_litter(p) = leafn_xfer(p) * m + m_frootn_xfer_to_litter(p) = frootn_xfer(p) * m + m_livestemn_xfer_to_litter(p) = livestemn_xfer(p) * m + m_deadstemn_xfer_to_litter(p) = deadstemn_xfer(p) * m + m_livecrootn_xfer_to_litter(p) = livecrootn_xfer(p) * m + m_deadcrootn_xfer_to_litter(p) = deadcrootn_xfer(p) * m + + end do ! end of pft loop + + ! gather all pft-level litterfall fluxes to the column + ! for litter C and N inputs + + call CNGapPftToColumn(num_soilc, filter_soilc) + +end subroutine CNGapMortality +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNGapPftToColumn +! +! !INTERFACE: +subroutine CNGapPftToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! called in the middle of CNGapMoratlity to gather all pft-level gap mortality fluxes +! to the column level and assign them to the three litter pools +! +! !USES: + use clmtype + use clm_varpar, only : maxpatch_pft +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter +! +! !CALLED FROM: +! subroutine CNphenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! pft weight relative to column (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafn_to_litter(:) + real(r8), pointer :: m_frootn_to_litter(:) + real(r8), pointer :: m_livestemn_to_litter(:) + real(r8), pointer :: m_deadstemn_to_litter(:) + real(r8), pointer :: m_livecrootn_to_litter(:) + real(r8), pointer :: m_deadcrootn_to_litter(:) + real(r8), pointer :: m_retransn_to_litter(:) + real(r8), pointer :: m_leafn_storage_to_litter(:) + real(r8), pointer :: m_frootn_storage_to_litter(:) + real(r8), pointer :: m_livestemn_storage_to_litter(:) + real(r8), pointer :: m_deadstemn_storage_to_litter(:) + real(r8), pointer :: m_livecrootn_storage_to_litter(:) + real(r8), pointer :: m_deadcrootn_storage_to_litter(:) + real(r8), pointer :: m_leafn_xfer_to_litter(:) + real(r8), pointer :: m_frootn_xfer_to_litter(:) + real(r8), pointer :: m_livestemn_xfer_to_litter(:) + real(r8), pointer :: m_deadstemn_xfer_to_litter(:) + real(r8), pointer :: m_livecrootn_xfer_to_litter(:) + real(r8), pointer :: m_deadcrootn_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: m_leafc_to_litr1c(:) + real(r8), pointer :: m_leafc_to_litr2c(:) + real(r8), pointer :: m_leafc_to_litr3c(:) + real(r8), pointer :: m_frootc_to_litr1c(:) + real(r8), pointer :: m_frootc_to_litr2c(:) + real(r8), pointer :: m_frootc_to_litr3c(:) + real(r8), pointer :: m_livestemc_to_cwdc(:) + real(r8), pointer :: m_deadstemc_to_cwdc(:) + real(r8), pointer :: m_livecrootc_to_cwdc(:) + real(r8), pointer :: m_deadcrootc_to_cwdc(:) + real(r8), pointer :: m_leafc_storage_to_litr1c(:) + real(r8), pointer :: m_frootc_storage_to_litr1c(:) + real(r8), pointer :: m_livestemc_storage_to_litr1c(:) + real(r8), pointer :: m_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: m_gresp_storage_to_litr1c(:) + real(r8), pointer :: m_leafc_xfer_to_litr1c(:) + real(r8), pointer :: m_frootc_xfer_to_litr1c(:) + real(r8), pointer :: m_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: m_gresp_xfer_to_litr1c(:) + real(r8), pointer :: m_leafn_to_litr1n(:) + real(r8), pointer :: m_leafn_to_litr2n(:) + real(r8), pointer :: m_leafn_to_litr3n(:) + real(r8), pointer :: m_frootn_to_litr1n(:) + real(r8), pointer :: m_frootn_to_litr2n(:) + real(r8), pointer :: m_frootn_to_litr3n(:) + real(r8), pointer :: m_livestemn_to_cwdn(:) + real(r8), pointer :: m_deadstemn_to_cwdn(:) + real(r8), pointer :: m_livecrootn_to_cwdn(:) + real(r8), pointer :: m_deadcrootn_to_cwdn(:) + real(r8), pointer :: m_retransn_to_litr1n(:) + real(r8), pointer :: m_leafn_storage_to_litr1n(:) + real(r8), pointer :: m_frootn_storage_to_litr1n(:) + real(r8), pointer :: m_livestemn_storage_to_litr1n(:) + real(r8), pointer :: m_deadstemn_storage_to_litr1n(:) + real(r8), pointer :: m_livecrootn_storage_to_litr1n(:) + real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:) + real(r8), pointer :: m_leafn_xfer_to_litr1n(:) + real(r8), pointer :: m_frootn_xfer_to_litr1n(:) + real(r8), pointer :: m_livestemn_xfer_to_litr1n(:) + real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:) + real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:) + real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:) +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to column-level arrays + npfts => col%npfts + pfti => col%pfti + m_leafc_to_litr1c => ccf%m_leafc_to_litr1c + m_leafc_to_litr2c => ccf%m_leafc_to_litr2c + m_leafc_to_litr3c => ccf%m_leafc_to_litr3c + m_frootc_to_litr1c => ccf%m_frootc_to_litr1c + m_frootc_to_litr2c => ccf%m_frootc_to_litr2c + m_frootc_to_litr3c => ccf%m_frootc_to_litr3c + m_livestemc_to_cwdc => ccf%m_livestemc_to_cwdc + m_deadstemc_to_cwdc => ccf%m_deadstemc_to_cwdc + m_livecrootc_to_cwdc => ccf%m_livecrootc_to_cwdc + m_deadcrootc_to_cwdc => ccf%m_deadcrootc_to_cwdc + m_leafc_storage_to_litr1c => ccf%m_leafc_storage_to_litr1c + m_frootc_storage_to_litr1c => ccf%m_frootc_storage_to_litr1c + m_livestemc_storage_to_litr1c => ccf%m_livestemc_storage_to_litr1c + m_deadstemc_storage_to_litr1c => ccf%m_deadstemc_storage_to_litr1c + m_livecrootc_storage_to_litr1c => ccf%m_livecrootc_storage_to_litr1c + m_deadcrootc_storage_to_litr1c => ccf%m_deadcrootc_storage_to_litr1c + m_gresp_storage_to_litr1c => ccf%m_gresp_storage_to_litr1c + m_leafc_xfer_to_litr1c => ccf%m_leafc_xfer_to_litr1c + m_frootc_xfer_to_litr1c => ccf%m_frootc_xfer_to_litr1c + m_livestemc_xfer_to_litr1c => ccf%m_livestemc_xfer_to_litr1c + m_deadstemc_xfer_to_litr1c => ccf%m_deadstemc_xfer_to_litr1c + m_livecrootc_xfer_to_litr1c => ccf%m_livecrootc_xfer_to_litr1c + m_deadcrootc_xfer_to_litr1c => ccf%m_deadcrootc_xfer_to_litr1c + m_gresp_xfer_to_litr1c => ccf%m_gresp_xfer_to_litr1c + m_leafn_to_litr1n => cnf%m_leafn_to_litr1n + m_leafn_to_litr2n => cnf%m_leafn_to_litr2n + m_leafn_to_litr3n => cnf%m_leafn_to_litr3n + m_frootn_to_litr1n => cnf%m_frootn_to_litr1n + m_frootn_to_litr2n => cnf%m_frootn_to_litr2n + m_frootn_to_litr3n => cnf%m_frootn_to_litr3n + m_livestemn_to_cwdn => cnf%m_livestemn_to_cwdn + m_deadstemn_to_cwdn => cnf%m_deadstemn_to_cwdn + m_livecrootn_to_cwdn => cnf%m_livecrootn_to_cwdn + m_deadcrootn_to_cwdn => cnf%m_deadcrootn_to_cwdn + m_retransn_to_litr1n => cnf%m_retransn_to_litr1n + m_leafn_storage_to_litr1n => cnf%m_leafn_storage_to_litr1n + m_frootn_storage_to_litr1n => cnf%m_frootn_storage_to_litr1n + m_livestemn_storage_to_litr1n => cnf%m_livestemn_storage_to_litr1n + m_deadstemn_storage_to_litr1n => cnf%m_deadstemn_storage_to_litr1n + m_livecrootn_storage_to_litr1n => cnf%m_livecrootn_storage_to_litr1n + m_deadcrootn_storage_to_litr1n => cnf%m_deadcrootn_storage_to_litr1n + m_leafn_xfer_to_litr1n => cnf%m_leafn_xfer_to_litr1n + m_frootn_xfer_to_litr1n => cnf%m_frootn_xfer_to_litr1n + m_livestemn_xfer_to_litr1n => cnf%m_livestemn_xfer_to_litr1n + m_deadstemn_xfer_to_litr1n => cnf%m_deadstemn_xfer_to_litr1n + m_livecrootn_xfer_to_litr1n => cnf%m_livecrootn_xfer_to_litr1n + m_deadcrootn_xfer_to_litr1n => cnf%m_deadcrootn_xfer_to_litr1n + + ! assign local pointers to pft-level arrays + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + m_leafc_to_litter => pcf%m_leafc_to_litter + m_frootc_to_litter => pcf%m_frootc_to_litter + m_livestemc_to_litter => pcf%m_livestemc_to_litter + m_deadstemc_to_litter => pcf%m_deadstemc_to_litter + m_livecrootc_to_litter => pcf%m_livecrootc_to_litter + m_deadcrootc_to_litter => pcf%m_deadcrootc_to_litter + m_leafc_storage_to_litter => pcf%m_leafc_storage_to_litter + m_frootc_storage_to_litter => pcf%m_frootc_storage_to_litter + m_livestemc_storage_to_litter => pcf%m_livestemc_storage_to_litter + m_deadstemc_storage_to_litter => pcf%m_deadstemc_storage_to_litter + m_livecrootc_storage_to_litter => pcf%m_livecrootc_storage_to_litter + m_deadcrootc_storage_to_litter => pcf%m_deadcrootc_storage_to_litter + m_gresp_storage_to_litter => pcf%m_gresp_storage_to_litter + m_leafc_xfer_to_litter => pcf%m_leafc_xfer_to_litter + m_frootc_xfer_to_litter => pcf%m_frootc_xfer_to_litter + m_livestemc_xfer_to_litter => pcf%m_livestemc_xfer_to_litter + m_deadstemc_xfer_to_litter => pcf%m_deadstemc_xfer_to_litter + m_livecrootc_xfer_to_litter => pcf%m_livecrootc_xfer_to_litter + m_deadcrootc_xfer_to_litter => pcf%m_deadcrootc_xfer_to_litter + m_gresp_xfer_to_litter => pcf%m_gresp_xfer_to_litter + m_leafn_to_litter => pnf%m_leafn_to_litter + m_frootn_to_litter => pnf%m_frootn_to_litter + m_livestemn_to_litter => pnf%m_livestemn_to_litter + m_deadstemn_to_litter => pnf%m_deadstemn_to_litter + m_livecrootn_to_litter => pnf%m_livecrootn_to_litter + m_deadcrootn_to_litter => pnf%m_deadcrootn_to_litter + m_retransn_to_litter => pnf%m_retransn_to_litter + m_leafn_storage_to_litter => pnf%m_leafn_storage_to_litter + m_frootn_storage_to_litter => pnf%m_frootn_storage_to_litter + m_livestemn_storage_to_litter => pnf%m_livestemn_storage_to_litter + m_deadstemn_storage_to_litter => pnf%m_deadstemn_storage_to_litter + m_livecrootn_storage_to_litter => pnf%m_livecrootn_storage_to_litter + m_deadcrootn_storage_to_litter => pnf%m_deadcrootn_storage_to_litter + m_leafn_xfer_to_litter => pnf%m_leafn_xfer_to_litter + m_frootn_xfer_to_litter => pnf%m_frootn_xfer_to_litter + m_livestemn_xfer_to_litter => pnf%m_livestemn_xfer_to_litter + m_deadstemn_xfer_to_litter => pnf%m_deadstemn_xfer_to_litter + m_livecrootn_xfer_to_litter => pnf%m_livecrootn_xfer_to_litter + m_deadcrootn_xfer_to_litter => pnf%m_deadcrootn_xfer_to_litter + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + + if (pwtgcell(p)>0._r8) then + + ! leaf gap mortality carbon fluxes + m_leafc_to_litr1c(c) = m_leafc_to_litr1c(c) + & + m_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + m_leafc_to_litr2c(c) = m_leafc_to_litr2c(c) + & + m_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + m_leafc_to_litr3c(c) = m_leafc_to_litr3c(c) + & + m_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root gap mortality carbon fluxes + m_frootc_to_litr1c(c) = m_frootc_to_litr1c(c) + & + m_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + m_frootc_to_litr2c(c) = m_frootc_to_litr2c(c) + & + m_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + m_frootc_to_litr3c(c) = m_frootc_to_litr3c(c) + & + m_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood gap mortality carbon fluxes + m_livestemc_to_cwdc(c) = m_livestemc_to_cwdc(c) + & + m_livestemc_to_litter(p) * wtcol(p) + m_deadstemc_to_cwdc(c) = m_deadstemc_to_cwdc(c) + & + m_deadstemc_to_litter(p) * wtcol(p) + m_livecrootc_to_cwdc(c) = m_livecrootc_to_cwdc(c) + & + m_livecrootc_to_litter(p) * wtcol(p) + m_deadcrootc_to_cwdc(c) = m_deadcrootc_to_cwdc(c) + & + m_deadcrootc_to_litter(p) * wtcol(p) + + ! storage gap mortality carbon fluxes + m_leafc_storage_to_litr1c(c) = m_leafc_storage_to_litr1c(c) + & + m_leafc_storage_to_litter(p) * wtcol(p) + m_frootc_storage_to_litr1c(c) = m_frootc_storage_to_litr1c(c) + & + m_frootc_storage_to_litter(p) * wtcol(p) + m_livestemc_storage_to_litr1c(c) = m_livestemc_storage_to_litr1c(c) + & + m_livestemc_storage_to_litter(p) * wtcol(p) + m_deadstemc_storage_to_litr1c(c) = m_deadstemc_storage_to_litr1c(c) + & + m_deadstemc_storage_to_litter(p) * wtcol(p) + m_livecrootc_storage_to_litr1c(c) = m_livecrootc_storage_to_litr1c(c) + & + m_livecrootc_storage_to_litter(p) * wtcol(p) + m_deadcrootc_storage_to_litr1c(c) = m_deadcrootc_storage_to_litr1c(c) + & + m_deadcrootc_storage_to_litter(p) * wtcol(p) + m_gresp_storage_to_litr1c(c) = m_gresp_storage_to_litr1c(c) + & + m_gresp_storage_to_litter(p) * wtcol(p) + + ! transfer gap mortality carbon fluxes + m_leafc_xfer_to_litr1c(c) = m_leafc_xfer_to_litr1c(c) + & + m_leafc_xfer_to_litter(p) * wtcol(p) + m_frootc_xfer_to_litr1c(c) = m_frootc_xfer_to_litr1c(c) + & + m_frootc_xfer_to_litter(p) * wtcol(p) + m_livestemc_xfer_to_litr1c(c) = m_livestemc_xfer_to_litr1c(c) + & + m_livestemc_xfer_to_litter(p) * wtcol(p) + m_deadstemc_xfer_to_litr1c(c) = m_deadstemc_xfer_to_litr1c(c) + & + m_deadstemc_xfer_to_litter(p) * wtcol(p) + m_livecrootc_xfer_to_litr1c(c) = m_livecrootc_xfer_to_litr1c(c) + & + m_livecrootc_xfer_to_litter(p) * wtcol(p) + m_deadcrootc_xfer_to_litr1c(c) = m_deadcrootc_xfer_to_litr1c(c) + & + m_deadcrootc_xfer_to_litter(p) * wtcol(p) + m_gresp_xfer_to_litr1c(c) = m_gresp_xfer_to_litr1c(c) + & + m_gresp_xfer_to_litter(p) * wtcol(p) + + ! leaf gap mortality nitrogen fluxes + m_leafn_to_litr1n(c) = m_leafn_to_litr1n(c) + & + m_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + m_leafn_to_litr2n(c) = m_leafn_to_litr2n(c) + & + m_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + m_leafn_to_litr3n(c) = m_leafn_to_litr3n(c) + & + m_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root litter nitrogen fluxes + m_frootn_to_litr1n(c) = m_frootn_to_litr1n(c) + & + m_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + m_frootn_to_litr2n(c) = m_frootn_to_litr2n(c) + & + m_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + m_frootn_to_litr3n(c) = m_frootn_to_litr3n(c) + & + m_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood gap mortality nitrogen fluxes + m_livestemn_to_cwdn(c) = m_livestemn_to_cwdn(c) + & + m_livestemn_to_litter(p) * wtcol(p) + m_deadstemn_to_cwdn(c) = m_deadstemn_to_cwdn(c) + & + m_deadstemn_to_litter(p) * wtcol(p) + m_livecrootn_to_cwdn(c) = m_livecrootn_to_cwdn(c) + & + m_livecrootn_to_litter(p) * wtcol(p) + m_deadcrootn_to_cwdn(c) = m_deadcrootn_to_cwdn(c) + & + m_deadcrootn_to_litter(p) * wtcol(p) + + ! retranslocated N pool gap mortality fluxes + m_retransn_to_litr1n(c) = m_retransn_to_litr1n(c) + & + m_retransn_to_litter(p) * wtcol(p) + + ! storage gap mortality nitrogen fluxes + m_leafn_storage_to_litr1n(c) = m_leafn_storage_to_litr1n(c) + & + m_leafn_storage_to_litter(p) * wtcol(p) + m_frootn_storage_to_litr1n(c) = m_frootn_storage_to_litr1n(c) + & + m_frootn_storage_to_litter(p) * wtcol(p) + m_livestemn_storage_to_litr1n(c) = m_livestemn_storage_to_litr1n(c) + & + m_livestemn_storage_to_litter(p) * wtcol(p) + m_deadstemn_storage_to_litr1n(c) = m_deadstemn_storage_to_litr1n(c) + & + m_deadstemn_storage_to_litter(p) * wtcol(p) + m_livecrootn_storage_to_litr1n(c) = m_livecrootn_storage_to_litr1n(c) + & + m_livecrootn_storage_to_litter(p) * wtcol(p) + m_deadcrootn_storage_to_litr1n(c) = m_deadcrootn_storage_to_litr1n(c) + & + m_deadcrootn_storage_to_litter(p) * wtcol(p) + + ! transfer gap mortality nitrogen fluxes + m_leafn_xfer_to_litr1n(c) = m_leafn_xfer_to_litr1n(c) + & + m_leafn_xfer_to_litter(p) * wtcol(p) + m_frootn_xfer_to_litr1n(c) = m_frootn_xfer_to_litr1n(c) + & + m_frootn_xfer_to_litter(p) * wtcol(p) + m_livestemn_xfer_to_litr1n(c) = m_livestemn_xfer_to_litr1n(c) + & + m_livestemn_xfer_to_litter(p) * wtcol(p) + m_deadstemn_xfer_to_litr1n(c) = m_deadstemn_xfer_to_litr1n(c) + & + m_deadstemn_xfer_to_litter(p) * wtcol(p) + m_livecrootn_xfer_to_litr1n(c) = m_livecrootn_xfer_to_litr1n(c) + & + m_livecrootn_xfer_to_litter(p) * wtcol(p) + m_deadcrootn_xfer_to_litr1n(c) = m_deadcrootn_xfer_to_litr1n(c) + & + m_deadcrootn_xfer_to_litter(p) * wtcol(p) + + end if + end if + + end do + + end do + +end subroutine CNGapPftToColumn +!----------------------------------------------------------------------- + +end module CNGapMortalityMod diff --git a/components/clm/src_clm40/biogeochem/CNMRespMod.F90 b/components/clm/src_clm40/biogeochem/CNMRespMod.F90 new file mode 100644 index 0000000000..bf2a1b6f15 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNMRespMod.F90 @@ -0,0 +1,180 @@ +module CNMRespMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNMRespMod +! +! !DESCRIPTION: +! Module holding maintenance respiration routines for coupled carbon +! nitrogen code. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varpar , only: nlevgrnd + use shr_const_mod, only: SHR_CONST_TKFRZ + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNMResp +! +! !REVISION HISTORY: +! 8/14/03: Created by Peter Thornton +! 10/23/03, Peter Thornton: Migrated all subroutines to vector data structures. +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNMResp +! +! !INTERFACE: +subroutine CNMResp(lbc, ubc, num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! +! !USES: + use clmtype + use pftvarcon , only : npcropmin +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: num_soilc ! number of soil points in column filter + integer, intent(in) :: filter_soilc(:) ! column filter for soil points + integer, intent(in) :: num_soilp ! number of soil points in pft filter + integer, intent(in) :: filter_soilp(:) ! pft filter for soil points +! +! !CALLED FROM: +! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 8/14/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in arrays +! + ! column level + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + ! pft level + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: rootfr(:,:) ! fraction of roots in each soil layer (nlevgrnd) + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! index into column level quantities + integer , pointer :: plandunit(:) ! index into landunit level quantities + integer , pointer :: clandunit(:) ! index into landunit level quantities + integer , pointer :: itypelun(:) ! landunit type + ! ecophysiological constants + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + logical , pointer :: croplive(:) ! Flag, true if planted, not harvested +! +! local pointers to implicit in/out arrays +! + ! pft level + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: livecroot_mr(:) +! +! !OTHER LOCAL VARIABLES: + integer :: c,p,j ! indices + integer :: fp ! soil filter pft index + integer :: fc ! soil filter column index + real(r8):: mr ! maintenance respiration (gC/m2/s) + real(r8):: br ! base rate (gC/gN/s) + real(r8):: q10 ! temperature dependence + real(r8):: tc ! temperature correction, 2m air temp (unitless) + real(r8):: tcsoi(lbc:ubc,nlevgrnd) ! temperature correction by soil layer (unitless) +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays + t_soisno => ces%t_soisno + t_ref2m => pes%t_ref2m + leafn => pns%leafn + frootn => pns%frootn + livestemn => pns%livestemn + livecrootn => pns%livecrootn + rootfr => pps%rootfr + leaf_mr => pcf%leaf_mr + froot_mr => pcf%froot_mr + livestem_mr => pcf%livestem_mr + livecroot_mr => pcf%livecroot_mr + ivt => pft%itype + pcolumn => pft%column + plandunit => pft%landunit + clandunit => col%landunit + itypelun => lun%itype + woody => pftcon%woody + croplive => pps%croplive + + ! base rate for maintenance respiration is from: + ! M. Ryan, 1991. Effects of climate change on plant respiration. + ! Ecological Applications, 1(2), 157-167. + ! Original expression is br = 0.0106 molC/(molN h) + ! Conversion by molecular weights of C and N gives 2.525e-6 gC/(gN s) + br = 2.525e-6_r8 + ! Peter Thornton: 3/13/09 + ! Q10 was originally set to 2.0, an arbitrary choice, but reduced to 1.5 as part of the tuning + ! to improve seasonal cycle of atmospheric CO2 concentration in global + ! simulatoins + q10 = 1.5_r8 + + ! column loop to calculate temperature factors in each soil layer + do j=1,nlevgrnd + do fc = 1, num_soilc + c = filter_soilc(fc) + + ! calculate temperature corrections for each soil layer, for use in + ! estimating fine root maintenance respiration with depth + + tcsoi(c,j) = q10**((t_soisno(c,j)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + end do + end do + + ! pft loop for leaves and live wood + do fp = 1, num_soilp + p = filter_soilp(fp) + + ! calculate maintenance respiration fluxes in + ! gC/m2/s for each of the live plant tissues. + ! Leaf and live wood MR + + tc = q10**((t_ref2m(p)-SHR_CONST_TKFRZ - 20.0_r8)/10.0_r8) + leaf_mr(p) = leafn(p)*br*tc + if (woody(ivt(p)) == 1) then + livestem_mr(p) = livestemn(p)*br*tc + livecroot_mr(p) = livecrootn(p)*br*tc + else if (ivt(p) >= npcropmin) then + livestem_mr(p) = livestemn(p)*br*tc + end if + end do + + ! soil and pft loop for fine root + do j = 1,nlevgrnd + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + + ! Fine root MR + ! rootfr(j) sums to 1.0 over all soil layers, and + ! describes the fraction of root mass that is in each + ! layer. This is used with the layer temperature correction + ! to estimate the total fine root maintenance respiration as a + ! function of temperature and N content. + + froot_mr(p) = froot_mr(p) + frootn(p)*br*tcsoi(c,j)*rootfr(p,j) + end do + end do + +end subroutine CNMResp + +end module CNMRespMod diff --git a/components/clm/src_clm40/biogeochem/CNNDynamicsMod.F90 b/components/clm/src_clm40/biogeochem/CNNDynamicsMod.F90 new file mode 100644 index 0000000000..756ababeb8 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNNDynamicsMod.F90 @@ -0,0 +1,268 @@ +module CNNDynamicsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNNDynamicsMod +! +! !DESCRIPTION: +! Module for mineral nitrogen dynamics (deposition, fixation, leaching) +! for coupled carbon-nitrogen code. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNNDeposition + public :: CNNFixation + public :: CNNLeaching +! +! !REVISION HISTORY: +! 6/1/04: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNNDeposition +! +! !INTERFACE: +subroutine CNNDeposition( lbc, ubc ) +! +! !DESCRIPTION: +! On the radiation time step, update the nitrogen deposition rate +! from atmospheric forcing. For now it is assumed that all the atmospheric +! N deposition goes to the soil mineral N pool. +! This could be updated later to divide the inputs between mineral N absorbed +! directly into the canopy and mineral N entering the soil pool. +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds +! +! !CALLED FROM: +! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 6/1/04: Created by Peter Thornton +! 11/06/09: Copy to all columns NOT just over soil. S. Levis +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: forc_ndep(:) ! nitrogen deposition rate (gN/m2/s) + integer , pointer :: gridcell(:) ! index into gridcell level quantities +! +! local pointers to implicit out scalars +! + real(r8), pointer :: ndep_to_sminn(:) +! +! !OTHER LOCAL VARIABLES: + integer :: g,c ! indices + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + forc_ndep => clm_a2l%forc_ndep + gridcell => col%gridcell + + ! Assign local pointers to derived type arrays (out) + ndep_to_sminn => cnf%ndep_to_sminn + + ! Loop through columns + do c = lbc, ubc + g = gridcell(c) + + ndep_to_sminn(c) = forc_ndep(g) + + end do + +end subroutine CNNDeposition + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNNFixation +! +! !INTERFACE: +subroutine CNNFixation(num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, update the nitrogen fixation rate +! as a function of annual total NPP. This rate gets updated once per year. +! All N fixation goes to the soil mineral N pool. +! +! !USES: + use clmtype + use clm_varctl , only: iulog + use clm_time_manager, only: get_days_per_year + use shr_sys_mod , only: shr_sys_flush + use clm_varcon , only: secspday +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNEcosystemDyn, in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 6/1/04: Created by Peter Thornton +! 2/14/05, PET: After looking at a number of point simulations, +! it looks like a constant Nfix might be more efficient and +! maybe more realistic - setting to constant 0.4 gN/m2/yr. +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: cannsum_npp(:) ! nitrogen deposition rate (gN/m2/s) +! +! local pointers to implicit out scalars +! + real(r8), pointer :: nfix_to_sminn(:) +! +! !OTHER LOCAL VARIABLES: + integer :: c,fc ! indices + real(r8) :: t ! temporary + real(r8) :: dayspyr ! days per year + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + cannsum_npp => cps%cannsum_npp + + ! Assign local pointers to derived type arrays (out) + nfix_to_sminn => cnf%nfix_to_sminn + + dayspyr = get_days_per_year() + + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! the value 0.001666 is set to give 100 TgN/yr when global + ! NPP = 60 PgC/yr. (Cleveland et al., 1999) + ! Convert from gN/m2/yr -> gN/m2/s + !t = cannsum_npp(c) * 0.001666_r8 / (secspday * dayspyr) + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + ! PET 2/14/05: commenting out the dependence on NPP, and + ! forcing Nfix to global constant = 0.4 gN/m2/yr + !nfix_to_sminn(c) = 0.4 / (secspday*dayspyr) + + end do + +end subroutine CNNFixation + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNNLeaching +! +! !INTERFACE: +subroutine CNNLeaching(lbc, ubc, num_soilc, filter_soilc) +! +! !DESCRIPTION: +! On the radiation time step, update the nitrogen leaching rate +! as a function of soluble mineral N and total soil water outflow. +! +! !USES: + use clmtype + use clm_varpar , only : nlevsoi + use clm_time_manager , only : get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 6/9/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: qflx_drain(:) ! sub-surface runoff (mm H2O /s) + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N +! +! local pointers to implicit out scalars +! + real(r8), pointer :: sminn_leached(:) ! rate of mineral N leaching (gN/m2/s) +! +! !OTHER LOCAL VARIABLES: + integer :: j,c,fc ! indices + real(r8) :: dt ! radiation time step (seconds) + real(r8) :: tot_water(lbc:ubc) ! total column liquid water (kg water/m2) + real(r8) :: sf ! soluble fraction of mineral N (unitless) + real(r8) :: disn_conc ! dissolved mineral N concentration + ! (gN/kg water) + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + h2osoi_liq => cws%h2osoi_liq + qflx_drain => cwf%qflx_drain + sminn => cns%sminn + + ! Assign local pointers to derived type arrays (out) + sminn_leached => cnf%sminn_leached + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! Assume that 10% of the soil mineral N is in a soluble form + sf = 0.1_r8 + + ! calculate the total soil water + tot_water(lbc:ubc) = 0._r8 + do j = 1,nlevsoi + do fc = 1,num_soilc + c = filter_soilc(fc) + tot_water(c) = tot_water(c) + h2osoi_liq(c,j) + end do + end do + + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate the dissolved mineral N concentration (gN/kg water) + ! assumes that 10% of mineral nitrogen is soluble + disn_conc = 0._r8 + if (tot_water(c) > 0._r8) then + disn_conc = (sf * sminn(c))/tot_water(c) + end if + + ! calculate the N leaching flux as a function of the dissolved + ! concentration and the sub-surface drainage flux + sminn_leached(c) = disn_conc * qflx_drain(c) + + ! limit the flux based on current sminn state + ! only let at most the assumed soluble fraction + ! of sminn be leached on any given timestep + sminn_leached(c) = min(sminn_leached(c), (sf * sminn(c))/dt) + + ! limit the flux to a positive value + sminn_leached(c) = max(sminn_leached(c), 0._r8) + + end do + +end subroutine CNNLeaching + +end module CNNDynamicsMod diff --git a/components/clm/src_clm40/biogeochem/CNNStateUpdate1Mod.F90 b/components/clm/src_clm40/biogeochem/CNNStateUpdate1Mod.F90 new file mode 100644 index 0000000000..a6518f3a75 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNNStateUpdate1Mod.F90 @@ -0,0 +1,537 @@ +module CNNStateUpdate1Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: NStateUpdate1Mod +! +! !DESCRIPTION: +! Module for nitrogen state variable updates, non-mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate1 +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NStateUpdate1 +! +! !INTERFACE: +subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic nitrogen state +! variables (except for gap-phase mortality and fire fluxes) +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use pftvarcon , only: npcropmin, nc3crop + use surfrdMod , only: crop_prog +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: cwdn_to_litr2n(:) ! decomp. of coarse woody debris N to litter 2 N (gN/m2/s) + real(r8), pointer :: cwdn_to_litr3n(:) ! decomp. of coarse woody debris N to litter 3 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr1n(:) ! grain N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr2n(:) ! grain N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr3n(:) ! grain N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr1n(:) ! livestem N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr2n(:) ! livestem N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr3n(:) ! livestem N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr1n(:) ! fine root N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr2n(:) ! fine root N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr3n(:) ! fine root N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr1n(:) ! leaf N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr2n(:) ! leaf N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr3n(:) ! leaf N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: litr1n_to_soil1n(:) + real(r8), pointer :: litr2n_to_soil2n(:) + real(r8), pointer :: litr3n_to_soil3n(:) + real(r8), pointer :: ndep_to_sminn(:) + real(r8), pointer :: nfix_to_sminn(:) ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + real(r8), pointer :: sminn_to_denit_excess(:) + real(r8), pointer :: sminn_to_denit_l1s1(:) + real(r8), pointer :: sminn_to_denit_l2s2(:) + real(r8), pointer :: sminn_to_denit_l3s3(:) + real(r8), pointer :: sminn_to_denit_s1s2(:) + real(r8), pointer :: sminn_to_denit_s2s3(:) + real(r8), pointer :: sminn_to_denit_s3s4(:) + real(r8), pointer :: sminn_to_denit_s4(:) + real(r8), pointer :: sminn_to_plant(:) + real(r8), pointer :: sminn_to_soil1n_l1(:) + real(r8), pointer :: sminn_to_soil2n_l2(:) + real(r8), pointer :: sminn_to_soil2n_s1(:) + real(r8), pointer :: sminn_to_soil3n_l3(:) + real(r8), pointer :: sminn_to_soil3n_s2(:) + real(r8), pointer :: sminn_to_soil4n_s3(:) + real(r8), pointer :: soil1n_to_soil2n(:) + real(r8), pointer :: soil2n_to_soil3n(:) + real(r8), pointer :: soil3n_to_soil4n(:) + real(r8), pointer :: soil4n_to_sminn(:) + real(r8), pointer :: supplement_to_sminn(:) + real(r8), pointer :: deadcrootn_storage_to_xfer(:) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:) + real(r8), pointer :: deadstemn_storage_to_xfer(:) + real(r8), pointer :: deadstemn_xfer_to_deadstemn(:) + real(r8), pointer :: frootn_storage_to_xfer(:) + real(r8), pointer :: frootn_to_litter(:) + real(r8), pointer :: frootn_xfer_to_frootn(:) + real(r8), pointer :: leafn_storage_to_xfer(:) + real(r8), pointer :: leafn_to_litter(:) + real(r8), pointer :: leafn_to_retransn(:) + real(r8), pointer :: leafn_xfer_to_leafn(:) + real(r8), pointer :: livecrootn_storage_to_xfer(:) + real(r8), pointer :: livecrootn_to_deadcrootn(:) + real(r8), pointer :: livecrootn_to_retransn(:) + real(r8), pointer :: livecrootn_xfer_to_livecrootn(:) + real(r8), pointer :: livestemn_storage_to_xfer(:) + real(r8), pointer :: livestemn_to_deadstemn(:) + real(r8), pointer :: livestemn_to_retransn(:) + real(r8), pointer :: livestemn_xfer_to_livestemn(:) + real(r8), pointer :: npool_to_deadcrootn(:) + real(r8), pointer :: npool_to_deadcrootn_storage(:) + real(r8), pointer :: npool_to_deadstemn(:) + real(r8), pointer :: npool_to_deadstemn_storage(:) + real(r8), pointer :: npool_to_frootn(:) + real(r8), pointer :: npool_to_frootn_storage(:) + real(r8), pointer :: npool_to_leafn(:) + real(r8), pointer :: npool_to_leafn_storage(:) + real(r8), pointer :: npool_to_livecrootn(:) + real(r8), pointer :: npool_to_livecrootn_storage(:) + real(r8), pointer :: npool_to_livestemn(:) ! allocation to live stem N (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_storage(:) ! allocation to live stem N storage (gN/m2/s) + real(r8), pointer :: retransn_to_npool(:) ! deployment of retranslocated N (gN/m2/s) + real(r8), pointer :: sminn_to_npool(:) ! deployment of soil mineral N uptake (gN/m2/s) + real(r8), pointer :: grainn_storage_to_xfer(:) ! grain N shift storage to transfer (gN/m2/s) + real(r8), pointer :: grainn_to_food(:) ! grain N to food (gN/m2/s) + real(r8), pointer :: grainn_xfer_to_grainn(:) ! grain N growth from storage (gN/m2/s) + real(r8), pointer :: livestemn_to_litter(:) ! livestem N to litter (gN/m2/s) + real(r8), pointer :: npool_to_grainn(:) ! allocation to grain N (gN/m2/s) + real(r8), pointer :: npool_to_grainn_storage(:) ! allocation to grain N storage (gN/m2/s) +! +! local pointers to implicit in/out scalars + real(r8), pointer :: grainn(:) ! (gN/m2) grain N + real(r8), pointer :: grainn_storage(:) ! (gN/m2) grain N storage + real(r8), pointer :: grainn_xfer(:) ! (gN/m2) grain N transfer + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + real(r8), pointer :: soil1n(:) ! (gN/m2) soil organic matter N (fast pool) + real(r8), pointer :: soil2n(:) ! (gN/m2) soil organic matter N (medium pool) + real(r8), pointer :: soil3n(:) ! (gN/m2) soil orgainc matter N (slow pool) + real(r8), pointer :: soil4n(:) ! (gN/m2) soil orgainc matter N (slowest pool) + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool(:) ! (gN/m2) temporary plant N pool + +! local pointers for dynamic landcover fluxes and states + real(r8), pointer :: dwt_seedn_to_leaf(:) + real(r8), pointer :: dwt_seedn_to_deadstem(:) + real(r8), pointer :: dwt_frootn_to_litr1n(:) + real(r8), pointer :: dwt_frootn_to_litr2n(:) + real(r8), pointer :: dwt_frootn_to_litr3n(:) + real(r8), pointer :: dwt_livecrootn_to_cwdn(:) + real(r8), pointer :: dwt_deadcrootn_to_cwdn(:) + real(r8), pointer :: seedn(:) +! +! local pointers to implicit out scalars + real(r8), pointer :: col_begnb(:) ! nitrogen mass, beginning of time step (gN/m**2) + real(r8), pointer :: pft_begnb(:) ! nitrogen mass, beginning of time step (gN/m**2) +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers + woody => pftcon%woody + + ! assign local pointers at the column level + cwdn_to_litr2n => cnf%cwdn_to_litr2n + cwdn_to_litr3n => cnf%cwdn_to_litr3n + livestemn_to_litr1n => cnf%livestemn_to_litr1n + livestemn_to_litr2n => cnf%livestemn_to_litr2n + livestemn_to_litr3n => cnf%livestemn_to_litr3n + grainn_to_litr1n => cnf%grainn_to_litr1n + grainn_to_litr2n => cnf%grainn_to_litr2n + grainn_to_litr3n => cnf%grainn_to_litr3n + frootn_to_litr1n => cnf%frootn_to_litr1n + frootn_to_litr2n => cnf%frootn_to_litr2n + frootn_to_litr3n => cnf%frootn_to_litr3n + leafn_to_litr1n => cnf%leafn_to_litr1n + leafn_to_litr2n => cnf%leafn_to_litr2n + leafn_to_litr3n => cnf%leafn_to_litr3n + litr1n_to_soil1n => cnf%litr1n_to_soil1n + litr2n_to_soil2n => cnf%litr2n_to_soil2n + litr3n_to_soil3n => cnf%litr3n_to_soil3n + ndep_to_sminn => cnf%ndep_to_sminn + nfix_to_sminn => cnf%nfix_to_sminn + sminn_to_denit_excess => cnf%sminn_to_denit_excess + sminn_to_denit_l1s1 => cnf%sminn_to_denit_l1s1 + sminn_to_denit_l2s2 => cnf%sminn_to_denit_l2s2 + sminn_to_denit_l3s3 => cnf%sminn_to_denit_l3s3 + sminn_to_denit_s1s2 => cnf%sminn_to_denit_s1s2 + sminn_to_denit_s2s3 => cnf%sminn_to_denit_s2s3 + sminn_to_denit_s3s4 => cnf%sminn_to_denit_s3s4 + sminn_to_denit_s4 => cnf%sminn_to_denit_s4 + sminn_to_plant => cnf%sminn_to_plant + sminn_to_soil1n_l1 => cnf%sminn_to_soil1n_l1 + sminn_to_soil2n_l2 => cnf%sminn_to_soil2n_l2 + sminn_to_soil2n_s1 => cnf%sminn_to_soil2n_s1 + sminn_to_soil3n_l3 => cnf%sminn_to_soil3n_l3 + sminn_to_soil3n_s2 => cnf%sminn_to_soil3n_s2 + sminn_to_soil4n_s3 => cnf%sminn_to_soil4n_s3 + soil1n_to_soil2n => cnf%soil1n_to_soil2n + soil2n_to_soil3n => cnf%soil2n_to_soil3n + soil3n_to_soil4n => cnf%soil3n_to_soil4n + soil4n_to_sminn => cnf%soil4n_to_sminn + supplement_to_sminn => cnf%supplement_to_sminn + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + sminn => cns%sminn + soil1n => cns%soil1n + soil2n => cns%soil2n + soil3n => cns%soil3n + soil4n => cns%soil4n + ! new pointers for dynamic landcover + dwt_seedn_to_leaf => cnf%dwt_seedn_to_leaf + dwt_seedn_to_deadstem => cnf%dwt_seedn_to_deadstem + dwt_frootn_to_litr1n => cnf%dwt_frootn_to_litr1n + dwt_frootn_to_litr2n => cnf%dwt_frootn_to_litr2n + dwt_frootn_to_litr3n => cnf%dwt_frootn_to_litr3n + dwt_livecrootn_to_cwdn => cnf%dwt_livecrootn_to_cwdn + dwt_deadcrootn_to_cwdn => cnf%dwt_deadcrootn_to_cwdn + seedn => cns%seedn + + ! assign local pointers at the pft level + ivt => pft%itype + deadcrootn_storage_to_xfer => pnf%deadcrootn_storage_to_xfer + deadcrootn_xfer_to_deadcrootn => pnf%deadcrootn_xfer_to_deadcrootn + deadstemn_storage_to_xfer => pnf%deadstemn_storage_to_xfer + deadstemn_xfer_to_deadstemn => pnf%deadstemn_xfer_to_deadstemn + frootn_storage_to_xfer => pnf%frootn_storage_to_xfer + frootn_to_litter => pnf%frootn_to_litter + frootn_xfer_to_frootn => pnf%frootn_xfer_to_frootn + leafn_storage_to_xfer => pnf%leafn_storage_to_xfer + leafn_to_litter => pnf%leafn_to_litter + leafn_to_retransn => pnf%leafn_to_retransn + leafn_xfer_to_leafn => pnf%leafn_xfer_to_leafn + livecrootn_storage_to_xfer => pnf%livecrootn_storage_to_xfer + livecrootn_to_deadcrootn => pnf%livecrootn_to_deadcrootn + livecrootn_to_retransn => pnf%livecrootn_to_retransn + livecrootn_xfer_to_livecrootn => pnf%livecrootn_xfer_to_livecrootn + livestemn_storage_to_xfer => pnf%livestemn_storage_to_xfer + livestemn_to_deadstemn => pnf%livestemn_to_deadstemn + livestemn_to_retransn => pnf%livestemn_to_retransn + livestemn_xfer_to_livestemn => pnf%livestemn_xfer_to_livestemn + npool_to_deadcrootn => pnf%npool_to_deadcrootn + npool_to_deadcrootn_storage => pnf%npool_to_deadcrootn_storage + npool_to_deadstemn => pnf%npool_to_deadstemn + npool_to_deadstemn_storage => pnf%npool_to_deadstemn_storage + npool_to_frootn => pnf%npool_to_frootn + npool_to_frootn_storage => pnf%npool_to_frootn_storage + npool_to_leafn => pnf%npool_to_leafn + npool_to_leafn_storage => pnf%npool_to_leafn_storage + npool_to_livecrootn => pnf%npool_to_livecrootn + npool_to_livecrootn_storage => pnf%npool_to_livecrootn_storage + npool_to_livestemn => pnf%npool_to_livestemn + npool_to_livestemn_storage => pnf%npool_to_livestemn_storage + retransn_to_npool => pnf%retransn_to_npool + sminn_to_npool => pnf%sminn_to_npool + grainn_storage_to_xfer => pnf%grainn_storage_to_xfer + grainn_to_food => pnf%grainn_to_food + grainn_xfer_to_grainn => pnf%grainn_xfer_to_grainn + livestemn_to_litter => pnf%livestemn_to_litter + npool_to_grainn => pnf%npool_to_grainn + npool_to_grainn_storage => pnf%npool_to_grainn_storage + grainn => pns%grainn + grainn_storage => pns%grainn_storage + grainn_xfer => pns%grainn_xfer + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + npool => pns%npool + retransn => pns%retransn + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column-level fluxes + + ! N deposition and fixation + sminn(c) = sminn(c) + ndep_to_sminn(c)*dt + sminn(c) = sminn(c) + nfix_to_sminn(c)*dt + + ! plant to litter fluxes + ! leaf litter + litr1n(c) = litr1n(c) + leafn_to_litr1n(c)*dt + litr2n(c) = litr2n(c) + leafn_to_litr2n(c)*dt + litr3n(c) = litr3n(c) + leafn_to_litr3n(c)*dt + ! fine root litter + litr1n(c) = litr1n(c) + frootn_to_litr1n(c)*dt + litr2n(c) = litr2n(c) + frootn_to_litr2n(c)*dt + litr3n(c) = litr3n(c) + frootn_to_litr3n(c)*dt + if ( crop_prog )then + ! livestem litter + litr1n(c) = litr1n(c) + livestemn_to_litr1n(c)*dt + litr2n(c) = litr2n(c) + livestemn_to_litr2n(c)*dt + litr3n(c) = litr3n(c) + livestemn_to_litr3n(c)*dt + ! grain litter + litr1n(c) = litr1n(c) + grainn_to_litr1n(c)*dt + litr2n(c) = litr2n(c) + grainn_to_litr2n(c)*dt + litr3n(c) = litr3n(c) + grainn_to_litr3n(c)*dt + end if + + ! seeding fluxes, from dynamic landcover + seedn(c) = seedn(c) - dwt_seedn_to_leaf(c) * dt + seedn(c) = seedn(c) - dwt_seedn_to_deadstem(c) * dt + + ! fluxes into litter and CWD, from dynamic landcover + litr1n(c) = litr1n(c) + dwt_frootn_to_litr1n(c)*dt + litr2n(c) = litr2n(c) + dwt_frootn_to_litr2n(c)*dt + litr3n(c) = litr3n(c) + dwt_frootn_to_litr3n(c)*dt + cwdn(c) = cwdn(c) + dwt_livecrootn_to_cwdn(c)*dt + cwdn(c) = cwdn(c) + dwt_deadcrootn_to_cwdn(c)*dt + + ! CWD to litter fluxes + cwdn(c) = cwdn(c) - cwdn_to_litr2n(c)*dt + litr2n(c) = litr2n(c) + cwdn_to_litr2n(c)*dt + cwdn(c) = cwdn(c) - cwdn_to_litr3n(c)*dt + litr3n(c) = litr3n(c) + cwdn_to_litr3n(c)*dt + + ! update litter states + litr1n(c) = litr1n(c) - litr1n_to_soil1n(c)*dt + litr2n(c) = litr2n(c) - litr2n_to_soil2n(c)*dt + litr3n(c) = litr3n(c) - litr3n_to_soil3n(c)*dt + + ! update SOM states + soil1n(c) = soil1n(c) + & + (litr1n_to_soil1n(c) + sminn_to_soil1n_l1(c) - soil1n_to_soil2n(c))*dt + soil2n(c) = soil2n(c) + & + (litr2n_to_soil2n(c) + sminn_to_soil2n_l2(c) + & + soil1n_to_soil2n(c) + sminn_to_soil2n_s1(c) - soil2n_to_soil3n(c))*dt + soil3n(c) = soil3n(c) + & + (litr3n_to_soil3n(c) + sminn_to_soil3n_l3(c) + & + soil2n_to_soil3n(c) + sminn_to_soil3n_s2(c) - soil3n_to_soil4n(c))*dt + soil4n(c) = soil4n(c) + & + (soil3n_to_soil4n(c) + sminn_to_soil4n_s3(c) - soil4n_to_sminn(c))*dt + + ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes + sminn(c) = sminn(c) - & + (sminn_to_soil1n_l1(c) + sminn_to_soil2n_l2(c) + & + sminn_to_soil3n_l3(c) + sminn_to_soil2n_s1(c) + & + sminn_to_soil3n_s2(c) + sminn_to_soil4n_s3(c) - & + soil4n_to_sminn(c))*dt + + ! denitrification fluxes + sminn(c) = sminn(c) - & + (sminn_to_denit_l1s1(c) + sminn_to_denit_l2s2(c) + & + sminn_to_denit_l3s3(c) + sminn_to_denit_s1s2(c) + & + sminn_to_denit_s2s3(c) + sminn_to_denit_s3s4(c) + & + sminn_to_denit_s4(c) + sminn_to_denit_excess(c))*dt + + ! total plant uptake from mineral N + sminn(c) = sminn(c) - sminn_to_plant(c)*dt + + ! flux that prevents N limitation (when Carbon_only is set) + sminn(c) = sminn(c) + supplement_to_sminn(c)*dt + + end do ! end of column loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! phenology: transfer growth fluxes + leafn(p) = leafn(p) + leafn_xfer_to_leafn(p)*dt + leafn_xfer(p) = leafn_xfer(p) - leafn_xfer_to_leafn(p)*dt + frootn(p) = frootn(p) + frootn_xfer_to_frootn(p)*dt + frootn_xfer(p) = frootn_xfer(p) - frootn_xfer_to_frootn(p)*dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn(p) = livestemn(p) + livestemn_xfer_to_livestemn(p)*dt + livestemn_xfer(p) = livestemn_xfer(p) - livestemn_xfer_to_livestemn(p)*dt + deadstemn(p) = deadstemn(p) + deadstemn_xfer_to_deadstemn(p)*dt + deadstemn_xfer(p) = deadstemn_xfer(p) - deadstemn_xfer_to_deadstemn(p)*dt + livecrootn(p) = livecrootn(p) + livecrootn_xfer_to_livecrootn(p)*dt + livecrootn_xfer(p) = livecrootn_xfer(p) - livecrootn_xfer_to_livecrootn(p)*dt + deadcrootn(p) = deadcrootn(p) + deadcrootn_xfer_to_deadcrootn(p)*dt + deadcrootn_xfer(p) = deadcrootn_xfer(p) - deadcrootn_xfer_to_deadcrootn(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + livestemn(p) = livestemn(p) + livestemn_xfer_to_livestemn(p)*dt + livestemn_xfer(p) = livestemn_xfer(p) - livestemn_xfer_to_livestemn(p)*dt + grainn(p) = grainn(p) + grainn_xfer_to_grainn(p)*dt + grainn_xfer(p) = grainn_xfer(p) - grainn_xfer_to_grainn(p)*dt + end if + + ! phenology: litterfall and retranslocation fluxes + leafn(p) = leafn(p) - leafn_to_litter(p)*dt + frootn(p) = frootn(p) - frootn_to_litter(p)*dt + leafn(p) = leafn(p) - leafn_to_retransn(p)*dt + retransn(p) = retransn(p) + leafn_to_retransn(p)*dt + + ! live wood turnover and retranslocation fluxes + if (woody(ivt(p)) == 1._r8) then + livestemn(p) = livestemn(p) - livestemn_to_deadstemn(p)*dt + deadstemn(p) = deadstemn(p) + livestemn_to_deadstemn(p)*dt + livestemn(p) = livestemn(p) - livestemn_to_retransn(p)*dt + retransn(p) = retransn(p) + livestemn_to_retransn(p)*dt + livecrootn(p) = livecrootn(p) - livecrootn_to_deadcrootn(p)*dt + deadcrootn(p) = deadcrootn(p) + livecrootn_to_deadcrootn(p)*dt + livecrootn(p) = livecrootn(p) - livecrootn_to_retransn(p)*dt + retransn(p) = retransn(p) + livecrootn_to_retransn(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + livestemn(p) = livestemn(p) - livestemn_to_litter(p)*dt + livestemn(p) = livestemn(p) - livestemn_to_retransn(p)*dt + retransn(p) = retransn(p) + livestemn_to_retransn(p)*dt + grainn(p) = grainn(p) - grainn_to_food(p)*dt + end if + + ! uptake from soil mineral N pool + npool(p) = npool(p) + sminn_to_npool(p)*dt + + ! deployment from retranslocation pool + npool(p) = npool(p) + retransn_to_npool(p)*dt + retransn(p) = retransn(p) - retransn_to_npool(p)*dt + + ! allocation fluxes + npool(p) = npool(p) - npool_to_leafn(p)*dt + leafn(p) = leafn(p) + npool_to_leafn(p)*dt + npool(p) = npool(p) - npool_to_leafn_storage(p)*dt + leafn_storage(p) = leafn_storage(p) + npool_to_leafn_storage(p)*dt + npool(p) = npool(p) - npool_to_frootn(p)*dt + frootn(p) = frootn(p) + npool_to_frootn(p)*dt + npool(p) = npool(p) - npool_to_frootn_storage(p)*dt + frootn_storage(p) = frootn_storage(p) + npool_to_frootn_storage(p)*dt + if (woody(ivt(p)) == 1._r8) then + npool(p) = npool(p) - npool_to_livestemn(p)*dt + livestemn(p) = livestemn(p) + npool_to_livestemn(p)*dt + npool(p) = npool(p) - npool_to_livestemn_storage(p)*dt + livestemn_storage(p) = livestemn_storage(p) + npool_to_livestemn_storage(p)*dt + npool(p) = npool(p) - npool_to_deadstemn(p)*dt + deadstemn(p) = deadstemn(p) + npool_to_deadstemn(p)*dt + npool(p) = npool(p) - npool_to_deadstemn_storage(p)*dt + deadstemn_storage(p) = deadstemn_storage(p) + npool_to_deadstemn_storage(p)*dt + npool(p) = npool(p) - npool_to_livecrootn(p)*dt + livecrootn(p) = livecrootn(p) + npool_to_livecrootn(p)*dt + npool(p) = npool(p) - npool_to_livecrootn_storage(p)*dt + livecrootn_storage(p) = livecrootn_storage(p) + npool_to_livecrootn_storage(p)*dt + npool(p) = npool(p) - npool_to_deadcrootn(p)*dt + deadcrootn(p) = deadcrootn(p) + npool_to_deadcrootn(p)*dt + npool(p) = npool(p) - npool_to_deadcrootn_storage(p)*dt + deadcrootn_storage(p) = deadcrootn_storage(p) + npool_to_deadcrootn_storage(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + npool(p) = npool(p) - npool_to_livestemn(p)*dt + livestemn(p) = livestemn(p) + npool_to_livestemn(p)*dt + npool(p) = npool(p) - npool_to_livestemn_storage(p)*dt + livestemn_storage(p) = livestemn_storage(p) + npool_to_livestemn_storage(p)*dt + npool(p) = npool(p) - npool_to_grainn(p)*dt + grainn(p) = grainn(p) + npool_to_grainn(p)*dt + npool(p) = npool(p) - npool_to_grainn_storage(p)*dt + grainn_storage(p) = grainn_storage(p) + npool_to_grainn_storage(p)*dt + end if + + ! move storage pools into transfer pools + leafn_storage(p) = leafn_storage(p) - leafn_storage_to_xfer(p)*dt + leafn_xfer(p) = leafn_xfer(p) + leafn_storage_to_xfer(p)*dt + frootn_storage(p) = frootn_storage(p) - frootn_storage_to_xfer(p)*dt + frootn_xfer(p) = frootn_xfer(p) + frootn_storage_to_xfer(p)*dt + if (woody(ivt(p)) == 1._r8) then + livestemn_storage(p) = livestemn_storage(p) - livestemn_storage_to_xfer(p)*dt + livestemn_xfer(p) = livestemn_xfer(p) + livestemn_storage_to_xfer(p)*dt + deadstemn_storage(p) = deadstemn_storage(p) - deadstemn_storage_to_xfer(p)*dt + deadstemn_xfer(p) = deadstemn_xfer(p) + deadstemn_storage_to_xfer(p)*dt + livecrootn_storage(p) = livecrootn_storage(p) - livecrootn_storage_to_xfer(p)*dt + livecrootn_xfer(p) = livecrootn_xfer(p) + livecrootn_storage_to_xfer(p)*dt + deadcrootn_storage(p) = deadcrootn_storage(p) - deadcrootn_storage_to_xfer(p)*dt + deadcrootn_xfer(p) = deadcrootn_xfer(p) + deadcrootn_storage_to_xfer(p)*dt + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + ! lines here for consistency; the transfer terms are zero + livestemn_storage(p) = livestemn_storage(p) - livestemn_storage_to_xfer(p)*dt + livestemn_xfer(p) = livestemn_xfer(p) + livestemn_storage_to_xfer(p)*dt + grainn_storage(p) = grainn_storage(p) - grainn_storage_to_xfer(p)*dt + grainn_xfer(p) = grainn_xfer(p) + grainn_storage_to_xfer(p)*dt + end if + + end do + +end subroutine NStateUpdate1 +!----------------------------------------------------------------------- + +end module CNNStateUpdate1Mod diff --git a/components/clm/src_clm40/biogeochem/CNNStateUpdate2Mod.F90 b/components/clm/src_clm40/biogeochem/CNNStateUpdate2Mod.F90 new file mode 100644 index 0000000000..a26e4c87cc --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNNStateUpdate2Mod.F90 @@ -0,0 +1,550 @@ +module CNNStateUpdate2Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: NStateUpdate2Mod +! +! !DESCRIPTION: +! Module for nitrogen state variable update, mortality fluxes. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate2 + public:: NStateUpdate2h +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NStateUpdate2 +! +! !INTERFACE: +subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic nitrogen state +! variables affected by gap-phase mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:) + real(r8), pointer :: m_deadcrootn_to_cwdn(:) + real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:) + real(r8), pointer :: m_deadstemn_storage_to_litr1n(:) + real(r8), pointer :: m_deadstemn_to_cwdn(:) + real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:) + real(r8), pointer :: m_frootn_storage_to_litr1n(:) + real(r8), pointer :: m_frootn_to_litr1n(:) + real(r8), pointer :: m_frootn_to_litr2n(:) + real(r8), pointer :: m_frootn_to_litr3n(:) + real(r8), pointer :: m_frootn_xfer_to_litr1n(:) + real(r8), pointer :: m_leafn_storage_to_litr1n(:) + real(r8), pointer :: m_leafn_to_litr1n(:) + real(r8), pointer :: m_leafn_to_litr2n(:) + real(r8), pointer :: m_leafn_to_litr3n(:) + real(r8), pointer :: m_leafn_xfer_to_litr1n(:) + real(r8), pointer :: m_livecrootn_storage_to_litr1n(:) + real(r8), pointer :: m_livecrootn_to_cwdn(:) + real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:) + real(r8), pointer :: m_livestemn_storage_to_litr1n(:) + real(r8), pointer :: m_livestemn_to_cwdn(:) + real(r8), pointer :: m_livestemn_xfer_to_litr1n(:) + real(r8), pointer :: m_retransn_to_litr1n(:) + real(r8), pointer :: m_deadcrootn_storage_to_litter(:) + real(r8), pointer :: m_deadcrootn_to_litter(:) + real(r8), pointer :: m_deadcrootn_xfer_to_litter(:) + real(r8), pointer :: m_deadstemn_storage_to_litter(:) + real(r8), pointer :: m_deadstemn_to_litter(:) + real(r8), pointer :: m_deadstemn_xfer_to_litter(:) + real(r8), pointer :: m_frootn_storage_to_litter(:) + real(r8), pointer :: m_frootn_to_litter(:) + real(r8), pointer :: m_frootn_xfer_to_litter(:) + real(r8), pointer :: m_leafn_storage_to_litter(:) + real(r8), pointer :: m_leafn_to_litter(:) + real(r8), pointer :: m_leafn_xfer_to_litter(:) + real(r8), pointer :: m_livecrootn_storage_to_litter(:) + real(r8), pointer :: m_livecrootn_to_litter(:) + real(r8), pointer :: m_livecrootn_xfer_to_litter(:) + real(r8), pointer :: m_livestemn_storage_to_litter(:) + real(r8), pointer :: m_livestemn_to_litter(:) + real(r8), pointer :: m_livestemn_xfer_to_litter(:) + real(r8), pointer :: m_retransn_to_litter(:) +! +! local pointers to implicit in/out scalars + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + m_deadcrootn_storage_to_litr1n => cnf%m_deadcrootn_storage_to_litr1n + m_deadcrootn_to_cwdn => cnf%m_deadcrootn_to_cwdn + m_deadcrootn_xfer_to_litr1n => cnf%m_deadcrootn_xfer_to_litr1n + m_deadstemn_storage_to_litr1n => cnf%m_deadstemn_storage_to_litr1n + m_deadstemn_to_cwdn => cnf%m_deadstemn_to_cwdn + m_deadstemn_xfer_to_litr1n => cnf%m_deadstemn_xfer_to_litr1n + m_frootn_storage_to_litr1n => cnf%m_frootn_storage_to_litr1n + m_frootn_to_litr1n => cnf%m_frootn_to_litr1n + m_frootn_to_litr2n => cnf%m_frootn_to_litr2n + m_frootn_to_litr3n => cnf%m_frootn_to_litr3n + m_frootn_xfer_to_litr1n => cnf%m_frootn_xfer_to_litr1n + m_leafn_storage_to_litr1n => cnf%m_leafn_storage_to_litr1n + m_leafn_to_litr1n => cnf%m_leafn_to_litr1n + m_leafn_to_litr2n => cnf%m_leafn_to_litr2n + m_leafn_to_litr3n => cnf%m_leafn_to_litr3n + m_leafn_xfer_to_litr1n => cnf%m_leafn_xfer_to_litr1n + m_livecrootn_storage_to_litr1n => cnf%m_livecrootn_storage_to_litr1n + m_livecrootn_to_cwdn => cnf%m_livecrootn_to_cwdn + m_livecrootn_xfer_to_litr1n => cnf%m_livecrootn_xfer_to_litr1n + m_livestemn_storage_to_litr1n => cnf%m_livestemn_storage_to_litr1n + m_livestemn_to_cwdn => cnf%m_livestemn_to_cwdn + m_livestemn_xfer_to_litr1n => cnf%m_livestemn_xfer_to_litr1n + m_retransn_to_litr1n => cnf%m_retransn_to_litr1n + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + + ! assign local pointers at the pft level + m_deadcrootn_storage_to_litter => pnf%m_deadcrootn_storage_to_litter + m_deadcrootn_to_litter => pnf%m_deadcrootn_to_litter + m_deadcrootn_xfer_to_litter => pnf%m_deadcrootn_xfer_to_litter + m_deadstemn_storage_to_litter => pnf%m_deadstemn_storage_to_litter + m_deadstemn_to_litter => pnf%m_deadstemn_to_litter + m_deadstemn_xfer_to_litter => pnf%m_deadstemn_xfer_to_litter + m_frootn_storage_to_litter => pnf%m_frootn_storage_to_litter + m_frootn_to_litter => pnf%m_frootn_to_litter + m_frootn_xfer_to_litter => pnf%m_frootn_xfer_to_litter + m_leafn_storage_to_litter => pnf%m_leafn_storage_to_litter + m_leafn_to_litter => pnf%m_leafn_to_litter + m_leafn_xfer_to_litter => pnf%m_leafn_xfer_to_litter + m_livecrootn_storage_to_litter => pnf%m_livecrootn_storage_to_litter + m_livecrootn_to_litter => pnf%m_livecrootn_to_litter + m_livecrootn_xfer_to_litter => pnf%m_livecrootn_xfer_to_litter + m_livestemn_storage_to_litter => pnf%m_livestemn_storage_to_litter + m_livestemn_to_litter => pnf%m_livestemn_to_litter + m_livestemn_xfer_to_litter => pnf%m_livestemn_xfer_to_litter + m_retransn_to_litter => pnf%m_retransn_to_litter + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + retransn => pns%retransn + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column-level nitrogen fluxes from gap-phase mortality + + ! leaf to litter + litr1n(c) = litr1n(c) + m_leafn_to_litr1n(c) * dt + litr2n(c) = litr2n(c) + m_leafn_to_litr2n(c) * dt + litr3n(c) = litr3n(c) + m_leafn_to_litr3n(c) * dt + + ! fine root to litter + litr1n(c) = litr1n(c) + m_frootn_to_litr1n(c) * dt + litr2n(c) = litr2n(c) + m_frootn_to_litr2n(c) * dt + litr3n(c) = litr3n(c) + m_frootn_to_litr3n(c) * dt + + ! wood to CWD + cwdn(c) = cwdn(c) + m_livestemn_to_cwdn(c) * dt + cwdn(c) = cwdn(c) + m_deadstemn_to_cwdn(c) * dt + cwdn(c) = cwdn(c) + m_livecrootn_to_cwdn(c) * dt + cwdn(c) = cwdn(c) + m_deadcrootn_to_cwdn(c) * dt + + ! retranslocated N pool to litter + litr1n(c) = litr1n(c) + m_retransn_to_litr1n(c) * dt + + ! storage pools to litter + litr1n(c) = litr1n(c) + m_leafn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_frootn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_livestemn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_deadstemn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_livecrootn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_deadcrootn_storage_to_litr1n(c) * dt + + ! transfer pools to litter + litr1n(c) = litr1n(c) + m_leafn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_frootn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_livestemn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_deadstemn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_livecrootn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + m_deadcrootn_xfer_to_litr1n(c) * dt + + end do ! end of column loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level nitrogen fluxes from gap-phase mortality + ! displayed pools + leafn(p) = leafn(p) - m_leafn_to_litter(p) * dt + frootn(p) = frootn(p) - m_frootn_to_litter(p) * dt + livestemn(p) = livestemn(p) - m_livestemn_to_litter(p) * dt + deadstemn(p) = deadstemn(p) - m_deadstemn_to_litter(p) * dt + livecrootn(p) = livecrootn(p) - m_livecrootn_to_litter(p) * dt + deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_litter(p) * dt + retransn(p) = retransn(p) - m_retransn_to_litter(p) * dt + + ! storage pools + leafn_storage(p) = leafn_storage(p) - m_leafn_storage_to_litter(p) * dt + frootn_storage(p) = frootn_storage(p) - m_frootn_storage_to_litter(p) * dt + livestemn_storage(p) = livestemn_storage(p) - m_livestemn_storage_to_litter(p) * dt + deadstemn_storage(p) = deadstemn_storage(p) - m_deadstemn_storage_to_litter(p) * dt + livecrootn_storage(p) = livecrootn_storage(p) - m_livecrootn_storage_to_litter(p) * dt + deadcrootn_storage(p) = deadcrootn_storage(p) - m_deadcrootn_storage_to_litter(p) * dt + + ! transfer pools + leafn_xfer(p) = leafn_xfer(p) - m_leafn_xfer_to_litter(p) * dt + frootn_xfer(p) = frootn_xfer(p) - m_frootn_xfer_to_litter(p) * dt + livestemn_xfer(p) = livestemn_xfer(p) - m_livestemn_xfer_to_litter(p) * dt + deadstemn_xfer(p) = deadstemn_xfer(p) - m_deadstemn_xfer_to_litter(p) * dt + livecrootn_xfer(p) = livecrootn_xfer(p) - m_livecrootn_xfer_to_litter(p) * dt + deadcrootn_xfer(p) = deadcrootn_xfer(p) - m_deadcrootn_xfer_to_litter(p) * dt + + end do + +end subroutine NStateUpdate2 +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NStateUpdate2h +! +! !INTERFACE: +subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Update all the prognostic nitrogen state +! variables affected by harvest mortality fluxes +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_deadcrootn_to_cwdn(:) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:) + real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_frootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_frootn_to_litr1n(:) + real(r8), pointer :: hrv_frootn_to_litr2n(:) + real(r8), pointer :: hrv_frootn_to_litr3n(:) + real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_leafn_storage_to_litr1n(:) + real(r8), pointer :: hrv_leafn_to_litr1n(:) + real(r8), pointer :: hrv_leafn_to_litr2n(:) + real(r8), pointer :: hrv_leafn_to_litr3n(:) + real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_livecrootn_to_cwdn(:) + real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:) + real(r8), pointer :: hrv_livestemn_to_cwdn(:) + real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_retransn_to_litr1n(:) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemn_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemn_to_prod10n(:) + real(r8), pointer :: hrv_deadstemn_to_prod100n(:) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:) + real(r8), pointer :: hrv_frootn_storage_to_litter(:) + real(r8), pointer :: hrv_frootn_to_litter(:) + real(r8), pointer :: hrv_frootn_xfer_to_litter(:) + real(r8), pointer :: hrv_leafn_storage_to_litter(:) + real(r8), pointer :: hrv_leafn_to_litter(:) + real(r8), pointer :: hrv_leafn_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootn_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootn_to_litter(:) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemn_storage_to_litter(:) + real(r8), pointer :: hrv_livestemn_to_litter(:) + real(r8), pointer :: hrv_livestemn_xfer_to_litter(:) + real(r8), pointer :: hrv_retransn_to_litter(:) +! +! local pointers to implicit in/out scalars + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + hrv_deadcrootn_storage_to_litr1n => cnf%hrv_deadcrootn_storage_to_litr1n + hrv_deadcrootn_to_cwdn => cnf%hrv_deadcrootn_to_cwdn + hrv_deadcrootn_xfer_to_litr1n => cnf%hrv_deadcrootn_xfer_to_litr1n + hrv_deadstemn_storage_to_litr1n => cnf%hrv_deadstemn_storage_to_litr1n + hrv_deadstemn_xfer_to_litr1n => cnf%hrv_deadstemn_xfer_to_litr1n + hrv_frootn_storage_to_litr1n => cnf%hrv_frootn_storage_to_litr1n + hrv_frootn_to_litr1n => cnf%hrv_frootn_to_litr1n + hrv_frootn_to_litr2n => cnf%hrv_frootn_to_litr2n + hrv_frootn_to_litr3n => cnf%hrv_frootn_to_litr3n + hrv_frootn_xfer_to_litr1n => cnf%hrv_frootn_xfer_to_litr1n + hrv_leafn_storage_to_litr1n => cnf%hrv_leafn_storage_to_litr1n + hrv_leafn_to_litr1n => cnf%hrv_leafn_to_litr1n + hrv_leafn_to_litr2n => cnf%hrv_leafn_to_litr2n + hrv_leafn_to_litr3n => cnf%hrv_leafn_to_litr3n + hrv_leafn_xfer_to_litr1n => cnf%hrv_leafn_xfer_to_litr1n + hrv_livecrootn_storage_to_litr1n => cnf%hrv_livecrootn_storage_to_litr1n + hrv_livecrootn_to_cwdn => cnf%hrv_livecrootn_to_cwdn + hrv_livecrootn_xfer_to_litr1n => cnf%hrv_livecrootn_xfer_to_litr1n + hrv_livestemn_storage_to_litr1n => cnf%hrv_livestemn_storage_to_litr1n + hrv_livestemn_to_cwdn => cnf%hrv_livestemn_to_cwdn + hrv_livestemn_xfer_to_litr1n => cnf%hrv_livestemn_xfer_to_litr1n + hrv_retransn_to_litr1n => cnf%hrv_retransn_to_litr1n + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + + ! assign local pointers at the pft level + hrv_deadcrootn_storage_to_litter => pnf%hrv_deadcrootn_storage_to_litter + hrv_deadcrootn_to_litter => pnf%hrv_deadcrootn_to_litter + hrv_deadcrootn_xfer_to_litter => pnf%hrv_deadcrootn_xfer_to_litter + hrv_deadstemn_storage_to_litter => pnf%hrv_deadstemn_storage_to_litter + hrv_deadstemn_to_prod10n => pnf%hrv_deadstemn_to_prod10n + hrv_deadstemn_to_prod100n => pnf%hrv_deadstemn_to_prod100n + hrv_deadstemn_xfer_to_litter => pnf%hrv_deadstemn_xfer_to_litter + hrv_frootn_storage_to_litter => pnf%hrv_frootn_storage_to_litter + hrv_frootn_to_litter => pnf%hrv_frootn_to_litter + hrv_frootn_xfer_to_litter => pnf%hrv_frootn_xfer_to_litter + hrv_leafn_storage_to_litter => pnf%hrv_leafn_storage_to_litter + hrv_leafn_to_litter => pnf%hrv_leafn_to_litter + hrv_leafn_xfer_to_litter => pnf%hrv_leafn_xfer_to_litter + hrv_livecrootn_storage_to_litter => pnf%hrv_livecrootn_storage_to_litter + hrv_livecrootn_to_litter => pnf%hrv_livecrootn_to_litter + hrv_livecrootn_xfer_to_litter => pnf%hrv_livecrootn_xfer_to_litter + hrv_livestemn_storage_to_litter => pnf%hrv_livestemn_storage_to_litter + hrv_livestemn_to_litter => pnf%hrv_livestemn_to_litter + hrv_livestemn_xfer_to_litter => pnf%hrv_livestemn_xfer_to_litter + hrv_retransn_to_litter => pnf%hrv_retransn_to_litter + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + retransn => pns%retransn + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column-level nitrogen fluxes from harvest mortality + + ! leaf to litter + litr1n(c) = litr1n(c) + hrv_leafn_to_litr1n(c) * dt + litr2n(c) = litr2n(c) + hrv_leafn_to_litr2n(c) * dt + litr3n(c) = litr3n(c) + hrv_leafn_to_litr3n(c) * dt + + ! fine root to litter + litr1n(c) = litr1n(c) + hrv_frootn_to_litr1n(c) * dt + litr2n(c) = litr2n(c) + hrv_frootn_to_litr2n(c) * dt + litr3n(c) = litr3n(c) + hrv_frootn_to_litr3n(c) * dt + + ! wood to CWD + cwdn(c) = cwdn(c) + hrv_livestemn_to_cwdn(c) * dt + cwdn(c) = cwdn(c) + hrv_livecrootn_to_cwdn(c) * dt + cwdn(c) = cwdn(c) + hrv_deadcrootn_to_cwdn(c) * dt + + ! wood to product pools - updates done in CNWoodProducts() + + ! retranslocated N pool to litter + litr1n(c) = litr1n(c) + hrv_retransn_to_litr1n(c) * dt + + ! storage pools to litter + litr1n(c) = litr1n(c) + hrv_leafn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_frootn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_livestemn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_deadstemn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_livecrootn_storage_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_deadcrootn_storage_to_litr1n(c) * dt + + ! transfer pools to litter + litr1n(c) = litr1n(c) + hrv_leafn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_frootn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_livestemn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_deadstemn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_livecrootn_xfer_to_litr1n(c) * dt + litr1n(c) = litr1n(c) + hrv_deadcrootn_xfer_to_litr1n(c) * dt + + end do ! end of column loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level nitrogen fluxes from harvest mortality + ! displayed pools + leafn(p) = leafn(p) - hrv_leafn_to_litter(p) * dt + frootn(p) = frootn(p) - hrv_frootn_to_litter(p) * dt + livestemn(p) = livestemn(p) - hrv_livestemn_to_litter(p) * dt + deadstemn(p) = deadstemn(p) - hrv_deadstemn_to_prod10n(p) * dt + deadstemn(p) = deadstemn(p) - hrv_deadstemn_to_prod100n(p)* dt + livecrootn(p) = livecrootn(p) - hrv_livecrootn_to_litter(p) * dt + deadcrootn(p) = deadcrootn(p) - hrv_deadcrootn_to_litter(p) * dt + retransn(p) = retransn(p) - hrv_retransn_to_litter(p) * dt + + ! storage pools + leafn_storage(p) = leafn_storage(p) - hrv_leafn_storage_to_litter(p) * dt + frootn_storage(p) = frootn_storage(p) - hrv_frootn_storage_to_litter(p) * dt + livestemn_storage(p) = livestemn_storage(p) - hrv_livestemn_storage_to_litter(p) * dt + deadstemn_storage(p) = deadstemn_storage(p) - hrv_deadstemn_storage_to_litter(p) * dt + livecrootn_storage(p) = livecrootn_storage(p) - hrv_livecrootn_storage_to_litter(p) * dt + deadcrootn_storage(p) = deadcrootn_storage(p) - hrv_deadcrootn_storage_to_litter(p) * dt + + ! transfer pools + leafn_xfer(p) = leafn_xfer(p) - hrv_leafn_xfer_to_litter(p) * dt + frootn_xfer(p) = frootn_xfer(p) - hrv_frootn_xfer_to_litter(p) * dt + livestemn_xfer(p) = livestemn_xfer(p) - hrv_livestemn_xfer_to_litter(p) * dt + deadstemn_xfer(p) = deadstemn_xfer(p) - hrv_deadstemn_xfer_to_litter(p) * dt + livecrootn_xfer(p) = livecrootn_xfer(p) - hrv_livecrootn_xfer_to_litter(p) * dt + deadcrootn_xfer(p) = deadcrootn_xfer(p) - hrv_deadcrootn_xfer_to_litter(p) * dt + + end do + +end subroutine NStateUpdate2h +!----------------------------------------------------------------------- + +end module CNNStateUpdate2Mod diff --git a/components/clm/src_clm40/biogeochem/CNNStateUpdate3Mod.F90 b/components/clm/src_clm40/biogeochem/CNNStateUpdate3Mod.F90 new file mode 100644 index 0000000000..839d988e99 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNNStateUpdate3Mod.F90 @@ -0,0 +1,243 @@ +module CNNStateUpdate3Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: NStateUpdate3Mod +! +! !DESCRIPTION: +! Module for nitrogen state variable update, mortality fluxes. +! Also, sminn leaching flux. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: NStateUpdate3 +! +! !REVISION HISTORY: +! 7/27/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NStateUpdate3 +! +! !INTERFACE: +subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, update all the prognostic nitrogen state +! variables affected by gap-phase mortality fluxes. Also the Sminn leaching flux. +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + real(r8), pointer :: sminn_leached(:) + real(r8), pointer :: m_cwdn_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:) + real(r8), pointer :: m_deadstemn_to_cwdn_fire(:) + real(r8), pointer :: m_litr1n_to_fire(:) + real(r8), pointer :: m_litr2n_to_fire(:) + real(r8), pointer :: m_litr3n_to_fire(:) + real(r8), pointer :: m_deadcrootn_storage_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_litter_fire(:) + real(r8), pointer :: m_deadcrootn_xfer_to_fire(:) + real(r8), pointer :: m_deadstemn_storage_to_fire(:) + real(r8), pointer :: m_deadstemn_to_fire(:) + real(r8), pointer :: m_deadstemn_to_litter_fire(:) + real(r8), pointer :: m_deadstemn_xfer_to_fire(:) + real(r8), pointer :: m_frootn_storage_to_fire(:) + real(r8), pointer :: m_frootn_to_fire(:) + real(r8), pointer :: m_frootn_xfer_to_fire(:) + real(r8), pointer :: m_leafn_storage_to_fire(:) + real(r8), pointer :: m_leafn_to_fire(:) + real(r8), pointer :: m_leafn_xfer_to_fire(:) + real(r8), pointer :: m_livecrootn_storage_to_fire(:) + real(r8), pointer :: m_livecrootn_to_fire(:) + real(r8), pointer :: m_livecrootn_xfer_to_fire(:) + real(r8), pointer :: m_livestemn_storage_to_fire(:) + real(r8), pointer :: m_livestemn_to_fire(:) + real(r8), pointer :: m_livestemn_xfer_to_fire(:) + real(r8), pointer :: m_retransn_to_fire(:) +! +! local pointers to implicit in/out scalars + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: dt ! radiation time step (seconds) + +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers at the column level + sminn_leached => cnf%sminn_leached + m_cwdn_to_fire => cnf%m_cwdn_to_fire + m_deadcrootn_to_cwdn_fire => cnf%m_deadcrootn_to_cwdn_fire + m_deadstemn_to_cwdn_fire => cnf%m_deadstemn_to_cwdn_fire + m_litr1n_to_fire => cnf%m_litr1n_to_fire + m_litr2n_to_fire => cnf%m_litr2n_to_fire + m_litr3n_to_fire => cnf%m_litr3n_to_fire + sminn => cns%sminn + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + + ! assign local pointers at the pft level + m_deadcrootn_storage_to_fire => pnf%m_deadcrootn_storage_to_fire + m_deadcrootn_to_fire => pnf%m_deadcrootn_to_fire + m_deadcrootn_to_litter_fire => pnf%m_deadcrootn_to_litter_fire + m_deadcrootn_xfer_to_fire => pnf%m_deadcrootn_xfer_to_fire + m_deadstemn_storage_to_fire => pnf%m_deadstemn_storage_to_fire + m_deadstemn_to_fire => pnf%m_deadstemn_to_fire + m_deadstemn_to_litter_fire => pnf%m_deadstemn_to_litter_fire + m_deadstemn_xfer_to_fire => pnf%m_deadstemn_xfer_to_fire + m_frootn_storage_to_fire => pnf%m_frootn_storage_to_fire + m_frootn_to_fire => pnf%m_frootn_to_fire + m_frootn_xfer_to_fire => pnf%m_frootn_xfer_to_fire + m_leafn_storage_to_fire => pnf%m_leafn_storage_to_fire + m_leafn_to_fire => pnf%m_leafn_to_fire + m_leafn_xfer_to_fire => pnf%m_leafn_xfer_to_fire + m_livecrootn_storage_to_fire => pnf%m_livecrootn_storage_to_fire + m_livecrootn_to_fire => pnf%m_livecrootn_to_fire + m_livecrootn_xfer_to_fire => pnf%m_livecrootn_xfer_to_fire + m_livestemn_storage_to_fire => pnf%m_livestemn_storage_to_fire + m_livestemn_to_fire => pnf%m_livestemn_to_fire + m_livestemn_xfer_to_fire => pnf%m_livestemn_xfer_to_fire + m_retransn_to_fire => pnf%m_retransn_to_fire + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + retransn => pns%retransn + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! mineral N loss due to leaching + sminn(c) = sminn(c) - sminn_leached(c) * dt + + ! column level nitrogen fluxes from fire + + ! pft-level wood to column-level CWD (uncombusted wood) + cwdn(c) = cwdn(c) + m_deadstemn_to_cwdn_fire(c) * dt + cwdn(c) = cwdn(c) + m_deadcrootn_to_cwdn_fire(c) * dt + + ! litter and CWD losses to fire + litr1n(c) = litr1n(c) - m_litr1n_to_fire(c) * dt + litr2n(c) = litr2n(c) - m_litr2n_to_fire(c) * dt + litr3n(c) = litr3n(c) - m_litr3n_to_fire(c) * dt + cwdn(c) = cwdn(c) - m_cwdn_to_fire(c) * dt + + end do ! end of column loop + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! pft-level nitrogen fluxes from fire + ! displayed pools + leafn(p) = leafn(p) - m_leafn_to_fire(p) * dt + frootn(p) = frootn(p) - m_frootn_to_fire(p) * dt + livestemn(p) = livestemn(p) - m_livestemn_to_fire(p) * dt + deadstemn(p) = deadstemn(p) - m_deadstemn_to_fire(p) * dt + deadstemn(p) = deadstemn(p) - m_deadstemn_to_litter_fire(p) * dt + livecrootn(p) = livecrootn(p) - m_livecrootn_to_fire(p) * dt + deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_fire(p) * dt + deadcrootn(p) = deadcrootn(p) - m_deadcrootn_to_litter_fire(p) * dt + + ! storage pools + leafn_storage(p) = leafn_storage(p) - m_leafn_storage_to_fire(p) * dt + frootn_storage(p) = frootn_storage(p) - m_frootn_storage_to_fire(p) * dt + livestemn_storage(p) = livestemn_storage(p) - m_livestemn_storage_to_fire(p) * dt + deadstemn_storage(p) = deadstemn_storage(p) - m_deadstemn_storage_to_fire(p) * dt + livecrootn_storage(p) = livecrootn_storage(p) - m_livecrootn_storage_to_fire(p) * dt + deadcrootn_storage(p) = deadcrootn_storage(p) - m_deadcrootn_storage_to_fire(p) * dt + + ! transfer pools + leafn_xfer(p) = leafn_xfer(p) - m_leafn_xfer_to_fire(p) * dt + frootn_xfer(p) = frootn_xfer(p) - m_frootn_xfer_to_fire(p) * dt + livestemn_xfer(p) = livestemn_xfer(p) - m_livestemn_xfer_to_fire(p) * dt + deadstemn_xfer(p) = deadstemn_xfer(p) - m_deadstemn_xfer_to_fire(p) * dt + livecrootn_xfer(p) = livecrootn_xfer(p) - m_livecrootn_xfer_to_fire(p) * dt + deadcrootn_xfer(p) = deadcrootn_xfer(p) - m_deadcrootn_xfer_to_fire(p) * dt + + ! retranslocated N pool + retransn(p) = retransn(p) - m_retransn_to_fire(p) * dt + + end do + +end subroutine NStateUpdate3 +!----------------------------------------------------------------------- + +end module CNNStateUpdate3Mod diff --git a/components/clm/src_clm40/biogeochem/CNPhenologyMod.F90 b/components/clm/src_clm40/biogeochem/CNPhenologyMod.F90 new file mode 100644 index 0000000000..2266684fd5 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNPhenologyMod.F90 @@ -0,0 +1,2750 @@ +module CNPhenologyMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNPhenologyMod +! +! !DESCRIPTION: +! Module holding routines used in phenology model for coupled carbon +! nitrogen code. +! +! !USES: + use clmtype + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varcon , only: tfrz + use clm_varctl , only: iulog, use_cndv + use clm_varpar , only: numpft + use shr_sys_mod , only: shr_sys_flush + use abortutils , only: endrun + implicit none + save + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: CNPhenologyInit ! Initialization + public :: CNPhenology ! Update +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! 10/23/03, Peter Thornton: migrated all routines to vector data structures +! 2/4/08, slevis: adding crop phenology from AgroIBIS + +! !PRIVATE DATA MEMBERS: + + real(r8) :: dt ! radiation time step delta t (seconds) + real(r8) :: fracday ! dtime as a fraction of day + real(r8) :: crit_dayl ! critical daylength for offset (seconds) + real(r8) :: ndays_on ! number of days to complete onset + real(r8) :: ndays_off ! number of days to complete offset + real(r8) :: fstor2tran ! fraction of storage to move to transfer on each onset + real(r8) :: crit_onset_fdd ! critical number of freezing days + real(r8) :: crit_onset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_on ! water potential for onset trigger (MPa) + real(r8) :: crit_offset_fdd ! critical number of freezing degree days + ! to trigger offset + real(r8) :: crit_offset_swi ! water stress days for offset trigger + real(r8) :: soilpsi_off ! water potential for offset trigger (MPa) + real(r8) :: lwtop ! live wood turnover proportion (annual fraction) + ! + ! CropPhenology variables and constants + ! + real(r8) :: p1d, p1v ! photoperiod factor constants for crop vernalization + real(r8) :: hti ! cold hardening index threshold for vernalization + real(r8) :: tbase ! base temperature for vernalization + integer, parameter :: NOT_Planted = 999 ! If not planted yet in year + integer, parameter :: NOT_Harvested = 999 ! If not harvested yet in year + integer, parameter :: inNH = 1 ! Northern Hemisphere + integer, parameter :: inSH = 2 ! Southern Hemisphere + integer, pointer :: inhemi(:) ! Hemisphere that pft is in + integer :: minplantjday(0:numpft,inSH) ! minimum planting julian day + integer :: maxplantjday(0:numpft,inSH) ! maximum planting julian day + integer :: jdayyrstart(inSH) ! julian day of start of year + +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNPhenology +! +! !INTERFACE: +subroutine CNPhenology (num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp, filter_pcropp, doalb) +! +! !DESCRIPTION: +! Dynamic phenology routine for coupled carbon-nitrogen code (CN) +! 1. grass phenology +! +! !USES: +! +! !ARGUMENTS: + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + integer, intent(in) :: num_pcropp ! number of prog. crop pfts in filter + integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts + logical, intent(in) :: doalb ! true if time for sfc albedo calc +! +! !CALLED FROM: +! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 7/28/03: Created by Peter Thornton +! 9/05/03, Peter Thornton: moved from call with (p) to call with (c) +! 10/3/03, Peter Thornton: added subroutine calls for different phenology types +! 11/7/03, Peter Thornton: moved phenology type tests into phenology type +! routines, and moved onset, offset, background litfall routines into +! main phenology call. +! !LOCAL VARIABLES: +! local pointers to implicit in arrays +! +! local pointers to implicit in/out scalars +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + + ! each of the following phenology type routines includes a filter + ! to operate only on the relevant pfts + + call CNPhenologyClimate(num_soilp, filter_soilp, num_pcropp, filter_pcropp) + + call CNEvergreenPhenology(num_soilp, filter_soilp) + + call CNSeasonDecidPhenology(num_soilp, filter_soilp) + + call CNStressDecidPhenology(num_soilp, filter_soilp) + + if (doalb .and. num_pcropp > 0 ) call CropPhenology(num_pcropp, filter_pcropp) + + ! the same onset and offset routines are called regardless of + ! phenology type - they depend only on onset_flag, offset_flag, bglfr, and bgtr + + call CNOnsetGrowth(num_soilp, filter_soilp) + + call CNOffsetLitterfall(num_soilp, filter_soilp) + + call CNBackgroundLitterfall(num_soilp, filter_soilp) + + call CNLivewoodTurnover(num_soilp, filter_soilp) + + ! gather all pft-level litterfall fluxes to the column + ! for litter C and N inputs + + call CNLitterToColumn(num_soilc, filter_soilc) + +end subroutine CNPhenology + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNPhenologyInit +! +! !INTERFACE: +subroutine CNPhenologyInit( begp, endp ) +! +! !DESCRIPTION: +! Initialization of CNPhenology. Must be called after time-manager is +! initialized, and after pftcon file is read in. +! +! !USES: + use clm_time_manager, only: get_step_size + use surfrdMod , only: crop_prog + use clm_varcon , only: secspday +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begp, endp ! Beginning and ending PFT index +! !CALLED FROM: +! subroutine initialize2 in module clm_initializeMod.F90 +! +! !REVISION HISTORY: +! 3/28/11: Created by Erik Kluzek +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------ + + ! + ! Get time-step and what fraction of a day it is + ! + dt = real( get_step_size(), r8 ) + fracday = dt/secspday + + ! set some local parameters - these will be moved into + ! parameter file after testing + + ! ----------------------------------------- + ! Constants for CNSeasonDecidPhenology + ! ----------------------------------------- + ! + ! critical daylength from Biome-BGC, v4.1.2 + crit_dayl = 39300._r8 + + ! ----------------------------------------- + ! Constants for CNSeasonDecidPhenology and CNStressDecidPhenology + ! ----------------------------------------- + ndays_on = 30._r8 + ndays_off = 15._r8 + + ! transfer parameters + fstor2tran = 0.5_r8 + ! ----------------------------------------- + ! Constants for CNStressDecidPhenology + ! ----------------------------------------- + + ! onset parameters + crit_onset_fdd = 15.0_r8 + ! critical onset gdd now being calculated as a function of annual + ! average 2m temp. + ! crit_onset_gdd = 150.0 ! c3 grass value + ! crit_onset_gdd = 1000.0 ! c4 grass value + crit_onset_swi = 15.0_r8 + soilpsi_on = -2.0_r8 + + ! offset parameters + crit_offset_fdd = 15.0_r8 + crit_offset_swi = 15.0_r8 + soilpsi_off = -2.0_r8 + + ! ----------------------------------------- + ! Constants for CNLivewoodTurnover + ! ----------------------------------------- + + ! set the global parameter for livewood turnover rate + ! define as an annual fraction (0.7), and convert to fraction per second + lwtop = 0.7_r8 / 31536000.0_r8 + + ! ----------------------------------------- + ! Call any subroutine specific initialization routines + ! ----------------------------------------- + + if ( crop_prog ) call CropPhenologyInit( begp, endp ) + +end subroutine CNPhenologyInit +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNPhenologyClimate +! +! !INTERFACE: +subroutine CNPhenologyClimate (num_soilp, filter_soilp, num_pcropp, filter_pcropp) +! +! !DESCRIPTION: +! For coupled carbon-nitrogen code (CN). +! +! !USES: + use clm_time_manager, only: get_days_per_year + use clm_time_manager, only: get_curr_date, is_first_step + use CropRestMod , only: CropRestYear +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts + integer, intent(in) :: num_pcropp ! number of prognostic crops in filter + integer, intent(in) :: filter_pcropp(:)! filter for prognostic crop pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 3/13/07: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + ! ecophysiological constants + real(r8), pointer :: t_ref2m(:) ! 2m air temperature (K) + real(r8), pointer :: tempavg_t2m(:) ! temp. avg 2m air temperature (K) + real(r8), pointer :: gdd0(:) ! growing deg. days base 0 deg C (ddays) + real(r8), pointer :: gdd8(:) ! " " " " 8 " " " + real(r8), pointer :: gdd10(:) ! " " " " 10 " " " + real(r8), pointer :: gdd020(:) ! 20-yr mean of gdd0 (ddays) + real(r8), pointer :: gdd820(:) ! 20-yr mean of gdd8 (ddays) + real(r8), pointer :: gdd1020(:) ! 20-yr mean of gdd10 (ddays) + integer , pointer :: pgridcell(:) ! pft's gridcell index +! +! local pointers to implicit in/out scalars +! +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + integer :: nyrs ! number of years prognostic crop has run + real(r8):: dayspyr ! days per year (days) + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + real(r8), parameter :: yravg = 20.0_r8 ! length of years to average for gdd + real(r8), parameter :: yravgm1 = yravg-1.0_r8 ! minus 1 of above +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers to derived type arrays + ivt => pft%itype + t_ref2m => pes%t_ref2m + tempavg_t2m => pepv%tempavg_t2m + + gdd0 => pps%gdd0 + gdd8 => pps%gdd8 + gdd10 => pps%gdd10 + gdd020 => pps%gdd020 + gdd820 => pps%gdd820 + gdd1020 => pps%gdd1020 + pgridcell => pft%gridcell + + ! set time steps + + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + tempavg_t2m(p) = tempavg_t2m(p) + t_ref2m(p) * (fracday/dayspyr) + end do + + ! + ! The following crop related steps are done here rather than CropPhenology + ! so that they will be completed each time-step rather than with doalb. + ! + ! The following lines come from ibis's climate.f + stats.f + ! gdd SUMMATIONS ARE RELATIVE TO THE PLANTING DATE (see subr. updateAccFlds) + + if (num_pcropp > 0) then + ! get time-related info + call get_curr_date(kyr, kmo, kda, mcsec) + nyrs = CropRestYear() + end if + + do fp = 1,num_pcropp + p = filter_pcropp(fp) + if (kmo == 1 .and. kda == 1 .and. nyrs == 0) then ! YR 1: + gdd020(p) = 0._r8 ! set gdd..20 variables to 0 + gdd820(p) = 0._r8 ! and crops will not be planted + gdd1020(p) = 0._r8 + end if + if (kmo == 1 .and. kda == 1 .and. mcsec == 0) then ! <-- END of EVERY YR: + if (nyrs == 1) then ! <-- END of YR 1 + gdd020(p) = gdd0(p) ! <-- END of YR 1 + gdd820(p) = gdd8(p) ! <-- END of YR 1 + gdd1020(p) = gdd10(p) ! <-- END of YR 1 + end if ! <-- END of YR 1 + gdd020(p) = (yravgm1* gdd020(p) + gdd0(p)) / yravg ! gdd..20 must be long term avgs + gdd820(p) = (yravgm1* gdd820(p) + gdd8(p)) / yravg ! so ignore results for yrs 1 & 2 + gdd1020(p) = (yravgm1* gdd1020(p) + gdd10(p)) / yravg + end if + end do + +end subroutine CNPhenologyClimate +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNEvergreenPhenology +! +! !INTERFACE: +subroutine CNEvergreenPhenology (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! For coupled carbon-nitrogen code (CN). +! +! !USES: + use clm_varcon , only: secspday + use clm_time_manager, only: get_days_per_year +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/2/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + ! ecophysiological constants + real(r8), pointer :: evergreen(:) ! binary flag for evergreen leaf habit (0 or 1) + real(r8), pointer :: leaf_long(:) ! leaf longevity (yrs) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: bgtr(:) ! background transfer growth rate (1/s) + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + real(r8):: dayspyr ! Days per year + integer :: p ! indices + integer :: fp ! lake filter pft index +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers to derived type arrays + ivt => pft%itype + evergreen => pftcon%evergreen + leaf_long => pftcon%leaf_long + bglfr => pepv%bglfr + bgtr => pepv%bgtr + lgsf => pepv%lgsf + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + if (evergreen(ivt(p)) == 1._r8) then + bglfr(p) = 1._r8/(leaf_long(ivt(p))*dayspyr*secspday) + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + end if + end do + +end subroutine CNEvergreenPhenology +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSeasonDecidPhenology +! +! !INTERFACE: +subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! For coupled carbon-nitrogen code (CN). +! This routine handles the seasonal deciduous phenology code (temperate +! deciduous vegetation that has only one growing season per year). +! +! !USES: + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_PI + use clm_varcon , only: secspday +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/6/03: Created by Peter Thornton +! 10/24/03, Peter Thornton: migrated to vector data structures +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: latdeg(:) ! latitude (radians) + real(r8), pointer :: decl(:) ! solar declination (radians) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + ! ecophysiological constants + real(r8), pointer :: season_decid(:) ! binary flag for seasonal-deciduous leaf habit (0 or 1) + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) +! +! local pointers to implicit in/out scalars + real(r8), pointer :: dormant_flag(:) ! dormancy flag + real(r8), pointer :: days_active(:) ! number of days since last dormancy + real(r8), pointer :: onset_flag(:) ! onset flag + real(r8), pointer :: onset_counter(:) ! onset counter (seconds) + real(r8), pointer :: onset_gddflag(:) ! onset freeze flag + real(r8), pointer :: onset_gdd(:) ! onset growing degree days + real(r8), pointer :: offset_flag(:) ! offset flag + real(r8), pointer :: offset_counter(:) ! offset counter (seconds) + real(r8), pointer :: dayl(:) ! daylength (seconds) + real(r8), pointer :: prev_dayl(:) ! daylength from previous albedo timestep (seconds) + real(r8), pointer :: annavg_t2m(:) ! annual average 2m air temperature (K) + real(r8), pointer :: prev_leafc_to_litter(:) ! previous timestep leaf C litterfall flux (gC/m2/s) + real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s) + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: bgtr(:) ! background transfer growth rate (1/s) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: leafn_xfer_to_leafn(:) + real(r8), pointer :: frootn_xfer_to_frootn(:) + real(r8), pointer :: livestemn_xfer_to_livestemn(:) + real(r8), pointer :: deadstemn_xfer_to_deadstemn(:) + real(r8), pointer :: livecrootn_xfer_to_livecrootn(:) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:) + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: leafc_storage_to_xfer(:) + real(r8), pointer :: frootc_storage_to_xfer(:) + real(r8), pointer :: livestemc_storage_to_xfer(:) + real(r8), pointer :: deadstemc_storage_to_xfer(:) + real(r8), pointer :: livecrootc_storage_to_xfer(:) + real(r8), pointer :: deadcrootc_storage_to_xfer(:) + real(r8), pointer :: gresp_storage_to_xfer(:) + real(r8), pointer :: leafn_storage_to_xfer(:) + real(r8), pointer :: frootn_storage_to_xfer(:) + real(r8), pointer :: livestemn_storage_to_xfer(:) + real(r8), pointer :: deadstemn_storage_to_xfer(:) + real(r8), pointer :: livecrootn_storage_to_xfer(:) + real(r8), pointer :: deadcrootn_storage_to_xfer(:) + logical , pointer :: pftmayexist(:) ! exclude seasonal decid pfts from tropics +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: c,p !indices + integer :: fp !lake filter pft index + real(r8):: ws_flag !winter-summer solstice flag (0 or 1) + real(r8):: crit_onset_gdd !critical onset growing degree-day sum + real(r8):: soilt + real(r8):: lat !latitude (radians) + real(r8):: temp !temporary variable for daylength calculation + +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + ivt => pft%itype + pcolumn => pft%column + pgridcell => pft%gridcell + latdeg => grc%latdeg + decl => cps%decl + t_soisno => ces%t_soisno + leafc_storage => pcs%leafc_storage + frootc_storage => pcs%frootc_storage + livestemc_storage => pcs%livestemc_storage + deadstemc_storage => pcs%deadstemc_storage + livecrootc_storage => pcs%livecrootc_storage + deadcrootc_storage => pcs%deadcrootc_storage + gresp_storage => pcs%gresp_storage + leafn_storage => pns%leafn_storage + frootn_storage => pns%frootn_storage + livestemn_storage => pns%livestemn_storage + deadstemn_storage => pns%deadstemn_storage + livecrootn_storage => pns%livecrootn_storage + deadcrootn_storage => pns%deadcrootn_storage + season_decid => pftcon%season_decid + woody => pftcon%woody + + ! Assign local pointers to derived type arrays (out) + dormant_flag => pepv%dormant_flag + days_active => pepv%days_active + onset_flag => pepv%onset_flag + onset_counter => pepv%onset_counter + onset_gddflag => pepv%onset_gddflag + onset_gdd => pepv%onset_gdd + offset_flag => pepv%offset_flag + offset_counter => pepv%offset_counter + dayl => pepv%dayl + prev_dayl => pepv%prev_dayl + annavg_t2m => pepv%annavg_t2m + prev_leafc_to_litter => pepv%prev_leafc_to_litter + prev_frootc_to_litter => pepv%prev_frootc_to_litter + bglfr => pepv%bglfr + bgtr => pepv%bgtr + lgsf => pepv%lgsf + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + leafn_xfer_to_leafn => pnf%leafn_xfer_to_leafn + frootn_xfer_to_frootn => pnf%frootn_xfer_to_frootn + livestemn_xfer_to_livestemn => pnf%livestemn_xfer_to_livestemn + deadstemn_xfer_to_deadstemn => pnf%deadstemn_xfer_to_deadstemn + livecrootn_xfer_to_livecrootn => pnf%livecrootn_xfer_to_livecrootn + deadcrootn_xfer_to_deadcrootn => pnf%deadcrootn_xfer_to_deadcrootn + leafc_xfer => pcs%leafc_xfer + frootc_xfer => pcs%frootc_xfer + livestemc_xfer => pcs%livestemc_xfer + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc_xfer => pcs%deadcrootc_xfer + leafn_xfer => pns%leafn_xfer + frootn_xfer => pns%frootn_xfer + livestemn_xfer => pns%livestemn_xfer + deadstemn_xfer => pns%deadstemn_xfer + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn_xfer => pns%deadcrootn_xfer + leafc_storage_to_xfer => pcf%leafc_storage_to_xfer + frootc_storage_to_xfer => pcf%frootc_storage_to_xfer + livestemc_storage_to_xfer => pcf%livestemc_storage_to_xfer + deadstemc_storage_to_xfer => pcf%deadstemc_storage_to_xfer + livecrootc_storage_to_xfer => pcf%livecrootc_storage_to_xfer + deadcrootc_storage_to_xfer => pcf%deadcrootc_storage_to_xfer + gresp_storage_to_xfer => pcf%gresp_storage_to_xfer + leafn_storage_to_xfer => pnf%leafn_storage_to_xfer + frootn_storage_to_xfer => pnf%frootn_storage_to_xfer + livestemn_storage_to_xfer => pnf%livestemn_storage_to_xfer + deadstemn_storage_to_xfer => pnf%deadstemn_storage_to_xfer + livecrootn_storage_to_xfer => pnf%livecrootn_storage_to_xfer + deadcrootn_storage_to_xfer => pnf%deadcrootn_storage_to_xfer + pftmayexist => pdgvs%pftmayexist + + ! start pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + + if (season_decid(ivt(p)) == 1._r8) then + + ! set background litterfall rate, background transfer rate, and + ! long growing season factor to 0 for seasonal deciduous types + bglfr(p) = 0._r8 + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + ! use solar declination information stored during Surface Albedo() + ! and latitude from gps to calcluate daylength (convert latitude from degrees to radians) + ! the constant 13750.9871 is the number of seconds per radian of hour-angle + + prev_dayl(p) = dayl(p) + lat = (SHR_CONST_PI/180._r8)*latdeg(pgridcell(p)) + temp = -(sin(lat)*sin(decl(c)))/(cos(lat) * cos(decl(c))) + temp = min(1._r8,max(-1._r8,temp)) + dayl(p) = 2.0_r8 * 13750.9871_r8 * acos(temp) + + ! set flag for solstice period (winter->summer = 1, summer->winter = 0) + if (dayl(p) >= prev_dayl(p)) then + ws_flag = 1._r8 + else + ws_flag = 0._r8 + end if + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1.0_r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + if (use_cndv) then + pftmayexist(p) = .true. + end if + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + + onset_flag(p) = 0.0_r8 + onset_counter(p) = 0.0_r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0.0_r8 + frootc_xfer_to_frootc(p) = 0.0_r8 + leafn_xfer_to_leafn(p) = 0.0_r8 + frootn_xfer_to_frootn(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0.0_r8 + deadstemc_xfer_to_deadstemc(p) = 0.0_r8 + livecrootc_xfer_to_livecrootc(p) = 0.0_r8 + deadcrootc_xfer_to_deadcrootc(p) = 0.0_r8 + livestemn_xfer_to_livestemn(p) = 0.0_r8 + deadstemn_xfer_to_deadstemn(p) = 0.0_r8 + livecrootn_xfer_to_livecrootn(p) = 0.0_r8 + deadcrootn_xfer_to_deadcrootn(p) = 0.0_r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0.0_r8 + leafn_xfer(p) = 0.0_r8 + frootc_xfer(p) = 0.0_r8 + frootn_xfer(p) = 0.0_r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0.0_r8 + livestemn_xfer(p) = 0.0_r8 + deadstemc_xfer(p) = 0.0_r8 + deadstemn_xfer(p) = 0.0_r8 + livecrootc_xfer(p) = 0.0_r8 + livecrootn_xfer(p) = 0.0_r8 + deadcrootc_xfer(p) = 0.0_r8 + deadcrootn_xfer(p) = 0.0_r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1.0_r8) then + + ! Test to turn on growing degree-day sum, if off. + ! switch on the growing degree day sum on the winter solstice + + if (onset_gddflag(p) == 0._r8 .and. ws_flag == 1._r8) then + onset_gddflag(p) = 1._r8 + onset_gdd(p) = 0._r8 + end if + + ! Test to turn off growing degree-day sum, if on. + ! This test resets the growing degree day sum if it gets past + ! the summer solstice without reaching the threshold value. + ! In that case, it will take until the next winter solstice + ! before the growing degree-day summation starts again. + + if (onset_gddflag(p) == 1._r8 .and. ws_flag == 0._r8) then + onset_gddflag(p) = 0._r8 + onset_gdd(p) = 0._r8 + end if + + ! if the gdd flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + soilt = t_soisno(c,3) + if (onset_gddflag(p) == 1.0_r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) then + onset_flag(p) = 1.0_r8 + dormant_flag(p) = 0.0_r8 + onset_gddflag(p) = 0.0_r8 + onset_gdd(p) = 0.0_r8 + onset_counter(p) = ndays_on * secspday + + ! move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0.0_r8) then + if (use_cndv) then + ! If days_active > 355, then remove pft in + ! CNDVEstablishment at the end of the year. + ! days_active > 355 is a symptom of seasonal decid. pfts occurring in + ! gridcells where dayl never drops below crit_dayl. + ! This results in TLAI>1e4 in a few gridcells. + days_active(p) = days_active(p) + fracday + if (days_active(p) > 355._r8) pftmayexist(p) = .false. + end if + + ! only begin to test for offset daylength once past the summer sol + if (ws_flag == 0._r8 .and. dayl(p) < crit_dayl) then + offset_flag(p) = 1._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + end if ! end if seasonal deciduous + + end do ! end of pft loop + +end subroutine CNSeasonDecidPhenology +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNStressDecidPhenology +! +! !INTERFACE: +subroutine CNStressDecidPhenology (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! This routine handles phenology for vegetation types, such as grasses and +! tropical drought deciduous trees, that respond to cold and drought stress +! signals and that can have multiple growing seasons in a given year. +! This routine allows for the possibility that leaves might persist year-round +! in the absence of a suitable stress trigger, by switching to an essentially +! evergreen habit, but maintaining a deciduous leaf longevity, while waiting +! for the next stress trigger. This is in contrast to the seasonal deciduous +! algorithm (for temperate deciduous trees) that forces a single growing season +! per year. +! +! !USES: + use clm_time_manager, only: get_days_per_year + use clm_varcon , only: secspday + use shr_const_mod , only: SHR_CONST_TKFRZ, SHR_CONST_PI +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/27/03: Created by Peter Thornton +! 01/29/04: Made onset_gdd critical sum a function of temperature, as in +! seasonal deciduous algorithm. +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: latdeg(:) ! latitude (radians) + real(r8), pointer :: decl(:) ! solar declination (radians) + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + real(r8), pointer :: leaf_long(:) ! leaf longevity (yrs) + real(r8), pointer :: stress_decid(:) ! binary flag for stress-deciduous leaf habit (0 or 1) + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: dormant_flag(:) ! dormancy flag + real(r8), pointer :: days_active(:) ! number of days since last dormancy + real(r8), pointer :: onset_flag(:) ! onset flag + real(r8), pointer :: onset_counter(:) ! onset counter (seconds) + real(r8), pointer :: onset_gddflag(:) ! onset freeze flag + real(r8), pointer :: onset_fdd(:) ! onset freezing degree days counter + real(r8), pointer :: onset_gdd(:) ! onset growing degree days + real(r8), pointer :: onset_swi(:) ! onset soil water index + real(r8), pointer :: offset_flag(:) ! offset flag + real(r8), pointer :: offset_counter(:) ! offset counter (seconds) + real(r8), pointer :: dayl(:) ! daylength (seconds) + real(r8), pointer :: offset_fdd(:) ! offset freezing degree days counter + real(r8), pointer :: offset_swi(:) ! offset soil water index + real(r8), pointer :: annavg_t2m(:) ! annual average 2m air temperature (K) + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: bgtr(:) ! background transfer growth rate (1/s) + real(r8), pointer :: prev_leafc_to_litter(:) ! previous timestep leaf C litterfall flux (gC/m2/s) + real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: leafn_xfer_to_leafn(:) + real(r8), pointer :: frootn_xfer_to_frootn(:) + real(r8), pointer :: livestemn_xfer_to_livestemn(:) + real(r8), pointer :: deadstemn_xfer_to_deadstemn(:) + real(r8), pointer :: livecrootn_xfer_to_livecrootn(:) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:) + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: leafc_storage_to_xfer(:) + real(r8), pointer :: frootc_storage_to_xfer(:) + real(r8), pointer :: livestemc_storage_to_xfer(:) + real(r8), pointer :: deadstemc_storage_to_xfer(:) + real(r8), pointer :: livecrootc_storage_to_xfer(:) + real(r8), pointer :: deadcrootc_storage_to_xfer(:) + real(r8), pointer :: gresp_storage_to_xfer(:) + real(r8), pointer :: leafn_storage_to_xfer(:) + real(r8), pointer :: frootn_storage_to_xfer(:) + real(r8), pointer :: livestemn_storage_to_xfer(:) + real(r8), pointer :: deadstemn_storage_to_xfer(:) + real(r8), pointer :: livecrootn_storage_to_xfer(:) + real(r8), pointer :: deadcrootn_storage_to_xfer(:) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + real(r8),parameter :: secspqtrday = secspday / 4 ! seconds per quarter day + integer :: c,p ! indices + integer :: fp ! lake filter pft index + real(r8):: dayspyr ! days per year + real(r8):: crit_onset_gdd ! degree days for onset trigger + real(r8):: soilt ! temperature of top soil layer + real(r8):: psi ! water stress of top soil layer + real(r8):: lat !latitude (radians) + real(r8):: temp !temporary variable for daylength calculation +!EOP +!----------------------------------------------------------------------- + ! Assign local pointers to derived type arrays (in) + ivt => pft%itype + pcolumn => pft%column + pgridcell => pft%gridcell + latdeg => grc%latdeg + decl => cps%decl + leafc_storage => pcs%leafc_storage + frootc_storage => pcs%frootc_storage + livestemc_storage => pcs%livestemc_storage + deadstemc_storage => pcs%deadstemc_storage + livecrootc_storage => pcs%livecrootc_storage + deadcrootc_storage => pcs%deadcrootc_storage + gresp_storage => pcs%gresp_storage + leafn_storage => pns%leafn_storage + frootn_storage => pns%frootn_storage + livestemn_storage => pns%livestemn_storage + deadstemn_storage => pns%deadstemn_storage + livecrootn_storage => pns%livecrootn_storage + deadcrootn_storage => pns%deadcrootn_storage + soilpsi => cps%soilpsi + t_soisno => ces%t_soisno + leaf_long => pftcon%leaf_long + woody => pftcon%woody + stress_decid => pftcon%stress_decid + + ! Assign local pointers to derived type arrays (out) + dormant_flag => pepv%dormant_flag + days_active => pepv%days_active + onset_flag => pepv%onset_flag + onset_counter => pepv%onset_counter + onset_gddflag => pepv%onset_gddflag + onset_fdd => pepv%onset_fdd + onset_gdd => pepv%onset_gdd + onset_swi => pepv%onset_swi + offset_flag => pepv%offset_flag + offset_counter => pepv%offset_counter + dayl => pepv%dayl + offset_fdd => pepv%offset_fdd + offset_swi => pepv%offset_swi + annavg_t2m => pepv%annavg_t2m + prev_leafc_to_litter => pepv%prev_leafc_to_litter + prev_frootc_to_litter => pepv%prev_frootc_to_litter + lgsf => pepv%lgsf + bglfr => pepv%bglfr + bgtr => pepv%bgtr + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + leafn_xfer_to_leafn => pnf%leafn_xfer_to_leafn + frootn_xfer_to_frootn => pnf%frootn_xfer_to_frootn + livestemn_xfer_to_livestemn => pnf%livestemn_xfer_to_livestemn + deadstemn_xfer_to_deadstemn => pnf%deadstemn_xfer_to_deadstemn + livecrootn_xfer_to_livecrootn => pnf%livecrootn_xfer_to_livecrootn + deadcrootn_xfer_to_deadcrootn => pnf%deadcrootn_xfer_to_deadcrootn + leafc_xfer => pcs%leafc_xfer + frootc_xfer => pcs%frootc_xfer + livestemc_xfer => pcs%livestemc_xfer + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc_xfer => pcs%deadcrootc_xfer + leafn_xfer => pns%leafn_xfer + frootn_xfer => pns%frootn_xfer + livestemn_xfer => pns%livestemn_xfer + deadstemn_xfer => pns%deadstemn_xfer + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn_xfer => pns%deadcrootn_xfer + leafc_storage_to_xfer => pcf%leafc_storage_to_xfer + frootc_storage_to_xfer => pcf%frootc_storage_to_xfer + livestemc_storage_to_xfer => pcf%livestemc_storage_to_xfer + deadstemc_storage_to_xfer => pcf%deadstemc_storage_to_xfer + livecrootc_storage_to_xfer => pcf%livecrootc_storage_to_xfer + deadcrootc_storage_to_xfer => pcf%deadcrootc_storage_to_xfer + gresp_storage_to_xfer => pcf%gresp_storage_to_xfer + leafn_storage_to_xfer => pnf%leafn_storage_to_xfer + frootn_storage_to_xfer => pnf%frootn_storage_to_xfer + livestemn_storage_to_xfer => pnf%livestemn_storage_to_xfer + deadstemn_storage_to_xfer => pnf%deadstemn_storage_to_xfer + livecrootn_storage_to_xfer => pnf%livecrootn_storage_to_xfer + deadcrootn_storage_to_xfer => pnf%deadcrootn_storage_to_xfer + + ! set time steps + dayspyr = get_days_per_year() + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + + if (stress_decid(ivt(p)) == 1._r8) then + soilt = t_soisno(c,3) + psi = soilpsi(c,3) + + ! use solar declination information stored during Surface Albedo() + ! and latitude from gps to calcluate daylength (convert latitude from degrees to radians) + ! the constant 13750.9871 is the number of seconds per radian of hour-angle + + lat = (SHR_CONST_PI/180._r8)*latdeg(pgridcell(p)) + temp = -(sin(lat)*sin(decl(c)))/(cos(lat) * cos(decl(c))) + temp = min(1._r8,max(-1._r8,temp)) + dayl(p) = 2.0_r8 * 13750.9871_r8 * acos(temp) + + ! onset gdd sum from Biome-BGC, v4.1.2 + crit_onset_gdd = exp(4.8_r8 + 0.13_r8*(annavg_t2m(p) - SHR_CONST_TKFRZ)) + + + ! update offset_counter and test for the end of the offset period + if (offset_flag(p) == 1._r8) then + ! decrement counter for offset period + offset_counter(p) = offset_counter(p) - dt + + ! if this is the end of the offset_period, reset phenology + ! flags and indices + if (offset_counter(p) == 0._r8) then + ! this code block was originally handled by call cn_offset_cleanup(p) + ! inlined during vectorization + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + + ! reset the previous timestep litterfall flux memory + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! update onset_counter and test for the end of the onset period + if (onset_flag(p) == 1.0_r8) then + ! decrement counter for onset period + onset_counter(p) = onset_counter(p) - dt + + ! if this is the end of the onset period, reset phenology + ! flags and indices + if (onset_counter(p) == 0.0_r8) then + ! this code block was originally handled by call cn_onset_cleanup(p) + ! inlined during vectorization + onset_flag(p) = 0._r8 + onset_counter(p) = 0._r8 + ! set all transfer growth rates to 0.0 + leafc_xfer_to_leafc(p) = 0._r8 + frootc_xfer_to_frootc(p) = 0._r8 + leafn_xfer_to_leafn(p) = 0._r8 + frootn_xfer_to_frootn(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = 0._r8 + deadstemc_xfer_to_deadstemc(p) = 0._r8 + livecrootc_xfer_to_livecrootc(p) = 0._r8 + deadcrootc_xfer_to_deadcrootc(p) = 0._r8 + livestemn_xfer_to_livestemn(p) = 0._r8 + deadstemn_xfer_to_deadstemn(p) = 0._r8 + livecrootn_xfer_to_livecrootn(p) = 0._r8 + deadcrootn_xfer_to_deadcrootn(p) = 0._r8 + end if + ! set transfer pools to 0.0 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = 0._r8 + frootc_xfer(p) = 0._r8 + frootn_xfer(p) = 0._r8 + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer(p) = 0._r8 + livestemn_xfer(p) = 0._r8 + deadstemc_xfer(p) = 0._r8 + deadstemn_xfer(p) = 0._r8 + livecrootc_xfer(p) = 0._r8 + livecrootn_xfer(p) = 0._r8 + deadcrootc_xfer(p) = 0._r8 + deadcrootn_xfer(p) = 0._r8 + end if + end if + end if + + ! test for switching from dormant period to growth period + if (dormant_flag(p) == 1._r8) then + + ! keep track of the number of freezing degree days in this + ! dormancy period (only if the freeze flag has not previously been set + ! for this dormancy period + + if (onset_gddflag(p) == 0._r8 .and. soilt < SHR_CONST_TKFRZ) onset_fdd(p) = onset_fdd(p) + fracday + + ! if the number of freezing degree days exceeds a critical value, + ! then onset will require both wet soils and a critical soil + ! temperature sum. If this case is triggered, reset any previously + ! accumulated value in onset_swi, so that onset now depends on + ! the accumulated soil water index following the freeze trigger + + if (onset_fdd(p) > crit_onset_fdd) then + onset_gddflag(p) = 1._r8 + onset_fdd(p) = 0._r8 + onset_swi(p) = 0._r8 + end if + + ! if the freeze flag is set, and if the soil is above freezing + ! then accumulate growing degree days for onset trigger + + if (onset_gddflag(p) == 1._r8 .and. soilt > SHR_CONST_TKFRZ) then + onset_gdd(p) = onset_gdd(p) + (soilt-SHR_CONST_TKFRZ)*fracday + end if + + ! if soils are wet, accumulate soil water index for onset trigger + if (psi >= soilpsi_on) onset_swi(p) = onset_swi(p) + fracday + + ! if critical soil water index is exceeded, set onset_flag, and + ! then test for soil temperature criteria + + if (onset_swi(p) > crit_onset_swi) then + onset_flag(p) = 1._r8 + + ! only check soil temperature criteria if freeze flag set since + ! beginning of last dormancy. If freeze flag set and growing + ! degree day sum (since freeze trigger) is lower than critical + ! value, then override the onset_flag set from soil water. + + if (onset_gddflag(p) == 1._r8 .and. onset_gdd(p) < crit_onset_gdd) onset_flag(p) = 0._r8 + end if + + ! only allow onset if dayl > 6hrs + if (onset_flag(p) == 1._r8 .and. dayl(p) <= secspqtrday) then + onset_flag(p) = 0._r8 + end if + + ! if this is the beginning of the onset period + ! then reset the phenology flags and indices + + if (onset_flag(p) == 1._r8) then + dormant_flag(p) = 0._r8 + days_active(p) = 0._r8 + onset_gddflag(p) = 0._r8 + onset_fdd(p) = 0._r8 + onset_gdd(p) = 0._r8 + onset_swi(p) = 0._r8 + onset_counter(p) = ndays_on * secspday + + ! call subroutine to move all the storage pools into transfer pools, + ! where they will be transfered to displayed growth over the onset period. + ! this code was originally handled with call cn_storage_to_xfer(p) + ! inlined during vectorization + + ! set carbon fluxes for shifting storage pools to transfer pools + leafc_storage_to_xfer(p) = fstor2tran * leafc_storage(p)/dt + frootc_storage_to_xfer(p) = fstor2tran * frootc_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = fstor2tran * livestemc_storage(p)/dt + deadstemc_storage_to_xfer(p) = fstor2tran * deadstemc_storage(p)/dt + livecrootc_storage_to_xfer(p) = fstor2tran * livecrootc_storage(p)/dt + deadcrootc_storage_to_xfer(p) = fstor2tran * deadcrootc_storage(p)/dt + gresp_storage_to_xfer(p) = fstor2tran * gresp_storage(p)/dt + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = fstor2tran * leafn_storage(p)/dt + frootn_storage_to_xfer(p) = fstor2tran * frootn_storage(p)/dt + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = fstor2tran * livestemn_storage(p)/dt + deadstemn_storage_to_xfer(p) = fstor2tran * deadstemn_storage(p)/dt + livecrootn_storage_to_xfer(p) = fstor2tran * livecrootn_storage(p)/dt + deadcrootn_storage_to_xfer(p) = fstor2tran * deadcrootn_storage(p)/dt + end if + end if + + ! test for switching from growth period to offset period + else if (offset_flag(p) == 0._r8) then + + ! if soil water potential lower than critical value, accumulate + ! as stress in offset soil water index + + if (psi <= soilpsi_off) then + offset_swi(p) = offset_swi(p) + fracday + + ! if the offset soil water index exceeds critical value, and + ! if this is not the middle of a previously initiated onset period, + ! then set flag to start the offset period and reset index variables + + if (offset_swi(p) >= crit_offset_swi .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + + ! if soil water potential higher than critical value, reduce the + ! offset water stress index. By this mechanism, there must be a + ! sustained period of water stress to initiate offset. + + else if (psi >= soilpsi_on) then + offset_swi(p) = offset_swi(p) - fracday + offset_swi(p) = max(offset_swi(p),0._r8) + end if + + ! decrease freezing day accumulator for warm soil + if (offset_fdd(p) > 0._r8 .and. soilt > SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) - fracday + offset_fdd(p) = max(0._r8, offset_fdd(p)) + end if + + ! increase freezing day accumulator for cold soil + if (soilt <= SHR_CONST_TKFRZ) then + offset_fdd(p) = offset_fdd(p) + fracday + + ! if freezing degree day sum is greater than critical value, initiate offset + if (offset_fdd(p) > crit_offset_fdd .and. onset_flag(p) == 0._r8) offset_flag(p) = 1._r8 + end if + + ! force offset if daylength is < 6 hrs + if (dayl(p) <= secspqtrday) then + offset_flag(p) = 1._r8 + end if + + ! if this is the beginning of the offset period + ! then reset flags and indices + if (offset_flag(p) == 1._r8) then + offset_fdd(p) = 0._r8 + offset_swi(p) = 0._r8 + offset_counter(p) = ndays_off * secspday + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + end if + end if + + ! keep track of number of days since last dormancy for control on + ! fraction of new growth to send to storage for next growing season + + if (dormant_flag(p) == 0.0_r8) then + days_active(p) = days_active(p) + fracday + end if + + ! calculate long growing season factor (lgsf) + ! only begin to calculate a lgsf greater than 0.0 once the number + ! of days active exceeds days/year. + lgsf(p) = max(min((days_active(p)-dayspyr)/dayspyr, 1._r8),0._r8) + + ! set background litterfall rate, when not in the phenological offset period + if (offset_flag(p) == 1._r8) then + bglfr(p) = 0._r8 + else + ! calculate the background litterfall rate (bglfr) + ! in units 1/s, based on leaf longevity (yrs) and correction for long growing season + + bglfr(p) = (1._r8/(leaf_long(ivt(p))*dayspyr*secspday))*lgsf(p) + end if + + ! set background transfer rate when active but not in the phenological onset period + if (onset_flag(p) == 1._r8) then + bgtr(p) = 0._r8 + else + ! the background transfer rate is calculated as the rate that would result + ! in complete turnover of the storage pools in one year at steady state, + ! once lgsf has reached 1.0 (after 730 days active). + + bgtr(p) = (1._r8/(dayspyr*secspday))*lgsf(p) + + ! set carbon fluxes for shifting storage pools to transfer pools + + leafc_storage_to_xfer(p) = leafc_storage(p) * bgtr(p) + frootc_storage_to_xfer(p) = frootc_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_storage_to_xfer(p) = livestemc_storage(p) * bgtr(p) + deadstemc_storage_to_xfer(p) = deadstemc_storage(p) * bgtr(p) + livecrootc_storage_to_xfer(p) = livecrootc_storage(p) * bgtr(p) + deadcrootc_storage_to_xfer(p) = deadcrootc_storage(p) * bgtr(p) + gresp_storage_to_xfer(p) = gresp_storage(p) * bgtr(p) + end if + + ! set nitrogen fluxes for shifting storage pools to transfer pools + leafn_storage_to_xfer(p) = leafn_storage(p) * bgtr(p) + frootn_storage_to_xfer(p) = frootn_storage(p) * bgtr(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemn_storage_to_xfer(p) = livestemn_storage(p) * bgtr(p) + deadstemn_storage_to_xfer(p) = deadstemn_storage(p) * bgtr(p) + livecrootn_storage_to_xfer(p) = livecrootn_storage(p) * bgtr(p) + deadcrootn_storage_to_xfer(p) = deadcrootn_storage(p) * bgtr(p) + end if + end if + + end if ! end if stress deciduous + + end do ! end of pft loop + +end subroutine CNStressDecidPhenology +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CropPhenology +! +! !INTERFACE: +subroutine CropPhenology(num_pcropp, filter_pcropp) + +! !DESCRIPTION: +! Code from AgroIBIS to determine crop phenology and code from CN to +! handle CN fluxes during the phenological onset & offset periods. + +! !USES: + use clm_time_manager, only : get_curr_date, get_curr_calday, get_days_per_year + use pftvarcon , only : ncorn, nscereal, nwcereal, nsoybean, gddmin, hybgdd, & + lfemerg, grnfill, mxmat, minplanttemp, planttemp + use clm_varcon , only : spval, secspday + +! !ARGUMENTS: + integer, intent(in) :: num_pcropp ! number of prog crop pfts in filter + integer, intent(in) :: filter_pcropp(:) ! filter for prognostic crop pfts + +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 2/5/08: slevis created according to AgroIBIS subroutines of Kucharik et al. +! 7/14/08: slevis adapted crop cycles to southern hemisphere +! 3/29/11: ekluzek simply logic using pftvarcon arrays + +!EOP + +! LOCAL VARAIBLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) + integer jday ! julian day of the year + integer fp,p ! pft indices + integer c ! column indices + integer g ! gridcell indices + integer h ! hemisphere indices + integer idpp ! number of days past planting + integer pmmin ! earliest month to plant winter temperate cereal + integer pdmin ! earliest day in earliest month to plant + integer pmmax ! latest possible month (month) and + integer pdmax ! latest day in latest month to plant + real(r8) dayspyr ! days per year + real(r8) crmcorn ! comparitive relative maturity for corn + +! local pointers to implicit in scalars + + integer , pointer :: pgridcell(:)! pft's gridcell index + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: ivt(:) ! pft + real(r8), pointer :: hui(:) ! =gdd since planting (gddplant) + real(r8), pointer :: leafout(:) ! =gdd from top soil layer temperature + real(r8), pointer :: tlai(:) ! one-sided leaf area index, no burying by snow + real(r8), pointer :: gdd020(:) ! 20 yr mean of gdd0 + real(r8), pointer :: gdd820(:) ! 20 yr mean of gdd8 + real(r8), pointer :: gdd1020(:) ! 20 yr mean of gdd10 + real(r8), pointer :: a5tmin(:) ! 5-day running mean of min 2-m temperature + real(r8), pointer :: a10tmin(:) ! 10-day running mean of min 2-m temperature + real(r8), pointer :: t10(:) ! 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_ref2m_min(:) !daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: bgtr(:) ! background transfer growth rate (1/s) + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] + real(r8), pointer :: offset_flag(:) ! offset flag + real(r8), pointer :: offset_counter(:) ! offset counter + real(r8), pointer :: leaf_long(:) ! leaf longevity (yrs) + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) +! local pointers to implicit out scalars + integer , pointer :: idop(:) ! date of planting + integer , pointer :: harvdate(:) ! harvest date + logical , pointer :: croplive(:) ! Flag, true if planted, not harvested + logical , pointer :: cropplant(:) ! Flag, true if crop may be planted + real(r8), pointer :: cumvd(:) ! cumulative vernalization d?ependence? + real(r8), pointer :: hdidx(:) ! cold hardening index? + real(r8), pointer :: vf(:) ! vernalization factor + real(r8), pointer :: gddmaturity(:) ! gdd needed to harvest + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: huileaf(:) ! heat unit index needed from planting to leaf emergence + real(r8), pointer :: huigrain(:) ! same to reach vegetative maturity + real(r8), pointer :: onset_flag(:) ! onset flag + real(r8), pointer :: onset_counter(:) ! onset counter + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: dwt_seedc_to_leaf(:) ! (gC/m2/s) seed source to PFT-level + real(r8), pointer :: dwt_seedn_to_leaf(:) ! (gN/m2/s) seed source to PFT-level +!------------------------------------------------------------------------ + + pgridcell => pft%gridcell + pcolumn => pft%column + ivt => pft%itype + idop => pps%idop + harvdate => pps%harvdate + croplive => pps%croplive + cropplant => pps%cropplant + gddmaturity => pps%gddmaturity + huileaf => pps%huileaf + huigrain => pps%huigrain + hui => pps%gddplant + leafout => pps%gddtsoi + tlai => pps%tlai + gdd020 => pps%gdd020 + gdd820 => pps%gdd820 + gdd1020 => pps%gdd1020 + a5tmin => pes%a5tmin + a10tmin => pes%a10tmin + t10 => pes%t10 + cumvd => pps%cumvd + hdidx => pps%hdidx + vf => pps%vf + t_ref2m_min => pes%t_ref2m_min + bglfr => pepv%bglfr + bgtr => pepv%bgtr + lgsf => pepv%lgsf + onset_flag => pepv%onset_flag + offset_flag => pepv%offset_flag + onset_counter => pepv%onset_counter + offset_counter => pepv%offset_counter + leafc_xfer => pcs%leafc_xfer + leafn_xfer => pns%leafn_xfer + leaf_long => pftcon%leaf_long + leafcn => pftcon%leafcn + dwt_seedc_to_leaf => ccf%dwt_seedc_to_leaf + dwt_seedn_to_leaf => cnf%dwt_seedn_to_leaf +! --------------------------------------- + + ! get time info + dayspyr = get_days_per_year() + jday = get_curr_calday() + call get_curr_date(kyr, kmo, kda, mcsec) + + do fp = 1, num_pcropp + p = filter_pcropp(fp) + c = pcolumn(p) + g = pgridcell(p) + h = inhemi(p) + + ! background litterfall and transfer rates; long growing season factor + + bglfr(p) = 0._r8 ! this value changes later in a crop's life cycle + bgtr(p) = 0._r8 + lgsf(p) = 0._r8 + + ! --------------------------------- + ! from AgroIBIS subroutine planting + ! --------------------------------- + + ! in order to allow a crop to be planted only once each year + ! initialize cropplant = .false., but hold it = .true. through the end of the year + + ! initialize other variables that are calculated for crops + ! on an annual basis in cropresidue subroutine + + if ( jday == jdayyrstart(h) .and. mcsec == 0 )then + + ! make sure variables aren't changed at beginning of the year + ! for a crop that is currently planted (e.g. winter temperate cereal) + + if (.not. croplive(p)) then + cropplant(p) = .false. + idop(p) = NOT_Planted + + ! keep next for continuous, annual winter temperate cereal type crop; + ! if we removed elseif, + ! winter cereal grown continuously would amount to a cereal/fallow + ! rotation because cereal would only be planted every other year + + else if (croplive(p) .and. ivt(p) == nwcereal) then + cropplant(p) = .false. +! else ! not possible to have croplive and ivt==cornORsoy? (slevis) + end if + + end if + + if ( (.not. croplive(p)) .and. (.not. cropplant(p)) ) then + + ! gdd needed for * chosen crop and a likely hybrid (for that region) * + ! to reach full physiological maturity + + ! based on accumulated seasonal average growing degree days from + ! April 1 - Sept 30 (inclusive) + ! for corn and soybeans in the United States - + ! decided upon by what the typical average growing season length is + ! and the gdd needed to reach maturity in those regions + + ! first choice is used for spring temperate cereal and/or soybeans and maize + + ! slevis: ibis reads xinpdate in io.f from control.crops.nc variable name 'plantdate' + ! According to Chris Kucharik, the dataset of + ! xinpdate was generated from a previous model run at 0.5 deg resolution + + ! winter temperate cereal : use gdd0 as a limit to plant winter cereal + + if (ivt(p) == nwcereal) then + + ! add check to only plant winter cereal after other crops (soybean, maize) + ! have been harvested + + ! *** remember order of planting is crucial - in terms of which crops you want + ! to be grown in what order *** + + ! in this case, corn or soybeans are assumed to be planted before + ! cereal would be in any particular year that both pfts are allowed + ! to grow in the same grid cell (e.g., double-cropping) + + ! slevis: harvdate below needs cropplant(p) above to be cropplant(p,ivt(p)) + ! where ivt(p) has rotated to winter cereal because + ! cropplant through the end of the year for a harvested crop. + ! Also harvdate(p) should be harvdate(p,ivt(p)) and should be + ! updated on Jan 1st instead of at harvest (slevis) + if (a5tmin(p) /= spval .and. & + a5tmin(p) <= minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + (gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p)))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + ! latest possible date to plant winter cereal and after all other + ! crops were harvested for that year + + else if (jday >= maxplantjday(ivt(p),h) .and. & + gdd020(p) /= spval .and. & + gdd020(p) >= gddmin(ivt(p))) then + + cumvd(p) = 0._r8 + hdidx(p) = 0._r8 + vf(p) = 0._r8 + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + gddmaturity(p) = hybgdd(ivt(p)) + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + else + gddmaturity(p) = 0._r8 + end if + + else ! not winter cereal... slevis: added distinction between NH and SH + ! slevis: The idea is that jday will equal idop sooner or later in the year + ! while the gdd part is either true or false for the year. + if (t10(p) /= spval.and. a10tmin(p) /= spval .and. & + t10(p) > planttemp(ivt(p)) .and. & + a10tmin(p) > minplanttemp(ivt(p)) .and. & + jday >= minplantjday(ivt(p),h) .and. & + jday <= maxplantjday(ivt(p),h) .and. & + t10(p) /= spval .and. a10tmin(p) /= spval .and. & + gdd820(p) /= spval .and. & + gdd820(p) >= gddmin(ivt(p))) then + + ! impose limit on growing season length needed + ! for crop maturity - for cold weather constraints + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + ! go a specified amount of time before/after + ! climatological date + if (ivt(p)==nsoybean) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p))) + if (ivt(p)==ncorn) then + gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + gddmaturity(p)=max(950._r8, min(gddmaturity(p)+150._r8,1850._r8)) + end if + if (ivt(p)==nscereal) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p))) + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + ! If hit the max planting julian day -- go ahead and plant + else if (jday == maxplantjday(ivt(p),h) .and. gdd820(p) > 0._r8 .and. & + gdd820(p) /= spval ) then + croplive(p) = .true. + cropplant(p) = .true. + idop(p) = jday + harvdate(p) = NOT_Harvested + + if (ivt(p)==nsoybean) gddmaturity(p)=min(gdd1020(p),hybgdd(ivt(p))) + if (ivt(p)==ncorn) gddmaturity(p)=max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) + if (ivt(p)==nscereal) gddmaturity(p)=min(gdd020(p),hybgdd(ivt(p))) + + leafc_xfer(p) = 1._r8 ! initial seed at planting to appear + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) + leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) + leafn_xfer(p)/dt + + else + gddmaturity(p) = 0._r8 + end if + end if ! crop pft distinction + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! calculate threshold from phase 1 to phase 2: + ! threshold for attaining leaf emergence (based on fraction of + ! gdd(i) -- climatological average) + ! Hayhoe and Dwyer, 1990, Can. J. Soil Sci 70:493-497 + ! Carlson and Gage, 1989, Agric. For. Met., 45: 313-324 + ! J.T. Ritchie, 1991: Modeling Plant and Soil systems + + huileaf(p) = lfemerg(ivt(p)) * gddmaturity(p) ! 3-7% in cereal + + ! calculate threshhold from phase 2 to phase 3: + ! from leaf emergence to beginning of grain-fill period + ! this hypothetically occurs at the end of tassling, not the beginning + ! tassel initiation typically begins at 0.5-0.55 * gddmaturity + + ! calculate linear relationship between huigrain fraction and relative + ! maturity rating for maize + + if (ivt(p) == ncorn) then + ! the following estimation of crmcorn from gddmaturity is based on a linear + ! regression using data from Pioneer-brand corn hybrids (Kucharik, 2003, + ! Earth Interactions 7:1-33: fig. 2) + crmcorn = max(73._r8, min(135._r8, (gddmaturity(p)+ 53.683_r8)/13.882_r8)) + + ! the following adjustment of grnfill based on crmcorn is based on a tuning + ! of Agro-IBIS to give reasonable results for max LAI and the seasonal + ! progression of LAI growth (pers. comm. C. Kucharik June 10, 2010) + huigrain(p) = -0.002_r8 * (crmcorn - 73._r8) + grnfill(ivt(p)) + + huigrain(p) = min(max(huigrain(p), grnfill(ivt(p))-0.1_r8), grnfill(ivt(p))) + huigrain(p) = huigrain(p) * gddmaturity(p) ! Cabelguenne et + else + huigrain(p) = grnfill(ivt(p)) * gddmaturity(p) ! al. 1999 + end if + + end if ! crop not live nor planted + + ! ---------------------------------- + ! from AgroIBIS subroutine phenocrop + ! ---------------------------------- + + ! all of the phenology changes are based on the total number of gdd needed + ! to change to the next phase - based on fractions of the total gdd typical + ! for that region based on the April 1 - Sept 30 window of development + + ! crop phenology (gdd thresholds) controlled by gdd needed for + ! maturity (physiological) which is based on the average gdd + ! accumulation and hybrids in United States from April 1 - Sept 30 + + ! Phase 1: Planting to leaf emergence (now in CNAllocation) + ! Phase 2: Leaf emergence to beginning of grain fill (general LAI accumulation) + ! Phase 3: Grain fill to physiological maturity and harvest (LAI decline) + ! Harvest: if gdd past grain fill initiation exceeds limit + ! or number of days past planting reaches a maximum, the crop has + ! reached physiological maturity and plant is harvested; + ! crop could be live or dead at this stage - these limits + ! could lead to reaching physiological maturity or determining + ! a harvest date for a crop killed by an early frost (see next comments) + ! --- --- --- + ! keeping comments without the code (slevis): + ! if minimum temperature, t_ref2m_min <= freeze kill threshold, tkill + ! for 3 consecutive days and lai is above a minimum, + ! plant will be damaged/killed. This function is more for spring freeze events + ! or for early fall freeze events + + ! spring temperate cereal is affected by this, winter cereal kill function + ! is determined in crops.f - is a more elaborate function of + ! cold hardening of the plant + + ! currently simulates too many grid cells killed by freezing temperatures + + ! removed on March 12 2002 - C. Kucharik + ! until it can be a bit more refined, or used at a smaller scale. + ! we really have no way of validating this routine + ! too difficult to implement on 0.5 degree scale grid cells + ! --- --- --- + + onset_flag(p) = 0._r8 ! CN terminology to trigger certain + offset_flag(p) = 0._r8 ! carbon and nitrogen transfers + + if (croplive(p)) then + + ! call vernalization if winter temperate cereal planted, living, and the + ! vernalization factor is not 1; + ! vf affects the calculation of gddtsoi & gddplant + + if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. ivt(p) == nwcereal) then + call vernalization(p) + end if + + ! days past planting may determine harvest + + if (jday >= idop(p)) then + idpp = jday - idop(p) + else + idpp = int(dayspyr) + jday - idop(p) + end if + + ! onset_counter initialized to zero when .not. croplive + ! offset_counter relevant only at time step of harvest + + onset_counter(p) = onset_counter(p) - dt + + ! enter phase 2 onset for one time step: + ! transfer seed carbon to leaf emergence + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then + if (abs(onset_counter(p)) > 1.e-6_r8) then + onset_flag(p) = 1._r8 + onset_counter(p) = dt + else + onset_counter(p) = dt ! ensure no re-entry to onset of phase2 + end if + + ! enter harvest for one time step: + ! - transfer live biomass to litter and to crop yield + ! - send xsmrpool to the atmosphere + ! if onset and harvest needed to last longer than one timestep + ! the onset_counter would change from dt and you'd need to make + ! changes to the offset subroutine below + + else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then + if (harvdate(p) >= NOT_Harvested) harvdate(p) = jday + croplive(p) = .false. ! no re-entry in greater if-block + if (tlai(p) > 0._r8) then ! plant had emerged before harvest + offset_flag(p) = 1._r8 + offset_counter(p) = dt + else ! plant never emerged from the ground + dwt_seedc_to_leaf(c) = dwt_seedc_to_leaf(c) - leafc_xfer(p)/dt + dwt_seedn_to_leaf(c) = dwt_seedn_to_leaf(c) - leafn_xfer(p)/dt + leafc_xfer(p) = 0._r8 ! revert planting transfers + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + end if + + ! enter phase 3 while previous criteria fail and next is true; + ! in terms of order, phase 3 occurs before harvest, but when + ! harvest *can* occur, we want it to have first priority. + ! AgroIBIS uses a complex formula for lai decline. + ! Use CN's simple formula at least as a place holder (slevis) + + else if (hui(p) >= huigrain(p)) then + bglfr(p) = 1._r8/(leaf_long(ivt(p))*dayspyr*secspday) + end if + + else ! crop not live + onset_counter(p) = 0._r8 + leafc_xfer(p) = 0._r8 + leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + end if ! croplive + + end do ! prognostic crops loop + +end subroutine CropPhenology +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CropPhenologyInit +! +! !INTERFACE: +subroutine CropPhenologyInit( begp, endp ) + +! !DESCRIPTION: +! Initialization of CropPhenology. Must be called after time-manager is +! initialized, and after pftcon file is read in. +! +! !USES: + use pftvarcon , only: nwcereal, nsoybean, ncorn, nscereal, & + npcropmin, npcropmax, mnNHplantdate, & + mnSHplantdate, mxNHplantdate, & + mxSHplantdate + use clm_time_manager, only: get_calday +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begp, endp ! Beginning and ending PFT index +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +!EOP + +! LOCAL VARAIBLES: + real(r8), pointer :: latdeg(:) ! latitude (radians) + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer :: p,g,n,i ! indices +!------------------------------------------------------------------------ + latdeg => grc%latdeg + pgridcell => pft%gridcell + + allocate( inhemi(begp:endp) ) + + ! Julian day for the start of the year (mid-winter) + jdayyrstart(inNH) = 1 + jdayyrstart(inSH) = 182 + + ! Convert planting dates into julian day + minplantjday(:,:) = huge(1) + maxplantjday(:,:) = huge(1) + do n = npcropmin, npcropmax + minplantjday(n,inNH) = int( get_calday( mnNHplantdate(n), 0 ) ) + maxplantjday(n,inNH) = int( get_calday( mxNHplantdate(n), 0 ) ) + end do + do n = npcropmin, npcropmax + minplantjday(n,inSH) = int( get_calday( mnSHplantdate(n), 0 ) ) + maxplantjday(n,inSH) = int( get_calday( mxSHplantdate(n), 0 ) ) + end do + + ! Figure out what hemisphere each PFT is in + do p = begp, endp + g = pgridcell(p) + ! Northern hemisphere + if ( latdeg(g) > 0.0_r8 )then + inhemi(p) = inNH + else + inhemi(p) = inSH + end if + end do + + ! + ! Constants for Crop vernalization + ! + + ! photoperiod factor calculation + ! genetic constant - can be modified + + p1d = 0.004_r8 ! average for genotypes from Ritchey, 1991. + ! Modeling plant & soil systems: Wheat phasic developmt + p1v = 0.003_r8 ! average for genotypes from Ritchey, 1991. + + hti = 1._r8 + tbase = 0._r8 + +end subroutine CropPhenologyInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: vernalization +! +! !INTERFACE: + subroutine vernalization(p) +! +! !DESCRIPTION: +! +! * * * only call for winter temperate cereal * * * +! +! subroutine calculates vernalization and photoperiod effects on +! gdd accumulation in winter temperate cereal varieties. Thermal time accumulation +! is reduced in 1st period until plant is fully vernalized. During this +! time of emergence to spikelet formation, photoperiod can also have a +! drastic effect on plant development. +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: p ! PFT index running over +! +! !REVISION HISTORY: +! Created by Sam Levis from AGROIBIS +! +!EOP + +! LOCAL VARAIBLES: + real(r8) tcrown ! ? + real(r8) vd, vd1, vd2 ! vernalization dependence + real(r8) tkil ! Freeze kill threshold + integer c,g ! indices +! local pointers to implicit in scalars + integer , pointer :: pcolumn(:) ! pft's column index + logical , pointer :: croplive(:) ! Flag, true if planted, not harvested + real(r8), pointer :: tlai(:) ! one-sided leaf area index, no burying by snow + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min(:) !daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max(:) !daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: snowdp(:) ! snow height (m) +! local pointers to implicit out scalars + real(r8), pointer :: vf(:) ! vernalization factor for cereal + real(r8), pointer :: cumvd(:) ! cumulative vernalization d?ependence? + real(r8), pointer :: gddmaturity(:) ! gdd needed to harvest + real(r8), pointer :: huigrain(:) ! heat unit index needed to reach vegetative maturity + real(r8), pointer :: hdidx(:) ! cold hardening index? +!------------------------------------------------------------------------ + + pcolumn => pft%column + croplive => pps%croplive + hdidx => pps%hdidx + cumvd => pps%cumvd + vf => pps%vf + gddmaturity => pps%gddmaturity + huigrain => pps%huigrain + tlai => pps%tlai + t_ref2m => pes%t_ref2m + t_ref2m_min => pes%t_ref2m_min + t_ref2m_max => pes%t_ref2m_max + snowdp => cps%snowdp + + c = pcolumn(p) + + ! for all equations - temperatures must be in degrees (C) + ! calculate temperature of crown of crop (e.g., 3 cm soil temperature) + ! snow depth in centimeters + + if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K) + tcrown = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snowdp(c)*100._r8, 15._r8) - 15._r8)**2) + else !slevis: snowdp inst of adsnod=daily average (m) + tcrown = t_ref2m(p) - tfrz + end if + + ! vernalization factor calculation + ! if vf(p) = 1. then plant is fully vernalized - and thermal time + ! accumulation in phase 1 will be unaffected + ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis) + ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis) + + if (t_ref2m_max(p) > tfrz) then + if (t_ref2m_min(p) <= tfrz+15._r8) then + vd1 = 1.4_r8 - 0.0778_r8 * tcrown + vd2 = 0.5_r8 + 13.44_r8 / ((t_ref2m_max(p)-t_ref2m_min(p)+3._r8)**2) * tcrown + vd = max(0._r8, min(1._r8, vd1, vd2)) + cumvd(p) = cumvd(p) + vd + end if + + if (cumvd(p) < 10._r8 .and. t_ref2m_max(p) > tfrz+30._r8) then + cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8) + end if + cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + + vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p)) + vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + end if + + ! calculate cold hardening of plant + ! determines for winter cereal varieties whether the plant has completed + ! a period of cold hardening to protect it from freezing temperatures. If + ! not, then exposure could result in death or killing of plants. + + ! there are two distinct phases of hardening + + if (t_ref2m_min(p) <= tfrz-3._r8 .or. hdidx(p) /= 0._r8) then + if (hdidx(p) >= hti) then ! done with phase 1 + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + + else if (tcrown >= tbase-1._r8) then + if (tcrown <= tbase+8._r8) then + hdidx(p) = hdidx(p) + 0.1_r8 - (tcrown-tbase+3.5_r8)**2 / 506._r8 + if (hdidx(p) >= hti .and. tcrown <= tbase + 0._r8) then + hdidx(p) = hdidx(p) + 0.083_r8 + hdidx(p) = min(hdidx(p), hti*2._r8) + end if + end if + + if (t_ref2m_max(p) >= tbase + tfrz + 10._r8) then + hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + if (hdidx(p) > hti) hdidx(p) = hdidx(p) - 0.02_r8 * (t_ref2m_max(p)-tbase-tfrz-10._r8) + hdidx(p) = max(0._r8, hdidx(p)) + end if + end if + + ! calculate what the cereal killing temperature + ! there is a linear inverse relationship between + ! hardening of the plant and the killing temperature or + ! threshold that the plant can withstand + ! when plant is fully-hardened (hdidx = 2), the killing threshold is -18 C + + ! will have to develop some type of relationship that reduces LAI and + ! biomass pools in response to cold damaged crop + + if (t_ref2m_min(p) <= tfrz - 6._r8) then + tkil = (tbase - 6._r8) - 6._r8 * hdidx(p) + if (tkil >= tcrown) then + if ((0.95_r8 - 0.02_r8 * (tcrown - tkil)**2) >= 0.02_r8) then + write (iulog,*) 'crop damaged by cold temperatures at p,c =', p,c + else if (tlai(p) > 0._r8) then ! slevis: kill if past phase1 + gddmaturity(p) = 0._r8 ! by forcing through + huigrain(p) = 0._r8 ! harvest + write (iulog,*) '95% of crop killed by cold temperatures at p,c =', p,c + end if + end if + end if + + end subroutine vernalization + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNOnsetGrowth +! +! !INTERFACE: +subroutine CNOnsetGrowth (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Determines the flux of stored C and N from transfer pools to display +! pools during the phenological onset period. +! +! !USES: +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/27/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: onset_flag(:) ! onset flag + real(r8), pointer :: onset_counter(:) ! onset days counter + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: bgtr(:) ! background transfer growth rate (1/s) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: leafn_xfer_to_leafn(:) + real(r8), pointer :: frootn_xfer_to_frootn(:) + real(r8), pointer :: livestemn_xfer_to_livestemn(:) + real(r8), pointer :: deadstemn_xfer_to_deadstemn(:) + real(r8), pointer :: livecrootn_xfer_to_livecrootn(:) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:) +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + real(r8):: t1 ! temporary variable + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + onset_flag => pepv%onset_flag + onset_counter => pepv%onset_counter + leafc_xfer => pcs%leafc_xfer + frootc_xfer => pcs%frootc_xfer + livestemc_xfer => pcs%livestemc_xfer + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc_xfer => pcs%deadcrootc_xfer + leafn_xfer => pns%leafn_xfer + frootn_xfer => pns%frootn_xfer + livestemn_xfer => pns%livestemn_xfer + deadstemn_xfer => pns%deadstemn_xfer + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn_xfer => pns%deadcrootn_xfer + bgtr => pepv%bgtr + woody => pftcon%woody + + ! assign local pointers to derived type arrays (out) + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + leafn_xfer_to_leafn => pnf%leafn_xfer_to_leafn + frootn_xfer_to_frootn => pnf%frootn_xfer_to_frootn + livestemn_xfer_to_livestemn => pnf%livestemn_xfer_to_livestemn + deadstemn_xfer_to_deadstemn => pnf%deadstemn_xfer_to_deadstemn + livecrootn_xfer_to_livecrootn => pnf%livecrootn_xfer_to_livecrootn + deadcrootn_xfer_to_deadcrootn => pnf%deadcrootn_xfer_to_deadcrootn + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes during onset period + if (onset_flag(p) == 1._r8) then + + ! The transfer rate is a linearly decreasing function of time, + ! going to zero on the last timestep of the onset period + + if (onset_counter(p) == dt) then + t1 = 1.0_r8 / dt + else + t1 = 2.0_r8 / (onset_counter(p)) + end if + leafc_xfer_to_leafc(p) = t1 * leafc_xfer(p) + frootc_xfer_to_frootc(p) = t1 * frootc_xfer(p) + leafn_xfer_to_leafn(p) = t1 * leafn_xfer(p) + frootn_xfer_to_frootn(p) = t1 * frootn_xfer(p) + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = t1 * livestemc_xfer(p) + deadstemc_xfer_to_deadstemc(p) = t1 * deadstemc_xfer(p) + livecrootc_xfer_to_livecrootc(p) = t1 * livecrootc_xfer(p) + deadcrootc_xfer_to_deadcrootc(p) = t1 * deadcrootc_xfer(p) + livestemn_xfer_to_livestemn(p) = t1 * livestemn_xfer(p) + deadstemn_xfer_to_deadstemn(p) = t1 * deadstemn_xfer(p) + livecrootn_xfer_to_livecrootn(p) = t1 * livecrootn_xfer(p) + deadcrootn_xfer_to_deadcrootn(p) = t1 * deadcrootn_xfer(p) + end if + + end if ! end if onset period + + ! calculate the background rate of transfer growth (used for stress + ! deciduous algorithm). In this case, all of the mass in the transfer + ! pools should be moved to displayed growth in each timestep. + + if (bgtr(p) > 0._r8) then + leafc_xfer_to_leafc(p) = leafc_xfer(p) / dt + frootc_xfer_to_frootc(p) = frootc_xfer(p) / dt + leafn_xfer_to_leafn(p) = leafn_xfer(p) / dt + frootn_xfer_to_frootn(p) = frootn_xfer(p) / dt + if (woody(ivt(p)) == 1.0_r8) then + livestemc_xfer_to_livestemc(p) = livestemc_xfer(p) / dt + deadstemc_xfer_to_deadstemc(p) = deadstemc_xfer(p) / dt + livecrootc_xfer_to_livecrootc(p) = livecrootc_xfer(p) / dt + deadcrootc_xfer_to_deadcrootc(p) = deadcrootc_xfer(p) / dt + livestemn_xfer_to_livestemn(p) = livestemn_xfer(p) / dt + deadstemn_xfer_to_deadstemn(p) = deadstemn_xfer(p) / dt + livecrootn_xfer_to_livecrootn(p) = livecrootn_xfer(p) / dt + deadcrootn_xfer_to_deadcrootn(p) = deadcrootn_xfer(p) / dt + end if + end if ! end if bgtr + + end do ! end pft loop + +end subroutine CNOnsetGrowth +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNOffsetLitterfall +! +! !INTERFACE: +subroutine CNOffsetLitterfall (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Determines the flux of C and N from displayed pools to litter +! pools during the phenological offset period. +! +! !USES: + use pftvarcon , only: npcropmin +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/27/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: offset_flag(:) ! offset flag + real(r8), pointer :: offset_counter(:) ! offset days counter + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: cpool_to_leafc(:) ! allocation to leaf C (gC/m2/s) + real(r8), pointer :: cpool_to_frootc(:) ! allocation to fine root C (gC/m2/s) +! integer , pointer :: pcolumn(:) ! pft's column index + real(r8), pointer :: grainc(:) ! (gC/m2) grain C + real(r8), pointer :: livestemc(:) ! (gC/m2) livestem C + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc(:) ! allocation to live stem C (gC/m2/s) + real(r8), pointer :: livewdcn(:) ! live wood C:N (gC/gN) + real(r8), pointer :: graincn(:) ! grain C:N (gC/gN) + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) + real(r8), pointer :: lflitcn(:) ! leaf litter C:N (gC/gN) + real(r8), pointer :: frootcn(:) ! fine root C:N (gC/gN) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: prev_leafc_to_litter(:) ! previous timestep leaf C litterfall flux (gC/m2/s) + real(r8), pointer :: prev_frootc_to_litter(:) ! previous timestep froot C litterfall flux (gC/m2/s) + real(r8), pointer :: leafc_to_litter(:) ! leaf C litterfall (gC/m2/s) + real(r8), pointer :: frootc_to_litter(:) ! fine root C litterfall (gC/m2/s) + real(r8), pointer :: leafn_to_litter(:) ! leaf N litterfall (gN/m2/s) + real(r8), pointer :: leafn_to_retransn(:) ! leaf N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_litter(:) ! fine root N litterfall (gN/m2/s) + real(r8), pointer :: livestemc_to_litter(:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food(:) ! grain C to food (gC/m2/s) + real(r8), pointer :: livestemn_to_litter(:) ! livestem N to litter (gN/m2/s) + real(r8), pointer :: grainn_to_food(:) ! grain N to food (gN/m2/s) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: p, c ! indices + integer :: fp ! lake filter pft index + real(r8):: t1 ! temporary variable + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + offset_flag => pepv%offset_flag + offset_counter => pepv%offset_counter + leafc => pcs%leafc + frootc => pcs%frootc + grainc => pcs%grainc + livestemc => pcs%livestemc + cpool_to_grainc => pcf%cpool_to_grainc + cpool_to_livestemc => pcf%cpool_to_livestemc + cpool_to_leafc => pcf%cpool_to_leafc + cpool_to_frootc => pcf%cpool_to_frootc + leafcn => pftcon%leafcn + lflitcn => pftcon%lflitcn + frootcn => pftcon%frootcn + livewdcn => pftcon%livewdcn + graincn => pftcon%graincn + + ! assign local pointers to derived type arrays (out) + prev_leafc_to_litter => pepv%prev_leafc_to_litter + prev_frootc_to_litter => pepv%prev_frootc_to_litter + leafc_to_litter => pcf%leafc_to_litter + frootc_to_litter => pcf%frootc_to_litter + livestemc_to_litter => pcf%livestemc_to_litter + grainc_to_food => pcf%grainc_to_food + livestemn_to_litter => pnf%livestemn_to_litter + grainn_to_food => pnf%grainn_to_food + leafn_to_litter => pnf%leafn_to_litter + leafn_to_retransn => pnf%leafn_to_retransn + frootn_to_litter => pnf%frootn_to_litter + + ! The litterfall transfer rate starts at 0.0 and increases linearly + ! over time, with displayed growth going to 0.0 on the last day of litterfall + + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate fluxes during offset period + if (offset_flag(p) == 1._r8) then + + if (offset_counter(p) == dt) then + t1 = 1.0_r8 / dt + leafc_to_litter(p) = t1 * leafc(p) + cpool_to_leafc(p) + frootc_to_litter(p) = t1 * frootc(p) + cpool_to_frootc(p) + ! this assumes that offset_counter == dt for crops + ! if this were ever changed, we'd need to add code to the "else" + if (ivt(p) >= npcropmin) then + grainc_to_food(p) = t1 * grainc(p) + cpool_to_grainc(p) + livestemc_to_litter(p) = t1 * livestemc(p) + cpool_to_livestemc(p) + end if + else + t1 = dt * 2.0_r8 / (offset_counter(p) * offset_counter(p)) + leafc_to_litter(p) = prev_leafc_to_litter(p) + t1*(leafc(p) - prev_leafc_to_litter(p)*offset_counter(p)) + frootc_to_litter(p) = prev_frootc_to_litter(p) + t1*(frootc(p) - prev_frootc_to_litter(p)*offset_counter(p)) + end if + + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + if (ivt(p) >= npcropmin) then + livestemn_to_litter(p) = livestemc_to_litter(p) / livewdcn(ivt(p)) + grainn_to_food(p) = grainc_to_food(p) / graincn(ivt(p)) + end if + + ! save the current litterfall fluxes + prev_leafc_to_litter(p) = leafc_to_litter(p) + prev_frootc_to_litter(p) = frootc_to_litter(p) + + end if ! end if offset period + + end do ! end pft loop + +end subroutine CNOffsetLitterfall +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNBackgroundLitterfall +! +! !INTERFACE: +subroutine CNBackgroundLitterfall (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Determines the flux of C and N from displayed pools to litter +! pools as the result of background litter fall. +! +! !USES: +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 10/2/03: Created by Peter Thornton +! 10/24/03, Peter Thornton: migrated to vector data structures +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + ! pft level + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + ! ecophysiological constants + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) + real(r8), pointer :: lflitcn(:) ! leaf litter C:N (gC/gN) + real(r8), pointer :: frootcn(:) ! fine root C:N (gC/gN) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: leafn_to_litter(:) + real(r8), pointer :: leafn_to_retransn(:) + real(r8), pointer :: frootn_to_litter(:) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + bglfr => pepv%bglfr + leafc => pcs%leafc + frootc => pcs%frootc + leafcn => pftcon%leafcn + lflitcn => pftcon%lflitcn + frootcn => pftcon%frootcn + + ! assign local pointers to derived type arrays (out) + leafc_to_litter => pcf%leafc_to_litter + frootc_to_litter => pcf%frootc_to_litter + leafn_to_litter => pnf%leafn_to_litter + leafn_to_retransn => pnf%leafn_to_retransn + frootn_to_litter => pnf%frootn_to_litter + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes if the background litterfall rate is non-zero + if (bglfr(p) > 0._r8) then + ! units for bglfr are already 1/s + leafc_to_litter(p) = bglfr(p) * leafc(p) + frootc_to_litter(p) = bglfr(p) * frootc(p) + + ! calculate the leaf N litterfall and retranslocation + leafn_to_litter(p) = leafc_to_litter(p) / lflitcn(ivt(p)) + leafn_to_retransn(p) = (leafc_to_litter(p) / leafcn(ivt(p))) - leafn_to_litter(p) + + ! calculate fine root N litterfall (no retranslocation of fine root N) + frootn_to_litter(p) = frootc_to_litter(p) / frootcn(ivt(p)) + + end if + + end do + +end subroutine CNBackgroundLitterfall +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNLivewoodTurnover +! +! !INTERFACE: +subroutine CNLivewoodTurnover (num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Determines the flux of C and N from live wood to +! dead wood pools, for stem and coarse root. +! +! !USES: +! +! !ARGUMENTS: + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 12/5/03: created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + ! pft level + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + ! ecophysiological constants + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: livewdcn(:) ! live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8), pointer :: deadwdcn(:) ! dead wood (xylem and heartwood) C:N (gC/gN) +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: livestemc_to_deadstemc(:) + real(r8), pointer :: livecrootc_to_deadcrootc(:) + real(r8), pointer :: livestemn_to_deadstemn(:) + real(r8), pointer :: livestemn_to_retransn(:) + real(r8), pointer :: livecrootn_to_deadcrootn(:) + real(r8), pointer :: livecrootn_to_retransn(:) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: p ! indices + integer :: fp ! lake filter pft index + real(r8):: ctovr ! temporary variable for carbon turnover + real(r8):: ntovr ! temporary variable for nitrogen turnover + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + livestemc => pcs%livestemc + livecrootc => pcs%livecrootc + livestemn => pns%livestemn + livecrootn => pns%livecrootn + woody => pftcon%woody + livewdcn => pftcon%livewdcn + deadwdcn => pftcon%deadwdcn + + ! assign local pointers to derived type arrays (out) + livestemc_to_deadstemc => pcf%livestemc_to_deadstemc + livecrootc_to_deadcrootc => pcf%livecrootc_to_deadcrootc + livestemn_to_deadstemn => pnf%livestemn_to_deadstemn + livestemn_to_retransn => pnf%livestemn_to_retransn + livecrootn_to_deadcrootn => pnf%livecrootn_to_deadcrootn + livecrootn_to_retransn => pnf%livecrootn_to_retransn + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! only calculate these fluxes for woody types + if (woody(ivt(p)) > 0._r8) then + + ! live stem to dead stem turnover + + ctovr = livestemc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + livestemc_to_deadstemc(p) = ctovr + livestemn_to_deadstemn(p) = ctovr / deadwdcn(ivt(p)) + livestemn_to_retransn(p) = ntovr - livestemn_to_deadstemn(p) + + ! live coarse root to dead coarse root turnover + + ctovr = livecrootc(p) * lwtop + ntovr = ctovr / livewdcn(ivt(p)) + livecrootc_to_deadcrootc(p) = ctovr + livecrootn_to_deadcrootn(p) = ctovr / deadwdcn(ivt(p)) + livecrootn_to_retransn(p) = ntovr - livecrootn_to_deadcrootn(p) + + end if + + end do + +end subroutine CNLivewoodTurnover +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNLitterToColumn +! +! !INTERFACE: +subroutine CNLitterToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! called at the end of cn_phenology to gather all pft-level litterfall fluxes +! to the column level and assign them to the three litter pools +! +! !USES: + use clm_varpar, only : max_pft_per_col + use pftvarcon , only : npcropmin +! +! !ARGUMENTS: + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNPhenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! weight (relative to column) for this pft (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: leafc_to_litter(:) ! leaf C litterfall (gC/m2/s) + real(r8), pointer :: frootc_to_litter(:) ! fine root N litterfall (gN/m2/s) + real(r8), pointer :: livestemc_to_litter(:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food(:) ! grain C to food (gC/m2/s) + real(r8), pointer :: livestemn_to_litter(:) ! livestem N to litter (gN/m2/s) + real(r8), pointer :: grainn_to_food(:) ! grain N to food (gN/m2/s) + real(r8), pointer :: leafn_to_litter(:) ! leaf N litterfall (gN/m2/s) + real(r8), pointer :: frootn_to_litter(:) ! fine root N litterfall (gN/m2/s) + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column +! +! local pointers to implicit in/out scalars +! + real(r8), pointer :: leafc_to_litr1c(:) ! leaf C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr2c(:) ! leaf C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr3c(:) ! leaf C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr1c(:) ! fine root C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr2c(:) ! fine root C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr3c(:) ! fine root C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr1c(:) ! livestem C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr2c(:) ! livestem C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr3c(:) ! livestem C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: livestemn_to_litr1n(:) ! livestem N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr2n(:) ! livestem N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr3n(:) ! livestem N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: grainc_to_litr1c(:) ! grain C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr2c(:) ! grain C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr3c(:) ! grain C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: grainn_to_litr1n(:) ! grain N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr2n(:) ! grain N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr3n(:) ! grain N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr1n(:) ! leaf N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr2n(:) ! leaf N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr3n(:) ! leaf N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr1n(:) ! fine root N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr2n(:) ! fine root N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr3n(:) ! fine root N litterfall to litter 3 N (gN/m2/s) +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices +!EOP +!----------------------------------------------------------------------- + ! assign local pointers to derived type arrays (in) + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + leafc_to_litter => pcf%leafc_to_litter + frootc_to_litter => pcf%frootc_to_litter + livestemc_to_litter => pcf%livestemc_to_litter + grainc_to_food => pcf%grainc_to_food + livestemn_to_litter => pnf%livestemn_to_litter + grainn_to_food => pnf%grainn_to_food + leafn_to_litter => pnf%leafn_to_litter + frootn_to_litter => pnf%frootn_to_litter + npfts => col%npfts + pfti => col%pfti + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to derived type arrays (out) + leafc_to_litr1c => ccf%leafc_to_litr1c + leafc_to_litr2c => ccf%leafc_to_litr2c + leafc_to_litr3c => ccf%leafc_to_litr3c + frootc_to_litr1c => ccf%frootc_to_litr1c + frootc_to_litr2c => ccf%frootc_to_litr2c + frootc_to_litr3c => ccf%frootc_to_litr3c + grainc_to_litr1c => ccf%grainc_to_litr1c + grainc_to_litr2c => ccf%grainc_to_litr2c + grainc_to_litr3c => ccf%grainc_to_litr3c + livestemc_to_litr1c => ccf%livestemc_to_litr1c + livestemc_to_litr2c => ccf%livestemc_to_litr2c + livestemc_to_litr3c => ccf%livestemc_to_litr3c + livestemn_to_litr1n => cnf%livestemn_to_litr1n + livestemn_to_litr2n => cnf%livestemn_to_litr2n + livestemn_to_litr3n => cnf%livestemn_to_litr3n + grainn_to_litr1n => cnf%grainn_to_litr1n + grainn_to_litr2n => cnf%grainn_to_litr2n + grainn_to_litr3n => cnf%grainn_to_litr3n + leafn_to_litr1n => cnf%leafn_to_litr1n + leafn_to_litr2n => cnf%leafn_to_litr2n + leafn_to_litr3n => cnf%leafn_to_litr3n + frootn_to_litr1n => cnf%frootn_to_litr1n + frootn_to_litr2n => cnf%frootn_to_litr2n + frootn_to_litr3n => cnf%frootn_to_litr3n + + do pi = 1,max_pft_per_col + do fc = 1,num_soilc + c = filter_soilc(fc) + + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 + if (pwtgcell(p)>0._r8) then + + ! leaf litter carbon fluxes + leafc_to_litr1c(c) = leafc_to_litr1c(c) + leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + leafc_to_litr2c(c) = leafc_to_litr2c(c) + leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + leafc_to_litr3c(c) = leafc_to_litr3c(c) + leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! leaf litter nitrogen fluxes + leafn_to_litr1n(c) = leafn_to_litr1n(c) + leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + leafn_to_litr2n(c) = leafn_to_litr2n(c) + leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + leafn_to_litr3n(c) = leafn_to_litr3n(c) + leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root litter carbon fluxes + frootc_to_litr1c(c) = frootc_to_litr1c(c) + frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + frootc_to_litr2c(c) = frootc_to_litr2c(c) + frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + frootc_to_litr3c(c) = frootc_to_litr3c(c) + frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! fine root litter nitrogen fluxes + frootn_to_litr1n(c) = frootn_to_litr1n(c) + frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + frootn_to_litr2n(c) = frootn_to_litr2n(c) + frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + frootn_to_litr3n(c) = frootn_to_litr3n(c) + frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + + ! agroibis puts crop stem litter together with leaf litter + ! so I've used the leaf lf_f* parameters instead of making + ! new ones for now (slevis) + ! also for simplicity I've put "food" into the litter pools + if (ivt(p) >= npcropmin) then ! add livestemc to litter + ! stem litter carbon fluxes + livestemc_to_litr1c(c) = livestemc_to_litr1c(c) + livestemc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + livestemc_to_litr2c(c) = livestemc_to_litr2c(c) + livestemc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + livestemc_to_litr3c(c) = livestemc_to_litr3c(c) + livestemc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! stem litter nitrogen fluxes + livestemn_to_litr1n(c) = livestemn_to_litr1n(c) + livestemn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + livestemn_to_litr2n(c) = livestemn_to_litr2n(c) + livestemn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + livestemn_to_litr3n(c) = livestemn_to_litr3n(c) + livestemn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! grain litter carbon fluxes + grainc_to_litr1c(c) = grainc_to_litr1c(c) + grainc_to_food(p) * lf_flab(ivt(p)) * wtcol(p) + grainc_to_litr2c(c) = grainc_to_litr2c(c) + grainc_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) + grainc_to_litr3c(c) = grainc_to_litr3c(c) + grainc_to_food(p) * lf_flig(ivt(p)) * wtcol(p) + + ! grain litter nitrogen fluxes + grainn_to_litr1n(c) = grainn_to_litr1n(c) + grainn_to_food(p) * lf_flab(ivt(p)) * wtcol(p) + grainn_to_litr2n(c) = grainn_to_litr2n(c) + grainn_to_food(p) * lf_fcel(ivt(p)) * wtcol(p) + grainn_to_litr3n(c) = grainn_to_litr3n(c) + grainn_to_food(p) * lf_flig(ivt(p)) * wtcol(p) + end if + end if + end if + + end do + + end do + +end subroutine CNLitterToColumn +!----------------------------------------------------------------------- + +end module CNPhenologyMod diff --git a/components/clm/src_clm40/biogeochem/CNPrecisionControlMod.F90 b/components/clm/src_clm40/biogeochem/CNPrecisionControlMod.F90 new file mode 100644 index 0000000000..9acac12aca --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNPrecisionControlMod.F90 @@ -0,0 +1,737 @@ +module CNPrecisionControlMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNPrecisionControlMod +! +! !DESCRIPTION: +! controls on very low values in critical state variables +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CNPrecisionControl +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNPrecisionControl +! +! !INTERFACE: +subroutine CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, force leaf and deadstem c and n to 0 if +! they get too small. +! +! !USES: + use clmtype + use abortutils, only: endrun + use clm_varctl, only: iulog, use_c13 + use pftvarcon, only: nc3crop + use surfrdMod, only: crop_prog +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 8/1/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + + real(r8), pointer :: c13_col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: c13_cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: c13_litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: c13_litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: c13_litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: c13_soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: c13_soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: c13_soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: c13_soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + + real(r8), pointer :: col_ntrunc(:) ! (gN/m2) column-level sink for N truncation + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: soil1n(:) ! (gN/m2) soil organic matter N (fast pool) + real(r8), pointer :: soil2n(:) ! (gN/m2) soil organic matter N (medium pool) + real(r8), pointer :: soil3n(:) ! (gN/m2) soil orgainc matter N (slow pool) + real(r8), pointer :: soil4n(:) ! (gN/m2) soil orgainc matter N (slowest pool) + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: pft_ctrunc(:) ! (gC/m2) pft-level sink for C truncation + real(r8), pointer :: xsmrpool(:) ! (gC/m2) execss maint resp C pool + real(r8), pointer :: grainc(:) ! (gC/m2) grain C + real(r8), pointer :: grainc_storage(:) ! (gC/m2) grain C storage + real(r8), pointer :: grainc_xfer(:) ! (gC/m2) grain C transfer + + real(r8), pointer :: c13_cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: c13_deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: c13_deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: c13_deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: c13_deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: c13_deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: c13_deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: c13_frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: c13_frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: c13_frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: c13_gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: c13_gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: c13_leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: c13_leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: c13_leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: c13_livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: c13_livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: c13_livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: c13_livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: c13_livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: c13_livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: c13_pft_ctrunc(:) ! (gC/m2) pft-level sink for C truncation + + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: grainn(:) ! (gC/m2) grain N + real(r8), pointer :: grainn_storage(:) ! (gC/m2) grain N storage + real(r8), pointer :: grainn_xfer(:) ! (gC/m2) grain N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: npool(:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: pft_ntrunc(:) ! (gN/m2) pft-level sink for N truncation + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + integer , pointer :: ivt(:) ! pft vegetation type +! +! local pointers to implicit in/out scalars +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + real(r8):: pc,pn ! truncation terms for pft-level corrections + real(r8):: cc,cn ! truncation terms for column-level corrections + + real(r8):: pc13 ! truncation terms for pft-level corrections + real(r8):: cc13 ! truncation terms for column-level corrections + + real(r8):: ccrit ! critical carbon state value for truncation + real(r8):: ncrit ! critical nitrogen state value for truncation + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers at the column level + col_ctrunc => ccs%col_ctrunc + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + soil1c => ccs%soil1c + soil2c => ccs%soil2c + soil3c => ccs%soil3c + soil4c => ccs%soil4c + + c13_col_ctrunc => cc13s%col_ctrunc + c13_cwdc => cc13s%cwdc + c13_litr1c => cc13s%litr1c + c13_litr2c => cc13s%litr2c + c13_litr3c => cc13s%litr3c + c13_soil1c => cc13s%soil1c + c13_soil2c => cc13s%soil2c + c13_soil3c => cc13s%soil3c + c13_soil4c => cc13s%soil4c + + col_ntrunc => cns%col_ntrunc + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + soil1n => cns%soil1n + soil2n => cns%soil2n + soil3n => cns%soil3n + soil4n => cns%soil4n + + ! assign local pointers at the pft level + ivt => pft%itype + cpool => pcs%cpool + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + pft_ctrunc => pcs%pft_ctrunc + xsmrpool => pcs%xsmrpool + grainc => pcs%grainc + grainc_storage => pcs%grainc_storage + grainc_xfer => pcs%grainc_xfer + + c13_cpool => pc13s%cpool + c13_deadcrootc => pc13s%deadcrootc + c13_deadcrootc_storage => pc13s%deadcrootc_storage + c13_deadcrootc_xfer => pc13s%deadcrootc_xfer + c13_deadstemc => pc13s%deadstemc + c13_deadstemc_storage => pc13s%deadstemc_storage + c13_deadstemc_xfer => pc13s%deadstemc_xfer + c13_frootc => pc13s%frootc + c13_frootc_storage => pc13s%frootc_storage + c13_frootc_xfer => pc13s%frootc_xfer + c13_gresp_storage => pc13s%gresp_storage + c13_gresp_xfer => pc13s%gresp_xfer + c13_leafc => pc13s%leafc + c13_leafc_storage => pc13s%leafc_storage + c13_leafc_xfer => pc13s%leafc_xfer + c13_livecrootc => pc13s%livecrootc + c13_livecrootc_storage => pc13s%livecrootc_storage + c13_livecrootc_xfer => pc13s%livecrootc_xfer + c13_livestemc => pc13s%livestemc + c13_livestemc_storage => pc13s%livestemc_storage + c13_livestemc_xfer => pc13s%livestemc_xfer + c13_pft_ctrunc => pc13s%pft_ctrunc + + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + grainn => pns%grainn + grainn_storage => pns%grainn_storage + grainn_xfer => pns%grainn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + npool => pns%npool + pft_ntrunc => pns%pft_ntrunc + retransn => pns%retransn + + ! set the critical carbon state value for truncation (gC/m2) + ccrit = 1.e-8_r8 + ! set the critical nitrogen state value for truncation (gN/m2) + ncrit = 1.e-8_r8 + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! initialize the pft-level C and N truncation terms + pc = 0._r8 + if (use_c13) then + pc13 = 0._r8 + end if + pn = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate C, C13, and N components + + ! leaf C and N + if (abs(leafc(p)) < ccrit) then + pc = pc + leafc(p) + leafc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_leafc(p) + c13_leafc(p) = 0._r8 + endif + pn = pn + leafn(p) + leafn(p) = 0._r8 + end if + + ! leaf storage C and N + if (abs(leafc_storage(p)) < ccrit) then + pc = pc + leafc_storage(p) + leafc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_leafc_storage(p) + c13_leafc_storage(p) = 0._r8 + endif + pn = pn + leafn_storage(p) + leafn_storage(p) = 0._r8 + end if + + ! leaf transfer C and N + if (abs(leafc_xfer(p)) < ccrit) then + pc = pc + leafc_xfer(p) + leafc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_leafc_xfer(p) + c13_leafc_xfer(p) = 0._r8 + endif + pn = pn + leafn_xfer(p) + leafn_xfer(p) = 0._r8 + end if + + ! froot C and N + if (abs(frootc(p)) < ccrit) then + pc = pc + frootc(p) + frootc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_frootc(p) + c13_frootc(p) = 0._r8 + endif + pn = pn + frootn(p) + frootn(p) = 0._r8 + end if + + ! froot storage C and N + if (abs(frootc_storage(p)) < ccrit) then + pc = pc + frootc_storage(p) + frootc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_frootc_storage(p) + c13_frootc_storage(p) = 0._r8 + endif + pn = pn + frootn_storage(p) + frootn_storage(p) = 0._r8 + end if + + ! froot transfer C and N + if (abs(frootc_xfer(p)) < ccrit) then + pc = pc + frootc_xfer(p) + frootc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_frootc_xfer(p) + c13_frootc_xfer(p) = 0._r8 + endif + pn = pn + frootn_xfer(p) + frootn_xfer(p) = 0._r8 + end if + + if ( crop_prog .and. ivt(p) >= nc3crop )then + ! grain C and N + if (abs(grainc(p)) < ccrit) then + pc = pc + grainc(p) + grainc(p) = 0._r8 + pn = pn + grainn(p) + grainn(p) = 0._r8 + end if + + ! grain storage C and N + if (abs(grainc_storage(p)) < ccrit) then + pc = pc + grainc_storage(p) + grainc_storage(p) = 0._r8 + pn = pn + grainn_storage(p) + grainn_storage(p) = 0._r8 + end if + + ! grain transfer C and N + if (abs(grainc_xfer(p)) < ccrit) then + pc = pc + grainc_xfer(p) + grainc_xfer(p) = 0._r8 + pn = pn + grainn_xfer(p) + grainn_xfer(p) = 0._r8 + end if + end if + + ! livestem C and N + if (abs(livestemc(p)) < ccrit) then + pc = pc + livestemc(p) + livestemc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livestemc(p) + c13_livestemc(p) = 0._r8 + endif + pn = pn + livestemn(p) + livestemn(p) = 0._r8 + end if + + ! livestem storage C and N + if (abs(livestemc_storage(p)) < ccrit) then + pc = pc + livestemc_storage(p) + livestemc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livestemc_storage(p) + c13_livestemc_storage(p) = 0._r8 + endif + pn = pn + livestemn_storage(p) + livestemn_storage(p) = 0._r8 + end if + + ! livestem transfer C and N + if (abs(livestemc_xfer(p)) < ccrit) then + pc = pc + livestemc_xfer(p) + livestemc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livestemc_xfer(p) + c13_livestemc_xfer(p) = 0._r8 + endif + pn = pn + livestemn_xfer(p) + livestemn_xfer(p) = 0._r8 + end if + + ! deadstem C and N + if (abs(deadstemc(p)) < ccrit) then + pc = pc + deadstemc(p) + deadstemc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadstemc(p) + c13_deadstemc(p) = 0._r8 + endif + pn = pn + deadstemn(p) + deadstemn(p) = 0._r8 + end if + + ! deadstem storage C and N + if (abs(deadstemc_storage(p)) < ccrit) then + pc = pc + deadstemc_storage(p) + deadstemc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadstemc_storage(p) + c13_deadstemc_storage(p) = 0._r8 + endif + pn = pn + deadstemn_storage(p) + deadstemn_storage(p) = 0._r8 + end if + + ! deadstem transfer C and N + if (abs(deadstemc_xfer(p)) < ccrit) then + pc = pc + deadstemc_xfer(p) + deadstemc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadstemc_xfer(p) + c13_deadstemc_xfer(p) = 0._r8 + endif + pn = pn + deadstemn_xfer(p) + deadstemn_xfer(p) = 0._r8 + end if + + ! livecroot C and N + if (abs(livecrootc(p)) < ccrit) then + pc = pc + livecrootc(p) + livecrootc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livecrootc(p) + c13_livecrootc(p) = 0._r8 + endif + pn = pn + livecrootn(p) + livecrootn(p) = 0._r8 + end if + + ! livecroot storage C and N + if (abs(livecrootc_storage(p)) < ccrit) then + pc = pc + livecrootc_storage(p) + livecrootc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livecrootc_storage(p) + c13_livecrootc_storage(p) = 0._r8 + endif + pn = pn + livecrootn_storage(p) + livecrootn_storage(p) = 0._r8 + end if + + ! livecroot transfer C and N + if (abs(livecrootc_xfer(p)) < ccrit) then + pc = pc + livecrootc_xfer(p) + livecrootc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_livecrootc_xfer(p) + c13_livecrootc_xfer(p) = 0._r8 + endif + pn = pn + livecrootn_xfer(p) + livecrootn_xfer(p) = 0._r8 + end if + + ! deadcroot C and N + if (abs(deadcrootc(p)) < ccrit) then + pc = pc + deadcrootc(p) + deadcrootc(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadcrootc(p) + c13_deadcrootc(p) = 0._r8 + endif + pn = pn + deadcrootn(p) + deadcrootn(p) = 0._r8 + end if + + ! deadcroot storage C and N + if (abs(deadcrootc_storage(p)) < ccrit) then + pc = pc + deadcrootc_storage(p) + deadcrootc_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadcrootc_storage(p) + c13_deadcrootc_storage(p) = 0._r8 + endif + pn = pn + deadcrootn_storage(p) + deadcrootn_storage(p) = 0._r8 + end if + + ! deadcroot transfer C and N + if (abs(deadcrootc_xfer(p)) < ccrit) then + pc = pc + deadcrootc_xfer(p) + deadcrootc_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_deadcrootc_xfer(p) + c13_deadcrootc_xfer(p) = 0._r8 + endif + pn = pn + deadcrootn_xfer(p) + deadcrootn_xfer(p) = 0._r8 + end if + + ! gresp_storage (C only) + if (abs(gresp_storage(p)) < ccrit) then + pc = pc + gresp_storage(p) + gresp_storage(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_gresp_storage(p) + c13_gresp_storage(p) = 0._r8 + endif + end if + + ! gresp_xfer (C only) + if (abs(gresp_xfer(p)) < ccrit) then + pc = pc + gresp_xfer(p) + gresp_xfer(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_gresp_xfer(p) + c13_gresp_xfer(p) = 0._r8 + endif + end if + + ! cpool (C only) + if (abs(cpool(p)) < ccrit) then + pc = pc + cpool(p) + cpool(p) = 0._r8 + if (use_c13) then + pc13 = pc13 + c13_cpool(p) + c13_cpool(p) = 0._r8 + endif + end if + + if ( crop_prog .and. ivt(p) >= nc3crop )then + ! xsmrpool (C only) + if (abs(xsmrpool(p)) < ccrit) then + pc = pc + xsmrpool(p) + xsmrpool(p) = 0._r8 + end if + end if + + ! retransn (N only) + if (abs(retransn(p)) < ncrit) then + pn = pn + retransn(p) + retransn(p) = 0._r8 + end if + + ! npool (N only) + if (abs(npool(p)) < ncrit) then + pn = pn + npool(p) + npool(p) = 0._r8 + end if + + pft_ctrunc(p) = pft_ctrunc(p) + pc + if (use_c13) then + c13_pft_ctrunc(p) = c13_pft_ctrunc(p) + pc13 + endif + pft_ntrunc(p) = pft_ntrunc(p) + pn + + end do ! end of pft loop + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! initialize the column-level C and N truncation terms + cc = 0._r8 + if (use_c13) then + cc13 = 0._r8 + endif + cn = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate both C and N components + + ! coarse woody debris C and N + if (abs(cwdc(c)) < ccrit) then + cc = cc + cwdc(c) + cwdc(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_cwdc(c) + c13_cwdc(c) = 0._r8 + endif + cn = cn + cwdn(c) + cwdn(c) = 0._r8 + end if + + ! litr1 C and N + if (abs(litr1c(c)) < ccrit) then + cc = cc + litr1c(c) + litr1c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_litr1c(c) + c13_litr1c(c) = 0._r8 + endif + cn = cn + litr1n(c) + litr1n(c) = 0._r8 + end if + + ! litr2 C and N + if (abs(litr2c(c)) < ccrit) then + cc = cc + litr2c(c) + litr2c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_litr2c(c) + c13_litr2c(c) = 0._r8 + endif + cn = cn + litr2n(c) + litr2n(c) = 0._r8 + end if + + ! litr3 C and N + if (abs(litr3c(c)) < ccrit) then + cc = cc + litr3c(c) + litr3c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_litr3c(c) + c13_litr3c(c) = 0._r8 + endif + cn = cn + litr3n(c) + litr3n(c) = 0._r8 + end if + + ! soil1 C and N + if (abs(soil1c(c)) < ccrit) then + cc = cc + soil1c(c) + soil1c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_soil1c(c) + c13_soil1c(c) = 0._r8 + endif + cn = cn + soil1n(c) + soil1n(c) = 0._r8 + end if + + ! soil2 C and N + if (abs(soil2c(c)) < ccrit) then + cc = cc + soil2c(c) + soil2c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_soil2c(c) + c13_soil2c(c) = 0._r8 + endif + cn = cn + soil2n(c) + soil2n(c) = 0._r8 + end if + + ! soil3 C and N + if (abs(soil3c(c)) < ccrit) then + cc = cc + soil3c(c) + soil3c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_soil3c(c) + c13_soil3c(c) = 0._r8 + endif + cn = cn + soil3n(c) + soil3n(c) = 0._r8 + end if + + ! soil4 C and N + if (abs(soil4c(c)) < ccrit) then + cc = cc + soil4c(c) + soil4c(c) = 0._r8 + if (use_c13) then + cc13 = cc13 + c13_soil4c(c) + c13_soil4c(c) = 0._r8 + endif + cn = cn + soil4n(c) + soil4n(c) = 0._r8 + end if + + ! not doing precision control on soil mineral N, since it will + ! be getting the N truncation flux anyway. + + col_ctrunc(c) = col_ctrunc(c) + cc + if (use_c13) then + c13_col_ctrunc(c) = c13_col_ctrunc(c) + cc13 + endif + col_ntrunc(c) = col_ntrunc(c) + cn + + end do ! end of column loop + +end subroutine CNPrecisionControl +!----------------------------------------------------------------------- + +end module CNPrecisionControlMod diff --git a/components/clm/src_clm40/biogeochem/CNSetValueMod.F90 b/components/clm/src_clm40/biogeochem/CNSetValueMod.F90 new file mode 100644 index 0000000000..bcb8700e18 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNSetValueMod.F90 @@ -0,0 +1,1280 @@ +module CNSetValueMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNSetValueMod +! +! !DESCRIPTION: +! contains code to set all CN variables to specified value +! Used for both initialization of special landunit values, and +! setting fluxes to 0.0 at the beginning of each time step +! 3/23/09, Peter Thornton: Added new subroutine, CNZeroFluxes_dwt(), +! which initialize flux variables used in the pftdyn +! routines. This is called from clm_driver1, as +! these variables need to be initialized outside of the clumps loop. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varpar , only: nlevgrnd + use clm_varctl , only: iulog, use_c13, use_cn, use_cndv + use clmtype + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNZeroFluxes + public :: CNZeroFluxes_dwt + public :: CNSetPps + public :: CNSetPepv + public :: CNSetPcs + public :: CNSetPns + public :: CNSetPcf + public :: CNSetPnf + public :: CNSetCps + public :: CNSetCcs + public :: CNSetCns + public :: CNSetCcf + public :: CNSetCnf +! !PRIVATE MEMBER FUNCTIONS: +! +! !REVISION HISTORY: +! 9/04/03: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNZeroFluxes +! +! !INTERFACE: +subroutine CNZeroFluxes(num_filterc, filterc, num_filterp, filterp) +! +! !DESCRIPTION: +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_filterc ! number of good values in filterc + integer, intent(in) :: filterc(:) ! column filter + integer, intent(in) :: num_filterp ! number of good values in filterp + integer, intent(in) :: filterp(:) ! pft filter +! +! !CALLED FROM: +! subroutine CNEcosystemDyn in module CNEcosystemDynMod.F90 +! +! !REVISION HISTORY: +! 9/04/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! +! +! local pointers to implicit in/out scalars +! +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + + ! zero the column-level C and N fluxes + call CNSetCcf(num_filterc, filterc, 0._r8, ccf) + if (use_c13) then + call CNSetCcf(num_filterc, filterc, 0._r8, cc13f) + end if + call CNSetCnf(num_filterc, filterc, 0._r8, cnf) + + ! zero the column-average pft-level C and N fluxes + call CNSetPcf(num_filterc, filterc, 0._r8, pcf_a) + call CNSetPnf(num_filterc, filterc, 0._r8, pnf_a) + + ! zero the pft-level C and N fluxes + call CNSetPcf(num_filterp, filterp, 0._r8, pcf) + if (use_c13) then + call CNSetPcf(num_filterp, filterp, 0._r8, pc13f) + end if + call CNSetPnf(num_filterp, filterp, 0._r8, pnf) + +end subroutine CNZeroFluxes +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNZeroFluxes_dwt +! +! !INTERFACE: +subroutine CNZeroFluxes_dwt( begc, endc, begp, endp ) +! +! !DESCRIPTION: +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begc, endc ! proc beginning and ending column indices + integer, intent(IN) :: begp, endp ! proc beginning and ending pft indices +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 3/23/09: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! +! +! local pointers to implicit in/out scalars +! +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c, p ! indices + type(column_type), pointer :: cptr ! pointer to column derived subtype +!EOP +!----------------------------------------------------------------------- + + cptr => col + ! set column-level conversion and product pool fluxes + ! to 0 at the beginning of every timestep + + do c = begc,endc + ! C fluxes + ccf%dwt_seedc_to_leaf(c) = 0._r8 + ccf%dwt_seedc_to_deadstem(c) = 0._r8 + ccf%dwt_conv_cflux(c) = 0._r8 + ccf%dwt_prod10c_gain(c) = 0._r8 + ccf%dwt_prod100c_gain(c) = 0._r8 + ccf%dwt_frootc_to_litr1c(c) = 0._r8 + ccf%dwt_frootc_to_litr2c(c) = 0._r8 + ccf%dwt_frootc_to_litr3c(c) = 0._r8 + ccf%dwt_livecrootc_to_cwdc(c) = 0._r8 + ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8 + if (use_c13) then + ! C13 fluxes + cc13f%dwt_seedc_to_leaf(c) = 0._r8 + cc13f%dwt_seedc_to_deadstem(c) = 0._r8 + cc13f%dwt_conv_cflux(c) = 0._r8 + cc13f%dwt_prod10c_gain(c) = 0._r8 + cc13f%dwt_prod100c_gain(c) = 0._r8 + cc13f%dwt_frootc_to_litr1c(c) = 0._r8 + cc13f%dwt_frootc_to_litr2c(c) = 0._r8 + cc13f%dwt_frootc_to_litr3c(c) = 0._r8 + cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8 + cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8 + end if + ! N fluxes + cnf%dwt_seedn_to_leaf(c) = 0._r8 + cnf%dwt_seedn_to_deadstem(c) = 0._r8 + cnf%dwt_conv_nflux(c) = 0._r8 + cnf%dwt_prod10n_gain(c) = 0._r8 + cnf%dwt_prod100n_gain(c) = 0._r8 + cnf%dwt_frootn_to_litr1n(c) = 0._r8 + cnf%dwt_frootn_to_litr2n(c) = 0._r8 + cnf%dwt_frootn_to_litr3n(c) = 0._r8 + cnf%dwt_livecrootn_to_cwdn(c) = 0._r8 + cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8 + end do + if (use_cn) then + do p = begp,endp + pcs%dispvegc(p) = 0._r8 + pcs%storvegc(p) = 0._r8 + pcs%totpftc(p) = 0._r8 + if (use_c13) then + pc13s%dispvegc(p) = 0._r8 + pc13s%storvegc(p) = 0._r8 + pc13s%totpftc(p) = 0._r8 + end if + pns%dispvegn(p) = 0._r8 + pns%storvegn(p) = 0._r8 + pns%totvegn(p) = 0._r8 + pns%totpftn(p) = 0._r8 + end do + end if + +end subroutine CNZeroFluxes_dwt +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPps +! +! !INTERFACE: +subroutine CNSetPps(num, filter, val, pps) +! +! !DESCRIPTION: +! Set pft physical state variables +! !USES: + use clm_varpar , only : numrad +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_pstate_type), intent(inout) :: pps +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i,j ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + pps%slasun(i) = val + pps%slasha(i) = val + pps%lncsun(i) = val + pps%lncsha(i) = val + pps%vcmxsun(i) = val + pps%vcmxsha(i) = val + pps%gdir(i) = val + end do + + do j = 1,numrad + do fi = 1,num + i = filter(fi) + pps%omega(i,j) = val + pps%eff_kid(i,j) = val + pps%eff_kii(i,j) = val + pps%sun_faid(i,j) = val + pps%sun_faii(i,j) = val + pps%sha_faid(i,j) = val + pps%sha_faii(i,j) = val + end do + end do + +end subroutine CNSetPps +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPepv +! +! !INTERFACE: +subroutine CNSetPepv (num, filter, val, pepv) +! +! !DESCRIPTION: +! Set pft ecophysiological variables +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_epv_type), intent(inout) :: pepv +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + pepv%dormant_flag(i) = val + pepv%days_active(i) = val + pepv%onset_flag(i) = val + pepv%onset_counter(i) = val + pepv%onset_gddflag(i) = val + pepv%onset_fdd(i) = val + pepv%onset_gdd(i) = val + pepv%onset_swi(i) = val + pepv%offset_flag(i) = val + pepv%offset_counter(i) = val + pepv%offset_fdd(i) = val + pepv%offset_swi(i) = val + pepv%lgsf(i) = val + pepv%bglfr(i) = val + pepv%bgtr(i) = val + pepv%dayl(i) = val + pepv%prev_dayl(i) = val + pepv%annavg_t2m(i) = val + pepv%tempavg_t2m(i) = val + pepv%gpp(i) = val + pepv%availc(i) = val + pepv%xsmrpool_recover(i) = val + if (use_c13) then + pepv%xsmrpool_c13ratio(i) = val + end if + pepv%alloc_pnow(i) = val + pepv%c_allometry(i) = val + pepv%n_allometry(i) = val + pepv%plant_ndemand(i) = val + pepv%tempsum_potential_gpp(i) = val + pepv%annsum_potential_gpp(i) = val + pepv%tempmax_retransn(i) = val + pepv%annmax_retransn(i) = val + pepv%avail_retransn(i) = val + pepv%plant_nalloc(i) = val + pepv%plant_calloc(i) = val + pepv%excess_cflux(i) = val + pepv%downreg(i) = val + pepv%prev_leafc_to_litter(i) = val + pepv%prev_frootc_to_litter(i) = val + pepv%tempsum_npp(i) = val + pepv%annsum_npp(i) = val + if (use_cndv) then + pepv%tempsum_litfall(i) = val + pepv%annsum_litfall(i) = val + end if + end do + +end subroutine CNSetPepv +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPcs +! +! !INTERFACE: +subroutine CNSetPcs (num, filter, val, pcs) +! +! !DESCRIPTION: +! Set pft carbon state variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_cstate_type), intent(inout) :: pcs +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + pcs%leafc(i) = val + pcs%leafc_storage(i) = val + pcs%leafc_xfer(i) = val + pcs%frootc(i) = val + pcs%frootc_storage(i) = val + pcs%frootc_xfer(i) = val + pcs%livestemc(i) = val + pcs%livestemc_storage(i) = val + pcs%livestemc_xfer(i) = val + pcs%deadstemc(i) = val + pcs%deadstemc_storage(i) = val + pcs%deadstemc_xfer(i) = val + pcs%livecrootc(i) = val + pcs%livecrootc_storage(i) = val + pcs%livecrootc_xfer(i) = val + pcs%deadcrootc(i) = val + pcs%deadcrootc_storage(i) = val + pcs%deadcrootc_xfer(i) = val + pcs%gresp_storage(i) = val + pcs%gresp_xfer(i) = val + pcs%cpool(i) = val + pcs%xsmrpool(i) = val + pcs%pft_ctrunc(i) = val + pcs%dispvegc(i) = val + pcs%storvegc(i) = val + pcs%totvegc(i) = val + pcs%totpftc(i) = val + pcs%woodc(i) = val + + if ( crop_prog )then + pcs%grainc(i) = val + pcs%grainc_storage(i) = val + pcs%grainc_xfer(i) = val + end if + end do + +end subroutine CNSetPcs +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPns +! +! !INTERFACE: +subroutine CNSetPns(num, filter, val, pns) +! +! !DESCRIPTION: +! Set pft nitrogen state variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_nstate_type), intent(inout) :: pns +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + pns%leafn(i) = val + pns%leafn_storage(i) = val + pns%leafn_xfer(i) = val + pns%frootn(i) = val + pns%frootn_storage(i) = val + pns%frootn_xfer(i) = val + pns%livestemn(i) = val + pns%livestemn_storage(i) = val + pns%livestemn_xfer(i) = val + pns%deadstemn(i) = val + pns%deadstemn_storage(i) = val + pns%deadstemn_xfer(i) = val + pns%livecrootn(i) = val + pns%livecrootn_storage(i) = val + pns%livecrootn_xfer(i) = val + pns%deadcrootn(i) = val + pns%deadcrootn_storage(i) = val + pns%deadcrootn_xfer(i) = val + pns%retransn(i) = val + pns%npool(i) = val + pns%pft_ntrunc(i) = val + pns%dispvegn(i) = val + pns%storvegn(i) = val + pns%totvegn(i) = val + pns%totpftn(i) = val + if ( crop_prog )then + pns%grainn(i) = val + pns%grainn_storage(i) = val + pns%grainn_xfer(i) = val + end if + end do + +end subroutine CNSetPns +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPcf +! +! !INTERFACE: +subroutine CNSetPcf(num, filter, val, pcf) +! +! !DESCRIPTION: +! Set pft carbon flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_cflux_type), intent(inout) :: pcf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + pcf%m_leafc_to_litter(i) = val + pcf%m_frootc_to_litter(i) = val + pcf%m_leafc_storage_to_litter(i) = val + pcf%m_frootc_storage_to_litter(i) = val + pcf%m_livestemc_storage_to_litter(i) = val + pcf%m_deadstemc_storage_to_litter(i) = val + pcf%m_livecrootc_storage_to_litter(i) = val + pcf%m_deadcrootc_storage_to_litter(i) = val + pcf%m_leafc_xfer_to_litter(i) = val + pcf%m_frootc_xfer_to_litter(i) = val + pcf%m_livestemc_xfer_to_litter(i) = val + pcf%m_deadstemc_xfer_to_litter(i) = val + pcf%m_livecrootc_xfer_to_litter(i) = val + pcf%m_deadcrootc_xfer_to_litter(i) = val + pcf%m_livestemc_to_litter(i) = val + pcf%m_deadstemc_to_litter(i) = val + pcf%m_livecrootc_to_litter(i) = val + pcf%m_deadcrootc_to_litter(i) = val + pcf%m_gresp_storage_to_litter(i) = val + pcf%m_gresp_xfer_to_litter(i) = val + pcf%hrv_leafc_to_litter(i) = val + pcf%hrv_leafc_storage_to_litter(i) = val + pcf%hrv_leafc_xfer_to_litter(i) = val + pcf%hrv_frootc_to_litter(i) = val + pcf%hrv_frootc_storage_to_litter(i) = val + pcf%hrv_frootc_xfer_to_litter(i) = val + pcf%hrv_livestemc_to_litter(i) = val + pcf%hrv_livestemc_storage_to_litter(i) = val + pcf%hrv_livestemc_xfer_to_litter(i) = val + pcf%hrv_deadstemc_to_prod10c(i) = val + pcf%hrv_deadstemc_to_prod100c(i) = val + pcf%hrv_deadstemc_storage_to_litter(i) = val + pcf%hrv_deadstemc_xfer_to_litter(i) = val + pcf%hrv_livecrootc_to_litter(i) = val + pcf%hrv_livecrootc_storage_to_litter(i) = val + pcf%hrv_livecrootc_xfer_to_litter(i) = val + pcf%hrv_deadcrootc_to_litter(i) = val + pcf%hrv_deadcrootc_storage_to_litter(i) = val + pcf%hrv_deadcrootc_xfer_to_litter(i) = val + pcf%hrv_gresp_storage_to_litter(i) = val + pcf%hrv_gresp_xfer_to_litter(i) = val + pcf%hrv_xsmrpool_to_atm(i) = val + pcf%m_leafc_to_fire(i) = val + pcf%m_frootc_to_fire(i) = val + pcf%m_leafc_storage_to_fire(i) = val + pcf%m_frootc_storage_to_fire(i) = val + pcf%m_livestemc_storage_to_fire(i) = val + pcf%m_deadstemc_storage_to_fire(i) = val + pcf%m_livecrootc_storage_to_fire(i) = val + pcf%m_deadcrootc_storage_to_fire(i) = val + pcf%m_leafc_xfer_to_fire(i) = val + pcf%m_frootc_xfer_to_fire(i) = val + pcf%m_livestemc_xfer_to_fire(i) = val + pcf%m_deadstemc_xfer_to_fire(i) = val + pcf%m_livecrootc_xfer_to_fire(i) = val + pcf%m_deadcrootc_xfer_to_fire(i) = val + pcf%m_livestemc_to_fire(i) = val + pcf%m_deadstemc_to_fire(i) = val + pcf%m_deadstemc_to_litter_fire(i) = val + pcf%m_livecrootc_to_fire(i) = val + pcf%m_deadcrootc_to_fire(i) = val + pcf%m_deadcrootc_to_litter_fire(i) = val + pcf%m_gresp_storage_to_fire(i) = val + pcf%m_gresp_xfer_to_fire(i) = val + pcf%leafc_xfer_to_leafc(i) = val + pcf%frootc_xfer_to_frootc(i) = val + pcf%livestemc_xfer_to_livestemc(i) = val + pcf%deadstemc_xfer_to_deadstemc(i) = val + pcf%livecrootc_xfer_to_livecrootc(i) = val + pcf%deadcrootc_xfer_to_deadcrootc(i) = val + pcf%leafc_to_litter(i) = val + pcf%frootc_to_litter(i) = val + pcf%leaf_mr(i) = val + pcf%froot_mr(i) = val + pcf%livestem_mr(i) = val + pcf%livecroot_mr(i) = val + pcf%leaf_curmr(i) = val + pcf%froot_curmr(i) = val + pcf%livestem_curmr(i) = val + pcf%livecroot_curmr(i) = val + pcf%leaf_xsmr(i) = val + pcf%froot_xsmr(i) = val + pcf%livestem_xsmr(i) = val + pcf%livecroot_xsmr(i) = val + pcf%psnsun_to_cpool(i) = val + pcf%psnshade_to_cpool(i) = val + pcf%cpool_to_xsmrpool(i) = val + pcf%cpool_to_leafc(i) = val + pcf%cpool_to_leafc_storage(i) = val + pcf%cpool_to_frootc(i) = val + pcf%cpool_to_frootc_storage(i) = val + pcf%cpool_to_livestemc(i) = val + pcf%cpool_to_livestemc_storage(i) = val + pcf%cpool_to_deadstemc(i) = val + pcf%cpool_to_deadstemc_storage(i) = val + pcf%cpool_to_livecrootc(i) = val + pcf%cpool_to_livecrootc_storage(i) = val + pcf%cpool_to_deadcrootc(i) = val + pcf%cpool_to_deadcrootc_storage(i) = val + pcf%cpool_to_gresp_storage(i) = val + pcf%cpool_leaf_gr(i) = val + pcf%cpool_leaf_storage_gr(i) = val + pcf%transfer_leaf_gr(i) = val + pcf%cpool_froot_gr(i) = val + pcf%cpool_froot_storage_gr(i) = val + pcf%transfer_froot_gr(i) = val + pcf%cpool_livestem_gr(i) = val + pcf%cpool_livestem_storage_gr(i) = val + pcf%transfer_livestem_gr(i) = val + pcf%cpool_deadstem_gr(i) = val + pcf%cpool_deadstem_storage_gr(i) = val + pcf%transfer_deadstem_gr(i) = val + pcf%cpool_livecroot_gr(i) = val + pcf%cpool_livecroot_storage_gr(i) = val + pcf%transfer_livecroot_gr(i) = val + pcf%cpool_deadcroot_gr(i) = val + pcf%cpool_deadcroot_storage_gr(i) = val + pcf%transfer_deadcroot_gr(i) = val + pcf%leafc_storage_to_xfer(i) = val + pcf%frootc_storage_to_xfer(i) = val + pcf%livestemc_storage_to_xfer(i) = val + pcf%deadstemc_storage_to_xfer(i) = val + pcf%livecrootc_storage_to_xfer(i) = val + pcf%deadcrootc_storage_to_xfer(i) = val + pcf%gresp_storage_to_xfer(i) = val + pcf%livestemc_to_deadstemc(i) = val + pcf%livecrootc_to_deadcrootc(i) = val + pcf%gpp(i) = val + pcf%mr(i) = val + pcf%current_gr(i) = val + pcf%transfer_gr(i) = val + pcf%storage_gr(i) = val + pcf%gr(i) = val + pcf%ar(i) = val + pcf%rr(i) = val + pcf%npp(i) = val + pcf%agnpp(i) = val + pcf%bgnpp(i) = val + pcf%litfall(i) = val + pcf%vegfire(i) = val + pcf%wood_harvestc(i) = val + pcf%pft_cinputs(i) = val + pcf%pft_coutputs(i) = val + pcf%pft_fire_closs(i) = val + pcf%frootc_alloc(i) = val + pcf%frootc_loss(i) = val + pcf%leafc_alloc(i) = val + pcf%leafc_loss(i) = val + pcf%woodc_alloc(i) = val + pcf%woodc_loss(i) = val + if ( crop_prog )then + pcf%xsmrpool_to_atm(i) = val + pcf%livestemc_to_litter(i) = val + pcf%grainc_to_food(i) = val + pcf%grainc_xfer_to_grainc(i) = val + pcf%cpool_to_grainc(i) = val + pcf%cpool_to_grainc_storage(i) = val + pcf%cpool_grain_gr(i) = val + pcf%cpool_grain_storage_gr(i) = val + pcf%transfer_grain_gr(i) = val + pcf%grainc_storage_to_xfer(i) = val + end if + end do + +end subroutine CNSetPcf +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetPnf +! +! !INTERFACE: +subroutine CNSetPnf(num, filter, val, pnf) +! +! !DESCRIPTION: +! Set pft nitrogen flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (pft_nflux_type), intent(inout) :: pnf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i=filter(fi) + pnf%m_leafn_to_litter(i) = val + pnf%m_frootn_to_litter(i) = val + pnf%m_leafn_storage_to_litter(i) = val + pnf%m_frootn_storage_to_litter(i) = val + pnf%m_livestemn_storage_to_litter(i) = val + pnf%m_deadstemn_storage_to_litter(i) = val + pnf%m_livecrootn_storage_to_litter(i) = val + pnf%m_deadcrootn_storage_to_litter(i) = val + pnf%m_leafn_xfer_to_litter(i) = val + pnf%m_frootn_xfer_to_litter(i) = val + pnf%m_livestemn_xfer_to_litter(i) = val + pnf%m_deadstemn_xfer_to_litter(i) = val + pnf%m_livecrootn_xfer_to_litter(i) = val + pnf%m_deadcrootn_xfer_to_litter(i) = val + pnf%m_livestemn_to_litter(i) = val + pnf%m_deadstemn_to_litter(i) = val + pnf%m_livecrootn_to_litter(i) = val + pnf%m_deadcrootn_to_litter(i) = val + pnf%m_retransn_to_litter(i) = val + pnf%hrv_leafn_to_litter(i) = val + pnf%hrv_frootn_to_litter(i) = val + pnf%hrv_leafn_storage_to_litter(i) = val + pnf%hrv_frootn_storage_to_litter(i) = val + pnf%hrv_livestemn_storage_to_litter(i) = val + pnf%hrv_deadstemn_storage_to_litter(i) = val + pnf%hrv_livecrootn_storage_to_litter(i) = val + pnf%hrv_deadcrootn_storage_to_litter(i) = val + pnf%hrv_leafn_xfer_to_litter(i) = val + pnf%hrv_frootn_xfer_to_litter(i) = val + pnf%hrv_livestemn_xfer_to_litter(i) = val + pnf%hrv_deadstemn_xfer_to_litter(i) = val + pnf%hrv_livecrootn_xfer_to_litter(i) = val + pnf%hrv_deadcrootn_xfer_to_litter(i) = val + pnf%hrv_livestemn_to_litter(i) = val + pnf%hrv_deadstemn_to_prod10n(i) = val + pnf%hrv_deadstemn_to_prod100n(i) = val + pnf%hrv_livecrootn_to_litter(i) = val + pnf%hrv_deadcrootn_to_litter(i) = val + pnf%hrv_retransn_to_litter(i) = val + pnf%m_leafn_to_fire(i) = val + pnf%m_frootn_to_fire(i) = val + pnf%m_leafn_storage_to_fire(i) = val + pnf%m_frootn_storage_to_fire(i) = val + pnf%m_livestemn_storage_to_fire(i) = val + pnf%m_deadstemn_storage_to_fire(i) = val + pnf%m_livecrootn_storage_to_fire(i) = val + pnf%m_deadcrootn_storage_to_fire(i) = val + pnf%m_leafn_xfer_to_fire(i) = val + pnf%m_frootn_xfer_to_fire(i) = val + pnf%m_livestemn_xfer_to_fire(i) = val + pnf%m_deadstemn_xfer_to_fire(i) = val + pnf%m_livecrootn_xfer_to_fire(i) = val + pnf%m_deadcrootn_xfer_to_fire(i) = val + pnf%m_livestemn_to_fire(i) = val + pnf%m_deadstemn_to_fire(i) = val + pnf%m_deadstemn_to_litter_fire(i) = val + pnf%m_livecrootn_to_fire(i) = val + pnf%m_deadcrootn_to_fire(i) = val + pnf%m_deadcrootn_to_litter_fire(i) = val + pnf%m_retransn_to_fire(i) = val + pnf%leafn_xfer_to_leafn(i) = val + pnf%frootn_xfer_to_frootn(i) = val + pnf%livestemn_xfer_to_livestemn(i) = val + pnf%deadstemn_xfer_to_deadstemn(i) = val + pnf%livecrootn_xfer_to_livecrootn(i) = val + pnf%deadcrootn_xfer_to_deadcrootn(i) = val + pnf%leafn_to_litter(i) = val + pnf%leafn_to_retransn(i) = val + pnf%frootn_to_litter(i) = val + pnf%retransn_to_npool(i) = val + pnf%sminn_to_npool(i) = val + pnf%npool_to_leafn(i) = val + pnf%npool_to_leafn_storage(i) = val + pnf%npool_to_frootn(i) = val + pnf%npool_to_frootn_storage(i) = val + pnf%npool_to_livestemn(i) = val + pnf%npool_to_livestemn_storage(i) = val + pnf%npool_to_deadstemn(i) = val + pnf%npool_to_deadstemn_storage(i) = val + pnf%npool_to_livecrootn(i) = val + pnf%npool_to_livecrootn_storage(i) = val + pnf%npool_to_deadcrootn(i) = val + pnf%npool_to_deadcrootn_storage(i) = val + pnf%leafn_storage_to_xfer(i) = val + pnf%frootn_storage_to_xfer(i) = val + pnf%livestemn_storage_to_xfer(i) = val + pnf%deadstemn_storage_to_xfer(i) = val + pnf%livecrootn_storage_to_xfer(i) = val + pnf%deadcrootn_storage_to_xfer(i) = val + pnf%livestemn_to_deadstemn(i) = val + pnf%livestemn_to_retransn(i) = val + pnf%livecrootn_to_deadcrootn(i) = val + pnf%livecrootn_to_retransn(i) = val + pnf%ndeploy(i) = val + pnf%pft_ninputs(i) = val + pnf%pft_noutputs(i) = val + pnf%wood_harvestn(i) = val + pnf%pft_fire_nloss(i) = val + if ( crop_prog )then + pnf%livestemn_to_litter(i) = val + pnf%grainn_to_food(i) = val + pnf%grainn_xfer_to_grainn(i) = val + pnf%npool_to_grainn(i) = val + pnf%npool_to_grainn_storage(i) = val + pnf%grainn_storage_to_xfer(i) = val + end if + end do + +end subroutine CNSetPnf +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetCps +! +! !INTERFACE: +subroutine CNSetCps(num, filter, val, cps) +! +! !DESCRIPTION: +! Set column physical state variables +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (column_pstate_type), intent(inout) :: cps +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i,j ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + cps%decl(i) = val + cps%coszen(i) = val + cps%fpi(i) = val + cps%fpg(i) = val + cps%annsum_counter(i) = val + cps%cannsum_npp(i) = val + cps%cannavg_t2m(i) = val + cps%wf(i) = val + cps%me(i) = val + cps%fire_prob(i) = val + cps%mean_fire_prob(i) = val + cps%fireseasonl(i) = val + cps%farea_burned(i) = val + cps%ann_farea_burned(i) = val + end do + + do j = 1,nlevgrnd + do fi = 1,num + i = filter(fi) + cps%bsw2(i,j) = val + cps%psisat(i,j) = val + cps%vwcsat(i,j) = val + cps%soilpsi(i,j) = val + end do + end do + +end subroutine CNSetCps +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetCcs +! +! !INTERFACE: +subroutine CNSetCcs(num, filter, val, ccs) +! +! !DESCRIPTION: +! Set column carbon state variables +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (column_cstate_type), intent(inout) :: ccs +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + ccs%cwdc(i) = val + ccs%litr1c(i) = val + ccs%litr2c(i) = val + ccs%litr3c(i) = val + ccs%soil1c(i) = val + ccs%soil2c(i) = val + ccs%soil3c(i) = val + ccs%soil4c(i) = val + ccs%col_ctrunc(i) = val + ccs%totlitc(i) = val + ccs%totsomc(i) = val + ccs%totecosysc(i) = val + ccs%totcolc(i) = val + + end do + +end subroutine CNSetCcs +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetCns +! +! !INTERFACE: +subroutine CNSetCns(num, filter, val, cns) +! +! !DESCRIPTION: +! Set column nitrogen state variables +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (column_nstate_type), intent(inout) :: cns +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + cns%cwdn(i) = val + cns%litr1n(i) = val + cns%litr2n(i) = val + cns%litr3n(i) = val + cns%soil1n(i) = val + cns%soil2n(i) = val + cns%soil3n(i) = val + cns%soil4n(i) = val + cns%sminn(i) = val + cns%col_ntrunc(i) = val + cns%totlitn(i) = val + cns%totsomn(i) = val + cns%totecosysn(i) = val + cns%totcoln(i) = val + end do + +end subroutine CNSetCns +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetCcf +! +! !INTERFACE: +subroutine CNSetCcf(num, filter, val, ccf) +! +! !DESCRIPTION: +! Set column carbon flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (column_cflux_type), intent(inout) :: ccf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + ccf%m_leafc_to_litr1c(i) = val + ccf%m_leafc_to_litr2c(i) = val + ccf%m_leafc_to_litr3c(i) = val + ccf%m_frootc_to_litr1c(i) = val + ccf%m_frootc_to_litr2c(i) = val + ccf%m_frootc_to_litr3c(i) = val + ccf%m_leafc_storage_to_litr1c(i) = val + ccf%m_frootc_storage_to_litr1c(i) = val + ccf%m_livestemc_storage_to_litr1c(i) = val + ccf%m_deadstemc_storage_to_litr1c(i) = val + ccf%m_livecrootc_storage_to_litr1c(i) = val + ccf%m_deadcrootc_storage_to_litr1c(i) = val + ccf%m_leafc_xfer_to_litr1c(i) = val + ccf%m_frootc_xfer_to_litr1c(i) = val + ccf%m_livestemc_xfer_to_litr1c(i) = val + ccf%m_deadstemc_xfer_to_litr1c(i) = val + ccf%m_livecrootc_xfer_to_litr1c(i) = val + ccf%m_deadcrootc_xfer_to_litr1c(i) = val + ccf%m_livestemc_to_cwdc(i) = val + ccf%m_deadstemc_to_cwdc(i) = val + ccf%m_livecrootc_to_cwdc(i) = val + ccf%m_deadcrootc_to_cwdc(i) = val + ccf%m_gresp_storage_to_litr1c(i) = val + ccf%m_gresp_xfer_to_litr1c(i) = val + ccf%hrv_leafc_to_litr1c(i) = val + ccf%hrv_leafc_to_litr2c(i) = val + ccf%hrv_leafc_to_litr3c(i) = val + ccf%hrv_frootc_to_litr1c(i) = val + ccf%hrv_frootc_to_litr2c(i) = val + ccf%hrv_frootc_to_litr3c(i) = val + ccf%hrv_livestemc_to_cwdc(i) = val + ccf%hrv_deadstemc_to_prod10c(i) = val + ccf%hrv_deadstemc_to_prod100c(i) = val + ccf%hrv_livecrootc_to_cwdc(i) = val + ccf%hrv_deadcrootc_to_cwdc(i) = val + ccf%hrv_leafc_storage_to_litr1c(i) = val + ccf%hrv_frootc_storage_to_litr1c(i) = val + ccf%hrv_livestemc_storage_to_litr1c(i) = val + ccf%hrv_deadstemc_storage_to_litr1c(i) = val + ccf%hrv_livecrootc_storage_to_litr1c(i) = val + ccf%hrv_deadcrootc_storage_to_litr1c(i) = val + if ( crop_prog )then + ccf%livestemc_to_litr1c(i) = val + ccf%livestemc_to_litr2c(i) = val + ccf%livestemc_to_litr3c(i) = val + ccf%grainc_to_litr1c(i) = val + ccf%grainc_to_litr2c(i) = val + ccf%grainc_to_litr3c(i) = val + end if + ccf%hrv_gresp_storage_to_litr1c(i) = val + ccf%hrv_leafc_xfer_to_litr1c(i) = val + ccf%hrv_frootc_xfer_to_litr1c(i) = val + ccf%hrv_livestemc_xfer_to_litr1c(i) = val + ccf%hrv_deadstemc_xfer_to_litr1c(i) = val + ccf%hrv_livecrootc_xfer_to_litr1c(i) = val + ccf%hrv_deadcrootc_xfer_to_litr1c(i) = val + ccf%hrv_gresp_xfer_to_litr1c(i) = val + ccf%m_deadstemc_to_cwdc_fire(i) = val + ccf%m_deadcrootc_to_cwdc_fire(i) = val + ccf%m_litr1c_to_fire(i) = val + ccf%m_litr2c_to_fire(i) = val + ccf%m_litr3c_to_fire(i) = val + ccf%m_cwdc_to_fire(i) = val + ccf%prod10c_loss(i) = val + ccf%prod100c_loss(i) = val + ccf%product_closs(i) = val + ccf%leafc_to_litr1c(i) = val + ccf%leafc_to_litr2c(i) = val + ccf%leafc_to_litr3c(i) = val + ccf%frootc_to_litr1c(i) = val + ccf%frootc_to_litr2c(i) = val + ccf%frootc_to_litr3c(i) = val + ccf%cwdc_to_litr2c(i) = val + ccf%cwdc_to_litr3c(i) = val + ccf%litr1_hr(i) = val + ccf%litr1c_to_soil1c(i) = val + ccf%litr2_hr(i) = val + ccf%litr2c_to_soil2c(i) = val + ccf%litr3_hr(i) = val + ccf%litr3c_to_soil3c(i) = val + ccf%soil1_hr(i) = val + ccf%soil1c_to_soil2c(i) = val + ccf%soil2_hr(i) = val + ccf%soil2c_to_soil3c(i) = val + ccf%soil3_hr(i) = val + ccf%soil3c_to_soil4c(i) = val + ccf%soil4_hr(i) = val + ccf%lithr(i) = val + ccf%somhr(i) = val + ccf%hr(i) = val + ccf%sr(i) = val + ccf%er(i) = val + ccf%litfire(i) = val + ccf%somfire(i) = val + ccf%totfire(i) = val + ccf%nep(i) = val + ccf%nbp(i) = val + ccf%nee(i) = val + ccf%col_cinputs(i) = val + ccf%col_coutputs(i) = val + ccf%col_fire_closs(i) = val + ccf%cwdc_hr(i) = val + ccf%cwdc_loss(i) = val + ccf%litterc_loss(i) = val + + end do + +end subroutine CNSetCcf +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNSetCnf +! +! !INTERFACE: +subroutine CNSetCnf(num, filter, val, cnf) +! +! !DESCRIPTION: +! Set column nitrogen flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer , intent(in) :: num + integer , intent(in) :: filter(:) + real(r8), intent(in) :: val + type (column_nflux_type), intent(inout) :: cnf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in/out arrays +! +! !OTHER LOCAL VARIABLES: + integer :: fi,i ! loop index +!EOP +!------------------------------------------------------------------------ + + do fi = 1,num + i = filter(fi) + cnf%ndep_to_sminn(i) = val + cnf%nfix_to_sminn(i) = val + cnf%m_leafn_to_litr1n(i) = val + cnf%m_leafn_to_litr2n(i) = val + cnf%m_leafn_to_litr3n(i) = val + cnf%m_frootn_to_litr1n(i) = val + cnf%m_frootn_to_litr2n(i) = val + cnf%m_frootn_to_litr3n(i) = val + cnf%m_leafn_storage_to_litr1n(i) = val + cnf%m_frootn_storage_to_litr1n(i) = val + cnf%m_livestemn_storage_to_litr1n(i) = val + cnf%m_deadstemn_storage_to_litr1n(i) = val + cnf%m_livecrootn_storage_to_litr1n(i) = val + cnf%m_deadcrootn_storage_to_litr1n(i) = val + cnf%m_leafn_xfer_to_litr1n(i) = val + cnf%m_frootn_xfer_to_litr1n(i) = val + cnf%m_livestemn_xfer_to_litr1n(i) = val + cnf%m_deadstemn_xfer_to_litr1n(i) = val + cnf%m_livecrootn_xfer_to_litr1n(i) = val + cnf%m_deadcrootn_xfer_to_litr1n(i) = val + cnf%m_livestemn_to_cwdn(i) = val + cnf%m_deadstemn_to_cwdn(i) = val + cnf%m_livecrootn_to_cwdn(i) = val + cnf%m_deadcrootn_to_cwdn(i) = val + cnf%m_retransn_to_litr1n(i) = val + cnf%hrv_leafn_to_litr1n(i) = val + cnf%hrv_leafn_to_litr2n(i) = val + cnf%hrv_leafn_to_litr3n(i) = val + cnf%hrv_frootn_to_litr1n(i) = val + cnf%hrv_frootn_to_litr2n(i) = val + cnf%hrv_frootn_to_litr3n(i) = val + cnf%hrv_livestemn_to_cwdn(i) = val + cnf%hrv_deadstemn_to_prod10n(i) = val + cnf%hrv_deadstemn_to_prod100n(i) = val + cnf%hrv_livecrootn_to_cwdn(i) = val + cnf%hrv_deadcrootn_to_cwdn(i) = val + cnf%hrv_retransn_to_litr1n(i) = val + cnf%hrv_leafn_storage_to_litr1n(i) = val + cnf%hrv_frootn_storage_to_litr1n(i) = val + cnf%hrv_livestemn_storage_to_litr1n(i) = val + cnf%hrv_deadstemn_storage_to_litr1n(i) = val + cnf%hrv_livecrootn_storage_to_litr1n(i) = val + cnf%hrv_deadcrootn_storage_to_litr1n(i) = val + cnf%hrv_leafn_xfer_to_litr1n(i) = val + cnf%hrv_frootn_xfer_to_litr1n(i) = val + cnf%hrv_livestemn_xfer_to_litr1n(i) = val + cnf%hrv_deadstemn_xfer_to_litr1n(i) = val + cnf%hrv_livecrootn_xfer_to_litr1n(i) = val + cnf%hrv_deadcrootn_xfer_to_litr1n(i) = val + cnf%m_deadstemn_to_cwdn_fire(i) = val + cnf%m_deadcrootn_to_cwdn_fire(i) = val + cnf%m_litr1n_to_fire(i) = val + cnf%m_litr2n_to_fire(i) = val + cnf%m_litr3n_to_fire(i) = val + cnf%m_cwdn_to_fire(i) = val + cnf%prod10n_loss(i) = val + cnf%prod100n_loss(i) = val + cnf%product_nloss(i) = val + if ( crop_prog )then + cnf%grainn_to_litr1n(i) = val + cnf%grainn_to_litr2n(i) = val + cnf%grainn_to_litr3n(i) = val + cnf%livestemn_to_litr1n(i) = val + cnf%livestemn_to_litr2n(i) = val + cnf%livestemn_to_litr3n(i) = val + end if + cnf%leafn_to_litr1n(i) = val + cnf%leafn_to_litr2n(i) = val + cnf%leafn_to_litr3n(i) = val + cnf%frootn_to_litr1n(i) = val + cnf%frootn_to_litr2n(i) = val + cnf%frootn_to_litr3n(i) = val + cnf%cwdn_to_litr2n(i) = val + cnf%cwdn_to_litr3n(i) = val + cnf%litr1n_to_soil1n(i) = val + cnf%sminn_to_soil1n_l1(i) = val + cnf%litr2n_to_soil2n(i) = val + cnf%sminn_to_soil2n_l2(i) = val + cnf%litr3n_to_soil3n(i) = val + cnf%sminn_to_soil3n_l3(i) = val + cnf%soil1n_to_soil2n(i) = val + cnf%sminn_to_soil2n_s1(i) = val + cnf%soil2n_to_soil3n(i) = val + cnf%sminn_to_soil3n_s2(i) = val + cnf%soil3n_to_soil4n(i) = val + cnf%sminn_to_soil4n_s3(i) = val + cnf%soil4n_to_sminn(i) = val + cnf%sminn_to_denit_l1s1(i) = val + cnf%sminn_to_denit_l2s2(i) = val + cnf%sminn_to_denit_l3s3(i) = val + cnf%sminn_to_denit_s1s2(i) = val + cnf%sminn_to_denit_s2s3(i) = val + cnf%sminn_to_denit_s3s4(i) = val + cnf%sminn_to_denit_s4(i) = val + cnf%sminn_to_denit_excess(i) = val + cnf%sminn_leached(i) = val + cnf%potential_immob(i) = val + cnf%actual_immob(i) = val + cnf%sminn_to_plant(i) = val + cnf%supplement_to_sminn(i) = val + cnf%gross_nmin(i) = val + cnf%net_nmin(i) = val + cnf%denit(i) = val + cnf%col_ninputs(i) = val + cnf%col_noutputs(i) = val + cnf%col_fire_nloss(i) = val + end do + +end subroutine CNSetCnf +!----------------------------------------------------------------------- + +end module CNSetValueMod diff --git a/components/clm/src_clm40/biogeochem/CNSummaryMod.F90 b/components/clm/src_clm40/biogeochem/CNSummaryMod.F90 new file mode 100644 index 0000000000..2a1f08a51e --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNSummaryMod.F90 @@ -0,0 +1,1402 @@ +module CNSummaryMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNSummaryMod +! +! !DESCRIPTION: +! Module for carbon and nitrogen summary calculations +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use pftvarcon , only: npcropmin, nc3crop + use surfrdMod , only: crop_prog + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CSummary + public :: NSummary +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CSummary +! +! !INTERFACE: +subroutine CSummary(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, perform pft and column-level carbon +! summary calculations +! +! !USES: + use clmtype + use pft2colMod, only: p2c + use clm_varctl, only: iulog, use_cndv + use shr_sys_mod, only: shr_sys_flush +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 12/9/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss + real(r8), pointer :: er(:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: hr(:) ! (gC/m2/s) total heterotrophic respiration + real(r8), pointer :: litfire(:) ! (gC/m2/s) litter fire losses + real(r8), pointer :: lithr(:) ! (gC/m2/s) litter heterotrophic respiration + real(r8), pointer :: litr1_hr(:) + real(r8), pointer :: litr2_hr(:) + real(r8), pointer :: litr3_hr(:) + real(r8), pointer :: m_cwdc_to_fire(:) + real(r8), pointer :: m_litr1c_to_fire(:) + real(r8), pointer :: m_litr2c_to_fire(:) + real(r8), pointer :: m_litr3c_to_fire(:) + real(r8), pointer :: nee(:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, land-use, harvest, and hrv_xsmrpool flux, positive for source + real(r8), pointer :: nep(:) ! (gC/m2/s) net ecosystem production, excludes fire, land-use, and harvest flux, positive for sink + real(r8), pointer :: nbp(:) ! (gC/m2/s) net biome production, includes fire, land-use, and harvest flux, positive for sink + real(r8), pointer :: col_ar(:) ! (gC/m2/s) autotrophic respiration (MR + GR) + real(r8), pointer :: col_gpp(:) ! GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: col_npp(:) ! (gC/m2/s) net primary production + real(r8), pointer :: col_pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss + real(r8), pointer :: col_litfall(:) ! (gC/m2/s) total pft-level litterfall C loss + real(r8), pointer :: col_rr(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: col_vegfire(:) ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal) + real(r8), pointer :: col_wood_harvestc(:) + real(r8), pointer :: soil1_hr(:) + real(r8), pointer :: soil2_hr(:) + real(r8), pointer :: soil3_hr(:) + real(r8), pointer :: soil4_hr(:) + real(r8), pointer :: somfire(:) ! (gC/m2/s) soil organic matter fire losses + real(r8), pointer :: somhr(:) ! (gC/m2/s) soil organic matter heterotrophic respiration + real(r8), pointer :: sr(:) ! (gC/m2/s) total soil respiration (HR + root resp) + real(r8), pointer :: totfire(:) ! (gC/m2/s) total ecosystem fire losses + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: col_totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: col_totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc(:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totlitc(:) ! (gC/m2) total litter carbon + real(r8), pointer :: totsomc(:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: agnpp(:) ! (gC/m2/s) aboveground NPP + real(r8), pointer :: ar(:) ! (gC/m2/s) autotrophic respiration (MR + GR) + real(r8), pointer :: bgnpp(:) ! (gC/m2/s) belowground NPP + real(r8), pointer :: xsmrpool_to_atm(:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: cpool_grain_gr(:) ! grain growth respiration (gC/m2/s) + real(r8), pointer :: cpool_grain_storage_gr(:) ! grain growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C storage (gC/m2/s) + real(r8), pointer :: grainc_xfer_to_grainc(:) ! grain C growth from storage (gC/m2/s) + real(r8), pointer :: transfer_grain_gr(:) ! grain growth respiration from storage (gC/m2/s) + real(r8), pointer :: grainc_to_food(:) ! grain C to food (gC/m2/s) + real(r8), pointer :: livestemc_to_litter(:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc(:) ! (gC/m2) grain C + real(r8), pointer :: grainc_storage(:) ! (gC/m2) grain C storage + real(r8), pointer :: grainc_xfer(:) ! (gC/m2) grain C transfer + real(r8), pointer :: cpool_deadcroot_gr(:) ! dead coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) ! dead coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_deadstem_gr(:) ! dead stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadstem_storage_gr(:) ! dead stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_froot_gr(:) ! fine root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_froot_storage_gr(:) ! fine root growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_leaf_gr(:) ! leaf growth respiration (gC/m2/s) + real(r8), pointer :: cpool_leaf_storage_gr(:) ! leaf growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_livecroot_gr(:) ! live coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livecroot_storage_gr(:) ! live coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_livestem_gr(:) ! live stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livestem_storage_gr(:) ! live stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc(:) ! allocation to dead coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc(:) ! allocation to dead stem C (gC/m2/s) + real(r8), pointer :: cpool_to_frootc(:) ! allocation to fine root C (gC/m2/s) + real(r8), pointer :: cpool_to_leafc(:) ! allocation to leaf C (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc(:) ! allocation to live coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc(:) ! allocation to live stem C (gC/m2/s) + real(r8), pointer :: current_gr(:) ! (gC/m2/s) growth resp for new growth displayed in this timestep + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) + real(r8), pointer :: frootc_to_litter(:) + real(r8), pointer :: frootc_xfer_to_frootc(:) + real(r8), pointer :: froot_mr(:) + real(r8), pointer :: gpp(:) !GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: gr(:) ! (gC/m2/s) total growth respiration + real(r8), pointer :: leafc_to_litter(:) + real(r8), pointer :: leafc_xfer_to_leafc(:) + real(r8), pointer :: leaf_mr(:) + real(r8), pointer :: litfall(:) ! (gC/m2/s) litterfall (leaves and fine roots) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) + real(r8), pointer :: livecroot_mr(:) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) + real(r8), pointer :: livestem_mr(:) + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_fire(:) + real(r8), pointer :: m_deadcrootc_to_litter(:) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) + real(r8), pointer :: m_deadstemc_to_fire(:) + real(r8), pointer :: m_deadstemc_to_litter(:) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) + real(r8), pointer :: m_frootc_storage_to_fire(:) + real(r8), pointer :: m_frootc_storage_to_litter(:) + real(r8), pointer :: m_frootc_to_fire(:) + real(r8), pointer :: m_frootc_to_litter(:) + real(r8), pointer :: m_frootc_xfer_to_fire(:) + real(r8), pointer :: m_frootc_xfer_to_litter(:) + real(r8), pointer :: m_gresp_storage_to_fire(:) + real(r8), pointer :: m_gresp_storage_to_litter(:) + real(r8), pointer :: m_gresp_xfer_to_fire(:) + real(r8), pointer :: m_gresp_xfer_to_litter(:) + real(r8), pointer :: m_leafc_storage_to_fire(:) + real(r8), pointer :: m_leafc_storage_to_litter(:) + real(r8), pointer :: m_leafc_to_fire(:) + real(r8), pointer :: m_leafc_to_litter(:) + real(r8), pointer :: m_leafc_xfer_to_fire(:) + real(r8), pointer :: m_leafc_xfer_to_litter(:) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) + real(r8), pointer :: m_livecrootc_to_fire(:) + real(r8), pointer :: m_livecrootc_to_litter(:) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) + real(r8), pointer :: m_livestemc_storage_to_fire(:) + real(r8), pointer :: m_livestemc_storage_to_litter(:) + real(r8), pointer :: m_livestemc_to_fire(:) + real(r8), pointer :: m_livestemc_to_litter(:) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) + real(r8), pointer :: col_hrv_xsmrpool_to_atm(:) + real(r8), pointer :: mr(:) ! (gC/m2/s) maintenance respiration + real(r8), pointer :: npp(:) ! (gC/m2/s) net primary production + real(r8), pointer :: pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss + real(r8), pointer :: psnshade_to_cpool(:) + real(r8), pointer :: psnsun_to_cpool(:) + real(r8), pointer :: rr(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: storage_gr(:) ! (gC/m2/s) growth resp for growth sent to storage for later display + real(r8), pointer :: transfer_deadcroot_gr(:) + real(r8), pointer :: transfer_deadstem_gr(:) + real(r8), pointer :: transfer_froot_gr(:) + real(r8), pointer :: transfer_gr(:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep + real(r8), pointer :: transfer_leaf_gr(:) + real(r8), pointer :: transfer_livecroot_gr(:) + real(r8), pointer :: transfer_livestem_gr(:) + real(r8), pointer :: wood_harvestc(:) ! (gC/m2/s) pft-level wood harvest (to product pools) + real(r8), pointer :: vegfire(:) ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal) + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: pft_ctrunc(:) ! (gC/m2) pft-level sink for C truncation + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: dispvegc(:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: storvegc(:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: tempsum_npp(:) ! temporary annual sum of NPP (gC/m2/yr) + real(r8), pointer :: tempsum_litfall(:) !temporary annual sum of litfall (gC/m2/yr) + + ! for landcover change + real(r8), pointer :: landuseflux(:) ! (gC/m2/s) dwt_closs+product_closs + real(r8), pointer :: landuptake(:) ! (gC/m2/s) nee-landuseflux + real(r8), pointer :: dwt_closs(:) ! (gC/m2/s) total carbon loss from land cover conversion + real(r8), pointer :: dwt_conv_cflux(:) ! (gC/m2/s) conversion C flux (immediate loss to atm) + real(r8), pointer :: prod10c_loss(:) ! (gC/m2/s) loss from 10-yr wood product pool + real(r8), pointer :: prod100c_loss(:) ! (gC/m2/s) loss from 100-yr wood product pool + real(r8), pointer :: product_closs(:) ! (gC/m2/s) total wood product carbon loss + real(r8), pointer :: seedc(:) ! (gC/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10c(:) ! (gC/m2) wood product C pool, 10-year lifespan + real(r8), pointer :: prod100c(:) ! (gC/m2) wood product C pool, 100-year lifespan + real(r8), pointer :: totprodc(:) ! (gC/m2) total wood product C + + real(r8), pointer :: frootc_alloc(:) ! fine root C allocation (gC/m2/s) + real(r8), pointer :: frootc_loss(:) ! fine root C loss (gC/m2/s) + real(r8), pointer :: leafc_alloc(:) ! leaf C allocation (gC/m2/s) + real(r8), pointer :: leafc_loss(:) ! leaf C loss (gC/m2/s) + real(r8), pointer :: woodc(:) ! wood C (gC/m2) + real(r8), pointer :: woodc_alloc(:) ! wood C allocation (gC/m2/s) + real(r8), pointer :: woodc_loss(:) ! wood C loss (gC/m2/s) + real(r8), pointer :: cwdc_hr(:) ! coarse woody debris C heterotrophic respiration (gC/m2/s) + real(r8), pointer :: cwdc_loss(:) ! coarse woody debris C loss (gC/m2/s) + real(r8), pointer :: litterc_loss(:) ! litter C loss (gC/m2/s) + real(r8), pointer :: litr1c_to_soil1c(:) ! litter1 C loss to soil1 (gC/m2/s) + real(r8), pointer :: litr2c_to_soil2c(:) ! litter2 C loss to soil2 (gC/m2/s) + real(r8), pointer :: litr3c_to_soil3c(:) ! litter3 C loss to soil3 (gC/m2/s) + real(r8), pointer :: cwdc_to_litr2c(:) ! cwdc C to soil2 (gC/m2/s) + real(r8), pointer :: cwdc_to_litr3c(:) ! cwdc C to soil3 (gC/m2/s) +! +! +! local pointers to implicit in/out scalars +! +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers + ivt => pft%itype + col_fire_closs => ccf%col_fire_closs + er => ccf%er + hr => ccf%hr + litfire => ccf%litfire + lithr => ccf%lithr + litr1_hr => ccf%litr1_hr + litr2_hr => ccf%litr2_hr + litr3_hr => ccf%litr3_hr + m_cwdc_to_fire => ccf%m_cwdc_to_fire + m_litr1c_to_fire => ccf%m_litr1c_to_fire + m_litr2c_to_fire => ccf%m_litr2c_to_fire + m_litr3c_to_fire => ccf%m_litr3c_to_fire + cwdc_to_litr2c => ccf%cwdc_to_litr2c + cwdc_to_litr3c => ccf%cwdc_to_litr3c + litr1c_to_soil1c => ccf%litr1c_to_soil1c + litr2c_to_soil2c => ccf%litr2c_to_soil2c + litr3c_to_soil3c => ccf%litr3c_to_soil3c + nee => ccf%nee + nep => ccf%nep + nbp => ccf%nbp + col_ar => pcf_a%ar + col_gpp => pcf_a%gpp + col_npp => pcf_a%npp + col_pft_fire_closs => pcf_a%pft_fire_closs + col_litfall => pcf_a%litfall + col_rr => pcf_a%rr + col_vegfire => pcf_a%vegfire + col_wood_harvestc => pcf_a%wood_harvestc + soil1_hr => ccf%soil1_hr + soil2_hr => ccf%soil2_hr + soil3_hr => ccf%soil3_hr + soil4_hr => ccf%soil4_hr + somfire => ccf%somfire + somhr => ccf%somhr + sr => ccf%sr + totfire => ccf%totfire + cwdc_hr => ccf%cwdc_hr + cwdc_loss => ccf%cwdc_loss + litterc_loss => ccf%litterc_loss + ! dynamic landcover pointers + dwt_closs => ccf%dwt_closs + landuseflux => ccf%landuseflux + landuptake => ccf%landuptake + dwt_conv_cflux => ccf%dwt_conv_cflux + seedc => ccs%seedc + + ! wood product pointers + prod10c_loss => ccf%prod10c_loss + prod100c_loss => ccf%prod100c_loss + product_closs => ccf%product_closs + prod10c => ccs%prod10c + prod100c => ccs%prod100c + totprodc => ccs%totprodc + + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + col_totpftc => pcs_a%totpftc + col_totvegc => pcs_a%totvegc + soil1c => ccs%soil1c + soil2c => ccs%soil2c + soil3c => ccs%soil3c + soil4c => ccs%soil4c + col_ctrunc => ccs%col_ctrunc + totcolc => ccs%totcolc + totecosysc => ccs%totecosysc + totlitc => ccs%totlitc + totsomc => ccs%totsomc + agnpp => pcf%agnpp + ar => pcf%ar + bgnpp => pcf%bgnpp + xsmrpool_to_atm => pcf%xsmrpool_to_atm + cpool_grain_gr => pcf%cpool_grain_gr + cpool_grain_storage_gr => pcf%cpool_grain_storage_gr + cpool_to_grainc => pcf%cpool_to_grainc + grainc_xfer_to_grainc => pcf%grainc_xfer_to_grainc + transfer_grain_gr => pcf%transfer_grain_gr + grainc_to_food => pcf%grainc_to_food + livestemc_to_litter => pcf%livestemc_to_litter + grainc => pcs%grainc + grainc_storage => pcs%grainc_storage + grainc_xfer => pcs%grainc_xfer + cpool_deadcroot_gr => pcf%cpool_deadcroot_gr + cpool_deadcroot_storage_gr => pcf%cpool_deadcroot_storage_gr + cpool_deadstem_gr => pcf%cpool_deadstem_gr + cpool_deadstem_storage_gr => pcf%cpool_deadstem_storage_gr + cpool_froot_gr => pcf%cpool_froot_gr + cpool_froot_storage_gr => pcf%cpool_froot_storage_gr + cpool_leaf_gr => pcf%cpool_leaf_gr + cpool_leaf_storage_gr => pcf%cpool_leaf_storage_gr + cpool_livecroot_gr => pcf%cpool_livecroot_gr + cpool_livecroot_storage_gr => pcf%cpool_livecroot_storage_gr + cpool_livestem_gr => pcf%cpool_livestem_gr + cpool_livestem_storage_gr => pcf%cpool_livestem_storage_gr + cpool_to_deadcrootc => pcf%cpool_to_deadcrootc + cpool_to_deadstemc => pcf%cpool_to_deadstemc + cpool_to_frootc => pcf%cpool_to_frootc + cpool_to_leafc => pcf%cpool_to_leafc + cpool_to_livecrootc => pcf%cpool_to_livecrootc + cpool_to_livestemc => pcf%cpool_to_livestemc + current_gr => pcf%current_gr + deadcrootc_xfer_to_deadcrootc => pcf%deadcrootc_xfer_to_deadcrootc + deadstemc_xfer_to_deadstemc => pcf%deadstemc_xfer_to_deadstemc + frootc_to_litter => pcf%frootc_to_litter + frootc_xfer_to_frootc => pcf%frootc_xfer_to_frootc + froot_mr => pcf%froot_mr + gpp => pcf%gpp + gr => pcf%gr + leafc_to_litter => pcf%leafc_to_litter + leafc_xfer_to_leafc => pcf%leafc_xfer_to_leafc + leaf_mr => pcf%leaf_mr + litfall => pcf%litfall + livecrootc_xfer_to_livecrootc => pcf%livecrootc_xfer_to_livecrootc + livecroot_mr => pcf%livecroot_mr + livestemc_xfer_to_livestemc => pcf%livestemc_xfer_to_livestemc + livestem_mr => pcf%livestem_mr + m_deadcrootc_storage_to_fire => pcf%m_deadcrootc_storage_to_fire + m_deadcrootc_storage_to_litter => pcf%m_deadcrootc_storage_to_litter + m_deadcrootc_to_fire => pcf%m_deadcrootc_to_fire + m_deadcrootc_to_litter => pcf%m_deadcrootc_to_litter + m_deadcrootc_to_litter_fire => pcf%m_deadcrootc_to_litter_fire + m_deadcrootc_xfer_to_fire => pcf%m_deadcrootc_xfer_to_fire + m_deadcrootc_xfer_to_litter => pcf%m_deadcrootc_xfer_to_litter + m_deadstemc_storage_to_fire => pcf%m_deadstemc_storage_to_fire + m_deadstemc_storage_to_litter => pcf%m_deadstemc_storage_to_litter + m_deadstemc_to_fire => pcf%m_deadstemc_to_fire + m_deadstemc_to_litter => pcf%m_deadstemc_to_litter + m_deadstemc_to_litter_fire => pcf%m_deadstemc_to_litter_fire + m_deadstemc_xfer_to_fire => pcf%m_deadstemc_xfer_to_fire + m_deadstemc_xfer_to_litter => pcf%m_deadstemc_xfer_to_litter + m_frootc_storage_to_fire => pcf%m_frootc_storage_to_fire + m_frootc_storage_to_litter => pcf%m_frootc_storage_to_litter + m_frootc_to_fire => pcf%m_frootc_to_fire + m_frootc_to_litter => pcf%m_frootc_to_litter + m_frootc_xfer_to_fire => pcf%m_frootc_xfer_to_fire + m_frootc_xfer_to_litter => pcf%m_frootc_xfer_to_litter + m_gresp_storage_to_fire => pcf%m_gresp_storage_to_fire + m_gresp_storage_to_litter => pcf%m_gresp_storage_to_litter + m_gresp_xfer_to_fire => pcf%m_gresp_xfer_to_fire + m_gresp_xfer_to_litter => pcf%m_gresp_xfer_to_litter + m_leafc_storage_to_fire => pcf%m_leafc_storage_to_fire + m_leafc_storage_to_litter => pcf%m_leafc_storage_to_litter + m_leafc_to_fire => pcf%m_leafc_to_fire + m_leafc_to_litter => pcf%m_leafc_to_litter + m_leafc_xfer_to_fire => pcf%m_leafc_xfer_to_fire + m_leafc_xfer_to_litter => pcf%m_leafc_xfer_to_litter + m_livecrootc_storage_to_fire => pcf%m_livecrootc_storage_to_fire + m_livecrootc_storage_to_litter => pcf%m_livecrootc_storage_to_litter + m_livecrootc_to_fire => pcf%m_livecrootc_to_fire + m_livecrootc_to_litter => pcf%m_livecrootc_to_litter + m_livecrootc_xfer_to_fire => pcf%m_livecrootc_xfer_to_fire + m_livecrootc_xfer_to_litter => pcf%m_livecrootc_xfer_to_litter + m_livestemc_storage_to_fire => pcf%m_livestemc_storage_to_fire + m_livestemc_storage_to_litter => pcf%m_livestemc_storage_to_litter + m_livestemc_to_fire => pcf%m_livestemc_to_fire + m_livestemc_to_litter => pcf%m_livestemc_to_litter + m_livestemc_xfer_to_fire => pcf%m_livestemc_xfer_to_fire + m_livestemc_xfer_to_litter => pcf%m_livestemc_xfer_to_litter + hrv_leafc_to_litter => pcf%hrv_leafc_to_litter + hrv_leafc_storage_to_litter => pcf%hrv_leafc_storage_to_litter + hrv_leafc_xfer_to_litter => pcf%hrv_leafc_xfer_to_litter + hrv_frootc_to_litter => pcf%hrv_frootc_to_litter + hrv_frootc_storage_to_litter => pcf%hrv_frootc_storage_to_litter + hrv_frootc_xfer_to_litter => pcf%hrv_frootc_xfer_to_litter + hrv_livestemc_to_litter => pcf%hrv_livestemc_to_litter + hrv_livestemc_storage_to_litter => pcf%hrv_livestemc_storage_to_litter + hrv_livestemc_xfer_to_litter => pcf%hrv_livestemc_xfer_to_litter + hrv_deadstemc_to_prod10c => pcf%hrv_deadstemc_to_prod10c + hrv_deadstemc_to_prod100c => pcf%hrv_deadstemc_to_prod100c + hrv_deadstemc_storage_to_litter => pcf%hrv_deadstemc_storage_to_litter + hrv_deadstemc_xfer_to_litter => pcf%hrv_deadstemc_xfer_to_litter + hrv_livecrootc_to_litter => pcf%hrv_livecrootc_to_litter + hrv_livecrootc_storage_to_litter => pcf%hrv_livecrootc_storage_to_litter + hrv_livecrootc_xfer_to_litter => pcf%hrv_livecrootc_xfer_to_litter + hrv_deadcrootc_to_litter => pcf%hrv_deadcrootc_to_litter + hrv_deadcrootc_storage_to_litter => pcf%hrv_deadcrootc_storage_to_litter + hrv_deadcrootc_xfer_to_litter => pcf%hrv_deadcrootc_xfer_to_litter + hrv_gresp_storage_to_litter => pcf%hrv_gresp_storage_to_litter + hrv_gresp_xfer_to_litter => pcf%hrv_gresp_xfer_to_litter + hrv_xsmrpool_to_atm => pcf%hrv_xsmrpool_to_atm + col_hrv_xsmrpool_to_atm => pcf_a%hrv_xsmrpool_to_atm + mr => pcf%mr + npp => pcf%npp + pft_fire_closs => pcf%pft_fire_closs + psnshade_to_cpool => pcf%psnshade_to_cpool + psnsun_to_cpool => pcf%psnsun_to_cpool + rr => pcf%rr + storage_gr => pcf%storage_gr + transfer_deadcroot_gr => pcf%transfer_deadcroot_gr + transfer_deadstem_gr => pcf%transfer_deadstem_gr + transfer_froot_gr => pcf%transfer_froot_gr + transfer_gr => pcf%transfer_gr + transfer_leaf_gr => pcf%transfer_leaf_gr + transfer_livecroot_gr => pcf%transfer_livecroot_gr + transfer_livestem_gr => pcf%transfer_livestem_gr + vegfire => pcf%vegfire + wood_harvestc => pcf%wood_harvestc + frootc_alloc => pcf%frootc_alloc + frootc_loss => pcf%frootc_loss + leafc_alloc => pcf%leafc_alloc + leafc_loss => pcf%leafc_loss + woodc_alloc => pcf%woodc_alloc + woodc_loss => pcf%woodc_loss + cpool => pcs%cpool + xsmrpool => pcs%xsmrpool + pft_ctrunc => pcs%pft_ctrunc + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + dispvegc => pcs%dispvegc + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + storvegc => pcs%storvegc + totpftc => pcs%totpftc + totvegc => pcs%totvegc + woodc => pcs%woodc + tempsum_npp => pepv%tempsum_npp + tempsum_litfall => pepv%tempsum_litfall + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! calculate pft-level summary carbon fluxes and states + + ! gross primary production (GPP) + gpp(p) = & + psnsun_to_cpool(p) + & + psnshade_to_cpool(p) + + ! maintenance respiration (MR) + mr(p) = & + leaf_mr(p) + & + froot_mr(p) + & + livestem_mr(p) + & + livecroot_mr(p) + + ! growth respiration (GR) + ! current GR is respired this time step for new growth displayed in this timestep + current_gr(p) = & + cpool_leaf_gr(p) + & + cpool_froot_gr(p) + & + cpool_livestem_gr(p) + & + cpool_deadstem_gr(p) + & + cpool_livecroot_gr(p) + & + cpool_deadcroot_gr(p) + + ! transfer GR is respired this time step for transfer growth displayed in this timestep + transfer_gr(p) = & + transfer_leaf_gr(p) + & + transfer_froot_gr(p) + & + transfer_livestem_gr(p) + & + transfer_deadstem_gr(p) + & + transfer_livecroot_gr(p) + & + transfer_deadcroot_gr(p) + + ! storage GR is respired this time step for growth sent to storage for later display + storage_gr(p) = & + cpool_leaf_storage_gr(p) + & + cpool_froot_storage_gr(p) + & + cpool_livestem_storage_gr(p) + & + cpool_deadstem_storage_gr(p) + & + cpool_livecroot_storage_gr(p) + & + cpool_deadcroot_storage_gr(p) + + ! GR is the sum of current + transfer + storage GR + gr(p) = & + current_gr(p) + & + transfer_gr(p) + & + storage_gr(p) + + ! autotrophic respiration (AR) + if ( ivt(p) >= npcropmin )then + ar(p) = mr(p) + gr(p) + xsmrpool_to_atm(p) ! xsmr... is -ve (slevis) + else + ar(p) = mr(p) + gr(p) + end if + + ! root respiration (RR) + rr(p) = & + froot_mr(p) + & + cpool_froot_gr(p) + & + cpool_livecroot_gr(p) + & + cpool_deadcroot_gr(p) + & + transfer_froot_gr(p) + & + transfer_livecroot_gr(p) + & + transfer_deadcroot_gr(p) + & + cpool_froot_storage_gr(p) + & + cpool_livecroot_storage_gr(p) + & + cpool_deadcroot_storage_gr(p) + + ! net primary production (NPP) + npp(p) = gpp(p) - ar(p) + + ! update the annual NPP accumulator, for use in allocation code + tempsum_npp(p) = tempsum_npp(p) + npp(p) + + ! aboveground NPP: leaf, live stem, dead stem (AGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of AGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + agnpp(p) = & + cpool_to_leafc(p) + & + leafc_xfer_to_leafc(p) + & + cpool_to_livestemc(p) + & + livestemc_xfer_to_livestemc(p) + & + cpool_to_deadstemc(p) + & + deadstemc_xfer_to_deadstemc(p) + + ! belowground NPP: fine root, live coarse root, dead coarse root (BGNPP) + ! This is supposed to correspond as closely as possible to + ! field measurements of BGNPP, so it ignores the storage pools + ! and only treats the fluxes into displayed pools. + bgnpp(p) = & + cpool_to_frootc(p) + & + frootc_xfer_to_frootc(p) + & + cpool_to_livecrootc(p) + & + livecrootc_xfer_to_livecrootc(p) + & + cpool_to_deadcrootc(p) + & + deadcrootc_xfer_to_deadcrootc(p) + + ! litterfall (LITFALL) + litfall(p) = & + leafc_to_litter(p) + & + frootc_to_litter(p) + & + m_leafc_to_litter(p) + & + m_leafc_storage_to_litter(p) + & + m_leafc_xfer_to_litter(p) + & + m_frootc_to_litter(p) + & + m_frootc_storage_to_litter(p) + & + m_frootc_xfer_to_litter(p) + & + m_livestemc_to_litter(p) + & + m_livestemc_storage_to_litter(p) + & + m_livestemc_xfer_to_litter(p) + & + m_deadstemc_to_litter(p) + & + m_deadstemc_storage_to_litter(p) + & + m_deadstemc_xfer_to_litter(p) + & + m_livecrootc_to_litter(p) + & + m_livecrootc_storage_to_litter(p) + & + m_livecrootc_xfer_to_litter(p) + & + m_deadcrootc_to_litter(p) + & + m_deadcrootc_storage_to_litter(p) + & + m_deadcrootc_xfer_to_litter(p) + & + m_gresp_storage_to_litter(p) + & + m_gresp_xfer_to_litter(p) + & + m_deadstemc_to_litter_fire(p) + & + m_deadcrootc_to_litter_fire(p) + & + hrv_leafc_to_litter(p) + & + hrv_leafc_storage_to_litter(p) + & + hrv_leafc_xfer_to_litter(p) + & + hrv_frootc_to_litter(p) + & + hrv_frootc_storage_to_litter(p) + & + hrv_frootc_xfer_to_litter(p) + & + hrv_livestemc_to_litter(p) + & + hrv_livestemc_storage_to_litter(p) + & + hrv_livestemc_xfer_to_litter(p) + & + hrv_deadstemc_storage_to_litter(p) + & + hrv_deadstemc_xfer_to_litter(p) + & + hrv_livecrootc_to_litter(p) + & + hrv_livecrootc_storage_to_litter(p)+ & + hrv_livecrootc_xfer_to_litter(p) + & + hrv_deadcrootc_to_litter(p) + & + hrv_deadcrootc_storage_to_litter(p)+ & + hrv_deadcrootc_xfer_to_litter(p) + & + hrv_gresp_storage_to_litter(p) + & + hrv_gresp_xfer_to_litter(p) + + if (use_cndv) then + ! update the annual litfall accumulator, for use in mortality code + tempsum_litfall(p) = tempsum_litfall(p) + leafc_to_litter(p) + frootc_to_litter(p) + end if + + ! pft-level fire losses (VEGFIRE) + vegfire(p) = 0._r8 + + ! pft-level wood harvest + wood_harvestc(p) = & + hrv_deadstemc_to_prod10c(p) + & + hrv_deadstemc_to_prod100c(p) + + ! pft-level carbon losses to fire + pft_fire_closs(p) = & + m_leafc_to_fire(p) + & + m_leafc_storage_to_fire(p) + & + m_leafc_xfer_to_fire(p) + & + m_frootc_to_fire(p) + & + m_frootc_storage_to_fire(p) + & + m_frootc_xfer_to_fire(p) + & + m_livestemc_to_fire(p) + & + m_livestemc_storage_to_fire(p) + & + m_livestemc_xfer_to_fire(p) + & + m_deadstemc_to_fire(p) + & + m_deadstemc_storage_to_fire(p) + & + m_deadstemc_xfer_to_fire(p) + & + m_livecrootc_to_fire(p) + & + m_livecrootc_storage_to_fire(p) + & + m_livecrootc_xfer_to_fire(p) + & + m_deadcrootc_to_fire(p) + & + m_deadcrootc_storage_to_fire(p) + & + m_deadcrootc_xfer_to_fire(p) + & + m_gresp_storage_to_fire(p) + & + m_gresp_xfer_to_fire(p) + + ! displayed vegetation carbon, excluding storage and cpool (DISPVEGC) + dispvegc(p) = & + leafc(p) + & + frootc(p) + & + livestemc(p) + & + deadstemc(p) + & + livecrootc(p) + & + deadcrootc(p) + + ! stored vegetation carbon, excluding cpool (STORVEGC) + storvegc(p) = & + cpool(p) + & + leafc_storage(p) + & + frootc_storage(p) + & + livestemc_storage(p) + & + deadstemc_storage(p) + & + livecrootc_storage(p) + & + deadcrootc_storage(p) + & + leafc_xfer(p) + & + frootc_xfer(p) + & + livestemc_xfer(p) + & + deadstemc_xfer(p) + & + livecrootc_xfer(p) + & + deadcrootc_xfer(p) + & + gresp_storage(p) + & + gresp_xfer(p) + + if ( crop_prog .and. ivt(p) >= nc3crop )then + current_gr(p) = current_gr(p) + & + cpool_grain_gr(p) + storvegc(p) = storvegc(p) + & + grainc_storage(p) + & + grainc_xfer(p) + transfer_gr(p) = transfer_gr(p) + & + transfer_grain_gr(p) + storage_gr(p) = storage_gr(p) + & + cpool_grain_storage_gr(p) + agnpp(p) = agnpp(p) + & + cpool_to_grainc(p) + & + grainc_xfer_to_grainc(p) + litfall(p) = litfall(p) + & + livestemc_to_litter(p) + & + grainc_to_food(p) + dispvegc(p) = dispvegc(p) + & + grainc(p) + end if + + ! total vegetation carbon, excluding cpool (TOTVEGC) + totvegc(p) = dispvegc(p) + storvegc(p) + + ! total pft-level carbon, including xsmrpool, ctrunc + totpftc(p) = totvegc(p) + xsmrpool(p) + pft_ctrunc(p) + + ! new summary variables for CLAMP + + ! (FROOTC_ALLOC) - fine root C allocation + frootc_alloc(p) = & + frootc_xfer_to_frootc(p) + & + cpool_to_frootc(p) + + ! (FROOTC_LOSS) - fine root C loss + frootc_loss(p) = & + m_frootc_to_litter(p) + & + m_frootc_to_fire(p) + & + hrv_frootc_to_litter(p) + & + frootc_to_litter(p) + + ! (LEAFC_ALLOC) - leaf C allocation + leafc_alloc(p) = & + leafc_xfer_to_leafc(p) + & + cpool_to_leafc(p) + + ! (LEAFC_LOSS) - leaf C loss + leafc_loss(p) = & + m_leafc_to_litter(p) + & + m_leafc_to_fire(p) + & + hrv_leafc_to_litter(p) + & + leafc_to_litter(p) + + ! (WOODC) - wood C + woodc(p) = & + deadstemc(p) + & + livestemc(p) + & + deadcrootc(p) + & + livecrootc(p) + + ! (WOODC_ALLOC) - wood C allocation + woodc_alloc(p) = & + livestemc_xfer_to_livestemc(p) + & + deadstemc_xfer_to_deadstemc(p) + & + livecrootc_xfer_to_livecrootc(p) + & + deadcrootc_xfer_to_deadcrootc(p) + & + cpool_to_livestemc(p) + & + cpool_to_deadstemc(p) + & + cpool_to_livecrootc(p) + & + cpool_to_deadcrootc(p) + + ! (WOODC_LOSS) - wood C loss + woodc_loss(p) = & + m_livestemc_to_litter(p) + & + m_deadstemc_to_litter(p) + & + m_livecrootc_to_litter(p) + & + m_deadcrootc_to_litter(p) + & + m_livestemc_to_fire(p) + & + m_deadstemc_to_fire(p) + & + m_livecrootc_to_fire(p) + & + m_deadcrootc_to_fire(p) + & + hrv_livestemc_to_litter(p) + & + hrv_livestemc_storage_to_litter(p) + & + hrv_livestemc_xfer_to_litter(p) + & + hrv_deadstemc_to_prod10c(p) + & + hrv_deadstemc_to_prod100c(p) + & + hrv_deadstemc_storage_to_litter(p) + & + hrv_deadstemc_xfer_to_litter(p) + & + hrv_livecrootc_to_litter(p) + & + hrv_livecrootc_storage_to_litter(p)+ & + hrv_livecrootc_xfer_to_litter(p) + & + hrv_deadcrootc_to_litter(p) + & + hrv_deadcrootc_storage_to_litter(p)+ & + hrv_deadcrootc_xfer_to_litter(p) + + end do ! end of pfts loop + + ! use p2c routine to get selected column-average pft-level fluxes and states + call p2c(num_soilc, filter_soilc, gpp, col_gpp) + call p2c(num_soilc, filter_soilc, ar, col_ar) + call p2c(num_soilc, filter_soilc, rr, col_rr) + call p2c(num_soilc, filter_soilc, npp, col_npp) + call p2c(num_soilc, filter_soilc, vegfire, col_vegfire) + call p2c(num_soilc, filter_soilc, wood_harvestc, col_wood_harvestc) + call p2c(num_soilc, filter_soilc, totvegc, col_totvegc) + call p2c(num_soilc, filter_soilc, totpftc, col_totpftc) + call p2c(num_soilc, filter_soilc, pft_fire_closs, col_pft_fire_closs) + call p2c(num_soilc, filter_soilc, litfall, col_litfall) + call p2c(num_soilc, filter_soilc, hrv_xsmrpool_to_atm, col_hrv_xsmrpool_to_atm) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! litter heterotrophic respiration (LITHR) + lithr(c) = & + litr1_hr(c) + & + litr2_hr(c) + & + litr3_hr(c) + + ! soil organic matter heterotrophic respiration (SOMHR) + somhr(c) = & + soil1_hr(c) + & + soil2_hr(c) + & + soil3_hr(c) + & + soil4_hr(c) + + ! total heterotrophic respiration (HR) + hr(c) = lithr(c) + somhr(c) + + ! total soil respiration, heterotrophic + root respiration (SR) + sr(c) = col_rr(c) + hr(c) + + ! total ecosystem respiration, autotrophic + heterotrophic (ER) + er(c) = col_ar(c) + hr(c) + + ! litter fire losses (LITFIRE) + litfire(c) = 0._r8 + + ! total wood product loss + product_closs(c) = & + prod10c_loss(c) + & + prod100c_loss(c) + + ! soil organic matter fire losses (SOMFIRE) + somfire(c) = 0._r8 + + ! total ecosystem fire losses (TOTFIRE) + totfire(c) = & + litfire(c) + & + somfire(c) + & + col_vegfire(c) + + ! column-level carbon losses to fire, including pft losses + col_fire_closs(c) = & + m_litr1c_to_fire(c) + & + m_litr2c_to_fire(c) + & + m_litr3c_to_fire(c) + & + m_cwdc_to_fire(c) + & + col_pft_fire_closs(c) + + ! column-level carbon losses due to landcover change + dwt_closs(c) = & + dwt_conv_cflux(c) + + ! net ecosystem production, excludes fire flux, landcover change, and loss from wood products, positive for sink (NEP) + nep(c) = col_gpp(c) - er(c) + + ! net biome production of carbon, includes depletion from: fire flux, landcover change flux, and loss + ! from wood products pools, positive for sink (NBP) + nbp(c) = nep(c) - col_fire_closs(c) - dwt_closs(c) - product_closs(c) + + ! net ecosystem exchange of carbon, includes fire flux, landcover change flux, loss + ! from wood products pools, and hrv_xsmrpool flux, positive for source (NEE) + nee(c) = -nep(c) + col_fire_closs(c) + dwt_closs(c) + product_closs(c) + col_hrv_xsmrpool_to_atm(c) + ! land use flux and land uptake + landuseflux(c) = dwt_closs(c) + product_closs(c) + landuptake(c) = nee(c) - landuseflux(c) + + ! total litter carbon (TOTLITC) + totlitc(c) = & + litr1c(c) + & + litr2c(c) + & + litr3c(c) + + ! total soil organic matter carbon (TOTSOMC) + totsomc(c) = & + soil1c(c) + & + soil2c(c) + & + soil3c(c) + & + soil4c(c) + + ! total wood product carbon + totprodc(c) = & + prod10c(c) + & + prod100c(c) + + ! total ecosystem carbon, including veg but excluding cpool (TOTECOSYSC) + totecosysc(c) = & + cwdc(c) + & + totlitc(c) + & + totsomc(c) + & + totprodc(c) + & + col_totvegc(c) + + ! total column carbon, including veg and cpool (TOTCOLC) + ! adding col_ctrunc, seedc + totcolc(c) = & + col_totpftc(c) + & + cwdc(c) + & + totlitc(c) + & + totsomc(c) + & + totprodc(c) + & + seedc(c) + & + col_ctrunc(c) + + ! new summary variables for CLAMP + + ! (CWDC_HR) - coarse woody debris heterotrophic respiration + cwdc_hr(c) = 0._r8 + + ! (CWDC_LOSS) - coarse woody debris C loss + cwdc_loss(c) = & + m_cwdc_to_fire(c) + & + cwdc_to_litr2c(c) + & + cwdc_to_litr3c(c) + + ! (LITTERC_LOSS) - litter C loss + litterc_loss(c) = & + lithr(c) + & + m_litr1c_to_fire(c) + & + m_litr2c_to_fire(c) + & + m_litr3c_to_fire(c) + & + litr1c_to_soil1c(c) + & + litr2c_to_soil2c(c) + & + litr3c_to_soil3c(c) + + end do ! end of columns loop + + +end subroutine CSummary +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NSummary +! +! !INTERFACE: +subroutine NSummary(num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, perform pft and column-level nitrogen +! summary calculations +! +! !USES: + use clmtype + use pft2colMod, only: p2c +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! filter for soil pfts +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 6/28/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: col_fire_nloss(:) ! (gN/m2/s) total column-level fire N loss + real(r8), pointer :: col_wood_harvestn(:) + real(r8), pointer :: denit(:) + real(r8), pointer :: m_cwdn_to_fire(:) + real(r8), pointer :: m_litr1n_to_fire(:) + real(r8), pointer :: m_litr2n_to_fire(:) + real(r8), pointer :: m_litr3n_to_fire(:) + real(r8), pointer :: col_pft_fire_nloss(:) ! (gN/m2/s) total pft-level fire C loss + real(r8), pointer :: sminn_to_denit_excess(:) + real(r8), pointer :: sminn_to_denit_l1s1(:) + real(r8), pointer :: sminn_to_denit_l2s2(:) + real(r8), pointer :: sminn_to_denit_l3s3(:) + real(r8), pointer :: sminn_to_denit_s1s2(:) + real(r8), pointer :: sminn_to_denit_s2s3(:) + real(r8), pointer :: sminn_to_denit_s3s4(:) + real(r8), pointer :: sminn_to_denit_s4(:) + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: col_totpftn(:) ! (gN/m2) total pft-level nitrogen + real(r8), pointer :: col_totvegn(:) ! (gN/m2) total vegetation nitrogen + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + real(r8), pointer :: soil1n(:) ! (gN/m2) soil organic matter N (fast pool) + real(r8), pointer :: soil2n(:) ! (gN/m2) soil organic matter N (medium pool) + real(r8), pointer :: soil3n(:) ! (gN/m2) soil orgainc matter N (slow pool) + real(r8), pointer :: soil4n(:) ! (gN/m2) soil orgainc matter N (slowest pool) + real(r8), pointer :: col_ntrunc(:) ! (gN/m2) column-level sink for N truncation + real(r8), pointer :: totcoln(:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: totecosysn(:) ! (gN/m2) total ecosystem nitrogen, incl veg + real(r8), pointer :: totlitn(:) ! (gN/m2) total litter nitrogen + real(r8), pointer :: totsomn(:) ! (gN/m2) total soil organic matter nitrogen + real(r8), pointer :: m_deadcrootn_storage_to_fire(:) + real(r8), pointer :: m_deadcrootn_to_fire(:) + real(r8), pointer :: m_deadcrootn_xfer_to_fire(:) + real(r8), pointer :: m_deadstemn_storage_to_fire(:) + real(r8), pointer :: m_deadstemn_to_fire(:) + real(r8), pointer :: m_deadstemn_xfer_to_fire(:) + real(r8), pointer :: m_frootn_storage_to_fire(:) + real(r8), pointer :: m_frootn_to_fire(:) + real(r8), pointer :: m_frootn_xfer_to_fire(:) + real(r8), pointer :: m_leafn_storage_to_fire(:) + real(r8), pointer :: m_leafn_to_fire(:) + real(r8), pointer :: m_leafn_xfer_to_fire(:) + real(r8), pointer :: m_livecrootn_storage_to_fire(:) + real(r8), pointer :: m_livecrootn_to_fire(:) + real(r8), pointer :: m_livecrootn_xfer_to_fire(:) + real(r8), pointer :: m_livestemn_storage_to_fire(:) + real(r8), pointer :: m_livestemn_to_fire(:) + real(r8), pointer :: m_livestemn_xfer_to_fire(:) + real(r8), pointer :: m_retransn_to_fire(:) + real(r8), pointer :: hrv_deadstemn_to_prod10n(:) + real(r8), pointer :: hrv_deadstemn_to_prod100n(:) + real(r8), pointer :: ndeploy(:) + real(r8), pointer :: pft_fire_nloss(:) ! (gN/m2/s) total pft-level fire C loss + real(r8), pointer :: retransn_to_npool(:) + real(r8), pointer :: sminn_to_npool(:) + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: dispvegn(:) ! (gN/m2) displayed veg nitrogen, excluding storage + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: grainn(:) ! (gN/m2) grain N + real(r8), pointer :: grainn_storage(:) ! (gN/m2) grain N storage + real(r8), pointer :: grainn_xfer(:) ! (gN/m2) grain N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool(:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: pft_ntrunc(:) ! (gN/m2) pft-level sink for N truncation + real(r8), pointer :: storvegn(:) ! (gN/m2) stored vegetation nitrogen + real(r8), pointer :: totpftn(:) ! (gN/m2) total pft-level nitrogen + real(r8), pointer :: totvegn(:) ! (gN/m2) total vegetation nitrogen + ! for landcover change + real(r8), pointer :: wood_harvestn(:) ! total N losses to wood product pools (gN/m2/s) + real(r8), pointer :: dwt_nloss(:) ! (gN/m2/s) total nitrogen loss from product pools and conversion + real(r8), pointer :: dwt_conv_nflux(:) ! (gN/m2/s) conversion N flux (immediate loss to atm) + real(r8), pointer :: seedn(:) ! (gN/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10n_loss(:) ! (gN/m2/s) loss from 10-yr wood product pool + real(r8), pointer :: prod100n_loss(:) ! (gN/m2/s) loss from 100-yr wood product pool + real(r8), pointer :: product_nloss(:) ! (gN/m2/s) total wood product nitrogen loss + real(r8), pointer :: prod10n(:) ! (gN/m2) wood product N pool, 10-year lifespan + real(r8), pointer :: prod100n(:) ! (gN/m2) wood product N pool, 100-year lifespan + real(r8), pointer :: totprodn(:) ! (gN/m2) total wood product N +! +! local pointers to implicit in/out scalars +! +! local pointers to implicit out scalars +! +! !OTHER LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fp,fc ! lake filter indices + +!EOP +!----------------------------------------------------------------------- + ! assign local pointers + ivt => pft%itype + col_fire_nloss => cnf%col_fire_nloss + denit => cnf%denit + m_cwdn_to_fire => cnf%m_cwdn_to_fire + m_litr1n_to_fire => cnf%m_litr1n_to_fire + m_litr2n_to_fire => cnf%m_litr2n_to_fire + m_litr3n_to_fire => cnf%m_litr3n_to_fire + col_pft_fire_nloss => pnf_a%pft_fire_nloss + sminn_to_denit_excess => cnf%sminn_to_denit_excess + sminn_to_denit_l1s1 => cnf%sminn_to_denit_l1s1 + sminn_to_denit_l2s2 => cnf%sminn_to_denit_l2s2 + sminn_to_denit_l3s3 => cnf%sminn_to_denit_l3s3 + sminn_to_denit_s1s2 => cnf%sminn_to_denit_s1s2 + sminn_to_denit_s2s3 => cnf%sminn_to_denit_s2s3 + sminn_to_denit_s3s4 => cnf%sminn_to_denit_s3s4 + sminn_to_denit_s4 => cnf%sminn_to_denit_s4 + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + col_totpftn => pns_a%totpftn + col_totvegn => pns_a%totvegn + sminn => cns%sminn + col_ntrunc => cns%col_ntrunc + soil1n => cns%soil1n + soil2n => cns%soil2n + soil3n => cns%soil3n + soil4n => cns%soil4n + totcoln => cns%totcoln + totecosysn => cns%totecosysn + totlitn => cns%totlitn + totsomn => cns%totsomn + m_deadcrootn_storage_to_fire => pnf%m_deadcrootn_storage_to_fire + m_deadcrootn_to_fire => pnf%m_deadcrootn_to_fire + m_deadcrootn_xfer_to_fire => pnf%m_deadcrootn_xfer_to_fire + m_deadstemn_storage_to_fire => pnf%m_deadstemn_storage_to_fire + m_deadstemn_to_fire => pnf%m_deadstemn_to_fire + m_deadstemn_xfer_to_fire => pnf%m_deadstemn_xfer_to_fire + m_frootn_storage_to_fire => pnf%m_frootn_storage_to_fire + m_frootn_to_fire => pnf%m_frootn_to_fire + m_frootn_xfer_to_fire => pnf%m_frootn_xfer_to_fire + m_leafn_storage_to_fire => pnf%m_leafn_storage_to_fire + m_leafn_to_fire => pnf%m_leafn_to_fire + m_leafn_xfer_to_fire => pnf%m_leafn_xfer_to_fire + m_livecrootn_storage_to_fire => pnf%m_livecrootn_storage_to_fire + m_livecrootn_to_fire => pnf%m_livecrootn_to_fire + m_livecrootn_xfer_to_fire => pnf%m_livecrootn_xfer_to_fire + m_livestemn_storage_to_fire => pnf%m_livestemn_storage_to_fire + m_livestemn_to_fire => pnf%m_livestemn_to_fire + m_livestemn_xfer_to_fire => pnf%m_livestemn_xfer_to_fire + m_retransn_to_fire => pnf%m_retransn_to_fire + hrv_deadstemn_to_prod10n => pnf%hrv_deadstemn_to_prod10n + hrv_deadstemn_to_prod100n => pnf%hrv_deadstemn_to_prod100n + ndeploy => pnf%ndeploy + pft_fire_nloss => pnf%pft_fire_nloss + retransn_to_npool => pnf%retransn_to_npool + sminn_to_npool => pnf%sminn_to_npool + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + dispvegn => pns%dispvegn + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + grainn => pns%grainn + grainn_storage => pns%grainn_storage + grainn_xfer => pns%grainn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + retransn => pns%retransn + npool => pns%npool + pft_ntrunc => pns%pft_ntrunc + storvegn => pns%storvegn + totpftn => pns%totpftn + totvegn => pns%totvegn + ! dynamic landcover pointers + wood_harvestn => pnf%wood_harvestn + col_wood_harvestn => pnf_a%wood_harvestn + dwt_nloss => cnf%dwt_nloss + dwt_conv_nflux => cnf%dwt_conv_nflux + prod10n_loss => cnf%prod10n_loss + prod100n_loss => cnf%prod100n_loss + product_nloss => cnf%product_nloss + seedn => cns%seedn + prod10n => cns%prod10n + prod100n => cns%prod100n + totprodn => cns%totprodn + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + ! calculate pft-level summary nitrogen fluxes and states + + ! total N deployment (from sminn and retranslocated N pool) (NDEPLOY) + ndeploy(p) = & + sminn_to_npool(p) + & + retransn_to_npool(p) + + ! pft-level wood harvest + wood_harvestn(p) = & + hrv_deadstemn_to_prod10n(p) + & + hrv_deadstemn_to_prod100n(p) + + ! total pft-level fire N losses + pft_fire_nloss(p) = & + m_leafn_to_fire(p) + & + m_leafn_storage_to_fire(p) + & + m_leafn_xfer_to_fire(p) + & + m_frootn_to_fire(p) + & + m_frootn_storage_to_fire(p) + & + m_frootn_xfer_to_fire(p) + & + m_livestemn_to_fire(p) + & + m_livestemn_storage_to_fire(p) + & + m_livestemn_xfer_to_fire(p) + & + m_deadstemn_to_fire(p) + & + m_deadstemn_storage_to_fire(p) + & + m_deadstemn_xfer_to_fire(p) + & + m_livecrootn_to_fire(p) + & + m_livecrootn_storage_to_fire(p) + & + m_livecrootn_xfer_to_fire(p) + & + m_deadcrootn_to_fire(p) + & + m_deadcrootn_storage_to_fire(p) + & + m_deadcrootn_xfer_to_fire(p) + & + m_retransn_to_fire(p) + + ! displayed vegetation nitrogen, excluding storage (DISPVEGN) + dispvegn(p) = & + leafn(p) + & + frootn(p) + & + livestemn(p) + & + deadstemn(p) + & + livecrootn(p) + & + deadcrootn(p) + + ! stored vegetation nitrogen, including retranslocated N pool (STORVEGN) + storvegn(p) = & + leafn_storage(p) + & + frootn_storage(p) + & + livestemn_storage(p) + & + deadstemn_storage(p) + & + livecrootn_storage(p) + & + deadcrootn_storage(p) + & + leafn_xfer(p) + & + frootn_xfer(p) + & + livestemn_xfer(p) + & + deadstemn_xfer(p) + & + livecrootn_xfer(p) + & + deadcrootn_xfer(p) + & + npool(p) + & + retransn(p) + + if ( crop_prog .and. ivt(p) >= nc3crop )then + dispvegn(p) = dispvegn(p) + & + grainn(p) + storvegn(p) = storvegn(p) + & + grainn_storage(p) + & + grainn_xfer(p) + end if + + ! total vegetation nitrogen (TOTVEGN) + totvegn(p) = dispvegn(p) + storvegn(p) + + ! total pft-level carbon (add pft_ntrunc) + totpftn(p) = totvegn(p) + pft_ntrunc(p) + + + end do ! end of pfts loop + + ! use p2c routine to get selected column-average pft-level fluxes and states + call p2c(num_soilc, filter_soilc, pft_fire_nloss, col_pft_fire_nloss) + call p2c(num_soilc, filter_soilc, wood_harvestn, col_wood_harvestn) + call p2c(num_soilc, filter_soilc, totvegn, col_totvegn) + call p2c(num_soilc, filter_soilc, totpftn, col_totpftn) + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! total N denitrification (DENIT) + denit(c) = & + sminn_to_denit_l1s1(c) + & + sminn_to_denit_l2s2(c) + & + sminn_to_denit_l3s3(c) + & + sminn_to_denit_s1s2(c) + & + sminn_to_denit_s2s3(c) + & + sminn_to_denit_s3s4(c) + & + sminn_to_denit_s4(c) + & + sminn_to_denit_excess(c) + + ! total column-level fire N losses + col_fire_nloss(c) = & + m_litr1n_to_fire(c) + & + m_litr2n_to_fire(c) + & + m_litr3n_to_fire(c) + & + m_cwdn_to_fire(c) + & + col_pft_fire_nloss(c) + + ! column-level N losses due to landcover change + dwt_nloss(c) = & + dwt_conv_nflux(c) + + ! total wood product N loss + product_nloss(c) = & + prod10n_loss(c) + & + prod100n_loss(c) + + ! total litter nitrogen (TOTLITN) + totlitn(c) = & + litr1n(c) + & + litr2n(c) + & + litr3n(c) + + ! total soil organic matter nitrogen (TOTSOMN) + totsomn(c) = & + soil1n(c) + & + soil2n(c) + & + soil3n(c) + & + soil4n(c) + + ! total wood product nitrogen + totprodn(c) = & + prod10n(c) + & + prod100n(c) + + ! total ecosystem nitrogen, including veg (TOTECOSYSN) + totecosysn(c) = & + cwdn(c) + & + totlitn(c) + & + totsomn(c) + & + sminn(c) + & + totprodn(c) + & + col_totvegn(c) + + ! total column nitrogen, including pft (TOTCOLN) + totcoln(c) = & + col_totpftn(c) + & + cwdn(c) + & + totlitn(c) + & + totsomn(c) + & + sminn(c) + & + totprodn(c) + & + seedn(c) + & + col_ntrunc(c) + + end do ! end of columns loop + + +end subroutine NSummary +!----------------------------------------------------------------------- + +end module CNSummaryMod diff --git a/components/clm/src_clm40/biogeochem/CNVegStructUpdateMod.F90 b/components/clm/src_clm40/biogeochem/CNVegStructUpdateMod.F90 new file mode 100644 index 0000000000..955f76ef7e --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNVegStructUpdateMod.F90 @@ -0,0 +1,317 @@ +module CNVegStructUpdateMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNVegStructUpdateMod +! +! !DESCRIPTION: +! Module for vegetation structure updates (LAI, SAI, htop, hbot) +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public :: CNVegStructUpdate +! +! !REVISION HISTORY: +! 4/23/2004: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNVegStructUpdate +! +! !INTERFACE: +subroutine CNVegStructUpdate(num_soilp, filter_soilp) +! +! !DESCRIPTION: +! On the radiation time step, use C state variables and epc to diagnose +! vegetation structure (LAI, SAI, height) +! +! !USES: + use clmtype + use clm_atmlnd , only: clm_a2l + use pftvarcon , only: noveg, nc3crop, nirrig, nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub + use pftvarcon , only: ncorn, npcropmin, ztopmx, laimx + use clm_varctl , only: iulog, use_cndv + use shr_sys_mod , only: shr_sys_flush + use shr_const_mod, only: SHR_CONST_PI + use clm_time_manager , only : get_rad_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilp ! number of column soil points in pft filter + integer, intent(in) :: filter_soilp(:) ! pft filter for soil points +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 10/28/03: Created by Peter Thornton +! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation +! +! !LOCAL VARIABLES: +! local pointers to implicit in scalars +! + real(r8), pointer :: allom2(:) ! ecophys const + real(r8), pointer :: allom3(:) ! ecophys const + real(r8), pointer :: nind(:) ! number of individuals (#/m**2) + real(r8), pointer :: fpcgrid(:) ! fractional area of pft (pft area/nat veg area) + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! column index associated with each pft + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: woody(:) !binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: slatop(:) !specific leaf area at top of canopy, projected area basis [m^2/gC] + real(r8), pointer :: dsladlai(:) !dSLA/dLAI, projected area basis [m^2/gC] + real(r8), pointer :: z0mr(:) !ratio of momentum roughness length to canopy top height (-) + real(r8), pointer :: displar(:) !ratio of displacement height to canopy top height (-) + real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft-level [m] + real(r8), pointer :: dwood(:) ! density of wood (gC/m^3) +! +! local pointers to implicit in/out scalars +! + integer , pointer :: frac_veg_nosno_alb(:) ! frac of vegetation not covered by snow [-] + real(r8), pointer :: tlai(:) !one-sided leaf area index, no burying by snow + real(r8), pointer :: tsai(:) !one-sided stem area index, no burying by snow + real(r8), pointer :: htop(:) !canopy top (m) + real(r8), pointer :: hbot(:) !canopy bottom (m) + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: htmx(:) ! max hgt attained by a crop during yr (m) + integer , pointer :: peaklai(:) ! 1: max allowed lai; 0: not at max + integer , pointer :: harvdate(:) ! harvest date +! +! local pointers to implicit out scalars +! +! +! !OTHER LOCAL VARIABLES: + integer :: p,c,g !indices + integer :: fp !lake filter indices + real(r8):: taper ! ratio of height:radius_breast_height (tree allometry) + real(r8):: stocking ! #stems / ha (stocking density) + real(r8):: ol ! thickness of canopy layer covered by snow (m) + real(r8):: fb ! fraction of canopy layer covered by snow + real(r8) :: tlai_old ! for use in Zeng tsai formula + real(r8) :: tsai_old ! for use in Zeng tsai formula + real(r8) :: tsai_min ! PFT derived minimum tsai + real(r8) :: tsai_alpha ! monthly decay rate of tsai + real(r8) dt ! radiation time step (sec) + + real(r8), parameter :: dtsmonth = 2592000._r8 ! number of seconds in a 30 day month (60x60x24x30) +!EOP +!----------------------------------------------------------------------- +! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 +! +! tsai(p) = max( tsai_alpha(ivt(p))*tsai_old + max(tlai_old-tlai(p),0_r8), tsai_min(ivt(p)) ) +! notes: +! * RHS tsai & tlai are from previous timestep +! * should create tsai_alpha(ivt(p)) & tsai_min(ivt(p)) in pftvarcon.F90 - slevis +! * all non-crop pfts use same values: +! crop tsai_alpha,tsai_min = 0.0,0.1 +! noncrop tsai_alpha,tsai_min = 0.5,1.0 (includes bare soil and urban) +!------------------------------------------------------------------------------- + + ! assign local pointers to derived type arrays (in) + allom2 => dgv_pftcon%allom2 + allom3 => dgv_pftcon%allom3 + nind => pdgvs%nind + fpcgrid => pdgvs%fpcgrid + ivt => pft%itype + pcolumn => pft%column + pgridcell => pft%gridcell + leafc => pcs%leafc + deadstemc => pcs%deadstemc + snowdp => cps%snowdp + woody => pftcon%woody + slatop => pftcon%slatop + dsladlai => pftcon%dsladlai + z0mr => pftcon%z0mr + displar => pftcon%displar + dwood => pftcon%dwood + + ! assign local pointers to derived type arrays (out) + tlai => pps%tlai + tsai => pps%tsai + htop => pps%htop + hbot => pps%hbot + elai => pps%elai + esai => pps%esai + frac_veg_nosno_alb => pps%frac_veg_nosno_alb + htmx => pps%htmx + peaklai => pps%peaklai + harvdate => pps%harvdate + forc_hgt_u_pft => pps%forc_hgt_u_pft + + dt = real( get_rad_step_size(), r8 ) + + ! constant allometric parameters + taper = 200._r8 + stocking = 1000._r8 + + ! convert from stems/ha -> stems/m^2 + stocking = stocking / 10000._r8 + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pcolumn(p) + g = pgridcell(p) + + if (ivt(p) /= noveg) then + + tlai_old = tlai(p) ! n-1 value + tsai_old = tsai(p) ! n-1 value + + ! update the leaf area index based on leafC and SLA + ! Eq 3 from Thornton and Zimmerman, 2007, J Clim, 20, 3902-3923. + if (dsladlai(ivt(p)) > 0._r8) then + tlai(p) = (slatop(ivt(p))*(exp(leafc(p)*dsladlai(ivt(p))) - 1._r8))/dsladlai(ivt(p)) + else + tlai(p) = slatop(ivt(p)) * leafc(p) + end if + tlai(p) = max(0._r8, tlai(p)) + + ! update the stem area index and height based on LAI, stem mass, and veg type. + ! With the exception of htop for woody vegetation, this follows the DGVM logic. + + ! tsai formula from Zeng et. al. 2002, Journal of Climate, p1835 (see notes) + ! Assumes doalb time step .eq. CLM time step, SAI min and monthly decay factor + ! alpha are set by PFT, and alpha is scaled to CLM time step by multiplying by + ! dt and dividing by dtsmonth (seconds in average 30 day month) + ! tsai_min scaled by 0.5 to match MODIS satellite derived values + if (ivt(p) == nc3crop .or. ivt(p) == nirrig) then ! generic crops + + tsai_alpha = 1.0_r8-1.0_r8*dt/dtsmonth + tsai_min = 0.1_r8 + else + tsai_alpha = 1.0_r8-0.5_r8*dt/dtsmonth + tsai_min = 1.0_r8 + end if + tsai_min = tsai_min * 0.5_r8 + tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min) + + if (woody(ivt(p)) == 1._r8) then + + ! trees and shrubs + + ! if shrubs have a squat taper + if (ivt(p) >= nbrdlf_evr_shrub .and. ivt(p) <= nbrdlf_dcd_brl_shrub) then + taper = 10._r8 + ! otherwise have a tall taper + else + taper = 200._r8 + end if + + ! trees and shrubs for now have a very simple allometry, with hard-wired + ! stem taper (height:radius) and hard-wired stocking density (#individuals/area) + if (use_cndv) then + if (fpcgrid(p) > 0._r8 .and. nind(p) > 0._r8) then + stocking = nind(p)/fpcgrid(p) !#ind/m2 nat veg area -> #ind/m2 pft area + ! lpj's htop w/ cn's stemdiam + htop(p) = allom2(ivt(p)) * ( (24._r8 * deadstemc(p) / & + (SHR_CONST_PI * stocking * dwood(ivt(p)) * taper))**(1._r8/3._r8) )**allom3(ivt(p)) + else + htop(p) = 0._r8 + end if + else + htop(p) = ((3._r8 * deadstemc(p) * taper * taper)/ & + (SHR_CONST_PI * stocking * dwood(ivt(p))))**(1._r8/3._r8) + end if + + ! Peter Thornton, 5/3/2004 + ! Adding test to keep htop from getting too close to forcing height for windspeed + ! Also added for grass, below, although it is not likely to ever be an issue. + htop(p) = min(htop(p),(forc_hgt_u_pft(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + ! This becomes an issue when fire mortality is pushing deadstemc + ! to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0._r8, min(3._r8, htop(p)-1._r8)) + + else if (ivt(p) >= npcropmin) then ! prognostic crops + + if (tlai(p) >= laimx(ivt(p))) peaklai(p) = 1 ! used in CNAllocation + + if (ivt(p) == ncorn) then + tsai(p) = 0.1_r8 * tlai(p) + else + tsai(p) = 0.2_r8 * tlai(p) + end if + + ! "stubble" after harvest + if (harvdate(p) < 999 .and. tlai(p) == 0._r8) then + tsai(p) = 0.25_r8 + htmx(p) = 0._r8 + peaklai(p) = 0 + end if + !if (harvdate(p) < 999 .and. tlai(p) > 0._r8) write(iulog,*) 'CNVegStructUpdate: tlai>0 after harvest!' ! remove after initial debugging? + + ! canopy top and bottom heights + htop(p) = ztopmx(ivt(p)) * (min(tlai(p)/(laimx(ivt(p))-1._r8),1._r8))**2 + htmx(p) = max(htmx(p), htop(p)) + htop(p) = max(0.05_r8, max(htmx(p),htop(p))) + hbot(p) = 0.02_r8 + else ! generic crops and ... + ! grasses + + ! height for grasses depends only on LAI + htop(p) = max(0.25_r8, tlai(p) * 0.25_r8) + + htop(p) = min(htop(p),(forc_hgt_u_pft(p)/(displar(ivt(p))+z0mr(ivt(p))))-3._r8) + + ! Peter Thornton, 8/11/2004 + ! Adding constraint to keep htop from going to 0.0. + htop(p) = max(htop(p), 0.01_r8) + + hbot(p) = max(0.0_r8, min(0.05_r8, htop(p)-0.20_r8)) + end if + + else + tlai(p) = 0._r8 + tsai(p) = 0._r8 + htop(p) = 0._r8 + hbot(p) = 0._r8 + end if + + ! adjust lai and sai for burying by snow. + + ! snow burial fraction for short vegetation (e.g. grasses) as in + ! Wang and Zeng, 2007. + if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then + ol = min( max(snowdp(c)-hbot(p), 0._r8), htop(p)-hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - max(min(snowdp(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed + !depth of snow required for complete burial of grasses + endif + + elai(p) = max(tlai(p)*fb, 0.0_r8) + esai(p) = max(tsai(p)*fb, 0.0_r8) + + ! Fraction of vegetation free of snow + if ((elai(p) + esai(p)) > 0._r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if + + end do + +end subroutine CNVegStructUpdate +!----------------------------------------------------------------------- + +end module CNVegStructUpdateMod diff --git a/components/clm/src_clm40/biogeochem/CNWoodProductsMod.F90 b/components/clm/src_clm40/biogeochem/CNWoodProductsMod.F90 new file mode 100644 index 0000000000..7bcc54b24d --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNWoodProductsMod.F90 @@ -0,0 +1,138 @@ +module CNWoodProductsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNWoodProductsMod +! +! !DESCRIPTION: +! Calculate loss fluxes from wood products pools, and update product pool state variables +! +! !USES: + use decompMod , only : get_proc_bounds + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varcon , only: istsoil + use spmdMod , only: masterproc + implicit none + save + private +! !PUBLIC MEMBER FUNCTIONS: + public:: CNWoodProducts +! +! !REVISION HISTORY: +! 5/20/2009: Created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNWoodProducts +! +! !INTERFACE: +subroutine CNWoodProducts(num_soilc, filter_soilc) +! +! !DESCRIPTION: +! Update all loss fluxes from wood product pools, and update product pool state variables +! for both loss and gain terms. Gain terms are calculated in pftdyn_cnbal() for gains associated +! with changes in landcover, and in CNHarvest(), for gains associated with wood harvest. +! +! !USES: + use clmtype + use clm_time_manager, only: get_step_size + use clm_varctl, only : use_c13 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 5/21/09: Created by Peter Thornton +! +! !LOCAL VARIABLES: + + integer :: fc ! lake filter indices + integer :: c ! indices + real(r8):: dt ! time step (seconds) + type(column_type), pointer :: cptr ! pointer to column derived subtype + real(r8) :: kprod10 ! decay constant for 10-year product pool + real(r8) :: kprod100 ! decay constant for 100-year product pool + +!EOP +!----------------------------------------------------------------------- + + cptr => col + + ! calculate column-level losses from product pools + ! the following (1/s) rate constants result in ~90% loss of initial state over 10 and 100 years, + ! respectively, using a discrete-time fractional decay algorithm. + kprod10 = 7.2e-9 + kprod100 = 7.2e-10 + + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! calculate fluxes (1/sec) + ccf%prod10c_loss(c) = ccs%prod10c(c) * kprod10 + ccf%prod100c_loss(c) = ccs%prod100c(c) * kprod100 + if (use_c13) then + cc13f%prod10c_loss(c) = cc13s%prod10c(c) * kprod10 + cc13f%prod100c_loss(c) = cc13s%prod100c(c) * kprod100 + end if + cnf%prod10n_loss(c) = cns%prod10n(c) * kprod10 + cnf%prod100n_loss(c) = cns%prod100n(c) * kprod100 + end do + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! update wood product state variables + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column-level fluxes + + ! fluxes into wood product pools, from landcover change + ccs%prod10c(c) = ccs%prod10c(c) + ccf%dwt_prod10c_gain(c)*dt + ccs%prod100c(c) = ccs%prod100c(c) + ccf%dwt_prod100c_gain(c)*dt + if (use_c13) then + cc13s%prod10c(c) = cc13s%prod10c(c) + cc13f%dwt_prod10c_gain(c)*dt + cc13s%prod100c(c) = cc13s%prod100c(c) + cc13f%dwt_prod100c_gain(c)*dt + end if + cns%prod10n(c) = cns%prod10n(c) + cnf%dwt_prod10n_gain(c)*dt + cns%prod100n(c) = cns%prod100n(c) + cnf%dwt_prod100n_gain(c)*dt + + ! fluxes into wood product pools, from harvest + ccs%prod10c(c) = ccs%prod10c(c) + ccf%hrv_deadstemc_to_prod10c(c)*dt + ccs%prod100c(c) = ccs%prod100c(c) + ccf%hrv_deadstemc_to_prod100c(c)*dt + if (use_c13) then + cc13s%prod10c(c) = cc13s%prod10c(c) + cc13f%hrv_deadstemc_to_prod10c(c)*dt + cc13s%prod100c(c) = cc13s%prod100c(c) + cc13f%hrv_deadstemc_to_prod100c(c)*dt + end if + cns%prod10n(c) = cns%prod10n(c) + cnf%hrv_deadstemn_to_prod10n(c)*dt + cns%prod100n(c) = cns%prod100n(c) + cnf%hrv_deadstemn_to_prod100n(c)*dt + + ! fluxes out of wood product pools, from decomposition + ccs%prod10c(c) = ccs%prod10c(c) - ccf%prod10c_loss(c)*dt + ccs%prod100c(c) = ccs%prod100c(c) - ccf%prod100c_loss(c)*dt + if (use_c13) then + cc13s%prod10c(c) = cc13s%prod10c(c) - cc13f%prod10c_loss(c)*dt + cc13s%prod100c(c) = cc13s%prod100c(c) - cc13f%prod100c_loss(c)*dt + end if + cns%prod10n(c) = cns%prod10n(c) - cnf%prod10n_loss(c)*dt + cns%prod100n(c) = cns%prod100n(c) - cnf%prod100n_loss(c)*dt + + end do ! end of column loop + +end subroutine CNWoodProducts +!----------------------------------------------------------------------- + +end module CNWoodProductsMod diff --git a/components/clm/src_clm40/biogeochem/CNrestMod.F90 b/components/clm/src_clm40/biogeochem/CNrestMod.F90 new file mode 100644 index 0000000000..c22e5b48cd --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CNrestMod.F90 @@ -0,0 +1,2339 @@ +module CNrestMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CNrestMod +! +! !DESCRIPTION: +! Read/Write to/from CN info to CLM restart file. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use abortutils , only : endrun +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: CNrest +! +! !REVISION HISTORY: +! 11/05/03: Module created by Peter Thornton +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNRest +! +! !INTERFACE: + subroutine CNRest ( ncid, flag ) +! +! !DESCRIPTION: +! Read/write CN restart data +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varpar , only : numrad + use clm_varctl , only : use_c13, use_cndv, use_exit_spinup + use decompMod , only : get_proc_bounds + use clm_time_manager, only : is_restart + use ncdio_pio +! +! !ARGUMENTS: + implicit none + type(file_desc_t) :: ncid ! netcdf id + character(len=*), intent(in) :: flag !'read' or 'write' +! +! !CALLED FROM: +! subroutine restart in module restFileMod +! +! !REVISION HISTORY: +! Author: Peter Thornton +! +! +! !LOCAL VARIABLES: +!EOP + integer :: c,p,j ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + real(r8):: m ! multiplier for the exit_spinup code + logical :: readvar ! determine if variable is on initial file + character(len=128) :: varname ! temporary + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + integer , pointer :: iptemp(:) ! pointer to memory to be allocated + integer :: ier ! error status +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ! Determine necessary subgrid bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + !-------------------------------- + ! pft ecophysiological variables + !-------------------------------- + + ! dormant_flag + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='dormant_flag', xtype=ncd_double, & + dim1name='pft',long_name='dormancy flag',units='unitless' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='dormant_flag', data=pepv%dormant_flag, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! days_active + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='days_active', xtype=ncd_double, & + dim1name='pft',long_name='number of days since last dormancy',units='days' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='days_active', data=pepv%days_active, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_flag + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_flag', xtype=ncd_double, & + dim1name='pft',long_name='flag if critical growing degree-day sum is exceeded',units='unitless' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_flag', data=pepv%onset_flag, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_counter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_counter', xtype=ncd_double, & + dim1name='pft',long_name='onset days counter',units='sec' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_counter', data=pepv%onset_counter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_gddflag + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_gddflag', xtype=ncd_double, & + dim1name='pft',long_name='onset flag for growing degree day sum',units='' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_gddflag', data=pepv%onset_gddflag, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_fdd + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_fdd', xtype=ncd_double, & + dim1name='pft',long_name='onset freezing degree days counter',units='days' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_fdd', data=pepv%onset_fdd, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_gdd + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_gdd', xtype=ncd_double, & + dim1name='pft',long_name='onset growing degree days',units='days' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_gdd', data=pepv%onset_gdd, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! onset_swi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='onset_swi', xtype=ncd_double, & + dim1name='pft',long_name='onset soil water index',units='days' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='onset_swi', data=pepv%onset_swi, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! offset_flag + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='offset_flag', xtype=ncd_double, & + dim1name='pft',long_name='offset flag',units='unitless' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='offset_flag', data=pepv%offset_flag, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! offset_counter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='offset_counter', xtype=ncd_double, & + dim1name='pft',long_name='offset days counter',units='sec' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='offset_counter', data=pepv%offset_counter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! offset_fdd + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='offset_fdd', xtype=ncd_double, & + dim1name='pft',long_name='offset freezing degree days counter',units='days' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='offset_fdd', data=pepv%offset_fdd, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! offset_swi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='offset_swi', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='offset_swi', data=pepv%offset_swi, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! lgsf + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='lgsf', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='lgsf', data=pepv%lgsf, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! bglfr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='bglfr', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='bglfr', data=pepv%bglfr, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! bgtr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='bgtr', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='bgtr', data=pepv%bgtr, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! dayl + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='dayl', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='dayl', data=pepv%dayl, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prev_dayl + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prev_dayl', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prev_dayl', data=pepv%prev_dayl, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! annavg_t2m + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annavg_t2m', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annavg_t2m', data=pepv%annavg_t2m, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! tempavg_t2m + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tempavg_t2m', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tempavg_t2m', data=pepv%tempavg_t2m, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gpp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gpp_pepv', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gpp_pepv', data=pepv%gpp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! availc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='availc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='availc', data=pepv%availc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! xsmrpool_recover + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='xsmrpool_recover', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='xsmrpool_recover', data=pepv%xsmrpool_recover, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + + if (use_c13) then + ! xsmrpool_c13ratio + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='xsmrpool_c13ratio', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='xsmrpool_c13ratio', data=pepv%xsmrpool_c13ratio, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + end if + + ! alloc_pnow + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='alloc_pnow', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='alloc_pnow', data=pepv%alloc_pnow, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! c_allometry + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='c_allometry', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='c_allometry', data=pepv%c_allometry, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! n_allometry + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='n_allometry', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='n_allometry', data=pepv%n_allometry, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! plant_ndemand + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='plant_ndemand', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='plant_ndemand', data=pepv%plant_ndemand, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! tempsum_potential_gpp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tempsum_potential_gpp', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tempsum_potential_gpp', data=pepv%tempsum_potential_gpp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !annsum_potential_gpp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annsum_potential_gpp', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annsum_potential_gpp', data=pepv%annsum_potential_gpp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! tempmax_retransn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tempmax_retransn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tempmax_retransn', data=pepv%tempmax_retransn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! annmax_retransn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annmax_retransn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annmax_retransn', data=pepv%annmax_retransn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! avail_retransn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='avail_retransn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='avail_retransn', data=pepv%avail_retransn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! plant_nalloc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='plant_nalloc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='plant_nalloc', data=pepv%plant_nalloc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! plant_calloc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='plant_calloc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='plant_calloc', data=pepv%plant_calloc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! excess_cflux + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='excess_cflux', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='excess_cflux', data=pepv%excess_cflux, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! downreg + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='downreg', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='downreg', data=pepv%downreg, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prev_leafc_to_litter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prev_leafc_to_litter', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prev_leafc_to_litter', data=pepv%prev_leafc_to_litter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prev_frootc_to_litter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prev_frootc_to_litter', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prev_frootc_to_litter', data=pepv%prev_frootc_to_litter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! tempsum_npp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tempsum_npp', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tempsum_npp', data=pepv%tempsum_npp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! annsum_npp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annsum_npp', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annsum_npp', data=pepv%annsum_npp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + if (use_c13) then + ! rc13_canair + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='rc13_canair', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='rc13_canair', data=pepv%rc13_canair, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! rc13_psnsun + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='rc13_psnsun', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='rc13_psnsun', data=pepv%rc13_psnsun, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! rc13_psnsha + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='rc13_psnsha', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='rc13_psnsha', data=pepv%rc13_psnsha, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + end if + + !-------------------------------- + ! pft carbon state variables + !-------------------------------- + + ! leafc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc', data=pcs%leafc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc_storage', data=pcs%leafc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc_xfer', data=pcs%leafc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc', data=pcs%frootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc_storage', data=pcs%frootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !frootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc_xfer', data=pcs%frootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc', data=pcs%livestemc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_storage', data=pcs%livestemc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_xfer', data=pcs%livestemc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc', data=pcs%deadstemc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc_storage', data=pcs%deadstemc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc_xfer', data=pcs%deadstemc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc', data=pcs%livecrootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc_storage', data=pcs%livecrootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc_xfer', data=pcs%livecrootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc', data=pcs%deadcrootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc_storage', data=pcs%deadcrootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc_xfer', data=pcs%deadcrootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gresp_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gresp_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gresp_storage', data=pcs%gresp_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gresp_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gresp_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gresp_xfer', data=pcs%gresp_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool', data=pcs%cpool, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! xsmrpool + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='xsmrpool', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='xsmrpool', data=pcs%xsmrpool, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! pft_ctrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='pft_ctrunc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='pft_ctrunc', data=pcs%pft_ctrunc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totvegc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totvegc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totvegc', data=pcs%totvegc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + if (use_c13) then + !-------------------------------- + ! C13 pft carbon state variables + !-------------------------------- + + ! leafc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc_13', data=pc13s%leafc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc_storage_13', data=pc13s%leafc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafc_xfer_13', data=pc13s%leafc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc_13', data=pc13s%frootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc_storage_13', data=pc13s%frootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !frootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootc_xfer_13', data=pc13s%frootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_13', data=pc13s%livestemc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_storage_13', data=pc13s%livestemc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_xfer_13', data=pc13s%livestemc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc_13', data=pc13s%deadstemc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc_storage_13', data=pc13s%deadstemc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemc_xfer_13', data=pc13s%deadstemc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc_13', data=pc13s%livecrootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc_storage_13', data=pc13s%livecrootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootc_xfer_13', data=pc13s%livecrootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc_13', data=pc13s%deadcrootc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc_storage_13', data=pc13s%deadcrootc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootc_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootc_xfer_13', data=pc13s%deadcrootc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gresp_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gresp_storage_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gresp_storage_13', data=pc13s%gresp_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gresp_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gresp_xfer_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gresp_xfer_13', data=pc13s%gresp_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool_13', data=pc13s%cpool, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! xsmrpool + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='xsmrpool_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='xsmrpool_13', data=pc13s%xsmrpool, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! pft_ctrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='pft_ctrunc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='pft_ctrunc_13', data=pc13s%pft_ctrunc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totvegc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totvegc_13', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totvegc_13', data=pc13s%totvegc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + end if + + !-------------------------------- + ! pft nitrogen state variables + !-------------------------------- + + ! leafn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafn', data=pns%leafn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafn_storage', data=pns%leafn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! leafn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafn_xfer', data=pns%leafn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootn', data=pns%frootn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootn_storage', data=pns%frootn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! frootn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frootn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frootn_xfer', data=pns%frootn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemn', data=pns%livestemn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemn_storage', data=pns%livestemn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemn_xfer', data=pns%livestemn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadstemn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemn', data=pns%deadstemn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !deadstemn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemn_storage', data=pns%deadstemn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !deadstemn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadstemn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadstemn_xfer', data=pns%deadstemn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootn', data=pns%livecrootn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livecrootn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootn_storage', data=pns%livecrootn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !livecrootn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livecrootn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livecrootn_xfer', data=pns%livecrootn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootn', data=pns%deadcrootn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootn_storage', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootn_storage', data=pns%deadcrootn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! deadcrootn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='deadcrootn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='deadcrootn_xfer', data=pns%deadcrootn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !retransn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='retransn', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='retransn', data=pns%retransn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! npool + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='npool', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='npool', data=pns%npool, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! pft_ntrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='pft_ntrunc', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='pft_ntrunc', data=pns%pft_ntrunc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !-------------------------------- + ! column physical state variables + !-------------------------------- + + ! decl + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='decl', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='decl', data=cps%decl, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fpi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fpi', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fpi', data=cps%fpi, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fpg + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fpg', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fpg', data=cps%fpg, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! annsum_counter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annsum_counter', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annsum_counter', data=cps%annsum_counter, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cannsum_npp + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cannsum_npp', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cannsum_npp', data=cps%cannsum_npp, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cannavg_t2m + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cannavg_t2m', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cannavg_t2m', data=cps%cannavg_t2m, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! wf + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='wf', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='wf', data=cps%wf, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! me + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='me', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='me', data=cps%me, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fire_prob + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fire_prob', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fire_prob', data=cps%fire_prob, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! mean_fire_prob + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mean_fire_prob', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mean_fire_prob', data=cps%mean_fire_prob, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fireseasonl + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fireseasonl', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fireseasonl', data=cps%fireseasonl, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! farea_burned + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='farea_burned', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='farea_burned', data=cps%farea_burned, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! ann_farea_burned + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ann_farea_burned', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='ann_farea_burned', data=cps%ann_farea_burned, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !-------------------------------- + ! column carbon state variables + !-------------------------------- + + ! cwdc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cwdc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cwdc', data=ccs%cwdc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr1c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr1c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr1c', data=ccs%litr1c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !litr2c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr2c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr2c', data=ccs%litr2c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr3c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr3c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr3c', data=ccs%litr3c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !soil1c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil1c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil1c', data=ccs%soil1c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil2c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil2c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil2c', data=ccs%soil2c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil3c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil3c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil3c', data=ccs%soil3c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil4c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil4c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil4c', data=ccs%soil4c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! seedc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='seedc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='seedc', data=ccs%seedc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! col_ctrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='col_ctrunc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='col_ctrunc', data=ccs%col_ctrunc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totlitc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totlitc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totlitc', data=ccs%totlitc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totcolc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totcolc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totcolc', data=ccs%totcolc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod10c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod10c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod10c', data=ccs%prod10c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod100c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod100c', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod100c', data=ccs%prod100c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + if (use_c13) then + !-------------------------------- + ! C13 column carbon state variables + !-------------------------------- + + ! cwdc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cwdc_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cwdc_13', data=cc13s%cwdc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr1c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr1c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr1c_13', data=cc13s%litr1c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !litr2c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr2c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr2c_13', data=cc13s%litr2c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr3c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr3c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr3c_13', data=cc13s%litr3c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !soil1c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil1c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil1c_13', data=cc13s%soil1c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil2c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil2c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil2c_13', data=cc13s%soil2c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil3c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil3c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil3c_13', data=cc13s%soil3c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil4c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil4c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil4c_13', data=cc13s%soil4c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! seedc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='seedc_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='seedc_13', data=cc13s%seedc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! col_ctrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='col_ctrunc_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='col_ctrunc_13', data=cc13s%col_ctrunc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totlitc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totlitc_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totlitc_13', data=cc13s%totlitc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totcolc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totcolc_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totcolc_13', data=cc13s%totcolc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod10c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod10c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod10c_13', data=cc13s%prod10c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod100c + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod100c_13', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod100c_13', data=cc13s%prod100c, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + end if + + !-------------------------------- + ! column nitrogen state variables + !-------------------------------- + + ! cwdn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cwdn', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cwdn', data=cns%cwdn, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + !litr1n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr1n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr1n', data=cns%litr1n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr2n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr2n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr2n', data=cns%litr2n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! litr3n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='litr3n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='litr3n', data=cns%litr3n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil1n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil1n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil1n', data=cns%soil1n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil2n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil2n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil2n', data=cns%soil2n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil3n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil3n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil3n', data=cns%soil3n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! soil4n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='soil4n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='soil4n', data=cns%soil4n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! sminn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sminn', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sminn', data=cns%sminn, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! col_ntrunc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='col_ntrunc', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='col_ntrunc', data=cns%col_ntrunc, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! totcoln + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='totcoln', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='totcoln', data=cns%totcoln, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! seedn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='seedn', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='seedn', data=cns%seedn, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod10n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod10n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod10n', data=cns%prod10n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! prod100n + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='prod100n', xtype=ncd_double, & + dim1name='column',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='prod100n', data=cns%prod100n, & + dim1name=namec, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + if (use_exit_spinup) then + if (flag == 'read') then + m = 20._r8 + do c = begc, endc + ccs%soil1c(c) = ccs%soil1c(c) * m + ccs%soil2c(c) = ccs%soil2c(c) * m + ccs%soil3c(c) = ccs%soil3c(c) * m + ccs%soil4c(c) = ccs%soil4c(c) * m + if (use_c13) then + ! adding code for 13C, 12/25/05, PET + cc13s%soil1c(c) = cc13s%soil1c(c) * m + cc13s%soil2c(c) = cc13s%soil2c(c) * m + cc13s%soil3c(c) = cc13s%soil3c(c) * m + cc13s%soil4c(c) = cc13s%soil4c(c) * m + end if + cns%soil1n(c) = cns%soil1n(c) * m + cns%soil2n(c) = cns%soil2n(c) * m + cns%soil3n(c) = cns%soil3n(c) * m + cns%soil4n(c) = cns%soil4n(c) * m + end do + end if + end if + + if (use_cndv) then + ! pft type dgvm physical state - crownarea + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='CROWNAREA', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='CROWNAREA', data=pdgvs%crownarea, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! tempsum_litfall + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tempsum_litfall', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tempsum_litfall', data=pepv%tempsum_litfall, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! annsum_litfall + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='annsum_litfall', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='annsum_litfall', data=pepv%annsum_litfall, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! nind + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='nind', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='nind', data=pdgvs%nind, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fpcgrid + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fpcgrid', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fpcgrid', data=pdgvs%fpcgrid, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! fpcgridold + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fpcgridold', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fpcgridold', data=pdgvs%fpcgridold, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gridcell type dgvm physical state - tmomin20 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='TMOMIN20', xtype=ncd_double, & + dim1name='gridcell',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='TMOMIN20', data=gdgvs%tmomin20, & + dim1name=nameg, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gridcell type dgvm physical state - agdd20 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='AGDD20', xtype=ncd_double, & + dim1name='gridcell',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='AGDD20', data=gdgvs%agdd20, & + dim1name=nameg, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! pft type dgvm physical state - t_mo_min + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_MO_MIN', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_MO_MIN', data=pdgvs%t_mo_min, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! present + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='present', xtype=ncd_int, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + allocate (iptemp(begp:endp), stat=ier) + if (ier /= 0) then + call endrun('CNrest: allocation error ') + end if + if (flag == 'write') then + do p = begp,endp + iptemp(p) = 0 + if (pdgvs%present(p)) iptemp(p) = 1 + end do + end if + call ncd_io(varname='present', data=iptemp, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read') then + if (.not. readvar) then + if (is_restart()) call endrun + else + do p = begp,endp + pdgvs%present(p) = .false. + if (iptemp(p) == 1) pdgvs%present(p) = .true. + end do + end if + end if + deallocate (iptemp) + end if + + ! leafcmax + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='leafcmax', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='leafcmax', data=pcs%leafcmax, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! heatstress + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='heatstress', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='heatstress', data=pdgvs%heatstress, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! greffic + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='greffic', xtype=ncd_double, & + dim1name='pft',long_name='',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='greffic', data=pdgvs%greffic, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + end if + + end subroutine CNRest + +end module CNrestMod + diff --git a/components/clm/src_clm40/biogeochem/CropRestMod.F90 b/components/clm/src_clm40/biogeochem/CropRestMod.F90 new file mode 100644 index 0000000000..d9a5df20cd --- /dev/null +++ b/components/clm/src_clm40/biogeochem/CropRestMod.F90 @@ -0,0 +1,744 @@ +module CropRestMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: CropRestMod +! +! !DESCRIPTION: +! Read/Write to/from Crop info to CLM restart file. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use abortutils , only : endrun +! +! !PUBLIC TYPES: + implicit none + private + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: CropRest ! Restart prognostic crop model + public :: CropRestYear ! Get the number of years crop has spunup + public :: CropRestIncYear ! Increment the crop spinup years +! +! !REVISION HISTORY: +! Module created by slevis following CNRestMod by Peter Thornton +! + +! !PRIVATE DATA MEMBERS: + integer :: restyear = 0 ! Restart year from the initial conditions file, incremented as time elapses + +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CropRest +! +! !INTERFACE: + subroutine CropRest ( ncid, flag ) +! +! !DESCRIPTION: +! Read/write Crop restart data +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varpar , only : numrad + use decompMod , only : get_proc_bounds + use clm_time_manager, only : is_restart + use ncdio_pio +! +! !ARGUMENTS: + implicit none + type(file_desc_t) :: ncid ! netcdf id + character(len=*), intent(in) :: flag !'read' or 'write' +! +! !CALLED FROM: +! subroutine restart in module restFileMod +! +! !REVISION HISTORY: +! Author: slevis +! +!EOP +! +! !LOCAL VARIABLES: + integer :: c,p,j ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + real(r8):: m ! multiplier for the exit_spinup code + logical :: readvar ! determine if variable is on initial file + character(len=128) :: varname ! temporary + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + integer , pointer :: iptemp(:) ! pointer to memory to be allocated + integer :: ier ! error status +!----------------------------------------------------------------------- + + ! Prognostic crop restart year + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='restyear', xtype=ncd_int, & + long_name='Number of years prognostic crop ran', units="years") + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='restyear', data=restyear, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' )then + if ( readvar ) then + call checkDates( ) + else + if ( is_restart()) call endrun + end if + end if + end if + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ! Determine necessary subgrid bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + !-------------------------------- + ! pft physical state variables + !-------------------------------- + + ! peaklai + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='peaklai', xtype=ncd_int, & + dim1name='pft',long_name='Flag if at max allowed LAI or not', & + flag_values=(/0,1/), nvalid_range=(/0,1/), & + flag_meanings=(/'NOT-at-peak', 'AT_peak-LAI' /) ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='peaklai', data=pps%peaklai, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! idop + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='idop', xtype=ncd_int, & + dim1name='pft',long_name='Date of planting',units='jday', & + nvalid_range=(/1,366/) ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='idop', data=pps%idop, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! aleaf + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='aleaf', xtype=ncd_double, & + dim1name='pft',long_name='leaf allocation coefficient',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='aleaf', data=pps%aleaf, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! aleafi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='aleafi', xtype=ncd_double, & + dim1name='pft',long_name='Saved leaf allocation coefficient from phase 2', & + units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='aleafi', data=pps%aleafi, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! astem + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='astem', xtype=ncd_double, & + dim1name='pft',long_name='stem allocation coefficient',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='astem', data=pps%astem, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! astemi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='astemi', xtype=ncd_double, & + dim1name='pft',long_name='Saved stem allocation coefficient from phase 2',& + units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='astemi', data=pps%astemi, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! htmx + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='htmx', xtype=ncd_double, & + dim1name='pft',long_name='max height attained by a crop during year',& + units='m') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='htmx', data=pps%htmx, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! hdidx + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='hdidx', xtype=ncd_double, & + dim1name='pft',long_name='cold hardening index',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='hdidx', data=pps%hdidx, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! vf + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf', xtype=ncd_double, & + dim1name='pft',long_name='vernalization factor',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf', data=pps%vf, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cumvd + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cumvd', xtype=ncd_double, & + dim1name='pft',long_name='cumulative vernalization d',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cumvd', data=pps%cumvd, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! croplive + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='croplive', xtype=ncd_log, & + dim1name='pft',long_name='Flag that crop is alive, but not harvested') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='croplive', data=pps%croplive, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cropplant + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cropplant', xtype=ncd_log, & + dim1name='pft',long_name='Flag that crop is planted, but not harvested' ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cropplant', data=pps%cropplant, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! harvdate + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='harvdate', xtype=ncd_int, & + dim1name='pft',long_name='harvest date',units='jday', & + nvalid_range=(/1,366/) ) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='harvdate', data=pps%harvdate, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gdd1020 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gdd1020', xtype=ncd_double, & + dim1name='pft', & + long_name='20 year average of growing degree-days base 10C from planting', & + units='ddays') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gdd1020', data=pps%gdd1020, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gdd820 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gdd820', xtype=ncd_double, & + dim1name='pft', & + long_name='20 year average of growing degree-days base 8C from planting', & + units='ddays') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gdd820', data=pps%gdd820, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gdd020 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gdd020', xtype=ncd_double, & + dim1name='pft', & + long_name='20 year average of growing degree-days base 0C from planting', & + units='ddays') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gdd020', data=pps%gdd020, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! gddmaturity + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gddmaturity', xtype=ncd_double, & + dim1name='pft',long_name='Growing degree days needed to harvest',units='ddays') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gddmaturity', data=pps%gddmaturity, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! huileaf + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='huileaf', xtype=ncd_double, & + dim1name='pft', & + long_name='heat unit index needed from planting to leaf emergence',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='huileaf', data=pps%huileaf, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! huigrain + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='huigrain', xtype=ncd_double, & + dim1name='pft',long_name='heat unit index needed to reach vegetative maturity', & + units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='huigrain', data=pps%huigrain, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc', xtype=ncd_double, & + dim1name='pft',long_name='grain C',units='gC/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc', data=pcs%grainc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc_storage', xtype=ncd_double, & + dim1name='pft',long_name='grain C storage',units='gC/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc_storage', data=pcs%grainc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc_xfer', xtype=ncd_double, & + dim1name='pft',long_name='grain C transfer',units='gC/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc_xfer', data=pcs%grainc_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn', xtype=ncd_double, & + dim1name='pft',long_name='grain N',units='gN/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn', data=pns%grainn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn_storage', xtype=ncd_double, & + dim1name='pft',long_name='grain N storage',units='gN/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn_storage', data=pns%grainn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn_xfer', xtype=ncd_double, & + dim1name='pft',long_name='grain N transfer',units='gN/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn_xfer', data=pns%grainn_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc_xfer_to_grainc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc_xfer_to_grainc', xtype=ncd_double, & + dim1name='pft',long_name='grain C growth from storage',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc_xfer_to_grainc', data=pcf%grainc_xfer_to_grainc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemc_to_litter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemc_to_litter', xtype=ncd_double, & + dim1name='pft',long_name='live stem C litterfall',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemc_to_litter', data=pcf%livestemc_to_litter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc_to_food + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc_to_food', xtype=ncd_double, & + dim1name='pft',long_name='grain C to food',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc_to_food', data=pcf%grainc_to_food, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn_xfer_to_grainn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn_xfer_to_grainn', xtype=ncd_double, & + dim1name='pft',long_name='grain N growth from storage',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn_xfer_to_grainn', data=pnf%grainn_xfer_to_grainn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! livestemn_to_litter + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='livestemn_to_litter', xtype=ncd_double, & + dim1name='pft',long_name='livestem N to litter',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='livestemn_to_litter', data=pnf%livestemn_to_litter, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn_to_food + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn_to_food', xtype=ncd_double, & + dim1name='pft',long_name='grain N to food',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn_to_food', data=pnf%grainn_to_food, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool_to_grainc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool_to_grainc', xtype=ncd_double, & + dim1name='pft',long_name='allocation to grain C',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool_to_grainc', data=pcf%cpool_to_grainc, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool_to_grainc_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool_to_grainc_storage', xtype=ncd_double, & + dim1name='pft',long_name='allocation to grain C storage',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool_to_grainc_storage', data=pcf%cpool_to_grainc_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! npool_to_grainn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='npool_to_grainn', xtype=ncd_double, & + dim1name='pft',long_name='allocation to grain N',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='npool_to_grainn', data=pnf%npool_to_grainn, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! npool_to_grainn_storage + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='npool_to_grainn_storage', xtype=ncd_double, & + dim1name='pft',long_name='allocation to grain N storage',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='npool_to_grainn_storage', data=pnf%npool_to_grainn_storage, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool_grain_gr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool_grain_gr', xtype=ncd_double, & + dim1name='pft',long_name='grain growth respiration',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool_grain_gr', data=pcf%cpool_grain_gr, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! cpool_grain_storage_gr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cpool_grain_storage_gr', xtype=ncd_double, & + dim1name='pft',long_name='grain growth respiration to storage',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='cpool_grain_storage_gr', data=pcf%cpool_grain_storage_gr, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! transfer_grain_gr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='transfer_grain_gr', xtype=ncd_double, & + dim1name='pft',long_name='grain growth respiration from storage',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='transfer_grain_gr', data=pcf%transfer_grain_gr, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainc_storage_to_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainc_storage_to_xfer', xtype=ncd_double, & + dim1name='pft',long_name='grain C shift storage to transfer',units='gC/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainc_storage_to_xfer', data=pcf%grainc_storage_to_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + ! grainn_storage_to_xfer + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grainn_storage_to_xfer', xtype=ncd_double, & + dim1name='pft',long_name='grain N shift storage to transfer',units='gN/m2/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='grainn_storage_to_xfer', data=pnf%grainn_storage_to_xfer, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun + end if + end if + + end subroutine CropRest + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CropRestYear +! +! !INTERFACE: + integer function CropRestYear ( ) +! +! !DESCRIPTION: +! Return the restart year for prognostic crop +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +! +! !LOCAL VARIABLES: + CropRestYear = restyear + end function CropRestYear + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CropRestIncYear +! +! !INTERFACE: + subroutine CropRestIncYear () +! +! !DESCRIPTION: +! Increment the crop restart year, if appropriate +! +! This routine should be called every time step, but only once per clump (to avoid +! inadvertently updating nyrs multiple times) +! +! !USES: + use surfrdMod , only : crop_prog + use clm_time_manager , only : get_curr_date, is_first_step + implicit none +! +! !LOCAL VARIABLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) +!----------------------------------------------------------------------- + + ! Update restyear only when running with prognostic crop + if ( crop_prog )then + ! Update restyear when it's the start of a new year - but don't do that at the + ! very start of the run + call get_curr_date ( kyr, kmo, kda, mcsec) + if ((kmo == 1 .and. kda == 1 .and. mcsec == 0) .and. .not. is_first_step()) then + restyear = restyear + 1 + end if + end if + + end subroutine CropRestIncYear + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: checkDates +! +! !INTERFACE: + subroutine checkDates( ) +! +! !DESCRIPTION: +! Make sure the dates are compatible. The date given to startup the model +! and the date on the restart file must be the same although years can be +! different. The dates need to be checked when the restart file is being +! read in for a startup or branch case (they are NOT allowed to be different +! for a restart case). +! +! For the prognostic crop model the date of planting is tracked and growing +! degree days is tracked (with a 20 year mean) -- so shifting the start dates +! messes up these bits of saved information. +! +! !USES: +! +! !ARGUMENTS: + use clm_time_manager, only : get_driver_start_ymd, get_start_date + use clm_varctl , only : iulog + use clm_varctl , only : nsrest, nsrBranch, nsrStartup +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +! +! !LOCAL VARIABLES: + integer :: stymd ! Start date YYYYMMDD from driver + integer :: styr ! Start year from driver + integer :: stmon_day ! Start date MMDD from driver + integer :: rsmon_day ! Restart date MMDD from restart file + integer :: rsyr ! Restart year from restart file + integer :: rsmon ! Restart month from restart file + integer :: rsday ! Restart day from restart file + integer :: tod ! Restart time of day from restart file + character(len=*), parameter :: formDate = '(A,i4.4,"/",i2.2,"/",i2.2)' ! log output format + character(len=32) :: subname = 'CropRest::checkDates' + ! + ! If branch or startup make sure the startdate is compatible with the date + ! on the restart file. + ! + if ( nsrest == nsrBranch .or. nsrest == nsrStartup )then + stymd = get_driver_start_ymd() + styr = stymd / 10000 + stmon_day = stymd - styr*10000 + call get_start_date( rsyr, rsmon, rsday, tod ) + rsmon_day = rsmon*100 + rsday + if ( masterproc ) & + write(iulog,formDate) 'Date on the restart file is: ', rsyr, rsmon, rsday + if ( stmon_day /= rsmon_day )then + write(iulog,formDate) 'Start date is: ', styr, stmon_day/100, & + (stmon_day - stmon_day/100) + call endrun( trim(subname)// & + ' ERROR: For prognostic crop to work correctly, the start date (month and day)'// & + ' and the date on the restart file needs to match (years can be different)' ) + end if + end if + + end subroutine checkDates + +end module CropRestMod + diff --git a/components/clm/src_clm40/biogeochem/DUSTMod.F90 b/components/clm/src_clm40/biogeochem/DUSTMod.F90 new file mode 100644 index 0000000000..f41be79105 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/DUSTMod.F90 @@ -0,0 +1,900 @@ +module DUSTMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: DUSTMod +! +! !DESCRIPTION: +! Routines in this module calculate Dust mobilization and dry deposition for dust. +! Simulates dust mobilization due to wind from the surface into the +! lowest atmospheric layer. On output flx_mss_vrt_dst(ndst) is the surface dust +! emission (kg/m**2/s) [ + = to atm]. +! Calculates the turbulent component of dust dry deposition, (the turbulent deposition +! velocity through the lowest atmospheric layer). CAM will calculate the settling +! velocity through the whole atmospheric column. The two calculations will determine +! the dust dry deposition flux to the surface. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_varpar , only : dst_src_nbr, ndst, sz_nbr + use clm_varcon , only : grav, istsoil + use clm_varcon , only : istcrop, istice_mec + use clm_varctl , only : iulog + use abortutils , only : endrun + use subgridAveMod, only: p2l_1d + use clm_varcon, only: spval +! +! !PUBLIC TYPES + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Dustini ! Initialize variables used in subroutine Dust + public DustEmission ! Dust mobilization + public DustDryDep ! Turbulent dry deposition for dust +! +! !REVISION HISTORY +! Created by Sam Levis, updated to clm2.1 by Mariana Vertenstein +! Source: C. Zender's dust model +! +!EOP +! +! Data private to this module +! + private + real(r8) ovr_src_snk_mss(dst_src_nbr,ndst) + real(r8) tmp1 !Factor in saltation computation (named as in Charlie's code) + real(r8) dmt_vwr(ndst) ![m] Mass-weighted mean diameter resolved + real(r8) stk_crc(ndst) ![frc] Correction to Stokes settling velocity + real(r8) dns_aer ![kg m-3] Aerosol density +!------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: DustEmission +! +! !INTERFACE: + subroutine DustEmission (lbp, ubp, lbc,ubc,lbl,ubl,num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! Dust mobilization. This code simulates dust mobilization due to wind +! from the surface into the lowest atmospheric layer +! On output flx_mss_vrt_dst(ndst) is the surface dust emission +! (kg/m**2/s) [ + = to atm] +! Source: C. Zender's dust model +! +! !USES + use clm_atmlnd , only : clm_a2l + use shr_const_mod, only : SHR_CONST_RHOFW +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp,lbc,ubc,ubl,lbl ! pft bounds + integer, intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_nolakep(num_nolakep) ! pft filter for non-lake points +! +! !LOCAL VARIABLES +! +! local pointers to implicit in arguments +! + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: ityplun(:) ! landunit type + real(r8), pointer :: tlai(:) ! one-sided leaf area index, no burying by snow + real(r8), pointer :: tsai(:) ! one-sided stem area index, no burying by snow + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: gwc_thr(:) ! threshold gravimetric soil moisture based on clay content + real(r8), pointer :: forc_rho(:) ! density (kg/m**3) + real(r8), pointer :: fv(:) ! friction velocity (m/s) (for dust model) + real(r8), pointer :: u10(:) ! 10-m wind (m/s) (created for dust model) + real(r8), pointer :: mbl_bsn_fct(:) ! basin factor + real(r8), pointer :: mss_frc_cly_vld(:) ! [frc] Mass fraction clay limited to 0.20 + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid soil water (kg/m2) + real(r8), pointer :: h2osoi_ice(:,:) ! frozen soil water (kg/m2) + real(r8), pointer :: watsat(:,:) ! saturated volumetric soil water + +! local pointers to implicit out arguments +! + real(r8), pointer :: flx_mss_vrt_dst(:,:) ! surface dust emission (kg/m**2/s) + real(r8), pointer :: flx_mss_vrt_dst_tot(:) ! total dust flux into atmosphere + +! !REVISION HISTORY +! Created by Sam Levis +! Migrated to new data structures by Peter Thornton and Mariana Vertenstein +! !Created by Peter Thornton and Mariana Vertenstein +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: fp,p,c,l,g,m,n ! indices + real(r8) :: liqfrac ! fraction of total water that is liquid + real(r8) :: wnd_frc_rat ! [frc] Wind friction threshold over wind friction + real(r8) :: wnd_frc_slt_dlt ! [m s-1] Friction velocity increase from saltatn + real(r8) :: wnd_rfr_dlt ! [m s-1] Reference windspeed excess over threshld + real(r8) :: dst_slt_flx_rat_ttl + real(r8) :: flx_mss_hrz_slt_ttl + real(r8) :: flx_mss_vrt_dst_ttl(lbp:ubp) + real(r8) :: frc_thr_wet_fct + real(r8) :: frc_thr_rgh_fct + real(r8) :: wnd_frc_thr_slt + real(r8) :: wnd_rfr_thr_slt + real(r8) :: wnd_frc_slt + real(r8) :: lnd_frc_mbl(lbp:ubp) + real(r8) :: bd + real(r8) :: gwc_sfc + real(r8) :: ttlai(lbp:ubp) + real(r8) :: tlai_lu(lbl:ubl) +! +! constants +! + real(r8), parameter :: cst_slt = 2.61_r8 ! [frc] Saltation constant + real(r8), parameter :: flx_mss_fdg_fct = 5.0e-4_r8 ! [frc] Empir. mass flx tuning eflx_lh_vegt + real(r8), parameter :: vai_mbl_thr = 0.3_r8 ! [m2 m-2] VAI threshold quenching dust mobilization + real(r8), pointer :: wtlunit(:) ! weight of pft relative to landunit + real(r8) :: sumwt(lbl:ubl) ! sum of weights + logical :: found ! temporary for error check + integer :: index + +!------------------------------------------------------------------------ + + ! Assign local pointers to derived type scalar members (gridcell-level) + + forc_rho => clm_a2l%forc_rho + + ! Assign local pointers to derived type scalar members (landunit-level) + + ityplun => lun%itype + + ! Assign local pointers to derived type scalar members (column-level) + + frac_sno => cps%frac_sno + gwc_thr => cps%gwc_thr + mbl_bsn_fct => cps%mbl_bsn_fct + mss_frc_cly_vld => cps%mss_frc_cly_vld + h2osoi_vol => cws%h2osoi_vol + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + watsat => cps%watsat + + ! Assign local pointers to derived type scalar members (pft-level) + + pgridcell => pft%gridcell + plandunit => pft%landunit + pcolumn => pft%column + tlai => pps%tlai + tsai => pps%tsai + fv => pps%fv + u10 => pps%u10 + flx_mss_vrt_dst => pdf%flx_mss_vrt_dst + flx_mss_vrt_dst_tot => pdf%flx_mss_vrt_dst_tot + !local pointers from subgridAveMod/p2l_1d + wtlunit => pft%wtlunit + + ttlai(:) = 0._r8 +! make lai average at landunit level + do fp = 1,num_nolakep + p = filter_nolakep(fp) + ttlai(p) = tlai(p)+tsai(p) + enddo + + tlai_lu(:) = spval + sumwt(:) = 0._r8 + do p = lbp,ubp + if (ttlai(p) /= spval .and. wtlunit(p) /= 0._r8) then + c = pcolumn(p) + l = plandunit(p) + if (sumwt(l) == 0._r8) tlai_lu(l) = 0._r8 + tlai_lu(l) = tlai_lu(l) + ttlai(p) * wtlunit(p) + sumwt(l) = sumwt(l) + wtlunit(p) + end if + end do + found = .false. + do l = lbl,ubl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + exit + else if (sumwt(l) /= 0._r8) then + tlai_lu(l) = tlai_lu(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*) 'p2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun() + end if + +! Loop through pfts + +! initialize variables which get passed to the atmosphere + flx_mss_vrt_dst(lbp:ubp,:)=0._r8 + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + l = plandunit(p) + + ! the following code from subr. lnd_frc_mbl_get was adapted for lsm use + ! purpose: return fraction of each gridcell suitable for dust mobilization + + ! the "bare ground" fraction of the current sub-gridscale cell decreases + ! linearly from 1 to 0 as VAI(=tlai+tsai) increases from 0 to vai_mbl_thr + ! if ice sheet, wetland, or lake, no dust allowed + + if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then + if (tlai_lu(l) < vai_mbl_thr) then + lnd_frc_mbl(p) = 1.0_r8 - (tlai_lu(l))/vai_mbl_thr + else + lnd_frc_mbl(p) = 0.0_r8 + endif + lnd_frc_mbl(p) = lnd_frc_mbl(p) * (1.0_r8 - frac_sno(c)) + else + lnd_frc_mbl(p) = 0.0_r8 + end if + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p)>1.0_r8 .or. lnd_frc_mbl(p)<0.0_r8) then + write(iulog,*)'Error dstmbl: pft= ',p,' lnd_frc_mbl(p)= ',lnd_frc_mbl(p) + call endrun + end if + end do + + ! reset history output variables before next if-statement to avoid output = inf + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + flx_mss_vrt_dst_tot(p) = 0.0_r8 + end do + do n = 1, ndst + do fp = 1,num_nolakep + p = filter_nolakep(fp) + flx_mss_vrt_dst(p,n) = 0.0_r8 + end do + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + l = plandunit(p) + g = pgridcell(p) + + ! only perform the following calculations if lnd_frc_mbl is non-zero + + if (lnd_frc_mbl(p) > 0.0_r8) then + + ! the following comes from subr. frc_thr_rgh_fct_get + ! purpose: compute factor by which surface roughness increases threshold + ! friction velocity (currently a constant) + + frc_thr_rgh_fct = 1.0_r8 + + ! the following comes from subr. frc_thr_wet_fct_get + ! purpose: compute factor by which soil moisture increases threshold friction velocity + ! adjust threshold velocity for inhibition by moisture + ! modified 4/5/2002 (slevis) to use gravimetric instead of volumetric + ! water content + + bd = (1._r8-watsat(c,1))*2.7e3_r8 ![kg m-3] Bulk density of dry surface soil + gwc_sfc = h2osoi_vol(c,1)*SHR_CONST_RHOFW/bd ![kg kg-1] Gravimetric H2O cont + if (gwc_sfc > gwc_thr(c)) then + frc_thr_wet_fct = sqrt(1.0_r8 + 1.21_r8 * (100.0_r8*(gwc_sfc - gwc_thr(c)))**0.68_r8) + else + frc_thr_wet_fct = 1.0_r8 + end if + + ! slevis: adding liqfrac here, because related to effects from soil water + + liqfrac = max( 0.0_r8, min( 1.0_r8, h2osoi_liq(c,1) / (h2osoi_ice(c,1)+h2osoi_liq(c,1)+1.0e-6_r8) ) ) + + ! the following lines come from subr. dst_mbl + ! purpose: adjust threshold friction velocity to acct for moisture and + ! roughness. The ratio tmp1 / sqrt(forc_rho) comes from + ! subr. wnd_frc_thr_slt_get which computes dry threshold + ! friction velocity for saltation + + wnd_frc_thr_slt = tmp1 / sqrt(forc_rho(g)) * frc_thr_wet_fct * frc_thr_rgh_fct + + ! reset these variables which will be updated in the following if-block + + wnd_frc_slt = fv(p) + flx_mss_hrz_slt_ttl = 0.0_r8 + flx_mss_vrt_dst_ttl(p) = 0.0_r8 + + ! the following line comes from subr. dst_mbl + ! purpose: threshold saltation wind speed + + wnd_rfr_thr_slt = u10(p) * wnd_frc_thr_slt / fv(p) + + ! the following if-block comes from subr. wnd_frc_slt_get + ! purpose: compute the saltating friction velocity + ! theory: saltation roughens the boundary layer, AKA "Owen's effect" + + if (u10(p) >= wnd_rfr_thr_slt) then + wnd_rfr_dlt = u10(p) - wnd_rfr_thr_slt + wnd_frc_slt_dlt = 0.003_r8 * wnd_rfr_dlt * wnd_rfr_dlt + wnd_frc_slt = fv(p) + wnd_frc_slt_dlt + end if + + ! the following comes from subr. flx_mss_hrz_slt_ttl_Whi79_get + ! purpose: compute vertically integrated streamwise mass flux of particles + + if (wnd_frc_slt > wnd_frc_thr_slt) then + wnd_frc_rat = wnd_frc_thr_slt / wnd_frc_slt + flx_mss_hrz_slt_ttl = cst_slt * forc_rho(g) * (wnd_frc_slt**3.0_r8) * & + (1.0_r8 - wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) * (1.0_r8 + wnd_frc_rat) / grav + + ! the following loop originates from subr. dst_mbl + ! purpose: apply land sfc and veg limitations and global tuning factor + ! slevis: multiply flx_mss_hrz_slt_ttl by liqfrac to incude the effect + ! of frozen soil + + flx_mss_hrz_slt_ttl = flx_mss_hrz_slt_ttl * lnd_frc_mbl(p) * mbl_bsn_fct(c) * & + flx_mss_fdg_fct * liqfrac + end if + + ! the following comes from subr. flx_mss_vrt_dst_ttl_MaB95_get + ! purpose: diagnose total vertical mass flux of dust from vertically + ! integrated streamwise mass flux + + dst_slt_flx_rat_ttl = 100.0_r8 * exp( log(10.0_r8) * (13.4_r8 * mss_frc_cly_vld(c) - 6.0_r8) ) + flx_mss_vrt_dst_ttl(p) = flx_mss_hrz_slt_ttl * dst_slt_flx_rat_ttl + + end if ! lnd_frc_mbl > 0.0 + + end do + + ! the following comes from subr. flx_mss_vrt_dst_prt in C. Zender's code + ! purpose: partition total vertical mass flux of dust into transport bins + + do n = 1, ndst + do m = 1, dst_src_nbr + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p) > 0.0_r8) then + flx_mss_vrt_dst(p,n) = flx_mss_vrt_dst(p,n) + ovr_src_snk_mss(m,n) * flx_mss_vrt_dst_ttl(p) + end if + end do + end do + end do + + do n = 1, ndst + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (lnd_frc_mbl(p) > 0.0_r8) then + flx_mss_vrt_dst_tot(p) = flx_mss_vrt_dst_tot(p) + flx_mss_vrt_dst(p,n) + end if + end do + end do + + end subroutine DustEmission + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine DustDryDep +! +! !INTERFACE: +! + subroutine DustDryDep (lbp, ubp) +! +! !DESCRIPTION: +! +! Determine Turbulent dry deposition for dust. Calculate the turbulent +! component of dust dry deposition, (the turbulent deposition velocity +! through the lowest atmospheric layer. CAM will calculate the settling +! velocity through the whole atmospheric column. The two calculations +! will determine the dust dry deposition flux to the surface. +! Note: Same process should occur over oceans. For the coupled CESM, +! we may find it more efficient to let CAM calculate the turbulent dep +! velocity over all surfaces. This would require passing the +! aerodynamic resistance, ram(1), and the friction velocity, fv, from +! the land to the atmosphere component. In that case, dustini need not +! calculate particle diamter (dmt_vwr) and particle density (dns_aer). +! Source: C. Zender's dry deposition code +! +! !USES +! + use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RDAIR, SHR_CONST_BOLTZ + use clm_atmlnd , only : clm_a2l +! +! !ARGUMENTS: +! + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds +! +! !LOCAL VARIABLES +! +! local pointers to implicit in arguments +! + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: ityplun(:) ! landunit type + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: forc_t(:) ! atm temperature (K) + real(r8), pointer :: forc_pbot(:) ! atm pressure (Pa) + real(r8), pointer :: forc_rho(:) ! atm density (kg/m**3) + real(r8), pointer :: fv(:) ! friction velocity (m/s) + real(r8), pointer :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: vlc_trb(:,:) ! Turbulent deposn velocity (m/s) + real(r8), pointer :: vlc_trb_1(:) ! Turbulent deposition velocity 1 + real(r8), pointer :: vlc_trb_2(:) ! Turbulent deposition velocity 2 + real(r8), pointer :: vlc_trb_3(:) ! Turbulent deposition velocity 3 + real(r8), pointer :: vlc_trb_4(:) ! Turbulent deposition velocity 4 +! +! !REVISION HISTORY +! Created by Sam Levis +! +! +! !LOCAL VARIABLES +!EOP +! + integer :: p,l,g,m,n ! indices + real(r8) :: vsc_dyn_atm(lbp:ubp) ! [kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm(lbp:ubp) ! [m2 s-1] Kinematic viscosity of atmosphere + real(r8) :: shm_nbr_xpn ! [frc] Sfc-dep exponent for aerosol-diffusion dependence on Schmidt number + real(r8) :: shm_nbr ! [frc] Schmidt number + real(r8) :: stk_nbr ! [frc] Stokes number + real(r8) :: mfp_atm ! [m] Mean free path of air + real(r8) :: dff_aer ! [m2 s-1] Brownian diffusivity of particle + real(r8) :: rss_trb ! [s m-1] Resistance to turbulent deposition + real(r8) :: slp_crc(lbp:ubp,ndst) ! [frc] Slip correction factor + real(r8) :: vlc_grv(lbp:ubp,ndst) ! [m s-1] Settling velocity + real(r8) :: rss_lmn(lbp:ubp,ndst) ! [s m-1] Quasi-laminar layer resistance + real(r8) :: tmp ! temporary + +! constants + + real(r8),parameter::shm_nbr_xpn_lnd=-2._r8/3._r8 ![frc] shm_nbr_xpn over land +!------------------------------------------------------------------------ + + ! Assign local pointers to derived type members (gridcell-level) + + forc_pbot => clm_a2l%forc_pbot + forc_rho => clm_a2l%forc_rho + forc_t => clm_a2l%forc_t + + ! Assign local pointers to derived type members (landunit-level) + + ityplun => lun%itype + + ! Assign local pointers to derived type members (pft-level) + + plandunit => pft%landunit + pgridcell => pft%gridcell + pwtgcell => pft%wtgcell + fv => pps%fv + ram1 => pps%ram1 + vlc_trb => pdf%vlc_trb + vlc_trb_1 => pdf%vlc_trb_1 + vlc_trb_2 => pdf%vlc_trb_2 + vlc_trb_3 => pdf%vlc_trb_3 + vlc_trb_4 => pdf%vlc_trb_4 + + do p = lbp,ubp + l = plandunit(p) + ! Note: some glacier_mec pfts may have zero weight + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + g = pgridcell(p) + + ! from subroutine dst_dps_dry (consider adding sanity checks from line 212) + ! when code asks to use midlayer density, pressure, temperature, + ! I use the data coming in from the atmosphere, ie forc_t, forc_pbot, forc_rho + + ! Quasi-laminar layer resistance: call rss_lmn_get + ! Size-independent thermokinetic properties + + vsc_dyn_atm(p) = 1.72e-5_r8 * ((forc_t(g)/273.0_r8)**1.5_r8) * 393.0_r8 / & + (forc_t(g)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102 + mfp_atm = 2.0_r8 * vsc_dyn_atm(p) / & ![m] SeP97 p. 455 + (forc_pbot(g)*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*forc_t(g)))) + vsc_knm_atm(p) = vsc_dyn_atm(p) / forc_rho(g) ![m2 s-1] Kinematic viscosity of air + + do m = 1, ndst + slp_crc(p,m) = 1.0_r8 + 2.0_r8 * mfp_atm * & + (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / & + dmt_vwr(m) ![frc] Slip correction factor SeP97 p. 464 + vlc_grv(p,m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * & + grav * slp_crc(p,m) / vsc_dyn_atm(p) ![m s-1] Stokes' settling velocity SeP97 p. 466 + vlc_grv(p,m) = vlc_grv(p,m) * stk_crc(m) ![m s-1] Correction to Stokes settling velocity + end do + end if + end do + + do m = 1, ndst + do p = lbp,ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + g = pgridcell(p) + + stk_nbr = vlc_grv(p,m) * fv(p) * fv(p) / (grav * vsc_knm_atm(p)) ![frc] SeP97 p.965 + dff_aer = SHR_CONST_BOLTZ * forc_t(g) * slp_crc(p,m) / & ![m2 s-1] + (3.0_r8*SHR_CONST_PI * vsc_dyn_atm(p) * dmt_vwr(m)) !SeP97 p.474 + shm_nbr = vsc_knm_atm(p) / dff_aer ![frc] SeP97 p.972 + shm_nbr_xpn = shm_nbr_xpn_lnd ![frc] + + ! fxm: Turning this on dramatically reduces + ! deposition velocity in low wind regimes + ! Schmidt number exponent is -2/3 over solid surfaces and + ! -1/2 over liquid surfaces SlS80 p. 1014 + ! if (oro(i)==0.0) shm_nbr_xpn=shm_nbr_xpn_ocn else shm_nbr_xpn=shm_nbr_xpn_lnd + ! [frc] Surface-dependent exponent for aerosol-diffusion dependence on Schmidt # + + tmp = shm_nbr**shm_nbr_xpn + 10.0_r8**(-3.0_r8/stk_nbr) + rss_lmn(p,m) = 1.0_r8 / (tmp * fv(p)) ![s m-1] SeP97 p.972,965 + end if + end do + end do + + ! Lowest layer: Turbulent deposition (CAM will calc. gravitational dep) + + do m = 1, ndst + do p = lbp,ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + rss_trb = ram1(p) + rss_lmn(p,m) + ram1(p) * rss_lmn(p,m) * vlc_grv(p,m) ![s m-1] + vlc_trb(p,m) = 1.0_r8 / rss_trb ![m s-1] + end if + end do + end do + + do p = lbp,ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + vlc_trb_1(p) = vlc_trb(p,1) + vlc_trb_2(p) = vlc_trb(p,2) + vlc_trb_3(p) = vlc_trb(p,3) + vlc_trb_4(p) = vlc_trb(p,4) + end if + end do + + end subroutine DustDryDep + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subroutine Dustini +! +! !INTERFACE: +! + subroutine Dustini() +! +! !DESCRIPTION: +! +! Compute source efficiency factor from topography +! Initialize other variables used in subroutine Dust: +! ovr_src_snk_mss(m,n) and tmp1. +! Define particle diameter and density needed by atm model +! as well as by dry dep model +! Source: Paul Ginoux (for source efficiency factor) +! Modifications by C. Zender and later by S. Levis +! Rest of subroutine from C. Zender's dust model +! +! !USES + use shr_const_mod, only: SHR_CONST_PI, SHR_CONST_RDAIR + use decompMod, only : get_proc_bounds + use shr_spfn_mod, only: erf => shr_spfn_erf +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY +! Created by Samual Levis +! +! !LOCAL VARIABLES +! +! local pointers to implicit in arguments +! + real(r8), pointer :: mbl_bsn_fct(:) !basin factor +! +! +! !LOCAL VARIABLES +!EOP +! + integer :: fc,c,l,m,n ! indices + real(r8) :: ovr_src_snk_frc + real(r8) :: sqrt2lngsdi ! [frc] Factor in erf argument + real(r8) :: lndmaxjovrdmdni ! [frc] Factor in erf argument + real(r8) :: lndminjovrdmdni ! [frc] Factor in erf argument + real(r8) :: ryn_nbr_frc_thr_prx_opt ! [frc] Threshold friction Reynolds number approximation for optimal size + real(r8) :: ryn_nbr_frc_thr_opt_fnc ! [frc] Threshold friction Reynolds factor for saltation calculation + real(r8) :: icf_fct ! Interpartical cohesive forces factor for saltation calc + real(r8) :: dns_fct ! Density ratio factor for saltation calculation + real(r8) :: dmt_min(ndst) ! [m] Size grid minimum + real(r8) :: dmt_max(ndst) ! [m] Size grid maximum + real(r8) :: dmt_ctr(ndst) ! [m] Diameter at bin center + real(r8) :: dmt_dlt(ndst) ! [m] Width of size bin + real(r8) :: slp_crc(ndst) ! [frc] Slip correction factor + real(r8) :: vlm_rsl(ndst) ! [m3 m-3] Volume concentration resolved + real(r8) :: vlc_stk(ndst) ! [m s-1] Stokes settling velocity + real(r8) :: vlc_grv(ndst) ! [m s-1] Settling velocity + real(r8) :: ryn_nbr_grv(ndst) ! [frc] Reynolds number at terminal velocity + real(r8) :: cff_drg_grv(ndst) ! [frc] Drag coefficient at terminal velocity + real(r8) :: tmp ! temporary + real(r8) :: ln_gsd ! [frc] ln(gsd) + real(r8) :: gsd_anl ! [frc] Geometric standard deviation + real(r8) :: dmt_vma ! [m] Mass median diameter analytic She84 p.75 Tabl.1 + real(r8) :: dmt_nma ! [m] Number median particle diameter + real(r8) :: lgn_dst ! Lognormal distribution at sz_ctr + real(r8) :: eps_max ! [frc] Relative accuracy for convergence + real(r8) :: eps_crr ! [frc] Current relative accuracy + real(r8) :: itr_idx ! [idx] Counting index + real(r8) :: dns_mdp ! [kg m-3] Midlayer density + real(r8) :: mfp_atm ! [m] Mean free path of air + real(r8) :: vsc_dyn_atm ! [kg m-1 s-1] Dynamic viscosity of air + real(r8) :: vsc_knm_atm ! [kg m-1 s-1] Kinematic viscosity of air + real(r8) :: vlc_grv_old ! [m s-1] Previous gravitational settling velocity + real(r8) :: series_ratio ! Factor for logarithmic grid + real(r8) :: lngsdsqrttwopi_rcp ! Factor in lognormal distribution + real(r8) :: sz_min(sz_nbr) ! [m] Size Bin minima + real(r8) :: sz_max(sz_nbr) ! [m] Size Bin maxima + real(r8) :: sz_ctr(sz_nbr) ! [m] Size Bin centers + real(r8) :: sz_dlt(sz_nbr) ! [m] Size Bin widths + + ! constants + real(r8) :: dmt_vma_src(dst_src_nbr) = & ! [m] Mass median diameter + (/ 0.832e-6_r8 , 4.82e-6_r8 , 19.38e-6_r8 /) ! BSM96 p. 73 Table 2 + real(r8) :: gsd_anl_src(dst_src_nbr) = & ! [frc] Geometric std deviation + (/ 2.10_r8 , 1.90_r8 , 1.60_r8 /) ! BSM96 p. 73 Table 2 + real(r8) :: mss_frc_src(dst_src_nbr) = & ! [frc] Mass fraction + (/ 0.036_r8, 0.957_r8, 0.007_r8 /) ! BSM96 p. 73 Table 2 + real(r8) :: dmt_grd(5) = & ! [m] Particle diameter grid + (/ 0.1e-6_r8, 1.0e-6_r8, 2.5e-6_r8, 5.0e-6_r8, 10.0e-6_r8 /) + real(r8), parameter :: dmt_slt_opt = 75.0e-6_r8 ! [m] Optim diam for saltation + real(r8), parameter :: dns_slt = 2650.0_r8 ! [kg m-3] Density of optimal saltation particles + + ! declare erf intrinsic function + real(r8) :: dum ! dummy variable for erf test + + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices +!------------------------------------------------------------------------ + + ! Assign local pointers to derived type scalar members (column-level) + + mbl_bsn_fct => cps%mbl_bsn_fct + + ! the following comes from (1) szdstlgn.F subroutine ovr_src_snk_frc_get + ! and (2) dstszdst.F subroutine dst_szdst_ini + ! purpose(1): given one set (the "source") of lognormal distributions, + ! and one set of bin boundaries (the "sink"), compute and return + ! the overlap factors between the source and sink distributions + ! purpose(2): set important statistics of size distributions + + do m = 1, dst_src_nbr + sqrt2lngsdi = sqrt(2.0_r8) * log(gsd_anl_src(m)) + do n = 1, ndst + lndmaxjovrdmdni = log(dmt_grd(n+1)/dmt_vma_src(m)) + lndminjovrdmdni = log(dmt_grd(n )/dmt_vma_src(m)) + ovr_src_snk_frc = 0.5_r8 * (erf(lndmaxjovrdmdni/sqrt2lngsdi) - & + erf(lndminjovrdmdni/sqrt2lngsdi)) + ovr_src_snk_mss(m,n) = ovr_src_snk_frc * mss_frc_src(m) + end do + end do + + ! The following code from subroutine wnd_frc_thr_slt_get was placed + ! here because tmp1 needs to be defined just once + + ryn_nbr_frc_thr_prx_opt = 0.38_r8 + 1331.0_r8 * (100.0_r8*dmt_slt_opt)**1.56_r8 + + if (ryn_nbr_frc_thr_prx_opt < 0.03_r8) then + write(iulog,*) 'dstmbl: ryn_nbr_frc_thr_prx_opt < 0.03' + call endrun + else if (ryn_nbr_frc_thr_prx_opt < 10.0_r8) then + ryn_nbr_frc_thr_opt_fnc = -1.0_r8 + 1.928_r8 * (ryn_nbr_frc_thr_prx_opt**0.0922_r8) + ryn_nbr_frc_thr_opt_fnc = 0.1291_r8 * 0.1291_r8 / ryn_nbr_frc_thr_opt_fnc + else + ryn_nbr_frc_thr_opt_fnc = 1.0_r8 - 0.0858_r8 * exp(-0.0617_r8*(ryn_nbr_frc_thr_prx_opt-10.0_r8)) + ryn_nbr_frc_thr_opt_fnc = 0.120_r8 * 0.120_r8 * ryn_nbr_frc_thr_opt_fnc * ryn_nbr_frc_thr_opt_fnc + end if + + icf_fct = 1.0_r8 + 6.0e-07_r8 / (dns_slt * grav * (dmt_slt_opt**2.5_r8)) + dns_fct = dns_slt * grav * dmt_slt_opt + tmp1 = sqrt(icf_fct * dns_fct * ryn_nbr_frc_thr_opt_fnc) + + ! Set basin factor to 1 for now + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + do c = begc, endc + l = col%landunit(c) + if (.not. lun%lakpoi(l)) then + mbl_bsn_fct(c) = 1.0_r8 + end if + end do + + ! Introducing particle diameter. Needed by atm model and by dry dep model. + ! Taken from Charlie Zender's subroutines dst_psd_ini, dst_sz_rsl, + ! grd_mk (dstpsd.F90) and subroutine lgn_evl (psdlgn.F90) + + ! Charlie allows logarithmic or linear option for size distribution + ! however, he hardwires the distribution to logarithmic in his code + ! therefore, I take his logarithmic code only + ! furthermore, if dst_nbr == 4, he overrides the automatic grid calculation + ! he currently works with dst_nbr = 4, so I only take the relevant code + ! if ndst ever becomes different from 4, must add call grd_mk (dstpsd.F90) + ! as done in subroutine dst_psd_ini + ! note that here ndst = dst_nbr + + ! Override automatic grid with preset grid if available + + if (ndst == 4) then + do n = 1, ndst + dmt_min(n) = dmt_grd(n) ![m] Max diameter in bin + dmt_max(n) = dmt_grd(n+1) ![m] Min diameter in bin + dmt_ctr(n) = 0.5_r8 * (dmt_min(n)+dmt_max(n)) ![m] Diameter at bin ctr + dmt_dlt(n) = dmt_max(n)-dmt_min(n) ![m] Width of size bin + end do + else + write(iulog,*) 'Dustini error: ndst must equal to 4 with current code' + call endrun !see more comments above + end if !end if ndst == 4 + + ! Bin physical properties + + gsd_anl = 2.0_r8 ! [frc] Geometric std dev PaG77 p. 2080 Table1 + ln_gsd = log(gsd_anl) + dns_aer = 2.5e+3_r8 ! [kg m-3] Aerosol density + + ! Set a fundamental statistic for each bin + + dmt_vma = 3.5000e-6_r8 ! [m] Mass median diameter analytic She84 p.75 Table1 + + ! Compute analytic size statistics + ! Convert mass median diameter to number median diameter (call vma2nma) + + dmt_nma = dmt_vma * exp(-3.0_r8*ln_gsd*ln_gsd) ! [m] + + ! Compute resolved size statistics for each size distribution + ! In C. Zender's code call dst_sz_rsl + + do n = 1, ndst + + series_ratio = (dmt_max(n)/dmt_min(n))**(1.0_r8/sz_nbr) + sz_min(1) = dmt_min(n) + do m = 2, sz_nbr ! Loop starts at 2 + sz_min(m) = sz_min(m-1) * series_ratio + end do + + ! Derived grid values + do m = 1, sz_nbr-1 ! Loop ends at sz_nbr-1 + sz_max(m) = sz_min(m+1) ! [m] + end do + sz_max(sz_nbr) = dmt_max(n) ! [m] + + ! Final derived grid values + do m = 1, sz_nbr + sz_ctr(m) = 0.5_r8 * (sz_min(m)+sz_max(m)) + sz_dlt(m) = sz_max(m)-sz_min(m) + end do + + lngsdsqrttwopi_rcp = 1.0_r8 / (ln_gsd*sqrt(2.0_r8*SHR_CONST_PI)) + dmt_vwr(n) = 0.0_r8 ! [m] Mass wgted diameter resolved + vlm_rsl(n) = 0.0_r8 ! [m3 m-3] Volume concentration resolved + + do m = 1, sz_nbr + + ! Evaluate lognormal distribution for these sizes (call lgn_evl) + tmp = log(sz_ctr(m)/dmt_nma) / ln_gsd + lgn_dst = lngsdsqrttwopi_rcp * exp(-0.5_r8*tmp*tmp) / sz_ctr(m) + + ! Integrate moments of size distribution + dmt_vwr(n) = dmt_vwr(n) + sz_ctr(m) * & + SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + vlm_rsl(n) = vlm_rsl(n) + & + SHR_CONST_PI / 6.0_r8 * (sz_ctr(m)**3.0_r8) * & ![m3] Volume + lgn_dst * sz_dlt(m) ![# m-3] Number concentrn + + end do + + dmt_vwr(n) = dmt_vwr(n) / vlm_rsl(n) ![m] Mass weighted diameter resolved + + end do + + ! calculate correction to Stokes' settling velocity (subroutine stk_crc_get) + + eps_max = 1.0e-4_r8 + dns_mdp = 100000._r8 / (295.0_r8*SHR_CONST_RDAIR) ![kg m-3] const prs_mdp & tpt_vrt + + ! Size-independent thermokinetic properties + + vsc_dyn_atm = 1.72e-5_r8 * ((295.0_r8/273.0_r8)**1.5_r8) * 393.0_r8 / & + (295.0_r8+120.0_r8) ![kg m-1 s-1] RoY94 p.102 tpt_mdp=295.0 + mfp_atm = 2.0_r8 * vsc_dyn_atm / & !SeP97 p. 455 constant prs_mdp, tpt_mdp + (100000._r8*sqrt(8.0_r8/(SHR_CONST_PI*SHR_CONST_RDAIR*295.0_r8))) + vsc_knm_atm = vsc_dyn_atm / dns_mdp ![m2 s-1] Kinematic viscosity of air + + do m = 1, ndst + slp_crc(m) = 1.0_r8 + 2.0_r8 * mfp_atm * & + (1.257_r8+0.4_r8*exp(-1.1_r8*dmt_vwr(m)/(2.0_r8*mfp_atm))) / & + dmt_vwr(m) ! [frc] Slip correction factor SeP97 p.464 + vlc_stk(m) = (1.0_r8/18.0_r8) * dmt_vwr(m) * dmt_vwr(m) * dns_aer * & + grav * slp_crc(m) / vsc_dyn_atm ! [m s-1] SeP97 p.466 + end do + + ! For Reynolds number flows Re < 0.1 Stokes' velocity is valid for + ! vlc_grv SeP97 p. 466 (8.42). For larger Re, inertial effects become + ! important and empirical drag coefficients must be employed + ! Implicit equation for Re, Cd, and Vt is SeP97 p. 467 (8.44) + ! Using Stokes' velocity rather than iterative solution with empirical + ! drag coefficient causes 60% errors for D = 200 um SeP97 p. 468 + + ! Iterative solution for drag coefficient, Reynolds number, and terminal veloc + do m = 1, ndst + + ! Initialize accuracy and counter + eps_crr = eps_max + 1.0_r8 ![frc] Current relative accuracy + itr_idx = 0 ![idx] Counting index + + ! Initial guess for vlc_grv is exact for Re < 0.1 + vlc_grv(m) = vlc_stk(m) ![m s-1] + + do while(eps_crr > eps_max) + + ! Save terminal velocity for convergence test + vlc_grv_old = vlc_grv(m) ![m s-1] + ryn_nbr_grv(m) = vlc_grv(m) * dmt_vwr(m) / vsc_knm_atm !SeP97 p.460 + + ! Update drag coefficient based on new Reynolds number + if (ryn_nbr_grv(m) < 0.1_r8) then + cff_drg_grv(m) = 24.0_r8 / ryn_nbr_grv(m) !Stokes' law Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 3.0_r8*ryn_nbr_grv(m)/16.0_r8 + & + 9.0_r8*ryn_nbr_grv(m)*ryn_nbr_grv(m)* & + log(2.0_r8*ryn_nbr_grv(m))/160.0_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 500.0_r8) then + cff_drg_grv(m) = (24.0_r8/ryn_nbr_grv(m)) * & + (1.0_r8 + 0.15_r8*ryn_nbr_grv(m)**0.687_r8) !Sep97 p.463 (8.32) + else if (ryn_nbr_grv(m) < 2.0e5_r8) then + cff_drg_grv(m) = 0.44_r8 !Sep97 p.463 (8.32) + else + write(iulog,'(a,es9.2)') "ryn_nbr_grv(m) = ",ryn_nbr_grv(m) + write(iulog,*)'Dustini error: Reynolds number too large in stk_crc_get()' + call endrun + end if + + ! Update terminal velocity based on new Reynolds number and drag coeff + ! [m s-1] Terminal veloc SeP97 p.467 (8.44) + + vlc_grv(m) = sqrt(4.0_r8 * grav * dmt_vwr(m) * slp_crc(m) * dns_aer / & + (3.0_r8*cff_drg_grv(m)*dns_mdp)) + eps_crr = abs((vlc_grv(m)-vlc_grv_old)/vlc_grv(m)) !Relative convergence + if (itr_idx == 12) then + ! Numerical pingpong may occur when Re = 0.1, 2.0, or 500.0 + ! due to discontinuities in derivative of drag coefficient + vlc_grv(m) = 0.5_r8 * (vlc_grv(m)+vlc_grv_old) ! [m s-1] + end if + if (itr_idx > 20) then + write(iulog,*) 'Dustini error: Terminal velocity not converging ',& + ' in stk_crc_get(), breaking loop...' + goto 100 !to next iteration + end if + itr_idx = itr_idx + 1 + + end do !end while + +100 continue !Label to jump to when iteration does not converge + end do !end loop over size + + ! Compute factors to convert Stokes' settling velocities to + ! actual settling velocities + + do m = 1, ndst + stk_crc(m) = vlc_grv(m) / vlc_stk(m) + end do + + end subroutine Dustini + +end module DUSTMod diff --git a/components/clm/src_clm40/biogeochem/DryDepVelocity.F90 b/components/clm/src_clm40/biogeochem/DryDepVelocity.F90 new file mode 100644 index 0000000000..deb64f3dc1 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/DryDepVelocity.F90 @@ -0,0 +1,608 @@ +Module DryDepVelocity + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Deposition velocity (m/s) + ! + ! Method: + ! This code simulates dry deposition velocities using the Wesely scheme. + ! Details of this method can be found in: + ! + ! M.L Wesely. Parameterization of surface resistances to gaseous dry deposition + ! in regional-scale numericl models. 1989. Atmospheric Environment vol.23 No.6 + ! pp. 1293-1304. + ! + ! In Wesely (1998) "the magnitude of the dry deposition velocity can be found + ! as: + ! + ! |vd|=(ra+rb+rc)^-1 + ! + ! where ra is the aerodynamic resistance (common to all gases) between a + ! specific height and the surface, rb is the quasilaminar sublayer resistance + ! (whose only dependence on the porperties of the gas of interest is its + ! molecular diffusivity in air), and rc is the bulk surface resistance". + ! + ! In this subroutine both ra and rb are calculated elsewhere in CLM. Thus ra + ! and rb were "globalized" in order to gain access to them for the calculation. + ! "ram1" is the CLM variable used for ra. ram1 was globalized in the following + ! subroutines; BareGroundFluxes.F90, Biogeophysics_lake.F90, CanopyFluxes.F90, + ! and clmtype.F90. + ! + ! "rb" is the CLM variable used for rb in the Wesely equation above. rb was + ! globalized in the following subroutines; clmtype.F90 + ! + ! In Wesely (1989) rc is estimated for five seasonal categories and 11 landuse + ! types. For each season and landuse type, Wesely compiled data into a + ! look-up-table for several parameters used to calculate rc. In this subroutine + ! the same values are used as found in wesely's look-up-tables, the only + ! difference is that this subroutine uses a CLM generated LAI to select values + ! from the look-up-table instead of seasonality. Inaddition, Wesely(1989) + ! land use types are "mapped" into CLM plant function types (PFT). + ! + ! Subroutine written to operate at the patch level. + ! + ! Output: + ! + ! vd(n_species) !Dry deposition velocity [m s-1] for each molecule or species + ! + ! Author: Beth Holland and James Sulzman + ! + ! Modified: Francis Vitt -- 30 Mar 2007 + ! Modified: Maria Val Martin -- 15 Jan 2014 + ! Corrected major bugs in the leaf and stomatal resitances. The code is now + ! coupled to LAI and Rs uses the Ball-Berry Scheme. Also, corrected minor + ! bugs in rlu and rcl calculations. Added + ! no vegetation removal for CO. See README for details and + ! Val Martin et al., 2014 GRL for major corrections + ! + !********* !!! IMPORTANT !!! ************ + ! STOMATAL RESISTANCE IS OPTIMIZED TO MATCH UP OBSERVATIONS + !----------------------------------------------------------------------- + + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use abortutils, only : endrun + use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time + use clm_atmlnd, only : clm_a2l + use spmdMod, only : masterproc + use seq_drydep_mod, only : n_drydep, drydep_list + use seq_drydep_mod, only : drydep_method, DD_XLND + use seq_drydep_mod, only : index_o3=>o3_ndx, index_o3a=>o3a_ndx, index_so2=>so2_ndx, index_h2=>h2_ndx, & + index_co=>co_ndx, index_ch4=>ch4_ndx, index_pan=>pan_ndx, & + index_xpan=>xpan_ndx + implicit none + save + + private + + public :: depvel_compute + +CONTAINS + + !----------------------------------------------------------------------- + ! computes the dry deposition velocity of tracers + !----------------------------------------------------------------------- + subroutine depvel_compute( lbp , ubp ) + use shr_const_mod , only : tmelt => shr_const_tkfrz + use seq_drydep_mod , only : seq_drydep_setHCoeff, mapping, drat, foxd, & + rcls, h2_a, h2_b, h2_c, ri, rac, rclo, rlu, & + rgss, rgso + use clm_varcon , only : istsoil, istice, istice_mec, istslak, istdlak, istwet, isturb + use clm_varctl , only : iulog + use pftvarcon , only : noveg, ndllf_evr_tmp_tree, ndllf_evr_brl_tree, & + ndllf_dcd_brl_tree, nbrdlf_evr_trp_tree, & + nbrdlf_evr_tmp_tree, nbrdlf_dcd_trp_tree, & + nbrdlf_dcd_tmp_tree, nbrdlf_dcd_brl_tree, & + nbrdlf_evr_shrub, nbrdlf_dcd_tmp_shrub, & + nbrdlf_dcd_brl_shrub, nc3_arctic_grass, & + nc3_nonarctic_grass, nc4_grass, nc3crop, & + nirrig, npcropmin, npcropmax + + implicit none + + !----Arguments----------------------------------------------------- + + integer, intent(in) :: lbp, ubp ! pft bounds + + ! ------------------------ local variables ------------------------ + ! local pointers to implicit in arguments + integer , pointer :: plandunit(:) !pft's landunit index + integer , pointer :: ivt(:) !landunit type + integer , pointer :: itypveg(:) !vegetation type for current pft + integer , pointer :: pgridcell(:) !pft's gridcell index + real(r8), pointer :: pwtgcell(:) !weight of pft relative to corresponding gridcell + real(r8), pointer :: elai(:) !one-sided leaf area index with burying by snow + real(r8), pointer :: forc_t(:) !atmospheric temperature (Kelvin) + real(r8), pointer :: forc_q(:) !atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_psrf(:) !surface pressure (Pa) + real(r8), pointer :: latdeg(:) !latitude (degrees) + real(r8), pointer :: londeg(:) !longitude (degrees) + real(r8), pointer :: forc_rain(:) !rain rate [mm/s] + real(r8), pointer :: forc_snow(:) !snow rate [mm/s] + real(r8), pointer :: forc_lwrad(:) !direct beam radiation (visible only) + real(r8), pointer :: forc_solad(:,:) !direct beam radiation (visible only) + real(r8), pointer :: forc_solai(:,:) !direct beam radiation (visible only) + real(r8), pointer :: ram1(:) !aerodynamical resistance + real(r8), pointer :: vds(:) !aerodynamical resistance + real(r8), pointer :: rssun(:) !stomatal resistance + real(r8), pointer :: rssha(:) !shaded stomatal resistance (s/m) + real(r8), pointer :: fsun(:) !sunlit fraction of canopy + real(r8), pointer :: rb1(:) !leaf boundary layer resistance [s/m] + real(r8), pointer :: annlai(:,:) !12 months of monthly lai from input data set + real(r8), pointer :: mlaidiff(:) !difference in lai between month one and month two + real(r8), pointer :: velocity(:,:) + real(r8), pointer :: snowdp(:) ! snow height (m) + + integer, pointer :: pcolumn(:) ! column index associated with each pft + integer :: c + integer , pointer :: itypelun(:) ! landunit type + + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) + real(r8) :: soilw, var_soilw, fact_h2, dv_soil_h2 + + ! new local variables + integer :: pi,g, l + integer :: ispec + integer :: length + integer :: wesveg !wesely vegegation index + integer :: clmveg !clm veg index from ivegtype + integer :: i + integer :: index_season !seasonal index based on LAI. This indexs wesely data tables + integer :: nstep !current step + integer :: indexp + + real(r8) :: pg ! surface pressure + real(r8) :: tc ! temperature in celsius + real(r8) :: rs ! constant for calculating rsmx + real(r8) :: es ! saturation vapor pressur + real(r8) :: ws ! saturation mixing ratio + real(r8) :: rmx ! resistance by vegetation + real(r8) :: qs ! saturation specific humidity + real(r8) :: dewm ! multiplier for rs when dew occurs + real(r8) :: crs ! multiplier to calculate crs + real(r8) :: rdc ! part of lower canopy resistance + real(r8) :: rain ! rain fall + real(r8) :: spec_hum ! specific humidity + real(r8) :: solar_flux ! solar radiation(direct beam) W/m2 + real(r8) :: lat ! latitude in degrees + real(r8) :: lon ! longitude in degrees + real(r8) :: sfc_temp ! surface temp + real(r8) :: minlai ! minimum of monthly lai + real(r8) :: maxlai ! maximum of monthly lai + real(r8) :: rds ! resistance for aerosols + + !mvm 11/30/2013 + real(r8) :: rlu_lai ! constant to calculate rlu over bulk canopy + real(r8) :: rs_factor ! constant to optimize stomatal resistance + + logical :: has_dew + logical :: has_rain + real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s + + ! local arrays: dependent on species only + ! + + real(r8), dimension(n_drydep) :: rsmx !vegetative resistance (plant mesophyll) + real(r8), dimension(n_drydep) :: rclx !lower canopy resistance + real(r8), dimension(n_drydep) :: rlux !vegetative resistance (upper canopy) + real(r8), dimension(n_drydep) :: rgsx !gournd resistance + real(r8), dimension(n_drydep) :: heff + real(r8) :: rc !combined surface resistance + real(r8) :: cts !correction to flu rcl and rgs for frost + real(r8) :: rlux_o3 !to calculate O3 leaf resistance in dew/rain conditions + + ! constants + real(r8), parameter :: slope = 0._r8 ! Used to calculate rdc in (lower canopy resistance) + integer, parameter :: wveg_unset = -1 ! Unset Wesley vegetation type + + character(len=32), parameter :: subname = "depvel_compute" + + !------------------------------------------------------------------------------------- + ! jfl : mods for PAN + !------------------------------------------------------------------------------------- + real(r8) :: dv_pan + real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, & + 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /) + real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, & + 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /) + !----------------------------------------------------------------------- + if ( n_drydep == 0 .or. drydep_method /= DD_XLND ) return + + ! local pointers to original implicit out arrays + + ! Assign local pointers to derived subtypes components (column-level) + forc_t => clm_a2l%forc_t + forc_q => clm_a2l%forc_q + forc_psrf => clm_a2l%forc_pbot + forc_rain => clm_a2l%forc_rain + + latdeg => grc%latdeg + londeg => grc%londeg + ivt => pft%itype + elai => pps%elai + ram1 => pps%ram1 + vds => pps%vds + fsun => pps%fsun + rssun => pps%rssun + rssha => pps%rssha + rb1 => pps%rb1 + mlaidiff => pps%mlaidiff + annlai => pps%annlai + + forc_solai => clm_a2l%forc_solai + forc_solad => clm_a2l%forc_solad + + pwtgcell => pft%wtgcell + pgridcell => pft%gridcell + plandunit => pft%landunit + + pcolumn => pft%column + itypelun => lun%itype + + h2osoi_vol => cws%h2osoi_vol + + velocity => pdd%drydepvel ! cm/sec + + snowdp => cps%snowdp + + ! Assign local pointers to original implicit out arrays + !_________________________________________________________________ + ! + ! Begin loop through pfts + pft_loop: do pi = lbp,ubp + l = plandunit(pi) + + ! Note: some glacier_mec pfts may have zero weight + gcell_wght: if (pwtgcell(pi)>0._r8 .or. itypelun(l)==istice_mec) then + + c = pcolumn(pi) + g = pgridcell(pi) + pg = forc_psrf(g) + spec_hum = forc_q(g) + rain = forc_rain(g) + sfc_temp = forc_t(g) + lat = latdeg(g) + lon = londeg(g) + solar_flux = forc_solad(g,1) + clmveg = ivt(pi) + soilw = h2osoi_vol(c,1) + + !map CLM veg type into Wesely veg type + wesveg = wveg_unset + if (clmveg == noveg ) wesveg = 8 + if (clmveg == ndllf_evr_tmp_tree ) wesveg = 5 + if (clmveg == ndllf_evr_brl_tree ) wesveg = 5 + if (clmveg == ndllf_dcd_brl_tree ) wesveg = 5 + if (clmveg == nbrdlf_evr_trp_tree ) wesveg = 4 + if (clmveg == nbrdlf_evr_tmp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_trp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_tmp_tree ) wesveg = 4 + if (clmveg == nbrdlf_dcd_brl_tree ) wesveg = 4 + if (clmveg == nbrdlf_evr_shrub ) wesveg = 11 + if (clmveg == nbrdlf_dcd_tmp_shrub ) wesveg = 11 + if (clmveg == nbrdlf_dcd_brl_shrub ) wesveg = 11 + if (clmveg == nc3_arctic_grass ) wesveg = 3 + if (clmveg == nc3_nonarctic_grass ) wesveg = 3 + if (clmveg == nc4_grass ) wesveg = 3 + if (clmveg == nc3crop ) wesveg = 2 + if (clmveg == nirrig ) wesveg = 2 + if (clmveg >= npcropmin .and. clmveg <= npcropmax ) wesveg = 2 + if (wesveg == wveg_unset )then + write(iulog,*) 'clmveg = ', clmveg, 'itypelun = ', itypelun(l) + call endrun( subname//': Not able to determine Wesley vegetation type') + end if + + ! create seasonality index used to index wesely data tables from LAI, Bascially + !if elai is between max lai from input data and half that max the index_season=1 + + + !mail1j and mlai2j are the two monthly lai values pulled from a CLM input data set + !/fs/cgd/csm/inputdata/lnd/clm2/rawdata/mksrf_lai.nc. lai for dates in the middle + !of the month are interpolated using using these values and stored in the variable + !elai (done elsewhere). If the difference between mlai1j and mlai2j is greater + !than zero it is assumed to be fall and less than zero it is assumed to be spring. + + !wesely seasonal "index_season" + ! 1 - midsummer with lush vegetation + ! 2 - Autumn with unharvested cropland + ! 3 - Late autumn after frost, no snow + ! 4 - Winter, snow on ground and subfreezing + ! 5 - Transitional spring with partially green short annuals + + + !mlaidiff=jan-feb + minlai=minval(annlai(:,pi)) + maxlai=maxval(annlai(:,pi)) + + index_season = -1 + + if ( itypelun(l) /= istsoil )then + if ( itypelun(l) == istice .or. itypelun(l) == istice_mec ) then + wesveg = 8 + index_season = 4 + elseif ( itypelun(l) == istdlak .or. itypelun(l) == istslak ) then + wesveg = 7 + index_season = 4 + elseif ( itypelun(l) == istwet ) then + wesveg = 9 + index_season = 2 + elseif ( itypelun(l) == isturb ) then + wesveg = 1 + index_season = 2 + end if + else if ( snowdp(c) > 0 ) then + index_season = 4 + else if(elai(pi).gt.0.5_r8*maxlai) then + index_season = 1 + endif + + if (index_season<0) then + if (elai(pi).lt.(minlai+0.05*(maxlai-minlai))) then + index_season = 3 + endif + endif + + if (index_season<0) then + if (mlaidiff(pi).gt.0.0_r8) then + index_season = 2 + elseif (mlaidiff(pi).lt.0.0_r8) then + index_season = 5 + elseif (mlaidiff(pi).eq.0.0_r8) then + index_season = 3 + endif + endif + + if (index_season<0) then + call endrun( subname//': not able to determine season') + endif + + ! saturation specific humidity + ! + es = 611_r8*exp(5414.77_r8*((1._r8/tmelt)-(1._r8/sfc_temp))) + ws = .622_r8*es/(pg-es) + qs = ws/(1._r8+ws) + + has_dew = .false. + if( qs <= spec_hum ) then + has_dew = .true. + end if + if( sfc_temp < tmelt ) then + has_dew = .false. + end if + + has_rain = rain > rain_threshold + + if ( has_dew .or. has_rain ) then + dewm = 3._r8 + else + dewm = 1._r8 + end if + + !Define tc + tc = sfc_temp - tmelt + + ! + ! rdc (lower canopy res) + ! + rdc=100._r8*(1._r8+1000._r8/(solar_flux+10._r8))/(1._r8+1000._r8*slope) + + ! surface resistance : depends on both land type and species + ! land types are computed seperately, then resistance is computed as average of values + ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 + + !******************************************************* + call seq_drydep_setHCoeff( sfc_temp, heff(:n_drydep) ) + !********************************************************* + + species_loop1: do ispec=1, n_drydep + if(mapping(ispec).le.0) cycle + + if(ispec.eq.index_o3.or.ispec.eq.index_o3a.or.ispec.eq.index_so2) then + rmx=0._r8 + else + rmx=1._r8/((heff(ispec)/3000._r8)+(100._r8*foxd(ispec))) + endif + + ! correction for frost + cts = 1000._r8*exp( -tc - 4._r8 ) + + !ground resistance + rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rgso(index_season,wesveg)+cts))) + + !------------------------------------------------------------------------------------- + ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) + !------------------------------------------------------------------------------------- + if( ispec == index_h2 .or. ispec == index_co .or. ispec == index_ch4 ) then + + if( ispec == index_co ) then + fact_h2 = 1.0_r8 + elseif ( ispec == index_h2 ) then + fact_h2 = 0.5_r8 + elseif ( ispec == index_ch4 ) then + fact_h2 = 50.0_r8 + end if + + !------------------------------------------------------------------------------------- + ! no deposition on snow, ice, desert, and water + !------------------------------------------------------------------------------------- + if( wesveg == 1 .or. wesveg == 7 .or. wesveg == 8 .or. index_season == 4 ) then + rgsx(ispec) = 1.e36_r8 + else + var_soilw = max( .1_r8,min( soilw,.3_r8 ) ) + if( wesveg == 3 ) then + var_soilw = log( var_soilw ) + end if + dv_soil_h2 = h2_c(wesveg) + var_soilw*(h2_b(wesveg) + var_soilw*h2_a(wesveg)) + if( dv_soil_h2 > 0._r8 ) then + rgsx(ispec) = fact_h2/(dv_soil_h2*1.e-4_r8) + end if + end if + end if + + !------------------------------------------------------------------------------------- + ! no deposition on water or no vegetation or snow (elai<=0) + !------------------------------------------------------------------------------------- + + no_dep: if( wesveg == 7 .or. elai(pi).le.0_r8 ) then !mvm 11/26/2013 + rclx(ispec)=1.e36_r8 + rsmx(ispec)=1.e36_r8 + rlux(ispec)=1.e36_r8 + else + + !Stomatal resistance + !MVM: adjusted rs to calculate stomata conductance over bulk canopy (CLM report pag 161) + rs=(fsun(pi)*rssun(pi)/elai(pi))+((rssha(pi)/elai(pi))*(1.-fsun(pi))) + + !MVM: rs_factor=0.2 to match up Rs observations (Padro et al, 1996) + rs_factor = 0.2_r8 + rsmx(ispec) = rs_factor*rs*drat(ispec)+rmx + + ! Leaf resistance + !MVM: adjusted rlu by LAI to get leaf resistance over bulk canopy (gao and wesely, 1995) + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) + + !Lower canopy resistance + rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rclo(index_season,wesveg)+cts))) + + !----------------------------------- + !mvm 11/30/2013: special case for CO + !Dry deposition of CO and hydrocarbons is negligibly + !small in vegetation [Mueller and Brasseur, 1995]. + !------------------------------------ + if( ispec == index_co ) then + rclx(ispec)=1.e36_r8 + rsmx(ispec)=1.e36_r8 + rlux(ispec)=1.e36_r8 + endif + + !-------------------------------------------- + ! jfl : special case for PAN + !-------------------------------------------- + if( ispec == index_pan ) then + dv_pan = c0_pan(wesveg) * (1._r8 - exp(-k_pan(wesveg)*(rs*drat(ispec))*1.e-2_r8 )) + + if( dv_pan > 0._r8 .and. index_season /= 4 ) then + rsmx(ispec) = ( 1._r8/dv_pan ) + end if + end if + + endif no_dep + + end do species_loop1 + + + !---------------------------------------------- + !Adjustment for dew and rain in leaf resitances + !--------------------------------------------- + ! no effect over water + no_water: if( wesveg.ne.7 ) then + !MVM: effect only on vegetated areas (elai> 0) + with_LAI: if (elai(pi).gt.0._r8) then + + ! + ! no effect if sfc_temp < O C + ! + non_freezing: if(sfc_temp.gt.tmelt) then + if( has_dew ) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) + + if (index_o3 > 0) then + rlux(index_o3) = rlux_o3 + endif + if (index_o3a > 0) then + rlux(index_o3a) = rlux_o3 + endif + endif + + if(has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) + + if (index_o3 > 0) then + rlux(index_o3) = rlux_o3 + endif + if (index_o3a > 0) then + rlux(index_o3a) = rlux_o3 + endif + endif + + species_loop2: do ispec=1,n_drydep + if(mapping(ispec).le.0) cycle + if(ispec.ne.index_o3.and.ispec.ne.index_o3a.and.ispec.ne.index_so2) then + + if( has_dew .or. has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & + (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) + endif + + elseif(ispec.eq.index_so2) then + + if( has_dew ) then + rlux(ispec) = 100._r8 + endif + + if(has_rain) then + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) + endif + + if( has_dew .or. has_rain ) then + !MVM:rlux=50 for SO2 in dew or rain only for *urban land* type surfaces. + if (wesveg.eq.1) then + rlux(ispec)=50._r8 + endif + endif + end if + !mvm 11/30/2013: special case for CO + if( ispec.eq.index_co ) then + rlux(ispec)=1.e36_r8 + endif + end do species_loop2 + endif non_freezing + endif with_LAI + endif no_water + + ! resistance for aerosols + rds = 1._r8/vds(pi) + + species_loop3: do ispec=1,n_drydep + if(mapping(ispec).le.0) cycle + + ! + ! compute rc + ! + rc = 1._r8/((1._r8/rsmx(ispec))+(1._r8/rlux(ispec)) + & + (1._r8/(rdc+rclx(ispec)))+(1._r8/(rac(index_season,wesveg)+rgsx(ispec)))) + rc = max( 10._r8, rc) + ! + ! assume no surface resistance for SO2 over water + ! + if ( drydep_list(ispec) == 'SO2' .and. wesveg == 7 ) then + rc = 0._r8 + end if + + select case( drydep_list(ispec) ) + case ( 'SO4' ) + velocity(pi,ispec) = (1._r8/(ram1(pi)+rds))*100._r8 + case ( 'NH4','NH4NO3','XNH4NO3' ) + velocity(pi,ispec) = (1._r8/(ram1(pi)+0.5_r8*rds))*100._r8 + case ( 'Pb' ) + velocity(pi,ispec) = 0.2_r8 + case ( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + velocity(pi,ispec) = 0.10_r8 + case default + velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 + end select + end do species_loop3 + endif gcell_wght + end do pft_loop + + end subroutine depvel_compute + +end module DryDepVelocity diff --git a/components/clm/src_clm40/biogeochem/MEGANFactorsMod.F90 b/components/clm/src_clm40/biogeochem/MEGANFactorsMod.F90 new file mode 100644 index 0000000000..2d045d9e53 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/MEGANFactorsMod.F90 @@ -0,0 +1,319 @@ +module MEGANFactorsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: MEGANFactorsMod +! +! !DESCRIPTION: +! Manages input of MEGAN emissions factors from netCDF file +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : iulog +! + implicit none + private + save +! +! !PUBLIC MEMBERS: + public :: megan_factors_init + public :: megan_factors_get + public :: comp_names +! +! !PUBLIC DATA: + real(r8), public, allocatable :: LDF(:) ! light dependent fraction + real(r8), public, allocatable :: Agro(:) ! growing leaf age factor + real(r8), public, allocatable :: Amat(:) ! mature leaf age factor + real(r8), public, allocatable :: Anew(:) ! new leaf age factor + real(r8), public, allocatable :: Aold(:) ! old leaf age factor + real(r8), public, allocatable :: betaT(:)! temperature factor + real(r8), public, allocatable :: ct1(:) ! temperature coefficient 1 + real(r8), public, allocatable :: ct2(:) ! temperature coefficient 2 + real(r8), public, allocatable :: Ceo(:) ! Eopt coefficient +! +! !PRIVATE MEMBERS: + integer :: npfts ! number of plant function types +! + type emis_eff_t + real(r8), pointer :: eff(:) ! emissions efficiency factor + real(r8) :: wght ! molecular weight + integer :: class_num ! MEGAN class number + endtype emis_eff_t +! + type(emis_eff_t), pointer :: comp_factors_table(:) ! hash table of MEGAN factors (points to an array of pointers) + integer, pointer :: hash_table_indices(:) ! pointer to hash table indices + integer, parameter :: tbl_hash_sz = 2**16 ! hash table size +! + character(len=32), allocatable :: comp_names(:) ! MEGAN compound names + real(r8), allocatable :: comp_molecwghts(:)! MEGAN compound molecular weights +! +! !REVISION HISTORY: +! 28 Oct 2011: Created by Francis Vitt +! +!EOP +!----------------------------------------------------------------------- +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: megan_factors_get +! +! !INTERFACE: + subroutine megan_factors_get( comp_name, factors, class_n, molecwght ) +! +! !DESCRIPTION: +! Method for getting MEGAN information for a named compound +! +! !ARGUMENTS: + character(len=*),intent(in) :: comp_name ! MEGAN compound name + real(r8), intent(out) :: factors(npfts) ! vegitation type factors for the compound of intrest + integer, intent(out) :: class_n ! MEGAN class number for the compound of intrest + real(r8), intent(out) :: molecwght ! molecular weight of the compound of intrest +! +!EOP +!----------------------------------------------------------------------- +! local vars: + integer :: hashkey, ndx + character(len=120) :: errmes + + hashkey = gen_hashkey(comp_name) + ndx = hash_table_indices(hashkey) + + if (ndx<1) then + errmes = 'megan_factors_get: '//trim(comp_name)//' compound not found in MEGAN table' + write(iulog,*) trim(errmes) + call endrun(errmes) + endif + + factors(:) = comp_factors_table( ndx )%eff(:) + class_n = comp_factors_table( ndx )%class_num + molecwght = comp_factors_table( ndx )%wght + + end subroutine megan_factors_get +!----------------------------------------------------------------------- +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: megan_factors_init +! +! !INTERFACE: + subroutine megan_factors_init( filename ) +! +! !DESCRIPTION: +! Initializes the MEGAN factors using data from input file +! +! !USES: + use ncdio_pio, only : ncd_pio_openfile,ncd_inqdlen + use pio, only : pio_inq_varid,pio_get_var,file_desc_t,pio_closefile + use fileutils , only : getfil +! +! !ARGUMENTS: + character(len=*),intent(in) :: filename ! MEGAN factors input file + +!EOP +!----------------------------------------------------------------------- +! + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + + integer :: start(2), count(2) + + integer :: ierr, i, vid + integer :: dimid, n_comps, n_classes, n_pfts + integer :: class_ef_vid,comp_ef_vid,comp_name_vid,class_num_vid + integer :: comp_mw_vid + integer, allocatable :: class_nums(:) + + real(r8),allocatable :: factors(:) + real(r8),allocatable :: comp_factors(:) + real(r8),allocatable :: class_factors(:) + + allocate(comp_factors_table(150)) + allocate(hash_table_indices(tbl_hash_sz)) + + + call getfil(filename, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + call ncd_inqdlen( ncid, dimid, n_comps, name='Comp_Num') + call ncd_inqdlen( ncid, dimid, n_classes, name='Class_Num') + call ncd_inqdlen( ncid, dimid, n_pfts, name='PFT_Num') + + npfts = n_pfts + + ierr = pio_inq_varid(ncid,'Class_EF', class_ef_vid) + ierr = pio_inq_varid(ncid,'Comp_EF', comp_ef_vid) + ierr = pio_inq_varid(ncid,'Comp_Name',comp_name_vid) + ierr = pio_inq_varid(ncid,'Class_Num',class_num_vid) + ierr = pio_inq_varid(ncid,'Comp_MW', comp_mw_vid) + + allocate( factors(n_pfts) ) + allocate( comp_factors(n_pfts) ) + allocate( class_factors(n_pfts) ) + + allocate( comp_names(n_comps) ) + allocate( comp_molecwghts(n_comps) ) + allocate( class_nums(n_comps) ) + + ierr = pio_get_var( ncid, comp_name_vid, comp_names ) + ierr = pio_get_var( ncid, comp_mw_vid, comp_molecwghts ) + ierr = pio_get_var( ncid, class_num_vid, class_nums ) + + ! set up hash table where data is stored + call bld_hash_table_indices( comp_names ) + do i=1,n_comps + start=(/i,1/) + count=(/1,16/) + ierr = pio_get_var( ncid, comp_ef_vid, start, count, comp_factors ) + start=(/class_nums(i),1/) + ierr = pio_get_var( ncid, class_ef_vid, start, count, class_factors ) + factors(:) = comp_factors(:)*class_factors(:) + call enter_hash_data( trim(comp_names(i)), factors, class_nums(i), comp_molecwghts(i) ) + enddo + + allocate( LDF(n_classes) ) + allocate( Agro(n_classes) ) + allocate( Amat(n_classes) ) + allocate( Anew(n_classes) ) + allocate( Aold(n_classes) ) + allocate( betaT(n_classes) ) + allocate( ct1(n_classes) ) + allocate( ct2(n_classes) ) + allocate( Ceo(n_classes) ) + + ierr = pio_inq_varid(ncid,'LDF', vid) + ierr = pio_get_var( ncid, vid, LDF ) + + ierr = pio_inq_varid(ncid,'Agro', vid) + ierr = pio_get_var( ncid, vid, Agro ) + + ierr = pio_inq_varid(ncid,'Amat', vid) + ierr = pio_get_var( ncid, vid, Amat ) + + ierr = pio_inq_varid(ncid,'Anew', vid) + ierr = pio_get_var( ncid, vid, Anew ) + + ierr = pio_inq_varid(ncid,'Aold', vid) + ierr = pio_get_var( ncid, vid, Aold ) + + ierr = pio_inq_varid(ncid,'betaT', vid) + ierr = pio_get_var( ncid, vid, betaT ) + + ierr = pio_inq_varid(ncid,'ct1', vid) + ierr = pio_get_var( ncid, vid, ct1 ) + + ierr = pio_inq_varid(ncid,'ct2', vid) + ierr = pio_get_var( ncid, vid, ct2 ) + + ierr = pio_inq_varid(ncid,'Ceo', vid) + ierr = pio_get_var( ncid, vid, Ceo ) + + call pio_closefile(ncid) + + deallocate( class_nums, comp_factors,class_factors,factors ) + + endsubroutine megan_factors_init +!----------------------------------------------------------------------- + + !----------------------------------------------------------------------- + ! Private methods... + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine bld_hash_table_indices( names ) + character(len=*),intent(in) :: names(:) + + integer :: n, i, hashkey + + hash_table_indices(:) = 0 + + n = size(names) + do i=1,n + hashkey = gen_hashkey(names(i)) + hash_table_indices(hashkey) = i + enddo + + endsubroutine bld_hash_table_indices + + !----------------------------------------------------------------------- + !----------------------------------------------------------------------- + subroutine enter_hash_data( name, data, class_n, molec_wght ) + character(len=*), intent(in) :: name + real(r8), intent(in) :: data(:) + integer, intent(in) :: class_n + real(r8), intent(in) :: molec_wght + + integer :: hashkey, ndx + integer :: nfactors + + hashkey = gen_hashkey(name) + nfactors = size(data) + + ndx = hash_table_indices(hashkey) + + allocate (comp_factors_table(ndx)%eff(nfactors)) + + comp_factors_table(ndx)%eff(:) = data(:) + comp_factors_table(ndx)%class_num = class_n + comp_factors_table(ndx)%wght = molec_wght + + end subroutine enter_hash_data + + !----------------------------------------------------------------------- + !from cam_history + ! + ! Purpose: Generate a hash key on the interval [0 .. tbl_hash_sz-1] + ! given a character string. + ! + ! Algorithm is a variant of perl's internal hashing function. + ! + !----------------------------------------------------------------------- + integer function gen_hashkey(string) + + implicit none + ! + ! Arguments: + ! + character(len=*), intent(in) :: string + ! + ! Local vars + ! + integer :: hash + integer :: i + + integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 + integer, parameter :: gen_hash_key_offset = z'000053db' + integer, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = (/61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1/) + + hash = gen_hash_key_offset + + if ( len_trim(string) /= 19 ) then + ! + ! Process arbitrary string length. + ! + do i = 1, len_trim(string) + hash = ieor(hash , (ichar(string(i:i)) * tbl_gen_hash_key(iand(i-1,tbl_max_idx)))) + end do + else + ! + ! Special case string length = 19 + ! + do i = 1, tbl_max_idx+1 + hash = ieor(hash , ichar(string(i:i)) * tbl_gen_hash_key(i-1)) + end do + do i = tbl_max_idx+2, len_trim(string) + hash = ieor(hash , ichar(string(i:i)) * tbl_gen_hash_key(i-tbl_max_idx-2)) + end do + end if + + gen_hashkey = iand(hash, tbl_hash_sz-1) + + return + + end function gen_hashkey + +end module MEGANFactorsMod + + diff --git a/components/clm/src_clm40/biogeochem/STATICEcosysDynMod.F90 b/components/clm/src_clm40/biogeochem/STATICEcosysDynMod.F90 new file mode 100644 index 0000000000..c7039c7942 --- /dev/null +++ b/components/clm/src_clm40/biogeochem/STATICEcosysDynMod.F90 @@ -0,0 +1,549 @@ +module STATICEcosysdynMOD + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: STATICEcosysDynMod +! +! !DESCRIPTION: +! Static Ecosystem dynamics: phenology, vegetation. This is for the CLM Satelitte Phenology +! model (CLMSP). Allow some subroutines to be used by the CLM Carbon Nitrogen model (CLMCN) +! so that DryDeposition code can get estimates of LAI differences between months. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : scmlat,scmlon,single_column + use clm_varctl, only : iulog + use perf_mod, only : t_startf, t_stopf + use spmdMod, only : masterproc + use ncdio_pio +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: EcosystemDyn ! CLMSP Ecosystem dynamics: phenology, vegetation + public :: EcosystemDynini ! Dynamically allocate memory + public :: interpMonthlyVeg ! interpolate monthly vegetation data + public :: readAnnualVegetation ! Read in annual vegetation (needed for Dry-deposition) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE MEMBER FUNCTIONS: + private :: readMonthlyVegetation ! read monthly vegetation data for two months +! +! !PRIVATE TYPES: + integer , private :: InterpMonths1 ! saved month index + real(r8), private :: timwt(2) ! time weights for month 1 and month 2 + real(r8), private, allocatable :: mlai2t(:,:) ! lai for interpolation (2 months) + real(r8), private, allocatable :: msai2t(:,:) ! sai for interpolation (2 months) + real(r8), private, allocatable :: mhvt2t(:,:) ! top vegetation height for interpolation (2 months) + real(r8), private, allocatable :: mhvb2t(:,:) ! bottom vegetation height for interpolation(2 months) +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: EcosystemDynini +! +! !INTERFACE: + subroutine EcosystemDynini () +! +! !DESCRIPTION: +! Dynamically allocate memory and set to signaling NaN. +! +! !USES: + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use decompMod, only : get_proc_bounds +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ier ! error code + integer :: begp,endp ! local beg and end p index +!----------------------------------------------------------------------- + + InterpMonths1 = -999 ! saved month index + call get_proc_bounds(begp=begp,endp=endp) + + ier = 0 + if(.not.allocated(mlai2t))allocate (mlai2t(begp:endp,2), & + msai2t(begp:endp,2), & + mhvt2t(begp:endp,2), & + mhvb2t(begp:endp,2), stat=ier) + if (ier /= 0) then + write(iulog,*) 'EcosystemDynini allocation error' + call endrun + end if + + mlai2t(:,:) = nan + msai2t(:,:) = nan + mhvt2t(:,:) = nan + mhvb2t(:,:) = nan + + end subroutine EcosystemDynini + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: EcosystemDyn +! +! !INTERFACE: + subroutine EcosystemDyn(lbp, ubp, num_nolakep, filter_nolakep, doalb) +! +! !DESCRIPTION: +! Ecosystem dynamics: phenology, vegetation +! Calculates leaf areas (tlai, elai), stem areas (tsai, esai) and +! height (htop). +! +! !USES: + use clmtype + use pftvarcon, only : noveg, nc3crop, nbrdlf_dcd_brl_shrub +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points + logical, intent(in) :: doalb ! true = surface albedo calculation time step +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 2/1/02, Peter Thornton: Migrated to new data structure. +! 2/29/08, David Lawrence: revised snow burial fraction for short vegetation +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pcolumn(:) ! column index associated with each pft + real(r8), pointer :: snowdp(:) ! snow height (m) + integer , pointer :: ivt(:) ! pft vegetation type +! +! local pointers to implicit out arguments +! + real(r8), pointer :: tlai(:) ! one-sided leaf area index, no burying by snow + real(r8), pointer :: tsai(:) ! one-sided stem area index, no burying by snow + real(r8), pointer :: htop(:) ! canopy top (m) + real(r8), pointer :: hbot(:) ! canopy bottom (m) + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + integer , pointer :: frac_veg_nosno_alb(:) ! frac of vegetation not covered by snow [-] +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: fp,p,c ! indices + real(r8) :: ol ! thickness of canopy layer covered by snow (m) + real(r8) :: fb ! fraction of canopy layer covered by snow +!----------------------------------------------------------------------- + + if (doalb) then + + ! Assign local pointers to derived type scalar members (column-level) + + snowdp => cps%snowdp + + ! Assign local pointers to derived type scalar members (pftlevel) + + pcolumn => pft%column + tlai => pps%tlai + tsai => pps%tsai + elai => pps%elai + esai => pps%esai + htop => pps%htop + hbot => pps%hbot + frac_veg_nosno_alb => pps%frac_veg_nosno_alb + ivt => pft%itype + + do fp = 1, num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + + ! need to update elai and esai only every albedo time step so do not + ! have any inconsistency in lai and sai between SurfaceAlbedo calls (i.e., + ! if albedos are not done every time step). + ! leaf phenology + ! Set leaf and stem areas based on day of year + ! Interpolate leaf area index, stem area index, and vegetation heights + ! between two monthly + ! The weights below (timwt(1) and timwt(2)) were obtained by a call to + ! routine InterpMonthlyVeg in subroutine NCARlsm. + ! Field Monthly Values + ! ------------------------- + ! leaf area index LAI <- mlai1 and mlai2 + ! leaf area index SAI <- msai1 and msai2 + ! top height HTOP <- mhvt1 and mhvt2 + ! bottom height HBOT <- mhvb1 and mhvb2 + + tlai(p) = timwt(1)*mlai2t(p,1) + timwt(2)*mlai2t(p,2) + tsai(p) = timwt(1)*msai2t(p,1) + timwt(2)*msai2t(p,2) + htop(p) = timwt(1)*mhvt2t(p,1) + timwt(2)*mhvt2t(p,2) + hbot(p) = timwt(1)*mhvb2t(p,1) + timwt(2)*mhvb2t(p,2) + + ! adjust lai and sai for burying by snow. if exposed lai and sai + ! are less than 0.05, set equal to zero to prevent numerical + ! problems associated with very small lai and sai. + + ! snow burial fraction for short vegetation (e.g. grasses) as in + ! Wang and Zeng, 2007. + + if (ivt(p) > noveg .and. ivt(p) <= nbrdlf_dcd_brl_shrub ) then + ol = min( max(snowdp(c)-hbot(p), 0._r8), htop(p)-hbot(p)) + fb = 1._r8 - ol / max(1.e-06_r8, htop(p)-hbot(p)) + else + fb = 1._r8 - max(min(snowdp(c),0.2_r8),0._r8)/0.2_r8 ! 0.2m is assumed + !depth of snow required for complete burial of grasses + endif + + elai(p) = max(tlai(p)*fb, 0.0_r8) + esai(p) = max(tsai(p)*fb, 0.0_r8) + if (elai(p) < 0.05_r8) elai(p) = 0._r8 + if (esai(p) < 0.05_r8) esai(p) = 0._r8 + + ! Fraction of vegetation free of snow + + if ((elai(p) + esai(p)) >= 0.05_r8) then + frac_veg_nosno_alb(p) = 1 + else + frac_veg_nosno_alb(p) = 0 + end if + + end do ! end of pft loop + + end if !end of if-doalb block + + end subroutine EcosystemDyn + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: interpMonthlyVeg +! +! !INTERFACE: + subroutine interpMonthlyVeg () +! +! !DESCRIPTION: +! Determine if 2 new months of data are to be read. +! +! !USES: + use clm_varctl , only : fsurdat + use clm_time_manager, only : get_curr_date, get_step_size, & + get_perp_date, is_perpetual, get_nstep +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: kyr ! year (0, ...) for nstep+1 + integer :: kmo ! month (1, ..., 12) + integer :: kda ! day of month (1, ..., 31) + integer :: ksec ! seconds into current date for nstep+1 + real(r8):: dtime ! land model time step (sec) + real(r8):: t ! a fraction: kda/ndaypm + integer :: it(2) ! month 1 and month 2 (step 1) + integer :: months(2) ! months to be interpolated (1 to 12) + integer, dimension(12) :: ndaypm= & + (/31,28,31,30,31,30,31,31,30,31,30,31/) !days per month +!----------------------------------------------------------------------- + + dtime = get_step_size() + + if ( is_perpetual() ) then + call get_perp_date(kyr, kmo, kda, ksec, offset=int(dtime)) + else + call get_curr_date(kyr, kmo, kda, ksec, offset=int(dtime)) + end if + + t = (kda-0.5_r8) / ndaypm(kmo) + it(1) = t + 0.5_r8 + it(2) = it(1) + 1 + months(1) = kmo + it(1) - 1 + months(2) = kmo + it(2) - 1 + if (months(1) < 1) months(1) = 12 + if (months(2) > 12) months(2) = 1 + timwt(1) = (it(1)+0.5_r8) - t + timwt(2) = 1._r8-timwt(1) + + if (InterpMonths1 /= months(1)) then + if (masterproc) then + write(iulog,*) 'Attempting to read monthly vegetation data .....' + write(iulog,*) 'nstep = ',get_nstep(),' month = ',kmo,' day = ',kda + end if + call t_startf('readMonthlyVeg') + call readMonthlyVegetation (fsurdat, months) + InterpMonths1 = months(1) + call t_stopf('readMonthlyVeg') + end if + + end subroutine interpMonthlyVeg + +!----------------------------------------------------------------------- +! read 12 months of veg data for dry deposition +!----------------------------------------------------------------------- + + subroutine readAnnualVegetation ( ) + + use clmtype + use clm_varpar , only : numpft + use pftvarcon , only : noveg + use decompMod , only : get_proc_bounds + use domainMod , only : ldomain + use fileutils , only : getfil + use clm_varctl , only : fsurdat + use shr_scam_mod, only : shr_scam_getCloseLatLon + + implicit none + + ! local vars + + type(file_desc_t) :: ncid ! netcdf id + real(r8), pointer :: annlai(:,:) ! 12 months of monthly lai from input data set + real(r8), pointer :: mlai(:,:) ! lai read from input files + integer :: ier ! error code + character(len=256) :: locfn ! local file name + integer :: g,k,l,m,n,p,ivt ! indices + integer :: ni,nj,ns ! indices + integer :: dimid,varid ! input netCDF id's + integer :: ntim ! number of input data time samples + integer :: nlon_i ! number of input data longitudes + integer :: nlat_i ! number of input data latitudes + integer :: npft_i ! number of input data pft types + integer :: begp,endp ! beg and end local p index + integer :: begg,endg ! beg and end local g index + integer :: closelatidx,closelonidx ! single column vars + real(r8):: closelat,closelon ! single column vars + logical :: isgrid2d ! true => file is 2d + character(len=32) :: subname = 'readAnnualVegetation' + + annlai => pps%annlai + + ! Determine necessary indices + + call get_proc_bounds(begg=begg,endg=endg,begp=begp,endp=endp) + + allocate(mlai(begg:endg,0:numpft), stat=ier) + if (ier /= 0) then + write(iulog,*)subname, 'allocation error '; call endrun() + end if + + if (masterproc) then + write (iulog,*) 'Attempting to read annual vegetation data .....' + end if + + call getfil(fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun() + end if + call check_dim(ncid, 'lsmpft', numpft+1) + + if (single_column) then + call shr_scam_getCloseLatLon(locfn, scmlat, scmlon, & + closelat, closelon, closelatidx, closelonidx) + endif + + do k=1,12 !! loop over months and read vegetated data + + call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, & + dim1name=grlnd, nt=k) + + !! store data directly in clmtype structure + !! only vegetated pfts have nonzero values + !! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] pfts + !! as determined in subroutine surfrd + + do p = begp,endp + g = pft%gridcell(p) + ivt = pft%itype(p) + if (ivt /= noveg) then !! vegetated pft + do l = 0, numpft + if (l == ivt) then + annlai(k,p) = mlai(g,l) + end if + end do + else !! non-vegetated pft + annlai(k,p) = 0._r8 + end if + end do ! end of loop over pfts + + enddo ! months loop + + call ncd_pio_closefile(ncid) + + deallocate(mlai) + + endsubroutine readAnnualVegetation + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: readMonthlyVegetation +! +! !INTERFACE: + subroutine readMonthlyVegetation (fveg, months) +! +! !DESCRIPTION: +! Read monthly vegetation data for two consec. months. +! +! !USES: + use clmtype + use decompMod , only : get_proc_bounds + use clm_varpar , only : numpft + use pftvarcon , only : noveg + use fileutils , only : getfil + use spmdMod , only : masterproc, mpicom, MPI_REAL8, MPI_INTEGER + use shr_scam_mod, only : shr_scam_getCloseLatLon + use clm_time_manager, only : get_nstep + use netcdf +! +! !ARGUMENTS: + implicit none + + character(len=*), intent(in) :: fveg ! file with monthly vegetation data + integer, intent(in) :: months(2) ! months to be interpolated (1 to 12) +! +! !REVISION HISTORY: +! Created by Sam Levis +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: g,n,k,l,m,p,ivt,ni,nj,ns ! indices + integer :: dimid,varid ! input netCDF id's + integer :: ntim ! number of input data time samples + integer :: nlon_i ! number of input data longitudes + integer :: nlat_i ! number of input data latitudes + integer :: npft_i ! number of input data pft types + integer :: begp,endp ! beg and end local p index + integer :: begg,endg ! beg and end local g index + integer :: ier ! error code + integer :: closelatidx,closelonidx + real(r8):: closelat,closelon + logical :: readvar + real(r8), pointer :: mlai(:,:) ! lai read from input files + real(r8), pointer :: msai(:,:) ! sai read from input files + real(r8), pointer :: mhgtt(:,:) ! top vegetation height + real(r8), pointer :: mhgtb(:,:) ! bottom vegetation height + real(r8), pointer :: mlaidiff(:) ! difference between lai month one and month two + character(len=32) :: subname = 'readMonthlyVegetation' +!----------------------------------------------------------------------- + + ! Determine necessary indices + + call get_proc_bounds(begg=begg,endg=endg,begp=begp,endp=endp) + + allocate(mlai(begg:endg,0:numpft), & + msai(begg:endg,0:numpft), & + mhgtt(begg:endg,0:numpft), & + mhgtb(begg:endg,0:numpft), & + stat=ier) + if (ier /= 0) then + write(iulog,*)subname, 'allocation big error '; call endrun() + end if + + ! ---------------------------------------------------------------------- + ! Open monthly vegetation file + ! Read data and convert from gridcell to pft data + ! ---------------------------------------------------------------------- + + call getfil(fveg, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + if (single_column) then + call shr_scam_getCloseLatLon (ncid, scmlat, scmlon, closelat, closelon,& + closelatidx, closelonidx) + endif + + do k=1,2 !loop over months and read vegetated data + + call ncd_io(ncid=ncid, varname='MONTHLY_LAI', flag='read', data=mlai, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: MONTHLY_LAI NOT on fveg file' ) + + call ncd_io(ncid=ncid, varname='MONTHLY_SAI', flag='read', data=msai, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: MONTHLY_SAI NOT on fveg file' ) + + call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', flag='read', data=mhgtt, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file' ) + + call ncd_io(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', flag='read', data=mhgtb, dim1name=grlnd, & + nt=months(k), readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: MONTHLY_HEIGHT_TOP NOT on fveg file' ) + + ! Store data directly in clmtype structure + ! only vegetated pfts have nonzero values + ! Assign lai/sai/hgtt/hgtb to the top [maxpatch_pft] pfts + ! as determined in subroutine surfrd + + do p = begp,endp + g = pft%gridcell(p) + ivt = pft%itype(p) + if (ivt /= noveg) then ! vegetated pft + do l = 0, numpft + if (l == ivt) then + mlai2t(p,k) = mlai(g,l) + msai2t(p,k) = msai(g,l) + mhvt2t(p,k) = mhgtt(g,l) + mhvb2t(p,k) = mhgtb(g,l) + end if + end do + else ! non-vegetated pft + mlai2t(p,k) = 0._r8 + msai2t(p,k) = 0._r8 + mhvt2t(p,k) = 0._r8 + mhvb2t(p,k) = 0._r8 + end if + end do ! end of loop over pfts + + end do ! end of loop over months + + call ncd_pio_closefile(ncid) + + if (masterproc) then + k = 2 + write(iulog,*) 'Successfully read monthly vegetation data for' + write(iulog,*) 'month ', months(k) + write(iulog,*) + end if + + deallocate(mlai, msai, mhgtt, mhgtb) + + mlaidiff => pps%mlaidiff + do p = begp,endp + mlaidiff(p)=mlai2t(p,1)-mlai2t(p,2) + enddo + + end subroutine readMonthlyVegetation + +end module STATICEcosysDynMod diff --git a/components/clm/src_clm40/biogeochem/VOCEmissionMod.F90 b/components/clm/src_clm40/biogeochem/VOCEmissionMod.F90 new file mode 100644 index 0000000000..c225a36d0f --- /dev/null +++ b/components/clm/src_clm40/biogeochem/VOCEmissionMod.F90 @@ -0,0 +1,1023 @@ +module VOCEmissionMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: VOCEmissionMod +! +! !DESCRIPTION: +! Volatile organic compound emission +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varctl, only : iulog + use abortutils, only : endrun + use clm_varpar, only : numpft + use pftvarcon , only : ndllf_evr_tmp_tree, ndllf_evr_brl_tree, & + ndllf_dcd_brl_tree, nbrdlf_evr_trp_tree, & + nbrdlf_evr_tmp_tree, nbrdlf_dcd_brl_shrub, & + nbrdlf_dcd_trp_tree, nbrdlf_dcd_tmp_tree, & + nbrdlf_dcd_brl_tree, nbrdlf_evr_shrub, & + nc3_arctic_grass, nc3crop, & + nc4_grass, noveg + + use shr_megan_mod, only : shr_megan_megcomps_n, shr_megan_megcomp_t, shr_megan_linkedlist + use shr_megan_mod, only : shr_megan_mechcomps_n, shr_megan_mechcomps, shr_megan_mapped_emisfctrs + use MEGANFactorsMod,only : Agro, Amat, Anew, Aold, betaT, ct1, ct2, LDF, Ceo + +! +! !PUBLIC TYPES: + implicit none + save + + logical, parameter :: debug = .false. + +! +! +! !PUBLIC MEMBER FUNCTIONS: + public :: VOCEmission + public :: VOCEmission_init +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: VOCEmission +! +! !INTERFACE: + subroutine VOCEmission (lbp, ubp, num_soilp, filter_soilp ) +! +! ! NEW DESCRIPTION +! Volatile organic compound emission +! This code simulates volatile organic compound emissions following +! MEGAN (Model of Emissions of Gases and Aerosols from Nature) v2.1 +! for 20 compound classes. The original description of this +! algorithm (for isoprene only) can be found in Guenther et al., 2006 +! (we follow equations 2-9, 16-17, 20 for explicit canopy). +! The model scheme came be described as: +! E= epsilon * gamma * rho +! VOC flux (E) [ug m-2 h-1] is calculated from baseline emission +! factors (epsilon) [ug m-2 h-1] which are specified for each of the 16 +! CLM PFTs (in input file) OR in the case of isoprene, from +! mapped EFs for each PFT which reflect species divergence of emissions, +! particularly in North America. +! The emission activity factor (gamma) [unitless] for includes +! dependence on PPFT, temperature, LAI, leaf age and soil moisture. +! For isoprene only we also include the effect of CO2 inhibition as +! described by Heald et al., 2009. +! The canopy environment constant was calculated offline for CLM+CAM at +! standard conditions. +! We assume that the escape efficiency (rho) here is unity following +! Guenther et al., 2006. +! A manuscript describing MEGAN 2.1 and the implementation in CLM is +! in preparation: Guenther, Heald et al., 2012 +! Subroutine written to operate at the patch level. +! +! Input: to be read in with EFs and some parameters. +! Currently these are set in procedure init_EF_params +! Output: vocflx(shr_megan_mechcomps_n) !VOC flux [moles/m2/sec] +! +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_atmlnd , only : clm_a2l + use clmtype + use domainMod, only : ldomain + use clm_varcon , only : spval +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_soilp ! number of columns in soil pft filter + integer, intent(in) :: filter_soilp(num_soilp) ! pft filter for soil +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Sam Levis +! 2/1/02: Peter Thornton: migration to new data structure +! 4/15/06: Colette L. Heald: modify for updated MEGAN model (Guenther et al., 2006) +! 4/29/11: Colette L. Heald: expand MEGAN to 20 compound classes +! 7 Feb 2012: Francis Vitt: Implemented capability to specify MEGAN emissions in namelist +! and read in MEGAN factors from file. +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pgridcell(:) ! gridcell index of corresponding pft + integer , pointer :: pcolumn(:) ! column index of corresponding pft + integer , pointer :: ivt(:) ! pft vegetation type for current + real(r8), pointer :: t_veg(:) ! pft vegetation temperature (Kelvin) + real(r8), pointer :: fsun(:) ! sunlit fraction of canopy + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: clayfrac(:) ! fraction of soil that is clay + real(r8), pointer :: sandfrac(:) ! fraction of soil that is sand + real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (visible only) + real(r8), pointer :: forc_solai(:,:) ! diffuse radiation (visible only) + real(r8), pointer :: elai_p(:) ! one-sided leaf area index from previous timestep + real(r8), pointer :: t_veg24(:) ! avg pft vegetation temperature for last 24 hrs + real(r8), pointer :: t_veg240(:) ! avg pft vegetation temperature for last 240 hrs + real(r8), pointer :: fsun24(:) ! sunlit fraction of canopy last 24 hrs + real(r8), pointer :: fsun240(:) ! sunlit fraction of canopy last 240 hrs + real(r8), pointer :: forc_solad24(:) ! direct beam radiation last 24hrs (visible only) + real(r8), pointer :: forc_solai24(:) ! diffuse radiation last 24hrs (visible only) + real(r8), pointer :: forc_solad240(:) ! direct beam radiation last 240hrs (visible only) + real(r8), pointer :: forc_solai240(:) ! diffuse radiation last 240hrs (visible only) + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (m3/m3) + real(r8), pointer :: h2osoi_ice(:,:) ! ice soil content (kg/m3) + real(r8), pointer :: dz(:,:) ! depth of layer (m) + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" (nlevgrnd) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) (nlevgrnd) + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) (nlevgrnd) + real(r8), pointer :: cisun(:) ! sunlit intracellular CO2 (Pa) + real(r8), pointer :: cisha(:) ! shaded intracellular CO2 (Pa) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: forc_pco2(:) ! CO2 partial pressure +! +! local pointers to original implicit out arrays +! + real(r8), pointer :: vocflx(:,:) ! VOC flux [moles/m2/sec] + real(r8), pointer :: vocflx_tot(:) ! VOC flux [moles/m2/sec] + + type(megan_out_type), pointer :: meg_out(:) ! fluxes for CLM history + + real(r8), pointer :: gamma_out(:) + real(r8), pointer :: gammaT_out(:) + real(r8), pointer :: gammaP_out(:) + real(r8), pointer :: gammaL_out(:) + real(r8), pointer :: gammaA_out(:) + real(r8), pointer :: gammaS_out(:) + real(r8), pointer :: gammaC_out(:) + + real(r8), pointer :: Eopt_out(:) + real(r8), pointer :: topt_out(:) + real(r8), pointer :: alpha_out(:) + real(r8), pointer :: cp_out(:) + real(r8), pointer :: paru_out(:) + real(r8), pointer :: par24u_out(:) + real(r8), pointer :: par240u_out(:) + real(r8), pointer :: para_out(:) + real(r8), pointer :: par24a_out(:) + real(r8), pointer :: par240a_out(:) + +! +! +! !OTHER LOCAL VARIABLES: +! + integer :: fp,p,g,c ! indices + real(r8) :: epsilon ! emission factor [ug m-2 h-1] + real(r8) :: par_sun ! temporary + real(r8) :: par24_sun ! temporary + real(r8) :: par240_sun ! temporary + real(r8) :: par_sha ! temporary + real(r8) :: par24_sha ! temporary + real(r8) :: par240_sha ! temporary + real(r8) :: gamma ! activity factor (accounting for light, T, age, LAI conditions) + real(r8) :: gamma_p ! activity factor for PPFD + real(r8) :: gamma_l ! activity factor for PPFD & LAI + real(r8) :: gamma_t ! activity factor for temperature + real(r8) :: gamma_a ! activity factor for leaf age + real(r8) :: gamma_sm ! activity factor for soil moisture + real(r8) :: gamma_c ! activity factor for CO2 (only isoprene) + + integer :: class_num, n_meg_comps, imech, imeg, ii + character(len=16) :: mech_name + + real(r8) :: vocflx_meg(shr_megan_megcomps_n) + type(shr_megan_megcomp_t), pointer :: meg_cmp + + real(r8) :: cp, alpha, Eopt, topt ! for history output + real(r8) :: co2_ppmv + + ! factor used convert MEGAN units [micro-grams/m2/hr] to CAM srf emis units [g/m2/sec] + real(r8), parameter :: megemis_units_factor = 1._r8/3600._r8/1.e6_r8 + +! real(r8) :: root_depth(0:numpft) ! Root depth [m] +! +!!----------------------------------------------------------------------- +! +! ! root depth (m) (defined based on Zeng et al., 2001, cf Guenther 2006) +! root_depth(noveg) = 0._r8 ! bare-soil +! root_depth(ndllf_evr_tmp_tree:ndllf_evr_brl_tree) = 1.8_r8 ! evergreen tree +! root_depth(ndllf_dcd_brl_tree) = 2.0_r8 ! needleleaf deciduous boreal tree +! root_depth(nbrdlf_evr_trp_tree:nbrdlf_evr_tmp_tree) = 3.0_r8 ! broadleaf evergreen tree +! root_depth(nbrdlf_dcd_trp_tree:nbrdlf_dcd_brl_tree) = 2.0_r8 ! broadleaf deciduous tree +! root_depth(nbrdlf_evr_shrub:nbrdlf_dcd_brl_shrub) = 2.5_r8 ! shrub +! root_depth(nc3_arctic_grass:numpft) = 1.5_r8 ! grass/crop +! +!----------------------------------------------------------------------- + if ( shr_megan_mechcomps_n < 1) return + + ! Assign local pointers to derived type members (gridcell-level) + forc_solad => clm_a2l%forc_solad + forc_solai => clm_a2l%forc_solai + forc_pbot => clm_a2l%forc_pbot + forc_pco2 => clm_a2l%forc_pco2 + + ! Assign local pointers to derived subtypes components (column-level) + h2osoi_vol => cws%h2osoi_vol + h2osoi_ice => cws%h2osoi_ice + dz => cps%dz + bsw => cps%bsw + watsat => cps%watsat + sucsat => cps%sucsat + + ! Assign local pointers to derived subtypes components (pft-level) + + pgridcell => pft%gridcell + pcolumn => pft%column + ivt => pft%itype + t_veg => pes%t_veg + fsun => pps%fsun + elai => pps%elai + clayfrac => pps%clayfrac + sandfrac => pps%sandfrac + + cisun => pps%cisun + cisha => pps%cisha + + vocflx => pvf%vocflx + vocflx_tot => pvf%vocflx_tot + meg_out => pvf%meg + + gammaL_out => pvf%gammaL_out + gammaT_out => pvf%gammaT_out + gammaP_out => pvf%gammaP_out + gammaA_out => pvf%gammaA_out + gammaS_out => pvf%gammaS_out + gammaC_out => pvf%gammaC_out + gamma_out => pvf%gamma_out + + Eopt_out => pvf%Eopt_out + topt_out => pvf%topt_out + alpha_out => pvf%alpha_out + cp_out => pvf%cp_out + paru_out => pvf%paru_out + par24u_out => pvf%par24u_out + par240u_out => pvf%par240u_out + para_out => pvf%para_out + par24a_out => pvf%par24a_out + par240a_out => pvf%par240a_out + + t_veg24 => pvs%t_veg24 + t_veg240 => pvs%t_veg240 + forc_solad24 => pvs%fsd24 + forc_solad240 => pvs%fsd240 + forc_solai24 => pvs%fsi24 + forc_solai240 => pvs%fsi240 + fsun24 => pvs%fsun24 + fsun240 => pvs%fsun240 + elai_p => pvs%elai_p + + ! initialize variables which get passed to the atmosphere + vocflx(lbp:ubp,:) = 0._r8 + vocflx_tot(lbp:ubp) = 0._r8 + + do imeg=1,shr_megan_megcomps_n + meg_out(imeg)%flux_out(lbp:ubp) = 0._r8 + enddo + + gamma_out(lbp:ubp) = spval + gammaP_out(lbp:ubp) = spval + gammaT_out(lbp:ubp) = spval + gammaA_out(lbp:ubp) = spval + gammaS_out(lbp:ubp) = spval + gammaL_out(lbp:ubp) = spval + gammaC_out(lbp:ubp) = spval + + paru_out(lbp:ubp) = spval + par24u_out(lbp:ubp) = spval + par240u_out(lbp:ubp) = spval + + para_out(lbp:ubp) = spval + par24a_out(lbp:ubp) = spval + par240a_out(lbp:ubp) = spval + + alpha_out(lbp:ubp) = spval + cp_out(lbp:ubp) = spval + + topt_out(lbp:ubp) = spval + Eopt_out(lbp:ubp) = spval + + ! Begin loop over points + !_______________________________________________________________________________ + do fp = 1,num_soilp + p = filter_soilp(fp) + g = pgridcell(p) + c = pcolumn(p) + + ! initialize EF + epsilon=0._r8 + + ! initalize to zero since this might not alway get set + ! this needs to be within the fp loop ... + vocflx_meg(:) = 0._r8 + + ! calculate VOC emissions for non-bare ground PFTs + if (ivt(p) > 0) then + gamma=0._r8 + + ! Calculate PAR: multiply w/m2 by 4.6 to get umol/m2/s for par (added 8/14/02) + !------------------------ + ! SUN: + par_sun = (forc_solad(g,1) + fsun(p) * forc_solai(g,1)) * 4.6_r8 + par24_sun = (forc_solad24(p) + fsun24(p) * forc_solai24(p)) * 4.6_r8 + par240_sun = (forc_solad240(p) + fsun240(p) * forc_solai240(p)) * 4.6_r8 + ! SHADE: + par_sha = ((1._r8 - fsun(p)) * forc_solai(g,1)) * 4.6_r8 + par24_sha = ((1._r8 - fsun24(p)) * forc_solai24(p)) * 4.6_r8 + par240_sha = ((1._r8 - fsun240(p)) * forc_solai240(p)) * 4.6_r8 + + ! Activity factor for LAI (Guenther et al., 2006): all species + gamma_l = get_gamma_L(fsun240(p), elai(p)) + + ! Activity factor for soil moisture: all species (commented out for now) +! gamma_sm = get_gamma_SM(clayfrac(p), sandfrac(p), h2osoi_vol(c,:), h2osoi_ice(c,:), & +! dz(c,:), bsw(c,:), watsat(c,:), sucsat(c,:), root_depth(ivt(p))) + gamma_sm = 1.0_r8 + + ! Loop through VOCs for light, temperature and leaf age activity factor & apply + ! all final activity factors to baseline emission factors + !_______________________________________________________________________________ + + ! loop over megan compounds + meg_cmp => shr_megan_linkedlist + meg_cmp_loop: do while(associated(meg_cmp)) + imeg = meg_cmp%index + + ! set emis factor + ! if specified, set EF for isoprene with mapped values + if ( trim(meg_cmp%name) == 'isoprene' .and. shr_megan_mapped_emisfctrs) then + epsilon = get_map_EF(ivt(p),g) + else + epsilon = meg_cmp%emis_factors(ivt(p)) + end if + + class_num = meg_cmp%class_number + + ! Activity factor for PPFD + gamma_p = get_gamma_P(par_sun, par24_sun, par240_sun, par_sha, par24_sha, par240_sha, & + fsun(p), fsun240(p), forc_solad240(p),forc_solai240(p), LDF(class_num), cp, alpha) + + ! Activity factor for T + gamma_t = get_gamma_T(t_veg240(p), t_veg24(p),t_veg(p), ct1(class_num), ct2(class_num),& + betaT(class_num),LDF(class_num), Ceo(class_num), Eopt, topt) + + ! Activity factor for Leaf Age + gamma_a = get_gamma_A(ivt(p), elai_p(p),elai(p),class_num) + + ! Activity factor for CO2 (only for isoprene) + if (trim(meg_cmp%name) == 'isoprene') then + co2_ppmv = 1.e6*forc_pco2(g)/forc_pbot(g) + gamma_c = get_gamma_C(cisun(p),cisha(p),forc_pbot(g),fsun(p), co2_ppmv) + else + gamma_c = 1._r8 + end if + + ! Calculate total scaling factor + gamma = gamma_l * gamma_sm * gamma_a * gamma_p * gamma_T * gamma_c + + if ( (gamma >=0.0_r8) .and. (gamma< 100._r8) ) then + + vocflx_meg(imeg) = epsilon * gamma * megemis_units_factor / meg_cmp%molec_weight ! moles/m2/sec + + ! assign to arrays for history file output (not weighted by landfrac) + meg_out(imeg)%flux_out(p) = meg_out(imeg)%flux_out(p) & + + epsilon * gamma * megemis_units_factor*1.e-3_r8 ! Kg/m2/sec + + if (imeg==1) then + ! + gamma_out(p)=gamma + gammaP_out(p)=gamma_p + gammaT_out(p)=gamma_t + gammaA_out(p)=gamma_a + gammaS_out(p)=gamma_sm + gammaL_out(p)=gamma_l + gammaC_out(p)=gamma_c + + paru_out(p)=par_sun + par24u_out(p)=par24_sun + par240u_out(p)=par240_sun + + para_out(p)=par_sha + par24a_out(p)=par24_sha + par240a_out(p)=par240_sha + + alpha_out(p)=alpha + cp_out(p)=cp + + topt_out(p)=topt + Eopt_out(p)=Eopt + + end if + endif + + if (debug .and. gamma > 0.0_r8) then + write(iulog,*) 'MEGAN: n, megan name, epsilon, gamma, vocflx: ', & + imeg, meg_cmp%name, epsilon, gamma, vocflx_meg(imeg), gamma_p,gamma_t,gamma_a,gamma_sm,gamma_l + endif + + meg_cmp => meg_cmp%next_megcomp + enddo meg_cmp_loop + + ! sum up the megan compound fluxes for the fluxes of chem mechanism compounds + do imech = 1,shr_megan_mechcomps_n + n_meg_comps = shr_megan_mechcomps(imech)%n_megan_comps + do imeg = 1,n_meg_comps ! loop over number of megan compounds that make up the nth mechanism compoud + ii = shr_megan_mechcomps(imech)%megan_comps(imeg)%ptr%index + vocflx(p,imech) = vocflx(p,imech) + vocflx_meg(ii) + enddo + vocflx_tot(p) = vocflx_tot(p) + vocflx(p,imech) ! moles/m2/sec + enddo + + end if ! ivt(1:15 only) + + enddo ! fp + + end subroutine VOCEmission +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! !IROUTINE: init_EF_params +! +! !INTERFACE: + subroutine VOCEmission_init( ) + ! Interface to set all input parameters for 20 VOC compound classes. + ! including EFs for 16(+1 bare ground) PFTs. + ! For now set all specified values, in future to be replaced with values read in from file. + ! (heald, 04/27/11) + + use shr_megan_mod, only : shr_megan_factors_file + use MEGANFactorsMod, only : megan_factors_init, megan_factors_get + +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! +! !USES +! +! !ARGUMENTS: + implicit none + +! character(len=*),intent(in) :: filename +! +! !LOCAL VARIABLES: +!----------------------------------------------------------------------- + + integer :: nmech, nmeg + type(shr_megan_megcomp_t), pointer :: meg_cmp + + integer :: class_num + real(r8) :: factors(numpft) + real(r8) :: molec_wght + + if ( shr_megan_mechcomps_n < 1) return + + call megan_factors_init( shr_megan_factors_file ) + + meg_cmp => shr_megan_linkedlist + do while(associated(meg_cmp)) + allocate(meg_cmp%emis_factors(numpft)) + call megan_factors_get( trim(meg_cmp%name), factors, class_num, molec_wght ) + meg_cmp%emis_factors = factors + meg_cmp%class_number = class_num + meg_cmp%molec_weight = molec_wght + meg_cmp => meg_cmp%next_megcomp + enddo + + end subroutine VOCEmission_init +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_map_EF +! +! !INTERFACE: +function get_map_EF(ivt_in,g_in) +! +! Get mapped EF for isoprene +! Use gridded values for 6 PFTs specified by MEGAN following +! Guenther et al. (2006). Map the numpft CLM PFTs to these 6. +! Units: [ug m-2 h-1] +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! + +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: + + ! varibles in + integer, intent(in) :: ivt_in + integer, intent(in) :: g_in + real(r8) :: get_map_EF + + real(r8), pointer :: efisop(:,:) ! emission factors for isoprene for each pft [ug m-2 h-1] + + ! assign local pointer + efisop => gve%efisop +!----------------------------------------------------------------------- + get_map_EF = 0._r8 + + if ( ivt_in == ndllf_evr_tmp_tree & + .or. ivt_in == ndllf_evr_brl_tree) then !fineleaf evergreen + get_map_EF = efisop(2,g_in) + else if (ivt_in == ndllf_dcd_brl_tree) then !fineleaf deciduous + get_map_EF = efisop(3,g_in) + else if (ivt_in >= nbrdlf_evr_trp_tree & + .and. ivt_in <= nbrdlf_dcd_brl_tree) then !broadleaf trees + get_map_EF = efisop(1,g_in) + else if (ivt_in >= nbrdlf_evr_shrub & + .and. ivt_in <= nbrdlf_dcd_brl_shrub) then !shrubs + get_map_EF = efisop(4,g_in) + else if (ivt_in >= nc3_arctic_grass & + .and. ivt_in <= nc4_grass) then !grass + get_map_EF = efisop(5,g_in) + else if (ivt_in >= nc3crop) then !crops + get_map_EF =efisop(6,g_in) + end if + +end function get_map_EF +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_P +! +! !INTERFACE: + function get_gamma_P(par_sun_in, par24_sun_in, par240_sun_in, par_sha_in, par24_sha_in, par240_sha_in, & + fsun_in, fsun240_in, forc_solad240_in,forc_solai240_in, LDF_in, cp, alpha) + +! Activity factor for PPFD (Guenther et al., 2006): all light dependent species +!------------------------- +! With distinction between sunlit and shaded leafs, weight scalings by +! fsun and fshade +! Scale total incident par by fraction of sunlit leaves (added on 1/2002) + +! fvitt -- forc_solad240, forc_solai240 can be zero when CLM finidat is specified +! which will cause par240 to be zero and produce NaNs via log(par240) +! dml -- fsun240 can be equal to or greater than one before 10 day averages are +! set on startup or if a new pft comes online during land cover change. +! Avoid this problem by only doing calculations with fsun240 when fsun240 is +! between 0 and 1 +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: par_sun_in + real(r8),intent(in) :: par24_sun_in + real(r8),intent(in) :: par240_sun_in + real(r8),intent(in) :: par_sha_in + real(r8),intent(in) :: par24_sha_in + real(r8),intent(in) :: par240_sha_in + real(r8),intent(in) :: fsun_in + real(r8),intent(in) :: fsun240_in + real(r8),intent(in) :: forc_solad240_in + real(r8),intent(in) :: forc_solai240_in + real(r8),intent(in) :: LDF_in + + real(r8),intent(out) :: cp ! temporary + real(r8),intent(out) :: alpha ! temporary + real(r8) :: gamma_p_LDF ! activity factor for PPFD + real(r8) :: get_gamma_P ! return value + + real(r8), parameter :: ca1 = 0.004_r8 ! empirical coefficent for alpha + real(r8), parameter :: ca2 = 0.0005_r8 ! empirical coefficent for alpha + real(r8), parameter :: ca3 = 0.0468_r8 ! empirical coefficent for cp + real(r8), parameter :: par0_sun = 200._r8 ! std conditions for past 24 hrs [umol/m2/s] + real(r8), parameter :: par0_shade = 50._r8 ! std conditions for past 24 hrs [umol/m2/s] + real(r8), parameter :: alpha_fix = 0.001_r8 ! empirical coefficient + real(r8), parameter :: cp_fix = 1.21_r8 ! empirical coefficient +! +! local pointers to implicit in arguments +! +!----------------------------------------------------------------------- + + if ( (fsun240_in > 0._r8) .and. (fsun240_in < 1._r8) .and. (forc_solad240_in > 0._r8) & + .and. (forc_solai240_in > 0._r8)) then + ! With alpha and cp calculated based on eq 6 and 7: + ! Note indexing for accumulated variables is all at pft level + ! SUN: + alpha = ca1 - ca2 * log(par240_sun_in) + cp = ca3 * exp(ca2 * (par24_sun_in-par0_sun))*par240_sun_in**(0.6_r8) + gamma_p_LDF = fsun_in * ( cp * alpha * par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) ) + ! SHADE: + alpha = ca1 - ca2 * log(par240_sha_in) + cp = ca3 * exp(ca2 * (par_sha_in-par0_shade))*par240_sha_in**(0.6_r8) + gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8)) + else + ! With fixed alpha and cp (from MEGAN User's Guide): + ! SUN: direct + diffuse + alpha = alpha_fix + cp = cp_fix + gamma_p_LDF = fsun_in * ( cp * alpha*par_sun_in * (1._r8 + alpha*alpha*par_sun_in*par_sun_in)**(-0.5_r8) ) + ! SHADE: diffuse + gamma_p_LDF = gamma_p_LDF + (1._r8-fsun_in) * (cp*alpha*par_sha_in*(1._r8 + alpha*alpha*par_sha_in*par_sha_in)**(-0.5_r8)) + end if + + ! Calculate total activity factor for PPFD accounting for light-dependent fraction + get_gamma_P = (1._r8 - LDF_in) + LDF_in * gamma_p_LDF + +end function get_gamma_P +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_L +! +! !INTERFACE: +function get_gamma_L(fsun240_in,elai_in) +! +! Activity factor for LAI (Guenther et al., 2006): all species +! Guenther et al., 2006 eq 3 +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! + +! !USES: + use clm_varcon , only : denice + use clm_varpar , only : nlevsoi +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: fsun240_in + real(r8),intent(in) :: elai_in + real(r8) :: get_gamma_L ! return value + + + ! parameters + real(r8), parameter :: cce = 0.30_r8 ! factor to set emissions to unity @ std + real(r8), parameter :: cce1 = 0.24_r8 ! same as Cce but for non-accumulated vars +!----------------------------------------------------------------------- + if ( (fsun240_in > 0.0_r8) .and. (fsun240_in < 1.e30_r8) ) then + get_gamma_L = cce * elai_in + else + get_gamma_L = cce1 * elai_in + end if + +end function get_gamma_L +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_SM +! +! !INTERFACE: +function get_gamma_SM(clayfrac_in, sandfrac_in, h2osoi_vol_in, h2osoi_ice_in, dz_in, & + bsw_in, watsat_in, sucsat_in, root_depth_in) +! +! Activity factor for soil moisture (Guenther et al., 2006): all species +!---------------------------------- +! Calculate the mean scaling factor throughout the root depth. +! wilting point potential is in units of matric potential (mm) +! (1 J/Kg = 0.001 MPa, approx = 0.1 m) +! convert to volumetric soil water using equation 7.118 of the CLM4 Technical Note +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! + +! !USES: + use clm_varcon , only : denice + use clm_varpar , only : nlevsoi +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: clayfrac_in + real(r8),intent(in) :: sandfrac_in + real(r8),intent(in) :: h2osoi_vol_in(nlevsoi) + real(r8),intent(in) :: h2osoi_ice_in(nlevsoi) + real(r8),intent(in) :: dz_in(nlevsoi) + real(r8),intent(in) :: bsw_in(nlevsoi) + real(r8),intent(in) :: watsat_in(nlevsoi) + real(r8),intent(in) :: sucsat_in(nlevsoi) + real(r8),intent(in) :: root_depth_in + + real(r8) :: get_gamma_SM + + ! local variables + integer :: j + real(r8) :: nl ! temporary number of soil levels + real(r8) :: theta_ice ! water content in ice in m3/m3 + real(r8) :: wilt ! wilting point in m3/m3 + real(r8) :: theta1 ! temporary + + ! parameters + real(r8), parameter :: deltheta1=0.06_r8 ! empirical coefficient + real(r8), parameter :: smpmax = 2.57e5_r8 ! maximum soil matrix potential + + if ((clayfrac_in > 0) .and. (sandfrac_in > 0)) then + get_gamma_SM = 0._r8 + nl=0._r8 + + do j = 1,nlevsoi + if (sum(dz_in(1:j)) < root_depth_in) then + theta_ice = h2osoi_ice_in(j)/(dz_in(j)*denice) + wilt = ((smpmax/sucsat_in(j))**(-1._r8/bsw_in(j))) * (watsat_in(j) - theta_ice) + theta1 = wilt + deltheta1 + if (h2osoi_vol_in(j) >= theta1) then + get_gamma_SM = get_gamma_SM + 1._r8 + else if ( (h2osoi_vol_in(j) > wilt) .and. (h2osoi_vol_in(j) < theta1) ) then + get_gamma_SM = get_gamma_SM + ( h2osoi_vol_in(j) - wilt ) / deltheta1 + else + get_gamma_SM = get_gamma_SM + 0._r8 + end if + nl=nl+1._r8 + end if + end do + + if (nl > 0._r8) then + get_gamma_SM = get_gamma_SM/nl + endif + + if (get_gamma_SM > 1.0_r8) then + write(iulog,*) 'healdSM > 1: gamma_SM, nl', get_gamma_SM, nl + get_gamma_SM=1.0_r8 + endif + + else + get_gamma_SM = 1.0_r8 + end if + + +end function get_gamma_SM +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_T +! +! !INTERFACE: +function get_gamma_T(t_veg240_in, t_veg24_in,t_veg_in, ct1_in, ct2_in, betaT_in, LDF_in, Ceo_in, Eopt, topt) + +! Activity factor for temperature +!-------------------------------- +! Calculate both a light-dependent fraction as in Guenther et al., 2006 for isoprene +! of a max saturation type form. Also caculate a light-independent fraction of the +! form of an exponential. Final activity factor depends on light dependent fraction +! of compound type. +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: t_veg240_in + real(r8),intent(in) :: t_veg24_in + real(r8),intent(in) :: t_veg_in + real(r8),intent(in) :: ct1_in + real(r8),intent(in) :: ct2_in + real(r8),intent(in) :: betaT_in + real(r8),intent(in) :: LDF_in + real(r8),intent(in) :: Ceo_in + real(r8),intent(out) :: Eopt ! temporary + real(r8),intent(out) :: topt ! temporary + + ! local variables + real(r8) :: get_gamma_T + real(r8) :: gamma_t_LDF ! activity factor for temperature + real(r8) :: gamma_t_LIF ! activity factor for temperature + real(r8) :: x ! temporary + + ! parameters + real(r8), parameter :: co1 = 313._r8 ! empirical coefficient + real(r8), parameter :: co2 = 0.6_r8 ! empirical coefficient + real(r8), parameter :: co4 = 0.05_r8 ! empirical coefficient + real(r8), parameter :: tstd0 = 297_r8 ! std temperature [K] + real(r8), parameter :: topt_fix = 317._r8 ! std temperature [K] + real(r8), parameter :: Eopt_fix = 2.26_r8 ! empirical coefficient + real(r8), parameter :: ct3 = 0.00831_r8 ! empirical coefficient (0.0083 in User's Guide) + real(r8), parameter :: tstd = 303.15_r8 ! std temperature [K] + real(r8), parameter :: bet = 0.09_r8 ! beta empirical coefficient [K-1] +!----------------------------------------------------------------------- + + ! Light dependent fraction (Guenther et al., 2006) + if ( (t_veg240_in > 0.0_r8) .and. (t_veg240_in < 1.e30_r8) ) then + ! topt and Eopt from eq 8 and 9: + topt = co1 + (co2 * (t_veg240_in-tstd0)) + Eopt = Ceo_in * exp (co4 * (t_veg24_in-tstd0)) * exp(co4 * (t_veg240_in -tstd0)) + else + topt = topt_fix + Eopt = Eopt_fix + endif + x = ( (1._r8/topt) - (1._r8/(t_veg_in)) ) / ct3 + gamma_t_LDF = Eopt * ( ct2_in * exp(ct1_in * x)/(ct2_in - ct1_in * (1._r8 - exp(ct2_in * x))) ) + + + ! Light independent fraction (of exp(beta T) form) + gamma_t_LIF = exp(betaT_in * (t_veg_in - tstd)) + + ! Calculate total activity factor for light as a function of light-dependent fraction + !-------------------------------- + get_gamma_T = (1-LDF_in)*gamma_T_LIF + LDF_in*gamma_T_LDF + +end function get_gamma_T +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_A +! +! !INTERFACE: +function get_gamma_A(ivt_in, elai_p_in,elai_in,nclass_in) + +! Activity factor for leaf age (Guenther et al., 2006) +!----------------------------- +! If not CNDV elai is constant therefore gamma_a=1.0 +! gamma_a set to unity for evergreens (PFTs 1, 2, 4, 5) +! Note that we assume here that the time step is shorter than the number of +!days after budbreak required to induce isoprene emissions (ti=12 days) and +! the number of days after budbreak to reach peak emission (tm=28 days) +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (4/27/11) +! +! !ARGUMENTS: + implicit none +! !LOCAL VARIABLES: + + ! varibles in + integer,intent(in) :: ivt_in + integer,intent(in) :: nclass_in + real(r8),intent(in) :: elai_p_in + real(r8),intent(in) :: elai_in + + real(r8) :: get_gamma_A + + ! local variables + real(r8) :: elai_prev ! lai for previous timestep + real(r8) :: fnew, fgro, fmat, fold ! fractions of leaves at different phenological stages + !----------------------------------------------------------------------- + if ( (ivt_in == ndllf_dcd_brl_tree) .or. (ivt_in >= nbrdlf_dcd_trp_tree) ) then ! non-evergreen + + if ( (elai_p_in > 0.0_r8) .and. (elai_p_in < 1.e30_r8) )then + elai_prev = 2._r8*elai_p_in-elai_in ! have accumulated average lai over last timestep + if (elai_prev == elai_in) then + fnew = 0.0_r8 + fgro = 0.0_r8 + fmat = 1.0_r8 + fold = 0.0_r8 + else if (elai_prev > elai_in) then + fnew = 0.0_r8 + fgro = 0.0_r8 + fmat = 1.0_r8 - (elai_prev - elai_in)/elai_prev + fold = (elai_prev - elai_in)/elai_prev + else if (elai_prev < elai_in) then + fnew = 1 - (elai_prev / elai_in) + fgro = 0.0_r8 + fmat = (elai_prev / elai_in) + fold = 0.0_r8 + end if + + get_gamma_A = fnew*Anew(nclass_in) + fgro*Agro(nclass_in) + fmat*Amat(nclass_in) + fold*Aold(nclass_in) + + else + get_gamma_A = 1.0_r8 + end if + + else + get_gamma_A = 1.0_r8 + end if + + + end function get_gamma_A +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! FUNCTION: get_gamma_C +! +! !INTERFACE: + function get_gamma_C(cisun_in,cisha_in,forc_pbot_in,fsun_in, co2_ppmv) + +! Activity factor for instantaneous CO2 changes (Heald et al., 2009) +!------------------------- +! With distinction between sunlit and shaded leaves, weight scalings by +! fsun and fshade +! +! !CALLED FROM: VOCEmission +! +! !REVISION HISTORY: +! Author: Colette L. Heald (11/30/11) +! Louisa K. Emmons (16/03/2015) - implement Colette's intended code +! and use atmosphere CO2 (not nml setting) +! +! !USES: +! use clm_varctl, only : co2_ppmv ! corresponds to CCSM_CO2_PPMV set in env_conf.xml +! +! !ARGUMENTS: + implicit none +! !LOCAL VARIABLES: + + ! varibles in + real(r8),intent(in) :: cisun_in + real(r8),intent(in) :: cisha_in + real(r8),intent(in) :: forc_pbot_in + real(r8),intent(in) :: fsun_in + real(r8),intent(in) :: co2_ppmv + + real(r8) :: get_gamma_C + + ! local variables + real(r8) :: Ismax ! empirical coeff for CO2 + real(r8) :: h ! empirical coeff for CO2 + real(r8) :: Cstar ! empirical coeff for CO2 + real(r8) :: fint ! interpolation fraction for CO2 + real(r8) :: ci ! temporary sunlight/shade weighted cisun & cisha (umolCO2/mol) + real(r8) :: gamma_ci ! short-term exposure gamma + real(r8) :: gamma_ca ! long-term exposure gamma + !----------------------------------------------------------------------- + + + ! LONG-TERM EXPOSURE (based on ambient CO2, Ca) + !----------------------------------------------------------------------------- + gamma_ca = 1.344_r8 - ( (1.344_r8*(0.7_r8*co2_ppmv)**1.4614_r8)/(585._r8**1.4614_r8+(0.7_r8*co2_ppmv)**1.4614_r8) ) + + + ! SHORT-TERM EXPOSURE (based on intercellular CO2, Ci) + !----------------------------------------------------------------------------- + ! Determine long-term CO2 growth environment (ie. ambient CO2) and interpolate + ! parameters + if ( co2_ppmv < 400._r8 ) then + Ismax = 1.072_r8 + h = 1.70_r8 + Cstar = 1218._r8 + else if ( (co2_ppmv > 400._r8) .and. (co2_ppmv < 600._r8) ) then + fint = (co2_ppmv - 400._r8)/200._r8 + Ismax = fint*1.036_r8 + (1.- fint)*1.072_r8 + h = fint*2.0125_r8 + (1.- fint)*1.70_r8 + Cstar = fint*1150._r8 + (1.- fint)*1218._r8 + else if ( (co2_ppmv > 600._r8) .and. (co2_ppmv < 800._r8) ) then + fint = (co2_ppmv - 600._r8)/200._r8 + Ismax = fint*1.046_r8 + (1.- fint)*1.036_r8 + h = fint*1.5380_r8 + (1.- fint)*2.0125_r8 + Cstar = fint*2025._r8 + (1.- fint)*1150._r8 + else if ( co2_ppmv > 800._r8 ) then + Ismax = 1.014_r8 + h = 2.861_r8 + Cstar = 1525._r8 + end if + + ! Intercellular CO2 concentrations (ci) given in Pa, divide by atmos + ! pressure to get mixing ratio (umolCO2/mol) + if ( (cisun_in .gt. 0._r8) .and. (cisha_in .gt. 0._r8) .and. & + (cisun_in .eq. cisun_in) .and. (cisha_in .eq. cisha_in) .and. (forc_pbot_in > 0._r8) .and. (fsun_in > 0._r8) ) then + ci = ( fsun_in*cisun_in + (1._r8-fsun_in)*cisha_in )/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else if ( (cisun_in > 0.0_r8) .and. (cisun_in < 1.e30_r8) .and. (forc_pbot_in > 0._r8) .and. (fsun_in .eq. 1._r8) ) then + ci = cisun_in/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else if ( (cisha_in > 0.0_r8) .and. (cisha_in < 1.e30_r8) .and. (forc_pbot_in > 0._r8) .and. (fsun_in .eq. 0._r8) ) then + ci = cisha_in/forc_pbot_in * 1.e6_r8 + gamma_ci = Ismax - ( (Ismax*ci**h)/(Cstar**h+ci**h) ) + else + gamma_ci = 1._r8 + end if + + get_gamma_C = gamma_ci * gamma_ca + + end function get_gamma_C +!----------------------------------------------------------------------- + +end module VOCEmissionMod + + diff --git a/components/clm/src_clm40/biogeophys/BalanceCheckMod.F90 b/components/clm/src_clm40/biogeophys/BalanceCheckMod.F90 new file mode 100644 index 0000000000..980690ff0c --- /dev/null +++ b/components/clm/src_clm40/biogeophys/BalanceCheckMod.F90 @@ -0,0 +1,735 @@ +module BalanceCheckMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: BalanceCheckMod +! +! !DESCRIPTION: +! Water and energy balance check. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only: endrun + use clm_varctl, only: iulog +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: BeginWaterBalance ! Initialize water balance check + public :: BalanceCheck ! Water and energy balance check +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BeginWaterBalance +! +! !INTERFACE: + subroutine BeginWaterBalance(lbc, ubc, lbp, ubp, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + num_hydrologyc, filter_hydrologyc) +! +! !DESCRIPTION: +! Initialize column-level water balance at beginning of time step +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_varpar , only : nlevgrnd, nlevsoi + use subgridAveMod, only : p2c + use clm_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, & + icol_road_imperv +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_lakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_lakec(ubc-lbc+1) ! column filter for non-lake points + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in variables +! + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: h2ocan_pft(:) ! canopy water (mm H2O) (pft-level) + real(r8), pointer :: wa(:) ! water in the unconfined aquifer (mm) + integer , pointer :: ctype(:) ! column type + real(r8), pointer :: zwt(:) ! water table depth (m) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) +! +! local pointers to original implicit out variables +! + real(r8), pointer :: h2ocan_col(:) ! canopy water (mm H2O) (column level) + real(r8), pointer :: begwb(:) ! water mass begining of the time step +! +! !OTHER LOCAL VARIABLES: +! + integer :: c, p, f, j, fc ! indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (column-level) + + h2osno => cws%h2osno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + begwb => cwbal%begwb + h2ocan_col => pws_a%h2ocan + wa => cws%wa + ctype => col%itype + zwt => cws%zwt + zi => cps%zi + + ! Assign local pointers to derived type members (pft-level) + + h2ocan_pft => pws%h2ocan + + ! Determine beginning water balance for time step + ! pft-level canopy water averaged to column + call p2c(num_nolakec, filter_nolakec, h2ocan_pft, h2ocan_col) + + do f = 1, num_hydrologyc + c = filter_hydrologyc(f) + if(zwt(c) <= zi(c,nlevsoi)) then + wa(c) = 5000._r8 + end if + end do + + do f = 1, num_nolakec + c = filter_nolakec(f) + if (ctype(c) == icol_roof .or. ctype(c) == icol_sunwall & + .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_road_imperv) then + begwb(c) = h2ocan_col(c) + h2osno(c) + else + begwb(c) = h2ocan_col(c) + h2osno(c) + wa(c) + end if + end do + do j = 1, nlevgrnd + do f = 1, num_nolakec + c = filter_nolakec(f) + begwb(c) = begwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end do + end do + + do f = 1, num_lakec + c = filter_lakec(f) + begwb(c) = h2osno(c) + end do + + end subroutine BeginWaterBalance +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BalanceCheck +! +! !INTERFACE: + subroutine BalanceCheck(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg) +! +! !DESCRIPTION: +! This subroutine accumulates the numerical truncation errors of the water +! and energy balance calculation. It is helpful to see the performance of +! the process of integration. +! +! The error for energy balance: +! +! error = abs(Net radiation - change of internal energy - Sensible heat +! - Latent heat) +! +! The error for water balance: +! +! error = abs(precipitation - change of water storage - evaporation - runoff) +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use subgridAveMod + use clm_time_manager , only : get_step_size, get_nstep + use clm_varcon , only : isturb, icol_roof, icol_sunwall, icol_shadewall, & + spval, icol_road_perv, icol_road_imperv, istice_mec, & + istdlak, istslak, istwet, istcrop, istsoil + use clm_varctl , only : glc_dyntopo +! +! !ARGUMENTS: + implicit none + integer :: lbp, ubp ! pft-index bounds + integer :: lbc, ubc ! column-index bounds + integer :: lbl, ubl ! landunit-index bounds + integer :: lbg, ubg ! grid-index bounds +! +! !CALLED FROM: +! subroutine clm_driver +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 10 November 2000: Mariana Vertenstein +! Migrated to new data structures by Mariana Vertenstein and +! Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + logical , pointer :: do_capsnow(:) ! true => do snow capping + real(r8), pointer :: qflx_floodc(:) ! total runoff due to flooding + real(r8), pointer :: qflx_snow_melt(:) ! snow melt (net) + real(r8), pointer :: qflx_rain_grnd_col(:) ! rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_col(:) ! snow on ground after interception (mm H2O/s) [+] + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: cgridcell(:) ! column's gridcell index + integer , pointer :: clandunit(:) ! column's landunit index + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: ctype(:) ! column type + real(r8), pointer :: pwtgcell(:) ! pft's weight relative to corresponding gridcell + real(r8), pointer :: cwtgcell(:) ! column's weight relative to corresponding gridcell + real(r8), pointer :: forc_rain(:) ! rain rate [mm/s] + real(r8), pointer :: forc_snow(:) ! snow rate [mm/s] + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + real(r8), pointer :: endwb(:) ! water mass end of the time step + real(r8), pointer :: begwb(:) ! water mass begining of the time step + real(r8), pointer :: fsa(:) ! solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsr(:) ! solar radiation reflected (W/m**2) + real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net(:) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: sabv(:) ! solar radiation absorbed by vegetation (W/m**2) + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: eflx_sh_tot(:) ! total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_totg(:) ! total sensible heat flux at grid level (W/m**2) [+ to atm] + real(r8), pointer :: eflx_dynbal(:) ! energy conversion flux due to dynamic land cover change(W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot(:) ! total latent heat flux (W/m8*2) [+ to atm] + real(r8), pointer :: eflx_soil_grnd(:) ! soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: qflx_irrig(:) ! irrigation flux (mm H2O /s) + real(r8), pointer :: qflx_surf(:) ! surface runoff (mm H2O /s) + real(r8), pointer :: qflx_qrgwl(:) ! qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_drain(:) ! sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_runoff(:) ! total runoff (mm H2O /s) + real(r8), pointer :: qflx_runoffg(:) ! total runoff at gridcell level inc land cover change flux (mm H2O /s) + real(r8), pointer :: qflx_liq_dynbal(:) ! liq runoff due to dynamic land cover change (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice(:) ! excess snowfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: qflx_glcice(:) ! flux of new glacier ice (mm H2O /s) [+ if ice grows] + real(r8), pointer :: qflx_glcice_frz(:) ! ice growth (mm H2O/s) [+] + real(r8), pointer :: qflx_snwcp_iceg(:) ! excess snowfall due to snow cap inc land cover change flux (mm H20/s) + real(r8), pointer :: qflx_ice_dynbal(:) ! ice runoff due to dynamic land cover change (mm H2O /s) + real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (vis=forc_sols , nir=forc_soll ) + real(r8), pointer :: forc_solai(:,:) ! diffuse radiation (vis=forc_solsd, nir=forc_solld) + real(r8), pointer :: eflx_traffic_pft(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_pft(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width + real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: h2osno_old(:) ! snow water (mm H2O) at previous time step + real(r8), pointer :: qflx_dew_snow(:) ! surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow(:) ! sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_top_soil(:) ! net water input into soil from top (mm/s) + real(r8), pointer :: qflx_dew_grnd(:) ! ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: qflx_evap_grnd(:) ! ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_prec_grnd(:) ! water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_snwcp_liq(:) ! excess liquid water due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: qflx_sl_top_soil(:) ! liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + integer , pointer :: snl(:) ! number of snow layers +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: errh2o(:) ! water conservation error (mm H2O) + real(r8), pointer :: errsol(:) ! solar radiation conservation error (W/m**2) + real(r8), pointer :: errlon(:) ! longwave radiation conservation error (W/m**2) + real(r8), pointer :: errseb(:) ! surface energy conservation error (W/m**2) + real(r8), pointer :: netrad(:) ! net radiation (positive downward) (W/m**2) + real(r8), pointer :: errsoi_col(:) ! column-level soil/lake energy conservation error (W/m**2) + real(r8), pointer :: snow_sources(:) ! snow sources (mm H2O /s) + real(r8), pointer :: snow_sinks(:) ! snow sinks (mm H2O /s) + real(r8), pointer :: errh2osno(:) ! error in h2osno (kg m-2) +! +!EOP +! +! !OTHER LOCAL VARIABLES: + integer :: p,c,l,g ! indices + real(r8) :: dtime ! land model time step (sec) + integer :: nstep ! time step number + logical :: found ! flag in search loop + integer :: indexp,indexc,indexl,indexg ! index of first found in search loop + real(r8) :: forc_rain_col(lbc:ubc) ! column level rain rate [mm/s] + real(r8) :: forc_snow_col(lbc:ubc) ! column level snow rate [mm/s] + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type scalar members (gridcell-level) + + do_capsnow => cps%do_capsnow + qflx_floodc => cwf%qflx_floodc + qflx_snow_melt => cwf%qflx_snow_melt + qflx_rain_grnd_col => pwf_a%qflx_rain_grnd + qflx_snow_grnd_col => pwf_a%qflx_snow_grnd + clandunit => col%landunit + forc_rain => clm_a2l%forc_rain + forc_snow => clm_a2l%forc_snow + forc_lwrad => clm_a2l%forc_lwrad + forc_solad => clm_a2l%forc_solad + forc_solai => clm_a2l%forc_solai + + ! Assign local pointers to derived type scalar members (landunit-level) + + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + + ! Assign local pointers to derived type scalar members (column-level) + + ctype => col%itype + cgridcell => col%gridcell + cwtgcell => col%wtgcell + endwb => cwbal%endwb + begwb => cwbal%begwb + qflx_irrig => cwf%qflx_irrig + qflx_surf => cwf%qflx_surf + qflx_qrgwl => cwf%qflx_qrgwl + qflx_drain => cwf%qflx_drain + qflx_runoff => cwf%qflx_runoff + qflx_snwcp_ice => pwf_a%qflx_snwcp_ice + qflx_evap_tot => pwf_a%qflx_evap_tot + qflx_glcice => cwf%qflx_glcice + qflx_glcice_frz => cwf%qflx_glcice_frz + errh2o => cwbal%errh2o + errsoi_col => cebal%errsoi + h2osno => cws%h2osno + h2osno_old => cws%h2osno_old + qflx_dew_snow => pwf_a%qflx_dew_snow + qflx_sub_snow => pwf_a%qflx_sub_snow + qflx_top_soil => cwf%qflx_top_soil + qflx_evap_grnd => pwf_a%qflx_evap_grnd + qflx_dew_grnd => pwf_a%qflx_dew_grnd + qflx_prec_grnd => pwf_a%qflx_prec_grnd + qflx_snwcp_liq => pwf_a%qflx_snwcp_liq + qflx_sl_top_soil => cwf%qflx_sl_top_soil + snow_sources => cws%snow_sources + snow_sinks => cws%snow_sinks + errh2osno => cws%errh2osno + snl => cps%snl + + ! Assign local pointers to derived type scalar members (pft-level) + + pgridcell => pft%gridcell + plandunit => pft%landunit + pwtgcell => pft%wtgcell + fsa => pef%fsa + fsr => pef%fsr + eflx_lwrad_out => pef%eflx_lwrad_out + eflx_lwrad_net => pef%eflx_lwrad_net + sabv => pef%sabv + sabg => pef%sabg + eflx_sh_tot => pef%eflx_sh_tot + eflx_lh_tot => pef%eflx_lh_tot + eflx_soil_grnd => pef%eflx_soil_grnd + errsol => pebal%errsol + errseb => pebal%errseb + errlon => pebal%errlon + netrad => pef%netrad + eflx_wasteheat_pft => pef%eflx_wasteheat_pft + eflx_heat_from_ac_pft => pef%eflx_heat_from_ac_pft + eflx_traffic_pft => pef%eflx_traffic_pft + + ! Assign local pointers to derived type scalar members (gridcell-level) + + qflx_runoffg => gwf%qflx_runoffg + qflx_liq_dynbal => gwf%qflx_liq_dynbal + qflx_snwcp_iceg => gwf%qflx_snwcp_iceg + qflx_ice_dynbal => gwf%qflx_ice_dynbal + eflx_sh_totg => gef%eflx_sh_totg + eflx_dynbal => gef%eflx_dynbal + + ! Get step size and time step + + nstep = get_nstep() + dtime = get_step_size() + + ! Determine column level incoming snow and rain + ! Assume no incident precipitation on urban wall columns (as in Hydrology1Mod.F90). + + do c = lbc,ubc + g = cgridcell(c) + if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall) then + forc_rain_col(c) = 0. + forc_snow_col(c) = 0. + else + forc_rain_col(c) = forc_rain(g) + forc_snow_col(c) = forc_snow(g) + end if + end do + + ! Water balance check + + do c = lbc, ubc + g = cgridcell(c) + l = clandunit(c) + + ! Note: Some glacier_mec cols may have zero weight + if (cwtgcell(c) > 0._r8 .or. ltype(l)==istice_mec)then + errh2o(c) = endwb(c) - begwb(c) & + - (forc_rain_col(c) + forc_snow_col(c) + qflx_irrig(c) + qflx_floodc(c) & + - qflx_evap_tot(c) - qflx_surf(c) & + - qflx_qrgwl(c) - qflx_drain(c) - qflx_snwcp_ice(c)) * dtime + + ! Suppose glc_dyntopo = T: + ! (1) We have qflx_snwcp_ice = 0, and excess snow has been incorporated in qflx_glcice. + ! This flux must be included here to complete the water balance. + ! (2) Meltwater from ice is allowed to run off and is included in qflx_qrgwl, + ! but the water content of the ice column has not changed (at least for now) because + ! an equivalent ice mass has been "borrowed" from the base of the column. That + ! meltwater is included in qflx_glcice. + ! + ! Note that qflx_glcice is only valid over ice_mec landunits; elsewhere it is spval + + if (glc_dyntopo .and. ltype(l)==istice_mec) then + errh2o(c) = errh2o(c) + qflx_glcice(c)*dtime + end if + + else + + errh2o(c) = 0.0_r8 + + end if + + end do + + found = .false. + do c = lbc, ubc + if (abs(errh2o(c)) > 1e-7_r8) then + found = .true. + indexc = c + end if + end do + if ( found ) then + write(iulog,*)'WARNING: water balance error ',& + ' nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc),' landunit type= ',ltype(clandunit(indexc)) + if ((ctype(indexc) .eq. icol_roof .or. ctype(indexc) .eq. icol_road_imperv .or. & + ctype(indexc) .eq. icol_road_perv) .and. abs(errh2o(indexc)) > 1.e-1 .and. (nstep > 2) ) then + write(iulog,*)'clm urban model is stopping - error is greater than 1.e-1' + write(iulog,*)'nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc) + write(iulog,*)'ctype(indexc): ',ctype(indexc) + write(iulog,*)'forc_rain = ',forc_rain_col(indexc) + write(iulog,*)'forc_snow = ',forc_snow_col(indexc) + write(iulog,*)'endwb = ',endwb(indexc) + write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'qflx_evap_tot= ',qflx_evap_tot(indexc) + write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc) + write(iulog,*)'qflx_surf = ',qflx_surf(indexc) + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc) + write(iulog,*)'qflx_drain = ',qflx_drain(indexc) + write(iulog,*)'qflx_flood = ',qflx_floodc(indexc) + write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc) + write(iulog,*)'clm model is stopping' + call endrun() + else if (abs(errh2o(indexc)) > .10_r8 .and. (nstep > 2) ) then + write(iulog,*)'clm model is stopping - error is greater than .10' + write(iulog,*)'nstep = ',nstep,' indexc= ',indexc,' errh2o= ',errh2o(indexc) + write(iulog,*)'ctype(indexc): ',ctype(indexc) + write(iulog,*)'forc_rain = ',forc_rain_col(indexc) + write(iulog,*)'forc_snow = ',forc_snow_col(indexc) + write(iulog,*)'endwb = ',endwb(indexc) + write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'qflx_evap_tot= ',qflx_evap_tot(indexc) + write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc) + write(iulog,*)'qflx_surf = ',qflx_surf(indexc) + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc) + write(iulog,*)'qflx_drain = ',qflx_drain(indexc) + write(iulog,*)'qflx_flood = ',qflx_floodc(indexc) + write(iulog,*)'qflx_snwcp_ice = ',qflx_snwcp_ice(indexc) + write(iulog,*)'clm model is stopping' + call endrun() + end if + end if + + ! Snow balance check + do c = lbc, ubc + g = cgridcell(c) + l = clandunit(c) + ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at + ! any given time step but only if there is at least one snow layer. h2osno + ! also includes snow that is part of the soil column (an initial snow layer is + ! only created if h2osno > 10mm). + + ! --------------------------------------------------------------------- ! + ! SPM - brought in qflx_snow_melt to get snow + ! balance working after the flooding modifications were in place. + ! This new check is based on a perfrostsims branch of S. Swenson. + ! --------------------------------------------------------------------- ! + + if (snl(c) .lt. 0) then + snow_sources(c) = qflx_prec_grnd(c) + qflx_dew_snow(c) + qflx_dew_grnd(c) + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) + qflx_snow_melt(c) & + + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) + qflx_sl_top_soil(c) + + if (ltype(l) == istdlak) then + if ( do_capsnow(c) ) then + snow_sources(c) = qflx_snow_grnd_col(c) & + + qflx_dew_snow(c) + qflx_dew_grnd(c) + + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) & + + (qflx_snwcp_ice(c) + qflx_snwcp_liq(c) - qflx_prec_grnd(c)) & + + qflx_snow_melt(c) + qflx_sl_top_soil(c) + else + snow_sources(c) = qflx_snow_grnd_col(c) & + + qflx_rain_grnd_col(c) & + + qflx_dew_snow(c) + qflx_dew_grnd(c) + + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) & + + qflx_snow_melt(c) + qflx_sl_top_soil(c) + endif + endif + + if (ltype(l) == istsoil .or. ltype(l) == istcrop .or. ltype(l) == istwet ) then + if ( do_capsnow(c) ) then + snow_sources(c) = qflx_dew_snow(c) + qflx_dew_grnd(c) & + + qflx_prec_grnd(c) + + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) & + + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & + + qflx_snow_melt(c) + qflx_sl_top_soil(c) + else + snow_sources(c) = qflx_snow_grnd_col(c) & + + qflx_rain_grnd_col(c) & + + qflx_dew_snow(c) + qflx_dew_grnd(c) + + snow_sinks(c) = qflx_sub_snow(c) + qflx_evap_grnd(c) & + + qflx_snow_melt(c) + qflx_sl_top_soil(c) + endif + endif + + if (ltype(l) == istice_mec .and. glc_dyntopo) then + snow_sinks(c) = snow_sinks(c) + qflx_glcice_frz(c) + end if + + errh2osno(c) = (h2osno(c) - h2osno_old(c)) - (snow_sources(c) - snow_sinks(c)) * dtime + else + snow_sources(c) = 0._r8 + snow_sinks(c) = 0._r8 + errh2osno(c) = 0._r8 + end if + end do + + found = .false. + do c = lbc, ubc + if (cwtgcell(c) > 0._r8 .and. abs(errh2osno(c)) > 1.0e-7_r8) then + found = .true. + indexc = c + end if + end do + + if ( found ) then + write(iulog,*)'WARNING: snow balance error ',& + ' nstep = ',nstep,' indexc= ',indexc,' errh2osno= ',errh2osno(indexc) + if (abs(errh2osno(indexc)) > 0.1_r8 .and. (nstep > 2) ) then + write(iulog,*)'clm model is stopping - error is greater than .10' + write(iulog,*)'nstep = ',nstep,' indexc= ',indexc,' errh2osno= ',errh2osno(indexc) + write(iulog,*)'ltype: ', ltype(clandunit(indexc)) + write(iulog,*)'ctype(indexc): ',ctype(indexc) + write(iulog,*)'snl: ',snl(indexc) + write(iulog,*)'h2osno: ',h2osno(indexc) + write(iulog,*)'h2osno_old: ',h2osno_old(indexc) + write(iulog,*)'snow_sources: ', snow_sources(indexc) + write(iulog,*)'snow_sinks: ', snow_sinks(indexc) + write(iulog,*)'qflx_prec_grnd: ',qflx_prec_grnd(indexc)*dtime + write(iulog,*)'qflx_sub_snow: ',qflx_sub_snow(indexc)*dtime + write(iulog,*)'qflx_evap_grnd: ',qflx_evap_grnd(indexc)*dtime + write(iulog,*)'qflx_top_soil: ',qflx_top_soil(indexc)*dtime + write(iulog,*)'qflx_dew_snow: ',qflx_dew_snow(indexc)*dtime + write(iulog,*)'qflx_dew_grnd: ',qflx_dew_grnd(indexc)*dtime + write(iulog,*)'qflx_snwcp_ice: ',qflx_snwcp_ice(indexc)*dtime + write(iulog,*)'qflx_snow_melt: ',qflx_snow_melt(indexc)*dtime + write(iulog,*)'qflx_snwcp_liq: ',qflx_snwcp_liq(indexc)*dtime + write(iulog,*)'qflx_sl_top_soil: ',qflx_sl_top_soil(indexc)*dtime + write(iulog,*)'qflx_glcice_frz: ',qflx_glcice_frz(indexc)*dtime + write(iulog,*)'clm model is stopping' + call endrun() + end if + end if + + ! Energy balance checks + + do p = lbp, ubp + l = plandunit(p) + ! Note: Some glacier_mec pfts may have zero weight + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + g = pgridcell(p) + + ! Solar radiation energy balance + ! Do not do this check for an urban pft since it will not balance on a per-column + ! level because of interactions between columns and since a separate check is done + ! in the urban radiation module + if (ltype(l) /= isturb) then + errsol(p) = fsa(p) + fsr(p) & + - (forc_solad(g,1) + forc_solad(g,2) + forc_solai(g,1) + forc_solai(g,2)) + else + errsol(p) = spval + end if + + ! Longwave radiation energy balance + ! Do not do this check for an urban pft since it will not balance on a per-column + ! level because of interactions between columns and since a separate check is done + ! in the urban radiation module + if (ltype(l) /= isturb) then + errlon(p) = eflx_lwrad_out(p) - eflx_lwrad_net(p) - forc_lwrad(g) + else + errlon(p) = spval + end if + + ! Surface energy balance + ! Changed to using (eflx_lwrad_net) here instead of (forc_lwrad - eflx_lwrad_out) because + ! there are longwave interactions between urban columns (and therefore pfts). + ! For surfaces other than urban, (eflx_lwrad_net) equals (forc_lwrad - eflx_lwrad_out), + ! and a separate check is done above for these terms. + + if (ltype(l) /= isturb) then + errseb(p) = sabv(p) + sabg(p) + forc_lwrad(g) - eflx_lwrad_out(p) & + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) + else + errseb(p) = sabv(p) + sabg(p) & + - eflx_lwrad_net(p) & + - eflx_sh_tot(p) - eflx_lh_tot(p) - eflx_soil_grnd(p) & + + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p) + end if + netrad(p) = fsa(p) - eflx_lwrad_net(p) + end if + end do + + ! Solar radiation energy balance check + + found = .false. + do p = lbp, ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + if ( (errsol(p) /= spval) .and. (abs(errsol(p)) > .10_r8) ) then + found = .true. + indexp = p + indexg = pgridcell(p) + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,100)'BalanceCheck: solar radiation balance error', nstep, indexp, errsol(indexp) + write(iulog,*)'fsa = ',fsa(indexp) + write(iulog,*)'fsr = ',fsr(indexp) + write(iulog,*)'forc_solad(1)= ',forc_solad(indexg,1) + write(iulog,*)'forc_solad(2)= ',forc_solad(indexg,2) + write(iulog,*)'forc_solai(1)= ',forc_solai(indexg,1) + write(iulog,*)'forc_solai(2)= ',forc_solai(indexg,2) + write(iulog,*)'forc_tot = ',forc_solad(indexg,1)+forc_solad(indexg,2)& + +forc_solai(indexg,1)+forc_solai(indexg,2) + write(iulog,*)'clm model is stopping' + call endrun() + end if + + ! Longwave radiation energy balance check + + found = .false. + do p = lbp, ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + if ( (errlon(p) /= spval) .and. (abs(errlon(p)) > .10_r8) ) then + found = .true. + indexp = p + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,100)'BalanceCheck: longwave enery balance error',nstep,indexp,errlon(indexp) + write(iulog,*)'clm model is stopping' + call endrun() + end if + + ! Surface energy balance check + + found = .false. + do p = lbp, ubp + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + if (abs(errseb(p)) > .10_r8 ) then + found = .true. + indexp = p + end if + end if + end do + if ( found .and. (nstep > 2) ) then + write(iulog,100)'BalanceCheck: surface flux energy balance error',nstep,indexp,errseb(indexp) + write(iulog,*)' sabv = ',sabv(indexp) + write(iulog,*)' sabg = ',sabg(indexp) + write(iulog,*)' eflx_lwrad_net = ',eflx_lwrad_net(indexp) + write(iulog,*)' eflx_sh_tot = ',eflx_sh_tot(indexp) + write(iulog,*)' eflx_lh_tot = ',eflx_lh_tot(indexp) + write(iulog,*)' eflx_soil_grnd = ',eflx_soil_grnd(indexp) + write(iulog,*)'clm model is stopping' + call endrun() + end if + + ! Soil energy balance check + + found = .false. + do c = lbc, ubc + if (abs(errsoi_col(c)) > 1.0e-7_r8 ) then + found = .true. + indexc = c + end if + end do + if ( found ) then + write(iulog,100)'BalanceCheck: soil balance error',nstep,indexc,errsoi_col(indexc) + if (abs(errsoi_col(indexc)) > .10_r8 .and. (nstep > 2) ) then + write(iulog,*)'clm model is stopping' + call endrun() + end if + end if + + ! Update SH and RUNOFF for dynamic land cover change energy and water fluxes + call c2g( lbc, ubc, lbl, ubl, lbg, ubg, & + qflx_runoff(lbc:ubc), qflx_runoffg(lbg:ubg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + do g = lbg, ubg + qflx_runoffg(g) = qflx_runoffg(g) - qflx_liq_dynbal(g) + enddo + + call c2g( lbc, ubc, lbl, ubl, lbg, ubg, & + qflx_snwcp_ice(lbc:ubc), qflx_snwcp_iceg(lbg:ubg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + do g = lbg, ubg + qflx_snwcp_iceg(g) = qflx_snwcp_iceg(g) - qflx_ice_dynbal(g) + enddo + + call p2g( lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg, & + eflx_sh_tot(lbp:ubp), eflx_sh_totg(lbg:ubg), & + p2c_scale_type='unity',c2l_scale_type='urbanf',l2g_scale_type='unity') + do g = lbg, ubg + eflx_sh_totg(g) = eflx_sh_totg(g) - eflx_dynbal(g) + enddo + +100 format (1x,a,' nstep =',i10,' point =',i6,' imbalance =',f12.6,' W/m2') +200 format (1x,a,' nstep =',i10,' point =',i6,' imbalance =',f12.6,' mm') + + end subroutine BalanceCheck + +end module BalanceCheckMod diff --git a/components/clm/src_clm40/biogeophys/BareGroundFluxesMod.F90 b/components/clm/src_clm40/biogeophys/BareGroundFluxesMod.F90 new file mode 100644 index 0000000000..3e7ea8c815 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/BareGroundFluxesMod.F90 @@ -0,0 +1,441 @@ +module BareGroundFluxesMod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: BareGroundFluxesMod +! +! !DESCRIPTION: +! Compute sensible and latent fluxes and their derivatives with respect +! to ground temperature using ground temperatures from previous time step. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: BareGroundFluxes ! Calculate sensible and latent heat fluxes +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: BareGroundFluxes +! +! !INTERFACE: + subroutine BareGroundFluxes(lbp, ubp, num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! Compute sensible and latent fluxes and their derivatives with respect +! to ground temperature using ground temperatures from previous time step. +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varpar , only : nlevgrnd + use clm_varcon , only : cpair, vkc, grav, denice, denh2o, istsoil + use clm_varcon , only : istcrop + use clm_varctl , only : use_c13 + use shr_const_mod , only : SHR_CONST_RGAS + use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni + use QSatMod , only : QSat + +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_nolakep ! number of pft non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine Biogeophysics1 in module Biogeophysics1Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 12/19/01, Peter Thornton +! This routine originally had a long list of parameters, and also a reference to +! the entire clm derived type. For consistency, only the derived type reference +! is passed (now pointing to the current column and pft), and the other original +! parameters are initialized locally. Using t_grnd instead of tg (tg eliminated +! as redundant). +! 1/23/02, PET: Added pft reference as parameter. All outputs will be written +! to the pft data structures, and averaged to the column level outside of +! this routine. +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1) [-] + real(r8), pointer :: t_grnd(:) ! ground surface temperature [K] + real(r8), pointer :: thm(:) ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft) + real(r8), pointer :: qg(:) ! specific humidity at ground surface [kg/kg] + real(r8), pointer :: thv(:) ! virtual potential temperature (kelvin) + real(r8), pointer :: dqgdT(:) ! temperature derivative of "qg" + real(r8), pointer :: htvp(:) ! latent heat of evaporation (/sublimation) [J/kg] + real(r8), pointer :: beta(:) ! coefficient of conective velocity [-] + real(r8), pointer :: zii(:) ! convective boundary height [m] + real(r8), pointer :: forc_u(:) ! atmospheric wind speed in east direction (m/s) + real(r8), pointer :: forc_v(:) ! atmospheric wind speed in north direction (m/s) + real(r8), pointer :: forc_t(:) ! atmospheric temperature (Kelvin) + real(r8), pointer :: forc_th(:) ! atmospheric potential temperature (Kelvin) + real(r8), pointer :: forc_q(:) ! atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_rho(:) ! density (kg/m**3) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft level [m] + real(r8), pointer :: psnsun(:) ! sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) ! shaded leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: z0mg_col(:) ! roughness length, momentum [m] + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: soilbeta(:) ! soil wetness relative to field capacity +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: z0hg_col(:) ! roughness length, sensible heat [m] + real(r8), pointer :: z0qg_col(:) ! roughness length, latent heat [m] +! +! local pointers to implicit out arguments +! + real(r8), pointer :: dlrad(:) ! downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad(:) ! upward longwave radiation above the canopy [W/m2] + real(r8), pointer :: cgrnds(:) ! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] + real(r8), pointer :: cgrndl(:) ! deriv of soil latent heat flux wrt soil temp [w/m**2/k] + real(r8), pointer :: cgrnd(:) ! deriv. of soil energy flux wrt to soil temp [w/m2/k] + real(r8), pointer :: taux(:) ! wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy(:) ! wind (shear) stress: n-s (kg/m/s**2) + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot(:) ! total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: q_ref2m(:) ! 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: t_ref2m_r(:) ! Rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: rh_ref2m_r(:) ! Rural 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m(:) ! 2 m height surface relative humidity (%) + real(r8), pointer :: t_veg(:) ! vegetation temperature (Kelvin) + real(r8), pointer :: btran(:) ! transpiration wetness factor (0 to 1) + real(r8), pointer :: rssun(:) ! sunlit stomatal resistance (s/m) + real(r8), pointer :: rssha(:) ! shaded stomatal resistance (s/m) + real(r8), pointer :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: fpsn(:) ! photosynthesis (umol CO2 /m**2 /s) + real(r8), pointer :: rootr(:,:) ! effective fraction of roots in each soil layer + real(r8), pointer :: rresis(:,:) ! root resistance by layer (0-1) (nlevgrnd) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer, parameter :: niters = 3 ! maximum number of iterations for surface temperature + integer :: p,c,g,f,j,l ! indices + integer :: filterp(ubp-lbp+1) ! pft filter for vegetated pfts + integer :: fn ! number of values in local pft filter + integer :: fp ! lake filter pft index + integer :: iter ! iteration index + real(r8) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] + real(r8) :: displa(lbp:ubp) ! displacement height [m] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface + real(r8) :: obu(lbp:ubp) ! Monin-Obukhov length (m) + real(r8) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(r8) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(r8) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(r8) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(r8) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(r8) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: cf ! heat transfer coefficient from leaves [-] + real(r8) :: ram ! aerodynamical resistance [s/m] + real(r8) :: rah ! thermal resistance [s/m] + real(r8) :: raw ! moisture resistance [s/m] + real(r8) :: raih ! temporary variable [kg/m2/s] + real(r8) :: raiw ! temporary variable [kg/m2/s] + real(r8) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: z0mg_pft(lbp:ubp) + real(r8) :: z0hg_pft(lbp:ubp) + real(r8) :: z0qg_pft(lbp:ubp) + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + real(r8) :: www ! surface soil wetness [-] +!------------------------------------------------------------------------------ + + ! Assign local pointers to derived type members (gridcell-level) + + forc_u => clm_a2l%forc_u + forc_v => clm_a2l%forc_v + + ! Assign local pointers to derived type members (landunit-level) + + ltype => lun%itype + + ! Assign local pointers to derived type members (column-level) + + forc_th => ces%forc_th + forc_t => ces%forc_t + forc_pbot => cps%forc_pbot + forc_rho => cps%forc_rho + forc_q => cws%forc_q + pcolumn => pft%column + pgridcell => pft%gridcell + frac_veg_nosno => pps%frac_veg_nosno + dlrad => pef%dlrad + ulrad => pef%ulrad + t_grnd => ces%t_grnd + qg => cws%qg + z0mg_col => cps%z0mg + z0hg_col => cps%z0hg + z0qg_col => cps%z0qg + thv => ces%thv + beta => cps%beta + zii => cps%zii + ram1 => pps%ram1 + cgrnds => pef%cgrnds + cgrndl => pef%cgrndl + cgrnd => pef%cgrnd + dqgdT => cws%dqgdT + htvp => cps%htvp + watsat => cps%watsat + h2osoi_ice => cws%h2osoi_ice + dz => cps%dz + h2osoi_liq => cws%h2osoi_liq + frac_sno => cps%frac_sno + soilbeta => cws%soilbeta + + ! Assign local pointers to derived type members (pft-level) + + taux => pmf%taux + tauy => pmf%tauy + eflx_sh_grnd => pef%eflx_sh_grnd + eflx_sh_tot => pef%eflx_sh_tot + qflx_evap_soi => pwf%qflx_evap_soi + qflx_evap_tot => pwf%qflx_evap_tot + t_ref2m => pes%t_ref2m + q_ref2m => pes%q_ref2m + t_ref2m_r => pes%t_ref2m_r + rh_ref2m_r => pes%rh_ref2m_r + plandunit => pft%landunit + rh_ref2m => pes%rh_ref2m + t_veg => pes%t_veg + thm => pes%thm + btran => pps%btran + rssun => pps%rssun + rssha => pps%rssha + rootr => pps%rootr + rresis => pps%rresis + psnsun => pcf%psnsun + psnsha => pcf%psnsha + fpsn => pcf%fpsn + forc_hgt_u_pft => pps%forc_hgt_u_pft + + ! Filter pfts where frac_veg_nosno is zero + + fn = 0 + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (frac_veg_nosno(p) == 0) then + fn = fn + 1 + filterp(fn) = p + end if + end do + + ! Compute sensible and latent fluxes and their derivatives with respect + ! to ground temperature using ground temperatures from previous time step + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + ! Initialization variables + + displa(p) = 0._r8 + dlrad(p) = 0._r8 + ulrad(p) = 0._r8 + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-t_grnd(c) + dqh(p) = forc_q(c) - qg(c) + dthv = dth(p)*(1._r8+0.61_r8*forc_q(c))+0.61_r8*forc_th(c)*dqh(p) + zldis(p) = forc_hgt_u_pft(p) + + ! Copy column roughness to local pft-level arrays + + z0mg_pft(p) = z0mg_col(c) + z0hg_pft(p) = z0hg_col(c) + z0qg_pft(p) = z0qg_col(c) + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg_pft(p), um(p), obu(p)) + + end do + + ! Perform stability iteration + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + do iter = 1, niters + + call FrictionVelocity(lbp, ubp, fn, filterp, & + displa, z0mg_pft, z0hg_pft, z0qg_pft, & + obu, iter, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm) + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + z0hg_pft(p) = z0mg_pft(p)/exp(0.13_r8 * (ustar(p)*z0mg_pft(p)/1.5e-5_r8)**0.45_r8) + z0qg_pft(p) = z0hg_pft(p) + thvstar = tstar*(1._r8+0.61_r8*forc_q(c)) + 0.61_r8*forc_th(c)*qstar + zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta(c)*(-grav*ustar(p)*thvstar*zii(c)/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p) + wc*wc) + end if + obu(p) = zldis(p)/zeta + end do + + end do ! end stability iteration + + do j = 1, nlevgrnd + do f = 1, fn + p = filterp(f) + rootr(p,j) = 0._r8 + rresis(p,j) = 0._r8 + end do + end do + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + l = plandunit(p) + + ! Determine aerodynamic resistances + + ram = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah = 1._r8/(temp1(p)*ustar(p)) + raw = 1._r8/(temp2(p)*ustar(p)) + raih = forc_rho(c)*cpair/rah + + ! Soil evaporation resistance + www = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1)/watsat(c,1) + www = min(max(www,0.0_r8),1._r8) + + !changed by K.Sakaguchi. Soilbeta is used for evaporation + if (dqh(p) .gt. 0._r8) then !dew (beta is not applied, just like rsoil used to be) + raiw = forc_rho(c)/(raw) + else + ! Lee and Pielke 1992 beta is applied + raiw = soilbeta(c)*forc_rho(c)/(raw) + end if + + ram1(p) = ram !pass value to global variable + + ! Output to pft-level data structures + ! Derivative of fluxes with respect to ground temperature + + cgrnds(p) = raih + cgrndl(p) = raiw*dqgdT(c) + cgrnd(p) = cgrnds(p) + htvp(c)*cgrndl(p) + + ! Surface fluxes of momentum, sensible and latent heat + ! using ground temperatures from previous time step + + taux(p) = -forc_rho(c)*forc_u(g)/ram + tauy(p) = -forc_rho(c)*forc_v(g)/ram + eflx_sh_grnd(p) = -raih*dth(p) + eflx_sh_tot(p) = eflx_sh_grnd(p) + qflx_evap_soi(p) = -raiw*dqh(p) + qflx_evap_tot(p) = qflx_evap_soi(p) + + ! 2 m height air temperature + + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + + ! 2 m height specific humidity + + q_ref2m(p) = forc_q(c) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(c), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + rh_ref2m_r(p) = rh_ref2m(p) + t_ref2m_r(p) = t_ref2m(p) + end if + + ! Variables needed by history tape + + t_veg(p) = forc_t(c) + btran(p) = 0._r8 + cf = forc_pbot(c)/(SHR_CONST_RGAS*0.001_r8*thm(p))*1.e06_r8 + rssun(p) = 1._r8/1.e15_r8 * cf + rssha(p) = 1._r8/1.e15_r8 * cf + + ! Add the following to avoid NaN + + psnsun(p) = 0._r8 + psnsha(p) = 0._r8 + fpsn(p) = 0._r8 + pps%lncsun(p) = 0._r8 + pps%lncsha(p) = 0._r8 + pps%vcmxsun(p) = 0._r8 + pps%vcmxsha(p) = 0._r8 + ! adding code for isotopes, 8/17/05, PET + pps%cisun(p) = 0._r8 + pps%cisha(p) = 0._r8 + if (use_c13) then + pps%alphapsnsun(p) = 0._r8 + pps%alphapsnsha(p) = 0._r8 + pepv%rc13_canair(p) = 0._r8 + pepv%rc13_psnsun(p) = 0._r8 + pepv%rc13_psnsha(p) = 0._r8 + pc13f%psnsun(p) = 0._r8 + pc13f%psnsha(p) = 0._r8 + pc13f%fpsn(p) = 0._r8 + end if + + end do + + end subroutine BareGroundFluxes + +end module BareGroundFluxesMod diff --git a/components/clm/src_clm40/biogeophys/BiogeophysRestMod.F90 b/components/clm/src_clm40/biogeophys/BiogeophysRestMod.F90 new file mode 100644 index 0000000000..811f727c0b --- /dev/null +++ b/components/clm/src_clm40/biogeophys/BiogeophysRestMod.F90 @@ -0,0 +1,2137 @@ +module BiogeophysRestMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: BiogeophysRestMod +! +! !DESCRIPTION: +! Reads from or biogeophysics restart/initial data +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use spmdMod , only : masterproc +! +! !PUBLIC TYPES: + implicit none + + private +! save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: BiogeophysRest +! +! !REVISION HISTORY: +! 2005-06-12: Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + private :: weights_exactly_the_same + private :: weights_within_roundoff_different + private :: weights_tooDifferent + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BiogeophysRest +! +! !INTERFACE: + subroutine BiogeophysRest( ncid, flag ) +! +! !DESCRIPTION: +! Read/Write biogeophysics information to/from restart file. +! +! !USES: + use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int + use clmtype + use decompMod , only : get_proc_bounds + use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, nlevurb + use clm_varcon , only : istcrop + use clm_varcon , only : denice, denh2o, istdlak, istslak, isturb, & + istsoil, pondmx, watmin, spval + use clm_varctl , only : allocate_all_vegpfts, nsrest, flanduse_timeseries, & + iulog, nsrContinue, nsrStartup, nsrBranch, & + use_cndv, use_cn, use_snicar_frc + use initSurfAlbMod , only : do_initsurfalb + use clm_time_manager, only : is_first_step + use SNICARMod , only : snw_rds_min + use shr_infnan_mod , only : shr_infnan_isnan + use clm_time_manager, only : is_restart +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*), intent(in) :: flag ! 'read' or 'write' +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! 12/11/2003, Peter Thornton: Added cps%coszen, pps%gdir, and pps%omega +! for new sunlit/shaded canopy algorithm (in SUNSHA ifdef block) +! 4/25/2005, Peter Thornton: Removed the SUNSHA ifdefs, since this is now the +! default code behavior. +! 6/12/2005, Moved to netcdf format and renamed file +! +! +! !LOCAL VARIABLES: +!EOP +! +! local pointers to implicit in arguments +! + real(r8) :: maxwatsat !maximum porosity + real(r8) :: excess !excess volumetric soil water + real(r8) :: totwat !total soil water (mm) + real(r8) :: maxdiff !maximum difference in PFT weights + real(r8), pointer :: wtgcell(:) ! Grid cell weights for PFT + real(r8), pointer :: wtlunit(:) ! Land-unit weights for PFT + real(r8), pointer :: wtcol(:) ! Column weights for PFT + integer :: p,c,l,g,j ! indices + integer :: nlevs ! number of layers + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + logical :: readvar ! determine if variable is on initial file + character(len=128) :: varname ! temporary + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ltype(:) ! landunit type + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + real(r8), pointer :: temp2d(:,:) ! temporary for zisno + real(r8), parameter :: adiff = 5.e-04_r8 ! tolerance of acceptible difference + character(len=7) :: filetypes(0:3) + character(len=32) :: fileusing + character(len=*), parameter :: sub="BiogeophysRest" +!----------------------------------------------------------------------- + filetypes(:) = "missing" + filetypes(nsrStartup) = "finidat" + filetypes(nsrContinue) = "restart" + filetypes(nsrBranch) = "nrevsn" + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + ltype => lptr%itype + clandunit => cptr%landunit + clandunit => cptr%landunit + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! + ! Read in weights if allocating all vegetation types + ! + + if (allocate_all_vegpfts) then + + ! pft weight wrt gridcell + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='PFT_WTGCELL', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding gridcell', units='') + else if (flag == 'read' .or. flag == 'write') then + ! Copy weights calculated from fsurdat/flanduse_timeseries to temp array for comparision + ! Don't read directly into temp array -- so that answers are identical with clm3.6.58. EBK 1/9/2010 + if (flag == 'read' )then + allocate( wtgcell(begp:endp) ) + wtgcell(:) = pptr%wtgcell(:) + end if + call ncd_io(varname='PFT_WTGCELL', data=pptr%wtgcell, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft weight wrt landunit + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='PFT_WTLUNIT', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding landunit', units='') + else if (flag == 'read' .or. flag == 'write') then + ! Copy weights calculated from fsurdat/flanduse_timeseries to temp array for comparision + ! Don't read directly into temp array -- so that answers are identical with clm3.6.58. EBK 1/9/2010 + if (flag == 'read' )then + allocate( wtlunit(begp:endp) ) + wtlunit(:) = pptr%wtlunit(:) + end if + call ncd_io(varname='PFT_WTLUNIT', data=pptr%wtlunit, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft weight wrt column + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='PFT_WTCOL', xtype=ncd_double, & + dim1name='pft', & + long_name='pft weight relative to corresponding column', units='') + else if (flag == 'read' .or. flag == 'write') then + ! Copy weights calculated from fsurdat/flanduse_timeseries to temp array for comparision + ! Don't read directly into temp array -- so that answers are identical with clm3.6.58. EBK 1/9/2010 + if (flag == 'read' )then + allocate( wtcol(begp:endp) ) + wtcol(:) = pptr%wtcol(:) + end if + call ncd_io(varname='PFT_WTCOL', data=pptr%wtcol, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + if (flag == 'read' )then + + if ( flanduse_timeseries /= ' ' )then + fileusing = "fsurdat/flanduse_timeseries" + else + fileusing = "fsurdat" + end if + ! + ! Note: Do not compare weights if restart or if dynamic-pft branch + ! + if ( nsrest == nsrContinue .or. flanduse_timeseries /= ' ' )then + ! Do NOT do any testing for restart or a pftdyn case + ! + ! Otherwise test and make sure weights agree to reasonable tolerence + ! + else if ( .not.weights_exactly_the_same( pptr, wtgcell, wtlunit, wtcol ) )then + if (.not. use_cndv) then + if ( weights_within_roundoff_different( pptr, wtgcell, wtlunit, wtcol ) )then + write(iulog,*) sub//"::NOTE, PFT weights from ", filetypes(nsrest), & + " file and ", trim(fileusing), " file(s) are different to roundoff -- using ", & + trim(fileusing), " values." + else if ( weights_tooDifferent( begp, endp, pptr, wtgcell, adiff, maxdiff ) )then + write(iulog,*) "ERROR:: PFT weights are SIGNIFICANTLY different from the input ", & + filetypes(nsrest), " file and ", trim(fileusing), " file(s)." + write(iulog,*) "ERROR:: maximum difference is ", maxdiff, " max allowed = ", adiff + write(iulog,*) "ERROR:: Run interpinic on your initial condition file to interpolate to the new surface dataset" + call endrun( sub//"::ERROR:: Weights between initial condition file and surface dataset are too different" ) + else + write(iulog,*) sub//"::NOTE, PFT weights from ", filetypes(nsrest), & + " file and ", trim(fileusing), " file(s) are different to < ", & + adiff, " -- using ", trim(fileusing), " values." + end if + write(iulog,*) sub//"::WARNING, weights different between ", filetypes(nsrest), & + " file and ", trim(fileusing), " file(s), but close enough -- using ", & + trim(fileusing), " values." + ! Copy weights from fsurdat file back in -- they are only off by roundoff to 1% or so... + pptr%wtgcell(:) = wtgcell(:) + pptr%wtlunit(:) = wtlunit(:) + pptr%wtcol(:) = wtcol(:) + end if + end if + + deallocate( wtgcell ) + deallocate( wtlunit ) + deallocate( wtcol ) + + end if + + end if + + ! Note - for the snow interfaces, are only examing the snow interfaces + ! above zi=0 which is why zisno and zsno have the same level dimension below + ! (Note - for zisno, zi(0) is set to 0 in routine iniTimeConst) + + ! pft energy flux - eflx_lwrad_out + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='EFLX_LWRAD_OUT', xtype=ncd_double, & + dim1name='pft', & + long_name='emitted infrared (longwave) radiation', units='watt/m^2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='EFLX_LWRAD_OUT', data=pef%eflx_lwrad_out, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - snow levels + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='SNLSNO', xtype=ncd_int, & + dim1name='column', & + long_name='number of snow layers', units='unitless') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='SNLSNO', data=cps%snl, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - snowdp + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='SNOWDP', xtype=ncd_double, & + dim1name='column', & + long_name='snow depth', units='m') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='SNOWDP', data=cps%snowdp, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - wa + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='WA', xtype=ncd_double, & + dim1name='column', & + long_name='water in the unconfined aquifer', units='mm') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='WA', data=cws%wa, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - wt + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='WT', xtype=ncd_double, & + dim1name='column', & + long_name='total water storage', units='mm') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='WT', data=cws%wt, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - zwt + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ZWT', xtype=ncd_double, & + dim1name='column', & + long_name='water table depth', units='m') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='ZWT', data=cws%zwt, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type physical state variable - frac_sno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='frac_sno', xtype=ncd_double, & + dim1name='column',& + long_name='fraction of ground covered by snow (0 to 1)',units='unitless') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='frac_sno', data=cps%frac_sno, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type physical state variable - dzsno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='DZSNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer thickness', units='m') + else if (flag == 'read' .or. flag == 'write') then + allocate(temp2d(begc:endc,-nlevsno+1:0)) + if (flag == 'write') then + temp2d(begc:endc,-nlevsno+1:0) = cps%dz(begc:endc,-nlevsno+1:0) + end if + call ncd_io(varname='DZSNO', data=temp2d, & + dim1name=namec, switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + if (flag == 'read') then + cps%dz(begc:endc,-nlevsno+1:0) = temp2d(begc:endc,-nlevsno+1:0) + end if + deallocate(temp2d) + end if + + ! column type physical state variable - zsno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ZSNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer depth', units='m') + else if (flag == 'read' .or. flag == 'write') then + allocate(temp2d(begc:endc,-nlevsno+1:0)) + if (flag == 'write') then + temp2d(begc:endc,-nlevsno+1:0) = cps%z(begc:endc,-nlevsno+1:0) + end if + call ncd_io(varname='ZSNO', data=temp2d, & + dim1name=namec, switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + if (flag == 'read') then + cps%z(begc:endc,-nlevsno+1:0) = temp2d(begc:endc,-nlevsno+1:0) + end if + deallocate(temp2d) + end if + + ! column type physical state variable - zisno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ZISNO', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow interface depth', units='m') + else if (flag == 'read' .or. flag == 'write') then + allocate(temp2d(begc:endc,-nlevsno:-1)) + if (flag == 'write') then + temp2d(begc:endc,-nlevsno:-1) = cps%zi(begc:endc,-nlevsno:-1) + end if + call ncd_io(varname='ZISNO', data=temp2d, & + dim1name=namec, switchdim=.true., & + lowerb2=-nlevsno, upperb2=-1, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + if (flag == 'read') then + cps%zi(begc:endc,-nlevsno:-1) = temp2d(begc:endc,-nlevsno:-1) + end if + deallocate(temp2d) + end if + + ! column type physical state variable - coszen + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='coszen', xtype=ncd_double, & + dim1name='column', & + long_name='cosine of solar zenith angle', units='unitless') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='coszen', data=cps%coszen, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - gdir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='gdir', xtype=ncd_double, & + dim1name='pft', & + long_name='leaf projection in solar direction (0 to 1)', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='gdir', data=pps%gdir, & + dim1name=namep, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - omega + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='omega', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='fraction of intercepted radiation that is scattered (0 to 1)', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='omega', data=pps%omega, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_roof_dir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_roof_dir', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by roof per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_roof_dir', data=lps%sabs_roof_dir, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_roof_dif + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_roof_dif', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by roof per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_roof_dif', data=lps%sabs_roof_dif, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_sunwall_dir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_sunwall_dir', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by sunwall per unit wall area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_sunwall_dir', data=lps%sabs_sunwall_dir, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_sunwall_dif + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_sunwall_dif', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by sunwall per unit wall area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_sunwall_dif', data=lps%sabs_sunwall_dif, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_shadewall_dir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_shadewall_dir', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by shadewall per unit wall area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_shadewall_dir', data=lps%sabs_shadewall_dir, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_shadewall_dif + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_shadewall_dif', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by shadewall per unit wall area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_shadewall_dif', data=lps%sabs_shadewall_dif, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_improad_dir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_improad_dir', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by impervious road per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_improad_dir', data=lps%sabs_improad_dir, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_improad_dif + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_improad_dif', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by impervious road per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_improad_dif', data=lps%sabs_improad_dif, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_perroad_dir + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_perroad_dir', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='direct solar absorbed by pervious road per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_perroad_dir', data=lps%sabs_perroad_dir, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - sabs_perroad_dif + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='sabs_perroad_dif', xtype=ncd_double, & + dim1name='landunit', dim2name='numrad', switchdim=.true., & + long_name='diffuse solar absorbed by pervious road per unit ground area per unit incident flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='sabs_perroad_dif', data=lps%sabs_perroad_dif, & + dim1name=namel, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - vf_sr + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf_sr', xtype=ncd_double, & + dim1name='landunit', & + long_name='view factor of sky for road',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf_sr', data=lps%vf_sr, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - vf_wr + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf_wr', xtype=ncd_double, & + dim1name='landunit', & + long_name='view factor of one wall for road',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf_wr', data=lps%vf_wr, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - vf_sw + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf_sw', xtype=ncd_double, & + dim1name='landunit', & + long_name='view factor of sky for one wall',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf_sw', data=lps%vf_sw, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - vf_rw + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf_rw', xtype=ncd_double, & + dim1name='landunit', & + long_name='view factor of road for one wall',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf_rw', data=lps%vf_rw, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - vf_ww + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='vf_ww', xtype=ncd_double, & + dim1name='landunit', & + long_name='view factor of opposing wall for one wall',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='vf_ww', data=lps%vf_ww, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - taf + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='taf', xtype=ncd_double, & + dim1name='landunit', & + long_name='urban canopy air temperature',units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='taf', data=lps%taf, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! landunit type physical state variable - qaf + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='qaf', xtype=ncd_double, & + dim1name='landunit', & + long_name='urban canopy specific humidity',units='kg/kg') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='qaf', data=lps%qaf, & + dim1name=namel, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - albd + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albd', data=pps%albd, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + end if + + ! pft type physical state variable - albi + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albi', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (diffuse) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albi', data=pps%albi, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + end if + + ! column type physical state variable - albgrd + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgrd', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgrd', data=cps%albgrd, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type physical state variable - albgri + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgri', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (indirect) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgri', data=cps%albgri, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + if (use_snicar_frc) then + ! column type physical state variable - albgrd_bc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgrd_bc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgrd_bc', data=cps%albgrd_bc, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_bc in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgrd_bc to albgrd" + do c=begc,endc + cps%albgrd_bc(c,:) = cps%albgrd(c,:) + enddo + end if + end if + ! column type physical state variable - albgri_bc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgri_bc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (diffuse) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgri_bc', data=cps%albgri_bc, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_bc in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgri_bc to albgri" + do c=begc,endc + cps%albgri_bc(c,:) = cps%albgri(c,:) + enddo + end if + end if + ! column type physical state variable - albgrd_pur + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgrd_pur', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgrd_pur', data=cps%albgrd_pur, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_pur in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgrd_pur to albgrd" + do c=begc,endc + cps%albgrd_pur(c,:) = cps%albgrd(c,:) + enddo + end if + end if + ! column type physical state variable - albgri_pur + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgri_pur', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (diffuse) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgri_pur', data=cps%albgri_pur, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_pur in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgri_pur to albgri" + do c=begc,endc + cps%albgri_pur(c,:) = cps%albgri(c,:) + enddo + end if + end if + ! column type physical state variable - albgrd_oc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgrd_oc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgrd_oc', data=cps%albgrd_oc, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_oc in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgrd_oc to albgrd" + do c=begc,endc + cps%albgrd_oc(c,:) = cps%albgrd(c,:) + enddo + end if + end if + ! column type physical state variable - albgri_oc + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgri_oc', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (diffuse) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgri_oc', data=cps%albgri_oc, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_oc in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgri_oc to albgri" + do c=begc,endc + cps%albgri_oc(c,:) = cps%albgri(c,:) + enddo + end if + end if + ! column type physical state variable - albgrd_dst + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgrd_dst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (direct) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgrd_dst', data=cps%albgrd_dst, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgrd_dst in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgrd_dst to albgrd" + do c=begc,endc + cps%albgrd_dst(c,:) = cps%albgrd(c,:) + enddo + end if + end if + ! column type physical state variable - albgri_dst + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albgri_dst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (diffuse) (0 to 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albgri_dst', data=cps%albgri_dst, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find albgri_dst in restart (or initial) file..." + if (masterproc) write(iulog,*) "Initialize albgri_dst to albgri" + do c=begc,endc + cps%albgri_dst(c,:) = cps%albgri(c,:) + enddo + end if + end if + end if !end of if use_snicar_frc + + ! column water state variable - h2osno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='H2OSNO', xtype=ncd_double, & + dim1name='column', & + long_name='snow water', units='kg/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='H2OSNO', data=cws%h2osno, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - h2osoi_liq + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='H2OSOI_LIQ', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='liquid water', units='kg/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='H2OSOI_LIQ', data=cws%h2osoi_liq, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column water state variable - h2osoi_ice + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='H2OSOI_ICE', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='ice lens', units='kg/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='H2OSOI_ICE', data=cws%h2osoi_ice, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column energy state variable - t_grnd + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_GRND', xtype=ncd_double, & + dim1name='column', & + long_name='ground temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_GRND', data=ces%t_grnd, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column urban energy state variable - eflx_urban_ac + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='URBAN_AC', xtype=ncd_double, & + dim1name='column', & + long_name='urban air conditioning flux', units='watt/m^2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='URBAN_AC', data=cef%eflx_urban_ac, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column urban energy state variable - eflx_urban_heat + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='URBAN_HEAT', xtype=ncd_double, & + dim1name='column', & + long_name='urban heating flux', units='watt/m^2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='URBAN_HEAT', data=cef%eflx_urban_heat, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft energy state variable - t_ref2m_min + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN', xtype=ncd_double, & + dim1name='pft', & + long_name='daily minimum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN', data=pes%t_ref2m_min, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX', xtype=ncd_double, & + dim1name='pft', & + long_name='daily maximum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX', data=pes%t_ref2m_max, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_min_inst + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN_INST', xtype=ncd_double, & + dim1name='pft', & + long_name='instantaneous daily min of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN_INST', data=pes%t_ref2m_min_inst, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max_inst + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX_INST', xtype=ncd_double, & + dim1name='pft', & + long_name='instantaneous daily max of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX_INST', data=pes%t_ref2m_max_inst, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname="T_REF2M_U", xtype=ncd_double, & + dim1name='pft', & + long_name='Urban 2m height surface air temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname="T_REF2M_U", data=pes%t_ref2m_u, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column energy state variable - t_grnd_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_GRND_U', xtype=ncd_double, & + dim1name='column', & + long_name='urban ground temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_GRND_U', data=ces%t_grnd_u, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft energy state variable - t_ref2m_min_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN_U', xtype=ncd_double, & + dim1name='pft', & + long_name='urban daily minimum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN_U', data=pes%t_ref2m_min_u, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX_U', xtype=ncd_double, & + dim1name='pft', & + long_name='urban daily maximum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX_U', data=pes%t_ref2m_max_u, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_min_inst_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN_INST_U', xtype=ncd_double, & + dim1name='pft', & + long_name='urban instantaneous daily min of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN_INST_U', data=pes%t_ref2m_min_inst_u, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max_inst_u + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX_INST_U', xtype=ncd_double, & + dim1name='pft', & + long_name='urban instantaneous daily max of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX_INST_U', data=pes%t_ref2m_max_inst_u, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname="T_REF2M_R", xtype=ncd_double, & + dim1name='pft', & + long_name='Rural 2m height surface air temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname="T_REF2M_R", data=pes%t_ref2m_r, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column energy state variable - t_grnd_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_GRND_R', xtype=ncd_double, & + dim1name='column', & + long_name='rural ground temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_GRND_R', data=ces%t_grnd_r, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft energy state variable - t_ref2m_min_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural daily minimum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN_R', data=pes%t_ref2m_min_r, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural daily maximum of average 2 m height surface air temperature (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX_R', data=pes%t_ref2m_max_r, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_min_inst_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MIN_INST_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural instantaneous daily min of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MIN_INST_R', data=pes%t_ref2m_min_inst_r, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! pft energy state variable - t_ref2m_max_inst_r + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_REF2M_MAX_INST_R', xtype=ncd_double, & + dim1name='pft', & + long_name='rural instantaneous daily max of average 2 m height surface air temp (K)', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_REF2M_MAX_INST_R', data=pes%t_ref2m_max_inst_r, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + endif + + ! column energy state variable - t_soisno + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_SOISNO', xtype=ncd_double, & + dim1name='column', dim2name='levtot', switchdim=.true., & + long_name='soil-snow temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_SOISNO', data=ces%t_soisno, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type energy state variable - t_lake + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_LAKE', xtype=ncd_double, & + dim1name='column', dim2name='levlak', switchdim=.true., & + long_name='lake temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_LAKE', data=ces%t_lake, & + dim1name=namec, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft physical state variable - frac_veg_nosno_alb + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='FRAC_VEG_NOSNO_ALB', xtype=ncd_int, & + dim1name='pft',& + long_name='fraction of vegetation not covered by snow (0 or 1)',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='FRAC_VEG_NOSNO_ALB', data=pps%frac_veg_nosno_alb, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - fwet + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='FWET', xtype=ncd_double, & + dim1name='pft', & + long_name='fraction of canopy that is wet (0 to 1)', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='FWET', data=pps%fwet, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - tlai + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tlai', xtype=ncd_double, & + dim1name='pft', & + long_name='one-sided leaf area index, no burying by snow', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tlai', data=pps%tlai, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - tsai + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='tsai', xtype=ncd_double, & + dim1name='pft', & + long_name='one-sided stem area index, no burying by snow', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='tsai', data=pps%tsai, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mlaidiff', xtype=ncd_double, & + dim1name='pft',& + long_name='difference between lai month one and month two',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mlaidiff', data=pps%mlaidiff, & + dim1name='pft', & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - elai + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='elai', xtype=ncd_double, & + dim1name='pft', & + long_name='one-sided leaf area index, with burying by snow', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='elai', data=pps%elai, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - esai + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='esai', xtype=ncd_double, & + dim1name='pft', & + long_name='one-sided stem area index, with burying by snow', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='esai', data=pps%esai, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - fsun + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fsun', xtype=ncd_double, & + dim1name='pft', & + long_name='sunlit fraction of canopy', units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fsun', data=pps%fsun, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' )then + if ( .not. readvar) then + if (is_restart()) call endrun() + else + do p = begp, endp + if ( shr_infnan_isnan( pps%fsun(p) ) )then + pps%fsun(p) = spval + end if + end do + end if + end if + end if + + ! pft type physical state variable - htop + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='htop', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy top', units='m') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='htop', data=pps%htop, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - hbot + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='hbot', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy botton', units='m') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='hbot', data=pps%hbot, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - fabd + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fabd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by veg per unit direct flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fabd', data=pps%fabd, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - fabi + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='fabi', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='flux absorbed by veg per unit diffuse flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='fabi', data=pps%fabi, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - ftdd + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ftdd', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down direct flux below veg per unit direct flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='ftdd', data=pps%ftdd, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - ftid + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ftid', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down diffuse flux below veg per unit direct flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='ftid', data=pps%ftid, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft type physical state variable - ftii + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='ftii', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='down diffuse flux below veg per unit diffuse flux',units='') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='ftii', data=pps%ftii, & + dim1name=namep, switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft energy state variable - t_veg + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='T_VEG', xtype=ncd_double, & + dim1name='pft', & + long_name='vegetation temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='T_VEG', data=pes%t_veg, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! pft energy state variable - t_ref2m + + varname = 'T_REF2M' + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_double, & + dim1name='pft', & + long_name='2m height surface air temperature', units='K') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname=varname, data=pes%t_ref2m, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (allocate_all_vegpfts) then + call endrun() + else + if (is_restart()) call endrun() + end if + end if + end if + + ! pft type water state variable - h2ocan + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='H2OCAN', xtype=ncd_double, & + dim1name='pft', & + long_name='canopy water', units='kg/m2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='H2OCAN', data=pws%h2ocan, & + dim1name=namep, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column irrigation variable - n_irrig_steps_left + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='n_irrig_steps_left', xtype=ncd_int, & + dim1name='column', & + long_name='number of irrigation time steps left', units='#') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='n_irrig_steps_left', data=cps%n_irrig_steps_left, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + cps%n_irrig_steps_left = 0 + end if + end if + + ! column irrigation variable - irrig_rate + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='irrig_rate', xtype=ncd_double, & + dim1name='column', & + long_name='irrigation rate', units='mm/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='irrig_rate', data=cps%irrig_rate, & + dim1name=namec, & + ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + cps%irrig_rate = 0.0_r8 + end if + end if + + ! ------------------------------------------------------------ + ! Determine volumetric soil water (for read only) + ! ------------------------------------------------------------ + + if (flag == 'read' ) then + do c = begc,endc + l = clandunit(c) + if ( ltype(l) == istdlak .or. ltype(l) == istslak )then + nlevs = nlevlak + else if ( ltype(l) == isturb )then + nlevs = nlevurb + else + nlevs = nlevgrnd + end if + ! NOTE: THIS IS A MEMORY INEFFICIENT COPY + do j = 1,nlevs + cws%h2osoi_vol(c,j) = cws%h2osoi_liq(c,j)/(cps%dz(c,j)*denh2o) & + + cws%h2osoi_ice(c,j)/(cps%dz(c,j)*denice) + end do + end do + + + ! ------------------------------------------------------------ + ! If initial run -- ensure that water is properly bounded + ! ------------------------------------------------------------ + + if ( is_first_step() )then + do c = begc,endc + l = clandunit(c) + if ( ltype(l) == istdlak .or. ltype(l) == istslak )then + nlevs = nlevlak + else if ( ltype(l) == isturb )then + nlevs = nlevurb + else + nlevs = nlevgrnd + end if + do j = 1,nlevs + l = clandunit(c) + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + cws%h2osoi_liq(c,j) = max(0._r8,cws%h2osoi_liq(c,j)) + cws%h2osoi_ice(c,j) = max(0._r8,cws%h2osoi_ice(c,j)) + cws%h2osoi_vol(c,j) = cws%h2osoi_liq(c,j)/(cps%dz(c,j)*denh2o) & + + cws%h2osoi_ice(c,j)/(cps%dz(c,j)*denice) + if (j == 1) then + maxwatsat = (cps%watsat(c,j)*cps%dz(c,j)*1000.0_r8 + pondmx) / & + (cps%dz(c,j)*1000.0_r8) + else + maxwatsat = cps%watsat(c,j) + end if + if (cws%h2osoi_vol(c,j) > maxwatsat) then + excess = (cws%h2osoi_vol(c,j) - maxwatsat)*cps%dz(c,j)*1000.0_r8 + totwat = cws%h2osoi_liq(c,j) + cws%h2osoi_ice(c,j) + cws%h2osoi_liq(c,j) = cws%h2osoi_liq(c,j) - & + (cws%h2osoi_liq(c,j)/totwat) * excess + cws%h2osoi_ice(c,j) = cws%h2osoi_ice(c,j) - & + (cws%h2osoi_ice(c,j)/totwat) * excess + end if + cws%h2osoi_liq(c,j) = max(watmin,cws%h2osoi_liq(c,j)) + cws%h2osoi_ice(c,j) = max(watmin,cws%h2osoi_ice(c,j)) + cws%h2osoi_vol(c,j) = cws%h2osoi_liq(c,j)/(cps%dz(c,j)*denh2o) & + + cws%h2osoi_ice(c,j)/(cps%dz(c,j)*denice) + end if + end do + end do + end if + endif + ! + ! variables needed for SNICAR + ! + ! column type physical state variable - snw_rds + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='snw_rds', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer effective radius', units='um') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='snw_rds', data=cps%snw_rds, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (masterproc) write(iulog,*) "SNICAR: can't find snw_rds in restart (or initial) file..." + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize snw_rds + if (masterproc) then + write(iulog,*) "SNICAR: This is an initial run (not a restart), and grain size/aerosol " // & + "mass data are not defined in initial condition file. Initialize snow " // & + "effective radius to fresh snow value, and snow/aerosol masses to zero." + endif + do c=begc,endc + if (cps%snl(c) < 0) then + cps%snw_rds(c,cps%snl(c)+1:0) = snw_rds_min + cps%snw_rds(c,-nlevsno+1:cps%snl(c)) = 0._r8 + cps%snw_rds_top(c) = snw_rds_min + cps%sno_liq_top(c) = cws%h2osoi_liq(c,cps%snl(c)+1) / & + (cws%h2osoi_liq(c,cps%snl(c)+1)+cws%h2osoi_ice(c,cps%snl(c)+1)) + elseif (cws%h2osno(c) > 0._r8) then + cps%snw_rds(c,0) = snw_rds_min + cps%snw_rds(c,-nlevsno+1:-1) = 0._r8 + cps%snw_rds_top(c) = spval + cps%sno_liq_top(c) = spval + else + cps%snw_rds(c,:) = 0._r8 + cps%snw_rds_top(c) = spval + cps%sno_liq_top(c) = spval + endif + enddo + endif + end if + end if + + ! column type physical state variable - mss_bcpho + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_bcpho', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer hydrophobic black carbon mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_bcpho', data=cps%mss_bcpho, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_bcpho to zero + do c=begc,endc + cps%mss_bcpho(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_bcphi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_bcphi', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer hydrophilic black carbon mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_bcphi', data=cps%mss_bcphi, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_bcphi to zero + do c=begc,endc + cps%mss_bcphi(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_ocpho + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_ocpho', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer hydrophobic organic carbon mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_ocpho', data=cps%mss_ocpho, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_ocpho to zero + do c=begc,endc + cps%mss_ocpho(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_ocphi + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_ocphi', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer hydrophilic organic carbon mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_ocphi', data=cps%mss_ocphi, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_ocphi to zero + do c=begc,endc + cps%mss_ocphi(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_dst1 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_dst1', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer dust species 1 mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_dst1', data=cps%mss_dst1, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_dst1 to zero + do c=begc,endc + cps%mss_dst1(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_dst2 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_dst2', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer dust species 2 mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_dst2', data=cps%mss_dst2, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_dst2 to zero + do c=begc,endc + cps%mss_dst2(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_dst3 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_dst3', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer dust species 3 mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_dst3', data=cps%mss_dst3, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_dst3 to zero + do c=begc,endc + cps%mss_dst3(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - mss_dst4 + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mss_dst4', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer dust species 4 mass', units='kg m-2') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='mss_dst4', data=cps%mss_dst4, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize mss_dst4 to zero + do c=begc,endc + cps%mss_dst4(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type physical state variable - flx_absdv + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='flx_absdv', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., & + long_name='snow layer flux absorption factors (direct, VIS)', units='fraction') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='flx_absdv', data=cps%flx_absdv, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=1, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + ! SNICAR, via SurfaceAlbedo, will define the needed flux absorption factors + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + + ! column type physical state variable - flx_absdn + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='flx_absdn', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., & + long_name='snow layer flux absorption factors (direct, NIR)', units='fraction') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='flx_absdn', data=cps%flx_absdn, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=1, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + ! SNICAR, via SurfaceAlbedo, will define the needed flux absorption factors + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + + ! column type physical state variable - flx_absiv + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='flx_absiv', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., & + long_name='snow layer flux absorption factors (diffuse, VIS)', units='fraction') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='flx_absiv', data=cps%flx_absiv, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=1, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + ! SNICAR, via SurfaceAlbedo, will define the needed flux absorption factors + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + + ! column type physical state variable - flx_absin + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='flx_absin', xtype=ncd_double, & + dim1name='column', dim2name='levsno1', switchdim=.true., & + long_name='snow layer flux absorption factors (diffuse, NIR)', units='fraction') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='flx_absin', data=cps%flx_absin, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=1, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) call endrun() + ! SNICAR, via SurfaceAlbedo, will define the needed flux absorption factors + if (nsrest == nsrStartup) do_initsurfalb = .true. + end if + end if + + ! column type physical state variable - albsnd_hst + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albsnd_hst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (direct) (0 to 1)',units='proportion') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albsnd_hst', data=cps%albsnd_hst, & + dim1name='column', switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type physical state variable - albsni_hst + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='albsni_hst', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (diffuse) (0 to 1)',units='proportion') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='albsni_hst', data=cps%albsni_hst, & + dim1name='column', switchdim=.true., ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call endrun() + end if + end if + + ! column type water flux variable - qflx_snofrz_lyr + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='qflx_snofrz_lyr', xtype=ncd_double, & + dim1name='column', dim2name='levsno', switchdim=.true., & + long_name='snow layer ice freezing rate', units='kg m-2 s-1') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='qflx_snofrz_lyr', data=cwf%qflx_snofrz_lyr, & + dim1name='column', switchdim=.true., & + lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize qflx_snofrz_lyr to zero + do c=begc,endc + cwf%qflx_snofrz_lyr(c,-nlevsno+1:0) = 0._r8 + enddo + endif + end if + end if + + ! column type water flux variable - qflx_snow_melt + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='qflx_snow_melt', xtype=ncd_double, & + dim1name='column', long_name='net snow melt', units='mm/s') + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname='qflx_snow_melt', data=cwf%qflx_snow_melt, & + dim1name='column', ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. .not. readvar) then + if (is_restart()) then + call endrun() + else + ! initial run, not restart: initialize qflx_snow_melt to zero + cwf%qflx_snow_melt = 0._r8 + endif + end if + end if + + ! initialize other variables that are derived from those + ! stored in the restart buffer. (there may be a more appropriate + ! place to do this, but functionally this works) + if (flag == 'read' ) then + do j = -nlevsno+1,0 + do c = begc,endc + ! mass concentrations of aerosols in snow + if (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j) > 0._r8) then + cps%mss_cnc_bcpho(c,j) = cps%mss_bcpho(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_bcphi(c,j) = cps%mss_bcphi(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_ocpho(c,j) = cps%mss_ocpho(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_ocphi(c,j) = cps%mss_ocphi(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + + cps%mss_cnc_dst1(c,j) = cps%mss_dst1(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_dst2(c,j) = cps%mss_dst2(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_dst3(c,j) = cps%mss_dst3(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + cps%mss_cnc_dst4(c,j) = cps%mss_dst4(c,j) / (cws%h2osoi_ice(c,j)+cws%h2osoi_liq(c,j)) + else + cps%mss_cnc_bcpho(c,j) = 0._r8 + cps%mss_cnc_bcphi(c,j) = 0._r8 + cps%mss_cnc_ocpho(c,j) = 0._r8 + cps%mss_cnc_ocphi(c,j) = 0._r8 + + cps%mss_cnc_dst1(c,j) = 0._r8 + cps%mss_cnc_dst2(c,j) = 0._r8 + cps%mss_cnc_dst3(c,j) = 0._r8 + cps%mss_cnc_dst4(c,j) = 0._r8 + endif + enddo + enddo + endif + !-- SNICAR variables + + + end subroutine BiogeophysRest + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: weights_exactly_the_same +! +! !INTERFACE: + logical function weights_exactly_the_same( pptr, wtgcell, wtlunit, wtcol ) +! +! !DESCRIPTION: +! Determine if the weights read in are exactly the same as those from surface dataset +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + type(pft_type), pointer :: pptr ! pointer to pft derived subtype + real(r8), intent(IN) :: wtgcell(:) ! grid cell weights for each PFT + real(r8), intent(IN) :: wtlunit(:) ! land-unit weights for each PFT + real(r8), intent(IN) :: wtcol(:) ! column weights for each PFT +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + + ! Check that weights are identical for all PFT's and all weight types + if ( all( pptr%wtgcell(:) == wtgcell ) .and. all( pptr%wtlunit(:) == wtlunit ) & + .and. all( pptr%wtcol(:) == wtcol ) )then + weights_exactly_the_same = .true. + else + weights_exactly_the_same = .false. + end if + + end function weights_exactly_the_same + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: weights_within_roundoff_different +! +! !INTERFACE: + logical function weights_within_roundoff_different( pptr, wtgcell, wtlunit, wtcol ) +! +! !DESCRIPTION: +! Determine if the weights are within roundoff different from each other +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + type(pft_type), pointer :: pptr ! pointer to pft derived subtype + real(r8), intent(IN) :: wtgcell(:) ! grid cell weights for each PFT + real(r8), intent(IN) :: wtlunit(:) ! land-unit weights for each PFT + real(r8), intent(IN) :: wtcol(:) ! column weights for each PFT +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + real(r8), parameter :: rndVal = 1.e-13_r8 + + ! If differences between all weights for each PFT and each weight type is + ! less than or equal to double precision roundoff level -- weights are close + if ( all( abs(pptr%wtgcell(:) - wtgcell) <= rndVal ) & + .and. all( abs(pptr%wtlunit(:) - wtlunit) <= rndVal ) & + .and. all( abs(pptr%wtcol(:) - wtcol ) <= rndVal ) )then + weights_within_roundoff_different = .true. + else + weights_within_roundoff_different = .false. + end if + + end function weights_within_roundoff_different + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: weights_tooDifferent +! +! !INTERFACE: + logical function weights_tooDifferent( begp, endp, pptr, wtgcell, adiff, maxdiff ) +! +! !DESCRIPTION: +! Determine if the weights read in are too different and should flag an error +! +! !USES: + use clmtype + implicit none +! +! !ARGUMENTS: + integer, intent(IN) :: begp, endp ! per-proc beginning and ending pft indices + type(pft_type), pointer :: pptr ! pointer to pft derived subtype + real(r8), intent(IN) :: wtgcell(begp:endp) ! grid cell weights for each PFT + real(r8), intent(IN) :: adiff ! tolerance of acceptible difference + real(r8), intent(OUT) :: maxdiff ! maximum difference found +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + integer :: p ! PFT index + real(r8) :: diff ! difference in weights + + ! Assume weights are NOT different and only change if find weights too different + weights_tooDifferent = .false. + maxdiff = 0.0_r8 + do p = begp, endp + + diff = abs(pptr%wtgcell(p) - wtgcell(p)) + if ( diff > maxdiff ) maxdiff = diff + if ( diff > adiff ) weights_tooDifferent = .true. + end do + + end function weights_tooDifferent + + +end module BiogeophysRestMod diff --git a/components/clm/src_clm40/biogeophys/Biogeophysics1Mod.F90 b/components/clm/src_clm40/biogeophys/Biogeophysics1Mod.F90 new file mode 100644 index 0000000000..142d454e28 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/Biogeophysics1Mod.F90 @@ -0,0 +1,544 @@ +module Biogeophysics1Mod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: Biogeophysics1Mod +! +! !DESCRIPTION: +! Performs calculation of leaf temperature and surface fluxes. +! Biogeophysics2.F90 then determines soil/snow and ground +! temperatures and updates the surface fluxes for the new ground +! temperature. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Biogeophysics1 ! Calculate leaf temperature and surface fluxes +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Biogeophysics1 +! +! !INTERFACE: + subroutine Biogeophysics1(lbg, ubg, lbc, ubc, lbp, ubp, & + num_nolakec, filter_nolakec, num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! This is the main subroutine to execute the calculation of leaf temperature +! and surface fluxes. Biogeophysics2.F90 then determines soil/snow and ground +! temperatures and updates the surface fluxes for the new ground +! temperature. +! +! Calling sequence is: +! Biogeophysics1: surface biogeophysics driver +! -> QSat: saturated vapor pressure, specific humidity, and +! derivatives at ground surface and derivatives at +! leaf surface using updated leaf temperature +! Leaf temperature +! Foliage energy conservation is given by the foliage energy budget +! equation: +! Rnet - Hf - LEf = 0 +! The equation is solved by Newton-Raphson iteration, in which this +! iteration includes the calculation of the photosynthesis and +! stomatal resistance, and the integration of turbulent flux profiles. +! The sensible and latent heat transfer between foliage and atmosphere +! and ground is linked by the equations: +! Ha = Hf + Hg and Ea = Ef + Eg +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varcon , only : denh2o, denice, roverg, hvap, hsub, & + istice, istice_mec, istwet, istsoil, isturb, istdlak, & + zlnd, zsno, tfrz, & + icol_roof, icol_sunwall, icol_shadewall, & + icol_road_imperv, icol_road_perv, tfrz, spval, istdlak + use clm_varcon , only : istcrop + use clm_varpar , only : nlevgrnd, nlevurb, nlevsno, max_pft_per_gcell, nlevsoi + use QSatMod , only : QSat + use shr_const_mod , only : SHR_CONST_PI +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbg, ubg ! gridcell-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! Migrated to clm2.0 by Keith Oleson and Mariana Vertenstein +! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein +! 27 February 2008: Keith Oleson; weighted soil/snow emissivity +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: ivt(:) !pft vegetation type + integer , pointer :: ityplun(:) !landunit type + integer , pointer :: clandunit(:) !column's landunit index + integer , pointer :: cgridcell(:) !column's gridcell index + real(r8), pointer :: pwtgcell(:) !weight relative to gridcell for each pft + integer , pointer :: ctype(:) !column type + real(r8), pointer :: forc_pbot(:) !atmospheric pressure (Pa) + real(r8), pointer :: forc_q(:) !atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_t(:) !atmospheric temperature (Kelvin) + real(r8), pointer :: forc_hgt_t(:) !observational height of temperature [m] + real(r8), pointer :: forc_hgt_u(:) !observational height of wind [m] + real(r8), pointer :: forc_hgt_q(:) !observational height of specific humidity [m] + integer , pointer :: npfts(:) !number of pfts on gridcell + integer , pointer :: pfti(:) !initial pft on gridcell + integer , pointer :: plandunit(:) !pft's landunit index + real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m] + real(r8), pointer :: forc_hgt_t_pft(:) !observational height of temperature at pft level [m] + real(r8), pointer :: forc_hgt_q_pft(:) !observational height of specific humidity at pft level [m] + integer , pointer :: frac_veg_nosno(:) !fraction of vegetation not covered by snow (0 OR 1) [-] + integer , pointer :: pgridcell(:) !pft's gridcell index + integer , pointer :: pcolumn(:) !pft's column index + real(r8), pointer :: z_0_town(:) !momentum roughness length of urban landunit (m) + real(r8), pointer :: z_d_town(:) !displacement height of urban landunit (m) + real(r8), pointer :: forc_th(:) !atmospheric potential temperature (Kelvin) + real(r8), pointer :: forc_u(:) !atmospheric wind speed in east direction (m/s) + real(r8), pointer :: forc_v(:) !atmospheric wind speed in north direction (m/s) + real(r8), pointer :: smpmin(:) !restriction for min of soil potential (mm) + integer , pointer :: snl(:) !number of snow layers + real(r8), pointer :: frac_sno(:) !fraction of ground covered by snow (0 to 1) + real(r8), pointer :: h2osno(:) !snow water (mm H2O) + real(r8), pointer :: elai(:) !one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) !one-sided stem area index with burying by snow + real(r8), pointer :: z0mr(:) !ratio of momentum roughness length to canopy top height (-) + real(r8), pointer :: displar(:) !ratio of displacement height to canopy top height (-) + real(r8), pointer :: htop(:) !canopy top (m) + real(r8), pointer :: dz(:,:) !layer depth (m) + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: watsat(:,:) !volumetric soil water at saturation (porosity) + real(r8), pointer :: sucsat(:,:) !minimum soil suction (mm) + real(r8), pointer :: bsw(:,:) !Clapp and Hornberger "b" + real(r8), pointer :: watfc(:,:) !volumetric soil water at field capacity + real(r8), pointer :: watopt(:,:) !volumetric soil moisture corresponding to no restriction on ET from urban pervious surface + real(r8), pointer :: watdry(:,:) !volumetric soil moisture corresponding to no restriction on ET from urban pervious surface + real(r8), pointer :: rootfr_road_perv(:,:) !fraction of roots in each soil layer for urban pervious road + real(r8), pointer :: rootr_road_perv(:,:) !effective fraction of roots in each soil layer for urban pervious road +! +! local pointers to implicit out arguments +! + real(r8), pointer :: t_grnd(:) !ground temperature (Kelvin) + real(r8), pointer :: qg(:) !ground specific humidity [kg/kg] + real(r8), pointer :: dqgdT(:) !d(qg)/dT + real(r8), pointer :: emg(:) !ground emissivity + real(r8), pointer :: htvp(:) !latent heat of vapor of water (or sublimation) [j/kg] + real(r8), pointer :: beta(:) !coefficient of convective velocity [-] + real(r8), pointer :: zii(:) !convective boundary height [m] + real(r8), pointer :: thm(:) !intermediate variable (forc_t+0.0098*forc_hgt_t_pft) + real(r8), pointer :: thv(:) !virtual potential temperature (kelvin) + real(r8), pointer :: z0mg(:) !roughness length over ground, momentum [m] + real(r8), pointer :: z0hg(:) !roughness length over ground, sensible heat [m] + real(r8), pointer :: z0qg(:) !roughness length over ground, latent heat [m] + real(r8), pointer :: emv(:) !vegetation emissivity + real(r8), pointer :: z0m(:) !momentum roughness length (m) + real(r8), pointer :: displa(:) !displacement height (m) + real(r8), pointer :: z0mv(:) !roughness length over vegetation, momentum [m] + real(r8), pointer :: z0hv(:) !roughness length over vegetation, sensible heat [m] + real(r8), pointer :: z0qv(:) !roughness length over vegetation, latent heat [m] + real(r8), pointer :: eflx_sh_tot(:) !total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u(:) !urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_r(:) !rural total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot(:) !total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_u(:) !urban total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_r(:) !rural total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_veg(:) !sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_tot(:) !qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: qflx_evap_veg(:) !vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg(:) !vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: cgrnd(:) !deriv. of soil energy flux wrt to soil temp [w/m2/k] + real(r8), pointer :: cgrnds(:) !deriv. of soil sensible heat flux wrt soil temp [w/m2/k] + real(r8), pointer :: cgrndl(:) !deriv. of soil latent heat flux wrt soil temp [w/m**2/k] + real(r8) ,pointer :: tssbef(:,:) !soil/snow temperature before update + real(r8) ,pointer :: soilalpha(:) !factor that reduces ground saturated specific humidity (-) + real(r8) ,pointer :: soilbeta(:) !factor that reduces ground evaporation + real(r8) ,pointer :: soilalpha_u(:) !Urban factor that reduces ground saturated specific humidity (-) + +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: g,l,c,p !indices + integer :: j !soil/snow level index + integer :: fp !lake filter pft index + integer :: fc !lake filter column index + real(r8) :: qred !soil surface relative humidity + real(r8) :: avmuir !ir inverse optical depth per unit leaf area + real(r8) :: eg !water vapor pressure at temperature T [pa] + real(r8) :: qsatg !saturated humidity [kg/kg] + real(r8) :: degdT !d(eg)/dT + real(r8) :: qsatgdT !d(qsatg)/dT + real(r8) :: fac !soil wetness of surface layer + real(r8) :: psit !negative potential of soil + real(r8) :: hr !relative humidity + real(r8) :: hr_road_perv !relative humidity for urban pervious road + real(r8) :: wx !partial volume of ice and water of surface layer + real(r8) :: fac_fc !soil wetness of surface layer relative to field capacity + real(r8) :: eff_porosity ! effective porosity in layer + real(r8) :: vol_ice ! partial volume of ice lens in layer + real(r8) :: vol_liq ! partial volume of liquid water in layer + integer :: pi !index +!------------------------------------------------------------------------------ + + ! Assign local pointers to derived type members (gridcell-level) + + forc_hgt_t => clm_a2l%forc_hgt_t + forc_u => clm_a2l%forc_u + forc_v => clm_a2l%forc_v + forc_hgt_u => clm_a2l%forc_hgt_u + forc_hgt_q => clm_a2l%forc_hgt_q + npfts => grc%npfts + pfti => grc%pfti + + ! Assign local pointers to derived type members (landunit-level) + + ityplun => lun%itype + z_0_town => lun%z_0_town + z_d_town => lun%z_d_town + + ! Assign local pointers to derived type members (column-level) + + forc_pbot => cps%forc_pbot + forc_q => cws%forc_q + forc_t => ces%forc_t + forc_th => ces%forc_th + + cgridcell => col%gridcell + clandunit => col%landunit + ctype => col%itype + beta => cps%beta + dqgdT => cws%dqgdT + emg => cps%emg + frac_sno => cps%frac_sno + h2osno => cws%h2osno + htvp => cps%htvp + qg => cws%qg + smpmin => cps%smpmin + snl => cps%snl + t_grnd => ces%t_grnd + thv => ces%thv + z0hg => cps%z0hg + z0mg => cps%z0mg + z0qg => cps%z0qg + zii => cps%zii + bsw => cps%bsw + dz => cps%dz + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + soilalpha => cws%soilalpha + soilbeta => cws%soilbeta + soilalpha_u => cws%soilalpha_u + sucsat => cps%sucsat + t_soisno => ces%t_soisno + tssbef => ces%tssbef + watsat => cps%watsat + watfc => cps%watfc + watdry => cps%watdry + watopt => cps%watopt + rootfr_road_perv => cps%rootfr_road_perv + rootr_road_perv => cps%rootr_road_perv + + ! Assign local pointers to derived type members (pft-level) + + ivt => pft%itype + elai => pps%elai + esai => pps%esai + htop => pps%htop + emv => pps%emv + z0m => pps%z0m + displa => pps%displa + z0mv => pps%z0mv + z0hv => pps%z0hv + z0qv => pps%z0qv + eflx_sh_tot => pef%eflx_sh_tot + eflx_sh_tot_u => pef%eflx_sh_tot_u + eflx_sh_tot_r => pef%eflx_sh_tot_r + eflx_lh_tot => pef%eflx_lh_tot + eflx_lh_tot_u => pef%eflx_lh_tot_u + eflx_lh_tot_r => pef%eflx_lh_tot_r + eflx_sh_veg => pef%eflx_sh_veg + qflx_evap_tot => pwf%qflx_evap_tot + qflx_evap_veg => pwf%qflx_evap_veg + qflx_tran_veg => pwf%qflx_tran_veg + cgrnd => pef%cgrnd + cgrnds => pef%cgrnds + cgrndl => pef%cgrndl + forc_hgt_u_pft => pps%forc_hgt_u_pft + forc_hgt_t_pft => pps%forc_hgt_t_pft + forc_hgt_q_pft => pps%forc_hgt_q_pft + plandunit => pft%landunit + frac_veg_nosno => pps%frac_veg_nosno + thm => pes%thm + pgridcell => pft%gridcell + pcolumn => pft%column + pwtgcell => pft%wtgcell + + ! Assign local pointers to derived type members (ecophysiological) + + z0mr => pftcon%z0mr + displar => pftcon%displar + + do j = -nlevsno+1, nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + tssbef(c,j) = t_soisno(c,j) + end do + end do + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + + if (ctype(c) == icol_road_perv) then + hr_road_perv = 0._r8 + end if + + ! begin calculations that relate only to the column level + ! Ground and soil temperatures from previous time step + + t_grnd(c) = t_soisno(c,snl(c)+1) + + ! Saturated vapor pressure, specific humidity and their derivatives + ! at ground surface + + qred = 1._r8 + if (ityplun(l)/=istwet .AND. ityplun(l)/=istice & + .AND. ityplun(l)/=istice_mec) then + if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then + wx = (h2osoi_liq(c,1)/denh2o+h2osoi_ice(c,1)/denice)/dz(c,1) + fac = min(1._r8, wx/watsat(c,1)) + fac = max( fac, 0.01_r8 ) + psit = -sucsat(c,1) * fac ** (-bsw(c,1)) + psit = max(smpmin(c), psit) + hr = exp(psit/roverg/t_grnd(c)) + qred = (1.-frac_sno(c))*hr + frac_sno(c) + + !! Lee and Pielke 1992 beta, added by K.Sakaguchi + if (wx < watfc(c,1) ) then !when water content of ths top layer is less than that at F.C. + fac_fc = min(1._r8, wx/watfc(c,1)) !eqn5.66 but divided by theta at field capacity + fac_fc = max( fac_fc, 0.01_r8 ) + ! modifiy soil beta by snow cover. soilbeta for snow surface is one + soilbeta(c) = (1._r8-frac_sno(c))*0.25_r8*(1._r8 - cos(SHR_CONST_PI*fac_fc))**2._r8 & + + frac_sno(c) + else !when water content of ths top layer is more than that at F.C. + soilbeta(c) = 1._r8 + end if + + soilalpha(c) = qred + ! Pervious road depends on water in total soil column + else if (ctype(c) == icol_road_perv) then + do j = 1, nlevsoi + if (t_soisno(c,j) >= tfrz) then + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity = watsat(c,j)-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + fac = min( max(vol_liq-watdry(c,j),0._r8) / (watopt(c,j)-watdry(c,j)), 1._r8 ) + else + fac = 0._r8 + end if + rootr_road_perv(c,j) = rootfr_road_perv(c,j)*fac + hr_road_perv = hr_road_perv + rootr_road_perv(c,j) + end do + ! Allows for sublimation of snow or dew on snow + qred = (1.-frac_sno(c))*hr_road_perv + frac_sno(c) + + ! Normalize root resistances to get layer contribution to total ET + if (hr_road_perv .gt. 0._r8) then + do j = 1, nlevsoi + rootr_road_perv(c,j) = rootr_road_perv(c,j)/hr_road_perv + end do + end if + soilalpha_u(c) = qred + soilbeta(c) = 0._r8 + else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall) then + qred = 0._r8 + soilbeta(c) = 0._r8 + soilalpha_u(c) = spval + else if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then + qred = 1._r8 + soilbeta(c) = 0._r8 + soilalpha_u(c) = spval + end if + else + soilalpha(c) = spval + soilbeta(c) = 1._r8 + end if + + call QSat(t_grnd(c), forc_pbot(c), eg, degdT, qsatg, qsatgdT) + + qg(c) = qred*qsatg + dqgdT(c) = qred*qsatgdT + + if (qsatg > forc_q(c) .and. forc_q(c) > qred*qsatg) then + qg(c) = forc_q(c) + dqgdT(c) = 0._r8 + end if + + ! Ground emissivity - only calculate for non-urban landunits + ! Urban emissivities are currently read in from data file + + if (ityplun(l) /= isturb) then + if (ityplun(l)==istice .or. ityplun(l)==istice_mec) then + emg(c) = 0.97_r8 + else + emg(c) = (1._r8-frac_sno(c))*0.96_r8 + frac_sno(c)*0.97_r8 + end if + end if + + ! Latent heat. We arbitrarily assume that the sublimation occurs + ! only as h2osoi_liq = 0 + + htvp(c) = hvap + if (h2osoi_liq(c,snl(c)+1) <= 0._r8 .and. h2osoi_ice(c,snl(c)+1) > 0._r8) htvp(c) = hsub + + ! Ground roughness lengths over non-lake columns (includes bare ground, ground + ! underneath canopy, wetlands, etc.) + + if (frac_sno(c) > 0._r8) then + z0mg(c) = zsno + else + z0mg(c) = zlnd + end if + z0hg(c) = z0mg(c) ! initial set only + z0qg(c) = z0mg(c) ! initial set only + + ! Potential, virtual potential temperature, and wind speed at the + ! reference height + + beta(c) = 1._r8 + zii(c) = 1000._r8 + thv(c) = forc_th(c)*(1._r8+0.61_r8*forc_q(c)) + + end do ! (end of columns loop) + + ! Initialization + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + + ! Initial set (needed for history tape fields) + + eflx_sh_tot(p) = 0._r8 + l = plandunit(p) + if (ityplun(l) == isturb) then + eflx_sh_tot_u(p) = 0._r8 + else if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then + eflx_sh_tot_r(p) = 0._r8 + end if + eflx_lh_tot(p) = 0._r8 + if (ityplun(l) == isturb) then + eflx_lh_tot_u(p) = 0._r8 + else if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then + eflx_lh_tot_r(p) = 0._r8 + end if + eflx_sh_veg(p) = 0._r8 + qflx_evap_tot(p) = 0._r8 + qflx_evap_veg(p) = 0._r8 + qflx_tran_veg(p) = 0._r8 + + ! Initial set for calculation + + cgrnd(p) = 0._r8 + cgrnds(p) = 0._r8 + cgrndl(p) = 0._r8 + + ! Vegetation Emissivity + + avmuir = 1._r8 + emv(p) = 1._r8-exp(-(elai(p)+esai(p))/avmuir) + + ! Roughness lengths over vegetation + + z0m(p) = z0mr(ivt(p)) * htop(p) + displa(p) = displar(ivt(p)) * htop(p) + + z0mv(p) = z0m(p) + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) + end do + + ! Make forcing height a pft-level quantity that is the atmospheric forcing + ! height plus each pft's z0m+displa + do pi = 1,max_pft_per_gcell + do g = lbg, ubg + if (pi <= npfts(g)) then + p = pfti(g) + pi - 1 + l = plandunit(p) + ! Note: Some glacier_mec pfts may have zero weight + if (pwtgcell(p) > 0._r8 .or. ityplun(l)==istice_mec) then + c = pcolumn(p) + if (ityplun(l) == istsoil .or. ityplun(l) == istcrop) then + if (frac_veg_nosno(p) == 0) then + forc_hgt_u_pft(p) = forc_hgt_u(g) + z0mg(c) + displa(p) + forc_hgt_t_pft(p) = forc_hgt_t(g) + z0mg(c) + displa(p) + forc_hgt_q_pft(p) = forc_hgt_q(g) + z0mg(c) + displa(p) + else + forc_hgt_u_pft(p) = forc_hgt_u(g) + z0m(p) + displa(p) + forc_hgt_t_pft(p) = forc_hgt_t(g) + z0m(p) + displa(p) + forc_hgt_q_pft(p) = forc_hgt_q(g) + z0m(p) + displa(p) + end if + else if (ityplun(l) == istwet .or. ityplun(l) == istice & + .or. ityplun(l) == istice_mec) then + forc_hgt_u_pft(p) = forc_hgt_u(g) + z0mg(c) + forc_hgt_t_pft(p) = forc_hgt_t(g) + z0mg(c) + forc_hgt_q_pft(p) = forc_hgt_q(g) + z0mg(c) + else if (ityplun(l) == istdlak) then + ! Should change the roughness lengths to shared constants + if (t_grnd(c) >= tfrz) then + forc_hgt_u_pft(p) = forc_hgt_u(g) + 0.01_r8 + forc_hgt_t_pft(p) = forc_hgt_t(g) + 0.01_r8 + forc_hgt_q_pft(p) = forc_hgt_q(g) + 0.01_r8 + else + forc_hgt_u_pft(p) = forc_hgt_u(g) + 0.04_r8 + forc_hgt_t_pft(p) = forc_hgt_t(g) + 0.04_r8 + forc_hgt_q_pft(p) = forc_hgt_q(g) + 0.04_r8 + end if + else if (ityplun(l) == isturb) then + forc_hgt_u_pft(p) = forc_hgt_u(g) + z_0_town(l) + z_d_town(l) + forc_hgt_t_pft(p) = forc_hgt_t(g) + z_0_town(l) + z_d_town(l) + forc_hgt_q_pft(p) = forc_hgt_q(g) + z_0_town(l) + z_d_town(l) + end if + end if + end if + end do + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + thm(p) = forc_t(c) + 0.0098_r8*forc_hgt_t_pft(p) + end do + + end subroutine Biogeophysics1 + +end module Biogeophysics1Mod diff --git a/components/clm/src_clm40/biogeophys/Biogeophysics2Mod.F90 b/components/clm/src_clm40/biogeophys/Biogeophysics2Mod.F90 new file mode 100644 index 0000000000..94ff9169b3 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/Biogeophysics2Mod.F90 @@ -0,0 +1,509 @@ +module Biogeophysics2Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: Biogeophysics2Mod +! +! !DESCRIPTION: +! Performs the calculation of soil/snow and ground temperatures +! and updates surface fluxes based on the new ground temperature. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Biogeophysics2 ! Calculate soil/snow and ground temperatures +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Biogeophysics2 +! +! !INTERFACE: + subroutine Biogeophysics2 (lbl, ubl, lbc, ubc, lbp, ubp, & + num_urbanl, filter_urbanl, num_nolakec, filter_nolakec, & + num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! This is the main subroutine to execute the calculation of soil/snow and +! ground temperatures and update surface fluxes based on the new ground +! temperature +! +! Calling sequence is: +! Biogeophysics2: surface biogeophysics driver +! -> SoilTemperature: soil/snow and ground temperatures +! -> SoilTermProp thermal conductivities and heat capacities +! -> Tridiagonal tridiagonal matrix solution +! -> PhaseChange phase change of liquid/ice contents +! +! (1) Snow and soil temperatures +! o The volumetric heat capacity is calculated as a linear combination +! in terms of the volumetric fraction of the constituent phases. +! o The thermal conductivity of soil is computed from +! the algorithm of Johansen (as reported by Farouki 1981), and the +! conductivity of snow is from the formulation used in +! SNTHERM (Jordan 1991). +! o Boundary conditions: +! F = Rnet - Hg - LEg (top), F= 0 (base of the soil column). +! o Soil / snow temperature is predicted from heat conduction +! in 10 soil layers and up to 5 snow layers. +! The thermal conductivities at the interfaces between two +! neighboring layers (j, j+1) are derived from an assumption that +! the flux across the interface is equal to that from the node j +! to the interface and the flux from the interface to the node j+1. +! The equation is solved using the Crank-Nicholson method and +! results in a tridiagonal system equation. +! +! (2) Phase change (see PhaseChange.F90) +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_time_manager , only : get_step_size + use clm_varcon , only : hvap, cpair, grav, vkc, tfrz, sb, & + isturb, icol_roof, icol_sunwall, icol_shadewall, istsoil, & + istice_mec + use clm_varcon , only : istcrop + use clm_varpar , only : nlevsno, nlevgrnd, max_pft_per_col + use SoilTemperatureMod, only : SoilTemperature + use subgridAveMod , only : p2c +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbl, ubl ! landunit bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_urbanl ! number of urban landunits in clump + integer, intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + integer, intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! Migrated to clm2.0 by Keith Oleson and Mariana Vertenstein +! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: ctype(:) ! column type + integer , pointer :: clandunit(:) ! column's landunit index + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: pwtgcell(:) ! pft's weight relative to corresponding column + integer , pointer :: npfts(:) ! column's number of pfts + integer , pointer :: pfti(:) ! column's beginning pft index + integer , pointer :: snl(:) ! number of snow layers + logical , pointer :: do_capsnow(:) ! true => do snow capping + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + real(r8), pointer :: emg(:) ! ground emissivity + real(r8), pointer :: htvp(:) ! latent heat of vapor of water (or sublimation) [j/kg] + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1 now) [-] + real(r8), pointer :: cgrnds(:) ! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] + real(r8), pointer :: cgrndl(:) ! deriv of soil latent heat flux wrt soil temp [w/m**2/k] + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: dlrad(:) ! downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad(:) ! upward longwave radiation above the canopy [W/m2] + real(r8), pointer :: eflx_sh_veg(:) ! sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_veg(:) ! vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can(:) ! evaporation from leaves and stems (mm H2O/s) (+ = to atm) + real(r8), pointer :: wtcol(:) ! pft weight relative to column + real(r8), pointer :: tssbef(:,:) ! soil/snow temperature before update + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) (new) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) (new) + real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to walls, roof + real(r8), pointer :: eflx_traffic_pft(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat_pft(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_pft(:) ! sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width (-) + +! local pointers to implicit inout arguments +! + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_snwcp_liq(:) ! excess rainfall due to snow capping (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice(:) ! excess snowfall due to snow capping (mm H2O /s) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: dt_grnd(:) ! change in t_grnd, last iteration (Kelvin) + real(r8), pointer :: eflx_soil_grnd(:) ! soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_u(:)! urban soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_r(:)! rural soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_sh_tot(:) ! total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u(:) ! urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_r(:) ! rural total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: eflx_lh_tot(:) ! total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_u(:) ! urban total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_r(:) ! rural total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_grnd(:) ! ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_sub_snow(:) ! sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow(:) ! surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd(:) ! ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net(:) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_u(:) ! urban net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_r(:) ! rural net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lh_vege(:) ! veg evaporation heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vegt(:) ! veg transpiration heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_grnd(:) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(r8), pointer :: errsoi_pft(:) ! pft-level soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errsoi_col(:) ! column-level soil/lake energy conservation error (W/m**2) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: p,c,g,j,pi,l ! indices + integer :: fc,fp ! lake filtered column and pft indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: egsmax(lbc:ubc) ! max. evaporation which soil can provide at one time step + real(r8) :: egirat(lbc:ubc) ! ratio of topsoil_evap_tot : egsmax + real(r8) :: tinc(lbc:ubc) ! temperature difference of two time step + real(r8) :: xmf(lbc:ubc) ! total latent heat of phase change of ground water + real(r8) :: sumwt(lbc:ubc) ! temporary + real(r8) :: evaprat(lbp:ubp) ! ratio of qflx_evap_soi/topsoil_evap_tot + real(r8) :: save_qflx_evap_soi ! temporary storage for qflx_evap_soi + real(r8) :: topsoil_evap_tot(lbc:ubc) ! column-level total evaporation from top soil layer + real(r8) :: fact(lbc:ubc, -nlevsno+1:nlevgrnd) ! used in computing tridiagonal matrix + real(r8) :: eflx_lwrad_del(lbp:ubp) ! update due to eflx_lwrad +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (gridcell-level) + + forc_lwrad => clm_a2l%forc_lwrad + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + clandunit => col%landunit + npfts => col%npfts + pfti => col%pfti + snl => cps%snl + do_capsnow => cps%do_capsnow + htvp => cps%htvp + emg => cps%emg + t_grnd => ces%t_grnd + dt_grnd => ces%dt_grnd + t_soisno => ces%t_soisno + tssbef => ces%tssbef + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + errsoi_col => cebal%errsoi + eflx_building_heat => cef%eflx_building_heat + + ! Assign local pointers to derived subtypes components (pft-level) + + pcolumn => pft%column + plandunit => pft%landunit + pgridcell => pft%gridcell + pwtgcell => pft%wtgcell + frac_veg_nosno => pps%frac_veg_nosno + sabg => pef%sabg + dlrad => pef%dlrad + ulrad => pef%ulrad + eflx_sh_grnd => pef%eflx_sh_grnd + eflx_sh_veg => pef%eflx_sh_veg + qflx_evap_soi => pwf%qflx_evap_soi + qflx_evap_veg => pwf%qflx_evap_veg + qflx_tran_veg => pwf%qflx_tran_veg + qflx_evap_can => pwf%qflx_evap_can + qflx_snwcp_liq => pwf%qflx_snwcp_liq + qflx_snwcp_ice => pwf%qflx_snwcp_ice + qflx_evap_tot => pwf%qflx_evap_tot + qflx_evap_grnd => pwf%qflx_evap_grnd + qflx_sub_snow => pwf%qflx_sub_snow + qflx_dew_snow => pwf%qflx_dew_snow + qflx_dew_grnd => pwf%qflx_dew_grnd + eflx_soil_grnd => pef%eflx_soil_grnd + eflx_soil_grnd_u => pef%eflx_soil_grnd_u + eflx_soil_grnd_r => pef%eflx_soil_grnd_r + eflx_sh_tot => pef%eflx_sh_tot + eflx_sh_tot_u => pef%eflx_sh_tot_u + eflx_sh_tot_r => pef%eflx_sh_tot_r + eflx_lh_tot => pef%eflx_lh_tot + eflx_lh_tot_u => pef%eflx_lh_tot_u + eflx_lh_tot_r => pef%eflx_lh_tot_r + eflx_lwrad_out => pef%eflx_lwrad_out + eflx_lwrad_net => pef%eflx_lwrad_net + eflx_lwrad_net_u => pef%eflx_lwrad_net_u + eflx_lwrad_net_r => pef%eflx_lwrad_net_r + eflx_lh_vege => pef%eflx_lh_vege + eflx_lh_vegt => pef%eflx_lh_vegt + eflx_lh_grnd => pef%eflx_lh_grnd + cgrnds => pef%cgrnds + cgrndl => pef%cgrndl + eflx_sh_grnd => pef%eflx_sh_grnd + qflx_evap_soi => pwf%qflx_evap_soi + errsoi_pft => pebal%errsoi + wtcol => pft%wtcol + eflx_wasteheat_pft => pef%eflx_wasteheat_pft + eflx_heat_from_ac_pft => pef%eflx_heat_from_ac_pft + eflx_traffic_pft => pef%eflx_traffic_pft + + ! Get step size + + dtime = get_step_size() + + ! Determine soil temperatures including surface soil temperature + + call SoilTemperature(lbl, ubl, lbc, ubc, num_urbanl, filter_urbanl, & + num_nolakec, filter_nolakec, xmf , fact) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + j = snl(c)+1 + + ! Calculate difference in soil temperature from last time step, for + ! flux corrections + + tinc(c) = t_soisno(c,j) - tssbef(c,j) + + ! Determine ratio of topsoil_evap_tot + + egsmax(c) = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) / dtime + + ! added to trap very small negative soil water,ice + + if (egsmax(c) < 0._r8) then + egsmax(c) = 0._r8 + end if + end do + + ! A preliminary pft loop to determine if corrections are required for + ! excess evaporation from the top soil layer... Includes new logic + ! to distribute the corrections between pfts on the basis of their + ! evaporative demands. + ! egirat holds the ratio of demand to availability if demand is + ! greater than availability, or 1.0 otherwise. + ! Correct fluxes to present soil temperature + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + eflx_sh_grnd(p) = eflx_sh_grnd(p) + tinc(c)*cgrnds(p) + qflx_evap_soi(p) = qflx_evap_soi(p) + tinc(c)*cgrndl(p) + end do + + ! Set the column-average qflx_evap_soi as the weighted average over all pfts + ! but only count the pfts that are evaporating + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + topsoil_evap_tot(c) = 0._r8 + sumwt(c) = 0._r8 + end do + + do pi = 1,max_pft_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 + ! Note: some glacier_mec pfts may have zero weight + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + topsoil_evap_tot(c) = topsoil_evap_tot(c) + qflx_evap_soi(p) * wtcol(p) + end if + end if + end do + end do + + ! Calculate ratio for rescaling pft-level fluxes to meet availability + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (topsoil_evap_tot(c) > egsmax(c)) then + egirat(c) = (egsmax(c)/topsoil_evap_tot(c)) + else + egirat(c) = 1.0_r8 + end if + end do + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + l = plandunit(p) + g = pgridcell(p) + j = snl(c)+1 + + ! Correct soil fluxes for possible evaporation in excess of top layer water + ! excess energy is added to the sensible heat flux from soil + + if (egirat(c) < 1.0_r8) then + save_qflx_evap_soi = qflx_evap_soi(p) + qflx_evap_soi(p) = qflx_evap_soi(p) * egirat(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) + (save_qflx_evap_soi - qflx_evap_soi(p))*htvp(c) + end if + + ! Ground heat flux + + if (ltype(l) /= isturb) then + eflx_soil_grnd(p) = sabg(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) & + - emg(c)*sb*tssbef(c,j)**3*(tssbef(c,j) + 4._r8*tinc(c)) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c)) + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + eflx_soil_grnd_r(p) = eflx_soil_grnd(p) + end if + else + ! For all urban columns we use the net longwave radiation (eflx_lwrad_net) since + ! the term (emg*sb*tssbef(snl+1)**4) is not the upward longwave flux because of + ! interactions between urban columns. + + eflx_lwrad_del(p) = 4._r8*emg(c)*sb*tssbef(c,j)**3*tinc(c) + ! Include transpiration term because needed for pervious road + ! and wasteheat and traffic flux + eflx_soil_grnd(p) = sabg(p) + dlrad(p) & + - eflx_lwrad_net(p) - eflx_lwrad_del(p) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & + + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p) + eflx_soil_grnd_u(p) = eflx_soil_grnd(p) + end if + + ! Total fluxes (vegetation + ground) + + eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) + qflx_evap_tot(p) = qflx_evap_veg(p) + qflx_evap_soi(p) + eflx_lh_tot(p)= hvap*qflx_evap_veg(p) + htvp(c)*qflx_evap_soi(p) + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + eflx_lh_tot_r(p)= eflx_lh_tot(p) + eflx_sh_tot_r(p)= eflx_sh_tot(p) + else if (ltype(l) == isturb) then + eflx_lh_tot_u(p)= eflx_lh_tot(p) + eflx_sh_tot_u(p)= eflx_sh_tot(p) + end if + + ! Assign ground evaporation to sublimation from soil ice or to dew + ! on snow or ground + + qflx_evap_grnd(p) = 0._r8 + qflx_sub_snow(p) = 0._r8 + qflx_dew_snow(p) = 0._r8 + qflx_dew_grnd(p) = 0._r8 + + if (qflx_evap_soi(p) >= 0._r8) then + ! for evaporation partitioning between liquid evap and ice sublimation, + ! use the ratio of liquid to (liquid+ice) in the top layer to determine split + if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0.) then + qflx_evap_grnd(p) = max(qflx_evap_soi(p)*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._r8) + else + qflx_evap_grnd(p) = 0. + end if + qflx_sub_snow(p) = qflx_evap_soi(p) - qflx_evap_grnd(p) + else + if (t_grnd(c) < tfrz) then + qflx_dew_snow(p) = abs(qflx_evap_soi(p)) + else + qflx_dew_grnd(p) = abs(qflx_evap_soi(p)) + end if + end if + + ! Update the pft-level qflx_snwcp + ! This was moved in from Hydrology2 to keep all pft-level + ! calculations out of Hydrology2 + + if (snl(c) < 0 .and. do_capsnow(c)) then + qflx_snwcp_liq(p) = qflx_snwcp_liq(p) + qflx_dew_grnd(p) + qflx_snwcp_ice(p) = qflx_snwcp_ice(p) + qflx_dew_snow(p) + end if + + ! Variables needed by history tape + + qflx_evap_can(p) = qflx_evap_veg(p) - qflx_tran_veg(p) + eflx_lh_vege(p) = (qflx_evap_veg(p) - qflx_tran_veg(p)) * hvap + eflx_lh_vegt(p) = qflx_tran_veg(p) * hvap + eflx_lh_grnd(p) = qflx_evap_soi(p) * htvp(c) + + end do + + ! Soil Energy balance check + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + errsoi_pft(p) = eflx_soil_grnd(p) - xmf(c) + + ! For urban sunwall, shadewall, and roof columns, the "soil" energy balance check + ! must include the heat flux from the interior of the building. + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then + errsoi_pft(p) = errsoi_pft(p) + eflx_building_heat(c) + end if + end do + do j = -nlevsno+1,nlevgrnd + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + if (j >= snl(c)+1) then + errsoi_pft(p) = errsoi_pft(p) - (t_soisno(c,j)-tssbef(c,j))/fact(c,j) + end if + end do + end do + + ! Outgoing long-wave radiation from vegetation + ground + ! For conservation we put the increase of ground longwave to outgoing + ! For urban pfts, ulrad=0 and (1-fracveg_nosno)=1, and eflx_lwrad_out and eflx_lwrad_net + ! are calculated in UrbanRadiation. The increase of ground longwave is added directly + ! to the outgoing longwave and the net longwave. + + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = pcolumn(p) + l = plandunit(p) + g = pgridcell(p) + j = snl(c)+1 + + if (ltype(l) /= isturb) then + eflx_lwrad_out(p) = ulrad(p) & + + (1-frac_veg_nosno(p))*(1.-emg(c))*forc_lwrad(g) & + + (1-frac_veg_nosno(p))*emg(c)*sb*tssbef(c,j)**4 & + + 4.*emg(c)*sb*tssbef(c,j)**3*tinc(c) + eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(g) + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + eflx_lwrad_net_r(p) = eflx_lwrad_out(p) - forc_lwrad(g) + end if + else + eflx_lwrad_out(p) = eflx_lwrad_out(p) + eflx_lwrad_del(p) + eflx_lwrad_net(p) = eflx_lwrad_net(p) + eflx_lwrad_del(p) + eflx_lwrad_net_u(p) = eflx_lwrad_net_u(p) + eflx_lwrad_del(p) + end if + end do + + ! lake balance for errsoi is not over pft + ! therefore obtain column-level radiative temperature + + call p2c(num_nolakec, filter_nolakec, errsoi_pft, errsoi_col) + + end subroutine Biogeophysics2 + +end module Biogeophysics2Mod diff --git a/components/clm/src_clm40/biogeophys/BiogeophysicsLakeMod.F90 b/components/clm/src_clm40/biogeophys/BiogeophysicsLakeMod.F90 new file mode 100644 index 0000000000..d902720ea9 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/BiogeophysicsLakeMod.F90 @@ -0,0 +1,764 @@ +module BiogeophysicsLakeMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: BiogeophysicsLakeMod +! +! !DESCRIPTION: +! Calculates lake temperatures and surface fluxes. +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: BiogeophysicsLake + +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BiogeophysicsLake +! +! !INTERFACE: + subroutine BiogeophysicsLake(lbc, ubc, lbp, ubp, num_lakec, filter_lakec, & + num_lakep, filter_lakep) +! +! !DESCRIPTION: +! Calculates lake temperatures and surface fluxes. +! Lake temperatures are determined from a one-dimensional thermal +! stratification model based on eddy diffusion concepts to +! represent vertical mixing of heat. +! +! d ts d d ts 1 ds +! ---- = -- [(km + ke) ----] + -- -- +! dt dz dz cw dz +! +! where: ts = temperature (kelvin) +! t = time (s) +! z = depth (m) +! km = molecular diffusion coefficient (m**2/s) +! ke = eddy diffusion coefficient (m**2/s) +! cw = heat capacity (j/m**3/kelvin) +! s = heat source term (w/m**2) +! +! There are two types of lakes: +! Deep lakes are 50 m. +! Shallow lakes are 10 m deep. +! +! For unfrozen deep lakes: ke > 0 and convective mixing +! For unfrozen shallow lakes: ke = 0 and no convective mixing +! +! Use the Crank-Nicholson method to set up tridiagonal system of equations to +! solve for ts at time n+1, where the temperature equation for layer i is +! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1 +! +! The solution conserves energy as: +! +! cw*([ts( 1)] n+1 - [ts( 1)] n)*dz( 1)/dt + ... + +! cw*([ts(nlevlak)] n+1 - [ts(nlevlak)] n)*dz(nlevlak)/dt = fin +! +! where: +! [ts] n = old temperature (kelvin) +! [ts] n+1 = new temperature (kelvin) +! fin = heat flux into lake (w/m**2) +! = beta*sabg + forc_lwrad - eflx_lwrad_out - eflx_sh_tot - eflx_lh_tot +! - hm + phi(1) + ... + phi(nlevlak) +! +! WARNING: This subroutine assumes lake columns have one and only one pft. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevlak + use clm_varcon , only : hvap, hsub, hfus, cpair, cpliq, cpice, tkwat, tkice, & + sb, vkc, grav, denh2o, tfrz, spval + use QSatMod , only : QSat + use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni + use TridiagonalMod , only : Tridiagonal +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: num_lakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_lakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_lakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_lakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! Migrated to clm2.1 new data structures by Peter Thornton and M. Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: cgridcell(:) ! column's gridcell index + real(r8), pointer :: forc_t(:) ! atmospheric temperature (Kelvin) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft level [m] + real(r8), pointer :: forc_hgt_t_pft(:) ! observational height of temperature at pft level [m] + real(r8), pointer :: forc_hgt_q_pft(:) ! observational height of specific humidity at pft level [m] + real(r8), pointer :: forc_th(:) ! atmospheric potential temperature (Kelvin) + real(r8), pointer :: forc_q(:) ! atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_u(:) ! atmospheric wind speed in east direction (m/s) + real(r8), pointer :: forc_v(:) ! atmospheric wind speed in north direction (m/s) + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + real(r8), pointer :: forc_rho(:) ! density (kg/m**3) + real(r8), pointer :: forc_snow(:) ! snow rate [mm/s] + real(r8), pointer :: forc_rain(:) ! rain rate [mm/s] + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: hc_soisno(:) ! soil plus snow plus lake heat content (MJ/m2) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: lat(:) ! latitude (radians) + real(r8), pointer :: dz(:,:) ! layer thickness (m) + real(r8), pointer :: z(:,:) ! layer depth (m) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: qflx_prec_grnd(:) ! water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: qflx_snwcp_liq(:) ! excess rainfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: qflx_snwcp_ice(:) ! excess snowfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net(:) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_soil_grnd(:) ! soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_sh_tot(:) ! total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot(:) ! total latent heat flux (W/m8*2) [+ to atm] + real(r8), pointer :: eflx_lh_grnd(:) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(r8), pointer :: t_veg(:) ! vegetation temperature (Kelvin) + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: q_ref2m(:) ! 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: rh_ref2m(:) ! 2 m height surface relative humidity (%) + real(r8), pointer :: taux(:) ! wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy(:) ! wind (shear) stress: n-s (kg/m/s**2) + real(r8), pointer :: qmelt(:) ! snow melt [mm/s] + real(r8), pointer :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: errsoi(:) ! soil/lake energy conservation error (W/m**2) + real(r8), pointer :: t_lake(:,:) ! lake temperature (Kelvin) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer , parameter :: idlak = 1 ! index of lake, 1 = deep lake, 2 = shallow lake + integer , parameter :: niters = 3 ! maximum number of iterations for surface temperature + real(r8), parameter :: beta1 = 1._r8 ! coefficient of connective velocity (in computing W_*) [-] + real(r8), parameter :: emg = 0.97_r8 ! ground emissivity (0.97 for snow) + real(r8), parameter :: zii = 1000._r8 ! convective boundary height [m] + real(r8), parameter :: p0 = 1._r8 ! neutral value of turbulent prandtl number + integer :: i,j,fc,fp,g,c,p ! do loop or array index + integer :: fncopy ! number of values in pft filter copy + integer :: fnold ! previous number of pft filter values + integer :: fpcopy(num_lakep) ! pft filter copy for iteration loop + integer :: num_unfrzc ! number of values in unfrozen column filter + integer :: filter_unfrzc(ubc-lbc+1)! unfrozen column filter + integer :: iter ! iteration index + integer :: nmozsgn(lbp:ubp) ! number of times moz changes sign + integer :: jtop(lbc:ubc) ! number of levels for each column (all 1) + real(r8) :: dtime ! land model time step (sec) + real(r8) :: ax ! + real(r8) :: bx ! + real(r8) :: degdT ! d(eg)/dT + real(r8) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface + real(r8) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dzsur(lbc:ubc) ! + real(r8) :: eg ! water vapor pressure at temperature T [pa] + real(r8) :: hm ! energy residual [W/m2] + real(r8) :: htvp(lbc:ubc) ! latent heat of vapor of water (or sublimation) [j/kg] + real(r8) :: obu(lbp:ubp) ! monin-obukhov length (m) + real(r8) :: obuold(lbp:ubp) ! monin-obukhov length of previous iteration + real(r8) :: qsatg(lbc:ubc) ! saturated humidity [kg/kg] + real(r8) :: qsatgdT(lbc:ubc) ! d(qsatg)/dT + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: ram(lbp:ubp) ! aerodynamical resistance [s/m] + real(r8) :: rah(lbp:ubp) ! thermal resistance [s/m] + real(r8) :: raw(lbp:ubp) ! moisture resistance [s/m] + real(r8) :: stftg3(lbp:ubp) ! derivative of fluxes w.r.t ground temperature + real(r8) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(r8) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(r8) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(r8) :: tgbef(lbc:ubc) ! initial ground temperature + real(r8) :: thm(lbp:ubp) ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft) + real(r8) :: thv(lbc:ubc) ! virtual potential temperature (kelvin) + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: tksur ! thermal conductivity of snow/soil (w/m/kelvin) + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(r8) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(r8) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] + real(r8) :: displa(lbp:ubp) ! displacement (always zero) [m] + real(r8) :: z0mg(lbp:ubp) ! roughness length over ground, momentum [m] + real(r8) :: z0hg(lbp:ubp) ! roughness length over ground, sensible heat [m] + real(r8) :: z0qg(lbp:ubp) ! roughness length over ground, latent heat [m] + real(r8) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type + real(r8) :: za(2) ! base of surface absorption layer (m): depends on lake type + real(r8) :: eta(2) ! light extinction coefficient (/m): depends on lake type + real(r8) :: a(lbc:ubc,nlevlak) ! "a" vector for tridiagonal matrix + real(r8) :: b(lbc:ubc,nlevlak) ! "b" vector for tridiagonal matrix + real(r8) :: c1(lbc:ubc,nlevlak) ! "c" vector for tridiagonal matrix + real(r8) :: r(lbc:ubc,nlevlak) ! "r" vector for tridiagonal solution + real(r8) :: rhow(lbc:ubc,nlevlak) ! density of water (kg/m**3) + real(r8) :: phi(lbc:ubc,nlevlak) ! solar radiation absorbed by layer (w/m**2) + real(r8) :: kme(lbc:ubc,nlevlak) ! molecular + eddy diffusion coefficient (m**2/s) + real(r8) :: cwat ! specific heat capacity of water (j/m**3/kelvin) + real(r8) :: ws(lbc:ubc) ! surface friction velocity (m/s) + real(r8) :: ks(lbc:ubc) ! coefficient + real(r8) :: in ! relative flux of solar radiation into layer + real(r8) :: out ! relative flux of solar radiation out of layer + real(r8) :: ri ! richardson number + real(r8) :: fin(lbc:ubc) ! heat flux into lake - flux out of lake (w/m**2) + real(r8) :: ocvts(lbc:ubc) ! (cwat*(t_lake[n ])*dz + real(r8) :: ncvts(lbc:ubc) ! (cwat*(t_lake[n+1])*dz + real(r8) :: m1 ! intermediate variable for calculating r, a, b, c + real(r8) :: m2 ! intermediate variable for calculating r, a, b, c + real(r8) :: m3 ! intermediate variable for calculating r, a, b, c + real(r8) :: ke ! eddy diffusion coefficient (m**2/s) + real(r8) :: km ! molecular diffusion coefficient (m**2/s) + real(r8) :: zin ! depth at top of layer (m) + real(r8) :: zout ! depth at bottom of layer (m) + real(r8) :: drhodz ! d [rhow] /dz (kg/m**4) + real(r8) :: n2 ! brunt-vaisala frequency (/s**2) + real(r8) :: num ! used in calculating ri + real(r8) :: den ! used in calculating ri + real(r8) :: tav(lbc:ubc) ! used in aver temp for convectively mixed layers + real(r8) :: nav(lbc:ubc) ! used in aver temp for convectively mixed layers + real(r8) :: phidum ! temporary value of phi + real(r8) :: u2m ! 2 m wind speed (m/s) + real(r8) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m +! +! Constants for lake temperature model +! + data beta/0.4_r8, 0.4_r8/ ! (deep lake, shallow lake) + data za /0.6_r8, 0.5_r8/ + data eta /0.1_r8, 0.5_r8/ +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (gridcell-level) + + forc_t => clm_a2l%forc_t + forc_pbot => clm_a2l%forc_pbot + forc_th => clm_a2l%forc_th + forc_q => clm_a2l%forc_q + forc_u => clm_a2l%forc_u + forc_v => clm_a2l%forc_v + forc_rho => clm_a2l%forc_rho + forc_lwrad => clm_a2l%forc_lwrad + forc_snow => clm_a2l%forc_snow + forc_rain => clm_a2l%forc_rain + lat => grc%lat + + ! Assign local pointers to derived type members (column-level) + + cgridcell => col%gridcell + dz => cps%dz + z => cps%z + t_lake => ces%t_lake + h2osno => cws%h2osno + snowdp => cps%snowdp + t_grnd => ces%t_grnd + hc_soisno => ces%hc_soisno + errsoi => cebal%errsoi + qmelt => cwf%qmelt + + ! Assign local pointers to derived type members (pft-level) + + pcolumn => pft%column + pgridcell => pft%gridcell + sabg => pef%sabg + t_ref2m => pes%t_ref2m + q_ref2m => pes%q_ref2m + rh_ref2m => pes%rh_ref2m + t_veg => pes%t_veg + eflx_lwrad_out => pef%eflx_lwrad_out + eflx_lwrad_net => pef%eflx_lwrad_net + eflx_soil_grnd => pef%eflx_soil_grnd + eflx_lh_tot => pef%eflx_lh_tot + eflx_lh_grnd => pef%eflx_lh_grnd + eflx_sh_grnd => pef%eflx_sh_grnd + eflx_sh_tot => pef%eflx_sh_tot + ram1 => pps%ram1 + taux => pmf%taux + tauy => pmf%tauy + qflx_prec_grnd => pwf%qflx_prec_grnd + qflx_evap_soi => pwf%qflx_evap_soi + qflx_evap_tot => pwf%qflx_evap_tot + forc_hgt_u_pft => pps%forc_hgt_u_pft + forc_hgt_t_pft => pps%forc_hgt_t_pft + forc_hgt_q_pft => pps%forc_hgt_q_pft + qflx_snwcp_ice => pwf%qflx_snwcp_ice + qflx_snwcp_liq => pwf%qflx_snwcp_liq + + ! Determine step size + + dtime = get_step_size() + + ! Begin calculations + + do fc = 1, num_lakec + c = filter_lakec(fc) + g = cgridcell(c) + + ! Initialize quantities computed below + + ocvts(c) = 0._r8 + ncvts(c) = 0._r8 + hc_soisno(c) = 0._r8 + + ! Surface temperature and fluxes + + dzsur(c) = dz(c,1) + snowdp(c) + + ! Saturated vapor pressure, specific humidity and their derivatives + ! at lake surface + + call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c)) + + ! Potential, virtual potential temperature, and wind speed at the + ! reference height + + !zii = 1000. ! m (pbl height) + thv(c) = forc_th(g)*(1._r8+0.61_r8*forc_q(g)) ! virtual potential T + end do + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + nmozsgn(p) = 0 + obuold(p) = 0._r8 + displa(p) = 0._r8 + thm(p) = forc_t(g) + 0.0098_r8*forc_hgt_t_pft(p) ! intermediate variable + + ! Roughness lengths + + if (t_grnd(c) >= tfrz) then ! for unfrozen lake + z0mg(p) = 0.01_r8 + else ! for frozen lake + z0mg(p) = 0.04_r8 + end if + z0hg(p) = z0mg(p) + z0qg(p) = z0mg(p) + + ! Latent heat + + if (forc_t(g) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + + ! Initialize stability variables + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-t_grnd(c) + dqh(p) = forc_q(g)-qsatg(c) + dthv = dth(p)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(p) + zldis(p) = forc_hgt_u_pft(p) - 0._r8 + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg(p), um(p), obu(p)) + + end do + + iter = 1 + fncopy = num_lakep + fpcopy(1:num_lakep) = filter_lakep(1:num_lakep) + + ! Begin stability iteration + + ITERATION : do while (iter <= niters .and. fncopy > 0) + + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + call FrictionVelocity(lbp, ubp, fncopy, fpcopy, & + displa, z0mg, z0hg, z0qg, & + obu, iter, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm) + + do fp = 1, fncopy + p = fpcopy(fp) + c = pcolumn(p) + g = pgridcell(p) + + tgbef(c) = t_grnd(c) + if (t_grnd(c) > tfrz) then + tksur = tkwat + else + tksur = tkice + end if + + ! Determine aerodynamic resistances + + ram(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah(p) = 1._r8/(temp1(p)*ustar(p)) + raw(p) = 1._r8/(temp2(p)*ustar(p)) + ram1(p) = ram(p) !pass value to global variable + + ! Get derivative of fluxes with respect to ground temperature + + stftg3(p) = emg*sb*tgbef(c)*tgbef(c)*tgbef(c) + + ax = sabg(p) + emg*forc_lwrad(g) + 3._r8*stftg3(p)*tgbef(c) & + + forc_rho(g)*cpair/rah(p)*thm(p) & + - htvp(c)*forc_rho(g)/raw(p)*(qsatg(c)-qsatgdT(c)*tgbef(c) - forc_q(g)) & + + tksur*t_lake(c,1)/dzsur(c) + + bx = 4._r8*stftg3(p) + forc_rho(g)*cpair/rah(p) & + + htvp(c)*forc_rho(g)/raw(p)*qsatgdT(c) + tksur/dzsur(c) + + t_grnd(c) = ax/bx + + ! Surface fluxes of momentum, sensible and latent heat + ! using ground temperatures from previous time step + + eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(p))/rah(p) + qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c))-forc_q(g))/raw(p) + + ! Re-calculate saturated vapor pressure, specific humidity and their + ! derivatives at lake surface + + call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c)) + + dth(p)=thm(p)-t_grnd(c) + dqh(p)=forc_q(g)-qsatg(c) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + + !not used + !dthv=dth(p)*(1.+0.61*forc_q(g))+0.61*forc_th(g)*dqh(p) + thvstar=tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar + zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p)+wc*wc) + end if + obu(p) = zldis(p)/zeta + + if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 + + obuold(p) = obu(p) + + end do ! end of filtered pft loop + + iter = iter + 1 + if (iter <= niters ) then + ! Rebuild copy of pft filter for next pass through the ITERATION loop + + fnold = fncopy + fncopy = 0 + do fp = 1, fnold + p = fpcopy(fp) + if (nmozsgn(p) < 3) then + fncopy = fncopy + 1 + fpcopy(fncopy) = p + end if + end do ! end of filtered pft loop + end if + + end do ITERATION ! end of stability iteration + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + ! initialize snow cap terms to zero for lake columns + qflx_snwcp_ice(p) = 0._r8 + qflx_snwcp_liq(p) = 0._r8 + + ! If there is snow on the ground and t_grnd > tfrz: reset t_grnd = tfrz. + ! Re-evaluate ground fluxes. Energy imbalance used to melt snow. + ! h2osno > 0.5 prevents spurious fluxes. + ! note that qsatg and qsatgdT should be f(tgbef) (PET: not sure what this + ! comment means) + + if (h2osno(c) > 0.5_r8 .AND. t_grnd(c) > tfrz) then + t_grnd(c) = tfrz + eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(p))/rah(p) + qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c)) - forc_q(g))/raw(p) + end if + + ! Net longwave from ground to atmosphere + + eflx_lwrad_out(p) = (1._r8-emg)*forc_lwrad(g) + stftg3(p)*(-3._r8*tgbef(c)+4._r8*t_grnd(c)) + + ! Ground heat flux + + eflx_soil_grnd(p) = sabg(p) + forc_lwrad(g) - eflx_lwrad_out(p) - & + eflx_sh_grnd(p) - htvp(c)*qflx_evap_soi(p) + + taux(p) = -forc_rho(g)*forc_u(g)/ram(p) + tauy(p) = -forc_rho(g)*forc_v(g)/ram(p) + + eflx_sh_tot(p) = eflx_sh_grnd(p) + qflx_evap_tot(p) = qflx_evap_soi(p) + eflx_lh_tot(p) = htvp(c)*qflx_evap_soi(p) + eflx_lh_grnd(p) = htvp(c)*qflx_evap_soi(p) + + ! 2 m height air temperature + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + + ! 2 m height specific humidity + q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + + ! Energy residual used for melting snow + if (h2osno(c) > 0._r8 .AND. t_grnd(c) >= tfrz) then + hm = min(h2osno(c)*hfus/dtime, max(eflx_soil_grnd(p),0._r8)) + else + hm = 0._r8 + end if + qmelt(c) = hm/hfus ! snow melt (mm/s) + + ! Prepare for lake layer temperature calculations below + + fin(c) = beta(idlak) * sabg(p) + forc_lwrad(g) - (eflx_lwrad_out(p) + & + eflx_sh_tot(p) + eflx_lh_tot(p) + hm) + u2m = max(1.0_r8,ustar(p)/vkc*log(2._r8/z0mg(p))) + + ws(c) = 1.2e-03_r8 * u2m + ks(c) = 6.6_r8*sqrt(abs(sin(lat(g))))*(u2m**(-1.84_r8)) + + end do + + ! Eddy diffusion + molecular diffusion coefficient (constants): + ! eddy diffusion coefficient used for unfrozen deep lakes only + + cwat = cpliq*denh2o ! a constant + km = tkwat/cwat ! a constant + + ! Lake density + + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + rhow(c,j) = 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,j)-277._r8))**1.68_r8 ) + end do + end do + + do j = 1, nlevlak-1 + do fc = 1, num_lakec + c = filter_lakec(fc) + drhodz = (rhow(c,j+1)-rhow(c,j)) / (z(c,j+1)-z(c,j)) + n2 = -grav / rhow(c,j) * drhodz + num = 40._r8 * n2 * (vkc*z(c,j))**2 + den = max( (ws(c)**2) * exp(-2._r8*ks(c)*z(c,j)), 1.e-10_r8 ) + ri = ( -1._r8 + sqrt( max(1._r8+num/den, 0._r8) ) ) / 20._r8 + if (t_grnd(c) > tfrz) then + ! valid for deep lake only (idlak == 1) + ke = vkc*ws(c)*z(c,j)/p0 * exp(-ks(c)*z(c,j)) / (1._r8+37._r8*ri*ri) + else + ke = 0._r8 + end if + kme(c,j) = km + ke + end do + end do + + do fc = 1, num_lakec + c = filter_lakec(fc) + kme(c,nlevlak) = kme(c,nlevlak-1) + ! set number of column levels for use by Tridiagonal below + jtop(c) = 1 + end do + + ! Heat source term: unfrozen lakes only + + do j = 1, nlevlak + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + + zin = z(c,j) - 0.5_r8*dz(c,j) + zout = z(c,j) + 0.5_r8*dz(c,j) + in = exp( -eta(idlak)*max( zin-za(idlak),0._r8 ) ) + out = exp( -eta(idlak)*max( zout-za(idlak),0._r8 ) ) + + ! Assume solar absorption is only in the considered depth + if (j == nlevlak) out = 0._r8 + if (t_grnd(c) > tfrz) then + phidum = (in-out) * sabg(p) * (1._r8-beta(idlak)) + else if (j == 1) then + phidum = sabg(p) * (1._r8-beta(idlak)) + else + phidum = 0._r8 + end if + phi(c,j) = phidum + end do + end do + + ! Sum cwat*t_lake*dz for energy check + + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + + ocvts(c) = ocvts(c) + cwat*t_lake(c,j)*dz(c,j) + end do + end do + + ! Set up vector r and vectors a, b, c that define tridiagonal matrix + + do fc = 1, num_lakec + c = filter_lakec(fc) + + j = 1 + m2 = dz(c,j)/kme(c,j) + dz(c,j+1)/kme(c,j+1) + m3 = dtime/dz(c,j) + r(c,j) = t_lake(c,j) + (fin(c)+phi(c,j))*m3/cwat - (t_lake(c,j)-t_lake(c,j+1))*m3/m2 + a(c,j) = 0._r8 + b(c,j) = 1._r8 + m3/m2 + c1(c,j) = -m3/m2 + + j = nlevlak + m1 = dz(c,j-1)/kme(c,j-1) + dz(c,j)/kme(c,j) + m3 = dtime/dz(c,j) + r(c,j) = t_lake(c,j) + phi(c,j)*m3/cwat + (t_lake(c,j-1)-t_lake(c,j))*m3/m1 + a(c,j) = -m3/m1 + b(c,j) = 1._r8 + m3/m1 + c1(c,j) = 0._r8 + end do + + do j = 2, nlevlak-1 + do fc = 1, num_lakec + c = filter_lakec(fc) + + m1 = dz(c,j-1)/kme(c,j-1) + dz(c,j )/kme(c,j ) + m2 = dz(c,j )/kme(c,j ) + dz(c,j+1)/kme(c,j+1) + m3 = dtime/dz(c,j) + r(c,j) = t_lake(c,j) + phi(c,j)*m3/cwat + & + (t_lake(c,j-1) - t_lake(c,j ))*m3/m1 - & + (t_lake(c,j ) - t_lake(c,j+1))*m3/m2 + + a(c,j) = -m3/m1 + b(c,j) = 1._r8 + m3/m1 + m3/m2 + c1(c,j) = -m3/m2 + end do + end do + + ! Solve for t_lake: a, b, c, r, u + + call Tridiagonal(lbc, ubc, 1, nlevlak, jtop, num_lakec, filter_lakec, & + a, b, c1, r, t_lake(lbc:ubc,1:nlevlak)) + + ! Convective mixing: make sure cwat*dz*ts is conserved. Valid only for + ! deep lakes (idlak == 1). + + num_unfrzc = 0 + do fc = 1, num_lakec + c = filter_lakec(fc) + if (t_grnd(c) > tfrz) then + num_unfrzc = num_unfrzc + 1 + filter_unfrzc(num_unfrzc) = c + end if + end do + + do j = 1, nlevlak-1 + do fc = 1, num_unfrzc + c = filter_unfrzc(fc) + tav(c) = 0._r8 + nav(c) = 0._r8 + end do + + do i = 1, j+1 + do fc = 1, num_unfrzc + c = filter_unfrzc(fc) + if (rhow(c,j) > rhow(c,j+1)) then + tav(c) = tav(c) + t_lake(c,i)*dz(c,i) + nav(c) = nav(c) + dz(c,i) + end if + end do + end do + + do fc = 1, num_unfrzc + c = filter_unfrzc(fc) + if (rhow(c,j) > rhow(c,j+1)) then + tav(c) = tav(c)/nav(c) + end if + end do + + do i = 1, j+1 + do fc = 1, num_unfrzc + c = filter_unfrzc(fc) + if (nav(c) > 0._r8) then + t_lake(c,i) = tav(c) + rhow(c,i) = 1000._r8*( 1.0_r8 - 1.9549e-05_r8*(abs(t_lake(c,i)-277._r8))**1.68_r8 ) + end if + end do + end do + end do + + ! Sum cwat*t_lake*dz and total energy into lake for energy check + + do j = 1, nlevlak + do fc = 1, num_lakec + c = filter_lakec(fc) + ncvts(c) = ncvts(c) + cwat*t_lake(c,j)*dz(c,j) + hc_soisno(c) = hc_soisno(c) + cwat*t_lake(c,j)*dz(c,j) /1.e6_r8 + if (j == nlevlak) then + hc_soisno(c) = hc_soisno(c) + & + cpice*h2osno(c)*t_grnd(c)*snowdp(c) /1.e6_r8 + endif + fin(c) = fin(c) + phi(c,j) + end do + end do + + ! The following are needed for global average on history tape. + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + g = pgridcell(p) + errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) + t_veg(p) = forc_t(g) + eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(g) + qflx_prec_grnd(p) = forc_rain(g) + forc_snow(g) + end do + + end subroutine BiogeophysicsLake + +end module BiogeophysicsLakeMod diff --git a/components/clm/src_clm40/biogeophys/CanopyFluxesMod.F90 b/components/clm/src_clm40/biogeophys/CanopyFluxesMod.F90 new file mode 100644 index 0000000000..4ddf095a0c --- /dev/null +++ b/components/clm/src_clm40/biogeophys/CanopyFluxesMod.F90 @@ -0,0 +1,1434 @@ +module CanopyFluxesMod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: CanopyFluxesMod +! +! !DESCRIPTION: +! Calculates the leaf temperature and the leaf fluxes, +! transpiration, photosynthesis and updates the dew +! accumulation due to evaporation. +! +! !USES: + use abortutils, only: endrun + use clm_varctl, only: iulog, use_c13, use_cn, use_cndv + use shr_sys_mod, only: shr_sys_flush +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: CanopyFluxes !Calculates the leaf temperature and leaf fluxes +! +! !PRIVATE MEMBER FUNCTIONS: + private :: Stomata !Leaf stomatal resistance and leaf photosynthesis +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 4/25/05, Peter Thornton: replaced old Stomata subroutine with what +! used to be called StomataCN, as part of migration to new sun/shade +! algorithms. +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CanopyFluxes +! +! !INTERFACE: + subroutine CanopyFluxes(lbg, ubg, lbc, ubc, lbp, ubp, & + num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! 1. Calculates the leaf temperature: +! 2. Calculates the leaf fluxes, transpiration, photosynthesis and +! updates the dew accumulation due to evaporation. +! +! Method: +! Use the Newton-Raphson iteration to solve for the foliage +! temperature that balances the surface energy budget: +! +! f(t_veg) = Net radiation - Sensible - Latent = 0 +! f(t_veg) + d(f)/d(t_veg) * dt_veg = 0 (*) +! +! Note: +! (1) In solving for t_veg, t_grnd is given from the previous timestep. +! (2) The partial derivatives of aerodynamical resistances, which cannot +! be determined analytically, are ignored for d(H)/dT and d(LE)/dT +! (3) The weighted stomatal resistance of sunlit and shaded foliage is used +! (4) Canopy air temperature and humidity are derived from => Hc + Hg = Ha +! => Ec + Eg = Ea +! (5) Energy loss is due to: numerical truncation of energy budget equation +! (*); and "ecidif" (see the code) which is dropped into the sensible +! heat +! (6) The convergence criteria: the difference, del = t_veg(n+1)-t_veg(n) +! and del2 = t_veg(n)-t_veg(n-1) less than 0.01 K, and the difference +! of water flux from the leaf between the iteration step (n+1) and (n) +! less than 0.1 W/m2; or the iterative steps over 40. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_time_manager , only : get_step_size, get_prev_date + use clm_varpar , only : nlevgrnd, nlevsno + use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice, & + denh2o, tfrz, csoilc, tlsai_crit, alpha_aero, & + isecspday, degpsec + use shr_const_mod , only : SHR_CONST_TKFRZ + use pftvarcon , only : nirrig + use QSatMod , only : QSat + use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni + use spmdMod , only : masterproc +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbg, ubg ! gridcell bounds + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_nolakep ! number of column non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine Biogeophysics1 in module Biogeophysics1Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 12/19/01, Peter Thornton +! Changed tg to t_grnd for consistency with other routines +! 1/29/02, Peter Thornton +! Migrate to new data structures, new calling protocol. For now co2 and +! o2 partial pressures are hardwired, but they should be coming in from +! forc_pco2 and forc_po2. Keeping the same hardwired values as in CLM2 to +! assure bit-for-bit results in the first comparisons. +! 27 February 2008: Keith Oleson; Sparse/dense aerodynamic parameters from +! X. Zeng +! 6 March 2009: Peter Thornton; Daylength control on Vcmax, from Bill Bauerle +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in variables +! + integer , pointer :: frac_veg_nosno(:) ! frac of veg not covered by snow (0 OR 1 now) [-] + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: forc_th(:) ! atmospheric potential temperature (Kelvin) + real(r8), pointer :: t_grnd(:) ! ground surface temperature [K] + real(r8), pointer :: thm(:) ! intermediate variable (forc_t+0.0098*forc_hgt_t_pft) + real(r8), pointer :: qg(:) ! specific humidity at ground surface [kg/kg] + real(r8), pointer :: thv(:) ! virtual potential temperature (kelvin) + real(r8), pointer :: z0mv(:) ! roughness length over vegetation, momentum [m] + real(r8), pointer :: z0hv(:) ! roughness length over vegetation, sensible heat [m] + real(r8), pointer :: z0qv(:) ! roughness length over vegetation, latent heat [m] + real(r8), pointer :: z0mg(:) ! roughness length of ground, momentum [m] + real(r8), pointer :: dqgdT(:) ! temperature derivative of "qg" + real(r8), pointer :: htvp(:) ! latent heat of evaporation (/sublimation) [J/kg] + real(r8), pointer :: emv(:) ! ground emissivity + real(r8), pointer :: emg(:) ! vegetation emissivity + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: forc_pco2(:) ! partial pressure co2 (Pa) + + ! 4/14/05: PET + ! Adding isotope code + real(r8), pointer :: forc_pc13o2(:) ! partial pressure c13o2 (Pa) + + real(r8), pointer :: forc_po2(:) ! partial pressure o2 (Pa) + real(r8), pointer :: forc_q(:) ! atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_u(:) ! atmospheric wind speed in east direction (m/s) + real(r8), pointer :: forc_v(:) ! atmospheric wind speed in north direction (m/s) + real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m] + real(r8), pointer :: forc_rho(:) ! density (kg/m**3) + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + real(r8), pointer :: displa(:) ! displacement height (m) + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] + real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) + real(r8), pointer :: laisun(:) ! sunlit leaf area + real(r8), pointer :: laisha(:) ! shaded leaf area + real(r8), pointer :: sabv(:) ! solar radiation absorbed by vegetation (W/m**2) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: watdry(:,:) ! btran parameter for btran=0 + real(r8), pointer :: watopt(:,:) ! btran parameter for btran = 1 + real(r8), pointer :: h2osoi_ice(:,:)! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:)! liquid water (kg/m2) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(r8), pointer :: rootfr(:,:) ! fraction of roots in each soil layer + real(r8), pointer :: dleaf(:) ! characteristic leaf dimension (m) + real(r8), pointer :: smpso(:) ! soil water potential at full stomatal opening (mm) + real(r8), pointer :: smpsc(:) ! soil water potential at full stomatal closure (mm) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: htop(:) ! canopy top(m) + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: soilbeta(:) ! soil wetness relative to field capacity + real(r8), pointer :: lat(:) ! latitude (radians) + real(r8), pointer :: decl(:) ! declination angle (radians) + real(r8), pointer :: max_dayl(:) !maximum daylength for this column (s) + real(r8), pointer :: londeg(:) ! longitude (degrees) (for calculation of local time) + +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: cgrnds(:) ! deriv. of soil sensible heat flux wrt soil temp [w/m2/k] + real(r8), pointer :: cgrndl(:) ! deriv. of soil latent heat flux wrt soil temp [w/m**2/k] + real(r8), pointer :: t_veg(:) ! vegetation temperature (Kelvin) + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: q_ref2m(:) ! 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: t_ref2m_r(:) ! Rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: rh_ref2m(:) ! 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_r(:) ! Rural 2 m height surface relative humidity (%) + real(r8), pointer :: h2ocan(:) ! canopy water (mm H2O) + real(r8), pointer :: cisun(:) !sunlit intracellular CO2 (Pa) + real(r8), pointer :: cisha(:) !shaded intracellular CO2 (Pa) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: rb1(:) ! boundary layer resistance (s/m) + real(r8), pointer :: cgrnd(:) ! deriv. of soil energy flux wrt to soil temp [w/m2/k] + real(r8), pointer :: dlrad(:) ! downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad(:) ! upward longwave radiation above the canopy [W/m2] + real(r8), pointer :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: btran(:) ! transpiration wetness factor (0 to 1) + real(r8), pointer :: rssun(:) ! sunlit stomatal resistance (s/m) + real(r8), pointer :: rssha(:) ! shaded stomatal resistance (s/m) + real(r8), pointer :: psnsun(:) ! sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) ! shaded leaf photosynthesis (umol CO2 /m**2/ s) + + ! 4/14/05: PET + ! Adding isotope code + real(r8), pointer :: c13_psnsun(:) ! sunlit leaf photosynthesis (umol 13CO2 /m**2/ s) + real(r8), pointer :: c13_psnsha(:) ! shaded leaf photosynthesis (umol 13CO2 /m**2/ s) + ! 4/21/05: PET + ! Adding isotope code + real(r8), pointer :: rc13_canair(:) !C13O2/C12O2 in canopy air + real(r8), pointer :: rc13_psnsun(:) !C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer :: rc13_psnsha(:) !C13O2/C12O2 in shaded canopy psn flux + real(r8), pointer :: alphapsnsun(:) !fractionation factor in sunlit canopy psn flux + real(r8), pointer :: alphapsnsha(:) !fractionation factor in shaded canopy psn flux + + real(r8), pointer :: qflx_tran_veg(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: dt_veg(:) ! change in t_veg, last iteration (Kelvin) + real(r8), pointer :: qflx_evap_veg(:) ! vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: eflx_sh_veg(:) ! sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: taux(:) ! wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy(:) ! wind (shear) stress: n-s (kg/m/s**2) + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: fpsn(:) ! photosynthesis (umol CO2 /m**2 /s) + real(r8), pointer :: rootr(:,:) ! effective fraction of roots in each soil layer + real(r8), pointer :: rresis(:,:) ! root resistance by layer (0-1) (nlevgrnd) + real(r8), pointer :: irrig_rate(:) ! current irrigation rate [mm/s] + integer, pointer :: n_irrig_steps_left(:) ! # of time steps for which we still need to irrigate today +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + real(r8), parameter :: btran0 = 0.0_r8 ! initial value + real(r8), parameter :: zii = 1000.0_r8 ! convective boundary layer height [m] + real(r8), parameter :: beta = 1.0_r8 ! coefficient of conective velocity [-] + real(r8), parameter :: delmax = 1.0_r8 ! maxchange in leaf temperature [K] + real(r8), parameter :: dlemin = 0.1_r8 ! max limit for energy flux convergence [w/m2] + real(r8), parameter :: dtmin = 0.01_r8 ! max limit for temperature convergence [K] + integer , parameter :: itmax = 40 ! maximum number of iteration [-] + integer , parameter :: itmin = 2 ! minimum number of iteration [-] + real(r8), parameter :: irrig_min_lai = 0.0_r8 ! Minimum LAI for irrigation + real(r8), parameter :: irrig_btran_thresh = 0.999999_r8 ! Irrigate when btran falls below 0.999999 rather than 1 to allow for round-off error + integer , parameter :: irrig_start_time = isecspday/4 ! Time of day to check whether we need irrigation, seconds (0 = midnight). + ! We start applying the irrigation in the time step FOLLOWING this time, + ! since we won't begin irrigating until the next call to Hydrology1 + integer , parameter :: irrig_length = isecspday/6 ! Desired amount of time to irrigate per day (sec). Actual time may + ! differ if this is not a multiple of dtime. Irrigation won't work properly + ! if dtime > secsperday + real(r8), parameter :: irrig_factor = 0.7_r8 ! Determines target soil moisture level for irrigation. If h2osoi_liq_so + ! is the soil moisture level at which stomata are fully open and + ! h2osoi_liq_sat is the soil moisture level at saturation (eff_porosity), + ! then the target soil moisture level is + ! (h2osoi_liq_so + irrig_factor*(h2osoi_liq_sat - h2osoi_liq_so)). + ! A value of 0 means that the target soil moisture level is h2osoi_liq_so. + ! A value of 1 means that the target soil moisture level is h2osoi_liq_sat + + !added by K.Sakaguchi for litter resistance + real(r8), parameter :: lai_dl = 0.5_r8 ! placeholder for (dry) plant litter area index (m2/m2) + real(r8), parameter :: z_dl = 0.05_r8 ! placeholder for (dry) litter layer thickness (m) + !added by K.Sakaguchi for stability formulation + real(r8), parameter :: ria = 0.5_r8 ! free parameter for stable formulation (currently = 0.5, "gamma" in Sakaguchi&Zeng,2008) + real(r8) :: dtime ! land model time step (sec) + real(r8) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface + real(r8) :: dthv(lbp:ubp) ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface + real(r8) :: obu(lbp:ubp) ! Monin-Obukhov length (m) + real(r8) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(r8) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(r8) :: uaf(lbp:ubp) ! velocity of air within foliage [m/s] + real(r8) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(r8) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(r8) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(r8) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: taf(lbp:ubp) ! air temperature within canopy space [K] + real(r8) :: qaf(lbp:ubp) ! humidity of canopy air [kg/kg] + real(r8) :: rpp ! fraction of potential evaporation from leaf [-] + real(r8) :: rppdry ! fraction of potential evaporation through transp [-] + real(r8) :: cf ! heat transfer coefficient from leaves [-] + real(r8) :: rb(lbp:ubp) ! leaf boundary layer resistance [s/m] + real(r8) :: rah(lbp:ubp,2) ! thermal resistance [s/m] + real(r8) :: raw(lbp:ubp,2) ! moisture resistance [s/m] + real(r8) :: wta ! heat conductance for air [m/s] + real(r8) :: wtg(lbp:ubp) ! heat conductance for ground [m/s] + real(r8) :: wtl ! heat conductance for leaf [m/s] + real(r8) :: wta0(lbp:ubp) ! normalized heat conductance for air [-] + real(r8) :: wtl0(lbp:ubp) ! normalized heat conductance for leaf [-] + real(r8) :: wtg0 ! normalized heat conductance for ground [-] + real(r8) :: wtal(lbp:ubp) ! normalized heat conductance for air and leaf [-] + real(r8) :: wtga ! normalized heat cond. for air and ground [-] + real(r8) :: wtaq ! latent heat conductance for air [m/s] + real(r8) :: wtlq ! latent heat conductance for leaf [m/s] + real(r8) :: wtgq(lbp:ubp) ! latent heat conductance for ground [m/s] + real(r8) :: wtaq0(lbp:ubp) ! normalized latent heat conductance for air [-] + real(r8) :: wtlq0(lbp:ubp) ! normalized latent heat conductance for leaf [-] + real(r8) :: wtgq0 ! normalized heat conductance for ground [-] + real(r8) :: wtalq(lbp:ubp) ! normalized latent heat cond. for air and leaf [-] + real(r8) :: wtgaq ! normalized latent heat cond. for air and ground [-] + real(r8) :: el(lbp:ubp) ! vapor pressure on leaf surface [pa] + real(r8) :: deldT ! derivative of "el" on "t_veg" [pa/K] + real(r8) :: qsatl(lbp:ubp) ! leaf specific humidity [kg/kg] + real(r8) :: qsatldT(lbp:ubp) ! derivative of "qsatl" on "t_veg" + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + real(r8) :: air(lbp:ubp),bir(lbp:ubp),cir(lbp:ubp) ! atmos. radiation temporay set + real(r8) :: dc1,dc2 ! derivative of energy flux [W/m2/K] + real(r8) :: delt ! temporary + real(r8) :: delq(lbp:ubp) ! temporary + real(r8) :: del(lbp:ubp) ! absolute change in leaf temp in current iteration [K] + real(r8) :: del2(lbp:ubp) ! change in leaf temperature in previous iteration [K] + real(r8) :: dele(lbp:ubp) ! change in latent heat flux from leaf [K] + real(r8) :: dels ! change in leaf temperature in current iteration [K] + real(r8) :: det(lbp:ubp) ! maximum leaf temp. change in two consecutive iter [K] + real(r8) :: efeb(lbp:ubp) ! latent heat flux from leaf (previous iter) [mm/s] + real(r8) :: efeold ! latent heat flux from leaf (previous iter) [mm/s] + real(r8) :: efpot ! potential latent energy flux [kg/m2/s] + real(r8) :: efe(lbp:ubp) ! water flux from leaf [mm/s] + real(r8) :: efsh ! sensible heat from leaf [mm/s] + real(r8) :: obuold(lbp:ubp) ! monin-obukhov length from previous iteration + real(r8) :: tlbef(lbp:ubp) ! leaf temperature from previous iteration [K] + real(r8) :: ecidif ! excess energies [W/m2] + real(r8) :: err(lbp:ubp) ! balance error + real(r8) :: erre ! balance error + real(r8) :: co2(lbp:ubp) ! atmospheric co2 partial pressure (pa) + + ! 4/14/05: PET + ! Adding isotope code + real(r8) :: c13o2(lbp:ubp) ! atmospheric c13o2 partial pressure (pa) + + real(r8) :: o2(lbp:ubp) ! atmospheric o2 partial pressure (pa) + real(r8) :: svpts(lbp:ubp) ! saturation vapor pressure at t_veg (pa) + real(r8) :: eah(lbp:ubp) ! canopy air vapor pressure (pa) + real(r8) :: s_node ! vol_liq/eff_porosity + real(r8) :: smp_node ! matrix potential + real(r8) :: vol_ice ! partial volume of ice lens in layer + real(r8) :: eff_porosity ! effective porosity in layer + real(r8) :: vol_liq ! partial volume of liquid water in layer + integer :: itlef ! counter for leaf temperature iteration [-] + integer :: nmozsgn(lbp:ubp) ! number of times stability changes sign + real(r8) :: w ! exp(-LSAI) + real(r8) :: csoilcn ! interpolated csoilc for less than dense canopies + real(r8) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed + real(r8) :: wtshi ! sensible heat resistance for air, grnd and leaf [-] + real(r8) :: wtsqi ! latent heat resistance for air, grnd and leaf [-] + integer :: j ! soil/snow level index + integer :: p ! pft index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! gridcell index + integer :: fp ! lake filter pft index + integer :: fn ! number of values in pft filter + integer :: fnorig ! number of values in pft filter copy + integer :: fnold ! temporary copy of pft count + integer :: f ! filter index + integer :: filterp(ubp-lbp+1) ! temporary filter + integer :: fporig(ubp-lbp+1) ! temporary filter + real(r8) :: displa_loc(lbp:ubp) ! temporary copy + real(r8) :: z0mv_loc(lbp:ubp) ! temporary copy + real(r8) :: z0hv_loc(lbp:ubp) ! temporary copy + real(r8) :: z0qv_loc(lbp:ubp) ! temporary copy + logical :: found ! error flag for canopy above forcing hgt + integer :: index ! pft index for error + real(r8) :: egvf ! effective green vegetation fraction + real(r8) :: lt ! elai+esai + real(r8) :: ri ! stability parameter for under canopy air (unitless) + real(r8) :: csoilb ! turbulent transfer coefficient over bare soil (unitless) + real(r8) :: ricsoilc ! modified transfer coefficient under dense canopy (unitless) + real(r8) :: snowdp_c ! critical snow depth to cover plant litter (m) + real(r8) :: rdl ! dry litter layer resistance for water vapor (s/m) + real(r8) :: elai_dl ! exposed (dry) plant litter area index + real(r8) :: fsno_dl ! effective snow cover over plant litter + real(r8) :: dayl ! daylength (s) + real(r8) :: temp ! temporary, for daylength calculation + real(r8) :: dayl_factor(lbp:ubp) ! scalar (0-1) for daylength effect on Vcmax + integer :: yr ! year at start of time step + integer :: mon ! month at start of time step + integer :: day ! day at start of time step + integer :: time ! time at start of time step (seconds after 0Z) + integer :: local_time ! local time at start of time step (seconds after solar midnight) + integer :: irrig_nsteps_per_day ! number of time steps per day in which we irrigate + logical :: check_for_irrig(lbp:ubp) ! where do we need to check soil moisture to see if we need to irrigate? + logical :: frozen_soil(lbc:ubc) ! set to true if we have encountered a frozen soil layer + real(r8) :: vol_liq_so ! partial volume of liquid water in layer for which smp_node = smpso + real(r8) :: h2osoi_liq_so ! liquid water corresponding to vol_liq_so for this layer [kg/m2] + real(r8) :: h2osoi_liq_sat ! liquid water corresponding to eff_porosity for this layer [kg/m2] + real(r8) :: deficit ! difference between desired soil moisture level for this layer and current soil moisture level [kg/m2] +!------------------------------------------------------------------------------ + + ! Assign local pointers to derived type members (gridcell-level) + + forc_lwrad => clm_a2l%forc_lwrad + forc_pco2 => clm_a2l%forc_pco2 + + forc_pc13o2 => clm_a2l%forc_pc13o2 + + forc_po2 => clm_a2l%forc_po2 + forc_q => clm_a2l%forc_q + forc_pbot => clm_a2l%forc_pbot + forc_u => clm_a2l%forc_u + forc_v => clm_a2l%forc_v + forc_th => clm_a2l%forc_th + forc_rho => clm_a2l%forc_rho + lat => grc%lat + londeg => grc%londeg + + ! Assign local pointers to derived type members (column-level) + + t_soisno => ces%t_soisno + watsat => cps%watsat + watdry => cps%watdry + watopt => cps%watopt + h2osoi_ice => cws%h2osoi_ice + dz => cps%dz + h2osoi_liq => cws%h2osoi_liq + sucsat => cps%sucsat + bsw => cps%bsw + emg => cps%emg + t_grnd => ces%t_grnd + qg => cws%qg + thv => ces%thv + dqgdT => cws%dqgdT + htvp => cps%htvp + z0mg => cps%z0mg + frac_sno => cps%frac_sno + snowdp => cps%snowdp + soilbeta => cws%soilbeta + decl => cps%decl + max_dayl => cps%max_dayl + + ! Assign local pointers to derived type members (pft-level) + + rb1 => pps%rb1 + ivt => pft%itype + pcolumn => pft%column + plandunit => pft%landunit + pgridcell => pft%gridcell + frac_veg_nosno => pps%frac_veg_nosno + btran => pps%btran + rootfr => pps%rootfr + rootr => pps%rootr + rresis => pps%rresis + emv => pps%emv + t_veg => pes%t_veg + displa => pps%displa + z0mv => pps%z0mv + z0hv => pps%z0hv + z0qv => pps%z0qv + ram1 => pps%ram1 + htop => pps%htop + rssun => pps%rssun + rssha => pps%rssha + cisun => pps%cisun + cisha => pps%cisha + psnsun => pcf%psnsun + psnsha => pcf%psnsha + + ! 4/14/05: PET + ! Adding isotope code + c13_psnsun => pc13f%psnsun + c13_psnsha => pc13f%psnsha + ! 4/21/05: PET + ! Adding isotope code + rc13_canair => pepv%rc13_canair + rc13_psnsun => pepv%rc13_psnsun + rc13_psnsha => pepv%rc13_psnsha + alphapsnsun => pps%alphapsnsun + alphapsnsha => pps%alphapsnsha + + elai => pps%elai + esai => pps%esai + fdry => pps%fdry + laisun => pps%laisun + laisha => pps%laisha + qflx_tran_veg => pwf%qflx_tran_veg + fwet => pps%fwet + h2ocan => pws%h2ocan + dt_veg => pps%dt_veg + sabv => pef%sabv + qflx_evap_veg => pwf%qflx_evap_veg + eflx_sh_veg => pef%eflx_sh_veg + taux => pmf%taux + tauy => pmf%tauy + eflx_sh_grnd => pef%eflx_sh_grnd + qflx_evap_soi => pwf%qflx_evap_soi + t_ref2m => pes%t_ref2m + q_ref2m => pes%q_ref2m + t_ref2m_r => pes%t_ref2m_r + rh_ref2m_r => pes%rh_ref2m_r + rh_ref2m => pes%rh_ref2m + dlrad => pef%dlrad + ulrad => pef%ulrad + cgrnds => pef%cgrnds + cgrndl => pef%cgrndl + cgrnd => pef%cgrnd + fpsn => pcf%fpsn + forc_hgt_u_pft => pps%forc_hgt_u_pft + thm => pes%thm + irrig_rate => cps%irrig_rate + n_irrig_steps_left => cps%n_irrig_steps_left + + ! Assign local pointers to derived type members (ecophysiological) + + dleaf => pftcon%dleaf + smpso => pftcon%smpso + smpsc => pftcon%smpsc + + ! Determine step size + + dtime = get_step_size() + irrig_nsteps_per_day = ((irrig_length + (dtime - 1))/dtime) ! round up + + ! Filter pfts where frac_veg_nosno is non-zero + + fn = 0 + do fp = 1,num_nolakep + p = filter_nolakep(fp) + if (frac_veg_nosno(p) /= 0) then + fn = fn + 1 + filterp(fn) = p + end if + end do + + ! Initialize + + do f = 1, fn + p = filterp(f) + del(p) = 0._r8 ! change in leaf temperature from previous iteration + efeb(p) = 0._r8 ! latent head flux from leaf for previous iteration + wtlq0(p) = 0._r8 + wtalq(p) = 0._r8 + wtgq(p) = 0._r8 + wtaq0(p) = 0._r8 + obuold(p) = 0._r8 + btran(p) = btran0 + end do + + ! calculate daylength control for Vcmax + do f = 1, fn + p=filterp(f) + c=pcolumn(p) + g=pgridcell(p) + ! calculate daylength + temp = -(sin(lat(g))*sin(decl(c)))/(cos(lat(g)) * cos(decl(c))) + temp = min(1._r8,max(-1._r8,temp)) + dayl = 2.0_r8 * 13750.9871_r8 * acos(temp) + ! calculate dayl_factor as the ratio of (current:max dayl)^2 + ! set a minimum of 0.01 (1%) for the dayl_factor + dayl_factor(p)=min(1._r8,max(0.01_r8,(dayl*dayl)/(max_dayl(c)*max_dayl(c)))) + end do + + rb1(lbp:ubp) = 0._r8 + + ! Effective porosity of soil, partial volume of ice and liquid (needed for btran) + ! and root resistance factors + + do j = 1,nlevgrnd + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + l = plandunit(p) + + ! Root resistance factors + + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity = watsat(c,j)-vol_ice + vol_liq = min(eff_porosity, h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + if (vol_liq .le. 0._r8 .or. t_soisno(c,j) .le. tfrz-2._r8) then + rootr(p,j) = 0._r8 + else + s_node = max(vol_liq/eff_porosity,0.01_r8) + smp_node = max(smpsc(ivt(p)), -sucsat(c,j)*s_node**(-bsw(c,j))) + + rresis(p,j) = min( (eff_porosity/watsat(c,j))* & + (smp_node - smpsc(ivt(p))) / (smpso(ivt(p)) - smpsc(ivt(p))), 1._r8) + rootr(p,j) = rootfr(p,j)*rresis(p,j) + btran(p) = btran(p) + rootr(p,j) + endif + end do + end do + + ! Normalize root resistances to get layer contribution to ET + + do j = 1,nlevgrnd + do f = 1, fn + p = filterp(f) + if (btran(p) .gt. btran0) then + rootr(p,j) = rootr(p,j)/btran(p) + else + rootr(p,j) = 0._r8 + end if + end do + end do + + ! Determine if irrigation is needed (over irrigated soil columns) + + ! First, determine in what grid cells we need to bother 'measuring' soil water, to see if we need irrigation + ! Also set n_irrig_steps_left for these grid cells + ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 + ! in this case, we'll irrigate by 0 for the given number of time steps + call get_prev_date(yr, mon, day, time) ! get time as of beginning of time step + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + if (ivt(p) == nirrig .and. elai(p) > irrig_min_lai .and. btran(p) < irrig_btran_thresh) then + ! see if it's the right time of day to start irrigating: + local_time = modulo(time + nint(londeg(g)/degpsec), isecspday) + if (modulo(local_time - irrig_start_time, isecspday) < dtime) then + ! it's time to start irrigating + check_for_irrig(p) = .true. + n_irrig_steps_left(c) = irrig_nsteps_per_day + irrig_rate(c) = 0._r8 ! reset; we'll add to this later + else + check_for_irrig(p) = .false. + end if + else ! non-irrig pft or elai<=irrig_min_lai or btran>irrig_btran_thresh + check_for_irrig(p) = .false. + end if + + end do + + + ! Now 'measure' soil water for the grid cells identified above and see if the soil is dry enough to warrant irrigation + frozen_soil(:) = .false. + do j = 1,nlevgrnd + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + if (check_for_irrig(p) .and. .not. frozen_soil(c)) then + ! if level L was frozen, then we don't look at any levels below L + if (t_soisno(c,j) <= SHR_CONST_TKFRZ) then + frozen_soil(c) = .true. + else if (rootfr(p,j) > 0._r8) then + ! determine soil water deficit in this layer: + + ! Calculate vol_liq_so - i.e., vol_liq at which smp_node = smpso - by inverting the above equations + ! for the root resistance factors + vol_ice = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) ! this duplicates the above equation for vol_ice + eff_porosity = watsat(c,j)-vol_ice ! this duplicates the above equation for eff_porosity + vol_liq_so = eff_porosity * (-smpso(ivt(p))/sucsat(c,j))**(-1/bsw(c,j)) + + ! Translate vol_liq_so and eff_porosity into h2osoi_liq_so and h2osoi_liq_sat and calculate deficit + h2osoi_liq_so = vol_liq_so * denh2o * dz(c,j) + h2osoi_liq_sat = eff_porosity * denh2o * dz(c,j) + deficit = max((h2osoi_liq_so + irrig_factor*(h2osoi_liq_sat - h2osoi_liq_so)) - h2osoi_liq(c,j), 0._r8) + + ! Add deficit to irrig_rate, converting units from mm to mm/sec + irrig_rate(c) = irrig_rate(c) + deficit/(dtime*irrig_nsteps_per_day) + + end if ! else if (rootfr(p,j) .gt. 0) + end if ! if (check_for_irrig(p) .and. .not. frozen_soil(c)) + end do ! do f + end do ! do j + + ! Modify aerodynamic parameters for sparse/dense canopy (X. Zeng) + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + + lt = min(elai(p)+esai(p), tlsai_crit) + egvf =(1._r8 - alpha_aero * exp(-lt)) / (1._r8 - alpha_aero * exp(-tlsai_crit)) + displa(p) = egvf * displa(p) + z0mv(p) = exp(egvf * log(z0mv(p)) + (1._r8 - egvf) * log(z0mg(c))) + z0hv(p) = z0mv(p) + z0qv(p) = z0mv(p) + + end do + + found = .false. + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + ! Net absorbed longwave radiation by canopy and ground + ! =air+bir*t_veg**4+cir*t_grnd(c)**4 + + air(p) = emv(p) * (1._r8+(1._r8-emv(p))*(1._r8-emg(c))) * forc_lwrad(g) + bir(p) = - (2._r8-emv(p)*(1._r8-emg(c))) * emv(p) * sb + cir(p) = emv(p)*emg(c)*sb + + ! Saturated vapor pressure, specific humidity, and their derivatives + ! at the leaf surface + + call QSat (t_veg(p), forc_pbot(g), el(p), deldT, qsatl(p), qsatldT(p)) + + ! Determine atmospheric co2 and o2 + + co2(p) = forc_pco2(g) + o2(p) = forc_po2(g) + + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + c13o2(p) = forc_pc13o2(g) + end if + + ! Initialize flux profile + + nmozsgn(p) = 0 + + taf(p) = (t_grnd(c) + thm(p))/2._r8 + qaf(p) = (forc_q(g)+qg(c))/2._r8 + + ur(p) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(p)-taf(p) + dqh(p) = forc_q(g)-qaf(p) + delq(p) = qg(c) - qaf(p) + dthv(p) = dth(p)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(p) + zldis(p) = forc_hgt_u_pft(p) - displa(p) + + ! Check to see if the forcing height is below the canopy height + if (zldis(p) < 0._r8) then + found = .true. + index = p + end if + + end do + + if (found) then + write(iulog,*)'Error: Forcing height is below canopy height for pft index ',index + call endrun() + end if + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv(p), zldis(p), z0mv(p), um(p), obu(p)) + + end do + + ! Set counter for leaf temperature iteration (itlef) + + itlef = 0 + fnorig = fn + fporig(1:fn) = filterp(1:fn) + + ! Make copies so that array sections are not passed in function calls to friction velocity + + do f = 1, fn + p = filterp(f) + displa_loc(p) = displa(p) + z0mv_loc(p) = z0mv(p) + z0hv_loc(p) = z0hv(p) + z0qv_loc(p) = z0qv(p) + end do + + ! Begin stability iteration + + ITERATION : do while (itlef <= itmax .and. fn > 0) + + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + call FrictionVelocity (lbp, ubp, fn, filterp, & + displa_loc, z0mv_loc, z0hv_loc, z0qv_loc, & + obu, itlef+1, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm) + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + tlbef(p) = t_veg(p) + del2(p) = del(p) + + ! Determine aerodynamic resistances + + ram1(p) = 1._r8/(ustar(p)*ustar(p)/um(p)) + rah(p,1) = 1._r8/(temp1(p)*ustar(p)) + raw(p,1) = 1._r8/(temp2(p)*ustar(p)) + + ! Bulk boundary layer resistance of leaves + + uaf(p) = um(p)*sqrt( 1._r8/(ram1(p)*um(p)) ) + cf = 0.01_r8/(sqrt(uaf(p))*sqrt(dleaf(ivt(p)))) + rb(p) = 1._r8/(cf*uaf(p)) + rb1(p) = rb(p) + + ! Parameterization for variation of csoilc with canopy density from + ! X. Zeng, University of Arizona + + w = exp(-(elai(p)+esai(p))) + + ! changed by K.Sakaguchi from here + ! transfer coefficient over bare soil is changed to a local variable + ! just for readability of the code (from line 680) + csoilb = (vkc/(0.13_r8*(z0mg(c)*uaf(p)/1.5e-5_r8)**0.45_r8)) + + !compute the stability parameter for ricsoilc ("S" in Sakaguchi&Zeng,2008) + + ri = ( grav*htop(p) * (taf(p) - t_grnd(c)) ) / (taf(p) * uaf(p) **2.00_r8) + + !! modify csoilc value (0.004) if the under-canopy is in stable condition + + if ( (taf(p) - t_grnd(c) ) > 0._r8) then + ! decrease the value of csoilc by dividing it with (1+gamma*min(S, 10.0)) + ! ria ("gmanna" in Sakaguchi&Zeng, 2008) is a constant (=0.5) + ricsoilc = csoilc / (1.00_r8 + ria*min( ri, 10.0_r8) ) + csoilcn = csoilb*w + ricsoilc*(1._r8-w) + else + csoilcn = csoilb*w + csoilc*(1._r8-w) + end if + + !! Sakaguchi changes for stability formulation ends here + + rah(p,2) = 1._r8/(csoilcn*uaf(p)) + raw(p,2) = rah(p,2) + + ! Stomatal resistances for sunlit and shaded fractions of canopy. + ! Done each iteration to account for differences in eah, tv. + + svpts(p) = el(p) ! pa + eah(p) = forc_pbot(g) * qaf(p) / 0.622_r8 ! pa + end do + + ! 4/25/05, PET: Now calling the sun/shade version of Stomata by default + call Stomata (fn, filterp, lbp, ubp, svpts, eah, o2, co2, rb, dayl_factor, phase='sun') + call Stomata (fn, filterp, lbp, ubp, svpts, eah, o2, co2, rb, dayl_factor, phase='sha') + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + ! Sensible heat conductance for air, leaf and ground + ! Moved the original subroutine in-line... + + wta = 1._r8/rah(p,1) ! air + wtl = (elai(p)+esai(p))/rb(p) ! leaf + wtg(p) = 1._r8/rah(p,2) ! ground + wtshi = 1._r8/(wta+wtl+wtg(p)) + + wtl0(p) = wtl*wtshi ! leaf + wtg0 = wtg(p)*wtshi ! ground + wta0(p) = wta*wtshi ! air + + wtga = wta0(p)+wtg0 ! ground + air + wtal(p) = wta0(p)+wtl0(p) ! air + leaf + + ! Fraction of potential evaporation from leaf + + if (fdry(p) .gt. 0._r8) then + rppdry = fdry(p)*rb(p)*(laisun(p)/(rb(p)+rssun(p)) + & + laisha(p)/(rb(p)+rssha(p)))/elai(p) + else + rppdry = 0._r8 + end if + efpot = forc_rho(g)*wtl*(qsatl(p)-qaf(p)) + + if (efpot > 0._r8) then + if (btran(p) > btran0) then + qflx_tran_veg(p) = efpot*rppdry + rpp = rppdry + fwet(p) + else + !No transpiration if btran below 1.e-10 + rpp = fwet(p) + qflx_tran_veg(p) = 0._r8 + end if + !Check total evapotranspiration from leaves + rpp = min(rpp, (qflx_tran_veg(p)+h2ocan(p)/dtime)/efpot) + else + !No transpiration if potential evaporation less than zero + rpp = 1._r8 + qflx_tran_veg(p) = 0._r8 + end if + + ! Update conductances for changes in rpp + ! Latent heat conductances for ground and leaf. + ! Air has same conductance for both sensible and latent heat. + ! Moved the original subroutine in-line... + + wtaq = frac_veg_nosno(p)/raw(p,1) ! air + wtlq = frac_veg_nosno(p)*(elai(p)+esai(p))/rb(p) * rpp ! leaf + + !Litter layer resistance. Added by K.Sakaguchi + snowdp_c = z_dl ! critical depth for 100% litter burial by snow (=litter thickness) + fsno_dl = snowdp(c)/snowdp_c ! effective snow cover for (dry)plant litter + elai_dl = lai_dl*(1._r8 - min(fsno_dl,1._r8)) ! exposed (dry)litter area index + rdl = ( 1._r8 - exp(-elai_dl) ) / ( 0.004_r8*uaf(p)) ! dry litter layer resistance + + ! add litter resistance and Lee and Pielke 1992 beta + if (delq(p) .lt. 0._r8) then !dew. Do not apply beta for negative flux (follow old rsoil) + wtgq(p) = frac_veg_nosno(p)/(raw(p,2)+rdl) + else + wtgq(p) = soilbeta(c)*frac_veg_nosno(p)/(raw(p,2)+rdl) + end if + + wtsqi = 1._r8/(wtaq+wtlq+wtgq(p)) + + wtgq0 = wtgq(p)*wtsqi ! ground + wtlq0(p) = wtlq*wtsqi ! leaf + wtaq0(p) = wtaq*wtsqi ! air + + wtgaq = wtaq0(p)+wtgq0 ! air + ground + wtalq(p) = wtaq0(p)+wtlq0(p) ! air + leaf + + dc1 = forc_rho(g)*cpair*wtl + dc2 = hvap*forc_rho(g)*wtlq + + efsh = dc1*(wtga*t_veg(p)-wtg0*t_grnd(c)-wta0(p)*thm(p)) + efe(p) = dc2*(wtgaq*qsatl(p)-wtgq0*qg(c)-wtaq0(p)*forc_q(g)) + + ! Evaporation flux from foliage + + erre = 0._r8 + if (efe(p)*efeb(p) < 0._r8) then + efeold = efe(p) + efe(p) = 0.1_r8*efeold + erre = efe(p) - efeold + end if + dt_veg(p) = (sabv(p) + air(p) + bir(p)*t_veg(p)**4 + & + cir(p)*t_grnd(c)**4 - efsh - efe(p)) / & + (- 4._r8*bir(p)*t_veg(p)**3 +dc1*wtga +dc2*wtgaq*qsatldT(p)) + t_veg(p) = tlbef(p) + dt_veg(p) + dels = dt_veg(p) + del(p) = abs(dels) + err(p) = 0._r8 + if (del(p) > delmax) then + dt_veg(p) = delmax*dels/del(p) + t_veg(p) = tlbef(p) + dt_veg(p) + err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + cir(p)*t_grnd(c)**4 - & + (efsh + dc1*wtga*dt_veg(p)) - (efe(p) + & + dc2*wtgaq*qsatldT(p)*dt_veg(p)) + end if + + ! Fluxes from leaves to canopy space + ! "efe" was limited as its sign changes frequently. This limit may + ! result in an imbalance in "hvap*qflx_evap_veg" and + ! "efe + dc2*wtgaq*qsatdt_veg" + + efpot = forc_rho(g)*wtl*(wtgaq*(qsatl(p)+qsatldT(p)*dt_veg(p)) & + -wtgq0*qg(c)-wtaq0(p)*forc_q(g)) + qflx_evap_veg(p) = rpp*efpot + + ! Calculation of evaporative potentials (efpot) and + ! interception losses; flux in kg m**-2 s-1. ecidif + ! holds the excess energy if all intercepted water is evaporated + ! during the timestep. This energy is later added to the + ! sensible heat flux. + + ecidif = 0._r8 + if (efpot > 0._r8 .and. btran(p) > btran0) then + qflx_tran_veg(p) = efpot*rppdry + else + qflx_tran_veg(p) = 0._r8 + end if + ecidif = max(0._r8, qflx_evap_veg(p)-qflx_tran_veg(p)-h2ocan(p)/dtime) + qflx_evap_veg(p) = min(qflx_evap_veg(p),qflx_tran_veg(p)+h2ocan(p)/dtime) + + ! The energy loss due to above two limits is added to + ! the sensible heat flux. + + eflx_sh_veg(p) = efsh + dc1*wtga*dt_veg(p) + err(p) + erre + hvap*ecidif + + ! Re-calculate saturated vapor pressure, specific humidity, and their + ! derivatives at the leaf surface + + call QSat(t_veg(p), forc_pbot(g), el(p), deldT, qsatl(p), qsatldT(p)) + + ! Update vegetation/ground surface temperature, canopy air + ! temperature, canopy vapor pressure, aerodynamic temperature, and + ! Monin-Obukhov stability parameter for next iteration. + + taf(p) = wtg0*t_grnd(c) + wta0(p)*thm(p) + wtl0(p)*t_veg(p) + qaf(p) = wtlq0(p)*qsatl(p) + wtgq0*qg(c) + forc_q(g)*wtaq0(p) + + ! Update Monin-Obukhov length and wind speed including the + ! stability effect + + dth(p) = thm(p)-taf(p) + dqh(p) = forc_q(g)-qaf(p) + delq(p) = wtalq(p)*qg(c)-wtlq0(p)*qsatl(p)-wtaq0(p)*forc_q(g) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + + thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar + zeta = zldis(p)*vkc*grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(p) = max(ur(p),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_r8 + um(p) = sqrt(ur(p)*ur(p)+wc*wc) + end if + obu(p) = zldis(p)/zeta + + if (obuold(p)*obu(p) < 0._r8) nmozsgn(p) = nmozsgn(p)+1 + if (nmozsgn(p) >= 4) obu(p) = zldis(p)/(-0.01_r8) + obuold(p) = obu(p) + + end do ! end of filtered pft loop + + ! Test for convergence + + itlef = itlef+1 + if (itlef > itmin) then + do f = 1, fn + p = filterp(f) + dele(p) = abs(efe(p)-efeb(p)) + efeb(p) = efe(p) + det(p) = max(del(p),del2(p)) + end do + fnold = fn + fn = 0 + do f = 1, fnold + p = filterp(f) + if (.not. (det(p) < dtmin .and. dele(p) < dlemin)) then + fn = fn + 1 + filterp(fn) = p + end if + end do + end if + + end do ITERATION ! End stability iteration + + fn = fnorig + filterp(1:fn) = fporig(1:fn) + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + ! Energy balance check in canopy + + err(p) = sabv(p) + air(p) + bir(p)*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) & + + cir(p)*t_grnd(c)**4 - eflx_sh_veg(p) - hvap*qflx_evap_veg(p) + + ! Fluxes from ground to canopy space + + delt = wtal(p)*t_grnd(c)-wtl0(p)*t_veg(p)-wta0(p)*thm(p) + taux(p) = -forc_rho(g)*forc_u(g)/ram1(p) + tauy(p) = -forc_rho(g)*forc_v(g)/ram1(p) + eflx_sh_grnd(p) = cpair*forc_rho(g)*wtg(p)*delt + qflx_evap_soi(p) = forc_rho(g)*wtgq(p)*delq(p) + + ! 2 m height air temperature + + t_ref2m(p) = thm(p) + temp1(p)*dth(p)*(1._r8/temp12m(p) - 1._r8/temp1(p)) + t_ref2m_r(p) = t_ref2m(p) + + ! 2 m height specific humidity + + q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._r8/temp22m(p) - 1._r8/temp2(p)) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + rh_ref2m_r(p) = rh_ref2m(p) + + ! Downward longwave radiation below the canopy + + dlrad(p) = (1._r8-emv(p))*emg(c)*forc_lwrad(g) + & + emv(p)*emg(c)*sb*tlbef(p)**3*(tlbef(p) + 4._r8*dt_veg(p)) + + ! Upward longwave radiation above the canopy + + ulrad(p) = ((1._r8-emg(c))*(1._r8-emv(p))*(1._r8-emv(p))*forc_lwrad(g) & + + emv(p)*(1._r8+(1._r8-emg(c))*(1._r8-emv(p)))*sb*tlbef(p)**3*(tlbef(p) + & + 4._r8*dt_veg(p)) + emg(c)*(1._r8-emv(p))*sb*t_grnd(c)**4) + + ! Derivative of soil energy flux with respect to soil temperature + + cgrnds(p) = cgrnds(p) + cpair*forc_rho(g)*wtg(p)*wtal(p) + cgrndl(p) = cgrndl(p) + forc_rho(g)*wtgq(p)*wtalq(p)*dqgdT(c) + cgrnd(p) = cgrnds(p) + cgrndl(p)*htvp(c) + + ! Update dew accumulation (kg/m2) + + h2ocan(p) = max(0._r8,h2ocan(p)+(qflx_tran_veg(p)-qflx_evap_veg(p))*dtime) + + ! total photosynthesis + + fpsn(p) = psnsun(p)*laisun(p) + psnsha(p)*laisha(p) + + if (use_cn) then + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + rc13_canair(p) = c13o2(p)/(co2(p)-c13o2(p)) + rc13_psnsun(p) = rc13_canair(p)/alphapsnsun(p) + rc13_psnsha(p) = rc13_canair(p)/alphapsnsha(p) + c13_psnsun(p) = psnsun(p) * (rc13_psnsun(p)/(1._r8+rc13_psnsun(p))) + c13_psnsha(p) = psnsha(p) * (rc13_psnsha(p)/(1._r8+rc13_psnsha(p))) + !write(iulog,*) p,ivt(p),btran(p),psnsun(p),psnsha(p),alphapsnsun(p),alphapsnsha(p) + end if + end if + + end do + + ! Filter out pfts which have small energy balance errors; report others + + fnold = fn + fn = 0 + do f = 1, fnold + p = filterp(f) + if (abs(err(p)) > 0.1_r8) then + fn = fn + 1 + filterp(fn) = p + end if + end do + + do f = 1, fn + p = filterp(f) + write(iulog,*) 'energy balance in canopy ',p,', err=',err(p) + end do + + end subroutine CanopyFluxes + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Stomata +! +! !INTERFACE: + subroutine Stomata (fn, filterp, lbp, ubp, ei, ea, o2, co2, rb, dayl_factor, phase) +! +! !DESCRIPTION: +! Leaf stomatal resistance and leaf photosynthesis. Modifications for CN code. + +! !REVISION HISTORY: +! 22 January 2004: Created by Peter Thornton +! 4/14/05: Peter Thornton: Converted Ci from local variable to pps struct member +! now returns cisun or cisha per pft as implicit output argument. +! Also sets alphapsnsun and alphapsnsha. +! 4/25/05, Peter Thornton: Adopted as the default code for CLM, together with +! modifications for sun/shade canopy. Renamed from StomataCN to Stomata, +! and eliminating the older Stomata subroutine +! 3/6/09: Peter Thornton; added dayl_factor control on Vcmax, from Bill Bauerle + +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_const_mod, only : SHR_CONST_TKFRZ, SHR_CONST_RGAS + use clmtype + use clm_atmlnd , only : clm_a2l + use spmdMod , only: masterproc + use pftvarcon , only : nbrdlf_dcd_tmp_shrub + use pftvarcon , only : nsoybean, npcropmin +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: fn ! size of pft filter + integer , intent(in) :: filterp(fn) ! pft filter + integer , intent(in) :: lbp, ubp ! pft bounds + real(r8), intent(in) :: ei(lbp:ubp) ! vapor pressure inside leaf (sat vapor press at tl) (pa) + real(r8), intent(in) :: ea(lbp:ubp) ! vapor pressure of canopy air (pa) + real(r8), intent(in) :: o2(lbp:ubp) ! atmospheric o2 concentration (pa) + real(r8), intent(in) :: co2(lbp:ubp) ! atmospheric co2 concentration (pa) + real(r8), intent(inout) :: rb(lbp:ubp) ! boundary layer resistance (s/m) + real(r8), intent(in) :: dayl_factor(lbp:ubp) ! scalar (0-1) for daylength + character(len=*), intent(in) :: phase ! 'sun' or 'sha' +! +! !CALLED FROM: +! subroutine CanopyFluxes in this module +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in variables +! new ecophys variables (leafcn, flnr) added 1/26/04 +! + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: qe25(:) ! quantum efficiency at 25C (umol CO2 / umol photon) + real(r8), pointer :: c3psn(:) ! photosynthetic pathway: 0. = c4, 1. = c3 + real(r8), pointer :: mp(:) ! slope of conductance-to-photosynthesis relationship + real(r8), pointer :: tgcm(:) ! air temperature at agcm reference height (kelvin) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: tl(:) ! leaf temperature (Kelvin) + real(r8), pointer :: btran(:) ! soil water transpiration factor (0 to 1) + real(r8), pointer :: apar(:) ! par absorbed per unit lai (w/m**2) + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) + real(r8), pointer :: flnr(:) ! fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + real(r8), pointer :: sla(:) ! specific leaf area, projected area basis (m^2/gC) + real(r8), pointer :: fnitr(:) ! foliage nitrogen limitation factor (-) +! +! local pointers to implicit inout variables +! + real(r8), pointer :: rs(:) ! leaf stomatal resistance (s/m) + real(r8), pointer :: psn(:) ! foliage photosynthesis (umol co2 /m**2/ s) [always +] + real(r8), pointer :: ci(:) ! intracellular leaf CO2 (Pa) + real(r8), pointer :: alphapsn(:) ! 13C fractionation factor for PSN () +! +! local pointers to implicit out variables +! + real(r8), pointer :: lnc(:) ! leaf N concentration per unit projected LAI (gN leaf/m^2) + real(r8), pointer :: vcmx(:) ! maximum rate of carboxylation (umol co2/m**2/s) +! +! +! !LOCAL VARIABLES: +!EOP +! + real(r8), parameter :: mpe = 1.e-6_r8 ! prevents overflow error if division by zero + integer , parameter :: niter = 3 ! number of iterations + integer :: f,p,c,g ! indices + integer :: iter ! iteration index + real(r8) :: ab ! used in statement functions + real(r8) :: bc ! used in statement functions + real(r8) :: f1 ! generic temperature response (statement function) + real(r8) :: f2 ! generic temperature inhibition (statement function) + real(r8) :: tc ! leaf temperature (degree celsius) + real(r8) :: cs ! co2 concentration at leaf surface (pa) + real(r8) :: kc ! co2 michaelis-menten constant (pa) + real(r8) :: ko ! o2 michaelis-menten constant (pa) + real(r8) :: atmp ! intermediate calculations for rs + real(r8) :: btmp ! intermediate calculations for rs + real(r8) :: ctmp ! intermediate calculations for rs + real(r8) :: q ! intermediate calculations for rs + real(r8) :: r1,r2 ! roots for rs + real(r8) :: ppf ! absorb photosynthetic photon flux (umol photons/m**2/s) + real(r8) :: wc ! rubisco limited photosynthesis (umol co2/m**2/s) + real(r8) :: wj ! light limited photosynthesis (umol co2/m**2/s) + real(r8) :: we ! export limited photosynthesis (umol co2/m**2/s) + real(r8) :: cp ! co2 compensation point (pa) + real(r8) :: awc ! intermediate calcuation for wc + real(r8) :: j ! electron transport (umol co2/m**2/s) + real(r8) :: cea ! constrain ea or else model blows up + real(r8) :: cf ! s m**2/umol -> s/m + real(r8) :: rsmax0 ! maximum stomatal resistance [s/m] + real(r8) :: kc25 ! co2 michaelis-menten constant at 25c (pa) + real(r8) :: akc ! q10 for kc25 + real(r8) :: ko25 ! o2 michaelis-menten constant at 25c (pa) + real(r8) :: ako ! q10 for ko25 + real(r8) :: bp ! minimum leaf conductance (umol/m**2/s) + ! additional variables for new treatment of Vcmax, Peter Thornton, 1/26/04 + real(r8) :: act25 ! (umol/mgRubisco/min) Rubisco activity at 25 C + real(r8) :: act ! (umol/mgRubisco/min) Rubisco activity + real(r8) :: q10act ! (DIM) Q_10 for Rubisco activity + real(r8) :: fnr ! (gRubisco/gN in Rubisco) +!------------------------------------------------------------------------------ + + ! Set statement functions + + f1(ab,bc) = ab**((bc-25._r8)/10._r8) + f2(ab) = 1._r8 + exp((-2.2e05_r8+710._r8*(ab+SHR_CONST_TKFRZ))/(SHR_CONST_RGAS*0.001_r8*(ab+SHR_CONST_TKFRZ))) + + ! Assign local pointers to derived type members (pft-level) + + pcolumn => pft%column + pgridcell => pft%gridcell + ivt => pft%itype + tl => pes%t_veg + btran => pps%btran + if (phase == 'sun') then + apar => pef%parsun + rs => pps%rssun + psn => pcf%psnsun + ci => pps%cisun + + alphapsn => pps%alphapsnsun + + sla => pps%slasun + lnc => pps%lncsun + vcmx => pps%vcmxsun + else if (phase == 'sha') then + apar => pef%parsha + rs => pps%rssha + psn => pcf%psnsha + ci => pps%cisha + sla => pps%slasha + + alphapsn => pps%alphapsnsha + + lnc => pps%lncsha + vcmx => pps%vcmxsha + end if + + ! Assign local pointers to derived type members (gridcell-level) + + forc_pbot => clm_a2l%forc_pbot + + ! Assign local pointers to derived type members (column-level) + + tgcm => pes%thm + + ! Assign local pointers to pft constants + ! new ecophys constants added 1/26/04 + + qe25 => pftcon%qe25 + c3psn => pftcon%c3psn + mp => pftcon%mp + leafcn => pftcon%leafcn + flnr => pftcon%flnr + fnitr => pftcon%fnitr + + ! Set constant values + + kc25 = 30._r8 + akc = 2.1_r8 + ko25 = 30000._r8 + ako = 1.2_r8 + bp = 2000._r8 + + ! New constants for CN code, added 1/26/04 + + act25 = 3.6_r8 + q10act = 2.4_r8 + fnr = 7.16_r8 + + ! Convert rubisco activity units from umol/mgRubisco/min -> umol/gRubisco/s + + act25 = act25 * 1000.0_r8 / 60.0_r8 + + do f = 1, fn + p = filterp(f) + c = pcolumn(p) + g = pgridcell(p) + + ! Initialize rs=rsmax and psn=0 because calculations are performed only + ! when apar > 0, in which case rs <= rsmax and psn >= 0 + ! Set constants + + rsmax0 = 2.e4_r8 + cf = forc_pbot(g)/(SHR_CONST_RGAS*0.001_r8*tgcm(p))*1.e06_r8 + if (apar(p) <= 0._r8) then ! night time + rs(p) = min(rsmax0, 1._r8/bp * cf) + psn(p) = 0._r8 + lnc(p) = 0._r8 + vcmx(p) = 0._r8 + if (use_c13) then + alphapsn(p) = 1._r8 + end if + else ! day time + tc = tl(p) - SHR_CONST_TKFRZ + ppf = 4.6_r8 * apar(p) + j = ppf * qe25(ivt(p)) + kc = kc25 * f1(akc,tc) + ko = ko25 * f1(ako,tc) + awc = kc * (1._r8+o2(p)/ko) + cp = 0.5_r8*kc/ko*o2(p)*0.21_r8 + + ! Modification for shrubs proposed by X.D.Z + ! Why does he prefer this line here instead of in subr. + ! CanopyFluxes? (slevis) + ! Equivalent modification for soy following AgroIBIS + if (use_cndv) then + if (ivt(p) == nbrdlf_dcd_tmp_shrub) btran(p) = min(1._r8, btran(p) * 3.33_r8) + end if + if (ivt(p) == nsoybean) btran(p) = min(1._r8, btran(p) * 1.25_r8) + + ! new calculations for vcmax, 1/26/04 + lnc(p) = 1._r8 / (sla(p) * leafcn(ivt(p))) + act = act25 * f1(q10act,tc) + if (use_cn) then + if ( ivt(p) < npcropmin )then + vcmx(p) = lnc(p) * flnr(ivt(p)) * fnr * act / f2(tc) * btran(p) * & + dayl_factor(p) + else + vcmx(p) = 101._r8 * f1(q10act,tc) / f2(tc) * btran(p) * dayl_factor(p) + end if + else + vcmx(p) = lnc(p) * flnr(ivt(p)) * fnr * act / f2(tc) * btran(p) * & + dayl_factor(p) * fnitr(ivt(p)) + end if + + ! First guess ci + + ci(p) = 0.7_r8*co2(p)*c3psn(ivt(p)) + 0.4_r8*co2(p)*(1._r8-c3psn(ivt(p))) + + ! rb: s/m -> s m**2 / umol + + rb(p) = rb(p)/cf + + ! Constrain ea + + cea = max(0.25_r8*ei(p)*c3psn(ivt(p))+0.40_r8*ei(p)*(1._r8-c3psn(ivt(p))), min(ea(p),ei(p)) ) + + ! ci iteration for 'actual' photosynthesis + + do iter = 1, niter + wj = max(ci(p)-cp,0._r8)*j/(ci(p)+2._r8*cp)*c3psn(ivt(p)) + j*(1._r8-c3psn(ivt(p))) + wc = max(ci(p)-cp,0._r8)*vcmx(p)/(ci(p)+awc)*c3psn(ivt(p)) + vcmx(p)*(1._r8-c3psn(ivt(p))) + we = 0.5_r8*vcmx(p)*c3psn(ivt(p)) + 4000._r8*vcmx(p)*ci(p)/forc_pbot(g)*(1._r8-c3psn(ivt(p))) + psn(p) = min(wj,wc,we) + cs = max( co2(p)-1.37_r8*rb(p)*forc_pbot(g)*psn(p), mpe ) + atmp = mp(ivt(p))*psn(p)*forc_pbot(g)*cea / (cs*ei(p)) + bp + btmp = ( mp(ivt(p))*psn(p)*forc_pbot(g)/cs + bp ) * rb(p) - 1._r8 + ctmp = -rb(p) + if (btmp >= 0._r8) then + q = -0.5_r8*( btmp + sqrt(btmp*btmp-4._r8*atmp*ctmp) ) + else + q = -0.5_r8*( btmp - sqrt(btmp*btmp-4._r8*atmp*ctmp) ) + end if + r1 = q/atmp + r2 = ctmp/q + rs(p) = max(r1,r2) + ci(p) = max( cs-psn(p)*forc_pbot(g)*1.65_r8*rs(p), 0._r8 ) + end do + + ! rs, rb: s m**2 / umol -> s/m + + rs(p) = min(rsmax0, rs(p)*cf) + rb(p) = rb(p) * cf + + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + alphapsn(p) = 1._r8 + (((c3psn(ivt(p)) * (4.4_r8 + (22.6_r8*(ci(p)/co2(p))))) + & + ((1._r8 - c3psn(ivt(p))) * 4.4_r8))/1000._r8) + !alphapsn(p) = 1._r8 + !write(iulog,*) 'in StomataCN ',p,ivt(p),c3psn(ivt(p)),ci(p),co2(p),alphapsn(p) + end if + + end if + + end do + + end subroutine Stomata + +end module CanopyFluxesMod diff --git a/components/clm/src_clm40/biogeophys/FracWetMod.F90 b/components/clm/src_clm40/biogeophys/FracWetMod.F90 new file mode 100644 index 0000000000..f4bd6b9b80 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/FracWetMod.F90 @@ -0,0 +1,115 @@ +module FracWetMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: FracWetMod +! +! !DESCRIPTION: +! Determine fraction of vegetated surfaces which are wet and +! fraction of elai which is dry. +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: FracWet +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: FracWet +! +! !INTERFACE: + subroutine FracWet(numf, filter) +! +! !DESCRIPTION: +! Determine fraction of vegetated surfaces which are wet and +! fraction of elai which is dry. The variable ``fwet'' is the +! fraction of all vegetation surfaces which are wet including +! stem area which contribute to evaporation. The variable ``fdry'' +! is the fraction of elai which is dry because only leaves +! can transpire. Adjusted for stem area which does not transpire. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: numf ! number of filter non-lake points + integer, intent(in) :: filter(numf) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine Hydrology1 in module Hydrology1Mod +! +! !REVISION HISTORY: +! Created by Keith Oleson and M. Vertenstein +! 03/08/29 Mariana Vertenstein : Migrated to vectorized code +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: frac_veg_nosno(:) ! fraction of veg not covered by snow (0/1 now) [-] + real(r8), pointer :: dewmx(:) ! Maximum allowed dew [mm] + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: h2ocan(:) ! total canopy water (mm H2O) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) + real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: fp,p ! indices + real(r8) :: vegt ! frac_veg_nosno*lsai + real(r8) :: dewmxi ! inverse of maximum allowed dew [1/mm] +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (pft-level) + + frac_veg_nosno => pps%frac_veg_nosno + dewmx => pps%dewmx + elai => pps%elai + esai => pps%esai + h2ocan => pws%h2ocan + fwet => pps%fwet + fdry => pps%fdry + + ! Compute fraction of canopy that is wet and dry + + do fp = 1,numf + p = filter(fp) + if (frac_veg_nosno(p) == 1) then + if (h2ocan(p) > 0._r8) then + vegt = frac_veg_nosno(p)*(elai(p) + esai(p)) + dewmxi = 1.0_r8/dewmx(p) + fwet(p) = ((dewmxi/vegt)*h2ocan(p))**0.666666666666_r8 + fwet(p) = min (fwet(p),1.0_r8) ! Check for maximum limit of fwet + else + fwet(p) = 0._r8 + end if + fdry(p) = (1._r8-fwet(p))*elai(p)/(elai(p)+esai(p)) + else + fwet(p) = 0._r8 + fdry(p) = 0._r8 + end if + end do + + end subroutine FracWet + +end module FracWetMod diff --git a/components/clm/src_clm40/biogeophys/FrictionVelocityMod.F90 b/components/clm/src_clm40/biogeophys/FrictionVelocityMod.F90 new file mode 100644 index 0000000000..0f3eaa3a52 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/FrictionVelocityMod.F90 @@ -0,0 +1,572 @@ +module FrictionVelocityMod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: FrictionVelocityMod +! +! !DESCRIPTION: +! Calculation of the friction velocity, relation for potential +! temperature and humidity profiles of surface boundary layer. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: FrictionVelocity ! Calculate friction velocity + public :: MoninObukIni ! Initialization of the Monin-Obukhov length +! +! !PRIVATE MEMBER FUNCTIONS: + private :: StabilityFunc1 ! Stability function for rib < 0. + private :: StabilityFunc2 ! Stability function for rib < 0. +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: FrictionVelocity +! +! !INTERFACE: + subroutine FrictionVelocity(lbn, ubn, fn, filtern, & + displa, z0m, z0h, z0q, & + obu, iter, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm, landunit_index) +! +! !DESCRIPTION: +! Calculation of the friction velocity, relation for potential +! temperature and humidity profiles of surface boundary layer. +! The scheme is based on the work of Zeng et al. (1998): +! Intercomparison of bulk aerodynamic algorithms for the computation +! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, +! Vol. 11, 2628-2644. +! +! !USES: + use clmtype + use clm_atmlnd, only : clm_a2l + use clm_varcon, only : vkc + use clm_varctl, only : iulog +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbn, ubn ! pft/landunit array bounds + integer , intent(in) :: fn ! number of filtered pft/landunit elements + integer , intent(in) :: filtern(fn) ! pft/landunit filter + real(r8), intent(in) :: displa(lbn:ubn) ! displacement height (m) + real(r8), intent(in) :: z0m(lbn:ubn) ! roughness length over vegetation, momentum [m] + real(r8), intent(in) :: z0h(lbn:ubn) ! roughness length over vegetation, sensible heat [m] + real(r8), intent(in) :: z0q(lbn:ubn) ! roughness length over vegetation, latent heat [m] + real(r8), intent(in) :: obu(lbn:ubn) ! monin-obukhov length (m) + integer, intent(in) :: iter ! iteration number + real(r8), intent(in) :: ur(lbn:ubn) ! wind speed at reference height [m/s] + real(r8), intent(in) :: um(lbn:ubn) ! wind speed including the stablity effect [m/s] + logical, optional, intent(in) :: landunit_index ! optional argument that defines landunit or pft level + real(r8), intent(out) :: ustar(lbn:ubn) ! friction velocity [m/s] + real(r8), intent(out) :: temp1(lbn:ubn) ! relation for potential temperature profile + real(r8), intent(out) :: temp12m(lbn:ubn) ! relation for potential temperature profile applied at 2-m + real(r8), intent(out) :: temp2(lbn:ubn) ! relation for specific humidity profile + real(r8), intent(out) :: temp22m(lbn:ubn) ! relation for specific humidity profile applied at 2-m + real(r8), intent(inout) :: fm(lbn:ubn) ! diagnose 10m wind (DUST only) +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 12/19/01, Peter Thornton +! Added arguments to eliminate passing clm derived type into this function. +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: ngridcell(:) !pft/landunit gridcell index + real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft level [m] + real(r8), pointer :: forc_hgt_t_pft(:) !observational height of temperature at pft level [m] + real(r8), pointer :: forc_hgt_q_pft(:) !observational height of specific humidity at pft level [m] + integer , pointer :: pfti(:) !beginning pfti index for landunit + integer , pointer :: pftf(:) !final pft index for landunit +! +! local pointers to implicit out arguments +! + real(r8), pointer :: u10(:) ! 10-m wind (m/s) (for dust model) + real(r8), pointer :: fv(:) ! friction velocity (m/s) (for dust model) + real(r8), pointer :: vds(:) ! dry deposition velocity term (m/s) (for SO4 NH4NO3) + real(r8), pointer :: u10_clm(:) ! 10-m wind (m/s) + real(r8), pointer :: va(:) ! atmospheric wind speed plus convective velocity (m/s) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + real(r8), parameter :: zetam = 1.574_r8 ! transition point of flux-gradient relation (wind profile) + real(r8), parameter :: zetat = 0.465_r8 ! transition point of flux-gradient relation (temp. profile) + integer :: f ! pft/landunit filter index + integer :: n ! pft/landunit index + integer :: g ! gridcell index + integer :: pp ! pfti,pftf index + real(r8):: zldis(lbn:ubn) ! reference height "minus" zero displacement heght [m] + real(r8):: zeta(lbn:ubn) ! dimensionless height used in Monin-Obukhov theory + real(r8) :: tmp1,tmp2,tmp3,tmp4 ! Used to diagnose the 10 meter wind + real(r8) :: fmnew ! Used to diagnose the 10 meter wind + real(r8) :: fm10 ! Used to diagnose the 10 meter wind + real(r8) :: zeta10 ! Used to diagnose the 10 meter wind + real(r8) :: vds_tmp ! Temporary for dry deposition velocity +!------------------------------------------------------------------------------ + + ! Assign local pointers to derived type members (gridcell-level) + + if (present(landunit_index)) then + ngridcell => lun%gridcell + else + ngridcell => pft%gridcell + end if + + vds => pps%vds + u10 => pps%u10 + u10_clm => pps%u10_clm + va => pps%va + fv => pps%fv + + ! Assign local pointers to derived type members (pft or landunit-level) + + pfti => lun%pfti + pftf => lun%pftf + + ! Assign local pointers to derived type members (pft-level) + + forc_hgt_u_pft => pps%forc_hgt_u_pft + forc_hgt_t_pft => pps%forc_hgt_t_pft + forc_hgt_q_pft => pps%forc_hgt_q_pft + + ! Adjustment factors for unstable (moz < 0) or stable (moz > 0) conditions. + + do f = 1, fn + n = filtern(f) + g = ngridcell(n) + + ! Wind profile + + if (present(landunit_index)) then + zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_u_pft(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetam) then + ustar(n) = vkc*um(n)/(log(-zetam*obu(n)/z0m(n))& + - StabilityFunc1(-zetam) & + + StabilityFunc1(z0m(n)/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) + else if (zeta(n) < 0._r8) then + ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n))& + - StabilityFunc1(zeta(n))& + + StabilityFunc1(z0m(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + ustar(n) = vkc*um(n)/(log(zldis(n)/z0m(n)) + 5._r8*zeta(n) -5._r8*z0m(n)/obu(n)) + else + ustar(n) = vkc*um(n)/(log(obu(n)/z0m(n))+5._r8-5._r8*z0m(n)/obu(n) & + +(5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + if (zeta(n) < 0._r8) then + vds_tmp = 2.e-3_r8*ustar(n) * ( 1._r8 + (300._r8/(-obu(n)))**0.666_r8) + else + vds_tmp = 2.e-3_r8*ustar(n) + endif + + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + vds(pp) = vds_tmp + end do + else + vds(n) = vds_tmp + end if + +! Calculate a 10-m wind (10m + z0m + d) +! For now, this will not be the same as the 10-m wind calculated for the dust +! model because the CLM stability functions are used here, not the LSM stability +! functions used in the dust model. We will eventually change the dust model to be +! consistent with the following formulation. +! Note that the 10-m wind calculated this way could actually be larger than the +! atmospheric forcing wind because 1) this includes the convective velocity, 2) +! this includes the 1 m/s minimum wind threshold + +! If forcing height is less than or equal to 10m, then set 10-m wind to um + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + if (zldis(n)-z0m(n) .le. 10._r8) then + u10_clm(pp) = um(n) + else + if (zeta(n) < -zetam) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) & + - StabilityFunc1(-zetam) & + + StabilityFunc1((10._r8+z0m(n))/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) ) + else if (zeta(n) < 0._r8) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + - StabilityFunc1(zeta(n)) & + + StabilityFunc1((10._r8+z0m(n))/obu(n))) ) + else if (zeta(n) <= 1._r8) then + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) ) + else + u10_clm(pp) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) & + + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) ) + + end if + end if + va(pp) = um(n) + end do + else + if (zldis(n)-z0m(n) .le. 10._r8) then + u10_clm(n) = um(n) + else + if (zeta(n) < -zetam) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(-zetam*obu(n)/(10._r8+z0m(n))) & + - StabilityFunc1(-zetam) & + + StabilityFunc1((10._r8+z0m(n))/obu(n)) & + + 1.14_r8*((-zeta(n))**0.333_r8-(zetam)**0.333_r8)) ) + else if (zeta(n) < 0._r8) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + - StabilityFunc1(zeta(n)) & + + StabilityFunc1((10._r8+z0m(n))/obu(n))) ) + else if (zeta(n) <= 1._r8) then + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(zldis(n)/(10._r8+z0m(n))) & + + 5._r8*zeta(n) - 5._r8*(10._r8+z0m(n))/obu(n)) ) + else + u10_clm(n) = um(n) - ( ustar(n)/vkc*(log(obu(n)/(10._r8+z0m(n))) & + + 5._r8 - 5._r8*(10._r8+z0m(n))/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) ) + end if + end if + va(n) = um(n) + end if + + ! Temperature profile + + if (present(landunit_index)) then + zldis(n) = forc_hgt_t_pft(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_t_pft(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp1(n) = vkc/(log(-zetat*obu(n)/z0h(n))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp1(n) = vkc/(log(zldis(n)/z0h(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0h(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp1(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n)) + else + temp1(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + ! Humidity profile + + if (present(landunit_index)) then + if (forc_hgt_q_pft(pfti(n)) == forc_hgt_t_pft(pfti(n)) .and. z0q(n) == z0h(n)) then + temp2(n) = temp1(n) + else + zldis(n) = forc_hgt_q_pft(pfti(n))-displa(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + end if + else + if (forc_hgt_q_pft(n) == forc_hgt_t_pft(n) .and. z0q(n) == z0h(n)) then + temp2(n) = temp1(n) + else + zldis(n) = forc_hgt_q_pft(n)-displa(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp2(n) = vkc/(log(-zetat*obu(n)/z0q(n)) & + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp2(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp2(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + endif + endif + + ! Temperature profile applied at 2-m + + zldis(n) = 2.0_r8 + z0h(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp12m(n) = vkc/(log(-zetat*obu(n)/z0h(n))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp12m(n) = vkc/(log(zldis(n)/z0h(n)) & + - StabilityFunc2(zeta(n)) & + + StabilityFunc2(z0h(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp12m(n) = vkc/(log(zldis(n)/z0h(n)) + 5._r8*zeta(n) - 5._r8*z0h(n)/obu(n)) + else + temp12m(n) = vkc/(log(obu(n)/z0h(n)) + 5._r8 - 5._r8*z0h(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + + ! Humidity profile applied at 2-m + + if (z0q(n) == z0h(n)) then + temp22m(n) = temp12m(n) + else + zldis(n) = 2.0_r8 + z0q(n) + zeta(n) = zldis(n)/obu(n) + if (zeta(n) < -zetat) then + temp22m(n) = vkc/(log(-zetat*obu(n)/z0q(n)) - & + StabilityFunc2(-zetat) + StabilityFunc2(z0q(n)/obu(n)) & + + 0.8_r8*((zetat)**(-0.333_r8)-(-zeta(n))**(-0.333_r8))) + else if (zeta(n) < 0._r8) then + temp22m(n) = vkc/(log(zldis(n)/z0q(n)) - & + StabilityFunc2(zeta(n))+StabilityFunc2(z0q(n)/obu(n))) + else if (zeta(n) <= 1._r8) then + temp22m(n) = vkc/(log(zldis(n)/z0q(n)) + 5._r8*zeta(n)-5._r8*z0q(n)/obu(n)) + else + temp22m(n) = vkc/(log(obu(n)/z0q(n)) + 5._r8 - 5._r8*z0q(n)/obu(n) & + + (5._r8*log(zeta(n))+zeta(n)-1._r8)) + end if + end if + + ! diagnose 10-m wind for dust model (dstmbl.F) + ! Notes from C. Zender's dst.F: + ! According to Bon96 p. 62, the displacement height d (here displa) is + ! 0.0 <= d <= 0.34 m in dust source regions (i.e., regions w/o trees). + ! Therefore d <= 0.034*z1 and may safely be neglected. + ! Code from LSM routine SurfaceTemperature was used to obtain u10 + + if (present(landunit_index)) then + zldis(n) = forc_hgt_u_pft(pfti(n))-displa(n) + else + zldis(n) = forc_hgt_u_pft(n)-displa(n) + end if + zeta(n) = zldis(n)/obu(n) + if (min(zeta(n), 1._r8) < 0._r8) then + tmp1 = (1._r8 - 16._r8*min(zeta(n),1._r8))**0.25_r8 + tmp2 = log((1._r8+tmp1*tmp1)/2._r8) + tmp3 = log((1._r8+tmp1)/2._r8) + fmnew = 2._r8*tmp3 + tmp2 - 2._r8*atan(tmp1) + 1.5707963_r8 + else + fmnew = -5._r8*min(zeta(n),1._r8) + endif + if (iter == 1) then + fm(n) = fmnew + else + fm(n) = 0.5_r8 * (fm(n)+fmnew) + end if + zeta10 = min(10._r8/obu(n), 1._r8) + if (zeta(n) == 0._r8) zeta10 = 0._r8 + if (zeta10 < 0._r8) then + tmp1 = (1.0_r8 - 16.0_r8 * zeta10)**0.25_r8 + tmp2 = log((1.0_r8 + tmp1*tmp1)/2.0_r8) + tmp3 = log((1.0_r8 + tmp1)/2.0_r8) + fm10 = 2.0_r8*tmp3 + tmp2 - 2.0_r8*atan(tmp1) + 1.5707963_r8 + else ! not stable + fm10 = -5.0_r8 * zeta10 + end if + if (present(landunit_index)) then + tmp4 = log( max( 1.0_r8, forc_hgt_u_pft(pfti(n)) / 10._r8) ) + else + tmp4 = log( max( 1.0_r8, forc_hgt_u_pft(n) / 10._r8) ) + end if + if (present(landunit_index)) then + do pp = pfti(n),pftf(n) + u10(pp) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10) + fv(pp) = ustar(n) + end do + else + u10(n) = ur(n) - ustar(n)/vkc * (tmp4 - fm(n) + fm10) + fv(n) = ustar(n) + end if + + end do + + end subroutine FrictionVelocity + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: StabilityFunc +! +! !INTERFACE: + real(r8) function StabilityFunc1(zeta) +! +! !DESCRIPTION: +! Stability function for rib < 0. +! +! !USES: + use shr_const_mod, only: SHR_CONST_PI +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory +! +! !CALLED FROM: +! subroutine FrictionVelocity in this module +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: chik, chik2 +!------------------------------------------------------------------------------ + + chik2 = sqrt(1._r8-16._r8*zeta) + chik = sqrt(chik2) + StabilityFunc1 = 2._r8*log((1._r8+chik)*0.5_r8) & + + log((1._r8+chik2)*0.5_r8)-2._r8*atan(chik)+SHR_CONST_PI*0.5_r8 + + end function StabilityFunc1 + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: StabilityFunc2 +! +! !INTERFACE: + real(r8) function StabilityFunc2(zeta) +! +! !DESCRIPTION: +! Stability function for rib < 0. +! +! !USES: + use shr_const_mod, only: SHR_CONST_PI +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory +! +! !CALLED FROM: +! subroutine FrictionVelocity in this module +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: chik2 +!------------------------------------------------------------------------------ + + chik2 = sqrt(1._r8-16._r8*zeta) + StabilityFunc2 = 2._r8*log((1._r8+chik2)*0.5_r8) + + end function StabilityFunc2 + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: MoninObukIni +! +! !INTERFACE: + subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) +! +! !DESCRIPTION: +! Initialization of the Monin-Obukhov length. +! The scheme is based on the work of Zeng et al. (1998): +! Intercomparison of bulk aerodynamic algorithms for the computation +! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, +! Vol. 11, 2628-2644. +! +! !USES: + use clm_varcon, only : grav +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: ur ! wind speed at reference height [m/s] + real(r8), intent(in) :: thv ! virtual potential temperature (kelvin) + real(r8), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] + real(r8), intent(in) :: z0m ! roughness length, momentum [m] + real(r8), intent(out) :: um ! wind speed including the stability effect [m/s] + real(r8), intent(out) :: obu ! monin-obukhov length (m) +! +! !CALLED FROM: +! subroutine BareGroundFluxes in module BareGroundFluxesMod.F90 +! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod.F90 +! subroutine CanopyFluxes in module CanopyFluxesMod.F90 +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: wc ! convective velocity [m/s] + real(r8) :: rib ! bulk Richardson number + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: ustar ! friction velocity [m/s] +!----------------------------------------------------------------------- + + ! Initial values of u* and convective velocity + + ustar=0.06_r8 + wc=0.5_r8 + if (dthv >= 0._r8) then + um=max(ur,0.1_r8) + else + um=sqrt(ur*ur+wc*wc) + endif + + rib=grav*zldis*dthv/(thv*um*um) + + if (rib >= 0._r8) then ! neutral or stable + zeta = rib*log(zldis/z0m)/(1._r8-5._r8*min(rib,0.19_r8)) + zeta = min(2._r8,max(zeta,0.01_r8 )) + else ! unstable + zeta=rib*log(zldis/z0m) + zeta = max(-100._r8,min(zeta,-0.01_r8 )) + endif + + obu=zldis/zeta + + end subroutine MoninObukIni + +end module FrictionVelocityMod diff --git a/components/clm/src_clm40/biogeophys/Hydrology1Mod.F90 b/components/clm/src_clm40/biogeophys/Hydrology1Mod.F90 new file mode 100644 index 0000000000..915c0969ac --- /dev/null +++ b/components/clm/src_clm40/biogeophys/Hydrology1Mod.F90 @@ -0,0 +1,499 @@ +module Hydrology1Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: Hydrology1Mod +! +! !DESCRIPTION: +! Calculation of +! (1) water storage of intercepted precipitation +! (2) direct throughfall and canopy drainage of precipitation +! (3) the fraction of foliage covered by water and the fraction +! of foliage that is dry and transpiring. +! (4) snow layer initialization if the snow accumulation exceeds 10 mm. +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Hydrology1 +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Hydrology1 +! +! !INTERFACE: + subroutine Hydrology1(lbc, ubc, lbp, ubp, num_nolakec, filter_nolakec, & + num_nolakep, filter_nolakep) +! +! !DESCRIPTION: +! Calculation of +! (1) water storage of intercepted precipitation +! (2) direct throughfall and canopy drainage of precipitation +! (3) the fraction of foliage covered by water and the fraction +! of foliage that is dry and transpiring. +! (4) snow layer initialization if the snow accumulation exceeds 10 mm. +! Note: The evaporation loss is taken off after the calculation of leaf +! temperature in the subroutine clm\_leaftem.f90, not in this subroutine. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varcon , only : tfrz, istice, istwet, istsoil, istice_mec, isturb, & + icol_roof, icol_sunwall, icol_shadewall + use clm_varcon , only : istcrop + use FracWetMod , only : FracWet + use clm_time_manager , only : get_step_size + use subgridAveMod, only : p2c + use SNICARMod , only : snw_rds_min + +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_nolakep ! number of pft non-lake points in pft filter + integer, intent(in) :: filter_nolakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/15/02, Peter Thornton: Migrated to new data structures. Required +! adding a PFT loop. +! 4/26/05, Peter Thornton: Made the canopy interception factor fpi max=0.25 +! the default behavior +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arrays +! + real(r8), pointer :: qflx_floodg(:) ! gridcell flux of flood water from RTM + real(r8), pointer :: qflx_floodc(:) ! column flux of flood water from RTM + integer , pointer :: cgridcell(:) ! columns's gridcell + integer , pointer :: clandunit(:) ! columns's landunit + integer , pointer :: pgridcell(:) ! pft's gridcell + integer , pointer :: plandunit(:) ! pft's landunit + integer , pointer :: pcolumn(:) ! pft's column + integer , pointer :: npfts(:) ! number of pfts in column + integer , pointer :: pfti(:) ! column's beginning pft index + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: ctype(:) ! column type + real(r8), pointer :: forc_rain(:) ! rain rate [mm/s] + real(r8), pointer :: forc_snow(:) ! snow rate [mm/s] + real(r8), pointer :: forc_t(:) ! atmospheric temperature (Kelvin) + logical , pointer :: do_capsnow(:) ! true => do snow capping + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: dewmx(:) ! Maximum allowed dew [mm] + integer , pointer :: frac_veg_nosno(:) ! fraction of veg not covered by snow (0/1 now) [-] + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: h2ocan_loss(:) ! canopy water mass balance term (column) + real(r8), pointer :: irrig_rate(:) ! current irrigation rate (applied if n_irrig_steps_left > 0) [mm/s] +! +! local pointers to original implicit inout arrays +! + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: h2ocan(:) ! total canopy water (mm H2O) + real(r8), pointer :: qflx_irrig(:) ! irrigation amount (mm/s) + integer, pointer :: n_irrig_steps_left(:) ! number of time steps for which we still need to irrigate today +! +! local pointers to original implicit out arrays +! + real(r8), pointer :: qflx_prec_intr(:) ! interception of precipitation [mm/s] + real(r8), pointer :: qflx_prec_grnd(:) ! water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_snwcp_liq(:) ! excess rainfall due to snow capping (mm H2O /s) [+] + real(r8), pointer :: qflx_snwcp_ice(:) ! excess snowfall due to snow capping (mm H2O /s) [+] + real(r8), pointer :: qflx_snow_grnd_pft(:) ! snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_col(:) ! snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_rain_grnd(:) ! rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) + real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: z(:,:) ! layer thickness (m) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: frac_iceold(:,:) ! fraction of ice relative to the tot water + real(r8), pointer :: snw_rds(:,:) ! effective snow grain radius (col,lyr) [microns, m^-6] + real(r8), pointer :: mss_bcpho(:,:) ! mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcphi(:,:) ! mass of hydrophilic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bctot(:,:) ! total mass of BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bc_col(:) ! total column mass of BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bc_top(:) ! total top-layer mass of BC (col,lyr) [kg] + real(r8), pointer :: mss_ocpho(:,:) ! mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! mass of hydrophilic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_octot(:,:) ! total mass of OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_oc_col(:) ! total column mass of OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_oc_top(:) ! total top-layer mass of OC (col,lyr) [kg] + real(r8), pointer :: mss_dst1(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dsttot(:,:) ! total mass of dust in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst_col(:) ! total column mass of dust in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst_top(:) ! total top-layer mass of dust in snow (col,lyr) [kg] +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: f ! filter index + integer :: pi ! pft index + integer :: p ! pft index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! gridcell index + integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) + real(r8) :: dtime ! land model time step (sec) + real(r8) :: h2ocanmx ! maximum allowed water on canopy [mm] + real(r8) :: fpi ! coefficient of interception + real(r8) :: xrun ! excess water that exceeds the leaf capacity [mm/s] + real(r8) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] + real(r8) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + real(r8) :: fracsnow(lbp:ubp) ! frac of precipitation that is snow + real(r8) :: fracrain(lbp:ubp) ! frac of precipitation that is rain + real(r8) :: qflx_candrip(lbp:ubp) ! rate of canopy runoff and snow falling off canopy [mm/s] + real(r8) :: qflx_through_rain(lbp:ubp) ! direct rain throughfall [mm/s] + real(r8) :: qflx_through_snow(lbp:ubp) ! direct snow throughfall [mm/s] + real(r8) :: qflx_prec_grnd_snow(lbp:ubp) ! snow precipitation incident on ground [mm/s] + real(r8) :: qflx_prec_grnd_rain(lbp:ubp) ! rain precipitation incident on ground [mm/s] +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (gridcell-level) + + pgridcell => pft%gridcell + forc_rain => clm_a2l%forc_rain + forc_snow => clm_a2l%forc_snow + + ! Assign local pointers to derived type members (landunit-level) + + ltype => lun%itype + + ! Assign local pointers to derived type members (column-level) + + qflx_floodg => clm_a2l%forc_flood + qflx_floodc => cwf%qflx_floodc + cgridcell => col%gridcell + clandunit => col%landunit + ctype => col%itype + pfti => col%pfti + npfts => col%npfts + do_capsnow => cps%do_capsnow + forc_t => ces%forc_t + t_grnd => ces%t_grnd + snl => cps%snl + snowdp => cps%snowdp + h2osno => cws%h2osno + zi => cps%zi + dz => cps%dz + z => cps%z + frac_iceold => cps%frac_iceold + t_soisno => ces%t_soisno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + qflx_snow_grnd_col => pwf_a%qflx_snow_grnd + h2ocan_loss => cwf%h2ocan_loss + snw_rds => cps%snw_rds + mss_bcpho => cps%mss_bcpho + mss_bcphi => cps%mss_bcphi + mss_bctot => cps%mss_bctot + mss_bc_col => cps%mss_bc_col + mss_bc_top => cps%mss_bc_top + mss_ocpho => cps%mss_ocpho + mss_ocphi => cps%mss_ocphi + mss_octot => cps%mss_octot + mss_oc_col => cps%mss_oc_col + mss_oc_top => cps%mss_oc_top + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + mss_dsttot => cps%mss_dsttot + mss_dst_col => cps%mss_dst_col + mss_dst_top => cps%mss_dst_top + + ! Assign local pointers to derived type members (pft-level) + + plandunit => pft%landunit + pcolumn => pft%column + dewmx => pps%dewmx + frac_veg_nosno => pps%frac_veg_nosno + elai => pps%elai + esai => pps%esai + h2ocan => pws%h2ocan + qflx_prec_intr => pwf%qflx_prec_intr + qflx_prec_grnd => pwf%qflx_prec_grnd + qflx_snwcp_liq => pwf%qflx_snwcp_liq + qflx_snwcp_ice => pwf%qflx_snwcp_ice + qflx_snow_grnd_pft => pwf%qflx_snow_grnd + qflx_rain_grnd => pwf%qflx_rain_grnd + fwet => pps%fwet + fdry => pps%fdry + irrig_rate => cps%irrig_rate + n_irrig_steps_left => cps%n_irrig_steps_left + qflx_irrig => cwf%qflx_irrig + + ! Compute time step + + dtime = get_step_size() + + ! Start pft loop + + do f = 1, num_nolakep + p = filter_nolakep(f) + g = pgridcell(p) + l = plandunit(p) + c = pcolumn(p) + + ! Canopy interception and precipitation onto ground surface + ! Add precipitation to leaf water + + if (ltype(l)==istsoil .or. ltype(l)==istwet .or. ltype(l)==isturb .or. & + ltype(l)==istcrop) then + qflx_candrip(p) = 0._r8 ! rate of canopy runoff + qflx_through_snow(p) = 0._r8 ! rain precipitation direct through canopy + qflx_through_rain(p) = 0._r8 ! snow precipitation direct through canopy + qflx_prec_intr(p) = 0._r8 ! total intercepted precipitation + fracsnow(p) = 0._r8 ! fraction of input precip that is snow + fracrain(p) = 0._r8 ! fraction of input precip that is rain + + if (ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall) then + if (frac_veg_nosno(p) == 1 .and. (forc_rain(g) + forc_snow(g)) > 0._r8) then + + ! determine fraction of input precipitation that is snow and rain + + fracsnow(p) = forc_snow(g)/(forc_snow(g) + forc_rain(g)) + fracrain(p) = forc_rain(g)/(forc_snow(g) + forc_rain(g)) + + ! The leaf water capacities for solid and liquid are different, + ! generally double for snow, but these are of somewhat less + ! significance for the water budget because of lower evap. rate at + ! lower temperature. Hence, it is reasonable to assume that + ! vegetation storage of solid water is the same as liquid water. + h2ocanmx = dewmx(p) * (elai(p) + esai(p)) + + ! Coefficient of interception + ! set fraction of potential interception to max 0.25 + fpi = 0.25_r8*(1._r8 - exp(-0.5_r8*(elai(p) + esai(p)))) + + ! Direct throughfall + qflx_through_snow(p) = forc_snow(g) * (1._r8-fpi) + qflx_through_rain(p) = forc_rain(g) * (1._r8-fpi) + + ! Intercepted precipitation [mm/s] + qflx_prec_intr(p) = (forc_snow(g) + forc_rain(g)) * fpi + + ! Water storage of intercepted precipitation and dew + h2ocan(p) = max(0._r8, h2ocan(p) + dtime*qflx_prec_intr(p)) + + ! Initialize rate of canopy runoff and snow falling off canopy + qflx_candrip(p) = 0._r8 + + ! Excess water that exceeds the leaf capacity + xrun = (h2ocan(p) - h2ocanmx)/dtime + + ! Test on maximum dew on leaf + ! Note if xrun > 0 then h2ocan must be at least h2ocanmx + if (xrun > 0._r8) then + qflx_candrip(p) = xrun + h2ocan(p) = h2ocanmx + end if + + end if + end if + + else if (ltype(l)==istice .or. ltype(l)==istice_mec) then + + h2ocan(p) = 0._r8 + qflx_candrip(p) = 0._r8 + qflx_through_snow(p) = 0._r8 + qflx_through_rain(p) = 0._r8 + qflx_prec_intr(p) = 0._r8 + fracsnow(p) = 0._r8 + fracrain(p) = 0._r8 + + end if + + ! Precipitation onto ground (kg/(m2 s)) + ! PET, 1/18/2005: Added new terms for mass balance correction + ! due to dynamic pft weight shifting (column-level h2ocan_loss) + ! Because the fractionation between rain and snow is indeterminate if + ! rain + snow = 0, I am adding this very small flux only to the rain + ! components. + + if (ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall) then + if (frac_veg_nosno(p) == 0) then + qflx_prec_grnd_snow(p) = forc_snow(g) + qflx_prec_grnd_rain(p) = forc_rain(g) + h2ocan_loss(c) + else + qflx_prec_grnd_snow(p) = qflx_through_snow(p) + (qflx_candrip(p) * fracsnow(p)) + qflx_prec_grnd_rain(p) = qflx_through_rain(p) + (qflx_candrip(p) * fracrain(p)) + h2ocan_loss(c) + end if + ! Urban sunwall and shadewall have no intercepted precipitation + else + qflx_prec_grnd_snow(p) = 0. + qflx_prec_grnd_rain(p) = 0. + end if + + ! Determine whether we're irrigating here; set qflx_irrig appropriately + if (n_irrig_steps_left(c) > 0) then + qflx_irrig(c) = irrig_rate(c) + n_irrig_steps_left(c) = n_irrig_steps_left(c) - 1 + else + qflx_irrig(c) = 0._r8 + end if + + ! Add irrigation water directly onto ground (bypassing canopy interception) + ! Note that it's still possible that (some of) this irrigation water will runoff (as runoff is computed later) + qflx_prec_grnd_rain(p) = qflx_prec_grnd_rain(p) + qflx_irrig(c) + + ! Done irrigation + + qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) + + if (do_capsnow(c)) then + qflx_snwcp_liq(p) = qflx_prec_grnd_rain(p) + qflx_snwcp_ice(p) = qflx_prec_grnd_snow(p) + + qflx_snow_grnd_pft(p) = 0._r8 + qflx_rain_grnd(p) = 0._r8 + else + qflx_snwcp_liq(p) = 0._r8 + qflx_snwcp_ice(p) = 0._r8 + qflx_snow_grnd_pft(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) + qflx_rain_grnd(p) = qflx_prec_grnd_rain(p) ! liquid water onto ground (mm/s) + end if + + end do ! (end pft loop) + + ! Determine the fraction of foliage covered by water and the + ! fraction of foliage that is dry and transpiring. + + call FracWet(num_nolakep, filter_nolakep) + + ! Update column level state variables for snow. + + call p2c(num_nolakec, filter_nolakec, qflx_snow_grnd_pft, qflx_snow_grnd_col) + +!rtm_flood: apply gridcell flood water flux to non-lake columns +! no inputs to urban wall columns, as above with atm inputs +!dir$ concurrent +!cdir nodep + do f = 1, num_nolakec + c = filter_nolakec(f) + g = cgridcell(c) + if (ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall) then + qflx_floodc(c) = qflx_floodg(g) + else + qflx_floodc(c) = 0._r8 + endif + enddo +!rtm_flood + + ! Determine snow height and snow water + + do f = 1, num_nolakec + c = filter_nolakec(f) + l = clandunit(c) + g = cgridcell(c) + + ! Use Alta relationship, Anderson(1976); LaChapelle(1961), + ! U.S.Department of Agriculture Forest Service, Project F, + ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification. + + if (do_capsnow(c)) then + dz_snowf = 0._r8 + else + if (forc_t(c) > tfrz + 2._r8) then + bifall=50._r8 + 1.7_r8*(17.0_r8)**1.5_r8 + else if (forc_t(c) > tfrz - 15._r8) then + bifall=50._r8 + 1.7_r8*(forc_t(c) - tfrz + 15._r8)**1.5_r8 + else + bifall=50._r8 + end if + dz_snowf = qflx_snow_grnd_col(c)/bifall + snowdp(c) = snowdp(c) + dz_snowf*dtime + h2osno(c) = h2osno(c) + qflx_snow_grnd_col(c)*dtime ! snow water equivalent (mm) + + end if + + if (ltype(l)==istwet .and. t_grnd(c)>tfrz) then + h2osno(c)=0._r8 + snowdp(c)=0._r8 + end if + + ! When the snow accumulation exceeds 10 mm, initialize snow layer + ! Currently, the water temperature for the precipitation is simply set + ! as the surface air temperature + + newnode = 0 ! flag for when snow node will be initialized + if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_r8 .and. snowdp(c) >= 0.01_r8) then + newnode = 1 + snl(c) = -1 + dz(c,0) = snowdp(c) ! meter + z(c,0) = -0.5_r8*dz(c,0) + zi(c,-1) = -dz(c,0) + t_soisno(c,0) = min(tfrz, forc_t(c)) ! K + h2osoi_ice(c,0) = h2osno(c) ! kg/m2 + h2osoi_liq(c,0) = 0._r8 ! kg/m2 + frac_iceold(c,0) = 1._r8 + + + ! intitialize SNICAR variables for fresh snow: + snw_rds(c,0) = snw_rds_min + + mss_bcpho(c,:) = 0._r8 + mss_bcphi(c,:) = 0._r8 + mss_bctot(c,:) = 0._r8 + mss_bc_col(c) = 0._r8 + mss_bc_top(c) = 0._r8 + + mss_ocpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_octot(c,:) = 0._r8 + mss_oc_col(c) = 0._r8 + mss_oc_top(c) = 0._r8 + + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + mss_dsttot(c,:) = 0._r8 + mss_dst_col(c) = 0._r8 + mss_dst_top(c) = 0._r8 + end if + + ! The change of ice partial density of surface node due to precipitation. + ! Only ice part of snowfall is added here, the liquid part will be added + ! later. + + if (snl(c) < 0 .and. newnode == 0) then + h2osoi_ice(c,snl(c)+1) = h2osoi_ice(c,snl(c)+1)+dtime*qflx_snow_grnd_col(c) + dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime + end if + + end do + + end subroutine Hydrology1 + +end module Hydrology1Mod diff --git a/components/clm/src_clm40/biogeophys/Hydrology2Mod.F90 b/components/clm/src_clm40/biogeophys/Hydrology2Mod.F90 new file mode 100644 index 0000000000..759e9d3657 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/Hydrology2Mod.F90 @@ -0,0 +1,757 @@ +module Hydrology2Mod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: Hydrology2Mod +! +! !DESCRIPTION: +! Calculation of soil/snow hydrology. +! +! !USES: + use clm_varctl, only : iulog, use_cn + use abortutils, only : endrun +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Hydrology2 ! Calculates soil/snow hydrology +! +! !REVISION HISTORY: +! 2/28/02 Peter Thornton: Migrated to new data structures. +! 7/12/03 Forrest Hoffman ,Mariana Vertenstein : Migrated to vector code +! 11/05/03 Peter Thornton: Added calculation of soil water potential +! for use in CN phenology code. +! 04/25/07 Keith Oleson: CLM3.5 Hydrology +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Hydrology2 +! +! !INTERFACE: + subroutine Hydrology2(lbc, ubc, lbp, ubp, & + num_nolakec, filter_nolakec, & + num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + num_snowc, filter_snowc, & + num_nosnowc, filter_nosnowc) +! +! !DESCRIPTION: +! This is the main subroutine to execute the calculation of soil/snow +! hydrology +! Calling sequence is: +! Hydrology2: surface hydrology driver +! -> SnowWater: change of snow mass and snow water onto soil +! -> SurfaceRunoff: surface runoff +! -> Infiltration: infiltration into surface soil layer +! -> SoilWater: soil water movement between layers +! -> Tridiagonal tridiagonal matrix solution +! -> Drainage: subsurface runoff +! -> SnowCompaction: compaction of snow layers +! -> CombineSnowLayers: combine snow layers that are thinner than minimum +! -> DivideSnowLayers: subdivide snow layers that are thicker than maximum +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varcon , only : denh2o, denice, spval, & + istice, istwet, istsoil, isturb, istice_mec, & + icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, & + icol_shadewall + use clm_varcon , only : istcrop + use clm_varctl , only : glc_dyntopo + use clm_varpar , only : nlevgrnd, nlevsno, nlevsoi + use SnowHydrologyMod, only : SnowCompaction, CombineSnowLayers, DivideSnowLayers, & + SnowWater, BuildSnowFilter + use SoilHydrologyMod, only : Infiltration, SoilWater, Drainage, SurfaceRunoff + use clm_time_manager, only : get_step_size, get_nstep, is_perpetual + +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: lbp, ubp ! pft bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer, intent(in) :: filter_hydrologyc(ubc-lbc+1)! column filter for soil points + integer, intent(in) :: num_urbanc ! number of column urban points in column filter + integer, intent(in) :: filter_urbanc(ubc-lbc+1) ! column filter for urban points + integer :: num_snowc ! number of column snow points + integer :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer :: num_nosnowc ! number of column non-snow points + integer :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! +!rtm_flood + real(r8), pointer :: qflx_floodg(:) ! gridcell flux of flood water from RTM +!rtm_flood + integer , pointer :: cgridcell(:) ! column's gridcell + integer , pointer :: clandunit(:) ! column's landunit + integer , pointer :: ityplun(:) ! landunit type + integer , pointer :: ctype(:) ! column type + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: h2ocan(:) ! canopy water (mm H2O) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(r8), pointer :: z(:,:) ! layer depth (m) + real(r8), pointer :: forc_rain(:) ! rain rate [mm/s] + real(r8), pointer :: forc_snow(:) ! snow rate [mm/s] + real(r8), pointer :: begwb(:) ! water mass begining of the time step + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code + real(r8), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(r8), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: zi(:,:) ! interface depth (m) + real(r8), pointer :: zwt(:) ! water table depth (m) + real(r8), pointer :: fcov(:) ! fractional impermeable area + real(r8), pointer :: fsat(:) ! fractional area with water table at surface + real(r8), pointer :: wa(:) ! water in the unconfined aquifer (mm) + real(r8), pointer :: qcharge(:) ! aquifer recharge rate (mm/s) + real(r8), pointer :: smp_l(:,:) ! soil matrix potential [mm] + real(r8), pointer :: hk_l(:,:) ! hydraulic conductivity (mm/s) + real(r8), pointer :: qflx_rsub_sat(:) ! soil saturation excess [mm h2o/s] +! +! local pointers to implicit out arguments +! + real(r8), pointer :: endwb(:) ! water mass end of the time step + real(r8), pointer :: wf(:) ! soil water as frac. of whc for top 0.5 m + real(r8), pointer :: snowice(:) ! average snow ice lens + real(r8), pointer :: snowliq(:) ! average snow liquid water + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: t_soi_10cm(:) ! soil temperature in top 10cm of soil (Kelvin) + real(r8), pointer :: h2osoi_liqice_10cm(:) ! liquid water + ice lens in top 10cm of soil (kg/m2) + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + real(r8), pointer :: qflx_drain(:) ! sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_surf(:) ! surface runoff (mm H2O /s) + real(r8), pointer :: qflx_infl(:) ! infiltration (mm H2O /s) + real(r8), pointer :: qflx_qrgwl(:) ! qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_irrig(:) ! irrigation flux (mm H2O /s) + real(r8), pointer :: qflx_runoff(:) ! total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_u(:) ! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + real(r8), pointer :: qflx_runoff_r(:) ! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: t_grnd_u(:) ! Urban ground temperature (Kelvin) + real(r8), pointer :: t_grnd_r(:) ! Rural ground temperature (Kelvin) + real(r8), pointer :: qflx_snwcp_ice(:)! excess snowfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + + real(r8), pointer :: snot_top(:) ! snow temperature in top layer (col) [K] + real(r8), pointer :: dTdz_top(:) ! temperature gradient in top layer (col) [K m-1] + real(r8), pointer :: snw_rds(:,:) ! effective snow grain radius (col,lyr) [microns, m^-6] + real(r8), pointer :: snw_rds_top(:) ! effective snow grain size, top layer(col) [microns] + real(r8), pointer :: sno_liq_top(:) ! liquid water fraction in top snow layer (col) [frc] + real(r8), pointer :: frac_sno(:) ! snow cover fraction (col) [frc] + real(r8), pointer :: h2osno_top(:) ! mass of snow in top layer (col) [kg] + + real(r8), pointer :: mss_bcpho(:,:) ! mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcphi(:,:) ! mass of hydrophillic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bctot(:,:) ! total mass of BC (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_bc_col(:) ! total mass of BC in snow column (col) [kg] + real(r8), pointer :: mss_bc_top(:) ! total mass of BC in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of BC species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of BC species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_ocpho(:,:) ! mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! mass of hydrophillic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_octot(:,:) ! total mass of OC (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_oc_col(:) ! total mass of OC in snow column (col) [kg] + real(r8), pointer :: mss_oc_top(:) ! total mass of OC in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of OC species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of OC species 2 (col,lyr) [kg/kg] + + real(r8), pointer :: mss_dst1(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dsttot(:,:) ! total mass of dust in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst_col(:) ! total mass of dust in snow column (col) [kg] + real(r8), pointer :: mss_dst_top(:) ! total mass of dust in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_dst1(:,:) ! mass concentration of dust species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst2(:,:) ! mass concentration of dust species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst3(:,:) ! mass concentration of dust species 3 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst4(:,:) ! mass concentration of dust species 4 (col,lyr) [kg/kg] + logical , pointer :: do_capsnow(:) ! true => do snow capping + real(r8), pointer :: qflx_glcice(:) ! flux of new glacier ice (mm H2O /s) + real(r8), pointer :: qflx_glcice_frz(:) ! ice growth (positive definite) (mm H2O/s) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: g,l,c,j,fc ! indices + integer :: nstep ! time step number + real(r8) :: dtime ! land model time step (sec) + real(r8) :: vol_liq(lbc:ubc,1:nlevgrnd)! partial volume of liquid water in layer + real(r8) :: icefrac(lbc:ubc,1:nlevgrnd)! ice fraction in layer + real(r8) :: dwat(lbc:ubc,1:nlevgrnd) ! change in soil water + real(r8) :: hk(lbc:ubc,1:nlevgrnd) ! hydraulic conductivity (mm h2o/s) + real(r8) :: dhkdw(lbc:ubc,1:nlevgrnd) ! d(hk)/d(vol_liq) + real(r8) :: psi,vwc,fsattmp ! temporary variables for soilpsi calculation + real(r8) :: watdry ! temporary + real(r8) :: rwat(lbc:ubc) ! soil water wgted by depth to maximum depth of 0.5 m + real(r8) :: swat(lbc:ubc) ! same as rwat but at saturation + real(r8) :: rz(lbc:ubc) ! thickness of soil layers contributing to rwat (m) + real(r8) :: tsw ! volumetric soil water to 0.5 m + real(r8) :: stsw ! volumetric soil water to 0.5 m at saturation + real(r8) :: snowmass ! liquid+ice snow mass in a layer [kg/m2] + real(r8) :: snowcap_scl_fct ! temporary factor used to correct for snow capping + real(r8) :: fracl ! fraction of soil layer contributing to 10cm total soil water + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (gridcell-level) + + forc_rain => clm_a2l%forc_rain + forc_snow => clm_a2l%forc_snow + + ! Assign local pointers to derived subtypes components (landunit-level) + + ityplun => lun%itype + + ! Assign local pointers to derived subtypes components (column-level) + +!rtm_flood + qflx_floodg => clm_a2l%forc_flood +!rtm_flood + cgridcell => col%gridcell + clandunit => col%landunit + ctype => col%itype + snl => cps%snl + t_grnd => ces%t_grnd + h2ocan => pws_a%h2ocan + h2osno => cws%h2osno + wf => cps%wf + snowice => cws%snowice + snowliq => cws%snowliq + zwt => cws%zwt + fcov => cws%fcov + fsat => cws%fsat + wa => cws%wa + qcharge => cws%qcharge + watsat => cps%watsat + sucsat => cps%sucsat + bsw => cps%bsw + z => cps%z + dz => cps%dz + zi => cps%zi + t_soisno => ces%t_soisno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + h2osoi_vol => cws%h2osoi_vol + t_soi_10cm => ces%t_soi_10cm + h2osoi_liqice_10cm => cws%h2osoi_liqice_10cm + qflx_evap_tot => pwf_a%qflx_evap_tot + qflx_drain => cwf%qflx_drain + qflx_surf => cwf%qflx_surf + qflx_infl => cwf%qflx_infl + qflx_qrgwl => cwf%qflx_qrgwl + qflx_irrig => cwf%qflx_irrig + endwb => cwbal%endwb + begwb => cwbal%begwb + bsw2 => cps%bsw2 + psisat => cps%psisat + vwcsat => cps%vwcsat + soilpsi => cps%soilpsi + smp_l => cws%smp_l + hk_l => cws%hk_l + qflx_rsub_sat => cwf%qflx_rsub_sat + qflx_runoff => cwf%qflx_runoff + qflx_runoff_u => cwf%qflx_runoff_u + qflx_runoff_r => cwf%qflx_runoff_r + t_grnd_u => ces%t_grnd_u + t_grnd_r => ces%t_grnd_r + snot_top => cps%snot_top + dTdz_top => cps%dTdz_top + snw_rds => cps%snw_rds + snw_rds_top => cps%snw_rds_top + sno_liq_top => cps%sno_liq_top + frac_sno => cps%frac_sno + h2osno_top => cps%h2osno_top + mss_bcpho => cps%mss_bcpho + mss_bcphi => cps%mss_bcphi + mss_bctot => cps%mss_bctot + mss_bc_col => cps%mss_bc_col + mss_bc_top => cps%mss_bc_top + mss_cnc_bcphi => cps%mss_cnc_bcphi + mss_cnc_bcpho => cps%mss_cnc_bcpho + mss_ocpho => cps%mss_ocpho + mss_ocphi => cps%mss_ocphi + mss_octot => cps%mss_octot + mss_oc_col => cps%mss_oc_col + mss_oc_top => cps%mss_oc_top + mss_cnc_ocphi => cps%mss_cnc_ocphi + mss_cnc_ocpho => cps%mss_cnc_ocpho + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + mss_dsttot => cps%mss_dsttot + mss_dst_col => cps%mss_dst_col + mss_dst_top => cps%mss_dst_top + mss_cnc_dst1 => cps%mss_cnc_dst1 + mss_cnc_dst2 => cps%mss_cnc_dst2 + mss_cnc_dst3 => cps%mss_cnc_dst3 + mss_cnc_dst4 => cps%mss_cnc_dst4 + do_capsnow => cps%do_capsnow + qflx_snwcp_ice => pwf_a%qflx_snwcp_ice + qflx_glcice => cwf%qflx_glcice + qflx_glcice_frz => cwf%qflx_glcice_frz + + ! Determine time step and step size + + nstep = get_nstep() + dtime = get_step_size() + + ! Determine initial snow/no-snow filters (will be modified possibly by + ! routines CombineSnowLayers and DivideSnowLayers below + + call BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + ! Determine the change of snow mass and the snow water onto soil + + call SnowWater(lbc, ubc, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + ! Determine soil hydrology + + call SurfaceRunoff(lbc, ubc, lbp, ubp, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + vol_liq, icefrac ) + + call Infiltration(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc) + + call SoilWater(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + vol_liq, dwat, hk, dhkdw) + + call Drainage(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + vol_liq, hk, icefrac) + + if (.not. is_perpetual()) then + + ! Natural compaction and metamorphosis. + + call SnowCompaction(lbc, ubc, num_snowc, filter_snowc) + + ! Combine thin snow elements + + call CombineSnowLayers(lbc, ubc, num_snowc, filter_snowc) + + ! Divide thick snow elements + + call DivideSnowLayers(lbc, ubc, num_snowc, filter_snowc) + + else + + do fc = 1, num_snowc + c = filter_snowc(fc) + h2osno(c) = 0._r8 + end do + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end if + end do + end do + + end if + + ! Set empty snow layers to zero + + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j <= snl(c) .and. snl(c) > -nlevsno) then + h2osoi_ice(c,j) = 0._r8 + h2osoi_liq(c,j) = 0._r8 + t_soisno(c,j) = 0._r8 + dz(c,j) = 0._r8 + z(c,j) = 0._r8 + zi(c,j-1) = 0._r8 + end if + end do + end do + + ! Build new snow filter + + call BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + + ! Vertically average t_soisno and sum of h2osoi_liq and h2osoi_ice + ! over all snow layers for history output + + do fc = 1, num_nolakec + c = filter_nolakec(fc) + snowice(c) = 0._r8 + snowliq(c) = 0._r8 + end do + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + snowice(c) = snowice(c) + h2osoi_ice(c,j) + snowliq(c) = snowliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Determine ground temperature, ending water balance and volumetric soil water + ! Calculate soil temperature and total water (liq+ice) in top 10cm of soil + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (ityplun(l) /= isturb) then + t_soi_10cm(c) = 0._r8 + h2osoi_liqice_10cm(c) = 0._r8 + end if + end do + do j = 1, nlevsoi + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (ityplun(l) /= isturb) then + if (zi(c,j) <= 0.1_r8) then + fracl = 1._r8 + t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + else + if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) .lt. 0.1_r8) then + fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) + t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + end if + end if + end if + end do + end do + + do fc = 1, num_nolakec + + c = filter_nolakec(fc) + l = clandunit(c) + + t_grnd(c) = t_soisno(c,snl(c)+1) + if (ityplun(l) /= isturb) then + t_soi_10cm(c) = t_soi_10cm(c)/0.1_r8 + end if + if (ityplun(l)==isturb) then + t_grnd_u(c) = t_soisno(c,snl(c)+1) + end if + if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then + t_grnd_r(c) = t_soisno(c,snl(c)+1) + end if + if (ctype(c) == icol_roof .or. ctype(c) == icol_sunwall & + .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_road_imperv) then + endwb(c) = h2ocan(c) + h2osno(c) + else + endwb(c) = h2ocan(c) + h2osno(c) + wa(c) + end if + end do + + do j = 1, nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + endwb(c) = endwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + end do + end do + + ! Determine wetland and land ice hydrology (must be placed here + ! since need snow updated from CombineSnowLayers) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + g = cgridcell(c) + if (ityplun(l)==istwet .or. ityplun(l)==istice & + .or. ityplun(l)==istice_mec) then + qflx_drain(c) = 0._r8 + qflx_irrig(c) = 0._r8 + qflx_surf(c) = 0._r8 + qflx_infl(c) = 0._r8 + +!rtm_flood: add flood water flux to runoff for wetlands/glaciers + qflx_qrgwl(c) = forc_rain(g) + forc_snow(g) + qflx_floodg(g) - qflx_evap_tot(c) - qflx_snwcp_ice(c) - & +!rtm_flood + (endwb(c)-begwb(c))/dtime + ! For dynamic topography, add meltwater from glacier_mec ice to the runoff. + ! (Negative qflx_glcice => positive contribution to runoff) + ! Note: The meltwater contribution is computed in PhaseChanges (part of Biogeophysics2). + ! This code will not work if Hydrology2 is called before Biogeophysics2, or if + ! qflx_snwcp_ice has alread been included in qflx_glcice. + ! (The snwcp flux is added to qflx_glcice later in this subroutine.) + + if (glc_dyntopo .and. ityplun(l)==istice_mec) then + qflx_qrgwl(c) = qflx_qrgwl(c) - qflx_glcice(c) ! meltwater from melted ice + endif + fcov(c) = spval + fsat(c) = spval + qcharge(c) = spval + qflx_rsub_sat(c) = spval + else if (ityplun(l) == isturb .and. ctype(c) /= icol_road_perv) then + fcov(c) = spval + fsat(c) = spval + qcharge(c) = spval + qflx_rsub_sat(c) = spval + end if + + ! If snow exceeds the thickness limit in glacier_mec columns, convert to an ice flux. + ! For dynamic glacier topography, remove qflx_snwcp_ice from the runoff. + ! Note that qflx_glcice can also have a negative component from melting of bare ice, + ! as computed in SoilTemperatureMod.F90 + + if (ityplun(l)==istice_mec) then + + qflx_glcice_frz(c) = qflx_snwcp_ice(c) + qflx_glcice(c) = qflx_glcice(c) + qflx_glcice_frz(c) + + ! For dynamic topography, set qflx_snwcp_ice = 0 so that this ice mass does not run off. + ! For static topography, qflx_glc_ice is passed to the ice sheet model, but the + ! CLM runoff terms are not changed. + + if (glc_dyntopo) qflx_snwcp_ice(c) = 0._r8 + + endif ! istice_mec + + qflx_runoff(c) = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c) + if (ityplun(l)==istsoil .and. col%wtgcell(c) > 0.0_r8 ) then + qflx_runoff(c) = qflx_runoff(c) - qflx_irrig(c) + end if + if (ityplun(l)==isturb) then + qflx_runoff_u(c) = qflx_runoff(c) + else if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then + qflx_runoff_r(c) = qflx_runoff(c) + end if + + end do + + if (use_cn) then + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + if (h2osoi_liq(c,j) > 0._r8) then + vwc = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + + ! the following limit set to catch very small values of + ! fractional saturation that can crash the calculation of psi + + fsattmp = max(vwc/vwcsat(c,j), 0.001_r8) + psi = psisat(c,j) * (fsattmp)**bsw2(c,j) + soilpsi(c,j) = min(max(psi,-15.0_r8),0._r8) + else + soilpsi(c,j) = -15.0_r8 + end if + end do + end do + end if + + if (use_cn) then + ! Available soil water up to a depth of 0.5 m. + ! Potentially available soil water (=whc) up to a depth of 0.5 m. + ! Water content as fraction of whc up to a depth of 0.5 m. + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + rwat(c) = 0._r8 + swat(c) = 0._r8 + rz(c) = 0._r8 + end do + + do j = 1, nlevgrnd + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + !if (z(c,j)+0.5_r8*dz(c,j) <= 0.5_r8) then + if (z(c,j)+0.5_r8*dz(c,j) <= 0.05_r8) then + watdry = watsat(c,j) * (316230._r8/sucsat(c,j)) ** (-1._r8/bsw(c,j)) + rwat(c) = rwat(c) + (h2osoi_vol(c,j)-watdry) * dz(c,j) + swat(c) = swat(c) + (watsat(c,j) -watdry) * dz(c,j) + rz(c) = rz(c) + dz(c,j) + end if + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (rz(c) /= 0._r8) then + tsw = rwat(c)/rz(c) + stsw = swat(c)/rz(c) + else + watdry = watsat(c,1) * (316230._r8/sucsat(c,1)) ** (-1._r8/bsw(c,1)) + tsw = h2osoi_vol(c,1) - watdry + stsw = watsat(c,1) - watdry + end if + wf(c) = tsw/stsw + end do + end if + + + ! Calculate column-integrated aerosol masses, and + ! mass concentrations for radiative calculations and output + ! (based on new snow level state, after SnowFilter is rebuilt. + ! NEEDS TO BE AFTER SnowFiler is rebuilt, otherwise there + ! can be zero snow layers but an active column in filter) + + do fc = 1, num_snowc + c = filter_snowc(fc) + + ! Zero column-integrated aerosol mass before summation + mss_bc_col(c) = 0._r8 + mss_oc_col(c) = 0._r8 + mss_dst_col(c) = 0._r8 + + do j = -nlevsno+1, 0 + + ! layer mass of snow: + snowmass = h2osoi_ice(c,j)+h2osoi_liq(c,j) + + ! Correct the top layer aerosol mass to account for snow capping. + ! This approach conserves the aerosol mass concentration + ! (but not the aerosol amss) when snow-capping is invoked + + if (j == snl(c)+1) then + if (do_capsnow(c)) then + snowcap_scl_fct = snowmass / (snowmass+(qflx_snwcp_ice(c)*dtime)) + + mss_bcpho(c,j) = mss_bcpho(c,j)*snowcap_scl_fct + mss_bcphi(c,j) = mss_bcphi(c,j)*snowcap_scl_fct + mss_ocpho(c,j) = mss_ocpho(c,j)*snowcap_scl_fct + mss_ocphi(c,j) = mss_ocphi(c,j)*snowcap_scl_fct + + mss_dst1(c,j) = mss_dst1(c,j)*snowcap_scl_fct + mss_dst2(c,j) = mss_dst2(c,j)*snowcap_scl_fct + mss_dst3(c,j) = mss_dst3(c,j)*snowcap_scl_fct + mss_dst4(c,j) = mss_dst4(c,j)*snowcap_scl_fct + endif + endif + + if (j >= snl(c)+1) then + mss_bctot(c,j) = mss_bcpho(c,j) + mss_bcphi(c,j) + mss_bc_col(c) = mss_bc_col(c) + mss_bctot(c,j) + mss_cnc_bcphi(c,j) = mss_bcphi(c,j) / snowmass + mss_cnc_bcpho(c,j) = mss_bcpho(c,j) / snowmass + + mss_octot(c,j) = mss_ocpho(c,j) + mss_ocphi(c,j) + mss_oc_col(c) = mss_oc_col(c) + mss_octot(c,j) + mss_cnc_ocphi(c,j) = mss_ocphi(c,j) / snowmass + mss_cnc_ocpho(c,j) = mss_ocpho(c,j) / snowmass + + mss_dsttot(c,j) = mss_dst1(c,j) + mss_dst2(c,j) + mss_dst3(c,j) + mss_dst4(c,j) + mss_dst_col(c) = mss_dst_col(c) + mss_dsttot(c,j) + mss_cnc_dst1(c,j) = mss_dst1(c,j) / snowmass + mss_cnc_dst2(c,j) = mss_dst2(c,j) / snowmass + mss_cnc_dst3(c,j) = mss_dst3(c,j) / snowmass + mss_cnc_dst4(c,j) = mss_dst4(c,j) / snowmass + + else + !set variables of empty snow layers to zero + snw_rds(c,j) = 0._r8 + + mss_bcpho(c,j) = 0._r8 + mss_bcphi(c,j) = 0._r8 + mss_bctot(c,j) = 0._r8 + mss_cnc_bcphi(c,j) = 0._r8 + mss_cnc_bcpho(c,j) = 0._r8 + + mss_ocpho(c,j) = 0._r8 + mss_ocphi(c,j) = 0._r8 + mss_octot(c,j) = 0._r8 + mss_cnc_ocphi(c,j) = 0._r8 + mss_cnc_ocpho(c,j) = 0._r8 + + mss_dst1(c,j) = 0._r8 + mss_dst2(c,j) = 0._r8 + mss_dst3(c,j) = 0._r8 + mss_dst4(c,j) = 0._r8 + mss_dsttot(c,j) = 0._r8 + mss_cnc_dst1(c,j) = 0._r8 + mss_cnc_dst2(c,j) = 0._r8 + mss_cnc_dst3(c,j) = 0._r8 + mss_cnc_dst4(c,j) = 0._r8 + endif + enddo + + ! top-layer diagnostics + h2osno_top(c) = h2osoi_ice(c,snl(c)+1) + h2osoi_liq(c,snl(c)+1) + mss_bc_top(c) = mss_bctot(c,snl(c)+1) + mss_oc_top(c) = mss_octot(c,snl(c)+1) + mss_dst_top(c) = mss_dsttot(c,snl(c)+1) + enddo + + ! Zero mass variables in columns without snow + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + + h2osno_top(c) = 0._r8 + snw_rds(c,:) = 0._r8 + + mss_bc_top(c) = 0._r8 + mss_bc_col(c) = 0._r8 + mss_bcpho(c,:) = 0._r8 + mss_bcphi(c,:) = 0._r8 + mss_bctot(c,:) = 0._r8 + mss_cnc_bcphi(c,:) = 0._r8 + mss_cnc_bcpho(c,:) = 0._r8 + + mss_oc_top(c) = 0._r8 + mss_oc_col(c) = 0._r8 + mss_ocpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_octot(c,:) = 0._r8 + mss_cnc_ocphi(c,:) = 0._r8 + mss_cnc_ocpho(c,:) = 0._r8 + + mss_dst_top(c) = 0._r8 + mss_dst_col(c) = 0._r8 + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + mss_dsttot(c,:) = 0._r8 + mss_cnc_dst1(c,:) = 0._r8 + mss_cnc_dst2(c,:) = 0._r8 + mss_cnc_dst3(c,:) = 0._r8 + mss_cnc_dst4(c,:) = 0._r8 + + ! top-layer diagnostics (spval is not averaged when computing history fields) + snot_top(c) = spval + dTdz_top(c) = spval + snw_rds_top(c) = spval + sno_liq_top(c) = spval + enddo + + end subroutine Hydrology2 + +end module Hydrology2Mod diff --git a/components/clm/src_clm40/biogeophys/HydrologyLakeMod.F90 b/components/clm/src_clm40/biogeophys/HydrologyLakeMod.F90 new file mode 100644 index 0000000000..09207e6e35 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/HydrologyLakeMod.F90 @@ -0,0 +1,322 @@ +module HydrologyLakeMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: HydrologyLakeMod +! +! !DESCRIPTION: +! Calculate lake hydrology +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: HydrologyLake +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: HydrologyLake +! +! !INTERFACE: + subroutine HydrologyLake(lbp, ubp, num_lakep, filter_lakep) +! +! !DESCRIPTION: +! Calculate lake hydrology +! +! WARNING: This subroutine assumes lake columns have one and only one pft. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_time_manager, only : get_step_size + use clm_varcon , only : hfus, tfrz, spval +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: num_lakep ! number of pft non-lake points in pft filter + integer, intent(in) :: filter_lakep(ubp-lbp+1) ! pft filter for non-lake points +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 3/4/02: Peter Thornton; Migrated to new data structures. +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arrays +! + integer , pointer :: pcolumn(:) !pft's column index + integer , pointer :: pgridcell(:) !pft's gridcell index + real(r8), pointer :: begwb(:) !water mass begining of the time step + real(r8), pointer :: forc_snow(:) !snow rate [mm/s] + real(r8), pointer :: forc_rain(:) !rain rate [mm/s] + logical , pointer :: do_capsnow(:) !true => do snow capping + real(r8), pointer :: t_grnd(:) !ground temperature (Kelvin) + real(r8), pointer :: qmelt(:) !snow melt [mm/s] + real(r8), pointer :: qflx_evap_soi(:) !soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot(:) !qflx_evap_soi + qflx_evap_can + qflx_tran_veg +! +! local pointers to implicit inout arrays +! + real(r8), pointer :: h2osno(:) !snow water (mm H2O) +! +! local pointers to implicit out arrays +! +!rtm_flood + real(r8), pointer :: qflx_floodg(:) ! gridcell flux of flood water from RTM + real(r8), pointer :: qflx_floodc(:) ! column flux of flood water from RTM +!rtm_flood + real(r8), pointer :: endwb(:) !water mass end of the time step + real(r8), pointer :: snowdp(:) !snow height (m) + real(r8), pointer :: snowice(:) !average snow ice lens + real(r8), pointer :: snowliq(:) !average snow liquid water + real(r8), pointer :: qflx_rain_grnd(:)!rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_rain_grnd_col(:)!rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd(:)!snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd_col(:)!snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: eflx_snomelt(:) !snow melt heat flux (W/m**2) + real(r8), pointer :: qflx_infl(:) !infiltration (mm H2O /s) + real(r8), pointer :: qflx_snomelt(:) !snow melt (mm H2O /s) + real(r8), pointer :: qflx_surf(:) !surface runoff (mm H2O /s) + real(r8), pointer :: qflx_drain(:) !sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_irrig(:) !irrigation flux (mm H2O /s) + real(r8), pointer :: qflx_qrgwl(:) !qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_runoff(:) !total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_snwcp_ice(:)!excess snowfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: qflx_snwcp_ice_col(:)!excess snowfall due to snow capping (mm H2O /s) [+]` + real(r8), pointer :: qflx_evap_tot_col(:) !pft quantity averaged to the column (assuming one pft) + real(r8), pointer :: qflx_evap_grnd(:)! ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_evap_grnd_col(:)! ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_sub_snow(:) ! sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow_col(:) ! sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow(:) ! surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow_col(:) ! surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd(:) ! ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd_col(:) ! ground surface dew formation (mm H2O /s) [+] + real(r8) ,pointer :: soilalpha(:) !factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: zwt(:) !water table depth + real(r8), pointer :: fcov(:) !fractional impermeable area + real(r8), pointer :: fsat(:) !fractional area with water table at surface + real(r8), pointer :: qcharge(:) !aquifer recharge rate (mm/s) + real(r8), pointer :: qflx_top_soil(:) ! net water input into soil from top (mm/s) + real(r8), pointer :: qflx_prec_grnd(:) ! water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_prec_grnd_col(:) ! water onto ground including canopy runoff [kg/(m2 s)] +! +! local pointers to implicit out multi-level arrays +! + real(r8), pointer :: rootr_column(:,:) !effective fraction of roots in each soil layer + real(r8), pointer :: h2osoi_vol(:,:) !volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) + real(r8), pointer :: qflx_snofrz_col(:)!column-integrated snow freezing rate (kg m-2 s-1) [+] +! +! +! !OTHER LOCAL VARIABLES: +!EOP + real(r8), parameter :: snow_bd = 250._r8 !constant snow bulk density + integer :: fp, p, c, g ! indices + real(r8) :: dtime ! land model time step (sec) +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type gridcell members + + forc_snow => clm_a2l%forc_snow + forc_rain => clm_a2l%forc_rain + + ! Assign local pointers to derived type column members + +!rtm_flood: add flooding terms + qflx_floodg => clm_a2l%forc_flood + qflx_floodc => cwf%qflx_floodc +!rtm_flood + begwb => cwbal%begwb + endwb => cwbal%endwb + do_capsnow => cps%do_capsnow + snowdp => cps%snowdp + t_grnd => ces%t_grnd + h2osno => cws%h2osno + snowice => cws%snowice + snowliq => cws%snowliq + eflx_snomelt => cef%eflx_snomelt + qmelt => cwf%qmelt + qflx_snomelt => cwf%qflx_snomelt + qflx_surf => cwf%qflx_surf + qflx_qrgwl => cwf%qflx_qrgwl + qflx_runoff => cwf%qflx_runoff + qflx_snwcp_ice_col => pwf_a%qflx_snwcp_ice + qflx_drain => cwf%qflx_drain + qflx_irrig => cwf%qflx_irrig + qflx_infl => cwf%qflx_infl + rootr_column => cps%rootr_column + h2osoi_vol => cws%h2osoi_vol + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + qflx_evap_tot_col => pwf_a%qflx_evap_tot + soilalpha => cws%soilalpha + zwt => cws%zwt + fcov => cws%fcov + fsat => cws%fsat + qcharge => cws%qcharge + qflx_snofrz_col => cwf%qflx_snofrz_col + qflx_top_soil => cwf%qflx_top_soil + qflx_prec_grnd_col => pwf_a%qflx_prec_grnd + qflx_evap_grnd_col => pwf_a%qflx_evap_grnd + qflx_dew_grnd_col => pwf_a%qflx_dew_grnd + qflx_dew_snow_col => pwf_a%qflx_dew_snow + qflx_sub_snow_col => pwf_a%qflx_sub_snow + qflx_rain_grnd_col => pwf_a%qflx_rain_grnd + qflx_snow_grnd_col => pwf_a%qflx_snow_grnd + + ! Assign local pointers to derived type pft members + + pcolumn => pft%column + pgridcell => pft%gridcell + qflx_evap_soi => pwf%qflx_evap_soi + qflx_evap_tot => pwf%qflx_evap_tot + qflx_evap_grnd => pwf%qflx_evap_grnd + qflx_sub_snow => pwf%qflx_sub_snow + qflx_dew_snow => pwf%qflx_dew_snow + qflx_dew_grnd => pwf%qflx_dew_grnd + qflx_rain_grnd => pwf%qflx_rain_grnd + qflx_snow_grnd => pwf%qflx_snow_grnd + qflx_prec_grnd => pwf%qflx_prec_grnd + qflx_snwcp_ice => pwf%qflx_snwcp_ice + + ! Determine step size + + dtime = get_step_size() + + do fp = 1, num_lakep + p = filter_lakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + ! Snow on the lake ice + + qflx_evap_grnd(p) = 0._r8 + qflx_sub_snow(p) = 0._r8 + qflx_dew_snow(p) = 0._r8 + qflx_dew_grnd(p) = 0._r8 + + if (qflx_evap_soi(p) >= 0._r8) then + + ! Sublimation: do not allow for more sublimation than there is snow + ! after melt. Remaining surface evaporation used for infiltration. + + qflx_sub_snow(p) = min(qflx_evap_soi(p), h2osno(c)/dtime-qmelt(c)) + ! Liquid water evaporation from snow or "ground" is implicitly treated as a term in qrgwl + qflx_evap_grnd(p) = 0._r8 + + else + + if (t_grnd(c) < tfrz-0.1_r8) then + qflx_dew_snow(p) = abs(qflx_evap_soi(p)) + else + ! Liquid dew on snow or "ground" is implicitly treated as a term in qrgwl + qflx_dew_grnd(p) = 0._r8 + end if + + end if + + ! Update snow pack + + ! WJS (8-26-11): For consistency with non-lake columns, I am setting the values of + ! qflx_rain_grnd and qflx_snow_grnd dependent on do_capsnow. For qflx_snow_grnd, + ! this makes sense: as with non-lake columns, this gives the amount of snowfall + ! that is added to the snowpack as opposed to running off due to snow capping. For + ! qflx_rain_grnd, the definition over lakes is less well defined, since (I believe) + ! all rain runs off over lakes (and qflx_snwcp_liq is always 0 over + ! lakes). Nevertheless, I am trying to be consistent with the definition of + ! qflx_rain_grnd elsewhere, which is: the amount of rainfall reaching the ground, + ! but 0 if there is snow capping. + + if (do_capsnow(c)) then + qflx_rain_grnd(p) = 0._r8 + qflx_snow_grnd(p) = 0._r8 + h2osno(c) = h2osno(c) - (qmelt(c) + qflx_sub_snow(p))*dtime + qflx_snwcp_ice(p) = forc_snow(g) + qflx_dew_snow(p) + else + qflx_rain_grnd(p) = forc_rain(g) + qflx_snow_grnd(p) = forc_snow(g) + h2osno(c) = h2osno(c) + (forc_snow(g)-qmelt(c)-qflx_sub_snow(p)+qflx_dew_snow(p))*dtime + qflx_snwcp_ice(p) = 0._r8 + end if + h2osno(c) = max(h2osno(c), 0._r8) + + ! No snow if lake unfrozen + + if (t_grnd(c) > tfrz) h2osno(c) = 0._r8 + + ! Snow depth + + snowdp(c) = h2osno(c)/snow_bd !Assume a constant snow bulk density = 250. + + ! Determine ending water balance + + endwb(c) = h2osno(c) + + ! The following are needed for global average on history tape. + ! Note that components that are not displayed over lake on history tape + ! must be set to spval here + + eflx_snomelt(c) = qmelt(c)*hfus + qflx_infl(c) = 0._r8 + qflx_snomelt(c) = qmelt(c) + qflx_surf(c) = 0._r8 + qflx_drain(c) = 0._r8 + qflx_irrig(c) = 0._r8 + rootr_column(c,:) = spval + snowice(c) = spval + snowliq(c) = spval + soilalpha(c) = spval + zwt(c) = spval + fcov(c) = spval + fsat(c) = spval + qcharge(c) = spval + h2osoi_vol(c,:) = spval + h2osoi_ice(c,:) = spval + h2osoi_liq(c,:) = spval + qflx_snofrz_col(c) = spval + qflx_qrgwl(c) = forc_rain(g) + forc_snow(g) + qflx_floodg(g) - qflx_evap_tot(p) - qflx_snwcp_ice(p) - & + (endwb(c)-begwb(c))/dtime + qflx_floodc(c) = qflx_floodg(g) + qflx_runoff(c) = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c) + qflx_top_soil(c) = forc_rain(g) + qflx_snomelt(c) + qflx_prec_grnd(p) = forc_rain(g) + forc_snow(g) + + ! pft averages must be done here for output to history tape and other uses + ! (note that pft2col is called before HydrologyLake, so we can't use that routine + ! to do these column -> pft averages) + + qflx_evap_tot_col(c) = qflx_evap_tot(p) + qflx_prec_grnd_col(c) = qflx_prec_grnd(p) + qflx_evap_grnd_col(c) = qflx_evap_grnd(p) + qflx_dew_grnd_col(c) = qflx_dew_grnd(p) + qflx_dew_snow_col(c) = qflx_dew_snow(p) + qflx_sub_snow_col(c) = qflx_sub_snow(p) + qflx_rain_grnd_col(c) = qflx_rain_grnd(p) + qflx_snow_grnd_col(c) = qflx_snow_grnd(p) + qflx_snwcp_ice_col(c) = qflx_snwcp_ice(p) + + end do + + end subroutine HydrologyLake + +end module HydrologyLakeMod diff --git a/components/clm/src_clm40/biogeophys/QSatMod.F90 b/components/clm/src_clm40/biogeophys/QSatMod.F90 new file mode 100644 index 0000000000..8a9fa0829b --- /dev/null +++ b/components/clm/src_clm40/biogeophys/QSatMod.F90 @@ -0,0 +1,149 @@ + +module QSatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: QSatMod +! +! !DESCRIPTION: +! Computes saturation mixing ratio and the change in saturation +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: QSat +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: QSat +! +! !INTERFACE: + subroutine QSat (T, p, es, esdT, qs, qsdT) +! +! !DESCRIPTION: +! Computes saturation mixing ratio and the change in saturation +! mixing ratio with respect to temperature. +! Reference: Polynomial approximations from: +! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation +! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T ! temperature (K) + real(r8), intent(in) :: p ! surface atmospheric pressure (pa) + real(r8), intent(out) :: es ! vapor pressure (pa) + real(r8), intent(out) :: esdT ! d(es)/d(T) + real(r8), intent(out) :: qs ! humidity (kg/kg) + real(r8), intent(out) :: qsdT ! d(qs)/d(T) +! +! !CALLED FROM: +! subroutine Biogeophysics1 in module Biogeophysics1Mod +! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod +! subroutine CanopyFluxesMod CanopyFluxesMod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: T_limit + real(r8) :: td,vp,vp1,vp2 +! +! For water vapor (temperature range 0C-100C) +! + real(r8), parameter :: a0 = 6.11213476_r8 + real(r8), parameter :: a1 = 0.444007856_r8 + real(r8), parameter :: a2 = 0.143064234e-01_r8 + real(r8), parameter :: a3 = 0.264461437e-03_r8 + real(r8), parameter :: a4 = 0.305903558e-05_r8 + real(r8), parameter :: a5 = 0.196237241e-07_r8 + real(r8), parameter :: a6 = 0.892344772e-10_r8 + real(r8), parameter :: a7 = -0.373208410e-12_r8 + real(r8), parameter :: a8 = 0.209339997e-15_r8 +! +! For derivative:water vapor +! + real(r8), parameter :: b0 = 0.444017302_r8 + real(r8), parameter :: b1 = 0.286064092e-01_r8 + real(r8), parameter :: b2 = 0.794683137e-03_r8 + real(r8), parameter :: b3 = 0.121211669e-04_r8 + real(r8), parameter :: b4 = 0.103354611e-06_r8 + real(r8), parameter :: b5 = 0.404125005e-09_r8 + real(r8), parameter :: b6 = -0.788037859e-12_r8 + real(r8), parameter :: b7 = -0.114596802e-13_r8 + real(r8), parameter :: b8 = 0.381294516e-16_r8 +! +! For ice (temperature range -75C-0C) +! + real(r8), parameter :: c0 = 6.11123516_r8 + real(r8), parameter :: c1 = 0.503109514_r8 + real(r8), parameter :: c2 = 0.188369801e-01_r8 + real(r8), parameter :: c3 = 0.420547422e-03_r8 + real(r8), parameter :: c4 = 0.614396778e-05_r8 + real(r8), parameter :: c5 = 0.602780717e-07_r8 + real(r8), parameter :: c6 = 0.387940929e-09_r8 + real(r8), parameter :: c7 = 0.149436277e-11_r8 + real(r8), parameter :: c8 = 0.262655803e-14_r8 +! +! For derivative:ice +! + real(r8), parameter :: d0 = 0.503277922_r8 + real(r8), parameter :: d1 = 0.377289173e-01_r8 + real(r8), parameter :: d2 = 0.126801703e-02_r8 + real(r8), parameter :: d3 = 0.249468427e-04_r8 + real(r8), parameter :: d4 = 0.313703411e-06_r8 + real(r8), parameter :: d5 = 0.257180651e-08_r8 + real(r8), parameter :: d6 = 0.133268878e-10_r8 + real(r8), parameter :: d7 = 0.394116744e-13_r8 + real(r8), parameter :: d8 = 0.498070196e-16_r8 +!----------------------------------------------------------------------- + + T_limit = T - SHR_CONST_TKFRZ + if (T_limit > 100.0_r8) T_limit=100.0_r8 + if (T_limit < -75.0_r8) T_limit=-75.0_r8 + + td = T_limit + if (td >= 0.0_r8) then + es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else + es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + endif + + es = es * 100._r8 ! pa + esdT = esdT * 100._r8 ! pa/K + + vp = 1.0_r8 / (p - 0.378_r8*es) + vp1 = 0.622_r8 * vp + vp2 = vp1 * vp + + qs = es * vp1 ! kg/kg + qsdT = esdT * vp2 * p ! 1 / K + + end subroutine QSat + +end module QSatMod diff --git a/components/clm/src_clm40/biogeophys/SNICARMod.F90 b/components/clm/src_clm40/biogeophys/SNICARMod.F90 new file mode 100644 index 0000000000..3febfe7160 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SNICARMod.F90 @@ -0,0 +1,1494 @@ +module SNICARMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SNICARMod +! +! !DESCRIPTION: +! Calculate albedo of snow containing impurities +! and the evolution of snow effective radius +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use clm_varctl , only : iulog + use shr_const_mod , only : SHR_CONST_RHOICE + use abortutils , only : endrun + + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SNICAR_RT ! Snow albedo and vertically-resolved solar absorption + public :: SnowAge_grain ! Snow effective grain size evolution + public :: SnowAge_init ! Initial read in of snow-aging file + public :: SnowOptics_init ! Initial read in of snow-optics file +! +! !PUBLIC DATA MEMBERS: + + real(r8), public, parameter :: snw_rds_min = 54.526_r8 ! minimum allowed snow effective radius + ! (also "fresh snow" value) [microns] + integer, public, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack + ! (indices described above) [nbr] + logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC) + ! in snowpack radiative calculations + logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations + + real(r8), public, parameter :: scvng_fct_mlt_bcphi = 0.20_r8 ! scavenging factor for hydrophillic BC inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_bcpho = 0.03_r8 ! scavenging factor for hydrophobic BC inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_ocphi = 0.20_r8 ! scavenging factor for hydrophillic OC inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_ocpho = 0.03_r8 ! scavenging factor for hydrophobic OC inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst1 = 0.02_r8 ! scavenging factor for dust species 1 inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst2 = 0.02_r8 ! scavenging factor for dust species 2 inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst3 = 0.01_r8 ! scavenging factor for dust species 3 inclusion in meltwater + ! [frc] + real(r8), public, parameter :: scvng_fct_mlt_dst4 = 0.01_r8 ! scavenging factor for dust species 4 inclusion in meltwater + ! [frc] + +! !PRIVATE MEMBER FUNCTIONS: + +! +! !PRIVATE DATA MEMBERS: + ! Aerosol species indices: + ! 1= hydrophillic black carbon + ! 2= hydrophobic black carbon + ! 3= hydrophilic organic carbon + ! 4= hydrophobic organic carbon + ! 5= dust species 1 + ! 6= dust species 2 + ! 7= dust species 3 + ! 8= dust species 4 + integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr] + integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] + integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] + + integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] + integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] + integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx] + integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] + + integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns] + integer, parameter :: snw_rds_min_tbl = 30 ! minimium effective radius defined in Mie lookup table [microns] + real(r8), parameter :: snw_rds_max = 1500._r8 ! maximum allowed snow effective radius [microns] + real(r8), parameter :: snw_rds_refrz = 1000._r8 ! effective radius of re-frozen snow [microns] + + real(r8), parameter :: min_snw = 1.0E-30_r8 ! minimum snow mass required for SNICAR RT calculation [kg m-2] + + !real(r8), parameter :: C1_liq_Brun89 = 1.28E-17_r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89 + real(r8), parameter :: C1_liq_Brun89 = 0._r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89: zeroed to accomodate dry snow aging + real(r8), parameter :: C2_liq_Brun89 = 4.22E-13_r8 ! constant for liquid water grain growth [m3 s-1], + ! from Brun89: corrected for LWC in units of percent + + real(r8), parameter :: tim_cns_bc_rmv = 2.2E-8_r8 ! time constant for removal of BC in snow on sea-ice + ! [s-1] (50% mass removal/year) + real(r8), parameter :: tim_cns_oc_rmv = 2.2E-8_r8 ! time constant for removal of OC in snow on sea-ice + ! [s-1] (50% mass removal/year) + real(r8), parameter :: tim_cns_dst_rmv = 2.2E-8_r8 ! time constant for removal of dust in snow on sea-ice + ! [s-1] (50% mass removal/year) + + ! scaling of the snow aging rate (tuning option): + logical :: flg_snoage_scl = .false. ! flag for scaling the snow aging rate by some arbitrary factor + real(r8), parameter :: xdrdt = 1.0_r8 ! arbitrary factor applied to snow aging rate + + ! snow and aerosol Mie parameters: + ! (arrays declared here, but are set in iniTimeConst) + ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um)) + + ! direct-beam weighted ice optical properties + real(r8) :: ss_alb_snw_drc(idx_Mie_snw_mx,numrad_snw) + real(r8) :: asm_prm_snw_drc(idx_Mie_snw_mx,numrad_snw) + real(r8) :: ext_cff_mss_snw_drc(idx_Mie_snw_mx,numrad_snw) + + ! diffuse radiation weighted ice optical properties + real(r8) :: ss_alb_snw_dfs(idx_Mie_snw_mx,numrad_snw) + real(r8) :: asm_prm_snw_dfs(idx_Mie_snw_mx,numrad_snw) + real(r8) :: ext_cff_mss_snw_dfs(idx_Mie_snw_mx,numrad_snw) + + ! hydrophiliic BC + real(r8) :: ss_alb_bc1(numrad_snw) + real(r8) :: asm_prm_bc1(numrad_snw) + real(r8) :: ext_cff_mss_bc1(numrad_snw) + + ! hydrophobic BC + real(r8) :: ss_alb_bc2(numrad_snw) + real(r8) :: asm_prm_bc2(numrad_snw) + real(r8) :: ext_cff_mss_bc2(numrad_snw) + + ! hydrophobic OC + real(r8) :: ss_alb_oc1(numrad_snw) + real(r8) :: asm_prm_oc1(numrad_snw) + real(r8) :: ext_cff_mss_oc1(numrad_snw) + + ! hydrophilic OC + real(r8) :: ss_alb_oc2(numrad_snw) + real(r8) :: asm_prm_oc2(numrad_snw) + real(r8) :: ext_cff_mss_oc2(numrad_snw) + + ! dust species 1: + real(r8) :: ss_alb_dst1(numrad_snw) + real(r8) :: asm_prm_dst1(numrad_snw) + real(r8) :: ext_cff_mss_dst1(numrad_snw) + + ! dust species 2: + real(r8) :: ss_alb_dst2(numrad_snw) + real(r8) :: asm_prm_dst2(numrad_snw) + real(r8) :: ext_cff_mss_dst2(numrad_snw) + + ! dust species 3: + real(r8) :: ss_alb_dst3(numrad_snw) + real(r8) :: asm_prm_dst3(numrad_snw) + real(r8) :: ext_cff_mss_dst3(numrad_snw) + + ! dust species 4: + real(r8) :: ss_alb_dst4(numrad_snw) + real(r8) :: asm_prm_dst4(numrad_snw) + real(r8) :: ext_cff_mss_dst4(numrad_snw) + + ! best-fit parameters for snow aging defined over: + ! 11 temperatures from 225 to 273 K + ! 31 temperature gradients from 0 to 300 K/m + ! 8 snow densities from 0 to 350 kg/m3 + ! (arrays declared here, but are set in iniTimeConst) + real(r8), pointer :: snowage_tau(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) + real(r8), pointer :: snowage_kappa(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) + real(r8), pointer :: snowage_drdt0(:,:,:) ! idx_rhos_max,idx_Tgrd_max,idx_T_max) + +! +! !REVISION HISTORY: +! Created by Mark Flanner +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SNICAR_RT +! +! +! !CALLED FROM: +! subroutine SurfaceAlbedo in module SurfaceAlbedoMod (CLM) +! subroutine albice (CSIM) +! +! !REVISION HISTORY: +! Author: Mark Flanner +! +! !INTERFACE: + + subroutine SNICAR_RT (flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen, flg_slr_in, h2osno_liq, h2osno_ice, snw_rds, & + mss_cnc_aer_in, albsfc, albout, flx_abs) + + ! + ! !DESCRIPTION: + ! Determine reflectance of, and vertically-resolved solar absorption in, + ! snow with impurities. + ! + ! Original references on physical models of snow reflectance include: + ! Wiscombe and Warren [1980] and Warren and Wiscombe [1980], + ! Journal of Atmospheric Sciences, 37, + ! + ! The multi-layer solution for multiple-scattering used here is from: + ! Toon et al. [1989], Rapid calculation of radiative heating rates + ! and photodissociation rates in inhomogeneous multiple scattering atmospheres, + ! J. Geophys. Res., 94, D13, 16287-16301 + ! + ! The implementation of the SNICAR model in CLM/CSIM is described in: + ! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], + ! Present-day climate forcing and response from black carbon in snow, + ! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 + + + ! !USES: + use clmtype + use clm_varpar , only : nlevsno, numrad + use clm_time_manager , only : get_nstep + use shr_const_mod , only : SHR_CONST_PI + + + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: flg_snw_ice ! flag: =1 when called from CLM, =2 when called from CSIM + integer , intent(in) :: lbc, ubc ! column index bounds [unitless] + integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter + integer , intent(in) :: filter_nourbanc(ubc-lbc+1) ! column filter for non-urban points + real(r8), intent(in) :: coszen(lbc:ubc) ! cosine of solar zenith angle for next time step + ! (col) [unitless] + integer , intent(in) :: flg_slr_in ! flag: =1 for direct-beam incident flux, + ! =2 for diffuse incident flux + real(r8), intent(in) :: h2osno_liq(lbc:ubc,-nlevsno+1:0) ! liquid water content (col,lyr) [kg/m2] + real(r8), intent(in) :: h2osno_ice(lbc:ubc,-nlevsno+1:0) ! ice content (col,lyr) [kg/m2] + integer, intent(in) :: snw_rds(lbc:ubc,-nlevsno+1:0) ! snow effective radius (col,lyr) [microns, m^-6] + real(r8), intent(in) :: mss_cnc_aer_in(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species + ! (col,lyr,aer) [kg/kg] + real(r8), intent(in) :: albsfc(lbc:ubc,numrad) ! albedo of surface underlying snow + ! (col,bnd) [frc] + real(r8), intent(out) :: albout(lbc:ubc,numrad) ! snow albedo, averaged into 2 bands + ! (=0 if no sun or no snow) (col,bnd) [frc] + real(r8), intent(out) :: flx_abs(lbc:ubc,-nlevsno+1:1,numrad) ! absorbed flux in each layer per unit flux incident + ! on top of snowpack (col,lyr,bnd) [frc] + + ! + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit in arguments + ! + integer, pointer :: snl(:) ! negative number of snow layers (col) [nbr] + real(r8), pointer :: h2osno(:) ! snow liquid water equivalent (col) [kg/m2] + integer, pointer :: clandunit(:) ! corresponding landunit of column (col) [idx] (debugging only) + integer, pointer :: cgridcell(:) ! columns's gridcell index (col) [idx] (debugging only) + integer, pointer :: ltype(:) ! landunit type (lnd) (debugging only) + real(r8), pointer :: londeg(:) ! longitude (degrees) (debugging only) + real(r8), pointer :: latdeg(:) ! latitude (degrees) (debugging only) +! +! !OTHER LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + ! + ! variables for snow radiative transfer calculations + + ! Local variables representing single-column values of arrays: + integer :: snl_lcl ! negative number of snow layers [nbr] + integer :: snw_rds_lcl(-nlevsno+1:0) ! snow effective radius [m^-6] + real(r8):: flx_slrd_lcl(1:numrad_snw) ! direct beam incident irradiance [W/m2] (set to 1) + real(r8):: flx_slri_lcl(1:numrad_snw) ! diffuse incident irradiance [W/m2] (set to 1) + real(r8):: mss_cnc_aer_lcl(-nlevsno+1:0,1:sno_nbr_aer) ! aerosol mass concentration (lyr,aer_nbr) [kg/kg] + real(r8):: h2osno_lcl ! total column snow mass [kg/m2] + real(r8):: h2osno_liq_lcl(-nlevsno+1:0) ! liquid water mass [kg/m2] + real(r8):: h2osno_ice_lcl(-nlevsno+1:0) ! ice mass [kg/m2] + real(r8):: albsfc_lcl(1:numrad_snw) ! albedo of underlying surface [frc] + real(r8):: ss_alb_snw_lcl(-nlevsno+1:0) ! single-scatter albedo of ice grains (lyr) [frc] + real(r8):: asm_prm_snw_lcl(-nlevsno+1:0) ! asymmetry parameter of ice grains (lyr) [frc] + real(r8):: ext_cff_mss_snw_lcl(-nlevsno+1:0) ! mass extinction coefficient of ice grains (lyr) [m2/kg] + real(r8):: ss_alb_aer_lcl(sno_nbr_aer) ! single-scatter albedo of aerosol species (aer_nbr) [frc] + real(r8):: asm_prm_aer_lcl(sno_nbr_aer) ! asymmetry parameter of aerosol species (aer_nbr) [frc] + real(r8):: ext_cff_mss_aer_lcl(sno_nbr_aer) ! mass extinction coefficient of aerosol species (aer_nbr) [m2/kg] + + + ! Other local variables + integer :: APRX_TYP ! two-stream approximation type + ! (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr] + integer :: DELTA ! flag to use Delta approximation (Joseph, 1976) + ! (1= use, 0= don't use) + real(r8):: flx_wgt(1:numrad_snw) ! weights applied to spectral bands, + ! specific to direct and diffuse cases (bnd) [frc] + + integer :: flg_nosnl ! flag: =1 if there is snow, but zero snow layers, + ! =0 if at least 1 snow layer [flg] + integer :: trip ! flag: =1 to redo RT calculation if result is unrealistic + integer :: flg_dover ! defines conditions for RT redo (explained below) + + real(r8):: albedo ! temporary snow albedo [frc] + real(r8):: flx_sum ! temporary summation variable for NIR weighting + real(r8):: albout_lcl(numrad_snw) ! snow albedo by band [frc] + real(r8):: flx_abs_lcl(-nlevsno+1:1,numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc] + + real(r8):: L_snw(-nlevsno+1:0) ! h2o mass (liquid+solid) in snow layer (lyr) [kg/m2] + real(r8):: tau_snw(-nlevsno+1:0) ! snow optical depth (lyr) [unitless] + real(r8):: L_aer(-nlevsno+1:0,sno_nbr_aer) ! aerosol mass in snow layer (lyr,nbr_aer) [kg/m2] + real(r8):: tau_aer(-nlevsno+1:0,sno_nbr_aer) ! aerosol optical depth (lyr,nbr_aer) [unitless] + real(r8):: tau_sum ! cumulative (snow+aerosol) optical depth [unitless] + real(r8):: tau_clm(-nlevsno+1:0) ! column optical depth from layer bottom to snowpack top (lyr) [unitless] + real(r8):: omega_sum ! temporary summation of single-scatter albedo of all aerosols [frc] + real(r8):: g_sum ! temporary summation of asymmetry parameter of all aerosols [frc] + + real(r8):: tau(-nlevsno+1:0) ! weighted optical depth of snow+aerosol layer (lyr) [unitless] + real(r8):: omega(-nlevsno+1:0) ! weighted single-scatter albedo of snow+aerosol layer (lyr) [frc] + real(r8):: g(-nlevsno+1:0) ! weighted asymmetry parameter of snow+aerosol layer (lyr) [frc] + real(r8):: tau_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) optical depth of snow+aerosol layer + ! (lyr) [unitless] + real(r8):: omega_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) SSA of snow+aerosol layer (lyr) [frc] + real(r8):: g_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) asymmetry paramater of snow+aerosol layer + ! (lyr) [frc] + + integer :: nstep ! current timestep [nbr] (debugging only) + integer :: g_idx, c_idx, l_idx ! gridcell, column, and landunit indices [idx] + integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= numrad_snw) [idx] + integer :: rds_idx ! snow effective radius index for retrieving + ! Mie parameters from lookup table [idx] + integer :: snl_btm ! index of bottom snow layer (0) [idx] + integer :: snl_top ! index of top snow layer (-4 to 0) [idx] + integer :: fc ! column filter index + integer :: i ! layer index [idx] + integer :: j ! aerosol number index [idx] + integer :: n ! tridiagonal matrix index [idx] + integer :: m ! secondary layer index [idx] + + real(r8):: F_direct(-nlevsno+1:0) ! direct-beam radiation at bottom of layer interface (lyr) [W/m^2] + real(r8):: F_net(-nlevsno+1:0) ! net radiative flux at bottom of layer interface (lyr) [W/m^2] + real(r8):: F_abs(-nlevsno+1:0) ! net absorbed radiative energy (lyr) [W/m^2] + real(r8):: F_abs_sum ! total absorbed energy in column [W/m^2] + real(r8):: F_sfc_pls ! upward radiative flux at snowpack top [W/m^2] + real(r8):: F_btm_net ! net flux at bottom of snowpack [W/m^2] + real(r8):: F_sfc_net ! net flux at top of snowpack [W/m^2] + real(r8):: energy_sum ! sum of all energy terms; should be 0.0 [W/m^2] + real(r8):: F_direct_btm ! direct-beam radiation at bottom of snowpack [W/m^2] + real(r8):: mu_not ! cosine of solar zenith angle (used locally) [frc] + + integer :: err_idx ! counter for number of times through error loop [nbr] + real(r8):: lat_coord ! gridcell latitude (debugging only) + real(r8):: lon_coord ! gridcell longitude (debugging only) + integer :: sfctype ! underlying surface type (debugging only) + real(r8):: pi ! 3.1415... + + + ! intermediate variables for radiative transfer approximation: + real(r8):: gamma1(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma2(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma3(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: gamma4(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: lambda(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: GAMMA(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: mu_one ! two-stream coefficient from Toon et al. (lyr) [unitless] + real(r8):: e1(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e2(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e3(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: e4(-nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (lyr) + real(r8):: C_pls_btm(-nlevsno+1:0) ! intermediate variable: upward flux at bottom interface (lyr) [W/m2] + real(r8):: C_mns_btm(-nlevsno+1:0) ! intermediate variable: downward flux at bottom interface (lyr) [W/m2] + real(r8):: C_pls_top(-nlevsno+1:0) ! intermediate variable: upward flux at top interface (lyr) [W/m2] + real(r8):: C_mns_top(-nlevsno+1:0) ! intermediate variable: downward flux at top interface (lyr) [W/m2] + real(r8):: A(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: B(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: D(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: E(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: AS(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: DS(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: X(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + real(r8):: Y(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + + + ! Assign local pointers to derived subtypes components (column-level) + ! (CLM-specific) + if (flg_snw_ice == 1) then + snl => cps%snl + h2osno => cws%h2osno + clandunit => col%landunit ! (debug only) + cgridcell => col%gridcell ! (debug only) + ltype => lun%itype ! (debug only) + londeg => grc%londeg ! (debug only) + latdeg => grc%latdeg ! (debug only) + endif + + + ! Define constants + pi = SHR_CONST_PI + + ! always use Delta approximation for snow + DELTA = 1 + + ! Get current timestep + nstep = get_nstep() + + ! Loop over all non-urban columns + ! (when called from CSIM, there is only one column) + do fc = 1,num_nourbanc + c_idx = filter_nourbanc(fc) + + + ! Zero absorbed radiative fluxes: + do i=-nlevsno+1,1,1 + flx_abs_lcl(:,:) = 0._r8 + flx_abs(c_idx,i,:) = 0._r8 + enddo + + ! set snow/ice mass to be used for RT: + if (flg_snw_ice == 1) then + h2osno_lcl = h2osno(c_idx) + else + h2osno_lcl = h2osno_ice(c_idx,0) + endif + + + ! Qualifier for computing snow RT: + ! 1) sunlight from atmosphere model + ! 2) minimum amount of snow on ground. + ! Otherwise, set snow albedo to zero + if ((coszen(c_idx) > 0._r8) .and. (h2osno_lcl > min_snw)) then + + ! Set variables specific to CLM + if (flg_snw_ice == 1) then + ! Assign local (single-column) variables to global values + ! If there is snow, but zero snow layers, we must create a layer locally. + ! This layer is presumed to have the fresh snow effective radius. + if (snl(c_idx) > -1) then + flg_nosnl = 1 + snl_lcl = -1 + h2osno_ice_lcl(0) = h2osno_lcl + h2osno_liq_lcl(0) = 0._r8 + snw_rds_lcl(0) = nint(snw_rds_min) + else + flg_nosnl = 0 + snl_lcl = snl(c_idx) + h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) + h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) + snw_rds_lcl(:) = snw_rds(c_idx,:) + endif + + snl_btm = 0 + snl_top = snl_lcl+1 + + ! for debugging only + l_idx = clandunit(c_idx) + g_idx = cgridcell(c_idx) + sfctype = ltype(l_idx) + lat_coord = latdeg(g_idx) + lon_coord = londeg(g_idx) + + + ! Set variables specific to CSIM + else + flg_nosnl = 0 + snl_lcl = -1 + h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) + h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) + snw_rds_lcl(:) = snw_rds(c_idx,:) + snl_btm = 0 + snl_top = 0 + sfctype = -1 + lat_coord = -90 + lon_coord = 0 + endif + + ! Set local aerosol array + do j=1,sno_nbr_aer + mss_cnc_aer_lcl(:,j) = mss_cnc_aer_in(c_idx,:,j) + enddo + + + ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos + albsfc_lcl(1) = albsfc(c_idx,1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) + + + ! Error check for snow grain size: + do i=snl_top,snl_btm,1 + if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then + write (iulog,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds." + write (iulog,*) "NSTEP= ", nstep + write (iulog,*) "flg_snw_ice= ", flg_snw_ice + write (iulog,*) "column: ", c_idx, " level: ", i, " snl(c)= ", snl_lcl + write (iulog,*) "lat= ", lat_coord, " lon= ", lon_coord + write (iulog,*) "h2osno(c)= ", h2osno_lcl + call endrun() + endif + enddo + + ! Incident flux weighting parameters + ! - sum of all VIS bands must equal 1 + ! - sum of all NIR bands must equal 1 + ! + ! Spectral bands (5-band case) + ! Band 1: 0.3-0.7um (VIS) + ! Band 2: 0.7-1.0um (NIR) + ! Band 3: 1.0-1.2um (NIR) + ! Band 4: 1.2-1.5um (NIR) + ! Band 5: 1.5-5.0um (NIR) + ! + ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere + ! + ! 3-band weights + if (numrad_snw==3) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.66628670195247_r8 + flx_wgt(3) = 0.33371329804753_r8 + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.77887652162877_r8 + flx_wgt(3) = 0.22112347837123_r8 + endif + + ! 5-band weights + elseif(numrad_snw==5) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.49352158521175_r8 + flx_wgt(3) = 0.18099494230665_r8 + flx_wgt(4) = 0.12094898498813_r8 + flx_wgt(5) = 0.20453448749347_r8 + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1) = 1._r8 + flx_wgt(2) = 0.58581507618433_r8 + flx_wgt(3) = 0.20156903770812_r8 + flx_wgt(4) = 0.10917889346386_r8 + flx_wgt(5) = 0.10343699264369_r8 + endif + endif + + ! Loop over snow spectral bands + do bnd_idx = 1,numrad_snw + + mu_not = coszen(c_idx) ! must set here, because of error handling + flg_dover = 1 ! default is to redo + err_idx = 0 ! number of times through loop + + do while (flg_dover > 0) + + ! DEFAULT APPROXIMATIONS: + ! VIS: Delta-Eddington + ! NIR (all): Delta-Hemispheric Mean + ! WARNING: DO NOT USE DELTA-EDDINGTON FOR NIR DIFFUSE - this sometimes results in negative albedo + ! + ! ERROR CONDITIONS: + ! Conditions which cause "trip", resulting in redo of RT approximation: + ! 1. negative absorbed flux + ! 2. total absorbed flux greater than incident flux + ! 3. negative albedo + ! NOTE: These errors have only been encountered in spectral bands 4 and 5 + ! + ! ERROR HANDLING + ! 1st error (flg_dover=2): switch approximation (Edd->HM or HM->Edd) + ! 2nd error (flg_dover=3): change zenith angle by 0.02 (this happens about 1 in 10^6 cases) + ! 3rd error (flg_dover=4): switch approximation with new zenith + ! Subsequent errors: repeatedly change zenith and approximations... + + if (bnd_idx == 1) then + if (flg_dover == 2) then + APRX_TYP = 3 + elseif (flg_dover == 3) then + APRX_TYP = 1 + if (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + endif + elseif (flg_dover == 4) then + APRX_TYP = 3 + else + APRX_TYP = 1 + endif + + else + if (flg_dover == 2) then + APRX_TYP = 1 + elseif (flg_dover == 3) then + APRX_TYP = 3 + if (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + endif + elseif (flg_dover == 4) then + APRX_TYP = 1 + else + APRX_TYP = 3 + endif + + endif + + ! Set direct or diffuse incident irradiance to 1 + ! (This has to be within the bnd loop because mu_not is adjusted in rare cases) + if (flg_slr_in == 1) then + flx_slrd_lcl(bnd_idx) = 1._r8/(mu_not*pi) ! this corresponds to incident irradiance of 1.0 + flx_slri_lcl(bnd_idx) = 0._r8 + else + flx_slrd_lcl(bnd_idx) = 0._r8 + flx_slri_lcl(bnd_idx) = 1._r8 + endif + + ! Pre-emptive error handling: aerosols can reap havoc on these absorptive bands. + ! Since extremely high soot concentrations have a negligible effect on these bands, zero them. + if ( (numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then + mss_cnc_aer_lcl(:,:) = 0._r8 + endif + + if ( (numrad_snw == 3).and.(bnd_idx == 3) ) then + mss_cnc_aer_lcl(:,:) = 0._r8 + endif + + ! Define local Mie parameters based on snow grain size and aerosol species, + ! retrieved from a lookup table. + if (flg_slr_in == 1) then + do i=snl_top,snl_btm,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (direct radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_drc(rds_idx,bnd_idx) + asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,bnd_idx) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_drc(rds_idx,bnd_idx) + enddo + elseif (flg_slr_in == 2) then + do i=snl_top,snl_btm,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (diffuse radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_dfs(rds_idx,bnd_idx) + asm_prm_snw_lcl(i) = asm_prm_snw_dfs(rds_idx,bnd_idx) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_dfs(rds_idx,bnd_idx) + enddo + endif + + ! aerosol species 1 optical properties + ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + + ! aerosol species 2 optical properties + ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) + asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) + ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) + + ! aerosol species 3 optical properties + ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) + asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) + ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) + + ! aerosol species 4 optical properties + ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) + asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) + ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) + + ! aerosol species 5 optical properties + ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) + asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) + ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) + + ! aerosol species 6 optical properties + ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) + asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) + ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) + + ! aerosol species 7 optical properties + ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) + asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) + ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) + + ! aerosol species 8 optical properties + ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) + asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) + ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) + + + ! 1. snow and aerosol layer column mass (L_snw, L_aer [kg/m^2]) + ! 2. optical Depths (tau_snw, tau_aer) + ! 3. weighted Mie properties (tau, omega, g) + + ! Weighted Mie parameters of each layer + do i=snl_top,snl_btm,1 + L_snw(i) = h2osno_ice_lcl(i)+h2osno_liq_lcl(i) + tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i) + + do j=1,sno_nbr_aer + L_aer(i,j) = L_snw(i)*mss_cnc_aer_lcl(i,j) + tau_aer(i,j) = L_aer(i,j)*ext_cff_mss_aer_lcl(j) + enddo + + tau_sum = 0._r8 + omega_sum = 0._r8 + g_sum = 0._r8 + + do j=1,sno_nbr_aer + tau_sum = tau_sum + tau_aer(i,j) + omega_sum = omega_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)) + g_sum = g_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)*asm_prm_aer_lcl(j)) + enddo + + tau(i) = tau_sum + tau_snw(i) + omega(i) = (1/tau(i))*(omega_sum+(ss_alb_snw_lcl(i)*tau_snw(i))) + g(i) = (1/(tau(i)*omega(i)))*(g_sum+ (asm_prm_snw_lcl(i)*ss_alb_snw_lcl(i)*tau_snw(i))) + enddo + + ! DELTA transformations, if requested + if (DELTA == 1) then + do i=snl_top,snl_btm,1 + g_star(i) = g(i)/(1+g(i)) + omega_star(i) = ((1-(g(i)**2))*omega(i)) / (1-(omega(i)*(g(i)**2))) + tau_star(i) = (1-(omega(i)*(g(i)**2)))*tau(i) + enddo + else + do i=snl_top,snl_btm,1 + g_star(i) = g(i) + omega_star(i) = omega(i) + tau_star(i) = tau(i) + enddo + endif + + ! Total column optical depth: + ! tau_clm(i) = total optical depth above the bottom of layer i + tau_clm(snl_top) = 0._r8 + do i=snl_top+1,snl_btm,1 + tau_clm(i) = tau_clm(i-1)+tau_star(i-1) + enddo + + ! Direct radiation at bottom of snowpack: + F_direct_btm = albsfc_lcl(bnd_idx)*mu_not*exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx) + + ! Intermediates + ! Gamma values are approximation-specific. + + ! Eddington + if (APRX_TYP==1) then + do i=snl_top,snl_btm,1 + gamma1(i) = (7-(omega_star(i)*(4+(3*g_star(i)))))/4 + gamma2(i) = -(1-(omega_star(i)*(4-(3*g_star(i)))))/4 + gamma3(i) = (2-(3*g_star(i)*mu_not))/4 + gamma4(i) = 1-gamma3(i) + mu_one = 0.5 + enddo + + ! Quadrature + elseif (APRX_TYP==2) then + do i=snl_top,snl_btm,1 + gamma1(i) = (3**0.5)*(2-(omega_star(i)*(1+g_star(i))))/2 + gamma2(i) = omega_star(i)*(3**0.5)*(1-g_star(i))/2 + gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2 + gamma4(i) = 1-gamma3(i) + mu_one = 1/(3**0.5) + enddo + + ! Hemispheric Mean + elseif (APRX_TYP==3) then + do i=snl_top,snl_btm,1 + gamma1(i) = 2 - (omega_star(i)*(1+g_star(i))) + gamma2(i) = omega_star(i)*(1-g_star(i)) + gamma3(i) = (1-((3**0.5)*g_star(i)*mu_not))/2 + gamma4(i) = 1-gamma3(i) + mu_one = 0.5 + enddo + endif + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,1 + lambda(i) = sqrt(abs((gamma1(i)**2) - (gamma2(i)**2))) + GAMMA(i) = gamma2(i)/(gamma1(i)+lambda(i)) + + e1(i) = 1+(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e2(i) = 1-(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e3(i) = GAMMA(i) + exp(-lambda(i)*tau_star(i)) + e4(i) = GAMMA(i) - exp(-lambda(i)*tau_star(i)) + enddo !enddo over snow layers + + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,1 + if (flg_slr_in == 1) then + + C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)-(1/mu_not))*gamma3(i))+ & + (gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_mns_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)+(1/mu_not))*gamma4(i))+ & + (gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_pls_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)-(1/mu_not))* & + gamma3(i))+(gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + C_mns_top(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)+(1/mu_not))* & + gamma4(i))+(gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + else + C_pls_btm(i) = 0._r8 + C_mns_btm(i) = 0._r8 + C_pls_top(i) = 0._r8 + C_mns_top(i) = 0._r8 + endif + enddo + + ! Coefficients for tridiaganol matrix solution + do i=2*snl_lcl+1,0,1 + + !Boundary values for i=1 and i=2*snl_lcl, specifics for i=odd and i=even + if (i==(2*snl_lcl+1)) then + A(i) = 0 + B(i) = e1(snl_top) + D(i) = -e2(snl_top) + E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top) + + elseif(i==0) then + A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm)) + B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm)) + D(i) = 0 + E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm)) + + elseif(mod(i,2)==-1) then ! If odd and i>=3 (n=1 for i=3) + n=floor(i/2.0) + A(i) = (e2(n)*e3(n))-(e4(n)*e1(n)) + B(i) = (e1(n)*e1(n+1))-(e3(n)*e3(n+1)) + D(i) = (e3(n)*e4(n+1))-(e1(n)*e2(n+1)) + E(i) = (e3(n)*(C_pls_top(n+1)-C_pls_btm(n)))+(e1(n)*(C_mns_btm(n)-C_mns_top(n+1))) + + elseif(mod(i,2)==0) then ! If even and i<=2*snl_lcl + n=(i/2) + A(i) = (e2(n+1)*e1(n))-(e3(n)*e4(n+1)) + B(i) = (e2(n)*e2(n+1))-(e4(n)*e4(n+1)) + D(i) = (e1(n+1)*e4(n+1))-(e2(n+1)*e3(n+1)) + E(i) = (e2(n+1)*(C_pls_top(n+1)-C_pls_btm(n)))+(e4(n+1)*(C_mns_top(n+1)-C_mns_btm(n))) + endif + enddo + + AS(0) = A(0)/B(0) + DS(0) = E(0)/B(0) + + do i=-1,(2*snl_lcl+1),-1 + X(i) = 1/(B(i)-(D(i)*AS(i+1))) + AS(i) = A(i)*X(i) + DS(i) = (E(i)-(D(i)*DS(i+1)))*X(i) + enddo + + Y(2*snl_lcl+1) = DS(2*snl_lcl+1) + do i=(2*snl_lcl+2),0,1 + Y(i) = DS(i)-(AS(i)*Y(i-1)) + enddo + + ! Downward direct-beam and net flux (F_net) at the base of each layer: + do i=snl_top,snl_btm,1 + F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*exp(-(tau_clm(i)+tau_star(i))/mu_not) + F_net(i) = (Y(2*i-1)*(e1(i)-e3(i))) + (Y(2*i)*(e2(i)-e4(i))) + & + C_pls_btm(i) - C_mns_btm(i) - F_direct(i) + enddo + + ! Upward flux at snowpack top: + F_sfc_pls = (Y(2*snl_lcl+1)*(exp(-lambda(snl_top)*tau_star(snl_top))+ & + GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* & + tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top) + + ! Net flux at bottom = absorbed radiation by underlying surface: + F_btm_net = -F_net(snl_btm) + + + ! Bulk column albedo and surface net flux + albedo = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + + trip = 0 + ! Absorbed flux in each layer + do i=snl_top,snl_btm,1 + if(i==snl_top) then + F_abs(i) = F_net(i)-F_sfc_net + else + F_abs(i) = F_net(i)-F_net(i-1) + endif + flx_abs_lcl(i,bnd_idx) = F_abs(i) + + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,bnd_idx) < -0.00001) then + trip = 1 + endif + enddo + + flx_abs_lcl(1,bnd_idx) = F_btm_net + + if (flg_nosnl == 1) then + ! If there are no snow layers (but still snow), all absorbed energy must be in top soil layer + !flx_abs_lcl(:,bnd_idx) = 0._r8 + !flx_abs_lcl(1,bnd_idx) = F_abs(0) + F_btm_net + + ! changed on 20070408: + ! OK to put absorbed energy in the fictitous snow layer because routine SurfaceRadiation + ! handles the case of no snow layers. Then, if a snow layer is addded between now and + ! SurfaceRadiation (called in Hydrology1), absorbed energy will be properly distributed. + flx_abs_lcl(0,bnd_idx) = F_abs(0) + flx_abs_lcl(1,bnd_idx) = F_btm_net + endif + + !Underflow check (we've already tripped the error condition above) + do i=snl_top,1,1 + if (flx_abs_lcl(i,bnd_idx) < 0._r8) then + flx_abs_lcl(i,bnd_idx) = 0._r8 + endif + enddo + + F_abs_sum = 0._r8 + do i=snl_top,snl_btm,1 + F_abs_sum = F_abs_sum + F_abs(i) + enddo + + + !ERROR check: absorption greater than incident flux + ! (should make condition more generic than "1._r8") + if (F_abs_sum > 1._r8) then + trip = 1 + endif + + !ERROR check: + if ((albedo < 0._r8).and.(trip==0)) then + trip = 1 + endif + + ! Set conditions for redoing RT calculation + if ((trip == 1).and.(flg_dover == 1)) then + flg_dover = 2 + elseif ((trip == 1).and.(flg_dover == 2)) then + flg_dover = 3 + elseif ((trip == 1).and.(flg_dover == 3)) then + flg_dover = 4 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx < 20)) then + flg_dover = 3 + err_idx = err_idx + 1 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx >= 20)) then + flg_dover = 0 + write(iulog,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice + write(iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) + write(iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + write(iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write(iulog,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) + write(iulog,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) + write(iulog,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) + write(iulog,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) + write(iulog,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) + write(iulog,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) + + call endrun() + else + flg_dover = 0 + endif + + enddo !enddo while (flg_dover > 0) + + ! Energy conservation check: + ! Incident direct+diffuse radiation equals (absorbed+bulk_transmitted+bulk_reflected) + energy_sum = (mu_not*pi*flx_slrd_lcl(bnd_idx)) + flx_slri_lcl(bnd_idx) - (F_abs_sum + F_btm_net + F_sfc_pls) + if (abs(energy_sum) > 0.00001_r8) then + write (iulog,"(a,e12.6,a,i6,a,i6)") "SNICAR ERROR: Energy conservation error of : ", energy_sum, & + " at timestep: ", nstep, " at column: ", c_idx + call endrun() + endif + + albout_lcl(bnd_idx) = albedo + + + ! Check that albedo is less than 1 + if (albout_lcl(bnd_idx) > 1.0) then + + write (iulog,*) "SNICAR ERROR: Albedo > 1.0 at c: ", c_idx, " NSTEP= ",nstep + write (iulog,*) "SNICAR STATS: bnd_idx= ",bnd_idx + write (iulog,*) "SNICAR STATS: albout_lcl(bnd)= ",albout_lcl(bnd_idx), " albsfc_lcl(bnd_idx)= ",albsfc_lcl(bnd_idx) + write (iulog,*) "SNICAR STATS: landtype= ", sfctype + write (iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write (iulog,*) "SNICAR STATS: coszen= ", coszen(c_idx), " flg_slr= ", flg_slr_in + + write (iulog,*) "SNICAR STATS: soot(-4)= ", mss_cnc_aer_lcl(-4,1) + write (iulog,*) "SNICAR STATS: soot(-3)= ", mss_cnc_aer_lcl(-3,1) + write (iulog,*) "SNICAR STATS: soot(-2)= ", mss_cnc_aer_lcl(-2,1) + write (iulog,*) "SNICAR STATS: soot(-1)= ", mss_cnc_aer_lcl(-1,1) + write (iulog,*) "SNICAR STATS: soot(0)= ", mss_cnc_aer_lcl(0,1) + + write (iulog,*) "SNICAR STATS: L_snw(-4)= ", L_snw(-4) + write (iulog,*) "SNICAR STATS: L_snw(-3)= ", L_snw(-3) + write (iulog,*) "SNICAR STATS: L_snw(-2)= ", L_snw(-2) + write (iulog,*) "SNICAR STATS: L_snw(-1)= ", L_snw(-1) + write (iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + + write (iulog,*) "SNICAR STATS: snw_rds(-4)= ", snw_rds(c_idx,-4) + write (iulog,*) "SNICAR STATS: snw_rds(-3)= ", snw_rds(c_idx,-3) + write (iulog,*) "SNICAR STATS: snw_rds(-2)= ", snw_rds(c_idx,-2) + write (iulog,*) "SNICAR STATS: snw_rds(-1)= ", snw_rds(c_idx,-1) + write (iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) + + call endrun() + endif + + enddo ! loop over wvl bands + + + ! Weight output NIR albedo appropriately + albout(c_idx,1) = albout_lcl(1) + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) + end do + albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + + ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately + flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) + do i=snl_top,1,1 + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) + enddo + flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end do + + ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo + elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then + albout(c_idx,1) = albsfc(c_idx,1) + albout(c_idx,2) = albsfc(c_idx,2) + + ! There is either zero snow, or no sun + else + albout(c_idx,1) = 0._r8 + albout(c_idx,2) = 0._r8 + endif ! if column has snow and coszen > 0 + + enddo ! loop over all columns + + + end subroutine SNICAR_RT + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SnowAge_grain +! +! !INTERFACE: + subroutine SnowAge_grain(lbc, ubc, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + ! + ! !DESCRIPTION: + ! Updates the snow effective grain size (radius). + ! Contributions to grain size evolution are from: + ! 1. vapor redistribution (dry snow) + ! 2. liquid water redistribution (wet snow) + ! 3. re-freezing of liquid water + ! + ! Vapor redistribution: Method is to retrieve 3 best-bit parameters that + ! depend on snow temperature, temperature gradient, and density, + ! that are derived from the microphysical model described in: + ! Flanner and Zender (2006), Linking snowpack microphysics and albedo + ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. + ! The parametric equation has the form: + ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where: + ! r is the effective radius, + ! tau and kappa are best-fit parameters, + ! drdt_0 is the initial rate of change of effective radius, and + ! dr_fresh is the difference between the current and fresh snow states + ! (r_current - r_fresh). + ! + ! Liquid water redistribution: Apply the grain growth function from: + ! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of + ! liquid-water content, Annals of Glaciology, 13, 22-26. + ! There are two parameters that describe the grain growth rate as + ! a function of snow liquid water content (LWC). The "LWC=0" parameter + ! is zeroed here because we are accounting for dry snowing with a + ! different representation + ! + ! Re-freezing of liquid water: Assume that re-frozen liquid water clumps + ! into an arbitrarily large effective grain size (snw_rds_refrz). + ! The phenomenon is observed (Grenfell), but so far unquantified, as far as + ! I am aware. + ! + ! + ! !USES: + use clmtype + use clm_time_manager , only : get_step_size, get_nstep + use clm_varpar , only : nlevsno + use clm_varcon , only : spval + use abortutils , only : endrun + use shr_const_mod , only : SHR_CONST_RHOICE, SHR_CONST_PI + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_snowc ! number of column snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(in) :: num_nosnowc ! number of column non-snow points in column filter + integer, intent(in) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points + ! + ! + ! !CALLED FROM: clm_driver1 + ! + + ! !LOCAL VARIABLES: + ! + ! local pointers to implicit arguments + ! + + real(r8), pointer :: t_soisno(:,:) ! soil and snow temperature (col,lyr) [K] + integer, pointer :: snl(:) ! negative number of snow layers (col) [nbr] + real(r8), pointer :: t_grnd(:) ! ground temperature (col) [K] + real(r8), pointer :: dz(:,:) ! layer thickness (col,lyr) [m] + real(r8), pointer :: h2osno(:) ! snow water (col) [mm H2O] + real(r8), pointer :: snw_rds(:,:) ! effective grain radius (col,lyr) [microns, m-6] + real(r8), pointer :: snw_rds_top(:) ! effective grain radius, top layer (col) [microns, m-6] + real(r8), pointer :: sno_liq_top(:) ! liquid water fraction (mass) in top snow layer (col) [frc] + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water content (col,lyr) [kg m-2] + real(r8), pointer :: h2osoi_ice(:,:) ! ice content (col,lyr) [kg m-2] + real(r8), pointer :: snot_top(:) ! snow temperature in top layer (col) [K] + real(r8), pointer :: dTdz_top(:) ! temperature gradient in top layer (col) [K m-1] + real(r8), pointer :: qflx_snow_grnd_col(:) ! snow on ground after interception (col) [kg m-2 s-1] + real(r8), pointer :: qflx_snwcp_ice(:) ! excess precipitation due to snow capping [kg m-2 s-1] + real(r8), pointer :: qflx_snofrz_lyr(:,:) ! snow freezing rate (col,lyr) [kg m-2 s-1] + logical , pointer :: do_capsnow(:) ! true => do snow capping + + ! + ! !OTHER LOCAL VARIABLES: + ! + integer :: snl_top ! top snow layer index [idx] + integer :: snl_btm ! bottom snow layer index [idx] + integer :: i ! layer index [idx] + integer :: c_idx ! column index [idx] + integer :: fc ! snow column filter index [idx] + integer :: T_idx ! snow aging lookup table temperature index [idx] + integer :: Tgrd_idx ! snow aging lookup table temperature gradient index [idx] + integer :: rhos_idx ! snow aging lookup table snow density index [idx] + real(r8) :: t_snotop ! temperature at upper layer boundary [K] + real(r8) :: t_snobtm ! temperature at lower layer boundary [K] + real(r8) :: dTdz(lbc:ubc,-nlevsno:0) ! snow temperature gradient (col,lyr) [K m-1] + real(r8) :: bst_tau ! snow aging parameter retrieved from lookup table [hour] + real(r8) :: bst_kappa ! snow aging parameter retrieved from lookup table [unitless] + real(r8) :: bst_drdt0 ! snow aging parameter retrieved from lookup table [um hr-1] + real(r8) :: dr ! incremental change in snow effective radius [um] + real(r8) :: dr_wet ! incremental change in snow effective radius from wet growth [um] + real(r8) :: dr_fresh ! difference between fresh snow r_e and current r_e [um] + real(r8) :: newsnow ! fresh snowfall [kg m-2] + real(r8) :: refrzsnow ! re-frozen snow [kg m-2] + real(r8) :: frc_newsnow ! fraction of layer mass that is new snow [frc] + real(r8) :: frc_oldsnow ! fraction of layer mass that is old snow [frc] + real(r8) :: frc_refrz ! fraction of layer mass that is re-frozen snow [frc] + real(r8) :: frc_liq ! fraction of layer mass that is liquid water[frc] + real(r8) :: dtime ! land model time step [sec] + real(r8) :: rhos ! snow density [kg m-3] + real(r8) :: h2osno_lyr ! liquid + solid H2O in snow layer [kg m-2] + + + ! Assign local pointers to derived subtypes components (column-level) + t_soisno => ces%t_soisno + snl => cps%snl + t_grnd => ces%t_grnd + dz => cps%dz + h2osno => cws%h2osno + snw_rds => cps%snw_rds + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + snot_top => cps%snot_top + dTdz_top => cps%dTdz_top + snw_rds_top => cps%snw_rds_top + sno_liq_top => cps%sno_liq_top + qflx_snow_grnd_col => pwf_a%qflx_snow_grnd + qflx_snwcp_ice => pwf_a%qflx_snwcp_ice + qflx_snofrz_lyr => cwf%qflx_snofrz_lyr + do_capsnow => cps%do_capsnow + + + ! set timestep and step interval + dtime = get_step_size() + + ! loop over columns that have at least one snow layer + do fc = 1, num_snowc + c_idx = filter_snowc(fc) + + snl_btm = 0 + snl_top = snl(c_idx) + 1 + + ! loop over snow layers + do i=snl_top,snl_btm,1 + ! + !********** 1. DRY SNOW AGING *********** + ! + h2osno_lyr = h2osoi_liq(c_idx,i) + h2osoi_ice(c_idx,i) + + ! temperature gradient + if (i == snl_top) then + ! top layer + t_snotop = t_grnd(c_idx) + t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i+1)) / (dz(c_idx,i)+dz(c_idx,i+1)) + else + t_snotop = (t_soisno(c_idx,i-1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i-1)) / (dz(c_idx,i)+dz(c_idx,i-1)) + t_snobtm = (t_soisno(c_idx,i+1)*dz(c_idx,i) + t_soisno(c_idx,i)*dz(c_idx,i+1)) / (dz(c_idx,i)+dz(c_idx,i+1)) + endif + + dTdz(c_idx,i) = abs((t_snotop - t_snobtm) / dz(c_idx,i)) + + ! snow density + rhos = (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)) / dz(c_idx,i) + + ! best-fit table indecies + T_idx = nint((t_soisno(c_idx,i)-223) / 5) + 1 + Tgrd_idx = nint(dTdz(c_idx,i) / 10) + 1 + rhos_idx = nint((rhos-50) / 50) + 1 + + ! boundary check: + if (T_idx < idx_T_min) then + T_idx = idx_T_min + endif + if (T_idx > idx_T_max) then + T_idx = idx_T_max + endif + if (Tgrd_idx < idx_Tgrd_min) then + Tgrd_idx = idx_Tgrd_min + endif + if (Tgrd_idx > idx_Tgrd_max) then + Tgrd_idx = idx_Tgrd_max + endif + if (rhos_idx < idx_rhos_min) then + rhos_idx = idx_rhos_min + endif + if (rhos_idx > idx_rhos_max) then + rhos_idx = idx_rhos_max + endif + + ! best-fit parameters + bst_tau = snowage_tau(rhos_idx,Tgrd_idx,T_idx) + bst_kappa = snowage_kappa(rhos_idx,Tgrd_idx,T_idx) + bst_drdt0 = snowage_drdt0(rhos_idx,Tgrd_idx,T_idx) + + + ! change in snow effective radius, using best-fit parameters + dr_fresh = snw_rds(c_idx,i)-snw_rds_min + dr = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa)) * (dtime/3600) + + + ! + !********** 2. WET SNOW AGING *********** + ! + ! We are assuming wet and dry evolution occur simultaneously, and + ! the contributions from both can be summed. + ! This is justified by setting the linear offset constant C1_liq_Brun89 to zero [Brun, 1989] + + ! liquid water faction + frc_liq = min(0.1_r8, (h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)))) + + !dr_wet = 1E6_r8*(dtime*(C1_liq_Brun89 + C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*(snw_rds(c_idx,i)/1E6)**(2))) + !simplified, units of microns: + dr_wet = 1E18_r8*(dtime*(C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*snw_rds(c_idx,i)**(2))) + + dr = dr + dr_wet + + ! + !********** 3. SNOWAGE SCALING (TURNED OFF BY DEFAULT) ************* + ! + ! Multiply rate of change of effective radius by some constant, xdrdt + if (flg_snoage_scl) then + dr = dr*xdrdt + endif + + + ! + !********** 4. INCREMENT EFFECTIVE RADIUS, ACCOUNTING FOR: *********** + ! DRY AGING + ! WET AGING + ! FRESH SNOW + ! RE-FREEZING + ! + ! new snowfall [kg/m2] + if (do_capsnow(c_idx)) then + newsnow = max(0._r8, (qflx_snwcp_ice(c_idx)*dtime)) + else + newsnow = max(0._r8, (qflx_snow_grnd_col(c_idx)*dtime)) + endif + + ! snow that has re-frozen [kg/m2] + refrzsnow = max(0._r8, (qflx_snofrz_lyr(c_idx,i)*dtime)) + + ! fraction of layer mass that is re-frozen + frc_refrz = refrzsnow / h2osno_lyr + + ! fraction of layer mass that is new snow + if (i == snl_top) then + frc_newsnow = newsnow / h2osno_lyr + else + frc_newsnow = 0._r8 + endif + + if ((frc_refrz + frc_newsnow) > 1._r8) then + frc_refrz = frc_refrz / (frc_refrz + frc_newsnow) + frc_newsnow = 1._r8 - frc_refrz + frc_oldsnow = 0._r8 + else + frc_oldsnow = 1._r8 - frc_refrz - frc_newsnow + endif + + ! mass-weighted mean of fresh snow, old snow, and re-frozen snow effective radius + snw_rds(c_idx,i) = (snw_rds(c_idx,i)+dr)*frc_oldsnow + snw_rds_min*frc_newsnow + snw_rds_refrz*frc_refrz + + + ! + !********** 5. CHECK BOUNDARIES *********** + ! + ! boundary check + if (snw_rds(c_idx,i) < snw_rds_min) then + snw_rds(c_idx,i) = snw_rds_min + endif + + if (snw_rds(c_idx,i) > snw_rds_max) then + snw_rds(c_idx,i) = snw_rds_max + end if + + ! set top layer variables for history files + if (i == snl_top) then + snot_top(c_idx) = t_soisno(c_idx,i) + dTdz_top(c_idx) = dTdz(c_idx,i) + snw_rds_top(c_idx) = snw_rds(c_idx,i) + sno_liq_top(c_idx) = h2osoi_liq(c_idx,i) / (h2osoi_liq(c_idx,i)+h2osoi_ice(c_idx,i)) + endif + + enddo + enddo + + ! Special case: snow on ground, but not enough to have defined a snow layer: + ! set snw_rds to fresh snow grain size: + do fc = 1, num_nosnowc + c_idx = filter_nosnowc(fc) + if (h2osno(c_idx) > 0._r8) then + snw_rds(c_idx,0) = snw_rds_min + endif + enddo + + end subroutine SnowAge_grain + + subroutine SnowOptics_init( ) + use fileutils , only : getfil + use CLM_varctl , only : fsnowoptics + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + + type(file_desc_t) :: ncid ! netCDF file id + character(len=256) :: locfn ! local filename + character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name + integer :: ier ! error status + + + ! + ! Open optics file: + if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' + call getfil (fsnowoptics, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + + ! direct-beam snow Mie parameters: + call ncd_io('ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + + ! diffuse snow Mie parameters + call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + + ! BC species 1 Mie parameters + call ncd_io( 'ss_alb_bcphil', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphil', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphil', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + + ! BC species 2 Mie parameters + call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + + ! OC species 1 Mie parameters + call ncd_io( 'ss_alb_ocphil', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphil', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphil', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + + ! OC species 2 Mie parameters + call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + + + call ncd_pio_closefile(ncid) + if (masterproc) then + + write(iulog,*) 'Successfully read snow optical properties' + ! print some diagnostics: + write (iulog,*) 'SNICAR: Mie single scatter albedos for direct-beam ice, rds=100um: ', & + ss_alb_snw_drc(71,1), ss_alb_snw_drc(71,2), ss_alb_snw_drc(71,3), & + ss_alb_snw_drc(71,4), ss_alb_snw_drc(71,5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for diffuse ice, rds=100um: ', & + ss_alb_snw_dfs(71,1), ss_alb_snw_dfs(71,2), ss_alb_snw_dfs(71,3), & + ss_alb_snw_dfs(71,4), ss_alb_snw_dfs(71,5) + if (DO_SNO_OC) then + write (iulog,*) 'SNICAR: Including OC aerosols from snow radiative transfer calculations' + else + write (iulog,*) 'SNICAR: Excluding OC aerosols from snow radiative transfer calculations' + endif + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic BC: ', & + ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic BC: ', & + ss_alb_bc2(1), ss_alb_bc2(2), ss_alb_bc2(3), ss_alb_bc2(4), ss_alb_bc2(5) + if (DO_SNO_OC) then + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic OC: ', & + ss_alb_oc1(1), ss_alb_oc1(2), ss_alb_oc1(3), ss_alb_oc1(4), ss_alb_oc1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic OC: ', & + ss_alb_oc2(1), ss_alb_oc2(2), ss_alb_oc2(3), ss_alb_oc2(4), ss_alb_oc2(5) + endif + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 1: ', & + ss_alb_dst1(1), ss_alb_dst1(2), ss_alb_dst1(3), ss_alb_dst1(4), ss_alb_dst1(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 2: ', & + ss_alb_dst2(1), ss_alb_dst2(2), ss_alb_dst2(3), ss_alb_dst2(4), ss_alb_dst2(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 3: ', & + ss_alb_dst3(1), ss_alb_dst3(2), ss_alb_dst3(3), ss_alb_dst3(4), ss_alb_dst3(5) + write (iulog,*) 'SNICAR: Mie single scatter albedos for dust species 4: ', & + ss_alb_dst4(1), ss_alb_dst4(2), ss_alb_dst4(3), ss_alb_dst4(4), ss_alb_dst4(5) + write(iulog,*) + end if + + end subroutine SnowOptics_init + + subroutine SnowAge_init( ) + use CLM_varctl , only : fsnowaging + use fileutils , only : getfil + use spmdMod , only : masterproc + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + + type(file_desc_t) :: ncid ! netCDF file id + character(len=256) :: locfn ! local filename + character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name + integer :: varid ! netCDF id's + integer :: ier ! error status + + ! Open snow aging (effective radius evolution) file: + allocate(snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + allocate(snowage_kappa(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max,idx_Tgrd_max,idx_T_max)) + + if(masterproc) write(iulog,*) 'Attempting to read snow aging parameters .....' + call getfil (fsnowaging, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowaging) + + ! snow aging parameters + + call ncd_io('tau', snowage_tau, 'read', ncid, posNOTonfile=.true.) + call ncd_io('kappa', snowage_kappa, 'read', ncid, posNOTonfile=.true.) + call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, posNOTonfile=.true.) + + call ncd_pio_closefile(ncid) + if (masterproc) then + + write(iulog,*) 'Successfully read snow aging properties' + + ! print some diagnostics: + write (iulog,*) 'SNICAR: snowage tau for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_tau(3,11,9) + write (iulog,*) 'SNICAR: snowage kappa for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_kappa(3,11,9) + write (iulog,*) 'SNICAR: snowage dr/dt_0 for T=263K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_drdt0(3,11,9) + endif + + end subroutine SnowAge_init + + +end module SNICARMod diff --git a/components/clm/src_clm40/biogeophys/SnowHydrologyMod.F90 b/components/clm/src_clm40/biogeophys/SnowHydrologyMod.F90 new file mode 100644 index 0000000000..ecd92bc640 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SnowHydrologyMod.F90 @@ -0,0 +1,1650 @@ +module SnowHydrologyMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SnowHydrologyMod +! +! !DESCRIPTION: +! Calculate snow hydrology. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varpar , only : nlevsno +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SnowWater ! Change of snow mass and the snow water onto soil + public :: SnowCompaction ! Change in snow layer thickness due to compaction + public :: CombineSnowLayers ! Combine snow layers less than a min thickness + public :: DivideSnowLayers ! Subdivide snow layers if they exceed maximum thickness + public :: BuildSnowFilter ! Construct snow/no-snow filters +! +! !PRIVATE MEMBER FUNCTIONS: + private :: Combo ! Returns the combined variables: dz, t, wliq, wice. +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SnowWater +! +! !INTERFACE: + subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & + num_nosnowc, filter_nosnowc) +! +! !DESCRIPTION: +! Evaluate the change of snow mass and the snow water onto soil. +! Water flow within snow is computed by an explicit and non-physical +! based scheme, which permits a part of liquid water over the holding +! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to +! percolate into the underlying layer. Except for cases where the +! porosity of one of the two neighboring layers is less than 0.05, zero +! flow is assumed. The water flow out of the bottom of the snow pack will +! participate as the input of the soil water and runoff. This subroutine +! uses a filter for columns containing snow which must be constructed prior +! to being called. +! +! !USES: + use clmtype + use clm_varcon , only : denh2o, denice, wimp, ssi + use clm_time_manager, only : get_step_size + use clm_atmlnd , only : clm_a2l + use SNICARMod , only : scvng_fct_mlt_bcphi, scvng_fct_mlt_bcpho, & + scvng_fct_mlt_ocphi, scvng_fct_mlt_ocpho, & + scvng_fct_mlt_dst1, scvng_fct_mlt_dst2, & + scvng_fct_mlt_dst3, scvng_fct_mlt_dst4 +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_snowc ! number of snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(in) :: num_nosnowc ! number of non-snow points in column filter + integer, intent(in) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 15 November 2000: Mariana Vertenstein +! 2/26/02, Peter Thornton: Migrated to new data structures. +! 03/28/08, Mark Flanner: Added aerosol deposition and flushing with meltwater +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: snl(:) !number of snow layers + logical , pointer :: do_capsnow(:) !true => do snow capping + real(r8), pointer :: qflx_snow_melt(:) !net snow melt + real(r8), pointer :: qflx_snomelt(:) !snow melt (mm H2O /s) + real(r8), pointer :: qflx_rain_grnd(:) !rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_sub_snow(:) !sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_evap_grnd(:) !ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_dew_snow(:) !surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd(:) !ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: dz(:,:) !layer depth (m) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: qflx_top_soil(:) !net water input into soil from top (mm/s) +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) + integer , pointer :: cgridcell(:) ! columns's gridcell (col) + real(r8), pointer :: mss_bcphi(:,:) ! hydrophillic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcpho(:,:) ! hydrophobic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! hydrophillic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocpho(:,:) ! hydrophobic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst1(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer :: flx_bc_dep_dry(:) ! dry BC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_bc_dep_wet(:) ! wet BC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_bc_dep(:) ! total BC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_bc_dep_pho(:) ! hydrophobic BC deposition (col) [kg m-1 s-1] + real(r8), pointer :: flx_bc_dep_phi(:) ! hydrophillic BC deposition (col) [kg m-1 s-1] + real(r8), pointer :: flx_oc_dep_dry(:) ! dry OC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_oc_dep_wet(:) ! wet OC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_oc_dep(:) ! total OC deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_oc_dep_pho(:) ! hydrophobic OC deposition (col) [kg m-1 s-1] + real(r8), pointer :: flx_oc_dep_phi(:) ! hydrophillic OC deposition (col) [kg m-1 s-1] + real(r8), pointer :: flx_dst_dep_dry1(:) ! dry dust (species 1) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_wet1(:) ! wet dust (species 1) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_dry2(:) ! dry dust (species 2) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_wet2(:) ! wet dust (species 2) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_dry3(:) ! dry dust (species 3) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_wet3(:) ! wet dust (species 3) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_dry4(:) ! dry dust (species 4) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep_wet4(:) ! wet dust (species 4) deposition (col) [kg m-2 s-1] + real(r8), pointer :: flx_dst_dep(:) ! total dust deposition (col) [kg m-2 s-1] + real(r8), pointer :: forc_aer(:,:) ! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: c, j, fc !do loop/array indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: qin(lbc:ubc) !water flow into the elmement (mm/s) + real(r8) :: qout(lbc:ubc) !water flow out of the elmement (mm/s) + real(r8) :: wgdif !ice mass after minus sublimation + real(r8) :: vol_liq(lbc:ubc,-nlevsno+1:0) !partial volume of liquid water in layer + real(r8) :: vol_ice(lbc:ubc,-nlevsno+1:0) !partial volume of ice lens in layer + real(r8) :: eff_porosity(lbc:ubc,-nlevsno+1:0) !effective porosity = porosity - vol_ice + integer :: g ! gridcell loop index + real(r8) :: qin_bc_phi(lbc:ubc) ! flux of hydrophilic BC into layer [kg] + real(r8) :: qout_bc_phi(lbc:ubc) ! flux of hydrophilic BC out of layer [kg] + real(r8) :: qin_bc_pho(lbc:ubc) ! flux of hydrophobic BC into layer [kg] + real(r8) :: qout_bc_pho(lbc:ubc) ! flux of hydrophobic BC out of layer [kg] + real(r8) :: qin_oc_phi(lbc:ubc) ! flux of hydrophilic OC into layer [kg] + real(r8) :: qout_oc_phi(lbc:ubc) ! flux of hydrophilic OC out of layer [kg] + real(r8) :: qin_oc_pho(lbc:ubc) ! flux of hydrophobic OC into layer [kg] + real(r8) :: qout_oc_pho(lbc:ubc) ! flux of hydrophobic OC out of layer [kg] + real(r8) :: qin_dst1(lbc:ubc) ! flux of dust species 1 into layer [kg] + real(r8) :: qout_dst1(lbc:ubc) ! flux of dust species 1 out of layer [kg] + real(r8) :: qin_dst2(lbc:ubc) ! flux of dust species 2 into layer [kg] + real(r8) :: qout_dst2(lbc:ubc) ! flux of dust species 2 out of layer [kg] + real(r8) :: qin_dst3(lbc:ubc) ! flux of dust species 3 into layer [kg] + real(r8) :: qout_dst3(lbc:ubc) ! flux of dust species 3 out of layer [kg] + real(r8) :: qin_dst4(lbc:ubc) ! flux of dust species 4 into layer [kg] + real(r8) :: qout_dst4(lbc:ubc) ! flux of dust species 4 out of layer [kg] + real(r8) :: mss_liqice ! mass of liquid+ice in a layer + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtype components (column-level) + + snl => cps%snl + do_capsnow => cps%do_capsnow + qflx_snow_melt => cwf%qflx_snow_melt + qflx_snomelt => cwf%qflx_snomelt + qflx_rain_grnd => pwf_a%qflx_rain_grnd + qflx_sub_snow => pwf_a%qflx_sub_snow + qflx_evap_grnd => pwf_a%qflx_evap_grnd + qflx_dew_snow => pwf_a%qflx_dew_snow + qflx_dew_grnd => pwf_a%qflx_dew_grnd + qflx_top_soil => cwf%qflx_top_soil + dz => cps%dz + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + cgridcell => col%gridcell + mss_bcphi => cps%mss_bcphi + mss_bcpho => cps%mss_bcpho + mss_ocphi => cps%mss_ocphi + mss_ocpho => cps%mss_ocpho + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + flx_bc_dep => cwf%flx_bc_dep + flx_bc_dep_wet => cwf%flx_bc_dep_wet + flx_bc_dep_dry => cwf%flx_bc_dep_dry + flx_bc_dep_phi => cwf%flx_bc_dep_phi + flx_bc_dep_pho => cwf%flx_bc_dep_pho + flx_oc_dep => cwf%flx_oc_dep + flx_oc_dep_wet => cwf%flx_oc_dep_wet + flx_oc_dep_dry => cwf%flx_oc_dep_dry + flx_oc_dep_phi => cwf%flx_oc_dep_phi + flx_oc_dep_pho => cwf%flx_oc_dep_pho + flx_dst_dep => cwf%flx_dst_dep + flx_dst_dep_wet1 => cwf%flx_dst_dep_wet1 + flx_dst_dep_dry1 => cwf%flx_dst_dep_dry1 + flx_dst_dep_wet2 => cwf%flx_dst_dep_wet2 + flx_dst_dep_dry2 => cwf%flx_dst_dep_dry2 + flx_dst_dep_wet3 => cwf%flx_dst_dep_wet3 + flx_dst_dep_dry3 => cwf%flx_dst_dep_dry3 + flx_dst_dep_wet4 => cwf%flx_dst_dep_wet4 + flx_dst_dep_dry4 => cwf%flx_dst_dep_dry4 + forc_aer => clm_a2l%forc_aer + + ! Determine model time step + + dtime = get_step_size() + + ! Renew the mass of ice lens (h2osoi_ice) and liquid (h2osoi_liq) in the + ! surface snow layer resulting from sublimation (frost) / evaporation (condense) + + do fc = 1,num_snowc + c = filter_snowc(fc) + if (do_capsnow(c)) then + wgdif = h2osoi_ice(c,snl(c)+1) - qflx_sub_snow(c)*dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0._r8) then + h2osoi_ice(c,snl(c)+1) = 0._r8 + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) - qflx_evap_grnd(c) * dtime + else + wgdif = h2osoi_ice(c,snl(c)+1) + (qflx_dew_snow(c) - qflx_sub_snow(c)) * dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0._r8) then + h2osoi_ice(c,snl(c)+1) = 0._r8 + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + & + (qflx_rain_grnd(c) + qflx_dew_grnd(c) - qflx_evap_grnd(c)) * dtime + end if + h2osoi_liq(c,snl(c)+1) = max(0._r8, h2osoi_liq(c,snl(c)+1)) + end do + + ! Porosity and partial volume + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + vol_ice(c,j) = min(1._r8, h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity(c,j) = 1._r8 - vol_ice(c,j) + vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + end if + end do + end do + + ! Capillary forces within snow are usually two or more orders of magnitude + ! less than those of gravity. Only gravity terms are considered. + ! the genernal expression for water flow is "K * ss**3", however, + ! no effective parameterization for "K". Thus, a very simple consideration + ! (not physically based) is introduced: + ! when the liquid water of layer exceeds the layer's holding + ! capacity, the excess meltwater adds to the underlying neighbor layer. + + ! Also compute aerosol fluxes through snowpack in this loop: + ! 1) compute aerosol mass in each layer + ! 2) add aerosol mass flux from above layer to mass of this layer + ! 3) qout_xxx is mass flux of aerosol species xxx out bottom of + ! layer in water flow, proportional to (current) concentration + ! of aerosol in layer multiplied by a scavenging ratio. + ! 4) update mass of aerosol in top layer, accordingly + ! 5) update mass concentration of aerosol accordingly + + qin(:) = 0._r8 + qin_bc_phi(:) = 0._r8 + qin_bc_pho(:) = 0._r8 + qin_oc_phi(:) = 0._r8 + qin_oc_pho(:) = 0._r8 + qin_dst1(:) = 0._r8 + qin_dst2(:) = 0._r8 + qin_dst3(:) = 0._r8 + qin_dst4(:) = 0._r8 + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osoi_liq(c,j) = h2osoi_liq(c,j) + qin(c) + + mss_bcphi(c,j) = mss_bcphi(c,j) + qin_bc_phi(c) + mss_bcpho(c,j) = mss_bcpho(c,j) + qin_bc_pho(c) + mss_ocphi(c,j) = mss_ocphi(c,j) + qin_oc_phi(c) + mss_ocpho(c,j) = mss_ocpho(c,j) + qin_oc_pho(c) + mss_dst1(c,j) = mss_dst1(c,j) + qin_dst1(c) + mss_dst2(c,j) = mss_dst2(c,j) + qin_dst2(c) + mss_dst3(c,j) = mss_dst3(c,j) + qin_dst3(c) + mss_dst4(c,j) = mss_dst4(c,j) + qin_dst4(c) + + if (j <= -1) then + ! No runoff over snow surface, just ponding on surface + if (eff_porosity(c,j) < wimp .OR. eff_porosity(c,j+1) < wimp) then + qout(c) = 0._r8 + else + qout(c) = max(0._r8,(vol_liq(c,j)-ssi*eff_porosity(c,j))*dz(c,j)) + qout(c) = min(qout(c),(1._r8-vol_ice(c,j+1)-vol_liq(c,j+1))*dz(c,j+1)) + end if + else + qout(c) = max(0._r8,(vol_liq(c,j) - ssi*eff_porosity(c,j))*dz(c,j)) + end if + qout(c) = qout(c)*1000._r8 + h2osoi_liq(c,j) = h2osoi_liq(c,j) - qout(c) + qin(c) = qout(c) + + ! mass of ice+water: in extremely rare circumstances, this can + ! be zero, even though there is a snow layer defined. In + ! this case, set the mass to a very small value to + ! prevent division by zero. + mss_liqice = h2osoi_liq(c,j)+h2osoi_ice(c,j) + if (mss_liqice < 1E-30_r8) then + mss_liqice = 1E-30_r8 + endif + + ! BCPHI: + ! 1. flux with meltwater: + qout_bc_phi(c) = qout(c)*scvng_fct_mlt_bcphi*(mss_bcphi(c,j)/mss_liqice) + if (qout_bc_phi(c) > mss_bcphi(c,j)) then + qout_bc_phi(c) = mss_bcphi(c,j) + endif + mss_bcphi(c,j) = mss_bcphi(c,j) - qout_bc_phi(c) + qin_bc_phi(c) = qout_bc_phi(c) + + ! BCPHO: + ! 1. flux with meltwater: + qout_bc_pho(c) = qout(c)*scvng_fct_mlt_bcpho*(mss_bcpho(c,j)/mss_liqice) + if (qout_bc_pho(c) > mss_bcpho(c,j)) then + qout_bc_pho(c) = mss_bcpho(c,j) + endif + mss_bcpho(c,j) = mss_bcpho(c,j) - qout_bc_pho(c) + qin_bc_pho(c) = qout_bc_pho(c) + + ! OCPHI: + ! 1. flux with meltwater: + qout_oc_phi(c) = qout(c)*scvng_fct_mlt_ocphi*(mss_ocphi(c,j)/mss_liqice) + if (qout_oc_phi(c) > mss_ocphi(c,j)) then + qout_oc_phi(c) = mss_ocphi(c,j) + endif + mss_ocphi(c,j) = mss_ocphi(c,j) - qout_oc_phi(c) + qin_oc_phi(c) = qout_oc_phi(c) + + ! OCPHO: + ! 1. flux with meltwater: + qout_oc_pho(c) = qout(c)*scvng_fct_mlt_ocpho*(mss_ocpho(c,j)/mss_liqice) + if (qout_oc_pho(c) > mss_ocpho(c,j)) then + qout_oc_pho(c) = mss_ocpho(c,j) + endif + mss_ocpho(c,j) = mss_ocpho(c,j) - qout_oc_pho(c) + qin_oc_pho(c) = qout_oc_pho(c) + + ! DUST 1: + ! 1. flux with meltwater: + qout_dst1(c) = qout(c)*scvng_fct_mlt_dst1*(mss_dst1(c,j)/mss_liqice) + if (qout_dst1(c) > mss_dst1(c,j)) then + qout_dst1(c) = mss_dst1(c,j) + endif + mss_dst1(c,j) = mss_dst1(c,j) - qout_dst1(c) + qin_dst1(c) = qout_dst1(c) + + ! DUST 2: + ! 1. flux with meltwater: + qout_dst2(c) = qout(c)*scvng_fct_mlt_dst2*(mss_dst2(c,j)/mss_liqice) + if (qout_dst2(c) > mss_dst2(c,j)) then + qout_dst2(c) = mss_dst2(c,j) + endif + mss_dst2(c,j) = mss_dst2(c,j) - qout_dst2(c) + qin_dst2(c) = qout_dst2(c) + + ! DUST 3: + ! 1. flux with meltwater: + qout_dst3(c) = qout(c)*scvng_fct_mlt_dst3*(mss_dst3(c,j)/mss_liqice) + if (qout_dst3(c) > mss_dst3(c,j)) then + qout_dst3(c) = mss_dst3(c,j) + endif + mss_dst3(c,j) = mss_dst3(c,j) - qout_dst3(c) + qin_dst3(c) = qout_dst3(c) + + ! DUST 4: + ! 1. flux with meltwater: + qout_dst4(c) = qout(c)*scvng_fct_mlt_dst4*(mss_dst4(c,j)/mss_liqice) + if (qout_dst4(c) > mss_dst4(c,j)) then + qout_dst4(c) = mss_dst4(c,j) + endif + mss_dst4(c,j) = mss_dst4(c,j) - qout_dst4(c) + qin_dst4(c) = qout_dst4(c) + + end if + end do + end do + + ! Adjust layer thickness for any water+ice content changes in excess of previous + ! layer thickness. Strictly speaking, only necessary for top snow layer, but doing + ! it for all snow layers will catch problems with older initial files. + ! Layer interfaces (zi) and node depths (z) do not need adjustment here because they + ! are adjusted in CombineSnowLayers and are not used up to that point. + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + dz(c,j) = max(dz(c,j),h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice) + end if + end do + end do + + do fc = 1, num_snowc + c = filter_snowc(fc) + ! Qout from snow bottom + qflx_top_soil(c) = qout(c) / dtime + qflx_snow_melt(c) = qflx_snow_melt(c) + (qout(c) / dtime) + end do + + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + qflx_top_soil(c) = qflx_rain_grnd(c) + qflx_snomelt(c) + qflx_snow_melt(c) = qflx_snomelt(c) + end do + + ! set aerosol deposition fluxes from forcing array + ! The forcing array is either set from an external file + ! or from fluxes received from the atmosphere model + do c = lbc,ubc + g = cgridcell(c) + + flx_bc_dep_dry(c) = forc_aer(g,1) + forc_aer(g,2) + flx_bc_dep_wet(c) = forc_aer(g,3) + flx_bc_dep_phi(c) = forc_aer(g,1) + forc_aer(g,3) + flx_bc_dep_pho(c) = forc_aer(g,2) + flx_bc_dep(c) = forc_aer(g,1) + forc_aer(g,2) + forc_aer(g,3) + + flx_oc_dep_dry(c) = forc_aer(g,4) + forc_aer(g,5) + flx_oc_dep_wet(c) = forc_aer(g,6) + flx_oc_dep_phi(c) = forc_aer(g,4) + forc_aer(g,6) + flx_oc_dep_pho(c) = forc_aer(g,5) + flx_oc_dep(c) = forc_aer(g,4) + forc_aer(g,5) + forc_aer(g,6) + + flx_dst_dep_wet1(c) = forc_aer(g,7) + flx_dst_dep_dry1(c) = forc_aer(g,8) + flx_dst_dep_wet2(c) = forc_aer(g,9) + flx_dst_dep_dry2(c) = forc_aer(g,10) + flx_dst_dep_wet3(c) = forc_aer(g,11) + flx_dst_dep_dry3(c) = forc_aer(g,12) + flx_dst_dep_wet4(c) = forc_aer(g,13) + flx_dst_dep_dry4(c) = forc_aer(g,14) + flx_dst_dep(c) = forc_aer(g,7) + forc_aer(g,8) + forc_aer(g,9) + & + forc_aer(g,10) + forc_aer(g,11) + forc_aer(g,12) + & + forc_aer(g,13) + forc_aer(g,14) + + end do + + ! aerosol deposition fluxes into top layer + ! This is done after the inter-layer fluxes so that some aerosol + ! is in the top layer after deposition, and is not immediately + ! washed out before radiative calculations are done + do fc = 1, num_snowc + c = filter_snowc(fc) + mss_bcphi(c,snl(c)+1) = mss_bcphi(c,snl(c)+1) + (flx_bc_dep_phi(c)*dtime) + mss_bcpho(c,snl(c)+1) = mss_bcpho(c,snl(c)+1) + (flx_bc_dep_pho(c)*dtime) + mss_ocphi(c,snl(c)+1) = mss_ocphi(c,snl(c)+1) + (flx_oc_dep_phi(c)*dtime) + mss_ocpho(c,snl(c)+1) = mss_ocpho(c,snl(c)+1) + (flx_oc_dep_pho(c)*dtime) + + mss_dst1(c,snl(c)+1) = mss_dst1(c,snl(c)+1) + (flx_dst_dep_dry1(c) + flx_dst_dep_wet1(c))*dtime + mss_dst2(c,snl(c)+1) = mss_dst2(c,snl(c)+1) + (flx_dst_dep_dry2(c) + flx_dst_dep_wet2(c))*dtime + mss_dst3(c,snl(c)+1) = mss_dst3(c,snl(c)+1) + (flx_dst_dep_dry3(c) + flx_dst_dep_wet3(c))*dtime + mss_dst4(c,snl(c)+1) = mss_dst4(c,snl(c)+1) + (flx_dst_dep_dry4(c) + flx_dst_dep_wet4(c))*dtime + end do + + end subroutine SnowWater + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SnowCompaction +! +! !INTERFACE: + subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc) +! +! !DESCRIPTION: +! Determine the change in snow layer thickness due to compaction and +! settling. +! Three metamorphisms of changing snow characteristics are implemented, +! i.e., destructive, overburden, and melt. The treatments of the former +! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution +! due to melt metamorphism is simply taken as a ratio of snow ice +! fraction after the melting versus before the melting. +! +! !USES: + use clmtype + use clm_time_manager, only : get_step_size + use clm_varcon , only : denice, denh2o, tfrz, istice_mec +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_snowc ! number of column snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points +! +! !CALLED FROM: +! subroutine Hydrology2 in module Hydrology2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/28/02, Peter Thornton: Migrated to new data structures +! 2/29/08, David Lawrence: Revised snow overburden to be include 0.5 weight of current layer +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars +! + integer, pointer :: snl(:) !number of snow layers +! +! local pointers to implicit in arguments +! + integer, pointer :: imelt(:,:) !flag for melting (=1), freezing (=2), Not=0 + real(r8), pointer :: frac_iceold(:,:) !fraction of ice relative to the tot water + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) +! +! local pointers to implicit inout arguments +! + real(r8), pointer :: dz(:,:) !layer depth (m) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: j, l, c, fc ! indices + real(r8):: dtime ! land model time step (sec) + real(r8), parameter :: c2 = 23.e-3_r8 ! [m3/kg] + real(r8), parameter :: c3 = 2.777e-6_r8 ! [1/s] + real(r8), parameter :: c4 = 0.04_r8 ! [1/K] + real(r8), parameter :: c5 = 2.0_r8 ! + real(r8), parameter :: dm = 100.0_r8 ! Upper Limit on Destructive Metamorphism Compaction [kg/m3] + real(r8), parameter :: eta0 = 9.e+5_r8 ! The Viscosity Coefficient Eta0 [kg-s/m2] + real(r8) :: burden(lbc:ubc) ! pressure of overlying snow [kg/m2] + real(r8) :: ddz1 ! Rate of settling of snowpack due to destructive metamorphism. + real(r8) :: ddz2 ! Rate of compaction of snowpack due to overburden. + real(r8) :: ddz3 ! Rate of compaction of snowpack due to melt [1/s] + real(r8) :: dexpf ! expf=exp(-c4*(273.15-t_soisno)). + real(r8) :: fi ! Fraction of ice relative to the total water content at current time step + real(r8) :: td ! t_soisno - tfrz [K] + real(r8) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s] + real(r8) :: void ! void (1 - vol_ice - vol_liq) + real(r8) :: wx ! water mass (ice+liquid) [kg/m2] + real(r8) :: bi ! partial density of ice [kg/m3] + + integer, pointer :: clandunit(:) !landunit index for each column + integer, pointer :: ltype(:) !landunit type + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes (column-level) + + snl => cps%snl + dz => cps%dz + imelt => cps%imelt + frac_iceold => cps%frac_iceold + t_soisno => ces%t_soisno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + clandunit => col%landunit + ltype => lun%itype + + ! Get time step + + dtime = get_step_size() + + ! Begin calculation - note that the following column loops are only invoked if snl(c) < 0 + + burden(:) = 0._r8 + + do j = -nlevsno+1, 0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + + wx = h2osoi_ice(c,j) + h2osoi_liq(c,j) + void = 1._r8 - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o) / dz(c,j) + + ! If void is negative, then increase dz such that void = 0. + ! This should be done for any landunit, but for now is done only for glacier_mec 1andunits. + l = clandunit(c) + if (ltype(l)==istice_mec .and. void < 0._r8) then + dz(c,j) = h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o + void = 0._r8 + endif + + ! Allow compaction only for non-saturated node and higher ice lens node. + if (void > 0.001_r8 .and. h2osoi_ice(c,j) > .1_r8) then + bi = h2osoi_ice(c,j) / dz(c,j) + fi = h2osoi_ice(c,j) / wx + td = tfrz-t_soisno(c,j) + dexpf = exp(-c4*td) + + ! Settling as a result of destructive metamorphism + + ddz1 = -c3*dexpf + if (bi > dm) ddz1 = ddz1*exp(-46.0e-3_r8*(bi-dm)) + + ! Liquid water term + + if (h2osoi_liq(c,j) > 0.01_r8*dz(c,j)) ddz1=ddz1*c5 + + ! Compaction due to overburden + + ddz2 = -(burden(c)+wx/2._r8)*exp(-0.08_r8*td - c2*bi)/eta0 + + ! Compaction occurring during melt + + if (imelt(c,j) == 1) then + ddz3 = - 1._r8/dtime * max(0._r8,(frac_iceold(c,j) - fi)/frac_iceold(c,j)) + else + ddz3 = 0._r8 + end if + + ! Time rate of fractional change in dz (units of s-1) + + pdzdtc = ddz1 + ddz2 + ddz3 + + ! The change in dz due to compaction + ! Limit compaction to no less than fully saturated layer thickness + + dz(c,j) = max(dz(c,j) * (1._r8+pdzdtc*dtime),h2osoi_ice(c,j)/denice & + + h2osoi_liq(c,j)/denh2o) + + end if + + ! Pressure of overlying snow + + burden(c) = burden(c) + wx + + end if + end do + end do + + end subroutine SnowCompaction + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CombineSnowLayers +! +! !INTERFACE: + subroutine CombineSnowLayers(lbc, ubc, num_snowc, filter_snowc) +! +! !DESCRIPTION: +! Combine snow layers that are less than a minimum thickness or mass +! If the snow element thickness or mass is less than a prescribed minimum, +! then it is combined with a neighboring element. The subroutine +! clm\_combo.f90 then executes the combination of mass and energy. +! +! !USES: + use clmtype + use clm_varcon, only : istsoil, isturb + use clm_varcon, only : istcrop + use clm_time_manager, only : get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(inout) :: num_snowc ! number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points +! +! !CALLED FROM: +! subroutine Hydrology2 in module Hydrology2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/28/02, Peter Thornton: Migrated to new data structures. +! 03/28/08, Mark Flanner: Added aerosol masses and snow grain radius +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer, pointer :: clandunit(:) !landunit index for each column + integer, pointer :: ltype(:) !landunit type +! +! local pointers to implicit inout arguments +! + integer , pointer :: snl(:) !number of snow layers + real(r8), pointer :: h2osno(:) !snow water (mm H2O) + real(r8), pointer :: snowdp(:) !snow height (m) + real(r8), pointer :: dz(:,:) !layer depth (m) + real(r8), pointer :: zi(:,:) !interface level below a "z" level (m) + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: z(:,:) ! layer thickness (m) + real(r8), pointer :: mss_bcphi(:,:) ! hydrophilic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcpho(:,:) ! hydrophobic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! hydrophilic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocpho(:,:) ! hydrophobic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst1(:,:) ! dust species 1 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! dust species 2 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! dust species 3 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! dust species 4 mass in snow (col,lyr) [kg] + real(r8), pointer :: snw_rds(:,:) ! effective snow grain radius (col,lyr) [microns, m^-6] + real(r8), pointer :: qflx_sl_top_soil(:) ! liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: c, fc ! column indices + integer :: i,k ! loop indices + integer :: j,l ! node indices + integer :: msn_old(lbc:ubc) ! number of top snow layer + integer :: mssi(lbc:ubc) ! node index + integer :: neibor ! adjacent node selected for combination + real(r8):: zwice(lbc:ubc) ! total ice mass in snow + real(r8):: zwliq (lbc:ubc) ! total liquid water in snow + real(r8):: dzmin(5) ! minimum of top snow layer + real(r8) :: dtime !land model time step (sec) + + data dzmin /0.010_r8, 0.015_r8, 0.025_r8, 0.055_r8, 0.115_r8/ +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes (landunit-level) + + ltype => lun%itype + + ! Assign local pointers to derived subtypes (column-level) + + clandunit => col%landunit + snl => cps%snl + snowdp => cps%snowdp + h2osno => cws%h2osno + dz => cps%dz + zi => cps%zi + z => cps%z + t_soisno => ces%t_soisno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + mss_bcphi => cps%mss_bcphi + mss_bcpho => cps%mss_bcpho + mss_ocphi => cps%mss_ocphi + mss_ocpho => cps%mss_ocpho + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + snw_rds => cps%snw_rds + qflx_sl_top_soil => cwf%qflx_sl_top_soil + + ! Determine model time step + + dtime = get_step_size() + + + ! Check the mass of ice lens of snow, when the total is less than a small value, + ! combine it with the underlying neighbor. + + do fc = 1, num_snowc + c = filter_snowc(fc) + msn_old(c) = snl(c) + qflx_sl_top_soil(c) = 0._r8 + end do + + ! The following loop is NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + l = clandunit(c) + do j = msn_old(c)+1,0 + if (h2osoi_ice(c,j) <= .1_r8) then + if (ltype(l) == istsoil .or. ltype(l)==isturb .or. ltype(l) == istcrop) then + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + + if (j == 0) then + qflx_sl_top_soil(c) = (h2osoi_liq(c,j) + h2osoi_ice(c,j))/dtime + end if + + if (j /= 0) dz(c,j+1) = dz(c,j+1) + dz(c,j) + + ! NOTE: Temperature, and similarly snw_rds, of the + ! underlying snow layer are NOT adjusted in this case. + ! Because the layer being eliminated has a small mass, + ! this should not make a large difference, but it + ! would be more thorough to do so. + if (j /= 0) then + mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j) + mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j) + mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j) + mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j) + mss_dst1(c,j+1) = mss_dst1(c,j+1) + mss_dst1(c,j) + mss_dst2(c,j+1) = mss_dst2(c,j+1) + mss_dst2(c,j) + mss_dst3(c,j+1) = mss_dst3(c,j+1) + mss_dst3(c,j) + mss_dst4(c,j+1) = mss_dst4(c,j+1) + mss_dst4(c,j) + end if + + else if (ltype(l) /= istsoil .and. ltype(l) /= isturb .and. ltype(l) /= istcrop .and. j /= 0) then + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + dz(c,j+1) = dz(c,j+1) + dz(c,j) + + mss_bcphi(c,j+1) = mss_bcphi(c,j+1) + mss_bcphi(c,j) + mss_bcpho(c,j+1) = mss_bcpho(c,j+1) + mss_bcpho(c,j) + mss_ocphi(c,j+1) = mss_ocphi(c,j+1) + mss_ocphi(c,j) + mss_ocpho(c,j+1) = mss_ocpho(c,j+1) + mss_ocpho(c,j) + mss_dst1(c,j+1) = mss_dst1(c,j+1) + mss_dst1(c,j) + mss_dst2(c,j+1) = mss_dst2(c,j+1) + mss_dst2(c,j) + mss_dst3(c,j+1) = mss_dst3(c,j+1) + mss_dst3(c,j) + mss_dst4(c,j+1) = mss_dst4(c,j+1) + mss_dst4(c,j) + + end if + + ! shift all elements above this down one. + if (j > snl(c)+1 .and. snl(c) < -1) then + do i = j, snl(c)+2, -1 + ! If the layer closest to the surface is less than 0.1 mm and the ltype is not + ! urban, soil or crop, the h2osoi_liq and h2osoi_ice associated with this layer is sent + ! to qflx_qrgwl later on in the code. To keep track of this for the snow balance + ! error check, we add this to qflx_sl_top_soil here + if (ltype(l) /= istsoil .and. ltype(l) /= istcrop .and. ltype(l) /= isturb .and. i == 0) then + qflx_sl_top_soil(c) = (h2osoi_liq(c,i) + h2osoi_ice(c,i))/dtime + end if + + t_soisno(c,i) = t_soisno(c,i-1) + h2osoi_liq(c,i) = h2osoi_liq(c,i-1) + h2osoi_ice(c,i) = h2osoi_ice(c,i-1) + + mss_bcphi(c,i) = mss_bcphi(c,i-1) + mss_bcpho(c,i) = mss_bcpho(c,i-1) + mss_ocphi(c,i) = mss_ocphi(c,i-1) + mss_ocpho(c,i) = mss_ocpho(c,i-1) + mss_dst1(c,i) = mss_dst1(c,i-1) + mss_dst2(c,i) = mss_dst2(c,i-1) + mss_dst3(c,i) = mss_dst3(c,i-1) + mss_dst4(c,i) = mss_dst4(c,i-1) + snw_rds(c,i) = snw_rds(c,i-1) + + dz(c,i) = dz(c,i-1) + end do + end if + snl(c) = snl(c) + 1 + end if + end do + end do + + do fc = 1, num_snowc + c = filter_snowc(fc) + h2osno(c) = 0._r8 + snowdp(c) = 0._r8 + zwice(c) = 0._r8 + zwliq(c) = 0._r8 + end do + + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + snowdp(c) = snowdp(c) + dz(c,j) + zwice(c) = zwice(c) + h2osoi_ice(c,j) + zwliq(c) = zwliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Check the snow depth - all snow gone + ! The liquid water assumes ponding on soil surface. + + do fc = 1, num_snowc + c = filter_snowc(fc) + l = clandunit(c) + if (snowdp(c) < 0.01_r8 .and. snowdp(c) > 0._r8) then + snl(c) = 0 + h2osno(c) = zwice(c) + + mss_bcphi(c,:) = 0._r8 + mss_bcpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_ocpho(c,:) = 0._r8 + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + + if (h2osno(c) <= 0._r8) snowdp(c) = 0._r8 + if (ltype(l) == istsoil .or. ltype(l) == isturb .or. ltype(l) == istcrop) then + h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c) + end if + end if + end do + + ! Check the snow depth - snow layers combined + ! The following loop IS NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + + ! Two or more layers + + if (snl(c) < -1) then + + msn_old(c) = snl(c) + mssi(c) = 1 + + do i = msn_old(c)+1,0 + if (dz(c,i) < dzmin(mssi(c))) then + + if (i == snl(c)+1) then + ! If top node is removed, combine with bottom neighbor. + neibor = i + 1 + else if (i == 0) then + ! If the bottom neighbor is not snow, combine with the top neighbor. + neibor = i - 1 + else + ! If none of the above special cases apply, combine with the thinnest neighbor + neibor = i + 1 + if ((dz(c,i-1)+dz(c,i)) < (dz(c,i+1)+dz(c,i))) neibor = i-1 + end if + + ! Node l and j are combined and stored as node j. + if (neibor > i) then + j = neibor + l = i + else + j = i + l = neibor + end if + + ! this should be included in 'Combo' for consistency, + ! but functionally it is the same to do it here + mss_bcphi(c,j)=mss_bcphi(c,j)+mss_bcphi(c,l) + mss_bcpho(c,j)=mss_bcpho(c,j)+mss_bcpho(c,l) + mss_ocphi(c,j)=mss_ocphi(c,j)+mss_ocphi(c,l) + mss_ocpho(c,j)=mss_ocpho(c,j)+mss_ocpho(c,l) + mss_dst1(c,j)=mss_dst1(c,j)+mss_dst1(c,l) + mss_dst2(c,j)=mss_dst2(c,j)+mss_dst2(c,l) + mss_dst3(c,j)=mss_dst3(c,j)+mss_dst3(c,l) + mss_dst4(c,j)=mss_dst4(c,j)+mss_dst4(c,l) + ! mass-weighted combination of effective grain size: + snw_rds(c,j) = (snw_rds(c,j)*(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + & + snw_rds(c,l)*(h2osoi_liq(c,l)+h2osoi_ice(c,l))) / & + (h2osoi_liq(c,j)+h2osoi_ice(c,j)+h2osoi_liq(c,l)+h2osoi_ice(c,l)) + + call Combo (dz(c,j), h2osoi_liq(c,j), h2osoi_ice(c,j), & + t_soisno(c,j), dz(c,l), h2osoi_liq(c,l), h2osoi_ice(c,l), t_soisno(c,l) ) + + ! Now shift all elements above this down one. + if (j-1 > snl(c)+1) then + do k = j-1, snl(c)+2, -1 + t_soisno(c,k) = t_soisno(c,k-1) + h2osoi_ice(c,k) = h2osoi_ice(c,k-1) + h2osoi_liq(c,k) = h2osoi_liq(c,k-1) + + mss_bcphi(c,k) = mss_bcphi(c,k-1) + mss_bcpho(c,k) = mss_bcpho(c,k-1) + mss_ocphi(c,k) = mss_ocphi(c,k-1) + mss_ocpho(c,k) = mss_ocpho(c,k-1) + mss_dst1(c,k) = mss_dst1(c,k-1) + mss_dst2(c,k) = mss_dst2(c,k-1) + mss_dst3(c,k) = mss_dst3(c,k-1) + mss_dst4(c,k) = mss_dst4(c,k-1) + snw_rds(c,k) = snw_rds(c,k-1) + + dz(c,k) = dz(c,k-1) + end do + end if + + ! Decrease the number of snow layers + snl(c) = snl(c) + 1 + if (snl(c) >= -1) EXIT + + else + + ! The layer thickness is greater than the prescribed minimum value + mssi(c) = mssi(c) + 1 + + end if + end do + + end if + + end do + + ! Reset the node depth and the depth of layer interface + + do j = 0, -nlevsno+1, -1 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c) + 1) then + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end subroutine CombineSnowLayers + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: DivideSnowLayers +! +! !INTERFACE: + subroutine DivideSnowLayers(lbc, ubc, num_snowc, filter_snowc) +! +! !DESCRIPTION: +! Subdivides snow layers if they exceed their prescribed maximum thickness. +! +! !USES: + use clmtype + use clm_varcon, only : tfrz +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(inout) :: num_snowc ! number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points +! +! !CALLED FROM: +! subroutine Hydrology2 in module Hydrology2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/28/02, Peter Thornton: Migrated to new data structures. +! 2/29/08, David Lawrence: Snowpack T profile maintained during layer splitting +! 03/28/08, Mark Flanner: Added aerosol masses and snow grain radius +! +! !LOCAL VARIABLES: +! +! local pointers to implicit inout arguments +! + integer , pointer :: snl(:) !number of snow layers + real(r8), pointer :: dz(:,:) !layer depth (m) + real(r8), pointer :: zi(:,:) !interface level below a "z" level (m) + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: z(:,:) ! layer thickness (m) + real(r8), pointer :: mss_bcphi(:,:) ! hydrophilic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcpho(:,:) ! hydrophobic BC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! hydrophilic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocpho(:,:) ! hydrophobic OC mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst1(:,:) ! dust species 1 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! dust species 2 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! dust species 3 mass in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! dust species 4 mass in snow (col,lyr) [kg] + real(r8), pointer :: snw_rds(:,:) ! effective snow grain radius (col,lyr) [microns, m^-6] +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: j, c, fc ! indices + real(r8) :: drr ! thickness of the combined [m] + integer :: msno ! number of snow layer 1 (top) to msno (bottom) + real(r8) :: dzsno(lbc:ubc,nlevsno) ! Snow layer thickness [m] + real(r8) :: swice(lbc:ubc,nlevsno) ! Partial volume of ice [m3/m3] + real(r8) :: swliq(lbc:ubc,nlevsno) ! Partial volume of liquid water [m3/m3] + real(r8) :: tsno(lbc:ubc ,nlevsno) ! Nodel temperature [K] + real(r8) :: zwice ! temporary + real(r8) :: zwliq ! temporary + real(r8) :: propor ! temporary + real(r8) :: dtdz ! temporary + + ! temporary variables mimicking the structure of other layer division variables + real(r8) :: mbc_phi(lbc:ubc,nlevsno) ! mass of BC in each snow layer + real(r8) :: zmbc_phi ! temporary + real(r8) :: mbc_pho(lbc:ubc,nlevsno) ! mass of BC in each snow layer + real(r8) :: zmbc_pho ! temporary + real(r8) :: moc_phi(lbc:ubc,nlevsno) ! mass of OC in each snow layer + real(r8) :: zmoc_phi ! temporary + real(r8) :: moc_pho(lbc:ubc,nlevsno) ! mass of OC in each snow layer + real(r8) :: zmoc_pho ! temporary + real(r8) :: mdst1(lbc:ubc,nlevsno) ! mass of dust 1 in each snow layer + real(r8) :: zmdst1 ! temporary + real(r8) :: mdst2(lbc:ubc,nlevsno) ! mass of dust 2 in each snow layer + real(r8) :: zmdst2 ! temporary + real(r8) :: mdst3(lbc:ubc,nlevsno) ! mass of dust 3 in each snow layer + real(r8) :: zmdst3 ! temporary + real(r8) :: mdst4(lbc:ubc,nlevsno) ! mass of dust 4 in each snow layer + real(r8) :: zmdst4 ! temporary + real(r8) :: rds(lbc:ubc,nlevsno) + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtype components (column-level) + + snl => cps%snl + dz => cps%dz + zi => cps%zi + z => cps%z + t_soisno => ces%t_soisno + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + mss_bcphi => cps%mss_bcphi + mss_bcpho => cps%mss_bcpho + mss_ocphi => cps%mss_ocphi + mss_ocpho => cps%mss_ocpho + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + snw_rds => cps%snw_rds + + + ! Begin calculation - note that the following column loops are only invoked + ! for snow-covered columns + + do j = 1,nlevsno + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j <= abs(snl(c))) then + dzsno(c,j) = dz(c,j+snl(c)) + swice(c,j) = h2osoi_ice(c,j+snl(c)) + swliq(c,j) = h2osoi_liq(c,j+snl(c)) + tsno(c,j) = t_soisno(c,j+snl(c)) + + mbc_phi(c,j) = mss_bcphi(c,j+snl(c)) + mbc_pho(c,j) = mss_bcpho(c,j+snl(c)) + moc_phi(c,j) = mss_ocphi(c,j+snl(c)) + moc_pho(c,j) = mss_ocpho(c,j+snl(c)) + mdst1(c,j) = mss_dst1(c,j+snl(c)) + mdst2(c,j) = mss_dst2(c,j+snl(c)) + mdst3(c,j) = mss_dst3(c,j+snl(c)) + mdst4(c,j) = mss_dst4(c,j+snl(c)) + rds(c,j) = snw_rds(c,j+snl(c)) + + end if + end do + end do + + do fc = 1, num_snowc + c = filter_snowc(fc) + + msno = abs(snl(c)) + + if (msno == 1) then + ! Specify a new snow layer + if (dzsno(c,1) > 0.03_r8) then + msno = 2 + dzsno(c,1) = dzsno(c,1)/2._r8 + swice(c,1) = swice(c,1)/2._r8 + swliq(c,1) = swliq(c,1)/2._r8 + dzsno(c,2) = dzsno(c,1) + swice(c,2) = swice(c,1) + swliq(c,2) = swliq(c,1) + tsno(c,2) = tsno(c,1) + + mbc_phi(c,1) = mbc_phi(c,1)/2._r8 + mbc_phi(c,2) = mbc_phi(c,1) + mbc_pho(c,1) = mbc_pho(c,1)/2._r8 + mbc_pho(c,2) = mbc_pho(c,1) + moc_phi(c,1) = moc_phi(c,1)/2._r8 + moc_phi(c,2) = moc_phi(c,1) + moc_pho(c,1) = moc_pho(c,1)/2._r8 + moc_pho(c,2) = moc_pho(c,1) + mdst1(c,1) = mdst1(c,1)/2._r8 + mdst1(c,2) = mdst1(c,1) + mdst2(c,1) = mdst2(c,1)/2._r8 + mdst2(c,2) = mdst2(c,1) + mdst3(c,1) = mdst3(c,1)/2._r8 + mdst3(c,2) = mdst3(c,1) + mdst4(c,1) = mdst4(c,1)/2._r8 + mdst4(c,2) = mdst4(c,1) + rds(c,2) = rds(c,1) + + end if + end if + + if (msno > 1) then + if (dzsno(c,1) > 0.02_r8) then + drr = dzsno(c,1) - 0.02_r8 + propor = drr/dzsno(c,1) + zwice = propor*swice(c,1) + zwliq = propor*swliq(c,1) + + zmbc_phi = propor*mbc_phi(c,1) + zmbc_pho = propor*mbc_pho(c,1) + zmoc_phi = propor*moc_phi(c,1) + zmoc_pho = propor*moc_pho(c,1) + zmdst1 = propor*mdst1(c,1) + zmdst2 = propor*mdst2(c,1) + zmdst3 = propor*mdst3(c,1) + zmdst4 = propor*mdst4(c,1) + + propor = 0.02_r8/dzsno(c,1) + swice(c,1) = propor*swice(c,1) + swliq(c,1) = propor*swliq(c,1) + + mbc_phi(c,1) = propor*mbc_phi(c,1) + mbc_pho(c,1) = propor*mbc_pho(c,1) + moc_phi(c,1) = propor*moc_phi(c,1) + moc_pho(c,1) = propor*moc_pho(c,1) + mdst1(c,1) = propor*mdst1(c,1) + mdst2(c,1) = propor*mdst2(c,1) + mdst3(c,1) = propor*mdst3(c,1) + mdst4(c,1) = propor*mdst4(c,1) + + dzsno(c,1) = 0.02_r8 + + mbc_phi(c,2) = mbc_phi(c,2)+zmbc_phi ! (combo) + mbc_pho(c,2) = mbc_pho(c,2)+zmbc_pho ! (combo) + moc_phi(c,2) = moc_phi(c,2)+zmoc_phi ! (combo) + moc_pho(c,2) = moc_pho(c,2)+zmoc_pho ! (combo) + mdst1(c,2) = mdst1(c,2)+zmdst1 ! (combo) + mdst2(c,2) = mdst2(c,2)+zmdst2 ! (combo) + mdst3(c,2) = mdst3(c,2)+zmdst3 ! (combo) + mdst4(c,2) = mdst4(c,2)+zmdst4 ! (combo) + rds(c,2) = rds(c,1) ! (combo) + + call Combo (dzsno(c,2), swliq(c,2), swice(c,2), tsno(c,2), drr, & + zwliq, zwice, tsno(c,1)) + + ! Subdivide a new layer + if (msno <= 2 .and. dzsno(c,2) > 0.07_r8) then + msno = 3 + dtdz = (tsno(c,1) - tsno(c,2))/((dzsno(c,1)+dzsno(c,2))/2._r8) + dzsno(c,2) = dzsno(c,2)/2._r8 + swice(c,2) = swice(c,2)/2._r8 + swliq(c,2) = swliq(c,2)/2._r8 + dzsno(c,3) = dzsno(c,2) + swice(c,3) = swice(c,2) + swliq(c,3) = swliq(c,2) + tsno(c,3) = tsno(c,2) - dtdz*dzsno(c,2)/2._r8 + if (tsno(c,3) >= tfrz) then + tsno(c,3) = tsno(c,2) + else + tsno(c,2) = tsno(c,2) + dtdz*dzsno(c,2)/2._r8 + endif + + mbc_phi(c,2) = mbc_phi(c,2)/2._r8 + mbc_phi(c,3) = mbc_phi(c,2) + mbc_pho(c,2) = mbc_pho(c,2)/2._r8 + mbc_pho(c,3) = mbc_pho(c,2) + moc_phi(c,2) = moc_phi(c,2)/2._r8 + moc_phi(c,3) = moc_phi(c,2) + moc_pho(c,2) = moc_pho(c,2)/2._r8 + moc_pho(c,3) = moc_pho(c,2) + mdst1(c,2) = mdst1(c,2)/2._r8 + mdst1(c,3) = mdst1(c,2) + mdst2(c,2) = mdst2(c,2)/2._r8 + mdst2(c,3) = mdst2(c,2) + mdst3(c,2) = mdst3(c,2)/2._r8 + mdst3(c,3) = mdst3(c,2) + mdst4(c,2) = mdst4(c,2)/2._r8 + mdst4(c,3) = mdst4(c,2) + rds(c,3) = rds(c,2) + + end if + end if + end if + + if (msno > 2) then + if (dzsno(c,2) > 0.05_r8) then + drr = dzsno(c,2) - 0.05_r8 + propor = drr/dzsno(c,2) + zwice = propor*swice(c,2) + zwliq = propor*swliq(c,2) + + zmbc_phi = propor*mbc_phi(c,2) + zmbc_pho = propor*mbc_pho(c,2) + zmoc_phi = propor*moc_phi(c,2) + zmoc_pho = propor*moc_pho(c,2) + zmdst1 = propor*mdst1(c,2) + zmdst2 = propor*mdst2(c,2) + zmdst3 = propor*mdst3(c,2) + zmdst4 = propor*mdst4(c,2) + + propor = 0.05_r8/dzsno(c,2) + swice(c,2) = propor*swice(c,2) + swliq(c,2) = propor*swliq(c,2) + + mbc_phi(c,2) = propor*mbc_phi(c,2) + mbc_pho(c,2) = propor*mbc_pho(c,2) + moc_phi(c,2) = propor*moc_phi(c,2) + moc_pho(c,2) = propor*moc_pho(c,2) + mdst1(c,2) = propor*mdst1(c,2) + mdst2(c,2) = propor*mdst2(c,2) + mdst3(c,2) = propor*mdst3(c,2) + mdst4(c,2) = propor*mdst4(c,2) + + dzsno(c,2) = 0.05_r8 + + mbc_phi(c,3) = mbc_phi(c,3)+zmbc_phi ! (combo) + mbc_pho(c,3) = mbc_pho(c,3)+zmbc_pho ! (combo) + moc_phi(c,3) = moc_phi(c,3)+zmoc_phi ! (combo) + moc_pho(c,3) = moc_pho(c,3)+zmoc_pho ! (combo) + mdst1(c,3) = mdst1(c,3)+zmdst1 ! (combo) + mdst2(c,3) = mdst2(c,3)+zmdst2 ! (combo) + mdst3(c,3) = mdst3(c,3)+zmdst3 ! (combo) + mdst4(c,3) = mdst4(c,3)+zmdst4 ! (combo) + rds(c,3) = rds(c,2) ! (combo) + + call Combo (dzsno(c,3), swliq(c,3), swice(c,3), tsno(c,3), drr, & + zwliq, zwice, tsno(c,2)) + + ! Subdivided a new layer + if (msno <= 3 .and. dzsno(c,3) > 0.18_r8) then + msno = 4 + dtdz = (tsno(c,2) - tsno(c,3))/((dzsno(c,2)+dzsno(c,3))/2._r8) + dzsno(c,3) = dzsno(c,3)/2._r8 + swice(c,3) = swice(c,3)/2._r8 + swliq(c,3) = swliq(c,3)/2._r8 + dzsno(c,4) = dzsno(c,3) + swice(c,4) = swice(c,3) + swliq(c,4) = swliq(c,3) + tsno(c,4) = tsno(c,3) - dtdz*dzsno(c,3)/2._r8 + if (tsno(c,4) >= tfrz) then + tsno(c,4) = tsno(c,3) + else + tsno(c,3) = tsno(c,3) + dtdz*dzsno(c,3)/2._r8 + endif + + mbc_phi(c,3) = mbc_phi(c,3)/2._r8 + mbc_phi(c,4) = mbc_phi(c,3) + mbc_pho(c,3) = mbc_pho(c,3)/2._r8 + mbc_pho(c,4) = mbc_pho(c,3) + moc_phi(c,3) = moc_phi(c,3)/2._r8 + moc_phi(c,4) = moc_phi(c,3) + moc_pho(c,3) = moc_pho(c,3)/2._r8 + moc_pho(c,4) = moc_pho(c,3) + mdst1(c,3) = mdst1(c,3)/2._r8 + mdst1(c,4) = mdst1(c,3) + mdst2(c,3) = mdst2(c,3)/2._r8 + mdst2(c,4) = mdst2(c,3) + mdst3(c,3) = mdst3(c,3)/2._r8 + mdst3(c,4) = mdst3(c,3) + mdst4(c,3) = mdst4(c,3)/2._r8 + mdst4(c,4) = mdst4(c,3) + rds(c,4) = rds(c,3) + + end if + end if + end if + + if (msno > 3) then + if (dzsno(c,3) > 0.11_r8) then + drr = dzsno(c,3) - 0.11_r8 + propor = drr/dzsno(c,3) + zwice = propor*swice(c,3) + zwliq = propor*swliq(c,3) + + zmbc_phi = propor*mbc_phi(c,3) + zmbc_pho = propor*mbc_pho(c,3) + zmoc_phi = propor*moc_phi(c,3) + zmoc_pho = propor*moc_pho(c,3) + zmdst1 = propor*mdst1(c,3) + zmdst2 = propor*mdst2(c,3) + zmdst3 = propor*mdst3(c,3) + zmdst4 = propor*mdst4(c,3) + + propor = 0.11_r8/dzsno(c,3) + swice(c,3) = propor*swice(c,3) + swliq(c,3) = propor*swliq(c,3) + + mbc_phi(c,3) = propor*mbc_phi(c,3) + mbc_pho(c,3) = propor*mbc_pho(c,3) + moc_phi(c,3) = propor*moc_phi(c,3) + moc_pho(c,3) = propor*moc_pho(c,3) + mdst1(c,3) = propor*mdst1(c,3) + mdst2(c,3) = propor*mdst2(c,3) + mdst3(c,3) = propor*mdst3(c,3) + mdst4(c,3) = propor*mdst4(c,3) + + dzsno(c,3) = 0.11_r8 + + mbc_phi(c,4) = mbc_phi(c,4)+zmbc_phi ! (combo) + mbc_pho(c,4) = mbc_pho(c,4)+zmbc_pho ! (combo) + moc_phi(c,4) = moc_phi(c,4)+zmoc_phi ! (combo) + moc_pho(c,4) = moc_pho(c,4)+zmoc_pho ! (combo) + mdst1(c,4) = mdst1(c,4)+zmdst1 ! (combo) + mdst2(c,4) = mdst2(c,4)+zmdst2 ! (combo) + mdst3(c,4) = mdst3(c,4)+zmdst3 ! (combo) + mdst4(c,4) = mdst4(c,4)+zmdst4 ! (combo) + rds(c,4) = rds(c,3) ! (combo) + + call Combo (dzsno(c,4), swliq(c,4), swice(c,4), tsno(c,4), drr, & + zwliq, zwice, tsno(c,3)) + + ! Subdivided a new layer + if (msno <= 4 .and. dzsno(c,4) > 0.41_r8) then + msno = 5 + dtdz = (tsno(c,3) - tsno(c,4))/((dzsno(c,3)+dzsno(c,4))/2._r8) + dzsno(c,4) = dzsno(c,4)/2._r8 + swice(c,4) = swice(c,4)/2._r8 + swliq(c,4) = swliq(c,4)/2._r8 + dzsno(c,5) = dzsno(c,4) + swice(c,5) = swice(c,4) + swliq(c,5) = swliq(c,4) + tsno(c,5) = tsno(c,4) - dtdz*dzsno(c,4)/2._r8 + if (tsno(c,5) >= tfrz) then + tsno(c,5) = tsno(c,4) + else + tsno(c,4) = tsno(c,4) + dtdz*dzsno(c,4)/2._r8 + endif + + mbc_phi(c,4) = mbc_phi(c,4)/2._r8 + mbc_phi(c,5) = mbc_phi(c,4) + mbc_pho(c,4) = mbc_pho(c,4)/2._r8 + mbc_pho(c,5) = mbc_pho(c,4) + moc_phi(c,4) = moc_phi(c,4)/2._r8 + moc_phi(c,5) = moc_phi(c,4) + moc_pho(c,4) = moc_pho(c,4)/2._r8 + moc_pho(c,5) = moc_pho(c,4) + mdst1(c,4) = mdst1(c,4)/2._r8 + mdst1(c,5) = mdst1(c,4) + mdst2(c,4) = mdst2(c,4)/2._r8 + mdst2(c,5) = mdst2(c,4) + mdst3(c,4) = mdst3(c,4)/2._r8 + mdst3(c,5) = mdst3(c,4) + mdst4(c,4) = mdst4(c,4)/2._r8 + mdst4(c,5) = mdst4(c,4) + rds(c,5) = rds(c,4) + + end if + end if + end if + + if (msno > 4) then + if (dzsno(c,4) > 0.23_r8) then + drr = dzsno(c,4) - 0.23_r8 + propor = drr/dzsno(c,4) + zwice = propor*swice(c,4) + zwliq = propor*swliq(c,4) + + zmbc_phi = propor*mbc_phi(c,4) + zmbc_pho = propor*mbc_pho(c,4) + zmoc_phi = propor*moc_phi(c,4) + zmoc_pho = propor*moc_pho(c,4) + zmdst1 = propor*mdst1(c,4) + zmdst2 = propor*mdst2(c,4) + zmdst3 = propor*mdst3(c,4) + zmdst4 = propor*mdst4(c,4) + + propor = 0.23_r8/dzsno(c,4) + swice(c,4) = propor*swice(c,4) + swliq(c,4) = propor*swliq(c,4) + + mbc_phi(c,4) = propor*mbc_phi(c,4) + mbc_pho(c,4) = propor*mbc_pho(c,4) + moc_phi(c,4) = propor*moc_phi(c,4) + moc_pho(c,4) = propor*moc_pho(c,4) + mdst1(c,4) = propor*mdst1(c,4) + mdst2(c,4) = propor*mdst2(c,4) + mdst3(c,4) = propor*mdst3(c,4) + mdst4(c,4) = propor*mdst4(c,4) + + dzsno(c,4) = 0.23_r8 + + mbc_phi(c,5) = mbc_phi(c,5)+zmbc_phi ! (combo) + mbc_pho(c,5) = mbc_pho(c,5)+zmbc_pho ! (combo) + moc_phi(c,5) = moc_phi(c,5)+zmoc_phi ! (combo) + moc_pho(c,5) = moc_pho(c,5)+zmoc_pho ! (combo) + mdst1(c,5) = mdst1(c,5)+zmdst1 ! (combo) + mdst2(c,5) = mdst2(c,5)+zmdst2 ! (combo) + mdst3(c,5) = mdst3(c,5)+zmdst3 ! (combo) + mdst4(c,5) = mdst4(c,5)+zmdst4 ! (combo) + rds(c,5) = rds(c,4) ! (combo) + + call Combo (dzsno(c,5), swliq(c,5), swice(c,5), tsno(c,5), drr, & + zwliq, zwice, tsno(c,4)) + end if + end if + + snl(c) = -msno + + end do + + do j = -nlevsno+1,0 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + dz(c,j) = dzsno(c,j-snl(c)) + h2osoi_ice(c,j) = swice(c,j-snl(c)) + h2osoi_liq(c,j) = swliq(c,j-snl(c)) + t_soisno(c,j) = tsno(c,j-snl(c)) + + mss_bcphi(c,j) = mbc_phi(c,j-snl(c)) + mss_bcpho(c,j) = mbc_pho(c,j-snl(c)) + mss_ocphi(c,j) = moc_phi(c,j-snl(c)) + mss_ocpho(c,j) = moc_pho(c,j-snl(c)) + mss_dst1(c,j) = mdst1(c,j-snl(c)) + mss_dst2(c,j) = mdst2(c,j-snl(c)) + mss_dst3(c,j) = mdst3(c,j-snl(c)) + mss_dst4(c,j) = mdst4(c,j-snl(c)) + snw_rds(c,j) = rds(c,j-snl(c)) + + end if + end do + end do + + do j = 0, -nlevsno+1, -1 + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end subroutine DivideSnowLayers + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Combo +! +! !INTERFACE: + subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) +! +! !DESCRIPTION: +! Combines two elements and returns the following combined +! variables: dz, t, wliq, wice. +! The combined temperature is based on the equation: +! the sum of the enthalpies of the two elements = +! that of the combined element. +! +! !USES: + use clm_varcon, only : cpice, cpliq, tfrz, hfus +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] + real(r8), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] + real(r8), intent(in) :: wice2 ! ice of element 2 [kg/m2] + real(r8), intent(in) :: t2 ! nodal temperature of element 2 [K] + real(r8), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] + real(r8), intent(inout) :: wliq ! liquid water of element 1 + real(r8), intent(inout) :: wice ! ice of element 1 [kg/m2] + real(r8), intent(inout) :: t ! nodel temperature of elment 1 [K] +! +! !CALLED FROM: +! subroutine CombineSnowLayers in this module +! subroutine DivideSnowLayers in this module +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! +! +! !LOCAL VARIABLES: +!EOP +! + real(r8) :: dzc ! Total thickness of nodes 1 and 2 (dzc=dz+dz2). + real(r8) :: wliqc ! Combined liquid water [kg/m2] + real(r8) :: wicec ! Combined ice [kg/m2] + real(r8) :: tc ! Combined node temperature [K] + real(r8) :: h ! enthalpy of element 1 [J/m2] + real(r8) :: h2 ! enthalpy of element 2 [J/m2] + real(r8) :: hc ! temporary +!----------------------------------------------------------------------- + + dzc = dz+dz2 + wicec = (wice+wice2) + wliqc = (wliq+wliq2) + h = (cpice*wice+cpliq*wliq) * (t-tfrz)+hfus*wliq + h2= (cpice*wice2+cpliq*wliq2) * (t2-tfrz)+hfus*wliq2 + + hc = h + h2 + tc = tfrz + (hc - hfus*wliqc) / (cpice*wicec + cpliq*wliqc) + + dz = dzc + wice = wicec + wliq = wliqc + t = tc + + end subroutine Combo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: BuildSnowFilter +! +! !INTERFACE: + subroutine BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec, & + num_snowc, filter_snowc, & + num_nosnowc, filter_nosnowc) +! +! !DESCRIPTION: +! Constructs snow filter for use in vectorized loops for snow hydrology. +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(out) :: num_snowc ! number of column snow points in column filter + integer, intent(out) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(out) :: num_nosnowc ! number of column non-snow points in column filter + integer, intent(out) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points +! +! !CALLED FROM: +! subroutine Hydrology2 in Hydrology2Mod +! subroutine CombineSnowLayers in this module +! +! !REVISION HISTORY: +! 2003 July 31: Forrest Hoffman +! +! !LOCAL VARIABLES: +! local pointers to implicit in arguments + integer , pointer :: snl(:) ! number of snow layers +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: fc, c +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtype components (column-level) + + snl => cps%snl + + ! Build snow/no-snow filters for other subroutines + + num_snowc = 0 + num_nosnowc = 0 + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (snl(c) < 0) then + num_snowc = num_snowc + 1 + filter_snowc(num_snowc) = c + else + num_nosnowc = num_nosnowc + 1 + filter_nosnowc(num_nosnowc) = c + end if + end do + + end subroutine BuildSnowFilter + +end module SnowHydrologyMod diff --git a/components/clm/src_clm40/biogeophys/SoilHydrologyMod.F90 b/components/clm/src_clm40/biogeophys/SoilHydrologyMod.F90 new file mode 100644 index 0000000000..e490e13542 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SoilHydrologyMod.F90 @@ -0,0 +1,1243 @@ +module SoilHydrologyMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SoilHydrologyMod +! +! !DESCRIPTION: +! Calculate soil hydrology +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceRunoff ! Calculate surface runoff + public :: Infiltration ! Calculate infiltration into surface soil layer + public :: SoilWater ! Calculate soil hydrology + public :: Drainage ! Calculate subsurface drainage +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 04/25/07 Keith Oleson: CLM3.5 hydrology +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SurfaceRunoff +! +! !INTERFACE: + subroutine SurfaceRunoff (lbc, ubc, lbp, ubp, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, vol_liq, icefrac) +! +! !DESCRIPTION: +! Calculate surface runoff +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_varcon , only : denice, denh2o, wimp, pondmx_urban, & + icol_roof, icol_sunwall, icol_shadewall, & + icol_road_imperv, icol_road_perv + + use clm_varpar , only : nlevsoi, maxpatch_pft + use clm_time_manager, only : get_step_size +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: lbp, ubp ! pft bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! column filter for urban points + real(r8), intent(out) :: vol_liq(lbc:ubc,1:nlevsoi) ! partial volume of liquid water in layer + real(r8), intent(out) :: icefrac(lbc:ubc,1:nlevsoi) ! fraction of ice in layer (-) +! +! !CALLED FROM: +! subroutine Hydrology2 in module Hydrology2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 12 November 1999: Z.-L. Yang and G.-Y. Niu +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/26/02, Peter Thornton: Migrated to new data structures. +! 4/26/05, David Lawrence: Made surface runoff for dry soils a function +! of rooting fraction in top three soil layers. +! 04/25/07 Keith Oleson: Completely new routine for CLM3.5 hydrology +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! +!rtm_flood + real(r8), pointer :: qflx_floodc(:) ! column flux of flood water from RTM +!rtm_flood + integer , pointer :: cgridcell(:) ! gridcell index for each column + integer , pointer :: ctype(:) ! column type index + real(r8), pointer :: qflx_top_soil(:) !net water input into soil from top (mm/s) + real(r8), pointer :: watsat(:,:) !volumetric soil water at saturation (porosity) + real(r8), pointer :: hkdepth(:) !decay factor (m) + real(r8), pointer :: zwt(:) !water table depth (m) + real(r8), pointer :: fcov(:) !fractional impermeable area + real(r8), pointer :: fsat(:) !fractional area with water table at surface + real(r8), pointer :: dz(:,:) !layer depth (m) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) + real(r8), pointer :: wtfact(:) !maximum saturated fraction for a gridcell + real(r8), pointer :: hksat(:,:) ! hydraulic conductivity at saturation (mm H2O /s) + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) + integer , pointer :: snl(:) ! minus number of snow layers + real(r8), pointer :: qflx_evap_grnd(:) ! ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: qflx_surf(:) ! surface runoff (mm H2O /s) + real(r8), pointer :: eff_porosity(:,:) ! effective porosity = porosity - vol_ice + real(r8), pointer :: fracice(:,:) !fractional impermeability (-) +! +!EOP +! +! !OTHER LOCAL VARIABLES: +! + integer :: c,j,fc,g !indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: xs(lbc:ubc) ! excess soil water above urban ponding limit + real(r8) :: vol_ice(lbc:ubc,1:nlevsoi) !partial volume of ice lens in layer + real(r8) :: fff(lbc:ubc) !decay factor (m-1) + real(r8) :: s1 !variable to calculate qinmax + real(r8) :: su !variable to calculate qinmax + real(r8) :: v !variable to calculate qinmax + real(r8) :: qinmax !maximum infiltration capacity (mm/s) + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtype components (column-level) + +!rtm_flood + qflx_floodc => cwf%qflx_floodc +!rtm_flood + ctype => col%itype + qflx_top_soil => cwf%qflx_top_soil + qflx_surf => cwf%qflx_surf + watsat => cps%watsat + hkdepth => cps%hkdepth + dz => cps%dz + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + fcov => cws%fcov + fsat => cws%fsat + eff_porosity => cps%eff_porosity + wtfact => cps%wtfact + zwt => cws%zwt + fracice => cps%fracice + hksat => cps%hksat + bsw => cps%bsw + sucsat => cps%sucsat + snl => cps%snl + qflx_evap_grnd => pwf_a%qflx_evap_grnd + zi => cps%zi + + ! Get time step + + dtime = get_step_size() + + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Porosity of soil, partial volume of ice and liquid, fraction of ice in each layer, + ! fractional impermeability + + vol_ice(c,j) = min(watsat(c,j), h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity(c,j) = max(0.01_r8,watsat(c,j)-vol_ice(c,j)) + vol_liq(c,j) = min(eff_porosity(c,j), h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + + icefrac(c,j) = min(1._r8,h2osoi_ice(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j))) + + fracice(c,j) = max(0._r8,exp(-3._r8*(1._r8-icefrac(c,j)))- exp(-3._r8))/(1.0_r8-exp(-3._r8)) + end do + end do + + ! Saturated fraction + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + fff(c) = 0.5_r8 + fsat(c) = wtfact(c) * exp(-0.5_r8*fff(c)*zwt(c)) + fcov(c) = (1._r8 - fracice(c,1)) * fsat(c) + fracice(c,1) + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Maximum infiltration capacity + s1 = max(0.01_r8,vol_liq(c,1)/max(wimp,eff_porosity(c,1))) + su = max(0._r8,(s1-fcov(c)) / (max(0.01_r8,1._r8-fcov(c)))) + v = -bsw(c,1)*sucsat(c,1)/(0.5_r8*dz(c,1)*1000._r8) + qinmax = (1._r8+v*(su-1._r8))*hksat(c,1) + + ! Surface runoff + qflx_surf(c) = fcov(c) * qflx_top_soil(c) + & + (1._r8-fcov(c)) * max(0._r8, qflx_top_soil(c)-qinmax) + + end do + + ! Determine water in excess of ponding limit for urban roof and impervious road. + ! Excess goes to surface runoff. No surface runoff for sunwall and shadewall. + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then + + ! If there are snow layers then all qflx_top_soil goes to surface runoff + if (snl(c) < 0) then + qflx_surf(c) = max(0._r8,qflx_top_soil(c)) + else + xs(c) = max(0._r8, & + h2osoi_liq(c,1)/dtime + qflx_top_soil(c) - qflx_evap_grnd(c) - & + pondmx_urban/dtime) + if (xs(c) > 0.) then + h2osoi_liq(c,1) = pondmx_urban + else + h2osoi_liq(c,1) = max(0._r8,h2osoi_liq(c,1)+ & + (qflx_top_soil(c)-qflx_evap_grnd(c))*dtime) + end if + qflx_surf(c) = xs(c) + end if + else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall) then + qflx_surf(c) = 0._r8 + end if +!rtm_flood: send flood water flux to runoff for all urban columns + qflx_surf(c) = qflx_surf(c) + qflx_floodc(c) +!rtm_flood + end do + +!rtm_flood: add qflx_flood to qflx_top_soil +!dir$ concurrent +!cdir nodep + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_top_soil(c) = qflx_top_soil(c) + qflx_floodc(c) + end do + end subroutine SurfaceRunoff + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Infiltration +! +! !INTERFACE: + subroutine Infiltration(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc) +! +! !DESCRIPTION: +! Calculate infiltration into surface soil layer (minus the evaporation) +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varcon , only : icol_roof, icol_road_imperv, icol_sunwall, icol_shadewall, & + icol_road_perv + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer, intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points + integer, intent(in) :: num_urbanc ! number of column urban points in column filter + integer, intent(in) :: filter_urbanc(ubc-lbc+1) ! column filter for urban points +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 12 November 1999: Z.-L. Yang and G.-Y. Niu +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/27/02, Peter Thornton: Migrated to new data structures. +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: ctype(:) ! column type index + integer , pointer :: snl(:) ! minus number of snow layers + real(r8), pointer :: qflx_top_soil(:) ! net water input into soil from top (mm/s) + real(r8), pointer :: qflx_surf(:) ! surface runoff (mm H2O /s) + real(r8), pointer :: qflx_evap_grnd(:)! ground surface evaporation rate (mm H2O/s) [+] +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: qflx_infl(:) !infiltration (mm H2O /s) +! +!EOP +! +! !OTHER LOCAL VARIABLES: +! + integer :: c, fc !indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (column-level) + + ctype => col%itype + snl => cps%snl + qflx_top_soil => cwf%qflx_top_soil + qflx_surf => cwf%qflx_surf + qflx_infl => cwf%qflx_infl + qflx_evap_grnd => pwf_a%qflx_evap_grnd + + ! Infiltration into surface soil layer (minus the evaporation) + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (snl(c) >= 0) then + qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) - qflx_evap_grnd(c) + else + qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) + end if + end do + + ! No infiltration for impervious urban surfaces + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (ctype(c) /= icol_road_perv) then + qflx_infl(c) = 0._r8 + end if + end do + + end subroutine Infiltration + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SoilWater +! +! !INTERFACE: + subroutine SoilWater(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, & + vol_liq, dwat, hk, dhkdw) +! +! !DESCRIPTION: +! Soil hydrology +! Soil moisture is predicted from a 10-layer model (as with soil +! temperature), in which the vertical soil moisture transport is governed +! by infiltration, runoff, gradient diffusion, gravity, and root +! extraction through canopy transpiration. The net water applied to the +! surface layer is the snowmelt plus precipitation plus the throughfall +! of canopy dew minus surface runoff and evaporation. +! CLM3.5 uses a zero-flow bottom boundary condition. +! +! The vertical water flow in an unsaturated porous media is described by +! Darcy's law, and the hydraulic conductivity and the soil negative +! potential vary with soil water content and soil texture based on the work +! of Clapp and Hornberger (1978) and Cosby et al. (1984). The equation is +! integrated over the layer thickness, in which the time rate of change in +! water mass must equal the net flow across the bounding interface, plus the +! rate of internal source or sink. The terms of water flow across the layer +! interfaces are linearly expanded by using first-order Taylor expansion. +! The equations result in a tridiagonal system equation. +! +! Note: length units here are all millimeter +! (in temperature subroutine uses same soil layer +! structure required but lengths are m) +! +! Richards equation: +! +! d wat d d wat d psi +! ----- = - -- [ k(----- ----- - 1) ] + S +! dt dz dz d wat +! +! where: wat = volume of water per volume of soil (mm**3/mm**3) +! psi = soil matrix potential (mm) +! dt = time step (s) +! z = depth (mm) +! dz = thickness (mm) +! qin = inflow at top (mm h2o /s) +! qout= outflow at bottom (mm h2o /s) +! s = source/sink flux (mm h2o /s) +! k = hydraulic conductivity (mm h2o /s) +! +! d qin d qin +! qin[n+1] = qin[n] + -------- d wat(j-1) + --------- d wat(j) +! d wat(j-1) d wat(j) +! ==================|================= +! < qin +! +! d wat(j)/dt * dz = qin[n+1] - qout[n+1] + S(j) +! +! > qout +! ==================|================= +! d qout d qout +! qout[n+1] = qout[n] + --------- d wat(j) + --------- d wat(j+1) +! d wat(j) d wat(j+1) +! +! +! Solution: linearize k and psi about d wat and use tridiagonal +! system of equations to solve for d wat, +! where for layer j +! +! +! r_j = a_j [d wat_j-1] + b_j [d wat_j] + c_j [d wat_j+1] +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_varcon , only : wimp, icol_roof, icol_road_imperv + use clm_varpar , only : nlevsoi, max_pft_per_col + use clm_varctl , only : iulog + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_LATICE, SHR_CONST_G + use TridiagonalMod, only : Tridiagonal + use clm_time_manager , only : get_step_size +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! column filter for urban points + real(r8), intent(in) :: vol_liq(lbc:ubc,1:nlevsoi) ! soil water per unit volume [mm/mm] + real(r8), intent(out) :: dwat(lbc:ubc,1:nlevsoi) ! change of soil water [m3/m3] + real(r8), intent(out) :: hk(lbc:ubc,1:nlevsoi) ! hydraulic conductivity [mm h2o/s] + real(r8), intent(out) :: dhkdw(lbc:ubc,1:nlevsoi) ! d(hk)/d(vol_liq) +! +! !CALLED FROM: +! subroutine Hydrology2 in module Hydrology2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/27/02, Peter Thornton: Migrated to new data structures. Includes +! treatment of multiple PFTs on a single soil column. +! 04/25/07 Keith Oleson: CLM3.5 hydrology +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: ctype(:) ! column type index + integer , pointer :: npfts(:) ! column's number of pfts - ADD + real(r8), pointer :: pwtcol(:) ! weight relative to column for each pft + real(r8), pointer :: pwtgcell(:) ! weight relative to gridcell for each pft + real(r8), pointer :: z(:,:) ! layer depth (m) + real(r8), pointer :: dz(:,:) ! layer thickness (m) + real(r8), pointer :: smpmin(:) ! restriction for min of soil potential (mm) + real(r8), pointer :: qflx_infl(:) ! infiltration (mm H2O /s) + real(r8), pointer :: qflx_tran_veg_pft(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg_col(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: eff_porosity(:,:) ! effective porosity = porosity - vol_ice + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: hksat(:,:) ! hydraulic conductivity at saturation (mm H2O /s) + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: rootr_pft(:,:) ! effective fraction of roots in each soil layer + integer , pointer :: pfti(:) ! beginning pft index for each column + real(r8), pointer :: fracice(:,:) ! fractional impermeability (-) + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + real(r8), pointer :: qcharge(:) ! aquifer recharge rate (mm/s) + real(r8), pointer :: hkdepth(:) ! decay factor (m) + real(r8), pointer :: zwt(:) ! water table depth (m) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) +! +! local pointers to original implicit inout arguments +! + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) +! +! local pointer s to original implicit out arguments +! + real(r8), pointer :: rootr_col(:,:) ! effective fraction of roots in each soil layer + real(r8), pointer :: smp_l(:,:) ! soil matrix potential [mm] + real(r8), pointer :: hk_l(:,:) ! hydraulic conductivity (mm/s) +! +!EOP +! +! !OTHER LOCAL VARIABLES: +! + integer :: p,c,fc,j ! do loop indices + integer :: jtop(lbc:ubc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + real(r8) :: amx(lbc:ubc,1:nlevsoi+1) ! "a" left off diagonal of tridiagonal matrix + real(r8) :: bmx(lbc:ubc,1:nlevsoi+1) ! "b" diagonal column for tridiagonal matrix + real(r8) :: cmx(lbc:ubc,1:nlevsoi+1) ! "c" right off diagonal tridiagonal matrix + real(r8) :: rmx(lbc:ubc,1:nlevsoi+1) ! "r" forcing term of tridiagonal matrix + real(r8) :: zmm(lbc:ubc,1:nlevsoi+1) ! layer depth [mm] + real(r8) :: dzmm(lbc:ubc,1:nlevsoi+1) ! layer thickness [mm] + real(r8) :: den ! used in calculating qin, qout + real(r8) :: dqidw0(lbc:ubc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i-1)) + real(r8) :: dqidw1(lbc:ubc,1:nlevsoi+1) ! d(qin)/d(vol_liq(i)) + real(r8) :: dqodw1(lbc:ubc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i)) + real(r8) :: dqodw2(lbc:ubc,1:nlevsoi+1) ! d(qout)/d(vol_liq(i+1)) + real(r8) :: dsmpdw(lbc:ubc,1:nlevsoi+1) ! d(smp)/d(vol_liq) + real(r8) :: num ! used in calculating qin, qout + real(r8) :: qin(lbc:ubc,1:nlevsoi+1) ! flux of water into soil layer [mm h2o/s] + real(r8) :: qout(lbc:ubc,1:nlevsoi+1) ! flux of water out of soil layer [mm h2o/s] + real(r8) :: s_node ! soil wetness + real(r8) :: s1 ! "s" at interface of layer + real(r8) :: s2 ! k*s**(2b+2) + real(r8) :: smp(lbc:ubc,1:nlevsoi) ! soil matrix potential [mm] + real(r8) :: sdamp ! extrapolates soiwat dependence of evaporation + integer :: pi ! pft index + real(r8) :: temp(lbc:ubc) ! accumulator for rootr weighting + integer :: jwt(lbc:ubc) ! index of the soil layer right above the water table (-) + real(r8) :: smp1,dsmpdw1,wh,wh_zwt,ka + real(r8) :: dwat2(lbc:ubc,1:nlevsoi+1) + real(r8) :: dzq ! used in calculating qin, qout (difference in equilbirium matric potential) + real(r8) :: zimm(lbc:ubc,0:nlevsoi) ! layer interface depth [mm] + real(r8) :: zq(lbc:ubc,1:nlevsoi+1) ! equilibrium matric potential for each layer [mm] + real(r8) :: vol_eq(lbc:ubc,1:nlevsoi+1) ! equilibrium volumetric water content + real(r8) :: tempi ! temp variable for calculating vol_eq + real(r8) :: temp0 ! temp variable for calculating vol_eq + real(r8) :: voleq1 ! temp variable for calculating vol_eq + real(r8) :: zwtmm(lbc:ubc) ! water table depth [mm] +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (column-level) + + qcharge => cws%qcharge + hkdepth => cps%hkdepth + zi => cps%zi + zwt => cws%zwt + ctype => col%itype + npfts => col%npfts + z => cps%z + dz => cps%dz + smpmin => cps%smpmin + watsat => cps%watsat + hksat => cps%hksat + bsw => cps%bsw + sucsat => cps%sucsat + eff_porosity => cps%eff_porosity + rootr_col => cps%rootr_column + t_soisno => ces%t_soisno + h2osoi_liq => cws%h2osoi_liq + h2osoi_vol => cws%h2osoi_vol + qflx_infl => cwf%qflx_infl + fracice => cps%fracice + qflx_tran_veg_col => pwf_a%qflx_tran_veg + pfti => col%pfti + smp_l => cws%smp_l + hk_l => cws%hk_l + + ! Assign local pointers to derived type members (pft-level) + + qflx_tran_veg_pft => pwf%qflx_tran_veg + rootr_pft => pps%rootr + pwtcol => pft%wtcol + pwtgcell => pft%wtgcell + + ! Get time step + + dtime = get_step_size() + + ! Because the depths in this routine are in mm, use local + ! variable arrays instead of pointers + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zmm(c,j) = z(c,j)*1.e3_r8 + dzmm(c,j) = dz(c,j)*1.e3_r8 + zimm(c,j) = zi(c,j)*1.e3_r8 + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zimm(c,0) = 0.0_r8 + zwtmm(c) = zwt(c)*1.e3_r8 + end do + + ! First step is to calculate the column-level effective rooting + ! fraction in each soil layer. This is done outside the usual + ! PFT-to-column averaging routines because it is not a simple + ! weighted average of the PFT level rootr arrays. Instead, the + ! weighting depends on both the per-unit-area transpiration + ! of the PFT and the PFTs area relative to all PFTs. + + temp(:) = 0._r8 + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + rootr_col(c,j) = 0._r8 + end do + end do + + do pi = 1,max_pft_per_col + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + if (pwtgcell(p)>0._r8) then + rootr_col(c,j) = rootr_col(c,j) + rootr_pft(p,j) * qflx_tran_veg_pft(p) * pwtcol(p) + end if + end if + end do + end do + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + if (pwtgcell(p)>0._r8) then + temp(c) = temp(c) + qflx_tran_veg_pft(p) * pwtcol(p) + end if + end if + end do + end do + + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (temp(c) /= 0._r8) then + rootr_col(c,j) = rootr_col(c,j)/temp(c) + end if + end do + end do + + !compute jwt index + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + jwt(c) = nlevsoi + do j = 2,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + end do + + ! calculate the equilibrium water content based on the water table depth + + do j=1,nlevsoi + do fc=1, num_hydrologyc + c = filter_hydrologyc(fc) + if ((zwtmm(c) .lt. zimm(c,j-1))) then !fully saturated when wtd is less than the layer top + vol_eq(c,j) = watsat(c,j) + + ! use the weighted average from the saturated part (depth > wtd) and the equilibrium solution for the + ! rest of the layer + + else if ((zwtmm(c) .lt. zimm(c,j)) .and. (zwtmm(c) .gt. zimm(c,j-1))) then + tempi = 1.0_r8 + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + voleq1 = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j-1))*(tempi-temp0) + vol_eq(c,j) = (voleq1*(zwtmm(c)-zimm(c,j-1)) + watsat(c,j)*(zimm(c,j)-zwtmm(c)))/(zimm(c,j)-zimm(c,j-1)) + vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j)) + vol_eq(c,j) = max(vol_eq(c,j),0.0_r8) + else + tempi = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j-1))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + vol_eq(c,j) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zimm(c,j)-zimm(c,j-1))*(tempi-temp0) + vol_eq(c,j) = max(vol_eq(c,j),0.0_r8) + vol_eq(c,j) = min(watsat(c,j),vol_eq(c,j)) + endif + zq(c,j) = -sucsat(c,j)*(max(vol_eq(c,j)/watsat(c,j),0.01_r8))**(-bsw(c,j)) + zq(c,j) = max(smpmin(c), zq(c,j)) + end do + end do + + ! If water table is below soil column calculate zq for the 11th layer + j = nlevsoi + do fc=1, num_hydrologyc + c = filter_hydrologyc(fc) + if(jwt(c) == nlevsoi) then + tempi = 1._r8 + temp0 = (((sucsat(c,j)+zwtmm(c)-zimm(c,j))/sucsat(c,j)))**(1._r8-1._r8/bsw(c,j)) + vol_eq(c,j+1) = -sucsat(c,j)*watsat(c,j)/(1._r8-1._r8/bsw(c,j))/(zwtmm(c)-zimm(c,j))*(tempi-temp0) + vol_eq(c,j+1) = max(vol_eq(c,j+1),0.0_r8) + vol_eq(c,j+1) = min(watsat(c,j),vol_eq(c,j+1)) + zq(c,j+1) = -sucsat(c,j)*(max(vol_eq(c,j+1)/watsat(c,j),0.01_r8))**(-bsw(c,j)) + zq(c,j+1) = max(smpmin(c), zq(c,j+1)) + end if + end do + + ! Hydraulic conductivity and soil matric potential and their derivatives + + sdamp = 0._r8 + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + s1 = 0.5_r8*(h2osoi_vol(c,j) + h2osoi_vol(c,min(nlevsoi, j+1))) / & + (0.5_r8*(watsat(c,j)+watsat(c,min(nlevsoi, j+1)))) + s1 = min(1._r8, s1) + s2 = hksat(c,j)*s1**(2._r8*bsw(c,j)+2._r8) + + hk(c,j) = (1._r8-0.5_r8*(fracice(c,j)+fracice(c,min(nlevsoi, j+1))))*s1*s2 + + dhkdw(c,j) = (1._r8-0.5_r8*(fracice(c,j)+fracice(c,min(nlevsoi, j+1))))* & + (2._r8*bsw(c,j)+3._r8)*s2*0.5_r8/watsat(c,j) + + s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) + s_node = min(1.0_r8, s_node) + + smp(c,j) = -sucsat(c,j)*s_node**(-bsw(c,j)) + smp(c,j) = max(smpmin(c), smp(c,j)) + + dsmpdw(c,j) = -bsw(c,j)*smp(c,j)/(s_node*watsat(c,j)) + + smp_l(c,j) = smp(c,j) + hk_l(c,j) = hk(c,j) + + end do + end do + + ! aquifer (11th) layer + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + zmm(c,nlevsoi+1) = 0.5*(1.e3_r8*zwt(c) + zmm(c,nlevsoi)) + if(jwt(c) < nlevsoi) then + dzmm(c,nlevsoi+1) = dzmm(c,nlevsoi) + else + dzmm(c,nlevsoi+1) = (1.e3_r8*zwt(c) - zmm(c,nlevsoi)) + end if + end do + + ! Set up r, a, b, and c vectors for tridiagonal solution + + ! Node j=1 (top) + + j = 1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qin(c,j) = qflx_infl(c) + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp(c,j+1)-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den + rmx(c,j) = qin(c,j) - qout(c,j) - qflx_tran_veg_col(c) * rootr_col(c,j) + amx(c,j) = 0._r8 + bmx(c,j) = dzmm(c,j)*(sdamp+1._r8/dtime) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + end do + + ! Nodes j=2 to j=nlevsoi-1 + + do j = 2, nlevsoi - 1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp(c,j+1)-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw(c,j+1) + num*dhkdw(c,j))/den + rmx(c,j) = qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + end do + end do + + ! Node j=nlevsoi (bottom) + + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if(j > jwt(c)) then !water table is in soil column + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + qout(c,j) = 0._r8 + dqodw1(c,j) = 0._r8 + rmx(c,j) = qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = 0._r8 + + !scs: next set up aquifer layer; hydrologically inactive + rmx(c,j+1) = 0._r8 + amx(c,j+1) = 0._r8 + bmx(c,j+1) = dzmm(c,j+1)/dtime + cmx(c,j+1) = 0._r8 + else ! water table is below soil column + + !scs: compute aquifer soil moisture as average of layer 10 and saturation + s_node = max(0.5*(1.0_r8+h2osoi_vol(c,j)/watsat(c,j)), 0.01_r8) + s_node = min(1.0_r8, s_node) + + !scs: compute smp for aquifer layer + smp1 = -sucsat(c,j)*s_node**(-bsw(c,j)) + smp1 = max(smpmin(c), smp1) + + !scs: compute dsmpdw for aquifer layer + dsmpdw1 = -bsw(c,j)*smp1/(s_node*watsat(c,j)) + + !scs: first set up bottom layer of soil column + den = (zmm(c,j) - zmm(c,j-1)) + dzq = (zq(c,j)-zq(c,j-1)) + num = (smp(c,j)-smp(c,j-1)) - dzq + qin(c,j) = -hk(c,j-1)*num/den + dqidw0(c,j) = -(-hk(c,j-1)*dsmpdw(c,j-1) + num*dhkdw(c,j-1))/den + dqidw1(c,j) = -( hk(c,j-1)*dsmpdw(c,j) + num*dhkdw(c,j-1))/den + den = (zmm(c,j+1)-zmm(c,j)) + dzq = (zq(c,j+1)-zq(c,j)) + num = (smp1-smp(c,j)) - dzq + qout(c,j) = -hk(c,j)*num/den + dqodw1(c,j) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqodw2(c,j) = -( hk(c,j)*dsmpdw1 + num*dhkdw(c,j))/den + + rmx(c,j) = qin(c,j) - qout(c,j) - qflx_tran_veg_col(c)*rootr_col(c,j) + amx(c,j) = -dqidw0(c,j) + bmx(c,j) = dzmm(c,j)/dtime - dqidw1(c,j) + dqodw1(c,j) + cmx(c,j) = dqodw2(c,j) + + !scs: next set up aquifer layer; den/num unchanged, qin=qout + qin(c,j+1) = qout(c,j) + dqidw0(c,j+1) = -(-hk(c,j)*dsmpdw(c,j) + num*dhkdw(c,j))/den + dqidw1(c,j+1) = -( hk(c,j)*dsmpdw1 + num*dhkdw(c,j))/den + qout(c,j+1) = 0._r8 ! zero-flow bottom boundary condition + dqodw1(c,j+1) = 0._r8 ! zero-flow bottom boundary condition + rmx(c,j+1) = qin(c,j+1) - qout(c,j+1) + amx(c,j+1) = -dqidw0(c,j+1) + bmx(c,j+1) = dzmm(c,j+1)/dtime - dqidw1(c,j+1) + dqodw1(c,j+1) + cmx(c,j+1) = 0._r8 + endif + end do + + ! Solve for dwat + + jtop(:) = 1 + call Tridiagonal(lbc, ubc, 1, nlevsoi+1, jtop, num_hydrologyc, filter_hydrologyc, & + amx, bmx, cmx, rmx, dwat2 ) + !scs: set dwat + do fc = 1,num_hydrologyc + c = filter_hydrologyc(fc) + do j = 1, nlevsoi + dwat(c,j)=dwat2(c,j) + end do + end do + + ! Renew the mass of liquid water + !scs: also compute qcharge from dwat in aquifer layer + !scs: update in drainage for case jwt < nlevsoi + + do fc = 1,num_hydrologyc + c = filter_hydrologyc(fc) + do j = 1, nlevsoi + h2osoi_liq(c,j) = h2osoi_liq(c,j) + dwat2(c,j)*dzmm(c,j) + end do + + !scs: calculate qcharge for case jwt < nlevsoi + if(jwt(c) < nlevsoi) then + wh_zwt = 0._r8 !since wh_zwt = -sucsat - zq_zwt, where zq_zwt = -sucsat + + s_node = max(h2osoi_vol(c,jwt(c))/watsat(c,jwt(c)), 0.01_r8) + s_node = min(1.0_r8, s_node) + + !scs: use average moisture between water table and layer jwt + s1 = 0.5_r8*(1.0+s_node) + s1 = min(1._r8, s1) + + !scs: this is the expression for unsaturated hk + ka = hksat(c,jwt(c))*s1**(2._r8*bsw(c,jwt(c))+3._r8) + + ! Recharge rate qcharge to groundwater (positive to aquifer) + smp1 = -sucsat(c,jwt(c))*s_node**(-bsw(c,jwt(c))) + smp1 = max(smpmin(c), smp(c,jwt(c))) + wh = smp1 - zq(c,jwt(c)) + qcharge(c) = -ka * (wh_zwt-wh) /((zwt(c)-z(c,jwt(c)))*1000._r8) + + ! To limit qcharge (for the first several timesteps) + qcharge(c) = max(-10.0_r8/dtime,qcharge(c)) + qcharge(c) = min( 10.0_r8/dtime,qcharge(c)) + else + !scs: if water table is below soil column, compute qcharge from dwat2(11) + qcharge(c) = dwat2(c,nlevsoi+1)*dzmm(c,nlevsoi+1)/dtime + endif + end do + + end subroutine SoilWater + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Drainage +! +! !INTERFACE: + subroutine Drainage(lbc, ubc, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, vol_liq, hk, & + icefrac) +! +! !DESCRIPTION: +! Calculate subsurface drainage +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use clm_time_manager, only : get_step_size + use clm_varcon , only : pondmx, tfrz, icol_roof, icol_road_imperv, icol_road_perv, watmin + use clm_varpar , only : nlevsoi +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! column filter for urban points + integer , intent(in) :: filter_hydrologyc(ubc-lbc+1) ! column filter for soil points + real(r8), intent(in) :: vol_liq(lbc:ubc,1:nlevsoi) ! partial volume of liquid water in layer + real(r8), intent(in) :: hk(lbc:ubc,1:nlevsoi) ! hydraulic conductivity (mm h2o/s) + real(r8), intent(in) :: icefrac(lbc:ubc,1:nlevsoi) ! fraction of ice in layer +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 12 November 1999: Z.-L. Yang and G.-Y. Niu +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 4/26/05, Peter Thornton and David Lawrence: Turned off drainage from +! middle soil layers for both wet and dry fractions. +! 04/25/07 Keith Oleson: Completely new routine for CLM3.5 hydrology +! 27 February 2008: Keith Oleson; Saturation excess modification +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: ctype(:) !column type index + integer , pointer :: snl(:) !number of snow layers + real(r8), pointer :: qflx_snwcp_liq(:) !excess rainfall due to snow capping (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_grnd(:) !ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow(:) !surface dew added to snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow(:) !sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: dz(:,:) !layer depth (m) + real(r8), pointer :: bsw(:,:) !Clapp and Hornberger "b" + real(r8), pointer :: eff_porosity(:,:) !effective porosity = porosity - vol_ice + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) + real(r8), pointer :: hksat(:,:) !hydraulic conductivity at saturation (mm H2O /s) + real(r8), pointer :: sucsat(:,:) !minimum soil suction (mm) + real(r8), pointer :: z(:,:) !layer depth (m) + real(r8), pointer :: zi(:,:) !interface level below a "z" level (m) + real(r8), pointer :: watsat(:,:) !volumetric soil water at saturation (porosity) + real(r8), pointer :: hkdepth(:) !decay factor (m) + real(r8), pointer :: zwt(:) !water table depth (m) + real(r8), pointer :: wa(:) !water in the unconfined aquifer (mm) + real(r8), pointer :: wt(:) !total water storage (unsaturated soil water + groundwater) (mm) + real(r8), pointer :: qcharge(:) !aquifer recharge rate (mm/s) +! +! local pointers to original implicit inout arguments +! + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: qflx_drain(:) !sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_irrig(:) !irrigation flux (mm H2O /s) + real(r8), pointer :: qflx_qrgwl(:) !qflx_surf at glaciers, wetlands, lakes (mm H2O /s) + real(r8), pointer :: eflx_impsoil(:) !implicit evaporation for soil temperature equation + real(r8), pointer :: qflx_rsub_sat(:) !soil saturation excess [mm h2o/s] +! +!EOP +! +! !OTHER LOCAL VARIABLES: +! + integer :: c,j,fc,i !indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: xs(lbc:ubc) !water needed to bring soil moisture to watmin (mm) + real(r8) :: dzmm(lbc:ubc,1:nlevsoi) !layer thickness (mm) + integer :: jwt(lbc:ubc) !index of the soil layer right above the water table (-) + real(r8) :: rsub_bot(lbc:ubc) !subsurface runoff - bottom drainage (mm/s) + real(r8) :: rsub_top(lbc:ubc) !subsurface runoff - topographic control (mm/s) + real(r8) :: fff(lbc:ubc) !decay factor (m-1) + real(r8) :: xsi(lbc:ubc) !excess soil water above saturation at layer i (mm) + real(r8) :: xsia(lbc:ubc) !available pore space at layer i (mm) + real(r8) :: xs1(lbc:ubc) !excess soil water above saturation at layer 1 (mm) + real(r8) :: smpfz(1:nlevsoi) !matric potential of layer right above water table (mm) + real(r8) :: wtsub !summation of hk*dzmm for layers below water table (mm**2/s) + real(r8) :: rous !aquifer yield (-) + real(r8) :: wh !smpfz(jwt)-z(jwt) (mm) + real(r8) :: wh_zwt !water head at the water table depth (mm) + real(r8) :: ws !summation of pore space of layers below water table (mm) + real(r8) :: s_node !soil wetness (-) + real(r8) :: dzsum !summation of dzmm of layers below water table (mm) + real(r8) :: icefracsum !summation of icefrac*dzmm of layers below water table (-) + real(r8) :: fracice_rsub(lbc:ubc) !fractional impermeability of soil layers (-) + real(r8) :: ka !hydraulic conductivity of the aquifer (mm/s) + real(r8) :: dza !fff*(zwt-z(jwt)) (-) + real(r8) :: available_h2osoi_liq !available soil liquid water in a layer +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype +! cgridcell => col%gridcell + + snl => cps%snl + dz => cps%dz + bsw => cps%bsw + t_soisno => ces%t_soisno + hksat => cps%hksat + sucsat => cps%sucsat + z => cps%z + zi => cps%zi + watsat => cps%watsat + hkdepth => cps%hkdepth + zwt => cws%zwt + wa => cws%wa + wt => cws%wt + qcharge => cws%qcharge + eff_porosity => cps%eff_porosity + qflx_snwcp_liq => pwf_a%qflx_snwcp_liq + qflx_dew_grnd => pwf_a%qflx_dew_grnd + qflx_dew_snow => pwf_a%qflx_dew_snow + qflx_sub_snow => pwf_a%qflx_sub_snow + qflx_drain => cwf%qflx_drain + qflx_irrig => cwf%qflx_irrig + qflx_qrgwl => cwf%qflx_qrgwl + qflx_rsub_sat => cwf%qflx_rsub_sat + eflx_impsoil => cef%eflx_impsoil + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + + ! Get time step + + dtime = get_step_size() + + ! Convert layer thicknesses from m to mm + + do j = 1,nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + dzmm(c,j) = dz(c,j)*1.e3_r8 + end do + end do + + ! Initial set + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_drain(c) = 0._r8 + rsub_bot(c) = 0._r8 + qflx_rsub_sat(c) = 0._r8 + rsub_top(c) = 0._r8 + fracice_rsub(c) = 0._r8 + end do + + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + jwt(c) = nlevsoi + do j = 2,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + end do + + ! Topographic runoff + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + fff(c) = 1._r8/ hkdepth(c) + dzsum = 0._r8 + icefracsum = 0._r8 + do j = jwt(c), nlevsoi + dzsum = dzsum + dzmm(c,j) + icefracsum = icefracsum + icefrac(c,j) * dzmm(c,j) + end do + fracice_rsub(c) = max(0._r8,exp(-3._r8*(1._r8-(icefracsum/dzsum)))- exp(-3._r8))/(1.0_r8-exp(-3._r8)) + rsub_top(c) = (1._r8 - fracice_rsub(c)) * 5.5e-3_r8 * exp(-fff(c)*zwt(c)) + end do + + rous = 0.2_r8 + + ! Water table calculation + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Water storage in aquifer + soil + wt(c) = wt(c) + (qcharge(c) - rsub_top(c)) * dtime + + if(jwt(c) == nlevsoi) then ! water table is below the soil column + wa(c) = wa(c) + (qcharge(c) -rsub_top(c)) * dtime + wt(c) = wa(c) + zwt(c) = (zi(c,nlevsoi) + 25._r8) - wa(c)/1000._r8/rous + h2osoi_liq(c,nlevsoi) = h2osoi_liq(c,nlevsoi) + max(0._r8,(wa(c)-5000._r8)) + wa(c) = min(wa(c), 5000._r8) + else ! water table within soil layers + if (jwt(c) == nlevsoi-1) then ! water table within bottom soil layer + + zwt(c) = zi(c,nlevsoi)- (wt(c)-rous*1000._r8*25._r8) /eff_porosity(c,nlevsoi)/1000._r8 + + else ! water table within soil layers 1-9 + ws = 0._r8 ! water used to fill soil air pores regardless of water content + do j = jwt(c)+2,nlevsoi + ws = ws + eff_porosity(c,j) * 1000._r8 * dz(c,j) + enddo + zwt(c) = zi(c,jwt(c)+1)-(wt(c)-rous*1000_r8*25._r8-ws) /eff_porosity(c,jwt(c)+1)/1000._r8 + endif + + wtsub = 0._r8 + do j = jwt(c)+1, nlevsoi + wtsub = wtsub + hk(c,j)*dzmm(c,j) + end do + + ! Remove subsurface runoff + do j = jwt(c)+1, nlevsoi + h2osoi_liq(c,j) = h2osoi_liq(c,j) - rsub_top(c)*dtime*hk(c,j)*dzmm(c,j)/wtsub + end do + end if + + zwt(c) = max(0.05_r8,zwt(c)) + zwt(c) = min(80._r8,zwt(c)) + + end do + + ! excessive water above saturation added to the above unsaturated layer like a bucket + ! if column fully saturated, excess water goes to runoff + + do j = nlevsoi,2,-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + xsi(c) = max(h2osoi_liq(c,j)-eff_porosity(c,j)*dzmm(c,j),0._r8) + h2osoi_liq(c,j) = min(eff_porosity(c,j)*dzmm(c,j), h2osoi_liq(c,j)) + h2osoi_liq(c,j-1) = h2osoi_liq(c,j-1) + xsi(c) + end do + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + xs1(c) = max(max(h2osoi_liq(c,1),0._r8)-max(0._r8,(pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1))),0._r8) + h2osoi_liq(c,1) = min(max(0._r8,pondmx+watsat(c,1)*dzmm(c,1)-h2osoi_ice(c,1)), h2osoi_liq(c,1)) + qflx_rsub_sat(c) = xs1(c) / dtime + end do + + ! Limit h2osoi_liq to be greater than or equal to watmin. + ! Get water needed to bring h2osoi_liq equal watmin from lower layer. + ! If insufficient water in soil layers, get from aquifer water + + do j = 1, nlevsoi-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin - h2osoi_liq(c,j) + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j ) = h2osoi_liq(c,j ) + xs(c) + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) - xs(c) + end do + end do + +! Get water for bottom layer from layers above if possible + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin-h2osoi_liq(c,j) + searchforwater: do i = nlevsoi-1, 1, -1 + available_h2osoi_liq = max(h2osoi_liq(c,i)-watmin-xs(c),0._r8) + if (available_h2osoi_liq .ge. xs(c)) then + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + h2osoi_liq(c,i) = h2osoi_liq(c,i) - xs(c) + xs(c) = 0._r8 + exit searchforwater + else + h2osoi_liq(c,j) = h2osoi_liq(c,j) + available_h2osoi_liq + h2osoi_liq(c,i) = h2osoi_liq(c,i) - available_h2osoi_liq + xs(c) = xs(c) - available_h2osoi_liq + end if + end do searchforwater + else + xs(c) = 0._r8 + end if +! Needed in case there is no water to be found + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + wt(c) = wt(c) - xs(c) +! Instead of removing water from aquifer where it eventually +! shows up as excess drainage to the ocean, take it back out of +! drainage + rsub_top(c) = rsub_top(c) - xs(c)/dtime + end do + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + ! Sub-surface runoff and drainage + + qflx_drain(c) = qflx_rsub_sat(c) + rsub_top(c) + + ! Set imbalance for snow capping + + qflx_qrgwl(c) = qflx_snwcp_liq(c) + + ! Implicit evaporation term is now zero + + eflx_impsoil(c) = 0._r8 + + ! Renew the ice and liquid mass due to condensation + + if (snl(c)+1 >= 1) then + h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_dew_grnd(c) * dtime + h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_dew_snow(c) * dtime) + if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then + qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime + h2osoi_ice(c,1) = 0._r8 + else + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_sub_snow(c) * dtime) + end if + end if + end do + + ! No drainage for urban columns (except for pervious road as computed above) + + do fc = 1, num_urbanc + c = filter_urbanc(fc) + if (ctype(c) /= icol_road_perv) then + qflx_drain(c) = 0._r8 + qflx_irrig(c) = 0._r8 + ! This must be done for roofs and impervious road (walls will be zero) + qflx_qrgwl(c) = qflx_snwcp_liq(c) + eflx_impsoil(c) = 0._r8 + end if + + ! Renew the ice and liquid mass due to condensation for urban roof and impervious road + + if (ctype(c) == icol_roof .or. ctype(c) == icol_road_imperv) then + if (snl(c)+1 >= 1) then + h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_dew_grnd(c) * dtime + h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_dew_snow(c) * dtime) + if (qflx_sub_snow(c)*dtime > h2osoi_ice(c,1)) then + qflx_sub_snow(c) = h2osoi_ice(c,1)/dtime + h2osoi_ice(c,1) = 0._r8 + else + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_sub_snow(c) * dtime) + end if + end if + end if + + end do + + end subroutine Drainage + +end module SoilHydrologyMod diff --git a/components/clm/src_clm40/biogeophys/SoilTemperatureMod.F90 b/components/clm/src_clm40/biogeophys/SoilTemperatureMod.F90 new file mode 100644 index 0000000000..9e81a79cd0 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SoilTemperatureMod.F90 @@ -0,0 +1,1225 @@ +module SoilTemperatureMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SoilTemperatureMod +! +! !DESCRIPTION: +! Calculates snow and soil temperatures including phase change +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SoilTemperature ! Snow and soil temperatures including phase change +! +! !PRIVATE MEMBER FUNCTIONS: + private :: SoilThermProp ! Set therm conductivities and heat cap of snow/soil layers + private :: PhaseChange ! Calculation of the phase change within snow and soil layers +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SoilTemperature +! +! !INTERFACE: + subroutine SoilTemperature(lbl, ubl, lbc, ubc, num_urbanl, filter_urbanl, & + num_nolakec, filter_nolakec, xmf, fact) +! +! !DESCRIPTION: +! Snow and soil temperatures including phase change +! o The volumetric heat capacity is calculated as a linear combination +! in terms of the volumetric fraction of the constituent phases. +! o The thermal conductivity of soil is computed from +! the algorithm of Johansen (as reported by Farouki 1981), and the +! conductivity of snow is from the formulation used in +! SNTHERM (Jordan 1991). +! o Boundary conditions: +! F = Rnet - Hg - LEg (top), F= 0 (base of the soil column). +! o Soil / snow temperature is predicted from heat conduction +! in 10 soil layers and up to 5 snow layers. +! The thermal conductivities at the interfaces between two +! neighboring layers (j, j+1) are derived from an assumption that +! the flux across the interface is equal to that from the node j +! to the interface and the flux from the interface to the node j+1. +! The equation is solved using the Crank-Nicholson method and +! results in a tridiagonal system equation. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_time_manager , only : get_step_size + use clm_varctl , only : iulog + use clm_varcon , only : sb, capr, cnfac, hvap, istice_mec, isturb, & + icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv, istwet + use clm_varpar , only : nlevsno, nlevgrnd, max_pft_per_col, nlevurb + use TridiagonalMod, only : Tridiagonal + +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer , intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + real(r8), intent(out) :: xmf(lbc:ubc) ! total latent heat of phase change of ground water + real(r8), intent(out) :: fact(lbc:ubc, -nlevsno+1:nlevgrnd) ! used in computing tridiagonal matrix +! +! !CALLED FROM: +! subroutine Biogeophysics2 in module Biogeophysics2Mod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 12/19/01, Peter Thornton +! Changed references for tg to t_grnd, for consistency with the +! rest of the code (tg eliminated as redundant) +! 2/14/02, Peter Thornton: Migrated to new data structures. Added pft loop +! in calculation of net ground heat flux. +! 3/18/08, David Lawrence: Change nlevsoi to nlevgrnd for deep soil +! 03/28/08, Mark Flanner: Changes to allow solar radiative absorption in all snow layers and top soil layer +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: pgridcell(:) ! pft's gridcell index + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: clandunit(:) ! column's landunit + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: ctype(:) ! column type + integer , pointer :: npfts(:) ! column's number of pfts + integer , pointer :: pfti(:) ! column's beginning pft index + real(r8), pointer :: pwtcol(:) ! weight of pft relative to column + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: htvp(:) ! latent heat of vapor of water (or sublimation) [j/kg] + real(r8), pointer :: emg(:) ! ground emissivity + real(r8), pointer :: cgrnd(:) ! deriv. of soil energy flux wrt to soil temp [w/m2/k] + real(r8), pointer :: dlrad(:) ! downward longwave radiation blow the canopy [W/m2] + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1 now) [-] (new) + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: z(:,:) ! layer thickness (m) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: eflx_lwrad_net(:) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: tssbef(:,:) ! temperature at previous time step [K] + real(r8), pointer :: t_building(:) ! internal building temperature (K) + real(r8), pointer :: t_building_max(:) ! maximum internal building temperature (K) + real(r8), pointer :: t_building_min(:) ! minimum internal building temperature (K) + real(r8), pointer :: hc_soi(:) ! soil heat content (MJ/m2) + real(r8), pointer :: hc_soisno(:) ! soil plus snow plus lake heat content (MJ/m2) + real(r8), pointer :: eflx_fgr12(:) ! heat flux between soil layer 1 and 2 (W/m2) + real(r8), pointer :: eflx_traffic(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_wasteheat_pft(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_traffic_pft(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_anthro(:) ! total anthropogenic heat flux (W/m**2) + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio + real(r8), pointer :: wtlunit_roof(:) ! weight of roof with respect to landunit + real(r8), pointer :: eflx_bot(:) ! heat flux from beneath column (W/m**2) [+ = upward] +! +! local pointers to original implicit inout arguments +! + real(r8), pointer :: t_grnd(:) ! ground surface temperature [K] +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: eflx_gnet(:) ! net ground heat flux into the surface (W/m**2) + real(r8), pointer :: dgnetdT(:) ! temperature derivative of ground net heat flux + real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to walls, roof (W/m**2) + +! variables needed for SNICAR + real(r8), pointer :: sabg_lyr(:,:) ! absorbed solar radiation (pft,lyr) [W/m2] + real(r8), pointer :: h2osno(:) ! total snow water (col) [kg/m2] + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (col,lyr) [kg/m2] + real(r8), pointer :: h2osoi_ice(:,:) ! ice content (col,lyr) [kg/m2] + +! Urban building HAC fluxes + real(r8), pointer :: eflx_urban_ac(:) ! urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat(:) ! urban heating flux (W/m**2) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: j,c,p,l,g,pi ! indices + integer :: fc ! lake filtered column indices + integer :: fl ! urban filtered landunit indices + integer :: jtop(lbc:ubc) ! top level at each column + real(r8) :: dtime ! land model time step (sec) + real(r8) :: at (lbc:ubc,-nlevsno+1:nlevgrnd) ! "a" vector for tridiagonal matrix + real(r8) :: bt (lbc:ubc,-nlevsno+1:nlevgrnd) ! "b" vector for tridiagonal matrix + real(r8) :: ct (lbc:ubc,-nlevsno+1:nlevgrnd) ! "c" vector for tridiagonal matrix + real(r8) :: rt (lbc:ubc,-nlevsno+1:nlevgrnd) ! "r" vector for tridiagonal solution + real(r8) :: cv (lbc:ubc,-nlevsno+1:nlevgrnd) ! heat capacity [J/(m2 K)] + real(r8) :: tk (lbc:ubc,-nlevsno+1:nlevgrnd) ! thermal conductivity [W/(m K)] + real(r8) :: fn (lbc:ubc,-nlevsno+1:nlevgrnd) ! heat diffusion through the layer interface [W/m2] + real(r8) :: fn1(lbc:ubc,-nlevsno+1:nlevgrnd) ! heat diffusion through the layer interface [W/m2] + real(r8) :: brr(lbc:ubc,-nlevsno+1:nlevgrnd) ! temporary + real(r8) :: dzm ! used in computing tridiagonal matrix + real(r8) :: dzp ! used in computing tridiagonal matrix + real(r8) :: hs(lbc:ubc) ! net energy flux into the surface (w/m2) + real(r8) :: dhsdT(lbc:ubc) ! d(hs)/dT + real(r8) :: lwrad_emit(lbc:ubc) ! emitted longwave radiation + real(r8) :: dlwrad_emit(lbc:ubc) ! time derivative of emitted longwave radiation + integer :: lyr_top ! index of top layer of snowpack (-4 to 0) [idx] + real(r8) :: sabg_lyr_col(lbc:ubc,-nlevsno+1:1) ! absorbed solar radiation (col,lyr) [W/m2] + real(r8) :: eflx_gnet_top ! net energy flux into surface layer, pft-level [W/m2] + real(r8) :: hs_top(lbc:ubc) ! net energy flux into surface layer (col) [W/m2] + logical :: cool_on(lbl:ubl) ! is urban air conditioning on? + logical :: heat_on(lbl:ubl) ! is urban heating on? +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (gridcell-level) + + forc_lwrad => clm_a2l%forc_lwrad + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + t_building => lps%t_building + t_building_max => lps%t_building_max + t_building_min => lps%t_building_min + eflx_traffic => lef%eflx_traffic + canyon_hwr => lun%canyon_hwr + eflx_wasteheat => lef%eflx_wasteheat + eflx_heat_from_ac => lef%eflx_heat_from_ac + wtlunit_roof => lun%wtlunit_roof + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + clandunit => col%landunit + npfts => col%npfts + pfti => col%pfti + snl => cps%snl + htvp => cps%htvp + emg => cps%emg + t_grnd => ces%t_grnd + hc_soi => ces%hc_soi + hc_soisno => ces%hc_soisno + eflx_fgr12 => cef%eflx_fgr12 + zi => cps%zi + dz => cps%dz + z => cps%z + t_soisno => ces%t_soisno + eflx_building_heat => cef%eflx_building_heat + tssbef => ces%tssbef + eflx_urban_ac => cef%eflx_urban_ac + eflx_urban_heat => cef%eflx_urban_heat + eflx_bot => cef%eflx_bot + + ! Assign local pointers to derived subtypes components (pft-level) + + pgridcell => pft%gridcell + plandunit => pft%landunit + pwtcol => pft%wtcol + pwtgcell => pft%wtgcell + frac_veg_nosno => pps%frac_veg_nosno + cgrnd => pef%cgrnd + dlrad => pef%dlrad + sabg => pef%sabg + eflx_sh_grnd => pef%eflx_sh_grnd + qflx_evap_soi => pwf%qflx_evap_soi + qflx_tran_veg => pwf%qflx_tran_veg + eflx_gnet => pef%eflx_gnet + dgnetdT => pef%dgnetdT + eflx_lwrad_net => pef%eflx_lwrad_net + eflx_wasteheat_pft => pef%eflx_wasteheat_pft + eflx_heat_from_ac_pft => pef%eflx_heat_from_ac_pft + eflx_traffic_pft => pef%eflx_traffic_pft + eflx_anthro => pef%eflx_anthro + + sabg_lyr => pef%sabg_lyr + h2osno => cws%h2osno + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + + ! Get step size + + dtime = get_step_size() + + ! Compute ground surface and soil temperatures + + ! Thermal conductivity and Heat capacity + + call SoilThermProp(lbc, ubc, num_nolakec, filter_nolakec, tk, cv) + + ! Net ground heat flux into the surface and its temperature derivative + ! Added a pfts loop here to get the average of hs and dhsdT over + ! all PFTs on the column. Precalculate the terms that do not depend on PFT. + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + lwrad_emit(c) = emg(c) * sb * t_grnd(c)**4 + dlwrad_emit(c) = 4._r8*emg(c) * sb * t_grnd(c)**3 + end do + + hs(lbc:ubc) = 0._r8 + dhsdT(lbc:ubc) = 0._r8 + do pi = 1,max_pft_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 + l = plandunit(p) + g = pgridcell(p) + + ! Note: Some glacier_mec pfts may have zero weight + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + if (ltype(l) /= isturb) then + eflx_gnet(p) = sabg(p) + dlrad(p) & + + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) - lwrad_emit(c) & + - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + else + ! For urban columns we use the net longwave radiation (eflx_lwrad_net) because of + ! interactions between urban columns. + + ! All wasteheat and traffic flux goes into canyon floor + if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + eflx_wasteheat_pft(p) = eflx_wasteheat(l)/(1._r8-wtlunit_roof(l)) + eflx_heat_from_ac_pft(p) = eflx_heat_from_ac(l)/(1._r8-wtlunit_roof(l)) + eflx_traffic_pft(p) = eflx_traffic(l)/(1._r8-wtlunit_roof(l)) + else + eflx_wasteheat_pft(p) = 0._r8 + eflx_heat_from_ac_pft(p) = 0._r8 + eflx_traffic_pft(p) = 0._r8 + end if + ! Include transpiration term because needed for previous road + ! and include wasteheat and traffic flux + eflx_gnet(p) = sabg(p) + dlrad(p) & + - eflx_lwrad_net(p) & + - (eflx_sh_grnd(p) + qflx_evap_soi(p)*htvp(c) + qflx_tran_veg(p)*hvap) & + + eflx_wasteheat_pft(p) + eflx_heat_from_ac_pft(p) + eflx_traffic_pft(p) + eflx_anthro(p) = eflx_wasteheat_pft(p) + eflx_traffic_pft(p) + end if + dgnetdT(p) = - cgrnd(p) - dlwrad_emit(c) + hs(c) = hs(c) + eflx_gnet(p) * pwtcol(p) + dhsdT(c) = dhsdT(c) + dgnetdT(p) * pwtcol(p) + end if + + end if + end do + end do + + ! Additional calculations with SNICAR: + ! Set up tridiagonal matrix in a new manner. There is now + ! absorbed solar radiation in each snow layer, instead of + ! only the surface. Following the current implementation, + ! absorbed solar flux should be: S + ((delS/delT)*dT), + ! where S is absorbed radiation, and T is temperature. Now, + ! assume delS/delT is zero, then it is OK to just add S + ! to each layer + + ! Initialize: + sabg_lyr_col(lbc:ubc,-nlevsno+1:1) = 0._r8 + hs_top(lbc:ubc) = 0._r8 + + do pi = 1,max_pft_per_col + do fc = 1,num_nolakec + c = filter_nolakec(fc) + lyr_top = snl(c) + 1 + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ltype(l)==istice_mec) then + g = pgridcell(p) + if (ltype(l) /= isturb )then + + eflx_gnet_top = sabg_lyr(p,lyr_top) + dlrad(p) + (1-frac_veg_nosno(p))*emg(c)*forc_lwrad(g) & + - lwrad_emit(c) - (eflx_sh_grnd(p)+qflx_evap_soi(p)*htvp(c)) + + hs_top(c) = hs_top(c) + eflx_gnet_top*pwtcol(p) + + do j = lyr_top,1,1 + sabg_lyr_col(c,j) = sabg_lyr_col(c,j) + sabg_lyr(p,j) * pwtcol(p) + enddo + else + + hs_top(c) = hs_top(c) + eflx_gnet(p)*pwtcol(p) + + sabg_lyr_col(c,lyr_top) = sabg_lyr_col(c,lyr_top) + sabg(p) * pwtcol(p) + + endif + endif + + endif + enddo + enddo + + ! Restrict internal building temperature to between min and max + ! and determine if heating or air conditioning is on + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if (ltype(l) == isturb) then + cool_on(l) = .false. + heat_on(l) = .false. + if (t_building(l) > t_building_max(l)) then + t_building(l) = t_building_max(l) + cool_on(l) = .true. + heat_on(l) = .false. + else if (t_building(l) < t_building_min(l)) then + t_building(l) = t_building_min(l) + cool_on(l) = .false. + heat_on(l) = .true. + end if + end if + end do + + ! Determine heat diffusion through the layer interface and factor used in computing + ! tridiagonal matrix and set up vector r and vectors a, b, c that define tridiagonal + ! matrix and solve system + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (j >= snl(c)+1) then + if (j == snl(c)+1) then + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then + fact(c,j) = dtime/cv(c,j) + else + fact(c,j) = dtime/cv(c,j) * dz(c,j) / (0.5_r8*(z(c,j)-zi(c,j-1)+capr*(z(c,j+1)-zi(c,j-1)))) + end if + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j <= nlevgrnd-1) then + fact(c,j) = dtime/cv(c,j) + fn(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + dzm = (z(c,j)-z(c,j-1)) + else if (j == nlevgrnd) then + fact(c,j) = dtime/cv(c,j) + + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then + fn(c,j) = tk(c,j) * (t_building(l) - cnfac*t_soisno(c,j))/(zi(c,j) - z(c,j)) + else + fn(c,j) = eflx_bot(c) + end if + end if + end if + enddo + end do + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (j >= snl(c)+1) then + if (j == snl(c)+1) then + dzp = z(c,j+1)-z(c,j) + at(c,j) = 0._r8 + bt(c,j) = 1+(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp-fact(c,j)*dhsdT(c) + ct(c,j) = -(1._r8-cnfac)*fact(c,j)*tk(c,j)/dzp + ! changed hs to hs_top + rt(c,j) = t_soisno(c,j) + fact(c,j)*( hs_top(c) - dhsdT(c)*t_soisno(c,j) + cnfac*fn(c,j) ) + else if (j <= nlevgrnd-1) then + dzm = (z(c,j)-z(c,j-1)) + dzp = (z(c,j+1)-z(c,j)) + at(c,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j-1)/dzm + bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j)/dzp + tk(c,j-1)/dzm) + ct(c,j) = - (1._r8-cnfac)*fact(c,j)* tk(c,j)/dzp + + ! if this is a snow layer or the top soil layer, + ! add absorbed solar flux to factor 'rt' + if (j <= 1) then + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + (fact(c,j)*sabg_lyr_col(c,j)) + else + rt(c,j) = t_soisno(c,j) + cnfac*fact(c,j)*( fn(c,j) - fn(c,j-1) ) + endif + + else if (j == nlevgrnd) then + + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then + dzm = ( z(c,j)-z(c,j-1)) + dzp = (zi(c,j)-z(c,j)) + at(c,j) = - (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm) + bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*(tk(c,j-1)/dzm + tk(c,j)/dzp) + ct(c,j) = 0._r8 + rt(c,j) = t_soisno(c,j) + fact(c,j)*( fn(c,j) - cnfac*fn(c,j-1) ) + else + dzm = (z(c,j)-z(c,j-1)) + at(c,j) = - (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + bt(c,j) = 1._r8+ (1._r8-cnfac)*fact(c,j)*tk(c,j-1)/dzm + ct(c,j) = 0._r8 + rt(c,j) = t_soisno(c,j) - cnfac*fact(c,j)*fn(c,j-1) + fact(c,j)*fn(c,j) + end if + end if + + end if + enddo + end do + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + jtop(c) = snl(c) + 1 + end do + call Tridiagonal(lbc, ubc, -nlevsno+1, nlevgrnd, jtop, num_nolakec, filter_nolakec, & + at, bt, ct, rt, t_soisno(lbc:ubc,-nlevsno+1:nlevgrnd)) + + ! Melting or Freezing + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (j >= snl(c)+1) then + if (j <= nlevgrnd-1) then + fn1(c,j) = tk(c,j)*(t_soisno(c,j+1)-t_soisno(c,j))/(z(c,j+1)-z(c,j)) + else if (j == nlevgrnd) then + + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + ! Note new formulation for fn, this will be used below in brr computation + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall .or. ctype(c)==icol_roof) then + fn1(c,j) = tk(c,j) * (t_building(l) - t_soisno(c,j))/(zi(c,j) - z(c,j)) + fn(c,j) = tk(c,j) * (t_building(l) - tssbef(c,j))/(zi(c,j) - z(c,j)) + else + fn1(c,j) = 0._r8 + end if + end if + end if + end do + end do + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (ltype(l) == isturb) then + eflx_building_heat(c) = cnfac*fn(c,nlevurb) + (1-cnfac)*fn1(c,nlevurb) + if (cool_on(l)) then + eflx_urban_ac(c) = abs(eflx_building_heat(c)) + eflx_urban_heat(c) = 0._r8 + else if (heat_on(l)) then + eflx_urban_ac(c) = 0._r8 + eflx_urban_heat(c) = abs(eflx_building_heat(c)) + else + eflx_urban_ac(c) = 0._r8 + eflx_urban_heat(c) = 0._r8 + end if + end if + end do + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (j >= snl(c)+1) then + if (j == snl(c)+1) then + brr(c,j) = cnfac*fn(c,j) + (1._r8-cnfac)*fn1(c,j) + else + brr(c,j) = cnfac*(fn(c,j)-fn(c,j-1)) + (1._r8-cnfac)*(fn1(c,j)-fn1(c,j-1)) + end if + end if + end do + end do + + call PhaseChange (lbc, ubc, num_nolakec, filter_nolakec, fact, brr, hs, dhsdT, xmf, hs_top, sabg_lyr_col) + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + t_grnd(c) = t_soisno(c,snl(c)+1) + end do + + +! Initialize soil heat content + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (ltype(l) /= isturb) then + hc_soisno(c) = 0._r8 + hc_soi(c) = 0._r8 + end if + eflx_fgr12(c)= 0._r8 + end do + +! Calculate soil heat content and soil plus snow heat content + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + eflx_fgr12(c) = -cnfac*fn(c,1) - (1._r8-cnfac)*fn1(c,1) + if (ltype(l) /= isturb) then + if (j >= snl(c)+1) then + hc_soisno(c) = hc_soisno(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8 + endif + if (j >= 1) then + hc_soi(c) = hc_soi(c) + cv(c,j)*t_soisno(c,j) / 1.e6_r8 + end if + end if + end do + end do + + end subroutine SoilTemperature + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SoilThermProp +! +! !INTERFACE: + subroutine SoilThermProp (lbc, ubc, num_nolakec, filter_nolakec, tk, cv) +! +! !DESCRIPTION: +! Calculation of thermal conductivities and heat capacities of +! snow/soil layers +! (1) The volumetric heat capacity is calculated as a linear combination +! in terms of the volumetric fraction of the constituent phases. +! +! (2) The thermal conductivity of soil is computed from the algorithm of +! Johansen (as reported by Farouki 1981), and of snow is from the +! formulation used in SNTHERM (Jordan 1991). +! The thermal conductivities at the interfaces between two neighboring +! layers (j, j+1) are derived from an assumption that the flux across +! the interface is equal to that from the node j to the interface and the +! flux from the interface to the node j+1. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use clm_varcon , only : denh2o, denice, tfrz, tkwat, tkice, tkair, & + cpice, cpliq, istice, istice_mec, istwet, & + icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv + use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, nlevsoi +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + real(r8), intent(out) :: cv(lbc:ubc,-nlevsno+1:nlevgrnd)! heat capacity [J/(m2 K)] + real(r8), intent(out) :: tk(lbc:ubc,-nlevsno+1:nlevgrnd)! thermal conductivity [W/(m K)] +! +! !CALLED FROM: +! subroutine SoilTemperature in this module +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/13/02, Peter Thornton: migrated to new data structures +! 7/01/03, Mariana Vertenstein: migrated to vector code +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in scalars +! + integer , pointer :: ctype(:) ! column type + integer , pointer :: clandunit(:) ! column's landunit + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) +! +! local pointers to original implicit in arrays +! + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: tksatu(:,:) ! thermal conductivity, saturated soil [W/m-K] + real(r8), pointer :: tkmg(:,:) ! thermal conductivity, soil minerals [W/m-K] + real(r8), pointer :: tkdry(:,:) ! thermal conductivity, dry soil (W/m/Kelvin) + real(r8), pointer :: csol(:,:) ! heat capacity, soil solids (J/m**3/Kelvin) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) + real(r8), pointer :: z(:,:) ! layer thickness (m) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: tk_wall(:,:) ! thermal conductivity of urban wall + real(r8), pointer :: tk_roof(:,:) ! thermal conductivity of urban roof + real(r8), pointer :: tk_improad(:,:) ! thermal conductivity of urban impervious road + real(r8), pointer :: cv_wall(:,:) ! thermal conductivity of urban wall + real(r8), pointer :: cv_roof(:,:) ! thermal conductivity of urban roof + real(r8), pointer :: cv_improad(:,:) ! thermal conductivity of urban impervious road + integer, pointer :: nlev_improad(:) ! number of impervious road layers + +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: l,c,j ! indices + integer :: fc ! lake filtered column indices + real(r8) :: bw ! partial density of water (ice + liquid) + real(r8) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(r8) :: dke ! kersten number + real(r8) :: fl ! fraction of liquid or unfrozen water to total water + real(r8) :: satw ! relative total water content of soil. + real(r8) :: thk(lbc:ubc,-nlevsno+1:nlevgrnd) ! thermal conductivity of layer + real(r8) :: thk_bedrock = 3.0_r8 ! thermal conductivity of 'typical' saturated granitic rock + ! (Clauser and Huenges, 1995)(W/m/K) +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + clandunit => col%landunit + snl => cps%snl + h2osno => cws%h2osno + watsat => cps%watsat + tksatu => cps%tksatu + tkmg => cps%tkmg + tkdry => cps%tkdry + csol => cps%csol + dz => cps%dz + zi => cps%zi + z => cps%z + t_soisno => ces%t_soisno + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + tk_wall => lps%tk_wall + tk_roof => lps%tk_roof + tk_improad => lps%tk_improad + cv_wall => lps%cv_wall + cv_roof => lps%cv_roof + cv_improad => lps%cv_improad + nlev_improad => lps%nlev_improad + + ! Thermal conductivity of soil from Farouki (1981) + ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB) + ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol., + ! 41, 1011-1026. + + do j = -nlevsno+1,nlevgrnd + do fc = 1, num_nolakec + c = filter_nolakec(fc) + + ! Only examine levels from 1->nlevgrnd + if (j >= 1) then + l = clandunit(c) + if (ctype(c) == icol_sunwall .OR. ctype(c) == icol_shadewall) then + thk(c,j) = tk_wall(l,j) + else if (ctype(c) == icol_roof) then + thk(c,j) = tk_roof(l,j) + else if (ctype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then + thk(c,j) = tk_improad(l,j) + elseif (ltype(l) /= istwet .AND. ltype(l) /= istice & + .AND. ltype(l) /= istice_mec) then + satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j)) + satw = min(1._r8, satw) + if (satw > .1e-6_r8) then + fl = h2osoi_liq(c,j)/(h2osoi_ice(c,j)+h2osoi_liq(c,j)) + if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil + dke = max(0._r8, log10(satw) + 1.0_r8) + dksat = tksatu(c,j) + else ! Frozen soil + dke = satw + dksat = tkmg(c,j)*0.249_r8**(fl*watsat(c,j))*2.29_r8**watsat(c,j) + endif + thk(c,j) = dke*dksat + (1._r8-dke)*tkdry(c,j) + else + thk(c,j) = tkdry(c,j) + endif + if (j > nlevsoi) thk(c,j) = thk_bedrock + else if (ltype(l) == istice .OR. ltype(l) == istice_mec) then + thk(c,j) = tkwat + if (t_soisno(c,j) < tfrz) thk(c,j) = tkice + else if (ltype(l) == istwet) then + if (j > nlevsoi) then + thk(c,j) = thk_bedrock + else + thk(c,j) = tkwat + if (t_soisno(c,j) < tfrz) thk(c,j) = tkice + endif + endif + endif + + ! Thermal conductivity of snow, which from Jordan (1991) pp. 18 + ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 + if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then + bw = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dz(c,j) + thk(c,j) = tkair + (7.75e-5_r8 *bw + 1.105e-6_r8*bw*bw)*(tkice-tkair) + end if + + end do + end do + + ! Thermal conductivity at the layer interface + + do j = -nlevsno+1,nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (j >= snl(c)+1 .AND. j <= nlevgrnd-1) then + tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) & + /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j))) + else if (j == nlevgrnd) then + + ! For urban sunwall, shadewall, and roof columns, there is a non-zero heat flux across + ! the bottom "soil" layer and the equations are derived assuming a prescribed internal + ! building temperature. (See Oleson urban notes of 6/18/03). + if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall .OR. ctype(c)==icol_roof) then + tk(c,j) = thk(c,j) + else + tk(c,j) = 0._r8 + end if + end if + end do + end do + + ! Soil heat capacity, from de Vires (1963) + ! Urban values are from Masson et al. 2002, Evaluation of the Town Energy Balance (TEB) + ! scheme with direct measurements from dry districts in two cities, J. Appl. Meteorol., + ! 41, 1011-1026. + + do j = 1, nlevgrnd + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall) then + cv(c,j) = cv_wall(l,j) * dz(c,j) + else if (ctype(c) == icol_roof) then + cv(c,j) = cv_roof(l,j) * dz(c,j) + else if (ctype(c) == icol_road_imperv .and. j >= 1 .and. j <= nlev_improad(l)) then + cv(c,j) = cv_improad(l,j) * dz(c,j) + elseif (ltype(l) /= istwet .AND. ltype(l) /= istice & + .AND. ltype(l) /= istice_mec) then + cv(c,j) = csol(c,j)*(1-watsat(c,j))*dz(c,j) + (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + else if (ltype(l) == istwet) then + cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + if (j > nlevsoi) cv(c,j) = csol(c,j)*dz(c,j) + else if (ltype(l) == istice .OR. ltype(l) == istice_mec) then + cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + endif + if (j == 1) then + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8) then + cv(c,j) = cv(c,j) + cpice*h2osno(c) + end if + end if + enddo + end do + + ! Snow heat capacity + + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (snl(c)+1 < 1 .and. j >= snl(c)+1) then + cv(c,j) = cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j) + end if + end do + end do + + end subroutine SoilThermProp + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: PhaseChange +! +! !INTERFACE: + subroutine PhaseChange (lbc, ubc, num_nolakec, filter_nolakec, fact, & + brr, hs, dhsdT, xmf, hs_top, sabg_lyr_col) +! +! !DESCRIPTION: +! Calculation of the phase change within snow and soil layers: +! (1) Check the conditions for which the phase change may take place, +! i.e., the layer temperature is great than the freezing point +! and the ice mass is not equal to zero (i.e. melting), +! or the layer temperature is less than the freezing point +! and the liquid water mass is greater than the allowable supercooled +! liquid water calculated from freezing point depression (i.e. freezing). +! (2) Assess the rate of phase change from the energy excess (or deficit) +! after setting the layer temperature to freezing point. +! (3) Re-adjust the ice and liquid mass, and the layer temperature +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_time_manager, only : get_step_size + use clm_varcon , only : tfrz, hfus, grav, istsoil, istice_mec, isturb, icol_road_perv + use clm_varcon , only : istcrop + use clm_varpar , only : nlevsno, nlevgrnd + +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer , intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + real(r8), intent(in) :: brr (lbc:ubc, -nlevsno+1:nlevgrnd) ! temporary + real(r8), intent(in) :: fact (lbc:ubc, -nlevsno+1:nlevgrnd) ! temporary + real(r8), intent(in) :: hs (lbc:ubc) ! net ground heat flux into the surface + real(r8), intent(in) :: dhsdT (lbc:ubc) ! temperature derivative of "hs" + real(r8), intent(out):: xmf (lbc:ubc) ! total latent heat of phase change + real(r8), intent(in) :: hs_top(lbc:ubc) ! net heat flux into the top snow layer [W/m2] + real(r8), intent(in) :: sabg_lyr_col(lbc:ubc,-nlevsno+1:1) ! absorbed solar radiation (col,lyr) [W/m2] + +! +! !CALLED FROM: +! subroutine SoilTemperature in this module +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 2/14/02, Peter Thornton: Migrated to new data structures. +! 7/01/03, Mariana Vertenstein: Migrated to vector code +! 04/25/07 Keith Oleson: CLM3.5 Hydrology +! 03/28/08 Mark Flanner: accept new arguments and calculate freezing rate of h2o in snow +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in scalars +! + real(r8), pointer :: qflx_snow_melt(:) ! net snow melt + integer , pointer :: snl(:) !number of snow layers + real(r8), pointer :: h2osno(:) !snow water (mm H2O) + integer , pointer :: ltype(:) !landunit type + integer , pointer :: clandunit(:) !column's landunit + integer , pointer :: ctype(:) !column type +! +! local pointers to original implicit inout scalars +! + real(r8), pointer :: snowdp(:) !snow height (m) +! +! local pointers to original implicit out scalars +! + real(r8), pointer :: qflx_snomelt(:) !snow melt (mm H2O /s) + real(r8), pointer :: eflx_snomelt(:) !snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_u(:)!urban snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_r(:)!rural snow melt heat flux (W/m**2) + real(r8), pointer :: qflx_snofrz_lyr(:,:) !snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + real(r8), pointer :: qflx_snofrz_col(:) !column-integrated snow freezing rate (positive definite) [kg m-2 s-1] + real(r8), pointer :: qflx_glcice(:) !flux of new glacier ice (mm H2O/s) [+ = ice grows] + real(r8), pointer :: qflx_glcice_melt(:) !ice melt (positive definite) (mm H2O/s) +! +! local pointers to original implicit in arrays +! + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) (new) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) (new) + real(r8), pointer :: tssbef(:,:) !temperature at previous time step [K] + real(r8), pointer :: sucsat(:,:) !minimum soil suction (mm) + real(r8), pointer :: watsat(:,:) !volumetric soil water at saturation (porosity) + real(r8), pointer :: bsw(:,:) !Clapp and Hornberger "b" + real(r8), pointer :: dz(:,:) !layer thickness (m) +! +! local pointers to original implicit inout arrays +! + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) +! +! local pointers to original implicit out arrays +! + integer, pointer :: imelt(:,:) !flag for melting (=1), freezing (=2), Not=0 (new) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: j,c,g,l !do loop index + integer :: fc !lake filtered column indices + real(r8) :: dtime !land model time step (sec) + real(r8) :: heatr !energy residual or loss after melting or freezing + real(r8) :: temp1 !temporary variables [kg/m2] + real(r8) :: hm(lbc:ubc,-nlevsno+1:nlevgrnd) !energy residual [W/m2] + real(r8) :: xm(lbc:ubc,-nlevsno+1:nlevgrnd) !melting or freezing within a time step [kg/m2] + real(r8) :: wmass0(lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of ice and liquid (kg/m2) + real(r8) :: wice0 (lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of ice (kg/m2) + real(r8) :: wliq0 (lbc:ubc,-nlevsno+1:nlevgrnd)!initial mass of liquid (kg/m2) + real(r8) :: supercool(lbc:ubc,nlevgrnd) !supercooled water in soil (kg/m2) + real(r8) :: propor !proportionality constant (-) + real(r8) :: tinc !t(n+1)-t(n) (K) + real(r8) :: smp !frozen water potential (mm) +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (column-level) + + snl => cps%snl + h2osno => cws%h2osno + snowdp => cps%snowdp + qflx_snow_melt => cwf%qflx_snow_melt + qflx_snomelt => cwf%qflx_snomelt + eflx_snomelt => cef%eflx_snomelt + eflx_snomelt_u => cef%eflx_snomelt_u + eflx_snomelt_r => cef%eflx_snomelt_r + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + imelt => cps%imelt + t_soisno => ces%t_soisno + tssbef => ces%tssbef + bsw => cps%bsw + sucsat => cps%sucsat + watsat => cps%watsat + dz => cps%dz + ctype => col%itype + clandunit => col%landunit + ltype => lun%itype + qflx_snofrz_lyr => cwf%qflx_snofrz_lyr + qflx_snofrz_col => cwf%qflx_snofrz_col + qflx_glcice => cwf%qflx_glcice + qflx_glcice_melt => cwf%qflx_glcice_melt + + ! Get step size + + dtime = get_step_size() + + ! Initialization + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + + qflx_snomelt(c) = 0._r8 + qflx_snow_melt(c) = 0._r8 + xmf(c) = 0._r8 + qflx_snofrz_lyr(c,-nlevsno+1:0) = 0._r8 + qflx_snofrz_col(c) = 0._r8 + if (ltype(l)==istice_mec) then + ! only need to initialize qflx_glcice_melt over ice_mec landunits, because + ! those are the only places where it is computed + qflx_glcice_melt(c) = 0._r8 + end if + end do + + do j = -nlevsno+1,nlevgrnd ! all layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (j >= snl(c)+1) then + + ! Initialization + imelt(c,j) = 0 + hm(c,j) = 0._r8 + xm(c,j) = 0._r8 + wice0(c,j) = h2osoi_ice(c,j) + wliq0(c,j) = h2osoi_liq(c,j) + wmass0(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j) + endif ! end of snow layer if-block + end do ! end of column-loop + enddo ! end of level-loop + + do j = -nlevsno+1,0 ! snow layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + if (j >= snl(c)+1) then + + ! Melting identification + ! If ice exists above melt point, melt some to liquid. + if (h2osoi_ice(c,j) > 0._r8 .AND. t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + t_soisno(c,j) = tfrz + endif + + ! Freezing identification + ! If liquid exists below melt point, freeze some to ice. + if (h2osoi_liq(c,j) > 0._r8 .AND. t_soisno(c,j) < tfrz) then + imelt(c,j) = 2 + t_soisno(c,j) = tfrz + endif + endif ! end of snow layer if-block + end do ! end of column-loop + enddo ! end of level-loop + + do j = 1,nlevgrnd ! soil layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + l = clandunit(c) + if (h2osoi_ice(c,j) > 0. .AND. t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + t_soisno(c,j) = tfrz + endif + + ! from Zhao (1997) and Koren (1999) + supercool(c,j) = 0.0_r8 + if (ltype(l) == istsoil .or. ltype(l) == istcrop .or. ctype(c) == icol_road_perv) then + if(t_soisno(c,j) < tfrz) then + smp = hfus*(tfrz-t_soisno(c,j))/(grav*t_soisno(c,j)) * 1000._r8 !(mm) + supercool(c,j) = watsat(c,j)*(smp/sucsat(c,j))**(-1._r8/bsw(c,j)) + supercool(c,j) = supercool(c,j)*dz(c,j)*1000._r8 ! (mm) + endif + endif + + if (h2osoi_liq(c,j) > supercool(c,j) .AND. t_soisno(c,j) < tfrz) then + imelt(c,j) = 2 + t_soisno(c,j) = tfrz + endif + + ! If snow exists, but its thickness is less than the critical value (0.01 m) + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. j == 1) then + if (t_soisno(c,j) > tfrz) then + imelt(c,j) = 1 + t_soisno(c,j) = tfrz + endif + endif + end do + enddo + + do j = -nlevsno+1,nlevgrnd ! all layers + do fc = 1,num_nolakec + c = filter_nolakec(fc) + + if (j >= snl(c)+1) then + + ! Calculate the energy surplus and loss for melting and freezing + if (imelt(c,j) > 0) then + tinc = t_soisno(c,j)-tssbef(c,j) + + ! added unique cases for this calculation, + ! to account for absorbed solar radiation in each layer + if (j == snl(c)+1) then + ! top layer + hm(c,j) = hs_top(c) + dhsdT(c)*tinc + brr(c,j) - tinc/fact(c,j) + elseif (j <= 1) then + ! snow layer or top soil layer (where sabg_lyr_col is defined) + hm(c,j) = brr(c,j) - tinc/fact(c,j) + sabg_lyr_col(c,j) + else + ! soil layer + hm(c,j) = brr(c,j) - tinc/fact(c,j) + endif + + endif + + ! These two errors were checked carefully (Y. Dai). They result from the + ! computed error of "Tridiagonal-Matrix" in subroutine "thermal". + if (imelt(c,j) == 1 .AND. hm(c,j) < 0._r8) then + hm(c,j) = 0._r8 + imelt(c,j) = 0 + endif + if (imelt(c,j) == 2 .AND. hm(c,j) > 0._r8) then + hm(c,j) = 0._r8 + imelt(c,j) = 0 + endif + + ! The rate of melting and freezing + + if (imelt(c,j) > 0 .and. abs(hm(c,j)) > 0._r8) then + xm(c,j) = hm(c,j)*dtime/hfus ! kg/m2 + + ! If snow exists, but its thickness is less than the critical value + ! (1 cm). Note: more work is needed to determine how to tune the + ! snow depth for this case + if (j == 1) then + if (snl(c)+1 == 1 .AND. h2osno(c) > 0._r8 .AND. xm(c,j) > 0._r8) then + temp1 = h2osno(c) ! kg/m2 + h2osno(c) = max(0._r8,temp1-xm(c,j)) + propor = h2osno(c)/temp1 + snowdp(c) = propor * snowdp(c) + heatr = hm(c,j) - hfus*(temp1-h2osno(c))/dtime ! W/m2 + if (heatr > 0._r8) then + xm(c,j) = heatr*dtime/hfus ! kg/m2 + hm(c,j) = heatr ! W/m2 + else + xm(c,j) = 0._r8 + hm(c,j) = 0._r8 + endif + qflx_snomelt(c) = max(0._r8,(temp1-h2osno(c)))/dtime ! kg/(m2 s) + xmf(c) = hfus*qflx_snomelt(c) + qflx_snow_melt(c) = qflx_snomelt(c) + endif + endif + + heatr = 0._r8 + if (xm(c,j) > 0._r8) then + h2osoi_ice(c,j) = max(0._r8, wice0(c,j)-xm(c,j)) + heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + else if (xm(c,j) < 0._r8) then + if (j <= 0) then + h2osoi_ice(c,j) = min(wmass0(c,j), wice0(c,j)-xm(c,j)) ! snow + else + if (wmass0(c,j) < supercool(c,j)) then + h2osoi_ice(c,j) = 0._r8 + else + h2osoi_ice(c,j) = min(wmass0(c,j) - supercool(c,j),wice0(c,j)-xm(c,j)) + endif + endif + heatr = hm(c,j) - hfus*(wice0(c,j)-h2osoi_ice(c,j))/dtime + endif + + h2osoi_liq(c,j) = max(0._r8,wmass0(c,j)-h2osoi_ice(c,j)) + + if (abs(heatr) > 0._r8) then + if (j > snl(c)+1) then + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr + else + t_soisno(c,j) = t_soisno(c,j) + fact(c,j)*heatr/(1._r8-fact(c,j)*dhsdT(c)) + endif + if (j <= 0) then ! snow + if (h2osoi_liq(c,j)*h2osoi_ice(c,j)>0._r8) t_soisno(c,j) = tfrz + end if + endif + + xmf(c) = xmf(c) + hfus * (wice0(c,j)-h2osoi_ice(c,j))/dtime + + if (imelt(c,j) == 1 .AND. j < 1) then + qflx_snomelt(c) = qflx_snomelt(c) + max(0._r8,(wice0(c,j)-h2osoi_ice(c,j)))/dtime + endif + + ! layer freezing mass flux (positive): + if (imelt(c,j) == 2 .AND. j < 1) then + qflx_snofrz_lyr(c,j) = max(0._r8,(h2osoi_ice(c,j)-wice0(c,j)))/dtime + endif + + endif + endif ! end of snow layer if-block + + ! For glacier_mec columns, compute negative ice flux from melted ice. + ! Note that qflx_glcice can also include a positive component from excess snow, + ! as computed in Hydrology2Mod.F90. + + l = clandunit(c) + if (ltype(l)==istice_mec) then + + if (j>=1 .and. h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater + ! melting corresponds to a negative ice flux + qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime + qflx_glcice(c) = qflx_glcice(c) - h2osoi_liq(c,j)/dtime + + ! convert layer back to pure ice by "borrowing" ice from below the column + h2osoi_ice(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j) + h2osoi_liq(c,j) = 0._r8 + + endif ! liquid water is present + endif ! istice_mec + + end do ! end of column-loop + enddo ! end of level-loop + + ! Needed for history file output + + do fc = 1,num_nolakec + c = filter_nolakec(fc) + eflx_snomelt(c) = qflx_snomelt(c) * hfus + l = clandunit(c) + if (ltype(l) == isturb) then + eflx_snomelt_u(c) = eflx_snomelt(c) + else if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + eflx_snomelt_r(c) = eflx_snomelt(c) + end if + end do + + do j = -nlevsno+1,0 + do fc = 1,num_nolakec + c = filter_nolakec(fc) + qflx_snofrz_col(c) = qflx_snofrz_col(c) + qflx_snofrz_lyr(c,j) + end do + end do + + end subroutine PhaseChange + + +end module SoilTemperatureMod diff --git a/components/clm/src_clm40/biogeophys/SurfaceAlbedoMod.F90 b/components/clm/src_clm40/biogeophys/SurfaceAlbedoMod.F90 new file mode 100644 index 0000000000..1fa9e12055 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SurfaceAlbedoMod.F90 @@ -0,0 +1,1045 @@ +module SurfaceAlbedoMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: SurfaceAlbedoMod +! +! !DESCRIPTION: +! Performs surface albedo calculations +! +! !PUBLIC TYPES: + use clm_varcon , only : istsoil + use clm_varpar , only : numrad + use clm_varcon , only : istcrop + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varpar , only : nlevsno + use SNICARMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC + use clm_varctl , only : use_snicar_frc + + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceAlbedo ! Surface albedo and two-stream fluxes +! +! !PUBLIC DATA MEMBERS: +! The CLM default albice values are too high. +! Full-spectral albedo for land ice is ~0.5 (Paterson, Physics of Glaciers, 1994, p. 59) +! This is the value used in CAM3 by Pritchard et al., GRL, 35, 2008. + + real(r8), public :: albice(numrad) = & ! albedo land ice by waveband (1=vis, 2=nir) + (/ 0.80_r8, 0.55_r8 /) +! +! !PRIVATE MEMBER FUNCTIONS: + private :: SoilAlbedo ! Determine ground surface albedo + private :: TwoStream ! Two-stream fluxes for canopy radiative transfer + +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SurfaceAlbedo +! +! !INTERFACE: + subroutine SurfaceAlbedo(lbg, ubg, lbc, ubc, lbp, ubp, & + num_nourbanc, filter_nourbanc, & + num_nourbanp, filter_nourbanp, & + nextsw_cday, declinp1) +! +! !DESCRIPTION: +! Surface albedo and two-stream fluxes +! Surface albedos. Also fluxes (per unit incoming direct and diffuse +! radiation) reflected, transmitted, and absorbed by vegetation. +! Also sunlit fraction of the canopy. +! The calling sequence is: +! -> SurfaceAlbedo: albedos for next time step +! -> SoilAlbedo: soil/lake/glacier/wetland albedos +! -> SNICAR_RT: snow albedos: direct beam (SNICAR) +! -> SNICAR_RT: snow albedos: diffuse (SNICAR) +! -> TwoStream: absorbed, reflected, transmitted solar fluxes (vis dir,vis dif, nir dir, nir dif) +! + +! !USES: + use clmtype + use shr_orb_mod + use clm_time_manager, only : get_nstep + +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbg, ubg ! gridcell bounds + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: lbp, ubp ! pft bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter + integer , intent(in) :: filter_nourbanc(ubc-lbc+1) ! column filter for non-urban points + integer , intent(in) :: num_nourbanp ! number of pfts in non-urban filter + integer , intent(in) :: filter_nourbanp(ubp-lbp+1) ! pft filter for non-urban points + real(r8), intent(in) :: nextsw_cday ! calendar day at Greenwich (1.00, ..., days/year) + real(r8), intent(in) :: declinp1 ! declination angle (radians) for next time step +! +! !CALLED FROM: +! subroutine clm_driver1 +! subroutine iniTimeVar +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 2/1/02, Peter Thornton: Migrate to new data structures +! 8/20/03, Mariana Vertenstein: Vectorized routine +! 11/3/03, Peter Thornton: added decl(c) output for use in CN code. +! 03/28/08, Mark Flanner: added SNICAR, which required reversing the +! order of calls to SNICAR_RT and SoilAlbedo and the location where +! ground albedo is calculated +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: plandunit(:) ! index into landunit level quantities + integer , pointer :: itypelun(:) ! landunit type + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: cgridcell(:) ! gridcell of corresponding column + real(r8), pointer :: pwtgcell(:) ! weight of pft wrt corresponding gridcell + real(r8), pointer :: lat(:) ! gridcell latitude (radians) + real(r8), pointer :: lon(:) ! gridcell longitude (radians) + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: rhol(:,:) ! leaf reflectance: 1=vis, 2=nir + real(r8), pointer :: rhos(:,:) ! stem reflectance: 1=vis, 2=nir + real(r8), pointer :: taul(:,:) ! leaf transmittance: 1=vis, 2=nir + real(r8), pointer :: taus(:,:) ! stem transmittance: 1=vis, 2=nir + integer , pointer :: ivt(:) ! pft vegetation type +! +! local pointers toimplicit out arguments +! + real(r8), pointer :: coszen(:) ! cosine of solar zenith angle + real(r8), pointer :: fsun(:) ! sunlit fraction of canopy + real(r8), pointer :: albgrd(:,:) ! ground albedo (direct) + real(r8), pointer :: albgri(:,:) ! ground albedo (diffuse) + real(r8), pointer :: albd(:,:) ! surface albedo (direct) + real(r8), pointer :: albi(:,:) ! surface albedo (diffuse) + real(r8), pointer :: fabd(:,:) ! flux absorbed by veg per unit direct flux + real(r8), pointer :: fabi(:,:) ! flux absorbed by veg per unit diffuse flux + real(r8), pointer :: ftdd(:,:) ! down direct flux below veg per unit dir flx + real(r8), pointer :: ftid(:,:) ! down diffuse flux below veg per unit dir flx + real(r8), pointer :: ftii(:,:) ! down diffuse flux below veg per unit dif flx + real(r8), pointer :: decl(:) ! solar declination angle (radians) + real(r8), pointer :: gdir(:) ! leaf projection in solar direction (0 to 1) + real(r8), pointer :: omega(:,:) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water content (col,lyr) [kg/m2] + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens content (col,lyr) [kg/m2] + real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of hydrophilic BC (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of hydrophobic BC (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of hydrophilic OC (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of hydrophobic OC (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst1(:,:) ! mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst2(:,:) ! mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst3(:,:) ! mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst4(:,:) ! mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] + real(r8), pointer :: albsod(:,:) ! direct-beam soil albedo (col,bnd) [frc] + real(r8), pointer :: albsoi(:,:) ! diffuse soil albedo (col,bnd) [frc] + real(r8), pointer :: flx_absdv(:,:) ! direct flux absorption factor (col,lyr): VIS [frc] + real(r8), pointer :: flx_absdn(:,:) ! direct flux absorption factor (col,lyr): NIR [frc] + real(r8), pointer :: flx_absiv(:,:) ! diffuse flux absorption factor (col,lyr): VIS [frc] + real(r8), pointer :: flx_absin(:,:) ! diffuse flux absorption factor (col,lyr): NIR [frc] + real(r8), pointer :: snw_rds(:,:) ! snow grain radius (col,lyr) [microns] + real(r8), pointer :: albgrd_pur(:,:) ! pure snow ground albedo (direct) + real(r8), pointer :: albgri_pur(:,:) ! pure snow ground albedo (diffuse) + real(r8), pointer :: albgrd_bc(:,:) ! ground albedo without BC (direct) + real(r8), pointer :: albgri_bc(:,:) ! ground albedo without BC (diffuse) + real(r8), pointer :: albgrd_oc(:,:) ! ground albedo without OC (direct) + real(r8), pointer :: albgri_oc(:,:) ! ground albedo without OC (diffuse) + real(r8), pointer :: albgrd_dst(:,:) ! ground albedo without dust (direct) + real(r8), pointer :: albgri_dst(:,:) ! ground albedo without dust (diffuse) + real(r8), pointer :: albsnd_hst(:,:) ! snow albedo, direct, for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst(:,:) ! snow ground albedo, diffuse, for history files (col,bnd) [frc] +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer :: fp,fc,g,c,p ! indices + integer :: ib ! band index + integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + real(r8) :: wl(lbp:ubp) ! fraction of LAI+SAI that is LAI + real(r8) :: ws(lbp:ubp) ! fraction of LAI+SAI that is SAI + real(r8) :: vai(lbp:ubp) ! elai+esai + real(r8) :: rho(lbp:ubp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI + real(r8) :: tau(lbp:ubp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI + real(r8) :: ftdi(lbp:ubp,numrad) ! down direct flux below veg per unit dif flux = 0 + real(r8) :: albsnd(lbc:ubc,numrad) ! snow albedo (direct) + real(r8) :: albsni(lbc:ubc,numrad) ! snow albedo (diffuse) + real(r8) :: ext(lbp:ubp) ! optical depth direct beam per unit LAI+SAI + real(r8) :: coszen_gcell(lbg:ubg) ! cosine solar zenith angle for next time step (gridcell level) + real(r8) :: coszen_col(lbc:ubc) ! cosine solar zenith angle for next time step (pft level) + real(r8) :: coszen_pft(lbp:ubp) ! cosine solar zenith angle for next time step (pft level) + integer :: num_vegsol ! number of vegetated pfts where coszen>0 + integer :: filter_vegsol(ubp-lbp+1) ! pft filter where vegetated and coszen>0 + integer :: num_novegsol ! number of vegetated pfts where coszen>0 + integer :: filter_novegsol(ubp-lbp+1) ! pft filter where vegetated and coszen>0 + integer, parameter :: nband =numrad ! number of solar radiation waveband classes + integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) + integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) + real(r8) :: albsnd_pur(lbc:ubc,numrad) ! direct pure snow albedo (radiative forcing) + real(r8) :: albsni_pur(lbc:ubc,numrad) ! diffuse pure snow albedo (radiative forcing) + real(r8) :: albsnd_bc(lbc:ubc,numrad) ! direct snow albedo without BC (radiative forcing) + real(r8) :: albsni_bc(lbc:ubc,numrad) ! diffuse snow albedo without BC (radiative forcing) + real(r8) :: albsnd_oc(lbc:ubc,numrad) ! direct snow albedo without OC (radiative forcing) + real(r8) :: albsni_oc(lbc:ubc,numrad) ! diffuse snow albedo without OC (radiative forcing) + real(r8) :: albsnd_dst(lbc:ubc,numrad) ! direct snow albedo without dust (radiative forcing) + real(r8) :: albsni_dst(lbc:ubc,numrad) ! diffuse snow albedo without dust (radiative forcing) + integer :: i ! index for layers [idx] + real(r8) :: flx_absd_snw(lbc:ubc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (direct) [frc] + real(r8) :: flx_absi_snw(lbc:ubc,-nlevsno+1:1,numrad) ! flux absorption factor for just snow (diffuse) [frc] + real(r8) :: foo_snw(lbc:ubc,-nlevsno+1:1,numrad) ! dummy array for forcing calls + real(r8) :: albsfc(lbc:ubc,numrad) ! albedo of surface underneath snow (col,bnd) + real(r8) :: h2osno_liq(lbc:ubc,-nlevsno+1:0) ! liquid snow content (col,lyr) [kg m-2] + real(r8) :: h2osno_ice(lbc:ubc,-nlevsno+1:0) ! ice content in snow (col,lyr) [kg m-2] + integer :: snw_rds_in(lbc:ubc,-nlevsno+1:0) ! snow grain size sent to SNICAR (col,lyr) [microns] + real(r8) :: mss_cnc_aer_in_frc_pur(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for forcing calculation (zero) (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_bc(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for BC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_oc(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for OC forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_frc_dst(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of aerosol species for dust forcing (col,lyr,aer) [kg kg-1] + real(r8) :: mss_cnc_aer_in_fdb(lbc:ubc,-nlevsno+1:0,sno_nbr_aer) ! mass concentration of all aerosol species for feedback calculation (col,lyr,aer) [kg kg-1] + !----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (gridcell-level) + + lat => grc%lat + lon => grc%lon + + ! Assign local pointers to derived subtypes components (landunit level) + + itypelun => lun%itype + + ! Assign local pointers to derived subtypes components (column-level) + + cgridcell => col%gridcell + h2osno => cws%h2osno + albgrd => cps%albgrd + albgri => cps%albgri + decl => cps%decl + coszen => cps%coszen + albsod => cps%albsod + albsoi => cps%albsoi + frac_sno => cps%frac_sno + flx_absdv => cps%flx_absdv + flx_absdn => cps%flx_absdn + flx_absiv => cps%flx_absiv + flx_absin => cps%flx_absin + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + snw_rds => cps%snw_rds + albgrd_pur => cps%albgrd_pur + albgri_pur => cps%albgri_pur + albgrd_bc => cps%albgrd_bc + albgri_bc => cps%albgri_bc + albgrd_oc => cps%albgrd_oc + albgri_oc => cps%albgri_oc + albgrd_dst => cps%albgrd_dst + albgri_dst => cps%albgri_dst + mss_cnc_bcphi => cps%mss_cnc_bcphi + mss_cnc_bcpho => cps%mss_cnc_bcpho + mss_cnc_ocphi => cps%mss_cnc_ocphi + mss_cnc_ocpho => cps%mss_cnc_ocpho + mss_cnc_dst1 => cps%mss_cnc_dst1 + mss_cnc_dst2 => cps%mss_cnc_dst2 + mss_cnc_dst3 => cps%mss_cnc_dst3 + mss_cnc_dst4 => cps%mss_cnc_dst4 + albsnd_hst => cps%albsnd_hst + albsni_hst => cps%albsni_hst + + ! Assign local pointers to derived subtypes components (pft-level) + + plandunit => pft%landunit + pgridcell => pft%gridcell + pcolumn => pft%column + pwtgcell => pft%wtgcell + albd => pps%albd + albi => pps%albi + fabd => pps%fabd + fabi => pps%fabi + ftdd => pps%ftdd + ftid => pps%ftid + ftii => pps%ftii + fsun => pps%fsun + elai => pps%elai + esai => pps%esai + gdir => pps%gdir + omega => pps%omega + ivt => pft%itype + rhol => pftcon%rhol + rhos => pftcon%rhos + taul => pftcon%taul + taus => pftcon%taus + + + ! Cosine solar zenith angle for next time step + + do g = lbg, ubg + coszen_gcell(g) = shr_orb_cosz (nextsw_cday, lat(g), lon(g), declinp1) + end do + + ! Save coszen and declination values to clm3 data structures for + ! use in other places in the CN and urban code + + do c = lbc,ubc + g = cgridcell(c) + coszen_col(c) = coszen_gcell(g) + coszen(c) = coszen_col(c) + decl(c) = declinp1 + end do + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) +! if (pwtgcell(p)>0._r8) then ! "if" added due to chg in filter definition + g = pgridcell(p) + coszen_pft(p) = coszen_gcell(g) +! end if ! then removed for CNDV (and dyn. landuse?) cases to work + end do + + ! Initialize output because solar radiation only done if coszen > 0 + + do ib = 1, numrad + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + albgrd(c,ib) = 0._r8 + albgri(c,ib) = 0._r8 + albgrd_pur(c,ib) = 0._r8 + albgri_pur(c,ib) = 0._r8 + albgrd_bc(c,ib) = 0._r8 + albgri_bc(c,ib) = 0._r8 + albgrd_oc(c,ib) = 0._r8 + albgri_oc(c,ib) = 0._r8 + albgrd_dst(c,ib) = 0._r8 + albgri_dst(c,ib) = 0._r8 + do i=-nlevsno+1,1,1 + flx_absdv(c,i) = 0._r8 + flx_absdn(c,i) = 0._r8 + flx_absiv(c,i) = 0._r8 + flx_absin(c,i) = 0._r8 + enddo + end do + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) +! if (pwtgcell(p)>0._r8) then ! "if" added due to chg in filter definition + albd(p,ib) = 1._r8 + albi(p,ib) = 1._r8 + fabd(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + ftdd(p,ib) = 0._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 0._r8 + omega(p,ib)= 0._r8 + if (ib==1) then + gdir(p) = 0._r8 + end if +! end if ! then removed for CNDV (and dyn. landuse?) cases to work + end do + end do + + ! SoilAlbedo called before SNICAR_RT + ! so that reflectance of soil beneath snow column is known + ! ahead of time for snow RT calculation. + + ! Snow albedos + ! Note that snow albedo routine will only compute nonzero snow albedos + ! where h2osno> 0 and coszen > 0 + + ! Ground surface albedos + ! Note that ground albedo routine will only compute nonzero snow albedos + ! where coszen > 0 + + call SoilAlbedo(lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, albsnd, albsni) + + ! set variables to pass to SNICAR. + + flg_snw_ice = 1 ! calling from CLM, not CSIM + do c=lbc,ubc + albsfc(c,:) = albsoi(c,:) + h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) + h2osno_ice(c,:) = h2osoi_ice(c,-nlevsno+1:0) + snw_rds_in(c,:) = nint(snw_rds(c,:)) + + ! zero aerosol input arrays + mss_cnc_aer_in_frc_pur(c,:,:) = 0._r8 + mss_cnc_aer_in_frc_bc(c,:,:) = 0._r8 + mss_cnc_aer_in_frc_oc(c,:,:) = 0._r8 + mss_cnc_aer_in_frc_dst(c,:,:) = 0._r8 + mss_cnc_aer_in_fdb(c,:,:) = 0._r8 + end do + + ! Set aerosol input arrays + ! feedback input arrays have been zeroed + ! set soot and dust aerosol concentrations: + if (DO_SNO_AER) then + mss_cnc_aer_in_fdb(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:) + mss_cnc_aer_in_fdb(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:) + + ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: + ! 1) Knowledge of their optical properties is primitive + ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, + ! it has a negligible darkening effect. + if (DO_SNO_OC) then + mss_cnc_aer_in_fdb(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:) + mss_cnc_aer_in_fdb(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:) + endif + + mss_cnc_aer_in_fdb(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:) + mss_cnc_aer_in_fdb(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:) + mss_cnc_aer_in_fdb(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:) + mss_cnc_aer_in_fdb(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:) + endif + + +! If radiative forcing is being calculated, first estimate clean-snow albedo + + if (use_snicar_frc) then + + ! 1. BC input array: + ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] + mss_cnc_aer_in_frc_bc(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:) + mss_cnc_aer_in_frc_bc(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:) + mss_cnc_aer_in_frc_bc(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:) + mss_cnc_aer_in_frc_bc(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_bc(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:) + mss_cnc_aer_in_frc_bc(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:) + endif + + ! BC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_bc, albsfc, albsnd_bc, foo_snw) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_bc, albsfc, albsni_bc, foo_snw) + + + ! 2. OC input array: + ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_oc(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:) + mss_cnc_aer_in_frc_oc(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:) + mss_cnc_aer_in_frc_oc(lbc:ubc,:,5) = mss_cnc_dst1(lbc:ubc,:) + mss_cnc_aer_in_frc_oc(lbc:ubc,:,6) = mss_cnc_dst2(lbc:ubc,:) + mss_cnc_aer_in_frc_oc(lbc:ubc,:,7) = mss_cnc_dst3(lbc:ubc,:) + mss_cnc_aer_in_frc_oc(lbc:ubc,:,8) = mss_cnc_dst4(lbc:ubc,:) + + ! OC FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_oc, albsfc, albsnd_oc, foo_snw) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_oc, albsfc, albsni_oc, foo_snw) + endif + + ! 3. DUST input array: + ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] + mss_cnc_aer_in_frc_dst(lbc:ubc,:,1) = mss_cnc_bcphi(lbc:ubc,:) + mss_cnc_aer_in_frc_dst(lbc:ubc,:,2) = mss_cnc_bcpho(lbc:ubc,:) + if (DO_SNO_OC) then + mss_cnc_aer_in_frc_dst(lbc:ubc,:,3) = mss_cnc_ocphi(lbc:ubc,:) + mss_cnc_aer_in_frc_dst(lbc:ubc,:,4) = mss_cnc_ocpho(lbc:ubc,:) + endif + + ! DUST FORCING CALCULATIONS + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_dst, albsfc, albsnd_dst, foo_snw) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_dst, albsfc, albsni_dst, foo_snw) + + + ! 4. ALL AEROSOL FORCING CALCULATION + ! (pure snow albedo) + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_pur, albsfc, albsnd_pur, foo_snw) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_frc_pur, albsfc, albsni_pur, foo_snw) + + end if + + ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: + flg_slr = 1; ! direct-beam + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_fdb, albsfc, albsnd, flx_absd_snw) + + flg_slr = 2; ! diffuse + call SNICAR_RT(flg_snw_ice, lbc, ubc, num_nourbanc, filter_nourbanc, & + coszen_col, flg_slr, h2osno_liq, h2osno_ice, snw_rds_in, & + mss_cnc_aer_in_fdb, albsfc, albsni, flx_absi_snw) + + ! ground albedos and snow-fraction weighting of snow absorption factors + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen(c) > 0._r8) then + ! ground albedo was originally computed in SoilAlbedo, but is now computed here + ! because the order of SoilAlbedo and SNICAR_RT was switched for SNICAR. + albgrd(c,ib) = albsod(c,ib)*(1._r8-frac_sno(c)) + albsnd(c,ib)*frac_sno(c) + albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) + + ! albedos for radiative forcing calculations: + if (use_snicar_frc) then + + ! BC forcing albedo + albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) + albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) + + if (DO_SNO_OC) then + ! OC forcing albedo + albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) + albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) + endif + + ! dust forcing albedo + albgrd_dst(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_dst(c,ib)*frac_sno(c) + albgri_dst(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_dst(c,ib)*frac_sno(c) + + ! pure snow albedo for all-aerosol radiative forcing + albgrd_pur(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_pur(c,ib)*frac_sno(c) + albgri_pur(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_pur(c,ib)*frac_sno(c) + + end if + + ! also in this loop (but optionally in a different loop for vectorized code) + ! weight snow layer radiative absorption factors based on snow fraction and soil albedo + ! (NEEDED FOR ENERGY CONSERVATION) + do i = -nlevsno+1,1,1 + if (ib == 1) then + flx_absdv(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absiv(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + elseif (ib == 2) then + flx_absdn(c,i) = flx_absd_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsod(c,ib))*(flx_absd_snw(c,i,ib)/(1.-albsnd(c,ib)))) + flx_absin(c,i) = flx_absi_snw(c,i,ib)*frac_sno(c) + & + ((1.-frac_sno(c))*(1-albsoi(c,ib))*(flx_absi_snw(c,i,ib)/(1.-albsni(c,ib)))) + endif + enddo + endif + enddo + enddo + + ! for diagnostics, set snow albedo to spval over non-snow points + ! so that it is not averaged in history buffer + ! (OPTIONAL) + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if ((coszen(c) > 0._r8) .and. (h2osno(c) > 0._r8)) then + albsnd_hst(c,ib) = albsnd(c,ib) + albsni_hst(c,ib) = albsni(c,ib) + else + albsnd_hst(c,ib) = 0._r8 + albsni_hst(c,ib) = 0._r8 + endif + enddo + enddo + + ! Create solar-vegetated filter for the following calculations + + num_vegsol = 0 + num_novegsol = 0 + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (coszen_pft(p) > 0._r8) then + if ((itypelun(plandunit(p)) == istsoil .or. & + itypelun(plandunit(p)) == istcrop ) & + .and. (elai(p) + esai(p)) > 0._r8 & + .and. pwtgcell(p) > 0._r8) then + num_vegsol = num_vegsol + 1 + filter_vegsol(num_vegsol) = p + else + num_novegsol = num_novegsol + 1 + filter_novegsol(num_novegsol) = p + end if + end if + end do + + ! Weight reflectance/transmittance by lai and sai + ! Only perform on vegetated pfts where coszen > 0 + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + vai(p) = elai(p) + esai(p) + wl(p) = elai(p) / max( vai(p), mpe ) + ws(p) = esai(p) / max( vai(p), mpe ) + end do + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + rho(p,ib) = max( rhol(ivt(p),ib)*wl(p) + rhos(ivt(p),ib)*ws(p), mpe ) + tau(p,ib) = max( taul(ivt(p),ib)*wl(p) + taus(ivt(p),ib)*ws(p), mpe ) + end do + end do + + ! Calculate surface albedos and fluxes + ! Only perform on vegetated pfts where coszen > 0 + + call TwoStream (lbc, ubc, lbp, ubp, filter_vegsol, num_vegsol, & + coszen_pft, vai, rho, tau) + + ! Determine values for non-vegetated pfts where coszen > 0 + + do ib = 1,numrad + do fp = 1,num_novegsol + p = filter_novegsol(fp) + c = pcolumn(p) + fabd(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + ftdd(p,ib) = 1._r8 + ftid(p,ib) = 0._r8 + ftii(p,ib) = 1._r8 + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + gdir(p) = 0._r8 + end do + end do + + end subroutine SurfaceAlbedo + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: SoilAlbedo +! +! !INTERFACE: + subroutine SoilAlbedo (lbc, ubc, num_nourbanc, filter_nourbanc, coszen, albsnd, albsni) +! +! !DESCRIPTION: +! Determine ground surface albedo, accounting for snow +! +! !USES: + use clmtype + use clm_varpar, only : numrad + use clm_varcon, only : albsat, albdry, alblak, tfrz, istice, istice_mec +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: num_nourbanc ! number of columns in non-urban points in column filter + integer , intent(in) :: filter_nourbanc(ubc-lbc+1) ! column filter for non-urban points + real(r8), intent(in) :: coszen(lbc:ubc) ! cos solar zenith angle next time step (column-level) + real(r8), intent(in) :: albsnd(lbc:ubc,numrad) ! snow albedo (direct) + real(r8), intent(in) :: albsni(lbc:ubc,numrad) ! snow albedo (diffuse) +! +! !CALLED FROM: +! subroutine SurfaceAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 2/5/02, Peter Thornton: Migrated to new data structures. +! 8/20/03, Mariana Vertenstein: Vectorized routine +! 03/28/08, Mark Flanner: changes for SNICAR +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: isoicol(:) ! soil color class + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water [m3/m3] +! +! local pointers to original implicit out arguments +! + real(r8), pointer:: albgrd(:,:) ! ground albedo (direct) + real(r8), pointer:: albgri(:,:) ! ground albedo (diffuse) + ! albsod and albsoi are now clm_type variables so they can be used by SNICAR. + real(r8), pointer :: albsod(:,:) ! soil albedo (direct) + real(r8), pointer :: albsoi(:,:) ! soil albedo (diffuse) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer, parameter :: nband =numrad ! number of solar radiation waveband classes + integer :: fc ! non-urban filter column index + integer :: c,l ! indices + integer :: ib ! waveband number (1=vis, 2=nir) + real(r8) :: inc ! soil water correction factor for soil albedo + ! albsod and albsoi are now clm_type variables so they can be used by SNICAR. + !real(r8) :: albsod ! soil albedo (direct) + !real(r8) :: albsoi ! soil albedo (diffuse) + integer :: soilcol ! soilcolor +!----------------------------------------------------------------------- +!dir$ inlinenever SoilAlbedo + + ! Assign local pointers to derived subtypes components (column-level) + + clandunit => col%landunit + isoicol => cps%isoicol + t_grnd => ces%t_grnd + frac_sno => cps%frac_sno + h2osoi_vol => cws%h2osoi_vol + albgrd => cps%albgrd + albgri => cps%albgri + albsod => cps%albsod + albsoi => cps%albsoi + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + + ! Compute soil albedos + + do ib = 1, nband + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen(c) > 0._r8) then + l = clandunit(c) + + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then ! soil + inc = max(0.11_r8-0.40_r8*h2osoi_vol(c,1), 0._r8) + soilcol = isoicol(c) + ! changed from local variable to clm_type: + !albsod = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + !albsoi = albsod + albsod(c,ib) = min(albsat(soilcol,ib)+inc, albdry(soilcol,ib)) + albsoi(c,ib) = albsod(c,ib) + else if (ltype(l) == istice .or. ltype(l) == istice_mec) then ! land ice + ! changed from local variable to clm_type: + !albsod = albice(ib) + !albsoi = albsod + albsod(c,ib) = albice(ib) + albsoi(c,ib) = albsod(c,ib) + else if (t_grnd(c) > tfrz) then ! unfrozen lake, wetland + ! changed from local variable to clm_type: + !albsod = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) + !albsoi = albsod + albsod(c,ib) = 0.05_r8/(max(0.001_r8,coszen(c)) + 0.15_r8) + albsoi(c,ib) = albsod(c,ib) + else ! frozen lake, wetland + ! changed from local variable to clm_type: + !albsod = alblak(ib) + !albsoi = albsod + albsod(c,ib) = alblak(ib) + albsoi(c,ib) = albsod(c,ib) + end if + + ! Weighting is done in SurfaceAlbedo, after the call to SNICAR_RT + ! This had to be done, because SoilAlbedo is called before SNICAR_RT, so at + ! this point, snow albedo is not yet known. + end if + end do + end do + + end subroutine SoilAlbedo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: TwoStream +! +! !INTERFACE: + subroutine TwoStream (lbc, ubc, lbp, ubp, filter_vegsol, num_vegsol, & + coszen, vai, rho, tau) +! +! !DESCRIPTION: +! Two-stream fluxes for canopy radiative transfer +! Use two-stream approximation of Dickinson (1983) Adv Geophysics +! 25:305-353 and Sellers (1985) Int J Remote Sensing 6:1335-1372 +! to calculate fluxes absorbed by vegetation, reflected by vegetation, +! and transmitted through vegetation for unit incoming direct or diffuse +! flux given an underlying surface with known albedo. +! +! !USES: + use clmtype + use clm_varpar, only : numrad + use clm_varcon, only : omegas, tfrz, betads, betais +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! column bounds + integer , intent(in) :: lbp, ubp ! pft bounds + integer , intent(in) :: filter_vegsol(ubp-lbp+1) ! filter for vegetated pfts with coszen>0 + integer , intent(in) :: num_vegsol ! number of vegetated pfts where coszen>0 + real(r8), intent(in) :: coszen(lbp:ubp) ! cosine solar zenith angle for next time step + real(r8), intent(in) :: vai(lbp:ubp) ! elai+esai + real(r8), intent(in) :: rho(lbp:ubp,numrad) ! leaf/stem refl weighted by fraction LAI and SAI + real(r8), intent(in) :: tau(lbp:ubp,numrad) ! leaf/stem tran weighted by fraction LAI and SAI +! +! !CALLED FROM: +! subroutine SurfaceAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! Modified for speedup: Mariana Vertenstein, 8/26/02 +! Vectorized routine: Mariana Vertenstein: 8/20/03 +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars +! + integer , pointer :: pcolumn(:) ! column of corresponding pft + real(r8), pointer :: albgrd(:,:) ! ground albedo (direct) (column-level) + real(r8), pointer :: albgri(:,:) ! ground albedo (diffuse)(column-level) + real(r8), pointer :: t_veg(:) ! vegetation temperature (Kelvin) + real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: xl(:) ! ecophys const - leaf/stem orientation index +! +! local pointers to implicit out scalars +! + real(r8), pointer :: albd(:,:) ! surface albedo (direct) + real(r8), pointer :: albi(:,:) ! surface albedo (diffuse) + real(r8), pointer :: fabd(:,:) ! flux absorbed by veg per unit direct flux + real(r8), pointer :: fabi(:,:) ! flux absorbed by veg per unit diffuse flux + real(r8), pointer :: ftdd(:,:) ! down direct flux below veg per unit dir flx + real(r8), pointer :: ftid(:,:) ! down diffuse flux below veg per unit dir flx + real(r8), pointer :: ftii(:,:) ! down diffuse flux below veg per unit dif flx + real(r8), pointer :: gdir(:) ! leaf projection in solar direction (0 to 1) + real(r8), pointer :: omega(:,:) ! fraction of intercepted radiation that is scattered (0 to 1) +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: fp,p,c ! array indices + !integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + integer :: ib ! waveband number + real(r8) :: cosz ! 0.001 <= coszen <= 1.000 + real(r8) :: asu ! single scattering albedo + real(r8) :: chil(lbp:ubp) ! -0.4 <= xl <= 0.6 + real(r8) :: twostext(lbp:ubp)! optical depth of direct beam per unit leaf area + real(r8) :: avmu(lbp:ubp) ! average diffuse optical depth + real(r8) :: omegal ! omega for leaves + real(r8) :: betai ! upscatter parameter for diffuse radiation + real(r8) :: betail ! betai for leaves + real(r8) :: betad ! upscatter parameter for direct beam radiation + real(r8) :: betadl ! betad for leaves + real(r8) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 ! temporary + real(r8) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 ! temporary + real(r8) :: b,c1,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 ! temporary + real(r8) :: phi1,phi2,sigma ! temporary + real(r8) :: temp0(lbp:ubp),temp1,temp2(lbp:ubp) ! temporary + real(r8) :: t1 +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (column-level) + + albgrd => cps%albgrd + albgri => cps%albgri + + ! Assign local pointers to derived subtypes components (pft-level) + + pcolumn => pft%column + fwet => pps%fwet + t_veg => pes%t_veg + ivt => pft%itype + albd => pps%albd + albi => pps%albi + fabd => pps%fabd + fabi => pps%fabi + ftdd => pps%ftdd + ftid => pps%ftid + ftii => pps%ftii + gdir => pps%gdir + omega => pps%omega + xl => pftcon%xl + + ! Calculate two-stream parameters omega, betad, betai, avmu, gdir, twostext. + ! Omega, betad, betai are adjusted for snow. Values for omega*betad + ! and omega*betai are calculated and then divided by the new omega + ! because the product omega*betai, omega*betad is used in solution. + ! Also, the transmittances and reflectances (tau, rho) are linear + ! weights of leaf and stem values. + + do fp = 1,num_vegsol + p = filter_vegsol(fp) + + ! note that the following limit only acts on cosz values > 0 and less than + ! 0.001, not on values cosz = 0, since these zero have already been filtered + ! out in filter_vegsol + cosz = max(0.001_r8, coszen(p)) + + chil(p) = min( max(xl(ivt(p)), -0.4_r8), 0.6_r8 ) + if (abs(chil(p)) <= 0.01_r8) chil(p) = 0.01_r8 + phi1 = 0.5_r8 - 0.633_r8*chil(p) - 0.330_r8*chil(p)*chil(p) + phi2 = 0.877_r8 * (1._r8-2._r8*phi1) + gdir(p) = phi1 + phi2*cosz + twostext(p) = gdir(p)/cosz + avmu(p) = ( 1._r8 - phi1/phi2 * log((phi1+phi2)/phi1) ) / phi2 + temp0(p) = gdir(p) + phi2*cosz + temp1 = phi1*cosz + temp2(p) = ( 1._r8 - temp1/temp0(p) * log((temp1+temp0(p))/temp1) ) + end do + + do ib = 1, numrad + do fp = 1,num_vegsol + p = filter_vegsol(fp) + c = pcolumn(p) + + omegal = rho(p,ib) + tau(p,ib) + asu = 0.5_r8*omegal*gdir(p)/temp0(p) *temp2(p) + betadl = (1._r8+avmu(p)*twostext(p))/(omegal*avmu(p)*twostext(p))*asu + betail = 0.5_r8 * ((rho(p,ib)+tau(p,ib)) + (rho(p,ib)-tau(p,ib)) & + * ((1._r8+chil(p))/2._r8)**2) / omegal + + ! Adjust omega, betad, and betai for intercepted snow + + if (t_veg(p) > tfrz) then !no snow + tmp0 = omegal + tmp1 = betadl + tmp2 = betail + else + tmp0 = (1._r8-fwet(p))*omegal + fwet(p)*omegas(ib) + tmp1 = ( (1._r8-fwet(p))*omegal*betadl + fwet(p)*omegas(ib)*betads ) / tmp0 + tmp2 = ( (1._r8-fwet(p))*omegal*betail + fwet(p)*omegas(ib)*betais ) / tmp0 + end if + omega(p,ib) = tmp0 + betad = tmp1 + betai = tmp2 + + ! Absorbed, reflected, transmitted fluxes per unit incoming radiation + + b = 1._r8 - omega(p,ib) + omega(p,ib)*betai + c1 = omega(p,ib)*betai + tmp0 = avmu(p)*twostext(p) + d = tmp0 * omega(p,ib)*betad + f = tmp0 * omega(p,ib)*(1._r8-betad) + tmp1 = b*b - c1*c1 + h = sqrt(tmp1) / avmu(p) + sigma = tmp0*tmp0 - tmp1 + p1 = b + avmu(p)*h + p2 = b - avmu(p)*h + p3 = b + tmp0 + p4 = b - tmp0 + + ! PET, 03/01/04: added this test to avoid floating point errors in exp() + ! EBK, 04/15/08: always do this for all modes -- not just CN + + t1 = min(h*vai(p), 40._r8) + s1 = exp(-t1) + t1 = min(twostext(p)*vai(p), 40._r8) + s2 = exp(-t1) + + ! Determine fluxes for vegetated pft for unit incoming direct + ! Loop over incoming direct and incoming diffuse + ! 0=unit incoming direct; 1=unit incoming diffuse + + ! ic = 0 unit incoming direct flux + ! ======================================== + + u1 = b - c1/albgrd(c,ib) + u2 = b - c1*albgrd(c,ib) + u3 = f + c1*albgrd(c,ib) + + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + ! Downward direct and diffuse fluxes below vegetation (ic = 0) + + ftdd(p,ib) = s2 + ftid(p,ib) = h4*s2/sigma + h5*s1 + h6/s1 + + ! Flux reflected by vegetation (ic = 0) + + albd(p,ib) = h1/sigma + h2 + h3 + + ! Flux absorbed by vegetation (ic = 0) + + fabd(p,ib) = 1._r8 - albd(p,ib) & + - (1._r8-albgrd(c,ib))*ftdd(p,ib) - (1._r8-albgri(c,ib))*ftid(p,ib) + + ! ic = 1 unit incoming diffuse + ! ======================================== + + u1 = b - c1/albgri(c,ib) + u2 = b - c1*albgri(c,ib) + u3 = f + c1*albgri(c,ib) + + tmp2 = u1 - avmu(p)*h + tmp3 = u1 + avmu(p)*h + d1 = p1*tmp2/s1 - p2*tmp3*s1 + tmp4 = u2 + avmu(p)*h + tmp5 = u2 - avmu(p)*h + d2 = tmp4/s1 - tmp5*s1 + h1 = -d*p4 - c1*f + tmp6 = d - h1*p3/sigma + tmp7 = ( d - c1 - h1/sigma*(u1+tmp0) ) * s2 + h2 = ( tmp6*tmp2/s1 - p2*tmp7 ) / d1 + h3 = - ( tmp6*tmp3*s1 - p1*tmp7 ) / d1 + h4 = -f*p3 - c1*d + tmp8 = h4/sigma + tmp9 = ( u3 - tmp8*(u2-tmp0) ) * s2 + h5 = - ( tmp8*tmp4/s1 + tmp9 ) / d2 + h6 = ( tmp8*tmp5*s1 + tmp9 ) / d2 + h7 = (c1*tmp2) / (d1*s1) + h8 = (-c1*tmp3*s1) / d1 + h9 = tmp4 / (d2*s1) + h10 = (-tmp5*s1) / d2 + + ! Downward direct and diffuse fluxes below vegetation + + ftii(p,ib) = h9*s1 + h10/s1 + + ! Flux reflected by vegetation + + albi(p,ib) = h7 + h8 + + ! Flux absorbed by vegetation + + fabi(p,ib) = 1._r8 - albi(p,ib) - (1._r8-albgri(c,ib))*ftii(p,ib) + + end do ! end of pft loop + end do ! end of radiation band loop + + end subroutine TwoStream + +end module SurfaceAlbedoMod diff --git a/components/clm/src_clm40/biogeophys/SurfaceRadiationMod.F90 b/components/clm/src_clm40/biogeophys/SurfaceRadiationMod.F90 new file mode 100644 index 0000000000..d8e87f78c1 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/SurfaceRadiationMod.F90 @@ -0,0 +1,801 @@ +module SurfaceRadiationMod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: SurfaceRadiationMod +! +! !DESCRIPTION: +! Calculate solar fluxes absorbed by vegetation and ground surface +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: iulog + +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: SurfaceRadiation ! Solar fluxes absorbed by veg and ground surface +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 11/26/03, Peter Thornton: Added new routine for improved treatment of +! sunlit/shaded canopy radiation. +! 4/26/05, Peter Thornton: Adopted the sun/shade algorithm as the default, +! removed the old SurfaceRadiation(), and renamed SurfaceRadiationSunShade() +! as SurfaceRadiation(). +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: SurfaceRadiation +! +! !INTERFACE: + subroutine SurfaceRadiation(lbp, ubp, num_nourbanp, filter_nourbanp) +! +! !DESCRIPTION: +! Solar fluxes absorbed by vegetation and ground surface +! Note possible problem when land is on different grid than atmosphere. +! Land may have sun above the horizon (coszen > 0) but atmosphere may +! have sun below the horizon (forc_solad = 0 and forc_solai = 0). This is okay +! because all fluxes (absorbed, reflected, transmitted) are multiplied +! by the incoming flux and all will equal zero. +! Atmosphere may have sun above horizon (forc_solad > 0 and forc_solai > 0) but +! land may have sun below horizon. This is okay because fabd, fabi, +! ftdd, ftid, and ftii all equal zero so that sabv=sabg=fsa=0. Also, +! albd and albi equal one so that fsr=forc_solad+forc_solai. In other words, all +! the radiation is reflected. NDVI should equal zero in this case. +! However, the way the code is currently implemented this is only true +! if (forc_solad+forc_solai)|vis = (forc_solad+forc_solai)|nir. +! Output variables are parsun,parsha,sabv,sabg,fsa,fsr,ndvi +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use clm_varpar , only : numrad + use clm_varcon , only : spval, istsoil, degpsec, isecspday + use clm_varcon , only : istice_mec + use clm_varcon , only : istcrop + use clm_time_manager, only : get_curr_date, get_step_size + use clm_varpar , only : nlevsno + use SNICARMod , only : DO_SNO_OC + use abortutils , only : endrun + use clm_varctl , only : use_snicar_frc +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbp, ubp ! pft upper and lower bounds + integer, intent(in) :: num_nourbanp ! number of pfts in non-urban points in pft filter + integer, intent(in) :: filter_nourbanp(ubp-lbp+1) ! pft filter for non-urban points +! +! !CALLED FROM: +! subroutine Biogeophysics1 in module Biogeophysics1Mod +! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 2/18/02, Peter Thornton: Migrated to new data structures. Added a pft loop. +! 6/05/03, Peter Thornton: Modified sunlit/shaded canopy treatment. Original code +! had all radiation being absorbed in the sunlit canopy, and now the sunlit and shaded +! canopies are each given the appropriate fluxes. There was also an inconsistency in +! the original code, where parsun was not being scaled by leaf area, and so represented +! the entire canopy flux. This goes into Stomata (in CanopyFluxes) where it is assumed +! to be a flux per unit leaf area. In addition, the fpsn flux coming out of Stomata was +! being scaled back up to the canopy by multiplying by lai, but the input radiation flux was +! for the entire canopy to begin with. Corrected this inconsistency in this version, so that +! the parsun and parsha fluxes going into canopy fluxes are per unit lai in the sunlit and +! shaded canopies. +! 6/9/03, Peter Thornton: Moved coszen from gps to c%cps to avoid problem +! with OpenMP threading over columns, where different columns hit the radiation +! time step at different times during execution. +! 6/10/03, Peter Thornton: Added constraint on negative tot_aid, instead of +! exiting with error. Appears to be happening only at roundoff level. +! 6/11/03, Peter Thornton: Moved calculation of ext inside if (coszen), +! and added check on laisun = 0 and laisha = 0 in calculation of sun_aperlai +! and sha_aperlai. +! 11/26/03, Peter Thornton: During migration to new vector code, created +! this as a new routine to handle sunlit/shaded canopy calculations. +! 03/28/08, Mark Flanner: Incorporated SNICAR, including absorbed solar radiation +! in each snow layer and top soil layer, and optional radiative forcing calculation +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: ivt(:) ! pft vegetation type + integer , pointer :: pcolumn(:) ! pft's column index + integer , pointer :: pgridcell(:) ! pft's gridcell index + real(r8), pointer :: pwtgcell(:) ! pft's weight relative to corresponding gridcell + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow + real(r8), pointer :: londeg(:) ! longitude (degrees) + real(r8), pointer :: latdeg(:) ! latitude (degrees) + real(r8), pointer :: slasun(:) ! specific leaf area for sunlit canopy, projected area basis (m^2/gC) + real(r8), pointer :: slasha(:) ! specific leaf area for shaded canopy, projected area basis (m^2/gC) + real(r8), pointer :: gdir(:) ! leaf projection in solar direction (0 to 1) + real(r8), pointer :: omega(:,:) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8), pointer :: coszen(:) ! cosine of solar zenith angle + real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (W/m**2) + real(r8), pointer :: forc_solai(:,:) ! diffuse radiation (W/m**2) + real(r8), pointer :: fabd(:,:) ! flux absorbed by veg per unit direct flux + real(r8), pointer :: fabi(:,:) ! flux absorbed by veg per unit diffuse flux + real(r8), pointer :: ftdd(:,:) ! down direct flux below veg per unit dir flx + real(r8), pointer :: ftid(:,:) ! down diffuse flux below veg per unit dir flx + real(r8), pointer :: ftii(:,:) ! down diffuse flux below veg per unit dif flx + real(r8), pointer :: albgrd(:,:) ! ground albedo (direct) + real(r8), pointer :: albgri(:,:) ! ground albedo (diffuse) + real(r8), pointer :: albd(:,:) ! surface albedo (direct) + real(r8), pointer :: albi(:,:) ! surface albedo (diffuse) + real(r8), pointer :: slatop(:) ! specific leaf area at top of canopy, projected area basis [m^2/gC] + real(r8), pointer :: dsladlai(:) ! dSLA/dLAI, projected area basis [m^2/gC] +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: fsun(:) ! sunlit fraction of canopy + real(r8), pointer :: laisun(:) ! sunlit leaf area + real(r8), pointer :: laisha(:) ! shaded leaf area + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: sabv(:) ! solar radiation absorbed by vegetation (W/m**2) + real(r8), pointer :: fsa(:) ! solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_r(:) ! rural solar radiation absorbed (total) (W/m**2) + integer , pointer :: ityplun(:) ! landunit type + integer , pointer :: plandunit(:) ! index into landunit level quantities + real(r8), pointer :: parsun(:) ! average absorbed PAR for sunlit leaves (W/m**2) + real(r8), pointer :: parsha(:) ! average absorbed PAR for shaded leaves (W/m**2) + real(r8), pointer :: fsr(:) ! solar radiation reflected (W/m**2) + real(r8), pointer :: fsds_vis_d(:) ! incident direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_d(:) ! incident direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_i(:) ! incident diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_i(:) ! incident diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_d(:) ! reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_d(:) ! reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_i(:) ! reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_i(:) ! reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_d_ln(:) ! incident direct beam vis solar rad at local noon (W/m**2) + real(r8), pointer :: fsds_nir_d_ln(:) ! incident direct beam nir solar rad at local noon (W/m**2) + real(r8), pointer :: fsr_vis_d_ln(:) ! reflected direct beam vis solar rad at local noon (W/m**2) + real(r8), pointer :: fsr_nir_d_ln(:) ! reflected direct beam nir solar rad at local noon (W/m**2) + real(r8), pointer :: eff_kid(:,:) ! effective extinction coefficient for indirect from direct + real(r8), pointer :: eff_kii(:,:) ! effective extinction coefficient for indirect from indirect + real(r8), pointer :: sun_faid(:,:) ! fraction sun canopy absorbed indirect from direct + real(r8), pointer :: sun_faii(:,:) ! fraction sun canopy absorbed indirect from indirect + real(r8), pointer :: sha_faid(:,:) ! fraction shade canopy absorbed indirect from direct + real(r8), pointer :: sha_faii(:,:) ! fraction shade canopy absorbed indirect from indirect + real(r8), pointer :: sun_add(:,:) ! sun canopy absorbed direct from direct (W/m**2) + real(r8), pointer :: tot_aid(:,:) ! total canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sun_aid(:,:) ! sun canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sun_aii(:,:) ! sun canopy absorbed indirect from indirect (W/m**2) + real(r8), pointer :: sha_aid(:,:) ! shade canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sha_aii(:,:) ! shade canopy absorbed indirect from indirect (W/m**2) + real(r8), pointer :: sun_atot(:,:) ! sun canopy total absorbed (W/m**2) + real(r8), pointer :: sha_atot(:,:) ! shade canopy total absorbed (W/m**2) + real(r8), pointer :: sun_alf(:,:) ! sun canopy total absorbed by leaves (W/m**2) + real(r8), pointer :: sha_alf(:,:) ! shade canopy total absored by leaves (W/m**2) + real(r8), pointer :: sun_aperlai(:,:) ! sun canopy total absorbed per unit LAI (W/m**2) + real(r8), pointer :: sha_aperlai(:,:) ! shade canopy total absorbed per unit LAI (W/m**2) + real(r8), pointer :: flx_absdv(:,:) ! direct flux absorption factor (col,lyr): VIS [frc] + real(r8), pointer :: flx_absdn(:,:) ! direct flux absorption factor (col,lyr): NIR [frc] + real(r8), pointer :: flx_absiv(:,:) ! diffuse flux absorption factor (col,lyr): VIS [frc] + real(r8), pointer :: flx_absin(:,:) ! diffuse flux absorption factor (col,lyr): NIR [frc] + integer , pointer :: snl(:) ! negative number of snow layers [nbr] + real(r8), pointer :: albgrd_pur(:,:) ! pure snow ground albedo (direct) + real(r8), pointer :: albgri_pur(:,:) ! pure snow ground albedo (diffuse) + real(r8), pointer :: albgrd_bc(:,:) ! ground albedo without BC (direct) (col,bnd) + real(r8), pointer :: albgri_bc(:,:) ! ground albedo without BC (diffuse) (col,bnd) + real(r8), pointer :: albgrd_oc(:,:) ! ground albedo without OC (direct) (col,bnd) + real(r8), pointer :: albgri_oc(:,:) ! ground albedo without OC (diffuse) (col,bnd) + real(r8), pointer :: albgrd_dst(:,:) ! ground albedo without dust (direct) (col,bnd) + real(r8), pointer :: albgri_dst(:,:) ! ground albedo without dust (diffuse) (col,bnd) + real(r8), pointer :: albsnd_hst(:,:) ! snow albedo, direct, for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst(:,:) ! snow ground albedo, diffuse, for history files (col,bnd + real(r8), pointer :: sabg_lyr(:,:) ! absorbed radiative flux (pft,lyr) [W/m2] + real(r8), pointer :: sfc_frc_aer(:) ! surface forcing of snow with all aerosols (pft) [W/m2] + real(r8), pointer :: sfc_frc_bc(:) ! surface forcing of snow with BC (pft) [W/m2] + real(r8), pointer :: sfc_frc_oc(:) ! surface forcing of snow with OC (pft) [W/m2] + real(r8), pointer :: sfc_frc_dst(:) ! surface forcing of snow with dust (pft) [W/m2] + real(r8), pointer :: sfc_frc_aer_sno(:) ! surface forcing of snow with all aerosols, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_bc_sno(:) ! surface forcing of snow with BC, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_oc_sno(:) ! surface forcing of snow with OC, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_dst_sno(:) ! surface forcing of snow with dust, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: fsr_sno_vd(:) ! reflected visible, direct radiation from snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsr_sno_nd(:) ! reflected near-IR, direct radiation from snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsr_sno_vi(:) ! reflected visible, diffuse radiation from snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsr_sno_ni(:) ! reflected near-IR, diffuse radiation from snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsds_sno_vd(:) ! incident visible, direct radiation on snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsds_sno_nd(:) ! incident near-IR, direct radiation on snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsds_sno_vi(:) ! incident visible, diffuse radiation on snow (for history files) (pft) [W/m2] + real(r8), pointer :: fsds_sno_ni(:) ! incident near-IR, diffuse radiation on snow (for history files) (pft) [W/m2] + real(r8), pointer :: snowdp(:) ! snow height (m) + +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer , parameter :: nband = numrad ! number of solar radiation waveband classes + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + integer :: fp ! non-urban filter pft index + integer :: p ! pft index + integer :: c ! column index + integer :: l ! landunit index + integer :: g ! grid cell index + integer :: ib ! waveband number (1=vis, 2=nir) + real(r8) :: absrad ! absorbed solar radiation (W/m**2) + real(r8) :: rnir ! reflected solar radiation [nir] (W/m**2) + real(r8) :: rvis ! reflected solar radiation [vis] (W/m**2) + real(r8) :: laifra ! leaf area fraction of canopy + real(r8) :: trd(lbp:ubp,numrad) ! transmitted solar radiation: direct (W/m**2) + real(r8) :: tri(lbp:ubp,numrad) ! transmitted solar radiation: diffuse (W/m**2) + real(r8) :: cad(lbp:ubp,numrad) ! direct beam absorbed by canopy (W/m**2) + real(r8) :: cai(lbp:ubp,numrad) ! diffuse radiation absorbed by canopy (W/m**2) + real(r8) :: vai(lbp:ubp) ! total leaf area index + stem area index, one sided + real(r8) :: ext ! optical depth direct beam per unit LAI+SAI + real(r8) :: t1, t2 ! temporary variables + real(r8) :: cosz + integer :: local_secp1 ! seconds into current date in local time + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day,secs ! calendar info for current time step + integer :: i ! layer index [idx] + real(r8) :: sabg_snl_sum ! temporary, absorbed energy in all active snow layers [W/m2] + real(r8) :: absrad_pur ! temp: absorbed solar radiation by pure snow [W/m2] + real(r8) :: absrad_bc ! temp: absorbed solar radiation without BC [W/m2] + real(r8) :: absrad_oc ! temp: absorbed solar radiation without OC [W/m2] + real(r8) :: absrad_dst ! temp: absorbed solar radiation without dust [W/m2] + real(r8) :: sabg_pur(lbp:ubp) ! solar radiation absorbed by ground with pure snow [W/m2] + real(r8) :: sabg_bc(lbp:ubp) ! solar radiation absorbed by ground without BC [W/m2] + real(r8) :: sabg_oc(lbp:ubp) ! solar radiation absorbed by ground without OC [W/m2] + real(r8) :: sabg_dst(lbp:ubp) ! solar radiation absorbed by ground without dust [W/m2] +!------------------------------------------------------------------------------ + + ! Assign local pointers to multi-level derived type members (gridcell level) + + londeg => grc%londeg + latdeg => grc%latdeg + forc_solad => clm_a2l%forc_solad + forc_solai => clm_a2l%forc_solai + + ! Assign local pointers to multi-level derived type members (landunit level) + + ityplun => lun%itype + + ! Assign local pointers to multi-level derived type members (column level) + + albgrd => cps%albgrd + albgri => cps%albgri + coszen => cps%coszen + + ! Assign local pointers to derived type members (pft-level) + + plandunit => pft%landunit + ivt => pft%itype + pcolumn => pft%column + pgridcell => pft%gridcell + pwtgcell => pft%wtgcell + elai => pps%elai + esai => pps%esai + slasun => pps%slasun + slasha => pps%slasha + gdir => pps%gdir + omega => pps%omega + laisun => pps%laisun + laisha => pps%laisha + fabd => pps%fabd + fabi => pps%fabi + ftdd => pps%ftdd + ftid => pps%ftid + ftii => pps%ftii + albd => pps%albd + albi => pps%albi + fsun => pps%fsun + sabg => pef%sabg + sabv => pef%sabv + snowdp => cps%snowdp + fsa => pef%fsa + fsa_r => pef%fsa_r + fsr => pef%fsr + parsun => pef%parsun + parsha => pef%parsha + fsds_vis_d => pef%fsds_vis_d + fsds_nir_d => pef%fsds_nir_d + fsds_vis_i => pef%fsds_vis_i + fsds_nir_i => pef%fsds_nir_i + fsr_vis_d => pef%fsr_vis_d + fsr_nir_d => pef%fsr_nir_d + fsr_vis_i => pef%fsr_vis_i + fsr_nir_i => pef%fsr_nir_i + fsds_vis_d_ln => pef%fsds_vis_d_ln + fsds_nir_d_ln => pef%fsds_nir_d_ln + fsr_vis_d_ln => pef%fsr_vis_d_ln + fsr_nir_d_ln => pef%fsr_nir_d_ln + eff_kid => pps%eff_kid + eff_kii => pps%eff_kii + sun_faid => pps%sun_faid + sun_faii => pps%sun_faii + sha_faid => pps%sha_faid + sha_faii => pps%sha_faii + sun_add => pef%sun_add + tot_aid => pef%tot_aid + sun_aid => pef%sun_aid + sun_aii => pef%sun_aii + sha_aid => pef%sha_aid + sha_aii => pef%sha_aii + sun_atot => pef%sun_atot + sha_atot => pef%sha_atot + sun_alf => pef%sun_alf + sha_alf => pef%sha_alf + sun_aperlai => pef%sun_aperlai + sha_aperlai => pef%sha_aperlai + + ! Assign local pointers to derived type members (ecophysiological) + + slatop => pftcon%slatop + dsladlai => pftcon%dsladlai + frac_sno => cps%frac_sno + flx_absdv => cps%flx_absdv + flx_absdn => cps%flx_absdn + flx_absiv => cps%flx_absiv + flx_absin => cps%flx_absin + sabg_lyr => pef%sabg_lyr + snl => cps%snl + sfc_frc_aer => pef%sfc_frc_aer + sfc_frc_aer_sno => pef%sfc_frc_aer_sno + albgrd_pur => cps%albgrd_pur + albgri_pur => cps%albgri_pur + sfc_frc_bc => pef%sfc_frc_bc + sfc_frc_bc_sno => pef%sfc_frc_bc_sno + albgrd_bc => cps%albgrd_bc + albgri_bc => cps%albgri_bc + sfc_frc_oc => pef%sfc_frc_oc + sfc_frc_oc_sno => pef%sfc_frc_oc_sno + albgrd_oc => cps%albgrd_oc + albgri_oc => cps%albgri_oc + sfc_frc_dst => pef%sfc_frc_dst + sfc_frc_dst_sno => pef%sfc_frc_dst_sno + albgrd_dst => cps%albgrd_dst + albgri_dst => cps%albgri_dst + albsnd_hst => cps%albsnd_hst + albsni_hst => cps%albsni_hst + fsr_sno_vd => pef%fsr_sno_vd + fsr_sno_nd => pef%fsr_sno_nd + fsr_sno_vi => pef%fsr_sno_vi + fsr_sno_ni => pef%fsr_sno_ni + fsds_sno_vd => pef%fsds_sno_vd + fsds_sno_nd => pef%fsds_sno_nd + fsds_sno_vi => pef%fsds_sno_vi + fsds_sno_ni => pef%fsds_sno_ni + + ! Determine seconds off current time step + + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Determine fluxes + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + ! was redundant b/c filter already included wt>0; + ! not redundant anymore with chg in filter definition + l = plandunit(p) + !Note: Some glacier_mec pfts may have zero weight + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + sabg(p) = 0._r8 + sabv(p) = 0._r8 + fsa(p) = 0._r8 + l = plandunit(p) + if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then + fsa_r(p) = 0._r8 + end if + sabg_lyr(p,:) = 0._r8 + sabg_pur(p) = 0._r8 + sabg_bc(p) = 0._r8 + sabg_oc(p) = 0._r8 + sabg_dst(p) = 0._r8 + end if + end do + + ! Loop over pfts to calculate fsun, etc + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + c = pcolumn(p) + g = pgridcell(p) + + vai(p) = elai(p) + esai(p) + if (coszen(c) > 0._r8 .and. elai(p) > 0._r8 .and. gdir(p) > 0._r8) then + cosz = max(0.001_r8, coszen(c)) + ext = gdir(p)/cosz + t1 = min(ext*elai(p), 40.0_r8) + t2 = exp(-t1) + fsun(p) = (1._r8-t2)/t1 + + ! new control on low lai, to avoid numerical problems in + ! calculation of slasun, slasha + ! PET: 2/29/04 + + if (elai(p) > 0.01_r8) then + laisun(p) = elai(p)*fsun(p) + laisha(p) = elai(p)*(1._r8-fsun(p)) + + ! calculate the average specific leaf area for sunlit and shaded + ! canopies, when effective LAI > 0 + slasun(p) = (t2*dsladlai(ivt(p))*ext*elai(p) + & + t2*dsladlai(ivt(p)) + & + t2*slatop(ivt(p))*ext - & + dsladlai(ivt(p)) - & + slatop(ivt(p))*ext) / & + (ext*(t2-1._r8)) + slasha(p) = ((slatop(ivt(p)) + & + (dsladlai(ivt(p)) * elai(p)/2.0_r8)) * elai(p) - & + laisun(p)*slasun(p)) / laisha(p) + else + ! special case for low elai + fsun(p) = 1._r8 + laisun(p) = elai(p) + laisha(p) = 0._r8 + slasun(p) = slatop(ivt(p)) + slasha(p) = 0._r8 + end if + else + fsun(p) = 0._r8 + laisun(p) = 0._r8 + laisha(p) = elai(p) + slasun(p) = 0._r8 + slasha(p) = 0._r8 + end if + end if + end do + + ! Loop over nband wavebands + do ib = 1, nband + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + c = pcolumn(p) + g = pgridcell(p) + + ! Absorbed by canopy + + cad(p,ib) = forc_solad(g,ib)*fabd(p,ib) + cai(p,ib) = forc_solai(g,ib)*fabi(p,ib) + sabv(p) = sabv(p) + cad(p,ib) + cai(p,ib) + fsa(p) = fsa(p) + cad(p,ib) + cai(p,ib) + l = plandunit(p) + if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then + fsa_r(p) = fsa_r(p) + cad(p,ib) + cai(p,ib) + end if + + ! Transmitted = solar fluxes incident on ground + + trd(p,ib) = forc_solad(g,ib)*ftdd(p,ib) + tri(p,ib) = forc_solad(g,ib)*ftid(p,ib) + forc_solai(g,ib)*ftii(p,ib) + + ! Solar radiation absorbed by ground surface + + absrad = trd(p,ib)*(1._r8-albgrd(c,ib)) + tri(p,ib)*(1._r8-albgri(c,ib)) + sabg(p) = sabg(p) + absrad + fsa(p) = fsa(p) + absrad + if (ityplun(l)==istsoil .or. ityplun(l)==istcrop) then + fsa_r(p) = fsa_r(p) + absrad + end if + + if (use_snicar_frc) then + ! Solar radiation absorbed by ground surface without BC + absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib)) + sabg_bc(p) = sabg_bc(p) + absrad_bc + + ! Solar radiation absorbed by ground surface without OC + absrad_oc = trd(p,ib)*(1._r8-albgrd_oc(c,ib)) + tri(p,ib)*(1._r8-albgri_oc(c,ib)) + sabg_oc(p) = sabg_oc(p) + absrad_oc + + ! Solar radiation absorbed by ground surface without dust + absrad_dst = trd(p,ib)*(1._r8-albgrd_dst(c,ib)) + tri(p,ib)*(1._r8-albgri_dst(c,ib)) + sabg_dst(p) = sabg_dst(p) + absrad_dst + + ! Solar radiation absorbed by ground surface without any aerosols + absrad_pur = trd(p,ib)*(1._r8-albgrd_pur(c,ib)) + tri(p,ib)*(1._r8-albgri_pur(c,ib)) + sabg_pur(p) = sabg_pur(p) + absrad_pur + end if + + + ! New sunlit.shaded canopy algorithm + + if (coszen(c) > 0._r8 .and. elai(p) > 0._r8 .and. gdir(p) > 0._r8 ) then + + ! 1. calculate flux of direct beam radiation absorbed in the + ! sunlit canopy as direct (sun_add), and the flux of direct + ! beam radiation absorbed in the total canopy as indirect + + sun_add(p,ib) = forc_solad(g,ib) * (1._r8-ftdd(p,ib)) * (1._r8-omega(p,ib)) + tot_aid(p,ib) = (forc_solad(g,ib) * fabd(p,ib)) - sun_add(p,ib) + + ! the following constraint set to catch round-off level errors + ! that can cause negative tot_aid + + tot_aid(p,ib) = max(tot_aid(p,ib), 0._r8) + + ! 2. calculate the effective extinction coefficients for indirect + ! transmission originating from direct and indirect streams, + ! using ftid and ftii + + !eff_kid(p,ib) = -(log(ftid(p,ib)))/vai(p) + !eff_kii(p,ib) = -(log(ftii(p,ib)))/vai(p) + + ! 3. calculate the fraction of indirect radiation being absorbed + ! in the sunlit and shaded canopy fraction. Some of this indirect originates in + ! the direct beam and some originates in the indirect beam. + + !sun_faid(p,ib) = 1.-exp(-eff_kid(p,ib) * vaisun(p)) + !sun_faii(p,ib) = 1.-exp(-eff_kii(p,ib) * vaisun(p)) + sun_faid(p,ib) = fsun(p) + sun_faii(p,ib) = fsun(p) + sha_faid(p,ib) = 1._r8-sun_faid(p,ib) + sha_faii(p,ib) = 1._r8-sun_faii(p,ib) + + ! 4. calculate the total indirect flux absorbed by the sunlit + ! and shaded canopy based on these fractions and the fabd and + ! fabi from surface albedo calculations + + sun_aid(p,ib) = tot_aid(p,ib) * sun_faid(p,ib) + sun_aii(p,ib) = forc_solai(g,ib)*fabi(p,ib)*sun_faii(p,ib) + sha_aid(p,ib) = tot_aid(p,ib) * sha_faid(p,ib) + sha_aii(p,ib) = forc_solai(g,ib)*fabi(p,ib)*sha_faii(p,ib) + + ! 5. calculate the total flux absorbed in the sunlit and shaded + ! canopy as the sum of these terms + + sun_atot(p,ib) = sun_add(p,ib) + sun_aid(p,ib) + sun_aii(p,ib) + sha_atot(p,ib) = sha_aid(p,ib) + sha_aii(p,ib) + + ! 6. calculate the total flux absorbed by leaves in the sunlit + ! and shaded canopies + + laifra = elai(p)/vai(p) + sun_alf(p,ib) = sun_atot(p,ib) * laifra + sha_alf(p,ib) = sha_atot(p,ib) * laifra + + ! 7. calculate the fluxes per unit lai in the sunlit and shaded + ! canopies + + if (laisun(p) > 0._r8) then + sun_aperlai(p,ib) = sun_alf(p,ib)/laisun(p) + else + sun_aperlai(p,ib) = 0._r8 + endif + if (laisha(p) > 0._r8) then + sha_aperlai(p,ib) = sha_alf(p,ib)/laisha(p) + else + sha_aperlai(p,ib) = 0._r8 + endif + + else ! coszen = 0 or elai = 0 + + sun_add(p,ib) = 0._r8 + tot_aid(p,ib) = 0._r8 + eff_kid(p,ib) = 0._r8 + eff_kii(p,ib) = 0._r8 + sun_faid(p,ib) = 0._r8 + sun_faii(p,ib) = 0._r8 + sha_faid(p,ib) = 0._r8 + sha_faii(p,ib) = 0._r8 + sun_aid(p,ib) = 0._r8 + sun_aii(p,ib) = 0._r8 + sha_aid(p,ib) = 0._r8 + sha_aii(p,ib) = 0._r8 + sun_atot(p,ib) = 0._r8 + sha_atot(p,ib) = 0._r8 + sun_alf(p,ib) = 0._r8 + sha_alf(p,ib) = 0._r8 + sun_aperlai(p,ib) = 0._r8 + sha_aperlai(p,ib) = 0._r8 + + end if + end if + end do ! end of pft loop + end do ! end nbands loop + + + ! compute absorbed flux in each snow layer and top soil layer, + ! based on flux factors computed in the radiative transfer portion of SNICAR. + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + c = pcolumn(p) + sabg_snl_sum = 0._r8 + + ! CASE1: No snow layers: all energy is absorbed in top soil layer + if (snl(c) == 0) then + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,1) = sabg(p) + sabg_snl_sum = sabg_lyr(p,1) + + ! CASE 2: Snow layers present: absorbed radiation is scaled according to + ! flux factors computed by SNICAR + else + do i = -nlevsno+1,1,1 + sabg_lyr(p,i) = flx_absdv(c,i)*trd(p,1) + flx_absdn(c,i)*trd(p,2) + & + flx_absiv(c,i)*tri(p,1) + flx_absin(c,i)*tri(p,2) + ! summed radiation in active snow layers: + if (i >= snl(c)+1) then + sabg_snl_sum = sabg_snl_sum + sabg_lyr(p,i) + endif + enddo + + ! Error handling: The situation below can occur when solar radiation is + ! NOT computed every timestep. + ! When the number of snow layers has changed in between computations of the + ! absorbed solar energy in each layer, we must redistribute the absorbed energy + ! to avoid physically unrealistic conditions. The assumptions made below are + ! somewhat arbitrary, but this situation does not arise very frequently. + ! This error handling is implemented to accomodate any value of the + ! radiation frequency. + if (abs(sabg_snl_sum-sabg(p)) > 0.00001_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-4:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-4:-1) = 0._r8 + sabg_lyr(p,0) = sabg(p)*0.6_r8 + sabg_lyr(p,1) = sabg(p)*0.4_r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8 + endif + endif + + ! If shallow snow depth, all solar radiation absorbed in top or top two snow layers + ! to prevent unrealistic timestep soil warming + if (snowdp(c) < 0.10_r8) then + if (snl(c) == 0) then + sabg_lyr(p,-4:0) = 0._r8 + sabg_lyr(p,1) = sabg(p) + elseif (snl(c) == -1) then + sabg_lyr(p,-4:-1) = 0._r8 + sabg_lyr(p,0) = sabg(p) + sabg_lyr(p,1) = 0._r8 + else + sabg_lyr(p,:) = 0._r8 + sabg_lyr(p,snl(c)+1) = sabg(p)*0.75_r8 + sabg_lyr(p,snl(c)+2) = sabg(p)*0.25_r8 + endif + endif + + endif + + ! This situation should not happen: + if (abs(sum(sabg_lyr(p,:))-sabg(p)) > 0.00001_r8) then + write(iulog,*) "SNICAR ERROR: Absorbed ground radiation not equal to summed snow layer radiation. pft = ", & + p," Col= ", c, " Diff= ",sum(sabg_lyr(p,:))-sabg(p), " sabg(p)= ", sabg(p), " sabg_sum(p)= ", & + sum(sabg_lyr(p,:)), " snl(c)= ", snl(c) + write(iulog,*) "flx_absdv1= ", trd(p,1)*(1.-albgrd(c,1)), "flx_absdv2= ", sum(flx_absdv(c,:))*trd(p,1) + write(iulog,*) "flx_absiv1= ", tri(p,1)*(1.-albgri(c,1))," flx_absiv2= ", sum(flx_absiv(c,:))*tri(p,1) + write(iulog,*) "flx_absdn1= ", trd(p,2)*(1.-albgrd(c,2))," flx_absdn2= ", sum(flx_absdn(c,:))*trd(p,2) + write(iulog,*) "flx_absin1= ", tri(p,2)*(1.-albgri(c,2))," flx_absin2= ", sum(flx_absin(c,:))*tri(p,2) + + write(iulog,*) "albgrd_nir= ", albgrd(c,2) + write(iulog,*) "coszen= ", coszen(c) + call endrun() + endif + + + if (use_snicar_frc) then + + ! BC aerosol forcing (pft-level): + sfc_frc_bc(p) = sabg(p) - sabg_bc(p) + + ! OC aerosol forcing (pft-level): + if (DO_SNO_OC) then + sfc_frc_oc(p) = sabg(p) - sabg_oc(p) + else + sfc_frc_oc(p) = 0._r8 + endif + + ! dust aerosol forcing (pft-level): + sfc_frc_dst(p) = sabg(p) - sabg_dst(p) + + ! all-aerosol forcing (pft-level): + sfc_frc_aer(p) = sabg(p) - sabg_pur(p) + + ! forcings averaged only over snow: + if (frac_sno(c) > 0._r8) then + sfc_frc_bc_sno(p) = sfc_frc_bc(p)/frac_sno(c) + sfc_frc_oc_sno(p) = sfc_frc_oc(p)/frac_sno(c) + sfc_frc_dst_sno(p) = sfc_frc_dst(p)/frac_sno(c) + sfc_frc_aer_sno(p) = sfc_frc_aer(p)/frac_sno(c) + else + sfc_frc_bc_sno(p) = spval + sfc_frc_oc_sno(p) = spval + sfc_frc_dst_sno(p) = spval + sfc_frc_aer_sno(p) = spval + endif + + end if + endif + enddo + + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + l = plandunit(p) + if (pwtgcell(p)>0._r8 .or. ityplun(l)==istice_mec) then + g = pgridcell(p) + + ! Final step of new sunlit/shaded canopy algorithm + ! 8. calculate the total and per-unit-lai fluxes for PAR in the + ! sunlit and shaded canopy leaf fractions + + parsun(p) = sun_aperlai(p,1) + parsha(p) = sha_aperlai(p,1) + + ! The following code is duplicated from SurfaceRadiation + ! NDVI and reflected solar radiation + + rvis = albd(p,1)*forc_solad(g,1) + albi(p,1)*forc_solai(g,1) + rnir = albd(p,2)*forc_solad(g,2) + albi(p,2)*forc_solai(g,2) + fsr(p) = rvis + rnir + + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + fsr_vis_d(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d(p) = albd(p,2)*forc_solad(g,2) + fsr_vis_i(p) = albi(p,1)*forc_solai(g,1) + fsr_nir_i(p) = albi(p,2)*forc_solai(g,2) + + local_secp1 = secs + nint((londeg(g)/degpsec)/dtime)*dtime + local_secp1 = mod(local_secp1,isecspday) + if (local_secp1 == isecspday/2) then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + fsr_vis_d_ln(p) = albd(p,1)*forc_solad(g,1) + fsr_nir_d_ln(p) = albd(p,2)*forc_solad(g,2) + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + end if + + ! diagnostic variables (downwelling and absorbed radiation partitioning) for history files + ! (OPTIONAL) + c = pcolumn(p) + if (snl(c) < 0) then + fsds_sno_vd(p) = forc_solad(g,1) + fsds_sno_nd(p) = forc_solad(g,2) + fsds_sno_vi(p) = forc_solai(g,1) + fsds_sno_ni(p) = forc_solai(g,2) + + fsr_sno_vd(p) = fsds_vis_d(p)*albsnd_hst(c,1) + fsr_sno_nd(p) = fsds_nir_d(p)*albsnd_hst(c,2) + fsr_sno_vi(p) = fsds_vis_i(p)*albsni_hst(c,1) + fsr_sno_ni(p) = fsds_nir_i(p)*albsni_hst(c,2) + else + fsds_sno_vd(p) = spval + fsds_sno_nd(p) = spval + fsds_sno_vi(p) = spval + fsds_sno_ni(p) = spval + + fsr_sno_vd(p) = spval + fsr_sno_nd(p) = spval + fsr_sno_vi(p) = spval + fsr_sno_ni(p) = spval + endif + + end if + end do + + end subroutine SurfaceRadiation + +end module SurfaceRadiationMod diff --git a/components/clm/src_clm40/biogeophys/TridiagonalMod.F90 b/components/clm/src_clm40/biogeophys/TridiagonalMod.F90 new file mode 100644 index 0000000000..a5e8d7d1ab --- /dev/null +++ b/components/clm/src_clm40/biogeophys/TridiagonalMod.F90 @@ -0,0 +1,106 @@ +module TridiagonalMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: TridiagonalMod +! +! !DESCRIPTION: +! Tridiagonal matrix solution +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: Tridiagonal +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Tridiagonal +! +! !INTERFACE: + subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & + a, b, c, r, u) +! +! !DESCRIPTION: +! Tridiagonal matrix solution +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! lbinning and ubing column indices + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop(lbc:ubc) ! top level for each column + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(1:numf) ! filter + real(r8), intent(in) :: a(lbc:ubc, lbj:ubj) ! "a" left off diagonal of tridiagonal matrix + real(r8), intent(in) :: b(lbc:ubc, lbj:ubj) ! "b" diagonal column for tridiagonal matrix + real(r8), intent(in) :: c(lbc:ubc, lbj:ubj) ! "c" right off diagonal tridiagonal matrix + real(r8), intent(in) :: r(lbc:ubc, lbj:ubj) ! "r" forcing term of tridiagonal matrix + real(r8), intent(inout) :: u(lbc:ubc, lbj:ubj) ! solution +! +! !CALLED FROM: +! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod +! subroutine SoilTemperature in module SoilTemperatureMod +! subroutine SoilWater in module HydrologyMod +! +! !REVISION HISTORY: +! 15 September 1999: Yongjiu Dai; Initial code +! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision +! 1 July 2003: Mariana Vertenstein; modified for vectorization +! +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: j,ci,fc !indices + real(r8) :: gam(lbc:ubc,lbj:ubj) !temporary + real(r8) :: bet(lbc:ubc) !temporary +!----------------------------------------------------------------------- + + ! Solve the matrix + + do fc = 1,numf + ci = filter(fc) + bet(ci) = b(ci,jtop(ci)) + end do + + do j = lbj, ubj + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if + end if + end do + end do + + do j = ubj-1,lbj,-1 + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + end do + end do + + end subroutine Tridiagonal + +end module TridiagonalMod diff --git a/components/clm/src_clm40/biogeophys/UrbanInitMod.F90 b/components/clm/src_clm40/biogeophys/UrbanInitMod.F90 new file mode 100644 index 0000000000..ad48b350ce --- /dev/null +++ b/components/clm/src_clm40/biogeophys/UrbanInitMod.F90 @@ -0,0 +1,477 @@ +module UrbanInitMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: UrbanInitMod +! +! !DESCRIPTION: +! Initialize urban data +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_sys_mod , only : shr_sys_flush + use clm_varctl , only : iulog, use_vancouver, use_mexicocity + use UrbanMod, only : urban_traffic, urban_hac, urban_hac_off +! +! !PUBLIC TYPES: + implicit none + save + + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanInitTimeVar ! Initialize urban time varying variables + public :: UrbanInitTimeConst ! Initialize urban time constant variables + public :: UrbanInitAero ! Calculate urban landunit aerodynamic constants +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanInitAero +! +! !INTERFACE: + subroutine UrbanInitAero( ) +! +! !DESCRIPTION: +! Calculate urban land unit aerodynamic constants using Macdonald (1998) as used in +! Grimmond and Oke (1999) +! +! !USES: + use clmtype + use clm_varcon, only : isturb, vkc + use decompMod , only : get_proc_bounds +! +! !ARGUMENTS: + implicit none +! +! local pointers to original implicit in arguments (urban clump) +! + real(r8), pointer :: ht_roof(:) ! height of urban roof (m) + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width (-) + integer , pointer :: ltype(:) ! landunit type +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: z_0_town(:) ! urban landunit momentum roughness length (m) + real(r8), pointer :: z_d_town(:) ! urban landunit displacement height (m) +! +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! Created by Keith Oleson January 2005 +! +! +! !LOCAL VARIABLES: +!EOP + real(r8), parameter :: alpha = 4.43_r8 ! coefficient used to calculate z_d_town + real(r8), parameter :: beta = 1.0_r8 ! coefficient used to calculate z_d_town + real(r8), parameter :: C_d = 1.2_r8 ! drag coefficient as used in Grimmond and Oke (1999) + real(r8) :: plan_ai ! plan area index - ratio building area to plan area (-) + real(r8) :: frontal_ai ! frontal area index of buildings (-) + real(r8) :: build_lw_ratio ! building short/long side ratio (-) + integer :: l,g ! indices + integer :: begp, endp ! clump beginning and ending pft indices + integer :: begc, endc ! clump beginning and ending column indices + integer :: begl, endl ! clump beginning and ending landunit indices + integer :: begg, endg ! clump beginning and ending gridcell indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (landunit level) + + ltype => lun%itype + z_0_town => lun%z_0_town + z_d_town => lun%z_d_town + ht_roof => lun%ht_roof + canyon_hwr => lun%canyon_hwr + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + do l = begl, endl + if (ltype(l) == isturb) then + + ! Calculate plan area index + plan_ai = canyon_hwr(l)/(canyon_hwr(l) + 1._r8) + + ! Building shape shortside/longside ratio (e.g. 1 = square ) + ! This assumes the building occupies the entire canyon length + build_lw_ratio = plan_ai + + ! Calculate frontal area index + frontal_ai = (1._r8 - plan_ai) * canyon_hwr(l) + + ! Adjust frontal area index for different building configuration + frontal_ai = frontal_ai * sqrt(1/build_lw_ratio) * sqrt(plan_ai) + + ! Calculate displacement height + + if (use_vancouver) then + z_d_town(l) = 3.5_r8 + else if (use_mexicocity) then + z_d_town(l) = 10.9_r8 + else + z_d_town(l) = (1._r8 + alpha**(-plan_ai) * (plan_ai - 1._r8)) * ht_roof(l) + end if + + ! Calculate the roughness length + + if (use_vancouver) then + z_0_town(l) = 0.35_r8 + else if (use_mexicocity) then + z_0_town(l) = 2.2_r8 + else + z_0_town(l) = ht_roof(l) * (1._r8 - z_d_town(l) / ht_roof(l)) * & + exp(-1.0_r8 * (0.5_r8 * beta * C_d / vkc**2 * & + (1 - z_d_town(l) / ht_roof(l)) * frontal_ai)**(-0.5_r8)) + end if + end if + end do + + end subroutine UrbanInitAero + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanInitTimeConst +! +! !INTERFACE: + subroutine UrbanInitTimeConst() +! +! !DESCRIPTION: +! Initialize urban time-constant variables +! +! !USES: + use clmtype + use clm_varcon , only : isturb, icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv, spval + use decompMod , only : get_proc_bounds, ldecomp + use UrbanInputMod, only : urbinp +! +! !ARGUMENTS: + implicit none +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: gdc(:) ! grid index for landunit + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type index + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio + real(r8), pointer :: emg(:) ! ground emissivity + real(r8), pointer :: wtroad_perv(:) ! weight of pervious column to total road + real(r8), pointer :: ht_roof(:) ! height of urban roof (m) + real(r8), pointer :: wtlunit_roof(:) ! weight of roof with respect to landunit + real(r8), pointer :: wind_hgt_canyon(:) ! height above road at which wind in canyon is to be computed (m) + real(r8), pointer :: eflx_traffic_factor(:) ! multiplicative factor for sensible heat flux from urban traffic + real(r8), pointer :: t_building_max(:) ! maximum internal building temperature (K) + real(r8), pointer :: t_building_min(:) ! minimum internal building temperature (K) + real(r8), pointer :: tk_wall(:,:) ! thermal conductivity of urban wall (W/m/K) + real(r8), pointer :: tk_roof(:,:) ! thermal conductivity of urban roof (W/m/K) + real(r8), pointer :: tk_improad(:,:) ! thermal conductivity of urban impervious road (W/m/K) + real(r8), pointer :: cv_wall(:,:) ! thermal conductivity of urban wall (J/m^3/K) + real(r8), pointer :: cv_roof(:,:) ! thermal conductivity of urban roof (J/m^3/K) + real(r8), pointer :: cv_improad(:,:) ! thermal conductivity of urban impervious road (J/m^3/K) + real(r8), pointer :: thick_wall(:) ! thickness of urban wall (m) + real(r8), pointer :: thick_roof(:) ! thickness of urban roof (m) + integer, pointer :: nlev_improad(:) ! number of impervious road layers (-) +! +! +! !OTHER LOCAL VARIABLES +!EOP + integer :: nc,fl,ib,l,c,p,g ! indices + integer :: ier ! error status + integer :: begp, endp ! clump beginning and ending pft indices + integer :: begc, endc ! clump beginning and ending column indices + integer :: begl, endl ! clump beginning and ending landunit indices + integer :: begg, endg ! clump beginning and ending gridcell indices + + ! Assign local pointers to derived type members (landunit-level) + + ltype => lun%itype + lgridcell => lun%gridcell + coli => lun%coli + colf => lun%colf + canyon_hwr => lun%canyon_hwr + wtroad_perv => lun%wtroad_perv + ht_roof => lun%ht_roof + wtlunit_roof => lun%wtlunit_roof + wind_hgt_canyon => lun%wind_hgt_canyon + eflx_traffic_factor => lef%eflx_traffic_factor + t_building_max => lps%t_building_max + t_building_min => lps%t_building_min + canyon_hwr => lun%canyon_hwr + tk_wall => lps%tk_wall + tk_roof => lps%tk_roof + tk_improad => lps%tk_improad + cv_wall => lps%cv_wall + cv_roof => lps%cv_roof + cv_improad => lps%cv_improad + thick_wall => lps%thick_wall + thick_roof => lps%thick_roof + nlev_improad => lps%nlev_improad + + ! Assign local pointers to derived type members (column-level) + + ctype => col%itype + emg => cps%emg + + ! Initialize time constant urban variables + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + do l = begl, endl + if (ltype(l) == isturb) then + g = lun%gridcell(l) + canyon_hwr(l) = urbinp%canyon_hwr(g) + wtroad_perv(l) = urbinp%wtroad_perv(g) + ht_roof(l) = urbinp%ht_roof(g) + wtlunit_roof(l) = urbinp%wtlunit_roof(g) + wind_hgt_canyon(l) = urbinp%wind_hgt_canyon(g) + tk_wall(l,:) = urbinp%tk_wall(g,:) + tk_roof(l,:) = urbinp%tk_roof(g,:) + tk_improad(l,:) = urbinp%tk_improad(g,:) + cv_wall(l,:) = urbinp%cv_wall(g,:) + cv_roof(l,:) = urbinp%cv_roof(g,:) + cv_improad(l,:) = urbinp%cv_improad(g,:) + thick_wall(l) = urbinp%thick_wall(g) + thick_roof(l) = urbinp%thick_roof(g) + nlev_improad(l) = urbinp%nlev_improad(g) + t_building_min(l) = urbinp%t_building_min(g) + t_building_max(l) = urbinp%t_building_max(g) + + do c = coli(l),colf(l) + if (ctype(c) == icol_roof ) emg(c) = urbinp%em_roof(g) + if (ctype(c) == icol_sunwall ) emg(c) = urbinp%em_wall(g) + if (ctype(c) == icol_shadewall ) emg(c) = urbinp%em_wall(g) + if (ctype(c) == icol_road_imperv) emg(c) = urbinp%em_improad(g) + if (ctype(c) == icol_road_perv ) emg(c) = urbinp%em_perroad(g) + end do + + ! Inferred from Sailor and Lu 2004 + if (urban_traffic) then + eflx_traffic_factor(l) = 3.6_r8 * (canyon_hwr(l)-0.5_r8) + 1.0_r8 + else + eflx_traffic_factor(l) = 0.0_r8 + end if + + if (use_vancouver .or. use_mexicocity) then + ! Freely evolving + t_building_max(l) = 380.00_r8 + t_building_min(l) = 200.00_r8 + else + if (urban_hac == urban_hac_off) then + ! Overwrite values read in from urbinp by freely evolving values + t_building_max(l) = 380.00_r8 + t_building_min(l) = 200.00_r8 + end if + end if + else + eflx_traffic_factor(l) = 0.0_r8 + t_building_max(l) = 0.0_r8 + t_building_min(l) = 0.0_r8 + end if + end do + + end subroutine UrbanInitTimeConst + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanInitTimeVar +! +! !INTERFACE: + subroutine UrbanInitTimeVar( ) +! +! !DESCRIPTION: +! Initialize urban time-varying variables +! +! !USES: + use clmtype + use clm_varcon, only : isturb, spval, icol_road_perv + use decompMod , only : get_proc_bounds +! +! !ARGUMENTS: + implicit none +! +! local pointers to original implicit in arguments (urban clump) +! + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: clandunit(:) ! landunit index of corresponding column + integer , pointer :: plandunit(:) ! landunit index of corresponding pft + integer , pointer :: ctype(:) ! column type +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: taf(:) ! urban canopy air temperature (K) + real(r8), pointer :: qaf(:) ! urban canopy air specific humidity (kg/kg) + real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to walls, roof (W/m**2) + real(r8), pointer :: eflx_urban_ac(:) ! urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat(:) ! urban heating flux (W/m**2) + real(r8), pointer :: fcov(:) ! fractional impermeable area + real(r8), pointer :: fsat(:) ! fractional area with water table at surface + real(r8), pointer :: qcharge(:) ! aquifer recharge rate (mm/s) + real(r8), pointer :: t_building(:) ! internal building temperature (K) + real(r8), pointer :: eflx_traffic(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_wasteheat_pft(:) ! sensible heat flux from urban heating/cooling sources of waste heat at pft level (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_pft(:) ! sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_traffic_pft(:) ! sensible heat flux from traffic (W/m**2) + real(r8), pointer :: eflx_anthro(:) ! total anthropogenic heat flux (W/m**2) + real(r8), pointer :: t_ref2m_u(:) ! Urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_min_u(:) ! Urban daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_u(:) ! Urban daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: rh_ref2m_u(:) ! Urban 2 m height surface relative humidity (%) + real(r8), pointer :: t_grnd_u(:) ! Urban ground temperature (Kelvin) + real(r8), pointer :: qflx_runoff_u(:) ! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + real(r8), pointer :: fsa_u(:) ! Urban absorbed solar radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net_u(:) ! Urban net longwave radiation (W/m**2) + real(r8), pointer :: eflx_lh_tot_u(:) ! Urban latent heat flux (W/m**2) + real(r8), pointer :: eflx_sh_tot_u(:) ! Urban sensible heat flux (W/m**2) + real(r8), pointer :: eflx_soil_grnd_u(:) ! Urban ground heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_u(:) ! Urban snow melt heat flux (W/m**2) +! +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! Created by Keith Oleson February 2005 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: l,g,c,p ! indices + integer :: begp, endp ! clump beginning and ending pft indices + integer :: begc, endc ! clump beginning and ending column indices + integer :: begl, endl ! clump beginning and ending landunit indices + integer :: begg, endg ! clump beginning and ending gridcell indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (landunit level) + + taf => lps%taf + qaf => lps%qaf + ltype => lun%itype + lgridcell => lun%gridcell + t_building => lps%t_building + eflx_traffic => lef%eflx_traffic + eflx_wasteheat => lef%eflx_wasteheat + + ! Assign local pointers to derived type members (column level) + + clandunit => col%landunit + eflx_building_heat => cef%eflx_building_heat + eflx_urban_ac => cef%eflx_urban_ac + eflx_urban_heat => cef%eflx_urban_heat + fcov => cws%fcov + fsat => cws%fsat + qcharge => cws%qcharge + ctype => col%itype + t_grnd_u => ces%t_grnd_u + qflx_runoff_u => cwf%qflx_runoff_u + eflx_snomelt_u => cef%eflx_snomelt_u + + ! Assign local pointers to derived type members (pft level) + + t_ref2m_u => pes%t_ref2m_u + t_ref2m_min_u => pes%t_ref2m_min_u + t_ref2m_max_u => pes%t_ref2m_max_u + rh_ref2m_u => pes%rh_ref2m_u + plandunit => pft%landunit + eflx_wasteheat_pft => pef%eflx_wasteheat_pft + eflx_heat_from_ac_pft => pef%eflx_heat_from_ac_pft + eflx_traffic_pft => pef%eflx_traffic_pft + eflx_anthro => pef%eflx_anthro + fsa_u => pef%fsa_u + eflx_lwrad_net_u => pef%eflx_lwrad_net_u + eflx_lh_tot_u => pef%eflx_lh_tot_u + eflx_sh_tot_u => pef%eflx_sh_tot_u + eflx_soil_grnd_u => pef%eflx_soil_grnd_u + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + do l = begl, endl + g = lgridcell(l) + if (ltype(l) == isturb) then + if (use_vancouver) then + taf(l) = 297.56_r8 + qaf(l) = 0.0111_r8 + else if (use_mexicocity) then + taf(l) = 289.46_r8 + qaf(l) = 0.00248_r8 + else + taf(l) = 283._r8 + ! Arbitrary set since forc_q is not yet available + qaf(l) = 1.e-4_r8 + end if + else + t_building(l) = 0.0_r8 + eflx_traffic(l) = 0.0_r8 + eflx_wasteheat(l) = 0.0_r8 + end if + end do + + do c = begc, endc + l = clandunit(c) + if (ltype(l) == isturb) then + eflx_building_heat(c) = 0._r8 + eflx_urban_ac(c) = 0._r8 + eflx_urban_heat(c) = 0._r8 + ! + ! Set hydrology variables for urban to spvalue -- as only valid for pervious road + ! + if (ctype(c) /= icol_road_perv )then + fcov(c) = spval + fsat(c) = spval + qcharge(c) = spval + end if + else + eflx_building_heat(c) = 0._r8 + eflx_urban_ac(c) = 0._r8 + eflx_urban_heat(c) = 0.0_r8 + t_grnd_u(c) = 0.0_r8 + qflx_runoff_u(c) = 0.0_r8 + eflx_snomelt_u(c) = 0.0_r8 + end if + end do + + do p = begp, endp + l = plandunit(p) + if (ltype(l) /= isturb) then + t_ref2m_u(p) = 0.0_r8 + t_ref2m_min_u(p) = 0.0_r8 + t_ref2m_max_u(p) = 0.0_r8 + rh_ref2m_u(p) = 0.0_r8 + eflx_wasteheat_pft(p) = 0.0_r8 + eflx_heat_from_ac_pft(p) = 0.0_r8 + eflx_traffic_pft(p) = 0.0_r8 + eflx_anthro(p) = 0.0_r8 + fsa_u(p) = 0.0_r8 + eflx_lwrad_net_u(p) = 0.0_r8 + eflx_lh_tot_u(p) = 0.0_r8 + eflx_sh_tot_u(p) = 0.0_r8 + eflx_soil_grnd_u(p) = 0.0_r8 + else + eflx_wasteheat_pft(p) = 0.0_r8 + eflx_heat_from_ac_pft(p) = 0.0_r8 + eflx_traffic_pft(p) = 0.0_r8 + end if + end do + + end subroutine UrbanInitTimeVar + +end module UrbanInitMod diff --git a/components/clm/src_clm40/biogeophys/UrbanInputMod.F90 b/components/clm/src_clm40/biogeophys/UrbanInputMod.F90 new file mode 100644 index 0000000000..dd73156fca --- /dev/null +++ b/components/clm/src_clm40/biogeophys/UrbanInputMod.F90 @@ -0,0 +1,355 @@ +module UrbanInputMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: UrbanInputMod +! +! !DESCRIPTION: +! Read in input urban data - fill in data structure urbinp +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_sys_mod , only : shr_sys_flush +! +! !PUBLIC TYPES: + implicit none + save + + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanInput ! Read in urban input data + + type urbinp_t + real(r8), pointer :: canyon_hwr(:) + real(r8), pointer :: wtlunit_roof(:) + real(r8), pointer :: wtroad_perv(:) + real(r8), pointer :: em_roof(:) + real(r8), pointer :: em_improad(:) + real(r8), pointer :: em_perroad(:) + real(r8), pointer :: em_wall(:) + real(r8), pointer :: alb_roof_dir(:,:) + real(r8), pointer :: alb_roof_dif(:,:) + real(r8), pointer :: alb_improad_dir(:,:) + real(r8), pointer :: alb_improad_dif(:,:) + real(r8), pointer :: alb_perroad_dir(:,:) + real(r8), pointer :: alb_perroad_dif(:,:) + real(r8), pointer :: alb_wall_dir(:,:) + real(r8), pointer :: alb_wall_dif(:,:) + real(r8), pointer :: ht_roof(:) + real(r8), pointer :: wind_hgt_canyon(:) + real(r8), pointer :: tk_wall(:,:) + real(r8), pointer :: tk_roof(:,:) + real(r8), pointer :: tk_improad(:,:) + real(r8), pointer :: cv_wall(:,:) + real(r8), pointer :: cv_roof(:,:) + real(r8), pointer :: cv_improad(:,:) + real(r8), pointer :: thick_wall(:) + real(r8), pointer :: thick_roof(:) + integer, pointer :: nlev_improad(:) + real(r8), pointer :: t_building_min(:) + real(r8), pointer :: t_building_max(:) + end type urbinp_t + public urbinp_t + + type (urbinp_t) , public :: urbinp ! urban input derived type +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanInput +! +! !INTERFACE: + subroutine UrbanInput(mode) +! +! !DESCRIPTION: +! Allocate memory and read in urban input data +! +! !USES: + use clm_varpar, only : numrad, nlevurb, numsolar + use clm_varctl, only : iulog, fsurdat, single_column + use fileutils , only : getavu, relavu, getfil, opnfil + use spmdMod , only : masterproc + use clmtype + use decompMod , only : get_proc_bounds + use domainMod , only : ldomain + use ncdio_pio , only : file_desc_t, ncd_pio_openfile, ncd_io, ncd_inqfdims, ncd_pio_closefile, ncd_inqdid, ncd_inqdlen +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: mode +! +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein July 2004 +! Revised by Keith Oleson for netcdf input Jan 2008 +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: dimid,varid ! netCDF id's + integer :: begg,endg ! start/stop gridcells + integer :: nw,n,k,i,j,ni,nj,ns ! indices + integer :: nlevurb_i ! input grid: number of urban vertical levels + integer :: numsolar_i ! input grid: number of solar type (DIR/DIF) + integer :: numrad_i ! input grid: number of solar bands (VIS/NIR) + integer :: ier,ret ! error status + logical :: isgrid2d ! true => file is 2d + logical :: readvar ! true => variable is on dataset + real(r8), pointer :: arrayl3d(:,:,:) ! generic global array + character(len=32) :: subname = 'UrbanInput' ! subroutine name +!----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg) + + if (mode == 'initialize') then + + ! Allocate dynamic memory + allocate(urbinp%canyon_hwr(begg:endg), & + urbinp%wtlunit_roof(begg:endg), & + urbinp%wtroad_perv(begg:endg), & + urbinp%em_roof(begg:endg), & + urbinp%em_improad(begg:endg), & + urbinp%em_perroad(begg:endg), & + urbinp%em_wall(begg:endg), & + urbinp%alb_roof_dir(begg:endg,numrad), & + urbinp%alb_roof_dif(begg:endg,numrad), & + urbinp%alb_improad_dir(begg:endg,numrad), & + urbinp%alb_perroad_dir(begg:endg,numrad), & + urbinp%alb_improad_dif(begg:endg,numrad), & + urbinp%alb_perroad_dif(begg:endg,numrad), & + urbinp%alb_wall_dir(begg:endg,numrad), & + urbinp%alb_wall_dif(begg:endg,numrad), & + urbinp%ht_roof(begg:endg), & + urbinp%wind_hgt_canyon(begg:endg), & + urbinp%tk_wall(begg:endg,nlevurb), & + urbinp%tk_roof(begg:endg,nlevurb), & + urbinp%tk_improad(begg:endg,nlevurb), & + urbinp%cv_wall(begg:endg,nlevurb), & + urbinp%cv_roof(begg:endg,nlevurb), & + urbinp%cv_improad(begg:endg,nlevurb), & + urbinp%thick_wall(begg:endg), & + urbinp%thick_roof(begg:endg), & + urbinp%nlev_improad(begg:endg), & + urbinp%t_building_min(begg:endg), & + urbinp%t_building_max(begg:endg), & + stat=ier) + if (ier /= 0) then + write(iulog,*)'initUrbanInput: allocation error '; call endrun() + endif + + ! Read urban data + + if (masterproc) then + write(iulog,*)' Reading in urban input data from fsurdat file ...' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + if (masterproc) then + write(iulog,*) subname,trim(fsurdat) + end if + + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun() + end if + + call ncd_inqdid(ncid, 'nlevurb', dimid) + call ncd_inqdlen(ncid, dimid, nlevurb_i) + if (nlevurb_i /= nlevurb) then + write(iulog,*)trim(subname)// ': parameter nlevurb= ',nlevurb, & + 'does not equal input dataset nlevurb= ',nlevurb_i + call endrun + endif + + call ncd_inqdid(ncid, 'numsolar', dimid) + call ncd_inqdlen(ncid, dimid, numsolar_i) + if (numsolar_i /= numsolar) then + write(iulog,*)trim(subname)// ': parameter numsolar= ',numsolar, & + 'does not equal input dataset numsolar= ',numsolar_i + call endrun + endif + + call ncd_inqdid(ncid, 'numrad', dimid) + call ncd_inqdlen(ncid, dimid, numrad_i) + if (numrad_i /= numrad) then + write(iulog,*)trim(subname)// ': parameter numrad= ',numrad, & + 'does not equal input dataset numrad= ',numrad_i + call endrun + endif + + call ncd_io(ncid=ncid, varname='CANYON_HWR', flag='read', data=urbinp%canyon_hwr,& + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: CANYON_HWR NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='WTLUNIT_ROOF', flag='read', data=urbinp%wtlunit_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: WTLUNIT_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='WTROAD_PERV', flag='read', data=urbinp%wtroad_perv, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: WTROAD_PERV NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='EM_ROOF', flag='read', data=urbinp%em_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='EM_IMPROAD', flag='read', data=urbinp%em_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_IMPROAD NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='EM_PERROAD', flag='read', data=urbinp%em_perroad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_PERROAD NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='EM_WALL', flag='read', data=urbinp%em_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: EM_WALL NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='HT_ROOF', flag='read', data=urbinp%ht_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HT_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='WIND_HGT_CANYON', flag='read', data=urbinp%wind_hgt_canyon, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: WIND_HGT_CANYON NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='THICK_WALL', flag='read', data=urbinp%thick_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: THICK_WALL NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='THICK_ROOF', flag='read', data=urbinp%thick_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: THICK_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='NLEV_IMPROAD', flag='read', data=urbinp%nlev_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: NLEV_IMPROAD NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='T_BUILDING_MIN', flag='read', data=urbinp%t_building_min, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: T_BUILDING_MIN NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='T_BUILDING_MAX', flag='read', data=urbinp%t_building_max, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: T_BUILDING_MAX NOT on fsurdat file' ) + + allocate(arrayl3d(begg:endg,numrad,numsolar)) + + call ncd_io(ncid=ncid, varname='ALB_IMPROAD', flag='read', data=arrayl3d, & + dim1name=grlnd, readvar=readvar) + if (.not.readvar) call endrun( trim(subname)//' ERROR: ALB_IMPROAD NOT on fsurdat file' ) + urbinp%alb_improad_dir(begg:endg,:) = arrayl3d(begg:endg,:,1) + urbinp%alb_improad_dif(begg:endg,:) = arrayl3d(begg:endg,:,2) + + call ncd_io(ncid=ncid, varname='ALB_PERROAD', flag='read',data=arrayl3d, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_PERROAD NOT on fsurdat file' ) + urbinp%alb_perroad_dir(begg:endg,:) = arrayl3d(begg:endg,:,1) + urbinp%alb_perroad_dif(begg:endg,:) = arrayl3d(begg:endg,:,2) + + call ncd_io(ncid=ncid, varname='ALB_ROOF', flag='read', data=arrayl3d, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_ROOF NOT on fsurdat file' ) + urbinp%alb_roof_dir(begg:endg,:) = arrayl3d(begg:endg,:,1) + urbinp%alb_roof_dif(begg:endg,:) = arrayl3d(begg:endg,:,2 ) + + call ncd_io(ncid=ncid, varname='ALB_WALL', flag='read', data=arrayl3d, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: ALB_WALL NOT on fsurdat file' ) + urbinp%alb_wall_dir(begg:endg,:) = arrayl3d(begg:endg,:,1) + urbinp%alb_wall_dif(begg:endg,:) = arrayl3d(begg:endg,:,2) + + deallocate (arrayl3d) + + call ncd_io(ncid=ncid, varname='TK_IMPROAD', flag='read', data=urbinp%tk_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_IMPROAD NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='TK_ROOF', flag='read', data=urbinp%tk_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='TK_WALL', flag='read', data=urbinp%tk_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: TK_WALL NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='CV_IMPROAD', flag='read', data=urbinp%cv_improad, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_IMPROAD NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='CV_ROOF', flag='read', data=urbinp%cv_roof, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_ROOF NOT on fsurdat file' ) + + call ncd_io(ncid=ncid, varname='CV_WALL', flag='read', data=urbinp%cv_wall, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: CV_WALL NOT on fsurdat file' ) + + call ncd_pio_closefile(ncid) + if (masterproc) then + write(iulog,*)' Sucessfully read urban input data' + write(iulog,*) + end if + + else if (mode == 'finalize') then + + deallocate(urbinp%canyon_hwr, & + urbinp%wtlunit_roof, & + urbinp%wtroad_perv, & + urbinp%em_roof, & + urbinp%em_improad, & + urbinp%em_perroad, & + urbinp%em_wall, & + urbinp%alb_roof_dir, & + urbinp%alb_roof_dif, & + urbinp%alb_improad_dir, & + urbinp%alb_perroad_dir, & + urbinp%alb_improad_dif, & + urbinp%alb_perroad_dif, & + urbinp%alb_wall_dir, & + urbinp%alb_wall_dif, & + urbinp%ht_roof, & + urbinp%wind_hgt_canyon, & + urbinp%tk_wall, & + urbinp%tk_roof, & + urbinp%tk_improad, & + urbinp%cv_wall, & + urbinp%cv_roof, & + urbinp%cv_improad, & + urbinp%thick_wall, & + urbinp%thick_roof, & + urbinp%nlev_improad, & + urbinp%t_building_min, & + urbinp%t_building_max, & + stat=ier) + if (ier /= 0) then + write(iulog,*)'initUrbanInput: deallocation error '; call endrun() + endif + + else + write(iulog,*)'initUrbanInput error: mode ',trim(mode),' not supported ' + call endrun() + end if + + end subroutine UrbanInput + +end module UrbanInputMod + diff --git a/components/clm/src_clm40/biogeophys/UrbanMod.F90 b/components/clm/src_clm40/biogeophys/UrbanMod.F90 new file mode 100644 index 0000000000..01896678f5 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/UrbanMod.F90 @@ -0,0 +1,3464 @@ +module UrbanMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: UrbanMod +! +! !DESCRIPTION: +! Calculate solar and longwave radiation, and turbulent fluxes for urban landunit +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_varpar , only : numrad + use clm_varcon , only : isecspday, degpsec + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_sys_mod , only : shr_sys_flush +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: UrbanClumpInit ! Initialization of urban clump data structure + public :: UrbanRadiation ! Urban radiative fluxes + public :: UrbanAlbedo ! Urban albedos + public :: UrbanSnowAlbedo ! Urban snow albedos + public :: UrbanFluxes ! Urban turbulent fluxes + +! !Urban control variables + character(len= *), parameter, public :: urban_hac_off = 'OFF' ! + character(len= *), parameter, public :: urban_hac_on = 'ON' ! + character(len= *), parameter, public :: urban_wasteheat_on = 'ON_WASTEHEAT' ! + character(len= 16), public :: urban_hac = urban_hac_off + logical, public :: urban_traffic = .false. ! urban traffic fluxes +! +! !REVISION HISTORY: +! Created by Gordon Bonan and Mariana Vertenstein and Keith Oleson 04/2003 +! +!EOP +! +! PRIVATE MEMBER FUNCTIONS + private :: view_factor ! View factors for road and one wall + private :: incident_direct ! Direct beam solar rad incident on walls and road in urban canyon + private :: incident_diffuse ! Diffuse solar rad incident on walls and road in urban canyon + private :: net_solar ! Solar radiation absorbed by road and both walls in urban canyon + private :: net_longwave ! Net longwave radiation for road and both walls in urban canyon + +! PRIVATE TYPES + private + type urban_clump_t + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width + real(r8), pointer :: wtroad_perv(:) ! weight of pervious road wrt total road + real(r8), pointer :: ht_roof(:) ! height of urban roof (m) + real(r8), pointer :: wtlunit_roof(:) ! weight of roof with respect to landunit + real(r8), pointer :: wind_hgt_canyon(:) ! height above road at which wind in canyon is to be computed (m) + real(r8), pointer :: em_roof(:) ! roof emissivity + real(r8), pointer :: em_improad(:) ! impervious road emissivity + real(r8), pointer :: em_perroad(:) ! pervious road emissivity + real(r8), pointer :: em_wall(:) ! wall emissivity + real(r8), pointer :: alb_roof_dir(:,:) ! direct roof albedo + real(r8), pointer :: alb_roof_dif(:,:) ! diffuse roof albedo + real(r8), pointer :: alb_improad_dir(:,:) ! direct impervious road albedo + real(r8), pointer :: alb_improad_dif(:,:) ! diffuse impervious road albedo + real(r8), pointer :: alb_perroad_dir(:,:) ! direct pervious road albedo + real(r8), pointer :: alb_perroad_dif(:,:) ! diffuse pervious road albedo + real(r8), pointer :: alb_wall_dir(:,:) ! direct wall albedo + real(r8), pointer :: alb_wall_dif(:,:) ! diffuse wall albedo + end type urban_clump_t + + type (urban_clump_t), private, pointer :: urban_clump(:) ! array of urban clumps for this processor + + integer, private, parameter :: noonsec = isecspday / 2 ! seconds at local noon +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanAlbedo +! +! !INTERFACE: + subroutine UrbanAlbedo (nc, lbl, ubl, lbc, ubc, lbp, ubp, & + num_urbanl, filter_urbanl, & + num_urbanc, filter_urbanc, & + num_urbanp, filter_urbanp) +! +! !DESCRIPTION: +! Determine urban landunit component albedos +! +! !USES: + use clmtype + use shr_orb_mod , only : shr_orb_decl, shr_orb_cosz + use clm_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv, & + sb +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: nc ! clump index + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban pfts in clump + integer , intent(in) :: filter_urbanp(ubp-lbp+1) ! urban pft filter +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 03/2003, Mariana Vertenstein: Migrated to clm2.2 +! 01/2008, Erik Kluzek: Migrated to clm3.5.15 +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: clandunit(:) ! column's landunit + integer , pointer :: cgridcell(:) ! gridcell of corresponding column + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + integer , pointer :: ctype(:) ! column type + integer , pointer :: pcolumn(:) ! column of corresponding pft + real(r8), pointer :: czen(:) ! cosine of solar zenith angle for each column + real(r8), pointer :: lat(:) ! latitude (radians) + real(r8), pointer :: lon(:) ! longitude (radians) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: albgrd(:,:) ! ground albedo (direct) + real(r8), pointer :: albgri(:,:) ! ground albedo (diffuse) + real(r8), pointer :: albd(:,:) ! surface albedo (direct) + real(r8), pointer :: albi(:,:) ! surface albedo (diffuse) + real(r8), pointer :: fabd(:,:) ! flux absorbed by veg per unit direct flux + real(r8), pointer :: fabi(:,:) ! flux absorbed by veg per unit diffuse flux + real(r8), pointer :: ftdd(:,:) ! down direct flux below veg per unit dir flx + real(r8), pointer :: ftid(:,:) ! down diffuse flux below veg per unit dir flx + real(r8), pointer :: ftii(:,:) ! down diffuse flux below veg per unit dif flx + real(r8), pointer :: fsun(:) ! sunlit fraction of canopy + real(r8), pointer :: gdir(:) ! leaf projection in solar direction (0 to 1) + real(r8), pointer :: omega(:,:) ! fraction of intercepted radiation that is scattered (0 to 1) + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall + real(r8), pointer :: sabs_roof_dir(:,:) ! direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif(:,:) ! diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir(:,:) ! direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif(:,:) ! diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir(:,:) ! direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif(:,:) ! diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir(:,:) ! direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif(:,:) ! diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir(:,:) ! direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif(:,:) ! diffuse solar absorbed by pervious road per unit ground area per unit incident flux +! +! +! !OTHER LOCAL VARIABLES +!EOP +! + real(r8) :: coszen(num_urbanl) ! cosine solar zenith angle + real(r8) :: coszen_pft(num_urbanp) ! cosine solar zenith angle for next time step (pft level) + real(r8) :: zen(num_urbanl) ! solar zenith angle (radians) + real(r8) :: sdir(num_urbanl, numrad) ! direct beam solar radiation on horizontal surface + real(r8) :: sdif(num_urbanl, numrad) ! diffuse solar radiation on horizontal surface + + real(r8) :: sdir_road(num_urbanl, numrad) ! direct beam solar radiation incident on road + real(r8) :: sdif_road(num_urbanl, numrad) ! diffuse solar radiation incident on road + real(r8) :: sdir_sunwall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8) :: sdif_sunwall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8) :: sdir_shadewall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8) :: sdif_shadewall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8) :: albsnd_roof(num_urbanl,numrad) ! snow albedo for roof (direct) + real(r8) :: albsni_roof(num_urbanl,numrad) ! snow albedo for roof (diffuse) + real(r8) :: albsnd_improad(num_urbanl,numrad) ! snow albedo for impervious road (direct) + real(r8) :: albsni_improad(num_urbanl,numrad) ! snow albedo for impervious road (diffuse) + real(r8) :: albsnd_perroad(num_urbanl,numrad) ! snow albedo for pervious road (direct) + real(r8) :: albsni_perroad(num_urbanl,numrad) ! snow albedo for pervious road (diffuse) + + integer :: fl,fp,fc,g,l,p,c,ib ! indices + integer :: ic ! 0=unit incoming direct; 1=unit incoming diffuse + integer :: num_solar ! counter + real(r8) :: alb_roof_dir_s(num_urbanl,numrad) ! direct roof albedo with snow effects + real(r8) :: alb_roof_dif_s(num_urbanl,numrad) ! diffuse roof albedo with snow effects + real(r8) :: alb_improad_dir_s(num_urbanl,numrad) ! direct impervious road albedo with snow effects + real(r8) :: alb_perroad_dir_s(num_urbanl,numrad) ! direct pervious road albedo with snow effects + real(r8) :: alb_improad_dif_s(num_urbanl,numrad) ! diffuse impervious road albedo with snow effects + real(r8) :: alb_perroad_dif_s(num_urbanl,numrad) ! diffuse pervious road albedo with snow effects + real(r8) :: sref_roof_dir(num_urbanl,numrad) ! direct solar reflected by roof per unit ground area per unit incident flux + real(r8) :: sref_roof_dif(num_urbanl,numrad) ! diffuse solar reflected by roof per unit ground area per unit incident flux + real(r8) :: sref_sunwall_dir(num_urbanl,numrad) ! direct solar reflected by sunwall per unit wall area per unit incident flux + real(r8) :: sref_sunwall_dif(num_urbanl,numrad) ! diffuse solar reflected by sunwall per unit wall area per unit incident flux + real(r8) :: sref_shadewall_dir(num_urbanl,numrad) ! direct solar reflected by shadewall per unit wall area per unit incident flux + real(r8) :: sref_shadewall_dif(num_urbanl,numrad) ! diffuse solar reflected by shadewall per unit wall area per unit incident flux + real(r8) :: sref_improad_dir(num_urbanl,numrad) ! direct solar reflected by impervious road per unit ground area per unit incident flux + real(r8) :: sref_improad_dif(num_urbanl,numrad) ! diffuse solar reflected by impervious road per unit ground area per unit incident flux + real(r8) :: sref_perroad_dir(num_urbanl,numrad) ! direct solar reflected by pervious road per unit ground area per unit incident flux + real(r8) :: sref_perroad_dif(num_urbanl,numrad) ! diffuse solar reflected by pervious road per unit ground area per unit incident flux + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width + real(r8), pointer :: wtroad_perv(:) ! weight of pervious road wrt total road + real(r8), pointer :: alb_roof_dir(:,:) ! direct roof albedo + real(r8), pointer :: alb_roof_dif(:,:) ! diffuse roof albedo + real(r8), pointer :: alb_improad_dir(:,:) ! direct impervious road albedo + real(r8), pointer :: alb_perroad_dir(:,:) ! direct pervious road albedo + real(r8), pointer :: alb_improad_dif(:,:) ! diffuse imprevious road albedo + real(r8), pointer :: alb_perroad_dif(:,:) ! diffuse pervious road albedo + real(r8), pointer :: alb_wall_dir(:,:) ! direct wall albedo + real(r8), pointer :: alb_wall_dif(:,:) ! diffuse wall albedo +!----------------------------------------------------------------------- + + ! Assign pointers into module urban clumps + + canyon_hwr => urban_clump(nc)%canyon_hwr + wtroad_perv => urban_clump(nc)%wtroad_perv + alb_roof_dir => urban_clump(nc)%alb_roof_dir + alb_roof_dif => urban_clump(nc)%alb_roof_dif + alb_improad_dir => urban_clump(nc)%alb_improad_dir + alb_improad_dif => urban_clump(nc)%alb_improad_dif + alb_perroad_dir => urban_clump(nc)%alb_perroad_dir + alb_perroad_dif => urban_clump(nc)%alb_perroad_dif + alb_wall_dir => urban_clump(nc)%alb_wall_dir + alb_wall_dif => urban_clump(nc)%alb_wall_dif + + ! Assign gridcell level pointers + + lat => grc%lat + lon => grc%lon + + ! Assign landunit level pointer + + lgridcell => lun%gridcell + coli => lun%coli + colf => lun%colf + vf_sr => lps%vf_sr + vf_wr => lps%vf_wr + vf_sw => lps%vf_sw + vf_rw => lps%vf_rw + vf_ww => lps%vf_ww + sabs_roof_dir => lps%sabs_roof_dir + sabs_roof_dif => lps%sabs_roof_dif + sabs_sunwall_dir => lps%sabs_sunwall_dir + sabs_sunwall_dif => lps%sabs_sunwall_dif + sabs_shadewall_dir => lps%sabs_shadewall_dir + sabs_shadewall_dif => lps%sabs_shadewall_dif + sabs_improad_dir => lps%sabs_improad_dir + sabs_improad_dif => lps%sabs_improad_dif + sabs_perroad_dir => lps%sabs_perroad_dir + sabs_perroad_dif => lps%sabs_perroad_dif + + ! Assign column level pointers + + ctype => col%itype + albgrd => cps%albgrd + albgri => cps%albgri + frac_sno => cps%frac_sno + clandunit => col%landunit + cgridcell => col%gridcell + czen => cps%coszen + + ! Assign pft level pointers + + pgridcell => pft%gridcell + pcolumn => pft%column + albd => pps%albd + albi => pps%albi + fabd => pps%fabd + fabi => pps%fabi + ftdd => pps%ftdd + ftid => pps%ftid + ftii => pps%ftii + fsun => pps%fsun + gdir => pps%gdir + omega => pps%omega + + ! ---------------------------------------------------------------------------- + ! Solar declination and cosine solar zenith angle and zenith angle for + ! next time step + ! ---------------------------------------------------------------------------- + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + coszen(fl) = czen(coli(l)) ! Assumes coszen for each column are the same + zen(fl) = acos(coszen(fl)) + end do + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + g = pgridcell(p) + c = pcolumn(p) + coszen_pft(fp) = czen(c) + end do + + ! ---------------------------------------------------------------------------- + ! Initialize clmtype output since solar radiation is only done if coszen > 0 + ! ---------------------------------------------------------------------------- + + do ib = 1,numrad + do fc = 1,num_urbanc + c = filter_urbanc(fc) + + albgrd(c,ib) = 0._r8 + albgri(c,ib) = 0._r8 + end do + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + g = pgridcell(p) + albd(p,ib) = 1._r8 + albi(p,ib) = 1._r8 + fabd(p,ib) = 0._r8 + fabi(p,ib) = 0._r8 + if (coszen_pft(fp) > 0._r8) then + ftdd(p,ib) = 1._r8 + else + ftdd(p,ib) = 0._r8 + end if + ftid(p,ib) = 0._r8 + if (coszen_pft(fp) > 0._r8) then + ftii(p,ib) = 1._r8 + else + ftii(p,ib) = 0._r8 + end if + omega(p,ib) = 0._r8 + if (ib == 1) then + gdir(p) = 0._r8 + fsun(p) = 0._r8 + end if + end do + end do + + ! ---------------------------------------------------------------------------- + ! Urban Code + ! ---------------------------------------------------------------------------- + + num_solar = 0 + do fl = 1,num_urbanl + if (coszen(fl) > 0._r8) num_solar = num_solar + 1 + end do + + ! Initialize urban clump components + + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + sabs_roof_dir(l,ib) = 0._r8 + sabs_roof_dif(l,ib) = 0._r8 + sabs_sunwall_dir(l,ib) = 0._r8 + sabs_sunwall_dif(l,ib) = 0._r8 + sabs_shadewall_dir(l,ib) = 0._r8 + sabs_shadewall_dif(l,ib) = 0._r8 + sabs_improad_dir(l,ib) = 0._r8 + sabs_improad_dif(l,ib) = 0._r8 + sabs_perroad_dir(l,ib) = 0._r8 + sabs_perroad_dif(l,ib) = 0._r8 + sref_roof_dir(fl,ib) = 1._r8 + sref_roof_dif(fl,ib) = 1._r8 + sref_sunwall_dir(fl,ib) = 1._r8 + sref_sunwall_dif(fl,ib) = 1._r8 + sref_shadewall_dir(fl,ib) = 1._r8 + sref_shadewall_dif(fl,ib) = 1._r8 + sref_improad_dir(fl,ib) = 1._r8 + sref_improad_dif(fl,ib) = 1._r8 + sref_perroad_dir(fl,ib) = 1._r8 + sref_perroad_dif(fl,ib) = 1._r8 + end do + end do + + ! View factors for road and one wall in urban canyon (depends only on canyon_hwr) + + if (num_urbanl .gt. 0) then + call view_factor (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr) + end if + + ! ---------------------------------------------------------------------------- + ! Only do the rest if all coszen are positive + ! ---------------------------------------------------------------------------- + + if (num_solar > 0)then + + ! Set constants - solar fluxes are per unit incoming flux + + do ib = 1,numrad + do fl = 1,num_urbanl + sdir(fl,ib) = 1._r8 + sdif(fl,ib) = 1._r8 + end do + end do + + ! Incident direct beam radiation for + ! (a) roof and (b) road and both walls in urban canyon + + if (num_urbanl .gt. 0) then + call incident_direct (lbl, ubl, num_urbanl, canyon_hwr, coszen, zen, sdir, sdir_road, sdir_sunwall, sdir_shadewall) + end if + + ! Incident diffuse radiation for + ! (a) roof and (b) road and both walls in urban canyon. + + if (num_urbanl .gt. 0) then + call incident_diffuse (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr, sdif, sdif_road, & + sdif_sunwall, sdif_shadewall) + end if + + ! Get snow albedos for roof and impervious and pervious road + if (num_urbanl .gt. 0) then + ic = 0; call UrbanSnowAlbedo(lbl, ubl, num_urbanl, filter_urbanl, coszen, ic, albsnd_roof, albsnd_improad, albsnd_perroad) + ic = 1; call UrbanSnowAlbedo(lbl, ubl, num_urbanl, filter_urbanl, coszen, ic, albsni_roof, albsni_improad, albsni_perroad) + end if + + ! Combine snow-free and snow albedos + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + do c = coli(l),colf(l) + if (ctype(c) == icol_roof) then + alb_roof_dir_s(fl,ib) = alb_roof_dir(fl,ib)*(1._r8-frac_sno(c)) & + + albsnd_roof(fl,ib)*frac_sno(c) + alb_roof_dif_s(fl,ib) = alb_roof_dif(fl,ib)*(1._r8-frac_sno(c)) & + + albsni_roof(fl,ib)*frac_sno(c) + else if (ctype(c) == icol_road_imperv) then + alb_improad_dir_s(fl,ib) = alb_improad_dir(fl,ib)*(1._r8-frac_sno(c)) & + + albsnd_improad(fl,ib)*frac_sno(c) + alb_improad_dif_s(fl,ib) = alb_improad_dif(fl,ib)*(1._r8-frac_sno(c)) & + + albsni_improad(fl,ib)*frac_sno(c) + else if (ctype(c) == icol_road_perv) then + alb_perroad_dir_s(fl,ib) = alb_perroad_dir(fl,ib)*(1._r8-frac_sno(c)) & + + albsnd_perroad(fl,ib)*frac_sno(c) + alb_perroad_dif_s(fl,ib) = alb_perroad_dif(fl,ib)*(1._r8-frac_sno(c)) & + + albsni_perroad(fl,ib)*frac_sno(c) + end if + end do + end do + end do + + ! Reflected and absorbed solar radiation per unit incident radiation + ! for road and both walls in urban canyon allowing for multiple reflection + ! Reflected and absorbed solar radiation per unit incident radiation for roof + + if (num_urbanl .gt. 0) then + call net_solar (lbl, ubl, num_urbanl, filter_urbanl, coszen, canyon_hwr, wtroad_perv, sdir, sdif, & + alb_improad_dir_s, alb_perroad_dir_s, alb_wall_dir, alb_roof_dir_s, & + alb_improad_dif_s, alb_perroad_dif_s, alb_wall_dif, alb_roof_dif_s, & + sdir_road, sdir_sunwall, sdir_shadewall, & + sdif_road, sdif_sunwall, sdif_shadewall, & + sref_improad_dir, sref_perroad_dir, sref_sunwall_dir, sref_shadewall_dir, sref_roof_dir, & + sref_improad_dif, sref_perroad_dif, sref_sunwall_dif, sref_shadewall_dif, sref_roof_dif) + end if + + ! ---------------------------------------------------------------------------- + ! Map urban output to clmtype components + ! ---------------------------------------------------------------------------- + + ! Set albgrd and albgri (ground albedos) and albd and albi (surface albedos) + + do ib = 1,numrad + do fl = 1,num_urbanl + l = filter_urbanl(fl) + do c = coli(l),colf(l) + if (ctype(c) == icol_roof) then + albgrd(c,ib) = sref_roof_dir(fl,ib) + albgri(c,ib) = sref_roof_dif(fl,ib) + else if (ctype(c) == icol_sunwall) then + albgrd(c,ib) = sref_sunwall_dir(fl,ib) + albgri(c,ib) = sref_sunwall_dif(fl,ib) + else if (ctype(c) == icol_shadewall) then + albgrd(c,ib) = sref_shadewall_dir(fl,ib) + albgri(c,ib) = sref_shadewall_dif(fl,ib) + else if (ctype(c) == icol_road_perv) then + albgrd(c,ib) = sref_perroad_dir(fl,ib) + albgri(c,ib) = sref_perroad_dif(fl,ib) + else if (ctype(c) == icol_road_imperv) then + albgrd(c,ib) = sref_improad_dir(fl,ib) + albgri(c,ib) = sref_improad_dif(fl,ib) + endif + end do + end do + do fp = 1,num_urbanp + p = filter_urbanp(fp) + c = pcolumn(p) + albd(p,ib) = albgrd(c,ib) + albi(p,ib) = albgri(c,ib) + end do + end do + end if + + end subroutine UrbanAlbedo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanSnowAlbedo +! +! !INTERFACE: + subroutine UrbanSnowAlbedo (lbl, ubl, num_urbanl, filter_urbanl, coszen, ind, & + albsn_roof, albsn_improad, albsn_perroad) +! +! !DESCRIPTION: +! Determine urban snow albedos +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_varcon , only : icol_roof, icol_road_perv, icol_road_imperv +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + integer , intent(in) :: ind ! 0=direct beam, 1=diffuse radiation + real(r8), intent(in) :: coszen(num_urbanl) ! cosine solar zenith angle + real(r8), intent(out):: albsn_roof(num_urbanl,2) ! roof snow albedo by waveband (assume 2 wavebands) + real(r8), intent(out):: albsn_improad(num_urbanl,2) ! impervious road snow albedo by waveband (assume 2 wavebands) + real(r8), intent(out):: albsn_perroad(num_urbanl,2) ! pervious road snow albedo by waveband (assume 2 wavebands) +! +! !CALLED FROM: +! subroutine UrbanAlbedo in this module +! +! !REVISION HISTORY: +! Author: Keith Oleson 9/2005 +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + integer , pointer :: ctype(:) ! column type +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: fl,c,l ! indices +! +! variables and constants for snow albedo calculation +! +! These values are derived from Marshall (1989) assuming soot content of 1.5e-5 +! (three times what LSM uses globally). Note that snow age effects are ignored here. + real(r8), parameter :: snal0 = 0.66_r8 ! vis albedo of urban snow + real(r8), parameter :: snal1 = 0.56_r8 ! nir albedo of urban snow +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (landunit level) + + coli => lun%coli + colf => lun%colf + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + h2osno => cws%h2osno + + ! this code assumes that numrad = 2 , with the following + ! index values: 1 = visible, 2 = NIR + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + do c = coli(l),colf(l) + if (coszen(fl) > 0._r8 .and. h2osno(c) > 0._r8) then + if (ctype(c) == icol_roof) then + albsn_roof(fl,1) = snal0 + albsn_roof(fl,2) = snal1 + else if (ctype(c) == icol_road_imperv) then + albsn_improad(fl,1) = snal0 + albsn_improad(fl,2) = snal1 + else if (ctype(c) == icol_road_perv) then + albsn_perroad(fl,1) = snal0 + albsn_perroad(fl,2) = snal1 + end if + else + if (ctype(c) == icol_roof) then + albsn_roof(fl,1) = 0._r8 + albsn_roof(fl,2) = 0._r8 + else if (ctype(c) == icol_road_imperv) then + albsn_improad(fl,1) = 0._r8 + albsn_improad(fl,2) = 0._r8 + else if (ctype(c) == icol_road_perv) then + albsn_perroad(fl,1) = 0._r8 + albsn_perroad(fl,2) = 0._r8 + end if + end if + end do + end do + + end subroutine UrbanSnowAlbedo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanRadiation +! +! !INTERFACE: + subroutine UrbanRadiation (nc, lbl, ubl, lbc, ubc, lbp, ubp, & + num_nourbanl, filter_nourbanl, & + num_urbanl, filter_urbanl, & + num_urbanc, filter_urbanc, & + num_urbanp, filter_urbanp) +! +! !DESCRIPTION: +! Solar fluxes absorbed and reflected by roof and canyon (walls, road). +! Also net and upward longwave fluxes. + +! !USES: + use clmtype + use clm_varcon , only : spval, icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv, sb + use clm_varcon , only : tfrz ! To use new constant.. + use clm_time_manager , only : get_curr_date, get_step_size + use clm_atmlnd , only : clm_a2l +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: nc ! clump index + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer , intent(in) :: num_nourbanl ! number of non-urban landunits in clump + integer , intent(in) :: filter_nourbanl(ubl-lbl+1) ! non-urban landunit filter + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban pfts in clump + integer , intent(in) :: filter_urbanp(ubp-lbp+1) ! urban pft filter +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 03/2003, Mariana Vertenstein: Migrated to clm2.2 +! 07/2004, Mariana Vertenstein: Migrated to clm3.0 +! 01/2008, Erik Kluzek: Migrated to clm3.5.15 +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments (urban clump) +! + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width + real(r8), pointer :: wtroad_perv(:) ! weight of pervious road wrt total road + real(r8), pointer :: em_roof(:) ! roof emissivity + real(r8), pointer :: em_improad(:) ! impervious road emissivity + real(r8), pointer :: em_perroad(:) ! pervious road emissivity + real(r8), pointer :: em_wall(:) ! wall emissivity +! +! local pointers to original implicit in arguments (clmtype) +! + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: ctype(:) ! column type + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + integer , pointer :: pfti(:) ! beginning pfti index for landunit + integer , pointer :: pftf(:) ! ending pftf index for landunit + real(r8), pointer :: londeg(:) ! longitude (degrees) + real(r8), pointer :: forc_lwrad(:) ! downward infrared (longwave) radiation (W/m**2) + real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (vis=forc_sols , nir=forc_soll ) (W/m**2) + real(r8), pointer :: forc_solai(:,:) ! diffuse beam radiation (vis=forc_sols , nir=forc_soll ) (W/m**2) + real(r8), pointer :: forc_solar(:) ! incident solar radiation (W/m**2) + real(r8), pointer :: albd(:,:) ! surface albedo (direct) + real(r8), pointer :: albi(:,:) ! surface albedo (diffuse) + real(r8), pointer :: t_grnd(:) ! ground temperature (K) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (K) + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall + real(r8), pointer :: sabs_roof_dir(:,:) ! direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif(:,:) ! diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir(:,:) ! direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif(:,:) ! diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir(:,:) ! direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif(:,:) ! diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir(:,:) ! direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif(:,:) ! diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir(:,:) ! direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif(:,:) ! diffuse solar absorbed by pervious road per unit ground area per unit incident flux +! +! local pointers to original implicit out arguments (clmtype) +! + real(r8), pointer :: parsun(:) ! average absorbed PAR for sunlit leaves (W/m**2) + real(r8), pointer :: parsha(:) ! average absorbed PAR for shaded leaves (W/m**2) + real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: sabv(:) ! solar radiation absorbed by vegetation (W/m**2) + real(r8), pointer :: fsa(:) ! solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_u(:) ! urban solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsr(:) ! solar radiation reflected (total) (W/m**2) + real(r8), pointer :: fsds_vis_d(:) ! incident direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_d(:) ! incident direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_i(:) ! incident diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_i(:) ! incident diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_d(:) ! reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_d(:) ! reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_i(:) ! reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_i(:) ! reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_d_ln(:) ! incident direct beam vis solar rad at local noon (W/m**2) + real(r8), pointer :: fsds_nir_d_ln(:) ! incident direct beam nir solar rad at local noon (W/m**2) + real(r8), pointer :: fsr_vis_d_ln(:) ! reflected direct beam vis solar rad at local noon (W/m**2) + real(r8), pointer :: fsr_nir_d_ln(:) ! reflected direct beam nir solar rad at local noon (W/m**2) + real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net(:) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_u(:) ! urban net infrared (longwave) rad (W/m**2) [+ = to atm] +! +! +! !OTHER LOCAL VARIABLES +!EOP +! + integer :: fp,fl,p,c,l,g ! indices + integer :: local_secp1 ! seconds into current date in local time + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day ! temporaries (not used) + integer :: secs ! seconds into current date + + real(r8), parameter :: mpe = 1.e-06_r8 ! prevents overflow for division by zero + real(r8), parameter :: snoem = 0.97_r8 ! snow emissivity (should use value from Biogeophysics1) + + real(r8) :: lwnet_roof(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit ground area), roof (W/m**2) + real(r8) :: lwnet_improad(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit ground area), impervious road (W/m**2) + real(r8) :: lwnet_perroad(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit ground area), pervious road (W/m**2) + real(r8) :: lwnet_sunwall(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit wall area), sunlit wall (W/m**2) + real(r8) :: lwnet_shadewall(num_urbanl)! net (outgoing-incoming) longwave radiation (per unit wall area), shaded wall (W/m**2) + real(r8) :: lwnet_canyon(num_urbanl) ! net (outgoing-incoming) longwave radiation for canyon, per unit ground area (W/m**2) + real(r8) :: lwup_roof(num_urbanl) ! upward longwave radiation (per unit ground area), roof (W/m**2) + real(r8) :: lwup_improad(num_urbanl) ! upward longwave radiation (per unit ground area), impervious road (W/m**2) + real(r8) :: lwup_perroad(num_urbanl) ! upward longwave radiation (per unit ground area), pervious road (W/m**2) + real(r8) :: lwup_sunwall(num_urbanl) ! upward longwave radiation, (per unit wall area), sunlit wall (W/m**2) + real(r8) :: lwup_shadewall(num_urbanl) ! upward longwave radiation, (per unit wall area), shaded wall (W/m**2) + real(r8) :: lwup_canyon(num_urbanl) ! upward longwave radiation for canyon, per unit ground area (W/m**2) + real(r8) :: t_roof(num_urbanl) ! roof temperature (K) + real(r8) :: t_improad(num_urbanl) ! imppervious road temperature (K) + real(r8) :: t_perroad(num_urbanl) ! pervious road temperature (K) + real(r8) :: t_sunwall(num_urbanl) ! sunlit wall temperature (K) + real(r8) :: t_shadewall(num_urbanl) ! shaded wall temperature (K) + real(r8) :: lwdown(num_urbanl) ! atmospheric downward longwave radiation (W/m**2) + real(r8) :: em_roof_s(num_urbanl) ! roof emissivity with snow effects + real(r8) :: em_improad_s(num_urbanl) ! impervious road emissivity with snow effects + real(r8) :: em_perroad_s(num_urbanl) ! pervious road emissivity with snow effects +!----------------------------------------------------------------------- + + ! Assign pointers into module urban clumps + + if( num_urbanl > 0 )then + canyon_hwr => urban_clump(nc)%canyon_hwr + wtroad_perv => urban_clump(nc)%wtroad_perv + em_roof => urban_clump(nc)%em_roof + em_improad => urban_clump(nc)%em_improad + em_perroad => urban_clump(nc)%em_perroad + em_wall => urban_clump(nc)%em_wall + end if + + ! Assign local pointers to multi-level derived type members (gridcell level) + + londeg => grc%londeg + forc_solad => clm_a2l%forc_solad + forc_solai => clm_a2l%forc_solai + forc_solar => clm_a2l%forc_solar + forc_lwrad => clm_a2l%forc_lwrad + + ! Assign local pointers to derived type members (landunit level) + + pfti => lun%pfti + pftf => lun%pftf + coli => lun%coli + colf => lun%colf + lgridcell => lun%gridcell + vf_sr => lps%vf_sr + vf_wr => lps%vf_wr + vf_sw => lps%vf_sw + vf_rw => lps%vf_rw + vf_ww => lps%vf_ww + sabs_roof_dir => lps%sabs_roof_dir + sabs_roof_dif => lps%sabs_roof_dif + sabs_sunwall_dir => lps%sabs_sunwall_dir + sabs_sunwall_dif => lps%sabs_sunwall_dif + sabs_shadewall_dir => lps%sabs_shadewall_dir + sabs_shadewall_dif => lps%sabs_shadewall_dif + sabs_improad_dir => lps%sabs_improad_dir + sabs_improad_dif => lps%sabs_improad_dif + sabs_perroad_dir => lps%sabs_perroad_dir + sabs_perroad_dif => lps%sabs_perroad_dif + + ! Assign local pointers to derived type members (column level) + + ctype => col%itype + t_grnd => ces%t_grnd + frac_sno => cps%frac_sno + + ! Assign local pointers to derived type members (pft level) + + pgridcell => pft%gridcell + pcolumn => pft%column + albd => pps%albd + albi => pps%albi + sabg => pef%sabg + sabv => pef%sabv + fsa => pef%fsa + fsa_u => pef%fsa_u + fsr => pef%fsr + fsds_vis_d => pef%fsds_vis_d + fsds_nir_d => pef%fsds_nir_d + fsds_vis_i => pef%fsds_vis_i + fsds_nir_i => pef%fsds_nir_i + fsr_vis_d => pef%fsr_vis_d + fsr_nir_d => pef%fsr_nir_d + fsr_vis_i => pef%fsr_vis_i + fsr_nir_i => pef%fsr_nir_i + fsds_vis_d_ln => pef%fsds_vis_d_ln + fsds_nir_d_ln => pef%fsds_nir_d_ln + fsr_vis_d_ln => pef%fsr_vis_d_ln + fsr_nir_d_ln => pef%fsr_nir_d_ln + eflx_lwrad_out => pef%eflx_lwrad_out + eflx_lwrad_net => pef%eflx_lwrad_net + eflx_lwrad_net_u => pef%eflx_lwrad_net_u + parsun => pef%parsun + parsha => pef%parsha + t_ref2m => pes%t_ref2m + + ! Define fields that appear on the restart file for non-urban landunits + + do fl = 1,num_nourbanl + l = filter_nourbanl(fl) + sabs_roof_dir(l,:) = spval + sabs_roof_dif(l,:) = spval + sabs_sunwall_dir(l,:) = spval + sabs_sunwall_dif(l,:) = spval + sabs_shadewall_dir(l,:) = spval + sabs_shadewall_dif(l,:) = spval + sabs_improad_dir(l,:) = spval + sabs_improad_dif(l,:) = spval + sabs_perroad_dir(l,:) = spval + sabs_perroad_dif(l,:) = spval + vf_sr(l) = spval + vf_wr(l) = spval + vf_sw(l) = spval + vf_rw(l) = spval + vf_ww(l) = spval + end do + + ! Set input forcing fields + do fl = 1,num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + ! Need to set the following temperatures to some defined value even if it + ! does not appear in the urban landunit for the net_longwave computation + + t_roof(fl) = 19._r8 + tfrz + t_sunwall(fl) = 19._r8 + tfrz + t_shadewall(fl) = 19._r8 + tfrz + t_improad(fl) = 19._r8 + tfrz + t_perroad(fl) = 19._r8 + tfrz + + ! Initial assignment of emissivity + em_roof_s(fl) = em_roof(fl) + em_improad_s(fl) = em_improad(fl) + em_perroad_s(fl) = em_perroad(fl) + + ! Set urban temperatures and emissivity including snow effects. + do c = coli(l),colf(l) + if (ctype(c) == icol_roof ) then + t_roof(fl) = t_grnd(c) + em_roof_s(fl) = em_roof(fl)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_road_imperv) then + t_improad(fl) = t_grnd(c) + em_improad_s(fl) = em_improad(fl)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_road_perv ) then + t_perroad(fl) = t_grnd(c) + em_perroad_s(fl) = em_perroad(fl)*(1._r8-frac_sno(c)) + snoem*frac_sno(c) + else if (ctype(c) == icol_sunwall ) then + t_sunwall(fl) = t_grnd(c) + else if (ctype(c) == icol_shadewall ) then + t_shadewall(fl) = t_grnd(c) + end if + end do + lwdown(fl) = forc_lwrad(g) + end do + + ! Net longwave radiation for road and both walls in urban canyon allowing for multiple re-emission + + if (num_urbanl .gt. 0) then + call net_longwave (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr, wtroad_perv, & + lwdown, em_roof_s, em_improad_s, em_perroad_s, em_wall, & + t_roof, t_improad, t_perroad, t_sunwall, t_shadewall, & + lwnet_roof, lwnet_improad, lwnet_perroad, lwnet_sunwall, lwnet_shadewall, lwnet_canyon, & + lwup_roof, lwup_improad, lwup_perroad, lwup_sunwall, lwup_shadewall, lwup_canyon) + end if + + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Determine clmtype variables needed for history output and communication with atm + ! Loop over urban pfts in clump + + do fp = 1,num_urbanp + p = filter_urbanp(fp) + g = pgridcell(p) + + local_secp1 = secs + nint((londeg(g)/degpsec)/dtime)*dtime + local_secp1 = mod(local_secp1,isecspday) + + ! Solar incident + + fsds_vis_d(p) = forc_solad(g,1) + fsds_nir_d(p) = forc_solad(g,2) + fsds_vis_i(p) = forc_solai(g,1) + fsds_nir_i(p) = forc_solai(g,2) + ! Determine local noon incident solar + if (local_secp1 == noonsec) then + fsds_vis_d_ln(p) = forc_solad(g,1) + fsds_nir_d_ln(p) = forc_solad(g,2) + else + fsds_vis_d_ln(p) = spval + fsds_nir_d_ln(p) = spval + endif + + ! Solar reflected + ! per unit ground area (roof, road) and per unit wall area (sunwall, shadewall) + + fsr_vis_d(p) = albd(p,1) * forc_solad(g,1) + fsr_nir_d(p) = albd(p,2) * forc_solad(g,2) + fsr_vis_i(p) = albi(p,1) * forc_solai(g,1) + fsr_nir_i(p) = albi(p,2) * forc_solai(g,2) + + ! Determine local noon reflected solar + if (local_secp1 == noonsec) then + fsr_vis_d_ln(p) = fsr_vis_d(p) + fsr_nir_d_ln(p) = fsr_nir_d(p) + else + fsr_vis_d_ln(p) = spval + fsr_nir_d_ln(p) = spval + endif + fsr(p) = fsr_vis_d(p) + fsr_nir_d(p) + fsr_vis_i(p) + fsr_nir_i(p) + + end do + + ! Loop over urban landunits in clump + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + ! Solar absorbed and longwave out and net + ! per unit ground area (roof, road) and per unit wall area (sunwall, shadewall) + ! Each urban pft has its own column - this is used in the logic below + + do p = pfti(l), pftf(l) + c = pcolumn(p) + if (ctype(c) == icol_roof) then + eflx_lwrad_out(p) = lwup_roof(fl) + eflx_lwrad_net(p) = lwnet_roof(fl) + eflx_lwrad_net_u(p) = lwnet_roof(fl) + sabg(p) = sabs_roof_dir(l,1)*forc_solad(g,1) + & + sabs_roof_dif(l,1)*forc_solai(g,1) + & + sabs_roof_dir(l,2)*forc_solad(g,2) + & + sabs_roof_dif(l,2)*forc_solai(g,2) + else if (ctype(c) == icol_sunwall) then + eflx_lwrad_out(p) = lwup_sunwall(fl) + eflx_lwrad_net(p) = lwnet_sunwall(fl) + eflx_lwrad_net_u(p) = lwnet_sunwall(fl) + sabg(p) = sabs_sunwall_dir(l,1)*forc_solad(g,1) + & + sabs_sunwall_dif(l,1)*forc_solai(g,1) + & + sabs_sunwall_dir(l,2)*forc_solad(g,2) + & + sabs_sunwall_dif(l,2)*forc_solai(g,2) + else if (ctype(c) == icol_shadewall) then + eflx_lwrad_out(p) = lwup_shadewall(fl) + eflx_lwrad_net(p) = lwnet_shadewall(fl) + eflx_lwrad_net_u(p) = lwnet_shadewall(fl) + sabg(p) = sabs_shadewall_dir(l,1)*forc_solad(g,1) + & + sabs_shadewall_dif(l,1)*forc_solai(g,1) + & + sabs_shadewall_dir(l,2)*forc_solad(g,2) + & + sabs_shadewall_dif(l,2)*forc_solai(g,2) + else if (ctype(c) == icol_road_perv) then + eflx_lwrad_out(p) = lwup_perroad(fl) + eflx_lwrad_net(p) = lwnet_perroad(fl) + eflx_lwrad_net_u(p) = lwnet_perroad(fl) + sabg(p) = sabs_perroad_dir(l,1)*forc_solad(g,1) + & + sabs_perroad_dif(l,1)*forc_solai(g,1) + & + sabs_perroad_dir(l,2)*forc_solad(g,2) + & + sabs_perroad_dif(l,2)*forc_solai(g,2) + else if (ctype(c) == icol_road_imperv) then + eflx_lwrad_out(p) = lwup_improad(fl) + eflx_lwrad_net(p) = lwnet_improad(fl) + eflx_lwrad_net_u(p) = lwnet_improad(fl) + sabg(p) = sabs_improad_dir(l,1)*forc_solad(g,1) + & + sabs_improad_dif(l,1)*forc_solai(g,1) + & + sabs_improad_dir(l,2)*forc_solad(g,2) + & + sabs_improad_dif(l,2)*forc_solai(g,2) + end if + sabv(p) = 0._r8 + fsa(p) = sabv(p) + sabg(p) + fsa_u(p) = fsa(p) + parsun(p) = 0._r8 + parsha(p) = 0._r8 + + end do ! end loop over urban pfts + + end do ! end loop over urban landunits + + end subroutine UrbanRadiation + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: view_factor +! +! !INTERFACE: + subroutine view_factor (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr) + +! +! !DESCRIPTION: +! View factors for road and one wall +! WALL | +! ROAD | +! wall | +! -----\ /----- - - |\----------/ +! | \ vsr / | | r | | \ vww / s +! | \ / | h o w | \ / k +! wall | \ / | wall | a | | \ / y +! |vwr \ / vwr| | d | |vrw \ / vsw +! ------\/------ - - |-----\/----- +! road wall | +! <----- w ----> | +! <---- h --->| +! +! vsr = view factor of sky for road vrw = view factor of road for wall +! vwr = view factor of one wall for road vww = view factor of opposing wall for wall +! vsw = view factor of sky for wall +! vsr + vwr + vwr = 1 vrw + vww + vsw = 1 +! +! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in +! atmospheric models. Boundary-Layer Meteorology 94:357-397 +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + real(r8), intent(in) :: canyon_hwr(num_urbanl) ! ratio of building height to street width +! +! local pointers to original implicit out arguments (clmtype) +! + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall +! +! !CALLED FROM: +! subroutine UrbanAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! 03/2003, Mariana Vertenstein: Migrated to clm2.2 +! 01/2008, Erik Kluzek: Migrated to clm3.5.15 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: l, fl ! indices + real(r8) :: sum ! sum of view factors for wall or road +!----------------------------------------------------------------------- + + ! Assign landunit level pointer + + vf_sr => lps%vf_sr + vf_wr => lps%vf_wr + vf_sw => lps%vf_sw + vf_rw => lps%vf_rw + vf_ww => lps%vf_ww + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + ! road -- sky view factor -> 1 as building height -> 0 + ! and -> 0 as building height -> infinity + + vf_sr(l) = sqrt(canyon_hwr(fl)**2 + 1._r8) - canyon_hwr(fl) + vf_wr(l) = 0.5_r8 * (1._r8 - vf_sr(l)) + + ! one wall -- sky view factor -> 0.5 as building height -> 0 + ! and -> 0 as building height -> infinity + + vf_sw(l) = 0.5_r8 * (canyon_hwr(fl) + 1._r8 - sqrt(canyon_hwr(fl)**2+1._r8)) / canyon_hwr(fl) + vf_rw(l) = vf_sw(l) + vf_ww(l) = 1._r8 - vf_sw(l) - vf_rw(l) + + end do + + + ! error check -- make sure view factor sums to one for road and wall + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + sum = vf_sr(l) + 2._r8*vf_wr(l) + if (abs(sum-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban road view factor error',sum + write (iulog,*) 'clm model is stopping' + call endrun() + endif + sum = vf_sw(l) + vf_rw(l) + vf_ww(l) + if (abs(sum-1._r8) > 1.e-06_r8 ) then + write (iulog,*) 'urban wall view factor error',sum + write (iulog,*) 'clm model is stopping' + call endrun() + endif + + end do + + end subroutine view_factor + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: incident_direct +! +! !INTERFACE: + subroutine incident_direct (lbl, ubl, num_urbanl, canyon_hwr, coszen, zen, sdir, sdir_road, sdir_sunwall, sdir_shadewall) +! +! !DESCRIPTION: +! Direct beam solar radiation incident on walls and road in urban canyon +! +! Sun +! / +! roof / +! ------ /--- - +! | / | | +! sunlit wall | / | shaded wall h +! | / | | +! -----/----- - +! road +! <--- w ---> +! +! Method: +! Road = Horizontal surface. Account for shading by wall. Integrate over all canyon orientations +! Wall (sunlit) = Adjust horizontal radiation for 90 degree surface. Account for shading by opposing wall. +! Integrate over all canyon orientations +! Wall (shaded) = 0 +! +! Conservation check: Total incoming direct beam (sdir) = sdir_road + (sdir_shadewall + sdir_sunwall)*canyon_hwr +! Multiplication by canyon_hwr scales wall fluxes (per unit wall area) to per unit ground area +! +! Source: Masson, V. (2000) A physically-based scheme for the urban energy budget in +! atmospheric models. Boundary-Layer Meteorology 94:357-397 +! +! This analytical solution from Masson (2000) agrees with the numerical solution to +! within 0.6 W/m**2 for sdir = 1000 W/m**2 and for all H/W from 0.1 to 10 by 0.1 +! and all solar zenith angles from 1 to 90 deg by 1 +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varcon , only : rpi + implicit none +! +! !ARGUMENTS: + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + real(r8), intent(in) :: canyon_hwr(num_urbanl) ! ratio of building height to street width + real(r8), intent(in) :: coszen(num_urbanl) ! cosine solar zenith angle + real(r8), intent(in) :: zen(num_urbanl) ! solar zenith angle (radians) + real(r8), intent(in) :: sdir(num_urbanl, numrad) ! direct beam solar radiation incident on horizontal surface + real(r8), intent(out) :: sdir_road(num_urbanl, numrad) ! direct beam solar radiation incident on road per unit incident flux + real(r8), intent(out) :: sdir_sunwall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8), intent(out) :: sdir_shadewall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux +! +! !CALLED FROM: +! subroutine UrbanAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + integer :: l,i,ib ! indices +!KO logical :: numchk = .true. ! true => perform numerical check of analytical solution + logical :: numchk = .false. ! true => perform numerical check of analytical solution + real(r8) :: theta0(num_urbanl) ! critical canyon orientation for which road is no longer illuminated + real(r8) :: tanzen(num_urbanl) ! tan(zenith angle) + real(r8) :: swall_projected ! direct beam solar radiation (per unit ground area) incident on wall + real(r8) :: err1(num_urbanl) ! energy conservation error + real(r8) :: err2(num_urbanl) ! energy conservation error + real(r8) :: err3(num_urbanl) ! energy conservation error + real(r8) :: sumr ! sum of sroad for each orientation (0 <= theta <= pi/2) + real(r8) :: sumw ! sum of swall for each orientation (0 <= theta <= pi/2) + real(r8) :: num ! number of orientations + real(r8) :: theta ! canyon orientation relative to sun (0 <= theta <= pi/2) + real(r8) :: zen0 ! critical solar zenith angle for which sun begins to illuminate road +!----------------------------------------------------------------------- + + do l = 1,num_urbanl + if (coszen(l) > 0._r8) then + theta0(l) = asin(min( (1._r8/(canyon_hwr(l)*tan(max(zen(l),0.000001_r8)))), 1._r8 )) + tanzen(l) = tan(zen(l)) + end if + end do + + do ib = 1,numrad + + do l = 1,num_urbanl + if (coszen(l) > 0._r8) then + sdir_shadewall(l,ib) = 0._r8 + + ! incident solar radiation on wall and road integrated over all canyon orientations (0 <= theta <= pi/2) + + sdir_road(l,ib) = sdir(l,ib) * & + (2._r8*theta0(l)/rpi - 2./rpi*canyon_hwr(l)*tanzen(l)*(1._r8-cos(theta0(l)))) + sdir_sunwall(l,ib) = 2._r8 * sdir(l,ib) * ((1._r8/canyon_hwr(l))* & + (0.5_r8-theta0(l)/rpi) + (1._r8/rpi)*tanzen(l)*(1._r8-cos(theta0(l)))) + + ! conservation check for road and wall. need to use wall fluxes converted to ground area + + swall_projected = (sdir_shadewall(l,ib) + sdir_sunwall(l,ib)) * canyon_hwr(l) + err1(l) = sdir(l,ib) - (sdir_road(l,ib) + swall_projected) + else + sdir_road(l,ib) = 0._r8 + sdir_sunwall(l,ib) = 0._r8 + sdir_shadewall(l,ib) = 0._r8 + endif + end do + + do l = 1,num_urbanl + if (coszen(l) > 0._r8) then + if (abs(err1(l)) > 0.001_r8) then + write (iulog,*) 'urban direct beam solar radiation balance error',err1(l) + write (iulog,*) 'clm model is stopping' + call endrun() + endif + endif + end do + + ! numerical check of analytical solution + ! sum sroad and swall over all canyon orientations (0 <= theta <= pi/2) + + if (numchk) then + do l = 1,num_urbanl + if (coszen(l) > 0._r8) then + sumr = 0._r8 + sumw = 0._r8 + num = 0._r8 + do i = 1, 9000 + theta = i/100._r8 * rpi/180._r8 + zen0 = atan(1._r8/(canyon_hwr(l)*sin(theta))) + if (zen(l) >= zen0) then + sumr = sumr + 0._r8 + sumw = sumw + sdir(l,ib) / canyon_hwr(l) + else + sumr = sumr + sdir(l,ib) * (1._r8-canyon_hwr(l)*sin(theta)*tanzen(l)) + sumw = sumw + sdir(l,ib) * sin(theta)*tanzen(l) + end if + num = num + 1._r8 + end do + err2(l) = sumr/num - sdir_road(l,ib) + err3(l) = sumw/num - sdir_sunwall(l,ib) + endif + end do + do l = 1,num_urbanl + if (coszen(l) > 0._r8) then + if (abs(err2(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban road incident direct beam solar radiation error',err2(l) + write (iulog,*) 'clm model is stopping' + call endrun + endif + if (abs(err3(l)) > 0.0006_r8 ) then + write (iulog,*) 'urban wall incident direct beam solar radiation error',err3(l) + write (iulog,*) 'clm model is stopping' + call endrun + end if + end if + end do + end if + + end do + + end subroutine incident_direct + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: incident_diffuse +! +! !INTERFACE: + subroutine incident_diffuse (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr, sdif, sdif_road, sdif_sunwall, sdif_shadewall) +! +! !DESCRIPTION: +! Diffuse solar radiation incident on walls and road in urban canyon +! Conservation check: Total incoming diffuse +! (sdif) = sdif_road + (sdif_shadewall + sdif_sunwall)*canyon_hwr +! Multiplication by canyon_hwr scales wall fluxes (per unit wall area) to per unit ground area +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype +! +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + real(r8), intent(in) :: canyon_hwr(num_urbanl) ! ratio of building height to street width + real(r8), intent(in) :: sdif(num_urbanl, numrad) ! diffuse solar radiation incident on horizontal surface + real(r8), intent(out) :: sdif_road(num_urbanl, numrad) ! diffuse solar radiation incident on road + real(r8), intent(out) :: sdif_sunwall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on sunlit wall + real(r8), intent(out) :: sdif_shadewall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on shaded wall +! +! local pointers to original implicit in arguments (clmtype) +! + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall +! +! !CALLED FROM: +! subroutine UrbanAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + integer :: l, fl, ib ! indices + real(r8) :: err(num_urbanl) ! energy conservation error (W/m**2) + real(r8) :: swall_projected ! diffuse solar radiation (per unit ground area) incident on wall (W/m**2) +!----------------------------------------------------------------------- + + ! Assign landunit level pointer + + vf_sr => lps%vf_sr + vf_sw => lps%vf_sw + + do ib = 1, numrad + + ! diffuse solar and conservation check. need to convert wall fluxes to ground area + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + sdif_road(fl,ib) = sdif(fl,ib) * vf_sr(l) + sdif_sunwall(fl,ib) = sdif(fl,ib) * vf_sw(l) + sdif_shadewall(fl,ib) = sdif(fl,ib) * vf_sw(l) + + swall_projected = (sdif_shadewall(fl,ib) + sdif_sunwall(fl,ib)) * canyon_hwr(fl) + err(fl) = sdif(fl,ib) - (sdif_road(fl,ib) + swall_projected) + end do + + ! error check + + do l = 1, num_urbanl + if (abs(err(l)) > 0.001_r8) then + write (iulog,*) 'urban diffuse solar radiation balance error',err(l) + write (iulog,*) 'clm model is stopping' + call endrun + endif + end do + + end do + + end subroutine incident_diffuse + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: net_solar +! +! !INTERFACE: + subroutine net_solar (lbl, ubl, num_urbanl, filter_urbanl, coszen, canyon_hwr, wtroad_perv, sdir, sdif, & + alb_improad_dir, alb_perroad_dir, alb_wall_dir, alb_roof_dir, & + alb_improad_dif, alb_perroad_dif, alb_wall_dif, alb_roof_dif, & + sdir_road, sdir_sunwall, sdir_shadewall, & + sdif_road, sdif_sunwall, sdif_shadewall, & + sref_improad_dir, sref_perroad_dir, sref_sunwall_dir, sref_shadewall_dir, sref_roof_dir, & + sref_improad_dif, sref_perroad_dif, sref_sunwall_dif, sref_shadewall_dif, sref_roof_dif) +! +! !DESCRIPTION: +! Solar radiation absorbed by road and both walls in urban canyon allowing +! for multiple reflection. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype +! +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: num_urbanl ! number of urban landunits + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + real(r8), intent(in) :: coszen(num_urbanl) ! cosine solar zenith angle + real(r8), intent(in) :: canyon_hwr(num_urbanl) ! ratio of building height to street width + real(r8), intent(in) :: wtroad_perv(num_urbanl) ! weight of pervious road wrt total road + real(r8), intent(in) :: sdir(num_urbanl, numrad) ! direct beam solar radiation incident on horizontal surface + real(r8), intent(in) :: sdif(num_urbanl, numrad) ! diffuse solar radiation on horizontal surface + real(r8), intent(in) :: alb_improad_dir(num_urbanl, numrad) ! direct impervious road albedo + real(r8), intent(in) :: alb_perroad_dir(num_urbanl, numrad) ! direct pervious road albedo + real(r8), intent(in) :: alb_wall_dir(num_urbanl, numrad) ! direct wall albedo + real(r8), intent(in) :: alb_roof_dir(num_urbanl, numrad) ! direct roof albedo + real(r8), intent(in) :: alb_improad_dif(num_urbanl, numrad) ! diffuse impervious road albedo + real(r8), intent(in) :: alb_perroad_dif(num_urbanl, numrad) ! diffuse pervious road albedo + real(r8), intent(in) :: alb_wall_dif(num_urbanl, numrad) ! diffuse wall albedo + real(r8), intent(in) :: alb_roof_dif(num_urbanl, numrad) ! diffuse roof albedo + real(r8), intent(in) :: sdir_road(num_urbanl, numrad) ! direct beam solar radiation incident on road per unit incident flux + real(r8), intent(in) :: sdir_sunwall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8), intent(in) :: sdir_shadewall(num_urbanl, numrad) ! direct beam solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8), intent(in) :: sdif_road(num_urbanl, numrad) ! diffuse solar radiation incident on road per unit incident flux + real(r8), intent(in) :: sdif_sunwall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on sunlit wall per unit incident flux + real(r8), intent(in) :: sdif_shadewall(num_urbanl, numrad) ! diffuse solar radiation (per unit wall area) incident on shaded wall per unit incident flux + real(r8), intent(inout) :: sref_improad_dir(num_urbanl, numrad) ! direct solar rad reflected by impervious road (per unit ground area) per unit incident flux + real(r8), intent(inout) :: sref_perroad_dir(num_urbanl, numrad) ! direct solar rad reflected by pervious road (per unit ground area) per unit incident flux + real(r8), intent(inout) :: sref_improad_dif(num_urbanl, numrad) ! diffuse solar rad reflected by impervious road (per unit ground area) per unit incident flux + real(r8), intent(inout) :: sref_perroad_dif(num_urbanl, numrad) ! diffuse solar rad reflected by pervious road (per unit ground area) per unit incident flux + real(r8), intent(inout) :: sref_sunwall_dir(num_urbanl, numrad) ! direct solar rad reflected by sunwall (per unit wall area) per unit incident flux + real(r8), intent(inout) :: sref_sunwall_dif(num_urbanl, numrad) ! diffuse solar rad reflected by sunwall (per unit wall area) per unit incident flux + real(r8), intent(inout) :: sref_shadewall_dir(num_urbanl, numrad) ! direct solar rad reflected by shadewall (per unit wall area) per unit incident flux + real(r8), intent(inout) :: sref_shadewall_dif(num_urbanl, numrad) ! diffuse solar rad reflected by shadewall (per unit wall area) per unit incident flux + real(r8), intent(inout) :: sref_roof_dir(num_urbanl, numrad) ! direct solar rad reflected by roof (per unit ground area) per unit incident flux + real(r8), intent(inout) :: sref_roof_dif(num_urbanl, numrad) ! diffuse solar rad reflected by roof (per unit ground area) per unit incident flux +! +! local pointers to original implicit in arguments (clmtype) +! + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall + real(r8), pointer :: sabs_roof_dir(:,:) ! direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif(:,:) ! diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir(:,:) ! direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif(:,:) ! diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir(:,:) ! direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif(:,:) ! diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir(:,:) ! direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif(:,:) ! diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir(:,:) ! direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif(:,:) ! diffuse solar absorbed by pervious road per unit ground area per unit incident flux +! +! !CALLED FROM: +! subroutine UrbanAlbedo in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES +!EOP +! + real(r8) :: wtroad_imperv(num_urbanl) ! weight of impervious road wrt total road + real(r8) :: sabs_canyon_dir(num_urbanl) ! direct solar rad absorbed by canyon per unit incident flux + real(r8) :: sabs_canyon_dif(num_urbanl) ! diffuse solar rad absorbed by canyon per unit incident flux + real(r8) :: sref_canyon_dir(num_urbanl) ! direct solar reflected by canyon per unit incident flux + real(r8) :: sref_canyon_dif(num_urbanl) ! diffuse solar reflected by canyon per unit incident flux + + real(r8) :: improad_a_dir(num_urbanl) ! absorbed direct solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_a_dif(num_urbanl) ! absorbed diffuse solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_dir(num_urbanl) ! reflected direct solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_dif(num_urbanl) ! reflected diffuse solar for impervious road after "n" reflections per unit incident flux + real(r8) :: improad_r_sky_dir(num_urbanl) ! improad_r_dir to sky per unit incident flux + real(r8) :: improad_r_sunwall_dir(num_urbanl) ! improad_r_dir to sunlit wall per unit incident flux + real(r8) :: improad_r_shadewall_dir(num_urbanl) ! improad_r_dir to shaded wall per unit incident flux + real(r8) :: improad_r_sky_dif(num_urbanl) ! improad_r_dif to sky per unit incident flux + real(r8) :: improad_r_sunwall_dif(num_urbanl) ! improad_r_dif to sunlit wall per unit incident flux + real(r8) :: improad_r_shadewall_dif(num_urbanl) ! improad_r_dif to shaded wall per unit incident flux + + real(r8) :: perroad_a_dir(num_urbanl) ! absorbed direct solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_a_dif(num_urbanl) ! absorbed diffuse solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_dir(num_urbanl) ! reflected direct solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_dif(num_urbanl) ! reflected diffuse solar for pervious road after "n" reflections per unit incident flux + real(r8) :: perroad_r_sky_dir(num_urbanl) ! perroad_r_dir to sky per unit incident flux + real(r8) :: perroad_r_sunwall_dir(num_urbanl) ! perroad_r_dir to sunlit wall per unit incident flux + real(r8) :: perroad_r_shadewall_dir(num_urbanl) ! perroad_r_dir to shaded wall per unit incident flux + real(r8) :: perroad_r_sky_dif(num_urbanl) ! perroad_r_dif to sky per unit incident flux + real(r8) :: perroad_r_sunwall_dif(num_urbanl) ! perroad_r_dif to sunlit wall per unit incident flux + real(r8) :: perroad_r_shadewall_dif(num_urbanl) ! perroad_r_dif to shaded wall per unit incident flux + + real(r8) :: road_a_dir(num_urbanl) ! absorbed direct solar for total road after "n" reflections per unit incident flux + real(r8) :: road_a_dif(num_urbanl) ! absorbed diffuse solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_dir(num_urbanl) ! reflected direct solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_dif(num_urbanl) ! reflected diffuse solar for total road after "n" reflections per unit incident flux + real(r8) :: road_r_sky_dir(num_urbanl) ! road_r_dir to sky per unit incident flux + real(r8) :: road_r_sunwall_dir(num_urbanl) ! road_r_dir to sunlit wall per unit incident flux + real(r8) :: road_r_shadewall_dir(num_urbanl) ! road_r_dir to shaded wall per unit incident flux + real(r8) :: road_r_sky_dif(num_urbanl) ! road_r_dif to sky per unit incident flux + real(r8) :: road_r_sunwall_dif(num_urbanl) ! road_r_dif to sunlit wall per unit incident flux + real(r8) :: road_r_shadewall_dif(num_urbanl) ! road_r_dif to shaded wall per unit incident flux + + real(r8) :: sunwall_a_dir(num_urbanl) ! absorbed direct solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_a_dif(num_urbanl) ! absorbed diffuse solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_dir(num_urbanl) ! reflected direct solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_dif(num_urbanl) ! reflected diffuse solar for sunlit wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: sunwall_r_sky_dir(num_urbanl) ! sunwall_r_dir to sky per unit incident flux + real(r8) :: sunwall_r_road_dir(num_urbanl) ! sunwall_r_dir to road per unit incident flux + real(r8) :: sunwall_r_shadewall_dir(num_urbanl) ! sunwall_r_dir to opposing (shaded) wall per unit incident flux + real(r8) :: sunwall_r_sky_dif(num_urbanl) ! sunwall_r_dif to sky per unit incident flux + real(r8) :: sunwall_r_road_dif(num_urbanl) ! sunwall_r_dif to road per unit incident flux + real(r8) :: sunwall_r_shadewall_dif(num_urbanl) ! sunwall_r_dif to opposing (shaded) wall per unit incident flux + + real(r8) :: shadewall_a_dir(num_urbanl) ! absorbed direct solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_a_dif(num_urbanl) ! absorbed diffuse solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_dir(num_urbanl) ! reflected direct solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_dif(num_urbanl) ! reflected diffuse solar for shaded wall (per unit wall area) after "n" reflections per unit incident flux + real(r8) :: shadewall_r_sky_dir(num_urbanl) ! shadewall_r_dir to sky per unit incident flux + real(r8) :: shadewall_r_road_dir(num_urbanl) ! shadewall_r_dir to road per unit incident flux + real(r8) :: shadewall_r_sunwall_dir(num_urbanl) ! shadewall_r_dir to opposing (sunlit) wall per unit incident flux + real(r8) :: shadewall_r_sky_dif(num_urbanl) ! shadewall_r_dif to sky per unit incident flux + real(r8) :: shadewall_r_road_dif(num_urbanl) ! shadewall_r_dif to road per unit incident flux + real(r8) :: shadewall_r_sunwall_dif(num_urbanl) ! shadewall_r_dif to opposing (sunlit) wall per unit incident flux + + real(r8) :: canyon_alb_dir(num_urbanl) ! direct canyon albedo + real(r8) :: canyon_alb_dif(num_urbanl) ! diffuse canyon albedo + + real(r8) :: stot(num_urbanl) ! sum of radiative terms + real(r8) :: stot_dir(num_urbanl) ! sum of direct radiative terms + real(r8) :: stot_dif(num_urbanl) ! sum of diffuse radiative terms + + integer :: l,fl,ib ! indices + integer :: iter_dir,iter_dif ! iteration counter + real(r8) :: crit ! convergence criterion + real(r8) :: err ! energy conservation error + integer :: pass + integer, parameter :: n = 50 ! number of interations + real(r8) :: sabs_road ! temporary for absorption over road + real(r8) :: sref_road ! temporary for reflected over road + real(r8), parameter :: errcrit = .00001_r8 ! error criteria +!----------------------------------------------------------------------- + + ! Assign landunit level pointer + + vf_sr => lps%vf_sr + vf_wr => lps%vf_wr + vf_sw => lps%vf_sw + vf_rw => lps%vf_rw + vf_ww => lps%vf_ww + sabs_roof_dir => lps%sabs_roof_dir + sabs_roof_dif => lps%sabs_roof_dif + sabs_sunwall_dir => lps%sabs_sunwall_dir + sabs_sunwall_dif => lps%sabs_sunwall_dif + sabs_shadewall_dir => lps%sabs_shadewall_dir + sabs_shadewall_dif => lps%sabs_shadewall_dif + sabs_improad_dir => lps%sabs_improad_dir + sabs_improad_dif => lps%sabs_improad_dif + sabs_perroad_dir => lps%sabs_perroad_dir + sabs_perroad_dif => lps%sabs_perroad_dif + + ! Calculate impervious road + + do l = 1,num_urbanl + wtroad_imperv(l) = 1._r8 - wtroad_perv(l) + end do + + do ib = 1,numrad + do fl = 1,num_urbanl + if (coszen(fl) .gt. 0._r8) then + l = filter_urbanl(fl) + + ! initial absorption and reflection for road and both walls. + ! distribute reflected radiation to sky, road, and walls + ! according to appropriate view factor. radiation reflected to + ! road and walls will undergo multiple reflections within the canyon. + ! do separately for direct beam and diffuse radiation. + + ! direct beam + + road_a_dir(fl) = 0.0_r8 + road_r_dir(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_a_dir(fl) = (1._r8-alb_improad_dir(fl,ib)) * sdir_road(fl,ib) + improad_r_dir(fl) = alb_improad_dir(fl,ib) * sdir_road(fl,ib) + improad_r_sky_dir(fl) = improad_r_dir(fl) * vf_sr(l) + improad_r_sunwall_dir(fl) = improad_r_dir(fl) * vf_wr(l) + improad_r_shadewall_dir(fl) = improad_r_dir(fl) * vf_wr(l) + road_a_dir(fl) = road_a_dir(fl) + improad_a_dir(fl)*wtroad_imperv(fl) + road_r_dir(fl) = road_r_dir(fl) + improad_r_dir(fl)*wtroad_imperv(fl) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_a_dir(fl) = (1._r8-alb_perroad_dir(fl,ib)) * sdir_road(fl,ib) + perroad_r_dir(fl) = alb_perroad_dir(fl,ib) * sdir_road(fl,ib) + perroad_r_sky_dir(fl) = perroad_r_dir(fl) * vf_sr(l) + perroad_r_sunwall_dir(fl) = perroad_r_dir(fl) * vf_wr(l) + perroad_r_shadewall_dir(fl) = perroad_r_dir(fl) * vf_wr(l) + road_a_dir(fl) = road_a_dir(fl) + perroad_a_dir(fl)*wtroad_perv(fl) + road_r_dir(fl) = road_r_dir(fl) + perroad_r_dir(fl)*wtroad_perv(fl) + end if + + road_r_sky_dir(fl) = road_r_dir(fl) * vf_sr(l) + road_r_sunwall_dir(fl) = road_r_dir(fl) * vf_wr(l) + road_r_shadewall_dir(fl) = road_r_dir(fl) * vf_wr(l) + + sunwall_a_dir(fl) = (1._r8-alb_wall_dir(fl,ib)) * sdir_sunwall(fl,ib) + sunwall_r_dir(fl) = alb_wall_dir(fl,ib) * sdir_sunwall(fl,ib) + sunwall_r_sky_dir(fl) = sunwall_r_dir(fl) * vf_sw(l) + sunwall_r_road_dir(fl) = sunwall_r_dir(fl) * vf_rw(l) + sunwall_r_shadewall_dir(fl) = sunwall_r_dir(fl) * vf_ww(l) + + shadewall_a_dir(fl) = (1._r8-alb_wall_dir(fl,ib)) * sdir_shadewall(fl,ib) + shadewall_r_dir(fl) = alb_wall_dir(fl,ib) * sdir_shadewall(fl,ib) + shadewall_r_sky_dir(fl) = shadewall_r_dir(fl) * vf_sw(l) + shadewall_r_road_dir(fl) = shadewall_r_dir(fl) * vf_rw(l) + shadewall_r_sunwall_dir(fl) = shadewall_r_dir(fl) * vf_ww(l) + + ! diffuse + + road_a_dif(fl) = 0.0_r8 + road_r_dif(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_a_dif(fl) = (1._r8-alb_improad_dif(fl,ib)) * sdif_road(fl,ib) + improad_r_dif(fl) = alb_improad_dif(fl,ib) * sdif_road(fl,ib) + improad_r_sky_dif(fl) = improad_r_dif(fl) * vf_sr(l) + improad_r_sunwall_dif(fl) = improad_r_dif(fl) * vf_wr(l) + improad_r_shadewall_dif(fl) = improad_r_dif(fl) * vf_wr(l) + road_a_dif(fl) = road_a_dif(fl) + improad_a_dif(fl)*wtroad_imperv(fl) + road_r_dif(fl) = road_r_dif(fl) + improad_r_dif(fl)*wtroad_imperv(fl) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_a_dif(fl) = (1._r8-alb_perroad_dif(fl,ib)) * sdif_road(fl,ib) + perroad_r_dif(fl) = alb_perroad_dif(fl,ib) * sdif_road(fl,ib) + perroad_r_sky_dif(fl) = perroad_r_dif(fl) * vf_sr(l) + perroad_r_sunwall_dif(fl) = perroad_r_dif(fl) * vf_wr(l) + perroad_r_shadewall_dif(fl) = perroad_r_dif(fl) * vf_wr(l) + road_a_dif(fl) = road_a_dif(fl) + perroad_a_dif(fl)*wtroad_perv(fl) + road_r_dif(fl) = road_r_dif(fl) + perroad_r_dif(fl)*wtroad_perv(fl) + end if + + road_r_sky_dif(fl) = road_r_dif(fl) * vf_sr(l) + road_r_sunwall_dif(fl) = road_r_dif(fl) * vf_wr(l) + road_r_shadewall_dif(fl) = road_r_dif(fl) * vf_wr(l) + + sunwall_a_dif(fl) = (1._r8-alb_wall_dif(fl,ib)) * sdif_sunwall(fl,ib) + sunwall_r_dif(fl) = alb_wall_dif(fl,ib) * sdif_sunwall(fl,ib) + sunwall_r_sky_dif(fl) = sunwall_r_dif(fl) * vf_sw(l) + sunwall_r_road_dif(fl) = sunwall_r_dif(fl) * vf_rw(l) + sunwall_r_shadewall_dif(fl) = sunwall_r_dif(fl) * vf_ww(l) + + shadewall_a_dif(fl) = (1._r8-alb_wall_dif(fl,ib)) * sdif_shadewall(fl,ib) + shadewall_r_dif(fl) = alb_wall_dif(fl,ib) * sdif_shadewall(fl,ib) + shadewall_r_sky_dif(fl) = shadewall_r_dif(fl) * vf_sw(l) + shadewall_r_road_dif(fl) = shadewall_r_dif(fl) * vf_rw(l) + shadewall_r_sunwall_dif(fl) = shadewall_r_dif(fl) * vf_ww(l) + + ! initialize sum of direct and diffuse solar absorption and reflection for road and both walls + + if ( wtroad_imperv(fl) > 0.0_r8 ) sabs_improad_dir(l,ib) = improad_a_dir(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sabs_perroad_dir(l,ib) = perroad_a_dir(fl) + sabs_sunwall_dir(l,ib) = sunwall_a_dir(fl) + sabs_shadewall_dir(l,ib) = shadewall_a_dir(fl) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sabs_improad_dif(l,ib) = improad_a_dif(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sabs_perroad_dif(l,ib) = perroad_a_dif(fl) + sabs_sunwall_dif(l,ib) = sunwall_a_dif(fl) + sabs_shadewall_dif(l,ib) = shadewall_a_dif(fl) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sref_improad_dir(fl,ib) = improad_r_sky_dir(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sref_perroad_dir(fl,ib) = perroad_r_sky_dir(fl) + sref_sunwall_dir(fl,ib) = sunwall_r_sky_dir(fl) + sref_shadewall_dir(fl,ib) = shadewall_r_sky_dir(fl) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sref_improad_dif(fl,ib) = improad_r_sky_dif(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sref_perroad_dif(fl,ib) = perroad_r_sky_dif(fl) + sref_sunwall_dif(fl,ib) = sunwall_r_sky_dif(fl) + sref_shadewall_dif(fl,ib) = shadewall_r_sky_dif(fl) + endif + + end do + + ! absorption and reflection for walls and road with multiple reflections + ! (i.e., absorb and reflect initial reflection in canyon and allow for + ! subsequent scattering) + ! + ! (1) absorption and reflection of scattered solar radiation + ! road: reflected fluxes from walls need to be projected to ground area + ! wall: reflected flux from road needs to be projected to wall area + ! + ! (2) add absorbed radiation for ith reflection to total absorbed + ! + ! (3) distribute reflected radiation to sky, road, and walls according to view factors + ! + ! (4) add solar reflection to sky for ith reflection to total reflection + ! + ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. + ! small convergence criteria is required to ensure solar radiation is conserved + ! + ! do separately for direct beam and diffuse + + do fl = 1,num_urbanl + if (coszen(fl) .gt. 0._r8) then + l = filter_urbanl(fl) + + ! reflected direct beam + + do iter_dir = 1, n + ! step (1) + + stot(fl) = (sunwall_r_road_dir(fl) + shadewall_r_road_dir(fl))*canyon_hwr(fl) + + road_a_dir(fl) = 0.0_r8 + road_r_dir(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_a_dir(fl) = (1._r8-alb_improad_dir(fl,ib)) * stot(fl) + improad_r_dir(fl) = alb_improad_dir(fl,ib) * stot(fl) + road_a_dir(fl) = road_a_dir(fl) + improad_a_dir(fl)*wtroad_imperv(fl) + road_r_dir(fl) = road_r_dir(fl) + improad_r_dir(fl)*wtroad_imperv(fl) + end if + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_a_dir(fl) = (1._r8-alb_perroad_dir(fl,ib)) * stot(fl) + perroad_r_dir(fl) = alb_perroad_dir(fl,ib) * stot(fl) + road_a_dir(fl) = road_a_dir(fl) + perroad_a_dir(fl)*wtroad_perv(fl) + road_r_dir(fl) = road_r_dir(fl) + perroad_r_dir(fl)*wtroad_perv(fl) + end if + + stot(fl) = road_r_sunwall_dir(fl)/canyon_hwr(fl) + shadewall_r_sunwall_dir(fl) + sunwall_a_dir(fl) = (1._r8-alb_wall_dir(fl,ib)) * stot(fl) + sunwall_r_dir(fl) = alb_wall_dir(fl,ib) * stot(fl) + + stot(fl) = road_r_shadewall_dir(fl)/canyon_hwr(fl) + sunwall_r_shadewall_dir(fl) + shadewall_a_dir(fl) = (1._r8-alb_wall_dir(fl,ib)) * stot(fl) + shadewall_r_dir(fl) = alb_wall_dir(fl,ib) * stot(fl) + + ! step (2) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sabs_improad_dir(l,ib) = sabs_improad_dir(l,ib) + improad_a_dir(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sabs_perroad_dir(l,ib) = sabs_perroad_dir(l,ib) + perroad_a_dir(fl) + sabs_sunwall_dir(l,ib) = sabs_sunwall_dir(l,ib) + sunwall_a_dir(fl) + sabs_shadewall_dir(l,ib) = sabs_shadewall_dir(l,ib) + shadewall_a_dir(fl) + + ! step (3) + + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_r_sky_dir(fl) = improad_r_dir(fl) * vf_sr(l) + improad_r_sunwall_dir(fl) = improad_r_dir(fl) * vf_wr(l) + improad_r_shadewall_dir(fl) = improad_r_dir(fl) * vf_wr(l) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_r_sky_dir(fl) = perroad_r_dir(fl) * vf_sr(l) + perroad_r_sunwall_dir(fl) = perroad_r_dir(fl) * vf_wr(l) + perroad_r_shadewall_dir(fl) = perroad_r_dir(fl) * vf_wr(l) + end if + + road_r_sky_dir(fl) = road_r_dir(fl) * vf_sr(l) + road_r_sunwall_dir(fl) = road_r_dir(fl) * vf_wr(l) + road_r_shadewall_dir(fl) = road_r_dir(fl) * vf_wr(l) + + sunwall_r_sky_dir(fl) = sunwall_r_dir(fl) * vf_sw(l) + sunwall_r_road_dir(fl) = sunwall_r_dir(fl) * vf_rw(l) + sunwall_r_shadewall_dir(fl) = sunwall_r_dir(fl) * vf_ww(l) + + shadewall_r_sky_dir(fl) = shadewall_r_dir(fl) * vf_sw(l) + shadewall_r_road_dir(fl) = shadewall_r_dir(fl) * vf_rw(l) + shadewall_r_sunwall_dir(fl) = shadewall_r_dir(fl) * vf_ww(l) + + ! step (4) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sref_improad_dir(fl,ib) = sref_improad_dir(fl,ib) + improad_r_sky_dir(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sref_perroad_dir(fl,ib) = sref_perroad_dir(fl,ib) + perroad_r_sky_dir(fl) + sref_sunwall_dir(fl,ib) = sref_sunwall_dir(fl,ib) + sunwall_r_sky_dir(fl) + sref_shadewall_dir(fl,ib) = sref_shadewall_dir(fl,ib) + shadewall_r_sky_dir(fl) + + ! step (5) + + crit = max(road_a_dir(fl), sunwall_a_dir(fl), shadewall_a_dir(fl)) + if (crit < errcrit) exit + end do + if (iter_dir >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, direct beam' + write (iulog,*) 'clm model is stopping' + call endrun + endif + + ! reflected diffuse + + do iter_dif = 1, n + ! step (1) + + stot(fl) = (sunwall_r_road_dif(fl) + shadewall_r_road_dif(fl))*canyon_hwr(fl) + road_a_dif(fl) = 0.0_r8 + road_r_dif(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_a_dif(fl) = (1._r8-alb_improad_dif(fl,ib)) * stot(fl) + improad_r_dif(fl) = alb_improad_dif(fl,ib) * stot(fl) + road_a_dif(fl) = road_a_dif(fl) + improad_a_dif(fl)*wtroad_imperv(fl) + road_r_dif(fl) = road_r_dif(fl) + improad_r_dif(fl)*wtroad_imperv(fl) + end if + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_a_dif(fl) = (1._r8-alb_perroad_dif(fl,ib)) * stot(fl) + perroad_r_dif(fl) = alb_perroad_dif(fl,ib) * stot(fl) + road_a_dif(fl) = road_a_dif(fl) + perroad_a_dif(fl)*wtroad_perv(fl) + road_r_dif(fl) = road_r_dif(fl) + perroad_r_dif(fl)*wtroad_perv(fl) + end if + + stot(fl) = road_r_sunwall_dif(fl)/canyon_hwr(fl) + shadewall_r_sunwall_dif(fl) + sunwall_a_dif(fl) = (1._r8-alb_wall_dif(fl,ib)) * stot(fl) + sunwall_r_dif(fl) = alb_wall_dif(fl,ib) * stot(fl) + + stot(fl) = road_r_shadewall_dif(fl)/canyon_hwr(fl) + sunwall_r_shadewall_dif(fl) + shadewall_a_dif(fl) = (1._r8-alb_wall_dif(fl,ib)) * stot(fl) + shadewall_r_dif(fl) = alb_wall_dif(fl,ib) * stot(fl) + + ! step (2) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sabs_improad_dif(l,ib) = sabs_improad_dif(l,ib) + improad_a_dif(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sabs_perroad_dif(l,ib) = sabs_perroad_dif(l,ib) + perroad_a_dif(fl) + sabs_sunwall_dif(l,ib) = sabs_sunwall_dif(l,ib) + sunwall_a_dif(fl) + sabs_shadewall_dif(l,ib) = sabs_shadewall_dif(l,ib) + shadewall_a_dif(fl) + + ! step (3) + + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_r_sky_dif(fl) = improad_r_dif(fl) * vf_sr(l) + improad_r_sunwall_dif(fl) = improad_r_dif(fl) * vf_wr(l) + improad_r_shadewall_dif(fl) = improad_r_dif(fl) * vf_wr(l) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_r_sky_dif(fl) = perroad_r_dif(fl) * vf_sr(l) + perroad_r_sunwall_dif(fl) = perroad_r_dif(fl) * vf_wr(l) + perroad_r_shadewall_dif(fl) = perroad_r_dif(fl) * vf_wr(l) + end if + + road_r_sky_dif(fl) = road_r_dif(fl) * vf_sr(l) + road_r_sunwall_dif(fl) = road_r_dif(fl) * vf_wr(l) + road_r_shadewall_dif(fl) = road_r_dif(fl) * vf_wr(l) + + sunwall_r_sky_dif(fl) = sunwall_r_dif(fl) * vf_sw(l) + sunwall_r_road_dif(fl) = sunwall_r_dif(fl) * vf_rw(l) + sunwall_r_shadewall_dif(fl) = sunwall_r_dif(fl) * vf_ww(l) + + shadewall_r_sky_dif(fl) = shadewall_r_dif(fl) * vf_sw(l) + shadewall_r_road_dif(fl) = shadewall_r_dif(fl) * vf_rw(l) + shadewall_r_sunwall_dif(fl) = shadewall_r_dif(fl) * vf_ww(l) + + ! step (4) + + if ( wtroad_imperv(fl) > 0.0_r8 ) sref_improad_dif(fl,ib) = sref_improad_dif(fl,ib) + improad_r_sky_dif(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) sref_perroad_dif(fl,ib) = sref_perroad_dif(fl,ib) + perroad_r_sky_dif(fl) + sref_sunwall_dif(fl,ib) = sref_sunwall_dif(fl,ib) + sunwall_r_sky_dif(fl) + sref_shadewall_dif(fl,ib) = sref_shadewall_dif(fl,ib) + shadewall_r_sky_dif(fl) + + ! step (5) + + crit = max(road_a_dif(fl), sunwall_a_dif(fl), shadewall_a_dif(fl)) + if (crit < errcrit) exit + end do + if (iter_dif >= n) then + write (iulog,*) 'urban net solar radiation error: no convergence, diffuse' + write (iulog,*) 'clm model is stopping' + call endrun() + endif + + ! total reflected by canyon - sum of solar reflection to sky from canyon. + ! project wall fluxes to horizontal surface + + sref_canyon_dir(fl) = 0.0_r8 + sref_canyon_dif(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + sref_canyon_dir(fl) = sref_canyon_dir(fl) + sref_improad_dir(fl,ib)*wtroad_imperv(fl) + sref_canyon_dif(fl) = sref_canyon_dif(fl) + sref_improad_dif(fl,ib)*wtroad_imperv(fl) + end if + if ( wtroad_perv(fl) > 0.0_r8 ) then + sref_canyon_dir(fl) = sref_canyon_dir(fl) + sref_perroad_dir(fl,ib)*wtroad_perv(fl) + sref_canyon_dif(fl) = sref_canyon_dif(fl) + sref_perroad_dif(fl,ib)*wtroad_perv(fl) + end if + sref_canyon_dir(fl) = sref_canyon_dir(fl) + (sref_sunwall_dir(fl,ib) + sref_shadewall_dir(fl,ib))*canyon_hwr(fl) + sref_canyon_dif(fl) = sref_canyon_dif(fl) + (sref_sunwall_dif(fl,ib) + sref_shadewall_dif(fl,ib))*canyon_hwr(fl) + + ! total absorbed by canyon. project wall fluxes to horizontal surface + + sabs_canyon_dir(fl) = 0.0_r8 + sabs_canyon_dif(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + sabs_canyon_dir(fl) = sabs_canyon_dir(fl) + sabs_improad_dir(l,ib)*wtroad_imperv(fl) + sabs_canyon_dif(fl) = sabs_canyon_dif(fl) + sabs_improad_dif(l,ib)*wtroad_imperv(fl) + end if + if ( wtroad_perv(fl) > 0.0_r8 ) then + sabs_canyon_dir(fl) = sabs_canyon_dir(fl) + sabs_perroad_dir(l,ib)*wtroad_perv(fl) + sabs_canyon_dif(fl) = sabs_canyon_dif(fl) + sabs_perroad_dif(l,ib)*wtroad_perv(fl) + end if + sabs_canyon_dir(fl) = sabs_canyon_dir(fl) + (sabs_sunwall_dir(l,ib) + sabs_shadewall_dir(l,ib))*canyon_hwr(fl) + sabs_canyon_dif(fl) = sabs_canyon_dif(fl) + (sabs_sunwall_dif(l,ib) + sabs_shadewall_dif(l,ib))*canyon_hwr(fl) + + ! conservation check. note: previous conservation checks confirm partioning of total direct + ! beam and diffuse radiation from atmosphere to road and walls is conserved as + ! sdir (from atmosphere) = sdir_road + (sdir_sunwall + sdir_shadewall)*canyon_hwr + ! sdif (from atmosphere) = sdif_road + (sdif_sunwall + sdif_shadewall)*canyon_hwr + + stot_dir(fl) = sdir_road(fl,ib) + (sdir_sunwall(fl,ib) + sdir_shadewall(fl,ib))*canyon_hwr(fl) + stot_dif(fl) = sdif_road(fl,ib) + (sdif_sunwall(fl,ib) + sdif_shadewall(fl,ib))*canyon_hwr(fl) + + err = stot_dir(fl) + stot_dif(fl) & + - (sabs_canyon_dir(fl) + sabs_canyon_dif(fl) + sref_canyon_dir(fl) + sref_canyon_dif(fl)) + if (abs(err) > 0.001_r8 ) then + write(iulog,*)'urban net solar radiation balance error for ib=',ib,' err= ',err + write(iulog,*)' l= ',l,' ib= ',ib + write(iulog,*)' stot_dir = ',stot_dir(fl) + write(iulog,*)' stot_dif = ',stot_dif(fl) + write(iulog,*)' sabs_canyon_dir = ',sabs_canyon_dir(fl) + write(iulog,*)' sabs_canyon_dif = ',sabs_canyon_dif(fl) + write(iulog,*)' sref_canyon_dir = ',sref_canyon_dir(fl) + write(iulog,*)' sref_canyon_dif = ',sref_canyon_dir(fl) + write(iulog,*) 'clm model is stopping' + call endrun() + endif + + ! canyon albedo + + canyon_alb_dif(fl) = sref_canyon_dif(fl) / max(stot_dif(fl), 1.e-06_r8) + canyon_alb_dir(fl) = sref_canyon_dir(fl) / max(stot_dir(fl), 1.e-06_r8) + end if + + end do ! end of landunit loop + + ! Refected and absorbed solar radiation per unit incident radiation for roof + + do fl = 1,num_urbanl + if (coszen(fl) .gt. 0._r8) then + l = filter_urbanl(fl) + sref_roof_dir(fl,ib) = alb_roof_dir(fl,ib) * sdir(fl,ib) + sref_roof_dif(fl,ib) = alb_roof_dif(fl,ib) * sdif(fl,ib) + sabs_roof_dir(l,ib) = sdir(fl,ib) - sref_roof_dir(fl,ib) + sabs_roof_dif(l,ib) = sdif(fl,ib) - sref_roof_dif(fl,ib) + end if + end do + + end do ! end of radiation band loop + + end subroutine net_solar + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: net_longwave +! +! !INTERFACE: + subroutine net_longwave (lbl, ubl, num_urbanl, filter_urbanl, canyon_hwr, wtroad_perv, & + lwdown, em_roof, em_improad, em_perroad, em_wall, & + t_roof, t_improad, t_perroad, t_sunwall, t_shadewall, & + lwnet_roof, lwnet_improad, lwnet_perroad, lwnet_sunwall, lwnet_shadewall, lwnet_canyon, & + lwup_roof, lwup_improad, lwup_perroad, lwup_sunwall, lwup_shadewall, lwup_canyon) +! +! !DESCRIPTION: +! Net longwave radiation for road and both walls in urban canyon allowing for +! multiple reflection. Also net longwave radiation for urban roof. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varcon , only : sb + use clmtype +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: num_urbanl ! number of urban landunits + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + real(r8), intent(in) :: canyon_hwr(num_urbanl) ! ratio of building height to street width + real(r8), intent(in) :: wtroad_perv(num_urbanl) ! weight of pervious road wrt total road + + real(r8), intent(in) :: lwdown(num_urbanl) ! atmospheric longwave radiation (W/m**2) + real(r8), intent(in) :: em_roof(num_urbanl) ! roof emissivity + real(r8), intent(in) :: em_improad(num_urbanl) ! impervious road emissivity + real(r8), intent(in) :: em_perroad(num_urbanl) ! pervious road emissivity + real(r8), intent(in) :: em_wall(num_urbanl) ! wall emissivity + + real(r8), intent(in) :: t_roof(num_urbanl) ! roof temperature (K) + real(r8), intent(in) :: t_improad(num_urbanl) ! impervious road temperature (K) + real(r8), intent(in) :: t_perroad(num_urbanl) ! ervious road temperature (K) + real(r8), intent(in) :: t_sunwall(num_urbanl) ! sunlit wall temperature (K) + real(r8), intent(in) :: t_shadewall(num_urbanl) ! shaded wall temperature (K) + + real(r8), intent(out) :: lwnet_roof(num_urbanl) ! net (outgoing-incoming) longwave radiation, roof (W/m**2) + real(r8), intent(out) :: lwnet_improad(num_urbanl) ! net (outgoing-incoming) longwave radiation, impervious road (W/m**2) + real(r8), intent(out) :: lwnet_perroad(num_urbanl) ! net (outgoing-incoming) longwave radiation, pervious road (W/m**2) + real(r8), intent(out) :: lwnet_sunwall(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit wall area), sunlit wall (W/m**2) + real(r8), intent(out) :: lwnet_shadewall(num_urbanl) ! net (outgoing-incoming) longwave radiation (per unit wall area), shaded wall (W/m**2) + real(r8), intent(out) :: lwnet_canyon(num_urbanl) ! net (outgoing-incoming) longwave radiation for canyon, per unit ground area (W/m**2) + + real(r8), intent(out) :: lwup_roof(num_urbanl) ! upward longwave radiation, roof (W/m**2) + real(r8), intent(out) :: lwup_improad(num_urbanl) ! upward longwave radiation, impervious road (W/m**2) + real(r8), intent(out) :: lwup_perroad(num_urbanl) ! upward longwave radiation, pervious road (W/m**2) + real(r8), intent(out) :: lwup_sunwall(num_urbanl) ! upward longwave radiation (per unit wall area), sunlit wall (W/m**2) + real(r8), intent(out) :: lwup_shadewall(num_urbanl) ! upward longwave radiation (per unit wall area), shaded wall (W/m**2) + real(r8), intent(out) :: lwup_canyon(num_urbanl) ! upward longwave radiation for canyon, per unit ground area (W/m**2) +! +! local pointers to original implicit in arguments (clmtype) +! + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall +! +! !CALLED FROM: +! subroutine UrbanRadiation in this module +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: lwdown_road(num_urbanl) ! atmospheric longwave radiation for total road (W/m**2) + real(r8) :: lwdown_sunwall(num_urbanl) ! atmospheric longwave radiation (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: lwdown_shadewall(num_urbanl) ! atmospheric longwave radiation (per unit wall area) for shaded wall (W/m**2) + real(r8) :: lwtot(num_urbanl) ! incoming longwave radiation (W/m**2) + + real(r8) :: improad_a(num_urbanl) ! absorbed longwave for improad (W/m**2) + real(r8) :: improad_r(num_urbanl) ! reflected longwave for improad (W/m**2) + real(r8) :: improad_r_sky(num_urbanl) ! improad_r to sky (W/m**2) + real(r8) :: improad_r_sunwall(num_urbanl) ! improad_r to sunlit wall (W/m**2) + real(r8) :: improad_r_shadewall(num_urbanl) ! improad_r to shaded wall (W/m**2) + real(r8) :: improad_e(num_urbanl) ! emitted longwave for improad (W/m**2) + real(r8) :: improad_e_sky(num_urbanl) ! improad_e to sky (W/m**2) + real(r8) :: improad_e_sunwall(num_urbanl) ! improad_e to sunlit wall (W/m**2) + real(r8) :: improad_e_shadewall(num_urbanl) ! improad_e to shaded wall (W/m**2) + + real(r8) :: perroad_a(num_urbanl) ! absorbed longwave for perroad (W/m**2) + real(r8) :: perroad_r(num_urbanl) ! reflected longwave for perroad (W/m**2) + real(r8) :: perroad_r_sky(num_urbanl) ! perroad_r to sky (W/m**2) + real(r8) :: perroad_r_sunwall(num_urbanl) ! perroad_r to sunlit wall (W/m**2) + real(r8) :: perroad_r_shadewall(num_urbanl) ! perroad_r to shaded wall (W/m**2) + real(r8) :: perroad_e(num_urbanl) ! emitted longwave for perroad (W/m**2) + real(r8) :: perroad_e_sky(num_urbanl) ! perroad_e to sky (W/m**2) + real(r8) :: perroad_e_sunwall(num_urbanl) ! perroad_e to sunlit wall (W/m**2) + real(r8) :: perroad_e_shadewall(num_urbanl) ! perroad_e to shaded wall (W/m**2) + + real(r8) :: road_a(num_urbanl) ! absorbed longwave for total road (W/m**2) + real(r8) :: road_r(num_urbanl) ! reflected longwave for total road (W/m**2) + real(r8) :: road_r_sky(num_urbanl) ! total road_r to sky (W/m**2) + real(r8) :: road_r_sunwall(num_urbanl) ! total road_r to sunlit wall (W/m**2) + real(r8) :: road_r_shadewall(num_urbanl) ! total road_r to shaded wall (W/m**2) + real(r8) :: road_e(num_urbanl) ! emitted longwave for total road (W/m**2) + real(r8) :: road_e_sky(num_urbanl) ! total road_e to sky (W/m**2) + real(r8) :: road_e_sunwall(num_urbanl) ! total road_e to sunlit wall (W/m**2) + real(r8) :: road_e_shadewall(num_urbanl) ! total road_e to shaded wall (W/m**2) + + real(r8) :: sunwall_a(num_urbanl) ! absorbed longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_r(num_urbanl) ! reflected longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_r_sky(num_urbanl) ! sunwall_r to sky (W/m**2) + real(r8) :: sunwall_r_road(num_urbanl) ! sunwall_r to road (W/m**2) + real(r8) :: sunwall_r_shadewall(num_urbanl) ! sunwall_r to opposing (shaded) wall (W/m**2) + real(r8) :: sunwall_e(num_urbanl) ! emitted longwave (per unit wall area) for sunlit wall (W/m**2) + real(r8) :: sunwall_e_sky(num_urbanl) ! sunwall_e to sky (W/m**2) + real(r8) :: sunwall_e_road(num_urbanl) ! sunwall_e to road (W/m**2) + real(r8) :: sunwall_e_shadewall(num_urbanl) ! sunwall_e to opposing (shaded) wall (W/m**2) + + real(r8) :: shadewall_a(num_urbanl) ! absorbed longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_r(num_urbanl) ! reflected longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_r_sky(num_urbanl) ! shadewall_r to sky (W/m**2) + real(r8) :: shadewall_r_road(num_urbanl) ! shadewall_r to road (W/m**2) + real(r8) :: shadewall_r_sunwall(num_urbanl) ! shadewall_r to opposing (sunlit) wall (W/m**2) + real(r8) :: shadewall_e(num_urbanl) ! emitted longwave (per unit wall area) for shaded wall (W/m**2) + real(r8) :: shadewall_e_sky(num_urbanl) ! shadewall_e to sky (W/m**2) + real(r8) :: shadewall_e_road(num_urbanl) ! shadewall_e to road (W/m**2) + real(r8) :: shadewall_e_sunwall(num_urbanl) ! shadewall_e to opposing (sunlit) wall (W/m**2) + integer :: l,fl,iter ! indices + integer, parameter :: n = 50 ! number of interations + real(r8) :: crit ! convergence criterion (W/m**2) + real(r8) :: err ! energy conservation error (W/m**2) + real(r8) :: wtroad_imperv(num_urbanl) ! weight of impervious road wrt total road +!----------------------------------------------------------------------- + + ! Assign landunit level pointer + + vf_sr => lps%vf_sr + vf_wr => lps%vf_wr + vf_sw => lps%vf_sw + vf_rw => lps%vf_rw + vf_ww => lps%vf_ww + + ! Calculate impervious road + + do l = 1,num_urbanl + wtroad_imperv(l) = 1._r8 - wtroad_perv(l) + end do + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + ! atmospheric longwave radiation incident on walls and road in urban canyon. + ! check for conservation (need to convert wall fluxes to ground area). + ! lwdown (from atmosphere) = lwdown_road + (lwdown_sunwall + lwdown_shadewall)*canyon_hwr + + lwdown_road(fl) = lwdown(fl) * vf_sr(l) + lwdown_sunwall(fl) = lwdown(fl) * vf_sw(l) + lwdown_shadewall(fl) = lwdown(fl) * vf_sw(l) + + err = lwdown(fl) - (lwdown_road(fl) + (lwdown_shadewall(fl) + lwdown_sunwall(fl))*canyon_hwr(fl)) + if (abs(err) > 0.10_r8 ) then + write (iulog,*) 'urban incident atmospheric longwave radiation balance error',err + write (iulog,*) 'clm model is stopping' + call endrun + endif + end do + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + ! initial absorption, reflection, and emission for road and both walls. + ! distribute reflected and emitted radiation to sky, road, and walls according + ! to appropriate view factor. radiation reflected to road and walls will + ! undergo multiple reflections within the canyon. + + road_a(fl) = 0.0_r8 + road_r(fl) = 0.0_r8 + road_e(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_a(fl) = em_improad(fl) * lwdown_road(fl) + improad_r(fl) = (1._r8-em_improad(fl)) * lwdown_road(fl) + improad_r_sky(fl) = improad_r(fl) * vf_sr(l) + improad_r_sunwall(fl) = improad_r(fl) * vf_wr(l) + improad_r_shadewall(fl) = improad_r(fl) * vf_wr(l) + improad_e(fl) = em_improad(fl) * sb * (t_improad(fl)**4) + improad_e_sky(fl) = improad_e(fl) * vf_sr(l) + improad_e_sunwall(fl) = improad_e(fl) * vf_wr(l) + improad_e_shadewall(fl) = improad_e(fl) * vf_wr(l) + road_a(fl) = road_a(fl) + improad_a(fl)*wtroad_imperv(fl) + road_r(fl) = road_r(fl) + improad_r(fl)*wtroad_imperv(fl) + road_e(fl) = road_e(fl) + improad_e(fl)*wtroad_imperv(fl) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_a(fl) = em_perroad(fl) * lwdown_road(fl) + perroad_r(fl) = (1._r8-em_perroad(fl)) * lwdown_road(fl) + perroad_r_sky(fl) = perroad_r(fl) * vf_sr(l) + perroad_r_sunwall(fl) = perroad_r(fl) * vf_wr(l) + perroad_r_shadewall(fl) = perroad_r(fl) * vf_wr(l) + perroad_e(fl) = em_perroad(fl) * sb * (t_perroad(fl)**4) + perroad_e_sky(fl) = perroad_e(fl) * vf_sr(l) + perroad_e_sunwall(fl) = perroad_e(fl) * vf_wr(l) + perroad_e_shadewall(fl) = perroad_e(fl) * vf_wr(l) + road_a(fl) = road_a(fl) + perroad_a(fl)*wtroad_perv(fl) + road_r(fl) = road_r(fl) + perroad_r(fl)*wtroad_perv(fl) + road_e(fl) = road_e(fl) + perroad_e(fl)*wtroad_perv(fl) + end if + + road_r_sky(fl) = road_r(fl) * vf_sr(l) + road_r_sunwall(fl) = road_r(fl) * vf_wr(l) + road_r_shadewall(fl) = road_r(fl) * vf_wr(l) + road_e_sky(fl) = road_e(fl) * vf_sr(l) + road_e_sunwall(fl) = road_e(fl) * vf_wr(l) + road_e_shadewall(fl) = road_e(fl) * vf_wr(l) + + sunwall_a(fl) = em_wall(fl) * lwdown_sunwall(fl) + sunwall_r(fl) = (1._r8-em_wall(fl)) * lwdown_sunwall(fl) + sunwall_r_sky(fl) = sunwall_r(fl) * vf_sw(l) + sunwall_r_road(fl) = sunwall_r(fl) * vf_rw(l) + sunwall_r_shadewall(fl) = sunwall_r(fl) * vf_ww(l) + sunwall_e(fl) = em_wall(fl) * sb * (t_sunwall(fl)**4) + sunwall_e_sky(fl) = sunwall_e(fl) * vf_sw(l) + sunwall_e_road(fl) = sunwall_e(fl) * vf_rw(l) + sunwall_e_shadewall(fl) = sunwall_e(fl) * vf_ww(l) + + shadewall_a(fl) = em_wall(fl) * lwdown_shadewall(fl) + shadewall_r(fl) = (1._r8-em_wall(fl)) * lwdown_shadewall(fl) + shadewall_r_sky(fl) = shadewall_r(fl) * vf_sw(l) + shadewall_r_road(fl) = shadewall_r(fl) * vf_rw(l) + shadewall_r_sunwall(fl) = shadewall_r(fl) * vf_ww(l) + shadewall_e(fl) = em_wall(fl) * sb * (t_shadewall(fl)**4) + shadewall_e_sky(fl) = shadewall_e(fl) * vf_sw(l) + shadewall_e_road(fl) = shadewall_e(fl) * vf_rw(l) + shadewall_e_sunwall(fl) = shadewall_e(fl) * vf_ww(l) + + ! initialize sum of net and upward longwave radiation for road and both walls + + if ( wtroad_imperv(fl) > 0.0_r8 ) lwnet_improad(fl) = improad_e(fl) - improad_a(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) lwnet_perroad(fl) = perroad_e(fl) - perroad_a(fl) + lwnet_sunwall(fl) = sunwall_e(fl) - sunwall_a(fl) + lwnet_shadewall(fl) = shadewall_e(fl) - shadewall_a(fl) + + if ( wtroad_imperv(fl) > 0.0_r8 ) lwup_improad(fl) = improad_r_sky(fl) + improad_e_sky(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) lwup_perroad(fl) = perroad_r_sky(fl) + perroad_e_sky(fl) + lwup_sunwall(fl) = sunwall_r_sky(fl) + sunwall_e_sky(fl) + lwup_shadewall(fl) = shadewall_r_sky(fl) + shadewall_e_sky(fl) + + end do + + ! now account for absorption and reflection within canyon of fluxes from road and walls + ! allowing for multiple reflections + ! + ! (1) absorption and reflection. note: emission from road and walls absorbed by walls and roads + ! only occurs in first iteration. zero out for later iterations. + ! + ! road: fluxes from walls need to be projected to ground area + ! wall: fluxes from road need to be projected to wall area + ! + ! (2) add net longwave for ith reflection to total net longwave + ! + ! (3) distribute reflected radiation to sky, road, and walls according to view factors + ! + ! (4) add upward longwave radiation to sky from road and walls for ith reflection to total + ! + ! (5) stop iteration when absorption for ith reflection is less than some nominal amount. + ! small convergence criteria is required to ensure radiation is conserved + + do fl = 1,num_urbanl + l = filter_urbanl(fl) + + do iter = 1, n + ! step (1) + + lwtot(fl) = (sunwall_r_road(fl) + sunwall_e_road(fl) & + + shadewall_r_road(fl) + shadewall_e_road(fl))*canyon_hwr(fl) + road_a(fl) = 0.0_r8 + road_r(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_r(fl) = (1._r8-em_improad(fl)) * lwtot(fl) + improad_a(fl) = em_improad(fl) * lwtot(fl) + road_a(fl) = road_a(fl) + improad_a(fl)*wtroad_imperv(fl) + road_r(fl) = road_r(fl) + improad_r(fl)*wtroad_imperv(fl) + end if + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_r(fl) = (1._r8-em_perroad(fl)) * lwtot(fl) + perroad_a(fl) = em_perroad(fl) * lwtot(fl) + road_a(fl) = road_a(fl) + perroad_a(fl)*wtroad_perv(fl) + road_r(fl) = road_r(fl) + perroad_r(fl)*wtroad_perv(fl) + end if + + lwtot(fl) = (road_r_sunwall(fl) + road_e_sunwall(fl))/canyon_hwr(fl) & + + (shadewall_r_sunwall(fl) + shadewall_e_sunwall(fl)) + sunwall_a(fl) = em_wall(fl) * lwtot(fl) + sunwall_r(fl) = (1._r8-em_wall(fl)) * lwtot(fl) + + lwtot(fl) = (road_r_shadewall(fl) + road_e_shadewall(fl))/canyon_hwr(fl) & + + (sunwall_r_shadewall(fl) + sunwall_e_shadewall(fl)) + shadewall_a(fl) = em_wall(fl) * lwtot(fl) + shadewall_r(fl) = (1._r8-em_wall(fl)) * lwtot(fl) + + sunwall_e_road(fl) = 0._r8 + shadewall_e_road(fl) = 0._r8 + road_e_sunwall(fl) = 0._r8 + shadewall_e_sunwall(fl) = 0._r8 + road_e_shadewall(fl) = 0._r8 + sunwall_e_shadewall(fl) = 0._r8 + + ! step (2) + + if ( wtroad_imperv(fl) > 0.0_r8 ) lwnet_improad(fl) = lwnet_improad(fl) - improad_a(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) lwnet_perroad(fl) = lwnet_perroad(fl) - perroad_a(fl) + lwnet_sunwall(fl) = lwnet_sunwall(fl) - sunwall_a(fl) + lwnet_shadewall(fl) = lwnet_shadewall(fl) - shadewall_a(fl) + + ! step (3) + + if ( wtroad_imperv(fl) > 0.0_r8 ) then + improad_r_sky(fl) = improad_r(fl) * vf_sr(l) + improad_r_sunwall(fl) = improad_r(fl) * vf_wr(l) + improad_r_shadewall(fl) = improad_r(fl) * vf_wr(l) + end if + + if ( wtroad_perv(fl) > 0.0_r8 ) then + perroad_r_sky(fl) = perroad_r(fl) * vf_sr(l) + perroad_r_sunwall(fl) = perroad_r(fl) * vf_wr(l) + perroad_r_shadewall(fl) = perroad_r(fl) * vf_wr(l) + end if + + road_r_sky(fl) = road_r(fl) * vf_sr(l) + road_r_sunwall(fl) = road_r(fl) * vf_wr(l) + road_r_shadewall(fl) = road_r(fl) * vf_wr(l) + + sunwall_r_sky(fl) = sunwall_r(fl) * vf_sw(l) + sunwall_r_road(fl) = sunwall_r(fl) * vf_rw(l) + sunwall_r_shadewall(fl) = sunwall_r(fl) * vf_ww(l) + + shadewall_r_sky(fl) = shadewall_r(fl) * vf_sw(l) + shadewall_r_road(fl) = shadewall_r(fl) * vf_rw(l) + shadewall_r_sunwall(fl) = shadewall_r(fl) * vf_ww(l) + + ! step (4) + + if ( wtroad_imperv(fl) > 0.0_r8 ) lwup_improad(fl) = lwup_improad(fl) + improad_r_sky(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) lwup_perroad(fl) = lwup_perroad(fl) + perroad_r_sky(fl) + lwup_sunwall(fl) = lwup_sunwall(fl) + sunwall_r_sky(fl) + lwup_shadewall(fl) = lwup_shadewall(fl) + shadewall_r_sky(fl) + + ! step (5) + + crit = max(road_a(fl), sunwall_a(fl), shadewall_a(fl)) + if (crit < .001_r8) exit + end do + if (iter >= n) then + write (iulog,*) 'urban net longwave radiation error: no convergence' + write (iulog,*) 'clm model is stopping' + call endrun + endif + + ! total net longwave radiation for canyon. project wall fluxes to horizontal surface + + lwnet_canyon(fl) = 0.0_r8 + if ( wtroad_imperv(fl) > 0.0_r8 ) lwnet_canyon(fl) = lwnet_canyon(fl) + lwnet_improad(fl)*wtroad_imperv(fl) + if ( wtroad_perv(fl) > 0.0_r8 ) lwnet_canyon(fl) = lwnet_canyon(fl) + lwnet_perroad(fl)*wtroad_perv(fl) + lwnet_canyon(fl) = lwnet_canyon(fl) + (lwnet_sunwall(fl) + lwnet_shadewall(fl))*canyon_hwr(fl) + + ! total emitted longwave for canyon. project wall fluxes to horizontal + + lwup_canyon(fl) = 0.0_r8 + if( wtroad_imperv(fl) > 0.0_r8 ) lwup_canyon(fl) = lwup_canyon(fl) + lwup_improad(fl)*wtroad_imperv(fl) + if( wtroad_perv(fl) > 0.0_r8 ) lwup_canyon(fl) = lwup_canyon(fl) + lwup_perroad(fl)*wtroad_perv(fl) + lwup_canyon(fl) = lwup_canyon(fl) + (lwup_sunwall(fl) + lwup_shadewall(fl))*canyon_hwr(fl) + + ! conservation check. note: previous conservation check confirms partioning of incident + ! atmospheric longwave radiation to road and walls is conserved as + ! lwdown (from atmosphere) = lwdown_improad + lwdown_perroad + (lwdown_sunwall + lwdown_shadewall)*canyon_hwr + + err = lwnet_canyon(fl) - (lwup_canyon(fl) - lwdown(fl)) + if (abs(err) > .10_r8 ) then + write (iulog,*) 'urban net longwave radiation balance error',err + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + end do + + ! Net longwave radiation for roof + + do l = 1,num_urbanl + lwup_roof(l) = em_roof(l)*sb*(t_roof(l)**4) + (1._r8-em_roof(l))*lwdown(l) + lwnet_roof(l) = lwup_roof(l) - lwdown(l) + end do + + end subroutine net_longwave + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanClumpInit +! +! !INTERFACE: + subroutine UrbanClumpInit() +! +! !DESCRIPTION: +! Initialize urban radiation module +! +! !USES: + use clmtype + use clm_varcon , only : spval, icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv + use decompMod , only : get_proc_clumps, ldecomp + use filterMod , only : filter + use UrbanInputMod, only : urbinp +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein 04/2003 +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments +! + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: ctype(:) ! column type +! +! +! !OTHER LOCAL VARIABLES +!EOP +! + integer :: nc,fl,ib,l,c,p,g ! indices + integer :: nclumps ! number of clumps on processor + integer :: num_urbanl ! number of per-clump urban landunits + integer :: ier ! error status +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (landunit-level) + + coli => lun%coli + colf => lun%colf + lgridcell => lun%gridcell + + ! Assign local pointers to derived type members (column-level) + + ctype => col%itype + + ! Allocate memory + + nclumps = get_proc_clumps() + allocate(urban_clump(nclumps), stat=ier) + if (ier /= 0) then + write (iulog,*) 'UrbanInit: allocation error for urban clumps'; call endrun() + end if + + ! Loop over all clumps on this processor + + do nc = 1, nclumps + + ! Determine number of unrban landunits in clump + + num_urbanl = filter(nc)%num_urbanl + + ! Consistency check for urban columns + + do fl = 1,num_urbanl + l = filter(nc)%urbanl(fl) + do c = coli(l),colf(l) + if ( ctype(c) /= icol_roof .and. & + ctype(c) /= icol_sunwall .and. ctype(c) /= icol_shadewall .and. & + ctype(c) /= icol_road_perv .and. ctype(c) /= icol_road_imperv) then + write(iulog,*)'error in urban column types for landunit = ',l + write(iulog,*)'ctype= ',ctype(c) + call endrun() + endif + end do + end do + + ! Allocate memory for urban clump clumponents + + if (num_urbanl > 0) then + allocate( urban_clump(nc)%canyon_hwr (num_urbanl), & + urban_clump(nc)%wtroad_perv (num_urbanl), & + urban_clump(nc)%ht_roof (num_urbanl), & + urban_clump(nc)%wtlunit_roof (num_urbanl), & + urban_clump(nc)%wind_hgt_canyon (num_urbanl), & + urban_clump(nc)%em_roof (num_urbanl), & + urban_clump(nc)%em_improad (num_urbanl), & + urban_clump(nc)%em_perroad (num_urbanl), & + urban_clump(nc)%em_wall (num_urbanl), & + urban_clump(nc)%alb_roof_dir (num_urbanl,numrad), & + urban_clump(nc)%alb_roof_dif (num_urbanl,numrad), & + urban_clump(nc)%alb_improad_dir (num_urbanl,numrad), & + urban_clump(nc)%alb_perroad_dir (num_urbanl,numrad), & + urban_clump(nc)%alb_improad_dif (num_urbanl,numrad), & + urban_clump(nc)%alb_perroad_dif (num_urbanl,numrad), & + urban_clump(nc)%alb_wall_dir (num_urbanl,numrad), & + urban_clump(nc)%alb_wall_dif (num_urbanl,numrad), stat=ier ) + if (ier /= 0) then + write(iulog,*)'UrbanRadInit: allocation error for urban derived type'; call endrun() + endif + end if + + ! Set constants in derived type values for urban clump + + do fl = 1,num_urbanl + l = filter(nc)%urbanl(fl) + g = lun%gridcell(l) + urban_clump(nc)%canyon_hwr (fl) = urbinp%canyon_hwr (g) + urban_clump(nc)%wtroad_perv (fl) = urbinp%wtroad_perv (g) + urban_clump(nc)%ht_roof (fl) = urbinp%ht_roof (g) + urban_clump(nc)%wtlunit_roof (fl) = urbinp%wtlunit_roof (g) + urban_clump(nc)%wind_hgt_canyon(fl) = urbinp%wind_hgt_canyon(g) + do ib = 1,numrad + urban_clump(nc)%alb_roof_dir (fl,ib) = urbinp%alb_roof_dir (g,ib) + urban_clump(nc)%alb_roof_dif (fl,ib) = urbinp%alb_roof_dif (g,ib) + urban_clump(nc)%alb_improad_dir(fl,ib) = urbinp%alb_improad_dir(g,ib) + urban_clump(nc)%alb_perroad_dir(fl,ib) = urbinp%alb_perroad_dir(g,ib) + urban_clump(nc)%alb_improad_dif(fl,ib) = urbinp%alb_improad_dif(g,ib) + urban_clump(nc)%alb_perroad_dif(fl,ib) = urbinp%alb_perroad_dif(g,ib) + urban_clump(nc)%alb_wall_dir (fl,ib) = urbinp%alb_wall_dir (g,ib) + urban_clump(nc)%alb_wall_dif (fl,ib) = urbinp%alb_wall_dif (g,ib) + end do + urban_clump(nc)%em_roof (fl) = urbinp%em_roof (g) + urban_clump(nc)%em_improad(fl) = urbinp%em_improad(g) + urban_clump(nc)%em_perroad(fl) = urbinp%em_perroad(g) + urban_clump(nc)%em_wall (fl) = urbinp%em_wall (g) +! write(iulog,*)'g: ',g +! write(iulog,*)'l: ',l +! write(iulog,*)'fl: ',fl +! write(iulog,*)'urban_clump(nc)%canyon_hwr: ',urban_clump(nc)%canyon_hwr(fl) +! write(iulog,*)'urban_clump(nc)%wtroad_perv: ',urban_clump(nc)%wtroad_perv(fl) +! write(iulog,*)'urban_clump(nc)%ht_roof: ',urban_clump(nc)%ht_roof(fl) +! write(iulog,*)'urban_clump(nc)%wtlunit_roof: ',urban_clump(nc)%wtlunit_roof(fl) +! write(iulog,*)'urban_clump(nc)%wind_hgt_canyon: ',urban_clump(nc)%wind_hgt_canyon(fl) +! write(iulog,*)'urban_clump(nc)%alb_roof_dir: ',urban_clump(nc)%alb_roof_dir(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_roof_dif: ',urban_clump(nc)%alb_roof_dif(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_improad_dir: ',urban_clump(nc)%alb_improad_dir(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_improad_dif: ',urban_clump(nc)%alb_improad_dif(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_perroad_dir: ',urban_clump(nc)%alb_perroad_dir(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_perroad_dif: ',urban_clump(nc)%alb_perroad_dif(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_wall_dir: ',urban_clump(nc)%alb_wall_dir(fl,:) +! write(iulog,*)'urban_clump(nc)%alb_wall_dif: ',urban_clump(nc)%alb_wall_dif(fl,:) +! write(iulog,*)'urban_clump(nc)%em_roof: ',urban_clump(nc)%em_roof(fl) +! write(iulog,*)'urban_clump(nc)%em_improad: ',urban_clump(nc)%em_improad(fl) +! write(iulog,*)'urban_clump(nc)%em_perroad: ',urban_clump(nc)%em_perroad(fl) +! write(iulog,*)'urban_clump(nc)%em_wall: ',urban_clump(nc)%em_wall(fl) + end do + end do ! end of loop over clumps + + end subroutine UrbanClumpInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: UrbanFluxes +! +! !INTERFACE: + subroutine UrbanFluxes (nc, lbp, ubp, lbl, ubl, lbc, ubc, & + num_nourbanl, filter_nourbanl, & + num_urbanl, filter_urbanl, & + num_urbanc, filter_urbanc, & + num_urbanp, filter_urbanp) +! +! !DESCRIPTION: +! Turbulent and momentum fluxes from urban canyon (consisting of roof, sunwall, +! shadewall, pervious and impervious road). + +! !USES: + use clmtype + use clm_varcon , only : cpair, vkc, spval, icol_roof, icol_sunwall, & + icol_shadewall, icol_road_perv, icol_road_imperv, & + grav, pondmx_urban, rpi, rgas, & + ht_wasteheat_factor, ac_wasteheat_factor, & + wasteheat_limit + use filterMod , only : filter + use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni + use QSatMod , only : QSat + use clm_varpar , only : maxpatch_urb, nlevurb + use clm_time_manager , only : get_curr_date, get_step_size, get_nstep + use clm_atmlnd , only : clm_a2l + +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: nc ! clump index + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: lbl, ubl ! landunit-index bounds + integer, intent(in) :: lbc, ubc ! column-index bounds + integer , intent(in) :: num_nourbanl ! number of non-urban landunits in clump + integer , intent(in) :: filter_nourbanl(ubl-lbl+1) ! non-urban landunit filter + integer , intent(in) :: num_urbanl ! number of urban landunits in clump + integer , intent(in) :: filter_urbanl(ubl-lbl+1) ! urban landunit filter + integer , intent(in) :: num_urbanc ! number of urban columns in clump + integer , intent(in) :: filter_urbanc(ubc-lbc+1) ! urban column filter + integer , intent(in) :: num_urbanp ! number of urban pfts in clump + integer , intent(in) :: filter_urbanp(ubp-lbp+1) ! urban pft filter +! +! !CALLED FROM: +! subroutine clm_driver1 +! +! !REVISION HISTORY: +! Author: Keith Oleson 10/2005 +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in arguments (urban clump) +! + real(r8), pointer :: ht_roof(:) ! height of urban roof (m) + real(r8), pointer :: wtlunit_roof(:) ! weight of roof with respect to landunit + real(r8), pointer :: canyon_hwr(:) ! ratio of building height to street width + real(r8), pointer :: wtroad_perv(:) ! weight of pervious road wrt total road + real(r8), pointer :: wind_hgt_canyon(:) ! height above road at which wind in canyon is to be computed (m) +! +! local pointers to original implicit in arguments (clmtype) +! + real(r8), pointer :: forc_u(:) ! atmospheric wind speed in east direction (m/s) + real(r8), pointer :: forc_v(:) ! atmospheric wind speed in north direction (m/s) + real(r8), pointer :: forc_rho(:) ! density (kg/m**3) + real(r8), pointer :: forc_hgt_u_pft(:) ! observational height of wind at pft-level (m) + real(r8), pointer :: forc_hgt_t_pft(:) ! observational height of temperature at pft-level (m) + real(r8), pointer :: forc_q(:) ! atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_t(:) ! atmospheric temperature (K) + real(r8), pointer :: forc_th(:) ! atmospheric potential temperature (K) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + + real(r8), pointer :: z_0_town(:) ! momentum roughness length of urban landunit (m) + real(r8), pointer :: z_d_town(:) ! displacement height of urban landunit (m) + + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: plandunit(:) ! pft's landunit index + integer , pointer :: ctype(:) ! column type + integer , pointer :: coli(:) ! beginning column index for landunit + integer , pointer :: colf(:) ! ending column index for landunit + integer , pointer :: pfti(:) ! beginning pft index for landunit + integer , pointer :: pftf(:) ! ending pft index for landunit + + real(r8), pointer :: taf(:) ! urban canopy air temperature (K) + real(r8), pointer :: qaf(:) ! urban canopy air specific humidity (kg/kg) + integer , pointer :: npfts(:) ! landunit's number of pfts (columns) + real(r8), pointer :: t_grnd(:) ! ground surface temperature (K) + real(r8), pointer :: qg(:) ! specific humidity at ground surface (kg/kg) + real(r8), pointer :: htvp(:) ! latent heat of evaporation (/sublimation) (J/kg) + real(r8), pointer :: dqgdT(:) ! temperature derivative of "qg" + real(r8), pointer :: eflx_traffic(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_traffic_factor(:) ! multiplicative urban traffic factor for sensible heat flux + real(r8), pointer :: eflx_wasteheat(:) ! sensible heat flux from urban heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac(:) ! sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: t_soisno(:,:) ! soil temperature (K) + real(r8), pointer :: eflx_urban_ac(:) ! urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat(:) ! urban heating flux (W/m**2) + real(r8), pointer :: londeg(:) ! longitude (degrees) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: rootr_road_perv(:,:) ! effective fraction of roots in each soil layer for urban pervious road + real(r8), pointer :: soilalpha_u(:) ! Urban factor that reduces ground saturated specific humidity (-) +! +! local pointers to original implicit out arguments +! + real(r8), pointer :: dlrad(:) ! downward longwave radiation below the canopy (W/m**2) + real(r8), pointer :: ulrad(:) ! upward longwave radiation above the canopy (W/m**2) + real(r8), pointer :: cgrnds(:) ! deriv, of soil sensible heat flux wrt soil temp (W/m**2/K) + real(r8), pointer :: cgrndl(:) ! deriv of soil latent heat flux wrt soil temp (W/m**2/K) + real(r8), pointer :: cgrnd(:) ! deriv. of soil energy flux wrt to soil temp (W/m**2/K) + real(r8), pointer :: taux(:) ! wind (shear) stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy(:) ! wind (shear) stress: n-s (kg/m/s**2) + real(r8), pointer :: eflx_sh_grnd(:) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot(:) ! total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u(:) ! urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: qflx_evap_soi(:) ! soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg(:) ! vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_veg(:) ! vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot(:) ! qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (K) + real(r8), pointer :: q_ref2m(:) ! 2 m height surface specific humidity (kg/kg) + real(r8), pointer :: t_ref2m_u(:) ! Urban 2 m height surface air temperature (K) + real(r8), pointer :: t_veg(:) ! vegetation temperature (K) + real(r8), pointer :: ram1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: rootr(:,:) ! effective fraction of roots in each soil layer + real(r8), pointer :: psnsun(:) ! sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) ! shaded leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: t_building(:) ! internal building temperature (K) + real(r8), pointer :: rh_ref2m(:) ! 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_u(:) ! Urban 2 m height surface relative humidity (%) +! +! +! !OTHER LOCAL VARIABLES +!EOP +! + character(len=*), parameter :: sub="UrbanFluxes" + integer :: fp,fc,fl,f,p,c,l,g,j,pi,i ! indices + + real(r8) :: canyontop_wind(num_urbanl) ! wind at canyon top (m/s) + real(r8) :: canyon_u_wind(num_urbanl) ! u-component of wind speed inside canyon (m/s) + real(r8) :: canyon_wind(num_urbanl) ! net wind speed inside canyon (m/s) + real(r8) :: canyon_resistance(num_urbanl) ! resistance to heat and moisture transfer from canyon road/walls to canyon air (s/m) + + real(r8) :: ur(lbl:ubl) ! wind speed at reference height (m/s) + real(r8) :: ustar(lbl:ubl) ! friction velocity (m/s) + real(r8) :: ramu(lbl:ubl) ! aerodynamic resistance (s/m) + real(r8) :: rahu(lbl:ubl) ! thermal resistance (s/m) + real(r8) :: rawu(lbl:ubl) ! moisture resistance (s/m) + real(r8) :: temp1(lbl:ubl) ! relation for potential temperature profile + real(r8) :: temp12m(lbl:ubl) ! relation for potential temperature profile applied at 2-m + real(r8) :: temp2(lbl:ubl) ! relation for specific humidity profile + real(r8) :: temp22m(lbl:ubl) ! relation for specific humidity profile applied at 2-m + real(r8) :: thm_g(lbl:ubl) ! intermediate variable (forc_t+0.0098*forc_hgt_t) + real(r8) :: thv_g(lbl:ubl) ! virtual potential temperature (K) + real(r8) :: dth(lbl:ubl) ! diff of virtual temp. between ref. height and surface + real(r8) :: dqh(lbl:ubl) ! diff of humidity between ref. height and surface + real(r8) :: zldis(lbl:ubl) ! reference height "minus" zero displacement height (m) + real(r8) :: um(lbl:ubl) ! wind speed including the stablity effect (m/s) + real(r8) :: obu(lbl:ubl) ! Monin-Obukhov length (m) + real(r8) :: taf_numer(lbl:ubl) ! numerator of taf equation (K m/s) + real(r8) :: taf_denom(lbl:ubl) ! denominator of taf equation (m/s) + real(r8) :: qaf_numer(lbl:ubl) ! numerator of qaf equation (kg m/kg s) + real(r8) :: qaf_denom(lbl:ubl) ! denominator of qaf equation (m/s) + real(r8) :: wtas(lbl:ubl) ! sensible heat conductance for urban air to atmospheric air (m/s) + real(r8) :: wtaq(lbl:ubl) ! latent heat conductance for urban air to atmospheric air (m/s) + real(r8) :: wts_sum(lbl:ubl) ! sum of wtas, wtus_roof, wtus_road_perv, wtus_road_imperv, wtus_sunwall, wtus_shadewall + real(r8) :: wtq_sum(lbl:ubl) ! sum of wtaq, wtuq_roof, wtuq_road_perv, wtuq_road_imperv, wtuq_sunwall, wtuq_shadewall + real(r8) :: beta(lbl:ubl) ! coefficient of convective velocity + real(r8) :: zii(lbl:ubl) ! convective boundary layer height (m) + + real(r8) :: fm(lbl:ubl) ! needed for BGC only to diagnose 10m wind speed + + real(r8) :: wtus(lbc:ubc) ! sensible heat conductance for urban columns (m/s) + real(r8) :: wtuq(lbc:ubc) ! latent heat conductance for urban columns (m/s) + + integer :: iter ! iteration index + real(r8) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(r8) :: tstar ! temperature scaling parameter + real(r8) :: qstar ! moisture scaling parameter + real(r8) :: thvstar ! virtual potential temperature scaling parameter + real(r8) :: wtus_roof(lbl:ubl) ! sensible heat conductance for roof (not scaled) (m/s) + real(r8) :: wtuq_roof(lbl:ubl) ! latent heat conductance for roof (not scaled) (m/s) + real(r8) :: wtus_road_perv(lbl:ubl) ! sensible heat conductance for pervious road (not scaled) (m/s) + real(r8) :: wtuq_road_perv(lbl:ubl) ! latent heat conductance for pervious road (not scaled) (m/s) + real(r8) :: wtus_road_imperv(lbl:ubl) ! sensible heat conductance for impervious road (not scaled) (m/s) + real(r8) :: wtuq_road_imperv(lbl:ubl) ! latent heat conductance for impervious road (not scaled) (m/s) + real(r8) :: wtus_sunwall(lbl:ubl) ! sensible heat conductance for sunwall (not scaled) (m/s) + real(r8) :: wtuq_sunwall(lbl:ubl) ! latent heat conductance for sunwall (not scaled) (m/s) + real(r8) :: wtus_shadewall(lbl:ubl) ! sensible heat conductance for shadewall (not scaled) (m/s) + real(r8) :: wtuq_shadewall(lbl:ubl) ! latent heat conductance for shadewall (not scaled) (m/s) + real(r8) :: t_sunwall_innerl(lbl:ubl) ! temperature of inner layer of sunwall (K) + real(r8) :: t_shadewall_innerl(lbl:ubl) ! temperature of inner layer of shadewall (K) + real(r8) :: t_roof_innerl(lbl:ubl) ! temperature of inner layer of roof (K) + real(r8) :: lngth_roof ! length of roof (m) + real(r8) :: wc ! convective velocity (m/s) + real(r8) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(r8) :: eflx_sh_grnd_scale(lbp:ubp) ! scaled sensible heat flux from ground (W/m**2) [+ to atm] + real(r8) :: qflx_evap_soi_scale(lbp:ubp) ! scaled soil evaporation (mm H2O/s) (+ = to atm) + real(r8) :: eflx_wasteheat_roof(lbl:ubl) ! sensible heat flux from urban heating/cooling sources of waste heat for roof (W/m**2) + real(r8) :: eflx_wasteheat_sunwall(lbl:ubl) ! sensible heat flux from urban heating/cooling sources of waste heat for sunwall (W/m**2) + real(r8) :: eflx_wasteheat_shadewall(lbl:ubl) ! sensible heat flux from urban heating/cooling sources of waste heat for shadewall (W/m**2) + real(r8) :: eflx_heat_from_ac_roof(lbl:ubl) ! sensible heat flux put back into canyon due to heat removal by AC for roof (W/m**2) + real(r8) :: eflx_heat_from_ac_sunwall(lbl:ubl) ! sensible heat flux put back into canyon due to heat removal by AC for sunwall (W/m**2) + real(r8) :: eflx_heat_from_ac_shadewall(lbl:ubl) ! sensible heat flux put back into canyon due to heat removal by AC for shadewall (W/m**2) + real(r8) :: eflx(lbl:ubl) ! total sensible heat flux for error check (W/m**2) + real(r8) :: qflx(lbl:ubl) ! total water vapor flux for error check (kg/m**2/s) + real(r8) :: eflx_scale(lbl:ubl) ! sum of scaled sensible heat fluxes for urban columns for error check (W/m**2) + real(r8) :: qflx_scale(lbl:ubl) ! sum of scaled water vapor fluxes for urban columns for error check (kg/m**2/s) + real(r8) :: eflx_err(lbl:ubl) ! sensible heat flux error (W/m**2) + real(r8) :: qflx_err(lbl:ubl) ! water vapor flux error (kg/m**2/s) + real(r8) :: fwet_roof ! fraction of roof surface that is wet (-) + real(r8) :: fwet_road_imperv ! fraction of impervious road surface that is wet (-) + + integer, parameter :: niters = 3 ! maximum number of iterations for surface temperature + integer :: local_secp1(lbl:ubl) ! seconds into current date in local time (sec) + real(r8) :: dtime ! land model time step (sec) + integer :: year,month,day,secs ! calendar info for current time step + logical :: found ! flag in search loop + integer :: indexl ! index of first found in search loop + integer :: nstep ! time step number + real(r8) :: z_d_town_loc(lbl:ubl) ! temporary copy + real(r8) :: z_0_town_loc(lbl:ubl) ! temporary copy + real(r8), parameter :: lapse_rate = 0.0098_r8 ! Dry adiabatic lapse rate (K/m) + real(r8) :: e_ref2m ! 2 m height surface saturated vapor pressure [Pa] + real(r8) :: de2mdT ! derivative of 2 m height surface saturated vapor pressure on t_ref2m + real(r8) :: qsat_ref2m ! 2 m height surface saturated specific humidity [kg/kg] + real(r8) :: dqsat2mdT ! derivative of 2 m height surface saturated specific humidity on t_ref2m + +!----------------------------------------------------------------------- + + ! Assign pointers into module urban clumps + + if ( num_urbanl > 0 )then + ht_roof => urban_clump(nc)%ht_roof + wtlunit_roof => urban_clump(nc)%wtlunit_roof + canyon_hwr => urban_clump(nc)%canyon_hwr + wtroad_perv => urban_clump(nc)%wtroad_perv + wind_hgt_canyon => urban_clump(nc)%wind_hgt_canyon + end if + + ! Assign local pointers to multi-level derived type members (gridcell level) + + forc_t => clm_a2l%forc_t + forc_th => clm_a2l%forc_th + forc_u => clm_a2l%forc_u + forc_v => clm_a2l%forc_v + forc_rho => clm_a2l%forc_rho + forc_q => clm_a2l%forc_q + forc_pbot => clm_a2l%forc_pbot + londeg => grc%londeg + + ! Assign local pointers to derived type members (landunit level) + + pfti => lun%pfti + pftf => lun%pftf + coli => lun%coli + colf => lun%colf + lgridcell => lun%gridcell + z_0_town => lun%z_0_town + z_d_town => lun%z_d_town + taf => lps%taf + qaf => lps%qaf + npfts => lun%npfts + eflx_traffic => lef%eflx_traffic + eflx_traffic_factor => lef%eflx_traffic_factor + eflx_wasteheat => lef%eflx_wasteheat + eflx_heat_from_ac => lef%eflx_heat_from_ac + t_building => lps%t_building + + ! Assign local pointers to derived type members (column level) + + ctype => col%itype + t_grnd => ces%t_grnd + qg => cws%qg + htvp => cps%htvp + dqgdT => cws%dqgdT + t_soisno => ces%t_soisno + eflx_urban_ac => cef%eflx_urban_ac + eflx_urban_heat => cef%eflx_urban_heat + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + frac_sno => cps%frac_sno + snowdp => cps%snowdp + h2osno => cws%h2osno + snl => cps%snl + rootr_road_perv => cps%rootr_road_perv + soilalpha_u => cws%soilalpha_u + + ! Assign local pointers to derived type members (pft level) + + pgridcell => pft%gridcell + pcolumn => pft%column + plandunit => pft%landunit + ram1 => pps%ram1 + dlrad => pef%dlrad + ulrad => pef%ulrad + cgrnds => pef%cgrnds + cgrndl => pef%cgrndl + cgrnd => pef%cgrnd + taux => pmf%taux + tauy => pmf%tauy + eflx_sh_grnd => pef%eflx_sh_grnd + eflx_sh_tot => pef%eflx_sh_tot + eflx_sh_tot_u => pef%eflx_sh_tot_u + qflx_evap_soi => pwf%qflx_evap_soi + qflx_tran_veg => pwf%qflx_tran_veg + qflx_evap_veg => pwf%qflx_evap_veg + qflx_evap_tot => pwf%qflx_evap_tot + t_ref2m => pes%t_ref2m + q_ref2m => pes%q_ref2m + t_ref2m_u => pes%t_ref2m_u + t_veg => pes%t_veg + rootr => pps%rootr + psnsun => pcf%psnsun + psnsha => pcf%psnsha + forc_hgt_u_pft => pps%forc_hgt_u_pft + forc_hgt_t_pft => pps%forc_hgt_t_pft + forc_hgt_u_pft => pps%forc_hgt_u_pft + forc_hgt_t_pft => pps%forc_hgt_t_pft + rh_ref2m => pes%rh_ref2m + rh_ref2m_u => pes%rh_ref2m_u + + ! Define fields that appear on the restart file for non-urban landunits + + do fl = 1,num_nourbanl + l = filter_nourbanl(fl) + taf(l) = spval + qaf(l) = spval + end do + + ! Get time step + nstep = get_nstep() + + ! Set constants (same as in Biogeophysics1Mod) + beta(:) = 1._r8 ! Should be set to the same values as in Biogeophysics1Mod + zii(:) = 1000._r8 ! Should be set to the same values as in Biogeophysics1Mod + + ! Get current date + dtime = get_step_size() + call get_curr_date (year, month, day, secs) + + ! Compute canyontop wind using Masson (2000) + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + local_secp1(l) = secs + nint((londeg(g)/degpsec)/dtime)*dtime + local_secp1(l) = mod(local_secp1(l),isecspday) + + ! Error checks + + if (ht_roof(fl) - z_d_town(l) <= z_0_town(l)) then + write (iulog,*) 'aerodynamic parameter error in UrbanFluxes' + write (iulog,*) 'h_r - z_d <= z_0' + write (iulog,*) 'ht_roof, z_d_town, z_0_town: ', ht_roof(fl), z_d_town(l), & + z_0_town(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + if (forc_hgt_u_pft(pfti(l)) - z_d_town(l) <= z_0_town(l)) then + write (iulog,*) 'aerodynamic parameter error in UrbanFluxes' + write (iulog,*) 'h_u - z_d <= z_0' + write (iulog,*) 'forc_hgt_u_pft, z_d_town, z_0_town: ', forc_hgt_u_pft(pfti(l)), z_d_town(l), & + z_0_town(l) + write (iulog,*) 'clm model is stopping' + call endrun() + end if + + ! Magnitude of atmospheric wind + + ur(l) = max(1.0_r8,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + + ! Canyon top wind + + canyontop_wind(fl) = ur(l) * & + log( (ht_roof(fl)-z_d_town(l)) / z_0_town(l) ) / & + log( (forc_hgt_u_pft(pfti(l))-z_d_town(l)) / z_0_town(l) ) + + ! U component of canyon wind + + if (canyon_hwr(fl) < 0.5_r8) then ! isolated roughness flow + canyon_u_wind(fl) = canyontop_wind(fl) * exp( -0.5_r8*canyon_hwr(fl)* & + (1._r8-(wind_hgt_canyon(fl)/ht_roof(fl))) ) + else if (canyon_hwr(fl) < 1.0_r8) then ! wake interference flow + canyon_u_wind(fl) = canyontop_wind(fl) * (1._r8+2._r8*(2._r8/rpi - 1._r8)* & + (ht_roof(fl)/(ht_roof(fl)/canyon_hwr(fl)) - 0.5_r8)) * & + exp(-0.5_r8*canyon_hwr(fl)*(1._r8-(wind_hgt_canyon(fl)/ht_roof(fl)))) + else ! skimming flow + canyon_u_wind(fl) = canyontop_wind(fl) * (2._r8/rpi) * & + exp(-0.5_r8*canyon_hwr(fl)*(1._r8-(wind_hgt_canyon(fl)/ht_roof(fl)))) + end if + + end do + +! Compute fluxes - Follows CLM approach for bare soils (Oleson et al 2004) + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + thm_g(l) = forc_t(g) + lapse_rate*forc_hgt_t_pft(pfti(l)) + thv_g(l) = forc_th(g)*(1._r8+0.61_r8*forc_q(g)) + dth(l) = thm_g(l)-taf(l) + dqh(l) = forc_q(g)-qaf(l) + dthv = dth(l)*(1._r8+0.61_r8*forc_q(g))+0.61_r8*forc_th(g)*dqh(l) + zldis(l) = forc_hgt_u_pft(pfti(l)) - z_d_town(l) + + ! Initialize Monin-Obukhov length and wind speed including convective velocity + + call MoninObukIni(ur(l), thv_g(l), dthv, zldis(l), z_0_town(l), um(l), obu(l)) + + end do + + ! Initialize conductances + wtus_roof(:) = 0._r8 + wtus_road_perv(:) = 0._r8 + wtus_road_imperv(:) = 0._r8 + wtus_sunwall(:) = 0._r8 + wtus_shadewall(:) = 0._r8 + wtuq_roof(:) = 0._r8 + wtuq_road_perv(:) = 0._r8 + wtuq_road_imperv(:) = 0._r8 + wtuq_sunwall(:) = 0._r8 + wtuq_shadewall(:) = 0._r8 + + ! Make copies so that array sections are not passed in function calls to friction velocity + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + z_d_town_loc(l) = z_d_town(l) + z_0_town_loc(l) = z_0_town(l) + end do + + ! Start stability iteration + + do iter = 1,niters + + ! Get friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + + if (num_urbanl .gt. 0) then + call FrictionVelocity(lbl, ubl, num_urbanl, filter_urbanl, & + z_d_town_loc, z_0_town_loc, z_0_town_loc, z_0_town_loc, & + obu, iter, ur, um, ustar, & + temp1, temp2, temp12m, temp22m, fm, landunit_index=.true.) + end if + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + ! Determine aerodynamic resistance to fluxes from urban canopy air to + ! atmosphere + + ramu(l) = 1._r8/(ustar(l)*ustar(l)/um(l)) + rahu(l) = 1._r8/(temp1(l)*ustar(l)) + rawu(l) = 1._r8/(temp2(l)*ustar(l)) + + ! Determine magnitude of canyon wind by using horizontal wind determined + ! previously and vertical wind from friction velocity (Masson 2000) + + canyon_wind(fl) = sqrt(canyon_u_wind(fl)**2._r8 + ustar(l)**2._r8) + + ! Determine canyon_resistance (currently this single resistance determines the + ! resistance from urban surfaces (roof, pervious and impervious road, sunlit and + ! shaded walls) to urban canopy air, since it is only dependent on wind speed + ! Also from Masson 2000. + + canyon_resistance(fl) = cpair * forc_rho(g) / (11.8_r8 + 4.2_r8*canyon_wind(fl)) + + end do + + ! This is the first term in the equation solutions for urban canopy air temperature + ! and specific humidity (numerator) and is a landunit quantity + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + taf_numer(l) = thm_g(l)/rahu(l) + taf_denom(l) = 1._r8/rahu(l) + qaf_numer(l) = forc_q(g)/rawu(l) + qaf_denom(l) = 1._r8/rawu(l) + + ! First term needed for derivative of heat fluxes + wtas(l) = 1._r8/rahu(l) + wtaq(l) = 1._r8/rawu(l) + + end do + + + ! Gather other terms for other urban columns for numerator and denominator of + ! equations for urban canopy air temperature and specific humidity + + do pi = 1,maxpatch_urb + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if ( pi <= npfts(l) ) then + c = coli(l) + pi - 1 + + if (ctype(c) == icol_roof) then + + ! scaled sensible heat conductance + wtus(c) = wtlunit_roof(fl)/canyon_resistance(fl) + ! unscaled sensible heat conductance + wtus_roof(l) = 1._r8/canyon_resistance(fl) + + if (snowdp(c) > 0._r8) then + fwet_roof = min(snowdp(c)/0.05_r8, 1._r8) + else + fwet_roof = (max(0._r8, h2osoi_liq(c,1)+h2osoi_ice(c,1))/pondmx_urban)**0.666666666666_r8 + fwet_roof = min(fwet_roof,1._r8) + end if + if (qaf(l) > qg(c)) then + fwet_roof = 1._r8 + end if + ! scaled latent heat conductance + wtuq(c) = fwet_roof*(wtlunit_roof(fl)/canyon_resistance(fl)) + ! unscaled latent heat conductance + wtuq_roof(l) = fwet_roof*(1._r8/canyon_resistance(fl)) + + ! wasteheat from heating/cooling + if (trim(urban_hac) == urban_wasteheat_on) then + eflx_wasteheat_roof(l) = ac_wasteheat_factor * eflx_urban_ac(c) + & + ht_wasteheat_factor * eflx_urban_heat(c) + else + eflx_wasteheat_roof(l) = 0._r8 + end if + + ! If air conditioning on, always replace heat removed with heat into canyon + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + eflx_heat_from_ac_roof(l) = abs(eflx_urban_ac(c)) + else + eflx_heat_from_ac_roof(l) = 0._r8 + end if + + else if (ctype(c) == icol_road_perv) then + + ! scaled sensible heat conductance + wtus(c) = wtroad_perv(fl)*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled sensible heat conductance + if (wtroad_perv(fl) > 0._r8) then + wtus_road_perv(l) = 1._r8/canyon_resistance(fl) + else + wtus_road_perv(l) = 0._r8 + end if + + ! scaled latent heat conductance + wtuq(c) = wtroad_perv(fl)*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled latent heat conductance + if (wtroad_perv(fl) > 0._r8) then + wtuq_road_perv(l) = 1._r8/canyon_resistance(fl) + else + wtuq_road_perv(l) = 0._r8 + end if + + else if (ctype(c) == icol_road_imperv) then + + ! scaled sensible heat conductance + wtus(c) = (1._r8-wtroad_perv(fl))*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled sensible heat conductance + if ((1._r8-wtroad_perv(fl)) > 0._r8) then + wtus_road_imperv(l) = 1._r8/canyon_resistance(fl) + else + wtus_road_imperv(l) = 0._r8 + end if + + if (snowdp(c) > 0._r8) then + fwet_road_imperv = min(snowdp(c)/0.05_r8, 1._r8) + else + fwet_road_imperv = (max(0._r8, h2osoi_liq(c,1)+h2osoi_ice(c,1))/pondmx_urban)**0.666666666666_r8 + fwet_road_imperv = min(fwet_road_imperv,1._r8) + end if + if (qaf(l) > qg(c)) then + fwet_road_imperv = 1._r8 + end if + ! scaled latent heat conductance + wtuq(c) = fwet_road_imperv*(1._r8-wtroad_perv(fl))*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled latent heat conductance + if ((1._r8-wtroad_perv(fl)) > 0._r8) then + wtuq_road_imperv(l) = fwet_road_imperv*(1._r8/canyon_resistance(fl)) + else + wtuq_road_imperv(l) = 0._r8 + end if + + else if (ctype(c) == icol_sunwall) then + + ! scaled sensible heat conductance + wtus(c) = canyon_hwr(fl)*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled sensible heat conductance + wtus_sunwall(l) = 1._r8/canyon_resistance(fl) + + ! scaled latent heat conductance + wtuq(c) = 0._r8 + ! unscaled latent heat conductance + wtuq_sunwall(l) = 0._r8 + + ! wasteheat from heating/cooling + if (trim(urban_hac) == urban_wasteheat_on) then + eflx_wasteheat_sunwall(l) = ac_wasteheat_factor * eflx_urban_ac(c) + & + ht_wasteheat_factor * eflx_urban_heat(c) + else + eflx_wasteheat_sunwall(l) = 0._r8 + end if + + ! If air conditioning on, always replace heat removed with heat into canyon + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + eflx_heat_from_ac_sunwall(l) = abs(eflx_urban_ac(c)) + else + eflx_heat_from_ac_sunwall(l) = 0._r8 + end if + + else if (ctype(c) == icol_shadewall) then + + ! scaled sensible heat conductance + wtus(c) = canyon_hwr(fl)*(1._r8-wtlunit_roof(fl))/canyon_resistance(fl) + ! unscaled sensible heat conductance + wtus_shadewall(l) = 1._r8/canyon_resistance(fl) + + ! scaled latent heat conductance + wtuq(c) = 0._r8 + ! unscaled latent heat conductance + wtuq_shadewall(l) = 0._r8 + + ! wasteheat from heating/cooling + if (trim(urban_hac) == urban_wasteheat_on) then + eflx_wasteheat_shadewall(l) = ac_wasteheat_factor * eflx_urban_ac(c) + & + ht_wasteheat_factor * eflx_urban_heat(c) + else + eflx_wasteheat_shadewall(l) = 0._r8 + end if + + ! If air conditioning on, always replace heat removed with heat into canyon + if (trim(urban_hac) == urban_hac_on .or. trim(urban_hac) == urban_wasteheat_on) then + eflx_heat_from_ac_shadewall(l) = abs(eflx_urban_ac(c)) + else + eflx_heat_from_ac_shadewall(l) = 0._r8 + end if + else + write(iulog,*) 'c, ctype, pi = ', c, ctype(c), pi + write(iulog,*) 'Column indices for: shadewall, sunwall, road_imperv, road_perv, roof: ' + write(iulog,*) icol_shadewall, icol_sunwall, icol_road_imperv, icol_road_perv, icol_roof + call endrun( sub//':: ERROR, ctype out of range' ) + end if + + taf_numer(l) = taf_numer(l) + t_grnd(c)*wtus(c) + taf_denom(l) = taf_denom(l) + wtus(c) + qaf_numer(l) = qaf_numer(l) + qg(c)*wtuq(c) + qaf_denom(l) = qaf_denom(l) + wtuq(c) + + end if + end do + end do + + ! Calculate new urban canopy air temperature and specific humidity + + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + ! Total waste heat and heat from AC is sum of heat for walls and roofs + ! accounting for different surface areas + eflx_wasteheat(l) = wtlunit_roof(fl)*eflx_wasteheat_roof(l) + & + (1._r8-wtlunit_roof(fl))*(canyon_hwr(fl)*(eflx_wasteheat_sunwall(l) + & + eflx_wasteheat_shadewall(l))) + + ! Limit wasteheat to ensure that we don't get any unrealistically strong + ! positive feedbacks due to AC in a warmer climate + eflx_wasteheat(l) = min(eflx_wasteheat(l),wasteheat_limit) + + eflx_heat_from_ac(l) = wtlunit_roof(fl)*eflx_heat_from_ac_roof(l) + & + (1._r8-wtlunit_roof(fl))*(canyon_hwr(fl)*(eflx_heat_from_ac_sunwall(l) + & + eflx_heat_from_ac_shadewall(l))) + + ! Calculate traffic heat flux + ! Only comes from impervious road + eflx_traffic(l) = (1._r8-wtlunit_roof(fl))*(1._r8-wtroad_perv(fl))* & + eflx_traffic_factor(l) + + taf(l) = taf_numer(l)/taf_denom(l) + qaf(l) = qaf_numer(l)/qaf_denom(l) + + wts_sum(l) = wtas(l) + wtus_roof(l) + wtus_road_perv(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l) + + wtq_sum(l) = wtaq(l) + wtuq_roof(l) + wtuq_road_perv(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l) + + end do + + ! This section of code is not required if niters = 1 + ! Determine stability using new taf and qaf + ! TODO: Some of these constants replicate what is in FrictionVelocity and BareGround fluxes should consildate. EBK + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + + dth(l) = thm_g(l)-taf(l) + dqh(l) = forc_q(g)-qaf(l) + tstar = temp1(l)*dth(l) + qstar = temp2(l)*dqh(l) + thvstar = tstar*(1._r8+0.61_r8*forc_q(g)) + 0.61_r8*forc_th(g)*qstar + zeta = zldis(l)*vkc*grav*thvstar/(ustar(l)**2*thv_g(l)) + + if (zeta >= 0._r8) then !stable + zeta = min(2._r8,max(zeta,0.01_r8)) + um(l) = max(ur(l),0.1_r8) + else !unstable + zeta = max(-100._r8,min(zeta,-0.01_r8)) + wc = beta(l)*(-grav*ustar(l)*thvstar*zii(l)/thv_g(l))**0.333_r8 + um(l) = sqrt(ur(l)*ur(l) + wc*wc) + end if + + obu(l) = zldis(l)/zeta + end do + + end do ! end iteration + +! Determine fluxes from canyon surfaces + + do f = 1, num_urbanp + + p = filter_urbanp(f) + c = pcolumn(p) + g = pgridcell(p) + l = plandunit(p) + + ram1(p) = ramu(l) !pass value to global variable + + ! Upward and downward canopy longwave are zero + + ulrad(p) = 0._r8 + dlrad(p) = 0._r8 + + ! Derivative of sensible and latent heat fluxes with respect to + ! ground temperature + + if (ctype(c) == icol_roof) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_road_perv(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_roof(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_road_perv(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_roof(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_road_perv) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_imperv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_road_perv(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_roof(l) + & + wtuq_road_imperv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_road_perv(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_road_imperv) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_sunwall(l) + wtus_shadewall(l)) * & + (wtus_road_imperv(l)/wts_sum(l)) + cgrndl(p) = forc_rho(g) * (wtaq(l) + wtuq_roof(l) + & + wtuq_road_perv(l) + wtuq_sunwall(l) + wtuq_shadewall(l)) * & + (wtuq_road_imperv(l)/wtq_sum(l))*dqgdT(c) + else if (ctype(c) == icol_sunwall) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_road_imperv(l) + wtus_shadewall(l)) * & + (wtus_sunwall(l)/wts_sum(l)) + cgrndl(p) = 0._r8 + else if (ctype(c) == icol_shadewall) then + cgrnds(p) = forc_rho(g) * cpair * (wtas(l) + wtus_roof(l) + & + wtus_road_perv(l) + wtus_road_imperv(l) + wtus_sunwall(l)) * & + (wtus_shadewall(l)/wts_sum(l)) + cgrndl(p) = 0._r8 + end if + cgrnd(p) = cgrnds(p) + cgrndl(p)*htvp(c) + + ! Surface fluxes of momentum, sensible and latent heat + + taux(p) = -forc_rho(g)*forc_u(g)/ramu(l) + tauy(p) = -forc_rho(g)*forc_v(g)/ramu(l) + + ! Use new canopy air temperature + dth(l) = taf(l) - t_grnd(c) + + if (ctype(c) == icol_roof) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_roof(l)*dth(l) + else if (ctype(c) == icol_road_perv) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_road_perv(l)*dth(l) + else if (ctype(c) == icol_road_imperv) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_road_imperv(l)*dth(l) + else if (ctype(c) == icol_sunwall) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_sunwall(l)*dth(l) + else if (ctype(c) == icol_shadewall) then + eflx_sh_grnd(p) = -forc_rho(g)*cpair*wtus_shadewall(l)*dth(l) + end if + + eflx_sh_tot(p) = eflx_sh_grnd(p) + eflx_sh_tot_u(p) = eflx_sh_tot(p) + + dqh(l) = qaf(l) - qg(c) + + if (ctype(c) == icol_roof) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_roof(l)*dqh(l) + else if (ctype(c) == icol_road_perv) then + ! Evaporation assigned to soil term if dew or snow + ! or if no liquid water available in soil column + if (dqh(l) > 0._r8 .or. frac_sno(c) > 0._r8 .or. soilalpha_u(c) .le. 0._r8) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_road_perv(l)*dqh(l) + qflx_tran_veg(p) = 0._r8 + ! Otherwise, evaporation assigned to transpiration term + else + qflx_evap_soi(p) = 0._r8 + qflx_tran_veg(p) = -forc_rho(g)*wtuq_road_perv(l)*dqh(l) + end if + qflx_evap_veg(p) = qflx_tran_veg(p) + else if (ctype(c) == icol_road_imperv) then + qflx_evap_soi(p) = -forc_rho(g)*wtuq_road_imperv(l)*dqh(l) + else if (ctype(c) == icol_sunwall) then + qflx_evap_soi(p) = 0._r8 + else if (ctype(c) == icol_shadewall) then + qflx_evap_soi(p) = 0._r8 + end if + + ! SCALED sensible and latent heat flux for error check + eflx_sh_grnd_scale(p) = -forc_rho(g)*cpair*wtus(c)*dth(l) + qflx_evap_soi_scale(p) = -forc_rho(g)*wtuq(c)*dqh(l) + + end do + + ! Check to see that total sensible and latent heat equal the sum of + ! the scaled heat fluxes above + do fl = 1, num_urbanl + l = filter_urbanl(fl) + g = lgridcell(l) + eflx(l) = -(forc_rho(g)*cpair/rahu(l))*(thm_g(l) - taf(l)) + qflx(l) = -(forc_rho(g)/rawu(l))*(forc_q(g) - qaf(l)) + eflx_scale(l) = sum(eflx_sh_grnd_scale(pfti(l):pftf(l))) + qflx_scale(l) = sum(qflx_evap_soi_scale(pfti(l):pftf(l))) + eflx_err(l) = eflx_scale(l) - eflx(l) + qflx_err(l) = qflx_scale(l) - qflx(l) + end do + + found = .false. + do fl = 1, num_urbanl + l = filter_urbanl(fl) + if (abs(eflx_err(l)) > 0.01_r8) then + found = .true. + indexl = l + exit + end if + end do + if ( found ) then + write(iulog,*)'WARNING: Total sensible heat does not equal sum of scaled heat fluxes for urban columns ',& + ' nstep = ',nstep,' indexl= ',indexl,' eflx_err= ',eflx_err(indexl) + if (abs(eflx_err(indexl)) > .01_r8) then + write(iulog,*)'clm model is stopping - error is greater than .01 W/m**2' + write(iulog,*)'eflx_scale = ',eflx_scale(indexl) + write(iulog,*)'eflx_sh_grnd_scale: ',eflx_sh_grnd_scale(pfti(indexl):pftf(indexl)) + write(iulog,*)'eflx = ',eflx(indexl) + call endrun + end if + end if + + found = .false. + do fl = 1, num_urbanl + l = filter_urbanl(fl) + ! 4.e-9 kg/m**2/s = 0.01 W/m**2 + if (abs(qflx_err(l)) > 4.e-9_r8) then + found = .true. + indexl = l + exit + end if + end do + if ( found ) then + write(iulog,*)'WARNING: Total water vapor flux does not equal sum of scaled water vapor fluxes for urban columns ',& + ' nstep = ',nstep,' indexl= ',indexl,' qflx_err= ',qflx_err(indexl) + if (abs(qflx_err(indexl)) > 4.e-9_r8) then + write(iulog,*)'clm model is stopping - error is greater than 4.e-9 kg/m**2/s' + write(iulog,*)'qflx_scale = ',qflx_scale(indexl) + write(iulog,*)'qflx = ',qflx(indexl) + call endrun + end if + end if + + ! Gather terms required to determine internal building temperature + + do pi = 1,maxpatch_urb + do fl = 1,num_urbanl + l = filter_urbanl(fl) + if ( pi <= npfts(l) ) then + c = coli(l) + pi - 1 + + if (ctype(c) == icol_roof) then + t_roof_innerl(l) = t_soisno(c,nlevurb) + else if (ctype(c) == icol_sunwall) then + t_sunwall_innerl(l) = t_soisno(c,nlevurb) + else if (ctype(c) == icol_shadewall) then + t_shadewall_innerl(l) = t_soisno(c,nlevurb) + end if + + end if + end do + end do + + ! Calculate internal building temperature + do fl = 1, num_urbanl + l = filter_urbanl(fl) + + lngth_roof = (ht_roof(fl)/canyon_hwr(fl))*wtlunit_roof(fl)/(1._r8-wtlunit_roof(fl)) + t_building(l) = (ht_roof(fl)*(t_shadewall_innerl(l) + t_sunwall_innerl(l)) & + +lngth_roof*t_roof_innerl(l))/(2._r8*ht_roof(fl)+lngth_roof) + end do + + ! No roots for urban except for pervious road + + do j = 1, nlevurb + do f = 1, num_urbanp + p = filter_urbanp(f) + c = pcolumn(p) + if (ctype(c) == icol_road_perv) then + rootr(p,j) = rootr_road_perv(c,j) + else + rootr(p,j) = 0._r8 + end if + end do + end do + + do f = 1, num_urbanp + + p = filter_urbanp(f) + c = pcolumn(p) + g = pgridcell(p) + l = plandunit(p) + + ! Use urban canopy air temperature and specific humidity to represent + ! 2-m temperature and humidity + + t_ref2m(p) = taf(l) + q_ref2m(p) = qaf(l) + t_ref2m_u(p) = taf(l) + + ! 2 m height relative humidity + + call QSat(t_ref2m(p), forc_pbot(g), e_ref2m, de2mdT, qsat_ref2m, dqsat2mdT) + rh_ref2m(p) = min(100._r8, q_ref2m(p) / qsat_ref2m * 100._r8) + rh_ref2m_u(p) = rh_ref2m(p) + + ! Variables needed by history tape + + t_veg(p) = forc_t(g) + + ! Add the following to avoid NaN + + psnsun(p) = 0._r8 + psnsha(p) = 0._r8 + pps%lncsun(p) = 0._r8 + pps%lncsha(p) = 0._r8 + pps%vcmxsun(p) = 0._r8 + pps%vcmxsha(p) = 0._r8 + + end do + + end subroutine UrbanFluxes + +end module UrbanMod diff --git a/components/clm/src_clm40/biogeophys/clm_driverInitMod.F90 b/components/clm/src_clm40/biogeophys/clm_driverInitMod.F90 new file mode 100644 index 0000000000..ac28ed9558 --- /dev/null +++ b/components/clm/src_clm40/biogeophys/clm_driverInitMod.F90 @@ -0,0 +1,247 @@ + +module clm_driverInitMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_driverInitMod +! +! !DESCRIPTION: +! Initialization of clm driver variables needed from previous timestep +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: clm_driverInit +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: clm_driverInit +! +! !INTERFACE: + subroutine clm_driverInit(lbc, ubc, lbp, ubp, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec) +! +! !DESCRIPTION: +! Initialization of clm driver variables needed from previous timestep +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_varpar , only : nlevsno + use subgridAveMod, only : p2c + use clm_varcon, only : h2osno_max, rair, cpair, grav, istice_mec, lapse_glcmec + use clm_atmlnd, only : clm_a2l + use domainMod, only : ldomain + use clmtype + use QsatMod, only : Qsat + +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column-index bounds + integer, intent(in) :: lbp, ubp ! pft-index bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: num_lakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_lakec(ubc-lbc+1) ! column filter for non-lake points +! +! !CALLED FROM: +! subroutine driver1 +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +! +! local pointers to original implicit in variables +! + real(r8), pointer :: pwtgcell(:) ! weight of pft wrt corresponding gridcell + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + integer , pointer :: frac_veg_nosno_alb(:) ! fraction of vegetation not covered by snow (0 OR 1) [-] + integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1 now) [-] (pft-level) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) +! +! local pointers to original implicit out variables +! + logical , pointer :: do_capsnow(:) ! true => do snow capping + real(r8), pointer :: h2osno_old(:) ! snow water (mm H2O) at previous time step + real(r8), pointer :: frac_iceold(:,:) ! fraction of ice relative to the tot water +! +! !OTHER LOCAL VARIABLES: +!EOP +! + integer :: g, l, c, p, f, j, fc ! indices + + real(r8), pointer :: qflx_glcice(:) ! flux of new glacier ice (mm H2O/s) [+ = ice grows] + real(r8), pointer :: eflx_bot(:) ! heat flux from beneath soil/ice column (W/m**2) + real(r8), pointer :: glc_topo(:) ! sfc elevation for glacier_mec column (m) + real(r8), pointer :: forc_t(:) ! atmospheric temperature (Kelvin) + real(r8), pointer :: forc_th(:) ! atmospheric potential temperature (Kelvin) + real(r8), pointer :: forc_q(:) ! atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_pbot(:) ! atmospheric pressure (Pa) + real(r8), pointer :: forc_rho(:) ! atmospheric density (kg/m**3) + integer , pointer :: cgridcell(:) ! column's gridcell + integer , pointer :: clandunit(:) ! column's landunit + integer , pointer :: plandunit(:) ! pft's landunit + integer , pointer :: ityplun(:) ! landunit type + + ! temporaries for topo downscaling + real(r8) :: hsurf_g,hsurf_c,Hbot + real(r8) :: zbot_g, tbot_g, pbot_g, thbot_g, qbot_g, qs_g, es_g + real(r8) :: zbot_c, tbot_c, pbot_c, thbot_c, qbot_c, qs_c, es_c + real(r8) :: egcm_c, rhos_c + real(r8) :: dum1, dum2 + +!----------------------------------------------------------------------- + + ! Assign local pointers to derived type members (landunit-level) + + ityplun => lun%itype + + ! Assign local pointers to derived type members (column-level) + + snl => cps%snl + h2osno => cws%h2osno + h2osno_old => cws%h2osno_old + do_capsnow => cps%do_capsnow + frac_iceold => cps%frac_iceold + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + frac_veg_nosno_alb => pps%frac_veg_nosno_alb + frac_veg_nosno => pps%frac_veg_nosno + qflx_glcice => cwf%qflx_glcice + eflx_bot => cef%eflx_bot + glc_topo => cps%glc_topo + forc_t => ces%forc_t + forc_th => ces%forc_th + forc_q => cws%forc_q + forc_pbot => cps%forc_pbot + forc_rho => cps%forc_rho + clandunit => col%landunit + cgridcell => col%gridcell + + ! Assign local pointers to derived type members (pft-level) + + pwtgcell => pft%wtgcell + plandunit => pft%landunit + + do c = lbc, ubc + + l = clandunit(c) + g = cgridcell(c) + + ! Initialize column forcing + + forc_t(c) = clm_a2l%forc_t(g) + forc_th(c) = clm_a2l%forc_th(g) + forc_q(c) = clm_a2l%forc_q(g) + forc_pbot(c) = clm_a2l%forc_pbot(g) + forc_rho(c) = clm_a2l%forc_rho(g) + + ! Save snow mass at previous time step + h2osno_old(c) = h2osno(c) + + ! Decide whether to cap snow + if (h2osno(c) > h2osno_max) then + do_capsnow(c) = .true. + else + do_capsnow(c) = .false. + end if + eflx_bot(c) = 0._r8 + + ! Initialize qflx_glcice, but only over ice_mec landunits (elsewhere, it is spval) + if (ityplun(l) == istice_mec) then + qflx_glcice(c) = 0._r8 + end if + + end do + + ! Initialize fraction of vegetation not covered by snow (pft-level) + + do p = lbp,ubp + l = plandunit(p) + ! Note: Some glacier_mec points may have zero weight + if (pwtgcell(p)>0._r8 .or. ityplun(l) == istice_mec) then + frac_veg_nosno(p) = frac_veg_nosno_alb(p) + else + frac_veg_nosno(p) = 0._r8 + end if + end do + + ! Initialize set of previous time-step variables + ! Ice fraction of snow at previous time step + + do j = -nlevsno+1,0 + do f = 1, num_nolakec + c = filter_nolakec(f) + if (j >= snl(c) + 1) then + frac_iceold(c,j) = h2osoi_ice(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + end if + end do + end do + + ! Downscale forc_t, forc_th, forc_q, forc_pbot, and forc_rho to columns. + ! For glacier_mec columns the downscaling is based on surface elevation. + ! For other columns the downscaling is a simple copy. + + do f = 1, num_nolakec + c = filter_nolakec(f) + l = clandunit(c) + g = cgridcell(c) + + if (ityplun(l) == istice_mec) then ! downscale to elevation classes + + ! This is a simple downscaling procedure taken from subroutine clm_mapa2l. + ! Note that forc_hgt, forc_u, and forc_v are not downscaled. + + hsurf_g = ldomain%topo(g) ! gridcell sfc elevation + hsurf_c = glc_topo(c) ! column sfc elevation + + tbot_g = clm_a2l%forc_t(g) ! atm sfc temp + thbot_g = clm_a2l%forc_th(g) ! atm sfc pot temp + qbot_g = clm_a2l%forc_q(g) ! atm sfc spec humid + pbot_g = clm_a2l%forc_pbot(g) ! atm sfc pressure + zbot_g = clm_a2l%forc_hgt(g) ! atm ref height + + zbot_c = zbot_g + tbot_c = tbot_g-lapse_glcmec*(hsurf_c-hsurf_g) ! sfc temp for column + + Hbot = rair*0.5_r8*(tbot_g+tbot_c)/grav ! scale ht at avg temp + pbot_c = pbot_g*exp(-(hsurf_c-hsurf_g)/Hbot) ! column sfc press + thbot_c= tbot_c*exp((zbot_c/Hbot)*(rair/cpair)) ! pot temp calc + + call Qsat(tbot_g,pbot_g,es_g,dum1,qs_g,dum2) + call Qsat(tbot_c,pbot_c,es_c,dum1,qs_c,dum2) + + qbot_c = qbot_g*(qs_c/qs_g) + egcm_c = qbot_c*pbot_c/(0.622+0.378*qbot_c) + rhos_c = (pbot_c-0.378*egcm_c) / (rair*tbot_c) + + forc_t(c) = tbot_c + forc_th(c) = thbot_c + forc_q(c) = qbot_c + forc_pbot(c) = pbot_c + forc_rho(c) = rhos_c + + endif + + enddo ! num_nolakec + + end subroutine clm_driverInit + +end module clm_driverInitMod diff --git a/components/clm/src_clm40/main/CMakeLists.txt b/components/clm/src_clm40/main/CMakeLists.txt new file mode 100644 index 0000000000..f5594094fd --- /dev/null +++ b/components/clm/src_clm40/main/CMakeLists.txt @@ -0,0 +1,6 @@ +# Note that this is just used for unit testing; hence, we only need to add +# source files that are currently used in unit tests + +list(APPEND clm_sources domainMod.F90) + +sourcelist_to_parent(clm_sources) diff --git a/components/clm/src_clm40/main/CNiniSpecial.F90 b/components/clm/src_clm40/main/CNiniSpecial.F90 new file mode 100644 index 0000000000..91677c0dbb --- /dev/null +++ b/components/clm/src_clm40/main/CNiniSpecial.F90 @@ -0,0 +1,223 @@ +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNiniSpecial +! +! !INTERFACE: +subroutine CNiniSpecial () +! +! !DESCRIPTION: +! One-time initialization of CN variables for special landunits +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use pftvarcon , only: noveg + use decompMod , only: get_proc_bounds + use clm_varcon , only: spval + use clm_varctl , only: iulog, use_c13, use_cn + use clmtype + use CNSetValueMod +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine iniTimeConst in file iniTimeConst.F90 +! +! !REVISION HISTORY: +! 11/13/03: Created by Peter Thornton +! +! +! local pointers to implicit in arguments +! + integer , pointer :: clandunit(:) ! landunit index of corresponding column + integer , pointer :: plandunit(:) ! landunit index of corresponding pft + logical , pointer :: ifspecial(:) ! BOOL: true=>landunit is wetland,ice,lake, or urban +! +! local pointers to implicit out arguments +! +! !LOCAL VARIABLES: +!EOP + integer :: fc,fp,l,c,p ! indices + integer :: begp, endp ! per-clump/proc beginning and ending pft indices + integer :: begc, endc ! per-clump/proc beginning and ending column indices + integer :: begl, endl ! per-clump/proc beginning and ending landunit indices + integer :: begg, endg ! per-clump/proc gridcell ending gridcell indices + integer :: num_specialc ! number of good values in specialc filter + integer :: num_specialp ! number of good values in specialp filter + integer, allocatable :: specialc(:) ! special landunit filter - columns + integer, allocatable :: specialp(:) ! special landunit filter - pfts +!----------------------------------------------------------------------- + ! assign local pointers at the landunit level + ifspecial => lun%ifspecial + + ! assign local pointers at the column level + clandunit => col%landunit + + ! assign local pointers at the pft level + plandunit => pft%landunit + + ! Determine subgrid bounds on this processor + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! allocate special landunit filters + allocate(specialc(endc-begc+1)) + allocate(specialp(endp-begp+1)) + + ! fill special landunit filters + num_specialc = 0 + do c = begc, endc + l = clandunit(c) + if (ifspecial(l)) then + num_specialc = num_specialc + 1 + specialc(num_specialc) = c + end if + end do + + num_specialp = 0 + do p = begp, endp + l = plandunit(p) + if (ifspecial(l)) then + num_specialp = num_specialp + 1 + specialp(num_specialp) = p + end if + end do + + ! initialize column-level fields + call CNSetCps(num_specialc, specialc, spval, cps) + call CNSetCcs(num_specialc, specialc, 0._r8, ccs) + call CNSetCns(num_specialc, specialc, 0._r8, cns) + call CNSetCcf(num_specialc, specialc, 0._r8, ccf) + call CNSetCnf(num_specialc, specialc, 0._r8, cnf) + if (use_c13) then + ! 4/14/05: PET + ! adding isotope code + call CNSetCcs(num_specialc, specialc, 0._r8, cc13s) + call CNSetCcf(num_specialc, specialc, 0._r8, cc13f) + endif + + ! initialize column-average pft fields + call CNSetPps(num_specialc, specialc, spval, pps_a) + call CNSetPcs(num_specialc, specialc, 0._r8, pcs_a) + call CNSetPns(num_specialc, specialc, 0._r8, pns_a) + call CNSetPcf(num_specialc, specialc, 0._r8, pcf_a) + call CNSetPnf(num_specialc, specialc, 0._r8, pnf_a) + + ! initialize pft-level fields + call CNSetPepv(num_specialp, specialp, spval, pepv) + call CNSetPps(num_specialp, specialp, spval, pps) + call CNSetPcs(num_specialp, specialp, 0._r8, pcs) + call CNSetPns(num_specialp, specialp, 0._r8, pns) + call CNSetPcf(num_specialp, specialp, 0._r8, pcf) + call CNSetPnf(num_specialp, specialp, 0._r8, pnf) + if (use_c13) then + ! 4/14/05: PET + ! adding isotope code + call CNSetPcs(num_specialp, specialp, 0._r8, pc13s) + call CNSetPcf(num_specialp, specialp, 0._r8, pc13f) + endif + + ! now loop through special filters and explicitly set the variables that + ! have to be in place for SurfaceAlbedo and biogeophysics + ! also set pcf%psnsun and pcf%psnsha to 0 (not included in CNSetPcf()) + + do fp = 1,num_specialp + p = specialp(fp) + pps%tlai(p) = 0._r8 + pps%tsai(p) = 0._r8 + pps%elai(p) = 0._r8 + pps%esai(p) = 0._r8 + pps%htop(p) = 0._r8 + pps%hbot(p) = 0._r8 + pps%fwet(p) = 0._r8 + pps%fdry(p) = 0._r8 + pps%frac_veg_nosno_alb(p) = 0._r8 + pps%frac_veg_nosno(p) = 0._r8 + pcf%psnsun(p) = 0._r8 + pcf%psnsha(p) = 0._r8 + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + pc13f%psnsun(p) = 0._r8 + pc13f%psnsha(p) = 0._r8 + endif + + end do + + do fc = 1,num_specialc + c = specialc(fc) + pcf_a%psnsun(c) = 0._r8 + pcf_a%psnsha(c) = 0._r8 + if (use_c13) then + ! 8/17/05: PET + ! Adding isotope code + pcf_a%psnsun(c) = 0._r8 + pcf_a%psnsha(c) = 0._r8 + endif + + ! adding dynpft code + ccs%seedc(c) = 0._r8 + ccs%prod10c(c) = 0._r8 + ccs%prod100c(c) = 0._r8 + ccs%totprodc(c) = 0._r8 + if (use_c13) then + cc13s%seedc(c) = 0._r8 + cc13s%prod10c(c) = 0._r8 + cc13s%prod100c(c) = 0._r8 + cc13s%totprodc(c) = 0._r8 + endif + cns%seedn(c) = 0._r8 + cns%prod10n(c) = 0._r8 + cns%prod100n(c) = 0._r8 + cns%totprodn(c) = 0._r8 + ccf%dwt_seedc_to_leaf(c) = 0._r8 + ccf%dwt_seedc_to_deadstem(c) = 0._r8 + ccf%dwt_conv_cflux(c) = 0._r8 + ccf%dwt_prod10c_gain(c) = 0._r8 + ccf%prod10c_loss(c) = 0._r8 + ccf%dwt_prod100c_gain(c) = 0._r8 + ccf%prod100c_loss(c) = 0._r8 + ccf%dwt_frootc_to_litr1c(c) = 0._r8 + ccf%dwt_frootc_to_litr2c(c) = 0._r8 + ccf%dwt_frootc_to_litr3c(c) = 0._r8 + ccf%dwt_livecrootc_to_cwdc(c) = 0._r8 + ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8 + ccf%dwt_closs(c) = 0._r8 + ccf%landuseflux(c) = 0._r8 + ccf%landuptake(c) = 0._r8 + if (use_c13) then + cc13f%dwt_seedc_to_leaf(c) = 0._r8 + cc13f%dwt_seedc_to_deadstem(c) = 0._r8 + cc13f%dwt_conv_cflux(c) = 0._r8 + cc13f%dwt_prod10c_gain(c) = 0._r8 + cc13f%prod10c_loss(c) = 0._r8 + cc13f%dwt_prod100c_gain(c) = 0._r8 + cc13f%prod100c_loss(c) = 0._r8 + cc13f%dwt_frootc_to_litr1c(c) = 0._r8 + cc13f%dwt_frootc_to_litr2c(c) = 0._r8 + cc13f%dwt_frootc_to_litr3c(c) = 0._r8 + cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8 + cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8 + cc13f%dwt_closs(c) = 0._r8 + endif + cnf%dwt_seedn_to_leaf(c) = 0._r8 + cnf%dwt_seedn_to_deadstem(c) = 0._r8 + cnf%dwt_conv_nflux(c) = 0._r8 + cnf%dwt_prod10n_gain(c) = 0._r8 + cnf%prod10n_loss(c) = 0._r8 + cnf%dwt_prod100n_gain(c) = 0._r8 + cnf%prod100n_loss(c) = 0._r8 + cnf%dwt_frootn_to_litr1n(c) = 0._r8 + cnf%dwt_frootn_to_litr2n(c) = 0._r8 + cnf%dwt_frootn_to_litr3n(c) = 0._r8 + cnf%dwt_livecrootn_to_cwdn(c) = 0._r8 + cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8 + cnf%dwt_nloss(c) = 0._r8 + + end do + + ! deallocate special landunit filters + deallocate(specialc) + deallocate(specialp) + +end subroutine CNiniSpecial diff --git a/components/clm/src_clm40/main/CNiniTimeVar.F90 b/components/clm/src_clm40/main/CNiniTimeVar.F90 new file mode 100644 index 0000000000..9f48a5ef65 --- /dev/null +++ b/components/clm/src_clm40/main/CNiniTimeVar.F90 @@ -0,0 +1,875 @@ +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNiniTimeVar +! +! !INTERFACE: +subroutine CNiniTimeVar() +! +! !DESCRIPTION: +! Initializes time varying variables used only in +! coupled carbon-nitrogen mode (CN): +! +! !USES: + use clmtype + use clm_atmlnd , only: clm_a2l + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varcon , only: istsoil + use clm_varcon , only: istcrop + use clm_varcon , only: c13ratio + use clm_varctl , only: use_c13, use_cndv + use pftvarcon , only: noveg + use pftvarcon , only: npcropmin + use decompMod , only: get_proc_bounds + use surfrdMod , only: crop_prog +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine iniTimeVar in file iniTimeVar.F90 +! +! !REVISION HISTORY: +! 10/21/03: Created by Peter Thornton +! +! +! local pointers to implicit in arguments +! + real(r8), pointer :: evergreen(:) ! binary flag for evergreen leaf habit (0 or 1) + real(r8), pointer :: woody(:) ! binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: leafcn(:) ! leaf C:N (gC/gN) + real(r8), pointer :: deadwdcn(:) ! dead wood (xylem and heartwood) C:N (gC/gN) + integer , pointer :: ivt(:) ! pft vegetation type + logical , pointer :: lakpoi(:) ! true => landunit is a lake point + integer , pointer :: plandunit(:) ! landunit index associated with each pft + integer , pointer :: clandunit(:) ! landunit index associated with each column + integer , pointer :: itypelun(:) ! landunit type +! +! local pointers to implicit out arguments +! + real(r8), pointer :: forc_hgt_u_pft(:) !observational height of wind at pft-level [m] + real(r8), pointer :: annsum_counter(:) ! seconds since last annual accumulator turnover + real(r8), pointer :: cannsum_npp(:) ! annual sum of NPP, averaged from pft-level (gC/m2/yr) + real(r8), pointer :: cannavg_t2m(:) !annual average of 2m air temperature, averaged from pft-level (K) + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: soil1n(:) ! (gN/m2) soil organic matter N (fast pool) + real(r8), pointer :: soil2n(:) ! (gN/m2) soil organic matter N (medium pool) + real(r8), pointer :: soil3n(:) ! (gN/m2) soil orgainc matter N (slow pool) + real(r8), pointer :: soil4n(:) ! (gN/m2) soil orgainc matter N (slowest pool) + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: grainc(:) ! (gC/m2) grain C + real(r8), pointer :: grainc_storage(:) ! (gC/m2) grain C storage + real(r8), pointer :: grainc_xfer(:) ! (gC/m2) grain C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) abstract C pool to meet excess MR demand + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: grainn(:) ! (gN/m2) grain N + real(r8), pointer :: grainn_storage(:) ! (gN/m2) grain N storage + real(r8), pointer :: grainn_xfer(:) ! (gN/m2) grain N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool(:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: psnsun(:) ! sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) ! shaded leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: c13_psnsun(:) ! sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: c13_psnsha(:) ! shaded leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: laisun(:) ! sunlit projected leaf area index + real(r8), pointer :: laisha(:) ! shaded projected leaf area index + real(r8), pointer :: dormant_flag(:) ! dormancy flag + real(r8), pointer :: days_active(:) ! number of days since last dormancy + real(r8), pointer :: onset_flag(:) ! onset flag + real(r8), pointer :: onset_counter(:) ! onset days counter + real(r8), pointer :: onset_gddflag(:) ! onset flag for growing degree day sum + real(r8), pointer :: onset_fdd(:) ! onset freezing degree days counter + real(r8), pointer :: onset_gdd(:) ! onset growing degree days + real(r8), pointer :: onset_swi(:) ! onset soil water index + real(r8), pointer :: offset_flag(:) ! offset flag + real(r8), pointer :: offset_counter(:) ! offset days counter + real(r8), pointer :: offset_fdd(:) ! offset freezing degree days counter + real(r8), pointer :: offset_swi(:) ! offset soil water index + real(r8), pointer :: lgsf(:) ! long growing season factor [0-1] + real(r8), pointer :: bglfr(:) ! background litterfall rate (1/s) + real(r8), pointer :: bgtr(:) ! background transfer rate (1/s) + real(r8), pointer :: dayl(:) ! daylength (seconds) + real(r8), pointer :: prev_dayl(:) ! daylength from previous timestep (seconds) + real(r8), pointer :: annavg_t2m(:) ! annual average 2m air temperature (K) + real(r8), pointer :: tempavg_t2m(:) ! temporary average 2m air temperature (K) + real(r8), pointer :: gpp(:) ! GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: availc(:) ! C flux available for allocation (gC/m2/s) + real(r8), pointer :: xsmrpool_recover(:) ! C flux assigned to recovery of negative cpool (gC/m2/s) + real(r8), pointer :: xsmrpool_c13ratio(:) ! C flux assigned to recovery of negative cpool (gC/m2/s) + real(r8), pointer :: alloc_pnow(:) ! fraction of current allocation to display as new growth (DIM) + real(r8), pointer :: c_allometry(:) ! C allocation index (DIM) + real(r8), pointer :: n_allometry(:) ! N allocation index (DIM) + real(r8), pointer :: plant_ndemand(:) ! N flux required to support initial GPP (gN/m2/s) + real(r8), pointer :: tempsum_potential_gpp(:) ! temporary annual sum of plant_ndemand + real(r8), pointer :: annsum_potential_gpp(:) ! annual sum of plant_ndemand + real(r8), pointer :: tempmax_retransn(:) ! temporary max of retranslocated N pool (gN/m2) + real(r8), pointer :: annmax_retransn(:) ! annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: avail_retransn(:) ! N flux available from retranslocation pool (gN/m2/s) + real(r8), pointer :: plant_nalloc(:) ! total allocated N flux (gN/m2/s) + real(r8), pointer :: plant_calloc(:) ! total allocated C flux (gC/m2/s) + real(r8), pointer :: excess_cflux(:) ! C flux not allocated due to downregulation (gC/m2/s) + real(r8), pointer :: downreg(:) ! fractional reduction in GPP due to N limitation (DIM) + real(r8), pointer :: tempsum_npp(:) ! temporary annual sum of NPP + real(r8), pointer :: annsum_npp(:) ! annual sum of NPP + real(r8), pointer :: tempsum_litfall(:) ! temporary annual sum of litfall + real(r8), pointer :: annsum_litfall(:) ! annual sum of litfall + real(r8), pointer :: rc13_canair(:) !C13O2/C12O2 in canopy air + real(r8), pointer :: rc13_psnsun(:) !C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer :: rc13_psnsha(:) !C13O2/C12O2 in shaded canopy psn flux + real(r8), pointer :: alphapsnsun(:) !sunlit 13c fractionation ([]) + real(r8), pointer :: alphapsnsha(:) !shaded 13c fractionation ([]) + real(r8), pointer :: qflx_drain(:) ! sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_irrig(:) !irrigation flux (mm H2O/s) + ! new variables for fire + real(r8), pointer :: wf(:) ! soil moisture in top 0.5 m + real(r8), pointer :: me(:) ! moisture of extinction (proportion) + real(r8), pointer :: fire_prob(:) ! daily fire probability (0-1) + real(r8), pointer :: mean_fire_prob(:) ! e-folding mean of daily fire probability (0-1) + real(r8), pointer :: fireseasonl(:) ! annual fire season length (days, <= days/year) + real(r8), pointer :: farea_burned(:) ! timestep fractional area burned (proportion) + real(r8), pointer :: ann_farea_burned(:) ! annual total fractional area burned (proportion) + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totecosysc(:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totlitc(:) ! (gC/m2) total litter carbon + real(r8), pointer :: totsomc(:) ! (gC/m2) total soil organic matter carbon + + real(r8), pointer :: woodc(:) ! (gC/m2) pft-level wood C + real(r8), pointer :: col_ntrunc(:) ! (gN/m2) column-level sink for N truncation + real(r8), pointer :: totcoln(:) ! (gN/m2) total column nitrogen, incl veg + real(r8), pointer :: totecosysn(:) ! (gN/m2) total ecosystem nitrogen, incl veg + real(r8), pointer :: totlitn(:) ! (gN/m2) total litter nitrogen + real(r8), pointer :: totsomn(:) ! (gN/m2) total soil organic matter nitrogen + real(r8), pointer :: dispvegc(:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: pft_ctrunc(:) ! (gC/m2) pft-level sink for C truncation + real(r8), pointer :: storvegc(:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: prev_frootc_to_litter(:)!previous timestep froot C litterfall flux (gC/m2/s) + real(r8), pointer :: prev_leafc_to_litter(:) !previous timestep leaf C litterfall flux (gC/m2/s) + real(r8), pointer :: dispvegn(:) ! (gN/m2) displayed veg nitrogen, excluding storage + real(r8), pointer :: pft_ntrunc(:) ! (gN/m2) pft-level sink for N truncation + real(r8), pointer :: storvegn(:) ! (gN/m2) stored vegetation nitrogen + real(r8), pointer :: totpftn(:) ! (gN/m2) total pft-level nitrogen + real(r8), pointer :: totvegn(:) ! (gN/m2) total vegetation nitrogen + real(r8), pointer :: lncsha(:) ! leaf N concentration per unit projected LAI (gN leaf/m^2) + real(r8), pointer :: lncsun(:) ! leaf N concentration per unit projected LAI (gN leaf/m^2) + real(r8), pointer :: vcmxsha(:) ! shaded leaf Vcmax (umolCO2/m^2/s) + real(r8), pointer :: vcmxsun(:) ! sunlit leaf Vcmax (umolCO2/m^2/s) + ! 4/14/05: PET + ! Adding isotope code + real(r8), pointer :: cwdc13(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c13(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c13(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c13(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c13(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c13(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c13(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c13(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: c13_col_ctrunc(:) ! (gC/m2) C truncation term + real(r8), pointer :: leafc13(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc13_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc13_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc13(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc13_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc13_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc13(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc13_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc13_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc13(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc13_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc13_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc13(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc13_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc13_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc13(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc13_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc13_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: c13_gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: c13_gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: c13pool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: c13xsmrpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: c13_pft_ctrunc(:) ! (gC/m2) C truncation term + real(r8), pointer :: totvegc13(:) ! (gC/m2) total vegetation carbon, excluding cpool + ! dynamic landuse variables + real(r8), pointer :: seedc(:) ! (gC/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10c(:) ! (gC/m2) wood product C pool, 10-year lifespan + real(r8), pointer :: prod100c(:) ! (gC/m2) wood product C pool, 100-year lifespan + real(r8), pointer :: totprodc(:) ! (gC/m2) total wood product C + real(r8), pointer :: seedc13(:) ! (gC/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10c13(:) ! (gC/m2) wood product C13 pool, 10-year lifespan + real(r8), pointer :: prod100c13(:) ! (gC/m2) wood product C13 pool, 100-year lifespan + real(r8), pointer :: totprodc13(:) ! (gC/m2) total wood product C13 + real(r8), pointer :: seedn(:) ! (gN/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10n(:) ! (gN/m2) wood product N pool, 10-year lifespan + real(r8), pointer :: prod100n(:) ! (gN/m2) wood product N pool, 100-year lifespan + real(r8), pointer :: totprodn(:) ! (gN/m2) total wood product N +! +! !LOCAL VARIABLES: + integer :: g,l,c,p ! indices + integer :: begp, endp ! per-clump/proc beginning and ending pft indices + integer :: begc, endc ! per-clump/proc beginning and ending column indices + integer :: begl, endl ! per-clump/proc beginning and ending landunit indices + integer :: begg, endg ! per-clump/proc gridcell ending gridcell indices +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers at the gridcell level + + ! assign local pointers at the landunit level + lakpoi => lun%lakpoi + itypelun => lun%itype + + ! assign local pointers at the column level + clandunit => col%landunit + annsum_counter => cps%annsum_counter + cannsum_npp => cps%cannsum_npp + cannavg_t2m => cps%cannavg_t2m + wf => cps%wf + me => cps%me + fire_prob => cps%fire_prob + mean_fire_prob => cps%mean_fire_prob + fireseasonl => cps%fireseasonl + farea_burned => cps%farea_burned + ann_farea_burned => cps%ann_farea_burned + qflx_drain => cwf%qflx_drain + qflx_irrig => cwf%qflx_irrig + cwdc => ccs%cwdc + litr1c => ccs%litr1c + litr2c => ccs%litr2c + litr3c => ccs%litr3c + soil1c => ccs%soil1c + soil2c => ccs%soil2c + soil3c => ccs%soil3c + soil4c => ccs%soil4c + + ! dynamic landuse variables + seedc => ccs%seedc + prod10c => ccs%prod10c + prod100c => ccs%prod100c + totprodc => ccs%totprodc + seedc13 => cc13s%seedc + prod10c13 => cc13s%prod10c + prod100c13 => cc13s%prod100c + totprodc13 => cc13s%totprodc + seedn => cns%seedn + prod10n => cns%prod10n + prod100n => cns%prod100n + totprodn => cns%totprodn + + cwdn => cns%cwdn + litr1n => cns%litr1n + litr2n => cns%litr2n + litr3n => cns%litr3n + soil1n => cns%soil1n + soil2n => cns%soil2n + soil3n => cns%soil3n + soil4n => cns%soil4n + sminn => cns%sminn + col_ctrunc => ccs%col_ctrunc + totcolc => ccs%totcolc + totecosysc => ccs%totecosysc + totlitc => ccs%totlitc + totsomc => ccs%totsomc + + col_ntrunc => cns%col_ntrunc + totcoln => cns%totcoln + totecosysn => cns%totecosysn + totlitn => cns%totlitn + totsomn => cns%totsomn + + ! 4/14/05: PET + ! Adding isotope code + cwdc13 => cc13s%cwdc + litr1c13 => cc13s%litr1c + litr2c13 => cc13s%litr2c + litr3c13 => cc13s%litr3c + soil1c13 => cc13s%soil1c + soil2c13 => cc13s%soil2c + soil3c13 => cc13s%soil3c + soil4c13 => cc13s%soil4c + c13_col_ctrunc => cc13s%col_ctrunc + + ! assign local pointers at the pft level + ivt => pft%itype + plandunit => pft%landunit + leafc => pcs%leafc + leafc_storage => pcs%leafc_storage + leafc_xfer => pcs%leafc_xfer + grainc => pcs%grainc + grainc_storage => pcs%grainc_storage + grainc_xfer => pcs%grainc_xfer + frootc => pcs%frootc + frootc_storage => pcs%frootc_storage + frootc_xfer => pcs%frootc_xfer + livestemc => pcs%livestemc + livestemc_storage => pcs%livestemc_storage + livestemc_xfer => pcs%livestemc_xfer + deadstemc => pcs%deadstemc + deadstemc_storage => pcs%deadstemc_storage + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc => pcs%livecrootc + livecrootc_storage => pcs%livecrootc_storage + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc => pcs%deadcrootc + deadcrootc_storage => pcs%deadcrootc_storage + deadcrootc_xfer => pcs%deadcrootc_xfer + gresp_storage => pcs%gresp_storage + gresp_xfer => pcs%gresp_xfer + cpool => pcs%cpool + xsmrpool => pcs%xsmrpool + forc_hgt_u_pft => pps%forc_hgt_u_pft + woodc => pcs%woodc + leafn => pns%leafn + leafn_storage => pns%leafn_storage + leafn_xfer => pns%leafn_xfer + grainn => pns%grainn + grainn_storage => pns%grainn_storage + grainn_xfer => pns%grainn_xfer + frootn => pns%frootn + frootn_storage => pns%frootn_storage + frootn_xfer => pns%frootn_xfer + livestemn => pns%livestemn + livestemn_storage => pns%livestemn_storage + livestemn_xfer => pns%livestemn_xfer + deadstemn => pns%deadstemn + deadstemn_storage => pns%deadstemn_storage + deadstemn_xfer => pns%deadstemn_xfer + livecrootn => pns%livecrootn + livecrootn_storage => pns%livecrootn_storage + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn => pns%deadcrootn + deadcrootn_storage => pns%deadcrootn_storage + deadcrootn_xfer => pns%deadcrootn_xfer + retransn => pns%retransn + npool => pns%npool + psnsun => pcf%psnsun + psnsha => pcf%psnsha + + c13_psnsun => pc13f%psnsun + c13_psnsha => pc13f%psnsha + + laisun => pps%laisun + laisha => pps%laisha + dormant_flag => pepv%dormant_flag + days_active => pepv%days_active + onset_flag => pepv%onset_flag + onset_counter => pepv%onset_counter + onset_gddflag => pepv%onset_gddflag + onset_fdd => pepv%onset_fdd + onset_gdd => pepv%onset_gdd + onset_swi => pepv%onset_swi + offset_flag => pepv%offset_flag + offset_counter => pepv%offset_counter + offset_fdd => pepv%offset_fdd + offset_swi => pepv%offset_swi + lgsf => pepv%lgsf + bglfr => pepv%bglfr + bgtr => pepv%bgtr + dayl => pepv%dayl + prev_dayl => pepv%prev_dayl + annavg_t2m => pepv%annavg_t2m + tempavg_t2m => pepv%tempavg_t2m + gpp => pepv%gpp + availc => pepv%availc + xsmrpool_recover => pepv%xsmrpool_recover + + xsmrpool_c13ratio => pepv%xsmrpool_c13ratio + + alloc_pnow => pepv%alloc_pnow + c_allometry => pepv%c_allometry + n_allometry => pepv%n_allometry + plant_ndemand => pepv%plant_ndemand + tempsum_potential_gpp => pepv%tempsum_potential_gpp + annsum_potential_gpp => pepv%annsum_potential_gpp + tempmax_retransn => pepv%tempmax_retransn + annmax_retransn => pepv%annmax_retransn + avail_retransn => pepv%avail_retransn + plant_nalloc => pepv%plant_nalloc + plant_calloc => pepv%plant_calloc + excess_cflux => pepv%excess_cflux + downreg => pepv%downreg + tempsum_npp => pepv%tempsum_npp + annsum_npp => pepv%annsum_npp + tempsum_litfall => pepv%tempsum_litfall + annsum_litfall => pepv%annsum_litfall + dispvegc => pcs%dispvegc + pft_ctrunc => pcs%pft_ctrunc + storvegc => pcs%storvegc + totpftc => pcs%totpftc + totvegc => pcs%totvegc + prev_frootc_to_litter => pepv%prev_frootc_to_litter + prev_leafc_to_litter => pepv%prev_leafc_to_litter + dispvegn => pns%dispvegn + pft_ntrunc => pns%pft_ntrunc + storvegn => pns%storvegn + totpftn => pns%totpftn + totvegn => pns%totvegn + lncsha => pps%lncsha + lncsun => pps%lncsun + vcmxsha => pps%vcmxsha + vcmxsun => pps%vcmxsun + + ! 4/14/05: PET + ! Adding isotope code + alphapsnsun => pps%alphapsnsun + alphapsnsha => pps%alphapsnsha + leafc13 => pc13s%leafc + leafc13_storage => pc13s%leafc_storage + leafc13_xfer => pc13s%leafc_xfer + frootc13 => pc13s%frootc + frootc13_storage => pc13s%frootc_storage + frootc13_xfer => pc13s%frootc_xfer + livestemc13 => pc13s%livestemc + livestemc13_storage => pc13s%livestemc_storage + livestemc13_xfer => pc13s%livestemc_xfer + deadstemc13 => pc13s%deadstemc + deadstemc13_storage => pc13s%deadstemc_storage + deadstemc13_xfer => pc13s%deadstemc_xfer + livecrootc13 => pc13s%livecrootc + livecrootc13_storage => pc13s%livecrootc_storage + livecrootc13_xfer => pc13s%livecrootc_xfer + deadcrootc13 => pc13s%deadcrootc + deadcrootc13_storage => pc13s%deadcrootc_storage + deadcrootc13_xfer => pc13s%deadcrootc_xfer + c13_gresp_storage => pc13s%gresp_storage + c13_gresp_xfer => pc13s%gresp_xfer + c13pool => pc13s%cpool + c13xsmrpool => pc13s%xsmrpool + c13_pft_ctrunc => pc13s%pft_ctrunc + totvegc13 => pc13s%totvegc + rc13_canair => pepv%rc13_canair + rc13_psnsun => pepv%rc13_psnsun + rc13_psnsha => pepv%rc13_psnsha + + ! assign local pointers for ecophysiological constants + evergreen => pftcon%evergreen + woody => pftcon%woody + leafcn => pftcon%leafcn + deadwdcn => pftcon%deadwdcn + + ! Determine subgrid bounds on this processor + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Added 5/4/04, PET: initialize forc_hgt_u (gridcell-level), + ! since this is not initialized before first call to CNVegStructUpdate, + ! and it is required to set the upper bound for canopy top height. + ! Changed 3/21/08, KO: still needed but don't have sufficient information + ! to set this properly (e.g., pft-level displacement height and roughness + ! length). So leave at 30m. + do p = begp, endp + forc_hgt_u_pft(p) = 30._r8 + end do + + ! initialize column-level variables + do c = begc, endc + l = clandunit(c) + if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then + + ! column physical state variables + annsum_counter(c) = 0._r8 + cannsum_npp(c) = 0._r8 + cannavg_t2m(c) = 280._r8 + wf(c) = 1.0_r8 ! it needs to be non zero so the first time step has no fires + me(c) = 0._r8 + fire_prob(c) = 0._r8 + mean_fire_prob(c) = 0._r8 + fireseasonl(c) = 0._r8 + farea_burned(c) = 0._r8 + ann_farea_burned(c) = 0._r8 + + ! needed for CNNLeaching + qflx_drain(c) = 0._r8 + + qflx_irrig(c) = 0._r8 + + ! column carbon state variable initialization + cwdc(c) = 0._r8 + litr1c(c) = 0._r8 + litr2c(c) = 0._r8 + litr3c(c) = 0._r8 + soil1c(c) = 0._r8 + soil2c(c) = 0._r8 + soil3c(c) = 0._r8 + soil4c(c) = 10._r8 + col_ctrunc(c) = 0._r8 + totlitc(c) = 0._r8 + totsomc(c) = 0._r8 + totecosysc(c) = 0._r8 + totcolc(c) = 0._r8 + + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + cwdc13(c) = cwdc(c) * c13ratio + litr1c13(c) = litr1c(c) * c13ratio + litr2c13(c) = litr2c(c) * c13ratio + litr3c13(c) = litr3c(c) * c13ratio + soil1c13(c) = soil1c(c) * c13ratio + soil2c13(c) = soil2c(c) * c13ratio + soil3c13(c) = soil3c(c) * c13ratio + soil4c13(c) = soil4c(c) * c13ratio + c13_col_ctrunc(c) = col_ctrunc(c) * c13ratio + end if + + ! column nitrogen state variables + cwdn(c) = cwdc(c) / 500._r8 + litr1n(c) = litr1c(c) / 90._r8 + litr2n(c) = litr2c(c) / 90._r8 + litr3n(c) = litr3c(c) / 90._r8 + soil1n(c) = soil1c(c) / 12._r8 + soil2n(c) = soil2c(c) / 12._r8 + soil3n(c) = soil3c(c) / 10._r8 + soil4n(c) = soil4c(c) / 10._r8 + sminn(c) = 0._r8 + col_ntrunc(c) = 0._r8 + totlitn(c) = 0._r8 + totsomn(c) = 0._r8 + totecosysn(c) = 0._r8 + totcoln(c) = 0._r8 + + ! dynamic landcover state variables + seedc(c) = 0._r8 + prod10c(c) = 0._r8 + prod100c(c) = 0._r8 + totprodc(c) = 0._r8 + if (use_c13) then + seedc13(c) = 0._r8 + prod10c13(c) = 0._r8 + prod100c13(c) = 0._r8 + totprodc13(c) = 0._r8 + endif + seedn(c) = 0._r8 + prod10n(c) = 0._r8 + prod100n(c) = 0._r8 + totprodn(c) = 0._r8 + + ! also initialize dynamic landcover fluxes so that they have + ! real values on first timestep, prior to calling pftdyn_cnbal + ccf%dwt_seedc_to_leaf(c) = 0._r8 + ccf%dwt_seedc_to_deadstem(c) = 0._r8 + ccf%dwt_conv_cflux(c) = 0._r8 + ccf%dwt_prod10c_gain(c) = 0._r8 + ccf%prod10c_loss(c) = 0._r8 + ccf%dwt_prod100c_gain(c) = 0._r8 + ccf%prod100c_loss(c) = 0._r8 + ccf%dwt_frootc_to_litr1c(c) = 0._r8 + ccf%dwt_frootc_to_litr2c(c) = 0._r8 + ccf%dwt_frootc_to_litr3c(c) = 0._r8 + ccf%dwt_livecrootc_to_cwdc(c) = 0._r8 + ccf%dwt_deadcrootc_to_cwdc(c) = 0._r8 + ccf%dwt_closs(c) = 0._r8 + if (use_c13) then + cc13f%dwt_seedc_to_leaf(c) = 0._r8 + cc13f%dwt_seedc_to_deadstem(c) = 0._r8 + cc13f%dwt_conv_cflux(c) = 0._r8 + cc13f%dwt_prod10c_gain(c) = 0._r8 + cc13f%prod10c_loss(c) = 0._r8 + cc13f%dwt_prod100c_gain(c) = 0._r8 + cc13f%prod100c_loss(c) = 0._r8 + cc13f%dwt_frootc_to_litr1c(c) = 0._r8 + cc13f%dwt_frootc_to_litr2c(c) = 0._r8 + cc13f%dwt_frootc_to_litr3c(c) = 0._r8 + cc13f%dwt_livecrootc_to_cwdc(c) = 0._r8 + cc13f%dwt_deadcrootc_to_cwdc(c) = 0._r8 + cc13f%dwt_closs(c) = 0._r8 + endif + cnf%dwt_seedn_to_leaf(c) = 0._r8 + cnf%dwt_seedn_to_deadstem(c) = 0._r8 + cnf%dwt_conv_nflux(c) = 0._r8 + cnf%dwt_prod10n_gain(c) = 0._r8 + cnf%prod10n_loss(c) = 0._r8 + cnf%dwt_prod100n_gain(c) = 0._r8 + cnf%prod100n_loss(c) = 0._r8 + cnf%dwt_frootn_to_litr1n(c) = 0._r8 + cnf%dwt_frootn_to_litr2n(c) = 0._r8 + cnf%dwt_frootn_to_litr3n(c) = 0._r8 + cnf%dwt_livecrootn_to_cwdn(c) = 0._r8 + cnf%dwt_deadcrootn_to_cwdn(c) = 0._r8 + cnf%dwt_nloss(c) = 0._r8 + end if + end do + + ! initialize pft-level variables + do p = begp, endp + l = plandunit(p) + if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then + + ! carbon state variables + if (ivt(p) == noveg) then + leafc(p) = 0._r8 + leafc_storage(p) = 0._r8 + else + if (evergreen(ivt(p)) == 1._r8) then + leafc(p) = 1._r8 + leafc_storage(p) = 0._r8 + else if (ivt(p) >= npcropmin) then ! prognostic crop types + leafc(p) = 0._r8 + leafc_storage(p) = 0._r8 + else + leafc(p) = 0._r8 + leafc_storage(p) = 1._r8 + end if + end if + + leafc_xfer(p) = 0._r8 + if ( crop_prog )then + grainc(p) = 0._r8 + grainc_storage(p) = 0._r8 + grainc_xfer(p) = 0._r8 + end if + frootc(p) = 0._r8 + frootc_storage(p) = 0._r8 + frootc_xfer(p) = 0._r8 + livestemc(p) = 0._r8 + livestemc_storage(p) = 0._r8 + livestemc_xfer(p) = 0._r8 + + ! tree types need to be initialized with some stem mass so that + ! roughness length is not zero in canopy flux calculation + + if (woody(ivt(p)) == 1._r8) then + deadstemc(p) = 0.1_r8 + else + deadstemc(p) = 0._r8 + end if + + deadstemc_storage(p) = 0._r8 + deadstemc_xfer(p) = 0._r8 + livecrootc(p) = 0._r8 + livecrootc_storage(p) = 0._r8 + livecrootc_xfer(p) = 0._r8 + deadcrootc(p) = 0._r8 + deadcrootc_storage(p) = 0._r8 + deadcrootc_xfer(p) = 0._r8 + gresp_storage(p) = 0._r8 + gresp_xfer(p) = 0._r8 + cpool(p) = 0._r8 + xsmrpool(p) = 0._r8 + pft_ctrunc(p) = 0._r8 + dispvegc(p) = 0._r8 + storvegc(p) = 0._r8 + totpftc(p) = 0._r8 + ! calculate totvegc explicitly so that it is available for the isotope + ! code on the first time step. + totvegc(p) = leafc(p) + leafc_storage(p) + leafc_xfer(p) + frootc(p) + & + frootc_storage(p) + frootc_xfer(p) + livestemc(p) + livestemc_storage(p) + & + livestemc_xfer(p) + deadstemc(p) + deadstemc_storage(p) + deadstemc_xfer(p) + & + livecrootc(p) + livecrootc_storage(p) + livecrootc_xfer(p) + deadcrootc(p) + & + deadcrootc_storage(p) + deadcrootc_xfer(p) + gresp_storage(p) + & + gresp_xfer(p) + cpool(p) + + woodc(p) = 0._r8 + + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + leafc13(p) = leafc(p) * c13ratio + leafc13_storage(p) = leafc_storage(p) * c13ratio + leafc13_xfer(p) = leafc_xfer(p) * c13ratio + frootc13(p) = frootc(p) * c13ratio + frootc13_storage(p) = frootc_storage(p) * c13ratio + frootc13_xfer(p) = frootc_xfer(p) * c13ratio + livestemc13(p) = livestemc(p) * c13ratio + livestemc13_storage(p) = livestemc_storage(p) * c13ratio + livestemc13_xfer(p) = livestemc_xfer(p) * c13ratio + deadstemc13(p) = deadstemc(p) * c13ratio + deadstemc13_storage(p) = deadstemc_storage(p) * c13ratio + deadstemc13_xfer(p) = deadstemc_xfer(p) * c13ratio + livecrootc13(p) = livecrootc(p) * c13ratio + livecrootc13_storage(p) = livecrootc_storage(p) * c13ratio + livecrootc13_xfer(p) = livecrootc_xfer(p) * c13ratio + deadcrootc13(p) = deadcrootc(p) * c13ratio + deadcrootc13_storage(p) = deadcrootc_storage(p) * c13ratio + deadcrootc13_xfer(p) = deadcrootc_xfer(p) * c13ratio + c13_gresp_storage(p) = gresp_storage(p) * c13ratio + c13_gresp_xfer(p) = gresp_xfer(p) * c13ratio + c13pool(p) = cpool(p) * c13ratio + c13xsmrpool(p) = xsmrpool(p) * c13ratio + c13_pft_ctrunc(p) = pft_ctrunc(p) * c13ratio + + ! calculate totvegc explicitly so that it is available for the isotope + ! code on the first time step. + totvegc13(p) = leafc13(p) + leafc13_storage(p) + leafc13_xfer(p) + frootc13(p) + & + frootc13_storage(p) + frootc13_xfer(p) + livestemc13(p) + livestemc13_storage(p) + & + livestemc13_xfer(p) + deadstemc13(p) + deadstemc13_storage(p) + deadstemc13_xfer(p) + & + livecrootc13(p) + livecrootc13_storage(p) + livecrootc13_xfer(p) + deadcrootc13(p) + & + deadcrootc13_storage(p) + deadcrootc13_xfer(p) + c13_gresp_storage(p) + & + c13_gresp_xfer(p) + c13pool(p) + endif + + ! nitrogen state variables + if (ivt(p) == noveg) then + leafn(p) = 0._r8 + leafn_storage(p) = 0._r8 + else + leafn(p) = leafc(p) / leafcn(ivt(p)) + leafn_storage(p) = leafc_storage(p) / leafcn(ivt(p)) + end if + + leafn_xfer(p) = 0._r8 + if ( crop_prog )then + grainn(p) = 0._r8 + grainn_storage(p) = 0._r8 + grainn_xfer(p) = 0._r8 + end if + frootn(p) = 0._r8 + frootn_storage(p) = 0._r8 + frootn_xfer(p) = 0._r8 + livestemn(p) = 0._r8 + livestemn_storage(p) = 0._r8 + livestemn_xfer(p) = 0._r8 + + ! tree types need to be initialized with some stem mass so that + ! roughness length is not zero in canopy flux calculation + + if (woody(ivt(p)) == 1._r8) then + deadstemn(p) = deadstemc(p) / deadwdcn(ivt(p)) + else + deadstemn(p) = 0._r8 + end if + + deadstemn_storage(p) = 0._r8 + deadstemn_xfer(p) = 0._r8 + livecrootn(p) = 0._r8 + livecrootn_storage(p) = 0._r8 + livecrootn_xfer(p) = 0._r8 + deadcrootn(p) = 0._r8 + deadcrootn_storage(p) = 0._r8 + deadcrootn_xfer(p) = 0._r8 + retransn(p) = 0._r8 + npool(p) = 0._r8 + pft_ntrunc(p) = 0._r8 + dispvegn(p) = 0._r8 + storvegn(p) = 0._r8 + totvegn(p) = 0._r8 + totpftn(p) = 0._r8 + + ! initialization for psnsun and psnsha required for + ! proper arbitrary initialization of allocation routine + ! in initial ecosysdyn call + + psnsun(p) = 0._r8 + psnsha(p) = 0._r8 + if (use_c13) then + c13_psnsun(p) = 0._r8 + c13_psnsha(p) = 0._r8 + endif + laisun(p) = 0._r8 + laisha(p) = 0._r8 + lncsun(p) = 0._r8 + lncsha(p) = 0._r8 + vcmxsun(p) = 0._r8 + vcmxsha(p) = 0._r8 + + ! ecophysiological variables + ! phenology variables + dormant_flag(p) = 1._r8 + days_active(p) = 0._r8 + onset_flag(p) = 0._r8 + onset_counter(p) = 0._r8 + onset_gddflag(p) = 0._r8 + onset_fdd(p) = 0._r8 + onset_gdd(p) = 0._r8 + onset_swi(p) = 0.0_r8 + offset_flag(p) = 0._r8 + offset_counter(p) = 0._r8 + offset_fdd(p) = 0._r8 + offset_swi(p) = 0._r8 + lgsf(p) = 0._r8 + bglfr(p) = 0._r8 + bgtr(p) = 0._r8 + annavg_t2m(p) = 280._r8 + tempavg_t2m(p) = 0._r8 + + ! non-phenology variables + gpp(p) = 0._r8 + availc(p) = 0._r8 + xsmrpool_recover(p) = 0._r8 + if (use_c13) then + xsmrpool_c13ratio(p) = c13ratio + endif + alloc_pnow(p) = 1._r8 + c_allometry(p) = 0._r8 + n_allometry(p) = 0._r8 + plant_ndemand(p) = 0._r8 + tempsum_potential_gpp(p) = 0._r8 + annsum_potential_gpp(p) = 0._r8 + tempmax_retransn(p) = 0._r8 + annmax_retransn(p) = 0._r8 + avail_retransn(p) = 0._r8 + plant_nalloc(p) = 0._r8 + plant_calloc(p) = 0._r8 + excess_cflux(p) = 0._r8 + downreg(p) = 0._r8 + prev_leafc_to_litter(p) = 0._r8 + prev_frootc_to_litter(p) = 0._r8 + tempsum_npp(p) = 0._r8 + annsum_npp(p) = 0._r8 + if (use_cndv) then + tempsum_litfall(p) = 0._r8 + annsum_litfall(p) = 0._r8 + end if + if (use_c13) then + rc13_canair(p) = 0._r8 + rc13_psnsun(p) = 0._r8 + rc13_psnsha(p) = 0._r8 + alphapsnsun(p) = 0._r8 + alphapsnsha(p) = 0._r8 + endif + + + + end if ! end of if-istsoil block + end do ! end of loop over pfts + +end subroutine CNiniTimeVar diff --git a/components/clm/src_clm40/main/GetGlobalValuesMod.F90 b/components/clm/src_clm40/main/GetGlobalValuesMod.F90 new file mode 100644 index 0000000000..9bcac2385c --- /dev/null +++ b/components/clm/src_clm40/main/GetGlobalValuesMod.F90 @@ -0,0 +1,145 @@ +module GetGlobalValuesMod + + !----------------------------------------------------------------------- + ! Obtain and Write Global Index information + !----------------------------------------------------------------------- + implicit none + private + + ! PUBLIC MEMBER FUNCTIONS: + + public :: GetGlobalIndex + public :: GetGlobalWrite + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + integer function GetGlobalIndex(decomp_index, clmlevel) + + !---------------------------------------------------------------- + ! Description + ! Determine global index space value for target point at given clmlevel + ! + ! Uses: + use clmtype , only: nameg, namel, namec, namep + use decompMod , only: bounds_type, get_clmlevel_gsmap, get_proc_bounds + use spmdMod , only: iam + use clm_varctl , only: iulog + use shr_log_mod, only: errMsg => shr_log_errMsg + use mct_mod + ! + ! Arguments + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + ! + ! Local Variables: + type(bounds_type) :: bounds_proc ! processor bounds + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmap_ordered ! gsmap ordered points + integer :: beg_index ! beginning proc index for clmlevel + !---------------------------------------------------------------- + + call get_proc_bounds(bounds_proc) + + if (trim(clmlevel) == nameg) then + beg_index = bounds_proc%begg + else if (trim(clmlevel) == namel) then + beg_index = bounds_proc%begl + else if (trim(clmlevel) == namec) then + beg_index = bounds_proc%begc + else if (trim(clmlevel) == namep) then + beg_index = bounds_proc%begp + else + call shr_sys_abort('clmlevel of '//trim(clmlevel)//' not supported' // & + errmsg(__FILE__, __LINE__)) + end if + + call get_clmlevel_gsmap(clmlevel=trim(clmlevel), gsmap=gsmap) + call mct_gsmap_op(gsmap, iam, gsmap_ordered) + GetGlobalIndex = gsmap_ordered(decomp_index - beg_index + 1) + deallocate(gsmap_ordered) + + end function GetGlobalIndex + + !----------------------------------------------------------------------- + subroutine GetGlobalWrite(decomp_index, clmlevel) + + !----------------------------------------------------------------------- + ! Description: + ! Write global index information for input local indices + ! + use clmtype + use shr_sys_mod , only: shr_sys_flush + use shr_sys_mod , only: shr_sys_abort + use shr_log_mod , only: errMsg => shr_log_errMsg + use clm_varctl , only: iulog + ! + ! Arguments: + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + ! + ! Local Variables: + integer :: igrc, ilun, icol, ipft + !----------------------------------------------------------------------- + + if (trim(clmlevel) == nameg) then + + igrc = decomp_index + write(iulog,*)'local gridcell index = ',igrc + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + + else if (trim(clmlevel) == namel) then + + ilun = decomp_index + igrc = lun%gridcell(ilun) + write(iulog,*)'local landunit index = ',ilun + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'landunit type = ',lun%itype(decomp_index) + + else if (trim(clmlevel) == namec) then + + icol = decomp_index + ilun = col%landunit(icol) + igrc = col%gridcell(icol) + write(iulog,*)'local column index = ',icol + write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec) + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'column type = ',col%itype(icol) + write(iulog,*)'landunit type = ',lun%itype(ilun) + + else if (trim(clmlevel) == namep) then + + ipft = decomp_index + icol = pft%column(ipft) + ilun = pft%landunit(ipft) + igrc = pft%gridcell(ipft) + write(iulog,*)'local pft index = ',ipft + write(iulog,*)'global pft index = ',GetGlobalIndex(decomp_index=ipft, clmlevel=namep) + write(iulog,*)'global column index = ',GetGlobalIndex(decomp_index=icol, clmlevel=namec) + write(iulog,*)'global landunit index = ',GetGlobalIndex(decomp_index=ilun, clmlevel=namel) + write(iulog,*)'global gridcell index = ',GetGlobalIndex(decomp_index=igrc, clmlevel=nameg) + write(iulog,*)'gridcell longitude = ',grc%londeg(igrc) + write(iulog,*)'gridcell latitude = ',grc%latdeg(igrc) + write(iulog,*)'pft type = ',pft%itype(ipft) + write(iulog,*)'column type = ',col%itype(icol) + write(iulog,*)'landunit type = ',lun%itype(ilun) + + else + call shr_sys_abort('clmlevel '//trim(clmlevel)//'not supported '//errmsg(__FILE__, __LINE__)) + + end if + + call shr_sys_flush(iulog) + + end subroutine GetGlobalWrite + +end module GetGlobalValuesMod diff --git a/components/clm/src_clm40/main/SimpleMathMod.F90 b/components/clm/src_clm40/main/SimpleMathMod.F90 new file mode 100644 index 0000000000..5649a54263 --- /dev/null +++ b/components/clm/src_clm40/main/SimpleMathMod.F90 @@ -0,0 +1,226 @@ +module SimpleMathMod + +#include "shr_assert.h" + !------------------------------------------------------------------------------ + ! + ! DESCRIPTIONS: + ! module contains simple mathematical functions for arrays + ! Created by Jinyun Tang, Feb., 2014 + +implicit none + + interface array_normalization + module procedure array_normalization_2d, array_normalization_2d_filter + end interface array_normalization + + interface array_div_vector + module procedure array_div_vector_filter, array_div_vector_nofilter + end interface array_div_vector +contains +!-------------------------------------------------------------------------------- + subroutine array_normalization_2d(which_dim, arr2d_inout) + ! + !DESCRIPTIONS + !do normalization for the input array along dimension which_dim + ! + !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + + integer, intent(in) :: which_dim !do normalization along which dimension? + real(r8), intent(inout) :: arr2d_inout(:,:) !input 2d array + + + !local variables + integer :: sz1, sz2 !array size + integer :: j1, j2 !indices + real(r8) :: arr_sum + + sz1 = size(arr2d_inout,1) + sz2 = size(arr2d_inout,2) + + if(which_dim==1)then + !normalize along dimension 1, so loop along dimension 2 + do j2 = 1, sz2 + !obtain the total + arr_sum=0._r8 + do j1 = 1, sz1 + arr_sum=arr_sum+arr2d_inout(j1,j2) + enddo + !normalize with the total if arr_sum is non-zero + if(arr_sum/=0._r8)then + do j1 = 1, sz1 + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr_sum + enddo + endif + enddo + elseif(which_dim==2)then + !normalize along dimension 2, so loop along dimension 1 + do j1 = 1, sz1 + !obtain the total + arr_sum=0._r8 + do j2 = 1, sz2 + arr_sum=arr_sum+arr2d_inout(j1,j2) + enddo + !normalize with the total if arr_sum is non-zero + !I think there should be a safer mask for this to screen off spval values + !Jinyun Tang, May 30, 2014 + if(arr_sum>0._r8 .or. arr_sum < 0._r8)then + do j2 = 1, sz2 + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr_sum + enddo + endif + enddo + endif + return + end subroutine array_normalization_2d + +!-------------------------------------------------------------------------------- + subroutine array_normalization_2d_filter(lbj1, ubj1, lbj2, ubj2, numf, filter, arr2d_inout) + ! + !DESCRIPTIONS + !do normalization with filter for the input array along dimension 2 + + ! + !USES + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + integer, intent(in) :: lbj1 !left bound of dim 1 + integer, intent(in) :: lbj2 !left bound of dim 2 + integer, intent(in) :: ubj1 !right bound of dim 1 + integer, intent(in) :: ubj2 !right bound of dim 2 + integer, intent(in) :: numf !filter size + integer, intent(in) :: filter(:) !filter + real(r8), intent(inout) :: arr2d_inout(lbj1: , lbj2: ) !input 2d array + + + !local variables + integer :: sz1, sz2 !array size + integer :: j2 !indices + integer :: f, p !indices + real(r8) :: arr_sum(lbj1:ubj1) + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(arr2d_inout) == (/ubj1, ubj2/)), errMsg(__FILE__, __LINE__)) + + + arr_sum(:) = 0._r8 + do j2 = lbj2, ubj2 + do f = 1, numf + p = filter(f) + !obtain the total + arr_sum(p)=arr_sum(p)+arr2d_inout(p,j2) + enddo + enddo + + !normalize with the total if arr_sum is non-zero + do j2 = lbj2, ubj2 + do f = 1, numf + p = filter(f) + !I found I have to ensure >0._r8 because of some unknown reason, jyt May 23, 2014 + !I will test this later with arr_sum(p)/=0._r8 + if(arr_sum(p)>0._r8 .or. arr_sum(p)<0._r8)then + arr2d_inout(p,j2) = arr2d_inout(p,j2)/arr_sum(p) + endif + enddo + enddo + return + end subroutine array_normalization_2d_filter +!-------------------------------------------------------------------------------- + + subroutine array_div_vector_filter(lbj1, ubj1, lbj2, ubj2, & + arr1d_in, fn, filter, arr2d_inout) + ! + !DESCRIPTIONS + !array divided by a vector, arr2d_in is divided by one + !element in arr1d_in + !It always assumes the filter is along with dimenion 1 + ! + ! USES + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + integer, intent(in) :: lbj1 !left bound of dim 1 + integer, intent(in) :: lbj2 !left bound of dim 2 + integer, intent(in) :: ubj1 !right bound of dim 1 + integer, intent(in) :: ubj2 !right bound of dim 2 + real(r8), intent(in) :: arr1d_in(lbj1: ) !1d scaling factor + integer , intent(in) :: fn + integer , intent(in) :: filter(:) !filter + real(r8), intent(inout) :: arr2d_inout(lbj1: ,lbj2: ) !2d array to be scaled + + integer :: sz + integer :: j, f, p + + ! Enforce expected array sizes + SHR_ASSERT_ALL((ubound(arr2d_inout) == (/ubj1, ubj2/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(arr1d_in) == (/ubj1/)), errMsg(__FILE__, __LINE__)) + + + do j = lbj2, ubj2 + do f = 1, fn + p = filter(f) + if (arr1d_in(p) > 0._r8 .or. arr1d_in(p) < 0._r8) then + arr2d_inout(p,j) = arr2d_inout(p,j)/arr1d_in(p) + else + arr2d_inout(p,j) = 0._r8 + end if + end do + end do + return + end subroutine array_div_vector_filter + +!-------------------------------------------------------------------------------- + + subroutine array_div_vector_nofilter(arr1d_in, which_dim, arr2d_inout) + ! + !DESCRIPTIONS + !array divided by a vector, each row in arr2d_in is divided by one + !element in arr1d_in + ! + !USES + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_assert_mod , only : shr_assert + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + real(r8), intent(in) :: arr1d_in(:) !scaling factor + integer, intent(in) :: which_dim !which dimension is scaled + real(r8), intent(inout) :: arr2d_inout(:,:) !2d array to be scaled + + integer :: sz1, sz2 + integer :: j1, j2 + + sz1=size(arr2d_inout,1) + sz2=size(arr2d_inout,2) + + if(which_dim==1)then + ! Enforce expected array sizes + call shr_assert(sz1 == size(arr1d_in), errMsg(__FILE__, __LINE__)) + + do j2 = 1, sz2 + do j1 = 1, sz1 + if(arr1d_in(j1)>0._r8)then + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr1d_in(j1) + endif + enddo + enddo + else + ! Enforce expected array sizes + call shr_assert(sz2 == size(arr1d_in), errMsg(__FILE__, __LINE__)) + + do j2 = 1, sz2 + do j1 = 1, sz1 + if(arr1d_in(j2)>0._r8 .or. arr1d_in(j2)<0._r8)then + arr2d_inout(j1,j2) = arr2d_inout(j1,j2)/arr1d_in(j2) + endif + enddo + enddo + + endif + return + end subroutine array_div_vector_nofilter + +end module SimpleMathMod diff --git a/components/clm/src_clm40/main/abortutils.F90 b/components/clm/src_clm40/main/abortutils.F90 new file mode 100644 index 0000000000..8718f0af04 --- /dev/null +++ b/components/clm/src_clm40/main/abortutils.F90 @@ -0,0 +1,82 @@ +module abortutils + + !----------------------------------------------------------------------- + ! !MODULE: abortutils + ! + ! !DESCRIPTION: + ! Abort the model for abnormal termination + !----------------------------------------------------------------------- + + private + save + + public :: endrun + + interface endrun + module procedure endrun_vanilla + module procedure endrun_globalindex + end interface + +CONTAINS + + !----------------------------------------------------------------------- + subroutine endrun_vanilla(msg) + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Abort the model for abnormal termination + ! + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in), optional :: msg ! string to be printed + !----------------------------------------------------------------------- + + if (present (msg)) then + write(iulog,*)'ENDRUN:', msg + else + write(iulog,*)'ENDRUN: called without a message string' + end if + + call shr_sys_abort() + + end subroutine endrun_vanilla + + !----------------------------------------------------------------------- + subroutine endrun_globalindex(decomp_index, clmlevel, msg) + + !----------------------------------------------------------------------- + ! Description: + ! Abort the model for abnormal termination + ! + use clmtype + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + use GetGlobalValuesMod, only: GetGlobalWrite + ! + ! Arguments: + implicit none + integer , intent(in) :: decomp_index + character(len=*) , intent(in) :: clmlevel + character(len=*) , intent(in), optional :: msg ! string to be printed + ! + ! Local Variables: + integer :: igrc, ilun, icol + !----------------------------------------------------------------------- + + write(6,*)'calling getglobalwrite with decomp_index= ',decomp_index,' and clmlevel= ',trim(clmlevel) + call GetGlobalWrite(decomp_index, clmlevel) + + if (present (msg)) then + write(iulog,*)'ENDRUN:', msg + else + write(iulog,*)'ENDRUN: called without a message string' + end if + + call shr_sys_abort() + + end subroutine endrun_globalindex + +end module abortutils diff --git a/components/clm/src_clm40/main/accFldsMod.F90 b/components/clm/src_clm40/main/accFldsMod.F90 new file mode 100644 index 0000000000..5e8853857c --- /dev/null +++ b/components/clm/src_clm40/main/accFldsMod.F90 @@ -0,0 +1,1044 @@ +module accFldsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: accFldsMod +! +! !DESCRIPTION: +! This module contains subroutines that initialize, update and extract +! the user-specified fields over user-defined intervals. Each interval +! and accumulation type is unique to each field processed. +! Subroutine [initAccumFlds] defines the fields to be processed +! and the type of accumulation. Subroutine [updateAccumFlds] does +! the actual accumulation for a given field. Fields are accumulated +! by calls to subroutine [update_accum_field]. To accumulate a field, +! it must first be defined in subroutine [initAccumFlds] and then +! accumulated by calls to [updateAccumFlds]. +! Four types of accumulations are possible: +! o average over time interval +! o running mean over time interval +! o running accumulation over time interval +! Time average fields are only valid at the end of the averaging interval. +! Running means are valid once the length of the simulation exceeds the +! averaging interval. Accumulated fields are continuously accumulated. +! The trigger value "-99999." resets the accumulation to zero. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only: endrun + use clm_varctl, only: iulog, use_cndv, use_cn, use_crop + use surfrdMod, only: crop_prog +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: initAccFlds ! Initialization accumulator fields + public :: initAccClmtype ! Initialize clmtype variables obtained from accum fields + public :: updateAccFlds ! Update accumulator fields +! +! !REVISION HISTORY: +! Created by M. Vertenstein 03/2003 +! +!EOP + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: initAccFlds() +! +! !INTERFACE: + subroutine initAccFlds() +! +! !DESCRIPTION: +! Initializes accumulator and sets up array of accumulated fields +! +! !USES: + use accumulMod , only : init_accum_field, print_accum_fields + use clm_time_manager , only : get_step_size + use shr_const_mod, only : SHR_CONST_CDAY, SHR_CONST_TKFRZ +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY:: +! Created by M. Vertenstein 03/2003 +! +! +! !LOCAL VARIABLES: +!EOP +! + integer :: dtime !time step size + integer, parameter :: not_used = huge(1) +!------------------------------------------------------------------------ + + ! Hourly average of 2m temperature. + + dtime = get_step_size() + call init_accum_field(name='TREFAV', units='K', & + desc='average over an hour of 2-m temperature', & + accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! Hourly average of Urban 2m temperature. + + call init_accum_field(name='TREFAV_U', units='K', & + desc='average over an hour of urban 2-m temperature', & + accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! Hourly average of Rural 2m temperature. + + call init_accum_field(name='TREFAV_R', units='K', & + desc='average over an hour of rural 2-m temperature', & + accum_type='timeavg', accum_period=nint(3600._r8/dtime), & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 24hr average of vegetation temperature (heald, 04/06) + call init_accum_field (name='T_VEG24', units='K', & + desc='24hr average of vegetation temperature', & + accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 240hr average of vegetation temperature (heald, 04/06) + call init_accum_field (name='T_VEG240', units='K', & + desc='240hr average of vegetation temperature', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 24hr average of direct solar radiation (heald, 04/06) + call init_accum_field (name='FSD24', units='W/m2', & + desc='24hr average of direct solar radiation', & + accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 240hr average of direct solar radiation (heald, 04/06) + call init_accum_field (name='FSD240', units='W/m2', & + desc='240hr average of direct solar radiation', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 24hr average of diffuse solar radiation (heald, 04/06) + call init_accum_field (name='FSI24', units='W/m2', & + desc='24hr average of diffuse solar radiation', & + accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 240hr average of diffuse solar radiation (heald, 04/06) + call init_accum_field (name='FSI240', units='W/m2', & + desc='240hr average of diffuse solar radiation', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 24hr average of fraction of canopy that is sunlit (heald, 04/06) + call init_accum_field (name='FSUN24', units='fraction', & + desc='24hr average of diffuse solar radiation', & + accum_type='runmean', accum_period=-1, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! 240hr average of fraction of canopy that is sunlit (heald, 04/06) + call init_accum_field (name='FSUN240', units='fraction', & + desc='240hr average of diffuse solar radiation', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! Average of LAI from previous and current timestep (heald, 04/06) + ! corrected to be 10-day average (LKE, 2014-12-5) + call init_accum_field (name='LAIP', units='m2/m2', & + desc='leaf area index average over timestep', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + if (use_cndv .or. use_crop) then + ! The following is a running mean. + ! The accumulation period is set to -10 for a 10-day running mean. + + call init_accum_field (name='T10', units='K', & + desc='10-day running mean of 2-m temperature', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8) + + end if + + if (use_cndv) then + ! 30-day average of 2m temperature. + + call init_accum_field (name='TDA', units='K', & + desc='30-day average of 2-m temperature', & + accum_type='timeavg', accum_period=-30, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! The following are running means. + ! The accumulation period is set to -365 for a 365-day running mean. + + call init_accum_field (name='PREC365', units='MM H2O/S', & + desc='365-day running mean of total precipitation', & + accum_type='runmean', accum_period=-365, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + ! The following are accumulated fields. + ! These types of fields are accumulated until a trigger value resets + ! the accumulation to zero (see subroutine update_accum_field). + ! Hence, [accper] is not valid. + + call init_accum_field (name='AGDDTW', units='K', & + desc='growing degree-days base twmax', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='AGDD', units='K', & + desc='growing degree-days base 5C', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if + + if ( crop_prog )then + ! 10-day average of min 2m temperature. + + call init_accum_field (name='TDM10', units='K', & + desc='10-day running mean of min 2-m temperature', & + accum_type='runmean', accum_period=-10, & + subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) + + ! 5-day average of min 2m temperature. + + call init_accum_field (name='TDM5', units='K', & + desc='5-day running mean of min 2-m temperature', & + accum_type='runmean', accum_period=-5, & + subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) + + ! All GDD summations are relative to the planting date + ! (Kucharik & Brye 2003) + + call init_accum_field (name='GDD0', units='K', & + desc='growing degree-days base 0C from planting', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDD8', units='K', & + desc='growing degree-days base 8C from planting', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDD10', units='K', & + desc='growing degree-days base 10C from planting', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDDPLANT', units='K', & + desc='growing degree-days from planting', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + + call init_accum_field (name='GDDTSOI', units='K', & + desc='growing degree-days from planting (top two soil layers)', & + accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if + + ! Print output of accumulated fields + + call print_accum_fields() + + end subroutine initAccFlds + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: updateAccFlds +! +! !INTERFACE: + subroutine updateAccFlds() +! +! !DESCRIPTION: +! Update and/or extract accumulated fields +! +! !USES: + use clmtype + use clm_atmlnd , only : clm_a2l + use decompMod , only : get_proc_bounds + use clm_varcon , only : spval + use shr_const_mod, only : SHR_CONST_CDAY, SHR_CONST_TKFRZ + use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date + use accumulMod , only : update_accum_field, extract_accum_field + use pftvarcon , only : nwcereal, mxtmp, baset + use clm_time_manager , only : get_start_date + use pftvarcon , only : ndllf_dcd_brl_tree +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by M. Vertenstein 03/2003 +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: itype(:) ! pft vegetation + integer , pointer :: pgridcell(:) ! index into gridcell level quantities + real(r8), pointer :: forc_t(:) ! atmospheric temperature (Kelvin) + real(r8), pointer :: forc_rain(:) ! rain rate [mm/s] + real(r8), pointer :: forc_snow(:) ! snow rate [mm/s] + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_u(:) ! Urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_r(:) ! Rural 2 m height surface air temperature (Kelvin) + logical , pointer :: urbpoi(:) ! true => landunit is an urban point + logical , pointer :: ifspecial(:) ! true => landunit is not vegetated + integer , pointer :: plandunit(:) ! landunit index associated with each pft + real(r8), pointer :: vf(:) ! vernalization factor + real(r8), pointer :: t_soisno(:,:) ! soil temperature (K) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) (nlevgrnd) + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: latdeg(:) ! latitude (radians) + logical , pointer :: croplive(:) ! Flag, true if planted, not harvested + integer , pointer :: pcolumn(:) ! index into column level quantities +! +! local pointers to implicit out arguments +! + ! heald (04/06): variables to be accumulated for VOC emissions + real(r8), pointer :: t_veg(:) ! pft vegetation temperature (Kelvin) + real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (visible only) + real(r8), pointer :: forc_solai(:,:) ! diffuse radiation (visible only) + real(r8), pointer :: fsun(:) ! sunlit fraction of canopy + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + ! heald (04/06): accumulated variables for VOC emissions + real(r8), pointer :: t_veg24(:) ! 24hr average vegetation temperature (K) + real(r8), pointer :: t_veg240(:) ! 240hr average vegetation temperature (Kelvin) + real(r8), pointer :: fsd24(:) ! 24hr average of direct beam radiation + real(r8), pointer :: fsd240(:) ! 240hr average of direct beam radiation + real(r8), pointer :: fsi24(:) ! 24hr average of diffuse beam radiation + real(r8), pointer :: fsi240(:) ! 240hr average of diffuse beam radiation + real(r8), pointer :: fsun24(:) ! 24hr average of sunlit fraction of canopy + real(r8), pointer :: fsun240(:) ! 240hr average of sunlit fraction of canopy + real(r8), pointer :: elai_p(:) ! leaf area index average over timestep + + real(r8), pointer :: t_ref2m_min(:) ! daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max(:) ! daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst(:) ! instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst(:) ! instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_u(:) ! Urban daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_r(:) ! Rural daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_u(:) ! Urban daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_r(:) ! Rural daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst_u(:) ! Urban instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_inst_r(:) ! Rural instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_u(:) ! Urban instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_r(:) ! Rural instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t10(:) ! 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_mo(:) ! 30-day average temperature (Kelvin) + real(r8), pointer :: t_mo_min(:) ! annual min of t_mo (Kelvin) + real(r8), pointer :: prec365(:) ! 365-day running mean of tot. precipitation + real(r8), pointer :: agddtw(:) ! accumulated growing degree days above twmax + real(r8), pointer :: agdd(:) ! accumulated growing degree days above 5 + real(r8), pointer :: twmax(:) ! upper limit of temperature of the warmest month + real(r8), pointer :: gdd0(:) ! growing degree-days base 0C' + real(r8), pointer :: gdd8(:) ! growing degree-days base 8C from planting + real(r8), pointer :: gdd10(:) ! growing degree-days base 10C from planting + real(r8), pointer :: gddplant(:) ! growing degree-days from planting + real(r8), pointer :: gddtsoi(:) ! growing degree-days from planting (top two soil layers) + real(r8), pointer :: a10tmin(:) ! 10-day running mean of min 2-m temperature + real(r8), pointer :: a5tmin(:) ! 5-day running mean of min 2-m temperature +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: g,l,c,p ! indices + integer :: itypveg ! vegetation type + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: year ! year (0, ...) for nstep + integer :: month ! month (1, ..., 12) for nstep + integer :: day ! day of month (1, ..., 31) for nstep + integer :: secs ! seconds into current date for nstep + logical :: end_cd ! temporary for is_end_curr_day() value + integer :: ier ! error status + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + real(r8), pointer :: rbufslp(:) ! temporary single level - pft level +!------------------------------------------------------------------------ + + ! Determine necessary indices + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Assign local pointers to derived subtypes components (gridcell-level) + + forc_t => clm_a2l%forc_t + forc_rain => clm_a2l%forc_rain + forc_snow => clm_a2l%forc_snow + forc_solad => clm_a2l%forc_solad ! (heald 04/06) + forc_solai => clm_a2l%forc_solai ! (heald 04/06) + + ! Assign local pointers to derived subtypes components (landunit-level) + ifspecial => lun%ifspecial + urbpoi => lun%urbpoi + + ! Assign local pointers to derived subtypes components (pft-level) + + itype => pft%itype + pgridcell => pft%gridcell + t_ref2m => pes%t_ref2m + t_ref2m_max_inst => pes%t_ref2m_max_inst + t_ref2m_min_inst => pes%t_ref2m_min_inst + t_ref2m_max => pes%t_ref2m_max + t_ref2m_min => pes%t_ref2m_min + t_ref2m_u => pes%t_ref2m_u + t_ref2m_r => pes%t_ref2m_r + t_ref2m_max_u => pes%t_ref2m_max_u + t_ref2m_max_r => pes%t_ref2m_max_r + t_ref2m_min_u => pes%t_ref2m_min_u + t_ref2m_min_r => pes%t_ref2m_min_r + t_ref2m_max_inst_u => pes%t_ref2m_max_inst_u + t_ref2m_max_inst_r => pes%t_ref2m_max_inst_r + t_ref2m_min_inst_u => pes%t_ref2m_min_inst_u + t_ref2m_min_inst_r => pes%t_ref2m_min_inst_r + plandunit => pft%landunit + t10 => pes%t10 + a10tmin => pes%a10tmin + a5tmin => pes%a5tmin + t_mo => pdgvs%t_mo + t_mo_min => pdgvs%t_mo_min + prec365 => pdgvs%prec365 + agddtw => pdgvs%agddtw + agdd => pdgvs%agdd + twmax => dgv_pftcon%twmax + gdd0 => pps%gdd0 + gdd8 => pps%gdd8 + gdd10 => pps%gdd10 + gddplant => pps%gddplant + gddtsoi => pps%gddtsoi + vf => pps%vf + t_soisno => ces%t_soisno + h2osoi_liq => cws%h2osoi_liq + watsat => cps%watsat + dz => cps%dz + latdeg => grc%latdeg + croplive => pps%croplive + pcolumn => pft%column + t_veg24 => pvs%t_veg24 ! (heald 04/06) + t_veg240 => pvs%t_veg240 ! (heald 04/06) + fsd24 => pvs%fsd24 ! (heald 04/06) + fsd240 => pvs%fsd240 ! (heald 04/06) + fsi24 => pvs%fsi24 ! (heald 04/06) + fsi240 => pvs%fsi240 ! (heald 04/06) + fsun24 => pvs%fsun24 ! (heald 04/06) + fsun240 => pvs%fsun240 ! (heald 04/06) + elai_p => pvs%elai_p ! (heald 04/06) + t_veg => pes%t_veg ! (heald 04/06) + fsun => pps%fsun ! (heald 04/06) + elai => pps%elai ! (heald 04/06) + + ! Determine calendar information + + dtime = get_step_size() + nstep = get_nstep() + call get_curr_date (year, month, day, secs) + + ! Don't do any accumulation if nstep is zero + ! (only applies to coupled or cam mode) + + if (nstep == 0) return + + ! NOTE: currently only single level pft fields are used below + ! Variables are declared above that should make it easy to incorporate + ! multi-level or single-level fields of any subgrid type + + ! Allocate needed dynamic memory for single level pft field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'update_accum_hist allocation error for rbuf1dp' + call endrun + endif + + ! Accumulate and extract TREFAV - hourly average 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV', t_ref2m, nstep) + call extract_accum_field ('TREFAV', rbufslp, nstep) + end_cd = is_end_curr_day() + do p = begp,endp + if (rbufslp(p) /= spval) then + t_ref2m_max_inst(p) = max(rbufslp(p), t_ref2m_max_inst(p)) + t_ref2m_min_inst(p) = min(rbufslp(p), t_ref2m_min_inst(p)) + endif + if (end_cd) then + t_ref2m_max(p) = t_ref2m_max_inst(p) + t_ref2m_min(p) = t_ref2m_min_inst(p) + t_ref2m_max_inst(p) = -spval + t_ref2m_min_inst(p) = spval + else if (secs == int(dtime)) then + t_ref2m_max(p) = spval + t_ref2m_min(p) = spval + endif + end do + + ! Accumulate and extract TREFAV_U - hourly average urban 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV_U', t_ref2m_u, nstep) + call extract_accum_field ('TREFAV_U', rbufslp, nstep) + do p = begp,endp + l = plandunit(p) + if (rbufslp(p) /= spval) then + t_ref2m_max_inst_u(p) = max(rbufslp(p), t_ref2m_max_inst_u(p)) + t_ref2m_min_inst_u(p) = min(rbufslp(p), t_ref2m_min_inst_u(p)) + endif + if (end_cd) then + if (urbpoi(l)) then + t_ref2m_max_u(p) = t_ref2m_max_inst_u(p) + t_ref2m_min_u(p) = t_ref2m_min_inst_u(p) + t_ref2m_max_inst_u(p) = -spval + t_ref2m_min_inst_u(p) = spval + end if + else if (secs == int(dtime)) then + t_ref2m_max_u(p) = spval + t_ref2m_min_u(p) = spval + endif + end do + + ! Accumulate and extract TREFAV_R - hourly average rural 2m air temperature + ! Used to compute maximum and minimum of hourly averaged 2m reference + ! temperature over a day. Note that "spval" is returned by the call to + ! accext if the time step does not correspond to the end of an + ! accumulation interval. First, initialize the necessary values for + ! an initial run at the first time step the accumulator is called + + call update_accum_field ('TREFAV_R', t_ref2m_r, nstep) + call extract_accum_field ('TREFAV_R', rbufslp, nstep) + do p = begp,endp + l = plandunit(p) + if (rbufslp(p) /= spval) then + t_ref2m_max_inst_r(p) = max(rbufslp(p), t_ref2m_max_inst_r(p)) + t_ref2m_min_inst_r(p) = min(rbufslp(p), t_ref2m_min_inst_r(p)) + endif + if (end_cd) then + if (.not.(ifspecial(l))) then + t_ref2m_max_r(p) = t_ref2m_max_inst_r(p) + t_ref2m_min_r(p) = t_ref2m_min_inst_r(p) + t_ref2m_max_inst_r(p) = -spval + t_ref2m_min_inst_r(p) = spval + end if + else if (secs == int(dtime)) then + t_ref2m_max_r(p) = spval + t_ref2m_min_r(p) = spval + endif + end do + + ! Accumulate and extract T_VEG24 & T_VEG240 (heald 04/06) + do p = begp,endp + rbufslp(p) = t_veg(p) + end do + call update_accum_field ('T_VEG24', rbufslp, nstep) + call extract_accum_field ('T_VEG24', t_veg24, nstep) + call update_accum_field ('T_VEG240', rbufslp, nstep) + call extract_accum_field ('T_VEG240', t_veg240, nstep) + + ! Accumulate and extract forc_solad24 & forc_solad240 (heald 04/06) + do p = begp,endp + g = pgridcell(p) + rbufslp(p) = forc_solad(g,1) + end do + call update_accum_field ('FSD240', rbufslp, nstep) + call extract_accum_field ('FSD240', fsd240, nstep) + call update_accum_field ('FSD24', rbufslp, nstep) + call extract_accum_field ('FSD24', fsd24, nstep) + + ! Accumulate and extract forc_solai24 & forc_solai240 (heald 04/06) + do p = begp,endp + g = pgridcell(p) + rbufslp(p) = forc_solai(g,1) + end do + call update_accum_field ('FSI24', rbufslp, nstep) + call extract_accum_field ('FSI24', fsi24, nstep) + call update_accum_field ('FSI240', rbufslp, nstep) + call extract_accum_field ('FSI240', fsi240, nstep) + + ! Accumulate and extract fsun24 & fsun240 (heald 04/06) + do p = begp,endp + rbufslp(p) = fsun(p) + end do + call update_accum_field ('FSUN24', rbufslp, nstep) + call extract_accum_field ('FSUN24', fsun24, nstep) + call update_accum_field ('FSUN240', rbufslp, nstep) + call extract_accum_field ('FSUN240', fsun240, nstep) + + ! Accumulate and extract elai_p (heald 04/06) + do p = begp,endp + rbufslp(p) = elai(p) + end do + call update_accum_field ('LAIP', rbufslp, nstep) + call extract_accum_field ('LAIP', elai_p, nstep) + + if (use_cndv .or. use_crop) then + ! Accumulate and extract T10 + !(acumulates TSA as 10-day running mean) + + call update_accum_field ('T10', t_ref2m, nstep) + call extract_accum_field ('T10', t10, nstep) + end if + + if (use_cndv) then + ! Accumulate and extract TDA + ! (accumulates TBOT as 30-day average) + ! Also determine t_mo_min + + do p = begp,endp + g = pgridcell(p) + rbufslp(p) = forc_t(g) + end do + call update_accum_field ('TDA', rbufslp, nstep) + call extract_accum_field ('TDA', rbufslp, nstep) + do p = begp,endp + t_mo(p) = rbufslp(p) + t_mo_min(p) = min(t_mo_min(p), rbufslp(p)) + end do + + ! Accumulate and extract PREC365 + ! (accumulates total precipitation as 365-day running mean) + + do p = begp,endp + g = pgridcell(p) + rbufslp(p) = forc_rain(g) + forc_snow(g) + end do + call update_accum_field ('PREC365', rbufslp, nstep) + call extract_accum_field ('PREC365', prec365, nstep) + + ! Accumulate growing degree days based on 10-day running mean temperature. + ! The trigger to reset the accumulated values to zero is -99999. + + ! Accumulate and extract AGDDTW (gdd base twmax, which is 23 deg C + ! for boreal woody pfts) + + do p = begp,endp + rbufslp(p) = max(0._r8, (t10(p) - SHR_CONST_TKFRZ - twmax(ndllf_dcd_brl_tree)) & + * dtime/SHR_CONST_CDAY) + if (month==1 .and. day==1 .and. secs==int(dtime)) rbufslp(p) = -99999._r8 + end do + call update_accum_field ('AGDDTW', rbufslp, nstep) + call extract_accum_field ('AGDDTW', agddtw, nstep) + + ! Accumulate and extract AGDD + + do p = begp,endp + rbufslp(p) = max(0.0_r8, (t_ref2m(p) - (SHR_CONST_TKFRZ + 5.0_r8)) & + * dtime/SHR_CONST_CDAY) + end do + call update_accum_field ('AGDD', rbufslp, nstep) + call extract_accum_field ('AGDD', agdd, nstep) + end if + + if ( crop_prog )then + ! Accumulate and extract TDM10 + + do p = begp,endp + rbufslp(p) = min(t_ref2m_min(p),t_ref2m_min_inst(p)) !slevis: ok choice? + if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& + end do !'min_inst' not initialized? + call update_accum_field ('TDM10', rbufslp, nstep) + call extract_accum_field ('TDM10', a10tmin, nstep) + + ! Accumulate and extract TDM5 + + do p = begp,endp + rbufslp(p) = min(t_ref2m_min(p),t_ref2m_min_inst(p)) !slevis: ok choice? + if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& + end do !'min_inst' not initialized? + call update_accum_field ('TDM5', rbufslp, nstep) + call extract_accum_field ('TDM5', a5tmin, nstep) + + ! Accumulate and extract GDD0 + + do p = begp,endp + itypveg = itype(p) + g = pgridcell(p) + if (month==1 .and. day==1 .and. secs==int(dtime)) then + rbufslp(p) = -99999._r8 ! reset gdd + else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(26._r8, t_ref2m(p)-SHR_CONST_TKFRZ)) & + * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD0', rbufslp, nstep) + call extract_accum_field ('GDD0', gdd0, nstep) + + ! Accumulate and extract GDD8 + + do p = begp,endp + itypveg = itype(p) + g = pgridcell(p) + if (month==1 .and. day==1 .and. secs==int(dtime)) then + rbufslp(p) = -99999._r8 ! reset gdd + else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(30._r8, & + t_ref2m(p)-(SHR_CONST_TKFRZ + 8._r8))) & + * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD8', rbufslp, nstep) + call extract_accum_field ('GDD8', gdd8, nstep) + + ! Accumulate and extract GDD10 + + do p = begp,endp + itypveg = itype(p) + g = pgridcell(p) + if (month==1 .and. day==1 .and. secs==int(dtime)) then + rbufslp(p) = -99999._r8 ! reset gdd + else if (( month > 3 .and. month < 10 .and. latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(30._r8, & + t_ref2m(p)-(SHR_CONST_TKFRZ + 10._r8))) & + * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD10', rbufslp, nstep) + call extract_accum_field ('GDD10', gdd10, nstep) + + ! Accumulate and extract GDDPLANT + + do p = begp,endp + if (croplive(p)) then ! relative to planting date + itypveg = itype(p) + rbufslp(p) = max(0._r8, min(mxtmp(itypveg), & + t_ref2m(p)-(SHR_CONST_TKFRZ + baset(itypveg)))) & + * dtime/SHR_CONST_CDAY + if (itypveg == nwcereal) rbufslp(p) = rbufslp(p)*vf(p) + else + rbufslp(p) = -99999._r8 + end if + end do + call update_accum_field ('GDDPLANT', rbufslp, nstep) + call extract_accum_field ('GDDPLANT', gddplant, nstep) + + ! Accumulate and extract GDDTSOI + ! In agroibis this variable is calculated + ! to 0.05 m, so here we use the top two soil layers + + do p = begp,endp + if (croplive(p)) then ! relative to planting date + itypveg = itype(p) + c = pcolumn(p) + rbufslp(p) = max(0._r8, min(mxtmp(itypveg), & + ((t_soisno(c,1)*dz(c,1)+t_soisno(c,2)*dz(c,2))/(dz(c,1)+dz(c,2))) - & + (SHR_CONST_TKFRZ + baset(itypveg)))) * dtime/SHR_CONST_CDAY + if (itypveg == nwcereal) rbufslp(p) = rbufslp(p)*vf(p) + else + rbufslp(p) = -99999._r8 + end if + end do + call update_accum_field ('GDDTSOI', rbufslp, nstep) + call extract_accum_field ('GDDTSOI', gddtsoi, nstep) + + end if + + ! Deallocate dynamic memory + + deallocate(rbufslp) + + end subroutine updateAccFlds + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: initAccClmtype +! +! !INTERFACE: + subroutine initAccClmtype +! +! !DESCRIPTION: +! Initialize clmtype variables that are associated with +! time accumulated fields. This routine is called in an initial run +! at nstep=0 for cam and csm mode. +! This routine is also always called for a restart run and +! therefore must be called after the restart file is read in +! and the accumulated fields are obtained. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use decompMod , only : get_proc_bounds, get_proc_global + use accumulMod , only : extract_accum_field + use clm_time_manager, only : get_nstep + use clm_varctl , only : nsrest, nsrStartup + use clm_varcon , only : spval +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit out arguments +! + real(r8), pointer :: t_ref2m_min(:) ! daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max(:) ! daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst(:) ! instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst(:) ! instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_u(:) ! Urban daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_r(:) ! Rural daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_u(:) ! Urban daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_r(:) ! Rural daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst_u(:) ! Urban instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_inst_r(:) ! Rural instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_u(:) ! Urban instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_r(:) ! Rural instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t10(:) ! 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_mo(:) ! 30-day average temperature (Kelvin) + real(r8), pointer :: prec365(:) ! 365-day running mean of tot. precipitation + real(r8), pointer :: agddtw(:) ! accumulated growing degree days above twmax + real(r8), pointer :: agdd(:) ! accumulated growing degree days above 5 + real(r8), pointer :: gdd0(:) ! growing degree-days base 0C' + real(r8), pointer :: gdd8(:) ! growing degree-days base 8C from planting + real(r8), pointer :: gdd10(:) ! growing degree-days base 10C from planting + real(r8), pointer :: gddplant(:) ! growing degree-days from planting + real(r8), pointer :: gddtsoi(:) ! growing degree-days from planting (top two soil layers) + real(r8), pointer :: a10tmin(:) ! 10-day running mean of min 2-m temperature + real(r8), pointer :: a5tmin(:) ! 5-day running mean of min 2-m temperature + ! heald (04/06): accumulated variables for VOC emissions + real(r8), pointer :: t_veg24(:) ! 24hr average vegetation temperature (K) + real(r8), pointer :: t_veg240(:) ! 240hr average vegetation temperature (Kelvin) + real(r8), pointer :: fsd24(:) ! 24hr average of direct beam radiation + real(r8), pointer :: fsd240(:) ! 240hr average of direct beam radiation + real(r8), pointer :: fsi24(:) ! 24hr average of diffuse beam radiation + real(r8), pointer :: fsi240(:) ! 240hr average of diffuse beam radiation + real(r8), pointer :: fsun24(:) ! 24hr average of sunlit fraction of canopy + real(r8), pointer :: fsun240(:) ! 240hr average of sunlit fraction of canopy + real(r8), pointer :: elai_p(:) ! leaf area index average over timestep +! +! !LOCAL VARIABLES: +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: p ! indices + integer :: nstep ! time step + integer :: ier ! error status + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + real(r8), pointer :: rbufslp(:) ! temporary + character(len=32) :: subname = 'initAccClmtype' ! subroutine name +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (pft-level) + + t_ref2m_max_inst => pes%t_ref2m_max_inst + t_ref2m_min_inst => pes%t_ref2m_min_inst + t_ref2m_max => pes%t_ref2m_max + t_ref2m_min => pes%t_ref2m_min + t_ref2m_max_inst_u => pes%t_ref2m_max_inst_u + t_ref2m_max_inst_r => pes%t_ref2m_max_inst_r + t_ref2m_min_inst_u => pes%t_ref2m_min_inst_u + t_ref2m_min_inst_r => pes%t_ref2m_min_inst_r + t_ref2m_max_u => pes%t_ref2m_max_u + t_ref2m_max_r => pes%t_ref2m_max_r + t_ref2m_min_u => pes%t_ref2m_min_u + t_ref2m_min_r => pes%t_ref2m_min_r + t10 => pes%t10 + a10tmin => pes%a10tmin + a5tmin => pes%a5tmin + t_mo => pdgvs%t_mo + prec365 => pdgvs%prec365 + agddtw => pdgvs%agddtw + agdd => pdgvs%agdd + gdd0 => pps%gdd0 + gdd8 => pps%gdd8 + gdd10 => pps%gdd10 + gddplant => pps%gddplant + gddtsoi => pps%gddtsoi + ! heald (04/06): accumulated variables for VOC emissions + t_veg24 => pvs%t_veg24 + t_veg240 => pvs%t_veg240 + fsd24 => pvs%fsd24 + fsd240 => pvs%fsd240 + fsi24 => pvs%fsi24 + fsi240 => pvs%fsi240 + fsun24 => pvs%fsun24 + fsun240 => pvs%fsun240 + elai_p => pvs%elai_p + + ! Determine necessary indices + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Determine time step + + nstep = get_nstep() + + ! Initialize 2m ref temperature max and min values + + if (nsrest == nsrStartup) then ! Why not restart&branch? These vars are not in clmr. + do p = begp,endp + t_ref2m_max(p) = spval + t_ref2m_min(p) = spval + t_ref2m_max_inst(p) = -spval + t_ref2m_min_inst(p) = spval + t_ref2m_max_u(p) = spval + t_ref2m_max_r(p) = spval + t_ref2m_min_u(p) = spval + t_ref2m_min_r(p) = spval + t_ref2m_max_inst_u(p) = -spval + t_ref2m_max_inst_r(p) = -spval + t_ref2m_min_inst_u(p) = spval + t_ref2m_min_inst_r(p) = spval + end do + end if + + ! Allocate needed dynamic memory for single level pft field + + allocate(rbufslp(begp:endp), stat=ier) + if (ier/=0) then + write(iulog,*)'extract_accum_hist allocation error for rbufslp in '//subname + call endrun + endif + + ! Initialize clmtype variables that are to be time accumulated + + call extract_accum_field ('T_VEG24', rbufslp, nstep) + do p = begp,endp + t_veg24(p) = rbufslp(p) + end do + + call extract_accum_field ('T_VEG240', rbufslp, nstep) + do p = begp,endp + t_veg240(p) = rbufslp(p) + end do + + call extract_accum_field ('FSD24', rbufslp, nstep) + do p = begp,endp + fsd24(p) = rbufslp(p) + end do + + call extract_accum_field ('FSD240', rbufslp, nstep) + do p = begp,endp + fsd240(p) = rbufslp(p) + end do + + call extract_accum_field ('FSI24', rbufslp, nstep) + do p = begp,endp + fsi24(p) = rbufslp(p) + end do + + call extract_accum_field ('FSI240', rbufslp, nstep) + do p = begp,endp + fsi240(p) = rbufslp(p) + end do + + call extract_accum_field ('FSUN24', rbufslp, nstep) + do p = begp,endp + fsun24(p) = rbufslp(p) + end do + + call extract_accum_field ('FSUN240', rbufslp, nstep) + do p = begp,endp + fsun240(p) = rbufslp(p) + end do + + call extract_accum_field ('LAIP', rbufslp, nstep) + do p = begp,endp + elai_p(p) = rbufslp(p) + end do + + if ( crop_prog )then + + call extract_accum_field ('GDD0', rbufslp, nstep) + do p = begp,endp + gdd0(p) = rbufslp(p) + end do + + call extract_accum_field ('GDD8', rbufslp, nstep) + do p = begp,endp + gdd8(p) = rbufslp(p) + end do + + call extract_accum_field ('GDD10', rbufslp, nstep) + do p = begp,endp + gdd10(p) = rbufslp(p) + end do + + call extract_accum_field ('GDDPLANT', rbufslp, nstep) + do p = begp,endp + gddplant(p) = rbufslp(p) + end do + + call extract_accum_field ('GDDTSOI', rbufslp, nstep) + do p = begp,endp + gddtsoi(p) = rbufslp(p) + end do + + call extract_accum_field ('TDM10', rbufslp, nstep) + do p = begp,endp + a10tmin(p) = rbufslp(p) + end do + + call extract_accum_field ('TDM5', rbufslp, nstep) + do p = begp,endp + a5tmin(p) = rbufslp(p) + end do + + end if + + if (use_cndv .or. use_crop) then + call extract_accum_field ('T10', rbufslp, nstep) + do p = begp,endp + t10(p) = rbufslp(p) + end do + end if + + if (use_cndv) then + call extract_accum_field ('TDA', rbufslp, nstep) + do p = begp,endp + t_mo(p) = rbufslp(p) + end do + + call extract_accum_field ('PREC365', rbufslp, nstep) + do p = begp,endp + prec365(p) = rbufslp(p) + end do + + call extract_accum_field ('AGDDTW', rbufslp, nstep) + do p = begp,endp + agddtw(p) = rbufslp(p) + end do + + call extract_accum_field ('AGDD', rbufslp, nstep) + do p = begp,endp + agdd(p) = rbufslp(p) + end do + end if + + deallocate(rbufslp) + + end subroutine initAccClmtype + +end module accFldsMod diff --git a/components/clm/src_clm40/main/accumulMod.F90 b/components/clm/src_clm40/main/accumulMod.F90 new file mode 100644 index 0000000000..f78723f975 --- /dev/null +++ b/components/clm/src_clm40/main/accumulMod.F90 @@ -0,0 +1,656 @@ +module accumulMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! This module contains generic subroutines that can be used to + ! define, accumulate and extract user-specified fields over + ! user-defined intervals. Each interval and accumulation type is + ! unique to each field processed. + ! Subroutine [init_accumulator] defines the values of the accumulated + ! field data structure. Subroutine [update_accum_field] does + ! the actual accumulation for a given field. + ! Four types of accumulations are possible: + ! - Average over time interval. Time average fields are only + ! valid at the end of the averaging interval. + ! - Running mean over time interval. Running means are valid once the + ! length of the simulation exceeds the + ! - Running accumulation over time interval. Accumulated fields are + ! continuously accumulated. The trigger value "-99999." resets + ! the accumulation to zero. + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod , only: shr_sys_abort + use clm_varctl , only: iulog + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: accumulRest ! Write/read restart of accumulation fields + public :: init_accum_field ! Initialize an accumulator field + public :: print_accum_fields ! Print info about accumulator fields + public :: extract_accum_field ! Extracts the current value of an accumulator field + public :: update_accum_field ! Update the current value of an accumulator field + + interface extract_accum_field + module procedure extract_accum_field_sl ! Extract current val of single-level accumulator field + module procedure extract_accum_field_ml ! Extract current val of multi-level accumulator field + end interface + interface update_accum_field ! Updates the current value of an accumulator field + module procedure update_accum_field_sl ! Update single-level accumulator field + module procedure update_accum_field_ml ! Update multi-level accumulator field + end interface + private + ! + ! !PRIVATE TYPES: + type accum_field + character(len= 8) :: name !field name + character(len=128) :: desc !field description + character(len= 8) :: units !field units + character(len= 8) :: acctype !accumulation type: ["timeavg","runmean","runaccum"] + character(len= 8) :: type1d !subgrid type: ["gridcell","landunit","column" or "pft"] + character(len= 8) :: type2d !type2d ('','levsoi','numrad',..etc. ) + integer :: beg1d !subgrid type beginning index + integer :: end1d !subgrid type ending index + integer :: num1d !total subgrid points + integer :: numlev !number of vertical levels in field + real(r8) :: initval !initial value of accumulated field + real(r8), pointer :: val(:,:) !accumulated field + integer :: period !field accumulation period (in model time steps) + end type accum_field + + real(r8), parameter, public :: accumResetVal = -99999._r8 ! used to do an annual reset ( put in for bug 1858) + + integer, parameter :: max_accum = 100 !maximum number of accumulated fields + type (accum_field) :: accum(max_accum) !array accumulated fields + integer :: naccflds = 0 !accumulator field counter + + integer :: iflag_interp = 1 + integer :: iflag_copy = 2 + integer :: iflag_skip = 3 + !------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------ + subroutine init_accum_field (name, units, desc, & + accum_type, accum_period, numlev, subgrid_type, init_value, type2d) + ! + ! !DESCRIPTION: + ! Initialize accumulation fields. This subroutine sets: + ! o name of accumulated field + ! o units of accumulated field + ! o accumulation type of accumulated field + ! o description of accumulated fields: accdes + ! o accumulation period for accumulated field (in iterations) + ! o initial value of accumulated field + ! + ! !USES: + use shr_const_mod, only: SHR_CONST_CDAY + use clm_time_manager, only : get_step_size + use decompMod, only : get_proc_bounds, get_proc_global + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + character(len=*), intent(in) :: units !field units + character(len=*), intent(in) :: desc !field description + character(len=*), intent(in) :: accum_type !field type: tavg, runm, runa, ins + integer , intent(in) :: accum_period !field accumulation period + character(len=*), intent(in) :: subgrid_type !["gridcell","landunit","column" or "pft"] + integer , intent(in) :: numlev !number of vertical levels + real(r8), intent(in) :: init_value !field initial or reset value + character(len=*), intent(in), optional :: type2d !level type (optional) - needed if numlev > 1 + ! + ! !LOCAL VARIABLES: + integer :: nf ! field index + integer :: beg1d,end1d ! beggining and end subgrid indices + integer :: num1d ! total number subgrid indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: begCohort, endCohort ! per-proc beg end cohort indices + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: numCohort ! total number of cohorts across all processors + !------------------------------------------------------------------------ + + ! Determine necessary indices + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort ) + call get_proc_global(numg, numl, numc, nump, numCohort) + + ! update field index + ! Consistency check that number of accumulated does not exceed maximum. + + naccflds = naccflds + 1 + if (naccflds > max_accum) then + write(iulog,*) 'ACCUMULINIT error: user-defined accumulation fields ', & + 'equal to ',naccflds,' exceeds max_accum' + call shr_sys_abort() + end if + nf = naccflds + + ! Note accumulation period must be converted from days + ! to number of iterations + + accum(nf)%name = trim(name) + accum(nf)%units = trim(units) + accum(nf)%desc = trim(desc) + accum(nf)%acctype = trim(accum_type) + accum(nf)%initval = init_value + accum(nf)%period = accum_period + if (accum(nf)%period < 0) then + accum(nf)%period = -accum(nf)%period * nint(SHR_CONST_CDAY) / get_step_size() + end if + + select case (trim(subgrid_type)) + case ('gridcell') + beg1d = begg + end1d = endg + num1d = numg + case ('landunit') + beg1d = begl + end1d = endl + num1d = numl + case ('column') + beg1d = begc + end1d = endc + num1d = numc + case ('pft') + beg1d = begp + end1d = endp + num1d = nump + case default + write(iulog,*)'ACCUMULINIT: unknown subgrid type ',subgrid_type + call shr_sys_abort () + end select + + accum(nf)%type1d = trim(subgrid_type) + accum(nf)%beg1d = beg1d + accum(nf)%end1d = end1d + accum(nf)%num1d = num1d + accum(nf)%numlev = numlev + + if (present(type2d)) then + accum(nf)%type2d = type2d + else + accum(nf)%type2d = ' ' + end if + + ! Allocate and initialize accumulation field + + allocate(accum(nf)%val(beg1d:end1d,numlev)) + accum(nf)%val(beg1d:end1d,numlev) = init_value + + end subroutine init_accum_field + + !------------------------------------------------------------------------ + subroutine print_accum_fields() + ! + ! !DESCRIPTION: + ! Diagnostic printout of accumulated fields + ! + ! !USES: + use spmdMod, only : masterproc + ! + ! !ARGUMENTS: + implicit none + ! + integer :: i,nf !indices + !------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) + write(iulog,*) 'Initializing variables for time accumulation .....' + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Accumulated fields' + write(iulog,1002) + write(iulog,'(72a1)') ("_",i=1,71) + do nf = 1, naccflds + if (accum(nf)%period /= huge(1)) then + write(iulog,1003) nf,accum(nf)%name,accum(nf)%units,& + accum(nf)%acctype, accum(nf)%period, accum(nf)%initval, & + accum(nf)%desc + else + write(iulog,1004) nf,accum(nf)%name,accum(nf)%units,& + accum(nf)%acctype, accum(nf)%initval, accum(nf)%desc + endif + end do + write(iulog,'(72a1)') ("_",i=1,71) + write(iulog,*) + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Successfully initialized variables for accumulation' + write(iulog,*) + endif + +1002 format(' No',' Name ',' Units ',' Type ','Period',' Inival',' Description') +1003 format((1x,i2),(1x,a8),(1x,a8),(1x,a8), (1x,i5),(1x,f4.0),(1x,a40)) +1004 format((1x,i2),(1x,a8),(1x,a8),(1x,a8),' N.A.',(1x,f4.0),(1x,a40)) + + end subroutine print_accum_fields + + !------------------------------------------------------------------------ + subroutine extract_accum_field_sl (name, field, nstep) + ! + ! !DESCRIPTION: + ! Extract single-level accumulated field. + ! This routine extracts the field values from the multi-level + ! accumulation field. It extracts the current value except if + ! the field type is a time average. In this case, an absurd value + ! is assigned to indicate the time average is not yet valid. + ! + ! !USES: + use clm_varcon, only : spval, ispval + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:) :: field !field values for current time step + integer , intent(in) :: nstep !timestep index + ! + ! !LOCAL VARIABLES: + integer :: i,k,nf !indices + integer :: beg,end !subgrid beginning,ending indices + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'EXTRACT_ACCUM_FIELD_SL error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',& + size(field,dim=1),' and should be ',end-beg+1 + call shr_sys_abort + endif + + ! extract field + + if (accum(nf)%acctype == 'timeavg' .and. & + mod(nstep,accum(nf)%period) /= 0) then + do k = beg,end + field(k) = spval !assign absurd value when avg not ready + end do + else + do k = beg,end + field(k) = accum(nf)%val(k,1) + end do + end if + + end subroutine extract_accum_field_sl + + !------------------------------------------------------------------------ + subroutine extract_accum_field_ml (name, field, nstep) + ! + ! !DESCRIPTION: + ! Extract mutli-level accumulated field. + ! This routine extracts the field values from the multi-level + ! accumulation field. It extracts the current value except if + ! the field type is a time average. In this case, an absurd value + ! is assigned to indicate the time average is not yet valid. + ! + ! !USES: + use clm_varcon, only : spval + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:,:) :: field !field values for current time step + integer, intent(in) :: nstep !timestep index + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,nf !indices + integer :: beg,end !subgrid beginning,ending indices + integer :: numlev !number of vertical levels + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'EXTRACT_ACCUM_FIELD_ML error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + numlev = accum(nf)%numlev + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',& + size(field,dim=1),' and should be ',end-beg+1 + call shr_sys_abort + else if (size(field,dim=2) /= numlev) then + write(iulog,*)'ERROR in extract_accum_field for field ',accum(nf)%name + write(iulog,*)'size of second dimension of field iis ',& + size(field,dim=2),' and should be ',numlev + call shr_sys_abort + endif + + !extract field + + if (accum(nf)%acctype == 'timeavg' .and. & + mod(nstep,accum(nf)%period) /= 0) then + do j = 1,numlev + do k = beg,end + field(k,j) = spval !assign absurd value when avg not ready + end do + end do + else + do j = 1,numlev + do k = beg,end + field(k,j) = accum(nf)%val(k,j) + end do + end do + end if + + end subroutine extract_accum_field_ml + + !------------------------------------------------------------------------ + subroutine update_accum_field_sl (name, field, nstep) + ! + ! !DESCRIPTION: + ! Accumulate single level field over specified time interval. + ! The appropriate field is accumulated in the array [accval]. + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:) :: field !field values for current time step + integer , intent(in) :: nstep !time step index + ! + ! !LOCAL VARIABLES: + integer :: i,k,nf !indices + integer :: accper !temporary accumulation period + integer :: beg,end !subgrid beginning,ending indices + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'UPDATE_ACCUM_FIELD_SL error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_SL for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',size(field,dim=1),& + ' and should be ',end-beg+1 + call shr_sys_abort + endif + + ! accumulate field + + if (accum(nf)%acctype /= 'timeavg' .AND. & + accum(nf)%acctype /= 'runmean' .AND. & + accum(nf)%acctype /= 'runaccum') then + write(iulog,*) 'UPDATE_ACCUM_FIELD_SL error: incorrect accumulation type' + write(iulog,*) ' was specified for field ',name + write(iulog,*)' accumulation type specified is ',accum(nf)%acctype + write(iulog,*)' only [timeavg, runmean, runaccum] are currently acceptable' + call shr_sys_abort() + end if + + + ! reset accumulated field value if necessary and update + ! accumulation field + ! running mean never reset + + if (accum(nf)%acctype == 'timeavg') then + + !time average field reset every accumulation period + !normalize at end of accumulation period + + if ((mod(nstep,accum(nf)%period) == 1 .or. accum(nf)%period == 1) .and. (nstep /= 0))then + accum(nf)%val(beg:end,1) = 0._r8 + end if + accum(nf)%val(beg:end,1) = accum(nf)%val(beg:end,1) + field(beg:end) + if (mod(nstep,accum(nf)%period) == 0) then + accum(nf)%val(beg:end,1) = accum(nf)%val(beg:end,1) / accum(nf)%period + endif + + else if (accum(nf)%acctype == 'runmean') then + + !running mean - reset accumulation period until greater than nstep + + accper = min (nstep,accum(nf)%period) + accum(nf)%val(beg:end,1) = ((accper-1)*accum(nf)%val(beg:end,1) + field(beg:end)) / accper + + else if (accum(nf)%acctype == 'runaccum') then + + !running accumulation field reset at trigger -99999 + + do k = beg,end + if (nint(field(k)) == -99999) then + accum(nf)%val(k,1) = 0._r8 + end if + end do + accum(nf)%val(beg:end,1) = min(max(accum(nf)%val(beg:end,1) + field(beg:end), 0._r8), 99999._r8) + + end if + + end subroutine update_accum_field_sl + + !------------------------------------------------------------------------ + subroutine update_accum_field_ml (name, field, nstep) + ! + ! !DESCRIPTION: + ! Accumulate multi level field over specified time interval. + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name !field name + real(r8), pointer, dimension(:,:) :: field !field values for current time step + integer , intent(in) :: nstep !time step index + ! + ! !LOCAL VARIABLES: + integer :: i,j,k,nf !indices + integer :: accper !temporary accumulation period + integer :: beg,end !subgrid beginning,ending indices + integer :: numlev !number of vertical levels + !------------------------------------------------------------------------ + + ! find field index. return if "name" is not on list + + nf = 0 + do i = 1, naccflds + if (name == accum(i)%name) nf = i + end do + if (nf == 0) then + write(iulog,*) 'UPDATE_ACCUM_FIELD_ML error: field name ',name,' not found' + call shr_sys_abort + endif + + ! error check + + numlev = accum(nf)%numlev + beg = accum(nf)%beg1d + end = accum(nf)%end1d + if (size(field,dim=1) /= end-beg+1) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name + write(iulog,*)'size of first dimension of field is ',size(field,dim=1),& + ' and should be ',end-beg+1 + call shr_sys_abort + else if (size(field,dim=2) /= numlev) then + write(iulog,*)'ERROR in UPDATE_ACCUM_FIELD_ML for field ',accum(nf)%name + write(iulog,*)'size of second dimension of field is ',size(field,dim=2),& + ' and should be ',numlev + call shr_sys_abort + endif + + ! accumulate field + + if (accum(nf)%acctype /= 'timeavg' .AND. & + accum(nf)%acctype /= 'runmean' .AND. & + accum(nf)%acctype /= 'runaccum') then + write(iulog,*) 'UPDATE_ACCUM_FIELD_ML error: incorrect accumulation type' + write(iulog,*) ' was specified for field ',name + write(iulog,*)' accumulation type specified is ',accum(nf)%acctype + write(iulog,*)' only [timeavg, runmean, runaccum] are currently acceptable' + call shr_sys_abort() + end if + + ! accumulate field + + ! reset accumulated field value if necessary and update + ! accumulation field + ! running mean never reset + + if (accum(nf)%acctype == 'timeavg') then + + !time average field reset every accumulation period + !normalize at end of accumulation period + + if ((mod(nstep,accum(nf)%period) == 1 .or. accum(nf)%period == 1) .and. (nstep /= 0))then + accum(nf)%val(beg:end,1:numlev) = 0._r8 + endif + accum(nf)%val(beg:end,1:numlev) = accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev) + if (mod(nstep,accum(nf)%period) == 0) then + accum(nf)%val(beg:end,1:numlev) = accum(nf)%val(beg:end,1:numlev) / accum(nf)%period + endif + + else if (accum(nf)%acctype == 'runmean') then + + !running mean - reset accumulation period until greater than nstep + + accper = min (nstep,accum(nf)%period) + accum(nf)%val(beg:end,1:numlev) = & + ((accper-1)*accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev)) / accper + + else if (accum(nf)%acctype == 'runaccum') then + + !running accumulation field reset at trigger -99999 + + do j = 1,numlev + do k = beg,end + if (nint(field(k,j)) == -99999) then + accum(nf)%val(k,j) = 0._r8 + end if + end do + end do + accum(nf)%val(beg:end,1:numlev) = & + min(max(accum(nf)%val(beg:end,1:numlev) + field(beg:end,1:numlev), 0._r8), 99999._r8) + + end if + + end subroutine update_accum_field_ml + + !------------------------------------------------------------------------ + subroutine accumulRest( ncid, flag ) + ! + ! !DESCRIPTION: + ! Read/write accumulation restart data + ! + ! !USES: + use clm_time_manager, only : is_restart + use clm_varcon , only : ispval + use ncdio_pio + use pio + ! + ! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid !netcdf unit + character(len=*) , intent(in) :: flag !'define','read', or 'write' + ! + ! !LOCAL VARIABLES: + integer :: nf,k,j ! indices + integer :: beg1d, end1d ! buffer bounds + integer :: ier ! error status + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: rbuf1d(:) ! temporary 1d buffer + type(var_desc_t) :: vardesc ! local vardesc + character(len=128) :: varname ! temporary + character(len= 32) :: subname='AccumRest' ! subroutine name + !------------------------------------------------------------------------ + + do nf = 1,naccflds + + ! Note = below need to allocate rbuf for single level variables, since + ! accum(nf)%val is always 2d + + varname = trim(accum(nf)%name) // '_VALUE' + if (flag == 'define') then + if (accum(nf)%numlev == 1) then + call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_double, & + dim1name=accum(nf)%type1d, & + long_name=accum(nf)%desc, units=accum(nf)%units) + ier = PIO_inq_varid(ncid, trim(varname), vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_interp) + else + call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_double, & + dim1name=accum(nf)%type1d, dim2name=accum(nf)%type2d, & + long_name=accum(nf)%desc, units=accum(nf)%units) + end if + else if (flag == 'read' .or. flag == 'write') then + if (accum(nf)%numlev == 1) then + beg1d = accum(nf)%beg1d + end1d = accum(nf)%end1d + allocate(rbuf1d(beg1d:end1d)) + if (flag == 'write') then + rbuf1d(beg1d:end1d) = accum(nf)%val(beg1d:end1d,1) + end if + call ncd_io(varname=varname, data=rbuf1d, & + dim1name=accum(nf)%type1d, ncid=ncid, flag=flag, readvar=readvar) + if (flag == 'read' .and. readvar) then + accum(nf)%val(beg1d:end1d,1) = rbuf1d(beg1d:end1d) + end if + deallocate(rbuf1d) + else + call ncd_io(varname=varname, data=accum(nf)%val, & + dim1name=accum(nf)%type1d, ncid=ncid, flag=flag, readvar=readvar) + end if + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call shr_sys_abort() + end if + end if + + varname = trim(accum(nf)%name) // '_PERIOD' + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname=varname, xtype=ncd_int, & + long_name='', units='time steps', imissing_value=ispval, & + ifill_value=huge(1)) + ier = PIO_inq_varid(ncid, trim(varname), vardesc) + ier = PIO_put_att(ncid, vardesc%varid, 'interpinic_flag', iflag_copy) + else if (flag == 'read' .or. flag == 'write') then + call ncd_io(varname=varname, data=accum(nf)%period, ncid=ncid, flag=flag, readvar=readvar) + if (flag=='read' .and. .not. readvar) then + if (is_restart()) call shr_sys_abort() + end if + end if + + end do + + end subroutine accumulRest + +end module accumulMod diff --git a/components/clm/src_clm40/main/clm_atmlnd.F90 b/components/clm/src_clm40/main/clm_atmlnd.F90 new file mode 100644 index 0000000000..1534ec51e5 --- /dev/null +++ b/components/clm/src_clm40/main/clm_atmlnd.F90 @@ -0,0 +1,548 @@ +module clm_atmlnd + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_atmlnd +! +! !DESCRIPTION: +! Handle atm2lnd, lnd2atm mapping +! +! !USES: + use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. + use clm_varcon , only : rair, grav, cpair, hfus, tfrz + use clm_varctl , only : iulog, use_cn + use decompMod , only : get_proc_bounds + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use spmdMod , only : masterproc + use abortutils , only : endrun + use seq_drydep_mod, only : n_drydep, drydep_method, DD_XLND + use shr_megan_mod, only : shr_megan_mechcomps_n +! +! !PUBLIC TYPES: + implicit none + private + save +!---------------------------------------------------- +! atmosphere -> land variables structure +!---------------------------------------------------- + + ! Notes about atm2lnd_downscaled_fields_type, atm2lnd_type, and + ! a2l_not_downscaled_gcell: On the CLM4.5 side, atm2lnd_type has been broken into two + ! types: atm2lnd_type contains a subset of the original type, and + ! atm2lnd_downscaled_fields_type contains the remaining fields. Similarly, there are two + ! variables at the grid cell level: clm_a2l (of type atm2lnd_type) and + ! a2l_not_downscaled_gcell (of type atm2lnd_downscaled_fields_type). Because + ! lnd_import_export accesses these types and the related variables, and because + ! lnd_import_export is shared between the clm4.0 and clm4.5 sides, we needed to make + ! changes on the clm4.0 side for compatibility. Specifically, we needed to introduce a + ! pointer/alias named a2l_not_downscaled_gcell; for simplicity, this is simply another + ! way to access all of the fields in clm_a2l. Getting its type right is a bit tricky: + ! lnd_import_export expects it to be of type atm2lnd_downscaled_fields_type, but it + ! needs to point to a variable of type atm2lnd_type. To accomplish this, we have used + ! inheritance & polymorphism (Fortran 2003 features). + + ! This is really the type definition for atm2lnd_type. However, for compatibility with + ! clm4_5 (particularly in lnd_import_export) we need to call this + ! atm2lnd_downscaled_fields_type, and then define an extended type called atm2lnd_type. + type, public :: atm2lnd_downscaled_fields_type + real(r8), pointer :: forc_t(:) => null() !atmospheric temperature (Kelvin) + real(r8), pointer :: forc_u(:) => null() !atm wind speed, east direction (m/s) + real(r8), pointer :: forc_v(:) => null() !atm wind speed, north direction (m/s) + real(r8), pointer :: forc_wind(:) => null() !atmospheric wind speed + real(r8), pointer :: forc_q(:) => null() !atmospheric specific humidity (kg/kg) + real(r8), pointer :: forc_hgt(:) => null() !atmospheric reference height (m) + real(r8), pointer :: forc_hgt_u(:) => null() !obs height of wind [m] (new) + real(r8), pointer :: forc_hgt_t(:) => null() !obs height of temperature [m] (new) + real(r8), pointer :: forc_hgt_q(:) => null() !obs height of humidity [m] (new) + real(r8), pointer :: forc_pbot(:) => null() !atmospheric pressure (Pa) + real(r8), pointer :: forc_th(:) => null() !atm potential temperature (Kelvin) + real(r8), pointer :: forc_vp(:) => null() !atmospheric vapor pressure (Pa) + real(r8), pointer :: forc_rho(:) => null() !density (kg/m**3) + real(r8), pointer :: forc_rh(:) => null() !atmospheric relative humidity (%) + real(r8), pointer :: forc_psrf(:) => null() !surface pressure (Pa) + real(r8), pointer :: forc_pco2(:) => null() !CO2 partial pressure (Pa) + real(r8), pointer :: forc_lwrad(:) => null() !downward IR longwave radiation (W/m**2) + real(r8), pointer :: forc_solad(:,:) => null() !direct beam radiation (numrad) (vis=forc_sols , nir=forc_soll ) + real(r8), pointer :: forc_solai(:,:) => null() !diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) + real(r8), pointer :: forc_solar(:) => null() !incident solar radiation + real(r8), pointer :: forc_rain(:) => null() !rain rate [mm/s] + real(r8), pointer :: forc_snow(:) => null() !snow rate [mm/s] + real(r8), pointer :: forc_ndep(:) => null() !nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_pc13o2(:) => null() !C13O2 partial pressure (Pa) + real(r8), pointer :: forc_po2(:) => null() !O2 partial pressure (Pa) + real(r8), pointer :: forc_flood(:) => null() ! rof flood (mm/s) + real(r8), pointer :: volr(:) => null() ! rof volr (m3) + real(r8), pointer :: forc_aer(:,:) => null() ! aerosol deposition array + ! Needed for backwards compatibility with lnd_comp_mct used in clm4_5 + real(r8), pointer :: forc_pch4(:) => null() !CH4 partial pressure (Pa) + ! anomaly forcing - only define and only used in clm4_5. This is a hack + ! since lnd_import_export doesn't have a way to deal with the 45/40 + ! distinction + real(r8), pointer ::af_precip(:) => null() ! anomaly forcing + real(r8), pointer ::af_uwind(:) => null() ! anomaly forcing + real(r8), pointer ::af_vwind(:) => null() ! anomaly forcing + real(r8), pointer ::af_tbot(:) => null() ! anomaly forcing + real(r8), pointer ::af_pbot(:) => null() ! anomaly forcing + real(r8), pointer ::af_shum(:) => null() ! anomaly forcing + real(r8), pointer ::af_swdn(:) => null() ! anomaly forcing + real(r8), pointer ::af_lwdn(:) => null() ! anomaly forcing + real(r8), pointer :: bc_precip(:) => null() ! anomaly forcing - add bias correction + end type atm2lnd_downscaled_fields_type + + ! The following type extension is needed just so that lnd_import_export can remain + ! consistent between the clm4_0 code and clm4_5 code. + type, public, extends(atm2lnd_downscaled_fields_type) :: atm2lnd_type + end type atm2lnd_type + +!---------------------------------------------------- +! land -> atmosphere variables structure +!---------------------------------------------------- + + type, public :: lnd2atm_type + real(r8), pointer :: t_rad(:) => null() !radiative temperature (Kelvin) + real(r8), pointer :: t_ref2m(:) => null() !2m surface air temperature (Kelvin) + real(r8), pointer :: q_ref2m(:) => null() !2m surface specific humidity (kg/kg) + real(r8), pointer :: u_ref10m(:) => null() !10m surface wind speed (m/sec) + real(r8), pointer :: h2osno(:) => null() !snow water (mm H2O) + real(r8), pointer :: albd(:,:) => null() !(numrad) surface albedo (direct) + real(r8), pointer :: albi(:,:) => null() !(numrad) surface albedo (diffuse) + real(r8), pointer :: taux(:) => null() !wind stress: e-w (kg/m/s**2) + real(r8), pointer :: tauy(:) => null() !wind stress: n-s (kg/m/s**2) + real(r8), pointer :: eflx_lh_tot(:) => null() !total latent HF (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot(:) => null() !total sensible HF (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lwrad_out(:) => null() !IR (longwave) radiation (W/m**2) + real(r8), pointer :: qflx_evap_tot(:) => null() !qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: fsa(:) => null() !solar rad absorbed (total) (W/m**2) + real(r8), pointer :: nee(:) => null() !net CO2 flux (kg CO2/m**2/s) [+ to atm] + real(r8), pointer :: ram1(:) => null() !aerodynamical resistance (s/m) + real(r8), pointer :: fv(:) => null() !friction velocity (m/s) (for dust model) + real(r8), pointer :: h2osoi_vol(:,:) => null() !volumetric soil water (0~watsat, m3/m3, nlevgrnd) (for dust model) + real(r8), pointer :: rofliq(:) => null() ! rof liq forcing + real(r8), pointer :: rofice(:) => null() ! rof ice forcing + real(r8), pointer :: flxdst(:,:) => null() !dust flux (size bins) + real(r8), pointer :: ddvel(:,:) => null() !dry deposition velocities + real(r8), pointer :: flxvoc(:,:) => null() ! VOC flux (size bins) + ! Needed for backwards compatibility with lnd_comp_mct used in clm4_5 + real(r8), pointer :: flux_ch4(:) => null() !net CH4 flux (kg C/m**2/s) [+ to atm] + end type lnd2atm_type + + type(atm2lnd_type),public,target :: clm_a2l ! a2l fields on clm grid + type(lnd2atm_type),public,target :: clm_l2a ! l2a fields on clm grid + + ! The following alias is needed just so that lnd_import_export can remain consistent + ! between the clm4_0 code and clm4_5 code. + class(atm2lnd_downscaled_fields_type),public,pointer :: a2l_not_downscaled_gcell + +! !PUBLIC MEMBER FUNCTIONS: + public :: init_atm2lnd_type + public :: init_lnd2atm_type + public :: clm_map2gcell_minimal + public :: clm_map2gcell +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein and Tony Craig, 2006-01-10 +! +! !PRIVATE MEMBER FUNCTIONS: + +!EOP +!---------------------------------------------------- + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_atm2lnd_type +! +! !INTERFACE: + subroutine init_atm2lnd_type(beg, end, a2l) +! +! !DESCRIPTION: +! Initialize atmospheric variables required by the land +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (atm2lnd_type), intent(inout):: a2l +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! Modified by T Craig, 11/01/05 for finemesh project +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: ival ! initial value +!------------------------------------------------------------------------ + + allocate(a2l%forc_t(beg:end)) + allocate(a2l%forc_u(beg:end)) + allocate(a2l%forc_v(beg:end)) + allocate(a2l%forc_wind(beg:end)) + allocate(a2l%forc_q(beg:end)) + allocate(a2l%forc_rh(beg:end)) + allocate(a2l%forc_hgt(beg:end)) + allocate(a2l%forc_hgt_u(beg:end)) + allocate(a2l%forc_hgt_t(beg:end)) + allocate(a2l%forc_hgt_q(beg:end)) + allocate(a2l%forc_pbot(beg:end)) + allocate(a2l%forc_th(beg:end)) + allocate(a2l%forc_vp(beg:end)) + allocate(a2l%forc_rho(beg:end)) + allocate(a2l%forc_psrf(beg:end)) + allocate(a2l%forc_pco2(beg:end)) + allocate(a2l%forc_lwrad(beg:end)) + allocate(a2l%forc_solad(beg:end,numrad)) + allocate(a2l%forc_solai(beg:end,numrad)) + allocate(a2l%forc_solar(beg:end)) + allocate(a2l%forc_rain(beg:end)) + allocate(a2l%forc_snow(beg:end)) + allocate(a2l%forc_ndep(beg:end)) + allocate(a2l%forc_pc13o2(beg:end)) + allocate(a2l%forc_po2(beg:end)) + allocate(a2l%forc_flood(beg:end)) + allocate(a2l%volr(beg:end)) + allocate(a2l%forc_aer(beg:end,14)) + + ! ival = nan ! causes core dump in map_maparray, tcx fix + ival = 0.0_r8 + + a2l%forc_t(beg:end) = ival + a2l%forc_u(beg:end) = ival + a2l%forc_v(beg:end) = ival + a2l%forc_wind(beg:end) = ival + a2l%forc_q(beg:end) = ival + a2l%forc_rh(beg:end) = ival + a2l%forc_hgt(beg:end) = ival + a2l%forc_hgt_u(beg:end) = ival + a2l%forc_hgt_t(beg:end) = ival + a2l%forc_hgt_q(beg:end) = ival + a2l%forc_pbot(beg:end) = ival + a2l%forc_th(beg:end) = ival + a2l%forc_vp(beg:end) = ival + a2l%forc_rho(beg:end) = ival + a2l%forc_psrf(beg:end) = ival + a2l%forc_pco2(beg:end) = ival + a2l%forc_lwrad(beg:end) = ival + a2l%forc_solad(beg:end,1:numrad) = ival + a2l%forc_solai(beg:end,1:numrad) = ival + a2l%forc_solar(beg:end) = ival + a2l%forc_rain(beg:end) = ival + a2l%forc_snow(beg:end) = ival + a2l%forc_ndep(beg:end) = ival + a2l%forc_pc13o2(beg:end) = ival + a2l%forc_po2(beg:end) = ival + a2l%forc_flood(beg:end) = ival + a2l%volr(beg:end) = ival + a2l%forc_aer(beg:end,:) = ival + + ! The following alias is needed just so that lnd_import_export can remain consistent + ! between the clm4_0 code and clm4_5 code. + a2l_not_downscaled_gcell => clm_a2l + +end subroutine init_atm2lnd_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_lnd2atm_type +! +! !INTERFACE: + subroutine init_lnd2atm_type(beg, end, l2a) +! +! !DESCRIPTION: +! Initialize land variables required by the atmosphere +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (lnd2atm_type), intent(inout):: l2a +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! Modified by T Craig, 11/01/05 for finemesh project +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: ival ! initial value +!------------------------------------------------------------------------ + + allocate(l2a%t_rad(beg:end)) + allocate(l2a%t_ref2m(beg:end)) + allocate(l2a%q_ref2m(beg:end)) + allocate(l2a%u_ref10m(beg:end)) + allocate(l2a%h2osno(beg:end)) + allocate(l2a%albd(beg:end,1:numrad)) + allocate(l2a%albi(beg:end,1:numrad)) + allocate(l2a%taux(beg:end)) + allocate(l2a%tauy(beg:end)) + allocate(l2a%eflx_lwrad_out(beg:end)) + allocate(l2a%eflx_sh_tot(beg:end)) + allocate(l2a%eflx_lh_tot(beg:end)) + allocate(l2a%qflx_evap_tot(beg:end)) + allocate(l2a%fsa(beg:end)) + allocate(l2a%nee(beg:end)) + allocate(l2a%ram1(beg:end)) + allocate(l2a%fv(beg:end)) + allocate(l2a%h2osoi_vol(beg:end,1:nlevgrnd)) + allocate(l2a%rofliq(beg:end)) + allocate(l2a%rofice(beg:end)) + allocate(l2a%flxdst(beg:end,1:ndst)) + if (shr_megan_mechcomps_n>0) then + allocate(l2a%flxvoc(beg:end,1:shr_megan_mechcomps_n)) + endif + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + allocate(l2a%ddvel(beg:end,1:n_drydep)) + end if + + ! ival = nan ! causes core dump in map_maparray, tcx fix + ival = 0.0_r8 + + l2a%t_rad(beg:end) = ival + l2a%t_ref2m(beg:end) = ival + l2a%q_ref2m(beg:end) = ival + l2a%u_ref10m(beg:end) = ival + l2a%h2osno(beg:end) = ival + l2a%albd(beg:end,1:numrad) = ival + l2a%albi(beg:end,1:numrad) = ival + l2a%taux(beg:end) = ival + l2a%tauy(beg:end) = ival + l2a%eflx_lwrad_out(beg:end) = ival + l2a%eflx_sh_tot(beg:end) = ival + l2a%eflx_lh_tot(beg:end) = ival + l2a%qflx_evap_tot(beg:end) = ival + l2a%fsa(beg:end) = ival + l2a%nee(beg:end) = ival + l2a%ram1(beg:end) = ival + l2a%fv(beg:end) = ival + l2a%h2osoi_vol(beg:end,1:nlevgrnd) = ival + l2a%rofliq(beg:end) = ival + l2a%rofice(beg:end) = ival + l2a%flxdst(beg:end,1:ndst) = ival + if (shr_megan_mechcomps_n>0) then + l2a%flxvoc(beg:end,1:shr_megan_mechcomps_n) = ival + endif + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + l2a%ddvel(beg:end, : ) = ival + end if + +end subroutine init_lnd2atm_type + +!------------------------------------------------------------------------ +! +! !IROUTINE: clm_map2gcell_minimal +! +! !INTERFACE: subroutine clm_map2gcell_minimal(init) +subroutine clm_map2gcell_minimal() +! +! !DESCRIPTION: +! Compute l2a component of gridcell derived type. This routine computes the +! bare minimum of components necessary to get the first step of a run +! started. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use subgridAveMod + use clm_varcon , only : sb + use clm_varpar , only : numrad +! +! !REVISION HISTORY: +! Sean Santos: Extracted from clm_map2gcell 2013/08/27 +! +! +! !LOCAL VARIABLES: + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + + integer :: g ! indices + real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon + real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen + real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2 + ! The following converts g of C to kg of CO2 + real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC) + +!------------------------------------------------------------------------ + + ! Determine processor bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Compute gridcell averages. + + call c2g(begc, endc, begl, endl, begg, endg, & + cws%h2osno, clm_l2a%h2osno, & + c2l_scale_type= 'urbanf', l2g_scale_type='unity') + do g = begg,endg + clm_l2a%h2osno(g) = clm_l2a%h2osno(g)/1000._r8 + end do + + call c2g(begc, endc, begl, endl, begg, endg, nlevgrnd, & + cws%h2osoi_vol, clm_l2a%h2osoi_vol, & + c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, numrad, & + pps%albd, clm_l2a%albd,& + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, numrad, & + pps%albi, clm_l2a%albi,& + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pef%eflx_lwrad_out, clm_l2a%eflx_lwrad_out,& + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + do g = begg,endg + clm_l2a%t_rad(g) = sqrt(sqrt(clm_l2a%eflx_lwrad_out(g)/sb)) + end do + +end subroutine clm_map2gcell_minimal + +!------------------------------------------------------------------------ +! +! !IROUTINE: clm_map2gcell +! +! !INTERFACE: subroutine clm_map2gcell() +subroutine clm_map2gcell() +! +! !DESCRIPTION: +! Compute l2a component of gridcell derived type +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use subgridAveMod + use clm_varcon , only : sb + use clm_varpar , only : numrad +! +! !REVISION HISTORY: +! Mariana Vertenstein: created 03/10-25 +! 03-04-27 : Created by Mariana Vertenstein +! 03-08-25 : Updated to vector data structure (Mariana Vertenstein) +! +! +! !LOCAL VARIABLES: + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + + integer :: g ! indices + real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon + real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen + real(r8), parameter :: amCO2 = amC + 2.0_r8*amO ! Atomic mass number for CO2 + ! The following converts g of C to kg of CO2 + real(r8), parameter :: convertgC2kgCO2 = 1.0e-3_r8 * (amCO2/amC) + +!------------------------------------------------------------------------ + + ! First, compute the "minimal" set of fields. + call clm_map2gcell_minimal() + + ! Determine processor bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Compute remaining gridcell averages. + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pes%t_ref2m, clm_l2a%t_ref2m, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pes%q_ref2m, clm_l2a%q_ref2m, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pps%u10_clm, clm_l2a%u_ref10m, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pmf%taux, clm_l2a%taux, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pmf%tauy, clm_l2a%tauy, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pef%eflx_lh_tot, clm_l2a%eflx_lh_tot, & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + +!DML note: use new array: gef%eflx_sh_totg +! call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & +! pef%eflx_sh_tot, clm_l2a%eflx_sh_tot, & +! p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + do g = begg,endg + clm_l2a%eflx_sh_tot(g) = gef%eflx_sh_totg(g) + end do + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pwf%qflx_evap_tot, clm_l2a%qflx_evap_tot, & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pef%fsa, clm_l2a%fsa, & + p2c_scale_type='unity', c2l_scale_type= 'urbanf', l2g_scale_type='unity') + + if (use_cn) then + call c2g(begc, endc, begl, endl, begg, endg, & + ccf%nee, clm_l2a%nee, & + c2l_scale_type= 'unity', l2g_scale_type='unity') + else + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pcf%fco2, clm_l2a%nee, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + ! Note that fco2 in is umolC/m2/sec so units need to be changed to gC/m2/sec + do g = begg,endg + clm_l2a%nee(g) = clm_l2a%nee(g)*12.011e-6_r8 + end do + end if + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pps%fv, clm_l2a%fv, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, & + pps%ram1, clm_l2a%ram1, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + do g = begg,endg + clm_l2a%rofliq(g) = gwf%qflx_runoffg(g) + clm_l2a%rofice(g) = gwf%qflx_snwcp_iceg(g) + end do + + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, ndst, & + pdf%flx_mss_vrt_dst, clm_l2a%flxdst, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + + if (shr_megan_mechcomps_n>0) then + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, shr_megan_mechcomps_n, & + pvf%vocflx, clm_l2a%flxvoc, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + endif + + if ( n_drydep > 0 .and. drydep_method == DD_XLND ) then + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, n_drydep, & + pdd%drydepvel, clm_l2a%ddvel, & + p2c_scale_type='unity', c2l_scale_type= 'unity', l2g_scale_type='unity') + endif + + ! Convert from gC/m2/s to kgCO2/m2/s + do g = begg,endg + clm_l2a%nee(g) = clm_l2a%nee(g)*convertgC2kgCO2 + end do + +end subroutine clm_map2gcell + +!------------------------------------------------------------------------ +!------------------------------------------------------------------------ +end module clm_atmlnd + diff --git a/components/clm/src_clm40/main/clm_cpl_indices.F90 b/components/clm/src_clm40/main/clm_cpl_indices.F90 new file mode 100644 index 0000000000..15873fb34b --- /dev/null +++ b/components/clm/src_clm40/main/clm_cpl_indices.F90 @@ -0,0 +1,303 @@ +module clm_cpl_indices + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing the indices for the fields passed between CLM and + ! the driver. Includes the River Transport Model fields (RTM) and the + ! fields needed by the land-ice component (sno). + ! + ! !USES: + + use shr_sys_mod, only : shr_sys_abort + implicit none + + SAVE + private ! By default make data private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: clm_cpl_indices_set ! Set the coupler indices + ! + ! !PUBLIC DATA MEMBERS: + ! + integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits + ! (from coupler) - must equal maxpatch_glcmec from namelist + integer , parameter, private:: glc_nec_max = 100 + + ! lnd -> drv (required) + + integer, public ::index_l2x_Flrl_rofl ! lnd->rtm input fluxes + integer, public ::index_l2x_Flrl_rofi ! lnd->rtm input fluxes + + integer, public ::index_l2x_Sl_t ! temperature + integer, public ::index_l2x_Sl_tref ! 2m reference temperature + integer, public ::index_l2x_Sl_qref ! 2m reference specific humidity + integer, public ::index_l2x_Sl_avsdr ! albedo: direct , visible + integer, public ::index_l2x_Sl_anidr ! albedo: direct , near-ir + integer, public ::index_l2x_Sl_avsdf ! albedo: diffuse, visible + integer, public ::index_l2x_Sl_anidf ! albedo: diffuse, near-ir + integer, public ::index_l2x_Sl_snowh ! snow height + integer, public ::index_l2x_Sl_u10 ! 10m wind + integer, public ::index_l2x_Sl_ddvel ! dry deposition velocities (optional) + integer, public ::index_l2x_Sl_fv ! friction velocity + integer, public ::index_l2x_Sl_ram1 ! aerodynamical resistance + integer, public ::index_l2x_Sl_soilw ! volumetric soil water + integer, public ::index_l2x_Fall_taux ! wind stress, zonal + integer, public ::index_l2x_Fall_tauy ! wind stress, meridional + integer, public ::index_l2x_Fall_lat ! latent heat flux + integer, public ::index_l2x_Fall_sen ! sensible heat flux + integer, public ::index_l2x_Fall_lwup ! upward longwave heat flux + integer, public ::index_l2x_Fall_evap ! evaporation water flux + integer, public ::index_l2x_Fall_swnet ! heat flux shortwave net + integer, public ::index_l2x_Fall_fco2_lnd ! co2 flux **For testing set to 0 + integer, public ::index_l2x_Fall_flxdst1 ! dust flux size bin 1 + integer, public ::index_l2x_Fall_flxdst2 ! dust flux size bin 2 + integer, public ::index_l2x_Fall_flxdst3 ! dust flux size bin 3 + integer, public ::index_l2x_Fall_flxdst4 ! dust flux size bin 4 + integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, public ::index_l2x_Sl_tsrf(0:glc_nec_max) = 0 ! glc MEC temperature + integer, public ::index_l2x_Sl_topo(0:glc_nec_max) = 0 ! glc MEC topo height + integer, public ::index_l2x_Flgl_qice(0:glc_nec_max) = 0 ! glc MEC ice flux + + integer, public ::index_x2l_Sa_methane + integer, public ::index_l2x_Fall_methane + + integer, public :: nflds_l2x = 0 + + ! drv -> lnd (required) + + integer, public ::index_x2l_Sa_z ! bottom atm level height + integer, public ::index_x2l_Sa_u ! bottom atm level zon wind + integer, public ::index_x2l_Sa_v ! bottom atm level mer wind + integer, public ::index_x2l_Sa_ptem ! bottom atm level pot temp + integer, public ::index_x2l_Sa_shum ! bottom atm level spec hum + integer, public ::index_x2l_Sa_pbot ! bottom atm level pressure + integer, public ::index_x2l_Sa_tbot ! bottom atm level temp + integer, public ::index_x2l_Faxa_lwdn ! downward lw heat flux + integer, public ::index_x2l_Faxa_rainc ! prec: liquid "convective" + integer, public ::index_x2l_Faxa_rainl ! prec: liquid "large scale" + integer, public ::index_x2l_Faxa_snowc ! prec: frozen "convective" + integer, public ::index_x2l_Faxa_snowl ! prec: frozen "large scale" + integer, public ::index_x2l_Faxa_swndr ! sw: nir direct downward + integer, public ::index_x2l_Faxa_swvdr ! sw: vis direct downward + integer, public ::index_x2l_Faxa_swndf ! sw: nir diffuse downward + integer, public ::index_x2l_Faxa_swvdf ! sw: vis diffuse downward + integer, public ::index_x2l_Sa_co2prog ! bottom atm level prognostic co2 + integer, public ::index_x2l_Sa_co2diag ! bottom atm level diagnostic co2 + integer, public ::index_x2l_Faxa_bcphidry ! flux: Black Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_bcphodry ! flux: Black Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_bcphiwet ! flux: Black Carbon hydrophilic wet deposition + integer, public ::index_x2l_Faxa_ocphidry ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_ocphodry ! flux: Organic Carbon hydrophobic dry deposition + integer, public ::index_x2l_Faxa_ocphiwet ! flux: Organic Carbon hydrophilic dry deposition + integer, public ::index_x2l_Faxa_dstwet1 ! flux: Size 1 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet2 ! flux: Size 2 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet3 ! flux: Size 3 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstwet4 ! flux: Size 4 dust -- wet deposition + integer, public ::index_x2l_Faxa_dstdry1 ! flux: Size 1 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry2 ! flux: Size 2 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry3 ! flux: Size 3 dust -- dry deposition + integer, public ::index_x2l_Faxa_dstdry4 ! flux: Size 4 dust -- dry deposition + + integer, public ::index_x2l_Flrr_flood ! rtm->lnd rof (flood) flux + integer, public ::index_x2l_Flrr_volr ! rtm->lnd rof volr + + ! In the following, index 0 is bare land, other indices are glc elevation classes + integer, public ::index_x2l_Sg_ice_covered(0:glc_nec_max) = 0 ! Fraction of glacier from glc model + integer, public ::index_x2l_Sg_topo(0:glc_nec_max) = 0 ! Topo height from glc model + integer, public ::index_x2l_Flgg_hflx(0:glc_nec_max) = 0 ! Heat flux from glc model + + integer, public ::index_x2l_Sg_icemask + + integer, public :: nflds_x2l = 0 + + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine clm_cpl_indices_set( ) + ! + ! !DESCRIPTION: + ! Set the coupler indices needed by the land model coupler + ! interface. + ! + ! !USES: + use seq_flds_mod , only: seq_flds_x2l_fields, seq_flds_l2x_fields + use mct_mod , only: mct_aVect, mct_aVect_init, mct_avect_indexra + use mct_mod , only: mct_aVect_clean, mct_avect_nRattr + use seq_drydep_mod , only: drydep_fields_token, lnd_drydep + use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n + use clm_varctl , only: use_voc + ! + ! !ARGUMENTS: + implicit none + ! + ! !REVISION HISTORY: + ! Author: Mariana Vertenstein + ! 01/2011, Erik Kluzek: Added protex headers + ! + ! !LOCAL VARIABLES: + type(mct_aVect) :: l2x ! temporary, land to coupler + type(mct_aVect) :: x2l ! temporary, coupler to land + integer :: num + character(len= 2) :: cnum + character(len=64) :: name + character(len=32) :: subname = 'clm_cpl_indices_set' ! subroutine name + !----------------------------------------------------------------------- + + ! Determine attribute vector indices + + ! create temporary attribute vectors + call mct_aVect_init(x2l, rList=seq_flds_x2l_fields, lsize=1) + nflds_x2l = mct_avect_nRattr(x2l) + + call mct_aVect_init(l2x, rList=seq_flds_l2x_fields, lsize=1) + nflds_l2x = mct_avect_nRattr(l2x) + + !------------------------------------------------------------- + ! clm -> drv + !------------------------------------------------------------- + + index_l2x_Flrl_rofl = mct_avect_indexra(l2x,'Flrl_rofl') + index_l2x_Flrl_rofi = mct_avect_indexra(l2x,'Flrl_rofi') + + index_l2x_Sl_t = mct_avect_indexra(l2x,'Sl_t') + index_l2x_Sl_snowh = mct_avect_indexra(l2x,'Sl_snowh') + index_l2x_Sl_avsdr = mct_avect_indexra(l2x,'Sl_avsdr') + index_l2x_Sl_anidr = mct_avect_indexra(l2x,'Sl_anidr') + index_l2x_Sl_avsdf = mct_avect_indexra(l2x,'Sl_avsdf') + index_l2x_Sl_anidf = mct_avect_indexra(l2x,'Sl_anidf') + index_l2x_Sl_tref = mct_avect_indexra(l2x,'Sl_tref') + index_l2x_Sl_qref = mct_avect_indexra(l2x,'Sl_qref') + index_l2x_Sl_u10 = mct_avect_indexra(l2x,'Sl_u10') + index_l2x_Sl_ram1 = mct_avect_indexra(l2x,'Sl_ram1') + index_l2x_Sl_fv = mct_avect_indexra(l2x,'Sl_fv') + index_l2x_Sl_soilw = mct_avect_indexra(l2x,'Sl_soilw',perrwith='quiet') + if ( lnd_drydep )then + index_l2x_Sl_ddvel = mct_avect_indexra(l2x, trim(drydep_fields_token)) + else + index_l2x_Sl_ddvel = 0 + end if + + index_l2x_Fall_taux = mct_avect_indexra(l2x,'Fall_taux') + index_l2x_Fall_tauy = mct_avect_indexra(l2x,'Fall_tauy') + index_l2x_Fall_lat = mct_avect_indexra(l2x,'Fall_lat') + index_l2x_Fall_sen = mct_avect_indexra(l2x,'Fall_sen') + index_l2x_Fall_lwup = mct_avect_indexra(l2x,'Fall_lwup') + index_l2x_Fall_evap = mct_avect_indexra(l2x,'Fall_evap') + index_l2x_Fall_swnet = mct_avect_indexra(l2x,'Fall_swnet') + index_l2x_Fall_flxdst1 = mct_avect_indexra(l2x,'Fall_flxdst1') + index_l2x_Fall_flxdst2 = mct_avect_indexra(l2x,'Fall_flxdst2') + index_l2x_Fall_flxdst3 = mct_avect_indexra(l2x,'Fall_flxdst3') + index_l2x_Fall_flxdst4 = mct_avect_indexra(l2x,'Fall_flxdst4') + + index_l2x_Fall_fco2_lnd = mct_avect_indexra(l2x,'Fall_fco2_lnd',perrwith='quiet') + + index_l2x_Fall_methane = mct_avect_indexra(l2x,'Fall_methane',perrWith='quiet') + + ! MEGAN fluxes + ! use_voc is a temporary logic to enable turning off MEGAN fluxes when prognostic crop + ! is used + if (shr_megan_mechcomps_n>0 .and. use_voc) then + index_l2x_Fall_flxvoc = mct_avect_indexra(l2x,trim(shr_megan_fields_token)) + else + index_l2x_Fall_flxvoc = 0 + endif + + !------------------------------------------------------------- + ! drv -> clm + !------------------------------------------------------------- + + index_x2l_Sa_z = mct_avect_indexra(x2l,'Sa_z') + index_x2l_Sa_u = mct_avect_indexra(x2l,'Sa_u') + index_x2l_Sa_v = mct_avect_indexra(x2l,'Sa_v') + index_x2l_Sa_ptem = mct_avect_indexra(x2l,'Sa_ptem') + index_x2l_Sa_pbot = mct_avect_indexra(x2l,'Sa_pbot') + index_x2l_Sa_tbot = mct_avect_indexra(x2l,'Sa_tbot') + index_x2l_Sa_shum = mct_avect_indexra(x2l,'Sa_shum') + index_x2l_Sa_co2prog = mct_avect_indexra(x2l,'Sa_co2prog',perrwith='quiet') + index_x2l_Sa_co2diag = mct_avect_indexra(x2l,'Sa_co2diag',perrwith='quiet') + + index_x2l_Sa_methane = mct_avect_indexra(x2l,'Sa_methane',perrWith='quiet') + + index_x2l_Flrr_volr = mct_avect_indexra(x2l,'Flrr_volr') + + index_x2l_Faxa_lwdn = mct_avect_indexra(x2l,'Faxa_lwdn') + index_x2l_Faxa_rainc = mct_avect_indexra(x2l,'Faxa_rainc') + index_x2l_Faxa_rainl = mct_avect_indexra(x2l,'Faxa_rainl') + index_x2l_Faxa_snowc = mct_avect_indexra(x2l,'Faxa_snowc') + index_x2l_Faxa_snowl = mct_avect_indexra(x2l,'Faxa_snowl') + index_x2l_Faxa_swndr = mct_avect_indexra(x2l,'Faxa_swndr') + index_x2l_Faxa_swvdr = mct_avect_indexra(x2l,'Faxa_swvdr') + index_x2l_Faxa_swndf = mct_avect_indexra(x2l,'Faxa_swndf') + index_x2l_Faxa_swvdf = mct_avect_indexra(x2l,'Faxa_swvdf') + index_x2l_Faxa_bcphidry = mct_avect_indexra(x2l,'Faxa_bcphidry') + index_x2l_Faxa_bcphodry = mct_avect_indexra(x2l,'Faxa_bcphodry') + index_x2l_Faxa_bcphiwet = mct_avect_indexra(x2l,'Faxa_bcphiwet') + index_x2l_Faxa_ocphidry = mct_avect_indexra(x2l,'Faxa_ocphidry') + index_x2l_Faxa_ocphodry = mct_avect_indexra(x2l,'Faxa_ocphodry') + index_x2l_Faxa_ocphiwet = mct_avect_indexra(x2l,'Faxa_ocphiwet') + index_x2l_Faxa_dstdry1 = mct_avect_indexra(x2l,'Faxa_dstdry1') + index_x2l_Faxa_dstdry2 = mct_avect_indexra(x2l,'Faxa_dstdry2') + index_x2l_Faxa_dstdry3 = mct_avect_indexra(x2l,'Faxa_dstdry3') + index_x2l_Faxa_dstdry4 = mct_avect_indexra(x2l,'Faxa_dstdry4') + index_x2l_Faxa_dstwet1 = mct_avect_indexra(x2l,'Faxa_dstwet1') + index_x2l_Faxa_dstwet2 = mct_avect_indexra(x2l,'Faxa_dstwet2') + index_x2l_Faxa_dstwet3 = mct_avect_indexra(x2l,'Faxa_dstwet3') + index_x2l_Faxa_dstwet4 = mct_avect_indexra(x2l,'Faxa_dstwet4') + + index_x2l_Flrr_flood = mct_avect_indexra(x2l,'Flrr_flood') + + !------------------------------------------------------------- + ! glc coupling + !------------------------------------------------------------- + + glc_nec = 0 + + do num = 0,glc_nec_max + + write(cnum,'(i2.2)') num + name = 'Sg_ice_covered' // cnum + index_x2l_Sg_ice_covered(num) = mct_avect_indexra(x2l,trim(name),perrwith='quiet') + name = 'Sg_topo' // cnum + index_x2l_Sg_topo(num) = mct_avect_indexra(x2l,trim(name),perrwith='quiet') + name = 'Flgg_hflx' // cnum + index_x2l_Flgg_hflx(num) = mct_avect_indexra(x2l,trim(name),perrwith='quiet') + if ( index_x2l_Sg_ice_covered(num) == 0 .and. & + index_x2l_Sg_topo(num) == 0 .and. & + index_x2l_Flgg_hflx(num) == 0 ) then + exit + end if + glc_nec = num + end do + + index_x2l_Sg_icemask = mct_avect_indexra(x2l,'Sg_icemask',perrwith='quiet') + + if (glc_nec == glc_nec_max) then + call shr_sys_abort (subname // 'error: glc_nec_cpl cannot equal glc_nec_max') + end if + + ! If glc_nec > 0, then create coupling fields for all glc elevation classes + ! (1:glc_nec) plus bare land (index 0). Note that, if glc_nec = 0, then we don't + ! even need the bare land (0) index. + if (glc_nec > 0) then + do num = 0,glc_nec + write(cnum,'(i2.2)') num + name = 'Sl_tsrf' // cnum + index_l2x_Sl_tsrf(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Sl_topo' // cnum + index_l2x_Sl_topo(num) = mct_avect_indexra(l2x,trim(name)) + name = 'Flgl_qice' // cnum + index_l2x_Flgl_qice(num) = mct_avect_indexra(l2x,trim(name)) + end do + end if + + call mct_aVect_clean(x2l) + call mct_aVect_clean(l2x) + + end subroutine clm_cpl_indices_set + +!======================================================================= + +end module clm_cpl_indices diff --git a/components/clm/src_clm40/main/clm_driver.F90 b/components/clm/src_clm40/main/clm_driver.F90 new file mode 100644 index 0000000000..c7a5b28507 --- /dev/null +++ b/components/clm/src_clm40/main/clm_driver.F90 @@ -0,0 +1,903 @@ +module clm_driver + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_driver +! +! !DESCRIPTION: +! This module provides the main CLM driver physics calling sequence. Most +! computations occurs over ``clumps'' of gridcells (and associated subgrid +! scale entities) assigned to each MPI process. Computation is further +! parallelized by looping over clumps on each process using shared memory OpenMP. +! +! The main CLM driver physics calling sequence for clm_driver1 is as follows: +! \begin{verbatim} +! +! + interpMonthlyVeg interpolate monthly vegetation data [! CN or ! CNDV] +! + readMonthlyVegetation read vegetation data for two months [! CN or ! CNDV] +! +! ==== Begin Loop over clumps ==== +! -> dynland_hwcontent Get initial heat, water content +! + pftdyn_interp [pftdyn] +! + dynland_hwcontent Get new heat, water content [pftdyn] +! ==== End Loop over clumps ==== +! +! ==== Begin Loop over clumps ==== +! -> clm_driverInit save of variables from previous time step +! -> Hydrology1 canopy interception and precip on ground +! -> FracWet fraction of wet vegetated surface and dry elai +! -> SurfaceRadiation surface solar radiation +! -> UrbanRadiation surface solar and longwave radiation for Urban landunits +! -> Biogeophysics1 leaf temperature and surface fluxes +! -> BareGroundFluxes surface fluxes for bare soil or snow-covered +! vegetation patches +! -> UrbanFluxes surface fluxes for urban landunits +! -> MoninObukIni first-guess Monin-Obukhov length and wind speed +! -> FrictionVelocity friction velocity and potential temperature and +! humidity profiles +! -> CanopyFluxes leaf temperature and surface fluxes for vegetated +! patches +! -> QSat saturated vapor pressure, specific humidity, & +! derivatives at leaf surface +! -> MoninObukIni first-guess Monin-Obukhov length and wind speed +! -> FrictionVelocity friction velocity and potential temperature and +! humidity profiles +! -> Stomata stomatal resistance and photosynthesis for +! sunlit leaves +! -> Stomata stomatal resistance and photosynthesis for +! shaded leaves +! -> QSat recalculation of saturated vapor pressure, +! specific humidity, & derivatives at leaf surface +! + DustEmission Dust mobilization +! + DustDryDep Dust dry deposition +! -> Biogeophysics_Lake lake temperature and surface fluxes +! + VOCEmission compute VOC emission [VOC] +! -> Biogeophysics2 soil/snow & ground temp and update surface fluxes +! -> pft2col Average from PFT level to column level +! -> Hydrology2 surface and soil hydrology +! -> Hydrology_Lake lake hydrology +! -> SnowAge_grain update snow effective grain size for snow radiative transfer +! + CNEcosystemDyn Carbon Nitrogen model ecosystem dynamics: [CN] +! vegetation phenology and soil carbon +! + EcosystemDyn "static" ecosystem dynamics: [! CN ] +! vegetation phenology and soil carbon +! -> BalanceCheck check for errors in energy and water balances +! -> SurfaceAlbedo albedos for next time step +! -> UrbanAlbedo Urban landunit albedos for next time step +! ==== End Loop over clumps ==== +! +! Second phase of the clm main driver, for handling history and restart file output. +! +! -> write_diagnostic output diagnostic if appropriate +! -> updateAccFlds update accumulated fields +! -> hist_update_hbuf accumulate history fields for time interval +! -> htapes_wrapup write history tapes if appropriate +! -> restFile_write write restart file if appropriate +! \end{verbatim} +! +! Optional subroutines are denoted by an plus (+) with the associated +! CPP token or variable in brackets at the end of the line. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use clm_varctl , only : wrtdia, flanduse_timeseries, iulog, create_glacier_mec_landunit, & + use_cn, use_cndv, use_exit_spinup + use spmdMod , only : masterproc,mpicom + use decompMod , only : get_proc_clumps, get_clump_bounds, get_proc_bounds + use filterMod , only : filter, setFilters + use CNDVMod , only : dv, histCNDV + use pftdynMod , only : pftwt_interp + use pftdynMod , only : pftdyn_interp, pftdyn_wbal_init, pftdyn_wbal + use pftdynMod , only : pftdyn_cnbal + use dynlandMod , only : dynland_hwcontent + use clm_varcon , only : zlnd, isturb + use clm_time_manager , only : get_step_size,get_curr_date,get_ref_date,get_nstep + use CropRestMod , only : CropRestIncYear + use histFileMod , only : hist_update_hbuf, hist_htapes_wrapup + use restFileMod , only : restFile_write, restFile_filename + use accFldsMod , only : updateAccFlds + use clm_driverInitMod , only : clm_driverInit + use BalanceCheckMod , only : BeginWaterBalance, BalanceCheck + use SurfaceRadiationMod , only : SurfaceRadiation + use Hydrology1Mod , only : Hydrology1 + use Hydrology2Mod , only : Hydrology2 + use HydrologyLakeMod , only : HydrologyLake + use Biogeophysics1Mod , only : Biogeophysics1 + use BareGroundFluxesMod , only : BareGroundFluxes + use CanopyFluxesMod , only : CanopyFluxes + use Biogeophysics2Mod , only : Biogeophysics2 + use BiogeophysicsLakeMod, only : BiogeophysicsLake + use SurfaceAlbedoMod , only : SurfaceAlbedo + use pft2colMod , only : pft2col + use CNSetValueMod , only : CNZeroFluxes_dwt + use CNEcosystemDynMod , only : CNEcosystemDyn + use CNAnnualUpdateMod , only : CNAnnualUpdate + use CNBalanceCheckMod , only : BeginCBalance, BeginNBalance, & + CBalanceCheck, NBalanceCheck + use ndepStreamMod , only : ndep_interp + use STATICEcosysDynMod , only : EcosystemDyn + use DUSTMod , only : DustDryDep, DustEmission + use VOCEmissionMod , only : VOCEmission + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use STATICEcosysDynMod , only : interpMonthlyVeg + use DryDepVelocity , only : depvel_compute + use abortutils , only : endrun + use UrbanMod , only : UrbanAlbedo, UrbanRadiation, UrbanFluxes + use SNICARMod , only : SnowAge_grain + use clm_atmlnd , only : clm_map2gcell + use clm_glclnd , only : update_clm_s2x + use perf_mod +! +! !PUBLIC TYPES: + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: + public :: clm_drv ! clm physics,history, restart writes +! +! !PRIVATE MEMBER FUNCTIONS: + private :: write_diagnostic ! Write diagnostic information to log file +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: clm_drv +! +! !INTERFACE: +subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) +! +! !DESCRIPTION: +! +! First phase of the clm driver calling the clm physics. An outline of +! the calling tree is given in the description of this module. +! +! !USES: + +! !ARGUMENTS: + implicit none + logical, intent(in) :: doalb ! true if time for surface albedo calc + real(r8), intent(in) :: nextsw_cday ! calendar day for nstep+1 + real(r8), intent(in) :: declinp1 ! declination angle for next time step + real(r8), intent(in) :: declin ! declination angle for current time step + logical, intent(in) :: rstwr ! true => write restart file this step + logical, intent(in) :: nlend ! true => end of run on this step + character(len=*),intent(in) :: rdate ! restart file time stamp for name +! +! !REVISION HISTORY: +! 2002.10.01 Mariana Vertenstein latest update to new data structures +! 11/26/03, Peter Thornton: Added new call for SurfaceRadiationSunShade when +! cpp directive SUNSHA is set, for sunlit/shaded canopy radiation. +! 4/25/05, Peter Thornton: Made the sun/shade routine the default, no longer +! need to have SUNSHA defined. +! Oct/05 & Jul/07 Sam Levis: Starting dates of CNDV and crop model work +! 2/29/08, Dave Lawrence: Revised snow cover fraction according to Niu and Yang, 2007 +! 3/6/09, Peter Thornton: Added declin as new argument, for daylength control on Vcmax +! 2008.11.12 B. Kauffman: morph routine casa() in casa_ecosytemDyn(), so casa +! is more similar to CN & DGVM +! 2/25/2012 M. Vertenstein: Removed CASA references +! +!EOP +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: clandunit(:) ! landunit index associated with each column + integer , pointer :: itypelun(:) ! landunit type +! +! !OTHER LOCAL VARIABLES: + integer :: nstep ! time step number + real(r8) :: dtime ! land model time step (sec) + real(r8) :: t1, t2, t3 ! temporary for mass balance checks + integer :: nc, fc, c, fp, p, l, g ! indices + integer :: nclumps ! number of clumps on this processor + integer :: begg, endg ! clump beginning and ending gridcell indices + integer :: begl, endl ! clump beginning and ending landunit indices + integer :: begc, endc ! clump beginning and ending column indices + integer :: begp, endp ! clump beginning and ending pft indices + integer :: begg_proc, endg_proc ! proc beginning and ending gridcell indices + integer :: begl_proc, endl_proc ! proc beginning and ending landunit indices + integer :: begc_proc, endc_proc ! proc beginning and ending column indices + integer :: begp_proc, endp_proc ! proc beginning and ending pft indices + type(column_type), pointer :: cptr ! pointer to column derived subtype + integer :: yrp1 ! year (0, ...) for nstep+1 + integer :: monp1 ! month (1, ..., 12) for nstep+1 + integer :: dayp1 ! day of month (1, ..., 31) for nstep+1 + integer :: secp1 ! seconds into current date for nstep+1 + integer :: yr ! year (0, ...) + integer :: mon ! month (1, ..., 12) + integer :: day ! day of month (1, ..., 31) + integer :: sec ! seconds of the day + integer :: ncdate ! current date + integer :: nbdate ! base date (reference date) + integer :: kyr ! thousand years, equals 2 at end of first year + character(len=256) :: filer ! restart file name + integer :: ier ! error code +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (landunit-level) + + itypelun => lun%itype + + ! Assign local pointers to derived subtypes components (column-level) + + clandunit => col%landunit + + ! Set pointers into derived type + + cptr => col + + ! Update time-related info + + call CropRestIncYear() + + + if (use_cn) then + ! For dry-deposition need to call CLMSP so that mlaidiff is obtained + if ( n_drydep > 0 .and. drydep_method == DD_XLND ) then + call t_startf('interpMonthlyVeg') + call interpMonthlyVeg() + call t_stopf('interpMonthlyVeg') + endif + else + ! Determine weights for time interpolation of monthly vegetation data. + ! This also determines whether it is time to read new monthly vegetation and + ! obtain updated leaf area index [mlai1,mlai2], stem area index [msai1,msai2], + ! vegetation top [mhvt1,mhvt2] and vegetation bottom [mhvb1,mhvb2]. The + ! weights obtained here are used in subroutine ecosystemdyn to obtain time + ! interpolated values. + if (doalb .or. ( n_drydep > 0 .and. drydep_method == DD_XLND )) then + call t_startf('interpMonthlyVeg') + call interpMonthlyVeg() + call t_stopf('interpMonthlyVeg') + end if + end if + + ! ============================================================================ + ! Loop over clumps + ! ============================================================================ + + nclumps = get_proc_clumps() + + !$OMP PARALLEL DO PRIVATE (nc,g,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + + ! ============================================================================ + ! Determine clump boundaries + ! ============================================================================ + + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + ! ============================================================================ + ! change pft weights and compute associated heat & water fluxes + ! ============================================================================ + + ! initialize heat and water content and dynamic balance fields to zero + do g = begg,endg + gwf%qflx_liq_dynbal(g) = 0._r8 + gws%gc_liq2(g) = 0._r8 + gws%gc_liq1(g) = 0._r8 + gwf%qflx_ice_dynbal(g) = 0._r8 + gws%gc_ice2(g) = 0._r8 + gws%gc_ice1(g) = 0._r8 + gef%eflx_dynbal(g) = 0._r8 + ges%gc_heat2(g) = 0._r8 + ges%gc_heat1(g) = 0._r8 + enddo + + !--- get initial heat,water content --- + call dynland_hwcontent( begg, endg, gws%gc_liq1(begg:endg), & + gws%gc_ice1(begg:endg), ges%gc_heat1(begg:endg) ) + end do + !$OMP END PARALLEL DO + + if (.not. use_cndv) then + if (flanduse_timeseries /= ' ') then + call pftdyn_interp ! change the pft weights + + !$OMP PARALLEL DO PRIVATE (nc,g,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + !--- get new heat,water content: (new-old)/dt = flux into lnd model --- + call dynland_hwcontent( begg, endg, gws%gc_liq2(begg:endg), & + gws%gc_ice2(begg:endg), ges%gc_heat2(begg:endg) ) + dtime = get_step_size() + do g = begg,endg + gwf%qflx_liq_dynbal(g) = (gws%gc_liq2 (g) - gws%gc_liq1 (g))/dtime + gwf%qflx_ice_dynbal(g) = (gws%gc_ice2 (g) - gws%gc_ice1 (g))/dtime + gef%eflx_dynbal (g) = (ges%gc_heat2(g) - ges%gc_heat1(g))/dtime + enddo + end do + !$OMP END PARALLEL DO + end if + end if + + !$OMP PARALLEL DO PRIVATE (nc,g,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + ! ============================================================================ + ! Initialize the mass balance checks: water, carbon, and nitrogen + ! ============================================================================ + + call t_startf('begwbal') + call BeginWaterBalance(begc, endc, begp, endp, & + filter(nc)%num_nolakec, filter(nc)%nolakec, filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_hydrologyc, filter(nc)%hydrologyc) + call t_stopf('begwbal') + + if (use_cn) then + call t_startf('begcnbal') + call BeginCBalance(begc, endc, filter(nc)%num_soilc, filter(nc)%soilc) + call BeginNBalance(begc, endc, filter(nc)%num_soilc, filter(nc)%soilc) + call t_stopf('begcnbal') + end if + + end do + !$OMP END PARALLEL DO + + ! ============================================================================ + ! Initialize h2ocan_loss to zero + ! ============================================================================ + + call t_startf('pftdynwts') + + !$OMP PARALLEL DO PRIVATE (nc,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + call pftdyn_wbal_init( begc, endc ) + + if (use_cndv) then + ! NOTE: Currently CNDV and flanduse_timeseries /= ' ' are incompatible + call CNZeroFluxes_dwt( begc, endc, begp, endp ) + call pftwt_interp( begp, endp ) + call pftdyn_wbal( begg, endg, begc, endc, begp, endp ) + call pftdyn_cnbal( begc, endc, begp, endp ) + call setFilters(nc) + else + ! ============================================================================ + ! Update weights and reset filters if dynamic land use + ! This needs to be done outside the clumps loop, but after BeginWaterBalance() + ! The call to CNZeroFluxes_dwt() is needed regardless of flanduse_timeseries + ! ============================================================================ + if (use_cn) then + call CNZeroFluxes_dwt( begc, endc, begp, endp ) + end if + if (flanduse_timeseries /= ' ') then + if (use_cn) then + call pftdyn_cnbal( begc, endc, begp, endp ) + end if + call setFilters(nc) + end if + end if + + end do + !$OMP END PARALLEL DO + + + if (use_cn) then + ! ============================================================================ + ! Update dynamic N deposition field, on albedo timestep + ! currently being done outside clumps loop, but no reason why it couldn't be + ! re-written to go inside. + ! ============================================================================ + ! PET: switching CN timestep + call ndep_interp() + end if + call t_stopf('pftdynwts') + + !$OMP PARALLEL DO PRIVATE (nc,l,c,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + + ! ============================================================================ + ! Determine clump boundaries + ! ============================================================================ + + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + ! ============================================================================ + ! Initialize variables from previous time step and + ! Determine canopy interception and precipitation onto ground surface. + ! Determine the fraction of foliage covered by water and the fraction + ! of foliage that is dry and transpiring. Initialize snow layer if the + ! snow accumulation exceeds 10 mm. + ! ============================================================================ + + ! initialize intracellular CO2 (Pa) parameters each timestep for use in VOCEmission + pps%cisun(begp:endp) = -999._r8 + pps%cisha(begp:endp) = -999._r8 + + ! initialize declination for current timestep + do c = begc,endc + cps%decl(c) = declin + end do + + call t_startf('drvinit') + call clm_driverInit(begc, endc, begp, endp, & + filter(nc)%num_nolakec, filter(nc)%nolakec, filter(nc)%num_lakec, filter(nc)%lakec) + call t_stopf('drvinit') + + ! ============================================================================ + ! Hydrology1 + ! ============================================================================ + + call t_startf('hydro1') + call Hydrology1(begc, endc, begp, endp, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep) + call t_stopf('hydro1') + + ! ============================================================================ + ! Surface Radiation + ! ============================================================================ + + call t_startf('surfrad') + + ! Surface Radiation for non-urban columns + + call SurfaceRadiation(begp, endp, & + filter(nc)%num_nourbanp, filter(nc)%nourbanp) + + ! Surface Radiation for urban columns + + call UrbanRadiation(nc, begl, endl, begc, endc, begp, endp, & + filter(nc)%num_nourbanl, filter(nc)%nourbanl, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp) + + call t_stopf('surfrad') + + ! ============================================================================ + ! Determine leaf temperature and surface fluxes based on ground + ! temperature from previous time step. + ! ============================================================================ + + call t_startf('bgp1') + call Biogeophysics1(begg, endg, begc, endc, begp, endp, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep) + call t_stopf('bgp1') + + ! ============================================================================ + ! Determine bare soil or snow-covered vegetation surface temperature and fluxes + ! Calculate Ground fluxes (frac_veg_nosno is either 1 or 0) + ! ============================================================================ + + call t_startf('bgflux') + + ! BareGroundFluxes for all pfts except lakes and urban landunits + + call BareGroundFluxes(begp, endp, & + filter(nc)%num_nolakeurbanp, filter(nc)%nolakeurbanp) + call t_stopf('bgflux') + + ! Fluxes for all Urban landunits + + call t_startf('uflux') + call UrbanFluxes(nc, begp, endp, begl, endl, begc, endc, & + filter(nc)%num_nourbanl, filter(nc)%nourbanl, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp) + call t_stopf('uflux') + + ! ============================================================================ + ! Determine non snow-covered vegetation surface temperature and fluxes + ! Calculate canopy temperature, latent and sensible fluxes from the canopy, + ! and leaf water change by evapotranspiration + ! ============================================================================ + + call t_startf('canflux') + call CanopyFluxes(begg, endg, begc, endc, begp, endp, & + filter(nc)%num_nolakep, filter(nc)%nolakep) + call t_stopf('canflux') + + ! ============================================================================ + ! Determine lake temperature and surface fluxes + ! ============================================================================ + + call t_startf('bgplake') + call BiogeophysicsLake(begc, endc, begp, endp, & + filter(nc)%num_lakec, filter(nc)%lakec, & + filter(nc)%num_lakep, filter(nc)%lakep) + call t_stopf('bgplake') + + ! ============================================================================ + ! DUST and VOC emissions + ! ============================================================================ + + call t_startf('bgc') + + ! Dust mobilization (C. Zender's modified codes) + call DustEmission(begp, endp, begc, endc, begl, endl, & + filter(nc)%num_nolakep, filter(nc)%nolakep) + + ! Dust dry deposition (C. Zender's modified codes) + call DustDryDep(begp, endp) + + ! VOC emission (A. Guenther's MEGAN (2006) model) + call VOCEmission(begp, endp, & + filter(nc)%num_soilp, filter(nc)%soilp) + + call t_stopf('bgc') + + ! ============================================================================ + ! Determine soil/snow temperatures including ground temperature and + ! update surface fluxes for new ground temperature. + ! ============================================================================ + + call t_startf('bgp2') + call Biogeophysics2(begl, endl, begc, endc, begp, endp, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_nolakep, filter(nc)%nolakep) + call t_stopf('bgp2') + + ! ============================================================================ + ! Perform averaging from PFT level to column level + ! ============================================================================ + + call t_startf('pft2col') + call pft2col(begc, endc, filter(nc)%num_nolakec, filter(nc)%nolakec) + call t_stopf('pft2col') + + ! ============================================================================ + ! Vertical (column) soil and surface hydrology + ! ============================================================================ + + call t_startf('hydro2') + call Hydrology2(begc, endc, begp, endp, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_hydrologyc, filter(nc)%hydrologyc, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_snowc, filter(nc)%snowc, & + filter(nc)%num_nosnowc, filter(nc)%nosnowc) + call t_stopf('hydro2') + + ! ============================================================================ + ! Lake hydrology + ! ============================================================================ + + call t_startf('hylake') + call HydrologyLake(begp, endp, & + filter(nc)%num_lakep, filter(nc)%lakep) + call t_stopf('hylake') + + ! ============================================================================ + ! ! Fraction of soil covered by snow (Z.-L. Yang U. Texas) + ! ============================================================================ + + do c = begc,endc + l = clandunit(c) + if (itypelun(l) == isturb) then + ! Urban landunit use Bonan 1996 (LSM Technical Note) + cps%frac_sno(c) = min( cps%snowdp(c)/0.05_r8, 1._r8) + else + ! snow cover fraction in Niu et al. 2007 + cps%frac_sno(c) = 0.0_r8 + if(cps%snowdp(c) .gt. 0.0_r8) then + cps%frac_sno(c) = tanh(cps%snowdp(c)/(2.5_r8*zlnd* & + (min(800._r8,cws%h2osno(c)/cps%snowdp(c))/100._r8)**1._r8) ) + endif + end if + end do + + ! ============================================================================ + ! Snow aging routine based on Flanner and Zender (2006), Linking snowpack + ! microphysics and albedo evolution, JGR, and Brun (1989), Investigation of + ! wet-snow metamorphism in respect of liquid-water content, Ann. Glaciol. + ! ============================================================================ + call SnowAge_grain(begc, endc, & + filter(nc)%num_snowc, filter(nc)%snowc, & + filter(nc)%num_nosnowc, filter(nc)%nosnowc) + + ! ============================================================================ + ! Ecosystem dynamics: Uses CN, CNDV, or static parameterizations + ! ============================================================================ + call t_startf('ecosysdyn') + + if (use_cn) then + ! fully prognostic canopy structure and C-N biogeochemistry + ! - CNDV defined: prognostic biogeography; else prescribed + ! - crop model: crop algorithms called from within CNEcosystemDyn + call CNEcosystemDyn(begc,endc,begp,endp,filter(nc)%num_soilc,& + filter(nc)%soilc, filter(nc)%num_soilp, & + filter(nc)%soilp, filter(nc)%num_pcropp, & + filter(nc)%pcropp, doalb) + call CNAnnualUpdate(begc,endc,begp,endp,filter(nc)%num_soilc,& + filter(nc)%soilc, filter(nc)%num_soilp, & + filter(nc)%soilp) + else + ! Prescribed biogeography, + ! prescribed canopy structure, some prognostic carbon fluxes + call EcosystemDyn(begp, endp, & + filter(nc)%num_nolakep, filter(nc)%nolakep, & + doalb) + end if + call t_stopf('ecosysdyn') + + ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) + call depvel_compute(begp,endp) + + ! ============================================================================ + ! Check the energy and water balance, also carbon and nitrogen balance + ! ============================================================================ + + call t_startf('balchk') + call BalanceCheck(begp, endp, begc, endc, begl, endl, begg, endg) + call t_stopf('balchk') + + if (use_exit_spinup) then + ! skip calls to C and N balance checking during EXIT_SPINUP + ! because the system is (intentionally) not conserving mass + ! on the first EXIT_SPINUP doalb timestep + else + if (use_cn) then + nstep = get_nstep() + if (nstep > 2) then + call t_startf('cnbalchk') + call CBalanceCheck(begc, endc, filter(nc)%num_soilc, filter(nc)%soilc) + call NBalanceCheck(begc, endc, filter(nc)%num_soilc, filter(nc)%soilc) + call t_stopf('cnbalchk') + end if + end if + end if + + ! ============================================================================ + ! Determine albedos for next time step + ! ============================================================================ + + if (doalb) then + call t_startf('surfalb') + + ! Albedos for non-urban columns + + call SurfaceAlbedo(begg, endg, begc, endc, begp, endp, & + filter(nc)%num_nourbanc, filter(nc)%nourbanc, & + filter(nc)%num_nourbanp, filter(nc)%nourbanp, & + nextsw_cday, declinp1) + + call t_stopf('surfalb') + + ! Albedos for urban columns + + call t_startf('urbsurfalb') + + if (filter(nc)%num_urbanl > 0) then + call UrbanAlbedo(nc, begl, endl, begc, endc, begp, endp, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp) + end if + + call t_stopf('urbsurfalb') + + end if + + end do + !$OMP END PARALLEL DO + + ! ============================================================================ + ! Determine gridcell averaged properties to send to atm (l2as and l2af derived types) + ! ============================================================================ + + call t_startf('clm_map2gcell') + call clm_map2gcell( ) + call t_stopf('clm_map2gcell') + + ! ============================================================================ + ! Determine fields to send to glc + ! ============================================================================ + + if (create_glacier_mec_landunit) then + call t_startf('create_s2x') + call update_clm_s2x(init=.false.) + call t_stopf('create_s2x') + end if + + ! ============================================================================ + ! Write global average diagnostics to standard output + ! ============================================================================ + + nstep = get_nstep() + if (wrtdia) call mpi_barrier(mpicom,ier) + call t_startf('wrtdiag') + call write_diagnostic(wrtdia, nstep) + call t_stopf('wrtdiag') + + ! ============================================================================ + ! Update accumulators + ! ============================================================================ + + call t_startf('accum') + call updateAccFlds() + call t_stopf('accum') + + ! ============================================================================ + ! Update history buffer + ! ============================================================================ + + call t_startf('hbuf') + call hist_update_hbuf() + call t_stopf('hbuf') + + ! ============================================================================ + ! Call dv (dynamic vegetation) at last time step of year + ! NOTE: monp1, dayp1, and secp1 correspond to nstep+1 + ! ============================================================================ + + if (use_cndv) then + call t_startf('d2dgvm') + dtime = get_step_size() + call get_curr_date(yrp1, monp1, dayp1, secp1, offset=int(dtime)) + if (monp1==1 .and. dayp1==1 .and. secp1==dtime .and. nstep>0) then + + ! Get date info. kyr is used in lpj(). At end of first year, kyr = 2. + call get_curr_date(yr, mon, day, sec) + ncdate = yr*10000 + mon*100 + day + call get_ref_date(yr, mon, day, sec) + nbdate = yr*10000 + mon*100 + day + kyr = ncdate/10000 - nbdate/10000 + 1 + + if (masterproc) write(iulog,*) 'End of year. CNDV called now: ncdate=', & + ncdate,' nbdate=',nbdate,' kyr=',kyr,' nstep=', nstep + + nclumps = get_proc_clumps() + + !$OMP PARALLEL DO PRIVATE (nc,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1,nclumps + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + call dv(begg, endg, begp, endp, & + filter(nc)%num_natvegp, filter(nc)%natvegp, kyr) + end do + !$OMP END PARALLEL DO + end if + call t_stopf('d2dgvm') + end if + + ! ============================================================================ + ! Create history and write history tapes if appropriate + ! ============================================================================ + + call t_startf('clm_drv_io') + + call t_startf('clm_drv_io_htapes') + call hist_htapes_wrapup( rstwr, nlend ) + call t_stopf('clm_drv_io_htapes') + + ! ============================================================================ + ! Write to CNDV history buffer if appropriate + ! ============================================================================ + + if (use_cndv) then + if (monp1==1 .and. dayp1==1 .and. secp1==dtime .and. nstep>0) then + call t_startf('clm_drv_io_hdgvm') + call histCNDV() + if (masterproc) write(iulog,*) 'Annual CNDV calculations are complete' + call t_stopf('clm_drv_io_hdgvm') + end if + end if + + ! ============================================================================ + ! Write restart/initial files if appropriate + ! ============================================================================ + + if (rstwr) then + call t_startf('clm_drv_io_wrest') + filer = restFile_filename(rdate=rdate) + call restFile_write( filer, nlend, rdate=rdate ) + call t_stopf('clm_drv_io_wrest') + end if + + call t_stopf('clm_drv_io') + +end subroutine clm_drv + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: write_diagnostic +! +! !INTERFACE: +subroutine write_diagnostic (wrtdia, nstep) +! +! !DESCRIPTION: +! Write diagnostic surface temperature output each timestep. Written to +! be fast but not bit-for-bit because order of summations can change each +! timestep. +! +! !USES: + use clm_atmlnd , only : clm_l2a + use decompMod , only : get_proc_bounds, get_proc_global + use spmdMod , only : masterproc, npes, MPI_REAL8, MPI_ANY_SOURCE, & + MPI_STATUS_SIZE, mpicom, MPI_SUM + use shr_sys_mod, only : shr_sys_flush + use abortutils , only : endrun +! +! !ARGUMENTS: + implicit none + logical, intent(in) :: wrtdia !true => write diagnostic + integer, intent(in) :: nstep !model time step +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +! +! !LOCAL VARIABLES: + integer :: p ! loop index + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: ier ! error status + real(r8):: psum ! partial sum of ts + real(r8):: tsum ! sum of ts + real(r8):: tsxyav ! average ts for diagnostic output + integer :: status(MPI_STATUS_SIZE) ! mpi status + logical,parameter :: old_sendrecv = .false. ! Flag if should use old send/receive method rather than MPI reduce +!------------------------------------------------------------------------ + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + + if (wrtdia) then + + call t_barrierf('sync_write_diag', mpicom) + psum = sum(clm_l2a%t_rad(begg:endg)) + if (old_sendrecv) then + if (masterproc) then + tsum = psum + do p = 1, npes-1 + call mpi_recv(psum, 1, MPI_REAL8, p, 999, mpicom, status, ier) + if (ier/=0) then + write(iulog,*) 'write_diagnostic: Error in mpi_recv()' + call endrun + end if + tsum = tsum + psum + end do + else + call mpi_send(psum, 1, MPI_REAL8, 0, 999, mpicom, ier) + if (ier/=0) then + write(iulog,*) 'write_diagnostic: Error in mpi_send()' + call endrun + end if + end if + else + call mpi_reduce(psum, tsum, 1, MPI_REAL8, MPI_SUM, 0, mpicom, ier) + if (ier/=0) then + write(iulog,*) 'write_diagnostic: Error in mpi_reduce()' + call endrun + end if + endif + if (masterproc) then + tsxyav = tsum / numg + write(iulog,1000) nstep, tsxyav + call shr_sys_flush(iulog) + end if + + else + + if (masterproc) then + write(iulog,*)'clm2: completed timestep ',nstep + call shr_sys_flush(iulog) + end if + + endif + +1000 format (1x,'nstep = ',i10,' TS = ',f21.15) + +end subroutine write_diagnostic + +end module clm_driver diff --git a/components/clm/src_clm40/main/clm_glclnd.F90 b/components/clm/src_clm40/main/clm_glclnd.F90 new file mode 100644 index 0000000000..1e0ff2898e --- /dev/null +++ b/components/clm/src_clm40/main/clm_glclnd.F90 @@ -0,0 +1,263 @@ +module clm_glclnd + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_glclnd +! +! !DESCRIPTION: +! Handle arrays used for exchanging data between glc and land model. +! Based on clm_atmlnd (but without mapping routines because glc data +! is send and received on the lnd decomposition, at least for now). +! +! The fields sent from the lnd component to the glc component via +! the coupler are labeled 's2x', or sno to coupler. +! The fields received by the lnd component from the glc component +! via the coupler are labeled 'x2s', or coupler to sno. +! 'Sno' is a misnomer in that the exchanged data are related to +! the ice beneath the snow, not the snow itself. But by CESM convention, +! 'ice' refers to sea ice, not land ice. +! +! !USES: + use decompMod , only : get_proc_bounds + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use spmdMod , only : masterproc + use clm_varpar , only : maxpatch_glcmec + use clm_varctl , only : iulog, glc_smb + use abortutils , only : endrun +! +! !REVISION HISTORY: +! Created by William Lipscomb, Dec. 2007, based on clm_atmlnd.F90. +! +! !PUBLIC TYPES: + implicit none + private + save + +!---------------------------------------------------- +! glc -> land variables structure +!---------------------------------------------------- + type, public :: glc2lnd_type + real(r8), pointer :: frac(:,:) => null() + real(r8), pointer :: topo(:,:) => null() + real(r8), pointer :: hflx(:,:) => null() + real(r8), pointer :: icemask(:) => null() + end type glc2lnd_type + +!---------------------------------------------------- +! land -> glc variables structure +!---------------------------------------------------- + type, public :: lnd2glc_type + real(r8), pointer :: tsrf(:,:) => null() + real(r8), pointer :: topo(:,:) => null() + real(r8), pointer :: qice(:,:) => null() + end type lnd2glc_type + + type (lnd2glc_type), public, target :: clm_s2x ! s2x fields on clm grid + type (glc2lnd_type), public, target :: clm_x2s ! x2s fields on clm grid + +! !PUBLIC MEMBER FUNCTIONS: + public :: init_glc2lnd_type + public :: init_lnd2glc_type + public :: update_clm_s2x +! +! !PRIVATE MEMBER FUNCTIONS: + +!EOP +!---------------------------------------------------- + +contains + + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_glc2lnd_type +! +! !INTERFACE: + subroutine init_glc2lnd_type(beg, end, x2s) +! +! !DESCRIPTION: +! Initialize glc variables required by the land +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (glc2lnd_type), intent(inout):: x2s +! +! !REVISION HISTORY: +! Created by William Lipscomb, based on init_atm2lnd_type +!EOP +! +! !LOCAL VARIABLES: + real(r8) :: ival ! initial value +!------------------------------------------------------------------------ + + allocate(x2s%frac(beg:end,0:maxpatch_glcmec)) + allocate(x2s%topo(beg:end,0:maxpatch_glcmec)) + allocate(x2s%hflx(beg:end,0:maxpatch_glcmec)) + allocate(x2s%icemask(beg:end)) + +! ival = nan ! causes core dump in map_maparray, tcx fix + ival = 0.0_r8 + + x2s%frac(beg:end,0:) = ival + x2s%topo(beg:end,0:) = ival + x2s%hflx(beg:end,0:) = ival + x2s%icemask(beg:end)= ival + +end subroutine init_glc2lnd_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_lnd2glc_type +! +! !INTERFACE: + subroutine init_lnd2glc_type(beg, end, s2x) +! +! !DESCRIPTION: +! Initialize land variables required by glc +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (lnd2glc_type), intent(inout):: s2x +! +! !REVISION HISTORY: +! Created by William Lipscomb, based on init_lnd2atm_type +! +!EOP +! +! !LOCAL VARIABLES: + real(r8) :: ival ! initial value +!------------------------------------------------------------------------ + + allocate(s2x%tsrf(beg:end,0:maxpatch_glcmec)) + allocate(s2x%topo(beg:end,0:maxpatch_glcmec)) + allocate(s2x%qice(beg:end,0:maxpatch_glcmec)) + +! ival = nan ! causes core dump in map_maparray, tcx fix + ival = 0.0_r8 + + s2x%tsrf(beg:end,0:) = ival + s2x%topo(beg:end,0:) = ival + s2x%qice(beg:end,0:) = ival + +end subroutine init_lnd2glc_type + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: update_clm_s2x +! +! !INTERFACE: + subroutine update_clm_s2x(init) +! +! !DESCRIPTION: +! Assign values to clm_s2x based on the appropriate derived types +! +! !USES: + use clmtype + use domainMod , only : ldomain + use clm_varcon , only : istice_mec + use clm_atmlnd , only : clm_l2a, clm_a2l + use clm_varcon , only : spval, tfrz +! +! !ARGUMENTS: + implicit none + + logical, intent(in) :: init ! if true=>only set a subset of fields +! +! !REVISION HISTORY: +! Written by William Lipscomb, Feb. 2009 +! + + integer :: begg, endg ! per-proc beginning and ending gridcell indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: c, l, g, n ! indices + integer , pointer :: ityplun(:) ! landunit type + integer , pointer :: clandunit(:) ! column's landunit index + integer , pointer :: cgridcell(:) ! column's gridcell index + + ! Assign local pointers to derived type members + + clandunit => col%landunit + cgridcell => col%gridcell + ityplun => lun%itype + + ! Get processor bounds + call get_proc_bounds(begg, endg, begc=begc, endc=endc) + + ! Initialize qice because otherwise it will remain unset if init=true and + ! glc_smb=true; note that the value here is the value qice will keep if these + ! conditions hold. Also, need to set a reasonable default for elevation class 0, + ! which is used by the CLM4.5 code, but not by CLM4.0. + + clm_s2x%qice(:,0:) = 0._r8 + + ! and initialize the other variables just to be safe; also need to set a reasonable + ! default for elevation class 0 (for tsrf, note that we initialize other elevation + ! classes to 0, to remain consistent with what was done before, but set elevation + ! class 0 to a reasonable default, because it will remain at its default value). + + clm_s2x%tsrf(:,0) = tfrz + clm_s2x%tsrf(:,1:) = 0._r8 + clm_s2x%topo(:,:) = 0._r8 + + ! Fill the clm_s2x vector on the clm grid + + if (glc_smb) then ! send surface mass balance info + do c = begc, endc + l = clandunit(c) + g = cgridcell(c) + + ! Following assumes all elevation classes are populated + if (ityplun(l) == istice_mec) then + n = c - lun%coli(l) + 1 ! elevation class index + + ! t_soisno and glc_topo are valid even in initialization, so tsrf and topo + ! are set here regardless of the value of init. But qflx_glcice is not valid + ! until the run loop; thus, in initialization, we will use the default value + ! for qice, as set above. + clm_s2x%tsrf(g,n) = ces%t_soisno(c,1) + clm_s2x%topo(g,n) = cps%glc_topo(c) + if (.not. init) then + clm_s2x%qice(g,n) = cwf%qflx_glcice(c) + + ! Check for bad values of qice + if ( abs(clm_s2x%qice(g,n)) > 1.0_r8 .and. clm_s2x%qice(g,n) /= spval) then + write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, clm_s2x%qice(g,n) + endif + end if + + endif ! istice_mec + enddo ! c + else ! Pass PDD info (same info in each elevation class) + ! Require maxpatch_glcmec = 1 for this case + if (maxpatch_glcmec .ne. 1) then + call endrun('update_clm_s2x error: maxpatch_glcmec must be 1 if glc_smb is false') + end if + n = 1 + do g = begg, endg + clm_s2x%tsrf(g,n) = clm_l2a%t_ref2m(g) + clm_s2x%qice(g,n) = clm_a2l%forc_snow(g) ! Assume rain runs off + clm_s2x%topo(g,n) = ldomain%topo(g) + ! Check for bad values of qice + if (clm_s2x%qice(g,n) > -1.0_r8 .and. clm_s2x%qice(g,n) < 1.0_r8) then + continue + else + write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, clm_s2x%qice(g,n) + write(iulog,*) 'forc_rain =', clm_a2l%forc_rain(g) + write(iulog,*) 'forc_snow =', clm_a2l%forc_snow(g) + endif + enddo + endif ! glc_smb + +end subroutine update_clm_s2x + +!------------------------------------------------------------------------ + +end module clm_glclnd + diff --git a/components/clm/src_clm40/main/clm_initializeMod.F90 b/components/clm/src_clm40/main/clm_initializeMod.F90 new file mode 100644 index 0000000000..dc6443bcc1 --- /dev/null +++ b/components/clm/src_clm40/main/clm_initializeMod.F90 @@ -0,0 +1,684 @@ +module clm_initializeMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_initializeMod +! +! !DESCRIPTION: +! Performs land model initialization +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use shr_sys_mod , only : shr_sys_flush + use abortutils , only : endrun + use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch, & + create_glacier_mec_landunit, iulog, & + use_cn, use_cndv + use clm_varsur , only : wtxy, vegxy, topoxy + use perf_mod , only : t_startf, t_stopf + use ncdio_pio , only : file_desc_t + +! !PUBLIC TYPES: + implicit none + save + + private ! By default everything is private + +! !PUBLIC MEMBER FUNCTIONS: + public :: initialize1 ! Phase one initialization + public :: initialize2 ! Phase two initialization +! +! !REVISION HISTORY: +! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein +! +! +! !PRIVATE MEMBER FUNCTIONS: + private header ! echo version numbers + private do_restread ! read a restart file +!----------------------------------------------------------------------- +! !PRIVATE DATA MEMBERS: None + +!EOP +!----------------------------------------------------------------------- +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: initialize1 +! +! !INTERFACE: + subroutine initialize1( ) +! +! !DESCRIPTION: +! Land model initialization. +! o Initializes run control variables via the [clm_inparm] namelist. +! o Reads surface data on model grid. +! o Defines the multiple plant types and fraction areas for each surface type. +! o Builds the appropriate subgrid <-> grid mapping indices and weights. +! o Set up parallel processing. +! o Initializes time constant variables. +! o Reads restart data for a restart or branch run. +! o Reads initial data and initializes the time variant variables for an initial run. +! o Initializes history file output. +! o Initializes river routing model. +! o Initializes accumulation variables. +! +! !USES: + use clmtypeInitMod , only : initClmtype + use clm_varpar , only : maxpatch, clm_varpar_init + use clm_varctl , only : fsurdat, fatmlndfrc, flndtopo, fglcmask, noland + use pftvarcon , only : pftconrd + use decompInitMod , only : decompInit_lnd, decompInit_glcp + use decompMod , only : get_proc_bounds + use domainMod , only : domain_check, ldomain, domain_init + use surfrdMod , only : surfrd_get_globmask, surfrd_get_grid, surfrd_get_topo, & + surfrd_get_data + use controlMod , only : control_init, control_print, nlfilename + use UrbanInputMod , only : UrbanInput + use ncdio_pio , only : ncd_pio_init + use clm_atmlnd , only : init_atm2lnd_type, init_lnd2atm_type, clm_a2l, clm_l2a + use clm_glclnd , only : init_glc2lnd_type, init_lnd2glc_type, clm_x2s, clm_s2x + use initGridCellsMod, only : initGridCells +! +! !ARGUMENTS: +! +! !REVISION HISTORY: +! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ier ! error status + integer :: i,j,n,k ! loop indices + integer :: nl ! gdc and glo lnd indices + integer :: ns, ni, nj ! global grid sizes + logical :: isgrid2d ! true => global grid is regular lat/lon + integer :: begp, endp ! clump beg and ending pft indices + integer :: begc, endc ! clump beg and ending column indices + integer :: begl, endl ! clump beg and ending landunit indices + integer :: begg, endg ! clump beg and ending gridcell indices + integer ,pointer :: amask(:) ! global land mask + character(len=32) :: subname = 'initialize1' ! subroutine name +!----------------------------------------------------------------------- + + call t_startf('clm_init1') + + ! ------------------------------------------------------------------------ + ! Initialize run control variables, timestep + ! ------------------------------------------------------------------------ + + call header() + + if (masterproc) then + write(iulog,*) 'Attempting to initialize the land model .....' + write(iulog,*) + call shr_sys_flush(iulog) + endif + + call control_init() + call clm_varpar_init() + call ncd_pio_init() + + if (masterproc) call control_print() + + ! ------------------------------------------------------------------------ + ! Read in global land grid and land mask (amask)- needed to set decomposition + ! ------------------------------------------------------------------------ + + ! global memory for amask is allocate in surfrd_get_glomask - must be + ! deallocated below + if (masterproc) then + write(iulog,*) 'Attempting to read global land mask from ',trim(fatmlndfrc) + call shr_sys_flush(iulog) + endif + call surfrd_get_globmask(filename=fatmlndfrc, mask=amask, ni=ni, nj=nj) + + ! Exit early if no valid land points + if ( all(amask == 0) )then + if (masterproc) write(iulog,*) trim(subname)//': no valid land points do NOT run clm' + noland = .true. + return + end if + + ! Determine clm decomposition + + call decompInit_lnd(ni, nj, amask) + deallocate(amask) + + ! Get grid and land fraction (set ldomain) + + if (masterproc) then + write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) + call shr_sys_flush(iulog) + endif + if (create_glacier_mec_landunit) then + call surfrd_get_grid(ldomain, fatmlndfrc, fglcmask) + else + call surfrd_get_grid(ldomain, fatmlndfrc) + endif + if (masterproc) then + call domain_check(ldomain) + endif + ldomain%mask = 1 !!! TODO - is this needed? + + ! Get topo if appropriate (set ldomain%topo) + + if (flndtopo /= " ") then + if (masterproc) then + write(iulog,*) 'Attempting to read atm topo from ',trim(flndtopo) + call shr_sys_flush(iulog) + endif + call surfrd_get_topo(ldomain, flndtopo) + endif + + ! Initialize urban model input (initialize urbinp data structure) + + call UrbanInput(mode='initialize') + + ! Allocate surface grid dynamic memory (for wtxy and vegxy arrays) + ! Allocate additional dynamic memory for glacier_mec topo and thickness + + call get_proc_bounds(begg, endg) + allocate (vegxy(begg:endg,maxpatch), wtxy(begg:endg,maxpatch), stat=ier) + if (create_glacier_mec_landunit) then + allocate (topoxy(begg:endg,maxpatch), stat=ier) + else + allocate (topoxy(1,1), stat=ier) + endif + if (ier /= 0) then + write(iulog,*)'initialize allocation error'; call endrun() + endif + + ! Read list of PFTs and their corresponding parameter values + ! Independent of model resolution, Needs to stay before surfrd_get_data + + call pftconrd() + + ! Read surface dataset and set up vegetation type [vegxy] and + ! weight [wtxy] arrays for [maxpatch] subgrid patches. + + call surfrd_get_data(ldomain, fsurdat) + + ! Determine decomposition of subgrid scale landunits, columns, pfts + + if (create_glacier_mec_landunit) then + call decompInit_glcp (ns, ni, nj, ldomain%glcmask) + else + call decompInit_glcp (ns, ni, nj) + endif + + ! Allocate memory and initialize values of clmtype data structures + + call initClmtype() + + ! Initialize atm->lnd, lnd->atm, glc->lnd and lnd->glc data structures + + call init_atm2lnd_type(begg, endg, clm_a2l) + call init_lnd2atm_type(begg, endg, clm_l2a) + if (create_glacier_mec_landunit) then + call init_glc2lnd_type(begg, endg, clm_x2s) + call init_lnd2glc_type(begg, endg, clm_s2x) + endif + + ! Build hierarchy and topological info for derived types + + call initGridCells() + + ! Deallocate surface grid dynamic memory (for wtxy and vegxy arrays) + + deallocate (vegxy, wtxy, topoxy) + + call t_stopf('clm_init1') + + end subroutine initialize1 + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: initialize2 +! +! !INTERFACE: + subroutine initialize2( ) +! +! !DESCRIPTION: +! Land model initialization. +! o Initializes run control variables via the [clm_inparm] namelist. +! o Reads surface data on model grid. +! o Defines the multiple plant types and fraction areas for each surface type. +! o Builds the appropriate subgrid <-> grid mapping indices and weights. +! o Set up parallel processing. +! o Initializes time constant variables. +! o Reads restart data for a restart or branch run. +! o Reads initial data and initializes the time variant variables for an initial run. +! o Initializes history file output. +! o Initializes river routing model. +! o Initializes accumulation variables. +! +! !USES: + use clm_atmlnd , only : clm_map2gcell_minimal + use clm_glclnd , only : update_clm_s2x + use clm_varctl , only : finidat, flanduse_timeseries + use decompMod , only : get_proc_clumps, get_proc_bounds + use filterMod , only : allocFilters, setFilters + use histFldsMod , only : hist_initFlds + use histFileMod , only : hist_htapes_build, htapes_fieldlist + use restFileMod , only : restFile_getfile, & + restFile_open, restFile_close, restFile_read + use accFldsMod , only : initAccFlds, initAccClmtype + use mkarbinitMod , only : mkarbinit + use pftdynMod , only : pftdyn_init, pftdyn_interp + use ndepStreamMod , only : ndep_init, ndep_interp + use CNEcosystemDynMod, only : CNEcosystemDynInit + use pftdynMod , only : pftwt_init + use CNDVEcosystemDyniniMod, only : CNDVEcosystemDynini + use STATICEcosysDynMod , only : EcosystemDynini, readAnnualVegetation + use STATICEcosysDynMod , only : interpMonthlyVeg + use DustMod , only : Dustini + use clm_time_manager, only : get_curr_date, get_nstep, advance_timestep, & + timemgr_init, timemgr_restart_io, timemgr_restart + use clm_time_manager, only : get_step_size, get_curr_calday + use fileutils , only : getfil + use UrbanMod , only : UrbanClumpInit + use UrbanInitMod , only : UrbanInitTimeConst, UrbanInitTimeVar, UrbanInitAero + use UrbanInputMod , only : UrbanInput + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use shr_orb_mod , only : shr_orb_decl + use initSurfAlbMod , only : initSurfAlb, do_initsurfalb + use clm_varorb , only : eccen, mvelpp, lambm0, obliqr + use VOCEmissionMod , only : VOCEmission_init + + +! !Arguments + implicit none +! +! !REVISION HISTORY: +! Created by Gordon Bonan, Sam Levis and Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: nl,na,nag ! indices + integer :: i,j,k ! indices + integer :: yr ! current year (0, ...) + integer :: mon ! current month (1 -> 12) + integer :: day ! current day (1 -> 31) + integer :: ncsec ! current time of day [seconds] + integer :: nc ! clump index + integer :: nclumps ! number of clumps on this processor + integer :: begp, endp ! clump beg and ending pft indices + integer :: begc, endc ! clump beg and ending column indices + integer :: begl, endl ! clump beg and ending landunit indices + integer :: begg, endg ! clump beg and ending gridcell indices + character(len=256) :: fnamer ! name of netcdf restart file + character(len=256) :: pnamer ! full pathname of netcdf restart file + type(file_desc_t) :: ncid ! netcdf id + real(r8) :: dtime ! time step increment (sec) + integer :: nstep ! model time step + real(r8) :: calday ! calendar day for nstep + real(r8) :: caldaym1 ! calendar day for nstep-1 + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinm1 ! solar declination angle in radians for nstep-1 + real(r8) :: eccf ! earth orbit eccentricity factor + character(len=32) :: subname = 'initialize2' ! subroutine name +!---------------------------------------------------------------------- + + call t_startf('clm_init2') + + ! ------------------------------------------------------------------------ + ! Initialize time constant variables + ! ------------------------------------------------------------------------ + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp ) + + ! Initialize Ecosystem Dynamics + + call t_startf('init_ecosys') + if (use_cndv) then + call CNDVEcosystemDynini() + else if (.not. use_cn) then + call EcosystemDynini() + end if + + if (use_cn .or. use_cndv) then + ! -------------------------------------------------------------- + ! Initialize CLMSP ecosystem dynamics when drydeposition is used + ! so that estimates of monthly differences in LAI can be computed + ! -------------------------------------------------------------- + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + call EcosystemDynini() + end if + end if + call t_stopf('init_ecosys') + + ! Initialize dust emissions model + + call t_startf('init_dust') + call Dustini() + call t_stopf('init_dust') + + ! Initialize MEGAN emissions model + + call VOCEmission_init( ) + + ! ------------------------------------------------------------------------ + ! Initialize time constant urban variables + ! ------------------------------------------------------------------------ + + call t_startf('init_io1') + call UrbanInitTimeConst() + call iniTimeConst() + + ! ------------------------------------------------------------------------ + ! Obtain restart file if appropriate + ! ------------------------------------------------------------------------ + + if (do_restread()) then + call restFile_getfile( file=fnamer, path=pnamer ) + end if + + ! ------------------------------------------------------------------------ + ! Initialize master history list. + ! ------------------------------------------------------------------------ + call t_startf('hist_initFlds') + + call hist_initFlds() + ! On restart process the history namelist. Later the namelist from the restart file + ! will be used. But, this allows some basic checking to make sure you didn't + ! try to change the history namelist on restart. + if (nsrest == nsrContinue ) call htapes_fieldlist() + + call t_stopf('hist_initFlds') + ! ------------------------------------------------------------------------ + ! Initialize time manager + ! ------------------------------------------------------------------------ + + if (nsrest == nsrStartup) then + call timemgr_init() + else + call restFile_open( flag='read', file=fnamer, ncid=ncid ) + call timemgr_restart_io( ncid=ncid, flag='read' ) + call restFile_close( ncid=ncid ) + call timemgr_restart() + end if + call t_stopf('init_io1') + + ! ------------------------------------------------------------------------ + ! Initialize CN Ecosystem Dynamics (must be after time-manager initialization) + ! ------------------------------------------------------------------------ + if (use_cn .or. use_cndv) then + call CNEcosystemDynInit( begc, endc, begp, endp ) + end if + + ! ------------------------------------------------------------------------ + ! Initialize accumulated fields + ! ------------------------------------------------------------------------ + + ! Initialize accumulator fields to be time accumulated for various purposes. + ! The time manager needs to be initialized before this called is made, since + ! the step size is needed. + + call t_startf('init_accflds') + call initAccFlds() + call t_stopf('init_accflds') + + ! ------------------------------------------------------------------------ + ! Set arbitrary initial conditions for time varying fields + ! used in coupled carbon-nitrogen code + ! ------------------------------------------------------------------------ + + if (use_cn) then + call t_startf('init_cninitim') + if (nsrest == nsrStartup) then + call CNiniTimeVar() + end if + call t_stopf('init_cninitim') + end if + + ! ------------------------------------------------------------------------ + ! Initialization of dynamic pft weights + ! ------------------------------------------------------------------------ + + ! Determine correct pft weights (interpolate pftdyn dataset if initial run) + ! Otherwise these are read in for a restart run + + if (use_cndv) then + call pftwt_init() + else + if (flanduse_timeseries /= ' ') then + call t_startf('init_pftdyn') + call pftdyn_init() + call pftdyn_interp( ) + call t_stopf('init_pftdyn') + end if + end if + + ! ------------------------------------------------------------------------ + ! Read restart/initial info + ! ------------------------------------------------------------------------ + + ! No weight related information can be contained in the routines, + ! "mkarbinit, inicfile and restFile". + + call t_startf('init_io2') + if (do_restread()) then + call UrbanInitTimeVar( ) + if (masterproc) write(iulog,*)'reading restart file ',fnamer + call restFile_read( fnamer ) + else if (nsrest == nsrStartup .and. finidat == ' ') then + call mkarbinit() + call UrbanInitTimeVar( ) + end if + call t_stopf('init_io2') + + ! ------------------------------------------------------------------------ + ! Initialize nitrogen deposition + ! ------------------------------------------------------------------------ + + if (use_cn) then + call t_startf('init_ndep') + call ndep_init() + call ndep_interp() + call t_stopf('init_ndep') + end if + + ! ------------------------------------------------------------------------ + ! Initialization of model parameterizations that are needed after + ! restart file is read in + ! ------------------------------------------------------------------------ + + ! ------------------------------------------------------------------------ + ! Initialize history and accumator buffers + ! ------------------------------------------------------------------------ + + call t_startf('init_hist1') + + ! Initialize active history fields. This is only done if not a restart run. + ! If a restart run, then this information has already been obtained from the + ! restart data read above. Note that routine hist_htapes_build needs time manager + ! information, so this call must be made after the restart information has been read. + + if (nsrest == nsrStartup .or. nsrest == nsrBranch) call hist_htapes_build() + + ! Initialize clmtype variables that are obtained from accumulated fields. + ! This routine is called in an initial run at nstep=0 + ! This routine is also always called for a restart run and must + ! therefore be called after the restart file is read in + + call initAccClmtype() + + call t_stopf('init_hist1') + + ! -------------------------------------------------------------- + ! Note - everything below this point needs updated weights + ! -------------------------------------------------------------- + + ! Initialize filters + + call t_startf('init_filters') + + call allocFilters() + nclumps = get_proc_clumps() +!$OMP PARALLEL DO PRIVATE (nc) + do nc = 1, nclumps + call setFilters(nc) + end do +!$OMP END PARALLEL DO + + call t_stopf('init_filters') + + ! Calculate urban "town" roughness length and displacement + ! height for urban landunits + + call UrbanInitAero() + + ! Initialize urban radiation model - this uses urbinp data structure + + call UrbanClumpInit() + + ! Finalize urban model initialization + + call UrbanInput(mode='finalize') + + ! + ! Even if CN is on, and dry-deposition is active, read CLMSP annual vegetation to get estimates of monthly LAI + ! + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + call readAnnualVegetation() + end if + + ! End initialization + + call t_startf('init_wlog') + if (masterproc) then + write(iulog,*) 'Successfully initialized the land model' + if (nsrest == nsrStartup) then + write(iulog,*) 'begin initial run at: ' + else + write(iulog,*) 'begin continuation run at:' + end if + call get_curr_date(yr, mon, day, ncsec) + write(iulog,*) ' nstep= ',get_nstep(), ' year= ',yr,' month= ',mon,& + ' day= ',day,' seconds= ',ncsec + write(iulog,*) + write(iulog,'(72a1)') ("*",i=1,60) + write(iulog,*) + endif + call t_stopf('init_wlog') + + if (get_nstep() == 0 .or. nsrest == nsrStartup) then + ! Initialize albedos (correct pft filters are needed) + + if (finidat == ' ' .or. do_initsurfalb) then + call t_startf('init_orb') + calday = get_curr_calday() + call t_startf('init_orbd1') + call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) + call t_stopf('init_orbd1') + + dtime = get_step_size() + caldaym1 = get_curr_calday(offset=-int(dtime)) + call t_startf('init_orbd2') + call shr_orb_decl( caldaym1, eccen, mvelpp, lambm0, obliqr, declinm1, eccf ) + call t_stopf('init_orbd2') + + call t_startf('init_orbSA') + call initSurfAlb( calday, declin, declinm1 ) + call t_stopf('init_orbSA') + call t_stopf('init_orb') + else if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + ! Call interpMonthlyVeg for dry-deposition so that mlaidiff will be calculated + ! This needs to be done even if CN or CNDV is on! + call interpMonthlyVeg() + end if + + ! Determine gridcell averaged properties to send to atm + + call t_startf('init_map2gc') + call clm_map2gcell_minimal() + call t_stopf('init_map2gc') + + end if + + ! Initialize sno export state + if (create_glacier_mec_landunit) then + call t_startf('init_create_s2x') + call update_clm_s2x(init=.true.) + call t_stopf('init_create_s2x') + end if + + call t_stopf('clm_init2') + + end subroutine initialize2 + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: header +! +! !INTERFACE: + subroutine header() +! +! !DESCRIPTION: +! Echo and save model version number +! +! !USES: + use clm_varctl , only : version +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize in this module +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! +!EOP +!----------------------------------------------------------------------- + + if ( masterproc )then + write(iulog,*) trim(version) + write(iulog,*) + end if + + end subroutine header + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: do_restread +! +! !INTERFACE: + logical function do_restread( ) +! +! !DESCRIPTION: +! Determine if restart file will be read +! +! !USES: + use clm_varctl, only : finidat +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + do_restread = .false. + if (nsrest == nsrStartup .and. finidat /= ' ') then + do_restread = .true. + end if + if (nsrest == nsrContinue .or. nsrest == nsrBranch) then + do_restread = .true. + end if + end function do_restread + +end module clm_initializeMod diff --git a/components/clm/src_clm40/main/clm_nlUtilsMod.F90 b/components/clm/src_clm40/main/clm_nlUtilsMod.F90 new file mode 100644 index 0000000000..68536bd1fb --- /dev/null +++ b/components/clm/src_clm40/main/clm_nlUtilsMod.F90 @@ -0,0 +1,116 @@ +module clm_nlUtilsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_nltUtilsMod +! +! !DESCRIPTION: +! Utilities to handle namelists. +! +! !USES: + +! !PUBLIC TYPES: + implicit none + save + + private ! By default everything is private + +! !PUBLIC MEMBER FUNCTIONS: + public :: find_nlgroup_name ! find a specified namelist group in a file +! +! !REVISION HISTORY: +! Created by B. Eaton +! Move to CLM by E. Kluzek +! +! !PRIVATE MEMBER FUNCTIONS: None +!----------------------------------------------------------------------- +! !PRIVATE DATA MEMBERS: None + +!EOP +!----------------------------------------------------------------------- +contains + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: find_nlgroup_name +! +! !INTERFACE: + subroutine find_nlgroup_name(unit, group, status) +! +! !DESCRIPTION: +! Search a file that contains namelist input for the specified namelist group name. +! Leave the file positioned so that the current record is the first record of the +! input for the specified group. +! +! METHOD: +! Read the file line by line. Each line is searched for an '&' which may only +! be preceded by blanks, immediately followed by the group name which is case +! insensitive. If found then backspace the file so the current record is the +! one containing the group name and return success. Otherwise return -1. +! +! !USES: + use shr_kind_mod , only : CS => shr_kind_cs + use shr_string_mod, only : shr_string_toLower +! +! !ARGUMENTS: + integer, intent(in) :: unit ! fortran unit attached to file + character(len=*), intent(in) :: group ! namelist group name + integer, intent(out) :: status ! 0 for success, -1 if group name not found +! +! !REVISION HISTORY: +! Created by B. Eaton, August 2007 +! Move to CLM E. Kluzek, August 2012 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: len_grp ! length of the groupname + integer :: ios ! io status + character(len=CS) :: inrec ! first shr_kind_CS characters of input record + character(len=CS) :: inrec2 ! left adjusted input record + character(len=len(group)) :: lc_group ! lower-case group name + character(len=32) :: subname = 'find_nlgroup_name' ! subroutine name +!----------------------------------------------------------------------- + len_grp = len_trim(group) + lc_group = shr_string_toLower(group) + + ios = 0 + do while (ios <= 0) + + read(unit, '(a)', iostat=ios, end=100) inrec + + if (ios <= 0) then ! ios < 0 indicates an end of record condition + + ! look for group name in this record + + ! remove leading blanks + inrec2 = adjustl(inrec) + + ! check for leading '&' + if (inrec2(1:1) == '&') then + + ! check for case insensitive group name + if (trim(lc_group) == shr_string_toLower(inrec2(2:len_grp+1))) then + + ! found group name. backspace to leave file position at this record + backspace(unit) + status = 0 + return + + end if + end if + end if + + end do + + 100 continue ! end of file processing + status = -1 + +end subroutine find_nlgroup_name + +!----------------------------------------------------------------------- + +end module clm_nlUtilsMod diff --git a/components/clm/src_clm40/main/clm_time_manager.F90 b/components/clm/src_clm40/main/clm_time_manager.F90 new file mode 100644 index 0000000000..3057294bc3 --- /dev/null +++ b/components/clm/src_clm40/main/clm_time_manager.F90 @@ -0,0 +1,1625 @@ +module clm_time_manager + + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_sys_mod , only: shr_sys_abort + use spmdMod , only: masterproc + use clm_varctl , only: iulog + use clm_varcon , only: isecspday + use ESMF + + implicit none + private + + ! 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_rad_step_size, &! return radiation step size in seconds + get_nstep, &! return timestep number + get_curr_date, &! return date components at end of current timestep + get_prev_date, &! return date components at beginning of current timestep + get_start_date, &! return components of the start date + get_driver_start_ymd, &! return year/month/day (as integer in YYYYMMDD format) of driver start date + get_ref_date, &! return components of the reference date + get_perp_date, &! return components of the perpetual date, and current time of day + get_curr_time, &! return components of elapsed time since reference date at end of current timestep + get_prev_time, &! return components of elapsed time since reference date at beg of current timestep + get_curr_calday, &! return calendar day at end of current timestep + get_calday, &! return calendar day from input date + get_calendar, &! return calendar + get_days_per_year, &! return the days per year for current year + get_curr_yearfrac, &! return the fractional position in the current year + get_rest_date, &! return the date from the restart file + set_nextsw_cday, &! set the next radiation calendar day + is_first_step, &! return true on first step of initial run + is_first_restart_step, &! return true on first step of restart or branch run + is_beg_curr_day, &! return true on first timestep in current day + is_end_curr_day, &! return true on last timestep in current day + is_end_curr_month, &! return true on last timestep in current month + is_last_step, &! return true on last timestep + is_perpetual, &! return true if perpetual calendar is in use + is_restart, &! return true if this is a restart run + update_rad_dtime ! track radiation interval via nstep + + ! Public parameter data + character(len=*), public, parameter :: NO_LEAP_C = 'NO_LEAP' + character(len=*), public, parameter :: GREGORIAN_C = 'GREGORIAN' + + ! Private module data + + ! Private data for input + + character(len=ESMF_MAXSTR), save ::& + calendar = NO_LEAP_C ! Calendar to use in date calculations. + integer, parameter :: uninit_int = -999999999 + real(r8), parameter :: uninit_r8 = -999999999.0 + + ! Input + integer, save ::& + dtime = uninit_int, &! timestep in seconds + dtime_rad = uninit_int, &! radiation interval in seconds + nstep_rad_prev = uninit_int ! radiation interval in seconds + + ! 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 + type(ESMF_Clock), save :: tm_clock ! model clock + type(ESMF_Time), save :: tm_perp_date ! perpetual date + + ! Data required to restart time manager: + integer, save :: rst_step_sec = uninit_int ! timestep size seconds + integer, save :: rst_start_ymd = uninit_int ! start date + integer, save :: rst_start_tod = uninit_int ! start time of day + integer, save :: rst_ref_ymd = uninit_int ! reference date + integer, save :: rst_ref_tod = uninit_int ! reference time of day + integer, save :: rst_curr_ymd = uninit_int ! current date + integer, save :: rst_curr_tod = uninit_int ! current time of day + + integer, save :: rst_nstep_rad_prev ! nstep of previous radiation call + integer, save :: perpetual_ymd = uninit_int ! Perpetual calendar date (YYYYMMDD) + 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 + ! + real(r8) :: nextsw_cday = uninit_r8 ! calday from clock of next radiation computation + + ! Private module methods + + private :: timemgr_spmdbcast + private :: init_calendar + private :: init_clock + private :: calc_nestep + private :: timemgr_print + private :: TimeGetymd + + !========================================================================================= +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 ) + + !--------------------------------------------------------------------------------- + ! 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) + ! + character(len=*), parameter :: sub = 'clm::set_timemgr_init' + + if ( timemgr_set ) call shr_sys_abort( sub//":: timemgr_init or timemgr_restart already called" ) + if (present(calendar_in) ) calendar = trim(calendar_in) + if (present(start_ymd_in) ) start_ymd = start_ymd_in + 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 + if ( .not. present(perpetual_ymd_in) .or. perpetual_ymd == uninit_int) & + call shr_sys_abort( sub//":: perpetual_run set but NOT perpetual_ymd" ) + 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 + + !========================================================================================= + + subroutine timemgr_init( ) + + !--------------------------------------------------------------------------------- + ! Initialize the ESMF time manager from the sync clock + ! + ! Arguments + ! + 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 + !--------------------------------------------------------------------------------- + call timemgr_spmdbcast( ) + + ! Initalize calendar + + call init_calendar() + + ! Initalize start date. + + if ( start_ymd == uninit_int ) then + write(iulog,*)sub,': start_ymd must be specified ' + call shr_sys_abort + end if + if ( start_tod == uninit_int ) then + write(iulog,*)sub,': start_tod must be specified ' + call shr_sys_abort + end if + start_date = TimeSetymd( start_ymd, start_tod, "start_date" ) + + ! Initialize current date + + 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 + ref_date = TimeSetymd( ref_ymd, ref_tod, "ref_date" ) + else + ref_date = start_date + end if + + ! Initialize clock + + call init_clock( start_date, ref_date, curr_date, stop_date ) + + ! Initialize date used for perpetual calendar day calculation. + + if (tm_perp_calendar) then + tm_perp_date = TimeSetymd( perpetual_ymd, 0, "tm_perp_date" ) + end if + + ! Print configuration summary to log file (stdout). + + if (masterproc) call timemgr_print() + + timemgr_set = .true. + + end subroutine timemgr_init + + !========================================================================================= + + subroutine init_clock( start_date, ref_date, curr_date, stop_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 + ! + 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_TimeInterval) :: step_size ! timestep size + type(ESMF_Time) :: current ! current date (from clock) + 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') + + ! Initialize the clock + + tm_clock = ESMF_ClockCreate(name="CLM Time-manager clock", timeStep=step_size, startTime=start_date, & + stopTime=stop_date, refTime=ref_date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockSetup') + + ! Advance clock to the current time (in case of a restart) + + call ESMF_ClockGet(tm_clock, currTime=current, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + do while( curr_date > current ) + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + call ESMF_ClockGet(tm_clock, currTime=current ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + end do + end subroutine init_clock + + !========================================================================================= + + function TimeSetymd( ymd, tod, desc ) + !--------------------------------------------------------------------------------- + ! + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + ! + integer, intent(in) :: ymd ! Year, month, day YYYYMMDD + integer, intent(in) :: tod ! Time of day in seconds + character(len=*), intent(in) :: desc ! Description of time to set + + type(ESMF_Time) :: TimeSetymd ! Return value + + character(len=*), parameter :: sub = 'clm::TimeSetymd' + integer :: yr, mon, day ! Year, month, day as integers + integer :: rc ! return code + !--------------------------------------------------------------------------------- + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > isecspday) )then + write(iulog,*) sub//': error yymmdd is a negative number or time-of-day out of bounds', & + ymd, tod + call shr_sys_abort + end if + yr = ymd / 10000 + mon = (ymd - yr*10000) / 100 + day = ymd - yr*10000 - mon*100 + call ESMF_TimeSet( TimeSetymd, yy=yr, mm=mon, dd=day, s=tod, & + calendar=tm_cal, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeSet: setting '//trim(desc)) + end function TimeSetymd + + !========================================================================================= + + integer function TimeGetymd( date, tod ) + ! + ! Get the date and time of day in ymd from ESMF Time. + ! + type(ESMF_Time), intent(inout) :: date ! Input date to convert to ymd + integer, intent(out), optional :: tod ! Time of day in seconds + + character(len=*), parameter :: sub = 'clm::TimeGetymd' + integer :: yr, mon, day + integer :: rc ! return code + + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + TimeGetymd = yr*10000 + mon*100 + day + if ( present( tod ) )then + call ESMF_TimeGet( date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + end if + if ( yr < 0 )then + write(iulog,*) sub//': error year is less than zero', yr + call shr_sys_abort + end if + end function TimeGetymd + + !========================================================================================= + + subroutine timemgr_restart_io( ncid, flag ) + + !--------------------------------------------------------------------------------- + ! Read/Write information needed on restart to a netcdf file. + use ncdio_pio, only: ncd_int + use pio, only: var_desc_t, file_desc_t + use restUtilMod + ! + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf id + character(len=*), intent(in) :: flag ! 'read' or 'write' + ! + ! Local variables + character(len=*), parameter :: sub = 'clm::timemgr_restart' + integer :: rc ! return code + logical :: readvar ! determine if variable is on initial file + 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 + integer :: rst_caltype ! calendar type + integer, parameter :: noleap = 1 + integer, parameter :: gregorian = 2 + character(len=len(calendar)) :: cal + !--------------------------------------------------------------------------------- + + if (flag == 'write') then + rst_nstep_rad_prev = nstep_rad_prev + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_nstep_rad_prev', xtype=ncd_int, & + long_name='previous_radiation_nstep', units='unitless positive integer', & + ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_nstep_rad_prev) + if (flag == 'read') then + nstep_rad_prev = rst_nstep_rad_prev + end if + + if (flag == 'write') then + cal = to_upper(calendar) + if ( trim(cal) == NO_LEAP_C ) then + rst_caltype = noleap + else if ( trim(cal) == GREGORIAN_C ) then + rst_caltype = gregorian + else + call shr_sys_abort(sub//'ERROR: unrecognized calendar specified= '//trim(calendar)) + end if + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_type', xtype=ncd_int, & + long_name='calendar type', units='unitless', flag_meanings=(/ "NO_LEAP_C", "GREGORIAN" /), & + flag_values=(/ noleap, gregorian /), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_caltype) + if (flag == 'read') then + if ( rst_caltype == noleap ) then + calendar = NO_LEAP_C + else if ( rst_caltype == gregorian ) then + calendar = GREGORIAN_C + else + write(iulog,*)sub,': unrecognized calendar type in restart file: ',rst_caltype + call shr_sys_abort( sub//'ERROR: bad calendar type in restart file') + end if + end if + + if (flag == 'write') then + call ESMF_ClockGet( tm_clock, startTime=start_date, currTime=curr_date, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + rst_step_sec = dtime + rst_start_ymd = TimeGetymd( start_date, tod=rst_start_tod ) + rst_ref_ymd = TimeGetymd( ref_date, tod=rst_ref_tod ) + rst_curr_ymd = TimeGetymd( curr_date, tod=rst_curr_tod ) + end if + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_step_sec', xtype=ncd_int, & + long_name='seconds component of timestep size', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_step_sec) + if ((flag == 'read') .and. ( rst_step_sec < 0 .or. rst_step_sec > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_step_sec out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_start_ymd', xtype=ncd_int, & + long_name='start date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_start_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_start_tod', xtype=ncd_int, & + long_name='start time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_start_tod) + if ((flag == 'read') .and. ( rst_start_tod < 0 .or. rst_start_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_strart_tod out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_ref_ymd', xtype=ncd_int, & + long_name='reference date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_ref_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_ref_tod', xtype=ncd_int, & + long_name='reference time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_ref_tod) + if ((flag == 'read') .and. ( rst_start_tod < 0 .or. rst_start_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_ref_tod out of range') + end if + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_curr_ymd', xtype=ncd_int, & + long_name='current date', units='YYYYMMDD', ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_curr_ymd) + + call restartvar(ncid=ncid, flag=flag, varname='timemgr_rst_curr_tod', xtype=ncd_int, & + long_name='current time of day', units='sec', & + nvalid_range=(/0,isecspday/), ifill_value=uninit_int, & + interpinic_flag='skip', readvar=readvar, data=rst_curr_tod) + if ((flag == 'read') .and. ( rst_curr_tod < 0 .or. rst_curr_tod > isecspday )) then + call shr_sys_abort( sub//'ERROR: timemgr_rst_ref_ymd out of range') + end if + + end subroutine timemgr_restart_io + + !========================================================================================= + + subroutine timemgr_restart( ) + + !--------------------------------------------------------------------------------- + ! Restart the ESMF time manager using the synclock for ending date. + ! + character(len=*), parameter :: sub = 'clm::timemgr_restart' + 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) :: 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( ) + + ! Initialize calendar from restart info + + call init_calendar() + + ! Initialize the timestep from restart info + + dtime = rst_step_sec + + ! Initialize start date from restart info + + start_date = TimeSetymd( rst_start_ymd, rst_start_tod, "start_date" ) + + ! Initialize current date from restart info + + 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 + + ! Initialize ref date from restart info + + ref_date = TimeSetymd( rst_ref_ymd, rst_ref_tod, "ref_date" ) + + ! Initialize clock + + call init_clock( start_date, ref_date, curr_date, stop_date ) + + ! Advance the timestep. + ! Data from the restart file corresponds to the last timestep of the previous run. + + call advance_timestep() + + ! Set flag that this is the first timestep of the restart run. + + tm_first_restart_step = .true. + + ! Calculate ending time step + + call calc_nestep( ) + + ! Print configuration summary to log file (stdout). + + if (masterproc) call timemgr_print() + + timemgr_set = .true. + + 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( ) + + !--------------------------------------------------------------------------------- + ! Initialize calendar + ! + ! Local variables + ! + character(len=*), parameter :: sub = 'clm::init_calendar' + type(ESMF_CalKind_Flag) :: cal_type ! calendar type + character(len=len(calendar)) :: caltmp + integer :: rc ! return code + !--------------------------------------------------------------------------------- + + caltmp = to_upper(calendar) + if ( trim(caltmp) == NO_LEAP_C ) then + cal_type = ESMF_CALKIND_NOLEAP + else if ( trim(caltmp) == GREGORIAN_C ) then + cal_type = ESMF_CALKIND_GREGORIAN + else + write(iulog,*)sub,': unrecognized calendar specified: ',calendar + call shr_sys_abort + end if + tm_cal = ESMF_CalendarCreate( name=caltmp, calkindflag=cal_type, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_CalendarSet') + end subroutine init_calendar + + !========================================================================================= + + subroutine timemgr_print() + + !--------------------------------------------------------------------------------- + character(len=*), parameter :: sub = 'clm::timemgr_print' + integer :: rc + integer :: yr, mon, day + integer :: & ! Data required to restart time manager: + nstep = uninit_int, &! current step number + step_sec = uninit_int, &! timestep size seconds + start_yr = uninit_int, &! start year + 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 + ref_tod = uninit_int, &! reference time of day + curr_yr = uninit_int, &! current year + curr_mon = uninit_int, &! current month + curr_day = uninit_int, &! current day of month + 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, & + advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + + write(iulog,*)' ******** CLM Time Manager Configuration ********' + + call ESMF_TimeIntervalGet( step, s=step_sec, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + 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') + call ESMF_TimeGet( curr_date, yy=curr_yr, mm=curr_mon, dd=curr_day, & + s=curr_tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + write(iulog,*)' Calendar type: ',trim(calendar) + 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 + + if ( tm_perp_calendar ) then + call ESMF_TimeGet( tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + write(iulog,*)' Use perpetual diurnal cycle date (yr mon day): ', & + yr, mon, day + end if + + write(iulog,*)' ************************************************' + + end subroutine timemgr_print + + !========================================================================================= + + subroutine advance_timestep() + + ! Increment the timestep number. + + character(len=*), parameter :: sub = 'clm::advance_timestep' + integer :: rc + + call ESMF_ClockAdvance( tm_clock, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockAdvance') + + tm_first_restart_step = .false. + + 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 + + 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 + + type(ESMF_Time) :: get_curr_ESMF_Time + character(len=*), parameter :: sub = 'clm::get_curr_ESMF_Time' + integer :: rc + + call ESMF_ClockGet( tm_clock, currTime=get_curr_ESMF_Time, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + end function get_curr_ESMF_Time + + !========================================================================================= + + integer function get_step_size() + + ! Return the step size in seconds. + + character(len=*), parameter :: sub = 'clm::get_step_size' + type(ESMF_TimeInterval) :: step_size ! timestep size + integer :: rc + + call ESMF_ClockGet(tm_clock, timeStep=step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeIntervalGet(step_size, s=get_step_size, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockTimeIntervalGet') + + end function get_step_size + + !========================================================================================= + + subroutine update_rad_dtime(doalb) + !--------------------------------------------------------------------------------- + ! called only on doalb timesteps to save off radiation nsteps + ! + ! Local Arguments + logical,intent(in) :: doalb + integer :: dtime,nstep + + if (doalb) then + + dtime=get_step_size() + nstep = get_nstep() + + if (nstep_rad_prev == uninit_int ) then + dtime_rad = dtime + nstep_rad_prev = nstep + else + dtime_rad = (nstep - nstep_rad_prev) * dtime + nstep_rad_prev = nstep + endif + end if + end subroutine update_rad_dtime + + !========================================================================================= + + integer function get_rad_step_size() + + if (nstep_rad_prev == uninit_int ) then + get_rad_step_size=get_step_size() + else + get_rad_step_size=dtime_rad + end if + + end function get_rad_step_size + + !========================================================================================= + + integer function get_nstep() + + ! Return the timestep number. + + character(len=*), parameter :: sub = 'clm::get_nstep' + integer :: rc + integer(ESMF_KIND_I8) :: step_no + + call ESMF_ClockGet(tm_clock, advanceCount=step_no, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + get_nstep = step_no + + end function get_nstep + + !========================================================================================= + + subroutine get_curr_date(yr, mon, day, tod, offset) + + !----------------------------------------------------------------------------------------- + ! Return date components valid at end of current timestep with an optional + ! offset (positive or negative) in seconds. + + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_curr_date + + !========================================================================================= + + subroutine get_perp_date(yr, mon, day, tod, offset) + + !----------------------------------------------------------------------------------------- + ! Return time of day valid at end of current timestep and the components + ! of the perpetual date (with an optional offset (positive or negative) in seconds. + + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_perp_date' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: DelTime + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + ! Get time of day add it to perpetual date + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet(DelTime, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + DelTime + if ( present(offset) )then + call ESMF_TimeIntervalSet(DelTime, s=offset, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + DelTime + end if + ! Get time of day from the result + ! Get year, month, day so that seconds are time-of-day rather than since start time + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + + ! Get the date from the fixed perpetual date (in case it overflows to next day) + call ESMF_TimeGet(tm_perp_date, yy=yr, mm=mon, dd=day, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_perp_date + + !========================================================================================= + + subroutine get_prev_date(yr, mon, day, tod) + + ! Return date components valid at beginning of current timestep. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_prev_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_prev_date + + !========================================================================================= + + subroutine get_start_date(yr, mon, day, tod) + + ! Return date components valid at beginning of initial run. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_start_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, startTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_start_date + + !========================================================================================= + + integer function get_driver_start_ymd( tod ) + + ! Return date of start of simulation from driver (i.e. NOT from restart file) + ! Note: get_start_date gets you the date from the beginning of the simulation + ! on the restart file. + + ! Arguments + integer, optional, intent(out) ::& + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_driver_start_ymd' + !----------------------------------------------------------------------------------------- + + if ( start_ymd == uninit_int )then + call shr_sys_abort( sub//': error driver start date is NOT set yet' ) + end if + if ( start_ymd < 101 .or. start_ymd > 99991231 )then + call shr_sys_abort( sub//': error driver start date is invalid' ) + end if + if ( present(tod) )then + tod = start_tod + if ( (tod < 0) .or. (tod > isecspday) )then + call shr_sys_abort( sub//': error driver start tod is invalid' ) + end if + end if + get_driver_start_ymd = start_ymd + + end function get_driver_start_ymd + + !========================================================================================= + + subroutine get_ref_date(yr, mon, day, tod) + + ! Return date components of the reference date. + + ! Arguments + integer, intent(out) ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_ref_date' + integer :: rc + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, refTime=date, rc=rc) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_TimeGet(date, yy=yr, mm=mon, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end subroutine get_ref_date + + !========================================================================================= + + subroutine get_curr_time(days, seconds) + + ! Return time components valid at end of current timestep. + ! Current time is the time interval between the current date and the reference date. + + ! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_curr_time' + integer :: rc + type(ESMF_Time) :: cdate, rdate + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=cdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + call ESMF_ClockGet( tm_clock, refTime=rdate, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + diff = cdate - rdate + + call ESMF_TimeIntervalGet(diff, d=days, s=seconds, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + + end subroutine get_curr_time + + !========================================================================================= + + subroutine get_prev_time(days, seconds) + + ! Return time components valid at beg of current timestep. + ! prev time is the time interval between the prev date and the reference date. + + ! Arguments + integer, intent(out) ::& + days, &! number of whole days in time interval + seconds ! remaining seconds in time interval + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_prev_time' + integer :: rc + type(ESMF_Time) :: date, ref_date + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet(tm_clock, prevTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for prevTime') + call ESMF_ClockGet(tm_clock, refTime=ref_date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet for refTime') + diff = date - ref_date + call ESMF_TimeIntervalGet( diff, d=days, s=seconds, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeintervalGet') + + end subroutine get_prev_time + + !========================================================================================= + + function get_curr_calday(offset) + + ! Return calendar day at end of current timestep with optional offset. + ! Calendar day 1.0 = 0Z on Jan 1. + + ! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + ! Return value + real(r8) :: get_curr_calday + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_curr_calday' + integer :: rc + type(ESMF_Time) :: date + type(ESMF_TimeInterval) :: off, diurnal + integer :: year, month, day, tod + !----------------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, currTime=date, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + + if (present(offset)) then + if (offset > 0) then + call ESMF_TimeIntervalSet( off, s=offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date + off + else if (offset < 0) then + call ESMF_TimeIntervalSet( off, s=-offset, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = date - off + end if + end if + + if ( tm_perp_calendar ) then + call ESMF_TimeGet(date, yy=year, mm=month, dd=day, s=tod, rc=rc) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + call ESMF_TimeIntervalSet( diurnal, s=tod, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalSet') + date = tm_perp_date + diurnal + end if + + call ESMF_TimeGet( date, dayOfYear_r8=get_curr_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + !----------------------------------------------------------------------------------------! + !!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! + !!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! + !!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! + !!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( (get_curr_calday > 366.0) .and. (get_curr_calday <= 367.0) .and. & + (trim(calendar) == GREGORIAN_C) )then + get_curr_calday = get_curr_calday - 1.0_r8 + end if + !!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------------------------! + if ( (get_curr_calday < 1.0) .or. (get_curr_calday > 366.0) )then + write(iulog,*) sub, ' = ', get_curr_calday + if ( present(offset) ) write(iulog,*) 'offset = ', offset + call shr_sys_abort( sub//': error get_curr_calday out of bounds' ) + end if + + end function get_curr_calday + + !========================================================================================= + + function get_calday(ymd, tod) + + ! Return calendar day corresponding to specified time instant. + ! Calendar day 1.0 = 0Z on Jan 1. + + ! Arguments + integer, intent(in) :: & + ymd, &! date in yearmmdd format + tod ! time of day (seconds past 0Z) + + ! Return value + real(r8) :: get_calday + + ! Local variables + character(len=*), parameter :: sub = 'clm::get_calday' + integer :: rc ! return code + type(ESMF_Time) :: date + !----------------------------------------------------------------------------------------- + + date = TimeSetymd( ymd, tod, "get_calday" ) + call ESMF_TimeGet( date, dayOfYear_r8=get_calday, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + !----------------------------------------------------------------------------------------! +!!!!!!!!!!!!!! WARNING HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!! +!!!! The following hack fakes day 366 by reusing day 365. This is just because the !!!!!! +!!!! current shr_orb_decl calculation can't handle days > 366. !!!!!! +!!!! Dani Bundy-Coleman and Erik Kluzek Aug/2008 !!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if ( (get_calday > 366.0) .and. (get_calday <= 367.0) .and. & + (trim(calendar) == GREGORIAN_C) )then + get_calday = get_calday - 1.0_r8 + end if +!!!!!!!!!!!!!! END HACK TO ENABLE Gregorian CALENDAR WITH SHR_ORB !!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------------------------! + if ( (get_calday < 1.0) .or. (get_calday > 366.0) )then + write(iulog,*) sub, ' = ', get_calday + call shr_sys_abort( sub//': error calday out of range' ) + end if + + end function get_calday + + !========================================================================================= + + function get_calendar() + + ! Return calendar + + ! Return value + character(len=ESMF_MAXSTR) :: get_calendar + + get_calendar = calendar + + end function get_calendar + + !========================================================================================= + + integer function get_days_per_year( offset ) + + !--------------------------------------------------------------------------------- + ! Get the number of days per year for currrent year + + ! + ! Arguments + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_days_per_year' + integer :: yr, mon, day, tod ! current date year, month, day and time-of-day + type(ESMF_Time) :: eDate ! ESMF date + integer :: rc ! ESMF return code + !--------------------------------------------------------------------------------- + + if ( present(offset) )then + call get_curr_date(yr, mon, day, tod, offset ) + else + call get_curr_date(yr, mon, day, tod ) + end if + eDate = TimeSetymd( ymd=yr*10000+1231, tod=0, desc="end of year" ) + call ESMF_TimeGet( eDate, dayOfYear=get_days_per_year, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeGet') + + end function get_days_per_year + + !========================================================================================= + + function get_curr_yearfrac( offset ) + + !--------------------------------------------------------------------------------- + ! Get the fractional position in the current year. This is 0 at midnight on Jan 1, + ! and 1 at the end of Dec 31. + + ! + ! Arguments + real(r8) :: get_curr_yearfrac ! function result + + integer, optional, intent(in) :: offset ! Offset from current time in seconds. + ! Positive for future times, negative + ! for previous times. + + character(len=*), parameter :: sub = 'clm::get_curr_yearfrac' + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: days_per_year ! days per year + + cday = get_curr_calday(offset=offset) + days_per_year = get_days_per_year() + + get_curr_yearfrac = (cday - 1._r8)/days_per_year + + end function get_curr_yearfrac + + !========================================================================================= + + subroutine get_rest_date(ncid, yr) + + !--------------------------------------------------------------------------------- + ! Get the date from the restart file. + ! + ! Currently just returns the year (because the month & day are harder to extract, and + ! currently aren't needed). + use pio, only: file_desc_t + use ncdio_pio, only: ncd_io + ! + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf id for the restart file + integer , intent(out) :: yr ! year from restart file + + integer :: ymd ! yyyymmdd from the restart file + logical :: readvar ! whether the variable was read from the file + + integer, parameter :: year_mask = 10000 ! divide by this to get year from ymd + + character(len=*), parameter :: subname = 'get_rest_date' + !----------------------------------------------------------------------- + + ! Get the date (yyyymmdd) from restart file. + ! Note that we cannot simply use the rst_curr_ymd module variable, because that isn't + ! set under some circumstances + call ncd_io(varname='timemgr_rst_curr_ymd', data=ymd, & + ncid=ncid, flag='read', readvar=readvar) + if (.not. readvar) then + call shr_sys_abort(subname//' ERROR: timemgr_rst_curr_ymd not found on restart file') + end if + + ! Extract the year + yr = ymd / year_mask + end subroutine get_rest_date + + !========================================================================================= + + subroutine set_nextsw_cday( nextsw_cday_in ) + + ! Set the next radiation calendar day, so that radiation step can be calculated + ! + ! Arguments + real(r8), intent(IN) :: nextsw_cday_in ! input calday of next radiation computation + + character(len=*), parameter :: sub = 'clm::set_nextsw_cday' + + nextsw_cday = nextsw_cday_in + + end subroutine set_nextsw_cday + + !========================================================================================= + + function is_beg_curr_day() + + ! Return true if current timestep is first timestep in current day. + + ! Return value + logical :: is_beg_curr_day + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + + call get_curr_date(yr, mon, day, tod) + is_beg_curr_day = ( tod == dtime ) + + end function is_beg_curr_day + + !========================================================================================= + + function is_end_curr_day() + + !--------------------------------------------------------------------------------- + ! Return true if current timestep is last timestep in current day. + + ! Return value + logical :: is_end_curr_day + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + !--------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_day = (tod == 0) + + end function is_end_curr_day + + !========================================================================================= + + logical function is_end_curr_month() + + !--------------------------------------------------------------------------------- + ! Return true if current timestep is last timestep in current month. + + ! Local variables + integer ::& + yr, &! year + mon, &! month + day, &! day of month + tod ! time of day (seconds past 0Z) + !--------------------------------------------------------------------------------- + + call get_curr_date(yr, mon, day, tod) + is_end_curr_month = (day == 1 .and. tod == 0) + + end function is_end_curr_month + + !========================================================================================= + + logical function is_first_step() + + !--------------------------------------------------------------------------------- + ! Return true on first step of initial run only. + + ! Local variables + character(len=*), parameter :: sub = 'clm::is_first_step' + integer :: rc + integer :: nstep + integer(ESMF_KIND_I8) :: step_no + !--------------------------------------------------------------------------------- + + call ESMF_ClockGet( tm_clock, advanceCount=step_no, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_ClockGet') + nstep = step_no + is_first_step = (nstep == 0) + + end function is_first_step + !========================================================================================= + + logical function is_first_restart_step() + + ! Return true on first step of restart run only. + + is_first_restart_step = tm_first_restart_step + + end function is_first_restart_step + + !========================================================================================= + + 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 + !--------------------------------------------------------------------------------- + + 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. + + is_perpetual = tm_perp_calendar + + end function is_perpetual + + !========================================================================================= + + subroutine timemgr_datediff(ymd1, tod1, ymd2, tod2, days) + + ! Calculate the difference (ymd2,tod2) - (ymd1,tod1) and return the result in days. + ! Arguments + integer, intent(in) ::& + ymd1, &! date1 in yyyymmdd format + tod1, &! time of day relative to date1 (seconds past 0Z) + ymd2, &! date2 in yyyymmdd format + tod2 ! time of day relative to date2 (seconds past 0Z) + + real(r8) :: days ! (ymd2,tod2)-(ymd1,tod1) in days + + ! Local variables + character(len=*), parameter :: sub = 'clm::timemgr_datediff' + integer :: rc ! return code + + type(ESMF_Time) :: date1 + type(ESMF_Time) :: date2 + type(ESMF_TimeInterval) :: diff + !----------------------------------------------------------------------------------------- + + date1 = TimeSetymd( ymd1, tod1, "date1" ) + date2 = TimeSetymd( ymd2, tod2, "date2" ) + diff = date2 - date1 + call ESMF_TimeIntervalGet( diff, d_r8=days, rc=rc ) + call chkrc(rc, sub//': error return from ESMF_TimeIntervalGet') + days = days + 1.0_r8 + + end subroutine timemgr_datediff + + !========================================================================================= + + subroutine chkrc(rc, mes) + integer, intent(in) :: rc ! return code from time management library + character(len=*), intent(in) :: mes ! error message + if ( rc == ESMF_SUCCESS ) return + write(iulog,*) mes + call shr_sys_abort ('CHKRC') + end subroutine chkrc + + !========================================================================================= + + function to_upper(str) + + !--------------------------------------------------------------------------------- + ! Convert character string to upper case. Use achar and iachar intrinsics + ! to ensure use of ascii collating sequence. + ! + ! !INPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to upper case + ! !RETURN VALUE: + character(len=len(str)) :: to_upper + ! !LOCAL VARIABLES: + integer :: i ! Index + integer :: aseq ! ascii collating sequence + character(len=1) :: ctmp ! Character temporary + !--------------------------------------------------------------------------------- + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= 97 .and. aseq <= 122 ) ctmp = achar(aseq - 32) + to_upper(i:i) = ctmp + end do + + end function to_upper + + !========================================================================================= + + logical function is_restart( ) + ! Determine if restart run + use clm_varctl, only : nsrest, nsrContinue + if (nsrest == nsrContinue) then + is_restart = .true. + else + is_restart = .false. + end if + end function is_restart + + !========================================================================================= + + subroutine timemgr_spmdbcast( ) + + use spmdMod, only : mpicom, MPI_INTEGER + + integer :: ier + + call mpi_bcast (dtime , 1, MPI_INTEGER , 0, mpicom, ier) + + end subroutine timemgr_spmdbcast + +end module clm_time_manager diff --git a/components/clm/src_clm40/main/clm_varcon.F90 b/components/clm/src_clm40/main/clm_varcon.F90 new file mode 100644 index 0000000000..b3b076ac5c --- /dev/null +++ b/components/clm/src_clm40/main/clm_varcon.F90 @@ -0,0 +1,167 @@ +module clm_varcon + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varcon +! +! !DESCRIPTION: +! Module containing various model constants +! +! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_G,SHR_CONST_STEBOL,SHR_CONST_KARMAN, & + SHR_CONST_RWV,SHR_CONST_RDAIR,SHR_CONST_CPFW, & + SHR_CONST_CPICE,SHR_CONST_CPDAIR,SHR_CONST_LATVAP, & + SHR_CONST_LATSUB,SHR_CONST_LATICE,SHR_CONST_RHOFW, & + SHR_CONST_RHOICE,SHR_CONST_TKFRZ,SHR_CONST_REARTH, & + SHR_CONST_PDB, SHR_CONST_PI, SHR_CONST_CDAY, & + SHR_CONST_RGAS + use clm_varpar , only: numrad, nlevgrnd, nlevlak +! +! !PUBLIC TYPES: + implicit none + save +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 27 February 2008: Keith Oleson; Add forcing height and aerodynamic parameters +! +!EOP +!----------------------------------------------------------------------- + + !------------------------------------------------------------------ + ! Initialize mathmatical constants + !------------------------------------------------------------------ + + real(r8) :: rpi = SHR_CONST_PI + + !------------------------------------------------------------------ + ! Initialize physical constants + !------------------------------------------------------------------ + + real(r8) :: grav = SHR_CONST_G !gravity constant [m/s2] + real(r8) :: sb = SHR_CONST_STEBOL !stefan-boltzmann constant [W/m2/K4] + real(r8) :: vkc = SHR_CONST_KARMAN !von Karman constant [-] + real(r8) :: rwat = SHR_CONST_RWV !gas constant for water vapor [J/(kg K)] + real(r8) :: rair = SHR_CONST_RDAIR !gas constant for dry air [J/kg/K] + real(r8) :: roverg = SHR_CONST_RWV/SHR_CONST_G*1000._r8 !Rw/g constant = (8.3144/0.018)/(9.80616)*1000. mm/K + real(r8) :: cpliq = SHR_CONST_CPFW !Specific heat of water [J/kg-K] + real(r8) :: cpice = SHR_CONST_CPICE !Specific heat of ice [J/kg-K] + real(r8) :: cpair = SHR_CONST_CPDAIR !specific heat of dry air [J/kg/K] + real(r8) :: hvap = SHR_CONST_LATVAP !Latent heat of evap for water [J/kg] + real(r8) :: hsub = SHR_CONST_LATSUB !Latent heat of sublimation [J/kg] + real(r8) :: hfus = SHR_CONST_LATICE !Latent heat of fusion for ice [J/kg] + real(r8) :: denh2o = SHR_CONST_RHOFW !density of liquid water [kg/m3] + real(r8) :: denice = SHR_CONST_RHOICE !density of ice [kg/m3] + real(r8) :: rgas = SHR_CONST_RGAS !universal gas constant [J/K/kmole] + real(r8) :: tkair = 0.023_r8 !thermal conductivity of air [W/m/K] + real(r8) :: tkice = 2.290_r8 !thermal conductivity of ice [W/m/K] + real(r8) :: tkwat = 0.6_r8 !thermal conductivity of water [W/m/K] + real(r8) :: tfrz = SHR_CONST_TKFRZ !freezing temperature [K] + real(r8) :: tcrit = 2.5_r8 !critical temperature to determine rain or snow + real(r8) :: o2_molar_const = 0.209_r8 !constant atmospheric O2 molar ratio (mol/mol) + + real(r8) :: bdsno = 250._r8 !bulk density snow (kg/m**3) + real(r8) :: alpha_aero = 1.0_r8 !constant for aerodynamic parameter weighting + real(r8) :: tlsai_crit = 2.0_r8 !critical value of elai+esai for which aerodynamic parameters are maximum + real(r8) :: watmin = 0.01_r8 !minimum soil moisture (mm) + + real(r8) :: re = SHR_CONST_REARTH*0.001_r8 !radius of earth (km) + + real(r8), public, parameter :: degpsec = 15._r8/3600.0_r8 ! Degree's earth rotates per second + + real(r8), public, parameter :: secspday= SHR_CONST_CDAY ! Seconds per day + integer, public, parameter :: isecspday= secspday ! Integer seconds per day + real(r8), public, parameter :: spval = 1.e36_r8 ! special value for real data + integer , public, parameter :: ispval = -9999 ! special value for int data + + ! These are tunable constants from clm2_3 + + real(r8) :: zlnd = 0.01_r8 !Roughness length for soil [m] + real(r8) :: zsno = 0.0024_r8 !Roughness length for snow [m] + real(r8) :: csoilc = 0.004_r8 !Drag coefficient for soil under canopy [-] + real(r8) :: capr = 0.34_r8 !Tuning factor to turn first layer T into surface T + real(r8) :: cnfac = 0.5_r8 !Crank Nicholson factor between 0 and 1 + real(r8) :: ssi = 0.033_r8 !Irreducible water saturation of snow + real(r8) :: wimp = 0.05_r8 !Water impremeable if porosity less than wimp + real(r8) :: pondmx = 10.0_r8 !Ponding depth (mm) + real(r8) :: pondmx_urban = 1.0_r8 !Ponding depth for urban roof and impervious road (mm) + ! 4/14/05: PET + ! Adding isotope code + real(r8), parameter :: preind_atm_del13c = -6.0 ! preindustrial value for atmospheric del13C + real(r8), parameter :: preind_atm_ratio = SHR_CONST_PDB + (preind_atm_del13c * SHR_CONST_PDB)/1000.0 ! 13C/12C + real(r8) :: c13ratio = preind_atm_ratio/(1.0+preind_atm_ratio) ! 13C/(12+13)C preind atmosphere + + real(r8), parameter :: ht_efficiency_factor = 0.75_r8 !efficiency factor for urban heating (-) + real(r8), parameter :: ac_efficiency_factor = 0.25_r8 !efficiency factor for urban air conditioning (-) + real(r8) :: ht_wasteheat_factor = 1.0_r8/ht_efficiency_factor !wasteheat factor for urban heating (-) + real(r8) :: ac_wasteheat_factor = 1.0_r8/ac_efficiency_factor !wasteheat factor for urban air conditioning (-) + real(r8) :: wasteheat_limit = 100._r8 !limit on wasteheat (W/m2) + + real(r8), parameter :: h2osno_max = 1000._r8 ! max allowed snow thickness (mm H2O) + real(r8), parameter :: lapse_glcmec = 0.006_r8 ! surface temperature lapse rate (deg m-1) + ! Pritchard et al. (GRL, 35, 2008) use 0.006 + + !------------------------------------------------------------------ + ! Initialize water type constants + !------------------------------------------------------------------ + + ! "land unit " types + ! 1 soil (includes vegetated landunits) + ! 2 land ice (glacier) + ! 3 deep lake + ! 4 shallow lake + ! 5 wetland (swamp, marsh, etc.) + ! 6 urban + ! 7 land ice (glacier) with multiple elevation classes + ! 8 crop + + integer :: istsoil = 1 !soil landunit type + integer :: istice = 2 !land ice landunit type + integer :: istdlak = 3 !deep lake landunit type + integer :: istslak = 4 !shallow lake landunit type + integer :: istwet = 5 !wetland landunit type + integer :: isturb = 6 !urban landunit type + integer :: istice_mec = 7 !land ice (multiple elevation classes) landunit type + integer :: istcrop = 8 !crop landunit type + integer :: max_lunit = 8 !maximum value that lun%itype can have + !(i.e., largest value in the above list) + + ! urban column types + + integer :: icol_roof = 61 + integer :: icol_sunwall = 62 + integer :: icol_shadewall = 63 + integer :: icol_road_imperv = 64 + integer :: icol_road_perv = 65 + + !------------------------------------------------------------------ + ! Initialize miscellaneous radiation constants + !------------------------------------------------------------------ + + integer, private :: i ! loop index + + real(r8), allocatable :: albsat(:,:) ! wet soil albedo by color class and waveband (1=vis,2=nir) + real(r8), allocatable :: albdry(:,:) ! dry soil albedo by color class and waveband (1=vis,2=nir) + + real(r8) :: alblak(numrad) ! albedo frozen lakes by waveband (1=vis, 2=nir) + data (alblak(i),i=1,numrad) /0.60_r8, 0.40_r8/ + + real(r8) :: betads = 0.5_r8 ! two-stream parameter betad for snow + real(r8) :: betais = 0.5_r8 ! two-stream parameter betai for snow + real(r8) :: omegas(numrad) ! two-stream parameter omega for snow by band + data (omegas(i),i=1,numrad) /0.8_r8, 0.4_r8/ + + !------------------------------------------------------------------ + ! Soil and Lake depths are constants for now + ! The values for the following arrays are set in routine iniTimeConst + !------------------------------------------------------------------ + + real(r8) :: zlak(1:nlevlak) !lake z (layers) + real(r8) :: dzlak(1:nlevlak) !lake dz (thickness) + real(r8) :: zsoi(1:nlevgrnd) !soil z (layers) + real(r8) :: dzsoi(1:nlevgrnd) !soil dz (thickness) + real(r8) :: zisoi(0:nlevgrnd) !soil zi (interfaces) + +end module clm_varcon diff --git a/components/clm/src_clm40/main/clm_varctl.F90 b/components/clm/src_clm40/main/clm_varctl.F90 new file mode 100644 index 0000000000..81c0318948 --- /dev/null +++ b/components/clm/src_clm40/main/clm_varctl.F90 @@ -0,0 +1,321 @@ +module clm_varctl + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varctl +! +! !DESCRIPTION: +! Module containing run control variables +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC MEMBER FUNCTIONS: + implicit none + public :: clm_varctl_set ! Set variables + public :: clmvarctl_init ! Initialize and check values after namelist input + + private + save +! +! !PUBLIC TYPES: +! + integer, parameter, private :: iundef = -9999999 + integer, parameter, private :: rundef = -9999999._r8 +! +! Run control variables +! + character(len=256), public :: caseid = ' ' ! case id + character(len=256), public :: ctitle = ' ' ! case title + integer, public :: nsrest = iundef ! Type of run + integer, public, parameter :: nsrStartup = 0 ! Startup from initial conditions + integer, public, parameter :: nsrContinue = 1 ! Continue from restart files + integer, public, parameter :: nsrBranch = 2 ! Branch from restart files + logical, public :: brnch_retain_casename = .false. ! true => allow case name to remain the same for branch run + ! by default this is not allowed + logical, public :: noland = .false. ! true => no valid land points -- do NOT run + character(len=256), public :: hostname = ' ' ! Hostname of machine running on + character(len=256), public :: username = ' ' ! username of user running program + character(len=256), public :: source = "Community Land Model CLM4.0" ! description of this source + character(len=256), public :: version = " " ! version of program + character(len=256), public :: conventions = "CF-1.0" ! dataset conventions +! +! Unit Numbers +! + integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 +! +! Output NetCDF files +! + logical, public :: outnc_large_files = .true. ! large file support for output NetCDF files +! +! Run input files +! + character(len=256), public :: finidat = ' ' ! initial conditions file name + character(len=256), public :: fsurdat = ' ' ! surface data file name + character(len=256), public :: fatmgrid = ' ' ! atm grid file name + character(len=256), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid + character(len=256), public :: fatmtopo = ' ' ! topography on atm grid + character(len=256), public :: flndtopo = ' ' ! topography on lnd grid + character(len=256), public :: flanduse_timeseries = ' ' ! dynamic landuse dataset + character(len=256), public :: fpftcon = ' ' ! ASCII data file with PFT physiological constants + character(len=256), public :: nrevsn = ' ' ! restart data file name for branch run + character(len=256), public :: fsnowoptics = ' ' ! snow optical properties file name + character(len=256), public :: fsnowaging = ' ' ! snow aging parameters file name + +! +! Landunit logic +! + logical, public :: create_crop_landunit = .false. ! true => separate crop landunit is not created by default + logical, public :: allocate_all_vegpfts = .false. ! true => allocate memory for all possible vegetated pfts on + ! vegetated landunit if at least one pft has nonzero weight +! +! BGC logic and datasets +! + character(len=16), public :: co2_type = 'constant' ! values of 'prognostic','diagnostic','constant' +! +! Physics +! + logical, public :: wrtdia = .false. ! true => write global average diagnostics to std out + real(r8), public :: co2_ppmv = 355._r8 ! atmospheric CO2 molar ratio (by volume) (umol/mol) + + ! C isotopes + logical, public :: use_c13 = .false. ! true => use C-13 model + logical, public :: use_c14 = .false. ! true => use C-14 model + +! glacier_mec control variables: default values (may be overwritten by namelist) +! NOTE: glc_smb must have the same values for CLM and GLC + + logical , public :: create_glacier_mec_landunit = .false. ! glacier_mec landunit is not created (set in controlMod) + logical , public :: glc_smb = .true. ! if true, pass surface mass balance info to GLC + ! if false, pass positive-degree-day info to GLC + logical , public :: glc_dyntopo = .false. ! true => CLM glacier topography changes dynamically + real(r8), public, allocatable :: glc_topomax(:) ! upper limit of each class (m) (set in surfrd) + character(len=256), public :: fglcmask = ' ' ! glacier mask file name +! +! single column control variables +! + logical, public :: single_column = .false. ! true => single column mode + real(r8), public :: scmlat = rundef ! single column lat + real(r8), public :: scmlon = rundef ! single column lon +! +! instance control +! + integer, public :: inst_index + character(len=16), public :: inst_name + character(len=16), public :: inst_suffix +! +! Decomp control variables +! + integer, public :: nsegspc = 20 ! number of segments per clump for decomp +! +! Derived variables (run, history and restart file) +! + character(len=256), public :: rpntdir = '.' ! directory name for local restart pointer file + character(len=256), public :: rpntfil = 'rpointer.lnd' ! file name for local restart pointer file +! +! Migration of CPP variables +! +#if (defined CN) + logical, public :: use_cn = .true. +#else + logical, public :: use_cn = .false. +#endif +#if (defined CNDV) + logical, public :: use_cndv = .true. +#else + logical, public :: use_cndv = .false. +#endif +#if (defined CROP) + logical, public :: use_crop = .true. +#else + logical, public :: use_crop = .false. +#endif +#if (defined SNICAR_FRC) + logical, public :: use_snicar_frc = .true. +#else + logical, public :: use_snicar_frc = .false. +#endif +#if (defined NOFIRE) + logical, public :: use_nofire = .true. +#else + logical, public :: use_nofire = .false. +#endif +#if (defined VANCOUVER) + logical, public :: use_vancouver = .true. +#else + logical, public :: use_vancouver = .false. +#endif +#if (defined MEXICOCITY) + logical, public :: use_mexicocity = .true. +#else + logical, public :: use_mexicocity = .false. +#endif +#if (defined AD_SPINUP) + logical, public :: use_ad_spinup = .true. +#else + logical, public :: use_ad_spinup = .false. +#endif +#if (defined EXIT_SPINUP) + logical, public :: use_exit_spinup = .true. +#else + logical, public :: use_exit_spinup = .false. +#endif + !needed for compatibility with changes in clm4_5 and reference dy lnd_comp_mct + !however use_voc is not used anywhere inside the clm4_0 code + logical, public :: use_voc = .true. +! +! !PRIVATE DATA MEMBERS: +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein and Gordon Bonan +! 1 June 2004, Peter Thornton: added fnedpdat for nitrogen deposition data +! +!EOP +!----------------------------------------------------------------------- + logical, private :: clmvarctl_isset = .false. + +!=============================================================== +contains +!=============================================================== + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: clm_varctl_set +! +! !INTERFACE: + subroutine clm_varctl_set( caseid_in, ctitle_in, brnch_retain_casename_in, & + single_column_in, scmlat_in, scmlon_in, nsrest_in, & + version_in, hostname_in, username_in) +! +! !DESCRIPTION: +! Set input control variables. +! +! !USES: + use shr_sys_mod, only : shr_sys_abort +! +! !ARGUMENTS: + character(len=256), optional, intent(IN) :: caseid_in ! case id + character(len=256), optional, intent(IN) :: ctitle_in ! case title + logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to remain the same for branch run + logical, optional, intent(IN) :: single_column_in ! true => single column mode + real(r8), optional, intent(IN) :: scmlat_in ! single column lat + real(r8), optional, intent(IN) :: scmlon_in ! single column lon + integer, optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch + character(len=256), optional, intent(IN) :: version_in ! model version + character(len=256), optional, intent(IN) :: hostname_in ! hostname running on + character(len=256), optional, intent(IN) :: username_in ! username running job + +! +! !LOCAL VARIABLES: + character(len=32) :: subname = 'clm_varctl_set' ! subroutine name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + if ( clmvarctl_isset )then + call shr_sys_abort( subname//' ERROR:: control variables already set -- can not call this subroutine' ) + end if + if ( present(caseid_in ) ) caseid = caseid_in + if ( present(ctitle_in ) ) ctitle = ctitle_in + if ( present(single_column_in) ) single_column = single_column_in + if ( present(scmlat_in ) ) scmlat = scmlat_in + if ( present(scmlon_in ) ) scmlon = scmlon_in + if ( present(nsrest_in ) ) nsrest = nsrest_in + if ( present(brnch_retain_casename_in) ) brnch_retain_casename = brnch_retain_casename_in + if ( present(version_in ) ) version = version_in + if ( present(username_in ) ) username = username_in + if ( present(hostname_in ) ) hostname = hostname_in + + end subroutine clm_varctl_set + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: clmvarctl_init +! +! !INTERFACE: + subroutine clmvarctl_init( masterproc, dtime ) +! +! !DESCRIPTION: +! Check that values are correct, and finish setting variables based on other variables. +! +! !USES: + use shr_sys_mod , only : shr_sys_abort + use clm_varpar , only : maxpatch_pft, numpft +! +! !ARGUMENTS: + logical, intent(IN) :: masterproc ! proc 0 logical for printing msgs + integer, intent(IN) :: dtime ! timestep in seconds +! +! !LOCAL VARIABLES: + character(len=32) :: subname = 'clmvarctl_init' ! subroutine name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + + ! landunit generation + + if (maxpatch_pft == numpft+1) then + allocate_all_vegpfts = .true. + else + allocate_all_vegpfts = .false. + if (use_crop) then + write(iulog,*)'maxpatch_pft = ',maxpatch_pft,& + ' does NOT equal numpft+1 = ',numpft+1 + call shr_sys_abort( subname//' ERROR:: Can NOT turn CROP on without all PFTs' ) + end if + end if + + if (masterproc) then + + ! Consistency settings for co2 type + + if (co2_type /= 'constant' .and. co2_type /= 'prognostic' .and. co2_type /= 'diagnostic') then + write(iulog,*)'co2_type = ',co2_type,' is not supported' + call shr_sys_abort( subname//' ERROR:: choices are constant, prognostic or diagnostic' ) + end if + + ! Consistency settings for dynamic land use, etc. + + if (flanduse_timeseries /= ' ' .and. create_crop_landunit) & + call shr_sys_abort( subname//' ERROR:: dynamic landuse is currently not supported with create_crop_landunit option' ) + if (create_crop_landunit .and. .not.allocate_all_vegpfts) & + call shr_sys_abort( subname//' ERROR:: maxpft 3000.0_r8) ) & + call shr_sys_abort( subname//' ERROR: co2_ppmv is out of a reasonable range' ) + + if (nsrest == nsrStartup ) nrevsn = ' ' + if (nsrest == nsrContinue) nrevsn = 'set by restart pointer file file' + if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) & + call shr_sys_abort( subname//' ERROR: nsrest NOT set to a valid value' ) + + if ( single_column .and. (scmlat == rundef .or. scmlon == rundef ) ) & + call shr_sys_abort( subname//' ERROR:: single column mode on -- but scmlat and scmlon are NOT set' ) + + endif ! end of if-masterproc if-block + + clmvarctl_isset = .true. + + end subroutine clmvarctl_init + +end module clm_varctl diff --git a/components/clm/src_clm40/main/clm_varorb.F90 b/components/clm/src_clm40/main/clm_varorb.F90 new file mode 100644 index 0000000000..47bf51e576 --- /dev/null +++ b/components/clm/src_clm40/main/clm_varorb.F90 @@ -0,0 +1,17 @@ + +module clm_varorb + + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + + ! Orbital information needed as input to orbit_parms + + real(r8) :: eccen ! Earth's eccentricity factor (unitless) (typically 0 to 0.1) + + ! Orbital information after processed by orbit_params + + real(r8) :: obliqr ! Earth's obliquity in radians + real(r8) :: lambm0 ! Mean longitude of perihelion at the vernal equinox (radians) + real(r8) :: mvelpp ! Earth's moving vernal equinox longitude of perihelion plus pi (radians) + +end module clm_varorb diff --git a/components/clm/src_clm40/main/clm_varpar.F90 b/components/clm/src_clm40/main/clm_varpar.F90 new file mode 100644 index 0000000000..252569e385 --- /dev/null +++ b/components/clm/src_clm40/main/clm_varpar.F90 @@ -0,0 +1,118 @@ +module clm_varpar + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! ------------------------------------------------------- +! Module Parameters +! ------------------------------------------------------- + +! Note - model resolution is read in from the surface dataset + + integer, parameter :: nlevsoi = 10 ! number of hydrologically active soil layers + integer, parameter :: nlevgrnd = 15 ! number of ground layers (includes lower layers that are hydrologically inactive) + integer, parameter :: nlevurb = nlevgrnd! number of urban layers (must equal nlevgrnd right now) + integer, parameter :: nlevlak = 10 ! number of lake layers + integer, parameter :: nlevsno = 5 ! maximum number of snow layers + integer, parameter :: numwat = 5 ! number of water types (soil, ice, 2 lakes, wetland) + integer, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir + integer, parameter :: ivis = 1 ! index for visible band + integer, parameter :: inir = 2 ! index for near-infrared band + integer, parameter :: numsolar = 2 ! number of solar type bands: direct, diffuse + integer, parameter :: ndst = 4 ! number of dust size classes (BGC only) + integer, parameter :: dst_src_nbr = 3 ! number of size distns in src soil (BGC only) + integer, parameter :: sz_nbr = 200 ! number of sub-grid bins in large bin of dust size distribution (BGC only) + integer, parameter :: mxpft = 20 ! maximum number of PFT's for any mode + integer, parameter :: numveg = 16 ! number of veg types (without specific crop) +#if (defined CROP) + integer, parameter :: numpft = mxpft ! actual # of pfts (without bare) + integer, parameter :: numcft = 6 ! actual # of crops +#else + integer, parameter :: numpft = numveg ! actual # of pfts (without bare) + integer, parameter :: numcft = 2 ! actual # of crops +#endif + integer, parameter :: maxpatch_pft= MAXPATCH_PFT ! max number of plant functional types in naturally vegetated landunit + +! ------------------------------------------------------- +! Module Varaibles (initialized in clm_varpar_init) +! ------------------------------------------------------- + +! Indices used in surface file read and set in clm_varpar_init + + integer :: maxpatch ! max number of patches + integer :: maxpatch_glcmec ! max number of elevation classes + integer :: maxpatch_urb ! max number of urban pfts (columns) in urban landunit + integer :: npatch_urban ! number of urban pfts (columns) in urban landunit + integer :: npatch_lake ! number of lake pfts (columns) in lake landunit + integer :: npatch_wet ! number of wetland pfts (columns) in wetland landunit + integer :: npatch_glacier ! number of glacier pfts (columns) in glacier landunit + integer :: npatch_glacier_mec ! number of glacier_mec pfts (columns) in glacier_mec landunit + integer :: max_pft_per_gcell + integer :: max_pft_per_lu + integer :: max_pft_per_col + +! !PUBLIC MEMBER FUNCTIONS: + public clm_varpar_init ! set parameters + +! !REVISION HISTORY: +! Created by Mariana Vertenstein + +!EOP +!----------------------------------------------------------------------- +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: clm_varpar_init +! +! !INTERFACE: + subroutine clm_varpar_init() +! +! !DESCRIPTION: +! This subroutine initializes parameters in clm_varpar +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by T Craig +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + maxpatch_urb = 5 + npatch_urban = maxpatch_pft + 1 + npatch_lake = npatch_urban + maxpatch_urb + npatch_wet = npatch_lake + 1 + npatch_glacier = npatch_wet + 1 + npatch_glacier_mec = npatch_glacier + maxpatch_glcmec + maxpatch = npatch_glacier_mec + + max_pft_per_gcell = numpft+1 + 3 + maxpatch_urb + maxpatch_glcmec +#if (defined CROP) + max_pft_per_gcell = max_pft_per_gcell + numcft +#endif + max_pft_per_lu = max(numpft+1, numcft, maxpatch_urb) + max_pft_per_col = max(numpft+1, numcft, maxpatch_urb) + + end subroutine clm_varpar_init + +!------------------------------------------------------------------------------ +end module clm_varpar diff --git a/components/clm/src_clm40/main/clm_varsur.F90 b/components/clm/src_clm40/main/clm_varsur.F90 new file mode 100644 index 0000000000..3ff2162c14 --- /dev/null +++ b/components/clm/src_clm40/main/clm_varsur.F90 @@ -0,0 +1,37 @@ + +module clm_varsur + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varsur +! +! !DESCRIPTION: +! Module containing 2-d surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! land model grid - moved to domainMod +! +! surface boundary data, these are all "gdc" local +! + integer , allocatable :: vegxy(:,:) ! vegetation type + real(r8), allocatable,target :: wtxy(:,:) ! subgrid weights + + real(r8),allocatable :: pctspec(:) ! percent of spec lunits wrt gcell + + real(r8), allocatable,target :: topoxy(:,:) ! subgrid glacier_mec sfc elevation +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 2005-11-01 Moved grid to domainMod, T Craig +! +!EOP +!----------------------------------------------------------------------- + +end module clm_varsur diff --git a/components/clm/src_clm40/main/clmtype.F90 b/components/clm/src_clm40/main/clmtype.F90 new file mode 100644 index 0000000000..0498100222 --- /dev/null +++ b/components/clm/src_clm40/main/clmtype.F90 @@ -0,0 +1,1991 @@ +module clmtype + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clmtype +! +! !DESCRIPTION: +! Define derived type hierarchy. Includes declaration of +! the clm derived type and 1d mapping arrays. +! +! -------------------------------------------------------- +! gridcell types can have values of +! -------------------------------------------------------- +! 1 => default +! -------------------------------------------------------- +! landunits types can have values of (see clm_varcon.F90) +! -------------------------------------------------------- +! 1 => (istsoil) soil (vegetated or bare soil landunit) +! 2 => (istice) land ice +! 3 => (istdlak) deep lake +! 4 => (istslak) shallow lake (not currently implemented) +! 5 => (istwet) wetland +! 6 => (isturb) urban +! 7 => (istice_mec) land ice (multiple elevation classes) +! 8 => (istcrop) crop (only for crop configuration) +! -------------------------------------------------------- +! column types can have values of +! -------------------------------------------------------- +! 1 => (istsoil) soil (vegetated or bare soil) +! 2 => (istice) land ice +! 3 => (istdlak) deep lake +! 4 => (istslak) shallow lake +! 5 => (istwet) wetland +! 7 => (istice_mec) land ice (multiple elevation classes) +! 61 => (icol_roof) urban roof +! 62 => (icol_sunwall) urban sunwall +! 63 => (icol_shadewall) urban shadewall +! 64 => (icol_road_imperv) urban impervious road +! 65 => (icol_road_perv) urban pervious road +! -------------------------------------------------------- +! pft types can have values of +! -------------------------------------------------------- +! 0 => not vegetated +! 1 => needleleaf evergreen temperate tree +! 2 => needleleaf evergreen boreal tree +! 3 => needleleaf deciduous boreal tree +! 4 => broadleaf evergreen tropical tree +! 5 => broadleaf evergreen temperate tree +! 6 => broadleaf deciduous tropical tree +! 7 => broadleaf deciduous temperate tree +! 8 => broadleaf deciduous boreal tree +! 9 => broadleaf evergreen shrub +! 10 => broadleaf deciduous temperate shrub +! 11 => broadleaf deciduous boreal shrub +! 12 => c3 arctic grass +! 13 => c3 non-arctic grass +! 14 => c4 grass +! 15 => c3_crop +! 16 => c3_irrigated +! 17 => corn +! 18 => spring temperate cereal +! 19 => winter temperate cereal +! 20 => soybean +! -------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use domainMod , only: domain_type +! +! !PUBLIC TYPES: + implicit none + + public +! +! !REVISION HISTORY: +! Created by Peter Thornton and Mariana Vertenstein +! +!******************************************************************************* +!---------------------------------------------------- +! Begin definition of conservation check structures +!---------------------------------------------------- +! energy balance structure +!---------------------------------------------------- +type, public :: energy_balance_type + real(r8), pointer :: errsoi(:) !soil/lake energy conservation error (W/m**2) + real(r8), pointer :: errseb(:) !surface energy conservation error (W/m**2) + real(r8), pointer :: errsol(:) !solar radiation conservation error (W/m**2) + real(r8), pointer :: errlon(:) !longwave radiation conservation error (W/m**2) +end type energy_balance_type + +type(energy_balance_type) :: pebal !energy balance structure +type(energy_balance_type) :: cebal !energy balance structure + +!---------------------------------------------------- +! water balance structure +!---------------------------------------------------- +type, public :: water_balance_type + real(r8), pointer :: begwb(:) !water mass begining of the time step + real(r8), pointer :: endwb(:) !water mass end of the time step + real(r8), pointer :: errh2o(:) !water conservation error (mm H2O) +end type water_balance_type + +type(water_balance_type) :: pwbal !water balance structure +type(water_balance_type) :: cwbal !water balance structure + +!---------------------------------------------------- +! carbon balance structure +!---------------------------------------------------- +type, public :: carbon_balance_type + real(r8), pointer :: begcb(:) !carbon mass, beginning of time step (gC/m**2) + real(r8), pointer :: endcb(:) !carbon mass, end of time step (gC/m**2) + real(r8), pointer :: errcb(:) !carbon balance error for the timestep (gC/m**2) +end type carbon_balance_type + +type(carbon_balance_type) :: pcbal !carbon balance structure +type(carbon_balance_type) :: ccbal !carbon balance structure + +!---------------------------------------------------- +! nitrogen balance structure +!---------------------------------------------------- +type, public :: nitrogen_balance_type + real(r8), pointer :: begnb(:) !nitrogen mass, beginning of time step (gN/m**2) + real(r8), pointer :: endnb(:) !nitrogen mass, end of time step (gN/m**2) + real(r8), pointer :: errnb(:) !nitrogen balance error for the timestep (gN/m**2) +end type nitrogen_balance_type + +type(nitrogen_balance_type) :: pnbal !nitrogen balance structure +type(nitrogen_balance_type) :: cnbal !nitrogen balance structure + +!---------------------------------------------------- +! End definition of conservation check structures +!---------------------------------------------------- +!******************************************************************************* + +!******************************************************************************* +!---------------------------------------------------- +! Begin definition of structures defined at the pft_type level +!---------------------------------------------------- +! pft physical state variables structure +!---------------------------------------------------- +type, public :: pft_pstate_type + integer , pointer :: frac_veg_nosno(:) !fraction of vegetation not covered by snow (0 OR 1) [-] + integer , pointer :: frac_veg_nosno_alb(:) !fraction of vegetation not covered by snow (0 OR 1) [-] + real(r8), pointer :: emv(:) !vegetation emissivity + real(r8), pointer :: z0mv(:) !roughness length over vegetation, momentum [m] + real(r8), pointer :: z0hv(:) !roughness length over vegetation, sensible heat [m] + real(r8), pointer :: z0qv(:) !roughness length over vegetation, latent heat [m] + real(r8), pointer :: rootfr(:,:) !fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootr(:,:) !effective fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rresis(:,:) !root resistance by layer (0-1) (nlevgrnd) + real(r8), pointer :: dewmx(:) !Maximum allowed dew [mm] + real(r8), pointer :: rssun(:) !sunlit stomatal resistance (s/m) + real(r8), pointer :: rssha(:) !shaded stomatal resistance (s/m) + real(r8), pointer :: laisun(:) !sunlit projected leaf area index + real(r8), pointer :: laisha(:) !shaded projected leaf area index + real(r8), pointer :: btran(:) !transpiration wetness factor (0 to 1) + real(r8), pointer :: fsun(:) !sunlit fraction of canopy + real(r8), pointer :: tlai(:) !one-sided leaf area index, no burying by snow + real(r8), pointer :: tsai(:) !one-sided stem area index, no burying by snow + real(r8), pointer :: elai(:) !one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) !one-sided stem area index with burying by snow + real(r8), pointer :: fwet(:) !fraction of canopy that is wet (0 to 1) + real(r8), pointer :: fdry(:) !fraction of foliage that is green and dry [-] (new) + real(r8), pointer :: dt_veg(:) !change in t_veg, last iteration (Kelvin) + real(r8), pointer :: htop(:) !canopy top (m) + real(r8), pointer :: hbot(:) !canopy bottom (m) + real(r8), pointer :: z0m(:) !momentum roughness length (m) + real(r8), pointer :: displa(:) !displacement height (m) + real(r8), pointer :: albd(:,:) !surface albedo (direct) (numrad) + real(r8), pointer :: albi(:,:) !surface albedo (indirect) (numrad) + real(r8), pointer :: fabd(:,:) !flux absorbed by veg per unit direct flux (numrad) + real(r8), pointer :: fabi(:,:) !flux absorbed by veg per unit diffuse flux (numrad) + real(r8), pointer :: ftdd(:,:) !down direct flux below veg per unit dir flx (numrad) + real(r8), pointer :: ftid(:,:) !down diffuse flux below veg per unit dir flx (numrad) + real(r8), pointer :: ftii(:,:) !down diffuse flux below veg per unit dif flx (numrad) + real(r8), pointer :: u10(:) !10-m wind (m/s) (for dust model) + real(r8), pointer :: u10_clm(:) !10-m wind (m/s) + real(r8), pointer :: va(:) !atmospheric wind speed plus convective velocity (m/s) + real(r8), pointer :: ram1(:) !aerodynamical resistance (s/m) + real(r8), pointer :: fv(:) !friction velocity (m/s) (for dust model) + real(r8), pointer :: forc_hgt_u_pft(:) !wind forcing height (10m+z0m+d) (m) + real(r8), pointer :: forc_hgt_t_pft(:) !temperature forcing height (10m+z0m+d) (m) + real(r8), pointer :: forc_hgt_q_pft(:) !specific humidity forcing height (10m+z0m+d) (m) + ! Variables for prognostic crop model + real(r8), pointer :: hdidx(:) ! cold hardening index? + real(r8), pointer :: cumvd(:) ! cumulative vernalization d?ependence? + real(r8), pointer :: htmx(:) ! max hgt attained by a crop during yr (m) + real(r8), pointer :: vf(:) ! vernalization factor for cereal + real(r8), pointer :: gddmaturity(:) ! growing degree days (gdd) needed to harvest (ddays) + real(r8), pointer :: gdd0(:) ! growing degree-days base 0C from planting (ddays) + real(r8), pointer :: gdd8(:) ! growing degree-days base 8C from planting (ddays) + real(r8), pointer :: gdd10(:) ! growing degree-days base 10C from planting (ddays) + real(r8), pointer :: gdd020(:) ! 20-year average of gdd0 (ddays) + real(r8), pointer :: gdd820(:) ! 20-year average of gdd8 (ddays) + real(r8), pointer :: gdd1020(:) ! 20-year average of gdd10 (ddays) + real(r8), pointer :: gddplant(:) ! accum gdd past planting date for crop (ddays) + real(r8), pointer :: gddtsoi(:) ! growing degree-days from planting (top two soil layers) (ddays) + real(r8), pointer :: huileaf(:) ! heat unit index needed from planting to leaf emergence + real(r8), pointer :: huigrain(:) ! heat unit index needed to reach vegetative maturity + real(r8), pointer :: aleafi(:) ! saved leaf allocation coefficient from phase 2 + real(r8), pointer :: astemi(:) ! saved stem allocation coefficient from phase 2 + real(r8), pointer :: aleaf(:) ! leaf allocation coefficient + real(r8), pointer :: astem(:) ! stem allocation coefficient + logical , pointer :: croplive(:) ! Flag, true if planted, not harvested + logical , pointer :: cropplant(:) ! Flag, true if planted + integer , pointer :: harvdate(:) ! harvest date + ! cropplant and harvdate could be 2D to facilitate rotation + integer , pointer :: idop(:) ! date of planting + integer , pointer :: peaklai(:) ! 1: max allowed lai; 0: not at max + real(r8), pointer :: vds(:) !deposition velocity term (m/s) (for dry dep SO4, NH4NO3) + ! new variables for CN code + real(r8), pointer :: slasun(:) !specific leaf area for sunlit canopy, projected area basis (m^2/gC) + real(r8), pointer :: slasha(:) !specific leaf area for shaded canopy, projected area basis (m^2/gC) + real(r8), pointer :: lncsun(:) !leaf N concentration per unit projected LAI (gN leaf/m^2) + real(r8), pointer :: lncsha(:) !leaf N concentration per unit projected LAI (gN leaf/m^2) + real(r8), pointer :: vcmxsun(:) !sunlit leaf Vcmax (umolCO2/m^2/s) + real(r8), pointer :: vcmxsha(:) !shaded leaf Vcmax (umolCO2/m^2/s) + real(r8), pointer :: gdir(:) !leaf projection in solar direction (0 to 1) + real(r8), pointer :: omega(:,:) !fraction of intercepted radiation that is scattered (0 to 1) + real(r8), pointer :: eff_kid(:,:) !effective extinction coefficient for indirect from direct + real(r8), pointer :: eff_kii(:,:) !effective extinction coefficient for indirect from indirect + real(r8), pointer :: sun_faid(:,:) !fraction sun canopy absorbed indirect from direct + real(r8), pointer :: sun_faii(:,:) !fraction sun canopy absorbed indirect from indirect + real(r8), pointer :: sha_faid(:,:) !fraction shade canopy absorbed indirect from direct + real(r8), pointer :: sha_faii(:,:) !fraction shade canopy absorbed indirect from indirect + real(r8), pointer :: cisun(:) !sunlit intracellular CO2 (Pa) + real(r8), pointer :: cisha(:) !shaded intracellular CO2 (Pa) + real(r8), pointer :: alphapsnsun(:) !sunlit 13c fractionation ([]) + real(r8), pointer :: alphapsnsha(:) !shaded 13c fractionation ([]) + real(r8), pointer :: sandfrac(:) ! sand fraction + real(r8), pointer :: clayfrac(:) ! clay fraction + ! for dry deposition of chemical tracers + real(r8), pointer :: mlaidiff(:) ! difference between lai month one and month two + real(r8), pointer :: rb1(:) ! aerodynamical resistance (s/m) + real(r8), pointer :: annlai(:,:) ! 12 months of monthly lai from input data set +end type pft_pstate_type + +type(pft_pstate_type) :: pps !physical state variables +type(pft_pstate_type) :: pps_a !pft-level pstate variables averaged to the column + +!---------------------------------------------------- +! pft ecophysiological constants structure +!---------------------------------------------------- +type, public :: pft_epc_type + integer , pointer :: noveg(:) !value for not vegetated + integer , pointer :: tree(:) !tree or not? + real(r8), pointer :: smpso(:) !soil water potential at full stomatal opening (mm) + real(r8), pointer :: smpsc(:) !soil water potential at full stomatal closure (mm) + real(r8), pointer :: fnitr(:) !foliage nitrogen limitation factor (-) + real(r8), pointer :: foln(:) !foliage nitrogen (%) + real(r8), pointer :: dleaf(:) !characteristic leaf dimension (m) + real(r8), pointer :: c3psn(:) !photosynthetic pathway: 0. = c4, 1. = c3 + real(r8), pointer :: mp(:) !slope of conductance-to-photosynthesis relationship + real(r8), pointer :: qe25(:) !quantum efficiency at 25C (umol CO2 / umol photon) + real(r8), pointer :: xl(:) !leaf/stem orientation index + real(r8), pointer :: rhol(:,:) !leaf reflectance: 1=vis, 2=nir (numrad) + real(r8), pointer :: rhos(:,:) !stem reflectance: 1=vis, 2=nir (numrad) + real(r8), pointer :: taul(:,:) !leaf transmittance: 1=vis, 2=nir (numrad) + real(r8), pointer :: taus(:,:) !stem transmittance: 1=vis, 2=nir (numrad) + real(r8), pointer :: z0mr(:) !ratio of momentum roughness length to canopy top height (-) + real(r8), pointer :: displar(:) !ratio of displacement height to canopy top height (-) + real(r8), pointer :: roota_par(:) !CLM rooting distribution parameter [1/m] + real(r8), pointer :: rootb_par(:) !CLM rooting distribution parameter [1/m] + real(r8), pointer :: sla(:) !specific leaf area [m2 leaf g-1 carbon] + ! new variables for CN code + real(r8), pointer :: dwood(:) !wood density (gC/m3) + real(r8), pointer :: slatop(:) !specific leaf area at top of canopy, projected area basis [m^2/gC] + real(r8), pointer :: dsladlai(:) !dSLA/dLAI, projected area basis [m^2/gC] + real(r8), pointer :: leafcn(:) !leaf C:N (gC/gN) + real(r8), pointer :: flnr(:) !fraction of leaf N in the Rubisco enzyme (gN Rubisco / gN leaf) + real(r8), pointer :: woody(:) !binary flag for woody lifeform (1=woody, 0=not woody) + real(r8), pointer :: lflitcn(:) !leaf litter C:N (gC/gN) + real(r8), pointer :: frootcn(:) !fine root C:N (gC/gN) + real(r8), pointer :: livewdcn(:) !live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8), pointer :: deadwdcn(:) !dead wood (xylem and heartwood) C:N (gC/gN) + real(r8), pointer :: graincn(:) !grain C:N (gC/gN) for prognostic crop model + real(r8), pointer :: froot_leaf(:) !allocation parameter: new fine root C per new leaf C (gC/gC) + real(r8), pointer :: stem_leaf(:) !allocation parameter: new stem c per new leaf C (gC/gC) + real(r8), pointer :: croot_stem(:) !allocation parameter: new coarse root C per new stem C (gC/gC) + real(r8), pointer :: flivewd(:) !allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + real(r8), pointer :: fcur(:) !allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + real(r8), pointer :: lf_flab(:) !leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) !leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) !leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) !fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) !fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) !fine root litter lignin fraction + real(r8), pointer :: leaf_long(:) !leaf longevity (yrs) + real(r8), pointer :: evergreen(:) !binary flag for evergreen leaf habit (0 or 1) + real(r8), pointer :: stress_decid(:) !binary flag for stress-deciduous leaf habit (0 or 1) + real(r8), pointer :: season_decid(:) !binary flag for seasonal-deciduous leaf habit (0 or 1) + ! new variables for fire code + real(r8), pointer :: resist(:) !resistance to fire (no units) +end type pft_epc_type + +type(pft_epc_type), public, target, save :: pftcon + +!---------------------------------------------------- +! pft DGVM-specific ecophysiological constants structure +!---------------------------------------------------- +type, public :: pft_dgvepc_type + real(r8), pointer :: crownarea_max(:) !tree maximum crown area [m2] + real(r8), pointer :: tcmin(:) !minimum coldest monthly mean temperature [units?] + real(r8), pointer :: tcmax(:) !maximum coldest monthly mean temperature [units?] + real(r8), pointer :: gddmin(:) !minimum growing degree days (at or above 5 C) + real(r8), pointer :: twmax(:) !upper limit of temperature of the warmest month [units?] + real(r8), pointer :: reinickerp(:) !parameter in allometric equation + real(r8), pointer :: allom1(:) !parameter in allometric + real(r8), pointer :: allom2(:) !parameter in allometric + real(r8), pointer :: allom3(:) !parameter in allometric +end type pft_dgvepc_type + +type(pft_dgvepc_type), public, target, save :: dgv_pftcon + +!---------------------------------------------------- +! pft ecophysiological variables structure +!---------------------------------------------------- +type, public :: pft_epv_type + real(r8), pointer :: dormant_flag(:) !dormancy flag + real(r8), pointer :: days_active(:) !number of days since last dormancy + real(r8), pointer :: onset_flag(:) !onset flag + real(r8), pointer :: onset_counter(:) !onset days counter + real(r8), pointer :: onset_gddflag(:) !onset flag for growing degree day sum + real(r8), pointer :: onset_fdd(:) !onset freezing degree days counter + real(r8), pointer :: onset_gdd(:) !onset growing degree days + real(r8), pointer :: onset_swi(:) !onset soil water index + real(r8), pointer :: offset_flag(:) !offset flag + real(r8), pointer :: offset_counter(:) !offset days counter + real(r8), pointer :: offset_fdd(:) !offset freezing degree days counter + real(r8), pointer :: offset_swi(:) !offset soil water index + real(r8), pointer :: lgsf(:) !long growing season factor [0-1] + real(r8), pointer :: bglfr(:) !background litterfall rate (1/s) + real(r8), pointer :: bgtr(:) !background transfer growth rate (1/s) + real(r8), pointer :: dayl(:) !daylength (seconds) + real(r8), pointer :: prev_dayl(:) !daylength from previous timestep (seconds) + real(r8), pointer :: annavg_t2m(:) !annual average 2m air temperature (K) + real(r8), pointer :: tempavg_t2m(:) !temporary average 2m air temperature (K) + real(r8), pointer :: gpp(:) !GPP flux before downregulation (gC/m2/s) + real(r8), pointer :: availc(:) !C flux available for allocation (gC/m2/s) + real(r8), pointer :: xsmrpool_recover(:) !C flux assigned to recovery of negative cpool (gC/m2/s) + real(r8), pointer :: xsmrpool_c13ratio(:) !C13/C(12+13) ratio for xsmrpool (proportion) + real(r8), pointer :: alloc_pnow(:) !fraction of current allocation to display as new growth (DIM) + real(r8), pointer :: c_allometry(:) !C allocation index (DIM) + real(r8), pointer :: n_allometry(:) !N allocation index (DIM) + real(r8), pointer :: plant_ndemand(:) !N flux required to support initial GPP (gN/m2/s) + real(r8), pointer :: tempsum_potential_gpp(:)!temporary annual sum of potential GPP + real(r8), pointer :: annsum_potential_gpp(:) !annual sum of potential GPP + real(r8), pointer :: tempmax_retransn(:) !temporary annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: annmax_retransn(:) !annual max of retranslocated N pool (gN/m2) + real(r8), pointer :: avail_retransn(:) !N flux available from retranslocation pool (gN/m2/s) + real(r8), pointer :: plant_nalloc(:) !total allocated N flux (gN/m2/s) + real(r8), pointer :: plant_calloc(:) !total allocated C flux (gC/m2/s) + real(r8), pointer :: excess_cflux(:) !C flux not allocated due to downregulation (gC/m2/s) + real(r8), pointer :: downreg(:) !fractional reduction in GPP due to N limitation (DIM) + real(r8), pointer :: prev_leafc_to_litter(:) !previous timestep leaf C litterfall flux (gC/m2/s) + real(r8), pointer :: prev_frootc_to_litter(:)!previous timestep froot C litterfall flux (gC/m2/s) + real(r8), pointer :: tempsum_npp(:) !temporary annual sum of NPP (gC/m2/yr) + real(r8), pointer :: annsum_npp(:) !annual sum of NPP (gC/m2/yr) + real(r8), pointer :: tempsum_litfall(:) !temporary annual sum of litfall (gC/m2/yr) + real(r8), pointer :: annsum_litfall(:) !annual sum of litfall (gC/m2/yr) + real(r8), pointer :: rc13_canair(:) !C13O2/C12O2 in canopy air + real(r8), pointer :: rc13_psnsun(:) !C13O2/C12O2 in sunlit canopy psn flux + real(r8), pointer :: rc13_psnsha(:) !C13O2/C12O2 in shaded canopy psn flux +end type pft_epv_type + +type(pft_epv_type) :: pepv !pft ecophysiological variables + +!---------------------------------------------------- +! pft energy state variables structure +!---------------------------------------------------- +type, public :: pft_estate_type + real(r8), pointer :: t_ref2m(:) !2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_min(:) !daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max(:) !daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst(:) !instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst(:) !instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: q_ref2m(:) !2 m height surface specific humidity (kg/kg) + real(r8), pointer :: t_ref2m_u(:) !Urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_r(:) !Rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_min_u(:) !Urban daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_r(:) !Rural daily minimum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_u(:) !Urban daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_max_r(:) !Rural daily maximum of average 2 m height surface air temperature (K) + real(r8), pointer :: t_ref2m_min_inst_u(:) !Urban instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_min_inst_r(:) !Rural instantaneous daily min of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_u(:) !Urban instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: t_ref2m_max_inst_r(:) !Rural instantaneous daily max of average 2 m height surface air temp (K) + real(r8), pointer :: a10tmin(:) ! 10-day running mean of min 2-m temperature + real(r8), pointer :: a5tmin(:) ! 5-day running mean of min 2-m temperature + real(r8), pointer :: t10(:) !10-day running mean of the 2 m temperature (K) + real(r8), pointer :: rh_ref2m(:) !2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_u(:) !Urban 2 m height surface relative humidity (%) + real(r8), pointer :: rh_ref2m_r(:) !Rural 2 m height surface relative humidity (%) + real(r8), pointer :: t_veg(:) !vegetation temperature (Kelvin) + real(r8), pointer :: thm(:) !intermediate variable (forc_t+0.0098*forc_hgt_t_pft) +end type pft_estate_type + +type(pft_estate_type) :: pes !pft energy state + +!---------------------------------------------------- +! pft water state variables structure +!---------------------------------------------------- +type, public :: pft_wstate_type + real(r8), pointer :: h2ocan(:) !canopy water (mm H2O) +end type pft_wstate_type + +type(pft_wstate_type) :: pws !pft water state + +!---------------------------------------------------- +! pft carbon state variables structure +!---------------------------------------------------- +type, public :: pft_cstate_type + real(r8), pointer :: leafcmax(:) ! (gC/m2) ann max leaf C + ! variables for prognostic crop model + real(r8), pointer :: grainc(:) ! (gC/m2) grain C + real(r8), pointer :: grainc_storage(:) ! (gC/m2) grain C storage + real(r8), pointer :: grainc_xfer(:) ! (gC/m2) grain C transfer + ! + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: cpool(:) ! (gC/m2) temporary photosynthate C pool + real(r8), pointer :: xsmrpool(:) ! (gC/m2) abstract C pool to meet excess MR demand + real(r8), pointer :: pft_ctrunc(:) ! (gC/m2) pft-level sink for C truncation + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegc(:) ! (gC/m2) displayed veg carbon, excluding storage and cpool + real(r8), pointer :: storvegc(:) ! (gC/m2) stored vegetation carbon, excluding cpool + real(r8), pointer :: totvegc(:) ! (gC/m2) total vegetation carbon, excluding cpool + real(r8), pointer :: totpftc(:) ! (gC/m2) total pft-level carbon, including cpool + real(r8), pointer :: woodc(:) ! (gC/m2) wood C +end type pft_cstate_type + +type(pft_cstate_type) :: pcs !pft carbon state +type(pft_cstate_type) :: pcs_a !pft-level carbon state averaged to the column +type(pft_cstate_type) :: pc13s !pft carbon-13 state +type(pft_cstate_type) :: pc13s_a !pft carbon-13 state averaged to the column + +!---------------------------------------------------- +! pft nitrogen state variables structure +!---------------------------------------------------- +type, public :: pft_nstate_type + ! variables for prognostic crop model + real(r8), pointer :: grainn(:) ! (gN/m2) grain N + real(r8), pointer :: grainn_storage(:) ! (gN/m2) grain N storage + real(r8), pointer :: grainn_xfer(:) ! (gN/m2) grain N transfer + ! + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: npool(:) ! (gN/m2) temporary plant N pool + real(r8), pointer :: pft_ntrunc(:) ! (gN/m2) pft-level sink for N truncation + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: dispvegn(:) ! (gN/m2) displayed veg nitrogen, excluding storage + real(r8), pointer :: storvegn(:) ! (gN/m2) stored vegetation nitrogen + real(r8), pointer :: totvegn(:) ! (gN/m2) total vegetation nitrogen + real(r8), pointer :: totpftn(:) ! (gN/m2) total pft-level nitrogen +end type pft_nstate_type + +type(pft_nstate_type) :: pns !pft nitrogen state + +!---------------------------------------------------- +! pft VOC state variables structure +!---------------------------------------------------- +type, public :: pft_vstate_type + real(r8), pointer :: t_veg24(:) ! 24hr average vegetation temperature (K) + real(r8), pointer :: t_veg240(:) ! 240hr average vegetation temperature (Kelvin) + real(r8), pointer :: fsd24(:) ! 24hr average of direct beam radiation + real(r8), pointer :: fsd240(:) ! 240hr average of direct beam radiation + real(r8), pointer :: fsi24(:) ! 24hr average of diffuse beam radiation + real(r8), pointer :: fsi240(:) ! 240hr average of diffuse beam radiation + real(r8), pointer :: fsun24(:) ! 24hr average of sunlit fraction of canopy + real(r8), pointer :: fsun240(:) ! 240hr average of sunlit fraction of canopy + real(r8), pointer :: elai_p(:) ! leaf area index average over timestep +end type pft_vstate_type + +type(pft_vstate_type) :: pvs !pft VOC state + +!---------------------------------------------------- +! pft DGVM state variables structure +!---------------------------------------------------- +type, public :: pft_dgvstate_type + real(r8), pointer :: agddtw(:) !accumulated growing degree days above twmax + real(r8), pointer :: agdd(:) !accumulated growing degree days above 5 + real(r8), pointer :: t_mo(:) !30-day average temperature (Kelvin) + real(r8), pointer :: t_mo_min(:) !annual min of t_mo (Kelvin) + real(r8), pointer :: prec365(:) !365-day running mean of tot. precipitation + logical , pointer :: present(:) !whether PFT present in patch + logical , pointer :: pftmayexist(:) !if .false. then exclude seasonal decid pfts from tropics + real(r8), pointer :: nind(:) !number of individuals (#/m**2) + real(r8), pointer :: lm_ind(:) !individual leaf mass + real(r8), pointer :: lai_ind(:) !LAI per individual + real(r8), pointer :: fpcinc(:) !foliar projective cover increment (fraction) + real(r8), pointer :: fpcgrid(:) !foliar projective cover on gridcell (fraction) + real(r8), pointer :: fpcgridold(:) !last yr's fpcgrid + real(r8), pointer :: crownarea(:) !area that each individual tree takes up (m^2) + real(r8), pointer :: greffic(:) + real(r8), pointer :: heatstress(:) +end type pft_dgvstate_type + +type(pft_dgvstate_type) :: pdgvs !pft DGVM state variables + +!---------------------------------------------------- +! pft energy flux variables structure +!---------------------------------------------------- +type, public :: pft_eflux_type + real(r8), pointer :: sabg(:) !solar radiation absorbed by ground (W/m**2) + real(r8), pointer :: sabv(:) !solar radiation absorbed by vegetation (W/m**2) + real(r8), pointer :: fsa(:) !solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_u(:) !urban solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsa_r(:) !rural solar radiation absorbed (total) (W/m**2) + real(r8), pointer :: fsr(:) !solar radiation reflected (W/m**2) + real(r8), pointer :: parsun(:) !average absorbed PAR for sunlit leaves (W/m**2) + real(r8), pointer :: parsha(:) !average absorbed PAR for shaded leaves (W/m**2) + real(r8), pointer :: dlrad(:) !downward longwave radiation below the canopy [W/m2] + real(r8), pointer :: ulrad(:) !upward longwave radiation above the canopy [W/m2] + real(r8), pointer :: eflx_lh_tot(:) !total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_u(:) !urban total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_tot_r(:) !rural total latent heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_grnd(:) !ground evaporation heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_soil_grnd(:) !soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_u(:) !urban soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_soil_grnd_r(:) !rural soil heat flux (W/m**2) [+ = into soil] + real(r8), pointer :: eflx_sh_tot(:) !total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_u(:) !urban total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_tot_r(:) !rural total sensible heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_grnd(:) !sensible heat flux from ground (W/m**2) [+ to atm] + real(r8), pointer :: eflx_sh_veg(:) !sensible heat flux from leaves (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vege(:) !veg evaporation heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_lh_vegt(:) !veg transpiration heat flux (W/m**2) [+ to atm] + real(r8), pointer :: eflx_wasteheat_pft(:) !sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac_pft(:) !sensible heat flux put back into canyon due to removal by AC (W/m**2) + real(r8), pointer :: eflx_traffic_pft(:) !traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_anthro(:) !total anthropogenic heat flux (W/m**2) + real(r8), pointer :: cgrnd(:) !deriv. of soil energy flux wrt to soil temp [w/m2/k] + real(r8), pointer :: cgrndl(:) !deriv. of soil latent heat flux wrt soil temp [w/m**2/k] + real(r8), pointer :: cgrnds(:) !deriv. of soil sensible heat flux wrt soil temp [w/m2/k] + real(r8), pointer :: eflx_gnet(:) !net heat flux into ground (W/m**2) + real(r8), pointer :: dgnetdT(:) !derivative of net ground heat flux wrt soil temp (W/m**2 K) + real(r8), pointer :: eflx_lwrad_out(:) !emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: eflx_lwrad_net(:) !net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_u(:) !urban net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: eflx_lwrad_net_r(:) !rural net infrared (longwave) rad (W/m**2) [+ = to atm] + real(r8), pointer :: netrad(:) !net radiation (W/m**2) [+ = to sfc] + real(r8), pointer :: fsds_vis_d(:) !incident direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_d(:) !incident direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_i(:) !incident diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsds_nir_i(:) !incident diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_d(:) !reflected direct beam vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_d(:) !reflected direct beam nir solar radiation (W/m**2) + real(r8), pointer :: fsr_vis_i(:) !reflected diffuse vis solar radiation (W/m**2) + real(r8), pointer :: fsr_nir_i(:) !reflected diffuse nir solar radiation (W/m**2) + real(r8), pointer :: fsds_vis_d_ln(:) !incident direct beam vis solar radiation at local noon (W/m**2) + real(r8), pointer :: fsds_nir_d_ln(:) !incident direct beam nir solar radiation at local noon (W/m**2) + real(r8), pointer :: fsr_vis_d_ln(:) !reflected direct beam vis solar radiation at local noon (W/m**2) + real(r8), pointer :: fsr_nir_d_ln(:) !reflected direct beam nir solar radiation at local noon (W/m**2) + real(r8), pointer :: sun_add(:,:) !sun canopy absorbed direct from direct (W/m**2) + real(r8), pointer :: tot_aid(:,:) !total canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sun_aid(:,:) !sun canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sun_aii(:,:) !sun canopy absorbed indirect from indirect (W/m**2) + real(r8), pointer :: sha_aid(:,:) !shade canopy absorbed indirect from direct (W/m**2) + real(r8), pointer :: sha_aii(:,:) !shade canopy absorbed indirect from indirect (W/m**2) + real(r8), pointer :: sun_atot(:,:) !sun canopy total absorbed (W/m**2) + real(r8), pointer :: sha_atot(:,:) !shade canopy total absorbed (W/m**2) + real(r8), pointer :: sun_alf(:,:) !sun canopy total absorbed by leaves (W/m**2) + real(r8), pointer :: sha_alf(:,:) !shade canopy total absored by leaves (W/m**2) + real(r8), pointer :: sun_aperlai(:,:) !sun canopy total absorbed per unit LAI (W/m**2) + real(r8), pointer :: sha_aperlai(:,:) !shade canopy total absorbed per unit LAI (W/m**2) + real(r8), pointer :: sabg_lyr(:,:) ! absorbed radiation in each snow layer and top soil layer (pft,lyr) [W/m2] + real(r8), pointer :: sfc_frc_aer(:) ! surface forcing of snow with all aerosols (pft) [W/m2] + real(r8), pointer :: sfc_frc_bc(:) ! surface forcing of snow with BC (pft) [W/m2] + real(r8), pointer :: sfc_frc_oc(:) ! surface forcing of snow with OC (pft) [W/m2] + real(r8), pointer :: sfc_frc_dst(:) ! surface forcing of snow with dust (pft) [W/m2] + real(r8), pointer :: sfc_frc_aer_sno(:)! surface forcing of snow with all aerosols, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_bc_sno(:) ! surface forcing of snow with BC, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_oc_sno(:) ! surface forcing of snow with OC, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: sfc_frc_dst_sno(:)! surface forcing of snow with dust, averaged only when snow is present (pft) [W/m2] + real(r8), pointer :: fsr_sno_vd(:) ! reflected direct beam vis solar radiation from snow (W/m**2) + real(r8), pointer :: fsr_sno_nd(:) ! reflected direct beam NIR solar radiation from snow (W/m**2) + real(r8), pointer :: fsr_sno_vi(:) ! reflected diffuse vis solar radiation from snow (W/m**2) + real(r8), pointer :: fsr_sno_ni(:) ! reflected diffuse NIR solar radiation from snow (W/m**2) + real(r8), pointer :: fsds_sno_vd(:) ! incident visible, direct radiation on snow (for history files) [W/m2] + real(r8), pointer :: fsds_sno_nd(:) ! incident near-IR, direct radiation on snow (for history files) [W/m2] + real(r8), pointer :: fsds_sno_vi(:) ! incident visible, diffuse radiation on snow (for history files) [W/m2] + real(r8), pointer :: fsds_sno_ni(:) ! incident near-IR, diffuse radiation on snow (for history files) [W/m2] +end type pft_eflux_type + +type(pft_eflux_type) :: pef !pft energy flux + +!---------------------------------------------------- +! pft momentum flux variables structure +!---------------------------------------------------- +type, public :: pft_mflux_type + real(r8),pointer :: taux(:) !wind (shear) stress: e-w (kg/m/s**2) + real(r8),pointer :: tauy(:) !wind (shear) stress: n-s (kg/m/s**2) +end type pft_mflux_type + +type(pft_mflux_type) :: pmf !pft momentum flux + +!---------------------------------------------------- +! pft water flux variables structure +!---------------------------------------------------- +type, public :: pft_wflux_type + real(r8), pointer :: qflx_prec_intr(:) !interception of precipitation [mm/s] + real(r8), pointer :: qflx_prec_grnd(:) !water onto ground including canopy runoff [kg/(m2 s)] + real(r8), pointer :: qflx_rain_grnd(:) !rain on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snow_grnd(:) !snow on ground after interception (mm H2O/s) [+] + real(r8), pointer :: qflx_snwcp_ice(:) !excess snowfall due to snow capping (mm H2O /s) [+] + real(r8), pointer :: qflx_snwcp_liq(:) !excess rainfall due to snow capping (mm H2O /s) [+] + real(r8), pointer :: qflx_evap_veg(:) !vegetation evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_tran_veg(:) !vegetation transpiration (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_can(:) !evaporation from leaves and stems + real(r8), pointer :: qflx_evap_soi(:) !soil evaporation (mm H2O/s) (+ = to atm) + real(r8), pointer :: qflx_evap_tot(:) !qflx_evap_soi + qflx_evap_can + qflx_tran_veg + real(r8), pointer :: qflx_evap_grnd(:) !ground surface evaporation rate (mm H2O/s) [+] + real(r8), pointer :: qflx_dew_grnd(:) !ground surface dew formation (mm H2O /s) [+] + real(r8), pointer :: qflx_sub_snow(:) !sublimation rate from snow pack (mm H2O /s) [+] + real(r8), pointer :: qflx_dew_snow(:) !surface dew added to snow pack (mm H2O /s) [+] +end type pft_wflux_type + +type(pft_wflux_type) :: pwf !pft water flux + +!---------------------------------------------------- +! pft carbon flux variables structure +!---------------------------------------------------- +type, public :: pft_cflux_type + real(r8), pointer :: psnsun(:) !sunlit leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: psnsha(:) !shaded leaf photosynthesis (umol CO2 /m**2/ s) + real(r8), pointer :: fpsn(:) !photosynthesis (umol CO2 /m**2 /s) + real(r8), pointer :: fco2(:) !net CO2 flux (umol CO2 /m**2 /s) [+ = to atm] + ! new variables for CN code + ! gap mortality fluxes + real(r8), pointer :: m_leafc_to_litter(:) ! leaf C mortality (gC/m2/s) + real(r8), pointer :: m_leafc_storage_to_litter(:) ! leaf C storage mortality (gC/m2/s) + real(r8), pointer :: m_leafc_xfer_to_litter(:) ! leaf C transfer mortality (gC/m2/s) + real(r8), pointer :: m_frootc_to_litter(:) ! fine root C mortality (gC/m2/s) + real(r8), pointer :: m_frootc_storage_to_litter(:) ! fine root C storage mortality (gC/m2/s) + real(r8), pointer :: m_frootc_xfer_to_litter(:) ! fine root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_to_litter(:) ! live stem C mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_storage_to_litter(:) ! live stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_livestemc_xfer_to_litter(:) ! live stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_litter(:) ! dead stem C mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_storage_to_litter(:) ! dead stem C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadstemc_xfer_to_litter(:) ! dead stem C transfer mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_to_litter(:) ! live coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_storage_to_litter(:) ! live coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_livecrootc_xfer_to_litter(:) ! live coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_litter(:) ! dead coarse root C mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_storage_to_litter(:) ! dead coarse root C storage mortality (gC/m2/s) + real(r8), pointer :: m_deadcrootc_xfer_to_litter(:) ! dead coarse root C transfer mortality (gC/m2/s) + real(r8), pointer :: m_gresp_storage_to_litter(:) ! growth respiration storage mortality (gC/m2/s) + real(r8), pointer :: m_gresp_xfer_to_litter(:) ! growth respiration transfer mortality (gC/m2/s) + ! harvest mortality fluxes + real(r8), pointer :: hrv_leafc_to_litter(:) ! leaf C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) ! leaf C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) ! leaf C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litter(:) ! fine root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) ! fine root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) ! fine root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_to_litter(:) ! live stem C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) ! live stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) ! live stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) ! dead stem C harvest to 10-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) ! dead stem C harvest to 100-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) ! dead stem C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) ! dead stem C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_to_litter(:) ! live coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) ! live coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) ! live coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) ! dead coarse root C harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) ! dead coarse root C storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) ! dead coarse root C transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) ! growth respiration storage harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) ! growth respiration transfer harvest mortality (gC/m2/s) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) ! excess MR pool harvest mortality (gC/m2/s) + ! PFT-level fire fluxes + real(r8), pointer :: m_leafc_to_fire(:) ! leaf C fire loss (gC/m2/s) + real(r8), pointer :: m_leafc_storage_to_fire(:) ! leaf C storage fire loss (gC/m2/s) + real(r8), pointer :: m_leafc_xfer_to_fire(:) ! leaf C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_frootc_to_fire(:) ! fine root C fire loss (gC/m2/s) + real(r8), pointer :: m_frootc_storage_to_fire(:) ! fine root C storage fire loss (gC/m2/s) + real(r8), pointer :: m_frootc_xfer_to_fire(:) ! fine root C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_livestemc_to_fire(:) ! live stem C fire loss (gC/m2/s) + real(r8), pointer :: m_livestemc_storage_to_fire(:) ! live stem C storage fire loss (gC/m2/s) + real(r8), pointer :: m_livestemc_xfer_to_fire(:) ! live stem C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_fire(:) ! dead stem C fire loss (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_litter_fire(:) ! dead stem C fire mortality to litter (gC/m2/s) + real(r8), pointer :: m_deadstemc_storage_to_fire(:) ! dead stem C storage fire loss (gC/m2/s) + real(r8), pointer :: m_deadstemc_xfer_to_fire(:) ! dead stem C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_livecrootc_to_fire(:) ! live coarse root C fire loss (gC/m2/s) + real(r8), pointer :: m_livecrootc_storage_to_fire(:) ! live coarse root C storage fire loss (gC/m2/s) + real(r8), pointer :: m_livecrootc_xfer_to_fire(:) ! live coarse root C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_fire(:) ! dead coarse root C fire loss (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_litter_fire(:) ! dead coarse root C fire mortality to litter (gC/m2/s) + real(r8), pointer :: m_deadcrootc_storage_to_fire(:) ! dead coarse root C storage fire loss (gC/m2/s) + real(r8), pointer :: m_deadcrootc_xfer_to_fire(:) ! dead coarse root C transfer fire loss (gC/m2/s) + real(r8), pointer :: m_gresp_storage_to_fire(:) ! growth respiration storage fire loss (gC/m2/s) + real(r8), pointer :: m_gresp_xfer_to_fire(:) ! growth respiration transfer fire loss (gC/m2/s) + ! phenology fluxes from transfer pools + real(r8), pointer :: grainc_xfer_to_grainc(:) ! grain C growth from storage for prognostic crop(gC/m2/s) + real(r8), pointer :: leafc_xfer_to_leafc(:) ! leaf C growth from storage (gC/m2/s) + real(r8), pointer :: frootc_xfer_to_frootc(:) ! fine root C growth from storage (gC/m2/s) + real(r8), pointer :: livestemc_xfer_to_livestemc(:) ! live stem C growth from storage (gC/m2/s) + real(r8), pointer :: deadstemc_xfer_to_deadstemc(:) ! dead stem C growth from storage (gC/m2/s) + real(r8), pointer :: livecrootc_xfer_to_livecrootc(:) ! live coarse root C growth from storage (gC/m2/s) + real(r8), pointer :: deadcrootc_xfer_to_deadcrootc(:) ! dead coarse root C growth from storage (gC/m2/s) + ! leaf and fine root litterfall + real(r8), pointer :: leafc_to_litter(:) ! leaf C litterfall (gC/m2/s) + real(r8), pointer :: frootc_to_litter(:) ! fine root C litterfall (gC/m2/s) + real(r8), pointer :: livestemc_to_litter(:) ! live stem C litterfall (gC/m2/s) + real(r8), pointer :: grainc_to_food(:) ! grain C to food for prognostic crop(gC/m2/s) + ! maintenance respiration fluxes + real(r8), pointer :: leaf_mr(:) ! leaf maintenance respiration (gC/m2/s) + real(r8), pointer :: froot_mr(:) ! fine root maintenance respiration (gC/m2/s) + real(r8), pointer :: livestem_mr(:) ! live stem maintenance respiration (gC/m2/s) + real(r8), pointer :: livecroot_mr(:) ! live coarse root maintenance respiration (gC/m2/s) + real(r8), pointer :: leaf_curmr(:) ! leaf maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: froot_curmr(:) ! fine root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livestem_curmr(:) ! live stem maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: livecroot_curmr(:) ! live coarse root maintenance respiration from current GPP (gC/m2/s) + real(r8), pointer :: leaf_xsmr(:) ! leaf maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: froot_xsmr(:) ! fine root maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livestem_xsmr(:) ! live stem maintenance respiration from storage (gC/m2/s) + real(r8), pointer :: livecroot_xsmr(:) ! live coarse root maintenance respiration from storage (gC/m2/s) + ! photosynthesis fluxes + real(r8), pointer :: psnsun_to_cpool(:) ! C fixation from sunlit canopy (gC/m2/s) + real(r8), pointer :: psnshade_to_cpool(:) ! C fixation from shaded canopy (gC/m2/s) + ! allocation fluxes, from current GPP + real(r8), pointer :: cpool_to_xsmrpool(:) ! allocation to maintenance respiration storage pool (gC/m2/s) + real(r8), pointer :: cpool_to_grainc(:) ! allocation to grain C for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_grainc_storage(:) ! allocation to grain C storage for prognostic crop(gC/m2/s) + real(r8), pointer :: cpool_to_leafc(:) ! allocation to leaf C (gC/m2/s) + real(r8), pointer :: cpool_to_leafc_storage(:) ! allocation to leaf C storage (gC/m2/s) + real(r8), pointer :: cpool_to_frootc(:) ! allocation to fine root C (gC/m2/s) + real(r8), pointer :: cpool_to_frootc_storage(:) ! allocation to fine root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc(:) ! allocation to live stem C (gC/m2/s) + real(r8), pointer :: cpool_to_livestemc_storage(:) ! allocation to live stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc(:) ! allocation to dead stem C (gC/m2/s) + real(r8), pointer :: cpool_to_deadstemc_storage(:) ! allocation to dead stem C storage (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc(:) ! allocation to live coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_livecrootc_storage(:) ! allocation to live coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc(:) ! allocation to dead coarse root C (gC/m2/s) + real(r8), pointer :: cpool_to_deadcrootc_storage(:) ! allocation to dead coarse root C storage (gC/m2/s) + real(r8), pointer :: cpool_to_gresp_storage(:) ! allocation to growth respiration storage (gC/m2/s) + ! growth respiration fluxes + real(r8), pointer :: xsmrpool_to_atm(:) ! excess MR pool harvest mortality (gC/m2/s) + real(r8), pointer :: cpool_leaf_gr(:) ! leaf growth respiration (gC/m2/s) + real(r8), pointer :: cpool_leaf_storage_gr(:) ! leaf growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_leaf_gr(:) ! leaf growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_froot_gr(:) ! fine root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_froot_storage_gr(:) ! fine root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_froot_gr(:) ! fine root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livestem_gr(:) ! live stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livestem_storage_gr(:) ! live stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livestem_gr(:) ! live stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadstem_gr(:) ! dead stem growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadstem_storage_gr(:) ! dead stem growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadstem_gr(:) ! dead stem growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_livecroot_gr(:) ! live coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_livecroot_storage_gr(:) ! live coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_livecroot_gr(:) ! live coarse root growth respiration from storage (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_gr(:) ! dead coarse root growth respiration (gC/m2/s) + real(r8), pointer :: cpool_deadcroot_storage_gr(:) ! dead coarse root growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_deadcroot_gr(:) ! dead coarse root growth respiration from storage (gC/m2/s) + ! growth respiration for prognostic crop model + real(r8), pointer :: cpool_grain_gr(:) ! grain growth respiration (gC/m2/s) + real(r8), pointer :: cpool_grain_storage_gr(:) ! grain growth respiration to storage (gC/m2/s) + real(r8), pointer :: transfer_grain_gr(:) ! grain growth respiration from storage (gC/m2/s) + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainc_storage_to_xfer(:) ! grain C shift storage to transfer for prognostic crop model (gC/m2/s) + real(r8), pointer :: leafc_storage_to_xfer(:) ! leaf C shift storage to transfer (gC/m2/s) + real(r8), pointer :: frootc_storage_to_xfer(:) ! fine root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livestemc_storage_to_xfer(:) ! live stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadstemc_storage_to_xfer(:) ! dead stem C shift storage to transfer (gC/m2/s) + real(r8), pointer :: livecrootc_storage_to_xfer(:) ! live coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: deadcrootc_storage_to_xfer(:) ! dead coarse root C shift storage to transfer (gC/m2/s) + real(r8), pointer :: gresp_storage_to_xfer(:) ! growth respiration shift storage to transfer (gC/m2/s) + ! turnover of livewood to deadwood + real(r8), pointer :: livestemc_to_deadstemc(:) ! live stem C turnover (gC/m2/s) + real(r8), pointer :: livecrootc_to_deadcrootc(:) ! live coarse root C turnover (gC/m2/s) + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: gpp(:) ! (gC/m2/s) gross primary production + real(r8), pointer :: mr(:) ! (gC/m2/s) maintenance respiration + real(r8), pointer :: current_gr(:) ! (gC/m2/s) growth resp for new growth displayed in this timestep + real(r8), pointer :: transfer_gr(:) ! (gC/m2/s) growth resp for transfer growth displayed in this timestep + real(r8), pointer :: storage_gr(:) ! (gC/m2/s) growth resp for growth sent to storage for later display + real(r8), pointer :: gr(:) ! (gC/m2/s) total growth respiration + real(r8), pointer :: ar(:) ! (gC/m2/s) autotrophic respiration (MR + GR) + real(r8), pointer :: rr(:) ! (gC/m2/s) root respiration (fine root MR + total root GR) + real(r8), pointer :: npp(:) ! (gC/m2/s) net primary production + real(r8), pointer :: agnpp(:) ! (gC/m2/s) aboveground NPP + real(r8), pointer :: bgnpp(:) ! (gC/m2/s) belowground NPP + real(r8), pointer :: litfall(:) ! (gC/m2/s) litterfall (leaves and fine roots) + real(r8), pointer :: vegfire(:) ! (gC/m2/s) pft-level fire loss (obsolete, mark for removal) + real(r8), pointer :: wood_harvestc(:) ! (gC/m2/s) pft-level wood harvest (to product pools) + real(r8), pointer :: pft_cinputs(:) ! (gC/m2/s) pft-level carbon inputs (for balance checking) + real(r8), pointer :: pft_coutputs(:) ! (gC/m2/s) pft-level carbon outputs (for balance checking) + ! CLAMP summary (diagnostic) variables, not involved in mass balance + real(r8), pointer :: frootc_alloc(:) ! (gC/m2/s) pft-level fine root C alloc + real(r8), pointer :: frootc_loss(:) ! (gC/m2/s) pft-level fine root C loss + real(r8), pointer :: leafc_alloc(:) ! (gC/m2/s) pft-level leaf C alloc + real(r8), pointer :: leafc_loss(:) ! (gC/m2/s) pft-level leaf C loss + real(r8), pointer :: woodc_alloc(:) ! (gC/m2/s) pft-level wood C alloc + real(r8), pointer :: woodc_loss(:) ! (gC/m2/s) pft-level wood C loss + ! new variables for fire code + real(r8), pointer :: pft_fire_closs(:) ! (gC/m2/s) total pft-level fire C loss +end type pft_cflux_type + +type(pft_cflux_type) :: pcf !pft carbon flux +type(pft_cflux_type) :: pcf_a !pft carbon flux averaged to the column +type(pft_cflux_type) :: pc13f !pft carbon-13 flux +type(pft_cflux_type) :: pc13f_a !pft carbon-13 flux averaged to the column + +!---------------------------------------------------- +! pft nitrogen flux variables structure +!---------------------------------------------------- +type, public :: pft_nflux_type + ! new variables for CN code + ! gap mortality fluxes + real(r8), pointer :: m_leafn_to_litter(:) ! leaf N mortality (gN/m2/s) + real(r8), pointer :: m_frootn_to_litter(:) ! fine root N mortality (gN/m2/s) + real(r8), pointer :: m_leafn_storage_to_litter(:) ! leaf N storage mortality (gN/m2/s) + real(r8), pointer :: m_frootn_storage_to_litter(:) ! fine root N storage mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_storage_to_litter(:) ! live stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_storage_to_litter(:) ! dead stem N storage mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_storage_to_litter(:) ! live coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_storage_to_litter(:) ! dead coarse root N storage mortality (gN/m2/s) + real(r8), pointer :: m_leafn_xfer_to_litter(:) ! leaf N transfer mortality (gN/m2/s) + real(r8), pointer :: m_frootn_xfer_to_litter(:) ! fine root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_xfer_to_litter(:) ! live stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_xfer_to_litter(:) ! dead stem N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_xfer_to_litter(:) ! live coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_xfer_to_litter(:) ! dead coarse root N transfer mortality (gN/m2/s) + real(r8), pointer :: m_livestemn_to_litter(:) ! live stem N mortality (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_litter(:) ! dead stem N mortality (gN/m2/s) + real(r8), pointer :: m_livecrootn_to_litter(:) ! live coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_litter(:) ! dead coarse root N mortality (gN/m2/s) + real(r8), pointer :: m_retransn_to_litter(:) ! retranslocated N pool mortality (gN/m2/s) + ! harvest mortality fluxes + real(r8), pointer :: hrv_leafn_to_litter(:) ! leaf N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_to_litter(:) ! fine root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_storage_to_litter(:) ! leaf N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_storage_to_litter(:) ! fine root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_storage_to_litter(:) ! live stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_storage_to_litter(:) ! dead stem N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_storage_to_litter(:) ! live coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:) ! dead coarse root N storage harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_leafn_xfer_to_litter(:) ! leaf N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_frootn_xfer_to_litter(:) ! fine root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_xfer_to_litter(:) ! live stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:) ! dead stem N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:) ! live coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:) ! dead coarse root N transfer harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_livestemn_to_litter(:) ! live stem N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod10n(:) ! dead stem N harvest to 10-year product pool (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod100n(:) ! dead stem N harvest to 100-year product pool (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_to_litter(:) ! live coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_to_litter(:) ! dead coarse root N harvest mortality (gN/m2/s) + real(r8), pointer :: hrv_retransn_to_litter(:) ! retranslocated N pool harvest mortality (gN/m2/s) + ! fire mortality fluxes + real(r8), pointer :: m_leafn_to_fire(:) ! leaf N fire loss (gN/m2/s) + real(r8), pointer :: m_leafn_storage_to_fire(:) ! leaf N storage fire loss (gN/m2/s) + real(r8), pointer :: m_leafn_xfer_to_fire(:) ! leaf N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_frootn_to_fire(:) ! fine root N fire loss (gN/m2/s) + real(r8), pointer :: m_frootn_storage_to_fire(:) ! fine root N storage fire loss (gN/m2/s) + real(r8), pointer :: m_frootn_xfer_to_fire(:) ! fine root N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_livestemn_to_fire(:) ! live stem N fire loss (gN/m2/s) + real(r8), pointer :: m_livestemn_storage_to_fire(:) ! live stem N storage fire loss (gN/m2/s) + real(r8), pointer :: m_livestemn_xfer_to_fire(:) ! live stem N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_fire(:) ! dead stem N fire loss (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_litter_fire(:) ! dead stem N fire mortality to litter (gN/m2/s) + real(r8), pointer :: m_deadstemn_storage_to_fire(:) ! dead stem N storage fire loss (gN/m2/s) + real(r8), pointer :: m_deadstemn_xfer_to_fire(:) ! dead stem N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_livecrootn_to_fire(:) ! live coarse root N fire loss (gN/m2/s) + real(r8), pointer :: m_livecrootn_storage_to_fire(:) ! live coarse root N storage fire loss (gN/m2/s) + real(r8), pointer :: m_livecrootn_xfer_to_fire(:) ! live coarse root N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_fire(:) ! dead coarse root N fire loss (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_litter_fire(:) ! dead coarse root N fire mortality to litter (gN/m2/s) + real(r8), pointer :: m_deadcrootn_storage_to_fire(:) ! dead coarse root N storage fire loss (gN/m2/s) + real(r8), pointer :: m_deadcrootn_xfer_to_fire(:) ! dead coarse root N transfer fire loss (gN/m2/s) + real(r8), pointer :: m_retransn_to_fire(:) ! retranslocated N pool fire loss (gN/m2/s) + ! phenology fluxes from transfer pool + real(r8), pointer :: grainn_xfer_to_grainn(:) ! grain N growth from storage for prognostic crop model (gN/m2/s) + real(r8), pointer :: leafn_xfer_to_leafn(:) ! leaf N growth from storage (gN/m2/s) + real(r8), pointer :: frootn_xfer_to_frootn(:) ! fine root N growth from storage (gN/m2/s) + real(r8), pointer :: livestemn_xfer_to_livestemn(:) ! live stem N growth from storage (gN/m2/s) + real(r8), pointer :: deadstemn_xfer_to_deadstemn(:) ! dead stem N growth from storage (gN/m2/s) + real(r8), pointer :: livecrootn_xfer_to_livecrootn(:) ! live coarse root N growth from storage (gN/m2/s) + real(r8), pointer :: deadcrootn_xfer_to_deadcrootn(:) ! dead coarse root N growth from storage (gN/m2/s) + ! litterfall fluxes + real(r8), pointer :: livestemn_to_litter(:) ! livestem N to litter (gN/m2/s) + real(r8), pointer :: grainn_to_food(:) ! grain N to food for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_to_litter(:) ! leaf N litterfall (gN/m2/s) + real(r8), pointer :: leafn_to_retransn(:) ! leaf N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: frootn_to_litter(:) ! fine root N litterfall (gN/m2/s) + ! allocation fluxes + real(r8), pointer :: retransn_to_npool(:) ! deployment of retranslocated N (gN/m2/s) + real(r8), pointer :: sminn_to_npool(:) ! deployment of soil mineral N uptake (gN/m2/s) + real(r8), pointer :: npool_to_grainn(:) ! allocation to grain N for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_grainn_storage(:) ! allocation to grain N storage for prognostic crop (gN/m2/s) + real(r8), pointer :: npool_to_leafn(:) ! allocation to leaf N (gN/m2/s) + real(r8), pointer :: npool_to_leafn_storage(:) ! allocation to leaf N storage (gN/m2/s) + real(r8), pointer :: npool_to_frootn(:) ! allocation to fine root N (gN/m2/s) + real(r8), pointer :: npool_to_frootn_storage(:) ! allocation to fine root N storage (gN/m2/s) + real(r8), pointer :: npool_to_livestemn(:) ! allocation to live stem N (gN/m2/s) + real(r8), pointer :: npool_to_livestemn_storage(:) ! allocation to live stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn(:) ! allocation to dead stem N (gN/m2/s) + real(r8), pointer :: npool_to_deadstemn_storage(:) ! allocation to dead stem N storage (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn(:) ! allocation to live coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_livecrootn_storage(:) ! allocation to live coarse root N storage (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn(:) ! allocation to dead coarse root N (gN/m2/s) + real(r8), pointer :: npool_to_deadcrootn_storage(:) ! allocation to dead coarse root N storage (gN/m2/s) + ! annual turnover of storage to transfer pools + real(r8), pointer :: grainn_storage_to_xfer(:) ! grain N shift storage to transfer for prognostic crop (gN/m2/s) + real(r8), pointer :: leafn_storage_to_xfer(:) ! leaf N shift storage to transfer (gN/m2/s) + real(r8), pointer :: frootn_storage_to_xfer(:) ! fine root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livestemn_storage_to_xfer(:) ! live stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadstemn_storage_to_xfer(:) ! dead stem N shift storage to transfer (gN/m2/s) + real(r8), pointer :: livecrootn_storage_to_xfer(:) ! live coarse root N shift storage to transfer (gN/m2/s) + real(r8), pointer :: deadcrootn_storage_to_xfer(:) ! dead coarse root N shift storage to transfer (gN/m2/s) + ! turnover of livewood to deadwood, with retranslocation + real(r8), pointer :: livestemn_to_deadstemn(:) ! live stem N turnover (gN/m2/s) + real(r8), pointer :: livestemn_to_retransn(:) ! live stem N to retranslocated N pool (gN/m2/s) + real(r8), pointer :: livecrootn_to_deadcrootn(:) ! live coarse root N turnover (gN/m2/s) + real(r8), pointer :: livecrootn_to_retransn(:) ! live coarse root N to retranslocated N pool (gN/m2/s) + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: ndeploy(:) ! total N deployed to growth and storage (gN/m2/s) + real(r8), pointer :: pft_ninputs(:) ! total N inputs to pft-level (gN/m2/s) + real(r8), pointer :: pft_noutputs(:) ! total N outputs from pft-level (gN/m2/s) + real(r8), pointer :: wood_harvestn(:) ! total N losses to wood product pools (gN/m2/s) + ! new variables for fire code + real(r8), pointer :: pft_fire_nloss(:) ! total pft-level fire N loss (gN/m2/s) +end type pft_nflux_type + +type(pft_nflux_type) :: pnf !pft nitrogen flux +type(pft_nflux_type) :: pnf_a !pft-level nitrogen flux variables averaged to the column + +!---------------------------------------------------- +! pft VOC fluxes structure for history output +!---------------------------------------------------- +type, public :: megan_out_type + real(r8), pointer :: flux_out(:) !(n_megan_comps) MEGAN flux [ug C m-2 h-1] +endtype megan_out_type + +!---------------------------------------------------- +! pft VOC flux variables structure +!---------------------------------------------------- +type, public :: pft_vflux_type + real(r8), pointer :: vocflx_tot(:) !total VOC flux into atmosphere [moles/m2/sec] + real(r8), pointer :: vocflx(:,:) !(num_mech_comps) MEGAN flux [moles/m2/sec] + real(r8), pointer :: Eopt_out(:) !Eopt coefficient + real(r8), pointer :: topt_out(:) !topt coefficient + real(r8), pointer :: alpha_out(:) !alpha coefficient + real(r8), pointer :: cp_out(:) !cp coefficient + real(r8), pointer :: paru_out(:) + real(r8), pointer :: par24u_out(:) + real(r8), pointer :: par240u_out(:) + real(r8), pointer :: para_out(:) + real(r8), pointer :: par24a_out(:) + real(r8), pointer :: par240a_out(:) + real(r8), pointer :: gamma_out(:) + real(r8), pointer :: gammaL_out(:) + real(r8), pointer :: gammaT_out(:) + real(r8), pointer :: gammaP_out(:) + real(r8), pointer :: gammaA_out(:) + real(r8), pointer :: gammaS_out(:) + real(r8), pointer :: gammaC_out(:) + type(megan_out_type), pointer :: meg(:) ! points to output fluxes +end type pft_vflux_type + +type(pft_vflux_type) :: pvf !pft VOC flux + +!---------------------------------------------------- +! pft dry dep velocity variables structure +!---------------------------------------------------- +type, public :: pft_depvd_type + real(r8), pointer :: drydepvel(:,:) +end type pft_depvd_type + +type(pft_depvd_type) :: pdd !dry dep velocity + +!---------------------------------------------------- +! pft dust flux variables structure +!---------------------------------------------------- +type, public :: pft_dflux_type + real(r8), pointer :: flx_mss_vrt_dst(:,:) !(ndst) !surface dust emission (kg/m**2/s) [ + = to atm] + real(r8), pointer :: flx_mss_vrt_dst_tot(:) !total dust flux into atmosphere + real(r8), pointer :: vlc_trb(:,:) !(ndst) turbulent deposition velocity (m/s) + real(r8), pointer :: vlc_trb_1(:) !turbulent deposition velocity 1(m/s) + real(r8), pointer :: vlc_trb_2(:) !turbulent deposition velocity 2(m/s) + real(r8), pointer :: vlc_trb_3(:) !turbulent deposition velocity 3(m/s) + real(r8), pointer :: vlc_trb_4(:) !turbulent deposition velocity 4(m/s) +end type pft_dflux_type + +type(pft_dflux_type) :: pdf !pft dust flux + +!---------------------------------------------------- +! End definition of structures defined at the pft_type level +!---------------------------------------------------- +!******************************************************************************* + + +!******************************************************************************* +!---------------------------------------------------- +! Begin definition of structures defined at the column_type level +!---------------------------------------------------- +! column physical state variables structure +!---------------------------------------------------- +type, public :: column_pstate_type + integer , pointer :: snl(:) !number of snow layers + integer , pointer :: isoicol(:) !soil color class + real(r8), pointer :: bsw(:,:) !Clapp and Hornberger "b" (nlevgrnd) + real(r8), pointer :: watsat(:,:) !volumetric soil water at saturation (porosity) (nlevgrnd) + real(r8), pointer :: watdry(:,:) !btran parameter for btran=0 + real(r8), pointer :: watopt(:,:) !btran parameter for btran = 1 + real(r8), pointer :: hksat(:,:) !hydraulic conductivity at saturation (mm H2O /s) (nlevgrnd) + real(r8), pointer :: sucsat(:,:) !minimum soil suction (mm) (nlevgrnd) + real(r8), pointer :: hkdepth(:) !decay factor (m) + real(r8), pointer :: wtfact(:) !maximum saturated fraction for a gridcell + real(r8), pointer :: fracice(:,:) !fractional impermeability (-) + real(r8), pointer :: csol(:,:) !heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) + real(r8), pointer :: tkmg(:,:) !thermal conductivity, soil minerals [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: tkdry(:,:) !thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) + real(r8), pointer :: tksatu(:,:) !thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: smpmin(:) !restriction for min of soil potential (mm) (new) + real(r8), pointer :: gwc_thr(:) !threshold soil moisture based on clay content + real(r8), pointer :: mss_frc_cly_vld(:) ![frc] Mass fraction clay limited to 0.20 + real(r8), pointer :: mbl_bsn_fct(:) !basin factor + logical , pointer :: do_capsnow(:) !true => do snow capping + real(r8), pointer :: snowdp(:) !snow height (m) + real(r8), pointer :: frac_sno(:) !fraction of ground covered by snow (0 to 1) + !real(r8), pointer :: res_sno(:) !residual snow when snl -> 0 + !real(r8), pointer :: topo_ndx(:) !gridcell topographic index + !real(r8), pointer :: topo_slope(:) !gridcell topographic slope + !real(r8), pointer :: var_track(:) !generic variable to track... + !real(r8), pointer :: var_track2(:) !generic variable to track... + real(r8), pointer :: zi(:,:) !interface level below a "z" level (m) (-nlevsno+0:nlevgrnd) + real(r8), pointer :: dz(:,:) !layer thickness (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: z(:,:) !layer depth (m) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: frac_iceold(:,:) !fraction of ice relative to the tot water (new) (-nlevsno+1:nlevgrnd) + integer , pointer :: imelt(:,:) !flag for melting (=1), freezing (=2), Not=0 (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: eff_porosity(:,:) !effective porosity = porosity - vol_ice (nlevgrnd) + real(r8), pointer :: emg(:) !ground emissivity + real(r8), pointer :: z0mg(:) !roughness length over ground, momentum [m] + real(r8), pointer :: z0hg(:) !roughness length over ground, sensible heat [m] + real(r8), pointer :: z0qg(:) !roughness length over ground, latent heat [m] + real(r8), pointer :: htvp(:) !latent heat of vapor of water (or sublimation) [j/kg] + real(r8), pointer :: beta(:) !coefficient of convective velocity [-] + real(r8), pointer :: zii(:) !convective boundary height [m] + real(r8), pointer :: albgrd(:,:) !ground albedo (direct) (numrad) + real(r8), pointer :: albgri(:,:) !ground albedo (diffuse) (numrad) + real(r8), pointer :: rootr_column(:,:) !effective fraction of roots in each soil layer (nlevgrnd) + real(r8), pointer :: rootfr_road_perv(:,:) !fraction of roots in each soil layer for urban pervious road + real(r8), pointer :: rootr_road_perv(:,:) !effective fraction of roots in each soil layer of urban pervious road + real(r8), pointer :: wf(:) !soil water as frac. of whc for top 0.5 m +! real(r8), pointer :: xirrig(:) !irrigation rate + real(r8), pointer :: max_dayl(:) !maximum daylength for this column (s) + ! new variables for CN code + real(r8), pointer :: bsw2(:,:) !Clapp and Hornberger "b" for CN code + real(r8), pointer :: psisat(:,:) !soil water potential at saturation for CN code (MPa) + real(r8), pointer :: vwcsat(:,:) !volumetric water content at saturation for CN code (m3/m3) + real(r8), pointer :: decl(:) ! solar declination angle (radians) + real(r8), pointer :: coszen(:) !cosine of solar zenith angle + real(r8), pointer :: soilpsi(:,:) !soil water potential in each soil layer (MPa) + real(r8), pointer :: fpi(:) !fraction of potential immobilization (no units) + real(r8), pointer :: fpg(:) !fraction of potential gpp (no units) + real(r8), pointer :: annsum_counter(:) !seconds since last annual accumulator turnover + real(r8), pointer :: cannsum_npp(:) !annual sum of NPP, averaged from pft-level (gC/m2/yr) + real(r8), pointer :: cannavg_t2m(:) !annual average of 2m air temperature, averaged from pft-level (K) + real(r8), pointer :: watfc(:,:) !volumetric soil water at field capacity (nlevsoi) + ! new variables for fire code + real(r8), pointer :: me(:) !moisture of extinction (proportion) + real(r8), pointer :: fire_prob(:) !daily fire probability (0-1) + real(r8), pointer :: mean_fire_prob(:) !e-folding mean of daily fire probability (0-1) + real(r8), pointer :: fireseasonl(:) !annual fire season length (days, <= days/year) + real(r8), pointer :: farea_burned(:) !timestep fractional area burned (proportion) + real(r8), pointer :: ann_farea_burned(:) !annual total fractional area burned (proportion) + real(r8), pointer :: albsnd_hst(:,:) ! snow albedo, direct, for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst(:,:) ! snow albedo, diffuse, for history files (col,bnd) [frc] + real(r8), pointer :: albsod(:,:) ! soil albedo: direct (col,bnd) [frc] + real(r8), pointer :: albsoi(:,:) ! soil albedo: diffuse (col,bnd) [frc] + real(r8), pointer :: flx_absdv(:,:) ! absorbed flux per unit incident direct flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absdn(:,:) ! absorbed flux per unit incident direct flux: NIR (col,lyr) [frc] + real(r8), pointer :: flx_absiv(:,:) ! absorbed flux per unit incident diffuse flux: VIS (col,lyr) [frc] + real(r8), pointer :: flx_absin(:,:) ! absorbed flux per unit incident diffuse flux: NIR (col,lyr) [frc] + real(r8), pointer :: snw_rds(:,:) ! snow grain radius (col,lyr) [m^-6, microns] + real(r8), pointer :: snw_rds_top(:) ! snow grain radius, top layer (col) [m^-6, microns] + real(r8), pointer :: sno_liq_top(:) ! snow liquid water fraction (mass), top layer (col) [fraction] + real(r8), pointer :: mss_bcpho(:,:) ! mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcphi(:,:) ! mass of hydrophillic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bctot(:,:) ! total mass of BC in snow (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_bc_col(:) ! column-integrated mass of total BC (col) [kg] + real(r8), pointer :: mss_bc_top(:) ! top-layer mass of total BC (col) [kg] + real(r8), pointer :: mss_ocpho(:,:) ! mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! mass of hydrophillic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_octot(:,:) ! total mass of OC in snow (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_oc_col(:) ! column-integrated mass of total OC (col) [kg] + real(r8), pointer :: mss_oc_top(:) ! top-layer mass of total OC (col) [kg] + real(r8), pointer :: mss_dst1(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dsttot(:,:) ! total mass of dust in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst_col(:) ! column-integrated mass of dust in snow (col) [kg] + real(r8), pointer :: mss_dst_top(:) ! top-layer mass of dust in snow (col) [kg] + real(r8), pointer :: h2osno_top(:) ! top-layer mass of snow (col) [kg] + real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of hydrophilic BC in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of hydrophilic OC in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst1(:,:) ! mass concentration of dust species 1 in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst2(:,:) ! mass concentration of dust species 2 in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst3(:,:) ! mass concentration of dust species 3 in snow (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst4(:,:) ! mass concentration of dust species 4 in snow (col,lyr) [kg/kg] + real(r8), pointer :: albgrd_pur(:,:) ! pure snow ground direct albedo (numrad) + real(r8), pointer :: albgri_pur(:,:) ! pure snow ground diffuse albedo (numrad) + real(r8), pointer :: albgrd_bc(:,:) ! ground direct albedo without BC (numrad) + real(r8), pointer :: albgri_bc(:,:) ! ground diffuse albedo without BC (numrad) + real(r8), pointer :: albgrd_oc(:,:) ! ground direct albedo without OC (numrad) + real(r8), pointer :: albgri_oc(:,:) ! ground diffuse albedo without OC (numrad) + real(r8), pointer :: albgrd_dst(:,:) ! ground direct albedo without dust (numrad) + real(r8), pointer :: albgri_dst(:,:) ! ground diffuse albedo without dust (numrad) + real(r8), pointer :: dTdz_top(:) ! temperature gradient in top layer [K m-1] + real(r8), pointer :: snot_top(:) ! temperature of top snow layer [K] + real(r8), pointer :: irrig_rate(:) ! current irrigation rate [mm/s] + integer, pointer :: n_irrig_steps_left(:) ! number of time steps for which we still need to irrigate today (if 0, ignore irrig_rate) + real(r8), pointer :: forc_pbot(:) ! surface atm pressure, downscaled to column (Pa) + real(r8), pointer :: forc_rho(:) ! surface air density, downscaled to column (kg/m^3) + real(r8), pointer :: glc_frac(:) ! ice fractional area + real(r8), pointer :: glc_topo(:) ! surface elevation (m) +end type column_pstate_type + +type(column_pstate_type) :: cps !column physical state variables + +!---------------------------------------------------- +! column energy state variables structure +!---------------------------------------------------- +type, public :: column_estate_type + real(r8), pointer :: t_grnd(:) !ground temperature (Kelvin) + real(r8), pointer :: t_grnd_u(:) !Urban ground temperature (Kelvin) + real(r8), pointer :: t_grnd_r(:) !Rural ground temperature (Kelvin) + real(r8), pointer :: dt_grnd(:) !change in t_grnd, last iteration (Kelvin) + real(r8), pointer :: t_soisno(:,:) !soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: t_soi_10cm(:) !soil temperature in top 10cm of soil (Kelvin) + real(r8), pointer :: t_lake(:,:) !lake temperature (Kelvin) (1:nlevlak) + real(r8), pointer :: tssbef(:,:) !soil/snow temperature before update (-nlevsno+1:nlevgrnd) + real(r8), pointer :: thv(:) !virtual potential temperature (kelvin) + real(r8), pointer :: hc_soi(:) !soil heat content (MJ/m2) + real(r8), pointer :: hc_soisno(:) !soil plus snow heat content (MJ/m2) + real(r8), pointer :: forc_t(:) !atm temperature, downscaled to column (Kelvin) + real(r8), pointer :: forc_th(:) !atm potl temperature, downscaled to column (Kelvin) +end type column_estate_type + +type(column_estate_type) :: ces !column energy state + +!---------------------------------------------------- +! column water state variables structure +!---------------------------------------------------- +type, public :: column_wstate_type + real(r8), pointer :: h2osno(:) !snow water (mm H2O) + real(r8), pointer :: errh2osno(:) !imbalance in snow water (mm H2O) + real(r8), pointer :: snow_sources(:) !snow sources (mm H2O/s) + real(r8), pointer :: snow_sinks(:) !snow sinks (mm H2O/s) + real(r8), pointer :: h2osoi_liq(:,:) !liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_ice(:,:) !ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: h2osoi_liqice_10cm(:) !liquid water + ice lens in top 10cm of soil (kg/m2) + real(r8), pointer :: h2osoi_vol(:,:) !volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + real(r8), pointer :: h2osno_old(:) !snow mass for previous time step (kg/m2) (new) + real(r8), pointer :: qg(:) !ground specific humidity [kg/kg] + real(r8), pointer :: dqgdT(:) !d(qg)/dT + real(r8), pointer :: snowice(:) !average snow ice lens + real(r8), pointer :: snowliq(:) !average snow liquid water + real(r8) ,pointer :: soilalpha(:) !factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: soilbeta(:) !factor that reduces ground evaporation L&P1992(-) + real(r8) ,pointer :: soilalpha_u(:) !urban factor that reduces ground saturated specific humidity (-) + real(r8), pointer :: zwt(:) !water table depth + !real(r8), pointer :: frost_table(:) !frost table depth + !real(r8), pointer :: zwt_perched(:) !perched water table depth + real(r8), pointer :: fcov(:) !fractional impermeable area + real(r8), pointer :: wa(:) !water in the unconfined aquifer (mm) + real(r8), pointer :: wt(:) !total water storage (unsaturated soil water + groundwater) (mm) + real(r8), pointer :: qcharge(:) !aquifer recharge rate (mm/s) + real(r8), pointer :: smp_l(:,:) !soil matric potential (mm) + real(r8), pointer :: hk_l(:,:) !hydraulic conductivity (mm/s) + real(r8), pointer :: fsat(:) !fractional area with water table at surface + real(r8), pointer :: forc_q(:) !atm specific humidity, downscaled to column (kg/kg) +end type column_wstate_type + +type(column_wstate_type) :: cws !column water state +type(pft_wstate_type) :: pws_a !pft-level water state variables averaged to the column + +!---------------------------------------------------- +! column carbon state variables structure +!---------------------------------------------------- +type, public :: column_cstate_type + ! NOTE: the soilc variable is used by the original CLM C-cycle code, + ! and is not used by the CN code + real(r8), pointer :: soilc(:) !soil carbon (kg C /m**2) + ! BGC variables + real(r8), pointer :: cwdc(:) ! (gC/m2) coarse woody debris C + real(r8), pointer :: litr1c(:) ! (gC/m2) litter labile C + real(r8), pointer :: litr2c(:) ! (gC/m2) litter cellulose C + real(r8), pointer :: litr3c(:) ! (gC/m2) litter lignin C + real(r8), pointer :: soil1c(:) ! (gC/m2) soil organic matter C (fast pool) + real(r8), pointer :: soil2c(:) ! (gC/m2) soil organic matter C (medium pool) + real(r8), pointer :: soil3c(:) ! (gC/m2) soil organic matter C (slow pool) + real(r8), pointer :: soil4c(:) ! (gC/m2) soil organic matter C (slowest pool) + real(r8), pointer :: col_ctrunc(:) ! (gC/m2) column-level sink for C truncation + ! pools for dynamic landcover + real(r8), pointer :: seedc(:) ! (gC/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10c(:) ! (gC/m2) wood product C pool, 10-year lifespan + real(r8), pointer :: prod100c(:) ! (gC/m2) wood product C pool, 100-year lifespan + real(r8), pointer :: totprodc(:) ! (gC/m2) total wood product C + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: totlitc(:) ! (gC/m2) total litter carbon + real(r8), pointer :: totsomc(:) ! (gC/m2) total soil organic matter carbon + real(r8), pointer :: totecosysc(:) ! (gC/m2) total ecosystem carbon, incl veg but excl cpool + real(r8), pointer :: totcolc(:) ! (gC/m2) total column carbon, incl veg and cpool +end type column_cstate_type + +type(column_cstate_type) :: ccs !column carbon state +type(column_cstate_type) :: cc13s !column carbon-13 state + +!---------------------------------------------------- +! column nitrogen state variables structure +!---------------------------------------------------- +type, public :: column_nstate_type + ! BGC variables + real(r8), pointer :: cwdn(:) ! (gN/m2) coarse woody debris N + real(r8), pointer :: litr1n(:) ! (gN/m2) litter labile N + real(r8), pointer :: litr2n(:) ! (gN/m2) litter cellulose N + real(r8), pointer :: litr3n(:) ! (gN/m2) litter lignin N + real(r8), pointer :: soil1n(:) ! (gN/m2) soil organic matter N (fast pool) + real(r8), pointer :: soil2n(:) ! (gN/m2) soil organic matter N (medium pool) + real(r8), pointer :: soil3n(:) ! (gN/m2) soil orgainc matter N (slow pool) + real(r8), pointer :: soil4n(:) ! (gN/m2) soil orgainc matter N (slowest pool) + real(r8), pointer :: sminn(:) ! (gN/m2) soil mineral N + real(r8), pointer :: col_ntrunc(:) ! (gN/m2) column-level sink for N truncation + ! wood product pools, for dynamic landcover + real(r8), pointer :: seedn(:) ! (gN/m2) column-level pool for seeding new PFTs + real(r8), pointer :: prod10n(:) ! (gN/m2) wood product N pool, 10-year lifespan + real(r8), pointer :: prod100n(:) ! (gN/m2) wood product N pool, 100-year lifespan + real(r8), pointer :: totprodn(:) ! (gN/m2) total wood product N + ! summary (diagnostic) state variables, not involved in mass balance + real(r8), pointer :: totlitn(:) ! (gN/m2) total litter nitrogen + real(r8), pointer :: totsomn(:) ! (gN/m2) total soil organic matter nitrogen + real(r8), pointer :: totecosysn(:) ! (gN/m2) total ecosystem nitrogen, incl veg + real(r8), pointer :: totcoln(:) ! (gN/m2) total column nitrogen, incl veg +end type column_nstate_type + +type(column_nstate_type) :: cns !column nitrogen state +type(pft_nstate_type) :: pns_a !pft-level nitrogen state variables averaged to the column + +!---------------------------------------------------- +! column VOC state variables structure +!---------------------------------------------------- +type, public :: column_vstate_type + real(r8), pointer :: dummy_entry(:) +end type column_vstate_type + +!---------------------------------------------------- +! column DGVM state variables structure +!---------------------------------------------------- +type, public :: column_dgvstate_type + real(r8), pointer :: dummy_entry(:) +end type column_dgvstate_type + +!---------------------------------------------------- +! column dust state variables structure +!---------------------------------------------------- +type, public :: column_dstate_type + real(r8), pointer :: dummy_entry(:) +end type column_dstate_type + +!---------------------------------------------------- +! column energy flux variables structure +!---------------------------------------------------- +type, public :: column_eflux_type + real(r8), pointer :: eflx_snomelt(:) ! snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_u(:) ! urban snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_snomelt_r(:) ! rural snow melt heat flux (W/m**2) + real(r8), pointer :: eflx_impsoil(:) ! implicit evaporation for soil temperature equation + real(r8), pointer :: eflx_fgr12(:) ! ground heat flux between soil layers 1 and 2 (W/m2) + ! Urban variable + real(r8), pointer :: eflx_building_heat(:) ! heat flux from urban building interior to urban walls, roof (W/m**2) + real(r8), pointer :: eflx_urban_ac(:) ! urban air conditioning flux (W/m**2) + real(r8), pointer :: eflx_urban_heat(:) ! urban heating flux (W/m**2) + real(r8), pointer :: eflx_bot(:) ! heat flux from beneath the soil or ice column (W/m**2) + ! positive upward; usually eflx_bot >= 0 +end type column_eflux_type + +type(column_eflux_type) :: cef ! column energy flux +type(pft_eflux_type) :: pef_a ! pft-level energy flux variables averaged to the column + +!---------------------------------------------------- +! column momentum flux variables structure +!---------------------------------------------------- +type, public :: column_mflux_type + real(r8), pointer :: dummy_entry(:) +end type column_mflux_type + +type(column_mflux_type) :: cmf ! column momentum flux +type(pft_mflux_type) :: pmf_a ! pft-level momentum flux variables averaged to the column + +!---------------------------------------------------- +! column water flux variables structure +!---------------------------------------------------- +type, public :: column_wflux_type + real(r8), pointer :: qflx_infl(:) ! infiltration (mm H2O /s) + real(r8), pointer :: qflx_surf(:) ! surface runoff (mm H2O /s) + real(r8), pointer :: qflx_drain(:) ! sub-surface runoff (mm H2O /s) + real(r8), pointer :: qflx_top_soil(:)! net water input into soil from top (mm/s) + real(r8), pointer :: qflx_sl_top_soil(:) ! liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + !real(r8), pointer :: qflx_snow_out(:) ! net water output from snow column + !real(r8), pointer :: qflx_drain_perched(:) ! sub-surface runoff from perched wt (mm H2O /s) + ! + real(r8), pointer :: qflx_h2osfc_surf(:) ! surface water runoff + real(r8), pointer :: qflx_snow_h2osfc(:) ! snow falling on surface water + real(r8), pointer :: qflx_drain_perched(:) ! sub-surface runoff from perched wt (mm H2O /s) + real(r8), pointer :: qflx_floodc(:) ! flood water flux at column level + real(r8), pointer :: qflx_snow_melt(:) ! snow melt (net) + ! + real(r8), pointer :: qflx_snomelt(:) ! snow melt (mm H2O /s) + real(r8), pointer :: qflx_qrgwl(:) ! qflx_surf at glaciers, wetlands, lakes + real(r8), pointer :: qflx_runoff(:) ! total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qflx_runoff_u(:)! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) + real(r8), pointer :: qflx_runoff_r(:)! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + real(r8), pointer :: qmelt(:) ! snow melt [mm/s] + real(r8), pointer :: h2ocan_loss(:) ! mass balance correction term for dynamic weights + real(r8), pointer :: qflx_rsub_sat(:) ! soil saturation excess [mm/s] + real(r8), pointer :: flx_bc_dep_dry(:) ! dry (BCPHO+BCPHI) BC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_bc_dep_wet(:) ! wet (BCPHI) BC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_bc_dep_pho(:) ! hydrophobic BC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_bc_dep_phi(:) ! hydrophillic BC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_bc_dep(:) ! total (dry+wet) BC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_oc_dep_dry(:) ! dry (OCPHO+OCPHI) OC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_oc_dep_wet(:) ! wet (OCPHI) OC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_oc_dep_pho(:) ! hydrophobic OC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_oc_dep_phi(:) ! hydrophillic OC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_oc_dep(:) ! total (dry+wet) OC deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_dry1(:) ! dust species 1 dry deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_wet1(:) ! dust species 1 wet deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_dry2(:) ! dust species 2 dry deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_wet2(:) ! dust species 2 wet deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_dry3(:) ! dust species 3 dry deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_wet3(:) ! dust species 3 wet deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_dry4(:) ! dust species 4 dry deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep_wet4(:) ! dust species 4 wet deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: flx_dst_dep(:) ! total (dry+wet) dust deposition on ground (positive definite) (col) [kg/s] + real(r8), pointer :: qflx_snofrz_lyr(:,:)! snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] + real(r8), pointer :: qflx_snofrz_col(:) ! column-integrated snow freezing rate (positive definite) (col) [kg m-2 s-1] + real(r8), pointer :: qflx_irrig(:) ! irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_glcice(:) ! net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC + real(r8), pointer :: qflx_glcice_frz(:) ! ice growth (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_glcice_melt(:) ! ice melt (positive definite) (mm H2O/s) + real(r8), pointer :: glc_rofi(:) ! ice runoff passed from GLC to CLM (mm H2O /s) + real(r8), pointer :: glc_rofl(:) ! liquid runoff passed from GLC to CLM (mm H2O /s) +end type column_wflux_type + +type(column_wflux_type) :: cwf ! column water flux +type(pft_wflux_type) :: pwf_a ! pft-level water flux variables averaged to the column + +!---------------------------------------------------- +! column carbon flux variables structure +!---------------------------------------------------- +type, public :: column_cflux_type + ! new variables for CN code + ! column-level gap mortality fluxes + real(r8), pointer :: m_leafc_to_litr1c(:) ! leaf C mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_leafc_to_litr2c(:) ! leaf C mortality to litter 2 C (gC/m2/s) + real(r8), pointer :: m_leafc_to_litr3c(:) ! leaf C mortality to litter 3 C (gC/m2/s) + real(r8), pointer :: m_frootc_to_litr1c(:) ! fine root C mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_frootc_to_litr2c(:) ! fine root C mortality to litter 2 C (gC/m2/s) + real(r8), pointer :: m_frootc_to_litr3c(:) ! fine root C mortality to litter 3 C (gC/m2/s) + real(r8), pointer :: m_livestemc_to_cwdc(:) ! live stem C mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: m_deadstemc_to_cwdc(:) ! dead stem C mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: m_livecrootc_to_cwdc(:) ! live coarse root C mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_cwdc(:) ! dead coarse root C mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: m_leafc_storage_to_litr1c(:) ! leaf C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_frootc_storage_to_litr1c(:) ! fine root C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_livestemc_storage_to_litr1c(:) ! live stem C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_deadstemc_storage_to_litr1c(:) ! dead stem C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_livecrootc_storage_to_litr1c(:) ! live coarse root C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_deadcrootc_storage_to_litr1c(:) ! dead coarse root C storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_gresp_storage_to_litr1c(:) ! growth respiration storage mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_leafc_xfer_to_litr1c(:) ! leaf C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_frootc_xfer_to_litr1c(:) ! fine root C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_livestemc_xfer_to_litr1c(:) ! live stem C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_deadstemc_xfer_to_litr1c(:) ! dead stem C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_livecrootc_xfer_to_litr1c(:) ! live coarse root C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_deadcrootc_xfer_to_litr1c(:) ! dead coarse root C transfer mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: m_gresp_xfer_to_litr1c(:) ! growth respiration transfer mortality to litter 1 C (gC/m2/s) + ! column-level harvest mortality fluxes + real(r8), pointer :: hrv_leafc_to_litr1c(:) ! leaf C harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_leafc_to_litr2c(:) ! leaf C harvest mortality to litter 2 C (gC/m2/s) + real(r8), pointer :: hrv_leafc_to_litr3c(:) ! leaf C harvest mortality to litter 3 C (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litr1c(:) ! fine root C harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litr2c(:) ! fine root C harvest mortality to litter 2 C (gC/m2/s) + real(r8), pointer :: hrv_frootc_to_litr3c(:) ! fine root C harvest mortality to litter 3 C (gC/m2/s) + real(r8), pointer :: hrv_livestemc_to_cwdc(:) ! live stem C harvest mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) ! dead stem C harvest mortality to 10-year product pool (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) ! dead stem C harvest mortality to 100-year product pool (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_to_cwdc(:) ! live coarse root C harvest mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_to_cwdc(:) ! dead coarse root C harvest mortality to coarse woody debris C (gC/m2/s) + real(r8), pointer :: hrv_leafc_storage_to_litr1c(:) ! leaf C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_frootc_storage_to_litr1c(:) ! fine root C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:) ! live stem C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:) ! dead stem C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:) ! live coarse root C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:) ! dead coarse root C storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_gresp_storage_to_litr1c(:) ! growth respiration storage harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:) ! leaf C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:) ! fine root C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:) ! live stem C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:) ! dead stem C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:) ! live coarse root C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:) ! dead coarse root C transfer harvest mortality to litter 1 C (gC/m2/s) + real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:) ! growth respiration transfer harvest mortality to litter 1 C (gC/m2/s) + ! column-level fire fluxes + real(r8), pointer :: m_deadstemc_to_cwdc_fire(:) ! dead stem C to coarse woody debris C by fire (gC/m2/s) + real(r8), pointer :: m_deadcrootc_to_cwdc_fire(:) ! dead coarse root C to to woody debris C by fire (gC/m2/s) + real(r8), pointer :: m_litr1c_to_fire(:) ! litter 1 C fire loss (gC/m2/s) + real(r8), pointer :: m_litr2c_to_fire(:) ! litter 2 C fire loss (gC/m2/s) + real(r8), pointer :: m_litr3c_to_fire(:) ! litter 3 C fire loss (gC/m2/s) + real(r8), pointer :: m_cwdc_to_fire(:) ! coarse woody debris C fire loss (gC/m2/s) + ! litterfall fluxes + real(r8), pointer :: livestemc_to_litr1c(:) ! livestem C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr2c(:) ! livestem C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: livestemc_to_litr3c(:) ! livestem C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr1c(:) ! leaf C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr2c(:) ! leaf C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: leafc_to_litr3c(:) ! leaf C litterfall to litter 3 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr1c(:) ! fine root C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr2c(:) ! fine root C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: frootc_to_litr3c(:) ! fine root C litterfall to litter 3 C (gC/m2/s) + ! litterfall fluxes for prognostic crop model + real(r8), pointer :: grainc_to_litr1c(:) ! grain C litterfall to litter 1 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr2c(:) ! grain C litterfall to litter 2 C (gC/m2/s) + real(r8), pointer :: grainc_to_litr3c(:) ! grain C litterfall to litter 3 C (gC/m2/s) + ! decomposition fluxes + real(r8), pointer :: cwdc_to_litr2c(:) ! decomp. of coarse woody debris C to litter 2 C (gC/m2/s) + real(r8), pointer :: cwdc_to_litr3c(:) ! decomp. of coarse woody debris C to litter 3 C (gC/m2/s) + real(r8), pointer :: litr1_hr(:) ! het. resp. from litter 1 C (gC/m2/s) + real(r8), pointer :: litr1c_to_soil1c(:) ! decomp. of litter 1 C to SOM 1 C (gC/m2/s) + real(r8), pointer :: litr2_hr(:) ! het. resp. from litter 2 C (gC/m2/s) + real(r8), pointer :: litr2c_to_soil2c(:) ! decomp. of litter 2 C to SOM 2 C (gC/m2/s) + real(r8), pointer :: litr3_hr(:) ! het. resp. from litter 3 C (gC/m2/s) + real(r8), pointer :: litr3c_to_soil3c(:) ! decomp. of litter 3 C to SOM 3 C (gC/m2/s) + real(r8), pointer :: soil1_hr(:) ! het. resp. from SOM 1 C (gC/m2/s) + real(r8), pointer :: soil1c_to_soil2c(:) ! decomp. of SOM 1 C to SOM 2 C (gC/m2/s) + real(r8), pointer :: soil2_hr(:) ! het. resp. from SOM 2 C (gC/m2/s) + real(r8), pointer :: soil2c_to_soil3c(:) ! decomp. of SOM 2 C to SOM 3 C (gC/m2/s) + real(r8), pointer :: soil3_hr(:) ! het. resp. from SOM 3 C (gC/m2/s) + real(r8), pointer :: soil3c_to_soil4c(:) ! decomp. of SOM 3 C to SOM 4 C (gC/m2/s) + real(r8), pointer :: soil4_hr(:) ! het. resp. from SOM 4 C (gC/m2/s) + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedc_to_leaf(:) ! (gC/m2/s) seed source to PFT-level + real(r8), pointer :: dwt_seedc_to_deadstem(:) ! (gC/m2/s) seed source to PFT-level + real(r8), pointer :: dwt_conv_cflux(:) ! (gC/m2/s) conversion C flux (immediate loss to atm) + real(r8), pointer :: dwt_prod10c_gain(:) ! (gC/m2/s) addition to 10-yr wood product pool + real(r8), pointer :: dwt_prod100c_gain(:) ! (gC/m2/s) addition to 100-yr wood product pool + real(r8), pointer :: dwt_frootc_to_litr1c(:) ! (gC/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr2c(:) ! (gC/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootc_to_litr3c(:) ! (gC/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootc_to_cwdc(:) ! (gC/m2/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootc_to_cwdc(:) ! (gC/m2/s) dead coarse root to CWD due to landcover change + real(r8), pointer :: dwt_closs(:) ! (gC/m2/s) total carbon loss from product pools and conversion + real(r8), pointer :: landuseflux(:) ! (gC/m2/s) dwt_closs+product_closs + real(r8), pointer :: landuptake(:) ! (gC/m2/s) nee-landuseflux + ! wood product pool loss fluxes + real(r8), pointer :: prod10c_loss(:) ! (gC/m2/s) decomposition loss from 10-yr wood product pool + real(r8), pointer :: prod100c_loss(:) ! (gC/m2/s) decomposition loss from 100-yr wood product pool + real(r8), pointer :: product_closs(:) ! (gC/m2/s) total wood product carbon loss + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: lithr(:) ! (gC/m2/s) litter heterotrophic respiration + real(r8), pointer :: somhr(:) ! (gC/m2/s) soil organic matter heterotrophic respiration + real(r8), pointer :: hr(:) ! (gC/m2/s) total heterotrophic respiration + real(r8), pointer :: sr(:) ! (gC/m2/s) total soil respiration (HR + root resp) + real(r8), pointer :: er(:) ! (gC/m2/s) total ecosystem respiration, autotrophic + heterotrophic + real(r8), pointer :: litfire(:) ! (gC/m2/s) litter fire losses + real(r8), pointer :: somfire(:) ! (gC/m2/s) soil organic matter fire losses + real(r8), pointer :: totfire(:) ! (gC/m2/s) total ecosystem fire losses + real(r8), pointer :: nep(:) ! (gC/m2/s) net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink + real(r8), pointer :: nbp(:) ! (gC/m2/s) net biome production, includes fire, landuse, and harvest flux, positive for sink + real(r8), pointer :: nee(:) ! (gC/m2/s) net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source + real(r8), pointer :: col_cinputs(:) ! (gC/m2/s) total column-level carbon inputs (for balance check) + real(r8), pointer :: col_coutputs(:) ! (gC/m2/s) total column-level carbon outputs (for balance check) + ! CLAMP summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: cwdc_hr(:) ! (gC/m2/s) col-level coarse woody debris C heterotrophic respiration + real(r8), pointer :: cwdc_loss(:) ! (gC/m2/s) col-level coarse woody debris C loss + real(r8), pointer :: litterc_loss(:) ! (gC/m2/s) col-level litter C loss + ! new variables for fire + real(r8), pointer :: col_fire_closs(:) ! (gC/m2/s) total column-level fire C loss +end type column_cflux_type + +type(column_cflux_type) :: ccf ! column carbon flux +type(column_cflux_type) :: cc13f ! column carbon-13 flux + +!---------------------------------------------------- +! column nitrogen flux variables structure +!---------------------------------------------------- +type, public :: column_nflux_type + ! new variables for CN code + ! deposition fluxes + real(r8), pointer :: ndep_to_sminn(:) ! atmospheric N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: nfix_to_sminn(:) ! symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) + ! column-level gap mortality fluxes + real(r8), pointer :: m_leafn_to_litr1n(:) ! leaf N mortality to litter 1 N (gC/m2/s) + real(r8), pointer :: m_leafn_to_litr2n(:) ! leaf N mortality to litter 2 N (gC/m2/s) + real(r8), pointer :: m_leafn_to_litr3n(:) ! leaf N mortality to litter 3 N (gC/m2/s) + real(r8), pointer :: m_frootn_to_litr1n(:) ! fine root N mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_frootn_to_litr2n(:) ! fine root N mortality to litter 2 N (gN/m2/s) + real(r8), pointer :: m_frootn_to_litr3n(:) ! fine root N mortality to litter 3 N (gN/m2/s) + real(r8), pointer :: m_livestemn_to_cwdn(:) ! live stem N mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: m_deadstemn_to_cwdn(:) ! dead stem N mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: m_livecrootn_to_cwdn(:) ! live coarse root N mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_cwdn(:) ! dead coarse root N mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: m_retransn_to_litr1n(:) ! retranslocated N pool mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_leafn_storage_to_litr1n(:) ! leaf N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_frootn_storage_to_litr1n(:) ! fine root N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_livestemn_storage_to_litr1n(:) ! live stem N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_deadstemn_storage_to_litr1n(:) ! dead stem N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_livecrootn_storage_to_litr1n(:) ! live coarse root N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_deadcrootn_storage_to_litr1n(:) ! dead coarse root N storage mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_leafn_xfer_to_litr1n(:) ! leaf N transfer mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_frootn_xfer_to_litr1n(:) ! fine root N transfer mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_livestemn_xfer_to_litr1n(:) ! live stem N transfer mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_deadstemn_xfer_to_litr1n(:) ! dead stem N transfer mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_livecrootn_xfer_to_litr1n(:) ! live coarse root N transfer mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: m_deadcrootn_xfer_to_litr1n(:) ! dead coarse root N transfer mortality to litter 1 N (gN/m2/s) + ! column-level harvest fluxes + real(r8), pointer :: hrv_leafn_to_litr1n(:) ! leaf N harvest mortality to litter 1 N (gC/m2/s) + real(r8), pointer :: hrv_leafn_to_litr2n(:) ! leaf N harvest mortality to litter 2 N (gC/m2/s) + real(r8), pointer :: hrv_leafn_to_litr3n(:) ! leaf N harvest mortality to litter 3 N (gC/m2/s) + real(r8), pointer :: hrv_frootn_to_litr1n(:) ! fine root N harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_frootn_to_litr2n(:) ! fine root N harvest mortality to litter 2 N (gN/m2/s) + real(r8), pointer :: hrv_frootn_to_litr3n(:) ! fine root N harvest mortality to litter 3 N (gN/m2/s) + real(r8), pointer :: hrv_livestemn_to_cwdn(:) ! live stem N harvest mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod10n(:) ! dead stem N harvest mortality to 10-year product pool (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_to_prod100n(:) ! dead stem N harvest mortality to 100-year product pool (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_to_cwdn(:) ! live coarse root N harvest mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_to_cwdn(:) ! dead coarse root N harvest mortality to coarse woody debris N (gN/m2/s) + real(r8), pointer :: hrv_retransn_to_litr1n(:) ! retranslocated N pool harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_leafn_storage_to_litr1n(:) ! leaf N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_frootn_storage_to_litr1n(:) ! fine root N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:) ! live stem N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:) ! dead stem N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:) ! live coarse root N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:) ! dead coarse root N storage harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:) ! leaf N transfer harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:) ! fine root N transfer harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:) ! live stem N transfer harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:) ! dead stem N transfer harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:) ! live coarse root N transfer harvest mortality to litter 1 N (gN/m2/s) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:) ! dead coarse root N transfer harvest mortality to litter 1 N (gN/m2/s) + ! column-level fire fluxes + real(r8), pointer :: m_deadstemn_to_cwdn_fire(:) ! dead stem N to coarse woody debris N by fire (gN/m2/s) + real(r8), pointer :: m_deadcrootn_to_cwdn_fire(:) ! dead coarse root N to to woody debris N by fire (gN/m2/s) + real(r8), pointer :: m_litr1n_to_fire(:) ! litter 1 N fire loss (gN/m2/s) + real(r8), pointer :: m_litr2n_to_fire(:) ! litter 2 N fire loss (gN/m2/s) + real(r8), pointer :: m_litr3n_to_fire(:) ! litter 3 N fire loss (gN/m2/s) + real(r8), pointer :: m_cwdn_to_fire(:) ! coarse woody debris N fire loss (gN/m2/s) + ! litterfall fluxes + real(r8), pointer :: livestemn_to_litr1n(:) ! livestem N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr2n(:) ! livestem N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: livestemn_to_litr3n(:) ! livestem N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr1n(:) ! leaf N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr2n(:) ! leaf N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: leafn_to_litr3n(:) ! leaf N litterfall to litter 3 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr1n(:) ! fine root N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr2n(:) ! fine root N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: frootn_to_litr3n(:) ! fine root N litterfall to litter 3 N (gN/m2/s) + ! litterfall fluxes for prognostic crop model + real(r8), pointer :: grainn_to_litr1n(:) ! grain N litterfall to litter 1 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr2n(:) ! grain N litterfall to litter 2 N (gN/m2/s) + real(r8), pointer :: grainn_to_litr3n(:) ! grain N litterfall to litter 3 N (gN/m2/s) + ! decomposition fluxes + real(r8), pointer :: cwdn_to_litr2n(:) ! decomp. of coarse woody debris N to litter 2 N (gN/m2/s) + real(r8), pointer :: cwdn_to_litr3n(:) ! decomp. of coarse woody debris N to litter 3 N (gN/m2/s) + real(r8), pointer :: litr1n_to_soil1n(:) ! decomp. of litter 1 N to SOM 1 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil1n_l1(:) ! mineral N flux for decomp. of litter 1 to SOM 1 (gN/m2/s) + real(r8), pointer :: litr2n_to_soil2n(:) ! decomp. of litter 2 N to SOM 2 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil2n_l2(:) ! mineral N flux for decomp. of litter 2 to SOM 2 (gN/m2/s) + real(r8), pointer :: litr3n_to_soil3n(:) ! decomp. of litter 3 N to SOM 3 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil3n_l3(:) ! mineral N flux for decomp. of litter 3 to SOM 3 (gN/m2/s) + real(r8), pointer :: soil1n_to_soil2n(:) ! decomp. of SOM 1 N to SOM 2 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil2n_s1(:) ! mineral N flux for decomp. of SOM 1 to SOM 2 (gN/m2/s) + real(r8), pointer :: soil2n_to_soil3n(:) ! decomp. of SOM 2 N to SOM 3 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil3n_s2(:) ! mineral N flux for decomp. of SOM 2 to SOM 3 (gN/m2/s) + real(r8), pointer :: soil3n_to_soil4n(:) ! decomp. of SOM 3 N to SOM 4 N (gN/m2/s) + real(r8), pointer :: sminn_to_soil4n_s3(:) ! mineral N flux for decomp. of SOM 3 to SOM 4 (gN/m2/s) + real(r8), pointer :: soil4n_to_sminn(:) ! N mineralization for decomp. of SOM 4 (gN/m2/s) + ! denitrification fluxes + real(r8), pointer :: sminn_to_denit_l1s1(:) ! denitrification for decomp. of litter 1 to SOM 1 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_l2s2(:) ! denitrification for decomp. of litter 2 to SOM 2 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_l3s3(:) ! denitrification for decomp. of litter 3 to SOM 3 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_s1s2(:) ! denitrification for decomp. of SOM 1 to SOM 2 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_s2s3(:) ! denitrification for decomp. of SOM 2 to SOM 3 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_s3s4(:) ! denitrification for decomp. of SOM 3 to SOM 4 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_s4(:) ! denitrification for decomp. of SOM 4 (gN/m2/s) + real(r8), pointer :: sminn_to_denit_excess(:) ! denitrification from excess mineral N pool (gN/m2/s) + ! leaching fluxes + real(r8), pointer :: sminn_leached(:) ! soil mineral N pool loss to leaching (gN/m2/s) + ! dynamic landcover fluxes + real(r8), pointer :: dwt_seedn_to_leaf(:) ! (gN/m2/s) seed source to PFT-level + real(r8), pointer :: dwt_seedn_to_deadstem(:) ! (gN/m2/s) seed source to PFT-level + real(r8), pointer :: dwt_conv_nflux(:) ! (gN/m2/s) conversion N flux (immediate loss to atm) + real(r8), pointer :: dwt_prod10n_gain(:) ! (gN/m2/s) addition to 10-yr wood product pool + real(r8), pointer :: dwt_prod100n_gain(:) ! (gN/m2/s) addition to 100-yr wood product pool + real(r8), pointer :: dwt_frootn_to_litr1n(:) ! (gN/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr2n(:) ! (gN/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_frootn_to_litr3n(:) ! (gN/m2/s) fine root to litter due to landcover change + real(r8), pointer :: dwt_livecrootn_to_cwdn(:) ! (gN/m2/s) live coarse root to CWD due to landcover change + real(r8), pointer :: dwt_deadcrootn_to_cwdn(:) ! (gN/m2/s) dead coarse root to CWD due to landcover change + real(r8), pointer :: dwt_nloss(:) ! (gN/m2/s) total nitrogen loss from product pools and conversion + ! wood product pool loss fluxes + real(r8), pointer :: prod10n_loss(:) ! (gN/m2/s) decomposition loss from 10-yr wood product pool + real(r8), pointer :: prod100n_loss(:) ! (gN/m2/s) decomposition loss from 100-yr wood product pool + real(r8), pointer :: product_nloss(:) ! (gN/m2/s) total wood product nitrogen loss + ! summary (diagnostic) flux variables, not involved in mass balance + real(r8), pointer :: potential_immob(:) ! potential N immobilization (gN/m2/s) + real(r8), pointer :: actual_immob(:) ! actual N immobilization (gN/m2/s) + real(r8), pointer :: sminn_to_plant(:) ! plant uptake of soil mineral N (gN/m2/s) + real(r8), pointer :: supplement_to_sminn(:) ! supplemental N supply (gN/m2/s) + real(r8), pointer :: gross_nmin(:) ! gross rate of N mineralization (gN/m2/s) + real(r8), pointer :: net_nmin(:) ! net rate of N mineralization (gN/m2/s) + real(r8), pointer :: denit(:) ! total rate of denitrification (gN/m2/s) + real(r8), pointer :: col_ninputs(:) ! column-level N inputs (gN/m2/s) + real(r8), pointer :: col_noutputs(:) ! column-level N outputs (gN/m2/s) + ! new variables for fire + real(r8), pointer :: col_fire_nloss(:) ! total column-level fire N loss (gN/m2/s) +end type column_nflux_type + +type(column_nflux_type) :: cnf !column nitrogen flux + +!---------------------------------------------------- +! column dust flux variables structure +!---------------------------------------------------- +type, public :: column_dflux_type + real(r8), pointer :: dummy_entry(:) +end type column_dflux_type + +!---------------------------------------------------- +! End definition of structures defined at the column_type level +!---------------------------------------------------- +!******************************************************************************* + + +!******************************************************************************* +!---------------------------------------------------- +! Begin definition of structures defined at the landunit_type level +!---------------------------------------------------- +!---------------------------------------------------- +! landunit physical state variables structure +!---------------------------------------------------- +! note - landunit type can be vegetated (includes bare soil), deep lake, +! shallow lake, wetland, glacier or urban +type, public :: landunit_pstate_type + ! Urban variables + real(r8), pointer :: t_building(:) ! internal building temperature (K) + real(r8), pointer :: t_building_max(:) ! maximum internal building temperature (K) + real(r8), pointer :: t_building_min(:) ! minimum internal building temperature (K) + real(r8), pointer :: tk_wall(:,:) ! thermal conductivity of urban wall (W/m/K) + real(r8), pointer :: tk_roof(:,:) ! thermal conductivity of urban roof (W/m/K) + real(r8), pointer :: tk_improad(:,:) ! thermal conductivity of urban impervious road (W/m/K) + real(r8), pointer :: cv_wall(:,:) ! heat capacity of urban wall (J/m^3/K) + real(r8), pointer :: cv_roof(:,:) ! heat capacity of urban roof (J/m^3/K) + real(r8), pointer :: cv_improad(:,:) ! heat capacity of urban impervious road (J/m^3/K) + real(r8), pointer :: thick_wall(:) ! total thickness of urban wall (m) + real(r8), pointer :: thick_roof(:) ! total thickness of urban roof (m) + integer , pointer :: nlev_improad(:) ! number of impervious road layers (-) + real(r8), pointer :: vf_sr(:) ! view factor of sky for road + real(r8), pointer :: vf_wr(:) ! view factor of one wall for road + real(r8), pointer :: vf_sw(:) ! view factor of sky for one wall + real(r8), pointer :: vf_rw(:) ! view factor of road for one wall + real(r8), pointer :: vf_ww(:) ! view factor of opposing wall for one wall + real(r8), pointer :: taf(:) ! urban canopy air temperature (K) + real(r8), pointer :: qaf(:) ! urban canopy air specific humidity (kg/kg) + real(r8), pointer :: sabs_roof_dir(:,:) ! direct solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_roof_dif(:,:) ! diffuse solar absorbed by roof per unit ground area per unit incident flux + real(r8), pointer :: sabs_sunwall_dir(:,:) ! direct solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_sunwall_dif(:,:) ! diffuse solar absorbed by sunwall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dir(:,:) ! direct solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_shadewall_dif(:,:) ! diffuse solar absorbed by shadewall per unit wall area per unit incident flux + real(r8), pointer :: sabs_improad_dir(:,:) ! direct solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_improad_dif(:,:) ! diffuse solar absorbed by impervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dir(:,:) ! direct solar absorbed by pervious road per unit ground area per unit incident flux + real(r8), pointer :: sabs_perroad_dif(:,:) ! diffuse solar absorbed by pervious road per unit ground area per unit incident flux +end type landunit_pstate_type + +type(landunit_pstate_type) :: lps !land unit physical state variables + +!---------------------------------------------------- +! landunit energy flux variables structure +!---------------------------------------------------- +type, public :: landunit_eflux_type + ! Urban variables + real(r8), pointer :: eflx_traffic_factor(:) ! multiplicative traffic factor for sensible heat flux from urban traffic (-) + real(r8), pointer :: eflx_traffic(:) ! traffic sensible heat flux (W/m**2) + real(r8), pointer :: eflx_wasteheat(:) ! sensible heat flux from domestic heating/cooling sources of waste heat (W/m**2) + real(r8), pointer :: eflx_heat_from_ac(:) ! sensible heat flux to be put back into canyon due to removal by AC (W/m**2) +end type landunit_eflux_type + +type(landunit_eflux_type) :: lef ! average of energy fluxes all columns + +!---------------------------------------------------- +! End definition of structures defined at the landunit_type level +!---------------------------------------------------- +!******************************************************************************* + +!******************************************************************************* +!---------------------------------------------------- +! Begin definition of structures defined at the gridcell_type level +!---------------------------------------------------- +! gridcell physical state variables structure +!---------------------------------------------------- +type, public :: gridcell_pstate_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_pstate_type + +!---------------------------------------------------- +! gridcell energy state variables structure +!---------------------------------------------------- +type, public :: gridcell_estate_type + real(r8), pointer :: gc_heat1(:) ! initial gridcell total heat content + real(r8), pointer :: gc_heat2(:) ! post land cover change total heat content +end type gridcell_estate_type + +type(gridcell_estate_type) :: ges !average of energy states all landunits + +!---------------------------------------------------- +! gridcell water state variables structure +!---------------------------------------------------- +type, public :: gridcell_wstate_type + real(r8), pointer :: gc_liq1(:) ! initial gridcell total h2o liq content + real(r8), pointer :: gc_liq2(:) ! post land cover change total liq content + real(r8), pointer :: gc_ice1(:) ! initial gridcell total h2o liq content + real(r8), pointer :: gc_ice2(:) ! post land cover change total ice content +end type gridcell_wstate_type + +type(gridcell_wstate_type) :: gws !average of water states all landunits + +!---------------------------------------------------- +! gridcell carbon state variables structure +!---------------------------------------------------- +type, public :: gridcell_cstate_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_cstate_type + +type(column_cstate_type):: ccs_a !column-level carbon state variables averaged to gridcell + +!---------------------------------------------------- +! gridcell nitrogen state variables structure +!---------------------------------------------------- +type, public :: gridcell_nstate_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_nstate_type + +type(column_nstate_type):: cns_a !column-level nitrogen state variables averaged to gridcell + +!---------------------------------------------------- +! gridcell VOC state variables structure +!---------------------------------------------------- +type, public :: gridcell_vstate_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_vstate_type + +type(column_vstate_type):: cvs_a !column-level VOC state variables averaged to gridcell + +!---------------------------------------------------- +! gridcell VOC emission factor variables structure (heald) +!---------------------------------------------------- +type, public :: gridcell_efstate_type + real(r8), pointer :: efisop(:,:) ! isoprene emission factors +end type gridcell_efstate_type +type(gridcell_efstate_type):: gve !gridcell VOC emission factors + +!---------------------------------------------------- +! gridcell dust state variables structure +!---------------------------------------------------- +type, public :: gridcell_dstate_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_dstate_type + +!---------------------------------------------------- +! gridcell DGVM state variables structure +!---------------------------------------------------- +type, public :: gridcell_dgvstate_type + real(r8), pointer :: agdd20(:) !20-yr running mean of agdd + real(r8), pointer :: tmomin20(:) !20-yr running mean of tmomin + real(r8), pointer :: t10min(:) !ann minimum of 10-day running mean (K) +end type gridcell_dgvstate_type + +type(gridcell_dgvstate_type):: gdgvs !gridcell DGVM structure + +!---------------------------------------------------- +! gridcell energy flux variables structure +!---------------------------------------------------- +type, public :: gridcell_eflux_type + real(r8), pointer :: eflx_sh_totg(:) ! total grid-level sensible heat flux + real(r8), pointer :: eflx_dynbal(:) ! dynamic land cover change conversion energy flux +end type gridcell_eflux_type + +type(gridcell_eflux_type) :: gef !average of energy fluxes all landunits + +!---------------------------------------------------- +! gridcell momentum flux variables structure +!-- ------------------------------------------------- +type, public :: gridcell_mflux_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_mflux_type + +!---------------------------------------------------- +! gridcell water flux variables structure +!---------------------------------------------------- +type, public :: gridcell_wflux_type + real(r8), pointer :: qflx_runoffg(:) ! total grid-level liq runoff + real(r8), pointer :: qflx_snwcp_iceg(:) ! total grid-level ice runoff + real(r8), pointer :: qflx_liq_dynbal(:) ! liq dynamic land cover change conversion runoff flux + real(r8), pointer :: qflx_ice_dynbal(:) ! ice dynamic land cover change conversion runoff flux + real(r8), pointer :: qflx_floodg(:) ! total grid-level flood water flux +end type gridcell_wflux_type + +type(gridcell_wflux_type) :: gwf !average of water fluxes all landunits + +!---------------------------------------------------- +! gridcell carbon flux variables structure +!---------------------------------------------------- +type, public :: gridcell_cflux_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_cflux_type + +!---------------------------------------------------- +! gridcell nitrogen flux variables structure +!---------------------------------------------------- +type, public :: gridcell_nflux_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_nflux_type + +!---------------------------------------------------- +! gridcell dust flux variables structure +!---------------------------------------------------- +type, public :: gridcell_dflux_type + real(r8), pointer :: dummy_entry(:) +end type gridcell_dflux_type + +!---------------------------------------------------- +! End definition of structures defined at the gridcell_type level +!---------------------------------------------------- +!******************************************************************************* + +!******************************************************************************* +!---------------------------------------------------- +! define the pft structure +!---------------------------------------------------- +type, public :: pft_type + integer , pointer :: column(:) !index into column level quantities + real(r8), pointer :: wtcol(:) !weight (relative to column) + integer , pointer :: landunit(:) !index into landunit level quantities + real(r8), pointer :: wtlunit(:) !weight (relative to landunit) + integer , pointer :: gridcell(:) !index into gridcell level quantities + real(r8), pointer :: wtgcell(:) !weight (relative to gridcell) + integer , pointer :: itype(:) !pft vegetation + integer , pointer :: mxy(:) !m index for laixy(i,j,m),etc. +end type pft_type + +type(pft_type), target :: pft !plant functional type (pft) data structure + +!---------------------------------------------------- +! define the column structure +!---------------------------------------------------- +type, public :: column_type + integer , pointer :: landunit(:) !index into landunit level quantities + real(r8), pointer :: wtlunit(:) !weight (relative to landunit) + integer , pointer :: gridcell(:) !index into gridcell level quantities + real(r8), pointer :: wtgcell(:) !weight (relative to gridcell) + integer , pointer :: pfti(:) !beginning pft index for each column + integer , pointer :: pftf(:) !ending pft index for each column + integer , pointer :: npfts(:) !number of pfts for each column + integer , pointer :: itype(:) !column type +end type column_type + +type(column_type), target :: col !column data structure (soil/snow/canopy columns) + +!---------------------------------------------------- +! define the geomorphological land unit structure +!---------------------------------------------------- +type, public :: landunit_type + integer , pointer :: gridcell(:) !index into gridcell level quantities + real(r8), pointer :: wtgcell(:) !weight (relative to gridcell) + integer , pointer :: coli(:) !beginning column index per landunit + integer , pointer :: colf(:) !ending column index for each landunit + integer , pointer :: ncolumns(:) !number of columns for each landunit + integer , pointer :: pfti(:) !beginning pft index for each landunit + integer , pointer :: pftf(:) !ending pft index for each landunit + integer , pointer :: npfts(:) !number of pfts for each landunit + integer , pointer :: itype(:) !landunit type + logical , pointer :: ifspecial(:) !BOOL: true=>landunit is not vegetated + logical , pointer :: lakpoi(:) !BOOL: true=>lake point + logical , pointer :: urbpoi(:) !BOOL: true=>urban point + logical , pointer :: glcmecpoi(:) !BOOL: true=>glacier_mec point + + ! Urban canyon related properties + real(r8), pointer :: canyon_hwr(:) ! urban landunit canyon height to width ratio (-) + real(r8), pointer :: wtroad_perv(:) ! urban landunit weight of pervious road column to total road (-) + real(r8), pointer :: wtlunit_roof(:) ! weight of roof with respect to urban landunit (-) + + ! Urban related info MV - this should be moved to land physical state - MV + real(r8), pointer :: ht_roof(:) ! height of urban roof (m) + real(r8), pointer :: wind_hgt_canyon(:)! height above road at which wind in canyon is to be computed (m) + real(r8), pointer :: z_0_town(:) ! urban landunit momentum roughness length (m) + real(r8), pointer :: z_d_town(:) ! urban landunit displacement height (m) +end type landunit_type + +type(landunit_type), target :: lun !geomorphological landunits + +!---------------------------------------------------- +! define the gridcell structure +!---------------------------------------------------- +type, public :: gridcell_type + integer , pointer :: luni(:) !beginning landunit index + integer , pointer :: lunf(:) !ending landunit index + integer , pointer :: nlandunits(:) !number of landunit for each gridcell + integer , pointer :: coli(:) !beginning column index + integer , pointer :: colf(:) !ending column index + integer , pointer :: ncolumns(:) !number of columns for each gridcell + integer , pointer :: pfti(:) !beginning pft index + integer , pointer :: pftf(:) !ending pft index + integer , pointer :: npfts(:) !number of pfts for each gridcell + integer , pointer :: gindex(:) !global index + real(r8), pointer :: area(:) !total land area, gridcell (km^2) + real(r8), pointer :: lat(:) !latitude (radians) + real(r8), pointer :: lon(:) !longitude (radians) + real(r8), pointer :: latdeg(:) !latitude (degrees) + real(r8), pointer :: londeg(:) !longitude (degrees) + real(r8), pointer :: gris_mask(:) !Greenland ice sheet mask + real(r8), pointer :: gris_area(:) !Greenland ice-covered area per gridcell (km^2) + real(r8), pointer :: aais_mask(:) !Antarctic ice sheet mask + real(r8), pointer :: aais_area(:) !Antarctic ice-covered area per gridcell (km^2) +end type gridcell_type + +type(gridcell_type), target :: grc !gridcell data structure + +!---------------------------------------------------- +! End definition of spatial scaling hierarchy +!---------------------------------------------------- + +character(len=16), parameter, public :: grlnd = 'lndgrid' ! name of lndgrid +character(len=16), parameter, public :: namea = 'gridcellatm' ! name of atmgrid +character(len=16), parameter, public :: nameg = 'gridcell' ! name of gridcells +character(len=16), parameter, public :: namel = 'landunit' ! name of landunits +character(len=16), parameter, public :: namec = 'column' ! name of columns +character(len=16), parameter, public :: namep = 'pft' ! name of pfts + +! +!EOP +!----------------------------------------------------------------------- +end module clmtype diff --git a/components/clm/src_clm40/main/clmtypeInitMod.F90 b/components/clm/src_clm40/main/clmtypeInitMod.F90 new file mode 100644 index 0000000000..f31c1dec28 --- /dev/null +++ b/components/clm/src_clm40/main/clmtypeInitMod.F90 @@ -0,0 +1,4116 @@ +module clmtypeInitMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clmtypeInitMod +! +! !DESCRIPTION: +! Allocate clmtype components and initialize them to signaling NaN. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clmtype + use clm_varpar , only : maxpatch_pft, nlevsno, nlevgrnd, numrad, nlevlak, & + numpft, ndst, nlevurb, nlevsoi + use clm_varctl , only : use_c13, use_cn, use_cndv, use_crop +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: initClmtype +! +! !REVISION HISTORY: +! Created by Peter Thornton and Mariana Vertenstein +! Modified by Colette L. Heald (05/06) for VOC emission factors +! 3/17/08 David Lawrence, changed nlevsoi to nlevgrnd where appropriate +! +! !PRIVATE MEMBER FUNCTIONS: + private :: init_pft_type + private :: init_column_type + private :: init_landunit_type + private :: init_gridcell_type + private :: init_energy_balance_type + private :: init_water_balance_type + private :: init_pft_ecophys_constants + private :: init_pft_DGVMecophys_constants + private :: init_pft_pstate_type + private :: init_pft_epv_type + private :: init_pft_pdgvstate_type + private :: init_pft_vstate_type + private :: init_pft_estate_type + private :: init_pft_wstate_type + private :: init_pft_cstate_type + private :: init_pft_nstate_type + private :: init_pft_eflux_type + private :: init_pft_mflux_type + private :: init_pft_wflux_type + private :: init_pft_cflux_type + private :: init_pft_nflux_type + private :: init_pft_vflux_type + private :: init_pft_dflux_type + private :: init_pft_depvd_type + private :: init_column_pstate_type + private :: init_column_estate_type + private :: init_column_wstate_type + private :: init_column_cstate_type + private :: init_column_nstate_type + private :: init_column_eflux_type + private :: init_column_wflux_type + private :: init_column_cflux_type + private :: init_column_nflux_type + private :: init_landunit_pstate_type + private :: init_landunit_eflux_type + private :: init_gridcell_pstate_type + private :: init_gridcell_efstate_type + private :: init_gridcell_wflux_type +!EOP +!---------------------------------------------------- + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: initClmtype +! +! !INTERFACE: + subroutine initClmtype() +! +! !DESCRIPTION: +! Initialize clmtype components to signaling nan +! The following clmtype components should NOT be initialized here +! since they are set in routine clm_map which is called before this +! routine is invoked +! *%area, *%wt, *%wtlnd, *%wtxy, *%ixy, *%jxy, *%mxy, %snindex +! *%ifspecial, *%ityplun, *%itype +! *%pfti, *%pftf, *%pftn +! *%coli, *%colf, *%coln +! *%luni, *%lunf, *%lunn +! +! !USES: + use abortutils, only : endrun + use decompMod , only : get_proc_bounds, get_proc_global +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +! +! LOCAL VARAIBLES: + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + character(len=32), parameter :: subname = "initClmtype" +!------------------------------------------------------------------------ + + ! Determine necessary indices + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + + call init_pft_type (begp, endp, pft) + call init_column_type (begc, endc, col) + call init_landunit_type(begl, endl, lun) + call init_gridcell_type(begg, endg, grc) + + ! pft ecophysiological constants + + call init_pft_ecophys_constants() + + ! pft DGVM-specific ecophysiological constants + + if (use_cndv) then + call init_pft_DGVMecophys_constants() + end if + + ! energy balance structures (all levels) + + call init_energy_balance_type(begp, endp, pebal) + call init_energy_balance_type(begc, endc, cebal) + + ! water balance structures (all levels) + + call init_water_balance_type(begp, endp, pwbal) + call init_water_balance_type(begc, endc, cwbal) + + ! carbon balance structures (pft and column levels) + + call init_carbon_balance_type(begp, endp, pcbal) + call init_carbon_balance_type(begc, endc, ccbal) + + ! nitrogen balance structures (pft and column levels) + + call init_nitrogen_balance_type(begp, endp, pnbal) + call init_nitrogen_balance_type(begc, endc, cnbal) + + ! pft physical state variables at pft level and averaged to the column + + call init_pft_pstate_type(begp, endp, pps) + call init_pft_pstate_type(begc, endc, pps_a) + + ! pft ecophysiological variables (only at the pft level for now) + call init_pft_epv_type(begp, endp, pepv) + + ! pft DGVM state variables at pft level + + if (use_cndv) then + call init_pft_pdgvstate_type(begp, endp, pdgvs) + end if + call init_pft_vstate_type(begp, endp, pvs) + + ! pft energy state variables at the pft level + + call init_pft_estate_type(begp, endp, pes) + + ! pft water state variables at the pft level and averaged to the column + + call init_pft_wstate_type(begp, endp, pws) + call init_pft_wstate_type(begc, endc, pws_a) + + ! pft carbon state variables at the pft level and averaged to the column + + call init_pft_cstate_type(begp, endp, pcs) + call init_pft_cstate_type(begc, endc, pcs_a) + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + call init_pft_cstate_type(begp, endp, pc13s) + call init_pft_cstate_type(begc, endc, pc13s_a) + if (use_crop) then + call endrun( trim(subname)//" ERROR:: CROP and C13 can NOT be on at the same time" ) + end if + endif + + ! pft nitrogen state variables at the pft level and averaged to the column + + call init_pft_nstate_type(begp, endp, pns) + call init_pft_nstate_type(begc, endc, pns_a) + + ! pft energy flux variables at pft level + + call init_pft_eflux_type(begp, endp, pef) + + ! pft momentum flux variables at pft level + + call init_pft_mflux_type(begp, endp, pmf) + + ! pft water flux variables + + call init_pft_wflux_type(begp, endp, pwf) + call init_pft_wflux_type(begc, endc, pwf_a) + + ! pft carbon flux variables at pft level and averaged to column + + call init_pft_cflux_type(begp, endp, pcf) + call init_pft_cflux_type(begc, endc, pcf_a) + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + call init_pft_cflux_type(begp, endp, pc13f) + call init_pft_cflux_type(begc, endc, pc13f_a) + endif + + ! pft nitrogen flux variables at pft level and averaged to column + + call init_pft_nflux_type(begp, endp, pnf) + call init_pft_nflux_type(begc, endc, pnf_a) + + ! pft VOC flux variables at pft level + + call init_pft_vflux_type(begp, endp, pvf) + + ! gridcell VOC emission factors (heald, 05/06) + + call init_gridcell_efstate_type(begg, endg, gve) + + ! pft dust flux variables at pft level + + call init_pft_dflux_type(begp, endp, pdf) + + ! pft dry dep velocity variables at pft level + + call init_pft_depvd_type(begp, endp, pdd) + + ! column physical state variables at column level + + call init_column_pstate_type(begc, endc, cps) + + ! column energy state variables at column level + + + call init_column_estate_type(begc, endc, ces) + + ! column water state variables at column level + + call init_column_wstate_type(begc, endc, cws) + + ! column carbon state variables at column level + + call init_column_cstate_type(begc, endc, ccs) + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + call init_column_cstate_type(begc, endc, cc13s) + endif + + ! column nitrogen state variables at column level + + call init_column_nstate_type(begc, endc, cns) + + ! column energy flux variables at column level + + call init_column_eflux_type(begc, endc, cef) + + ! column water flux variables at column level + + call init_column_wflux_type(begc, endc, cwf) + + ! column carbon flux variables at column level + + call init_column_cflux_type(begc, endc, ccf) + if (use_c13) then + ! 4/14/05: PET + ! Adding isotope code + call init_column_cflux_type(begc, endc, cc13f) + endif + + ! column nitrogen flux variables at column level + + call init_column_nflux_type(begc, endc, cnf) + + ! land unit physical state variables + + call init_landunit_pstate_type(begl, endl, lps) + + ! land unit energy flux variables + + call init_landunit_eflux_type(begl, endl, lef) + + ! gridcell DGVM variables + + if (use_cndv) then + call init_gridcell_dgvstate_type(begg, endg, gdgvs) + end if + + ! gridcell physical state variables + + + ! gridcell: water flux variables + + call init_gridcell_wflux_type(begg, endg, gwf) + + ! gridcell: energy flux variables + + call init_gridcell_eflux_type(begg, endg, gef) + + ! gridcell: water state variables + + call init_gridcell_wstate_type(begg, endg, gws) + + ! gridcell: energy state variables + + call init_gridcell_estate_type(begg, endg, ges) + + end subroutine initClmtype + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_type +! +! !INTERFACE: + subroutine init_pft_type (beg, end, p) +! +! !DESCRIPTION: +! Initialize components of pft_type structure +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(pft_type), intent(inout):: p +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pft%gridcell(beg:end),& + pft%wtgcell(beg:end), & + pft%landunit(beg:end),& + pft%wtlunit(beg:end), & + pft%column(beg:end), & + pft%wtcol(beg:end), & + pft%itype(beg:end), & + pft%mxy(beg:end)) + + end subroutine init_pft_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_type +! +! !INTERFACE: + subroutine init_column_type (beg, end, c) +! +! !DESCRIPTION: +! Initialize components of column_type structure +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(column_type), intent(inout):: c +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(col%gridcell(beg:end),& + col%wtgcell(beg:end), & + col%landunit(beg:end),& + col%wtlunit(beg:end), & + col%pfti(beg:end), & + col%pftf(beg:end), & + col%npfts(beg:end), & + col%itype(beg:end)) + + end subroutine init_column_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_landunit_type +! +! !INTERFACE: + subroutine init_landunit_type (beg, end,l) +! +! !DESCRIPTION: +! Initialize components of landunit_type structure +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(landunit_type), intent(inout):: l +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(lun%gridcell(beg:end), & + lun%wtgcell(beg:end), & + lun%coli(beg:end), & + lun%colf(beg:end), & + lun%ncolumns(beg:end), & + lun%pfti(beg:end), & + lun%pftf(beg:end), & + lun%npfts(beg:end), & + lun%itype(beg:end), & + lun%ifspecial(beg:end),& + lun%lakpoi(beg:end), & + lun%urbpoi(beg:end), & + lun%glcmecpoi(beg:end)) + + ! These should be moved to landunit physical state + allocate(lun%canyon_hwr(beg:end), & + lun%wtroad_perv(beg:end), & + lun%ht_roof(beg:end), & + lun%wtlunit_roof(beg:end), & + lun%wind_hgt_canyon(beg:end),& + lun%z_0_town(beg:end), & + lun%z_d_town(beg:end)) + + lun%canyon_hwr(beg:end) = nan + lun%wtroad_perv(beg:end) = nan + lun%ht_roof(beg:end) = nan + lun%wtlunit_roof(beg:end) = nan + lun%wind_hgt_canyon(beg:end)= nan + lun%z_0_town(beg:end) = nan + lun%z_d_town(beg:end) = nan + + lun%glcmecpoi(beg:end) = .false. + + end subroutine init_landunit_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_type +! +! !INTERFACE: + subroutine init_gridcell_type (beg, end,g) +! +! !DESCRIPTION: +! Initialize components of gridcell_type structure +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(gridcell_type), intent(inout):: g +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(grc%luni(beg:end), & + grc%lunf(beg:end), & + grc%nlandunits(beg:end),& + grc%coli(beg:end), & + grc%colf(beg:end), & + grc%ncolumns(beg:end), & + grc%pfti(beg:end), & + grc%pftf(beg:end), & + grc%npfts(beg:end), & + grc%gindex(beg:end), & + grc%area(beg:end), & + grc%lat(beg:end), & + grc%lon(beg:end), & + grc%latdeg(beg:end), & + grc%londeg(beg:end), & + grc%gris_mask(beg:end), & + grc%gris_area(beg:end), & + grc%aais_mask(beg:end), & + grc%aais_area(beg:end)) + + grc%gris_mask(beg:end) = nan + grc%gris_area(beg:end) = nan + grc%aais_mask(beg:end) = nan + grc%aais_area(beg:end) = nan + + end subroutine init_gridcell_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_energy_balance_type +! +! !INTERFACE: + subroutine init_energy_balance_type(beg, end, ebal) +! +! !DESCRIPTION: +! Initialize energy balance variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(energy_balance_type), intent(inout):: ebal +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(ebal%errsoi(beg:end)) + allocate(ebal%errseb(beg:end)) + allocate(ebal%errsol(beg:end)) + allocate(ebal%errlon(beg:end)) + + ebal%errsoi(beg:end) = nan + ebal%errseb(beg:end) = nan + ebal%errsol(beg:end) = nan + ebal%errlon(beg:end) = nan + + end subroutine init_energy_balance_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_water_balance_type +! +! !INTERFACE: + subroutine init_water_balance_type(beg, end, wbal) +! +! !DESCRIPTION: +! Initialize water balance variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(water_balance_type), intent(inout):: wbal +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(wbal%begwb(beg:end)) + allocate(wbal%endwb(beg:end)) + allocate(wbal%errh2o(beg:end)) + + wbal%begwb(beg:end) = nan + wbal%endwb(beg:end) = nan + wbal%errh2o(beg:end) = nan + + end subroutine init_water_balance_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_carbon_balance_type +! +! !INTERFACE: + subroutine init_carbon_balance_type(beg, end, cbal) +! +! !DESCRIPTION: +! Initialize carbon balance variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(carbon_balance_type), intent(inout):: cbal +! +! !REVISION HISTORY: +! Created by Peter Thornton, 12/11/2003 +! +!EOP +!------------------------------------------------------------------------ + + allocate(cbal%begcb(beg:end)) + allocate(cbal%endcb(beg:end)) + allocate(cbal%errcb(beg:end)) + + cbal%begcb(beg:end) = nan + cbal%endcb(beg:end) = nan + cbal%errcb(beg:end) = nan + + end subroutine init_carbon_balance_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_nitrogen_balance_type +! +! !INTERFACE: + subroutine init_nitrogen_balance_type(beg, end, nbal) +! +! !DESCRIPTION: +! Initialize nitrogen balance variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type(nitrogen_balance_type), intent(inout):: nbal +! +! !REVISION HISTORY: +! Created by Peter Thornton, 12/11/2003 +! +!EOP +!------------------------------------------------------------------------ + + allocate(nbal%begnb(beg:end)) + allocate(nbal%endnb(beg:end)) + allocate(nbal%errnb(beg:end)) + + nbal%begnb(beg:end) = nan + nbal%endnb(beg:end) = nan + nbal%errnb(beg:end) = nan + + end subroutine init_nitrogen_balance_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_ecophys_constants +! +! !INTERFACE: + subroutine init_pft_ecophys_constants() +! +! !DESCRIPTION: +! Initialize pft physical state +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pftcon%noveg(0:numpft)) + allocate(pftcon%tree(0:numpft)) + allocate(pftcon%smpso(0:numpft)) + allocate(pftcon%smpsc(0:numpft)) + allocate(pftcon%fnitr(0:numpft)) + allocate(pftcon%foln(0:numpft)) + allocate(pftcon%dleaf(0:numpft)) + allocate(pftcon%c3psn(0:numpft)) + allocate(pftcon%mp(0:numpft)) + allocate(pftcon%qe25(0:numpft)) + allocate(pftcon%xl(0:numpft)) + allocate(pftcon%rhol(0:numpft,numrad)) + allocate(pftcon%rhos(0:numpft,numrad)) + allocate(pftcon%taul(0:numpft,numrad)) + allocate(pftcon%taus(0:numpft,numrad)) + allocate(pftcon%z0mr(0:numpft)) + allocate(pftcon%displar(0:numpft)) + allocate(pftcon%roota_par(0:numpft)) + allocate(pftcon%rootb_par(0:numpft)) + allocate(pftcon%sla(0:numpft)) + allocate(pftcon%slatop(0:numpft)) + allocate(pftcon%dsladlai(0:numpft)) + allocate(pftcon%leafcn(0:numpft)) + allocate(pftcon%flnr(0:numpft)) + allocate(pftcon%woody(0:numpft)) + allocate(pftcon%lflitcn(0:numpft)) + allocate(pftcon%frootcn(0:numpft)) + allocate(pftcon%livewdcn(0:numpft)) + allocate(pftcon%deadwdcn(0:numpft)) + allocate(pftcon%graincn(0:numpft)) + allocate(pftcon%froot_leaf(0:numpft)) + allocate(pftcon%stem_leaf(0:numpft)) + allocate(pftcon%croot_stem(0:numpft)) + allocate(pftcon%flivewd(0:numpft)) + allocate(pftcon%fcur(0:numpft)) + allocate(pftcon%lf_flab(0:numpft)) + allocate(pftcon%lf_fcel(0:numpft)) + allocate(pftcon%lf_flig(0:numpft)) + allocate(pftcon%fr_flab(0:numpft)) + allocate(pftcon%fr_fcel(0:numpft)) + allocate(pftcon%fr_flig(0:numpft)) + allocate(pftcon%leaf_long(0:numpft)) + allocate(pftcon%evergreen(0:numpft)) + allocate(pftcon%stress_decid(0:numpft)) + allocate(pftcon%season_decid(0:numpft)) + allocate(pftcon%resist(0:numpft)) + allocate(pftcon%dwood(0:numpft)) + + pftcon%noveg(:) = huge(1) + pftcon%tree(:) = huge(1) + pftcon%smpso(:) = nan + pftcon%smpsc(:) = nan + pftcon%fnitr(:) = nan + pftcon%foln(:) = nan + pftcon%dleaf(:) = nan + pftcon%c3psn(:) = nan + pftcon%mp(:) = nan + pftcon%qe25(:) = nan + pftcon%xl(:) = nan + pftcon%rhol(:,:numrad) = nan + pftcon%rhos(:,:numrad) = nan + pftcon%taul(:,:numrad) = nan + pftcon%taus(:,:numrad) = nan + pftcon%z0mr(:) = nan + pftcon%displar(:) = nan + pftcon%roota_par(:) = nan + pftcon%rootb_par(:) = nan + pftcon%sla(:) = nan + pftcon%slatop(:) = nan + pftcon%dsladlai(:) = nan + pftcon%leafcn(:) = nan + pftcon%flnr(:) = nan + pftcon%woody(:) = nan + pftcon%lflitcn(:) = nan + pftcon%frootcn(:) = nan + pftcon%livewdcn(:) = nan + pftcon%deadwdcn(:) = nan + pftcon%graincn(:) = nan + pftcon%froot_leaf(:) = nan + pftcon%stem_leaf(:) = nan + pftcon%croot_stem(:) = nan + pftcon%flivewd(:) = nan + pftcon%fcur(:) = nan + pftcon%lf_flab(:) = nan + pftcon%lf_fcel(:) = nan + pftcon%lf_flig(:) = nan + pftcon%fr_flab(:) = nan + pftcon%fr_fcel(:) = nan + pftcon%fr_flig(:) = nan + pftcon%leaf_long(:) = nan + pftcon%evergreen(:) = nan + pftcon%stress_decid(:) = nan + pftcon%season_decid(:) = nan + pftcon%resist(:) = nan + pftcon%dwood(:) = nan + + end subroutine init_pft_ecophys_constants + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_DGVMecophys_constants +! +! !INTERFACE: + subroutine init_pft_DGVMecophys_constants() +! +! !DESCRIPTION: +! Initialize pft physical state +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(dgv_pftcon%crownarea_max(0:numpft)) + allocate(dgv_pftcon%tcmin(0:numpft)) + allocate(dgv_pftcon%tcmax(0:numpft)) + allocate(dgv_pftcon%gddmin(0:numpft)) + allocate(dgv_pftcon%twmax(0:numpft)) + allocate(dgv_pftcon%reinickerp(0:numpft)) + allocate(dgv_pftcon%allom1(0:numpft)) + allocate(dgv_pftcon%allom2(0:numpft)) + allocate(dgv_pftcon%allom3(0:numpft)) + + dgv_pftcon%crownarea_max(:) = nan + dgv_pftcon%tcmin(:) = nan + dgv_pftcon%tcmax(:) = nan + dgv_pftcon%gddmin(:) = nan + dgv_pftcon%twmax(:) = nan + dgv_pftcon%reinickerp(:) = nan + dgv_pftcon%allom1(:) = nan + dgv_pftcon%allom2(:) = nan + dgv_pftcon%allom3(:) = nan + + end subroutine init_pft_DGVMecophys_constants + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_pstate_type +! +! !INTERFACE: + subroutine init_pft_pstate_type(beg, end, pps) +! +! !DESCRIPTION: +! Initialize pft physical state +! +! !USES: + use clm_varcon, only : spval + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_pstate_type), intent(inout):: pps +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pps%frac_veg_nosno(beg:end)) + allocate(pps%frac_veg_nosno_alb(beg:end)) + allocate(pps%emv(beg:end)) + allocate(pps%z0mv(beg:end)) + allocate(pps%z0hv(beg:end)) + allocate(pps%z0qv(beg:end)) + allocate(pps%rootfr(beg:end,1:nlevgrnd)) + allocate(pps%rootr(beg:end,1:nlevgrnd)) + allocate(pps%rresis(beg:end,1:nlevgrnd)) + allocate(pps%dewmx(beg:end)) + allocate(pps%rssun(beg:end)) + allocate(pps%rssha(beg:end)) + allocate(pps%laisun(beg:end)) + allocate(pps%laisha(beg:end)) + allocate(pps%btran(beg:end)) + allocate(pps%fsun(beg:end)) + allocate(pps%tlai(beg:end)) + allocate(pps%tsai(beg:end)) + allocate(pps%elai(beg:end)) + allocate(pps%esai(beg:end)) + allocate(pps%fwet(beg:end)) + allocate(pps%fdry(beg:end)) + allocate(pps%dt_veg(beg:end)) + allocate(pps%htop(beg:end)) + allocate(pps%hbot(beg:end)) + allocate(pps%z0m(beg:end)) + allocate(pps%displa(beg:end)) + allocate(pps%albd(beg:end,1:numrad)) + allocate(pps%albi(beg:end,1:numrad)) + allocate(pps%fabd(beg:end,1:numrad)) + allocate(pps%fabi(beg:end,1:numrad)) + allocate(pps%ftdd(beg:end,1:numrad)) + allocate(pps%ftid(beg:end,1:numrad)) + allocate(pps%ftii(beg:end,1:numrad)) + allocate(pps%u10(beg:end)) + allocate(pps%u10_clm(beg:end)) + allocate(pps%va(beg:end)) + allocate(pps%fv(beg:end)) + allocate(pps%ram1(beg:end)) + if ( crop_prog )then + allocate(pps%hdidx(beg:end)) + allocate(pps%cumvd(beg:end)) + allocate(pps%htmx(beg:end)) + allocate(pps%vf(beg:end)) + allocate(pps%gddmaturity(beg:end)) + allocate(pps%gdd0(beg:end)) + allocate(pps%gdd8(beg:end)) + allocate(pps%gdd10(beg:end)) + allocate(pps%gdd020(beg:end)) + allocate(pps%gdd820(beg:end)) + allocate(pps%gdd1020(beg:end)) + allocate(pps%gddplant(beg:end)) + allocate(pps%gddtsoi(beg:end)) + allocate(pps%huileaf(beg:end)) + allocate(pps%huigrain(beg:end)) + allocate(pps%aleafi(beg:end)) + allocate(pps%astemi(beg:end)) + allocate(pps%aleaf(beg:end)) + allocate(pps%astem(beg:end)) + allocate(pps%croplive(beg:end)) + allocate(pps%cropplant(beg:end)) !,numpft)) ! make 2-D if using + allocate(pps%harvdate(beg:end)) !,numpft)) ! crop rotation + allocate(pps%idop(beg:end)) + allocate(pps%peaklai(beg:end)) + end if + allocate(pps%vds(beg:end)) + allocate(pps%slasun(beg:end)) + allocate(pps%slasha(beg:end)) + allocate(pps%lncsun(beg:end)) + allocate(pps%lncsha(beg:end)) + allocate(pps%vcmxsun(beg:end)) + allocate(pps%vcmxsha(beg:end)) + allocate(pps%gdir(beg:end)) + allocate(pps%omega(beg:end,1:numrad)) + allocate(pps%eff_kid(beg:end,1:numrad)) + allocate(pps%eff_kii(beg:end,1:numrad)) + allocate(pps%sun_faid(beg:end,1:numrad)) + allocate(pps%sun_faii(beg:end,1:numrad)) + allocate(pps%sha_faid(beg:end,1:numrad)) + allocate(pps%sha_faii(beg:end,1:numrad)) + allocate(pps%forc_hgt_u_pft(beg:end)) + allocate(pps%forc_hgt_t_pft(beg:end)) + allocate(pps%forc_hgt_q_pft(beg:end)) + ! 4/14/05: PET + ! Adding isotope code + allocate(pps%cisun(beg:end)) + allocate(pps%cisha(beg:end)) + allocate(pps%alphapsnsun(beg:end)) + allocate(pps%alphapsnsha(beg:end)) + + allocate(pps%sandfrac(beg:end)) + allocate(pps%clayfrac(beg:end)) + pps%sandfrac(beg:end) = nan + pps%clayfrac(beg:end) = nan + allocate(pps%mlaidiff(beg:end)) + allocate(pps%rb1(beg:end)) + allocate(pps%annlai(12,beg:end)) + pps%mlaidiff(beg:end) = nan + pps%rb1(beg:end) = nan + pps%annlai(:,:) = nan + + pps%frac_veg_nosno(beg:end) = huge(1) + pps%frac_veg_nosno_alb(beg:end) = 0 + pps%emv(beg:end) = nan + pps%z0mv(beg:end) = nan + pps%z0hv(beg:end) = nan + pps%z0qv(beg:end) = nan + pps%rootfr(beg:end,:nlevgrnd) = spval + pps%rootr (beg:end,:nlevgrnd) = spval + pps%rresis(beg:end,:nlevgrnd) = spval + pps%dewmx(beg:end) = nan + pps%rssun(beg:end) = nan + pps%rssha(beg:end) = nan + pps%laisun(beg:end) = nan + pps%laisha(beg:end) = nan + pps%btran(beg:end) = spval + pps%fsun(beg:end) = spval + pps%tlai(beg:end) = 0._r8 + pps%tsai(beg:end) = 0._r8 + pps%elai(beg:end) = 0._r8 + pps%esai(beg:end) = 0._r8 + pps%fwet(beg:end) = nan + pps%fdry(beg:end) = nan + pps%dt_veg(beg:end) = nan + pps%htop(beg:end) = 0._r8 + pps%hbot(beg:end) = 0._r8 + pps%z0m(beg:end) = nan + pps%displa(beg:end) = nan + pps%albd(beg:end,:numrad) = nan + pps%albi(beg:end,:numrad) = nan + pps%fabd(beg:end,:numrad) = nan + pps%fabi(beg:end,:numrad) = nan + pps%ftdd(beg:end,:numrad) = nan + pps%ftid(beg:end,:numrad) = nan + pps%ftii(beg:end,:numrad) = nan + pps%u10(beg:end) = nan + pps%u10_clm(beg:end) = nan + pps%va(beg:end) = nan + pps%fv(beg:end) = nan + pps%ram1(beg:end) = nan + if ( crop_prog )then + pps%hdidx(beg:end) = nan + pps%cumvd(beg:end) = nan + pps%htmx(beg:end) = 0.0_r8 + pps%vf(beg:end) = 0.0_r8 + pps%gddmaturity(beg:end) = spval + pps%gdd0(beg:end) = spval + pps%gdd8(beg:end) = spval + pps%gdd10(beg:end) = spval + pps%gdd020(beg:end) = spval + pps%gdd820(beg:end) = spval + pps%gdd1020(beg:end) = spval + pps%gddplant(beg:end) = spval + pps%gddtsoi(beg:end) = spval + pps%huileaf(beg:end) = nan + pps%huigrain(beg:end) = nan + pps%aleafi(beg:end) = nan + pps%astemi(beg:end) = nan + pps%aleaf(beg:end) = nan + pps%astem(beg:end) = nan + pps%croplive(beg:end) = .false. + pps%cropplant(beg:end) = .false. + pps%harvdate(beg:end) = huge(1) + pps%idop(beg:end) = huge(1) + pps%peaklai(beg:end) = 0 + end if + pps%vds(beg:end) = nan + pps%slasun(beg:end) = nan + pps%slasha(beg:end) = nan + pps%lncsun(beg:end) = nan + pps%lncsha(beg:end) = nan + pps%vcmxsun(beg:end) = nan + pps%vcmxsha(beg:end) = nan + pps%gdir(beg:end) = nan + pps%omega(beg:end,1:numrad) = nan + pps%eff_kid(beg:end,1:numrad) = nan + pps%eff_kii(beg:end,1:numrad) = nan + pps%sun_faid(beg:end,1:numrad) = nan + pps%sun_faii(beg:end,1:numrad) = nan + pps%sha_faid(beg:end,1:numrad) = nan + pps%sha_faii(beg:end,1:numrad) = nan + pps%forc_hgt_u_pft(beg:end) = nan + pps%forc_hgt_t_pft(beg:end) = nan + pps%forc_hgt_q_pft(beg:end) = nan + ! 4/14/05: PET + ! Adding isotope code + pps%cisun(beg:end) = nan + pps%cisha(beg:end) = nan + if (use_c13) then + pps%alphapsnsun(beg:end) = nan + pps%alphapsnsha(beg:end) = nan + endif + + end subroutine init_pft_pstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_epv_type +! +! !INTERFACE: + subroutine init_pft_epv_type(beg, end, pepv) +! +! !DESCRIPTION: +! Initialize pft ecophysiological variables +! +! !USES: +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_epv_type), intent(inout):: pepv +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + allocate(pepv%dormant_flag(beg:end)) + allocate(pepv%days_active(beg:end)) + allocate(pepv%onset_flag(beg:end)) + allocate(pepv%onset_counter(beg:end)) + allocate(pepv%onset_gddflag(beg:end)) + allocate(pepv%onset_fdd(beg:end)) + allocate(pepv%onset_gdd(beg:end)) + allocate(pepv%onset_swi(beg:end)) + allocate(pepv%offset_flag(beg:end)) + allocate(pepv%offset_counter(beg:end)) + allocate(pepv%offset_fdd(beg:end)) + allocate(pepv%offset_swi(beg:end)) + allocate(pepv%lgsf(beg:end)) + allocate(pepv%bglfr(beg:end)) + allocate(pepv%bgtr(beg:end)) + allocate(pepv%dayl(beg:end)) + allocate(pepv%prev_dayl(beg:end)) + allocate(pepv%annavg_t2m(beg:end)) + allocate(pepv%tempavg_t2m(beg:end)) + allocate(pepv%gpp(beg:end)) + allocate(pepv%availc(beg:end)) + allocate(pepv%xsmrpool_recover(beg:end)) + allocate(pepv%xsmrpool_c13ratio(beg:end)) + allocate(pepv%alloc_pnow(beg:end)) + allocate(pepv%c_allometry(beg:end)) + allocate(pepv%n_allometry(beg:end)) + allocate(pepv%plant_ndemand(beg:end)) + allocate(pepv%tempsum_potential_gpp(beg:end)) + allocate(pepv%annsum_potential_gpp(beg:end)) + allocate(pepv%tempmax_retransn(beg:end)) + allocate(pepv%annmax_retransn(beg:end)) + allocate(pepv%avail_retransn(beg:end)) + allocate(pepv%plant_nalloc(beg:end)) + allocate(pepv%plant_calloc(beg:end)) + allocate(pepv%excess_cflux(beg:end)) + allocate(pepv%downreg(beg:end)) + allocate(pepv%prev_leafc_to_litter(beg:end)) + allocate(pepv%prev_frootc_to_litter(beg:end)) + allocate(pepv%tempsum_npp(beg:end)) + allocate(pepv%annsum_npp(beg:end)) + allocate(pepv%tempsum_litfall(beg:end)) + allocate(pepv%annsum_litfall(beg:end)) + ! 4/21/05, PET + ! Adding isotope code + allocate(pepv%rc13_canair(beg:end)) + allocate(pepv%rc13_psnsun(beg:end)) + allocate(pepv%rc13_psnsha(beg:end)) + + pepv%dormant_flag(beg:end) = nan + pepv%days_active(beg:end) = nan + pepv%onset_flag(beg:end) = nan + pepv%onset_counter(beg:end) = nan + pepv%onset_gddflag(beg:end) = nan + pepv%onset_fdd(beg:end) = nan + pepv%onset_gdd(beg:end) = nan + pepv%onset_swi(beg:end) = nan + pepv%offset_flag(beg:end) = nan + pepv%offset_counter(beg:end) = nan + pepv%offset_fdd(beg:end) = nan + pepv%offset_swi(beg:end) = nan + pepv%lgsf(beg:end) = nan + pepv%bglfr(beg:end) = nan + pepv%bgtr(beg:end) = nan + pepv%dayl(beg:end) = nan + pepv%prev_dayl(beg:end) = nan + pepv%annavg_t2m(beg:end) = nan + pepv%tempavg_t2m(beg:end) = nan + pepv%gpp(beg:end) = nan + pepv%availc(beg:end) = nan + pepv%xsmrpool_recover(beg:end) = nan + if (use_c13) then + pepv%xsmrpool_c13ratio(beg:end) = nan + endif + pepv%alloc_pnow(beg:end) = nan + pepv%c_allometry(beg:end) = nan + pepv%n_allometry(beg:end) = nan + pepv%plant_ndemand(beg:end) = nan + pepv%tempsum_potential_gpp(beg:end) = nan + pepv%annsum_potential_gpp(beg:end) = nan + pepv%tempmax_retransn(beg:end) = nan + pepv%annmax_retransn(beg:end) = nan + pepv%avail_retransn(beg:end) = nan + pepv%plant_nalloc(beg:end) = nan + pepv%plant_calloc(beg:end) = nan + pepv%excess_cflux(beg:end) = nan + pepv%downreg(beg:end) = nan + pepv%prev_leafc_to_litter(beg:end) = nan + pepv%prev_frootc_to_litter(beg:end) = nan + pepv%tempsum_npp(beg:end) = nan + pepv%annsum_npp(beg:end) = nan + pepv%tempsum_litfall(beg:end) = nan + pepv%annsum_litfall(beg:end) = nan + if (use_c13) then + ! 4/21/05, PET + ! Adding isotope code + pepv%rc13_canair(beg:end) = nan + pepv%rc13_psnsun(beg:end) = nan + pepv%rc13_psnsha(beg:end) = nan + endif + + end subroutine init_pft_epv_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_pdgvstate_type +! +! !INTERFACE: + subroutine init_pft_pdgvstate_type(beg, end, pdgvs) +! +! !DESCRIPTION: +! Initialize pft DGVM state variables +! +! !USES: +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_dgvstate_type), intent(inout):: pdgvs +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pdgvs%agddtw(beg:end)) + allocate(pdgvs%agdd(beg:end)) + allocate(pdgvs%t_mo(beg:end)) + allocate(pdgvs%t_mo_min(beg:end)) + allocate(pdgvs%prec365(beg:end)) + allocate(pdgvs%present(beg:end)) + allocate(pdgvs%pftmayexist(beg:end)) + allocate(pdgvs%nind(beg:end)) + allocate(pdgvs%lm_ind(beg:end)) + allocate(pdgvs%lai_ind(beg:end)) + allocate(pdgvs%fpcinc(beg:end)) + allocate(pdgvs%fpcgrid(beg:end)) + allocate(pdgvs%fpcgridold(beg:end)) + allocate(pdgvs%crownarea(beg:end)) + allocate(pdgvs%greffic(beg:end)) + allocate(pdgvs%heatstress(beg:end)) + + pdgvs%agddtw(beg:end) = nan + pdgvs%agdd(beg:end) = nan + pdgvs%t_mo(beg:end) = nan + pdgvs%t_mo_min(beg:end) = nan + pdgvs%prec365(beg:end) = nan + pdgvs%present(beg:end) = .false. + pdgvs%pftmayexist(beg:end) = .true. + pdgvs%nind(beg:end) = nan + pdgvs%lm_ind(beg:end) = nan + pdgvs%lai_ind(beg:end) = nan + pdgvs%fpcinc(beg:end) = nan + pdgvs%fpcgrid(beg:end) = nan + pdgvs%fpcgridold(beg:end) = nan + pdgvs%crownarea(beg:end) = nan + pdgvs%greffic(beg:end) = nan + pdgvs%heatstress(beg:end) = nan + + end subroutine init_pft_pdgvstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_vstate_type +! +! !INTERFACE: + subroutine init_pft_vstate_type(beg, end, pvs) +! +! !DESCRIPTION: +! Initialize pft VOC variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_vstate_type), intent(inout):: pvs +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +!EOP +!------------------------------------------------------------------------ + + allocate(pvs%t_veg24 (beg:end)) + allocate(pvs%t_veg240(beg:end)) + allocate(pvs%fsd24 (beg:end)) + allocate(pvs%fsd240 (beg:end)) + allocate(pvs%fsi24 (beg:end)) + allocate(pvs%fsi240 (beg:end)) + allocate(pvs%fsun24 (beg:end)) + allocate(pvs%fsun240 (beg:end)) + allocate(pvs%elai_p (beg:end)) + + pvs%t_veg24 (beg:end) = spval + pvs%t_veg240(beg:end) = spval + pvs%fsd24 (beg:end) = spval + pvs%fsd240 (beg:end) = spval + pvs%fsi24 (beg:end) = spval + pvs%fsi240 (beg:end) = spval + pvs%fsun24 (beg:end) = spval + pvs%fsun240 (beg:end) = spval + pvs%elai_p (beg:end) = spval + end subroutine init_pft_vstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_estate_type +! +! !INTERFACE: + subroutine init_pft_estate_type(beg, end, pes) +! +! !DESCRIPTION: +! Initialize pft energy state +! +! !USES: + use clm_varcon, only : spval + use surfrdMod, only : crop_prog +! !AGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_estate_type), intent(inout):: pes +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + allocate(pes%t_ref2m(beg:end)) + allocate(pes%t_ref2m_min(beg:end)) + allocate(pes%t_ref2m_max(beg:end)) + allocate(pes%t_ref2m_min_inst(beg:end)) + allocate(pes%t_ref2m_max_inst(beg:end)) + allocate(pes%q_ref2m(beg:end)) + allocate(pes%t_ref2m_u(beg:end)) + allocate(pes%t_ref2m_r(beg:end)) + allocate(pes%t_ref2m_min_u(beg:end)) + allocate(pes%t_ref2m_min_r(beg:end)) + allocate(pes%t_ref2m_max_u(beg:end)) + allocate(pes%t_ref2m_max_r(beg:end)) + allocate(pes%t_ref2m_min_inst_u(beg:end)) + allocate(pes%t_ref2m_min_inst_r(beg:end)) + allocate(pes%t_ref2m_max_inst_u(beg:end)) + allocate(pes%t_ref2m_max_inst_r(beg:end)) + allocate(pes%t10(beg:end)) + if ( crop_prog )then + allocate(pes%a10tmin(beg:end)) + allocate(pes%a5tmin(beg:end)) + end if + allocate(pes%rh_ref2m(beg:end)) + allocate(pes%rh_ref2m_u(beg:end)) + allocate(pes%rh_ref2m_r(beg:end)) + allocate(pes%t_veg(beg:end)) + allocate(pes%thm(beg:end)) + + pes%t_ref2m(beg:end) = nan + pes%t_ref2m_min(beg:end) = nan + pes%t_ref2m_max(beg:end) = nan + pes%t_ref2m_min_inst(beg:end) = nan + pes%t_ref2m_max_inst(beg:end) = nan + pes%q_ref2m(beg:end) = nan + pes%t_ref2m_u(beg:end) = nan + pes%t_ref2m_r(beg:end) = nan + pes%t_ref2m_min_u(beg:end) = nan + pes%t_ref2m_min_r(beg:end) = nan + pes%t_ref2m_max_u(beg:end) = nan + pes%t_ref2m_max_r(beg:end) = nan + pes%t_ref2m_min_inst_u(beg:end) = nan + pes%t_ref2m_min_inst_r(beg:end) = nan + pes%t_ref2m_max_inst_u(beg:end) = nan + pes%t_ref2m_max_inst_r(beg:end) = nan + pes%t10(beg:end) = spval + if ( crop_prog )then + pes%a10tmin(beg:end) = spval + pes%a5tmin(beg:end) = spval + end if + pes%rh_ref2m(beg:end) = nan + pes%rh_ref2m_u(beg:end) = nan + pes%rh_ref2m_r(beg:end) = nan + pes%t_veg(beg:end) = nan + pes%thm(beg:end) = nan + + end subroutine init_pft_estate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_wstate_type +! +! !INTERFACE: + subroutine init_pft_wstate_type(beg, end, pws) +! +! !DESCRIPTION: +! Initialize pft water state +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_wstate_type), intent(inout):: pws !pft water state +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pws%h2ocan(beg:end)) + pws%h2ocan(beg:end) = nan + + end subroutine init_pft_wstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_cstate_type +! +! !INTERFACE: + subroutine init_pft_cstate_type(beg, end, pcs) +! +! !DESCRIPTION: +! Initialize pft carbon state +! +! !USES: + use surfrdMod, only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_cstate_type), intent(inout):: pcs !pft carbon state +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + allocate(pcs%leafc(beg:end)) + allocate(pcs%leafc_storage(beg:end)) + allocate(pcs%leafc_xfer(beg:end)) + allocate(pcs%frootc(beg:end)) + allocate(pcs%frootc_storage(beg:end)) + allocate(pcs%frootc_xfer(beg:end)) + allocate(pcs%livestemc(beg:end)) + allocate(pcs%livestemc_storage(beg:end)) + allocate(pcs%livestemc_xfer(beg:end)) + allocate(pcs%deadstemc(beg:end)) + allocate(pcs%deadstemc_storage(beg:end)) + allocate(pcs%deadstemc_xfer(beg:end)) + allocate(pcs%livecrootc(beg:end)) + allocate(pcs%livecrootc_storage(beg:end)) + allocate(pcs%livecrootc_xfer(beg:end)) + allocate(pcs%deadcrootc(beg:end)) + allocate(pcs%deadcrootc_storage(beg:end)) + allocate(pcs%deadcrootc_xfer(beg:end)) + allocate(pcs%gresp_storage(beg:end)) + allocate(pcs%gresp_xfer(beg:end)) + allocate(pcs%cpool(beg:end)) + allocate(pcs%xsmrpool(beg:end)) + allocate(pcs%pft_ctrunc(beg:end)) + allocate(pcs%dispvegc(beg:end)) + allocate(pcs%storvegc(beg:end)) + allocate(pcs%totvegc(beg:end)) + allocate(pcs%totpftc(beg:end)) + allocate(pcs%leafcmax(beg:end)) + if ( crop_prog )then + allocate(pcs%grainc(beg:end)) + allocate(pcs%grainc_storage(beg:end)) + allocate(pcs%grainc_xfer(beg:end)) + end if + allocate(pcs%woodc(beg:end)) + + pcs%leafc(beg:end) = nan + pcs%leafc_storage(beg:end) = nan + pcs%leafc_xfer(beg:end) = nan + pcs%frootc(beg:end) = nan + pcs%frootc_storage(beg:end) = nan + pcs%frootc_xfer(beg:end) = nan + pcs%livestemc(beg:end) = nan + pcs%livestemc_storage(beg:end) = nan + pcs%livestemc_xfer(beg:end) = nan + pcs%deadstemc(beg:end) = nan + pcs%deadstemc_storage(beg:end) = nan + pcs%deadstemc_xfer(beg:end) = nan + pcs%livecrootc(beg:end) = nan + pcs%livecrootc_storage(beg:end) = nan + pcs%livecrootc_xfer(beg:end) = nan + pcs%deadcrootc(beg:end) = nan + pcs%deadcrootc_storage(beg:end) = nan + pcs%deadcrootc_xfer(beg:end) = nan + pcs%gresp_storage(beg:end) = nan + pcs%gresp_xfer(beg:end) = nan + pcs%cpool(beg:end) = nan + pcs%xsmrpool(beg:end) = nan + pcs%pft_ctrunc(beg:end) = nan + pcs%dispvegc(beg:end) = nan + pcs%storvegc(beg:end) = nan + pcs%totvegc(beg:end) = nan + pcs%totpftc(beg:end) = nan + pcs%leafcmax(beg:end) = nan + if ( crop_prog )then + pcs%grainc(beg:end) = nan + pcs%grainc_storage(beg:end) = nan + pcs%grainc_xfer(beg:end) = nan + end if + pcs%woodc(beg:end) = nan + + end subroutine init_pft_cstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_nstate_type +! +! !INTERFACE: + subroutine init_pft_nstate_type(beg, end, pns) +! +! !DESCRIPTION: +! Initialize pft nitrogen state +! +! !USES: + use surfrdMod, only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_nstate_type), intent(inout):: pns !pft nitrogen state +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + if ( crop_prog )then + allocate(pns%grainn(beg:end)) + allocate(pns%grainn_storage(beg:end)) + allocate(pns%grainn_xfer(beg:end)) + end if + allocate(pns%leafn(beg:end)) + allocate(pns%leafn_storage(beg:end)) + allocate(pns%leafn_xfer(beg:end)) + allocate(pns%frootn(beg:end)) + allocate(pns%frootn_storage(beg:end)) + allocate(pns%frootn_xfer(beg:end)) + allocate(pns%livestemn(beg:end)) + allocate(pns%livestemn_storage(beg:end)) + allocate(pns%livestemn_xfer(beg:end)) + allocate(pns%deadstemn(beg:end)) + allocate(pns%deadstemn_storage(beg:end)) + allocate(pns%deadstemn_xfer(beg:end)) + allocate(pns%livecrootn(beg:end)) + allocate(pns%livecrootn_storage(beg:end)) + allocate(pns%livecrootn_xfer(beg:end)) + allocate(pns%deadcrootn(beg:end)) + allocate(pns%deadcrootn_storage(beg:end)) + allocate(pns%deadcrootn_xfer(beg:end)) + allocate(pns%retransn(beg:end)) + allocate(pns%npool(beg:end)) + allocate(pns%pft_ntrunc(beg:end)) + allocate(pns%dispvegn(beg:end)) + allocate(pns%storvegn(beg:end)) + allocate(pns%totvegn(beg:end)) + allocate(pns%totpftn(beg:end)) + + if ( crop_prog )then + pns%grainn(beg:end) = nan + pns%grainn_storage(beg:end) = nan + pns%grainn_xfer(beg:end) = nan + end if + pns%leafn(beg:end) = nan + pns%leafn_storage(beg:end) = nan + pns%leafn_xfer(beg:end) = nan + pns%frootn(beg:end) = nan + pns%frootn_storage(beg:end) = nan + pns%frootn_xfer(beg:end) = nan + pns%livestemn(beg:end) = nan + pns%livestemn_storage(beg:end) = nan + pns%livestemn_xfer(beg:end) = nan + pns%deadstemn(beg:end) = nan + pns%deadstemn_storage(beg:end) = nan + pns%deadstemn_xfer(beg:end) = nan + pns%livecrootn(beg:end) = nan + pns%livecrootn_storage(beg:end) = nan + pns%livecrootn_xfer(beg:end) = nan + pns%deadcrootn(beg:end) = nan + pns%deadcrootn_storage(beg:end) = nan + pns%deadcrootn_xfer(beg:end) = nan + pns%retransn(beg:end) = nan + pns%npool(beg:end) = nan + pns%pft_ntrunc(beg:end) = nan + pns%dispvegn(beg:end) = nan + pns%storvegn(beg:end) = nan + pns%totvegn(beg:end) = nan + pns%totpftn(beg:end) = nan + + end subroutine init_pft_nstate_type +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_eflux_type +! +! !INTERFACE: + subroutine init_pft_eflux_type(beg, end, pef) +! +! !DESCRIPTION: +! Initialize pft energy flux variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_eflux_type), intent(inout):: pef +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pef%sabg(beg:end)) + allocate(pef%sabv(beg:end)) + allocate(pef%fsa(beg:end)) + allocate(pef%fsa_u(beg:end)) + allocate(pef%fsa_r(beg:end)) + allocate(pef%fsr(beg:end)) + allocate(pef%parsun(beg:end)) + allocate(pef%parsha(beg:end)) + allocate(pef%dlrad(beg:end)) + allocate(pef%ulrad(beg:end)) + allocate(pef%eflx_lh_tot(beg:end)) + allocate(pef%eflx_lh_tot_u(beg:end)) + allocate(pef%eflx_lh_tot_r(beg:end)) + allocate(pef%eflx_lh_grnd(beg:end)) + allocate(pef%eflx_soil_grnd(beg:end)) + allocate(pef%eflx_soil_grnd_u(beg:end)) + allocate(pef%eflx_soil_grnd_r(beg:end)) + allocate(pef%eflx_sh_tot(beg:end)) + allocate(pef%eflx_sh_tot_u(beg:end)) + allocate(pef%eflx_sh_tot_r(beg:end)) + allocate(pef%eflx_sh_grnd(beg:end)) + allocate(pef%eflx_sh_veg(beg:end)) + allocate(pef%eflx_lh_vege(beg:end)) + allocate(pef%eflx_lh_vegt(beg:end)) + allocate(pef%eflx_wasteheat_pft(beg:end)) + allocate(pef%eflx_heat_from_ac_pft(beg:end)) + allocate(pef%eflx_traffic_pft(beg:end)) + allocate(pef%eflx_anthro(beg:end)) + allocate(pef%cgrnd(beg:end)) + allocate(pef%cgrndl(beg:end)) + allocate(pef%cgrnds(beg:end)) + allocate(pef%eflx_gnet(beg:end)) + allocate(pef%dgnetdT(beg:end)) + allocate(pef%eflx_lwrad_out(beg:end)) + allocate(pef%eflx_lwrad_net(beg:end)) + allocate(pef%eflx_lwrad_net_u(beg:end)) + allocate(pef%eflx_lwrad_net_r(beg:end)) + allocate(pef%netrad(beg:end)) + allocate(pef%fsds_vis_d(beg:end)) + allocate(pef%fsds_nir_d(beg:end)) + allocate(pef%fsds_vis_i(beg:end)) + allocate(pef%fsds_nir_i(beg:end)) + allocate(pef%fsr_vis_d(beg:end)) + allocate(pef%fsr_nir_d(beg:end)) + allocate(pef%fsr_vis_i(beg:end)) + allocate(pef%fsr_nir_i(beg:end)) + allocate(pef%fsds_vis_d_ln(beg:end)) + allocate(pef%fsds_nir_d_ln(beg:end)) + allocate(pef%fsr_vis_d_ln(beg:end)) + allocate(pef%fsr_nir_d_ln(beg:end)) + allocate(pef%sun_add(beg:end,1:numrad)) + allocate(pef%tot_aid(beg:end,1:numrad)) + allocate(pef%sun_aid(beg:end,1:numrad)) + allocate(pef%sun_aii(beg:end,1:numrad)) + allocate(pef%sha_aid(beg:end,1:numrad)) + allocate(pef%sha_aii(beg:end,1:numrad)) + allocate(pef%sun_atot(beg:end,1:numrad)) + allocate(pef%sha_atot(beg:end,1:numrad)) + allocate(pef%sun_alf(beg:end,1:numrad)) + allocate(pef%sha_alf(beg:end,1:numrad)) + allocate(pef%sun_aperlai(beg:end,1:numrad)) + allocate(pef%sha_aperlai(beg:end,1:numrad)) + allocate(pef%sabg_lyr(beg:end,-nlevsno+1:1)) + allocate(pef%sfc_frc_aer(beg:end)) + allocate(pef%sfc_frc_bc(beg:end)) + allocate(pef%sfc_frc_oc(beg:end)) + allocate(pef%sfc_frc_dst(beg:end)) + allocate(pef%sfc_frc_aer_sno(beg:end)) + allocate(pef%sfc_frc_bc_sno(beg:end)) + allocate(pef%sfc_frc_oc_sno(beg:end)) + allocate(pef%sfc_frc_dst_sno(beg:end)) + allocate(pef%fsr_sno_vd(beg:end)) + allocate(pef%fsr_sno_nd(beg:end)) + allocate(pef%fsr_sno_vi(beg:end)) + allocate(pef%fsr_sno_ni(beg:end)) + allocate(pef%fsds_sno_vd(beg:end)) + allocate(pef%fsds_sno_nd(beg:end)) + allocate(pef%fsds_sno_vi(beg:end)) + allocate(pef%fsds_sno_ni(beg:end)) + + pef%sabg(beg:end) = nan + pef%sabv(beg:end) = nan + pef%fsa(beg:end) = nan + pef%fsa_u(beg:end) = nan + pef%fsa_r(beg:end) = nan + pef%fsr(beg:end) = nan + pef%parsun(beg:end) = nan + pef%parsha(beg:end) = nan + pef%dlrad(beg:end) = nan + pef%ulrad(beg:end) = nan + pef%eflx_lh_tot(beg:end) = nan + pef%eflx_lh_tot_u(beg:end) = nan + pef%eflx_lh_tot_r(beg:end) = nan + pef%eflx_lh_grnd(beg:end) = nan + pef%eflx_soil_grnd(beg:end) = nan + pef%eflx_soil_grnd_u(beg:end) = nan + pef%eflx_soil_grnd_r(beg:end) = nan + pef%eflx_sh_tot(beg:end) = nan + pef%eflx_sh_tot_u(beg:end) = nan + pef%eflx_sh_tot_r(beg:end) = nan + pef%eflx_sh_grnd(beg:end) = nan + pef%eflx_sh_veg(beg:end) = nan + pef%eflx_lh_vege(beg:end) = nan + pef%eflx_lh_vegt(beg:end) = nan + pef%eflx_wasteheat_pft(beg:end) = spval + pef%eflx_heat_from_ac_pft(beg:end) = spval + pef%eflx_traffic_pft(beg:end) = spval + pef%eflx_anthro(beg:end) = nan + pef%cgrnd(beg:end) = nan + pef%cgrndl(beg:end) = nan + pef%cgrnds(beg:end) = nan + pef%eflx_gnet(beg:end) = nan + pef%dgnetdT(beg:end) = nan + pef%eflx_lwrad_out(beg:end) = nan + pef%eflx_lwrad_net(beg:end) = nan + pef%eflx_lwrad_net_u(beg:end) = nan + pef%eflx_lwrad_net_r(beg:end) = nan + pef%netrad(beg:end) = nan + pef%fsds_vis_d(beg:end) = nan + pef%fsds_nir_d(beg:end) = nan + pef%fsds_vis_i(beg:end) = nan + pef%fsds_nir_i(beg:end) = nan + pef%fsr_vis_d(beg:end) = nan + pef%fsr_nir_d(beg:end) = nan + pef%fsr_vis_i(beg:end) = nan + pef%fsr_nir_i(beg:end) = nan + pef%fsds_vis_d_ln(beg:end) = nan + pef%fsds_nir_d_ln(beg:end) = nan + pef%fsr_vis_d_ln(beg:end) = nan + pef%fsr_nir_d_ln(beg:end) = nan + pef%sun_add(beg:end,1:numrad) = nan + pef%tot_aid(beg:end,1:numrad) = nan + pef%sun_aid(beg:end,1:numrad) = nan + pef%sun_aii(beg:end,1:numrad) = nan + pef%sha_aid(beg:end,1:numrad) = nan + pef%sha_aii(beg:end,1:numrad) = nan + pef%sun_atot(beg:end,1:numrad) = nan + pef%sha_atot(beg:end,1:numrad) = nan + pef%sun_alf(beg:end,1:numrad) = nan + pef%sha_alf(beg:end,1:numrad) = nan + pef%sun_aperlai(beg:end,1:numrad) = nan + pef%sha_aperlai(beg:end,1:numrad) = nan + pef%sabg_lyr(beg:end,-nlevsno+1:1) = nan + pef%sfc_frc_aer(beg:end) = nan + pef%sfc_frc_bc(beg:end) = nan + pef%sfc_frc_oc(beg:end) = nan + pef%sfc_frc_dst(beg:end) = nan + pef%sfc_frc_aer_sno(beg:end) = nan + pef%sfc_frc_bc_sno(beg:end) = nan + pef%sfc_frc_oc_sno(beg:end) = nan + pef%sfc_frc_dst_sno(beg:end) = nan + pef%fsr_sno_vd(beg:end) = nan + pef%fsr_sno_nd(beg:end) = nan + pef%fsr_sno_vi(beg:end) = nan + pef%fsr_sno_ni(beg:end) = nan + pef%fsds_sno_vd(beg:end) = nan + pef%fsds_sno_nd(beg:end) = nan + pef%fsds_sno_vi(beg:end) = nan + pef%fsds_sno_ni(beg:end) = nan + end subroutine init_pft_eflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_mflux_type +! +! !INTERFACE: + subroutine init_pft_mflux_type(beg, end, pmf) +! +! !DESCRIPTION: +! Initialize pft momentum flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_mflux_type), intent(inout) :: pmf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pmf%taux(beg:end)) + allocate(pmf%tauy(beg:end)) + + pmf%taux(beg:end) = nan + pmf%tauy(beg:end) = nan + + end subroutine init_pft_mflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_wflux_type +! +! !INTERFACE: + subroutine init_pft_wflux_type(beg, end, pwf) +! +! !DESCRIPTION: +! Initialize pft water flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_wflux_type), intent(inout) :: pwf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pwf%qflx_prec_intr(beg:end)) + allocate(pwf%qflx_prec_grnd(beg:end)) + allocate(pwf%qflx_rain_grnd(beg:end)) + allocate(pwf%qflx_snow_grnd(beg:end)) + allocate(pwf%qflx_snwcp_liq(beg:end)) + allocate(pwf%qflx_snwcp_ice(beg:end)) + allocate(pwf%qflx_evap_veg(beg:end)) + allocate(pwf%qflx_tran_veg(beg:end)) + allocate(pwf%qflx_evap_can(beg:end)) + allocate(pwf%qflx_evap_soi(beg:end)) + allocate(pwf%qflx_evap_tot(beg:end)) + allocate(pwf%qflx_evap_grnd(beg:end)) + allocate(pwf%qflx_dew_grnd(beg:end)) + allocate(pwf%qflx_sub_snow(beg:end)) + allocate(pwf%qflx_dew_snow(beg:end)) + + pwf%qflx_prec_intr(beg:end) = nan + pwf%qflx_prec_grnd(beg:end) = nan + pwf%qflx_rain_grnd(beg:end) = nan + pwf%qflx_snow_grnd(beg:end) = nan + pwf%qflx_snwcp_liq(beg:end) = nan + pwf%qflx_snwcp_ice(beg:end) = nan + pwf%qflx_evap_veg(beg:end) = nan + pwf%qflx_tran_veg(beg:end) = nan + pwf%qflx_evap_can(beg:end) = nan + pwf%qflx_evap_soi(beg:end) = nan + pwf%qflx_evap_tot(beg:end) = nan + pwf%qflx_evap_grnd(beg:end) = nan + pwf%qflx_dew_grnd(beg:end) = nan + pwf%qflx_sub_snow(beg:end) = nan + pwf%qflx_dew_snow(beg:end) = nan + + end subroutine init_pft_wflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_cflux_type +! +! !INTERFACE: + subroutine init_pft_cflux_type(beg, end, pcf) +! +! !DESCRIPTION: +! Initialize pft carbon flux variables +! +! !USES: + use clm_varcon, only : spval + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_cflux_type), intent(inout) :: pcf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pcf%psnsun(beg:end)) + allocate(pcf%psnsha(beg:end)) + allocate(pcf%fpsn(beg:end)) + allocate(pcf%fco2(beg:end)) + + allocate(pcf%m_leafc_to_litter(beg:end)) + allocate(pcf%m_frootc_to_litter(beg:end)) + allocate(pcf%m_leafc_storage_to_litter(beg:end)) + allocate(pcf%m_frootc_storage_to_litter(beg:end)) + allocate(pcf%m_livestemc_storage_to_litter(beg:end)) + allocate(pcf%m_deadstemc_storage_to_litter(beg:end)) + allocate(pcf%m_livecrootc_storage_to_litter(beg:end)) + allocate(pcf%m_deadcrootc_storage_to_litter(beg:end)) + allocate(pcf%m_leafc_xfer_to_litter(beg:end)) + allocate(pcf%m_frootc_xfer_to_litter(beg:end)) + allocate(pcf%m_livestemc_xfer_to_litter(beg:end)) + allocate(pcf%m_deadstemc_xfer_to_litter(beg:end)) + allocate(pcf%m_livecrootc_xfer_to_litter(beg:end)) + allocate(pcf%m_deadcrootc_xfer_to_litter(beg:end)) + allocate(pcf%m_livestemc_to_litter(beg:end)) + allocate(pcf%m_deadstemc_to_litter(beg:end)) + allocate(pcf%m_livecrootc_to_litter(beg:end)) + allocate(pcf%m_deadcrootc_to_litter(beg:end)) + allocate(pcf%m_gresp_storage_to_litter(beg:end)) + allocate(pcf%m_gresp_xfer_to_litter(beg:end)) + allocate(pcf%hrv_leafc_to_litter(beg:end)) + allocate(pcf%hrv_leafc_storage_to_litter(beg:end)) + allocate(pcf%hrv_leafc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_frootc_to_litter(beg:end)) + allocate(pcf%hrv_frootc_storage_to_litter(beg:end)) + allocate(pcf%hrv_frootc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_livestemc_to_litter(beg:end)) + allocate(pcf%hrv_livestemc_storage_to_litter(beg:end)) + allocate(pcf%hrv_livestemc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_deadstemc_to_prod10c(beg:end)) + allocate(pcf%hrv_deadstemc_to_prod100c(beg:end)) + allocate(pcf%hrv_deadstemc_storage_to_litter(beg:end)) + allocate(pcf%hrv_deadstemc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_livecrootc_to_litter(beg:end)) + allocate(pcf%hrv_livecrootc_storage_to_litter(beg:end)) + allocate(pcf%hrv_livecrootc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_deadcrootc_to_litter(beg:end)) + allocate(pcf%hrv_deadcrootc_storage_to_litter(beg:end)) + allocate(pcf%hrv_deadcrootc_xfer_to_litter(beg:end)) + allocate(pcf%hrv_gresp_storage_to_litter(beg:end)) + allocate(pcf%hrv_gresp_xfer_to_litter(beg:end)) + allocate(pcf%hrv_xsmrpool_to_atm(beg:end)) + allocate(pcf%m_leafc_to_fire(beg:end)) + allocate(pcf%m_frootc_to_fire(beg:end)) + allocate(pcf%m_leafc_storage_to_fire(beg:end)) + allocate(pcf%m_frootc_storage_to_fire(beg:end)) + allocate(pcf%m_livestemc_storage_to_fire(beg:end)) + allocate(pcf%m_deadstemc_storage_to_fire(beg:end)) + allocate(pcf%m_livecrootc_storage_to_fire(beg:end)) + allocate(pcf%m_deadcrootc_storage_to_fire(beg:end)) + allocate(pcf%m_leafc_xfer_to_fire(beg:end)) + allocate(pcf%m_frootc_xfer_to_fire(beg:end)) + allocate(pcf%m_livestemc_xfer_to_fire(beg:end)) + allocate(pcf%m_deadstemc_xfer_to_fire(beg:end)) + allocate(pcf%m_livecrootc_xfer_to_fire(beg:end)) + allocate(pcf%m_deadcrootc_xfer_to_fire(beg:end)) + allocate(pcf%m_livestemc_to_fire(beg:end)) + allocate(pcf%m_deadstemc_to_fire(beg:end)) + allocate(pcf%m_deadstemc_to_litter_fire(beg:end)) + allocate(pcf%m_livecrootc_to_fire(beg:end)) + allocate(pcf%m_deadcrootc_to_fire(beg:end)) + allocate(pcf%m_deadcrootc_to_litter_fire(beg:end)) + allocate(pcf%m_gresp_storage_to_fire(beg:end)) + allocate(pcf%m_gresp_xfer_to_fire(beg:end)) + allocate(pcf%leafc_xfer_to_leafc(beg:end)) + allocate(pcf%frootc_xfer_to_frootc(beg:end)) + allocate(pcf%livestemc_xfer_to_livestemc(beg:end)) + allocate(pcf%deadstemc_xfer_to_deadstemc(beg:end)) + allocate(pcf%livecrootc_xfer_to_livecrootc(beg:end)) + allocate(pcf%deadcrootc_xfer_to_deadcrootc(beg:end)) + allocate(pcf%leafc_to_litter(beg:end)) + allocate(pcf%frootc_to_litter(beg:end)) + allocate(pcf%leaf_mr(beg:end)) + allocate(pcf%froot_mr(beg:end)) + allocate(pcf%livestem_mr(beg:end)) + allocate(pcf%livecroot_mr(beg:end)) + allocate(pcf%leaf_curmr(beg:end)) + allocate(pcf%froot_curmr(beg:end)) + allocate(pcf%livestem_curmr(beg:end)) + allocate(pcf%livecroot_curmr(beg:end)) + allocate(pcf%leaf_xsmr(beg:end)) + allocate(pcf%froot_xsmr(beg:end)) + allocate(pcf%livestem_xsmr(beg:end)) + allocate(pcf%livecroot_xsmr(beg:end)) + allocate(pcf%psnsun_to_cpool(beg:end)) + allocate(pcf%psnshade_to_cpool(beg:end)) + allocate(pcf%cpool_to_xsmrpool(beg:end)) + allocate(pcf%cpool_to_leafc(beg:end)) + allocate(pcf%cpool_to_leafc_storage(beg:end)) + allocate(pcf%cpool_to_frootc(beg:end)) + allocate(pcf%cpool_to_frootc_storage(beg:end)) + allocate(pcf%cpool_to_livestemc(beg:end)) + allocate(pcf%cpool_to_livestemc_storage(beg:end)) + allocate(pcf%cpool_to_deadstemc(beg:end)) + allocate(pcf%cpool_to_deadstemc_storage(beg:end)) + allocate(pcf%cpool_to_livecrootc(beg:end)) + allocate(pcf%cpool_to_livecrootc_storage(beg:end)) + allocate(pcf%cpool_to_deadcrootc(beg:end)) + allocate(pcf%cpool_to_deadcrootc_storage(beg:end)) + allocate(pcf%cpool_to_gresp_storage(beg:end)) + allocate(pcf%cpool_leaf_gr(beg:end)) + allocate(pcf%cpool_leaf_storage_gr(beg:end)) + allocate(pcf%transfer_leaf_gr(beg:end)) + allocate(pcf%cpool_froot_gr(beg:end)) + allocate(pcf%cpool_froot_storage_gr(beg:end)) + allocate(pcf%transfer_froot_gr(beg:end)) + allocate(pcf%cpool_livestem_gr(beg:end)) + allocate(pcf%cpool_livestem_storage_gr(beg:end)) + allocate(pcf%transfer_livestem_gr(beg:end)) + allocate(pcf%cpool_deadstem_gr(beg:end)) + allocate(pcf%cpool_deadstem_storage_gr(beg:end)) + allocate(pcf%transfer_deadstem_gr(beg:end)) + allocate(pcf%cpool_livecroot_gr(beg:end)) + allocate(pcf%cpool_livecroot_storage_gr(beg:end)) + allocate(pcf%transfer_livecroot_gr(beg:end)) + allocate(pcf%cpool_deadcroot_gr(beg:end)) + allocate(pcf%cpool_deadcroot_storage_gr(beg:end)) + allocate(pcf%transfer_deadcroot_gr(beg:end)) + allocate(pcf%leafc_storage_to_xfer(beg:end)) + allocate(pcf%frootc_storage_to_xfer(beg:end)) + allocate(pcf%livestemc_storage_to_xfer(beg:end)) + allocate(pcf%deadstemc_storage_to_xfer(beg:end)) + allocate(pcf%livecrootc_storage_to_xfer(beg:end)) + allocate(pcf%deadcrootc_storage_to_xfer(beg:end)) + allocate(pcf%gresp_storage_to_xfer(beg:end)) + allocate(pcf%livestemc_to_deadstemc(beg:end)) + allocate(pcf%livecrootc_to_deadcrootc(beg:end)) + allocate(pcf%gpp(beg:end)) + allocate(pcf%mr(beg:end)) + allocate(pcf%current_gr(beg:end)) + allocate(pcf%transfer_gr(beg:end)) + allocate(pcf%storage_gr(beg:end)) + allocate(pcf%gr(beg:end)) + allocate(pcf%ar(beg:end)) + allocate(pcf%rr(beg:end)) + allocate(pcf%npp(beg:end)) + allocate(pcf%agnpp(beg:end)) + allocate(pcf%bgnpp(beg:end)) + allocate(pcf%litfall(beg:end)) + allocate(pcf%vegfire(beg:end)) + allocate(pcf%wood_harvestc(beg:end)) + allocate(pcf%pft_cinputs(beg:end)) + allocate(pcf%pft_coutputs(beg:end)) + allocate(pcf%pft_fire_closs(beg:end)) + if ( crop_prog )then + allocate(pcf%xsmrpool_to_atm(beg:end)) + allocate(pcf%grainc_xfer_to_grainc(beg:end)) + allocate(pcf%livestemc_to_litter(beg:end)) + allocate(pcf%grainc_to_food(beg:end)) + allocate(pcf%cpool_to_grainc(beg:end)) + allocate(pcf%cpool_to_grainc_storage(beg:end)) + allocate(pcf%cpool_grain_gr(beg:end)) + allocate(pcf%cpool_grain_storage_gr(beg:end)) + allocate(pcf%transfer_grain_gr(beg:end)) + allocate(pcf%grainc_storage_to_xfer(beg:end)) + end if + if (use_cn) then + allocate(pcf%frootc_alloc(beg:end)) + allocate(pcf%frootc_loss(beg:end)) + allocate(pcf%leafc_alloc(beg:end)) + allocate(pcf%leafc_loss(beg:end)) + allocate(pcf%woodc_alloc(beg:end)) + allocate(pcf%woodc_loss(beg:end)) + end if + + pcf%psnsun(beg:end) = nan + pcf%psnsha(beg:end) = nan + pcf%fpsn(beg:end) = spval + pcf%fco2(beg:end) = 0._r8 + + pcf%m_leafc_to_litter(beg:end) = nan + pcf%m_frootc_to_litter(beg:end) = nan + pcf%m_leafc_storage_to_litter(beg:end) = nan + pcf%m_frootc_storage_to_litter(beg:end) = nan + pcf%m_livestemc_storage_to_litter(beg:end) = nan + pcf%m_deadstemc_storage_to_litter(beg:end) = nan + pcf%m_livecrootc_storage_to_litter(beg:end) = nan + pcf%m_deadcrootc_storage_to_litter(beg:end) = nan + pcf%m_leafc_xfer_to_litter(beg:end) = nan + pcf%m_frootc_xfer_to_litter(beg:end) = nan + pcf%m_livestemc_xfer_to_litter(beg:end) = nan + pcf%m_deadstemc_xfer_to_litter(beg:end) = nan + pcf%m_livecrootc_xfer_to_litter(beg:end) = nan + pcf%m_deadcrootc_xfer_to_litter(beg:end) = nan + pcf%m_livestemc_to_litter(beg:end) = nan + pcf%m_deadstemc_to_litter(beg:end) = nan + pcf%m_livecrootc_to_litter(beg:end) = nan + pcf%m_deadcrootc_to_litter(beg:end) = nan + pcf%m_gresp_storage_to_litter(beg:end) = nan + pcf%m_gresp_xfer_to_litter(beg:end) = nan + pcf%hrv_leafc_to_litter(beg:end) = nan + pcf%hrv_leafc_storage_to_litter(beg:end) = nan + pcf%hrv_leafc_xfer_to_litter(beg:end) = nan + pcf%hrv_frootc_to_litter(beg:end) = nan + pcf%hrv_frootc_storage_to_litter(beg:end) = nan + pcf%hrv_frootc_xfer_to_litter(beg:end) = nan + pcf%hrv_livestemc_to_litter(beg:end) = nan + pcf%hrv_livestemc_storage_to_litter(beg:end) = nan + pcf%hrv_livestemc_xfer_to_litter(beg:end) = nan + pcf%hrv_deadstemc_to_prod10c(beg:end) = nan + pcf%hrv_deadstemc_to_prod100c(beg:end) = nan + pcf%hrv_deadstemc_storage_to_litter(beg:end) = nan + pcf%hrv_deadstemc_xfer_to_litter(beg:end) = nan + pcf%hrv_livecrootc_to_litter(beg:end) = nan + pcf%hrv_livecrootc_storage_to_litter(beg:end) = nan + pcf%hrv_livecrootc_xfer_to_litter(beg:end) = nan + pcf%hrv_deadcrootc_to_litter(beg:end) = nan + pcf%hrv_deadcrootc_storage_to_litter(beg:end) = nan + pcf%hrv_deadcrootc_xfer_to_litter(beg:end) = nan + pcf%hrv_gresp_storage_to_litter(beg:end) = nan + pcf%hrv_gresp_xfer_to_litter(beg:end) = nan + pcf%hrv_xsmrpool_to_atm(beg:end) = nan + pcf%m_leafc_to_fire(beg:end) = nan + pcf%m_frootc_to_fire(beg:end) = nan + pcf%m_leafc_storage_to_fire(beg:end) = nan + pcf%m_frootc_storage_to_fire(beg:end) = nan + pcf%m_livestemc_storage_to_fire(beg:end) = nan + pcf%m_deadstemc_storage_to_fire(beg:end) = nan + pcf%m_livecrootc_storage_to_fire(beg:end) = nan + pcf%m_deadcrootc_storage_to_fire(beg:end) = nan + pcf%m_leafc_xfer_to_fire(beg:end) = nan + pcf%m_frootc_xfer_to_fire(beg:end) = nan + pcf%m_livestemc_xfer_to_fire(beg:end) = nan + pcf%m_deadstemc_xfer_to_fire(beg:end) = nan + pcf%m_livecrootc_xfer_to_fire(beg:end) = nan + pcf%m_deadcrootc_xfer_to_fire(beg:end) = nan + pcf%m_livestemc_to_fire(beg:end) = nan + pcf%m_deadstemc_to_fire(beg:end) = nan + pcf%m_deadstemc_to_litter_fire(beg:end) = nan + pcf%m_livecrootc_to_fire(beg:end) = nan + pcf%m_deadcrootc_to_fire(beg:end) = nan + pcf%m_deadcrootc_to_litter_fire(beg:end) = nan + pcf%m_gresp_storage_to_fire(beg:end) = nan + pcf%m_gresp_xfer_to_fire(beg:end) = nan + pcf%leafc_xfer_to_leafc(beg:end) = nan + pcf%frootc_xfer_to_frootc(beg:end) = nan + pcf%livestemc_xfer_to_livestemc(beg:end) = nan + pcf%deadstemc_xfer_to_deadstemc(beg:end) = nan + pcf%livecrootc_xfer_to_livecrootc(beg:end) = nan + pcf%deadcrootc_xfer_to_deadcrootc(beg:end) = nan + pcf%leafc_to_litter(beg:end) = nan + pcf%frootc_to_litter(beg:end) = nan + pcf%leaf_mr(beg:end) = nan + pcf%froot_mr(beg:end) = nan + pcf%livestem_mr(beg:end) = nan + pcf%livecroot_mr(beg:end) = nan + pcf%leaf_curmr(beg:end) = nan + pcf%froot_curmr(beg:end) = nan + pcf%livestem_curmr(beg:end) = nan + pcf%livecroot_curmr(beg:end) = nan + pcf%leaf_xsmr(beg:end) = nan + pcf%froot_xsmr(beg:end) = nan + pcf%livestem_xsmr(beg:end) = nan + pcf%livecroot_xsmr(beg:end) = nan + pcf%psnsun_to_cpool(beg:end) = nan + pcf%psnshade_to_cpool(beg:end) = nan + pcf%cpool_to_xsmrpool(beg:end) = nan + pcf%cpool_to_leafc(beg:end) = nan + pcf%cpool_to_leafc_storage(beg:end) = nan + pcf%cpool_to_frootc(beg:end) = nan + pcf%cpool_to_frootc_storage(beg:end) = nan + pcf%cpool_to_livestemc(beg:end) = nan + pcf%cpool_to_livestemc_storage(beg:end) = nan + pcf%cpool_to_deadstemc(beg:end) = nan + pcf%cpool_to_deadstemc_storage(beg:end) = nan + pcf%cpool_to_livecrootc(beg:end) = nan + pcf%cpool_to_livecrootc_storage(beg:end) = nan + pcf%cpool_to_deadcrootc(beg:end) = nan + pcf%cpool_to_deadcrootc_storage(beg:end) = nan + pcf%cpool_to_gresp_storage(beg:end) = nan + pcf%cpool_leaf_gr(beg:end) = nan + pcf%cpool_leaf_storage_gr(beg:end) = nan + pcf%transfer_leaf_gr(beg:end) = nan + pcf%cpool_froot_gr(beg:end) = nan + pcf%cpool_froot_storage_gr(beg:end) = nan + pcf%transfer_froot_gr(beg:end) = nan + pcf%cpool_livestem_gr(beg:end) = nan + pcf%cpool_livestem_storage_gr(beg:end) = nan + pcf%transfer_livestem_gr(beg:end) = nan + pcf%cpool_deadstem_gr(beg:end) = nan + pcf%cpool_deadstem_storage_gr(beg:end) = nan + pcf%transfer_deadstem_gr(beg:end) = nan + pcf%cpool_livecroot_gr(beg:end) = nan + pcf%cpool_livecroot_storage_gr(beg:end) = nan + pcf%transfer_livecroot_gr(beg:end) = nan + pcf%cpool_deadcroot_gr(beg:end) = nan + pcf%cpool_deadcroot_storage_gr(beg:end) = nan + pcf%transfer_deadcroot_gr(beg:end) = nan + pcf%leafc_storage_to_xfer(beg:end) = nan + pcf%frootc_storage_to_xfer(beg:end) = nan + pcf%livestemc_storage_to_xfer(beg:end) = nan + pcf%deadstemc_storage_to_xfer(beg:end) = nan + pcf%livecrootc_storage_to_xfer(beg:end) = nan + pcf%deadcrootc_storage_to_xfer(beg:end) = nan + pcf%gresp_storage_to_xfer(beg:end) = nan + pcf%livestemc_to_deadstemc(beg:end) = nan + pcf%livecrootc_to_deadcrootc(beg:end) = nan + pcf%gpp(beg:end) = nan + pcf%mr(beg:end) = nan + pcf%current_gr(beg:end) = nan + pcf%transfer_gr(beg:end) = nan + pcf%storage_gr(beg:end) = nan + pcf%gr(beg:end) = nan + pcf%ar(beg:end) = nan + pcf%rr(beg:end) = nan + pcf%npp(beg:end) = nan + pcf%agnpp(beg:end) = nan + pcf%bgnpp(beg:end) = nan + pcf%litfall(beg:end) = nan + pcf%vegfire(beg:end) = nan + pcf%wood_harvestc(beg:end) = nan + pcf%pft_cinputs(beg:end) = nan + pcf%pft_coutputs(beg:end) = nan + pcf%pft_fire_closs(beg:end) = nan + if ( crop_prog )then + pcf%xsmrpool_to_atm(beg:end) = nan + pcf%grainc_xfer_to_grainc(beg:end) = nan + pcf%livestemc_to_litter(beg:end) = nan + pcf%grainc_to_food(beg:end) = nan + pcf%cpool_to_grainc(beg:end) = nan + pcf%cpool_to_grainc_storage(beg:end) = nan + pcf%cpool_grain_gr(beg:end) = nan + pcf%cpool_grain_storage_gr(beg:end) = nan + pcf%transfer_grain_gr(beg:end) = nan + pcf%grainc_storage_to_xfer(beg:end) = nan + end if + if (use_cn) then + pcf%frootc_alloc(beg:end) = nan + pcf%frootc_loss(beg:end) = nan + pcf%leafc_alloc(beg:end) = nan + pcf%leafc_loss(beg:end) = nan + pcf%woodc_alloc(beg:end) = nan + pcf%woodc_loss(beg:end) = nan + end if + + end subroutine init_pft_cflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_nflux_type +! +! !INTERFACE: + subroutine init_pft_nflux_type(beg, end, pnf) +! +! !DESCRIPTION: +! Initialize pft nitrogen flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_nflux_type), intent(inout) :: pnf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pnf%m_leafn_to_litter(beg:end)) + allocate(pnf%m_frootn_to_litter(beg:end)) + allocate(pnf%m_leafn_storage_to_litter(beg:end)) + allocate(pnf%m_frootn_storage_to_litter(beg:end)) + allocate(pnf%m_livestemn_storage_to_litter(beg:end)) + allocate(pnf%m_deadstemn_storage_to_litter(beg:end)) + allocate(pnf%m_livecrootn_storage_to_litter(beg:end)) + allocate(pnf%m_deadcrootn_storage_to_litter(beg:end)) + allocate(pnf%m_leafn_xfer_to_litter(beg:end)) + allocate(pnf%m_frootn_xfer_to_litter(beg:end)) + allocate(pnf%m_livestemn_xfer_to_litter(beg:end)) + allocate(pnf%m_deadstemn_xfer_to_litter(beg:end)) + allocate(pnf%m_livecrootn_xfer_to_litter(beg:end)) + allocate(pnf%m_deadcrootn_xfer_to_litter(beg:end)) + allocate(pnf%m_livestemn_to_litter(beg:end)) + allocate(pnf%m_deadstemn_to_litter(beg:end)) + allocate(pnf%m_livecrootn_to_litter(beg:end)) + allocate(pnf%m_deadcrootn_to_litter(beg:end)) + allocate(pnf%m_retransn_to_litter(beg:end)) + allocate(pnf%hrv_leafn_to_litter(beg:end)) + allocate(pnf%hrv_frootn_to_litter(beg:end)) + allocate(pnf%hrv_leafn_storage_to_litter(beg:end)) + allocate(pnf%hrv_frootn_storage_to_litter(beg:end)) + allocate(pnf%hrv_livestemn_storage_to_litter(beg:end)) + allocate(pnf%hrv_deadstemn_storage_to_litter(beg:end)) + allocate(pnf%hrv_livecrootn_storage_to_litter(beg:end)) + allocate(pnf%hrv_deadcrootn_storage_to_litter(beg:end)) + allocate(pnf%hrv_leafn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_frootn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_livestemn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_deadstemn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_livecrootn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_deadcrootn_xfer_to_litter(beg:end)) + allocate(pnf%hrv_livestemn_to_litter(beg:end)) + allocate(pnf%hrv_deadstemn_to_prod10n(beg:end)) + allocate(pnf%hrv_deadstemn_to_prod100n(beg:end)) + allocate(pnf%hrv_livecrootn_to_litter(beg:end)) + allocate(pnf%hrv_deadcrootn_to_litter(beg:end)) + allocate(pnf%hrv_retransn_to_litter(beg:end)) + allocate(pnf%m_leafn_to_fire(beg:end)) + allocate(pnf%m_frootn_to_fire(beg:end)) + allocate(pnf%m_leafn_storage_to_fire(beg:end)) + allocate(pnf%m_frootn_storage_to_fire(beg:end)) + allocate(pnf%m_livestemn_storage_to_fire(beg:end)) + allocate(pnf%m_deadstemn_storage_to_fire(beg:end)) + allocate(pnf%m_livecrootn_storage_to_fire(beg:end)) + allocate(pnf%m_deadcrootn_storage_to_fire(beg:end)) + allocate(pnf%m_leafn_xfer_to_fire(beg:end)) + allocate(pnf%m_frootn_xfer_to_fire(beg:end)) + allocate(pnf%m_livestemn_xfer_to_fire(beg:end)) + allocate(pnf%m_deadstemn_xfer_to_fire(beg:end)) + allocate(pnf%m_livecrootn_xfer_to_fire(beg:end)) + allocate(pnf%m_deadcrootn_xfer_to_fire(beg:end)) + allocate(pnf%m_livestemn_to_fire(beg:end)) + allocate(pnf%m_deadstemn_to_fire(beg:end)) + allocate(pnf%m_deadstemn_to_litter_fire(beg:end)) + allocate(pnf%m_livecrootn_to_fire(beg:end)) + allocate(pnf%m_deadcrootn_to_fire(beg:end)) + allocate(pnf%m_deadcrootn_to_litter_fire(beg:end)) + allocate(pnf%m_retransn_to_fire(beg:end)) + allocate(pnf%leafn_xfer_to_leafn(beg:end)) + allocate(pnf%frootn_xfer_to_frootn(beg:end)) + allocate(pnf%livestemn_xfer_to_livestemn(beg:end)) + allocate(pnf%deadstemn_xfer_to_deadstemn(beg:end)) + allocate(pnf%livecrootn_xfer_to_livecrootn(beg:end)) + allocate(pnf%deadcrootn_xfer_to_deadcrootn(beg:end)) + allocate(pnf%leafn_to_litter(beg:end)) + allocate(pnf%leafn_to_retransn(beg:end)) + allocate(pnf%frootn_to_litter(beg:end)) + allocate(pnf%retransn_to_npool(beg:end)) + allocate(pnf%sminn_to_npool(beg:end)) + allocate(pnf%npool_to_leafn(beg:end)) + allocate(pnf%npool_to_leafn_storage(beg:end)) + allocate(pnf%npool_to_frootn(beg:end)) + allocate(pnf%npool_to_frootn_storage(beg:end)) + allocate(pnf%npool_to_livestemn(beg:end)) + allocate(pnf%npool_to_livestemn_storage(beg:end)) + allocate(pnf%npool_to_deadstemn(beg:end)) + allocate(pnf%npool_to_deadstemn_storage(beg:end)) + allocate(pnf%npool_to_livecrootn(beg:end)) + allocate(pnf%npool_to_livecrootn_storage(beg:end)) + allocate(pnf%npool_to_deadcrootn(beg:end)) + allocate(pnf%npool_to_deadcrootn_storage(beg:end)) + allocate(pnf%leafn_storage_to_xfer(beg:end)) + allocate(pnf%frootn_storage_to_xfer(beg:end)) + allocate(pnf%livestemn_storage_to_xfer(beg:end)) + allocate(pnf%deadstemn_storage_to_xfer(beg:end)) + allocate(pnf%livecrootn_storage_to_xfer(beg:end)) + allocate(pnf%deadcrootn_storage_to_xfer(beg:end)) + allocate(pnf%livestemn_to_deadstemn(beg:end)) + allocate(pnf%livestemn_to_retransn(beg:end)) + allocate(pnf%livecrootn_to_deadcrootn(beg:end)) + allocate(pnf%livecrootn_to_retransn(beg:end)) + allocate(pnf%ndeploy(beg:end)) + allocate(pnf%pft_ninputs(beg:end)) + allocate(pnf%pft_noutputs(beg:end)) + allocate(pnf%wood_harvestn(beg:end)) + allocate(pnf%pft_fire_nloss(beg:end)) + if ( crop_prog )then + allocate(pnf%grainn_xfer_to_grainn(beg:end)) + allocate(pnf%livestemn_to_litter(beg:end)) + allocate(pnf%grainn_to_food(beg:end)) + allocate(pnf%npool_to_grainn(beg:end)) + allocate(pnf%npool_to_grainn_storage(beg:end)) + allocate(pnf%grainn_storage_to_xfer(beg:end)) + end if + + pnf%m_leafn_to_litter(beg:end) = nan + pnf%m_frootn_to_litter(beg:end) = nan + pnf%m_leafn_storage_to_litter(beg:end) = nan + pnf%m_frootn_storage_to_litter(beg:end) = nan + pnf%m_livestemn_storage_to_litter(beg:end) = nan + pnf%m_deadstemn_storage_to_litter(beg:end) = nan + pnf%m_livecrootn_storage_to_litter(beg:end) = nan + pnf%m_deadcrootn_storage_to_litter(beg:end) = nan + pnf%m_leafn_xfer_to_litter(beg:end) = nan + pnf%m_frootn_xfer_to_litter(beg:end) = nan + pnf%m_livestemn_xfer_to_litter(beg:end) = nan + pnf%m_deadstemn_xfer_to_litter(beg:end) = nan + pnf%m_livecrootn_xfer_to_litter(beg:end) = nan + pnf%m_deadcrootn_xfer_to_litter(beg:end) = nan + pnf%m_livestemn_to_litter(beg:end) = nan + pnf%m_deadstemn_to_litter(beg:end) = nan + pnf%m_livecrootn_to_litter(beg:end) = nan + pnf%m_deadcrootn_to_litter(beg:end) = nan + pnf%m_retransn_to_litter(beg:end) = nan + pnf%hrv_leafn_to_litter(beg:end) = nan + pnf%hrv_frootn_to_litter(beg:end) = nan + pnf%hrv_leafn_storage_to_litter(beg:end) = nan + pnf%hrv_frootn_storage_to_litter(beg:end) = nan + pnf%hrv_livestemn_storage_to_litter(beg:end) = nan + pnf%hrv_deadstemn_storage_to_litter(beg:end) = nan + pnf%hrv_livecrootn_storage_to_litter(beg:end) = nan + pnf%hrv_deadcrootn_storage_to_litter(beg:end) = nan + pnf%hrv_leafn_xfer_to_litter(beg:end) = nan + pnf%hrv_frootn_xfer_to_litter(beg:end) = nan + pnf%hrv_livestemn_xfer_to_litter(beg:end) = nan + pnf%hrv_deadstemn_xfer_to_litter(beg:end) = nan + pnf%hrv_livecrootn_xfer_to_litter(beg:end) = nan + pnf%hrv_deadcrootn_xfer_to_litter(beg:end) = nan + pnf%hrv_livestemn_to_litter(beg:end) = nan + pnf%hrv_deadstemn_to_prod10n(beg:end) = nan + pnf%hrv_deadstemn_to_prod100n(beg:end) = nan + pnf%hrv_livecrootn_to_litter(beg:end) = nan + pnf%hrv_deadcrootn_to_litter(beg:end) = nan + pnf%hrv_retransn_to_litter(beg:end) = nan + pnf%m_leafn_to_fire(beg:end) = nan + pnf%m_frootn_to_fire(beg:end) = nan + pnf%m_leafn_storage_to_fire(beg:end) = nan + pnf%m_frootn_storage_to_fire(beg:end) = nan + pnf%m_livestemn_storage_to_fire(beg:end) = nan + pnf%m_deadstemn_storage_to_fire(beg:end) = nan + pnf%m_livecrootn_storage_to_fire(beg:end) = nan + pnf%m_deadcrootn_storage_to_fire(beg:end) = nan + pnf%m_leafn_xfer_to_fire(beg:end) = nan + pnf%m_frootn_xfer_to_fire(beg:end) = nan + pnf%m_livestemn_xfer_to_fire(beg:end) = nan + pnf%m_deadstemn_xfer_to_fire(beg:end) = nan + pnf%m_livecrootn_xfer_to_fire(beg:end) = nan + pnf%m_deadcrootn_xfer_to_fire(beg:end) = nan + pnf%m_livestemn_to_fire(beg:end) = nan + pnf%m_deadstemn_to_fire(beg:end) = nan + pnf%m_deadstemn_to_litter_fire(beg:end) = nan + pnf%m_livecrootn_to_fire(beg:end) = nan + pnf%m_deadcrootn_to_fire(beg:end) = nan + pnf%m_deadcrootn_to_litter_fire(beg:end) = nan + pnf%m_retransn_to_fire(beg:end) = nan + pnf%leafn_xfer_to_leafn(beg:end) = nan + pnf%frootn_xfer_to_frootn(beg:end) = nan + pnf%livestemn_xfer_to_livestemn(beg:end) = nan + pnf%deadstemn_xfer_to_deadstemn(beg:end) = nan + pnf%livecrootn_xfer_to_livecrootn(beg:end) = nan + pnf%deadcrootn_xfer_to_deadcrootn(beg:end) = nan + pnf%leafn_to_litter(beg:end) = nan + pnf%leafn_to_retransn(beg:end) = nan + pnf%frootn_to_litter(beg:end) = nan + pnf%retransn_to_npool(beg:end) = nan + pnf%sminn_to_npool(beg:end) = nan + pnf%npool_to_leafn(beg:end) = nan + pnf%npool_to_leafn_storage(beg:end) = nan + pnf%npool_to_frootn(beg:end) = nan + pnf%npool_to_frootn_storage(beg:end) = nan + pnf%npool_to_livestemn(beg:end) = nan + pnf%npool_to_livestemn_storage(beg:end) = nan + pnf%npool_to_deadstemn(beg:end) = nan + pnf%npool_to_deadstemn_storage(beg:end) = nan + pnf%npool_to_livecrootn(beg:end) = nan + pnf%npool_to_livecrootn_storage(beg:end) = nan + pnf%npool_to_deadcrootn(beg:end) = nan + pnf%npool_to_deadcrootn_storage(beg:end) = nan + pnf%leafn_storage_to_xfer(beg:end) = nan + pnf%frootn_storage_to_xfer(beg:end) = nan + pnf%livestemn_storage_to_xfer(beg:end) = nan + pnf%deadstemn_storage_to_xfer(beg:end) = nan + pnf%livecrootn_storage_to_xfer(beg:end) = nan + pnf%deadcrootn_storage_to_xfer(beg:end) = nan + pnf%livestemn_to_deadstemn(beg:end) = nan + pnf%livestemn_to_retransn(beg:end) = nan + pnf%livecrootn_to_deadcrootn(beg:end) = nan + pnf%livecrootn_to_retransn(beg:end) = nan + pnf%ndeploy(beg:end) = nan + pnf%pft_ninputs(beg:end) = nan + pnf%pft_noutputs(beg:end) = nan + pnf%wood_harvestn(beg:end) = nan + pnf%pft_fire_nloss(beg:end) = nan + if ( crop_prog )then + pnf%grainn_xfer_to_grainn(beg:end) = nan + pnf%livestemn_to_litter(beg:end) = nan + pnf%grainn_to_food(beg:end) = nan + pnf%npool_to_grainn(beg:end) = nan + pnf%npool_to_grainn_storage(beg:end) = nan + pnf%grainn_storage_to_xfer(beg:end) = nan + end if + + end subroutine init_pft_nflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_vflux_type +! +! !INTERFACE: + subroutine init_pft_vflux_type(beg, end, pvf) +! +! !DESCRIPTION: +! Initialize pft VOC flux variables +! + use clm_varcon, only : spval + use shr_megan_mod, only: shr_megan_megcomps_n, shr_megan_mechcomps_n +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_vflux_type), intent(inout) :: pvf + + integer :: i +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! (heald, 08/06) +! +!EOP +!------------------------------------------------------------------------ + + if (shr_megan_mechcomps_n<1) return + + allocate(pvf%vocflx_tot(beg:end)) + allocate(pvf%vocflx(beg:end,1:shr_megan_mechcomps_n)) + allocate(pvf%Eopt_out(beg:end)) + allocate(pvf%topt_out(beg:end)) + allocate(pvf%alpha_out(beg:end)) + allocate(pvf%cp_out(beg:end)) + allocate(pvf%para_out(beg:end)) + allocate(pvf%par24a_out(beg:end)) + allocate(pvf%par240a_out(beg:end)) + allocate(pvf%paru_out(beg:end)) + allocate(pvf%par24u_out(beg:end)) + allocate(pvf%par240u_out(beg:end)) + allocate(pvf%gamma_out(beg:end)) + allocate(pvf%gammaL_out(beg:end)) + allocate(pvf%gammaT_out(beg:end)) + allocate(pvf%gammaP_out(beg:end)) + allocate(pvf%gammaA_out(beg:end)) + allocate(pvf%gammaS_out(beg:end)) + allocate(pvf%gammaC_out(beg:end)) + + pvf%vocflx_tot(beg:end) = nan + pvf%vocflx(beg:end,1:shr_megan_mechcomps_n) = nan + pvf%Eopt_out(beg:end) = nan + pvf%topt_out(beg:end) = nan + pvf%alpha_out(beg:end) = nan + pvf%cp_out(beg:end) = nan + pvf%para_out(beg:end) = nan + pvf%par24a_out(beg:end) = nan + pvf%par240a_out(beg:end) = nan + pvf%paru_out(beg:end) = nan + pvf%par24u_out(beg:end) = nan + pvf%par240u_out(beg:end) = nan + pvf%gamma_out(beg:end) = nan + pvf%gammaL_out(beg:end) = nan + pvf%gammaT_out(beg:end) = nan + pvf%gammaP_out(beg:end) = nan + pvf%gammaA_out(beg:end) = nan + pvf%gammaS_out(beg:end) = nan + pvf%gammaC_out(beg:end) = nan + + allocate(pvf%meg(shr_megan_megcomps_n)) + + do i=1,shr_megan_megcomps_n + allocate(pvf%meg(i)%flux_out(beg:end)) + pvf%meg(i)%flux_out(beg:end) = nan + enddo + + end subroutine init_pft_vflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_dflux_type +! +! !INTERFACE: + subroutine init_pft_dflux_type(beg, end, pdf) +! +! !DESCRIPTION: +! Initialize pft dust flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_dflux_type), intent(inout):: pdf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(pdf%flx_mss_vrt_dst(beg:end,1:ndst)) + allocate(pdf%flx_mss_vrt_dst_tot(beg:end)) + allocate(pdf%vlc_trb(beg:end,1:ndst)) + allocate(pdf%vlc_trb_1(beg:end)) + allocate(pdf%vlc_trb_2(beg:end)) + allocate(pdf%vlc_trb_3(beg:end)) + allocate(pdf%vlc_trb_4(beg:end)) + + pdf%flx_mss_vrt_dst(beg:end,1:ndst) = nan + pdf%flx_mss_vrt_dst_tot(beg:end) = nan + pdf%vlc_trb(beg:end,1:ndst) = nan + pdf%vlc_trb_1(beg:end) = nan + pdf%vlc_trb_2(beg:end) = nan + pdf%vlc_trb_3(beg:end) = nan + pdf%vlc_trb_4(beg:end) = nan + + end subroutine init_pft_dflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_pft_depvd_type +! +! !INTERFACE: + subroutine init_pft_depvd_type(beg, end, pdd) + + use seq_drydep_mod, only: n_drydep, drydep_method, DD_XLND +! +! !DESCRIPTION: +! Initialize pft dep velocity variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (pft_depvd_type), intent(inout):: pdd + integer :: i +! +! !REVISION HISTORY: +! Created by James Sulzman 541-929-6183 +! +!EOP +!------------------------------------------------------------------------ + + if ( n_drydep > 0 .and. drydep_method == DD_XLND )then + allocate(pdd%drydepvel(beg:end,n_drydep)) + pdd%drydepvel = nan + end if + + end subroutine init_pft_depvd_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_pstate_type +! +! !INTERFACE: + subroutine init_column_pstate_type(beg, end, cps) +! +! !DESCRIPTION: +! Initialize column physical state variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_pstate_type), intent(inout):: cps +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(cps%snl(beg:end)) !* cannot be averaged up + allocate(cps%isoicol(beg:end)) !* cannot be averaged up + allocate(cps%bsw(beg:end,nlevgrnd)) + allocate(cps%watsat(beg:end,nlevgrnd)) + allocate(cps%watfc(beg:end,nlevgrnd)) + allocate(cps%watdry(beg:end,nlevgrnd)) + allocate(cps%watopt(beg:end,nlevgrnd)) + allocate(cps%hksat(beg:end,nlevgrnd)) + allocate(cps%sucsat(beg:end,nlevgrnd)) + allocate(cps%csol(beg:end,nlevgrnd)) + allocate(cps%tkmg(beg:end,nlevgrnd)) + allocate(cps%tkdry(beg:end,nlevgrnd)) + allocate(cps%tksatu(beg:end,nlevgrnd)) + allocate(cps%smpmin(beg:end)) + allocate(cps%hkdepth(beg:end)) + allocate(cps%wtfact(beg:end)) + allocate(cps%fracice(beg:end,nlevgrnd)) + allocate(cps%gwc_thr(beg:end)) + allocate(cps%mss_frc_cly_vld(beg:end)) + allocate(cps%mbl_bsn_fct(beg:end)) + allocate(cps%do_capsnow(beg:end)) + allocate(cps%snowdp(beg:end)) + allocate(cps%frac_sno (beg:end)) + allocate(cps%zi(beg:end,-nlevsno+0:nlevgrnd)) + allocate(cps%dz(beg:end,-nlevsno+1:nlevgrnd)) + allocate(cps%z (beg:end,-nlevsno+1:nlevgrnd)) + allocate(cps%frac_iceold(beg:end,-nlevsno+1:nlevgrnd)) + allocate(cps%imelt(beg:end,-nlevsno+1:nlevgrnd)) + allocate(cps%eff_porosity(beg:end,nlevgrnd)) + allocate(cps%emg(beg:end)) + allocate(cps%z0mg(beg:end)) + allocate(cps%z0hg(beg:end)) + allocate(cps%z0qg(beg:end)) + allocate(cps%htvp(beg:end)) + allocate(cps%beta(beg:end)) + allocate(cps%zii(beg:end)) + allocate(cps%albgrd(beg:end,numrad)) + allocate(cps%albgri(beg:end,numrad)) + allocate(cps%rootr_column(beg:end,nlevgrnd)) + allocate(cps%rootfr_road_perv(beg:end,nlevgrnd)) + allocate(cps%rootr_road_perv(beg:end,nlevgrnd)) + allocate(cps%wf(beg:end)) +! allocate(cps%xirrig(beg:end)) + allocate(cps%max_dayl(beg:end)) + allocate(cps%bsw2(beg:end,nlevgrnd)) + allocate(cps%psisat(beg:end,nlevgrnd)) + allocate(cps%vwcsat(beg:end,nlevgrnd)) + allocate(cps%soilpsi(beg:end,nlevgrnd)) + allocate(cps%decl(beg:end)) + allocate(cps%coszen(beg:end)) + allocate(cps%fpi(beg:end)) + allocate(cps%fpg(beg:end)) + allocate(cps%annsum_counter(beg:end)) + allocate(cps%cannsum_npp(beg:end)) + allocate(cps%cannavg_t2m(beg:end)) + allocate(cps%me(beg:end)) + allocate(cps%fire_prob(beg:end)) + allocate(cps%mean_fire_prob(beg:end)) + allocate(cps%fireseasonl(beg:end)) + allocate(cps%farea_burned(beg:end)) + allocate(cps%ann_farea_burned(beg:end)) + allocate(cps%albsnd_hst(beg:end,numrad)) + allocate(cps%albsni_hst(beg:end,numrad)) + allocate(cps%albsod(beg:end,numrad)) + allocate(cps%albsoi(beg:end,numrad)) + allocate(cps%flx_absdv(beg:end,-nlevsno+1:1)) + allocate(cps%flx_absdn(beg:end,-nlevsno+1:1)) + allocate(cps%flx_absiv(beg:end,-nlevsno+1:1)) + allocate(cps%flx_absin(beg:end,-nlevsno+1:1)) + allocate(cps%snw_rds(beg:end,-nlevsno+1:0)) + allocate(cps%snw_rds_top(beg:end)) + allocate(cps%sno_liq_top(beg:end)) + allocate(cps%mss_bcpho(beg:end,-nlevsno+1:0)) + allocate(cps%mss_bcphi(beg:end,-nlevsno+1:0)) + allocate(cps%mss_bctot(beg:end,-nlevsno+1:0)) + allocate(cps%mss_bc_col(beg:end)) + allocate(cps%mss_bc_top(beg:end)) + allocate(cps%mss_ocpho(beg:end,-nlevsno+1:0)) + allocate(cps%mss_ocphi(beg:end,-nlevsno+1:0)) + allocate(cps%mss_octot(beg:end,-nlevsno+1:0)) + allocate(cps%mss_oc_col(beg:end)) + allocate(cps%mss_oc_top(beg:end)) + allocate(cps%mss_dst1(beg:end,-nlevsno+1:0)) + allocate(cps%mss_dst2(beg:end,-nlevsno+1:0)) + allocate(cps%mss_dst3(beg:end,-nlevsno+1:0)) + allocate(cps%mss_dst4(beg:end,-nlevsno+1:0)) + allocate(cps%mss_dsttot(beg:end,-nlevsno+1:0)) + allocate(cps%mss_dst_col(beg:end)) + allocate(cps%mss_dst_top(beg:end)) + allocate(cps%h2osno_top(beg:end)) + allocate(cps%mss_cnc_bcphi(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_bcpho(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_ocphi(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_ocpho(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_dst1(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_dst2(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_dst3(beg:end,-nlevsno+1:0)) + allocate(cps%mss_cnc_dst4(beg:end,-nlevsno+1:0)) + allocate(cps%albgrd_pur(beg:end,numrad)) + allocate(cps%albgri_pur(beg:end,numrad)) + allocate(cps%albgrd_bc(beg:end,numrad)) + allocate(cps%albgri_bc(beg:end,numrad)) + allocate(cps%albgrd_oc(beg:end,numrad)) + allocate(cps%albgri_oc(beg:end,numrad)) + allocate(cps%albgrd_dst(beg:end,numrad)) + allocate(cps%albgri_dst(beg:end,numrad)) + allocate(cps%dTdz_top(beg:end)) + allocate(cps%snot_top(beg:end)) + allocate(cps%irrig_rate(beg:end)) + allocate(cps%n_irrig_steps_left(beg:end)) + allocate(cps%forc_pbot(beg:end)) + allocate(cps%forc_rho(beg:end)) + allocate(cps%glc_topo(beg:end)) + cps%isoicol(beg:end) = huge(1) + cps%bsw(beg:end,1:nlevgrnd) = nan + cps%watsat(beg:end,1:nlevgrnd) = nan + cps%watfc(beg:end,1:nlevgrnd) = nan + cps%watdry(beg:end,1:nlevgrnd) = nan + cps%watopt(beg:end,1:nlevgrnd) = nan + cps%hksat(beg:end,1:nlevgrnd) = nan + cps%sucsat(beg:end,1:nlevgrnd) = nan + cps%csol(beg:end,1:nlevgrnd) = nan + cps%tkmg(beg:end,1:nlevgrnd) = nan + cps%tkdry(beg:end,1:nlevgrnd) = nan + cps%tksatu(beg:end,1:nlevgrnd) = nan + cps%smpmin(beg:end) = nan + cps%hkdepth(beg:end) = nan + cps%wtfact(beg:end) = nan + cps%fracice(beg:end,1:nlevgrnd) = nan + cps%gwc_thr(beg:end) = nan + cps%mss_frc_cly_vld(beg:end) = nan + cps%mbl_bsn_fct(beg:end) = nan + cps%do_capsnow (beg:end)= .false. + cps%snowdp(beg:end) = nan + cps%frac_sno(beg:end) = nan + cps%zi(beg:end,-nlevsno+0:nlevgrnd) = nan + cps%dz(beg:end,-nlevsno+1:nlevgrnd) = nan + cps%z (beg:end,-nlevsno+1:nlevgrnd) = nan + cps%frac_iceold(beg:end,-nlevsno+1:nlevgrnd) = spval + cps%imelt(beg:end,-nlevsno+1:nlevgrnd) = huge(1) + cps%eff_porosity(beg:end,1:nlevgrnd) = spval + cps%emg(beg:end) = nan + cps%z0mg(beg:end) = nan + cps%z0hg(beg:end) = nan + cps%z0qg(beg:end) = nan + cps%htvp(beg:end) = nan + cps%beta(beg:end) = nan + cps%zii(beg:end) = nan + cps%albgrd(beg:end,:numrad) = nan + cps%albgri(beg:end,:numrad) = nan + cps%rootr_column(beg:end,1:nlevgrnd) = spval + cps%rootfr_road_perv(beg:end,1:nlevurb) = nan + cps%rootr_road_perv(beg:end,1:nlevurb) = nan + cps%wf(beg:end) = nan +! cps%xirrig(beg:end) = 0._r8 + cps%bsw2(beg:end,1:nlevgrnd) = nan + cps%psisat(beg:end,1:nlevgrnd) = nan + cps%vwcsat(beg:end,1:nlevgrnd) = nan + cps%soilpsi(beg:end,1:nlevgrnd) = spval + cps%decl(beg:end) = nan + cps%coszen(beg:end) = nan + cps%fpi(beg:end) = nan + cps%fpg(beg:end) = nan + cps%annsum_counter(beg:end) = nan + cps%cannsum_npp(beg:end) = nan + cps%cannavg_t2m(beg:end) = nan + cps%me(beg:end) = nan + cps%fire_prob(beg:end) = nan + cps%mean_fire_prob(beg:end) = nan + cps%fireseasonl(beg:end) = nan + cps%farea_burned(beg:end) = nan + cps%ann_farea_burned(beg:end) = nan + cps%albsnd_hst(beg:end,:numrad) = spval + cps%albsni_hst(beg:end,:numrad) = spval + cps%albsod(beg:end,:numrad) = nan + cps%albsoi(beg:end,:numrad) = nan + cps%flx_absdv(beg:end,-nlevsno+1:1) = spval + cps%flx_absdn(beg:end,-nlevsno+1:1) = spval + cps%flx_absiv(beg:end,-nlevsno+1:1) = spval + cps%flx_absin(beg:end,-nlevsno+1:1) = spval + cps%snw_rds(beg:end,-nlevsno+1:0) = nan + cps%snw_rds_top(beg:end) = nan + cps%sno_liq_top(beg:end) = nan + cps%mss_bcpho(beg:end,-nlevsno+1:0) = nan + cps%mss_bcphi(beg:end,-nlevsno+1:0) = nan + cps%mss_bctot(beg:end,-nlevsno+1:0) = nan + cps%mss_bc_col(beg:end) = nan + cps%mss_bc_top(beg:end) = nan + cps%mss_ocpho(beg:end,-nlevsno+1:0) = nan + cps%mss_ocphi(beg:end,-nlevsno+1:0) = nan + cps%mss_octot(beg:end,-nlevsno+1:0) = nan + cps%mss_oc_col(beg:end) = nan + cps%mss_oc_top(beg:end) = nan + cps%mss_dst1(beg:end,-nlevsno+1:0) = nan + cps%mss_dst2(beg:end,-nlevsno+1:0) = nan + cps%mss_dst3(beg:end,-nlevsno+1:0) = nan + cps%mss_dst4(beg:end,-nlevsno+1:0) = nan + cps%mss_dsttot(beg:end,-nlevsno+1:0) = nan + cps%mss_dst_col(beg:end) = nan + cps%mss_dst_top(beg:end) = nan + cps%h2osno_top(beg:end) = nan + cps%mss_cnc_bcphi(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_bcpho(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_ocphi(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_ocpho(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_dst1(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_dst2(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_dst3(beg:end,-nlevsno+1:0) = nan + cps%mss_cnc_dst4(beg:end,-nlevsno+1:0) = nan + cps%albgrd_pur(beg:end,:numrad) = nan + cps%albgri_pur(beg:end,:numrad) = nan + cps%albgrd_bc(beg:end,:numrad) = nan + cps%albgri_bc(beg:end,:numrad) = nan + cps%albgrd_oc(beg:end,:numrad) = nan + cps%albgri_oc(beg:end,:numrad) = nan + cps%albgrd_dst(beg:end,:numrad) = nan + cps%albgri_dst(beg:end,:numrad) = nan + cps%dTdz_top(beg:end) = nan + cps%snot_top(beg:end) = nan + cps%irrig_rate(beg:end) = nan + cps%n_irrig_steps_left(beg:end) = 0 + cps%forc_pbot(beg:end) = nan + cps%forc_rho(beg:end) = nan + cps%glc_topo(beg:end) = nan + + end subroutine init_column_pstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_estate_type +! +! !INTERFACE: + subroutine init_column_estate_type(beg, end, ces) +! +! !DESCRIPTION: +! Initialize column energy state variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_estate_type), intent(inout):: ces +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + allocate(ces%t_grnd(beg:end)) + allocate(ces%t_grnd_u(beg:end)) + allocate(ces%t_grnd_r(beg:end)) + allocate(ces%dt_grnd(beg:end)) + allocate(ces%t_soisno(beg:end,-nlevsno+1:nlevgrnd)) + allocate(ces%t_soi_10cm(beg:end)) + allocate(ces%t_lake(beg:end,1:nlevlak)) + allocate(ces%tssbef(beg:end,-nlevsno+1:nlevgrnd)) + allocate(ces%thv(beg:end)) + allocate(ces%hc_soi(beg:end)) + allocate(ces%hc_soisno(beg:end)) + allocate(ces%forc_t(beg:end)) + allocate(ces%forc_th(beg:end)) + + ces%t_grnd(beg:end) = nan + ces%t_grnd_u(beg:end) = nan + ces%t_grnd_r(beg:end) = nan + ces%dt_grnd(beg:end) = nan + ces%t_soisno(beg:end,-nlevsno+1:nlevgrnd) = spval + ces%t_soi_10cm(beg:end) = spval + ces%t_lake(beg:end,1:nlevlak) = nan + ces%tssbef(beg:end,-nlevsno+1:nlevgrnd) = nan + ces%thv(beg:end) = nan + ces%hc_soi(beg:end) = nan + ces%hc_soisno(beg:end) = nan + ces%forc_t(beg:end) = nan + ces%forc_th(beg:end) = nan + + end subroutine init_column_estate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_wstate_type +! +! !INTERFACE: + subroutine init_column_wstate_type(beg, end, cws) +! +! !DESCRIPTION: +! Initialize column water state variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_wstate_type), intent(inout):: cws !column water state +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(cws%h2osno(beg:end)) + allocate(cws%errh2osno(beg:end)) + allocate(cws%snow_sources(beg:end)) + allocate(cws%snow_sinks(beg:end)) + allocate(cws%h2osoi_liq(beg:end,-nlevsno+1:nlevgrnd)) + allocate(cws%h2osoi_ice(beg:end,-nlevsno+1:nlevgrnd)) + allocate(cws%h2osoi_liqice_10cm(beg:end)) + allocate(cws%h2osoi_vol(beg:end,1:nlevgrnd)) + allocate(cws%h2osno_old(beg:end)) + allocate(cws%qg(beg:end)) + allocate(cws%dqgdT(beg:end)) + allocate(cws%snowice(beg:end)) + allocate(cws%snowliq(beg:end)) + allocate(cws%soilalpha(beg:end)) + allocate(cws%soilbeta(beg:end)) + allocate(cws%soilalpha_u(beg:end)) + allocate(cws%zwt(beg:end)) + allocate(cws%fcov(beg:end)) + allocate(cws%fsat(beg:end)) + allocate(cws%wa(beg:end)) + allocate(cws%wt(beg:end)) + allocate(cws%qcharge(beg:end)) + allocate(cws%smp_l(beg:end,1:nlevgrnd)) + allocate(cws%hk_l(beg:end,1:nlevgrnd)) + allocate(cws%forc_q(beg:end)) + + cws%h2osno(beg:end) = nan + cws%errh2osno(beg:end) = nan + cws%snow_sources(beg:end) = nan + cws%snow_sinks(beg:end) = nan + cws%h2osoi_liq(beg:end,-nlevsno+1:nlevgrnd)= spval + cws%h2osoi_ice(beg:end,-nlevsno+1:nlevgrnd) = spval + cws%h2osoi_liqice_10cm(beg:end) = spval + cws%h2osoi_vol(beg:end,1:nlevgrnd) = spval + cws%h2osno_old(beg:end) = nan + cws%qg(beg:end) = nan + cws%dqgdT(beg:end) = nan + cws%snowice(beg:end) = nan + cws%snowliq(beg:end) = nan + cws%soilalpha(beg:end) = nan + cws%soilbeta(beg:end) = nan + cws%soilalpha_u(beg:end) = nan + cws%zwt(beg:end) = nan + cws%fcov(beg:end) = nan + cws%fsat(beg:end) = nan + cws%wa(beg:end) = nan + cws%wt(beg:end) = nan + cws%qcharge(beg:end) = nan + cws%smp_l(beg:end,1:nlevgrnd) = spval + cws%hk_l(beg:end,1:nlevgrnd) = spval + cws%forc_q(beg:end) = nan + + end subroutine init_column_wstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_cstate_type +! +! !INTERFACE: + subroutine init_column_cstate_type(beg, end, ccs) +! +! !DESCRIPTION: +! Initialize column carbon state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_cstate_type), intent(inout):: ccs +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(ccs%soilc(beg:end)) + allocate(ccs%cwdc(beg:end)) + allocate(ccs%litr1c(beg:end)) + allocate(ccs%litr2c(beg:end)) + allocate(ccs%litr3c(beg:end)) + allocate(ccs%soil1c(beg:end)) + allocate(ccs%soil2c(beg:end)) + allocate(ccs%soil3c(beg:end)) + allocate(ccs%soil4c(beg:end)) + allocate(ccs%seedc(beg:end)) + allocate(ccs%col_ctrunc(beg:end)) + allocate(ccs%prod10c(beg:end)) + allocate(ccs%prod100c(beg:end)) + allocate(ccs%totprodc(beg:end)) + allocate(ccs%totlitc(beg:end)) + allocate(ccs%totsomc(beg:end)) + allocate(ccs%totecosysc(beg:end)) + allocate(ccs%totcolc(beg:end)) + + ccs%soilc(beg:end) = nan + ccs%cwdc(beg:end) = nan + ccs%litr1c(beg:end) = nan + ccs%litr2c(beg:end) = nan + ccs%litr3c(beg:end) = nan + ccs%soil1c(beg:end) = nan + ccs%soil2c(beg:end) = nan + ccs%soil3c(beg:end) = nan + ccs%soil4c(beg:end) = nan + ccs%seedc(beg:end) = nan + ccs%col_ctrunc(beg:end) = nan + ccs%prod10c(beg:end) = nan + ccs%prod100c(beg:end) = nan + ccs%totprodc(beg:end) = nan + ccs%totlitc(beg:end) = nan + ccs%totsomc(beg:end) = nan + ccs%totecosysc(beg:end) = nan + ccs%totcolc(beg:end) = nan + + end subroutine init_column_cstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_nstate_type +! +! !INTERFACE: + subroutine init_column_nstate_type(beg, end, cns) +! +! !DESCRIPTION: +! Initialize column nitrogen state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_nstate_type), intent(inout):: cns +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + allocate(cns%cwdn(beg:end)) + allocate(cns%litr1n(beg:end)) + allocate(cns%litr2n(beg:end)) + allocate(cns%litr3n(beg:end)) + allocate(cns%soil1n(beg:end)) + allocate(cns%soil2n(beg:end)) + allocate(cns%soil3n(beg:end)) + allocate(cns%soil4n(beg:end)) + allocate(cns%sminn(beg:end)) + allocate(cns%col_ntrunc(beg:end)) + allocate(cns%seedn(beg:end)) + allocate(cns%prod10n(beg:end)) + allocate(cns%prod100n(beg:end)) + allocate(cns%totprodn(beg:end)) + allocate(cns%totlitn(beg:end)) + allocate(cns%totsomn(beg:end)) + allocate(cns%totecosysn(beg:end)) + allocate(cns%totcoln(beg:end)) + + cns%cwdn(beg:end) = nan + cns%litr1n(beg:end) = nan + cns%litr2n(beg:end) = nan + cns%litr3n(beg:end) = nan + cns%soil1n(beg:end) = nan + cns%soil2n(beg:end) = nan + cns%soil3n(beg:end) = nan + cns%soil4n(beg:end) = nan + cns%sminn(beg:end) = nan + cns%col_ntrunc(beg:end) = nan + cns%seedn(beg:end) = nan + cns%prod10n(beg:end) = nan + cns%prod100n(beg:end) = nan + cns%totprodn(beg:end) = nan + cns%totlitn(beg:end) = nan + cns%totsomn(beg:end) = nan + cns%totecosysn(beg:end) = nan + cns%totcoln(beg:end) = nan + + end subroutine init_column_nstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_eflux_type +! +! !INTERFACE: + subroutine init_column_eflux_type(beg, end, cef) +! +! !DESCRIPTION: +! Initialize column energy flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_eflux_type), intent(inout):: cef +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(cef%eflx_snomelt(beg:end)) + allocate(cef%eflx_snomelt_u(beg:end)) + allocate(cef%eflx_snomelt_r(beg:end)) + allocate(cef%eflx_impsoil(beg:end)) + allocate(cef%eflx_fgr12(beg:end)) + allocate(cef%eflx_building_heat(beg:end)) + allocate(cef%eflx_urban_ac(beg:end)) + allocate(cef%eflx_urban_heat(beg:end)) + allocate(cef%eflx_bot(beg:end)) + + cef%eflx_snomelt(beg:end) = nan + cef%eflx_snomelt_u(beg:end) = nan + cef%eflx_snomelt_r(beg:end) = nan + cef%eflx_impsoil(beg:end) = nan + cef%eflx_fgr12(beg:end) = nan + cef%eflx_building_heat(beg:end) = nan + cef%eflx_urban_ac(beg:end) = nan + cef%eflx_urban_heat(beg:end) = nan + cef%eflx_bot(beg:end) = nan + + end subroutine init_column_eflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_wflux_type +! +! !INTERFACE: + subroutine init_column_wflux_type(beg, end, cwf) +! +! !DESCRIPTION: +! Initialize column water flux variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_wflux_type), intent(inout):: cwf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(cwf%qflx_infl(beg:end)) + allocate(cwf%qflx_surf(beg:end)) + allocate(cwf%qflx_drain(beg:end)) + allocate(cwf%qflx_top_soil(beg:end)) + allocate(cwf%qflx_sl_top_soil(beg:end)) + allocate(cwf%qflx_snomelt(beg:end)) + allocate(cwf%qflx_qrgwl(beg:end)) + allocate(cwf%qflx_runoff(beg:end)) + allocate(cwf%qflx_runoff_u(beg:end)) + allocate(cwf%qflx_runoff_r(beg:end)) + allocate(cwf%qmelt(beg:end)) + allocate(cwf%h2ocan_loss(beg:end)) + allocate(cwf%qflx_rsub_sat(beg:end)) + allocate(cwf%flx_bc_dep_dry(beg:end)) + allocate(cwf%flx_bc_dep_wet(beg:end)) + allocate(cwf%flx_bc_dep_pho(beg:end)) + allocate(cwf%flx_bc_dep_phi(beg:end)) + allocate(cwf%flx_bc_dep(beg:end)) + allocate(cwf%flx_oc_dep_dry(beg:end)) + allocate(cwf%flx_oc_dep_wet(beg:end)) + allocate(cwf%flx_oc_dep_pho(beg:end)) + allocate(cwf%flx_oc_dep_phi(beg:end)) + allocate(cwf%flx_oc_dep(beg:end)) + allocate(cwf%flx_dst_dep_dry1(beg:end)) + allocate(cwf%flx_dst_dep_wet1(beg:end)) + allocate(cwf%flx_dst_dep_dry2(beg:end)) + allocate(cwf%flx_dst_dep_wet2(beg:end)) + allocate(cwf%flx_dst_dep_dry3(beg:end)) + allocate(cwf%flx_dst_dep_wet3(beg:end)) + allocate(cwf%flx_dst_dep_dry4(beg:end)) + allocate(cwf%flx_dst_dep_wet4(beg:end)) + allocate(cwf%flx_dst_dep(beg:end)) + allocate(cwf%qflx_snofrz_lyr(beg:end,-nlevsno+1:0)) + allocate(cwf%qflx_snofrz_col(beg:end)) + allocate(cwf%qflx_irrig(beg:end)) + allocate(cwf%qflx_glcice(beg:end)) + allocate(cwf%qflx_glcice_frz(beg:end)) + allocate(cwf%qflx_glcice_melt(beg:end)) + allocate(cwf%glc_rofi(beg:end)) + allocate(cwf%glc_rofl(beg:end)) + allocate(cwf%qflx_floodc(beg:end)) + allocate(cwf%qflx_snow_melt(beg:end)) + + cwf%qflx_infl(beg:end) = nan + cwf%qflx_surf(beg:end) = nan + cwf%qflx_drain(beg:end) = nan + cwf%qflx_top_soil(beg:end) = spval + cwf%qflx_sl_top_soil(beg:end) = nan + cwf%qflx_snomelt(beg:end) = nan + cwf%qflx_qrgwl(beg:end) = nan + cwf%qflx_runoff(beg:end) = nan + cwf%qflx_runoff_u(beg:end) = nan + cwf%qflx_runoff_r(beg:end) = nan + cwf%qmelt(beg:end) = nan + cwf%h2ocan_loss(beg:end) = nan + cwf%qflx_rsub_sat(beg:end) = nan + cwf%flx_bc_dep_dry(beg:end) = nan + cwf%flx_bc_dep_wet(beg:end) = nan + cwf%flx_bc_dep_pho(beg:end) = nan + cwf%flx_bc_dep_phi(beg:end) = nan + cwf%flx_bc_dep(beg:end) = nan + cwf%flx_oc_dep_dry(beg:end) = nan + cwf%flx_oc_dep_wet(beg:end) = nan + cwf%flx_oc_dep_pho(beg:end) = nan + cwf%flx_oc_dep_phi(beg:end) = nan + cwf%flx_oc_dep(beg:end) = nan + cwf%flx_dst_dep_dry1(beg:end) = nan + cwf%flx_dst_dep_wet1(beg:end) = nan + cwf%flx_dst_dep_dry2(beg:end) = nan + cwf%flx_dst_dep_wet2(beg:end) = nan + cwf%flx_dst_dep_dry3(beg:end) = nan + cwf%flx_dst_dep_wet3(beg:end) = nan + cwf%flx_dst_dep_dry4(beg:end) = nan + cwf%flx_dst_dep_wet4(beg:end) = nan + cwf%flx_dst_dep(beg:end) = nan + cwf%qflx_snofrz_lyr(beg:end,-nlevsno+1:0) = spval + cwf%qflx_snofrz_col(beg:end) = nan + cwf%qflx_irrig(beg:end) = nan + cwf%qflx_glcice(beg:end) = nan + cwf%qflx_glcice_frz(beg:end) = nan + cwf%qflx_glcice_melt(beg:end) = nan + cwf%glc_rofi(beg:end) = nan + cwf%glc_rofl(beg:end) = nan + cwf%qflx_floodc(beg:end) = spval + cwf%qflx_snow_melt(beg:end) = spval + + end subroutine init_column_wflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_cflux_type +! +! !INTERFACE: + subroutine init_column_cflux_type(beg, end, ccf) +! +! !DESCRIPTION: +! Initialize column carbon flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_cflux_type), intent(inout):: ccf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + allocate(ccf%m_leafc_to_litr1c(beg:end)) + allocate(ccf%m_leafc_to_litr2c(beg:end)) + allocate(ccf%m_leafc_to_litr3c(beg:end)) + allocate(ccf%m_frootc_to_litr1c(beg:end)) + allocate(ccf%m_frootc_to_litr2c(beg:end)) + allocate(ccf%m_frootc_to_litr3c(beg:end)) + allocate(ccf%m_leafc_storage_to_litr1c(beg:end)) + allocate(ccf%m_frootc_storage_to_litr1c(beg:end)) + allocate(ccf%m_livestemc_storage_to_litr1c(beg:end)) + allocate(ccf%m_deadstemc_storage_to_litr1c(beg:end)) + allocate(ccf%m_livecrootc_storage_to_litr1c(beg:end)) + allocate(ccf%m_deadcrootc_storage_to_litr1c(beg:end)) + allocate(ccf%m_leafc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_frootc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_livestemc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_deadstemc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_livecrootc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_deadcrootc_xfer_to_litr1c(beg:end)) + allocate(ccf%m_livestemc_to_cwdc(beg:end)) + allocate(ccf%m_deadstemc_to_cwdc(beg:end)) + allocate(ccf%m_livecrootc_to_cwdc(beg:end)) + allocate(ccf%m_deadcrootc_to_cwdc(beg:end)) + allocate(ccf%m_gresp_storage_to_litr1c(beg:end)) + allocate(ccf%m_gresp_xfer_to_litr1c(beg:end)) + allocate(ccf%m_deadstemc_to_cwdc_fire(beg:end)) + allocate(ccf%m_deadcrootc_to_cwdc_fire(beg:end)) + allocate(ccf%hrv_leafc_to_litr1c(beg:end)) + allocate(ccf%hrv_leafc_to_litr2c(beg:end)) + allocate(ccf%hrv_leafc_to_litr3c(beg:end)) + allocate(ccf%hrv_frootc_to_litr1c(beg:end)) + allocate(ccf%hrv_frootc_to_litr2c(beg:end)) + allocate(ccf%hrv_frootc_to_litr3c(beg:end)) + allocate(ccf%hrv_livestemc_to_cwdc(beg:end)) + allocate(ccf%hrv_deadstemc_to_prod10c(beg:end)) + allocate(ccf%hrv_deadstemc_to_prod100c(beg:end)) + allocate(ccf%hrv_livecrootc_to_cwdc(beg:end)) + allocate(ccf%hrv_deadcrootc_to_cwdc(beg:end)) + allocate(ccf%hrv_leafc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_frootc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_livestemc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_deadstemc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_livecrootc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_deadcrootc_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_gresp_storage_to_litr1c(beg:end)) + allocate(ccf%hrv_leafc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_frootc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_livestemc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_deadstemc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_livecrootc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_deadcrootc_xfer_to_litr1c(beg:end)) + allocate(ccf%hrv_gresp_xfer_to_litr1c(beg:end)) + allocate(ccf%m_litr1c_to_fire(beg:end)) + allocate(ccf%m_litr2c_to_fire(beg:end)) + allocate(ccf%m_litr3c_to_fire(beg:end)) + allocate(ccf%m_cwdc_to_fire(beg:end)) + if ( crop_prog )then + allocate(ccf%grainc_to_litr1c(beg:end)) + allocate(ccf%grainc_to_litr2c(beg:end)) + allocate(ccf%grainc_to_litr3c(beg:end)) + allocate(ccf%livestemc_to_litr1c(beg:end)) + allocate(ccf%livestemc_to_litr2c(beg:end)) + allocate(ccf%livestemc_to_litr3c(beg:end)) + end if + allocate(ccf%leafc_to_litr1c(beg:end)) + allocate(ccf%leafc_to_litr2c(beg:end)) + allocate(ccf%leafc_to_litr3c(beg:end)) + allocate(ccf%frootc_to_litr1c(beg:end)) + allocate(ccf%frootc_to_litr2c(beg:end)) + allocate(ccf%frootc_to_litr3c(beg:end)) + allocate(ccf%cwdc_to_litr2c(beg:end)) + allocate(ccf%cwdc_to_litr3c(beg:end)) + allocate(ccf%litr1_hr(beg:end)) + allocate(ccf%litr1c_to_soil1c(beg:end)) + allocate(ccf%litr2_hr(beg:end)) + allocate(ccf%litr2c_to_soil2c(beg:end)) + allocate(ccf%litr3_hr(beg:end)) + allocate(ccf%litr3c_to_soil3c(beg:end)) + allocate(ccf%soil1_hr(beg:end)) + allocate(ccf%soil1c_to_soil2c(beg:end)) + allocate(ccf%soil2_hr(beg:end)) + allocate(ccf%soil2c_to_soil3c(beg:end)) + allocate(ccf%soil3_hr(beg:end)) + allocate(ccf%soil3c_to_soil4c(beg:end)) + allocate(ccf%soil4_hr(beg:end)) + if (use_cn) then + allocate(ccf%dwt_seedc_to_leaf(beg:end)) + allocate(ccf%dwt_seedc_to_deadstem(beg:end)) + allocate(ccf%dwt_conv_cflux(beg:end)) + allocate(ccf%dwt_prod10c_gain(beg:end)) + allocate(ccf%dwt_prod100c_gain(beg:end)) + allocate(ccf%dwt_frootc_to_litr1c(beg:end)) + allocate(ccf%dwt_frootc_to_litr2c(beg:end)) + allocate(ccf%dwt_frootc_to_litr3c(beg:end)) + allocate(ccf%dwt_livecrootc_to_cwdc(beg:end)) + allocate(ccf%dwt_deadcrootc_to_cwdc(beg:end)) + allocate(ccf%dwt_closs(beg:end)) + allocate(ccf%landuseflux(beg:end)) + allocate(ccf%landuptake(beg:end)) + allocate(ccf%prod10c_loss(beg:end)) + allocate(ccf%prod100c_loss(beg:end)) + allocate(ccf%product_closs(beg:end)) + end if + allocate(ccf%lithr(beg:end)) + allocate(ccf%somhr(beg:end)) + allocate(ccf%hr(beg:end)) + allocate(ccf%sr(beg:end)) + allocate(ccf%er(beg:end)) + allocate(ccf%litfire(beg:end)) + allocate(ccf%somfire(beg:end)) + allocate(ccf%totfire(beg:end)) + allocate(ccf%nep(beg:end)) + allocate(ccf%nbp(beg:end)) + allocate(ccf%nee(beg:end)) + allocate(ccf%col_cinputs(beg:end)) + allocate(ccf%col_coutputs(beg:end)) + allocate(ccf%col_fire_closs(beg:end)) + + if (use_cn) then + allocate(ccf%cwdc_hr(beg:end)) + allocate(ccf%cwdc_loss(beg:end)) + allocate(ccf%litterc_loss(beg:end)) + end if + + ccf%m_leafc_to_litr1c(beg:end) = nan + ccf%m_leafc_to_litr2c(beg:end) = nan + ccf%m_leafc_to_litr3c(beg:end) = nan + ccf%m_frootc_to_litr1c(beg:end) = nan + ccf%m_frootc_to_litr2c(beg:end) = nan + ccf%m_frootc_to_litr3c(beg:end) = nan + ccf%m_leafc_storage_to_litr1c(beg:end) = nan + ccf%m_frootc_storage_to_litr1c(beg:end) = nan + ccf%m_livestemc_storage_to_litr1c(beg:end) = nan + ccf%m_deadstemc_storage_to_litr1c(beg:end) = nan + ccf%m_livecrootc_storage_to_litr1c(beg:end) = nan + ccf%m_deadcrootc_storage_to_litr1c(beg:end) = nan + ccf%m_leafc_xfer_to_litr1c(beg:end) = nan + ccf%m_frootc_xfer_to_litr1c(beg:end) = nan + ccf%m_livestemc_xfer_to_litr1c(beg:end) = nan + ccf%m_deadstemc_xfer_to_litr1c(beg:end) = nan + ccf%m_livecrootc_xfer_to_litr1c(beg:end) = nan + ccf%m_deadcrootc_xfer_to_litr1c(beg:end) = nan + ccf%m_livestemc_to_cwdc(beg:end) = nan + ccf%m_deadstemc_to_cwdc(beg:end) = nan + ccf%m_livecrootc_to_cwdc(beg:end) = nan + ccf%m_deadcrootc_to_cwdc(beg:end) = nan + ccf%m_gresp_storage_to_litr1c(beg:end) = nan + ccf%m_gresp_xfer_to_litr1c(beg:end) = nan + ccf%m_deadstemc_to_cwdc_fire(beg:end) = nan + ccf%m_deadcrootc_to_cwdc_fire(beg:end) = nan + ccf%hrv_leafc_to_litr1c(beg:end) = nan + ccf%hrv_leafc_to_litr2c(beg:end) = nan + ccf%hrv_leafc_to_litr3c(beg:end) = nan + ccf%hrv_frootc_to_litr1c(beg:end) = nan + ccf%hrv_frootc_to_litr2c(beg:end) = nan + ccf%hrv_frootc_to_litr3c(beg:end) = nan + ccf%hrv_livestemc_to_cwdc(beg:end) = nan + ccf%hrv_deadstemc_to_prod10c(beg:end) = nan + ccf%hrv_deadstemc_to_prod100c(beg:end) = nan + ccf%hrv_livecrootc_to_cwdc(beg:end) = nan + ccf%hrv_deadcrootc_to_cwdc(beg:end) = nan + ccf%hrv_leafc_storage_to_litr1c(beg:end) = nan + ccf%hrv_frootc_storage_to_litr1c(beg:end) = nan + ccf%hrv_livestemc_storage_to_litr1c(beg:end) = nan + ccf%hrv_deadstemc_storage_to_litr1c(beg:end) = nan + ccf%hrv_livecrootc_storage_to_litr1c(beg:end) = nan + ccf%hrv_deadcrootc_storage_to_litr1c(beg:end) = nan + if ( crop_prog )then + ccf%grainc_to_litr1c(beg:end) = nan + ccf%grainc_to_litr2c(beg:end) = nan + ccf%grainc_to_litr3c(beg:end) = nan + ccf%livestemc_to_litr1c(beg:end) = nan + ccf%livestemc_to_litr2c(beg:end) = nan + ccf%livestemc_to_litr3c(beg:end) = nan + end if + ccf%hrv_gresp_storage_to_litr1c(beg:end) = nan + ccf%hrv_leafc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_frootc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_livestemc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_deadstemc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_livecrootc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_deadcrootc_xfer_to_litr1c(beg:end) = nan + ccf%hrv_gresp_xfer_to_litr1c(beg:end) = nan + ccf%m_litr1c_to_fire(beg:end) = nan + ccf%m_litr2c_to_fire(beg:end) = nan + ccf%m_litr3c_to_fire(beg:end) = nan + ccf%m_cwdc_to_fire(beg:end) = nan + ccf%leafc_to_litr1c(beg:end) = nan + ccf%leafc_to_litr2c(beg:end) = nan + ccf%leafc_to_litr3c(beg:end) = nan + ccf%frootc_to_litr1c(beg:end) = nan + ccf%frootc_to_litr2c(beg:end) = nan + ccf%frootc_to_litr3c(beg:end) = nan + ccf%cwdc_to_litr2c(beg:end) = nan + ccf%cwdc_to_litr3c(beg:end) = nan + ccf%litr1_hr(beg:end) = nan + ccf%litr1c_to_soil1c(beg:end) = nan + ccf%litr2_hr(beg:end) = nan + ccf%litr2c_to_soil2c(beg:end) = nan + ccf%litr3_hr(beg:end) = nan + ccf%litr3c_to_soil3c(beg:end) = nan + ccf%soil1_hr(beg:end) = nan + ccf%soil1c_to_soil2c(beg:end) = nan + ccf%soil2_hr(beg:end) = nan + ccf%soil2c_to_soil3c(beg:end) = nan + ccf%soil3_hr(beg:end) = nan + ccf%soil3c_to_soil4c(beg:end) = nan + ccf%soil4_hr(beg:end) = nan + if (use_cn) then + ccf%dwt_seedc_to_leaf(beg:end) = nan + ccf%dwt_seedc_to_deadstem(beg:end) = nan + ccf%dwt_conv_cflux(beg:end) = nan + ccf%dwt_prod10c_gain(beg:end) = nan + ccf%dwt_prod100c_gain(beg:end) = nan + ccf%dwt_frootc_to_litr1c(beg:end) = nan + ccf%dwt_frootc_to_litr2c(beg:end) = nan + ccf%dwt_frootc_to_litr3c(beg:end) = nan + ccf%dwt_livecrootc_to_cwdc(beg:end) = nan + ccf%dwt_deadcrootc_to_cwdc(beg:end) = nan + ccf%dwt_closs(beg:end) = nan + ccf%landuseflux(beg:end) = nan + ccf%landuptake(beg:end) = nan + ccf%prod10c_loss(beg:end) = nan + ccf%prod100c_loss(beg:end) = nan + ccf%product_closs(beg:end) = nan + end if + ccf%lithr(beg:end) = nan + ccf%somhr(beg:end) = nan + ccf%hr(beg:end) = nan + ccf%sr(beg:end) = nan + ccf%er(beg:end) = nan + ccf%litfire(beg:end) = nan + ccf%somfire(beg:end) = nan + ccf%totfire(beg:end) = nan + ccf%nep(beg:end) = nan + ccf%nbp(beg:end) = nan + ccf%nee(beg:end) = nan + ccf%col_cinputs(beg:end) = nan + ccf%col_coutputs(beg:end) = nan + ccf%col_fire_closs(beg:end) = nan + + if (use_cn) then + ccf%cwdc_hr(beg:end) = nan + ccf%cwdc_loss(beg:end) = nan + ccf%litterc_loss(beg:end) = nan + end if + + end subroutine init_column_cflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_column_nflux_type +! +! !INTERFACE: + subroutine init_column_nflux_type(beg, end, cnf) +! +! !DESCRIPTION: +! Initialize column nitrogen flux variables +! +! !USES: + use surfrdMod , only : crop_prog +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (column_nflux_type), intent(inout):: cnf +! +! !REVISION HISTORY: +! Created by Peter Thornton +! +!EOP +!------------------------------------------------------------------------ + + allocate(cnf%ndep_to_sminn(beg:end)) + allocate(cnf%nfix_to_sminn(beg:end)) + allocate(cnf%m_leafn_to_litr1n(beg:end)) + allocate(cnf%m_leafn_to_litr2n(beg:end)) + allocate(cnf%m_leafn_to_litr3n(beg:end)) + allocate(cnf%m_frootn_to_litr1n(beg:end)) + allocate(cnf%m_frootn_to_litr2n(beg:end)) + allocate(cnf%m_frootn_to_litr3n(beg:end)) + allocate(cnf%m_leafn_storage_to_litr1n(beg:end)) + allocate(cnf%m_frootn_storage_to_litr1n(beg:end)) + allocate(cnf%m_livestemn_storage_to_litr1n(beg:end)) + allocate(cnf%m_deadstemn_storage_to_litr1n(beg:end)) + allocate(cnf%m_livecrootn_storage_to_litr1n(beg:end)) + allocate(cnf%m_deadcrootn_storage_to_litr1n(beg:end)) + allocate(cnf%m_leafn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_frootn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_livestemn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_deadstemn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_livecrootn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_deadcrootn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_livestemn_to_cwdn(beg:end)) + allocate(cnf%m_deadstemn_to_cwdn(beg:end)) + allocate(cnf%m_livecrootn_to_cwdn(beg:end)) + allocate(cnf%m_deadcrootn_to_cwdn(beg:end)) + allocate(cnf%m_retransn_to_litr1n(beg:end)) + allocate(cnf%hrv_leafn_to_litr1n(beg:end)) + allocate(cnf%hrv_leafn_to_litr2n(beg:end)) + allocate(cnf%hrv_leafn_to_litr3n(beg:end)) + allocate(cnf%hrv_frootn_to_litr1n(beg:end)) + allocate(cnf%hrv_frootn_to_litr2n(beg:end)) + allocate(cnf%hrv_frootn_to_litr3n(beg:end)) + allocate(cnf%hrv_livestemn_to_cwdn(beg:end)) + allocate(cnf%hrv_deadstemn_to_prod10n(beg:end)) + allocate(cnf%hrv_deadstemn_to_prod100n(beg:end)) + allocate(cnf%hrv_livecrootn_to_cwdn(beg:end)) + allocate(cnf%hrv_deadcrootn_to_cwdn(beg:end)) + allocate(cnf%hrv_retransn_to_litr1n(beg:end)) + allocate(cnf%hrv_leafn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_frootn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_livestemn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_deadstemn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_livecrootn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_deadcrootn_storage_to_litr1n(beg:end)) + allocate(cnf%hrv_leafn_xfer_to_litr1n(beg:end)) + allocate(cnf%hrv_frootn_xfer_to_litr1n(beg:end)) + allocate(cnf%hrv_livestemn_xfer_to_litr1n(beg:end)) + allocate(cnf%hrv_deadstemn_xfer_to_litr1n(beg:end)) + allocate(cnf%hrv_livecrootn_xfer_to_litr1n(beg:end)) + allocate(cnf%hrv_deadcrootn_xfer_to_litr1n(beg:end)) + allocate(cnf%m_deadstemn_to_cwdn_fire(beg:end)) + allocate(cnf%m_deadcrootn_to_cwdn_fire(beg:end)) + allocate(cnf%m_litr1n_to_fire(beg:end)) + allocate(cnf%m_litr2n_to_fire(beg:end)) + allocate(cnf%m_litr3n_to_fire(beg:end)) + allocate(cnf%m_cwdn_to_fire(beg:end)) + if ( crop_prog )then + allocate(cnf%grainn_to_litr1n(beg:end)) + allocate(cnf%grainn_to_litr2n(beg:end)) + allocate(cnf%grainn_to_litr3n(beg:end)) + allocate(cnf%livestemn_to_litr1n(beg:end)) + allocate(cnf%livestemn_to_litr2n(beg:end)) + allocate(cnf%livestemn_to_litr3n(beg:end)) + end if + allocate(cnf%leafn_to_litr1n(beg:end)) + allocate(cnf%leafn_to_litr2n(beg:end)) + allocate(cnf%leafn_to_litr3n(beg:end)) + allocate(cnf%frootn_to_litr1n(beg:end)) + allocate(cnf%frootn_to_litr2n(beg:end)) + allocate(cnf%frootn_to_litr3n(beg:end)) + allocate(cnf%cwdn_to_litr2n(beg:end)) + allocate(cnf%cwdn_to_litr3n(beg:end)) + allocate(cnf%litr1n_to_soil1n(beg:end)) + allocate(cnf%sminn_to_soil1n_l1(beg:end)) + allocate(cnf%litr2n_to_soil2n(beg:end)) + allocate(cnf%sminn_to_soil2n_l2(beg:end)) + allocate(cnf%litr3n_to_soil3n(beg:end)) + allocate(cnf%sminn_to_soil3n_l3(beg:end)) + allocate(cnf%soil1n_to_soil2n(beg:end)) + allocate(cnf%sminn_to_soil2n_s1(beg:end)) + allocate(cnf%soil2n_to_soil3n(beg:end)) + allocate(cnf%sminn_to_soil3n_s2(beg:end)) + allocate(cnf%soil3n_to_soil4n(beg:end)) + allocate(cnf%sminn_to_soil4n_s3(beg:end)) + allocate(cnf%soil4n_to_sminn(beg:end)) + allocate(cnf%sminn_to_denit_l1s1(beg:end)) + allocate(cnf%sminn_to_denit_l2s2(beg:end)) + allocate(cnf%sminn_to_denit_l3s3(beg:end)) + allocate(cnf%sminn_to_denit_s1s2(beg:end)) + allocate(cnf%sminn_to_denit_s2s3(beg:end)) + allocate(cnf%sminn_to_denit_s3s4(beg:end)) + allocate(cnf%sminn_to_denit_s4(beg:end)) + allocate(cnf%sminn_to_denit_excess(beg:end)) + allocate(cnf%sminn_leached(beg:end)) + allocate(cnf%dwt_seedn_to_leaf(beg:end)) + allocate(cnf%dwt_seedn_to_deadstem(beg:end)) + allocate(cnf%dwt_conv_nflux(beg:end)) + allocate(cnf%dwt_prod10n_gain(beg:end)) + allocate(cnf%dwt_prod100n_gain(beg:end)) + allocate(cnf%dwt_frootn_to_litr1n(beg:end)) + allocate(cnf%dwt_frootn_to_litr2n(beg:end)) + allocate(cnf%dwt_frootn_to_litr3n(beg:end)) + allocate(cnf%dwt_livecrootn_to_cwdn(beg:end)) + allocate(cnf%dwt_deadcrootn_to_cwdn(beg:end)) + allocate(cnf%dwt_nloss(beg:end)) + allocate(cnf%prod10n_loss(beg:end)) + allocate(cnf%prod100n_loss(beg:end)) + allocate(cnf%product_nloss(beg:end)) + allocate(cnf%potential_immob(beg:end)) + allocate(cnf%actual_immob(beg:end)) + allocate(cnf%sminn_to_plant(beg:end)) + allocate(cnf%supplement_to_sminn(beg:end)) + allocate(cnf%gross_nmin(beg:end)) + allocate(cnf%net_nmin(beg:end)) + allocate(cnf%denit(beg:end)) + allocate(cnf%col_ninputs(beg:end)) + allocate(cnf%col_noutputs(beg:end)) + allocate(cnf%col_fire_nloss(beg:end)) + + cnf%ndep_to_sminn(beg:end) = nan + cnf%nfix_to_sminn(beg:end) = nan + cnf%m_leafn_to_litr1n(beg:end) = nan + cnf%m_leafn_to_litr2n(beg:end) = nan + cnf%m_leafn_to_litr3n(beg:end) = nan + cnf%m_frootn_to_litr1n(beg:end) = nan + cnf%m_frootn_to_litr2n(beg:end) = nan + cnf%m_frootn_to_litr3n(beg:end) = nan + cnf%m_leafn_storage_to_litr1n(beg:end) = nan + cnf%m_frootn_storage_to_litr1n(beg:end) = nan + cnf%m_livestemn_storage_to_litr1n(beg:end) = nan + cnf%m_deadstemn_storage_to_litr1n(beg:end) = nan + cnf%m_livecrootn_storage_to_litr1n(beg:end) = nan + cnf%m_deadcrootn_storage_to_litr1n(beg:end) = nan + cnf%m_leafn_xfer_to_litr1n(beg:end) = nan + cnf%m_frootn_xfer_to_litr1n(beg:end) = nan + cnf%m_livestemn_xfer_to_litr1n(beg:end) = nan + cnf%m_deadstemn_xfer_to_litr1n(beg:end) = nan + cnf%m_livecrootn_xfer_to_litr1n(beg:end) = nan + cnf%m_deadcrootn_xfer_to_litr1n(beg:end) = nan + cnf%m_livestemn_to_cwdn(beg:end) = nan + cnf%m_deadstemn_to_cwdn(beg:end) = nan + cnf%m_livecrootn_to_cwdn(beg:end) = nan + cnf%m_deadcrootn_to_cwdn(beg:end) = nan + cnf%m_retransn_to_litr1n(beg:end) = nan + cnf%hrv_leafn_to_litr1n(beg:end) = nan + cnf%hrv_leafn_to_litr2n(beg:end) = nan + cnf%hrv_leafn_to_litr3n(beg:end) = nan + cnf%hrv_frootn_to_litr1n(beg:end) = nan + cnf%hrv_frootn_to_litr2n(beg:end) = nan + cnf%hrv_frootn_to_litr3n(beg:end) = nan + cnf%hrv_livestemn_to_cwdn(beg:end) = nan + cnf%hrv_deadstemn_to_prod10n(beg:end) = nan + cnf%hrv_deadstemn_to_prod100n(beg:end) = nan + cnf%hrv_livecrootn_to_cwdn(beg:end) = nan + cnf%hrv_deadcrootn_to_cwdn(beg:end) = nan + cnf%hrv_retransn_to_litr1n(beg:end) = nan + cnf%hrv_leafn_storage_to_litr1n(beg:end) = nan + cnf%hrv_frootn_storage_to_litr1n(beg:end) = nan + cnf%hrv_livestemn_storage_to_litr1n(beg:end) = nan + cnf%hrv_deadstemn_storage_to_litr1n(beg:end) = nan + cnf%hrv_livecrootn_storage_to_litr1n(beg:end) = nan + cnf%hrv_deadcrootn_storage_to_litr1n(beg:end) = nan + cnf%hrv_leafn_xfer_to_litr1n(beg:end) = nan + cnf%hrv_frootn_xfer_to_litr1n(beg:end) = nan + cnf%hrv_livestemn_xfer_to_litr1n(beg:end) = nan + cnf%hrv_deadstemn_xfer_to_litr1n(beg:end) = nan + cnf%hrv_livecrootn_xfer_to_litr1n(beg:end) = nan + cnf%hrv_deadcrootn_xfer_to_litr1n(beg:end) = nan + cnf%m_deadstemn_to_cwdn_fire(beg:end) = nan + cnf%m_deadcrootn_to_cwdn_fire(beg:end) = nan + cnf%m_litr1n_to_fire(beg:end) = nan + cnf%m_litr2n_to_fire(beg:end) = nan + cnf%m_litr3n_to_fire(beg:end) = nan + cnf%m_cwdn_to_fire(beg:end) = nan + if ( crop_prog )then + cnf%grainn_to_litr1n(beg:end) = nan + cnf%grainn_to_litr2n(beg:end) = nan + cnf%grainn_to_litr3n(beg:end) = nan + cnf%livestemn_to_litr1n(beg:end) = nan + cnf%livestemn_to_litr2n(beg:end) = nan + cnf%livestemn_to_litr3n(beg:end) = nan + end if + cnf%leafn_to_litr1n(beg:end) = nan + cnf%leafn_to_litr2n(beg:end) = nan + cnf%leafn_to_litr3n(beg:end) = nan + cnf%frootn_to_litr1n(beg:end) = nan + cnf%frootn_to_litr2n(beg:end) = nan + cnf%frootn_to_litr3n(beg:end) = nan + cnf%cwdn_to_litr2n(beg:end) = nan + cnf%cwdn_to_litr3n(beg:end) = nan + cnf%litr1n_to_soil1n(beg:end) = nan + cnf%sminn_to_soil1n_l1(beg:end) = nan + cnf%litr2n_to_soil2n(beg:end) = nan + cnf%sminn_to_soil2n_l2(beg:end) = nan + cnf%litr3n_to_soil3n(beg:end) = nan + cnf%sminn_to_soil3n_l3(beg:end) = nan + cnf%soil1n_to_soil2n(beg:end) = nan + cnf%sminn_to_soil2n_s1(beg:end) = nan + cnf%soil2n_to_soil3n(beg:end) = nan + cnf%sminn_to_soil3n_s2(beg:end) = nan + cnf%soil3n_to_soil4n(beg:end) = nan + cnf%sminn_to_soil4n_s3(beg:end) = nan + cnf%soil4n_to_sminn(beg:end) = nan + cnf%sminn_to_denit_l1s1(beg:end) = nan + cnf%sminn_to_denit_l2s2(beg:end) = nan + cnf%sminn_to_denit_l3s3(beg:end) = nan + cnf%sminn_to_denit_s1s2(beg:end) = nan + cnf%sminn_to_denit_s2s3(beg:end) = nan + cnf%sminn_to_denit_s3s4(beg:end) = nan + cnf%sminn_to_denit_s4(beg:end) = nan + cnf%sminn_to_denit_excess(beg:end) = nan + cnf%sminn_leached(beg:end) = nan + cnf%dwt_seedn_to_leaf(beg:end) = nan + cnf%dwt_seedn_to_deadstem(beg:end) = nan + cnf%dwt_conv_nflux(beg:end) = nan + cnf%dwt_prod10n_gain(beg:end) = nan + cnf%dwt_prod100n_gain(beg:end) = nan + cnf%dwt_frootn_to_litr1n(beg:end) = nan + cnf%dwt_frootn_to_litr2n(beg:end) = nan + cnf%dwt_frootn_to_litr3n(beg:end) = nan + cnf%dwt_livecrootn_to_cwdn(beg:end) = nan + cnf%dwt_deadcrootn_to_cwdn(beg:end) = nan + cnf%dwt_nloss(beg:end) = nan + cnf%prod10n_loss(beg:end) = nan + cnf%prod100n_loss(beg:end) = nan + cnf%product_nloss(beg:end) = nan + cnf%potential_immob(beg:end) = nan + cnf%actual_immob(beg:end) = nan + cnf%sminn_to_plant(beg:end) = nan + cnf%supplement_to_sminn(beg:end) = nan + cnf%gross_nmin(beg:end) = nan + cnf%net_nmin(beg:end) = nan + cnf%denit(beg:end) = nan + cnf%col_ninputs(beg:end) = nan + cnf%col_noutputs(beg:end) = nan + cnf%col_fire_nloss(beg:end) = nan + + end subroutine init_column_nflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_landunit_pstate_type +! +! !INTERFACE: + subroutine init_landunit_pstate_type(beg, end, lps) +! +! !DESCRIPTION: +! Initialize landunit physical state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (landunit_pstate_type), intent(inout):: lps +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(lps%t_building(beg:end)) + allocate(lps%t_building_max(beg:end)) + allocate(lps%t_building_min(beg:end)) + allocate(lps%tk_wall(beg:end,nlevurb)) + allocate(lps%tk_roof(beg:end,nlevurb)) + allocate(lps%tk_improad(beg:end,nlevgrnd)) + allocate(lps%cv_wall(beg:end,nlevurb)) + allocate(lps%cv_roof(beg:end,nlevurb)) + allocate(lps%cv_improad(beg:end,nlevgrnd)) + allocate(lps%thick_wall(beg:end)) + allocate(lps%thick_roof(beg:end)) + allocate(lps%nlev_improad(beg:end)) + allocate(lps%vf_sr(beg:end)) + allocate(lps%vf_wr(beg:end)) + allocate(lps%vf_sw(beg:end)) + allocate(lps%vf_rw(beg:end)) + allocate(lps%vf_ww(beg:end)) + allocate(lps%taf(beg:end)) + allocate(lps%qaf(beg:end)) + allocate(lps%sabs_roof_dir(beg:end,1:numrad)) + allocate(lps%sabs_roof_dif(beg:end,1:numrad)) + allocate(lps%sabs_sunwall_dir(beg:end,1:numrad)) + allocate(lps%sabs_sunwall_dif(beg:end,1:numrad)) + allocate(lps%sabs_shadewall_dir(beg:end,1:numrad)) + allocate(lps%sabs_shadewall_dif(beg:end,1:numrad)) + allocate(lps%sabs_improad_dir(beg:end,1:numrad)) + allocate(lps%sabs_improad_dif(beg:end,1:numrad)) + allocate(lps%sabs_perroad_dir(beg:end,1:numrad)) + allocate(lps%sabs_perroad_dif(beg:end,1:numrad)) + + lps%t_building(beg:end) = nan + lps%t_building_max(beg:end) = nan + lps%t_building_min(beg:end) = nan + lps%tk_wall(beg:end,1:nlevurb) = nan + lps%tk_roof(beg:end,1:nlevurb) = nan + lps%tk_improad(beg:end,1:nlevgrnd) = nan + lps%cv_wall(beg:end,1:nlevurb) = nan + lps%cv_roof(beg:end,1:nlevurb) = nan + lps%cv_improad(beg:end,1:nlevgrnd) = nan + lps%cv_improad(beg:end,1:5) = nan + lps%thick_wall(beg:end) = nan + lps%thick_roof(beg:end) = nan + lps%nlev_improad(beg:end) = huge(1) + lps%vf_sr(beg:end) = nan + lps%vf_wr(beg:end) = nan + lps%vf_sw(beg:end) = nan + lps%vf_rw(beg:end) = nan + lps%vf_ww(beg:end) = nan + lps%taf(beg:end) = nan + lps%qaf(beg:end) = nan + lps%sabs_roof_dir(beg:end,1:numrad) = nan + lps%sabs_roof_dif(beg:end,1:numrad) = nan + lps%sabs_sunwall_dir(beg:end,1:numrad) = nan + lps%sabs_sunwall_dif(beg:end,1:numrad) = nan + lps%sabs_shadewall_dir(beg:end,1:numrad) = nan + lps%sabs_shadewall_dif(beg:end,1:numrad) = nan + lps%sabs_improad_dir(beg:end,1:numrad) = nan + lps%sabs_improad_dif(beg:end,1:numrad) = nan + lps%sabs_perroad_dir(beg:end,1:numrad) = nan + lps%sabs_perroad_dif(beg:end,1:numrad) = nan + + end subroutine init_landunit_pstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_landunit_eflux_type +! +! !INTERFACE: + subroutine init_landunit_eflux_type(beg, end, lef) +! +! !DESCRIPTION: +! Initialize landunit energy flux variables +! +! !USES: + use clm_varcon, only : spval +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (landunit_eflux_type), intent(inout):: lef +! +! !REVISION HISTORY: +! Created by Keith Oleson +! +!EOP +!------------------------------------------------------------------------ + + allocate(lef%eflx_traffic(beg:end)) + allocate(lef%eflx_traffic_factor(beg:end)) + allocate(lef%eflx_wasteheat(beg:end)) + allocate(lef%eflx_heat_from_ac(beg:end)) + + lef%eflx_traffic(beg:end) = spval + lef%eflx_traffic_factor(beg:end) = nan + lef%eflx_wasteheat(beg:end) = spval + lef%eflx_heat_from_ac(beg:end) = spval + + end subroutine init_landunit_eflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_dgvstate_type +! +! !INTERFACE: + subroutine init_gridcell_dgvstate_type(beg, end, gps) +! +! !DESCRIPTION: +! Initialize gridcell DGVM variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_dgvstate_type), intent(inout):: gps +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(gps%agdd20(beg:end)) + allocate(gps%tmomin20(beg:end)) + allocate(gps%t10min(beg:end)) + + gps%agdd20(beg:end) = nan + gps%tmomin20(beg:end) = nan + gps%t10min(beg:end) = nan + + end subroutine init_gridcell_dgvstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_pstate_type +! +! !INTERFACE: + subroutine init_gridcell_pstate_type(beg, end, gps) +! +! !DESCRIPTION: +! Initialize gridcell physical state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_pstate_type), intent(inout):: gps +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + + !allocate(gps%bcphiwet2t(beg:end,1:2)) + !allocate(gps%bcphidry2t(beg:end,1:2)) + !allocate(gps%bcphodry2t(beg:end,1:2)) + !allocate(gps%ocphiwet2t(beg:end,1:2)) + !allocate(gps%ocphidry2t(beg:end,1:2)) + !allocate(gps%ocphodry2t(beg:end,1:2)) + !allocate(gps%dstx01wd2t(beg:end,1:2)) + !allocate(gps%dstx01dd2t(beg:end,1:2)) + !allocate(gps%dstx02wd2t(beg:end,1:2)) + !allocate(gps%dstx02dd2t(beg:end,1:2)) + !allocate(gps%dstx03wd2t(beg:end,1:2)) + !allocate(gps%dstx03dd2t(beg:end,1:2)) + !allocate(gps%dstx04wd2t(beg:end,1:2)) + !allocate(gps%dstx04dd2t(beg:end,1:2)) + + !gps%bcphiwet2t(beg:end,1:2) = nan + !gps%bcphidry2t(beg:end,1:2) = nan + !gps%bcphodry2t(beg:end,1:2) = nan + !gps%ocphiwet2t(beg:end,1:2) = nan + !gps%ocphidry2t(beg:end,1:2) = nan + !gps%ocphodry2t(beg:end,1:2) = nan + !gps%dstx01wd2t(beg:end,1:2) = nan + !gps%dstx01dd2t(beg:end,1:2) = nan + !gps%dstx02wd2t(beg:end,1:2) = nan + !gps%dstx02dd2t(beg:end,1:2) = nan + !gps%dstx03wd2t(beg:end,1:2) = nan + !gps%dstx03dd2t(beg:end,1:2) = nan + !gps%dstx04wd2t(beg:end,1:2) = nan + !gps%dstx04dd2t(beg:end,1:2) = nan + + end subroutine init_gridcell_pstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_efstate_type +! +! !INTERFACE: + subroutine init_gridcell_efstate_type(beg, end, gve) +! +! !DESCRIPTION: +! Initialize gridcell isoprene emission factor variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_efstate_type), intent(inout) :: gve +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein (heald) +! +!EOP +!------------------------------------------------------------------------ + + allocate(gve%efisop(6,beg:end)) + gve%efisop(:,beg:end) = nan + + end subroutine init_gridcell_efstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_wflux_type +! +! !INTERFACE: + subroutine init_gridcell_wflux_type(beg, end, gwf) +! +! !DESCRIPTION: +! Initialize gridcell water flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_wflux_type), intent(inout):: gwf +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP +!------------------------------------------------------------------------ + + allocate(gwf%qflx_runoffg(beg:end)) + allocate(gwf%qflx_snwcp_iceg(beg:end)) + allocate(gwf%qflx_liq_dynbal(beg:end)) + allocate(gwf%qflx_ice_dynbal(beg:end)) + allocate(gwf%qflx_floodg(beg:end)) + + gwf%qflx_runoffg(beg:end) = 0._r8 + gwf%qflx_snwcp_iceg(beg:end) = 0._r8 + gwf%qflx_liq_dynbal(beg:end) = nan + gwf%qflx_ice_dynbal(beg:end) = nan + gwf%qflx_floodg(beg:end) = 0._r8 !rtm_flood: initialize to zero for 1st time step instead of nan + + end subroutine init_gridcell_wflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_eflux_type +! +! !INTERFACE: + subroutine init_gridcell_eflux_type(beg, end, gef) +! +! !DESCRIPTION: +! Initialize gridcell energy flux variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_eflux_type), intent(inout):: gef +! +! !REVISION HISTORY: +! Created by David Lawrence +! +!EOP +!------------------------------------------------------------------------ + allocate(gef%eflx_sh_totg(beg:end)) + allocate(gef%eflx_dynbal(beg:end)) + + gef%eflx_sh_totg(beg:end) = nan + gef%eflx_dynbal(beg:end) = nan + + end subroutine init_gridcell_eflux_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_wstate_type +! +! !INTERFACE: + subroutine init_gridcell_wstate_type(beg, end, gws) +! +! !DESCRIPTION: +! Initialize gridcell water state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_wstate_type), intent(inout):: gws +! +! !REVISION HISTORY: +! Created by David Lawrence +! +!EOP +!------------------------------------------------------------------------ + allocate(gws%gc_liq1(beg:end)) + allocate(gws%gc_liq2(beg:end)) + allocate(gws%gc_ice1(beg:end)) + allocate(gws%gc_ice2(beg:end)) + + gws%gc_liq1(beg:end) = nan + gws%gc_liq2(beg:end) = nan + gws%gc_ice1(beg:end) = nan + gws%gc_ice2(beg:end) = nan + + end subroutine init_gridcell_wstate_type + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: init_gridcell_estate_type +! +! !INTERFACE: + subroutine init_gridcell_estate_type(beg, end, ges) +! +! !DESCRIPTION: +! Initialize gridcell energy state variables +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: beg, end + type (gridcell_estate_type), intent(inout):: ges +! +! !REVISION HISTORY: +! Created by David Lawrence +! +!EOP +!------------------------------------------------------------------------ + allocate(ges%gc_heat1(beg:end)) + allocate(ges%gc_heat2(beg:end)) + + ges%gc_heat1(beg:end) = nan + ges%gc_heat2(beg:end) = nan + + end subroutine init_gridcell_estate_type + +end module clmtypeInitMod diff --git a/components/clm/src_clm40/main/controlMod.F90 b/components/clm/src_clm40/main/controlMod.F90 new file mode 100644 index 0000000000..f2d5bb43a7 --- /dev/null +++ b/components/clm/src_clm40/main/controlMod.F90 @@ -0,0 +1,562 @@ +module controlMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: controlMod +! +! !DESCRIPTION: +! Module which initializes run control variables. The following possible +! namelist variables are set default values and possibly read in on startup +! +! Note: For definitions of namelist variables see +! ../../bld/namelist_files/namelist_definition.xml +! Display the file in a browser to see it neatly formatted in html. +! + +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL + use clm_varpar , only : maxpatch_pft, maxpatch_glcmec + use clm_varctl , only : caseid, ctitle, nsrest, brnch_retain_casename, hostname, & + model_version=>version, & + iulog, finidat, fsurdat, fatmlndfrc, & + fatmtopo, flndtopo, flanduse_timeseries, fpftcon, nrevsn, & + create_crop_landunit, allocate_all_vegpfts, & + co2_type, wrtdia, co2_ppmv, nsegspc, & + username, fsnowaging, fsnowoptics, fglcmask, & + create_glacier_mec_landunit, glc_dyntopo, glc_smb, & + use_c13, use_c14, use_cn, use_cndv, use_crop + use spmdMod , only : masterproc + use decompMod , only : clump_pproc + use histFileMod , only : max_tapes, max_namlen, & + hist_empty_htapes, hist_dov2xy, & + hist_avgflag_pertape, hist_type1d_pertape, & + hist_nhtfrq, hist_ndens, hist_mfilt, & + hist_fincl1, hist_fincl2, hist_fincl3, & + hist_fincl4, hist_fincl5, hist_fincl6, & + hist_fexcl1, hist_fexcl2, hist_fexcl3, & + hist_fexcl4, hist_fexcl5, hist_fexcl6 + use shr_const_mod, only : SHR_CONST_CDAY + use abortutils , only : endrun + use UrbanMod , only : urban_hac, urban_traffic + use SurfaceAlbedoMod, only : albice + use CNAllocationMod , only : suplnitro + +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: control_setNL ! Set namelist filename + public :: control_init ! initial run control information + public :: control_print ! print run control information +! +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE TYPES: +! Namelist variables only used locally + character(len= 7) :: runtyp(4) ! run type + character(len=SHR_KIND_CL) :: NLFilename = 'lnd.stdin' ! Namelist filename +#if (defined _OPENMP) + integer, external :: omp_get_max_threads ! max number of threads that can execute + ! concurrently in a single parallel region +#endif +!EOP +!----------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: control_setNL +! +! !INTERFACE: + subroutine control_setNL( NLfile ) + + implicit none +! +! !DESCRIPTION: +! Set the namelist filename to use +! +! +! !ARGUMENTS: + character(len=*), intent(IN) :: NLFile ! Namelist filename +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'control_setNL' ! subroutine name + logical :: lexist ! File exists + + ! Error checking... + if ( len_trim(NLFile) == 0 )then + call endrun( subname//' error: nlfilename entered is not set' ) + end if + inquire (file = trim(NLFile), exist = lexist) + if ( .not. lexist )then + call endrun( subname//' error: NLfilename entered does NOT exist:'//trim(NLFile) ) + end if + if ( len_trim(NLFile) > len(NLFilename) )then + call endrun( subname//' error: entered NLFile is too long' ) + end if + ! Set the filename + NLFilename = NLFile + end subroutine control_setNL + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: control_init +! +! !INTERFACE: + subroutine control_init( ) +! +! !DESCRIPTION: +! Initialize CLM run control information +! +! !USES: + use clm_time_manager , only : set_timemgr_init, get_timemgr_defaults + use fileutils , only : getavu, relavu + use shr_string_mod , only : shr_string_getParentDir + use clm_varctl , only : clmvarctl_init, clm_varctl_set, nsrBranch, nsrStartup, & + nsrContinue + use clm_cpl_indices , only : glc_nec + + implicit none +! +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: starttype ! infodata start type + integer :: i,j,n ! loop indices + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + integer :: dtime ! Integer time-step + integer :: override_nsrest ! If want to override the startup type sent from driver + character(len=32) :: subname = 'control_init' ! subroutine name +!------------------------------------------------------------------------ + + ! ---------------------------------------------------------------------- + ! Namelist Variables + ! ---------------------------------------------------------------------- + + ! Time step + namelist / clm_inparm/ & + dtime + + ! CLM namelist settings + + namelist /clm_inparm / & + fatmlndfrc, finidat, nrevsn + + ! Input datasets + + namelist /clm_inparm/ & + fsurdat, fatmtopo, flndtopo, & + fpftcon, flanduse_timeseries, fsnowoptics, fsnowaging + + ! History, restart options + + namelist /clm_inparm/ & + hist_empty_htapes, hist_dov2xy, & + hist_avgflag_pertape, hist_type1d_pertape, & + hist_nhtfrq, hist_ndens, hist_mfilt, & + hist_fincl1, hist_fincl2, hist_fincl3, & + hist_fincl4, hist_fincl5, hist_fincl6, & + hist_fexcl1, hist_fexcl2, hist_fexcl3, & + hist_fexcl4, hist_fexcl5, hist_fexcl6 + + ! BGC info + + namelist /clm_inparm/ & + suplnitro + + namelist /clm_inparm / use_c13, use_c14 + + namelist /clm_inparm / & + co2_type + + ! Glacier_mec info + namelist /clm_inparm / & + maxpatch_glcmec, glc_smb, glc_dyntopo, fglcmask + + ! Other options + + namelist /clm_inparm/ & + clump_pproc, wrtdia, & + create_crop_landunit, nsegspc, co2_ppmv, override_nsrest, & + albice + ! Urban options + + namelist /clm_inparm/ & + urban_hac, urban_traffic + + ! ---------------------------------------------------------------------- + ! Default values + ! ---------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to initialize run control settings .....' + endif + + runtyp(:) = 'missing' + runtyp(nsrStartup + 1) = 'initial' + runtyp(nsrContinue + 1) = 'restart' + runtyp(nsrBranch + 1) = 'branch ' + + ! Set clumps per procoessor + +#if (defined _OPENMP) + clump_pproc = omp_get_max_threads() +#else + clump_pproc = 1 +#endif + + override_nsrest = nsrest + + if (masterproc) then + + ! ---------------------------------------------------------------------- + ! Read namelist from standard input. + ! ---------------------------------------------------------------------- + + if ( len_trim(NLFilename) == 0 )then + call endrun( subname//' error: nlfilename not set' ) + end if + unitn = getavu() + write(iulog,*) 'Read in clm_inparm namelist from: ', trim(NLFilename) + open( unitn, file=trim(NLFilename), status='old' ) + ierr = 1 + do while ( ierr /= 0 ) + read(unitn, clm_inparm, iostat=ierr) + if (ierr < 0) then + call endrun( subname//' encountered end-of-file on clm_inparm read' ) + endif + end do + call relavu( unitn ) + + ! ---------------------------------------------------------------------- + ! Consistency checks on input namelist. + ! ---------------------------------------------------------------------- + + call set_timemgr_init( dtime_in=dtime ) + + if (urban_traffic) then + write(iulog,*)'Urban traffic fluxes are not implemented currently' + call endrun() + end if + + ! History and restart files + + do i = 1, max_tapes + if (hist_nhtfrq(i) == 0) then + hist_mfilt(i) = 1 + else if (hist_nhtfrq(i) < 0) then + hist_nhtfrq(i) = nint(-hist_nhtfrq(i)*SHR_CONST_CDAY/(24._r8*dtime)) + endif + end do + + ! Override start-type (can only override to branch (3) and only + ! if the driver is a startup type + if ( override_nsrest /= nsrest )then + if ( override_nsrest /= nsrBranch .and. nsrest /= nsrStartup )then + call endrun( subname//' ERROR: can ONLY override clm start-type ' // & + 'to branch type and ONLY if driver is a startup type' ) + end if + call clm_varctl_set( nsrest_in=override_nsrest ) + end if + + ! Consistency of elevation classes on namelist to what's sent by the coupler + if (glc_nec /= maxpatch_glcmec ) then + write(iulog,*)'glc_nec, maxpatch_glcmec=',glc_nec, maxpatch_glcmec + write(iulog,*)'Number of glacier elevation classes from clm namelist and' // & + ' sent by the coupler MUST be equal' + call endrun( subname //' ERROR: glc_nec and maxpatch_glcmec must be equal') + end if + if (maxpatch_glcmec > 0) then + create_glacier_mec_landunit = .true. + else + create_glacier_mec_landunit = .false. + end if + + endif ! end of if-masterproc if-block + + call clmvarctl_init( masterproc, dtime ) + + ! ---------------------------------------------------------------------- + ! Broadcast all control information if appropriate + ! ---------------------------------------------------------------------- + + call control_spmd() + + if (masterproc) then + write(iulog,*) 'Successfully initialized run control settings' + write(iulog,*) + endif + + end subroutine control_init + + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: control_spmd +! +! !INTERFACE: + subroutine control_spmd() +! +! !DESCRIPTION: +! Distribute namelist data all processors. All program i/o is +! funnelled through the master processor. Processor 0 either +! reads restart/history data from the disk and distributes +! it to all processors, or collects data from +! all processors and writes it to disk. +! +! !USES: +! + use spmdMod, only : mpicom, MPI_CHARACTER, MPI_INTEGER, MPI_LOGICAL, MPI_REAL8 + use clm_varctl, only : single_column, scmlat, scmlon, rpntfil +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer ier !error code +!----------------------------------------------------------------------- + + ! run control variables + + call mpi_bcast (caseid, len(caseid), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (ctitle, len(ctitle), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (model_version, len(model_version), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hostname, len(hostname), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (username, len(username), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (nsrest, 1, MPI_INTEGER , 0, mpicom, ier) + + ! initial file variables + + call mpi_bcast (nrevsn , len(nrevsn) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (finidat , len(finidat) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsurdat , len(fsurdat) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fatmlndfrc,len(fatmlndfrc),MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fatmtopo, len(fatmtopo) ,MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (flndtopo, len(flndtopo) ,MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fpftcon , len(fpftcon) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (flanduse_timeseries , len(flanduse_timeseries) , MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) + + ! Landunit generation + + call mpi_bcast(create_crop_landunit, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast(allocate_all_vegpfts, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! BGC + + call mpi_bcast (co2_type, len(co2_type), MPI_CHARACTER, 0, mpicom, ier) + if (use_cn) then + call mpi_bcast (suplnitro, len(suplnitro), MPI_CHARACTER, 0, mpicom, ier) + end if + + ! isotopes + + call mpi_bcast (use_c13, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_c14, 1, MPI_LOGICAL, 0, mpicom, ier) + + ! physics variables + + call mpi_bcast (urban_hac , len(urban_hac), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (urban_traffic , 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (nsegspc , 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (wrtdia , 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (single_column,1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (scmlat, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (scmlon, 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (co2_ppmv , 1, MPI_REAL8, 0, mpicom, ier) + call mpi_bcast (albice , 2, MPI_REAL8, 0, mpicom, ier) + + ! glacier_mec variables + + call mpi_bcast (create_glacier_mec_landunit, 1, MPI_LOGICAL , 0, mpicom, ier) + call mpi_bcast (maxpatch_glcmec ,1, MPI_INTEGER , 0, mpicom, ier) + call mpi_bcast (glc_smb, 1, MPI_LOGICAL , 0, mpicom, ier) + call mpi_bcast (glc_dyntopo, 1, MPI_LOGICAL , 0, mpicom, ier) + call mpi_bcast (fglcmask, len(fglcmask), MPI_CHARACTER, 0, mpicom, ier) + + ! history file variables + + call mpi_bcast (hist_empty_htapes, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (hist_dov2xy, size(hist_dov2xy), MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (hist_nhtfrq, size(hist_nhtfrq), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_mfilt, size(hist_mfilt), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_ndens, size(hist_ndens), MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (hist_avgflag_pertape, size(hist_avgflag_pertape), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_type1d_pertape, max_namlen*size(hist_type1d_pertape), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl1, max_namlen*size(hist_fexcl1), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl2, max_namlen*size(hist_fexcl2), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl3, max_namlen*size(hist_fexcl3), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl4, max_namlen*size(hist_fexcl4), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl5, max_namlen*size(hist_fexcl5), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fexcl6, max_namlen*size(hist_fexcl6), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl1, (max_namlen+2)*size(hist_fincl1), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl2, (max_namlen+2)*size(hist_fincl2), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl3, (max_namlen+2)*size(hist_fincl3), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl4, (max_namlen+2)*size(hist_fincl4), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl5, (max_namlen+2)*size(hist_fincl5), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (hist_fincl6, (max_namlen+2)*size(hist_fincl6), MPI_CHARACTER, 0, mpicom, ier) + + ! restart file variables + + call mpi_bcast (rpntfil, len(rpntfil), MPI_CHARACTER, 0, mpicom, ier) + + ! clump decomposition variables + + call mpi_bcast (clump_pproc, 1, MPI_INTEGER, 0, mpicom, ier) + + end subroutine control_spmd + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: control_print +! +! !INTERFACE: + subroutine control_print () +! +! !DESCRIPTION: +! Write out the clm namelist run control variables +! +! !USES: +! + use clm_varctl, only : source, rpntdir, rpntfil, nsrStartup, nsrBranch, & + nsrContinue + use CNAllocationMod, only : suplnitro, suplnNon +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + character(len=32) :: subname = 'control_print' ! subroutine name +!------------------------------------------------------------------------ + + write(iulog,*) 'define run:' + write(iulog,*) ' source = ',trim(source) + write(iulog,*) ' model_version = ',trim(model_version) + write(iulog,*) ' run type = ',runtyp(nsrest+1) + write(iulog,*) ' case title = ',trim(ctitle) + write(iulog,*) ' username = ',trim(username) + write(iulog,*) ' hostname = ',trim(hostname) + write(iulog,*) 'input data files:' + write(iulog,*) ' PFT physiology = ',trim(fpftcon) + if (fsurdat == ' ') then + write(iulog,*) ' fsurdat, surface dataset not set' + else + write(iulog,*) ' surface data = ',trim(fsurdat) + end if + if (fatmlndfrc == ' ') then + write(iulog,*) ' fatmlndfrc not set, setting frac/mask to 1' + else + write(iulog,*) ' land frac data = ',trim(fatmlndfrc) + end if + if (flndtopo == ' ') then + write(iulog,*) ' flndtopo not set' + else + write(iulog,*) ' land topographic data = ',trim(flndtopo) + end if + if (fatmtopo == ' ') then + write(iulog,*) ' fatmtopo not set' + else + write(iulog,*) ' atm topographic data = ',trim(fatmtopo) + end if + if (use_cn) then + if (suplnitro /= suplnNon)then + write(iulog,*) ' Supplemental Nitrogen mode is set to run over PFTs: ', & + trim(suplnitro) + end if + write(iulog, *) ' use_c13: ', use_c13 + write(iulog, *) ' use_c14: ', use_c14 + end if + if (fsnowoptics == ' ') then + write(iulog,*) ' snow optical properties file NOT set' + else + write(iulog,*) ' snow optical properties file = ',trim(fsnowoptics) + endif + if (fsnowaging == ' ') then + write(iulog,*) ' snow aging parameters file NOT set' + else + write(iulog,*) ' snow aging parameters file = ',trim(fsnowaging) + endif + + if (create_glacier_mec_landunit) then + write(iulog,*) ' glc number of elevation classes =', maxpatch_glcmec + write(iulog,*) ' glc glacier mask file = ',trim(fglcmask) + if (glc_dyntopo) then + write(iulog,*) ' glc CLM glacier topography will evolve dynamically' + else + write(iulog,*) ' glc CLM glacier topography will NOT evolve dynamically' + endif + if (glc_smb) then + write(iulog,*) ' glc surface mass balance will be passed to ice sheet model' + else + write(iulog,*) ' glc positive-degree-day info will be passed to ice sheet model' + endif + endif + + if (nsrest == nsrStartup .and. finidat == ' ') write(iulog,*) ' initial data created by model' + if (nsrest == nsrStartup .and. finidat /= ' ') write(iulog,*) ' initial data = ',trim(finidat) + if (nsrest /= nsrStartup) write(iulog,*) ' restart data = ',trim(nrevsn) + write(iulog,*) ' atmospheric forcing data is from cesm atm model' + write(iulog,*) 'Restart parameters:' + write(iulog,*)' restart pointer file directory = ',trim(rpntdir) + write(iulog,*)' restart pointer file name = ',trim(rpntfil) + write(iulog,*) 'model physics parameters:' + + if ( trim(co2_type) == 'constant' )then + write(iulog,*) ' CO2 volume mixing ratio (umol/mol) = ', co2_ppmv + else + write(iulog,*) ' CO2 volume mixing ratio = ', co2_type + end if + + write(iulog,*) ' land-ice albedos (unitless 0-1) = ', albice + write(iulog,*) ' urban air conditioning/heating and wasteheat = ', urban_hac + write(iulog,*) ' urban traffic flux = ', urban_traffic + if (nsrest == nsrContinue) then + write(iulog,*) 'restart warning:' + write(iulog,*) ' Namelist not checked for agreement with initial run.' + write(iulog,*) ' Namelist should not differ except for ending time step and run type' + end if + if (nsrest == nsrBranch) then + write(iulog,*) 'branch warning:' + write(iulog,*) ' Namelist not checked for agreement with initial run.' + write(iulog,*) ' Surface data set and reference date should not differ from initial run' + end if + write(iulog,*) ' maxpatch_pft = ',maxpatch_pft + write(iulog,*) ' allocate_all_vegpfts = ',allocate_all_vegpfts + write(iulog,*) ' nsegspc = ',nsegspc + + end subroutine control_print + +end module controlMod diff --git a/components/clm/src_clm40/main/decompInitMod.F90 b/components/clm/src_clm40/main/decompInitMod.F90 new file mode 100644 index 0000000000..031275f1ab --- /dev/null +++ b/components/clm/src_clm40/main/decompInitMod.F90 @@ -0,0 +1,762 @@ +module decompInitMod + +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: decompInitMod +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc, iam, npes, mpicom, comp_id + use shr_sys_mod , only : shr_sys_flush + use abortutils , only : endrun + use clm_varctl , only : iulog + use mct_mod + use decompMod +! +! !PUBLIC TYPES: + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: + public decompInit_lnd ! initializes atm grid decomposition into clumps and processors + public decompInit_glcp ! initializes g,l,c,p decomp info + +! +! !DESCRIPTION: +! Module provides a descomposition into a clumped data structure which can +! be mapped back to atmosphere physics chunks. +! +! !REVISION HISTORY: +! 2002.09.11 Forrest Hoffman Creation. +! 2005.11.01 T Craig Rewrite +! 2006.06.06 T Craig Reduce memory, cleanup +! +! +! !PRIVATE TYPES: + private + + integer, pointer :: lcid(:) ! temporary for setting ldecomp + +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: decompInit_lnd +! +! !INTERFACE: + subroutine decompInit_lnd(lni,lnj,amask) +! +! !DESCRIPTION: +! This subroutine initializes the land surface decomposition into a clump +! data structure. This assumes each pe has the same number of clumps +! set by clump_pproc +! +! !USES: + use clm_varctl, only : nsegspc +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: amask(:) + integer , intent(in) :: lni,lnj ! domain global size +! +! !LOCAL VARIABLES: + integer :: lns ! global domain size + integer :: ln,lj ! indices + integer :: ag,an,ai,aj ! indices + integer :: numg ! number of land gridcells + logical :: seglen1 ! is segment length one + real(r8):: seglen ! average segment length + real(r8):: rcid ! real value of cid + integer :: cid,pid ! indices + integer :: n,m,ng ! indices + integer :: ier ! error code + integer :: beg,end,lsize,gsize ! used for gsmap init + integer, pointer :: gindex(:) ! global index for gsmap init + integer, pointer :: clumpcnt(:) ! clump index counter + integer, parameter :: dbug=1 ! 0 = min, 1=normal, 2=much, 3=max + +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! 2002.09.11 Forrest Hoffman Creation. +! 2005.12.15 T Craig Updated for finemesh +! 2006.08.18 P Worley Performance optimizations +! 2007.01.24 T Craig Created decompInit_atm from decomp_init +! +!EOP +!------------------------------------------------------------------------------ + + lns = lni * lnj + + !--- set and verify nclumps --- + if (clump_pproc > 0) then + nclumps = clump_pproc * npes + if (nclumps < npes) then + write(iulog,*) 'decompInit_lnd(): Number of gridcell clumps= ',nclumps, & + ' is less than the number of processes = ', npes + call endrun() + end if + else + write(iulog,*)'clump_pproc= ',clump_pproc,' must be greater than 0' + call endrun() + end if + + !--- allocate and initialize procinfo and clumps --- + !--- beg and end indices initialized for simple addition of cells later --- + + allocate(procinfo%cid(clump_pproc), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error for procinfo%cid' + call endrun() + endif + procinfo%nclumps = clump_pproc + procinfo%cid(:) = -1 + procinfo%ncells = 0 + procinfo%nlunits = 0 + procinfo%ncols = 0 + procinfo%npfts = 0 + procinfo%begg = 1 + procinfo%begl = 1 + procinfo%begc = 1 + procinfo%begp = 1 + procinfo%endg = 0 + procinfo%endl = 0 + procinfo%endc = 0 + procinfo%endp = 0 + + allocate(clumps(nclumps), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error for clumps' + call endrun() + end if + clumps(:)%owner = -1 + clumps(:)%ncells = 0 + clumps(:)%nlunits = 0 + clumps(:)%ncols = 0 + clumps(:)%npfts = 0 + clumps(:)%begg = 1 + clumps(:)%begl = 1 + clumps(:)%begc = 1 + clumps(:)%begp = 1 + clumps(:)%endg = 0 + clumps(:)%endl = 0 + clumps(:)%endc = 0 + clumps(:)%endp = 0 + + !--- assign clumps to proc round robin --- + cid = 0 + do n = 1,nclumps + pid = mod(n-1,npes) + if (pid < 0 .or. pid > npes-1) then + write(iulog,*) 'decompInit_lnd(): round robin pid error ',n,pid,npes + call endrun() + endif + clumps(n)%owner = pid + if (iam == pid) then + cid = cid + 1 + if (cid < 1 .or. cid > clump_pproc) then + write(iulog,*) 'decompInit_lnd(): round robin pid error ',n,pid,npes + call endrun() + endif + procinfo%cid(cid) = n + endif + enddo + + !--- count total land gridcells + numg = 0 + do ln = 1,lns + if (amask(ln) == 1) then + numg = numg + 1 + endif + enddo + + if (npes > numg) then + write(iulog,*) 'decompInit_lnd(): Number of processes exceeds number ', & + 'of land grid cells',npes,numg + call endrun() + end if + if (nclumps > numg) then + write(iulog,*) 'decompInit_lnd(): Number of clumps exceeds number ', & + 'of land grid cells',nclumps,numg + call endrun() + end if + + if (float(numg)/float(nclumps) < float(nsegspc)) then + seglen1 = .true. + seglen = 1.0_r8 + else + seglen1 = .false. + seglen = dble(numg)/(dble(nsegspc)*dble(nclumps)) + endif + + if (masterproc) then + write(iulog,*) ' decomp precompute numg,nclumps,seglen1,avg_seglen,nsegspc=', & + numg,nclumps,seglen1,& + sngl(seglen),sngl(dble(numg)/(seglen*dble(nclumps))) + end if + + ! Assign gridcells to clumps (and thus pes) --- + + allocate(lcid(lns)) + lcid(:) = 0 + ng = 0 + do ln = 1,lns + if (amask(ln) == 1) then + ng = ng + 1 + + !--- give to clumps in order based on nsegspc + if (seglen1) then + cid = mod(ng-1,nclumps) + 1 + else + rcid = (dble(ng-1)/dble(numg))*dble(nsegspc)*dble(nclumps) + cid = mod(int(rcid),nclumps) + 1 + endif + lcid(ln) = cid + + !--- give gridcell cell to pe that owns cid --- + !--- this needs to be done to subsequently use function + !--- get_proc_bounds(begg,endg) + if (iam == clumps(cid)%owner) then + procinfo%ncells = procinfo%ncells + 1 + endif + if (iam > clumps(cid)%owner) then + procinfo%begg = procinfo%begg + 1 + endif + if (iam >= clumps(cid)%owner) then + procinfo%endg = procinfo%endg + 1 + endif + + !--- give gridcell to cid --- + !--- increment the beg and end indices --- + clumps(cid)%ncells = clumps(cid)%ncells + 1 + do m = 1,nclumps + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then + clumps(m)%begg = clumps(m)%begg + 1 + endif + + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then + clumps(m)%endg = clumps(m)%endg + 1 + endif + enddo + + end if + enddo + + ! Set ldecomp + + allocate(ldecomp%gdc2glo(numg), ldecomp%glo2gdc(lns), stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error1 for ldecomp, etc' + call endrun() + end if + allocate(clumpcnt(nclumps),stat=ier) + if (ier /= 0) then + write(iulog,*) 'decompInit_lnd(): allocation error1 for clumpcnt' + call endrun() + end if + + ldecomp%gdc2glo(:) = 0 + ldecomp%glo2gdc(:) = 0 + + ! clumpcnt is the start gdc index of each clump + + clumpcnt = 0 + ag = 1 + do pid = 0,npes-1 + do cid = 1,nclumps + if (clumps(cid)%owner == pid) then + clumpcnt(cid) = ag + ag = ag + clumps(cid)%ncells + endif + enddo + enddo + + ! now go through gridcells one at a time and increment clumpcnt + ! in order to set gdc2glo and glo2gdc + + do aj = 1,lnj + do ai = 1,lni + an = (aj-1)*lni + ai + cid = lcid(an) + if (cid > 0) then + ag = clumpcnt(cid) + ldecomp%gdc2glo(ag) = an + ldecomp%glo2gdc(an) = ag + clumpcnt(cid) = clumpcnt(cid) + 1 + end if + enddo + enddo + + deallocate(clumpcnt) + + ! Set gsMap_lnd_gdc2glo + + call get_proc_bounds(beg, end) + allocate(gindex(beg:end)) + do n = beg,end + gindex(n) = ldecomp%gdc2glo(n) + enddo + lsize = end-beg+1 + gsize = lni * lnj + call mct_gsMap_init(gsMap_lnd_gdc2glo, gindex, mpicom, comp_id, lsize, gsize) + deallocate(gindex) + + ! Diagnostic output + + if (masterproc) then + write(iulog,*)' Surface Grid Characteristics' + write(iulog,*)' longitude points = ',lni + write(iulog,*)' latitude points = ',lnj + write(iulog,*)' total number of land gridcells = ',numg + write(iulog,*)' Decomposition Characteristics' + write(iulog,*)' clumps per process = ',clump_pproc + write(iulog,*)' gsMap Characteristics' + write(iulog,*) ' lnd gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo) + write(iulog,*) + end if + + call shr_sys_flush(iulog) + + end subroutine decompInit_lnd + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: decompInit_glcp +! +! !INTERFACE: + subroutine decompInit_glcp(lns,lni,lnj,glcmask) +! +! !DESCRIPTION: +! This subroutine initializes the land surface decomposition into a clump +! data structure. This assumes each pe has the same number of clumps +! set by clump_pproc +! +! !USES: + use clmtype , only : grlnd, nameg, namel, namec, namep + use spmdMod + use spmdGathScatMod + use subgridMod, only : subgrid_get_gcellinfo +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , pointer, optional :: glcmask(:) ! glc mask +! +! !LOCAL VARIABLES: + integer :: ln,an ! indices + integer :: i,g,l,k ! indices + integer :: cid,pid ! indices + integer :: n,m,np ! indices + integer :: anumg ! lnd num gridcells + integer :: begg,endg ! beg,end gridcells + integer :: begl,endl ! beg,end landunits + integer :: begc,endc ! beg,end columns + integer :: begp,endp ! beg,end pfts + integer :: icells ! temporary + integer :: ilunits ! temporary + integer :: icols ! temporary + integer :: ipfts ! temporary + integer :: ier ! error code + integer :: npmin,npmax,npint ! do loop values for printing + integer :: clmin,clmax ! do loop values for printing + integer :: lsize,gsize ! used for gsmap init + integer :: ng ! number of gridcells in gsmap + integer :: beg,end,num ! temporaries + integer :: val1, val2 ! temporaries + integer, pointer :: gindex(:) ! global index for gsmap init + integer, pointer :: arrayg(:) + integer, pointer :: gstart(:),gcount(:) + integer, pointer :: lstart(:),lcount(:) + integer, pointer :: cstart(:),ccount(:) + integer, pointer :: pstart(:),pcount(:) + integer, pointer :: start(:),count(:) + integer, pointer :: tarr1(:),tarr2(:) + integer, allocatable :: allvecg(:,:) ! temporary vector "global" + integer, allocatable :: allvecl(:,:) ! temporary vector "local" + type(mct_gsmap),pointer :: gsmap + character(len=8) :: clmlevel + integer :: ntest + integer, parameter :: dbug=1 ! 0 = min, 1=normal, 2=much, 3=max + character(len=32), parameter :: subname = 'decompInit_glcp' + +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! 2002.09.11 Forrest Hoffman Creation. +! 2005.12.15 T Craig Updated for finemesh +! 2006.08.18 P Worley Performance optimizations +! +!EOP +!------------------------------------------------------------------------------ + + !--- assign gridcells to clumps (and thus pes) --- + call get_proc_bounds(begg, endg) + + allocate(gstart(begg:endg),lstart(begg:endg),cstart(begg:endg),pstart(begg:endg)) + allocate(gcount(begg:endg),lcount(begg:endg),ccount(begg:endg),pcount(begg:endg)) + allocate(allvecg(nclumps,4),allvecl(nclumps,4)) ! 3 = gcells,lunit,cols,pfts + + allvecg= 0 + allvecl= 0 + gcount = 0 + lcount = 0 + ccount = 0 + pcount = 0 + do anumg = begg,endg + an = ldecomp%gdc2glo(anumg) + cid = lcid(an) + ln = anumg + if (present(glcmask)) then + call subgrid_get_gcellinfo (ln, nlunits=ilunits, & + ncols=icols, npfts=ipfts, glcmask=glcmask(ln)) + else + call subgrid_get_gcellinfo (ln, nlunits=ilunits, & + ncols=icols, npfts=ipfts) + endif + allvecl(cid,1) = allvecl(cid,1) + 1 + allvecl(cid,2) = allvecl(cid,2) + ilunits + allvecl(cid,3) = allvecl(cid,3) + icols + allvecl(cid,4) = allvecl(cid,4) + ipfts + gcount(ln) = 1 + lcount(ln) = ilunits + ccount(ln) = icols + pcount(ln) = ipfts + enddo + call mpi_allreduce(allvecl,allvecg,size(allvecg),MPI_INTEGER,MPI_SUM,mpicom,ier) + + numg = 0 + numl = 0 + numc = 0 + nump = 0 + do cid = 1,nclumps + icells = allvecg(cid,1) + ilunits = allvecg(cid,2) + icols = allvecg(cid,3) + ipfts = allvecg(cid,4) + + !--- overall total --- + numg = numg + icells + numl = numl + ilunits + numc = numc + icols + nump = nump + ipfts + + !--- give gridcell to cid --- + !--- increment the beg and end indices --- + clumps(cid)%nlunits = clumps(cid)%nlunits + ilunits + clumps(cid)%ncols = clumps(cid)%ncols + icols + clumps(cid)%npfts = clumps(cid)%npfts + ipfts + + do m = 1,nclumps + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m > cid)) then + clumps(m)%begl = clumps(m)%begl + ilunits + clumps(m)%begc = clumps(m)%begc + icols + clumps(m)%begp = clumps(m)%begp + ipfts + endif + + if ((clumps(m)%owner > clumps(cid)%owner) .or. & + (clumps(m)%owner == clumps(cid)%owner .and. m >= cid)) then + clumps(m)%endl = clumps(m)%endl + ilunits + clumps(m)%endc = clumps(m)%endc + icols + clumps(m)%endp = clumps(m)%endp + ipfts + endif + enddo + + !--- give gridcell to the proc that owns the cid --- + !--- increment the beg and end indices --- + if (iam == clumps(cid)%owner) then + procinfo%nlunits = procinfo%nlunits + ilunits + procinfo%ncols = procinfo%ncols + icols + procinfo%npfts = procinfo%npfts + ipfts + endif + + if (iam > clumps(cid)%owner) then + procinfo%begl = procinfo%begl + ilunits + procinfo%begc = procinfo%begc + icols + procinfo%begp = procinfo%begp + ipfts + endif + + if (iam >= clumps(cid)%owner) then + procinfo%endl = procinfo%endl + ilunits + procinfo%endc = procinfo%endc + icols + procinfo%endp = procinfo%endp + ipfts + endif + enddo + + do n = 1,nclumps + if (clumps(n)%ncells /= allvecg(n,1) .or. & + clumps(n)%nlunits /= allvecg(n,2) .or. & + clumps(n)%ncols /= allvecg(n,3) .or. & + clumps(n)%npfts /= allvecg(n,4)) then + write(iulog,*) 'decompInit_glcp(): allvecg error ncells ',iam,n,clumps(n)%ncells ,allvecg(n,1) + write(iulog,*) 'decompInit_glcp(): allvecg error lunits ',iam,n,clumps(n)%nlunits,allvecg(n,2) + write(iulog,*) 'decompInit_glcp(): allvecg error ncols ',iam,n,clumps(n)%ncols ,allvecg(n,3) + write(iulog,*) 'decompInit_glcp(): allvecg error pfts ',iam,n,clumps(n)%npfts ,allvecg(n,4) + call endrun() + endif + enddo + + deallocate(allvecg,allvecl) + deallocate(lcid) + + ! set gsMaps, perms for lun, col, pft + + ! this was just "set" above in procinfo, be careful not to move it up + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ng = mct_gsmap_gsize(gsmap_lnd_gdc2glo) + allocate(arrayg(ng)) + + ! for each subgrid gsmap (l, c, p) + ! gather the gdc subgrid counts to masterproc in glo order + ! compute glo ordered start indices from the counts + ! scatter the subgrid start indices back out to the gdc gridcells + ! set the local gindex array for the subgrid from the subgrid start and count arrays + + do k = 1,4 + if (k == 1) then + clmlevel = nameg + beg = begg + end = endg + num = numg + gsmap => gsmap_gce_gdc2glo + start => gstart + count => gcount + elseif (k == 2) then + clmlevel = namel + beg = begl + end = endl + num = numl + gsmap => gsmap_lun_gdc2glo + start => lstart + count => lcount + elseif (k == 3) then + clmlevel = namec + beg = begc + end = endc + num = numc + gsmap => gsmap_col_gdc2glo + start => cstart + count => ccount + elseif (k == 4) then + clmlevel = namep + beg = begp + end = endp + num = nump + gsmap => gsmap_pft_gdc2glo + start => pstart + count => pcount + else + write(iulog,*) 'decompInit_glcp error in k ',k + call endrun() + endif + + arrayg = 0 + call gather_data_to_master(count,arrayg,grlnd) + if (masterproc) then + gsize = arrayg(1) + val1 = arrayg(1) + arrayg(1) = 1 + do n = 2,ng + gsize = gsize + arrayg(n) + val2 = arrayg(n) + arrayg(n) = arrayg(n-1) + val1 + val1 = val2 + enddo + endif + call scatter_data_from_master(start,arrayg,grlnd) + + allocate(gindex(beg:end)) + + i = beg-1 + do g = begg,endg + if (count(g) < 1) then + write(iulog,*) 'decompInit_glcp warning count g ',k,iam,g,count(g) + endif + do l = 1,count(g) + i = i + 1 + if (i < beg .or. i > end) then + write(iulog,*) 'decompInit_glcp error i ',i,beg,end + call endrun() + endif + gindex(i) = start(g) + l - 1 + enddo + enddo + if (i /= end) then + write(iulog,*) 'decompInit_glcp error size ',i,beg,end + call endrun() + endif + lsize = end-beg+1 + gsize = num + call mct_gsMap_init(gsMap, gindex, mpicom, comp_id, lsize, gsize) + + if (dbug > 1) then + !--- test gsmap --- + ntest = mct_gsMap_gsize(gsMap) + allocate(tarr1(ntest),tarr2(beg:end)) + call gather_data_to_master(gindex,tarr1,clmlevel) + call scatter_data_from_master(tarr2,tarr1,clmlevel) + !--- verify gather/scatter produces same result + do l = beg,end + if (tarr2(l) /= gindex(l)) then + write(iulog,*) 'decompInit_glcp error tarr2 ',k,l,gindex(l),tarr2(l) + call endrun() + endif + enddo + !--- verify gather of gindex on new gsmap produces ordered indices + if (masterproc) then + if (tarr1(1) /= 1) then + write(iulog,*) 'decompInit_glcp error tarr1 ',k,1,tarr1(1) + call endrun() + endif + do l = 2,ntest + if (tarr1(l)-tarr1(l-1) /= 1) then + write(iulog,*) 'decompInit_glcp error tarr1 ',k,l,tarr1(l-1),tarr1(l) + call endrun() + endif + enddo + endif + deallocate(tarr1,tarr2) + if (masterproc) then + write(iulog,*) 'decompInit_glcp gsmap [l,c,p] test passes for ',k + endif + !--- end test section + end if + deallocate(gindex) + + enddo + + deallocate(gstart,lstart,cstart,pstart) + deallocate(gcount,lcount,ccount,pcount) + + ! Diagnostic output + + if (masterproc) then + write(iulog,*)' Surface Grid Characteristics' + write(iulog,*)' longitude points = ',lni + write(iulog,*)' latitude points = ',lnj + write(iulog,*)' total number of gridcells = ',numg + write(iulog,*)' total number of landunits = ',numl + write(iulog,*)' total number of columns = ',numc + write(iulog,*)' total number of pfts = ',nump + write(iulog,*)' Decomposition Characteristics' + write(iulog,*)' clumps per process = ',clump_pproc + write(iulog,*)' gsMap Characteristics' + write(iulog,*) ' lnd gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo) + write(iulog,*) ' gce gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo) + write(iulog,*) ' lun gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo) + write(iulog,*) ' col gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_col_gdc2glo) + write(iulog,*) ' pft gsmap glo num of segs = ',mct_gsMap_ngseg(gsMap_pft_gdc2glo) + write(iulog,*) + end if + + ! Write out clump and proc info, one pe at a time, + ! barrier to control pes overwriting each other on stdout + + call shr_sys_flush(iulog) + call mpi_barrier(mpicom,ier) + npmin = 0 + npmax = npes-1 + npint = 1 + if (dbug == 0) then + npmax = 0 + elseif (dbug == 1) then + npmax = min(npes-1,4) + elseif (dbug == 2) then + npint = npes/8 + endif + do np = npmin,npmax,npint + pid = np + if (dbug == 1) then + if (np == 2) pid=npes/2-1 + if (np == 3) pid=npes-2 + if (np == 4) pid=npes-1 + endif + pid = max(pid,0) + pid = min(pid,npes-1) + + if (iam == pid) then + write(iulog,*) + write(iulog,*)'proc= ',pid,& + ' beg gridcell= ',procinfo%begg, & + ' end gridcell= ',procinfo%endg, & + ' total gridcells per proc= ',procinfo%ncells + write(iulog,*)'proc= ',pid,& + ' beg landunit= ',procinfo%begl, & + ' end landunit= ',procinfo%endl, & + ' total landunits per proc= ',procinfo%nlunits + write(iulog,*)'proc= ',pid,& + ' beg column = ',procinfo%begc, & + ' end column = ',procinfo%endc, & + ' total columns per proc = ',procinfo%ncols + write(iulog,*)'proc= ',pid,& + ' beg pft = ',procinfo%begp, & + ' end pft = ',procinfo%endp, & + ' total pfts per proc = ',procinfo%npfts + write(iulog,*)'proc= ',pid,& + ' lnd ngseg = ',mct_gsMap_ngseg(gsMap_lnd_gdc2glo), & + ' lnd nlseg = ',mct_gsMap_nlseg(gsMap_lnd_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' gce ngseg = ',mct_gsMap_ngseg(gsMap_gce_gdc2glo), & + ' gce nlseg = ',mct_gsMap_nlseg(gsMap_gce_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' lun ngseg = ',mct_gsMap_ngseg(gsMap_lun_gdc2glo), & + ' lun nlseg = ',mct_gsMap_nlseg(gsMap_lun_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' col ngseg = ',mct_gsMap_ngseg(gsMap_col_gdc2glo), & + ' col nlseg = ',mct_gsMap_nlseg(gsMap_col_gdc2glo,iam) + write(iulog,*)'proc= ',pid,& + ' pft ngseg = ',mct_gsMap_ngseg(gsMap_pft_gdc2glo), & + ' pft nlseg = ',mct_gsMap_nlseg(gsMap_pft_gdc2glo,iam) + write(iulog,*)'proc= ',pid,' nclumps = ',procinfo%nclumps + + clmin = 1 + clmax = procinfo%nclumps + if (dbug == 1) then + clmax = 1 + elseif (dbug == 0) then + clmax = -1 + endif + do n = clmin,clmax + cid = procinfo%cid(n) + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg gridcell= ',clumps(cid)%begg, & + ' end gridcell= ',clumps(cid)%endg, & + ' total gridcells per clump= ',clumps(cid)%ncells + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg landunit= ',clumps(cid)%begl, & + ' end landunit= ',clumps(cid)%endl, & + ' total landunits per clump = ',clumps(cid)%nlunits + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg column = ',clumps(cid)%begc, & + ' end column = ',clumps(cid)%endc, & + ' total columns per clump = ',clumps(cid)%ncols + write(iulog,*)'proc= ',pid,' clump no = ',n, & + ' clump id= ',procinfo%cid(n), & + ' beg pft = ',clumps(cid)%begp, & + ' end pft = ',clumps(cid)%endp, & + ' total pfts per clump = ',clumps(cid)%npfts + end do + end if + call shr_sys_flush(iulog) + call mpi_barrier(mpicom,ier) + end do + call shr_sys_flush(iulog) + + end subroutine decompInit_glcp + +!------------------------------------------------------------------------------ + +end module decompInitMod diff --git a/components/clm/src_clm40/main/decompMod.F90 b/components/clm/src_clm40/main/decompMod.F90 new file mode 100644 index 0000000000..74f35c3de9 --- /dev/null +++ b/components/clm/src_clm40/main/decompMod.F90 @@ -0,0 +1,359 @@ +module decompMod + + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! Module provides a descomposition into a clumped data structure which can + ! be mapped back to atmosphere physics chunks. + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use spmdMod , only : masterproc, iam, npes, mpicom, comp_id + use clm_varctl , only : iulog + use mct_mod + ! + ! !PUBLIC TYPES: + implicit none + integer, public :: clump_pproc ! number of clumps per MPI process + ! + ! !PUBLIC MEMBER FUNCTIONS: + + public get_proc_clumps ! number of clumps for this processor + public get_proc_total ! total no. of gridcells, landunits, columns and pfts for any processor + public get_proc_global ! total gridcells, landunits, columns, pfts across all processors + public get_clmlevel_gsize ! get global size associated with clmlevel + public get_clmlevel_gsmap ! get gsmap associated with clmlevel + + interface get_clump_bounds + module procedure get_clump_bounds_old + module procedure get_clump_bounds_new + end interface + public get_clump_bounds ! clump beg and end gridcell,landunit,column,pft + + interface get_proc_bounds + module procedure get_proc_bounds_old + module procedure get_proc_bounds_new + end interface + public get_proc_bounds ! this processor beg and end gridcell,landunit,column,pft + + ! + ! !PRIVATE TYPES: + private ! (now mostly public for decompinitmod) + + integer,public :: nclumps ! total number of clumps across all processors + integer,public :: numg ! total number of gridcells on all procs + integer,public :: numl ! total number of landunits on all procs + integer,public :: numc ! total number of columns on all procs + integer,public :: nump ! total number of pfts on all procs + + type bounds_type + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending pft index + end type bounds_type + public bounds_type + + !---global information on each pe + type processor_type + integer :: nclumps ! number of clumps for processor_type iam + integer,pointer :: cid(:) ! clump indices + integer :: ncells ! number of gridcells in proc + integer :: nlunits ! number of landunits in proc + integer :: ncols ! number of columns in proc + integer :: npfts ! number of pfts in proc + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending pft index + end type processor_type + public processor_type + type(processor_type),public :: procinfo + + !---global information on each pe + type clump_type + integer :: owner ! process id owning clump + integer :: ncells ! number of gridcells in clump + integer :: nlunits ! number of landunits in clump + integer :: ncols ! number of columns in clump + integer :: npfts ! number of pfts in clump + integer :: begg, endg ! beginning and ending gridcell index + integer :: begl, endl ! beginning and ending landunit index + integer :: begc, endc ! beginning and ending column index + integer :: begp, endp ! beginning and ending pft index + end type clump_type + public clump_type + type(clump_type),public, allocatable :: clumps(:) + + !---global information on each pe + !--- i,j = 2d global + !--- glo = 1d global sn ordered + !--- gsn = 1d global sn ordered compressed + !--- gdc = 1d global dc ordered compressed + type decomp_type + integer,pointer :: glo2gdc(:) ! 1d glo to 1d gdc + integer,pointer :: gdc2glo(:) ! 1d gdc to 1d glo + end type decomp_type + public decomp_type + type(decomp_type),public,target :: ldecomp + + type(mct_gsMap) ,public,target :: gsMap_lnd_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_gce_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_lun_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_col_gdc2glo + type(mct_gsMap) ,public,target :: gsMap_pft_gdc2glo + !------------------------------------------------------------------------------ + +contains + + !------------------------------------------------------------------------------ + subroutine get_clump_bounds_new (n, bounds) + ! + ! !DESCRIPTION: + ! Determine clump bounds + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: n ! processor clump index + type(bounds_type), intent(out) :: bounds ! clump bounds + ! + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname = 'get_clump_bounds' ! Subroutine name + integer :: cid ! clump id +#ifdef _OPENMP + integer, external :: OMP_GET_MAX_THREADS + integer, external :: OMP_GET_NUM_THREADS +#endif + !------------------------------------------------------------------------------ + ! Make sure this IS being called from a threaded region +#ifdef _OPENMP + if ( OMP_GET_NUM_THREADS() == 1 .and. OMP_GET_MAX_THREADS() > 1 )then + call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a non-threaded region)') + end if +#endif + + cid = procinfo%cid(n) + bounds%begp = clumps(cid)%begp + bounds%endp = clumps(cid)%endp + bounds%begc = clumps(cid)%begc + bounds%endc = clumps(cid)%endc + bounds%begl = clumps(cid)%begl + bounds%endl = clumps(cid)%endl + bounds%begg = clumps(cid)%begg + bounds%endg = clumps(cid)%endg + end subroutine get_clump_bounds_new + + !------------------------------------------------------------------------------ + subroutine get_clump_bounds_old (n, begg, endg, begl, endl, begc, endc, begp, endp) + implicit none + integer, intent(in) :: n ! proc clump index + integer, intent(out) :: begp, endp ! clump beg and end pft indices + integer, intent(out) :: begc, endc ! clump beg and end column indices + integer, intent(out) :: begl, endl ! clump beg and end landunit indices + integer, intent(out) :: begg, endg ! clump beg and end gridcell indices + integer :: cid ! clump id + !------------------------------------------------------------------------------ + + cid = procinfo%cid(n) + begp = clumps(cid)%begp + endp = clumps(cid)%endp + begc = clumps(cid)%begc + endc = clumps(cid)%endc + begl = clumps(cid)%begl + endl = clumps(cid)%endl + begg = clumps(cid)%begg + endg = clumps(cid)%endg + end subroutine get_clump_bounds_old + + !------------------------------------------------------------------------------ + subroutine get_proc_bounds_new (bounds) + ! + ! !DESCRIPTION: + ! Retrieve processor bounds + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(out) :: bounds ! processor bounds bounds + ! + ! !LOCAL VARIABLES: +#ifdef _OPENMP + integer, external :: OMP_GET_NUM_THREADS +#endif + character(len=32), parameter :: subname = 'get_proc_bounds' ! Subroutine name + !------------------------------------------------------------------------------ + ! Make sure this is NOT being called from a threaded region +#ifdef _OPENMP + if ( OMP_GET_NUM_THREADS() > 1 )then + call shr_sys_abort( trim(subname)//' ERROR: Calling from inside a threaded region') + end if +#endif + + bounds%begp = procinfo%begp + bounds%endp = procinfo%endp + bounds%begc = procinfo%begc + bounds%endc = procinfo%endc + bounds%begl = procinfo%begl + bounds%endl = procinfo%endl + bounds%begg = procinfo%begg + bounds%endg = procinfo%endg + + end subroutine get_proc_bounds_new + + !------------------------------------------------------------------------------ + subroutine get_proc_bounds_old (begg, endg, begl, endl, begc, endc, begp, endp, & + begCohort, endCohort) + implicit none + integer, optional, intent(out) :: begp, endp ! proc beg and end pft indices + integer, optional, intent(out) :: begc, endc ! proc beg and end column indices + integer, optional, intent(out) :: begl, endl ! proc beg and end landunit indices + integer, optional, intent(out) :: begg, endg ! proc beg and end gridcell indices + ! these are dummy arguments for backwards compatibility with 4_5 in + ! util_share/accumulMod.F90. 4_0 will never have a cohort dimension + integer, optional, intent(out) :: begCohort, endCohort ! cohort beg and end gridcell indices + !------------------------------------------------------------------------------ + + if (present(begp)) begp = procinfo%begp + if (present(endp)) endp = procinfo%endp + if (present(begc)) begc = procinfo%begc + if (present(endc)) endc = procinfo%endc + if (present(begl)) begl = procinfo%begl + if (present(endl)) endl = procinfo%endl + if (present(begg)) begg = procinfo%begg + if (present(endg)) endg = procinfo%endg + end subroutine get_proc_bounds_old + + !------------------------------------------------------------------------------ + subroutine get_proc_total(pid, ncells, nlunits, ncols, npfts) + ! + ! !DESCRIPTION: + ! Count up gridcells, landunits, columns, and pfts on process. + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: pid ! proc id + integer, intent(out) :: ncells ! total number of gridcells on the processor + integer, intent(out) :: nlunits ! total number of landunits on the processor + integer, intent(out) :: ncols ! total number of columns on the processor + integer, intent(out) :: npfts ! total number of pfts on the processor + ! + ! !LOCAL VARIABLES: + integer :: cid ! clump index + !------------------------------------------------------------------------------ + + npfts = 0 + nlunits = 0 + ncols = 0 + ncells = 0 + do cid = 1,nclumps + if (clumps(cid)%owner == pid) then + ncells = ncells + clumps(cid)%ncells + nlunits = nlunits + clumps(cid)%nlunits + ncols = ncols + clumps(cid)%ncols + npfts = npfts + clumps(cid)%npfts + end if + end do + end subroutine get_proc_total + + !------------------------------------------------------------------------------ + subroutine get_proc_global(ng, nl, nc, np, nCohorts) + ! + ! !DESCRIPTION: + ! Return number of gridcells, landunits, columns, and pfts across all processes. + ! + ! !ARGUMENTS: + implicit none + integer, intent(out) :: ng ! total number of gridcells across all processors + integer, intent(out) :: nl ! total number of landunits across all processors + integer, intent(out) :: nc ! total number of columns across all processors + integer, intent(out) :: np ! total number of pfts across all processors + ! this is a dummy argument for backwards compatibility with 4_5 in + ! util_share/accumulMod.F90. 4_0 will never have a cohort dimension + integer, optional, intent(out) :: nCohorts ! total number ED cohorts + !------------------------------------------------------------------------------ + + np = nump + nc = numc + nl = numl + ng = numg + end subroutine get_proc_global + + !------------------------------------------------------------------------------ + integer function get_proc_clumps() + ! + ! !DESCRIPTION: + ! Return the number of clumps. + ! + ! !ARGUMENTS: + implicit none + !------------------------------------------------------------------------------ + + get_proc_clumps = procinfo%nclumps + + end function get_proc_clumps + + !----------------------------------------------------------------------- + integer function get_clmlevel_gsize (clmlevel) + ! + ! !DESCRIPTION: + ! Determine 1d size from clmlevel + ! + ! !USES: + use clmtype , only : grlnd, nameg, namel, namec, namep + use domainMod, only : ldomain + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: clmlevel !type of clm 1d array + !----------------------------------------------------------------------- + + select case (clmlevel) + case(grlnd) + get_clmlevel_gsize = ldomain%ns + case(nameg) + get_clmlevel_gsize = numg + case(namel) + get_clmlevel_gsize = numl + case(namec) + get_clmlevel_gsize = numc + case(namep) + get_clmlevel_gsize = nump + case default + write(iulog,*) 'get_clmlevel_gsize does not match clmlevel type: ', trim(clmlevel) + call shr_sys_abort() + end select + + end function get_clmlevel_gsize + + !----------------------------------------------------------------------- + subroutine get_clmlevel_gsmap (clmlevel, gsmap) + ! + ! !DESCRIPTION: + ! Compute arguments for gatherv, scatterv for vectors + ! + ! !USES: + use clmtype, only : grlnd, nameg, namel, namec, namep + ! + ! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: clmlevel ! type of input data + type(mct_gsmap) , pointer :: gsmap + !---------------------------------------------------------------------- + + select case (clmlevel) + case(grlnd) + gsmap => gsmap_lnd_gdc2glo + case(nameg) + gsmap => gsmap_gce_gdc2glo + case(namel) + gsmap => gsmap_lun_gdc2glo + case(namec) + gsmap => gsmap_col_gdc2glo + case(namep) + gsmap => gsmap_pft_gdc2glo + case default + write(iulog,*) 'get_clmlevel_gsmap: Invalid expansion character: ',trim(clmlevel) + call shr_sys_abort() + end select + end subroutine get_clmlevel_gsmap + +end module decompMod diff --git a/components/clm/src_clm40/main/domainMod.F90 b/components/clm/src_clm40/main/domainMod.F90 new file mode 100644 index 0000000000..310131ee31 --- /dev/null +++ b/components/clm/src_clm40/main/domainMod.F90 @@ -0,0 +1,241 @@ +module domainMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: domainMod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use spmdMod , only : masterproc + use clm_varctl , only : iulog +! +! !PUBLIC TYPES: + implicit none + private +! + public :: domain_type + + !--- this typically contains local domain info with arrays dim begg:endg --- + type domain_type + integer :: ns ! global size of domain + integer :: ni,nj ! global axis if 2d (nj=1 if unstructured) + logical :: isgrid2d ! true => global grid is lat/lon + integer :: nbeg,nend ! local beg/end indices + character(len=8) :: clmlevel ! grid type + integer ,pointer :: mask(:) ! land mask: 1 = land, 0 = ocean + real(r8),pointer :: frac(:) ! fractional land + real(r8),pointer :: topo(:) ! topography + real(r8),pointer :: latc(:) ! latitude of grid cell (deg) + real(r8),pointer :: lonc(:) ! longitude of grid cell (deg) + real(r8),pointer :: area(:) ! grid cell area (km**2) + integer ,pointer :: pftm(:) ! pft mask: 1=real, 0=fake, -1=notset + integer ,pointer :: glcmask(:) ! glc mask: 1=sfc mass balance required by GLC component + ! 0=SMB not required (default) + ! (glcmask is just a guess at the appropriate mask, known at initialization - in contrast to icemask, which is the true mask obtained from glc) + character*16 :: set ! flag to check if domain is set + logical :: decomped ! decomposed locally or global copy + end type domain_type + + type(domain_type) , public :: ldomain + real(r8), allocatable, public :: lon1d(:), lat1d(:) ! 1d lat/lons for 2d grids +! +! !PUBLIC MEMBER FUNCTIONS: + public domain_init ! allocates/nans domain types + public domain_clean ! deallocates domain types + public domain_check ! write out domain info +! +! !REVISION HISTORY: +! Originally clm_varsur by Mariana Vertenstein +! Migrated from clm_varsur to domainMod by T Craig +! + character*16,parameter :: set = 'domain_set ' + character*16,parameter :: unset = 'NOdomain_unsetNO' +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_init +! +! !INTERFACE: + subroutine domain_init(domain,isgrid2d,ni,nj,nbeg,nend,clmlevel) + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) +! +! !DESCRIPTION: +! This subroutine allocates and nans the domain type +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype + logical, intent(in) :: isgrid2d ! true => global grid is lat/lon + integer, intent(in) :: ni,nj ! grid size, 2d + integer , intent(in), optional :: nbeg,nend ! beg/end indices + character(len=*), intent(in), optional :: clmlevel ! grid type +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier + integer nb,ne +! +!------------------------------------------------------------------------------ + + nb = 1 + ne = ni*nj + if (present(nbeg)) then + if (present(nend)) then + nb = nbeg + ne = nend + endif + endif + + if (domain%set == set) then + call domain_clean(domain) + endif + allocate(domain%mask(nb:ne),domain%frac(nb:ne),domain%latc(nb:ne), & + domain%pftm(nb:ne),domain%area(nb:ne),domain%lonc(nb:ne), & + domain%topo(nb:ne),domain%glcmask(nb:ne),stat=ier) + if (ier /= 0) then + call shr_sys_abort('domain_init ERROR: allocate mask, frac, lat, lon, area ') + endif + + if (present(clmlevel)) then + domain%clmlevel = clmlevel + endif + + domain%isgrid2d = isgrid2d + domain%ns = ni*nj + domain%ni = ni + domain%nj = nj + domain%nbeg = nb + domain%nend = ne + domain%mask = -9999 + domain%frac = -1.0e36 + domain%topo = 0._r8 + domain%latc = nan + domain%lonc = nan + domain%area = nan + + domain%set = set + if (domain%nbeg == 1 .and. domain%nend == domain%ns) then + domain%decomped = .false. + else + domain%decomped = .true. + endif + + domain%pftm = -9999 + domain%glcmask = 0 + +end subroutine domain_init +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_clean +! +! !INTERFACE: + subroutine domain_clean(domain) +! +! !DESCRIPTION: +! This subroutine deallocates the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier +! +!------------------------------------------------------------------------------ + if (domain%set == set) then + if (masterproc) then + write(iulog,*) 'domain_clean: cleaning ',domain%ni,domain%nj + endif + deallocate(domain%mask,domain%frac,domain%latc, & + domain%lonc,domain%area,domain%pftm, & + domain%topo,domain%glcmask,stat=ier) + if (ier /= 0) then + call shr_sys_abort('domain_clean ERROR: deallocate mask, frac, lat, lon, area ') + endif + else + if (masterproc) then + write(iulog,*) 'domain_clean WARN: clean domain unecessary ' + endif + endif + + domain%clmlevel = unset + domain%ns = huge(1) + domain%ni = huge(1) + domain%nj = huge(1) + domain%nbeg = huge(1) + domain%nend = huge(1) + domain%set = unset + domain%decomped = .true. + +end subroutine domain_clean +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_check +! +! !INTERFACE: + subroutine domain_check(domain) +! +! !DESCRIPTION: +! This subroutine write domain info +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(in) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + if (masterproc) then + write(iulog,*) ' domain_check set = ',trim(domain%set) + write(iulog,*) ' domain_check decomped = ',domain%decomped + write(iulog,*) ' domain_check ns = ',domain%ns + write(iulog,*) ' domain_check ni,nj = ',domain%ni,domain%nj + write(iulog,*) ' domain_check clmlevel = ',trim(domain%clmlevel) + write(iulog,*) ' domain_check nbeg,nend = ',domain%nbeg,domain%nend + write(iulog,*) ' domain_check lonc = ',minval(domain%lonc),maxval(domain%lonc) + write(iulog,*) ' domain_check latc = ',minval(domain%latc),maxval(domain%latc) + write(iulog,*) ' domain_check mask = ',minval(domain%mask),maxval(domain%mask) + write(iulog,*) ' domain_check frac = ',minval(domain%frac),maxval(domain%frac) + write(iulog,*) ' domain_check topo = ',minval(domain%topo),maxval(domain%topo) + write(iulog,*) ' domain_check area = ',minval(domain%area),maxval(domain%area) + write(iulog,*) ' domain_check pftm = ',minval(domain%pftm),maxval(domain%pftm) + write(iulog,*) ' domain_check glcmask = ',minval(domain%glcmask),maxval(domain%glcmask) + write(iulog,*) ' ' + endif + +end subroutine domain_check + +!------------------------------------------------------------------------------ + +end module domainMod diff --git a/components/clm/src_clm40/main/dtypes.h b/components/clm/src_clm40/main/dtypes.h new file mode 100644 index 0000000000..977e95ad75 --- /dev/null +++ b/components/clm/src_clm40/main/dtypes.h @@ -0,0 +1,6 @@ +#define TYPEDOUBLE 102 +#define TYPEINT 103 +#define TYPETEXT 100 +#define TYPELONG 104 +#define TYPEREAL 101 +#define TYPELOGICAL 105 diff --git a/components/clm/src_clm40/main/dynlandMod.F90 b/components/clm/src_clm40/main/dynlandMod.F90 new file mode 100644 index 0000000000..b4fe770c19 --- /dev/null +++ b/components/clm/src_clm40/main/dynlandMod.F90 @@ -0,0 +1,255 @@ +module dynlandMod + +!--------------------------------------------------------------------------- +!BOP +! +! !MODULE: dynlandMod +! +! !USES: + use spmdMod + use clmtype + use decompMod , only : get_proc_bounds + use clm_varctl , only : iulog + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun +! +! !DESCRIPTION: +! Compute heat and water content to track conservation wrt dynamic land use +! +! !PUBLIC TYPES: + implicit none + private + save + public :: dynland_hwcontent +! +! !REVISION HISTORY: +! 2009-feb-20 B. Kauffman, created by +! +!EOP +! +! ! PRIVATE TYPES + +!=============================================================================== + +contains + +!=============================================================================== +!BOP +! +! !ROUTINE: dynland_hwcontent +! +! !INTERFACE: + + subroutine dynland_hwcontent(begg,endg,gcell_liq,gcell_ice,gcell_heat) + +! !DESCRIPTION: +! Compute grid-level heat and water content +! +! !REVISION HISTORY: +! 2009-feb-20 B. Kauffman, created by +! +! !USES: + + use clm_varcon, only : istsoil,istice,istwet,istdlak,istslak,isturb,istice_mec + use clm_varcon, only : istcrop + use clm_varcon, only : icol_road_perv,icol_road_imperv,icol_roof + use clm_varcon, only : icol_sunwall,icol_shadewall + use clm_varcon, only : cpice, cpliq + use clm_varpar, only : nlevsno, nlevgrnd + + implicit none + +! !ARGUMENTS: + + integer , intent(in) :: begg, endg ! proc beg & end gridcell indices + real(r8), intent(out) :: gcell_liq(begg:endg) + real(r8), intent(out) :: gcell_ice (begg:endg) + real(r8), intent(out) :: gcell_heat (begg:endg) + +! !LOCAL VARIABLES: +!EOP + + integer :: li,lf ! loop initial/final indicies + integer :: ci,cf ! loop initial/final indicies + integer :: pi,pf ! loop initial/final indicies + + integer :: g,l,c,p,k ! loop indicies (grid,lunit,column,pft,vertical level) + + real(r8) :: wtgcell ! weight relative to grid cell + real(r8) :: wtcol ! weight relative to column + real(r8) :: liq ! sum of liquid water at column level + real(r8) :: ice ! sum of frozen water at column level + real(r8) :: heat ! sum of heat content at column level + real(r8) :: cv ! heat capacity [J/(m^2 K)] + + integer ,pointer :: ltype(:) ! landunit type index + integer ,pointer :: ctype(:) ! column type index + integer ,pointer :: ptype(:) ! pft type index + + integer, pointer :: nlev_improad(:) ! number of impervious road layers + real(r8), pointer :: cv_wall(:,:) ! thermal conductivity of urban wall + real(r8), pointer :: cv_roof(:,:) ! thermal conductivity of urban roof + real(r8), pointer :: cv_improad(:,:) ! thermal conductivity of urban impervious road + + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: h2osoi_ice(:,:) ! frozen water (kg/m2) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) + real(r8), pointer :: csol(:,:) ! heat capacity, soil solids (J/m**3/Kelvin) + real(r8), pointer :: dz(:,:) ! layer depth (m) + real(r8), pointer :: wa(:,:) ! h2o in underground aquifer + + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + +!------------------------------------------------------------------------------- +! Note: this routine does not compute heat or water content of lakes. +! +!------------------------------------------------------------------------------- + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ltype => lun%itype + ctype => col%itype + ptype => pft%itype + + nlev_improad => lps%nlev_improad + cv_wall => lps%cv_wall + cv_roof => lps%cv_roof + cv_improad => lps%cv_improad + + snl => cps%snl + watsat => cps%watsat + csol => cps%csol + dz => cps%dz + t_soisno => ces%t_soisno + h2osoi_liq => cws%h2osoi_liq + h2osoi_ice => cws%h2osoi_ice + h2osno => cws%h2osno + + ! Get relevant sizes + + do g = begg,endg ! loop over grid cells + + gcell_liq (g) = 0.0_r8 ! sum for one grid cell + gcell_ice (g) = 0.0_r8 ! sum for one grid cell + gcell_heat (g) = 0.0_r8 ! sum for one grid cell + + li = gptr%luni(g) + lf = gptr%lunf(g) + do l = li,lf ! loop over land units + + ci = lptr%coli(l) + cf = lptr%colf(l) + do c = ci,cf ! loop over columns + + liq = 0.0_r8 ! sum for one column + ice = 0.0_r8 + heat = 0.0_r8 + + !--- water & ice, above ground only --- + if ( (ltype(l) == istsoil .or. ltype(l) == istcrop ) & + .or. (ltype(l) == istwet ) & + .or. (ltype(l) == istice ) & + .or. (ltype(l) == istice_mec ) & + .or. (ltype(l) == isturb .and. ctype(c) == icol_roof ) & + .or. (ltype(l) == isturb .and. ctype(c) == icol_road_imperv) & + .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv )) then + + if ( snl(c) < 0 ) then + do k = snl(c)+1,0 ! loop over snow layers + liq = liq + cws%h2osoi_liq(c,k) + ice = ice + cws%h2osoi_ice(c,k) + end do + else ! no snow layers exist + ice = ice + cws%h2osno(c) + end if + end if + + !--- water & ice, below ground only --- + if ( (ltype(l) == istsoil .or. ltype(l) == istcrop ) & + .or. (ltype(l) == istwet ) & + .or. (ltype(l) == istice ) & + .or. (ltype(l) == istice_mec ) & + .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv )) then + do k = 1,nlevgrnd + liq = liq + cws%h2osoi_liq(c,k) + ice = ice + cws%h2osoi_ice(c,k) + end do + end if + + !--- water in aquifer --- + if ( (ltype(l) == istsoil .or. ltype(l) == istcrop ) & + .or. (ltype(l) == istwet ) & + .or. (ltype(l) == istice ) & + .or. (ltype(l) == istice_mec ) & + .or. (ltype(l) == isturb .and. ctype(c) == icol_road_perv )) then + liq = liq + cws%wa(c) + end if + + !--- water in canopy (at pft level) --- + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then ! note: soil specified at LU level + pi = cptr%pfti(c) + pf = cptr%pftf(c) + do p = pi,pf ! loop over pfts + wtcol = pptr%wtcol(p) + liq = liq + pws%h2ocan(p) * wtcol + end do + end if + + if ( (ltype(l) /= istslak) .and. ltype(l) /= istdlak) then + + !--- heat content, below ground only --- + do k = 1,nlevgrnd + if (ctype(c)==icol_sunwall .OR. ctype(c)==icol_shadewall) then + cv = cv_wall(l,k) * dz(c,k) + else if (ctype(c) == icol_roof) then + cv = cv_roof(l,k) * dz(c,k) + else if (ctype(c) == icol_road_imperv .and. k >= 1 .and. k <= nlev_improad(l)) then + cv = cv_improad(l,k) * dz(c,k) + else if (ltype(l) /= istwet .AND. ltype(l) /= istice .AND. ltype(l) /= istice_mec) then + cv = csol(c,k)*(1-watsat(c,k))*dz(c,k) + (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq) + else + cv = (h2osoi_ice(c,k)*cpice + h2osoi_liq(c,k)*cpliq) + endif + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end do + + !--- heat content, above ground only --- + if ( snl(c) < 0 ) then + do k = snl(c)+1,0 ! loop over snow layers + cv = cpliq*h2osoi_liq(c,k) + cpice*h2osoi_ice(c,k) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end do + else if ( h2osno(c) > 0.0_r8) then + k = 1 + cv = cpice*h2osno(c) + heat = heat + cv*t_soisno(c,k) / 1.e6_r8 + end if + + end if + + !--- scale x/m^2 column-level values into x/m^2 gridcell-level values --- + wtgcell = cptr%wtgcell(c) + gcell_liq (g) = gcell_liq (g) + liq * wtgcell + gcell_ice (g) = gcell_ice (g) + ice * wtgcell + gcell_heat (g) = gcell_heat (g) + heat * wtgcell + + end do ! column loop + end do ! landunit loop + end do ! grid cell loop + + end subroutine dynland_hwcontent + +!=============================================================================== + +end module dynlandMod diff --git a/components/clm/src_clm40/main/fileutils.F90 b/components/clm/src_clm40/main/fileutils.F90 new file mode 100644 index 0000000000..b74af42426 --- /dev/null +++ b/components/clm/src_clm40/main/fileutils.F90 @@ -0,0 +1,179 @@ +module fileutils + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module containing file I/O utilities + ! + ! !USES: + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use spmdMod , only : masterproc + ! + ! !PUBLIC TYPES: + implicit none + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: get_filename !Returns filename given full pathname + public :: opnfil !Open local unformatted or formatted file + public :: getfil !Obtain local copy of file + public :: relavu !Close and release Fortran unit no longer in use + public :: getavu !Get next available Fortran unit number + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + character(len=256) function get_filename (fulpath) + ! + ! !DESCRIPTION: + ! Returns filename given full pathname + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !full pathname + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + !------------------------------------------------------------------------ + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i) == '/') go to 10 + end do + i = 0 +10 get_filename = fulpath(i+1:klen) + + return + end function get_filename + + !------------------------------------------------------------------------ + subroutine getfil (fulpath, locfn, iflag) + ! + ! !DESCRIPTION: + ! Obtain local copy of file + ! First check current working directory + ! Next check full pathname[fulpath] on disk + ! + ! !USES: + use shr_file_mod, only: shr_file_get + ! + ! !ARGUMENTS: + character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname + character(len=*), intent(out) :: locfn !output local file name + integer, intent(in) :: iflag !0=>abort if file not found 1=>do not abort + ! + ! !LOCAL VARIABLES: + integer i !loop index + integer klen !length of fulpath character string + logical lexist !true if local file exists + !------------------------------------------------------------------------ + + ! get local file name from full name + + locfn = get_filename( fulpath ) + if (len_trim(locfn) == 0) then + if (masterproc) write(iulog,*)'(GETFIL): local filename has zero length' + call shr_sys_abort + else + if (masterproc) write(iulog,*)'(GETFIL): attempting to find local file ', & + trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), & + ' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + locfn = fulpath + + inquire (file=fulpath,exist=lexist) + if (lexist) then + if (masterproc) write(iulog,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + if (masterproc) write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath + if (iflag==0) then + call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) + else + RETURN + endif + endif + + end subroutine getfil + + !------------------------------------------------------------------------ + subroutine opnfil (locfn, iun, form) + ! + ! !DESCRIPTION: + ! Open file locfn in unformatted or formatted form on unit iun + ! + ! !ARGUMENTS: + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, f = formatted + ! + ! !LOCAL VARIABLES: + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted + !------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(iulog,*)'(OPNFIL): local filename has zero length' + call shr_sys_abort + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + call shr_sys_abort + else if ( masterproc )then + write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), & + & ' on unit= ',iun + end if + + end subroutine opnfil + + !------------------------------------------------------------------------ + integer function getavu() + ! + ! !DESCRIPTION: + ! Get next available Fortran unit number. + ! + ! !USES: + use shr_file_mod, only : shr_file_getUnit + !------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + + !------------------------------------------------------------------------ + subroutine relavu (iunit) + ! + ! !DESCRIPTION: + ! Close and release Fortran unit no longer in use! + ! + ! !USES: + use shr_file_mod, only : shr_file_freeUnit + ! + ! !ARGUMENTS: + integer, intent(in) :: iunit !Fortran unit number + !------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/components/clm/src_clm40/main/filterMod.F90 b/components/clm/src_clm40/main/filterMod.F90 new file mode 100644 index 0000000000..e3151548a9 --- /dev/null +++ b/components/clm/src_clm40/main/filterMod.F90 @@ -0,0 +1,390 @@ +module filterMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: filterMod +! +! !DESCRIPTION: +! Module of filters used for processing columns and pfts of particular +! types, including lake, non-lake, urban, soil, snow, non-snow, and +! naturally-vegetated patches. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : iulog, use_cndv +! +! !PUBLIC TYPES: + implicit none + save + + private + + type clumpfilter + integer, pointer :: natvegp(:) ! CNDV nat-vegetated (present) filter (pfts) + integer :: num_natvegp ! number of pfts in nat-vegetated filter + + integer, pointer :: pcropp(:) ! prognostic crop filter (pfts) + integer :: num_pcropp ! number of pfts in prognostic crop filter + integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (pfts) + integer :: num_soilnopcropp ! number of pfts in soil w/o prog crops + + integer, pointer :: lakep(:) ! lake filter (pfts) + integer :: num_lakep ! number of pfts in lake filter + integer, pointer :: nolakep(:) ! non-lake filter (pfts) + integer :: num_nolakep ! number of pfts in non-lake filter + integer, pointer :: lakec(:) ! lake filter (columns) + integer :: num_lakec ! number of columns in lake filter + integer, pointer :: nolakec(:) ! non-lake filter (columns) + integer :: num_nolakec ! number of columns in non-lake filter + + integer, pointer :: soilc(:) ! soil filter (columns) + integer :: num_soilc ! number of columns in soil filter + integer, pointer :: soilp(:) ! soil filter (pfts) + integer :: num_soilp ! number of pfts in soil filter + + integer, pointer :: snowc(:) ! snow filter (columns) + integer :: num_snowc ! number of columns in snow filter + integer, pointer :: nosnowc(:) ! non-snow filter (columns) + integer :: num_nosnowc ! number of columns in non-snow filter + + integer, pointer :: hydrologyc(:) ! hydrology filter (columns) + integer :: num_hydrologyc ! number of columns in hydrology filter + + integer, pointer :: urbanl(:) ! urban filter (landunits) + integer :: num_urbanl ! number of landunits in urban filter + integer, pointer :: nourbanl(:) ! non-urban filter (landunits) + integer :: num_nourbanl ! number of landunits in non-urban filter + + integer, pointer :: urbanc(:) ! urban filter (columns) + integer :: num_urbanc ! number of columns in urban filter + integer, pointer :: nourbanc(:) ! non-urban filter (columns) + integer :: num_nourbanc ! number of columns in non-urban filter + + integer, pointer :: urbanp(:) ! urban filter (pfts) + integer :: num_urbanp ! number of pfts in urban filter + integer, pointer :: nourbanp(:) ! non-urban filter (pfts) + integer :: num_nourbanp ! number of pfts in non-urban filter + + integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (pfts) + integer :: num_nolakeurbanp ! number of pfts in non-lake, non-urban filter + + end type clumpfilter + public clumpfilter + + type(clumpfilter), allocatable, public :: filter(:) +! + public allocFilters ! allocate memory for filters + public setFilters ! set filters +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 11/13/03, Peter Thornton: Added soilp and num_soilp +! Jan/08, S. Levis: Added crop-related filters +! +!EOP +!----------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: allocFilters +! +! !INTERFACE: + subroutine allocFilters() +! +! !DESCRIPTION: +! Allocate CLM filters. +! +! !USES: + use clmtype + use decompMod , only : get_proc_clumps, get_clump_bounds +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 2004.04.27 DGVM naturally-vegetated filter added by Forrest Hoffman +! +!EOP +! +! LOCAL VARAIBLES: + integer :: nc ! clump index + integer :: nclumps ! total number of clumps on this processor + integer :: begp, endp ! per-clump beginning and ending pft indices + integer :: begc, endc ! per-clump beginning and ending column indices + integer :: begl, endl ! per-clump beginning and ending landunit indices + integer :: begg, endg ! per-clump beginning and ending gridcell indices + integer :: ier ! error status +!------------------------------------------------------------------------ + + ! Determine clump variables for this processor + + nclumps = get_proc_clumps() + ier = 0 + if( .not. allocated(filter)) then + allocate(filter(nclumps), stat=ier) + end if + if (ier /= 0) then + write(iulog,*) 'allocFilters(): allocation error for clumpsfilters' + call endrun + end if + + ! Loop over clumps on this processor + + !$OMP PARALLEL DO PRIVATE (nc,begg,endg,begl,endl,begc,endc,begp,endp) + do nc = 1, nclumps + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + allocate(filter(nc)%lakep(endp-begp+1)) + allocate(filter(nc)%nolakep(endp-begp+1)) + allocate(filter(nc)%nolakeurbanp(endp-begp+1)) + + allocate(filter(nc)%lakec(endc-begc+1)) + allocate(filter(nc)%nolakec(endc-begc+1)) + + allocate(filter(nc)%soilc(endc-begc+1)) + allocate(filter(nc)%soilp(endp-begp+1)) + + allocate(filter(nc)%snowc(endc-begc+1)) + allocate(filter(nc)%nosnowc(endc-begc+1)) + + if (use_cndv) then + allocate(filter(nc)%natvegp(endp-begp+1)) + end if + + allocate(filter(nc)%hydrologyc(endc-begc+1)) + + allocate(filter(nc)%urbanp(endp-begp+1)) + allocate(filter(nc)%nourbanp(endp-begp+1)) + + allocate(filter(nc)%urbanc(endc-begc+1)) + allocate(filter(nc)%nourbanc(endc-begc+1)) + + allocate(filter(nc)%urbanl(endl-begl+1)) + allocate(filter(nc)%nourbanl(endl-begl+1)) + + allocate(filter(nc)%pcropp(endp-begp+1)) + allocate(filter(nc)%soilnopcropp(endp-begp+1)) + end do + !$OMP END PARALLEL DO + + end subroutine allocFilters + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: setFilters +! +! !INTERFACE: + subroutine setFilters( nc ) +! +! !DESCRIPTION: +! Set CLM filters. +! +! !USES: + use clmtype + use decompMod , only : get_clump_bounds + use pftvarcon , only : npcropmin + use clm_varcon, only : istsoil, isturb, icol_road_perv, istice_mec + use clm_varcon, only : istcrop +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: nc ! clump index +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 2004.04.27 DGVM naturally-vegetated filter added by Forrest Hoffman +! 2005.09.12 Urban related filters added by Mariana Vertenstein +! +!EOP +! +! LOCAL VARAIBLES: + integer , pointer :: ctype(:) ! column type + integer :: c,l,p ! column, landunit, pft indices + integer :: fl ! lake filter index + integer :: fnl,fnlu ! non-lake filter index + integer :: fs ! soil filter index + integer :: f, fn ! general indices + integer :: begp, endp ! per-clump beginning and ending pft indices + integer :: begc, endc ! per-clump beginning and ending column indices + integer :: begl, endl ! per-clump beginning and ending landunit indices + integer :: begg, endg ! per-clump beginning and ending gridcell indices +!------------------------------------------------------------------------ + + ctype => col%itype + + ! Determine clump boundaries + + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + ! Create lake and non-lake filters at column-level + + fl = 0 + fnl = 0 + do c = begc,endc + l = col%landunit(c) + if (lun%lakpoi(l)) then + fl = fl + 1 + filter(nc)%lakec(fl) = c + else + fnl = fnl + 1 + filter(nc)%nolakec(fnl) = c + end if + end do + filter(nc)%num_lakec = fl + filter(nc)%num_nolakec = fnl + + ! Create lake and non-lake filters at pft-level + ! Filter will only be active if weight of pft wrt gcell is nonzero + + fl = 0 + fnl = 0 + fnlu = 0 + do p = begp,endp + l = pft%landunit(p) + if (pft%wtgcell(p) > 0._r8 & + .or. & + lun%itype(l)==istice_mec) then ! some glacier_mec columns have zero weight + + l = pft%landunit(p) + if (lun%lakpoi(l) ) then + fl = fl + 1 + filter(nc)%lakep(fl) = p + else + fnl = fnl + 1 + filter(nc)%nolakep(fnl) = p + if (lun%itype(l) /= isturb) then + fnlu = fnlu + 1 + filter(nc)%nolakeurbanp(fnlu) = p + end if + end if + end if + end do + filter(nc)%num_lakep = fl + filter(nc)%num_nolakep = fnl + filter(nc)%num_nolakeurbanp = fnlu + + ! Create soil filter at column-level + + fs = 0 + do c = begc,endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + filter(nc)%soilc(fs) = c + end if + end do + filter(nc)%num_soilc = fs + + ! Create soil filter at pft-level + ! Filter will only be active if weight of pft wrt gcell is nonzero + + fs = 0 + do p = begp,endp + if (pft%wtgcell(p) > 0._r8) then + l = pft%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fs = fs + 1 + filter(nc)%soilp(fs) = p + end if + end if + end do + filter(nc)%num_soilp = fs + + ! Create column-level hydrology filter (soil and Urban pervious road cols) + + f = 0 + do c = begc,endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. ctype(c) == icol_road_perv .or. & + lun%itype(l) == istcrop) then + f = f + 1 + filter(nc)%hydrologyc(f) = c + end if + end do + filter(nc)%num_hydrologyc = f + + ! Create prognostic crop and soil w/o prog. crop filters at pft-level + ! according to where the crop model should be used + + fl = 0 + fnl = 0 + do p = begp,endp + if (pft%wtgcell(p) > 0._r8) then + if (pft%itype(p) >= npcropmin) then !skips 2 generic crop types + fl = fl + 1 + filter(nc)%pcropp(fl) = p + else + l = pft%landunit(p) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + fnl = fnl + 1 + filter(nc)%soilnopcropp(fnl) = p + end if + end if + end if + end do + filter(nc)%num_pcropp = fl + filter(nc)%soilnopcropp = fnl ! This wasn't being set before... + + ! Create landunit-level urban and non-urban filters + + f = 0 + fn = 0 + do l = begl,endl + if (lun%itype(l) == isturb) then + f = f + 1 + filter(nc)%urbanl(f) = l + else + fn = fn + 1 + filter(nc)%nourbanl(fn) = l + end if + end do + filter(nc)%num_urbanl = f + filter(nc)%num_nourbanl = fn + + ! Create column-level urban and non-urban filters + + f = 0 + fn = 0 + do c = begc,endc + l = col%landunit(c) + if (lun%itype(l) == isturb) then + f = f + 1 + filter(nc)%urbanc(f) = c + else + fn = fn + 1 + filter(nc)%nourbanc(fn) = c + end if + end do + filter(nc)%num_urbanc = f + filter(nc)%num_nourbanc = fn + + ! Create pft-level urban and non-urban filters + + f = 0 + fn = 0 + do p = begp,endp + l = pft%landunit(p) + if (lun%itype(l) == isturb .and. pft%wtgcell(p) > 0._r8) then + f = f + 1 + filter(nc)%urbanp(f) = p + else + fn = fn + 1 + filter(nc)%nourbanp(fn) = p + end if + end do + filter(nc)%num_urbanp = f + filter(nc)%num_nourbanp = fn + + ! Note: snow filters are reconstructed each time step in Hydrology2 + ! Note: CNDV "pft present" filter is reconstructed each time CNDV is run + + end subroutine setFilters + +end module filterMod diff --git a/components/clm/src_clm40/main/findHistFields.pl b/components/clm/src_clm40/main/findHistFields.pl new file mode 100755 index 0000000000..a02fc644a5 --- /dev/null +++ b/components/clm/src_clm40/main/findHistFields.pl @@ -0,0 +1,265 @@ +#!/usr/bin/env perl +# +# This perl script reads in the histFldsMod.F90 file to find the total list of history +# fields that can be added for this model version, regardless of namelist options, or +# CPP processing. +# +use strict; +#use warnings; +#use diagnostics; + +use Cwd; +use English; +use Getopt::Long; +use IO::File; +use File::Glob ':glob'; + +# Set the directory that contains the CLM configuration scripts. If the command was +# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume +# the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script + # is in + # the user's PATH +my $cmdline = "@ARGV"; # Command line arguments to script +my $cwd = getcwd(); # current working directory +my $cfgdir; # absolute pathname of directory that contains this script +my $nm = "${ProgName}::"; # name to use if script dies +if ($ProgDir) { + $cfgdir = $ProgDir; +} else { + $cfgdir = $cwd; +} +# The namelist definition file contains entries for all namelist variables that +# can be output by build-namelist. +my $nl_definition_file = "$cfgdir/../../bld/namelist_files/namelist_definition_clm4_0.xml"; +(-f "$nl_definition_file") or die <<"EOF"; +** $ProgName - Cannot find namelist definition file \"$nl_definition_file\" ** +EOF +print "Using namelist definition file $nl_definition_file\n"; + +# The Build::NamelistDefinition module provides utilities to get the list of +# megan compounds + +#The root directory to cesm utils Tools +my $cesm_tools = "$cfgdir/../../../../cime/utils"; + +(-f "$cesm_tools/perl5lib/Build/NamelistDefinition.pm") or die <<"EOF"; +** $ProgName - Cannot find perl module \"Build/NamelistDefinition.pm\" in directory + \"$cesm_tools/perl5lib\" ** +EOF +# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules +my @dirs = ( $cfgdir, "$cesm_tools/perl5lib"); +unshift @INC, @dirs; +require Build::NamelistDefinition; +# Create a namelist definition object. This object provides a method for verifying that +# the +# output namelist variables are in the definition file, and are output in the correct +# namelist groups. +my $definition = Build::NamelistDefinition->new($nl_definition_file); + + +my $mxname = 0; +my $mxlongn = 0; +my %fields; +my $fldnamevar = "fieldname_var"; + +sub matchKeyword { +# +# Match a keyword +# + my $keyword = shift; + my $line = shift; + my $fh = shift; + + my $match = undef; + if ( $line =~ /$keyword/ ) { + if ( $line =~ /$keyword\s*=\s*['"]([^'"]+)['"]/ ) { + $match = $1; + } elsif ( $line =~ /$keyword\s*=\s*&\s*$/ ) { + $line = <$fh>; + if ( $line =~ /^\s*['"]([^'"]+)['"]/ ) { + $match = $1; + } else { + die "ERROR: Trouble getting keyword string\n Line: $line"; + } + } else { + if ( $line =~ /fname\s*=\s*fieldname/ ) { + print STDERR "Found variable used for fieldname = $line\n"; + $match = $fldnamevar; + } elsif ( $line =~ /fname\s*=\s*trim\(fname\)/ ) { + $match = undef; + } elsif ( $line =~ /units\s*=\s*units/ ) { + $match = undef; + } elsif ( $line =~ /long_name\s*=\s*long_name/ ) { + $match = undef; + } elsif ( $line =~ /long_name\s*=\s*longname/ ) { + print STDERR "Found variable used for longname = $line\n"; + $match = "longname_var"; + } else { + die "ERROR: Still have a match on $keyword\n Line: $line"; + } + } + } + return( $match ); +} + +sub getFieldInfo { +# +# Get field Information +# + my $fh = shift; + my $line = shift; + + my $fname = undef; + my $units = undef; + my $longn = undef; + my $endin = undef; + do { + if ( $line =~ /MEG_/ ) { + $line =~ s|'//'_'|_'|g; + $line =~ s|'//trim\(meg_cmp\%name\)|megancmpd'|gi; + if ( $line =~ /meg_cmp\%name/ ) { + die "ERROR: Still have meg_cmp in a line\n"; + } + } + if ( ! defined($fname) ) { + $fname = &matchKeyword( "fname", $line, $fh ); + } + if ( ! defined($units) ) { + $units = &matchKeyword( "units", $line, $fh ); + } + if ( ! defined($longn) ) { + $longn = &matchKeyword( "long_name", $line, $fh ); + } + if ( $line =~ /\)\s*$/ ) { + $endin = 1; + } + if ( ! defined($endin) ) { $line = <$fh>; } + + } until( (defined($fname) && defined($units) && defined($longn)) || + ! defined($line) || defined($endin) ); + if ( ! defined($fname) ) { + die "ERROR: name undefined for field ending with: $line\n"; + } + return( $fname, $longn, $units ); +} + +sub setField { +# +# Set the field +# + my $name = shift; + my $longn = shift; + my $units = shift; + + if ( defined($name) && $name ne $fldnamevar ) { + if ( length($name) > $mxname ) { $mxname = length($name); } + if ( length($longn) > $mxlongn ) { $mxlongn = length($longn); } + my $len; + if ( length($longn) > 90 ) { + $len = 110; + } elsif ( length($longn) > 60 ) { + $len = 90; + } else { + $len = 60; + } + $fields{$name} = sprintf( "%-${len}s\t(%s)", $longn, $units ); + } +} + +sub XML_Header { +# +# Write out header to history fields file +# + my $outfh = shift; + my $outfilename = shift; + my $filename = shift; + + print STDERR " Write out header to history fields file to: $outfilename\n"; + my $svnurl = '$URL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/src_clm40/main/findHistFields.pl $'; + my $svnid = '$Id: findHistFields.pl 69899 2015-04-10 20:45:24Z erik $'; + print $outfh <<"EOF"; + + +\<\?xml-stylesheet type="text\/xsl" href="history_fields.xsl"\?\> + +\<\!-- + List of history file field names, long-names and units for all the fields output + by CLM. This was created by reading in the file: $filename + SVN version information: + $svnurl + $svnid +--\> + +\ +EOF +} + +sub XML_Footer { +# +# Write out footer to history fields file +# + my $outfh = shift; + + print STDERR " Write out footer to history fields file\n"; + print $outfh "\n\n"; +} + +my $pwd = `pwd`; +chomp( $pwd ); +my $filename = "$pwd/histFldsMod.F90"; + +my $fh = IO::File->new($filename, '<') or die "** $ProgName - can't open history Fields file: $filename\n"; +my @megcmpds = $definition->get_valid_values( "megan_cmpds", 'noquotes'=>1 ); +# +# Read in the list of fields from the source file +# And output to an XML file +# +my $outfilename = "$pwd/../../bld/namelist_files/history_fields_clm4_0.xml"; + +my $outfh = IO::File->new($outfilename, '>') or die "** $ProgName - can't open output history Fields XML file: $outfilename\n"; +&XML_Header( $outfh, $outfilename, $filename ); +while (my $line = <$fh>) { + + # Comments + if ($line =~ /(.*)\!/) { + $line = $1; + } + my $format = "\n\n"; + if ($line =~ /call\s*hist_addfld/i ) { + (my $name, my $longn, my $units) = &getFieldInfo( $fh, $line ); + if ( $name ne "MEG_megancmpd" ) { + &setField( $name, $longn, $units ); + printf( $outfh $format, $name, $units, $longn ); + } else { + foreach my $megcmpd ( @megcmpds ) { + my $name = "MEG_${megcmpd}"; + &setField( $name, $longn, $units ); + printf( $outfh $format, $name, $units, $longn ); + } + } + } +} +close( $fh ); +&XML_Footer( $outfh ); +close( $outfh ); +print STDERR " mxname = $mxname\n"; +print STDERR " mxlongn = $mxlongn\n"; + +# +# List the fields in a neatly ordered list +# +foreach my $name ( sort(keys(%fields)) ) { + my $len; + if ( length($name) > 20 ) { + $len = 40; + } else { + $len = 20; + } + printf( "%-${len}s = %s\n", $name, $fields{$name} ); +} + diff --git a/components/clm/src_clm40/main/getdatetime.F90 b/components/clm/src_clm40/main/getdatetime.F90 new file mode 100644 index 0000000000..4126d807e4 --- /dev/null +++ b/components/clm/src_clm40/main/getdatetime.F90 @@ -0,0 +1,53 @@ +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: getdatetime +! +! !INTERFACE: +subroutine getdatetime (cdate, ctime) +! +! !DESCRIPTION: +! A generic Date and Time routine +! +! !USES: + use spmdMod , only : mpicom, masterproc, MPI_CHARACTER +! !ARGUMENTS: + implicit none + character(len=8), intent(out) :: cdate !current date + character(len=8), intent(out) :: ctime !current time +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=8) :: date !current date + character(len=10) :: time !current time + character(len=5) :: zone !zone + integer, dimension(8) :: values !temporary + integer :: ier !MPI error code +!----------------------------------------------------------------------- + if (masterproc) then + + call date_and_time (date, time, zone, values) + + cdate(1:2) = date(5:6) + cdate(3:3) = '/' + cdate(4:5) = date(7:8) + cdate(6:6) = '/' + cdate(7:8) = date(3:4) + + ctime(1:2) = time(1:2) + ctime(3:3) = ':' + ctime(4:5) = time(3:4) + ctime(6:6) = ':' + ctime(7:8) = time(5:6) + + endif + + call mpi_bcast (cdate,len(cdate),MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (ctime,len(ctime),MPI_CHARACTER, 0, mpicom, ier) + + return +end subroutine getdatetime diff --git a/components/clm/src_clm40/main/histFileMod.F90 b/components/clm/src_clm40/main/histFileMod.F90 new file mode 100644 index 0000000000..cc72d3a329 --- /dev/null +++ b/components/clm/src_clm40/main/histFileMod.F90 @@ -0,0 +1,4485 @@ +module histFileMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: histFileMod +! +! !DESCRIPTION: +! Module containing methods to for CLM history file handling. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use shr_sys_mod , only : shr_sys_flush + use abortutils , only : endrun + use clm_varcon , only : spval,ispval + use clm_varctl , only : iulog + use clmtype + use decompMod , only : get_proc_bounds, get_proc_global + use ncdio_pio + implicit none + save + private + +! +! !PUBLIC TYPES: +! +! Constants +! + integer , public, parameter :: max_tapes = 6 ! max number of history tapes + integer , public, parameter :: max_flds = 1500 ! max number of history fields + integer , public, parameter :: max_namlen = 32 ! maximum number of characters for field name +! +! Counters +! + integer , public :: ntapes = 0 ! index of max history file requested +! +! Namelist +! + integer :: ni ! implicit index below + logical, public :: & + hist_empty_htapes = .false. ! namelist: flag indicates no default history fields + integer, public :: & + hist_ndens(max_tapes) = 2 ! namelist: output density of netcdf history files + integer, public :: & + hist_mfilt(max_tapes) = 30 ! namelist: number of time samples per tape + logical, public :: & + hist_dov2xy(max_tapes) = (/.true.,(.true.,ni=2,max_tapes)/) ! namelist: true=> do grid averaging + integer, public :: & + hist_nhtfrq(max_tapes) = (/0, (-24, ni=2,max_tapes)/) ! namelist: history write freq(0=monthly) + character(len=1), public :: & + hist_avgflag_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape averaging flag + character(len=max_namlen), public :: & + hist_type1d_pertape(max_tapes) = (/(' ',ni=1,max_tapes)/) ! namelist: per tape type1d + + character(len=max_namlen+2), public :: & + fincl(max_flds,max_tapes) ! namelist-equivalence list of fields to add + + character(len=max_namlen+2), public :: & + hist_fincl1(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl2(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl3(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl4(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl5(max_flds) = ' ' ! namelist: list of fields to add + character(len=max_namlen+2), public :: & + hist_fincl6(max_flds) = ' ' ! namelist: list of fields to add + + character(len=max_namlen+2), public :: & + fexcl(max_flds,max_tapes) ! namelist-equivalence list of fields to remove + + character(len=max_namlen+2), public :: & + hist_fexcl1(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl2(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl3(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl4(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl5(max_flds) = ' ' ! namelist: list of fields to remove + character(len=max_namlen+2), public :: & + hist_fexcl6(max_flds) = ' ' ! namelist: list of fields to remove +! +! Restart +! + logical, private :: if_disphist(max_tapes) ! true => save history file +! +! !PUBLIC MEMBER FUNCTIONS: + public :: hist_addfld1d ! Add a 1d single-level field to the master field list + public :: hist_addfld2d ! Add a 2d multi-level field to the master field list + public :: hist_add_subscript ! Add a 2d subscript dimension + public :: hist_printflds ! Print summary of master field list + public :: hist_htapes_build ! Initialize history file handler for initial or continue run + public :: hist_update_hbuf ! Updates history buffer for all fields and tapes + public :: hist_htapes_wrapup ! Write history tape(s) + public :: hist_restart_ncd ! Read/write history file restart data + public :: htapes_fieldlist ! Define the contents of each history file based on namelist +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE MEMBER FUNCTIONS: + private :: masterlist_make_active ! Add a field to a history file default "on" list + private :: masterlist_addfld ! Add a field to the master field list + private :: masterlist_change_timeavg ! Override default history tape contents for specific tape + private :: htape_addfld ! Add a field to the active list for a history tape + private :: htape_create ! Define contents of history file t + private :: htape_timeconst ! Write time constant values to history tape + private :: htape_timeconst3D ! Write time constant 3D values to primary history tape + private :: hfields_normalize ! Normalize history file fields by number of accumulations + private :: hfields_zero ! Zero out accumulation and hsitory buffers for a tape + private :: hfields_write ! Write a variable to a history tape + private :: hfields_1dinfo ! Define/output 1d subgrid info if appropriate + private :: hist_update_hbuf_field_1d ! Updates history buffer for specific field and tape + private :: hist_update_hbuf_field_2d ! Updates history buffer for specific field and tape + private :: list_index ! Find index of field in exclude list + private :: set_hist_filename ! Determine history dataset filenames + private :: getname ! Retrieve name portion of input "inname" + private :: getflag ! Retrieve flag + private :: pointer_index ! Track data pointer indices + private :: max_nFields ! The max number of fields on any tape + +! !PRIVATE TYPES: +! Constants +! + integer, parameter :: max_chars = 128 ! max chars for char variables +! +! Subscript dimensions +! + integer, parameter :: max_subs = 100 ! max number of subscripts + integer :: num_subs = 0 ! actual number of subscripts + character(len=32) :: subs_name(max_subs) ! name of subscript + integer :: subs_dim(max_subs) ! dimension of subscript +! +! Derived types +! + type field_info + character(len=max_namlen) :: name ! field name + character(len=max_chars) :: long_name ! long name + character(len=max_chars) :: units ! units + character(len=8) :: type1d ! clm pointer first dimension type + ! from clmtype (nameg, etc) + character(len=8) :: type1d_out ! hbuf first dimension type + ! from clmtype (nameg, etc) + character(len=8) :: type2d ! hbuf second dimension type + ! ["levgrnd","levlak","numrad","glc_nec","subname(n)"] + integer :: beg1d ! on-node 1d clm pointer start index + integer :: end1d ! on-node 1d clm pointer end index + integer :: num1d ! size of clm pointer first dimension (all nodes) + integer :: beg1d_out ! on-node 1d hbuf pointer start index + integer :: end1d_out ! on-node 1d hbuf pointer end index + integer :: num1d_out ! size of hbuf first dimension (all nodes) + integer :: num2d ! size of hbuf second dimension (e.g. number of vertical levels) + integer :: hpindex ! history pointer index + character(len=8) :: p2c_scale_type ! scale factor when averaging pft to column + character(len=8) :: c2l_scale_type ! scale factor when averaging column to landunit + character(len=8) :: l2g_scale_type ! scale factor when averaging landunit to gridcell + end type field_info + + type master_entry + type (field_info) :: field ! field information + logical :: actflag(max_tapes) ! active/inactive flag + character(len=1) :: avgflag(max_tapes) ! time averaging flag ("X","A","M" or "I",) + end type master_entry + + type history_entry + type (field_info) :: field ! field information + character(len=1) :: avgflag ! time averaging flag + real(r8), pointer :: hbuf(:,:) ! history buffer (dimensions: dim1d x num2d) + integer , pointer :: nacs(:,:) ! accumulation counter (dimensions: dim1d x num2d) + end type history_entry + + type history_tape + integer :: nflds ! number of active fields on tape + integer :: ntimes ! current number of time samples on tape + integer :: mfilt ! maximum number of time samples per tape + integer :: nhtfrq ! number of time samples per tape + integer :: ncprec ! netcdf output precision + logical :: dov2xy ! true => do xy average for all fields + logical :: is_endhist ! true => current time step is end of history interval + real(r8) :: begtime ! time at beginning of history averaging interval + type (history_entry) :: hlist(max_flds) ! array of active history tape entries + end type history_tape + + type clmpoint_rs ! Pointer to real scalar data (1D) + real(r8), pointer :: ptr(:) + end type clmpoint_rs + type clmpoint_ra ! Pointer to real array data (2D) + real(r8), pointer :: ptr(:,:) + end type clmpoint_ra +!EOP +! +! Pointers into clmtype arrays +! + integer, parameter :: max_mapflds = 1500 ! Maximum number of fields to track + type (clmpoint_rs) :: clmptr_rs(max_mapflds) ! Real scalar data (1D) + type (clmpoint_ra) :: clmptr_ra(max_mapflds) ! Real array data (2D) +! +! Master list: an array of master_entry entities +! + type (master_entry) :: masterlist(max_flds) ! master field list +! +! History tape: an array of history_tape entities (only active fields) +! + type (history_tape) :: tape(max_tapes) ! array history tapes +! +! Namelist input +! +! Counters +! + integer :: nfmaster = 0 ! number of fields in master field list +! +! Other variables +! + character(len=max_chars) :: locfnh(max_tapes) ! local history file names + character(len=max_chars) :: locfnhr(max_tapes) ! local history restart file names + logical :: htapes_defined = .false. ! flag indicates history contents have been defined +! +! NetCDF Id's +! + type(file_desc_t) :: nfid(max_tapes) ! file ids + type(file_desc_t) :: ncid_hist(max_tapes) ! file ids for history restart files + integer :: time_dimid ! time dimension id + integer :: hist_interval_dimid ! time bounds dimension id + integer :: strlen_dimid ! string dimension id + +! +! Time Constant variable names and filename +! + character(len=max_chars) :: TimeConst3DVars_Filename = ' ' + character(len=max_chars) :: TimeConst3DVars = ' ' +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_printflds +! +! !INTERFACE: + subroutine hist_printflds() +! +! !DESCRIPTION: +! Print summary of master field list. +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 03/2003 +! +! +! !LOCAL VARIABLES: +!EOP + integer nf + character(len=*),parameter :: subname = 'CLM_hist_printflds' +!----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) trim(subname),' : number of master fields = ',nfmaster + write(iulog,*)' ******* MASTER FIELD LIST *******' + do nf = 1,nfmaster + write(iulog,9000)nf, masterlist(nf)%field%name, masterlist(nf)%field%units +9000 format (i5,1x,a32,1x,a16) + end do + call shr_sys_flush(iulog) + end if + + end subroutine hist_printflds + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: masterlist_addfld +! +! !INTERFACE: + subroutine masterlist_addfld (fname, type1d, type1d_out, & + type2d, num2d, units, avgflag, long_name, hpindex, & + p2c_scale_type, c2l_scale_type, l2g_scale_type) +! +! !DESCRIPTION: +! Add a field to the master field list. Put input arguments of +! field name, units, number of levels, averaging flag, and long name +! into a type entry in the global master field list (masterlist). +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type1d ! 1d data type + character(len=*), intent(in) :: type1d_out ! 1d output type + character(len=*), intent(in) :: type2d ! 2d output type + integer , intent(in) :: num2d ! size of second dimension (e.g. number of vertical levels) + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + integer , intent(in) :: hpindex ! clmtype index for history buffer output + character(len=*), intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n ! loop index + integer :: f ! masterlist index + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + character(len=*),parameter :: subname = 'masterlist_addfld' +!------------------------------------------------------------------------ + + ! Determine bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + ! Ensure that new field is not all blanks + + if (fname == ' ') then + write(iulog,*) trim(subname),' ERROR: blank field name not allowed' + call endrun() + end if + + ! Ensure that new field doesn't already exist + + do n = 1,nfmaster + if (masterlist(n)%field%name == fname) then + write(iulog,*) trim(subname),' ERROR:', fname, ' already on list' + call endrun() + end if + end do + + ! Increase number of fields on master field list + + nfmaster = nfmaster + 1 + f = nfmaster + + ! Check number of fields in master list against maximum number for master list + + if (nfmaster > max_flds) then + write(iulog,*) trim(subname),' ERROR: too many fields for primary history file ', & + '-- max_flds,nfmaster=', max_flds, nfmaster + call endrun() + end if + + ! Add field to master list + + masterlist(f)%field%name = fname + masterlist(f)%field%long_name = long_name + masterlist(f)%field%units = units + masterlist(f)%field%type1d = type1d + masterlist(f)%field%type1d_out = type1d_out + masterlist(f)%field%type2d = type2d + masterlist(f)%field%num2d = num2d + masterlist(f)%field%hpindex = hpindex + masterlist(f)%field%p2c_scale_type = p2c_scale_type + masterlist(f)%field%c2l_scale_type = c2l_scale_type + masterlist(f)%field%l2g_scale_type = l2g_scale_type + + select case (type1d) + case (grlnd) + masterlist(f)%field%beg1d = begg + masterlist(f)%field%end1d = endg + masterlist(f)%field%num1d = numg + case (nameg) + masterlist(f)%field%beg1d = begg + masterlist(f)%field%end1d = endg + masterlist(f)%field%num1d = numg + case (namel) + masterlist(f)%field%beg1d = begl + masterlist(f)%field%end1d = endl + masterlist(f)%field%num1d = numl + case (namec) + masterlist(f)%field%beg1d = begc + masterlist(f)%field%end1d = endc + masterlist(f)%field%num1d = numc + case (namep) + masterlist(f)%field%beg1d = begp + masterlist(f)%field%end1d = endp + masterlist(f)%field%num1d = nump + case default + write(iulog,*) trim(subname),' ERROR: unknown 1d output type= ',type1d + call endrun() + end select + + ! The following two fields are used only in master field list, + ! NOT in the runtime active field list + ! ALL FIELDS IN THE MASTER LIST ARE INITIALIZED WITH THE ACTIVE + ! FLAG SET TO FALSE + + masterlist(f)%avgflag(:) = avgflag + masterlist(f)%actflag(:) = .false. + + end subroutine masterlist_addfld + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_htapes_build +! +! !INTERFACE: + subroutine hist_htapes_build () +! +! !DESCRIPTION: +! Initialize history file for initial or continuation run. For example, +! on an initial run, this routine initializes ``ntapes'' history files. +! On a restart run, this routine only initializes history files declared +! beyond what existed on the previous run. Files which already existed on +! the previous run have already been initialized (i.e. named and opened) +! in routine restart\_history. Loop over tapes and fields per tape setting +! appropriate variables and calling appropriate routines +! +! !USES: + use clm_time_manager, only: get_prev_time + use clm_varcon , only: secspday +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i ! index + integer :: ier ! error code + integer :: t, f ! tape, field indices + integer :: day, sec ! day and seconds from base date + character(len=*),parameter :: subname = 'hist_htapes_build' +!----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) trim(subname),' Initializing clm2 history files' + write(iulog,'(72a1)') ("-",i=1,60) + call shr_sys_flush(iulog) + endif + + ! Define field list information for all history files. + ! Update ntapes to reflect number of active history files + ! Note - branch runs can have additional auxiliary history files + ! declared). + + call htapes_fieldlist() + + ! Determine if gridcell (xy) averaging is done for all fields on tape + + do t=1,ntapes + tape(t)%dov2xy = hist_dov2xy(t) + write(iulog,*)trim(subname),' hist tape = ',t,& + ' written with dov2xy= ',tape(t)%dov2xy + end do + + ! Set number of time samples in each history file and + ! Note - the following entries will be overwritten by history restart + ! Note - with netcdf, only 1 (ncd_double) and 2 (ncd_float) are allowed + + do t=1,ntapes + tape(t)%ntimes = 0 + tape(t)%dov2xy = hist_dov2xy(t) + tape(t)%nhtfrq = hist_nhtfrq(t) + tape(t)%mfilt = hist_mfilt(t) + if (hist_ndens(t) == 1) then + tape(t)%ncprec = ncd_double + else + tape(t)%ncprec = ncd_float + endif + end do + + ! Set time of beginning of current averaging interval + ! First etermine elapased time since reference date + + call get_prev_time(day, sec) + do t=1,ntapes + tape(t)%begtime = day + sec/secspday + end do + + if (masterproc) then + write(iulog,*) trim(subname),' Successfully initialized clm2 history files' + write(iulog,'(72a1)') ("-",i=1,60) + call shr_sys_flush(iulog) + endif + + end subroutine hist_htapes_build + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: masterlist_make_active +! +! !INTERFACE: + subroutine masterlist_make_active (name, tape_index, avgflag) +! +! !DESCRIPTION: +! Add a field to the default ``on'' list for a given history file. +! Also change the default time averaging flag if requested. +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name ! field name + integer, intent(in) :: tape_index ! history tape index + character(len=1), intent(in), optional :: avgflag ! time averaging flag +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + logical :: found ! flag indicates field found in masterlist + character(len=*),parameter :: subname = 'masterlist_make_active' +!----------------------------------------------------------------------- + + ! Check validity of input arguments + + if (tape_index > max_tapes) then + write(iulog,*) trim(subname),' ERROR: tape index=', tape_index, ' is too big' + call endrun() + end if + + if (present(avgflag)) then + if ( avgflag /= ' ' .and. & + avgflag /= 'A' .and. avgflag /= 'I' .and. & + avgflag /= 'X' .and. avgflag /= 'M') then + write(iulog,*) trim(subname),' ERROR: unknown averaging flag=', avgflag + call endrun() + endif + end if + + ! Look through master list for input field name. + ! When found, set active flag for that tape to true. + ! Also reset averaging flag if told to use other than default. + + found = .false. + do f = 1,nfmaster + if (trim(name) == trim(masterlist(f)%field%name)) then + masterlist(f)%actflag(tape_index) = .true. + if (present(avgflag)) then + if (avgflag/= ' ') masterlist(f)%avgflag(tape_index) = avgflag + end if + found = .true. + exit + end if + end do + if (.not. found) then + write(iulog,*) trim(subname),' ERROR: field=', name, ' not found' + call endrun() + end if + + end subroutine masterlist_make_active + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: masterlist_change_timeavg +! +! !INTERFACE: + subroutine masterlist_change_timeavg (t) +! +! !DESCRIPTION: +! Override default history tape contents for a specific tape. +! Copy the flag into the master field list. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! history tape index +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + character(len=1) :: avgflag ! lcl equiv of hist_avgflag_pertape(t) + character(len=*),parameter :: subname = 'masterlist_change_timeavg' +!----------------------------------------------------------------------- + + avgflag = hist_avgflag_pertape(t) + + do f = 1,nfmaster + select case (avgflag) + case ('A') + masterlist(f)%avgflag(t) = avgflag + case ('I') + masterlist(f)%avgflag(t) = avgflag + case ('X') + masterlist(f)%avgflag(t) = avgflag + case ('M') + masterlist(f)%avgflag(t) = avgflag + case default + write(iulog,*) trim(subname),' ERROR: unknown avgflag=',avgflag + call endrun () + end select + end do + + end subroutine masterlist_change_timeavg + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: htapes_fieldlist +! +! !INTERFACE: + subroutine htapes_fieldlist() +! +! !DESCRIPTION: +! Define the contents of each history file based on namelist +! input for initial or branch run, and restart data if a restart run. +! Use arrays fincl and fexcl to modify default history tape contents. +! Then sort the result alphanumerically. +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: t, f ! tape, field indices + integer :: ff ! index into include, exclude and fprec list + character(len=max_namlen) :: name ! field name portion of fincl (i.e. no avgflag separator) + character(len=max_namlen) :: mastername ! name from masterlist field + character(len=1) :: avgflag ! averaging flag + character(len=1) :: prec_acc ! history buffer precision flag + character(len=1) :: prec_wrt ! history buffer write precision flag + type (history_entry) :: tmp ! temporary used for swapping + character(len=*),parameter :: subname = 'htapes_fieldlist' +!----------------------------------------------------------------------- + + ! Override averaging flag for all fields on a particular tape + ! if namelist input so specifies + + do t=1,max_tapes + if (hist_avgflag_pertape(t) /= ' ') then + call masterlist_change_timeavg (t) + end if + end do + + fincl(:,1) = hist_fincl1(:) + fincl(:,2) = hist_fincl2(:) + fincl(:,3) = hist_fincl3(:) + fincl(:,4) = hist_fincl4(:) + fincl(:,5) = hist_fincl5(:) + fincl(:,6) = hist_fincl6(:) + + fexcl(:,1) = hist_fexcl1(:) + fexcl(:,2) = hist_fexcl2(:) + fexcl(:,3) = hist_fexcl3(:) + fexcl(:,4) = hist_fexcl4(:) + fexcl(:,5) = hist_fexcl5(:) + fexcl(:,6) = hist_fexcl6(:) + + + ! First ensure contents of fincl and fexcl are valid names + + do t = 1,max_tapes + f = 1 + do while (f < max_flds .and. fincl(f,t) /= ' ') + name = getname (fincl(f,t)) + do ff = 1,nfmaster + mastername = masterlist(ff)%field%name + if (name == mastername) exit + end do + if (name /= mastername) then + write(iulog,*) trim(subname),' ERROR: ', trim(name), ' in fincl(', f, ') ',& + 'for history tape ',t,' not found' + call endrun() + end if + f = f + 1 + end do + + f = 1 + do while (f < max_flds .and. fexcl(f,t) /= ' ') + do ff = 1,nfmaster + mastername = masterlist(ff)%field%name + if (fexcl(f,t) == mastername) exit + end do + if (fexcl(f,t) /= mastername) then + write(iulog,*) trim(subname),' ERROR: ', fexcl(f,t), ' in fexcl(', f, ') ', & + 'for history tape ',t,' not found' + call endrun() + end if + f = f + 1 + end do + end do + + tape(:)%nflds = 0 + do t = 1,max_tapes + + ! Loop through the masterlist set of field names and determine if any of those + ! are in the FINCL or FEXCL arrays + ! The call to list_index determines the index in the FINCL or FEXCL arrays + ! that the masterlist field corresponds to + ! Add the field to the tape if specified via namelist (FINCL[1-max_tapes]), + ! or if it is on by default and was not excluded via namelist (FEXCL[1-max_tapes]). + + do f = 1,nfmaster + mastername = masterlist(f)%field%name + call list_index (fincl(1,t), mastername, ff) + + if (ff > 0) then + + ! if field is in include list, ff > 0 and htape_addfld + ! will not be called for field + + avgflag = getflag (fincl(ff,t)) + call htape_addfld (t, f, avgflag) + + else if (.not. hist_empty_htapes) then + + ! find index of field in exclude list + + call list_index (fexcl(1,t), mastername, ff) + + ! if field is in exclude list, ff > 0 and htape_addfld + ! will not be called for field + ! if field is not in exclude list, ff =0 and htape_addfld + ! will be called for field (note that htape_addfld will be + ! called below only if field is not in exclude list OR in + ! include list + + if (ff == 0 .and. masterlist(f)%actflag(t)) then + call htape_addfld (t, f, ' ') + end if + + end if + end do + + ! Specification of tape contents now complete. + ! Sort each list of active entries + + do f = tape(t)%nflds-1,1,-1 + do ff = 1,f + if (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name) then + + tmp = tape(t)%hlist(ff) + tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) + tape(t)%hlist(ff+1) = tmp + + else if (tape(t)%hlist(ff)%field%name == tape(t)%hlist(ff+1)%field%name) then + + write(iulog,*) trim(subname),' ERROR: Duplicate field ', & + tape(t)%hlist(ff)%field%name, & + 't,ff,name=',t,ff,tape(t)%hlist(ff+1)%field%name + call endrun() + + end if + end do + end do + + if (masterproc) then + if (tape(t)%nflds > 0) then + write(iulog,*) trim(subname),' : Included fields tape ',t,'=',tape(t)%nflds + end if + do f = 1,tape(t)%nflds + write(iulog,*) f,' ',tape(t)%hlist(f)%field%name, & + tape(t)%hlist(f)%field%num2d,' ',tape(t)%hlist(f)%avgflag + end do + call shr_sys_flush(iulog) + end if + end do + + ! Determine total number of active history tapes + + ntapes = 0 + do t = max_tapes,1,-1 + if (tape(t)%nflds > 0) then + ntapes = t + exit + end if + end do + + ! Ensure there are no "holes" in tape specification, i.e. empty tapes. + ! Enabling holes should not be difficult if necessary. + + do t = 1,ntapes + if (tape(t)%nflds == 0) then + write(iulog,*) trim(subname),' ERROR: Tape ',t,' is empty' + call endrun() + end if + end do + + ! Check that the number of history files declared does not exceed + ! the maximum allowed. + + if (ntapes > max_tapes) then + write(iulog,*) trim(subname),' ERROR: Too many history files declared, max_tapes=',max_tapes + call endrun() + end if + + ! Change 1d output per tape output flag if requested - only for history + ! tapes where 2d xy averaging is not enabled + + do t = 1,ntapes + if (hist_type1d_pertape(t) /= ' ' .and. (.not. hist_dov2xy(t))) then + select case (trim(hist_type1d_pertape(t))) + case ('PFTS','COLS', 'LAND', 'GRID') + if ( masterproc ) & + write(iulog,*)'history tape ',t,' will have 1d output type of ',hist_type1d_pertape(t) + case default + write(iulog,*) trim(subname),' ERROR: unknown namelist type1d per tape=',hist_type1d_pertape(t) + call endrun() + end select + end if + end do + + if (masterproc) then + write(iulog,*) 'There will be a total of ',ntapes,' history tapes' + do t=1,ntapes + write(iulog,*) + if (hist_nhtfrq(t) == 0) then + write(iulog,*)'History tape ',t,' write frequency is MONTHLY' + else + write(iulog,*)'History tape ',t,' write frequency = ',hist_nhtfrq(t) + endif + if (hist_dov2xy(t)) then + write(iulog,*)'All fields on history tape ',t,' are grid averaged' + else + write(iulog,*)'All fields on history tape ',t,' are not grid averaged' + end if + write(iulog,*)'Number of time samples on history tape ',t,' is ',hist_mfilt(t) + write(iulog,*)'Output precision on history tape ',t,'=',hist_ndens(t) + write(iulog,*) + end do + call shr_sys_flush(iulog) + end if + + ! Set flag indicating h-tape contents are now defined (needed by masterlist_addfld) + + htapes_defined = .true. + + end subroutine htapes_fieldlist + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: htape_addfld +! +! !INTERFACE: + subroutine htape_addfld (t, f, avgflag) +! +! !DESCRIPTION: +! Add a field to the active list for a history tape. Copy the data from +! the master field list to the active list for the tape. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! history tape index + integer, intent(in) :: f ! field index from master field list + character(len=1), intent(in) :: avgflag ! time averaging flag +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n ! field index on defined tape + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: num2d ! size of second dimension (e.g. .number of vertical levels) + integer :: beg1d_out,end1d_out ! history output per-proc 1d beginning and ending indices + integer :: num1d_out ! history output 1d size + character(len=*),parameter :: subname = 'htape_addfld' +!----------------------------------------------------------------------- + + ! Ensure that it is not to late to add a field to the history tape + + if (htapes_defined) then + write(iulog,*) trim(subname),' ERROR: attempt to add field ', & + masterlist(f)%field%name, ' after history files are set' + call endrun() + end if + + tape(t)%nflds = tape(t)%nflds + 1 + n = tape(t)%nflds + + ! Copy field information + + tape(t)%hlist(n)%field = masterlist(f)%field + + ! Determine bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + + ! Modify type1d_out if necessary + + if (hist_dov2xy(t)) then + + ! If xy output averaging is requested, set output 1d type to grlnd + ! ***NOTE- the following logic is what permits non lat/lon grids to + ! be written to clm history file + + type1d = tape(t)%hlist(n)%field%type1d + + if (type1d == nameg .or. & + type1d == namel .or. & + type1d == namec .or. & + type1d == namep) then + tape(t)%hlist(n)%field%type1d_out = grlnd + end if + if (type1d == grlnd) then + tape(t)%hlist(n)%field%type1d_out = grlnd + end if + + else if (hist_type1d_pertape(t) /= ' ') then + + ! Set output 1d type based on namelist setting of hist_type1d_pertape + ! Only applies to tapes when xy output is not required + + type1d = tape(t)%hlist(n)%field%type1d + + select case (trim(hist_type1d_pertape(t))) + case('GRID') + tape(t)%hlist(n)%field%type1d_out = nameg + case('LAND') + tape(t)%hlist(n)%field%type1d_out = namel + case('COLS') + tape(t)%hlist(n)%field%type1d_out = namec + case ('PFTS') + tape(t)%hlist(n)%field%type1d_out = namep + case default + write(iulog,*) trim(subname),' ERROR: unknown input hist_type1d_pertape= ', hist_type1d_pertape(t) + call endrun() + end select + + endif + + ! Determine output 1d dimensions + + type1d_out = tape(t)%hlist(n)%field%type1d_out + if (type1d_out == grlnd) then + beg1d_out = begg + end1d_out = endg + num1d_out = numg + else if (type1d_out == nameg) then + beg1d_out = begg + end1d_out = endg + num1d_out = numg + else if (type1d_out == namel) then + beg1d_out = begl + end1d_out = endl + num1d_out = numl + else if (type1d_out == namec) then + beg1d_out = begc + end1d_out = endc + num1d_out = numc + else if (type1d_out == namep) then + beg1d_out = begp + end1d_out = endp + num1d_out = nump + else + write(iulog,*) trim(subname),' ERROR: incorrect value of type1d_out= ',type1d_out + call endrun() + end if + + tape(t)%hlist(n)%field%beg1d_out = beg1d_out + tape(t)%hlist(n)%field%end1d_out = end1d_out + tape(t)%hlist(n)%field%num1d_out = num1d_out + + ! Alloccate and initialize history buffer and related info + + num2d = tape(t)%hlist(n)%field%num2d + allocate (tape(t)%hlist(n)%hbuf(beg1d_out:end1d_out,num2d)) + allocate (tape(t)%hlist(n)%nacs(beg1d_out:end1d_out,num2d)) + tape(t)%hlist(n)%hbuf(:,:) = 0._r8 + tape(t)%hlist(n)%nacs(:,:) = 0 + + ! Set time averaging flag based on masterlist setting or + ! override the default averaging flag with namelist setting + + select case (avgflag) + case (' ') + tape(t)%hlist(n)%avgflag = masterlist(f)%avgflag(t) + case ('A','I','X','M') + tape(t)%hlist(n)%avgflag = avgflag + case default + write(iulog,*) trim(subname),' ERROR: unknown avgflag=', avgflag + call endrun() + end select + + end subroutine htape_addfld + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_update_hbuf +! +! !INTERFACE: + subroutine hist_update_hbuf() +! +! !DESCRIPTION: +! Accumulate (or take min, max, etc. as appropriate) input field +! into its history buffer for appropriate tapes. +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: t ! tape index + integer :: f ! field index + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + character(len=*),parameter :: subname = 'hist_update_hbuf' +!----------------------------------------------------------------------- + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + do t = 1,ntapes +!$OMP PARALLEL DO PRIVATE (f, num2d) + do f = 1,tape(t)%nflds + num2d = tape(t)%hlist(f)%field%num2d + if ( num2d == 1) then + call hist_update_hbuf_field_1d (t, f, begp, endp, begc, endc, begl, endl, begg, endg) + else + call hist_update_hbuf_field_2d (t, f, begp, endp, begc, endc, begl, endl, begg, endg, num2d) + end if + end do +!$OMP END PARALLEL DO + end do + + end subroutine hist_update_hbuf + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_update_hbuf_field_1d +! +! !INTERFACE: + subroutine hist_update_hbuf_field_1d (t, f, begp, endp, begc, endc, begl, endl, begg, endg) +! +! !DESCRIPTION: +! Accumulate (or take min, max, etc. as appropriate) input field +! into its history buffer for appropriate tapes. +! +! !USES: + use clmtype + use subgridAveMod, only : p2g, c2g, l2g + use clm_varcon , only : istice_mec +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! field index + integer, intent(in) :: begp, endp ! per-proc beginning and ending pft indices + integer, intent(in) :: begc, endc ! per-proc beginning and ending column indices + integer, intent(in) :: begl, endl ! per-proc beginning and ending landunit indices + integer, intent(in) :: begg, endg ! per-proc gridcell ending gridcell indices +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: hpindex ! history pointer index + integer :: k ! gridcell, landunit, column or pft index + integer :: l ! landunit index + integer :: beg1d,end1d ! beginning and ending indices + logical :: checkwt ! true => check weight of pft relative to gridcell + logical :: valid ! true => history operation is valid + logical :: map2gcell ! true => map clm pointer field to gridcell + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=1) :: avgflag ! time averaging flag + character(len=8) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=8) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: plandunit(:) ! pft's landunit index + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: field(:) ! clm 1d pointer field + real(r8) :: field_gcell(begg:endg) ! gricell level field (used if mapping to gridcell is done) + integer j + character(len=*),parameter :: subname = 'hist_update_hbuf_field_1d' +!----------------------------------------------------------------------- + + avgflag = tape(t)%hlist(f)%avgflag + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + type1d = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + hpindex = tape(t)%hlist(f)%field%hpindex + field => clmptr_rs(hpindex)%ptr + + ! set variables to check weights when allocate all pfts + + map2gcell = .false. + if (type1d_out == nameg .or. type1d_out == grlnd) then + if (type1d == namep) then + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, field, field_gcell, & + p2c_scale_type, c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namec) then + call c2g(begc, endc, begl, endl, begg, endg, field, field_gcell, & + c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namel) then + call l2g(begl, endl, begg, endg, field, field_gcell, & + l2g_scale_type) + map2gcell = .true. + end if + end if + + if (map2gcell) then ! Map to gridcell + + ! note that in this case beg1d = begg and end1d=endg + select case (avgflag) + case ('I') ! Instantaneous + do k = begg,endg + if (field_gcell(k) /= spval) then + hbuf(k,1) = field_gcell(k) + else + hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('A') ! Time average + do k = begg,endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field_gcell(k) + nacs(k,1) = nacs(k,1) + 1 + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case ('X') ! Maximum over time + do k = begg,endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8 + hbuf(k,1) = max( hbuf(k,1), field_gcell(k) ) + else + hbuf(k,1) = spval + endif + nacs(k,1) = 1 + end do + case ('M') ! Minimum over time + do k = begg,endg + if (field_gcell(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8 + hbuf(k,1) = min( hbuf(k,1), field_gcell(k) ) + else + hbuf(k,1) = spval + endif + nacs(k,1) = 1 + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun() + end select + + else ! Do not map to gridcell + + pwtgcell => pft%wtgcell + plandunit => pft%landunit + ltype => lun%itype + + checkwt = .false. + if (type1d == namep) checkwt = .true. + + select case (avgflag) + case ('I') ! Instantaneous + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + ! Note: some glacier_mec pfts may have zero weight and still be considered valid + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + hbuf(k,1) = field(k) + else + hbuf(k,1) = spval + end if + else + hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('A') ! Time average + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = 0._r8 + hbuf(k,1) = hbuf(k,1) + field(k) + nacs(k,1) = nacs(k,1) + 1 + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + end do + case ('X') ! Maximum over time + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = -1.e50_r8 + hbuf(k,1) = max( hbuf(k,1), field(k) ) + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case ('M') ! Minimum over time + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k) /= spval) then + if (nacs(k,1) == 0) hbuf(k,1) = +1.e50_r8 + hbuf(k,1) = min( hbuf(k,1), field(k) ) + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + else + if (nacs(k,1) == 0) hbuf(k,1) = spval + end if + nacs(k,1) = 1 + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun() + end select + end if + + end subroutine hist_update_hbuf_field_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_update_hbuf_field_2d +! +! !INTERFACE: + subroutine hist_update_hbuf_field_2d (t, f, begp, endp, begc, endc, begl, endl, begg, endg, num2d) +! +! !DESCRIPTION: +! Accumulate (or take min, max, etc. as appropriate) input field +! into its history buffer for appropriate tapes. +! +! !USES: + use clmtype + use subgridAveMod, only : p2g, c2g, l2g + use clm_varcon , only : istice_mec +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + integer, intent(in) :: f ! field index + integer, intent(in) :: begp, endp ! per-proc beginning and ending pft indices + integer, intent(in) :: begc, endc ! per-proc beginning and ending column indices + integer, intent(in) :: begl, endl ! per-proc beginning and ending landunit indices + integer, intent(in) :: begg, endg ! per-proc gridcell ending gridcell indices + integer, intent(in) :: num2d ! size of second dimension +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: hpindex ! history pointer index + integer :: k ! gridcell, landunit, column or pft index + integer :: l ! landunit index + integer :: j ! level index + integer :: beg1d,end1d ! beginning and ending indices + logical :: checkwt ! true => check weight of pft relative to gridcell + logical :: valid ! true => history operation is valid + logical :: map2gcell ! true => map clm pointer field to gridcell + character(len=8) :: type1d ! 1d clm pointerr type ["gridcell","landunit","column","pft"] + character(len=8) :: type1d_out ! 1d history buffer type ["gridcell","landunit","column","pft"] + character(len=1) :: avgflag ! time averaging flag + character(len=8) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=8) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + integer , pointer :: ltype(:) ! landunit type + integer , pointer :: plandunit(:) ! pft's landunit index + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: field(:,:) ! clm 2d pointer field + real(r8) :: field_gcell(begg:endg,num2d) ! gricell level field (used if mapping to gridcell is done) + character(len=*),parameter :: subname = 'hist_update_hbuf_field_2d' +!----------------------------------------------------------------------- + + avgflag = tape(t)%hlist(f)%avgflag + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + type1d = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + p2c_scale_type = tape(t)%hlist(f)%field%p2c_scale_type + c2l_scale_type = tape(t)%hlist(f)%field%c2l_scale_type + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + hpindex = tape(t)%hlist(f)%field%hpindex + field => clmptr_ra(hpindex)%ptr(:,1:num2d) + + ! set variables to check weights when allocate all pfts + + map2gcell = .false. + if (type1d_out == nameg .or. type1d_out == grlnd) then + if (type1d == namep) then + call p2g(begp, endp, begc, endc, begl, endl, begg, endg, num2d, field, field_gcell, & + p2c_scale_type, c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namec) then + call c2g(begc, endc, begl, endl, begg, endg, num2d, field, field_gcell, & + c2l_scale_type, l2g_scale_type) + map2gcell = .true. + else if (type1d == namel) then + call l2g(begl, endl, begg, endg, num2d, field, field_gcell, & + l2g_scale_type) + map2gcell = .true. + end if + end if + + if (map2gcell) then ! Map to gridcell + + ! note that in this case beg1d = begg and end1d=endg + select case (avgflag) + case ('I') ! Instantaneous + do j = 1,num2d + do k = begg,endg + if (field_gcell(k,j) /= spval) then + hbuf(k,j) = field_gcell(k,j) + else + hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('A') ! Time average + do j = 1,num2d + do k = begg,endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field_gcell(k,j) + nacs(k,j) = nacs(k,j) + 1 + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + endif + end do + end do + case ('X') ! Maximum over time + do j = 1,num2d + do k = begg,endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8 + hbuf(k,j) = max( hbuf(k,j), field_gcell(k,j) ) + else + hbuf(k,j) = spval + endif + nacs(k,j) = 1 + end do + end do + case ('M') ! Minimum over time + do j = 1,num2d + do k = begg,endg + if (field_gcell(k,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8 + hbuf(k,j) = min( hbuf(k,j), field_gcell(k,j) ) + else + hbuf(k,j) = spval + endif + nacs(k,j) = 1 + end do + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun() + end select + + else ! Do not map to gridcell + + ! Note that since field points to an array section the + ! bounds are field(1:end1d-beg1d+1, num2d) - therefore + ! need to do the shifting below + + pwtgcell => pft%wtgcell + plandunit => pft%landunit + ltype => lun%itype + + checkwt = .false. + if (type1d == namep) checkwt = .true. + + select case (avgflag) + case ('I') ! Instantaneous + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + hbuf(k,j) = field(k-beg1d+1,j) + else + hbuf(k,j) = spval + end if + else + hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('A') ! Time average + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = 0._r8 + hbuf(k,j) = hbuf(k,j) + field(k-beg1d+1,j) + nacs(k,j) = nacs(k,j) + 1 + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + end do + end do + case ('X') ! Maximum over time + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = -1.e50_r8 + hbuf(k,j) = max( hbuf(k,j), field(k-beg1d+1,j) ) + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case ('M') ! Minimum over time + do j = 1,num2d + do k = beg1d,end1d + valid = .true. + if (checkwt) then + l = plandunit(k) + if (pwtgcell(k) == 0._r8 .and. ltype(l)/=istice_mec) valid = .false. + end if + if (valid) then + if (field(k-beg1d+1,j) /= spval) then + if (nacs(k,j) == 0) hbuf(k,j) = +1.e50_r8 + hbuf(k,j) = min( hbuf(k,j), field(k-beg1d+1,j)) + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + else + if (nacs(k,j) == 0) hbuf(k,j) = spval + end if + nacs(k,j) = 1 + end do + end do + case default + write(iulog,*) trim(subname),' ERROR: invalid time averaging flag ', avgflag + call endrun() + end select + end if + + end subroutine hist_update_hbuf_field_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hfields_normalize +! +! !INTERFACE: + subroutine hfields_normalize (t) +! +! !DESCRIPTION: +! Normalize fields on a history file by the number of accumulations. +! Loop over fields on the tape. Need averaging flag and number of +! accumulations to perform normalization. +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + integer :: k ! 1d index + integer :: j ! 2d index + logical :: aflag ! averaging flag + integer :: beg1d_out,end1d_out ! hbuf 1d beginning and ending indices + integer :: num2d ! hbuf size of second dimension (e.g. number of vertical levels) + character(len=1) :: avgflag ! averaging flag + real(r8), pointer :: hbuf(:,:) ! history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + character(len=*),parameter :: subname = 'hfields_normalize' +!----------------------------------------------------------------------- +!dir$ inlinenever hfields_normalize + + ! Normalize by number of accumulations for time averaged case + + do f = 1,tape(t)%nflds + avgflag = tape(t)%hlist(f)%avgflag + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + num2d = tape(t)%hlist(f)%field%num2d + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (avgflag == 'A') then + aflag = .true. + else + aflag = .false. + end if + + do j = 1, num2d + do k = beg1d_out, end1d_out + if (aflag .and. nacs(k,j) /= 0) then + hbuf(k,j) = hbuf(k,j) / float(nacs(k,j)) + end if + end do + end do + end do + + end subroutine hfields_normalize + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hfields_zero +! +! !INTERFACE: + subroutine hfields_zero (t) +! +! !DESCRIPTION: +! Zero out accumulation and history buffers for a given history tape. +! Loop through fields on the tape. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + character(len=*),parameter :: subname = 'hfields_zero' +!----------------------------------------------------------------------- + + do f = 1,tape(t)%nflds + tape(t)%hlist(f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(f)%nacs(:,:) = 0 + end do + + end subroutine hfields_zero + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: htape_create +! +! !INTERFACE: + subroutine htape_create (t, histrest) +! +! !DESCRIPTION: +! Define contents of history file t. Issue the required netcdf +! wrapper calls to define the history file contents. +! +! !USES: + use clmtype + use clm_varpar , only : nlevgrnd, nlevlak, numrad, maxpatch_glcmec + use clm_varctl , only : caseid, ctitle, fsurdat, finidat, fpftcon, & + version, hostname, username, conventions, source + use domainMod , only : ldomain + use fileutils , only : get_filename +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + logical, intent(in), optional :: histrest ! if creating the history restart file +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + integer :: p,c,l,n ! indices + integer :: ier ! error code + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + integer :: dimid ! dimension id temporary + integer :: dim1id(1) ! netCDF dimension id + integer :: dim2id(2) ! netCDF dimension id + integer :: ndims ! dimension counter + integer :: omode ! returned mode from netCDF call + integer :: ncprec ! output netCDF write precision + integer :: ret ! netCDF error status + integer :: nump ! total number of pfts across all processors + integer :: numc ! total number of columns across all processors + integer :: numl ! total number of landunits across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numa ! total number of atm cells across all processors + logical :: lhistrest ! local history restart flag + type(file_desc_t) :: lnfid ! local file id + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len=256) :: name ! name of attribute + character(len=256) :: units ! units of attribute + character(len=256) :: str ! global attribute string + character(len= 1) :: avgflag ! time averaging flag + character(len=*),parameter :: subname = 'htape_create' +!----------------------------------------------------------------------- + + if ( present(histrest) )then + lhistrest = histrest + else + lhistrest = .false. + end if + + ! Determine necessary indices + + call get_proc_global(numg, numl, numc, nump) + + ! define output write precsion for tape + + ncprec = tape(t)%ncprec + + ! Create new netCDF file. It will be in define mode + + if ( .not. lhistrest )then + if (masterproc) then + write(iulog,*) trim(subname),' : Opening netcdf htape ', & + trim(locfnh(t)) + call shr_sys_flush(iulog) + end if + call ncd_pio_createfile(lnfid, trim(locfnh(t))) + call ncd_putatt(lnfid, ncd_global, 'title', 'CLM History file information' ) + call ncd_putatt(lnfid, ncd_global, 'comment', & + "NOTE: None of the variables are weighted by land fraction!" ) + else + if (masterproc) then + write(iulog,*) trim(subname),' : Opening netcdf rhtape ', & + trim(locfnhr(t)) + call shr_sys_flush(iulog) + end if + call ncd_pio_createfile(lnfid, trim(locfnhr(t))) + call ncd_putatt(lnfid, ncd_global, 'title', & + 'CLM Restart History information, required to continue a simulation' ) + call ncd_putatt(lnfid, ncd_global, 'comment', & + "This entire file NOT needed for startup or branch simulations") + end if + + ! Create global attributes. Attributes are used to store information + ! about the data set. Global attributes are information about the + ! data set as a whole, as opposed to a single variable + + call ncd_putatt(lnfid, ncd_global, 'Conventions', trim(conventions)) + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(lnfid, ncd_global, 'history' , trim(str)) + call ncd_putatt(lnfid, ncd_global, 'source' , trim(source)) + call ncd_putatt(lnfid, ncd_global, 'hostname', trim(hostname)) + call ncd_putatt(lnfid, ncd_global, 'username', trim(username)) + call ncd_putatt(lnfid, ncd_global, 'version' , trim(version)) + + str = & + '$Id: histFileMod.F90 69896 2015-04-10 20:25:18Z erik $' + call ncd_putatt(lnfid, ncd_global, 'revision_id', trim(str)) + call ncd_putatt(lnfid, ncd_global, 'case_title', trim(ctitle)) + call ncd_putatt(lnfid, ncd_global, 'case_id', trim(caseid)) + str = get_filename(fsurdat) + call ncd_putatt(lnfid, ncd_global, 'Surface_dataset', trim(str)) + if (finidat == ' ') then + str = 'arbitrary initialization' + else + str = get_filename(finidat) + endif + call ncd_putatt(lnfid, ncd_global, 'Initial_conditions_dataset', trim(str)) + str = get_filename(fpftcon) + call ncd_putatt(lnfid, ncd_global, 'PFT_physiological_constants_dataset', trim(str)) + + ! Define dimensions. + ! Time is an unlimited dimension. Character string is treated as an array of characters. + + ! Global uncompressed dimensions (including non-land points) + if (ldomain%isgrid2d) then + call ncd_defdim(lnfid, 'lon' , ldomain%ni, dimid) + call ncd_defdim(lnfid, 'lat' , ldomain%nj, dimid) + else + call ncd_defdim(lnfid, trim(grlnd), ldomain%ns, dimid) + end if + + ! Global compressed dimensions (not including non-land points) + call ncd_defdim(lnfid, trim(nameg), numg, dimid) + call ncd_defdim(lnfid, trim(namel), numl, dimid) + call ncd_defdim(lnfid, trim(namec), numc, dimid) + call ncd_defdim(lnfid, trim(namep), nump, dimid) + + ! "level" dimensions + call ncd_defdim(lnfid, 'levgrnd', nlevgrnd, dimid) + call ncd_defdim(lnfid, 'levlak' , nlevlak, dimid) + call ncd_defdim(lnfid, 'numrad' , numrad , dimid) + if (maxpatch_glcmec > 0) then + call ncd_defdim(lnfid, 'glc_nec' , maxpatch_glcmec , dimid) + end if + + do n = 1,num_subs + call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid) + end do + call ncd_defdim(lnfid, 'string_length', 8, strlen_dimid) + + if ( .not. lhistrest )then + call ncd_defdim(lnfid, 'hist_interval', 2, hist_interval_dimid) + call ncd_defdim(lnfid, 'time', ncd_unlimited, time_dimid) + nfid(t) = lnfid + if (masterproc)then + write(iulog,*) trim(subname), & + ' : Successfully defined netcdf history file ',t + call shr_sys_flush(iulog) + end if + else + ncid_hist(t) = lnfid + if (masterproc)then + write(iulog,*) trim(subname), & + ' : Successfully defined netcdf restart history file ',t + call shr_sys_flush(iulog) + end if + end if + + end subroutine htape_create + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: htape_timeconst3D +! +! !INTERFACE: + subroutine htape_timeconst3D(t, mode) +! +! !DESCRIPTION: +! Write time constant 3D variables to history tapes. +! Only write out when this subroutine is called (normally only for +! primary history files at very first time-step, nstep=0). +! Issue the required netcdf wrapper calls to define the history file +! contents. +! +! !USES: + use clmtype + use subgridAveMod , only : c2g + use clm_varpar , only : nlevgrnd + use shr_string_mod, only : shr_string_listAppend + use domainMod , only : ldomain +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: c,l,lev,ifld ! indices + integer :: ier ! error status + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + character(len=max_chars) :: long_name ! variable long name + character(len=max_namlen):: varname ! variable name + character(len=max_namlen):: units ! variable units + character(len=8) :: l2g_scale_type ! scale type for subgrid averaging of landunits to grid cells + real(r8), pointer :: histi(:,:) ! temporary + real(r8), pointer :: histo(:,:) ! temporary + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + integer, parameter :: nflds = 6 ! Number of 3D time-constant fields + character(len=*),parameter :: subname = 'htape_timeconst3D' + character(len=*),parameter :: varnames(nflds) = (/ & + 'ZSOI ', & + 'DZSOI ', & + 'WATSAT', & + 'SUCSAT', & + 'BSW ', & + 'HKSAT ' & + /) +!----------------------------------------------------------------------- + +!------------------------------------------------------------------------------- +!*** Non-time varying 3D fields *** +!*** Only write out when this subroutine is called *** +!*** Normally only called once for primary tapes *** +!------------------------------------------------------------------------------- + + if (mode == 'define') then + + do ifld = 1,nflds + ! Field indices MUST match varnames array order above! + if (ifld == 1) then + long_name='soil depth'; units = 'm' + else if (ifld == 2) then + long_name='soil thickness'; units = 'm' + else if (ifld == 3) then + long_name='saturated soil water content (porosity)'; units = 'mm3/mm3' + else if (ifld == 4) then + long_name='saturated soil matric potential'; units = 'mm' + else if (ifld == 5) then + long_name='slope of soil water retention curve'; units = 'unitless' + else if (ifld == 6) then + long_name='saturated hydraulic conductivity'; units = 'unitless' + else + call endrun( subname//' ERROR: bad 3D time-constant field index' ) + end if + if (tape(t)%dov2xy) then + if (ldomain%isgrid2d) then + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec,& + dim1name='lon', dim2name='lat', dim3name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + dim1name=grlnd, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + else + call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & + dim1name=namec, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval) + end if + call shr_string_listAppend(TimeConst3DVars,varnames(ifld)) + end do + + else if (mode == 'write') then + + ! Set pointers into derived type and get necessary bounds + + lptr => lun + cptr => col + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + allocate(histi(begc:endc,nlevgrnd), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histi'; call endrun() + end if + + ! Write time constant fields + + if (tape(t)%dov2xy) then + allocate(histo(begg:endg,nlevgrnd), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for histo'; call endrun() + end if + end if + + do ifld = 1,nflds + + ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are + ! currently constant in space, except for urban points, so their scale type + ! doesn't matter at the moment as long as it excludes urban points. I am using + ! 'nonurb' so that the values are output everywhere where the fields are + ! constant (i.e., everywhere except urban points). For the other fields, I am + ! using 'veg' to be consistent with the l2g_scale_type that is now used for many + ! of the 3-d time-variant fields; in theory, though, one might want versions of + ! these variables output for different landunits. + + ! Field indices MUST match varnames array order above! + if (ifld == 1) then ! ZSOI + l2g_scale_type = 'nonurb' + else if (ifld == 2) then ! DZSOI + l2g_scale_type = 'nonurb' + else if (ifld == 3) then ! WATSAT + l2g_scale_type = 'veg' + else if (ifld == 4) then ! SUCSAT + l2g_scale_type = 'veg' + else if (ifld == 5) then ! BSW + l2g_scale_type = 'veg' + else if (ifld == 6) then ! HKSAT + l2g_scale_type = 'veg' + end if + + histi(:,:) = spval + do lev = 1,nlevgrnd + do c = begc, endc + l = cptr%landunit(c) + if (.not. lptr%lakpoi(l)) then + ! Field indices MUST match varnames array order above! + if (ifld ==1) histi(c,lev) = cps%z(c,lev) + if (ifld ==2) histi(c,lev) = cps%dz(c,lev) + if (ifld ==3) histi(c,lev) = cps%watsat(c,lev) + if (ifld ==4) histi(c,lev) = cps%sucsat(c,lev) + if (ifld ==5) histi(c,lev) = cps%bsw(c,lev) + if (ifld ==6) histi(c,lev) = cps%hksat(c,lev) + end if + end do + end do + if (tape(t)%dov2xy) then + histo(:,:) = spval + call c2g(begc, endc, begl, endl, begg, endg, nlevgrnd, histi, histo, & + c2l_scale_type='unity', l2g_scale_type=l2g_scale_type) + + if (ldomain%isgrid2d) then + call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & + data=histo, ncid=nfid(t), flag='write') + else + call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & + data=histo, ncid=nfid(t), flag='write') + end if + else + call ncd_io(varname=trim(varnames(ifld)), dim1name=namec, & + data=histi, ncid=nfid(t), flag='write') + end if + end do + + if (tape(t)%dov2xy) deallocate(histo) + deallocate(histi) + + end if ! (define/write mode + + end subroutine htape_timeconst3D + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: htape_timeconst +! +! !INTERFACE: + subroutine htape_timeconst(t, mode) +! +! !DESCRIPTION: +! Write time constant values to primary history tape. +! Issue the required netcdf wrapper calls to define the history file +! contents. +! +! !USES: + use clmtype + use clm_varcon , only : zsoi, zlak, secspday + use domainMod , only : ldomain, lon1d, lat1d + use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time + use clm_time_manager, only : get_ref_date, get_calendar, NO_LEAP_C, GREGORIAN_C +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: vid,n,i,j,m ! indices + integer :: nstep ! current step + integer :: mcsec ! seconds of current date + integer :: mdcur ! current day + integer :: mscur ! seconds of current day + integer :: mcdate ! current date + integer :: yr,mon,day,nbsec ! year,month,day,seconds components of a date + integer :: hours,minutes,secs ! hours,minutes,seconds of hh:mm:ss + character(len= 10) :: basedate ! base date (yyyymmdd) + character(len= 8) :: basesec ! base seconds + character(len= 8) :: cdate ! system date + character(len= 8) :: ctime ! system time + real(r8):: time ! current time + real(r8):: timedata(2) ! time interval boundaries + integer :: dim1id(1) ! netCDF dimension id + integer :: dim2id(2) ! netCDF dimension id + integer :: varid ! netCDF variable id + type(Var_desc_t) :: vardesc ! netCDF variable description + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + character(len=max_chars) :: long_name ! variable long name + character(len=max_namlen):: varname ! variable name + character(len=max_namlen):: units ! variable units + character(len=max_namlen):: cal ! calendar from the time-manager + character(len=max_namlen):: caldesc ! calendar description to put on file + character(len=256):: str ! global attribute string + real(r8), pointer :: histo(:,:) ! temporary + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + integer :: status + + character(len=*),parameter :: subname = 'htape_timeconst' +!----------------------------------------------------------------------- + + !------------------------------------------------------------------------------- + !*** Time constant grid variables only on first time-sample of file *** + !------------------------------------------------------------------------------- + if (tape(t)%ntimes == 1) then + if (mode == 'define') then + call ncd_defvar(varname='levgrnd', xtype=tape(t)%ncprec, & + dim1name='levgrnd', & + long_name='coordinate soil levels', units='m', ncid=nfid(t)) + call ncd_defvar(varname='levlak', xtype=tape(t)%ncprec, & + dim1name='levlak', & + long_name='coordinate lake levels', units='m', ncid=nfid(t)) + elseif (mode == 'write') then + call ncd_io(varname='levgrnd', data=zsoi , ncid=nfid(t), flag='write') + call ncd_io(varname='levlak' , data=zlak , ncid=nfid(t), flag='write') + endif + endif + + !------------------------------------------------------------------------------- + !*** Time definition variables *** + !------------------------------------------------------------------------------- + + ! For define mode -- only do this for first time-sample + if (mode == 'define' .and. tape(t)%ntimes == 1) then + call get_ref_date(yr, mon, day, nbsec) + nstep = get_nstep() + hours = nbsec / 3600 + minutes = (nbsec - hours*3600) / 60 + secs = (nbsec - hours*3600 - minutes*60) + write(basedate,80) yr,mon,day +80 format(i4.4,'-',i2.2,'-',i2.2) + write(basesec ,90) hours, minutes, secs +90 format(i2.2,':',i2.2,':',i2.2) + + dim1id(1) = time_dimid + str = 'days since ' // basedate // " " // basesec + call ncd_defvar(nfid(t), 'time', tape(t)%ncprec, 1, dim1id, varid, & + long_name='time',units=str) + cal = get_calendar() + if ( trim(cal) == NO_LEAP_C )then + caldesc = "noleap" + else if ( trim(cal) == GREGORIAN_C )then + caldesc = "gregorian" + end if + call ncd_putatt(nfid(t), varid, 'calendar', caldesc) + call ncd_putatt(nfid(t), varid, 'bounds', 'time_bounds') + + dim1id(1) = time_dimid + call ncd_defvar(nfid(t) , 'mcdate', ncd_int, 1, dim1id , varid, & + long_name = 'current date (YYYYMMDD)') + call ncd_defvar(nfid(t) , 'mcsec' , ncd_int, 1, dim1id , varid, & + long_name = 'current seconds of current date', units='s') + call ncd_defvar(nfid(t) , 'mdcur' , ncd_int, 1, dim1id , varid, & + long_name = 'current day (from base day)') + call ncd_defvar(nfid(t) , 'mscur' , ncd_int, 1, dim1id , varid, & + long_name = 'current seconds of current day') + call ncd_defvar(nfid(t) , 'nstep' , ncd_int, 1, dim1id , varid, & + long_name = 'time step') + + dim2id(1) = hist_interval_dimid; dim2id(2) = time_dimid + call ncd_defvar(nfid(t), 'time_bounds', ncd_double, 2, dim2id, varid, & + long_name = 'history time interval endpoints') + + dim2id(1) = strlen_dimid; dim2id(2) = time_dimid + call ncd_defvar(nfid(t), 'date_written', ncd_char, 2, dim2id, varid) + call ncd_defvar(nfid(t), 'time_written', ncd_char, 2, dim2id, varid) + + if ( len_trim(TimeConst3DVars_Filename) > 0 )then + call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars_filename', & + trim(TimeConst3DVars_Filename)) + end if + if ( len_trim(TimeConst3DVars) > 0 )then + call ncd_putatt(nfid(t), ncd_global, 'Time_constant_3Dvars', & + trim(TimeConst3DVars)) + end if + + elseif (mode == 'write') then + + call get_curr_time (mdcur, mscur) + call get_curr_date (yr, mon, day, mcsec) + mcdate = yr*10000 + mon*100 + day + nstep = get_nstep() + + call ncd_io('mcdate', mcdate, 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mcsec' , mcsec , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mdcur' , mdcur , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('mscur' , mscur , 'write', nfid(t), nt=tape(t)%ntimes) + call ncd_io('nstep' , nstep , 'write', nfid(t), nt=tape(t)%ntimes) + + time = mdcur + mscur/secspday + call ncd_io('time' , time , 'write', nfid(t), nt=tape(t)%ntimes) + + timedata(1) = tape(t)%begtime + timedata(2) = time + call ncd_io('time_bounds', timedata, 'write', nfid(t), nt=tape(t)%ntimes) + + call getdatetime (cdate, ctime) + call ncd_io('date_written', cdate, 'write', nfid(t), nt=tape(t)%ntimes) + + call ncd_io('time_written', ctime, 'write', nfid(t), nt=tape(t)%ntimes) + + endif + + !------------------------------------------------------------------------------- + !*** Grid definition variables *** + !------------------------------------------------------------------------------- + ! For define mode -- only do this for first time-sample + if (mode == 'define' .and. tape(t)%ntimes == 1) then + + if (ldomain%isgrid2d) then + call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, dim1name='lon', & + long_name='coordinate longitude', units='degrees_east', & + ncid=nfid(t), missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='lon', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='coordinate longitude', units='degrees_east', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, dim1name='lat', & + long_name='coordinate latitude', units='degrees_north', & + ncid=nfid(t), missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='lat', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='coordinate latitude', units='degrees_north', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat',& + long_name='grid cell areas', units='km^2', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='area', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='grid cell areas', units='km^2', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & + dim1name='lon', dim2name='lat', & + long_name='land fraction', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(varname='landfrac', xtype=tape(t)%ncprec, & + dim1name=grlnd, & + long_name='land fraction', ncid=nfid(t), & + missing_value=spval, fill_value=spval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='landmask', xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + else + call ncd_defvar(varname='landmask', xtype=ncd_int, & + dim1name=grlnd, & + long_name='land/ocean mask (0.=ocean and 1.=land)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + end if + if (ldomain%isgrid2d) then + call ncd_defvar(varname='pftmask' , xtype=ncd_int, & + dim1name='lon', dim2name='lat', & + long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + else + call ncd_defvar(varname='pftmask' , xtype=ncd_int, & + dim1name=grlnd, & + long_name='pft real/fake mask (0.=fake and 1.=real)', ncid=nfid(t), & + imissing_value=ispval, ifill_value=ispval) + end if + else if (mode == 'write') then + + ! Most of this is constant and only needs to be done on tape(t)%ntimes=1 + ! But, some may change for dynamic PFT mode for example + ! Set pointers into derived type and get necessary bounds + + lptr => lun + cptr => col + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + if (ldomain%isgrid2d) then + call ncd_io(varname='lon', data=lon1d, ncid=nfid(t), flag='write') + call ncd_io(varname='lat', data=lat1d, ncid=nfid(t), flag='write') + else + call ncd_io(varname='lon', data=ldomain%lonc, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='lat', data=ldomain%latc, dim1name=grlnd, ncid=nfid(t), flag='write') + end if + call ncd_io(varname='area' , data=ldomain%area, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='landfrac', data=ldomain%frac, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='landmask', data=ldomain%mask, dim1name=grlnd, ncid=nfid(t), flag='write') + call ncd_io(varname='pftmask' , data=ldomain%pftm, dim1name=grlnd, ncid=nfid(t), flag='write') + end if ! (define/write mode + + end subroutine htape_timeconst + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hfields_write +! +! !INTERFACE: + subroutine hfields_write(t, mode) +! +! !DESCRIPTION: +! Write history tape. Issue the call to write the variable. +! +! !USES: + use clmtype + use domainMod , only : ldomain +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + integer :: k ! 1d index + integer :: c,l,p ! indices + integer :: beg1d_out ! on-node 1d hbuf pointer start index + integer :: end1d_out ! on-node 1d hbuf pointer end index + integer :: num1d_out ! size of hbuf first dimension (overall all nodes) + integer :: num2d ! hbuf second dimension size + integer :: nt ! time index + integer :: ier ! error status + character(len=1) :: avgflag ! time averaging flag + character(len=max_chars) :: long_name! long name + character(len=max_chars) :: units ! units + character(len=max_namlen):: varname ! variable name + character(len=32) :: avgstr ! time averaging type + character(len=8) :: type1d_out ! history output 1d type + character(len=8) :: type2d ! history output 2d type + character(len=32) :: dim1name ! temporary + character(len=32) :: dim2name ! temporary + real(r8), pointer :: histo(:,:) ! temporary + real(r8), pointer :: hist1do(:) ! temporary + character(len=*),parameter :: subname = 'hfields_write' +!----------------------------------------------------------------------- + + ! Write/define 1d topological info + + if (.not. tape(t)%dov2xy) then + if (mode == 'define') then + call hfields_1dinfo(t, mode='define') + else if (mode == 'write') then + call hfields_1dinfo(t, mode='write') + end if + end if + + ! Define time-dependent variables create variables and attributes for field list + + do f = 1,tape(t)%nflds + + ! Set history field variables + + varname = tape(t)%hlist(f)%field%name + long_name = tape(t)%hlist(f)%field%long_name + units = tape(t)%hlist(f)%field%units + avgflag = tape(t)%hlist(f)%avgflag + type1d_out = tape(t)%hlist(f)%field%type1d_out + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + num1d_out = tape(t)%hlist(f)%field%num1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + nt = tape(t)%ntimes + + if (mode == 'define') then + + select case (avgflag) + case ('A') + avgstr = 'mean' + case ('I') + avgstr = 'instantaneous' + case ('X') + avgstr = 'maximum' + case ('M') + avgstr = 'minimum' + case default + write(iulog,*) trim(subname),' ERROR: unknown time averaging flag (avgflag)=',avgflag; call endrun() + end select + + if (type1d_out == grlnd) then + if (ldomain%isgrid2d) then + dim1name = 'lon' ; dim2name = 'lat' + else + dim1name = trim(grlnd); dim2name = 'undefined' + end if + else + dim1name = type1d_out ; dim2name = 'undefined' + endif + + if (dim2name == 'undefined') then + if (num2d == 1) then + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=type2d, dim3name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + end if + else + if (num2d == 1) then + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=dim2name, dim3name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + else + call ncd_defvar(ncid=nfid(t), varname=varname, xtype=tape(t)%ncprec, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, dim4name='time', & + long_name=long_name, units=units, cell_method=avgstr, & + missing_value=spval, fill_value=spval) + end if + endif + + else if (mode == 'write') then + + ! Determine output buffer + + histo => tape(t)%hlist(f)%hbuf + + ! Allocate dynamic memory + + if (num2d == 1) then + allocate(hist1do(beg1d_out:end1d_out), stat=ier) + if (ier /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation'; call endrun() + end if + hist1do(beg1d_out:end1d_out) = histo(beg1d_out:end1d_out,1) + end if + + ! Write history output. Always output land and ocean runoff on xy grid. + + if (num2d == 1) then + call ncd_io(flag='write', varname=varname, & + dim1name=type1d_out, data=hist1do, ncid=nfid(t), nt=nt) + else + call ncd_io(flag='write', varname=varname, & + dim1name=type1d_out, data=histo, ncid=nfid(t), nt=nt) + end if + + + ! Deallocate dynamic memory + + if (num2d == 1) then + deallocate(hist1do) + end if + + end if + + end do + + end subroutine hfields_write + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hfields_1dinfo +! +! !INTERFACE: + subroutine hfields_1dinfo(t, mode) +! +! !DESCRIPTION: +! Write/define 1d info for history tape. +! +! !USES: + use clmtype + use decompMod , only : ldecomp + use domainMod , only : ldomain, ldomain +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: t ! tape index + character(len=*), intent(in) :: mode ! 'define' or 'write' +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: f ! field index + integer :: k ! 1d index + integer :: g,c,l,p ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: ier ! errir status + real(r8), pointer :: rgarr(:) ! temporary + real(r8), pointer :: rcarr(:) ! temporary + real(r8), pointer :: rlarr(:) ! temporary + real(r8), pointer :: rparr(:) ! temporary + integer , pointer :: igarr(:) ! temporary + integer , pointer :: icarr(:) ! temporary + integer , pointer :: ilarr(:) ! temporary + integer , pointer :: iparr(:) ! temporary + type(file_desc_t) :: ncid ! netcdf file + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + character(len=*),parameter :: subname = 'hfields_1dinfo' +!----------------------------------------------------------------------- + + ncid = nfid(t) + + if (mode == 'define') then + + ! Define gridcell info + + call ncd_defvar(varname='grid1d_lon', xtype=ncd_double, dim1name=nameg, & + long_name='gridcell longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='grid1d_lat', xtype=ncd_double, dim1name=nameg, & + long_name='gridcell latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='grid1d_ixy', xtype=ncd_int, dim1name=nameg, & + long_name='2d longitude index of corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='grid1d_jxy', xtype=ncd_int, dim1name=nameg, & + long_name='2d latitude index of corresponding gridcell', ncid=ncid) + + ! Define landunit info + + call ncd_defvar(varname='land1d_lon', xtype=ncd_double, dim1name=namel, & + long_name='landunit longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='land1d_lat', xtype=ncd_double, dim1name=namel, & + long_name='landunit latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='land1d_ixy', xtype=ncd_int, dim1name=namel, & + long_name='2d longitude index of corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, & + long_name='2d latitude index of corresponding landunit', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', & + ! long_name='1d grid index of corresponding landunit', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, & + long_name='landunit weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='land1d_ityplunit', xtype=ncd_int, dim1name=namel, & + long_name='landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + ! Define column info + + call ncd_defvar(varname='cols1d_lon', xtype=ncd_double, dim1name=namec, & + long_name='column longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='cols1d_lat', xtype=ncd_double, dim1name=namec, & + long_name='column latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='cols1d_ixy', xtype=ncd_int, dim1name=namec, & + long_name='2d longitude index of corresponding column', ncid=ncid) + + call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, & + long_name='2d latitude index of corresponding column', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', & + ! long_name='1d grid index of corresponding column', ncid=ncid) + + !call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', & + ! long_name='1d landunit index of corresponding column', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, & + long_name='column weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='cols1d_wtlunit', xtype=ncd_double, dim1name=namec, & + long_name='column weight relative to corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='cols1d_itype_lunit', xtype=ncd_int, dim1name=namec, & + long_name='column landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + ! Define pft info + + call ncd_defvar(varname='pfts1d_lon', xtype=ncd_double, dim1name=namep, & + long_name='pft longitude', units='degrees_east', ncid=ncid) + + call ncd_defvar(varname='pfts1d_lat', xtype=ncd_double, dim1name=namep, & + long_name='pft latitude', units='degrees_north', ncid=ncid) + + call ncd_defvar(varname='pfts1d_ixy', xtype=ncd_int, dim1name=namep, & + long_name='2d longitude index of corresponding pft', ncid=ncid) + + call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, & + long_name='2d latitude index of corresponding pft', ncid=ncid) + + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', & + ! long_name='1d grid index of corresponding pft', ncid=ncid) + + !call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', & + ! long_name='1d landunit index of corresponding pft', ncid=ncid) + + !call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', & + ! long_name='1d column index of corresponding pft', ncid=ncid) + ! ---------------------------------------------------------------- + + call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding gridcell', ncid=ncid) + + call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding landunit', ncid=ncid) + + call ncd_defvar(varname='pfts1d_wtcol', xtype=ncd_double, dim1name=namep, & + long_name='pft weight relative to corresponding column', ncid=ncid) + + call ncd_defvar(varname='pfts1d_itype_veg', xtype=ncd_int, dim1name=namep, & + long_name='pft vegetation type', ncid=ncid) + + call ncd_defvar(varname='pfts1d_itype_lunit', xtype=ncd_int, dim1name=namep, & + long_name='pft landunit type (vegetated,urban,lake,wetland,glacier or glacier_mec)', & + ncid=ncid) + + else if (mode == 'write') then + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ! Determine bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + allocate(rgarr(begg:endg),rlarr(begl:endl),rcarr(begc:endc),rparr(begp:endp),stat=ier) + if (ier /= 0) call endrun('hfields_1dinfo allocation error of rarrs') + + allocate(igarr(begg:endg),ilarr(begl:endl),icarr(begc:endc),iparr(begp:endp),stat=ier) + if (ier /= 0) call endrun('hfields_1dinfo allocation error of iarrs') + + ! Write gridcell info + + call ncd_io(varname='grid1d_lon', data=gptr%londeg, dim1name=nameg, ncid=ncid, flag='write') + call ncd_io(varname='grid1d_lat', data=gptr%latdeg, dim1name=nameg, ncid=ncid, flag='write') + do g=begg,endg + igarr(g)= mod(ldecomp%gdc2glo(g)-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='grid1d_ixy', data=igarr , dim1name=nameg, ncid=ncid, flag='write') + do g=begg,endg + igarr(g)= (ldecomp%gdc2glo(g) - 1)/ldomain%ni + 1 + enddo + call ncd_io(varname='grid1d_jxy', data=igarr , dim1name=nameg, ncid=ncid, flag='write') + + ! Write landunit info + + do l=begl,endl + rlarr(l) = gptr%londeg(lptr%gridcell(l)) + enddo + call ncd_io(varname='land1d_lon', data=rlarr, dim1name=namel, ncid=ncid, flag='write') + do l=begl,endl + rlarr(l) = gptr%latdeg(lptr%gridcell(l)) + enddo + call ncd_io(varname='land1d_lat', data=rlarr, dim1name=namel, ncid=ncid, flag='write') + do l=begl,endl + ilarr(l) = mod(ldecomp%gdc2glo(lptr%gridcell(l))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='land1d_ixy', data=ilarr, dim1name=namel, ncid=ncid, flag='write') + do l=begl,endl + ilarr(l) = (ldecomp%gdc2glo(lptr%gridcell(l))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='land1d_jxy' , data=ilarr , dim1name=namel, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 + !call ncd_io(varname='land1d_gi' , data=lptr%gridcell, dim1name=namel, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='land1d_wtgcell' , data=lptr%wtgcell , dim1name=namel, ncid=ncid, flag='write') + call ncd_io(varname='land1d_ityplunit', data=lptr%itype , dim1name=namel, ncid=ncid, flag='write') + + ! Write column info + + do c=begc,endc + rcarr(c) = gptr%londeg(cptr%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lon', data=rcarr, dim1name=namec, ncid=ncid, flag='write') + do c=begc,endc + rcarr(c) = gptr%latdeg(cptr%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lat', data=rcarr, dim1name=namec, ncid=ncid, flag='write') + do c=begc,endc + icarr(c) = mod(ldecomp%gdc2glo(cptr%gridcell(c))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='cols1d_ixy', data=icarr, dim1name=namec, ncid=ncid, flag='write') + do c=begc,endc + icarr(c) = (ldecomp%gdc2glo(cptr%gridcell(c))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='cols1d_jxy' , data=icarr ,dim1name=namec, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 + !call ncd_io(varname='cols1d_gi' , data=cptr%gridcell, dim1name=namec, ncid=ncid, flag='write') + !call ncd_io(varname='cols1d_li' , data=cptr%landunit, dim1name=namec, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='cols1d_wtgcell', data=cptr%wtgcell , dim1name=namec, ncid=ncid, flag='write') + call ncd_io(varname='cols1d_wtlunit', data=cptr%wtlunit , dim1name=namec, ncid=ncid, flag='write') + do c=begc,endc + icarr(c) = lptr%itype(cptr%landunit(c)) + enddo + call ncd_io(varname='cols1d_itype_lunit', data=icarr , dim1name=namec, ncid=ncid, flag='write') + + ! Write pft info + + do p=begp,endp + rparr(p) = gptr%londeg(pptr%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lon', data=rparr, dim1name=namep, ncid=ncid, flag='write') + do p=begp,endp + rparr(p) = gptr%latdeg(pptr%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lat', data=rparr, dim1name=namep, ncid=ncid, flag='write') + do p=begp,endp + iparr(p) = mod(ldecomp%gdc2glo(pptr%gridcell(p))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='pfts1d_ixy', data=iparr, dim1name=namep, ncid=ncid, flag='write') + do p=begp,endp + iparr(p) = (ldecomp%gdc2glo(pptr%gridcell(p))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag='write') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_io(varname='pfts1d_gi' , data=pptr%gridcell, dim1name=namep, ncid=ncid, flag='write') + !call ncd_io(varname='pfts1d_li' , data=pptr%landunit, dim1name=namep, ncid=ncid, flag='write') + !call ncd_io(varname='pfts1d_ci' , data=pptr%column , dim1name=namep, ncid=ncid, flag='write') + ! ---------------------------------------------------------------- + call ncd_io(varname='pfts1d_wtgcell' , data=pptr%wtgcell , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtlunit' , data=pptr%wtlunit , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtcol' , data=pptr%wtcol , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_itype_veg', data=pptr%itype , dim1name=namep, ncid=ncid, flag='write') + + do p=begp,endp + iparr(p) = lptr%itype(pptr%landunit(p)) + enddo + call ncd_io(varname='pfts1d_itype_lunit', data=iparr , dim1name=namep, ncid=ncid, flag='write') + + deallocate(rgarr,rlarr,rcarr,rparr) + deallocate(igarr,ilarr,icarr,iparr) + + end if + + end subroutine hfields_1dinfo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_htapes_wrapup +! +! !INTERFACE: + subroutine hist_htapes_wrapup( rstwr, nlend ) +! +! !DESCRIPTION: +! Write history tape(s) +! Determine if next time step is beginning of history interval and if so: +! increment the current time sample counter, open a new history file +! and if needed (i.e., when ntim = 1), write history data to current +! history file, reset field accumulation counters to zero. +! If primary history file is full or at the last time step of the simulation, +! write restart dataset and close all history fiels. +! If history file is full or at the last time step of the simulation: +! close history file +! and reset time sample counter to zero if file is full. +! Daily-averaged data for the first day in September are written on +! date = 00/09/02 with mscur = 0. +! Daily-averaged data for the first day in month mm are written on +! date = yyyy/mm/02 with mscur = 0. +! Daily-averaged data for the 30th day (last day in September) are written +! on date = 0000/10/01 mscur = 0. +! Daily-averaged data for the last day in month mm are written on +! date = yyyy/mm+1/01 with mscur = 0. +! +! !USES: + use clm_time_manager, only : get_nstep, get_curr_date, get_curr_time, get_prev_date + use clm_varcon , only : secspday + use clmtype +! +! !ARGUMENTS: + implicit none + logical, intent(in) :: rstwr ! true => write restart file this step + logical, intent(in) :: nlend ! true => end of run on this step +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: t ! tape index + integer :: f ! field index + integer :: ier ! error code + integer :: nstep ! current step + integer :: day ! current day (1 -> 31) + integer :: mon ! current month (1 -> 12) + integer :: yr ! current year (0 -> ...) + integer :: mdcur ! current day + integer :: mscur ! seconds of current day + integer :: mcsec ! current time of day [seconds] + integer :: daym1 ! nstep-1 day (1 -> 31) + integer :: monm1 ! nstep-1 month (1 -> 12) + integer :: yrm1 ! nstep-1 year (0 -> ...) + integer :: mcsecm1 ! nstep-1 time of day [seconds] + real(r8):: time ! current time + character(len=256) :: str ! global attribute string + logical :: if_stop ! true => last time step of run + logical, save :: do_3Dtconst = .true. ! true => write out 3D time-constant data + character(len=*),parameter :: subname = 'hist_htapes_wrapup' +!----------------------------------------------------------------------- + + ! get current step + + nstep = get_nstep() + + ! Set calendar for current time step + + call get_curr_date (yr, mon, day, mcsec) + call get_curr_time (mdcur, mscur) + time = mdcur + mscur/secspday + + ! Set calendar for current for previous time step + + call get_prev_date (yrm1, monm1, daym1, mcsecm1) + + ! Loop over active history tapes, create new history files if necessary + ! and write data to history files if end of history interval. + do t = 1, ntapes + + ! Skip nstep=0 if monthly average + + if (nstep==0 .and. tape(t)%nhtfrq==0) cycle + + ! Determine if end of history interval + tape(t)%is_endhist = .false. + if (tape(t)%nhtfrq==0) then !monthly average + if (mon /= monm1) tape(t)%is_endhist = .true. + else + if (mod(nstep,tape(t)%nhtfrq) == 0) tape(t)%is_endhist = .true. + end if + + ! If end of history interval + + if (tape(t)%is_endhist) then + + ! Normalize history buffer if time averaged + + call hfields_normalize(t) + + ! Increment current time sample counter. + + tape(t)%ntimes = tape(t)%ntimes + 1 + + ! Create history file if appropriate and build time comment + + ! If first time sample, generate unique history file name, open file, + ! define dims, vars, etc. + + if (tape(t)%ntimes == 1) then + locfnh(t) = set_hist_filename (hist_freq=tape(t)%nhtfrq, & + hist_mfilt=tape(t)%mfilt, hist_file=t) + if (masterproc) then + write(iulog,*) trim(subname),' : Creating history file ', trim(locfnh(t)), & + ' at nstep = ',get_nstep() + write(iulog,*)'calling htape_create for file t = ',t + endif + call htape_create (t) + + ! Define time-constant field variables + call htape_timeconst(t, mode='define') + + ! Define 3D time-constant field variables only to first primary tape + + if ( do_3Dtconst .and. t == 1 ) then + call htape_timeconst3D(t, mode='define') + TimeConst3DVars_Filename = trim(locfnh(t)) + end if + + ! Define model field variables + + call hfields_write(t, mode='define') + + ! Exit define model + call ncd_enddef(nfid(t)) + + endif + + ! Write time constant history variables + call htape_timeconst(t, mode='write') + + ! Write 3D time constant history variables only to first primary tape + if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then + call htape_timeconst3D(t, mode='write') + do_3Dtconst = .false. + end if + + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Writing current time sample to local history file ', & + trim(locfnh(t)),' at nstep = ',get_nstep(), & + ' for history time interval beginning at ', tape(t)%begtime, & + ' and ending at ',time + write(iulog,*) + call shr_sys_flush(iulog) + endif + + ! Update beginning time of next interval + + tape(t)%begtime = time + + ! Write history time samples + + call hfields_write(t, mode='write') + + ! Zero necessary history buffers + + call hfields_zero(t) + + end if + + end do ! end loop over history tapes + + ! Determine if file needs to be closed + + call hist_do_disp (ntapes, tape(:)%ntimes, tape(:)%mfilt, if_stop, if_disphist, rstwr, nlend) + + ! Close open history file + ! Auxilary files may have been closed and saved off without being full, + ! must reopen the files + + do t = 1, ntapes + if (if_disphist(t)) then + if (tape(t)%ntimes /= 0) then + if (masterproc) then + write(iulog,*) + write(iulog,*) trim(subname),' : Closing local history file ',& + trim(locfnh(t)),' at nstep = ', get_nstep() + write(iulog,*) + endif + call ncd_pio_closefile(nfid(t)) + if (.not.if_stop .and. (tape(t)%ntimes/=tape(t)%mfilt)) then + call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) + end if + else + if (masterproc) then + write(iulog,*) trim(subname),' : history tape ',t,': no open file to close' + end if + endif + endif + end do + + ! Reset number of time samples to zero if file is full + + do t = 1, ntapes + if (if_disphist(t) .and. tape(t)%ntimes==tape(t)%mfilt) then + tape(t)%ntimes = 0 + end if + end do + + end subroutine hist_htapes_wrapup + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_restart_ncd +! +! !INTERFACE: + subroutine hist_restart_ncd (ncid, flag, rdate) +! +! !DESCRIPTION: +! Read/write history file restart data. +! If the current history file(s) are not full, file(s) are opened +! so that subsequent time samples are added until the file is full. +! A new history file is used on a branch run. +! +! !USES: + use clm_varctl , only : nsrest, caseid, inst_suffix, nsrStartup, nsrBranch + use fileutils , only : getfil + use clmtype + use domainMod , only : ldomain + use clm_varpar , only : nlevgrnd, nlevlak, numrad + use clm_time_manager, only : is_restart +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid ! netcdf file + character(len=*) , intent(in) :: flag !'read' or 'write' + character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: max_nflds ! Max number of fields + integer :: num1d,beg1d,end1d ! 1d size, beginning and ending indices + integer :: num1d_out,beg1d_out,end1d_out ! 1d size, beginning and ending indices + integer :: num2d ! 2d size (e.g. number of vertical levels) + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numa ! total number of atm cells across all processors + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + character(len=max_namlen) :: name ! variable name + character(len=max_namlen) :: name_acc ! accumulator variable name + character(len=max_namlen) :: long_name ! long name of variable + character(len=max_chars) :: long_name_acc ! long name for accumulator + character(len=max_chars) :: units ! units of variable + character(len=max_chars) :: units_acc ! accumulator units + character(len=max_chars) :: fname ! full name of history file + character(len=max_chars) :: locrest(max_tapes) ! local history restart file names + + character(len=max_namlen),allocatable :: tname(:) + character(len=max_chars), allocatable :: tunits(:),tlongname(:) + character(len=8), allocatable :: tmpstr(:,:) + character(len=1), allocatable :: tavgflag(:) + integer :: start(2) + + character(len=1) :: hnum ! history file index + character(len=8) :: type1d ! clm pointer 1d type + character(len=8) :: type1d_out ! history buffer 1d type + character(len=8) :: type2d ! history buffer 2d type + character(len=32) :: dim1name ! temporary + character(len=32) :: dim2name ! temporary + type(var_desc_t) :: name_desc ! variable descriptor for name + type(var_desc_t) :: longname_desc ! variable descriptor for long_name + type(var_desc_t) :: units_desc ! variable descriptor for units + type(var_desc_t) :: type1d_desc ! variable descriptor for type1d + type(var_desc_t) :: type1d_out_desc ! variable descriptor for type1d_out + type(var_desc_t) :: type2d_desc ! variable descriptor for type2d + type(var_desc_t) :: avgflag_desc ! variable descriptor for avgflag + type(var_desc_t) :: p2c_scale_type_desc ! variable descriptor for p2c_scale_type + type(var_desc_t) :: c2l_scale_type_desc ! variable descriptor for c2l_scale_type + type(var_desc_t) :: l2g_scale_type_desc ! variable descriptor for l2g_scale_type + integer :: status ! error status + integer :: dimid ! dimension ID + integer :: k ! 1d index + integer :: ntapes_onfile ! number of history tapes on the restart file + integer :: nflds_onfile ! number of history fields on the restart file + integer :: t ! tape index + integer :: f ! field index + integer :: varid ! variable id + integer, allocatable :: itemp(:) ! temporary + real(r8), pointer :: hbuf(:,:) ! history buffer + real(r8), pointer :: hbuf1d(:) ! 1d history buffer + integer , pointer :: nacs(:,:) ! accumulation counter + integer , pointer :: nacs1d(:) ! 1d accumulation counter + character(len=*),parameter :: subname = 'hist_restart_ncd' +!------------------------------------------------------------------------ + + ! If branch run, initialize file times and return + + if (flag == 'read') then + if (nsrest == nsrBranch) then + do t = 1,ntapes + tape(t)%ntimes = 0 + end do + RETURN + end if + ! If startup run just return + if (nsrest == nsrStartup) then + RETURN + end if + endif + + ! Read history file data only for restart run (not for branch run) + + ! + ! First when writing out and in define mode, create files and define all variables + ! + !================================================ + if (flag == 'define') then + !================================================ + + if (.not. present(rdate)) then + call endrun('variable rdate must be present for writing restart files') + end if + + ! + ! On master restart file add ntapes/max_chars dimension + ! and then add the history and history restart filenames + ! + call ncd_defdim( ncid, 'ntapes' , ntapes , dimid) + call ncd_defdim( ncid, 'max_chars' , max_chars , dimid) + + call ncd_defvar(ncid=ncid, varname='locfnh', xtype=ncd_char, & + long_name="History filename", & + comment="This variable NOT needed for startup or branch simulations", & + dim1name='max_chars', dim2name="ntapes" ) + call ncd_defvar(ncid=ncid, varname='locfnhr', xtype=ncd_char, & + long_name="Restart history filename", & + comment="This variable NOT needed for startup or branch simulations", & + dim1name='max_chars', dim2name="ntapes" ) + + ! max_nflds is the maximum number of fields on any tape + ! max_flds is the maximum number possible number of fields + + max_nflds = max_nFields() + + call get_proc_global(numg, numl, numc, nump) + + ! Loop over tapes - write out namelist information to each restart-history tape + ! only read/write accumulators and counters if needed + + do t = 1,ntapes + + ! + ! Create the restart history filename and open it + ! + write(hnum,'(i1.1)') t-1 + locfnhr(t) = "./" // trim(caseid) //".clm2"// trim(inst_suffix) & + // ".rh" // hnum //"."// trim(rdate) //".nc" + + call htape_create( t, histrest=.true. ) + + ! + ! Add read/write accumultators and counters if needed + ! + if (.not. tape(t)%is_endhist) then + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + long_name = tape(t)%hlist(f)%field%long_name + units = tape(t)%hlist(f)%field%units + name_acc = trim(name) // "_acc" + units_acc = "unitless positive integer" + long_name_acc = trim(long_name) // " accumulator number of samples" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (type1d_out == grlnd) then + if (ldomain%isgrid2d) then + dim1name = 'lon' ; dim2name = 'lat' + else + dim1name = trim(grlnd); dim2name = 'undefined' + end if + else + dim1name = type1d_out ; dim2name = 'undefined' + endif + + if (dim2name == 'undefined') then + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if + else + if (num2d == 1) then + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, & + long_name=trim(long_name_acc), units=trim(units_acc)) + else + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name), xtype=ncd_double, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name), units=trim(units)) + call ncd_defvar(ncid=ncid_hist(t), varname=trim(name_acc), xtype=ncd_int, & + dim1name=dim1name, dim2name=dim2name, dim3name=type2d, & + long_name=trim(long_name_acc), units=trim(units_acc)) + end if + endif + end do + endif + + ! + ! Add namelist information to each restart history tape + ! + call ncd_defdim( ncid_hist(t), 'fname_lenp2' , max_namlen+2, dimid) + call ncd_defdim( ncid_hist(t), 'fname_len' , max_namlen , dimid) + call ncd_defdim( ncid_hist(t), 'len1' , 1 , dimid) + call ncd_defdim( ncid_hist(t), 'scalar' , 1 , dimid) + call ncd_defdim( ncid_hist(t), 'max_chars' , max_chars , dimid) + call ncd_defdim( ncid_hist(t), 'max_nflds' , max_nflds , dimid) + call ncd_defdim( ncid_hist(t), 'max_flds' , max_flds , dimid) + + call ncd_defvar(ncid=ncid_hist(t), varname='nhtfrq', xtype=ncd_int, & + long_name="Frequency of history writes", & + comment="Namelist item", & + units="absolute value of negative is in hours, 0=monthly, positive is time-steps", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='mfilt', xtype=ncd_int, & + long_name="Number of history time samples on a file", units="unitless", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='ncprec', xtype=ncd_int, & + long_name="Flag for data precision", flag_values=(/1,2/), & + comment="Namelist item", & + nvalid_range=(/1,2/), & + flag_meanings=(/"single-precision", "double-precision"/), & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='dov2xy', xtype=ncd_log, & + long_name="Output on 2D grid format (TRUE) or vector format (FALSE)", & + comment="Namelist item", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='fincl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to include", & + dim1name='fname_lenp2', dim2name='max_flds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='fexcl', xtype=ncd_char, & + comment="Namelist item", & + long_name="Fieldnames to exclude", & + dim1name='fname_lenp2', dim2name='max_flds' ) + + call ncd_defvar(ncid=ncid_hist(t), varname='nflds', xtype=ncd_int, & + long_name="Number of fields on file", units="unitless", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='ntimes', xtype=ncd_int, & + long_name="Number of time steps on file", units="time-step", & + dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='is_endhist', xtype=ncd_log, & + long_name="End of history file", dim1name='scalar') + call ncd_defvar(ncid=ncid_hist(t), varname='begtime', xtype=ncd_double, & + long_name="Beginning time", units="time units", & + dim1name='scalar') + + call ncd_defvar(ncid=ncid_hist(t), varname='num2d', xtype=ncd_int, & + long_name="Size of second dimension", units="unitless", & + dim1name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='hpindex', xtype=ncd_int, & + long_name="History pointer index", units="unitless", & + dim1name='max_nflds' ) + + call ncd_defvar(ncid=ncid_hist(t), varname='avgflag', xtype=ncd_char, & + long_name="Averaging flag", & + units="A=Average, X=Maximum, M=Minimum, I=Instantaneous", & + dim1name='len1', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='name', xtype=ncd_char, & + long_name="Fieldnames", & + dim1name='fname_len', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='long_name', xtype=ncd_char, & + long_name="Long descriptive names for fields", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='units', xtype=ncd_char, & + long_name="Units for each history field output", & + dim1name='max_chars', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type1d', xtype=ncd_char, & + long_name="1st dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type1d_out', xtype=ncd_char, & + long_name="1st output dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='type2d', xtype=ncd_char, & + long_name="2nd dimension type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='p2c_scale_type', xtype=ncd_char, & + long_name="PFT to column scale type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='c2l_scale_type', xtype=ncd_char, & + long_name="column to landunit scale type", & + dim1name='string_length', dim2name='max_nflds' ) + call ncd_defvar(ncid=ncid_hist(t), varname='l2g_scale_type', xtype=ncd_char, & + long_name="landunit to gridpoint scale type", & + dim1name='string_length', dim2name='max_nflds' ) + + call ncd_enddef(ncid_hist(t)) + + end do ! end of ntapes loop + + RETURN + + ! + ! First write out namelist information to each restart history file + ! + !================================================ + else if (flag == 'write') then + !================================================ + + ! Add history filenames to master restart file + do t = 1,ntapes + call ncd_io('locfnh', locfnh(t), 'write', ncid, nt=t) + call ncd_io('locfnhr', locfnhr(t), 'write', ncid, nt=t) + end do + + fincl(:,1) = hist_fincl1(:) + fincl(:,2) = hist_fincl2(:) + fincl(:,3) = hist_fincl3(:) + fincl(:,4) = hist_fincl4(:) + fincl(:,5) = hist_fincl5(:) + fincl(:,6) = hist_fincl6(:) + + fexcl(:,1) = hist_fexcl1(:) + fexcl(:,2) = hist_fexcl2(:) + fexcl(:,3) = hist_fexcl3(:) + fexcl(:,4) = hist_fexcl4(:) + fexcl(:,5) = hist_fexcl5(:) + fexcl(:,6) = hist_fexcl6(:) + + max_nflds = max_nFields() + + start(1)=1 + + + ! + ! Add history namelist data to each history restart tape + ! + allocate(itemp(max_nflds)) + + do t = 1,ntapes + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='write') + + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='write') + + itemp(:) = 0 + do f=1,tape(t)%nflds + itemp(f) = tape(t)%hlist(f)%field%num2d + end do + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='write') + + itemp(:) = 0 + do f=1,tape(t)%nflds + itemp(f) = tape(t)%hlist(f)%field%hpindex + end do + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='write') + + call ncd_io('nflds', tape(t)%nflds, 'write', ncid_hist(t) ) + call ncd_io('ntimes', tape(t)%ntimes, 'write', ncid_hist(t) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'write', ncid_hist(t) ) + call ncd_io('mfilt', tape(t)%mfilt, 'write', ncid_hist(t) ) + call ncd_io('ncprec', tape(t)%ncprec, 'write', ncid_hist(t) ) + call ncd_io('begtime', tape(t)%begtime, 'write', ncid_hist(t) ) + allocate(tmpstr(tape(t)%nflds,6 ),tname(tape(t)%nflds), & + tavgflag(tape(t)%nflds),tunits(tape(t)%nflds),tlongname(tape(t)%nflds)) + do f=1,tape(t)%nflds + tname(f) = tape(t)%hlist(f)%field%name + tunits(f) = tape(t)%hlist(f)%field%units + tlongname(f) = tape(t)%hlist(f)%field%long_name + tmpstr(f,1) = tape(t)%hlist(f)%field%type1d + tmpstr(f,2) = tape(t)%hlist(f)%field%type1d_out + tmpstr(f,3) = tape(t)%hlist(f)%field%type2d + tavgflag(f) = tape(t)%hlist(f)%avgflag + tmpstr(f,4) = tape(t)%hlist(f)%field%p2c_scale_type + tmpstr(f,5) = tape(t)%hlist(f)%field%c2l_scale_type + tmpstr(f,6) = tape(t)%hlist(f)%field%l2g_scale_type + end do + call ncd_io( 'name', tname, 'write',ncid_hist(t)) + call ncd_io('long_name', tlongname, 'write', ncid_hist(t)) + call ncd_io('units', tunits, 'write',ncid_hist(t)) + call ncd_io('type1d', tmpstr(:,1), 'write', ncid_hist(t)) + call ncd_io('type1d_out', tmpstr(:,2), 'write', ncid_hist(t)) + call ncd_io('type2d', tmpstr(:,3), 'write', ncid_hist(t)) + call ncd_io('avgflag',tavgflag , 'write', ncid_hist(t)) + call ncd_io('p2c_scale_type', tmpstr(:,4), 'write', ncid_hist(t)) + call ncd_io('c2l_scale_type', tmpstr(:,5), 'write', ncid_hist(t)) + call ncd_io('l2g_scale_type', tmpstr(:,6), 'write', ncid_hist(t)) + deallocate(tname,tlongname,tunits,tmpstr,tavgflag) + enddo + deallocate(itemp) + + ! + ! Read in namelist information + ! + !================================================ + else if (flag == 'read') then + !================================================ + + call ncd_inqdlen(ncid,dimid,ntapes_onfile, name='ntapes') + if ( is_restart() .and. ntapes_onfile /= ntapes )then + write(iulog,*) 'ntapes = ', ntapes, ' ntapes_onfile = ', ntapes_onfile + call endrun( trim(subname)//' ERROR: number of ntapes different than on restart file!, '// & + ' you can NOT change history options on restart!' ) + end if + if ( is_restart() .and. ntapes > 0 )then + call ncd_io('locfnh', locfnh(1:ntapes), 'read', ncid ) + call ncd_io('locfnhr', locrest(1:ntapes), 'read', ncid ) + do t = 1,ntapes + call strip_null(locrest(t)) + call strip_null(locfnh(t)) + end do + end if + + ! Determine necessary indices - the following is needed if model decomposition is different on restart + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + + start(1)=1 + + do t = 1,ntapes + + call getfil( locrest(t), locfnhr(t), 0 ) + call ncd_pio_openfile (ncid_hist(t), trim(locfnhr(t)), ncd_nowrite) + + if ( t == 1 )then + + call ncd_inqdlen(ncid_hist(1),dimid,max_nflds,name='max_nflds') + + allocate(itemp(max_nflds)) + end if + + call ncd_inqvid(ncid_hist(t), 'name', varid, name_desc) + call ncd_inqvid(ncid_hist(t), 'long_name', varid, longname_desc) + call ncd_inqvid(ncid_hist(t), 'units', varid, units_desc) + call ncd_inqvid(ncid_hist(t), 'type1d', varid, type1d_desc) + call ncd_inqvid(ncid_hist(t), 'type1d_out', varid, type1d_out_desc) + call ncd_inqvid(ncid_hist(t), 'type2d', varid, type2d_desc) + call ncd_inqvid(ncid_hist(t), 'avgflag', varid, avgflag_desc) + call ncd_inqvid(ncid_hist(t), 'p2c_scale_type', varid, p2c_scale_type_desc) + call ncd_inqvid(ncid_hist(t), 'c2l_scale_type', varid, c2l_scale_type_desc) + call ncd_inqvid(ncid_hist(t), 'l2g_scale_type', varid, l2g_scale_type_desc) + + call ncd_io(varname='fincl', data=fincl(:,t), ncid=ncid_hist(t), flag='read') + + call ncd_io(varname='fexcl', data=fexcl(:,t), ncid=ncid_hist(t), flag='read') + + call ncd_io('nflds', tape(t)%nflds, 'read', ncid_hist(t) ) + call ncd_io('ntimes', tape(t)%ntimes, 'read', ncid_hist(t) ) + call ncd_io('nhtfrq', tape(t)%nhtfrq, 'read', ncid_hist(t) ) + call ncd_io('mfilt', tape(t)%mfilt, 'read', ncid_hist(t) ) + call ncd_io('ncprec', tape(t)%ncprec, 'read', ncid_hist(t) ) + call ncd_io('begtime', tape(t)%begtime, 'read', ncid_hist(t) ) + + call ncd_io(varname='is_endhist', data=tape(t)%is_endhist, ncid=ncid_hist(t), flag='read') + call ncd_io(varname='dov2xy', data=tape(t)%dov2xy, ncid=ncid_hist(t), flag='read') + call ncd_io(varname='num2d', data=itemp(:), ncid=ncid_hist(t), flag='read') + do f=1,tape(t)%nflds + tape(t)%hlist(f)%field%num2d = itemp(f) + end do + + call ncd_io(varname='hpindex', data=itemp(:), ncid=ncid_hist(t), flag='read') + do f=1,tape(t)%nflds + tape(t)%hlist(f)%field%hpindex = itemp(f) + end do + + do f=1,tape(t)%nflds + start(2) = f + call ncd_io( name_desc, tape(t)%hlist(f)%field%name, & + 'read', ncid_hist(t), start ) + call ncd_io( longname_desc, tape(t)%hlist(f)%field%long_name, & + 'read', ncid_hist(t), start ) + call ncd_io( units_desc, tape(t)%hlist(f)%field%units, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_desc, tape(t)%hlist(f)%field%type1d, & + 'read', ncid_hist(t), start ) + call ncd_io( type1d_out_desc, tape(t)%hlist(f)%field%type1d_out, & + 'read', ncid_hist(t), start ) + call ncd_io( type2d_desc, tape(t)%hlist(f)%field%type2d, & + 'read', ncid_hist(t), start ) + call ncd_io( avgflag_desc, tape(t)%hlist(f)%avgflag, & + 'read', ncid_hist(t), start ) + call ncd_io( p2c_scale_type_desc, tape(t)%hlist(f)%field%p2c_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( c2l_scale_type_desc, tape(t)%hlist(f)%field%c2l_scale_type, & + 'read', ncid_hist(t), start ) + call ncd_io( l2g_scale_type_desc, tape(t)%hlist(f)%field%l2g_scale_type, & + 'read', ncid_hist(t), start ) + call strip_null(tape(t)%hlist(f)%field%name) + call strip_null(tape(t)%hlist(f)%field%long_name) + call strip_null(tape(t)%hlist(f)%field%units) + call strip_null(tape(t)%hlist(f)%field%type1d) + call strip_null(tape(t)%hlist(f)%field%type1d_out) + call strip_null(tape(t)%hlist(f)%field%type2d) + call strip_null(tape(t)%hlist(f)%field%p2c_scale_type) + call strip_null(tape(t)%hlist(f)%field%c2l_scale_type) + call strip_null(tape(t)%hlist(f)%field%l2g_scale_type) + call strip_null(tape(t)%hlist(f)%avgflag) + + type1d_out = trim(tape(t)%hlist(f)%field%type1d_out) + select case (trim(type1d_out)) + case (grlnd) + num1d_out = numg + beg1d_out = begg + end1d_out = endg + case (nameg) + num1d_out = numg + beg1d_out = begg + end1d_out = endg + case (namel) + num1d_out = numl + beg1d_out = begl + end1d_out = endl + case (namec) + num1d_out = numc + beg1d_out = begc + end1d_out = endc + case (namep) + num1d_out = nump + beg1d_out = begp + end1d_out = endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d output type=',trim(type1d_out) + call endrun () + end select + + tape(t)%hlist(f)%field%num1d_out = num1d_out + tape(t)%hlist(f)%field%beg1d_out = beg1d_out + tape(t)%hlist(f)%field%end1d_out = end1d_out + + num2d = tape(t)%hlist(f)%field%num2d + allocate (tape(t)%hlist(f)%hbuf(beg1d_out:end1d_out,num2d), & + tape(t)%hlist(f)%nacs(beg1d_out:end1d_out,num2d), & + stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation error for hbuf,nacs at t,f=',t,f,beg1d_out,end1d_out,num2d + call endrun() + endif + tape(t)%hlist(f)%hbuf(:,:) = 0._r8 + tape(t)%hlist(f)%nacs(:,:) = 0 + + type1d = tape(t)%hlist(f)%field%type1d + select case (type1d) + case (grlnd) + num1d = numg + beg1d = begg + end1d = endg + case (nameg) + num1d = numg + beg1d = begg + end1d = endg + case (namel) + num1d = numl + beg1d = begl + end1d = endl + case (namec) + num1d = numc + beg1d = begc + end1d = endc + case (namep) + num1d = nump + beg1d = begp + end1d = endp + case default + write(iulog,*) trim(subname),' ERROR: read unknown 1d type=',type1d + call endrun () + end select + + tape(t)%hlist(f)%field%num1d = num1d + tape(t)%hlist(f)%field%beg1d = beg1d + tape(t)%hlist(f)%field%end1d = end1d + + end do ! end of flds loop + + ! If history file is not full, open it + + if (tape(t)%ntimes /= 0) then + call ncd_pio_openfile (nfid(t), trim(locfnh(t)), ncd_write) + end if + + end do ! end of tapes loop + + hist_fincl1(:) = fincl(:,1) + hist_fincl2(:) = fincl(:,2) + hist_fincl3(:) = fincl(:,3) + hist_fincl4(:) = fincl(:,4) + hist_fincl5(:) = fincl(:,5) + hist_fincl6(:) = fincl(:,6) + + hist_fexcl1(:) = fexcl(:,1) + hist_fexcl2(:) = fexcl(:,2) + hist_fexcl3(:) = fexcl(:,3) + hist_fexcl4(:) = fexcl(:,4) + hist_fexcl5(:) = fexcl(:,5) + hist_fexcl6(:) = fexcl(:,6) + + if ( allocated(itemp) ) deallocate(itemp) + + end if + + !====================================================================== + ! Read/write history file restart data. + ! If the current history file(s) are not full, file(s) are opened + ! so that subsequent time samples are added until the file is full. + ! A new history file is used on a branch run. + !====================================================================== + + if (flag == 'write') then + + do t = 1,ntapes + if (.not. tape(t)%is_endhist) then + + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation'; call endrun() + end if + + hbuf1d(beg1d_out:end1d_out) = hbuf(beg1d_out:end1d_out,1) + nacs1d(beg1d_out:end1d_out) = nacs(beg1d_out:end1d_out,1) + + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t), flag='write', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if + + end do + + end if ! end of is_endhist block + + call ncd_pio_closefile(ncid_hist(t)) + + end do ! end of ntapes loop + + else if (flag == 'read') then + + ! Read history restart information if history files are not full + + do t = 1,ntapes + + if (.not. tape(t)%is_endhist) then + + do f = 1,tape(t)%nflds + name = tape(t)%hlist(f)%field%name + name_acc = trim(name) // "_acc" + type1d_out = tape(t)%hlist(f)%field%type1d_out + type2d = tape(t)%hlist(f)%field%type2d + num2d = tape(t)%hlist(f)%field%num2d + beg1d_out = tape(t)%hlist(f)%field%beg1d_out + end1d_out = tape(t)%hlist(f)%field%end1d_out + nacs => tape(t)%hlist(f)%nacs + hbuf => tape(t)%hlist(f)%hbuf + + if (num2d == 1) then + allocate(hbuf1d(beg1d_out:end1d_out), & + nacs1d(beg1d_out:end1d_out), stat=status) + if (status /= 0) then + write(iulog,*) trim(subname),' ERROR: allocation'; call endrun() + end if + + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf1d) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs1d) + + hbuf(beg1d_out:end1d_out,1) = hbuf1d(beg1d_out:end1d_out) + nacs(beg1d_out:end1d_out,1) = nacs1d(beg1d_out:end1d_out) + + deallocate(hbuf1d) + deallocate(nacs1d) + else + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name), & + dim1name=type1d_out, data=hbuf) + call ncd_io(ncid=ncid_hist(t), flag='read', varname=trim(name_acc), & + dim1name=type1d_out, data=nacs) + end if + end do + + end if + + call ncd_pio_closefile(ncid_hist(t)) + + end do + + end if + + end subroutine hist_restart_ncd + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: max_nFields +! +! !INTERFACE: +integer function max_nFields() +! +! !DESCRIPTION: +! Get the maximum number of fields on all tapes. +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: t ! index + character(len=*),parameter :: subname = 'max_nFields' +!----------------------------------------------------------------------- + max_nFields = 0 + do t = 1,ntapes + max_nFields = max(max_nFields, tape(t)%nflds) + end do + + return + +end function max_nFields + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: getname +! +! !INTERFACE: + character(len=max_namlen) function getname (inname) +! +! !DESCRIPTION: +! Retrieve name portion of inname. If an averaging flag separater character +! is present (:) in inname, lop it off. +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: inname +! +! !REVISION HISTORY: +! Created by Jim Rosinski +! +! +! !LOCAL VARIABLES: +!EOP + integer :: length + integer :: i + character(len=*),parameter :: subname = 'getname' +!----------------------------------------------------------------------- + + length = len (inname) + + if (length < max_namlen .or. length > max_namlen+2) then + write(iulog,*) trim(subname),' ERROR: bad length=',length + call endrun() + end if + + getname = ' ' + do i = 1,max_namlen + if (inname(i:i) == ':') exit + getname(i:i) = inname(i:i) + end do + + end function getname + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: getflag +! +! !INTERFACE: + character(len=1) function getflag (inname) +! +! !DESCRIPTION: +! Retrieve flag portion of inname. If an averaging flag separater character +! is present (:) in inname, return the character after it as the flag +! +! !ARGUMENTS: + implicit none + character(len=*) inname ! character string +! +! !REVISION HISTORY: +! Created by Jim Rosinski +! +! +! !LOCAL VARIABLES: +!EOP + integer :: length ! length of inname + integer :: i ! loop index + character(len=*),parameter :: subname = 'getflag' +!----------------------------------------------------------------------- + + length = len (inname) + + if (length < max_namlen .or. length > max_namlen+2) then + write(iulog,*) trim(subname),' ERROR: bad length=',length + call endrun() + end if + + getflag = ' ' + do i = 1,length + if (inname(i:i) == ':') then + getflag = inname(i+1:i+1) + exit + end if + end do + + end function getflag + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: list_index +! +! !INTERFACE: + subroutine list_index (list, name, index) +! +! !DESCRIPTION: +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: list(max_flds) ! input list of names, possibly ":" delimited + character(len=max_namlen), intent(in) :: name ! name to be searched for + integer, intent(out) :: index ! index of "name" in "list" +! +! !REVISION HISTORY: +! Created by Jim Rosinski +! +! +! !LOCAL VARIABLES: +!EOP + character(len=max_namlen) :: listname ! input name with ":" stripped off. + integer f ! field index + character(len=*),parameter :: subname = 'list_index' +!----------------------------------------------------------------------- + + ! Only list items + + index = 0 + do f=1,max_flds + listname = getname (list(f)) + if (listname == ' ') exit + if (listname == name) then + index = f + exit + end if + end do + + end subroutine list_index + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: set_hist_filename +! +! !INTERFACE: + character(len=256) function set_hist_filename (hist_freq, hist_mfilt, hist_file) +! +! !DESCRIPTION: +! Determine history dataset filenames. +! +! !USES: + use clm_varctl, only : caseid, inst_suffix + use clm_time_manager, only : get_curr_date, get_prev_date +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: hist_freq !history file frequency + integer, intent(in) :: hist_mfilt !history file number of time-samples + integer, intent(in) :: hist_file !history file index +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: cdate !date char string + character(len= 1) :: hist_index !p,1 or 2 (currently) + integer :: day !day (1 -> 31) + integer :: mon !month (1 -> 12) + integer :: yr !year (0 -> ...) + integer :: sec !seconds into current day + character(len=*),parameter :: subname = 'set_hist_filename' +!----------------------------------------------------------------------- + + if (hist_freq == 0 .and. hist_mfilt == 1) then !monthly + call get_prev_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2)') yr,mon + else !other + call get_curr_date (yr, mon, day, sec) + write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec + endif + write(hist_index,'(i1.1)') hist_file - 1 + set_hist_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".h"//hist_index//"."//trim(cdate)//".nc" + + end function set_hist_filename + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_addfld1d +! +! !INTERFACE: + subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_pft, ptr_lnd, & + ptr_atm, p2c_scale_type, c2l_scale_type, & + l2g_scale_type, set_lake, set_urb, set_nourb, & + set_noglcmec, set_spec, default) +! +! !DESCRIPTION: +! Initialize a single level history field. The pointer, ptrhist, +! is a pointer to the clmtype array that the history buffer will use. +! The value of type1d passed to masterlist\_add\_fld determines which of the +! 1d type of the output and the beginning and ending indices the history +! buffer field). Default history contents for given field on all tapes +! are set by calling [masterlist\_make\_active] for the appropriate tape. +! After the masterlist is built, routine [htapes\_build] is called for an +! initial or branch run to initialize the actual history tapes. +! +! !USES: + use clmtype +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from clmtype) + real(r8) , optional, pointer :: ptr_gcell(:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:) ! pointer to column array + real(r8) , optional, pointer :: ptr_pft(:) ! pointer to pft array + real(r8) , optional, pointer :: ptr_lnd(:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_atm(:) ! pointer to atm array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_noglcmec ! value to set non-glacier_mec to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: p,c,l,g ! indices + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: hpindex ! history buffer pointer index + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type + character(len=8) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column + character(len=8) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits + character(len=8) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells + character(len=*),parameter :: subname = 'hist_addfld1d' +!------------------------------------------------------------------------ + + ! Determine processor bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! History buffer pointer + + hpindex = pointer_index() + + if (present(ptr_lnd)) then + l_type1d = grlnd + l_type1d_out = grlnd + clmptr_rs(hpindex)%ptr => ptr_lnd + + else if (present(ptr_gcell)) then + l_type1d = nameg + l_type1d_out = nameg + clmptr_rs(hpindex)%ptr => ptr_gcell + + else if (present(ptr_lunit)) then + l_type1d = namel + l_type1d_out = namel + clmptr_rs(hpindex)%ptr => ptr_lunit + if (present(set_lake)) then + do l = begl,endl + if (lun%lakpoi(l)) ptr_lunit(l) = set_lake + end do + end if + if (present(set_urb)) then + do l = begl,endl + if (lun%urbpoi(l)) ptr_lunit(l) = set_urb + end do + end if + if (present(set_nourb)) then + do l = begl,endl + if (.not.(lun%urbpoi(l))) ptr_lunit(l) = set_nourb + end do + end if + if (present(set_spec)) then + do l = begl,endl + if (lun%ifspecial(l)) ptr_lunit(l) = set_spec + end do + end if + + else if (present(ptr_col)) then + l_type1d = namec + l_type1d_out = namec + clmptr_rs(hpindex)%ptr => ptr_col + if (present(set_lake)) then + do c = begc,endc + l = col%landunit(c) + if (lun%lakpoi(l)) ptr_col(c) = set_lake + end do + end if + if (present(set_urb)) then + do c = begc,endc + l = col%landunit(c) + if (lun%urbpoi(l)) ptr_col(c) = set_urb + end do + end if + if (present(set_nourb)) then + do c = begc,endc + l = col%landunit(c) + if (.not.(lun%urbpoi(l))) ptr_col(c) = set_nourb + end do + end if + if (present(set_spec)) then + do c = begc,endc + l = col%landunit(c) + if (lun%ifspecial(l)) ptr_col(c) = set_spec + end do + end if + if (present(set_noglcmec)) then + do c = begc,endc + l = col%landunit(c) + if (.not.(lun%glcmecpoi(l))) ptr_col(c) = set_noglcmec + end do + endif + + else if (present(ptr_pft)) then + l_type1d = namep + l_type1d_out = namep + clmptr_rs(hpindex)%ptr => ptr_pft + if (present(set_lake)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%lakpoi(l)) ptr_pft(p) = set_lake + end do + end if + if (present(set_urb)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%urbpoi(l)) ptr_pft(p) = set_urb + end do + end if + if (present(set_nourb)) then + do p = begp,endp + l = pft%landunit(p) + if (.not.(lun%urbpoi(l))) ptr_pft(p) = set_nourb + end do + end if + if (present(set_spec)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%ifspecial(l)) ptr_pft(p) = set_spec + end do + end if + if (present(set_noglcmec)) then + do p = begp,endp + l = pft%landunit(p) + if (.not.(lun%glcmecpoi(l))) ptr_pft(p) = set_noglcmec + end do + end if + else + write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', & + ' choices are [ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_pft] ' + call endrun() + + end if + + ! Set scaling factor + + scale_type_p2c = 'unity' + scale_type_c2l = 'unity' + scale_type_l2g = 'unity' + + if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type + if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type + if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type + if (present(type1d_out)) l_type1d_out = type1d_out + + ! Add field to masterlist + + call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, & + type2d='unset', num2d=1, & + units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g) + + if (present(default)) then + if (trim(default) == 'inactive') return + else + call masterlist_make_active (name=trim(fname), tape_index=1) + end if + + end subroutine hist_addfld1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_addfld2d +! +! !INTERFACE: + subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, & + ptr_gcell, ptr_lunit, ptr_col, ptr_pft, ptr_lnd, ptr_atm, & + p2c_scale_type, c2l_scale_type, l2g_scale_type, & + set_lake, set_urb, set_nourb, set_spec, default) +! +! !DESCRIPTION: +! Initialize a single level history field. The pointer, ptrhist, +! is a pointer to the clmtype array that the history buffer will use. +! The value of type1d passed to masterlist\_add\_fld determines which of the +! 1d type of the output and the beginning and ending indices the history +! buffer field). Default history contents for given field on all tapes +! are set by calling [masterlist\_make\_active] for the appropriatae tape. +! After the masterlist is built, routine [htapes\_build] is called for an +! initial or branch run to initialize the actual history tapes. +! +! !USES: + use clmtype + use clm_varpar, only : nlevgrnd, nlevlak, numrad, maxpatch_glcmec +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fname ! field name + character(len=*), intent(in) :: type2d ! 2d output type + character(len=*), intent(in) :: units ! units of field + character(len=1), intent(in) :: avgflag ! time averaging flag + character(len=*), intent(in) :: long_name ! long name of field + character(len=*), optional, intent(in) :: type1d_out ! output type (from clmtype) + real(r8) , optional, pointer :: ptr_atm(:,:) ! pointer to atm array + real(r8) , optional, pointer :: ptr_lnd(:,:) ! pointer to lnd array + real(r8) , optional, pointer :: ptr_gcell(:,:) ! pointer to gridcell array + real(r8) , optional, pointer :: ptr_lunit(:,:) ! pointer to landunit array + real(r8) , optional, pointer :: ptr_col(:,:) ! pointer to column array + real(r8) , optional, pointer :: ptr_pft(:,:) ! pointer to pft array + real(r8) , optional, intent(in) :: set_lake ! value to set lakes to + real(r8) , optional, intent(in) :: set_urb ! value to set urban to + real(r8) , optional, intent(in) :: set_nourb ! value to set non-urban to + real(r8) , optional, intent(in) :: set_spec ! value to set special to + character(len=*), optional, intent(in) :: p2c_scale_type ! scale type for subgrid averaging of pfts to column + character(len=*), optional, intent(in) :: c2l_scale_type ! scale type for subgrid averaging of columns to landunits + character(len=*), optional, intent(in) :: l2g_scale_type ! scale type for subgrid averaging of landunits to gridcells + character(len=*), optional, intent(in) :: default ! if set to 'inactive, field will not appear on primary tape +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: p,c,l,g ! indices + integer :: num2d ! size of second dimension (e.g. number of vertical levels) + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: hpindex ! history buffer index + character(len=8) :: l_type1d ! 1d data type + character(len=8) :: l_type1d_out ! 1d output type + character(len=8) :: scale_type_p2c ! scale type for subgrid averaging of pfts to column + character(len=8) :: scale_type_c2l ! scale type for subgrid averaging of columns to landunits + character(len=8) :: scale_type_l2g ! scale type for subgrid averaging of landunits to gridcells + character(len=*),parameter :: subname = 'hist_addfld2d' +!------------------------------------------------------------------------ + + ! Determine second dimension size + + select case (type2d) + case ('levgrnd') + num2d = nlevgrnd + case ('levlak') + num2d = nlevlak + case ('numrad') + num2d = numrad + case ('glc_nec') + if (maxpatch_glcmec > 0) then + num2d = maxpatch_glcmec + else + write(iulog,*) trim(subname),' ERROR: 2d type =', trim(type2d), & + ' only valid for maxpatch_glcmec > 0' + call endrun() + end if + case default + write(iulog,*) trim(subname),' ERROR: unsupported 2d type ',type2d, & + ' currently supported types for multi level fields are [levgrnd,levlak,numrad,glc_nec]' + call endrun() + end select + + ! Determine processor bounds + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! History buffer pointer + + hpindex = pointer_index() + + if (present(ptr_lnd)) then + l_type1d = grlnd + l_type1d_out = grlnd + clmptr_ra(hpindex)%ptr => ptr_lnd + + else if (present(ptr_gcell)) then + l_type1d = nameg + l_type1d_out = nameg + clmptr_ra(hpindex)%ptr => ptr_gcell + + else if (present(ptr_lunit)) then + l_type1d = namel + l_type1d_out = namel + clmptr_ra(hpindex)%ptr => ptr_lunit + if (present(set_lake)) then + do l = begl,endl + if (lun%lakpoi(l)) ptr_lunit(l,:) = set_lake + end do + end if + if (present(set_urb)) then + do l = begl,endl + if (lun%urbpoi(l)) ptr_lunit(l,:) = set_urb + end do + end if + if (present(set_nourb)) then + do l = begl,endl + if (.not.(lun%urbpoi(l))) ptr_lunit(l,:) = set_nourb + end do + end if + if (present(set_spec)) then + do l = begl,endl + if (lun%ifspecial(l)) ptr_lunit(l,:) = set_spec + end do + end if + + else if (present(ptr_col)) then + l_type1d = namec + l_type1d_out = namec + clmptr_ra(hpindex)%ptr => ptr_col + if (present(set_lake)) then + do c = begc,endc + l = col%landunit(c) + if (lun%lakpoi(l)) ptr_col(c,:) = set_lake + end do + end if + if (present(set_urb)) then + do c = begc,endc + l = col%landunit(c) + if (lun%urbpoi(l)) ptr_col(c,:) = set_urb + end do + end if + if (present(set_nourb)) then + do c = begc,endc + l = col%landunit(c) + if (.not.(lun%urbpoi(l))) ptr_col(c,:) = set_nourb + end do + end if + if (present(set_spec)) then + do c = begc,endc + l = col%landunit(c) + if (lun%ifspecial(l)) ptr_col(c,:) = set_spec + end do + end if + + else if (present(ptr_pft)) then + l_type1d = namep + l_type1d_out = namep + clmptr_ra(hpindex)%ptr => ptr_pft + if (present(set_lake)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%lakpoi(l)) ptr_pft(p,:) = set_lake + end do + end if + if (present(set_urb)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%urbpoi(l)) ptr_pft(p,:) = set_urb + end do + end if + if (present(set_nourb)) then + do p = begp,endp + l = pft%landunit(p) + if (.not.(lun%urbpoi(l))) ptr_pft(p,:) = set_nourb + end do + end if + if (present(set_spec)) then + do p = begp,endp + l = pft%landunit(p) + if (lun%ifspecial(l)) ptr_pft(p,:) = set_spec + end do + end if + + else + write(iulog,*) trim(subname),' ERROR: must specify a valid pointer index,', & + ' choices are ptr_atm, ptr_lnd, ptr_gcell, ptr_lunit, ptr_col, ptr_pft' + call endrun() + + end if + + ! Set scaling factor + + scale_type_p2c = 'unity' + scale_type_c2l = 'unity' + scale_type_l2g = 'unity' + + if (present(p2c_scale_type)) scale_type_p2c = p2c_scale_type + if (present(c2l_scale_type)) scale_type_c2l = c2l_scale_type + if (present(l2g_scale_type)) scale_type_l2g = l2g_scale_type + if (present(type1d_out)) l_type1d_out = type1d_out + + ! Add field to masterlist + + call masterlist_addfld (fname=trim(fname), type1d=l_type1d, type1d_out=l_type1d_out, & + type2d=type2d, num2d=num2d, & + units=units, avgflag=avgflag, long_name=long_name, hpindex=hpindex, & + p2c_scale_type=scale_type_p2c, c2l_scale_type=scale_type_c2l, l2g_scale_type=scale_type_l2g) + + if (present(default)) then + if (trim(default) == 'inactive') return + else + call masterlist_make_active (name=trim(fname), tape_index=1) + end if + + end subroutine hist_addfld2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: pointer_index +! +! !INTERFACE: + integer function pointer_index () +! +! !DESCRIPTION: +! Set the current pointer index and increment the value of the index. +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +!EOP + integer, save :: lastindex = 1 + character(len=*),parameter :: subname = 'pointer_index' +!----------------------------------------------------------------------- + + pointer_index = lastindex + lastindex = lastindex + 1 + if (lastindex > max_mapflds) then + write(iulog,*) trim(subname),' ERROR: ',& + ' lastindex = ',lastindex,' greater than max_mapflds= ',max_mapflds + call endrun() + endif + + end function pointer_index + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_add_subscript +! +! !INTERFACE: + subroutine hist_add_subscript(name, dim) +! +! !DESCRIPTION: +! Add a history variable to the output history tape. +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: name ! name of subscript + integer , intent(in) :: dim ! dimension of subscript +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=*),parameter :: subname = 'hist_add_subscript' +!----------------------------------------------------------------------- + + num_subs = num_subs + 1 + if (num_subs > max_subs) then + write(iulog,*) trim(subname),' ERROR: ',& + ' num_subs = ',num_subs,' greater than max_subs= ',max_subs + call endrun() + endif + subs_name(num_subs) = name + subs_dim(num_subs) = dim + + end subroutine hist_add_subscript + +!----------------------------------------------------------------------- + + subroutine strip_null(str) + character(len=*), intent(inout) :: str + integer :: i + do i=1,len(str) + if(ichar(str(i:i))==0) str(i:i)=' ' + end do + end subroutine strip_null + +!------------------------------------------------------------------------ +!BOP +! +! !ROUTINE: hist_do_disp +! +! !INTERFACE: + subroutine hist_do_disp (ntapes, hist_ntimes, hist_mfilt, if_stop, if_disphist, rstwr, nlend) +! +! !DESCRIPTION: +! Determine logic for closeing and/or disposing history file +! Sets values for if_disphist, if_stop (arguments) +! Remove history files unless this is end of run or +! history file is not full. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_abort + use clm_time_manager, only : is_last_step +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: ntapes !actual number of history tapes + integer, intent(in) :: hist_ntimes(ntapes) !current numbers of time samples on history tape + integer, intent(in) :: hist_mfilt(ntapes) !maximum number of time samples per tape + logical, intent(out) :: if_stop !true => last time step of run + logical, intent(out) :: if_disphist(ntapes) !true => save and dispose history file + logical, intent(in) :: rstwr + logical, intent(in) :: nlend + ! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: t ! history tape index + logical :: rest_now ! temporary + logical :: stop_now ! temporary +!------------------------------------------------------------------------ + + rest_now = .false. + stop_now = .false. + + if (nlend) stop_now = .true. + if (rstwr) rest_now = .true. + + if_stop = stop_now + + if (stop_now) then + ! End of run - dispose all history files + + if_disphist(1:ntapes) = .true. + + else if (rest_now) then + ! Restart - dispose all history files + + do t = 1,ntapes + if_disphist(t) = .true. + end do + else + ! Dispose + + if_disphist(1:ntapes) = .false. + do t = 1,ntapes + if (hist_ntimes(t) == hist_mfilt(t)) then + if_disphist(t) = .true. + endif + end do + endif + + end subroutine hist_do_disp + +end module histFileMod + diff --git a/components/clm/src_clm40/main/histFldsMod.F90 b/components/clm/src_clm40/main/histFldsMod.F90 new file mode 100644 index 0000000000..9004215912 --- /dev/null +++ b/components/clm/src_clm40/main/histFldsMod.F90 @@ -0,0 +1,4599 @@ +module histFldsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: histFldsMod +! +! !DESCRIPTION: +! Module containing initialization of clm history fields and files +! This is the module that the user must modify in order to add new +! history fields or modify defaults associated with existing history +! fields. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: + public hist_initFlds ! Build master field list of all possible history + ! file fields +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 03/2003 +! heald (11/28/06) +! +!EOP +!------------------------------------------------------------------------ + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: hist_initFlds +! +! !INTERFACE: + subroutine hist_initFlds() +! +! !DESCRIPTION: +! Build master field list of all possible fields in a history file. +! Each field has associated with it a ``long\_name'' netcdf attribute that +! describes what the field is, and a ``units'' attribute. A subroutine is +! called to add each field to the masterlist. +! +! !USES: + use clmtype + use clm_varcon , only : spval + use clm_varpar , only : maxpatch_glcmec + use clm_atmlnd , only : clm_a2l + use clm_glclnd , only : clm_s2x + use clm_varctl , only : create_glacier_mec_landunit, use_c13, use_cndv, use_cn, use_crop, & + use_snicar_frc + use histFileMod, only : hist_add_subscript, hist_addfld1d, hist_addfld2d, & + hist_printflds + use surfrdMod , only : crop_prog + use shr_megan_mod , only : shr_megan_linkedlist, shr_megan_megcomp_t, shr_megan_megcomps_n + +! +! !ARGUMENTS: + implicit none + + type(shr_megan_megcomp_t), pointer :: meg_cmp + integer :: imeg +! +! !REVISION HISTORY: +! Mariana Vertenstein: Created 03/2003 +! Mariana Vertenstein: Updated interface to create history fields 10/2003 +! +!EOP +!----------------------------------------------------------------------- + + ! Determine what subscripts to add + ! (uncomment the following call and modify it appropriately) + + ! call hist_add_subscript(subname='subscript_name', subdim=subscript_dim) + + ! NOTE: make a field not appear on the primary history tape by default - + ! add the keyword to default='inactive' to the call to addfld_1d or addfld_2d + + ! Snow properties + ! These will be vertically averaged over the snow profile + + call hist_addfld1d (fname='SNOWDP', units='m', & + avgflag='A', long_name='snow height', & + ptr_col=cps%snowdp, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSNO', units='unitless', & + avgflag='A', long_name='fraction of ground covered by snow', & + ptr_col=cps%frac_sno, c2l_scale_type='urbanf') + + ! Temperatures + + call hist_addfld1d (fname='TSA', units='K', & + avgflag='A', long_name='2m air temperature', & + ptr_pft=pes%t_ref2m) + + call hist_addfld1d (fname='TSA_U', units='K', & + avgflag='A', long_name='Urban 2m air temperature', & + ptr_pft=pes%t_ref2m_u, set_nourb=spval) + + call hist_addfld1d (fname='TSA_R', units='K', & + avgflag='A', long_name='Rural 2m air temperature', & + ptr_pft=pes%t_ref2m_r, set_spec=spval) + + call hist_addfld1d(fname='TBUILD', units='K', & + avgflag='A', long_name='internal urban building temperature', & + ptr_lunit=lps%t_building, set_nourb=spval, l2g_scale_type='unity') + + call hist_addfld1d (fname='TREFMNAV', units='K', & + avgflag='A', long_name='daily minimum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_min) + + call hist_addfld1d (fname='TREFMXAV', units='K', & + avgflag='A', long_name='daily maximum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_max) + + call hist_addfld1d (fname='TREFMNAV_U', units='K', & + avgflag='A', long_name='Urban daily minimum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_min_u, set_nourb=spval) + + call hist_addfld1d (fname='TREFMXAV_U', units='K', & + avgflag='A', long_name='Urban daily maximum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_max_u, set_nourb=spval) + + call hist_addfld1d (fname='TREFMNAV_R', units='K', & + avgflag='A', long_name='Rural daily minimum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_min_r, set_spec=spval) + + call hist_addfld1d (fname='TREFMXAV_R', units='K', & + avgflag='A', long_name='Rural daily maximum of average 2-m temperature', & + ptr_pft=pes%t_ref2m_max_r, set_spec=spval) + + call hist_addfld1d (fname='TV', units='K', & + avgflag='A', long_name='vegetation temperature', & + ptr_pft=pes%t_veg) + + call hist_addfld1d (fname='TV24', units='K', & + avgflag='A', long_name='vegetation temperature (last 24hrs)', & + ptr_pft=pvs%t_veg24, default='inactive') + + call hist_addfld1d (fname='TV240', units='K', & + avgflag='A', long_name='vegetation temperature (last 240hrs)', & + ptr_pft=pvs%t_veg240, default='inactive') + + call hist_addfld1d (fname='TG', units='K', & + avgflag='A', long_name='ground temperature', & + ptr_col=ces%t_grnd, c2l_scale_type='urbans') + + call hist_addfld1d (fname='TG_U', units='K', & + avgflag='A', long_name='Urban ground temperature', & + ptr_col=ces%t_grnd_u, set_nourb=spval, c2l_scale_type='urbans') + + call hist_addfld1d (fname='TG_R', units='K', & + avgflag='A', long_name='Rural ground temperature', & + ptr_col=ces%t_grnd_r, set_spec=spval) + + call hist_addfld1d (fname='HCSOI', units='MJ/m2', & + avgflag='A', long_name='soil heat content', & + ptr_col=ces%hc_soi, set_lake=spval, set_urb=spval, l2g_scale_type='veg') + + call hist_addfld1d (fname='HC', units='MJ/m2', & + avgflag='A', long_name='heat content of soil/snow/lake', & + ptr_col=ces%hc_soisno, set_urb=spval) + + call hist_addfld2d (fname='TSOI', units='K', type2d='levgrnd', & + avgflag='A', long_name='soil temperature (vegetated landunits only)', & + ptr_col=ces%t_soisno, l2g_scale_type='veg') + + call hist_addfld2d (fname='TSOI_ICE', units='K', type2d='levgrnd', & + avgflag='A', long_name='soil temperature (ice landunits only)', & + ptr_col=ces%t_soisno, l2g_scale_type='ice') + + call hist_addfld1d (fname='TSOI_10CM', units='K', & + avgflag='A', long_name='soil temperature in top 10cm of soil', & + ptr_col=ces%t_soi_10cm, set_urb=spval) + + call hist_addfld2d (fname='TLAKE', units='K', type2d='levlak', & + avgflag='A', long_name='lake temperature', & + ptr_col=ces%t_lake) + + ! Specific humidity + + call hist_addfld1d (fname='Q2M', units='kg/kg', & + avgflag='A', long_name='2m specific humidity', & + ptr_pft=pes%q_ref2m) + + ! Relative humidity + + call hist_addfld1d (fname='RH2M', units='%', & + avgflag='A', long_name='2m relative humidity', & + ptr_pft=pes%rh_ref2m) + + call hist_addfld1d (fname='RH2M_U', units='%', & + avgflag='A', long_name='Urban 2m relative humidity', & + ptr_pft=pes%rh_ref2m_u, set_nourb=spval) + + call hist_addfld1d (fname='RH2M_R', units='%', & + avgflag='A', long_name='Rural 2m specific humidity', & + ptr_pft=pes%rh_ref2m_r, set_spec=spval) + + ! Wind + + call hist_addfld1d (fname='U10', units='m/s', & + avgflag='A', long_name='10-m wind', & + ptr_pft=pps%u10_clm) + call hist_addfld1d (fname='VA', units='m/s', & + avgflag='A', long_name='atmospheric wind speed plus convective velocity', & + ptr_pft=pps%va, default='inactive') + + ! Surface radiation + + call hist_addfld1d (fname='SABV', units='W/m^2', & + avgflag='A', long_name='solar rad absorbed by veg', & + ptr_pft=pef%sabv, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='SABG', units='W/m^2', & + avgflag='A', long_name='solar rad absorbed by ground', & + ptr_pft=pef%sabg, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation', & + ptr_pft=pef%fsds_vis_d) + + call hist_addfld1d (fname='FSDSND', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation', & + ptr_pft=pef%fsds_nir_d) + + call hist_addfld1d (fname='FSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation', & + ptr_pft=pef%fsds_vis_i) + + call hist_addfld1d (fname='FSDSNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir incident solar radiation', & + ptr_pft=pef%fsds_nir_i) + + call hist_addfld1d (fname='FSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation', & + ptr_pft=pef%fsr_vis_d, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSRND', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation', & + ptr_pft=pef%fsr_nir_d, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation', & + ptr_pft=pef%fsr_vis_i, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSRNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir reflected solar radiation', & + ptr_pft=pef%fsr_nir_i, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSDSVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation at local noon', & + ptr_pft=pef%fsds_vis_d_ln) + + call hist_addfld1d (fname='FSDSNDLN', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation at local noon', & + ptr_pft=pef%fsds_nir_d_ln) + + call hist_addfld1d (fname='FSRVDLN', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation at local noon', & + ptr_pft=pef%fsr_vis_d_ln, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSRNDLN', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation at local noon', & + ptr_pft=pef%fsr_nir_d_ln, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSA', units='W/m^2', & + avgflag='A', long_name='absorbed solar radiation', & + ptr_pft=pef%fsa, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSA_U', units='W/m^2', & + avgflag='A', long_name='Urban absorbed solar radiation', & + ptr_pft=pef%fsa_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='FSA_R', units='W/m^2', & + avgflag='A', long_name='Rural absorbed solar radiation', & + ptr_pft=pef%fsa_r, set_spec=spval) + + call hist_addfld1d (fname='FSR', units='W/m^2', & + avgflag='A', long_name='reflected solar radiation', & + ptr_pft=pef%fsr, c2l_scale_type='urbanf') + + ! Rename of FSR for Urban intercomparision project + call hist_addfld1d (fname='SWup', units='W/m^2', & + avgflag='A', long_name='upwelling shortwave radiation', & + ptr_pft=pef%fsr, c2l_scale_type='urbanf', default='inactive') + + call hist_addfld1d (fname='FIRA', units='W/m^2', & + avgflag='A', long_name='net infrared (longwave) radiation', & + ptr_pft=pef%eflx_lwrad_net, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FIRA_U', units='W/m^2', & + avgflag='A', long_name='Urban net infrared (longwave) radiation', & + ptr_pft=pef%eflx_lwrad_net_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='FIRA_R', units='W/m^2', & + avgflag='A', long_name='Rural net infrared (longwave) radiation', & + ptr_pft=pef%eflx_lwrad_net_r, set_spec=spval) + + call hist_addfld1d (fname='FIRE', units='W/m^2', & + avgflag='A', long_name='emitted infrared (longwave) radiation', & + ptr_pft=pef%eflx_lwrad_out, c2l_scale_type='urbanf') + + ! Rename of FIRE for Urban intercomparision project + call hist_addfld1d (fname='LWup', units='W/m^2', & + avgflag='A', long_name='upwelling longwave radiation', & + ptr_pft=pef%eflx_lwrad_out, c2l_scale_type='urbanf', default='inactive') + + call hist_addfld1d (fname='BUILDHEAT', units='W/m^2', & + avgflag='A', long_name='heat flux from urban building interior to walls and roof', & + ptr_col=cef%eflx_building_heat, set_nourb=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='URBAN_AC', units='W/m^2', & + avgflag='A', long_name='urban air conditioning flux', & + ptr_col=cef%eflx_urban_ac, set_nourb=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='URBAN_HEAT', units='W/m^2', & + avgflag='A', long_name='urban heating flux', & + ptr_col=cef%eflx_urban_heat, set_nourb=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='TRAFFICFLUX', units='W/m^2', & + avgflag='A', long_name='sensible heat flux from urban traffic', & + ptr_pft=pef%eflx_traffic_pft, set_nourb=0._r8, c2l_scale_type='urbanf', & + default='inactive') + + call hist_addfld1d (fname='WASTEHEAT', units='W/m^2', & + avgflag='A', long_name='sensible heat flux from heating/cooling sources of urban waste heat', & + ptr_pft=pef%eflx_wasteheat_pft, set_nourb=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='HEAT_FROM_AC', units='W/m^2', & + avgflag='A', long_name='sensible heat flux put into canyon due to heat removed from air conditioning', & + ptr_pft=pef%eflx_heat_from_ac_pft, set_nourb=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='Qanth', units='W/m^2', & + avgflag='A', long_name='anthropogenic heat flux', & + ptr_pft=pef%eflx_anthro, set_nourb=0._r8, c2l_scale_type='urbanf', & + default='inactive') + + call hist_addfld1d (fname='Rnet', units='W/m^2', & + avgflag='A', long_name='net radiation', & + ptr_pft=pef%netrad, c2l_scale_type='urbanf', & + default='inactive') + + ! Solar zenith angle and solar declination angle + + call hist_addfld1d (fname='COSZEN', units='none', & + avgflag='A', long_name='cosine of solar zenith angle', & + ptr_col=cps%coszen, default='inactive') + + call hist_addfld1d (fname='DECL', units='radians', & + avgflag='A', long_name='solar declination angle', & + ptr_col=cps%decl, default='inactive') + + ! Surface energy fluxes + + call hist_addfld1d (fname='FCTR', units='W/m^2', & + avgflag='A', long_name='canopy transpiration', & + ptr_pft=pef%eflx_lh_vegt, set_lake=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FCEV', units='W/m^2', & + avgflag='A', long_name='canopy evaporation', & + ptr_pft=pef%eflx_lh_vege, set_lake=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FGEV', units='W/m^2', & + avgflag='A', long_name='ground evaporation', & + ptr_pft=pef%eflx_lh_grnd, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSH_NODYNLNDUSE', units='W/m^2', & + avgflag='A', long_name='sensible heat not including correction for land use change', & + ptr_pft=pef%eflx_sh_tot, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSH', units='W/m^2', & + avgflag='A', long_name='sensible heat', & + ptr_lnd=gef%eflx_sh_totg) + + call hist_addfld1d (fname='FSH_U', units='W/m^2', & + avgflag='A', long_name='Urban sensible heat', & + ptr_pft=pef%eflx_sh_tot_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='FSH_R', units='W/m^2', & + avgflag='A', long_name='Rural sensible heat', & + ptr_pft=pef%eflx_sh_tot_r, set_spec=spval) + + call hist_addfld1d (fname='GC_HEAT1', units='J/m^2', & + avgflag='A', long_name='initial gridcell total heat content', & + ptr_lnd=ges%gc_heat1) + + call hist_addfld1d (fname='GC_HEAT2', units='J/m^2', & + avgflag='A', long_name='post land cover change total heat content', & + ptr_lnd=ges%gc_heat2, default='inactive') + + call hist_addfld1d (fname='EFLX_DYNBAL', units='W/m^2', & + avgflag='A', long_name='dynamic land cover change conversion energy flux', & + ptr_lnd=gef%eflx_dynbal) + + call hist_addfld1d (fname='Qh', units='W/m^2', & + avgflag='A', long_name='sensible heat', & + ptr_pft=pef%eflx_sh_tot, c2l_scale_type='urbanf', & + default = 'inactive') + + call hist_addfld1d (fname='Qle', units='W/m^2', & + avgflag='A', long_name='total evaporation', & + ptr_pft=pef%eflx_lh_tot, c2l_scale_type='urbanf', & + default = 'inactive') + + call hist_addfld1d (fname='EFLX_LH_TOT_U', units='W/m^2', & + avgflag='A', long_name='Urban total evaporation', & + ptr_pft=pef%eflx_lh_tot_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='EFLX_LH_TOT_R', units='W/m^2', & + avgflag='A', long_name='Rural total evaporation', & + ptr_pft=pef%eflx_lh_tot_r, set_spec=spval) + + call hist_addfld1d (fname='Qstor', units='W/m^2', & + avgflag='A', long_name='storage heat flux (includes snowmelt)', & + ptr_pft=pef%eflx_soil_grnd, c2l_scale_type='urbanf', & + default = 'inactive') + + call hist_addfld1d (fname='FSH_V', units='W/m^2', & + avgflag='A', long_name='sensible heat from veg', & + ptr_pft=pef%eflx_sh_veg, set_lake=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSH_G', units='W/m^2', & + avgflag='A', long_name='sensible heat from ground', & + ptr_pft=pef%eflx_sh_grnd, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FGR', units='W/m^2', & + avgflag='A', long_name='heat flux into soil/snow including snow melt', & + ptr_pft=pef%eflx_soil_grnd, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FGR_U', units='W/m^2', & + avgflag='A', long_name='Urban heat flux into soil/snow including snow melt', & + ptr_pft=pef%eflx_soil_grnd_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='FGR_R', units='W/m^2', & + avgflag='A', long_name='Rural heat flux into soil/snow including snow melt', & + ptr_pft=pef%eflx_soil_grnd_r, set_spec=spval) + + call hist_addfld1d (fname='FSM', units='W/m^2', & + avgflag='A', long_name='snow melt heat flux', & + ptr_col=cef%eflx_snomelt, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='FSM_U', units='W/m^2', & + avgflag='A', long_name='Urban snow melt heat flux', & + ptr_col=cef%eflx_snomelt_u, c2l_scale_type='urbanf', set_nourb=spval) + + call hist_addfld1d (fname='FSM_R', units='W/m^2', & + avgflag='A', long_name='Rural snow melt heat flux', & + ptr_col=cef%eflx_snomelt_r, set_spec=spval) + + call hist_addfld1d (fname='FGR12', units='W/m^2', & + avgflag='A', long_name='heat flux between soil layers 1 and 2', & + ptr_col=cef%eflx_fgr12, set_lake=spval) + + call hist_addfld1d (fname='TAUX', units='kg/m/s^2', & + avgflag='A', long_name='zonal surface stress', & + ptr_pft=pmf%taux) + + ! Rename of TAUX for Urban intercomparision project (when U=V) + call hist_addfld1d (fname='Qtau', units='kg/m/s^2', & + avgflag='A', long_name='momentum flux', & + ptr_pft=pmf%taux, default='inactive') + + call hist_addfld1d (fname='TAUY', units='kg/m/s^2', & + avgflag='A', long_name='meridional surface stress', & + ptr_pft=pmf%tauy) + + ! Vegetation phenology + + call hist_addfld1d (fname='ELAI', units='m^2/m^2', & + avgflag='A', long_name='exposed one-sided leaf area index', & + ptr_pft=pps%elai) + + call hist_addfld1d (fname='ESAI', units='m^2/m^2', & + avgflag='A', long_name='exposed one-sided stem area index', & + ptr_pft=pps%esai) + + call hist_addfld1d (fname='LAISUN', units='none', & + avgflag='A', long_name='sunlit projected leaf area index', & + ptr_pft=pps%laisun, set_urb=0._r8) + + call hist_addfld1d (fname='LAISHA', units='none', & + avgflag='A', long_name='shaded projected leaf area index', & + ptr_pft=pps%laisha, set_urb=0._r8) + + call hist_addfld1d (fname='TLAI', units='none', & + avgflag='A', long_name='total projected leaf area index', & + ptr_pft=pps%tlai) + + call hist_addfld1d (fname='TSAI', units='none', & + avgflag='A', long_name='total projected stem area index', & + ptr_pft=pps%tsai) + + call hist_addfld1d (fname='SLASUN', units='m^2/gC', & + avgflag='A', long_name='specific leaf area for sunlit canopy, projected area basis', & + ptr_pft=pps%slasun, set_urb=0._r8, default='inactive') + + call hist_addfld1d (fname='SLASHA', units='m^2/gC', & + avgflag='A', long_name='specific leaf area for shaded canopy, projected area basis', & + ptr_pft=pps%slasha, set_urb=0._r8, default='inactive') + + ! Canopy physiology + + call hist_addfld1d (fname='RSSUN', units='s/m', & + avgflag='M', long_name='sunlit leaf stomatal resistance', & + ptr_pft=pps%rssun, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='RSSHA', units='s/m', & + avgflag='M', long_name='shaded leaf stomatal resistance', & + ptr_pft=pps%rssha, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='BTRAN', units='unitless', & + avgflag='A', long_name='transpiration beta factor', & + ptr_pft=pps%btran, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='FPSN', units='umol/m2s', & + avgflag='A', long_name='photosynthesis', & + ptr_pft=pcf%fpsn, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='DSTFLXT', units='kg/m2/s', & + avgflag='A', long_name='total surface dust emission', & + ptr_pft=pdf%flx_mss_vrt_dst_tot, set_lake=0._r8, set_urb=0._r8) + call hist_addfld1d (fname='DPVLTRB1', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 1', & + ptr_pft=pdf%vlc_trb_1, default='inactive') + call hist_addfld1d (fname='DPVLTRB2', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 2', & + ptr_pft=pdf%vlc_trb_2, default='inactive') + call hist_addfld1d (fname='DPVLTRB3', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 3', & + ptr_pft=pdf%vlc_trb_3, default='inactive') + call hist_addfld1d (fname='DPVLTRB4', units='m/s', & + avgflag='A', long_name='turbulent deposition velocity 4', & + ptr_pft=pdf%vlc_trb_4, default='inactive') + + ! for MEGAN emissions diagnositics + if (shr_megan_megcomps_n>0) then + + ! loop over megan compounds + meg_cmp => shr_megan_linkedlist + do while(associated(meg_cmp)) + imeg = meg_cmp%index + + call hist_addfld1d ( fname='MEG_'//trim(meg_cmp%name), units='kg/m2/sec', & + avgflag='A', long_name='MEGAN flux', & + ptr_pft=pvf%meg(imeg)%flux_out, set_lake=0._r8, set_urb=0._r8 ) + + meg_cmp => meg_cmp%next_megcomp + enddo + + call hist_addfld1d (fname='VOCFLXT', units='moles/m2/sec', & + avgflag='A', long_name='total VOC flux into atmosphere', & + ptr_pft=pvf%vocflx_tot, set_lake=0._r8, set_urb=0._r8) + + call hist_addfld1d (fname='GAMMA', units='non', & + avgflag='A', long_name='total gamma for VOC calc', & + ptr_pft=pvf%gamma_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAL', units='non', & + avgflag='A', long_name='gamma L for VOC calc', & + ptr_pft=pvf%gammaL_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAT', units='non', & + avgflag='A', long_name='gamma T for VOC calc', & + ptr_pft=pvf%gammaT_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAP', units='non', & + avgflag='A', long_name='gamma P for VOC calc', & + ptr_pft=pvf%gammaP_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAA', units='non', & + avgflag='A', long_name='gamma A for VOC calc', & + ptr_pft=pvf%gammaA_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAS', units='non', & + avgflag='A', long_name='gamma S for VOC calc', & + ptr_pft=pvf%gammaS_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='GAMMAC', units='non', & + avgflag='A', long_name='gamma C for VOC calc', & + ptr_pft=pvf%gammaC_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='EOPT', units='non', & + avgflag='A', long_name='Eopt coefficient for VOC calc', & + ptr_pft=pvf%Eopt_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='TOPT', units='non', & + avgflag='A', long_name='topt coefficient for VOC calc', & + ptr_pft=pvf%topt_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='ALPHA', units='non', & + avgflag='A', long_name='alpha coefficient for VOC calc', & + ptr_pft=pvf%alpha_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='CP', units='non', & + avgflag='A', long_name='cp coefficient for VOC calc', & + ptr_pft=pvf%cp_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR', & + ptr_pft=pvf%paru_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR24_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR (24 hrs)', & + ptr_pft=pvf%par24u_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR240_sun', units='umol/m2/s', & + avgflag='A', long_name='sunlit PAR (240 hrs)', & + ptr_pft=pvf%par240u_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR', & + ptr_pft=pvf%para_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR24_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR (24 hrs)', & + ptr_pft=pvf%par24a_out, set_lake=0._r8, default='inactive') + + call hist_addfld1d (fname='PAR240_shade', units='umol/m2/s', & + avgflag='A', long_name='shade PAR (240 hrs)', & + ptr_pft=pvf%par240a_out, set_lake=0._r8, default='inactive') + + endif + + call hist_addfld1d (fname='FSUN24', units='K', & + avgflag='A', long_name='fraction sunlit (last 24hrs)', & + ptr_pft=pvs%fsun24, default='inactive') + + call hist_addfld1d (fname='FSUN240', units='K', & + avgflag='A', long_name='fraction sunlit (last 240hrs)', & + ptr_pft=pvs%fsun240, default='inactive') + + call hist_addfld1d (fname='FSI24', units='K', & + avgflag='A', long_name='indirect radiation (last 24hrs)', & + ptr_pft=pvs%fsi24, default='inactive') + + call hist_addfld1d (fname='FSI240', units='K', & + avgflag='A', long_name='indirect radiation (last 240hrs)', & + ptr_pft=pvs%fsi240, default='inactive') + + call hist_addfld1d (fname='FSD24', units='K', & + avgflag='A', long_name='direct radiation (last 24hrs)', & + ptr_pft=pvs%fsd24, default='inactive') + + call hist_addfld1d (fname='FSD240', units='K', & + avgflag='A', long_name='direct radiation (last 240hrs)', & + ptr_pft=pvs%fsd240, default='inactive') + + ! Hydrology + + call hist_addfld1d (fname='SoilAlpha', units='unitless', & + avgflag='A', long_name='factor limiting ground evap', & + ptr_col=cws%soilalpha, set_urb=spval) + + call hist_addfld1d (fname='SoilAlpha_U', units='unitless', & + avgflag='A', long_name='urban factor limiting ground evap', & + ptr_col=cws%soilalpha_u, set_nourb=spval) + + call hist_addfld1d (fname='FCOV', units='unitless', & + avgflag='A', long_name='fractional impermeable area', & + ptr_col=cws%fcov, l2g_scale_type='veg') + call hist_addfld1d (fname='FSAT', units='unitless', & + avgflag='A', long_name='fractional area with water table at surface', & + ptr_col=cws%fsat, l2g_scale_type='veg') + call hist_addfld1d (fname='ZWT', units='m', & + avgflag='A', long_name='water table depth (vegetated landunits only)', & + ptr_col=cws%zwt, l2g_scale_type='veg') + + call hist_addfld1d (fname='WA', units='mm', & + avgflag='A', long_name='water in the unconfined aquifer (vegetated landunits only)', & + ptr_col=cws%wa, l2g_scale_type='veg') + + call hist_addfld1d (fname='WT', units='mm', & + avgflag='A', long_name='total water storage (unsaturated soil water + groundwater, veg landunits)', & + ptr_col=cws%wt, l2g_scale_type='veg') + + call hist_addfld1d (fname='QCHARGE', units='mm/s', & + avgflag='A', long_name='aquifer recharge rate (vegetated landunits only)', & + ptr_col=cws%qcharge, l2g_scale_type='veg') + + call hist_addfld2d (fname='SMP', units='mm', type2d='levgrnd', & + avgflag='A', long_name='soil matric potential (vegetated landunits only)', & + ptr_col=cws%smp_l, set_spec=spval, l2g_scale_type='veg', default='inactive') + + call hist_addfld2d (fname='HK', units='mm/s', type2d='levgrnd', & + avgflag='A', long_name='hydraulic conductivity (vegetated landunits only)', & + ptr_col=cws%hk_l, set_spec=spval, l2g_scale_type='veg', default='inactive') + + call hist_addfld1d (fname='H2OSNO', units='mm', & + avgflag='A', long_name='snow depth (liquid water)', & + ptr_col=cws%h2osno, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='ERRH2OSNO', units='mm', & + avgflag='A', long_name='imbalance in snow depth (liquid water)', & + ptr_col=cws%errh2osno, c2l_scale_type='urbanf') + + ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at + ! any given time step but only if there is at least one snow layer (for all landunits + ! except lakes). h2osno also includes snow that is part of the soil column (an + ! initial snow layer is only created if h2osno > 10mm). Also note that monthly average + ! files of snow_sources and snow sinks must be weighted by number of days in the month to + ! diagnose, for example, an annual value of the change in h2osno. + + call hist_addfld1d (fname='SNOW_SOURCES', units='mm/s', & + avgflag='A', long_name='snow sources (liquid water)', & + ptr_col=cws%snow_sources, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='SNOW_SINKS', units='mm/s', & + avgflag='A', long_name='snow sinks (liquid water)', & + ptr_col=cws%snow_sinks, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='H2OCAN', units='mm', & + avgflag='A', long_name='intercepted water', & + ptr_pft=pws%h2ocan, set_lake=0._r8) + + call hist_addfld2d (fname='H2OSOI', units='mm3/mm3', type2d='levgrnd', & + avgflag='A', long_name='volumetric soil water (vegetated landunits only)', & + ptr_col=cws%h2osoi_vol, l2g_scale_type='veg') + + call hist_addfld2d (fname='SOILLIQ', units='kg/m2', type2d='levgrnd', & + avgflag='A', long_name='soil liquid water (vegetated landunits only)', & + ptr_col=cws%h2osoi_liq, l2g_scale_type='veg') + + call hist_addfld2d (fname='SOILICE', units='kg/m2', type2d='levgrnd', & + avgflag='A', long_name='soil ice (vegetated landunits only)', & + ptr_col=cws%h2osoi_ice, l2g_scale_type='veg') + + call hist_addfld1d (fname='SOILWATER_10CM', units='kg/m2', & + avgflag='A', long_name='soil liquid water + ice in top 10cm of soil (veg landunits only)', & + ptr_col=cws%h2osoi_liqice_10cm, set_urb=spval, l2g_scale_type='veg') + + call hist_addfld1d (fname='SNOWLIQ', units='kg/m2', & + avgflag='A', long_name='snow liquid water', & + ptr_col=cws%snowliq) + + call hist_addfld1d (fname='SNOWICE', units='kg/m2', & + avgflag='A', long_name='snow ice', & + ptr_col=cws%snowice) + + call hist_addfld1d (fname='QTOPSOIL', units='mm/s', & + avgflag='A', long_name='water input to surface', & + ptr_col=cwf%qflx_top_soil, c2l_scale_type='urbanf', default='inactive') + + call hist_addfld1d (fname='QINFL', units='mm/s', & + avgflag='A', long_name='infiltration', & + ptr_col=cwf%qflx_infl, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QOVER', units='mm/s', & + avgflag='A', long_name='surface runoff', & + ptr_col=cwf%qflx_surf, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QRGWL', units='mm/s', & + avgflag='A', long_name='surface runoff at glaciers (liquid only), wetlands, lakes', & + ptr_col=cwf%qflx_qrgwl, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QSNWCPLIQ', units='mm H2O/s', & + avgflag='A', long_name='excess rainfall due to snow capping', & + ptr_pft=pwf%qflx_snwcp_liq, c2l_scale_type='urbanf', default='inactive') + + call hist_addfld1d (fname='QSNWCPICE_NODYNLNDUSE', units='mm H2O/s', & + avgflag='A', & + long_name='excess snowfall due to snow capping not including correction for land use change', & + ptr_pft=pwf%qflx_snwcp_ice, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QSNWCPICE', units='mm/s', & + avgflag='A', long_name='excess snowfall due to snow capping', & + ptr_lnd=gwf%qflx_snwcp_iceg) + + call hist_addfld1d (fname='QDRAI', units='mm/s', & + avgflag='A', long_name='sub-surface drainage', & + ptr_col=cwf%qflx_drain, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QRUNOFF_NODYNLNDUSE', units='mm/s', & + avgflag='A', & + long_name='total liquid runoff (does not include QSNWCPICE) not including correction for land use change', & + ptr_col=cwf%qflx_runoff, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QRUNOFF', units='mm/s', & + avgflag='A', long_name='total liquid runoff (does not include QSNWCPICE)', & + ptr_lnd=gwf%qflx_runoffg) + + call hist_addfld1d (fname='GC_LIQ1', units='mm', & + avgflag='A', long_name='initial gridcell total liq content', & + ptr_lnd=gws%gc_liq1) + + call hist_addfld1d (fname='GC_LIQ2', units='mm', & + avgflag='A', long_name='post landuse change gridcell total liq content', & + ptr_lnd=gws%gc_liq2, default='inactive') + + call hist_addfld1d (fname='QFLX_LIQ_DYNBAL', units='mm/s', & + avgflag='A', long_name='liq dynamic land cover change conversion runoff flux', & + ptr_lnd=gwf%qflx_liq_dynbal) + + call hist_addfld1d (fname='GC_ICE1', units='mm', & + avgflag='A', long_name='initial gridcell total ice content', & + ptr_lnd=gws%gc_ice1) + + call hist_addfld1d (fname='GC_ICE2', units='mm', & + avgflag='A', long_name='post land cover change total ice content', & + ptr_lnd=gws%gc_ice2, default='inactive') + + call hist_addfld1d (fname='QFLX_ICE_DYNBAL', units='mm/s', & + avgflag='A', long_name='ice dynamic land cover change conversion runoff flux', & + ptr_lnd=gwf%qflx_ice_dynbal) + + call hist_addfld1d (fname='QRUNOFF_U', units='mm/s', & + avgflag='A', long_name='Urban total runoff', & + ptr_col=cwf%qflx_runoff_u, set_nourb=spval, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QRUNOFF_R', units='mm/s', & + avgflag='A', long_name='Rural total runoff', & + ptr_col=cwf%qflx_runoff_r, set_spec=spval) + + call hist_addfld1d (fname='QINTR', units='mm/s', & + avgflag='A', long_name='interception', & + ptr_pft=pwf%qflx_prec_intr, set_lake=0._r8) + + call hist_addfld1d (fname='QDRIP', units='mm/s', & + avgflag='A', long_name='throughfall', & + ptr_pft=pwf%qflx_prec_grnd, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QSNOMELT', units='mm/s', & + avgflag='A', long_name='snow melt', & + ptr_col=cwf%qflx_snomelt, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QSNOFRZ', units='kg/m2/s', & + avgflag='A', long_name='column-integrated snow freezing rate', & + ptr_col=cwf%qflx_snofrz_col, default='inactive', & + set_lake=spval, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QSOIL', units='mm/s', & + avgflag='A', long_name= & + 'Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew)', & + ptr_pft=pwf%qflx_evap_soi, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QVEGE', units='mm/s', & + avgflag='A', long_name='canopy evaporation', & + ptr_pft=pwf%qflx_evap_can, set_lake=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QVEGT', units='mm/s', & + avgflag='A', long_name='canopy transpiration', & + ptr_pft=pwf%qflx_tran_veg, set_lake=0._r8, c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QIRRIG', units='mm/s', & + avgflag='A', long_name='water added through irrigation', & + ptr_col=cwf%qflx_irrig, set_lake=0._r8) + + if (create_glacier_mec_landunit) then + + call hist_addfld1d (fname='QICE', units='mm/s', & + avgflag='A', long_name='ice growth/melt', & + ptr_col=cwf%qflx_glcice, set_noglcmec=spval) + + call hist_addfld1d (fname='QICE_FRZ', units='mm/s', & + avgflag='A', long_name='ice growth', & + ptr_col=cwf%qflx_glcice_frz, set_noglcmec=spval) + + call hist_addfld1d (fname='QICE_MELT', units='mm/s', & + avgflag='A', long_name='ice melt', & + ptr_col=cwf%qflx_glcice_melt, set_noglcmec=spval) + + call hist_addfld1d (fname='gris_mask', units='unitless', & + avgflag='A', long_name='Greenland mask', & + ptr_gcell=grc%gris_mask) + + call hist_addfld1d (fname='gris_area', units='km^2', & + avgflag='A', long_name='Greenland ice area', & + ptr_gcell=grc%gris_area) + + call hist_addfld1d (fname='aais_mask', units='unitless', & + avgflag='A', long_name='Antarctic mask', & + ptr_gcell=grc%aais_mask) + + call hist_addfld1d (fname='aais_area', units='km^2', & + avgflag='A', long_name='Antarctic ice area', & + ptr_gcell=grc%aais_area) + + endif + + ! Water and energy balance checks + + call hist_addfld1d (fname='ERRSOI', units='W/m^2', & + avgflag='A', long_name='soil/lake energy conservation error', & + ptr_col=cebal%errsoi) + + call hist_addfld1d (fname='ERRSEB', units='W/m^2', & + avgflag='A', long_name='surface energy conservation error', & + ptr_pft=pebal%errseb) + + call hist_addfld1d (fname='ERRSOL', units='W/m^2', & + avgflag='A', long_name='solar radiation conservation error', & + ptr_pft=pebal%errsol, set_urb=spval) + + call hist_addfld1d (fname='ERRH2O', units='mm', & + avgflag='A', long_name='total water conservation error', & + ptr_col=cwbal%errh2o) + + ! Atmospheric forcing + + call hist_addfld1d (fname='RAIN', units='mm/s', & + avgflag='A', long_name='atmospheric rain', & + ptr_lnd=clm_a2l%forc_rain) + + call hist_addfld1d (fname='SNOW', units='mm/s', & + avgflag='A', long_name='atmospheric snow', & + ptr_lnd=clm_a2l%forc_snow) + + call hist_addfld1d (fname='TBOT', units='K', & + avgflag='A', long_name='atmospheric air temperature', & + ptr_lnd=clm_a2l%forc_t) + + call hist_addfld1d (fname='THBOT', units='K', & + avgflag='A', long_name='atmospheric air potential temperature', & + ptr_lnd=clm_a2l%forc_th) + + call hist_addfld1d (fname='WIND', units='m/s', & + avgflag='A', long_name='atmospheric wind velocity magnitude', & + ptr_lnd=clm_a2l%forc_wind) + + ! Rename of WIND for Urban intercomparision project + call hist_addfld1d (fname='Wind', units='m/s', & + avgflag='A', long_name='atmospheric wind velocity magnitude', & + ptr_gcell=clm_a2l%forc_wind, default = 'inactive') + + call hist_addfld1d (fname='Tair', units='K', & + avgflag='A', long_name='atmospheric air temperature', & + ptr_gcell=clm_a2l%forc_t, default='inactive') + + call hist_addfld1d (fname='PSurf', units='Pa', & + avgflag='A', long_name='surface pressure', & + ptr_gcell=clm_a2l%forc_pbot, default='inactive') + + call hist_addfld1d (fname='Rainf', units='mm/s', & + avgflag='A', long_name='atmospheric rain', & + ptr_gcell=clm_a2l%forc_rain, default='inactive') + + call hist_addfld1d (fname='SWdown', units='W/m^2', & + avgflag='A', long_name='atmospheric incident solar radiation', & + ptr_gcell=clm_a2l%forc_solar, default='inactive') + + call hist_addfld1d (fname='LWdown', units='W/m^2', & + avgflag='A', long_name='atmospheric longwave radiation', & + ptr_gcell=clm_a2l%forc_lwrad, default='inactive') + + call hist_addfld1d (fname='RH', units='%', & + avgflag='A', long_name='atmospheric relative humidity', & + ptr_gcell=clm_a2l%forc_rh, default='inactive') + + call hist_addfld1d (fname='QBOT', units='kg/kg', & + avgflag='A', long_name='atmospheric specific humidity', & + ptr_lnd=clm_a2l%forc_q) + + ! Rename of QBOT for Urban intercomparision project + call hist_addfld1d (fname='Qair', units='kg/kg', & + avgflag='A', long_name='atmospheric specific humidity', & + ptr_lnd=clm_a2l%forc_q, default='inactive') + + call hist_addfld1d (fname='ZBOT', units='m', & + avgflag='A', long_name='atmospheric reference height', & + ptr_lnd=clm_a2l%forc_hgt) + + call hist_addfld1d (fname='FLDS', units='W/m^2', & + avgflag='A', long_name='atmospheric longwave radiation', & + ptr_lnd=clm_a2l%forc_lwrad) + + call hist_addfld1d (fname='FSDS', units='W/m^2', & + avgflag='A', long_name='atmospheric incident solar radiation', & + ptr_lnd=clm_a2l%forc_solar) + + call hist_addfld1d (fname='PCO2', units='Pa', & + avgflag='A', long_name='atmospheric partial pressure of CO2', & + ptr_lnd=clm_a2l%forc_pco2) + + call hist_addfld1d (fname='PBOT', units='Pa', & + avgflag='A', long_name='atmospheric pressure', & + ptr_lnd=clm_a2l%forc_pbot) + + if (use_cndv .or. use_crop) then + call hist_addfld1d (fname='T10', units='K', & + avgflag='A', long_name='10-day running mean of 2-m temperature', & + ptr_pft=pes%t10) + end if + + if (use_cndv) then + call hist_addfld1d (fname='TDA', units='K', & + avgflag='A', long_name='daily average 2-m temperature', & + ptr_pft=pdgvs%t_mo) + + call hist_addfld1d (fname='AGDD', units='K', & + avgflag='A', long_name='growing degree-days base 5C', & + ptr_pft=pdgvs%agdd) + end if + + if (use_cn) then + call hist_addfld2d (fname='SOILPSI', units='MPa', type2d='levgrnd', & + avgflag='A', long_name='soil water potential in each soil layer', & + ptr_col=cps%soilpsi) + end if + + if (use_cn) then + ! add history fields for all CN variables, always set as default='inactive' + if ( crop_prog )then + + call hist_addfld1d (fname='A5TMIN', units='K', & + avgflag='A', long_name='5-day running mean of min 2-m temperature', & + ptr_pft=pes%a5tmin, default='inactive') + + call hist_addfld1d (fname='A10TMIN', units='K', & + avgflag='A', long_name='10-day running mean of min 2-m temperature', & + ptr_pft=pes%a10tmin, default='inactive') + + end if + + !------------------------------- + ! C state variables - native to PFT + !------------------------------- + ! add history fields for all CLAMP CN variables + + call hist_addfld1d (fname='WOODC', units='gC/m^2', & + avgflag='A', long_name='wood C', & + ptr_pft=pcs%woodc) + + call hist_addfld1d (fname='LEAFC', units='gC/m^2', & + avgflag='A', long_name='leaf C', & + ptr_pft=pcs%leafc) + + call hist_addfld1d (fname='LEAFC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='leaf C storage', & + ptr_pft=pcs%leafc_storage, default='inactive') + + call hist_addfld1d (fname='LEAFC_XFER', units='gC/m^2', & + avgflag='A', long_name='leaf C transfer', & + ptr_pft=pcs%leafc_xfer, default='inactive') + + call hist_addfld1d (fname='FROOTC', units='gC/m^2', & + avgflag='A', long_name='fine root C', & + ptr_pft=pcs%frootc) + + call hist_addfld1d (fname='FROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='fine root C storage', & + ptr_pft=pcs%frootc_storage, default='inactive') + + call hist_addfld1d (fname='FROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='fine root C transfer', & + ptr_pft=pcs%frootc_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMC', units='gC/m^2', & + avgflag='A', long_name='live stem C', & + ptr_pft=pcs%livestemc) + + call hist_addfld1d (fname='LIVESTEMC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='live stem C storage', & + ptr_pft=pcs%livestemc_storage, default='inactive') + + call hist_addfld1d (fname='LIVESTEMC_XFER', units='gC/m^2', & + avgflag='A', long_name='live stem C transfer', & + ptr_pft=pcs%livestemc_xfer, default='inactive') + + call hist_addfld1d (fname='DEADSTEMC', units='gC/m^2', & + avgflag='A', long_name='dead stem C', & + ptr_pft=pcs%deadstemc) + + call hist_addfld1d (fname='DEADSTEMC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='dead stem C storage', & + ptr_pft=pcs%deadstemc_storage, default='inactive') + + call hist_addfld1d (fname='DEADSTEMC_XFER', units='gC/m^2', & + avgflag='A', long_name='dead stem C transfer', & + ptr_pft=pcs%deadstemc_xfer, default='inactive') + + call hist_addfld1d (fname='LIVECROOTC', units='gC/m^2', & + avgflag='A', long_name='live coarse root C', & + ptr_pft=pcs%livecrootc) + + call hist_addfld1d (fname='LIVECROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='live coarse root C storage', & + ptr_pft=pcs%livecrootc_storage, default='inactive') + + call hist_addfld1d (fname='LIVECROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='live coarse root C transfer', & + ptr_pft=pcs%livecrootc_xfer, default='inactive') + + call hist_addfld1d (fname='DEADCROOTC', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C', & + ptr_pft=pcs%deadcrootc) + + call hist_addfld1d (fname='DEADCROOTC_STORAGE', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C storage', & + ptr_pft=pcs%deadcrootc_storage, default='inactive') + + call hist_addfld1d (fname='DEADCROOTC_XFER', units='gC/m^2', & + avgflag='A', long_name='dead coarse root C transfer', & + ptr_pft=pcs%deadcrootc_xfer, default='inactive') + + call hist_addfld1d (fname='GRESP_STORAGE', units='gC/m^2', & + avgflag='A', long_name='growth respiration storage', & + ptr_pft=pcs%gresp_storage, default='inactive') + + call hist_addfld1d (fname='GRESP_XFER', units='gC/m^2', & + avgflag='A', long_name='growth respiration transfer', & + ptr_pft=pcs%gresp_xfer, default='inactive') + + call hist_addfld1d (fname='CPOOL', units='gC/m^2', & + avgflag='A', long_name='temporary photosynthate C pool', & + ptr_pft=pcs%cpool) + + call hist_addfld1d (fname='XSMRPOOL', units='gC/m^2', & + avgflag='A', long_name='temporary photosynthate C pool', & + ptr_pft=pcs%xsmrpool) + + call hist_addfld1d (fname='PFT_CTRUNC', units='gC/m^2', & + avgflag='A', long_name='pft-level sink for C truncation', & + ptr_pft=pcs%pft_ctrunc) + + call hist_addfld1d (fname='DISPVEGC', units='gC/m^2', & + avgflag='A', long_name='displayed veg carbon, excluding storage and cpool', & + ptr_pft=pcs%dispvegc) + + call hist_addfld1d (fname='STORVEGC', units='gC/m^2', & + avgflag='A', long_name='stored vegetation carbon, excluding cpool', & + ptr_pft=pcs%storvegc) + + call hist_addfld1d (fname='TOTVEGC', units='gC/m^2', & + avgflag='A', long_name='total vegetation carbon, excluding cpool', & + ptr_pft=pcs%totvegc) + + call hist_addfld1d (fname='TOTPFTC', units='gC/m^2', & + avgflag='A', long_name='total pft-level carbon, including cpool', & + ptr_pft=pcs%totpftc) + + if (use_c13) then + !------------------------------- + ! C13 state variables - native to PFT + !------------------------------- + + call hist_addfld1d (fname='C13_LEAFC', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C', & + ptr_pft=pc13s%leafc) + + call hist_addfld1d (fname='C13_LEAFC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C storage', & + ptr_pft=pc13s%leafc_storage, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 leaf C transfer', & + ptr_pft=pc13s%leafc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C', & + ptr_pft=pc13s%frootc) + + call hist_addfld1d (fname='C13_FROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C storage', & + ptr_pft=pc13s%frootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 fine root C transfer', & + ptr_pft=pc13s%frootc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEMC', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C', & + ptr_pft=pc13s%livestemc) + + call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C storage', & + ptr_pft=pc13s%livestemc_storage, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEMC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 live stem C transfer', & + ptr_pft=pc13s%livestemc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_DEADSTEMC', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C', & + ptr_pft=pc13s%deadstemc) + + call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C storage', & + ptr_pft=pc13s%deadstemc_storage, default='inactive') + + call hist_addfld1d (fname='C13_DEADSTEMC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 dead stem C transfer', & + ptr_pft=pc13s%deadstemc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C', & + ptr_pft=pc13s%livecrootc) + + call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C storage', & + ptr_pft=pc13s%livecrootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 live coarse root C transfer', & + ptr_pft=pc13s%livecrootc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_DEADCROOTC', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C', & + ptr_pft=pc13s%deadcrootc) + + call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C storage', & + ptr_pft=pc13s%deadcrootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_DEADCROOTC_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 dead coarse root C transfer', & + ptr_pft=pc13s%deadcrootc_xfer, default='inactive') + + call hist_addfld1d (fname='C13_GRESP_STORAGE', units='gC13/m^2', & + avgflag='A', long_name='C13 growth respiration storage', & + ptr_pft=pc13s%gresp_storage, default='inactive') + + call hist_addfld1d (fname='C13_GRESP_XFER', units='gC13/m^2', & + avgflag='A', long_name='C13 growth respiration transfer', & + ptr_pft=pc13s%gresp_xfer, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL', units='gC13/m^2', & + avgflag='A', long_name='C13 temporary photosynthate C pool', & + ptr_pft=pc13s%cpool) + + call hist_addfld1d (fname='C13_XSMRPOOL', units='gC13/m^2', & + avgflag='A', long_name='C13 temporary photosynthate C pool', & + ptr_pft=pc13s%xsmrpool) + + call hist_addfld1d (fname='C13_PFT_CTRUNC', units='gC13/m^2', & + avgflag='A', long_name='C13 pft-level sink for C truncation', & + ptr_pft=pc13s%pft_ctrunc) + + call hist_addfld1d (fname='C13_DISPVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 displayed veg carbon, excluding storage and cpool', & + ptr_pft=pc13s%dispvegc) + + call hist_addfld1d (fname='C13_STORVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 stored vegetation carbon, excluding cpool', & + ptr_pft=pc13s%storvegc) + + call hist_addfld1d (fname='C13_TOTVEGC', units='gC13/m^2', & + avgflag='A', long_name='C13 total vegetation carbon, excluding cpool', & + ptr_pft=pc13s%totvegc) + + call hist_addfld1d (fname='C13_TOTPFTC', units='gC13/m^2', & + avgflag='A', long_name='C13 total pft-level carbon, including cpool', & + ptr_pft=pc13s%totpftc) + endif + + !------------------------------- + ! C state variables - native to column + !------------------------------- + ! add history fields for all CLAMP CN variables + call hist_addfld1d (fname='SOILC', units='gC/m^2', & + avgflag='A', long_name='soil C', & + ptr_col=ccs%totsomc) + + call hist_addfld1d (fname='LITTERC', units='gC/m^2', & + avgflag='A', long_name='litter C', & + ptr_col=ccs%totlitc) + + call hist_addfld1d (fname='CWDC', units='gC/m^2', & + avgflag='A', long_name='coarse woody debris C', & + ptr_col=ccs%cwdc) + + call hist_addfld1d (fname='LITR1C', units='gC/m^2', & + avgflag='A', long_name='litter labile C', & + ptr_col=ccs%litr1c) + + call hist_addfld1d (fname='LITR2C', units='gC/m^2', & + avgflag='A', long_name='litter cellulose C', & + ptr_col=ccs%litr2c) + + call hist_addfld1d (fname='LITR3C', units='gC/m^2', & + avgflag='A', long_name='litter lignin C', & + ptr_col=ccs%litr3c) + + call hist_addfld1d (fname='SOIL1C', units='gC/m^2', & + avgflag='A', long_name='soil organic matter C (fast pool)', & + ptr_col=ccs%soil1c) + + call hist_addfld1d (fname='SOIL2C', units='gC/m^2', & + avgflag='A', long_name='soil organic matter C (medium pool)', & + ptr_col=ccs%soil2c) + + call hist_addfld1d (fname='SOIL3C', units='gC/m^2', & + avgflag='A', long_name='soil organic matter C (slow pool)', & + ptr_col=ccs%soil3c) + + call hist_addfld1d (fname='SOIL4C', units='gC/m^2', & + avgflag='A', long_name='soil organic matter C (slowest pool)', & + ptr_col=ccs%soil4c) + + call hist_addfld1d (fname='SEEDC', units='gC/m^2', & + avgflag='A', long_name='pool for seeding new PFTs', & + ptr_col=ccs%seedc) + + call hist_addfld1d (fname='COL_CTRUNC', units='gC/m^2', & + avgflag='A', long_name='column-level sink for C truncation', & + ptr_col=ccs%col_ctrunc) + + call hist_addfld1d (fname='TOTLITC', units='gC/m^2', & + avgflag='A', long_name='total litter carbon', & + ptr_col=ccs%totlitc) + + call hist_addfld1d (fname='TOTSOMC', units='gC/m^2', & + avgflag='A', long_name='total soil organic matter carbon', & + ptr_col=ccs%totsomc) + + call hist_addfld1d (fname='TOTECOSYSC', units='gC/m^2', & + avgflag='A', long_name='total ecosystem carbon, incl veg but excl cpool', & + ptr_col=ccs%totecosysc) + + call hist_addfld1d (fname='TOTCOLC', units='gC/m^2', & + avgflag='A', long_name='total column carbon, incl veg and cpool', & + ptr_col=ccs%totcolc) + + call hist_addfld1d (fname='PROD10C', units='gC/m^2', & + avgflag='A', long_name='10-yr wood product C', & + ptr_col=ccs%prod10c) + + call hist_addfld1d (fname='PROD100C', units='gC/m^2', & + avgflag='A', long_name='100-yr wood product C', & + ptr_col=ccs%prod100c) + + call hist_addfld1d (fname='TOTPRODC', units='gC/m^2', & + avgflag='A', long_name='total wood product C', & + ptr_col=ccs%totprodc) + + + if (use_c13) then + !------------------------------- + ! C13 state variables - native to column + !------------------------------- + + call hist_addfld1d (fname='C13_CWDC', units='gC13/m^2', & + avgflag='A', long_name='C13 coarse woody debris C', & + ptr_col=cc13s%cwdc) + + call hist_addfld1d (fname='C13_LITR1C', units='gC13/m^2', & + avgflag='A', long_name='C13 litter labile C', & + ptr_col=cc13s%litr1c) + + call hist_addfld1d (fname='C13_LITR2C', units='gC13/m^2', & + avgflag='A', long_name='C13 litter cellulose C', & + ptr_col=cc13s%litr2c) + + call hist_addfld1d (fname='C13_LITR3C', units='gC13/m^2', & + avgflag='A', long_name='C13 litter lignin C', & + ptr_col=cc13s%litr3c) + + call hist_addfld1d (fname='C13_SOIL1C', units='gC13/m^2', & + avgflag='A', long_name='C13 soil organic matter C (fast pool)', & + ptr_col=cc13s%soil1c) + + call hist_addfld1d (fname='C13_SOIL2C', units='gC13/m^2', & + avgflag='A', long_name='C13 soil organic matter C (medium pool)', & + ptr_col=cc13s%soil2c) + + call hist_addfld1d (fname='C13_SOIL3C', units='gC13/m^2', & + avgflag='A', long_name='C13 soil organic matter C (slow pool)', & + ptr_col=cc13s%soil3c) + + call hist_addfld1d (fname='C13_SOIL4C', units='gC13/m^2', & + avgflag='A', long_name='C13 soil organic matter C (slowest pool)', & + ptr_col=cc13s%soil4c) + + call hist_addfld1d (fname='C13_SEEDC', units='gC13/m^2', & + avgflag='A', long_name='C13 pool for seeding new PFTs', & + ptr_col=ccs%seedc) + + call hist_addfld1d (fname='C13_COL_CTRUNC', units='gC13/m^2', & + avgflag='A', long_name='C13 column-level sink for C truncation', & + ptr_col=cc13s%col_ctrunc) + + call hist_addfld1d (fname='C13_TOTLITC', units='gC13/m^2', & + avgflag='A', long_name='C13 total litter carbon', & + ptr_col=cc13s%totlitc) + + call hist_addfld1d (fname='C13_TOTSOMC', units='gC13/m^2', & + avgflag='A', long_name='C13 total soil organic matter carbon', & + ptr_col=cc13s%totsomc) + + call hist_addfld1d (fname='C13_TOTECOSYSC', units='gC13/m^2', & + avgflag='A', long_name='C13 total ecosystem carbon, incl veg but excl cpool', & + ptr_col=cc13s%totecosysc) + + call hist_addfld1d (fname='C13_TOTCOLC', units='gC13/m^2', & + avgflag='A', long_name='C13 total column carbon, incl veg and cpool', & + ptr_col=cc13s%totcolc) + + call hist_addfld1d (fname='C13_PROD10C', units='gC13/m^2', & + avgflag='A', long_name='C13 10-yr wood product C', & + ptr_col=cc13s%prod10c) + + call hist_addfld1d (fname='C13_PROD100C', units='gC13/m^2', & + avgflag='A', long_name='C13 100-yr wood product C', & + ptr_col=cc13s%prod100c) + + call hist_addfld1d (fname='C13_TOTPRODC', units='gC13/m^2', & + avgflag='A', long_name='C13 total wood product C', & + ptr_col=cc13s%totprodc) + endif + + !------------------------------- + ! N state variables - native to PFT + !------------------------------- + + call hist_addfld1d (fname='LEAFN', units='gN/m^2', & + avgflag='A', long_name='leaf N', & + ptr_pft=pns%leafn) + + call hist_addfld1d (fname='LEAFN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='leaf N storage', & + ptr_pft=pns%leafn_storage, default='inactive') + + call hist_addfld1d (fname='LEAFN_XFER', units='gN/m^2', & + avgflag='A', long_name='leaf N transfer', & + ptr_pft=pns%leafn_xfer, default='inactive') + + call hist_addfld1d (fname='FROOTN', units='gN/m^2', & + avgflag='A', long_name='fine root N', & + ptr_pft=pns%frootn) + + call hist_addfld1d (fname='FROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='fine root N storage', & + ptr_pft=pns%frootn_storage, default='inactive') + + call hist_addfld1d (fname='FROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='fine root N transfer', & + ptr_pft=pns%frootn_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN', units='gN/m^2', & + avgflag='A', long_name='live stem N', & + ptr_pft=pns%livestemn) + + call hist_addfld1d (fname='LIVESTEMN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='live stem N storage', & + ptr_pft=pns%livestemn_storage, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN_XFER', units='gN/m^2', & + avgflag='A', long_name='live stem N transfer', & + ptr_pft=pns%livestemn_xfer, default='inactive') + + call hist_addfld1d (fname='DEADSTEMN', units='gN/m^2', & + avgflag='A', long_name='dead stem N', & + ptr_pft=pns%deadstemn) + + call hist_addfld1d (fname='DEADSTEMN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='dead stem N storage', & + ptr_pft=pns%deadstemn_storage, default='inactive') + + call hist_addfld1d (fname='DEADSTEMN_XFER', units='gN/m^2', & + avgflag='A', long_name='dead stem N transfer', & + ptr_pft=pns%deadstemn_xfer, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN', units='gN/m^2', & + avgflag='A', long_name='live coarse root N', & + ptr_pft=pns%livecrootn) + + call hist_addfld1d (fname='LIVECROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='live coarse root N storage', & + ptr_pft=pns%livecrootn_storage, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='live coarse root N transfer', & + ptr_pft=pns%livecrootn_xfer, default='inactive') + + call hist_addfld1d (fname='DEADCROOTN', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N', & + ptr_pft=pns%deadcrootn) + + call hist_addfld1d (fname='DEADCROOTN_STORAGE', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N storage', & + ptr_pft=pns%deadcrootn_storage, default='inactive') + + call hist_addfld1d (fname='DEADCROOTN_XFER', units='gN/m^2', & + avgflag='A', long_name='dead coarse root N transfer', & + ptr_pft=pns%deadcrootn_xfer, default='inactive') + + call hist_addfld1d (fname='RETRANSN', units='gN/m^2', & + avgflag='A', long_name='plant pool of retranslocated N', & + ptr_pft=pns%retransn) + + call hist_addfld1d (fname='NPOOL', units='gN/m^2', & + avgflag='A', long_name='temporary plant N pool', & + ptr_pft=pns%npool, default='inactive') + + call hist_addfld1d (fname='PFT_NTRUNC', units='gN/m^2', & + avgflag='A', long_name='pft-level sink for N truncation', & + ptr_pft=pns%pft_ntrunc) + + call hist_addfld1d (fname='DISPVEGN', units='gN/m^2', & + avgflag='A', long_name='displayed vegetation nitrogen', & + ptr_pft=pns%dispvegn) + + call hist_addfld1d (fname='STORVEGN', units='gN/m^2', & + avgflag='A', long_name='stored vegetation nitrogen', & + ptr_pft=pns%storvegn) + + call hist_addfld1d (fname='TOTVEGN', units='gN/m^2', & + avgflag='A', long_name='total vegetation nitrogen', & + ptr_pft=pns%totvegn) + + call hist_addfld1d (fname='TOTPFTN', units='gN/m^2', & + avgflag='A', long_name='total PFT-level nitrogen', & + ptr_pft=pns%totpftn) + + !------------------------------- + ! N state variables - native to column + !------------------------------- + + call hist_addfld1d (fname='CWDN', units='gN/m^2', & + avgflag='A', long_name='coarse woody debris N', & + ptr_col=cns%cwdn) + + call hist_addfld1d (fname='LITR1N', units='gN/m^2', & + avgflag='A', long_name='litter labile N', & + ptr_col=cns%litr1n) + + call hist_addfld1d (fname='LITR2N', units='gN/m^2', & + avgflag='A', long_name='litter cellulose N', & + ptr_col=cns%litr2n) + + call hist_addfld1d (fname='LITR3N', units='gN/m^2', & + avgflag='A', long_name='litter lignin N', & + ptr_col=cns%litr3n) + + call hist_addfld1d (fname='SOIL1N', units='gN/m^2', & + avgflag='A', long_name='soil organic matter N (fast pool)', & + ptr_col=cns%soil1n) + + call hist_addfld1d (fname='SOIL2N', units='gN/m^2', & + avgflag='A', long_name='soil organic matter N (medium pool)', & + ptr_col=cns%soil2n) + + call hist_addfld1d (fname='SOIL3N', units='gN/m^2', & + avgflag='A', long_name='soil orgainc matter N (slow pool)', & + ptr_col=cns%soil3n) + + call hist_addfld1d (fname='SOIL4N', units='gN/m^2', & + avgflag='A', long_name='soil orgainc matter N (slowest pool)', & + ptr_col=cns%soil4n) + + call hist_addfld1d (fname='SMINN', units='gN/m^2', & + avgflag='A', long_name='soil mineral N', & + ptr_col=cns%sminn) + + call hist_addfld1d (fname='COL_NTRUNC', units='gN/m^2', & + avgflag='A', long_name='column-level sink for N truncation', & + ptr_col=cns%col_ntrunc) + + call hist_addfld1d (fname='TOTLITN', units='gN/m^2', & + avgflag='A', long_name='total litter N', & + ptr_col=cns%totlitn) + + call hist_addfld1d (fname='TOTSOMN', units='gN/m^2', & + avgflag='A', long_name='total soil organic matter N', & + ptr_col=cns%totsomn) + + call hist_addfld1d (fname='TOTECOSYSN', units='gN/m^2', & + avgflag='A', long_name='total ecosystem N', & + ptr_col=cns%totecosysn) + + call hist_addfld1d (fname='TOTCOLN', units='gN/m^2', & + avgflag='A', long_name='total column-level N', & + ptr_col=cns%totcoln) + + call hist_addfld1d (fname='SEEDN', units='gN/m^2', & + avgflag='A', long_name='pool for seeding new PFTs ', & + ptr_col=cns%seedn) + + call hist_addfld1d (fname='PROD10N', units='gN/m^2', & + avgflag='A', long_name='10-yr wood product N', & + ptr_col=cns%prod10n) + + call hist_addfld1d (fname='PROD100N', units='gN/m^2', & + avgflag='A', long_name='100-yr wood product N', & + ptr_col=cns%prod100n) + + call hist_addfld1d (fname='TOTPRODN', units='gN/m^2', & + avgflag='A', long_name='total wood product N', & + ptr_col=cns%totprodn) + + !------------------------------- + ! C flux variables - native to PFT + !------------------------------- + + ! add history fields for all CLAMP CN variables + + call hist_addfld1d (fname='WOODC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='wood C allocation', & + ptr_pft=pcf%woodc_alloc) + + call hist_addfld1d (fname='WOODC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='wood C loss', & + ptr_pft=pcf%woodc_loss) + + call hist_addfld1d (fname='LEAFC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='leaf C loss', & + ptr_pft=pcf%leafc_loss) + + call hist_addfld1d (fname='LEAFC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='leaf C allocation', & + ptr_pft=pcf%leafc_alloc) + + call hist_addfld1d (fname='FROOTC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='fine root C loss', & + ptr_pft=pcf%frootc_loss) + + call hist_addfld1d (fname='FROOTC_ALLOC', units='gC/m^2/s', & + avgflag='A', long_name='fine root C allocation', & + ptr_pft=pcf%frootc_alloc) + + call hist_addfld1d (fname='PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='sunlit leaf photosynthesis', & + ptr_pft=pcf%psnsun) + + call hist_addfld1d (fname='PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='shaded leaf photosynthesis', & + ptr_pft=pcf%psnsha) + + call hist_addfld1d (fname='M_LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C mortality', & + ptr_pft=pcf%m_leafc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C mortality', & + ptr_pft=pcf%m_frootc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C storage mortality', & + ptr_pft=pcf%m_leafc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage mortality', & + ptr_pft=pcf%m_frootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage mortality', & + ptr_pft=pcf%m_livestemc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage mortality', & + ptr_pft=pcf%m_deadstemc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C storage mortality', & + ptr_pft=pcf%m_livecrootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C storage mortality', & + ptr_pft=pcf%m_deadcrootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer mortality', & + ptr_pft=pcf%m_leafc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer mortality', & + ptr_pft=pcf%m_frootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer mortality', & + ptr_pft=pcf%m_livestemc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer mortality', & + ptr_pft=pcf%m_deadstemc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C transfer mortality', & + ptr_pft=pcf%m_livecrootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C transfer mortality', & + ptr_pft=pcf%m_deadcrootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C mortality', & + ptr_pft=pcf%m_livestemc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C mortality', & + ptr_pft=pcf%m_deadstemc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C mortality', & + ptr_pft=pcf%m_livecrootc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C mortality', & + ptr_pft=pcf%m_deadcrootc_to_litter, default='inactive') + + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage mortality', & + ptr_pft=pcf%m_gresp_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_GRESP_XFER_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer mortality', & + ptr_pft=pcf%m_gresp_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C fire loss', & + ptr_pft=pcf%m_leafc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C fire loss', & + ptr_pft=pcf%m_frootc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C storage fire loss', & + ptr_pft=pcf%m_leafc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage fire loss', & + ptr_pft=pcf%m_frootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage fire loss', & + ptr_pft=pcf%m_livestemc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage fire loss', & + ptr_pft=pcf%m_deadstemc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C storage fire loss', & + ptr_pft=pcf%m_livecrootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C storage fire loss', & + ptr_pft=pcf%m_deadcrootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer fire loss', & + ptr_pft=pcf%m_leafc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer fire loss', & + ptr_pft=pcf%m_frootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer fire loss', & + ptr_pft=pcf%m_livestemc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer fire loss', & + ptr_pft=pcf%m_deadstemc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C transfer fire loss', & + ptr_pft=pcf%m_livecrootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C transfer fire loss', & + ptr_pft=pcf%m_deadcrootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live stem C fire loss', & + ptr_pft=pcf%m_livestemc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C fire loss', & + ptr_pft=pcf%m_deadstemc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C fire mortality to litter', & + ptr_pft=pcf%m_deadstemc_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C fire loss', & + ptr_pft=pcf%m_livecrootc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C fire loss', & + ptr_pft=pcf%m_deadcrootc_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_TO_LITTER_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C fire mortality to litter', & + ptr_pft=pcf%m_deadcrootc_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage fire loss', & + ptr_pft=pcf%m_gresp_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_GRESP_XFER_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer fire loss', & + ptr_pft=pcf%m_gresp_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='LEAFC_XFER_TO_LEAFC', units='gC/m^2/s', & + avgflag='A', long_name='leaf C growth from storage', & + ptr_pft=pcf%leafc_xfer_to_leafc, default='inactive') + + call hist_addfld1d (fname='FROOTC_XFER_TO_FROOTC', units='gC/m^2/s', & + avgflag='A', long_name='fine root C growth from storage', & + ptr_pft=pcf%frootc_xfer_to_frootc, default='inactive') + + call hist_addfld1d (fname='LIVESTEMC_XFER_TO_LIVESTEMC', units='gC/m^2/s', & + avgflag='A', long_name='live stem C growth from storage', & + ptr_pft=pcf%livestemc_xfer_to_livestemc, default='inactive') + + call hist_addfld1d (fname='DEADSTEMC_XFER_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C growth from storage', & + ptr_pft=pcf%deadstemc_xfer_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='LIVECROOTC_XFER_TO_LIVECROOTC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C growth from storage', & + ptr_pft=pcf%livecrootc_xfer_to_livecrootc, default='inactive') + + call hist_addfld1d (fname='DEADCROOTC_XFER_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C growth from storage', & + ptr_pft=pcf%deadcrootc_xfer_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C litterfall', & + ptr_pft=pcf%leafc_to_litter, default='inactive') + + call hist_addfld1d (fname='FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C litterfall', & + ptr_pft=pcf%frootc_to_litter, default='inactive') + + call hist_addfld1d (fname='LEAF_MR', units='gC/m^2/s', & + avgflag='A', long_name='leaf maintenance respiration', & + ptr_pft=pcf%leaf_mr, default='inactive') + + call hist_addfld1d (fname='FROOT_MR', units='gC/m^2/s', & + avgflag='A', long_name='fine root maintenance respiration', & + ptr_pft=pcf%froot_mr, default='inactive') + + call hist_addfld1d (fname='LIVESTEM_MR', units='gC/m^2/s', & + avgflag='A', long_name='live stem maintenance respiration', & + ptr_pft=pcf%livestem_mr, default='inactive') + + call hist_addfld1d (fname='LIVECROOT_MR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root maintenance respiration', & + ptr_pft=pcf%livecroot_mr, default='inactive') + + call hist_addfld1d (fname='PSNSUN_TO_CPOOL', units='gC/m^2/s', & + avgflag='A', long_name='C fixation from sunlit canopy', & + ptr_pft=pcf%psnsun_to_cpool) + + call hist_addfld1d (fname='PSNSHADE_TO_CPOOL', units='gC/m^2/s', & + avgflag='A', long_name='C fixation from shaded canopy', & + ptr_pft=pcf%psnshade_to_cpool) + + call hist_addfld1d (fname='CPOOL_TO_LEAFC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to leaf C', & + ptr_pft=pcf%cpool_to_leafc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_LEAFC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to leaf C storage', & + ptr_pft=pcf%cpool_to_leafc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_FROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to fine root C', & + ptr_pft=pcf%cpool_to_frootc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_FROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to fine root C storage', & + ptr_pft=pcf%cpool_to_frootc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live stem C', & + ptr_pft=pcf%cpool_to_livestemc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_LIVESTEMC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live stem C storage', & + ptr_pft=pcf%cpool_to_livestemc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead stem C', & + ptr_pft=pcf%cpool_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_DEADSTEMC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead stem C storage', & + ptr_pft=pcf%cpool_to_deadstemc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live coarse root C', & + ptr_pft=pcf%cpool_to_livecrootc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_LIVECROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to live coarse root C storage', & + ptr_pft=pcf%cpool_to_livecrootc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root C', & + ptr_pft=pcf%cpool_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_DEADCROOTC_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root C storage', & + ptr_pft=pcf%cpool_to_deadcrootc_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_TO_GRESP_STORAGE', units='gC/m^2/s', & + avgflag='A', long_name='allocation to growth respiration storage', & + ptr_pft=pcf%cpool_to_gresp_storage, default='inactive') + + call hist_addfld1d (fname='CPOOL_LEAF_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration', & + ptr_pft=pcf%cpool_leaf_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_LEAF_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration to storage', & + ptr_pft=pcf%cpool_leaf_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_LEAF_GR', units='gC/m^2/s', & + avgflag='A', long_name='leaf growth respiration from storage', & + ptr_pft=pcf%transfer_leaf_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_FROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration', & + ptr_pft=pcf%cpool_froot_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_FROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration to storage', & + ptr_pft=pcf%cpool_froot_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_FROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='fine root growth respiration from storage', & + ptr_pft=pcf%transfer_froot_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_LIVESTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration', & + ptr_pft=pcf%cpool_livestem_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_LIVESTEM_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration to storage', & + ptr_pft=pcf%cpool_livestem_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_LIVESTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='live stem growth respiration from storage', & + ptr_pft=pcf%transfer_livestem_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_DEADSTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration', & + ptr_pft=pcf%cpool_deadstem_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_DEADSTEM_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration to storage', & + ptr_pft=pcf%cpool_deadstem_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_DEADSTEM_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead stem growth respiration from storage', & + ptr_pft=pcf%transfer_deadstem_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_LIVECROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration', & + ptr_pft=pcf%cpool_livecroot_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_LIVECROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration to storage', & + ptr_pft=pcf%cpool_livecroot_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_LIVECROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root growth respiration from storage', & + ptr_pft=pcf%transfer_livecroot_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_DEADCROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration', & + ptr_pft=pcf%cpool_deadcroot_gr, default='inactive') + + call hist_addfld1d (fname='CPOOL_DEADCROOT_STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration to storage', & + ptr_pft=pcf%cpool_deadcroot_storage_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_DEADCROOT_GR', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root growth respiration from storage', & + ptr_pft=pcf%transfer_deadcroot_gr, default='inactive') + + call hist_addfld1d (fname='LEAFC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='leaf C shift storage to transfer', & + ptr_pft=pcf%leafc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='FROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='fine root C shift storage to transfer', & + ptr_pft=pcf%frootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='live stem C shift storage to transfer', & + ptr_pft=pcf%livestemc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='DEADSTEMC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C shift storage to transfer', & + ptr_pft=pcf%deadstemc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVECROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C shift storage to transfer', & + ptr_pft=pcf%livecrootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='DEADCROOTC_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C shift storage to transfer', & + ptr_pft=pcf%deadcrootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='GRESP_STORAGE_TO_XFER', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration shift storage to transfer', & + ptr_pft=pcf%gresp_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMC_TO_DEADSTEMC', units='gC/m^2/s', & + avgflag='A', long_name='live stem C turnover', & + ptr_pft=pcf%livestemc_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='LIVECROOTC_TO_DEADCROOTC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C turnover', & + ptr_pft=pcf%livecrootc_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='GPP', units='gC/m^2/s', & + avgflag='A', long_name='gross primary production', & + ptr_pft=pcf%gpp) + + call hist_addfld1d (fname='MR', units='gC/m^2/s', & + avgflag='A', long_name='maintenance respiration', & + ptr_pft=pcf%mr) + + call hist_addfld1d (fname='CURRENT_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for new growth displayed in this timestep', & + ptr_pft=pcf%current_gr, default='inactive') + + call hist_addfld1d (fname='TRANSFER_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for transfer growth displayed in this timestep', & + ptr_pft=pcf%transfer_gr, default='inactive') + + call hist_addfld1d (fname='STORAGE_GR', units='gC/m^2/s', & + avgflag='A', long_name='growth resp for growth sent to storage for later display', & + ptr_pft=pcf%storage_gr, default='inactive') + + call hist_addfld1d (fname='GR', units='gC/m^2/s', & + avgflag='A', long_name='total growth respiration', & + ptr_pft=pcf%gr) + + call hist_addfld1d (fname='AR', units='gC/m^2/s', & + avgflag='A', long_name='autotrophic respiration (MR + GR)', & + ptr_pft=pcf%ar) + + call hist_addfld1d (fname='RR', units='gC/m^2/s', & + avgflag='A', long_name='root respiration (fine root MR + total root GR)', & + ptr_pft=pcf%rr) + + call hist_addfld1d (fname='NPP', units='gC/m^2/s', & + avgflag='A', long_name='net primary production', & + ptr_pft=pcf%npp) + + call hist_addfld1d (fname='AGNPP', units='gC/m^2/s', & + avgflag='A', long_name='aboveground NPP', & + ptr_pft=pcf%agnpp) + + call hist_addfld1d (fname='BGNPP', units='gC/m^2/s', & + avgflag='A', long_name='belowground NPP', & + ptr_pft=pcf%bgnpp) + + call hist_addfld1d (fname='LITFALL', units='gC/m^2/s', & + avgflag='A', long_name='litterfall (leaves and fine roots)', & + ptr_pft=pcf%litfall) + + call hist_addfld1d (fname='VEGFIRE', units='gC/m^2/s', & + avgflag='A', long_name='pft-level fire loss', & + ptr_pft=pcf%vegfire, default='inactive') + + call hist_addfld1d (fname='WOOD_HARVESTC', units='gC/m^2/s', & + avgflag='A', long_name='wood harvest carbon (to product pools)', & + ptr_pft=pcf%wood_harvestc) + + call hist_addfld1d (fname='PFT_FIRE_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total pft-level fire C loss', & + ptr_pft=pcf%pft_fire_closs) + + if (use_c13) then + !------------------------------- + ! C13 flux variables - native to PFT + !------------------------------- + + call hist_addfld1d (fname='C13_PSNSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 sunlit leaf photosynthesis', & + ptr_pft=pc13f%psnsun) + + call hist_addfld1d (fname='C13_PSNSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='C13 shaded leaf photosynthesis', & + ptr_pft=pc13f%psnsha) + + call hist_addfld1d (fname='C13_M_LEAFC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C mortality', & + ptr_pft=pc13f%m_leafc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C mortality', & + ptr_pft=pc13f%m_frootc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C storage mortality', & + ptr_pft=pc13f%m_leafc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C storage mortality', & + ptr_pft=pc13f%m_frootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C storage mortality', & + ptr_pft=pc13f%m_livestemc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C storage mortality', & + ptr_pft=pc13f%m_deadstemc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C storage mortality', & + ptr_pft=pc13f%m_livecrootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C storage mortality', & + ptr_pft=pc13f%m_deadcrootc_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C transfer mortality', & + ptr_pft=pc13f%m_leafc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C transfer mortality', & + ptr_pft=pc13f%m_frootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C transfer mortality', & + ptr_pft=pc13f%m_livestemc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C transfer mortality', & + ptr_pft=pc13f%m_deadstemc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C transfer mortality', & + ptr_pft=pc13f%m_livecrootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C transfer mortality', & + ptr_pft=pc13f%m_deadcrootc_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C mortality', & + ptr_pft=pc13f%m_livestemc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C mortality', & + ptr_pft=pc13f%m_deadstemc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C mortality', & + ptr_pft=pc13f%m_livecrootc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C mortality', & + ptr_pft=pc13f%m_deadcrootc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration storage mortality', & + ptr_pft=pc13f%m_gresp_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration transfer mortality', & + ptr_pft=pc13f%m_gresp_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C fire loss', & + ptr_pft=pc13f%m_leafc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C fire loss', & + ptr_pft=pc13f%m_frootc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C storage fire loss', & + ptr_pft=pc13f%m_leafc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C storage fire loss', & + ptr_pft=pc13f%m_frootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C storage fire loss', & + ptr_pft=pc13f%m_livestemc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C storage fire loss', & + ptr_pft=pc13f%m_deadstemc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C storage fire loss', & + ptr_pft=pc13f%m_livecrootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C storage fire loss', & + ptr_pft=pc13f%m_deadcrootc_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C transfer fire loss', & + ptr_pft=pc13f%m_leafc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C transfer fire loss', & + ptr_pft=pc13f%m_frootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C transfer fire loss', & + ptr_pft=pc13f%m_livestemc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C transfer fire loss', & + ptr_pft=pc13f%m_deadstemc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C transfer fire loss', & + ptr_pft=pc13f%m_livecrootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C transfer fire loss', & + ptr_pft=pc13f%m_deadcrootc_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C fire loss', & + ptr_pft=pc13f%m_livestemc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C fire loss', & + ptr_pft=pc13f%m_deadstemc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_LITTER_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C fire mortality to litter', & + ptr_pft=pc13f%m_deadstemc_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C fire loss', & + ptr_pft=pc13f%m_livecrootc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C fire loss', & + ptr_pft=pc13f%m_deadcrootc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_LITTER_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C fire mortality to litter', & + ptr_pft=pc13f%m_deadcrootc_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration storage fire loss', & + ptr_pft=pc13f%m_gresp_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration transfer fire loss', & + ptr_pft=pc13f%m_gresp_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_XFER_TO_LEAFC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C growth from storage', & + ptr_pft=pc13f%leafc_xfer_to_leafc, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_XFER_TO_FROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C growth from storage', & + ptr_pft=pc13f%frootc_xfer_to_frootc, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEMC_XFER_TO_LIVESTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C growth from storage', & + ptr_pft=pc13f%livestemc_xfer_to_livestemc, default='inactive') + + call hist_addfld1d (fname='C13_DEADSTEMC_XFER_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C growth from storage', & + ptr_pft=pc13f%deadstemc_xfer_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOTC_XFER_TO_LIVECROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C growth from storage', & + ptr_pft=pc13f%livecrootc_xfer_to_livecrootc, default='inactive') + + call hist_addfld1d (fname='C13_DEADCROOTC_XFER_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C growth from storage', & + ptr_pft=pc13f%deadcrootc_xfer_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C litterfall', & + ptr_pft=pc13f%leafc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_TO_LITTER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall', & + ptr_pft=pc13f%frootc_to_litter, default='inactive') + + call hist_addfld1d (fname='C13_LEAF_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf maintenance respiration', & + ptr_pft=pc13f%leaf_mr, default='inactive') + + call hist_addfld1d (fname='C13_FROOT_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root maintenance respiration', & + ptr_pft=pc13f%froot_mr, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEM_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem maintenance respiration', & + ptr_pft=pc13f%livestem_mr, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOT_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root maintenance respiration', & + ptr_pft=pc13f%livecroot_mr, default='inactive') + + call hist_addfld1d (fname='C13_PSNSUN_TO_CPOOL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 C fixation from sunlit canopy', & + ptr_pft=pc13f%psnsun_to_cpool) + + call hist_addfld1d (fname='C13_PSNSHADE_TO_CPOOL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 C fixation from shaded canopy', & + ptr_pft=pc13f%psnshade_to_cpool) + + call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to leaf C', & + ptr_pft=pc13f%cpool_to_leafc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_LEAFC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to leaf C storage', & + ptr_pft=pc13f%cpool_to_leafc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to fine root C', & + ptr_pft=pc13f%cpool_to_frootc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_FROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to fine root C storage', & + ptr_pft=pc13f%cpool_to_frootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live stem C', & + ptr_pft=pc13f%cpool_to_livestemc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_LIVESTEMC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live stem C storage', & + ptr_pft=pc13f%cpool_to_livestemc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead stem C', & + ptr_pft=pc13f%cpool_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_DEADSTEMC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead stem C storage', & + ptr_pft=pc13f%cpool_to_deadstemc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live coarse root C', & + ptr_pft=pc13f%cpool_to_livecrootc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_LIVECROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to live coarse root C storage', & + ptr_pft=pc13f%cpool_to_livecrootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead coarse root C', & + ptr_pft=pc13f%cpool_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_DEADCROOTC_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to dead coarse root C storage', & + ptr_pft=pc13f%cpool_to_deadcrootc_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_TO_GRESP_STORAGE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 allocation to growth respiration storage', & + ptr_pft=pc13f%cpool_to_gresp_storage, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LEAF_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration', & + ptr_pft=pc13f%cpool_leaf_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LEAF_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration to storage', & + ptr_pft=pc13f%cpool_leaf_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_LEAF_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf growth respiration from storage', & + ptr_pft=pc13f%transfer_leaf_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_FROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration', & + ptr_pft=pc13f%cpool_froot_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_FROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration to storage', & + ptr_pft=pc13f%cpool_froot_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_FROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root growth respiration from storage', & + ptr_pft=pc13f%transfer_froot_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration', & + ptr_pft=pc13f%cpool_livestem_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LIVESTEM_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration to storage', & + ptr_pft=pc13f%cpool_livestem_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_LIVESTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem growth respiration from storage', & + ptr_pft=pc13f%transfer_livestem_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration', & + ptr_pft=pc13f%cpool_deadstem_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_DEADSTEM_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration to storage', & + ptr_pft=pc13f%cpool_deadstem_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_DEADSTEM_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem growth respiration from storage', & + ptr_pft=pc13f%transfer_deadstem_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration', & + ptr_pft=pc13f%cpool_livecroot_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_LIVECROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration to storage', & + ptr_pft=pc13f%cpool_livecroot_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_LIVECROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root growth respiration from storage', & + ptr_pft=pc13f%transfer_livecroot_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration', & + ptr_pft=pc13f%cpool_deadcroot_gr, default='inactive') + + call hist_addfld1d (fname='C13_CPOOL_DEADCROOT_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration to storage', & + ptr_pft=pc13f%cpool_deadcroot_storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_DEADCROOT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root growth respiration from storage', & + ptr_pft=pc13f%transfer_deadcroot_gr, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C shift storage to transfer', & + ptr_pft=pc13f%leafc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C shift storage to transfer', & + ptr_pft=pc13f%frootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C shift storage to transfer', & + ptr_pft=pc13f%livestemc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_DEADSTEMC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C shift storage to transfer', & + ptr_pft=pc13f%deadstemc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C shift storage to transfer', & + ptr_pft=pc13f%livecrootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_DEADCROOTC_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C shift storage to transfer', & + ptr_pft=pc13f%deadcrootc_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_GRESP_STORAGE_TO_XFER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration shift storage to transfer', & + ptr_pft=pc13f%gresp_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='C13_LIVESTEMC_TO_DEADSTEMC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C turnover', & + ptr_pft=pc13f%livestemc_to_deadstemc, default='inactive') + + call hist_addfld1d (fname='C13_LIVECROOTC_TO_DEADCROOTC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C turnover', & + ptr_pft=pc13f%livecrootc_to_deadcrootc, default='inactive') + + call hist_addfld1d (fname='C13_GPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 gross primary production', & + ptr_pft=pc13f%gpp) + + call hist_addfld1d (fname='C13_MR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 maintenance respiration', & + ptr_pft=pc13f%mr) + + call hist_addfld1d (fname='C13_CURRENT_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for new growth displayed in this timestep', & + ptr_pft=pc13f%current_gr, default='inactive') + + call hist_addfld1d (fname='C13_TRANSFER_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for transfer growth displayed in this timestep', & + ptr_pft=pc13f%transfer_gr, default='inactive') + + call hist_addfld1d (fname='C13_STORAGE_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth resp for growth sent to storage for later display', & + ptr_pft=pc13f%storage_gr, default='inactive') + + call hist_addfld1d (fname='C13_GR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total growth respiration', & + ptr_pft=pc13f%gr) + + call hist_addfld1d (fname='C13_AR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 autotrophic respiration (MR + GR)', & + ptr_pft=pc13f%ar) + + call hist_addfld1d (fname='C13_RR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 root respiration (fine root MR + total root GR)', & + ptr_pft=pc13f%rr) + + call hist_addfld1d (fname='C13_NPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net primary production', & + ptr_pft=pc13f%npp) + + call hist_addfld1d (fname='C13_AGNPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 aboveground NPP', & + ptr_pft=pc13f%agnpp) + + call hist_addfld1d (fname='C13_BGNPP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 belowground NPP', & + ptr_pft=pc13f%bgnpp) + + call hist_addfld1d (fname='C13_LITFALL', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litterfall (leaves and fine roots)', & + ptr_pft=pc13f%litfall, default='inactive') + + call hist_addfld1d (fname='C13_VEGFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 pft-level fire loss', & + ptr_pft=pc13f%vegfire, default='inactive') + + call hist_addfld1d (fname='C13_PFT_FIRE_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total pft-level fire C loss', & + ptr_pft=pc13f%pft_fire_closs) + endif + + !------------------------------- + ! C flux variables - native to column + !------------------------------- + ! add history fields for all CLAMP CN variables + + call hist_addfld1d (fname='CWDC_HR', units='gC/m^2/s', & + avgflag='A', long_name='coarse woody debris C heterotrophic respiration', & + ptr_col=ccf%cwdc_hr) + + call hist_addfld1d (fname='CWDC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='coarse woody debris C loss', & + ptr_col=ccf%cwdc_loss) + + call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', & + avgflag='A', long_name='litter C heterotrophic respiration', & + ptr_col=ccf%lithr) + + call hist_addfld1d (fname='LITTERC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='litter C loss', & + ptr_col=ccf%litterc_loss) + + call hist_addfld1d (fname='SOILC_HR', units='gC/m^2/s', & + avgflag='A', long_name='soil C heterotrophic respiration', & + ptr_col=ccf%somhr) + + call hist_addfld1d (fname='SOILC_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='soil C loss', & + ptr_col=ccf%somhr) + + call hist_addfld1d (fname='M_LEAFC_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C mortality to litter 1 C', & + ptr_col=ccf%m_leafc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C mortality to litter 2 C', & + ptr_col=ccf%m_leafc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C mortality to litter 3 C', & + ptr_col=ccf%m_leafc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C mortality to litter 1 C', & + ptr_col=ccf%m_frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C mortality to litter 2 C', & + ptr_col=ccf%m_frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C mortality to litter 3 C', & + ptr_col=ccf%m_frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C storage mortality to litter 1 C', & + ptr_col=ccf%m_leafc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C storage mortality to litter 1 C', & + ptr_col=ccf%m_frootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='live stem C storage mortality to litter 1 C', & + ptr_col=ccf%m_livestemc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C storage mortality to litter 1 C', & + ptr_col=ccf%m_deadstemc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C storage mortality to litter 1 C', & + ptr_col=ccf%m_livecrootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C storage mortality to litter 1 C', & + ptr_col=ccf%m_deadcrootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LEAFC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C transfer mortality to litter 1 C', & + ptr_col=ccf%m_leafc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_FROOTC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C transfer mortality to litter 1 C', & + ptr_col=ccf%m_frootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='live stem C transfer mortality to litter 1 C', & + ptr_col=ccf%m_livestemc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C transfer mortality to litter 1 C', & + ptr_col=ccf%m_deadstemc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C transfer mortality to litter 1 C', & + ptr_col=ccf%m_livecrootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C transfer mortality to litter 1 C', & + ptr_col=ccf%m_deadcrootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='live stem C mortality to coarse woody debris C', & + ptr_col=ccf%m_livestemc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C mortality to coarse woody debris C', & + ptr_col=ccf%m_deadstemc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root C mortality to coarse woody debris C', & + ptr_col=ccf%m_livecrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C mortality to coarse woody debris C', & + ptr_col=ccf%m_deadcrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='M_GRESP_STORAGE_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration storage mortality to litter 1 C', & + ptr_col=ccf%m_gresp_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_GRESP_XFER_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='growth respiration transfer mortality to litter 1 C', & + ptr_col=ccf%m_gresp_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMC_TO_CWDC_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead stem C to coarse woody debris C by fire', & + ptr_col=ccf%m_deadstemc_to_cwdc_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTC_TO_CWDC_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root C to to woody debris C by fire', & + ptr_col=ccf%m_deadcrootc_to_cwdc_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR1C_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='litter 1 C fire loss', & + ptr_col=ccf%m_litr1c_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR2C_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='litter 2 C fire loss', & + ptr_col=ccf%m_litr2c_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR3C_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='litter 3 C fire loss', & + ptr_col=ccf%m_litr3c_to_fire, default='inactive') + + call hist_addfld1d (fname='M_CWDC_TO_FIRE', units='gC/m^2/s', & + avgflag='A', long_name='coarse woody debris C fire loss', & + ptr_col=ccf%m_cwdc_to_fire, default='inactive') + + call hist_addfld1d (fname='LEAFC_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C litterfall to litter 1 C', & + ptr_col=ccf%leafc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='LEAFC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C litterfall to litter 2 C', & + ptr_col=ccf%leafc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='LEAFC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='leaf C litterfall to litter 3 C', & + ptr_col=ccf%leafc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='FROOTC_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C litterfall to litter 1 C', & + ptr_col=ccf%frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='FROOTC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C litterfall to litter 2 C', & + ptr_col=ccf%frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='FROOTC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='fine root C litterfall to litter 3 C', & + ptr_col=ccf%frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='CWDC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of coarse woody debris C to litter 2 C', & + ptr_col=ccf%cwdc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='CWDC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of coarse woody debris C to litter 3 C', & + ptr_col=ccf%cwdc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='LITR1_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from litter 1 C', & + ptr_col=ccf%litr1_hr, default='inactive') + + call hist_addfld1d (fname='LITR1C_TO_SOIL1C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of litter 1 C to SOM 1 C', & + ptr_col=ccf%litr1c_to_soil1c) + + call hist_addfld1d (fname='LITR2_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from litter 2 C', & + ptr_col=ccf%litr2_hr, default='inactive') + + call hist_addfld1d (fname='LITR2C_TO_SOIL2C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of litter 2 C to SOM 2 C', & + ptr_col=ccf%litr2c_to_soil2c) + + call hist_addfld1d (fname='LITR3_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from litter 3 C', & + ptr_col=ccf%litr3_hr, default='inactive') + + call hist_addfld1d (fname='LITR3C_TO_SOIL3C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of litter 3 C to SOM 3 C', & + ptr_col=ccf%litr3c_to_soil3c) + + call hist_addfld1d (fname='SOIL1_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from SOM 1 C', & + ptr_col=ccf%soil1_hr, default='inactive') + + call hist_addfld1d (fname='SOIL1C_TO_SOIL2C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of SOM 1 C to SOM 2 C', & + ptr_col=ccf%soil1c_to_soil2c, default='inactive') + + call hist_addfld1d (fname='SOIL2_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from SOM 2 C', & + ptr_col=ccf%soil2_hr, default='inactive') + + call hist_addfld1d (fname='SOIL2C_TO_SOIL3C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of SOM 2 C to SOM 3 C', & + ptr_col=ccf%soil2c_to_soil3c, default='inactive') + + call hist_addfld1d (fname='SOIL3_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from SOM 3 C', & + ptr_col=ccf%soil3_hr, default='inactive') + + call hist_addfld1d (fname='SOIL3C_TO_SOIL4C', units='gC/m^2/s', & + avgflag='A', long_name='decomp. of SOM 3 C to SOM 4 C', & + ptr_col=ccf%soil3c_to_soil4c, default='inactive') + + call hist_addfld1d (fname='SOIL4_HR', units='gC/m^2/s', & + avgflag='A', long_name='het. resp. from SOM 4 C', & + ptr_col=ccf%soil4_hr, default='inactive') + + call hist_addfld1d (fname='LITHR', units='gC/m^2/s', & + avgflag='A', long_name='litter heterotrophic respiration', & + ptr_col=ccf%lithr) + + call hist_addfld1d (fname='SOMHR', units='gC/m^2/s', & + avgflag='A', long_name='soil organic matter heterotrophic respiration', & + ptr_col=ccf%somhr) + + call hist_addfld1d (fname='HR', units='gC/m^2/s', & + avgflag='A', long_name='total heterotrophic respiration', & + ptr_col=ccf%hr) + + call hist_addfld1d (fname='SR', units='gC/m^2/s', & + avgflag='A', long_name='total soil respiration (HR + root resp)', & + ptr_col=ccf%sr) + + call hist_addfld1d (fname='ER', units='gC/m^2/s', & + avgflag='A', long_name='total ecosystem respiration, autotrophic + heterotrophic', & + ptr_col=ccf%er) + + call hist_addfld1d (fname='LITFIRE', units='gC/m^2/s', & + avgflag='A', long_name='litter fire losses', & + ptr_col=ccf%litfire, default='inactive') + + call hist_addfld1d (fname='SOMFIRE', units='gC/m^2/s', & + avgflag='A', long_name='soil organic matter fire losses', & + ptr_col=ccf%somfire, default='inactive') + + call hist_addfld1d (fname='TOTFIRE', units='gC/m^2/s', & + avgflag='A', long_name='total ecosystem fire losses', & + ptr_col=ccf%totfire, default='inactive') + + call hist_addfld1d (fname='NEP', units='gC/m^2/s', & + avgflag='A', long_name='net ecosystem production, excludes fire, landuse, and harvest flux, positive for sink', & + ptr_col=ccf%nep) + + call hist_addfld1d (fname='NBP', units='gC/m^2/s', & + avgflag='A', long_name='net biome production, includes fire, landuse, and harvest flux, positive for sink', & + ptr_col=ccf%nbp) + + call hist_addfld1d (fname='NEE', units='gC/m^2/s', & + avgflag='A', long_name=& + 'net ecosystem exchange of carbon, includes fire, landuse, harvest, and hrv_xsmrpool flux, positive for source', & + ptr_col=ccf%nee) + + call hist_addfld1d (fname='COL_FIRE_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total column-level fire C loss', & + ptr_col=ccf%col_fire_closs) + + call hist_addfld1d (fname='DWT_SEEDC_TO_LEAF', units='gC/m^2/s', & + avgflag='A', long_name='seed source to PFT-level leaf', & + ptr_col=ccf%dwt_seedc_to_leaf) + + call hist_addfld1d (fname='DWT_SEEDC_TO_DEADSTEM', units='gC/m^2/s', & + avgflag='A', long_name='seed source to PFT-level deadstem', & + ptr_col=ccf%dwt_seedc_to_deadstem) + + call hist_addfld1d (fname='DWT_CONV_CFLUX', units='gC/m^2/s', & + avgflag='A', long_name='conversion C flux (immediate loss to atm)', & + ptr_col=ccf%dwt_conv_cflux) + + call hist_addfld1d (fname='DWT_PROD10C_GAIN', units='gC/m^2/s', & + avgflag='A', long_name='landcover change-driven addition to 10-yr wood product pool', & + ptr_col=ccf%dwt_prod10c_gain) + + call hist_addfld1d (fname='PROD10C_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='loss from 10-yr wood product pool', & + ptr_col=ccf%prod10c_loss) + + call hist_addfld1d (fname='DWT_PROD100C_GAIN', units='gC/m^2/s', & + avgflag='A', long_name='landcover change-driven addition to 100-yr wood product pool', & + ptr_col=ccf%dwt_prod100c_gain) + + call hist_addfld1d (fname='PROD100C_LOSS', units='gC/m^2/s', & + avgflag='A', long_name='loss from 100-yr wood product pool', & + ptr_col=ccf%prod100c_loss) + + call hist_addfld1d (fname='DWT_FROOTC_TO_LITR1C', units='gC/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=ccf%dwt_frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='DWT_FROOTC_TO_LITR2C', units='gC/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=ccf%dwt_frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='DWT_FROOTC_TO_LITR3C', units='gC/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=ccf%dwt_frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='DWT_LIVECROOTC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='live coarse root to CWD due to landcover change', & + ptr_col=ccf%dwt_livecrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='DWT_DEADCROOTC_TO_CWDC', units='gC/m^2/s', & + avgflag='A', long_name='dead coarse root to CWD due to landcover change', & + ptr_col=ccf%dwt_deadcrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='DWT_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total carbon loss from land cover conversion', & + ptr_col=ccf%dwt_closs) + + call hist_addfld1d (fname='PRODUCT_CLOSS', units='gC/m^2/s', & + avgflag='A', long_name='total carbon loss from wood product pools', & + ptr_col=ccf%product_closs) + + call hist_addfld1d (fname='LAND_USE_FLUX', units='gC/m^2/s', & + avgflag='A', long_name='total C emitted from land cover conversion and wood product pools', & + ptr_col=ccf%landuseflux) + + call hist_addfld1d (fname='LAND_UPTAKE', units='gC/m^2/s', & + avgflag='A', long_name='NEE minus LAND_USE_FLUX, negative for update', & + ptr_col=ccf%landuptake) + + if (use_c13) then + !------------------------------- + ! C13 flux variables - native to column + !------------------------------- + + call hist_addfld1d (fname='C13_M_LEAFC_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C mortality to litter 1 C', & + ptr_col=cc13f%m_leafc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C mortality to litter 2 C', & + ptr_col=cc13f%m_leafc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C mortality to litter 3 C', & + ptr_col=cc13f%m_leafc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C mortality to litter 1 C', & + ptr_col=cc13f%m_frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C mortality to litter 2 C', & + ptr_col=cc13f%m_frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C mortality to litter 3 C', & + ptr_col=cc13f%m_frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C storage mortality to litter 1 C', & + ptr_col=cc13f%m_leafc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C storage mortality to litter 1 C', & + ptr_col=cc13f%m_frootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C storage mortality to litter 1 C', & + ptr_col=cc13f%m_livestemc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C storage mortality to litter 1 C', & + ptr_col=cc13f%m_deadstemc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C storage mortality to litter 1 C', & + ptr_col=cc13f%m_livecrootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C storage mortality to litter 1 C', & + ptr_col=cc13f%m_deadcrootc_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LEAFC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_leafc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_FROOTC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_frootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_livestemc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_deadstemc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_livecrootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C transfer mortality to litter 1 C', & + ptr_col=cc13f%m_deadcrootc_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVESTEMC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live stem C mortality to coarse woody debris C', & + ptr_col=cc13f%m_livestemc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C mortality to coarse woody debris C', & + ptr_col=cc13f%m_deadstemc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_M_LIVECROOTC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root C mortality to coarse woody debris C', & + ptr_col=cc13f%m_livecrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C mortality to coarse woody debris C', & + ptr_col=cc13f%m_deadcrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_STORAGE_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration storage mortality to litter 1 C', & + ptr_col=cc13f%m_gresp_storage_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_GRESP_XFER_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 growth respiration transfer mortality to litter 1 C', & + ptr_col=cc13f%m_gresp_xfer_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADSTEMC_TO_CWDC_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead stem C to coarse woody debris C by fire', & + ptr_col=cc13f%m_deadstemc_to_cwdc_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_DEADCROOTC_TO_CWDC_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root C to to woody debris C by fire', & + ptr_col=cc13f%m_deadcrootc_to_cwdc_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LITR1C_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter 1 C fire loss', & + ptr_col=cc13f%m_litr1c_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LITR2C_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter 2 C fire loss', & + ptr_col=cc13f%m_litr2c_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_LITR3C_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter 3 C fire loss', & + ptr_col=cc13f%m_litr3c_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_M_CWDC_TO_FIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 coarse woody debris C fire loss', & + ptr_col=cc13f%m_cwdc_to_fire, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C litterfall to litter 1 C', & + ptr_col=cc13f%leafc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C litterfall to litter 2 C', & + ptr_col=cc13f%leafc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_LEAFC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 leaf C litterfall to litter 3 C', & + ptr_col=cc13f%leafc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall to litter 1 C', & + ptr_col=cc13f%frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall to litter 2 C', & + ptr_col=cc13f%frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_FROOTC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root C litterfall to litter 3 C', & + ptr_col=cc13f%frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_CWDC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of coarse woody debris C to litter 2 C', & + ptr_col=cc13f%cwdc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_CWDC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of coarse woody debris C to litter 3 C', & + ptr_col=cc13f%cwdc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_LITR1_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from litter 1 C', & + ptr_col=cc13f%litr1_hr, default='inactive') + + call hist_addfld1d (fname='C13_LITR1C_TO_SOIL1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of litter 1 C to SOM 1 C', & + ptr_col=cc13f%litr1c_to_soil1c, default='inactive') + + call hist_addfld1d (fname='C13_LITR2_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from litter 2 C', & + ptr_col=cc13f%litr2_hr, default='inactive') + + call hist_addfld1d (fname='C13_LITR2C_TO_SOIL2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of litter 2 C to SOM 2 C', & + ptr_col=cc13f%litr2c_to_soil2c, default='inactive') + + call hist_addfld1d (fname='C13_LITR3_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from litter 3 C', & + ptr_col=cc13f%litr3_hr, default='inactive') + + call hist_addfld1d (fname='C13_LITR3C_TO_SOIL3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of litter 3 C to SOM 3 C', & + ptr_col=cc13f%litr3c_to_soil3c, default='inactive') + + call hist_addfld1d (fname='C13_SOIL1_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from SOM 1 C', & + ptr_col=cc13f%soil1_hr, default='inactive') + + call hist_addfld1d (fname='C13_SOIL1C_TO_SOIL2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of SOM 1 C to SOM 2 C', & + ptr_col=cc13f%soil1c_to_soil2c, default='inactive') + + call hist_addfld1d (fname='C13_SOIL2_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from SOM 2 C', & + ptr_col=cc13f%soil2_hr, default='inactive') + + call hist_addfld1d (fname='C13_SOIL2C_TO_SOIL3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of SOM 2 C to SOM 3 C', & + ptr_col=cc13f%soil2c_to_soil3c, default='inactive') + + call hist_addfld1d (fname='C13_SOIL3_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from SOM 3 C', & + ptr_col=cc13f%soil3_hr, default='inactive') + + call hist_addfld1d (fname='C13_SOIL3C_TO_SOIL4C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 decomp. of SOM 3 C to SOM 4 C', & + ptr_col=cc13f%soil3c_to_soil4c, default='inactive') + + call hist_addfld1d (fname='C13_SOIL4_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 het. resp. from SOM 4 C', & + ptr_col=cc13f%soil4_hr, default='inactive') + + call hist_addfld1d (fname='C13_LITHR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter heterotrophic respiration', & + ptr_col=cc13f%lithr) + + call hist_addfld1d (fname='C13_SOMHR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 soil organic matter heterotrophic respiration', & + ptr_col=cc13f%somhr) + + call hist_addfld1d (fname='C13_HR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total heterotrophic respiration', & + ptr_col=cc13f%hr) + + call hist_addfld1d (fname='C13_SR', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total soil respiration (HR + root resp)', & + ptr_col=cc13f%sr) + + call hist_addfld1d (fname='C13_ER', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total ecosystem respiration, autotrophic + heterotrophic', & + ptr_col=cc13f%er) + + call hist_addfld1d (fname='C13_LITFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 litter fire losses', & + ptr_col=cc13f%litfire, default='inactive') + + call hist_addfld1d (fname='C13_SOMFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 soil organic matter fire losses', & + ptr_col=cc13f%somfire, default='inactive') + + call hist_addfld1d (fname='C13_TOTFIRE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total ecosystem fire losses', & + ptr_col=cc13f%totfire, default='inactive') + + call hist_addfld1d (fname='C13_NEP', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net ecosystem production, excludes fire flux, positive for sink', & + ptr_col=cc13f%nep) + + call hist_addfld1d (fname='C13_NEE', units='gC13/m^2/s', & + avgflag='A', long_name='C13 net ecosystem exchange of carbon, includes fire flux, positive for source', & + ptr_col=cc13f%nee) + + call hist_addfld1d (fname='C13_COL_FIRE_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total column-level fire C loss', & + ptr_col=cc13f%col_fire_closs) + + call hist_addfld1d (fname='C13_DWT_SEEDC_TO_LEAF', units='gC13/m^2/s', & + avgflag='A', long_name='C13 seed source to PFT-level leaf', & + ptr_col=cc13f%dwt_seedc_to_leaf) + + call hist_addfld1d (fname='C13_DWT_SEEDC_TO_DEADSTEM', units='gC13/m^2/s', & + avgflag='A', long_name='C13 seed source to PFT-level deadstem', & + ptr_col=cc13f%dwt_seedc_to_deadstem) + + call hist_addfld1d (fname='C13_DWT_CONV_CFLUX', units='gC13/m^2/s', & + avgflag='A', long_name='C13 conversion C flux (immediate loss to atm)', & + ptr_col=cc13f%dwt_conv_cflux) + + call hist_addfld1d (fname='C13_DWT_PROD10C_GAIN', units='gC13/m^2/s', & + avgflag='A', long_name='C13 addition to 10-yr wood product pool', & + ptr_col=cc13f%dwt_prod10c_gain) + + call hist_addfld1d (fname='C13_PROD10C_LOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 loss from 10-yr wood product pool', & + ptr_col=cc13f%prod10c_loss) + + call hist_addfld1d (fname='C13_DWT_PROD100C_GAIN', units='gC13/m^2/s', & + avgflag='A', long_name='C13 addition to 100-yr wood product pool', & + ptr_col=cc13f%dwt_prod100c_gain) + + call hist_addfld1d (fname='C13_PROD100C_LOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 loss from 100-yr wood product pool', & + ptr_col=cc13f%prod100c_loss) + + call hist_addfld1d (fname='C13_DWT_FROOTC_TO_LITR1C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=cc13f%dwt_frootc_to_litr1c, default='inactive') + + call hist_addfld1d (fname='C13_DWT_FROOTC_TO_LITR2C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=cc13f%dwt_frootc_to_litr2c, default='inactive') + + call hist_addfld1d (fname='C13_DWT_FROOTC_TO_LITR3C', units='gC13/m^2/s', & + avgflag='A', long_name='C13 fine root to litter due to landcover change', & + ptr_col=cc13f%dwt_frootc_to_litr3c, default='inactive') + + call hist_addfld1d (fname='C13_DWT_LIVECROOTC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 live coarse root to CWD due to landcover change', & + ptr_col=cc13f%dwt_livecrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_DWT_DEADCROOTC_TO_CWDC', units='gC13/m^2/s', & + avgflag='A', long_name='C13 dead coarse root to CWD due to landcover change', & + ptr_col=cc13f%dwt_deadcrootc_to_cwdc, default='inactive') + + call hist_addfld1d (fname='C13_DWT_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total carbon loss from land cover conversion', & + ptr_col=cc13f%dwt_closs) + + call hist_addfld1d (fname='C13_PRODUCT_CLOSS', units='gC13/m^2/s', & + avgflag='A', long_name='C13 total carbon loss from wood product pools', & + ptr_col=cc13f%product_closs) + endif + + !------------------------------- + ! N flux variables - native to PFT + !------------------------------- + + call hist_addfld1d (fname='M_LEAFN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N mortality', & + ptr_pft=pnf%m_leafn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N mortality', & + ptr_pft=pnf%m_frootn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N storage mortality', & + ptr_pft=pnf%m_leafn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N storage mortality', & + ptr_pft=pnf%m_frootn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N storage mortality', & + ptr_pft=pnf%m_livestemn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N storage mortality', & + ptr_pft=pnf%m_deadstemn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N storage mortality', & + ptr_pft=pnf%m_livecrootn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N storage mortality', & + ptr_pft=pnf%m_deadcrootn_storage_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N transfer mortality', & + ptr_pft=pnf%m_leafn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N transfer mortality', & + ptr_pft=pnf%m_frootn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N transfer mortality', & + ptr_pft=pnf%m_livestemn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N transfer mortality', & + ptr_pft=pnf%m_deadstemn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N transfer mortality', & + ptr_pft=pnf%m_livecrootn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N transfer mortality', & + ptr_pft=pnf%m_deadcrootn_xfer_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N mortality', & + ptr_pft=pnf%m_livestemn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N mortality', & + ptr_pft=pnf%m_deadstemn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N mortality', & + ptr_pft=pnf%m_livecrootn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N mortality', & + ptr_pft=pnf%m_deadcrootn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_RETRANSN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='retranslocated N pool mortality', & + ptr_pft=pnf%m_retransn_to_litter, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N fire loss', & + ptr_pft=pnf%m_leafn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N fire loss ', & + ptr_pft=pnf%m_frootn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N storage fire loss', & + ptr_pft=pnf%m_leafn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N storage fire loss', & + ptr_pft=pnf%m_frootn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N storage fire loss', & + ptr_pft=pnf%m_livestemn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N storage fire loss', & + ptr_pft=pnf%m_deadstemn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N storage fire loss', & + ptr_pft=pnf%m_livecrootn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N storage fire loss', & + ptr_pft=pnf%m_deadcrootn_storage_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='leaf N transfer fire loss', & + ptr_pft=pnf%m_leafn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='fine root N transfer fire loss', & + ptr_pft=pnf%m_frootn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N transfer fire loss', & + ptr_pft=pnf%m_livestemn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N transfer fire loss', & + ptr_pft=pnf%m_deadstemn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N transfer fire loss', & + ptr_pft=pnf%m_livecrootn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N transfer fire loss', & + ptr_pft=pnf%m_deadcrootn_xfer_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live stem N fire loss', & + ptr_pft=pnf%m_livestemn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N fire loss', & + ptr_pft=pnf%m_deadstemn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_TO_LITTER_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N fire mortality to litter', & + ptr_pft=pnf%m_deadstemn_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N fire loss', & + ptr_pft=pnf%m_livecrootn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N fire loss', & + ptr_pft=pnf%m_deadcrootn_to_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_TO_LITTER_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N fire mortality to litter', & + ptr_pft=pnf%m_deadcrootn_to_litter_fire, default='inactive') + + call hist_addfld1d (fname='M_RETRANSN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='retranslocated N pool fire loss', & + ptr_pft=pnf%m_retransn_to_fire, default='inactive') + + call hist_addfld1d (fname='LEAFN_XFER_TO_LEAFN', units='gN/m^2/s', & + avgflag='A', long_name='leaf N growth from storage', & + ptr_pft=pnf%leafn_xfer_to_leafn, default='inactive') + + call hist_addfld1d (fname='FROOTN_XFER_TO_FROOTN', units='gN/m^2/s', & + avgflag='A', long_name='fine root N growth from storage', & + ptr_pft=pnf%frootn_xfer_to_frootn, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN_XFER_TO_LIVESTEMN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N growth from storage', & + ptr_pft=pnf%livestemn_xfer_to_livestemn, default='inactive') + + call hist_addfld1d (fname='DEADSTEMN_XFER_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N growth from storage', & + ptr_pft=pnf%deadstemn_xfer_to_deadstemn, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN_XFER_TO_LIVECROOTN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N growth from storage', & + ptr_pft=pnf%livecrootn_xfer_to_livecrootn, default='inactive') + + call hist_addfld1d (fname='DEADCROOTN_XFER_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N growth from storage', & + ptr_pft=pnf%deadcrootn_xfer_to_deadcrootn, default='inactive') + + call hist_addfld1d (fname='LEAFN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N litterfall', & + ptr_pft=pnf%leafn_to_litter, default='inactive') + + call hist_addfld1d (fname='LEAFN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='leaf N to retranslocated N pool', & + ptr_pft=pnf%leafn_to_retransn, default='inactive') + + call hist_addfld1d (fname='FROOTN_TO_LITTER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N litterfall', & + ptr_pft=pnf%frootn_to_litter, default='inactive') + + call hist_addfld1d (fname='RETRANSN_TO_NPOOL', units='gN/m^2/s', & + avgflag='A', long_name='deployment of retranslocated N', & + ptr_pft=pnf%retransn_to_npool) + + call hist_addfld1d (fname='SMINN_TO_NPOOL', units='gN/m^2/s', & + avgflag='A', long_name='deployment of soil mineral N uptake', & + ptr_pft=pnf%sminn_to_npool) + + call hist_addfld1d (fname='NPOOL_TO_LEAFN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to leaf N', & + ptr_pft=pnf%npool_to_leafn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_LEAFN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to leaf N storage', & + ptr_pft=pnf%npool_to_leafn_storage, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_FROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to fine root N', & + ptr_pft=pnf%npool_to_frootn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_FROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to fine root N storage', & + ptr_pft=pnf%npool_to_frootn_storage, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live stem N', & + ptr_pft=pnf%npool_to_livestemn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_LIVESTEMN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live stem N storage', & + ptr_pft=pnf%npool_to_livestemn_storage, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead stem N', & + ptr_pft=pnf%npool_to_deadstemn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_DEADSTEMN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead stem N storage', & + ptr_pft=pnf%npool_to_deadstemn_storage, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live coarse root N', & + ptr_pft=pnf%npool_to_livecrootn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_LIVECROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to live coarse root N storage', & + ptr_pft=pnf%npool_to_livecrootn_storage, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root N', & + ptr_pft=pnf%npool_to_deadcrootn, default='inactive') + + call hist_addfld1d (fname='NPOOL_TO_DEADCROOTN_STORAGE', units='gN/m^2/s', & + avgflag='A', long_name='allocation to dead coarse root N storage', & + ptr_pft=pnf%npool_to_deadcrootn_storage, default='inactive') + + call hist_addfld1d (fname='LEAFN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='leaf N shift storage to transfer', & + ptr_pft=pnf%leafn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='FROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='fine root N shift storage to transfer', & + ptr_pft=pnf%frootn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='live stem N shift storage to transfer', & + ptr_pft=pnf%livestemn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='DEADSTEMN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N shift storage to transfer', & + ptr_pft=pnf%deadstemn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N shift storage to transfer', & + ptr_pft=pnf%livecrootn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='DEADCROOTN_STORAGE_TO_XFER', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N shift storage to transfer', & + ptr_pft=pnf%deadcrootn_storage_to_xfer, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN_TO_DEADSTEMN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N turnover', & + ptr_pft=pnf%livestemn_to_deadstemn, default='inactive') + + call hist_addfld1d (fname='LIVESTEMN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N to retranslocated N pool', & + ptr_pft=pnf%livestemn_to_retransn, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN_TO_DEADCROOTN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N turnover', & + ptr_pft=pnf%livecrootn_to_deadcrootn, default='inactive') + + call hist_addfld1d (fname='LIVECROOTN_TO_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N to retranslocated N pool', & + ptr_pft=pnf%livecrootn_to_retransn, default='inactive') + + call hist_addfld1d (fname='NDEPLOY', units='gN/m^2/s', & + avgflag='A', long_name='total N deployed in new growth', & + ptr_pft=pnf%ndeploy) + + call hist_addfld1d (fname='WOOD_HARVESTN', units='gN/m^2/s', & + avgflag='A', long_name='wood harvest N (to product pools)', & + ptr_pft=pnf%wood_harvestn) + + call hist_addfld1d (fname='PFT_FIRE_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total pft-level fire N loss', & + ptr_pft=pnf%pft_fire_nloss) + + !------------------------------- + ! N flux variables - native to column + !------------------------------- + + call hist_addfld1d (fname='NDEP_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='atmospheric N deposition to soil mineral N', & + ptr_col=cnf%ndep_to_sminn) + + call hist_addfld1d (fname='NFIX_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='symbiotic/asymbiotic N fixation to soil mineral N', & + ptr_col=cnf%nfix_to_sminn) + + call hist_addfld1d (fname='M_LEAFN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N mortality to litter 1 N', & + ptr_col=cnf%m_leafn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N mortality to litter 2 N', & + ptr_col=cnf%m_leafn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N mortality to litter 3 N', & + ptr_col=cnf%m_leafn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N mortality to litter 1 N', & + ptr_col=cnf%m_frootn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N mortality to litter 2 N', & + ptr_col=cnf%m_frootn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N mortality to litter 3 N', & + ptr_col=cnf%m_frootn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N storage mortality to litter 1 N', & + ptr_col=cnf%m_leafn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N storage mortality to litter 1 N', & + ptr_col=cnf%m_frootn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='live stem N storage mortality to litter 1 N', & + ptr_col=cnf%m_livestemn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N storage mortality to litter 1 N', & + ptr_col=cnf%m_deadstemn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N storage mortality to litter 1 N', & + ptr_col=cnf%m_livecrootn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_STORAGE_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N storage mortality to litter 1 N', & + ptr_col=cnf%m_deadcrootn_storage_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LEAFN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N transfer mortality to litter 1 N', & + ptr_col=cnf%m_leafn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_FROOTN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N transfer mortality to litter 1 N', & + ptr_col=cnf%m_frootn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='live stem N transfer mortality to litter 1 N', & + ptr_col=cnf%m_livestemn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N transfer mortality to litter 1 N', & + ptr_col=cnf%m_deadstemn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N transfer mortality to litter 1 N', & + ptr_col=cnf%m_livecrootn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_XFER_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N transfer mortality to litter 1 N', & + ptr_col=cnf%m_deadcrootn_xfer_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_LIVESTEMN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='live stem N mortality to coarse woody debris N', & + ptr_col=cnf%m_livestemn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N mortality to coarse woody debris N', & + ptr_col=cnf%m_deadstemn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='M_LIVECROOTN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root N mortality to coarse woody debris N', & + ptr_col=cnf%m_livecrootn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N mortality to coarse woody debris N', & + ptr_col=cnf%m_deadcrootn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='M_RETRANSN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='retranslocated N pool mortality to litter 1 N', & + ptr_col=cnf%m_retransn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='M_DEADSTEMN_TO_CWDN_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead stem N to coarse woody debris N by fire', & + ptr_col=cnf%m_deadstemn_to_cwdn_fire, default='inactive') + + call hist_addfld1d (fname='M_DEADCROOTN_TO_CWDN_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root N to to woody debris N by fire', & + ptr_col=cnf%m_deadcrootn_to_cwdn_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR1N_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='litter 1 N fire loss', & + ptr_col=cnf%m_litr1n_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR2N_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='litter 2 N fire loss', & + ptr_col=cnf%m_litr2n_to_fire, default='inactive') + + call hist_addfld1d (fname='M_LITR3N_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='litter 3 N fire loss', & + ptr_col=cnf%m_litr3n_to_fire, default='inactive') + + call hist_addfld1d (fname='M_CWDN_TO_FIRE', units='gN/m^2/s', & + avgflag='A', long_name='coarse woody debris N fire loss', & + ptr_col=cnf%m_cwdn_to_fire, default='inactive') + + call hist_addfld1d (fname='LEAFN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N litterfall to litter 1 N', & + ptr_col=cnf%leafn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='LEAFN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N litterfall to litter 2 N', & + ptr_col=cnf%leafn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='LEAFN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='leaf N litterfall to litter 3 N', & + ptr_col=cnf%leafn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='FROOTN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N litterfall to litter 1 N', & + ptr_col=cnf%frootn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='FROOTN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N litterfall to litter 2 N', & + ptr_col=cnf%frootn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='FROOTN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='fine root N litterfall to litter 3 N ', & + ptr_col=cnf%frootn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='CWDN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of coarse woody debris N to litter 2 N', & + ptr_col=cnf%cwdn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='CWDN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of coarse woody debris N to litter 3 N', & + ptr_col=cnf%cwdn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='LITR1N_TO_SOIL1N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of litter 1 N to SOM 1 N', & + ptr_col=cnf%litr1n_to_soil1n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL1N_L1', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of litter 1 to SOM 1', & + ptr_col=cnf%sminn_to_soil1n_l1, default='inactive') + + call hist_addfld1d (fname='LITR2N_TO_SOIL2N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of litter 2 N to SOM 2 N', & + ptr_col=cnf%litr2n_to_soil2n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL2N_L2', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of litter 2 to SOM 2', & + ptr_col=cnf%sminn_to_soil2n_l2, default='inactive') + + call hist_addfld1d (fname='LITR3N_TO_SOIL3N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of litter 3 N to SOM 3 N', & + ptr_col=cnf%litr3n_to_soil3n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL3N_L3', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of litter 3 to SOM 3', & + ptr_col=cnf%sminn_to_soil3n_l3, default='inactive') + + call hist_addfld1d (fname='SOIL1N_TO_SOIL2n', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of SOM 1 N to SOM 2 N', & + ptr_col=cnf%soil1n_to_soil2n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL2N_S1', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of SOM 1 to SOM 2', & + ptr_col=cnf%sminn_to_soil2n_s1, default='inactive') + + call hist_addfld1d (fname='SOIL2N_TO_SOIL3N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of SOM 2 N to SOM 3 N', & + ptr_col=cnf%soil2n_to_soil3n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL3N_S2', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of SOM 2 to SOM 3', & + ptr_col=cnf%sminn_to_soil3n_s2, default='inactive') + + call hist_addfld1d (fname='SOIL3N_TO_SOIL4N', units='gN/m^2/s', & + avgflag='A', long_name='decomp. of SOM 3 N to SOM 4 N', & + ptr_col=cnf%soil3n_to_soil4n, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_SOIL4N_S3', units='gN/m^2/s', & + avgflag='A', long_name='mineral N flux for decomp. of SOM 3 to SOM 4', & + ptr_col=cnf%sminn_to_soil4n_s3, default='inactive') + + call hist_addfld1d (fname='SOIL4N_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='N mineralization for decomp. of SOM 4', & + ptr_col=cnf%soil4n_to_sminn, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_L1S1', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of litter 1 to SOM 1', & + ptr_col=cnf%sminn_to_denit_l1s1, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_L2S2', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of litter 2 to SOM 2', & + ptr_col=cnf%sminn_to_denit_l2s2, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_L3S3', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of litter 3 to SOM 3', & + ptr_col=cnf%sminn_to_denit_l3s3, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_S1S2', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of SOM 1 to SOM 2', & + ptr_col=cnf%sminn_to_denit_s1s2, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_S2S3', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of SOM 2 to SOM 3', & + ptr_col=cnf%sminn_to_denit_s2s3, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_S3S4', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of SOM 3 to SOM 4', & + ptr_col=cnf%sminn_to_denit_s3s4, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_S4', units='gN/m^2/s', & + avgflag='A', long_name='denitrification for decomp. of SOM 4', & + ptr_col=cnf%sminn_to_denit_s4, default='inactive') + + call hist_addfld1d (fname='SMINN_TO_DENIT_EXCESS', units='gN/m^2/s', & + avgflag='A', long_name='denitrification from excess mineral N pool', & + ptr_col=cnf%sminn_to_denit_excess, default='inactive') + + call hist_addfld1d (fname='SMINN_LEACHED', units='gN/m^2/s', & + avgflag='A', long_name='soil mineral N pool loss to leaching', & + ptr_col=cnf%sminn_leached) + + call hist_addfld1d (fname='POTENTIAL_IMMOB', units='gN/m^2/s', & + avgflag='A', long_name='potential N immobilization', & + ptr_col=cnf%potential_immob) + + call hist_addfld1d (fname='ACTUAL_IMMOB', units='gN/m^2/s', & + avgflag='A', long_name='actual N immobilization', & + ptr_col=cnf%actual_immob) + + call hist_addfld1d (fname='SMINN_TO_PLANT', units='gN/m^2/s', & + avgflag='A', long_name='plant uptake of soil mineral N', & + ptr_col=cnf%sminn_to_plant) + + call hist_addfld1d (fname='SUPPLEMENT_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='supplemental N supply', & + ptr_col=cnf%supplement_to_sminn) + + call hist_addfld1d (fname='GROSS_NMIN', units='gN/m^2/s', & + avgflag='A', long_name='gross rate of N mineralization', & + ptr_col=cnf%gross_nmin) + + call hist_addfld1d (fname='NET_NMIN', units='gN/m^2/s', & + avgflag='A', long_name='net rate of N mineralization', & + ptr_col=cnf%net_nmin) + + call hist_addfld1d (fname='DENIT', units='gN/m^2/s', & + avgflag='A', long_name='total rate of denitrification', & + ptr_col=cnf%denit) + + call hist_addfld1d (fname='COL_FIRE_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total column-level fire N loss', & + ptr_col=cnf%col_fire_nloss) + + call hist_addfld1d (fname='DWT_SEEDN_TO_LEAF', units='gN/m^2/s', & + avgflag='A', long_name='seed source to PFT-level leaf', & + ptr_col=cnf%dwt_seedn_to_leaf) + + call hist_addfld1d (fname='DWT_SEEDN_TO_DEADSTEM', units='gN/m^2/s', & + avgflag='A', long_name='seed source to PFT-level deadstem', & + ptr_col=cnf%dwt_seedn_to_deadstem) + + call hist_addfld1d (fname='DWT_CONV_NFLUX', units='gN/m^2/s', & + avgflag='A', long_name='conversion N flux (immediate loss to atm)', & + ptr_col=cnf%dwt_conv_nflux) + + call hist_addfld1d (fname='DWT_PROD10N_GAIN', units='gN/m^2/s', & + avgflag='A', long_name='addition to 10-yr wood product pool', & + ptr_col=cnf%dwt_prod10n_gain) + + call hist_addfld1d (fname='PROD10N_LOSS', units='gN/m^2/s', & + avgflag='A', long_name='loss from 10-yr wood product pool', & + ptr_col=cnf%prod10n_loss) + + call hist_addfld1d (fname='DWT_PROD100N_GAIN', units='gN/m^2/s', & + avgflag='A', long_name='addition to 100-yr wood product pool', & + ptr_col=cnf%dwt_prod100n_gain) + + call hist_addfld1d (fname='PROD100N_LOSS', units='gN/m^2/s', & + avgflag='A', long_name='loss from 100-yr wood product pool', & + ptr_col=cnf%prod100n_loss) + + call hist_addfld1d (fname='PRODUCT_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total N loss from wood product pools', & + ptr_col=cnf%product_nloss) + + call hist_addfld1d (fname='DWT_FROOTN_TO_LITR1N', units='gN/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=cnf%dwt_frootn_to_litr1n, default='inactive') + + call hist_addfld1d (fname='DWT_FROOTN_TO_LITR2N', units='gN/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=cnf%dwt_frootn_to_litr2n, default='inactive') + + call hist_addfld1d (fname='DWT_FROOTN_TO_LITR3N', units='gN/m^2/s', & + avgflag='A', long_name='fine root to litter due to landcover change', & + ptr_col=cnf%dwt_frootn_to_litr3n, default='inactive') + + call hist_addfld1d (fname='DWT_LIVECROOTN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='live coarse root to CWD due to landcover change', & + ptr_col=cnf%dwt_livecrootn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='DWT_DEADCROOTN_TO_CWDN', units='gN/m^2/s', & + avgflag='A', long_name='dead coarse root to CWD due to landcover change', & + ptr_col=cnf%dwt_deadcrootn_to_cwdn, default='inactive') + + call hist_addfld1d (fname='DWT_NLOSS', units='gN/m^2/s', & + avgflag='A', long_name='total nitrogen loss from landcover conversion', & + ptr_col=cnf%dwt_nloss) + + !------------------------------- + ! PFT ecophysiological variables (pepv) + !------------------------------- + + call hist_addfld1d (fname='DORMANT_FLAG', units='none', & + avgflag='A', long_name='dormancy flag', & + ptr_pft=pepv%dormant_flag, default='inactive') + + call hist_addfld1d (fname='DAYS_ACTIVE', units='days', & + avgflag='A', long_name='number of days since last dormancy', & + ptr_pft=pepv%days_active, default='inactive') + + call hist_addfld1d (fname='ONSET_FLAG', units='none', & + avgflag='A', long_name='onset flag', & + ptr_pft=pepv%onset_flag, default='inactive') + + call hist_addfld1d (fname='ONSET_COUNTER', units='days', & + avgflag='A', long_name='onset days counter', & + ptr_pft=pepv%onset_counter, default='inactive') + + call hist_addfld1d (fname='ONSET_GDDFLAG', units='none', & + avgflag='A', long_name='onset flag for growing degree day sum', & + ptr_pft=pepv%onset_gddflag, default='inactive') + + call hist_addfld1d (fname='ONSET_FDD', units='C degree-days', & + avgflag='A', long_name='onset freezing degree days counter', & + ptr_pft=pepv%onset_fdd, default='inactive') + + call hist_addfld1d (fname='ONSET_GDD', units='C degree-days', & + avgflag='A', long_name='onset growing degree days', & + ptr_pft=pepv%onset_gdd, default='inactive') + + call hist_addfld1d (fname='ONSET_SWI', units='none', & + avgflag='A', long_name='onset soil water index', & + ptr_pft=pepv%onset_swi, default='inactive') + + call hist_addfld1d (fname='OFFSET_FLAG', units='none', & + avgflag='A', long_name='offset flag', & + ptr_pft=pepv%offset_flag, default='inactive') + + call hist_addfld1d (fname='OFFSET_COUNTER', units='days', & + avgflag='A', long_name='offset days counter', & + ptr_pft=pepv%offset_counter, default='inactive') + + call hist_addfld1d (fname='OFFSET_FDD', units='C degree-days', & + avgflag='A', long_name='offset freezing degree days counter', & + ptr_pft=pepv%offset_fdd, default='inactive') + + call hist_addfld1d (fname='OFFSET_SWI', units='none', & + avgflag='A', long_name='offset soil water index', & + ptr_pft=pepv%offset_swi, default='inactive') + + call hist_addfld1d (fname='LGSF', units='proportion', & + avgflag='A', long_name='long growing season factor', & + ptr_pft=pepv%lgsf, default='inactive') + + call hist_addfld1d (fname='BGLFR', units='1/s', & + avgflag='A', long_name='background litterfall rate', & + ptr_pft=pepv%bglfr, default='inactive') + + call hist_addfld1d (fname='BGTR', units='1/s', & + avgflag='A', long_name='background transfer growth rate', & + ptr_pft=pepv%bgtr, default='inactive') + + call hist_addfld1d (fname='DAYL', units='s', & + avgflag='A', long_name='daylength', & + ptr_pft=pepv%dayl, default='inactive') + + call hist_addfld1d (fname='PREV_DAYL', units='s', & + avgflag='A', long_name='daylength from previous timestep', & + ptr_pft=pepv%prev_dayl, default='inactive') + + call hist_addfld1d (fname='ANNAVG_T2M', units='K', & + avgflag='A', long_name='annual average 2m air temperature', & + ptr_pft=pepv%annavg_t2m, default='inactive') + + call hist_addfld1d (fname='TEMPAVG_T2M', units='K', & + avgflag='A', long_name='temporary average 2m air temperature', & + ptr_pft=pepv%tempavg_t2m, default='inactive') + + call hist_addfld1d (fname='INIT_GPP', units='gC/m^2/s', & + avgflag='A', long_name='GPP flux before downregulation', & + ptr_pft=pepv%gpp, default='inactive') + + call hist_addfld1d (fname='AVAILC', units='gC/m^2/s', & + avgflag='A', long_name='C flux available for allocation', & + ptr_pft=pepv%availc, default='inactive') + + call hist_addfld1d (fname='XSMRPOOL_RECOVER', units='gC/m^2/s', & + avgflag='A', long_name='C flux assigned to recovery of negative xsmrpool', & + ptr_pft=pepv%xsmrpool_recover) + + if (use_c13) then + call hist_addfld1d (fname='XSMRPOOL_C13RATIO', units='proportion', & + avgflag='A', long_name='C13/C(12+13) ratio for xsmrpool', & + ptr_pft=pepv%xsmrpool_c13ratio, default='inactive') + endif + + call hist_addfld1d (fname='ALLOC_PNOW', units='proportion', & + avgflag='A', long_name='fraction of current allocation to display as new growth', & + ptr_pft=pepv%alloc_pnow, default='inactive') + + call hist_addfld1d (fname='C_ALLOMETRY', units='none', & + avgflag='A', long_name='C allocation index', & + ptr_pft=pepv%c_allometry, default='inactive') + + call hist_addfld1d (fname='N_ALLOMETRY', units='none', & + avgflag='A', long_name='N allocation index', & + ptr_pft=pepv%n_allometry, default='inactive') + + call hist_addfld1d (fname='PLANT_NDEMAND', units='gN/m^2/s', & + avgflag='A', long_name='N flux required to support initial GPP', & + ptr_pft=pepv%plant_ndemand) + + call hist_addfld1d (fname='TEMPSUM_POTENTIAL_GPP', units='gC/m^2/yr', & + avgflag='A', long_name='temporary annual sum of potential GPP', & + ptr_pft=pepv%tempsum_potential_gpp, default='inactive') + + call hist_addfld1d (fname='ANNSUM_POTENTIAL_GPP', units='gN/m^2/yr', & + avgflag='A', long_name='annual sum of potential GPP', & + ptr_pft=pepv%annsum_potential_gpp, default='inactive') + + call hist_addfld1d (fname='TEMPMAX_RETRANSN', units='gN/m^2', & + avgflag='A', long_name='temporary annual max of retranslocated N pool', & + ptr_pft=pepv%tempmax_retransn, default='inactive') + + call hist_addfld1d (fname='ANNMAX_RETRANSN', units='gN/m^2', & + avgflag='A', long_name='annual max of retranslocated N pool', & + ptr_pft=pepv%annmax_retransn, default='inactive') + + call hist_addfld1d (fname='AVAIL_RETRANSN', units='gN/m^2/s', & + avgflag='A', long_name='N flux available from retranslocation pool', & + ptr_pft=pepv%avail_retransn, default='inactive') + + call hist_addfld1d (fname='PLANT_NALLOC', units='gN/m^2/s', & + avgflag='A', long_name='total allocated N flux', & + ptr_pft=pepv%plant_nalloc, default='inactive') + + call hist_addfld1d (fname='PLANT_CALLOC', units='gC/m^2/s', & + avgflag='A', long_name='total allocated C flux', & + ptr_pft=pepv%plant_calloc, default='inactive') + + call hist_addfld1d (fname='EXCESS_CFLUX', units='gC/m^2/s', & + avgflag='A', long_name='C flux not allocated due to downregulation', & + ptr_pft=pepv%excess_cflux, default='inactive') + + call hist_addfld1d (fname='DOWNREG', units='proportion', & + avgflag='A', long_name='fractional reduction in GPP due to N limitation', & + ptr_pft=pepv%downreg, default='inactive') + + call hist_addfld1d (fname='PREV_LEAFC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='previous timestep leaf C litterfall flux', & + ptr_pft=pepv%prev_leafc_to_litter, default='inactive') + + call hist_addfld1d (fname='PREV_FROOTC_TO_LITTER', units='gC/m^2/s', & + avgflag='A', long_name='previous timestep froot C litterfall flux', & + ptr_pft=pepv%prev_frootc_to_litter, default='inactive') + + call hist_addfld1d (fname='ANNSUM_NPP', units='gC/m^2/yr', & + avgflag='A', long_name='annual sum of NPP', & + ptr_pft=pepv%annsum_npp, default='inactive') + + if (use_c13) then + call hist_addfld1d (fname='RC13_CANAIR', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for canopy air', & + ptr_pft=pepv%rc13_canair, default='inactive') + + call hist_addfld1d (fname='RC13_PSNSUN', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for sunlit photosynthesis', & + ptr_pft=pepv%rc13_psnsun, default='inactive') + + call hist_addfld1d (fname='RC13_PSNSHA', units='proportion', & + avgflag='A', long_name='C13/C(12+13) for shaded photosynthesis', & + ptr_pft=pepv%rc13_psnsha, default='inactive') + endif + + !------------------------------- + ! PFT physical state variables not already defined by default + !------------------------------- + + call hist_addfld1d (fname='EMV', units='proportion', & + avgflag='A', long_name='vegetation emissivity', & + ptr_pft=pps%emv, default='inactive') + + call hist_addfld1d (fname='Z0MV', units='m', & + avgflag='A', long_name='roughness length over vegetation, momentum', & + ptr_pft=pps%z0mv, default='inactive') + + call hist_addfld1d (fname='Z0HV', units='m', & + avgflag='A', long_name='roughness length over vegetation, sensible heat', & + ptr_pft=pps%z0hv, default='inactive') + + call hist_addfld1d (fname='Z0QV', units='m', & + avgflag='A', long_name='roughness length over vegetation, latent heat', & + ptr_pft=pps%z0qv, default='inactive') + + call hist_addfld1d (fname='DEWMX', units='mm', & + avgflag='A', long_name='Maximum allowed dew', & + ptr_pft=pps%dewmx, default='inactive') + + call hist_addfld1d (fname='LNCSUN', units='gN/m^2', & + avgflag='A', long_name='leaf N concentration per unit projected LAI', & + ptr_pft=pps%lncsun, default='inactive') + + call hist_addfld1d (fname='LNCSHA', units='gN/m^2', & + avgflag='A', long_name='leaf N concentration per unit projected LAI', & + ptr_pft=pps%lncsha, default='inactive') + + call hist_addfld1d (fname='VCMXSUN', units='umolCO2/m^2/s', & + avgflag='A', long_name='sunlit leaf Vcmax', & + ptr_pft=pps%vcmxsun, default='inactive') + + call hist_addfld1d (fname='VCMXSHA', units='umolCO2/m^2/s', & + avgflag='A', long_name='shaded leaf Vcmax', & + ptr_pft=pps%vcmxsha, default='inactive') + + call hist_addfld1d (fname='FSUN', units='proportion', & + avgflag='A', long_name='sunlit fraction of canopy', & + ptr_pft=pps%fsun, default='inactive') + + call hist_addfld1d (fname='GDIR', units='proportion', & + avgflag='A', long_name='leaf projection in solar direction', & + ptr_pft=pps%gdir, default='inactive') + + call hist_addfld1d (fname='CISUN', units='Pa', & + avgflag='A', long_name='sunlit intracellular CO2', & + ptr_pft=pps%cisun, default='inactive') + + call hist_addfld1d (fname='CISHA', units='Pa', & + avgflag='A', long_name='shaded intracellular CO2', & + ptr_pft=pps%cisha, default='inactive') + + if (use_c13) then + call hist_addfld1d (fname='ALPHAPSNSUN', units='proportion', & + avgflag='A', long_name='sunlit c13 fractionation', & + ptr_pft=pps%alphapsnsun, default='inactive') + + call hist_addfld1d (fname='ALPHAPSNSHA', units='proportion', & + avgflag='A', long_name='shaded c13 fractionation', & + ptr_pft=pps%alphapsnsha, default='inactive') + endif + + call hist_addfld1d (fname='FWET', units='proportion', & + avgflag='A', long_name='fraction of canopy that is wet', & + ptr_pft=pps%fwet, default='inactive') + + call hist_addfld1d (fname='FDRY', units='proportion', & + avgflag='A', long_name='fraction of foliage that is green and dry', & + ptr_pft=pps%fdry, default='inactive') + + call hist_addfld1d (fname='DT_VEG', units='K', & + avgflag='A', long_name='change in t_veg, last iteration', & + ptr_pft=pps%dt_veg, default='inactive') + + call hist_addfld1d (fname='HTOP', units='m', & + avgflag='A', long_name='canopy top', & + ptr_pft=pps%htop) + + call hist_addfld1d (fname='HBOT', units='m', & + avgflag='A', long_name='canopy bottom', & + ptr_pft=pps%hbot, default='inactive') + + call hist_addfld1d (fname='Z0M', units='m', & + avgflag='A', long_name='momentum roughness length', & + ptr_pft=pps%z0m, default='inactive') + + call hist_addfld1d (fname='DISPLA', units='m', & + avgflag='A', long_name='displacement height', & + ptr_pft=pps%displa, default='inactive') + + call hist_addfld1d (fname='U10_DUST', units='m/s', & + avgflag='A', long_name='10-m wind for dust model', & + ptr_pft=pps%u10, default='inactive') + + call hist_addfld1d (fname='RAM1', units='s/m', & + avgflag='A', long_name='aerodynamical resistance ', & + ptr_pft=pps%ram1, default='inactive') + + call hist_addfld1d (fname='FV', units='m/s', & + avgflag='A', long_name='friction velocity for dust model', & + ptr_pft=pps%fv, default='inactive') + + call hist_addfld2d (fname='ROOTFR', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='fraction of roots in each soil layer', & + ptr_pft=pps%rootfr, default='inactive') + + call hist_addfld2d (fname='ROOTR', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective fraction of roots in each soil layer', & + ptr_pft=pps%rootr, default='inactive') + + call hist_addfld2d (fname='RRESIS', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='root resistance in each soil layer', & + ptr_pft=pps%rresis, default='inactive') + + call hist_addfld2d (fname='ALBD', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (direct)', & + ptr_pft=pps%albd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld2d (fname='ALBI', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (indirect)', & + ptr_pft=pps%albi, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld2d (fname='FABD', units='proportion', type2d='numrad', & + avgflag='A', long_name='flux absorbed by veg per unit direct flux', & + ptr_pft=pps%fabd, default='inactive') + + call hist_addfld2d (fname='FABI', units='proportion', type2d='numrad', & + avgflag='A', long_name='flux absorbed by veg per unit indirect flux', & + ptr_pft=pps%fabi, default='inactive') + + call hist_addfld2d (fname='FTDD', units='proportion', type2d='numrad', & + avgflag='A', long_name='down direct flux below veg per unit dir flx', & + ptr_pft=pps%ftdd, default='inactive') + + call hist_addfld2d (fname='FTID', units='proportion', type2d='numrad', & + avgflag='A', long_name='down indirect flux below veg per unit dir flx', & + ptr_pft=pps%ftid, default='inactive') + + call hist_addfld2d (fname='FTII', units='proportion', type2d='numrad', & + avgflag='A', long_name='down indirect flux below veg per unit indirect flx', & + ptr_pft=pps%ftii, default='inactive') + + call hist_addfld2d (fname='OMEGA', units='proportion', type2d='numrad', & + avgflag='A', long_name='fraction of intercepted radiation that is scattered', & + ptr_pft=pps%omega, default='inactive') + + call hist_addfld2d (fname='EFF_KID', units='none', type2d='numrad', & + avgflag='A', long_name='effective extinction coefficient for indirect from direct', & + ptr_pft=pps%eff_kid, default='inactive') + + call hist_addfld2d (fname='EFF_KII', units='none', type2d='numrad', & + avgflag='A', long_name='effective extinction coefficient for indirect from indirect', & + ptr_pft=pps%eff_kii, default='inactive') + + call hist_addfld2d (fname='SUN_FAID', units='proportion', type2d='numrad', & + avgflag='A', long_name='fraction sun canopy absorbed indirect from direct', & + ptr_pft=pps%sun_faid, default='inactive') + + call hist_addfld2d (fname='SUN_FAII', units='proportion', type2d='numrad', & + avgflag='A', long_name='fraction sun canopy absorbed indirect from indirect', & + ptr_pft=pps%sun_faii, default='inactive') + + call hist_addfld2d (fname='SHA_FAID', units='proportion', type2d='numrad', & + avgflag='A', long_name='fraction shade canopy absorbed indirect from direct', & + ptr_pft=pps%sha_faid, default='inactive') + + call hist_addfld2d (fname='SHA_FAII', units='proportion', type2d='numrad', & + avgflag='A', long_name='fraction shade canopy absorbed indirect from indirect', & + ptr_pft=pps%sha_faii, default='inactive') + + if ( crop_prog )then + + call hist_addfld1d (fname='GDD0', units='ddays', & + avgflag='A', long_name='Growing degree days base 0C from planting', & + ptr_pft=pps%gdd0, default='inactive') + + call hist_addfld1d (fname='GDD8', units='ddays', & + avgflag='A', long_name='Growing degree days base 8C from planting', & + ptr_pft=pps%gdd8, default='inactive') + + call hist_addfld1d (fname='GDD10', units='ddays', & + avgflag='A', long_name='Growing degree days base 10C from planting', & + ptr_pft=pps%gdd10, default='inactive') + + call hist_addfld1d (fname='GDD020', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 0C from planting', & + ptr_pft=pps%gdd020, default='inactive') + + call hist_addfld1d (fname='GDD820', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 8C from planting', & + ptr_pft=pps%gdd820, default='inactive') + + call hist_addfld1d (fname='GDD1020', units='ddays', & + avgflag='A', long_name='Twenty year average of growing degree days base 10C from planting', & + ptr_pft=pps%gdd1020, default='inactive') + + call hist_addfld1d (fname='GDDPLANT', units='ddays', & + avgflag='A', long_name='Accumulated growing degree days past planting date for crop', & + ptr_pft=pps%gddplant, default='inactive') + + call hist_addfld1d (fname='GDDHARV', units='ddays', & + avgflag='A', long_name='Growing degree days (gdd) needed to harvest', & + ptr_pft=pps%gddmaturity, default='inactive') + + call hist_addfld1d (fname='GDDTSOI', units='ddays', & + avgflag='A', long_name='Growing degree-days from planting (top two soil layers)', & + ptr_pft=pps%gddtsoi, default='inactive') + + end if + + !------------------------------- + ! Column physical state variables not already defined by default + !------------------------------- + + call hist_addfld1d (fname='EMG', units='proportion', & + avgflag='A', long_name='ground emissivity', & + ptr_col=cps%emg, default='inactive') + + call hist_addfld1d (fname='Z0MG', units='m', & + avgflag='A', long_name='roughness length over ground, momentum', & + ptr_col=cps%z0mg, default='inactive') + + call hist_addfld1d (fname='Z0HG', units='m', & + avgflag='A', long_name='roughness length over ground, sensible heat', & + ptr_col=cps%z0hg, default='inactive') + + call hist_addfld1d (fname='Z0QG', units='m', & + avgflag='A', long_name='roughness length over ground, latent heat', & + ptr_col=cps%z0qg, default='inactive') + + call hist_addfld1d (fname='BETA', units='none', & + avgflag='A', long_name='coefficient of convective velocity', & + ptr_col=cps%beta, default='inactive') + + call hist_addfld1d (fname='ZII', units='m', & + avgflag='A', long_name='convective boundary height', & + ptr_col=cps%zii, default='inactive') + + call hist_addfld1d (fname='WF', units='proportion', & + avgflag='A', long_name='soil water as frac. of whc for top 0.5 m', & + ptr_col=cps%wf, default='inactive') + + call hist_addfld1d (fname='FPI', units='proportion', & + avgflag='A', long_name='fraction of potential immobilization', & + ptr_col=cps%fpi) + + call hist_addfld1d (fname='FPG', units='proportion', & + avgflag='A', long_name='fraction of potential gpp', & + ptr_col=cps%fpg) + + call hist_addfld1d (fname='ANNSUM_COUNTER', units='s', & + avgflag='A', long_name='seconds since last annual accumulator turnover', & + ptr_col=cps%annsum_counter, default='inactive') + + call hist_addfld1d (fname='CANNSUM_NPP', units='gC/m^2/s', & + avgflag='A', long_name='annual sum of column-level NPP', & + ptr_col=cps%cannsum_npp, default='inactive') + + call hist_addfld1d (fname='CANNAVG_T2M', units='K', & + avgflag='A', long_name='annual average of 2m air temperature', & + ptr_col=cps%cannavg_t2m, default='inactive') + + call hist_addfld2d (fname='FRAC_ICEOLD', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='fraction of ice relative to the tot water', & + ptr_col=cps%frac_iceold, default='inactive') + + call hist_addfld2d (fname='EFF_POROSITY', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective porosity = porosity - vol_ice', & + ptr_col=cps%eff_porosity, default='inactive') + + call hist_addfld2d (fname='ROOTR_COLUMN', units='proportion', type2d='levgrnd', & + avgflag='A', long_name='effective fraction of roots in each soil layer', & + ptr_col=cps%rootr_column, default='inactive') + + call hist_addfld2d (fname='ALBGRD', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (direct)', & + ptr_col=cps%albgrd, default='inactive') + + call hist_addfld2d (fname='ALBGRI', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (indirect)', & + ptr_col=cps%albgri, default='inactive') + + call hist_addfld1d (fname='ME', units='proportion', & + avgflag='A', long_name='moisture of extinction', & + ptr_col=cps%me, default='inactive') + + call hist_addfld1d (fname='FIRE_PROB', units='0-1', & + avgflag='A', long_name='daily fire probability', & + ptr_col=cps%fire_prob, default='inactive') + + call hist_addfld1d (fname='MEAN_FIRE_PROB', units='0-1', & + avgflag='A', long_name='e-folding mean of daily fire probability', & + ptr_col=cps%mean_fire_prob) + + call hist_addfld1d (fname='FIRESEASONL', units='days', & + avgflag='A', long_name='annual fire season length', & + ptr_col=cps%fireseasonl) + + call hist_addfld1d (fname='FAREA_BURNED', units='proportion', & + avgflag='A', long_name='timestep fractional area burned', & + ptr_col=cps%farea_burned, default='inactive') + + call hist_addfld1d (fname='ANN_FAREA_BURNED', units='proportion', & + avgflag='A', long_name='annual total fractional area burned', & + ptr_col=cps%ann_farea_burned) + + !------------------------------- + ! Energy flux variables not already defined by default - native PFT + !------------------------------- + + call hist_addfld1d (fname='PARSUN', units='W/m^2', & + avgflag='A', long_name='average absorbed PAR for sunlit leaves', & + ptr_pft=pef%parsun, default='inactive') + + call hist_addfld1d (fname='PARSHA', units='W/m^2', & + avgflag='A', long_name='average absorbed PAR for shaded leaves', & + ptr_pft=pef%parsha, default='inactive') + + call hist_addfld1d (fname='DLRAD', units='W/m^2', & + avgflag='A', long_name='downward longwave radiation below the canopy', & + ptr_pft=pef%dlrad, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='ULRAD', units='W/m^2', & + avgflag='A', long_name='upward longwave radiation above the canopy', & + ptr_pft=pef%ulrad, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='EFLX_LH_TOT', units='W/m^2', & + avgflag='A', long_name='total latent heat flux [+ to atm]', & + ptr_pft=pef%eflx_lh_tot, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='EFLX_SOIL_GRND', units='W/m^2', & + avgflag='A', long_name='soil heat flux [+ into soil]', & + ptr_pft=pef%eflx_soil_grnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='CGRND', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil energy flux wrt to soil temp', & + ptr_pft=pef%cgrnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='CGRNDL', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil latent heat flux wrt soil temp', & + ptr_pft=pef%cgrndl, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='CGRNDS', units='W/m^2/K', & + avgflag='A', long_name='deriv. of soil sensible heat flux wrt soil temp', & + ptr_pft=pef%cgrnds, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='EFLX_GNET', units='W/m^2', & + avgflag='A', long_name='net heat flux into ground', & + ptr_pft=pef%eflx_gnet, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='DGNETDT', units='W/m^2/K', & + avgflag='A', long_name='derivative of net ground heat flux wrt soil temp', & + ptr_pft=pef%dgnetdT, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld2d (fname='SUN_ADD', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy absorbed direct from direct', & + ptr_pft=pef%sun_add, default='inactive') + + call hist_addfld2d (fname='TOT_AID', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='total canopy absorbed indirect from direct', & + ptr_pft=pef%tot_aid, default='inactive') + + call hist_addfld2d (fname='SUN_AID', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy absorbed indirect from direct', & + ptr_pft=pef%sun_aid, default='inactive') + + call hist_addfld2d (fname='SUN_AII', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy absorbed indirect from indirect', & + ptr_pft=pef%sun_aii, default='inactive') + + call hist_addfld2d (fname='SHA_AID', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='shade canopy absorbed indirect from direct', & + ptr_pft=pef%sha_aid, default='inactive') + + call hist_addfld2d (fname='SHA_AII', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='shade canopy absorbed indirect from indirect', & + ptr_pft=pef%sha_aii, default='inactive') + + call hist_addfld2d (fname='SUN_ATOT', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy total absorbed', & + ptr_pft=pef%sun_atot, default='inactive') + + call hist_addfld2d (fname='SHA_ATOT', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='shade canopy total absorbed', & + ptr_pft=pef%sha_atot, default='inactive') + + call hist_addfld2d (fname='SUN_ALF', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy total absorbed by leaves', & + ptr_pft=pef%sun_alf, default='inactive') + + call hist_addfld2d (fname='SHA_ALF', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='shade canopy total absored by leaves', & + ptr_pft=pef%sha_alf, default='inactive') + + call hist_addfld2d (fname='SUN_APERLAI', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='sun canopy total absorbed per unit LAI', & + ptr_pft=pef%sun_aperlai, default='inactive') + + call hist_addfld2d (fname='SHA_APERLAI', units='W/m^2', type2d='numrad', & + avgflag='A', long_name='shade canopy total absorbed per unit LAI', & + ptr_pft=pef%sha_aperlai, default='inactive') + + !------------------------------- + ! Water flux variables not already defined by default - native PFT + !------------------------------- + + call hist_addfld1d (fname='QFLX_RAIN_GRND', units='mm H2O/s', & + avgflag='A', long_name='rain on ground after interception', & + ptr_pft=pwf%qflx_rain_grnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_SNOW_GRND', units='mm H2O/s', & + avgflag='A', long_name='snow on ground after interception', & + ptr_pft=pwf%qflx_snow_grnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_EVAP_GRND', units='mm H2O/s', & + avgflag='A', long_name='ground surface evaporation', & + ptr_pft=pwf%qflx_evap_grnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_EVAP_VEG', units='mm H2O/s', & + avgflag='A', long_name='vegetation evaporation', & + ptr_pft=pwf%qflx_evap_veg, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_EVAP_TOT', units='mm H2O/s', & + avgflag='A', long_name='qflx_evap_soi + qflx_evap_can + qflx_tran_veg', & + ptr_pft=pwf%qflx_evap_tot, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_DEW_GRND', units='mm H2O/s', & + avgflag='A', long_name='ground surface dew formation', & + ptr_pft=pwf%qflx_dew_grnd, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_SUB_SNOW', units='mm H2O/s', & + avgflag='A', long_name='sublimation rate from snow pack', & + ptr_pft=pwf%qflx_sub_snow, default='inactive', c2l_scale_type='urbanf') + + call hist_addfld1d (fname='QFLX_DEW_SNOW', units='mm H2O/s', & + avgflag='A', long_name='surface dew added to snow pacK', & + ptr_pft=pwf%qflx_dew_snow, default='inactive', c2l_scale_type='urbanf') + + end if + + call hist_addfld1d (fname='SNORDSL', units='m^-6', & + avgflag='A', long_name='top snow layer effective grain radius', & + ptr_col=cps%snw_rds_top, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='SNOTTOPL', units='K/m', & + avgflag='A', long_name='snow temperature (top layer)', & + ptr_col=cps%snot_top, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='SNOdTdzL', units='K/m', & + avgflag='A', long_name='top snow layer temperature gradient (land)', & + ptr_col=cps%dTdz_top, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='SNOLIQFL', units='fraction', & + avgflag='A', long_name='top snow layer liquid water fraction (land)', & + ptr_col=cps%sno_liq_top, set_lake=spval, set_urb=spval, & + default='inactive') + + call hist_addfld1d (fname='SNOFSRVD', units='W/m^2', & + avgflag='A', long_name='direct vis reflected solar radiation from snow', & + ptr_pft=pef%fsr_sno_vd, & + default='inactive') + + call hist_addfld1d (fname='SNOFSRND', units='W/m^2', & + avgflag='A', long_name='direct nir reflected solar radiation from snow', & + ptr_pft=pef%fsr_sno_nd, & + default='inactive') + + call hist_addfld1d (fname='SNOFSRVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis reflected solar radiation from snow', & + ptr_pft=pef%fsr_sno_vi, & + default='inactive') + + call hist_addfld1d (fname='SNOFSRNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir reflected solar radiation from snow', & + ptr_pft=pef%fsr_sno_ni, & + default='inactive') + + call hist_addfld1d (fname='SNOFSDSVD', units='W/m^2', & + avgflag='A', long_name='direct vis incident solar radiation on snow', & + ptr_pft=pef%fsds_sno_vd, & + default='inactive') + + call hist_addfld1d (fname='SNOFSDSND', units='W/m^2', & + avgflag='A', long_name='direct nir incident solar radiation on snow', & + ptr_pft=pef%fsds_sno_nd, & + default='inactive') + + call hist_addfld1d (fname='SNOFSDSVI', units='W/m^2', & + avgflag='A', long_name='diffuse vis incident solar radiation on snow', & + ptr_pft=pef%fsds_sno_vi, & + default='inactive') + + call hist_addfld1d (fname='SNOFSDSNI', units='W/m^2', & + avgflag='A', long_name='diffuse nir incident solar radiation on snow', & + ptr_pft=pef%fsds_sno_ni, & + default='inactive') + + call hist_addfld1d (fname='H2OSNO_TOP', units='kg/m2', & + avgflag='A', long_name='mass of snow in top snow layer', & + ptr_col=cps%h2osno_top, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOBCMCL', units='kg/m2', & + avgflag='A', long_name='mass of BC in snow column', & + ptr_col=cps%mss_bc_col, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOBCMSL', units='kg/m2', & + avgflag='A', long_name='mass of BC in top snow layer', & + ptr_col=cps%mss_bc_top, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOOCMCL', units='kg/m2', & + avgflag='A', long_name='mass of OC in snow column', & + ptr_col=cps%mss_oc_col, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOOCMSL', units='kg/m2', & + avgflag='A', long_name='mass of OC in top snow layer', & + ptr_col=cps%mss_oc_top, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNODSTMCL', units='kg/m2', & + avgflag='A', long_name='mass of dust in snow column', & + ptr_col=cps%mss_dst_col, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNODSTMSL', units='kg/m2', & + avgflag='A', long_name='mass of dust in top snow layer', & + ptr_col=cps%mss_dst_top, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='DSTDEP', units='kg/m^2/s', & + avgflag='A', long_name='total dust deposition (dry+wet) from atmosphere', & + ptr_col=cwf%flx_dst_dep, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='BCDEP', units='kg/m^2/s', & + avgflag='A', long_name='total BC deposition (dry+wet) from atmosphere', & + ptr_col=cwf%flx_bc_dep, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='OCDEP', units='kg/m^2/s', & + avgflag='A', long_name='total OC deposition (dry+wet) from atmosphere', & + ptr_col=cwf%flx_oc_dep, set_lake=spval, set_urb=spval) + + if (use_snicar_frc) then + call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & + ptr_pft=pef%sfc_frc_aer, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOAERFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of all aerosols in snow, averaged only when snow is present (land)', & + ptr_pft=pef%sfc_frc_aer_sno, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOBCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow (land) ', & + ptr_pft=pef%sfc_frc_bc, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOBCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of BC in snow, averaged only when snow is present (land)', & + ptr_pft=pef%sfc_frc_bc_sno, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & + ptr_pft=pef%sfc_frc_oc, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNOOCFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow, averaged only when snow is present (land)', & + ptr_pft=pef%sfc_frc_oc_sno, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNODSTFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow (land) ', & + ptr_pft=pef%sfc_frc_dst, set_lake=spval, set_urb=spval) + + call hist_addfld1d (fname='SNODSTFRC2L', units='W/m^2', & + avgflag='A', long_name='surface forcing of dust in snow, averaged only when snow is present (land)', & + ptr_pft=pef%sfc_frc_dst_sno, set_lake=spval, set_urb=spval) + end if + + !------------------------------- + ! Forcings sent to GLC + !------------------------------- + + if (maxpatch_glcmec > 0) then + + call hist_addfld2d (fname='QICE_FORC', units='mm/s', type2d='glc_nec', & + avgflag='A', long_name='qice forcing sent to GLC', & + ptr_lnd=clm_s2x%qice, default='inactive') + + call hist_addfld2d (fname='TSRF_FORC', units='K', type2d='glc_nec', & + avgflag='A', long_name='surface temperature sent to GLC', & + ptr_lnd=clm_s2x%tsrf, default='inactive') + + call hist_addfld2d (fname='TOPO_FORC', units='m', type2d='glc_nec', & + avgflag='A', long_name='topographic height sent to GLC', & + ptr_lnd=clm_s2x%topo, default='inactive') + + end if + + ! Print masterlist of history fields + + call hist_printflds() + + end subroutine hist_initFlds + +end module histFldsMod diff --git a/components/clm/src_clm40/main/iniTimeConst.F90 b/components/clm/src_clm40/main/iniTimeConst.F90 new file mode 100644 index 0000000000..73f2f170d5 --- /dev/null +++ b/components/clm/src_clm40/main/iniTimeConst.F90 @@ -0,0 +1,828 @@ +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: iniTimeConst +! +! !INTERFACE: +subroutine iniTimeConst +! +! !DESCRIPTION: +! Initialize time invariant clm variables +! 1) removed references to shallow lake - since it is not used +! 2) ***Make z, zi and dz allocatable depending on if you +! have lake or soil +! 3) rootfr only initialized for soil points +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use decompMod , only : get_proc_bounds, get_proc_global + use decompMod , only : gsMap_lnd_gdc2glo + use clm_atmlnd , only : clm_a2l + use clm_varpar , only : nlevsoi, nlevgrnd, nlevlak, numpft, numrad, nlevurb + use clm_varcon , only : istice, istdlak, istwet, isturb, istice_mec, & + icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv, & + zlak, dzlak, zsoi, dzsoi, zisoi, spval, & + albsat, albdry, secspday + use clm_varctl , only : fsurdat,scmlon,scmlat,single_column, iulog, use_cn, use_cndv + use pftvarcon , only : noveg, ntree, roota_par, rootb_par, & + smpso, smpsc, fnitr, nbrdlf_dcd_brl_shrub, & + z0mr, displar, dleaf, rhol, rhos, taul, taus, xl, & + qe25, mp, c3psn, slatop, dsladlai, leafcn, flnr, woody, & + lflitcn, frootcn, livewdcn, deadwdcn, froot_leaf, stem_leaf, croot_stem, & + flivewd, fcur, lf_flab, lf_fcel, lf_flig, fr_flab, fr_fcel, fr_flig, & + leaf_long, evergreen, stress_decid, season_decid, & + resist, pftpar20, pftpar28, pftpar29, pftpar30, pftpar31, & + allom1s, allom2s, & + allom1 , allom2 , allom3 , reinickerp, dwood + use pftvarcon , only : graincn + use clm_time_manager, only : get_step_size + use abortutils , only : endrun + use fileutils , only : getfil + use organicFileMod , only : organicrd + use spmdMod , only : mpicom, MPI_INTEGER, masterproc + use clm_varctl , only : fsnowoptics, fsnowaging + use SNICARMod , only : SnowAge_init, SnowOptics_init + use shr_scam_mod , only : shr_scam_getCloseLatLon + use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile + +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize in module initializeMod. +! +! !REVISION HISTORY: +! Created by Gordon Bonan. +! Updated to clm2.1 data structrues by Mariana Vertenstein +! 4/26/05, Peter Thornton: Eliminated exponential decrease in saturated hydraulic +! conductivity (hksat) with depth. +! Updated: Colette L. Heald (05/06) reading in VOC emission factors +! 27 February 2008: Keith Oleson; Qing Liu (2004) saturated hydraulic conductivity +! and matric potential +! 29 February 2008: David Lawrence; modified soil thermal and hydraulic properties to +! account for organic matter +! 18 March 2008: David Lawrence; nlevgrnd changes +! 03/28/08 Mark Flanner, read in netcdf files for SNICAR parameters +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: ivt(:) ! vegetation type index + integer , pointer :: pcolumn(:) ! column index of corresponding pft + integer , pointer :: pgridcell(:) ! gridcell index of corresponding pft + integer , pointer :: clandunit(:) ! landunit index of column + integer , pointer :: cgridcell(:) ! gridcell index of column + integer , pointer :: ctype(:) ! column type index + integer , pointer :: ltype(:) ! landunit type index + real(r8), pointer :: thick_wall(:) ! total thickness of urban wall + real(r8), pointer :: thick_roof(:) ! total thickness of urban roof + real(r8), pointer :: lat(:) ! gridcell latitude (radians) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: z(:,:) ! layer depth (m) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: rootfr(:,:) ! fraction of roots in each soil layer + real(r8), pointer :: rootfr_road_perv(:,:) ! fraction of roots in each soil layer for urban pervious road + real(r8), pointer :: rresis(:,:) !root resistance by layer (0-1) (nlevgrnd) + real(r8), pointer :: dewmx(:) ! maximum allowed dew [mm] + real(r8), pointer :: bsw(:,:) ! Clapp and Hornberger "b" (nlevgrnd) + real(r8), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code + real(r8), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(r8), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) (nlevgrnd) + real(r8), pointer :: watfc(:,:) ! volumetric soil water at field capacity (nlevsoi) + real(r8), pointer :: watdry(:,:) ! btran parameter for btran=0 + real(r8), pointer :: watopt(:,:) ! btran parameter for btran = 1 + real(r8), pointer :: hksat(:,:) ! hydraulic conductivity at saturation (mm H2O /s) (nlevgrnd) + real(r8), pointer :: sucsat(:,:) ! minimum soil suction (mm) (nlevgrnd) + real(r8), pointer :: csol(:,:) ! heat capacity, soil solids (J/m**3/Kelvin) (nlevgrnd) + real(r8), pointer :: tkmg(:,:) ! thermal conductivity, soil minerals [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: tkdry(:,:) ! thermal conductivity, dry soil (W/m/Kelvin) (nlevgrnd) + real(r8), pointer :: tksatu(:,:) ! thermal conductivity, saturated soil [W/m-K] (new) (nlevgrnd) + real(r8), pointer :: wtfact(:) ! maximum saturated fraction for a gridcell + real(r8), pointer :: smpmin(:) ! restriction for min of soil potential (mm) (new) + real(r8), pointer :: hkdepth(:) ! decay factor (m) + integer , pointer :: isoicol(:) ! soil color class + real(r8), pointer :: gwc_thr(:) ! threshold soil moisture based on clay content + real(r8), pointer :: mss_frc_cly_vld(:) ! [frc] Mass fraction clay limited to 0.20 + real(r8), pointer :: efisop(:,:) ! emission factors for isoprene (ug isoprene m-2 h-1) + real(r8), pointer :: max_dayl(:) ! maximum daylength (s) + real(r8), pointer :: sandfrac(:) + real(r8), pointer :: clayfrac(:) +! +! +! !OTHER LOCAL VARIABLES: +!EOP + type(file_desc_t) :: ncid ! netcdf id + integer :: n,j,ib,lev,bottom! indices + integer :: g,l,c,p ! indices + integer :: m ! vegetation type index + real(r8) :: bd ! bulk density of dry soil material [kg/m^3] + real(r8) :: tkm ! mineral conductivity + real(r8) :: xksat ! maximum hydraulic conductivity of soil [mm/s] + real(r8) :: scalez = 0.025_r8 ! Soil layer thickness discretization (m) + real(r8) :: clay,sand ! temporaries + real(r8) :: slope,intercept ! temporary, for rooting distribution + real(r8) :: temp, max_decl ! temporary, for calculation of max_dayl + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + + real(r8),pointer :: temp_ef(:) ! read in - temporary EFs + real(r8),pointer :: efisop2d(:,:) ! read in - isoprene emission factors + + real(r8),pointer :: arrayl(:) ! generic global array + integer ,pointer :: irrayg(:) ! generic global array + integer ,pointer :: soic2d(:) ! read in - soil color + real(r8),pointer :: sand3d(:,:) ! read in - soil texture: percent sand + real(r8),pointer :: clay3d(:,:) ! read in - soil texture: percent clay + real(r8),pointer :: organic3d(:,:) ! read in - organic matter: kg/m3 + real(r8),pointer :: gti(:) ! read in - fmax + real(r8) :: om_frac ! organic matter fraction + real(r8) :: om_watsat = 0.9_r8 ! porosity of organic soil + real(r8) :: om_hksat = 0.1_r8 ! saturated hydraulic conductivity of organic soil [mm/s] + real(r8) :: om_tkm = 0.25_r8 ! thermal conductivity of organic soil (Farouki, 1986) [W/m/K] + real(r8) :: om_sucsat = 10.3_r8 ! saturated suction for organic matter (Letts, 2000) + real(r8) :: om_csol = 2.5_r8 ! heat capacity of peat soil *10^6 (J/K m3) (Farouki, 1986) + real(r8) :: om_tkd = 0.05_r8 ! thermal conductivity of dry organic soil (Farouki, 1981) + real(r8) :: om_b = 2.7_r8 ! Clapp Hornberger paramater for oragnic soil (Letts, 2000) + real(r8) :: organic_max = 130._r8 ! organic matter (kg/m3) where soil is assumed to act like peat + real(r8) :: csol_bedrock = 2.0e6_r8 ! vol. heat capacity of granite/sandstone J/(m3 K)(Shabbir, 2000) + real(r8) :: pc = 0.5_r8 ! percolation threshold + real(r8) :: pcbeta = 0.139_r8 ! percolation exponent + real(r8) :: perc_frac ! "percolating" fraction of organic soil + real(r8) :: perc_norm ! normalize to 1 when 100% organic soil + real(r8) :: uncon_hksat ! series conductivity of mineral/organic soil + real(r8) :: uncon_frac ! fraction of "unconnected" soil + integer :: varid ! netCDF id's + integer :: ret + + integer :: ier ! error status + character(len=256) :: locfn ! local filename + character(len= 32) :: subname = 'iniTimeConst' ! subroutine name + integer :: mxsoil_color ! maximum number of soil color classes + real(r8), allocatable :: zurb_wall(:,:) ! wall (layer node depth) + real(r8), allocatable :: zurb_roof(:,:) ! roof (layer node depth) + real(r8), allocatable :: dzurb_wall(:,:) ! wall (layer thickness) + real(r8), allocatable :: dzurb_roof(:,:) ! roof (layer thickness) + real(r8), allocatable :: ziurb_wall(:,:) ! wall (layer interface) + real(r8), allocatable :: ziurb_roof(:,:) ! roof (layer interface) + logical :: readvar +!------------------------------------------------------------------------ + + integer :: closelatidx,closelonidx + real(r8):: closelat,closelon + integer :: iostat + +!------------------------------------------------------------------------ + + if (masterproc) write(iulog,*) 'Attempting to initialize time invariant variables' + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + call get_proc_global(numg, numl, numc, nump) + + allocate(soic2d(begg:endg), gti(begg:endg)) + allocate(sand3d(begg:endg,nlevsoi), clay3d(begg:endg,nlevsoi)) + allocate(organic3d(begg:endg,nlevsoi)) + + allocate(temp_ef(begg:endg),efisop2d(6,begg:endg)) + + efisop => gve%efisop + + ! Assign local pointers to derived subtypes components (gridcell-level) + lat => grc%lat + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + thick_wall => lps%thick_wall + thick_roof => lps%thick_roof + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + clandunit => col%landunit + cgridcell => col%gridcell + z => cps%z + dz => cps%dz + zi => cps%zi + bsw => cps%bsw + bsw2 => cps%bsw2 + psisat => cps%psisat + vwcsat => cps%vwcsat + watsat => cps%watsat + watfc => cps%watfc + watdry => cps%watdry + watopt => cps%watopt + rootfr_road_perv => cps%rootfr_road_perv + hksat => cps%hksat + sucsat => cps%sucsat + tkmg => cps%tkmg + tksatu => cps%tksatu + tkdry => cps%tkdry + csol => cps%csol + smpmin => cps%smpmin + hkdepth => cps%hkdepth + wtfact => cps%wtfact + isoicol => cps%isoicol + gwc_thr => cps%gwc_thr + mss_frc_cly_vld => cps%mss_frc_cly_vld + max_dayl => cps%max_dayl + + ! Assign local pointers to derived subtypes components (pft-level) + + ivt => pft%itype + pgridcell => pft%gridcell + pcolumn => pft%column + dewmx => pps%dewmx + rootfr => pps%rootfr + rresis => pps%rresis + sandfrac => pps%sandfrac + clayfrac => pps%clayfrac + + allocate(zurb_wall(begl:endl,nlevurb), & + zurb_roof(begl:endl,nlevurb), & + dzurb_wall(begl:endl,nlevurb), & + dzurb_roof(begl:endl,nlevurb), & + ziurb_wall(begl:endl,0:nlevurb), & + ziurb_roof(begl:endl,0:nlevurb), & + stat=ier) + if (ier /= 0) then + call endrun( 'iniTimeConst: allocation error for zurb_wall,zurb_roof,dzurb_wall,dzurb_roof,ziurb_wall,ziurb_roof' ) + end if + + ! -------------------------------------------------------------------- + ! Read soil color, sand and clay from surface dataset + ! -------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read soil color, sand and clay boundary data .....' + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + ! Determine number of soil color classes - if number of soil color classes is not + ! on input dataset set it to 8 + + if (single_column) then + call shr_scam_getCloseLatLon(locfn,scmlat,scmlon,closelat,closelon,closelatidx,closelonidx) + end if + call ncd_io(ncid=ncid, varname='mxsoil_color', flag='read', data=mxsoil_color, & + readvar=readvar) + if ( .not. readvar ) mxsoil_color = 8 + + ! Read fmax + + call ncd_io(ncid=ncid, varname='FMAX', flag='read', data=gti, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: FMAX NOT on surfdata file') + + ! Read in soil color, sand and clay fraction + + call ncd_io(ncid=ncid, varname='SOIL_COLOR', flag='read', data=soic2d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: SOIL_COLOR NOT on surfdata file' ) + + ! Read in emission factors + + call ncd_io(ncid=ncid, varname='EF1_BTR', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_BTR') + efisop2d(1,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='EF1_FET', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_FET') + efisop2d(2,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='EF1_FDT', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_FDT') + efisop2d(3,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='EF1_SHR', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_SHR') + efisop2d(4,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='EF1_GRS', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_GRS') + efisop2d(5,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='EF1_CRP', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('iniTimeConst: errror reading EF1_CRP') + efisop2d(6,:)=temp_ef(:) + + call ncd_io(ncid=ncid, varname='PCT_SAND', flag='read', data=sand3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_SAND NOT on surfdata file' ) + + call ncd_io(ncid=ncid, varname='PCT_CLAY', flag='read', data=clay3d, dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_CLAY NOT on surfdata file' ) + + call ncd_pio_closefile(ncid) + + if (masterproc) then + write(iulog,*) 'Successfully read fmax, soil color, sand and clay boundary data' + write(iulog,*) + endif + + ! Determine saturated and dry soil albedos for n color classes and + ! numrad wavebands (1=vis, 2=nir) + + allocate(albsat(mxsoil_color,numrad), albdry(mxsoil_color,numrad), stat=ier) + if (ier /= 0) then + write(iulog,*)'iniTimeConst: allocation error for albsat, albdry' + call endrun() + end if + + if (mxsoil_color == 8) then + albsat(1:8,1) = (/0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8/) + albsat(1:8,2) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,1) = (/0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8/) + albdry(1:8,2) = (/0.48_r8,0.44_r8,0.40_r8,0.36_r8,0.32_r8,0.28_r8,0.24_r8,0.20_r8/) + else if (mxsoil_color == 20) then + albsat(1:20,1) = (/0.25_r8,0.23_r8,0.21_r8,0.20_r8,0.19_r8,0.18_r8,0.17_r8,0.16_r8,& + 0.15_r8,0.14_r8,0.13_r8,0.12_r8,0.11_r8,0.10_r8,0.09_r8,0.08_r8,0.07_r8,0.06_r8,0.05_r8,0.04_r8/) + albsat(1:20,2) = (/0.50_r8,0.46_r8,0.42_r8,0.40_r8,0.38_r8,0.36_r8,0.34_r8,0.32_r8,& + 0.30_r8,0.28_r8,0.26_r8,0.24_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,1) = (/0.36_r8,0.34_r8,0.32_r8,0.31_r8,0.30_r8,0.29_r8,0.28_r8,0.27_r8,& + 0.26_r8,0.25_r8,0.24_r8,0.23_r8,0.22_r8,0.20_r8,0.18_r8,0.16_r8,0.14_r8,0.12_r8,0.10_r8,0.08_r8/) + albdry(1:20,2) = (/0.61_r8,0.57_r8,0.53_r8,0.51_r8,0.49_r8,0.48_r8,0.45_r8,0.43_r8,& + 0.41_r8,0.39_r8,0.37_r8,0.35_r8,0.33_r8,0.31_r8,0.29_r8,0.27_r8,0.25_r8,0.23_r8,0.21_r8,0.16_r8/) + else + write(iulog,*)'maximum color class = ',mxsoil_color,' is not supported' + call endrun + end if + + do p = begp,endp + g = pgridcell(p) + sandfrac(p) = sand3d(g,1)/100.0_r8 + clayfrac(p) = clay3d(g,1)/100.0_r8 + end do + + ! -------------------------------------------------------------------- + ! If a organic matter dataset has been specified, read it + ! -------------------------------------------------------------------- + + call organicrd(organic3d) + + ! -------------------------------------------------------------------- + ! Initialize time constant arrays of ecophysiological constants and + ! arrays of dgvm ecophysiological constants + ! -------------------------------------------------------------------- + + do m = 0,numpft + if (m <= ntree) then + pftcon%tree(m) = 1 + else + pftcon%tree(m) = 0 + end if + pftcon%z0mr(m) = z0mr(m) + pftcon%displar(m) = displar(m) + pftcon%dleaf(m) = dleaf(m) + pftcon%xl(m) = xl(m) + do ib = 1,numrad + pftcon%rhol(m,ib) = rhol(m,ib) + pftcon%rhos(m,ib) = rhos(m,ib) + pftcon%taul(m,ib) = taul(m,ib) + pftcon%taus(m,ib) = taus(m,ib) + end do + pftcon%qe25(m) = qe25(m) + pftcon%mp(m) = mp(m) + pftcon%c3psn(m) = c3psn(m) + pftcon%slatop(m) = slatop(m) + pftcon%dsladlai(m) = dsladlai(m) + pftcon%leafcn(m) = leafcn(m) + pftcon%flnr(m) = flnr(m) + pftcon%smpso(m) = smpso(m) + pftcon%smpsc(m) = smpsc(m) + pftcon%fnitr(m) = fnitr(m) + pftcon%woody(m) = woody(m) + pftcon%lflitcn(m) = lflitcn(m) + pftcon%frootcn(m) = frootcn(m) + pftcon%livewdcn(m) = livewdcn(m) + pftcon%deadwdcn(m) = deadwdcn(m) + pftcon%graincn(m) = graincn(m) + pftcon%froot_leaf(m) = froot_leaf(m) + pftcon%stem_leaf(m) = stem_leaf(m) + pftcon%croot_stem(m) = croot_stem(m) + pftcon%flivewd(m) = flivewd(m) + pftcon%fcur(m) = fcur(m) + pftcon%lf_flab(m) = lf_flab(m) + pftcon%lf_fcel(m) = lf_fcel(m) + pftcon%lf_flig(m) = lf_flig(m) + pftcon%fr_flab(m) = fr_flab(m) + pftcon%fr_fcel(m) = fr_fcel(m) + pftcon%fr_flig(m) = fr_flig(m) + pftcon%leaf_long(m) = leaf_long(m) + pftcon%evergreen(m) = evergreen(m) + pftcon%stress_decid(m) = stress_decid(m) + pftcon%season_decid(m) = season_decid(m) + pftcon%resist(m) = resist(m) + pftcon%dwood(m) = dwood + end do + + if (use_cndv) then + do m = 0,numpft + dgv_pftcon%crownarea_max(m) = pftpar20(m) + dgv_pftcon%tcmin(m) = pftpar28(m) + dgv_pftcon%tcmax(m) = pftpar29(m) + dgv_pftcon%gddmin(m) = pftpar30(m) + dgv_pftcon%twmax(m) = pftpar31(m) + dgv_pftcon%reinickerp(m) = reinickerp + dgv_pftcon%allom1(m) = allom1 + dgv_pftcon%allom2(m) = allom2 + dgv_pftcon%allom3(m) = allom3 + ! modification for shrubs by X.D.Z + if (m > ntree .and. m <= nbrdlf_dcd_brl_shrub ) then + dgv_pftcon%allom1(m) = allom1s + dgv_pftcon%allom2(m) = allom2s + end if + end do + end if + + ! -------------------------------------------------------------------- + ! Define layer structure for soil, lakes, urban walls and roof + ! Vertical profile of snow is not initialized here + ! -------------------------------------------------------------------- + + ! Lake layers (assumed same for all lake patches) + + dzlak(1) = 0.1_r8 + dzlak(2) = 1._r8 + dzlak(3) = 2._r8 + dzlak(4) = 3._r8 + dzlak(5) = 4._r8 + dzlak(6) = 5._r8 + dzlak(7) = 7._r8 + dzlak(8) = 7._r8 + dzlak(9) = 10.45_r8 + dzlak(10)= 10.45_r8 + + zlak(1) = 0.05_r8 + zlak(2) = 0.6_r8 + zlak(3) = 2.1_r8 + zlak(4) = 4.6_r8 + zlak(5) = 8.1_r8 + zlak(6) = 12.6_r8 + zlak(7) = 18.6_r8 + zlak(8) = 25.6_r8 + zlak(9) = 34.325_r8 + zlak(10)= 44.775_r8 + + ! Soil layers and interfaces (assumed same for all non-lake patches) + ! "0" refers to soil surface and "nlevsoi" refers to the bottom of model soil + + do j = 1, nlevgrnd + zsoi(j) = scalez*(exp(0.5_r8*(j-0.5_r8))-1._r8) !node depths + enddo + + dzsoi(1) = 0.5_r8*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + do j = 2,nlevgrnd-1 + dzsoi(j)= 0.5_r8*(zsoi(j+1)-zsoi(j-1)) + enddo + dzsoi(nlevgrnd) = zsoi(nlevgrnd)-zsoi(nlevgrnd-1) + + zisoi(0) = 0._r8 + do j = 1, nlevgrnd-1 + zisoi(j) = 0.5_r8*(zsoi(j)+zsoi(j+1)) !interface depths + enddo + zisoi(nlevgrnd) = zsoi(nlevgrnd) + 0.5_r8*dzsoi(nlevgrnd) + + ! Column level initialization for urban wall and roof layers and interfaces + do l = begl, endl + + ! "0" refers to urban wall/roof surface and "nlevsoi" refers to urban wall/roof bottom + if (ltype(l)==isturb) then + + do j = 1, nlevurb + zurb_wall(l,j) = (j-0.5)*(thick_wall(l)/float(nlevurb)) !node depths + end do + do j = 1, nlevurb + zurb_roof(l,j) = (j-0.5)*(thick_roof(l)/float(nlevurb)) !node depths + end do + + dzurb_wall(l,1) = 0.5*(zurb_wall(l,1)+zurb_wall(l,2)) !thickness b/n two interfaces + do j = 2,nlevurb-1 + dzurb_wall(l,j)= 0.5*(zurb_wall(l,j+1)-zurb_wall(l,j-1)) + enddo + dzurb_wall(l,nlevurb) = zurb_wall(l,nlevurb)-zurb_wall(l,nlevurb-1) + + dzurb_roof(l,1) = 0.5*(zurb_roof(l,1)+zurb_roof(l,2)) !thickness b/n two interfaces + do j = 2,nlevurb-1 + dzurb_roof(l,j)= 0.5*(zurb_roof(l,j+1)-zurb_roof(l,j-1)) + enddo + dzurb_roof(l,nlevurb) = zurb_roof(l,nlevurb)-zurb_roof(l,nlevurb-1) + + ziurb_wall(l,0) = 0. + do j = 1, nlevurb-1 + ziurb_wall(l,j) = 0.5*(zurb_wall(l,j)+zurb_wall(l,j+1)) !interface depths + enddo + ziurb_wall(l,nlevurb) = zurb_wall(l,nlevurb) + 0.5*dzurb_wall(l,nlevurb) + + ziurb_roof(l,0) = 0. + do j = 1, nlevurb-1 + ziurb_roof(l,j) = 0.5*(zurb_roof(l,j)+zurb_roof(l,j+1)) !interface depths + enddo + ziurb_roof(l,nlevurb) = zurb_roof(l,nlevurb) + 0.5*dzurb_roof(l,nlevurb) + end if + end do + + ! Grid level initialization + do g = begg, endg + + ! VOC emission factors + ! Set gridcell and landunit indices + efisop(:,g)=efisop2d(:,g) + + end do + + + ! -------------------------------------------------------------------- + ! Initialize soil and lake levels + ! Initialize soil color, thermal and hydraulic properties + ! -------------------------------------------------------------------- + + ! Column level initialization + do c = begc, endc + + ! Set gridcell and landunit indices + g = cgridcell(c) + l = clandunit(c) + + ! initialize maximum daylength, based on latitude and maximum declination + ! maximum declination hardwired for present-day orbital parameters, + ! +/- 23.4667 degrees = +/- 0.409571 radians, use negative value for S. Hem + max_decl = 0.409571 + if (lat(g) .lt. 0._r8) max_decl = -max_decl + temp = -(sin(lat(g))*sin(max_decl))/(cos(lat(g)) * cos(max_decl)) + temp = min(1._r8,max(-1._r8,temp)) + max_dayl(c) = 2.0_r8 * 13750.9871_r8 * acos(temp) + + ! Initialize restriction for min of soil potential (mm) + smpmin(c) = -1.e8_r8 + + ! Decay factor (m) + hkdepth(c) = 1._r8/2.5_r8 + + ! Maximum saturated fraction + wtfact(c) = gti(g) + + ! Soil color + isoicol(c) = soic2d(g) + + ! Soil hydraulic and thermal properties + ! Note that urban roof, sunwall and shadewall thermal properties used to + ! derive thermal conductivity and heat capacity are set to special + ! value because thermal conductivity and heat capacity for urban + ! roof, sunwall and shadewall are prescribed in SoilThermProp.F90 in + ! SoilTemperatureMod.F90 + if (ltype(l)==istdlak .or. ltype(l)==istwet .or. ltype(l)==istice .or. ltype(l)==istice_mec) then + do lev = 1,nlevgrnd + bsw(c,lev) = spval + bsw2(c,lev) = spval + psisat(c,lev) = spval + vwcsat(c,lev) = spval + watsat(c,lev) = spval + watfc(c,lev) = spval + hksat(c,lev) = spval + sucsat(c,lev) = spval + tkmg(c,lev) = spval + tksatu(c,lev) = spval + tkdry(c,lev) = spval + if (ltype(l)==istwet .and. lev > nlevsoi) then + csol(c,lev) = csol_bedrock + else + csol(c,lev)= spval + endif + watdry(c,lev) = spval + watopt(c,lev) = spval + end do + else if (ltype(l)==isturb .and. (ctype(c) /= icol_road_perv) .and. (ctype(c) /= icol_road_imperv) )then + ! Urban Roof, sunwall, shadewall properties set to special value + do lev = 1,nlevurb + watsat(c,lev) = spval + watfc(c,lev) = spval + bsw(c,lev) = spval + bsw2(c,lev) = spval + psisat(c,lev) = spval + vwcsat(c,lev) = spval + hksat(c,lev) = spval + sucsat(c,lev) = spval + tkmg(c,lev) = spval + tksatu(c,lev) = spval + tkdry(c,lev) = spval + csol(c,lev) = spval + watdry(c,lev) = spval + watopt(c,lev) = spval + end do + else ! soil columns of both urban and non-urban types + do lev = 1,nlevgrnd + ! duplicate clay and sand values from 10th soil layer + if (lev .le. nlevsoi) then + clay = clay3d(g,lev) + sand = sand3d(g,lev) + om_frac = (organic3d(g,lev)/organic_max)**2._r8 + else + clay = clay3d(g,nlevsoi) + sand = sand3d(g,nlevsoi) + om_frac = 0._r8 + endif + ! No organic matter for urban + if (ltype(l)==isturb) then + om_frac = 0._r8 + end if + ! Note that the following properties are overwritten for urban impervious road + ! layers that are not soil in SoilThermProp.F90 within SoilTemperatureMod.F90 + watsat(c,lev) = 0.489_r8 - 0.00126_r8*sand + bsw(c,lev) = 2.91 + 0.159*clay + sucsat(c,lev) = 10._r8 * ( 10._r8**(1.88_r8-0.0131_r8*sand) ) + bd = (1._r8-watsat(c,lev))*2.7e3_r8 + watsat(c,lev) = (1._r8 - om_frac)*watsat(c,lev) + om_watsat*om_frac + tkm = (1._r8-om_frac)*(8.80_r8*sand+2.92_r8*clay)/(sand+clay)+om_tkm*om_frac ! W/(m K) + bsw(c,lev) = (1._r8-om_frac)*(2.91_r8 + 0.159_r8*clay) + om_frac*om_b + bsw2(c,lev) = -(3.10_r8 + 0.157_r8*clay - 0.003_r8*sand) + psisat(c,lev) = -(exp((1.54_r8 - 0.0095_r8*sand + 0.0063_r8*(100.0_r8-sand-clay))*log(10.0_r8))*9.8e-5_r8) + vwcsat(c,lev) = (50.5_r8 - 0.142_r8*sand - 0.037_r8*clay)/100.0_r8 + sucsat(c,lev) = (1._r8-om_frac)*sucsat(c,lev) + om_sucsat*om_frac + xksat = 0.0070556 *( 10.**(-0.884+0.0153*sand) ) ! mm/s + + ! perc_frac is zero unless perf_frac greater than percolation threshold + if (om_frac > pc) then + perc_norm=(1._r8 - pc)**(-pcbeta) + perc_frac=perc_norm*(om_frac - pc)**pcbeta + else + perc_frac=0._r8 + endif + ! uncon_frac is fraction of mineral soil plus fraction of "nonpercolating" organic soil + uncon_frac=(1._r8-om_frac)+(1._r8-perc_frac)*om_frac + ! uncon_hksat is series addition of mineral/organic conductivites + if (om_frac .lt. 1._r8) then + uncon_hksat=uncon_frac/((1._r8-om_frac)/xksat & + +((1._r8-perc_frac)*om_frac)/om_hksat) + else + uncon_hksat = 0._r8 + end if + hksat(c,lev) = uncon_frac*uncon_hksat + (perc_frac*om_frac)*om_hksat + + tkmg(c,lev) = tkm ** (1._r8- watsat(c,lev)) + tksatu(c,lev) = tkmg(c,lev)*0.57_r8**watsat(c,lev) + tkdry(c,lev) = ((0.135_r8*bd + 64.7_r8) / (2.7e3_r8 - 0.947_r8*bd))*(1._r8-om_frac) + & + om_tkd*om_frac + csol(c,lev) = ((1._r8-om_frac)*(2.128_r8*sand+2.385_r8*clay) / (sand+clay) + & + om_csol*om_frac)*1.e6_r8 ! J/(m3 K) + if (lev .gt. nlevsoi) then + csol(c,lev) = csol_bedrock + endif + watdry(c,lev) = watsat(c,lev) * (316230._r8/sucsat(c,lev)) ** (-1._r8/bsw(c,lev)) + watopt(c,lev) = watsat(c,lev) * (158490._r8/sucsat(c,lev)) ** (-1._r8/bsw(c,lev)) + !! added by K.Sakaguchi for beta from Lee and Pielke, 1992 + ! water content at field capacity, defined as hk = 0.1 mm/day + ! used eqn (7.70) in CLM3 technote with k = 0.1 (mm/day) / secspday (day/sec) + watfc(c,lev) = watsat(c,lev) * (0.1_r8 / (hksat(c,lev)*secspday))**(1._r8/(2._r8*bsw(c,lev)+3._r8)) + end do + ! + ! Urban pervious and impervious road + ! + ! Impervious road layers -- same as above except set watdry and watopt as missing + if (ctype(c) == icol_road_imperv) then + do lev = 1,nlevgrnd + watdry(c,lev) = spval + watopt(c,lev) = spval + end do + ! pervious road layers -- same as above except also set rootfr_road_perv + ! Currently, pervious road has same properties as soil + else if (ctype(c) == icol_road_perv) then + do lev = 1, nlevgrnd + rootfr_road_perv(c,lev) = 0._r8 + enddo + do lev = 1,nlevsoi + rootfr_road_perv(c,lev) = 0.1_r8 ! uniform profile + end do + end if + endif + + ! Define lake or non-lake levels, layers and interfaces + if (ltype(l) == istdlak) then + z(c,1:nlevlak) = zlak(1:nlevlak) + dz(c,1:nlevlak) = dzlak(1:nlevlak) + else if (ltype(l) == isturb) then + if (ctype(c)==icol_sunwall .or. ctype(c)==icol_shadewall) then + z(c,1:nlevurb) = zurb_wall(l,1:nlevurb) + zi(c,0:nlevurb) = ziurb_wall(l,0:nlevurb) + dz(c,1:nlevurb) = dzurb_wall(l,1:nlevurb) + else if (ctype(c)==icol_roof) then + z(c,1:nlevurb) = zurb_roof(l,1:nlevurb) + zi(c,0:nlevurb) = ziurb_roof(l,0:nlevurb) + dz(c,1:nlevurb) = dzurb_roof(l,1:nlevurb) + else + z(c,1:nlevurb) = zsoi(1:nlevurb) + zi(c,0:nlevurb) = zisoi(0:nlevurb) + dz(c,1:nlevurb) = dzsoi(1:nlevurb) + end if + else + z(c,1:nlevgrnd) = zsoi(1:nlevgrnd) + zi(c,0:nlevgrnd) = zisoi(0:nlevgrnd) + dz(c,1:nlevgrnd) = dzsoi(1:nlevgrnd) + end if + + ! Initialize terms needed for dust model + clay = clay3d(g,1) + gwc_thr(c) = 0.17_r8 + 0.14_r8*clay*0.01_r8 + mss_frc_cly_vld(c) = min(clay*0.01_r8, 0.20_r8) + + end do + + ! pft level initialization + do p = begp, endp + + ! Initialize maximum allowed dew + + dewmx(p) = 0.1_r8 + + ! Initialize root fraction (computing from surface, d is depth in meter): + ! Y = 1 -1/2 (exp(-ad)+exp(-bd) under the constraint that + ! Y(d =0.1m) = 1-beta^(10 cm) and Y(d=d_obs)=0.99 with + ! beta & d_obs given in Zeng et al. (1998). + + c = pcolumn(p) + if (ivt(p) /= noveg) then + do lev = 1, nlevgrnd + rootfr(p,lev) = 0._r8 + enddo + do lev = 1, nlevsoi-1 + rootfr(p,lev) = .5_r8*( exp(-roota_par(ivt(p)) * zi(c,lev-1)) & + + exp(-rootb_par(ivt(p)) * zi(c,lev-1)) & + - exp(-roota_par(ivt(p)) * zi(c,lev )) & + - exp(-rootb_par(ivt(p)) * zi(c,lev )) ) + end do + rootfr(p,nlevsoi) = .5_r8*( exp(-roota_par(ivt(p)) * zi(c,nlevsoi-1)) & + + exp(-rootb_par(ivt(p)) * zi(c,nlevsoi-1)) ) + rootfr(p,nlevsoi+1:nlevgrnd) = 0.0_r8 + +!if (use_cn) then +! ! replacing the exponential rooting distribution +! ! with a linear decrease, going to zero at the bottom of the lowest +! ! soil layer for woody pfts, but going to zero at the bottom of +! ! layer 8 for non-woody pfts. This corresponds to 3.43 m for woody +! ! bottom, vs 1.38 m for non-woody bottom. +! if (woody(ivt(p)) == 1) then +! bottom = nlevsoi +! slope = -2._r8/(zi(c,bottom)*zi(c,bottom)) +! intercept = 2._r8/zi(c,bottom) +! do lev = 1, bottom +! rootfr(p,lev) = dz(c,lev) * 0.5_r8 * ((intercept+slope*zi(c,lev-1)) + (intercept+slope*zi(c,lev))) +! end do +! if (bottom < nlevsoi) then +! do lev=bottom+1,nlevgrnd +! rootfr(p,lev) = 0._r8 +! end do +! end if +! else +! bottom = 8 +! slope = -2._r8/(zi(c,bottom)*zi(c,bottom)) +! intercept = 2._r8/zi(c,bottom) +! do lev=1,bottom +! rootfr(p,lev) = dz(c,lev) * 0.5_r8 * ((intercept+slope*zi(c,lev-1)) + (intercept+slope*zi(c,lev))) +! end do +! if (bottom < nlevsoi) then +! do lev=bottom+1,nlevgrnd +! rootfr(p,lev) = 0._r8 +! end do +! end if +! end if +! endif + else + rootfr(p,1:nlevsoi) = 0._r8 + endif + + ! initialize rresis, for use in ecosystemdyn + do lev = 1,nlevgrnd + rresis(p,lev) = 0._r8 + end do + + end do ! end pft level initialization + + if (use_cn) then + ! initialize the CN variables for special landunits, including lake points + call CNiniSpecial() + end if + + deallocate(soic2d,sand3d,clay3d,gti,organic3d) + deallocate(temp_ef,efisop2d) + deallocate(zurb_wall, zurb_roof, dzurb_wall, dzurb_roof, ziurb_wall, ziurb_roof) + + + ! Initialize SNICAR optical and aging parameters: + call SnowOptics_init( ) + + call SnowAge_init( ) + + if (masterproc) write(iulog,*) 'Successfully initialized time invariant variables' + +end subroutine iniTimeConst diff --git a/components/clm/src_clm40/main/initGridCellsMod.F90 b/components/clm/src_clm40/main/initGridCellsMod.F90 new file mode 100644 index 0000000000..02e048cf7b --- /dev/null +++ b/components/clm/src_clm40/main/initGridCellsMod.F90 @@ -0,0 +1,1187 @@ +module initGridCellsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: initGridCellsMod +! +! !DESCRIPTION: +! Initializes sub-grid mapping for each land grid cell +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc,iam,mpicom + use abortutils , only : endrun + use clm_varsur , only : wtxy, vegxy + use clm_varsur , only : topoxy + use clm_varctl , only : iulog + +! +! !PUBLIC TYPES: + implicit none + private + save +! +! !PUBLIC MEMBER FUNCTIONS: + public initGridcells ! initialize sub-grid gridcell mapping +! +! !PRIVATE MEMBER FUNCTIONS: + private clm_ptrs_compdown + private clm_ptrs_check + private set_landunit_veg_compete + private set_landunit_wet_ice_lake + private set_landunit_crop_noncompete +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE DATA MEMBERS: None +!EOP +!----------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: initGridcells +! +! !INTERFACE: + subroutine initGridcells () +! +! !DESCRIPTION: +! Initialize sub-grid mapping and allocates space for derived type hierarchy. +! For each land gridcell determine landunit, column and pft properties. +! +! !USES + use clmtype + use domainMod , only : ldomain + use decompMod , only : ldecomp, get_proc_global, get_proc_bounds + use clm_varcon , only : istsoil, istice, istwet, istdlak, isturb, istice_mec + use clm_varctl , only : create_glacier_mec_landunit + use clm_varcon , only : istcrop + use subgridMod , only : subgrid_get_gcellinfo + use shr_const_mod,only : SHR_CONST_PI + use surfrdMod , only : crop_prog +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Peter Thornton and Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: li,ci,pi,m,na,gdc,gsn,glo ! indices + integer :: nveg ! number of pfts in naturally vegetated landunit + integer :: ltype ! landunit type + real(r8):: wtveg ! weight (gridcell) of naturally veg landunit + integer :: ncrop ! number of crop pfts in crop landunit + real(r8):: wtcrop ! weight (gridcell) of crop landunit + integer :: nlake ! number of pfts (columns) in lake landunit + real(r8):: wtlake ! weight (gridcell) of lake landunit + integer :: nwetland ! number of pfts (columns) in wetland landunit + real(r8):: wtwetland ! weight (gridcell) of wetland landunit + integer :: nglacier ! number of pfts (columns) in glacier landunit + real(r8):: wtglacier ! weight (gridcell) of glacier landunit + integer :: nglacier_mec ! number of pfts (columns) in glacier landunit + real(r8):: wtglacier_mec ! weight (gridcell) of glacier_mec landunit + integer :: ier ! error status + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: begg,endg ! local beg/end gridcells gdc + integer :: begl,endl ! local beg/end landunits + integer :: begc,endc ! local beg/end columns + integer :: begp,endp ! local beg/end pfts + logical :: my_gcell ! is gdc gridcell on my pe + integer :: nwtxy ! wtxy cell index + + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + !------------------------------------------------------------------------ + + ! Set pointers into derived types for this module + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ! Get total global number of grid cells, landunits, columns and pfts + + call get_proc_global(numg,numl,numc,nump) + call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) + + ! For each land gridcell on global grid determine landunit, column and pft properties + + li = begl-1 + ci = begc-1 + pi = begp-1 + + if ( crop_prog )then + ltype = istcrop + else + ltype = istsoil + end if + + !----- Set clm3 variables ----- + do gdc = begg,endg + + glo = ldecomp%gdc2glo(gdc) + nwtxy = gdc + + my_gcell = .false. + if (gdc >= begg .and. gdc <= endg) then + my_gcell = .true. + endif + + ! Determine naturally vegetated landunit + + call set_landunit_veg_compete( & + ltype=istsoil, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + ! Determine crop landunit + + call set_landunit_crop_noncompete( & + ltype=ltype, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + ! Determine urban landunit + + call set_landunit_urban( & +! ltype=isturb, wtxy=wtxy, vegxy=vegxy, & + ltype=isturb, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + ! Determine lake, wetland and glacier landunits + + call set_landunit_wet_ice_lake( & + ltype=istdlak, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + call set_landunit_wet_ice_lake( & + ltype=istwet, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + call set_landunit_wet_ice_lake( & + ltype=istice, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell) + + if (create_glacier_mec_landunit) then + call set_landunit_wet_ice_lake( & + ltype=istice_mec, & + nw=nwtxy, gi=gdc, li=li, ci=ci, pi=pi, setdata=my_gcell, & + glcmask = ldomain%glcmask(gdc)) + endif + + ! Make ice sheet masks + + gptr%gris_mask(gdc) = 0._r8 + gptr%gris_area(gdc) = 0._r8 + gptr%aais_mask(gdc) = 0._r8 + gptr%aais_area(gdc) = 0._r8 + + ! Greenland mask + if ( (ldomain%latc(gdc) > 58. .and. ldomain%latc(gdc) <= 67. .and. & + ldomain%lonc(gdc) > 302. .and. ldomain%lonc(gdc) < 330.) & + .or. & + (ldomain%latc(gdc) > 67. .and. ldomain%latc(gdc) <= 70. .and. & + ldomain%lonc(gdc) > 300. .and. ldomain%lonc(gdc) < 345.) & + .or. & + (ldomain%latc(gdc) > 70. .and. ldomain%latc(gdc) <= 75. .and. & + ldomain%lonc(gdc) > 295. .and. ldomain%lonc(gdc) < 350.) & + .or. & + (ldomain%latc(gdc) > 75. .and. ldomain%latc(gdc) <= 79. .and. & + ldomain%lonc(gdc) > 285. .and. ldomain%lonc(gdc) < 350.) & + .or. & + (ldomain%latc(gdc) > 79. .and. ldomain%latc(gdc) < 85. .and. & + ldomain%lonc(gdc) > 290. .and. ldomain%lonc(gdc) < 355.) ) then + + gptr%gris_mask(gdc) = 1.0_r8 + + elseif (ldomain%latc(gdc) < -60.) then + + gptr%aais_mask(gdc) = 1.0_r8 + + endif ! Greenland or Antarctic grid cell + + ! Set clm3 lats/lons + + if (my_gcell) then + gptr%gindex(gdc) = glo + gptr%latdeg(gdc) = ldomain%latc(gdc) + gptr%londeg(gdc) = ldomain%lonc(gdc) + gptr%lat(gdc) = gptr%latdeg(gdc) * SHR_CONST_PI/180._r8 + gptr%lon(gdc) = gptr%londeg(gdc) * SHR_CONST_PI/180._r8 + gptr%area(gdc) = ldomain%area(gdc) + endif + + enddo + + ! Fill in subgrid datatypes + + call clm_ptrs_compdown() + call clm_ptrs_check() + + end subroutine initGridcells + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: clm_ptrs_compdown +! +! !INTERFACE: + subroutine clm_ptrs_compdown() +! +! !DESCRIPTION: +! Assumes the part of the subgrid pointing up has been set. Fills +! in the data pointing down. Up is p_c, p_l, p_g, c_l, c_g, and l_g. +! +! This algorithm assumes all indices are monotonically increasing. +! +! Algorithm works as follows. The p, c, and l loops march through +! the full arrays (nump, numc, and numl) checking the "up" indexes. +! As soon as the "up" index of the current (p,c,l) cell changes relative +! to the previous (p,c,l) cell, the *i array will be set to point down +! to that cell. The *f array follows the same logic, so it's always the +! last "up" index from the previous cell when an "up" index changes. +! +! For example, a case where p_c(1:4) = 1 and p_c(5:12) = 2. This +! subroutine will set c_pi(1) = 1, c_pf(1) = 4, c_pi(2) = 5, c_pf(2) = 12. +! +! !USES + use clmtype + use decompMod , only : get_proc_bounds + +! !ARGUMENTS + implicit none +! +! !CALLED FROM: +! subroutines initGridCellsMod +! +! !REVISION HISTORY: +! 2005.11.15 T Craig Creation +! +! +! !LOCAL VARIABLES: + integer :: begg,endg,begl,endl,begc,endc,begp,endp ! beg/end glcp + integer :: g,l,c,p ! loop counters + integer :: curg,curl,curc,curp ! tracks g,l,c,p indexes in arrays + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype +!EOP +!------------------------------------------------------------------------------ + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) + + !--- Set the current c,l,g (curc, curl, curg) to zero for initialization, + !--- these indices track the current "up" index. + !--- Take advantage of locality of g/l/c/p cells + !--- Loop p through full local begp:endp length + !--- Separately check the p_c, p_l, and p_g indexes for a change in + !--- the "up" index. + !--- If there is a change, verify that the current c,l,g is within the + !--- valid range, and set c_pi, l_pi, or g_pi to that current c,l,g + !--- Constantly update the c_pf, l_pf, and g_pf array. When the + !--- g, l, c index changes, the *_pf array will be set correctly + !--- Do the same for cols setting c_li, c_gi, c_lf, c_gf and + !--- lunits setting l_gi, l_gf. + + curc = 0 + curl = 0 + curg = 0 + do p = begp,endp + if (pptr%column(p) /= curc) then + curc = pptr%column(p) + if (curc < begc .or. curc > endc) then + write(iulog,*) 'clm_ptrs_compdown ERROR: pcolumn ',p,curc,begc,endc + call endrun() + endif + cptr%pfti(curc) = p + endif + cptr%pftf(curc) = p + cptr%npfts(curc) = cptr%pftf(curc) - cptr%pfti(curc) + 1 + if (pptr%landunit(p) /= curl) then + curl = pptr%landunit(p) + if (curl < begl .or. curl > endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: plandunit ',p,curl,begl,endl + call endrun() + endif + lptr%pfti(curl) = p + endif + lptr%pftf(curl) = p + lptr%npfts(curl) = lptr%pftf(curl) - lptr%pfti(curl) + 1 + if (pptr%gridcell(p) /= curg) then + curg = pptr%gridcell(p) + if (curg < begg .or. curg > endg) then + write(iulog,*) 'clm_ptrs_compdown ERROR: pgridcell ',p,curg,begg,endg + call endrun() + endif + gptr%pfti(curg) = p + endif + gptr%pftf(curg) = p + gptr%npfts(curg) = gptr%pftf(curg) - gptr%pfti(curg) + 1 + enddo + + curg = 0 + curl = 0 + do c = begc,endc + if (cptr%landunit(c) /= curl) then + curl = cptr%landunit(c) + if (curl < begl .or. curl > endl) then + write(iulog,*) 'clm_ptrs_compdown ERROR: clandunit ',c,curl,begl,endl + call endrun() + endif + lptr%coli(curl) = c + endif + lptr%colf(curl) = c + lptr%ncolumns(curl) = lptr%colf(curl) - lptr%coli(curl) + 1 + if (cptr%gridcell(c) /= curg) then + curg = cptr%gridcell(c) + if (curg < begg .or. curg > endg) then + write(iulog,*) 'clm_ptrs_compdown ERROR: cgridcell ',c,curg,begg,endg + call endrun() + endif + gptr%coli(curg) = c + endif + gptr%colf(curg) = c + gptr%ncolumns(curg) = gptr%colf(curg) - gptr%coli(curg) + 1 + enddo + + curg = 0 + do l = begl,endl + if (lptr%gridcell(l) /= curg) then + curg = lptr%gridcell(l) + if (curg < begg .or. curg > endg) then + write(iulog,*) 'clm_ptrs_compdown ERROR: lgridcell ',l,curg,begg,endg + call endrun() + endif + gptr%luni(curg) = l + endif + gptr%lunf(curg) = l + gptr%nlandunits(curg) = gptr%lunf(curg) - gptr%luni(curg) + 1 + enddo + + end subroutine clm_ptrs_compdown +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: clm_ptrs_check +! +! !INTERFACE: + subroutine clm_ptrs_check() +! +! !DESCRIPTION: +! Checks and writes out a summary of subgrid data +! +! !USES + use clmtype + use decompMod , only : get_proc_bounds + +! !ARGUMENTS + implicit none +! +! !CALLED FROM: +! +! !REVISION HISTORY: +! 2005.11.15 T Craig Creation +! +! +! !LOCAL VARIABLES: + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + integer :: begg,endg,begl,endl,begc,endc,begp,endp ! beg/end indices + integer :: g,l,c,p ! loop counters + logical :: error ! error flag +!EOP +!------------------------------------------------------------------------------ + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + if (masterproc) write(iulog,*) ' ' + if (masterproc) write(iulog,*) '---clm_ptrs_check:' + call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) + + !--- check index ranges --- + error = .false. + if (minval(gptr%luni) < begl .or. maxval(gptr%luni) > endl) error=.true. + if (minval(gptr%lunf) < begl .or. maxval(gptr%lunf) > endl) error=.true. + if (minval(gptr%coli) < begc .or. maxval(gptr%coli) > endc) error=.true. + if (minval(gptr%colf) < begc .or. maxval(gptr%colf) > endc) error=.true. + if (minval(gptr%pfti) < begp .or. maxval(gptr%pfti) > endp) error=.true. + if (minval(gptr%pftf) < begp .or. maxval(gptr%pftf) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR' + write(iulog,*)'minval,beg,maxval,end' + write(iulog,*) minval(gptr%luni),begl,maxval(gptr%luni),endl + write(iulog,*) minval(gptr%lunf),begl,maxval(gptr%lunf),endl + write(iulog,*) minval(gptr%coli),begc,maxval(gptr%coli),endc + write(iulog,*) minval(gptr%colf),begc,maxval(gptr%colf),endc + write(iulog,*) minval(gptr%pfti),begp,maxval(gptr%pfti),endp + write(iulog,*) minval(gptr%pftf),begp,maxval(gptr%pftf),endp + call endrun() + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK' + + error = .false. + if (minval(lptr%gridcell) < begg .or. maxval(lptr%gridcell) > endg) error=.true. + if (minval(lptr%coli) < begc .or. maxval(lptr%coli) > endc) error=.true. + if (minval(lptr%colf) < begc .or. maxval(lptr%colf) > endc) error=.true. + if (minval(lptr%pfti) < begp .or. maxval(lptr%pfti) > endp) error=.true. + if (minval(lptr%pftf) < begp .or. maxval(lptr%pftf) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR' + call endrun() + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK' + + error = .false. + if (minval(cptr%gridcell) < begg .or. maxval(cptr%gridcell) > endg) error=.true. + if (minval(cptr%landunit) < begl .or. maxval(cptr%landunit) > endl) error=.true. + if (minval(cptr%pfti) < begp .or. maxval(cptr%pfti) > endp) error=.true. + if (minval(cptr%pftf) < begp .or. maxval(cptr%pftf) > endp) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR' + call endrun() + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK' + + error = .false. + if (minval(pptr%gridcell) < begg .or. maxval(pptr%gridcell) > endg) error=.true. + if (minval(pptr%landunit) < begl .or. maxval(pptr%landunit) > endl) error=.true. + if (minval(pptr%column) < begc .or. maxval(pptr%column) > endc) error=.true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR' + call endrun() + endif + if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK' + + !--- check that indices in arrays are monotonically increasing --- + error = .false. + do g=begg+1,endg + if (gptr%luni(g) < gptr%luni(g-1)) error = .true. + if (gptr%lunf(g) < gptr%lunf(g-1)) error = .true. + if (gptr%coli(g) < gptr%coli(g-1)) error = .true. + if (gptr%colf(g) < gptr%colf(g-1)) error = .true. + if (gptr%pfti(g) < gptr%pfti(g-1)) error = .true. + if (gptr%pftf(g) < gptr%pftf(g-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: g mono increasing - ERROR' + call endrun() + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: g mono increasing - OK' + + error = .false. + do l=begl+1,endl + if (lptr%gridcell(l) < lptr%gridcell(l-1)) error = .true. + if (lptr%coli(l) < lptr%coli(l-1)) error = .true. + if (lptr%colf(l) < lptr%colf(l-1)) error = .true. + if (lptr%pfti(l) < lptr%pfti(l-1)) error = .true. + if (lptr%pftf(l) < lptr%pftf(l-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR' + call endrun() + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK' + + error = .false. + do c=begc+1,endc + if (cptr%gridcell(c) < cptr%gridcell(c-1)) error = .true. + if (cptr%landunit(c) < cptr%landunit(c-1)) error = .true. + if (cptr%pfti(c) < cptr%pfti(c-1)) error = .true. + if (cptr%pftf(c) < cptr%pftf(c-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR' + call endrun() + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK' + + error = .false. + do p=begp+1,endp + if (pptr%gridcell(p) < pptr%gridcell(p-1)) error = .true. + if (pptr%landunit(p) < pptr%landunit(p-1)) error = .true. + if (pptr%column (p) < pptr%column (p-1)) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR' + call endrun() + endif + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK' + + !--- check that the tree is internally consistent --- + error = .false. + do g = begg, endg + do l = gptr%luni(g),gptr%lunf(g) + if (lptr%gridcell(l) /= g) error = .true. + do c = lptr%coli(l),lptr%colf(l) + if (cptr%gridcell(c) /= g) error = .true. + if (cptr%landunit(c) /= l) error = .true. + do p = cptr%pfti(c),cptr%pftf(c) + if (pptr%gridcell(p) /= g) error = .true. + if (pptr%landunit(p) /= l) error = .true. + if (pptr%column(p) /= c) error = .true. + if (error) then + write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' + call endrun() + endif + enddo + enddo + enddo + enddo + if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK' + if (masterproc) write(iulog,*) ' ' + +end subroutine clm_ptrs_check +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_landunit_veg_compete +! +! !INTERFACE: +! subroutine set_landunit_veg_compete (ltype, wtxy, vegxy, & + subroutine set_landunit_veg_compete (ltype, & + nw, gi, li, ci, pi, setdata) +! +! !DESCRIPTION: +! Initialize vegetated landunit with competition +! +! !USES + use clmtype + use subgridMod, only : subgrid_get_gcellinfo + use clm_varpar, only : numpft, maxpatch_pft, numcft + use clm_varctl, only : allocate_all_vegpfts, create_crop_landunit +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ltype ! landunit type +! real(r8), intent(in) :: wtxy(:,:) ! subgrid patch weights +! integer , intent(in) :: vegxy(:,:) ! PFT types + integer , intent(in) :: nw ! cell index + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! pft index + logical , intent(in) :: setdata ! set info or just compute +! +! !REVISION HISTORY: +! Created by ? +! 2005.11.25 Updated by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m ! m index in wtxy(nw,m) + integer :: n ! loop index + integer :: npfts ! number of pfts in landunit + integer :: ncols ! number of columns in landu + integer :: pitype ! pft itype + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + type(landunit_type), pointer :: lptr ! pointer to landunit + type(column_type) , pointer :: cptr ! pointer to column + type(pft_type) , pointer :: pptr ! pointer to pft + +!------------------------------------------------------------------------ + + ! Set decomposition properties + +! call subgrid_get_gcellinfo(nw, wtxy, nveg=npfts, wtveg=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nveg=npfts, wtveg=wtlunit2gcell) + + if (npfts > 0) then + + ! Set pointers into derived types for this module + + lptr => lun + cptr => col + pptr => pft + + ncols = 1 + + li = li + 1 + ci = ci + 1 + + if (setdata) then + ! Set landunit properties + lptr%ifspecial(li) = .false. + lptr%lakpoi(li) = .false. + lptr%urbpoi(li) = .false. + lptr%itype(li) = ltype + + lptr%gridcell (li) = gi + lptr%wtgcell(li) = wtlunit2gcell + + ! Set column properties for this landunit (only one column on landunit) + cptr%itype(ci) = 1 + + cptr%gridcell (ci) = gi + cptr%wtgcell(ci) = wtlunit2gcell + cptr%landunit (ci) = li + cptr%wtlunit(ci) = 1.0_r8 + endif ! setdata + + ! Set pft properties for this landunit + + if (create_crop_landunit) then + do n = 1,numpft+1-numcft + pi = pi + 1 + pitype = n-1 + if (setdata) then + pptr%mxy(pi) = n + pptr%itype(pi) = pitype + pptr%gridcell(pi) = gi + pptr%landunit(pi) = li + pptr%column (pi) = ci + pptr%wtgcell(pi) = 0.0_r8 + pptr%wtlunit(pi) = 0.0_r8 + pptr%wtcol(pi) = 0.0_r8 + do m = 1,maxpatch_pft + if (vegxy(nw,m) == pitype .and. wtxy(nw,m) > 0._r8) then + pptr%wtgcell(pi) = pptr%wtgcell(pi) + wtxy(nw,m) + pptr%wtlunit(pi) = pptr%wtlunit(pi) + wtxy(nw,m) / wtlunit2gcell + pptr%wtcol(pi) = pptr%wtcol(pi) + wtxy(nw,m) / wtlunit2gcell + end if + end do + endif ! setdata + end do + else if (allocate_all_vegpfts) then + do n = 1,numpft+1 + pi = pi + 1 + pitype = n-1 + if (setdata) then + pptr%mxy(pi) = n + pptr%itype(pi) = pitype + pptr%gridcell(pi) = gi + pptr%landunit(pi) = li + pptr%column (pi) = ci + pptr%wtgcell(pi) = 0.0_r8 + pptr%wtlunit(pi) = 0.0_r8 + pptr%wtcol(pi) = 0.0_r8 + do m = 1,maxpatch_pft + if (vegxy(nw,m) == pitype .and. wtxy(nw,m) > 0._r8) then + pptr%wtgcell(pi) = pptr%wtgcell(pi) + wtxy(nw,m) + pptr%wtlunit(pi) = pptr%wtlunit(pi) + wtxy(nw,m) / wtlunit2gcell + pptr%wtcol(pi) = pptr%wtcol(pi) + wtxy(nw,m) / wtlunit2gcell + end if + end do + endif ! setdata + end do + else + do m = 1,maxpatch_pft + if (wtxy(nw,m) > 0._r8) then + pi = pi + 1 + if (setdata) then + pptr%mxy(pi) = m + pptr%itype(pi) = vegxy(nw,m) + pptr%gridcell(pi) = gi + pptr%wtgcell(pi) = wtxy(nw,m) + pptr%landunit(pi) = li + pptr%wtlunit(pi) = wtxy(nw,m) / wtlunit2gcell + pptr%column (pi) = ci + pptr%wtcol(pi) = wtxy(nw,m) / wtlunit2gcell + endif ! setdata + end if + end do + end if + + end if + + end subroutine set_landunit_veg_compete + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_landunit_wet_ice_lake +! +! !INTERFACE: +! subroutine set_landunit_wet_ice_lake (ltype, wtxy, vegxy, & + subroutine set_landunit_wet_ice_lake (ltype, & + nw, gi, li, ci, pi, setdata, glcmask) +! +! !DESCRIPTION: +! Initialize wet_ice_lake landunits that are non-urban (lake, wetland, glacier, glacier_mec) +! +! !USES + use clmtype + use subgridMod, only : subgrid_get_gcellinfo + use clm_varcon, only : istice, istwet, istdlak, istice_mec + use clm_varpar, only : npatch_lake, npatch_glacier, npatch_wet + use clm_varpar, only : npatch_glacier_mec + +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ltype ! landunit type +! real(r8), intent(in) :: wtxy(:,:) ! subgrid patch weights +! integer , intent(in) :: vegxy(:,:) ! PFT types + integer , intent(in) :: nw ! cell index + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! pft index + logical , intent(in) :: setdata ! set info or just compute + integer , intent(in), optional :: glcmask ! = 1 where glc requires sfc mass balance + ! = 0 otherwise +! +! !REVISION HISTORY: +! Created by Sam Levis +! 2005.11.25 Updated by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m ! m index in wtxy(nw,m) + integer :: c ! column loop index + integer :: ctype ! column type + integer :: ier ! error status + integer :: npfts ! number of pfts in landunit + integer :: ncols ! number of columns in landu + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + real(r8) :: wtcol2lunit ! col weight in landunit + type(landunit_type), pointer :: lptr ! pointer to landunit + type(column_type) , pointer :: cptr ! pointer to column + type(pft_type) , pointer :: pptr ! pointer to pft + +!------------------------------------------------------------------------ + + ! Set decomposition properties + + if (ltype == istwet) then +! call subgrid_get_gcellinfo(nw, wtxy, nwetland=npfts, wtwetland=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nwetland=npfts, wtwetland=wtlunit2gcell) + m = npatch_wet + else if (ltype == istdlak) then +! call subgrid_get_gcellinfo(nw, wtxy, nlake=npfts, wtlake=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nlake=npfts, wtlake=wtlunit2gcell) + m = npatch_lake + else if (ltype == istice) then +! call subgrid_get_gcellinfo(nw, wtxy, nglacier=npfts, wtglacier=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nglacier=npfts, wtglacier=wtlunit2gcell) + m = npatch_glacier + else if (ltype == istice_mec) then +! call subgrid_get_gcellinfo(nw, wtxy, nglacier_mec=npfts, wtglacier_mec=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nglacier_mec=npfts, wtglacier_mec=wtlunit2gcell, & + glcmask = glcmask) + ! NOTE: multiple columns per landunit, so m is not set here + + else + write(iulog,*)' set_landunit_wet_ice_lake: ltype of ',ltype,' not valid' + write(iulog,*)' only istwet, istdlak, istice and istice_mec ltypes are valid' + call endrun() + end if + + if (npfts > 0) then + + ! Set pointers into derived types for this module + + lptr => lun + cptr => col + pptr => pft + + if (npfts /=1 .and. ltype /= istice_mec) then + write(iulog,*)' set_landunit_wet_ice_lake: compete landunit must'// & + ' have one column and one pft ' + write(iulog,*)' current values of ncols, pfts=',ncols,npfts + call endrun() + end if + + if (ltype==istice_mec) then ! multiple columns per landunit + + ! Assume that columns are of type 1 and that each column has its own pft + + ctype = 1 + li = li + 1 + + if (setdata) then + + ! Determine landunit properties + + lptr%itype (li) = ltype + lptr%ifspecial(li) = .true. + lptr%glcmecpoi(li) = .true. + lptr%lakpoi (li) = .false. + lptr%urbpoi (li) = .false. + lptr%gridcell (li) = gi + lptr%wtgcell (li) = wtlunit2gcell + + ! Determine column and properties + ! (Each column has its own pft) + ! + ! For grid cells with glcmask = 1, make sure all the elevations classes + ! are populated, even if some have zero fractional area. This ensures that the + ! ice sheet component, glc, will receive a surface mass balance in each elevation + ! class wherever the SMB is needed. + ! Columns with zero weight are referred to as "virtual" columns. + + do m = npatch_glacier+1, npatch_glacier_mec + + if (wtxy(nw,m) > 0._r8 .or. glcmask == 1) then + + ci = ci + 1 + pi = pi + 1 + if (wtlunit2gcell > 0._r8) then + wtcol2lunit = wtxy(nw,m)/wtlunit2gcell + else ! virtual landunit + wtcol2lunit = 0._r8 + endif + + cptr%itype (ci) = ctype + cptr%gridcell (ci) = gi + cptr%wtgcell (ci) = wtcol2lunit * wtlunit2gcell + cptr%landunit (ci) = li + cptr%wtlunit (ci) = wtcol2lunit + + ! Set sfc elevation too + + cps%glc_topo(ci) = topoxy(nw,m) + + ! Set pft properties + + pptr%mxy (pi) = m + pptr%itype (pi) = vegxy(nw,m) + pptr%gridcell (pi) = gi + pptr%wtgcell (pi) = wtcol2lunit * wtlunit2gcell + pptr%landunit (pi) = li + pptr%wtlunit (pi) = wtcol2lunit + pptr%column (pi) = ci + pptr%wtcol (pi) = 1.0_r8 + + endif ! wtxy > 0 or glcmask = 1 + enddo ! loop over columns + endif ! setdata + + else + + ncols = 1 + + ! Currently assume that each landunit only has only one column + ! (of type 1) and that each column has its own pft + + wtcol2lunit = 1.0_r8/ncols + ctype = 1 + + li = li + 1 + ci = ci + 1 + pi = pi + 1 + + if (setdata) then + + ! Determine landunit properties + + lptr%itype (li) = ltype + lptr%ifspecial(li) = .true. + lptr%urbpoi (li) = .false. + if (ltype == istdlak) then + lptr%lakpoi(li) = .true. + else + lptr%lakpoi(li) = .false. + end if + + lptr%gridcell (li) = gi + lptr%wtgcell(li) = wtlunit2gcell + + ! Determine column and properties + ! For the wet, ice or lake landunits it is assumed that each + ! column has its own pft + + cptr%itype(ci) = ctype + + cptr%gridcell (ci) = gi + cptr%wtgcell(ci) = wtcol2lunit * wtlunit2gcell + cptr%landunit (ci) = li + cptr%wtlunit(ci) = wtcol2lunit + + ! Set pft properties + + pptr%mxy(pi) = m + pptr%itype(pi) = vegxy(nw,m) + + pptr%gridcell (pi) = gi + pptr%wtgcell(pi) = wtcol2lunit * wtlunit2gcell + pptr%landunit (pi) = li + pptr%wtlunit(pi) = wtcol2lunit + pptr%column (pi) = ci + pptr%wtcol(pi) = 1.0_r8 + endif ! setdata + end if ! ltype = istice_mec + endif ! npfts > 0 + + end subroutine set_landunit_wet_ice_lake + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_landunit_crop_noncompete +! +! !INTERFACE: +! subroutine set_landunit_crop_noncompete (ltype, wtxy, vegxy, & + subroutine set_landunit_crop_noncompete (ltype, & + nw, gi, li, ci, pi, setdata) +! +! !DESCRIPTION: +! Initialize crop landunit without competition +! +! !USES + use clmtype + use subgridMod, only : subgrid_get_gcellinfo + use clm_varctl, only : create_crop_landunit + use clm_varpar, only : maxpatch_pft, numcft, npatch_glacier_mec +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ltype ! landunit type +! real(r8), intent(in) :: wtxy(:,:) ! subgrid patch weights +! integer , intent(in) :: vegxy(:,:) ! PFT types + integer , intent(in) :: nw ! cell index + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! pft index + logical , intent(in) :: setdata ! set info or just compute +! +! !REVISION HISTORY: +! Created by Sam Levis +! 2005.11.25 Updated by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m ! m index in wtxy(nw,m) + integer :: npfts ! number of pfts in landunit + integer :: ncols ! number of columns in landu + real(r8) :: wtlunit2gcell ! landunit weight in gridcell + type(landunit_type), pointer :: lptr ! pointer to landunit + type(column_type) , pointer :: cptr ! pointer to column + type(pft_type) , pointer :: pptr ! pointer to pft +!------------------------------------------------------------------------ + + ! Set decomposition properties + +! call subgrid_get_gcellinfo(nw, wtxy, ncrop=npfts, wtcrop=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, ncrop=npfts, wtcrop=wtlunit2gcell) + + if (npfts > 0) then + + ! Set pointers into derived types for this module + + lptr => lun + cptr => col + pptr => pft + + ! Set landunit properties - each column has its own pft + + ncols = npfts + + li = li + 1 + + if (setdata) then + lptr%itype(li) = ltype + lptr%ifspecial(li) = .false. + lptr%lakpoi(li) = .false. + lptr%urbpoi(li) = .false. + lptr%gridcell (li) = gi + lptr%wtgcell(li) = wtlunit2gcell + endif ! setdata + + ! Set column and pft properties for this landunit + ! (each column has its own pft) + + if (create_crop_landunit) then + do m = maxpatch_pft-numcft+1, maxpatch_pft + ci = ci + 1 + pi = pi + 1 + + if (setdata) then + cptr%itype(ci) = 1 + pptr%itype(pi) = m - 1 + pptr%mxy(pi) = m + + cptr%gridcell (ci) = gi + cptr%wtgcell(ci) = wtxy(nw,m) + cptr%landunit (ci) = li + + pptr%gridcell (pi) = gi + pptr%wtgcell(pi) = wtxy(nw,m) + pptr%landunit (pi) = li + pptr%column (pi) = ci + if (wtxy(nw,m) > 0._r8) then + cptr%wtlunit(ci) = wtxy(nw,m) / wtlunit2gcell + pptr%wtlunit(pi) = wtxy(nw,m) / wtlunit2gcell + pptr%wtcol(pi) = 1._r8 + else + cptr%wtlunit(ci) = 0._r8 + pptr%wtlunit(pi) = 0._r8 + pptr%wtcol(pi) = 0._r8 + end if + endif ! setdata + end do + end if + + end if + + end subroutine set_landunit_crop_noncompete + +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_landunit_urban +! +! !INTERFACE: +! subroutine set_landunit_urban (ltype, wtxy, vegxy, & + subroutine set_landunit_urban (ltype, & + nw, gi, li, ci, pi, setdata) +! +! !DESCRIPTION: +! Initialize urban landunits +! +! !USES + use clm_varcon , only : isturb, icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv + use clm_varpar , only : npatch_urban, maxpatch_urb + use clmtype + use subgridMod , only : subgrid_get_gcellinfo + use UrbanInputMod, only : urbinp + use decompMod , only : ldecomp +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ltype ! landunit type +! real(r8), intent(in) :: wtxy(:,:) ! subgrid patch weights +! integer , intent(in) :: vegxy(:,:) ! PFT types + integer , intent(in) :: nw ! cell index + integer , intent(in) :: gi ! gridcell index + integer , intent(inout) :: li ! landunit index + integer , intent(inout) :: ci ! column index + integer , intent(inout) :: pi ! pft index + logical , intent(in) :: setdata ! set info or just compute +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: c ! column loop index + integer :: m ! m index in wtxy(nw,m) + integer :: ctype ! column type + integer :: npfts ! number of pfts in landunit + integer :: ncols ! number of columns in landunit + real(r8) :: wtlunit2gcell ! weight relative to gridcell of landunit + real(r8) :: wtcol2lunit ! weight of column with respect to landunit + real(r8) :: wtlunit_roof ! weight of roof with respect to landunit + real(r8) :: wtroad_perv ! weight of pervious road column with respect to total road + integer :: ier ! error status + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype +!------------------------------------------------------------------------ + + ! Set decomposition properties + +! call subgrid_get_gcellinfo(nw, wtxy, nurban=npfts, wturban=wtlunit2gcell) + call subgrid_get_gcellinfo(nw, nurban=npfts, wturban=wtlunit2gcell) + + if (npfts > 0) then + + ! Set pointers into derived types for this module + + lptr => lun + cptr => col + pptr => pft + + ! Determine landunit properties - each columns has its own pft + + ncols = npfts + + li = li + 1 + if (setdata) then + lptr%itype (li) = ltype + lptr%ifspecial(li) = .true. + lptr%lakpoi (li) = .false. + lptr%urbpoi (li) = .true. + + lptr%gridcell (li) = gi + lptr%wtgcell (li) = wtlunit2gcell + endif + + ! Loop through columns for this landunit and set the column and pft properties + ! For the urban landunits it is assumed that each column has its own pft + + do m = npatch_urban, npatch_urban + maxpatch_urb - 1 + if (wtxy(nw,m) > 0._r8) then + + wtlunit_roof = urbinp%wtlunit_roof(nw) + wtroad_perv = urbinp%wtroad_perv(nw) + + if (m == npatch_urban ) then + ctype = icol_roof + wtcol2lunit = wtlunit_roof + else if (m == npatch_urban+1) then + ctype = icol_sunwall + wtcol2lunit = (1. - wtlunit_roof)/3 + else if (m == npatch_urban+2) then + ctype = icol_shadewall + wtcol2lunit = (1. - wtlunit_roof)/3 + else if (m == npatch_urban+3) then + ctype = icol_road_imperv + wtcol2lunit = ((1. - wtlunit_roof)/3) * (1.-wtroad_perv) + else if (m == npatch_urban+4) then + ctype = icol_road_perv + wtcol2lunit = ((1. - wtlunit_roof)/3) * (wtroad_perv) + end if + + ci = ci + 1 + pi = pi + 1 + + if (setdata) then + cptr%itype(ci) = ctype + + cptr%gridcell (ci) = gi + cptr%wtgcell (ci) = wtcol2lunit * wtlunit2gcell + cptr%landunit (ci) = li + cptr%wtlunit (ci) = wtcol2lunit + + pptr%mxy (pi) = m + pptr%itype (pi) = vegxy(nw,m) + + pptr%gridcell(pi) = gi + pptr%wtgcell (pi) = wtcol2lunit * wtlunit2gcell + pptr%landunit(pi) = li + pptr%wtlunit (pi) = wtcol2lunit + pptr%column (pi) = ci + pptr%wtcol (pi) = 1.0_r8 + end if + + end if + end do ! end of loop through urban columns-pfts + + end if + + end subroutine set_landunit_urban + +!------------------------------------------------------------------------------ + +end module initGridCellsMod diff --git a/components/clm/src_clm40/main/initSurfAlbMod.F90 b/components/clm/src_clm40/main/initSurfAlbMod.F90 new file mode 100644 index 0000000000..8314905ba1 --- /dev/null +++ b/components/clm/src_clm40/main/initSurfAlbMod.F90 @@ -0,0 +1,344 @@ +module initSurfalbMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: initSurfalbMod +! +! !DESCRIPTION: +! Computes initial surface albedo calculation - +! Initialization of ecosystem dynamics is needed for this +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils, only : endrun + use clm_varctl, only : iulog, use_cn, use_cndv +! +! !PUBLIC TYPES: + implicit none + logical, public :: do_initsurfalb +! save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: InitSurfAlb +! +! !REVISION HISTORY: +! 2005-06-12: Created by Mariana Vertenstein +! 2008-02-29: Revised snow cover fraction from Niu and Yang, 2007 +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: initSurfalb +! +! !INTERFACE: + subroutine initSurfalb( calday, declin, declinm1 ) +! +! !DESCRIPTION: +! The variable, h2osoi_vol, is needed by the soil albedo routine - this is not needed +! on restart since it is computed before the soil albedo computation is called. +! The remaining variables are initialized by calls to ecosystem dynamics and +! albedo subroutines. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_orb_mod , only : shr_orb_decl + use shr_const_mod , only : SHR_CONST_PI + use clmtype + use spmdMod , only : masterproc,iam + use decompMod , only : get_proc_clumps, get_clump_bounds + use filterMod , only : filter + use clm_varpar , only : nlevsoi, nlevsno, nlevlak, nlevgrnd + use clm_varcon , only : zlnd, istsoil, isturb, denice, denh2o, & + icol_roof, icol_road_imperv, & + icol_road_perv + use clm_varcon , only : istcrop + use clm_time_manager , only : get_step_size + use FracWetMod , only : FracWet + use SurfaceAlbedoMod , only : SurfaceAlbedo + use CNEcosystemDynMod , only : CNEcosystemDyn + use CNVegStructUpdateMod, only : CNVegStructUpdate + use STATICEcosysDynMod , only : EcosystemDyn, interpMonthlyVeg + use UrbanMod , only : UrbanAlbedo + use abortutils , only : endrun +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: calday ! calendar day for declin + real(r8), intent(in) :: declin ! declination angle (radians) for calday + real(r8), intent(in), optional :: declinm1 ! declination angle (radians) for caldaym1 +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: plandunit(:) ! landunit index associated with each pft + integer , pointer :: ctype(:) ! column type + integer , pointer :: clandunit(:) ! landunit index associated with each column + integer, pointer :: pgridcell(:) ! gridcell associated with each pft + integer , pointer :: itypelun(:) ! landunit type + logical , pointer :: lakpoi(:) ! true => landunit is a lake point + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + integer , pointer :: frac_veg_nosno_alb(:) ! fraction of vegetation not covered by snow (0 OR 1) [-] + real(r8), pointer :: dayl(:) ! daylength (seconds) + real(r8), pointer :: latdeg(:) ! latitude (degrees) + integer , pointer :: pcolumn(:) ! index into column level quantities + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) +! +! local pointers to implicit out arguments +! + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1) + integer , pointer :: frac_veg_nosno(:) ! fraction of vegetation not covered by snow (0 OR 1) [-] + real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) (pft-level) + real(r8), pointer :: decl(:) ! solar declination angle (radians) +! +! local pointers to implicit out arguments (lake points only) +! + real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) + real(r8), pointer :: tlai(:) ! one-sided leaf area index, no burying by snow + real(r8), pointer :: tsai(:) ! one-sided stem area index, no burying by snow + real(r8), pointer :: htop(:) ! canopy top (m) + real(r8), pointer :: hbot(:) ! canopy bottom (m) + real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow + real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: nc,j,l,c,p,fc ! indices + integer :: nclumps ! number of clumps on this processor + integer :: begp, endp ! per-clump beginning and ending pft indices + integer :: begc, endc ! per-clump beginning and ending column indices + integer :: begl, endl ! per-clump beginning and ending landunit indices + integer :: begg, endg ! per-clump gridcell ending gridcell indices + integer :: ier ! MPI return code + real(r8):: lat ! latitude (radians) for daylength calculation + real(r8):: temp ! temporary variable for daylength + real(r8):: snowbd ! temporary calculation of snow bulk density (kg/m3) + real(r8):: fmelt ! snowbd/100 +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (landunit-level) + + lakpoi => lun%lakpoi + itypelun => lun%itype + + ! Assign local pointers to derived subtypes components (column-level) + + dz => cps%dz + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + h2osoi_vol => cws%h2osoi_vol + snowdp => cps%snowdp + h2osno => cws%h2osno + frac_sno => cps%frac_sno + ctype => col%itype + clandunit => col%landunit + soilpsi => cps%soilpsi + + ! Assign local pointers to derived subtypes components (pft-level) + + plandunit => pft%landunit + frac_veg_nosno_alb => pps%frac_veg_nosno_alb + frac_veg_nosno => pps%frac_veg_nosno + fwet => pps%fwet + + ! Assign local pointers to derived subtypes components (pft-level) + ! The folowing pointers will only be used for lake points in this routine + + htop => pps%htop + hbot => pps%hbot + tlai => pps%tlai + tsai => pps%tsai + elai => pps%elai + esai => pps%esai + fdry => pps%fdry + + decl => cps%decl + dayl => pepv%dayl + pcolumn => pft%column + pgridcell => pft%gridcell + latdeg => grc%latdeg + + ! ======================================================================== + ! Determine surface albedo - initialized by calls to ecosystem dynamics and + ! albedo subroutines. Note: elai, esai, frac_veg_nosno_alb are computed in + ! Ecosysdyn and needed by routines FracWet and SurfaceAlbedo and + ! frac_veg_nosno is needed by FracWet + ! fwet is needed in routine TwoStream (called by SurfaceAlbedo) + ! frac_sno is needed by SoilAlbedo (called by SurfaceAlbedo) + ! ======================================================================== + + if (.not. use_cn) then + ! the default mode uses prescribed vegetation structure + ! Read monthly vegetation data for interpolation to daily values + + call interpMonthlyVeg() + end if + + ! Determine clump bounds for this processor + + nclumps = get_proc_clumps() + + ! Loop over clumps on this processor +!$OMP PARALLEL DO PRIVATE (nc,p,j,l,c,fc,begg,endg,begl,endl,begc,endc,begp,endp,lat,temp,snowbd,fmelt) + do nc = 1,nclumps + + ! Determine clump bounds + + call get_clump_bounds(nc, begg, endg, begl, endl, begc, endc, begp, endp) + + ! Determine variables needed by SurfaceAlbedo for lake points + + do p = begp,endp + l = plandunit(p) + if (lakpoi(l)) then + fwet(p) = 0._r8 + fdry(p) = 0._r8 + elai(p) = 0._r8 + esai(p) = 0._r8 + htop(p) = 0._r8 + hbot(p) = 0._r8 + tlai(p) = 0._r8 + tsai(p) = 0._r8 + frac_veg_nosno_alb(p) = 0._r8 + frac_veg_nosno(p) = 0._r8 + end if + end do + + ! ============================================================================ + ! Ecosystem dynamics: Uses CN, or static parameterizations + ! ============================================================================ + + if (use_cn) then + do j = 1, nlevgrnd + do fc = 1, filter(nc)%num_soilc + c = filter(nc)%soilc(fc) + soilpsi(c,j) = -15.0_r8 + end do + end do + end if + + ! Determine variables needed for SurfaceAlbedo for non-lake points + + if (use_cn) then + ! CN initialization is done only on the soil landunits. + + if (.not. present(declinm1)) then + write(iulog,*)'declination for the previous timestep (declinm1) must be ',& + ' present as argument in CN mode' + call endrun() + end if + + ! it is necessary to initialize the solar declination for the previous + ! timestep (caldaym1) so that the CNphenology routines know if this is + ! before or after the summer solstice. + + ! declination for previous timestep + do c = begc, endc + l = clandunit(c) + if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then + decl(c) = declinm1 + end if + end do + + ! daylength for previous timestep + do p = begp, endp + c = pcolumn(p) + l = plandunit(p) + if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then + lat = latdeg(pgridcell(p)) * SHR_CONST_PI / 180._r8 + temp = -(sin(lat)*sin(decl(c)))/(cos(lat) * cos(decl(c))) + temp = min(1._r8,max(-1._r8,temp)) + dayl(p) = 2.0_r8 * 13750.9871_r8 * acos(temp) + end if + end do + + ! declination for current timestep + do c = begc, endc + l = clandunit(c) + if (itypelun(l) == istsoil .or. itypelun(l) == istcrop) then + decl(c) = declin + end if + end do + + call CNEcosystemDyn(begc, endc, begp, endp, filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_pcropp, filter(nc)%pcropp, doalb=.true.) + + else + + ! this is the default call if CN not set + + call EcosystemDyn(begp, endp, filter(nc)%num_nolakep, filter(nc)%nolakep, & + doalb=.true.) + end if + + do p = begp, endp + l = plandunit(p) + if (.not. lakpoi(l)) then + frac_veg_nosno(p) = frac_veg_nosno_alb(p) + fwet(p) = 0._r8 + end if + end do + + call FracWet(filter(nc)%num_nolakep, filter(nc)%nolakep) + + ! Compute Surface Albedo - all land points (including lake) other than urban + ! Needs as input fracion of soil covered by snow (Z.-L. Yang U. Texas) + + do c = begc, endc + l = clandunit(c) + if (itypelun(l) == isturb) then + ! From Bonan 1996 (LSM technical note) + frac_sno(c) = min( snowdp(c)/0.05_r8, 1._r8) + else + frac_sno(c) = 0._r8 + ! snow cover fraction as in Niu and Yang 2007 + if(snowdp(c) .gt. 0.0) then + snowbd = min(800._r8,h2osno(c)/snowdp(c)) !bulk density of snow (kg/m3) + fmelt = (snowbd/100.)**1. + ! 100 is the assumed fresh snow density; 1 is a melting factor that could be + ! reconsidered, optimal value of 1.5 in Niu et al., 2007 + frac_sno(c) = tanh( snowdp(c) /(2.5 * zlnd * fmelt) ) + endif + end if + end do + call SurfaceAlbedo(begg, endg, begc, endc, begp, endp, & + filter(nc)%num_nourbanc, filter(nc)%nourbanc, & + filter(nc)%num_nourbanp, filter(nc)%nourbanp, & + calday, declin) + + + ! Determine albedos for urban landunits + + if (filter(nc)%num_urbanl > 0) then + call UrbanAlbedo(nc, begl, endl, begc, endc, begp, endp, & + filter(nc)%num_urbanl, filter(nc)%urbanl, & + filter(nc)%num_urbanc, filter(nc)%urbanc, & + filter(nc)%num_urbanp, filter(nc)%urbanp ) + + end if + + end do ! end of loop over clumps +!$OMP END PARALLEL DO + + end subroutine initSurfalb + +end module initSurfalbMod diff --git a/components/clm/src_clm40/main/lnd_comp_esmf.F90 b/components/clm/src_clm40/main/lnd_comp_esmf.F90 new file mode 100644 index 0000000000..bc0c3c16bb --- /dev/null +++ b/components/clm/src_clm40/main/lnd_comp_esmf.F90 @@ -0,0 +1,811 @@ +module lnd_comp_esmf + +#ifdef ESMF_INTERFACE + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Interface of the active land model component of CESM the CLM (Community Land Model) + ! with the main CESM driver. This is a thin interface taking CESM driver information + ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM and outputing + ! if in ESMF (Earth System Modelling Framework) format. + ! + ! !USES: + use esmf + use esmfshr_util_mod + use shr_kind_mod , only : r8 => shr_kind_r8, SHR_KIND_CL + use shr_string_mod , only : shr_string_listGetNum + use abortutils , only : endrun + use domainMod , only : ldomain + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use clm_varctl , only : iulog + use clm_atmlnd , only : atm2lnd_type, lnd2atm_type + use clm_glclnd , only : glc2lnd_type, lnd2glc_type + use clm_cpl_indices + use lnd_import_export + ! + ! !PUBLIC MEMBER FUNCTIONS: + implicit none + SAVE + private ! By default make data private + ! + public :: lnd_register_esmf ! register clm initial, run, final methods + public :: lnd_init_esmf ! clm initialization + public :: lnd_run_esmf ! clm run phase + public :: lnd_final_esmf ! clm finalization/cleanup + ! + ! !PRIVATE MEMBER FUNCTIONS: + private :: lnd_distgrid_esmf ! Distribute clm grid + private :: lnd_domain_esmf ! Set the land model domain information + !--------------------------------------------------------------------------- + +contains + + !--------------------------------------------------------------------------- + subroutine lnd_register_esmf(comp, rc) + ! + ! !DESCRIPTION: + ! Register the clm initial, run, and final phase methods with ESMF. + ! + ! !ARGUMENTS: + type(ESMF_GridComp) :: comp ! CLM grid component + integer, intent(out) :: rc ! return status + !----------------------------------------------------------------------- + rc = ESMF_SUCCESS + ! Register the callback routines. + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & + lnd_init_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & + lnd_run_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & + lnd_final_esmf, phase=1, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine lnd_register_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + ! + ! !USES: + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, set_nextsw_cday + use clm_atmlnd , only : clm_l2a + use clm_glclnd , only : clm_s2x + use clm_initializeMod, only : initialize1, initialize2 + use clm_varctl , only : finidat,single_column, clm_varctl_set, noland + use clm_varctl , only : inst_index, inst_suffix, inst_name + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use controlMod , only : control_setNL + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel + use shr_file_mod , only : shr_file_getLogUnit, shr_file_getLogLevel + use shr_file_mod , only : shr_file_getUnit, shr_file_setIO + use spmdMod , only : masterproc, spmd_init + use seq_timemgr_mod , only : seq_timemgr_EClockGetData + use seq_infodata_mod , only : seq_infodata_start_type_cont + use seq_infodata_mod , only : seq_infodata_start_type_brnch + use seq_infodata_mod , only : seq_infodata_start_type_start + use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use seq_flds_mod + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + ! + ! !LOCAL VARIABLES: + integer :: mpicom_lnd, mpicom_vm, gsize + type(ESMF_ArraySpec) :: arrayspec + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: dom, l2x, x2l + type(ESMF_VM) :: vm + 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 + real(r8) :: scmlat ! single-column latitude + real(r8) :: scmlon ! single-column longitude + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + 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) + 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 + logical :: atm_aero ! Flag if aerosol data sent from atm model + integer :: lbnum ! input to memory diagnostic + integer :: shrlogunit,shrloglev ! old values for log unit and log level + type(bounds_type) :: bounds ! bounds + integer :: LNDID ! cesm ID value + integer :: nfields + real(R8), pointer :: fptr(:, :) + character(len=32), parameter :: sub = 'lnd_init_esmf' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + character(ESMF_MAXSTR) :: convCIM, purpComp + !----------------------------------------------------------------------- + + ! Determine indices + + call clm_cpl_indices_set() + + rc = ESMF_SUCCESS + + ! duplicate the mpi communicator from the current VM + + call ESMF_VMGetCurrent(vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call MPI_Comm_dup(mpicom_vm, mpicom_lnd, rc) + if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="ID", value=LNDID, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call spmd_init( mpicom_lnd, LNDID ) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_init_esmf:start::',lbnum) + endif +#endif + + inst_name = seq_comm_name(LNDID) + inst_index = seq_comm_inst(LNDID) + inst_suffix = seq_comm_suffix(LNDID) + + ! Initialize io log unit + + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Use infodata to set orbital values + + call ESMF_AttributeGet(export_state, name="orb_eccen", value=eccen, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_mvelpp", value=mvelpp, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_lambm0", value=lambm0, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_obliqr", value=obliqr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Consistency check on namelist filename + + call control_setNL("lnd_in"//trim(inst_suffix)) + + ! Initialize clm + ! initialize1 reads namelist, grid and surface data + ! initialize2 performs rest of initialization + + 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 ) + + call ESMF_AttributeGet(export_state, name="case_name", value=caseid, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="case_desc", value=ctitle, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="single_column", value=single_column, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="scmlat", value=scmlat, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="scmlon", value=scmlon, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="brnch_retain_casename", value=brnch_retain_casename, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="start_type", value=starttype, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="model_version", value=version, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="hostname", value=hostname, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="username", value=username, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + 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) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + nsrest = nsrContinue + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + nsrest = nsrBranch + else + call endrun( sub//' ERROR: unknown starttype' ) + end if + + call clm_varctl_set( & + caseid_in=caseid, ctitle_in=ctitle, & + brnch_retain_casename_in=brnch_retain_casename, & + single_column_in=single_column, scmlat_in=scmlat, & + scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & + hostname_in=hostname, username_in=username ) + + call initialize1( ) + + ! If no land then exit out of initialization + + if ( noland) then + call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) + if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) + if( rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + end if + + ! Determine if aerosol and dust deposition come from atmosphere component + + rc = ESMF_SUCCESS + + call ESMF_AttributeGet(export_state, name="atm_aero", value=atm_aero, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if + + !----------------------------------------- + ! Initialize distgrid + !----------------------------------------- + + call get_proc_bounds(bounds) + + distgrid = lnd_distgrid_esmf(bounds, gsize) + + call ESMF_AttributeSet(export_state, name="gsize", value=gsize, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Set arrayspec for dom, l2x and x2l + !----------------------------------------- + + call ESMF_ArraySpecSet(arrayspec, rank=2, typekind=ESMF_TYPEKIND_R8, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Create dom + !----------------------------------------- + + nfields = shr_string_listGetNum(trim(seq_flds_dom_fields)) + + dom = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="domain", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(dom, name="mct_names", value=trim(seq_flds_dom_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Set values of dom + call lnd_domain_esmf(bounds, dom) + + !----------------------------------------- + ! Create l2x + !----------------------------------------- + + ! 1d undistributed index of fields, 2d is packed data + + nfields = shr_string_listGetNum(trim(seq_flds_l2x_fields)) + + l2x = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="d2x", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(l2x, name="mct_names", value=trim(seq_flds_l2x_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Create x2l + !----------------------------------------- + + nfields = shr_string_listGetNum(trim(seq_flds_x2l_fields)) + + x2l = ESMF_ArrayCreate(distgrid=distgrid, arrayspec=arrayspec, distgridToArrayMap=(/2/), & + undistLBound=(/1/), undistUBound=(/nfields/), name="x2d", rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(x2l, name="mct_names", value=trim(seq_flds_x2l_fields), rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + !----------------------------------------- + ! Add esmf arrays to import and export state + !----------------------------------------- + + call ESMF_StateAdd(export_state, (/dom/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(export_state, (/l2x/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_StateAdd(import_state, (/x2l/), rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Finish initializing clm + + 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) write(iulog,*)'dtime_sync= ',dtime_sync,& + ' dtime_clm= ',dtime_clm,' mod = ',mod(dtime_sync,dtime_clm) + 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 ESMF_ArrayGet(l2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_export(bounds, clm_l2a, clm_s2x, fptr) + + ! Set land modes + + call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.true., rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_nx", value=ldomain%ni, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeSet(export_state, name="lnd_ny", value=ldomain%nj, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Get nextsw_cday + + call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call set_nextsw_cday( nextsw_cday ) + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_esmf:end::',lbnum) + call memmon_reset_addr() + endif +#endif + +#ifdef USE_ESMF_METADATA + convCIM = "CIM" + purpComp = "Model Component Simulation Description" + + call ESMF_AttributeAdd(comp, & + convention=convCIM, purpose=purpComp, rc=rc) + + call ESMF_AttributeSet(comp, "ShortName", "CLM", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "LongName", & + "Community Land Model", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "Description", & + "The Community Land Model version 4.0 is " // & + "the land model used in the CESM1.0. " // & + "More information on the CLM project " // & + "and access to previous CLM model versions and " // & + "documentation can be found via the CLM Web Page.", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & + convention=convCIM, purpose=purpComp, rc=rc) + call ESMF_AttributeSet(comp, "ModelType", "Land", & + convention=convCIM, purpose=purpComp, rc=rc) +#endif + + end subroutine lnd_init_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Run clm model + ! + ! !USES: + use clm_atmlnd ,only : clm_l2a, clm_a2l, a2l_not_downscaled_gcell + use clm_glclnd ,only : clm_s2x, clm_x2s + use clm_driver ,only : clm_drv + use clm_varorb ,only : eccen, obliqr, lambm0, mvelpp + use clm_time_manager,only : get_curr_date, get_nstep, get_curr_calday, get_step_size, & + advance_timestep, set_nextsw_cday,update_rad_dtime + use shr_file_mod ,only : shr_file_setLogUnit, shr_file_setLogLevel, & + shr_file_getLogUnit, shr_file_getLogLevel + use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn, & + seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use spmdMod ,only : masterproc, mpicom + use perf_mod ,only : t_startf, t_stopf, t_barrierf + use shr_orb_mod ,only : shr_orb_decl + use clm_varorb ,only : eccen, mvelpp, lambm0, obliqr + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + ! + ! !LOCAL VARIABLES: + type(ESMF_Array) :: l2x, x2l, dom + real(R8), pointer :: fptr(:, :) + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CLM current date (YYYYMMDD) + integer :: yr ! CLM current year + integer :: mon ! CLM current month + integer :: day ! CLM current day + integer :: tod ! CLM current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + 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 ! clm calday plus dtime offset + 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 + integer :: shrlogunit,shrloglev ! old values + integer :: lbnum ! input to memory diagnostic + integer :: g,i,ka ! counters + real(r8):: recip ! recip + logical :: glcrun_alarm ! if true, sno data is averaged and sent to glc this step + type(bounds_type) :: bounds ! bounds + logical,save :: first_call = .true. ! first call work + character(len=32) :: rdate ! date char string for restart file names + character(len=32), parameter :: sub = "lnd_run_esmf" + !--------------------------------------------------------------------------- + + call get_proc_bounds(bounds) + + call t_startf ('lc_lnd_run1') + rc = ESMF_SUCCESS + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_esmf:start::',lbnum) + endif +#endif + + ! Reset shr logging to my log file + + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Determine time of next atmospheric shortwave calculation + + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=ymd, curr_tod=tod_sync, & + curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) + call ESMF_AttributeGet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call set_nextsw_cday( nextsw_cday ) + dtime = get_step_size() + + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync + nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) + rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) + + call t_stopf ('lc_lnd_run1') + + ! Map ESMF to CLM data type + + call t_startf ('lc_lnd_import') + + call ESMF_StateGet(import_state, itemName="x2d", array=x2l, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(x2l, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_import( bounds, fptr, clm_a2l, a2l_not_downscaled_gcell, clm_x2s ) + + call t_stopf ('lc_lnd_import') + + ! Use infodata to set orbital values if it was updated at run time + + call ESMF_AttributeGet(export_state, name="orb_eccen", value=eccen, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_mvelpp", value=mvelpp, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_lambm0", value=lambm0, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_AttributeGet(export_state, name="orb_obliqr", value=obliqr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Loop over time steps in coupling interval + + call t_startf ('lc_lnd_run2') + + dosend = .false. + do while(.not. dosend) + + ! 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 + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine doalb based on nextsw_cday sent from atm model + + nstep = get_nstep() + caldayp1 = get_curr_calday(offset=dtime) + doalb = abs(nextsw_cday- caldayp1) < 1.e-10_r8 + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run clm + + call t_barrierf('sync_clm_run', mpicom) + call t_startf ('clm_run') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) + call t_stopf ('clm_run') + + ! Map CLM data type to MCT + ! Reset landfrac on atmosphere grid to have the right domain + + call t_startf ('lc_lnd_export') + call ESMF_StateGet(export_state, itemName="d2x", array=l2x, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call ESMF_ArrayGet(l2x, localDe=0, farrayPtr=fptr, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call lnd_export( bounds, clm_l2a, clm_s2x, fptr ) + call t_stopf ('lc_lnd_export') + + ! Advance clm time step + + call t_startf ('lc_clm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_clm2_adv_timestep') + + end do + + call t_stopf ('lc_lnd_run2') + call t_startf('lc_lnd_run3') + + ! Check that internal clock is in sync with master clock + + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) + end if + + ! Reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_esmf:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + call t_stopf ('lc_lnd_run3') + + end subroutine lnd_run_esmf + + !--------------------------------------------------------------------------- + + subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) + ! + ! !DESCRIPTION: + ! Finalize land surface model + ! + ! !ARGUMENTS: + 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) :: EClock ! ESMF synchronization clock + integer, intent(out) :: rc ! Return code + !--------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Destroy ESMF objects + call esmfshr_util_StateArrayDestroy(export_state,'domain',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(export_state,'d2x',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + call esmfshr_util_StateArrayDestroy(import_state,'x2d',rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + end subroutine lnd_final_esmf + + !--------------------------------------------------------------------------- + function lnd_DistGrid_esmf(bounds, gsize) + ! + ! !DESCRIPTION: + ! Setup distributed grid for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(out) :: gsize ! grid size + ! + ! RETURN: + type(ESMF_DistGrid) :: lnd_DistGrid_esmf ! Resulting distributed grid + ! + ! !LOCAL VARIABLES: + integer,allocatable :: gindex(:) ! grid indices + integer :: n ! indices + integer :: rc ! error code + !--------------------------------------------------------------------------- + + ! number the local grid + + allocate(gindex(bounds%begg:bounds%endg)) + do n = bounds%begg, bounds%endg + gindex(n) = ldecomp%gdc2glo(n) + end do + gsize = ldomain%ni * ldomain%nj + + lnd_distgrid_esmf = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) + if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + deallocate(gindex) + + end function lnd_DistGrid_esmf + + !--------------------------------------------------------------------------- + subroutine lnd_domain_esmf( bounds, dom) + ! + ! !DESCRIPTION: + ! Send the land model domain information to the coupler + ! + ! !USES: + use clm_varcon , only : re + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + type(ESMF_Array) , intent(inout) :: dom ! CLM domain data + ! + ! !LOCAL VARIABLES: + integer :: g,i ! index + integer :: klon,klat,karea,kmask,kfrac ! domain fields + real(R8), pointer :: fptr (:,:) + integer :: rc ! return code + !--------------------------------------------------------------------------- + + ! Initialize domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + + call ESMF_ArrayGet(dom, localDe=0, farrayPtr=fptr, rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + klon = esmfshr_util_ArrayGetIndex(dom,'lon ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + klat = esmfshr_util_ArrayGetIndex(dom,'lat ',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + karea = esmfshr_util_ArrayGetIndex(dom,'area',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kmask = esmfshr_util_ArrayGetIndex(dom,'mask',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + kfrac = esmfshr_util_ArrayGetIndex(dom,'frac',rc=rc) + if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) + + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + + fptr(:,:) = -9999.0_R8 + fptr(kmask,:) = -0.0_R8 + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + fptr(klon, i) = ldomain%lonc(g) + fptr(klat, i) = ldomain%latc(g) + fptr(karea, i) = ldomain%area(g)/(re*re) + fptr(kmask, i) = real(ldomain%mask(g), r8) + fptr(kfrac, i) = real(ldomain%frac(g), r8) + end do + + end subroutine lnd_domain_esmf + !--------------------------------------------------------------------------- + +#endif + +end module lnd_comp_esmf diff --git a/components/clm/src_clm40/main/lnd_comp_mct.F90 b/components/clm/src_clm40/main/lnd_comp_mct.F90 new file mode 100644 index 0000000000..c4a7b71705 --- /dev/null +++ b/components/clm/src_clm40/main/lnd_comp_mct.F90 @@ -0,0 +1,649 @@ +module lnd_comp_mct + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Interface of the active land model component of CESM the CLM (Community Land Model) + ! with the main CESM driver. This is a thin interface taking CESM driver information + ! in MCT (Model Coupling Toolkit) format and converting it to use by CLM. + ! + ! !uses: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mct_mod , only : mct_avect, mct_gsmap + use decompmod , only : bounds_type, ldecomp + use lnd_import_export + ! + ! !public member functions: + implicit none + save + private ! by default make data private + ! + ! !public member functions: + public :: lnd_init_mct ! clm initialization + public :: lnd_run_mct ! clm run phase + public :: lnd_final_mct ! clm finalization/cleanup + ! + ! !private member functions: + private :: lnd_setgsmap_mct ! set the land model mct gs map + private :: lnd_domain_mct ! set the land model domain information + !--------------------------------------------------------------------------- + +contains + + !==================================================================================== + + subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) + ! + ! !DESCRIPTION: + ! Initialize land surface model and obtain relevant atmospheric model arrays + ! back from (i.e. albedos, surface temperature and snow cover over land). + ! + ! !USES: + use abortutils , only : endrun + use clm_time_manager , only : get_nstep, get_step_size, set_timemgr_init, & + set_nextsw_cday + use clm_atmlnd , only : clm_l2a + use clm_glclnd , only : clm_s2x + use clm_initializeMod, only : initialize1, initialize2 + use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland, & + inst_index, inst_suffix, inst_name + use clm_varorb , only : eccen, obliqr, lambm0, mvelpp + use controlMod , only : control_setNL + use decompMod , only : get_proc_bounds + use domainMod , only : ldomain + use shr_file_mod , only : shr_file_setLogUnit, shr_file_setLogLevel, & + shr_file_getLogUnit, shr_file_getLogLevel, & + shr_file_getUnit, shr_file_setIO + use seq_cdata_mod , only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod , only : seq_timemgr_EClockGetData + use seq_infodata_mod , only : seq_infodata_type, seq_infodata_GetData, seq_infodata_PutData, & + seq_infodata_start_type_start, seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch + use seq_comm_mct , only : seq_comm_suffix, seq_comm_inst, seq_comm_name + use seq_flds_mod , only : seq_flds_x2l_fields, seq_flds_l2x_fields + use spmdMod , only : masterproc, spmd_init + use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch + use clm_cpl_indices , only : clm_cpl_indices_set + use mct_mod + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock), intent(inout) :: EClock ! Input synchronization clock + type(seq_cdata), intent(inout) :: cdata_l ! Input land-model driver data + type(mct_aVect), intent(inout) :: x2l_l, l2x_l ! land model import and export states + character(len=*), optional, intent(in) :: NLFilename ! Namelist filename to read + ! + ! !LOCAL VARIABLES: + integer :: LNDID ! Land identifyer + integer :: mpicom_lnd ! MPI communicator + type(mct_gsMap), pointer :: GSMap_lnd ! Land model MCT GS map + type(mct_gGrid), pointer :: dom_l ! Land model domain + type(seq_infodata_type), pointer :: infodata ! CESM driver level info data + 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 + real(r8) :: scmlon ! single-column longitude + real(r8) :: nextsw_cday ! calday from clock of next radiation computation + character(len=SHR_KIND_CL) :: caseid ! case identifier name + character(len=SHR_KIND_CL) :: ctitle ! case description title + character(len=SHR_KIND_CL) :: starttype ! start-type (startup, continue, branch, hybrid) + character(len=SHR_KIND_CL) :: calendar ! calendar type name + character(len=SHR_KIND_CL) :: hostname ! hostname of machine running on + character(len=SHR_KIND_CL) :: version ! Model version + character(len=SHR_KIND_CL) :: username ! user running the model + integer :: nsrest ! clm restart type + 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) + 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 + type(bounds_type) :: bounds ! bounds + character(len=32), parameter :: sub = 'lnd_init_mct' + character(len=*), parameter :: format = "('("//trim(sub)//") :',A)" + !----------------------------------------------------------------------- + + ! Set cdata data + + call seq_cdata_setptrs(cdata_l, ID=LNDID, mpicom=mpicom_lnd, & + gsMap=GSMap_lnd, dom=dom_l, infodata=infodata) + + ! Determine attriute vector indices + + call clm_cpl_indices_set() + + ! Initialize clm MPI communicator + + call spmd_init( mpicom_lnd, LNDID ) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_init_mct:start::',lbnum) + endif +#endif + + inst_name = seq_comm_name(LNDID) + inst_index = seq_comm_inst(LNDID) + inst_suffix = seq_comm_suffix(LNDID) + + ! Initialize io log unit + + call shr_file_getLogUnit (shrlogunit) + if (masterproc) then + inquire(file='lnd_modelio.nml'//trim(inst_suffix),exist=exists) + if (exists) then + iulog = shr_file_getUnit() + call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),iulog) + end if + write(iulog,format) "CLM land model initialization" + else + iulog = shrlogunit + end if + + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Use infodata to set orbital values + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Consistency check on namelist filename + + call control_setNL("lnd_in"//trim(inst_suffix)) + + ! Initialize clm + ! initialize1 reads namelist, grid and surface data (need this to initialize gsmap) + ! initialize2 performs rest of initialization + + 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 ) + 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 ) + 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) + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + nsrest = nsrContinue + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + nsrest = nsrBranch + else + call endrun( sub//' ERROR: unknown starttype' ) + end if + + call clm_varctl_set(caseid_in=caseid, ctitle_in=ctitle, & + brnch_retain_casename_in=brnch_retain_casename, & + single_column_in=single_column, scmlat_in=scmlat, & + scmlon_in=scmlon, nsrest_in=nsrest, version_in=version, & + hostname_in=hostname, username_in=username) + + ! Read namelist, grid and surface data + + call initialize1( ) + + ! If no land then exit out of initialization + + if ( noland ) then + call seq_infodata_PutData( infodata, lnd_present =.false.) + call seq_infodata_PutData( infodata, lnd_prognostic=.false.) + return + end if + + ! Determine if aerosol and dust deposition come from atmosphere component + + call seq_infodata_GetData(infodata, atm_aero=atm_aero ) + if ( .not. atm_aero )then + call endrun( sub//' ERROR: atmosphere model MUST send aerosols to CLM' ) + end if + + ! Initialize clm gsMap, clm domain and clm attribute vectors + + call get_proc_bounds( bounds ) + + call lnd_SetgsMap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + lsize = mct_gsMap_lsize(gsMap_lnd, mpicom_lnd) + + call lnd_domain_mct( bounds, lsize, gsMap_lnd, dom_l ) + + call mct_aVect_init(x2l_l, rList=seq_flds_x2l_fields, lsize=lsize) + call mct_aVect_zero(x2l_l) + + call mct_aVect_init(l2x_l, rList=seq_flds_l2x_fields, lsize=lsize) + call mct_aVect_zero(l2x_l) + + ! Finish initializing clm + + 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, clm_l2a, clm_s2x, l2x_l%rattr) + + ! Fill in infodata settings + + call seq_infodata_PutData(infodata, lnd_prognostic=.true.) + call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) + + ! Get infodata info + + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + call set_nextsw_cday(nextsw_cday) + + ! Reset shr logging to original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + write(iulog,*) TRIM(Sub) // ':end::' + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_int_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + end subroutine lnd_init_mct + + !==================================================================================== + + subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Run clm model + ! + ! !USES: + use shr_kind_mod ,only : r8 => shr_kind_r8 + use clmtype + use clm_atmlnd ,only : clm_l2a, clm_a2l, a2l_not_downscaled_gcell + use clm_glclnd ,only : clm_s2x, clm_x2s + use clm_driver ,only : clm_drv + use clm_time_manager,only : get_curr_date, get_nstep, get_curr_calday, get_step_size, & + advance_timestep, set_nextsw_cday,update_rad_dtime + use decompMod ,only : get_proc_bounds + use abortutils ,only : endrun + use clm_varctl ,only : iulog + use clm_varorb ,only : eccen, obliqr, lambm0, mvelpp + use shr_file_mod ,only : shr_file_setLogUnit, shr_file_setLogLevel, & + shr_file_getLogUnit, shr_file_getLogLevel + use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn, & + seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use seq_infodata_mod,only : seq_infodata_type, seq_infodata_GetData + use spmdMod ,only : masterproc, mpicom + use perf_mod ,only : t_startf, t_stopf, t_barrierf + use shr_orb_mod ,only : shr_orb_decl + use mct_mod + use ESMF + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + ! + ! !LOCAL VARIABLES: + integer :: ymd_sync ! Sync date (YYYYMMDD) + integer :: yr_sync ! Sync current year + integer :: mon_sync ! Sync current month + integer :: day_sync ! Sync current day + integer :: tod_sync ! Sync current time of day (sec) + integer :: ymd ! CLM current date (YYYYMMDD) + integer :: yr ! CLM current year + integer :: mon ! CLM current month + integer :: day ! CLM current day + integer :: tod ! CLM current time of day (sec) + integer :: dtime ! time step increment (sec) + integer :: nstep ! time step index + logical :: rstwr_sync ! .true. ==> write restart file before returning + logical :: rstwr ! .true. ==> write restart file before returning + logical :: nlend_sync ! Flag signaling last time-step + 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 ! clm calday plus dtime offset + integer :: shrlogunit,shrloglev ! old values for share log unit and log level + integer :: lbnum ! input to memory diagnostic + integer :: g,i,lsize ! counters + real(r8) :: calday ! calendar day for nstep + real(r8) :: declin ! solar declination angle in radians for nstep + real(r8) :: declinp1 ! solar declination angle in radians for nstep+1 + real(r8) :: eccf ! earth orbit eccentricity factor + real(r8) :: recip ! reciprical + logical,save :: first_call = .true. ! first call work + type(seq_infodata_type),pointer :: infodata ! CESM information from the driver + type(mct_gGrid), pointer :: dom_l ! Land model domain data + type(bounds_type) :: bounds ! bounds + character(len=32) :: rdate ! date char string for restart file names + character(len=32), parameter :: sub = "lnd_run_mct" + !--------------------------------------------------------------------------- + + ! Determine processor bounds + + call get_proc_bounds(bounds) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:start::',lbnum) + endif +#endif + + ! Reset shr logging to my log file + call shr_file_getLogUnit (shrlogunit) + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogUnit (iulog) + + ! Determine time of next atmospheric shortwave calculation + call seq_cdata_setptrs(cdata_l, infodata=infodata, dom=dom_l) + call seq_timemgr_EClockGetData(EClock, & + curr_ymd=ymd, curr_tod=tod_sync, & + curr_yr=yr_sync, curr_mon=mon_sync, curr_day=day_sync) + call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) + + call set_nextsw_cday( nextsw_cday ) + dtime = get_step_size() + + write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync,mon_sync,day_sync,tod_sync + nlend_sync = seq_timemgr_StopAlarmIsOn( EClock ) + rstwr_sync = seq_timemgr_RestartAlarmIsOn( EClock ) + + ! Map MCT to land data type + ! Perform downscaling if appropriate + + + ! Map to clm (only when state and/or fluxes need to be updated) + + call t_startf ('lc_lnd_import') + call lnd_import( bounds, x2l_l%rattr, clm_a2l, a2l_not_downscaled_gcell, clm_x2s) + call t_stopf ('lc_lnd_import') + + ! Use infodata to set orbital values if updated mid-run + + call seq_infodata_GetData( infodata, orb_eccen=eccen, orb_mvelpp=mvelpp, & + orb_lambm0=lambm0, orb_obliqr=obliqr ) + + ! Loop over time steps in coupling interval + + dosend = .false. + do while(.not. dosend) + + ! 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 + + call get_curr_date( yr, mon, day, tod ) + ymd = yr*10000 + mon*100 + day + tod = tod + dosend = (seq_timemgr_EClockDateInSync( EClock, ymd, tod)) + + ! Determine doalb based on nextsw_cday sent from atm model + + nstep = get_nstep() + caldayp1 = get_curr_calday(offset=dtime) + if (nstep == 0) then + doalb = .false. + else if (nstep == 1) then + doalb = (abs(nextsw_cday- caldayp1) < 1.e-10_r8) + else + doalb = (nextsw_cday >= -0.5_r8) + end if + call update_rad_dtime(doalb) + + ! Determine if time to write cam restart and stop + + rstwr = .false. + if (rstwr_sync .and. dosend) rstwr = .true. + nlend = .false. + if (nlend_sync .and. dosend) nlend = .true. + + ! Run clm + + call t_barrierf('sync_clm_run1', mpicom) + call t_startf ('clm_run') + call t_startf ('shr_orb_decl') + calday = get_curr_calday() + call shr_orb_decl( calday , eccen, mvelpp, lambm0, obliqr, declin , eccf ) + call shr_orb_decl( nextsw_cday, eccen, mvelpp, lambm0, obliqr, declinp1, eccf ) + call t_stopf ('shr_orb_decl') + call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) + call t_stopf ('clm_run') + + ! Create l2x_l export state - add river runoff input to l2x_l if appropriate + + call t_startf ('lc_lnd_export') + call lnd_export(bounds, clm_l2a, clm_s2x, l2x_l%rattr) + call t_stopf ('lc_lnd_export') + + ! Advance clm time step + + call t_startf ('lc_clm2_adv_timestep') + call advance_timestep() + call t_stopf ('lc_clm2_adv_timestep') + + end do + + ! Check that internal clock is in sync with master clock + + call get_curr_date( yr, mon, day, tod, offset=-dtime ) + ymd = yr*10000 + mon*100 + day + tod = tod + if ( .not. seq_timemgr_EClockDateInSync( EClock, ymd, tod ) )then + call seq_timemgr_EclockGetData( EClock, curr_ymd=ymd_sync, curr_tod=tod_sync ) + write(iulog,*)' clm ymd=',ymd ,' clm tod= ',tod + write(iulog,*)'sync ymd=',ymd_sync,' sync tod= ',tod_sync + call endrun( sub//":: CLM clock not in sync with Master Sync clock" ) + end if + + ! Reset shr logging to my original values + + call shr_file_setLogUnit (shrlogunit) + call shr_file_setLogLevel(shrloglev) + +#if (defined _MEMTRACE) + if(masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_run_mct:end::',lbnum) + call memmon_reset_addr() + endif +#endif + + first_call = .false. + + end subroutine lnd_run_mct + + !==================================================================================== + + subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) + ! + ! !DESCRIPTION: + ! Finalize land surface model + + use seq_cdata_mod ,only : seq_cdata, seq_cdata_setptrs + use seq_timemgr_mod ,only : seq_timemgr_EClockGetData, seq_timemgr_StopAlarmIsOn, & + seq_timemgr_RestartAlarmIsOn, seq_timemgr_EClockDateInSync + use mct_mod + use esmf + ! + ! !ARGUMENTS: + type(ESMF_Clock) , intent(inout) :: EClock ! Input synchronization clock from driver + type(seq_cdata) , intent(inout) :: cdata_l ! Input driver data for land model + type(mct_aVect) , intent(inout) :: x2l_l ! Import state to land model + type(mct_aVect) , intent(inout) :: l2x_l ! Export state from land model + !--------------------------------------------------------------------------- + + ! fill this in + end subroutine lnd_final_mct + + !==================================================================================== + + subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) + ! + ! !DESCRIPTION: + ! Set the MCT GS map for the land model + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use domainMod , only : ldomain + use mct_mod , only : mct_gsMap, mct_gsMap_init + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: mpicom_lnd ! MPI communicator for the clm land model + integer , intent(in) :: LNDID ! Land model identifyer number + type(mct_gsMap) , intent(out) :: gsMap_lnd ! Resulting MCT GS map for the land model + ! + ! !LOCAL VARIABLES: + integer,allocatable :: gindex(:) ! Number the local grid points + integer :: i, j, n, gi ! Indices + integer :: lsize,gsize ! GS Map size + integer :: ier ! Error code + !--------------------------------------------------------------------------- + + ! Build the land grid numbering for MCT + ! NOTE: Numbering scheme is: West to East and South to North + ! starting at south pole. Should be the same as what's used in SCRIP + + allocate(gindex(bounds%begg:bounds%endg),stat=ier) + + ! number the local grid + + do n = bounds%begg, bounds%endg + gindex(n) = ldecomp%gdc2glo(n) + end do + lsize = bounds%endg - bounds%begg + 1 + gsize = ldomain%ni * ldomain%nj + + call mct_gsMap_init( gsMap_lnd, gindex, mpicom_lnd, LNDID, lsize, gsize ) + + deallocate(gindex) + + end subroutine lnd_SetgsMap_mct + + !==================================================================================== + + subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) + ! + ! !DESCRIPTION: + ! Send the land model domain information to the coupler + ! + ! !USES: + use clm_varcon , only: re + use domainMod , only: ldomain + use spmdMod , only: iam + use mct_mod , only: mct_gsMap, mct_gGrid, mct_gGrid_importIAttr + use mct_mod , only: mct_gGrid_importRAttr, mct_gGrid_init, mct_gsMap_orderedPoints + use seq_flds_mod, only: seq_flds_dom_coord, seq_flds_dom_other + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: lsize ! land model domain data size + type(mct_gsMap), intent(inout) :: gsMap_l ! Output land model MCT GS map + type(mct_ggrid), intent(out) :: dom_l ! Output domain information for land model + ! + ! Local Variables + integer :: g,i,j ! index + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + !--------------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + ! + call mct_gGrid_init( GGrid=dom_l, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsMap_l, iam, idata) + call mct_gGrid_importIAttr(dom_l,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_l,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_l,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_l,"mask" ,data,lsize) + ! + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + ! + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%lonc(g) + end do + call mct_gGrid_importRattr(dom_l,"lon",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%latc(g) + end do + call mct_gGrid_importRattr(dom_l,"lat",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = ldomain%area(g)/(re*re) + end do + call mct_gGrid_importRattr(dom_l,"area",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%mask(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"mask",data,lsize) + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + data(i) = real(ldomain%frac(g), r8) + end do + call mct_gGrid_importRattr(dom_l,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine lnd_domain_mct + +end module lnd_comp_mct diff --git a/components/clm/src_clm40/main/lnd_import_export.F90 b/components/clm/src_clm40/main/lnd_import_export.F90 new file mode 100644 index 0000000000..9a2fbf176c --- /dev/null +++ b/components/clm/src_clm40/main/lnd_import_export.F90 @@ -0,0 +1,330 @@ +module lnd_import_export + + use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl + use abortutils , only: endrun + use clm_atmlnd , only: lnd2atm_type + use clm_glclnd , only: lnd2glc_type + use decompmod , only: bounds_type + use clm_cpl_indices + use clmtype + implicit none + +contains + + !=============================================================================== + + subroutine lnd_import( bounds, x2l, a2l, a2l_not_downscaled_gcell, x2s) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the input data from the coupler to the land model + ! + ! !USES: + use clm_atmlnd , only: atm2lnd_type, atm2lnd_downscaled_fields_type + use clm_glclnd , only: glc2lnd_type + use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use domainMod , only: ldomain + implicit none + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model + type(atm2lnd_type) , intent(inout) :: a2l ! clm internal input data type + type(atm2lnd_downscaled_fields_type) , intent(inout) :: a2l_not_downscaled_gcell ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: x2s ! clm internal input data type + ! + ! !LOCAL VARIABLES: + integer :: g,i,nstep,ier ! indices, number of steps, and error code + real(r8) :: forc_rainc ! rainxy Atm flux mm/s + real(r8) :: e ! vapor pressure (Pa) + real(r8) :: qsat ! saturation specific humidity (kg/kg) + 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_rainl ! rainxy Atm flux mm/s + real(r8) :: forc_snowc ! snowfxy Atm flux mm/s + real(r8) :: forc_snowl ! snowfxl Atm flux mm/s + real(r8) :: co2_ppmv_diag ! temporary + real(r8) :: co2_ppmv_prog ! temporary + real(r8) :: co2_ppmv_val ! temporary + integer :: co2_type_idx ! integer flag for co2_type options + real(r8) :: esatw ! saturation vapor pressure over water (Pa) + real(r8) :: esati ! saturation vapor pressure over ice (Pa) + real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water + 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 + integer :: num ! counter + character(len=32), parameter :: sub = 'lnd_import_mct' + + ! 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)))))) + !--------------------------------------------------------------------------- + + co2_type_idx = 0 + if (co2_type == 'prognostic') then + co2_type_idx = 1 + else if (co2_type == 'diagnostic') then + co2_type_idx = 2 + end if + if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) + else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then + call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) + end if + + ! Note that the precipitation fluxes received from the coupler + ! are in units of kg/s/m^2. To convert these precipitation rates + ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply + ! by 1000 mm/m resulting in an overall factor of unity. + ! Below the units are therefore given in mm/s. + + + do g = bounds%begg,bounds%endg + i = 1 + (g - bounds%begg) + + ! Determine flooding input, sign convention is positive downward and + ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, + ! change the sign to indicate addition of water to system. + + a2l%forc_flood(g) = -x2l(index_x2l_Flrr_flood,i) + + a2l%volr(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8) + + ! Determine required receive fields + + a2l%forc_hgt(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m + a2l%forc_u(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s + a2l%forc_v(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s + a2l%forc_solad(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2 + a2l%forc_solad(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2 + a2l%forc_solai(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2 + a2l%forc_solai(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2 + + a2l_not_downscaled_gcell%forc_th(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K + a2l_not_downscaled_gcell%forc_q(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg + a2l_not_downscaled_gcell%forc_pbot(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa + a2l_not_downscaled_gcell%forc_t(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K + a2l_not_downscaled_gcell%forc_lwrad(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2 + + forc_rainc = x2l(index_x2l_Faxa_rainc,i) ! mm/s + forc_rainl = x2l(index_x2l_Faxa_rainl,i) ! mm/s + forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s + forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s + + ! atmosphere coupling, for prognostic/prescribed aerosols + a2l%forc_aer(g,1) = x2l(index_x2l_Faxa_bcphidry,i) + a2l%forc_aer(g,2) = x2l(index_x2l_Faxa_bcphodry,i) + a2l%forc_aer(g,3) = x2l(index_x2l_Faxa_bcphiwet,i) + a2l%forc_aer(g,4) = x2l(index_x2l_Faxa_ocphidry,i) + a2l%forc_aer(g,5) = x2l(index_x2l_Faxa_ocphodry,i) + a2l%forc_aer(g,6) = x2l(index_x2l_Faxa_ocphiwet,i) + a2l%forc_aer(g,7) = x2l(index_x2l_Faxa_dstwet1,i) + a2l%forc_aer(g,8) = x2l(index_x2l_Faxa_dstdry1,i) + a2l%forc_aer(g,9) = x2l(index_x2l_Faxa_dstwet2,i) + a2l%forc_aer(g,10) = x2l(index_x2l_Faxa_dstdry2,i) + a2l%forc_aer(g,11) = x2l(index_x2l_Faxa_dstwet3,i) + a2l%forc_aer(g,12) = x2l(index_x2l_Faxa_dstdry3,i) + a2l%forc_aer(g,13) = x2l(index_x2l_Faxa_dstwet4,i) + a2l%forc_aer(g,14) = x2l(index_x2l_Faxa_dstdry4,i) + + ! Determine optional receive fields + + if (index_x2l_Sa_co2prog /= 0) then + co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic + else + co2_ppmv_prog = co2_ppmv + end if + + if (index_x2l_Sa_co2diag /= 0) then + co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic + else + co2_ppmv_diag = co2_ppmv + end if + + if (index_x2l_Sa_methane /= 0) then + a2l%forc_pch4(g) = x2l(index_x2l_Sa_methane,i) + endif + + ! Determine derived quantities for required fields + + forc_t = a2l_not_downscaled_gcell%forc_t(g) + forc_q = a2l_not_downscaled_gcell%forc_q(g) + forc_pbot = a2l_not_downscaled_gcell%forc_pbot(g) + + a2l%forc_hgt_u(g) = a2l%forc_hgt(g) !observational height of wind [m] + a2l%forc_hgt_t(g) = a2l%forc_hgt(g) !observational height of temperature [m] + a2l%forc_hgt_q(g) = a2l%forc_hgt(g) !observational height of humidity [m] + a2l%forc_vp(g) = forc_q * forc_pbot & + / (0.622_r8 + 0.378_r8 * forc_q) + a2l_not_downscaled_gcell%forc_rho(g) = (forc_pbot - 0.378_r8 * a2l%forc_vp(g)) & + / (rair * forc_t) + a2l%forc_po2(g) = o2_molar_const * forc_pbot + a2l%forc_wind(g) = sqrt(a2l%forc_u(g)**2 + a2l%forc_v(g)**2) + a2l%forc_solar(g) = a2l%forc_solad(g,1) + a2l%forc_solai(g,1) + & + a2l%forc_solad(g,2) + a2l%forc_solai(g,2) + + a2l_not_downscaled_gcell%forc_rain(g) = forc_rainc + forc_rainl + a2l_not_downscaled_gcell%forc_snow(g) = forc_snowc + forc_snowl + + 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) + a2l%forc_rh(g) = 100.0_r8*(forc_q / qsat) + ! Make sure relative humidity is properly bounded + ! a2l%forc_rh(g) = min( 100.0_r8, a2l%forc_rh(g) ) + ! a2l%forc_rh(g) = max( 0.0_r8, a2l%forc_rh(g) ) + + ! Determine derived quantities for optional fields + ! Note that the following does unit conversions from ppmv to partial pressures (Pa) + ! Note that forc_pbot is in Pa + + if (co2_type_idx == 1) then + co2_ppmv_val = co2_ppmv_prog + else if (co2_type_idx == 2) then + co2_ppmv_val = co2_ppmv_diag + else + co2_ppmv_val = co2_ppmv + end if + a2l%forc_pco2(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot + if (use_c13) then + a2l%forc_pc13o2(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot + end if + + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + x2s%frac(g,num) = x2l(index_x2l_Sg_ice_covered(num),i) + x2s%topo(g,num) = x2l(index_x2l_Sg_topo(num),i) + x2s%hflx(g,num) = x2l(index_x2l_Flgg_hflx(num),i) + end do + x2s%icemask(g) = x2l(index_x2l_Sg_icemask,i) + end if + + end do + + end subroutine lnd_import + + !=============================================================================== + + subroutine lnd_export( bounds, clm_l2a, clm_s2x, l2x) + + !--------------------------------------------------------------------------- + ! !DESCRIPTION: + ! Convert the data to be sent from the clm model to the coupler + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog, create_glacier_mec_landunit + use clm_time_manager , only : get_nstep, get_step_size + use seq_drydep_mod , only : n_drydep + use shr_megan_mod , only : shr_megan_mechcomps_n + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + type(lnd2atm_type), intent(inout) :: clm_l2a ! clm land to atmosphere exchange data type + type(lnd2glc_type), intent(inout) :: clm_s2x ! clm land to atmosphere exchange data type + real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid + ! + ! !LOCAL VARIABLES: + integer :: g,i ! indices + integer :: ier ! error status + integer :: nstep ! time step index + integer :: dtime ! time step + integer :: num ! counter + !--------------------------------------------------------------------------- + + ! cesm sign convention is that fluxes are positive downward + + l2x(:,:) = 0.0_r8 + + do g = bounds%begg,bounds%endg + i = 1 + (g-bounds%begg) + l2x(index_l2x_Sl_t,i) = clm_l2a%t_rad(g) + l2x(index_l2x_Sl_snowh,i) = clm_l2a%h2osno(g) + l2x(index_l2x_Sl_avsdr,i) = clm_l2a%albd(g,1) + l2x(index_l2x_Sl_anidr,i) = clm_l2a%albd(g,2) + l2x(index_l2x_Sl_avsdf,i) = clm_l2a%albi(g,1) + l2x(index_l2x_Sl_anidf,i) = clm_l2a%albi(g,2) + l2x(index_l2x_Sl_tref,i) = clm_l2a%t_ref2m(g) + l2x(index_l2x_Sl_qref,i) = clm_l2a%q_ref2m(g) + l2x(index_l2x_Sl_u10,i) = clm_l2a%u_ref10m(g) + l2x(index_l2x_Fall_taux,i) = -clm_l2a%taux(g) + l2x(index_l2x_Fall_tauy,i) = -clm_l2a%tauy(g) + l2x(index_l2x_Fall_lat,i) = -clm_l2a%eflx_lh_tot(g) + l2x(index_l2x_Fall_sen,i) = -clm_l2a%eflx_sh_tot(g) + l2x(index_l2x_Fall_lwup,i) = -clm_l2a%eflx_lwrad_out(g) + l2x(index_l2x_Fall_evap,i) = -clm_l2a%qflx_evap_tot(g) + l2x(index_l2x_Fall_swnet,i) = clm_l2a%fsa(g) + if (index_l2x_Fall_fco2_lnd /= 0) then + l2x(index_l2x_Fall_fco2_lnd,i) = -clm_l2a%nee(g) + end if + + ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC + ! These are now standard fields, but the check on the index makes sure the driver handles them + if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = clm_l2a%ram1(g) + if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = clm_l2a%fv(g) + if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = clm_l2a%h2osoi_vol(g,1) + if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -clm_l2a%flxdst(g,1) + if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -clm_l2a%flxdst(g,2) + if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -clm_l2a%flxdst(g,3) + if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -clm_l2a%flxdst(g,4) + + + ! for dry dep velocities + if (index_l2x_Sl_ddvel /= 0 ) then + l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = & + clm_l2a%ddvel(g,:n_drydep) + end if + + ! for MEGAN VOC emis fluxes + if (index_l2x_Fall_flxvoc /= 0 ) then + l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = & + -clm_l2a%flxvoc(g,:shr_megan_mechcomps_n) + end if + + if (index_l2x_Fall_methane /= 0) then + l2x(index_l2x_Fall_methane,i) = -clm_l2a%flux_ch4(g) + endif + + ! sign convention is positive downward with + ! hierarchy of atm/glc/lnd/rof/ice/ocn. so water sent from land to rof is positive + + l2x(index_l2x_Flrl_rofl,i) = clm_l2a%rofliq(g) + l2x(index_l2x_Flrl_rofi,i) = clm_l2a%rofice(g) + + ! glc coupling + + if (create_glacier_mec_landunit) then + do num = 0,glc_nec + l2x(index_l2x_Sl_tsrf(num),i) = clm_s2x%tsrf(g,num) + l2x(index_l2x_Sl_topo(num),i) = clm_s2x%topo(g,num) + l2x(index_l2x_Flgl_qice(num),i) = clm_s2x%qice(g,num) + end do + end if + + end do + + end subroutine lnd_export + +end module lnd_import_export diff --git a/components/clm/src_clm40/main/mkarbinitMod.F90 b/components/clm/src_clm40/main/mkarbinitMod.F90 new file mode 100644 index 0000000000..6df966a2b9 --- /dev/null +++ b/components/clm/src_clm40/main/mkarbinitMod.F90 @@ -0,0 +1,762 @@ +module mkarbinitMod +!--------------------------------------------------------------------------- +!BOP +! +! !MODULE: mkarbinitMod +! +! !DESCRIPTION: +! +! +!--------------------------------------------------------------------------- + +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog, use_cn, use_cndv, & + use_vancouver, use_mexicocity + use shr_sys_mod , only : shr_sys_flush + use spmdMod , only : masterproc + + implicit none + + SAVE + private ! By default make data private + +! !PUBLIC MEMBER FUNCTIONS: + + public mkarbinit ! Make arbitrary initial conditions + +!EOP +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkarbinit +! +! !INTERFACE: + subroutine mkarbinit() +! +! !DESCRIPTION: +! Initializes the following time varying variables: +! water : h2osno, h2ocan, h2osoi_liq, h2osoi_ice, h2osoi_vol +! snow : snowdp, snl, dz, z, zi +! temperature: t_soisno, t_veg, t_grnd +! +! !USES: + use shr_const_mod, only : SHR_CONST_TKFRZ + use clmtype + use clm_varpar , only : nlevsoi, nlevgrnd, nlevsno, nlevlak, nlevurb + use clm_varcon , only : bdsno, istice, istwet, istsoil, isturb, & + denice, denh2o, spval, sb, icol_road_perv, & + icol_road_imperv, icol_roof, icol_sunwall, & + icol_shadewall + use clm_varcon , only : istcrop + use clm_varcon , only : istice_mec, h2osno_max + use clm_varctl , only : iulog + use spmdMod , only : masterproc + use decompMod , only : get_proc_bounds + use SNICARMod , only : snw_rds_min + +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! 3/07/08 Keith Oleson: initialize h2osoi_vol for all soil layers to 0.3 +! 3/18/08 David Lawrence, initialize deep layers +! 03/28/08 Mark Flanner, initialize snow aerosols and grain size +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: pcolumn(:) ! column index associated with each pft + integer , pointer :: ctype(:) ! column type + integer , pointer :: clandunit(:) ! landunit index associated with each column + integer , pointer :: ltype(:) ! landunit type + logical , pointer :: lakpoi(:) ! true => landunit is a lake point + integer , pointer :: plandunit(:) ! landunit index associated with each pft + logical , pointer :: urbpoi(:) ! true => landunit is an urban point + logical , pointer :: ifspecial(:) ! true => landunit is not vegetated + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: watsat(:,:) ! volumetric soil water at saturation (porosity) (nlevgrnd) + real(r8), pointer :: h2osoi_ice(:,:) ! ice lens (kg/m2) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code + real(r8), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(r8), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) + real(r8), pointer :: zi(:,:) ! interface level below a "z" level (m) + real(r8), pointer :: wa(:) ! water in the unconfined aquifer (mm) + real(r8), pointer :: wt(:) ! total water storage (unsaturated soil water + groundwater) (mm) + real(r8), pointer :: zwt(:) ! water table depth (m) + real(r8), pointer :: qflx_snow_melt(:) ! snow melt (net) +! +! local pointers to implicit out arguments +! + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: t_soisno(:,:) ! soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) + real(r8), pointer :: t_lake(:,:) ! lake temperature (Kelvin) (1:nlevlak) + real(r8), pointer :: t_grnd(:) ! ground temperature (Kelvin) + real(r8), pointer :: t_veg(:) ! vegetation temperature (Kelvin) + real(r8), pointer :: t_ref2m(:) ! 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_u(:) ! Urban 2 m height surface air temperature (Kelvin) + real(r8), pointer :: t_ref2m_r(:) ! Rural 2 m height surface air temperature (Kelvin) + real(r8), pointer :: h2osoi_vol(:,:) ! volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + real(r8), pointer :: h2ocan_col(:) ! canopy water (mm H2O) (column-level) + real(r8), pointer :: h2ocan_pft(:) ! canopy water (mm H2O) (pft-level) + real(r8), pointer :: h2osno(:) ! snow water (mm H2O) + real(r8), pointer :: snowdp(:) ! snow height (m) + real(r8), pointer :: qflx_irrig(:) ! irrigation flux (mm H2O/s) + real(r8), pointer :: eflx_lwrad_out(:) ! emitted infrared (longwave) radiation (W/m**2) + real(r8), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + real(r8), pointer :: snw_rds(:,:) ! effective snow grain radius (col,lyr) [microns, m^-6] + real(r8), pointer :: snw_rds_top(:) ! snow grain size, top (col) [microns] + real(r8), pointer :: sno_liq_top(:) ! liquid water fraction (mass) in top snow layer (col) [frc] + real(r8), pointer :: mss_bcpho(:,:) ! mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bcphi(:,:) ! mass of hydrophillic BC in snow (col,lyr) [kg] + real(r8), pointer :: mss_bctot(:,:) ! total mass of BC (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_bc_col(:) ! total mass of BC in snow column (col) [kg] + real(r8), pointer :: mss_bc_top(:) ! total mass of BC in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_bcphi(:,:) ! mass concentration of BC species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_bcpho(:,:) ! mass concentration of BC species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_ocpho(:,:) ! mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_ocphi(:,:) ! mass of hydrophillic OC in snow (col,lyr) [kg] + real(r8), pointer :: mss_octot(:,:) ! total mass of OC (pho+phi) (col,lyr) [kg] + real(r8), pointer :: mss_oc_col(:) ! total mass of OC in snow column (col) [kg] + real(r8), pointer :: mss_oc_top(:) ! total mass of OC in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_ocphi(:,:) ! mass concentration of OC species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_ocpho(:,:) ! mass concentration of OC species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_dst1(:,:) ! mass of dust species 1 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst2(:,:) ! mass of dust species 2 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst3(:,:) ! mass of dust species 3 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst4(:,:) ! mass of dust species 4 in snow (col,lyr) [kg] + real(r8), pointer :: mss_dsttot(:,:) ! total mass of dust in snow (col,lyr) [kg] + real(r8), pointer :: mss_dst_col(:) ! total mass of dust in snow column (col) [kg] + real(r8), pointer :: mss_dst_top(:) ! total mass of dust in top snow layer (col) [kg] + real(r8), pointer :: mss_cnc_dst1(:,:) ! mass concentration of dust species 1 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst2(:,:) ! mass concentration of dust species 2 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst3(:,:) ! mass concentration of dust species 3 (col,lyr) [kg/kg] + real(r8), pointer :: mss_cnc_dst4(:,:) ! mass concentration of dust species 4 (col,lyr) [kg/kg] + real(r8), pointer :: irrig_rate(:) ! current irrigation rate [mm/s] + integer, pointer :: n_irrig_steps_left(:) ! number of time steps for which we still need to irrigate today (if 0, ignore irrig_rate) + +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: j,l,c,p ! indices + integer :: nlevs ! number of levels + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + real(r8):: vwc,psi ! for calculating soilpsi +!----------------------------------------------------------------------- + + if ( masterproc )then + write(iulog,*) 'Setting initial data to non-spun up values' + end if + + ! Assign local pointers to derived subtypes components (landunit-level) + + ltype => lun%itype + lakpoi => lun%lakpoi + ifspecial => lun%ifspecial + urbpoi => lun%urbpoi + + ! Assign local pointers to derived subtypes components (column-level) + + ctype => col%itype + clandunit => col%landunit + snl => cps%snl + dz => cps%dz + watsat => cps%watsat + bsw2 => cps%bsw2 + vwcsat => cps%vwcsat + psisat => cps%psisat + soilpsi => cps%soilpsi + h2osoi_ice => cws%h2osoi_ice + h2osoi_liq => cws%h2osoi_liq + h2osoi_vol => cws%h2osoi_vol + h2ocan_col => pws_a%h2ocan + qflx_irrig => cwf%qflx_irrig + qflx_snow_melt => cwf%qflx_snow_melt + snowdp => cps%snowdp + h2osno => cws%h2osno + t_soisno => ces%t_soisno + t_lake => ces%t_lake + t_grnd => ces%t_grnd + zi => cps%zi + wa => cws%wa + wt => cws%wt + zwt => cws%zwt + snw_rds => cps%snw_rds + snw_rds_top => cps%snw_rds_top + sno_liq_top => cps%sno_liq_top + mss_bcpho => cps%mss_bcpho + mss_bcphi => cps%mss_bcphi + mss_bctot => cps%mss_bctot + mss_bc_col => cps%mss_bc_col + mss_bc_top => cps%mss_bc_top + mss_cnc_bcphi => cps%mss_cnc_bcphi + mss_cnc_bcpho => cps%mss_cnc_bcpho + mss_ocpho => cps%mss_ocpho + mss_ocphi => cps%mss_ocphi + mss_octot => cps%mss_octot + mss_oc_col => cps%mss_oc_col + mss_oc_top => cps%mss_oc_top + mss_cnc_ocphi => cps%mss_cnc_ocphi + mss_cnc_ocpho => cps%mss_cnc_ocpho + mss_dst1 => cps%mss_dst1 + mss_dst2 => cps%mss_dst2 + mss_dst3 => cps%mss_dst3 + mss_dst4 => cps%mss_dst4 + mss_dsttot => cps%mss_dsttot + mss_dst_col => cps%mss_dst_col + mss_dst_top => cps%mss_dst_top + mss_cnc_dst1 => cps%mss_cnc_dst1 + mss_cnc_dst2 => cps%mss_cnc_dst2 + mss_cnc_dst3 => cps%mss_cnc_dst3 + mss_cnc_dst4 => cps%mss_cnc_dst4 + n_irrig_steps_left => cps%n_irrig_steps_left + irrig_rate => cps%irrig_rate + + ! Assign local pointers to derived subtypes components (pft-level) + + pcolumn => pft%column + h2ocan_pft => pws%h2ocan + t_veg => pes%t_veg + t_ref2m => pes%t_ref2m + t_ref2m_u => pes%t_ref2m_u + t_ref2m_r => pes%t_ref2m_r + plandunit => pft%landunit + eflx_lwrad_out => pef%eflx_lwrad_out + + ! Determine subgrid bounds on this processor + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! NOTE: h2ocan, h2osno, and snowdp has valid values everywhere + ! canopy water (pft level) + + do p = begp, endp + h2ocan_pft(p) = 0._r8 + + ! added for canopy water mass balance under dynamic pft weights + !pps%tlai(p) = 0._r8 + !pps%tsai(p) = 0._r8 + !pps%elai(p) = 0._r8 + !pps%esai(p) = 0._r8 + !pps%htop(p) = 0._r8 + !pps%hbot(p) = 0._r8 + !pps%frac_veg_nosno_alb(p) = 0._r8 + end do + + do c = begc,endc + + ! canopy water (column level) + + h2ocan_col(c) = 0._r8 + qflx_snow_melt(c) = 0._r8 + + ! snow water + + l = clandunit(c) + + ! Note: Glacier_mec columns are initialized with half the maximum snow cover. + ! This gives more realistic values of qflx_glcice sooner in the simulation + ! for columns with net ablation, at the cost of delaying ice formation + ! in columns with net accumulation. + if (ltype(l)==istice) then + h2osno(c) = h2osno_max + elseif (ltype(l)==istice_mec) then + h2osno(c) = 0.5_r8 * h2osno_max ! 50 cm if h2osno_max = 1 m + else + h2osno(c) = 0._r8 + endif + + ! snow depth + + snowdp(c) = h2osno(c) / bdsno + + ! Initialize Irrigation to zero + if (ltype(l)==istsoil) then + n_irrig_steps_left(c) = 0 + irrig_rate(c) = 0.0_r8 + end if + + end do + + ! Set snow layer number, depth and thickiness + + call snowdp2lev(begc, endc) + + ! Set snow/soil temperature, note: + ! t_soisno only has valid values over non-lake + ! t_lake only has valid values over lake + ! t_grnd has valid values over all land + ! t_veg has valid values over all land + + ! NOTE: THESE MEMORY COPIES ARE INEFFICIENT -- SINCE nlev LOOP IS NESTED FIRST!!!! + do c = begc,endc + + t_soisno(c,-nlevsno+1:nlevgrnd) = spval + t_lake(c,1:nlevlak) = spval + + l = clandunit(c) + if (.not. lakpoi(l)) then !not lake + t_soisno(c,-nlevsno+1:0) = spval + if (snl(c) < 0) then !snow layer temperatures + do j = snl(c)+1, 0 + t_soisno(c,j) = 250._r8 + enddo + endif + if (ltype(l)==istice .or. ltype(l)==istice_mec) then + do j = 1, nlevgrnd + t_soisno(c,j) = 250._r8 + + end do + else if (ltype(l) == istwet) then + do j = 1, nlevgrnd + t_soisno(c,j) = 277._r8 + end do + else if (ltype(l) == isturb) then + if (use_vancouver) then + if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + ! Set road top layer to initial air temperature and interpolate other + ! layers down to 20C in bottom layer + do j = 1, nlevurb + t_soisno(c,j) = 297.56 - (j-1) * ((297.56-293.16)/(nlevurb-1)) + end do + ! Set wall and roof layers to initial air temperature + else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_roof) then + do j = 1, nlevurb + t_soisno(c,j) = 297.56 + end do + else + do j = 1, nlevurb + t_soisno(c,j) = 283._r8 + end do + end if + else if (use_mexicocity) then + if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + ! Set road top layer to initial air temperature and interpolate other + ! layers down to 22C in bottom layer + do j = 1, nlevurb + t_soisno(c,j) = 289.46 - (j-1) * ((289.46-295.16)/(nlevurb-1)) + end do + else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_roof) then + ! Set wall and roof layers to initial air temperature + do j = 1, nlevurb + t_soisno(c,j) = 289.46 + end do + else + do j = 1, nlevurb + t_soisno(c,j) = 283._r8 + end do + end if + else + if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + do j = 1, nlevurb + t_soisno(c,j) = 274._r8 + end do + else if (ctype(c) == icol_sunwall .or. ctype(c) == icol_shadewall .or. ctype(c) == icol_roof) then + ! Set sunwall, shadewall, roof to fairly high temperature to avoid initialization + ! shock from large heating/air conditioning flux + do j = 1, nlevurb + t_soisno(c,j) = 292._r8 + end do + end if + end if + else + do j = 1, nlevgrnd + t_soisno(c,j) = 274._r8 + end do + endif + t_grnd(c) = t_soisno(c,snl(c)+1) + else !lake + t_lake(c,1:nlevlak) = 277._r8 + t_grnd(c) = t_lake(c,1) + endif + + end do + + do p = begp, endp + c = pcolumn(p) + l = plandunit(p) + + ! Initialize Irrigation to zero + if (ltype(l)==istsoil) then + qflx_irrig(c) = 0.0_r8 + end if + + if (use_vancouver) then + t_veg(p) = 297.56 + t_ref2m(p) = 297.56 + if (urbpoi(l)) then + t_ref2m_u(p) = 297.56 + else + t_ref2m_u(p) = spval + end if + if (ifspecial(l)) then + t_ref2m_r(p) = spval + else + t_ref2m_r(p) = 297.56 + end if + else if (use_mexicocity) then + t_veg(p) = 289.46 + t_ref2m(p) = 289.46 + if (urbpoi(l)) then + t_ref2m_u(p) = 289.46 + else + t_ref2m_u(p) = spval + end if + if (ifspecial(l)) then + t_ref2m_r(p) = spval + else + t_ref2m_r(p) = 289.46 + end if + else + t_veg(p) = 283._r8 + t_ref2m(p) = 283._r8 + if (urbpoi(l)) then + t_ref2m_u(p) = 283._r8 + else + t_ref2m_u(p) = spval + end if + if (ifspecial(l)) then + t_ref2m_r(p) = spval + else + t_ref2m_r(p) = 283._r8 + end if + end if + eflx_lwrad_out(p) = sb * (t_grnd(c))**4 + end do + + ! Set snow/soil ice and liquid mass + + ! volumetric water is set first and liquid content and ice lens are obtained + ! NOTE: h2osoi_vol, h2osoi_liq and h2osoi_ice only have valid values over soil + ! and urban pervious road (other urban columns have zero soil water) + + h2osoi_vol(begc:endc, 1:) = spval + h2osoi_liq(begc:endc,-nlevsno+1:) = spval + h2osoi_ice(begc:endc,-nlevsno+1:) = spval + + wa(begc:endc) = 5000._r8 + wt(begc:endc) = 5000._r8 + zwt(begc:endc) = 0._r8 + + do c = begc,endc + l = clandunit(c) + if (.not. lakpoi(l)) then !not lake + if (ltype(l) == isturb) then + if (ctype(c) == icol_road_perv) then + wa(c) = 4800._r8 + wt(c) = wa(c) + zwt(c) = (25._r8 + zi(c,nlevsoi)) - wa(c)/0.2_r8 /1000._r8 ! One meter below soil column + else + wa(c) = spval + wt(c) = spval + zwt(c) = spval + end if + else + wa(c) = 4800._r8 + wt(c) = wa(c) + zwt(c) = (25._r8 + zi(c,nlevsoi)) - wa(c)/0.2_r8 /1000._r8 ! One meter below soil column + end if + end if + end do + + do c = begc,endc + l = clandunit(c) + if (.not. lakpoi(l)) then !not lake + + ! volumetric water + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + nlevs = nlevgrnd + do j = 1, nlevs + if (j > nlevsoi) then + h2osoi_vol(c,j) = 0.0_r8 + else + h2osoi_vol(c,j) = 0.3_r8 + endif + end do + else if (ltype(l) == isturb) then + nlevs = nlevurb + do j = 1, nlevs + if (ctype(c) == icol_road_perv .and. j <= nlevsoi) then + h2osoi_vol(c,j) = 0.3_r8 + else + h2osoi_vol(c,j) = 0.0_r8 + end if + end do + else if (ltype(l) == istwet) then + nlevs = nlevgrnd + do j = 1, nlevs + if (j > nlevsoi) then + h2osoi_vol(c,j) = 0.0_r8 + else + h2osoi_vol(c,j) = 1.0_r8 + endif + end do + else if (ltype(l) == istice .or. ltype(l) == istice_mec) then + nlevs = nlevgrnd + do j = 1, nlevs + h2osoi_vol(c,j) = 1.0_r8 + end do + endif + do j = 1, nlevs + h2osoi_vol(c,j) = min(h2osoi_vol(c,j),watsat(c,j)) + + ! soil layers + if (t_soisno(c,j) <= SHR_CONST_TKFRZ) then + h2osoi_ice(c,j) = dz(c,j)*denice*h2osoi_vol(c,j) + h2osoi_liq(c,j) = 0._r8 + else + h2osoi_ice(c,j) = 0._r8 + h2osoi_liq(c,j) = dz(c,j)*denh2o*h2osoi_vol(c,j) + endif + end do + + if (use_cn) then + ! soil water potential (added 10/21/03, PET) + ! required for CN code + if (ltype(l) == istsoil .or. ltype(l) == istcrop) then + nlevs = nlevgrnd + do j = 1, nlevs + if (h2osoi_liq(c,j) > 0._r8) then + vwc = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + psi = psisat(c,j) * (vwc/vwcsat(c,j))**bsw2(c,j) + soilpsi(c,j) = max(psi, -15.0_r8) + soilpsi(c,j) = min(soilpsi(c,j),0.0_r8) + end if + end do + end if + end if + end if + end do + + ! Set snow + + do j = -nlevsno+1, 0 + do c = begc,endc + l = clandunit(c) + if (.not. lakpoi(l)) then !not lake + if (j > snl(c)) then + h2osoi_ice(c,j) = dz(c,j)*250._r8 + h2osoi_liq(c,j) = 0._r8 + end if + end if + end do + end do + + + ! initialize SNICAR fields: + do c = begc,endc + mss_bctot(c,:) = 0._r8 + mss_bcpho(c,:) = 0._r8 + mss_bcphi(c,:) = 0._r8 + mss_cnc_bcphi(c,:)=0._r8 + mss_cnc_bcpho(c,:)=0._r8 + + mss_octot(c,:) = 0._r8 + mss_ocpho(c,:) = 0._r8 + mss_ocphi(c,:) = 0._r8 + mss_cnc_ocphi(c,:)=0._r8 + mss_cnc_ocpho(c,:)=0._r8 + + mss_dst1(c,:) = 0._r8 + mss_dst2(c,:) = 0._r8 + mss_dst3(c,:) = 0._r8 + mss_dst4(c,:) = 0._r8 + mss_dsttot(c,:) = 0._r8 + mss_cnc_dst1(c,:)=0._r8 + mss_cnc_dst2(c,:)=0._r8 + mss_cnc_dst3(c,:)=0._r8 + mss_cnc_dst4(c,:)=0._r8 + + if (snl(c) < 0) then + snw_rds(c,snl(c)+1:0) = snw_rds_min + snw_rds(c,-nlevsno+1:snl(c)) = 0._r8 + snw_rds_top(c) = snw_rds_min + sno_liq_top(c) = h2osoi_liq(c,snl(c)+1) / (h2osoi_liq(c,snl(c)+1)+h2osoi_ice(c,snl(c)+1)) + elseif (h2osno(c) > 0._r8) then + snw_rds(c,0) = snw_rds_min + snw_rds(c,-nlevsno+1:-1) = 0._r8 + snw_rds_top(c) = spval + sno_liq_top(c) = spval + else + snw_rds(c,:) = 0._r8 + snw_rds_top(c) = spval + sno_liq_top(c) = spval + endif + enddo + + + end subroutine mkarbinit + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: snowdp2lev +! +! !INTERFACE: + subroutine snowdp2lev(lbc, ubc) +! +! !DESCRIPTION: +! Create snow layers and interfaces given snow depth. +! Note that cps%zi(0) is set in routine iniTimeConst. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clmtype + use clm_varpar , only : nlevsno +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arguments +! + integer , pointer :: clandunit(:) ! landunit index associated with each column + real(r8), pointer :: snowdp(:) ! snow height (m) + logical , pointer :: lakpoi(:) ! true => landunit is a lake point +! +! local pointers to implicit out arguments +! + integer , pointer :: snl(:) ! number of snow layers + real(r8), pointer :: z(:,:) ! layer depth (m) over snow only + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) over snow only + real(r8), pointer :: zi(:,:) ! interface depth (m) over snow only +! +! +! !LOCAL VARIABLES: +!EOP + integer :: c,l,j !indices +!----------------------------------------------------------------------- + + ! Assign local pointers to derived subtypes components (landunit-level) + + lakpoi => lun%lakpoi + + ! Assign local pointers to derived type members (column-level) + + clandunit => col%landunit + snowdp => cps%snowdp + snl => cps%snl + zi => cps%zi + dz => cps%dz + z => cps%z + + ! Initialize snow levels and interfaces (lake and non-lake points) + + do c = lbc, ubc + dz(c,-nlevsno+1: 0) = 1.e36_r8 + z (c,-nlevsno+1: 0) = 1.e36_r8 + zi(c,-nlevsno :-1) = 1.e36_r8 + end do + + ! Determine snow levels and interfaces for non-lake points + + do c = lbc,ubc + l = clandunit(c) + if (.not. lakpoi(l)) then + if (snowdp(c) < 0.01_r8) then + snl(c) = 0 + dz(c,-nlevsno+1:0) = 0._r8 + z (c,-nlevsno+1:0) = 0._r8 + zi(c,-nlevsno+0:0) = 0._r8 + else + if ((snowdp(c) >= 0.01_r8) .and. (snowdp(c) <= 0.03_r8)) then + snl(c) = -1 + dz(c,0) = snowdp(c) + else if ((snowdp(c) > 0.03_r8) .and. (snowdp(c) <= 0.04_r8)) then + snl(c) = -2 + dz(c,-1) = snowdp(c)/2._r8 + dz(c, 0) = dz(c,-1) + else if ((snowdp(c) > 0.04_r8) .and. (snowdp(c) <= 0.07_r8)) then + snl(c) = -2 + dz(c,-1) = 0.02_r8 + dz(c, 0) = snowdp(c) - dz(c,-1) + else if ((snowdp(c) > 0.07_r8) .and. (snowdp(c) <= 0.12_r8)) then + snl(c) = -3 + dz(c,-2) = 0.02_r8 + dz(c,-1) = (snowdp(c) - 0.02_r8)/2._r8 + dz(c, 0) = dz(c,-1) + else if ((snowdp(c) > 0.12_r8) .and. (snowdp(c) <= 0.18_r8)) then + snl(c) = -3 + dz(c,-2) = 0.02_r8 + dz(c,-1) = 0.05_r8 + dz(c, 0) = snowdp(c) - dz(c,-2) - dz(c,-1) + else if ((snowdp(c) > 0.18_r8) .and. (snowdp(c) <= 0.29_r8)) then + snl(c) = -4 + dz(c,-3) = 0.02_r8 + dz(c,-2) = 0.05_r8 + dz(c,-1) = (snowdp(c) - dz(c,-3) - dz(c,-2))/2._r8 + dz(c, 0) = dz(c,-1) + else if ((snowdp(c) > 0.29_r8) .and. (snowdp(c) <= 0.41_r8)) then + snl(c) = -4 + dz(c,-3) = 0.02_r8 + dz(c,-2) = 0.05_r8 + dz(c,-1) = 0.11_r8 + dz(c, 0) = snowdp(c) - dz(c,-3) - dz(c,-2) - dz(c,-1) + else if ((snowdp(c) > 0.41_r8) .and. (snowdp(c) <= 0.64_r8)) then + snl(c) = -5 + dz(c,-4) = 0.02_r8 + dz(c,-3) = 0.05_r8 + dz(c,-2) = 0.11_r8 + dz(c,-1) = (snowdp(c) - dz(c,-4) - dz(c,-3) - dz(c,-2))/2._r8 + dz(c, 0) = dz(c,-1) + else if (snowdp(c) > 0.64_r8) then + snl(c) = -5 + dz(c,-4) = 0.02_r8 + dz(c,-3) = 0.05_r8 + dz(c,-2) = 0.11_r8 + dz(c,-1) = 0.23_r8 + dz(c, 0)=snowdp(c)-dz(c,-4)-dz(c,-3)-dz(c,-2)-dz(c,-1) + endif + end if + end if + end do + + ! The following loop is currently not vectorized + + do c = lbc,ubc + l = clandunit(c) + if (.not. lakpoi(l)) then + do j = 0, snl(c)+1, -1 + z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end do + end if + end do + + ! Determine snow levels and interfaces for lake points + + do c = lbc,ubc + l = clandunit(c) + if (lakpoi(l)) then + snl(c) = 0 + dz(c,-nlevsno+1:0) = 0._r8 + z (c,-nlevsno+1:0) = 0._r8 + zi(c,-nlevsno+0:0) = 0._r8 + end if + end do + + end subroutine snowdp2lev + +!----------------------------------------------------------------------- + +end module mkarbinitMod diff --git a/components/clm/src_clm40/main/ncdio_pio.F90 b/components/clm/src_clm40/main/ncdio_pio.F90 new file mode 100644 index 0000000000..68949c14eb --- /dev/null +++ b/components/clm/src_clm40/main/ncdio_pio.F90 @@ -0,0 +1,4082 @@ +#include "dtypes.h" +!=================================================== +! DO NOT EDIT THIS FILE, it was generated using ../../../../../tools/cprnc/genf90/genf90.pl +! Any changes you make to this file may be lost +!=================================================== +module ncdio_pio + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: ncdio_pioMod + ! + ! !DESCRIPTION: + ! Generic interfaces to write fields to netcdf files for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl + use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getunit, shr_file_freeunit + use shr_string_mod , only : shr_string_toUpper + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, mpicom, iam, npes + use spmdMod , only : MPI_REAL8, MPI_INTEGER, MPI_LOGICAL + use clmtype , only : grlnd, nameg, namel, namec, namep + use clm_varcon , only : spval,ispval + use clm_varctl , only : single_column, iulog + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : get_clmlevel_gsize,get_clmlevel_gsmap + use perf_mod , only : t_startf, t_stopf + use fileutils , only : getavu, relavu + use mct_mod , only : mct_gsMap, mct_gsMap_lsize, mct_gsMap_gsize, mct_gsMap_OP + use pio , only : file_desc_t, io_desc_t, iosystem_desc_t, pio_64bit_offset + use pio , only : pio_bcast_error, pio_char, pio_clobber, pio_closefile, pio_createfile, pio_def_dim + use pio , only : pio_def_var, pio_double, pio_enddef, pio_get_att, pio_get_var, pio_global, pio_initdecomp + use pio , only : pio_inq_att, pio_inq_dimid, pio_inq_dimlen, pio_inq_dimname, pio_inq_vardimid, pio_inq_varid + use pio , only : pio_inq_varname, pio_inq_varndims, pio_inquire, pio_int, pio_internal_error + use pio , only : pio_noclobber, pio_noerr, pio_nofill, pio_nowrite, pio_offset_kind, pio_openfile + use pio , only : pio_put_att, pio_put_var, pio_read_darray, pio_real, pio_seterrorhandling + use pio , only : pio_setframe, pio_unlimited, pio_write, pio_write_darray, var_desc_t + use pio , only : pio_iotask_rank, PIO_REARR_SUBSET, PIO_REARR_BOX + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public :: check_var ! determine if variable is on netcdf file + public :: check_att ! check if attribute is on file + public :: check_dim ! validity check on dimension + public :: ncd_pio_openfile ! open a file + public :: ncd_pio_createfile ! create a new file + public :: ncd_pio_closefile ! close a file + public :: ncd_pio_init ! called from clm_comp + public :: ncd_enddef ! end define mode + public :: ncd_putatt ! put attribute + public :: ncd_getatt ! get attribute + public :: ncd_defdim ! define dimension + public :: ncd_inqdid ! inquire dimension id + public :: ncd_inqdname ! inquire dimension name + public :: ncd_inqdlen ! inquire dimension length + public :: ncd_inqfdims ! inquire file dimnesions + public :: ncd_defvar ! define variables + public :: ncd_inqvid ! inquire variable id + public :: ncd_inqvname ! inquire variable name + public :: ncd_inqvdims ! inquire variable ndims + public :: ncd_inqvdids ! inquire variable dimids + public :: ncd_inqvdlen ! inquire variable dimension size + public :: ncd_io ! write local data + + integer,parameter,public :: ncd_int = pio_int + integer,parameter,public :: ncd_log =-pio_int + integer,parameter,public :: ncd_float = pio_real + integer,parameter,public :: ncd_double = pio_double + integer,parameter,public :: ncd_char = pio_char + integer,parameter,public :: ncd_global = pio_global + integer,parameter,public :: ncd_write = pio_write + integer,parameter,public :: ncd_nowrite = pio_nowrite + integer,parameter,public :: ncd_clobber = pio_clobber + integer,parameter,public :: ncd_noclobber = pio_noclobber + integer,parameter,public :: ncd_nofill = pio_nofill + integer,parameter,public :: ncd_unlimited = pio_unlimited + + ! PIO types needed for ncdio_pio interface calls + public file_desc_t + public var_desc_t + + ! + ! !PRIVATE MEMBER FUNCTIONS: + ! +# 88 "ncdio_pio.F90.in" + interface ncd_defvar + module procedure ncd_defvar_bynf + module procedure ncd_defvar_bygrid + end interface + +# 93 "ncdio_pio.F90.in" + interface ncd_putatt + module procedure ncd_putatt_int + module procedure ncd_putatt_real + module procedure ncd_putatt_char + end interface + +# 99 "ncdio_pio.F90.in" + interface ncd_getatt + module procedure ncd_getatt_char + end interface ncd_getatt + +# 103 "ncdio_pio.F90.in" + interface ncd_io + module procedure ncd_io_char_var0_start_glob + + !DIMS 0,1 + module procedure ncd_io_0d_log_glob + !DIMS 0,1 + module procedure ncd_io_1d_log_glob + + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_0d_int_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_1d_int_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_2d_int_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_3d_int_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_0d_double_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_1d_double_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_2d_double_glob + !TYPE int,double + !DIMS 0,1,2,3 + module procedure ncd_io_3d_double_glob + + !TYPE text + !DIMS 0,1,2 + module procedure ncd_io_0d_text_glob + !TYPE text + !DIMS 0,1,2 + module procedure ncd_io_1d_text_glob + !TYPE text + !DIMS 0,1,2 + module procedure ncd_io_2d_text_glob + + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_1d_int + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_2d_int + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_3d_int + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_1d_double + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_2d_double + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_3d_double + + !TYPE logical + !DIMS 1 + module procedure ncd_io_1d_logical + end interface + +# 126 "ncdio_pio.F90.in" + interface ncd_inqvdlen + module procedure ncd_inqvdlen_byDesc + module procedure ncd_inqvdlen_byName + end interface + + private :: ncd_getiodesc ! obtain iodesc + private :: scam_field_offsets ! get offset to proper lat/lon gridcell for SCAM + + integer,parameter,private :: debug = 0 ! local debug level + + integer , parameter , public :: max_string_len = 256 ! length of strings + real(r8), parameter , public :: fillvalue = 1.e36_r8 ! fill value for netcdf fields + + integer, public :: io_type + + type(iosystem_desc_t), pointer, public :: pio_subsystem + + type iodesc_plus_type + character(len=64) :: name + type(IO_desc_t) :: iodesc + integer :: type + integer :: ndims + integer :: dims(4) + integer :: dimids(4) + end type iodesc_plus_type + integer,parameter ,private :: max_iodesc = 100 + integer ,private :: num_iodesc = 0 + type(iodesc_plus_type) ,private, target :: iodesc_list(max_iodesc) + !----------------------------------------------------------------------- + +# 156 "ncdio_pio.F90.in" +contains + + !----------------------------------------------------------------------- +# 159 "ncdio_pio.F90.in" + subroutine ncd_pio_init() + ! + ! !DESCRIPTION: + ! Initial PIO + ! + ! !USES: + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype + use clm_varctl , only : inst_name + !----------------------------------------------------------------------- + + PIO_subsystem => shr_pio_getiosys(inst_name) + io_type = shr_pio_getiotype(inst_name) + +# 172 "ncdio_pio.F90.in" + end subroutine ncd_pio_init + + !----------------------------------------------------------------------- +# 175 "ncdio_pio.F90.in" + subroutine ncd_pio_openfile(file, fname, mode) + ! + ! !DESCRIPTION: + ! Open a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: file ! Output PIO file handle + character(len=*) , intent(in) :: fname ! Input filename to open + integer , intent(in) :: mode ! file mode + ! + ! !LOCAL VARIABLES: + integer :: ierr + !----------------------------------------------------------------------- + + ierr = pio_openfile(pio_subsystem, file, io_type, fname, mode) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort('ncd_pio_openfile ERROR: Failed to open file') + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened existing file ', trim(fname), file%fh + end if + +# 197 "ncdio_pio.F90.in" + end subroutine ncd_pio_openfile + + !----------------------------------------------------------------------- +# 200 "ncdio_pio.F90.in" + subroutine ncd_pio_closefile(file) + ! + ! !DESCRIPTION: + ! Close a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file handle to close + !----------------------------------------------------------------------- + + call pio_closefile(file) + +# 211 "ncdio_pio.F90.in" + end subroutine ncd_pio_closefile + + !----------------------------------------------------------------------- +# 214 "ncdio_pio.F90.in" + subroutine ncd_pio_createfile(file, fname) + ! + ! !DESCRIPTION: + ! Create a new NetCDF file with PIO + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file descriptor + character(len=*) , intent(in) :: fname ! File name to create + ! + ! !LOCAL VARIABLES: + integer :: ierr + !----------------------------------------------------------------------- + + ierr = pio_createfile(pio_subsystem, file, io_type, fname, ior(PIO_CLOBBER,PIO_64BIT_OFFSET)) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort( ' ncd_pio_createfile ERROR: Failed to open file to write: '//trim(fname)) + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened file ', trim(fname), ' to write', file%fh + end if + +# 235 "ncdio_pio.F90.in" + end subroutine ncd_pio_createfile + + !----------------------------------------------------------------------- +# 238 "ncdio_pio.F90.in" + subroutine check_var(ncid, varname, vardesc, readvar, print_err ) + ! + ! !DESCRIPTION: + ! Check if variable is on netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=*) , intent(in) :: varname ! Varible name to check + type(Var_desc_t) , intent(out) :: vardesc ! Output variable descriptor + logical , intent(out) :: readvar ! If variable exists or not + logical, optional , intent(in) :: print_err ! If should print about error + ! + ! !LOCAL VARIABLES: + integer :: ret ! return value + logical :: log_err ! if should log error + character(len=*),parameter :: subname='check_var' ! subroutine name + !----------------------------------------------------------------------- + + + if ( present(print_err) )then + log_err = print_err + else + log_err = .true. + end if + readvar = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid (ncid, varname, vardesc) + if (ret /= PIO_noerr) then + readvar = .false. + if (masterproc .and. log_err) & + write(iulog,*) subname//': variable ',trim(varname),' is not on dataset' + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + +# 272 "ncdio_pio.F90.in" + end subroutine check_var + + !----------------------------------------------------------------------- +# 275 "ncdio_pio.F90.in" + subroutine check_att(ncid, varid, attrib, att_found) + ! + ! !DESCRIPTION: + ! Check if attribute is on file + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + logical ,intent(out) :: att_found ! true if the attribute was found + ! + ! !LOCAL VARIABLES: + integer :: att_type ! attribute type + integer(pio_offset_kind) :: att_len ! attribute length + integer :: status + + character(len=*), parameter :: subname = 'check_att' + !----------------------------------------------------------------------- + + att_found = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + status = PIO_inq_att(ncid, varid, trim(attrib), att_type, att_len) + if (status /= PIO_noerr) then + att_found = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + +# 304 "ncdio_pio.F90.in" + end subroutine check_att + + !----------------------------------------------------------------------- +# 307 "ncdio_pio.F90.in" + subroutine check_dim(ncid, dimname, value) + ! + ! !DESCRIPTION: + ! Validity check on dimension + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! PIO file handle + character(len=*) , intent(in) :: dimname ! Dimension name + integer, intent(in) :: value ! Expected dimension size + ! + ! !LOCAL VARIABLES: + integer :: dimid, dimlen ! temporaries + integer :: status ! error code + character(len=*),parameter :: subname='check_dim' ! subroutine name + !----------------------------------------------------------------------- + + status = pio_inq_dimid (ncid, trim(dimname), dimid) + status = pio_inq_dimlen (ncid, dimid, dimlen) + if (dimlen /= value) then + write(iulog,*) subname//' ERROR: mismatch of input dimension ',dimlen, & + ' with expected value ',value,' for variable ',trim(dimname) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + +# 331 "ncdio_pio.F90.in" + end subroutine check_dim + + !----------------------------------------------------------------------- +# 334 "ncdio_pio.F90.in" + subroutine ncd_enddef(ncid) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + ! + ! !LOCAL VARIABLES: + integer :: status ! error status + !----------------------------------------------------------------------- + + status = PIO_enddef(ncid) + +# 348 "ncdio_pio.F90.in" + end subroutine ncd_enddef + + !----------------------------------------------------------------------- +# 351 "ncdio_pio.F90.in" + subroutine ncd_inqdid(ncid,name,dimid,dimexist) + ! + ! !DESCRIPTION: + ! inquire on a dimension id + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! dimension name + integer , intent(out):: dimid ! dimension id + logical,optional , intent(out):: dimexist ! if this dimension exists or not + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(dimexist) )then + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + end if + status = PIO_inq_dimid(ncid,name,dimid) + if ( present(dimexist) )then + if ( status == PIO_NOERR)then + dimexist = .true. + else + dimexist = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + end if + +# 379 "ncdio_pio.F90.in" + end subroutine ncd_inqdid + + !----------------------------------------------------------------------- +# 382 "ncdio_pio.F90.in" + subroutine ncd_inqdlen(ncid,dimid,len,name) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(inout) :: dimid ! dimension id + integer , intent(out) :: len ! dimension len + character(len=*), optional, intent(in) :: name ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(name) )then + call ncd_inqdid(ncid,name,dimid) + end if + len = -1 + status = PIO_inq_dimlen(ncid,dimid,len) + +# 403 "ncdio_pio.F90.in" + end subroutine ncd_inqdlen + + !----------------------------------------------------------------------- +# 406 "ncdio_pio.F90.in" + subroutine ncd_inqdname(ncid,dimid,dname) + ! + ! !DESCRIPTION: + ! inquire dim name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: dimid ! dimension id + character(len=*) , intent(out):: dname ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_inq_dimname(ncid,dimid,dname) + +# 422 "ncdio_pio.F90.in" + end subroutine ncd_inqdname + + !----------------------------------------------------------------------- +# 425 "ncdio_pio.F90.in" + subroutine ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout):: ncid + logical , intent(out) :: isgrid2d + integer , intent(out) :: ni + integer , intent(out) :: nj + integer , intent(out) :: ns + ! + ! !LOCAL VARIABLES: + integer :: dimid ! netCDF id + integer :: ier ! error status + character(len=32) :: subname = 'ncd_inqfdims' ! subroutine name + !----------------------------------------------------------------------- + + if (single_column) then + ni = 1 + nj = 1 + ns = 1 + isgrid2d = .true. + RETURN + end if + + ni = 0 + nj = 0 + + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ier = pio_inq_dimid (ncid, 'lon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'lsmlon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lsmlat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'ni', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'nj', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'gridcell', dimid) + if (ier == PIO_NOERR) then + ier = pio_inq_dimlen(ncid, dimid, ni) + if (ier == PIO_NOERR) nj = 1 + end if + + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + if (ni == 0 .or. nj == 0) then + write(iulog,*) trim(subname),' ERROR: ni,nj = ',ni,nj,' cannot be zero ' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + + if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + + ns = ni*nj + +# 488 "ncdio_pio.F90.in" + end subroutine ncd_inqfdims + + !----------------------------------------------------------------------- +# 491 "ncdio_pio.F90.in" + subroutine ncd_inqvid(ncid,name,varid,vardesc,readvar) + ! + ! !DESCRIPTION: + ! Inquire on a variable ID + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! variable name + integer , intent(out) :: varid ! variable id + type(Var_desc_t) , intent(out) :: vardesc ! variable descriptor + logical, optional , intent(out) :: readvar ! does variable exist + ! + ! !LOCAL VARIABLES: + integer :: ret ! return code + character(len=*),parameter :: subname='ncd_inqvid' ! subroutine name + !----------------------------------------------------------------------- + + if (present(readvar)) then + readvar = .false. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid(ncid,name,vardesc) + if (ret /= PIO_noerr) then + if (masterproc) write(iulog,*) subname//': variable ',trim(name),' is not on dataset' + readvar = .false. + else + readvar = .true. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + else + ret = PIO_inq_varid(ncid,name,vardesc) + endif + varid = vardesc%varid + +# 524 "ncdio_pio.F90.in" + end subroutine ncd_inqvid + + !----------------------------------------------------------------------- +# 527 "ncdio_pio.F90.in" + subroutine ncd_inqvdims(ncid,ndims,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimensions + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(out) :: ndims ! variable ndims + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + ndims = -1 + status = PIO_inq_varndims(ncid,vardesc,ndims) + +# 544 "ncdio_pio.F90.in" + end subroutine ncd_inqvdims + + !----------------------------------------------------------------------- +# 547 "ncdio_pio.F90.in" + subroutine ncd_inqvname(ncid,varid,vname,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: varid ! variable id + character(len=*) , intent(out) :: vname ! variable vname + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + vname = '' + status = PIO_inq_varname(ncid,vardesc,vname) + +# 565 "ncdio_pio.F90.in" + end subroutine ncd_inqvname + + !----------------------------------------------------------------------- +# 568 "ncdio_pio.F90.in" + subroutine ncd_inqvdids(ncid,dids,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimension ids + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! netcdf file id + integer ,intent(out) :: dids(:) ! variable dids + type(Var_desc_t) ,intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + dids = -1 + status = PIO_inq_vardimid(ncid,vardesc,dids) + +# 585 "ncdio_pio.F90.in" + end subroutine ncd_inqvdids + + !----------------------------------------------------------------------- +# 588 "ncdio_pio.F90.in" + subroutine ncd_inqvdlen_byDesc(ncid,vardesc,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a vardesc + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + type(Var_desc_t) ,intent(inout) :: vardesc ! variable descriptor + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + integer :: ndims ! number of dimensions + integer, allocatable :: dimids(:) ! dimension IDs + + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_none = 0 + integer, parameter :: error_dimnum_out_of_range = 1 + !----------------------------------------------------------------------- + + err_code = error_none + + call ncd_inqvdims(ncid, ndims, vardesc) + + if (dimnum > 0 .and. dimnum <= ndims) then + allocate(dimids(ndims)) + call ncd_inqvdids(ncid, dimids, vardesc) + call ncd_inqdlen(ncid, dimids(dimnum), dlen) + deallocate(dimids) + else + dlen = dlen_invalid + err_code = error_dimnum_out_of_range + end if + +# 631 "ncdio_pio.F90.in" + end subroutine ncd_inqvdlen_byDesc + + + !----------------------------------------------------------------------- +# 635 "ncdio_pio.F90.in" + subroutine ncd_inqvdlen_byName(ncid,varname,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a variable name + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! 11: variable not found + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) ,intent(in) :: varname ! variable name + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + type(Var_desc_t) :: vardesc ! variable descriptor + logical :: readvar ! whether the variable was found + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_variable_not_found = 11 + !----------------------------------------------------------------------- + + call check_var(ncid, varname, vardesc, readvar) + if (readvar) then + call ncd_inqvdlen_byDesc(ncid, vardesc, dimnum, dlen, err_code) + else + dlen = dlen_invalid + err_code = error_variable_not_found + end if + +# 671 "ncdio_pio.F90.in" + end subroutine ncd_inqvdlen_byName + + + !----------------------------------------------------------------------- +# 675 "ncdio_pio.F90.in" + subroutine ncd_putatt_int(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put integer attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + integer ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + +# 693 "ncdio_pio.F90.in" + end subroutine ncd_putatt_int + + !----------------------------------------------------------------------- +# 696 "ncdio_pio.F90.in" + subroutine ncd_putatt_char(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put character attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + +# 714 "ncdio_pio.F90.in" + end subroutine ncd_putatt_char + + !----------------------------------------------------------------------- +# 717 "ncdio_pio.F90.in" + subroutine ncd_putatt_real(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put real attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + real(r8) ,intent(in) :: value ! netcdf attrib value + integer ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + real*4 :: value4 + !----------------------------------------------------------------------- + + value4 = value + + if (xtype == pio_double) then + status = PIO_put_att(ncid,varid,trim(attrib),value) + else + status = PIO_put_att(ncid,varid,trim(attrib),value4) + endif + +# 742 "ncdio_pio.F90.in" + end subroutine ncd_putatt_real + + !----------------------------------------------------------------------- +# 745 "ncdio_pio.F90.in" + subroutine ncd_getatt_char(ncid,varid,attrib,value) + ! + ! !DESCRIPTION: + ! get a character attribute + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(out) :: value ! netcdf attrib value + ! + ! !LOCAL VARIABLES: + integer :: status + + character(len=*), parameter :: subname = 'ncd_getatt_char' + !----------------------------------------------------------------------- + + status = PIO_get_att(ncid,varid,trim(attrib),value) + +# 766 "ncdio_pio.F90.in" + end subroutine ncd_getatt_char + + + !----------------------------------------------------------------------- +# 770 "ncdio_pio.F90.in" + subroutine ncd_defdim(ncid,attrib,value,dimid) + ! + ! !DESCRIPTION: + ! define dimension + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + character(len=*) , intent(in) :: attrib ! netcdf attrib + integer , intent(in) :: value ! netcdf attrib value + integer , intent(out):: dimid ! netcdf dimension id + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = pio_def_dim(ncid,attrib,value,dimid) + +# 787 "ncdio_pio.F90.in" + end subroutine ncd_defdim + + !----------------------------------------------------------------------- +# 790 "ncdio_pio.F90.in" + subroutine ncd_defvar_bynf(ncid, varname, xtype, ndims, dimid, varid, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, comment, flag_meanings, & + flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + integer , intent(in) :: ndims ! number of dims + integer , intent(inout) :: varid ! returned var id + integer , intent(in), optional :: dimid(:) ! dimids + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ldimid(4) ! local dimid + integer :: dimid0(1) ! local dimid + integer :: status ! error status + integer :: lxtype ! local external type (in case logical variable) + type(var_desc_t) :: vardesc ! local vardesc + character(len=128) :: dimname ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bynf' ! subroutine name + !----------------------------------------------------------------------- + + varid = -1 + + dimid0 = 0 + ldimid = 0 + if (present(dimid)) then + ldimid(1:ndims) = dimid(1:ndims) + else ! ndims must be zero if dimid not present + if (ndims /= 0) then + write(iulog,*) subname//' ERROR: dimid not supplied and ndims ne 0 ',trim(varname),ndims + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + endif + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + if (masterproc .and. debug > 1) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + write(iulog,*) subname//' ',trim(varname),lxtype,ndims,ldimid(1:ndims) + endif + + if (ndims > 0) then + status = pio_inq_dimname(ncid,ldimid(ndims),dimname) + end if + + ! Define variable + if (present(dimid)) then + status = PIO_def_var(ncid,trim(varname),lxtype,dimid(1:ndims),vardesc) + else + status = PIO_def_var(ncid,trim(varname),lxtype,dimid0 ,vardesc) + endif + varid = vardesc%varid + + ! + ! Add attributes + ! + if (present(long_name)) then + call ncd_putatt(ncid, varid, 'long_name', trim(long_name)) + end if + if (present(flag_values)) then + status = PIO_put_att(ncid,varid,'flag_values',flag_values) + if ( .not. present(flag_meanings)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_values set -- but not flag_meanings"//errMsg(__FILE__, __LINE__)) + end if + end if + if (present(flag_meanings)) then + if ( .not. present(flag_values)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings set -- but not flag_values"//errMsg(__FILE__, __LINE__) ) + end if + if ( size(flag_values) /= size(flag_meanings) ) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings and flag_values dimension different"//errMsg(__FILE__, __LINE__)) + end if + str = flag_meanings(1) + do n = 1, size(flag_meanings) + if ( index(flag_meanings(n), ' ') /= 0 )then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings has an invalid space in it"//errMsg(__FILE__, __LINE__) ) + end if + if ( n > 1 ) str = trim(str)//" "//flag_meanings(n) + end do + status = PIO_put_att(ncid,varid,'flag_meanings', trim(str) ) + end if + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(cell_method)) then + str = 'time: ' // trim(cell_method) + call ncd_putatt(ncid, varid, 'cell_methods', trim(str)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + +# 927 "ncdio_pio.F90.in" + end subroutine ncd_defvar_bynf + + !----------------------------------------------------------------------- +# 930 "ncdio_pio.F90.in" + subroutine ncd_defvar_bygrid(ncid, varname, xtype, & + dim1name, dim2name, dim3name, dim4name, dim5name, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, switchdim, comment, & + flag_meanings, flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: dim3name ! dimension name + character(len=*) , intent(in), optional :: dim4name ! dimension name + character(len=*) , intent(in), optional :: dim5name ! dimension name + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + logical , intent(in), optional :: switchdim ! true=> permute dim1 and dim2 for output + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ndims ! dimension counter + integer :: dimid(5) ! dimension ids + integer :: varid ! variable id + integer :: itmp ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name + !----------------------------------------------------------------------- + + dimid(:) = 0 + + ! Determine dimension ids for variable + + if (present(dim1name)) call ncd_inqdid(ncid, dim1name, dimid(1)) + if (present(dim2name)) call ncd_inqdid(ncid, dim2name, dimid(2)) + if (present(dim3name)) call ncd_inqdid(ncid, dim3name, dimid(3)) + if (present(dim4name)) call ncd_inqdid(ncid, dim4name, dimid(4)) + if (present(dim5name)) call ncd_inqdid(ncid, dim5name, dimid(5)) + + ! Permute dim1 and dim2 if necessary + + if (present(switchdim)) then + itmp = dimid(2) + dimid(2) = dimid(1) + dimid(1) = itmp + end if + + ! Define variable + + ndims = 0 + if (present(dim1name)) then + do n = 1, size(dimid) + if (dimid(n) /= 0) ndims = ndims + 1 + end do + end if + + call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & + long_name=long_name, units=units, cell_method=cell_method, & + missing_value=missing_value, fill_value=fill_value, & + imissing_value=imissing_value, ifill_value=ifill_value, & + comment=comment, flag_meanings=flag_meanings, & + flag_values=flag_values, nvalid_range=nvalid_range ) + +# 1005 "ncdio_pio.F90.in" + end subroutine ncd_defvar_bygrid + + !------------------------------------------------------------------------ +# 1008 "ncdio_pio.F90.in" + subroutine ncd_io_char_var0_start_glob(vardesc, data, flag, ncid, start ) + ! + ! !DESCRIPTION: + ! netcdf I/O of global character array with start indices input + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + type(var_desc_t) , intent(in) :: vardesc ! local vardesc pointer + character(len=*) , intent(inout) :: data ! raw data for this index + integer , intent(in) :: start(:) ! output bounds + ! + ! !LOCAL VARIABLES: + integer :: status ! error code + character(len=*),parameter :: subname='ncd_io_char_var0_start_glob' + !----------------------------------------------------------------------- + + if (flag == 'read') then + + status = pio_get_var(ncid, vardesc, start, data ) + + elseif (flag == 'write') then + + status = pio_put_var(ncid, vardesc, start, data ) + + endif + +# 1035 "ncdio_pio.F90.in" + end subroutine ncd_io_char_var0_start_glob + + !------------------------------------------------------------------------ + !DIMS 0,1 +# 1039 "ncdio_pio.F90.in" + subroutine ncd_io_0d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global integer variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + logical , intent(inout) :: data ! raw data + logical, optional , intent(out) :: readvar ! was var read? + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: start(2), count(2) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer :: idata + integer, pointer :: idata1d(:) ! Temporary integer data to send to file + character(len=32) :: vname ! variable error checking + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_0d_log_glob' + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif +#if (0==0) + status = pio_get_var(ncid, varid, idata) + if ( idata == 0 )then + data = .false. + else if ( idata == 1 )then + data = .true. + else + call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(__FILE__, __LINE__)) + end if +#else + allocate(idata1d(size(data))) + data = (idata1d == 1) + if ( any(idata1d /= 0 .and. idata1d /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate(idata1d) +#endif + endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + +#if (0==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt + call ncd_inqvid (ncid, varname, varid, vardesc) + allocate(idata1d(1)) + if ( data )then + idata1d(1) = 1 + else + idata1d(1) = 0 + end if + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate(idata1d) +#else + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + allocate(idata1d(size(data))) + where( data ) + idata1d = 1 + elsewhere + idata1d = 0 + end where + call ncd_inqvid (ncid, varname, varid, vardesc) + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate( idata1d ) +#endif + + endif ! flag + +# 1129 "ncdio_pio.F90.in" + end subroutine ncd_io_0d_log_glob + !DIMS 0,1 +# 1039 "ncdio_pio.F90.in" + subroutine ncd_io_1d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global integer variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + logical , intent(inout) :: data(:) ! raw data + logical, optional , intent(out) :: readvar ! was var read? + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: start(2), count(2) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer :: idata + integer, pointer :: idata1d(:) ! Temporary integer data to send to file + character(len=32) :: vname ! variable error checking + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_1d_log_glob' + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif +#if (1==0) + status = pio_get_var(ncid, varid, idata) + if ( idata == 0 )then + data = .false. + else if ( idata == 1 )then + data = .true. + else + call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(__FILE__, __LINE__)) + end if +#else + allocate(idata1d(size(data))) + data = (idata1d == 1) + if ( any(idata1d /= 0 .and. idata1d /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate(idata1d) +#endif + endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + +#if (1==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt + call ncd_inqvid (ncid, varname, varid, vardesc) + allocate(idata1d(1)) + if ( data )then + idata1d(1) = 1 + else + idata1d(1) = 0 + end if + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate(idata1d) +#else + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + allocate(idata1d(size(data))) + where( data ) + idata1d = 1 + elsewhere + idata1d = 0 + end where + call ncd_inqvid (ncid, varname, varid, vardesc) + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate( idata1d ) +#endif + + endif ! flag + +# 1129 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_log_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_0d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + integer(i4) , intent(inout) :: data ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(0+1), count(0+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + integer(i4) :: temp(1) + character(len=*),parameter :: subname='ncd_io_0d_int_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (0==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 0 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (0==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (0==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (0==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (0==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_0d_int_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_1d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + integer(i4) , intent(inout) :: data(:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(1+1), count(1+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + integer(i4) :: temp(1) + character(len=*),parameter :: subname='ncd_io_1d_int_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (1==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 1 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (1==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (1==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (1==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (1==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_int_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_2d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + integer(i4) , intent(inout) :: data(:,:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(2+1), count(2+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + integer(i4) :: temp(1) + character(len=*),parameter :: subname='ncd_io_2d_int_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (2==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 2 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (2==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (2==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (2==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (2==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_2d_int_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_3d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + integer(i4) , intent(inout) :: data(:,:,:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(3+1), count(3+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + integer(i4) :: temp(1) + character(len=*),parameter :: subname='ncd_io_3d_int_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (3==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 3 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (3==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (3==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (3==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (3==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_3d_int_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_0d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + real(r8) , intent(inout) :: data ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(0+1), count(0+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + real(r8) :: temp(1) + character(len=*),parameter :: subname='ncd_io_0d_double_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (0==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 0 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (0==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (0==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (0==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (0==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_0d_double_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_1d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + real(r8) , intent(inout) :: data(:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(1+1), count(1+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + real(r8) :: temp(1) + character(len=*),parameter :: subname='ncd_io_1d_double_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (1==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 1 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (1==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (1==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (1==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (1==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_double_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_2d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + real(r8) , intent(inout) :: data(:,:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(2+1), count(2+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + real(r8) :: temp(1) + character(len=*),parameter :: subname='ncd_io_2d_double_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (2==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 2 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (2==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (2==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (2==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (2==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_2d_double_glob + !DIMS 0,1,2,3 + !TYPE int,double +# 1134 "ncdio_pio.F90.in" + subroutine ncd_io_3d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + real(r8) , intent(inout) :: data(:,:,:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(3+1), count(3+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + real(r8) :: temp(1) + character(len=*),parameter :: subname='ncd_io_3d_double_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if (3==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 3 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if (3==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif (3==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (3==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif (3==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1231 "ncdio_pio.F90.in" + end subroutine ncd_io_3d_double_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2 + !TYPE text +# 1236 "ncdio_pio.F90.in" + subroutine ncd_io_0d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + character(len=*) , intent(inout) :: data ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(4), count(4) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_0d_text_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + + if (varpresent) then + data = ' ' + status = pio_get_var(ncid, varid, data) + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 0 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) + +#if (0==0) + if (present(nt)) then + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do + start(1) = 1 ; count(1) = len(data) + start(2) = nt; count(2) = 1 + if ( count(1) > size(tmpString) )then + write(iulog,*) subname//' ERROR: input string size is too large:' + end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) + else + status = pio_put_var(ncid, varid, data ) + end if +#elif (0==1) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) + start(3) = nt; count(3) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#elif (0==2) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1317 "ncdio_pio.F90.in" + end subroutine ncd_io_0d_text_glob + !DIMS 0,1,2 + !TYPE text +# 1236 "ncdio_pio.F90.in" + subroutine ncd_io_1d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + character(len=*) , intent(inout) :: data(:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(4), count(4) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_1d_text_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + + if (varpresent) then + data = ' ' + status = pio_get_var(ncid, varid, data) + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 1 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) + +#if (1==0) + if (present(nt)) then + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do + start(1) = 1 ; count(1) = len(data) + start(2) = nt; count(2) = 1 + if ( count(1) > size(tmpString) )then + write(iulog,*) subname//' ERROR: input string size is too large:' + end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) + else + status = pio_put_var(ncid, varid, data ) + end if +#elif (1==1) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) + start(3) = nt; count(3) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#elif (1==2) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1317 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_text_glob + !DIMS 0,1,2 + !TYPE text +# 1236 "ncdio_pio.F90.in" + subroutine ncd_io_2d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + character(len=*) , intent(inout) :: data(:,:) ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(4), count(4) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_2d_text_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + + if (varpresent) then + data = ' ' + status = pio_get_var(ncid, varid, data) + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = 2 + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) + +#if (2==0) + if (present(nt)) then + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do + start(1) = 1 ; count(1) = len(data) + start(2) = nt; count(2) = 1 + if ( count(1) > size(tmpString) )then + write(iulog,*) subname//' ERROR: input string size is too large:' + end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) + else + status = pio_put_var(ncid, varid, data ) + end if +#elif (2==1) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) + start(3) = nt; count(3) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#elif (2==2) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + +# 1317 "ncdio_pio.F90.in" + end subroutine ncd_io_2d_text_glob + + !----------------------------------------------------------------------- + + !TYPE int,double,logical +# 1322 "ncdio_pio.F90.in" + subroutine ncd_io_1d_int(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer(i4) , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! Local Variables + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: n ! index + integer :: iodnum ! iodesc num in list + integer :: varid ! varid + integer :: ndims ! ndims for var + integer :: ndims_iod ! ndims iodesc for var + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: start(3) ! netcdf start index + integer :: count(3) ! netcdf count index + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer , pointer :: idata(:) ! Temporary integer data to send to file + integer , pointer :: compDOF(:) + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_1d_int' ! subroutine name + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if (103==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid,clmlevel,vardesc,start,count) + if (trim(clmlevel) == grlnd) then + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + else + n=1 + if (present(nt)) then + n=2 + start(2) = nt ; count(2) = 1 + end if + end if +#if (103==TYPELOGICAL) + allocate(idata(size(data))) + status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) +#endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (103==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (103==TYPELOGICAL) + allocate(idata(size(data))) + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) +#endif + end if + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (103==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (103==TYPELOGICAL) + allocate( idata(size(data)) ) + where( data ) + idata = 1 + elsewhere + idata = 0 + end where + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) + deallocate( idata ) +#elif (103==TYPEINT) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) +#elif (103==TYPEDOUBLE) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) +#endif + else + + if (masterproc) then + write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + +# 1493 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_int + !TYPE int,double,logical +# 1322 "ncdio_pio.F90.in" + subroutine ncd_io_1d_double(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + real(r8) , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! Local Variables + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: n ! index + integer :: iodnum ! iodesc num in list + integer :: varid ! varid + integer :: ndims ! ndims for var + integer :: ndims_iod ! ndims iodesc for var + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: start(3) ! netcdf start index + integer :: count(3) ! netcdf count index + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer , pointer :: idata(:) ! Temporary integer data to send to file + integer , pointer :: compDOF(:) + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_1d_double' ! subroutine name + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if (102==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid,clmlevel,vardesc,start,count) + if (trim(clmlevel) == grlnd) then + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + else + n=1 + if (present(nt)) then + n=2 + start(2) = nt ; count(2) = 1 + end if + end if +#if (102==TYPELOGICAL) + allocate(idata(size(data))) + status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) +#endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (102==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (102==TYPELOGICAL) + allocate(idata(size(data))) + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) +#endif + end if + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (102==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (102==TYPELOGICAL) + allocate( idata(size(data)) ) + where( data ) + idata = 1 + elsewhere + idata = 0 + end where + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) + deallocate( idata ) +#elif (102==TYPEINT) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) +#elif (102==TYPEDOUBLE) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) +#endif + else + + if (masterproc) then + write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + +# 1493 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_double + !TYPE int,double,logical +# 1322 "ncdio_pio.F90.in" + subroutine ncd_io_1d_logical(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + logical , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! Local Variables + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: n ! index + integer :: iodnum ! iodesc num in list + integer :: varid ! varid + integer :: ndims ! ndims for var + integer :: ndims_iod ! ndims iodesc for var + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: start(3) ! netcdf start index + integer :: count(3) ! netcdf count index + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer , pointer :: idata(:) ! Temporary integer data to send to file + integer , pointer :: compDOF(:) + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_1d_logical' ! subroutine name + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if (105==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid,clmlevel,vardesc,start,count) + if (trim(clmlevel) == grlnd) then + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + else + n=1 + if (present(nt)) then + n=2 + start(2) = nt ; count(2) = 1 + end if + end if +#if (105==TYPELOGICAL) + allocate(idata(size(data))) + status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) +#endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (105==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_logical, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (105==TYPELOGICAL) + allocate(idata(size(data))) + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) +#endif + end if + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if (105==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_logical, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if (105==TYPELOGICAL) + allocate( idata(size(data)) ) + where( data ) + idata = 1 + elsewhere + idata = 0 + end where + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) + deallocate( idata ) +#elif (105==TYPEINT) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) +#elif (105==TYPEDOUBLE) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) +#endif + else + + if (masterproc) then + write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + +# 1493 "ncdio_pio.F90.in" + end subroutine ncd_io_1d_logical + + !----------------------------------------------------------------------- + + !TYPE int,double +# 1498 "ncdio_pio.F90.in" + subroutine ncd_io_2d_int(varname, data, dim1name, lowerb2, upperb2, & + flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 2d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer(i4) , pointer :: data(:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output + logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! !LOCAL VARIABLES: +#if (103==TYPEINT) + integer , pointer :: temp(:,:) +#else + real(r8), pointer :: temp(:,:) +#endif + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n,i,j ! indices + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(4) ! netcdf start index + integer :: count(4) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + integer :: lb1,lb2 + integer :: ub1,ub2 + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_2d_int' ! subroutine name + !----------------------------------------------------------------------- + + start(:)=0 + count(:)=0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if (103==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + lb1 = lbound(data, dim=1) + ub1 = ubound(data, dim=1) + lb2 = lbound(data, dim=2) + ub2 = ubound(data, dim=2) + + if (present(switchdim)) then + if (present(lowerb2)) lb2 = lowerb2 + if (present(upperb2)) ub2 = upperb2 + allocate(temp(lb2:ub2,lb1:ub1)) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2) + n=3 + if (present(nt)) then + start(4) = nt; count(4) = 1 + n=4 + end if + else + count(2) = size(data,dim=2) + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + end if + if (present(switchdim)) then + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if +#if (103!=TYPEINT) + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( data(i,j) == spval )then + data(i,j) = nan + end if + end do + end do + end if +#endif + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + do j = lb2,ub2 + do i = lb1,ub1 + temp(j,i) = data(i,j) + end do + end do + end if +#if (103==TYPEINT) + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=0) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) + end if +#else + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) + end if + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( isnan(data(i,j)) )then + data(i,j) = spval + end if + end do + end do + end if +#endif + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + if (present(switchdim)) then + deallocate(temp) + end if + +# 1728 "ncdio_pio.F90.in" + end subroutine ncd_io_2d_int + !TYPE int,double +# 1498 "ncdio_pio.F90.in" + subroutine ncd_io_2d_double(varname, data, dim1name, lowerb2, upperb2, & + flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 2d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + real(r8) , pointer :: data(:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output + logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! !LOCAL VARIABLES: +#if (102==TYPEINT) + integer , pointer :: temp(:,:) +#else + real(r8), pointer :: temp(:,:) +#endif + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n,i,j ! indices + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(4) ! netcdf start index + integer :: count(4) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + integer :: lb1,lb2 + integer :: ub1,ub2 + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_2d_double' ! subroutine name + !----------------------------------------------------------------------- + + start(:)=0 + count(:)=0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if (102==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + lb1 = lbound(data, dim=1) + ub1 = ubound(data, dim=1) + lb2 = lbound(data, dim=2) + ub2 = ubound(data, dim=2) + + if (present(switchdim)) then + if (present(lowerb2)) lb2 = lowerb2 + if (present(upperb2)) ub2 = upperb2 + allocate(temp(lb2:ub2,lb1:ub1)) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2) + n=3 + if (present(nt)) then + start(4) = nt; count(4) = 1 + n=4 + end if + else + count(2) = size(data,dim=2) + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + end if + if (present(switchdim)) then + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if +#if (102!=TYPEINT) + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( data(i,j) == spval )then + data(i,j) = nan + end if + end do + end do + end if +#endif + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + do j = lb2,ub2 + do i = lb1,ub1 + temp(j,i) = data(i,j) + end do + end do + end if +#if (102==TYPEINT) + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=0) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) + end if +#else + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) + end if + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( isnan(data(i,j)) )then + data(i,j) = spval + end if + end do + end do + end if +#endif + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + if (present(switchdim)) then + deallocate(temp) + end if + +# 1728 "ncdio_pio.F90.in" + end subroutine ncd_io_2d_double + + !----------------------------------------------------------------------- + + !TYPE int,double +# 1733 "ncdio_pio.F90.in" + subroutine ncd_io_3d_int(varname, data, dim1name, flag, ncid, nt, readvar) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 3d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer(i4) , pointer :: data(:,:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + ! + ! !LOCAL VARIABLES: + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n ! index + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(5) ! netcdf start index + integer :: count(5) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_3d_int' ! subroutine name + !----------------------------------------------------------------------- + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 + count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2); + count(4) = size(data,dim=3) + n=4 + if (present(nt)) then + start(5) = nt + count(5) = 1 + n=5 + end if + else + count(2) = size(data,dim=2) + count(3) = size(data,dim=3) + n=3 + if (present(nt)) then + start(4) = nt + count(4) = 1 + n=4 + end if + end if + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_int, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + +# 1863 "ncdio_pio.F90.in" + end subroutine ncd_io_3d_int + !TYPE int,double +# 1733 "ncdio_pio.F90.in" + subroutine ncd_io_3d_double(varname, data, dim1name, flag, ncid, nt, readvar) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 3d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + real(r8) , pointer :: data(:,:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + ! + ! !LOCAL VARIABLES: + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n ! index + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(5) ! netcdf start index + integer :: count(5) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_3d_double' ! subroutine name + !----------------------------------------------------------------------- + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 + count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2); + count(4) = size(data,dim=3) + n=4 + if (present(nt)) then + start(5) = nt + count(5) = 1 + n=5 + end if + else + count(2) = size(data,dim=2) + count(3) = size(data,dim=3) + n=3 + if (present(nt)) then + start(4) = nt + count(4) = 1 + n=4 + end if + end if + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_double, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + +# 1863 "ncdio_pio.F90.in" + end subroutine ncd_io_3d_double + + !------------------------------------------------------------------------ + +# 1867 "ncdio_pio.F90.in" + subroutine scam_field_offsets( ncid, dim1name, vardesc, start, count, & + found, posNOTonfile) + ! + ! !DESCRIPTION: + ! Read/Write initial data from/to netCDF instantaneous initial data file + ! + ! !USES: + use clm_varctl, only: scmlon,scmlat,single_column + use shr_scam_mod, only: shr_scam_getCloseLatLon + use shr_string_mod, only: shr_string_toLower + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: dim1name ! dimension 1 name + type(Var_desc_t) , intent(inout) :: vardesc ! variable descriptor + integer , intent(out) :: start(:) ! start index + integer , intent(out) :: count(:) ! count to retrieve + logical, optional , intent(out) :: found ! if present return true if found + ! dimensions on file else false if NOT present abort if can't find + logical, optional , intent(in) :: posNOTonfile ! Position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: cc,i,ii ! index variable + integer :: data_offset ! offset into land array 1st column + integer :: ndata ! number of column (or pft points to read) + real(r8) , pointer :: cols1dlon(:) ! holds cols1d_ixy var + real(r8) , pointer :: cols1dlat(:) ! holds cols1d_jxy var + real(r8) , pointer :: pfts1dlon(:) ! holds pfts1d_ixy var + real(r8) , pointer :: pfts1dlat(:) ! holds pfts1d_jxy var + real(r8) , pointer :: land1dlon(:) ! holds land1d_ixy var + real(r8) , pointer :: land1dlat(:) ! holds land1d_jxy var + integer, allocatable :: cols(:) ! grid cell columns for scam + integer, allocatable :: pfts(:) ! grid cell pfts for scam + integer, allocatable :: landunits(:) ! grid cell landunits for scam + integer, allocatable :: dids(:) ! dim ids + integer :: varid ! netCDF variable id + integer :: status ! return code + integer :: latidx,lonidx ! latitude/longitude indices + real(r8) :: closelat,closelon ! closest latitude and longitude indices + integer :: ndims,dimlen ! number of dimensions in desired variable + character(len=32) :: dimname ! dimension name + character(len=32) :: subname = 'scam_field_offsets' + !------------------------------------------------------------------------ + + start(:)=1 + count(:)=1 + + if ( present(posNOTonfile) )then + if ( posNOTonfile )then + if ( .not. present(found) )then +# 1917 "ncdio_pio.F90.in" + call shr_sys_abort('ERROR: Bad subroutine calling structure posNOTonfile sent, but found was NOT!'//& + errMsg(__FILE__, __LINE__)) + end if + found = .false. + return + end if + end if + + ! find closest land grid cell for this point + + if ( present(found) )then + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx,found) + if ( .not. found ) return + else + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + end if + + call ncd_inqvdims(ncid,ndims,vardesc) + + allocate(dids(ndims)) + status = pio_inq_vardimid(ncid, vardesc, dids) + do i = 1,ndims + status = pio_inq_dimname(ncid,dids(i),dimname) + dimname=shr_string_toLower(dimname) + status = pio_inq_dimlen(ncid,dids(i),dimlen) + if ( trim(dimname)=='nj'.or. trim(dimname)=='lat'.or. trim(dimname)=='lsmlat') then + start(i)=latidx + count(i)=1 + else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then + start(i)=lonidx + count(i)=1 + else if ( trim(dimname)=='column') then + + allocate (cols1dlon(dimlen)) + allocate (cols1dlat(dimlen)) + allocate (cols(dimlen)) + + status = pio_inq_varid(ncid, 'cols1d_lon', varid) + status = pio_get_var(ncid, varid, cols1dlon) + status = pio_inq_varid(ncid, 'cols1d_lat', varid) + status = pio_get_var(ncid, varid, cols1dlat) + + cols(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (cols1dlon(cc) == closelon.and.cols1dlat(cc) == closelat) then + cols(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any columns for this latitude ',latidx,' and longitude ',lonidx + call shr_sys_abort('ERROR:: no columns for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=cols(1) + end if + + deallocate (cols1dlon) + deallocate (cols1dlat) + deallocate (cols) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='pft') then + + allocate (pfts1dlon(dimlen)) + allocate (pfts1dlat(dimlen)) + allocate (pfts(dimlen)) + + status = pio_inq_varid(ncid, 'pfts1d_lon', varid) + status = pio_get_var(ncid, varid, pfts1dlon) + + status = pio_inq_varid(ncid, 'pfts1d_lat', varid) + status = pio_get_var(ncid, varid, pfts1dlat) + + pfts(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (pfts1dlon(cc) == closelon.and.pfts1dlat(cc) == closelat) then + pfts(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any pfts for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no PFTs for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=pfts(1) + end if + + deallocate (pfts1dlon) + deallocate (pfts1dlat) + deallocate (pfts) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='landunit') then + + allocate (land1dlon(dimlen)) + allocate (land1dlat(dimlen)) + allocate (landunits(dimlen)) + + status = pio_inq_varid(ncid, 'land1d_lon', varid) + status = pio_get_var(ncid, varid, land1dlon) + + status = pio_inq_varid(ncid, 'land1d_lat', varid) + status = pio_get_var(ncid, varid, land1dlat) + + landunits(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (land1dlon(cc) == closelon.and.land1dlat(cc) == closelat) then + landunits(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any landunits for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no landunits for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=landunits(1) + end if + + deallocate (land1dlon) + deallocate (land1dlat) + deallocate (landunits) + + start(i) = data_offset + count(i) = ndata + else + start(i)=1 + count(i)=dimlen + end if + enddo + deallocate(dids) + +# 2062 "ncdio_pio.F90.in" + end subroutine scam_field_offsets + + !------------------------------------------------------------------------ + +# 2066 "ncdio_pio.F90.in" + subroutine ncd_getiodesc(ncid, clmlevel, ndims, dims, dimids, & + xtype, iodnum, switchdim) + ! + ! !DESCRIPTION: + ! Returns an index to an io descriptor + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=8) , intent(in) :: clmlevel ! clmlevel + integer , intent(in) :: ndims ! ndims for var + integer , intent(in) :: dims(:) ! dim sizes + integer , intent(in) :: dimids(:) ! dim ids + integer , intent(in) :: xtype ! file external type + integer , intent(out) :: iodnum ! iodesc num in list + logical,optional , intent(in) :: switchdim ! switch level dimension and first dim + ! + ! !LOCAL VARIABLES: + integer :: k,m,n,cnt ! indices + integer :: basetype ! pio basetype + integer :: gsmap_lsize ! local size of gsmap + integer :: gsmap_gsize ! global size of gsmap + integer :: fullsize ! size of entire array on cdf + integer :: gsize ! global size of clmlevel + integer :: vsize ! other dimensions + integer :: vsize1, vsize2 ! other dimensions + integer :: status ! error status + logical :: found ! true => found created iodescriptor + integer :: ndims_file ! temporary + character(len=64) dimname_file ! dimension name on file + character(len=64) dimname_iodesc ! dimension name from io descriptor + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmOP ! gsmap ordered points + integer(pio_offset_kind), pointer :: compDOF(:) + character(len=32) :: subname = 'ncd_getiodesc' + !------------------------------------------------------------------------ + + ! Determining if need to create a new io descriptor + n = 1 + found = .false. + do while (n <= num_iodesc .and. .not.found) + if (ndims == iodesc_list(n)%ndims .and. xtype == iodesc_list(n)%type) then + found = .true. + ! First found implies that dimension sizes are the same + do m = 1,ndims + if (dims(m) /= iodesc_list(n)%dims(m)) then + found = .false. + endif + enddo + ! If found - then also check that dimension names are equal - + ! dimension ids in iodescriptor are only used to query dimension + ! names associated with that iodescriptor + if (found) then + status = PIO_inquire(ncid, ndimensions=ndims_file) + do m = 1,ndims + status = PIO_inq_dimname(ncid,dimids(m),dimname_file) + if (iodesc_list(n)%dimids(m) > ndims_file) then + found = .false. + exit + else + status = PIO_inq_dimname(ncid,iodesc_list(n)%dimids(m),dimname_iodesc) + if (trim(dimname_file) /= trim(dimname_iodesc)) then + found = .false. + exit + end if + end if + end do + end if + if (found) then + iodnum = n + if (iodnum > num_iodesc) then + write(iulog,*) trim(subname),' ERROR: iodnum out of range ',iodnum,num_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + RETURN + endif + endif + n = n + 1 + enddo + + ! Creating a new io descriptor + + if (ndims > 0) then + num_iodesc = num_iodesc + 1 + if (num_iodesc > max_iodesc) then + write(iulog,*) trim(subname),' ERROR num_iodesc gt max_iodesc ',max_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + iodnum = num_iodesc + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' creating iodesc at iodnum,ndims,dims(1:ndims),xtype',& + iodnum,ndims,dims(1:ndims),xtype + endif + end if + + if (xtype == pio_double ) then + basetype = PIO_DOUBLE + else if (xtype == pio_real) then + basetype = PIO_DOUBLE + else if (xtype == pio_int) then + basetype = PIO_INT + else + write(iulog,*) trim(subname),'ERROR: no match for xtype = ',xtype + call shr_sys_abort(errMsg(__FILE__,__LINE__)) + end if + + call get_clmlevel_gsmap(clmlevel,gsmap) + gsize = get_clmlevel_gsize(clmlevel) + gsmap_lsize = mct_gsmap_lsize(gsmap,mpicom) + gsmap_gsize = mct_gsmap_gsize(gsmap) + + call mct_gsmap_OP(gsmap,iam,gsmOP) + + fullsize = 1 + do n = 1,ndims + fullsize = fullsize*dims(n) + enddo + + vsize = fullsize / gsize + if (mod(fullsize,gsize) /= 0) then + write(iulog,*) subname,' ERROR in vsize ',fullsize,gsize,vsize + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + allocate(compDOF(gsmap_lsize*vsize)) + + if (present(switchdim)) then + if (switchdim) then + cnt = 0 + do m = 1,gsmap_lsize + do n = 1,vsize + cnt = cnt + 1 + compDOF(cnt) = (gsmOP(m)-1)*vsize + n + enddo + enddo + else + write(iulog,*) subname,' ERROR switch dims present must have switchdim true' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + else ! currently allow for up to two vertical dimensions + if (vsize /= 1 .and. vsize /= dims(ndims)) then + vsize1 = vsize/dims(ndims) + vsize2 = dims(ndims) + if (vsize1*vsize2 /= vsize) then + write(iulog,*)'vsize1= ',vsize1,' vsize2= ',vsize2,' vsize= ',vsize + call shr_sys_abort('error in vsize1 and vsize2 computation'//errMsg(__FILE__, __LINE__)) + end if + cnt = 0 + do k = 1,vsize2 + do n = 1,vsize1 + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (k-1)*vsize1*gsmap_gsize + (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end do + else + cnt = 0 + do n = 1,vsize + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end if + end if + + if (debug > 1) then + do m = 0,npes-1 + if (iam == m) then + write(iulog,*) trim(subname),' sizes1 = ',iam,gsize,gsmap_gsize,gsmap_lsize + write(iulog,*) trim(subname),' sizes2 = ',iam,fullsize,npes,vsize + write(iulog,*) trim(subname),' compDOF = ',iam,size(compDOF),minval(compDOF),maxval(compDOF) + call shr_sys_flush(iulog) + endif + call mpi_barrier(mpicom,status) + enddo + endif + + deallocate(gsmOP) + +! call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_BOX) + call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_SUBSET) + + + deallocate(compDOF) + + iodesc_list(iodnum)%type = xtype + iodesc_list(iodnum)%ndims = ndims + iodesc_list(iodnum)%dims = 0 + iodesc_list(iodnum)%dims(1:ndims) = dims(1:ndims) + iodesc_list(iodnum)%dimids(1:ndims) = dimids(1:ndims) + +# 2258 "ncdio_pio.F90.in" + end subroutine ncd_getiodesc + +end module ncdio_pio diff --git a/components/clm/src_clm40/main/ncdio_pio.F90.in b/components/clm/src_clm40/main/ncdio_pio.F90.in new file mode 100644 index 0000000000..dc74d137c6 --- /dev/null +++ b/components/clm/src_clm40/main/ncdio_pio.F90.in @@ -0,0 +1,2260 @@ +module ncdio_pio + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: ncdio_pioMod + ! + ! !DESCRIPTION: + ! Generic interfaces to write fields to netcdf files for CLM + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl + use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getunit, shr_file_freeunit + use shr_string_mod , only : shr_string_toUpper + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : masterproc, mpicom, iam, npes + use spmdMod , only : MPI_REAL8, MPI_INTEGER, MPI_LOGICAL + use clmtype , only : grlnd, nameg, namel, namec, namep + use clm_varcon , only : spval,ispval + use clm_varctl , only : single_column, iulog + use shr_sys_mod , only : shr_sys_flush + use decompMod , only : get_clmlevel_gsize,get_clmlevel_gsmap + use perf_mod , only : t_startf, t_stopf + use fileutils , only : getavu, relavu + use mct_mod , only : mct_gsMap, mct_gsMap_lsize, mct_gsMap_gsize, mct_gsMap_OP + use pio , only : file_desc_t, io_desc_t, iosystem_desc_t, pio_64bit_offset + use pio , only : pio_bcast_error, pio_char, pio_clobber, pio_closefile, pio_createfile, pio_def_dim + use pio , only : pio_def_var, pio_double, pio_enddef, pio_get_att, pio_get_var, pio_global, pio_initdecomp + use pio , only : pio_inq_att, pio_inq_dimid, pio_inq_dimlen, pio_inq_dimname, pio_inq_vardimid, pio_inq_varid + use pio , only : pio_inq_varname, pio_inq_varndims, pio_inquire, pio_int, pio_internal_error + use pio , only : pio_noclobber, pio_noerr, pio_nofill, pio_nowrite, pio_offset_kind, pio_openfile + use pio , only : pio_put_att, pio_put_var, pio_read_darray, pio_real, pio_seterrorhandling + use pio , only : pio_setframe, pio_unlimited, pio_write, pio_write_darray, var_desc_t + use pio , only : pio_iotask_rank, PIO_REARR_SUBSET, PIO_REARR_BOX + ! + ! !PUBLIC TYPES: + implicit none + private + save + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public :: check_var ! determine if variable is on netcdf file + public :: check_att ! check if attribute is on file + public :: check_dim ! validity check on dimension + public :: ncd_pio_openfile ! open a file + public :: ncd_pio_createfile ! create a new file + public :: ncd_pio_closefile ! close a file + public :: ncd_pio_init ! called from clm_comp + public :: ncd_enddef ! end define mode + public :: ncd_putatt ! put attribute + public :: ncd_getatt ! get attribute + public :: ncd_defdim ! define dimension + public :: ncd_inqdid ! inquire dimension id + public :: ncd_inqdname ! inquire dimension name + public :: ncd_inqdlen ! inquire dimension length + public :: ncd_inqfdims ! inquire file dimnesions + public :: ncd_defvar ! define variables + public :: ncd_inqvid ! inquire variable id + public :: ncd_inqvname ! inquire variable name + public :: ncd_inqvdims ! inquire variable ndims + public :: ncd_inqvdids ! inquire variable dimids + public :: ncd_inqvdlen ! inquire variable dimension size + public :: ncd_io ! write local data + + integer,parameter,public :: ncd_int = pio_int + integer,parameter,public :: ncd_log =-pio_int + integer,parameter,public :: ncd_float = pio_real + integer,parameter,public :: ncd_double = pio_double + integer,parameter,public :: ncd_char = pio_char + integer,parameter,public :: ncd_global = pio_global + integer,parameter,public :: ncd_write = pio_write + integer,parameter,public :: ncd_nowrite = pio_nowrite + integer,parameter,public :: ncd_clobber = pio_clobber + integer,parameter,public :: ncd_noclobber = pio_noclobber + integer,parameter,public :: ncd_nofill = pio_nofill + integer,parameter,public :: ncd_unlimited = pio_unlimited + + ! PIO types needed for ncdio_pio interface calls + public file_desc_t + public var_desc_t + + ! + ! !PRIVATE MEMBER FUNCTIONS: + ! + interface ncd_defvar + module procedure ncd_defvar_bynf + module procedure ncd_defvar_bygrid + end interface + + interface ncd_putatt + module procedure ncd_putatt_int + module procedure ncd_putatt_real + module procedure ncd_putatt_char + end interface + + interface ncd_getatt + module procedure ncd_getatt_char + end interface ncd_getatt + + interface ncd_io + module procedure ncd_io_char_var0_start_glob + + !DIMS 0,1 + module procedure ncd_io_{DIMS}d_log_glob + + !DIMS 0,1,2,3 + !TYPE int,double + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + !DIMS 0,1,2 + !TYPE text + module procedure ncd_io_{DIMS}d_{TYPE}_glob + + !TYPE int,double + !DIMS 1,2,3 + module procedure ncd_io_{DIMS}d_{TYPE} + + !TYPE logical + !DIMS 1 + module procedure ncd_io_{DIMS}d_{TYPE} + end interface + + interface ncd_inqvdlen + module procedure ncd_inqvdlen_byDesc + module procedure ncd_inqvdlen_byName + end interface + + private :: ncd_getiodesc ! obtain iodesc + private :: scam_field_offsets ! get offset to proper lat/lon gridcell for SCAM + + integer,parameter,private :: debug = 0 ! local debug level + + integer , parameter , public :: max_string_len = 256 ! length of strings + real(r8), parameter , public :: fillvalue = 1.e36_r8 ! fill value for netcdf fields + + integer, public :: io_type + + type(iosystem_desc_t), pointer, public :: pio_subsystem + + type iodesc_plus_type + character(len=64) :: name + type(IO_desc_t) :: iodesc + integer :: type + integer :: ndims + integer :: dims(4) + integer :: dimids(4) + end type iodesc_plus_type + integer,parameter ,private :: max_iodesc = 100 + integer ,private :: num_iodesc = 0 + type(iodesc_plus_type) ,private, target :: iodesc_list(max_iodesc) + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine ncd_pio_init() + ! + ! !DESCRIPTION: + ! Initial PIO + ! + ! !USES: + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype + use clm_varctl , only : inst_name + !----------------------------------------------------------------------- + + PIO_subsystem => shr_pio_getiosys(inst_name) + io_type = shr_pio_getiotype(inst_name) + + end subroutine ncd_pio_init + + !----------------------------------------------------------------------- + subroutine ncd_pio_openfile(file, fname, mode) + ! + ! !DESCRIPTION: + ! Open a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: file ! Output PIO file handle + character(len=*) , intent(in) :: fname ! Input filename to open + integer , intent(in) :: mode ! file mode + ! + ! !LOCAL VARIABLES: + integer :: ierr + !----------------------------------------------------------------------- + + ierr = pio_openfile(pio_subsystem, file, io_type, fname, mode) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort('ncd_pio_openfile ERROR: Failed to open file') + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened existing file ', trim(fname), file%fh + end if + + end subroutine ncd_pio_openfile + + !----------------------------------------------------------------------- + subroutine ncd_pio_closefile(file) + ! + ! !DESCRIPTION: + ! Close a NetCDF PIO file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file handle to close + !----------------------------------------------------------------------- + + call pio_closefile(file) + + end subroutine ncd_pio_closefile + + !----------------------------------------------------------------------- + subroutine ncd_pio_createfile(file, fname) + ! + ! !DESCRIPTION: + ! Create a new NetCDF file with PIO + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: file ! PIO file descriptor + character(len=*) , intent(in) :: fname ! File name to create + ! + ! !LOCAL VARIABLES: + integer :: ierr + !----------------------------------------------------------------------- + + ierr = pio_createfile(pio_subsystem, file, io_type, fname, ior(PIO_CLOBBER,PIO_64BIT_OFFSET)) + + if(ierr/= PIO_NOERR) then + call shr_sys_abort( ' ncd_pio_createfile ERROR: Failed to open file to write: '//trim(fname)) + else if(pio_iotask_rank(pio_subsystem)==0) then + write(iulog,*) 'Opened file ', trim(fname), ' to write', file%fh + end if + + end subroutine ncd_pio_createfile + + !----------------------------------------------------------------------- + subroutine check_var(ncid, varname, vardesc, readvar, print_err ) + ! + ! !DESCRIPTION: + ! Check if variable is on netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=*) , intent(in) :: varname ! Varible name to check + type(Var_desc_t) , intent(out) :: vardesc ! Output variable descriptor + logical , intent(out) :: readvar ! If variable exists or not + logical, optional , intent(in) :: print_err ! If should print about error + ! + ! !LOCAL VARIABLES: + integer :: ret ! return value + logical :: log_err ! if should log error + character(len=*),parameter :: subname='check_var' ! subroutine name + !----------------------------------------------------------------------- + + + if ( present(print_err) )then + log_err = print_err + else + log_err = .true. + end if + readvar = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid (ncid, varname, vardesc) + if (ret /= PIO_noerr) then + readvar = .false. + if (masterproc .and. log_err) & + write(iulog,*) subname//': variable ',trim(varname),' is not on dataset' + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + end subroutine check_var + + !----------------------------------------------------------------------- + subroutine check_att(ncid, varid, attrib, att_found) + ! + ! !DESCRIPTION: + ! Check if attribute is on file + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + logical ,intent(out) :: att_found ! true if the attribute was found + ! + ! !LOCAL VARIABLES: + integer :: att_type ! attribute type + integer(pio_offset_kind) :: att_len ! attribute length + integer :: status + + character(len=*), parameter :: subname = 'check_att' + !----------------------------------------------------------------------- + + att_found = .true. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + status = PIO_inq_att(ncid, varid, trim(attrib), att_type, att_len) + if (status /= PIO_noerr) then + att_found = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + end subroutine check_att + + !----------------------------------------------------------------------- + subroutine check_dim(ncid, dimname, value) + ! + ! !DESCRIPTION: + ! Validity check on dimension + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! PIO file handle + character(len=*) , intent(in) :: dimname ! Dimension name + integer, intent(in) :: value ! Expected dimension size + ! + ! !LOCAL VARIABLES: + integer :: dimid, dimlen ! temporaries + integer :: status ! error code + character(len=*),parameter :: subname='check_dim' ! subroutine name + !----------------------------------------------------------------------- + + status = pio_inq_dimid (ncid, trim(dimname), dimid) + status = pio_inq_dimlen (ncid, dimid, dimlen) + if (dimlen /= value) then + write(iulog,*) subname//' ERROR: mismatch of input dimension ',dimlen, & + ' with expected value ',value,' for variable ',trim(dimname) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + + end subroutine check_dim + + !----------------------------------------------------------------------- + subroutine ncd_enddef(ncid) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + ! + ! !LOCAL VARIABLES: + integer :: status ! error status + !----------------------------------------------------------------------- + + status = PIO_enddef(ncid) + + end subroutine ncd_enddef + + !----------------------------------------------------------------------- + subroutine ncd_inqdid(ncid,name,dimid,dimexist) + ! + ! !DESCRIPTION: + ! inquire on a dimension id + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! dimension name + integer , intent(out):: dimid ! dimension id + logical,optional , intent(out):: dimexist ! if this dimension exists or not + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(dimexist) )then + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + end if + status = PIO_inq_dimid(ncid,name,dimid) + if ( present(dimexist) )then + if ( status == PIO_NOERR)then + dimexist = .true. + else + dimexist = .false. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + end if + + end subroutine ncd_inqdid + + !----------------------------------------------------------------------- + subroutine ncd_inqdlen(ncid,dimid,len,name) + ! + ! !DESCRIPTION: + ! enddef netcdf file + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(inout) :: dimid ! dimension id + integer , intent(out) :: len ! dimension len + character(len=*), optional, intent(in) :: name ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + if ( present(name) )then + call ncd_inqdid(ncid,name,dimid) + end if + len = -1 + status = PIO_inq_dimlen(ncid,dimid,len) + + end subroutine ncd_inqdlen + + !----------------------------------------------------------------------- + subroutine ncd_inqdname(ncid,dimid,dname) + ! + ! !DESCRIPTION: + ! inquire dim name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: dimid ! dimension id + character(len=*) , intent(out):: dname ! dimension name + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_inq_dimname(ncid,dimid,dname) + + end subroutine ncd_inqdname + + !----------------------------------------------------------------------- + subroutine ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout):: ncid + logical , intent(out) :: isgrid2d + integer , intent(out) :: ni + integer , intent(out) :: nj + integer , intent(out) :: ns + ! + ! !LOCAL VARIABLES: + integer :: dimid ! netCDF id + integer :: ier ! error status + character(len=32) :: subname = 'ncd_inqfdims' ! subroutine name + !----------------------------------------------------------------------- + + if (single_column) then + ni = 1 + nj = 1 + ns = 1 + isgrid2d = .true. + RETURN + end if + + ni = 0 + nj = 0 + + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ier = pio_inq_dimid (ncid, 'lon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'lsmlon', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'lsmlat', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'ni', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) + ier = pio_inq_dimid (ncid, 'nj', dimid) + if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) + + ier = pio_inq_dimid (ncid, 'gridcell', dimid) + if (ier == PIO_NOERR) then + ier = pio_inq_dimlen(ncid, dimid, ni) + if (ier == PIO_NOERR) nj = 1 + end if + + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + + if (ni == 0 .or. nj == 0) then + write(iulog,*) trim(subname),' ERROR: ni,nj = ',ni,nj,' cannot be zero ' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + + if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + + ns = ni*nj + + end subroutine ncd_inqfdims + + !----------------------------------------------------------------------- + subroutine ncd_inqvid(ncid,name,varid,vardesc,readvar) + ! + ! !DESCRIPTION: + ! Inquire on a variable ID + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: name ! variable name + integer , intent(out) :: varid ! variable id + type(Var_desc_t) , intent(out) :: vardesc ! variable descriptor + logical, optional , intent(out) :: readvar ! does variable exist + ! + ! !LOCAL VARIABLES: + integer :: ret ! return code + character(len=*),parameter :: subname='ncd_inqvid' ! subroutine name + !----------------------------------------------------------------------- + + if (present(readvar)) then + readvar = .false. + call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) + ret = PIO_inq_varid(ncid,name,vardesc) + if (ret /= PIO_noerr) then + if (masterproc) write(iulog,*) subname//': variable ',trim(name),' is not on dataset' + readvar = .false. + else + readvar = .true. + end if + call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) + else + ret = PIO_inq_varid(ncid,name,vardesc) + endif + varid = vardesc%varid + + end subroutine ncd_inqvid + + !----------------------------------------------------------------------- + subroutine ncd_inqvdims(ncid,ndims,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimensions + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(out) :: ndims ! variable ndims + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + ndims = -1 + status = PIO_inq_varndims(ncid,vardesc,ndims) + + end subroutine ncd_inqvdims + + !----------------------------------------------------------------------- + subroutine ncd_inqvname(ncid,varid,vname,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable name + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + integer , intent(in) :: varid ! variable id + character(len=*) , intent(out) :: vname ! variable vname + type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + vname = '' + status = PIO_inq_varname(ncid,vardesc,vname) + + end subroutine ncd_inqvname + + !----------------------------------------------------------------------- + subroutine ncd_inqvdids(ncid,dids,vardesc) + ! + ! !DESCRIPTION: + ! inquire variable dimension ids + ! + ! !ARGUMENTS: + class(file_desc_t),intent(in) :: ncid ! netcdf file id + integer ,intent(out) :: dids(:) ! variable dids + type(Var_desc_t) ,intent(inout):: vardesc ! variable descriptor + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + dids = -1 + status = PIO_inq_vardimid(ncid,vardesc,dids) + + end subroutine ncd_inqvdids + + !----------------------------------------------------------------------- + subroutine ncd_inqvdlen_byDesc(ncid,vardesc,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a vardesc + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + type(Var_desc_t) ,intent(inout) :: vardesc ! variable descriptor + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + integer :: ndims ! number of dimensions + integer, allocatable :: dimids(:) ! dimension IDs + + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_none = 0 + integer, parameter :: error_dimnum_out_of_range = 1 + !----------------------------------------------------------------------- + + err_code = error_none + + call ncd_inqvdims(ncid, ndims, vardesc) + + if (dimnum > 0 .and. dimnum <= ndims) then + allocate(dimids(ndims)) + call ncd_inqvdids(ncid, dimids, vardesc) + call ncd_inqdlen(ncid, dimids(dimnum), dlen) + deallocate(dimids) + else + dlen = dlen_invalid + err_code = error_dimnum_out_of_range + end if + + end subroutine ncd_inqvdlen_byDesc + + + !----------------------------------------------------------------------- + subroutine ncd_inqvdlen_byName(ncid,varname,dimnum,dlen,err_code) + ! + ! !DESCRIPTION: + ! inquire size of one of a variable's dimensions, given a variable name + ! + ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine + ! returns the size of the dimnum'th dimension. + ! + ! If there is an error condition, dlen will be -1, and err_code will hold the error + ! code; possible error codes are: + ! 0: no error + ! 1: dimnum out of range + ! 11: variable not found + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) ,intent(in) :: varname ! variable name + integer ,intent(in) :: dimnum ! dimension number to query + integer ,intent(out) :: dlen ! length of the dimension + integer ,intent(out) :: err_code ! error code (0 means no error) + ! + ! !LOCAL VARIABLES: + type(Var_desc_t) :: vardesc ! variable descriptor + logical :: readvar ! whether the variable was found + integer, parameter :: dlen_invalid = -1 + integer, parameter :: error_variable_not_found = 11 + !----------------------------------------------------------------------- + + call check_var(ncid, varname, vardesc, readvar) + if (readvar) then + call ncd_inqvdlen_byDesc(ncid, vardesc, dimnum, dlen, err_code) + else + dlen = dlen_invalid + err_code = error_variable_not_found + end if + + end subroutine ncd_inqvdlen_byName + + + !----------------------------------------------------------------------- + subroutine ncd_putatt_int(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put integer attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + integer ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_putatt_int + + !----------------------------------------------------------------------- + subroutine ncd_putatt_char(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put character attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(in) :: value ! netcdf attrib value + integer,optional ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = PIO_put_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_putatt_char + + !----------------------------------------------------------------------- + subroutine ncd_putatt_real(ncid,varid,attrib,value,xtype) + ! + ! !DESCRIPTION: + ! put real attributes + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + real(r8) ,intent(in) :: value ! netcdf attrib value + integer ,intent(in) :: xtype ! netcdf data type + ! + ! !LOCAL VARIABLES: + integer :: status + real*4 :: value4 + !----------------------------------------------------------------------- + + value4 = value + + if (xtype == pio_double) then + status = PIO_put_att(ncid,varid,trim(attrib),value) + else + status = PIO_put_att(ncid,varid,trim(attrib),value4) + endif + + end subroutine ncd_putatt_real + + !----------------------------------------------------------------------- + subroutine ncd_getatt_char(ncid,varid,attrib,value) + ! + ! !DESCRIPTION: + ! get a character attribute + ! + ! !USES: + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + integer ,intent(in) :: varid ! netcdf var id + character(len=*) ,intent(in) :: attrib ! netcdf attrib + character(len=*) ,intent(out) :: value ! netcdf attrib value + ! + ! !LOCAL VARIABLES: + integer :: status + + character(len=*), parameter :: subname = 'ncd_getatt_char' + !----------------------------------------------------------------------- + + status = PIO_get_att(ncid,varid,trim(attrib),value) + + end subroutine ncd_getatt_char + + + !----------------------------------------------------------------------- + subroutine ncd_defdim(ncid,attrib,value,dimid) + ! + ! !DESCRIPTION: + ! define dimension + ! + ! !ARGUMENTS: + class(file_desc_t), intent(in) :: ncid ! netcdf file id + character(len=*) , intent(in) :: attrib ! netcdf attrib + integer , intent(in) :: value ! netcdf attrib value + integer , intent(out):: dimid ! netcdf dimension id + ! + ! !LOCAL VARIABLES: + integer :: status + !----------------------------------------------------------------------- + + status = pio_def_dim(ncid,attrib,value,dimid) + + end subroutine ncd_defdim + + !----------------------------------------------------------------------- + subroutine ncd_defvar_bynf(ncid, varname, xtype, ndims, dimid, varid, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, comment, flag_meanings, & + flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + integer , intent(in) :: ndims ! number of dims + integer , intent(inout) :: varid ! returned var id + integer , intent(in), optional :: dimid(:) ! dimids + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ldimid(4) ! local dimid + integer :: dimid0(1) ! local dimid + integer :: status ! error status + integer :: lxtype ! local external type (in case logical variable) + type(var_desc_t) :: vardesc ! local vardesc + character(len=128) :: dimname ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bynf' ! subroutine name + !----------------------------------------------------------------------- + + varid = -1 + + dimid0 = 0 + ldimid = 0 + if (present(dimid)) then + ldimid(1:ndims) = dimid(1:ndims) + else ! ndims must be zero if dimid not present + if (ndims /= 0) then + write(iulog,*) subname//' ERROR: dimid not supplied and ndims ne 0 ',trim(varname),ndims + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + endif + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + if (masterproc .and. debug > 1) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + write(iulog,*) subname//' ',trim(varname),lxtype,ndims,ldimid(1:ndims) + endif + + if (ndims > 0) then + status = pio_inq_dimname(ncid,ldimid(ndims),dimname) + end if + + ! Define variable + if (present(dimid)) then + status = PIO_def_var(ncid,trim(varname),lxtype,dimid(1:ndims),vardesc) + else + status = PIO_def_var(ncid,trim(varname),lxtype,dimid0 ,vardesc) + endif + varid = vardesc%varid + + ! + ! Add attributes + ! + if (present(long_name)) then + call ncd_putatt(ncid, varid, 'long_name', trim(long_name)) + end if + if (present(flag_values)) then + status = PIO_put_att(ncid,varid,'flag_values',flag_values) + if ( .not. present(flag_meanings)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_values set -- but not flag_meanings"//errMsg(__FILE__, __LINE__)) + end if + end if + if (present(flag_meanings)) then + if ( .not. present(flag_values)) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings set -- but not flag_values"//errMsg(__FILE__, __LINE__) ) + end if + if ( size(flag_values) /= size(flag_meanings) ) then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings and flag_values dimension different"//errMsg(__FILE__, __LINE__)) + end if + str = flag_meanings(1) + do n = 1, size(flag_meanings) + if ( index(flag_meanings(n), ' ') /= 0 )then + write(iulog,*) 'Error in defining variable = ', trim(varname) + call shr_sys_abort(" ERROR:: flag_meanings has an invalid space in it"//errMsg(__FILE__, __LINE__) ) + end if + if ( n > 1 ) str = trim(str)//" "//flag_meanings(n) + end do + status = PIO_put_att(ncid,varid,'flag_meanings', trim(str) ) + end if + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(cell_method)) then + str = 'time: ' // trim(cell_method) + call ncd_putatt(ncid, varid, 'cell_methods', trim(str)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + end subroutine ncd_defvar_bynf + + !----------------------------------------------------------------------- + subroutine ncd_defvar_bygrid(ncid, varname, xtype, & + dim1name, dim2name, dim3name, dim4name, dim5name, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value, switchdim, comment, & + flag_meanings, flag_values, nvalid_range ) + ! + ! !DESCRIPTION: + ! Define a netcdf variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: dim3name ! dimension name + character(len=*) , intent(in), optional :: dim4name ! dimension name + character(len=*) , intent(in), optional :: dim5name ! dimension name + character(len=*) , intent(in), optional :: long_name ! attribute + character(len=*) , intent(in), optional :: units ! attribute + character(len=*) , intent(in), optional :: cell_method ! attribute + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + logical , intent(in), optional :: switchdim ! true=> permute dim1 and dim2 for output + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! !LOCAL VARIABLES: + integer :: n ! indices + integer :: ndims ! dimension counter + integer :: dimid(5) ! dimension ids + integer :: varid ! variable id + integer :: itmp ! temporary + character(len=256) :: str ! temporary + character(len=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name + !----------------------------------------------------------------------- + + dimid(:) = 0 + + ! Determine dimension ids for variable + + if (present(dim1name)) call ncd_inqdid(ncid, dim1name, dimid(1)) + if (present(dim2name)) call ncd_inqdid(ncid, dim2name, dimid(2)) + if (present(dim3name)) call ncd_inqdid(ncid, dim3name, dimid(3)) + if (present(dim4name)) call ncd_inqdid(ncid, dim4name, dimid(4)) + if (present(dim5name)) call ncd_inqdid(ncid, dim5name, dimid(5)) + + ! Permute dim1 and dim2 if necessary + + if (present(switchdim)) then + itmp = dimid(2) + dimid(2) = dimid(1) + dimid(1) = itmp + end if + + ! Define variable + + ndims = 0 + if (present(dim1name)) then + do n = 1, size(dimid) + if (dimid(n) /= 0) ndims = ndims + 1 + end do + end if + + call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & + long_name=long_name, units=units, cell_method=cell_method, & + missing_value=missing_value, fill_value=fill_value, & + imissing_value=imissing_value, ifill_value=ifill_value, & + comment=comment, flag_meanings=flag_meanings, & + flag_values=flag_values, nvalid_range=nvalid_range ) + + end subroutine ncd_defvar_bygrid + + !------------------------------------------------------------------------ + subroutine ncd_io_char_var0_start_glob(vardesc, data, flag, ncid, start ) + ! + ! !DESCRIPTION: + ! netcdf I/O of global character array with start indices input + ! + ! !ARGUMENTS: + class(file_desc_t),intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + type(var_desc_t) , intent(in) :: vardesc ! local vardesc pointer + character(len=*) , intent(inout) :: data ! raw data for this index + integer , intent(in) :: start(:) ! output bounds + ! + ! !LOCAL VARIABLES: + integer :: status ! error code + character(len=*),parameter :: subname='ncd_io_char_var0_start_glob' + !----------------------------------------------------------------------- + + if (flag == 'read') then + + status = pio_get_var(ncid, vardesc, start, data ) + + elseif (flag == 'write') then + + status = pio_put_var(ncid, vardesc, start, data ) + + endif + + end subroutine ncd_io_char_var0_start_glob + + !------------------------------------------------------------------------ + !DIMS 0,1 + subroutine ncd_io_{DIMS}d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global integer variable + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + logical , intent(inout) :: data{DIMSTR} ! raw data + logical, optional , intent(out) :: readvar ! was var read? + integer, optional , intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: varid ! netCDF variable id + integer :: start(2), count(2) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer :: idata + integer, pointer :: idata1d(:) ! Temporary integer data to send to file + character(len=32) :: vname ! variable error checking + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_{DIMS}d_log_glob' + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif +#if ({DIMS}==0) + status = pio_get_var(ncid, varid, idata) + if ( idata == 0 )then + data = .false. + else if ( idata == 1 )then + data = .true. + else + call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(__FILE__, __LINE__)) + end if +#else + allocate(idata1d(size(data))) + data = (idata1d == 1) + if ( any(idata1d /= 0 .and. idata1d /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate(idata1d) +#endif + endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + +#if ({DIMS}==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt + call ncd_inqvid (ncid, varname, varid, vardesc) + allocate(idata1d(1)) + if ( data )then + idata1d(1) = 1 + else + idata1d(1) = 0 + end if + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate(idata1d) +#else + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + allocate(idata1d(size(data))) + where( data ) + idata1d = 1 + elsewhere + idata1d = 0 + end where + call ncd_inqvid (ncid, varname, varid, vardesc) + status = pio_put_var(ncid, varid, start, count, idata1d) + deallocate( idata1d ) +#endif + + endif ! flag + + end subroutine ncd_io_{DIMS}d_log_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2,3 + !TYPE int,double + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start({DIMS}+1), count({DIMS}+1) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + logical :: found ! if true, found lat/lon dims on file + character(len=32) :: vname ! variable error checking + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + {VTYPE} :: temp(1) + character(len=*),parameter :: subname='ncd_io_{DIMS}d_{TYPE}_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + +#if ({DIMS}==0) + if (varpresent) then + status = pio_get_var(ncid, vardesc, data) + if (single_column .and. present(posNOTonfile) ) then + if ( .not. posNOTonfile )then + call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& + errMsg(__FILE__, __LINE__)) + end if + endif + end if +#else + if (varpresent) then + if (single_column) then + call scam_field_offsets(ncid,'undefined', vardesc,& + start, count, found=found, posNOTonfile=posNOTonfile) + if ( found )then + status = pio_get_var(ncid, varid, start, count, data) + else + status = pio_get_var(ncid, varid, data) + end if + else + status = pio_get_var(ncid, varid, data) + endif + endif +#endif + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = {DIMS} + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) +#if ({DIMS}==0) + start(1) = 1 ; count(1) = 1 + if (present(nt)) start(1) = nt ; count(1) = 1 + temp(1) = data + status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) +#elif ({DIMS}==1) + start(1) = 1 ; count(1) = size(data) + start(2) = 1 ; count(2) = 1 + if (present(nt)) start(2) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif ({DIMS}==2) + start(1) = 1 ; count(1) = size(data, dim=1) + start(2) = 1 ; count(2) = size(data, dim=2) + start(3) = 1 ; count(3) = 1 + if (present(nt)) start(3) = nt + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) +#elif ({DIMS}==3) + if (present(nt)) then + start(1) = 1 ; count(1) = size(data,dim=1) + start(2) = 1 ; count(2) = size(data,dim=2) + start(3) = 1 ; count(3) = size(data,dim=3) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !------------------------------------------------------------------------ + !DIMS 0,1,2 + !TYPE text + subroutine ncd_io_{DIMS}d_{TYPE}_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) + ! + ! !DESCRIPTION: + ! netcdf I/O of global variable + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*), intent(in) :: flag ! 'read' or 'write' + character(len=*), intent(in) :: varname ! variable name + {VTYPE} , intent(inout) :: data{DIMSTR} ! raw data + logical , optional, intent(out) :: readvar ! was var read? + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: m + integer :: varid ! netCDF variable id + integer :: start(4), count(4) ! output bounds + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + character(len=1) :: tmpString(128) ! temp for manipulating output string + type(var_desc_t) :: vardesc ! local vardesc pointer + character(len=*),parameter :: subname='ncd_io_{DIMS}d_{TYPE}_glob' + integer :: ndims + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + + if (varpresent) then + data = ' ' + status = pio_get_var(ncid, varid, data) + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + ndims = {DIMS} + if(present(nt)) ndims=ndims+1 + call ncd_inqvid (ncid, varname, varid, vardesc) + +#if ({DIMS}==0) + if (present(nt)) then + do m = 1,len(data) + tmpString(m:m) = data(m:m) + end do + start(1) = 1 ; count(1) = len(data) + start(2) = nt; count(2) = 1 + if ( count(1) > size(tmpString) )then + write(iulog,*) subname//' ERROR: input string size is too large:' + end if + status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) + else + status = pio_put_var(ncid, varid, data ) + end if +#elif ({DIMS}==1) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data) + start(3) = nt; count(3) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#elif ({DIMS}==2) + if (present(nt)) then + start(1) = 1 ; count(1) = len(data) + start(2) = 1 ; count(2) = size(data,dim=1) + start(3) = 1 ; count(3) = size(data,dim=2) + start(4) = nt ; count(4) = 1 + status = pio_put_var(ncid, varid, start, count, data) + else + status = pio_put_var(ncid, varid, data) + end if +#endif + + endif + + end subroutine ncd_io_{DIMS}d_{TYPE}_glob + + !----------------------------------------------------------------------- + + !TYPE int,double,logical + subroutine ncd_io_1d_{TYPE}(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! netcdf I/O for 1d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:) ! local decomposition data + character(len=*) , intent(in) :: dim1name ! dimension name + integer , optional, intent(in) :: nt ! time sample index + logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! Local Variables + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: n ! index + integer :: iodnum ! iodesc num in list + integer :: varid ! varid + integer :: ndims ! ndims for var + integer :: ndims_iod ! ndims iodesc for var + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: start(3) ! netcdf start index + integer :: count(3) ! netcdf count index + integer :: status ! error code + logical :: varpresent ! if true, variable is on tape + integer , pointer :: idata(:) ! Temporary integer data to send to file + integer , pointer :: compDOF(:) + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_1d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + start(:) = 0 + count(:) = 0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if ({ITYPE}==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid,clmlevel,vardesc,start,count) + if (trim(clmlevel) == grlnd) then + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + else + n=1 + if (present(nt)) then + n=2 + start(2) = nt ; count(2) = 1 + end if + end if +#if ({ITYPE}==TYPELOGICAL) + allocate(idata(size(data))) + status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) +#endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if ({ITYPE}==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if ({ITYPE}==TYPELOGICAL) + allocate(idata(size(data))) + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status) + data = (idata == 1) + if ( any(idata /= 0 .and. idata /= 1) )then + call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(__FILE__, __LINE__)) + end if + deallocate( idata ) +#else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) +#endif + end if + end if + if (present(readvar)) readvar = varpresent + + elseif (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo +#if ({ITYPE}==TYPELOGICAL) + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_INT, iodnum) +#else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) +#endif + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if +#if ({ITYPE}==TYPELOGICAL) + allocate( idata(size(data)) ) + where( data ) + idata = 1 + elsewhere + idata = 0 + end where + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) + deallocate( idata ) +#elif ({ITYPE}==TYPEINT) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) +#elif ({ITYPE}==TYPEDOUBLE) + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) +#endif + else + + if (masterproc) then + write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + end subroutine ncd_io_1d_{TYPE} + + !----------------------------------------------------------------------- + + !TYPE int,double + subroutine ncd_io_2d_{TYPE}(varname, data, dim1name, lowerb2, upperb2, & + flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 2d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output + logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) + ! + ! !LOCAL VARIABLES: +#if ({ITYPE}==TYPEINT) + integer , pointer :: temp(:,:) +#else + real(r8), pointer :: temp(:,:) +#endif + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n,i,j ! indices + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(4) ! netcdf start index + integer :: count(4) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + integer :: lb1,lb2 + integer :: ub1,ub2 + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_2d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + start(:)=0 + count(:)=0 + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + +#if ({ITYPE}==TYPEDOUBLE) + if ( present(cnvrtnan2fill) )then + if (.not. cnvrtnan2fill) then + call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& + errMsg(__FILE__, __LINE__)) + endif + end if +#endif + + lb1 = lbound(data, dim=1) + ub1 = ubound(data, dim=1) + lb2 = lbound(data, dim=2) + ub2 = ubound(data, dim=2) + + if (present(switchdim)) then + if (present(lowerb2)) lb2 = lowerb2 + if (present(upperb2)) ub2 = upperb2 + allocate(temp(lb2:ub2,lb1:ub1)) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 ; count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2) + n=3 + if (present(nt)) then + start(4) = nt; count(4) = 1 + n=4 + end if + else + count(2) = size(data,dim=2) + n=2 + if (present(nt)) then + start(3) = nt ; count(3) = 1 + n=3 + end if + end if + if (present(switchdim)) then + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + endif + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status) + do j = lb2,ub2 + do i = lb1,ub1 + data(i,j) = temp(j,i) + end do + end do + else + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if +#if ({ITYPE}!=TYPEINT) + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( data(i,j) == spval )then + data(i,j) = nan + end if + end do + end do + end if +#endif + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + if (present(switchdim)) then + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum, switchdim=.true.) + else + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + end if + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + if (present(switchdim)) then + do j = lb2,ub2 + do i = lb1,ub1 + temp(j,i) = data(i,j) + end do + end do + end if +#if ({ITYPE}==TYPEINT) + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=0) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=0) + end if +#else + if (present(switchdim)) then + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) + else + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) + end if + if ( present(cnvrtnan2fill) )then + do j = lb2,ub2 + do i = lb1,ub1 + if ( isnan(data(i,j)) )then + data(i,j) = spval + end if + end do + end do + end if +#endif + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + if (present(switchdim)) then + deallocate(temp) + end if + + end subroutine ncd_io_2d_{TYPE} + + !----------------------------------------------------------------------- + + !TYPE int,double + subroutine ncd_io_3d_{TYPE}(varname, data, dim1name, flag, ncid, nt, readvar) + ! + ! !DESCRIPTION: + ! Netcdf i/o of 3d + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + {VTYPE} , pointer :: data(:,:,:) ! local decomposition input data + character(len=*) , intent(in) :: dim1name ! dimension 1 name + integer, optional, intent(in) :: nt ! time sample index + logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) + ! + ! !LOCAL VARIABLES: + integer :: ndim1,ndim2 + character(len=8) :: clmlevel ! clmlevel + character(len=32) :: dimname ! temporary + integer :: status ! error status + integer :: ndims ! ndims total for var + integer :: ndims_iod ! ndims iodesc for var + integer :: varid ! varid + integer :: n ! index + integer :: dims(4) ! dim sizes + integer :: dids(4) ! dim ids + integer :: iodnum ! iodesc num in list + integer :: start(5) ! netcdf start index + integer :: count(5) ! netcdf count index + logical :: varpresent ! if true, variable is on tape + type(iodesc_plus_type) , pointer :: iodesc_plus + type(var_desc_t) :: vardesc + character(len=*),parameter :: subname='ncd_io_3d_{TYPE}' ! subroutine name + !----------------------------------------------------------------------- + + clmlevel = dim1name + + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) + end if + + if (flag == 'read') then + + call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) + if (varpresent) then + if (single_column) then + start(:) = 1 + count(:) = 1 + call scam_field_offsets(ncid, clmlevel, vardesc, start, count) + if (trim(clmlevel) == grlnd) then + count(3) = size(data,dim=2); + count(4) = size(data,dim=3) + n=4 + if (present(nt)) then + start(5) = nt + count(5) = 1 + n=5 + end if + else + count(2) = size(data,dim=2) + count(3) = size(data,dim=3) + n=3 + if (present(nt)) then + start(4) = nt + count(4) = 1 + n=4 + end if + end if + status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) + else + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) + status = pio_inq_dimname(ncid, dids(ndims), dimname) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_read_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + end if + end if + if (present(readvar)) readvar = varpresent + + else if (flag == 'write') then + + call ncd_inqvid(ncid, varname ,varid, vardesc) + status = pio_inq_varndims(ncid, vardesc, ndims) + status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) + if (ndims == 0) then + write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + status = pio_inq_dimname(ncid,dids(ndims),dimname) + if ('time' == trim(dimname)) then + ndims_iod = ndims - 1 + else + ndims_iod = ndims + end if + do n = 1,ndims_iod + status = pio_inq_dimlen(ncid,dids(n),dims(n)) + enddo + call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & + PIO_{TYPE}, iodnum) + iodesc_plus => iodesc_list(iodnum) + if (present(nt)) then + call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) + end if + call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) + + else + + if (masterproc) then + write(iulog,*) subname,' error: unsupported flag ',trim(flag) + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + endif + + end subroutine ncd_io_3d_{TYPE} + + !------------------------------------------------------------------------ + + subroutine scam_field_offsets( ncid, dim1name, vardesc, start, count, & + found, posNOTonfile) + ! + ! !DESCRIPTION: + ! Read/Write initial data from/to netCDF instantaneous initial data file + ! + ! !USES: + use clm_varctl, only: scmlon,scmlat,single_column + use shr_scam_mod, only: shr_scam_getCloseLatLon + use shr_string_mod, only: shr_string_toLower + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: dim1name ! dimension 1 name + type(Var_desc_t) , intent(inout) :: vardesc ! variable descriptor + integer , intent(out) :: start(:) ! start index + integer , intent(out) :: count(:) ! count to retrieve + logical, optional , intent(out) :: found ! if present return true if found + ! dimensions on file else false if NOT present abort if can't find + logical, optional , intent(in) :: posNOTonfile ! Position is NOT on this file + ! + ! !LOCAL VARIABLES: + integer :: cc,i,ii ! index variable + integer :: data_offset ! offset into land array 1st column + integer :: ndata ! number of column (or pft points to read) + real(r8) , pointer :: cols1dlon(:) ! holds cols1d_ixy var + real(r8) , pointer :: cols1dlat(:) ! holds cols1d_jxy var + real(r8) , pointer :: pfts1dlon(:) ! holds pfts1d_ixy var + real(r8) , pointer :: pfts1dlat(:) ! holds pfts1d_jxy var + real(r8) , pointer :: land1dlon(:) ! holds land1d_ixy var + real(r8) , pointer :: land1dlat(:) ! holds land1d_jxy var + integer, allocatable :: cols(:) ! grid cell columns for scam + integer, allocatable :: pfts(:) ! grid cell pfts for scam + integer, allocatable :: landunits(:) ! grid cell landunits for scam + integer, allocatable :: dids(:) ! dim ids + integer :: varid ! netCDF variable id + integer :: status ! return code + integer :: latidx,lonidx ! latitude/longitude indices + real(r8) :: closelat,closelon ! closest latitude and longitude indices + integer :: ndims,dimlen ! number of dimensions in desired variable + character(len=32) :: dimname ! dimension name + character(len=32) :: subname = 'scam_field_offsets' + !------------------------------------------------------------------------ + + start(:)=1 + count(:)=1 + + if ( present(posNOTonfile) )then + if ( posNOTonfile )then + if ( .not. present(found) )then + call shr_sys_abort('ERROR: Bad subroutine calling structure posNOTonfile sent, but found was NOT!'//& + errMsg(__FILE__, __LINE__)) + end if + found = .false. + return + end if + end if + + ! find closest land grid cell for this point + + if ( present(found) )then + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx,found) + if ( .not. found ) return + else + call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) + end if + + call ncd_inqvdims(ncid,ndims,vardesc) + + allocate(dids(ndims)) + status = pio_inq_vardimid(ncid, vardesc, dids) + do i = 1,ndims + status = pio_inq_dimname(ncid,dids(i),dimname) + dimname=shr_string_toLower(dimname) + status = pio_inq_dimlen(ncid,dids(i),dimlen) + if ( trim(dimname)=='nj'.or. trim(dimname)=='lat'.or. trim(dimname)=='lsmlat') then + start(i)=latidx + count(i)=1 + else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then + start(i)=lonidx + count(i)=1 + else if ( trim(dimname)=='column') then + + allocate (cols1dlon(dimlen)) + allocate (cols1dlat(dimlen)) + allocate (cols(dimlen)) + + status = pio_inq_varid(ncid, 'cols1d_lon', varid) + status = pio_get_var(ncid, varid, cols1dlon) + status = pio_inq_varid(ncid, 'cols1d_lat', varid) + status = pio_get_var(ncid, varid, cols1dlat) + + cols(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (cols1dlon(cc) == closelon.and.cols1dlat(cc) == closelat) then + cols(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any columns for this latitude ',latidx,' and longitude ',lonidx + call shr_sys_abort('ERROR:: no columns for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=cols(1) + end if + + deallocate (cols1dlon) + deallocate (cols1dlat) + deallocate (cols) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='pft') then + + allocate (pfts1dlon(dimlen)) + allocate (pfts1dlat(dimlen)) + allocate (pfts(dimlen)) + + status = pio_inq_varid(ncid, 'pfts1d_lon', varid) + status = pio_get_var(ncid, varid, pfts1dlon) + + status = pio_inq_varid(ncid, 'pfts1d_lat', varid) + status = pio_get_var(ncid, varid, pfts1dlat) + + pfts(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (pfts1dlon(cc) == closelon.and.pfts1dlat(cc) == closelat) then + pfts(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any pfts for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no PFTs for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=pfts(1) + end if + + deallocate (pfts1dlon) + deallocate (pfts1dlat) + deallocate (pfts) + + start(i) = data_offset + count(i) = ndata + else if ( trim(dimname)=='landunit') then + + allocate (land1dlon(dimlen)) + allocate (land1dlat(dimlen)) + allocate (landunits(dimlen)) + + status = pio_inq_varid(ncid, 'land1d_lon', varid) + status = pio_get_var(ncid, varid, land1dlon) + + status = pio_inq_varid(ncid, 'land1d_lat', varid) + status = pio_get_var(ncid, varid, land1dlat) + + landunits(:) = huge(1) + data_offset = huge(1) + ii = 1 + ndata = 0 + do cc = 1, dimlen + if (land1dlon(cc) == closelon.and.land1dlat(cc) == closelat) then + landunits(ii)=cc + ndata =ii + ii=ii+1 + end if + end do + if (ndata == 0) then + write(iulog,*)'couldnt find any landunits for this latitude ',closelat,' and longitude ',closelon + call shr_sys_abort('ERROR:: no landunits for this position'//errMsg(__FILE__, __LINE__)) + else + data_offset=landunits(1) + end if + + deallocate (land1dlon) + deallocate (land1dlat) + deallocate (landunits) + + start(i) = data_offset + count(i) = ndata + else + start(i)=1 + count(i)=dimlen + end if + enddo + deallocate(dids) + + end subroutine scam_field_offsets + + !------------------------------------------------------------------------ + + subroutine ncd_getiodesc(ncid, clmlevel, ndims, dims, dimids, & + xtype, iodnum, switchdim) + ! + ! !DESCRIPTION: + ! Returns an index to an io descriptor + ! + ! !ARGUMENTS: + class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor + character(len=8) , intent(in) :: clmlevel ! clmlevel + integer , intent(in) :: ndims ! ndims for var + integer , intent(in) :: dims(:) ! dim sizes + integer , intent(in) :: dimids(:) ! dim ids + integer , intent(in) :: xtype ! file external type + integer , intent(out) :: iodnum ! iodesc num in list + logical,optional , intent(in) :: switchdim ! switch level dimension and first dim + ! + ! !LOCAL VARIABLES: + integer :: k,m,n,cnt ! indices + integer :: basetype ! pio basetype + integer :: gsmap_lsize ! local size of gsmap + integer :: gsmap_gsize ! global size of gsmap + integer :: fullsize ! size of entire array on cdf + integer :: gsize ! global size of clmlevel + integer :: vsize ! other dimensions + integer :: vsize1, vsize2 ! other dimensions + integer :: status ! error status + logical :: found ! true => found created iodescriptor + integer :: ndims_file ! temporary + character(len=64) dimname_file ! dimension name on file + character(len=64) dimname_iodesc ! dimension name from io descriptor + type(mct_gsMap),pointer :: gsmap ! global seg map + integer, pointer,dimension(:) :: gsmOP ! gsmap ordered points + integer(pio_offset_kind), pointer :: compDOF(:) + character(len=32) :: subname = 'ncd_getiodesc' + !------------------------------------------------------------------------ + + ! Determining if need to create a new io descriptor + n = 1 + found = .false. + do while (n <= num_iodesc .and. .not.found) + if (ndims == iodesc_list(n)%ndims .and. xtype == iodesc_list(n)%type) then + found = .true. + ! First found implies that dimension sizes are the same + do m = 1,ndims + if (dims(m) /= iodesc_list(n)%dims(m)) then + found = .false. + endif + enddo + ! If found - then also check that dimension names are equal - + ! dimension ids in iodescriptor are only used to query dimension + ! names associated with that iodescriptor + if (found) then + status = PIO_inquire(ncid, ndimensions=ndims_file) + do m = 1,ndims + status = PIO_inq_dimname(ncid,dimids(m),dimname_file) + if (iodesc_list(n)%dimids(m) > ndims_file) then + found = .false. + exit + else + status = PIO_inq_dimname(ncid,iodesc_list(n)%dimids(m),dimname_iodesc) + if (trim(dimname_file) /= trim(dimname_iodesc)) then + found = .false. + exit + end if + end if + end do + end if + if (found) then + iodnum = n + if (iodnum > num_iodesc) then + write(iulog,*) trim(subname),' ERROR: iodnum out of range ',iodnum,num_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + RETURN + endif + endif + n = n + 1 + enddo + + ! Creating a new io descriptor + + if (ndims > 0) then + num_iodesc = num_iodesc + 1 + if (num_iodesc > max_iodesc) then + write(iulog,*) trim(subname),' ERROR num_iodesc gt max_iodesc ',max_iodesc + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + iodnum = num_iodesc + if (masterproc .and. debug > 1) then + write(iulog,*) trim(subname),' creating iodesc at iodnum,ndims,dims(1:ndims),xtype',& + iodnum,ndims,dims(1:ndims),xtype + endif + end if + + if (xtype == pio_double ) then + basetype = PIO_DOUBLE + else if (xtype == pio_real) then + basetype = PIO_DOUBLE + else if (xtype == pio_int) then + basetype = PIO_INT + else + write(iulog,*) trim(subname),'ERROR: no match for xtype = ',xtype + call shr_sys_abort(errMsg(__FILE__,__LINE__)) + end if + + call get_clmlevel_gsmap(clmlevel,gsmap) + gsize = get_clmlevel_gsize(clmlevel) + gsmap_lsize = mct_gsmap_lsize(gsmap,mpicom) + gsmap_gsize = mct_gsmap_gsize(gsmap) + + call mct_gsmap_OP(gsmap,iam,gsmOP) + + fullsize = 1 + do n = 1,ndims + fullsize = fullsize*dims(n) + enddo + + vsize = fullsize / gsize + if (mod(fullsize,gsize) /= 0) then + write(iulog,*) subname,' ERROR in vsize ',fullsize,gsize,vsize + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + endif + + allocate(compDOF(gsmap_lsize*vsize)) + + if (present(switchdim)) then + if (switchdim) then + cnt = 0 + do m = 1,gsmap_lsize + do n = 1,vsize + cnt = cnt + 1 + compDOF(cnt) = (gsmOP(m)-1)*vsize + n + enddo + enddo + else + write(iulog,*) subname,' ERROR switch dims present must have switchdim true' + call shr_sys_abort(errMsg(__FILE__, __LINE__)) + end if + else ! currently allow for up to two vertical dimensions + if (vsize /= 1 .and. vsize /= dims(ndims)) then + vsize1 = vsize/dims(ndims) + vsize2 = dims(ndims) + if (vsize1*vsize2 /= vsize) then + write(iulog,*)'vsize1= ',vsize1,' vsize2= ',vsize2,' vsize= ',vsize + call shr_sys_abort('error in vsize1 and vsize2 computation'//errMsg(__FILE__, __LINE__)) + end if + cnt = 0 + do k = 1,vsize2 + do n = 1,vsize1 + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (k-1)*vsize1*gsmap_gsize + (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end do + else + cnt = 0 + do n = 1,vsize + do m = 1,gsmap_lsize + cnt = cnt + 1 + compDOF(cnt) = (n-1)*gsmap_gsize + gsmOP(m) + enddo + enddo + end if + end if + + if (debug > 1) then + do m = 0,npes-1 + if (iam == m) then + write(iulog,*) trim(subname),' sizes1 = ',iam,gsize,gsmap_gsize,gsmap_lsize + write(iulog,*) trim(subname),' sizes2 = ',iam,fullsize,npes,vsize + write(iulog,*) trim(subname),' compDOF = ',iam,size(compDOF),minval(compDOF),maxval(compDOF) + call shr_sys_flush(iulog) + endif + call mpi_barrier(mpicom,status) + enddo + endif + + deallocate(gsmOP) + +! call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_BOX) + call pio_initdecomp(pio_subsystem, baseTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc, rearr=PIO_REARR_SUBSET) + + + deallocate(compDOF) + + iodesc_list(iodnum)%type = xtype + iodesc_list(iodnum)%ndims = ndims + iodesc_list(iodnum)%dims = 0 + iodesc_list(iodnum)%dims(1:ndims) = dims(1:ndims) + iodesc_list(iodnum)%dimids(1:ndims) = dimids(1:ndims) + + end subroutine ncd_getiodesc + +end module ncdio_pio diff --git a/components/clm/src_clm40/main/ndepStreamMod.F90 b/components/clm/src_clm40/main/ndepStreamMod.F90 new file mode 100644 index 0000000000..1baebdbf37 --- /dev/null +++ b/components/clm/src_clm40/main/ndepStreamMod.F90 @@ -0,0 +1,284 @@ +module ndepStreamMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: ndepStreamMod +! +! !DESCRIPTION: +! Contains methods for reading in nitrogen deposition data file +! Also includes functions for dynamic ndep file handling and +! interpolation. +! +! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_strdata_mod + use shr_stream_mod + use shr_string_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use controlMod , only: NLFilename + use abortutils , only: endrun + use fileutils , only: getavu, relavu + use decompMod , only: get_proc_bounds, ldecomp, gsmap_lnd_gdc2glo + use domainMod , only: ldomain + +! !PUBLIC TYPES: + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public :: ndep_init ! position datasets for dynamic ndep + public :: ndep_interp ! interpolates between two years of ndep file data + public :: clm_domain_mct ! Sets up MCT domain for this resolution +! +!EOP + +! ! PRIVATE TYPES + + type(shr_strdata_type) :: sdat ! input data stream + integer :: stream_year_first_ndep ! first year in stream to use + integer :: stream_year_last_ndep ! last year in stream to use + integer :: model_year_align_ndep ! align stream_year_firstndep with + +!======================================================================= +contains +!======================================================================= + + subroutine ndep_init( ) + + !----------------------------------------------------------------------- + ! Initialize data stream information. + !----------------------------------------------------------------------- + ! Uses: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + ! arguments + implicit none + + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_ndep + character(len=CL) :: ndepmapalgo = 'bilinear' + character(*), parameter :: shr_strdata_unset = 'NOT_SET' + character(*), parameter :: subName = "('ndepdyn_init')" + character(*), parameter :: F00 = "('(ndepdyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /ndepdyn_nml/ & + stream_year_first_ndep, & + stream_year_last_ndep, & + model_year_align_ndep, & + ndepmapalgo, & + stream_fldFileName_ndep + + ! Default values for namelist + stream_year_first_ndep = 1 ! first year in stream to use + stream_year_last_ndep = 1 ! last year in stream to use + model_year_align_ndep = 1 ! align stream_year_first_ndep with this model year + stream_fldFileName_ndep = ' ' + + ! Read ndepdyn_nml namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call shr_nl_find_group_name(nu_nml, 'ndepdyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndepdyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(subname // ':: ERROR reading ndepdyn_nml namelist') + end if + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_ndep, mpicom) + call shr_mpi_bcast(stream_year_last_ndep, mpicom) + call shr_mpi_bcast(model_year_align_ndep, mpicom) + call shr_mpi_bcast(stream_fldFileName_ndep, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'ndepdyn stream settings:' + write(iulog,*) ' stream_year_first_ndep = ',stream_year_first_ndep + write(iulog,*) ' stream_year_last_ndep = ',stream_year_last_ndep + write(iulog,*) ' model_year_align_ndep = ',model_year_align_ndep + write(iulog,*) ' stream_fldFileName_ndep = ',stream_fldFileName_ndep + write(iulog,*) ' ' + endif + + call clm_domain_mct (dom_clm) + + call shr_strdata_create(sdat,name="clmndep", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep, & + yearLast=stream_year_last_ndep, & + yearAlign=model_year_align_ndep, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep), & + domTvarName='time', & + domXvarName='lon' , & + domYvarName='lat' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep)/),& + fldListFile='NDEP_year', & + fldListModel='NDEP_year', & + fillalgo='none', & + mapalgo=ndepmapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat,'CLMNDEP data') + endif + + end subroutine ndep_init + +!================================================================ + + subroutine ndep_interp( ) + + !----------------------------------------------------------------------- + use decompMod , only : get_proc_bounds + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use clm_atmlnd , only : clm_a2l + + ! Local variables + implicit none + integer :: g, ig, begg, endg + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndepdyn') + + call get_proc_bounds(begg, endg) + ig = 0 + dayspyr = get_days_per_year( ) + do g = begg,endg + ig = ig+1 + clm_a2l%forc_ndep(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + end subroutine ndep_interp + +!============================================================================== + + subroutine clm_domain_mct( dom_clm ) + + !------------------------------------------------------------------- + ! Set domain data type for internal clm grid + use clm_varcon , only : re + use domainMod , only : ldomain + use seq_flds_mod + implicit none + ! + ! arguments + type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model + ! + ! local variables + integer :: g,i,j ! index + integer :: begg, endg ! beginning and ending gridcell indices + integer :: lsize ! land model domain data size + real(r8), pointer :: data(:) ! temporary + integer , pointer :: idata(:) ! temporary + !------------------------------------------------------------------- + ! + ! Initialize mct domain type + ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) + ! Note that in addition land carries around landfrac for the purposes of domain checking + ! + lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) + call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & + OtherChars=trim(seq_flds_dom_other), lsize=lsize ) + ! + ! Allocate memory + ! + allocate(data(lsize)) + ! + ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT + ! + call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) + call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) + ! + ! Determine domain (numbering scheme is: West to East and South to North to South pole) + ! Initialize attribute vector with special value + ! + data(:) = -9999.0_R8 + call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) + call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) + data(:) = 0.0_R8 + call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) + ! + ! Determine bounds + ! + call get_proc_bounds(begg, endg) + ! + ! Fill in correct values for domain components + ! Note aream will be filled in in the atm-lnd mapper + ! + do g = begg,endg + i = 1 + (g - begg) + data(i) = ldomain%lonc(g) + end do + call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) + + do g = begg,endg + i = 1 + (g - begg) + data(i) = ldomain%latc(g) + end do + call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) + + do g = begg,endg + i = 1 + (g - begg) + data(i) = ldomain%area(g)/(re*re) + end do + call mct_gGrid_importRattr(dom_clm,"area",data,lsize) + + do g = begg,endg + i = 1 + (g - begg) + data(i) = real(ldomain%mask(g), r8) + end do + call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) + + do g = begg,endg + i = 1 + (g - begg) + data(i) = real(ldomain%frac(g), r8) + end do + call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) + + deallocate(data) + deallocate(idata) + + end subroutine clm_domain_mct + +end module ndepStreamMod + diff --git a/components/clm/src_clm40/main/organicFileMod.F90 b/components/clm/src_clm40/main/organicFileMod.F90 new file mode 100644 index 0000000000..0e7ff0888f --- /dev/null +++ b/components/clm/src_clm40/main/organicFileMod.F90 @@ -0,0 +1,113 @@ +module organicFileMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: organicFileMod +! +! !DESCRIPTION: +! Contains methods for reading in organic matter data file which has +! organic matter density for each grid point and soil level +! +! !USES + use abortutils , only : endrun + use clm_varctl , only : iulog + use shr_kind_mod , only : r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + private + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: organicrd ! Read organic matter dataset +! +! !REVISION HISTORY: +! Created by David Lawrence, 4 May 2006 +! Revised by David Lawrence, 21 September 2007 +! Revised by David Lawrence, 14 October 2008 +! +!EOP +! +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: organicrd +! +! !INTERFACE: + subroutine organicrd(organic) +! +! !DESCRIPTION: +! Read the organic matter dataset. +! +! !USES: + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use spmdMod , only : masterproc + use clmtype , only : grlnd + use domainMod , only : ldomain + use ncdio_pio +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: organic(:,:) ! organic matter density (kg/m3) +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by David Lawrence, 4 May 2006 +! Revised by David Lawrence, 21 September 2007 +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! netcdf id + integer :: ni,nj,ns ! dimension sizes + logical :: isgrid2d ! true => file is 2d + logical :: readvar ! true => variable is on dataset + character(len=32) :: subname = 'organicrd' ! subroutine name +!----------------------------------------------------------------------- + + ! Initialize data to zero - no organic matter dataset + + organic(:,:) = 0._r8 + + ! Read data if file was specified in namelist + + if (fsurdat /= ' ') then + if (masterproc) then + write(iulog,*) 'Attempting to read organic matter data .....' + write(iulog,*) subname,trim(fsurdat) + end if + + call getfil (fsurdat, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + call ncd_inqfdims (ncid, isgrid2d, ni, nj, ns) + if (ldomain%ns /= ns .or. ldomain%ni /= ni .or. ldomain%nj /= nj) then + write(iulog,*)trim(subname), 'ldomain and input file do not match dims ' + write(iulog,*)trim(subname), 'ldomain%ni,ni,= ',ldomain%ni,ni + write(iulog,*)trim(subname), 'ldomain%nj,nj,= ',ldomain%nj,nj + write(iulog,*)trim(subname), 'ldomain%ns,ns,= ',ldomain%ns,ns + call endrun() + end if + + call ncd_io(ncid=ncid, varname='ORGANIC', flag='read', data=organic, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun('organicrd: errror reading ORGANIC') + + if ( masterproc )then + write(iulog,*) 'Successfully read organic matter data' + write(iulog,*) + end if + endif + + end subroutine organicrd + +end module organicFileMod diff --git a/components/clm/src_clm40/main/pft2colMod.F90 b/components/clm/src_clm40/main/pft2colMod.F90 new file mode 100644 index 0000000000..6927cffa9c --- /dev/null +++ b/components/clm/src_clm40/main/pft2colMod.F90 @@ -0,0 +1,143 @@ + +module pft2colMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: pft2colMod +! +! !DESCRIPTION: +! Contains calls to methods to perfom averages over from pfts to columns +! for model variables. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use subgridAveMod + use clmtype +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: p2c ! obtain column properties from average over column pfts +! +! !REVISION HISTORY: +! 03/09/08: Created by Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: pft2col +! +! !INTERFACE: + subroutine pft2col (lbc, ubc, num_nolakec, filter_nolakec) +! +! !DESCRIPTION: +! Averages over all pfts for variables defined over both soil and lake +! to provide the column-level averages of state and flux variables +! defined at the pft level. +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points +! +! !REVISION HISTORY: +! 03/09/08: Created by Mariana Vertenstein +! +! +! !OTHER LOCAL VARIABLES: +!EOP + integer :: c,fc ! indices + integer :: num_allc ! number of total column points + integer :: filter_allc(ubc-lbc+1) ! filter for all column points + real(r8), pointer :: ptrp(:) ! pointer to input pft array + real(r8), pointer :: ptrc(:) ! pointer to output column array +! ----------------------------------------------------------------- + + ! Set up a filter for all column points + + num_allc = ubc-lbc+1 + fc = 0 + do c = lbc,ubc + fc = fc + 1 + filter_allc(fc) = c + end do + + ! Note: lake points are excluded from many of the following averages. For some fields, + ! this is because the field doesn't apply over lakes. However, for many others, this + ! is because the field is computed in HydrologyLake, which is called after this + ! routine; thus, for lakes, the column-level values of these fields are explicitly set + ! in HydrologyLakeMod. (The fields that are included here for lakes are computed + ! elsewhere, e.g., in BiogeophysicsLake.) + + ! Averaging for pft water state variables + + ptrp => pws%h2ocan + ptrc => pws_a%h2ocan + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ! Averaging for pft water flux variables + + ptrp => pwf%qflx_evap_tot + ptrc => pwf_a%qflx_evap_tot + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_rain_grnd + ptrc => pwf_a%qflx_rain_grnd + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_snow_grnd + ptrc => pwf_a%qflx_snow_grnd + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_snwcp_liq + ptrc => pwf_a%qflx_snwcp_liq + call p2c (num_allc, filter_allc, ptrp, ptrc) + + ptrp => pwf%qflx_snwcp_ice + ptrc => pwf_a%qflx_snwcp_ice + ! For lakes, this field is initially set in BiogeophysicsLake (which is called before + ! this routine; hence it is appropriate to include lake columns in this p2c call). + ! However, it is later overwritten in HydrologyLake, both on the pft and the column + ! level. + call p2c (num_allc, filter_allc, ptrp, ptrc) + + ptrp => pwf%qflx_tran_veg + ptrc => pwf_a%qflx_tran_veg + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_evap_grnd + ptrc => pwf_a%qflx_evap_grnd + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_evap_soi + ptrc => pwf_a%qflx_evap_soi + call p2c (num_allc, filter_allc, ptrp, ptrc) + + ptrp => pwf%qflx_prec_grnd + ptrc => pwf_a%qflx_prec_grnd + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_dew_grnd + ptrc => pwf_a%qflx_dew_grnd + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_sub_snow + ptrc => pwf_a%qflx_sub_snow + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + ptrp => pwf%qflx_dew_snow + ptrc => pwf_a%qflx_dew_snow + call p2c (num_nolakec, filter_nolakec, ptrp, ptrc) + + end subroutine pft2col + +end module pft2colMod diff --git a/components/clm/src_clm40/main/pftdynMod.F90 b/components/clm/src_clm40/main/pftdynMod.F90 new file mode 100644 index 0000000000..42784bd835 --- /dev/null +++ b/components/clm/src_clm40/main/pftdynMod.F90 @@ -0,0 +1,3224 @@ +module pftdynMod + +!--------------------------------------------------------------------------- +!BOP +! +! !MODULE: pftdynMod +! +! !USES: + use spmdMod + use clmtype + use decompMod , only : get_proc_bounds + use clm_varsur , only : pctspec + use clm_varpar , only : max_pft_per_col + use clm_varctl , only : iulog, use_c13, use_cn, use_cndv + use shr_sys_mod , only : shr_sys_flush + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use ncdio_pio , only : file_desc_t, ncd_pio_openfile, ncd_inqdid, ncd_inqdlen, ncd_io, check_dim +! +! !DESCRIPTION: +! Determine pft weights at current time using dynamic landuse datasets. +! ASSUMES that only have one dynamic landuse dataset. +! +! !PUBLIC TYPES: + implicit none + private + save + public :: pftdyn_init + public :: pftdyn_interp + public :: pftdyn_wbal_init + public :: pftdyn_wbal + public :: pftdyn_cnbal + public :: pftwt_init + public :: pftwt_interp + public :: CNHarvest + public :: CNHarvestPftToColumn +! +! !REVISION HISTORY: +! Created by Peter Thornton +! slevis modified to handle CNDV and crop model +! 19 May 2009: PET - modified to handle harvest fluxes +! +!EOP +! +! ! PRIVATE TYPES + integer , pointer :: yearspft(:) + real(r8), pointer :: wtpft1(:,:) + real(r8), pointer :: wtpft2(:,:) + real(r8), pointer :: harvest(:) + real(r8), pointer :: wtcol_old(:) + integer :: nt1 + integer :: nt2 + integer :: ntimes + logical :: do_harvest + type(file_desc_t) :: ncid ! netcdf id +!--------------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_init +! +! !INTERFACE: + subroutine pftdyn_init() +! +! !DESCRIPTION: +! Initialize dynamic landuse dataset (position it to the right time samples +! that bound the initial model date) +! +! !USES: + use clm_time_manager, only : get_curr_date + use clm_varctl , only : flanduse_timeseries + use clm_varpar , only : numpft, maxpatch_pft + use fileutils , only : getfil +! +! !ARGUMENTS: + implicit none +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i,j,m,n,g ! indices + real(r8) :: sumpct ! sum for error check + integer :: varid ! netcdf ids + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: ier, ret ! error status + logical :: found ! true => input dataset bounding dates found + logical :: readvar ! true => variable is on input dataset + integer :: begg,endg ! beg/end indices for land gridcells + integer :: begl,endl ! beg/end indices for land landunits + integer :: begc,endc ! beg/end indices for land columns + integer :: begp,endp ! beg/end indices for land pfts + real(r8), pointer :: pctgla(:) ! percent of gcell is glacier + real(r8), pointer :: pctlak(:) ! percent of gcell is lake + real(r8), pointer :: pctwet(:) ! percent of gcell is wetland + real(r8), pointer :: pcturb(:) ! percent of gcell is urbanized + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + character(len=256) :: locfn ! local file name + character(len= 32) :: subname='pftdyn_init' ! subroutine name + !----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) + + ! Error check + + if ( maxpatch_pft /= numpft+1 )then + call endrun( subname//' maxpatch_pft does NOT equal numpft+1 -- this is invalid for dynamic PFT case' ) + end if + + allocate(pctgla(begg:endg),pctlak(begg:endg)) + allocate(pctwet(begg:endg),pcturb(begg:endg)) + + ! Set pointers into derived type + + gptr => grc + + ! pctspec must be saved between time samples + ! position to first time sample - assume that first time sample must match starting date + ! check consistency - special landunits, grid, frac and mask + ! only do this once + + ! read data PCT_PFT corresponding to correct year + + allocate(wtpft1(begg:endg,0:numpft), wtpft2(begg:endg,0:numpft), stat=ier) + if (ier /= 0) then + call endrun( subname//' allocation error for wtpft1, wtpft2' ) + end if + + allocate(harvest(begg:endg),stat=ier) + if (ier /= 0) then + call endrun( subname//' allocation error for harvest') + end if + + allocate(wtcol_old(begp:endp),stat=ier) + if (ier /= 0) then + call endrun( subname//' allocation error for wtcol_old' ) + end if + + if (masterproc) then + write(iulog,*) 'Attempting to read pft dynamic landuse data .....' + end if + + ! Obtain file + call getfil (flanduse_timeseries, locfn, 0) + call ncd_pio_openfile (ncid, locfn, 0) + + ! Obtain pft years from dynamic landuse file + + call ncd_inqdid(ncid, 'time', varid) + call ncd_inqdlen(ncid, varid, ntimes) + + ! Consistency check + + call check_dim(ncid, 'lsmpft', numpft+1) + + allocate (yearspft(ntimes), stat=ier) + if (ier /= 0) then + write(iulog,*) subname//' allocation error for yearspft'; call endrun() + end if + + call ncd_io(ncid=ncid, varname='YEAR', flag='read', data=yearspft) + + call ncd_io(ncid=ncid, varname='PCT_WETLAND', flag='read', data=pctwet, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_WETLAND NOT on landuse_timeseries file' ) + + call ncd_io(ncid=ncid, varname= 'PCT_LAKE', flag='read', data=pctlak, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_LAKE NOT on landuse_timeseries file' ) + + call ncd_io(ncid=ncid, varname= 'PCT_GLACIER', flag='read', data=pctgla, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_GLACIER NOT on landuse_timeseries file' ) + + call ncd_io(ncid=ncid, varname= 'PCT_URBAN' , flag='read', data=pcturb, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_URBAN NOT on landuse_timeseries file' ) + + ! Consistency check + do g = begg,endg + ! this was causing a fail, even though values are the same to within 1e-15 + ! if (pctlak(g)+pctwet(g)+pcturb(g)+pctgla(g) /= pctspec(g)) then + if (abs((pctlak(g)+pctwet(g)+pcturb(g)+pctgla(g))-pctspec(g)) > 1e-13_r8) then + write(iulog,*) subname//'mismatch between input pctspec = ',& + pctlak(g)+pctwet(g)+pcturb(g)+pctgla(g),& + ' and that obtained from surface dataset ', pctspec(g),' at g= ',g + call endrun() + end if + end do + + ! Determine if current date spans the years + ! If current year is less than first dynamic PFT timeseries year, + ! then use the first year from dynamic pft file for both nt1 and nt2, + ! forcing constant weights until the model year enters the dynamic + ! pft dataset timeseries range. + ! If current year is equal to or greater than the last dynamic pft + ! timeseries year, then use the last year for both nt1 and nt2, + ! forcing constant weights for the remainder of the simulation. + ! This mechanism permits the introduction of a dynamic pft period in the middle + ! of a simulation, with constant weights before and after the dynamic period. + ! PET: harvest - since harvest is specified as a rate for each year, this + ! approach will not work. Instead, need to seta flag that indicates harvest is + ! zero for the period before the beginning and after the end of the dynpft timeseries. + + call get_curr_date(year, mon, day, sec) + + if (year < yearspft(1)) then + nt1 = 1 + nt2 = 1 + do_harvest = .false. + else if (year >= yearspft(ntimes)) then + nt1 = ntimes + nt2 = ntimes + do_harvest = .false. + else + found = .false. + do n = 1,ntimes-1 + if (year == yearspft(n)) then + nt1 = n + nt2 = nt1 + 1 + found = .true. + do_harvest = .true. + end if + end do + if (.not. found) then + write(iulog,*) subname//' error: model year not found in landuse_timeseries file' + write(iulog,*)'model year = ',year + call endrun() + end if + end if + + ! Get pctpft time samples bracketing the current time + + if (masterproc) then + write(iulog,*) 'Get PFTDYN data for year: ', yearspft(nt1) + end if + call pftdyn_getdata(nt1, wtpft1, begg,endg,0,numpft) + if (masterproc) then + write(iulog,*) 'Get PFTDYN data for year: ', yearspft(nt2) + end if + call pftdyn_getdata(nt2, wtpft2, begg,endg,0,numpft) + + if (use_cn) then + ! Get harvest rate at the nt1 time + call pftdyn_getharvest(nt1,begg,endg) + end if + + ! convert weights from percent to proportion + do m = 0,numpft + do g = begg,endg + wtpft1(g,m) = wtpft1(g,m)/100._r8 + wtpft2(g,m) = wtpft2(g,m)/100._r8 + end do + end do + + deallocate(pctgla,pctlak,pctwet,pcturb) + + end subroutine pftdyn_init + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_interp +! +! !INTERFACE: + subroutine pftdyn_interp() +! +! !DESCRIPTION: +! Time interpolate dynamic landuse data to get pft weights for model time +! Note that harvest data are stored as rates (not weights) and so time interpolation is +! not necessary - the harvest rate is held constant through the year. This is consistent with +! the treatment of changing PFT weights, where interpolation of the annual endpoint weights leads to +! a constant rate of change in PFT weight through the year, with abrupt changes in the rate at +! annual boundaries. This routine is still used to get the next harvest time slice, when needed. +! This routine is also used to turn off the harvest switch when the model year runs past the end of +! the dynpft time series. +! +! !USES: + use clm_time_manager, only : get_curr_date, get_curr_calday, & + get_days_per_year + use clm_varcon , only : istsoil + use clm_varcon , only : istcrop + use clm_varpar , only : numpft + implicit none +! +! +! !LOCAL VARIABLES: +!EOP +! +! !ARGUMENTS: + integer :: begg,endg ! beg/end indices for land gridcells + integer :: begl,endl ! beg/end indices for land landunits + integer :: begc,endc ! beg/end indices for land columns + integer :: begp,endp ! beg/end indices for land pfts + integer :: i,j,m,p,l,g,c ! indices + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: days_per_year ! days per year + integer :: ier ! error status + integer :: lbc,ubc + real(r8) :: wt1 ! time interpolation weights + real(r8), pointer :: wtpfttot1(:) ! summation of pft weights for renormalization + real(r8), pointer :: wtpfttot2(:) ! summation of pft weights for renormalization + real(r8), parameter :: wtpfttol = 1.e-10 ! tolerance for pft weight renormalization + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + character(len=32) :: subname='pftdyn_interp' ! subroutine name +!----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) + + ! Set pointers into derived type + + gptr => grc + lptr => lun + pptr => pft + + allocate(wtpfttot1(begc:endc),wtpfttot2(begc:endc)) + wtpfttot1(:) = 0._r8 + wtpfttot2(:) = 0._r8 + + ! Interpolat pctpft to current time step - output in pctpft_intp + ! Map interpolated pctpft to subgrid weights + ! assumes that maxpatch_pft = numpft + 1, that each landunit has only 1 column, + ! SCAM and CNDV have not been defined, and create_croplandunit = .false. + + ! If necessary, obtain new time sample + + ! Get current date + + call get_curr_date(year, mon, day, sec) + + ! Obtain new time sample if necessary. + ! The first condition is the regular crossing of a year boundary + ! when within the dynpft timeseries range. The second condition is + ! the case of the first entry into the dynpft timeseries range from + ! an earlier period of constant weights. + + if (year > yearspft(nt1) .or. (nt1 == 1 .and. nt2 == 1 .and. year == yearspft(1))) then + + if (year >= yearspft(ntimes)) then + nt1 = ntimes + nt2 = ntimes + else + nt1 = nt2 + nt2 = nt2 + 1 + do_harvest = .true. + end if + + if (year > yearspft(ntimes)) then + do_harvest = .false. + endif + + if (nt2 > ntimes .and. masterproc) then + write(iulog,*)subname,' error - current year is past input data boundary' + end if + + do m = 0,numpft + do g = begg,endg + wtpft1(g,m) = wtpft2(g,m) + end do + end do + + if (masterproc) then + write(iulog,*) 'Get PFTDYN data for year: ', yearspft(nt2) + end if + call pftdyn_getdata(nt2, wtpft2, begg,endg,0,numpft) + if (use_cn) then + call pftdyn_getharvest(nt1,begg,endg) + end if + + do m = 0,numpft + do g = begg,endg + wtpft2(g,m) = wtpft2(g,m)/100._r8 + end do + end do + + end if ! end of need new data if-block + + ! Interpolate pft weight to current time + + cday = get_curr_calday() + days_per_year = get_days_per_year() + + wt1 = ((days_per_year + 1._r8) - cday)/days_per_year + + do p = begp,endp + c = pptr%column(p) + g = pptr%gridcell(p) + l = pptr%landunit(p) + if (lptr%itype(l) == istsoil .or. lptr%itype(l) == istcrop) then + m = pptr%itype(p) + wtcol_old(p) = pptr%wtcol(p) +! --- recoded for roundoff performance, tcraig 3/07 from k.lindsay +! pptr%wtgcell(p) = wtpft1(g,m)*wt1 + wtpft2(g,m)*wt2 + wtpfttot1(c) = wtpfttot1(c)+pptr%wtgcell(p) + pptr%wtgcell(p) = wtpft2(g,m) + wt1*(wtpft1(g,m)-wtpft2(g,m)) + pptr%wtlunit(p) = pptr%wtgcell(p) / lptr%wtgcell(l) + pptr%wtcol(p) = pptr%wtgcell(p) / lptr%wtgcell(l) + wtpfttot2(c) = wtpfttot2(c)+pptr%wtgcell(p) + end if + + end do + +! Renormalize pft weights so that sum of pft weights relative to grid cell +! remain constant even as land cover changes. Doing this eliminates +! soil balance error warnings. (DML, 4/8/2009) + do p = begp,endp + c = pptr%column(p) + g = pptr%gridcell(p) + l = pptr%landunit(p) + if (lptr%itype(l) == istsoil .or. lptr%itype(l) == istcrop) then + if (wtpfttot2(c) /= 0 .and. & + abs(wtpfttot1(c)-wtpfttot2(c)) > wtpfttol) then + pptr%wtgcell(p) = (wtpfttot1(c)/wtpfttot2(c))*pptr%wtgcell(p) + pptr%wtlunit(p) = pptr%wtgcell(p) / lptr%wtgcell(l) + pptr%wtcol(p) = pptr%wtgcell(p) / lptr%wtgcell(l) + end if + end if + + end do + + deallocate(wtpfttot1,wtpfttot2) + + end subroutine pftdyn_interp + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_getdata +! +! !INTERFACE: + subroutine pftdyn_getdata(ntime, pctpft, begg, endg, pft0, maxpft) +! +! !DESCRIPTION: +! Obtain dynamic landuse data (pctpft) and make sure that +! percentage of PFTs sum to 100% cover for vegetated landunit +! +! !USES: + use clm_varpar , only : numpft +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ntime + integer , intent(in) :: begg,endg,pft0,maxpft + real(r8), intent(out) :: pctpft(begg:endg,pft0:maxpft) +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i,j,m,n + integer :: err, ierr, ret + real(r8) :: sumpct,sumerr ! temporary + real(r8), pointer :: arrayl(:,:) ! temporary array + logical :: readvar + + character(len=32) :: subname='pftdyn_getdata' ! subroutine name +!----------------------------------------------------------------------- + + allocate(arrayl(begg:endg,pft0:maxpft)) + call ncd_io(ncid=ncid, varname= 'PCT_PFT', flag='read', data=arrayl, & + dim1name=grlnd, nt=ntime, readvar=readvar) + pctpft(begg:endg,pft0:maxpft) = arrayl(begg:endg,pft0:maxpft) + deallocate(arrayl) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_PFT NOT on pftdyn file' ) + + err = 0 + do n = begg,endg + if (pctspec(n) < 100._r8) then + sumpct = 0._r8 + do m = 0, numpft + sumpct = sumpct + pctpft(n,m) * 100._r8/(100._r8-pctspec(n)) + end do + if (abs(sumpct - 100._r8) > 0.1_r8) then + err = 1; ierr = n; sumerr = sumpct + end if + if (sumpct < -0.000001_r8) then + err = 2; ierr = n; sumerr = sumpct + end if + end if + end do + if (err == 1) then + write(iulog,*) subname,' error: sum(pct) over numpft+1 is not = 100.',sumerr,ierr,pctspec(ierr),pctpft(ierr,:) + call endrun() + else if (err == 2) then + write(iulog,*)subname,' error: sum(pct) over numpft+1 is < 0.',sumerr,ierr,pctspec(ierr),pctpft(ierr,:) + call endrun() + end if + + end subroutine pftdyn_getdata + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_getharvest +! +! !INTERFACE: + subroutine pftdyn_getharvest(ntime, begg, endg) +! +! !DESCRIPTION: +! Obtain harvest data +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ntime + integer , intent(IN) :: begg ! beg indices for land gridcells + integer , intent(IN) :: endg ! end indices for land gridcells +! +! +! !LOCAL VARIABLES: +!EOP + real(r8), pointer :: arrayl(:) ! temporary array + logical :: readvar + character(len=32) :: subname='pftdyn_getharvest' ! subroutine name +!----------------------------------------------------------------------- + + allocate(arrayl(begg:endg)) + + call ncd_io(ncid=ncid, varname= 'HARVEST_VH1', flag='read', data=arrayl, dim1name=grlnd, & + nt=ntime, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HARVEST_VH1 not on landuse_timeseries file' ) + harvest(begg:endg) = arrayl(begg:endg) + + call ncd_io(ncid=ncid, varname= 'HARVEST_VH2', flag='read', data=arrayl, dim1name=grlnd, & + nt=ntime, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HARVEST_VH2 not on landuse_timeseries file' ) + harvest(begg:endg) = harvest(begg:endg) + arrayl(begg:endg) + + call ncd_io(ncid=ncid, varname= 'HARVEST_SH1', flag='read', data=arrayl, dim1name=grlnd, & + nt=ntime, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HARVEST_SH1 not on landuse_timeseries file' ) + harvest(begg:endg) = harvest(begg:endg) + arrayl(begg:endg) + + call ncd_io(ncid=ncid, varname= 'HARVEST_SH2', flag='read', data=arrayl, dim1name=grlnd, & + nt=ntime, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HARVEST_SH2 not on landuse_timeseries file' ) + harvest(begg:endg) = harvest(begg:endg) + arrayl(begg:endg) + + call ncd_io(ncid=ncid, varname= 'HARVEST_SH3', flag='read', data=arrayl, dim1name=grlnd, & + nt=ntime, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: HARVEST_SH3 not on landuse_timeseries file' ) + harvest(begg:endg) = harvest(begg:endg) + arrayl(begg:endg) + + deallocate(arrayl) + + end subroutine pftdyn_getharvest + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_wbal_init +! +! !INTERFACE: + subroutine pftdyn_wbal_init( begc, endc ) +! +! !DESCRIPTION: +! initialize the column-level mass-balance correction term. +! Called in every timestep. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begc, endc ! proc beginning and ending column indices +! +! +! !LOCAL VARIABLES: +!EOP + integer :: c ! indices + type(column_type), pointer :: cptr ! pointer to column derived subtype +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + cptr => col + + ! set column-level canopy water mass balance correction flux + ! term to 0 at the beginning of every timestep + + do c = begc,endc + cwf%h2ocan_loss(c) = 0._r8 + end do + + end subroutine pftdyn_wbal_init + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_wbal +! +! !INTERFACE: + subroutine pftdyn_wbal( begg, endg, begc, endc, begp, endp ) +! +! !DESCRIPTION: +! modify pft-level state and flux variables to maintain water balance with +! dynamic pft-weights. +! Canopy water balance does not need to consider harvest fluxes, since pft weights are +! not affected by harvest. +! +! !USES: + use clm_varcon , only : istsoil + use clm_varcon , only : istcrop + use clm_time_manager, only : get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begg ! beg indices for land gridcells + integer, intent(IN) :: endg ! end indices for land gridcells + integer, intent(IN) :: begc ! beg indices for land columns + integer, intent(IN) :: endc ! end indices for land columns + integer, intent(IN) :: begp ! beg indices for land plant function types + integer, intent(IN) :: endp ! end indices for land plant function types +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pi,p,c,l,g ! indices + integer :: ier ! error code + real(r8) :: dtime ! land model time step (sec) + real(r8) :: dwt ! change in pft weight (relative to column) + real(r8) :: init_h2ocan ! initial canopy water mass + real(r8) :: new_h2ocan ! canopy water mass after weight shift + real(r8), allocatable :: loss_h2ocan(:) ! canopy water mass loss due to weight shift + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type), pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + character(len=32) :: subname='pftdyn_wbal' ! subroutine name +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + lptr => lun + cptr => col + pptr => pft + + ! Allocate loss_h2ocan + allocate(loss_h2ocan(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for loss_h2ocan'; call endrun() + end if + + ! Get time step + + dtime = get_step_size() + + ! set column-level canopy water mass balance correction flux + ! term to 0 at the beginning of every weight-shifting timestep + + do c = begc,endc + cwf%h2ocan_loss(c) = 0._r8 ! is this OR pftdyn_wbal_init redundant? + end do + + do p = begp,endp + l = pptr%landunit(p) + loss_h2ocan(p) = 0._r8 + + if (lptr%itype(l) == istsoil .or. lptr%itype(l) == istcrop) then + + ! calculate the change in weight for the timestep + dwt = pptr%wtcol(p)-wtcol_old(p) + + if (dwt > 0._r8) then + + ! if the pft gained weight, then the + ! initial canopy water state is redistributed over the + ! new (larger) area, conserving mass. + + pws%h2ocan(p) = pws%h2ocan(p) * (wtcol_old(p)/pptr%wtcol(p)) + + else if (dwt < 0._r8) then + + ! if the pft lost weight on the timestep, then the canopy water + ! mass associated with the lost weight is directed to a + ! column-level flux term that gets added to the precip flux + ! for every pft calculation in Hydrology1() + + init_h2ocan = pws%h2ocan(p) * wtcol_old(p) + loss_h2ocan(p) = pws%h2ocan(p) * (-dwt) + new_h2ocan = init_h2ocan - loss_h2ocan(p) + if (abs(new_h2ocan) < 1e-8_r8) then + new_h2ocan = 0._r8 + loss_h2ocan(p) = init_h2ocan + end if + if (pptr%wtcol(p) /= 0._r8) then + pws%h2ocan(p) = new_h2ocan/pptr%wtcol(p) + else + pws%h2ocan(p) = 0._r8 + loss_h2ocan(p) = init_h2ocan + end if + + + end if + + end if + end do + + do pi = 1,max_pft_per_col + do c = begc,endc + if (pi <= cptr%npfts(c)) then + p = cptr%pfti(c) + pi - 1 + cwf%h2ocan_loss(c) = cwf%h2ocan_loss(c) + loss_h2ocan(p)/dtime + end if + end do + end do + + ! Deallocate loss_h2ocan + deallocate(loss_h2ocan) + + end subroutine pftdyn_wbal + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftdyn_cnbal +! +! !INTERFACE: + subroutine pftdyn_cnbal( begc, endc, begp, endp ) +! +! !DESCRIPTION: +! modify pft-level state and flux variables to maintain carbon and nitrogen balance with +! dynamic pft-weights. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_const_mod,only : SHR_CONST_PDB + use decompMod , only : get_proc_bounds + use clm_varcon , only : istsoil + use clm_varcon , only : istcrop + use clm_varpar , only : numveg, numpft + use pftvarcon , only : pconv, pprod10, pprod100 + use clm_varcon , only : c13ratio + use clm_time_manager, only : get_step_size +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begp, endp ! proc beginning and ending pft indices + integer, intent(IN) :: begc, endc ! proc beginning and ending column indices +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pi,p,c,l,g ! indices + integer :: ier ! error code + real(r8) :: dwt ! change in pft weight (relative to column) + real(r8) :: dt ! land model time step (sec) + real(r8) :: init_h2ocan ! initial canopy water mass + real(r8) :: new_h2ocan ! canopy water mass after weight shift + real(r8), allocatable :: dwt_leafc_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_leafn_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_leafc13_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemc_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemn_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_deadstemc13_seed(:) ! pft-level mass gain due to seeding of new area + real(r8), allocatable :: dwt_frootc_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable :: dwt_livecrootc_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable :: dwt_deadcrootc_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_frootc13_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_livecrootc13_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_deadcrootc13_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_frootn_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_livecrootn_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: dwt_deadcrootn_to_litter(:) ! pft-level mass loss due to weight shift + real(r8), allocatable :: conv_cflux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable :: prod10_cflux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable :: prod100_cflux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: conv_c13flux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: prod10_c13flux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: prod100_c13flux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: conv_nflux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: prod10_nflux(:) ! pft-level mass loss due to weight shift + real(r8), allocatable, target :: prod100_nflux(:) ! pft-level mass loss due to weight shift + real(r8) :: c3_del13c ! typical del13C for C3 photosynthesis (permil, relative to PDB) + real(r8) :: c4_del13c ! typical del13C for C4 photosynthesis (permil, relative to PDB) + real(r8) :: c3_r1 ! isotope ratio (13c/12c) for C3 photosynthesis + real(r8) :: c4_r1 ! isotope ratio (13c/12c) for C4 photosynthesis + real(r8) :: c3_r2 ! isotope ratio (13c/[12c+13c]) for C3 photosynthesis + real(r8) :: c4_r2 ! isotope ratio (13c/[12c+13c]) for C4 photosynthesis + real(r8) :: t1,t2,wt_new,wt_old + real(r8) :: init_state, change_state, new_state + real(r8) :: tot_leaf, pleaf, pstor, pxfer + real(r8) :: leafc_seed, leafn_seed + real(r8) :: deadstemc_seed, deadstemn_seed + real(r8) :: leafc13_seed, deadstemc13_seed + real(r8), pointer :: dwt_ptr0, dwt_ptr1, dwt_ptr2, dwt_ptr3, ptr + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type), pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + integer , pointer :: pcolumn(:) ! column of corresponding pft + character(len=32) :: subname='pftdyn_cbal' ! subroutine name +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + lptr => lun + cptr => col + pptr => pft + pcolumn => pptr%column + + ! Allocate pft-level mass loss arrays + allocate(dwt_leafc_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafc_seed'; call endrun() + end if + allocate(dwt_leafn_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafn_seed'; call endrun() + end if + if (use_c13) then + allocate(dwt_leafc13_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_leafc13_seed'; call endrun() + end if + endif + allocate(dwt_deadstemc_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemc_seed'; call endrun() + end if + allocate(dwt_deadstemn_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemn_seed'; call endrun() + end if + if (use_c13) then + allocate(dwt_deadstemc13_seed(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadstemc13_seed'; call endrun() + end if + endif + allocate(dwt_frootc_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootc_to_litter'; call endrun() + end if + allocate(dwt_livecrootc_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootc_to_litter'; call endrun() + end if + allocate(dwt_deadcrootc_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootc_to_litter'; call endrun() + end if + if (use_c13) then + allocate(dwt_frootc13_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootc13_to_litter'; call endrun() + end if + allocate(dwt_livecrootc13_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootc13_to_litter'; call endrun() + end if + allocate(dwt_deadcrootc13_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootc13_to_litter'; call endrun() + end if + endif + allocate(dwt_frootn_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_frootn_to_litter'; call endrun() + end if + allocate(dwt_livecrootn_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_livecrootn_to_litter'; call endrun() + end if + allocate(dwt_deadcrootn_to_litter(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for dwt_deadcrootn_to_litter'; call endrun() + end if + allocate(conv_cflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_cflux'; call endrun() + end if + allocate(prod10_cflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_cflux'; call endrun() + end if + allocate(prod100_cflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_cflux'; call endrun() + end if + if (use_c13) then + allocate(conv_c13flux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_c13flux'; call endrun() + end if + allocate(prod10_c13flux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_c13flux'; call endrun() + end if + allocate(prod100_c13flux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_c13flux'; call endrun() + end if + endif + allocate(conv_nflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for conv_nflux'; call endrun() + end if + allocate(prod10_nflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod10_nflux'; call endrun() + end if + allocate(prod100_nflux(begp:endp), stat=ier) + if (ier /= 0) then + write(iulog,*)subname,' allocation error for prod100_nflux'; call endrun() + end if + + ! Get time step + dt = real( get_step_size(), r8 ) + + do p = begp,endp + c = pcolumn(p) + ! initialize all the pft-level local flux arrays + dwt_leafc_seed(p) = 0._r8 + dwt_leafn_seed(p) = 0._r8 + if (use_c13) then + dwt_leafc13_seed(p) = 0._r8 + endif + dwt_deadstemc_seed(p) = 0._r8 + dwt_deadstemn_seed(p) = 0._r8 + if (use_c13) then + dwt_deadstemc13_seed(p) = 0._r8 + endif + dwt_frootc_to_litter(p) = 0._r8 + dwt_livecrootc_to_litter(p) = 0._r8 + dwt_deadcrootc_to_litter(p) = 0._r8 + if (use_c13) then + dwt_frootc13_to_litter(p) = 0._r8 + dwt_livecrootc13_to_litter(p) = 0._r8 + dwt_deadcrootc13_to_litter(p) = 0._r8 + endif + dwt_frootn_to_litter(p) = 0._r8 + dwt_livecrootn_to_litter(p) = 0._r8 + dwt_deadcrootn_to_litter(p) = 0._r8 + conv_cflux(p) = 0._r8 + prod10_cflux(p) = 0._r8 + prod100_cflux(p) = 0._r8 + if (use_c13) then + conv_c13flux(p) = 0._r8 + prod10_c13flux(p) = 0._r8 + prod100_c13flux(p) = 0._r8 + endif + conv_nflux(p) = 0._r8 + prod10_nflux(p) = 0._r8 + prod100_nflux(p) = 0._r8 + + l = pptr%landunit(p) + if (lptr%itype(l) == istsoil .or. lptr%itype(l) == istcrop) then + + ! calculate the change in weight for the timestep + dwt = pptr%wtcol(p)-wtcol_old(p) + + ! PFTs for which weight increases on this timestep + if (dwt > 0._r8) then + + ! first identify PFTs that are initiating on this timestep + ! and set all the necessary state and flux variables + if (wtcol_old(p) == 0._r8) then + + ! set initial conditions for PFT that is being initiated + ! in this time step. Based on the settings in cnIniTimeVar. + + ! pft-level carbon state variables + pcs%leafc(p) = 0._r8 + pcs%leafc_storage(p) = 0._r8 + pcs%leafc_xfer(p) = 0._r8 + pcs%frootc(p) = 0._r8 + pcs%frootc_storage(p) = 0._r8 + pcs%frootc_xfer(p) = 0._r8 + pcs%livestemc(p) = 0._r8 + pcs%livestemc_storage(p) = 0._r8 + pcs%livestemc_xfer(p) = 0._r8 + pcs%deadstemc(p) = 0._r8 + pcs%deadstemc_storage(p) = 0._r8 + pcs%deadstemc_xfer(p) = 0._r8 + pcs%livecrootc(p) = 0._r8 + pcs%livecrootc_storage(p) = 0._r8 + pcs%livecrootc_xfer(p) = 0._r8 + pcs%deadcrootc(p) = 0._r8 + pcs%deadcrootc_storage(p) = 0._r8 + pcs%deadcrootc_xfer(p) = 0._r8 + pcs%gresp_storage(p) = 0._r8 + pcs%gresp_xfer(p) = 0._r8 + pcs%cpool(p) = 0._r8 + pcs%xsmrpool(p) = 0._r8 + pcs%pft_ctrunc(p) = 0._r8 + pcs%dispvegc(p) = 0._r8 + pcs%storvegc(p) = 0._r8 + pcs%totvegc(p) = 0._r8 + pcs%totpftc(p) = 0._r8 + + ! pft-level carbon-13 state variables + if (use_c13) then + pc13s%leafc(p) = 0._r8 + pc13s%leafc_storage(p) = 0._r8 + pc13s%leafc_xfer(p) = 0._r8 + pc13s%frootc(p) = 0._r8 + pc13s%frootc_storage(p) = 0._r8 + pc13s%frootc_xfer(p) = 0._r8 + pc13s%livestemc(p) = 0._r8 + pc13s%livestemc_storage(p) = 0._r8 + pc13s%livestemc_xfer(p) = 0._r8 + pc13s%deadstemc(p) = 0._r8 + pc13s%deadstemc_storage(p) = 0._r8 + pc13s%deadstemc_xfer(p) = 0._r8 + pc13s%livecrootc(p) = 0._r8 + pc13s%livecrootc_storage(p) = 0._r8 + pc13s%livecrootc_xfer(p) = 0._r8 + pc13s%deadcrootc(p) = 0._r8 + pc13s%deadcrootc_storage(p) = 0._r8 + pc13s%deadcrootc_xfer(p) = 0._r8 + pc13s%gresp_storage(p) = 0._r8 + pc13s%gresp_xfer(p) = 0._r8 + pc13s%cpool(p) = 0._r8 + pc13s%xsmrpool(p) = 0._r8 + pc13s%pft_ctrunc(p) = 0._r8 + pc13s%dispvegc(p) = 0._r8 + pc13s%storvegc(p) = 0._r8 + pc13s%totvegc(p) = 0._r8 + pc13s%totpftc(p) = 0._r8 + endif + + ! pft-level nitrogen state variables + pns%leafn(p) = 0._r8 + pns%leafn_storage(p) = 0._r8 + pns%leafn_xfer(p) = 0._r8 + pns%frootn(p) = 0._r8 + pns%frootn_storage(p) = 0._r8 + pns%frootn_xfer(p) = 0._r8 + pns%livestemn(p) = 0._r8 + pns%livestemn_storage(p) = 0._r8 + pns%livestemn_xfer(p) = 0._r8 + pns%deadstemn(p) = 0._r8 + pns%deadstemn_storage(p) = 0._r8 + pns%deadstemn_xfer(p) = 0._r8 + pns%livecrootn(p) = 0._r8 + pns%livecrootn_storage(p) = 0._r8 + pns%livecrootn_xfer(p) = 0._r8 + pns%deadcrootn(p) = 0._r8 + pns%deadcrootn_storage(p) = 0._r8 + pns%deadcrootn_xfer(p) = 0._r8 + pns%retransn(p) = 0._r8 + pns%npool(p) = 0._r8 + pns%pft_ntrunc(p) = 0._r8 + pns%dispvegn(p) = 0._r8 + pns%storvegn(p) = 0._r8 + pns%totvegn(p) = 0._r8 + pns%totpftn (p) = 0._r8 + + ! initialize same flux and epv variables that are set + ! in CNiniTimeVar + pcf%psnsun(p) = 0._r8 + pcf%psnsha(p) = 0._r8 + if (use_c13) then + pc13f%psnsun(p) = 0._r8 + pc13f%psnsha(p) = 0._r8 + endif + pps%laisun(p) = 0._r8 + pps%laisha(p) = 0._r8 + pps%lncsun(p) = 0._r8 + pps%lncsha(p) = 0._r8 + pps%vcmxsun(p) = 0._r8 + pps%vcmxsha(p) = 0._r8 + if (use_c13) then + pps%alphapsnsun(p) = 0._r8 + pps%alphapsnsha(p) = 0._r8 + endif + + pepv%dormant_flag(p) = 1._r8 + pepv%days_active(p) = 0._r8 + pepv%onset_flag(p) = 0._r8 + pepv%onset_counter(p) = 0._r8 + pepv%onset_gddflag(p) = 0._r8 + pepv%onset_fdd(p) = 0._r8 + pepv%onset_gdd(p) = 0._r8 + pepv%onset_swi(p) = 0.0_r8 + pepv%offset_flag(p) = 0._r8 + pepv%offset_counter(p) = 0._r8 + pepv%offset_fdd(p) = 0._r8 + pepv%offset_swi(p) = 0._r8 + pepv%lgsf(p) = 0._r8 + pepv%bglfr(p) = 0._r8 + pepv%bgtr(p) = 0._r8 + ! difference from CNiniTimeVar: using column-level + ! information to initialize annavg_t2m. + pepv%annavg_t2m(p) = cps%cannavg_t2m(c) + pepv%tempavg_t2m(p) = 0._r8 + pepv%gpp(p) = 0._r8 + pepv%availc(p) = 0._r8 + pepv%xsmrpool_recover(p) = 0._r8 + if (use_c13) then + pepv%xsmrpool_c13ratio(p) = c13ratio + endif + pepv%alloc_pnow(p) = 1._r8 + pepv%c_allometry(p) = 0._r8 + pepv%n_allometry(p) = 0._r8 + pepv%plant_ndemand(p) = 0._r8 + pepv%tempsum_potential_gpp(p) = 0._r8 + pepv%annsum_potential_gpp(p) = 0._r8 + pepv%tempmax_retransn(p) = 0._r8 + pepv%annmax_retransn(p) = 0._r8 + pepv%avail_retransn(p) = 0._r8 + pepv%plant_nalloc(p) = 0._r8 + pepv%plant_calloc(p) = 0._r8 + pepv%excess_cflux(p) = 0._r8 + pepv%downreg(p) = 0._r8 + pepv%prev_leafc_to_litter(p) = 0._r8 + pepv%prev_frootc_to_litter(p) = 0._r8 + pepv%tempsum_npp(p) = 0._r8 + pepv%annsum_npp(p) = 0._r8 + if (use_c13) then + pepv%rc13_canair(p) = 0._r8 + pepv%rc13_psnsun(p) = 0._r8 + pepv%rc13_psnsha(p) = 0._r8 + endif + + end if ! end initialization of new pft + + ! (still in dwt > 0 block) + + ! set the seed sources for leaf and deadstem + ! leaf source is split later between leaf, leaf_storage, leaf_xfer + leafc_seed = 0._r8 + leafn_seed = 0._r8 + if (use_c13) then + leafc13_seed = 0._r8 + endif + deadstemc_seed = 0._r8 + deadstemn_seed = 0._r8 + if (use_c13) then + deadstemc13_seed = 0._r8 + endif + if (pptr%itype(p) /= 0) then + leafc_seed = 1._r8 + leafn_seed = leafc_seed / pftcon%leafcn(pptr%itype(p)) + if (pftcon%woody(pptr%itype(p)) == 1._r8) then + deadstemc_seed = 0.1_r8 + deadstemn_seed = deadstemc_seed / pftcon%deadwdcn(pptr%itype(p)) + end if + + if (use_c13) then + ! 13c state is initialized assuming del13c = -28 permil for C3, and -13 permil for C4. + ! That translates to ratios of (13c/(12c+13c)) of 0.01080455 for C3, and 0.01096945 for C4 + ! based on the following formulae: + ! r1 (13/12) = PDB + (del13c * PDB)/1000.0 + ! r2 (13/(13+12)) = r1/(1+r1) + ! PDB = 0.0112372_R8 (ratio of 13C/12C in Pee Dee Belemnite, C isotope standard) + c3_del13c = -28._r8 + c4_del13c = -13._r8 + c3_r1 = SHR_CONST_PDB + ((c3_del13c*SHR_CONST_PDB)/1000._r8) + c3_r2 = c3_r1/(1._r8 + c3_r1) + c4_r1 = SHR_CONST_PDB + ((c4_del13c*SHR_CONST_PDB)/1000._r8) + c4_r2 = c4_r1/(1._r8 + c4_r1) + + if (pftcon%c3psn(pptr%itype(p)) == 1._r8) then + leafc13_seed = leafc_seed * c3_r2 + deadstemc13_seed = deadstemc_seed * c3_r2 + else + leafc13_seed = leafc_seed * c4_r2 + deadstemc13_seed = deadstemc_seed * c4_r2 + end if + endif + end if + + ! When PFT area expands (dwt > 0), the pft-level mass density + ! is modified to conserve the original pft mass distributed + ! over the new (larger) area, plus a term to account for the + ! introduction of new seed source for leaf and deadstem + t1 = wtcol_old(p)/pptr%wtcol(p) + t2 = dwt/pptr%wtcol(p) + + tot_leaf = pcs%leafc(p) + pcs%leafc_storage(p) + pcs%leafc_xfer(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + ! when adding seed source to non-zero leaf state, use current proportions + pleaf = pcs%leafc(p)/tot_leaf + pstor = pcs%leafc_storage(p)/tot_leaf + pxfer = pcs%leafc_xfer(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + pcs%leafc(p) = pcs%leafc(p)*t1 + leafc_seed*pleaf*t2 + pcs%leafc_storage(p) = pcs%leafc_storage(p)*t1 + leafc_seed*pstor*t2 + pcs%leafc_xfer(p) = pcs%leafc_xfer(p)*t1 + leafc_seed*pxfer*t2 + pcs%frootc(p) = pcs%frootc(p) * t1 + pcs%frootc_storage(p) = pcs%frootc_storage(p) * t1 + pcs%frootc_xfer(p) = pcs%frootc_xfer(p) * t1 + pcs%livestemc(p) = pcs%livestemc(p) * t1 + pcs%livestemc_storage(p) = pcs%livestemc_storage(p) * t1 + pcs%livestemc_xfer(p) = pcs%livestemc_xfer(p) * t1 + pcs%deadstemc(p) = pcs%deadstemc(p)*t1 + deadstemc_seed*t2 + pcs%deadstemc_storage(p) = pcs%deadstemc_storage(p) * t1 + pcs%deadstemc_xfer(p) = pcs%deadstemc_xfer(p) * t1 + pcs%livecrootc(p) = pcs%livecrootc(p) * t1 + pcs%livecrootc_storage(p) = pcs%livecrootc_storage(p) * t1 + pcs%livecrootc_xfer(p) = pcs%livecrootc_xfer(p) * t1 + pcs%deadcrootc(p) = pcs%deadcrootc(p) * t1 + pcs%deadcrootc_storage(p) = pcs%deadcrootc_storage(p) * t1 + pcs%deadcrootc_xfer(p) = pcs%deadcrootc_xfer(p) * t1 + pcs%gresp_storage(p) = pcs%gresp_storage(p) * t1 + pcs%gresp_xfer(p) = pcs%gresp_xfer(p) * t1 + pcs%cpool(p) = pcs%cpool(p) * t1 + pcs%xsmrpool(p) = pcs%xsmrpool(p) * t1 + pcs%pft_ctrunc(p) = pcs%pft_ctrunc(p) * t1 + pcs%dispvegc(p) = pcs%dispvegc(p) * t1 + pcs%storvegc(p) = pcs%storvegc(p) * t1 + pcs%totvegc(p) = pcs%totvegc(p) * t1 + pcs%totpftc(p) = pcs%totpftc(p) * t1 + + ! pft-level carbon-13 state variables + if (use_c13) then + tot_leaf = pc13s%leafc(p) + pc13s%leafc_storage(p) + pc13s%leafc_xfer(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + pleaf = pc13s%leafc(p)/tot_leaf + pstor = pc13s%leafc_storage(p)/tot_leaf + pxfer = pc13s%leafc_xfer(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + pc13s%leafc(p) = pc13s%leafc(p)*t1 + leafc13_seed*pleaf*t2 + pc13s%leafc_storage(p) = pc13s%leafc_storage(p)*t1 + leafc13_seed*pstor*t2 + pc13s%leafc_xfer(p) = pc13s%leafc_xfer(p)*t1 + leafc13_seed*pxfer*t2 + pc13s%frootc(p) = pc13s%frootc(p) * t1 + pc13s%frootc_storage(p) = pc13s%frootc_storage(p) * t1 + pc13s%frootc_xfer(p) = pc13s%frootc_xfer(p) * t1 + pc13s%livestemc(p) = pc13s%livestemc(p) * t1 + pc13s%livestemc_storage(p) = pc13s%livestemc_storage(p) * t1 + pc13s%livestemc_xfer(p) = pc13s%livestemc_xfer(p) * t1 + pc13s%deadstemc(p) = pc13s%deadstemc(p)*t1 + deadstemc13_seed*t2 + pc13s%deadstemc_storage(p) = pc13s%deadstemc_storage(p) * t1 + pc13s%deadstemc_xfer(p) = pc13s%deadstemc_xfer(p) * t1 + pc13s%livecrootc(p) = pc13s%livecrootc(p) * t1 + pc13s%livecrootc_storage(p) = pc13s%livecrootc_storage(p) * t1 + pc13s%livecrootc_xfer(p) = pc13s%livecrootc_xfer(p) * t1 + pc13s%deadcrootc(p) = pc13s%deadcrootc(p) * t1 + pc13s%deadcrootc_storage(p) = pc13s%deadcrootc_storage(p) * t1 + pc13s%deadcrootc_xfer(p) = pc13s%deadcrootc_xfer(p) * t1 + pc13s%gresp_storage(p) = pc13s%gresp_storage(p) * t1 + pc13s%gresp_xfer(p) = pc13s%gresp_xfer(p) * t1 + pc13s%cpool(p) = pc13s%cpool(p) * t1 + pc13s%xsmrpool(p) = pc13s%xsmrpool(p) * t1 + pc13s%pft_ctrunc(p) = pc13s%pft_ctrunc(p) * t1 + pc13s%dispvegc(p) = pc13s%dispvegc(p) * t1 + pc13s%storvegc(p) = pc13s%storvegc(p) * t1 + pc13s%totvegc(p) = pc13s%totvegc(p) * t1 + pc13s%totpftc(p) = pc13s%totpftc(p) * t1 + endif + + tot_leaf = pns%leafn(p) + pns%leafn_storage(p) + pns%leafn_xfer(p) + pleaf = 0._r8 + pstor = 0._r8 + pxfer = 0._r8 + if (tot_leaf /= 0._r8) then + pleaf = pns%leafn(p)/tot_leaf + pstor = pns%leafn_storage(p)/tot_leaf + pxfer = pns%leafn_xfer(p)/tot_leaf + else + ! when initiating from zero leaf state, use evergreen flag to set proportions + if (pftcon%evergreen(pptr%itype(p)) == 1._r8) then + pleaf = 1._r8 + else + pstor = 1._r8 + end if + end if + ! pft-level nitrogen state variables + pns%leafn(p) = pns%leafn(p)*t1 + leafn_seed*pleaf*t2 + pns%leafn_storage(p) = pns%leafn_storage(p)*t1 + leafn_seed*pstor*t2 + pns%leafn_xfer(p) = pns%leafn_xfer(p)*t1 + leafn_seed*pxfer*t2 + pns%frootn(p) = pns%frootn(p) * t1 + pns%frootn_storage(p) = pns%frootn_storage(p) * t1 + pns%frootn_xfer(p) = pns%frootn_xfer(p) * t1 + pns%livestemn(p) = pns%livestemn(p) * t1 + pns%livestemn_storage(p) = pns%livestemn_storage(p) * t1 + pns%livestemn_xfer(p) = pns%livestemn_xfer(p) * t1 + pns%deadstemn(p) = pns%deadstemn(p)*t1 + deadstemn_seed*t2 + pns%deadstemn_storage(p) = pns%deadstemn_storage(p) * t1 + pns%deadstemn_xfer(p) = pns%deadstemn_xfer(p) * t1 + pns%livecrootn(p) = pns%livecrootn(p) * t1 + pns%livecrootn_storage(p) = pns%livecrootn_storage(p) * t1 + pns%livecrootn_xfer(p) = pns%livecrootn_xfer(p) * t1 + pns%deadcrootn(p) = pns%deadcrootn(p) * t1 + pns%deadcrootn_storage(p) = pns%deadcrootn_storage(p) * t1 + pns%deadcrootn_xfer(p) = pns%deadcrootn_xfer(p) * t1 + pns%retransn(p) = pns%retransn(p) * t1 + pns%npool(p) = pns%npool(p) * t1 + pns%pft_ntrunc(p) = pns%pft_ntrunc(p) * t1 + pns%dispvegn(p) = pns%dispvegn(p) * t1 + pns%storvegn(p) = pns%storvegn(p) * t1 + pns%totvegn(p) = pns%totvegn(p) * t1 + pns%totpftn(p) = pns%totpftn(p) * t1 + + ! update temporary seed source arrays + ! These are calculated in terms of the required contributions from + ! column-level seed source + dwt_leafc_seed(p) = leafc_seed * dwt + if (use_c13) then + dwt_leafc13_seed(p) = leafc13_seed * dwt + endif + dwt_leafn_seed(p) = leafn_seed * dwt + dwt_deadstemc_seed(p) = deadstemc_seed * dwt + if (use_c13) then + dwt_deadstemc13_seed(p) = deadstemc13_seed * dwt + endif + dwt_deadstemn_seed(p) = deadstemn_seed * dwt + + else if (dwt < 0._r8) then + + ! if the pft lost weight on the timestep, then the carbon and nitrogen state + ! variables are directed to litter, CWD, and wood product pools. + + ! N.B. : the conv_cflux, prod10_cflux, and prod100_cflux fluxes are accumulated + ! as negative values, but the fluxes for pft-to-litter are accumulated as + ! positive values + + ! set local weight variables for this pft + wt_new = pptr%wtcol(p) + wt_old = wtcol_old(p) + + !--------------- + ! C state update + !--------------- + + ! leafc + ptr => pcs%leafc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! leafc_storage + ptr => pcs%leafc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! leafc_xfer + ptr => pcs%leafc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! frootc + ptr => pcs%frootc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_frootc_to_litter(p) = dwt_frootc_to_litter(p) + init_state + end if + + ! frootc_storage + ptr => pcs%frootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! frootc_xfer + ptr => pcs%frootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc + ptr => pcs%livestemc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc_storage + ptr => pcs%livestemc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livestemc_xfer + ptr => pcs%livestemc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadstemc + ptr => pcs%deadstemc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state*pconv(pptr%itype(p)) + prod10_cflux(p) = prod10_cflux(p) + change_state*pprod10(pptr%itype(p)) + prod100_cflux(p) = prod100_cflux(p) + change_state*pprod100(pptr%itype(p)) + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state*pconv(pptr%itype(p)) + prod10_cflux(p) = prod10_cflux(p) - init_state*pprod10(pptr%itype(p)) + prod100_cflux(p) = prod100_cflux(p) - init_state*pprod100(pptr%itype(p)) + end if + + ! deadstemc_storage + ptr => pcs%deadstemc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadstemc_xfer + ptr => pcs%deadstemc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livecrootc + ptr => pcs%livecrootc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_livecrootc_to_litter(p) = dwt_livecrootc_to_litter(p) + init_state + end if + + ! livecrootc_storage + ptr => pcs%livecrootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! livecrootc_xfer + ptr => pcs%livecrootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadcrootc + ptr => pcs%deadcrootc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) - change_state + else + ptr = 0._r8 + dwt_deadcrootc_to_litter(p) = dwt_deadcrootc_to_litter(p) + init_state + end if + + ! deadcrootc_storage + ptr => pcs%deadcrootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! deadcrootc_xfer + ptr => pcs%deadcrootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! gresp_storage + ptr => pcs%gresp_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! gresp_xfer + ptr => pcs%gresp_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! cpool + ptr => pcs%cpool(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! xsmrpool + ptr => pcs%xsmrpool(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + ! pft_ctrunc + ptr => pcs%pft_ctrunc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + conv_cflux(p) = conv_cflux(p) + change_state + else + ptr = 0._r8 + conv_cflux(p) = conv_cflux(p) - init_state + end if + + if (use_c13) then + !----------------- + ! C13 state update + !----------------- + + ! set pointers to the conversion and product pool fluxes for this pft + ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes + dwt_ptr1 => conv_c13flux(p) + dwt_ptr2 => prod10_c13flux(p) + dwt_ptr3 => prod100_c13flux(p) + + ! leafc + ptr => pc13s%leafc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_storage + ptr => pc13s%leafc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafc_xfer + ptr => pc13s%leafc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc + ptr => pc13s%frootc(p) + dwt_ptr0 => dwt_frootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! frootc_storage + ptr => pc13s%frootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootc_xfer + ptr => pc13s%frootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc + ptr => pc13s%livestemc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_storage + ptr => pc13s%livestemc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemc_xfer + ptr => pc13s%livestemc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc + ptr => pc13s%deadstemc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state*pconv(pptr%itype(p)) + dwt_ptr2 = dwt_ptr2 + change_state*pprod10(pptr%itype(p)) + dwt_ptr3 = dwt_ptr3 + change_state*pprod100(pptr%itype(p)) + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state*pconv(pptr%itype(p)) + dwt_ptr2 = dwt_ptr2 - init_state*pprod10(pptr%itype(p)) + dwt_ptr3 = dwt_ptr3 - init_state*pprod100(pptr%itype(p)) + end if + + ! deadstemc_storage + ptr => pc13s%deadstemc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemc_xfer + ptr => pc13s%deadstemc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc + ptr => pc13s%livecrootc(p) + dwt_ptr0 => dwt_livecrootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! livecrootc_storage + ptr => pc13s%livecrootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootc_xfer + ptr => pc13s%livecrootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc + ptr => pc13s%deadcrootc(p) + dwt_ptr0 => dwt_deadcrootc13_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! deadcrootc_storage + ptr => pc13s%deadcrootc_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootc_xfer + ptr => pc13s%deadcrootc_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_storage + ptr => pc13s%gresp_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! gresp_xfer + ptr => pc13s%gresp_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! cpool + ptr => pc13s%cpool(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! pft_ctrunc + ptr => pc13s%pft_ctrunc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + endif + + !--------------- + ! N state update + !--------------- + + ! set pointers to the conversion and product pool fluxes for this pft + ! dwt_ptr0 is reserved for local assignment to dwt_xxx_to_litter fluxes + dwt_ptr1 => conv_nflux(p) + dwt_ptr2 => prod10_nflux(p) + dwt_ptr3 => prod100_nflux(p) + + ! leafn + ptr => pns%leafn(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafn_storage + ptr => pns%leafn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! leafn_xfer + ptr => pns%leafn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootn + ptr => pns%frootn(p) + dwt_ptr0 => dwt_frootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! frootn_storage + ptr => pns%frootn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! frootn_xfer + ptr => pns%frootn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn + ptr => pns%livestemn(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn_storage + ptr => pns%livestemn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livestemn_xfer + ptr => pns%livestemn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemn + ptr => pns%deadstemn(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state*pconv(pptr%itype(p)) + dwt_ptr2 = dwt_ptr2 + change_state*pprod10(pptr%itype(p)) + dwt_ptr3 = dwt_ptr3 + change_state*pprod100(pptr%itype(p)) + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state*pconv(pptr%itype(p)) + dwt_ptr2 = dwt_ptr2 - init_state*pprod10(pptr%itype(p)) + dwt_ptr3 = dwt_ptr3 - init_state*pprod100(pptr%itype(p)) + end if + + ! deadstemn_storage + ptr => pns%deadstemn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadstemn_xfer + ptr => pns%deadstemn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootn + ptr => pns%livecrootn(p) + dwt_ptr0 => dwt_livecrootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! livecrootn_storage + ptr => pns%livecrootn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! livecrootn_xfer + ptr => pns%livecrootn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootn + ptr => pns%deadcrootn(p) + dwt_ptr0 => dwt_deadcrootn_to_litter(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr0 = dwt_ptr0 - change_state + else + ptr = 0._r8 + dwt_ptr0 = dwt_ptr0 + init_state + end if + + ! deadcrootn_storage + ptr => pns%deadcrootn_storage(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! deadcrootn_xfer + ptr => pns%deadcrootn_xfer(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! retransn + ptr => pns%retransn(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! npool + ptr => pns%npool(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + ! pft_ntrunc + ptr => pns%pft_ntrunc(p) + init_state = ptr*wt_old + change_state = ptr*dwt + new_state = init_state+change_state + if (wt_new /= 0._r8) then + ptr = new_state/wt_new + dwt_ptr1 = dwt_ptr1 + change_state + else + ptr = 0._r8 + dwt_ptr1 = dwt_ptr1 - init_state + end if + + end if ! weight decreasing + end if ! is soil + end do ! pft loop + + ! calculate column-level seeding fluxes + do pi = 1,max_pft_per_col + do c = begc, endc + if ( pi <= cptr%npfts(c) ) then + p = cptr%pfti(c) + pi - 1 + + ! C fluxes + ccf%dwt_seedc_to_leaf(c) = ccf%dwt_seedc_to_leaf(c) + dwt_leafc_seed(p)/dt + ccf%dwt_seedc_to_deadstem(c) = ccf%dwt_seedc_to_deadstem(c) & + + dwt_deadstemc_seed(p)/dt + + ! C13 fluxes + if (use_c13) then + cc13f%dwt_seedc_to_leaf(c) = cc13f%dwt_seedc_to_leaf(c) + dwt_leafc13_seed(p)/dt + cc13f%dwt_seedc_to_deadstem(c) = cc13f%dwt_seedc_to_deadstem(c) & + + dwt_deadstemc13_seed(p)/dt + endif + + ! N fluxes + cnf%dwt_seedn_to_leaf(c) = cnf%dwt_seedn_to_leaf(c) + dwt_leafn_seed(p)/dt + cnf%dwt_seedn_to_deadstem(c) = cnf%dwt_seedn_to_deadstem(c) & + + dwt_deadstemn_seed(p)/dt + end if + end do + end do + + + ! calculate pft-to-column for fluxes into litter and CWD pools + do pi = 1,max_pft_per_col + do c = begc, endc + if ( pi <= cptr%npfts(c) ) then + p = cptr%pfti(c) + pi - 1 + + ! fine root litter carbon fluxes + ccf%dwt_frootc_to_litr1c(c) = ccf%dwt_frootc_to_litr1c(c) + & + (dwt_frootc_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt + ccf%dwt_frootc_to_litr2c(c) = ccf%dwt_frootc_to_litr2c(c) + & + (dwt_frootc_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt + ccf%dwt_frootc_to_litr3c(c) = ccf%dwt_frootc_to_litr3c(c) + & + (dwt_frootc_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt + + ! fine root litter C13 fluxes + if (use_c13) then + cc13f%dwt_frootc_to_litr1c(c) = cc13f%dwt_frootc_to_litr1c(c) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt + cc13f%dwt_frootc_to_litr2c(c) = cc13f%dwt_frootc_to_litr2c(c) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt + cc13f%dwt_frootc_to_litr3c(c) = cc13f%dwt_frootc_to_litr3c(c) + & + (dwt_frootc13_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt + endif + + ! fine root litter nitrogen fluxes + cnf%dwt_frootn_to_litr1n(c) = cnf%dwt_frootn_to_litr1n(c) + & + (dwt_frootn_to_litter(p)*pftcon%fr_flab(pptr%itype(p)))/dt + cnf%dwt_frootn_to_litr2n(c) = cnf%dwt_frootn_to_litr2n(c) + & + (dwt_frootn_to_litter(p)*pftcon%fr_fcel(pptr%itype(p)))/dt + cnf%dwt_frootn_to_litr3n(c) = cnf%dwt_frootn_to_litr3n(c) + & + (dwt_frootn_to_litter(p)*pftcon%fr_flig(pptr%itype(p)))/dt + + ! livecroot fluxes to cwd + ccf%dwt_livecrootc_to_cwdc(c) = ccf%dwt_livecrootc_to_cwdc(c) + & + (dwt_livecrootc_to_litter(p))/dt + if (use_c13) then + cc13f%dwt_livecrootc_to_cwdc(c) = cc13f%dwt_livecrootc_to_cwdc(c) + & + (dwt_livecrootc13_to_litter(p))/dt + endif + cnf%dwt_livecrootn_to_cwdn(c) = cnf%dwt_livecrootn_to_cwdn(c) + & + (dwt_livecrootn_to_litter(p))/dt + + ! deadcroot fluxes to cwd + ccf%dwt_deadcrootc_to_cwdc(c) = ccf%dwt_deadcrootc_to_cwdc(c) + & + (dwt_deadcrootc_to_litter(p))/dt + if (use_c13) then + cc13f%dwt_deadcrootc_to_cwdc(c) = cc13f%dwt_deadcrootc_to_cwdc(c) + & + (dwt_deadcrootc13_to_litter(p))/dt + endif + cnf%dwt_deadcrootn_to_cwdn(c) = cnf%dwt_deadcrootn_to_cwdn(c) + & + (dwt_deadcrootn_to_litter(p))/dt + end if + end do + end do + + ! calculate pft-to-column for fluxes into product pools and conversion flux + do pi = 1,max_pft_per_col + do c = begc,endc + if (pi <= cptr%npfts(c)) then + p = cptr%pfti(c) + pi - 1 + + ! column-level fluxes are accumulated as positive fluxes. + ! column-level C flux updates + ccf%dwt_conv_cflux(c) = ccf%dwt_conv_cflux(c) - conv_cflux(p)/dt + ccf%dwt_prod10c_gain(c) = ccf%dwt_prod10c_gain(c) - prod10_cflux(p)/dt + ccf%dwt_prod100c_gain(c) = ccf%dwt_prod100c_gain(c) - prod100_cflux(p)/dt + + ! column-level C13 flux updates + if (use_c13) then + cc13f%dwt_conv_cflux(c) = cc13f%dwt_conv_cflux(c) - conv_c13flux(p)/dt + cc13f%dwt_prod10c_gain(c) = cc13f%dwt_prod10c_gain(c) - prod10_c13flux(p)/dt + cc13f%dwt_prod100c_gain(c) = cc13f%dwt_prod100c_gain(c) - prod100_c13flux(p)/dt + endif + + ! column-level N flux updates + cnf%dwt_conv_nflux(c) = cnf%dwt_conv_nflux(c) - conv_nflux(p)/dt + cnf%dwt_prod10n_gain(c) = cnf%dwt_prod10n_gain(c) - prod10_nflux(p)/dt + cnf%dwt_prod100n_gain(c) = cnf%dwt_prod100n_gain(c) - prod100_nflux(p)/dt + + end if + end do + end do + + ! Deallocate pft-level flux arrays + deallocate(dwt_leafc_seed) + deallocate(dwt_leafn_seed) + if (use_c13) then + deallocate(dwt_leafc13_seed) + endif + deallocate(dwt_deadstemc_seed) + deallocate(dwt_deadstemn_seed) + if (use_c13) then + deallocate(dwt_deadstemc13_seed) + endif + deallocate(dwt_frootc_to_litter) + deallocate(dwt_livecrootc_to_litter) + deallocate(dwt_deadcrootc_to_litter) + if (use_c13) then + deallocate(dwt_frootc13_to_litter) + deallocate(dwt_livecrootc13_to_litter) + deallocate(dwt_deadcrootc13_to_litter) + endif + deallocate(dwt_frootn_to_litter) + deallocate(dwt_livecrootn_to_litter) + deallocate(dwt_deadcrootn_to_litter) + deallocate(conv_cflux) + deallocate(prod10_cflux) + deallocate(prod100_cflux) + if (use_c13) then + deallocate(conv_c13flux) + deallocate(prod10_c13flux) + deallocate(prod100_c13flux) + endif + deallocate(conv_nflux) + deallocate(prod10_nflux) + deallocate(prod100_nflux) + +end subroutine pftdyn_cnbal + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftwt_init +! +! !INTERFACE: + subroutine pftwt_init() +! +! !DESCRIPTION: +! Initialize time interpolation of cndv pft weights from annual to time step +! +! !USES: + use clm_varctl, only : nsrest, nsrStartup +! +! !ARGUMENTS: + implicit none +! +!EOP +! +! !LOCAL VARIABLES: + integer :: ier, p ! error status, do-loop index + integer :: begp,endp ! beg/end indices for land pfts + character(len=32) :: subname='pftwt_init' ! subroutine name + type(pft_type), pointer :: pptr ! ponter to pft derived subtype +!----------------------------------------------------------------------- + + pptr => pft + + call get_proc_bounds(begp=begp,endp=endp) + + allocate(wtcol_old(begp:endp),stat=ier) + if (ier /= 0) then + call endrun( subname//'::ERROR: pftwt_init allocation error for wtcol_old') + end if + + if (nsrest == nsrStartup) then + do p = begp,endp + pdgvs%fpcgrid(p) = pptr%wtcol(p) + pdgvs%fpcgridold(p) = pptr%wtcol(p) + wtcol_old(p) = pptr%wtcol(p) + end do + else + do p = begp,endp + wtcol_old(p) = pptr%wtcol(p) + end do + end if + + end subroutine pftwt_init + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: pftwt_interp +! +! !INTERFACE: + subroutine pftwt_interp( begp, endp ) +! +! !DESCRIPTION: +! Time interpolate cndv pft weights from annual to time step +! +! !USES: + use clm_time_manager, only : get_curr_calday, get_curr_date, & + get_days_per_year + use clm_time_manager, only : get_step_size, get_nstep + use clm_varcon , only : istsoil ! CNDV incompatible with dynLU + use clm_varctl , only : finidat +! +! !ARGUMENTS: + implicit none + integer, intent(IN) :: begp,endp ! beg/end indices for land pfts +! +!EOP +! +! !LOCAL VARIABLES: + integer :: c,g,l,p ! indices + real(r8) :: cday ! current calendar day (1.0 = 0Z on Jan 1) + real(r8) :: wt1 ! time interpolation weights + real(r8) :: dtime ! model time step + real(r8) :: days_per_year ! days per year + integer :: nstep ! time step number + integer :: year ! year (0, ...) at nstep + 1 + integer :: mon ! month (1, ..., 12) at nstep + 1 + integer :: day ! day of month (1, ..., 31) at nstep + 1 + integer :: sec ! seconds into current date at nstep + 1 + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(pft_type) , pointer :: pptr ! ... to pft derived subtype + character(len=32) :: subname='pftwt_interp' ! subroutine name + +! !CALLED FROM: +! subr. driver +!----------------------------------------------------------------------- + + ! Set pointers into derived type + + lptr => lun + pptr => pft + + ! Interpolate pft weight to current time step + ! Map interpolated pctpft to subgrid weights + ! assumes maxpatch_pft = numpft + 1, each landunit has 1 column, + ! SCAM not defined and create_croplandunit = .false. + + nstep = get_nstep() + dtime = get_step_size() + cday = get_curr_calday(offset=-int(dtime)) + days_per_year = get_days_per_year() + + wt1 = ((days_per_year + 1._r8) - cday)/days_per_year + + call get_curr_date(year, mon, day, sec, offset=int(dtime)) + + do p = begp,endp + g = pptr%gridcell(p) + l = pptr%landunit(p) + + if (lptr%itype(l) == istsoil .and. lptr%wtgcell(l) > 0._r8) then ! CNDV incompatible with dynLU + wtcol_old(p) = pptr%wtcol(p) + pptr%wtcol(p) = pdgvs%fpcgrid(p) + & + wt1 * (pdgvs%fpcgridold(p) - pdgvs%fpcgrid(p)) + pptr%wtlunit(p) = pptr%wtcol(p) + pptr%wtgcell(p) = pptr%wtcol(p) * lptr%wtgcell(l) + + if (mon==1 .and. day==1 .and. sec==dtime .and. nstep>0) then + pdgvs%fpcgridold(p) = pdgvs%fpcgrid(p) + end if + end if + end do + + end subroutine pftwt_interp + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNHarvest +! +! !INTERFACE: +subroutine CNHarvest (num_soilc, filter_soilc, num_soilp, filter_soilp) +! +! !DESCRIPTION: +! Harvest mortality routine for coupled carbon-nitrogen code (CN) +! +! !USES: + use clmtype + use pftvarcon , only : noveg, nbrdlf_evr_shrub, pprodharv10 + use clm_varcon , only : secspday + use clm_time_manager, only : get_days_per_year +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! column filter for soil points + integer, intent(in) :: num_soilp ! number of soil pfts in filter + integer, intent(in) :: filter_soilp(:) ! pft filter for soil points +! +! !CALLED FROM: +! subroutine CNEcosystemDyn +! +! !REVISION HISTORY: +! 3/29/04: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in arrays + integer , pointer :: pgridcell(:) ! pft-level index into gridcell-level quantities + integer , pointer :: ivt(:) ! pft vegetation type + + real(r8), pointer :: leafc(:) ! (gC/m2) leaf C + real(r8), pointer :: frootc(:) ! (gC/m2) fine root C + real(r8), pointer :: livestemc(:) ! (gC/m2) live stem C + real(r8), pointer :: deadstemc(:) ! (gC/m2) dead stem C + real(r8), pointer :: livecrootc(:) ! (gC/m2) live coarse root C + real(r8), pointer :: deadcrootc(:) ! (gC/m2) dead coarse root C + real(r8), pointer :: xsmrpool(:) ! (gC/m2) abstract C pool to meet excess MR demand + real(r8), pointer :: leafc_storage(:) ! (gC/m2) leaf C storage + real(r8), pointer :: frootc_storage(:) ! (gC/m2) fine root C storage + real(r8), pointer :: livestemc_storage(:) ! (gC/m2) live stem C storage + real(r8), pointer :: deadstemc_storage(:) ! (gC/m2) dead stem C storage + real(r8), pointer :: livecrootc_storage(:) ! (gC/m2) live coarse root C storage + real(r8), pointer :: deadcrootc_storage(:) ! (gC/m2) dead coarse root C storage + real(r8), pointer :: gresp_storage(:) ! (gC/m2) growth respiration storage + real(r8), pointer :: leafc_xfer(:) ! (gC/m2) leaf C transfer + real(r8), pointer :: frootc_xfer(:) ! (gC/m2) fine root C transfer + real(r8), pointer :: livestemc_xfer(:) ! (gC/m2) live stem C transfer + real(r8), pointer :: deadstemc_xfer(:) ! (gC/m2) dead stem C transfer + real(r8), pointer :: livecrootc_xfer(:) ! (gC/m2) live coarse root C transfer + real(r8), pointer :: deadcrootc_xfer(:) ! (gC/m2) dead coarse root C transfer + real(r8), pointer :: gresp_xfer(:) ! (gC/m2) growth respiration transfer + real(r8), pointer :: leafn(:) ! (gN/m2) leaf N + real(r8), pointer :: frootn(:) ! (gN/m2) fine root N + real(r8), pointer :: livestemn(:) ! (gN/m2) live stem N + real(r8), pointer :: deadstemn(:) ! (gN/m2) dead stem N + real(r8), pointer :: livecrootn(:) ! (gN/m2) live coarse root N + real(r8), pointer :: deadcrootn(:) ! (gN/m2) dead coarse root N + real(r8), pointer :: retransn(:) ! (gN/m2) plant pool of retranslocated N + real(r8), pointer :: leafn_storage(:) ! (gN/m2) leaf N storage + real(r8), pointer :: frootn_storage(:) ! (gN/m2) fine root N storage + real(r8), pointer :: livestemn_storage(:) ! (gN/m2) live stem N storage + real(r8), pointer :: deadstemn_storage(:) ! (gN/m2) dead stem N storage + real(r8), pointer :: livecrootn_storage(:) ! (gN/m2) live coarse root N storage + real(r8), pointer :: deadcrootn_storage(:) ! (gN/m2) dead coarse root N storage + real(r8), pointer :: leafn_xfer(:) ! (gN/m2) leaf N transfer + real(r8), pointer :: frootn_xfer(:) ! (gN/m2) fine root N transfer + real(r8), pointer :: livestemn_xfer(:) ! (gN/m2) live stem N transfer + real(r8), pointer :: deadstemn_xfer(:) ! (gN/m2) dead stem N transfer + real(r8), pointer :: livecrootn_xfer(:) ! (gN/m2) live coarse root N transfer + real(r8), pointer :: deadcrootn_xfer(:) ! (gN/m2) dead coarse root N transfer +! +! local pointers to implicit in/out arrays +! +! local pointers to implicit out arrays + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: hrv_deadstemc_to_prod10c(:) + real(r8), pointer :: hrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_xsmrpool_to_atm(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_leafn_to_litter(:) + real(r8), pointer :: hrv_frootn_to_litter(:) + real(r8), pointer :: hrv_livestemn_to_litter(:) + real(r8), pointer :: hrv_deadstemn_to_prod10n(:) + real(r8), pointer :: hrv_deadstemn_to_prod100n(:) + real(r8), pointer :: hrv_livecrootn_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_to_litter(:) + real(r8), pointer :: hrv_retransn_to_litter(:) + real(r8), pointer :: hrv_leafn_storage_to_litter(:) + real(r8), pointer :: hrv_frootn_storage_to_litter(:) + real(r8), pointer :: hrv_livestemn_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemn_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootn_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:) + real(r8), pointer :: hrv_leafn_xfer_to_litter(:) + real(r8), pointer :: hrv_frootn_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemn_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:) +! +! !OTHER LOCAL VARIABLES: + integer :: p ! pft index + integer :: g ! gridcell index + integer :: fp ! pft filter index + real(r8):: am ! rate for fractional harvest mortality (1/yr) + real(r8):: m ! rate for fractional harvest mortality (1/s) + real(r8):: days_per_year ! days per year +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers to pft-level arrays + pgridcell => pft%gridcell + + ivt => pft%itype + leafc => pcs%leafc + frootc => pcs%frootc + livestemc => pcs%livestemc + deadstemc => pcs%deadstemc + livecrootc => pcs%livecrootc + deadcrootc => pcs%deadcrootc + xsmrpool => pcs%xsmrpool + leafc_storage => pcs%leafc_storage + frootc_storage => pcs%frootc_storage + livestemc_storage => pcs%livestemc_storage + deadstemc_storage => pcs%deadstemc_storage + livecrootc_storage => pcs%livecrootc_storage + deadcrootc_storage => pcs%deadcrootc_storage + gresp_storage => pcs%gresp_storage + leafc_xfer => pcs%leafc_xfer + frootc_xfer => pcs%frootc_xfer + livestemc_xfer => pcs%livestemc_xfer + deadstemc_xfer => pcs%deadstemc_xfer + livecrootc_xfer => pcs%livecrootc_xfer + deadcrootc_xfer => pcs%deadcrootc_xfer + gresp_xfer => pcs%gresp_xfer + leafn => pns%leafn + frootn => pns%frootn + livestemn => pns%livestemn + deadstemn => pns%deadstemn + livecrootn => pns%livecrootn + deadcrootn => pns%deadcrootn + retransn => pns%retransn + leafn_storage => pns%leafn_storage + frootn_storage => pns%frootn_storage + livestemn_storage => pns%livestemn_storage + deadstemn_storage => pns%deadstemn_storage + livecrootn_storage => pns%livecrootn_storage + deadcrootn_storage => pns%deadcrootn_storage + leafn_xfer => pns%leafn_xfer + frootn_xfer => pns%frootn_xfer + livestemn_xfer => pns%livestemn_xfer + deadstemn_xfer => pns%deadstemn_xfer + livecrootn_xfer => pns%livecrootn_xfer + deadcrootn_xfer => pns%deadcrootn_xfer + hrv_leafc_to_litter => pcf%hrv_leafc_to_litter + hrv_frootc_to_litter => pcf%hrv_frootc_to_litter + hrv_livestemc_to_litter => pcf%hrv_livestemc_to_litter + hrv_deadstemc_to_prod10c => pcf%hrv_deadstemc_to_prod10c + hrv_deadstemc_to_prod100c => pcf%hrv_deadstemc_to_prod100c + hrv_livecrootc_to_litter => pcf%hrv_livecrootc_to_litter + hrv_deadcrootc_to_litter => pcf%hrv_deadcrootc_to_litter + hrv_xsmrpool_to_atm => pcf%hrv_xsmrpool_to_atm + hrv_leafc_storage_to_litter => pcf%hrv_leafc_storage_to_litter + hrv_frootc_storage_to_litter => pcf%hrv_frootc_storage_to_litter + hrv_livestemc_storage_to_litter => pcf%hrv_livestemc_storage_to_litter + hrv_deadstemc_storage_to_litter => pcf%hrv_deadstemc_storage_to_litter + hrv_livecrootc_storage_to_litter => pcf%hrv_livecrootc_storage_to_litter + hrv_deadcrootc_storage_to_litter => pcf%hrv_deadcrootc_storage_to_litter + hrv_gresp_storage_to_litter => pcf%hrv_gresp_storage_to_litter + hrv_leafc_xfer_to_litter => pcf%hrv_leafc_xfer_to_litter + hrv_frootc_xfer_to_litter => pcf%hrv_frootc_xfer_to_litter + hrv_livestemc_xfer_to_litter => pcf%hrv_livestemc_xfer_to_litter + hrv_deadstemc_xfer_to_litter => pcf%hrv_deadstemc_xfer_to_litter + hrv_livecrootc_xfer_to_litter => pcf%hrv_livecrootc_xfer_to_litter + hrv_deadcrootc_xfer_to_litter => pcf%hrv_deadcrootc_xfer_to_litter + hrv_gresp_xfer_to_litter => pcf%hrv_gresp_xfer_to_litter + hrv_leafn_to_litter => pnf%hrv_leafn_to_litter + hrv_frootn_to_litter => pnf%hrv_frootn_to_litter + hrv_livestemn_to_litter => pnf%hrv_livestemn_to_litter + hrv_deadstemn_to_prod10n => pnf%hrv_deadstemn_to_prod10n + hrv_deadstemn_to_prod100n => pnf%hrv_deadstemn_to_prod100n + hrv_livecrootn_to_litter => pnf%hrv_livecrootn_to_litter + hrv_deadcrootn_to_litter => pnf%hrv_deadcrootn_to_litter + hrv_retransn_to_litter => pnf%hrv_retransn_to_litter + hrv_leafn_storage_to_litter => pnf%hrv_leafn_storage_to_litter + hrv_frootn_storage_to_litter => pnf%hrv_frootn_storage_to_litter + hrv_livestemn_storage_to_litter => pnf%hrv_livestemn_storage_to_litter + hrv_deadstemn_storage_to_litter => pnf%hrv_deadstemn_storage_to_litter + hrv_livecrootn_storage_to_litter => pnf%hrv_livecrootn_storage_to_litter + hrv_deadcrootn_storage_to_litter => pnf%hrv_deadcrootn_storage_to_litter + hrv_leafn_xfer_to_litter => pnf%hrv_leafn_xfer_to_litter + hrv_frootn_xfer_to_litter => pnf%hrv_frootn_xfer_to_litter + hrv_livestemn_xfer_to_litter => pnf%hrv_livestemn_xfer_to_litter + hrv_deadstemn_xfer_to_litter => pnf%hrv_deadstemn_xfer_to_litter + hrv_livecrootn_xfer_to_litter => pnf%hrv_livecrootn_xfer_to_litter + hrv_deadcrootn_xfer_to_litter => pnf%hrv_deadcrootn_xfer_to_litter + + + days_per_year = get_days_per_year() + + ! pft loop + do fp = 1,num_soilp + p = filter_soilp(fp) + g = pgridcell(p) + + ! If this is a tree pft, then + ! get the annual harvest "mortality" rate (am) from harvest array + ! and convert to rate per second + if (ivt(p) > noveg .and. ivt(p) < nbrdlf_evr_shrub) then + + if (do_harvest) then + am = harvest(g) + m = am/(days_per_year * secspday) + else + m = 0._r8 + end if + + ! pft-level harvest carbon fluxes + ! displayed pools + hrv_leafc_to_litter(p) = leafc(p) * m + hrv_frootc_to_litter(p) = frootc(p) * m + hrv_livestemc_to_litter(p) = livestemc(p) * m + hrv_deadstemc_to_prod10c(p) = deadstemc(p) * m * & + pprodharv10(ivt(p)) + hrv_deadstemc_to_prod100c(p) = deadstemc(p) * m * & + (1.0_r8 - pprodharv10(ivt(p))) + hrv_livecrootc_to_litter(p) = livecrootc(p) * m + hrv_deadcrootc_to_litter(p) = deadcrootc(p) * m + hrv_xsmrpool_to_atm(p) = xsmrpool(p) * m + + ! storage pools + hrv_leafc_storage_to_litter(p) = leafc_storage(p) * m + hrv_frootc_storage_to_litter(p) = frootc_storage(p) * m + hrv_livestemc_storage_to_litter(p) = livestemc_storage(p) * m + hrv_deadstemc_storage_to_litter(p) = deadstemc_storage(p) * m + hrv_livecrootc_storage_to_litter(p) = livecrootc_storage(p) * m + hrv_deadcrootc_storage_to_litter(p) = deadcrootc_storage(p) * m + hrv_gresp_storage_to_litter(p) = gresp_storage(p) * m + + ! transfer pools + hrv_leafc_xfer_to_litter(p) = leafc_xfer(p) * m + hrv_frootc_xfer_to_litter(p) = frootc_xfer(p) * m + hrv_livestemc_xfer_to_litter(p) = livestemc_xfer(p) * m + hrv_deadstemc_xfer_to_litter(p) = deadstemc_xfer(p) * m + hrv_livecrootc_xfer_to_litter(p) = livecrootc_xfer(p) * m + hrv_deadcrootc_xfer_to_litter(p) = deadcrootc_xfer(p) * m + hrv_gresp_xfer_to_litter(p) = gresp_xfer(p) * m + + ! pft-level harvest mortality nitrogen fluxes + ! displayed pools + hrv_leafn_to_litter(p) = leafn(p) * m + hrv_frootn_to_litter(p) = frootn(p) * m + hrv_livestemn_to_litter(p) = livestemn(p) * m + hrv_deadstemn_to_prod10n(p) = deadstemn(p) * m * & + pprodharv10(ivt(p)) + hrv_deadstemn_to_prod100n(p) = deadstemn(p) * m * & + (1.0_r8 - pprodharv10(ivt(p))) + hrv_livecrootn_to_litter(p) = livecrootn(p) * m + hrv_deadcrootn_to_litter(p) = deadcrootn(p) * m + hrv_retransn_to_litter(p) = retransn(p) * m + + ! storage pools + hrv_leafn_storage_to_litter(p) = leafn_storage(p) * m + hrv_frootn_storage_to_litter(p) = frootn_storage(p) * m + hrv_livestemn_storage_to_litter(p) = livestemn_storage(p) * m + hrv_deadstemn_storage_to_litter(p) = deadstemn_storage(p) * m + hrv_livecrootn_storage_to_litter(p) = livecrootn_storage(p) * m + hrv_deadcrootn_storage_to_litter(p) = deadcrootn_storage(p) * m + + ! transfer pools + hrv_leafn_xfer_to_litter(p) = leafn_xfer(p) * m + hrv_frootn_xfer_to_litter(p) = frootn_xfer(p) * m + hrv_livestemn_xfer_to_litter(p) = livestemn_xfer(p) * m + hrv_deadstemn_xfer_to_litter(p) = deadstemn_xfer(p) * m + hrv_livecrootn_xfer_to_litter(p) = livecrootn_xfer(p) * m + hrv_deadcrootn_xfer_to_litter(p) = deadcrootn_xfer(p) * m + + end if ! end tree block + + end do ! end of pft loop + + ! gather all pft-level litterfall fluxes from harvest to the column + ! for litter C and N inputs + + call CNHarvestPftToColumn(num_soilc, filter_soilc) + +end subroutine CNHarvest +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: CNHarvestPftToColumn +! +! !INTERFACE: +subroutine CNHarvestPftToColumn (num_soilc, filter_soilc) +! +! !DESCRIPTION: +! called at the end of CNHarvest to gather all pft-level harvest litterfall fluxes +! to the column level and assign them to the three litter pools +! +! !USES: + use clmtype + use clm_varpar, only : max_pft_per_col, maxpatch_pft +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! soil column filter +! +! !CALLED FROM: +! subroutine CNphenology +! +! !REVISION HISTORY: +! 9/8/03: Created by Peter Thornton +! +! !LOCAL VARIABLES: +! +! local pointers to implicit in scalars + integer , pointer :: ivt(:) ! pft vegetation type + real(r8), pointer :: wtcol(:) ! pft weight relative to column (0-1) + real(r8), pointer :: pwtgcell(:) ! weight of pft relative to corresponding gridcell + real(r8), pointer :: lf_flab(:) ! leaf litter labile fraction + real(r8), pointer :: lf_fcel(:) ! leaf litter cellulose fraction + real(r8), pointer :: lf_flig(:) ! leaf litter lignin fraction + real(r8), pointer :: fr_flab(:) ! fine root litter labile fraction + real(r8), pointer :: fr_fcel(:) ! fine root litter cellulose fraction + real(r8), pointer :: fr_flig(:) ! fine root litter lignin fraction + integer , pointer :: npfts(:) ! number of pfts for each column + integer , pointer :: pfti(:) ! beginning pft index for each column + real(r8), pointer :: hrv_leafc_to_litter(:) + real(r8), pointer :: hrv_frootc_to_litter(:) + real(r8), pointer :: hrv_livestemc_to_litter(:) + real(r8), pointer :: phrv_deadstemc_to_prod10c(:) + real(r8), pointer :: phrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_livecrootc_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_to_litter(:) + real(r8), pointer :: hrv_leafc_storage_to_litter(:) + real(r8), pointer :: hrv_frootc_storage_to_litter(:) + real(r8), pointer :: hrv_livestemc_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litter(:) + real(r8), pointer :: hrv_gresp_storage_to_litter(:) + real(r8), pointer :: hrv_leafc_xfer_to_litter(:) + real(r8), pointer :: hrv_frootc_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litter(:) + real(r8), pointer :: hrv_gresp_xfer_to_litter(:) + real(r8), pointer :: hrv_leafn_to_litter(:) + real(r8), pointer :: hrv_frootn_to_litter(:) + real(r8), pointer :: hrv_livestemn_to_litter(:) + real(r8), pointer :: phrv_deadstemn_to_prod10n(:) + real(r8), pointer :: phrv_deadstemn_to_prod100n(:) + real(r8), pointer :: hrv_livecrootn_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_to_litter(:) + real(r8), pointer :: hrv_retransn_to_litter(:) + real(r8), pointer :: hrv_leafn_storage_to_litter(:) + real(r8), pointer :: hrv_frootn_storage_to_litter(:) + real(r8), pointer :: hrv_livestemn_storage_to_litter(:) + real(r8), pointer :: hrv_deadstemn_storage_to_litter(:) + real(r8), pointer :: hrv_livecrootn_storage_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_storage_to_litter(:) + real(r8), pointer :: hrv_leafn_xfer_to_litter(:) + real(r8), pointer :: hrv_frootn_xfer_to_litter(:) + real(r8), pointer :: hrv_livestemn_xfer_to_litter(:) + real(r8), pointer :: hrv_deadstemn_xfer_to_litter(:) + real(r8), pointer :: hrv_livecrootn_xfer_to_litter(:) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litter(:) +! +! local pointers to implicit in/out arrays + real(r8), pointer :: hrv_leafc_to_litr1c(:) + real(r8), pointer :: hrv_leafc_to_litr2c(:) + real(r8), pointer :: hrv_leafc_to_litr3c(:) + real(r8), pointer :: hrv_frootc_to_litr1c(:) + real(r8), pointer :: hrv_frootc_to_litr2c(:) + real(r8), pointer :: hrv_frootc_to_litr3c(:) + real(r8), pointer :: hrv_livestemc_to_cwdc(:) + real(r8), pointer :: chrv_deadstemc_to_prod10c(:) + real(r8), pointer :: chrv_deadstemc_to_prod100c(:) + real(r8), pointer :: hrv_livecrootc_to_cwdc(:) + real(r8), pointer :: hrv_deadcrootc_to_cwdc(:) + real(r8), pointer :: hrv_leafc_storage_to_litr1c(:) + real(r8), pointer :: hrv_frootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_storage_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_storage_to_litr1c(:) + real(r8), pointer :: hrv_gresp_storage_to_litr1c(:) + real(r8), pointer :: hrv_leafc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_frootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livestemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadstemc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_livecrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_deadcrootc_xfer_to_litr1c(:) + real(r8), pointer :: hrv_gresp_xfer_to_litr1c(:) + real(r8), pointer :: hrv_leafn_to_litr1n(:) + real(r8), pointer :: hrv_leafn_to_litr2n(:) + real(r8), pointer :: hrv_leafn_to_litr3n(:) + real(r8), pointer :: hrv_frootn_to_litr1n(:) + real(r8), pointer :: hrv_frootn_to_litr2n(:) + real(r8), pointer :: hrv_frootn_to_litr3n(:) + real(r8), pointer :: hrv_livestemn_to_cwdn(:) + real(r8), pointer :: chrv_deadstemn_to_prod10n(:) + real(r8), pointer :: chrv_deadstemn_to_prod100n(:) + real(r8), pointer :: hrv_livecrootn_to_cwdn(:) + real(r8), pointer :: hrv_deadcrootn_to_cwdn(:) + real(r8), pointer :: hrv_retransn_to_litr1n(:) + real(r8), pointer :: hrv_leafn_storage_to_litr1n(:) + real(r8), pointer :: hrv_frootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_livestemn_storage_to_litr1n(:) + real(r8), pointer :: hrv_deadstemn_storage_to_litr1n(:) + real(r8), pointer :: hrv_livecrootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_deadcrootn_storage_to_litr1n(:) + real(r8), pointer :: hrv_leafn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_frootn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_livestemn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_deadstemn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_livecrootn_xfer_to_litr1n(:) + real(r8), pointer :: hrv_deadcrootn_xfer_to_litr1n(:) +! +! local pointers to implicit out arrays +! +! +! !OTHER LOCAL VARIABLES: + integer :: fc,c,pi,p ! indices +!EOP +!----------------------------------------------------------------------- + + ! assign local pointers + lf_flab => pftcon%lf_flab + lf_fcel => pftcon%lf_fcel + lf_flig => pftcon%lf_flig + fr_flab => pftcon%fr_flab + fr_fcel => pftcon%fr_fcel + fr_flig => pftcon%fr_flig + + ! assign local pointers to column-level arrays + npfts => col%npfts + pfti => col%pfti + hrv_leafc_to_litr1c => ccf%hrv_leafc_to_litr1c + hrv_leafc_to_litr2c => ccf%hrv_leafc_to_litr2c + hrv_leafc_to_litr3c => ccf%hrv_leafc_to_litr3c + hrv_frootc_to_litr1c => ccf%hrv_frootc_to_litr1c + hrv_frootc_to_litr2c => ccf%hrv_frootc_to_litr2c + hrv_frootc_to_litr3c => ccf%hrv_frootc_to_litr3c + hrv_livestemc_to_cwdc => ccf%hrv_livestemc_to_cwdc + chrv_deadstemc_to_prod10c => ccf%hrv_deadstemc_to_prod10c + chrv_deadstemc_to_prod100c => ccf%hrv_deadstemc_to_prod100c + hrv_livecrootc_to_cwdc => ccf%hrv_livecrootc_to_cwdc + hrv_deadcrootc_to_cwdc => ccf%hrv_deadcrootc_to_cwdc + hrv_leafc_storage_to_litr1c => ccf%hrv_leafc_storage_to_litr1c + hrv_frootc_storage_to_litr1c => ccf%hrv_frootc_storage_to_litr1c + hrv_livestemc_storage_to_litr1c => ccf%hrv_livestemc_storage_to_litr1c + hrv_deadstemc_storage_to_litr1c => ccf%hrv_deadstemc_storage_to_litr1c + hrv_livecrootc_storage_to_litr1c => ccf%hrv_livecrootc_storage_to_litr1c + hrv_deadcrootc_storage_to_litr1c => ccf%hrv_deadcrootc_storage_to_litr1c + hrv_gresp_storage_to_litr1c => ccf%hrv_gresp_storage_to_litr1c + hrv_leafc_xfer_to_litr1c => ccf%hrv_leafc_xfer_to_litr1c + hrv_frootc_xfer_to_litr1c => ccf%hrv_frootc_xfer_to_litr1c + hrv_livestemc_xfer_to_litr1c => ccf%hrv_livestemc_xfer_to_litr1c + hrv_deadstemc_xfer_to_litr1c => ccf%hrv_deadstemc_xfer_to_litr1c + hrv_livecrootc_xfer_to_litr1c => ccf%hrv_livecrootc_xfer_to_litr1c + hrv_deadcrootc_xfer_to_litr1c => ccf%hrv_deadcrootc_xfer_to_litr1c + hrv_gresp_xfer_to_litr1c => ccf%hrv_gresp_xfer_to_litr1c + hrv_leafn_to_litr1n => cnf%hrv_leafn_to_litr1n + hrv_leafn_to_litr2n => cnf%hrv_leafn_to_litr2n + hrv_leafn_to_litr3n => cnf%hrv_leafn_to_litr3n + hrv_frootn_to_litr1n => cnf%hrv_frootn_to_litr1n + hrv_frootn_to_litr2n => cnf%hrv_frootn_to_litr2n + hrv_frootn_to_litr3n => cnf%hrv_frootn_to_litr3n + hrv_livestemn_to_cwdn => cnf%hrv_livestemn_to_cwdn + chrv_deadstemn_to_prod10n => cnf%hrv_deadstemn_to_prod10n + chrv_deadstemn_to_prod100n => cnf%hrv_deadstemn_to_prod100n + hrv_livecrootn_to_cwdn => cnf%hrv_livecrootn_to_cwdn + hrv_deadcrootn_to_cwdn => cnf%hrv_deadcrootn_to_cwdn + hrv_retransn_to_litr1n => cnf%hrv_retransn_to_litr1n + hrv_leafn_storage_to_litr1n => cnf%hrv_leafn_storage_to_litr1n + hrv_frootn_storage_to_litr1n => cnf%hrv_frootn_storage_to_litr1n + hrv_livestemn_storage_to_litr1n => cnf%hrv_livestemn_storage_to_litr1n + hrv_deadstemn_storage_to_litr1n => cnf%hrv_deadstemn_storage_to_litr1n + hrv_livecrootn_storage_to_litr1n => cnf%hrv_livecrootn_storage_to_litr1n + hrv_deadcrootn_storage_to_litr1n => cnf%hrv_deadcrootn_storage_to_litr1n + hrv_leafn_xfer_to_litr1n => cnf%hrv_leafn_xfer_to_litr1n + hrv_frootn_xfer_to_litr1n => cnf%hrv_frootn_xfer_to_litr1n + hrv_livestemn_xfer_to_litr1n => cnf%hrv_livestemn_xfer_to_litr1n + hrv_deadstemn_xfer_to_litr1n => cnf%hrv_deadstemn_xfer_to_litr1n + hrv_livecrootn_xfer_to_litr1n => cnf%hrv_livecrootn_xfer_to_litr1n + hrv_deadcrootn_xfer_to_litr1n => cnf%hrv_deadcrootn_xfer_to_litr1n + + ! assign local pointers to pft-level arrays + ivt => pft%itype + wtcol => pft%wtcol + pwtgcell => pft%wtgcell + hrv_leafc_to_litter => pcf%hrv_leafc_to_litter + hrv_frootc_to_litter => pcf%hrv_frootc_to_litter + hrv_livestemc_to_litter => pcf%hrv_livestemc_to_litter + phrv_deadstemc_to_prod10c => pcf%hrv_deadstemc_to_prod10c + phrv_deadstemc_to_prod100c => pcf%hrv_deadstemc_to_prod100c + hrv_livecrootc_to_litter => pcf%hrv_livecrootc_to_litter + hrv_deadcrootc_to_litter => pcf%hrv_deadcrootc_to_litter + hrv_leafc_storage_to_litter => pcf%hrv_leafc_storage_to_litter + hrv_frootc_storage_to_litter => pcf%hrv_frootc_storage_to_litter + hrv_livestemc_storage_to_litter => pcf%hrv_livestemc_storage_to_litter + hrv_deadstemc_storage_to_litter => pcf%hrv_deadstemc_storage_to_litter + hrv_livecrootc_storage_to_litter => pcf%hrv_livecrootc_storage_to_litter + hrv_deadcrootc_storage_to_litter => pcf%hrv_deadcrootc_storage_to_litter + hrv_gresp_storage_to_litter => pcf%hrv_gresp_storage_to_litter + hrv_leafc_xfer_to_litter => pcf%hrv_leafc_xfer_to_litter + hrv_frootc_xfer_to_litter => pcf%hrv_frootc_xfer_to_litter + hrv_livestemc_xfer_to_litter => pcf%hrv_livestemc_xfer_to_litter + hrv_deadstemc_xfer_to_litter => pcf%hrv_deadstemc_xfer_to_litter + hrv_livecrootc_xfer_to_litter => pcf%hrv_livecrootc_xfer_to_litter + hrv_deadcrootc_xfer_to_litter => pcf%hrv_deadcrootc_xfer_to_litter + hrv_gresp_xfer_to_litter => pcf%hrv_gresp_xfer_to_litter + hrv_leafn_to_litter => pnf%hrv_leafn_to_litter + hrv_frootn_to_litter => pnf%hrv_frootn_to_litter + hrv_livestemn_to_litter => pnf%hrv_livestemn_to_litter + phrv_deadstemn_to_prod10n => pnf%hrv_deadstemn_to_prod10n + phrv_deadstemn_to_prod100n => pnf%hrv_deadstemn_to_prod100n + hrv_livecrootn_to_litter => pnf%hrv_livecrootn_to_litter + hrv_deadcrootn_to_litter => pnf%hrv_deadcrootn_to_litter + hrv_retransn_to_litter => pnf%hrv_retransn_to_litter + hrv_leafn_storage_to_litter => pnf%hrv_leafn_storage_to_litter + hrv_frootn_storage_to_litter => pnf%hrv_frootn_storage_to_litter + hrv_livestemn_storage_to_litter => pnf%hrv_livestemn_storage_to_litter + hrv_deadstemn_storage_to_litter => pnf%hrv_deadstemn_storage_to_litter + hrv_livecrootn_storage_to_litter => pnf%hrv_livecrootn_storage_to_litter + hrv_deadcrootn_storage_to_litter => pnf%hrv_deadcrootn_storage_to_litter + hrv_leafn_xfer_to_litter => pnf%hrv_leafn_xfer_to_litter + hrv_frootn_xfer_to_litter => pnf%hrv_frootn_xfer_to_litter + hrv_livestemn_xfer_to_litter => pnf%hrv_livestemn_xfer_to_litter + hrv_deadstemn_xfer_to_litter => pnf%hrv_deadstemn_xfer_to_litter + hrv_livecrootn_xfer_to_litter => pnf%hrv_livecrootn_xfer_to_litter + hrv_deadcrootn_xfer_to_litter => pnf%hrv_deadcrootn_xfer_to_litter + + do pi = 1,maxpatch_pft + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (pi <= npfts(c)) then + p = pfti(c) + pi - 1 + + if (pwtgcell(p)>0._r8) then + + ! leaf harvest mortality carbon fluxes + hrv_leafc_to_litr1c(c) = hrv_leafc_to_litr1c(c) + & + hrv_leafc_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + hrv_leafc_to_litr2c(c) = hrv_leafc_to_litr2c(c) + & + hrv_leafc_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + hrv_leafc_to_litr3c(c) = hrv_leafc_to_litr3c(c) + & + hrv_leafc_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root harvest mortality carbon fluxes + hrv_frootc_to_litr1c(c) = hrv_frootc_to_litr1c(c) + & + hrv_frootc_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + hrv_frootc_to_litr2c(c) = hrv_frootc_to_litr2c(c) + & + hrv_frootc_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + hrv_frootc_to_litr3c(c) = hrv_frootc_to_litr3c(c) + & + hrv_frootc_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood harvest mortality carbon fluxes + hrv_livestemc_to_cwdc(c) = hrv_livestemc_to_cwdc(c) + & + hrv_livestemc_to_litter(p) * wtcol(p) + chrv_deadstemc_to_prod10c(c) = chrv_deadstemc_to_prod10c(c) + & + phrv_deadstemc_to_prod10c(p) * wtcol(p) + chrv_deadstemc_to_prod100c(c) = chrv_deadstemc_to_prod100c(c) + & + phrv_deadstemc_to_prod100c(p) * wtcol(p) + hrv_livecrootc_to_cwdc(c) = hrv_livecrootc_to_cwdc(c) + & + hrv_livecrootc_to_litter(p) * wtcol(p) + hrv_deadcrootc_to_cwdc(c) = hrv_deadcrootc_to_cwdc(c) + & + hrv_deadcrootc_to_litter(p) * wtcol(p) + + ! storage harvest mortality carbon fluxes + hrv_leafc_storage_to_litr1c(c) = hrv_leafc_storage_to_litr1c(c) + & + hrv_leafc_storage_to_litter(p) * wtcol(p) + hrv_frootc_storage_to_litr1c(c) = hrv_frootc_storage_to_litr1c(c) + & + hrv_frootc_storage_to_litter(p) * wtcol(p) + hrv_livestemc_storage_to_litr1c(c) = hrv_livestemc_storage_to_litr1c(c) + & + hrv_livestemc_storage_to_litter(p) * wtcol(p) + hrv_deadstemc_storage_to_litr1c(c) = hrv_deadstemc_storage_to_litr1c(c) + & + hrv_deadstemc_storage_to_litter(p) * wtcol(p) + hrv_livecrootc_storage_to_litr1c(c) = hrv_livecrootc_storage_to_litr1c(c) + & + hrv_livecrootc_storage_to_litter(p) * wtcol(p) + hrv_deadcrootc_storage_to_litr1c(c) = hrv_deadcrootc_storage_to_litr1c(c) + & + hrv_deadcrootc_storage_to_litter(p) * wtcol(p) + hrv_gresp_storage_to_litr1c(c) = hrv_gresp_storage_to_litr1c(c) + & + hrv_gresp_storage_to_litter(p) * wtcol(p) + + ! transfer harvest mortality carbon fluxes + hrv_leafc_xfer_to_litr1c(c) = hrv_leafc_xfer_to_litr1c(c) + & + hrv_leafc_xfer_to_litter(p) * wtcol(p) + hrv_frootc_xfer_to_litr1c(c) = hrv_frootc_xfer_to_litr1c(c) + & + hrv_frootc_xfer_to_litter(p) * wtcol(p) + hrv_livestemc_xfer_to_litr1c(c) = hrv_livestemc_xfer_to_litr1c(c) + & + hrv_livestemc_xfer_to_litter(p) * wtcol(p) + hrv_deadstemc_xfer_to_litr1c(c) = hrv_deadstemc_xfer_to_litr1c(c) + & + hrv_deadstemc_xfer_to_litter(p) * wtcol(p) + hrv_livecrootc_xfer_to_litr1c(c) = hrv_livecrootc_xfer_to_litr1c(c) + & + hrv_livecrootc_xfer_to_litter(p) * wtcol(p) + hrv_deadcrootc_xfer_to_litr1c(c) = hrv_deadcrootc_xfer_to_litr1c(c) + & + hrv_deadcrootc_xfer_to_litter(p) * wtcol(p) + hrv_gresp_xfer_to_litr1c(c) = hrv_gresp_xfer_to_litr1c(c) + & + hrv_gresp_xfer_to_litter(p) * wtcol(p) + + ! leaf harvest mortality nitrogen fluxes + hrv_leafn_to_litr1n(c) = hrv_leafn_to_litr1n(c) + & + hrv_leafn_to_litter(p) * lf_flab(ivt(p)) * wtcol(p) + hrv_leafn_to_litr2n(c) = hrv_leafn_to_litr2n(c) + & + hrv_leafn_to_litter(p) * lf_fcel(ivt(p)) * wtcol(p) + hrv_leafn_to_litr3n(c) = hrv_leafn_to_litr3n(c) + & + hrv_leafn_to_litter(p) * lf_flig(ivt(p)) * wtcol(p) + + ! fine root litter nitrogen fluxes + hrv_frootn_to_litr1n(c) = hrv_frootn_to_litr1n(c) + & + hrv_frootn_to_litter(p) * fr_flab(ivt(p)) * wtcol(p) + hrv_frootn_to_litr2n(c) = hrv_frootn_to_litr2n(c) + & + hrv_frootn_to_litter(p) * fr_fcel(ivt(p)) * wtcol(p) + hrv_frootn_to_litr3n(c) = hrv_frootn_to_litr3n(c) + & + hrv_frootn_to_litter(p) * fr_flig(ivt(p)) * wtcol(p) + + ! wood harvest mortality nitrogen fluxes + hrv_livestemn_to_cwdn(c) = hrv_livestemn_to_cwdn(c) + & + hrv_livestemn_to_litter(p) * wtcol(p) + chrv_deadstemn_to_prod10n(c) = chrv_deadstemn_to_prod10n(c) + & + phrv_deadstemn_to_prod10n(p) * wtcol(p) + chrv_deadstemn_to_prod100n(c) = chrv_deadstemn_to_prod100n(c) + & + phrv_deadstemn_to_prod100n(p) * wtcol(p) + hrv_livecrootn_to_cwdn(c) = hrv_livecrootn_to_cwdn(c) + & + hrv_livecrootn_to_litter(p) * wtcol(p) + hrv_deadcrootn_to_cwdn(c) = hrv_deadcrootn_to_cwdn(c) + & + hrv_deadcrootn_to_litter(p) * wtcol(p) + + ! retranslocated N pool harvest mortality fluxes + hrv_retransn_to_litr1n(c) = hrv_retransn_to_litr1n(c) + & + hrv_retransn_to_litter(p) * wtcol(p) + + ! storage harvest mortality nitrogen fluxes + hrv_leafn_storage_to_litr1n(c) = hrv_leafn_storage_to_litr1n(c) + & + hrv_leafn_storage_to_litter(p) * wtcol(p) + hrv_frootn_storage_to_litr1n(c) = hrv_frootn_storage_to_litr1n(c) + & + hrv_frootn_storage_to_litter(p) * wtcol(p) + hrv_livestemn_storage_to_litr1n(c) = hrv_livestemn_storage_to_litr1n(c) + & + hrv_livestemn_storage_to_litter(p) * wtcol(p) + hrv_deadstemn_storage_to_litr1n(c) = hrv_deadstemn_storage_to_litr1n(c) + & + hrv_deadstemn_storage_to_litter(p) * wtcol(p) + hrv_livecrootn_storage_to_litr1n(c) = hrv_livecrootn_storage_to_litr1n(c) + & + hrv_livecrootn_storage_to_litter(p) * wtcol(p) + hrv_deadcrootn_storage_to_litr1n(c) = hrv_deadcrootn_storage_to_litr1n(c) + & + hrv_deadcrootn_storage_to_litter(p) * wtcol(p) + + ! transfer harvest mortality nitrogen fluxes + hrv_leafn_xfer_to_litr1n(c) = hrv_leafn_xfer_to_litr1n(c) + & + hrv_leafn_xfer_to_litter(p) * wtcol(p) + hrv_frootn_xfer_to_litr1n(c) = hrv_frootn_xfer_to_litr1n(c) + & + hrv_frootn_xfer_to_litter(p) * wtcol(p) + hrv_livestemn_xfer_to_litr1n(c) = hrv_livestemn_xfer_to_litr1n(c) + & + hrv_livestemn_xfer_to_litter(p) * wtcol(p) + hrv_deadstemn_xfer_to_litr1n(c) = hrv_deadstemn_xfer_to_litr1n(c) + & + hrv_deadstemn_xfer_to_litter(p) * wtcol(p) + hrv_livecrootn_xfer_to_litr1n(c) = hrv_livecrootn_xfer_to_litr1n(c) + & + hrv_livecrootn_xfer_to_litter(p) * wtcol(p) + hrv_deadcrootn_xfer_to_litr1n(c) = hrv_deadcrootn_xfer_to_litr1n(c) + & + hrv_deadcrootn_xfer_to_litter(p) * wtcol(p) + + end if + end if + + end do + + end do + +end subroutine CNHarvestPftToColumn +!----------------------------------------------------------------------- + +end module pftdynMod diff --git a/components/clm/src_clm40/main/pftvarcon.F90 b/components/clm/src_clm40/main/pftvarcon.F90 new file mode 100644 index 0000000000..07882a1464 --- /dev/null +++ b/components/clm/src_clm40/main/pftvarcon.F90 @@ -0,0 +1,489 @@ +module pftvarcon + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: pftvarcon +! +! !DESCRIPTION: +! Module containing vegetation constants and method to +! read and initialize vegetation (PFT) constants. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_varpar , only : mxpft, numpft, numrad, ivis, inir + use clm_varctl , only : iulog, use_cn, use_cndv +! +! !PUBLIC TYPES: + implicit none + save +! +! Vegetation type constants +! + character(len=40) pftname(0:mxpft) !PFT description + + integer :: noveg !value for not vegetated + integer :: ndllf_evr_tmp_tree !value for Needleleaf evergreen temperate tree + integer :: ndllf_evr_brl_tree !value for Needleleaf evergreen boreal tree + integer :: ndllf_dcd_brl_tree !value for Needleleaf deciduous boreal tree + integer :: nbrdlf_evr_trp_tree !value for Broadleaf evergreen tropical tree + integer :: nbrdlf_evr_tmp_tree !value for Broadleaf evergreen temperate tree + integer :: nbrdlf_dcd_trp_tree !value for Broadleaf deciduous tropical tree + integer :: nbrdlf_dcd_tmp_tree !value for Broadleaf deciduous temperate tree + integer :: nbrdlf_dcd_brl_tree !value for Broadleaf deciduous boreal tree + integer :: ntree !value for last type of tree + integer :: nbrdlf_evr_shrub !value for Broadleaf evergreen shrub + integer :: nbrdlf_dcd_tmp_shrub !value for Broadleaf deciduous temperate shrub + integer :: nbrdlf_dcd_brl_shrub !value for Broadleaf deciduous boreal shrub + integer :: nc3_arctic_grass !value for C3 arctic grass + integer :: nc3_nonarctic_grass !value for C3 non-arctic grass + integer :: nc4_grass !value for C4 grass + integer :: npcropmin !value for first crop + integer :: ncorn !value for corn + integer :: nscereal !value for spring temperate cereal + integer :: nwcereal !value for winter temperate cereal + integer :: nsoybean !value for soybean + integer :: npcropmax !value for last prognostic crop in list + integer :: nc3crop !value for generic crop + integer :: nirrig !value for irrigated generic crop + + real(r8):: dleaf(0:mxpft) !characteristic leaf dimension (m) + real(r8):: c3psn(0:mxpft) !photosynthetic pathway: 0. = c4, 1. = c3 + real(r8):: mp(0:mxpft) !slope of conductance-to-photosynthesis relationship + real(r8):: qe25(0:mxpft) !quantum efficiency at 25C (umol CO2 / umol photon) + real(r8):: xl(0:mxpft) !leaf/stem orientation index + real(r8):: rhol(0:mxpft,numrad) !leaf reflectance: 1=vis, 2=nir + real(r8):: rhos(0:mxpft,numrad) !stem reflectance: 1=vis, 2=nir + real(r8):: taul(0:mxpft,numrad) !leaf transmittance: 1=vis, 2=nir + real(r8):: taus(0:mxpft,numrad) !stem transmittance: 1=vis, 2=nir + real(r8):: z0mr(0:mxpft) !ratio of momentum roughness length to canopy top height (-) + real(r8):: displar(0:mxpft) !ratio of displacement height to canopy top height (-) + real(r8):: roota_par(0:mxpft) !CLM rooting distribution parameter [1/m] + real(r8):: rootb_par(0:mxpft) !CLM rooting distribution parameter [1/m] + real(r8):: crop(0:mxpft) ! crop pft: 0. = not crop, 1. = crop pft + real(r8):: irrigated(0:mxpft) ! irrigated pft: 0. = not, 1. = irrigated + real(r8):: smpso(0:mxpft) !soil water potential at full stomatal opening (mm) + real(r8):: smpsc(0:mxpft) !soil water potential at full stomatal closure (mm) + real(r8):: fnitr(0:mxpft) !foliage nitrogen limitation factor (-) + ! begin new pft parameters for CN code + real(r8):: slatop(0:mxpft) !SLA at top of canopy [m^2/gC] + real(r8):: dsladlai(0:mxpft) !dSLA/dLAI [m^2/gC] + real(r8):: leafcn(0:mxpft) !leaf C:N [gC/gN] + real(r8):: flnr(0:mxpft) !fraction of leaf N in Rubisco [no units] + real(r8):: woody(0:mxpft) !woody lifeform flag (0 or 1) + real(r8):: lflitcn(0:mxpft) !leaf litter C:N (gC/gN) + real(r8):: frootcn(0:mxpft) !fine root C:N (gC/gN) + real(r8):: livewdcn(0:mxpft) !live wood (phloem and ray parenchyma) C:N (gC/gN) + real(r8):: deadwdcn(0:mxpft) !dead wood (xylem and heartwood) C:N (gC/gN) + real(r8):: grperc(0:mxpft) !growth respiration parameter + real(r8):: grpnow(0:mxpft) !growth respiration parameter + +! for crop + real(r8):: graincn(0:mxpft) !grain C:N (gC/gN) + real(r8):: mxtmp(0:mxpft) !parameter used in accFlds + real(r8):: baset(0:mxpft) !parameter used in accFlds + real(r8):: declfact(0:mxpft) !parameter used in CNAllocation + real(r8):: bfact(0:mxpft) !parameter used in CNAllocation + real(r8):: aleaff(0:mxpft) !parameter used in CNAllocation + real(r8):: arootf(0:mxpft) !parameter used in CNAllocation + real(r8):: astemf(0:mxpft) !parameter used in CNAllocation + real(r8):: arooti(0:mxpft) !parameter used in CNAllocation + real(r8):: fleafi(0:mxpft) !parameter used in CNAllocation + real(r8):: allconsl(0:mxpft) !parameter used in CNAllocation + real(r8):: allconss(0:mxpft) !parameter used in CNAllocation + real(r8):: ztopmx(0:mxpft) !parameter used in CNVegStructUpdate + real(r8):: laimx(0:mxpft) !parameter used in CNVegStructUpdate + real(r8):: gddmin(0:mxpft) !parameter used in CNPhenology + real(r8):: hybgdd(0:mxpft) !parameter used in CNPhenology + real(r8):: lfemerg(0:mxpft) !parameter used in CNPhenology + real(r8):: grnfill(0:mxpft) !parameter used in CNPhenology + integer :: mxmat(0:mxpft) !parameter used in CNPhenology + integer :: mnNHplantdate(0:mxpft)!minimum planting date for NorthHemisphere (YYYYMMDD) + integer :: mxNHplantdate(0:mxpft)!maximum planting date for NorthHemisphere (YYYYMMDD) + integer :: mnSHplantdate(0:mxpft)!minimum planting date for SouthHemisphere (YYYYMMDD) + integer :: mxSHplantdate(0:mxpft)!maximum planting date for SouthHemisphere (YYYYMMDD) + real(r8):: planttemp(0:mxpft) !planting temperature used in CNPhenology (K) + real(r8):: minplanttemp(0:mxpft) !mininum planting temperature used in CNPhenology (K) + real(r8):: froot_leaf(0:mxpft) !allocation parameter: new fine root C per new leaf C (gC/gC) + real(r8):: stem_leaf(0:mxpft) !allocation parameter: new stem c per new leaf C (gC/gC) + real(r8):: croot_stem(0:mxpft) !allocation parameter: new coarse root C per new stem C (gC/gC) + real(r8):: flivewd(0:mxpft) !allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + real(r8):: fcur(0:mxpft) !allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + real(r8):: fcurdv(0:mxpft) !alternate fcur for use with cndv + real(r8):: lf_flab(0:mxpft) !leaf litter labile fraction + real(r8):: lf_fcel(0:mxpft) !leaf litter cellulose fraction + real(r8):: lf_flig(0:mxpft) !leaf litter lignin fraction + real(r8):: fr_flab(0:mxpft) !fine root litter labile fraction + real(r8):: fr_fcel(0:mxpft) !fine root litter cellulose fraction + real(r8):: fr_flig(0:mxpft) !fine root litter lignin fraction + real(r8):: leaf_long(0:mxpft) !leaf longevity (yrs) + real(r8):: evergreen(0:mxpft) !binary flag for evergreen leaf habit (0 or 1) + real(r8):: stress_decid(0:mxpft) !binary flag for stress-deciduous leaf habit (0 or 1) + real(r8):: season_decid(0:mxpft) !binary flag for seasonal-deciduous leaf habit (0 or 1) + real(r8):: pconv(0:mxpft) !proportion of deadstem to conversion flux + real(r8):: pprod10(0:mxpft) !proportion of deadstem to 10-yr product pool + real(r8):: pprod100(0:mxpft) !proportion of deadstem to 100-yr product pool + real(r8):: pprodharv10(0:mxpft) !harvest mortality proportion of deadstem to 10-yr pool + + ! new pft parameters for CN-fire code + real(r8):: resist(0:mxpft) !resistance to fire (no units) + + ! pft parameters for CNDV code + ! from LPJ subroutine pftparameters + real(r8) pftpar20(0:mxpft) !tree maximum crown area (m2) + real(r8) pftpar28(0:mxpft) !min coldest monthly mean temperature + real(r8) pftpar29(0:mxpft) !max coldest monthly mean temperature + real(r8) pftpar30(0:mxpft) !min growing degree days (>= 5 deg C) + real(r8) pftpar31(0:mxpft) !upper limit of temperature of the warmest month (twmax) + real(r8), parameter :: reinickerp = 1.6_r8 !parameter in allometric equation + real(r8), parameter :: dwood = 2.5e5_r8 !cn wood density (gC/m3); lpj:2.0e5 + real(r8), parameter :: allom1 = 100.0_r8 !parameters in + real(r8), parameter :: allom2 = 40.0_r8 !...allometric + real(r8), parameter :: allom3 = 0.5_r8 !...equations + real(r8), parameter :: allom1s = 250.0_r8 !modified for shrubs by + real(r8), parameter :: allom2s = 8.0_r8 !X.D.Z +! +! !PUBLIC MEMBER FUNCTIONS: + public :: pftconrd ! Read and initialize vegetation (PFT) constants +! +! !REVISION HISTORY: +! Created by Sam Levis (put into module form by Mariana Vertenstein) +! 10/21/03, Peter Thornton: Added new variables for CN code +! 06/24/09, Erik Kluzek: Add indices for all pft types, and add expected_pftnames array and comparision +! 09/17/10, David Lawrence: Modified code to read in netCDF pft physiology file +! +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: pftconrd +! +! !INTERFACE: + subroutine pftconrd +! +! !DESCRIPTION: +! Read and initialize vegetation (PFT) constants +! +! !USES: + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_closefile, ncd_pio_openfile, file_desc_t, & + ncd_inqdid, ncd_inqdlen + use clm_varctl, only : fpftcon + use clm_varcon, only : tfrz + use spmdMod , only : masterproc +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! routine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + character(len=256) :: locfn ! local file name + integer :: i,n ! loop indices + integer :: ier ! error code + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + logical :: readv ! read variable in or not + character(len=32) :: subname = 'pftconrd' ! subroutine name + ! + ! Expected PFT names: The names expected on the fpftcon file and the order they are expected to be in. + ! NOTE: similar types are assumed to be together, first trees (ending with broadleaf_deciduous_boreal_tree + ! then shrubs, ending with broadleaf_deciduous_boreal_shrub, then grasses starting with c3_arctic_grass + ! and finally crops, ending with soybean + ! DO NOT CHANGE THE ORDER -- WITHOUT MODIFYING OTHER PARTS OF THE CODE WHERE THE ORDER MATTERS! + ! + character(len=40), parameter :: expected_pftnames(0:mxpft) = (/ & + 'not_vegetated ' & + , 'needleleaf_evergreen_temperate_tree' & + , 'needleleaf_evergreen_boreal_tree ' & + , 'needleleaf_deciduous_boreal_tree ' & + , 'broadleaf_evergreen_tropical_tree ' & + , 'broadleaf_evergreen_temperate_tree ' & + , 'broadleaf_deciduous_tropical_tree ' & + , 'broadleaf_deciduous_temperate_tree ' & + , 'broadleaf_deciduous_boreal_tree ' & + , 'broadleaf_evergreen_shrub ' & + , 'broadleaf_deciduous_temperate_shrub' & + , 'broadleaf_deciduous_boreal_shrub ' & + , 'c3_arctic_grass ' & + , 'c3_non-arctic_grass ' & + , 'c4_grass ' & + , 'c3_crop ' & + , 'c3_irrigated ' & + , 'corn ' & + , 'spring_temperate_cereal ' & + , 'winter_temperate_cereal ' & + , 'soybean ' & + /) +!----------------------------------------------------------------------- + + ! Set specific vegetation type values + + if (masterproc) then + write(iulog,*) 'Attempting to read PFT physiological data .....' + end if + call getfil (fpftcon, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid,'pft',dimid) + call ncd_inqdlen(ncid,dimid,npft) + + call ncd_io('pftname',pftname, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('z0mr',z0mr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('displar',displar, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('dleaf',dleaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('c3psn',c3psn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('mp',mp, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('qe25',qe25, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('rholvis',rhol(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('rholnir',rhol(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('rhosvis',rhos(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('rhosnir', rhos(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('taulvis',taul(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('taulnir',taul(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('tausvis',taus(:,ivis), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('tausnir',taus(:,inir), 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('xl',xl, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('roota_par',roota_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('rootb_par',rootb_par, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('slatop',slatop, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('dsladlai',dsladlai, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('leafcn',leafcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('flnr',flnr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('smpso',smpso, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('smpsc',smpsc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fnitr',fnitr, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('woody',woody, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('lflitcn',lflitcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('frootcn',frootcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('livewdcn',livewdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('deadwdcn',deadwdcn, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('grperc',grperc, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('grpnow',grpnow, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('froot_leaf',froot_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('stem_leaf',stem_leaf, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('croot_stem',croot_stem, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('flivewd',flivewd, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fcur',fcur, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fcurdv',fcurdv, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('lf_flab',lf_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('lf_fcel',lf_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('lf_flig',lf_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fr_flab',fr_flab, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fr_fcel',fr_fcel, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fr_flig',fr_flig, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('leaf_long',leaf_long, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('evergreen',evergreen, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('stress_decid',stress_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('season_decid',season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('resist',resist, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pftpar20',pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pftpar28',pftpar28, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pftpar29',pftpar29, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pftpar30',pftpar30, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pftpar31',pftpar31, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pconv',pconv, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pprod10',pprod10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pprodharv10',pprodharv10, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('pprod100',pprod100, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('graincn',graincn, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('mxtmp',mxtmp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('baset',baset, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('declfact',declfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('bfact',bfact, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('aleaff',aleaff, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('arootf',arootf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('astemf',astemf, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('arooti',arooti, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('fleafi',fleafi, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('allconsl',allconsl, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('allconss',allconss, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('crop',crop, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('irrigated',irrigated, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('ztopmx',ztopmx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('laimx',laimx, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('gddmin',gddmin, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('hybgdd',hybgdd, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('lfemerg',lfemerg, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('grnfill',grnfill, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('mxmat',mxmat, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('planting_temp',planttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('min_planting_temp',minplanttemp, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('min_NH_planting_date',mnNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('min_SH_planting_date',mnSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('max_NH_planting_date',mxNHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_io('max_SH_planting_date',mxSHplantdate, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun( trim(subname)//' ERROR: error in reading in pft data' ) + call ncd_pio_closefile(ncid) + + do i = 0, mxpft + if ( trim(adjustl(pftname(i))) /= trim(expected_pftnames(i)) )then + write(iulog,*)'pftconrd: pftname is NOT what is expected, name = ', & + trim(pftname(i)), ', expected name = ', trim(expected_pftnames(i)) + call endrun( 'pftconrd: bad name for pft on fpftcon dataset' ) + end if + if ( trim(pftname(i)) == 'not_vegetated' ) noveg = i + if ( trim(pftname(i)) == 'needleleaf_evergreen_temperate_tree' ) ndllf_evr_tmp_tree = i + if ( trim(pftname(i)) == 'needleleaf_evergreen_boreal_tree' ) ndllf_evr_brl_tree = i + if ( trim(pftname(i)) == 'needleleaf_deciduous_boreal_tree' ) ndllf_dcd_brl_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_tropical_tree' ) nbrdlf_evr_trp_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_temperate_tree' ) nbrdlf_evr_tmp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_tropical_tree' ) nbrdlf_dcd_trp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_tree' ) nbrdlf_dcd_tmp_tree = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_tree' ) nbrdlf_dcd_brl_tree = i + if ( trim(pftname(i)) == 'broadleaf_evergreen_shrub' ) nbrdlf_evr_shrub = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_temperate_shrub' ) nbrdlf_dcd_tmp_shrub = i + if ( trim(pftname(i)) == 'broadleaf_deciduous_boreal_shrub' ) nbrdlf_dcd_brl_shrub = i + if ( trim(pftname(i)) == 'c3_arctic_grass' ) nc3_arctic_grass = i + if ( trim(pftname(i)) == 'c3_non-arctic_grass' ) nc3_nonarctic_grass = i + if ( trim(pftname(i)) == 'c4_grass' ) nc4_grass = i + if ( trim(pftname(i)) == 'c3_crop' ) nc3crop = i + if ( trim(pftname(i)) == 'c3_irrigated' ) nirrig = i + if ( trim(pftname(i)) == 'corn' ) ncorn = i + if ( trim(pftname(i)) == 'spring_temperate_cereal' ) nscereal = i + if ( trim(pftname(i)) == 'winter_temperate_cereal' ) nwcereal = i + if ( trim(pftname(i)) == 'soybean' ) nsoybean = i + end do + + ntree = nbrdlf_dcd_brl_tree ! value for last type of tree + npcropmin = ncorn ! first prognostic crop + npcropmax = nsoybean ! last prognostic crop in list + + if (use_cndv) then + fcur(:) = fcurdv(:) + end if + + ! + ! Do some error checking + ! + if ( npcropmax /= mxpft )then + call endrun( trim(subname)//' ERROR: npcropmax is NOT the last value' ) + end if + do i = 0, mxpft + if ( (irrigated(i) == 1.0_r8) .and. i == nirrig )then + ! correct + else if ( irrigated(i) == 0.0_r8 )then + ! correct + else + call endrun( trim(subname)//' ERROR: irrigated has wrong values' ) + end if + if ( crop(i) == 1.0_r8 .and. (i >= nc3crop .and. i <= npcropmax) )then + ! correct + else if ( crop(i) == 0.0_r8 )then + ! correct + else + call endrun( trim(subname)//' ERROR: crop has wrong values' ) + end if + if ( (i /= noveg) .and. (i < npcropmin) .and. & + abs(pconv(i)+pprod10(i)+pprod100(i) - 1.0_r8) > 1.e-7_r8 )then + call endrun( trim(subname)//' ERROR: pconv+pprod10+pprod100 do NOT sum to one.' ) + end if + if ( pprodharv10(i) > 1.0_r8 .or. pprodharv10(i) < 0.0_r8 )then + call endrun( trim(subname)//' ERROR: pprodharv10 outside of range.' ) + end if + end do + + if (masterproc) then + write(iulog,*) 'Successfully read PFT physiological data' + write(iulog,*) + end if + + end subroutine pftconrd + +end module pftvarcon + diff --git a/components/clm/src_clm40/main/quadraticMod.F90 b/components/clm/src_clm40/main/quadraticMod.F90 new file mode 100644 index 0000000000..ef3e561bb7 --- /dev/null +++ b/components/clm/src_clm40/main/quadraticMod.F90 @@ -0,0 +1,57 @@ +module quadraticMod + + use abortutils , only: endrun + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_log_mod , only: errMsg => shr_log_errMsg + use clm_varctl , only: iulog + + implicit none + + public :: quadratic + +contains + + subroutine quadratic (a, b, c, r1, r2) + ! + ! !DESCRIPTION: + !==============================================================================! + !----------------- Solve quadratic equation for its two roots -----------------! + !==============================================================================! + ! Solution from Press et al (1986) Numerical Recipes: The Art of Scientific + ! Computing (Cambridge University Press, Cambridge), pp. 145. + ! + ! !REVISION HISTORY: + ! 4/5/10: Adapted from /home/bonan/ecm/psn/An_gs_iterative.f90 by Keith Oleson + ! + ! !USES: + implicit none + ! + ! !ARGUMENTS: + real(r8), intent(in) :: a,b,c ! Terms for quadratic equation + real(r8), intent(out) :: r1,r2 ! Roots of quadratic equation + ! + ! !LOCAL VARIABLES: + real(r8) :: q ! Temporary term for quadratic solution + !------------------------------------------------------------------------------ + + if (a == 0._r8) then + write (iulog,*) 'Quadratic solution error: a = ',a + call endrun(msg=errmsg(__FILE__, __LINE__)) + end if + + if (b >= 0._r8) then + q = -0.5_r8 * (b + sqrt(b*b - 4._r8*a*c)) + else + q = -0.5_r8 * (b - sqrt(b*b - 4._r8*a*c)) + end if + + r1 = q / a + if (q /= 0._r8) then + r2 = c / q + else + r2 = 1.e36_r8 + end if + + end subroutine quadratic + +end module quadraticMod diff --git a/components/clm/src_clm40/main/restFileMod.F90 b/components/clm/src_clm40/main/restFileMod.F90 new file mode 100644 index 0000000000..e330b4bfb2 --- /dev/null +++ b/components/clm/src_clm40/main/restFileMod.F90 @@ -0,0 +1,729 @@ +module restFileMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: restFileMod +! +! !DESCRIPTION: +! Reads from or writes to/ the CLM restart file. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use abortutils , only : endrun + use clm_varctl , only : iulog, use_cn + use surfrdMod , only : crop_prog + use ncdio_pio , only : file_desc_t, ncd_pio_createfile, ncd_pio_openfile, ncd_global, & + ncd_pio_closefile, ncd_defdim, ncd_putatt, ncd_enddef, check_dim +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: restFile_read + public :: restFile_write + public :: restFile_open + public :: restFile_close + public :: restFile_getfile + public :: restFile_filename ! Sets restart filename +! +! !PRIVATE MEMBER FUNCTIONS: + private :: restFile_read_pfile + private :: restFile_write_pfile ! Writes restart pointer file + private :: restFile_closeRestart ! Close restart file and write restart pointer file + private :: restFile_dimset + private :: restFile_dimcheck + private :: restFile_enddef +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !PRIVATE TYPES: None + private +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_write +! +! !INTERFACE: + subroutine restFile_write( file, nlend, noptr, rdate ) +! +! !DESCRIPTION: +! Read/write CLM restart file. +! +! !USES: + use clm_time_manager , only : timemgr_restart_io, get_nstep + use subgridRestMod , only : SubgridRest + use BiogeophysRestMod, only : BiogeophysRest + use CNRestMod , only : CNRest + use CropRestMod , only : CropRest + use accumulMod , only : accumulRest + use histFileMod , only : hist_restart_ncd +! +! !ARGUMENTS: + implicit none + character(len=*) , intent(in) :: file ! output netcdf restart file + logical, intent(in) :: nlend ! if at the end of the simulation + character(len=*) , intent(in) :: rdate ! restart file time stamp for name + logical, intent(in), optional :: noptr ! if should NOT write to the restart pointer file +! +! !CALLED FROM: +! subroutine clm_driver2 +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(file_desc_t) :: ncid ! netcdf id + integer :: i ! index + logical :: ptrfile ! write out the restart pointer file +!----------------------------------------------------------------------- + + if ( present(noptr) )then + ptrfile = .not. noptr + else + ptrfile = .true. + end if + + ! -------------------------------------------- + ! Open restart file + ! -------------------------------------------- + + call restFile_open( flag='write', file=file, ncid=ncid ) + + ! -------------------------------------------- + ! Define dimensions and variables + ! -------------------------------------------- + + call restFile_dimset ( ncid ) + + ! Define restart file variables + + call timemgr_restart_io( ncid, flag='define' ) + + call SubgridRest( ncid, flag='define' ) + + call BiogeophysRest( ncid, flag='define' ) + + if (use_cn) then + call CNRest( ncid, flag='define' ) + if ( crop_prog ) call CropRest( ncid, flag='define' ) + end if + + call accumulRest( ncid, flag='define' ) + + call hist_restart_ncd ( ncid, flag='define', rdate=rdate ) + + call restFile_enddef( ncid ) + + ! -------------------------------------------- + ! Write restart file variables + ! -------------------------------------------- + + call timemgr_restart_io( ncid, flag='write' ) + + call SubgridRest( ncid, flag='write' ) + + call BiogeophysRest( ncid, flag='write' ) + + if (use_cn) then + call CNRest( ncid, flag='write' ) + if ( crop_prog ) call CropRest( ncid, flag='write' ) + end if + + call accumulRest( ncid, flag='write' ) + + call hist_restart_ncd (ncid, flag='write' ) + + ! -------------------------------------------- + ! Close restart file and write restart pointer file + ! -------------------------------------------- + + call restFile_close( ncid ) + call restFile_closeRestart( file, nlend ) + + ! Write restart pointer file + + if ( ptrfile ) call restFile_write_pfile( file ) + + ! Write out diagnostic info + + if (masterproc) then + write(iulog,*) 'Successfully wrote out restart data at nstep = ',get_nstep() + write(iulog,'(72a1)') ("-",i=1,60) + end if + + end subroutine restFile_write + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_read +! +! !INTERFACE: + subroutine restFile_read( file ) +! +! !DESCRIPTION: +! Read a CLM restart file. +! +! !USES: + use BiogeophysRestMod, only : BiogeophysRest + use CNRestMod , only : CNRest + use CropRestMod , only : CropRest + use accumulMod , only : accumulRest + use histFileMod , only : hist_restart_ncd +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: file ! output netcdf restart file +! +! !CALLED FROM: +! subroutine initialize2 +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(file_desc_t) :: ncid ! netcdf id + integer :: i ! index +!----------------------------------------------------------------------- + + ! Open file + + call restFile_open( flag='read', file=file, ncid=ncid ) + + ! Read file + + call restFile_dimcheck( ncid ) + + call BiogeophysRest( ncid, flag='read' ) + + if (use_cn) then + call CNRest( ncid, flag='read' ) + if ( crop_prog ) call CropRest( ncid, flag='read' ) + end if + + call accumulRest( ncid, flag='read' ) + + call hist_restart_ncd (ncid, flag='read') + + ! Close file + + call restFile_close( ncid ) + + ! Write out diagnostic info + + if (masterproc) then + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) 'Successfully read restart data for restart run' + write(iulog,*) + end if + + end subroutine restFile_read + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_getfile +! +! !INTERFACE: + subroutine restFile_getfile( file, path ) +! +! !DESCRIPTION: +! Determine and obtain netcdf restart file +! +! !USES: + use clm_varctl, only : caseid, finidat, nrevsn, nsrest, brnch_retain_casename, & + nsrContinue, nsrBranch, nsrStartup + use fileutils , only : getfil +! +! !ARGUMENTS: + implicit none + character(len=*), intent(out) :: file ! name of netcdf restart file + character(len=*), intent(out) :: path ! full pathname of netcdf restart file +! +! !CALLED FROM: +! subroutine initialize2 +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: status ! return status + integer :: length ! temporary + character(len=256) :: ftest,ctest ! temporaries +!----------------------------------------------------------------------- + + ! Continue run: + ! Restart file pathname is read restart pointer file + + if (nsrest==nsrContinue) then + call restFile_read_pfile( path ) + call getfil( path, file, 0 ) + end if + + ! Branch run: + ! Restart file pathname is obtained from namelist "nrevsn" + ! Check case name consistency (case name must be different for branch run, + ! unless namelist specification states otherwise) + + if (nsrest==nsrBranch) then + length = len_trim(nrevsn) + if (nrevsn(length-2:length) == '.nc') then + path = trim(nrevsn) + else + path = trim(nrevsn) // '.nc' + end if + call getfil( path, file, 0 ) + + ! tcraig, adding xx. and .clm2 makes this more robust + ctest = 'xx.'//trim(caseid)//'.clm2' + ftest = 'xx.'//trim(file) + status = index(trim(ftest),trim(ctest)) + if (status /= 0 .and. .not.(brnch_retain_casename)) then + write(iulog,*) 'Must change case name on branch run if ',& + 'brnch_retain_casename namelist is not set' + write(iulog,*) 'previous case filename= ',trim(file),& + ' current case = ',trim(caseid), ' ctest = ',trim(ctest), & + ' ftest = ',trim(ftest) + call endrun() + end if + end if + + ! Initial run: + ! Restart file pathname is obtained from namelist "finidat" + + if (nsrest==nsrStartup) then + call getfil( finidat, file, 0 ) + end if + + end subroutine restFile_getfile + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_read_pfile +! +! !INTERFACE: + subroutine restFile_read_pfile( pnamer ) +! +! !DESCRIPTION: +! Setup restart file and perform necessary consistency checks +! +! !USES: + use fileutils , only : opnfil, getavu, relavu + use clm_varctl, only : rpntfil, rpntdir, inst_suffix +! +! !ARGUMENTS: + implicit none + character(len=*), intent(out) :: pnamer ! full path of restart file +! +! !CALLED FROM: +! subroutine restart in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i ! indices + integer :: nio ! restart unit + integer :: status ! substring check status + character(len=256) :: locfn ! Restart pointer file name +!----------------------------------------------------------------------- + + ! Obtain the restart file from the restart pointer file. + ! For restart runs, the restart pointer file contains the full pathname + ! of the restart file. For branch runs, the namelist variable + ! [nrevsn] contains the full pathname of the restart file. + ! New history files are always created for branch runs. + + if (masterproc) then + write(iulog,*) 'Reading restart pointer file....' + endif + + nio = getavu() + locfn = trim(rpntdir) //'/'// trim(rpntfil)//trim(inst_suffix) + call opnfil (locfn, nio, 'f') + read (nio,'(a256)') pnamer + call relavu (nio) + + if (masterproc) then + write(iulog,*) 'Reading restart data.....' + write(iulog,'(72a1)') ("-",i=1,60) + end if + + end subroutine restFile_read_pfile + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_closeRestart +! +! !INTERFACE: + subroutine restFile_closeRestart( file, nlend ) +! +! !DESCRIPTION: +! 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: + implicit none + character(len=*) , intent(in) :: file ! local output filename + logical, intent(in) :: nlend +! +! !CALLED FROM: +! subroutine restart in this module +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i !index +!----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Successfully wrote local restart file ',trim(file) + write(iulog,'(72a1)') ("-",i=1,60) + write(iulog,*) + end if + + end subroutine restFile_closeRestart + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_write_pfile +! +! !INTERFACE: + subroutine restFile_write_pfile( fnamer ) +! +! !DESCRIPTION: +! Open restart pointer file. Write names of current netcdf restart file. +! +! !USES: + use clm_varctl, only : rpntdir, rpntfil, inst_suffix + use fileutils , only : relavu + use fileutils , only : getavu, opnfil +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fnamer +! +! !CALLED FROM: +! subroutine restart in this module +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m ! index + integer :: nio ! restart pointer file + character(len=256) :: filename ! local file name +!----------------------------------------------------------------------- + + if (masterproc) then + nio = getavu() + filename= trim(rpntdir) //'/'// trim(rpntfil)//trim(inst_suffix) + call opnfil( filename, nio, 'f' ) + + write(nio,'(a)') fnamer + call relavu( nio ) + write(iulog,*)'Successfully wrote local restart pointer file' + end if + + end subroutine restFile_write_pfile + +!----------------------------------------------------------------------- + subroutine restFile_open( flag, file, ncid ) + + use clm_time_manager, only : get_nstep + + implicit none + character(len=*), intent(in) :: flag ! flag to specify read or write + character(len=*), intent(in) :: file ! filename + type(file_desc_t), intent(out):: ncid ! netcdf id + + integer :: omode ! netCDF dummy variable + character(len= 32) :: subname='restFile_open' ! subroutine name + + if (flag == 'write') then + + ! Create new netCDF file (in define mode) and set fill mode + ! to "no fill" to optimize performance + + if (masterproc) then + write(iulog,*) + write(iulog,*)'restFile_open: writing restart dataset at ',& + trim(file), ' at nstep = ',get_nstep() + write(iulog,*) + end if + call ncd_pio_createfile(ncid, trim(file)) + + else if (flag == 'read') then + + ! Open netcdf restart file + + if (masterproc) then + write(iulog,*) 'Reading restart dataset' + end if + call ncd_pio_openfile (ncid, trim(file), 0) + + end if + + end subroutine restFile_open + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_filename +! +! !INTERFACE: + character(len=256) function restFile_filename( rdate ) +! +! !DESCRIPTION: +! +! !USES: + use clm_varctl, only : caseid, inst_suffix +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: rdate ! input date for restart file name +! +! !CALLED FROM: +! subroutine restart in this module +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + + restFile_filename = "./"//trim(caseid)//".clm2"//trim(inst_suffix)//& + ".r."//trim(rdate)//".nc" + if (masterproc) then + write(iulog,*)'writing restart file ',trim(restFile_filename),' for model date = ',rdate + end if + + end function restFile_filename + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: restFile_dimset +! +! !INTERFACE: + subroutine restFile_dimset( ncid ) +! +! !DESCRIPTION: +! Read/Write initial data from/to netCDF instantaneous initial data file +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_time_manager, only : get_nstep, get_curr_date + use spmdMod , only : mpicom, MPI_LOGICAL + use clm_varctl , only : caseid, ctitle, version, username, hostname, fsurdat, & + conventions, source + use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd + use decompMod , only : get_proc_bounds, get_proc_global +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid +! +! !REVISION HISTORY: +! +! +! !LOCAL VARIABLES: +!EOP + integer :: yr ! current year (0 -> ...) + integer :: mon ! current month (1 -> 12) + integer :: day ! current day (1 -> 31) + integer :: mcsec ! seconds of current date + integer :: mcdate ! current date + integer :: dimid ! netCDF dimension id + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + integer :: ier ! error status + integer :: strlen_dimid ! string dimension id + character(len= 8) :: curdate ! current date + character(len= 8) :: curtime ! current time + character(len=256) :: str + character(len= 32) :: subname='restFile_dimset' ! subroutine name +!------------------------------------------------------------------------ + + call get_proc_global(numg, numl, numc, nump) + + ! Define dimensions + + call ncd_defdim(ncid, 'gridcell', numg , dimid) + call ncd_defdim(ncid, 'landunit', numl , dimid) + call ncd_defdim(ncid, 'column' , numc , dimid) + call ncd_defdim(ncid, 'pft' , nump , dimid) + + call ncd_defdim(ncid, 'levgrnd' , nlevgrnd , dimid) + call ncd_defdim(ncid, 'levlak' , nlevlak , dimid) + call ncd_defdim(ncid, 'levsno' , nlevsno , dimid) + call ncd_defdim(ncid, 'levsno1' , nlevsno+1 , dimid) + call ncd_defdim(ncid, 'levtot' , nlevsno+nlevgrnd, dimid) + call ncd_defdim(ncid, 'numrad' , numrad , dimid) + call ncd_defdim(ncid, 'string_length', 64 , dimid) + + ! Define global attributes + + call ncd_putatt(ncid, NCD_GLOBAL, 'Conventions', trim(conventions)) + call getdatetime(curdate, curtime) + str = 'created on ' // curdate // ' ' // curtime + call ncd_putatt(ncid, NCD_GLOBAL, 'history' , trim(str)) + call ncd_putatt(ncid, NCD_GLOBAL, 'username', trim(username)) + call ncd_putatt(ncid, NCD_GLOBAL, 'host' , trim(hostname)) + call ncd_putatt(ncid, NCD_GLOBAL, 'version' , trim(version)) + call ncd_putatt(ncid, NCD_GLOBAL, 'source' , trim(source)) + str = '$Id: restFileMod.F90 62967 2014-08-25 01:41:36Z mvertens $' + call ncd_putatt(ncid, NCD_GLOBAL, 'revision_id' , trim(str)) + call ncd_putatt(ncid, NCD_GLOBAL, 'case_title' , trim(ctitle)) + call ncd_putatt(ncid, NCD_GLOBAL, 'case_id' , trim(caseid)) + call ncd_putatt(ncid, NCD_GLOBAL, 'surface_dataset', trim(fsurdat)) + call ncd_putatt(ncid, NCD_GLOBAL, 'title', & + 'CLM Restart information, required to continue a simulation' ) + + + end subroutine restFile_dimset + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_dimcheck +! +! !INTERFACE: + subroutine restFile_dimcheck( ncid ) +! +! !DESCRIPTION: +! Check dimensions of restart file +! +! !USES: + use decompMod, only : get_proc_bounds, get_proc_global + use clm_varpar, only : nlevsno, nlevlak, nlevgrnd + use clm_varctl, only : single_column, nsrest, nsrStartup + implicit none +! +! !ARGUMENTS: + type(file_desc_t), intent(inout) :: ncid +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: numg ! total number of gridcells across all processors + integer :: numl ! total number of landunits across all processors + integer :: numc ! total number of columns across all processors + integer :: nump ! total number of pfts across all processors + character(len=32) :: subname='restFile_dimcheck' ! subroutine name +!----------------------------------------------------------------------- + + ! Get relevant sizes + + if ( .not. single_column .or. nsrest /= nsrStartup )then + call get_proc_global(numg, numl, numc, nump) + call check_dim(ncid, 'gridcell', numg) + call check_dim(ncid, 'landunit', numl) + call check_dim(ncid, 'column' , numc) + call check_dim(ncid, 'pft' , nump) + end if + call check_dim(ncid, 'levsno' , nlevsno) + call check_dim(ncid, 'levgrnd' , nlevgrnd) + call check_dim(ncid, 'levlak' , nlevlak) + + end subroutine restFile_dimcheck + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_enddef +! +! !INTERFACE: + subroutine restFile_enddef( ncid ) +! +! !DESCRIPTION: +! Read a CLM restart file. +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + + call ncd_enddef(ncid) + + end subroutine restFile_enddef + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: restFile_close +! +! !INTERFACE: + subroutine restFile_close( ncid ) +! +! !DESCRIPTION: +! Read a CLM restart file. +! +! !USES: +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname='restFile_close' ! subroutine name +!----------------------------------------------------------------------- + + call ncd_pio_closefile(ncid) + + end subroutine restFile_close + +end module restFileMod + + + diff --git a/components/clm/src_clm40/main/restUtilMod.F90 b/components/clm/src_clm40/main/restUtilMod.F90 new file mode 100644 index 0000000000..2e2533e881 --- /dev/null +++ b/components/clm/src_clm40/main/restUtilMod.F90 @@ -0,0 +1,1319 @@ +#include "dtypes.h" +!=================================================== +! DO NOT EDIT THIS FILE, it was generated using ../../../../../tools/cprnc/genf90/genf90.pl +! Any changes you make to this file may be lost +!=================================================== +module restUtilMod + + !----------------------------------------------------------------------- + ! provies generic routines and types for use with restart files + ! + use shr_kind_mod, only: r8=>shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4 + use shr_sys_mod, only: shr_sys_abort + use spmdMod, only: masterproc + use clm_varctl, only: iulog + use clm_varcon, only: spval, ispval + use ncdio_pio + use pio + ! + implicit none + save + private + ! save + ! + !----------------------------------------------------------------------- + +# 21 "restUtilMod.F90.in" + interface restartvar + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_0d_text + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_1d_text + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_2d_text + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_0d_int + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_1d_int + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_2d_int + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_0d_double + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_1d_double + !TYPE text,int,double + !DIMS 0,1,2 + module procedure restartvar_2d_double + module procedure restartvar_2d_double_bounds + end interface restartvar + + integer,parameter, public :: iflag_interp = 1 + integer,parameter, public :: iflag_copy = 2 + integer,parameter, public :: iflag_skip = 3 + integer,parameter, public :: iflag_noswitchdim = 0 + integer,parameter, public :: iflag_switchdim = 1 + + public :: restartvar + + private :: is_restart + +# 38 "restUtilMod.F90.in" +contains + + !----------------------------------------------------------------------- + !DIMS 0 + !TYPE text,int,double +# 43 "restUtilMod.F90.in" + subroutine restartvar_0d_text(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + character(len=*) , intent(inout) :: data + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (100!=TYPETEXT) + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 145 "restUtilMod.F90.in" + end subroutine restartvar_0d_text + !DIMS 0 + !TYPE text,int,double +# 43 "restUtilMod.F90.in" + subroutine restartvar_0d_int(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + integer(i4) , intent(inout) :: data + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (103!=TYPETEXT) + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 145 "restUtilMod.F90.in" + end subroutine restartvar_0d_int + !DIMS 0 + !TYPE text,int,double +# 43 "restUtilMod.F90.in" + subroutine restartvar_0d_double(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , intent(inout) :: data + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (102!=TYPETEXT) + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 145 "restUtilMod.F90.in" + end subroutine restartvar_0d_double + + !----------------------------------------------------------------------- + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_1d_text(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + character(len=*) , pointer :: data(:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (100!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_1d_text + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_2d_text(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + character(len=*) , pointer :: data(:,:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (100!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_2d_text + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_1d_int(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + integer(i4) , pointer :: data(:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (103!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_1d_int + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_2d_int(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + integer(i4) , pointer :: data(:,:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (103!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_2d_int + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_1d_double(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (102!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_1d_double + !DIMS 1,2 + !TYPE text,int,double +# 150 "restUtilMod.F90.in" + subroutine restartvar_2d_double(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:,:) + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if (102!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 273 "restUtilMod.F90.in" + end subroutine restartvar_2d_double + + !----------------------------------------------------------------------- + +# 277 "restUtilMod.F90.in" + subroutine restartvar_2d_double_bounds(ncid, flag, varname, xtype, & + dim1name, dim2name, switchdim, lowerb2, upperb2, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: dim1name ! dimension name + character(len=*) , intent(in) :: dim2name ! dimension name + logical , intent(in) :: switchdim + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:,:) ! raw data + logical , intent(out) :: readvar ! was var read? + integer , intent(in), optional :: lowerb2 + integer , intent(in), optional :: upperb2 + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid ! returned var id + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (switchdim) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim2name), dim2name=trim(dim1name), & + long_name=trim(long_name), units=units) + else + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + status = PIO_inq_varid(ncid, trim(varname), vardesc) + + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=>nearest_neighbor 2=>copy 3=>skip") + + if (switchdim) then + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 1) + else + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 0) + end if + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_values', (/0,1/)) + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_0', & + "1st and 2nd dims are same as model representation") + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_1', & + "1st and 2nd dims are switched from model representation") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else + + if (present(lowerb2) .and. present(upperb2)) then + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + lowerb2=lowerb2, upperb2=upperb2, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + ncid=ncid, flag=flag, readvar=readvar) + end if + + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + +# 412 "restUtilMod.F90.in" + end subroutine restartvar_2d_double_bounds + + + !----------------------------------------------------------------------- +# 416 "restUtilMod.F90.in" + logical function is_restart( ) + ! Determine if restart run + use clm_varctl, only : nsrest, nsrContinue + if (nsrest == nsrContinue) then + is_restart = .true. + else + is_restart = .false. + end if +# 424 "restUtilMod.F90.in" + end function is_restart + +end module restUtilMod diff --git a/components/clm/src_clm40/main/restUtilMod.F90.in b/components/clm/src_clm40/main/restUtilMod.F90.in new file mode 100644 index 0000000000..07a6c82cd6 --- /dev/null +++ b/components/clm/src_clm40/main/restUtilMod.F90.in @@ -0,0 +1,426 @@ +module restUtilMod + + !----------------------------------------------------------------------- + ! provies generic routines and types for use with restart files + ! + use shr_kind_mod, only: r8=>shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4 + use shr_sys_mod, only: shr_sys_abort + use spmdMod, only: masterproc + use clm_varctl, only: iulog + use clm_varcon, only: spval, ispval + use ncdio_pio + use pio + ! + implicit none + save + private + ! save + ! + !----------------------------------------------------------------------- + + interface restartvar + !DIMS 0,1,2 + !TYPE text,int,double + module procedure restartvar_{DIMS}d_{TYPE} + module procedure restartvar_2d_double_bounds + end interface restartvar + + integer,parameter, public :: iflag_interp = 1 + integer,parameter, public :: iflag_copy = 2 + integer,parameter, public :: iflag_skip = 3 + integer,parameter, public :: iflag_noswitchdim = 0 + integer,parameter, public :: iflag_switchdim = 1 + + public :: restartvar + + private :: is_restart + +contains + + !----------------------------------------------------------------------- + !DIMS 0 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , intent(inout) :: data{DIMSTR} + logical , intent(out) :: readvar ! was var read? + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if ({ITYPE}!=TYPETEXT) + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + !DIMS 1,2 + !TYPE text,int,double + subroutine restartvar_{DIMS}d_{TYPE}(& + ncid, flag, varname, xtype, dim1name, dim2name, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t) , intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + {VTYPE} , pointer :: data{DIMSTR} + logical , intent(inout) :: readvar ! was var read? + character(len=*) , intent(in), optional :: dim1name ! dimension name + character(len=*) , intent(in), optional :: dim2name ! dimension name + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (.not. present(dim1name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + long_name=trim(long_name), units=units) + else if (.not. present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), & + long_name=trim(long_name), units=units) + else if (present(dim2name)) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + + status = PIO_inq_varid(ncid, trim(varname), vardesc) + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=nearest neighbor, 2=copy directly, 3=skip") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else if (flag == 'read' .or. flag == 'write') then + +#if ({ITYPE}!=TYPETEXT) + if (.not. present(dim1name)) then + call ncd_io(varname=trim(varname), data=data, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar) + end if +#endif + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_{DIMS}d_{TYPE} + + !----------------------------------------------------------------------- + + subroutine restartvar_2d_double_bounds(ncid, flag, varname, xtype, & + dim1name, dim2name, switchdim, lowerb2, upperb2, & + long_name, units, interpinic_flag, data, readvar, & + comment, flag_meanings, missing_value, fill_value, & + imissing_value, ifill_value, flag_values, nvalid_range ) + + !---------------------------------------------------- + ! Arguments + type(file_desc_t), intent(inout) :: ncid ! netcdf file id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! netcdf data type + character(len=*) , intent(in) :: dim1name ! dimension name + character(len=*) , intent(in) :: dim2name ! dimension name + logical , intent(in) :: switchdim + character(len=*) , intent(in) :: long_name ! long name for variable + character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic + real(r8) , pointer :: data(:,:) ! raw data + logical , intent(out) :: readvar ! was var read? + integer , intent(in), optional :: lowerb2 + integer , intent(in), optional :: upperb2 + character(len=*) , intent(in), optional :: units ! long name for variable + character(len=*) , intent(in), optional :: comment ! attribute + character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int + integer , intent(in), optional :: flag_values(:) ! attribute for int + integer , intent(in), optional :: nvalid_range(2) ! attribute for int + ! + ! Local variables + integer :: ivalue + type(var_desc_t) :: vardesc ! local vardesc + integer :: status ! return error code + integer :: varid ! returned var id + integer :: lxtype ! local external type (in case logical variable) + !---------------------------------------------------- + + if (flag == 'define') then + + if ( xtype == ncd_log )then + lxtype = ncd_int + else + lxtype = xtype + end if + + if (switchdim) then + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim2name), dim2name=trim(dim1name), & + long_name=trim(long_name), units=units) + else + call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, & + dim1name=trim(dim1name), dim2name=trim(dim2name), & + long_name=trim(long_name), units=units) + end if + status = PIO_inq_varid(ncid, trim(varname), vardesc) + + varid = vardesc%varid + + if (trim(interpinic_flag) == 'interp') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp) + else if (trim(interpinic_flag) == 'copy') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy) + else if (trim(interpinic_flag) == 'skip') then + status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip) + end if + status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', & + "1=>nearest_neighbor 2=>copy 3=>skip") + + if (switchdim) then + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 1) + else + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 0) + end if + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_values', (/0,1/)) + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_0', & + "1st and 2nd dims are same as model representation") + status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_1', & + "1st and 2nd dims are switched from model representation") + + if (present(comment)) then + call ncd_putatt(ncid, varid, 'comment', trim(comment)) + end if + if (present(units)) then + call ncd_putatt(ncid, varid, 'units', trim(units)) + end if + if (present(fill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype) + end if + if (present(missing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) + else if (lxtype == ncd_double) then + call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype) + end if + if (present(ifill_value)) then + call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype) + end if + if (present(imissing_value)) then + call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) + else if (lxtype == ncd_int) then + call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype) + end if + if (present(nvalid_range)) then + status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) + end if + if ( xtype == ncd_log )then + status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) + status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) + status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) + end if + + else + + if (present(lowerb2) .and. present(upperb2)) then + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + lowerb2=lowerb2, upperb2=upperb2, & + ncid=ncid, flag=flag, readvar=readvar) + else + call ncd_io(varname=trim(varname), data=data, & + dim1name=trim(dim1name), switchdim=switchdim, & + ncid=ncid, flag=flag, readvar=readvar) + end if + + end if + + if (flag == 'read') then + if (.not. readvar .and. is_restart()) call shr_sys_abort() + end if + + end subroutine restartvar_2d_double_bounds + + + !----------------------------------------------------------------------- + logical function is_restart( ) + ! Determine if restart run + use clm_varctl, only : nsrest, nsrContinue + if (nsrest == nsrContinue) then + is_restart = .true. + else + is_restart = .false. + end if + end function is_restart + +end module restUtilMod diff --git a/components/clm/src_clm40/main/spmdGathScatMod.F90 b/components/clm/src_clm40/main/spmdGathScatMod.F90 new file mode 100644 index 0000000000..209a1d2a4e --- /dev/null +++ b/components/clm/src_clm40/main/spmdGathScatMod.F90 @@ -0,0 +1,536 @@ +module spmdGathScatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: spmdGathScatMod +! +! !DESCRIPTION: +! Perform SPMD gather and scatter operations. +! +! !USES: + use clm_varcon, only: spval, ispval + use decompMod, only : get_clmlevel_gsmap + use shr_kind_mod, only: r8 => shr_kind_r8 + use spmdMod + use mct_mod + use abortutils, only : endrun + use clm_varctl, only : iulog + use perf_mod +! +! !PUBLIC TYPES: + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: + public scatter_data_from_master, gather_data_to_master + + interface scatter_data_from_master + module procedure scatter_1darray_int + module procedure scatter_1darray_real + end interface + + interface gather_data_to_master + module procedure gather_1darray_int + module procedure gather_1darray_real + end interface +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +! + integer,private,parameter :: debug = 0 + +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: scatter_1darray_int +! +! !INTERFACE: + subroutine scatter_1darray_int (alocal, aglobal, clmlevel) +! +! !DESCRIPTION: +! Wrapper routine to scatter int 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , pointer :: alocal(:) ! local data (output) + integer , pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + integer ,pointer :: adata(:) ! local data array + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'scatter_1darray_int' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(istring) == 0) then + istring = trim(fname) + else + istring = trim(istring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + if (debug > 1) call t_startf(trim(subname)//'_pack') + + if (masterproc) then + lsize = size(aglobal,dim=1) + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + allocate(adata(lsize)) + do n2 = lb2,ub2 + adata(1:lsize) = aglobal(1:lsize) + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importIattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_scat') + + call mct_aVect_scatter(AVi, AVo, gsmap, 0, mpicom) + + if (debug > 1) call t_stopf(trim(subname)//'_scat') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + lsize = size(alocal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportIattr(AVo,trim(fname),adata,lsize) + do n1 = lb1,ub1 + alocal(n1) = adata(n1-lb1+1) + enddo + enddo + deallocate(adata) + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVi) + endif + call mct_aVect_clean(AVo) + + call t_stopf(trim(subname)//'_total') + + end subroutine scatter_1darray_int + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: gather_1darray_int +! +! !INTERFACE: + subroutine gather_1darray_int (alocal, aglobal, clmlevel, missing) +! +! !DESCRIPTION: +! Wrapper routine to gather int 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , pointer :: alocal(:) ! local data (output) + integer , pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid + integer ,optional,intent(in) :: missing ! missing value +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + integer ,pointer :: adata(:) ! temporary data array + integer ,pointer :: mvect(:) ! local array for mask + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'gather_1darray_int' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lsize = size(alocal,dim=1) + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + if (present(missing)) then + istring = "mask" + endif + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(istring) == 0) then + istring = trim(fname) + else + istring = trim(istring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + + if (debug > 1) call t_startf(trim(subname)//'_pack') + allocate(adata(lsize)) + do n2 = lb2,ub2 + do n1 = lb1,ub1 + adata(n1-lb1+1) = alocal(n1) + enddo + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importIattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + + if (present(missing)) then + allocate(mvect(lsize)) + do n1 = lb1,ub1 + mvect(n1-lb1+1) = 1 + enddo + call mct_aVect_importIattr(AVi,"mask",mvect,lsize) + deallocate(mvect) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_gath') + + if (present(missing)) then +! tcx wait for update in mct, then get rid of "mask" +! call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom, missing = missing) + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + else + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_gath') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + if (masterproc) then + lsize = size(aglobal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportIattr(AVo,trim(fname),adata,lsize) + aglobal(1:lsize) = adata(1:lsize) + enddo + deallocate(adata) + if (present(missing)) then + allocate(mvect(lsize)) + call mct_aVect_exportIattr(AVo,"mask",mvect,lsize) + do n1 = 1,lsize + if (mvect(n1) == 0) then + do n2 = lb2,ub2 + aglobal(n1) = missing + enddo + endif + enddo + deallocate(mvect) + endif + endif + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVo) + endif + + call mct_aVect_clean(AVi) + + call t_stopf(trim(subname)//'_total') + + end subroutine gather_1darray_int + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: scatter_1darray_real +! +! !INTERFACE: + subroutine scatter_1darray_real (alocal, aglobal, clmlevel) +! +! !DESCRIPTION: +! Wrapper routine to scatter real 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: alocal(:) ! local data (output) + real(r8), pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + real(r8),pointer :: adata(:) ! local data array + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'scatter_1darray_real' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(rstring) == 0) then + rstring = trim(fname) + else + rstring = trim(rstring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + if (debug > 1) call t_startf(trim(subname)//'_pack') + + if (masterproc) then + lsize = size(aglobal,dim=1) + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + allocate(adata(lsize)) + do n2 = lb2,ub2 + adata(1:lsize) = aglobal(1:lsize) + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importRattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_scat') + + call mct_aVect_scatter(AVi, AVo, gsmap, 0, mpicom) + + if (debug > 1) call t_stopf(trim(subname)//'_scat') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + lsize = size(alocal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportRattr(AVo,trim(fname),adata,lsize) + do n1 = lb1,ub1 + alocal(n1) = adata(n1-lb1+1) + enddo + enddo + deallocate(adata) + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVi) + endif + call mct_aVect_clean(AVo) + + call t_stopf(trim(subname)//'_total') + + end subroutine scatter_1darray_real + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: gather_1darray_real +! +! !INTERFACE: + subroutine gather_1darray_real (alocal, aglobal, clmlevel, missing) +! +! !DESCRIPTION: +! Wrapper routine to gather real 1d array +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), pointer :: alocal(:) ! local data (output) + real(r8), pointer :: aglobal(:) ! global data (input) + character(len=*) ,intent(in) :: clmlevel ! type of input grid + real(r8),optional,intent(in) :: missing ! missing value +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n1,n2,lb1,ub1,lb2,ub2 ! indices + integer :: lsize ! size of local array + type(mct_aVect) :: AVi, AVo ! attribute vectors + real(r8),pointer :: adata(:) ! temporary data array + integer ,pointer :: mvect(:) ! local array for mask + character(len=256) :: rstring ! real field list string + character(len=256) :: istring ! int field list string + character(len=8) :: fname ! arbitrary field name + type(mct_gsMap),pointer :: gsmap ! global seg map + character(len=*),parameter :: subname = 'gather_1darray_real' + +!----------------------------------------------------------------------- + + call t_startf(trim(subname)//'_total') + call get_clmlevel_gsmap(clmlevel,gsmap) + + lsize = size(alocal,dim=1) + lb1 = lbound(alocal,dim=1) + ub1 = ubound(alocal,dim=1) + lb2 = 1 + ub2 = 1 + + rstring = "" + istring = "" + + if (present(missing)) then + istring = "mask" + endif + + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + if (len_trim(rstring) == 0) then + rstring = trim(fname) + else + rstring = trim(rstring)//":"//trim(fname) + endif + enddo + + if (masterproc .and. debug > 2) then + write(iulog,*) trim(subname),' strings:',trim(rstring),' ',trim(istring) + endif + + call mct_aVect_init(AVi,rList=trim(rstring),iList=trim(istring),lsize=lsize) + + if (debug > 1) call t_startf(trim(subname)//'_pack') + allocate(adata(lsize)) + do n2 = lb2,ub2 + do n1 = lb1,ub1 + adata(n1-lb1+1) = alocal(n1) + enddo + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_importRattr(AVi,trim(fname),adata,lsize) + enddo + deallocate(adata) + + if (present(missing)) then + allocate(mvect(lsize)) + do n1 = lb1,ub1 + mvect(n1-lb1+1) = 1 + enddo + call mct_aVect_importIattr(AVi,"mask",mvect,lsize) + deallocate(mvect) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_pack') + if (debug > 1) call t_startf(trim(subname)//'_gath') + + if (present(missing)) then +! tcx wait for update in mct, then get rid of "mask" +! call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom, missing = missing) + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + else + call mct_aVect_gather(AVi, AVo, gsmap, 0, mpicom) + endif + + if (debug > 1) call t_stopf(trim(subname)//'_gath') + if (debug > 1) call t_startf(trim(subname)//'_upck') + + if (masterproc) then + lsize = size(aglobal,dim=1) + allocate(adata(lsize)) + do n2 = lb2,ub2 + write(fname,'(a1,i3.3)') 'f',n2-lb2+1 + call mct_aVect_exportRattr(AVo,trim(fname),adata,lsize) + aglobal(1:lsize) = adata(1:lsize) + enddo + deallocate(adata) + if (present(missing)) then + allocate(mvect(lsize)) + call mct_aVect_exportIattr(AVo,"mask",mvect,lsize) + do n1 = 1,lsize + if (mvect(n1) == 0) then + do n2 = lb2,ub2 + aglobal(n1) = missing + enddo + endif + enddo + deallocate(mvect) + endif + endif + + if (debug > 1) call t_stopf(trim(subname)//'_upck') + + if (masterproc) then + call mct_aVect_clean(AVo) + endif + + call mct_aVect_clean(AVi) + + call t_stopf(trim(subname)//'_total') + + end subroutine gather_1darray_real + +end module spmdGathScatMod diff --git a/components/clm/src_clm40/main/spmdMod.F90 b/components/clm/src_clm40/main/spmdMod.F90 new file mode 100644 index 0000000000..6983b96281 --- /dev/null +++ b/components/clm/src_clm40/main/spmdMod.F90 @@ -0,0 +1,142 @@ + +module spmdMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: spmdMod +! +! !DESCRIPTION: +! SPMD initialization +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!EOP +!----------------------------------------------------------------------- + + use shr_kind_mod, only: r8 => shr_kind_r8 + use clm_varctl , only: iulog + implicit none + + private + +#include + + save + + ! Default settings valid even if there is no spmd + + logical, public :: masterproc ! proc 0 logical for printing msgs + integer, public :: iam ! processor number + integer, public :: npes ! number of processors for clm + integer, public :: mpicom ! communicator group for clm + integer, public :: comp_id ! component id + + ! + ! Public methods + ! + public :: spmd_init ! Initialization + + ! + ! Values from mpif.h that can be used + ! + public :: MPI_INTEGER + public :: MPI_REAL8 + public :: MPI_LOGICAL + public :: MPI_SUM + public :: MPI_MIN + public :: MPI_MAX + public :: MPI_LOR + public :: MPI_STATUS_SIZE + public :: MPI_ANY_SOURCE + public :: MPI_CHARACTER + public :: MPI_COMM_WORLD + public :: MPI_MAX_PROCESSOR_NAME + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: spmd_init( clm_mpicom ) +! +! !INTERFACE: + subroutine spmd_init( clm_mpicom, LNDID ) +! +! !DESCRIPTION: +! MPI initialization (number of cpus, processes, tids, etc) +! +! !USES +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: clm_mpicom + integer, intent(in) :: LNDID +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i,j ! indices + integer :: ier ! return error status + integer :: mylength ! my processor length + logical :: mpi_running ! temporary + integer, allocatable :: length(:) + integer, allocatable :: displ(:) + character*(MPI_MAX_PROCESSOR_NAME), allocatable :: procname(:) + character*(MPI_MAX_PROCESSOR_NAME) :: myprocname +!----------------------------------------------------------------------- + + ! Initialize mpi communicator group + + mpicom = clm_mpicom + + comp_id = LNDID + + ! Get my processor id + + call mpi_comm_rank(mpicom, iam, ier) + if (iam==0) then + masterproc = .true. + else + masterproc = .false. + end if + + ! Get number of processors + + call mpi_comm_size(mpicom, npes, ier) + + ! Get my processor names + + allocate (length(0:npes-1), displ(0:npes-1), procname(0:npes-1)) + + call mpi_get_processor_name (myprocname, mylength, ier) + call mpi_allgather(mylength,1,MPI_INTEGER,length,1,MPI_INTEGER,mpicom,ier) + + do i = 0,npes-1 + displ(i)=i*MPI_MAX_PROCESSOR_NAME + end do + call mpi_gatherv (myprocname,mylength,MPI_CHARACTER, & + procname,length,displ,MPI_CHARACTER,0,mpicom,ier) + if (masterproc) then + write(iulog,100)npes + write(iulog,200) + write(iulog,220) + do i=0,npes-1 + write(iulog,250)i,(procname((i))(j:j),j=1,length(i)) + end do + endif + + deallocate (length, displ, procname) + +100 format(//,i3," pes participating in computation for CLM") +200 format(/,35('-')) +220 format(/,"NODE#",2x,"NAME") +250 format("(",i5,")",2x,100a1,//) + + end subroutine spmd_init + +end module spmdMod diff --git a/components/clm/src_clm40/main/subgridAveMod.F90 b/components/clm/src_clm40/main/subgridAveMod.F90 new file mode 100644 index 0000000000..426beb1a60 --- /dev/null +++ b/components/clm/src_clm40/main/subgridAveMod.F90 @@ -0,0 +1,1695 @@ +module subgridAveMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: subgridAveMod +! +! !DESCRIPTION: +! Utilities to perfrom subgrid averaging +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use clmtype + use clm_varcon, only : spval, isturb, icol_roof, icol_sunwall, icol_shadewall, & + icol_road_perv, icol_road_imperv + use clm_varctl, only : iulog + use abortutils, only : endrun + +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: p2c ! Perfrom an average from pfts to columns + public :: p2l ! Perfrom an average from pfts to landunits + public :: p2g ! Perfrom an average from pfts to gridcells + public :: c2l ! Perfrom an average from columns to landunits + public :: c2g ! Perfrom an average from columns to gridcells + public :: l2g ! Perfrom an average from landunits to gridcells + + interface p2c + module procedure p2c_1d + module procedure p2c_2d + module procedure p2c_1d_filter + module procedure p2c_2d_filter + end interface + interface p2l + module procedure p2l_1d + module procedure p2l_2d + end interface + interface p2g + module procedure p2g_1d + module procedure p2g_2d + end interface + interface c2l + module procedure c2l_1d + module procedure c2l_2d + end interface + interface c2g + module procedure c2g_1d + module procedure c2g_2d + end interface + interface l2g + module procedure l2g_1d + module procedure l2g_2d + end interface +! +! !PRIVATE MEMBER FUNCTIONS: + private :: build_scale_l2g + private :: create_scale_l2g_lookup +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +!EOP + +! WJS (10-14-11): TODO: +! +! - I believe that scale_p2c, scale_c2l and scale_l2g should be included in the sumwt +! accumulations (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but +! that requires some more thought to (1) make sure that is correct, and (2) make sure it +! doesn't break the urban scaling. (See also my notes in create_scale_l2g_lookup.) +! - Once that is done, you could use a scale of 0, avoiding the need for the use of +! spval and the special checks that requires. +! +! - Currently, there is a lot of repeated code to calculate scale_c2l. This should be +! cleaned up. +! - At a minimum, should collect the repeated code into a subroutine to eliminate this +! repitition +! - The best thing might be to use a lookup array, as is done for scale_l2g +! ----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2c_1d +! +! !INTERFACE: + subroutine p2c_1d (lbp, ubp, lbc, ubc, parr, carr, p2c_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from pfts to columns. +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_col +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft + integer , intent(in) :: lbc, ubc ! beginning and ending column + real(r8), intent(in) :: parr(lbp:ubp) ! pft array + real(r8), intent(out) :: carr(lbc:ubc) ! column array + character(len=*), intent(in) :: p2c_scale_type ! scale type +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pi,p,c,index ! indices + real(r8) :: scale_p2c(lbp:ubp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(lbc:ubc) ! sum of weights + real(r8), pointer :: wtcol(:) ! weight of pft relative to column + integer , pointer :: pcolumn(:) ! column index of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in column + integer , pointer :: pfti(:) ! initial pft index in column +!------------------------------------------------------------------------ + + wtcol => pft%wtcol + pcolumn => pft%column + npfts => col%npfts + pfti => col%pfti + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_1d error: scale type ',p2c_scale_type,' not supported' + call endrun() + end if + + carr(lbc:ubc) = spval + sumwt(lbc:ubc) = 0._r8 + do p = lbp,ubp + if (wtcol(p) /= 0._r8) then + if (parr(p) /= spval) then + c = pcolumn(p) + if (sumwt(c) == 0._r8) carr(c) = 0._r8 + carr(c) = carr(c) + parr(p) * scale_p2c(p) * wtcol(p) + sumwt(c) = sumwt(c) + wtcol(p) + end if + end if + end do + found = .false. + do c = lbc,ubc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c) = carr(c)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c error: sumwt is greater than 1.0 at c= ',index + call endrun() + end if + + end subroutine p2c_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2c_2d +! +! !INTERFACE: + subroutine p2c_2d (lbp, ubp, lbc, ubc, num2d, parr, carr, p2c_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from landunits to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_col +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft + integer , intent(in) :: lbc, ubc ! beginning and ending column + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr(lbp:ubp,num2d) ! pft array + real(r8), intent(out) :: carr(lbc:ubc,num2d) ! column array + character(len=*), intent(in) :: p2c_scale_type ! scale type +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,pi,p,c,index ! indices + real(r8) :: scale_p2c(lbp:ubp) ! scale factor for column->landunit mapping + logical :: found ! temporary for error check + real(r8) :: sumwt(lbc:ubc) ! sum of weights + real(r8), pointer :: wtcol(:) ! weight of pft relative to column + integer , pointer :: pcolumn(:) ! column index of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in column + integer , pointer :: pfti(:) ! initial pft index in column +!------------------------------------------------------------------------ + + wtcol => pft%wtcol + pcolumn => pft%column + npfts => col%npfts + pfti => col%pfti + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2c_2d error: scale type ',p2c_scale_type,' not supported' + call endrun() + end if + + carr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do p = lbp,ubp + if (wtcol(p) /= 0._r8) then + if (parr(p,j) /= spval) then + c = pcolumn(p) + if (sumwt(c) == 0._r8) carr(c,j) = 0._r8 + carr(c,j) = carr(c,j) + parr(p,j) * scale_p2c(p) * wtcol(p) + sumwt(c) = sumwt(c) + wtcol(p) + end if + end if + end do + found = .false. + do c = lbc,ubc + if (sumwt(c) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = c + else if (sumwt(c) /= 0._r8) then + carr(c,j) = carr(c,j)/sumwt(c) + end if + end do + if (found) then + write(iulog,*)'p2c_2d error: sumwt is greater than 1.0 at c= ',index,' lev= ',j + call endrun() + end if + end do + end subroutine p2c_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2c_1d_filter +! +! !INTERFACE: + subroutine p2c_1d_filter (numfc, filterc, pftarr, colarr) +! +! !DESCRIPTION: +! perform pft to column averaging for single level pft arrays +! +! !USES: + use clm_varpar, only : max_pft_per_col + use clm_varcon, only : istice_mec +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), pointer :: pftarr(:) + real(r8), pointer :: colarr(:) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: fc,c,pi,p,l ! indices + integer , pointer :: npfts(:) + integer , pointer :: pfti(:) + integer , pointer :: pftf(:) + integer , pointer :: clandunit(:) + integer , pointer :: ltype(:) + real(r8), pointer :: wtcol(:) + real(r8), pointer :: wtgcell(:) +!----------------------------------------------------------------------- + + npfts => col%npfts + pfti => col%pfti + pftf => col%pftf + clandunit => col%landunit + ltype => lun%itype + wtcol => pft%wtcol + wtgcell => pft%wtgcell + + do fc = 1,numfc + c = filterc(fc) + l = clandunit(c) + colarr(c) = 0._r8 + do p = pfti(c), pftf(c) + ! Note: some glacier_mec pfts may have zero weight + if (wtgcell(p) > 0._r8 .or. ltype(l)==istice_mec) colarr(c) = colarr(c) + pftarr(p) * wtcol(p) + end do + end do + + end subroutine p2c_1d_filter + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2c_2d_filter +! +! !INTERFACE: + subroutine p2c_2d_filter (lev, numfc, filterc, pftarr, colarr) +! +! !DESCRIPTION: +! perform pft to column averaging for multi level pft arrays +! +! !USES: + use clm_varpar, only : max_pft_per_col + +! !ARGUMENTS: + implicit none + integer , intent(in) :: lev + integer , intent(in) :: numfc + integer , intent(in) :: filterc(numfc) + real(r8), pointer :: pftarr(:,:) + real(r8), pointer :: colarr(:,:) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: fc,c,pi,p,j ! indices + integer , pointer :: npfts(:) + integer , pointer :: pfti(:) + integer , pointer :: pftf(:) + real(r8), pointer :: wtcol(:) +!----------------------------------------------------------------------- + + npfts => col%npfts + pfti => col%pfti + pftf => col%pftf + wtcol => pft%wtcol + + do j = 1,lev + do fc = 1,numfc + c = filterc(fc) + colarr(c,j) = 0._r8 + do p = pfti(c), pftf(c) + colarr(c,j) = colarr(c,j) + pftarr(p,j) * wtcol(p) + end do + end do + end do + + end subroutine p2c_2d_filter + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2l_1d +! +! !INTERFACE: + subroutine p2l_1d (lbp, ubp, lbc, ubc, lbl, ubl, parr, larr, & + p2c_scale_type, c2l_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from pfts to landunits +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_lu +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft indices + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + real(r8), intent(in) :: parr(lbp:ubp) ! input column array + real(r8), intent(out) :: larr(lbl:ubl) ! output landunit array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pi,p,c,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: sumwt(lbl:ubl) ! sum of weights + real(r8) :: scale_p2c(lbc:ubc) ! scale factor for pft->column mapping + real(r8) :: scale_c2l(lbc:ubc) ! scale factor for column->landunit mapping + real(r8), pointer :: wtlunit(:) ! weight of pft relative to landunit + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: plandunit(:) ! landunit of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in landunit + integer , pointer :: pfti(:) ! initial pft index in landunit + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + canyon_hwr => lun%canyon_hwr + ltype => lun%itype + ctype => col%itype + clandunit => col%landunit + wtlunit => pft%wtlunit + pcolumn => pft%column + plandunit => pft%landunit + npfts => lun%npfts + pfti => lun%pfti + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2l_1d error: scale type ',p2c_scale_type,' not supported' + call endrun() + end if + + larr(:) = spval + sumwt(:) = 0._r8 + do p = lbp,ubp + if (wtlunit(p) /= 0._r8) then + c = pcolumn(p) + if (parr(p) /= spval .and. scale_c2l(c) /= spval) then + l = plandunit(p) + if (sumwt(l) == 0._r8) larr(l) = 0._r8 + larr(l) = larr(l) + parr(p) * scale_p2c(p) * scale_c2l(c) * wtlunit(p) + sumwt(l) = sumwt(l) + wtlunit(p) + end if + end if + end do + found = .false. + do l = lbl,ubl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l) = larr(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'p2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun() + end if + + end subroutine p2l_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2l_2d +! +! !INTERFACE: + subroutine p2l_2d(lbp, ubp, lbc, ubc, lbl, ubl, num2d, parr, larr, & + p2c_scale_type, c2l_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from pfts to landunits +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_lu +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft indices + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr(lbp:ubp,num2d) ! input pft array + real(r8), intent(out) :: larr(lbl:ubl,num2d) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,pi,p,c,l,index ! indices + logical :: found ! temporary for error check + real(r8) :: sumwt(lbl:ubl) ! sum of weights + real(r8) :: scale_p2c(lbc:ubc) ! scale factor for pft->column mapping + real(r8) :: scale_c2l(lbc:ubc) ! scale factor for column->landunit mapping + real(r8), pointer :: wtlunit(:) ! weight of pft relative to landunit + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: plandunit(:) ! landunit of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in landunit + integer , pointer :: pfti(:) ! initial pft index in landunit + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + canyon_hwr => lun%canyon_hwr + ltype => lun%itype + clandunit => col%landunit + ctype => col%itype + wtlunit => pft%wtlunit + pcolumn => pft%column + plandunit => pft%landunit + npfts => lun%npfts + pfti => lun%pfti + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2l_2d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2l_2d error: scale type ',p2c_scale_type,' not supported' + call endrun() + end if + + larr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do p = lbp,ubp + if (wtlunit(p) /= 0._r8) then + c = pcolumn(p) + if (parr(p,j) /= spval .and. scale_c2l(c) /= spval) then + l = plandunit(p) + if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 + larr(l,j) = larr(l,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * wtlunit(p) + sumwt(l) = sumwt(l) + wtlunit(p) + end if + end if + end do + found = .false. + do l = lbl,ubl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l,j) = larr(l,j)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'p2l_2d error: sumwt is greater than 1.0 at l= ',index,' j= ',j + call endrun() + end if + end do + + end subroutine p2l_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2g_1d +! +! !INTERFACE: + subroutine p2g_1d(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg, parr, garr, & + p2c_scale_type, c2l_scale_type, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from pfts to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_gcell +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft indices + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: lbg, ubg ! beginning and ending gridcell indices + real(r8), intent(in) :: parr(lbp:ubp) ! input pft array + real(r8), intent(out) :: garr(lbg:ubg) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! !LOCAL VARIABLES: +!EOP + integer :: pi,p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(lbp:ubp) ! scale factor + real(r8) :: scale_c2l(lbc:ubc) ! scale factor + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of pfts relative to gridcells + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: plandunit(:) ! landunit of corresponding pft + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in gridcell + integer , pointer :: pfti(:) ! initial pft index in gridcell + integer , pointer :: ctype(:) ! column type + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + canyon_hwr => lun%canyon_hwr + ltype => lun%itype + clandunit => col%landunit + ctype => col%itype + wtgcell => pft%wtgcell + pcolumn => pft%column + pgridcell => pft%gridcell + plandunit => pft%landunit + npfts => grc%npfts + pfti => grc%pfti + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_1d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + garr(:) = spval + sumwt(:) = 0._r8 + do p = lbp,ubp + if (wtgcell(p) /= 0._r8) then + c = pcolumn(p) + l = plandunit(p) + if (parr(p) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = pgridcell(p) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + parr(p) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p) + sumwt(g) = sumwt(g) + wtgcell(p) + end if + end if + end do + found = .false. + do g = lbg, ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun() + end if + + end subroutine p2g_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: p2g_2d +! +! !INTERFACE: + subroutine p2g_2d(lbp, ubp, lbc, ubc, lbl, ubl, lbg, ubg, num2d, & + parr, garr, p2c_scale_type, c2l_scale_type, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from pfts to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !USES: + use clm_varpar, only : max_pft_per_gcell +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbp, ubp ! beginning and ending pft indices + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: lbg, ubg ! beginning and ending gridcell indices + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: parr(lbp:ubp,num2d) ! input pft array + real(r8), intent(out) :: garr(lbg:ubg,num2d) ! output gridcell array + character(len=*), intent(in) :: p2c_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,pi,p,c,l,g,index ! indices + logical :: found ! temporary for error check + real(r8) :: scale_p2c(lbp:ubp) ! scale factor + real(r8) :: scale_c2l(lbc:ubc) ! scale factor + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of pfts relative to gridcells + integer , pointer :: pcolumn(:) ! column of corresponding pft + integer , pointer :: plandunit(:) ! landunit of corresponding pft + integer , pointer :: pgridcell(:) ! gridcell of corresponding pft + integer , pointer :: npfts(:) ! number of pfts in gridcell + integer , pointer :: pfti(:) ! initial pft index in gridcell + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + canyon_hwr => lun%canyon_hwr + ltype => lun%itype + clandunit => col%landunit + ctype => col%itype + wtgcell => pft%wtgcell + pcolumn => pft%column + pgridcell => pft%gridcell + plandunit => pft%landunit + npfts => grc%npfts + pfti => grc%pfti + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + if (p2c_scale_type == 'unity') then + do p = lbp,ubp + scale_p2c(p) = 1.0_r8 + end do + else + write(iulog,*)'p2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + garr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do p = lbp,ubp + if (wtgcell(p) /= 0._r8) then + c = pcolumn(p) + l = plandunit(p) + if (parr(p,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = pgridcell(p) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + parr(p,j) * scale_p2c(p) * scale_c2l(c) * scale_l2g(l) * wtgcell(p) + sumwt(g) = sumwt(g) + wtgcell(p) + end if + end if + end do + found = .false. + do g = lbg, ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'p2g_2d error: sumwt gt 1.0 at g/sumwt = ',index,sumwt(index) + call endrun() + end if + end do + + end subroutine p2g_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: c2l_1d +! +! !INTERFACE: + subroutine c2l_1d (lbc, ubc, lbl, ubl, carr, larr, c2l_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from columns to landunits +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + real(r8), intent(in) :: carr(lbc:ubc) ! input column array + real(r8), intent(out) :: larr(lbl:ubl) ! output landunit array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ci,c,l,index ! indices + integer :: max_col_per_lu ! max columns per landunit; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_c2l(lbc:ubc) ! scale factor for column->landunit mapping + real(r8) :: sumwt(lbl:ubl) ! sum of weights + real(r8), pointer :: wtlunit(:) ! weight of landunits relative to gridcells + integer , pointer :: clandunit(:) ! gridcell of corresponding column + integer , pointer :: ncolumns(:) ! number of columns in landunit + integer , pointer :: coli(:) ! initial column index in landunit + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + ctype => col%itype + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + wtlunit => col%wtlunit + clandunit => col%landunit + ncolumns => lun%ncolumns + coli => lun%coli + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + larr(:) = spval + sumwt(:) = 0._r8 + do c = lbc,ubc + if (wtlunit(c) /= 0._r8) then + if (carr(c) /= spval .and. scale_c2l(c) /= spval) then + l = clandunit(c) + if (sumwt(l) == 0._r8) larr(l) = 0._r8 + larr(l) = larr(l) + carr(c) * scale_c2l(c) * wtlunit(c) + sumwt(l) = sumwt(l) + wtlunit(c) + end if + end if + end do + found = .false. + do l = lbl,ubl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l) = larr(l)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'c2l_1d error: sumwt is greater than 1.0 at l= ',index + call endrun() + end if + + end subroutine c2l_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: c2l_2d +! +! !INTERFACE: + subroutine c2l_2d (lbc, ubc, lbl, ubl, num2d, carr, larr, c2l_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from columns to landunits +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: carr(lbc:ubc,num2d) ! input column array + real(r8), intent(out) :: larr(lbl:ubl,num2d) ! output landunit array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,l,ci,c,index ! indices + integer :: max_col_per_lu ! max columns per landunit; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_c2l(lbc:ubc) ! scale factor for column->landunit mapping + real(r8) :: sumwt(lbl:ubl) ! sum of weights + real(r8), pointer :: wtlunit(:) ! weight of column relative to landunit + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: ncolumns(:) ! number of columns in landunit + integer , pointer :: coli(:) ! initial column index in landunit + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + ctype => col%itype + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + wtlunit => col%wtlunit + clandunit => col%landunit + ncolumns => lun%ncolumns + coli => lun%coli + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_2d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + larr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do c = lbc,ubc + if (wtlunit(c) /= 0._r8) then + if (carr(c,j) /= spval .and. scale_c2l(c) /= spval) then + l = clandunit(c) + if (sumwt(l) == 0._r8) larr(l,j) = 0._r8 + larr(l,j) = larr(l,j) + carr(c,j) * scale_c2l(c) * wtlunit(c) + sumwt(l) = sumwt(l) + wtlunit(c) + end if + end if + end do + found = .false. + do l = lbl,ubl + if (sumwt(l) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = l + else if (sumwt(l) /= 0._r8) then + larr(l,j) = larr(l,j)/sumwt(l) + end if + end do + if (found) then + write(iulog,*)'c2l_2d error: sumwt is greater than 1.0 at l= ',index,' lev= ',j + call endrun() + end if + end do + + end subroutine c2l_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: c2g_1d +! +! !INTERFACE: + subroutine c2g_1d(lbc, ubc, lbl, ubl, lbg, ubg, carr, garr, & + c2l_scale_type, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from columns to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: lbg, ubg ! beginning and ending landunit indices + real(r8), intent(in) :: carr(lbc:ubc) ! input column array + real(r8), intent(out) :: garr(lbg:ubg) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ci,c,l,g,index ! indices + integer :: max_col_per_gcell ! max columns per gridcell; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_c2l(lbc:ubc) ! scale factor + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of columns relative to gridcells + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: cgridcell(:) ! gridcell of corresponding column + integer , pointer :: ncolumns(:) ! number of columns in gridcell + integer , pointer :: coli(:) ! initial column index in gridcell + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + ctype => col%itype + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + wtgcell => col%wtgcell + clandunit => col%landunit + cgridcell => col%gridcell + ncolumns => grc%ncolumns + coli => grc%coli + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2l_1d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + garr(:) = spval + sumwt(:) = 0._r8 + do c = lbc,ubc + if ( wtgcell(c) /= 0._r8) then + l = clandunit(c) + if (carr(c) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = cgridcell(c) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + carr(c) * scale_c2l(c) * scale_l2g(l) * wtgcell(c) + sumwt(g) = sumwt(g) + wtgcell(c) + end if + end if + end do + found = .false. + do g = lbg, ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun() + end if + + end subroutine c2g_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: c2g_2d +! +! !INTERFACE: + subroutine c2g_2d(lbc, ubc, lbl, ubl, lbg, ubg, num2d, carr, garr, & + c2l_scale_type, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from columns to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! beginning and ending column indices + integer , intent(in) :: lbl, ubl ! beginning and ending landunit indices + integer , intent(in) :: lbg, ubg ! beginning and ending gridcell indices + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: carr(lbc:ubc,num2d) ! input column array + real(r8), intent(out) :: garr(lbg:ubg,num2d) ! output gridcell array + character(len=*), intent(in) :: c2l_scale_type ! scale factor type for averaging + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,ci,c,g,l,index ! indices + integer :: max_col_per_gcell ! max columns per gridcell; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_c2l(lbc:ubc) ! scale factor + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of columns relative to gridcells + integer , pointer :: clandunit(:) ! landunit of corresponding column + integer , pointer :: cgridcell(:) ! gridcell of corresponding column + integer , pointer :: ncolumns(:) ! number of columns in gridcell + integer , pointer :: coli(:) ! initial column index in gridcell + integer , pointer :: ctype(:) ! column type + integer , pointer :: ltype(:) ! landunit type + real(r8), pointer :: canyon_hwr(:) ! urban canyon height to width ratio +!------------------------------------------------------------------------ + + ctype => col%itype + ltype => lun%itype + canyon_hwr => lun%canyon_hwr + wtgcell => col%wtgcell + clandunit => col%landunit + cgridcell => col%gridcell + ncolumns => grc%ncolumns + coli => grc%coli + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + if (c2l_scale_type == 'unity') then + do c = lbc,ubc + scale_c2l(c) = 1.0_r8 + end do + else if (c2l_scale_type == 'urbanf') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = 3.0 * canyon_hwr(l) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0_r8 + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else if (c2l_scale_type == 'urbans') then + do c = lbc,ubc + l = clandunit(c) + if (ltype(l) == isturb) then + if (ctype(c) == icol_sunwall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_shadewall) then + scale_c2l(c) = (3.0 * canyon_hwr(l)) / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_road_perv .or. ctype(c) == icol_road_imperv) then + scale_c2l(c) = 3.0 / (2.*canyon_hwr(l) + 1.) + else if (ctype(c) == icol_roof) then + scale_c2l(c) = 1.0_r8 + end if + else + scale_c2l(c) = 1.0_r8 + end if + end do + else + write(iulog,*)'c2g_2d error: scale type ',c2l_scale_type,' not supported' + call endrun() + end if + + garr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do c = lbc,ubc + if (wtgcell(c) /= 0._r8) then + l = clandunit(c) + if (carr(c,j) /= spval .and. scale_c2l(c) /= spval .and. scale_l2g(l) /= spval) then + g = cgridcell(c) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + carr(c,j) * scale_c2l(c) * scale_l2g(l) * wtgcell(c) + sumwt(g) = sumwt(g) + wtgcell(c) + end if + end if + end do + found = .false. + do g = lbg, ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'c2g_2d error: sumwt is greater than 1.0 at g= ',index + call endrun() + end if + end do + + end subroutine c2g_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: l2g_1d +! +! !INTERFACE: + subroutine l2g_1d(lbl, ubl, lbg, ubg, larr, garr, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from landunits to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbl, ubl ! beginning and ending sub landunit indices + integer , intent(in) :: lbg, ubg ! beginning and ending gridcell indices + real(r8), intent(in) :: larr(lbl:ubl) ! input landunit array + real(r8), intent(out) :: garr(lbg:ubg) ! output gridcell array + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: li,l,g,index ! indices + integer :: max_lu_per_gcell ! max landunits per gridcell; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of landunits relative to gridcells + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: nlandunits(:) ! number of landunits in gridcell + integer , pointer :: luni(:) ! initial landunit index in gridcell +!------------------------------------------------------------------------ + + wtgcell => lun%wtgcell + lgridcell => lun%gridcell + nlandunits => grc%nlandunits + luni => grc%luni + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + garr(:) = spval + sumwt(:) = 0._r8 + do l = lbl,ubl + if (wtgcell(l) /= 0._r8) then + if (larr(l) /= spval .and. scale_l2g(l) /= spval) then + g = lgridcell(l) + if (sumwt(g) == 0._r8) garr(g) = 0._r8 + garr(g) = garr(g) + larr(l) * scale_l2g(l) * wtgcell(l) + sumwt(g) = sumwt(g) + wtgcell(l) + end if + end if + end do + found = .false. + do g = lbg, ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index = g + else if (sumwt(g) /= 0._r8) then + garr(g) = garr(g)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'l2g_1d error: sumwt is greater than 1.0 at g= ',index + call endrun() + end if + + end subroutine l2g_1d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: l2g_2d +! +! !INTERFACE: + subroutine l2g_2d(lbl, ubl, lbg, ubg, num2d, larr, garr, l2g_scale_type) +! +! !DESCRIPTION: +! Perfrom subgrid-average from landunits to gridcells. +! Averaging is only done for points that are not equal to "spval". +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: lbl, ubl ! beginning and ending column indices + integer , intent(in) :: lbg, ubg ! beginning and ending gridcell indices + integer , intent(in) :: num2d ! size of second dimension + real(r8), intent(in) :: larr(lbl:ubl,num2d) ! input landunit array + real(r8), intent(out) :: garr(lbg:ubg,num2d) ! output gridcell array + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/03 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: j,g,li,l,index ! indices + integer :: max_lu_per_gcell ! max landunits per gridcell; on the fly + logical :: found ! temporary for error check + real(r8) :: scale_l2g(lbl:ubl) ! scale factor + real(r8) :: sumwt(lbg:ubg) ! sum of weights + real(r8), pointer :: wtgcell(:) ! weight of landunits relative to gridcells + integer , pointer :: lgridcell(:) ! gridcell of corresponding landunit + integer , pointer :: nlandunits(:) ! number of landunits in gridcell + integer , pointer :: luni(:) ! initial landunit index in gridcell +!------------------------------------------------------------------------ + + wtgcell => lun%wtgcell + lgridcell => lun%gridcell + nlandunits => grc%nlandunits + luni => grc%luni + + call build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) + + garr(:,:) = spval + do j = 1,num2d + sumwt(:) = 0._r8 + do l = lbl,ubl + if (wtgcell(l) /= 0._r8) then + if (larr(l,j) /= spval .and. scale_l2g(l) /= spval) then + g = lgridcell(l) + if (sumwt(g) == 0._r8) garr(g,j) = 0._r8 + garr(g,j) = garr(g,j) + larr(l,j) * scale_l2g(l) * wtgcell(l) + sumwt(g) = sumwt(g) + wtgcell(l) + end if + end if + end do + found = .false. + do g = lbg,ubg + if (sumwt(g) > 1.0_r8 + 1.e-6_r8) then + found = .true. + index= g + else if (sumwt(g) /= 0._r8) then + garr(g,j) = garr(g,j)/sumwt(g) + end if + end do + if (found) then + write(iulog,*)'l2g_2d error: sumwt is greater than 1.0 at g= ',index,' lev= ',j + call endrun() + end if + end do + + end subroutine l2g_2d + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: build_scale_l2g +! +! !INTERFACE: + subroutine build_scale_l2g(l2g_scale_type, lbl, ubl, scale_l2g) +! +! !DESCRIPTION: +! Fill the scale_l2g(lbl:ubl) array with appropriate values for the given l2g_scale_type. +! This array can later be used to scale each landunit in forming grid cell averages. +! +! !USES: + use clm_varcon, only : max_lunit +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + integer , intent(in) :: lbl, ubl ! beginning and ending column indices + real(r8) , intent(out) :: scale_l2g(lbl:ubl) ! scale factor +! +! !REVISION HISTORY: +! Created by Bill Sacks 10/11 +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: scale_lookup(max_lunit) ! scale factor for each landunit type + integer :: l ! index + integer , pointer :: ltype(:) ! landunit type +!----------------------------------------------------------------------- + + ltype => lun%itype + + call create_scale_l2g_lookup(l2g_scale_type, scale_lookup) + + do l = lbl,ubl + scale_l2g(l) = scale_lookup(ltype(l)) + end do + + end subroutine build_scale_l2g + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: create_scale_l2g_lookup +! +! !INTERFACE: + subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) +! +! DESCRIPTION: +! Create a lookup array, scale_lookup(1..max_lunit), which gives the scale factor for +! each landunit type depending on l2g_scale_type +! +! !USES: + use clm_varcon, only : istsoil, istice, istdlak, istslak, istwet, isturb, istice_mec,& + istcrop, max_lunit, spval +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: l2g_scale_type ! scale factor type for averaging + real(r8) , intent(out) :: scale_lookup(max_lunit) ! scale factor for each landunit type +! +! !REVISION HISTORY: +! Created by Bill Sacks 10/11 +! +!EOP +!----------------------------------------------------------------------- + + ! ------------ WJS (10-14-11): IMPORTANT GENERAL NOTES ------------ + ! + ! Since scale_l2g is not currently included in the sumwt accumulations, you need to + ! be careful about the scale values you use. Values of 1 and spval are safe + ! (including having multiple landunits with value 1), but only use other values if + ! you know what you are doing! For example, using a value of 0 is NOT the correct way + ! to exclude a landunit from the average, because the normalization will be done + ! incorrectly in this case: instead, use spval to exclude a landunit from the + ! average. Similarly, using a value of 2 is NOT the correct way to give a landunit + ! double relative weight in general, because the normalization won't be done + ! correctly in this case, either. + ! + ! In the longer-term, I believe that the correct solution to this problem is to + ! include scale_l2g (and the other scale factors) in the sumwt accumulations + ! (e.g., sumwt = sumwt + wtgcell * scale_p2c * scale_c2l * scale_l2g), but that + ! requires some more thought to (1) make sure that is correct, and (2) make sure it + ! doesn't break the urban scaling. + ! + ! ----------------------------------------------------------------- + + + ! Initialize scale_lookup to spval for all landunits. Thus, any landunit that keeps + ! the default value will be excluded from grid cell averages. + scale_lookup(:) = spval + + if (l2g_scale_type == 'unity') then + scale_lookup(:) = 1.0_r8 + else if (l2g_scale_type == 'veg') then + scale_lookup(istsoil) = 1.0_r8 + scale_lookup(istcrop) = 1.0_r8 + else if (l2g_scale_type == 'ice') then + scale_lookup(istice) = 1.0_r8 + scale_lookup(istice_mec) = 1.0_r8 + else if (l2g_scale_type == 'nonurb') then + scale_lookup(:) = 1.0_r8 + scale_lookup(isturb) = spval + else + write(iulog,*)'scale_l2g_lookup_array error: scale type ',l2g_scale_type,' not supported' + call endrun() + end if + + end subroutine create_scale_l2g_lookup + +end module subgridAveMod diff --git a/components/clm/src_clm40/main/subgridMod.F90 b/components/clm/src_clm40/main/subgridMod.F90 new file mode 100644 index 0000000000..8fdb19a1ea --- /dev/null +++ b/components/clm/src_clm40/main/subgridMod.F90 @@ -0,0 +1,282 @@ +module subgridMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: subgridMod +! +! !DESCRIPTION: +! sub-grid data and mapping types and modules +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use spmdMod , only : masterproc + use abortutils , only : endrun + + implicit none + private + save + +! !PUBLIC MEMBER FUNCTIONS: + public subgrid_get_gcellinfo ! Returns g,l,c,p properties from wtxy + + +! !REVISION HISTORY: +! 2006.07.04 T Craig, rename initSubgridMod +! +! +! !PRIVATE MEMBER FUNCTIONS: None +! +! !PRIVATE DATA MEMBERS: None +!EOP +!----------------------------------------------------------------------- + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subgrid_get_gcellinfo +! +! !INTERFACE: + subroutine subgrid_get_gcellinfo (nw, & + nlunits, ncols, npfts, & + nveg, wtveg, & + ncrop, wtcrop, & + nurban, wturban, & + nlake, wtlake, & + nwetland, wtwetland, & + nglacier, wtglacier, & + nglacier_mec, wtglacier_mec, & + glcmask) +! +! !DESCRIPTION: +! Obtain gridcell properties +! +! !USES + use clm_varpar , only : numpft, maxpatch_pft, numcft, & + npatch_lake, npatch_glacier, npatch_wet, npatch_urban + use clm_varpar , only : npatch_glacier_mec + use clm_varctl , only : allocate_all_vegpfts, create_crop_landunit + use clm_varctl , only : create_glacier_mec_landunit, glc_topomax + use clm_varsur , only : wtxy + use clm_varsur , only : topoxy + +! !ARGUMENTS + implicit none + integer , intent(in) :: nw ! wtxy cell index + integer , optional, intent(out) :: nlunits ! number of landunits + integer , optional, intent(out) :: ncols ! number of columns + integer , optional, intent(out) :: npfts ! number of pfts + integer , optional, intent(out) :: nveg ! number of vegetated pfts in naturally vegetated landunit + real(r8), optional, intent(out) :: wtveg ! weight (relative to gridcell) of naturally vegetated landunit + integer , optional, intent(out) :: ncrop ! number of crop pfts in crop landunit + real(r8), optional, intent(out) :: wtcrop ! weight (relative to gridcell) of crop landunit + integer , optional, intent(out) :: nurban ! number of urban pfts (columns) in urban landunit + real(r8), optional, intent(out) :: wturban ! weight (relative to gridcell) of urban pfts (columns) in urban la + integer , optional, intent(out) :: nlake ! number of lake pfts (columns) in lake landunit + real(r8), optional, intent(out) :: wtlake ! weight (relative to gridcell) of lake landunitof lake pfts (columns) in lake landunit + integer , optional, intent(out) :: nwetland ! number of wetland pfts (columns) in wetland landunit + real(r8), optional, intent(out) :: wtwetland ! weight (relative to gridcell) of wetland landunitof wetland pfts (columns) in wetland landunit + integer , optional, intent(out) :: nglacier ! number of glacier pfts (columns) in glacier landunit + real(r8), optional, intent(out) :: wtglacier ! weight (relative to gridcell) of glacier landunitof glacier pfts (columns) in glacier landunit + integer , optional, intent(out) :: nglacier_mec ! number of glacier_mec pfts (columns) in glacier_mec landunit + real(r8), optional, intent(out) :: wtglacier_mec ! weight (relative to gridcell) of glacier_mec landunitof glacier pfts (columns) in glacier_mec landunit + integer , optional, intent(in) :: glcmask ! = 1 if glc requires surface mass balance in this gridcell +! +! !CALLED FROM: +! subroutines decomp_init, initGridCells +! +! !REVISION HISTORY: +! 2002.09.11 Mariana Vertenstein Creation. +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m ! loop index + integer :: n ! elevation class index + integer :: ipfts ! number of pfts in gridcell + integer :: icols ! number of columns in gridcell + integer :: ilunits ! number of landunits in gridcell + integer :: npfts_per_lunit ! number of pfts in landunit + real(r8) :: wtlunit ! weight (relative to gridcell) of landunit +!------------------------------------------------------------------------------ + + ! Initialize pfts, columns and landunits counters for gridcell + + ipfts = 0 + icols = 0 + ilunits = 0 + + ! Set naturally vegetated landunit + + npfts_per_lunit = 0 + wtlunit = 0._r8 + ! If crop should be on separate land units + if (allocate_all_vegpfts .and. create_crop_landunit) then + do m = 1, maxpatch_pft-numcft + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 ! sum natural pfts + wtlunit = wtlunit + wtxy(nw,m) ! and their wts + end if + end do + do m = maxpatch_pft-numcft+1, maxpatch_pft + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 ! sum crops, too, but not + end if ! their wts for now + end do + ! Assume that the vegetated landunit has one column + else + do m = 1, maxpatch_pft + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,m) + end if + end do + end if + if (npfts_per_lunit > 0) then ! true even when only crops are present + if (allocate_all_vegpfts) npfts_per_lunit = numpft+1 + if (allocate_all_vegpfts .and. create_crop_landunit) npfts_per_lunit = numpft+1-numcft + ilunits = ilunits + 1 + icols = icols + 1 + end if + ipfts = ipfts + npfts_per_lunit + if (present(nveg )) nveg = npfts_per_lunit + if (present(wtveg)) wtveg = wtlunit + + ! Set urban landunit + + npfts_per_lunit = 0 + wtlunit = 0._r8 + do m = npatch_urban, npatch_lake-1 + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,m) + end if + end do + if (npfts_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(nurban )) nurban = npfts_per_lunit + if (present(wturban)) wturban = wtlunit + + ! Set lake landunit + + npfts_per_lunit = 0 + wtlunit = 0._r8 + if (wtxy(nw,npatch_lake) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,npatch_lake) + end if + if (npfts_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(nlake )) nlake = npfts_per_lunit + if (present(wtlake)) wtlake = wtlunit + + ! Set wetland landunit + + npfts_per_lunit = 0 + wtlunit = 0._r8 + if (wtxy(nw,npatch_wet) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,npatch_wet) + end if + if (npfts_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(nwetland )) nwetland = npfts_per_lunit + if (present(wtwetland)) wtwetland = wtlunit + + ! Set glacier landunit + + npfts_per_lunit = 0 + wtlunit = 0._r8 + if (wtxy(nw,npatch_glacier) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,npatch_glacier) + end if + if (npfts_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(nglacier )) nglacier = npfts_per_lunit + if (present(wtglacier)) wtglacier = wtlunit + + ! Set glacier_mec landunit + ! If glcmask = 1, we create a column for each elevation class even if wtxy = 0. + + if (create_glacier_mec_landunit) then + npfts_per_lunit = 0 + wtlunit = 0._r8 + do m = npatch_glacier+1, npatch_glacier_mec + if (wtxy(nw,m) > 0._r8) then + npfts_per_lunit = npfts_per_lunit + 1 + wtlunit = wtlunit + wtxy(nw,m) + topoxy(nw,m) = max (topoxy(nw,m), 0._r8) + elseif (present(glcmask)) then + if (glcmask == 1) then ! create a virtual column + npfts_per_lunit = npfts_per_lunit + 1 + n = m - npatch_glacier ! elevation class index + if (m < npatch_glacier_mec) then ! classes 1 to maxpatch_glcmec-1 + topoxy(nw,m) = 0.5_r8 * (glc_topomax(n-1) + glc_topomax(n)) + else ! class maxpatch_glcmec + topoxy(nw,m) = 2.0_r8*glc_topomax(n-1) - glc_topomax(n-2) ! somewhat arbitrary + endif + endif ! glcmask = 1 + endif ! wtxy > 0 + enddo ! npatch_glacier_mec + if (npfts_per_lunit > 0) then + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(nglacier_mec )) nglacier_mec = npfts_per_lunit + if (present(wtglacier_mec)) wtglacier_mec = wtlunit + + endif ! create_glacier_mec_landunit + + ! Set crop landunit if appropriate + + npfts_per_lunit = 0 + wtlunit = 0._r8 + if (allocate_all_vegpfts .and. create_crop_landunit) then + do m = 1, maxpatch_pft-numcft + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 ! sum natural pfts again + end if ! not their wts this time + end do + do m = maxpatch_pft-numcft+1, maxpatch_pft + if (wtxy(nw,m) > 0.0_r8) then + npfts_per_lunit = npfts_per_lunit + 1 ! sum crops + wtlunit = wtlunit + wtxy(nw,m) ! and their wts + end if + end do + end if + if (npfts_per_lunit > 0) then ! true even if only natural veg is present + if (allocate_all_vegpfts .and. create_crop_landunit) npfts_per_lunit = numcft + ilunits = ilunits + 1 + icols = icols + npfts_per_lunit + end if + ipfts = ipfts + npfts_per_lunit + if (present(ncrop )) ncrop = npfts_per_lunit + if (present(wtcrop)) wtcrop = wtlunit + + ! Determine return arguments + + if (present(nlunits)) nlunits = ilunits + if (present(ncols)) ncols = icols + if (present(npfts)) npfts = ipfts + + end subroutine subgrid_get_gcellinfo + +!----------------------------------------------------------------------- + +end module subgridMod diff --git a/components/clm/src_clm40/main/subgridRestMod.F90 b/components/clm/src_clm40/main/subgridRestMod.F90 new file mode 100644 index 0000000000..e2072e886d --- /dev/null +++ b/components/clm/src_clm40/main/subgridRestMod.F90 @@ -0,0 +1,286 @@ +module subgridRestMod + +contains + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: subgridRest +! +! !INTERFACE: + subroutine subgridRest( ncid, flag ) + + use shr_kind_mod , only : r8 => shr_kind_r8 + use clmtype + use ncdio_pio , only : file_desc_t, ncd_io, ncd_defvar, ncd_int, ncd_double + use decompMod , only : get_proc_bounds, ldecomp + use domainMod , only : ldomain + use clm_time_manager , only : get_curr_date + use abortutils , only : endrun +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid ! netCDF dataset id + character(len=*) , intent(in) :: flag ! flag to determine if define, write or read data +! +! !REVISION HISTORY: +! +! +! !LOCAL VARIABLES: +!EOP + integer :: g,l,c,p,j,i ! indices + integer :: yr ! current year (0 -> ...) + integer :: mon ! current month (1 -> 12) + integer :: day ! current day (1 -> 31) + integer :: mcsec ! seconds of current date + integer :: mcdate ! current date + integer :: begp, endp ! per-proc beg/end pft indices + integer :: begc, endc ! per-proc beg/end column indices + integer :: begl, endl ! per-proc beg/end landunit indices + integer :: begg, endg ! per-proc beg/end gridcell indices + integer :: ier ! error status + real(r8),pointer :: rgarr(:) ! temporary + real(r8),pointer :: rlarr(:) ! temporary + real(r8),pointer :: rcarr(:) ! temporary + real(r8),pointer :: rparr(:) ! temporary + integer ,pointer :: igarr(:) ! temporary + integer ,pointer :: ilarr(:) ! temporary + integer ,pointer :: icarr(:) ! temporary + integer ,pointer :: iparr(:) ! temporary + type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype + type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype + type(column_type) , pointer :: cptr ! pointer to column derived subtype + type(pft_type) , pointer :: pptr ! pointer to pft derived subtype + character(len=32) :: subname='SubgridRest' ! subroutine name +!------------------------------------------------------------------------ + + ! Set pointers into derived type + + gptr => grc + lptr => lun + cptr => col + pptr => pft + + ! Get relevant sizes + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + + ! Allocate dynamic memory + + if (flag == 'write') then + allocate(rgarr(begg:endg),rlarr(begl:endl),rcarr(begc:endc),rparr(begp:endp),stat=ier) + if (ier /= 0) call endrun('allocation error from inicfile_fields rarrs') + allocate(igarr(begg:endg),ilarr(begl:endl),icarr(begc:endc),iparr(begp:endp),stat=ier) + if (ier /= 0) call endrun('allocation error from inicfile_fields iarrs') + end if + + ! Write output data (first write current date and seconds of current date) + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='mcdate', xtype=ncd_int, & + long_name='current date as 8 digit integer (YYYYMMDD)') + call ncd_defvar(ncid=ncid, varname='mcsec', xtype=ncd_int, & + long_name='current seconds of current date', units='s') + else if (flag == 'write') then + call get_curr_date (yr, mon, day, mcsec) + mcdate = yr*10000 + mon*100 + day + !TODO - add this to the file - get this to work +!DEBUG call ncd_io(varname='mcdate', data=mcdate, ncid=ncid, flag=flag) +!DEBUG call ncd_io(varname='mcsec' , data=mcsec , ncid=ncid, flag=flag) + end if + + ! Write gridcell info + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='grid1d_lon', xtype=ncd_double, & + dim1name='gridcell', long_name='gridcell longitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='grid1d_lat', xtype=ncd_double, & + dim1name='gridcell', long_name='gridcell latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='grid1d_ixy', xtype=ncd_int, & + dim1name='gridcell', long_name='2d longitude index of corresponding gridcell') + call ncd_defvar(ncid=ncid, varname='grid1d_jxy', xtype=ncd_int, & + dim1name='gridcell', long_name='2d latitude index of corresponding gridcell') + else if (flag == 'write') then + do g=begg,endg + igarr(g)= mod(ldecomp%gdc2glo(g)-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='grid1d_ixy', data=igarr , dim1name=nameg, ncid=ncid, flag=flag) + do g=begg,endg + igarr(g)= (ldecomp%gdc2glo(g) - 1)/ldomain%ni + 1 + enddo + call ncd_io(varname='grid1d_jxy', data=igarr , dim1name=nameg, ncid=ncid, flag=flag) + call ncd_io(varname='grid1d_lon', data=gptr%londeg, dim1name=nameg, ncid=ncid, flag=flag) + call ncd_io(varname='grid1d_lat', data=gptr%latdeg, dim1name=nameg, ncid=ncid, flag=flag) + end if + + ! Write landunit info + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='land1d_lon', xtype=ncd_double, & + dim1name='landunit', long_name='landunit longitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='land1d_lat', xtype=ncd_double, & + dim1name='landunit', long_name='landunit latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='land1d_ixy', xtype=ncd_int, & + dim1name='landunit', long_name='2d longitude index of corresponding landunit') + call ncd_defvar(ncid=ncid, varname='land1d_jxy', xtype=ncd_int, & + dim1name='landunit', long_name='2d latitude index of corresponding landunit') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(ncid=ncid, varname='land1d_gi', xtype=ncd_int, & + ! dim1name='landunit', long_name='1d grid index of corresponding landunit') + ! ---------------------------------------------------------------- + call ncd_defvar(ncid=ncid, varname='land1d_wtxy', xtype=ncd_double, & + dim1name='landunit', long_name='landunit weight relative to corresponding gridcell') + call ncd_defvar(ncid=ncid, varname='land1d_ityplun', xtype=ncd_int, & + dim1name='landunit', long_name='landunit type (vegetated,urban,lake,wetland or glacier)') + else if (flag == 'write') then + do l=begl,endl + rlarr(l) = gptr%londeg(lptr%gridcell(l)) + enddo + call ncd_io(varname='land1d_lon' , data=rlarr , dim1name=namel, ncid=ncid, flag=flag) + do l=begl,endl + rlarr(l) = gptr%latdeg(lptr%gridcell(l)) + enddo + call ncd_io(varname='land1d_lat' , data=rlarr , dim1name=namel, ncid=ncid, flag=flag) + do l=begl,endl + ilarr(l) = mod(ldecomp%gdc2glo(lptr%gridcell(l))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='land1d_ixy' , data=ilarr , dim1name=namel, ncid=ncid, flag=flag) + do l=begl,endl + ilarr(l) = (ldecomp%gdc2glo(lptr%gridcell(l))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='land1d_jxy' , data=ilarr , dim1name=namel, ncid=ncid, flag=flag) + call ncd_io(varname='land1d_wtxy' , data=lptr%wtgcell , dim1name=namel, ncid=ncid, flag=flag) + call ncd_io(varname='land1d_ityplun', data=lptr%itype , dim1name=namel, ncid=ncid, flag=flag) + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_io(varname='land1d_gi' , data=lptr%gridcell, dim1name=namel, ncid=ncid, flag=flag) + ! ---------------------------------------------------------------- + end if + + ! Write column info + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='cols1d_lon', xtype=ncd_double, & + dim1name='column', long_name='column longitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='cols1d_lat', xtype=ncd_double, & + dim1name='column', long_name='column latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='cols1d_ixy', xtype=ncd_int, & + dim1name='column', long_name='2d longitude index of corresponding column') + call ncd_defvar(ncid=ncid, varname='cols1d_jxy', xtype=ncd_int, & + dim1name='column', long_name='2d latitude index of corresponding column') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(ncid=ncid, varname='cols1d_gi', xtype=ncd_int, & + ! dim1name='column', long_name='1d grid index of corresponding column') + !call ncd_defvar(ncid=ncid, varname='cols1d_li', xtype=ncd_int, & + ! dim1name='column', long_name='1d landunit index of corresponding column') + ! ---------------------------------------------------------------- + call ncd_defvar(ncid=ncid, varname='cols1d_wtxy', xtype=ncd_double, & + dim1name='column', long_name='column weight relative to corresponding gridcell') + call ncd_defvar(ncid=ncid, varname='cols1d_wtlnd', xtype=ncd_double, & + dim1name='column', long_name='column weight relative to corresponding landunit') + call ncd_defvar(ncid=ncid, varname='cols1d_ityplun', xtype=ncd_int, & + dim1name='column', long_name='column landunit type (vegetated,urban,lake,wetland or glacier)') + call ncd_defvar(ncid=ncid, varname='cols1d_ityp', xtype=ncd_int, & + dim1name='column', long_name=& + 'column type (61-roof,62-sunwall,63-shadewall,64-impervious road,65-pervious road,1-all other columns)') + else if (flag == 'write') then + do c=begc,endc + rcarr(c) = gptr%londeg(cptr%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lon' , data=rcarr , dim1name=namec, ncid=ncid, flag=flag) + do c=begc,endc + rcarr(c) = gptr%latdeg(cptr%gridcell(c)) + enddo + call ncd_io(varname='cols1d_lat' , data=rcarr , dim1name=namec, ncid=ncid, flag=flag) + do c=begc,endc + icarr(c) = mod(ldecomp%gdc2glo(cptr%gridcell(c))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='cols1d_ixy' , data=icarr , dim1name=namec, ncid=ncid, flag=flag) + do c=begc,endc + icarr(c) = (ldecomp%gdc2glo(cptr%gridcell(c))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='cols1d_jxy' , data=icarr , dim1name=namec, ncid=ncid, flag=flag) + call ncd_io(varname='cols1d_wtxy' , data=cptr%wtgcell , dim1name=namec, ncid=ncid, flag=flag) + call ncd_io(varname='cols1d_wtlnd', data=cptr%wtlunit , dim1name=namec, ncid=ncid, flag=flag) + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_io(varname='cols1d_gi' , data=cptr%gridcell, dim1name=namec, ncid=ncid, flag=flag) + !call ncd_io(varname='cols1d_li' , data=cptr%landunit, dim1name=namec, ncid=ncid, flag=flag) + ! ---------------------------------------------------------------- + do c=begc,endc + icarr(c) = lptr%itype(cptr%landunit(c)) + enddo + call ncd_io(varname='cols1d_ityplun', data=icarr , dim1name=namec, ncid=ncid, flag=flag) + do c=begc,endc + icarr(c) = cptr%itype((c)) + enddo + call ncd_io(varname='cols1d_ityp', data=icarr , dim1name=namec, ncid=ncid, flag=flag) + end if + + ! Write pft info + + if (flag == 'define') then + call ncd_defvar(ncid=ncid, varname='pfts1d_lon', xtype=ncd_double, & + dim1name='pft', long_name='pft longitude', units='degrees_east') + call ncd_defvar(ncid=ncid, varname='pfts1d_lat', xtype=ncd_double, & + dim1name='pft', long_name='pft latitude', units='degrees_north') + call ncd_defvar(ncid=ncid, varname='pfts1d_ixy', xtype=ncd_int, & + dim1name='pft', long_name='2d longitude index of corresponding pft') + call ncd_defvar(ncid=ncid, varname='pfts1d_jxy', xtype=ncd_int, & + dim1name='pft', long_name='2d latitude index of corresponding pft') + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_defvar(ncid=ncid, varname='pfts1d_gi', xtype=ncd_int, & + ! dim1name='pft', long_name='1d grid index of corresponding pft') + !call ncd_defvar(ncid=ncid, varname='pfts1d_li', xtype=ncd_int, & + ! dim1name='pft', long_name='1d landunit index of corresponding pft') + ! ---------------------------------------------------------------- + call ncd_defvar(ncid=ncid, varname='pfts1d_ci', xtype=ncd_int, & + dim1name='pft', long_name='1d column index of corresponding pft') + call ncd_defvar(ncid=ncid, varname='pfts1d_wtxy', xtype=ncd_double, & + dim1name='pft', long_name='pft weight relative to corresponding gridcell') + call ncd_defvar(ncid=ncid, varname='pfts1d_wtlnd', xtype=ncd_double, & + dim1name='pft', long_name='pft weight relative to corresponding landunit') + call ncd_defvar(ncid=ncid, varname='pfts1d_wtcol', xtype=ncd_double, & + dim1name='pft', long_name='pft weight relative to corresponding column') + call ncd_defvar(ncid=ncid, varname='pfts1d_itypveg', xtype=ncd_int, & + dim1name='pft', long_name='pft vegetation type') + call ncd_defvar(ncid=ncid, varname='pfts1d_ityplun', xtype=ncd_int, & + dim1name='pft', long_name='pft landunit type (vegetated,urban,lake,wetland or glacier)') + else if (flag == 'write') then + do p=begp,endp + rparr(p) = gptr%londeg(pptr%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lon' , data=rparr , dim1name=namep, ncid=ncid, flag=flag) + do p=begp,endp + rparr(p) = gptr%latdeg(pptr%gridcell(p)) + enddo + call ncd_io(varname='pfts1d_lat' , data=rparr , dim1name=namep, ncid=ncid, flag=flag) + do p=begp,endp + iparr(p) = mod(ldecomp%gdc2glo(pptr%gridcell(p))-1,ldomain%ni) + 1 + enddo + call ncd_io(varname='pfts1d_ixy' , data=iparr , dim1name=namep, ncid=ncid, flag=flag) + do p=begp,endp + iparr(p) = (ldecomp%gdc2glo(pptr%gridcell(p))-1)/ldomain%ni + 1 + enddo + call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag=flag) + call ncd_io(varname='pfts1d_wtxy' , data=pptr%wtgcell , dim1name=namep, ncid=ncid, flag=flag) + call ncd_io(varname='pfts1d_wtlnd' , data=pptr%wtlunit , dim1name=namep, ncid=ncid, flag=flag) + call ncd_io(varname='pfts1d_wtcol' , data=pptr%wtcol , dim1name=namep, ncid=ncid, flag=flag) + call ncd_io(varname='pfts1d_itypveg', data=pptr%itype , dim1name=namep, ncid=ncid, flag=flag) + ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 + !call ncd_io(varname='pfts1d_gi' , data=pptr%gridcell, dim1name=namep, ncid=ncid, flag=flag) + !call ncd_io(varname='pfts1d_li' , data=pptr%landunit, dim1name=namep, ncid=ncid, flag=flag) + !call ncd_io(varname='pfts1d_ci' , data=pptr%column , dim1name=namep, ncid=ncid, flag=flag) + ! ---------------------------------------------------------------- + do p=begp,endp + iparr(p) = lptr%itype(pptr%landunit(p)) + enddo + call ncd_io(varname='pfts1d_ityplun', data=iparr , dim1name=namep, ncid=ncid, flag=flag) + end if + + if (flag == 'write') then + deallocate(rgarr,rlarr,rcarr,rparr) + deallocate(igarr,ilarr,icarr,iparr) + end if + + end subroutine subgridRest + +end module subgridRestMod diff --git a/components/clm/src_clm40/main/surfrdMod.F90 b/components/clm/src_clm40/main/surfrdMod.F90 new file mode 100644 index 0000000000..914b21484d --- /dev/null +++ b/components/clm/src_clm40/main/surfrdMod.F90 @@ -0,0 +1,1121 @@ +module surfrdMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: surfrdMod +! +! !DESCRIPTION: +! Contains methods for reading in surface data file and determining +! two-dimensional subgrid weights as well as writing out new surface +! dataset. When reading in the surface dataset, determines array +! which sets the PFT for each of the [maxpatch] patches and +! array which sets the relative abundance of the PFT. +! Also fills in the PFTs for vegetated portion of each grid cell. +! Fractional areas for these points pertain to "vegetated" +! area not to total grid area. Need to adjust them for fraction of grid +! that is vegetated. Also fills in urban, lake, wetland, and glacier patches. +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_varpar , only : nlevsoi, numpft, & + maxpatch_pft, numcft, maxpatch, & + npatch_urban, npatch_lake, npatch_wet, & + npatch_glacier,maxpatch_urb, npatch_glacier_mec, & + maxpatch_glcmec + use clm_varctl , only : glc_topomax, iulog, scmlat, scmlon, single_column, & + create_glacier_mec_landunit, use_cndv + use clm_varsur , only : wtxy, vegxy, topoxy, pctspec + use decompMod , only : get_proc_bounds + use clmtype + use spmdMod + use ncdio_pio , only : file_desc_t, var_desc_t, ncd_pio_openfile, ncd_pio_closefile, & + ncd_io, check_var, ncd_inqfdims, check_dim + use pio +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) + public :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) + public :: surfrd_get_topo ! Read grid topography into domain (after domain decomp) + public :: surfrd_get_data ! Read surface dataset and determine subgrid weights +! +! !PUBLIC DATA MEMBERS: + logical, public :: crop_prog = .false. ! If prognostic crops is turned on +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! Updated by T Craig +! Updated by Mariana Vertenstein Jan 2011 +! +! +! !PRIVATE MEMBER FUNCTIONS: + private :: surfrd_wtxy_special + private :: surfrd_wtxy_veg_all + private :: surfrd_wtxy_veg_dgvm +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_get_globmask +! +! !INTERFACE: + subroutine surfrd_get_globmask(filename, mask, ni, nj) +! +! !DESCRIPTION: +! Read the surface dataset grid related information: +! This is the first routine called by clm_initialize +! NO DOMAIN DECOMPOSITION HAS BEEN SET YET +! +! !USES: + use fileutils , only : getfil +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: filename ! grid filename + integer , pointer :: mask(:) ! grid mask + integer , intent(out) :: ni, nj ! global grid sizes +! +! !CALLED FROM: +! subroutine surfrd in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + logical :: isgrid2d + integer :: dimid,varid ! netCDF id's + integer :: ns ! size of grid on file + integer :: n,i,j ! index + integer :: ier ! error status + type(file_desc_t) :: ncid ! netcdf id + type(var_desc_t) :: vardesc ! variable descriptor + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + character(len=32) :: subname = 'surfrd_get_globmask' ! subroutine name +!----------------------------------------------------------------------- + + if (filename == ' ') then + mask(:) = 1 + RETURN + end if + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun() + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions and if grid file is 2d or 1d + + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + if (masterproc) then + write(iulog,*)'lat/lon grid flag (isgrid2d) is ',isgrid2d + end if + + allocate(mask(ns)) + mask(:) = 1 + + if (isgrid2d) then + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='LANDMASK', data=idata2d, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + end if + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + end if + deallocate(idata2d) + else + call ncd_io(ncid=ncid, varname='LANDMASK', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + end if + end if + if (.not. readvar) call endrun( trim(subname)//' ERROR: landmask not on fatmlndfrc file' ) + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_globmask + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_get_grid +! +! !INTERFACE: + subroutine surfrd_get_grid(ldomain, filename, glcfilename) +! +! !DESCRIPTION: +! THIS IS CALLED AFTER THE DOMAIN DECOMPOSITION HAS BEEN CREATED +! Read the surface dataset grid related information: +! o real latitude of grid cell (degrees) +! o real longitude of grid cell (degrees) +! +! !USES: + use clm_varcon, only : spval, re + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use decompMod , only : get_proc_bounds + use fileutils , only : getfil +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: ldomain ! domain to init + character(len=*) ,intent(in) :: filename ! grid filename + character(len=*) ,optional, intent(in) :: glcfilename ! glc mask filename +! +! !CALLED FROM: +! subroutine surfrd in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(file_desc_t) :: ncid ! netcdf id + type(file_desc_t) :: ncidg ! netCDF id for glcmask + type(var_desc_t) :: vardesc ! variable descriptor + integer :: beg ! local beg index + integer :: end ! local end index + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: start(1), count(1) ! 1d lat/lon array sections + integer :: ier,ret ! error status + logical :: readvar ! true => variable is on input file + logical :: isgrid2d ! true => file is 2d lat/lon + logical :: istype_domain ! true => input file is of type domain + real(r8), allocatable :: rdata2d(:,:) ! temporary + character(len=16) :: vname ! temporary + character(len=256):: locfn ! local file name + integer :: n ! indices + real(r8):: eps = 1.0e-12_r8 ! lat/lon error tolerance + character(len=32) :: subname = 'surfrd_get_grid' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun() + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Determine dimensions + + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + ! Determine isgrid2d flag for domain + + call get_proc_bounds(beg, end) + call domain_init(ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=beg, nend=end) + ! Determine type of file - old style grid file or new style domain file + + call check_var(ncid=ncid, varname='LONGXY', vardesc=vardesc, readvar=readvar) + if (readvar) istype_domain = .false. + + call check_var(ncid=ncid, varname='xc', vardesc=vardesc, readvar=readvar) + if (readvar) istype_domain = .true. + + ! Read in area, lon, lat + + if (istype_domain) then + call ncd_io(ncid=ncid, varname= 'area', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + ! convert from radians**2 to km**2 + ldomain%area = ldomain%area * (re**2) + if (.not. readvar) call endrun( trim(subname)//' ERROR: area NOT on file' ) + + call ncd_io(ncid=ncid, varname= 'xc', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: xc NOT on file' ) + + call ncd_io(ncid=ncid, varname= 'yc', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: yc NOT on file' ) + else + call ncd_io(ncid=ncid, varname= 'AREA', flag='read', data=ldomain%area, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: AREA NOT on file' ) + + call ncd_io(ncid=ncid, varname= 'LONGXY', flag='read', data=ldomain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: LONGXY NOT on file' ) + + call ncd_io(ncid=ncid, varname= 'LATIXY', flag='read', data=ldomain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: LATIXY NOT on file' ) + end if + + if (isgrid2d) then + allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) + if (istype_domain) then + vname = 'xc' + else + vname = 'LONGXY' + end if + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lon1d(:) = rdata2d(:,1) + if (istype_domain) then + vname = 'yc' + else + vname = 'LATIXY' + end if + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lat1d(:) = rdata2d(1,:) + deallocate(rdata2d) + end if + + ! Check lat limited to -90,90 + + if (minval(ldomain%latc) < -90.0_r8 .or. & + maxval(ldomain%latc) > 90.0_r8) then + write(iulog,*) trim(subname),' WARNING: lat/lon min/max is ', & + minval(ldomain%latc),maxval(ldomain%latc) + ! call endrun( trim(subname)//' ERROR: lat is outside [-90,90]' ) + ! write(iulog,*) trim(subname),' Limiting lat/lon to [-90/90] from ', & + ! minval(domain%latc),maxval(domain%latc) + ! where (ldomain%latc < -90.0_r8) ldomain%latc = -90.0_r8 + ! where (ldomain%latc > 90.0_r8) ldomain%latc = 90.0_r8 + endif + + call ncd_io(ncid=ncid, varname='LANDMASK', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='mask', flag='read', data=ldomain%mask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( trim(subname)//' ERROR: LANDMASK NOT on fracdata file' ) + end if + end if + + call ncd_io(ncid=ncid, varname='LANDFRAC', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call ncd_io(ncid=ncid, varname='frac', flag='read', data=ldomain%frac, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + call endrun( trim(subname)//' ERROR: LANDFRAC NOT on fracdata file' ) + end if + end if + + call ncd_pio_closefile(ncid) + + if (present(glcfilename)) then + if (masterproc) then + if (glcfilename == ' ') then + write(iulog,*) trim(subname),' ERROR: glc filename must be specified ' + call endrun() + endif + end if + call getfil( glcfilename, locfn, 0 ) + call ncd_pio_openfile (ncidg, trim(locfn), 0) + + ldomain%glcmask(:) = 0 + call ncd_io(ncid=ncidg, varname='GLCMASK', flag='read', data=ldomain%glcmask, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: GLCMASK NOT in file' ) + + ! Make sure the glc mask is a subset of the land mask + do n = beg,end + if (ldomain%glcmask(n)==1 .and. ldomain%mask(n)==0) then + write(iulog,*)trim(subname),& + 'initialize1: landmask/glcmask mismatch' + write(iulog,*)trim(subname),& + 'glc requires input where landmask = 0, gridcell index', n + call endrun() + endif + enddo + call ncd_pio_closefile(ncidg) + endif ! present(glcfilename) + + end subroutine surfrd_get_grid + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_get_topo +! +! !INTERFACE: + subroutine surfrd_get_topo(domain,filename) +! +! !DESCRIPTION: +! Read the topo dataset grid related information: +! Assume domain has already been initialized and read +! +! !USES: + use domainMod , only : domain_type + use fileutils , only : getfil +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain ! domain to init + character(len=*) ,intent(in) :: filename ! grid filename +! +! !CALLED FROM: +! subroutine initialize +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + type(file_desc_t) :: ncid ! netcdf file id + integer :: n ! indices + integer :: ni,nj,ns ! size of grid on file + integer :: dimid,varid ! netCDF id's + integer :: ier ! error status + real(r8):: eps = 1.0e-12_r8 ! lat/lon error tolerance + integer :: beg,end ! local beg,end indices + logical :: isgrid2d ! true => file is 2d lat/lon + real(r8),pointer :: lonc(:),latc(:) ! local lat/lon + character(len=256) :: locfn ! local file name + logical :: readvar ! is variable on file + character(len=32) :: subname = 'surfrd_get_topo' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun() + else + write(iulog,*) 'Attempting to read lnd topo from flndtopo ',trim(filename) + endif + end if + + call getfil( filename, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + + if (domain%ns /= ns) then + write(iulog,*) trim(subname),' ERROR: topo file mismatch ns',& + domain%ns,ns + call endrun() + endif + + beg = domain%nbeg + end = domain%nend + + allocate(latc(beg:end),lonc(beg:end)) + + call ncd_io(ncid=ncid, varname='LONGXY', flag='read', data=lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: LONGXY NOT on topodata file' ) + + call ncd_io(ncid=ncid, varname='LATIXY', flag='read', data=latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: LATIXY NOT on topodata file' ) + + do n = beg,end + if (abs(latc(n)-domain%latc(n)) > eps .or. & + abs(lonc(n)-domain%lonc(n)) > eps) then + write(iulog,*) trim(subname),' ERROR: topo file mismatch lat,lon',latc(n),& + domain%latc(n),lonc(n),domain%lonc(n),eps + call endrun() + endif + enddo + + call ncd_io(ncid=ncid, varname='TOPO', flag='read', data=domain%topo, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: TOPO NOT on topodata file' ) + + deallocate(latc,lonc) + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_topo + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_get_data +! +! !INTERFACE: + subroutine surfrd_get_data (ldomain, lfsurdat) +! +! !DESCRIPTION: +! Read the surface dataset and create subgrid weights. +! The model's surface dataset recognizes 6 basic land cover types within a grid +! cell: lake, wetland, urban, glacier, glacier_mec and vegetated. The vegetated +! portion of the grid cell is comprised of up to [maxpatch_pft] PFTs. These +! subgrid patches are read in explicitly for each grid cell. This is in +! contrast to LSMv1, where the PFTs were built implicitly from biome types. +! o real latitude of grid cell (degrees) +! o real longitude of grid cell (degrees) +! o integer surface type: 0 = ocean or 1 = land +! o integer soil color (1 to 20) for use with soil albedos +! o real soil texture, %sand, for thermal and hydraulic properties +! o real soil texture, %clay, for thermal and hydraulic properties +! o real % of cell covered by lake for use as subgrid patch +! o real % of cell covered by wetland for use as subgrid patch +! o real % of cell that is urban for use as subgrid patch +! o real % of cell that is glacier for use as subgrid patch +! o real % of cell that is glacier_mec for use as subgrid patch +! o integer PFTs +! o real % abundance PFTs (as a percent of vegetated area) +! +! !USES: + use clm_varctl , only : allocate_all_vegpfts, create_crop_landunit + use pftvarcon , only : noveg + use fileutils , only : getfil + use domainMod , only : domain_type, domain_init, domain_clean +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(in) :: ldomain ! land domain associated with wtxy + character(len=*), intent(in) :: lfsurdat ! surface dataset filename +! +! !CALLED FROM: +! subroutine initialize in module initializeMod +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein, Sam Levis and Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + type(var_desc_t) :: vardesc ! pio variable descriptor + type(domain_type) :: surfdata_domain ! local domain associated with surface dataset + character(len=256):: locfn ! local file name + integer :: n ! loop indices + integer :: ni,nj,ns ! domain sizes + character(len=16) :: lon_var, lat_var ! names of lat/lon on dataset + logical :: readvar ! true => variable is on dataset + real(r8) :: rmaxlon,rmaxlat ! local min/max vars + type(file_desc_t) :: ncid ! netcdf id + integer :: begg,endg ! beg,end gridcell indices + logical :: istype_domain ! true => input file is of type domain + logical :: isgrid2d ! true => intut grid is 2d + character(len=32) :: subname = 'surfrd_get_data' ! subroutine name +!----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to read surface boundary data .....' + if (lfsurdat == ' ') then + write(iulog,*)'lfsurdat must be specified'; call endrun() + endif + endif + + call get_proc_bounds(begg,endg) + allocate(pctspec(begg:endg)) + + vegxy(:,:) = noveg + wtxy(:,:) = 0._r8 + pctspec(:) = 0._r8 + if (allocated(topoxy)) topoxy(:,:) = 0._r8 + + ! Read surface data + + call getfil( lfsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + + ! Read in pft mask - this variable is only on the surface dataset - but not + ! on the domain dataset + + call ncd_io(ncid=ncid, varname= 'PFTDATA_MASK', flag='read', data=ldomain%pftm, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: pftm NOT on surface dataset' ) + + ! Check if fsurdat grid is "close" to fatmlndfrc grid, exit if lats/lon > 0.001 + + call check_var(ncid=ncid, varname='xc', vardesc=vardesc, readvar=readvar) + if (readvar) then + istype_domain = .true. + else + call check_var(ncid=ncid, varname='LONGXY', vardesc=vardesc, readvar=readvar) + if (readvar) then + istype_domain = .false. + else + call endrun( trim(subname)//' ERROR: unknown domain type') + end if + end if + if (istype_domain) then + lon_var = 'xc' + lat_var = 'yc' + else + lon_var = 'LONGXY' + lat_var = 'LATIXY' + end if + if ( masterproc )then + write(iulog,*) trim(subname),' lon_var = ',trim(lon_var),' lat_var =',trim(lat_var) + end if + + call ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) + call domain_init(surfdata_domain, isgrid2d, ni, nj, begg, endg, clmlevel=grlnd) + + call ncd_io(ncid=ncid, varname=lon_var, flag='read', data=surfdata_domain%lonc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: lon var NOT on surface dataset' ) + + call ncd_io(ncid=ncid, varname=lat_var, flag='read', data=surfdata_domain%latc, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: lat var NOT on surface dataset' ) + + rmaxlon = 0.0_r8 + rmaxlat = 0.0_r8 + do n = begg,endg + if (ldomain%lonc(n)-surfdata_domain%lonc(n) > 300.) then + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)-360._r8)) + elseif (ldomain%lonc(n)-surfdata_domain%lonc(n) < -300.) then + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n)+360._r8)) + else + rmaxlon = max(rmaxlon,abs(ldomain%lonc(n)-surfdata_domain%lonc(n))) + endif + rmaxlat = max(rmaxlat,abs(ldomain%latc(n)-surfdata_domain%latc(n))) + enddo + if (rmaxlon > 0.001_r8 .or. rmaxlat > 0.001_r8) then + write(iulog,*) trim(subname)//': surfdata/fatmgrid lon/lat mismatch error',& + rmaxlon,rmaxlat + call endrun(trim(subname)) + end if + call domain_clean(surfdata_domain) + + ! Obtain special landunit info + + call surfrd_wtxy_special(ncid, ldomain%ns) + + ! Obtain vegetated landunit info + + if (use_cndv) then + if (create_crop_landunit) then ! CNDV means allocate_all_vegpfts = .true. + call surfrd_wtxy_veg_all(ncid, ldomain%ns, ldomain%pftm) + end if + call surfrd_wtxy_veg_dgvm() + else + if (allocate_all_vegpfts) then + call surfrd_wtxy_veg_all(ncid, ldomain%ns, ldomain%pftm) + else + call endrun (trim(subname) // 'only allocate_all_vegpfts is supported') + end if + end if + + call ncd_pio_closefile(ncid) + + if ( masterproc )then + write(iulog,*) 'Successfully read surface boundary data' + write(iulog,*) + end if + + end subroutine surfrd_get_data + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_wtxy_special +! +! !INTERFACE: + subroutine surfrd_wtxy_special(ncid, ns) +! +! !DESCRIPTION: +! Determine weight with respect to gridcell of all special "pfts" as well +! as soil color and percent sand and clay +! +! !USES: + use pftvarcon , only : noveg + use UrbanInputMod , only : urbinp + use clm_varpar , only : maxpatch_glcmec +! +! !ARGUMENTS: + implicit none + type(file_desc_t), intent(inout) :: ncid ! netcdf id + integer , intent(in) :: ns ! domain size +! +! !CALLED FROM: +! subroutine surfrd in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein, Sam Levis and Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n,nl,nurb,g ! indices + integer :: begg,endg ! gcell beg/end + integer :: dimid,varid ! netCDF id's + real(r8) :: nlevsoidata(nlevsoi) + logical :: found ! temporary for error check + integer :: nindx ! temporary for error check + integer :: ier ! error status + integer :: nlev ! level + integer :: npatch + logical :: readvar + real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier + real(r8),pointer :: pctlak(:) ! percent of grid cell is lake + real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland + real(r8),pointer :: pcturb(:) ! percent of grid cell is urbanized + real(r8),pointer :: pctglc_mec(:,:) ! percent of grid cell is glacier_mec (in each elev class) + real(r8),pointer :: pctglc_mec_tot(:) ! percent of grid cell is glacier (sum over classes) + real(r8),pointer :: topoglc_mec(:,:) ! surface elevation in each elev class + character(len=32) :: subname = 'surfrd_wtxy_special' ! subroutine name + real(r8) closelat,closelon +!!----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg) + + allocate(pctgla(begg:endg),pctlak(begg:endg)) + allocate(pctwet(begg:endg),pcturb(begg:endg)) + if (create_glacier_mec_landunit) then + allocate(pctglc_mec(begg:endg,maxpatch_glcmec)) + allocate(pctglc_mec_tot(begg:endg)) + allocate(topoglc_mec(begg:endg,maxpatch_glcmec)) + allocate(glc_topomax(0:maxpatch_glcmec)) + endif + + call check_dim(ncid, 'nlevsoi', nlevsoi) + + ! Obtain non-grid surface properties of surface dataset other than percent pft + + call ncd_io(ncid=ncid, varname='PCT_WETLAND', flag='read', data=pctwet, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_WETLAND NOT on surfdata file' ) + + call ncd_io(ncid=ncid, varname='PCT_LAKE' , flag='read', data=pctlak, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_LAKE NOT on surfdata file' ) + + call ncd_io(ncid=ncid, varname='PCT_GLACIER', flag='read', data=pctgla, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_GLACIER NOT on surfdata file' ) + + call ncd_io(ncid=ncid, varname='PCT_URBAN' , flag='read', data=pcturb, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_URBAN NOT on surfdata file' ) + + if (create_glacier_mec_landunit) then ! call ncd_io_gs_int2d + + call check_dim(ncid, 'nglcec', maxpatch_glcmec ) + call check_dim(ncid, 'nglcecp1', maxpatch_glcmec+1 ) + + call ncd_io(ncid=ncid, varname='GLC_MEC', flag='read', data=glc_topomax, & + readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//'ERROR: GLC_MEC was NOT on the input surfdata file' ) + + call ncd_io(ncid=ncid, varname='PCT_GLC_MEC', flag='read', data=pctglc_mec, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_GLC_MEC NOT on surfdata file' ) + + call ncd_io(ncid=ncid, varname='TOPO_GLC_MEC', flag='read', data=topoglc_mec, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: TOPO_GLC_MEC NOT on surfdata file' ) + + pctglc_mec_tot(:) = 0._r8 + do n = 1, maxpatch_glcmec + do nl = begg,endg + pctglc_mec_tot(nl) = pctglc_mec_tot(nl) + pctglc_mec(nl,n) + enddo + enddo + + ! Make sure sum of pctglc_mec = pctgla (approximately), then correct pctglc_mec so + ! that its sum more exactly equals pctgla, then zero out pctgla + ! + ! WJS (9-28-12): The reason for the correction piece of this is: in the surface + ! dataset, pctgla underwent various minor corrections that make it the trusted + ! value (as opposed to sum(pctglc_mec). sum(pctglc_mec) can differ from pctgla by + ! single precision roundoff. This difference can cause problems later (e.g., in the + ! consistency check in pftdynMod), so we do this correction here. It might be + ! better to do this correction in mksurfdata_map, but because of time constraints, + ! which make me unable to recreate surface datasets, I have to do it here instead + ! (and there are arguments for putting it here anyway). + + do nl = begg,endg + ! We need to use a fairly high threshold for equality (2.0e-5) because pctgla + ! and pctglc_mec are computed using single precision inputs. Note that this + ! threshold agrees with the threshold in the error checks in mkglcmecMod: + ! mkglcmec in mksurfdata_map. + if (abs(pctgla(nl) - pctglc_mec_tot(nl)) > 2.0e-5) then + write(iulog,*) ' ' + write(iulog,*) 'surfrd error: pctgla not equal to sum of pctglc_mec for nl=', nl + write(iulog,*) 'pctgla =', pctgla(nl) + write(iulog,*) 'pctglc_mec_tot =', pctglc_mec_tot(nl) + call endrun() + endif + + ! Correct the remaining minor differences in pctglc_mec so sum more exactly + ! equals pctglc (see notes above for justification) + if (pctglc_mec_tot(nl) > 0.0_r8) then + pctglc_mec(nl,:) = pctglc_mec(nl,:) * pctgla(nl)/pctglc_mec_tot(nl) + end if + + ! Now recompute pctglc_mec_tot, and confirm that we are now much closer to pctgla + pctglc_mec_tot(nl) = 0._r8 + do n = 1, maxpatch_glcmec + pctglc_mec_tot(nl) = pctglc_mec_tot(nl) + pctglc_mec(nl,n) + end do + + if (abs(pctgla(nl) - pctglc_mec_tot(nl)) > 1.0e-13) then + write(iulog,*) ' ' + write(iulog,*) 'surfrd error: after correction, pctgla not equal to sum of pctglc_mec for nl=', nl + write(iulog,*) 'pctgla =', pctgla(nl) + write(iulog,*) 'pctglc_mec_tot =', pctglc_mec_tot(nl) + call endrun() + endif + + ! Finally, zero out pctgla + pctgla(nl) = 0._r8 + enddo + + ! If pctglc_mec_tot is very close to 100%, round to 100% + + do nl = begg,endg + ! The inequality here ( <= 2.0e-5 ) is designed to be the complement of the + ! above check that makes sure pctglc_mec_tot is close to pctgla: so if pctglc= + ! 100 (exactly), then exactly one of these conditionals will be triggered. + ! Update 9-28-12: Now that there is a rescaling of pctglc_mec to bring it more + ! in line with pctgla, we could probably decrease this tolerance again (the + ! point about exactly one of these conditionals being triggered no longer holds) + ! - or perhaps even get rid of this whole block of code. But I'm keeping this as + ! is for now because that's how I tested it, and I don't think it will hurt + ! anything to use this larger tolerance. + if (abs(pctglc_mec_tot(nl) - 100._r8) <= 2.0e-5) then + pctglc_mec(nl,:) = pctglc_mec(nl,:) * 100._r8 / pctglc_mec_tot(nl) + pctglc_mec_tot(nl) = 100._r8 + endif + enddo + + pctspec = pctwet + pctlak + pcturb + pctglc_mec_tot + + if ( masterproc ) write(iulog,*) ' elevation limits = ', glc_topomax + + else + + pctspec = pctwet + pctlak + pcturb + pctgla + + endif + + ! Error check: glacier, lake, wetland, urban sum must be less than 100 + + found = .false. + do nl = begg,endg + if (pctspec(nl) > 100._r8+1.e-04_r8) then + found = .true. + nindx = nl + exit + end if + if (found) exit + end do + if ( found ) then + write(iulog,*)'surfrd error: PFT cover>100 for nl=',nindx + call endrun() + end if + + ! Determine veg and wtxy for special landunits + + do nl = begg,endg + + vegxy(nl,npatch_lake) = noveg + wtxy(nl,npatch_lake) = pctlak(nl)/100._r8 + + vegxy(nl,npatch_wet) = noveg + wtxy(nl,npatch_wet) = pctwet(nl)/100._r8 + + vegxy(nl,npatch_glacier)= noveg + wtxy(nl,npatch_glacier) = pctgla(nl)/100._r8 + + ! Initialize urban weights + + do nurb = npatch_urban, npatch_lake-1 + vegxy(nl,nurb) = noveg + wtxy(nl,nurb) = pcturb(nl) / 100._r8 + end do + if ( pcturb(nl) > 0.0_r8 )then + wtxy(nl,npatch_urban) = wtxy(nl,npatch_urban)*urbinp%wtlunit_roof(nl) + wtxy(nl,npatch_urban+1) = wtxy(nl,npatch_urban+1)*(1 - urbinp%wtlunit_roof(nl))/3 + wtxy(nl,npatch_urban+2) = wtxy(nl,npatch_urban+2)*(1 - urbinp%wtlunit_roof(nl))/3 + wtxy(nl,npatch_urban+3) = wtxy(nl,npatch_urban+3)*(1 - urbinp%wtlunit_roof(nl))/3 * (1.-urbinp%wtroad_perv(nl)) + wtxy(nl,npatch_urban+4) = wtxy(nl,npatch_urban+4)*(1 - urbinp%wtlunit_roof(nl))/3 * urbinp%wtroad_perv(nl) + end if + + end do + + ! Check to make sure we have valid urban data for each urban patch + + found = .false. + do nl = begg,endg + if ( pcturb(nl) > 0.0_r8 )then + if (urbinp%canyon_hwr(nl) .le. 0._r8 .or. & + urbinp%em_improad(nl) .le. 0._r8 .or. & + urbinp%em_perroad(nl) .le. 0._r8 .or. & + urbinp%em_roof(nl) .le. 0._r8 .or. & + urbinp%em_wall(nl) .le. 0._r8 .or. & + urbinp%ht_roof(nl) .le. 0._r8 .or. & + urbinp%thick_roof(nl) .le. 0._r8 .or. & + urbinp%thick_wall(nl) .le. 0._r8 .or. & + urbinp%t_building_max(nl) .le. 0._r8 .or. & + urbinp%t_building_min(nl) .le. 0._r8 .or. & + urbinp%wind_hgt_canyon(nl) .le. 0._r8 .or. & + urbinp%wtlunit_roof(nl) .le. 0._r8 .or. & + urbinp%wtroad_perv(nl) .le. 0._r8 .or. & + any(urbinp%alb_improad_dir(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_improad_dif(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_perroad_dir(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_perroad_dif(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_roof_dir(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_roof_dif(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_wall_dir(nl,:) .le. 0._r8) .or. & + any(urbinp%alb_wall_dif(nl,:) .le. 0._r8) .or. & + any(urbinp%tk_roof(nl,:) .le. 0._r8) .or. & + any(urbinp%tk_wall(nl,:) .le. 0._r8) .or. & + any(urbinp%cv_roof(nl,:) .le. 0._r8) .or. & + any(urbinp%cv_wall(nl,:) .le. 0._r8)) then + found = .true. + nindx = nl + exit + else + if (urbinp%nlev_improad(nl) .gt. 0) then + nlev = urbinp%nlev_improad(nl) + if (any(urbinp%tk_improad(nl,1:nlev) .le. 0._r8) .or. & + any(urbinp%cv_improad(nl,1:nlev) .le. 0._r8)) then + found = .true. + nindx = nl + exit + end if + end if + end if + if (found) exit + end if + end do + if ( found ) then + write(iulog,*)'surfrd error: no valid urban data for nl=',nindx + write(iulog,*)'canyon_hwr: ',urbinp%canyon_hwr(nindx) + write(iulog,*)'em_improad: ',urbinp%em_improad(nindx) + write(iulog,*)'em_perroad: ',urbinp%em_perroad(nindx) + write(iulog,*)'em_roof: ',urbinp%em_roof(nindx) + write(iulog,*)'em_wall: ',urbinp%em_wall(nindx) + write(iulog,*)'ht_roof: ',urbinp%ht_roof(nindx) + write(iulog,*)'thick_roof: ',urbinp%thick_roof(nindx) + write(iulog,*)'thick_wall: ',urbinp%thick_wall(nindx) + write(iulog,*)'t_building_max: ',urbinp%t_building_max(nindx) + write(iulog,*)'t_building_min: ',urbinp%t_building_min(nindx) + write(iulog,*)'wind_hgt_canyon: ',urbinp%wind_hgt_canyon(nindx) + write(iulog,*)'wtlunit_roof: ',urbinp%wtlunit_roof(nindx) + write(iulog,*)'wtroad_perv: ',urbinp%wtroad_perv(nindx) + write(iulog,*)'alb_improad_dir: ',urbinp%alb_improad_dir(nindx,:) + write(iulog,*)'alb_improad_dif: ',urbinp%alb_improad_dif(nindx,:) + write(iulog,*)'alb_perroad_dir: ',urbinp%alb_perroad_dir(nindx,:) + write(iulog,*)'alb_perroad_dif: ',urbinp%alb_perroad_dif(nindx,:) + write(iulog,*)'alb_roof_dir: ',urbinp%alb_roof_dir(nindx,:) + write(iulog,*)'alb_roof_dif: ',urbinp%alb_roof_dif(nindx,:) + write(iulog,*)'alb_wall_dir: ',urbinp%alb_wall_dir(nindx,:) + write(iulog,*)'alb_wall_dif: ',urbinp%alb_wall_dif(nindx,:) + write(iulog,*)'tk_roof: ',urbinp%tk_roof(nindx,:) + write(iulog,*)'tk_wall: ',urbinp%tk_wall(nindx,:) + write(iulog,*)'cv_roof: ',urbinp%cv_roof(nindx,:) + write(iulog,*)'cv_wall: ',urbinp%cv_wall(nindx,:) + if (urbinp%nlev_improad(nindx) .gt. 0) then + nlev = urbinp%nlev_improad(nindx) + write(iulog,*)'tk_improad: ',urbinp%tk_improad(nindx,1:nlev) + write(iulog,*)'cv_improad: ',urbinp%cv_improad(nindx,1:nlev) + end if + call endrun() + end if + + ! Initialize glacier_mec weights + + if (create_glacier_mec_landunit) then + do n = 1, maxpatch_glcmec + npatch = npatch_glacier_mec - maxpatch_glcmec + n + do nl = begg, endg + vegxy (nl,npatch) = noveg + wtxy (nl,npatch) = pctglc_mec(nl,n)/100._r8 + topoxy(nl,npatch) = topoglc_mec(nl,n) + enddo ! nl + enddo ! maxpatch_glcmec + deallocate(pctglc_mec, pctglc_mec_tot, topoglc_mec) + endif ! create_glacier_mec_landunit + + deallocate(pctgla,pctlak,pctwet,pcturb) + + end subroutine surfrd_wtxy_special + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_wtxy_veg_all +! +! !INTERFACE: + subroutine surfrd_wtxy_veg_all(ncid, ns, pftm) +! +! !DESCRIPTION: +! Determine wtxy and veg arrays for non-dynamic landuse mode +! +! !USES: + use clm_varctl , only : create_crop_landunit + use pftvarcon , only : nirrig, npcropmin + use spmdMod , only : mpicom, MPI_LOGICAL, MPI_LOR +! +! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! netcdf id + integer ,intent(in) :: ns ! domain size + integer ,pointer :: pftm(:) +! +! !CALLED FROM: +! subroutine surfrd in this module +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein, Sam Levis and Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m,mp7,mp8,mp11,n,nl ! indices + integer :: begg,endg ! beg/end gcell index + integer :: dimid,varid ! netCDF id's + integer :: ier ! error status + logical :: readvar ! is variable on dataset + real(r8) :: sumpct ! sum of %pft over maxpatch_pft + real(r8),allocatable :: pctpft(:,:) ! percent of vegetated gridcell area for PFTs + real(r8),pointer :: arrayl(:,:) ! local array + real(r8) :: numpftp1data(0:numpft) + logical :: crop = .false. ! if crop data on this section of file + character(len=32) :: subname = 'surfrd_wtxy_veg_all' ! subroutine name +!----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg) + allocate(pctpft(begg:endg,0:numpft)) + + call check_dim(ncid, 'lsmpft', numpft+1) + + allocate(arrayl(begg:endg,0:numpft)) + call ncd_io(ncid=ncid, varname='PCT_PFT', flag='read', data=arrayl, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) call endrun( trim(subname)//' ERROR: PCT_PFT NOT on surfdata file' ) + pctpft(begg:endg,0:numpft) = arrayl(begg:endg,0:numpft) + deallocate(arrayl) + + do nl = begg,endg + if (pftm(nl) >= 0) then + + ! Error check: make sure PFTs sum to 100% cover for vegetated landunit + ! (convert pctpft from percent with respect to gridcel to percent with + ! respect to vegetated landunit) + + if (pctspec(nl) < 100._r8) then + sumpct = 0._r8 + do m = 0,numpft + sumpct = sumpct + pctpft(nl,m) * 100._r8/(100._r8-pctspec(nl)) + if (m == nirrig .and. .not. create_crop_landunit) then + if (pctpft(nl,m) > 0._r8) then + call endrun( trim(subname)//' ERROR surfrdMod: irrigated crop'// & + ' PFT requires create_crop_landunit=.true.' ) + end if + end if + end do + if (abs(sumpct - 100._r8) > 0.1e-4_r8) then + write(iulog,*) trim(subname)//' ERROR: sum(pct) over numpft+1 is not = 100.' + write(iulog,*) sumpct, sumpct-100._r8, nl + call endrun() + end if + if (sumpct < -0.000001_r8) then + write(iulog,*) trim(subname)//' ERROR: sum(pct) over numpft+1 is < 0.' + write(iulog,*) sumpct, nl + call endrun() + end if + do m = npcropmin, numpft + if ( pctpft(nl,m) > 0.0_r8 ) crop = .true. + end do + end if + + ! Set weight of each pft wrt gridcell (note that maxpatch_pft = numpft+1 here) + + do m = 1,numpft+1 + vegxy(nl,m) = m - 1 ! 0 (bare ground) to numpft + wtxy(nl,m) = pctpft(nl,m-1) / 100._r8 + end do + + end if + end do + call mpi_allreduce(crop,crop_prog,1,MPI_LOGICAL,MPI_LOR,mpicom,ier) + if (ier /= 0) then + write(iulog,*) trim(subname)//' mpi_allreduce error = ',ier + call endrun( trim(subname)//' ERROR: error in reduce of crop_prog' ) + endif + if (crop_prog .and. .not. create_crop_landunit) then + call endrun( trim(subname)//' ERROR: prognostic crop '// & + 'PFTs requires create_crop_landunit=.true.' ) + end if + + deallocate(pctpft) + + end subroutine surfrd_wtxy_veg_all + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: surfrd_wtxy_veg_dgvm +! +! !INTERFACE: + subroutine surfrd_wtxy_veg_dgvm() +! +! !DESCRIPTION: +! Determine wtxy and vegxy for CNDV mode. +! +! !USES: + use pftvarcon , only : noveg, crop + use clm_varctl, only : create_crop_landunit +! +! !ARGUMENTS: + implicit none +! +! !CALLED FROM: +! subroutine surfrd in this module +! +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 12/04 +! +! +! !LOCAL VARIABLES: +!EOP + integer :: m,nl ! indices + integer :: begg,endg ! beg/end gcell index +!----------------------------------------------------------------------- + + call get_proc_bounds(begg,endg) + do nl = begg,endg + do m = 1, maxpatch_pft ! CNDV means allocate_all_vegpfts = .true. + if (create_crop_landunit) then ! been through surfrd_wtxy_veg_all + if (crop(m-1) == 0) then ! so update natural vegetation only + wtxy(nl,m) = 0._r8 ! crops should have values >= 0. + end if + else ! not been through surfrd_wtxy_veg_all + wtxy(nl,m) = 0._r8 ! so update all vegetation + vegxy(nl,m) = m - 1 ! 0 (bare ground) to maxpatch_pft-1 (= 16) + end if + end do + ! bare ground weights + wtxy(nl,noveg+1) = max(0._r8, 1._r8 - sum(wtxy(nl,:))) + if (abs(sum(wtxy(nl,:)) - 1._r8) > 1.e-5_r8) then + write(iulog,*) 'all wtxy =', wtxy(nl,:) + call endrun() + end if ! error check + end do + + end subroutine surfrd_wtxy_veg_dgvm + +end module surfrdMod diff --git a/components/clm/test/tools/CLM_compare.sh b/components/clm/test/tools/CLM_compare.sh new file mode 100755 index 0000000000..ad6d56f28f --- /dev/null +++ b/components/clm/test/tools/CLM_compare.sh @@ -0,0 +1,39 @@ +#!/bin/sh +# + +if [ $# -ne 2 ]; then + echo "CLM_compare.sh: incorrect number of input arguments" + exit 1 +fi + +echo "CLM_compare.sh: comparing $1 " +echo " with $2" + +##note syntax here as stderr and stdout from cprnc command go +##to separate places! +${CPRNC_EXE} $1 $2 2>&1 > cprnc.out +rc=$? +if [ $rc -ne 0 ]; then + echo "CLM_compare.sh: error doing comparison, cprnc error= $rc" + exit 2 +fi + +result_old=`perl -e 'while (my $ll = <>) \ + { if ($ll =~ /(\d+)[^0-9]+compared[^0-9]+(\d+)/) \ + { print "PASS" if $1>0 && $2==0 }}' cprnc.out` +if grep -c "the two files seem to be IDENTICAL" cprnc.out > /dev/null; then + result=PASS +elif grep -c "the two files seem to be DIFFERENT" cprnc.out > /dev/null; then + result=FAIL +else + result=$result_old +fi + +if [ "$result" = "PASS" ]; then + echo "CLM_compare.sh: files are b4b" +else + echo "CLM_compare.sh: files are NOT b4b" + exit 3 +fi + +exit 0 diff --git a/components/clm/test/tools/Makefile b/components/clm/test/tools/Makefile new file mode 100644 index 0000000000..b5031abdba --- /dev/null +++ b/components/clm/test/tools/Makefile @@ -0,0 +1,12 @@ +# +# Makefile to build clm testing documentation +# + +# Get list of tests_ files +SOURCES = $(wildcard tests_*) + +all: test_table.html + +test_table.html: $(SOURCES) + gen_test_table.sh + diff --git a/components/clm/test/tools/README b/components/clm/test/tools/README new file mode 100644 index 0000000000..b8ec53cea2 --- /dev/null +++ b/components/clm/test/tools/README @@ -0,0 +1,53 @@ +clm/test/tools/README 05/15/2013 + +Scripts for testing the CLM support tools with many different +configurations and run-time options. + +I. MAIN SCRIPTS: + +test_driver.sh - Test the CLM offline tools + +To use... + +./test_driver.sh -i + +Intended for use on NCAR machines: yellowstone, frankfurt.cgd, lynx, mirage, +and ORNL machine titan. And works on the MacBook laptop yongi.cgd. For most machines +more than one compiler is supported. + +II. RUNNING test_driver.sh TOOLS TESTING: + +Basic use: + +./test_driver.sh -i +./test_driver.sh -h # to get help on options + +Important environment variables (just used by test_driver.sh) + +BL_ROOT ---------------- Root directory of CLM baseline code to compare to + (if not set BL test will not be performed) +BL_TESTDIR ------------- Root directory of where to put baseline tests +CLM_INPUT_TESTS -------- Filename of file with list of tests to perform +CLM_TESTDIR ------------ Root directory of where to put most tests +CLM_RETAIN_FILES ------- If set to TRUE -- don't cleanup files after testing +CLM_FC ----------------- Use given compiler +CLM_JOBID -------------- Job identification number to use (rather than process ID) +CLM_THREADS ------------ Number of open-MP threads to use + (by default this is set differently by machine) +CLM_SOFF --------------- If set to TRUE -- stop on first failed test + +Important files for test_driver tools testing: + +test_driver.sh ------- Main test script for tools +nl_files ------------- Directory with various namelists to test +config_files --------- Directory with various configurations to test +input_tests_master --- Master list of tests +tests_pretag_* ------- Tests for specific machines to do by default before a tag is done +tests_posttag_* ------ Tests for specific machines to do for more extensive testing + after a tag is done +CLM_compare.sh ------- Compares output history files between two cases +T*.sh ---------------- Basic test script to do a specific type of test +gen_test_table.sh ---- Creates HTML table of tests +Makefile ------------- Will build the HTML table of tests + +../../tools/README.testing - Information on how the testing works for the CLM tools diff --git a/components/clm/test/tools/README.testnames b/components/clm/test/tools/README.testnames new file mode 100644 index 0000000000..e7306c8770 --- /dev/null +++ b/components/clm/test/tools/README.testnames @@ -0,0 +1,65 @@ +Test names for the test_system script are given by the test type, resolution, compset, and then machine/compiler + +so + + test_type.resolution.compset.machine_compiler + +example: + + ERS_D_PT.T31_g37.I_2000_VOC_SNCRFRC_CN.yellowstone_intel + +Tests for test_driver are for the CLM tools only. + +Test naming conventions for the test_driver.sh script: + +Test names are: + +xxnmi + +Where: xx is the two-letter test type + sm=smoke, br=branch, er=exact restart, bl=base-line comparision, + cb=configure-build, rp=reproducibility, op=OpenMP threading for tools + +n is the configuration type: + +1 -- unused +2 -- unused +3 -- mkprocdata_map clm4.0 +4 -- mkmapgrids clm4.0 +5 -- gen_domain clm4.0 +6 -- PTCLM clm4.0 +7 -- mksurfdata_map clm4.0 +8 -- interpinic clm4.0 +9 -- tools scripts clm4.0 +0 -- unused +a -- unused +b -- unused +c -- mkprocdata_map clm4.5 +d -- mkmapgrids clm4.5 +e -- gen_domain clm4.5 +f -- PTCLM clm4.5 +g -- mksurfdata_map clm4.5 +h -- interpinic clm4.5 +i -- tools scripts clm4.5 + +m is the resolution + +1 -- 48x96 +5 -- 10x15 +7 -- 1x1 brazil +8 -- US-UMB +9 -- 4x5 +c -- US-UMB with cycling on forcing and transient use-case +g -- US-UMB with global forcing and grid PFT and soil +y -- 1.9x2.5 with transient 1850-2100 for rcp=2.6 and glacier-MEC on +Z -- 10x15 with crop on +@ -- ne120np4 +# -- ne30np4 + +i is the specific test (usually this implies...) + +3 -- OpenMP only +4 -- serial +7 -- OpenMP only second test (without DEBUG compiler mode on) + + diff --git a/components/clm/test/tools/TBLCFGtools.sh b/components/clm/test/tools/TBLCFGtools.sh new file mode 100755 index 0000000000..350fd0068c --- /dev/null +++ b/components/clm/test/tools/TBLCFGtools.sh @@ -0,0 +1,119 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TBLCFGtools.sh: incorrect number of input arguments" + exit 1 +fi + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TBL.sh: no environment variables set for baseline test - will skip" + exit 255 +fi + +test_name=TBLCFGtools.$1.$2.$3.$4 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLCFGtools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLCFGtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBLCFGtools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBLCFGtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBLCFGtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TBLCFGtools.sh: calling TSMCFGtools.sh to run $1 $2 executable" +${CLM_SCRIPTDIR}/TSMCFGtools.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBLCFGtools.sh: error from TSMCFGtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CLM_TESTDIR}.bl + fi + echo "TBLCFGtools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TBLCFGtools.sh: calling ****baseline**** TSMCFGtools.sh for smoke test" + bl_dir=`/bin/ls -1d ${BL_ROOT}/components/clm/test/tools` + env CLM_TESTDIR=${BL_TESTDIR} \ + CLM_ROOT=${BL_ROOT} \ + CLM_SCRIPTDIR=$bl_dir \ + $bl_dir/TSMCFGtools.sh $1 $2 $3 $4 + rc=$? + if [ $rc -ne 0 ]; then + echo "TBLCFGtools.sh: error from *baseline* TSMCFGtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +echo "TBLCFGtools.sh: starting b4b comparisons " +files_to_compare=`cd ${CLM_TESTDIR}/TSMCFGtools.$1.$2.$3.$4; ls *.nc` +if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then + echo "TBLCFGtools.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + env CPRNC_EXE=${CLM_SCRIPTDIR}/../../tools/shared/ncl_scripts/cprnc.pl \ + ${CLM_SCRIPTDIR}/CLM_compare.sh \ + ${BL_TESTDIR}/TSMCFGtools.$1.$2.$3.$4/${compare_file} \ + ${CLM_TESTDIR}/TSMCFGtools.$1.$2.$3.$4/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBLCFGtools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBLCFGtools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details +" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBLCFGtools.sh: baseline test passed" + echo "PASS" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TBLCFGtools.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TBLCFGtools.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/components/clm/test/tools/TBLscript_tools.sh b/components/clm/test/tools/TBLscript_tools.sh new file mode 100755 index 0000000000..737346574c --- /dev/null +++ b/components/clm/test/tools/TBLscript_tools.sh @@ -0,0 +1,146 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TBLscript_tools.sh: incorrect number of input arguments" + exit 1 +fi + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TBLscript_tools.sh: no environment variables set for baseline test - will skip" + exit 255 +fi + +test_name=TBLscript_tools.$1.$2.$3.$4 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLscript_tools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLscript_tools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBLscript_tools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBLscript_tools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBLscript_tools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TBLscript_tools.sh: calling TSMscript_tools.sh to run $1 $2 executable" +${CLM_SCRIPTDIR}/TSMscript_tools.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBLscript_tools.sh: error from TSMtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CLM_TESTDIR}.bl + fi + echo "TBLscript_tools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TBLscript_tools.sh: calling ****baseline**** TSMtools.sh for smoke test" + bl_dir=`/bin/ls -1d ${BL_ROOT}/components/clm/test/tools` + env CLM_TESTDIR=${BL_TESTDIR} \ + CLM_SCRIPTDIR=$bl_dir \ + CLM_ROOT=$BL_ROOT \ + $bl_dir/TSMscript_tools.sh $1 $2 $3 $4 + rc=$? + if [ $rc -ne 0 ]; then + echo "TBLscript_tools.sh: error from *baseline* TSMscript_tools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +echo "TBLscript_tools.sh: starting b4b comparisons " +files_to_compare=`cd ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3.$4; ls *.nc` +if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then + echo "TBLscript_tools.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + # For PTCLM, skip comparisons of mapping files, since these aren't really + # necessary, take a lot of time, and cprnc.pl can crash if there are mapping + # files with 0 overlaps + if [[ "$2" == "PTCLM" ]]; then + if [[ "$compare_file" == map* ]]; then + echo "SKIPPING: $compare_file" + continue + fi + fi + + env CPRNC_EXE=${CLM_SCRIPTDIR}/../../tools/shared/ncl_scripts/cprnc.pl \ + ${CLM_SCRIPTDIR}/CLM_compare.sh \ + ${BL_TESTDIR}/TSMscript_tools.$1.$2.$3.$4/${compare_file} \ + ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3.$4/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBLscript_tools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBLscript_tools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done +# Compare text files for PTCLM if they exist +files_to_compare=`cd ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3.$4; ls README*` +for compare_file in ${files_to_compare}; do + + diff \ + ${BL_TESTDIR}/TSMscript_tools.$1.$2.$3.$4/${compare_file} \ + ${CLM_TESTDIR}/TSMscript_tools.$1.$2.$3.$4/${compare_file} \ + > diff.${compare_file}.out + rc=$? + if [ $rc -eq 0 ]; then + echo "TBLscript_tools.sh: comparison successful; output in ${rundir}/diff.${compare_file}.out" + else + echo "TBLscript_tools.sh: error from CLM_compare.sh= $rc; see ${rundir}/diff.${compare_file}.out for details" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBLscript_tools.sh: baseline test passed" + echo "PASS" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TBLscript_tools.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TBLscript_tools.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + + + +exit 0 diff --git a/components/clm/test/tools/TBLtools.sh b/components/clm/test/tools/TBLtools.sh new file mode 100755 index 0000000000..b668e97a75 --- /dev/null +++ b/components/clm/test/tools/TBLtools.sh @@ -0,0 +1,119 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TBLtools.sh: incorrect number of input arguments" + exit 1 +fi + +if [ -z "$BL_ROOT" ] && [ -z "$BL_TESTDIR" ]; then + echo "TBL.sh: no environment variables set for baseline test - will skip" + exit 255 +fi + +test_name=TBLtools.$1.$2.$3.$4 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLtools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TBLtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TBLtools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TBLtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TBLtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TBLtools.sh: calling TSMtools.sh to run $1 $2 executable" +${CLM_SCRIPTDIR}/TSMtools.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TBLtools.sh: error from TSMtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +if [ -n "${BL_ROOT}" ]; then + if [ -z "$BL_TESTDIR" ]; then + BL_TESTDIR=${CLM_TESTDIR}.bl + fi + echo "TBLtools.sh: generating baseline data from root $BL_ROOT - results in $BL_TESTDIR" + + echo "TBLtools.sh: calling ****baseline**** TSMtools.sh for smoke test" + bl_dir=`/bin/ls -1d ${BL_ROOT}/components/clm/test/tools` + env CLM_TESTDIR=${BL_TESTDIR} \ + CLM_ROOT=${BL_ROOT} \ + CLM_SCRIPTDIR=$bl_dir \ + $bl_dir/TSMtools.sh $1 $2 $3 $4 + rc=$? + if [ $rc -ne 0 ]; then + echo "TBLtools.sh: error from *baseline* TSMtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +echo "TBLtools.sh: starting b4b comparisons " +files_to_compare=`cd ${CLM_TESTDIR}/TSMtools.$1.$2.$3.$4; ls *.nc` +if [ -z "${files_to_compare}" ] && [ "$debug" != "YES" ]; then + echo "TBLtools.sh: error locating files to compare" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +all_comparisons_good="TRUE" +for compare_file in ${files_to_compare}; do + + env CPRNC_EXE=${CLM_SCRIPTDIR}/../../tools/shared/ncl_scripts/cprnc.pl \ + ${CLM_SCRIPTDIR}/CLM_compare.sh \ + ${BL_TESTDIR}/TSMtools.$1.$2.$3.$4/${compare_file} \ + ${CLM_TESTDIR}/TSMtools.$1.$2.$3.$4/${compare_file} + rc=$? + mv cprnc.out cprnc.${compare_file}.out + if [ $rc -eq 0 ]; then + echo "TBLtools.sh: comparison successful; output in ${rundir}/cprnc.${compare_file}.out" + else + echo "TBLtools.sh: error from CLM_compare.sh= $rc; see ${rundir}/cprnc.${compare_file}.out for details +" + all_comparisons_good="FALSE" + fi +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TBLtools.sh: baseline test passed" + echo "PASS" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TBLtools.sh: removing some unneeded files to save disc space" + rm *.nc + rm *.r* + fi +else + echo "TBLtools.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/components/clm/test/tools/TCBCFGtools.sh b/components/clm/test/tools/TCBCFGtools.sh new file mode 100755 index 0000000000..ec5c34309c --- /dev/null +++ b/components/clm/test/tools/TCBCFGtools.sh @@ -0,0 +1,126 @@ +#!/bin/sh +# + +if [ $# -ne 3 ]; then + echo "TCBCFGtools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TCBCFGtools.$1.$2.$3 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBCFGtools.sh: build test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBCFGtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TCBCFGtools.sh: build test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TCBCFGtools.sh: this build test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +blddir=${CLM_TESTDIR}/${test_name}/src +if [ -d ${blddir} ]; then + rm -r ${blddir} +fi +mkdir -p ${blddir} +if [ $? -ne 0 ]; then + echo "TCBCFGtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${blddir} + +echo "TCBCFGtools.sh: building $1 executable; output in ${blddir}/test.log" +# +# Copy build files over +# +cp $cfgdir/src/Makefile . +cp $cfgdir/src/Filepath . +# +# Add cfgdir path to beginning of each path in Filepath +# +touch Filepath +while read filepath_arg; do + echo "${cfgdir}/src/${filepath_arg}" >> Filepath +done < ${cfgdir}/src/Filepath + +# +# Figure out configuration +# +if [ ! -f ${CLM_SCRIPTDIR}/config_files/$2 ]; then + echo "TCB.sh: configure options file ${CLM_SCRIPTDIR}/config_files/$2 not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +##construct string of args to configure +config_string=" " +while read config_arg; do + config_string="${config_string}${config_arg} " +done < ${CLM_SCRIPTDIR}/config_files/$2 + +if [ "$TOOLSLIBS" != "" ]; then + export SLIBS=$TOOLSLIBS +fi +echo "env CIMEROOT=$CLM_ROOT/cime $config_string $CLM_ROOT/cime/machines/configure -mach $CESM_MACH -compiler $CESM_COMP $TOOLS_CONF_STRING" +env CIMEROOT=$CLM_ROOT/cime $config_string $CLM_ROOT/cime/machines/configure -mach $CESM_MACH -compiler $CESM_COMP $TOOLS_CONF_STRING >> test.log 2>&1 +rc=$? +if [ $rc -ne 0 ]; then + echo "TCBCFGtools.sh: configure failed, error from configure= $rc" + echo "TCBCFGtools.sh: see ${blddir}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi +attempt=1 +still_compiling="TRUE" +while [ $still_compiling = "TRUE" ]; do + + echo "TCBCFGtools.sh: call to make:" + echo " ${MAKE_CMD} " + if [ "$debug" != "YES" ]; then + ${MAKE_CMD} >> test.log 2>&1 + status="PASS" + rc=$? + else + status="GEN" + rc=0 + fi + if [ $rc -eq 0 ]; then + echo "TCBCFGtools.sh: make was successful" + echo "TCBCFGtools.sh: configure and build test passed" + echo "$status" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TCBCFGtools.sh: removing some unneeded files to save disc space" + rm *.o + rm *.mod + fi + still_compiling="FALSE" + elif [ $attempt -lt 10 ] && \ + grep -c "LICENSE MANAGER PROBLEM" test.log > /dev/null; then + attempt=`expr $attempt + 1` + echo "TCBCFGtools.sh: encountered License Manager Problem; launching attempt #$attempt" + else + echo "TCBCFGtools.sh: clm build failed, error from make= $rc" + echo "TCBCFGtools.sh: see ${blddir}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 + fi +done +if [ "$TOOLSLIBS" != "" ]; then + export -n SLIBS +fi + +exit 0 diff --git a/components/clm/test/tools/TCBscripttools.sh b/components/clm/test/tools/TCBscripttools.sh new file mode 100755 index 0000000000..18d91b174c --- /dev/null +++ b/components/clm/test/tools/TCBscripttools.sh @@ -0,0 +1,79 @@ +#!/bin/sh +# + +if [ $# -ne 3 ]; then + echo "TCBscripttools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TCBscripttools.$1.$2.$3 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBscripttools.sh: build test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBscripttools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TCBscripttools.sh: build test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TCBscripttools.sh: this build test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +blddir=${CLM_TESTDIR}/${test_name} +if [ -d ${blddir} ]; then + rm -r ${blddir} +fi +mkdir -p ${blddir} +if [ $? -ne 0 ]; then + echo "TCBscripttools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${blddir} + +echo "TCBscripttools.sh: building $2 executables; output in ${blddir}/test.log" +# +# Build script to exercise +# +if [ ! -x ${cfgdir}/$3 ]; then + echo "TCB.sh: build run script file ${cfgdir}/$3 not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TCBscripttools.sh: run the build scriptmake:" +echo " ${cfgdir}/$3" + +if [ "$debug" != "YES" ]; then + export CESM_ROOT=${CLM_ROOT} + ${cfgdir}/$3 >> test.log 2>&1 + rc=$(( $rc + $? )) + status="PASS" +else + status="GEN" + rc=0 +fi +if [ $rc -eq 0 ]; then + echo "TCBscripttools.sh: build script was successful" + echo "TCBscripttools.sh: build script test passed" + echo "$status" > TestStatus +else + echo "TCBscripttools.sh: clm build script failed, error from build script= $rc" + echo "TCBscripttools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/components/clm/test/tools/TCBtools.sh b/components/clm/test/tools/TCBtools.sh new file mode 100755 index 0000000000..7429936516 --- /dev/null +++ b/components/clm/test/tools/TCBtools.sh @@ -0,0 +1,128 @@ +#!/bin/sh +# + +if [ $# -ne 3 ]; then + echo "TCBtools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TCBtools.$1.$2.$3 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBtools.sh: build test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TCBtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TCBtools.sh: build test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TCBtools.sh: this build test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +blddir=${CLM_TESTDIR}/${test_name}/src +if [ -d ${blddir} ]; then + rm -r ${blddir} +fi +mkdir -p ${blddir} +if [ $? -ne 0 ]; then + echo "TCBtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${blddir} + +echo "TCBtools.sh: building $1 $2 executable; output in ${blddir}/test.log" +# +# Copy build files over +# +cp $cfgdir/src/Makefile . +cp $cfgdir/src/Srcfiles . +cp $cfgdir/src/Mkdepends . +cp $cfgdir/src/Makefile.common . +# +# Add cfgdir path to beginning of each path in Filepath +# +touch Filepath +while read filepath_arg; do + echo "${cfgdir}/src/${filepath_arg}" >> Filepath +done < ${cfgdir}/src/Filepath + +# +# Figure out configuration +# +if [ ! -f ${CLM_SCRIPTDIR}/config_files/$3 ]; then + echo "TCB.sh: configure options file ${CLM_SCRIPTDIR}/config_files/$3 not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +##construct string of args to configure +config_string="$TOOLS_MAKE_STRING TOOLROOT=$cfgdir " +while read config_arg; do + config_string="${config_string}${config_arg} " +done < ${CLM_SCRIPTDIR}/config_files/$3 + +attempt=1 +still_compiling="TRUE" +if [ "$TOOLSLIBS" != "" ]; then + export SLIBS=$TOOLSLIBS +fi +while [ $still_compiling = "TRUE" ]; do + + if [ "$2" = "gen_domain" ]; then + HOSTNAME=`uname -n | cut -c 1-2` + if [ "$HOSTNAME" = "be" ]; then + echo "TCBtools.sh: run configure for gen_domain on bluefire" + env CIMEROOT=${CLM_ROOT}/cime ${CLM_ROOT}/cime/machines/configure -mach bluefire >> test.log 2>&1 + rc=$? + fi + fi + + echo "TCBtools.sh: call to make:" + echo " ${MAKE_CMD} ${config_string} " + if [ "$debug" != "YES" ]; then + ${MAKE_CMD} ${config_string} >> test.log 2>&1 + status="PASS" + rc=$(( $rc + $? )) + else + status="GEN" + rc=0 + fi + if [ $rc -eq 0 ]; then + echo "TCBtools.sh: make was successful" + echo "TCBtools.sh: configure and build test passed" + echo "$status" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TCBtools.sh: removing some unneeded files to save disc space" + rm *.o + rm *.mod + fi + still_compiling="FALSE" + elif [ $attempt -lt 10 ] && \ + grep -c "LICENSE MANAGER PROBLEM" test.log > /dev/null; then + attempt=`expr $attempt + 1` + echo "TCBtools.sh: encountered License Manager Problem; launching attempt #$attempt" + else + echo "TCBtools.sh: clm build failed, error from make= $rc" + echo "TCBtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 + fi +done +if [ "$TOOLSLIBS" != "" ]; then + export -n SLIBS +fi + +exit 0 diff --git a/components/clm/test/tools/TOPtools.sh b/components/clm/test/tools/TOPtools.sh new file mode 100755 index 0000000000..a44af3eb9f --- /dev/null +++ b/components/clm/test/tools/TOPtools.sh @@ -0,0 +1,120 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TOPtools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TOPtools.$1.$2.$3.$4 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TOPtools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TOPtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TOPtools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TOPtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TOPtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +if [ ${CLM_THREADS} -lt 2 ]; then + echo "TOPtools.sh: error not enough threads are being used to do the comparision" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi +if [ "$3" != "tools__o" ] && [ "$3" != "tools__do" ]; then + echo "TOPtools.sh: error build needs to be done Open-MP" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +echo "TOPtools.sh: calling TSMtools.sh to run $1 $2 executable" +${CLM_SCRIPTDIR}/TSMtools.sh $1 $2 $3 $4 +rc=$? +if [ $rc -ne 0 ]; then + echo "TOPtools.sh: error from TSMtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi +mkdir $rundir/$CLM_THREADS +cp ${CLM_TESTDIR}/TSMtools.$1.$2.$3.$4/*.nc $rundir/$CLM_THREADS + +# Get a list of different threads to run for, powers of 2 from 1 up to the thread count +threads=1 +list="1 " +until [ "$threads" -ge "$CLM_THREADS" ]; do + threads=`perl -e "$CLM_THREADS<$threads*2 ? print $CLM_THREADS : print $threads*2"` + if [ "$threads" -lt "$CLM_THREADS" ]; then list="$list $threads "; fi +done + +all_comparisons_good="TRUE" +for threads in $list +do + echo "TOPtools.sh: calling TSMtools.sh to run $1 executable for $threads threads" + env CLM_THREADS=$threads CLM_RERUN=yes ${CLM_SCRIPTDIR}/TSMtools.sh $1 $2 $3 $4 + rc=$? + if [ $rc -ne 0 ]; then + echo "TOPtools.sh: error from TSMtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 + fi + mkdir $rundir/$threads + cp ${CLM_TESTDIR}/TSMtools.$1.$2.$3.$4/*.nc $rundir/$threads + files_to_compare=`cd $rundir/$threads; ls *.nc` + for compare_file in ${files_to_compare}; do + + env CPRNC_EXE=${CLM_SCRIPTDIR}/../../tools/shared/ncl_scripts/cprnc.pl \ + ${CLM_SCRIPTDIR}/CLM_compare.sh \ + $rundir/$CLM_THREADS/${compare_file} \ + $rundir/$threads/${compare_file} + rc=$? + cprout="cprnc.${compare_file}.threads${threads}.out" + mv cprnc.out $cprout + if [ $rc -eq 0 ]; then + echo "TOPtools.sh: comparison successful; output in $cprout" + else + echo "TOPtools.sh: error from CLM_compare.sh= $rc; see $cprout for details" + all_comparisons_good="FALSE" + fi + done +done + +if [ ${all_comparisons_good} = "TRUE" ]; then + echo "TOPtools.sh: OpenMP comparison test passed" + echo "PASS" > TestStatus + if [ $CLM_RETAIN_FILES != "TRUE" ]; then + echo "TOPtools.sh: removing some unneeded files to save disc space" + rm */*.nc + fi +else + echo "TOPtools.sh: at least one file comparison did not pass" + echo "FAIL.job${JOBID}" > TestStatus + exit 7 +fi + +exit 0 diff --git a/components/clm/test/tools/TSMCFGtools.sh b/components/clm/test/tools/TSMCFGtools.sh new file mode 100755 index 0000000000..804f8b9c5a --- /dev/null +++ b/components/clm/test/tools/TSMCFGtools.sh @@ -0,0 +1,110 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TSMCFGtools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSMCFGtools.$1.$2.$3.$4 + +if [ -z "$CLM_RERUN" ]; then + CLM_RERUN="no" +fi + +if [ "$CLM_RERUN" != "yes" ] && [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMCFGtools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMCFGtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSMCFGtools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSMCFGtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSMCFGtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TSMCFGtools.sh: calling TCBCFGtools.sh to prepare $1 $2 executable" +${CLM_SCRIPTDIR}/TCBCFGtools.sh $1 $2 $3 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSMCFGtools.sh: error from TCBtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TSMCFGtools.sh: running $1 $2; output in ${rundir}/test.log" + +if [ "$3" = "CFGtools__o" ] || [ "$3" = "CFGtools__do" ]; then + toolrun="env OMP_NUM_THREADS=${CLM_THREADS} ${CLM_TESTDIR}/TCBCFGtools.$1.$2.$3/$2" +else + toolrun="${CLM_TESTDIR}/TCBCFGtools.$1.$2.$3/$2" +fi + +runfile="${CLM_SCRIPTDIR}/nl_files/$2.$4" +if [ ! -f "${runfile}" ]; then + echo "TSMCFGtools.sh: error ${runfile} input run file not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +echo "Run file type = ${4#*.}" +if [ ${4#*.} == "runoptions" ]; then + echo "$toolrun "`cat ${runfile}` + cp $cfgdir/*.nc . + if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + $toolrun `cat ${runfile}` >> test.log 2>&1 + rc=$? + status="PASS" + else + echo "Successfully created file" > test.log + status="GEN" + rc=0 + fi +else + echo "$toolrun < ${runfile}" + if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + $toolrun < ${runfile} >> test.log 2>&1 + rc=$? + status="PASS" + else + echo "Successfully created file" > test.log + status="GEN" + rc=0 + fi +fi + +if [ $rc -eq 0 ] && grep -ci "Successfully created " test.log > /dev/null; then + echo "TSMCFGtools.sh: smoke test passed" + echo "$status" > TestStatus +else + echo "TSMCFGtools.sh: error running $1, error= $rc" + echo "TSMCFGtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/components/clm/test/tools/TSMncl_tools.sh b/components/clm/test/tools/TSMncl_tools.sh new file mode 100755 index 0000000000..7fe77912f8 --- /dev/null +++ b/components/clm/test/tools/TSMncl_tools.sh @@ -0,0 +1,74 @@ +#!/bin/sh +# + +if [ $# -ne 2 ]; then + echo "TSMncl_tools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSMncl_tools.$1.$2 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMncl_tools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMncl_tools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSMncl_tools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSMncl_tools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/ncl_scripts` +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSMncl_tools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "TSMncl_tools.sh: running $1 $2; output in ${rundir}/test.log" + +if [ ! -f "${cfgdir}/$2.ncl" ]; then + echo "TSMncl_tools.sh: error ${cfgdir}/$2.ncl input script not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + ncl ${cfgdir}/$1.ncl >> test.log 2>&1 + status="PASS" + rc=$? +else + echo "success" > test.log + status="GEN" + rc=0 +fi + +if [ $rc -eq 0 ] && grep -ci "success" test.log > /dev/null; then + echo "TSMncl_tools.sh: smoke test passed" + echo "$status" > TestStatus +else + echo "TSMncl_tools.sh: error running $1 $2, error= $rc" + echo "TSMncl_tools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/components/clm/test/tools/TSMscript_tools.sh b/components/clm/test/tools/TSMscript_tools.sh new file mode 100755 index 0000000000..ba509f915d --- /dev/null +++ b/components/clm/test/tools/TSMscript_tools.sh @@ -0,0 +1,113 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TSMscript_tools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSMscript_tools.$1.$2.$3.$4 + +if [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMscript_tools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMscript_tools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSMscript_tools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSMscript_tools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSMscript_tools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +# Copy any sample files so can use them +cp $cfgdir/sample_* $rundir + +optfile=${4%^*} +cfgfile=${4#*^} + +if [[ "$2" == "PTCLM" ]]; then + echo "TSMscript_tools.sh: calling TCBscripttools.sh to prepare executables for $2" + ${CLM_SCRIPTDIR}/TCBscripttools.sh $1 $2 $cfgfile + rc=$? + if [ $rc -ne 0 ]; then + echo "TSMscript_tools.sh: error from TCBscripttools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 + fi + # Copy map files so we can use them + subdir=1x1pt_US-UMB + mkdir $rundir/$subdir + cp $CSMDATA/lnd/clm2/PTCLMmydatafiles/$subdir/map_* $rundir/$subdir +elif [ "$optfile" != "$4" ]; then + echo "TSMscript_tools.sh: calling TCBtools.sh to prepare $1 $2 executable" + ${CLM_SCRIPTDIR}/TCBtools.sh $1 $2 $cfgfile + rc=$? + if [ $rc -ne 0 ]; then + echo "TSMscript_tools.sh: error from TCBtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 + fi + tcbtools=${CLM_TESTDIR}/TCBtools.$1.$2.$cfgfile +else + tcbtools="." +fi + +scopts=`cat ${CLM_SCRIPTDIR}/nl_files/$optfile | sed -e "s|CSMDATA|$CSMDATA|g" | sed -e "s|EXEDIR|$tcbtools|" | sed -e "s|CFGDIR|$cfgdir|g"` + +echo "TSMscript_tools.sh: running ${cfgdir}/$3 with $scopts; output in ${rundir}/test.log" + +if [ ! -f "${cfgdir}/$3" ]; then + echo "TSMscript_tools.sh: error ${cfgdir}/$3 input script not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 +fi + +if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + ${cfgdir}/$3 $scopts >> test.log 2>&1 + status="PASS" + rc=$? +else + echo "success" > test.log + status="GEN" + rc=0 +fi + +if [ $rc -eq 0 ] && grep -ci "success" test.log > /dev/null; then + echo "TSMscript_tools.sh: smoke test passed" + echo "$status" > TestStatus + # Copy files from subdirectories up... + # (use hard links rather than symbolic links because 'ln -s' does funny + # things when there are no matching files) + ln */*.nc */*/*.nc . +else + echo "TSMscript_tools.sh: error running $3, error= $rc" + echo "TSMscript_tools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/components/clm/test/tools/TSMtools.sh b/components/clm/test/tools/TSMtools.sh new file mode 100755 index 0000000000..657852d98c --- /dev/null +++ b/components/clm/test/tools/TSMtools.sh @@ -0,0 +1,117 @@ +#!/bin/sh +# + +if [ $# -ne 4 ]; then + echo "TSMtools.sh: incorrect number of input arguments" + exit 1 +fi + +test_name=TSMtools.$1.$2.$3.$4 + +if [ -z "$CLM_RERUN" ]; then + CLM_RERUN="no" +fi + +if [ "$CLM_RERUN" != "yes" ] && [ -f ${CLM_TESTDIR}/${test_name}/TestStatus ]; then + if grep -c PASS ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMtools.sh: smoke test has already passed; results are in " + echo " ${CLM_TESTDIR}/${test_name}" + exit 0 + elif grep -c GEN ${CLM_TESTDIR}/${test_name}/TestStatus > /dev/null; then + echo "TSMtools.sh: test already generated" + else + read fail_msg < ${CLM_TESTDIR}/${test_name}/TestStatus + prev_jobid=${fail_msg#*job} + + if [ $JOBID = $prev_jobid ]; then + echo "TSMtools.sh: smoke test has already failed for this job - will not reattempt; " + echo " results are in: ${CLM_TESTDIR}/${test_name}" + exit 2 + else + echo "TSMtools.sh: this smoke test failed under job ${prev_jobid} - moving those results to " + echo " ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid and trying again" + cp -rp ${CLM_TESTDIR}/${test_name} ${CLM_TESTDIR}/${test_name}_FAIL.job$prev_jobid + fi + fi +fi + +cfgdir=`ls -1d ${CLM_ROOT}/components/clm/tools/$1/$2` +rundir=${CLM_TESTDIR}/${test_name} +if [ -d ${rundir} ]; then + rm -r ${rundir} +fi +mkdir -p ${rundir} +if [ $? -ne 0 ]; then + echo "TSMtools.sh: error, unable to create work subdirectory" + exit 3 +fi +cd ${rundir} + +echo "Copy any text files over" +cp $cfgdir/*.txt $rundir + +echo "TSMtools.sh: calling TCBtools.sh to prepare $1 $2 executable" +${CLM_SCRIPTDIR}/TCBtools.sh $1 $2 $3 +rc=$? +if [ $rc -ne 0 ]; then + echo "TSMtools.sh: error from TCBtools.sh= $rc" + echo "FAIL.job${JOBID}" > TestStatus + exit 4 +fi + +echo "TSMtools.sh: running $1; output in ${rundir}/test.log" + +if [ "$3" = "tools__o" ] || [ "$3" = "tools__do" ]; then + toolrun="env OMP_NUM_THREADS=${CLM_THREADS} ${CLM_TESTDIR}/TCBtools.$1.$2.$3/$2" +else + toolrun="${CLM_TESTDIR}/TCBtools.$1.$2.$3/$2" +fi + +runfile="${cfgdir}/$2.$4" + +if [ ! -f "${runfile}" ]; then + runfile="${CLM_SCRIPTDIR}/nl_files/$2.$4" + if [ ! -f "${runfile}" ]; then + echo "TSMtools.sh: error ${runfile} input run file not found" + echo "FAIL.job${JOBID}" > TestStatus + exit 5 + fi +fi + +echo "Run file type = ${4#*.}" +if [ ${4#*.} == "runoptions" ]; then + echo "$toolrun "`cat ${runfile}` + cp $cfgdir/*.nc . + if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + $toolrun `cat ${runfile}` >> test.log 2>&1 + rc=$? + status="PASS" + else + echo "Successfully created file" > test.log + status="GEN" + rc=0 + fi +else + echo "$toolrun < ${runfile}" + if [ "$debug" != "YES" ] && [ "$compile_only" != "YES" ]; then + $toolrun < ${runfile} >> test.log 2>&1 + rc=$? + status="PASS" + else + echo "Successfully created file" > test.log + status="GEN" + rc=0 + fi +fi + +if [ $rc -eq 0 ] && grep -ci "Successfully created " test.log > /dev/null; then + echo "TSMtools.sh: smoke test passed" + echo "$status" > TestStatus +else + echo "TSMtools.sh: error running $1 $2, error= $rc" + echo "TSMtools.sh: see ${CLM_TESTDIR}/${test_name}/test.log for details" + echo "FAIL.job${JOBID}" > TestStatus + exit 6 +fi + +exit 0 diff --git a/components/clm/test/tools/config_files/CFGtools__ds b/components/clm/test/tools/config_files/CFGtools__ds new file mode 100644 index 0000000000..e69de29bb2 diff --git a/components/clm/test/tools/config_files/PTCLM__s b/components/clm/test/tools/config_files/PTCLM__s new file mode 100644 index 0000000000..8a2155ac49 --- /dev/null +++ b/components/clm/test/tools/config_files/PTCLM__s @@ -0,0 +1 @@ +./buildtools diff --git a/components/clm/test/tools/config_files/README b/components/clm/test/tools/config_files/README new file mode 100644 index 0000000000..bdfe5e0dd0 --- /dev/null +++ b/components/clm/test/tools/config_files/README @@ -0,0 +1,9 @@ +_do => debug on, omp only on +_ds => debug on, serial mode (neither mpi nor omp) + +_o => debug off, omp only on +_s => debug off, serial mode (neither mpi nor omp) + +tools__ds => options for tools, debug on, serial mode +tools__do => options for tools, debug on, omp only on +tools__o => options for tools, debug off, omp only on diff --git a/components/clm/test/tools/config_files/gen_domain b/components/clm/test/tools/config_files/gen_domain new file mode 100644 index 0000000000..e69de29bb2 diff --git a/components/clm/test/tools/config_files/tools__do b/components/clm/test/tools/config_files/tools__do new file mode 100644 index 0000000000..7f061ed65d --- /dev/null +++ b/components/clm/test/tools/config_files/tools__do @@ -0,0 +1 @@ +SMP=TRUE OPT=FALSE diff --git a/components/clm/test/tools/config_files/tools__ds b/components/clm/test/tools/config_files/tools__ds new file mode 100644 index 0000000000..cf2d414b28 --- /dev/null +++ b/components/clm/test/tools/config_files/tools__ds @@ -0,0 +1 @@ +OPT=FALSE diff --git a/components/clm/test/tools/config_files/tools__o b/components/clm/test/tools/config_files/tools__o new file mode 100644 index 0000000000..8821e0bc5a --- /dev/null +++ b/components/clm/test/tools/config_files/tools__o @@ -0,0 +1 @@ +SMP=TRUE OPT=TRUE diff --git a/components/clm/test/tools/config_files/tools__s b/components/clm/test/tools/config_files/tools__s new file mode 100644 index 0000000000..507973f8be --- /dev/null +++ b/components/clm/test/tools/config_files/tools__s @@ -0,0 +1 @@ +OPT=TRUE diff --git a/components/clm/test/tools/gen_test_table.sh b/components/clm/test/tools/gen_test_table.sh new file mode 100755 index 0000000000..0791ad0447 --- /dev/null +++ b/components/clm/test/tools/gen_test_table.sh @@ -0,0 +1,80 @@ +#!/bin/sh +# + +# this script, when executed in the directory containing the test-driver +# scripts (~/test/system) will loop through the default test +# lists for pre and post tag testing of clm and create an html file +# (test_table.html) with the specifics of each test detailed + +outfile="./test_table.html" + +echo '' > $outfile +echo '' >> $outfile +echo '' >> $outfile +echo '' >> $outfile +echo 'CLM Testing Information Page' >> $outfile +echo '' >> $outfile +echo '' >> $outfile + +######################################################################################### +for input_file in `ls tests_*` ; do + echo '' >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + echo "" >> $outfile + + test_list="" + while read input_line; do + test_list="${test_list}${input_line} " + done < ./${input_file} + + count=0 + ##loop through the tests of input file + for test_id in ${test_list}; do + echo "" >> $outfile + count=`expr $count + 1` + while [ ${#count} -lt 3 ]; do + count="0${count}" + done + echo "" >> $outfile + + master_line=`grep $test_id ./input_tests_master` + dir="" + for arg in ${master_line}; do + arg1=${arg%^*} + arg2=${arg#*^} + if [ -d ../../tools/$arg ]; then + dir=$arg + elif [ -f ./nl_files/$arg ]; then + echo "" >> $outfile + elif [ -f ./config_files/$arg ]; then + echo "" >> $outfile + elif [ -f ./nl_files/$arg1 ] && [ -f ./nl_files/$arg2 ]; then + echo "" >> $outfile + elif [ -f ./nl_files/$arg1 ] && [ -f ./config_files/$arg2 ]; then + echo "" >> $outfile + elif [ -f ../../tools/$dir/$dir.$arg ]; then + echo "" >> $outfile + else + echo "" >> $outfile + fi + done + echo '' >> $outfile + done + echo '
$input_file
test# testid test script arg1 arg2 arg3
$count $arg $arg $arg1^" \ + "$arg2$arg1^" \ + "$arg2$arg $arg
' >> $outfile + echo '
' >> $outfile
+    echo ' ' >> $outfile
+    echo '
' >> $outfile +done +echo '' >> $outfile +echo '' >> $outfile + +exit 0 diff --git a/components/clm/test/tools/get_cprnc_diffs.sh b/components/clm/test/tools/get_cprnc_diffs.sh new file mode 100755 index 0000000000..360220cb71 --- /dev/null +++ b/components/clm/test/tools/get_cprnc_diffs.sh @@ -0,0 +1,56 @@ +#!/bin/bash + +# This script extracts lines from the output of cprnc that tell us +# which variables differ between two files +# +# Usage: get_cprnc_diffs filename + +# ---------------------------------------------------------------------- +# SET PARAMETERS HERE +# ---------------------------------------------------------------------- + +# maximum number of differences to extract from the cprnc output +maxdiffs=200 + +# ---------------------------------------------------------------------- +# LOCAL FUNCTIONS DEFINED HERE +# ---------------------------------------------------------------------- + +# This function gets differences for one prefix (e.g., "RMS") +# Usage: get_diffs prefix +# (also uses $infile and $maxdiffs from the parent script) +function get_diffs { + prefix=$1 + outfile=${infile}.${prefix}.$$ + grep "$prefix" $infile > $outfile + numlines=`wc -l $outfile | awk '{print $1}'` + if [ $numlines -gt $maxdiffs ]; then + echo "WARNING: Too many instances of $prefix - only printing last $maxdiffs" + tail -$maxdiffs $outfile + else + cat $outfile + fi + rm $outfile +} + +# ---------------------------------------------------------------------- +# BEGIN MAIN SCRIPT +# ---------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Handle command-line arguments +# ---------------------------------------------------------------------- + +if [[ $# -ne 1 ]]; then + echo "Usage: get_cprnc_diffs filename" + exit 1 +fi + +infile=$1 + +# ---------------------------------------------------------------------- +# Do the processing +# ---------------------------------------------------------------------- + +get_diffs RMS +get_diffs FILLDIFF diff --git a/components/clm/test/tools/input_tests_master b/components/clm/test/tools/input_tests_master new file mode 100644 index 0000000000..77751d190d --- /dev/null +++ b/components/clm/test/tools/input_tests_master @@ -0,0 +1,90 @@ + + +smc#4 TSMscript_tools.sh shared mkprocdata_map mkprocdata_map_wrap mkprocdata_ne30_to_f19_I2000^tools__ds +blc#4 TBLscript_tools.sh shared mkprocdata_map mkprocdata_map_wrap mkprocdata_ne30_to_f19_I2000^tools__ds + +sme14 TSMCFGtools.sh shared gen_domain CFGtools__ds T31.runoptions +ble14 TBLCFGtools.sh shared gen_domain CFGtools__ds T31.runoptions +sme@4 TSMCFGtools.sh shared gen_domain CFGtools__ds ne30.runoptions +ble@4 TBLCFGtools.sh shared gen_domain CFGtools__ds ne30.runoptions + +sm754 TSMtools.sh clm4_0 mksurfdata_map tools__s namelist +bl754 TBLtools.sh clm4_0 mksurfdata_map tools__s namelist + +smg54 TSMtools.sh clm4_5 mksurfdata_map tools__s namelist +blg54 TBLtools.sh clm4_5 mksurfdata_map tools__s namelist + +sm854 TSMtools.sh clm4_0 interpinic tools__ds runoptions +bl854 TBLtools.sh clm4_0 interpinic tools__ds runoptions + +sm853 TSMtools.sh clm4_0 interpinic tools__do runoptions +bl853 TBLtools.sh clm4_0 interpinic tools__do runoptions +op853 TOPtools.sh clm4_0 interpinic tools__do runoptions + +sm857 TSMtools.sh clm4_0 interpinic tools__o runoptions +bl857 TBLtools.sh clm4_0 interpinic tools__o runoptions +op857 TOPtools.sh clm4_0 interpinic tools__o runoptions + +sm924 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds +bl924 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds + +sm953 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__o +bl953 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__o +sm954 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__ds +bl954 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__ds +sm957 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__do +bl957 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_10x15_irr_1850^tools__do + +sm974 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds +bl974 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds +sm978 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds +bl978 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds +sm9T4 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__ds +bl9T4 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000^tools__ds +sm9C4 TSMscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds +bl9C4 TBLscript_tools.sh clm4_0 mksurfdata_map mksurfdata.pl mksrfdt_1x1_vancouverCAN_2000^tools__ds + +smi24 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds +bli24 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_T31_crpglc_2000^tools__ds + +smi53 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o +bli53 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__o +smi54 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds +bli54 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__ds +smi57 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do +bli57 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_1850^tools__do +smi58 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_crp_1850-2000^tools__do +bli58 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_10x15_crp_1850-2000^tools__do + +smi74 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds +bli74 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850-2000^tools__ds +smi78 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds +bli78 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_brazil_1850^tools__ds +smiT4 TSMscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools__ds +bliT4 TBLscript_tools.sh clm4_5 mksurfdata_map mksurfdata.pl mksrfdt_1x1_numaIA_mp24_2000^tools__ds + +sm9#2 TSMscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_ne30np4_clm4_0 +bl9#2 TBLscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_ne30np4_clm4_0 +smi#2 TSMscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_ne30np4 +bli#2 TBLscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_ne30np4 +smi59 TSMscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_if10 +bli59 TBLscript_tools.sh shared mkmapdata mkmapdata.sh mkmapdata_if10 + +sm684 TSMscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_clm4_0^buildtools +bl684 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_clm4_0^buildtools + +smf84 TSMscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_clm4_5^buildtools +blf84 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_clm4_5^buildtools +smfc4 TSMscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Cycle_clm4_5^buildtools +blfc4 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Cycle_clm4_5^buildtools +smfg4 TSMscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Global_clm4_5^buildtools +blfg4 TBLscript_tools.sh shared PTCLM PTCLMmkdata PTCLM_USUMB_Global_clm4_5^buildtools + +smiS4 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional +bliS4 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional +smiS8 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_ndep +bliS8 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_ndep +smiS9 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_T62 +bliS9 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_T62 +smiS0 TSMscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_0.5popd +bliS0 TBLscript_tools.sh shared ncl_scripts getregional_datasets.pl getregional_0.5popd diff --git a/components/clm/test/tools/nl_files/PTCLM_USUMB_Cycle_clm4_5 b/components/clm/test/tools/nl_files/PTCLM_USUMB_Cycle_clm4_5 new file mode 100644 index 0000000000..1b7faaf846 --- /dev/null +++ b/components/clm/test/tools/nl_files/PTCLM_USUMB_Cycle_clm4_5 @@ -0,0 +1 @@ +-s US-UMB -d CSMDATA --mydatadir . --phys=clm4_5 --map_gdate 140121 --cycle_forcing diff --git a/components/clm/test/tools/nl_files/PTCLM_USUMB_Global_clm4_5 b/components/clm/test/tools/nl_files/PTCLM_USUMB_Global_clm4_5 new file mode 100644 index 0000000000..0b0b8e9b9a --- /dev/null +++ b/components/clm/test/tools/nl_files/PTCLM_USUMB_Global_clm4_5 @@ -0,0 +1 @@ +-s US-UMB -d CSMDATA --mydatadir . --phys=clm4_5 --map_gdate 140121 --donot_use_tower_yrs --clmnmlusecase 20thC_transient --pftgrid --soilgrid diff --git a/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_0 b/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_0 new file mode 100644 index 0000000000..29b6cddf50 --- /dev/null +++ b/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_0 @@ -0,0 +1 @@ +-s US-UMB -d CSMDATA --mydatadir . --phys=clm4_0 --map_gdate 140121 diff --git a/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_5 b/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_5 new file mode 100644 index 0000000000..85915f4b73 --- /dev/null +++ b/components/clm/test/tools/nl_files/PTCLM_USUMB_clm4_5 @@ -0,0 +1 @@ +-s US-UMB -d CSMDATA --mydatadir . --phys=clm4_5 --map_gdate 140121 diff --git a/components/clm/test/tools/nl_files/clm4_0_mksrfdt_10x15_irr_1850 b/components/clm/test/tools/nl_files/clm4_0_mksrfdt_10x15_irr_1850 new file mode 100644 index 0000000000..555ded5077 --- /dev/null +++ b/components/clm/test/tools/nl_files/clm4_0_mksrfdt_10x15_irr_1850 @@ -0,0 +1 @@ +-l CSMDATA -r 10x15 -y 1850-2000 -irrig .true. -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 b/components/clm/test/tools/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 new file mode 100644 index 0000000000..ad89666bed --- /dev/null +++ b/components/clm/test/tools/nl_files/clm4_0_mksrfdt_1x1_numaIA_mp20irrcr_2000 @@ -0,0 +1 @@ +-l CSMDATA -r 1x1_numaIA -y 2000 -irrig .true. -crop -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/gen_domain.T31.runoptions b/components/clm/test/tools/nl_files/gen_domain.T31.runoptions new file mode 100644 index 0000000000..0fbe17a9f4 --- /dev/null +++ b/components/clm/test/tools/nl_files/gen_domain.T31.runoptions @@ -0,0 +1 @@ +-m /glade/p/cesm/cseg/inputdata/cpl/cpl6/map_gx3v7_to_T31_aave_da_090903.nc -o domain.ocn.gx3v7_test.nc -l domain.lnd.10x15_gx3v7.test.nc diff --git a/components/clm/test/tools/nl_files/gen_domain.ne30.runoptions b/components/clm/test/tools/nl_files/gen_domain.ne30.runoptions new file mode 100644 index 0000000000..8dbc853a24 --- /dev/null +++ b/components/clm/test/tools/nl_files/gen_domain.ne30.runoptions @@ -0,0 +1 @@ +-m /glade/p/cesm/cseg/inputdata/cpl/cpl6/map_gx1v6_to_ne30np4_aave_da_091227.nc -o domain.ocn.gx1v6_test.nc -l domain.lnd.ne30np4_gx1v6.test.nc diff --git a/components/clm/test/tools/nl_files/getregional b/components/clm/test/tools/nl_files/getregional new file mode 100644 index 0000000000..5e5d348e39 --- /dev/null +++ b/components/clm/test/tools/nl_files/getregional @@ -0,0 +1 @@ +-SW 52,190 -NE 73,220 -i sample_inlist -o sample_outlist diff --git a/components/clm/test/tools/nl_files/getregional_05popd b/components/clm/test/tools/nl_files/getregional_05popd new file mode 100644 index 0000000000..79747ad9cd --- /dev/null +++ b/components/clm/test/tools/nl_files/getregional_05popd @@ -0,0 +1 @@ +-SW 52,190 -NE 73,220 -i sample_inlist_0.5popd -o sample_outlist_0.5popd diff --git a/components/clm/test/tools/nl_files/getregional_T62 b/components/clm/test/tools/nl_files/getregional_T62 new file mode 100644 index 0000000000..8288847cf5 --- /dev/null +++ b/components/clm/test/tools/nl_files/getregional_T62 @@ -0,0 +1 @@ +-SW 52,190 -NE 73,220 -i sample_inlist_T62 -o sample_outlist_T62 diff --git a/components/clm/test/tools/nl_files/getregional_ndep b/components/clm/test/tools/nl_files/getregional_ndep new file mode 100644 index 0000000000..125285f690 --- /dev/null +++ b/components/clm/test/tools/nl_files/getregional_ndep @@ -0,0 +1 @@ +-SW 52,190 -NE 73,220 -i sample_inlist_ndep -o sample_outlist_ndep diff --git a/components/clm/test/tools/nl_files/mkmapdata_if10 b/components/clm/test/tools/nl_files/mkmapdata_if10 new file mode 100644 index 0000000000..1c30796e2e --- /dev/null +++ b/components/clm/test/tools/nl_files/mkmapdata_if10 @@ -0,0 +1 @@ +-t regional -r 10x15 diff --git a/components/clm/test/tools/nl_files/mkmapdata_ne30np4 b/components/clm/test/tools/nl_files/mkmapdata_ne30np4 new file mode 100644 index 0000000000..11066c7b41 --- /dev/null +++ b/components/clm/test/tools/nl_files/mkmapdata_ne30np4 @@ -0,0 +1 @@ +-r ne30np4 diff --git a/components/clm/test/tools/nl_files/mkmapdata_ne30np4_clm4_0 b/components/clm/test/tools/nl_files/mkmapdata_ne30np4_clm4_0 new file mode 100644 index 0000000000..118c66d998 --- /dev/null +++ b/components/clm/test/tools/nl_files/mkmapdata_ne30np4_clm4_0 @@ -0,0 +1 @@ +-r ne30np4 -p clm4_0 diff --git a/components/clm/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 b/components/clm/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 new file mode 100644 index 0000000000..d3ec4285bd --- /dev/null +++ b/components/clm/test/tools/nl_files/mkprocdata_ne30_to_f19_I2000 @@ -0,0 +1 @@ +-i CFGDIR/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc -o ne30output_onf19grid.nc -m CFGDIR/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc -t CFGDIR/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc -e EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_10x15_1850 b/components/clm/test/tools/nl_files/mksrfdt_10x15_1850 new file mode 100644 index 0000000000..826da9dd57 --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_10x15_1850 @@ -0,0 +1 @@ +-l CSMDATA -r 10x15 -y 1850 -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_10x15_crp_1850-2000 b/components/clm/test/tools/nl_files/mksrfdt_10x15_crp_1850-2000 new file mode 100644 index 0000000000..0abf5a00d4 --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_10x15_crp_1850-2000 @@ -0,0 +1 @@ +-l CSMDATA -r 10x15 -y 1850-2000 -crop -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850 b/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850 new file mode 100644 index 0000000000..2330bd082e --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850 @@ -0,0 +1 @@ +-l CSMDATA -r 1x1_brazil -y 1850-2000 -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850-2000 b/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850-2000 new file mode 100644 index 0000000000..2330bd082e --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_1x1_brazil_1850-2000 @@ -0,0 +1 @@ +-l CSMDATA -r 1x1_brazil -y 1850-2000 -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_1x1_numaIA_mp24_2000 b/components/clm/test/tools/nl_files/mksrfdt_1x1_numaIA_mp24_2000 new file mode 100644 index 0000000000..b35b416503 --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_1x1_numaIA_mp24_2000 @@ -0,0 +1 @@ +-l CSMDATA -r 1x1_numaIA -y 2000 -crop -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_1x1_vancouverCAN_2000 b/components/clm/test/tools/nl_files/mksrfdt_1x1_vancouverCAN_2000 new file mode 100644 index 0000000000..49e8bed89e --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_1x1_vancouverCAN_2000 @@ -0,0 +1 @@ +-l CSMDATA -r 1x1_vancouverCAN -y 2000 -exedir EXEDIR diff --git a/components/clm/test/tools/nl_files/mksrfdt_T31_crpglc_2000 b/components/clm/test/tools/nl_files/mksrfdt_T31_crpglc_2000 new file mode 100644 index 0000000000..b94e598941 --- /dev/null +++ b/components/clm/test/tools/nl_files/mksrfdt_T31_crpglc_2000 @@ -0,0 +1 @@ +-l CSMDATA -r 48x96 -y 2000 -crop -glc_nec 10 -exedir EXEDIR diff --git a/components/clm/test/tools/show_var_diffs.sh b/components/clm/test/tools/show_var_diffs.sh new file mode 100755 index 0000000000..f462d4ad0c --- /dev/null +++ b/components/clm/test/tools/show_var_diffs.sh @@ -0,0 +1,79 @@ +#!/bin/bash + +# This script processes a log file that was output by test_driver, +# giving lists of all variables with differences in values (those with +# RMS errors), and all variables with differences in fill patterns. +# +# This assumes that the log file contains output like: +# RMS foo +# RMS bar +# FILLDIFF foo +# FILLDIFF bar +# Some characteristics of these output lines are: +# - they begin with a leading space, followed by RMS or FILLDIFF +# - the variable name is in the second column of the line +# +# Note that (as of 4-5-12) the log file only contains output from the +# last file that didn't match, so this could potentially miss +# something -- especially if there are both h0 and h1 files in the +# comparison. + +# Usage: show_var_diffs logfile + +# ---------------------------------------------------------------------- +# LOCAL FUNCTIONS DEFINED HERE +# ---------------------------------------------------------------------- + +# This function shows the differences for one prefix (e.g., "RMS") +# Usage: show_diffs prefix +# (also uses $logfile from the parent script) +# +# Matches lines that start with the regular expression "^ ${prefix}" +# (note that one leading space is expected before the prefix) +# +# Assumes that the variable name is in the second column of matching lines +function show_diffs { + prefix=$1 + + # first determine if there were warnings relating to this prefix + grep "WARNING: Too many instances of ${prefix}" $logfile > /dev/null + if [ $? -eq 0 ]; then # found a warning + echo "WARNING: Some output was truncated; this may not be a complete list" + fi + + # now make a list of all variables matching this prefix + grep "^ ${prefix}" $logfile > $logfile.tmp.$$ + if [ $? -eq 0 ]; then + awk '{print $2}' $logfile.tmp.$$ | sort | uniq + else + echo "(no differences)" + fi + + rm $logfile.tmp.$$ +} + +# ---------------------------------------------------------------------- +# BEGIN MAIN SCRIPT +# ---------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Handle command-line arguments +# ---------------------------------------------------------------------- + +if [[ $# -ne 1 ]]; then + echo "Usage: show_var_diffs logfile" + exit 1 +fi + +logfile=$1 + +# ---------------------------------------------------------------------- +# Do the processing +# ---------------------------------------------------------------------- + +echo "Variables with differences in values:" +show_diffs "RMS" + +echo "" +echo "Variables with differences in fill patterns:" +show_diffs "FILLDIFF" \ No newline at end of file diff --git a/components/clm/test/tools/test_driver.sh b/components/clm/test/tools/test_driver.sh new file mode 100755 index 0000000000..cfe4e60c69 --- /dev/null +++ b/components/clm/test/tools/test_driver.sh @@ -0,0 +1,551 @@ +#!/bin/sh +# +# test_driver.sh: driver script for the offline testing of CLM of tools +# +# interactive usage on all machines: +# +# env CLM_SOFF=FALSE ./test_driver.sh -i +# +# valid arguments: +# -i interactive usage +# -d debug usage -- display tests that will run -- but do NOT actually execute them +# -f force batch submission (avoids user prompt) +# -h displays this help message +# +# +# **pass environment variables by preceding above commands +# with 'env var1=setting var2=setting ' +# **more details in the CLM testing user's guide, accessible +# from the CLM developers web page + + +#will attach timestamp onto end of script name to prevent overwriting +cur_time=`date '+%H:%M:%S'` + +hostname=`hostname` +case $hostname in + + ##yellowstone + ys* | caldera* | geyser* | pronghorn*) + submit_script="test_driver_yellowstone${cur_time}.sh" + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv +cat > ./${submit_script} << EOF +#!/bin/sh +# + +interactive="YES" +input_file="tests_pretag_yellowstone_nompi" +c_threads=16 + +source /glade/apps/opt/lmod/lmod/init/sh + +module purge +module load ncarenv/1.0 +module load ncarbinlibs/1.0 + +module load intel/12.1.5 +module load ncarcompilers/1.0 +module load netcdf/4.2 +module load pnetcdf/1.3.0 + +module load nco +module load ncl +module load python + + +##omp threads +if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line + export CLM_THREADS=\$c_threads +fi + +export CESM_MACH="yellowstone" +export CESM_COMP="intel" + +export NETCDF_DIR=\$NETCDF +export INC_NETCDF=\$NETCDF/include +export LIB_NETCDF=\$NETCDF/lib +export MAKE_CMD="gmake -j " +export CFG_STRING="" +export TOOLS_MAKE_STRING="USER_FC=ifort USER_LINKER=ifort " +export MACH_WORKSPACE="/glade/scratch" +CPRNC_EXE="$CESMDATAROOT/tools/cprnc/cprnc" +dataroot="$CESMDATAROOT" +export TOOLSLIBS="" +export TOOLS_CONF_STRING="" + + +echo_arg="" + +EOF +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + + ## hobart + hobart* ) + submit_script="test_driver_hobart_${cur_time}.sh" + export PATH=/cluster/torque/bin:${PATH} + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv +cat > ./${submit_script} << EOF +#!/bin/sh +# + +# Name of the queue (CHANGE THIS if needed) +#PBS -q long +# Number of nodes (CHANGE THIS if needed) +#PBS -l nodes=1:ppn=24 +# output file base name +#PBS -N test_dr +# Put standard error and standard out in same file +#PBS -j oe +# Export all Environment variables +#PBS -V +# End of options + +if [ -n "\$PBS_JOBID" ]; then #batch job + export JOBID=\`echo \${PBS_JOBID} | cut -f1 -d'.'\` + initdir=\${PBS_O_WORKDIR} +fi + +if [ "\$PBS_ENVIRONMENT" = "PBS_BATCH" ]; then + interactive="NO" + input_file="tests_posttag_hobart" +else + interactive="YES" + input_file="tests_posttag_hobart_nompi" +fi + +##omp threads +if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line + export CLM_THREADS=2 +fi +export CLM_RESTART_THREADS=1 + +##mpi tasks +export CLM_TASKS=24 +export CLM_RESTART_TASKS=20 + +export P4_GLOBMEMSIZE=500000000 + + +export CESM_MACH="hobart" + +limit stacksize unlimited +limit coredumpsize unlimited + +module purge +module load compiler/intel/15.0.2.164 + +export CESM_COMP="intel" +export TOOLS_MAKE_STRING="USER_FC=ifort USER_CC=icc " +export TOOLS_CONF_STRING="" +export CFG_STRING="" + +export NETCDF_DIR=\$NETCDF_PATH +export INC_NETCDF=\${NETCDF_PATH}/include +export LIB_NETCDF=\${NETCDF_PATH}/lib +export MAKE_CMD="gmake -j 5" ##using hyper-threading on hobart +export MACH_WORKSPACE="/scratch/cluster" +export CPRNC_EXE=/fs/cgd/csm/tools/cprnc_hobart/cprnc +export DATM_QIAN_DATA_DIR="/project/tss/atm_forcing.datm7.Qian.T62.c080727" +dataroot="/fs/cgd/csm" +export TOOLSSLIBS="" +echo_arg="-e" + +EOF +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + + ##yong + yong* | vpn* ) + submit_script="test_driver_yong_${cur_time}.sh" + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv +cat > ./${submit_script} << EOF +#!/bin/sh +# + +interactive="YES" + +##omp threads +if [ -z "\$CLM_THREADS" ]; then #threads NOT set on command line + export CLM_THREADS=2 +fi +export CLM_RESTART_THREADS=1 + +##mpi tasks +export CLM_TASKS=2 +export CLM_RESTART_TASKS=1 + +export CESM_MACH="generic_Darwin" +if [ "\$CLM_FC" = "PGI" ]; then + export CESM_COMP="pgi" + export NETCDF_PATH=/usr/local/netcdf-3.6.3-pgi-10.9 + export CFG_STRING="" + export TOOLS_MAKE_STRING="" +else + export CESM_COMP="intel" + export NETCDF_PATH=/usr/local/netcdf-3.6.3-intel-11.1 + export MPICH_PATH=/usr/local/mpich2-1.3.1-intel-11.1 + export PATH="\$MPICH_PATH/bin:$PATH" + export CFG_STRING="" + export TOOLS_MAKE_STRING="USER_FC=ifort USER_LINKER=ifort USER_CC=icc " + export DYLD_LIBRARY_PATH=/opt/intel/Compiler/11.1/067/lib +fi +export NETCDF_DIR=\$NETCDF_PATH +export INC_NETCDF=\$NETCDF_PATH/include +export LIB_NETCDF=\$NETCDF_PATH/lib +export MAKE_CMD="make -j 4" +export MACH_WORKSPACE="/glade/scratch" +export CPRNC_EXE=$HOME/bin/newcprnc +export DATM_QIAN_DATA_DIR="/fis/cgd/cseg/csm/inputdata/atm/datm7/atm_forcing.datm7.Qian.T62.c080727" +export ESMFBIN_PATH=\ +"/usr/local/esmf_5_2_0/DEFAULTINSTALLDIR/bin/binO/Darwin.intel.64.mpiuni.default" +dataroot="/fis/cgd/cseg/csm" +echo_arg="" +input_file="tests_posttag_yong" +export TOOLSLIBS="" +export TOOLS_CONF_STRING="-scratchroot \$MACH_WORKSPACE/$USER -max_tasks_per_node 2 -din_loc_root \$dataroot/inputdata" + +EOF +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + ;; + * ) + echo "Only setup to work on: yellowstone, hobart, and yong" + exit + + +esac + +##vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv writing to batch script vvvvvvvvvvvvvvvvvvv +cat >> ./${submit_script} << EOF + +if [ -n "\${CLM_JOBID}" ]; then + export JOBID=\${CLM_JOBID} +fi +##check if interactive job + +if [ "\$interactive" = "YES" ]; then + + if [ -z "\${JOBID}" ]; then + export JOBID=\$\$ + fi + echo "test_driver.sh: interactive run - setting JOBID to \$JOBID" + if [ \$0 = "test_driver.sh" ]; then + initdir="." + else + initdir=\${0%/*} + fi +else + echo "ERROR: you *always* need to use the interactive option (-i)" + echo " currently doesn't work without it" + exit 3 +fi + +##establish script dir and clm_root +if [ -f \${initdir}/test_driver.sh ]; then + export CLM_SCRIPTDIR=\`cd \${initdir}; pwd \` + export CLM_ROOT=\`cd \${CLM_SCRIPTDIR}/../../../..; pwd \` +else + if [ -n "\${CLM_ROOT}" ] && [ -f \${CLM_ROOT}/components/clm/test/tools/test_driver.sh ]; then + export CLM_SCRIPTDIR=\`cd \${CLM_ROOT}/components/clm/test/tools; pwd \` + else + echo "ERROR: unable to determine script directory " + echo " if initiating batch job from directory other than the one containing test_driver.sh, " + echo " you must set the environment variable CLM_ROOT to the full path of directory containing " + echo " and . " + exit 3 + fi +fi + +##output files +clm_log=\${initdir}/td.\${JOBID}.log +if [ -f \$clm_log ]; then + rm \$clm_log +fi +clm_status=\${initdir}/td.\${JOBID}.status +if [ -f \$clm_status ]; then + rm \$clm_status +fi + +##setup test work directory +if [ -z "\$CLM_TESTDIR" ]; then + export CLM_TESTDIR=\${MACH_WORKSPACE}/\$LOGNAME/clmTests/test-driver.\${JOBID} + if [ -d \$CLM_TESTDIR ] && [ \$CLM_RETAIN_FILES != "TRUE" ]; then + rm -r \$CLM_TESTDIR + fi +fi +if [ ! -d \$CLM_TESTDIR ]; then + mkdir -p \$CLM_TESTDIR + if [ \$? -ne 0 ]; then + echo "ERROR: unable to create work directory \$CLM_TESTDIR" + exit 4 + fi +fi + +## MCT and PIO build directorys +export MCT_LIBDIR=\$CLM_TESTDIR/mct +export PIO_LIBDIR=\$CLM_TESTDIR/pio + +##set our own environment vars +export CSMDATA=\${dataroot}/inputdata +export DIN_LOC_ROOT=\${CSMDATA} +export MPI_TYPE_MAX=100000 + +##process other env vars possibly coming in +if [ -z "\$CLM_RETAIN_FILES" ]; then + export CLM_RETAIN_FILES=FALSE +fi +if [ -n "\${CLM_INPUT_TESTS}" ]; then + input_file=\$CLM_INPUT_TESTS +else + input_file=\${CLM_SCRIPTDIR}/\${input_file} +fi +if [ ! -f \${input_file} ]; then + echo "ERROR: unable to locate input file \${input_file}" + exit 5 +fi + +if [ \$interactive = "YES" ]; then + echo "reading tests from \${input_file}" +else + echo "reading tests from \${input_file}" >> \${clm_log} +fi + +num_tests=\`wc -w < \${input_file}\` +echo "STATUS OF CLM TESTING UNDER JOB \${JOBID}; scheduled to run \$num_tests tests from:" >> \${clm_status} +echo "\$input_file" >> \${clm_status} +echo "" >> \${clm_status} +echo " on machine: $hostname" >> \${clm_status} +if [ -n "${BL_ROOT}" ]; then + echo "tests of baseline will use source code from:" >> \${clm_status} + echo "\$BL_ROOT" >> \${clm_status} +fi +if [ \$interactive = "NO" ]; then + echo "see \${clm_log} for more detailed output" >> \${clm_status} +fi +echo "" >> \${clm_status} + +test_list="" +while read input_line; do + test_list="\${test_list}\${input_line} " +done < \${input_file} + + +##initialize flags, counter +skipped_tests="NO" +pending_tests="NO" +count=0 + +##loop through the tests of input file +for test_id in \${test_list}; do + count=\`expr \$count + 1\` + while [ \${#count} -lt 3 ]; do + count="0\${count}" + done + + master_line=\`grep \$test_id \${CLM_SCRIPTDIR}/input_tests_master\` + status_out="" + for arg in \${master_line}; do + status_out="\${status_out}\${arg} " + done + + if [ -z "\$status_out" ]; then + echo "No test matches \$test_id in \${CLM_SCRIPTDIR}/input_tests_master" + exit 3 + fi + + test_cmd=\${status_out#* } + + status_out="\${count} \${status_out}" + + if [ \$interactive = "YES" ]; then + echo "" + echo "***********************************************************************************" + echo "\${status_out}" + echo "***********************************************************************************" + else + echo "" >> \${clm_log} + echo "***********************************************************************************"\ + >> \${clm_log} + echo "\$status_out" >> \${clm_log} + echo "***********************************************************************************"\ + >> \${clm_log} + fi + + if [ \${#status_out} -gt 94 ]; then + status_out=\`echo "\${status_out}" | cut -c1-100\` + fi + while [ \${#status_out} -lt 97 ]; do + status_out="\${status_out}." + done + + echo \$echo_arg "\$status_out\c" >> \${clm_status} + + if [ \$interactive = "YES" ]; then + \${CLM_SCRIPTDIR}/\${test_cmd} + rc=\$? + else + \${CLM_SCRIPTDIR}/\${test_cmd} >> \${clm_log} 2>&1 + rc=\$? + fi + if [ \$rc -eq 0 ]; then + echo "PASS" >> \${clm_status} + elif [ \$rc -eq 255 ]; then + echo "SKIPPED*" >> \${clm_status} + skipped_tests="YES" + elif [ \$rc -eq 254 ]; then + echo "PENDING**" >> \${clm_status} + pending_tests="YES" + else + echo " rc=\$rc FAIL" >> \${clm_status} + if [ \$interactive = "YES" ]; then + if [ "\$CLM_SOFF" != "FALSE" ]; then + echo "stopping on first failure" + echo "stopping on first failure" >> \${clm_status} + exit 6 + fi + else + if [ "\$CLM_SOFF" = "TRUE" ]; then + echo "stopping on first failure" >> \${clm_status} + echo "stopping on first failure" >> \${clm_log} + exit 6 + fi + fi + fi +done + +echo "end of input" >> \${clm_status} +if [ \$interactive = "YES" ]; then + echo "end of input" +else + echo "end of input" >> \${clm_log} +fi + +if [ \$skipped_tests = "YES" ]; then + echo "* please verify that any skipped tests are not required of your clm commit" >> \${clm_status} +fi +if [ \$pending_tests = "YES" ]; then + echo "** tests that are pending must be checked manually for a successful completion" >> \${clm_status} + if [ \$interactive = "NO" ]; then + echo " see the test's output in \${clm_log} " >> \${clm_status} + echo " for the location of test results" >> \${clm_status} + fi +fi + +if [ "\$interactive" = "YES" ]; then + passInt="test_driver.sh-i" +else + passInt="test_driver.sh" +fi + +../../bld/unit_testers/xFail/wrapClmTests.pl -statusFile "\${clm_status}" -numberOfTests "\${num_tests}" -callingScript "\${passInt}" + +exit 0 + +EOF +##^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ writing to batch script ^^^^^^^^^^^^^^^^^^^ + + +chmod a+x $submit_script +if [ ! -z "$CLM_RETAIN_FILES" ]; then + export CLM_RETAIN_FILES="FALSE" +fi +arg1=${1##*-} +case $arg1 in + [iI]* ) + debug="NO" + interactive="YES" + compile_only="NO" + export debug + export interactive + export compile_only + ./${submit_script} + exit 0 + ;; + + [cC]* ) + debug="NO" + interactive="YES" + compile_only="YES" + export debug + export CLM_RETAIN_FILES="TRUE" + export interactive + export compile_only + export CLM_RETAIN_FILES="TRUE" + ./${submit_script} + exit 0 + ;; + + [dD]* ) + debug="YES" + interactive="YES" + compile_only="NO" + export debug + export interactive + export compile_only + ./${submit_script} + exit 0 + ;; + + [fF]* ) + debug="NO" + interactive="NO" + compile_only="NO" + export debug + export interactive + export compile_only + ;; + + "" ) + echo "" + echo "**********************" + echo "$submit_script has been created and will be submitted to the batch queue..." + echo "(ret) to continue, (a) to abort" + read ans + case $ans in + [aA]* ) + echo "aborting...type ./test_driver.sh -h for help message" + exit 0 + ;; + esac + debug="NO" + interactive="NO" + compile_only="NO" + export debug + export interactive + export compile_only + ;; + + * ) + echo "" + echo "**********************" + echo "usage on yellowstone, hobart, and yongi: " + echo "./test_driver.sh -i" + echo "" + echo "valid arguments: " + echo "-i interactive usage" + echo "-c compile-only usage (run configure and compile do not run clm)" + echo "-d debug-only usage (run configure and build-namelist do NOT compile or run clm)" + echo "-f force batch submission (avoids user prompt)" + echo "-h displays this help message" + echo "" + echo "**pass environment variables by preceding above commands " + echo " with 'env var1=setting var2=setting '" + echo "" + echo "**********************" + exit 0 + ;; +esac + +echo "submitting..." +case $hostname in + #default + * ) + echo "no submission capability on this machine use the interactive option: -i" + exit 0 + ;; + +esac +exit 0 diff --git a/components/clm/test/tools/tests_posttag_hobart_nompi b/components/clm/test/tools/tests_posttag_hobart_nompi new file mode 100644 index 0000000000..cf912af9da --- /dev/null +++ b/components/clm/test/tools/tests_posttag_hobart_nompi @@ -0,0 +1,8 @@ +smc#4 blc#4 +smi54 bli54 +smi57 bli57 +smi74 bli74 +smiT4 bliT4 +sm684 bl684 +smf84 blf84 +smfc4 blfc4 diff --git a/components/clm/test/tools/tests_posttag_nompi_regression b/components/clm/test/tools/tests_posttag_nompi_regression new file mode 100644 index 0000000000..e54be3967d --- /dev/null +++ b/components/clm/test/tools/tests_posttag_nompi_regression @@ -0,0 +1,18 @@ +smc#4 blc#4 +sm754 bl754 +smg54 blg54 +sm854 bl854 +sm853 bl853 +smi24 bli24 +smi54 bli54 +smi74 bli74 +smi78 bli78 +smiS4 bliS4 +smiS8 bliS8 +smiS9 bliS9 +smiS0 bliS0 +smiS0 bliS0 +sm684 bl684 +smf84 blf84 +smfc4 blfc4 +smfg4 blfg4 diff --git a/components/clm/test/tools/tests_posttag_yong b/components/clm/test/tools/tests_posttag_yong new file mode 100644 index 0000000000..8aeaf3013c --- /dev/null +++ b/components/clm/test/tools/tests_posttag_yong @@ -0,0 +1,6 @@ +sm853 bl853 +sm854 +smi78 +smiT4 +sm684 bl684 +smf84 blf84 diff --git a/components/clm/test/tools/tests_pretag_yellowstone_nompi b/components/clm/test/tools/tests_pretag_yellowstone_nompi new file mode 100644 index 0000000000..829e65bfd9 --- /dev/null +++ b/components/clm/test/tools/tests_pretag_yellowstone_nompi @@ -0,0 +1,19 @@ +smc#4 blc#4 +sme14 ble14 +sme@4 ble@4 +sm754 bl754 +smg54 blg54 +sm854 bl854 +sm974 bl974 +smi24 bli24 +smi53 bli53 +smi54 bli54 +smi57 bli57 +smi58 bli58 +smiS4 bliS4 +smi74 bli74 +smiT4 bliT4 +sm684 bl684 +smf84 blf84 +smfc4 blfc4 +smfg4 blfg4 diff --git a/components/clm/tools/README b/components/clm/tools/README new file mode 100644 index 0000000000..26d36964c0 --- /dev/null +++ b/components/clm/tools/README @@ -0,0 +1,306 @@ +components/clm/tools/README May/07/2013 + +CLM tools for analysis of CLM history files -- or for creation or +modification of CLM input files. + +I. General directory structure: + + clm4_0 + mksurfdata_map --- Create surface datasets. + interpinic ------- Interpolate initial datasets to a different resolution. + (has optimized and OMP options) + clm4_5 + mksurfdata_map --- Create surface datasets. + (NOTE: interpinic now longer included as now an online capability in CLM) + + shared + mkmapgrids ------- Create regular lat/lon SCRIP grid files needed by mkmapdata + mkmapdata -------- Create SCRIP mapping data from SCRIP grid files (uses ESMF) + mkprocdata_map --- Convert output unstructured grids into a 2D format that + can be plotted easily + ncl_scripts ------ NCL post or pre processing scripts. + + cime-tools (../../../cime/tools/) (CIMEROOT is ../../../cime) + $CIMEROOT/mapping/gen_domain_files + gen_domain ------- Create data model domain datasets from SCRIP mapping datasets. + + Note that there are different versions of mksurfdata_map CLM4.0 vs. CLM4.5. + Other tools are shared between the two model versions. + + However, note that mkmapdata makes mapping files for CLM4.5 by default; to + make mapping files for CLM4.0, run the tool with the option: + -p clm4_0 + +II. Notes on building/running for each of the above tools: + + Each tool that has FORTRAN source code has the following files: + + README ------- Specific help for using the specific tool and help on specific + files in that directory. + src/Filepath ----- List of directories needed to build the tool + (some files in ../src directories are required). + src/Makefile ----- GNU Makefile to build the tool + (these are identical between tools. + src/Macros.custom Customization of make macros for the particular tool in question + src/Srcfiles ----- List of source files that are needed. + src/Mkdepends ---- Dependency generator program + + mkmapdata and ncl_scripts only contain scripts so don't have the above build files. + + Most tools have copies of files from other directories -- see the README.filecopies + file for more information on this. + + Tools may also have files with the directory name followed by: namelist, runoptions, + regional, or singlept these are sample namelists: + + .namelist ------ Namelist to create a global file. + .regional ------ Namelist to create a regional file. + .singlept ------ Namelist to create a single-point file. + .runoptions ---- Command line options to use the given tool. + + These files are also used by the test scripts to test the tools (see the + README.testing) file. + + NOTE: Be sure to change the path of the datasets references by these namelists to + point to where you have exported your CESM inputdata datasets. + + To build: + + cd + setenv INC_NETCDF + setenv LIB_NETCDF + gmake + + The process will create a file called "Depends" which has the dependencies + for the build of each file on other files. + + By default some codes may be compiled non-optimized + so that you can use the debugger, and with bounds-checking, and float trapping on. + To speed up do the following... + + gmake OPT=TRUE (by default already on for interpinic and mksurfdata_map) + + Also some of the tools allow for OpenMP shared memory parallelism + (such as interpinic and mksurfdata) with + + gmake SMP=TRUE + + To run a program with a namelist: + + ./program < namelist + + To get help on running a program with command line options (e.g., interpinic): + + ./program + + To run a program built with SMP=TRUE: + + setenv OMP_NUM_THREADS= + + run normally as above + +III. Process sequence to create input datasets needed to run CLM + +NOTE: The following assumes you want to create files for CLM4.5. If you want to +use CLM4.0, you will need to do the following: + - In the following commands, change references to the clm4_5 directory to clm4_0 + - Add the option '-p clm4_0' to the mkmapdata.sh command. + + 1.) Create SCRIP grid files (if needed) + + a.) For standard resolutions these files will already be created. (done) + + b.) To create regular lat-lon regional/single-point grids run mknoocnmap.pl + + This will create both SCRIP grid files and a mapping file that will + be valid if the region includes NO ocean whatsoever (so you can skip step 2). + You can also use this script to create SCRIP grid files for a region + (or even a global grid) that DOES include ocean if you use step 2 to + create mapping files for it (simply discard the non-ocean map created by + this script). + + Example, for single-point over Boulder Colorado. + + cd shared/mkmapdata + ./mknoocnmap.pl -p 40,255 -n 1x1_boulderCO + + c.) General case + + You'll need to convert or create SCRIP grid files on your own (using scripts + or other tools) for the general case where you have an unstructured grid, or + a grid that is not regular in latitude and longitude. + + example format + ================== + netcdf fv1.9x2.5_090205 { + dimensions: + grid_size = 13824 ; + grid_corners = 4 ; + grid_rank = 2 ; + variables: + double grid_center_lat(grid_size) ; + grid_center_lat:units = "degrees" ; + double grid_center_lon(grid_size) ; + grid_center_lon:units = "degrees" ; + double grid_corner_lat(grid_size, grid_corners) ; + grid_corner_lat:units = "degrees" ; + double grid_corner_lon(grid_size, grid_corners) ; + grid_corner_lon:units = "degrees" ; + int grid_dims(grid_rank) ; + int grid_imask(grid_size) ; + grid_imask:units = "unitless" ; + + 2.) Create ocean to atmosphere mapping file (if needed) + + a.) Standard resolutions (done) + + If this is a standard resolution with a standard ocean resolution -- this + step is already done, the files already exist. + + b.) Region without Ocean (done in step 1.b) + + IF YOU RAN mknoocnmap.pl FOR A REGION WITHOUT OCEAN THIS STEP IS ALREADY DONE. + + c.) New atmosphere or ocean resolution + + If the region DOES include ocean, use $CIMEROOT/tools/mapping/gen_domain_files/gen_maps.sh to create a + mapping file for it. + + Example: + + setenv CIMEROOT ../../../cime + cd $CIMEROOT/tools/mapping/gen_domain_files + ./gen_maps.sh -focn -fatm -nocn -natm + + + 3.) Add SCRIP grid file(s) created in (1) into XML database in CLM (optional) + + See the "Adding New Resolutions or New Files to the build-namelist Database" + Chapter in the CLM User's Guide + + http://www.cesm.ucar.edu/models/cesm1.0/clm/models/lnd/clm/doc/UsersGuide/book1.html + + If you don't do this step, you'll need to specify the file to mkmapdata + in step (3) using the "-f" option. + + 4.) Create mapping files for use by mksurfdata_map with mkmapdata + (See mkmapdata/README for more help on doing this) + + - this step uses the results of (1) that were entered into the XML database + by step (3). If you don't enter datasets in, you need to specify the + SCRIP grid file using the "-f" option to mkmapdata.sh. + + - note that mkmapdata generates maps for CLM4.5 by default; to generate + mapping files for CLM4.0, add the option '-p clm4_0' + + Example: to generate all necessary mapping files for the ne30np4 grid + + cd shared/mkmapdata + ./mkmapdata.sh -r ne30np4 + + 5.) Add mapping file(s) created in step (4) into XML database in CLM (optional) + + See notes on doing this in step (3) above. + Edit ../bld/namelist_files/namelist_defaults_clm.xml to incorporate new + mapping files. + + If you don't do this step, you'll need to specify the grid resolution name + and file creation dates to mksurfdata_map in step (5) below. + + 6.) Convert map of ocean to atm for use by DATM and CLM with gen_domain + (See $CIMEROOT/tools/mapping/README for more help on doing this) + + - gen_domain uses the map from step (2) (or previously created CESM maps) + + Example: + + cd $CIMEROOT/tools/mapping/gen_domain_files/src + gmake + cd .. + setenv CDATE 090206 + setenv OCNGRIDNAME gx1v6 + setenv ATMGRIDNAME fv1.9x2.5 + setenv MAPFILE $CSMDATA/cpl/cpl6/map_${OCNGRIDNAME}_to_${ATMGRIDNAME}_aave_da_${CDATE}.nc + ./gen_domain -m $MAPFILE -o $OCNGRIDNAME -l $ATMGRIDNAME + + Normally for I compsets running CLM only you will discard the ocean domain + file, and only use the atmosphere domain file for datm and as the fatmlndfrc + file for CLM. Output domain files will be named according to the input OCN/LND + gridnames. + + 7.) Create surface datasets with mksurfdata_map + (See mksurfdata_map/README for more help on doing this) + + - Run clm4_5/mksurfdata_map/mksurfdata.pl + - This step uses the results of step (4) entered into the XML database + in step (5). + - If datasets were NOT entered into the XML database, set the resolution + to "usrspec" and use the "-usr_gname", and "-usr_gdate" options. + + Example: for 0.9x1.25 resolution + + cd clm4_5/mksurfdata_map/src + gmake + cd .. + ./mksurfdata.pl -r 0.9x1.25 + + NOTE that surface dataset will be used by default for fatmgrid - and it will + contain the lat,lon,edges and area values for the atm grid - ASSUMING that + the atm and land grid are the same + + 8.) Interpolate initial conditions using interpinic (optional) + (See interpinic/README for more help on doing this) + + 9.) Add new files to XML data or using user_nl_clm (optional) + + See notes on doing this in step (3) above. + +IV. Example of creating single-point datasets without entering into XML database. + + Here we apply the process described in III. for a single-point dataset + where we don't enter the datasets into the XML database (thus skipping + steps 3, 5 and 9), but use the needed command line options to specify where the + files are. This also skips step (2) since step 1 creates the needed mapping file. + We also skip step (8) and do NOT create a finidat file. + + 0.) Set name of grid to use and the creation date to be used later... + setenv GRIDNAME 1x1_boulderCO + setenv CDATE `date +%y%m%d` + 1.) SCRIP grid and atm to ocn mapping file + cd shared/mkmapdata + ./mknoocnmap.pl -p 40,255 -n $GRIDNAME + # Set pointer to MAPFILE that will be used in step (6) + setenv MAPFILE `pwd`/map_${GRIDNAME}_noocean_to_${GRIDNAME}_nomask_aave_da_${CDATE}.nc + cd ../.. + 2.) skip + 3.) skip + 4.) Mapping files needed for mksurfdata_map + cd shared/mkmapdata + setenv GRIDFILE ../mkmapgrids/SCRIPgrid_${GRIDNAME}_nomask_${CDATE}.nc + ./mkmapdata.sh -r $GRIDNAME -f $GRIDFILE -t regional + cd ../.. + 5.) skip + 6.) Generate domain file for datm and CLM + setenv CIMEROOT ../../../cime + cd $CIMEROOT/tools/mapping/gen_domain_files/src + gmake + cd .. + setenv OCNDOM domain.ocn_noocean.nc + setenv ATMDOM domain.lnd.{$GRIDNAME}_noocean.nc + ./gen_domain -m $MAPFILE -o $OCNDOM -l $ATMDOM + 7.) Create surface dataset for CLM + cd clm4_5/mksurfdata_map/src + gmake + cd .. + ./mksurfdata.pl -r usrspec -usr_gname $GRIDNAME -usr_gdate $CDATE + 8.) skip + 9.) skip + +V. Notes on which input datasets are needed for CLM + + global or regional/single-point grids + - need fsurdata and fatmlndfrc + + fsurdata ---- from mksurfdata_map in step (III.7) + fatmlndfrc -- use the domain.lnd file from gen_domain in step (III.6) + diff --git a/components/clm/tools/README.filecopies b/components/clm/tools/README.filecopies new file mode 100644 index 0000000000..58553a3d27 --- /dev/null +++ b/components/clm/tools/README.filecopies @@ -0,0 +1,56 @@ +components/clm/tools/README.filecopies May/26/2011 + +There are several files that are copies of the original files from +either components/clm/src/main, cime/share/csm_share/shr, +cime/share/csm_share/unit_testers, or copies from other tool +directories. By having copies the tools can all be made stand-alone, +but any changes to the originals will have to be put into the tool +directories as well. + +I. Files that are IDENTICAL: + + 1. csm_share files copied that should be identical to cime/share/csm_share/shr: + + shr_kind_mod.F90 + shr_const_mod.F90 + shr_log_mod.F90 + shr_timer_mod.F90 + shr_string_mod.F90 + shr_file_mod.F90 + + 2. csm_share files copied that should be identical to cime/share/csm_share/unit_testers: + + test_mod.F90 + + 3. clm/src files copied that should be identical to components/clm/src/main: + + clm_varctl.F90 + nanMod.F90 + +II. Files with differences + + 1. csm_share files copied with differences: + + shr_sys_mod.F90 - Remove mpi abort and reference to shr_mpi_mod.F90. + + 2. clm/src files with differences: + + fileutils.F90 --- Remove use of masterproc and spmdMod and endrun in abortutils. + + 3. Files in mkgriddata (different from mkmapgrids) + + domainMod.F90 ---- Highly customized based off an earlier version of clm code. + Remove use of abortutils, spmdMod. clm version uses latlon + this version uses domain in names. Distributed memory + parallelism is removed. + + 4. Files in mkmapgrids (different from mkgriddata) + + domainMod.F90 ---- Highly customized based off an earlier version of clm code. + Remove use of abortutils, spmdMod. clm version uses latlon + this version uses domain in names. Distributed memory + parallelism is removed. + + 5. Files in mksurfdata_map + + mkvarpar.F90 diff --git a/components/clm/tools/README.testing b/components/clm/tools/README.testing new file mode 100644 index 0000000000..0686ab00c4 --- /dev/null +++ b/components/clm/tools/README.testing @@ -0,0 +1,70 @@ +components/clm/tools/README.testing May/23/2011 + +There is automated testing for all of the tools and scripts under this tools directory. +The tests are in the components/clm/test/system directory and are any of the scripts +that have "tools" in the name. There are several assumptions made in order for the +testing to work. + + +1.) Executable name is the same as the directory name + +The name of the executable program is the same as the directory name of the tool. + +2.) Build works the same for any Fortran tools + +The build for any Fortran tools should work the same way, with the same options +and required files for it. The files: Makefile, Mkdepends, Filepath and Srcfile +are expected to exist in the tool "src" sub-directory. To make maintaining these files easier +in general the Makefile and Mkdepends files should be kept identical other than +default settings for OPT and SMP and the output executable name. + +Options to the Makefile: + + LIB_NETCDF --- Library directory location of NetCDF. (defaults to /usr/local/lib) + INC_NETCDF --- Include directory location of NetCDF. (defaults to /usr/local/include) + MOD_NETCDF --- Module directory location of NetCDF. (defaults to $LIB_NETCDF) + USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. + USER_FCTYP --- Allow user to override the default type of Fortran compiler + (Linux and USER_FC=ftn only). + USER_CC ------ Allow user to override the default C compiler specified in Makefile + (Linux only). + USER_LINKER -- Allow user to override the default linker specified in Makefile. + SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] + OPT ---------- Use optimized options. (TRUE or FALSE) + +3.) Successful completion of the tool ends with "Successfully created ..." + +After the tool completes it should have an unique string telling of the +successful completion of the file that is searchable in the log file starting +with "Successfully created ". If this string isn't found in the log file, it +will be assumed by the test setup that the test failed. + +4.) NetCDF files are created or modified + +It is assumed that NetCDF files are created and/or modified by the process. And if +NetCDF files are NOT created -- something went wrong. For some scripts that copy files +to other locations this means an "-nomv" option needs to be invoked (and one provided) +so that it leaves the files created in the current directory. + +5.) Either .* namelist files exist or .runoptions files + +To specify options for the running of the tool, either sample namelist files +are provided or a sample run options file. These files can EITHER be in the +tool directory OR the ../test/system/nl_files directory. + + a. Namelist files + + If namelists are used to run the tool, sample namelist files exist with the + directory name followed by a "." and then a descriptive name. In general the + namelists will use filepaths that will only work on the NCAR machine bluefire. + + b. runoptions files + + If command line options are used to run the tool, a file with sample command + line options exist called ".runoptions". Again filepaths are only + expected to work on the NCAR machine bluefire. + +6.) Specific tests for perl run scripts + +For tools that have perl scripts to create namelists and run the tool for you, there +are customized tests to run these tools. diff --git a/components/clm/tools/SVN_EXTERNAL_DIRECTORIES b/components/clm/tools/SVN_EXTERNAL_DIRECTORIES new file mode 100644 index 0000000000..a45a2a5664 --- /dev/null +++ b/components/clm/tools/SVN_EXTERNAL_DIRECTORIES @@ -0,0 +1 @@ +shared/PTCLM https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_150826 diff --git a/components/clm/tools/clm4_0/interpinic/README b/components/clm/tools/clm4_0/interpinic/README new file mode 100644 index 0000000000..52b04ec207 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/README @@ -0,0 +1,59 @@ +components/clm/tools/interpinic/README May/25/2011 + +Tool to interpolate initial datasets to a different resolution or +mask. + + +Running gnumake in this directory will create an executable named + + "interpinic" + +Its function is to map an input clm initial file to an output clm initial file, +where the output clm initial file is overwritten with the interpolated values. + +USAGE: + +interpinic [-a] -i -o + +OPTIONS: + +-a To abort if find missing types that aren't matched + from the input file. By default will overwrite missing + types with the nearest bare soil. +-i File to interpolate from. +-o Input/Output file to interpolate to. + +Options to gmake: + +gmake OPT=FALSE # will compile with debug compiler options on +gmake SMP=TRUE # will compile with Open-MP parallelism on + +If SMP is TRUE, then should invoke interpic as follows: + +env OMP_NUM_THREADS interpinic -i -o + +See Also: See the components/clm/tools/README file for more notes about setting + the path for NetCDF and running with shared-memory parallelism. + +Files: + +src/Makefile --------------------------------------- GNU makefile +src/Macros.custom ---------------------------------- Customization of make macros for interpinic + +src/Mkdepends -------------------------------------- Tool for Makefile to figure out + code dependencies. + +src/Srcfiles --------------------------------------- List of source files needed + + +src/Filepath --------------------------------------- Filepath location to source files needed + +clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc- Sample 10x15 resolution dataset that + you can interpolate to + +interpinic.runoptions ------------------------------ Example runoptions using the above file. + +runinit_ibm.csh ------------------------------------ Script to run interpinic for multiple + resolutions, also runs clm to create + template files to do so. + diff --git a/components/clm/tools/clm4_0/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc b/components/clm/tools/clm4_0/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc new file mode 100644 index 0000000000..973590251c Binary files /dev/null and b/components/clm/tools/clm4_0/interpinic/clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc differ diff --git a/components/clm/tools/clm4_0/interpinic/interpinic.runoptions b/components/clm/tools/clm4_0/interpinic/interpinic.runoptions new file mode 100644 index 0000000000..c9d63b9433 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/interpinic.runoptions @@ -0,0 +1 @@ +-i /glade/p/cesm/cseg/inputdata/ccsm4_init/I1850CN_f19_g16_c100503/0001-01-01/I1850CN_f19_g16_c100503.clm2.r.0001-01-01-00000.nc -o clmi.BCN.1949-01-01_10x15_USGS_simyr1850_c100322.nc diff --git a/components/clm/tools/clm4_0/interpinic/src/Filepath b/components/clm/tools/clm4_0/interpinic/src/Filepath new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/Filepath @@ -0,0 +1 @@ +. diff --git a/components/clm/tools/clm4_0/interpinic/src/Makefile b/components/clm/tools/clm4_0/interpinic/src/Makefile new file mode 100644 index 0000000000..24afc3ae75 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/Makefile @@ -0,0 +1,15 @@ +# Makefile for interpinic + +EXENAME = ../interpinic + +# Set shared memory to off by default +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +include Makefile.common diff --git a/components/clm/tools/clm4_0/interpinic/src/Makefile.common b/components/clm/tools/clm4_0/interpinic/src/Makefile.common new file mode 100644 index 0000000000..bf8c80eed6 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/Makefile.common @@ -0,0 +1,360 @@ +#----------------------------------------------------------------------- +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# These macros can be changed by setting environment variables: +# +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS - Additional CPP defines. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS -- Additional load flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#------------------------------------------------------------------------ + +# Set up special characters +null := + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +RM = rm + +# Check for the netcdf library and include directories +ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include +endif + +ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) +endif + +# Set user specified Fortran compiler +ifneq ($(USER_FC),$(null)) + FC := $(USER_FC) +endif + +# Set user specified C compiler +ifneq ($(USER_CC),$(null)) + CC := $(USER_CC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +CPPDEF := $(USER_CPPDEFS) + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +ifeq ($(OPT),TRUE) + CPPDEF := -DOPT +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +# (the vpath itself is set elsewhere, based on this variable) +vpath_dirs := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +vpath_dirs := $(subst $(space),:,$(vpath_dirs)) + +#Primary Target: build the tool +all: $(EXENAME) + +# Get list of files and build dependency file for all .o files +# using perl scripts mkSrcfiles and mkDepends + +SOURCES := $(shell cat Srcfiles) + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +# Set path to Mkdepends script; assumes that any Makefile including +# this file is in a sibling of the src directory, in which Mkdepends +# resides +Mkdepends := ../src/Mkdepends + +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + $(Mkdepends) Filepath Srcfiles > $@ + + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +CPPDEF += -DAIX +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(CPPDEF)) +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90 -qsuffix=f=f90:cpp=F90 \ + $(FPPFLAGS) -g -qfullpath -qarch=auto -qtune=auto -qsigtrap=xl__trcedump -qsclk=micro + +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdff -lnetcdf +ifneq ($(OPT),TRUE) + FFLAGS += -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en -qspillsize=4000 -C +else + FFLAGS += -O2 -qmaxmem=-1 -Q + LDFLAGS += -Q +endif +CFLAGS := -q64 -g $(CPPDEF) -O2 +FFLAGS += $(cpp_path) +CFLAGS += $(cpp_path) + +ifeq ($(SMP),TRUE) + FC = xlf90_r + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp +else + FC = xlf90 +endif + +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + +# Set the default Fortran compiler +ifeq ($(USER_FC),$(null)) + FC := g95 +endif +ifeq ($(USER_CC),$(null)) + CC := gcc +endif + +CFLAGS := -g -O2 +CPPDEF += -DSYSDARWIN -DDarwin -DLINUX +LDFLAGS := + +ifeq ($(FC),g95) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),gfortran) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) \ + -fno-range-check + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),ifort) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c -ftz -g -fp-model precise $(CPPDEF) $(cpp_path) \ + -convert big_endian -assume byterecl -traceback -FR + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + LDFLAGS += -openmp + endif +endif + +ifeq ($(FC),pgf90) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c $(CPPDEF) $(cpp_path) + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + +endif + +ifeq ($(CC),icc) + CFLAGS += -m64 -g + ifeq ($(SMP),TRUE) + CFLAGS += -openmp + endif +endif +ifeq ($(CC),pgcc) + CFLAGS += -g -fast +endif + +CFLAGS += $(CPPDEF) $(cpp_path) +LDFLAGS += -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := ifort + FCTYP := ifort + else + ifeq ($(USER_FC),ftn) + ifneq ($(USER_FCTYP),$(null)) + FCTYP := $(USER_FCTYP) + else + FCTYP := pgf90 + endif + else + FCTYP := $(USER_FC) + endif + endif + CPPDEF += -DLINUX -DFORTRANUNDERSCORE + CFLAGS := $(CPPDEF) + LDFLAGS := $(shell $(LIB_NETCDF)/../bin/nf-config --flibs) + FFLAGS = + + ifeq ($(FCTYP),pgf90) + CC := pgcc + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + CFLAGS += -fast + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + + endif + + ifeq ($(FCTYP),lf95) + ifneq ($(OPT),TRUE) + FFLAGS += -g --chk a,e,s,u -O0 + else + FFLAGS += -O + endif + # Threading only works by putting thread memory on the heap rather than the stack + # (--threadheap). + # As of lf95 version 6.2 the thread stacksize limits are (still) too small to run + # even small + # resolution problems (FV at 10x15 res fails). + ifeq ($(SMP),TRUE) + FFLAGS += --openmp --threadheap 4096 + LDFLAGS += --openmp --threadheap 4096 + endif + endif + ifeq ($(FCTYP),pathf90) + FFLAGS += -extend_source -ftpp -fno-second-underscore + ifneq ($(OPT),TRUE) + FFLAGS += -g -O0 + else + FFLAGS += -O + endif + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + endif + ifeq ($(FCTYP),ifort) + + FFLAGS += -ftz -g -fp-model precise -convert big_endian -assume byterecl -traceback -FR + CFLAGS += -m64 -g + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + CFLAGS += -openmp + LDFLAGS += -openmp + endif + endif + FFLAGS += -c -I$(INC_NETCDF) $(CPPDEF) $(cpp_path) + CFLAGS += $(cpp_path) +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Set the vpath for all file types EXCEPT .o +# We do this for individual file types rather than generally using +# VPATH, because for .o files, we don't want to use files from a +# different build (e.g., in building the unit tester, we don't want to +# use .o files from the main build) +vpath %.F90 $(vpath_dirs) +vpath %.c $(vpath_dirs) +vpath %.h $(vpath_dirs) + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifneq ($(USER_LINKER),$(null)) + LINKER := $(USER_LINKER) +else + LINKER := $(FC) +endif + +.F90.o: + $(FC) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod Depends + +include $(CURDIR)/Depends diff --git a/components/clm/tools/clm4_0/interpinic/src/Mkdepends b/components/clm/tools/clm4_0/interpinic/src/Mkdepends new file mode 100755 index 0000000000..a75e8fdde0 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/Mkdepends @@ -0,0 +1,327 @@ +#!/usr/bin/env perl + +# Generate dependencies in a form suitable for inclusion into a Makefile. +# The source filenames are provided in a file, one per line. Directories +# to be searched for the source files and for their dependencies are provided +# in another file, one per line. Output is written to STDOUT. +# +# For CPP type dependencies (lines beginning with #include) the dependency +# search is recursive. Only dependencies that are found in the specified +# directories are included. So, for example, the standard include file +# stdio.h would not be included as a dependency unless /usr/include were +# one of the specified directories to be searched. +# +# For Fortran module USE dependencies (lines beginning with a case +# insensitive "USE", possibly preceded by whitespace) the Fortran compiler +# must be able to access the .mod file associated with the .o file that +# contains the module. In order to correctly generate these dependencies +# two restrictions must be observed. +# 1) All modules must be contained in files that have the same base name as +# the module, in a case insensitive sense. This restriction implies that +# there can only be one module per file. +# 2) All modules that are to be contained in the dependency list must be +# contained in one of the source files in the list provided on the command +# line. +# The reason for the second restriction is that since the makefile doesn't +# contain rules to build .mod files the dependency takes the form of the .o +# file that contains the module. If a module is being used for which the +# source code is not available (e.g., a module from a library), then adding +# a .o dependency for that module is a mistake because make will attempt to +# build that .o file, and will fail if the source code is not available. +# +# Author: B. Eaton +# Climate Modelling Section, NCAR +# Feb 2001 + +use Getopt::Std; +use File::Basename; + +# Check for usage request. +@ARGV >= 2 or usage(); + +# Process command line. +my %opt = (); +getopts( "t:w", \%opt ) or usage(); +my $filepath_arg = shift() or usage(); +my $srcfile_arg = shift() or usage(); +@ARGV == 0 or usage(); # Check that all args were processed. + +my $obj_dir; +if ( defined $opt{'t'} ) { $obj_dir = $opt{'t'}; } + +open(FILEPATH, $filepath_arg) or die "Can't open $filepath_arg: $!\n"; +open(SRCFILES, $srcfile_arg) or die "Can't open $srcfile_arg: $!\n"; + +# Make list of paths to use when looking for files. +# Prepend "." so search starts in current directory. This default is for +# consistency with the way GNU Make searches for dependencies. +my @file_paths = ; +close(FILEPATH); +chomp @file_paths; +unshift(@file_paths,'.'); +foreach $dir (@file_paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Make list of files containing source code. +my @src = ; +close(SRCFILES); +chomp @src; + +# For each file that may contain a Fortran module (*.[fF]90 *.[fF]) convert the +# file's basename to uppercase and use it as a hash key whose value is the file's +# basename. This allows fast identification of the files that contain modules. +# The only restriction is that the file's basename and the module name must match +# in a case insensitive way. +my %module_files = (); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.[fF]90', '\.[fF]' ); +foreach $f (@src) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $module_files{$mod} = $name; +} + +# Now make a list of .mod files in the file_paths. If a .o source dependency +# can't be found based on the module_files list above, then maybe a .mod +# module dependency can if the mod file is visible. +my %trumod_files = (); +my ($dir); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.mod' ); +foreach $dir (@file_paths) { + @filenames = (glob("$dir/*.mod")); + foreach $f (@filenames) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $trumod_files{$mod} = $name; + } +} + +#print STDERR "\%module_files\n"; +#while ( ($k,$v) = each %module_files ) { +# print STDERR "$k => $v\n"; +#} + +# Find module and include dependencies of the source files. +my ($file_path, $rmods, $rincs); +my %file_modules = (); +my %file_includes = (); +my @check_includes = (); +foreach $f ( @src ) { + + # Find the file in the seach path (@file_paths). + unless ($file_path = find_file($f)) { + if (defined $opt{'w'}) {print STDERR "$f not found\n";} + next; + } + + # Find the module and include dependencies. + ($rmods, $rincs) = find_dependencies( $file_path ); + + # Remove redundancies (a file can contain multiple procedures that have + # the same dependencies). + $file_modules{$f} = rm_duplicates($rmods); + $file_includes{$f} = rm_duplicates($rincs); + + # Make a list of all include files. + push @check_includes, @{$file_includes{$f}}; +} + +#print STDERR "\%file_modules\n"; +#while ( ($k,$v) = each %file_modules ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\@check_includes\n"; +#print STDERR "@check_includes\n"; + +# Find include file dependencies. +my %include_depends = (); +while (@check_includes) { + $f = shift @check_includes; + if (defined($include_depends{$f})) { next; } + + # Mark files not in path so they can be removed from the dependency list. + unless ($file_path = find_file($f)) { + $include_depends{$f} = -1; + next; + } + + # Find include file dependencies. + ($rmods, $include_depends{$f}) = find_dependencies($file_path); + + # Add included include files to the back of the check_includes list so + # that their dependencies can be found. + push @check_includes, @{$include_depends{$f}}; + + # Add included modules to the include_depends list. + if ( @$rmods ) { push @{$include_depends{$f}}, @$rmods; } +} + +#print STDERR "\%include_depends\n"; +#while ( ($k,$v) = each %include_depends ) { +# print STDERR (ref $v ? "$k => @$v\n" : "$k => $v\n"); +#} + +# Remove include file dependencies that are not in the Filepath. +my $i, $ii; +foreach $f (keys %include_depends) { + + unless (ref $include_depends{$f}) { next; } + $rincs = $include_depends{$f}; + unless (@$rincs) { next; } + $ii = 0; + $num_incs = @$rincs; + for ($i = 0; $i < $num_incs; ++$i) { + if ($include_depends{$$rincs[$ii]} == -1) { + splice @$rincs, $ii, 1; + next; + } + ++$ii; + } +} + +# Substitute the include file dependencies into the %file_includes lists. +foreach $f (keys %file_includes) { + my @expand_incs = (); + + # Initialize the expanded %file_includes list. + my $i; + unless (@{$file_includes{$f}}) { next; } + foreach $i (@{$file_includes{$f}}) { + push @expand_incs, $i unless ($include_depends{$i} == -1); + } + unless (@expand_incs) { + $file_includes{$f} = []; + next; + } + + # Expand + for ($i = 0; $i <= $#expand_incs; ++$i) { + push @expand_incs, @{ $include_depends{$expand_incs[$i]} }; + } + + $file_includes{$f} = rm_duplicates(\@expand_incs); +} + +#print STDERR "expanded \%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} + +# Print dependencies to STDOUT. +foreach $f (sort keys %file_modules) { + $f =~ /(.+)\./; + $target = "$1.o"; + if ( defined $opt{'t'} ) { $target = "$opt{'t'}/$1.o"; } + print "$target : $f @{$file_modules{$f}} @{$file_includes{$f}}\n"; +} + +#-------------------------------------------------------------------------------------- + +sub find_dependencies { + + # Find dependencies of input file. + # Use'd Fortran 90 modules are returned in \@mods. + # Files that are "#include"d by the cpp preprocessor are returned in \@incs. + + my( $file ) = @_; + my( @mods, @incs ); + + open(FH, $file) or die "Can't open $file: $!\n"; + + while ( ) { + # Search for "#include" and strip filename when found. + if ( /^#include\s+[<"](.*)[>"]/ ) { + push @incs, $1; + } + # Search for Fortran include dependencies. + elsif ( /^\s*include\s+['"](.*)['"]/ ) { #" for emacs fontlock + push @incs, $1; + } + # Search for module dependencies. + elsif ( /^\s*USE\s+(\w+)/i ) { + ($module = $1) =~ tr/a-z/A-Z/; + # Return dependency in the form of a .o version of the file that contains + # the module. this is from the source list. + if ( defined $module_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$module_files{$module}.o"; + } else { + push @mods, "$module_files{$module}.o"; + } + } + # Return dependency in the form of a .mod version of the file that contains + # the module. this is from the .mod list. only if .o version not found + elsif ( defined $trumod_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$trumod_files{$module}.mod"; + } else { + push @mods, "$trumod_files{$module}.mod"; + } + } + } + } + close( FH ); + return (\@mods, \@incs); +} + +#-------------------------------------------------------------------------------------- + +sub find_file { + +# Search for the specified file in the list of directories in the global +# array @file_paths. Return the first occurance found, or the null string if +# the file is not found. + + my($file) = @_; + my($dir, $fname); + + foreach $dir (@file_paths) { + $fname = "$dir/$file"; + if ( -f $fname ) { return $fname; } + } + return ''; # file not found +} + +#-------------------------------------------------------------------------------------- + +sub rm_duplicates { + +# Return a list with duplicates removed. + + my ($in) = @_; # input arrary reference + my @out = (); + my $i; + my %h = (); + foreach $i (@$in) { + $h{$i} = ''; + } + @out = keys %h; + return \@out; +} + +#-------------------------------------------------------------------------------------- + +sub usage { + ($ProgName = $0) =~ s!.*/!!; # name of program + die < -o [options]' + write (6,*) 'options: -a = abort rather than override missing values with closest bare-soil' + write (6,*) 'Note - the output initial data file will be overwritten with the interpolated values' + stop 999 +end subroutine diff --git a/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 b/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 new file mode 100644 index 0000000000..da519b49d2 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 @@ -0,0 +1,1498 @@ +module interpinic + + !----------------------------------------------------------------------- + ! Interpolate initial conditions file from one resolution and/or landmask + ! to another resolution and/or landmask + !----------------------------------------------------------------------- + + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod , only: SHR_CONST_PI, SHR_CONST_REARTH + use shr_sys_mod , only: shr_sys_flush + implicit none + + private + + ! Public methods + + public :: interp_filei + + ! Public data + + logical, public :: override_missing = .true. ! if you want to override missing + ! types with closest bare-soil + ! Otherwise it will abort. + + ! Private methods + + private :: interp_ml_real + private :: interp_sl_real + private :: interp_sl_int + private :: findMinDistPFTs + private :: findMinDistCols + private :: findMinDistLDUs + + ! Private data + + ! Variables read in from input and output initial files + + integer :: nlevsno ! maximum number of snow levels + integer :: nlevsno1 ! maximum number of snow levels plus one + integer :: nlevlak ! number of lake levels + integer :: nlevtot ! number of soil and snow levels + + integer :: numpfts ! input file number of pfts + integer :: numpftso ! output file number of pfts + integer :: numcols ! input file number of columns + integer :: numcolso ! output file number of columns + integer :: numldus ! input file number of landunits + integer :: numlduso ! output file number of landunits + + ! RTM river routing model + integer, parameter :: rtmlon = 720 ! # of rtm longitudes + integer, parameter :: rtmlat = 360 ! # of rtm latitudes + real(r8) :: volr(rtmlon,rtmlat) ! water volume in cell (m^3) + + ! Other parameter sizes + integer, parameter :: numrad = 2 ! # of radiation bands + + ! Parameters + + real(r8), parameter :: spval = 1.e36_r8 ! special value for missing data (ocean) + real(r8), parameter :: deg2rad = SHR_CONST_PI/180._r8 + real(r8), parameter :: re = SHR_CONST_REARTH + ! These types need to agree with the types in clm_varcon.F90 in the main CLM model code + integer, parameter :: croptype = 15 + integer, parameter :: istcrop = 8 + integer, parameter :: istsoil = 1 + integer, parameter :: baresoil = 0 + integer, parameter :: nonurbcol = 1 + + logical , save :: allPFTSfromSameGC = .false. ! Get all PFTS from the same gridcells + logical , save :: noAbortIfDNE = .false. ! Do NOT abort if some input data does not exist + integer , allocatable, save :: colindx(:) ! Column mapping indices + integer , allocatable, save :: pftindx(:) ! PFT mapping indices + integer , allocatable, save :: lduindx(:) ! land-unit mapping indices + + SAVE + +contains + + !======================================================================= + + subroutine interp_filei (fin, fout, cmdline) + + !----------------------------------------------------------------------- + ! Read initial data from netCDF instantaneous initial data history file + !----------------------------------------------------------------------- + + use netcdf +#ifdef AIX + use IEEE_ARITHMETIC, only: IEEE_IS_NAN +#endif + + implicit none + include 'netcdf.inc' + + ! ------------------------ arguments------ ----------------------------- + character(len=256), intent(in) :: fin !input initial dataset + character(len=256), intent(in) :: fout !output initial dataset + character(len=256), intent(in) :: cmdline !command line arguments + ! -------------------------------------------------------------------- + + ! ------------------------ local variables ----------------------------- + integer :: i,j,k,l,m,n ! loop indices + integer :: ncidi ! netCDF dataset id + integer :: nvecin ! input vector length + integer :: nvars ! number of variables + integer :: nvecout ! output vector length + integer :: ncido ! output net + integer :: dimid ! netCDF dimension id + integer :: dimidpft ! netCDF dimension id PFT + integer :: dimidldu ! netCDF dimension id PFT + integer :: dimidcols ! netCDF dimension id columns + integer :: dimidlak ! netCDF dimension id lake + integer :: dimidsno ! netCDF dimension id snow depth + integer :: dimidsno1 ! netCDF dimension id snow depth plus one + integer :: dimidtot ! netCDF dimension id total + integer :: dimidrad ! netCDF dimension id numrad + integer :: dimidrtmlat ! netCDF dimension id rtmlat + integer :: dimidrtmlon ! netCDF dimension id rtmlon + integer :: varid ! netCDF variable id + integer :: varido ! netCDF variable id + integer :: xtype ! netCDF variable type + integer :: period ! period accumulator scalar to copy over + integer :: ndims ! netCDF number of dimensions + integer :: dimids(3) = -1 ! netCDF dimension ids + integer :: dimlen ! input dimension length + integer :: ret ! netcdf return code + integer :: ncformat ! netcdf file format + character(len=256) :: varname !variable name + real(r8), allocatable :: rbufmlo (:,:) !output array + !-------------------------------------------------------------------- + + write (6,*) 'Mapping clm initial data from input to output initial files' + + ! Open input and output initial conditions files + + call check_ret (nf90_open(fin, NF90_NOWRITE, ncidi )) + call check_ret (nf90_open(fout, NF90_WRITE, ncido )) + call check_ret (nf_inq_format( ncido, ncformat )) + if ( ncformat /= NF_FORMAT_64BIT )then + write (6,*) 'Warning: output file is NOT in NetCDF large-file format!' + !stop + end if + + call addglobal (ncido, cmdline) + + call check_ret (nf90_inq_dimid(ncidi, "column", dimidcols )) + call check_ret (nf90_inquire_dimension(ncidi, dimidcols, len=numcols)) + call check_ret (nf90_inq_dimid(ncido, "column", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=numcolso)) + write (6,*) 'input numcols = ',numcols,' output numcols = ',numcolso + + call check_ret (nf90_inq_dimid(ncidi, "pft", dimidpft )) + call check_ret (nf90_inquire_dimension(ncidi, dimidpft, len=numpfts)) + call check_ret (nf90_inq_dimid(ncido, "pft", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=numpftso)) + write (6,*) 'input numpfts = ',numpfts,' output numpfts = ',numpftso + + + call check_ret (nf90_inq_dimid(ncidi, "landunit", dimidldu )) + call check_ret (nf90_inquire_dimension(ncidi, dimidldu, len=numldus)) + call check_ret (nf90_inq_dimid(ncido, "landunit", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=numlduso)) + write (6,*) 'input numldus = ',numldus,' output numldus = ',numlduso + + call check_ret (nf90_inq_dimid(ncidi, "levsno", dimidsno )) + call check_ret (nf90_inquire_dimension(ncidi, dimidsno, len=nlevsno)) + call check_ret (nf90_inq_dimid(ncido, "levsno", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen)) + if (dimlen/=nlevsno) then + write (6,*) 'error: input and output nlevsno values disagree' + write (6,*) 'input nlevsno = ',nlevsno,' output nlevsno = ',dimlen + stop + end if + + ret = nf90_inq_dimid(ncidi, "levsno1", dimidsno1) + if (ret == NF90_NOERR) then + call check_ret (nf90_inquire_dimension(ncidi, dimidsno1, len=nlevsno1)) + call check_ret (nf90_inq_dimid(ncido, "levsno1", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen)) + if (dimlen/=nlevsno1) then + write (6,*) 'error: input and output nlevsno1 values disagree' + write (6,*) 'input nlevsno1 = ',nlevsno1,' output nlevsno1 = ',dimlen + stop + end if + else + write (6,*) 'levsno1 dimension does NOT exist on the input dataset' + dimidsno1 = -9999 + nlevsno1 = -9999 + end if + + call check_ret (nf90_inq_dimid(ncidi, "levlak", dimidlak )) + call check_ret (nf90_inquire_dimension(ncidi, dimidlak, len=nlevlak)) + call check_ret (nf90_inq_dimid(ncido, "levlak", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen)) + if (dimlen/=nlevlak) then + write (6,*) 'error: input and output nlevlak values disagree' + write (6,*) 'input nlevlak = ',nlevlak,' output nlevlak = ',dimlen + stop + end if + + call check_ret (nf90_inq_dimid(ncidi, "levtot", dimidtot )) + call check_ret (nf90_inquire_dimension(ncidi, dimidtot, len=nlevtot)) + call check_ret (nf90_inq_dimid(ncido, "levtot", dimid )) + call check_ret (nf90_inquire_dimension(ncido, dimid, len=dimlen)) + if (dimlen/=nlevtot) then + write (6,*) 'error: input and output nlevtot values disagree' + write (6,*) 'input nlevtot = ',nlevtot,' output nlevtot = ',dimlen + stop + end if + + ! numrad dimension + ret = nf90_inq_dimid(ncidi, "numrad", dimidrad) + if (ret/=NF90_NOERR) call handle_error (ret) + ret = nf90_inquire_dimension(ncidi, dimidrad, len=dimlen) + if (dimlen/=numrad) then + write (6,*) 'error: input numrad dimension size does not equal ',numrad; stop + end if +#ifdef AIX + allocate( rbufmlo(numrad,numpftso) ) +#endif + + ! If RTM data exists on input file + ret = nf_inq_varid (ncidi, 'RTM_VOLR_LIQ', varid) + if (ret == NF_NOERR) then + call check_ret (nf90_inq_dimid(ncidi, "rtmlon", dimidrtmlon)) + call check_ret (nf90_inquire_dimension(ncidi, dimidrtmlon, len=dimlen)) + if (dimlen/=rtmlon) then + write (6,*) 'error: input rtmlon does not equal ',rtmlon; stop + end if + call check_ret (nf90_inq_dimid(ncidi, "rtmlat", dimidrtmlat)) + call check_ret (nf90_inquire_dimension(ncidi, dimidrtmlat, len=dimlen)) + if (dimlen/=rtmlat) then + write (6,*) 'error: input rtmlat does not equal ',rtmlat; stop + end if + else + dimidrtmlat = -1 + dimidrtmlon = -1 + end if + ! + ! Check if DGVM data exists on the dataset and if so -- use all PFT data from same grid cell + ! Otherwise use data for the same veg type from potentially different grid-cells + ! + ret = nf90_inq_varid(ncidi, 'present', varid) + if (ret==NF90_ENOTVAR)then + allPFTSfromSameGC = .false. + else if (ret/=NF90_NOERR)then + call handle_error (ret) + else + allPFTSfromSameGC = .true. + end if + + ! For each output pft, find the input pft, pftindx, that is closest + + write(6,*)'finding minimum distance for pfts' + allocate(pftindx(numpftso)) + call findMinDistPFTs( ncidi, ncido, pftindx ) + + ! For each output column, find the input column, colindx, that is closest + + write(6,*)'finding minimum distance for columns' + allocate(colindx(numcolso)) + call findMinDistCols( ncidi, ncido, colindx ) + + ! For each output landunit, find the input landunit, lduindx, that is closest + + write(6,*)'finding minimum distance for landunits' + allocate(lduindx(numlduso)) + call findMinDistLDUs( ncidi, ncido, lduindx ) + + ! Read input initial data and write output initial data + ! Only examing the snow interfaces above zi=0 => zisno and zsno have + ! the same level dimension below + + write(6,*)'reading in initial dataset' + call check_ret (nf90_inquire(ncidi, nVariables=nvars )) + do i = 1, nvars + varid = i + call check_ret (nf_inq_varname(ncidi, varid, varname )) + + ! Skip names that do NOT end in _PERIOD or _VALUE and match + ! specific list of names + if(((index(varname,"_PERIOD" ) == 0 ) .and. & + (index(varname,"_VALUE" ) == 0 )).and. (& + (index(varname,"timemgr_" ) == 1 ) .or. & + (index(varname,"PFT_" ) == 1 ) .or. & + (index(varname,"grid1d_" ) == 1 ) .or. & + (index(varname,"cols1d_" ) == 1 ) .or. & + (index(varname,"pfts1d_" ) == 1 ) .or. & + (index(varname,"land1d_" ) == 1 ) .or. & + (index(varname,"type1d_" ) == 1 ) .or. & + (index(varname,"EFLX_LWRAD_OUT" ) == 1 ) .or. & + (index(varname,"FRAC_VEG_NOSNO_ALB" ) == 1 ) .or. & + (index(varname,"tlai" ) == 1 ) .or. & + (index(varname,"tsai" ) == 1 ) .or. & + (index(varname,"elai" ) == 1 ) .or. & + (index(varname,"esai" ) == 1 ) .or. & + (index(varname,"T_REF" ) == 1 ) .or. & + (index(varname,"TREF" ) == 1 ) .or. & + (index(varname,"RTM_INPUT_LIQ" ) == 1 ) .or. & + (index(varname,"RTM_INPUT_ICE" ) == 1 ) .or. & + (index(varname,"t_ref2m" ) == 1 ) .or. & + (index(varname,"vf_sr" ) == 1 ) .or. & + (index(varname,"vf_wr" ) == 1 ) .or. & + (index(varname,"vf_sw" ) == 1 ) .or. & + (index(varname,"vf_rw" ) == 1 ) .or. & + (index(varname,"vf_ww" ) == 1 ) .or. & + (index(varname,"sabs_roof_dir" ) == 1 ) .or. & + (index(varname,"sabs_roof_dif" ) == 1 ) .or. & + (index(varname,"sabs_sunwall_dir" ) == 1 ) .or. & + (index(varname,"sabs_sunwall_dif" ) == 1 ) .or. & + (index(varname,"sabs_shadewall_dir" ) == 1 ) .or. & + (index(varname,"sabs_shadewall_dif" ) == 1 ) .or. & + (index(varname,"sabs_improad_dir" ) == 1 ) .or. & + (index(varname,"sabs_improad_dif" ) == 1 ) .or. & + (index(varname,"sabs_perroad_dir" ) == 1 ) .or. & + (index(varname,"sabs_perroad_dif" ) == 1 ) .or. & + (index(varname,"fpcgridold" ) == 1 ) .or. & + (index(varname,"locfnh" ) == 1 ) .or. & + (index(varname,"locfnhr" ) == 1 ) ) )then + write (6,*) 'Skipping variable: ', trim(varname) + cycle + end if + + ret = nf90_inq_varid(ncido, varname, varido) + if (ret==NF90_ENOTVAR)then + write (6,*) 'Variable NOT found on output file: ', trim(varname) + cycle + else if (ret/=NF90_NOERR)then + call handle_error (ret) + end if + call check_ret (nf90_inquire_variable( ncidi, varid, xtype=xtype, ndims=ndims, & + dimids=dimids )) + + ! For scalar variables + if ( ndims == 0 ) then + if ( index(varname,"_PERIOD" ) /= 0 .or. trim(varname) == "RTM_NCOUNT" )then + call check_ret(nf90_inq_varid(ncidi, varname, varid)) + call check_ret(nf90_get_var(ncidi, varid, period)) + + ret = nf90_inq_varid(ncido, varname, varid) + if (ret==NF90_ENOTVAR)then + write (6,*) 'Variable NOT found on output file: ', trim(varname) + cycle + else if (ret/=NF90_NOERR)then + call handle_error (ret) + end if + write (6,*) 'PERIOD variable copied over: ', trim(varname) + call check_ret(nf90_put_var(ncido, varid, period)) + else + write (6,*) 'Skipping scalar variable: ', trim(varname) + end if + ! For 1D variables + else if ( ndims == 1 ) then + + if ( dimids(1) == dimidcols )then + nvecin = numcols + nvecout = numcolso + else if ( dimids(1) == dimidpft )then + nvecin = numpfts + nvecout = numpftso + else if ( dimids(1) == dimidldu )then + nvecin = numldus + nvecout = numlduso + else + write (6,*) 'Skip 1D variable with unknown dimension: ', trim(varname) + cycle + end if + + if ( xtype == NF90_INT )then + call interp_sl_int( varname, ncidi, ncido, nvec=nvecin, nveco=nvecout ) + else if ( xtype == NF90_DOUBLE )then + call interp_sl_real( varname, ncidi, ncido, nvec=nvecin, nveco=nvecout ) + else + write (6,*) 'error: variable is not of type double or integer'; stop + end if + + ! For RTM variables + else if ( (dimids(2) == dimidrtmlat) .and. (dimids(1) == dimidrtmlon) )then + + ! Only copy the liquid water in, leave ice alone. This seems to solve problems + ! where the ocean blows up for negative ice flow. + ! An alternative solution that has not been tested, yet, eliminates both "if ( index..." lines + ! so that all RTM variables get mapped from the input to the output file. (slevis) + + ! If anything BUT RTM_VOLR_LIQ -- go to next variable + if ( index(varname,"RTM_VOLR_LIQ" ) /= 1 )then + write (6,*) 'Do NOT copy anything but RTM_VOLR_LIQ: ', trim(varname) + cycle + end if + call check_ret(nf90_inq_varid(ncidi, varname, varid)) + call check_ret(nf90_get_var(ncidi, varid, volr)) + + ret = nf90_inq_varid(ncido, varname, varid) + if (ret==NF90_ENOTVAR)then + write (6,*) 'Variable NOT found on output file: ', trim(varname) + cycle + else if (ret/=NF90_NOERR)then + call handle_error (ret) + end if +#ifdef AIX + !$OMP PARALLEL DO PRIVATE (i,j) + do j = 1, rtmlat + do l = 1, rtmlon + if ( IEEE_IS_NAN(volr(l,j)) ) volr(l,j) = spval + end do + end do + !$OMP END PARALLEL DO +#endif + write (6,*) 'RTM variable copied over: ', trim(varname) + call check_ret(nf90_put_var(ncido, varid, volr)) + + + ! For 2D variables + else if ( ndims == 2 )then + + if ( xtype /= NF90_DOUBLE )then + write (6,*) 'error: 2D variable is not of double type:', trim(varname) + stop + end if + if ( dimids(1) == dimidrad )then +#ifdef AIX + if ( dimids(2) == dimidpft )then + ret = nf90_inq_varid(ncido, varname, varid) + if (ret==NF90_ENOTVAR)then + write (6,*) 'Variable NOT found on output file: ', trim(varname) + cycle + else if (ret/=NF90_NOERR)then + call handle_error (ret) + end if + call check_ret(nf90_get_var(ncido, varid, rbufmlo)) + !$OMP PARALLEL DO PRIVATE (n,k) + do n = 1, numpftso + do k = 1, numrad + if ( IEEE_IS_NAN(rbufmlo(k,n)) ) rbufmlo(k,n) = spval + end do + end do + !$OMP END PARALLEL DO + call check_ret(nf90_put_var(ncido, varid, rbufmlo)) + write (6,*) 'copied and cleaned variable with numrad dimension: ', trim(varname) + else + write (6,*) 'Skipping variable with numrad dimension: ', trim(varname) + end if +#else + write (6,*) 'Skipping variable with numrad dimension: ', trim(varname) +#endif + cycle + end if + if ( dimids(2) /= dimidcols .and. dimids(2) /= dimidpft )then + write (6,*) 'error: variable = ', varname + write (6,*) 'error: variables second dimension is not recognized'; stop + end if + if ( dimids(1) == dimidlak )then + call interp_ml_real(varname, ncidi, ncido, & + nlev=nlevlak, nvec=numcols, nveco=numcolso) + else if ( dimids(1) == dimidtot )then + call interp_ml_real(varname, ncidi, ncido, & + nlev=nlevtot, nvec=numcols, nveco=numcolso) + else if ( dimids(1) == dimidsno )then + call interp_ml_real(varname, ncidi, ncido, & + nlev=nlevsno, nvec=numcols, nveco=numcolso) + else if ( dimids(1) == dimidsno1)then + call interp_ml_real(varname, ncidi, ncido, & + nlev=nlevsno1, nvec=numcols, nveco=numcolso) + else + write (6,*) 'error: variable = ', varname + write (6,*) 'error: variables first dimension is not recognized'; stop + end if + else + write (6,*) 'Skipping variable NOT 1 or 2D: ', trim(varname) + end if + call shr_sys_flush(6) + end do + + ! Close input and output files + + call check_ret(nf90_close( ncidi)) + call check_ret(nf90_close( ncido)) + + write (6,*) ' Successfully created initial condition file mapped from input IC file' + + end subroutine interp_filei + + !======================================================================= + + subroutine findMinDistPFTs( ncidi, ncido, pftindx ) + + ! Find the PFT distances based on the column distances already calculated + + use netcdf + implicit none + + ! ------------------------ arguments --------------------------------- + integer , intent(in) :: ncidi ! input netCdf id + integer , intent(in) :: ncido ! output netCDF id + integer , intent(out) :: pftindx(:) ! vector number + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + real(r8), allocatable :: lati(:) + real(r8), allocatable :: loni(:) + real(r8), allocatable :: cos_lati(:) + real(r8), allocatable :: lato(:) + real(r8), allocatable :: lono(:) + real(r8), allocatable :: cos_lato(:) + integer , allocatable :: ltypei(:) + integer , allocatable :: ltypeo(:) + integer , allocatable :: vtypei(:) + integer , allocatable :: vtypeo(:) + real(r8), allocatable :: wti(:) + real(r8), allocatable :: wto(:) + real(r8) :: dx,dy,distmin,dist + integer :: n,no,nmin,ier + integer :: ret !NetCDF return code + integer :: varid !netCDF variable id + ! -------------------------------------------------------------------- + ! + ! Distances for PFT's to output index no + ! + ier = 0 + allocate (lati(numpfts), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: lati' + call shr_sys_flush(6) + stop + end if + allocate (loni(numpfts), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: loni' + call shr_sys_flush(6) + stop + end if + allocate (cos_lati(numpfts), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: cos_lati' + call shr_sys_flush(6) + stop + end if + allocate (lato(numpftso), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: lato' + call shr_sys_flush(6) + stop + end if + allocate (lono(numpftso), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: lono' + call shr_sys_flush(6) + stop + end if + allocate (cos_lato(numpftso), stat=ier) + if (ier /= 0) then + write(6,*) 'allocation error: cos_lato' + call shr_sys_flush(6) + stop + end if + + allocate (ltypei(numpfts)) + allocate (vtypei(numpfts)) + allocate (wti (numpfts)) + + allocate (ltypeo(numpftso)) + allocate (vtypeo(numpftso)) + allocate (wto (numpftso)) + + ! input + + call check_ret(nf90_inq_varid (ncidi, 'pfts1d_lon', varid)) + call check_ret(nf90_get_var(ncidi, varid, loni)) + + call check_ret(nf90_inq_varid (ncidi, 'pfts1d_lat', varid)) + call check_ret(nf90_get_var(ncidi, varid, lati)) + + call check_ret(nf90_inq_varid(ncidi, 'pfts1d_ityplun', varid)) + call check_ret(nf90_get_var(ncidi, varid, ltypei)) + + call check_ret(nf90_inq_varid( ncidi, 'pfts1d_itypveg', varid)) + call check_ret(nf90_get_var( ncidi, varid, vtypei)) + + call check_ret(nf90_inq_varid (ncidi, 'pfts1d_wtxy', varid)) + call check_ret(nf90_get_var(ncidi, varid, wti)) + + ! output + + call check_ret(nf90_inq_varid (ncido, 'pfts1d_lon', varid)) + call check_ret(nf90_get_var(ncido, varid, lono)) + + call check_ret(nf90_inq_varid (ncido, 'pfts1d_lat', varid)) + call check_ret(nf90_get_var(ncido, varid, lato)) + + call check_ret(nf90_inq_varid(ncido, 'pfts1d_ityplun', varid)) + call check_ret(nf90_get_var(ncido, varid, ltypeo)) + + call check_ret(nf90_inq_varid( ncido, 'pfts1d_itypveg', varid)) + call check_ret(nf90_get_var( ncido, varid, vtypeo)) + + call check_ret(nf90_inq_varid (ncido, 'pfts1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + + do n = 1, numpfts + lati(n) = lati(n)*deg2rad + loni(n) = loni(n)*deg2rad + cos_lati(n) = cos(lati(n)) + end do + + do n = 1, numpftso + lato(n) = lato(n)*deg2rad + lono(n) = lono(n)*deg2rad + cos_lato(n) = cos(lato(n)) + end do + + write(6,*)'numpftso = ',numpftso,' numpfts= ',numpfts + pftindx(:) = 0 + !$OMP PARALLEL DO PRIVATE (no,n,nmin,distmin,dx,dy,dist) + do no = 1,numpftso + if (wto(no)>0.) then + + nmin = 0 + distmin = spval + + do n = 1, numpfts + if (wti(n)>0. .and. (ltypei(n) == ltypeo(no)) ) then + if ( allPFTSfromSameGC .or. & + (ltypeo(no) > istsoil) .or. & + (vtypei(n) == vtypeo(no)) )then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin ) then + distmin = dist + nmin = n + end if + end if + end if + end do + + ! If output pft type is not contained in input dataset, then use closest bare soil pft + if ( override_missing ) then + if (distmin == spval) then + do n = 1, numpfts + if (wti(n) > 0._r8 .and. ltypei(n) == istsoil .and. vtypei(n)==baresoil) then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin )then + distmin = dist + nmin = n + end if + end if + end do + if ( distmin == spval )then + write(*,*) 'findMinDistPFTs: Can not find the closest pft: ',& + ' no,ltypeo,vtypeo=', no,ltypeo(no),vtypeo(no) + stop + end if + end if + end if + + pftindx(no) = nmin + end if ! end if wto>0 block + end do + !$OMP END PARALLEL DO + + deallocate (loni) + deallocate (lono) + deallocate (lati) + deallocate (lato) + deallocate (cos_lati) + deallocate (cos_lato) + deallocate (ltypei) + deallocate (vtypei) + deallocate (wti) + deallocate (ltypeo) + deallocate (vtypeo) + deallocate (wto) + + end subroutine findMinDistPFTs + + !======================================================================= + + subroutine findMinDistCols( ncidi, ncido, colindx ) + + ! Find the minimun column distances excluding columns of different type + + use netcdf + implicit none + + ! ------------------------ arguments --------------------------------- + integer , intent(in) :: ncidi ! input netCdf id + integer , intent(in) :: ncido ! output netCDF id + integer , intent(out) :: colindx(:) ! n = colindx(no) + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + real(r8), allocatable :: lati(:) + real(r8), allocatable :: loni(:) + real(r8), allocatable :: cos_lati(:) + real(r8), allocatable :: lato(:) + real(r8), allocatable :: lono(:) + real(r8), allocatable :: cos_lato(:) + integer , allocatable :: typei(:) + integer , allocatable :: typeo(:) + integer , allocatable :: typei_urb(:) + integer , allocatable :: typeo_urb(:) + real(r8), allocatable :: wti(:) + real(r8), allocatable :: wto(:) + real(r8) :: dx,dy,distmin,dist + integer :: n,no,nmin + integer :: varid + logical :: calcmin + integer :: ret + ! -------------------------------------------------------------------- + + allocate (lati(numcols)) + allocate (lato(numcolso)) + + allocate (loni(numcols)) + allocate (lono(numcolso)) + + allocate (typei_urb(numcols)) + allocate (typeo_urb(numcolso)) + + allocate (cos_lati(numcols)) + allocate (cos_lato(numcolso)) + + allocate (typei(numcols)) + allocate (typeo(numcolso)) + + allocate (wti(numcols)) + allocate (wto(numcolso)) + + ! input + + call check_ret(nf90_inq_varid (ncidi, 'cols1d_lon', varid)) + call check_ret(nf90_get_var(ncidi, varid, loni)) + + call check_ret(nf90_inq_varid (ncidi, 'cols1d_lat', varid)) + call check_ret(nf90_get_var(ncidi, varid, lati)) + + call check_ret(nf90_inq_varid (ncidi, 'cols1d_ityplun', varid)) + call check_ret(nf90_get_var(ncidi, varid, typei)) + + call check_ret(nf90_inq_varid (ncidi, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncidi, varid, wti)) + + call check_ret(nf90_inq_varid( ncidi, 'cols1d_ityp', varid ) ) + call check_ret(nf90_get_var(ncidi, varid, typei_urb)) + + ! output + + call check_ret(nf90_inq_varid (ncido, 'cols1d_lon', varid)) + call check_ret(nf90_get_var(ncido, varid, lono)) + + call check_ret(nf90_inq_varid (ncido, 'cols1d_lat', varid)) + call check_ret(nf90_get_var(ncido, varid, lato)) + + call check_ret(nf90_inq_varid (ncido, 'cols1d_ityplun', varid)) + call check_ret(nf90_get_var(ncido, varid, typeo)) + + call check_ret(nf90_inq_varid (ncido, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + + call check_ret(nf90_inq_varid( ncido, 'cols1d_ityp', varid )) + call check_ret(nf90_get_var(ncido, varid, typeo_urb)) + + do n = 1, numcols + lati(n) = lati(n)*deg2rad + loni(n) = loni(n)*deg2rad + cos_lati(n) = cos(lati(n)) + end do + + do n = 1, numcolso + lato(n) = lato(n)*deg2rad + lono(n) = lono(n)*deg2rad + cos_lato(n) = cos(lato(n)) + end do + + write(6,*)'numcolso = ',numcolso + colindx(:) = 0 + !$OMP PARALLEL DO PRIVATE (no,n,nmin,distmin,dx,dy,dist,calcmin) + do no = 1,numcolso + + if (wto(no) > 0.) then + + distmin = spval + nmin = 0 + + do n = 1, numcols + if (wti(n) > 0.0_r8) then + calcmin = .false. + if (typei_urb(n) == nonurbcol) then + if (typei(n) == typeo(no)) calcmin = .true. + else + if (typei_urb(n) == typeo_urb(no)) calcmin = .true. + end if + end if + if (calcmin) then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin )then + distmin = dist + nmin = n + end if + end if + end do + + ! If input does not have output column type than use closest soil column if override is set + if ( override_missing ) then + if ( distmin == spval )then + do n = 1, numcols + if (wti(n) > 0._r8 .and. typei(n)==istsoil) then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin )then + distmin = dist + nmin = n + end if + end if + end do + if (distmin == spval) then + write(*,*) 'findMinDistCols: Can not find the closest column: no,typeo=',& + no,typeo(no) + stop + end if + end if + end if + + ! Determine input column index (nmin) for the given output no value + colindx(no) = nmin + end if + end do + !$OMP END PARALLEL DO + + deallocate (lati) + deallocate (lato) + deallocate (loni) + deallocate (lono) + deallocate (cos_lati) + deallocate (cos_lato) + deallocate (typei) + deallocate (typeo) + deallocate (wti) + deallocate (wto) + deallocate(typei_urb) + deallocate(typeo_urb) + + end subroutine findMinDistCols + + !======================================================================= + + subroutine findMinDistLDUs( ncidi, ncido, lduindx) + + ! Find the minimun column distances excluding columns of different type + + use netcdf + implicit none + + ! ------------------------ arguments --------------------------------- + integer , intent(in) :: ncidi ! input netCdf id + integer , intent(in) :: ncido ! output netCDF id + integer , intent(out) :: lduindx(:) + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + real(r8), allocatable :: lati(:) + real(r8), allocatable :: loni(:) + real(r8), allocatable :: cos_lati(:) + real(r8), allocatable :: lato(:) + real(r8), allocatable :: lono(:) + real(r8), allocatable :: cos_lato(:) + integer , allocatable :: typei(:) + integer , allocatable :: typeo(:) + real(r8), allocatable :: wti(:) + real(r8), allocatable :: wto(:) + real(r8) :: dx,dy,distmin,dist + integer :: n,no,nmin + integer :: varid + integer :: ret + ! -------------------------------------------------------------------- + + allocate (loni(numldus)) + allocate (lono(numlduso)) + + allocate (lati(numldus)) + allocate (lato(numlduso)) + + allocate (cos_lati(numldus)) + allocate (cos_lato(numlduso)) + + allocate (typei(numldus)) + allocate (typeo(numlduso)) + + allocate (wti(numldus)) + allocate (wto(numlduso)) + + ! input + + call check_ret(nf90_inq_varid (ncidi, 'land1d_lon', varid)) + call check_ret(nf90_get_var (ncidi, varid, loni)) + + call check_ret(nf90_inq_varid (ncidi, 'land1d_lat', varid)) + call check_ret(nf90_get_var (ncidi, varid, lati)) + + call check_ret(nf90_inq_varid( ncidi, 'land1d_ityplun', varid)) + call check_ret(nf90_get_var( ncidi, varid, typei)) + + call check_ret(nf90_inq_varid( ncidi, 'land1d_wtxy', varid)) + call check_ret(nf90_get_var( ncidi, varid, wti)) + + ! output + + call check_ret(nf90_inq_varid (ncido, 'land1d_lon', varid)) + call check_ret(nf90_get_var (ncido, varid, lono)) + + call check_ret(nf90_inq_varid (ncido, 'land1d_lat', varid)) + call check_ret(nf90_get_var (ncido, varid, lato)) + + call check_ret(nf90_inq_varid( ncido, 'land1d_ityplun', varid)) + call check_ret(nf90_get_var( ncido, varid, typeo)) + + call check_ret(nf90_inq_varid( ncido, 'land1d_wtxy', varid)) + call check_ret(nf90_get_var( ncido, varid, wto)) + + do n = 1, numldus + lati(n) = lati(n)*deg2rad + loni(n) = loni(n)*deg2rad + cos_lati(n) = cos(lati(n)) + end do + + do n = 1, numlduso + lato(n) = lato(n)*deg2rad + lono(n) = lono(n)*deg2rad + cos_lato(n) = cos(lato(n)) + end do + + lduindx(:) = 0 + !$OMP PARALLEL DO PRIVATE (no,n,nmin,distmin,dx,dy,dist) + do no = 1,numlduso + + if (wto(no) > 0.) then + distmin = spval + nmin = 0 + + do n = 1, numldus + if ( (wti(n) > 0.0_r8) .and. (typei(n) == typeo(no)) ) then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin ) then + distmin = dist + nmin = n + end if + end if + end do + + ! If input does not output landunit, then use closest soil landunit + if ( override_missing ) then + if ( distmin == spval )then + do n = 1, numldus + if (wti(n) > 0._r8 .and. typei(n) == istsoil) then + dy = abs(lato(no)-lati(n))*re + dx = abs(lono(no)-loni(n))*re * 0.5_r8*(cos_lato(no)+cos_lati(n)) + dist = dx*dx + dy*dy + if ( dist < distmin )then + distmin = dist + nmin = n + end if + end if + end do + end if ! end temporary code + if ( distmin == spval )then + write(*,*) 'findMinDistLDUs: Can not find the closest landunit: ',& + 'no,typeo=', no,typeo(no) + stop + end if + end if + + lduindx(no) = nmin + end if + + end do + !$OMP END PARALLEL DO + + deallocate (loni) + deallocate (lono) + deallocate (lati) + deallocate (lato) + deallocate (cos_lati) + deallocate (cos_lato) + deallocate(typei) + deallocate(typeo) + deallocate(wti) + deallocate(wto) + + end subroutine findMinDistLDUs + + !======================================================================= + + subroutine interp_ml_real (varname, ncidi, ncido, nlev, nvec, nveco) + + use netcdf + implicit none + include 'netcdf.inc' + + ! ------------------------ arguments --------------------------------- + character(len=*), intent(in) :: varname ! input variable name + integer , intent(in) :: ncidi ! input netCdf id + integer , intent(in) :: ncido ! output netCDF id + integer , intent(in) :: nlev ! number of levels + integer , intent(in) :: nvec ! number of points + integer , intent(in) :: nveco ! number of points + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + integer :: n,no ! indices + integer :: varid ! variable id + real(r8), allocatable :: rbufmli (:,:) ! input array + real(r8), allocatable :: rbufmlo (:,:) ! output array + real(r8), allocatable :: wto(:) ! weight + integer :: ret ! netCDF return code + ! -------------------------------------------------------------------- + + allocate (rbufmli(nlev,nvec)) + allocate (rbufmlo(nlev,nveco)) + allocate (wto(nveco)) + + if (nveco == numcolso) then + call check_ret(nf90_inq_varid(ncido, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + else if (nveco == numpftso) then + call check_ret(nf90_inq_varid( ncido, 'pfts1d_wtxy', varid)) + call check_ret(nf90_get_var( ncido, varid, wto)) + end if + + call check_ret(nf90_inq_varid (ncidi, trim(varname), varid)) + call check_ret(nf90_get_var(ncidi, varid, rbufmli)) + call check_ret(nf90_inq_varid (ncido, trim(varname), varid)) + call check_ret(nf90_get_var( ncido, varid, rbufmlo)) + + if (nvec == numcols) then + do no = 1, nveco + if (wto(no)>0._r8) then + n = colindx(no) + if (n > 0) rbufmlo(:,no) = rbufmli(:,n) + end if + end do + else if (nvec == numpfts) then + do no = 1, nveco + if (wto(no)>0._r8) then + n = pftindx(no) + if (n > 0) rbufmlo(:,no) = rbufmli(:,n) + end if + end do + else + write(*,*) 'no data was written: subroutine interp_ml_real' + stop + end if + + call check_ret(nf90_inq_varid (ncido, varname, varid)) + call check_ret(nf90_put_var(ncido, varid, rbufmlo)) + + write(*,*) 'wrote variable ',trim(varname),' to output file' + + deallocate(rbufmli) + deallocate(rbufmlo) + deallocate(wto) + + end subroutine interp_ml_real + + !======================================================================= + + subroutine interp_sl_real (varname, ncidi, ncido, nvec, nveco) + + use netcdf +#ifdef AIX + use IEEE_ARITHMETIC, only: IEEE_IS_NAN +#endif + implicit none + include 'netcdf.inc' + + ! ------------------------ arguments --------------------------------- + character(len=256), intent(in) :: varname ! input variable name + integer , intent(in) :: ncidi ! input netCdf id + integer , intent(in) :: ncido ! output netCDF id + integer , intent(in) :: nvec ! number of points + integer , intent(in) :: nveco ! number of points + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + integer :: i,j,k,n,no,ni,noo,l,g,gg ! indices + integer :: varid ! variable id + integer :: dimid ! dimension id + integer , allocatable :: vtypei(:) + integer , allocatable :: vtypeo(:) + integer , allocatable :: typeo(:) + real(r8), allocatable :: wto(:) + real(r8), allocatable :: rbufsli (:) ! input array + real(r8), allocatable :: rbufslo (:) ! output array + integer :: ret ! NetCDF return code + integer :: num ! number of gridcells NOT normalized + integer :: numgrdso ! number of gridcells on output grid + logical :: htop_var ! If variable name is == htop/hbot + logical :: fpcgrid_var ! If variable name is == fpcgrid + ! -------------------------------------------------------------------- + + allocate (rbufsli(nvec)) + allocate (rbufslo(nveco)) + allocate (wto(nveco)) + + htop_var = .false. + fpcgrid_var = .false. + if (nvec == numpfts) then + if ( trim(varname) == 'htop' ) htop_var = .true. + if ( trim(varname) == 'hbot' ) htop_var = .true. + if ( trim(varname) == 'fpcgrid' ) fpcgrid_var = .true. + end if + if ( htop_var .or. fpcgrid_var )then + allocate (vtypeo(nveco)) + allocate (typeo(nveco)) + end if + + if (nveco == numcolso) then + call check_ret(nf90_inq_varid (ncido, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + else if (nveco == numpftso) then + call check_ret(nf90_inq_varid( ncido, 'pfts1d_wtxy', varid )) + call check_ret(nf90_get_var( ncido, varid, wto)) + if ( htop_var .or. fpcgrid_var )then + call check_ret(nf90_inq_varid (ncido, 'pfts1d_itypveg', varid)) + call check_ret(nf90_get_var(ncido, varid, vtypeo)) + call check_ret(nf90_inq_varid (ncido, 'pfts1d_ityplun', varid)) + call check_ret(nf90_get_var( ncido, varid, typeo)) + end if + else if (nveco == numlduso) then + call check_ret(nf90_inq_varid (ncido, 'land1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + end if + + call check_ret(nf90_inq_varid (ncidi, varname, varid)) + call check_ret(nf90_get_var(ncidi, varid, rbufsli)) + call check_ret(nf90_inq_varid( ncido, varname, varid)) + call check_ret(nf90_get_var( ncido, varid, rbufslo)) + + if ( nvec == numcols )then + + do no = 1, nveco + if (wto(no)>0._r8) then + n = colindx(no) + if (n > 0) rbufslo(no) = rbufsli(n) + end if + end do + + else if ( nvec == numldus )then + + do no = 1, nveco + if (wto(no)>0._r8) then + n = lduindx(no) +#ifdef AIX + if ( IEEE_IS_NAN(rbufsli(n)) ) then + if (n > 0) rbufsli(n) = spval + end if +#endif + if (n > 0) rbufslo(no) = rbufsli(n) + end if + end do + + else if ( nvec == numpfts )then + + do no = 1, nveco + if (wto(no)>0._r8) then + ! + ! If variable-name is htop or fpcgrid + ! + ! NB: fpcgrid and fpcgridold not needed on output file if that + ! file will be used for a startup (not restart) simulation. + ! I think that interpinic is intended for startup runs. + ! + ! However, + ! the fpcgrid interpolation/mapping needs to go on the output + ! file as variable pfts1d_wtcol and/or PFT_WTCOL, which + ! updates fpcgrid and fpcgridold in clm subr pftwt_init. + ! + ! I removed fpcgrid normalization code from here because, + ! if fpcgrid for an output gridcell all comes from a single + ! input gridcell, which it should (check it!), + ! then normalization is unnecessary (slevis). + ! + if ( htop_var )then + ! AND this is non-vegetated land-unit -- set to zero + if( typeo(no) > istsoil .and. typeo(no) < istcrop )then + rbufslo(no) = 0.0_r8 + else + ! Otherwise calculate it from the nearest neighbor + n = pftindx(no) + if (n > 0) rbufslo(no) = rbufsli(n) + end if + else if ( fpcgrid_var )then + ! AND this is not naturally vegetated land-unit -- set to zero + if( typeo(no) > istsoil )then + if (n > 0) rbufslo(no) = 0.0_r8 + else + ! Otherwise calculate it from the nearest neighbor + n = pftindx(no) + if (n > 0) rbufslo(no) = rbufsli(n) + end if + else + ! Otherwise calculate it from the nearest neighbor + n = pftindx(no) +#ifdef AIX + if ( IEEE_IS_NAN(rbufsli(n)) ) then + if (n > 0) rbufsli(n) = spval + end if +#endif + if (n > 0) rbufslo(no) = rbufsli(n) + end if !data type + end if !output data with positive weight + end do !output data land loop + else + write(*,*) 'subroutine interp_sl_real: no data written to variable ',varname + stop + end if + + call check_ret(nf90_inq_varid (ncido, varname, varid)) + call check_ret(nf90_put_var(ncido, varid, rbufslo)) + + write(*,*) 'wrote variable ', trim(varname),' to output initial file' + + deallocate(rbufsli) + deallocate(rbufslo) + + if ( allocated(vtypei) ) deallocate(vtypei) + if ( allocated(vtypeo) ) deallocate(vtypeo) + if ( allocated(typeo) ) deallocate(typeo) + deallocate(wto) + + end subroutine interp_sl_real + + !======================================================================= + + subroutine interp_sl_int (varname, ncidi, ncido, nvec, nveco) + + use netcdf + implicit none + include 'netcdf.inc' + + ! ------------------------ arguments --------------------------------- + character(len=256), intent(in) :: varname + integer , intent(in) :: ncidi + integer , intent(in) :: ncido + integer , intent(in) :: nvec ! number of points + integer , intent(in) :: nveco ! number of points + ! -------------------------------------------------------------------- + + ! ------------------------ local variables -------------------------- + integer :: i,j,k,n,no,ni,noo !indices + integer :: varid !variable id + integer , allocatable :: vtypei(:) + integer , allocatable :: vtypeo(:) + integer , allocatable :: typeo(:) + real(r8), allocatable :: wti(:) + real(r8), allocatable :: wto(:) + integer , allocatable :: ibufsli (:) !input array + integer , allocatable :: ibufslo (:) !output array + integer :: count + integer :: ret !NetCDF return code + logical :: present_var !If variable name is == present + logical :: itypveg_var !If variable name is == itypveg + ! -------------------------------------------------------------------- + + allocate (ibufsli(nvec)) + allocate (ibufslo(nveco)) + allocate (wto(nveco)) + + present_var = .false. + itypveg_var = .false. + if (nvec == numpfts) then + if ( trim(varname) == 'present' ) present_var = .true. + if ( trim(varname) == 'pfts1d_itypveg' ) itypveg_var = .true. + end if + + if (nvec == numcols) then + allocate (wti(nvec)) + call check_ret(nf90_inq_varid (ncidi, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncidi, varid, wti)) + else if (nvec == numpfts) then + if ( present_var .or. itypveg_var )then + allocate (vtypei(nvec)) + call check_ret(nf90_inq_varid (ncidi, 'pfts1d_itypveg', varid)) + call check_ret(nf90_get_var(ncidi, varid, vtypei)) + end if + end if + + if (nveco == numcolso) then + allocate (typeo(nveco)) + call check_ret(nf90_inq_varid (ncido, 'cols1d_ityplun', varid)) + call check_ret(nf90_get_var(ncido, varid, typeo)) + call check_ret(nf90_inq_varid (ncido, 'cols1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + else if (nveco == numpftso) then + allocate (typeo(nveco)) + allocate (vtypeo(nveco)) + if ( present_var .or. itypveg_var )then + call check_ret(nf90_inq_varid (ncido, 'pfts1d_itypveg', varid)) + call check_ret(nf90_get_var(ncido, varid, vtypeo)) + call check_ret(nf90_inq_varid (ncido, 'pfts1d_ityplun', varid)) + call check_ret(nf90_get_var(ncido, varid, typeo)) + call check_ret(nf90_inq_varid (ncido, 'pfts1d_wtxy', varid)) + call check_ret(nf90_get_var(ncido, varid, wto)) + end if + end if + + call check_ret(nf90_inq_varid (ncidi, varname, varid)) + call check_ret(nf90_get_var(ncidi, varid, ibufsli)) + + call check_ret(nf90_inq_varid( ncido, varname, varid)) + call check_ret(nf90_get_var( ncido, varid, ibufslo )) + + if ( nvec == numcols )then + + do no = 1, nveco + if (wto(no)>0._r8) then + n = colindx(no) + if (n > 0) ibufslo(no) = ibufsli(n) + end if + end do + + else if ( nvec == numpfts )then + + do no = 1, nveco + if (wto(no)>0._r8) then + ! If variable-name is present or itypveg + ! AND this is crop or non-vegetated land-unit + if ( (present_var .or. itypveg_var) .and. & + ((vtypeo(no) >= croptype) .or. (typeo(no) > istsoil)) )then + if ( present_var ) ibufslo(no) = 0 + if ( itypveg_var ) ibufslo(no) = vtypeo(no) + ! Otherwise calculate it from the nearest neighbor + else + n = pftindx(no) + if (n > 0) ibufslo(no) = ibufsli(n) + end if !variable type + end if !output data with positive weight + end do !output data land loop + + else + + write(*,*) 'subroutine interp_sl_int: no data written to typeo,vtypeo,no=', & + typeo(no),vtypeo(no),no + stop + + end if + + call check_ret(nf90_inq_varid (ncido, varname, varid)) + call check_ret(nf90_put_var (ncido, varid, ibufslo)) + + write(*,*) 'wrote variable ', trim(varname),' to output file' + + deallocate (ibufsli) + deallocate (ibufslo) + deallocate (wto) + + if ( allocated(vtypei) ) deallocate (vtypei) + if ( allocated(vtypeo) ) deallocate (vtypeo) + if ( allocated(typeo) ) deallocate (typeo) + if ( allocated(wti) ) deallocate (wti) + + end subroutine interp_sl_int + + !======================================================================= + + subroutine addglobal (ncid, cmdline) + + implicit none + include 'netcdf.inc' + + integer, intent(in) :: ncid + character(len=*), intent(in) :: cmdline + + ! ------------------------ local variables ----------------------------- + integer :: ret + integer :: numchars + integer :: values(8) + integer :: hnum + integer :: hlen + character(len= 8) :: date + character(len=10) :: time + character(len= 5) :: zone + character(len=18) :: datetime + character(len=256):: version = & + "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/tools/clm4_0/interpinic/src/interpinic.F90 $" + character(len=256) :: revision_id = "$Id: interpinic.F90 55582 2013-11-23 21:15:59Z erik $" + character(len=16) :: logname + character(len=16) :: hostname + character(len=256) :: str + character(len=1500) :: hist +#ifdef _OPENMP + external :: OMP_GET_MAX_THREADS + integer :: OMP_GET_MAX_THREADS +#endif + !----------------------------------------------------------------------- + + call date_and_time (date, time, zone, values) + + datetime(1:8) = date(5:6) // '/' // date(7:8) // '/' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + + call getenv ('LOGNAME', logname) + call getenv ('HOST', hostname) + + ret = nf_redef( ncid ) + if (ret/=NF_NOERR) call handle_error (ret) + hlen = 0 + hist = ' ' + if (nf_inq_attid (ncid, nf_global, 'history', hnum) == nf_noerr) then + ret = nf_inq_attlen (ncid, nf_global, 'history', hlen) + if (ret/=NF_NOERR) call handle_error (ret) + ret = nf_get_att_text (ncid, nf_global, 'history', hist) + if (ret/=NF_NOERR) call handle_error (ret) + end if + + hist = trim (hist) // char(10) // datetime // trim (logname) // ':' // & + trim (hostname) // ':' // trim (cmdline) + + ! Add "3" to account for first newline and colons between each of 2 trimmed strings + + hlen = hlen + len(datetime) + len_trim(logname) + len_trim(hostname) + len_trim(cmdline) + 3 + + if (hlen > len(hist)) then + write(6,*)'Warning: history attribute too long: truncating' + hlen = len(hist) + end if + + numchars = len_trim (hist) + ret = nf_put_att_text (ncid, nf_global, 'history', numchars, hist) + if (ret/=NF_NOERR) call handle_error (ret) + + write(6,*) "Add SVN_version and Id to global file attributes" + numchars = len_trim (version) + ret = nf_put_att_text (ncid, nf_global, 'interpinic_version', numchars, version) + if (ret/=NF_NOERR) call handle_error (ret) + numchars = len_trim (revision_id) + ret = nf_put_att_text (ncid, nf_global, 'interpinic_version_Id', numchars, revision_id) + if (ret/=NF_NOERR) call handle_error (ret) + +#ifdef _OPENMP + str = 'OMP_NUM_THREADS' + ret = nf_put_att_int (ncid, nf_global, str, NF_INT, 1, & + OMP_GET_MAX_THREADS() ) + if (ret/=NF_NOERR) call handle_error (ret) + str = 'TRUE' +#else + str = 'FALSE' +#endif + numchars = len_trim (str) + ret = nf_put_att_text (ncid, nf_global, 'OpenMP', numchars, str) + if (ret/=NF_NOERR) call handle_error (ret) + +#ifdef OPT + str = 'TRUE' +#else + str = 'FALSE' +#endif + + numchars = len_trim (str) + ret = nf_put_att_text (ncid, nf_global, 'Compiler_Optimized', numchars, str) + if (ret/=NF_NOERR) call handle_error (ret) + + ret = nf_enddef( ncid ) + if (ret/=NF_NOERR) call handle_error (ret) + + end subroutine addglobal + + !======================================================================= + + subroutine check_ret(ret) + implicit none + include 'netcdf.inc' + integer, intent(in) :: ret + if (ret /= NF_NOERR) then + write(6,*)'netcdf error rcode = ', ret,' error = ', NF_STRERROR(ret) + call abort() + end if + end subroutine check_ret + + !======================================================================= + + subroutine handle_error (ret) + implicit none + include 'netcdf.inc' + integer ret + write(6,*) "NetCDF error code = ", ret + write(6,*) nf_strerror (ret) + call abort + end subroutine handle_error + +end module interpinic diff --git a/components/clm/tools/clm4_0/interpinic/src/shr_const_mod.F90 b/components/clm/tools/clm4_0/interpinic/src/shr_const_mod.F90 new file mode 100644 index 0000000000..16529ae9b7 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/shr_const_mod.F90 @@ -0,0 +1,61 @@ +!=============================================================================== +! SVN $Id: shr_const_mod.F90 6749 2007-10-04 20:58:20Z jwolfe $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_100228/shr/shr_const_mod.F90 $ +!=============================================================================== + +MODULE shr_const_mod + + use shr_kind_mod + + integer(SHR_KIND_IN),parameter,private :: R8 = SHR_KIND_R8 ! rename for local readability only + + !---------------------------------------------------------------------------- + ! physical constants (all data public) + !---------------------------------------------------------------------------- + public + + real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi + real(R8),parameter :: SHR_CONST_CDAY = 86400.0_R8 ! sec in calendar day ~ sec + real(R8),parameter :: SHR_CONST_SDAY = 86164.0_R8 ! sec in siderial day ~ sec + real(R8),parameter :: SHR_CONST_OMEGA = 2.0_R8*SHR_CONST_PI/SHR_CONST_SDAY ! earth rot ~ rad/sec + real(R8),parameter :: SHR_CONST_REARTH = 6.37122e6_R8 ! radius of earth ~ m + real(R8),parameter :: SHR_CONST_G = 9.80616_R8 ! acceleration of gravity ~ m/s^2 + + real(R8),parameter :: SHR_CONST_STEBOL = 5.67e-8_R8 ! Stefan-Boltzmann constant ~ W/m^2/K^4 + real(R8),parameter :: SHR_CONST_BOLTZ = 1.38065e-23_R8 ! Boltzmann's constant ~ J/K/molecule + real(R8),parameter :: SHR_CONST_AVOGAD = 6.02214e26_R8 ! Avogadro's number ~ molecules/kmole + real(R8),parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! Universal gas constant ~ J/K/kmole + real(R8),parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole + real(R8),parameter :: SHR_CONST_MWWV = 18.016_R8 ! molecular weight water vapor + real(R8),parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR ! Dry air gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_RWV = SHR_CONST_RGAS/SHR_CONST_MWWV ! Water vapor gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_ZVIR = (SHR_CONST_RWV/SHR_CONST_RDAIR)-1.0_R8 ! RWV/RDAIR - 1.0 + real(R8),parameter :: SHR_CONST_KARMAN = 0.4_R8 ! Von Karman constant + real(R8),parameter :: SHR_CONST_PSTD = 101325.0_R8 ! standard pressure ~ pascals + real(R8),parameter :: SHR_CONST_PDB = 0.0112372_R8 ! ratio of 13C/12C in Pee Dee Belemnite (C isotope standard) + + real(R8),parameter :: SHR_CONST_TKTRIP = 273.16_R8 ! triple point of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZ = 273.15_R8 ! freezing T of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZSW = SHR_CONST_TKFRZ - 1.8_R8 ! freezing T of salt water ~ K + + real(R8),parameter :: SHR_CONST_RHODAIR = & ! density of dry air at STP ~ kg/m^3 + SHR_CONST_PSTD/(SHR_CONST_RDAIR*SHR_CONST_TKFRZ) + real(R8),parameter :: SHR_CONST_RHOFW = 1.000e3_R8 ! density of fresh water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOSW = 1.026e3_R8 ! density of sea water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOICE = 0.917e3_R8 ! density of ice ~ kg/m^3 + real(R8),parameter :: SHR_CONST_CPDAIR = 1.00464e3_R8 ! specific heat of dry air ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPWV = 1.810e3_R8 ! specific heat of water vap ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPVIR = (SHR_CONST_CPWV/SHR_CONST_CPDAIR)-1.0_R8 ! CPWV/CPDAIR - 1.0 + real(R8),parameter :: SHR_CONST_CPFW = 4.188e3_R8 ! specific heat of fresh h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPSW = 3.996e3_R8 ! specific heat of sea h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPICE = 2.11727e3_R8 ! specific heat of fresh ice ~ J/kg/K + real(R8),parameter :: SHR_CONST_LATICE = 3.337e5_R8 ! latent heat of fusion ~ J/kg + real(R8),parameter :: SHR_CONST_LATVAP = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + real(R8),parameter :: SHR_CONST_LATSUB = & ! latent heat of sublimation ~ J/kg + SHR_CONST_LATICE + SHR_CONST_LATVAP + real(R8),parameter :: SHR_CONST_OCN_REF_SAL = 34.7_R8 ! ocn ref salinity (psu) + real(R8),parameter :: SHR_CONST_ICE_REF_SAL = 4.0_R8 ! ice ref salinity (psu) + + real(R8),parameter :: SHR_CONST_SPVAL = 1.0e30_R8 ! special missing value + +END MODULE shr_const_mod diff --git a/components/clm/tools/clm4_0/interpinic/src/shr_kind_mod.F90 b/components/clm/tools/clm4_0/interpinic/src/shr_kind_mod.F90 new file mode 100644 index 0000000000..79ee2fec05 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/shr_kind_mod.F90 @@ -0,0 +1,22 @@ +!=============================================================================== +! SVN $Id: shr_kind_mod.F90 11926 2008-09-25 21:10:40Z mvertens $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_kind_mod.F90 $ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + integer,parameter :: SHR_KIND_CS = 80 ! short char + integer,parameter :: SHR_KIND_CL = 256 ! long char + integer,parameter :: SHR_KIND_CX = 512 ! extra-long char + +END MODULE shr_kind_mod diff --git a/components/clm/tools/clm4_0/interpinic/src/shr_log_mod.F90 b/components/clm/tools/clm4_0/interpinic/src/shr_log_mod.F90 new file mode 100644 index 0000000000..244314a8de --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/shr_log_mod.F90 @@ -0,0 +1,13 @@ +MODULE shr_log_mod + + use shr_kind_mod + + !---------------------------------------------------------------------------- + ! low-level shared variables for logging, these may not be parameters + !---------------------------------------------------------------------------- + public + + integer(SHR_KIND_IN) :: shr_log_Level = 1 + integer(SHR_KIND_IN) :: shr_log_Unit = 6 + +END MODULE shr_log_mod diff --git a/components/clm/tools/clm4_0/interpinic/src/shr_sys_mod.F90 b/components/clm/tools/clm4_0/interpinic/src/shr_sys_mod.F90 new file mode 100644 index 0000000000..500ac40698 --- /dev/null +++ b/components/clm/tools/clm4_0/interpinic/src/shr_sys_mod.F90 @@ -0,0 +1,355 @@ +!=============================================================================== +! SVN $Id: shr_sys_mod.F90 28978 2011-06-27 20:37:05Z jedwards $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_110803/shr/shr_sys_mod.F90 $ +!=============================================================================== + +MODULE shr_sys_mod + + use shr_kind_mod ! defines real & integer kinds + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + +! PUBLIC: Public interfaces + + private + + public :: shr_sys_system ! make a system call + public :: shr_sys_chdir ! change current working dir + public :: shr_sys_getenv ! get an environment variable + public :: shr_sys_abort ! abort a program + public :: shr_sys_irtc ! returns real-time clock tick + public :: shr_sys_sleep ! have program sleep for a while + public :: shr_sys_flush ! flush an i/o buffer + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_system(str,rcode) + + IMPLICIT none + + !----- arguments --- + character(*) ,intent(in) :: str ! system/shell command string + integer(SHR_KIND_IN),intent(out) :: rcode ! function return error code + + !----- functions ----- +#if (defined CRAY) || (defined UNICOSMP) + integer(SHR_KIND_IN),external :: ishell ! function to envoke shell command +#endif +#if (defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__ && !defined CATAMOUNT)) + integer(SHR_KIND_IN),external :: system ! function to envoke shell command +#endif + + !----- local ----- +#if (defined CATAMOUNT) + character(2*SHR_KIND_CL) :: file1 ! one or two filenames + character( SHR_KIND_CL) :: file2 ! 2nd file name + integer(SHR_KIND_IN) :: iloc ! index/location within a string +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_system) ' + character(*),parameter :: F00 = "('(shr_sys_system) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +! NOTE: +! - for Catamount (Cray, pheonix at ORNL) there is no system call -- workarounds +! exist only for simple "rm" and "cp" commands +!------------------------------------------------------------------------------- + + +#if (defined CRAY) || (defined UNICOSMP) + + rcode=ishell(str) + +#elif (defined IRIX64 || defined NEC_SX) + + rcode = 0 + call system(str) + +#elif (defined AIX) + + call system(str,rcode) + +#elif (defined OSF1 || defined SUNOS || defined __GFORTRAN__ || (defined LINUX && !defined CATAMOUNT)) + + rcode = system(str) + +#elif (defined CATAMOUNT) + if (str(1:3) == 'rm ') then + call unlink(str(4:)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT unlink ',trim(str(4:)) + rcode = 0 + elseif (str(1:3) == 'mv ') then + file1 = str(4:) + iloc = index(file1,' ') + 3 + if (iloc < 6) then + if (s_loglev > 0) write(s_logunit,*) 'CATAMOUNT mv error ',trim(str),iloc + rcode = -1 + else + file1 = str(4:iloc) + file2 = str(iloc+1:) + call rename(trim(file1),trim(file2)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT rename ',trim(file1)," ",trim(file2) + rcode = 0 + endif + else + rcode = -1 + endif + +#else + + write(s_logunit,F00) 'ERROR: no implementation of system call for this architecture' + call shr_sys_abort(subName//'no implementation of system call for this architecture') + +#endif + +END SUBROUTINE shr_sys_system + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_chdir(path, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: path ! chdir to this dir + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenpath ! length of path +#if (defined AIX || defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__) || defined NEC_SX) + integer(SHR_KIND_IN),external :: chdir ! AIX system call +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_chdir) ' + character(*),parameter :: F00 = "('(shr_sys_chdir) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenpath=len_trim(path) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfchdir(path, lenpath, rcode) + +#elif (defined AIX) + + rcode = chdir(%ref(path(1:lenpath)//'\0')) + +#elif (defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + rcode=chdir(path(1:lenpath)) + +#else + + write(s_logunit,F00) 'ERROR: no implementation of chdir for this architecture' + call shr_sys_abort(subname//'no implementation of chdir for this machine') + +#endif + +END SUBROUTINE shr_sys_chdir + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_getenv(name, val, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: name ! env var name + character(*) ,intent(out) :: val ! env var value + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenname ! length of env var name + integer(SHR_KIND_IN) :: lenval ! length of env var value + character(SHR_KIND_CL) :: tmpval ! temporary env var value + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_getenv) ' + character(*),parameter :: F00 = "('(shr_sys_getenv) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenname=len_trim(name) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfgetenv(name, lenname, val, lenval, rcode) + +#elif (defined AIX || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + call getenv(trim(name),tmpval) + val=trim(tmpval) + rcode = 0 + if (len_trim(val) == 0 ) rcode = 1 + if (len_trim(val) > SHR_KIND_CL) rcode = 2 + +#else + + write(s_logunit,F00) 'ERROR: no implementation of getenv for this architecture' + call shr_sys_abort(subname//'no implementation of getenv for this machine') + +#endif + +END SUBROUTINE shr_sys_getenv + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_abort(string,rc) + + IMPLICIT none + + character(*) ,optional :: string ! error message string + integer(SHR_KIND_IN),optional :: rc ! error code + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_abort) ' + character(*),parameter :: F00 = "('(shr_sys_abort) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: consistent stopping mechanism +!------------------------------------------------------------------------------- + + call shr_sys_flush(s_logunit) + if (len_trim(string) > 0) write(s_logunit,F00) 'ERROR: '//trim(string) + write(s_logunit,F00) 'WARNING: stopping' + call shr_sys_flush(s_logunit) + call abort() + stop + +END SUBROUTINE shr_sys_abort + +!=============================================================================== +!=============================================================================== + +integer(SHR_KIND_I8) FUNCTION shr_sys_irtc( rate ) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_I8), optional :: rate + + !----- local ----- + integer(SHR_KIND_IN) :: count + integer(SHR_KIND_IN) :: count_rate + integer(SHR_KIND_IN) :: count_max + integer(SHR_KIND_IN),save :: last_count = -1 + integer(SHR_KIND_I8),save :: count_offset = 0 + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_irtc) ' + character(*),parameter :: F00 = "('(shr_sys_irtc) ',4a)" + +!------------------------------------------------------------------------------- +! emulates Cray/SGI irtc function (returns clock tick since last reboot) +!------------------------------------------------------------------------------- + + call system_clock(count=count,count_rate=count_rate, count_max=count_max) + if ( present(rate) ) rate = count_rate + shr_sys_irtc = count + + !--- adjust for clock wrap-around --- + if ( last_count /= -1 ) then + if ( count < last_count ) count_offset = count_offset + count_max + end if + shr_sys_irtc = shr_sys_irtc + count_offset + last_count = count + +END FUNCTION shr_sys_irtc + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_sleep(sec) + + IMPLICIT none + + !----- arguments ----- + real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep + + !----- local ----- + integer(SHR_KIND_IN) :: isec ! integer number of seconds + integer(SHR_KIND_IN) :: rcode ! return code + character(90) :: str ! system call string + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_sleep) ' + character(*),parameter :: F00 = "('(shr_sys_sleep) ',4a)" + character(*),parameter :: F10 = "('sleep ',i8 )" + +!------------------------------------------------------------------------------- +! PURPOSE: Sleep for approximately sec seconds +!------------------------------------------------------------------------------- + + isec = nint(sec) + + if (isec < 0) then + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: seconds must be > 0, sec=',sec + else if (isec == 0) then + ! Don't consider this an error and don't call system sleep + else +#if defined(CATAMOUNT) + call sleep(isec) +#else + write(str,FMT=F10) isec + call shr_sys_system( str, rcode ) +#endif + endif + +END SUBROUTINE shr_sys_sleep + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_flush(unit) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_flush) ' + character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + +#if (defined IRIX64 || defined CRAY || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX || defined UNICOSMP) + + call flush(unit) + +#elif (defined AIX) + + call flush_(unit) + +#else + + if (s_loglev > 0) write(s_logunit,F00) 'WARNING: no implementation of flush for this architecture' + +#endif + +END SUBROUTINE shr_sys_flush + +!=============================================================================== +!=============================================================================== + +END MODULE shr_sys_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/README b/components/clm/tools/clm4_0/mksurfdata_map/README new file mode 100644 index 0000000000..74a99fe9d1 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/README @@ -0,0 +1,65 @@ +components/clm/tools/mksurfdata_map/README Jan 13, 2012 + +The routines in this directory create a surface dataset. +The output grid is read in from the input namelist and +can correspond to either a global or regional grid. + +Supported model resolutions are those found in the repository input data directory + $DIN_LOC_ROOT/lnd/clm2/mappingdata/maps + +Surface datasets can either be created for two separate cases + a) for supported model resolutions + b) for unsupported (user-specified) model resolutions + +The following steps provide a method to create the executable +and generate the surface dataset: + +1) > cd src + > gmake + By default code compiles optimized so it's reasonably fast. If you want + to use the debugger, with bounds-checking, and float trapping on do the + following: + gmake OPT=FALSE + See Also: See the components/clm/tools/README file for notes about setting + the path for NetCDF and running with shared-memory parallelism. + +2) For supported model resolutions - skip this step + + For unsupported model resolutions - do the following... + determine the pathname of the model resolution SCRIP grid file + + > cd mkmapdata + invoke one of the following commands + (for global resolution) + > ./mkmapdata.sh -f -res -type global + (for regional resolution) + > ./mkmapdata.sh -f -res -type regional + > cd ../ + + note: the mapping files generated in ./mkmapdata will be used to + generate the surface dataset + note: the res argument above () MUST be identical to the one provided to + mksurfdata.pl (see below) + +3) make surface dataset(s) + > mksurfdata.pl --help (for full usage instructions) + For supported model resolution () + > mksurfdata.pl -res [options] + + For unsupported, user specified model resolutions + > mksurfdata.pl -res usrspec -usr_gname -usr_gdate + + Note that the argument to usr_gname MUST be the same as the -res argument value + when invoking mkmapdata + + Example, for gridname=1x1_boulderCO with maps created on Jan/13/2012 + + > mksurfdata.pl -res usrspec -usr_gname 1x_boulderCO -usr_gdate 20120113 + +Lists of input files for range of dates historical or future scenarios: + + landuse_timeseries_hist_simyr1850-2005.txt --- List of historical input PFT files from 1850 to 2005 + +(Historical period from 1850-2005 datafiles all point to the historical files, while + the future scenarios 2006-2100 are the scenario datasets) + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt b/components/clm/tools/clm4_0/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt new file mode 100644 index 0000000000..96a1a7d990 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt @@ -0,0 +1,156 @@ +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc 1850 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1851_c090630.nc 1851 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1852_c090630.nc 1852 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1853_c090630.nc 1853 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1854_c090630.nc 1854 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1855_c090630.nc 1855 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1856_c090630.nc 1856 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1857_c090630.nc 1857 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1858_c090630.nc 1858 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1859_c090630.nc 1859 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1860_c090630.nc 1860 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1861_c090630.nc 1861 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1862_c090630.nc 1862 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1863_c090630.nc 1863 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1864_c090630.nc 1864 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1865_c090630.nc 1865 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1866_c090630.nc 1866 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1867_c090630.nc 1867 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1868_c090630.nc 1868 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1869_c090630.nc 1869 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1870_c090630.nc 1870 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1871_c090630.nc 1871 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1872_c090630.nc 1872 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1873_c090630.nc 1873 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1874_c090630.nc 1874 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1875_c090630.nc 1875 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1876_c090630.nc 1876 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1877_c090630.nc 1877 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1878_c090630.nc 1878 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1879_c090630.nc 1879 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1880_c090630.nc 1880 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1881_c090630.nc 1881 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1882_c090630.nc 1882 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1883_c090630.nc 1883 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1884_c090630.nc 1884 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1885_c090630.nc 1885 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1886_c090630.nc 1886 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1887_c090630.nc 1887 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1888_c090630.nc 1888 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1889_c090630.nc 1889 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1890_c090630.nc 1890 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1891_c090630.nc 1891 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1892_c090630.nc 1892 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1893_c090630.nc 1893 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1894_c090630.nc 1894 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1895_c090630.nc 1895 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1896_c090630.nc 1896 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1897_c090630.nc 1897 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1898_c090630.nc 1898 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1899_c090630.nc 1899 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1900_c090630.nc 1900 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1901_c090630.nc 1901 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1902_c090630.nc 1902 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1903_c090630.nc 1903 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1904_c090630.nc 1904 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1905_c090630.nc 1905 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1906_c090630.nc 1906 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1907_c090630.nc 1907 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1908_c090630.nc 1908 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1909_c090630.nc 1909 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1910_c090630.nc 1910 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1911_c090630.nc 1911 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1912_c090630.nc 1912 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1913_c090630.nc 1913 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1914_c090630.nc 1914 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1915_c090630.nc 1915 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1916_c090630.nc 1916 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1917_c090630.nc 1917 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1918_c090630.nc 1918 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1919_c090630.nc 1919 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1920_c090630.nc 1920 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1921_c090630.nc 1921 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1922_c090630.nc 1922 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1923_c090630.nc 1923 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1924_c090630.nc 1924 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1925_c090630.nc 1925 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1926_c090630.nc 1926 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1927_c090630.nc 1927 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1928_c090630.nc 1928 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1929_c090630.nc 1929 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1930_c090630.nc 1930 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1931_c090630.nc 1931 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1932_c090630.nc 1932 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1933_c090630.nc 1933 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1934_c090630.nc 1934 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1935_c090630.nc 1935 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1936_c090630.nc 1936 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1937_c090630.nc 1937 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1938_c090630.nc 1938 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1939_c090630.nc 1939 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1940_c090630.nc 1940 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1941_c090630.nc 1941 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1942_c090630.nc 1942 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1943_c090630.nc 1943 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1944_c090630.nc 1944 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1945_c090630.nc 1945 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1946_c090630.nc 1946 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1947_c090630.nc 1947 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1948_c090630.nc 1948 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1949_c090630.nc 1949 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1950_c090630.nc 1950 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1951_c090630.nc 1951 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1952_c090630.nc 1952 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1953_c090630.nc 1953 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1954_c090630.nc 1954 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1955_c090630.nc 1955 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1956_c090630.nc 1956 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1957_c090630.nc 1957 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1958_c090630.nc 1958 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1959_c090630.nc 1959 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1960_c090630.nc 1960 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1961_c090630.nc 1961 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1962_c090630.nc 1962 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1963_c090630.nc 1963 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1964_c090630.nc 1964 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1965_c090630.nc 1965 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1966_c090630.nc 1966 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1967_c090630.nc 1967 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1968_c090630.nc 1968 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1969_c090630.nc 1969 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1970_c090630.nc 1970 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1971_c090630.nc 1971 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1972_c090630.nc 1972 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1973_c090630.nc 1973 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1974_c090630.nc 1974 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1975_c090630.nc 1975 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1976_c090630.nc 1976 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1977_c090630.nc 1977 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1978_c090630.nc 1978 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1979_c090630.nc 1979 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1980_c090630.nc 1980 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1981_c090630.nc 1981 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1982_c090630.nc 1982 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1983_c090630.nc 1983 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1984_c090630.nc 1984 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1985_c090630.nc 1985 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1986_c090630.nc 1986 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1987_c090630.nc 1987 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1988_c090630.nc 1988 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1989_c090630.nc 1989 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1990_c090630.nc 1990 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1991_c090630.nc 1991 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1992_c090630.nc 1992 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1993_c090630.nc 1993 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1994_c090630.nc 1994 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1995_c090630.nc 1995 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1996_c090630.nc 1996 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1997_c090630.nc 1997 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1998_c090630.nc 1998 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1999_c090630.nc 1999 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2000_c090630.nc 2000 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2001_c090630.nc 2001 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2002_c090630.nc 2002 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2003_c090630.nc 2003 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2004_c090630.nc 2004 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2005_c090630.nc 2005 diff --git a/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl b/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl new file mode 100755 index 0000000000..d9c5f17277 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata.pl @@ -0,0 +1,798 @@ +#!/usr/bin/env perl +# +# Oct/30/2008 Erik Kluzek +# +# mksurfdata.pl Perl script to make surface datasets for all resolutions. +# +# +use Cwd; +use strict; +use English; +use IO::File; +use Getopt::Long; + + +#Figure out where configure directory is and where can use the XML/Lite module from +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +my $cwd = getcwd(); # current working directory +my $scrdir; + +if ($ProgDir) { $scrdir = $ProgDir; } +else { $scrdir = $cwd; } + +#----------------------------------------------------------------------------------------------- +# Add $scrdir to the list of paths that Perl searches for modules +my @dirs = ( $scrdir, "$scrdir/../../../../../cime/utils/perl5lib", + ); +unshift @INC, @dirs; +my $result = eval "require XML::Lite"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"XML/Lite.pm\" from directories: @dirs ** +EOF +} +my $result = eval "require Build::NamelistDefinition"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"Build/NamelistDefinition.pm\" from directories: @dirs ** +EOF +} +my $nldef_file = "$scrdir/../../../bld/namelist_files/namelist_definition_clm4_0.xml"; + +my $definition = Build::NamelistDefinition->new( $nldef_file ); + +my $CSMDATA = "/glade/p/cesm/cseg/inputdata"; + +my %opts = ( + hgrid=>"all", + rcp=>"-999.9", + debug=>0, + exedir=>undef, + allownofile=>undef, + crop=>undef, + hires=>undef, + irrig=>undef, + years=>"1850,2000", + glc_nec=>0, + help=>0, + mv=>0, + old_woodharv=>undef, + irrig=>undef, + pft_override=>undef, + pft_frc=>undef, + pft_idx=>undef, + soil_override=>undef, + soil_cly=>undef, + soil_snd=>undef, + soil_col=>undef, + soil_fmx=>undef, + outnc_double=>undef, + outnc_dims=>"2", + usrname=>"", + usr_mapdir=>"../../shared/mkmapdata", + dynpft=>undef, + csmdata=>$CSMDATA, + ); + +my $numpft = 16; + +#----------------------------------------------------------------------------------------------- +sub usage { + die < [OPTIONS] + -res [or -r] is the supported resolution(s) to use for files (by default $opts{'hgrid'} ). + + + For unsupported, user-specified resolutions: + $ProgName -res usrspec -usr_gname -usr_gdate [OPTIONS] + -usr_gname "user_gname" User resolution name to find grid file with + (only used if -res is set to 'usrspec') + -usr_gdate "user_gdate" User map date to find mapping files with + (only used if -res is set to 'usrspec') + NOTE: all mapping files are assumed to be in mkmapdata + - and the user needs to have invoked mkmapdata in + that directory first + -usr_mapdir "mapdirectory" Directory where the user-supplied mapping files are + Default: $opts{'usr_mapdir'} + +OPTIONS + -allownofile Allow the script to run even if one of the input files + does NOT exist. + -crop Add in crop datasets + -dinlc [or -l] Enter the directory location for inputdata + (default $opts{'csmdata'}) + -debug [or -d] Do not actually run -- just print out what + would happen if ran. + -dynpft "filename" Dynamic PFT/harvesting file to use + (rather than create it on the fly) + (must be consistent with first year) + -glc_nec "number" Number of glacier elevation classes to use (by default $opts{'glc_nec'}) + -hires If you want to use high-resolution input datasets rather + than the default lower resolution datasets + (low resolution is typically at half-degree) + -irrig If you want to include irrigated crop in the output file. + -exedir "directory" Directory where mksurfdata_map program is + (by default assume it is in the current directory) + -mv If you want to move the files after creation to the + correct location in inputdata + (by default -nomv is assumed so files are NOT moved) + -old_woodharv Use the old "bad" wood harvesting (for rcp6 and rcp8.5) + (this is the version that was used for IPCC simulations) + (by default use the new good wood harvest datasets) + -years [or -y] Simulation year(s) to run over (by default $opts{'years'}) + (can also be a simulation year range: i.e. 1850-2000) + -help [or -h] Display this help. + + -rcp [or -c] "rep-con-path" Representative concentration pathway(s) to use for + future scenarios + (by default $opts{'rcp'}, where -999.9 means historical ). + -usrname "clm_usrdat_name" CLM user data name to find grid file with. + + NOTE: years, res, and rcp can be comma delimited lists. + + +OPTIONS to override the mapping of the input gridded data with hardcoded input + + -pft_frc "list of fractions" Comma delimited list of percentages for veg types + -pft_idx "list of veg index" Comma delimited veg index for each fraction + -soil_cly "% of clay" % of soil that is clay + -soil_col "soil color" Soil color (1 [light] to 20 [dark]) + -soil_fmx "soil fmax" Soil maximum saturated fraction (0-1) + -soil_snd "% of sand" % of soil that is sand + +EOF +} + +sub check_soil { +# +# check that the soil options are set correctly +# + foreach my $type ( "soil_cly", "soil_snd" ) { + if ( ! defined($opts{$type} ) ) { + die "ERROR: Soil variables were set, but $type was NOT set\n"; + } + } + #if ( $opts{'soil_col'} < 0 || $opts{'soil_col'} > 20 ) { + # die "ERROR: Soil color is out of range = ".$opts{'soil_col'}."\n"; + #} + my $texsum = $opts{'soil_cly'} + $opts{'soil_snd'}; + my $loam = 100.0 - $texsum; + if ( $texsum < 0.0 || $texsum > 100.0 ) { + die "ERROR: Soil textures are out of range: clay = ".$opts{'soil_cly'}. + " sand = ".$opts{'soil_snd'}." loam = $loam\n"; + } +} + +sub check_soil_col_fmx { +# +# check that the soil color or soil fmax option is set correctly +# + if ( defined($opts{'soil_col'}) ) { + if ( $opts{'soil_col'} < 0 || $opts{'soil_col'} > 20 ) { + die "ERROR: Soil color is out of range = ".$opts{'soil_col'}."\n"; + } + } + if ( defined($opts{'soil_fmx'}) ) { + if ( $opts{'soil_fmx'} < 0.0 || $opts{'soil_fmx'} > 1.0 ) { + die "ERROR: Soil fmax is out of range = ".$opts{'soil_fmx'}."\n"; + } + } +} + +sub check_pft { +# +# check that the pft options are set correctly +# + # Eliminate starting and ending square brackets + $opts{'pft_idx'} =~ s/^\[//; + $opts{'pft_idx'} =~ s/\]$//; + $opts{'pft_frc'} =~ s/^\[//; + $opts{'pft_frc'} =~ s/\]$//; + foreach my $type ( "pft_idx", "pft_frc" ) { + if ( ! defined($opts{$type} ) ) { + die "ERROR: PFT variables were set, but $type was NOT set\n"; + } + } + my @pft_idx = split( /,/, $opts{'pft_idx'} ); + my @pft_frc = split( /,/, $opts{'pft_frc'} ); + if ( $#pft_idx != $#pft_frc ) { + die "ERROR: PFT arrays are different sizes: pft_idx and pft_frc\n"; + } + my $sumfrc = 0.0; + for( my $i = 0; $i <= $#pft_idx; $i++ ) { + # check index in range + if ( $pft_idx[$i] < 0 || $pft_idx[$i] > $numpft ) { + die "ERROR: pft_idx out of range = ".$opts{'pft_idx'}."\n"; + } + # make sure there are no duplicates + for( my $j = 0; $j < $i; $j++ ) { + if ( $pft_idx[$i] == $pft_idx[$j] ) { + die "ERROR: pft_idx has duplicates = ".$opts{'pft_idx'}."\n"; + } + } + # check fraction in range + if ( $pft_frc[$i] <= 0.0 || $pft_frc[$i] > 100.0 ) { + die "ERROR: pft_frc out of range (>0.0 and <=100.0) = ".$opts{'pft_frc'}."\n"; + } + $sumfrc = $sumfrc + $pft_frc[$i]; + } + # check that fraction sums up to 100% + if ( abs( $sumfrc - 100.0) > 1.e-6 ) { + die "ERROR: pft_frc does NOT add up to 100% = ".$opts{'pft_frc'}."\n"; + } + +} + +# Perl trim function to remove whitespace from the start and end of the string +sub trim($) +{ + my $string = shift; + $string =~ s/^\s+//; + $string =~ s/\s+$//; + return $string; +} + +#----------------------------------------------------------------------------------------------- + + my $cmdline = "@ARGV"; + GetOptions( + "allownofile" => \$opts{'allownofile'}, + "r|res=s" => \$opts{'hgrid'}, + "usr_gname=s" => \$opts{'usr_gname'}, + "usr_gdate=s" => \$opts{'usr_gdate'}, + "usr_mapdir=s" => \$opts{'usr_mapdir'}, + "crop" => \$opts{'crop'}, + "irrig" => \$opts{'irrig'}, + "hires" => \$opts{'hires'}, + "c|rcp=s" => \$opts{'rcp'}, + "l|dinlc=s" => \$opts{'csmdata'}, + "d|debug" => \$opts{'debug'}, + "dynpft=s" => \$opts{'dynpft'}, + "y|years=s" => \$opts{'years'}, + "old_woodharv" => \$opts{'old_woodharv'}, + "exedir=s" => \$opts{'exedir'}, + "h|help" => \$opts{'help'}, + "usrname=s" => \$opts{'usrname'}, + "glc_nec=i" => \$opts{'glc_nec'}, + "irrig" => \$opts{'irrig'}, + "mv" => \$opts{'mv'}, + "pft_frc=s" => \$opts{'pft_frc'}, + "pft_idx=s" => \$opts{'pft_idx'}, + "soil_col=i" => \$opts{'soil_col'}, + "soil_fmx=f" => \$opts{'soil_fmx'}, + "soil_cly=f" => \$opts{'soil_cly'}, + "soil_snd=f" => \$opts{'soil_snd'}, + ) or usage(); + + # Check for unparsed arguments + if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); + } + if ( $opts{'help'} ) { + usage(); + } + # If csmdata was changed from the default + if ( $CSMDATA ne $opts{'csmdata'} ) { + $CSMDATA = $opts{'csmdata'}; + } + my $glc_nec = $opts{'glc_nec'}; + # + # Set disk location to send files to, and list resolutions to operate over, + # set filenames, and short-date-name + # + my @hresols; + my $mapdate; + if ( $opts{'hgrid'} eq "all" ) { + my @all_hresols = $definition->get_valid_values( "res" ); + @hresols = @all_hresols; + } elsif ( $opts{'hgrid'} eq "usrspec" ) { + @hresols = $opts{'usr_gname'}; + $mapdate = $opts{'usr_gdate'}; + } else { + @hresols = split( ",", $opts{'hgrid'} ); + # Check that resolutions are valid + foreach my $res ( @hresols ) { + if ( ! $definition->is_valid_value( "res", "'$res'" ) ) { + if ( $opts{'usrname'} eq "" || $res ne $opts{'usrname'} ) { + print "** Invalid resolution: $res\n"; + usage(); + } + } + } + } + # + # Set years to run over + # + my @years = split( ",", $opts{'years'} ); + # Check that resolutions are valid + foreach my $sim_year ( @years ) { + if ( ! $definition->is_valid_value( "sim_year", $sim_year ) ) { + if ( ! $definition->is_valid_value( "sim_year_range", "'$sim_year'" ) ) { + print "** Invalid simulation year or simulation year range: $sim_year\n"; + usage(); + } + } + } + # + # Set rcp to use + # + my @rcpaths = split( ",", $opts{'rcp'} ); + # Check that rcp is valid + foreach my $rcp ( @rcpaths ) { + if ( ! $definition->is_valid_value( "rcp", $rcp ) ) { + if ( ! $definition->is_valid_value( "rcp", "$rcp" ) ) { + print "** Invalid rcp: $rcp\n"; + usage(); + } + } + } + # Check if soil set + if ( defined($opts{'soil_cly'}) || + defined($opts{'soil_snd'}) ) { + &check_soil( ); + $opts{'soil_override'} = 1; + } + # Check if pft set + if ( defined($opts{'crop'}) ) { $numpft = 20; } # First set numpft if crop is on + if ( defined($opts{'pft_frc'}) || defined($opts{'pft_idx'}) ) { + &check_pft( ); + $opts{'pft_override'} = 1; + } + # Check if dynpft set and is valid filename + if ( defined($opts{'dynpft'}) ) { + if ( ! -f $opts{'dynpft'} ) { + print "** Dynamic PFT file does NOT exist: $opts{'dynpft'}\n"; + usage(); + } + } + + my $nl = "namelist"; + my $sdate = "c" . `date +%y%m%d`; + chomp( $sdate ); + + my @ncfiles; + my @lfiles; + my @tsfiles; + my $cfile = "clm.input_data_files"; + if ( -f "$cfile" ) { + `/bin/mv -f $cfile ${cfile}.previous`; + } + my $cfh = IO::File->new; + $cfh->open( ">$cfile" ) or die "** can't open file: $cfile\n"; + system( "\rm -f $cfile" ); + system( "touch $cfile" ); + print $cfh <<"EOF"; +#! /bin/csh -f +set CSMDATA = $CSMDATA +EOF + system( "chmod +x $cfile" ); + my $svnrepo = "https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata"; + my $svnmesg = "Update fsurdat files with mksurfdata_map"; + my $surfdir = "lnd/clm2/surfdata"; + + # + # Loop over all resolutions listed + # + foreach my $res ( @hresols ) { + # + # Query the XML default file database to get the appropriate files + # + my $queryopts, my $queryfilopts; + if ( $opts{'hgrid'} eq "usrspec" ) { + $queryopts = "-csmdata $CSMDATA -silent -justvalue -phys clm4_0"; + } else { + $queryopts = "-res $res -csmdata $CSMDATA -silent -justvalue -phys clm4_0"; + } + $queryfilopts = "$queryopts -onlyfiles "; + my $mkcrop = ""; + my $setnumpft = ""; + if ( defined($opts{'crop'}) ) { + $mkcrop = ",crop='on'"; + $setnumpft = "numpft = $numpft" + } + my $usrnam = ""; + if ( $opts{'usrname'} ne "" && $res eq $opts{'usrname'} ) { + $usrnam = "-usrname ".$opts{'usrname'}; + } + # + # Mapping files + # + my %map; my %hgrd; my %lmsk; my %datfil; + my $hires = "off"; + if ( defined($opts{'hires'}) ) { + $hires = "on"; + } + my $mopts = "$queryopts -namelist default_settings $usrnam"; + my $mkopts = "-csmdata $CSMDATA -silent -justvalue -namelist clmexp $usrnam -phys clm4_0"; + foreach my $typ ( "lak", "veg", "voc", "top", "irr", "tex", "col", + "fmx", "lai", "urb", "org", "glc", "utp", "wet" ) { + my $lmask = `$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ,glc_nec=$glc_nec,hires=$hires -var lmask`; + $lmask = trim($lmask); + my $hgrid = `$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ,glc_nec=$glc_nec,hires=$hires -var hgrid`; + $hgrid = trim($hgrid); + my $filnm = `$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ -var mksrf_filename`; + $filnm = trim($filnm); + $hgrd{$typ} = $hgrid; + $lmsk{$typ} = $lmask; + if ( $opts{'hgrid'} eq "usrspec" ) { + $map{$typ} = $opts{'usr_mapdir'}."/map_${hgrid}_${lmask}_to_${res}_nomask_aave_da_c${mapdate}\.nc"; + } else { + $map{$typ} = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts -namelist clmexp -options frm_hgrid=$hgrid,frm_lmask=$lmask,to_hgrid=$res,to_lmask=nomask -var map`; + } + $map{$typ} = trim($map{$typ}); + if ( $map{$typ} !~ /[^ ]+/ ) { + die "ERROR: could NOT find a mapping file for this resolution: $res and type: $typ at $hgrid and $lmask.\n"; + } + if ( ! defined($opts{'allownofile'}) && ! -f $map{$typ} ) { + die "ERROR: mapping file for this resolution does NOT exist ($map{$typ}).\n"; + } + $datfil{$typ} = `$scrdir/../../../bld/queryDefaultNamelist.pl $mkopts -options hgrid=$hgrid,lmask=$lmask,glc_nec=$glc_nec$mkcrop -var $filnm`; + $datfil{$typ} = trim($datfil{$typ}); + if ( $datfil{$typ} !~ /[^ ]+/ ) { + die "ERROR: could NOT find a $filnm data file for this resolution: $res and type: $typ at $hgrid and $lmask.\n"; + } + if ( ! defined($opts{'allownofile'}) && ! -f $datfil{$typ} ) { + die "ERROR: data file for this resolution does NOT exist ($datfil{$typ}).\n"; + } + if ( $typ eq "irr" && ! defined($opts{'irrig'}) ) { + $map{$typ} = " "; + $datfil{$typ} = " "; + } + } + # + # Grid file from the pft map file or grid if not found + # + my $griddata = trim($map{'veg'}); + if ( $griddata eq "" ) { + $griddata = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $usrnam -var fatmgrid`; + if ( $griddata eq "" ) { + die "ERROR: could NOT find a grid data file for this resolution: $res.\n"; + } + } + my $desc; + my $desc_yr0; + # + # Check if all urban single point dataset + # + my @all_urb = ( "1x1_camdenNJ","1x1_vancouverCAN", "1x1_mexicocityMEX", + "1x1_asphaltjungleNJ", "1x1_urbanc_alpha" ); + my $all_urb = ".false."; + my $urb_pt = 0; + foreach my $urb_res ( @all_urb ) { + if ( $res eq $urb_res ) { + $all_urb = ".true."; + $urb_pt = 1; + } + } + # + # Always run at double precision for output + # + my $double = ".true."; + # + # Loop over each sim_year + # + RCP: foreach my $rcp ( @rcpaths ) { + # + # Loop over each sim_year + # + SIM_YEAR: foreach my $sim_year ( @years ) { + # + # Skip if urban unless sim_year=2000 + # + if ( $urb_pt && $sim_year != 2000 ) { + print "For urban -- skip this simulation year = $sim_year\n"; + next SIM_YEAR; + } + # + # If year is 1850-2000 actually run 1850-2005 + # + if ( $sim_year eq "1850-2000" ) { + my $actual = "1850-2005"; + print "For $sim_year actually run $actual\n"; + $sim_year = $actual; + } + # + # Irrigation dataset + # + my $irrdes = ""; + if ( defined($opts{'irrig'}) ) { + $irrdes = "irrcr_"; + } + # + # Create namelist file + # + my $fh = IO::File->new; + $fh->open( ">$nl" ) or die "** can't open file: $nl\n"; + print "CSMDATA is $CSMDATA \n"; + print $fh <<"EOF"; +&clmexp + nglcec = $glc_nec + mksrf_fgrid = '$griddata' + map_fpft = '$map{'veg'}' + map_fglacier = '$map{'glc'}' + map_fsoicol = '$map{'col'}' + map_furban = '$map{'urb'}' + map_fmax = '$map{'fmx'}' + map_forganic = '$map{'org'}' + map_flai = '$map{'lai'}' + map_fharvest = '$map{'lai'}' + map_flakwat = '$map{'lak'}' + map_fwetlnd = '$map{'wet'}' + map_fvocef = '$map{'voc'}' + map_fsoitex = '$map{'tex'}' + map_firrig = '$map{'irr'}' + map_furbtopo = '$map{'utp'}' + map_flndtopo = '$map{'top'}' + mksrf_fsoitex = '$datfil{'tex'}' + mksrf_forganic = '$datfil{'org'}' + mksrf_flakwat = '$datfil{'lak'}' + mksrf_fwetlnd = '$datfil{'wet'}' + mksrf_fmax = '$datfil{'fmx'}' + mksrf_fglacier = '$datfil{'glc'}' + mksrf_fvocef = '$datfil{'voc'}' + mksrf_furbtopo = '$datfil{'utp'}' + mksrf_flndtopo = '$datfil{'top'}' + mksrf_firrig = '$datfil{'irr'}' + outnc_double = $double + all_urban = $all_urb +EOF + my $urbdesc = "urb3den"; + if ( ! $urb_pt ) { + print $fh <<"EOF"; + mksrf_furban = '$datfil{'urb'}' +EOF + } else { + my $urbdata = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts -var fsurdat -filenameonly`; + if ( $? != 0 ) { + die "ERROR:: furbinp file NOT found\n"; + } + chomp( $urbdata ); + print $fh <<"EOF"; + mksrf_furban = '$CSMDATA/lnd/clm2/surfdata/$urbdata' +EOF + } + + my $resol = ""; + if ( $res ne "1x1_tropicAtl" ) { + $resol = "-res $hgrd{'veg'}"; + } + my $sim_yr0 = $sim_year; + my $sim_yrn = $sim_year; + if ( $sim_year =~ /([0-9]+)-([0-9]+)/ ) { + $sim_yr0 = $1; + $sim_yrn = $2; + } + my $cmd = "$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year=${sim_yr0}$mkcrop -var mksrf_fvegtyp -namelist clmexp"; + my $vegtyp = `$cmd`; + chomp( $vegtyp ); + if ( $vegtyp eq "" ) { + die "** trouble getting vegtyp file with: $cmd\n"; + } + if ( $rcp == -999.9 ) { + $desc = sprintf( "hist_simyr%4.4d-%4.4d", $sim_yr0, $sim_yrn ); + $desc_yr0 = sprintf( "simyr%4.4d", $sim_yr0 ); + } else { + $desc = sprintf( "%s%2.1f_simyr%4.4d-%4.4d", "rcp", $rcp, $sim_yr0, $sim_yrn ); + $desc_yr0 = sprintf( "%s%2.1f_simyr%4.4d", "rcp", $rcp, $sim_yr0 ); + } + my $strlen = 195; + my $dynpft_format = "%-${strlen}.${strlen}s %4.4d\n"; + my $options = ""; + my $crpdes = ""; + if ( $mkcrop ne "" ) { + $options = "-options $mkcrop"; + $crpdes = "mp20_"; + } + my $landuse_timeseries_text_file; + if ( $sim_year ne $sim_yr0 ) { + if ( ! defined($opts{'dynpft'}) && ! $opts{'pft_override'} ) { + $landuse_timeseries_text_file = "landuse_timeseries_$desc.txt"; + my $fh_landuse_timeseries = IO::File->new; + $fh_landuse_timeseries->open( ">$landuse_timeseries_text_file" ) or die "** can't open file: $landuse_timeseries_text_file\n"; + print "Writing out landuse_timeseries text file: $landuse_timeseries_text_file\n"; + + # use new good wood harvest by default: + my $ngwh = ",ngwh=on"; + if ( defined($opts{'old_woodharv'}) ) { + $ngwh = ""; + } + + for( my $yr = $sim_yr0; $yr <= $sim_yrn; $yr++ ) { + my $vegtypyr = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year=$yr,rcp=${rcp}${mkcrop}${ngwh} -var mksrf_fvegtyp -namelist clmexp`; + chomp( $vegtypyr ); + printf $fh_landuse_timeseries $dynpft_format, $vegtypyr, $yr; + if ( $yr % 100 == 0 ) { + print "year: $yr\n"; + } + } + $fh_landuse_timeseries->close; + print "Done writing file\n"; + } elsif ( $opts{'pft_override'} && defined($opts{'dynpft'}) ) { + $landuse_timeseries_text_file = $opts{'dynpft'}; + } else { + $landuse_timeseries_text_file = "landuse_timeseries_override_$desc.txt"; + my $fh_landuse_timeseries = IO::File->new; + $fh_landuse_timeseries->open( ">$landuse_timeseries_text_file" ) or die "** can't open file: $landuse_timeseries_text_file\n"; + my $frstpft = "$opts{'pft_frc'}" . + "$opts{'pft_idx'}" . + "0,0,0,0,00"; + print "Writing out landuse_timeseries text file: $landuse_timeseries_text_file\n"; + if ( (my $len = length($frstpft)) > $strlen ) { + die "ERROR PFT line is too long ($len): $frstpft\n"; + } + printf $fh_landuse_timeseries $dynpft_format, $frstpft, $sim_yr0; + $fh_landuse_timeseries->close; + print "Done writing file\n"; + } + } + + if ( defined($opts{'soil_override'}) ) { + print $fh <<"EOF"; + soil_clay = $opts{'soil_cly'} + soil_sand = $opts{'soil_snd'} +EOF + } + if ( defined($opts{'pft_override'}) ) { + print $fh <<"EOF"; + pft_frc = $opts{'pft_frc'} + pft_idx = $opts{'pft_idx'} +EOF + } + + print $fh <<"EOF"; + mksrf_fvegtyp = '$vegtyp' + mksrf_fsoicol = '$datfil{'col'}' + mksrf_flai = '$datfil{'lai'}' +EOF + my $ofile = "surfdata_${res}_${desc_yr0}_${sdate}"; + print $fh <<"EOF"; + fsurdat = '$ofile.nc' + fsurlog = '$ofile.log' +EOF + + my $ofile_ts = "landuse.timeseries_${res}_${desc}_${sdate}"; + if ( $sim_year ne $sim_yr0 ) { + print $fh <<"EOF"; + mksrf_fdynuse = '$landuse_timeseries_text_file' + fdyndat = '$ofile_ts.nc' +EOF + } else { + print $fh <<"EOF"; + mksrf_fdynuse = ' ' + fdyndat = ' ' +EOF + } + print $fh <<"EOF"; + $setnumpft +/ +EOF + $fh->close; + print "resolution: $res rcp=$rcp sim_year = $sim_year\n"; + print "namelist: $nl\n"; + # + # Print namelist file + $fh->open( "<$nl" ) or die "** can't open file: $nl\n"; + while( $_ = <$fh> ) { + print $_; + } + $fh->close; + # + # Delete previous versions of files that will be created + # + system( "/bin/rm -f $ofile.nc $ofile.log" ); + # + # Run mksurfdata_map with the namelist file + # + my $exedir = $scrdir; + if ( defined($opts{'exedir'}) ) { + $exedir = $opts{'exedir'}; + } + print "$exedir/mksurfdata_map < $nl\n"; + my $filehead; + my $tsfilehead; + if ( ! $opts{'debug'} ) { + system( "$exedir/mksurfdata_map < $nl" ); + if ( $? ) { die "ERROR in mksurfdata_map: $?\n"; } + } else { + $filehead = "surfdata_$res"; + $tsfilehead = "landuse.timeseries_testfile"; + system( "touch $filehead.nc" ); + system( "touch $tsfilehead.nc" ); + system( "touch $filehead.log" ); + } + print "\n===========================================\n\n"; + # + # Check that files were created + # + @ncfiles = glob( "$ofile.nc" ); + if ( $#ncfiles != 0 ) { + die "ERROR surfdata netcdf file was NOT created!\n"; + } + chomp( $ncfiles[0] ); + @lfiles = glob( "$ofile.log" ); + chomp( $lfiles[0] ); + @tsfiles = glob( "$ofile_ts.nc" ); + chomp( $tsfiles[0] ); + if ( $#tsfiles != 0 ) { + die "ERROR surfdata landuse_timeseries netcdf file was NOT created!\n"; + } + # + # If urban point, append grid and frac file on top of surface dataset + # + if ( $urb_pt ) { + my $cmd = "ncks -A $griddata $ncfiles[0]"; + print "$cmd\n"; + if ( ! $opts{'debug'} ) { system( $cmd ); } + my $fracdata = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryopts -var fatmlndfrc`; + if ( $? != 0 ) { + die "ERROR:: fatmlndfrc file NOT found\n"; + } + chomp( $fracdata ); + $cmd = "ncks -A $fracdata $ncfiles[0]"; + print "$cmd\n"; + if ( ! $opts{'debug'} ) { system( $cmd ); } + } + # + # Rename files to CSMDATA + # + my $lsvnmesg = "'$svnmesg $urbdesc $desc'"; + if ( -f "$ncfiles[0]" && -f "$lfiles[0]" ) { + my $outdir = "$CSMDATA/$surfdir"; + my $ofile = "surfdata_${res}_${crpdes}${desc_yr0}_${irrdes}${sdate}"; + my $mvcmd = "/bin/mv -f $ncfiles[0] $outdir/$ofile.nc"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.nc" ); + } + my $mvcmd = "/bin/mv -f $lfiles[0] $outdir/$ofile.log"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.log" ); + } + if ( $opts{'mv'} ) { + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.nc\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.nc " . + "$svnrepo/$surfdir/$ofile.nc\n"; + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.log\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.log " . + "$svnrepo/$surfdir/$ofile.log\n"; + } + # If running a transient case + if ( $sim_year ne $sim_yr0 ) { + $ofile = "landuse.timeseries_${res}_${desc}_${sdate}"; + $mvcmd = "/bin/mv -f $tsfiles[0] $outdir/$ofile.nc"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.nc" ); + } + if ( $opts{'mv'} ) { + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.nc\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.nc " . + "$svnrepo/$surfdir/$ofile.nc\n"; + } + } + + } elsif( ! $opts{'debug'} ) { + die "ERROR files were NOT created: nc=$ncfiles[0] log=$lfiles[0]\n"; + } + if ( (! $opts{'debug'}) && $opts{'mv'} && (-f "$ncfiles[0]" || -f "$lfiles[0]") ) { + die "ERROR files were NOT moved: nc=$ncfiles[0] log=$lfiles[0]\n"; + } + if ( ! $opts{'debug'} ) { + system( "/bin/rm -f $filehead.nc $filehead.log $tsfilehead.nc" ); + } + } # End of sim_year loop + } # End of rcp loop + } + close( $cfh ); + print "Successfully created fsurdat files\n"; diff --git a/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist b/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist new file mode 100644 index 0000000000..06fff09b0c --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/mksurfdata_map.namelist @@ -0,0 +1,40 @@ +&clmexp + nglcec = 0 + mksrf_fgrid = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fpft = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fglacier = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc' + map_fsoicol = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_furban = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fmax = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_fmax_to_10x15_aave_da_110725.nc' + map_forganic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_flai = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fharvest = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_flakwat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fwetlnd = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fvocef = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fsoitex = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc' + map_firrig = ' ' + map_furbtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc' + map_flndtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc' + mksrf_fsoitex = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_soitex.10level.c010119.nc' + mksrf_forganic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_organic.10level.0.5deg.081112.nc' + mksrf_flakwat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_lanwat.050425.nc' + mksrf_fwetlnd = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_lanwat.050425.nc' + mksrf_fmax = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_fmax.070406.nc' + mksrf_fglacier = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000.c120926.nc' + mksrf_fvocef = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_vocef_0.5x0.5_simyr2000.c110531.nc' + mksrf_furbtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_topo.10min.c080912.nc' + mksrf_flndtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/topodata_10min_USGS_071205.nc' + mksrf_firrig = ' ' + outnc_double = .true. + all_urban = .false. + mksrf_furban = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_urban_3den_0.5x0.5_simyr2000.c090223_v1.nc' + mksrf_fvegtyp = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc' + mksrf_fsoicol = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_soilcol_global_c090324.nc' + mksrf_flai = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_lai_global_c090506.nc' + fsurdat = 'surfdata_10x15_simyr1850_c121108.nc' + fsurlog = 'surfdata_10x15_simyr1850_c121108.log' + mksrf_fdynuse = 'landuse_timeseries_hist_simyr1850-2005.txt' + fdyndat = 'landuse.timeseries_10x15_hist_simyr1850-2005_c121108.nc' + +/ diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/Filepath b/components/clm/tools/clm4_0/mksurfdata_map/src/Filepath new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/Filepath @@ -0,0 +1 @@ +. diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile b/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile new file mode 100644 index 0000000000..248a913565 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile @@ -0,0 +1,10 @@ +# Makefile for mksurfdata_map + +EXENAME = ../mksurfdata_map + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +include Makefile.common \ No newline at end of file diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common b/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common new file mode 100644 index 0000000000..bf8c80eed6 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/Makefile.common @@ -0,0 +1,360 @@ +#----------------------------------------------------------------------- +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# These macros can be changed by setting environment variables: +# +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS - Additional CPP defines. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS -- Additional load flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#------------------------------------------------------------------------ + +# Set up special characters +null := + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +RM = rm + +# Check for the netcdf library and include directories +ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include +endif + +ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) +endif + +# Set user specified Fortran compiler +ifneq ($(USER_FC),$(null)) + FC := $(USER_FC) +endif + +# Set user specified C compiler +ifneq ($(USER_CC),$(null)) + CC := $(USER_CC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +CPPDEF := $(USER_CPPDEFS) + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +ifeq ($(OPT),TRUE) + CPPDEF := -DOPT +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +# (the vpath itself is set elsewhere, based on this variable) +vpath_dirs := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +vpath_dirs := $(subst $(space),:,$(vpath_dirs)) + +#Primary Target: build the tool +all: $(EXENAME) + +# Get list of files and build dependency file for all .o files +# using perl scripts mkSrcfiles and mkDepends + +SOURCES := $(shell cat Srcfiles) + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +# Set path to Mkdepends script; assumes that any Makefile including +# this file is in a sibling of the src directory, in which Mkdepends +# resides +Mkdepends := ../src/Mkdepends + +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + $(Mkdepends) Filepath Srcfiles > $@ + + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +CPPDEF += -DAIX +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(CPPDEF)) +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90 -qsuffix=f=f90:cpp=F90 \ + $(FPPFLAGS) -g -qfullpath -qarch=auto -qtune=auto -qsigtrap=xl__trcedump -qsclk=micro + +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdff -lnetcdf +ifneq ($(OPT),TRUE) + FFLAGS += -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en -qspillsize=4000 -C +else + FFLAGS += -O2 -qmaxmem=-1 -Q + LDFLAGS += -Q +endif +CFLAGS := -q64 -g $(CPPDEF) -O2 +FFLAGS += $(cpp_path) +CFLAGS += $(cpp_path) + +ifeq ($(SMP),TRUE) + FC = xlf90_r + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp +else + FC = xlf90 +endif + +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + +# Set the default Fortran compiler +ifeq ($(USER_FC),$(null)) + FC := g95 +endif +ifeq ($(USER_CC),$(null)) + CC := gcc +endif + +CFLAGS := -g -O2 +CPPDEF += -DSYSDARWIN -DDarwin -DLINUX +LDFLAGS := + +ifeq ($(FC),g95) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),gfortran) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) \ + -fno-range-check + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),ifort) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c -ftz -g -fp-model precise $(CPPDEF) $(cpp_path) \ + -convert big_endian -assume byterecl -traceback -FR + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + LDFLAGS += -openmp + endif +endif + +ifeq ($(FC),pgf90) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c $(CPPDEF) $(cpp_path) + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + +endif + +ifeq ($(CC),icc) + CFLAGS += -m64 -g + ifeq ($(SMP),TRUE) + CFLAGS += -openmp + endif +endif +ifeq ($(CC),pgcc) + CFLAGS += -g -fast +endif + +CFLAGS += $(CPPDEF) $(cpp_path) +LDFLAGS += -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := ifort + FCTYP := ifort + else + ifeq ($(USER_FC),ftn) + ifneq ($(USER_FCTYP),$(null)) + FCTYP := $(USER_FCTYP) + else + FCTYP := pgf90 + endif + else + FCTYP := $(USER_FC) + endif + endif + CPPDEF += -DLINUX -DFORTRANUNDERSCORE + CFLAGS := $(CPPDEF) + LDFLAGS := $(shell $(LIB_NETCDF)/../bin/nf-config --flibs) + FFLAGS = + + ifeq ($(FCTYP),pgf90) + CC := pgcc + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + CFLAGS += -fast + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + + endif + + ifeq ($(FCTYP),lf95) + ifneq ($(OPT),TRUE) + FFLAGS += -g --chk a,e,s,u -O0 + else + FFLAGS += -O + endif + # Threading only works by putting thread memory on the heap rather than the stack + # (--threadheap). + # As of lf95 version 6.2 the thread stacksize limits are (still) too small to run + # even small + # resolution problems (FV at 10x15 res fails). + ifeq ($(SMP),TRUE) + FFLAGS += --openmp --threadheap 4096 + LDFLAGS += --openmp --threadheap 4096 + endif + endif + ifeq ($(FCTYP),pathf90) + FFLAGS += -extend_source -ftpp -fno-second-underscore + ifneq ($(OPT),TRUE) + FFLAGS += -g -O0 + else + FFLAGS += -O + endif + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + endif + ifeq ($(FCTYP),ifort) + + FFLAGS += -ftz -g -fp-model precise -convert big_endian -assume byterecl -traceback -FR + CFLAGS += -m64 -g + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + CFLAGS += -openmp + LDFLAGS += -openmp + endif + endif + FFLAGS += -c -I$(INC_NETCDF) $(CPPDEF) $(cpp_path) + CFLAGS += $(cpp_path) +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Set the vpath for all file types EXCEPT .o +# We do this for individual file types rather than generally using +# VPATH, because for .o files, we don't want to use files from a +# different build (e.g., in building the unit tester, we don't want to +# use .o files from the main build) +vpath %.F90 $(vpath_dirs) +vpath %.c $(vpath_dirs) +vpath %.h $(vpath_dirs) + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifneq ($(USER_LINKER),$(null)) + LINKER := $(USER_LINKER) +else + LINKER := $(FC) +endif + +.F90.o: + $(FC) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod Depends + +include $(CURDIR)/Depends diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/Mkdepends b/components/clm/tools/clm4_0/mksurfdata_map/src/Mkdepends new file mode 100755 index 0000000000..a75e8fdde0 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/Mkdepends @@ -0,0 +1,327 @@ +#!/usr/bin/env perl + +# Generate dependencies in a form suitable for inclusion into a Makefile. +# The source filenames are provided in a file, one per line. Directories +# to be searched for the source files and for their dependencies are provided +# in another file, one per line. Output is written to STDOUT. +# +# For CPP type dependencies (lines beginning with #include) the dependency +# search is recursive. Only dependencies that are found in the specified +# directories are included. So, for example, the standard include file +# stdio.h would not be included as a dependency unless /usr/include were +# one of the specified directories to be searched. +# +# For Fortran module USE dependencies (lines beginning with a case +# insensitive "USE", possibly preceded by whitespace) the Fortran compiler +# must be able to access the .mod file associated with the .o file that +# contains the module. In order to correctly generate these dependencies +# two restrictions must be observed. +# 1) All modules must be contained in files that have the same base name as +# the module, in a case insensitive sense. This restriction implies that +# there can only be one module per file. +# 2) All modules that are to be contained in the dependency list must be +# contained in one of the source files in the list provided on the command +# line. +# The reason for the second restriction is that since the makefile doesn't +# contain rules to build .mod files the dependency takes the form of the .o +# file that contains the module. If a module is being used for which the +# source code is not available (e.g., a module from a library), then adding +# a .o dependency for that module is a mistake because make will attempt to +# build that .o file, and will fail if the source code is not available. +# +# Author: B. Eaton +# Climate Modelling Section, NCAR +# Feb 2001 + +use Getopt::Std; +use File::Basename; + +# Check for usage request. +@ARGV >= 2 or usage(); + +# Process command line. +my %opt = (); +getopts( "t:w", \%opt ) or usage(); +my $filepath_arg = shift() or usage(); +my $srcfile_arg = shift() or usage(); +@ARGV == 0 or usage(); # Check that all args were processed. + +my $obj_dir; +if ( defined $opt{'t'} ) { $obj_dir = $opt{'t'}; } + +open(FILEPATH, $filepath_arg) or die "Can't open $filepath_arg: $!\n"; +open(SRCFILES, $srcfile_arg) or die "Can't open $srcfile_arg: $!\n"; + +# Make list of paths to use when looking for files. +# Prepend "." so search starts in current directory. This default is for +# consistency with the way GNU Make searches for dependencies. +my @file_paths = ; +close(FILEPATH); +chomp @file_paths; +unshift(@file_paths,'.'); +foreach $dir (@file_paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Make list of files containing source code. +my @src = ; +close(SRCFILES); +chomp @src; + +# For each file that may contain a Fortran module (*.[fF]90 *.[fF]) convert the +# file's basename to uppercase and use it as a hash key whose value is the file's +# basename. This allows fast identification of the files that contain modules. +# The only restriction is that the file's basename and the module name must match +# in a case insensitive way. +my %module_files = (); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.[fF]90', '\.[fF]' ); +foreach $f (@src) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $module_files{$mod} = $name; +} + +# Now make a list of .mod files in the file_paths. If a .o source dependency +# can't be found based on the module_files list above, then maybe a .mod +# module dependency can if the mod file is visible. +my %trumod_files = (); +my ($dir); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.mod' ); +foreach $dir (@file_paths) { + @filenames = (glob("$dir/*.mod")); + foreach $f (@filenames) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $trumod_files{$mod} = $name; + } +} + +#print STDERR "\%module_files\n"; +#while ( ($k,$v) = each %module_files ) { +# print STDERR "$k => $v\n"; +#} + +# Find module and include dependencies of the source files. +my ($file_path, $rmods, $rincs); +my %file_modules = (); +my %file_includes = (); +my @check_includes = (); +foreach $f ( @src ) { + + # Find the file in the seach path (@file_paths). + unless ($file_path = find_file($f)) { + if (defined $opt{'w'}) {print STDERR "$f not found\n";} + next; + } + + # Find the module and include dependencies. + ($rmods, $rincs) = find_dependencies( $file_path ); + + # Remove redundancies (a file can contain multiple procedures that have + # the same dependencies). + $file_modules{$f} = rm_duplicates($rmods); + $file_includes{$f} = rm_duplicates($rincs); + + # Make a list of all include files. + push @check_includes, @{$file_includes{$f}}; +} + +#print STDERR "\%file_modules\n"; +#while ( ($k,$v) = each %file_modules ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\@check_includes\n"; +#print STDERR "@check_includes\n"; + +# Find include file dependencies. +my %include_depends = (); +while (@check_includes) { + $f = shift @check_includes; + if (defined($include_depends{$f})) { next; } + + # Mark files not in path so they can be removed from the dependency list. + unless ($file_path = find_file($f)) { + $include_depends{$f} = -1; + next; + } + + # Find include file dependencies. + ($rmods, $include_depends{$f}) = find_dependencies($file_path); + + # Add included include files to the back of the check_includes list so + # that their dependencies can be found. + push @check_includes, @{$include_depends{$f}}; + + # Add included modules to the include_depends list. + if ( @$rmods ) { push @{$include_depends{$f}}, @$rmods; } +} + +#print STDERR "\%include_depends\n"; +#while ( ($k,$v) = each %include_depends ) { +# print STDERR (ref $v ? "$k => @$v\n" : "$k => $v\n"); +#} + +# Remove include file dependencies that are not in the Filepath. +my $i, $ii; +foreach $f (keys %include_depends) { + + unless (ref $include_depends{$f}) { next; } + $rincs = $include_depends{$f}; + unless (@$rincs) { next; } + $ii = 0; + $num_incs = @$rincs; + for ($i = 0; $i < $num_incs; ++$i) { + if ($include_depends{$$rincs[$ii]} == -1) { + splice @$rincs, $ii, 1; + next; + } + ++$ii; + } +} + +# Substitute the include file dependencies into the %file_includes lists. +foreach $f (keys %file_includes) { + my @expand_incs = (); + + # Initialize the expanded %file_includes list. + my $i; + unless (@{$file_includes{$f}}) { next; } + foreach $i (@{$file_includes{$f}}) { + push @expand_incs, $i unless ($include_depends{$i} == -1); + } + unless (@expand_incs) { + $file_includes{$f} = []; + next; + } + + # Expand + for ($i = 0; $i <= $#expand_incs; ++$i) { + push @expand_incs, @{ $include_depends{$expand_incs[$i]} }; + } + + $file_includes{$f} = rm_duplicates(\@expand_incs); +} + +#print STDERR "expanded \%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} + +# Print dependencies to STDOUT. +foreach $f (sort keys %file_modules) { + $f =~ /(.+)\./; + $target = "$1.o"; + if ( defined $opt{'t'} ) { $target = "$opt{'t'}/$1.o"; } + print "$target : $f @{$file_modules{$f}} @{$file_includes{$f}}\n"; +} + +#-------------------------------------------------------------------------------------- + +sub find_dependencies { + + # Find dependencies of input file. + # Use'd Fortran 90 modules are returned in \@mods. + # Files that are "#include"d by the cpp preprocessor are returned in \@incs. + + my( $file ) = @_; + my( @mods, @incs ); + + open(FH, $file) or die "Can't open $file: $!\n"; + + while ( ) { + # Search for "#include" and strip filename when found. + if ( /^#include\s+[<"](.*)[>"]/ ) { + push @incs, $1; + } + # Search for Fortran include dependencies. + elsif ( /^\s*include\s+['"](.*)['"]/ ) { #" for emacs fontlock + push @incs, $1; + } + # Search for module dependencies. + elsif ( /^\s*USE\s+(\w+)/i ) { + ($module = $1) =~ tr/a-z/A-Z/; + # Return dependency in the form of a .o version of the file that contains + # the module. this is from the source list. + if ( defined $module_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$module_files{$module}.o"; + } else { + push @mods, "$module_files{$module}.o"; + } + } + # Return dependency in the form of a .mod version of the file that contains + # the module. this is from the .mod list. only if .o version not found + elsif ( defined $trumod_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$trumod_files{$module}.mod"; + } else { + push @mods, "$trumod_files{$module}.mod"; + } + } + } + } + close( FH ); + return (\@mods, \@incs); +} + +#-------------------------------------------------------------------------------------- + +sub find_file { + +# Search for the specified file in the list of directories in the global +# array @file_paths. Return the first occurance found, or the null string if +# the file is not found. + + my($file) = @_; + my($dir, $fname); + + foreach $dir (@file_paths) { + $fname = "$dir/$file"; + if ( -f $fname ) { return $fname; } + } + return ''; # file not found +} + +#-------------------------------------------------------------------------------------- + +sub rm_duplicates { + +# Return a list with duplicates removed. + + my ($in) = @_; # input arrary reference + my @out = (); + my $i; + my %h = (); + foreach $i (@$in) { + $h{$i} = ''; + } + @out = keys %h; + return \@out; +} + +#-------------------------------------------------------------------------------------- + +sub usage { + ($ProgName = $0) =~ s!.*/!!; # name of program + die < shr_kind_r8 + use clm_varpar, only: maxpatch_glcmec +! +! +! !PUBLIC MEMBER FUNCTIONS: + implicit none + public :: set_clmvarctl ! Set variables + public :: clmvarctl_init ! Initialize and check values after namelist input + + private + save +! +! !PUBLIC TYPES: +! + integer, parameter, private :: iundef = -9999999 + integer, parameter, private :: rundef = -9999999._r8 +! +! Run control variables +! + character(len=256), public :: caseid = ' ' ! case id + character(len=256), public :: ctitle = ' ' ! case title + integer, public :: nsrest = iundef ! Type of run + integer, public, parameter :: nsrStartup = 0 ! Startup from initial conditions + integer, public, parameter :: nsrContinue = 1 ! Continue from restart files + integer, public, parameter :: nsrBranch = 2 ! Branch from restart files + logical, public :: brnch_retain_casename = .false. ! true => allow case name to remain the same for branch run + ! by default this is not allowed + logical, public :: noland = .false. ! true => no valid land points -- do NOT run + character(len=256), public :: hostname = ' ' ! Hostname of machine running on + character(len=256), public :: username = ' ' ! username of user running program + character(len=256), public :: source = "Community Land Model CLM4.0" ! description of this source + character(len=256), public :: version = " " ! version of program + character(len=256), public :: conventions = "CF-1.0" ! dataset conventions +! +! Unit Numbers +! + integer, public :: iulog = 6 ! "stdout" log file unit number, default is 6 +! +! Output NetCDF files +! + logical, public :: outnc_large_files = .true. ! large file support for output NetCDF files +! +! Run input files +! + character(len=256), public :: finidat = ' ' ! initial conditions file name + character(len=256), public :: fsurdat = ' ' ! surface data file name + character(len=256), public :: fatmgrid = ' ' ! atm grid file name + character(len=256), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid + character(len=256), public :: fatmtopo = ' ' ! topography on atm grid + character(len=256), public :: flndtopo = ' ' ! topography on lnd grid + character(len=256), public :: flanduse_timeseries = ' ' ! dynamic landuse dataset + character(len=256), public :: fpftcon = ' ' ! ASCII data file with PFT physiological constants + character(len=256), public :: nrevsn = ' ' ! restart data file name for branch run + character(len=256), public :: fsnowoptics = ' ' ! snow optical properties file name + character(len=256), public :: fsnowaging = ' ' ! snow aging parameters file name + character(len=256), public :: fglcmask = ' ' ! glacier mask file name + logical , public :: downscale ! true => do downscaling with fine mesh + ! ASSUMES that all grids are lat/lon +! +! Landunit logic +! + logical, public :: create_crop_landunit = .false. ! true => separate crop landunit is not created by default + logical, public :: allocate_all_vegpfts = .false. ! true => allocate memory for all possible vegetated pfts on + ! vegetated landunit if at least one pft has nonzero weight +! +! BGC logic and datasets +! + character(len=16), public :: co2_type = 'constant' ! values of 'prognostic','diagnostic','constant' +! +! Physics +! + logical, public :: wrtdia = .false. ! true => write global average diagnostics to std out + real(r8), public :: co2_ppmv = 355._r8 ! atmospheric CO2 molar ratio (by volume) (umol/mol) + +! glacier_mec control variables: default values (may be overwritten by namelist) +! NOTE: glc_nec and glc_smb must have the same values for CLM and GLC + + logical, public :: create_glacier_mec_landunit = .false. ! glacier_mec landunit is not created + logical, public :: glc_dyntopo = .false. ! true => CLM glacier topography changes dynamically + logical, public :: glc_smb = .false. ! if true, pass surface mass balance info to GLC + ! if false, pass positive-degree-day info to GLC + integer , public :: glc_nec = 0 ! number of elevation classes for glacier_mec landunits + real(r8), public :: glc_topomax(0:maxpatch_glcmec) ! upper limit of each class (m) +! +! single column control variables +! + logical, public :: single_column = .false. ! true => single column mode + real(r8), public:: scmlat = rundef ! single column lat + real(r8), public:: scmlon = rundef ! single column lon +! +! instance control +! + integer, public :: inst_index + character(len=16), public :: inst_name + character(len=16), public :: inst_suffix +#ifdef RTM +! +! Rtm control variables +! + character(len=256), public :: frivinp_rtm = ' ' ! RTM input data file name + integer, public :: rtm_nsteps = iundef ! if > 1, average rtm over rtm_nsteps time steps + logical, public :: ice_runoff = .true. ! true => runoff is split into liquid and ice + ! otherwise just liquid + character(len=256), public :: fmapinp_rtm = ' ' ! mapping file from clm to rtm grid + ! if blank - then rtm calculates the mapping matrix at runtime +#endif +! +! Decomp control variables +! + integer, public :: nsegspc = 20 ! number of segments per clump for decomp +! +! Derived variables (run, history and restart file) +! + character(len=256), public :: rpntdir = '.' ! directory name for local restart pointer file + character(len=256), public :: rpntfil = 'rpointer.lnd' ! file name for local restart pointer file +! +! Error growth perturbation limit +! + real(r8), public :: pertlim = 0.0_r8 ! perturbation limit when doing error growth test +! +! !PRIVATE DATA MEMBERS: +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein and Gordon Bonan +! 1 June 2004, Peter Thornton: added fnedpdat for nitrogen deposition data +! +!EOP +!----------------------------------------------------------------------- + logical, private :: clmvarctl_isset = .false. + +!=============================================================== +contains +!=============================================================== + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: set_clmvarctl +! +! !INTERFACE: + subroutine set_clmvarctl( caseid_in, ctitle_in, brnch_retain_casename_in, & + single_column_in, scmlat_in, scmlon_in, nsrest_in, & + version_in, hostname_in, username_in) +! +! !DESCRIPTION: +! Set input control variables. +! +! !USES: + use shr_sys_mod, only : shr_sys_abort +! +! !ARGUMENTS: + character(len=256), optional, intent(IN) :: caseid_in ! case id + character(len=256), optional, intent(IN) :: ctitle_in ! case title + logical, optional, intent(IN) :: brnch_retain_casename_in ! true => allow case name to remain the same for branch run + logical, optional, intent(IN) :: single_column_in ! true => single column mode + real(r8), optional, intent(IN) :: scmlat_in ! single column lat + real(r8), optional, intent(IN) :: scmlon_in ! single column lon + integer, optional, intent(IN) :: nsrest_in ! 0: initial run. 1: restart: 3: branch + character(len=256), optional, intent(IN) :: version_in ! model version + character(len=256), optional, intent(IN) :: hostname_in ! hostname running on + character(len=256), optional, intent(IN) :: username_in ! username running job + +! +! !LOCAL VARIABLES: + character(len=32) :: subname = 'set_clmvarctl' ! subroutine name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + if ( clmvarctl_isset )then + call shr_sys_abort( subname//' ERROR:: control variables already set -- can not call this subroutine' ) + end if + if ( present(caseid_in ) ) caseid = caseid_in + if ( present(ctitle_in ) ) ctitle = ctitle_in + if ( present(single_column_in) ) single_column = single_column_in + if ( present(scmlat_in ) ) scmlat = scmlat_in + if ( present(scmlon_in ) ) scmlon = scmlon_in + if ( present(nsrest_in ) ) nsrest = nsrest_in + if ( present(brnch_retain_casename_in) ) brnch_retain_casename = brnch_retain_casename_in + if ( present(version_in ) ) version = version_in + if ( present(username_in ) ) username = username_in + if ( present(hostname_in ) ) hostname = hostname_in + + end subroutine set_clmvarctl + +!--------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: clmvarctl_init +! +! !INTERFACE: + subroutine clmvarctl_init( masterproc, dtime ) +! +! !DESCRIPTION: +! Check that values are correct, and finish setting variables based on other variables. +! +! !USES: + use shr_sys_mod , only : shr_sys_abort + use clm_varpar , only : maxpatch_pft, numpft +! +! !ARGUMENTS: + logical, intent(IN) :: masterproc ! proc 0 logical for printing msgs + integer, intent(IN) :: dtime ! timestep in seconds +! +! !LOCAL VARIABLES: + character(len=32) :: subname = 'clmvarctl_init' ! subroutine name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!EOP +!----------------------------------------------------------------------- + + ! landunit generation + + if (maxpatch_pft == numpft+1) then + allocate_all_vegpfts = .true. + else + allocate_all_vegpfts = .false. +#ifdef CROP + write(iulog,*)'maxpatch_pft = ',maxpatch_pft,' does NOT equal numpft+1 = ', & + numpft+1 + call shr_sys_abort( subname//' ERROR:: Can NOT turn CROP on without all PFTs' ) +#endif + end if + + if (masterproc) then + + ! Consistency settings for co2 type + + if (co2_type /= 'constant' .and. co2_type /= 'prognostic' .and. co2_type /= 'diagnostic') then + write(iulog,*)'co2_type = ',co2_type,' is not supported' + call shr_sys_abort( subname//' ERROR:: choices are constant, prognostic or diagnostic' ) + end if + + ! Consistency settings for dynamic land use, etc. + + if (flanduse_timeseries /= ' ' .and. create_crop_landunit) & + call shr_sys_abort( subname//' ERROR:: dynamic landuse is currently not supported with create_crop_landunit option' ) + if (create_crop_landunit .and. .not.allocate_all_vegpfts) & + call shr_sys_abort( subname//' ERROR:: maxpft 3000.0_r8) ) & + call shr_sys_abort( subname//' ERROR: co2_ppmv is out of a reasonable range' ) + + if (nsrest == nsrStartup ) nrevsn = ' ' + if (nsrest == nsrContinue) nrevsn = 'set by restart pointer file file' + if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) & + call shr_sys_abort( subname//' ERROR: nsrest NOT set to a valid value' ) + + if ( single_column .and. (scmlat == rundef .or. scmlon == rundef ) ) & + call shr_sys_abort( subname//' ERROR:: single column mode on -- but scmlat and scmlon are NOT set' ) + + endif ! end of if-masterproc if-block + + clmvarctl_isset = .true. + + end subroutine clmvarctl_init + +end module clm_varctl diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/clm_varpar.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/clm_varpar.F90 new file mode 100644 index 0000000000..eb1fd7412a --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/clm_varpar.F90 @@ -0,0 +1,145 @@ +module clm_varpar + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +! +! Define land surface 2-d grid. The model resolution is read in from the surface dataset +! + integer :: lsmlon ! maximum number of longitude points on lsm grid + integer :: lsmlat ! number of latitude points on lsm grid + +! Define number of levels + + integer, parameter :: nlevsoi = 10 ! number of hydrologically active soil layers + integer, parameter :: nlevgrnd = 15 ! number of ground layers (includes lower layers that are hydrologically inactive) + integer, parameter :: nlevurb = nlevgrnd! number of urban layers (must equal nlevgrnd right now) + integer, parameter :: nlevlak = 10 ! number of lake layers + integer, parameter :: nlevsno = 5 ! maximum number of snow layers + +! Define miscellaneous parameters + + integer, parameter :: numwat = 5 ! number of water types (soil, ice, 2 lakes, wetland) + integer, parameter :: numrad = 2 ! number of solar radiation bands: vis, nir + integer, parameter :: ivis = 1 ! index for visible band + integer, parameter :: inir = 2 ! index for near-infrared band + integer, parameter :: numsolar = 2 ! number of solar type bands: direct, diffuse + integer, parameter :: ndst = 4 ! number of dust size classes (BGC only) + integer, parameter :: dst_src_nbr = 3 ! number of size distns in src soil (BGC only) + integer, parameter :: sz_nbr = 200 ! number of sub-grid bins in large bin of dust size distribution (BGC only) + integer, parameter :: nvoc = 5 ! number of voc categories + +! Define parameters for RTM river routing model + + integer :: rtmlon !number of rtm longitudes + integer :: rtmlat !number of rtm latitudes + +! Define indices used in surface file read +! maxpatch_pft = max number of plant functional types in naturally vegetated landunit +! maxpatch_urb = max number of urban pfts (columns) in urban landunit +! maxpatch_wet = max number of wetland pfts (columns) in wetland landunit +! maxpatch_lake = max number of lake pfts (columns) in lake landunit +! maxpatch_glacier = max number of glacier pfts (columns) in glacier landunit +! maxpatch_glcmec = max number of glacier_mec pfts (columns) in glacier_mec landunit + + integer, parameter :: mxpft = 20 ! maximum number of PFT's for any mode + integer, parameter :: numveg = 16 ! number of veg types (without specific crop) +#if (defined CROP) + integer, parameter :: numpft = mxpft ! actual # of pfts (without bare) + integer, parameter :: numcft = 6 ! actual # of crops +#else + integer, parameter :: numpft = numveg ! actual # of pfts (without bare) + integer, parameter :: numcft = 2 ! actual # of crops +#endif + integer, parameter :: maxpatch_urb = 5 + integer :: maxpatch_pft +#if defined(GLC_NEC_10) + integer, parameter :: maxpatch_glcmec = 10 +#elif defined(GLC_NEC_5) + integer, parameter :: maxpatch_glcmec = 5 +#elif defined(GLC_NEC_3) + integer, parameter :: maxpatch_glcmec = 3 +#elif defined(GLC_NEC_1) + integer, parameter :: maxpatch_glcmec = 1 +#else + integer, parameter :: maxpatch_glcmec = 0 +#endif + integer :: npatch_urban + integer :: npatch_lake + integer :: npatch_wet + integer :: npatch_glacier + integer :: npatch_glacier_mec + integer :: maxpatch + +! clm_varpar_init seems to do something similar; less prone to error to move +! these three lines there? (slevis) +#if (defined CROP) + integer, parameter :: max_pft_per_gcell = numpft+1 + 3 + maxpatch_urb + maxpatch_glcmec +#else + integer, parameter :: max_pft_per_gcell = numpft+1 + 3 + maxpatch_urb + numcft + maxpatch_glcmec +#endif + integer, parameter :: max_pft_per_lu = max(numpft+1, numcft, maxpatch_urb) + integer, parameter :: max_pft_per_col = max(numpft+1, numcft, maxpatch_urb) + +! !PUBLIC MEMBER FUNCTIONS: + public clm_varpar_init ! set parameters + +! !REVISION HISTORY: +! Created by Mariana Vertenstein + +!EOP +!----------------------------------------------------------------------- +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: clm_varpar_init +! +! !INTERFACE: + subroutine clm_varpar_init() +! +! !DESCRIPTION: +! This subroutine initializes parameters in clm_varpar +! +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + lsmlon = 1 + lsmlat = 1 + rtmlon = 1 + rtmlat = 1 + maxpatch_pft = MAXPATCH_PFT + npatch_urban = maxpatch_pft + 1 + npatch_lake = npatch_urban + maxpatch_urb + npatch_wet = npatch_lake + 1 + npatch_glacier = npatch_wet + 1 + npatch_glacier_mec = npatch_glacier + maxpatch_glcmec + maxpatch = npatch_glacier_mec + + end subroutine clm_varpar_init + +!------------------------------------------------------------------------------ +end module clm_varpar diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/fileutils.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/fileutils.F90 new file mode 100644 index 0000000000..3aac33cd73 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/fileutils.F90 @@ -0,0 +1,251 @@ + +module fileutils + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: fileutils +! +! !DESCRIPTION: +! Module containing file I/O utilities +! +! !USES: + use clm_varctl, only : iulog + use shr_sys_mod, only : shr_sys_abort +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: get_filename !Returns filename given full pathname + public :: opnfil !Open local unformatted or formatted file + public :: getfil !Obtain local copy of file + public :: relavu !Close and release Fortran unit no longer in use + public :: getavu !Get next available Fortran unit number +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE MEMBER FUNCTIONS: None +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: get_filename +! +! !INTERFACE: + character(len=256) function get_filename (fulpath) +! +! !DESCRIPTION: +! Returns filename given full pathname +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fulpath !full pathname +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + integer klen !length of fulpath character string +!------------------------------------------------------------------------ + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i) == '/') go to 10 + end do + i = 0 +10 get_filename = fulpath(i+1:klen) + + return + end function get_filename + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: getfil +! +! !INTERFACE: + subroutine getfil (fulpath, locfn, iflag) +! +! !DESCRIPTION: +! Obtain local copy of file +! First check current working directory +! Next check full pathname[fulpath] on disk +! +! !USES: + use shr_file_mod, only: shr_file_get +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname + character(len=*), intent(out) :: locfn !output local file name + integer, optional, intent(in) :: iflag !0=>abort if file not found 1=>do not abort +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + integer klen !length of fulpath character string + logical lexist !true if local file exists +!------------------------------------------------------------------------ + + ! get local file name from full name + + locfn = get_filename( fulpath ) + if (len_trim(locfn) == 0) then + write(iulog,*)'(GETFIL): local filename has zero length' + call shr_sys_abort + else + write(iulog,*)'(GETFIL): attempting to find local file ', & + trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + write(iulog,*) '(GETFIL): using ',trim(locfn), & + ' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + locfn = fulpath + + inquire (file=fulpath,exist=lexist) + if (lexist) then + write(iulog,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath + if (present(iflag) .and. iflag==0) then + call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) + else + RETURN + endif + endif + + end subroutine getfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: opnfil +! +! !INTERFACE: + subroutine opnfil (locfn, iun, form) +! +! !DESCRIPTION: +! Open file locfn in unformatted or formatted form on unit iun +! +! !ARGUMENTS: +! + implicit none + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, + !f = formatted +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted +!------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(iulog,*)'(OPNFIL): local filename has zero length' + call shr_sys_abort + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + call shr_sys_abort + else + write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), & + & ' on unit= ',iun + end if + + end subroutine opnfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: getavu +! +! !INTERFACE: + integer function getavu() +! +! !DESCRIPTION: +! Get next available Fortran unit number. +! +! !USES: + use shr_file_mod, only : shr_file_getUnit +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! Modified for clm2 by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: relavu +! +! !INTERFACE: + subroutine relavu (iunit) +! +! !DESCRIPTION: +! Close and release Fortran unit no longer in use! +! +! !USES: + use shr_file_mod, only : shr_file_freeUnit +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: iunit !Fortran unit number +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! +!EOP +!------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkdomainMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkdomainMod.F90 new file mode 100644 index 0000000000..66174de38b --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkdomainMod.F90 @@ -0,0 +1,782 @@ +module mkdomainMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: domain1Mod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkvarpar , only : re + use nanMod , only : nan, bigint +! +! !PUBLIC TYPES: + implicit none + private +! + public :: domain_type + + type domain_type + character*16 :: set ! flag to check if domain is set + integer :: ns ! global size of domain + integer :: ni,nj ! for 2d domains only + real(r8) :: edgen ! lsmedge north + real(r8) :: edgee ! lsmedge east + real(r8) :: edges ! lsmedge south + real(r8) :: edgew ! lsmedge west + integer ,pointer :: mask(:) ! land mask: 1 = land, 0 = ocean + real(r8),pointer :: frac(:) ! fractional land + real(r8),pointer :: latc(:) ! latitude of grid cell (deg) + real(r8),pointer :: lonc(:) ! longitude of grid cell (deg) + real(r8),pointer :: lats(:) ! grid cell latitude, S edge (deg) + real(r8),pointer :: latn(:) ! grid cell latitude, N edge (deg) + real(r8),pointer :: lonw(:) ! grid cell longitude, W edge (deg) + real(r8),pointer :: lone(:) ! grid cell longitude, E edge (deg) + real(r8),pointer :: area(:) ! grid cell area (km**2) (only used for output grid) + logical :: fracset ! if frac is set + logical :: maskset ! if mask is set + end type domain_type + +! +! !PUBLIC MEMBER FUNCTIONS: + public domain_clean + public domain_check + public domain_read + public domain_read_map + public domain_write + public domain_checksame +! +! +! !REVISION HISTORY: +! Originally clm_varsur by Mariana Vertenstein +! Migrated from clm_varsur to domainMod by T Craig +! + character*16,parameter :: set = 'domain_set ' + character*16,parameter :: unset = 'NOdomain_unsetNO' + + real(r8) :: flandmin = 0.001 !minimum land frac for land cell +! +! !PRIVATE MEMBER FUNCTIONS: + private domain_init +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_init +! +! !INTERFACE: + subroutine domain_init(domain,ns) +! +! !DESCRIPTION: +! This subroutine allocates and nans the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype + integer :: ns ! grid size, 2d +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier + integer nb,ne +! +!------------------------------------------------------------------------------ + + nb = 1 + ne = ns + + if (domain%set == set) then + call domain_clean(domain) + endif + + allocate(domain%mask(ns), & + domain%frac(ns), & + domain%latc(ns), & + domain%lonc(ns), & + domain%lats(ns), & + domain%latn(ns), & + domain%lonw(ns), & + domain%lone(ns), & + domain%area(ns), stat=ier) + if (ier /= 0) then + write(6,*) 'domain_init ERROR: allocate mask, frac, lat, lon, area ' + endif + + domain%ns = ns + domain%mask = -9999 + domain%frac = -1.0e36 + domain%latc = nan + domain%lonc = nan + domain%area = nan + domain%set = set + domain%fracset = .false. + domain%maskset = .false. + + end subroutine domain_init + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_clean +! +! !INTERFACE: + subroutine domain_clean(domain) +! +! !DESCRIPTION: +! This subroutine deallocates the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier +! +!------------------------------------------------------------------------------ + + if (domain%set == set) then + write(6,*) 'domain_clean: cleaning ',domain%ns + deallocate(domain%mask, & + domain%frac, & + domain%latc, & + domain%lonc, & + domain%lats, & + domain%latn, & + domain%lonw, & + domain%lone, & + domain%area, stat=ier) + if (ier /= 0) then + write(6,*) 'domain_clean ERROR: deallocate mask, frac, lat, lon, area ' + call abort() + endif + else + write(6,*) 'domain_clean WARN: clean domain unecessary ' + endif + + domain%ns = bigint + domain%set = unset + domain%fracset = .false. + domain%maskset = .false. + +end subroutine domain_clean + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_check +! +! !INTERFACE: + subroutine domain_check(domain) +! +! !DESCRIPTION: +! This subroutine write domain info +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(in) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + write(6,*) ' domain_check set = ',trim(domain%set) + write(6,*) ' domain_check ns = ',domain%ns + write(6,*) ' domain_check lonc = ',minval(domain%lonc),maxval(domain%lonc) + write(6,*) ' domain_check latc = ',minval(domain%latc),maxval(domain%latc) + write(6,*) ' domain_check mask = ',minval(domain%mask),maxval(domain%mask) + write(6,*) ' domain_check frac = ',minval(domain%frac),maxval(domain%frac) + write(6,*) ' ' + +end subroutine domain_check + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read_map +! +! !INTERFACE: + logical function domain_read_map(domain, fname) +! +! !DESCRIPTION: +! Read a grid file +! +! !USES: + use mkutilsMod, only : convert_latlon +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname ! this assumes a SCRIP mapping file - look at destination grid +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: i,j,n ! indices + integer :: grid_rank ! rank of domain grid + integer :: ns ! size of domain grid + integer :: ncid ! netCDF file id + integer :: dimid ! netCDF dimension id + integer :: varid ! netCDF variable id + integer :: ndims ! number of dims for variable + integer :: ier ! error status + real(r8), allocatable :: xv(:,:) ! local array for corner lons + real(r8), allocatable :: yv(:,:) ! local array for corner lats + integer :: grid_dims(2) + character(len= 32) :: subname = 'domain_read' +!----------------------------------------------------------------- + + domain_read_map = .true. + + ! Read domain file and compute stuff as needed + + call check_ret(nf_open(fname, 0, ncid), subname) + + ! Assume unstructured grid + + domain%ni = -9999 + domain%nj = -9999 + + ier = nf_inq_dimid (ncid, 'n_b', dimid) + if ( ier /= NF_NOERR )then + domain_read_map = .false. + else + call check_ret(nf_inq_dimlen (ncid, dimid, domain%ns), subname) + + call check_ret(nf_inq_dimid (ncid, 'dst_grid_rank', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, grid_rank), subname) + + if (grid_rank == 2) then + call check_ret(nf_inq_varid (ncid, 'dst_grid_dims', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, grid_dims), subname) + domain%ni = grid_dims(1) + domain%nj = grid_dims(2) + end if + + call domain_init(domain, domain%ns) + ns = domain%ns + + call check_ret(nf_inq_varid (ncid, 'xc_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%lonc), subname) + call convert_latlon(ncid, 'xc_b', domain%lonc) + + call check_ret(nf_inq_varid (ncid, 'yc_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%latc), subname) + call convert_latlon(ncid, 'yc_b', domain%latc) + + if (grid_rank == 2 ) then + allocate(yv(4,ns), xv(4,ns)) + call check_ret(nf_inq_varid (ncid, 'yv_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, yv), subname) + call check_ret(nf_inq_varid (ncid, 'xv_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, xv), subname) + + domain%lats(:) = yv(1,:) + call convert_latlon(ncid, 'yv_b', domain%lats(:)) + + domain%latn(:) = yv(3,:) + call convert_latlon(ncid, 'yv_b', domain%latn(:)) + + domain%lonw(:) = xv(1,:) + call convert_latlon(ncid, 'xv_b', domain%lonw(:)) + + domain%lone(:) = xv(2,:) + call convert_latlon(ncid, 'xv_b', domain%lone(:)) + + domain%edgen = maxval(domain%latn) + domain%edgee = maxval(domain%lone) + domain%edges = minval(domain%lats) + domain%edgew = minval(domain%lonw) + deallocate(yv,xv) + end if + + call check_ret(nf_inq_varid (ncid, 'frac_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + + call check_ret(nf_inq_varid (ncid, 'mask_b', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + + call check_ret(nf_inq_varid (ncid, 'area_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%area), subname) + domain%area = domain%area * re**2 + end if + domain%maskset = .true. + domain%fracset = .true. + + call check_ret(nf_close(ncid), subname) + + end function domain_read_map + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read +! +! !INTERFACE: + subroutine domain_read(domain, fname, readmask) +! +! !DESCRIPTION: +! Read a grid file +! +! !USES: + use mkutilsMod, only : convert_latlon +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname + logical,optional, intent(in) :: readmask ! true => read mask instead of landmask for urban parameters +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: i,j,n + integer :: nlon,nlat ! size + integer :: ns ! size of domain + real(r8), allocatable :: lon1d(:) ! local array for 1d lon + real(r8), allocatable :: lat1d(:) ! local array for 1d lat + real(r8), allocatable :: xv(:,:) ! local array for corner lons + real(r8), allocatable :: yv(:,:) ! local array for corner lats + integer :: ncid ! netCDF file id + integer :: dimid ! netCDF dimension id + integer :: varid ! netCDF variable id + logical :: dimset ! local ni,nj + logical :: edgeNESWset ! local EDGE[NESW] + logical :: lonlatset ! local lon(:,:), lat(:,:) + logical :: llneswset ! local lat[ns],lon[we] + logical :: landfracset ! local landfrac + logical :: maskset ! local mask + integer :: ndims ! number of dims for variable + integer :: ier ! error status + logical :: lreadmask ! local readmask + character(len= 32) :: lonvar ! name of 2-d longitude variable + character(len= 32) :: latvar ! name of 2-d latitude variable + character(len= 32) :: subname = 'domain_read' +!----------------------------------------------------------------- + + dimset = .false. + lonlatset = .false. + edgeNESWset = .false. + llneswset = .false. + landfracset = .false. + maskset = .false. + lreadmask = .false. + + if (present(readmask)) then + lreadmask = readmask + end if + + ! Read domain file and compute stuff as needed + + call check_ret(nf_open(fname, 0, ncid), subname) + + ! Assume unstructured grid + domain%ni = -9999 + domain%nj = -9999 + + ! ----- Set lat/lon dimension ------ + + ier = nf_inq_dimid (ncid, 'lon', dimid) + if (ier == NF_NOERR) then + if (dimset) write(6,*) trim(subname),' WARNING, overwriting dims' + dimset = .true. + write(6,*) trim(subname),' read lon and lat dims' + call check_ret(nf_inq_dimid (ncid, 'lon', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlon), subname) + call check_ret(nf_inq_dimid (ncid, 'lat', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlat), subname) + domain%ni = nlon + domain%nj = nlat + endif + + ier = nf_inq_dimid (ncid, 'ni', dimid) + if (ier == NF_NOERR) then + if (dimset) write(6,*) trim(subname),' WARNING, overwriting dims' + dimset = .true. + write(6,*) trim(subname),' read ni and nj dims' + call check_ret(nf_inq_dimid (ncid, 'ni', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlon), subname) + call check_ret(nf_inq_dimid (ncid, 'nj', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlat), subname) + domain%ni = nlon + domain%nj = nlat + endif + + ier = nf_inq_dimid (ncid, 'lsmlon', dimid) + if (ier == NF_NOERR) then + if (dimset) write(6,*) trim(subname),' WARNING, overwriting dims' + dimset = .true. + write(6,*) trim(subname),' read lsmlon and lsmlat dims' + call check_ret(nf_inq_dimid (ncid, 'lsmlon', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlon), subname) + call check_ret(nf_inq_dimid (ncid, 'lsmlat', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlat), subname) + domain%ni = nlon + domain%nj = nlat + endif + + if (dimset) then + write(6,*) trim(subname),' initialized domain' + call domain_init(domain,nlon*nlat) + else + write(6,*) trim(subname),' ERROR: dims not set for domain_init' + call abort() + endif + ns = domain%ns + + ! ----- Set lat/lon variable ------ + + lonvar = ' ' + latvar = ' ' + + if (.not. lonlatset) then + ier = nf_inq_varid (ncid, 'LONGXY', varid) + if (ier == NF_NOERR) then + lonvar = 'LONGXY' + latvar = 'LATIXY' + lonlatset = .true. + end if + end if + + if (.not. lonlatset) then + ier = nf_inq_varid (ncid, 'lon', varid) + if (ier == NF_NOERR) then + lonvar = 'lon' + latvar = 'lat' + lonlatset = .true. + end if + end if + + if (.not. lonlatset) then + write(6,*)'lon/lat values not set' + write(6,*)'currently assume either that lon/lat or LONGXY/LATIXY', & + ' variables are on input dataset' + call abort() + end if + + call check_ret(nf_inq_varid (ncid, lonvar, varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%lonc), subname) + call convert_latlon(ncid, lonvar, domain%lonc) + + call check_ret(nf_inq_varid (ncid, latvar, varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%latc), subname) + call convert_latlon(ncid, latvar, domain%latc) + + ! ----- Set landmask/landfrac ------ + + ier = nf_inq_varid (ncid, 'frac', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read frac' + call check_ret(nf_inq_varid (ncid, 'frac', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + ier = nf_inq_varid (ncid, 'LANDFRAC', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read LANDFRAC' + call check_ret(nf_inq_varid (ncid, 'LANDFRAC', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + if (lreadmask) then + ier = nf_inq_varid (ncid, 'mask', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read mask with lreadmask set' + call check_ret(nf_inq_varid (ncid, 'mask', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + else + ier = nf_inq_varid (ncid, 'mask', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read mask' + call check_ret(nf_inq_varid (ncid, 'mask', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + ier = nf_inq_varid (ncid, 'LANDMASK', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read LANDMASK' + call check_ret(nf_inq_varid (ncid, 'LANDMASK', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + end if + + call check_ret(nf_close(ncid), subname) + + ! ----- set derived variables ---- + + if (.not.maskset.and.landfracset) then + maskset = .true. + where (domain%frac < flandmin) + domain%mask = 0 !ocean + elsewhere + domain%mask = 1 !land + endwhere + endif + + if (.not.landfracset.and.maskset) then + landfracset = .true. + do n = 1,ns + if ( domain%mask(n) == 0 )then + domain%frac(n) = 0._r8 !ocean + else + domain%frac(n) = 1._r8 !land + end if + end do + endif + domain%maskset = maskset + domain%fracset = landfracset + + end subroutine domain_read + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_write +! +! !INTERFACE: + subroutine domain_write(domain,fname) +! +! !DESCRIPTION: +! Write a domain to netcdf + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: varid !netCDF variable id + integer :: ncid !netCDF file id + integer :: omode !netCDF output mode + character(len= 32) :: subname = 'domain_write' +!----------------------------------------------------------------- + + call check_ret(nf_open(trim(fname), nf_write, ncid), subname) + ! File will be in define mode. Set fill mode to "no fill" to optimize performance + + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Write domain fields + + call check_ret(nf_inq_varid(ncid, 'AREA', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%area), subname) + + call check_ret(nf_inq_varid(ncid, 'LONGXY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%lonc), subname) + + call check_ret(nf_inq_varid(ncid, 'LATIXY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%latc), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! Close grid data dataset + + call check_ret(nf_close(ncid), subname) + + end subroutine domain_write + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: check_ret +! +! !INTERFACE: + subroutine check_ret(ret, calling) +! +! !DESCRIPTION: +! Check return status from netcdf call +! +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ret + character(len=*) :: calling +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + + if (ret /= NF_NOERR) then + write(6,*)'netcdf error from ',trim(calling), ' rcode = ', ret, & + ' error = ', NF_STRERROR(ret) + call abort() + end if + + end subroutine check_ret + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_checksame +! +! !INTERFACE: + subroutine domain_checksame( srcdomain, dstdomain, tgridmap ) +! +! !DESCRIPTION: +! Check that the input domains agree with the input map +! +! USES: + use mkgridmapMod, only : gridmap_type, gridmap_setptrs +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: srcdomain ! input domain + type(domain_type), intent(in) :: dstdomain ! output domain + type(gridmap_type),intent(in) :: tgridmap ! grid map +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + integer :: na, nb, ns ! gridmap sizes + integer :: n, ni ! indices + real(r8), pointer :: xc_src(:) ! Source longitude + real(r8), pointer :: yc_src(:) ! Source latitude + real(r8), pointer :: frac_src(:) ! Source fraction + integer, pointer :: mask_src(:) ! Source mask + integer, pointer :: src_indx(:) ! Source index + real(r8), pointer :: xc_dst(:) ! Destination longitude + real(r8), pointer :: yc_dst(:) ! Destination latitude + real(r8), pointer :: frac_dst(:) ! Destination fraction + integer, pointer :: mask_dst(:) ! Destination mask + integer, pointer :: dst_indx(:) ! Destination index + character(len= 32) :: subname = 'domain_checksame' + + ! tolerance for checking equality of lat & lon + ! For a value of order 100 (e.g., lat / lon), machine epsilon is approximately 1e-13 + ! or 1e-14. We'll use 1e-12 to allow for slightly greater rounding errors. + real(r8), parameter :: eps = 1.e-12_r8 + + + if (srcdomain%set == unset) then + write(6,*) trim(subname)//'ERROR: source domain is unset!' + call abort() + end if + if (srcdomain%set == unset) then + write(6,*) trim(subname)//'ERROR: destination domain is unset!' + call abort() + end if + + call gridmap_setptrs( tgridmap, nsrc=na, ndst=nb, ns=ns, & + xc_src=xc_src, yc_src=yc_src, & + xc_dst=xc_dst, yc_dst=yc_dst, & + mask_src=mask_src, mask_dst=mask_dst, & + src_indx=src_indx, dst_indx=dst_indx & + ) + + if (srcdomain%ns /= na) then + write(6,*) trim(subname)// & + ' ERROR: input domain size and gridmap source size are not the same size' + write(6,*)' domain size = ',srcdomain%ns + write(6,*)' map src size= ',na + call abort() + end if + if (dstdomain%ns /= nb) then + write(6,*) trim(subname)// & + ' ERROR: output domain size and gridmap destination size are not the same size' + write(6,*)' domain size = ',dstdomain%ns + write(6,*)' map dst size= ',nb + call abort() + end if + do n = 1,ns + ni = src_indx(n) + if ( srcdomain%maskset )then + if (srcdomain%mask(ni) /= mask_src(ni)) then + write(6,*) trim(subname)// & + ' ERROR: input domain mask and gridmap mask are not the same at ni = ',ni + write(6,*)' domain mask= ',srcdomain%mask(ni) + write(6,*)' gridmap mask= ',mask_src(ni) + call abort() + end if + end if + if (abs(srcdomain%lonc(ni) - xc_src(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: input domain lon and gridmap lon not the same at ni = ',ni + write(6,*)' domain lon= ',srcdomain%lonc(ni) + write(6,*)' gridmap lon= ',xc_src(ni) + call abort() + end if + if (abs(srcdomain%latc(ni) - yc_src(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: input domain lat and gridmap lat not the same at ni = ',ni + write(6,*)' domain lat= ',srcdomain%latc(ni) + write(6,*)' gridmap lat= ',yc_src(ni) + call abort() + end if + end do + do n = 1,ns + ni = dst_indx(n) + if ( dstdomain%maskset )then + if (dstdomain%mask(ni) /= mask_dst(ni)) then + write(6,*) trim(subname)// & + ' ERROR: output domain mask and gridmap mask are not the same at ni = ',ni + write(6,*)' domain mask= ',dstdomain%mask(ni) + write(6,*)' gridmap mask= ',mask_dst(ni) + call abort() + end if + end if + if (abs(dstdomain%lonc(ni) - xc_dst(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: output domain lon and gridmap lon not the same at ni = ',ni + write(6,*)' domain lon= ',dstdomain%lonc(ni) + write(6,*)' gridmap lon= ',xc_dst(ni) + call abort() + end if + if (abs(dstdomain%latc(ni) - yc_dst(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: output domain lat and gridmap lat not the same at ni = ',ni + write(6,*)' domain lat= ',dstdomain%latc(ni) + write(6,*)' gridmap lat= ',yc_dst(ni) + call abort() + end if + end do + + end subroutine domain_checksame + +end module mkdomainMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 new file mode 100644 index 0000000000..feb9cfba7e --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 @@ -0,0 +1,746 @@ +module mkfileMod + +contains + +!----------------------------------------------------------------------- + subroutine mkfile(domain, fname, dynlanduse, urban_format) + + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_getenv + use fileutils , only : get_filename + use mkvarpar , only : nlevsoi, nlevurb, numsolar, numrad + use mkvarctl + use mkglcmecMod , only : nglcec + use mkpftMod , only : mkpftAtt + use mksoilMod , only : mksoilAtt + use mkharvestMod, only : mkharvest_fieldname, mkharvest_numtypes, mkharvest_longname + use mkurbanparCommonMod, only : URBAN_FORMAT_DOM + use mkncdio , only : check_ret, ncd_defvar + use mkdomainMod + + implicit none + include 'netcdf.inc' + type(domain_type) , intent(in) :: domain + character(len=*) , intent(in) :: fname + logical , intent(in) :: dynlanduse + integer , intent(in) :: urban_format ! code for format of urban file + + integer :: ncid + integer :: j ! index + integer :: dimid ! temporary + integer :: values(8) ! temporary + character(len=256) :: str ! global attribute string + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 18) :: datetime ! temporary + character(len= 8) :: date ! temporary + character(len= 10) :: time ! temporary + character(len= 5) :: zone ! temporary + integer :: ier ! error status + integer :: omode ! netCDF output mode + integer :: xtype ! external type + character(len=32) :: subname = 'mkfile' ! subroutine name +!----------------------------------------------------------------------- + + call check_ret(nf_create(trim(fname), ior(nf_clobber,nf_64bit_offset), & + ncid), subname) + + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Define dimensions. + + if (outnc_1d) then + call check_ret(nf_def_dim (ncid, 'gridcell', domain%ns, dimid), subname) + else + call check_ret(nf_def_dim (ncid, 'lsmlon' , domain%ni, dimid), subname) + call check_ret(nf_def_dim (ncid, 'lsmlat' , domain%nj, dimid), subname) + end if + + if (.not. dynlanduse) then + if ( nglcec > 0 )then + call check_ret(nf_def_dim (ncid, 'nglcec' , nglcec , dimid), subname) + call check_ret(nf_def_dim (ncid, 'nglcecp1', nglcec+1 , dimid), subname) + end if + end if + call check_ret(nf_def_dim (ncid, 'nlevurb' , nlevurb , dimid), subname) + call check_ret(nf_def_dim (ncid, 'numsolar', numsolar , dimid), subname) + call check_ret(nf_def_dim (ncid, 'numrad' , numrad , dimid), subname) + call check_ret(nf_def_dim (ncid, 'nchar' , 256 , dimid), subname) + + ! Create global attributes. + + str = 'NCAR-CSM' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Conventions', len_trim(str), trim(str)), subname) + + call date_and_time (date, time, zone, values) + datetime(1:8) = date(5:6) // '-' // date(7:8) // '-' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + str = 'created on: ' // datetime + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'History_Log', len_trim(str), trim(str)), subname) + + call shr_sys_getenv ('LOGNAME', str, ier) + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Logname', len_trim(str), trim(str)), subname) + + call shr_sys_getenv ('HOST', str, ier) + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Host', len_trim(str), trim(str)), subname) + + str = 'Community Land Model: CLM4' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Source', len_trim(str), trim(str)), subname) + + str = & +'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/tools/clm4_0/mksurfdata_map/src/mkfileMod.F90 $' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Version', len_trim(str), trim(str)), subname) + + str = '$Id: mkfileMod.F90 43810 2013-02-07 06:12:57Z erik $' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Revision_Id', len_trim(str), trim(str)), subname) + +#ifdef OPT + str = 'TRUE' +#else + str = 'FALSE' +#endif + + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Compiler_Optimized', len_trim(str), trim(str)), subname) + + if ( all_urban )then + str = 'TRUE' + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'all_urban', len_trim(str), trim(str)), subname) + end if + + str = get_filename(mksrf_fgrid) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Input_grid_dataset', len_trim(str), trim(str)), subname) + + str = trim(mksrf_gridtype) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Input_gridtype', len_trim(str), trim(str)), subname) + + if (.not. dynlanduse) then + str = get_filename(mksrf_fvocef) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'VOC_EF_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + str = get_filename(mksrf_flakwat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Inland_lake_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fwetlnd) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Inland_wetland_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fglacier) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Glacier_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_furbtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Urban_Topography_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_flndtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Land_Topography_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_furban) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Urban_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(map_fpft) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_pft_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_firrig) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Irrig_raw_data_file_name', len_trim(str), trim(str)), subname) + + if (.not. dynlanduse) then + str = get_filename(mksrf_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Lai_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + ! ---------------------------------------------------------------------- + ! Define variables + ! ---------------------------------------------------------------------- + + if ( .not. outnc_double )then + xtype = nf_float + else + xtype = nf_double + end if + + str = get_filename(map_flakwat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_lakwat_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fwetlnd) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_wetlnd_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fglacier) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_glacier_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fsoitex) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_texture_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fsoicol) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_color_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_forganic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_organic_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_furban) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_urban_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fmax) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_fmax_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fvocef) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_VOC_EF_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fharvest) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_harvest_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_firrig) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_irrigation_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_lai_sai_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_furbtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_urban_topography_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_flndtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_land_topography_file', len_trim(str), trim(str)), subname) + + ! ---------------------------------------------------------------------- + ! Define variables + ! ---------------------------------------------------------------------- + + if ( .not. outnc_double )then + xtype = nf_float + else + xtype = nf_double + end if + + call mksoilAtt( ncid, dynlanduse, xtype ) + + call mkpftAtt( ncid, dynlanduse, xtype ) + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='AREA' , xtype=nf_double, & + dim1name='gridcell',& + long_name='area', units='km^2') + else + call ncd_defvar(ncid=ncid, varname='AREA' , xtype=nf_double, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='area', units='km^2') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='LONGXY', xtype=nf_double, & + dim1name='gridcell',& + long_name='longitude', units='degrees east') + else + call ncd_defvar(ncid=ncid, varname='LONGXY', xtype=nf_double, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='longitude', units='degrees east') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='LATIXY', xtype=nf_double, & + dim1name='gridcell',& + long_name='latitude', units='degrees north') + else + call ncd_defvar(ncid=ncid, varname='LATIXY', xtype=nf_double, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='latitude', units='degrees north') + end if + + if (.not. dynlanduse) then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_BTR', xtype=xtype, & + dim1name='gridcell',& + long_name='EF btr (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_BTR', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF btr (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_FET', xtype=xtype, & + dim1name='gridcell',& + long_name='EF fet (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_FET', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF fet (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_FDT', xtype=xtype, & + dim1name='gridcell',& + long_name='EF fdt (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_FDT', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF fdt (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_SHR', xtype=xtype, & + dim1name='gridcell',& + long_name='EF shr (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_SHR', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF shr (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_GRS', xtype=xtype, & + dim1name='gridcell',& + long_name='EF grs (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_GRS', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF grs (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EF1_CRP', xtype=xtype, & + dim1name='gridcell',& + long_name='EF crp (isoprene)', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EF1_CRP', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='EF crp (isoprene)', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='CANYON_HWR', xtype=xtype, & + dim1name='gridcell',& + long_name='canyon height to width ratio', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='CANYON_HWR', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='canyon height to width ratio', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EM_IMPROAD', xtype=xtype, & + dim1name='gridcell',& + long_name='emissivity of impervious road', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EM_IMPROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='emissivity of impervious road', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EM_PERROAD', xtype=xtype, & + dim1name='gridcell',& + long_name='emissivity of pervious road', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EM_PERROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='emissivity of pervious road', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EM_ROOF', xtype=xtype, & + dim1name='gridcell',& + long_name='emissivity of roof', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EM_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='emissivity of roof', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='EM_WALL', xtype=xtype, & + dim1name='gridcell',& + long_name='emissivity of wall', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='EM_WALL', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='emissivity of wall', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='HT_ROOF', xtype=xtype, & + dim1name='gridcell',& + long_name='height of roof', units='meters') + else + call ncd_defvar(ncid=ncid, varname='HT_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='height of roof', units='meters') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='THICK_ROOF', xtype=xtype, & + dim1name='gridcell',& + long_name='thickness of roof', units='meters') + else + call ncd_defvar(ncid=ncid, varname='THICK_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='thickness of roof', units='meters') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='THICK_WALL', xtype=xtype, & + dim1name='gridcell',& + long_name='thickness of wall', units='meters') + else + call ncd_defvar(ncid=ncid, varname='THICK_WALL', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='thickness of wall', units='meters') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='T_BUILDING_MAX', xtype=xtype, & + dim1name='gridcell',& + long_name='maximum interior building temperature', units='K') + else + call ncd_defvar(ncid=ncid, varname='T_BUILDING_MAX', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='maximum interior building temperature', units='K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='T_BUILDING_MIN', xtype=xtype, & + dim1name='gridcell',& + long_name='minimum interior building temperature', units='K') + else + call ncd_defvar(ncid=ncid, varname='T_BUILDING_MIN', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='minimum interior building temperature', units='K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='WIND_HGT_CANYON', xtype=xtype, & + dim1name='gridcell',& + long_name='height of wind in canyon', units='meters') + else + call ncd_defvar(ncid=ncid, varname='WIND_HGT_CANYON', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='height of wind in canyon', units='meters') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='WTLUNIT_ROOF', xtype=xtype, & + dim1name='gridcell',& + long_name='fraction of roof', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='WTLUNIT_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='fraction of roof', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='WTROAD_PERV', xtype=xtype, & + dim1name='gridcell',& + long_name='fraction of pervious road', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='WTROAD_PERV', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='fraction of pervious road', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='ALB_IMPROAD', xtype=xtype, & + dim1name='gridcell', dim2name='numrad', dim3name='numsolar', & + long_name='albedo of impervious road', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='ALB_IMPROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='numrad', dim4name='numsolar', & + long_name='albedo of impervious road', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='ALB_PERROAD', xtype=xtype, & + dim1name='gridcell', dim2name='numrad', dim3name='numsolar', & + long_name='albedo of pervious road', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='ALB_PERROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='numrad', dim4name='numsolar', & + long_name='albedo of pervious road', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='ALB_ROOF', xtype=xtype, & + dim1name='gridcell', dim2name='numrad', dim3name='numsolar', & + long_name='albedo of roof', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='ALB_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='numrad',dim4name='numsolar', & + long_name='albedo of roof', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='ALB_WALL', xtype=xtype, & + dim1name='gridcell', dim2name='numrad', dim3name='numsolar', & + long_name='albedo of wall', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='ALB_WALL', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='numrad', dim4name='numsolar', & + long_name='albedo of wall', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='TK_ROOF', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='thermal conductivity of roof', units='W/m*K') + else + call ncd_defvar(ncid=ncid, varname='TK_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='thermal conductivity of roof', units='W/m*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='TK_WALL', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='thermal conductivity of wall', units='W/m*K') + else + call ncd_defvar(ncid=ncid, varname='TK_WALL', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='thermal conductivity of wall', units='W/m*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='TK_IMPROAD', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='thermal conductivity of impervious road', units='W/m*K') + else + call ncd_defvar(ncid=ncid, varname='TK_IMPROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='thermal conductivity of impervious road', units='W/m*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='CV_ROOF', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='volumetric heat capacity of roof', units='J/m^3*K') + else + call ncd_defvar(ncid=ncid, varname='CV_ROOF', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='volumetric heat capacity of roof', units='J/m^3*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='CV_WALL', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='volumetric heat capacity of wall', units='J/m^3*K') + else + call ncd_defvar(ncid=ncid, varname='CV_WALL', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='volumetric heat capacity of wall', units='J/m^3*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='CV_IMPROAD', xtype=xtype, & + dim1name='gridcell', dim2name='nlevurb', & + long_name='volumetric heat capacity of impervious road', units='J/m^3*K') + else + call ncd_defvar(ncid=ncid, varname='CV_IMPROAD', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevurb', & + long_name='volumetric heat capacity of impervious road', units='J/m^3*K') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='NLEV_IMPROAD', xtype=nf_int, & + dim1name='gridcell',& + long_name='number of impervious road layers', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='NLEV_IMPROAD', xtype=nf_int, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='number of impervious road layers', units='unitless') + end if + + endif + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_WETLAND', xtype=xtype, & + dim1name='gridcell',& + long_name='percent wetland', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_WETLAND', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent wetland', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_LAKE', xtype=xtype, & + dim1name='gridcell',& + long_name='percent lake', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_LAKE', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent lake', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLACIER', xtype=xtype, & + dim1name='gridcell',& + long_name='percent glacier', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLACIER', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent glacier', units='unitless') + end if + + if (.not. dynlanduse) then + if ( nglcec > 0 )then + call ncd_defvar(ncid=ncid, varname='GLC_MEC', xtype=xtype, & + dim1name='nglcecp1', long_name='Glacier elevation class', units='m') + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC', xtype=xtype, & + dim1name='gridcell', dim2name='nglcec', & + long_name='percent glacier for each glacier elevation class', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nglcec', & + long_name='percent glacier for each glacier elevation class', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC_GIC', xtype=xtype, & + dim1name='gridcell', dim2name='nglcec', & + long_name='percent smaller glaciers and ice caps for each glacier elevation class', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC_GIC', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nglcec', & + long_name='percent smaller glaciers and ice caps for each glacier elevation class', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC_ICESHEET', xtype=xtype, & + dim1name='gridcell', dim2name='nglcec', & + long_name='percent ice sheet for each glacier elevation class', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLC_MEC_ICESHEET', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nglcec', & + long_name='percent ice sheet for each glacier elevation class', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLC_GIC', xtype=xtype, & + dim1name='gridcell', & + long_name='percent ice caps/glaciers', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLC_GIC', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent ice caps/glaciers', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_GLC_ICESHEET', xtype=xtype, & + dim1name='gridcell', & + long_name='percent ice sheet', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_GLC_ICESHEET', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent ice sheet', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='TOPO_GLC_MEC', xtype=xtype, & + dim1name='gridcell', dim2name='nglcec', & + long_name='mean elevation on glacier elevation classes', units='m') + else + call ncd_defvar(ncid=ncid, varname='TOPO_GLC_MEC', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nglcec', & + long_name='mean elevation on glacier elevation classes', units='m') + end if + + end if + end if + + if (.not. dynlanduse) then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='TOPO', xtype=xtype, & + dim1name='gridcell', & + long_name='mean elevation on land', units='m') + else + call ncd_defvar(ncid=ncid, varname='TOPO', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='mean elevation on land', units='m') + end if + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_URBAN', xtype=xtype, & + dim1name='gridcell',& + long_name='percent urban', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_URBAN', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent urban', units='unitless') + end if + + if (urban_format == URBAN_FORMAT_DOM) then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='URBAN_DENSITY_CLASS', xtype=nf_int, & + dim1name='gridcell',& + long_name='urban density class', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='URBAN_DENSITY_CLASS', xtype=nf_int, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='urban density class', units='unitless') + end if + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='URBAN_REGION_ID', xtype=nf_int, & + dim1name='gridcell',& + long_name='urban region ID', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='URBAN_REGION_ID', xtype=nf_int, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='urban region ID', units='unitless') + end if + end if + + if (dynlanduse) then + do j = 1, mkharvest_numtypes() + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname=mkharvest_fieldname(j), xtype=xtype, & + dim1name='gridcell', dim2name='time', & + long_name=mkharvest_longname(j), units='unitless') + else + call ncd_defvar(ncid=ncid, varname=mkharvest_fieldname(j), xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='time', & + long_name=mkharvest_longname(j), units='unitless') + end if + end do + end if + + ! End of define mode + + call check_ret(nf_enddef(ncid), subname) + call check_ret(nf_close(ncid), subname) + + end subroutine mkfile + +end module mkfileMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 new file mode 100644 index 0000000000..57d49a6e9c --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkglcmecMod.F90 @@ -0,0 +1,791 @@ +module mkglcmecMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkglcmecMod +! +! !DESCRIPTION: +! Make glacier multi-elevation class data +! +! !REVISION HISTORY: +! Author: Erik Kluzek, Mariana Vertenstein +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mkglcmecInit ! Initialization + public mkglcmec ! Set glacier multi-elevation class + public mkglacier ! Set percent glacier +! +! !PUBLIC DATA MEMBERS: +! + integer, public :: nglcec = 10 ! number of elevation classes for glaciers + real(r8), pointer :: elevclass(:) ! elevation classes +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglcmecInit +! +! !INTERFACE: +subroutine mkglcmecInit( elevclass_o ) +! +! !DESCRIPTION: +! Initialize of Make glacier multi-elevation class data +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(OUT) :: elevclass_o(:) ! elevation classes +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'mkglcmecInit:: ' +!----------------------------------------------------------------------- + allocate( elevclass(nglcec+1) ) + + ! ----------------------------------------------------------------- + ! Define elevation classes, represents lower boundary of each class + ! ----------------------------------------------------------------- + + if ( nglcec == 36 )then + elevclass(:) = (/ 0., 200., 400., 600., 800., & + 1000., 1200., 1400., 1600., 1800., & + 2000., 2200., 2400., 2600., 2800., & + 3000., 3200., 3400., 3600., 3800., & + 4000., 4200., 4400., 4600., 4800., & + 5000., 5200., 5400., 5600., 5800., & + 6000., 6200., 6400., 6600., 6800., & + 7000., 10000./) + else if ( nglcec == 10 )then + elevclass(1) = 0. + elevclass(2) = 200. + elevclass(3) = 400. + elevclass(4) = 700. + elevclass(5) = 1000. + elevclass(6) = 1300. + elevclass(7) = 1600. + elevclass(8) = 2000. + elevclass(9) = 2500. + elevclass(10) = 3000. + elevclass(11) = 10000. + else if ( nglcec == 5 )then + elevclass(1) = 0. + elevclass(2) = 500. + elevclass(3) = 1000. + elevclass(4) = 1500. + elevclass(5) = 2000. + elevclass(6) = 10000. + else if ( nglcec == 3 )then + elevclass(1) = 0. + elevclass(2) = 1000. + elevclass(3) = 2000. + elevclass(4) = 10000. + else if ( nglcec == 1 )then + elevclass(1) = 0. + elevclass(2) = 10000. + else if ( nglcec == 0 )then + elevclass(1) = 10000. + else + write(6,*) subname//"ERROR:: nglcec must be 0, 1, 3, 5, 10 or 36",& + " to work with CLM: " + call abort() + end if + + elevclass_o(:) = elevclass(:) + +end subroutine mkglcmecInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglcmec +! +! !INTERFACE: +subroutine mkglcmec(ldomain, mapfname, & + datfname_fglacier, ndiag, & + pctglac_o, pctglac_o_uncorrected, & + pctglcmec_o, topoglcmec_o, & + pctglcmec_gic_o, pctglcmec_icesheet_o, & + pctglc_gic_o, pctglc_icesheet_o) +! +! !DESCRIPTION: +! make percent glacier on multiple elevation classes, mean elevation for each +! elevation class, and associated fields +! +! Note that the raw glacier data are specified by level, and thus implicitly include the +! necessary topo data for breaking pct glacier into elevation classes. Each level in the +! input data is assigned to an elevation (given by BIN_CENTERS in the input data). Thus, +! all of the input glacier in level 1 is treated as being at the same elevation, and +! likewise for each other level. These elevations are then used in assigning pct_glacier +! to the appropriate elevation class in the output data, as well as determining the mean +! topographic height of each elevation class in the output data. +! +! Does nothing if nglcec==0. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkutilsMod, only : slightly_below, slightly_above + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname_fglacier ! raw glacier data + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(in) :: pctglac_o(:) ! % glac on output glacier grid + real(r8) , intent(in) :: pctglac_o_uncorrected(:) ! % glac on output glacier grid, before any corrections were done + real(r8) , intent(out):: pctglcmec_o (:,:) ! % for each elevation class on output glacier grid + real(r8) , intent(out):: topoglcmec_o(:,:) ! mean elevation for each elevation classs on output glacier grid + real(r8) , intent(out):: pctglcmec_gic_o(:,:) ! % glc gic on output grid, by elevation class + real(r8) , intent(out):: pctglcmec_icesheet_o(:,:) ! % glc ice sheet on output grid, by elevation class + real(r8) , intent(out):: pctglc_gic_o(:) ! % glc gic on output grid, summed across elevation classes + real(r8) , intent(out):: pctglc_icesheet_o(:) ! % glc ice sheet on output grid, summed across elevation classes +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: David Lawrence +! 7/12/11: Bill Sacks: substantial rewrite to use input topo and % glacier at same resolution +! 9/25/12: Bill Sacks: substantial rewrite to use new format of fglacier, which provides +! percent by elevation bin (thus the separate topo dataset is no longer needed +! in this routine) +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: pctglc_gic_i(:) ! input GIC percentage for a single level + real(r8), allocatable :: pctglc_icesheet_i(:) ! input icesheet percentage for a single level + real(r8), allocatable :: topoglcmec_unnorm_o(:,:) ! same as topoglcmec_o, but unnormalized + real(r8) :: topoice_i ! topographic height of this level + real(r8) :: pctglc_i ! input total pct glacier for a single level & single point + real(r8) :: wt, frac ! weighting factors for remapping + integer :: ndims ! number of dimensions in input variables + integer :: dim_lengths(nf_max_var_dims) ! lengths of dimensions in input variables + integer, allocatable :: starts(:), counts(:) ! start indices & counts for reading variable slices + integer :: ni,no,ns_o,nst,lev ! indices + integer :: n,m ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: nlev ! number of levels in input file + real(r8) :: glc_sum ! temporary + integer :: ier ! error status + logical :: errors ! error status + real(r8), parameter :: minglac = 1.e-6_r8 ! Minimum glacier amount + character(len=32) :: subname = 'mkglcmec' +!----------------------------------------------------------------------- + + ! Initialize all output fields to zero + + pctglcmec_o(:,:) = 0. + topoglcmec_o(:,:) = 0. + pctglcmec_gic_o(:,:) = 0. + pctglcmec_icesheet_o(:,:) = 0. + pctglc_gic_o(:) = 0. + pctglc_icesheet_o(:) = 0. + + ! Set number of output points + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Exit early, if no glaciers exist + ! ----------------------------------------------------------------- + if ( all(pctglac_o < minglac ) )then + write (6,*) 'No glaciers exist, set glcmec to zero as well' + return + end if + + if ( nglcec == 0 )then + write (6,*) 'Number of glacier elevation classes is zero ',& + '-- set glcmec to zero as well' + call shr_sys_flush(6) + return + end if + + write (6,*) 'Attempting to make percent elevation class ',& + 'and mean elevation for glaciers .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and dimension information from glacier raw data file + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname_fglacier) + nst = tdomain%ns + + ! Read z dimension size + write (6,*) 'Open glacier file: ', trim(datfname_fglacier) + call check_ret(nf_open(datfname_fglacier, 0, ncid), subname) + ier = nf_inq_dimid (ncid, 'z', dimid) + if (ier /= NF_NOERR) then + write (6,*) trim(subname), ' ERROR: z dimension not found on glacier file:' + write (6,*) trim(datfname_fglacier) + write (6,*) 'Perhaps you are trying to use an old-format glacier file?' + write (6,*) '(prior to Sept., 2012)' + call abort() + end if + call check_ret(nf_inq_dimlen (ncid, dimid, nlev), subname) + + ! ----------------------------------------------------------------- + ! Read mapping data, check for consistency with domains + ! ----------------------------------------------------------------- + + ! Mapping for raw glacier -> model output grid + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Determine dimension lengths and create start & count arrays + ! for later reading one level at a time + ! ----------------------------------------------------------------- + + call get_dim_lengths(ncid, 'PCT_GLC_GIC', ndims, dim_lengths) + + allocate(starts(ndims), counts(ndims), stat=ier) + if (ier/=0) call abort() + + starts(1:ndims) = 1 + + ! We assume that the last dimension is the level dimension + counts(1:ndims-1) = dim_lengths(1:ndims-1) + counts(ndims) = 1 + + ! -------------------------------------------------------------------- + ! Compute fields on the output grid + ! -------------------------------------------------------------------- + + allocate(pctglc_gic_i(nst), pctglc_icesheet_i(nst), stat=ier) + if (ier/=0) call abort() + + allocate(topoglcmec_unnorm_o(ns_o,nglcec), stat=ier) + if (ier/=0) call abort() + + topoglcmec_unnorm_o(:,:) = 0. + + write(6,'(a)',advance='no') 'Level: ' + do lev = 1, nlev + write(6,'(i4)',advance='no') lev + + ! Read this level's data + ! We assume that the last dimension is the level dimension + starts(ndims) = lev + call check_ret(nf_inq_varid (ncid, 'BIN_CENTERS', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, (/lev/), (/1/), topoice_i), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLC_GIC', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, pctglc_gic_i), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLC_ICESHEET', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, pctglc_icesheet_i), subname) + + ! Determine elevation class + m = get_elevclass(topoice_i) + if (m < 1 .or. m > nglcec) then + call abort() + end if + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + + ! fraction of this destination cell that is covered by source cells that are within the source landmask + frac = tgridmap%frac_dst(no) + + ! We don't bother with the following if pctglac_o(no) <= minglac, because the + ! pctglcmec_o values will end up being <= minglac. + ! Also, if frac == 0, then we can't do this, to avoid divide by 0. In this case, the + ! outputs remain equal to 0 (their initialized value). + if (pctglac_o(no) > minglac .and. frac > 0) then + pctglc_i = pctglc_gic_i(ni) + pctglc_icesheet_i(ni) + pctglcmec_o(no,m) = pctglcmec_o(no,m) + wt*pctglc_i / frac + pctglcmec_gic_o(no,m) = pctglcmec_gic_o(no,m) + wt*pctglc_gic_i(ni) / frac + pctglcmec_icesheet_o(no,m) = pctglcmec_icesheet_o(no,m) + wt*pctglc_icesheet_i(ni) / frac + + ! note that, by weighting the following by pctglc_i, we are getting something + ! like the average topographic height over glaciated areas - NOT the average + ! topographic height of the entire grid cell + topoglcmec_unnorm_o(no,m) = topoglcmec_unnorm_o(no,m) + wt*pctglc_i*topoice_i / frac + end if + end do + end do + + ! advance to next line (needed because of 'advance=no' writes above) + write(6,*) ' ' + + ! Close glacier input file + call check_ret(nf_close(ncid), subname) + + ! Now pctglcmec_o, pctglcmec_gic_o and pctglcmec_icesheet_o are already normalized + ! appropriately, because for destarea normalization, the sum of the wovr values for a + ! given destination grid cell should equal frac_dst, so sum(wt/frac) = 1 for each + ! destination grid cell. + ! + ! However, we need to normalize topoglcmec_o. To do this, note that pctglcmec_o(n,m) is + ! equal to the sum of the weights used in doing the weighted average of topoice_i + ! (weight = wt*pctglc_i/frac); hence pctglcmec_o(n,m) is the correct normalization + ! factor + do no = 1,ns_o + do m = 1,nglcec + if (pctglcmec_o(no,m) > 0) then + topoglcmec_o(no,m) = topoglcmec_unnorm_o(no,m) / pctglcmec_o(no,m) + end if + + ! Correct for rounding errors that put topoglcmec_o(no,m) slightly outside the + ! allowed bounds for this elevation class + if (slightly_below(topoglcmec_o(no,m), elevclass(m))) then + write(6,*) 'Warning: topoglcmec_o was slightly lower than lower bound; setting equal& + & to lower bound; for: ', no, m, topoglcmec_o(no,m), elevclass(m) + write(6,*) '(this is informational only, and probably just indicates rounding error)' + topoglcmec_o(no,m) = elevclass(m) + else if (slightly_above(topoglcmec_o(no,m), elevclass(m+1))) then + write(6,*) 'Warning: topoglcmec_o was slightly higher than upper bound; setting equal& + & to upper bound; for: ', no, m, topoglcmec_o(no,m), elevclass(m+1) + write(6,*) '(this is informational only, and probably just indicates rounding error)' + topoglcmec_o(no,m) = elevclass(m+1) + end if + end do + end do + + ! We want the sum of pctglcmec_o across elevation classes to equal pctglac_o for each + ! grid cell. This should be approximately true at this point, but there have been a + ! number of adjustments to pctglac_o since its original remapping (e.g., setting values + ! < 1 to 0, and rescaling all percentages so that the total landcover is equal to + ! 100%). We need to essentially apply these same adjustments to pctglcmec_o. + ! + ! To do this, we use the stored, uncorrected values of pctglac_o. In theory, we could do + ! this renormalization without reference to these uncorrected values, since + ! pctglac_o_uncorrected should equal the sum of pctglcmec_o across elevation classes for + ! each grid cell. However, pctglac_o_uncorrected is helpful for error checking: it + ! allows us to verify that the pctglcmec sums are correct (this check is done below). + ! + ! Here we also rescale pctglcmec_gic_o and pctglcmec_icesheet_o similarly, to + ! achieve the same thing (i.e., we want sums to add up to pct_glacier) + do no = 1,ns_o + if (pctglac_o_uncorrected(no) > 0) then + pctglcmec_o(no,:) = pctglcmec_o(no,:) * (pctglac_o(no) / pctglac_o_uncorrected(no)) + pctglcmec_gic_o(no,:) = pctglcmec_gic_o(no,:) * (pctglac_o(no) / pctglac_o_uncorrected(no)) + pctglcmec_icesheet_o(no,:) = pctglcmec_icesheet_o(no,:) * (pctglac_o(no) / pctglac_o_uncorrected(no)) + + else if (pctglac_o_uncorrected(no) == 0 .and. pctglac_o(no) > 0) then + ! There isn't a clear way to handle the case when pctglac_o_uncorrected==0 (and + ! hence pctglcmec_o==0 for all elevation classes) but pctglac_o==0. Fortunately, + ! this should never happen: the only place where there is a potential for this is + ! over the south pole, where pctglac_o is set to 100%. + + write(6,*) 'ERROR in ', subname + write(6,*) 'pctglac_o_uncorrected==0 but pctglac_o > 0' + write(6,*) 'no = ', no + write(6,*) 'lon = ', tgridmap%xc_dst(no) + write(6,*) 'lat = ', tgridmap%yc_dst(no) + call abort() + end if + + ! The only other possibility is that (pctglac_o_uncorrected(no) == 0 .and. + ! pctglac_o(no) == 0); but in this case, all pctglcmec_o(no,:) values should be 0 + ! and can remain 0 (and similarly for pctglc_gic, pctglc_icesheet, etc.) + end do + + ! Set pctglc_gic_o to sum of pctglcmec_gic_o across elevation classes, and similarly for pctglc_icesheet_o + pctglc_gic_o = sum(pctglcmec_gic_o, dim=2) + pctglc_icesheet_o = sum(pctglcmec_icesheet_o, dim=2) + + ! -------------------------------------------------------------------- + ! Perform various sanity checks + ! -------------------------------------------------------------------- + + errors = .false. + + ! Check that sum over pctglcmec_o (from 1 to nglcec) is equal to pctglac_o(no) + ! + ! Note: We use a threshold of 2e-5 rather than 1e-6 or smaller because there is single- + ! precision roundoff error in the storage of the flat (i.e., non-multi-level) + ! PCT_GLACIER variable on the input dataset (which is used to compute pctglac_o) (since + ! the input dataset uses single-precision floats) + do no = 1,ns_o + glc_sum = 0. + do m = 1,nglcec + glc_sum = glc_sum + pctglcmec_o(no,m) + end do + if (abs(glc_sum - pctglac_o(no)) > 2.e-5) then + write(6,*)'no,pctglc,pctglac= ',no,glc_sum,pctglac_o(no) + errors = .true. + end if + end do + + ! Check that GIC + ICESHEET = total glacier, for variables summed over elevation classes + ! + ! Note: We use a threshold of 2e-5 rather than 1e-6 or smaller because there is single- + ! precision roundoff error in the storage of the flat (i.e., non-multi-level) + ! PCT_GLACIER variable on the input dataset (which is used to compute pctglac_o) (since + ! the input dataset uses single-precision floats) + do no = 1,ns_o + if (abs((pctglc_gic_o(no) + pctglc_icesheet_o(no)) - pctglac_o(no)) > 2.e-5) then + write(6,*)'no,pctglc_gic,pctglc_icesheet,pctglac,pctglac_uncorrected,lon,lat=',no,pctglc_gic_o(no),& + pctglc_icesheet_o(no),pctglac_o(no),pctglac_o_uncorrected(no),tgridmap%& + xc_dst(no),tgridmap%yc_dst(no) + errors = .true. + end if + end do + + ! Check that GIC + ICESHEET = total glacier, for each elevation class + do m = 1,nglcec + do no = 1,ns_o + if (abs((pctglcmec_gic_o(no,m) + pctglcmec_icesheet_o(no,m)) - pctglcmec_o(no,m)) > 1.e-6) then + write(6,*)'no,m,pctglcmec_gic,pctglcmec_icesheet,pctglcmec,lat,lon=',no,m,& + pctglcmec_gic_o(no,m),pctglcmec_icesheet_o(no,m),pctglcmec_o(no,m),& + tgridmap%xc_dst(no),tgridmap%yc_dst(no) + errors = .true. + end if + end do + end do + + ! Error check: are all elevations within elevation class range + do no = 1,ns_o + if (pctglac_o(no) .gt. minglac) then + do m = 1,nglcec + ! WJS (7-12-11): the original check was ((topo outside range) and (topo .ne. + ! 0)). I think that the second condition is meant to essentially check whether + ! pctglcmec_o(no,m) > 0. So I think we could just check whether ((topo outside + ! range) and (pctglcmec_o(no,m) > 0). However, I am keeping a warning message + ! if ((topo outside range) and (topo .ne. 0)) as well, because I don't want to + ! get rid of error checks. + if ( (topoglcmec_o(no,m) .lt. elevclass(m) .or. topoglcmec_o(no,m) .gt. elevclass(m+1)) & + .and. (pctglcmec_o(no,m) .gt. 0 .or. topoglcmec_o(no,m) .ne. 0)) then + write(6,*) 'Error: mean elevation does not fall within elevation class ' + write(6,*) elevclass(m),elevclass(m+1),topoglcmec_o(no,m),pctglcmec_o(no,m),m,no + errors = .true. + endif + end do + end if + end do + + if (errors) then + call abort() + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate(pctglc_gic_i, pctglc_icesheet_i) + deallocate(topoglcmec_unnorm_o) + deallocate(starts, counts) + + write (6,*) 'Successfully made percent elevation class and mean elevation for glaciers' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkglcmec + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglacier +! +! !INTERFACE: +subroutine mkglacier(ldomain, mapfname, datfname, ndiag, zero_out, glac_o, glac_uncorrected) +! +! !DESCRIPTION: +! make percent glacier +! +! In contrast to mkglcmec, this uses a "flat" PCT_GLACIER field (not separated by +! elevation class, and not separated into icesheet vs GIC). +! +! This simpler routine is sufficient for cases when we run without multiple elevation +! classes. This routine is also used when running with multiple elevation classes: we +! first regrid the flat PCT_GLACIER field, then later create the multiple elevation class +! data. This multi-step process makes it easier to do corrections on the total +! PCT_GLACIER, and make sure these corrections apply appropriately to the multi-level +! output. The assumption is that PCT_GLACIER is the sum of both PCT_GLC_GIC and +! PCT_GLC_ICESHEET across all elevation bins. +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: glac_o(:) ! output grid: %glacier + real(r8) , intent(out):: glac_uncorrected(:) ! output grid: %glacier before any + ! corrections are done +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: glac_i(:) ! input grid: percent glac + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gglac_i ! input grid: global glac + real(r8) :: garea_i ! input grid: global area + real(r8) :: gglac_o ! output grid: global glac + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkglacier' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %glacier .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns = tdomain%ns + allocate(glac_i(ns), stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open glacier file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLACIER', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, glac_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + if ( zero_out )then + + do no = 1, ldomain%ns + glac_o(no) = 0. + enddo + + else + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine glac_o on output grid + + call gridmap_areaave(tgridmap, glac_i, glac_o) + + ! Save a copy of glac_o before any corrections are done. This is needed for + ! normalization in mkglcmec + glac_uncorrected(:) = glac_o(:) + + do no = 1, ldomain%ns + if (glac_o(no) < 1.) glac_o(no) = 0. + enddo + end if + + ! Check for conservation + + do no = 1, ldomain%ns + if ((glac_o(no)) > 100.000001_r8) then + write (6,*) 'MKGLACIER error: glacier = ',glac_o(no), & + ' greater than 100.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + + ! Some error checking and writing of global values before and after the regrid + + if ( .not. zero_out )then + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1, tdomain%ns + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1, ldomain%ns + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKGLACIER error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gglac_i = 0. + garea_i = 0. + do ni = 1, tdomain%ns + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gglac_i = gglac_i + glac_i(ni)*(tgridmap%area_src(ni)/100.)*& + tgridmap%frac_src(ni)*re**2 + end do + + ! Output grid + + gglac_o = 0. + garea_o = 0. + do no = 1, ldomain%ns + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gglac_o = gglac_o + glac_o(no)*(tgridmap%area_dst(no)/100.)*& + tgridmap%frac_dst(no)*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Glacier Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) gglac_i*1.e-06,gglac_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'glaciers ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (glac_i) + end if + + write (6,*) 'Successfully made %glacier' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkglacier + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: get_elevclass +! +! !INTERFACE: +integer function get_elevclass(topo, writewarn) +! +! !DESCRIPTION: +! Returns elevation class index (1..nglcec) given the topographic height. +! If topo is lower than the lowest elevation class, returns 0. +! If topo is higher than the highest elevation class, returns (nglcec+1). +! In either of the two latter cases, the function also writes a warning message, unless +! writewarn is present and false. +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: topo ! topographic height (m) + logical, intent(in), optional :: writewarn ! should warning messages be written? (default: true) +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! !LOCAL VARIABLES: +!EOP + integer :: m + logical :: my_writewarn + character(len=32) :: subname = 'mkglcmec' +!----------------------------------------------------------------------- + + if (present(writewarn)) then + my_writewarn = writewarn + else + my_writewarn = .true. + end if + + if (topo < elevclass(1)) then + if (my_writewarn) then + write(6,*) 'WARNING in ', trim(subname) + write(6,*) 'topo out of bounds' + write(6,*) 'topo = ', topo + write(6,*) 'elevclass(1) = ', elevclass(1) + end if + get_elevclass = 0 + return + end if + + do m = 1, nglcec + if (topo < elevclass(m+1)) then + ! note that we already know that topo >= elevclass(m), otherwise we would have + ! returned earlier + get_elevclass = m + return + end if + end do + + if (my_writewarn) then + write(6,*) 'WARNING in ', trim(subname) + write(6,*) 'topo out of bounds' + write(6,*) 'topo = ', topo + write(6,*) 'elevclass(nglcec+1) = ', elevclass(nglcec+1) + end if + get_elevclass = nglcec+1 + +end function get_elevclass + +!----------------------------------------------------------------------- + +end module mkglcmecMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 new file mode 100644 index 0000000000..6c11952f61 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkgridmapMod.F90 @@ -0,0 +1,530 @@ +module mkgridmapMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkgridmapMod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + +! !PUBLIC TYPES: + type gridmap_type + character(len=32) :: set ! If set or not + character(len=32) :: name + integer :: na ! size of source domain + integer :: nb ! size of destination domain + integer :: ni ! number of row in the matrix + integer :: nj ! number of col in the matrix + integer :: ns ! number of non-zero elements in matrix + real(r8), pointer :: yc_src(:) ! "degrees" + real(r8), pointer :: yc_dst(:) ! "degrees" + real(r8), pointer :: xc_src(:) ! "degrees" + real(r8), pointer :: xc_dst(:) ! "degrees" + integer , pointer :: mask_src(:) ! "unitless" + integer , pointer :: mask_dst(:) ! "unitless" + real(R8), pointer :: area_src(:) ! area of a grid in map (radians) + real(R8), pointer :: area_dst(:) ! area of b grid in map (radians) + real(r8), pointer :: frac_src(:) ! "unitless" + real(r8), pointer :: frac_dst(:) ! "unitless" + integer , pointer :: src_indx(:) ! correpsonding column index + integer , pointer :: dst_indx(:) ! correpsonding row index + real(r8), pointer :: wovr(:) ! wt of overlap input cell + end type gridmap_type + public :: gridmap_type +! +! !PUBLIC MEMBER FUNCTIONS: + public :: gridmap_setptrs ! Set pointers to gridmap data + public :: gridmap_mapread ! Read in gridmap + public :: gridmap_areaave ! do area average + public :: gridmap_clean ! Clean and deallocate a gridmap structure +! +! +! !REVISION HISTORY: +! Author Mariana Vertenstein + + interface gridmap_areaave + module procedure gridmap_areaave_default + module procedure gridmap_areaave_srcmask + module procedure gridmap_areaave_srcmask2 + end interface + + ! questions - how does the reverse mapping occur + ! is mask_dst read in - and what happens if this is very different + ! from frac_dst which is calculated by mapping frac_src? + ! in frac - isn't grid1_frac always 1 or 0? + +! !PRIVATE MEMBER FUNCTIONS: + private :: gridmap_checkifset + + character(len=32), parameter :: isSet = "gridmap_IsSet" + +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_setptrs +! +! !INTERFACE: + subroutine gridmap_setptrs(gridmap, nsrc, ndst, ns, yc_src, yc_dst, & + xc_src, xc_dst, mask_src, mask_dst, & + frac_src, frac_dst, src_indx, dst_indx ) +! +! !DESCRIPTION: +! This subroutine assigns pointers to some of the map type data. +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! mapping data + integer, optional :: nsrc ! size of source domain + integer, optional :: ndst ! size of destination domain + integer, optional :: ns ! number of non-zero elements in matrix + integer, optional, pointer :: dst_indx(:) ! Destination index + integer, optional, pointer :: src_indx(:) ! Destination index + real(r8), optional, pointer :: yc_src(:) ! "degrees" + real(r8), optional, pointer :: yc_dst(:) ! "degrees" + real(r8), optional, pointer :: xc_src(:) ! "degrees" + real(r8), optional, pointer :: xc_dst(:) ! "degrees" + integer , optional, pointer :: mask_src(:) ! "unitless" + integer , optional, pointer :: mask_dst(:) ! "unitless" + real(r8), optional, pointer :: frac_src(:) ! "unitless" + real(r8), optional, pointer :: frac_dst(:) ! "unitless" +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------------ + character(*),parameter :: subName = '(gridmap_setptrs) ' + + call gridmap_checkifset( gridmap, subname ) + if ( present(nsrc) ) nsrc = gridmap%na + if ( present(ndst) ) ndst = gridmap%nb + if ( present(ns) ) ns = gridmap%ns + if ( present(yc_src) ) yc_src => gridmap%yc_src + if ( present(xc_src) ) xc_src => gridmap%xc_src + if ( present(mask_src) ) mask_src => gridmap%mask_src + if ( present(frac_src) ) frac_src => gridmap%frac_src + if ( present(yc_dst) ) yc_dst => gridmap%yc_dst + if ( present(xc_dst) ) xc_dst => gridmap%xc_dst + if ( present(mask_dst) ) mask_dst => gridmap%mask_dst + if ( present(frac_dst) ) frac_dst => gridmap%frac_dst + if ( present(dst_indx) ) dst_indx => gridmap%dst_indx + if ( present(src_indx) ) src_indx => gridmap%src_indx + end subroutine gridmap_setptrs + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_mapread +! +! !INTERFACE: + subroutine gridmap_mapread(gridmap, fileName) +! +! !DESCRIPTION: +! This subroutine reads in the map file +! +! !USES: + use mkutilsMod, only : convert_latlon +! +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + type(gridmap_type), intent(out) :: gridmap ! mapping data + character(len=*) , intent(in) :: filename ! netCDF file to read +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n ! generic loop indicies + integer :: na ! size of source domain + integer :: nb ! size of destination domain + integer :: igrow ! aVect index for matrix row + integer :: igcol ! aVect index for matrix column + integer :: iwgt ! aVect index for matrix element + integer :: iarea ! aVect index for area + + + character,allocatable :: str(:) ! variable length char string + character(len=256) :: attstr ! netCDF attribute name string + integer :: rcode ! netCDF routine return code + integer :: fid ! netCDF file ID + integer :: vid ! netCDF variable ID + integer :: did ! netCDF dimension ID + integer :: ns ! size of array + + real(r8), parameter :: tol = 1.0e-4_r8 ! tolerance for checking that mapping data + ! are within expected bounds + + !--- formats --- + character(*),parameter :: subName = '(gridmap_map_read) ' + character(*),parameter :: F00 = '("(gridmap_map_read) ",4a)' + character(*),parameter :: F01 = '("(gridmap_map_read) ",2(a,i7))' +!EOP +!------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + write(6,F00) "reading mapping matrix data..." + + ! open & read the file + write(6,F00) "* file name : ",trim(fileName) + + rcode = nf_open(filename ,NF_NOWRITE, fid) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + !--- allocate memory & get matrix data ---------- + rcode = nf_inq_dimid (fid, 'n_s', did) ! size of sparse matrix + rcode = nf_inq_dimlen(fid, did , gridmap%ns) + rcode = nf_inq_dimid (fid, 'n_a', did) ! size of input vector + rcode = nf_inq_dimlen(fid, did , gridmap%na) + rcode = nf_inq_dimid (fid, 'n_b', did) ! size of output vector + rcode = nf_inq_dimlen(fid, did , gridmap%nb) + + write(6,*) "* matrix dimensions rows x cols :",gridmap%na,' x',gridmap%nb + write(6,*) "* number of non-zero elements: ",gridmap%ns + + ns = gridmap%ns + na = gridmap%na + nb = gridmap%nb + allocate(gridmap%wovr(ns) , & + gridmap%src_indx(ns), & + gridmap%dst_indx(ns), & + gridmap%mask_src(na), & + gridmap%area_src(na), & + gridmap%frac_src(na), & + gridmap%area_dst(nb), & + gridmap%frac_dst(nb), & + gridmap%mask_dst(nb), & + gridmap%xc_dst(nb), & + gridmap%yc_dst(nb), & + gridmap%xc_src(na), & + gridmap%yc_src(na), stat=rcode) + if (rcode /= 0) then + write(6,*) SubName//' ERROR: allocate gridmap' + call abort() + endif + + rcode = nf_inq_varid(fid,'S' ,vid) + rcode = nf_get_var_double(fid,vid ,gridmap%wovr) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'row',vid) + rcode = nf_get_var_int(fid, vid ,gridmap%dst_indx) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'col',vid) + rcode = nf_get_var_int(fid, vid, gridmap%src_indx) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'area_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%area_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'area_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%area_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'frac_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%frac_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%frac_src(:) < 0.0_r8 .or. gridmap%frac_src > (1.0_r8 + tol)) )then + write(6,*) SubName//' ERROR: frac_src out of bounds' + write(6,*) 'max = ', maxval(gridmap%frac_src), ' min = ', minval(gridmap%frac_src) + call abort() + end if + + rcode = nf_inq_varid(fid,'frac_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%frac_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%frac_dst(:) < 0.0_r8 .or. gridmap%frac_dst > (1.0_r8 + tol)) )then + write(6,*) SubName//' ERROR: frac_dst out of bounds' + write(6,*) 'max = ', maxval(gridmap%frac_dst), ' min = ', minval(gridmap%frac_dst) + call abort() + end if + + rcode = nf_inq_varid(fid,'mask_a',vid) + rcode = nf_get_var_int(fid, vid, gridmap%mask_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%mask_src(:) < 0 .or. gridmap%mask_src > 1) )then + write(6,*) SubName//' ERROR: mask_src out of bounds' + call abort() + end if + + rcode = nf_inq_varid(fid,'mask_b',vid) + rcode = nf_get_var_int(fid, vid, gridmap%mask_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%mask_dst(:) < 0 .or. gridmap%mask_dst > 1) )then + write(6,*) SubName//' ERROR: mask_dst out of bounds' + call abort() + end if + + rcode = nf_inq_varid(fid,'xc_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%xc_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'xc_a', gridmap%xc_src) + + rcode = nf_inq_varid(fid,'yc_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%yc_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'yc_a', gridmap%yc_src) + + rcode = nf_inq_varid(fid,'xc_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%xc_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'xc_b', gridmap%xc_dst) + + rcode = nf_inq_varid(fid,'yc_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%yc_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'yc_b', gridmap%yc_dst) + + rcode = nf_close(fid) + + gridmap%set = IsSet + + end subroutine gridmap_mapread + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_default +! +! !INTERFACE: + subroutine gridmap_areaave_default (gridmap, src_array, dst_array) +! +! !DESCRIPTION: +! This subroutine does a simple area average +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt,frac + character(*),parameter :: subName = '(gridmap_areaave_default) ' +!EOP +!------------------------------------------------------------------------------ + call gridmap_checkifset( gridmap, subname ) + dst_array = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + frac = gridmap%frac_dst(no) + if (frac > 0.) then + dst_array(no) = dst_array(no) + wt * src_array(ni)/frac + end if + end do + + end subroutine gridmap_areaave_default + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_srcmask +! +! !INTERFACE: + subroutine gridmap_areaave_srcmask (gridmap, src_array, dst_array, mask_src) +! +! !DESCRIPTION: +! This subroutine does an area average with the source mask +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: mask_src(:) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt + real(r8), allocatable :: wtnorm(:) + character(*),parameter :: subName = '(gridmap_areaave_srcmask) ' +!EOP +!------------------------------------------------------------------------------ + call gridmap_checkifset( gridmap, subname ) + ns = size(dst_array) + allocate(wtnorm(ns)) + wtnorm(:) = 0._r8 + + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + wtnorm(no) = wtnorm(no) + wt*mask_src(ni) + end if + end do + + dst_array = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + dst_array(no) = dst_array(no) + wt*mask_src(ni)*src_array(ni)/wtnorm(no) + end if + end do + + deallocate(wtnorm) + + end subroutine gridmap_areaave_srcmask + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_srcmask2 +! +! !INTERFACE: + subroutine gridmap_areaave_srcmask2 (gridmap, src_array, dst_array, mask_src, & + mask_dst, mask_dst_min) +! +! !DESCRIPTION: +! This subroutine does an area average with the source mask and making sure the +! destination mask is valid as well. +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: mask_src(:) + real(r8), intent(in) :: mask_dst(:) + real(r8), intent(in) :: mask_dst_min +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt + real(r8), allocatable :: wtnorm(:) + character(*),parameter :: subName = '(gridmap_areaave_srcmask2) ' +!EOP +!------------------------------------------------------------------------------ + + call gridmap_checkifset( gridmap, subname ) + ns = size(dst_array) + allocate(wtnorm(ns)) + wtnorm(:) = 0._r8 + + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + wtnorm(no) = wtnorm(no) + wt*mask_src(ni) + end if + end do + + dst_array = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_dst(no) > mask_dst_min) then + if (mask_src(ni) > 0) then + dst_array(no) = dst_array(no) + wt*mask_src(ni)*src_array(ni)/wtnorm(no) + end if + end if + end do + + deallocate(wtnorm) + + end subroutine gridmap_areaave_srcmask2 + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_clean +! +! !INTERFACE: + subroutine gridmap_clean(gridmap) +! +! !DESCRIPTION: +! This subroutine deallocates the gridmap type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(inout) :: gridmap +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subName = "gridmap_clean" + integer ier ! error flag +!EOP +!------------------------------------------------------------------------------ + if ( gridmap%set .eq. IsSet )then + deallocate(gridmap%wovr , & + gridmap%src_indx, & + gridmap%dst_indx, & + gridmap%mask_src, & + gridmap%mask_dst, & + gridmap%area_src, & + gridmap%area_dst, & + gridmap%frac_src, & + gridmap%frac_dst, & + gridmap%xc_src, & + gridmap%yc_src, stat=ier) + if (ier /= 0) then + write(6,*) SubName//' ERROR: deallocate gridmap' + call abort() + endif + else + write(6,*) SubName//' Warning: calling '//trim(subName)//' on unallocated gridmap' + end if + gridmap%set = "NOT-set" + + end subroutine gridmap_clean + +!========================================================================== + + subroutine gridmap_checkifset( gridmap, subname ) + + implicit none + type(gridmap_type), intent(in) :: gridmap + character(len=*), intent(in) :: subname + + if ( gridmap%set .ne. IsSet )then + write(6,*) SubName//' ERROR: gridmap NOT set yet, run gridmap_mapread first' + call abort() + end if + end subroutine gridmap_checkifset + +end module mkgridmapMod + + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkharvestMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkharvestMod.F90 new file mode 100644 index 0000000000..133dcd3289 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkharvestMod.F90 @@ -0,0 +1,458 @@ +module mkharvestMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkharvest +! +! !DESCRIPTION: +! Make harvest and grazing data to add to the dynamic PFT file. +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkharvest_init ! Initialization + public mkharvest ! Calculate the harvest values on output grid + public mkharvest_fieldname ! Field name + public mkharvest_longname ! Long name + public mkharvest_numtypes ! Number of harvest types + public mkharvest_parse_oride ! Parse the over-ride string + +! !PRIVATE DATA MEMBERS: + + integer, parameter :: numharv = 6 ! number of harvest and grazing fields + integer, parameter :: harlen = 12 ! length of strings for harvest fieldnames + character(len=harlen), parameter :: harvest_fieldnames(numharv) = (/ & + 'HARVEST_VH1', & + 'HARVEST_VH2', & + 'HARVEST_SH1', & + 'HARVEST_SH2', & + 'HARVEST_SH3', & + 'GRAZING ' & + /) + character(len=CL), parameter :: string_undef = 'STRING_UNDEFINED' + real(r8), parameter :: real_undef = -999.99 + character(len=CL), save :: harvest_longnames(numharv) = string_undef + real(r8), pointer :: oride_harv(:) ! array that can override harvesting + + +!EOP +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_init +! +! !INTERFACE: + subroutine mkharvest_init( ns_o, init_val, harvest, fharvest ) +! +! !DESCRIPTION: +! Initialization of mkharvest module. +! +! !USES: + use mkncdio + implicit none +! +! !ARGUMENTS: + integer , intent(in) :: ns_o ! clm output grid resolution + real(r8) , intent(in) :: init_val ! initial value to set to + real(r8) , pointer :: harvest(:,:) ! output grid: normalized harvesting + character(len=*), intent(in) :: fharvest ! input harvest dataset file name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_init' + integer :: ncid,varid ! input netCDF id's + integer :: ifld ! indices +!EOP +!----------------------------------------------------------------------- + + allocate(harvest(ns_o,numharv)) + harvest(:,:) = init_val + + call check_ret(nf_open(fharvest, 0, ncid), subname) + do ifld = 1, numharv + call check_ret(nf_inq_varid ( ncid, mkharvest_fieldname(ifld), varid), subname) + call check_ret(nf_get_att_text( ncid, varid, 'long_name', harvest_longnames(ifld)), subname) + end do + + call check_ret(nf_close(ncid), subname) + + allocate( oride_harv(numharv) ) + oride_harv(:) = real_undef + + end subroutine mkharvest_init + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_fieldname +! +! !INTERFACE: + character(len=harlen) function mkharvest_fieldname( nfield ) +! +! !DESCRIPTION: +! Return harvest fieldname of input field number. +! +! !USES: + implicit none +! +! !ARGUMENTS: + integer, intent(in) :: nfield +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_fieldname' +!EOP +!----------------------------------------------------------------------- + + if ( nfield < 1 )then + write(6,*) subname, ' error nfield < 1' + call abort() + else if ( nfield > numharv )then + write(6,*) subname, ' error nfield > max fields' + call abort() + else + mkharvest_fieldname = harvest_fieldnames(nfield) + end if + + end function mkharvest_fieldname + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_longname +! +! !INTERFACE: + character(len=CL) function mkharvest_longname( nfield ) +! +! !DESCRIPTION: +! Return longname description of given input field number. +! +! !USES: + implicit none +! +! !ARGUMENTS: + integer, intent(in) :: nfield +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_longname' +!EOP +!----------------------------------------------------------------------- + + if ( nfield < 1 )then + write(6,*) subname, ' error nfield < 1' + call abort() + else if ( nfield > numharv )then + write(6,*) subname, ' error nfield > max fields' + call abort() + else + if ( trim(harvest_longnames(nfield)) .eq. trim(string_undef) )then + write(6,*) subname, ' error harvest_longnames not set yet' + call abort() + end if + mkharvest_longname = harvest_longnames(nfield) + end if + + end function mkharvest_longname + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_numtypes +! +! !INTERFACE: + integer function mkharvest_numtypes( ) +! +! !DESCRIPTION: +! Return number of different harvest field types. +! +! !USES: + implicit none +! +! !ARGUMENTS: + character(len=*), parameter :: subname = 'mkharvest_numtypes' +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + mkharvest_numtypes = numharv + + end function mkharvest_numtypes + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest +! +! !INTERFACE: +subroutine mkharvest(ldomain, mapfname, datfname, ndiag, harv_o) +! +! !DESCRIPTION: +! Make harvest data for the dynamic PFT dataset. +! This dataset consists of the normalized harvest or grazing fraction (0-1) of +! the model. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: harv_o(:,:) ! output grid: normalized harvesting +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: harv_i(:,:) ! input grid: harvest/grazing percent + real(r8), allocatable :: pctlnd_o(:) ! output grid: percent land + real(r8) :: gharv_o(numharv) ! output grid: global area harvesting + real(r8) :: garea_o ! output grid: global area + real(r8) :: gharv_i(numharv) ! input grid: global area harvesting + real(r8) :: garea_i ! input grid: global area + integer :: ifld ! indices + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + character(len=*), parameter :: unit = '10**6 km**2' ! Output units + real(r8), parameter :: fac = 1.e-06_r8 ! Output factor + real(r8), parameter :: rat = fac/100._r8 ! Output factor divided by 100% + character(len=*), parameter :: subname = 'mkharvest' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make harvest fields .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Normally read in the harvesting file, and then regrid to output grid + ! ----------------------------------------------------------------- + + if ( all(oride_harv == real_undef ) )then + + ! ----------------------------------------------------------------- + ! Read input harvesting file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read HARVEST_VH1, HARVEST_VH2, ... GRAZING etc. + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(harv_i(ns_i,1:numharv), stat=ier) + if (ier/=0) call abort() + ns_o = ldomain%ns + + write (6,*) 'Open harvest file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + do ifld = 1, numharv + call check_ret(nf_inq_varid(ncid, mkharvest_fieldname(ifld), varid), subname) + call check_ret(nf_get_var_double (ncid, varid, harv_i(:,ifld)), subname) + end do + call check_ret(nf_close(ncid), subname) + + ! Area-average normalized harvest on input grid [harv_i] to output grid [harv_o] + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine harv_o on output grid + + do ifld = 1,numharv + call gridmap_areaave(tgridmap, harv_i(:,ifld), harv_o(:,ifld)) + end do + + ! ----------------------------------------------------------------- + ! Error check + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + gharv_i(:) = 0. + garea_i = 0. + do ni = 1, ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + do m = 1, numharv + gharv_i(m) = gharv_i(m) + harv_i(ni,m)*tgridmap%area_src(ni)* & + tgridmap%frac_src(ni)*re**2 + end do + end do + + gharv_o(:) = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + do m = 1, numharv + gharv_o(m) = gharv_o(m) + harv_o(no,m)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Write out to diagnostic output file + ! + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Harvesting Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) unit, unit +1001 format (1x,'harvest type ',20x,' input grid area',' output grid area',/ & + 1x,33x,' ',A,' ',A) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do m = 1, numharv + write (ndiag,1002) mkharvest_fieldname(m), gharv_i(m)*rat,gharv_o(m)*rat + end do +1002 format (1x,a35,f16.3,f17.3) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (harv_i) + + else + + ! ----------------------------------------------------------------- + ! Otherwise override the harvesting with the input harvest values + ! ----------------------------------------------------------------- + + if ( any(oride_harv == real_undef ) )then + write(6,*) subname, ' error some override harvesting fields set ', & + 'and others are not = ', oride_harv + call abort() + end if + do m = 1, numharv + if ( oride_harv(m) < 0.0_r8 .or. oride_harv(m) > 100.0_r8 )then + write(6,*) subname, ' error override harvesting field out of range', & + oride_harv(m), ' field = ', mkharvest_fieldname(m) + call abort() + end if + end do + do no = 1,ns_o + do m = 1, numharv + harv_o(no,m) = oride_harv(m) + end do + end do + + end if + + write (6,*) 'Successfully made harvest and grazing' + write (6,*) + +end subroutine mkharvest + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_parse_oride +! +! !INTERFACE: +subroutine mkharvest_parse_oride( string ) +! +! !DESCRIPTION: +! Parse the string with harvest and grazing information on it, to override +! the file with this information rather than reading from a file. +! +! !USES: + use shr_string_mod, only: shr_string_betweenTags +! !ARGUMENTS: + character(len=256), intent(IN) :: string ! String to parse with harvest and grazing data +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: rc ! error return code + character(len=256) :: substring ! substring between tags + character(len=*), parameter :: harv_start = "" + character(len=*), parameter :: harv_end = "" + character(len=*), parameter :: graz_start = "" + character(len=*), parameter :: graz_end = "" + character(len=*), parameter :: subname = 'mkharvest_parse_oride' +!----------------------------------------------------------------------- + call shr_string_betweenTags( string, harv_start, harv_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding harvest start end tags' + call abort() + end if + read(substring,*) oride_harv(1:numharv-1) + call shr_string_betweenTags( string, graz_start, graz_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding grazing start end tags' + call abort() + end if + read(substring,*) oride_harv(numharv) + if ( harvest_fieldnames(numharv) /= 'GRAZING' )then + write(6,*) subname, ' grazing is NOT last field as was expected' + call abort() + end if + +!----------------------------------------------------------------------- + +end subroutine mkharvest_parse_oride + +!----------------------------------------------------------------------- + +end module mkharvestMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkindexmapMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkindexmapMod.F90 new file mode 100644 index 0000000000..cdafb41c07 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkindexmapMod.F90 @@ -0,0 +1,700 @@ +module mkindexmapMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkindexmapMod +! +! !DESCRIPTION: +! Module containing subroutines for making maps of index data. +! +! This includes a routine for making a map using the dominant type among the input grid +! cells making up a given output cell, as well as routines for using an index map as +! indices into a lookup table, to essentially paint-by-number some other field, and some +! other related routines +! +! WJS (2-1-12): There is a lookup_2d subroutine, but not a lookup_1d (or any other +! dimensionality). That is simply because I needed lookup_2d, but have not yet needed a +! routine of other dimensionalities. In the future, it would probably be helpful to at +! least have lookup_1d and lookup_1d_netcdf. If this is done, see my notes under the +! lookup_2d_netcdf routine for some thoughts on avoiding duplication. +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkncdio, only : nf_max_name + + implicit none + private + +! !PUBLIC TYPES: +! + ! dim_slice_type: stores information about dimensions that we use for slicing a multi- + ! dimensional variable + type dim_slice_type + character(len=nf_max_name) :: name ! name of this dimension + integer :: val ! index to use for the slice + end type dim_slice_type + public :: dim_slice_type +! +! !PUBLIC MEMBER FUNCTIONS: + public :: get_dominant_indices ! make output map based on dominant type in each grid cell + public :: filter_same ! build a filter of overlaps where src_val == dst_val + public :: lookup_2d ! create map based on a 2-d lookup table + public :: lookup_2d_netcdf ! wrapper to lookup_2d; first read table from netcdf file + public :: which_max ! get index of the maximum value in an array +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: get_dominant_indices +! +! !INTERFACE: +subroutine get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter) +! +! !DESCRIPTION: +! Fills an output array on the destination grid (dst_array) whose values are equal to the +! (weighted) dominant value in the source grid cells overlapping a given destination grid +! cell +! +! Ignores all values in src_array that are less than minval or greater than maxval (treats +! those values the same as if they had wt=0). (Note: for memory-use efficiency, it is +! best if the indices are designed such that most values between minval and maxval are +! actually used, since an array is allocated of size (maxval - minval + 1)*gridmap%nb.) +! +! The filter argument can be used to exclude certain overlaps -- if provided, we only +! consider overlaps where filter is .true. For example, see mkurbanparDomMod, where we +! first determine the dominant density class in each output cell, then determine the +! dominant region, but in the latter only considering overlapping source points whose +! density matches the dominant density in the output cell. If not provided, filter is +! treated as being .true. everywhere. +! +! Output grid cells with no contributing valid source points are given the nodata value +! +! !USES: + use mkgridmapMod, only : gridmap_type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! provides mapping from src -> dst + integer , intent(in) :: src_array(:) ! input values; length gridmap%na + integer , intent(out):: dst_array(:) ! output values; length gridmap%nb + integer , intent(in) :: minval ! minimum valid value in src_array + integer , intent(in) :: maxval ! maximum valid value in src_array + integer , intent(in) :: nodata ! value to assign to dst_array where there are no valid source points + + logical, intent(in), optional :: filter(:) ! only consider overlaps where filter is .true.; length gridmap%ns +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical, allocatable :: lfilter(:) ! local version of filter + logical, allocatable :: hasdata(:) ! true if an output cell has any valid data; + real(r8), allocatable :: weights(:,:) ! summed weight of each index value for each output cell + + integer :: n, ni, no + integer :: k + integer :: maxindex + real(r8) :: wt + real(r8) :: maxwt + + character(len=*), parameter :: subname = "get_dominant_indices" +!----------------------------------------------------------------------- + + ! Error-check inputs and initialize local variables + + if (size(src_array) /= gridmap%na .or. & + size(dst_array) /= gridmap%nb) then + write(6,*) subname//' ERROR: incorrect sizes of src_array or dst_array' + write(6,*) 'size(src_array) = ', size(src_array) + write(6,*) 'gridmap%na = ', gridmap%na + write(6,*) 'size(dst_array) = ', size(dst_array) + write(6,*) 'gridmap%nb = ', gridmap%nb + call abort() + end if + + allocate(lfilter(gridmap%ns)) + + if (present(filter)) then + if (size(filter) /= gridmap%ns) then + write(6,*) subname//' ERROR: incorrect size of filter' + write(6,*) 'size(filter) = ', size(filter) + write(6,*) 'gridmap%ns = ', gridmap%ns + call abort() + end if + + lfilter(:) = filter(:) + else + lfilter(:) = .true. + end if + + allocate(hasdata(gridmap%nb)) + hasdata(:) = .false. + allocate(weights(minval:maxval, gridmap%nb)) + weights(minval:maxval,:) = 0. + + ! Determine weight of each index value for each output (destination) cell + + do n = 1, gridmap%ns + if (lfilter(n)) then + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + k = src_array(ni) + if (k >= minval .and. k <= maxval) then + ! Note: if we were doing something like weighted sums, I think we would + ! want to divide wt by gridmap%frac_dst(no), as is done in + ! gridmap_areaave_default. But since all we care about is the relative + ! values of weights for a given destination cell, this is unnecessary + weights(k,no) = weights(k,no) + wt + hasdata(no) = .true. + end if + end if + end do + + ! Determine output values + ! Note: if a given destination cell has no contributing source points (thus + ! hasdata(no) = false), or the max weight of any index overlapping this destination + ! cell is <= 0, then the output value there will be nodata. + ! (I don't think this latter condition -- weight <= 0 -- is possible, but we handle + ! it anyway) + + dst_array(:) = nodata + do no = 1, gridmap%nb + if (hasdata(no)) then + call which_max(weights(:,no), maxwt, maxindex, lbound=minval) + if (maxwt > 0.) then + dst_array(no) = maxindex + end if + end if + end do + + deallocate(lfilter, weights, hasdata) + +end subroutine get_dominant_indices +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: filter_same +! +! !INTERFACE: +subroutine filter_same(gridmap, filter, src_array, dst_array, nodata) +! +! !DESCRIPTION: +! Creates a filter of overlaps where src_array == dst_array. +! +! More specifically: given a src_array (of size gridmap%na) and an already-created +! dst_array (of size gridmap%nb): +! +! Creates a logical filter array, of size gridmap%ns (i.e., number of overlaps), +! according to the following rules: +! (1) anywhere where filter was already .false., it will remain .false. +! (2) if nodata is present: for any overlap where the value in dst_array is nodata, +! filter will be .false. +! (3) for any overlap where the value in the given src_array differs from the value +! in the given dst_array, filter will be .false. +! (4) anywhere else, filter will be .true. +! +! !USES: + use mkgridmapMod, only : gridmap_type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! provides mapping from src -> dst + logical , intent(inout):: filter(:) ! length gridmap%ns + integer , intent(in) :: src_array(:) ! length gridmap%na + integer , intent(in) :: dst_array(:) ! length gridmap%nb + + integer, intent(in), optional :: nodata ! wherever dst_array == nodata, filter will be false +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n, ni, no + + character(len=*), parameter :: subname = "make_filter" +!----------------------------------------------------------------------- + + ! Error check inputs + + if (size(filter) /= gridmap%ns .or. & + size(src_array) /= gridmap%na .or. & + size(dst_array) /= gridmap%nb) then + write(6,*) subname//' ERROR: incorrect array sizes' + write(6,*) 'size(src_array) = ', size(src_array) + write(6,*) 'gridmap%na = ', gridmap%na + write(6,*) 'size(dst_array) = ', size(dst_array) + write(6,*) 'gridmap%nb = ', gridmap%nb + write(6,*) 'size(filter) = ', size(filter) + write(6,*) 'gridmap%ns = ', gridmap%ns + call abort() + end if + + ! Create the filter + + do n = 1, gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + + if (present(nodata)) then + if (dst_array(no) == nodata) then + filter(n) = .false. + end if + end if + + if (dst_array(no) /= src_array(ni)) then + filter(n) = .false. + end if + end do + +end subroutine filter_same +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: lookup_2d +! +! !INTERFACE: +subroutine lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, & + nodata, valid_entries, invalid_okay) +! +! !DESCRIPTION: +! Creates a data array using a paint-by-number approach according to a lookup table +! +! This routine operates on a 2-d lookup table. There are therefore two index arrays +! (index1 and index2); these index arrays are on the same grid as the desired data array +! (thus, index1, index2 and data must all have the same length). Each output point, n, is +! then generally determined as: +! +! data(n) = lookup_table(index1(n), index2(n)) +! +! fill_val: value to put in data array where either: +! (a) index1 or index2 are equal to nodata (if nodata is given) +! Note that this condition does NOT result in ierr being set +! (b) valid_entries(index1(n), index2(n)) is false (if valid_entries is given) +! Note that this condition also results in ierr being set, unless invalid_okay is +! present and .true. +! (If valid_entries is not given, it is treated as being .true. everywhere) +! (c) index1 or index2 out of range +! Note that this condition also results in ierr being set +! +! ierr: error return code (if non-0, indicates first error encountered): +! 0: no error +! 1: attempt to assign values from the lookup table that are invalid according +! to valid_entries (note: this is not considered an error if invalid_okay is +! present and .true.) +! 2: attempt to access an out-of-range index in lookup table +! WJS (2-2-12): My main reason for using ierr rather than aborting in case of error +! is to facilitate unit testing +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: index1(:) ! index into dim 1 of lookup_table + integer , intent(in) :: index2(:) ! index into dim 2 of lookup_table + real(r8), intent(in) :: lookup_table(:,:) + real(r8), intent(in) :: fill_val ! value to put in data where we don't have a valid value (see above for details) + real(r8), intent(out):: data(:) ! output arary + integer , intent(out):: ierr ! error return code (0 = no error) + + ! nodata flag in index1 and index2 (see above for details): + integer, intent(in), optional :: nodata + + ! which entries are considered valid (see above for details): + logical, intent(in), optional :: valid_entries(:,:) + + ! invalid_okay: if true, then assigning fill_val because valid_entries is false does + ! NOT raise an error flag (invalid_okay defaults to false, meaning an error is + ! raised in this case): + logical, intent(in), optional :: invalid_okay +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n + integer :: i1, i2 + integer :: data_size ! size of index1, index2 and data arrays + integer :: table_n1 ! size of dimension 1 of lookup table + integer :: table_n2 ! size of dimension 2 of lookup table + logical :: linvalid_okay ! local version of invalid_okay + logical, allocatable :: lvalid_entries(:,:) ! local version of valid_entries + + character(len=*), parameter :: subname = 'lookup_2d' +!----------------------------------------------------------------------- + + ierr = 0 + + ! Error-check array sizes + + data_size = size(data) + if (size(index1) /= data_size .or. size(index2) /= data_size) then + write(6,*) subname//' ERROR: data array sizes do not match' + write(6,*) 'size(data) = ', data_size + write(6,*) 'size(index1) = ', size(index1) + write(6,*) 'size(index2) = ', size(index2) + call abort() + end if + + table_n1 = size(lookup_table,1) + table_n2 = size(lookup_table,2) + if (present(valid_entries)) then + if (size(valid_entries,1) /= table_n1 .or. size(valid_entries,2) /= table_n2) then + write(6,*) subname//' ERROR: size of valid_entries does not match lookup_table' + write(6,*) 'size(lookup_table) = ', table_n1, table_n2 + write(6,*) 'size(valid_entries) = ', size(valid_entries,1), & + size(valid_entries,2) + call abort() + end if + end if + + ! Set local version of invalid_okay & valid_entries + + if (present(invalid_okay)) then + linvalid_okay = invalid_okay + else + linvalid_okay = .false. + end if + + allocate(lvalid_entries(table_n1, table_n2)) + if (present(valid_entries)) then + lvalid_entries(:,:) = valid_entries(:,:) + else + lvalid_entries(:,:) = .true. + end if + + ! Do the lookups + + do n = 1, data_size + i1 = index1(n) + i2 = index2(n) + + ! First handle special cases: + + ! index is nodata flag (this is NOT an error) + if (present(nodata)) then + if (i1 == nodata .or. i2 == nodata) then + data(n) = fill_val + cycle + end if + end if + + ! index out of range + if (i1 <= 0 .or. i1 > table_n1 .or. & + i2 <= 0 .or. i2 > table_n2) then + data(n) = fill_val + if (ierr == 0) ierr = 2 + cycle + end if + + ! lookup table entry is invalid + if (.not. lvalid_entries(i1, i2)) then + data(n) = fill_val + if (.not. linvalid_okay) then + if (ierr == 0) ierr = 1 + end if + cycle + end if + + ! Finally, the "normal" case, if none of the special cases were triggered: + data(n) = lookup_table(i1, i2) + end do + + deallocate(lvalid_entries) + +end subroutine lookup_2d +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: lookup_2d_netcdf +! +! !INTERFACE: +subroutine lookup_2d_netcdf(ncid, tablename, lookup_has_invalid, & + dimname1, dimname2, n_extra_dims, & + index1, index2, fill_val, data, ierr, & + extra_dims, nodata, invalid_okay) +! +! !DESCRIPTION: +! Wrapper to lookup_2d that first reads the lookup table from a netcdf file +! +! If lookup_has_invalid is false, then we treat all lookup table entries as valid data +! (i.e., all valid_entries are true in the call to lookup_2d). If lookup_has_invalid is +! true, then we read the _FillValue attribute for the lookup table variable, and consider +! any table entry with value _FillValue to be an invalid entry, thus putting fill_val in +! these data locations (and raising an error flag unless invalid_okay is present and +! true). +! +! The dimension given by dimname1 -- with the associated indices given by index1 -- is the +! fastest-varying dimension in the lookup table. Dimension dimname2 (associated with +! index2) is the second-fastest-varying dimension. Similarly, extra_dims should be ordered +! from faster-varying to slowest-varying dimension. (The first dimension in extra_dims is +! the third-fastest-varying dimension in the lookup table.) +! +! n_extra_dims gives the number of extra dimensions (in addition to the first two) in the +! lookup table. We take a single 2-d slice of the lookup table, by using a single value of +! each of these other dimensions. If n_extra_dims > 0, then extra_dims must be present, +! with at least n_extra_dims entries. Each entry in extra_dims gives the name of a +! dimension and the dimension index to use for the slice. +! +! If size(extra_dims) > n_extra_dims, then we use the first n_extra_dims entries in +! extra_dims. If n_extra_dims = 0, then extra_dims is ignored. +! +! Note that we ignore any coordinate variables associated with the dimensions of the +! lookup table; we simply treat the lookup table indices as 1,2,3,... +! +! See the lookup_2d documentation for documentation of some other arguments +! +! WJS (2-1-12): Some thoughts on avoiding duplication if we eventually want similar +! routines, lookup_1d_netcdf, lookup_3d_netcdf, etc.: +! +! Much of the code in lookup_2d_netcdf could then be pulled out to a shared subroutine +! (e.g., much of the error-checking code). +! +! Or, maybe better: we could try to make a single lookup_netcdf subroutine that handles +! 1-d, 2-d and any other dimensionality. To do that, we would (1) make a generic interface +! (of which lookup_1d and lookup_2d would be implementations); (2) change the repeated +! arguments in lookup_2d_netcdf (*1 and *2) to arrays -- maybe using an array of a derived +! type containing these arguments; (3) if possible, initially read the lookup table into a +! 1-d array (if the netcdf call allows reading a n-d array into a 1-d array) (if netcdf +! doesn't allow this, then I think we could achieve the same thing by reading 1-d slices +! of the lookup table in a loop, building the full lookup table as a long 1-d array); (4) +! in the call to the generic 'lookup' function, reshape the 1-d lookup table +! appropriately. (Note: I think it would be challenging to combine lookup_1d and lookup_2d +! (etc.) into a single routine using a similar method.) +! +! !USES: + use mkncdio +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! ID of an open netcdf file + character(len=*), intent(in) :: tablename ! name of the lookup table variable + logical , intent(in) :: lookup_has_invalid ! should we use _FillValue? (see above) + character(len=*), intent(in) :: dimname1 ! name of the first (fastest-varying) dimension of the lookup table + character(len=*), intent(in) :: dimname2 ! name of the second dimension of the lookup table + integer , intent(in) :: n_extra_dims ! number of extra dimensions in the lookup table + ! The following arguments are passed directly to lookup_2d: + integer , intent(in) :: index1(:) ! index into dim 1 of lookup table + integer , intent(in) :: index2(:) ! index into dim 2 of lookup table + real(r8) , intent(in) :: fill_val ! value to put in data where we don't have a valid value + real(r8) , intent(out):: data(:) ! output array + integer , intent(out):: ierr ! error return code from the call to lookup_2d + + ! slice to use if lookup table variable has more than 2 dimensions: + type(dim_slice_type), intent(in), optional :: extra_dims(:) + + ! nodata flag in index1 and index2, passed directly to lookup_2d: + integer , intent(in), optional :: nodata + + ! flag for whether trying to use a lookup table value that is equal to the _FillValue + ! should raise an error flag + ! (irrelevant if lookup_has_invalid is .false.) + ! (passed directly to lookup_2d - see the documentation there for more details) + logical , intent(in), optional :: invalid_okay +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: varid ! netcdf variable id of the lookup table + integer :: ndims ! total number of dimensions of lookup table + integer :: ndims_expected ! value we expect for ndims, for error checking + integer :: i + real(r8) :: table_fillval ! value of the _FillValue attribute for the lookup table + character(len=nf_max_name), allocatable :: dimnames(:) ! dimension names + integer , allocatable :: dimids(:) ! dimension ids + integer , allocatable :: dimlens(:) ! dimension lengths + integer , allocatable :: starts(:) ! starting indices for reading lookup table + integer , allocatable :: counts(:) ! dimension counts for reading lookup table + real(r8), allocatable :: lookup_table(:,:) + logical , allocatable :: valid_entries(:,:) ! which entries of the lookup table are considered valid + + character(len=*), parameter :: subname = 'lookup_2d_netcdf' +!----------------------------------------------------------------------- + + ! Error-check extra_dims + + if (n_extra_dims > 0) then + if (.not. present(extra_dims)) then + write(6,*) subname//' ERROR: extra_dims must be present for n_extra_dims > 0' + call abort() + end if + + if (size(extra_dims) < n_extra_dims) then + write(6,*) subname//' ERROR: not enough extra dimensions given' + write(6,*) 'n_extra_dims = ', n_extra_dims + write(6,*) 'size(extra_dims) = ', size(extra_dims) + call abort() + end if + end if + + ! Determine number of expected dimensions in the table, and actual number of + ! dimensions in the netcdf file + + ndims_expected = 2 + n_extra_dims + + call check_ret(nf_inq_varid (ncid, tablename, varid), subname) + call check_ret(nf_inq_varndims (ncid, varid, ndims), subname) + if (ndims /= ndims_expected) then + write(6,*) subname//' ERROR: unexpected number of dimensions in ', & + trim(tablename) + write(6,*) 'ndims = ', ndims + write(6,*) 'expected (based on n_extra_dims): ', ndims_expected + call abort() + end if + + ! Get dimension names & sizes, and error-check them + + allocate(dimids(ndims), dimlens(ndims), dimnames(ndims)) + call check_ret(nf_inq_vardimid (ncid, varid, dimids), subname) + do i = 1, ndims + call check_ret(nf_inq_dimname (ncid, dimids(i), dimnames(i)), subname) + call check_ret(nf_inq_dimlen (ncid, dimids(i), dimlens(i)), subname) + end do + + call check_dimname(dimnames(1), dimname1, 1) + call check_dimname(dimnames(2), dimname2, 2) + do i = 1, n_extra_dims + call check_dimname(dimnames(2+i), extra_dims(i)%name, 2+i) + call check_dimsize(dimlens(2+i), extra_dims(i)%val, 2+i) + end do + + ! Read the lookup table; if the given variable has more than 2 dimensions, we read + ! a single 2-d slice + + allocate(starts(ndims), counts(ndims)) + allocate(lookup_table(dimlens(1), dimlens(2))) + starts(1:2) = 1 + counts(1:2) = dimlens(1:2) + do i = 1, n_extra_dims + starts(2+i) = extra_dims(i)%val + counts(2+i) = 1 + end do + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, lookup_table), subname) + + ! Determine which entries are valid + + allocate(valid_entries(size(lookup_table, 1), size(lookup_table, 2))) + valid_entries(:,:) = .true. + if (lookup_has_invalid) then + call check_ret(nf_get_att_double (ncid, varid, '_FillValue', table_fillval), subname) + where (lookup_table == table_fillval) + valid_entries = .false. + end where + end if + + ! Do the lookups + + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, nodata=nodata, & + valid_entries=valid_entries, invalid_okay=invalid_okay) + + deallocate(valid_entries) + deallocate(lookup_table) + deallocate(starts, counts) + deallocate(dimids, dimlens, dimnames) + +contains +!------------------------------------------------------------------------------ + subroutine check_dimname(actual, expected, i) + ! Make sure names are equal; if not, stop with an error message + + character(len=*), intent(in) :: actual, expected + integer , intent(in) :: i ! dimension number, for output purposes + + if (actual /= expected) then + write(6,*) subname//' ERROR: unexpected dimension name in ', trim(tablename) + write(6,*) 'dimension #', i + write(6,*) 'actual: ', trim(actual) + write(6,*) 'expected: ', trim(expected) + call abort() + end if + end subroutine check_dimname + +!------------------------------------------------------------------------------ + subroutine check_dimsize(length, index, i) + ! Make sure dimension length is long enough; if not, stop with an error message + + integer, intent(in) :: length, index + integer, intent(in) :: i ! dimension number, for output purposes + + if (index > length) then + write(6,*) subname//' ERROR: desired index exceeds dimension length in ', & + trim(tablename) + write(6,*) 'dimension #', i + write(6,*) 'index: ', index + write(6,*) 'length: ', length + call abort() + end if + end subroutine check_dimsize + +end subroutine lookup_2d_netcdf +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: which_max +! +! !INTERFACE: +subroutine which_max(arr, maxval, maxindex, lbound) +! +! !DESCRIPTION: +! Returns maximum value in arr along with the index of the maximum value +! +! If multiple values are tied, returns index of the first maximum +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: arr(:) + real(r8), intent(out):: maxval ! maximum value in arr(:) + integer , intent(out):: maxindex ! first index of maxval + + ! lower bound of indices of arr; if not supplied, assumed to be 1: + integer , intent(in), optional :: lbound +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i +!----------------------------------------------------------------------- + + maxindex = 1 + maxval = arr(1) + + do i = 2, size(arr) + if (arr(i) > maxval) then + maxindex = i + maxval = arr(i) + end if + end do + + if (present(lbound)) then + maxindex = maxindex + (lbound - 1) + end if +end subroutine which_max +!------------------------------------------------------------------------------ + +end module mkindexmapMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mklaiMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mklaiMod.F90 new file mode 100644 index 0000000000..87228e2639 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mklaiMod.F90 @@ -0,0 +1,432 @@ +module mklaiMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mklai +! +! !DESCRIPTION: +! Make LAI/SAI/height data +! +! !REVISION HISTORY: +! Author: Sam Levis +! +!EOP +!----------------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + use mkvarctl + + implicit none + + private + + public :: mklai + private :: pft_laicheck + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mklai +! +! !INTERFACE: +subroutine mklai(ldomain, mapfname, datfname, firrig, ndiag, ncido) +! +! !DESCRIPTION: +! Make LAI/SAI/height data +! Portions of this code could be moved out of the month loop +! for improved efficiency +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar , only : numstdpft, re + use mkvarctl + use mkncdio + use mkpftMod , only : nonIrrigIdx, IrrigIdx +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + character(len=*) , intent(in) :: firrig ! %irrigated area filename + integer , intent(in) :: ndiag ! unit number for diag out + integer , intent(in) :: ncido ! output netcdf file id +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + integer :: numpft_i ! number of plant types on input + real(r8) :: glai_o(0:numpft) ! output grid: global area pfts + real(r8) :: gsai_o(0:numpft) ! output grid: global area pfts + real(r8) :: ghgtt_o(0:numpft) ! output grid: global area pfts + real(r8) :: ghgtb_o(0:numpft) ! output grid: global area pfts + real(r8) :: glai_i(0:numpft) ! input grid: global area pfts + real(r8) :: gsai_i(0:numpft) ! input grid: global area pfts + real(r8) :: ghgtt_i(0:numpft) ! input grid: global area pfts + real(r8) :: ghgtb_i(0:numpft) ! input grid: global area pfts + + real(r8), allocatable :: mlai_o(:,:) ! monthly lai + real(r8), allocatable :: msai_o(:,:) ! monthly sai + real(r8), allocatable :: mhgtt_o(:,:) ! monthly height (top) + real(r8), allocatable :: mhgtb_o(:,:) ! monthly height (bottom) + real(r8), allocatable :: mlai_max(:,:) ! monthly lai + real(r8), allocatable :: msai_max(:,:) ! monthly sai + real(r8), allocatable :: mhgtt_max(:,:) ! monthly height (top) + real(r8), allocatable :: mhgtb_max(:,:) ! monthly height (bottom) + real(r8), allocatable :: mlai_i(:,:) ! monthly lai in + real(r8), allocatable :: msai_i(:,:) ! monthly sai in + real(r8), allocatable :: mhgtt_i(:,:) ! monthly height (top) in + real(r8), allocatable :: mhgtb_i(:,:) ! monthly height (bottom) in + real(r8), allocatable :: mask_src(:) ! input grid: mask (0, 1) + integer, pointer :: laimask(:,:) ! lai+sai output mask for each plant function type + real(r8) :: garea_i ! input grid: global area + real(r8) :: garea_o ! output grid: global area + integer :: mwts ! number of weights + integer :: ni,no,ns_i,ns_o ! indices + integer :: k,l,n,m ! indices + integer :: ncidi,dimid,varid ! input netCDF id's + integer :: ndimsi,ndimso ! netCDF dimension sizes + integer :: dimids(4) ! netCDF dimension ids + integer :: bego(4),leno(4) ! netCDF bounds + integer :: begi(4),leni(4) ! netCDF bounds + integer :: ntim ! number of input time samples + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 32) :: subname = 'mklai' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make LAIs/SAIs/heights .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + write (6,*) 'Open LAI file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_dimid(ncidi, 'pft', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numpft_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'time', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, ntim), subname) + + if (numpft_i /= numpft+1) then + write(6,*)'MKLAI: parameter numpft+1= ',numpft+1, & + 'does not equal input dataset numpft= ',numpft_i + stop + endif + if (ntim /= 12) then + write(6,*)'MKLAI: must have 12 time samples on input data' + call abort() + endif + + ! NOTE - close data set at bottom of routine + + ! Dynamic allocation of variables + + allocate(mlai_i(ns_i,0:numpft), & + msai_i(ns_i,0:numpft), & + mhgtt_i(ns_i,0:numpft), & + mhgtb_i(ns_i,0:numpft), & + mask_src(ns_i), & + mlai_o(ns_o,0:numpft), & + msai_o(ns_o,0:numpft), & + mhgtt_o(ns_o,0:numpft), & + mhgtb_o(ns_o,0:numpft), & + laimask(ns_i,0:numpft), stat=ier ) + if (ier /= 0) then + write(6,*)'mklai allocation error'; call abort() + end if + + ! Determine mapping weights and map + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine number of dimensions in input by querying MONTHLY_LAI + + call check_ret(nf_inq_varid(ncidi, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_inq_vardimid(ncidi, varid, dimids), subname) + call check_ret(nf_inq_varndims(ncidi, varid, ndimsi), subname) + if (ndimsi ==4) then + begi(1) = 1 + begi(2) = 1 + begi(3) = 1 + leni(4) = 1 + call check_ret(nf_inq_dimlen(ncidi, dimids(1), leni(1)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(2), leni(2)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(3), leni(3)), subname) + else if (ndimsi== 3) then + begi(1) = 1 + begi(2) = 1 + leni(3) = 1 + call check_ret(nf_inq_dimlen(ncidi, dimids(1), leni(1)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(2), leni(2)), subname) + end if + + ! Determine number of dimensions in output by querying MONTHLY_LAI + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_inq_varndims(ncido, varid, ndimso), subname) + call check_ret(nf_inq_vardimid(ncido, varid, dimids), subname) + if (ndimso ==4) then + bego(1) = 1 + bego(2) = 1 + bego(3) = 1 + leno(4) = 1 + call check_ret(nf_inq_dimlen(ncido, dimids(1), leno(1)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(2), leno(2)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(3), leno(3)), subname) + else if (ndimso== 3) then + bego(1) = 1 + bego(2) = 1 + leno(3) = 1 + call check_ret(nf_inq_dimlen(ncido, dimids(1), leno(1)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(2), leno(2)), subname) + end if + + ! Loop over months + + do m = 1, ntim + + if (ndimsi == 4) begi(4)=m + if (ndimsi == 3) begi(3)=m + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mlai_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_SAI', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + msai_i(:,0:numpft)), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_HEIGHT_TOP', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mhgtt_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_HEIGHT_BOT', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mhgtb_i), subname) + + mlai_o(:,:) = 0. + msai_o(:,:) = 0. + mhgtt_o(:,:) = 0. + mhgtb_o(:,:) = 0. + + ! Loop over pft types to do mapping + + do l = 0,numpft + mask_src(:) = 1._r8 + call gridmap_areaave(tgridmap, mlai_i(:,l) , mlai_o(:,l) , mask_src) + call gridmap_areaave(tgridmap, msai_i(:,l) , msai_o(:,l) , mask_src) + call gridmap_areaave(tgridmap, mhgtt_i(:,l), mhgtt_o(:,l), mask_src) + call gridmap_areaave(tgridmap, mhgtb_i(:,l), mhgtb_o(:,l), mask_src) + enddo + + ! Determine laimask + + laimask(:,:) = 0 + + ! if irrigation dataset present, copy LAI,SAI,Heights from non-irrigated + ! into irrigated + if (firrig /= ' ') then + write(6,*) 'Irrigation dataset present; Copying crop ', & + ' LAI, SAI, and heights into irrigated crop ' + mlai_o(:,nonIrrigIdx) = mlai_o(:,IrrigIdx) + msai_o(:,nonIrrigIdx) = msai_o(:,IrrigIdx) + mhgtt_o(:,nonIrrigIdx) = mhgtt_o(:,IrrigIdx) + mhgtb_o(:,nonIrrigIdx) = mhgtb_o(:,IrrigIdx) + endif + + ! ----------------------------------------------------------------- + ! Output model resolution LAI/SAI/HEIGHT data + ! ----------------------------------------------------------------- + + ! Now write out all variables + + if (ndimso == 4) bego(4)=m + if (ndimso == 3) bego(3)=m + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mlai_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_SAI', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, msai_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_HEIGHT_TOP', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mhgtt_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_HEIGHT_BOT', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mhgtb_o), subname) + + call check_ret(nf_inq_varid(ncido, 'time', varid), subname) + call check_ret(nf_put_vara_int(ncido, varid, bego(ndimso), leno(ndimso), m), subname) + + call check_ret(nf_sync(ncido), subname) + + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid global area + + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni) + end do + + glai_i(:) = 0. + gsai_i(:) = 0. + ghgtt_i(:) = 0. + ghgtb_i(:) = 0. + do l = 0, numpft + do ni = 1, ns_i + glai_i(l) = glai_i(l) + mlai_i(ni,l) *tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + gsai_i(l) = gsai_i(l) + msai_i(ni,l) *tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + ghgtt_i(l) = ghgtt_i(l)+ mhgtt_i(ni,l)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + ghgtb_i(l) = ghgtb_i(l)+ mhgtb_i(ni,l)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + end do + end do + + ! Output grid global area + + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no) + end do + + glai_o(:) = 0. + gsai_o(:) = 0. + ghgtt_o(:) = 0. + ghgtb_o(:) = 0. + do l = 0, numpft + do no = 1,ns_o + glai_o(l) = glai_o(l) + mlai_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + gsai_o(l) = gsai_o(l) + msai_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + ghgtt_o(l) = ghgtt_o(l)+ mhgtt_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + ghgtb_o(l) = ghgtb_o(l)+ mhgtb_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'LAI Output for month ',m + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'PFT input grid area output grid area',/ & + 1x,3x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do l = 0, numpft + write (ndiag,1002) l, glai_i(l)*1.e-06*1.e-02,glai_o(l)*1.e-06*1.e-02 +1002 format (1x,i3,f16.3,f17.3) + end do + + write (6,*) 'Successfully made LAIs/SAIs/heights for month ', m + call shr_sys_flush(6) + + enddo + write (6,*) + + ! Close input file + call check_ret(nf_close(ncidi), subname) + + ! consistency check that PFT and LAI+SAI make sense + !call pft_laicheck( ni_s, pft_i, laimask ) + + ! Deallocate dynamic memory + + deallocate(mlai_i,msai_i,mhgtt_i,mhgtb_i,& + mask_src,mlai_o,msai_o,mhgtt_o,mhgtb_o,laimask) + call gridmap_clean(tgridmap) + call domain_clean(tdomain) + +end subroutine mklai + +!----------------------------------------------------------------------- +!BOP +! +! !INTERFACE: +subroutine pft_laicheck( ni_s, pctpft_i, laimask ) + +! !USES: +! +! !DESCRIPTION: +! +! consistency check that PFT and LAI+SAI make sense +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ni_s ! input PFT grid resolution + real(r8), pointer :: pctpft_i(:,:) ! % plant function types + integer, pointer :: laimask(:,:) ! mask where LAI+SAI > 0 +!EOP + + character(len=*), parameter :: subName="pft_laicheck" + integer :: ni,l,n,nc ! Indices +!----------------------------------------------------------------------- + + do l = 0, numpft + n = 0 + nc = 0 + do ni = 1,ni_s + if ( pctpft_i(ni,l) > 0.0_r8 ) nc = nc + 1 + if ( (pctpft_i(ni,l) > 0.0_r8) .and. (laimask(ni,l) /= 1) )then + write (6,*) subName//' :: warning: pft and LAI+SAI mask not consistent!' + write (6,*) 'ni,l = ', ni, l + write (6,*) 'pctpft_i = ',pctpft_i(ni,l) + write (6,*) 'laimask = ', laimask(ni,l) + n = n + 1 + end if + end do + if ( n > max(4,nc/4) ) then + write (6,*) subName//' :: pft/LAI+SAI inconsistency over more than 25% land-cover' + write (6,*) '# inconsistent points, total PFT pts, total LAI+SAI pts = ', & + n, nc, sum(laimask(:,l)) + stop + end if + end do + +end subroutine pft_laicheck + +!----------------------------------------------------------------------- + +end module mklaiMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mklanwatMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mklanwatMod.F90 new file mode 100644 index 0000000000..c58ecffe8c --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mklanwatMod.F90 @@ -0,0 +1,405 @@ +module mklanwatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mklanwatMod +! +! !DESCRIPTION: +! make %lake and %wetland from input lake / wetland data +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mklakwat + public mkwetlnd + +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mklakwat +! +! !INTERFACE: +subroutine mklakwat(ldomain, mapfname, datfname, ndiag, zero_out, lake_o) +! +! !DESCRIPTION: +! make %lake +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: lake_o(:) ! output grid: %lake +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: lake_i(:) ! input grid: percent lake + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: glake_i ! input grid: global lake + real(r8) :: garea_i ! input grid: global area + real(r8) :: glake_o ! output grid: global lake + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mklakwat' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %lake and %wetland .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) !todo - put in routine to read in 1d domains + ns_i = tdomain%ns + + if ( .not. zero_out )then + allocate(lake_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write(6,*)'Open lake file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_LAKE', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, lake_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine lake_o on output grid + + call gridmap_areaave(tgridmap, lake_i,lake_o) + + do no = 1,ns_o + if (lake_o(no) < 1.) lake_o(no) = 0. + enddo + + ! ----------------------------------------------------------------- + ! Error check prep + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + ! ----------------------------------------------------------------- + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( .not. zero_out .and. (trim(mksrf_gridtype) == 'global') ) then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKLANWAT error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + glake_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + glake_i = glake_i + lake_i(ni)*tgridmap%area_src(ni)/100.*re**2 + end do + + ! Output grid + + glake_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + glake_o = glake_o + lake_o(no)*tgridmap%area_dst(no)/100.*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Inland Water Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) glake_i*1.e-06,glake_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'lakes ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + else + do no = 1,ns_o + lake_o(no) = 0. + enddo + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (lake_i) + end if + + write (6,*) 'Successfully made %lake' + write (6,*) + call shr_sys_flush(6) + +end subroutine mklakwat + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkwetlnd +! +! !INTERFACE: +subroutine mkwetlnd(ldomain, mapfname, datfname, ndiag, zero_out, swmp_o) +! +! !DESCRIPTION: +! make %wetland +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: swmp_o(:) ! output grid: %wetland +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: swmp_i(:) ! input grid: percent swamp + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gswmp_i ! input grid: global swamp + real(r8) :: garea_i ! input grid: global area + real(r8) :: gswmp_o ! output grid: global swamp + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkwetlnd' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %wetland .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) !todo - put in routine to read in 1d domains + ns_i = tdomain%ns + + if ( .not. zero_out )then + allocate(swmp_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write(6,*)'Open wetland file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_WETLAND', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, swmp_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + ! Determine swmp_o on output grid + + call gridmap_areaave(tgridmap, swmp_i,swmp_o) + + do no = 1,ns_o + if (swmp_o(no) < 1.) swmp_o(no) = 0. + enddo + + ! ----------------------------------------------------------------- + ! Error check prep + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + ! ----------------------------------------------------------------- + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( .not. zero_out .and. (trim(mksrf_gridtype) == 'global') ) then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKLANWAT error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gswmp_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gswmp_i = gswmp_i + swmp_i(ni)*tgridmap%area_src(ni)/100.*re**2 + end do + + ! Output grid + + gswmp_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gswmp_o = gswmp_o + swmp_o(no)*tgridmap%area_dst(no)/100.*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Inland Water Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) gswmp_i*1.e-06,gswmp_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2003 format (1x,'wetlands ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + else + do no = 1,ns_o + swmp_o(no) = 0. + enddo + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (swmp_i) + end if + + write (6,*) 'Successfully made %wetland' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkwetlnd + +end module mklanwatMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkncdio.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkncdio.F90 new file mode 100644 index 0000000000..2118aacec4 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkncdio.F90 @@ -0,0 +1,249 @@ +module mkncdio + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkncdio +! +! !DESCRIPTION: +! Generic interfaces to write fields to netcdf files, and other useful netcdf operations +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush +! +! !PUBLIC TYPES: + implicit none + include 'netcdf.inc' + save + + private + + public :: check_ret ! checks return status of netcdf calls + public :: ncd_defvar ! define netCDF input variable + public :: get_dim_lengths ! get dimension lengths of a netcdf variable +! +! !REVISION HISTORY: +! +! +! !PRIVATE MEMBER FUNCTIONS: +! + logical :: masterproc = .true. ! always use 1 proc + real(r8) :: spval = 1.e36 ! special value + + public :: nf_open + public :: nf_close + public :: nf_write + public :: nf_sync + public :: nf_inq_attlen + public :: nf_inq_dimlen + public :: nf_inq_dimname + public :: nf_inq_varid + public :: nf_inq_varndims + public :: nf_inq_vardimid + public :: nf_get_att_double + public :: nf_get_att_text + public :: nf_get_var_double + public :: nf_get_vara_double + public :: nf_get_var_int + public :: nf_get_vara_int + public :: nf_put_var_double + public :: nf_put_vara_double + public :: nf_put_var_int + public :: nf_put_vara_int + public :: nf_inq_dimid + public :: nf_max_name + public :: nf_max_var_dims + public :: nf_noerr +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: check_ret +! +! !INTERFACE: + subroutine check_ret(ret, calling) +! +! !DESCRIPTION: +! Check return status from netcdf call +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: ret + character(len=*) :: calling +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + + if (ret /= NF_NOERR) then + write(6,*)'netcdf error from ',trim(calling), ' rcode = ', ret, & + ' error = ', NF_STRERROR(ret) + call abort() + end if + + end subroutine check_ret + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_defvar +! +! !INTERFACE: + subroutine ncd_defvar(ncid, varname, xtype, & + dim1name, dim2name, dim3name, dim4name, dim5name, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value) +! +! !DESCRIPTION: +! Define a netcdf variable +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*), intent(in), optional :: dim1name ! dimension name + character(len=*), intent(in), optional :: dim2name ! dimension name + character(len=*), intent(in), optional :: dim3name ! dimension name + character(len=*), intent(in), optional :: dim4name ! dimension name + character(len=*), intent(in), optional :: dim5name ! dimension name + character(len=*), intent(in), optional :: long_name ! attribute + character(len=*), intent(in), optional :: units ! attribute + character(len=*), intent(in), optional :: cell_method ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int +! +! !REVISION HISTORY: +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n ! indices + integer :: ndims ! dimension counter + integer :: dimid(5) ! dimension ids + integer :: varid ! variable id + integer :: itmp ! temporary + character(len=256) :: str ! temporary + character(len=32) :: subname='NCD_DEFVAR_REAL' ! subroutine name +!----------------------------------------------------------------------- + + if (.not. masterproc) return + + ! Determine dimension ids for variable + + dimid(:) = 0 + + if (present(dim1name)) then + call check_ret(nf_inq_dimid(ncid, dim1name, dimid(1)), subname) + end if + if (present(dim2name)) then + call check_ret(nf_inq_dimid(ncid, dim2name, dimid(2)), subname) + end if + if (present(dim3name)) then + call check_ret(nf_inq_dimid(ncid, dim3name, dimid(3)), subname) + end if + if (present(dim4name)) then + call check_ret(nf_inq_dimid(ncid, dim4name, dimid(4)), subname) + end if + if (present(dim5name)) then + call check_ret(nf_inq_dimid(ncid, dim5name, dimid(5)), subname) + end if + + ! Define variable + + if (present(dim1name)) then + ndims = 0 + do n = 1, size(dimid) + if (dimid(n) /= 0) ndims = ndims + 1 + end do + call check_ret(nf_def_var(ncid, trim(varname), xtype, ndims, dimid(1:ndims), varid), subname) + else + call check_ret(nf_def_var(ncid, varname, xtype, 0, 0, varid), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + if (present(cell_method)) then + str = 'time: ' // trim(cell_method) + call check_ret(nf_put_att_text(ncid, varid, 'cell_method', len_trim(str), trim(str)), subname) + end if + if (present(fill_value)) then + call check_ret(nf_put_att_double(ncid, varid, '_FillValue', xtype, 1, fill_value), subname) + end if + if (present(missing_value)) then + call check_ret(nf_put_att_double(ncid, varid, 'missing_value', xtype, 1, missing_value), subname) + end if + if (present(ifill_value)) then + call check_ret(nf_put_att_int(ncid, varid, '_FillValue', xtype, 1, ifill_value), subname) + end if + if (present(imissing_value)) then + call check_ret(nf_put_att_int(ncid, varid, 'missing_value', xtype, 1, imissing_value), subname) + end if + + end subroutine ncd_defvar + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: get_dim_lengths +! +! !INTERFACE: +subroutine get_dim_lengths(ncid, varname, ndims, dim_lengths) +! +! !DESCRIPTION: +! Returns the number of dimensions and an array containing the dimension lengths of a +! variable in an open netcdf file. +! +! Entries 1:ndims in the returned dim_lengths array contain the dimension lengths; the +! remaining entries in that vector are meaningless. The dim_lengths array must be large +! enough to hold all ndims values; if not, the code aborts (this can be ensured by passing +! in an array of length nf_max_var_dims). +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! netcdf id of an open netcdf file + character(len=*), intent(in) :: varname ! name of variable of interest + integer , intent(out):: ndims ! number of dimensions of variable + integer , intent(out):: dim_lengths(:) ! lengths of dimensions of variable +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: + integer :: varid + integer :: dimids(size(dim_lengths)) + integer :: i + character(len=*), parameter :: subname = 'get_dim_lengths' +!EOP +!------------------------------------------------------------------------------ + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) + + if (ndims > size(dim_lengths)) then + write(6,*) trim(subname), ' ERROR: dim_lengths too small' + call abort() + end if + + call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) + + dim_lengths(:) = 0 ! pre-fill with 0 so we won't have garbage in elements past ndims + do i = 1, ndims + call check_ret(nf_inq_dimlen(ncid, dimids(i), dim_lengths(i)), subname) + end do + end subroutine get_dim_lengths + +end module mkncdio diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkpftMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkpftMod.F90 new file mode 100644 index 0000000000..374d6fdc09 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkpftMod.F90 @@ -0,0 +1,932 @@ +module mkpftMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkpft +! +! !DESCRIPTION: +! Make PFT data +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkvarctl , only : numpft + use mkdomainMod , only : domain_checksame + + implicit none + + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mkpftInit ! Initialization + public mkpft ! Set PFT + public mkpft_parse_oride ! Parse the string with PFT fraction/index info to override + public mkirrig ! Set irrigation + public mkpftAtt ! Write out attributes to output file on pft +! +! !PUBLIC DATA MEMBERS: +! + + ! + ! When pft_idx and pft_frc are set, they must be set together, and they will cause the + ! entire area to be covered with vegetation and zero out other landunits. + ! The sum of pft_frc must = 100%, and each pft_idx point in the array corresponds to + ! the fraction in pft_frc. Only the first few points are used until pft_frc = 0.0. + ! + integer :: m ! index + integer, parameter :: maxpft = 20 ! maximum # of PFT + integer, public :: pft_idx(0:maxpft) = & ! PFT vegetation index to override with + (/ ( -1, m = 0, maxpft ) /) + real(r8), public :: pft_frc(0:maxpft) = & ! PFT vegetation fraction to override with + (/ ( 0.0, m = 0, maxpft ) /) + integer, public :: nonIrrigIdx = 15 + integer, public :: IrrigIdx = 16 +! +! !PRIVATE DATA MEMBERS: +! + logical, private :: zero_out = .false. ! Flag to zero out PFT + logical, private :: use_input_pft = .false. ! Flag to override PFT with input values + integer, private :: nzero ! index of first zero fraction +! +! !PRIVATE MEMBER FUNCTIONS: +! + private :: mkpft_check_oride ! Check the pft_frc and pft_idx values for correctness +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpftInit +! +! !INTERFACE: +subroutine mkpftInit( zero_out_l, all_veg ) +! +! !DESCRIPTION: +! Initialize of Make PFT data +! !USES: +! +! !ARGUMENTS: + implicit none + logical, intent(IN) :: zero_out_l ! If veg should be zero'ed out + logical, intent(OUT) :: all_veg ! If should zero out other fractions so that + ! all land-cover is vegetation +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8), parameter :: hndrd = 100.0_r8 ! A hundred percent + character(len=32) :: subname = 'mkpftInit:: ' +!----------------------------------------------------------------------- + + call mkpft_check_oride( ) + if ( use_input_pft ) then + if ( maxpft < numpft ) then + write(6,*) subname//'number PFT is > max allowed!' + call abort() + end if + write(6,*) 'Set PFT fraction to : ', pft_frc(0:nzero-1) + write(6,*) 'With PFT index : ', pft_idx(0:nzero-1) + end if + + all_veg = use_input_pft + + if ( zero_out_l .and. all_veg )then + write(6,*) subname//'zeroing out vegetation and setting vegetation to 100% is a contradiction!' + call abort() + end if + + ! Copy local zero out to module data version + zero_out = zero_out_l + +end subroutine mkpftInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft +! +! !INTERFACE: +subroutine mkpft(ldomain, mapfname, fpft, firrig, ndiag, & + pctlnd_o, pctirr_o, pctpft_o) +! +! !DESCRIPTION: +! Make PFT data +! This dataset consists of the %cover of the [numpft]+1 PFTs used by +! the model. The input %cover pertains to the "vegetated" portion of the +! grid cell and sums to 100. The real portion of each grid cell +! covered by each PFT is the PFT cover times the fraction of the +! grid cell that is land. This is the quantity preserved when +! area-averaging from the input (1/2 degree) grid to the models grid. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(inout) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: fpft ! input pft dataset file name + character(len=*) , intent(in) :: firrig ! input irrigation dataset file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(in) :: pctirr_o(:) ! % irrigated area (output grid) + real(r8) , intent(out):: pctlnd_o(:) ! output grid:%land/gridcell + real(r8) , pointer :: pctpft_o(:,:) ! PFT cover (% of vegetated area) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: pctpft_i(:,:) ! input grid: PFT percent + integer :: numpft_i ! num of plant types input data + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: wst(0:numpft) ! as pft_o at specific no + real(r8) :: wst_sum ! sum of %pft + real(r8) :: gpft_o(0:numpft) ! output grid: global area pfts + real(r8) :: garea_o ! output grid: global area + real(r8) :: gpft_i(0:numpft) ! input grid: global area pfts + real(r8) :: garea_i ! input grid: global area + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + integer :: indxcrop ! input grid index for crop + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + + character(len=35) veg(0:numpft) ! vegetation types + character(len=32) :: subname = 'mkpft' +!----------------------------------------------------------------------- + + write (6,*) + write (6,*) 'Attempting to make PFTs .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Set the vegetation types + ! ----------------------------------------------------------------- + if ( numpft >= numstdpft )then + veg(0:numstdpft) = (/ & + 'not vegetated ', & + 'needleleaf evergreen temperate tree', & + 'needleleaf evergreen boreal tree ', & + 'needleleaf deciduous boreal tree ', & + 'broadleaf evergreen tropical tree ', & + 'broadleaf evergreen temperate tree ', & + 'broadleaf deciduous tropical tree ', & + 'broadleaf deciduous temperate tree ', & + 'broadleaf deciduous boreal tree ', & + 'broadleaf evergreen shrub ', & + 'broadleaf deciduous temperate shrub', & + 'broadleaf deciduous boreal shrub ', & + 'c3 arctic grass ', & + 'c3 non-arctic grass ', & + 'c4 grass ', & + 'c3_crop ', & + 'c4_crop ' /) + indxcrop = 15 ! c3_crop is active generic crop type + end if + if ( numpft == numstdpft )then + write(6,*)'Creating surface datasets with the standard # of PFTs =', numpft + else if ( numpft > numstdpft )then + write(6,*)'Creating surface datasets with extra types for crops; total pfts =', numpft + else + write(6,*) subname//': parameter numpft is NOT set to a known value (should be 16 or more) =',numpft + call abort() + end if + + ! ----------------------------------------------------------------- + ! Read input PFT file + ! ----------------------------------------------------------------- + + ns_o = ldomain%ns + + if ( .not. use_input_pft ) then + ! Obtain input grid info, read PCT_PFT + + call domain_read(tdomain,fpft) + ns_i = tdomain%ns + + write (6,*) 'Open PFT file: ', trim(fpft) + call check_ret(nf_open(fpft, 0, ncid), subname) + + call check_ret(nf_inq_dimid (ncid, 'pft', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, numpft_i), subname) + + if (numpft_i .ne. numpft+1) then + write(6,*) subname//': parameter numpft+1= ',numpft+1, & + 'does not equal input dataset numpft= ',numpft_i + call abort() + endif + + allocate(pctpft_i(ns_i,0:numpft), stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'PCT_PFT', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, pctpft_i), subname) + + call check_ret(nf_close(ncid), subname) + + else + ns_i = 1 + end if + + ! Determine pctpft_o on output grid + + if ( zero_out ) then + + pctpft_o(:,:) = 0._r8 + pctlnd_o(:) = 100._r8 + + else if ( use_input_pft ) then + + call mkpft_check_oride( ) + + ! set PFT based on input pft_frc and pft_idx + pctpft_o(:,:) = 0._r8 + pctlnd_o(:) = 100._r8 + do m = 0, numpft + ! Once reach a PFT where fraction goes to zero -- exit + if ( pft_frc(m) .eq. 0.0_r8 ) exit + do no = 1,ns_o + pctpft_o(no,pft_idx(m)) = pft_frc(m) + end do + end do + + else + + ! Compute pctlnd_o, pctpft_o + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + ! Area-average percent cover on input grid [pctpft_i] to output grid + ! [pctpft_o] and correct [pctpft_o] according to land landmask + ! Note that percent cover is in terms of total grid area. + + do no = 1,ns_o + pctlnd_o(no) = tgridmap%frac_dst(no) * 100._r8 + ldomain%frac(no) = tgridmap%frac_dst(no) + end do + + do m = 0,numpft + call gridmap_areaave(tgridmap, pctpft_i(:,m), pctpft_o(:,m)) + do no = 1,ns_o + if (pctlnd_o(no) < 1.0e-6) then + if (m == 0) then + pctpft_o(no,m) = 100._r8 + else + pctpft_o(no,m) = 0._r8 + endif + end if + enddo + enddo + + ! if irrigation dataset present, split into irrigated and + ! non-irrigated crop area + if (firrig /= ' ') then + write(6,*) 'Irrigation dataset present; splitting crop PFT into irrigated ',& + 'and non-irrigated fractions' + do no = 1,ns_o + pctpft_o(no,IrrigIdx) = min(pctpft_o(no,nonIrrigIdx),pctirr_o(no)) + pctpft_o(no,nonIrrigIdx) = pctpft_o(no,nonIrrigIdx) - pctpft_o(no,IrrigIdx) + enddo + endif + + end if + + ! Error check: percents should sum to 100 for land grid cells + + if ( .not. zero_out) then + do no = 1,ns_o + wst_sum = 0. + do m = 0,numpft + wst_sum = wst_sum + pctpft_o(no,m) + enddo + if (abs(wst_sum-100._r8) > 0.00001_r8) then + write (6,*) subname//'error: pft = ', & + (pctpft_o(no,m), m = 0, numpft), & + ' do not sum to 100. at no = ',no,' but to ', wst_sum + stop + end if + end do + end if + + ! ----------------------------------------------------------------- + ! Error check + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + if ( .not. (zero_out .or. use_input_pft) ) then + + ! input grid + + gpft_i(:) = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + do m = 0, numpft + gpft_i(m) = gpft_i(m) + pctpft_i(ni,m)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + end do + end do + if ( allocated(pctpft_i) ) deallocate (pctpft_i) + + ! output grid + + gpft_o(:) = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + do m = 0, numpft + gpft_o(m) = gpft_o(m) + pctpft_o(no,m)*tgridmap%area_dst(no)*& + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'PFTs Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'plant type ',20x,' input grid area',' output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do m = 0, numpft + write (ndiag,1002) veg(m), gpft_i(m)*1.e-06/100.,gpft_o(m)*1.e-06/100. + end do +1002 format (1x,a35,f16.3,f17.3) + call shr_sys_flush(ndiag) + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out .and. .not. use_input_pft ) then + call gridmap_clean(tgridmap) + end if + + write (6,*) 'Successfully made PFTs' + write (6,*) + + +end subroutine mkpft + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft_parse_oride +! +! !INTERFACE: +subroutine mkpft_parse_oride( string ) +! +! !DESCRIPTION: +! Parse the string with pft fraction and index information on it, to override +! the file with this information rather than reading from a file. +! +! !USES: + use shr_string_mod, only: shr_string_betweenTags, shr_string_countChar +! !ARGUMENTS: + character(len=256), intent(IN) :: string ! String to parse with PFT fraction + ! and index data +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: rc ! error return code + integer :: num_elms ! number of elements + character(len=256) :: substring ! string between tags + character(len=*), parameter :: frc_start = "" + character(len=*), parameter :: frc_end = "" + character(len=*), parameter :: idx_start = "" + character(len=*), parameter :: idx_end = "" + character(len=*), parameter :: subname = 'mkpft_parse_oride' +!----------------------------------------------------------------------- + call shr_string_betweenTags( string, frc_start, frc_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding pft_frac start end tags' + call abort() + end if + num_elms = shr_string_countChar( substring, ",", rc ) + read(substring,*) pft_frc(0:num_elms) + call shr_string_betweenTags( string, idx_start, idx_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding pft_index start end tags' + call abort() + end if + if ( num_elms /= shr_string_countChar( substring, ",", rc ) )then + write(6,*) subname//'number of elements different between frc and idx fields' + call abort() + end if + read(substring,*) pft_idx(0:num_elms) +!----------------------------------------------------------------------- + +end subroutine mkpft_parse_oride + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft_check_oride +! +! !INTERFACE: +subroutine mkpft_check_oride( ) +! +! !DESCRIPTION: +! Check that the pft override values are valid +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i, j ! indices + real(r8) :: sumpft ! Sum of pft_frc + real(r8), parameter :: hndrd = 100.0_r8 ! A hundred percent + character(len=32) :: subname = 'mkpft_check_oride:: ' +!----------------------------------------------------------------------- + + sumpft = sum(pft_frc) + if ( sumpft == 0.0 )then + ! PFT fraction is NOT used + use_input_pft = .false. + else if ( abs(sumpft - hndrd) > 1.e-6 )then + write(6,*) subname//'Sum of PFT fraction is NOT equal to 100% =', sumpft + call abort() + else + use_input_pft = .true. + nzero = 0 + do i = 0, numpft + if ( pft_frc(i) == 0.0_r8 )then + nzero = i + exit + end if + end do + ! PFT fraction IS used, and sum is OK, now check details + do i = 0, nzero -1 + if ( pft_frc(i) < 0.0_r8 .or. pft_frc(i) > hndrd )then + write(6,*) subname//'PFT fraction is out of range: pft_frc=', pft_frc(i) + call abort() + else if ( pft_frc(i) > 0.0_r8 .and. pft_idx(i) == -1 )then + write(6,*) subname//'PFT fraction > zero, but index NOT set: pft_idx=', pft_idx(i) + call abort() + end if + ! PFT index out of range + if ( pft_idx(i) < 0 .or. pft_idx(i) > numpft )then + write(6,*) subname//'PFT index is out of range: ', pft_idx(i) + call abort() + end if + ! Make sure index values NOT used twice + do j = 0, i-1 + if ( pft_idx(i) == pft_idx(j) )then + write(6,*) subname//'Same PFT index is used twice: ', pft_idx(i) + call abort() + end if + end do + end do + ! Make sure the rest of the fraction is zero and index are not set as well + do i = nzero, numpft + if ( pft_frc(i) /= 0.0_r8 .or. pft_idx(i) /= -1 )then + write(6,*) subname//'After PFT fraction is zeroed out, fraction is non zero, or index set' + call abort() + end if + end do + end if + +end subroutine mkpft_check_oride + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkirrig +! +! !INTERFACE: +subroutine mkirrig(ldomain, mapfname, datfname, ndiag, irrig_o) +! +! !DESCRIPTION: +! make percent irrigated area +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input dataset file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: irrig_o(:) ! output grid: %irrigated area +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: David Lawrence +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: irrig_i(:) ! input grid: percent irrig + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: girrig_i ! input grid: global irrig + real(r8) :: garea_i ! input grid: global area + real(r8) :: girrig_o ! output grid: global irrig + real(r8) :: garea_o ! output grid: global area + integer :: k,n,m,ni,no,ns_o,ns_i ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkirrig' +!----------------------------------------------------------------------- + + write (6,*) + write (6,*) 'Attempting to make %irrigated area .....' + call shr_sys_flush(6) + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain, datfname) + ns_i = tdomain%ns + + write (6,*) 'Open irrigation file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(irrig_i(ns_i), stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'PCT_IRRIG', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, irrig_i), subname) + + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Do mapping from input to output grid + + call gridmap_areaave(tgridmap, irrig_i, irrig_o) + + do no = 1, ns_o + if (irrig_o(no) < 1.) irrig_o(no) = 0. + enddo + + ! Check for conservation + + do no = 1, ns_o + if ((irrig_o(no)) > 100.000001_r8) then + write (6,*) 'MKIRRIG error: irrigated area = ',irrig_o(no), & + ' greater than 100.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0. + do ni = 1, ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1, ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKIRRIG error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + girrig_i = 0. + garea_i = 0. + + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni) + girrig_i = girrig_i + irrig_i(ni)*(tgridmap%area_src(ni)/100.)*& + tgridmap%frac_src(ni)*re**2 + end do + + ! Output grid + + girrig_o = 0. + garea_o = 0. + + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no) + girrig_o = girrig_o + irrig_o(no)*(tgridmap%area_dst(no)/100.)*& + tgridmap%frac_dst(no)*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Irrigated area Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) girrig_i*1.e-06,girrig_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'irrigated area ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + call shr_sys_flush(ndiag) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (irrig_i) + + write (6,*) 'Successfully made %irrigated area' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkirrig + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpftAtt +! +! !INTERFACE: +subroutine mkpftAtt( ncid, dynlanduse, xtype ) +! +! !DESCRIPTION: +! make PFT attributes on the output file +! + use mkncdio , only : check_ret, ncd_defvar + use fileutils , only : get_filename + use mkvarctl , only : mksrf_fvegtyp, mksrf_firrig, mksrf_flai, outnc_1d + use mkvarpar + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ncid ! NetCDF file ID to write out to + logical, intent(in) :: dynlanduse ! if dynamic land-use file + integer, intent(in) :: xtype ! external type to output real data as +! +! !CALLED FROM: +! subroutine mkfile in module mkfileMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pftsize ! size of lsmpft dimension + integer :: dimid ! input netCDF id's + character(len=256) :: str ! global attribute string + character(len=32) :: subname = 'mkpftAtt' + + ! Define dimensions + call check_ret(nf_def_dim (ncid, 'time' , nf_unlimited, dimid), subname) + + pftsize = numpft + 1 + call check_ret(nf_def_dim (ncid, 'lsmpft' , pftsize , dimid), subname) + + ! Add global attributes + + str = get_filename(mksrf_firrig) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Irrig_raw_data_file_name', len_trim(str), trim(str)), subname) + + if (.not. dynlanduse) then + str = get_filename(mksrf_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Lai_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + if ( use_input_pft ) then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'pft_override', len_trim(str), trim(str)), subname) + else if ( zero_out )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'zero_out_pft_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fvegtyp) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Vegetation_type_raw_data_filename', len_trim(str), trim(str)), subname) + end if + + ! Define variables + + ! PCT_IRRIG + if (mksrf_firrig /= ' ') then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_IRRIG', xtype=xtype, & + dim1name='gridcell',& + long_name='percent irrigated area', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_IRRIG', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='percent irrigated area', units='unitless') + end if + endif + + ! LANDFRAC_PFT + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='LANDFRAC_PFT', xtype=nf_double, & + dim1name='gridcell',& + long_name='land fraction from pft dataset', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='LANDFRAC_PFT', xtype=nf_double, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='land fraction from pft dataset', units='unitless') + end if + + ! PFTDATA_MASK + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PFTDATA_MASK', xtype=nf_int, & + dim1name='gridcell',& + long_name='land mask from pft dataset, indicative of real/fake points', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PFTDATA_MASK', xtype=nf_int, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='land mask from pft dataset, indicative of real/fake points', units='unitless') + end if + + ! PCT_PFT + if (.not. dynlanduse) then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_PFT', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', & + long_name='percent plant functional type of gridcell', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_PFT', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', & + long_name='percent plant functional type of gridcell', units='unitless') + end if + else + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_PFT', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', dim3name='time', & + long_name='percent plant functional type of gridcell', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_PFT', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', dim4name='time', & + long_name='percent plant functional type of gridcell', units='unitless') + end if + end if + + ! LAI,SAI,HTOP,HBOT + if (.not. dynlanduse) then + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='MONTHLY_LAI', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', dim3name='time', & + long_name='monthly leaf area index', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='MONTHLY_LAI', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', dim4name='time', & + long_name='monthly leaf area index', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='MONTHLY_SAI', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', dim3name='time', & + long_name='monthly stem area index', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='MONTHLY_SAI', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', dim4name='time', & + long_name='monthly stem area index', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', dim3name='time', & + long_name='monthly height top', units='meters') + else + call ncd_defvar(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', dim4name='time', & + long_name='monthly height top', units='meters') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', xtype=xtype, & + dim1name='gridcell', dim2name='lsmpft', dim3name='time', & + long_name='monthly height bottom', units='meters') + else + call ncd_defvar(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='lsmpft', dim4name='time', & + long_name='monthly height bottom', units='meters') + end if + + end if + + ! OTHER + if (dynlanduse) then + call ncd_defvar(ncid=ncid, varname='YEAR', xtype=nf_int, & + dim1name='time', & + long_name='Year of PFT data', units='unitless') + call ncd_defvar(ncid=ncid, varname='time', xtype=nf_int, & + dim1name='time', & + long_name='year', units='unitless') + call ncd_defvar(ncid=ncid, varname='input_pftdata_filename', xtype=nf_char, & + dim1name='nchar', & + dim2name='time', & + long_name='Input filepath for PFT values for this year', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='time', xtype=nf_int, & + dim1name='time', & + long_name='Calendar month', units='month') + end if + +end subroutine mkpftAtt + +!----------------------------------------------------------------------- + +end module mkpftMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mksoilMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mksoilMod.F90 new file mode 100644 index 0000000000..e73f18956f --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mksoilMod.F90 @@ -0,0 +1,1464 @@ +module mksoilMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mksoilMod +! +! !DESCRIPTION: +! Make soil data (texture, color and organic) +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8, r4=>shr_kind_r4 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + SAVE + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mksoilInit ! Soil Initialization + + public mksoilAtt ! Add attributes to output file + + public mksoiltex ! Set soil texture + public mkorganic ! Set organic soil + public mksoilcol ! Set soil color + public mkfmax ! Make percent fmax +! +! !PUBLIC DATA MEMBERS: +! + real(r8), public, parameter :: unset = -999.99_r8 ! Flag to signify soil texture override not set + real(r8), public :: soil_sand = unset ! soil texture sand % to override with + real(r8), public :: soil_clay = unset ! soil texture clay % to override with + real(r8), public :: soil_fmax = unset ! soil max saturation frac to override with + integer , parameter :: unsetcol = -999 ! flag to indicate soil color NOT set + integer , public :: soil_color= unsetcol ! soil color to override with +! +! !PRIVATE DATA MEMBERS: +! +! !PRIVATE MEMBER FUNCTIONS: + private :: mkrank + private :: mksoiltexInit ! Soil texture Initialization + private :: mksoilcolInit ! Soil color Initialization + private :: mksoilfmaxInit ! Soil fmax Initialization + +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilInit +! +! !INTERFACE: +subroutine mksoilInit( ) +! +! !DESCRIPTION: +! Initialize the different soil types +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'mksoilInit' +!----------------------------------------------------------------------- + call mksoiltexInit() + call mksoilcolInit() + call mksoilfmaxInit() + +end subroutine mksoilInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoiltexInit +! +! !INTERFACE: +subroutine mksoiltexInit( ) +! +! !DESCRIPTION: +! Initialize of make soil texture +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoiltexInit' +!----------------------------------------------------------------------- + if ( soil_clay /= unset )then + write(6,*) 'Replace soil clay % for all points with: ', soil_clay + if ( soil_sand == unset )then + write (6,*) subname//':error: soil_clay set, but NOT soil_sand' + call abort() + end if + end if + if ( soil_sand /= unset )then + write(6,*) 'Replace soil sand % for all points with: ', soil_sand + if ( soil_clay == unset )then + write (6,*) subname//':error: soil_sand set, but NOT soil_clay' + call abort() + end if + sumtex = soil_sand + soil_clay + if ( sumtex < 0.0_r8 .or. sumtex > 100.0_r8 )then + write (6,*) subname//':error: soil_sand and soil_clay out of bounds: sand, clay = ', & + soil_sand, soil_clay + call abort() + end if + end if + +end subroutine mksoiltexInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoiltex +! +! !INTERFACE: +subroutine mksoiltex(ldomain, mapfname, datfname, ndiag, pctglac_o, sand_o, clay_o) +! +! !DESCRIPTION: +! make %sand and %clay from IGBP soil data, which includes +! igbp soil 'mapunits' and their corresponding textures +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(in) :: pctglac_o(:) ! % glac (output grid) + real(r8) , intent(out):: sand_o(:,:) ! % sand (output grid) + real(r8) , intent(out):: clay_o(:,:) ! % clay (output grid) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + character(len=38) :: typ ! soil texture based on ... + integer :: nlay ! number of soil layers + integer :: mapunitmax ! max value of igbp soil mapunits + integer :: mapunittemp ! temporary igbp soil mapunit + integer :: maxovr + integer , allocatable :: novr(:) + integer , allocatable :: kmap(:,:) + real(r8), allocatable :: kwgt(:,:) + integer , allocatable :: kmax(:) + real(r8), allocatable :: wst(:) + real(r8), allocatable :: sand_i(:,:) ! input grid: percent sand + real(r8), allocatable :: clay_i(:,:) ! input grid: percent clay + real(r8), allocatable :: mapunit_i(:) ! input grid: igbp soil mapunits + integer, parameter :: num=2 ! set soil mapunit number + integer :: wsti(num) ! index to 1st and 2nd largest wst + integer, parameter :: nlsm=4 ! number of soil textures + character(len=38) :: soil(0:nlsm) ! name of each soil texture + real(r8) :: gast_i(0:nlsm) ! global area, by texture type + real(r8) :: gast_o(0:nlsm) ! global area, by texture type + real(r8) :: wt ! map overlap weight + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + integer :: l,k,n,m,ni,no,ns_i,ns_o ! indices + integer :: k1,k2 ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + integer :: miss = 99999 ! missing data indicator + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + logical :: found ! temporary + integer :: kmap_max ! maximum overlap weights + integer, parameter :: kmap_max_min = 90 ! kmap_max mininum value + integer, parameter :: km_mx_ns_prod = 160000 ! product of kmap_max*ns_o to keep constant + character(len=32) :: subname = 'mksoiltex' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %sand and %clay .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Define the model surface types: 0 to nlsm + ! ----------------------------------------------------------------- + + soil(0) = 'no soil: ocean, glacier, lake, no data' + soil(1) = 'clays ' + soil(2) = 'sands ' + soil(3) = 'loams ' + soil(4) = 'silts ' + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + ns_o = ldomain%ns + + write (6,*) 'Open soil texture file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_dimid (ncid, 'number_of_layers', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlay), subname) + + call check_ret(nf_inq_dimid (ncid, 'max_value_mapunit', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, mapunitmax), subname) + + allocate(sand_i(mapunitmax,nlay), & + clay_i(mapunitmax,nlay), & + mapunit_i(ns_i), stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'MAPUNITS', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, mapunit_i), subname) + + call check_ret(nf_inq_varid (ncid, 'PCT_SAND', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, sand_i), subname) + + call check_ret(nf_inq_varid (ncid, 'PCT_CLAY', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, clay_i), subname) + + call check_ret(nf_close(ncid), subname) + + ! Compute local fields _o + if (soil_sand==unset .and. soil_clay==unset) then + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! kmap_max are the maximum number of mapunits that will consider on + ! any output gridcell - this is set currently above and can be changed + ! kmap(:) are the mapunit values on the input grid + ! kwgt(:) are the weights on the input grid + + allocate(novr(ns_o)) + novr(:) = 0 + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + novr(no) = novr(no) + 1 + end do + maxovr = maxval(novr(:)) + kmap_max = min(maxovr,max(kmap_max_min,km_mx_ns_prod/ns_o)) + deallocate(novr) + + write(6,*)'kmap_max= ',kmap_max,' maxovr= ',maxovr,' ns_o= ',ns_o,' size= ',(kmap_max+1)*ns_o + + allocate(kmap(0:kmap_max,ns_o), stat=ier) + if (ier/=0) call abort() + allocate(kwgt(0:kmap_max,ns_o), stat=ier) + if (ier/=0) call abort() + allocate(kmax(ns_o), stat=ier) + if (ier/=0) call abort() + allocate(wst(0:kmap_max), stat=ier) + if (ier/=0) call abort() + + kwgt(:,:) = 0. + kmap(:,:) = 0 + kmax(:) = 0 + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + if (tgridmap%frac_src(ni) > 0) then + k = mapunit_i(ni) + else + k = 0 + end if + found = .false. + do l = 0,kmax(no) + if (k == kmap(l,no)) then + kwgt(l,no) = kwgt(l,no) + wt + kmap(l,no) = k + found = .true. + exit + end if + end do + if (.not. found) then + kmax(no) = kmax(no) + 1 + if (kmax(no) > kmap_max) then + write(6,*)'kmax is > kmap_max= ',kmax(no), 'kmap_max = ', & + kmap_max,' for no = ',no + write(6,*)'reset kmap_max in mksoilMod to a greater value' + stop + end if + kmap(kmax(no),no) = k + kwgt(kmax(no),no) = wt + end if + enddo + + end if + + do no = 1,ns_o + + if (soil_sand==unset .and. soil_clay==unset) then + wst(:) = 0. + wst(0:kmax(no)) = kwgt(0:kmax(no),no) + + ! Rank non-zero weights by soil mapunit. + ! k1 is the most extensive mapunit. + ! k2 is the second most extensive mapunit. + + if (maxval(wst(:)) > 0) then + call mkrank (kmax(no)+1, wst(0:kmax(no)), miss, wsti, num) + k1 = kmap(wsti(1),no) + if (wsti(2) == miss) then + k2 = miss + else + k2 = kmap(wsti(2),no) + end if + else + k1 = 0 + k2 = 0 + end if + + end if + + ! Set soil texture as follows: + ! If land grid cell is ocean or 100% glacier: cell has no soil + ! Otherwise, grid cell needs soil: + ! a. Use dominant igbp soil mapunit based on area of overlap unless + ! 'no data' is dominant + ! b. In this case use second most dominant mapunit if it has data + ! c. If this has no data or if there isn't a second most dominant + ! mapunit, use loam for soil texture + + if (abs(pctglac_o(no)-100.) < 1.e-06) then !---glacier + do l = 1, nlay + sand_o(no,l) = 0. + clay_o(no,l) = 0. + end do + else !---need soil + if (soil_sand/=unset .and. soil_clay/=unset) then !---soil texture is input + do l = 1, nlay + sand_o(no,l) = soil_sand + clay_o(no,l) = soil_clay + end do + else if (k1 /= 0) then !---not 'no data' + do l = 1, nlay + sand_o(no,l) = sand_i(k1,l) + clay_o(no,l) = clay_i(k1,l) + end do + else !---if (k1 == 0) then + if (k2 == 0 .or. k2 == miss) then !---no data + do l = 1, nlay + sand_o(no,l) = 43. !---use loam + clay_o(no,l) = 18. + end do + else !---if (k2 /= 0 and /= miss) + do l = 1, nlay + sand_o(no,l) = sand_i(k2,l) + clay_o(no,l) = clay_i(k2,l) + end do + end if !---end of k2 if-block + end if !---end of k1 if-block + end if !---end of land/ocean if-block + + enddo + + if (soil_sand==unset .and. soil_clay==unset) then + + ! Global sum of output field + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKSOILTEX error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global area of each soil type on input and output grids + ! ----------------------------------------------------------------- + + ! input grid: global areas by texture class + + gast_i(:) = 0. + do l = 1, nlay + do ni = 1,ns_i + mapunittemp = nint(mapunit_i(ni)) + if (mapunittemp==0) then + typ = 'no soil: ocean, glacier, lake, no data' + else if (clay_i(mapunittemp,l) >= 40.) then + typ = 'clays' + else if (sand_i(mapunittemp,l) >= 50.) then + typ = 'sands' + else if (clay_i(mapunittemp,l)+sand_i(mapunittemp,l) < 50.) then + if (tdomain%mask(ni) /= 0.) then + typ = 'silts' + else !if (tdomain%mask(ni) == 0.) then no data + typ = 'no soil: ocean, glacier, lake, no data' + end if + else + typ = 'loams' + end if + do m = 0, nlsm + if (typ == soil(m)) go to 101 + end do + write (6,*) 'MKSOILTEX error: sand = ',sand_i(mapunittemp,l), & + ' clay = ',clay_i(mapunittemp,l), & + ' not assigned to soil type for input grid lon,lat,layer = ',ni,l + call abort() +101 continue + gast_i(m) = gast_i(m) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + end do + + ! output grid: global areas by texture class + + gast_o(:) = 0. + do l = 1, nlay + do no = 1,ns_o + if (clay_o(no,l)==0. .and. sand_o(no,l)==0.) then + typ = 'no soil: ocean, glacier, lake, no data' + else if (clay_o(no,l) >= 40.) then + typ = 'clays' + else if (sand_o(no,l) >= 50.) then + typ = 'sands' + else if (clay_o(no,l)+sand_o(no,l) < 50.) then + typ = 'silts' + else + typ = 'loams' + end if + do m = 0, nlsm + if (typ == soil(m)) go to 102 + end do + write (6,*) 'MKSOILTEX error: sand = ',sand_o(no,l), & + ' clay = ',clay_o(no,l), & + ' not assigned to soil type for output grid lon,lat,layer = ',no,l + call abort() +102 continue + gast_o(m) = gast_o(m) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',l=1,70) + write (ndiag,*) 'Soil Texture Output' + write (ndiag,'(1x,70a1)') ('=',l=1,70) + write (ndiag,*) + + write (ndiag,*) 'The following table of soil texture classes is for comparison only.' + write (ndiag,*) 'The actual data is continuous %sand, %silt and %clay not textural classes' + write (ndiag,*) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',l=1,70) + write (ndiag,1001) +1001 format (1x,'soil texture class',17x,' input grid area output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',l=1,70) + write (ndiag,*) + + do l = 0, nlsm + write (ndiag,1002) soil(l),gast_i(l)*1.e-6,gast_o(l)*1.e-6 +1002 format (1x,a38,f16.3,f17.3) + end do + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if (soil_sand==unset .and. soil_clay==unset) then + call gridmap_clean(tgridmap) + deallocate (kmap, kwgt, kmax, wst) + deallocate (sand_i,clay_i,mapunit_i) + end if + + + write (6,*) 'Successfully made %sand and %clay' + write (6,*) + call shr_sys_flush(6) + +end subroutine mksoiltex + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilcolInit +! +! !INTERFACE: +subroutine mksoilcolInit( ) +! +! !DESCRIPTION: +! Initialize of make soil color +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoilcolInit' +!----------------------------------------------------------------------- + + ! Error check soil_color if it is set + if ( soil_color /= unsetcol )then + if ( soil_color < 0 .or. soil_color > 20 )then + write(6,*)'soil_color is out of range = ', soil_color + call abort() + end if + write(6,*) 'Replace soil color for all points with: ', soil_color + end if +end subroutine mksoilcolInit + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilcol +! +! !INTERFACE: +subroutine mksoilcol(ldomain, mapfname, datfname, ndiag, & + pctglac_o, soil_color_o, nsoicol) +! +! !DESCRIPTION: +! make %sand and %clay from IGBP soil data, which includes +! igbp soil 'mapunits' and their corresponding textures +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(in) :: pctglac_o(:) ! % glac (output grid) + integer , intent(out):: soil_color_o(:) ! soil color classes + integer , intent(out):: nsoicol ! number of soil colors +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + integer, parameter :: num=2 ! set soil mapunit number + integer :: wsti(num) ! index to 1st and 2nd largest wst + real(r8), allocatable :: wst(:,:) ! overlap weights, by surface type + real(r8), allocatable :: gast_i(:) ! global area, by surface type + real(r8), allocatable :: gast_o(:) ! global area, by surface type + integer , allocatable :: soil_color_i(:) ! input grid: BATS soil color + integer , allocatable :: color(:) ! 0: none; 1: some + real(r8) :: wt ! map overlap weight + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + character(len=35), allocatable :: col(:) ! name of each color + integer :: k,l,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + integer :: miss = 99999 ! missing data indicator + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mksoilcol' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make soil color classes .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ns_o = ldomain%ns + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(soil_color_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open soil color file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'SOIL_COLOR', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, soil_color_i), subname) + call check_ret(nf_close(ncid), subname) + + nsoicol = maxval(soil_color_i) + write(6,*)'nsoicol = ',nsoicol + + allocate(gast_i(0:nsoicol),gast_o(0:nsoicol),col(0:nsoicol)) + + ! ----------------------------------------------------------------- + ! Define the model color classes: 0 to nsoicol + ! ----------------------------------------------------------------- + + if (nsoicol == 20) then + col(0) = 'no soil ' + col(1) = 'class 1: light ' + col(2) = 'class 2: ' + col(3) = 'class 3: ' + col(4) = 'class 4: ' + col(5) = 'class 5: ' + col(6) = 'class 6: ' + col(7) = 'class 7: ' + col(8) = 'class 8: ' + col(9) = 'class 9: ' + col(10) = 'class 10: ' + col(11) = 'class 11: ' + col(12) = 'class 12: ' + col(13) = 'class 13: ' + col(14) = 'class 14: ' + col(15) = 'class 15: ' + col(16) = 'class 16: ' + col(17) = 'class 17: ' + col(18) = 'class 18: ' + col(19) = 'class 19: ' + col(20) = 'class 20: dark ' + else if (nsoicol == 8) then + col(0) = 'no soil ' + col(1) = 'class 1: light ' + col(2) = 'class 2: ' + col(3) = 'class 3: ' + col(4) = 'class 4: ' + col(5) = 'class 5: ' + col(6) = 'class 6: ' + col(7) = 'class 7: ' + col(8) = 'class 8: dark ' + else + write(6,*)'nsoicol value of ',nsoicol,' is not currently supported' + call abort() + end if + + ! Error check soil_color if it is set + if ( soil_color /= unsetcol )then + if ( soil_color > nsoicol )then + write(6,*)'soil_color is out of range = ', soil_color + call abort() + end if + + do no = 1,ns_o + soil_color_o(no) = soil_color + end do + + else + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! find area of overlap for each soil color for each no + + allocate(wst(0:nsoicol,ns_o)) + wst(0:nsoicol,:) = 0 + allocate(color(ns_o)) + color(:) = 0 + + ! TODO: need to do a loop to determine + ! the maximum number of over lap cells throughout the grid + ! first get an array that is novr(ns_o) and fill this in - then set + ! maxovr - to max(novr) - then allocate the array wst to be size of + ! maxovr,ns_o or 0:nsoilcol,ns_o + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + k = soil_color_i(ni) * tdomain%mask(ni) + wst(k,no) = wst(k,no) + wt + if (k>0 .and. wst(k,no)>0.) then + color(no) = 1 + wst(0,no) = 0.0 + end if + enddo + + soil_color_o(:) = 0 + do no = 1,ns_o + + ! Rank non-zero weights by color type. wsti(1) is the most extensive + ! color type. + + if (color(no) == 1) then + call mkrank (nsoicol, wst(0:nsoicol,no), miss, wsti, num) + soil_color_o(no) = wsti(1) + end if + + ! If land but no color, set color to 15 (in older dataset generic + ! soil color 4) + + if (nsoicol == 8) then + if (soil_color_o(no)==0) soil_color_o(no) = 4 + else if (nsoicol == 20) then + if (soil_color_o(no)==0) soil_color_o(no) = 15 + end if + + ! Set color for grid cells that are 100% glacier to zero. Otherwise, + ! must have a soil color for the non-glacier portion of grid cell. + + if (abs(pctglac_o(no)-100.)<1.e-06) soil_color_o(no)=0 + + ! Error checks + + if (soil_color_o(no) < 0 .or. soil_color_o(no) > nsoicol) then + write (6,*) 'MKSOILCOL error: land model soil color = ', & + soil_color_o(no),' is not valid for lon,lat = ',no + call abort() + end if + + enddo + deallocate (wst) + deallocate (color) + + ! Global sum of output field + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKSOILCOL error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global area of each soil color on input and output grids + ! ----------------------------------------------------------------- + + gast_i(:) = 0. + do ni = 1,ns_i + k = soil_color_i(ni) + gast_i(k) = gast_i(k) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + + gast_o(:) = 0. + do no = 1,ns_o + k = soil_color_o(no) + gast_o(k) = gast_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! area comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Soil Color Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'soil color type',20x,' input grid area output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + do k = 0, nsoicol + write (ndiag,1002) col(k),gast_i(k)*1.e-6,gast_o(k)*1.e-6 +1002 format (1x,a35,f16.3,f17.3) + end do + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( soil_color == unsetcol )then + call gridmap_clean(tgridmap) + end if + deallocate (soil_color_i,gast_i,gast_o,col) + + write (6,*) 'Successfully made soil color classes' + write (6,*) + call shr_sys_flush(6) + +end subroutine mksoilcol + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkorganic +! +! !INTERFACE: +subroutine mkorganic(ldomain, mapfname, datfname, ndiag, organic_o) +! +! !DESCRIPTION: +! make organic matter dataset +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: organic_o(:,:) ! output grid: +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! +! Author: David Lawrence +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: organic_i(:,:) ! input grid: total column organic matter + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gomlev_i ! input grid: global organic on lev + real(r8) :: garea_i ! input grid: global area + real(r8) :: gomlev_o ! output grid: global organic on lev + real(r8) :: garea_o ! output grid: global area + integer :: k,n,m,ni,no,ns_i ! indices + integer :: lev ! level index + integer :: nlay ! number of soil layers + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkorganic' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make organic matter dataset .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + write (6,*) 'Open soil organic file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + call check_ret(nf_inq_dimid (ncid, 'number_of_layers', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlay), subname) + + allocate(organic_i(ns_i,nlay),stat=ier) + if (ier/=0) call abort() + if (nlay /= nlevsoi) then + write(6,*)'nlay, nlevsoi= ',nlay,nlevsoi,' do not match' + stop + end if + + call check_ret(nf_inq_varid (ncid, 'ORGANIC', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, organic_i), subname) + + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + do lev = 1,nlay + call gridmap_areaave(tgridmap, organic_i(:,lev), organic_o(:,lev)) + end do + + do lev = 1,nlevsoi + + ! Check for conservation + + do no = 1,ldomain%ns + if ((organic_o(no,lev)) > 130.000001_r8) then + write (6,*) 'MKORGANIC error: organic = ',organic_o(no,lev), & + ' greater than 130.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + +! ! Diagnostic output + + ! TODO: there is nothing being written out here currently - all zeroes + ! So for now these are commented out +!!$ write (ndiag,*) +!!$ write (ndiag,'(1x,70a1)') ('.',k=1,70) +!!$ write (ndiag,2001) +!!$2001 format (1x,'surface type input grid area output grid area'/ & +!!$ 1x,' 10**6 km**2 10**6 km**2 ') +!!$ write (ndiag,'(1x,70a1)') ('.',k=1,70) +!!$ write (ndiag,*) +!!$ write (ndiag,2002) gomlev_i*1.e-06,gomlev_o*1.e-06 +!!$ write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +!!$2002 format (1x,'organic ',f14.3,f17.3) +!!$2004 format (1x,'all surface ',f14.3,f17.3) +!!$ + call shr_sys_flush(ndiag) + + write (6,*) 'Successfully made organic matter, level = ', lev + call shr_sys_flush(6) + + end do ! lev + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (organic_i) + + write (6,*) 'Successfully made organic matter' + call shr_sys_flush(6) + write(6,*) + +end subroutine mkorganic + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: mkrank +! +! !INTERFACE: +subroutine mkrank (n, a, miss, iv, num) +! +! !DESCRIPTION: +! Return indices of largest [num] values in array [a]. Private method +! only used for soil color and soil texture. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: n !array length + real(r8), intent(in) :: a(0:n) !array to be ranked + integer , intent(in) :: miss !missing data value + integer , intent(in) :: num !number of largest values requested + integer , intent(out):: iv(num) !index to [num] largest values in array [a] +! +! !CALLED FROM: +! subroutine mksoilcol +! subroutine mksoiltex +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) a_max !maximum value in array + integer i !array index + real(r8) delmax !tolerance for finding if larger value + integer m !do loop index + integer k !do loop index + logical exclude !true if data value has already been chosen +!----------------------------------------------------------------------- + + delmax = 1.e-06 + + ! Find index of largest non-zero number + + iv(1) = miss + a_max = -9999. + + do i = 0, n + if (a(i)>0. .and. (a(i)-a_max)>delmax) then + a_max = a(i) + iv(1) = i + end if + end do + + ! iv(1) = miss indicates no values > 0. this is an error + + if (iv(1) == miss) then + write (6,*) 'MKRANK error: iv(1) = missing' + call abort() + end if + + ! Find indices of the next [num]-1 largest non-zero number. + ! iv(m) = miss if there are no more values > 0 + + do m = 2, num + iv(m) = miss + a_max = -9999. + do i = 0, n + + ! exclude if data value has already been chosen + + exclude = .false. + do k = 1, m-1 + if (i == iv(k)) exclude = .true. + end do + + ! if not already chosen, see if it is the largest of + ! the remaining values + + if (.not. exclude) then + if (a(i)>0. .and. (a(i)-a_max)>delmax) then + a_max = a(i) + iv(m) = i + end if + end if + end do + end do + +end subroutine mkrank + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilfmaxInit +! +! !INTERFACE: +subroutine mksoilfmaxInit( ) +! +! !DESCRIPTION: +! Initialize of make soil fmax +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoilfmaxInit' +!----------------------------------------------------------------------- + + ! Error check soil_fmax if it is set + if ( soil_fmax /= unset )then + if ( soil_fmax < 0.0 .or. soil_fmax > 1.0 )then + write(6,*)'soil_fmax is out of range = ', soil_fmax + stop + end if + write(6,*) 'Replace soil fmax for all points with: ', soil_fmax + end if + +end subroutine mksoilfmaxInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkfmax +! +! !INTERFACE: +subroutine mkfmax(ldomain, mapfname, datfname, ndiag, fmax_o) +! +! !DESCRIPTION: +! make percent fmax +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: fmax_o(:) ! output grid: %fmax +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Revised: Nan Rosenbloom - used mkglacier.F90 as template. +! Original Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: fmax_i(:) ! input grid: percent fmax + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gfmax_i ! input grid: global fmax + real(r8) :: garea_i ! input grid: global area + real(r8) :: gfmax_o ! output grid: global fmax + real(r8) :: garea_o ! output grid: global area + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkfmax' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %fmax .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(fmax_i(ns_i), stat=ier) + if (ier/=0) call abort() + ns_o = ldomain%ns + + write (6,*) 'Open soil fmax file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'FMAX', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, fmax_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine fmax_o on output grid + + call gridmap_areaave(tgridmap, fmax_i, fmax_o) + + do no = 1,ns_o + if (fmax_o(no) == 0.0) then + fmax_o(no) = .365783 ! fmax_o(no) = globalAvg + end if + if (fmax_o(no) == -999.99) then + fmax_o(no) = .365783 ! fmax_o(no) = globalAvg + end if + enddo + + ! Check for conservation + + do no = 1, ns_o + if ((fmax_o(no)) > 1.000001_r8) then + write (6,*) 'MKFMAX error: fmax = ',fmax_o(no), & + ' greater than 1.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKFMAX error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + gfmax_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gfmax_i = gfmax_i + fmax_i(ni)*(tgridmap%area_src(ni)/100.)* & + tgridmap%frac_src(ni)*re**2 + end do + + gfmax_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gfmax_o = gfmax_o + fmax_o(no)*(tgridmap%area_dst(no)/100.) * & + tgridmap%frac_dst(no)*re**2 + if ((tgridmap%mask_dst(no) > 0)) then + if ((tgridmap%frac_dst(no) < 0.0) .or. (tgridmap%frac_dst(no) > 1.0001)) then + write(6,*) "ERROR:: frac out of range: ", tgridmap%frac_dst(no),no + stop + end if + end if + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Maximum Fractional Saturated Area Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) gfmax_i*1.e-06,gfmax_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'fmax ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + + write (6,*) 'Successfully made %fmax' + write (6,*) + call shr_sys_flush(6) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (fmax_i) + +end subroutine mkfmax + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilAtt +! +! !INTERFACE: +subroutine mksoilAtt( ncid, dynlanduse, xtype ) +! +! !DESCRIPTION: +! add atttributes to output file regarding the soil module +! +! !USES: + use fileutils , only : get_filename + use mkncdio , only : check_ret, ncd_defvar + use mkvarpar + use mkvarctl + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ncid ! NetCDF file ID to write out to + logical, intent(in) :: dynlanduse ! if dynamic land-use file + integer, intent(in) :: xtype ! external type to output real data as +! +! !CALLED FROM: +! subroutine mkfile in module mkfileMod +! +! !REVISION HISTORY: +! Original Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: dimid ! temporary + character(len=256) :: str ! global attribute string + character(len=32) :: subname = 'mksoilAtt' +!----------------------------------------------------------------------- + + if (.not. dynlanduse) then + + ! Define dimensions unique to soil + + call check_ret(nf_def_dim (ncid, 'nlevsoi', & + nlevsoi , dimid), subname) + + ! Add global attributes to file + + if ( soil_clay /= unset .and. soil_sand /= unset )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_clay_override', len_trim(str), trim(str)), subname) + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_sand_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fsoitex) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Soil_texture_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + if ( soil_color /= unsetcol )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_color_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fsoicol) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Soil_color_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + if ( soil_fmax /= unset )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_fmax_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fmax) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Fmax_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + str = get_filename(mksrf_forganic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Organic_matter_raw_data_file_name', len_trim(str), trim(str)), subname) + + ! Define variables + + call ncd_defvar(ncid=ncid, varname='mxsoil_color', xtype=nf_int, & + long_name='maximum numbers of soil colors', units='unitless') + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='SOIL_COLOR', xtype=nf_int, & + dim1name='gridcell',& + long_name='soil color', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='SOIL_COLOR', xtype=nf_int, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='soil color', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_SAND', xtype=xtype, & + dim1name='gridcell', dim2name='nlevsoi', & + long_name='percent sand', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_SAND', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevsoi', & + long_name='percent sand', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='PCT_CLAY', xtype=xtype, & + dim1name='gridcell', dim2name='nlevsoi', & + long_name='percent clay', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='PCT_CLAY', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevsoi', & + long_name='percent clay', units='unitless') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='ORGANIC', xtype=xtype, & + dim1name='gridcell', dim2name='nlevsoi', & + long_name='organic matter density at soil levels', & + units='kg/m3 (assumed carbon content 0.58 gC per gOM)') + else + call ncd_defvar(ncid=ncid, varname='ORGANIC', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name='nlevsoi', & + long_name='organic matter density at soil levels', & + units='kg/m3 (assumed carbon content 0.58 gC per gOM)') + end if + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname='FMAX', xtype=xtype, & + dim1name='gridcell', & + long_name='maximum fractional saturated area', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='FMAX', xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name='maximum fractional saturated area', units='unitless') + end if + + end if + +end subroutine mksoilAtt + +!----------------------------------------------------------------------- + +end module mksoilMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 new file mode 100644 index 0000000000..08c119bb56 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mksurfdat.F90 @@ -0,0 +1,1320 @@ +program mksurfdat + +!----------------------------------------------------------------------- +!BOP +! +! !PROGRAM: mksurfdat +! +! !DESCRIPTION: +! Creates land model surface dataset from original "raw" data files. +! Surface dataset contains model grid, pfts, inland water, glacier, +! soil texture, soil color, LAI and SAI, urban fraction, and urban +! parameters. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4 + use fileutils , only : opnfil, getavu + use mklaiMod , only : mklai + use mkpftMod , only : pft_idx, pft_frc, mkpft, mkpftInit, mkpft_parse_oride, & + mkirrig + use mksoilMod , only : soil_sand, soil_clay, mksoiltex, mksoilInit, & + soil_color, mksoilcol, mkorganic, & + soil_fmax, mkfmax + use mkvocefMod , only : mkvocef + use mklanwatMod , only : mklakwat, mkwetlnd + use mkglcmecMod , only : nglcec, mkglcmec, mkglcmecInit, mkglacier + use mkharvestMod , only : mkharvest, mkharvest_init, mkharvest_fieldname, & + mkharvest_numtypes, mkharvest_parse_oride + use mkurbanparCommonMod, only : get_urban_format, mkelev, & + URBAN_FORMAT_AVG, URBAN_FORMAT_DOM + use mkurbanparAvgMod , only : mkurbanA => mkurban, mkurbanparA => mkurbanpar + use mkurbanparDomMod , only : mkurbanD => mkurban, mkurbanparD => mkurbanpar + use mkfileMod , only : mkfile + use mkvarpar , only : nlevsoi, elev_thresh + use mkvarctl + use nanMod , only : nan, bigint + use mkncdio , only : check_ret + use mkdomainMod , only : domain_type, domain_read_map, domain_read, & + domain_write +! +! !ARGUMENTS: + implicit none + + include 'netcdf.inc' +! +! !REVISION HISTORY: +! Authors: Gordon Bonan, Sam Levis and Mariana Vertenstein +! Revised: Nan Rosenbloom to add fmax processing. +! 3/18/08: David Lawrence added organic matter processing +! 1/22/09: Keith Oleson added urban parameter processing +! +! +! !LOCAL VARIABLES: +!EOP + integer :: nsoicol ! number of model color classes + integer :: k,m,n ! indices + integer :: ni,nj,ns_o ! indices + integer :: ier ! error status + integer :: ndiag,nfdyn ! unit numbers + integer :: ncid ! netCDF id + integer :: omode ! netCDF output mode + integer :: varid ! netCDF variable id + integer :: ndims ! netCDF number of dimensions + integer :: beg(4),len(4),dimids(4) ! netCDF dimension sizes + integer :: ret ! netCDF return status + integer :: ntim ! time sample for dynamic land use + integer :: year ! year for dynamic land use + integer :: urban_format ! code for format of urban file + logical :: all_veg ! if gridcell will be 100% vegetated land-cover + real(r8) :: suma ! sum for error check + character(len=256) :: fgrddat ! grid data file + character(len=256) :: fsurdat ! output surface data file name + character(len=256) :: fsurlog ! output surface log file name + character(len=256) :: fdyndat ! dynamic landuse data file name + character(len=256) :: fname ! generic filename + character(len=256) :: string ! string read in + integer :: t1 ! timer + real(r8),parameter :: p5 = 0.5_r8 ! constant + real(r8),parameter :: p25 = 0.25_r8 ! constant + + real(r8), allocatable :: landfrac_pft(:) ! PFT data: % land per gridcell + real(r8), allocatable :: pctlnd_pft(:) ! PFT data: % of gridcell for PFTs + real(r8), allocatable :: pctlnd_pft_dyn(:) ! PFT data: % of gridcell for dyn landuse PFTs + integer , allocatable :: pftdata_mask(:) ! mask indicating real or fake land type + real(r8), pointer :: pctpft(:,:) ! PFT data: land fraction per gridcell + real(r8), pointer :: harvest(:,:) ! harvest data: normalized harvesting + real(r8), allocatable :: pctgla(:) ! percent of grid cell that is glacier + real(r8), allocatable :: pctgla_uncorrected(:) ! percent of grid cell that is glacier, before any corrections + real(r8), allocatable :: pctglc_gic(:) ! percent of grid cell that is gic (glc) + real(r8), allocatable :: pctglc_icesheet(:) ! percent of grid cell that is ice sheet (glc) + real(r8), allocatable :: pctglcmec(:,:) ! glacier_mec pct coverage in each gridcell and class + real(r8), allocatable :: topoglcmec(:,:) ! glacier_mec sfc elevation in each gridcell and class + real(r8), allocatable :: pctglcmec_gic(:,:) ! GIC pct coverage in each gridcell and class + real(r8), allocatable :: pctglcmec_icesheet(:,:) ! icesheet pct coverage in each gridcell and class + real(r8), allocatable :: elevclass(:) ! glacier_mec elevation classes + real(r8), allocatable :: pctlak(:) ! percent of grid cell that is lake + real(r8), allocatable :: pctwet(:) ! percent of grid cell that is wetland + real(r8), allocatable :: pctirr(:) ! percent of grid cell that is irrigated + real(r8), allocatable :: pcturb(:) ! percent of grid cell that is urbanized + real(r8), allocatable :: elev(:) ! glc elevation (m) + real(r8), allocatable :: topo(:) ! land elevation (m) + real(r8), allocatable :: fmax(:) ! fractional saturated area + integer , allocatable :: soicol(:) ! soil color + real(r8), allocatable :: pctsand(:,:) ! soil texture: percent sand + real(r8), allocatable :: pctclay(:,:) ! soil texture: percent clay + real(r8), allocatable :: ef1_btr(:) ! Isoprene emission factor for broadleaf + real(r8), allocatable :: ef1_fet(:) ! Isoprene emission factor for fine/everg + real(r8), allocatable :: ef1_fdt(:) ! Isoprene emission factor for fine/dec + real(r8), allocatable :: ef1_shr(:) ! Isoprene emission factor for shrubs + real(r8), allocatable :: ef1_grs(:) ! Isoprene emission factor for grasses + real(r8), allocatable :: ef1_crp(:) ! Isoprene emission factor for crops + real(r8), allocatable :: organic(:,:) ! organic matter density (kg/m3) + integer , allocatable :: urban_dens(:) ! urban density class + integer , allocatable :: urban_region(:) ! urban region ID + + type(domain_type) :: ldomain + + character(len=32) :: subname = 'mksrfdat' ! program name + + namelist /clmexp/ & + mksrf_fgrid, & + mksrf_gridtype, & + mksrf_fvegtyp, & + mksrf_fsoitex, & + mksrf_forganic, & + mksrf_fsoicol, & + mksrf_fvocef, & + mksrf_flakwat, & + mksrf_fwetlnd, & + mksrf_fglacier, & + mksrf_furbtopo, & + mksrf_flndtopo, & + mksrf_fmax, & + mksrf_furban, & + mksrf_flai, & + mksrf_firrig, & + mksrf_fdynuse, & + nglcec, & + numpft, & + soil_color, & + soil_sand, & + soil_fmax, & + soil_clay, & + pft_idx, & + pft_frc, & + all_urban, & + map_fpft, & + map_flakwat, & + map_fwetlnd, & + map_fglacier, & + map_fsoitex, & + map_fsoicol, & + map_furban, & + map_furbtopo, & + map_flndtopo, & + map_fmax, & + map_forganic, & + map_fvocef, & + map_flai, & + map_fharvest, & + map_firrig, & + outnc_large_files, & + outnc_double, & + outnc_dims, & + fsurdat, & + fdyndat, & + fsurlog + +!----------------------------------------------------------------------- + + ! ====================================================================== + ! Read input namelist + ! ====================================== + ! Must specify settings for the output grid: + ! ====================================== + ! mksrf_fgrid -- Grid dataset + ! ====================================== + ! Must specify settings for input high resolution datafiles + ! ====================================== + ! mksrf_fglacier - Glacier dataset + ! mksrf_flai ----- Leaf Area Index dataset + ! mksrf_flakwat -- Lake water dataset + ! mksrf_fwetlnd -- Wetland water dataset + ! mksrf_forganic - Organic soil carbon dataset + ! mksrf_fmax ----- Max fractional saturated area dataset + ! mksrf_fsoicol -- Soil color dataset + ! mksrf_fsoitex -- Soil texture dataset + ! mksrf_furbtopo-- Topography dataset (for limiting urban areas) + ! mksrf_furban --- Urban dataset + ! mksrf_fvegtyp -- PFT vegetation type dataset + ! mksrf_fvocef -- Volatile Organic Compund Emission Factor dataset + ! ====================================== + ! Must specify mapping file for the different datafiles above + ! ====================================== + ! map_fpft -------- Mapping for mksrf_fvegtyp + ! map_flakwat ----- Mapping for mksrf_flakwat + ! map_fwetlnd ----- Mapping for mksrf_fwetlnd + ! map_fglacier ---- Mapping for mksrf_fglacier + ! map_fsoitex ----- Mapping for mksrf_fsoitex + ! map_fsoicol ----- Mapping for mksrf_fsoicol + ! map_furban ------ Mapping for mksrf_furban + ! map_furbtopo ---- Mapping for mksrf_furbtopo + ! map_flndtopo ---- Mapping for mksrf_flndtopo + ! map_fmax -------- Mapping for mksrf_fmax + ! map_forganic ---- Mapping for mksrf_forganic + ! map_fvocef ------ Mapping for mksrf_fvocef + ! map_flai -------- Mapping for mksrf_flai + ! map_fharvest ---- Mapping for mksrf_flai harvesting + ! map_firrig ------ Mapping for mksrf_firrig (optional) + ! ====================================== + ! Optionally specify setting for: + ! ====================================== + ! mksrf_firrig ------ Irrigation dataset + ! mksrf_fdynuse ----- ASCII text file that lists each year of pft files to use + ! mksrf_gridtype ---- Type of grid (default is 'global') + ! outnc_double ------ If output should be in double precision + ! outnc_large_files - If output should be in NetCDF large file format + ! nglcec ------------ If you want to change the number of Glacier elevation classes + ! ====================================== + ! Optional settings to change values for entire area + ! ====================================== + ! all_urban --------- If entire area is urban + ! soil_color -------- If you want to change the soil_color to this value everywhere + ! soil_clay --------- If you want to change the soil_clay % to this value everywhere + ! soil_fmax --------- If you want to change the soil_fmax to this value everywhere + ! soil_sand --------- If you want to change the soil_sand % to this value everywhere + ! pft_idx ----------- If you want to change to 100% veg covered with given PFT indices + ! pft_frc ----------- Fractions that correspond to the pft_idx above + ! ================== + ! numpft (if different than default of 16) + ! ====================================================================== + + write(6,*) 'Attempting to initialize control settings .....' + + mksrf_gridtype = 'global' + outnc_large_files = .false. + outnc_double = .true. + all_urban = .false. + + read(5, clmexp, iostat=ier) + if (ier /= 0) then + write(6,*)'error: namelist input resulted in error code ',ier + call abort() + endif + + write (6,*) 'Attempting to create surface boundary data .....' + write (6,'(72a1)') ("-",n=1,60) + + ! ---------------------------------------------------------------------- + ! Error check namelist input + ! ---------------------------------------------------------------------- + + if (mksrf_fgrid /= ' ')then + fgrddat = mksrf_fgrid + write(6,*)'mksrf_fgrid = ',mksrf_fgrid + else + write (6,*)'must specify mksrf_fgrid' + call abort() + endif + + if (trim(mksrf_gridtype) == 'global' .or. & + trim(mksrf_gridtype) == 'regional') then + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + else + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + write (6,*)'illegal mksrf_gridtype, must be global or regional ' + call abort() + endif + if ( outnc_large_files )then + write(6,*)'Output file in NetCDF 64-bit large_files format' + end if + if ( outnc_double )then + write(6,*)'Output ALL data in file as 64-bit' + end if + if ( all_urban )then + write(6,*) 'Output ALL data in file as 100% urban' + end if + ! + ! Call module initialization routines + ! + call mksoilInit( ) + call mkpftInit( all_urban, all_veg ) + allocate ( elevclass(nglcec+1) ) + call mkglcmecInit (elevclass) + + if ( all_veg )then + write(6,*) 'Output ALL data in file as 100% vegetated' + end if + + ! ---------------------------------------------------------------------- + ! Determine land model grid, fractional land and land mask + ! ---------------------------------------------------------------------- + + write(6,*)'calling domain_read' + if ( .not. domain_read_map(ldomain, fgrddat) )then + call domain_read(ldomain, fgrddat) + end if + write(6,*)'finished domain_read' + + ! Invalidate mask and frac for ldomain + + !ldomain%mask = bigint + !ldomain%frac = nan + + ! Determine if will have 1d output + + if (ldomain%ni /= -9999 .and. ldomain%nj /= -9999) then + write(6,*)'fsurdat is 2d lat/lon grid' + write(6,*)'nlon= ',ldomain%ni,' nlat= ',ldomain%nj + if (outnc_dims == 1) then + write(6,*)' writing output file in 1d gridcell format' + end if + else + write(6,*)'fsurdat is 1d gridcell grid' + outnc_dims = 1 + end if + + outnc_1d = .false. + if ((ldomain%ni == -9999 .and. ldomain%nj == -9999) .or. outnc_dims==1) then + outnc_1d = .true. + write(6,*)'output file will be 1d' + end if + + ! ---------------------------------------------------------------------- + ! Allocate and initialize dynamic memory + ! ---------------------------------------------------------------------- + + ns_o = ldomain%ns + allocate ( landfrac_pft(ns_o) , & + pctlnd_pft(ns_o) , & + pftdata_mask(ns_o) , & + pctpft(ns_o,0:numpft) , & + pctgla(ns_o) , & + pctgla_uncorrected(ns_o), & + pctlak(ns_o) , & + pctwet(ns_o) , & + pcturb(ns_o) , & + pctsand(ns_o,nlevsoi) , & + pctclay(ns_o,nlevsoi) , & + soicol(ns_o) ) + landfrac_pft(:) = spval + pctlnd_pft(:) = spval + pftdata_mask(:) = -999 + pctpft(:,:) = spval + pctgla(:) = spval + pctgla_uncorrected(:) = spval + pctlak(:) = spval + pctwet(:) = spval + pcturb(:) = spval + pctsand(:,:) = spval + pctclay(:,:) = spval + soicol(:) = -999 + + ! ---------------------------------------------------------------------- + ! Open diagnostic output log file + ! ---------------------------------------------------------------------- + + if (fsurlog == ' ') then + write(6,*)' must specify fsurlog in namelist' + stop + else + ndiag = getavu(); call opnfil (fsurlog, ndiag, 'f') + end if + + if (mksrf_fgrid /= ' ')then + write (ndiag,*)'using fractional land data from file= ', & + trim(mksrf_fgrid),' to create the surface dataset' + endif + + if (trim(mksrf_gridtype) == 'global' .or. & + trim(mksrf_gridtype) == 'regional') then + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + endif + + write(ndiag,*) 'PFTs from: ',trim(mksrf_fvegtyp) + write(ndiag,*) 'fmax from: ',trim(mksrf_fmax) + write(ndiag,*) 'glaciers from: ',trim(mksrf_fglacier) + write(ndiag,*) ' with: ', nglcec, ' glacier elevation classes' + write(ndiag,*) 'urban topography from: ',trim(mksrf_furbtopo) + write(ndiag,*) 'land topography from: ',trim(mksrf_flndtopo) + write(ndiag,*) 'urban from: ',trim(mksrf_furban) + write(ndiag,*) 'inland lake from: ',trim(mksrf_flakwat) + write(ndiag,*) 'inland wetland from: ',trim(mksrf_fwetlnd) + write(ndiag,*) 'soil texture from: ',trim(mksrf_fsoitex) + write(ndiag,*) 'soil organic from: ',trim(mksrf_forganic) + write(ndiag,*) 'soil color from: ',trim(mksrf_fsoicol) + write(ndiag,*) 'VOC emission factors from: ',trim(mksrf_fvocef) + if (mksrf_firrig /= ' ') then + write(ndiag,*)& + 'irrigated area from: ',trim(mksrf_firrig) + end if + write(ndiag,*)' mapping for pft ',trim(map_fpft) + write(ndiag,*)' mapping for lake water ',trim(map_flakwat) + write(ndiag,*)' mapping for wetland ',trim(map_fwetlnd) + write(ndiag,*)' mapping for glacier ',trim(map_fglacier) + write(ndiag,*)' mapping for soil texture ',trim(map_fsoitex) + write(ndiag,*)' mapping for soil color ',trim(map_fsoicol) + write(ndiag,*)' mapping for soil organic ',trim(map_forganic) + write(ndiag,*)' mapping for urban ',trim(map_furban) + write(ndiag,*)' mapping for fmax ',trim(map_fmax) + write(ndiag,*)' mapping for VOC pct emis ',trim(map_fvocef) + write(ndiag,*)' mapping for harvest ',trim(map_fharvest) + if (mksrf_firrig /= ' ') then + write(ndiag,*) & + ' mapping for irrigation ',trim(map_firrig) + end if + write(ndiag,*)' mapping for lai/sai ',trim(map_flai) + write(ndiag,*)' mapping for urb topography ',trim(map_furbtopo) + write(ndiag,*)' mapping for land topography ',trim(map_flndtopo) + + if (mksrf_fdynuse /= ' ') then + write(6,*)'mksrf_fdynuse = ',trim(mksrf_fdynuse) + end if + + ! ---------------------------------------------------------------------- + ! Make surface dataset fields + ! ---------------------------------------------------------------------- + + ! Make irrigated area fraction [pctirr] from [firrig] dataset if requested in namelist + + allocate ( pctirr(ns_o) ) + pctirr(:) = spval + if (mksrf_firrig /= ' ') then + call mkirrig(ldomain, mapfname=map_firrig, datfname=mksrf_firrig,& + ndiag=ndiag, irrig_o=pctirr) + endif + + ! Make PFTs [pctpft] from dataset [fvegtyp] + + call mkpft(ldomain, mapfname=map_fpft, fpft=mksrf_fvegtyp, & + firrig=mksrf_firrig, ndiag=ndiag, pctlnd_o=pctlnd_pft, pctirr_o=pctirr, & + pctpft_o=pctpft ) + + ! Make inland water [pctlak, pctwet] [flakwat] [fwetlnd] + + call mklakwat (ldomain, mapfname=map_flakwat, datfname=mksrf_flakwat, & + ndiag=ndiag, zero_out=all_urban.or.all_veg, lake_o=pctlak) + + call mkwetlnd (ldomain, mapfname=map_fwetlnd, datfname=mksrf_fwetlnd, & + ndiag=ndiag, zero_out=all_urban.or.all_veg, swmp_o=pctwet) + + ! Make glacier fraction [pctgla] from [fglacier] dataset + + call mkglacier (ldomain, mapfname=map_fglacier, datfname=mksrf_fglacier, & + ndiag=ndiag, zero_out=all_urban.or.all_veg, glac_o=pctgla, & + glac_uncorrected=pctgla_uncorrected) + + ! Make soil texture [pctsand, pctclay] [fsoitex] + + call mksoiltex (ldomain, mapfname=map_fsoitex, datfname=mksrf_fsoitex, & + ndiag=ndiag, pctglac_o=pctgla, sand_o=pctsand, clay_o=pctclay) + ! Make soil color classes [soicol] [fsoicol] + + call mksoilcol (ldomain, mapfname=map_fsoicol, datfname=mksrf_fsoicol, & + ndiag=ndiag, pctglac_o=pctgla, soil_color_o=soicol, nsoicol=nsoicol) + + ! Make fmax [fmax] from [fmax] dataset + + allocate(fmax(ns_o)) + fmax(:) = spval + call mkfmax (ldomain, mapfname=map_fmax, datfname=mksrf_fmax, & + ndiag=ndiag, fmax_o=fmax) + + ! Make urban fraction [pcturb] from [furban] dataset + + call get_urban_format (mksrf_furban, urban_format) + + if (urban_format == URBAN_FORMAT_AVG) then + call mkurbanA (ldomain, mapfname=map_furban, datfname=mksrf_furban, & + ndiag=ndiag, zero_out=all_veg, urbn_o=pcturb) + else if (urban_format == URBAN_FORMAT_DOM) then + allocate(urban_dens(ns_o) , & + urban_region(ns_o)) + urban_dens(:) = -999 + urban_region(:) = -999 + call mkurbanD (ldomain, mapfname=map_furban, datfname=mksrf_furban, & + ndiag=ndiag, zero_out=all_veg, urbn_o=pcturb, & + dens_o=urban_dens, region_o=urban_region) + else + write(6,*) 'ERROR: unexpected urban format code: ', urban_format + call abort() + end if + + ! WJS (9-25-12): Note about topo datasets: Until now, there have been two topography + ! datasets: flndtopo & fglctopo. flndtopo is used to create the TOPO variable, which I + ! believe is used to downscale grid cell-level climate to glc_mec columns (10-26-12: + ! Now I'm not surue about this: I think TOPO might actually come from a different file + ! in CLM, and TOPO on the surface dataset may be unused). Until now, fglctopo was used + ! for dividing pct_glacier data into multiple elevation classes in + ! mkglcmecMod. However, it is no longer needed for this purpose, since elevation data + ! is now folded into fglacier. fglctopo has also been used to screen urban points (I'm + ! not sure why fglctopo rather than flndtopo was chosen for that purpose). + ! + ! For now, I am keeping fglctopo around simply for the urban screening purpose. To + ! make its purpose clear, I am renaming it to furbtopo. I had planned to switch to a + ! new topo file that is consistent with the topo data that are implicitly included in + ! fglacier (i.e., a file that gives the topo that's used for glc purposes, even though + ! fglctopo itself isn't used for glc purposes any more). However, this caused problems + ! in coming up with a new elev_thresh. Thus, for now I am continuing to use the old + ! fglctopo file, which no longer has any meaning with respect to glc (and again, I am + ! renaming it to furbtopo to make it clear that it is not connected with glc). + ! + ! In the longer term, a better solution for this urban screening would probably be to + ! modify the raw urban data. In that case, I believe we could remove furbtopo. + ! + ! Why was TOPO created from flndtopo rather than fglctopo? It seems like, for the + ! purpose of downscaling, this TOPO variable should ideally represent CAM's + ! topographic height. For that purpose, flndtopo is more appropriate, because it seems + ! to have come from CAM's topo dataset. However, I believe that many (all??) CAM + ! resolutions use some sort of smoothed topography. So the ideal thing to do would be + ! for CLM to get its grid cell-level topography from CAM at initialization. If that + ! were done, then I think flndtopo and the TOPO variable on the surface dataset could + ! go away. (Update 10-26-12: it actually looks to me like CLM's TOPO comes from a + ! different source entirely (flndtopo in CLM), so it may be that TOPO on the surface + ! dataset isn't currently used for anything!) + + + ! Make elevation [elev] from [ftopo, ffrac] dataset + ! Used only to screen pcturb + ! Screen pcturb by elevation threshold from elev dataset + + if ( .not. all_urban .and. .not. all_veg )then + allocate(elev(ns_o)) + elev(:) = spval + call mkelev (ldomain, mapfname=map_furbtopo, datfname=mksrf_furbtopo, & + varname='TOPO_ICE', ndiag=ndiag, elev_o=elev) + + where (elev .gt. elev_thresh) + pcturb = 0._r8 + end where + deallocate(elev) + end if + + ! Determine topography + + allocate(topo(ns_o)) + call mkelev (ldomain, mapfname=map_flndtopo, datfname=mksrf_flndtopo, & + varname='TOPO', ndiag=ndiag, elev_o=topo) + + ! Make organic matter density [organic] [forganic] + allocate (organic(ns_o,nlevsoi)) + organic(:,:) = spval + call mkorganic (ldomain, mapfname=map_forganic, datfname=mksrf_forganic, & + ndiag=ndiag, organic_o=organic) + + ! Make VOC emission factors for isoprene & + ! [ef1_btr,ef1_fet,ef1_fdt,ef1_shr,ef1_grs,ef1_crp] + + allocate ( ef1_btr(ns_o) , & + ef1_fet(ns_o) , & + ef1_fdt(ns_o) , & + ef1_shr(ns_o) , & + ef1_grs(ns_o) , & + ef1_crp(ns_o) ) + ef1_btr(:) = 0._r8 + ef1_fet(:) = 0._r8 + ef1_fdt(:) = 0._r8 + ef1_shr(:) = 0._r8 + ef1_grs(:) = 0._r8 + ef1_crp(:) = 0._r8 + + call mkvocef (ldomain, mapfname=map_fvocef, datfname=mksrf_fvocef, ndiag=ndiag, & + ef_btr_o=ef1_btr, ef_fet_o=ef1_fet, ef_fdt_o=ef1_fdt, & + ef_shr_o=ef1_shr, ef_grs_o=ef1_grs, ef_crp_o=ef1_crp) + + + ! Do landuse changes such as for the poles, etc. + + call change_landuse( ldomain, dynpft=.false. ) + + do n = 1,ns_o + + ! Assume wetland and/or lake when dataset landmask implies ocean + ! (assume medium soil color (15) and loamy texture). + ! Also set pftdata_mask here + + if (pctlnd_pft(n) < 1.e-6_r8) then + pftdata_mask(n) = 0 + soicol(n) = 15 + pctwet(n) = 100._r8 - pctlak(n) + pcturb(n) = 0._r8 + if (mksrf_firrig /= ' ') pctirr(n) = 0._r8 + pctgla(n) = 0._r8 + pctpft(n,:) = 0._r8 + pctsand(n,:) = 43._r8 + pctclay(n,:) = 18._r8 + organic(n,:) = 0._r8 + else + pftdata_mask(n) = 1 + end if + + ! Truncate all percentage fields on output grid. This is needed to + ! insure that wt is not nonzero (i.e. a very small number such as + ! 1e-16) where it really should be zero + + do k = 1,nlevsoi + pctsand(n,k) = float(nint(pctsand(n,k))) + pctclay(n,k) = float(nint(pctclay(n,k))) + end do + pctlak(n) = float(nint(pctlak(n))) + pctwet(n) = float(nint(pctwet(n))) + pctgla(n) = float(nint(pctgla(n))) + if (mksrf_firrig /= ' ') pctirr(n) = float(nint(pctirr(n))) + + ! Make sure sum of land cover types does not exceed 100. If it does, + ! subtract excess from most dominant land cover. + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if (suma > 250._r4) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb and pctgla is greater than 250%' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n) + call abort() + else if (suma > 100._r4) then + pctlak(n) = pctlak(n) * 100._r8/suma + pctwet(n) = pctwet(n) * 100._r8/suma + pcturb(n) = pcturb(n) * 100._r8/suma + pctgla(n) = pctgla(n) * 100._r8/suma + end if + + end do + + call normalizencheck_landuse(ldomain) + + ! Write out sum of PFT's + + do k = 0,numpft + suma = 0._r8 + do n = 1,ns_o + suma = suma + pctpft(n,k) + enddo + write(6,*) 'sum over domain of pft ',k,suma + enddo + write(6,*) + + ! Make glacier multiple elevation classes [pctglcmec,topoglcmec] from [fglacier] dataset + ! This call needs to occur after pctgla has been adjusted for the final time + + if ( nglcec > 0 )then + + allocate (pctglcmec(ns_o,nglcec), & + topoglcmec(ns_o,nglcec), & + pctglcmec_gic(ns_o,nglcec), & + pctglcmec_icesheet(ns_o,nglcec)) + allocate (pctglc_gic(ns_o)) + allocate (pctglc_icesheet(ns_o)) + + pctglcmec(:,:) = spval + topoglcmec(:,:) = spval + pctglcmec_gic(:,:) = spval + pctglcmec_icesheet(:,:) = spval + pctglc_gic(:) = spval + pctglc_icesheet(:) = spval + + call mkglcmec (ldomain, mapfname=map_fglacier, & + datfname_fglacier=mksrf_fglacier, ndiag=ndiag, & + pctglac_o=pctgla, pctglac_o_uncorrected=pctgla_uncorrected, & + pctglcmec_o=pctglcmec, topoglcmec_o=topoglcmec, & + pctglcmec_gic_o=pctglcmec_gic, pctglcmec_icesheet_o=pctglcmec_icesheet, & + pctglc_gic_o=pctglc_gic, pctglc_icesheet_o=pctglc_icesheet) + end if + + ! Determine fractional land from pft dataset + + do n = 1,ns_o + landfrac_pft(n) = pctlnd_pft(n)/100._r8 + end do + + ! ---------------------------------------------------------------------- + ! Create surface dataset + ! ---------------------------------------------------------------------- + + ! Create netCDF surface dataset. + + if (fsurdat == ' ') then + write(6,*)' must specify fsurdat in namelist' + stop + end if + + call mkfile(ldomain, trim(fsurdat), dynlanduse = .false., urban_format=urban_format) + + call domain_write(ldomain, fsurdat) + + call check_ret(nf_open(trim(fsurdat), nf_write, ncid), subname) + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Write fields OTHER THAN lai, sai, heights, and urban parameters to netcdf surface dataset + + call check_ret(nf_inq_varid(ncid, 'PFTDATA_MASK', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, pftdata_mask), subname) + + call check_ret(nf_inq_varid(ncid, 'LANDFRAC_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, landfrac_pft), subname) + + call check_ret(nf_inq_varid(ncid, 'mxsoil_color', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, nsoicol), subname) + + call check_ret(nf_inq_varid(ncid, 'SOIL_COLOR', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, soicol), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_SAND', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctsand), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_CLAY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctclay), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_WETLAND', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctwet), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_LAKE', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctlak), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLACIER', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctgla), subname) + + if ( nglcec > 0 )then + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec), subname) + + call check_ret(nf_inq_varid(ncid, 'GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, elevclass), subname) + + call check_ret(nf_inq_varid(ncid, 'TOPO_GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, topoglcmec), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC_GIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec_gic), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC_ICESHEET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec_icesheet), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_GIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglc_gic), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_ICESHEET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglc_icesheet), subname) + + end if + + call check_ret(nf_inq_varid(ncid, 'TOPO', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, topo), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pcturb), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctpft), subname) + + call check_ret(nf_inq_varid(ncid, 'FMAX', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, fmax), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_BTR', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_btr), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_FET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_fet), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_FDT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_fdt), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_SHR', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_shr), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_GRS', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_grs), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_CRP', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_crp), subname) + + call check_ret(nf_inq_varid(ncid, 'ORGANIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, organic), subname) + + if (mksrf_firrig /= ' ') then + call check_ret(nf_inq_varid(ncid, 'PCT_IRRIG', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctirr), subname) + endif + + if (urban_format == URBAN_FORMAT_DOM) then + call check_ret(nf_inq_varid(ncid, 'URBAN_DENSITY_CLASS', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, urban_dens), subname) + + call check_ret(nf_inq_varid(ncid, 'URBAN_REGION_ID', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, urban_region), subname) + end if + + ! Deallocate arrays NOT needed for dynamic-pft section of code + + deallocate ( organic ) + deallocate ( ef1_btr, ef1_fet, ef1_fdt, ef1_shr, ef1_grs, ef1_crp ) + if ( nglcec > 0 ) deallocate ( pctglcmec, topoglcmec) + if ( nglcec > 0 ) deallocate ( pctglc_gic, pctglc_icesheet) + deallocate ( elevclass ) + deallocate ( fmax ) + deallocate ( pctsand, pctclay ) + deallocate ( soicol ) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! ---------------------------------------------------------------------- + ! Make Urban Parameters from raw input data and write to surface dataset + ! Write to netcdf file is done inside mkurbanpar routine + ! Only call this routine if pcturb is greater than zero somewhere. Raw urban + ! datasets will have no associated parameter fields if there is no urban + ! (e.g., mksrf_urban.060929.nc). + ! ---------------------------------------------------------------------- + + write(6,*)'calling mkurbanparA' + if (any(pcturb > 0._r8)) then + if (urban_format == URBAN_FORMAT_AVG) then + call mkurbanparA(ldomain, mapfname=map_furban, datfname=mksrf_furban, & + ndiag=ndiag, ncido=ncid) + else if (urban_format == URBAN_FORMAT_DOM) then + call mkurbanparD(datfname=mksrf_furban, ncido=ncid, & + dens_o=urban_dens, region_o=urban_region) + else + write(6,*) 'ERROR: unexpected urban format code: ', urban_format + call abort() + end if + else + write(6,*) 'PCT_URBAN is zero everywhere, no urban parameter fields will be created' + end if + + ! ---------------------------------------------------------------------- + ! Make LAI and SAI from 1/2 degree data and write to surface dataset + ! Write to netcdf file is done inside mklai routine + ! ---------------------------------------------------------------------- + + write(6,*)'calling mklai' + call mklai(ldomain, mapfname=map_flai, datfname=mksrf_flai, & + firrig=mksrf_firrig, ndiag=ndiag, ncido=ncid ) + + ! Close surface dataset + + call check_ret(nf_close(ncid), subname) + + write (6,'(72a1)') ("-",n=1,60) + write (6,*)' land model surface data set successfully created for ', & + 'grid of size ',ns_o + + ! ---------------------------------------------------------------------- + ! Create dynamic land use dataset if appropriate + ! ---------------------------------------------------------------------- + + if (mksrf_fdynuse /= ' ') then + + write(6,*)'creating dynamic land use dataset' + + allocate(pctlnd_pft_dyn(ns_o)) + call mkharvest_init( ns_o, spval, harvest, mksrf_fvegtyp ) + + if (fdyndat == ' ') then + write(6,*)' must specify fdyndat in namelist if mksrf_fdynuse is not blank' + stop + end if + + ! Define dimensions and global attributes + + call mkfile(ldomain, fdyndat, dynlanduse=.true., urban_format=urban_format) + + ! Write fields other pft to dynamic land use dataset + + call domain_write(ldomain, fdyndat) + + call check_ret(nf_open(trim(fdyndat), nf_write, ncid), subname) + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + call check_ret(nf_inq_varid(ncid, 'PFTDATA_MASK', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, pftdata_mask), subname) + + call check_ret(nf_inq_varid(ncid, 'LANDFRAC_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, landfrac_pft), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_WETLAND', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctwet), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_LAKE', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctlak), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLACIER', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctgla), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pcturb), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! Read in each dynamic pft landuse dataset + + nfdyn = getavu(); call opnfil (mksrf_fdynuse, nfdyn, 'f') + + ntim = 0 + do + ! Read input pft data + + read(nfdyn, '(A195,1x,I4)', iostat=ier) string, year + if (ier /= 0) exit + ! + ! If pft fraction override is set, than intrepret string as PFT and harvesting override values + ! + if ( any(pft_frc > 0.0_r8 ) )then + fname = ' ' + call mkpft_parse_oride(string) + call mkharvest_parse_oride(string) + write(6,*)'PFT and harvesting values are ',trim(string),' year is ',year + ! + ! Otherwise intrepret string as a filename with PFT and harvesting values in it + ! + else + fname = string + write(6,*)'input pft dynamic dataset is ',trim(fname),' year is ',year + end if + ntim = ntim + 1 + + ! Create pctpft data at model resolution + + call mkpft(ldomain, mapfname=map_fpft, fpft=fname, firrig=mksrf_firrig, & + ndiag=ndiag, pctlnd_o=pctlnd_pft_dyn, pctirr_o=pctirr, & + pctpft_o=pctpft ) + + ! Create harvesting data at model resolution + + call mkharvest( ldomain, mapfname=map_fharvest, datfname=fname, & + ndiag=ndiag, harv_o=harvest ) + + ! Consistency check on input land fraction + + do n = 1,ns_o + if (pctlnd_pft_dyn(n) /= pctlnd_pft(n)) then + write(6,*) subname,' error: pctlnd_pft for dynamics data = ',& + pctlnd_pft_dyn(n), ' not equal to pctlnd_pft for surface data = ',& + pctlnd_pft(n),' at n= ',n + if ( trim(fname) == ' ' )then + write(6,*) ' PFT string = ', string + else + write(6,*) ' PFT file = ', fname + end if + call abort() + end if + end do + + call change_landuse(ldomain, dynpft=.true.) + + call normalizencheck_landuse(ldomain) + + ! Output pctpft data for current year + + call check_ret(nf_inq_varid(ncid, 'PCT_PFT', varid), subname) + call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) + call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) + beg(1:ndims-1) = 1 + do n = 1,ndims-1 + call check_ret(nf_inq_dimlen(ncid, dimids(n), len(n)), subname) + end do + len(ndims) = 1 + beg(ndims) = ntim + call check_ret(nf_put_vara_double(ncid, varid, beg, len, pctpft), subname) + + do k = 1, mkharvest_numtypes() + call check_ret(nf_inq_varid(ncid, trim(mkharvest_fieldname(k)), varid), subname) + call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) + call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) + beg(1:ndims-1) = 1 + do n = 1,ndims-1 + call check_ret(nf_inq_dimlen(ncid, dimids(n), len(n)), subname) + end do + len(ndims) = 1 + beg(ndims) = ntim + call check_ret(nf_put_vara_double(ncid, varid, beg, len, harvest(:,k)), subname) + end do + + call check_ret(nf_inq_varid(ncid, 'YEAR', varid), subname) + call check_ret(nf_put_vara_int(ncid, varid, ntim, 1, year), subname) + + call check_ret(nf_inq_varid(ncid, 'time', varid), subname) + call check_ret(nf_put_vara_int(ncid, varid, ntim, 1, year), subname) + + call check_ret(nf_inq_varid(ncid, 'input_pftdata_filename', varid), subname) + call check_ret(nf_put_vara_text(ncid, varid, (/ 1, ntim /), (/ len_trim(string), 1 /), trim(string) ), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + end do ! end of read loop + + call check_ret(nf_close(ncid), subname) + + end if ! end of if-create dynamic landust dataset + + ! ---------------------------------------------------------------------- + ! Close diagnostic dataset + ! ---------------------------------------------------------------------- + + close (ndiag) + write (6,*) + write (6,*) 'Surface data output file = ',trim(fsurdat) + write (6,*) ' This file contains the land model surface data' + write (6,*) 'Diagnostic log file = ',trim(fsurlog) + write (6,*) ' See this file for a summary of the dataset' + write (6,*) + + write (6,*) 'Successfully created surface dataset' + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: change_landuse +! +! !INTERFACE: +subroutine change_landuse( ldomain, dynpft ) +! +! !DESCRIPTION: +! +! Do landuse changes such as for the poles, etc. +! +! !USES: + implicit none +! +! !ARGUMENTS: + type(domain_type) :: ldomain + logical, intent(in) :: dynpft ! if part of the dynpft section of code + +! +! !REVISION HISTORY: +! 9/10/09: Erik Kluzek spin off subroutine from original embedded code +! +!EOP +! +! !LOCAL VARIABLES: + logical :: first_time = .true. ! flag if this is the first pass through or not + integer ,parameter :: bdtroptree = 6 ! Index for broadleaf decidious tropical tree + integer ,parameter :: bdtemptree = 7 ! Index for broadleaf decidious temperate tree + integer ,parameter :: bdtempshrub = 10 ! Index for broadleaf decidious temperate shrub + real(r8),parameter :: troplat = 23.5_r8 ! Latitude to define as tropical + integer :: n,ns_o ! indices + character(len=32) :: subname = 'change_landuse' ! subroutine name +!----------------------------------------------------------------------- + + ns_o = ldomain%ns + do n = 1,ns_o + + ! Set pfts 7 and 10 to 6 in the tropics to avoid lais > 1000 + ! Using P. Thornton's method found in surfrdMod.F90 in clm3.5 + + if (abs(ldomain%latc(n))0._r8) then + pctpft(n,bdtroptree) = pctpft(n,bdtroptree) + pctpft(n,bdtemptree) + pctpft(n,bdtemptree) = 0._r8 + if ( first_time ) write (6,*) subname, ' Warning: all wgt of pft ', & + bdtemptree, ' now added to pft ', bdtroptree + end if + if (abs(ldomain%latc(n))0._r8) then + pctpft(n,bdtroptree) = pctpft(n,bdtroptree) + pctpft(n,bdtempshrub) + pctpft(n,bdtempshrub) = 0._r8 + if ( first_time ) write (6,*) subname, ' Warning: all wgt of pft ', & + bdtempshrub, ' now added to pft ', bdtroptree + end if + first_time = .false. + + ! If have pole points on grid - set south pole to glacier + ! north pole is assumed as non-land + + if (abs((ldomain%latc(n) - 90._r8)) < 1.e-6_r8) then + pctpft(n,:) = 0._r8 + pctlak(n) = 0._r8 + pctwet(n) = 0._r8 + pcturb(n) = 0._r8 + pctgla(n) = 100._r8 + if ( .not. dynpft )then + organic(n,:) = 0._r8 + ef1_btr(n) = 0._r8 + ef1_fet(n) = 0._r8 + ef1_fdt(n) = 0._r8 + ef1_shr(n) = 0._r8 + ef1_grs(n) = 0._r8 + ef1_crp(n) = 0._r8 + soicol(n) = 0 + if (mksrf_firrig /= ' ') pctirr(n) = 0._r8 + pctsand(n,:) = 0._r8 + pctclay(n,:) = 0._r8 + end if + end if + + end do + +end subroutine change_landuse + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: normalizencheck_landuse +! +! !INTERFACE: +subroutine normalizencheck_landuse(ldomain) +! +! !DESCRIPTION: +! +! Normalize land use and make sure things add up to 100% as well as +! checking that things are as they should be. +! +! !USES: + implicit none +! !ARGUMENTS: + type(domain_type) :: ldomain +! +! !REVISION HISTORY: +! 9/10/09: Erik Kluzek spin off subroutine from original embedded code +! +!EOP +! +! !LOCAL VARIABLES: + integer :: m,k,n,ns_o ! indices + integer :: nsmall ! number of small PFT values + real(r8) :: suma ! sum for error check + real(r8) :: bare_urb_diff ! difference between bare soil and urban % + real(r8) :: pcturb_excess ! excess urban % not accounted for by bare soil + real(r8) :: sumpft ! sum of non-baresoil pfts + real(r8) :: sum8, sum8a ! sum for error check + real(r4) :: sum4a ! sum for error check + real(r8), parameter :: toosmallPFT = 1.e-10_r8 ! tolerance for PFT's to ignore + character(len=32) :: subname = 'normalizencheck_landuse' ! subroutine name +!----------------------------------------------------------------------- + + ns_o = ldomain%ns + nsmall = 0 + do n = 1,ns_o + if (pcturb(n) .gt. 0._r8) then + + ! Replace bare soil preferentially with urban + suma = pctlak(n)+pctwet(n)+pctgla(n) + bare_urb_diff = 0.01_r8 * pctpft(n,0) * (100._r8 - suma) - pcturb(n) + pctpft(n,0) = max(0._r8,bare_urb_diff) + pcturb_excess = abs(min(0._r8,bare_urb_diff)) + + ! Normalize pctpft to be the remainder of [100 - (special landunits)] + ! including any urban not accounted for by bare soil above + sumpft = sum(pctpft(n,1:numpft)) + if (sumpft > 0._r8) then + suma = pctlak(n)+pctwet(n)+pctgla(n) + do m = 1, numpft + pctpft(n,m) = 0.01_r8 * pctpft(n,m) * (100._r8 - suma) - & + pcturb_excess*pctpft(n,m)/sumpft + if ( pctpft(n,m) < 0.0_r8 )then + write (6,*)'pctpft < 0.0 = ', pctpft(n,m), & + ' suma, pcturb_excess, sumpft = ', suma, pcturb_excess, sumpft + if ( abs(pctpft(n,m)) > epsilon(pctpft(n,m))*50.0_r8 )then + call abort() + end if + pctpft(n,m) = 0.0_r8 + end if + end do + end if + + else + + ! Normalize pctpft to be the remainder of [100 - (special landunits)] + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + do m = 0, numpft + pctpft(n,m) = 0.01_r8 * pctpft(n,m) * (100._r8 - suma) + end do + + end if + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + do m = 0,numpft + suma = suma + pctpft(n,m) + end do + + if (suma < 90._r8) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla and pctpft is less than 90' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctpft= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),pctpft(n,:) + call abort() + else if (suma > 100._r8 + 1.e-4_r8) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla and pctpft is greater than 100' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctpft,sum= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),pctpft(n,:),suma + call abort() + else + do m = 0, numpft + if ( pctpft(n,m) > 0.0_r8 .and. pctpft(n,m)*100.0_r8/suma < toosmallPFT )then + pctpft(n,m) = 0.0_r8 + nsmall = nsmall + 1 + end if + end do + if ( nsmall > 1 )then + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + do m = 0,numpft + suma = suma + pctpft(n,m) + end do + end if + if ( abs(suma - 100.0_r8) > 2.0*epsilon(suma) )then + pctlak(n) = pctlak(n) * 100._r8/suma + pctwet(n) = pctwet(n) * 100._r8/suma + pcturb(n) = pcturb(n) * 100._r8/suma + pctgla(n) = pctgla(n) * 100._r8/suma + pctpft(n,:) = pctpft(n,:) * 100._r8/suma + end if + end if + + ! Roundoff error fix + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if ( (suma < 100._r8 .and. suma > (100._r8 - 1.e-6_r8)) .or. & + (sum(pctpft(n,:)) > 0.0_r8 .and. sum(pctpft(n,:)) < 1.e-6_r8) ) then + write (6,*) 'Special land units near 100%, but not quite for n,suma =',n,suma + write (6,*) 'Adjusting special land units to 100%' + if (pctlak(n) >= 25._r8) then + pctlak(n) = 100._r8 - (pctwet(n) + pcturb(n) + pctgla(n)) + else if (pctwet(n) >= 25._r8) then + pctwet(n) = 100._r8 - (pctlak(n) + pcturb(n) + pctgla(n)) + else if (pcturb(n) >= 25._r8) then + pcturb(n) = 100._r8 - (pctlak(n) + pctwet(n) + pctgla(n)) + else if (pctgla(n) >= 25._r8) then + pctgla(n) = 100._r8 - (pctlak(n) + pctwet(n) + pcturb(n)) + else + write (6,*) subname, 'Error: sum of special land units nearly 100% but none is >= 25% at ', & + 'n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),pctpft(n,:),suma = ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),pctpft(n,:),suma + call abort() + end if + pctpft(n,:) = 0._r8 + end if + if ( any(pctpft(n,:) > 0.0_r8 .and. pctpft(n,:) < toosmallPFT ) )then + write (6,*) 'pctpft is small' + write (6,*) 'pctpft(',n,') = ', pctpft(n,:) + write (6,*) 'sum(pctpft) = ', sum(pctpft(n,:)) + call abort() + end if + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if (suma < 100._r8-epsilon(suma) .and. suma > (100._r8 - 4._r8*epsilon(suma))) then + write (6,*) subname, 'n,pctlak,pctwet,pcturb,pctgla,pctpft= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctpft(n,:) + call abort() + end if + do m = 0,numpft + suma = suma + pctpft(n,m) + end do + if ( abs(suma-100._r8) > 1.e-10_r8) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla and pctpft is NOT equal to 100' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctpft,sum= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctpft(n,:), sum8 + call abort() + end if + + end do + + ! Check that when pctpft identically zero, sum of special landunits is identically 100% + + if ( .not. outnc_double )then + do n = 1,ns_o + sum8 = real(pctlak(n),r4) + sum8 = sum8 + real(pctwet(n),r4) + sum8 = sum8 + real(pcturb(n),r4) + sum8 = sum8 + real(pctgla(n),r4) + sum4a = 0.0_r4 + do k = 0,numpft + sum4a = sum4a + real(pctpft(n,k),r4) + end do + if ( sum4a==0.0_r4 .and. sum8 < 100._r4-2._r4*epsilon(sum4a) )then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla is < 100% when pctpft==0 sum = ', sum8 + write (6,*)'n,pctlak,pctwet,pcturb,pctgla= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n), pctpft(n,:) + call abort() + end if + end do + else + do n = 1,ns_o + sum8 = pctlak(n) + sum8 = sum8 + pctwet(n) + sum8 = sum8 + pcturb(n) + sum8 = sum8 + pctgla(n) + sum8a = 0._r8 + do k = 0,numpft + sum8a = sum8a + pctpft(n,k) + end do + if ( sum8a==0._r8 .and. sum8 < (100._r8-4._r8*epsilon(sum8)) )then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla is < 100% when pctpft==0 sum = ', sum8 + write (6,*) 'Total error, error/epsilon = ',100._r8-sum8, ((100._r8-sum8)/epsilon(sum8)) + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctpft,epsilon= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n), pctpft(n,:), epsilon(sum8) + call abort() + end if + end do + end if + + do n = 1,ns_o + do k = 0,numpft + if ( pctpft(n,k) < 0.0_r8 )then + write (6,*)'pctpft < 0.0 = ', pctpft(n,k) + call abort() + end if + end do + if ( (sum(pctpft(n,:)) > 100._r8-4._r8*epsilon(sum8)) .and. & + (sum(pctpft(n,:)) < 0.5_r8) )then + write (6,*)'sum(pctpft) < 0.5 = ', sum(pctpft(n,:)) + call abort() + end if + end do + if ( nsmall > 1 )then + write (6,*)'number of small pft = ', nsmall + end if + +end subroutine normalizencheck_landuse + +end program mksurfdat diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparAvgMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparAvgMod.F90 new file mode 100644 index 0000000000..6cf2d78075 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparAvgMod.F90 @@ -0,0 +1,673 @@ +module mkurbanparAvgMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkurbanparAvg +! +! !DESCRIPTION: +! Make Urban Parameter data, using an average of input cells +! +! !REVISION HISTORY: +! Author: Keith Oleson, Mariana Vertenstein +! Feb 2012: Bill Sacks: pulled out some functionality to mkurbanparCommonMod +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkurban ! Get the urban percentage + public :: mkurbanpar ! Make the urban parameters + +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban +! +! !INTERFACE: +subroutine mkurban(ldomain, mapfname, datfname, ndiag, zero_out, urbn_o) +! +! !DESCRIPTION: +! make percent urban +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkurbanparCommonMod, only : mkurban_pct, mkurban_pct_diagnostics, MIN_DENS + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero urban out + real(r8) , intent(out):: urbn_o(:) ! output grid: %urban +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: urbn_i(:) ! input grid: percent urbn + integer :: no,ns ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + character(len=32) :: subname = 'mkurban' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %urban .....' + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain, datfname) + + ns = tdomain%ns + allocate(urbn_i(ns), stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open urban file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, urbn_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Compute local fields _o + + if ( all_urban .or. zero_out )then + + do no = 1, ldomain%ns + if (all_urban )then + urbn_o(no) = 100.00_r8 + else + urbn_o(no) = 0.00_r8 + end if + enddo + + else + + call gridmap_mapread(tgridmap, mapfname) + + call mkurban_pct(ldomain, tdomain, tgridmap, urbn_i, urbn_o) + + do no = 1, ldomain%ns + if (urbn_o(no) < MIN_DENS) then + urbn_o(no) = 0._r8 + end if + end do + + call mkurban_pct_diagnostics(ldomain, tdomain, tgridmap, urbn_i, urbn_o, ndiag) + + write (6,*) 'Successfully made %urban' + write (6,*) + + end if + + ! Deallocate dynamic memory + + ! call domain_clean(tdomain) + if ( .not. all_urban .and. .not. zero_out )then + call gridmap_clean(tgridmap) + end if + + deallocate (urbn_i) + +end subroutine mkurban + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurbanpar +! +! !INTERFACE: +subroutine mkurbanpar(ldomain, mapfname, datfname, ndiag, ncido) +! +! !DESCRIPTION: +! Make Urban Parameter data +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + integer , intent(in) :: ncido ! output netcdf file id +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(domain_type) :: tdomain_mask ! local domain that contains "mask" + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: canyon_hwr_o(:) ! canyon height to width ratio out + real(r8), allocatable :: canyon_hwr_i(:) ! canyon_height to width ratio in + real(r8), allocatable :: em_improad_o(:) ! emissivity of impervious road out + real(r8), allocatable :: em_improad_i(:) ! emissivity of impervious road in + real(r8), allocatable :: em_perroad_o(:) ! emissivity of pervious road out + real(r8), allocatable :: em_perroad_i(:) ! emissivity of pervious road in + real(r8), allocatable :: em_roof_o(:) ! emissivity of roof out + real(r8), allocatable :: em_roof_i(:) ! emissivity of roof in + real(r8), allocatable :: em_wall_o(:) ! emissivity of wall out + real(r8), allocatable :: em_wall_i(:) ! emissivity of wall in + real(r8), allocatable :: ht_roof_o(:) ! height of roof out + real(r8), allocatable :: ht_roof_i(:) ! height of roof in + real(r8), allocatable :: thick_roof_o(:) ! thickness of roof out + real(r8), allocatable :: thick_roof_i(:) ! thickness of roof in + real(r8), allocatable :: thick_wall_o(:) ! thickness of wall out + real(r8), allocatable :: thick_wall_i(:) ! thickness of wall in + real(r8), allocatable :: t_building_max_o(:) ! maximum interior building temperature out + real(r8), allocatable :: t_building_max_i(:) ! maximum interior building temperature in + real(r8), allocatable :: t_building_min_o(:) ! minimum interior building temperature out + real(r8), allocatable :: t_building_min_i(:) ! minimum interior building temperature in + real(r8), allocatable :: wind_hgt_canyon_o(:) ! height of wind in canyon out + real(r8), allocatable :: wind_hgt_canyon_i(:) ! height of wind in canyon in + real(r8), allocatable :: wtlunit_roof_o(:) ! fraction of roof out + real(r8), allocatable :: wtlunit_roof_i(:) ! fraction of roof in + real(r8), allocatable :: wtroad_perv_o(:) ! fraction of pervious road out + real(r8), allocatable :: wtroad_perv_i(:) ! fraction of pervious road in + real(r8), allocatable :: alb_improad_o(:,:,:) ! albedo of impervious road out (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_improad_i(:,:,:) ! albedo of impervious road in (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_perroad_o(:,:,:) ! albedo of pervious road out (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_perroad_i(:,:,:) ! albedo of pervious road in (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_roof_o(:,:,:) ! albedo of roof out (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_roof_i(:,:,:) ! albedo of roof in (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_wall_o(:,:,:) ! albedo of wall out (lon,lat,numrad,numsolar) + real(r8), allocatable :: alb_wall_i(:,:,:) ! albedo of wall in (lon,lat,numrad,numsolar) + real(r8), allocatable :: tk_roof_o(:,:) ! thermal conductivity of roof out (lon,lat,nlevurb) + real(r8), allocatable :: tk_roof_i(:,:) ! thermal conductivity of roof in (lon,lat,nlevurb) + real(r8), allocatable :: tk_wall_o(:,:) ! thermal conductivity of wall out (lon,lat,nlevurb) + real(r8), allocatable :: tk_wall_i(:,:) ! thermal conductivity of wall in (lon,lat,nlevurb) + real(r8), allocatable :: tk_improad_o(:,:) ! thermal conductivity of impervious road out (lon,lat,nlevurb) + real(r8), allocatable :: tk_improad_i(:,:) ! thermal conductivity of impervious road in (lon,lat,nlevurb) + real(r8), allocatable :: cv_roof_o(:,:) ! volumetric heat capacity of roof out (lon,lat,nlevurb) + real(r8), allocatable :: cv_roof_i(:,:) ! volumetric heat capacity of roof in (lon,lat,nlevurb) + real(r8), allocatable :: cv_wall_o(:,:) ! volumetric heat capacity of wall out (lon,lat,nlevurb) + real(r8), allocatable :: cv_wall_i(:,:) ! volumetric heat capacity of wall in (lon,lat,nlevurb) + real(r8), allocatable :: cv_improad_o(:,:) ! volumetric heat capacity of impervious road out (lon,lat,nlevurb) + real(r8), allocatable :: cv_improad_i(:,:) ! volumetric heat capacity of impervious road in (lon,lat,nlevurb) + integer, allocatable :: nlev_improad_o(:) ! number of impervious road layers out + real(r8), allocatable :: mask_i(:) ! input grid: mask (0, 1) + integer :: nlevurb_i ! input grid: number of urban vertical levels + integer :: numsolar_i ! input grid: number of solar type (DIR/DIF) + integer :: numrad_i ! input grid: number of solar bands (VIS/NIR) + integer :: ns_i,ns_o ! indices + integer :: k,l,n,m,ni,no ! indices + integer :: nsolar,nrad,nurb ! indices + integer :: ncidi,dimid,varid ! input netCDF id's + integer :: numlev ! number of valid impervious road layers + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 32) :: subname = 'mkurbanpar' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make Urban Parameters .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + !***NOTE - this determines the tdomain mask based on the "mask" + ! file variable NOT the LANDMASK file variable - and the "mask" + ! variable is a SUBSET of the LANDMASK variable - so we need + ! to call the interplation with the mask_src optional argument + + call domain_read(tdomain , datfname) + call domain_read(tdomain_mask, datfname, readmask=.true.) + + write (6,*) 'Open urban parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_dimid(ncidi, 'nlevurb', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, nlevurb_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numsolar', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numsolar_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numrad', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numrad_i), subname) + + if (nlevurb_i /= nlevurb) then + write(6,*)'MKURBANPAR: parameter nlevurb= ',nlevurb, & + 'does not equal input dataset nlevurb= ',nlevurb_i + stop + endif + if (numsolar_i /= numsolar) then + write(6,*)'MKURBANPAR: parameter numsolar= ',numsolar, & + 'does not equal input dataset numsolar= ',numsolar_i + stop + endif + if (numrad_i /= numrad) then + write(6,*)'MKURBANPAR: parameter numrad= ',numrad, & + 'does not equal input dataset numrad= ',numrad_i + stop + endif + + if (tdomain%ns /= tdomain_mask%ns) then + write(6,*)'MKURBANPAR: inconsistent sizes for tdomain and tdomain_mask' + write(6,*)' domain size tdomain = ',tdomain%ns + write(6,*)' domain size tdomain_mask= ',tdomain_mask%ns + stop + else + do n = 1,tdomain%ns + if (tdomain%mask(n) == 0 .and. tdomain_mask%mask(n) == 1) then + write(6,*)'tdomain_mask is not a submask tdomain at n= ',n + stop + end if + end do + end if + + ! Allocation + + ns_i = tdomain%ns + allocate(canyon_hwr_i(ns_i), & + em_improad_i(ns_i), & + em_perroad_i(ns_i), & + em_roof_i(ns_i), & + em_wall_i(ns_i), & + ht_roof_i(ns_i), & + thick_roof_i(ns_i), & + thick_wall_i(ns_i), & + t_building_max_i(ns_i), & + t_building_min_i(ns_i), & + wind_hgt_canyon_i(ns_i), & + wtlunit_roof_i(ns_i), & + wtroad_perv_i(ns_i), & + alb_improad_i(ns_i,numrad_i,numsolar_i), & + alb_perroad_i(ns_i,numrad_i,numsolar_i), & + alb_roof_i(ns_i,numrad_i,numsolar_i), & + alb_wall_i(ns_i,numrad_i,numsolar_i), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + ns_o = ldomain%ns + allocate(canyon_hwr_o(ns_o), & + em_improad_o(ns_o), & + em_perroad_o(ns_o), & + em_roof_o(ns_o), & + em_wall_o(ns_o), & + ht_roof_o(ns_o), & + thick_roof_o(ns_o), & + thick_wall_o(ns_o), & + t_building_max_o(ns_o), & + t_building_min_o(ns_o), & + wind_hgt_canyon_o(ns_o), & + wtlunit_roof_o(ns_o), & + wtroad_perv_o(ns_o), & + alb_improad_o(ns_o,numrad,numsolar), & + alb_perroad_o(ns_o,numrad,numsolar), & + alb_roof_o(ns_o,numrad,numsolar), & + alb_wall_o(ns_o,numrad,numsolar), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + ! Compute local fields _o + ! Area average and then deallocate input data + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine urban variables on output grid + + ! IMPORTANT - first create a mask for the mapping that is based on + ! tdomain_mask%mask rather than tdomain%mask + + allocate(mask_i(ns_i)) + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + if (tdomain_mask%mask(ni) .eq. 0.) then + mask_i(ni) = 0. + else + mask_i(ni) = 1. + end if + end do + + call check_ret(nf_inq_varid (ncidi, 'CANYON_HWR', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, canyon_hwr_i), subname) + call gridmap_areaave(tgridmap,canyon_hwr_i,canyon_hwr_o,mask_src=mask_i) + deallocate (canyon_hwr_i) + + call check_ret(nf_inq_varid (ncidi, 'EM_IMPROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, em_improad_i), subname) + call gridmap_areaave(tgridmap,em_improad_i,em_improad_o,mask_src=mask_i) + deallocate (em_improad_i) + + call check_ret(nf_inq_varid (ncidi, 'EM_PERROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, em_perroad_i), subname) + call gridmap_areaave(tgridmap,em_perroad_i,em_perroad_o,mask_src=mask_i) + deallocate (em_perroad_i) + + call check_ret(nf_inq_varid (ncidi, 'EM_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, em_roof_i), subname) + call gridmap_areaave(tgridmap,em_roof_i,em_roof_o,mask_src=mask_i) + deallocate (em_roof_i) + + call check_ret(nf_inq_varid (ncidi, 'EM_WALL', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, em_wall_i), subname) + call gridmap_areaave(tgridmap,em_wall_i,em_wall_o,mask_src=mask_i) + deallocate (em_wall_i) + + call check_ret(nf_inq_varid (ncidi, 'HT_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, ht_roof_i), subname) + call gridmap_areaave(tgridmap,ht_roof_i,ht_roof_o,mask_src=mask_i) + deallocate (ht_roof_i) + + call check_ret(nf_inq_varid (ncidi, 'THICK_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, thick_roof_i), subname) + call gridmap_areaave(tgridmap,thick_roof_i,thick_roof_o,mask_src=mask_i) + deallocate (thick_roof_i) + + call check_ret(nf_inq_varid (ncidi, 'THICK_WALL', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, thick_wall_i), subname) + call gridmap_areaave(tgridmap,thick_wall_i,thick_wall_o,mask_src=mask_i) + deallocate (thick_wall_i) + + call check_ret(nf_inq_varid (ncidi, 'T_BUILDING_MAX', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, t_building_max_i), subname) + call gridmap_areaave(tgridmap,t_building_max_i,t_building_max_o,mask_src=mask_i) + deallocate (t_building_max_i) + + call check_ret(nf_inq_varid (ncidi, 'T_BUILDING_MIN', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, t_building_min_i), subname) + call gridmap_areaave(tgridmap,t_building_min_i,t_building_min_o,mask_src=mask_i) + deallocate (t_building_min_i) + + call check_ret(nf_inq_varid (ncidi, 'WIND_HGT_CANYON', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, wind_hgt_canyon_i), subname) + call gridmap_areaave(tgridmap,wind_hgt_canyon_i,wind_hgt_canyon_o,mask_src=mask_i) + deallocate (wind_hgt_canyon_i) + + call check_ret(nf_inq_varid (ncidi, 'WTLUNIT_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, wtlunit_roof_i), subname) + call gridmap_areaave(tgridmap,wtlunit_roof_i,wtlunit_roof_o,mask_src=mask_i) + deallocate (wtlunit_roof_i) + + call check_ret(nf_inq_varid (ncidi, 'WTROAD_PERV', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, wtroad_perv_i), subname) + call gridmap_areaave(tgridmap,wtroad_perv_i,wtroad_perv_o,mask_src=mask_i) + deallocate (wtroad_perv_i) + + do n = 1,numrad_i + do m = 1,numsolar_i + call check_ret(nf_inq_varid (ncidi, 'ALB_IMPROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, alb_improad_i), subname) + call gridmap_areaave(tgridmap, alb_improad_i(:,n,m), alb_improad_o(:,n,m),& + mask_src=mask_i) + + call check_ret(nf_inq_varid (ncidi, 'ALB_PERROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, alb_perroad_i), subname) + call gridmap_areaave(tgridmap,alb_perroad_i(:,n,m),alb_perroad_o(:,n,m),& + mask_src=mask_i) + + call check_ret(nf_inq_varid (ncidi, 'ALB_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, alb_roof_i), subname) + call gridmap_areaave(tgridmap,alb_roof_i(:,n,m),alb_roof_o(:,n,m),& + mask_src=mask_i) + + call check_ret(nf_inq_varid (ncidi, 'ALB_WALL', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, alb_wall_i), subname) + call gridmap_areaave(tgridmap,alb_wall_i(:,n,m),alb_wall_o(:,n,m),& + mask_src=mask_i) + end do + end do + deallocate (alb_improad_i) + deallocate (alb_perroad_i) + deallocate (alb_roof_i) + deallocate (alb_wall_i) + + ! Now write output data to the file and then deallocate + call check_ret(nf_inq_varid(ncido, 'CANYON_HWR', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, canyon_hwr_o),subname) + deallocate (canyon_hwr_o) + + call check_ret(nf_inq_varid(ncido, 'EM_IMPROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, em_improad_o), subname) + deallocate (em_improad_o) + + call check_ret(nf_inq_varid(ncido, 'EM_PERROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, em_perroad_o), subname) + deallocate (em_perroad_o) + + call check_ret(nf_inq_varid(ncido, 'EM_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, em_roof_o), subname) + deallocate (em_roof_o) + + call check_ret(nf_inq_varid(ncido, 'EM_WALL', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, em_wall_o), subname) + deallocate (em_wall_o) + + call check_ret(nf_inq_varid(ncido, 'HT_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, ht_roof_o), subname) + deallocate (ht_roof_o) + + call check_ret(nf_inq_varid(ncido, 'THICK_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, thick_roof_o), subname) + deallocate (thick_roof_o) + + call check_ret(nf_inq_varid(ncido, 'THICK_WALL', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, thick_wall_o), subname) + deallocate (thick_wall_o) + + call check_ret(nf_inq_varid(ncido, 'T_BUILDING_MAX', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, t_building_max_o), subname) + deallocate (t_building_max_o) + + call check_ret(nf_inq_varid(ncido, 'T_BUILDING_MIN', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, t_building_min_o), subname) + deallocate (t_building_min_o) + + call check_ret(nf_inq_varid(ncido, 'WIND_HGT_CANYON', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, wind_hgt_canyon_o), subname) + deallocate (wind_hgt_canyon_o) + + call check_ret(nf_inq_varid(ncido, 'WTLUNIT_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, wtlunit_roof_o), subname) + deallocate (wtlunit_roof_o) + + call check_ret(nf_inq_varid(ncido, 'WTROAD_PERV', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, wtroad_perv_o), subname) + deallocate (wtroad_perv_o) + + call check_ret(nf_inq_varid(ncido, 'ALB_IMPROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, alb_improad_o), subname) + deallocate (alb_improad_o) + + call check_ret(nf_inq_varid(ncido, 'ALB_PERROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, alb_perroad_o), subname) + deallocate (alb_perroad_o) + + call check_ret(nf_inq_varid(ncido, 'ALB_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, alb_roof_o), subname) + deallocate (alb_roof_o) + + call check_ret(nf_inq_varid(ncido, 'ALB_WALL', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, alb_wall_o), subname) + deallocate (alb_wall_o) + ! + ! 3D nlevurb fields + ! + ! First allocate data + allocate(cv_improad_i(ns_i,nlevurb), & + tk_roof_i(ns_i,nlevurb), & + tk_wall_i(ns_i,nlevurb), & + tk_improad_i(ns_i,nlevurb), & + cv_roof_i(ns_i,nlevurb), & + cv_wall_i(ns_i,nlevurb), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + allocate(tk_roof_o(ns_o,nlevurb), & + tk_wall_o(ns_o,nlevurb), & + tk_improad_o(ns_o,nlevurb), & + cv_roof_o(ns_o,nlevurb), & + cv_wall_o(ns_o,nlevurb), & + cv_improad_o(ns_o,nlevurb), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + ! Do the areaaveraging and then deallocate input data + + call check_ret(nf_inq_varid (ncidi, 'TK_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, tk_roof_i), subname) + call check_ret(nf_inq_varid (ncidi, 'TK_WALL', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, tk_wall_i), subname) + call check_ret(nf_inq_varid (ncidi, 'CV_ROOF', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, cv_roof_i), subname) + call check_ret(nf_inq_varid (ncidi, 'CV_WALL', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, cv_wall_i), subname) + + do n = 1,nlevurb + call gridmap_areaave(tgridmap,tk_roof_i(:,n),tk_roof_o(:,n),& + mask_src=mask_i) + call gridmap_areaave(tgridmap,tk_wall_i(:,n),tk_wall_o(:,n),& + mask_src=mask_i) + call gridmap_areaave(tgridmap,cv_roof_i(:,n),cv_roof_o(:,n),& + mask_src=mask_i) + call gridmap_areaave(tgridmap,cv_wall_i(:,n),cv_wall_o(:,n),& + mask_src=mask_i) + end do + + deallocate (tk_roof_i) + deallocate (tk_wall_i) + deallocate (cv_roof_i) + deallocate (cv_wall_i) + deallocate (mask_i) + + ! Write output data then deallocate output data + call check_ret(nf_inq_varid(ncido, 'TK_WALL', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, tk_wall_o), subname) + deallocate (tk_wall_o) + + call check_ret(nf_inq_varid(ncido, 'TK_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, tk_roof_o), subname) + deallocate (tk_roof_o) + + call check_ret(nf_inq_varid(ncido, 'CV_WALL', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, cv_wall_o), subname) + deallocate (cv_wall_o) + + call check_ret(nf_inq_varid(ncido, 'CV_ROOF', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, cv_roof_o), subname) + deallocate (cv_roof_o) + + ! Get fields from input file + call check_ret(nf_inq_varid (ncidi, 'CV_IMPROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, cv_improad_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'TK_IMPROAD', varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, tk_improad_i), subname) + + ! Impervious road thermal conductivity and heat capacity need to be + ! handled differently because of varying levels of data. + + allocate(mask_i(ns_i)) + do nurb = 1,nlevurb + ! Create mask for input data from missing values + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + if (tk_improad_i(ni,nurb) .eq. -999.) then + mask_i(ni) = 0. + else + mask_i(ni) = 1. + end if + end do + call gridmap_areaave(tgridmap, tk_improad_i(:,nurb), tk_improad_o(:,nurb), & + mask_src=mask_i) + call gridmap_areaave(tgridmap, cv_improad_i(:,nurb), cv_improad_o(:,nurb), & + mask_src=mask_i) + end do + deallocate(cv_improad_i) + deallocate(tk_improad_i) + deallocate(mask_i) + + call check_ret(nf_inq_varid(ncido, 'TK_IMPROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, tk_improad_o), subname) + + call check_ret(nf_inq_varid(ncido, 'CV_IMPROAD', varid), subname) + call check_ret(nf_put_var_double(ncido, varid, cv_improad_o), subname) + + allocate(nlev_improad_o(ns_o), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + nlev_improad_o(:) = 0 + do no = 1,ns_o + numlev = 0 + do nurb = 1,nlevurb + if (tk_improad_o(no,nurb) > 0. .and. cv_improad_o(no,nurb) > 0.) then + numlev = numlev+1 + end if + end do + nlev_improad_o(no) = numlev + end do + + call check_ret(nf_inq_varid(ncido, 'NLEV_IMPROAD', varid), subname) + call check_ret(nf_put_var_int(ncido, varid, nlev_improad_o), subname) + + call check_ret(nf_sync(ncido), subname) + call check_ret(nf_close(ncidi), subname) + + ! Deallocate dynamic memory + + deallocate (tk_improad_o) + deallocate (cv_improad_o) + deallocate (nlev_improad_o) + call domain_clean(tdomain) + call domain_clean(tdomain_mask) + call gridmap_clean(tgridmap) + + write (6,*) 'Successfully made Urban Parameters' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkurbanpar + +!----------------------------------------------------------------------- + +end module mkurbanparAvgMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparCommonMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparCommonMod.F90 new file mode 100644 index 0000000000..fce1cab694 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparCommonMod.F90 @@ -0,0 +1,401 @@ +module mkurbanparCommonMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkurbanparCommon +! +! !DESCRIPTION: +! Common routines for making urban parameter data, shared by mkurbanparAvgMod, +! mkurbanparDomMod, etc. +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: get_urban_format ! Determine the format of the urban input file + public :: mkurban_pct ! Make output urban %, given input urban % + public :: mkurban_pct_diagnostics ! print diagnostics related to pct urban + public :: mkelev ! Get elevation to reduce urban for high elevation areas +! +! !PUBLIC DATA MEMBERS: +! + ! constants identifying urban input data format + integer , parameter :: URBAN_FORMAT_AVG = 1, & ! format used with averaging + URBAN_FORMAT_DOM = 2 ! format used with dominant type approach + + real(r8), parameter :: MIN_DENS = 0.1_r8 ! minimum urban density (% of grid cell) - below this value, urban % is set to 0 + + public :: URBAN_FORMAT_AVG, URBAN_FORMAT_DOM + public :: MIN_DENS +! +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: get_urban_format +! +! !INTERFACE: +subroutine get_urban_format(datfname, urban_format) +! +! !DESCRIPTION: +! determine the format of the urban input file +! +! !USES: + use mkncdio +! +! !ARGUMENTS: + implicit none + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(out):: urban_format ! code for format of data file +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ncid, dimid ! input netCDF id's + integer :: ier ! error code + + character(len=*), parameter :: subname = 'get_urban_format' +!----------------------------------------------------------------------- + + call check_ret(nf_open(datfname, 0, ncid), subname) + ier = nf_inq_dimid(ncid, 'density_class', dimid) + if (ier == NF_NOERR) then + ! density_class dimension was found on the file + write(6,*) 'Urban file appears to be dominant-type format' + urban_format = URBAN_FORMAT_DOM + else + write(6,*) 'Urban file appears to be area-average format' + urban_format = URBAN_FORMAT_AVG + end if + + call check_ret(nf_close(ncid), subname) + +end subroutine get_urban_format +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban_pct +! +! !INTERFACE: +subroutine mkurban_pct(ldomain, tdomain, tgridmap, urbn_i, urbn_o) +! +! !DESCRIPTION: +! make percent urban on output grid, given percent urban on input grid +! +! This assumes that we're neither using all_urban or zero_out +! +! +! !USES: + use mkdomainMod , only : domain_type, domain_checksame + use mkgridmapMod + use mkvarctl , only : mksrf_gridtype +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + type(domain_type) , intent(in) :: tdomain ! local domain + type(gridmap_type), intent(in) :: tgridmap ! local gridmap + real(r8) , intent(in) :: urbn_i(:) ! input grid: percent urban + real(r8) , intent(out):: urbn_o(:) ! output grid: percent urban +! +! !REVISION HISTORY: +! Author: Bill Sacks +! (Moved from mkurbanparMod Feb, 2012) +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + integer :: ni,no ! indices + real(r8) :: relerr = 0.00001_r8 ! max error: sum overlap wts ne 1 + character(len=*), parameter :: subname = 'mkurban_pct' +!----------------------------------------------------------------------- + + ! Error checks for array size consistencies + + if (size(urbn_i) /= tdomain%ns .or. & + size(urbn_o) /= ldomain%ns) then + write(6,*) subname//' ERROR: array size inconsistencies' + write(6,*) 'size(urbn_i) = ', size(urbn_i) + write(6,*) 'tdomain%ns = ', tdomain%ns + write(6,*) 'size(urbn_o) = ', size(urbn_o) + write(6,*) 'ldomain%ns = ', ldomain%ns + stop + end if + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine urbn_o on ouput grid: + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_areaave(tgridmap, urbn_i, urbn_o) + + ! Check for conservation + + do no = 1, ldomain%ns + if ((urbn_o(no)) > 100.000001_r8) then + write (6,*) 'MKURBAN error: urban = ',urbn_o(no), & + ' greater than 100.000001 for column, row = ',no + stop + end if + enddo + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,tdomain%ns + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0._r8 + do no = 1, ldomain%ns + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if (trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1._r8) > relerr ) then + write (6,*) 'MKURBAN error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! (Error check2 in mkurban_pct_diagnostics, which should be called separately) + +end subroutine mkurban_pct +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban_pct_diagnostics +! +! !INTERFACE: +subroutine mkurban_pct_diagnostics(ldomain, tdomain, tgridmap, urbn_i, urbn_o, ndiag, dens_class) +! +! !DESCRIPTION: +! print diagnostics related to pct urban +! +! This is intended to be called after mkurban_pct, but is split out into a separate +! routine so that modifications to urbn_o can be made in between the two calls (e.g., +! setting urbn_o to 0 wherever it is less than a certain threshold; the rules for doing +! this can't always be applied inline in mkurban_pct). +! +! !USES: + use mkdomainMod , only : domain_type + use mkgridmapMod, only : gridmap_type + use mkvarpar +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + type(domain_type) , intent(in) :: tdomain ! local domain + type(gridmap_type), intent(in) :: tgridmap ! local gridmap + real(r8) , intent(in) :: urbn_i(:) ! input grid: percent urban + real(r8) , intent(in) :: urbn_o(:) ! output grid: percent urban + integer , intent(in) :: ndiag ! unit number for diag out + + integer , intent(in), optional :: dens_class ! density class +! +! !REVISION HISTORY: +! Author: Bill Sacks +! (Moved from mkurbanparMod Feb, 2012) +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: gurbn_i ! input grid: global urbn + real(r8) :: garea_i ! input grid: global area + real(r8) :: gurbn_o ! output grid: global urbn + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k ! indices +!----------------------------------------------------------------------- + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gurbn_i = 0._r8 + garea_i = 0._r8 + + do ni = 1, tdomain%ns + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gurbn_i = gurbn_i + urbn_i(ni)*(tgridmap%area_src(ni)/100._r8)*& + tgridmap%frac_src(ni)*re**2 + end do + + ! Output grid + + gurbn_o = 0._r8 + garea_o = 0._r8 + + do no = 1, ldomain%ns + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gurbn_o = gurbn_o + urbn_o(no)* (tgridmap%area_dst(no)/100._r8)*& + tgridmap%frac_dst(no)*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + if (present(dens_class)) then + write (ndiag,'(1x,a,i0)') 'Urban Output -- class ', dens_class + else + write (ndiag,'(1x,a)') 'Urban Output' + end if + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) gurbn_i*1.e-06,gurbn_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'urban ',f14.3,f17.3) +2003 format (1x,'urban ',f14.3,f22.8) +2004 format (1x,'all surface ',f14.3,f17.3) + +end subroutine mkurban_pct_diagnostics +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkelev +! +! !INTERFACE: +subroutine mkelev(ldomain, mapfname, datfname, varname, ndiag, elev_o) +! +! !DESCRIPTION: +! Make elevation data +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read, domain_checksame + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + character(len=*) , intent(in) :: varname ! topo variable name + real(r8) , intent(out):: elev_o(:) ! output elevation data +! +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Keith Oleson +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + + real(r8), allocatable :: elev_i(:) ! canyon_height to width ratio in + real(r8), allocatable :: mask_i(:) ! input grid: mask (0, 1) + integer :: ns_i,ns_o ! indices + integer :: k,l,n,m,ni ! indices + integer :: ncidi,dimid,varid ! input netCDF id's + integer :: ier ! error status + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 32) :: subname = 'mkelev' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make elevation .....' + call shr_sys_flush(6) + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + + ns_i = tdomain%ns + allocate(elev_i(ns_i), stat=ier) + if (ier /= 0) then + write(6,*)'mkelev allocation error'; call abort() + end if + + write (6,*) 'Open elevation file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_varid (ncidi, trim(varname), varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, elev_i), subname) + call check_ret(nf_close(ncidi), subname) + + ! Read topo elev dataset with unit mask everywhere + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + ! Note that the topo dataset has no landmask - so a unit landmask is assumed + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine elev_o on output grid + + elev_o(:) = 0. + + call gridmap_areaave(tgridmap, elev_i, elev_o) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (elev_i) + + write (6,*) 'Successfully made elevation' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkelev + +!----------------------------------------------------------------------- + +end module mkurbanparCommonMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparDomMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparDomMod.F90 new file mode 100644 index 0000000000..146392d5cb --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkurbanparDomMod.F90 @@ -0,0 +1,640 @@ +module mkurbanparDomMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkurbanparDom +! +! !DESCRIPTION: +! Make Urban Parameter data, using a dominant type approach +! +! This approach involves determining the dominant urban density class and region for each +! output grid cell, then using these indices along with lookup tables to essentially +! paint-by-number the output urban parameter fields. +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkurban + public :: mkurbanpar + + ! The following could be private, but because there are associated test routines in a + ! separate module, they need to be public + public :: mkurban_dominant_density + +! !PRIVATE DATA MEMBERS: + ! flag to indicate nodata for index variables in output file: + integer, parameter :: index_nodata = 0 + character(len=*), parameter :: modname = 'mkurbanparDomMod' + + private :: index_nodata + private :: modname +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban +! +! !INTERFACE: +subroutine mkurban(ldomain, mapfname, datfname, ndiag, zero_out, urbn_o, dens_o, region_o) +! +! !DESCRIPTION: +! make percent urban, density class and region ID on the output grid +! +! Note: in contrast to mkurban in mkurbanparAvgMod, this routine does NOT handle all_urban +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkindexmapMod, only : get_dominant_indices + use mkurbanparCommonMod, only : mkurban_pct, mkurban_pct_diagnostics, MIN_DENS + use mkvarctl , only : all_urban + use mkvarpar + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero urban out + real(r8) , intent(out):: urbn_o(:) ! output grid: %urban + integer , intent(out):: dens_o(:) ! output grid: urban density class + integer , intent(out):: region_o(:) ! output grid: region ID +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: urbn_by_dens_i(:,:)! input grid: percent urban in each density class, at each point + real(r8), allocatable :: urbn_by_dens_o(:,:)! output grid: percent urban in each density class, at each point + integer , allocatable :: region_i(:) ! input grid: region ID + real(r8), allocatable :: gad_i(:) ! input grid: global area of each density class + real(r8), allocatable :: gad_o(:) ! output grid: global area of each density class + real(r8), allocatable :: gar_i(:) ! input grid: global area of each urban region ID + real(r8), allocatable :: gar_o(:) ! output grid: global area of each urban region ID + real(r8) :: sum_i, sum_o ! sums of global areas on input & output grids + integer :: ni,no,ns,k ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: dimlen ! netCDF dimension length + integer :: max_dens ! maximum density index + integer :: max_region ! maximum region index + integer :: ier ! error status + + character(len=32) :: subname = 'mkurban' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %urban and dominant density .....' + + ! Obtain input grid info, read local fields + + call gridmap_mapread(tgridmap, mapfname) + call domain_read(tdomain, datfname) + + ns = tdomain%ns + + write (6,*) 'Open urban file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_dimid (ncid, 'density_class', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, max_dens), subname) + + allocate(urbn_by_dens_i(ns, 1:max_dens), & + urbn_by_dens_o(ldomain%ns, 1:max_dens), & + stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, urbn_by_dens_i), subname) + + + ! Determine % urban by density class on the output grid + ! Note: in some cases (e.g., zero_out=.true., or a grid cell has < MIN_DENS urban %), + ! urbn_by_dens_o will be reset to 0 in some / all places. However, we still need the + ! values of urbn_by_dens_o before it is zeroed, in order to compute the dominant + ! density class in each grid cell + + do k = 1, max_dens + ! make % urban for each density class on the output grid + call mkurban_pct(ldomain, tdomain, tgridmap, urbn_by_dens_i(:,k), urbn_by_dens_o(:,k)) + end do + + + ! Determine dominant urban density class and total % urban + + call mkurban_dominant_density(urbn_by_dens_o, index_nodata, dens_o, urbn_o) + + + ! Handle special cases and too-small urban density: + + if (all_urban) then + write(6,*) modname//':'//subname//' ERROR: all_urban not handled here' + call abort() + else if (zero_out) then + urbn_o(:) = 0._r8 + urbn_by_dens_o(:,:) = 0._r8 + else + do no = 1, ldomain%ns + if (urbn_o(no) < MIN_DENS) then + urbn_o(no) = 0._r8 + urbn_by_dens_o(no,:) = 0._r8 + end if + end do + end if + + ! Print diagnostics + + do k = 1, max_dens + call mkurban_pct_diagnostics(ldomain, tdomain, tgridmap, & + urbn_by_dens_i(:,k), urbn_by_dens_o(:,k), & + ndiag, dens_class=k) + end do + + write (6,*) 'Successfully made %urban and dominant density' + + + write(6,*) 'Attempting to make urban region .....' + + ! Read in region field + ! Note: we do this here, rather than with the rest of the reads above, because we + ! expect the input urban fields to be large, so we're just reading the fields as + ! they're needed to try to avoid unnecessary memory paging + + allocate(region_i(ns), stat=ier) + if (ier/=0) call abort() + call check_ret(nf_inq_varid (ncid, 'REGION_ID', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, region_i), subname) + + ! Determine max region value, and make sure it doesn't exceed bounds of the lookup tables. + ! + ! (Note: this check assumes that region_i=1 refers to region(1), region_i=2 refers to + ! region(2), etc. The alternative would be to use a coordinate variable associated with + ! the region dimension of the lookup table, which could result in an arbitrary mapping + ! between region values and the indices of the lookup table; however, this use of + ! coordinate variables currently isn't supported by lookup_2d_netcdf [as of 2-8-12].) + + max_region = maxval(region_i) + call check_ret(nf_inq_dimid (ncid, 'region', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, dimlen), subname) + if (max_region > dimlen) then + write(6,*) modname//':'//subname// & + ' ERROR: max region value exceeds length of region dimension' + write(6,*) 'max region value : ', max_region + write(6,*) 'length of region dimension: ', dimlen + call abort() + end if + + ! Determine dominant region for each output cell + + call get_dominant_indices(tgridmap, region_i, region_o, 1, max_region, index_nodata) + + write (6,*) 'Successfully made urban region' + write (6,*) + + ! ----------------------------------------------------------------- + ! Error check + ! Compare relative areas of each density class & region ID on input and output grids + ! ----------------------------------------------------------------- + + allocate(gad_i(1:max_dens), gad_o(1:max_dens), & + gar_i(1:max_region), gar_o(1:max_region), & + stat=ier) + if (ier/=0) call abort() + + gad_i(:) = 0. + gar_i(:) = 0. + do k = 1, max_dens + do ni = 1,tdomain%ns + gad_i(k) = gad_i(k) + (urbn_by_dens_i(ni,k)/100._r8)*tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + end do + do ni = 1,tdomain%ns + k = region_i(ni) + if (k >= 1 .and. k <= max_region) then + gar_i(k) = gar_i(k) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end if + end do + + gad_o(:) = 0. + gar_o(:) = 0. + do no = 1,ldomain%ns + k = dens_o(no) + if (k >= 1 .and. k <= max_dens) then + gad_o(k) = gad_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end if + k = region_o(no) + if (k >= 1 .and. k <= max_region) then + gar_o(k) = gar_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end if + end do + + ! relative area comparison + ! Note: we compare relative areas rather than absolute areas because we expect big + ! differences in the absolute areas between input & output. + ! Also note that the relative areas are as a proportion of the area with valid urban data + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Urban Density Class Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'density class input grid area output grid area',/ & + 1x,' percent percent') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + sum_i = sum(gad_i) + sum_o = sum(gad_o) + do k = 1, max_dens + write (ndiag,1002) k,gad_i(k)/sum_i*100,gad_o(k)/sum_o*100 +1002 format (1x,i13,f15.3,'%',f16.3,'%') + end do + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Urban Region ID Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1003) +1003 format (1x,'region ID input grid area output grid area',/ & + 1x,' percent percent') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + sum_i = sum(gar_i) + sum_o = sum(gar_o) + do k = 1, max_region + write (ndiag,1004) k,gar_i(k)/sum_i*100,gar_o(k)/sum_o*100 +1004 format (1x,i9,f15.3,'%',f16.3,'%') + end do + + + ! Deallocate dynamic memory & other clean up + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (urbn_by_dens_i, urbn_by_dens_o, region_i) + deallocate(gad_i, gad_o, gar_i, gar_o) + +end subroutine mkurban +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurbanpar +! +! !INTERFACE: +subroutine mkurbanpar(datfname, ncido, dens_o, region_o) +! +! !DESCRIPTION: +! Make Urban Parameter data +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkindexmapMod, only : dim_slice_type, lookup_2d_netcdf + use mkvarpar + use mkncdio +! +! !ARGUMENTS: + implicit none + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ncido ! output netcdf file id + integer , intent(in) :: dens_o(:) ! output grid: urban density class + integer , intent(in) :: region_o(:) ! output grid: region ID +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type param + character(len=nf_max_name) :: name ! name in input & output files + logical :: invalid_okay ! are NA values allowed in the input table? + end type param + + real(r8), allocatable :: data_scalar_o(:) ! output array for parameters with no extra dimensions + real(r8), allocatable :: data_rad_o(:,:,:) ! output array for parameters dimensioned by numrad & numsolar + real(r8), allocatable :: data_levurb_o(:,:) ! output array for parameters dimensioned by nlevurb + integer :: nlevurb_i ! input grid: number of urban vertical levels + integer :: numsolar_i ! input grid: number of solar type (DIR/DIF) + integer :: numrad_i ! input grid: number of solar bands (VIS/NIR) + integer :: m,n,no,ns_o,p ! indices + integer :: ncidi,dimid,varid ! netCDF id's + integer :: ier ! error status + + ! information on extra dimensions for lookup tables greater than 2-d: + type(dim_slice_type), allocatable :: extra_dims(:) + + ! To add a new urban parameter, simply add an element to one of the below lists + ! (params_scalar, params_rad or params_levurb) + + ! Urban parameters with no extra dimensions + type(param), parameter :: params_scalar(14) = & + (/ param('CANYON_HWR', .false.), & + param('EM_IMPROAD', .false.), & + param('EM_PERROAD', .false.), & + param('EM_ROOF', .false.), & + param('EM_WALL', .false.), & + param('HT_ROOF', .false.), & + param('THICK_ROOF', .false.), & + param('THICK_WALL', .false.), & + param('T_BUILDING_MAX', .false.), & + param('T_BUILDING_MIN', .false.), & + param('WIND_HGT_CANYON', .false.), & + param('WTLUNIT_ROOF', .false.), & + param('WTROAD_PERV', .false.), & + + ! Note that NLEV_IMPROAD is written as an integer, meaning that type conversion occurs + ! by truncation. Thus we expect the values in the NLEV_IMPROAD lookup table to be exact; + ! e.g., if a value were 1.99999 rather than 2.0000, it would be written as 1 instead of 2 + param('NLEV_IMPROAD', .false.) /) + + ! Urban parameters dimensioned by numrad & numsolar + type(param), parameter :: params_rad(4) = & + (/ param('ALB_IMPROAD', .false.), & + param('ALB_PERROAD', .false.), & + param('ALB_ROOF', .false.), & + param('ALB_WALL', .false.) /) + + ! Urban parameters dimensioned by nlevurb + type(param), parameter :: params_levurb(6) = & + (/ param('TK_ROOF', .false.), & + param('TK_WALL', .false.), & + param('CV_ROOF', .false.), & + param('CV_WALL', .false.), & + + ! Impervious road thermal conductivity and heat capacity have varying levels of + ! data. Thus, we expect to find some missing values in the lookup table -- we + ! do not want to treat that as an error -- thus, we set invalid_okay=.true. + param('CV_IMPROAD', .true.), & + param('TK_IMPROAD', .true.) /) + + + character(len= 32) :: subname = 'mkurbanpar' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make Urban Parameters .....' + call shr_sys_flush(6) + + ! Determine & error-check array sizes + ns_o = size(dens_o) + if (ns_o /= size(region_o)) then + write(6,*) modname//':'//subname//' ERROR: array size mismatch' + write(6,*) 'size(dens_o) = ', size(dens_o) + write(6,*) 'size(region_o) = ', size(region_o) + call abort() + end if + + ! Read dimensions from input file + + write (6,*) 'Open urban parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_dimid(ncidi, 'nlevurb', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, nlevurb_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numsolar', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numsolar_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numrad', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numrad_i), subname) + + if (nlevurb_i /= nlevurb) then + write(6,*)'MKURBANPAR: parameter nlevurb= ',nlevurb, & + 'does not equal input dataset nlevurb= ',nlevurb_i + stop + endif + if (numsolar_i /= numsolar) then + write(6,*)'MKURBANPAR: parameter numsolar= ',numsolar, & + 'does not equal input dataset numsolar= ',numsolar_i + stop + endif + if (numrad_i /= numrad) then + write(6,*)'MKURBANPAR: parameter numrad= ',numrad, & + 'does not equal input dataset numrad= ',numrad_i + stop + endif + + ! Handle urban parameters with no extra dimensions + + allocate(data_scalar_o(ns_o), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + do p = 1, size(params_scalar) + call lookup_and_check_err(params_scalar(p)%name, data_scalar_o, 0, & + invalid_okay=params_scalar(p)%invalid_okay) + + call check_ret(nf_inq_varid(ncido, params_scalar(p)%name, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_scalar_o), subname) + end do + + deallocate(data_scalar_o) + + ! Handle urban parameters dimensioned by numrad & numsolar + + allocate(data_rad_o(ns_o, numrad, numsolar), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + allocate(extra_dims(2)) + extra_dims(1)%name = 'numrad' + extra_dims(2)%name = 'numsolar' + + do p = 1, size(params_rad) + do m = 1,numsolar_i + extra_dims(2)%val = m + do n = 1,numrad_i + extra_dims(1)%val = n + + call lookup_and_check_err(params_rad(p)%name, data_rad_o(:,n,m), 2, extra_dims, & + invalid_okay=params_rad(p)%invalid_okay) + end do + end do + + call check_ret(nf_inq_varid(ncido, params_rad(p)%name, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_rad_o), subname) + end do + + deallocate(data_rad_o) + deallocate(extra_dims) + + ! Handle urban parameters dimensioned by nlevurb + + allocate(data_levurb_o(ns_o, nlevurb), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + allocate(extra_dims(1)) + extra_dims(1)%name = 'nlevurb' + + do p = 1, size(params_levurb) + do n = 1,nlevurb + extra_dims(1)%val = n + + call lookup_and_check_err(params_levurb(p)%name, data_levurb_o(:,n), 1, extra_dims, & + invalid_okay=params_levurb(p)%invalid_okay) + end do + + call check_ret(nf_inq_varid(ncido, params_levurb(p)%name, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_levurb_o), subname) + end do + + deallocate(data_levurb_o) + deallocate(extra_dims) + + + call check_ret(nf_close(ncidi), subname) + call check_ret(nf_sync(ncido), subname) + + write (6,*) 'Successfully made Urban Parameters' + write (6,*) + call shr_sys_flush(6) + +contains +!------------------------------------------------------------------------------ + subroutine lookup_and_check_err(varname, data, n_extra_dims, extra_dims, invalid_okay) + ! Wrapper to lookup_2d_netcdf: calls that routine with the appropriate arguments, + ! then checks the error code, aborting if there were errors + ! + ! Note: inherits a number of variables from the parent routine + + use mkindexmapMod, only : lookup_2d_netcdf + + implicit none + character(len=*), intent(in) :: varname ! name of lookup table + real(r8) , intent(out):: data(:) ! output from lookup_2d_netcdf + integer , intent(in) :: n_extra_dims ! number of extra dimensions in the lookup table + + ! slice to use if lookup table variable has more than 2 dimensions: + type(dim_slice_type), intent(in), optional :: extra_dims(:) + + ! if present and true, then we won't abort due to finding _FillValue in the lookup + ! table -- instead, those places will just have fill_val in the output data + logical, intent(in), optional :: invalid_okay + + ! Local variables: + + integer :: ierr ! error return code + + ! value to put where we have no data in output variables + real(r8), parameter :: fill_val = 0._r8 + + + call lookup_2d_netcdf(ncidi, varname, .true., & + 'density_class', 'region', n_extra_dims, & + dens_o, region_o, fill_val, data, ierr, & + extra_dims=extra_dims, nodata=index_nodata, & + invalid_okay=invalid_okay) + + if (ierr /= 0) then + write(6,*) modname//':'//subname//' ERROR in lookup_2d_netcdf for ', & + trim(varname), ':', ierr + call abort() + end if + end subroutine lookup_and_check_err + +end subroutine mkurbanpar +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: mkurban_dominant_density +! +! !INTERFACE: +subroutine mkurban_dominant_density(urbn_by_dens_o, nodata, dens_o, urbn_o) +! +! !DESCRIPTION: +! Creates urban density class and total % urban on the output grid +! +! !USES: + use mkindexmapMod, only : which_max +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: urbn_by_dens_o(:,:) ! % urban in each density class, output grid + ! (dimensions: (gridmap%nb, ndens)) + integer , intent(in) :: nodata ! flag to indicate nodata in output arrays + integer , intent(out):: dens_o(:) ! urban density class, output grid + real(r8), intent(out):: urbn_o(:) ! total % urban, output grid +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n + integer :: no + real(r8) :: maxval + integer :: maxindex + + character(len=*), parameter :: subName = "mkurban_dominant_density" +!------------------------------------------------------------------------------ + + n = size(urbn_by_dens_o, 1) + + ! Error-check inputs + + if (size(dens_o) /= n .or. size(urbn_o) /= n) then + write(6,*) subName//' ERROR: incorrect array sizes' + write(6,*) 'n = ', n + write(6,*) 'size(dens_o) = ', size(dens_o) + write(6,*) 'size(urbn_o) = ', size(urbn_o) + call abort() + end if + + + do no = 1, size(dens_o) + urbn_o(no) = sum(urbn_by_dens_o(no,:)) + + ! Determine dominant density class for each output cell + ! Note: if all urban density classes have 0 area, then the output value will be nodata + call which_max(urbn_by_dens_o(no,:), maxval, maxindex) + if (maxval > 0.) then + dens_o(no) = maxindex + else + dens_o(no) = nodata + end if + end do + +end subroutine mkurban_dominant_density +!------------------------------------------------------------------------------ + +end module mkurbanparDomMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkutilsMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkutilsMod.F90 new file mode 100644 index 0000000000..f6e6485173 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkutilsMod.F90 @@ -0,0 +1,189 @@ +module mkutilsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkutils +! +! !DESCRIPTION: +! General-purpose utilities for mksurfdata_map +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: slightly_below + public :: slightly_above + public :: convert_latlon +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: slightly_below +! +! !INTERFACE: +logical function slightly_below(a, b, eps) +! +! !DESCRIPTION: +! Returns true if a is slightly below b; false if a is significantly below b or if a is +! greater than or equal to b +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: a + real(r8), intent(in) :: b + + ! if provided, eps gives the relative error allowed for checking the "slightly" + ! condition; if not provided, the tolerance defaults to the value given by eps_default + real(r8), intent(in), optional :: eps +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: l_eps + real(r8), parameter :: eps_default = 1.e-15_r8 ! default relative error tolerance +!------------------------------------------------------------------------------ + + if (present(eps)) then + l_eps = eps + else + l_eps = eps_default + end if + + if (a < b .and. (b - a)/b < l_eps) then + slightly_below = .true. + else + slightly_below = .false. + end if + +end function slightly_below +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: slightly_above +! +! !INTERFACE: +logical function slightly_above(a, b, eps) +! +! !DESCRIPTION: +! Returns true if a is slightly above b; false if a is significantly above b or if a is +! less than or equal to b +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: a + real(r8), intent(in) :: b + + ! if provided, eps gives the relative error allowed for checking the "slightly" + ! condition; if not provided, the tolerance defaults to the value given by eps_default + real(r8), intent(in), optional :: eps +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: l_eps + real(r8), parameter :: eps_default = 1.e-15_r8 ! default relative error tolerance +!------------------------------------------------------------------------------ + + if (present(eps)) then + l_eps = eps + else + l_eps = eps_default + end if + + if (a > b .and. (a - b)/b < l_eps) then + slightly_above = .true. + else + slightly_above = .false. + end if + +end function slightly_above +!------------------------------------------------------------------------------ + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: convert_latlon +! +! !INTERFACE: + subroutine convert_latlon(ncid, varname, data) +! +! !DESCRIPTION: +! Convert a latitude or longitude variable from its units in the input file to degrees E / +! degrees N. Currently, this just handles conversions from radians to degrees. +! +! Assumes that the longitude / latitude variable has already been read from file, into +! the variable given by 'data'. ncid & varname give the file ID and variable name from +! which this variable was read (needed to obtain the variable's units). +! +! !USES: + use mkncdio + use shr_const_mod, only : SHR_CONST_PI +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! ID of open netcdf file + character(len=*), intent(in) :: varname ! name of lat or lon variable that was read into 'data' + real(r8) , intent(inout):: data(:) ! latitude or longitude data +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ier ! error return code + integer :: varid ! netCDF variable id + integer :: units_len ! length of units attribute on file + character(len=256) :: units ! units attribute + character(len= 32) :: subname = 'convert_latlon' +!----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, varname, varid), subname) + ier = nf_inq_attlen(ncid, varid, 'units', units_len) + + ! Only do the following processing if there is no error; if ier /= NF_NOERR, that + ! probably means there isn't a units attribute -- in that case, assume units are + ! degrees and need no conversion + if (ier == NF_NOERR) then + if (units_len > len(units)) then + write(6,*) trim(subname), ' ERROR: units variable not long enough to hold attributue' + call abort() + end if + + call check_ret(nf_get_att_text(ncid, varid, 'units', units), subname) + + if (units(1:7) == 'radians') then + ! convert from radians to degrees + data(:) = data(:) * 180._r8 / SHR_CONST_PI + end if + end if + + end subroutine convert_latlon +!------------------------------------------------------------------------------ + + +end module mkutilsMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarctl.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarctl.F90 new file mode 100644 index 0000000000..d6ab93b469 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarctl.F90 @@ -0,0 +1,74 @@ +module mkvarctl + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkvarctl +! +! !DESCRIPTION: +! Module containing control variables +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + private + save +! + real(r8), public, parameter :: spval = 1.e36 ! special value + + logical, public :: outnc_large_files ! output files in 64-bit format for large files + logical, public :: outnc_double ! output ALL data in files as 64-bit + integer, public :: outnc_dims = 2 ! only applicable to lat/lon grids + logical, public :: outnc_1d ! true => output file is 1d + + character(len= 32), public :: mksrf_gridnm = ' ' ! name of grid to use on output file + character(len=256), public :: mksrf_fgrid = ' ' ! land grid file name to use + character(len=256), public :: mksrf_gridtype = ' ' ! land gridtype, global or reg + character(len=256), public :: mksrf_fvegtyp = ' ' ! vegetation data file name + character(len=256), public :: mksrf_fsoitex = ' ' ! soil texture data file name + character(len=256), public :: mksrf_forganic = ' ' ! organic matter data file name + character(len=256), public :: mksrf_fsoicol = ' ' ! soil color data file name + character(len=256), public :: mksrf_flakwat = ' ' ! inland lake data file name + character(len=256), public :: mksrf_fwetlnd = ' ' ! inland wetlands data file name + character(len=256), public :: mksrf_furban = ' ' ! urban data file name + character(len=256), public :: mksrf_firrig = ' ' ! irrigated area data file name + character(len=256), public :: mksrf_fglacier = ' ' ! glacier data file name + character(len=256), public :: mksrf_furbtopo = ' ' ! urban topography data file name + character(len=256), public :: mksrf_flndtopo = ' ' ! land topography data file name + character(len=256), public :: mksrf_fmax = ' ' ! fmax data file name + character(len=256), public :: mksrf_flai = ' ' ! lai data filename + character(len=256), public :: mksrf_fdynuse = ' ' ! ascii file containing names of dynamic land use files + character(len=256), public :: mksrf_fvocef = ' ' ! VOC Emission Factor data file name + + integer , public :: numpft = 16 ! number of plant types + + character(len=256), public :: map_fpft = ' ' ! Mapping file for PFT + character(len=256), public :: map_flakwat = ' ' ! Mapping file for lake water + character(len=256), public :: map_fwetlnd = ' ' ! Mapping file for wetland water + character(len=256), public :: map_fglacier = ' ' ! Mapping file for glacier + character(len=256), public :: map_fsoitex = ' ' ! Mapping file for soil texture + character(len=256), public :: map_fsoicol = ' ' ! Mapping file for soil color + character(len=256), public :: map_furban = ' ' ! Mapping file for urban + character(len=256), public :: map_furbtopo = ' ' ! Mapping file for urban topography + character(len=256), public :: map_flndtopo = ' ' ! Mapping file for land topography + character(len=256), public :: map_fmax = ' ' ! Mapping file for soil frac max + character(len=256), public :: map_forganic = ' ' ! Mapping file for organic soil + character(len=256), public :: map_fvocef = ' ' ! Mapping file for VOC emission factors + character(len=256), public :: map_flai = ' ' ! Mapping file for LAI + character(len=256), public :: map_fharvest = ' ' ! Mapping file for harvesting + character(len=256), public :: map_firrig = ' ' ! Mapping file for irrigation +! +! Variables to override data read in with +! (This is mostly for single-point mode, but could be used for sensitivity studies) +! + logical, public :: all_urban ! output ALL data as 100% covered in urban +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 11/04 +! +!EOP +!----------------------------------------------------------------------- + +end module mkvarctl diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarpar.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarpar.F90 new file mode 100644 index 0000000000..fba8cafccb --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvarpar.F90 @@ -0,0 +1,32 @@ +module mkvarpar + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_REARTH +! +! !PUBLIC TYPES: + implicit none + save +! + integer, parameter :: nlevsoi = 10 ! number of soil layers + integer, parameter :: numstdpft = 16! number of standard PFT types + integer, parameter :: noveg = 0 ! value for non-vegetated pft + integer, parameter :: nlevurb = 15 ! number of urban layers + integer, parameter :: numsolar = 2 ! number of solar types (Direct,Diffuse) + integer, parameter :: numrad = 2 ! number of solar bands (VIS,NIR) + real(r8),parameter :: elev_thresh = 2040._r8 ! elevation threshold for screening urban areas + real(r8),parameter :: re = SHR_CONST_REARTH*0.001 + +! +!EOP +!----------------------------------------------------------------------- + +end module mkvarpar diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/mkvocefMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvocefMod.F90 new file mode 100644 index 0000000000..f02f13444a --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/mkvocefMod.F90 @@ -0,0 +1,218 @@ +module mkvocefMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkvocMod +! +! !DESCRIPTION: +! Make VOC percentage emissions for surface dataset +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkvocef ! Get the percentage emissions for VOC for different + ! land cover types +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkvocef +! +! !INTERFACE: +subroutine mkvocef(ldomain, mapfname, datfname, ndiag, & + ef_btr_o, ef_fet_o, ef_fdt_o, ef_shr_o, ef_grs_o, ef_crp_o) +! +! !DESCRIPTION: +! make volatile organic coumpunds (VOC) emission factors. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diagnostic output + real(r8) , intent(out):: ef_btr_o(:) ! output grid: EFs for broadleaf trees + real(r8) , intent(out):: ef_fet_o(:) ! output grid: EFs for fineleaf evergreen + real(r8) , intent(out):: ef_fdt_o(:) ! output grid: EFs for fineleaf deciduous + real(r8) , intent(out):: ef_shr_o(:) ! output grid: EFs for shrubs + real(r8) , intent(out):: ef_grs_o(:) ! output grid: EFs for grasses + real(r8) , intent(out):: ef_crp_o(:) ! output grid: EFs for crops +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Colette L. Heald +! 17 Jul 2007 F Vitt -- updated to pftintdat06_clm3_5_05 and corrected indexing of ef_*_i arrarys +! +!EOP +! +! !LOCAL VARIABLES: + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: ef_btr_i(:) ! input grid: EFs for broadleaf trees + real(r8), allocatable :: ef_fet_i(:) ! input grid: EFs for fineleaf evergreen + real(r8), allocatable :: ef_fdt_i(:) ! input grid: EFs for fineleaf deciduous + real(r8), allocatable :: ef_shr_i(:) ! input grid: EFs for shrubs + real(r8), allocatable :: ef_grs_i(:) ! input grid: EFs for grasses + real(r8), allocatable :: ef_crp_i(:) ! input grid: EFs for crops + real(r8) :: sum_fldo ! global sum of dummy input fld + real(r8) :: sum_fldi ! global sum of dummy input fld + integer :: k,n,no,ni,ns_o,ns_i ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001_r8 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkvocef' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make VOC emission factors .....' + call shr_sys_flush(6) + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Read input Emission Factors + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(ef_btr_i(ns_i), ef_fet_i(ns_i), ef_fdt_i(ns_i), & + ef_shr_i(ns_i), ef_grs_i(ns_i), ef_crp_i(ns_i), & + stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open VOC file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'ef_btr', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_btr_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_fet', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_fet_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_fdt', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_fdt_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_shr', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_shr_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_grs', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_grs_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_crp', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_crp_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Do mapping from input to output grid + + call gridmap_areaave(tgridmap, ef_btr_i, ef_btr_o) + call gridmap_areaave(tgridmap, ef_fet_i, ef_fet_o) + call gridmap_areaave(tgridmap, ef_fdt_i, ef_fdt_o) + call gridmap_areaave(tgridmap, ef_shr_i, ef_shr_o) + call gridmap_areaave(tgridmap, ef_grs_i, ef_grs_o) + call gridmap_areaave(tgridmap, ef_crp_i, ef_crp_o) + + ! Check for conservation + + do no = 1, ns_o + if ( ef_btr_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF btr = ',ef_btr_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_fet_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF fet = ',ef_fet_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_fdt_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF fdt = ',ef_fdt_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_shr_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF shr = ',ef_shr_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_grs_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF grs = ',ef_grs_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_crp_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF crp = ',ef_crp_o(no), & + ' is negative for no = ',no + call abort() + end if + enddo + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0._r8 + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1._r8) > relerr ) then + write (6,*) 'MKVOCEF error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + write (6,*) 'Successfully made VOC Emission Factors' + write (6,*) + call shr_sys_flush(6) + + ! Deallocate dynamic memory + + deallocate ( ef_btr_i, ef_fet_i, ef_fdt_i, & + ef_shr_i, ef_grs_i, ef_crp_i ) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + +end subroutine mkvocef + +!----------------------------------------------------------------------- + +end module mkvocefMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/nanMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/nanMod.F90 new file mode 100644 index 0000000000..0cbeeea112 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/nanMod.F90 @@ -0,0 +1,41 @@ +module nanMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: nanMod +! +! !DESCRIPTION: +! Set parameters for the floating point flags "inf" Infinity +! and "nan" not-a-number. As well as "bigint" the point +! at which integers start to overflow. These values are used +! to initialize arrays with as a way to detect if arrays +! are being used before being set. +! Note that bigint is the largest possible 32-bit integer. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +#ifdef __PGI +! quiet nan for portland group compilers + real(r8), parameter :: inf = O'0777600000000000000000' + real(r8), parameter :: nan = O'0777700000000000000000' + integer, parameter :: bigint = O'17777777777' +#else +! signaling nan otherwise + real(r8), parameter :: inf = O'0777600000000000000000' + real(r8), parameter :: nan = O'0777610000000000000000' + integer, parameter :: bigint = O'17777777777' +#endif +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein based on cam module created by +! CCM core group +! +!EOP +!----------------------------------------------------------------------- + +end module nanMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_const_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_const_mod.F90 new file mode 100644 index 0000000000..16529ae9b7 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_const_mod.F90 @@ -0,0 +1,61 @@ +!=============================================================================== +! SVN $Id: shr_const_mod.F90 6749 2007-10-04 20:58:20Z jwolfe $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_100228/shr/shr_const_mod.F90 $ +!=============================================================================== + +MODULE shr_const_mod + + use shr_kind_mod + + integer(SHR_KIND_IN),parameter,private :: R8 = SHR_KIND_R8 ! rename for local readability only + + !---------------------------------------------------------------------------- + ! physical constants (all data public) + !---------------------------------------------------------------------------- + public + + real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi + real(R8),parameter :: SHR_CONST_CDAY = 86400.0_R8 ! sec in calendar day ~ sec + real(R8),parameter :: SHR_CONST_SDAY = 86164.0_R8 ! sec in siderial day ~ sec + real(R8),parameter :: SHR_CONST_OMEGA = 2.0_R8*SHR_CONST_PI/SHR_CONST_SDAY ! earth rot ~ rad/sec + real(R8),parameter :: SHR_CONST_REARTH = 6.37122e6_R8 ! radius of earth ~ m + real(R8),parameter :: SHR_CONST_G = 9.80616_R8 ! acceleration of gravity ~ m/s^2 + + real(R8),parameter :: SHR_CONST_STEBOL = 5.67e-8_R8 ! Stefan-Boltzmann constant ~ W/m^2/K^4 + real(R8),parameter :: SHR_CONST_BOLTZ = 1.38065e-23_R8 ! Boltzmann's constant ~ J/K/molecule + real(R8),parameter :: SHR_CONST_AVOGAD = 6.02214e26_R8 ! Avogadro's number ~ molecules/kmole + real(R8),parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! Universal gas constant ~ J/K/kmole + real(R8),parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole + real(R8),parameter :: SHR_CONST_MWWV = 18.016_R8 ! molecular weight water vapor + real(R8),parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR ! Dry air gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_RWV = SHR_CONST_RGAS/SHR_CONST_MWWV ! Water vapor gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_ZVIR = (SHR_CONST_RWV/SHR_CONST_RDAIR)-1.0_R8 ! RWV/RDAIR - 1.0 + real(R8),parameter :: SHR_CONST_KARMAN = 0.4_R8 ! Von Karman constant + real(R8),parameter :: SHR_CONST_PSTD = 101325.0_R8 ! standard pressure ~ pascals + real(R8),parameter :: SHR_CONST_PDB = 0.0112372_R8 ! ratio of 13C/12C in Pee Dee Belemnite (C isotope standard) + + real(R8),parameter :: SHR_CONST_TKTRIP = 273.16_R8 ! triple point of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZ = 273.15_R8 ! freezing T of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZSW = SHR_CONST_TKFRZ - 1.8_R8 ! freezing T of salt water ~ K + + real(R8),parameter :: SHR_CONST_RHODAIR = & ! density of dry air at STP ~ kg/m^3 + SHR_CONST_PSTD/(SHR_CONST_RDAIR*SHR_CONST_TKFRZ) + real(R8),parameter :: SHR_CONST_RHOFW = 1.000e3_R8 ! density of fresh water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOSW = 1.026e3_R8 ! density of sea water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOICE = 0.917e3_R8 ! density of ice ~ kg/m^3 + real(R8),parameter :: SHR_CONST_CPDAIR = 1.00464e3_R8 ! specific heat of dry air ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPWV = 1.810e3_R8 ! specific heat of water vap ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPVIR = (SHR_CONST_CPWV/SHR_CONST_CPDAIR)-1.0_R8 ! CPWV/CPDAIR - 1.0 + real(R8),parameter :: SHR_CONST_CPFW = 4.188e3_R8 ! specific heat of fresh h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPSW = 3.996e3_R8 ! specific heat of sea h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPICE = 2.11727e3_R8 ! specific heat of fresh ice ~ J/kg/K + real(R8),parameter :: SHR_CONST_LATICE = 3.337e5_R8 ! latent heat of fusion ~ J/kg + real(R8),parameter :: SHR_CONST_LATVAP = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + real(R8),parameter :: SHR_CONST_LATSUB = & ! latent heat of sublimation ~ J/kg + SHR_CONST_LATICE + SHR_CONST_LATVAP + real(R8),parameter :: SHR_CONST_OCN_REF_SAL = 34.7_R8 ! ocn ref salinity (psu) + real(R8),parameter :: SHR_CONST_ICE_REF_SAL = 4.0_R8 ! ice ref salinity (psu) + + real(R8),parameter :: SHR_CONST_SPVAL = 1.0e30_R8 ! special missing value + +END MODULE shr_const_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_file_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_file_mod.F90 new file mode 100644 index 0000000000..7e803c3194 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_file_mod.F90 @@ -0,0 +1,1027 @@ +!=============================================================================== +! SVN $Id: shr_file_mod.F90 22436 2010-04-18 05:32:48Z tcraig $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_110213/shr/shr_file_mod.F90 $ +!=============================================================================== +!BOP =========================================================================== +! +! !MODULE: shr_file_mod.F90 --- Module to handle various file utilily functions. +! +! !DESCRIPTION: +! +! Miscilaneous methods to handle file and directory utilities as well as FORTRAN +! unit control. Also put/get local files into/from archival location +! +! File utilites used with CCSM Message passing: +! +! shr_file_stdio is the main example here, it changes the working directory, +! changes stdin and stdout to a given filename. +! +! This is needed because some implementations of MPI with MPMD so that +! each executable can run in a different working directory and redirect +! output to different files. +! +! File name archival convention, eg. +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! is extensible -- the existence of the option file name prefix, eg. "mss:", +! and optional arguments, eg. rtpd-3650 can be used to access site-specific +! storage devices. Based on CCM (atmosphere) getfile & putfile routines, but +! intended to be a more extensible, shared code. +! +! !REVISION HISTORY: +! 2006-05-08 E. Kluzek, Add in shr_file_mod and getUnit, freeUnif methods. +! 2000-??-?? B. Kauffman, original version circa 2000 +! +! !INTERFACE: ------------------------------------------------------------------ + +MODULE shr_file_mod + +! !USES: + + use shr_kind_mod ! defines kinds + use shr_sys_mod ! system calls + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + IMPLICIT none + + PRIVATE ! By default everything is private to this module + +! !PUBLIC TYPES: + + ! no public types + +! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_file_put ! Put a file to an archive location + public :: shr_file_get ! Get a file from an archive location + public :: shr_file_queryPrefix ! Get prefix type for a filename + public :: shr_file_getUnit ! Get a logical unit for reading or writing + public :: shr_file_freeUnit ! Free a logical unit + public :: shr_file_stdio ! change dir and stdin and stdout + public :: shr_file_chDir ! change current working directory + public :: shr_file_dirio ! change stdin and stdout + public :: shr_file_chStdIn ! change stdin (attach to a file) + public :: shr_file_chStdOut ! change stdout (attach to a file) + public :: shr_file_setIO ! open a log file from namelist + public :: shr_file_setLogUnit ! Reset the log unit number + public :: shr_file_setLogLevel ! Reset the logging debug level + public :: shr_file_getLogUnit ! Get the log unit number + public :: shr_file_getLogLevel ! Get the logging debug level + +! !PUBLIC DATA MEMBERS: + + ! Integer flags for recognized prefixes on file get/put operations + integer(SHR_KIND_IN), parameter, public :: shr_file_noPrefix = 0 ! no recognized prefix + integer(SHR_KIND_IN), parameter, public :: shr_file_nullPrefix = 1 ! null: + integer(SHR_KIND_IN), parameter, public :: shr_file_cpPrefix = 2 ! cp: + integer(SHR_KIND_IN), parameter, public :: shr_file_mssPrefix = 3 ! mss: + integer(SHR_KIND_IN), parameter, public :: shr_file_hpssPrefix = 4 ! hpss: + +!EOP + !--- unit numbers, users can ask for unit numbers from 0 to min, but getUnit + !--- won't give a unit below min, users cannot ask for unit number above max + !--- for backward compatability. + !--- eventually, recommend min as hard lower limit (tcraig, 9/2007) + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + logical, save :: UnitTag(0:shr_file_maxUnit) = .false. ! Logical units in use + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_put -- Put a file to an archival location. +! +! !DESCRIPTION: +! a generic, extensible put-local-file-into-archive routine +! USAGE: +! call shr_file_put(rcode,"foo","/home/user/foo") +! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) +! call shr_file_put(rcode,"foo","cp:/home/user/foo",remove=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! if ( rcode /= 0 ) call shr_sys_abort( "error archiving foo to MSS" ) +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_put(rcode,loc_fn,rem_fn,passwd,rtpd,async,remove) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero -- error) + character(*), intent(in) :: loc_fn ! local filename + character(*), intent(in) :: rem_fn ! remote filename + character(*), intent(in),optional :: passwd ! password + integer(SHR_KIND_IN),intent(in),optional :: rtpd ! MSS retention period + logical, intent(in),optional :: async ! true <=> asynchronous put + logical, intent(in),optional :: remove ! true <=> rm after put + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: rtpd2 ! MSS retention period + logical :: remove2 ! true <=> rm after put + logical :: async2 ! true <=> asynchronous put + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_put) ' + character(*),parameter :: F00 = "('(shr_file_put) ',4a)" + character(*),parameter :: F01 = "('(shr_file_put) ',a,i3,2a)" + character(*),parameter :: F02 = "(a,i4)" + +!------------------------------------------------------------------------------- +! Notes: +! - On some machines the system call will not return a valid error code +! - when things are sent asynchronously, there probably won't be a error code +! returned. +!------------------------------------------------------------------------------- + + remove2 =.false. ; if ( PRESENT(remove )) remove2 = remove + async2 =.true. ; if ( PRESENT(async )) async2 = async + passwd2 = " " ; if ( PRESENT(passwd )) passwd2 = passwd + rtpd2 = 365 ; if ( PRESENT(rtpd )) rtpd2 = rtpd + rcode = 0 + + if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file = '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! put via unix cp + !------------------------------------------------------ + rfn = rem_fn + if ( rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) +#if defined(CATAMOUNT) + call shr_jlcp(trim(loc_fn),len_trim(loc_fn),trim(rfn),len_trim(rfn),rcode) + if (remove2) call unlink(trim(loc_fn)) + if (async2 .and. s_loglev > 0) write(s_logunit,F00) 'Error: asynchronous copy not supported.' + cmd = 'shr_jlcp -f '//trim(loc_fn)//' '//trim(rfn) + rcode = 0 +#else + cmd = '/bin/cp -f '//trim(loc_fn)//' '//trim(rfn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) +#endif + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! put onto NCAR's MSS + !------------------------------------------------------ + if (rtpd2 > 9999) rtpd2 = 9999 + write(cmd,F02) '/usr/local/bin/msrcp -period ',rtpd2 + if (async2 .and. (.not. remove2) ) cmd = trim(cmd)//' -async ' + if (len_trim(passwd2) > 0 ) cmd = trim(cmd)//' -wpwd '//trim(passwd) + cmd = trim(cmd)//' '//trim(loc_fn)//' '//trim(rem_fn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 .and. remove2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! put onto LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file archival, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + +END SUBROUTINE shr_file_put + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_get -- Get a file from archival location. +! +! !DESCRIPTION: +! a generic, extensible get-local-file-from-archive routine +! +! USAGE: +! call shr_file_get(rcode,"foo","/home/user/foo") +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) +! call shr_file_get(rcode,"foo","cp:/home/user/foo",remove=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) +! call shr_file_get(rcode,"foo","mss:/USER/foo",clobber=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo from MSS" ) +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_get(rcode,loc_fn,rem_fn,passwd,async,clobber) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero means error) + character(*) ,intent(in) :: loc_fn ! local filename + character(*) ,intent(in) :: rem_fn ! remote filename + character(*) ,intent(in),optional :: passwd ! password + logical ,intent(in),optional :: async ! true <=> asynchronous get + logical ,intent(in),optional :: clobber ! true <=> clobber existing file + +!EOP + + !----- local ----- + logical :: async2 ! true <=> asynchronous get + logical :: clobber2 ! true <=> clobber existing file + logical :: exists ! true <=> local file a ready exists + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_get) ' + character(*),parameter :: F00 = "('(shr_file_get) ',4a)" + character(*),parameter :: F01 = "('(shr_file_get) ',a,i3,2a)" + +!------------------------------------------------------------------------------- +! Notes: +! - On some machines the system call will not return a valid error code +! - When things are sent asynchronously, there probably won't be a error code +! returned. +!------------------------------------------------------------------------------- + + passwd2 = " " ; if (PRESENT(passwd )) passwd2 = passwd + async2 = .false. ; if (PRESENT(async )) async2 = async + clobber2 = .false. ; if (PRESENT(clobber)) clobber2 = clobber + rcode = 0 + + inquire(file=trim(loc_fn),exist=exists) + prefix = shr_file_queryPrefix( rem_fn ) + + if ( exists .and. .not. clobber2 ) then + !------------------------------------------------------ + ! (file exists) and (don't clobber) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: file exists & no-clobber for '//trim(loc_fn) + rcode = 0 + else if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file for '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! get via unix cp + !------------------------------------------------------ + rfn = rem_fn ! remove prefix from this temp file name + if (rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) +#if defined(CATAMOUNT) + call shr_jlcp(trim(rfn),len(trim(rfn)),trim(loc_fn),len(trim(loc_fn)),rcode) + if (async2.and.s_loglev>0) write(s_logunit,F00) 'Error: asynchronous copy not supported.' + cmd = 'shr_jlcp -f '//trim(rfn)//' '//trim(loc_fn) + rcode = 0 +#else + cmd = '/bin/cp -f '//trim(rfn)//' '//trim(loc_fn) + if (async2) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) +#endif + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! get from NCAR's MSS + !------------------------------------------------------ + cmd = '/usr/local/bin/msrcp ' + if (async2) cmd = trim(cmd)//' -async ' + cmd = trim(cmd)//' '//trim(rem_fn)//' '//trim(loc_fn) + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! get from LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file retrieval, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + +END SUBROUTINE shr_file_get + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_queryPrefix -- Get the prefix type from a filepath. +! +! !DESCRIPTION: +! +! !INTERFACE: ------------------------------------------------------------------ + +integer(SHR_KIND_IN) FUNCTION shr_file_queryPrefix( filepath, prefix ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*), intent(in) :: filepath ! Input filepath + character(*), intent(out), optional :: prefix ! Output prefix description + +!EOP + + !----- local ----- + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if ( filepath(1:5) == "null:" )then + shr_file_queryPrefix = shr_file_nullPrefix + if ( present(prefix) ) prefix = "null:" + else if( filepath(1:3) == "cp:" )then + shr_file_queryPrefix = shr_file_cpPrefix + if ( present(prefix) ) prefix = "cp:" + else if( filepath(1:4) == "mss:" )then + shr_file_queryPrefix = shr_file_mssPrefix + if ( present(prefix) ) prefix = "mss:" + else if( filepath(1:5) == "hpss:" )then + shr_file_queryPrefix = shr_file_hpssPrefix + if ( present(prefix) ) prefix = "hpss:" + else + shr_file_queryPrefix = shr_file_noPrefix + if ( present(prefix) ) prefix = "" + end if + +END FUNCTION shr_file_queryPrefix + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getUnit -- Get a free FORTRAN unit number +! +! !DESCRIPTION: Get the next free FORTRAN unit number. +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! +! !INTERFACE: ------------------------------------------------------------------ + +INTEGER FUNCTION shr_file_getUnit ( unit ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in),optional :: unit ! desired unit number + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! loop index + logical :: opened ! If unit opened or not + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_getUnit) ' + character(*),parameter :: F00 = "('(shr_file_getUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (present (unit)) then + inquire( unit, opened=opened ) + if (unit < 0 .or. unit > shr_file_maxUnit) then + write(s_logunit,F00) 'invalid unit number request:', unit + call shr_sys_abort( 'ERROR: bad input unit number' ) + else if (opened .or. UnitTag(unit) .or. unit == 0 .or. unit == 5 & + .or. unit == 6) then + write(s_logunit,F00) 'unit number ', unit, ' is already in use' + call shr_sys_abort( 'ERROR: Input unit number already in use' ) + else + shr_file_getUnit = unit + UnitTag (unit) = .true. + return + end if + + else + ! --- Choose first available unit other than 0, 5, or 6 ------ + do n=shr_file_maxUnit, shr_file_minUnit, -1 + inquire( n, opened=opened ) + if (n == 5 .or. n == 6 .or. opened) then + cycle + end if + if ( .not. UnitTag(n) ) then + shr_file_getUnit = n + UnitTag(n) = .true. + return + end if + end do + end if + + call shr_sys_abort( subName//': Error: no available units found' ) + +END FUNCTION shr_file_getUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_freeUnit -- Free up a FORTRAN unit number +! +! !DESCRIPTION: Free up the given unit number +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_freeUnit ( unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! unit number to be freed + +!EOP + + !----- local ----- + + !----- formats ----- + character(*), parameter :: subName = '(shr_file_freeUnit) ' + character(*), parameter :: F00 = "('(shr_file_freeUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (unit < 0 .or. unit > shr_file_maxUnit) then + if (s_loglev > 0) write(s_logunit,F00) 'invalid unit number request:', unit + else if (unit == 0 .or. unit == 5 .or. unit == 6) then + call shr_sys_abort( subName//': Error: units 0, 5, and 6 must not be freed' ) + else if (UnitTag(unit)) then + UnitTag (unit) = .false. + else + if (s_loglev > 0) write(s_logunit,F00) 'unit ', unit, ' was not in use' + end if + + return + +END SUBROUTINE shr_file_freeUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdio -- Change working directory, and redirect stdin/stdout +! +! !DESCRIPTION: +! 1) change the cwd (current working directory) and +! 2) redirect stdin & stdout (units 5 & 6) to named files, +! where the desired cwd & files are specified by namelist file. +! +! Normally this is done to work around limitations in the execution syntax +! of common MPI implementations. For example, SGI's mpirun syntax is not +! flexible enough to allow MPMD models to select different execution +! directories or to redirect stdin & stdout on the command line. +! Such functionality is highly desireable for CCSM purposes. +! ie. mpirun can't handle this: +! unix> cd /usr/tmp/jdoe/csm/case01/atm ; atm < atm.parm > atm.log & +! unix> cd /usr/tmp/jdoe/csm/case01/cpl ; cpl < cpl.parm > cpl.log & +! etc. +! +! ASSUMPTIONS: +! o if the cwd, stdin, or stdout are to be changed, there must be a namelist +! file in the cwd named _stdio.nml where is provided via +! subroutine dummy argument. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_stdio(model) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdio) ' + character(*),parameter :: F00 = "('(shr_file_stdio) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_chdir (model) ! changes cwd + call shr_file_chStdOut(model) ! open units 5 & 6 to named files + call shr_file_chStdIn (model) ! open units 5 & 6 to named files + +END SUBROUTINE shr_file_stdio + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_chdir -- Change working directory. +! +! !DESCRIPTION: +! change the cwd (current working directory), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chdir(model, rcodeOut) + +! !USES: + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + +!EOP + + !--- local --- + character(SHR_KIND_CL) :: dir ! directory to cd to + integer (SHR_KIND_IN) :: rcode ! Return error code + character(SHR_KIND_CL) :: filename ! namelist file to read + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chdir) ' + character(*),parameter :: F00 = "('(shr_file_chdir) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, dirOut=dir, rcodeOut=rcode ) + if (dir /= "nochange") then + call shr_sys_chdir(dir ,rcode) + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", changed cwd to ",trim(dir) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", cwd has *not* been changed" + rcode = 1 + endif + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chdir + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_dirio --- Change stdin and stdout. +! +! !DESCRIPTION: +! change the stdin & stdout (units 5 & 6), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_dirio(model) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + +!EOP + + !--- local --- + + !--- formats --- + character(*),parameter :: subName = '(shr_file_dirio) ' + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + call shr_file_chStdIn (model) + call shr_file_chStdOut(model) + +END SUBROUTINE shr_file_dirio + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_chStdIn -- Change stdin +! +! !DESCRIPTION: +! change the stdin (unit 5), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chStdIn( model, NLFilename, rcodeOut ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env var name + character(SHR_KIND_CL),intent(out),optional :: NLFilename ! open unit 5 to this + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + +!EOP + + !--- local --- + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: nlfile ! Namelist filename for model to read from + character(SHR_KIND_CL) :: filename ! namelist file to read + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdIn) ' + character(*),parameter :: F00 = "('(shr_file_chStdIn) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdinOut=stdin, & + nlfileOut=nlfile, rcodeOut=rcode ) + if (stdin /= "nochange") then + open(unit=5,file=stdin ,status='UNKNOWN',iostat=rcode) + if ( rcode /= 0 )then + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': error opening file as unit 5:', & + trim(nlfile) + else + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': unit 5 connected to ', & + trim(stdin) + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 5 has *not* been redirected' + endif + if ( len_trim(nlfile) > 0) then + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': read namelist from file:',trim(nlfile) + if ( .not. present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename NOT present" + rcode = 7 + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", " + if ( present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename present, but null" + rcode = 8 + end if + endif + if ( present(NLFilename) ) NLFilename = nlfile + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chStdIn + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdout -- Change stdout +! +! !DESCRIPTION: +! change the stdout (unit 6), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chStdOut(model,rcodeOut) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + !--- arguments --- + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code +!EOP + + !--- local --- + character(SHR_KIND_CL) :: filename ! namelist file to read + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdOut) ' + character(*),parameter :: F00 = "('(shr_file_chStdOut) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdoutOut=stdout, & + rcodeOut=rcode ) + if (stdout /= "nochange") then + close(6) + open(unit=6,file=stdout,position='APPEND') + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 connected to ',trim(stdout) + call shr_sys_flush(s_logunit) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 has *not* been redirected' + rcode = 1 + endif + + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chStdOut + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdioReadNL -- read in stdio namelist +! +! !DESCRIPTION: +! Read in the stdio namelist for any given model type. Return any of the +! needed input namelist variables as optional arguments. Return "nochange" in +! dir, stdin, or stdout if shouldn't change. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_stdioReadNL( model, filename, dirOut, stdinOut, stdoutOut, & + NLFileOut, rcodeOut ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + character(SHR_KIND_CL),intent(out) :: filename ! nml file to read from unit 5 + character(SHR_KIND_CL),intent(out),optional :: NLFileOut ! open unit 6 to this file + character(SHR_KIND_CL),intent(out),optional :: dirOut ! directory to cd to + character(SHR_KIND_CL),intent(out),optional :: stdinOut ! open unit 5 to this file + character(SHR_KIND_CL),intent(out),optional :: stdoutOut ! open unit 6 to this file + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + +!EOP + + !--- local --- + logical :: exists ! true iff file exists + character(SHR_KIND_CL) :: dir ! directory to cd to + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + character(SHR_KIND_CL) :: NLFile ! namelist file to read seperately + integer (SHR_KIND_IN) :: rcode ! return code + integer (SHR_KIND_IN) :: unit ! Unit to read from + + namelist / stdio / dir,stdin,stdout,NLFile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdioReadNL) ' + character(*),parameter :: F00 = "('(shr_file_stdioReadNL) ',4a)" + character(*),parameter :: F01 = "('(shr_file_stdioReadNL) ',2a,i6)" + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + rcode = 0 + dir = "nochange" + stdin = "nochange" + stdout = "nochange" + NLFile = " " + + filename = trim(model)//"_stdio.nml" ! eg. file="cpl_stdio.nml" + inquire(file=filename,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(filename),& + & " doesn't exist, can not read stdio namelist from it" + rcode = 9 + else + unit = shr_file_getUnit() + open (unit,file=filename,action="READ") + read (unit,nml=stdio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(filename),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(filename) ) + end if + endif + if ( len_trim(NLFile) > 0 .and. trim(stdin) /= "nochange" )then + write(s_logunit,F00) "Error: input namelist:" + write(s_logunit,nml=stdio) + call shr_sys_abort(subName//" ERROR trying to both redirect AND "// & + "open namelist filename" ) + end if + if ( present(NLFileOut) ) NLFileOut = NLFile + if ( present(dirOut) ) dirOut = dir + if ( present(stdinOut) ) stdinOut = stdin + if ( present(stdoutOut) ) stdoutOut = stdout + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_stdioReadNL + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setIO -- read in stdio namelist +! +! !DESCRIPTION: +! This opens a namelist file specified as an argument and then opens +! a log file associated with the unit argument. This may be extended +! in the future. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setIO( nmlfile, funit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(len=*) ,intent(in) :: nmlfile ! namelist filename + integer(SHR_KIND_IN),intent(in) :: funit ! unit number for log file + +!EOP + + !--- local --- + logical :: exists ! true if file exists + character(SHR_KIND_CL) :: diri ! directory to cd to + character(SHR_KIND_CL) :: diro ! directory to cd to + character(SHR_KIND_CL) :: logfile ! open unit 6 to this file + integer(SHR_KIND_IN) :: unit ! unit number + integer(SHR_KIND_IN) :: rcode ! error code + + namelist / modelio / diri,diro,logfile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setIO) ' + character(*),parameter :: F00 = "('(shr_file_setIO) ',4a)" + character(*),parameter :: F01 = "('(shr_file_setIO) ',2a,i6)" + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + diri = "." + diro = "." + logfile = "" + + inquire(file=nmlfile,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(nmlfile)," non existant" + return + else + unit = shr_file_getUnit() + open (unit,file=nmlfile,action="READ") + read (unit,nml=modelio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(nmlfile),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(nmlfile) ) + end if + endif + + if (len_trim(logfile) > 0) then + open(funit,file=trim(diro)//"/"//trim(logfile)) + else + if (s_loglev > 0) write(s_logunit,F00) "logfile not opened" + endif + +END SUBROUTINE shr_file_setIO + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setLogUnit -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setLogUnit(unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! new unit number + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_setLogUnit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: Caller must be sure it's a valid unit number +!------------------------------------------------------------------------------- + + if (s_loglev > 1 .and. s_logunit-unit /= 0) then + write(s_logunit,*) subName,': reset log unit number from/to ',s_logunit, unit + write( unit,*) subName,': reset log unit number from/to ',s_logunit, unit + endif + + s_logunit = unit + +END SUBROUTINE shr_file_setLogUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setLogLevel -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setLogLevel(newlevel) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: newlevel ! new log level + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_setLogLevel) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (s_loglev+newlevel > 2 .and. s_loglev-newlevel /= 0) & + write(s_logunit,*) subName,': reset log level from/to ',s_loglev, newlevel + + s_loglev = newlevel + +END SUBROUTINE shr_file_setLogLevel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getLogUnit -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_getLogUnit(unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: unit ! new unit number + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_getLogUnit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + unit = s_logunit + +END SUBROUTINE shr_file_getLogUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getLogLevel -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_getLogLevel(curlevel) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: curlevel ! new log level + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_getLogLevel) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + curlevel = s_loglev + +END SUBROUTINE shr_file_getLogLevel + +!=============================================================================== +!=============================================================================== + +END MODULE shr_file_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_kind_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_kind_mod.F90 new file mode 100644 index 0000000000..79ee2fec05 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_kind_mod.F90 @@ -0,0 +1,22 @@ +!=============================================================================== +! SVN $Id: shr_kind_mod.F90 11926 2008-09-25 21:10:40Z mvertens $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_kind_mod.F90 $ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + integer,parameter :: SHR_KIND_CS = 80 ! short char + integer,parameter :: SHR_KIND_CL = 256 ! long char + integer,parameter :: SHR_KIND_CX = 512 ! extra-long char + +END MODULE shr_kind_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_log_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_log_mod.F90 new file mode 100644 index 0000000000..244314a8de --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_log_mod.F90 @@ -0,0 +1,13 @@ +MODULE shr_log_mod + + use shr_kind_mod + + !---------------------------------------------------------------------------- + ! low-level shared variables for logging, these may not be parameters + !---------------------------------------------------------------------------- + public + + integer(SHR_KIND_IN) :: shr_log_Level = 1 + integer(SHR_KIND_IN) :: shr_log_Unit = 6 + +END MODULE shr_log_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_string_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_string_mod.F90 new file mode 100644 index 0000000000..e6596cc181 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_string_mod.F90 @@ -0,0 +1,1757 @@ +!=============================================================================== +! SVN $Id: shr_string_mod.F90 25247 2010-10-20 22:43:21Z tcraig $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_string_mod.F90 $ +!=============================================================================== +!=============================================================================== +!BOP =========================================================================== +! +! !MODULE: shr_string_mod -- string and list methods +! +! !DESCRIPTION: +! General string and specific list method. A list is a single string +! that is delimited by a character forming multiple fields, ie, +! character(len=*) :: mylist = "t:s:u1:v1:u2:v2:taux:tauy" +! The delimiter is called listDel in this module, is default ":", +! but can be set by a call to shr_string_listSetDel. +! +! !REVISION HISTORY: +! 2005-Apr-28 - T. Craig - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +module shr_string_mod + +! !USES: + + use shr_kind_mod ! F90 kinds + use shr_sys_mod ! shared system calls + use shr_timer_mod, only : shr_timer_get, shr_timer_start, shr_timer_stop + use shr_log_mod, only : s_loglev => shr_log_Level + use shr_log_mod, only : s_logunit => shr_log_Unit + + implicit none + private + +! !PUBLIC TYPES: + + ! no public types + +! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_string_countChar ! Count number of char in string, fn + public :: shr_string_toUpper ! Convert string to upper-case + public :: shr_string_toLower ! Convert string to lower-case + public :: shr_string_getParentDir ! For a pathname get the parent directory name + public :: shr_string_lastIndex ! Index of last substr in str + public :: shr_string_endIndex ! Index of end of substr in str + public :: shr_string_leftAlign ! remove leading white space + public :: shr_string_alphanum ! remove all non alpha-numeric characters + public :: shr_string_betweenTags ! get the substring between the two tags + public :: shr_string_parseCFtunit ! parse CF time units + public :: shr_string_clean ! Set string to all white space + + public :: shr_string_listIsValid ! test for a valid "list" + public :: shr_string_listGetNum ! Get number of fields in list, fn + public :: shr_string_listGetIndex ! Get index of field + public :: shr_string_listGetIndexF ! function version of listGetIndex + public :: shr_string_listGetName ! get k-th field name + public :: shr_string_listIntersect ! get intersection of two field lists + public :: shr_string_listUnion ! get union of two field lists + public :: shr_string_listMerge ! merge two lists to form third + public :: shr_string_listAppend ! append list at end of another + public :: shr_string_listPrepend ! prepend list in front of another + public :: shr_string_listSetDel ! Set field delimeter in lists + public :: shr_string_listGetDel ! Get field delimeter in lists + + public :: shr_string_setAbort ! set local abort flag + public :: shr_string_setDebug ! set local debug flag + +! !PUBLIC DATA MEMBERS: + + ! no public data members + +!EOP + + character(len=1) ,save :: listDel = ":" ! note single exec implications + character(len=2) ,save :: listDel2 = "::" ! note single exec implications + logical ,save :: doabort = .true. + integer(SHR_KIND_IN),save :: debug = 0 + +!=============================================================================== +contains +!=============================================================================== + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_countChar -- Count number of occurances of a character +! +! !DESCRIPTION: +! count number of occurances of a single character in a string +! \newline +! n = shr\_string\_countChar(string,character) +! +! !REVISION HISTORY: +! 2005-Feb-28 - First version from dshr_bundle +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_countChar(str,char,rc) + + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: str ! string to search + character(1) ,intent(in) :: char ! char to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: count ! counts occurances of char + integer(SHR_KIND_IN) :: n ! generic index + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_countChar) " + character(*),parameter :: F00 = "('(shr_string_countChar) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == char) count = count + 1 + end do + shr_string_countChar = count + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_countChar + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_toUpper -- Convert string to upper case +! +! !DESCRIPTION: +! Convert the input string to upper-case. +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! !REVISION HISTORY: +! 2005-Dec-20 - Move CAM version over to shared code. +! +! !INTERFACE: ------------------------------------------------------------------ + +function shr_string_toUpper(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to upper case + character(len=len(str)) :: shr_string_toUpper + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: aseq ! ascii collating sequence + integer(SHR_KIND_IN) :: LowerToUpper ! integer to convert case + character(len=1) :: ctmp ! Character temporary + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_toUpper) " + character(*),parameter :: F00 = "('(shr_string_toUpper) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + LowerToUpper = iachar("A") - iachar("a") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + LowertoUpper) + shr_string_toUpper(i:i) = ctmp + end do + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_toUpper + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_toLower -- Convert string to lower case +! +! !DESCRIPTION: +! Convert the input string to lower-case. +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! !REVISION HISTORY: +! 2006-Apr-20 - Creation +! +! !INTERFACE: ------------------------------------------------------------------ +function shr_string_toLower(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: shr_string_toLower + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: aseq ! ascii collating sequence + integer(SHR_KIND_IN) :: UpperToLower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_toLower) " + character(*),parameter :: F00 = "('(shr_string_toLower) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + UpperToLower = iachar("a") - iachar("A") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + UpperToLower) + shr_string_toLower(i:i) = ctmp + end do + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_toLower + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_getParentDir -- For pathname get the parent directory name +! +! !DESCRIPTION: +! Get the parent directory name for a pathname. +! +! !REVISION HISTORY: +! 2006-May-09 - Creation +! +! !INTERFACE: ------------------------------------------------------------------ + +function shr_string_getParentDir(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: shr_string_getParentDir + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: nlen ! Length of string + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_getParentDir) " + character(*),parameter :: F00 = "('(shr_string_getParentDir) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + nlen = len_trim(str) + if ( str(nlen:nlen) == "/" ) nlen = nlen - 1 + i = index( str(1:nlen), "/", back=.true. ) + if ( i == 0 )then + shr_string_getParentDir = str + else + shr_string_getParentDir = str(1:i-1) + end if + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_getParentDir + +!=============================================================================== +!BOP =========================================================================== +! +! +! !IROUTINE: shr_string_lastIndex -- Get index of last substr within string +! +! !DESCRIPTION: +! Get index of last substr within string +! \newline +! n = shr\_string\_lastIndex(string,substring) +! +! !REVISION HISTORY: +! 2005-Feb-28 - First version from dshr_domain +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_lastIndex(string,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: substr ! sub-string to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_lastIndex) " + character(*),parameter :: F00 = "('(shr_string_lastIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Note: +! - "new" F90 back option to index function makes this home-grown solution obsolete +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + shr_string_lastIndex = index(string,substr,.true.) + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_lastIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_endIndex -- Get the ending index of substr within string +! +! !DESCRIPTION: +! Get the ending index of substr within string +! \newline +! n = shr\_string\_endIndex(string,substring) +! +! !REVISION HISTORY: +! 2005-May-10 - B. Kauffman, first version. +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_endIndex(string,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: substr ! sub-string to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: i ! generic index + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_endIndex) " + character(*),parameter :: F00 = "('(shr_string_endIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! * returns zero if substring not found, uses len_trim() intrinsic +! * very similar to: i = index(str,substr,back=.true.) +! * do we need this function? +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + i = index(trim(string),trim(substr)) + if ( i == 0 ) then + shr_string_endIndex = 0 ! substr is not in string + else + shr_string_endIndex = i + len_trim(substr) - 1 + end if + +! ------------------------------------------------------------------- +! i = index(trim(string),trim(substr),back=.true.) +! if (i == len(string)+1) i = 0 +! shr_string_endIndex = i +! ------------------------------------------------------------------- + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_endIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_leftAlign -- remove leading white space +! +! !DESCRIPTION: +! Remove leading white space +! \newline +! call shr\_string\_leftAlign(string) +! +! !REVISION HISTORY: +! 2005-Apr-28 - B. Kauffman - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_leftAlign(str,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: str + integer(SHR_KIND_IN),intent(out) ,optional :: rc ! return code + +!EOP + + !----- local ---- + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_leftAlign) " + character(*),parameter :: F00 = "('(shr_string_leftAlign) ',4a)" + +!------------------------------------------------------------------------------- +! note: +! * ?? this routine isn't needed, use the intrisic adjustL instead ?? +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + +! ------------------------------------------------------------------- +! --- I used this until I discovered the intrinsic function below - BK +! do while (len_trim(str) > 0 ) +! if (str(1:1) /= ' ') exit +! str = str(2:len_trim(str)) +! end do +! rCode = 0 +! !! (len_trim(str) == 0 ) rCode = 1 ! ?? appropriate ?? +! ------------------------------------------------------------------- + + str = adjustL(str) + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_leftAlign + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_alphanum -- remove non alpha numeric characters +! +! !DESCRIPTION: +! Remove all non alpha numeric characters from string +! \newline +! call shr\_string\_alphanum(string) +! +! !REVISION HISTORY: +! 2005-Aug-01 - T. Craig - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_alphanum(str,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: str + integer(SHR_KIND_IN),intent(out) ,optional :: rc ! return code + +!EOP + + !----- local ---- + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: n,icnt ! counters + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_alphaNum) " + character(*),parameter :: F00 = "('(shr_string_alphaNum) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + icnt = 0 + do n=1,len_trim(str) + if ((str(n:n) >= 'a' .and. str(n:n) <= 'z') .or. & + (str(n:n) >= 'A' .and. str(n:n) <= 'Z') .or. & + (str(n:n) >= '0' .and. str(n:n) <= '9')) then + icnt = icnt + 1 + str(icnt:icnt) = str(n:n) + endif + enddo + do n=icnt+1,len(str) + str(n:n) = ' ' + enddo + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_alphanum + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_betweenTags -- Get the substring between the two tags. +! +! !DESCRIPTION: +! Get the substring found between the start and end tags. +! \newline +! call shr\_string\_betweenTags(string,startTag,endTag,substring,rc) +! +! !REVISION HISTORY: +! 2005-May-11 - B. Kauffman, first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_betweenTags(string,startTag,endTag,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: startTag ! start tag + character(*) ,intent(in) :: endTag ! end tag + character(*) ,intent(out) :: substr ! sub-string between tags + integer(SHR_KIND_IN),intent(out),optional :: rc ! retrun code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: iStart ! substring start index + integer(SHR_KIND_IN) :: iEnd ! substring end index + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_betweenTags) " + character(*),parameter :: F00 = "('(shr_string_betweenTags) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! * assumes the leading/trailing white space is not part of start & end tags +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + iStart = shr_string_endIndex(string,trim(adjustL(startTag))) ! end of start tag + iEnd = index(string,trim(adjustL(endTag ))) ! start of end tag + + rCode = 0 + substr = "" + + if (iStart < 1) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: can't find start tag in string" + write(s_logunit,F00) "ERROR: start tag = ",trim(startTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 1 + else if (iEnd < 1) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: can't find end tag in string" + write(s_logunit,F00) "ERROR: end tag = ",trim( endTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 2 + else if ( iEnd <= iStart) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: start tag not before end tag" + write(s_logunit,F00) "ERROR: start tag = ",trim(startTag) + write(s_logunit,F00) "ERROR: end tag = ",trim( endTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 3 + else if ( iStart+1 == iEnd ) then + substr = "" + if (s_loglev > 0) write(s_logunit,F00) "WARNING: zero-length substring found in ",trim(string) + else + substr = string(iStart+1:iEnd-1) + if (len_trim(substr) == 0 .and. s_loglev > 0) & + & write(s_logunit,F00) "WARNING: white-space substring found in ",trim(string) + end if + + if (present(rc)) rc = rCode + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_betweenTags + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_parseCFtunit -- Parse CF time unit +! +! !DESCRIPTION: +! Parse CF time unit into a delta string name and a base time in yyyymmdd +! and seconds (nearest integer actually). +! \newline +! call shr\_string\_parseCFtunit(string,substring) +! \newline +! Input string is like "days since 0001-06-15 15:20:45.5 -6:00" +! - recognizes "days", "hours", "minutes", "seconds" +! - must have at least yyyy-mm-dd, hh:mm:ss.s is optional +! - expects a "since" in the string +! - ignores time zone part +! +! !REVISION HISTORY: +! 2005-May-15 - T. Craig - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_parseCFtunit(string,unit,bdate,bsec,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(out) :: unit ! delta time unit + integer(SHR_KIND_IN),intent(out) :: bdate ! base date yyyymmdd + real(SHR_KIND_R8) ,intent(out) :: bsec ! base seconds + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: i,i1,i2 ! generic index + character(SHR_KIND_CL) :: tbase ! baseline time + character(SHR_KIND_CL) :: lstr ! local string + integer(SHR_KIND_IN) :: yr,mo,da,hr,min ! time stuff + real(SHR_KIND_R8) :: sec ! time stuff + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_parseCFtunit) " + character(*),parameter :: F00 = "('(shr_string_parseCFtunit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! o assume length of CF-1.0 time attribute char string < SHR_KIND_CL +! This is a reasonable assumption. +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + unit = 'none' + bdate = 0 + bsec = 0.0_SHR_KIND_R8 + + i = shr_string_lastIndex(string,'days ') + if (i > 0) unit = 'days' + i = shr_string_lastIndex(string,'hours ') + if (i > 0) unit = 'hours' + i = shr_string_lastIndex(string,'minutes ') + if (i > 0) unit = 'minutes' + i = shr_string_lastIndex(string,'seconds ') + if (i > 0) unit = 'seconds' + + if (trim(unit) == 'none') then + write(s_logunit,F00) ' ERROR time unit unknown' + call shr_string_abort(subName//' time unit unknown') + endif + + i = shr_string_lastIndex(string,' since ') + if (i < 1) then + write(s_logunit,F00) ' ERROR since does not appear in unit attribute for time ' + call shr_string_abort(subName//' no since in attr name') + endif + tbase = trim(string(i+6:)) + call shr_string_leftAlign(tbase) + + if (debug > 0 .and. s_logunit > 0) then + write(s_logunit,*) trim(subName)//' '//'unit '//trim(unit) + write(s_logunit,*) trim(subName)//' '//'tbase '//trim(tbase) + endif + + yr=0; mo=0; da=0; hr=0; min=0; sec=0 + i1 = 1 + + i2 = index(tbase,'-') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) yr + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,'-') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) mo + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,' ') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) da + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,':') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) hr + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,':') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) min + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,' ') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) sec + +100 continue + + if (debug > 0 .and. s_loglev > 0) write(s_logunit,*) trim(subName),'ymdhms:',yr,mo,da,hr,min,sec + + bdate = abs(yr)*10000 + mo*100 + da + if (yr < 0) bdate = -bdate + bsec = real(hr*3600 + min*60,SHR_KIND_R8) + sec + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + return + +200 continue + write(s_logunit,F00) 'ERROR 200 on char num read ' + call shr_string_abort(subName//' ERROR on char num read') + if (debug>1) call shr_timer_stop (t01) + return + +end subroutine shr_string_parseCFtunit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_clean -- Clean a string, set it to "blank" +! +! !DESCRIPTION: +! Clean a string, set it to blank +! \newline +! call shr\_string\_clean(string,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_clean(string,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: string ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! counter + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_clean) " + character(*),parameter :: F00 = "('(shr_string_clean) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + string = ' ' + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_clean + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listIsValid -- determine whether string is a valid list +! +! !DESCRIPTION: +! Determine whether string is a valid list +! \newline +! logical_var = shr\_string\_listIsValid(list,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - B. Kauffman +! +! !INTERFACE: ------------------------------------------------------------------ + +logical function shr_string_listIsValid(list,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer (SHR_KIND_IN) :: nChar ! lenth of list + integer (SHR_KIND_IN) :: rCode ! return code + integer (SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listIsValid) " + character(*),parameter :: F00 = "('(shr_string_listIsValid) ',4a)" + +!------------------------------------------------------------------------------- +! check that the list conforms to the list format +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + shr_string_listIsValid = .true. + + nChar = len_trim(list) + if (nChar < 1) then ! list is an empty string + rCode = 1 + else if ( list(1:1) == listDel ) then ! first char is delimiter + rCode = 2 + else if (list(nChar:nChar) == listDel ) then ! last char is delimiter + rCode = 3 + else if (index(trim(list)," " ) > 0) then ! white-space in a field name + rCode = 4 + else if (index(trim(list),listDel2) > 0) then ! found zero length field + rCode = 5 + end if + + if (rCode /= 0) then + shr_string_listIsValid = .false. + if (s_loglev > 0) write(s_logunit,F00) "WARNING: invalid list = ",trim(list) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listIsValid + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetName -- Get name of k-th field in list +! +! !DESCRIPTION: +! Get name of k-th field in list +! \newline +! call shr\_string\_listGetName(list,k,name,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - B. Kauffman +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetName(list,k,name,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list ! list/string + integer(SHR_KIND_IN) ,intent(in) :: k ! index of field + character(*) ,intent(out) :: name ! k-th name in list + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: i,j,n ! generic indecies + integer(SHR_KIND_IN) :: kFlds ! number of fields in list + integer(SHR_KIND_IN) :: i0,i1 ! name = list(i0:i1) + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetName) " + character(*),parameter :: F00 = "('(shr_string_listGetName) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + + !--- check that this is a valid list --- + if (.not. shr_string_listIsValid(list,rCode) ) then + write(s_logunit,F00) "ERROR: invalid list = ",trim(list) + call shr_string_abort(subName//" ERROR: invalid list = "//trim(list)) + end if + + !--- check that this is a valid index --- + kFlds = shr_string_listGetNum(list) + if (k<1 .or. kFlds1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetName + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listIntersect -- Get intersection of two field lists +! +! !DESCRIPTION: +! Get intersection of two fields lists, write into third list +! \newline +! call shr\_string\_listIntersect(list1,list2,listout) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listIntersect(list1,list2,listout,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: nf,n1,n2 ! counters + character(SHR_KIND_CS) :: name ! field name + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listIntersect) " + character(*),parameter :: F00 = "('(shr_string_listIntersect) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + + nf = shr_string_listGetNum(list1) + call shr_string_clean(listout) + do n1 = 1,nf + call shr_string_listGetName(list1,n1,name,rCode) + n2 = shr_string_listGetIndexF(list2,name) + if (n2 > 0) then + call shr_string_listAppend(listout,name) + endif + enddo + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listIntersect + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listUnion -- Get union of two field lists +! +! !DESCRIPTION: +! Get union of two fields lists, write into third list +! \newline +! call shr\_string\_listUnion(list1,list2,listout) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listUnion(list1,list2,listout,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: nf,n1,n2 ! counters + character(SHR_KIND_CS) :: name ! field name + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listUnion) " + character(*),parameter :: F00 = "('(shr_string_listUnion) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + call shr_string_clean(listout) + + nf = shr_string_listGetNum(list1) + do n1 = 1,nf + call shr_string_listGetName(list1,n1,name,rCode) + n2 = shr_string_listGetIndexF(listout,name) + if (n2 < 1) then + call shr_string_listAppend(listout,name) + endif + enddo + + nf = shr_string_listGetNum(list2) + do n1 = 1,nf + call shr_string_listGetName(list2,n1,name,rCode) + n2 = shr_string_listGetIndexF(listout,name) + if (n2 < 1) then + call shr_string_listAppend(listout,name) + endif + enddo + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listUnion + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listMerge -- Merge lists two list to third +! +! !DESCRIPTION: +! Merge two list to third +! \newline +! call shr\_string\_listMerge(list1,list2,listout) +! call shr\_string\_listMerge(list1,list2,list1) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listMerge(list1,list2,listout,rc) + + implicit none +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1,l2 ! local char strings + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listMerge) " + character(*),parameter :: F00 = "('(shr_string_listMerge) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp strings are large enough --- + if ( (len(l1) < len_trim(list1)) .or. (len(l2) < len_trim(list2))) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + call shr_string_clean(l2) + call shr_string_clean(listout) + l1 = trim(list1) + l2 = trim(list2) + call shr_string_leftAlign(l1,rCode) + call shr_string_leftAlign(l2,rCode) + if (len_trim(l1)+len_trim(l2)+1 > len(listout)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(l1) == 0) then + listout = trim(l2) + else + listout = trim(l1)//":"//trim(l2) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listMerge + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listAppend -- Append one list to another +! +! !DESCRIPTION: +! Append one list to another +! \newline +! call shr\_string\_listAppend(list,listadd) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listAppend(list,listadd,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: list ! list/string + character(*) ,intent(in) :: listadd ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1 ! local string + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listAppend) " + character(*),parameter :: F00 = "('(shr_string_listAppend) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp string is large enough --- + if (len(l1) < len_trim(listAdd)) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + l1 = trim(listadd) + call shr_string_leftAlign(l1,rCode) + if (len_trim(list)+len_trim(l1)+1 > len(list)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(list) == 0) then + list = trim(l1) + else + list = trim(list)//":"//trim(l1) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listAppend + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listPrepend -- Prepend one list to another +! +! !DESCRIPTION: +! Prepend one list to another +! \newline +! call shr\_string\_listPrepend(listadd,list) +! \newline +! results in listadd:list +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listPrepend(listadd,list,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: listadd ! list/string + character(*) ,intent(inout) :: list ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1 ! local string + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listPrepend) " + character(*),parameter :: F00 = "('(shr_string_listPrepend) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp string is large enough --- + if (len(l1) < len_trim(listAdd)) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + l1 = trim(listadd) + call shr_string_leftAlign(l1,rCode) + call shr_string_leftAlign(list,rCode) + if (len_trim(list)+len_trim(l1)+1 > len(list)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(l1) == 0) then + list = trim(list) + else + list = trim(l1)//":"//trim(list) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listPrepend + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetIndexF -- Get index of field in string +! +! !DESCRIPTION: +! Get index of field in string +! \newline +! k = shr\_string\_listGetIndex(str,"taux") +! +! !REVISION HISTORY: +! 2005-Feb-28 - B. Kauffman and J. Schramm - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_listGetIndexF(string,fldStr) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: string ! string + character(*),intent(in) :: fldStr ! name of field + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: k ! local index variable + integer(SHR_KIND_IN) :: rc ! error code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetIndexF) " + character(*),parameter :: F00 = "('(shr_string_listGetIndexF) ',4a)" + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + call shr_string_listGetIndex(string,fldStr,k,print=.false.,rc=rc) + shr_string_listGetIndexF = k + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listGetIndexF + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetIndex -- Get index of field in string +! +! !DESCRIPTION: +! Get index of field in string +! \newline +! call shr\_string\_listGetIndex(str,"taux",k,rc) +! +! !REVISION HISTORY: +! 2005-Feb-28 - B. Kauffman and J. Schramm - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetIndex(string,fldStr,kFld,print,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string + character(*) ,intent(in) :: fldStr ! name of field + integer(SHR_KIND_IN),intent(out) :: kFld ! index of field + logical ,intent(in) ,optional :: print ! print switch + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! index for colon position + integer(SHR_KIND_IN) :: k ! index for field name position + integer(SHR_KIND_IN) :: nFields ! number of fields in a string + integer(SHR_KIND_IN) :: i0,i1 ! fldStr == string(i0,i1) ?? + integer(SHR_KIND_IN) :: j0,j1 ! fldStr == string(j0,j1) ?? + logical :: found ! T => field found in fieldNames + logical :: lprint ! local print flag + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetIndex) " + character(*),parameter :: F00 = "('(shr_string_listGetIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - searching from both ends of the list at the same time seems to be 20% faster +! but I'm not sure why (B. Kauffman, Feb 2007) +! - I commented out sanity check to a little gain speed (B. Kauffman, Mar 2007) +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + if (present(rc)) rc = 0 + + lprint = .false. + if (present(print)) lprint = print + + !--- confirm proper size of input data --- + if (len_trim(fldStr) < 1) then + if (lprint) write(s_logunit,F00) "ERROR: input field name has 0 length" + call shr_string_abort(subName//"invalid field name") + end if + + !--- search for field name in string's list of fields --- + found = .false. + kFld = 0 + i0 = 1 ! ?? fldStr == string(i0:i1) ?? + i1 = -1 + j0 = -1 ! ?? fldStr == string(j0:j1) ?? + j1 = len_trim(string) + nFields = shr_string_listGetNum(string) + do k = 1,nFields + !-------------------------------------------------------- + ! search from end of list to end of list + !-------------------------------------------------------- + !--- get end index of of field number k --- + n = index(string(i0:len_trim(string)),listDel) + if (n > 0) then + i1 = i0 + n - 2 ! *not* the last field name in fieldNames + else + i1 = len_trim(string) ! this is the last field name in fieldNames + endif + !--- sanity check --- + ! if ((k 0)) then + ! call shr_string_abort(subName//"ERROR: wrong string%nf ?") + ! end if + !--- is it a match? --- + if (trim(fldStr) == string(i0:i1)) then + found = .true. + kFld = k + exit + endif + i0 = i1 + 2 ! start index for next iteration + !-------------------------------------------------------- + ! search from end of list to start of list + !-------------------------------------------------------- + !--- get start index of field number (nFields + 1 - k ) --- + n = index(string(1:j1),listDel,back=.true.) + j0 = n + 1 ! n==0 => the first field name in fieldNames + !--- sanity check --- + ! if ((k 0)) then + ! call shr_string_abort(subName//"ERROR: wrong string%nf ?") + ! end if + !--- is it a match? --- + if (trim(fldStr) == string(j0:j1)) then + found = .true. + kFld = nFields + 1 - k + exit + endif + j1 = j0 - 2 ! end index for next iteration + !-------------------------------------------------------- + ! exit if all field names have been checked + !-------------------------------------------------------- + if (2*k >= nFields) exit + end do + + !--- not finding a field is not a fatal error --- + if (.not. found) then + kFld = 0 + if (lprint .and. s_loglev > 0) write(s_logunit,F00) "FYI: field ",trim(fldStr)," not found in list ",trim(string) + if (present(rc)) rc = 1 + end if + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetNum -- get number of fields in a string list +! +! !DESCRIPTION: +! return number of fields in string list +! +! !REVISION HISTORY: +! 2005-Apr-28 - T. Craig - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_listGetNum(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: str ! string to search + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: count ! counts occurances of char + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetNum) " + character(*),parameter :: F00 = "('(shr_string_listGetNum) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + shr_string_listGetNum = 0 + + if (len_trim(str) > 0) then + count = shr_string_countChar(str,listDel) + shr_string_listGetNum = count + 1 + endif + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listGetNum + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listSetDel -- Set list delimeter character +! +! !DESCRIPTION: +! Set field delimeter character in lists +! \newline +! call shr\_string\_listSetDel(":") +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listSetDel(cflag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(len=1),intent(in) :: cflag + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_listSetDel) " + character(*),parameter :: F00 = "('(shr_string_listSetDel) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + if (debug > 0 .and. s_loglev > 0) write(s_logunit,F00) 'changing listDel from '//trim(listDel)//' to '//trim(cflag) + listDel = trim(cflag) + listDel2 = listDel//listDel + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listSetDel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetDel -- Get list delimeter character +! +! !DESCRIPTION: +! Get field delimeter character in lists +! \newline +! call shr\_string\_listGetDel(del) +! +! !REVISION HISTORY: +! 2005-May-15 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetDel(del) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(out) :: del + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_listGetDel) " + character(*),parameter :: F00 = "('(shr_string_listGetDel) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + del = trim(listDel) + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetDel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_setAbort -- Set local shr_string abort flag +! +! !DESCRIPTION: +! Set local shr_string abort flag, true = abort, false = print and continue +! \newline +! call shr\_string\_setAbort(.false.) +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_setAbort(flag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + logical,intent(in) :: flag + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_setAbort) " + character(*),parameter :: F00 = "('(shr_string_setAbort) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + if (debug > 0 .and. s_loglev > 0) then + if (flag) then + write(s_logunit,F00) 'setting abort to true' + else + write(s_logunit,F00) 'setting abort to false' + endif + endif + + doabort = flag + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_setAbort + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_setDebug -- Set local shr_string debug level +! +! !DESCRIPTION: +! Set local shr_string debug level, 0 = production +! \newline +! call shr\_string\_setDebug(2) +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_setDebug(iFlag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: iFlag ! requested debug level + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_setDebug) " + character(*),parameter :: F00 = "('(shr_string_setDebug) ',a) " + character(*),parameter :: F01 = "('(shr_string_setDebug) ',a,i3,a,i3) " + +!------------------------------------------------------------------------------- +! NTOE: write statement can be expensive if called many times. +!------------------------------------------------------------------------------- + + if (iFlag>1 .and. t01<1) call shr_timer_get(t01,subName) + if (iFlag>1) call shr_timer_start(t01) + +! if (s_loglev > 0) write(s_logunit,F01) 'changing debug level from ',debug,' to ',iflag + debug = iFlag + + if (iFlag>1) call shr_timer_stop (t01) + +end subroutine shr_string_setDebug + +!=============================================================================== +!=============================================================================== + +subroutine shr_string_abort(string) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),optional,intent(in) :: string + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- local --- + character(SHR_KIND_CX) :: lstring + character(*),parameter :: subName = "(shr_string_abort)" + character(*),parameter :: F00 = "('(shr_string_abort) ',a)" + +!------------------------------------------------------------------------------- +! NOTE: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + lstring = '' + if (present(string)) lstring = string + + if (doabort) then + call shr_sys_abort(trim(lstring)) + else + write(s_logunit,F00) ' no abort:'//trim(lstring) + endif + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_abort + +!=============================================================================== +!=============================================================================== + +end module shr_string_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_sys_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_sys_mod.F90 new file mode 100644 index 0000000000..500ac40698 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_sys_mod.F90 @@ -0,0 +1,355 @@ +!=============================================================================== +! SVN $Id: shr_sys_mod.F90 28978 2011-06-27 20:37:05Z jedwards $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_110803/shr/shr_sys_mod.F90 $ +!=============================================================================== + +MODULE shr_sys_mod + + use shr_kind_mod ! defines real & integer kinds + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + +! PUBLIC: Public interfaces + + private + + public :: shr_sys_system ! make a system call + public :: shr_sys_chdir ! change current working dir + public :: shr_sys_getenv ! get an environment variable + public :: shr_sys_abort ! abort a program + public :: shr_sys_irtc ! returns real-time clock tick + public :: shr_sys_sleep ! have program sleep for a while + public :: shr_sys_flush ! flush an i/o buffer + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_system(str,rcode) + + IMPLICIT none + + !----- arguments --- + character(*) ,intent(in) :: str ! system/shell command string + integer(SHR_KIND_IN),intent(out) :: rcode ! function return error code + + !----- functions ----- +#if (defined CRAY) || (defined UNICOSMP) + integer(SHR_KIND_IN),external :: ishell ! function to envoke shell command +#endif +#if (defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__ && !defined CATAMOUNT)) + integer(SHR_KIND_IN),external :: system ! function to envoke shell command +#endif + + !----- local ----- +#if (defined CATAMOUNT) + character(2*SHR_KIND_CL) :: file1 ! one or two filenames + character( SHR_KIND_CL) :: file2 ! 2nd file name + integer(SHR_KIND_IN) :: iloc ! index/location within a string +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_system) ' + character(*),parameter :: F00 = "('(shr_sys_system) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +! NOTE: +! - for Catamount (Cray, pheonix at ORNL) there is no system call -- workarounds +! exist only for simple "rm" and "cp" commands +!------------------------------------------------------------------------------- + + +#if (defined CRAY) || (defined UNICOSMP) + + rcode=ishell(str) + +#elif (defined IRIX64 || defined NEC_SX) + + rcode = 0 + call system(str) + +#elif (defined AIX) + + call system(str,rcode) + +#elif (defined OSF1 || defined SUNOS || defined __GFORTRAN__ || (defined LINUX && !defined CATAMOUNT)) + + rcode = system(str) + +#elif (defined CATAMOUNT) + if (str(1:3) == 'rm ') then + call unlink(str(4:)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT unlink ',trim(str(4:)) + rcode = 0 + elseif (str(1:3) == 'mv ') then + file1 = str(4:) + iloc = index(file1,' ') + 3 + if (iloc < 6) then + if (s_loglev > 0) write(s_logunit,*) 'CATAMOUNT mv error ',trim(str),iloc + rcode = -1 + else + file1 = str(4:iloc) + file2 = str(iloc+1:) + call rename(trim(file1),trim(file2)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT rename ',trim(file1)," ",trim(file2) + rcode = 0 + endif + else + rcode = -1 + endif + +#else + + write(s_logunit,F00) 'ERROR: no implementation of system call for this architecture' + call shr_sys_abort(subName//'no implementation of system call for this architecture') + +#endif + +END SUBROUTINE shr_sys_system + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_chdir(path, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: path ! chdir to this dir + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenpath ! length of path +#if (defined AIX || defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__) || defined NEC_SX) + integer(SHR_KIND_IN),external :: chdir ! AIX system call +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_chdir) ' + character(*),parameter :: F00 = "('(shr_sys_chdir) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenpath=len_trim(path) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfchdir(path, lenpath, rcode) + +#elif (defined AIX) + + rcode = chdir(%ref(path(1:lenpath)//'\0')) + +#elif (defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + rcode=chdir(path(1:lenpath)) + +#else + + write(s_logunit,F00) 'ERROR: no implementation of chdir for this architecture' + call shr_sys_abort(subname//'no implementation of chdir for this machine') + +#endif + +END SUBROUTINE shr_sys_chdir + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_getenv(name, val, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: name ! env var name + character(*) ,intent(out) :: val ! env var value + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenname ! length of env var name + integer(SHR_KIND_IN) :: lenval ! length of env var value + character(SHR_KIND_CL) :: tmpval ! temporary env var value + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_getenv) ' + character(*),parameter :: F00 = "('(shr_sys_getenv) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenname=len_trim(name) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfgetenv(name, lenname, val, lenval, rcode) + +#elif (defined AIX || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + call getenv(trim(name),tmpval) + val=trim(tmpval) + rcode = 0 + if (len_trim(val) == 0 ) rcode = 1 + if (len_trim(val) > SHR_KIND_CL) rcode = 2 + +#else + + write(s_logunit,F00) 'ERROR: no implementation of getenv for this architecture' + call shr_sys_abort(subname//'no implementation of getenv for this machine') + +#endif + +END SUBROUTINE shr_sys_getenv + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_abort(string,rc) + + IMPLICIT none + + character(*) ,optional :: string ! error message string + integer(SHR_KIND_IN),optional :: rc ! error code + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_abort) ' + character(*),parameter :: F00 = "('(shr_sys_abort) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: consistent stopping mechanism +!------------------------------------------------------------------------------- + + call shr_sys_flush(s_logunit) + if (len_trim(string) > 0) write(s_logunit,F00) 'ERROR: '//trim(string) + write(s_logunit,F00) 'WARNING: stopping' + call shr_sys_flush(s_logunit) + call abort() + stop + +END SUBROUTINE shr_sys_abort + +!=============================================================================== +!=============================================================================== + +integer(SHR_KIND_I8) FUNCTION shr_sys_irtc( rate ) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_I8), optional :: rate + + !----- local ----- + integer(SHR_KIND_IN) :: count + integer(SHR_KIND_IN) :: count_rate + integer(SHR_KIND_IN) :: count_max + integer(SHR_KIND_IN),save :: last_count = -1 + integer(SHR_KIND_I8),save :: count_offset = 0 + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_irtc) ' + character(*),parameter :: F00 = "('(shr_sys_irtc) ',4a)" + +!------------------------------------------------------------------------------- +! emulates Cray/SGI irtc function (returns clock tick since last reboot) +!------------------------------------------------------------------------------- + + call system_clock(count=count,count_rate=count_rate, count_max=count_max) + if ( present(rate) ) rate = count_rate + shr_sys_irtc = count + + !--- adjust for clock wrap-around --- + if ( last_count /= -1 ) then + if ( count < last_count ) count_offset = count_offset + count_max + end if + shr_sys_irtc = shr_sys_irtc + count_offset + last_count = count + +END FUNCTION shr_sys_irtc + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_sleep(sec) + + IMPLICIT none + + !----- arguments ----- + real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep + + !----- local ----- + integer(SHR_KIND_IN) :: isec ! integer number of seconds + integer(SHR_KIND_IN) :: rcode ! return code + character(90) :: str ! system call string + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_sleep) ' + character(*),parameter :: F00 = "('(shr_sys_sleep) ',4a)" + character(*),parameter :: F10 = "('sleep ',i8 )" + +!------------------------------------------------------------------------------- +! PURPOSE: Sleep for approximately sec seconds +!------------------------------------------------------------------------------- + + isec = nint(sec) + + if (isec < 0) then + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: seconds must be > 0, sec=',sec + else if (isec == 0) then + ! Don't consider this an error and don't call system sleep + else +#if defined(CATAMOUNT) + call sleep(isec) +#else + write(str,FMT=F10) isec + call shr_sys_system( str, rcode ) +#endif + endif + +END SUBROUTINE shr_sys_sleep + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_flush(unit) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_flush) ' + character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + +#if (defined IRIX64 || defined CRAY || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX || defined UNICOSMP) + + call flush(unit) + +#elif (defined AIX) + + call flush_(unit) + +#else + + if (s_loglev > 0) write(s_logunit,F00) 'WARNING: no implementation of flush for this architecture' + +#endif + +END SUBROUTINE shr_sys_flush + +!=============================================================================== +!=============================================================================== + +END MODULE shr_sys_mod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/src/shr_timer_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_timer_mod.F90 new file mode 100644 index 0000000000..a764c7e1c1 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/src/shr_timer_mod.F90 @@ -0,0 +1,428 @@ +!=============================================================================== +! SVN $Id: shr_timer_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_timer_mod.F90 $ +!=============================================================================== + +module shr_timer_mod + + !---------------------------------------------------------------------------- + ! + ! routines that support multiple CPU timers via F90 intrinsics + ! + ! Note: + ! o if an operation is requested on an invalid timer number n + ! then nothing is done in a routine + ! o if more than max_timers are requested, + ! then timer n=max_timers is "overloaded" and becomes invalid/undefined + ! + ! * cpp if-defs were introduced in 2005 to work-around a bug in the ORNL Cray + ! X1 F90 intrinsic system_clock() function -- ideally this Cray bug would be + ! fixed and cpp if-defs would be unnecessary and removed. + ! + ! !REVISION HISTORY: + ! 2005-??-?? - added workaround for Cray F90 bug, mods by Cray/ORNL + ! 2000-??-?? - 1st version by B. Kauffman + !---------------------------------------------------------------------------- + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + + private ! restricted access + + public :: shr_timer_init + public :: shr_timer_get + public :: shr_timer_start + public :: shr_timer_stop + public :: shr_timer_print + public :: shr_timer_print_all + public :: shr_timer_check + public :: shr_timer_check_all + public :: shr_timer_zero + public :: shr_timer_zero_all + public :: shr_timer_free + public :: shr_timer_free_all + public :: shr_timer_sleep + + integer(SHR_KIND_IN),parameter :: stat_free = 0 ! timer status constants + integer(SHR_KIND_IN),parameter :: stat_inuse = 1 + integer(SHR_KIND_IN),parameter :: stat_started = 2 + integer(SHR_KIND_IN),parameter :: stat_stopped = 3 + integer(SHR_KIND_IN),parameter :: max_timers = 200 ! max number of timers + + integer(SHR_KIND_IN) :: status (max_timers) ! status of each timer + !---------------------------------------------------------------------------- + ! the following ifdef circumvents a bug in the X1 system_clock function + !---------------------------------------------------------------------------- +#if (defined UNICOSMP) + integer(kind=8) :: cycles1(max_timers) ! cycle number at timer start + integer(kind=8) :: cycles2(max_timers) ! cycle number at timer stop +#else + integer(SHR_KIND_IN) :: cycles1(max_timers) ! cycle number at timer start + integer(SHR_KIND_IN) :: cycles2(max_timers) ! cycle number at timer stop +#endif + integer(SHR_KIND_IN) :: cycles_max = -1 ! max cycles before wrapping + character (len=80) :: name (max_timers) ! name assigned to each timer + real (SHR_KIND_R8) :: dt (max_timers) ! accumulated time + integer(SHR_KIND_IN) :: calls (max_timers) ! # of samples in accumulation + real (SHR_KIND_R8) :: clock_rate ! clock_rate: seconds per cycle + + save + +!=============================================================================== + contains +!=============================================================================== + +subroutine shr_timer_init + + !----- local ----- + integer(SHR_KIND_IN) :: cycles ! count rate return by system clock +#if (defined UNICOSMP) + integer(kind=8) :: irtc_rate +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_init) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine initializes: +! 1) values in all timer array locations +! 2) machine parameters necessary for computing cpu time from F90 intrinsics. +! F90 intrinsic: system_clock(count_rate=cycles, count_max=cycles_max) +!------------------------------------------------------------------------------- + + call shr_timer_free_all + +#if (defined UNICOSMP) + cycles = irtc_rate() +#else + call system_clock(count_rate=cycles, count_max=cycles_max) +#endif + + if (cycles /= 0) then + clock_rate = 1.0_SHR_KIND_R8/real(cycles,SHR_KIND_R8) + else + clock_rate = 0._SHR_KIND_R8 + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: no system clock available' + endif + +end subroutine shr_timer_init + +!=============================================================================== + +subroutine shr_timer_get(n, str) + + !----- arguments ----- + integer(SHR_KIND_IN),intent(out) :: n ! timer number + character (*) ,intent( in) :: str ! text string with timer name + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_get) ',a,i5)" + +!----------------------------------------------------------------------- +! search for next free timer +!----------------------------------------------------------------------- + + do n=1,max_timers + if (status(n) == stat_free) then + status(n) = stat_inuse + name (n) = str + calls (n) = 0 + return + endif + end do + + n=max_timers + name (n) = "" + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: exceeded maximum number of timers' + +end subroutine shr_timer_get + +!=============================================================================== + +subroutine shr_timer_start(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- local ----- +#if (defined UNICOSMP) + integer(kind=8) :: irtc +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_start) ',a,i5)" + +!----------------------------------------------------------------------- +! This routine starts a given timer. +!----------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) call shr_timer_stop(n) + + status(n) = stat_started +#if (defined UNICOSMP) + cycles1(n) = irtc() +#else + call system_clock(count=cycles1(n)) +#endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_start + +!=============================================================================== + +subroutine shr_timer_stop(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- local ----- + real (SHR_KIND_R8) :: elapse ! elapsed time returned by system counter +#if (defined UNICOSMP) + integer(kind=8) :: irtc +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_stop) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine stops a given timer, checks for cycle wrapping, computes the +! elapsed time, and accumulates the elapsed time in the dt(n) array +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if ( status(n) == stat_started) then +#if (defined UNICOSMP) + cycles2(n) = irtc() +#else + call system_clock(count=cycles2(n)) +#endif + if (cycles2(n) >= cycles1(n)) then + dt(n) = dt(n) + clock_rate*(cycles2(n) - cycles1(n)) + else + dt(n) = dt(n) + clock_rate*(cycles_max + cycles2(n) - cycles1(n)) + endif + calls (n) = calls(n) + 1 + status(n) = stat_stopped + end if + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_stop + +!=============================================================================== + +subroutine shr_timer_print(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_print) ',a,i5)" + character(len=*),parameter :: F01 = "('(shr_timer_print) timer',i3,& + & ':',i8,' calls,',f10.3,'s, id: ',a)" +!------------------------------------------------------------------------------- +! prints the accumulated time for a given timer +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) then + call shr_timer_stop(n) + if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n)) + call shr_timer_start(n) + else + if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n)) + endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_print + +!=============================================================================== + +subroutine shr_timer_print_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_print_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! prints accumulated time for all timers in use +!------------------------------------------------------------------------------- + + if (s_loglev > 0) write(s_logunit,F00) 'print all timing info:' + + do n=1,max_timers + if (status(n) /= stat_free) call shr_timer_print(n) + end do + +end subroutine shr_timer_print_all + +!=============================================================================== + +subroutine shr_timer_zero(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_zero) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine resets a given timer. +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + dt(n) = 0.0_SHR_KIND_R8 + calls(n) = 0 + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_zero + +!=============================================================================== + +subroutine shr_timer_zero_all + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_zero_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine resets all timers. +!------------------------------------------------------------------------------- + + dt = 0.0_SHR_KIND_R8 + calls = 0 + +end subroutine shr_timer_zero_all + +!=============================================================================== + +subroutine shr_timer_check(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_check) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine checks a given timer. This is primarily used to +! periodically accumulate time in the timer to prevent timer cycles +! from wrapping around max_cycles. +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) then + call shr_timer_stop (n) + call shr_timer_start(n) + endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_check + +!=============================================================================== + +subroutine shr_timer_check_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_check_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! Call shr_timer_check for all timers in use +!------------------------------------------------------------------------------- + + do n=1,max_timers + if (status(n) == stat_started) then + call shr_timer_stop (n) + call shr_timer_start(n) + endif + end do + +end subroutine shr_timer_check_all + +!=============================================================================== + +subroutine shr_timer_free(n) + + !----- arguments ----- + integer(SHR_KIND_IN),intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_free) ',a,i5)" + +!----------------------------------------------------------------------- +! initialize/free all timer array values +!----------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + status (n) = stat_free + name (n) = "" + dt (n) = 0.0_SHR_KIND_R8 + cycles1(n) = 0 + cycles2(n) = 0 + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_free + +!=============================================================================== + +subroutine shr_timer_free_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_free_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! initialize/free all timer array values +!------------------------------------------------------------------------------- + + do n=1,max_timers + call shr_timer_free(n) + end do + +end subroutine shr_timer_free_all + +!=============================================================================== + +subroutine shr_timer_sleep(sec) + + use shr_sys_mod ! share system calls (namely, shr_sys_sleep) + + !----- local ----- + real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep + +!------------------------------------------------------------------------------- +! Sleep for approximately sec seconds +! +! Note: sleep is typically a system call, hence it is implemented in +! shr_sys_mod, although it probably would only be used in a timing +! context, which is why there is a shr_timer_* wrapper provided here. +!------------------------------------------------------------------------------- + + call shr_sys_sleep(sec) + +end subroutine shr_timer_sleep + +!=============================================================================== +end module shr_timer_mod +!=============================================================================== diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Filepath b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Filepath new file mode 100644 index 0000000000..f5228276ec --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Filepath @@ -0,0 +1,2 @@ +. +../src diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Makefile b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Makefile new file mode 100644 index 0000000000..7260c828d8 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Makefile @@ -0,0 +1,10 @@ +# Makefile for mksurfdata_map unit testing + +EXENAME = ../test_mksurfdata_map + +# Set optimization off by default +ifeq ($(OPT),$(null)) + OPT := FALSE +endif + +include ../src/Makefile.common \ No newline at end of file diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/README b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/README new file mode 100644 index 0000000000..8620c3cc6d --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/README @@ -0,0 +1,6 @@ +This directory contains source code for building unit tests for +mksurfdata_map + +test_mod.F90 was copied from +https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk/unit_testers/test_mod.F90 + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Srcfiles b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Srcfiles new file mode 100644 index 0000000000..21fb90fec0 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/Srcfiles @@ -0,0 +1,21 @@ +test_mksurfdata_map.F90 +test_mkindexmapMod.F90 +test_mkurbanparDomMod.F90 +test_mkutilsMod.F90 +test_mkncdio.F90 +test_mod.F90 +mkindexmapMod.F90 +mkurbanparDomMod.F90 +mkurbanparCommonMod.F90 +mkutilsMod.F90 +mkdomainMod.F90 +mkvarpar.F90 +mkvarctl.F90 +mkgridmapMod.F90 +mkncdio.F90 +nanMod.F90 +shr_const_mod.F90 +shr_kind_mod.F90 +shr_log_mod.F90 +shr_sys_mod.F90 + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc new file mode 100644 index 0000000000..c8fa0887d0 Binary files /dev/null and b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_lookup_2d_netcdf.nc differ diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 new file mode 100644 index 0000000000..2973fe5898 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 @@ -0,0 +1,676 @@ +module test_mkindexmapMod +! Module for testing mkindexmapMod + + use mkindexmapMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_get_dominant_indices + public :: test_filter_same + public :: test_lookup_2d + public :: test_lookup_2d_netcdf + public :: test_which_max + + character(len=*), parameter :: modname = 'test_mkindexmapMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_get_dominant_indices + + use mkgridmapMod, only : gridmap_type + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + integer, allocatable :: src_array(:) + integer, allocatable :: dst_array(:) + integer, allocatable :: dst_array_t(:) + logical, allocatable :: filter(:) + integer :: minval, maxval, nodata + + character(len=*), parameter :: subname = 'test_get_dominant_indices' + + ! Set up a gridmap that will be used for most tests, and allocate corresponding + ! arrays: + ! Note that, for most tests here, the test arrays are: (1) simple case, (2) the main + ! case to test, (3) simple case. Thus, the main case in question is #2 of 3, and + ! we're always basically just testing one scenario in each call to the subroutine + ! (rather than doing a bunch of tests at once, which could make setting up the test + ! arrays more error-prone). + + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + ! Note: I'm not setting some things that aren't used in get_dominant_indices + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75,0.25, & ! weights of sources 1:2 on dest 1 + 0.1,0.1,0.1,0.3,0.2,0.2,0.2, & ! weights of sources 2:8 on dest 2 + 0.25,0.75/) ! weights of sources 8:9 on test 3 + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb), & + filter (gridmap%ns)) + + testname = 'basic test, all unique' + src_array = (/1, 2, 3, 4, 5, 6, 7, 8, 9/) + minval = 1 + maxval = 9 + nodata = -1 + ! dst 2 takes its value from src 5 because it has the largest weight: + dst_array_t = (/1, 5, 9/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'basic test, some duplicates' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'minval not 1' + src_array = (/3, 4, 5, 5, 6, 4, 4, 3, 3/) + minval = 3 + maxval = 6 + nodata = -1 + dst_array_t = (/3, 4, 3/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'single non-zero source value' + src_array = (/1, 0, 0, 0, 0, 2, 0, 0, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'single value within given min-max range' + src_array = (/1, 0, 9, 9, 0, 2, 9, 9, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'no valid values' + src_array = (/1, 0, 9, 9, 0, 0, 9, 9, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'some filters false' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + filter = (/.true., .true., & + .false., .true., .true., .true., .false., .true., .true., & + .true., .true./) + dst_array_t = (/1, 4, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter=filter) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'all filters false' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + filter = (/.true., .true., & + .false., .false., .false., .false., .false., .false., .false., & + .true., .true./) + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter=filter) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + ! Modify gridmap weights for the following test + gridmap%wovr = (/0.75,0.25, & ! weights of sources 1:2 on dest 1 + 0.0,0.0,0.0,0.0,0.0,0.0,0.0, & ! weights of sources 2:8 on dest 2 + 0.25,0.75/) ! weights of sources 8:9 on test 3 + testname='all weights 0' + src_array = (/1, 1, 1, 1, 1, 1, 1, 1, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + ! Make a new gridmap for the following test; + ! this involves more output cells and a more complex mapping from src to dst + ! This gridmap will have: + ! dst 1: from src 1, 4, 7 + ! dst 2: from src 2, 4, 6 + ! dst 3: from src 1 + ! dst 4: no overlapping src cells + ! dst 5: from src 5, 7, 8 + ! note that src 3 & 9 do not overlap with any dst + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, & + src_array, dst_array, dst_array_t, filter) + gridmap%na = 9 + gridmap%nb = 5 + gridmap%ns = 10 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns)) + gridmap%src_indx = (/1, 2, 4, 4, 7, 6, 1, 5, 7, 8/) + gridmap%dst_indx = (/1, 2, 1, 2, 1, 2, 3, 5, 5, 5/) + gridmap%wovr = (/1, 1, 2, 2, 1, 3, 1, 2, 2, 3/) + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb), & + filter (gridmap%ns)) + + testname = 'more complex gridmap' + ! src index: 1 2 3 4 5 6 7 8 9 + src_array = (/1, 2, 3, 1, 5, 6, 5, 8, 9/) + minval = 1 + maxval = 9 + nodata = -1 + dst_array_t = (/1, 6, 1, nodata, 5/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, & + src_array, dst_array_t, filter) + + end subroutine test_get_dominant_indices +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_filter_same + + use mkgridmapMod, only : gridmap_type + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + integer, allocatable :: src_array(:) + integer, allocatable :: dst_array(:) + logical, allocatable :: filter(:) + logical, allocatable :: filter_t(:) + integer :: nodata + + character(len=*), parameter :: subname = 'test_filter_same' + + ! Set up a gridmap that will be used for most tests, and allocate corresponding + ! arrays: + ! Note that, for most tests here, the test arrays are: (1) simple case, (2) the main + ! case to test, (3) simple case. Thus, the main case in question is #2 of 3, and + ! we're always basically just testing one scenario in each call to the subroutine + ! (rather than doing a bunch of tests at once, which could make setting up the test + ! arrays more error-prone). + + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + ! Note: I'm not setting some things that aren't used in filter_same + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + filter (gridmap%ns), & + filter_t (gridmap%ns)) + + testname = 'maintain false values in filter' + src_array(:) = 1 + dst_array(:) = 1 + filter(:) = .true. + filter(3) = .false. + filter(5) = .false. + filter_t(:) = .true. + filter_t(3) = .false. + filter_t(5) = .false. + call filter_same(gridmap, filter, src_array, dst_array) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'dst_array = nodata in some places' + nodata = -1 + src_array(:) = 1 + src_array(5) = nodata ! make sure that even when src_array = dst_array = nodata, + ! we still end up with filter = false + dst_array = (/1, nodata, 1/) + filter(:) = .true. + filter_t(:) = .true. + filter_t(3:9) = .false. ! false for all overlaps with dst #2 + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'src_array not equal to dst_array in some places, no nodata argument' + src_array(:) = (/1, 1, 1, 1, 2, 3, 1, 3, 1/) + dst_array(:) = (/1, 1, 1/) + filter(:) = .true. + ! src_array index: 1 2 2 3 4 5 6 7 8 8 9 + filter_t(:) = (/.true.,.true.,.true.,.true.,.true.,.false.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'src_array not equal to dst_array in some places, nodata never applies' + nodata = -1 + src_array(:) = (/1, 1, 1, 1, 2, 3, 1, 3, 1/) + dst_array(:) = (/1, 1, 1/) + filter(:) = .true. + ! src_array index: 1 2 2 3 4 5 6 7 8 8 9 + filter_t(:) = (/.true.,.true.,.true.,.true.,.true.,.false.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'combination of false filter, src_array not equal to dst_array, and nodata' + nodata = -1 + src_array(:) = (/1, 2, 1, 2, 1, 2, 1, 2, 1/) + dst_array(:) = (/nodata, 1, 1/) + filter(:) = .true. + filter(4) = .false. + filter_t(:) = (/.false.,.false.,.false.,.false.,.false.,.true.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + + deallocate(gridmap%src_indx, gridmap%dst_indx, & + src_array, dst_array, filter, filter_t) + + end subroutine test_filter_same +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_lookup_2d + + implicit none + + character(len=128) :: testname + real(r8), allocatable :: lookup_table(:,:) + logical , allocatable :: valid_entries(:,:) + integer , allocatable :: index1(:), index2(:) + real(r8), allocatable :: data(:), data_t(:) + real(r8) :: fill_val + integer :: nodata + integer :: ierr, ierr_t + + character(len=*), parameter :: subname = 'test_lookup_2d' + + ! Create lookup table for use in most tests + allocate(lookup_table(2,3), valid_entries(2,3)) + lookup_table(1,:) = (/11.,12.,13./) + lookup_table(2,:) = (/21.,22.,23./) + + testname = 'basic test; no nodata or valid_entries' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,2,1,2,2/) + index2 = (/1,2,3,2,3/) + fill_val = -1. + data_t = (/11., 22., 13., 22., 23./) + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'basic test but with index out of range' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,2,3,2,2/) + index2 = (/1,2,1,2,4/) + fill_val = -1. + data_t = (/11._r8, 22._r8, fill_val, 22._r8, fill_val/) + ierr_t = 2 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'basic test but with nodata present, and a nodata value in input' + allocate(index1(5), index2(5), data(5), data_t(5)) + nodata = -1 + index1 = (/nodata,2,1,2,nodata/) + index2 = (/1,2,3,nodata,nodata/) + fill_val = -1. + data_t = (/fill_val, 22._r8, 13._r8, fill_val, fill_val/) + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, nodata=nodata) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'valid_entries' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,1,2,2,1/) + index2 = (/1,2,1,2,3/) + valid_entries(1,:) = (/.false.,.false.,.true./) + valid_entries(2,:) = (/.true. ,.true. ,.true./) + fill_val = -1. + data_t = (/fill_val, fill_val, 21._r8, 22._r8, 13._r8/) + ierr_t = 1 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, valid_entries=valid_entries) + call check_results + + testname = 'valid_entries, invalid_okay' + ! Note: this test reuses some setup from the previous test + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, & + valid_entries=valid_entries, invalid_okay=.true.) + call check_results + deallocate(index1, index2, data, data_t) + + + testname = 'valid_entries, together with index out of range' + ! in addition to checking both valid_entries and index out of range, this also + ! makes sure that we get the appropriate ierr value when we have both errors + ! (because we encounter the valid_entries error first) + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,1,3,2,2/) + index2 = (/1,2,1,1,0/) + valid_entries(1,:) = (/.false.,.false.,.true./) + valid_entries(2,:) = (/.true. ,.true. ,.true./) + fill_val = -1. + data_t = (/fill_val, fill_val, fill_val, 21._r8, fill_val/) + ierr_t = 1 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, valid_entries=valid_entries) + call check_results + deallocate(index1, index2, data, data_t) + + + deallocate(lookup_table, valid_entries) + + contains + subroutine check_results + call test_is(data, data_t, modname//' -- '//subname//' -- '//trim(testname)//' -- data') + call test_is(ierr, ierr_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ierr') + end subroutine check_results + + end subroutine test_lookup_2d +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_lookup_2d_netcdf + + use mkncdio + + implicit none + + character(len=128) :: testname + character(len=64) :: tablename + character(len=4) :: dimname1, dimname2 + logical :: invalid_lookup + integer :: n_extra_dims + integer , allocatable :: index1(:), index2(:) + real(r8), allocatable :: data(:), data_t(:) + real(r8) :: fill_val + integer :: nodata + integer :: ierr, ierr_t + type(dim_slice_type), allocatable :: extra_dims(:) + + integer :: ncid + character(len=*), parameter :: filename = 'unit_testers/test_lookup_2d_netcdf.nc' + + ! flags to enable tests that we don't usually want to run, because they result in + ! an abort, but we may occasionally want to run to make sure this error-handling is + ! working properly + logical, parameter :: test_abort1 = .false. + logical, parameter :: test_abort2 = .false. + logical, parameter :: test_abort3 = .false. + + character(len=*), parameter :: subname = 'test_lookup_2d_netcdf' + + ! Open netcdf file that will be used for most tests: + ! Note that this file was created such that lookup4d(i,j,k,l) = 1000*i+100*j+10*k+l, + ! and similarly for the other variables + ! Also, lookup2d(1,2) is missing (i.e., equal to the _FillVal) + call check_ret(nf_open(filename, 0, ncid), subname) + + testname = '2-d lookup table with _FillValue resulting in valid_entries false somewhere' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup2d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 0 + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + ! Note that the third value is fill_val because lookup2d(1,2) is missing (i.e., + ! equal to the _FillVal in the netcdf file) + data_t = (/11._r8, 22._r8, fill_val, 21._r8, 23._r8/) + ierr_t = 1 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr) + call check_results + + testname = '2-d lookup table with _FillValue resulting in valid_entries false somewhere, invalid_okay' + ! Note: this test reuses some setup from the previous test + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, invalid_okay=.true.) + call check_results + deallocate(index1, index2, data, data_t) + + testname = '3-d lookup table with no _FillValue; nodata in index arrays' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 2) + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + call check_results + deallocate(index1, index2, data, data_t, extra_dims) + + testname = '4-d lookup table' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup4d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 2 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 4) + extra_dims(2) = dim_slice_type('dim4', 5) + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + data_t = (/1145., 2245., 1245., 2145., 2345./) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims) + call check_results + deallocate(index1, index2, data, data_t, extra_dims) + + ! The following tests should result in the code aborting with an error message. + ! + ! We don't usually want to run these tests, because they result in the code + ! aborting, but we may want to run them occasionally to make sure this + ! error-handling is working correctly. + + if (test_abort1) then + testname = '2-d lookup table with incorrect dimname for dimension 2' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup2d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'bad2' ! this differs from the value in the file + n_extra_dims = 0 + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + ! Note that the third value is fill_val because lookup2d(1,2) is missing (i.e., + ! equal to the _FillVal in the netcdf file) + data_t = (/11._r8, 22._r8, fill_val, 21._r8, 23._r8/) + ierr_t = 1 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr) + deallocate(index1, index2, data, data_t) + end if + + if (test_abort2) then + testname = '3-d lookup table with incorrect dimname for dimension 3' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('bad3', 2) ! this name differs from the value in the file + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + deallocate(index1, index2, data, data_t, extra_dims) + end if + + if (test_abort3) then + testname = '3-d lookup table, trying to access too large index for dimension 3' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 5) ! this index is out of bounds + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + deallocate(index1, index2, data, data_t, extra_dims) + end if + + call check_ret(nf_close(ncid), subname) + + contains + subroutine check_results + call test_is(data, data_t, modname//' -- '//subname//' -- '//trim(testname)//' -- data') + call test_is(ierr, ierr_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ierr') + end subroutine check_results + + end subroutine test_lookup_2d_netcdf +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_which_max + + implicit none + + real(r8), dimension(:), allocatable :: arr + + character(len=128) :: testname + + real(r8) :: maxval, maxval_t + integer :: maxindex, maxindex_t + + character(len=*), parameter :: subname = 'test_which_max' + + + testname = 'length-1 array' + allocate(arr(1)) + arr = (/3.0/) + maxval_t = 3.0 + maxindex_t = 1 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max @ 1' + allocate(arr(5)) + arr = (/5.0, 2.0, 3.0, 2.5, 1.5/) + maxval_t = 5.0 + maxindex_t = 1 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max in middle' + allocate(arr(5)) + arr = (/1.0, 2.0, 3.0, 2.5, 1.5/) + maxval_t = 3.0 + maxindex_t = 3 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max at end' + allocate(arr(5)) + arr = (/1.0, 2.0, 3.0, 2.5, 8.0/) + maxval_t = 8.0 + maxindex_t = 5 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'multiple tied max values' + allocate(arr(5)) + arr = (/1.0, 3.0, 3.0, 2.5, 1.5/) + maxval_t = 3.0 + maxindex_t = 2 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max in middle, with lbound present' + allocate(arr(3:7)) + arr = (/1.0, 3.0, 10.0, 2.5, 8.0/) + maxval_t = 10.0 + maxindex_t = 5 + call which_max(arr, maxval, maxindex, lbound=3) + call check_results + deallocate(arr) + + contains + subroutine check_results + call test_is(maxval, maxval_t, modname//' -- '//subname//' -- '//trim(testname)//' -- maxval') + call test_is(maxindex, maxindex_t, modname//' -- '//subname//' -- '//trim(testname)//' -- maxindex') + end subroutine check_results + + end subroutine test_which_max +!------------------------------------------------------------------------------ + +end module test_mkindexmapMod + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkncdio.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkncdio.F90 new file mode 100644 index 0000000000..1f8a82b050 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkncdio.F90 @@ -0,0 +1,55 @@ +module test_mkncdio +! Module for testing mkncdio + + use mkncdio + use test_mod + + implicit none + private + + public :: test_get_dim_lengths + + character(len=*), parameter :: modname = 'test_mkncdio' + +contains + +!------------------------------------------------------------------------------ + subroutine test_get_dim_lengths + + implicit none + + character(len=128) :: testname + integer :: ncid + character(len=128) :: varname + integer :: ndims, ndims_t + integer :: dim_lengths(nf_max_var_dims), dim_lengths_t(nf_max_var_dims) + + character(len=*), parameter :: filename = 'unit_testers/test_lookup_2d_netcdf.nc' + + character(len=*), parameter :: subname = 'test_get_dim_lengths' + + ! Open netcdf file that will be used for most tests + call check_ret(nf_open(filename, 0, ncid), subname) + + testname = '3d variable' + varname = 'lookup3d' + ndims_t = 3 + dim_lengths_t = 0 + dim_lengths_t(1) = 2 + dim_lengths_t(2) = 3 + dim_lengths_t(3) = 4 + call get_dim_lengths(ncid, varname, ndims, dim_lengths) + call check_results + + call check_ret(nf_close(ncid), subname) + + contains + subroutine check_results + call test_is(ndims, ndims_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ndims') + call test_is(dim_lengths(1:ndims), dim_lengths_t(1:ndims_t), & + modname//' -- '//subname//' -- '//trim(testname)//' -- dim_lengths') + end subroutine check_results + + end subroutine test_get_dim_lengths + +end module test_mkncdio diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 new file mode 100644 index 0000000000..39654a661b --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 @@ -0,0 +1,26 @@ +! Run unit tests for mksurfdata_map +program mksurfdata_map_unit_tester + use test_mkutilsMod + use test_mkindexmapMod + use test_mkurbanparDomMod + use test_mkncdio + use test_mod, only : test_init, test_final + + call test_init + + call test_slightly_below + call test_slightly_above + + call test_get_dominant_indices + call test_filter_same + call test_lookup_2d + call test_lookup_2d_netcdf + call test_which_max + + call test_mkurban_dominant_density + + call test_get_dim_lengths + + call test_final + +end program mksurfdata_map_unit_tester diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 new file mode 100644 index 0000000000..949147a583 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkurbanparDomMod.F90 @@ -0,0 +1,70 @@ +module test_mkurbanparDomMod +! Module for testing mkurbanparDomMod + + use mkurbanparDomMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_mkurban_dominant_density + + character(len=*), parameter :: modname = 'test_mkurbanparDomMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_mkurban_dominant_density + + implicit none + + real(r8), allocatable :: urbn_by_dens_o(:,:) + integer , allocatable :: dens_o(:) + integer , allocatable :: dens_o_t(:) + real(r8), allocatable :: urbn_o(:) + real(r8), allocatable :: urbn_o_t(:) + + character(len=128) :: testname + integer :: nodata + + character(len=*), parameter :: subname = 'test_mkurban_dominant_density' + + allocate(urbn_by_dens_o (4, 2), & + dens_o (4), & + dens_o_t (4), & + urbn_o (4), & + urbn_o_t (4)) + + + testname = 'basic test' + nodata = -1 + ! This tests a few different things: + ! (1) output 1 should end up as nodata + ! (2) output 2 tests a tie + ! (3) output 3 & 4 test "normal" cases + + urbn_by_dens_o = reshape(source=(/0, 10, 30, 10, & ! column 1 (i.e., density class 1) + 0, 10, 10, 30/), & ! column 2 (i.e., density class 2) + shape=(/4, 2/)) + + dens_o_t = (/nodata, 1, 1, 2/) + urbn_o_t = (/0, 20, 40, 40/) + + call mkurban_dominant_density(urbn_by_dens_o, nodata, dens_o, urbn_o) + call check_results + + deallocate(urbn_by_dens_o, dens_o, dens_o_t, urbn_o, urbn_o_t) + + contains + subroutine check_results + call test_is(dens_o, dens_o_t, modname//' -- '//subname//' -- '//trim(testname)//& + ' -- dens_o') + call test_is(urbn_o, urbn_o_t, modname//' -- '//subname//' -- '//trim(testname)//& + ' -- urbn_o') + end subroutine check_results + + end subroutine test_mkurban_dominant_density +!------------------------------------------------------------------------------ + +end module test_mkurbanparDomMod diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkutilsMod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkutilsMod.F90 new file mode 100644 index 0000000000..edd146e686 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mkutilsMod.F90 @@ -0,0 +1,112 @@ +module test_mkutilsMod +! Module for testing mkutilsMod + + use mkutilsMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_slightly_below + public :: test_slightly_above + + character(len=*), parameter :: modname = 'test_mkutilsMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_slightly_below + + implicit none + + character(len=128) :: testname + + logical :: retval + real(r8) :: a + real(r8) :: b + + character(len=*), parameter :: subname = 'test_slightly_below' + + testname='basic-true' + b = 3.0 + a = 3.0 - b*epsilon(b) + retval = slightly_below(a,b) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='far below' + b = 3.0 + a = 2.0 + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='equal' + b = 3.0 + a = 3.0 + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='above' + b = 3.0 + a = 3.0 + epsilon(b) + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='change epsilon to allow far below' + b = 3.0 + a = 2.0 + retval = slightly_below(a,b,eps=0.75_r8) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_slightly_below +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_slightly_above + + implicit none + + character(len=128) :: testname + + logical :: retval + real(r8) :: a + real(r8) :: b + + character(len=*), parameter :: subname = 'test_slightly_above' + + testname='basic-true' + b = 3.0 + a = 3.0 + b*epsilon(b) + retval = slightly_above(a,b) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='far above' + b = 3.0 + a = 4.0 + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='equal' + b = 3.0 + a = 3.0 + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='below' + b = 3.0 + a = 3.0 - epsilon(b) + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='change epsilon to allow far above' + b = 3.0 + a = 4.0 + retval = slightly_above(a,b,eps=0.75_r8) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_slightly_above +!------------------------------------------------------------------------------ + +end module test_mkutilsMod + + diff --git a/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mod.F90 b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mod.F90 new file mode 100644 index 0000000000..967eee1c89 --- /dev/null +++ b/components/clm/tools/clm4_0/mksurfdata_map/unit_testers/test_mod.F90 @@ -0,0 +1,339 @@ +module test_mod + +use shr_kind_mod, only : SHR_KIND_R8 +use shr_sys_mod, only : shr_sys_abort + +implicit none + +public test_init +public test_is +public test_close +public test_final + +integer, save :: ntests = 0 +integer, save :: npass = 0 +integer, save :: num_expected = 0 +logical, save :: num_expected_given = .false. +character(*), parameter :: formatTest = '(A4, " ", i5.5, " - ", A)' +character(*), parameter :: formatArrayMatch = & + '(" (all ", i5, " values match)")' +character(*), parameter :: formatArray2DMatch = & + '(" (all ", i5, "x", i5, " values match)")' +character(*), parameter :: formatArrayMisMatch = & + '(" (only ", i5, " values of ", i5, " values match)")' +character(*), parameter :: formatArray2DMisMatch = & + '(" (only ", i5, " values of ", i5, "x", i5, " values match)")' +character(*), parameter :: formatRArrayClose = & + '(" (all ", i5, " values are within", 1pe9.1e2, " )")' +character(*), parameter :: formatRArrayNotClose = & + '(" (only ", i5, " values of ", i5, " values are within", 1pe9.1e2, " max diff= ", 1pe9.1e2, ")")' +character(*), parameter :: formatRClose = & + '(" ( value within", 1pe9.1e2, " )")' +character(*), parameter :: formatRNotClose = & + '(" ( value within", 1pe9.1e2, " diff= ", 1pe9.1e2, ")")' + +interface test_is + module procedure test_is_logical + module procedure test_is_logical1D + module procedure test_is_string + module procedure test_is_integer + module procedure test_is_integer1D + module procedure test_is_real1D + module procedure test_is_real2D + module procedure test_is_realScalar +end interface test_is + +interface test_close + module procedure test_close_real1D + module procedure test_close_realScalar +end interface test_close + +private test_is_logical +private test_is_string +private test_is_integer +private test_is_integer1D +private test_is_real1D +private test_is_realScalar +private test_close_real1D + +contains + + +subroutine test_init( num_expected_tests ) + integer, intent(IN), optional :: num_expected_tests + + if ( present(num_expected_tests) ) then + num_expected = num_expected_tests + num_expected_given = .true. + write(*,formatTest) "1...", num_expected, "expected tests" + write(*,*) + end if + +end subroutine test_init + +subroutine test_is_logical( pass, description ) + + implicit none + + logical, intent(IN) :: pass ! If matches or not + character(*), intent(IN) :: description ! description of test + + character(4) :: status + + ntests = ntests + 1 + if ( pass )then + npass = npass + 1 + status = "PASS" + else + status = "FAIL" + end if + write(*,formatTest) status, ntests, trim(description) + +end subroutine test_is_logical + +subroutine test_is_logical1D( value, expected, description ) + + implicit none + + logical, intent(IN) :: value(:) ! test value + logical, intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value .eqv. expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value .eqv. expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_logical1D + + +subroutine test_is_string( value, expected, description ) + + implicit none + + character(len=*), intent(IN) :: value + character(len=*), intent(IN) :: expected + character(len=*), intent(IN) :: description ! description of test + + + logical :: pass ! If matches or not + + character(4) :: status + + if ( trim(value) == trim(expected) )then + pass = .true. + else + pass = .false. + end if + ntests = ntests + 1 + if ( pass )then + npass = npass + 1 + status = "PASS" + else + status = "FAIL" + end if + write(*,formatTest) status, ntests, trim(description) + +end subroutine test_is_string + +subroutine test_is_integer( value, expected, description ) + integer, intent(IN) :: value ! test value + integer, intent(IN) :: expected ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + + if ( value == expected )then + pass = .true. + else + pass = .false. + end if + call test_is_logical( pass, description ) + +end subroutine test_is_integer + +subroutine test_is_integer1D( value, expected, description ) + integer, intent(IN) :: value(:) ! test value + integer, intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value == expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_integer1D + +subroutine test_is_real1D( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value(:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value == expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_real1D + +subroutine test_is_real2D( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value(:,:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:,:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize1, nsize2, nmatch + character(256) :: descrip + + nsize1 = size(value,1) + nsize2 = size(value,2) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArray2DMatch) nsize1, nsize2 + else + nmatch = count(value == expected) + write(descrip,formatArray2DMisMatch) nmatch, nsize1, nsize2 + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_real2D + +subroutine test_is_realScalar( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value ! test value + real(SHR_KIND_R8), intent(IN) :: expected ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + + if ( value == expected )then + pass = .true. + else + pass = .false. + end if + call test_is_logical( pass, description ) + +end subroutine test_is_realScalar + +subroutine test_close_real1D( value, expected, eps, description, rel_diff ) + real(SHR_KIND_R8), intent(IN) :: value(:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:) ! expected value + real(SHR_KIND_R8), intent(IN) :: eps ! epsilon -- how close to be within + character(*), intent(IN) :: description ! description of test + logical, optional, intent(IN) :: rel_diff ! if should do relative difference or not + + logical :: pass, lreldiff + integer :: nsize, nmatch, i, n0(1), nf(1) + real(SHR_KIND_R8) :: within, diff + character(256) :: descrip + + lreldiff = .false. + if ( present(rel_diff) ) lreldiff = rel_diff + nsize = size(value) + if ( nsize /= size(expected) )then + call shr_sys_abort( "size of value and expected array is different" ) + end if + if ( any(lbound(value) /= lbound(expected)) )then + call shr_sys_abort( "lower bound of value and expected array is different" ) + end if + nmatch = 0 + n0 = lbound(value) + nf = ubound(value) + within = abs(value(n0(1)) - expected(n0(1))) + if ( lreldiff .and. within > 0.0_SHR_KIND_R8 ) within = within / max( abs(value(n0(1))), abs(expected(n0(1))) ) + do i = n0(1), nf(1) + diff = abs(value(i) - expected(i)) + if ( lreldiff .and. diff > 0.0_SHR_KIND_R8 ) diff = diff / max(abs(value(i)),abs(expected(i)) ) + within = max( within, diff ) + if ( diff <= eps ) nmatch = nmatch + 1 + end do + if( nmatch == nsize )then + write(descrip,formatRArrayClose) nsize, eps + pass = .true. + else + write(descrip,formatRArrayNotClose) nmatch, nsize, eps, within + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_close_real1D + +subroutine test_close_realScalar( value, expected, eps, description ) + real(SHR_KIND_R8), intent(IN) :: value ! test value + real(SHR_KIND_R8), intent(IN) :: expected ! expected value + real(SHR_KIND_R8), intent(IN) :: eps ! epsilon -- how close to be within + character(*), intent(IN) :: description ! description of test + + logical :: pass + real(SHR_KIND_R8) :: diff + character(256) :: descrip + + diff = abs(value - expected) + if ( diff <= eps ) then + write(descrip,formatRClose) eps + pass = .true. + else + write(descrip,formatRNotClose) eps, diff + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_close_realScalar + +subroutine test_final( PassStatus ) + + logical, intent(OUT), optional :: PassStatus + + character(4) :: status + character(50) :: desc + + write(*,*) + status = "PASS" + if ( present(PassStatus) ) PassStatus = .true. + desc = "All expected tests ran successfully" + if ( num_expected_given .and. ntests /= num_expected )then + status = "FAIL" + desc = "Different number of tests than expected" + if ( present(PassStatus) ) PassStatus = .false. + end if + if ( npass /= ntests )then + status = "FAIL" + if ( present(PassStatus) ) PassStatus = .false. + write(desc,'(A,i3,A)') "Not all tests passed (", & + ntests-npass, " tests failed)" + end if + write(*,formatTest) status, ntests, "tests run -- "//desc + +end subroutine test_final + +end module test_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/Makefile.data b/components/clm/tools/clm4_5/mksurfdata_map/Makefile.data new file mode 100644 index 0000000000..5de4478b0e --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/Makefile.data @@ -0,0 +1,172 @@ +# -*- mode:Makefile -*- +# +# To generate all surface data sets, run: +# make -f Makefile.data all +# +# To generate a single dataset, run make with the name of the rule you +# want to build. For example, to generate the crop data set for 1x1_numaIA: +# +# make -f Makefile.data crop-numa +# +# NOTE: The default behavior is to parallelize data set creation using +# the batch system by submitting jobs to the interactive queue in the +# background. Standard out and standard error are redirected to a text +# file. To change this behavior, you can comment out the BATCHJOBS and +# BACKGROUND variables and replace them with empty variables. +# +# WARNING: Do not put more than one mksurfdata call per rule. output +# redirection is based on the rule name, and multiple rules will over +# write the previous output or incomprehensively merge output from +# simultaneously running jobs. +# +BATCHJOBS = execgy +BACKGROUND = &> $@.stdout.txt & + +MKSURFDATA = $(BATCHJOBS) ./mksurfdata.pl + +STANDARD_RES = 360x720cru,48x96,0.9x1.25,1.9x2.5,10x15,ne30np4 + +STANDARD = \ + global-present \ + global-present-45 \ + global-present-0.125 \ + global-present-ne16np4 \ + global-transient-rcp-2.6 \ + global-transient-rcp-4.5 \ + global-transient-rcp-6 \ + global-transient-rcp-8.5 + +TROPICS = \ + tropics-present \ + tropics-transient \ + tropics-atlantic-historical \ + tropics-atlantic-present \ + tropics-atlantic-transient + +CROP = \ + crop-global-1.9 \ + crop-global-0.125 \ + crop-numa + +all : standard tropics crop urban landuse-timeseries + +# +# standard +# +standard : $(STANDARD) + +global-present : FORCE + $(MKSURFDATA) -glc_nec 10 -y 2000 -res $(STANDARD_RES) $(BACKGROUND) + +global-present-45 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 2000 -res 4x5 $(BACKGROUND) + +global-present-0.125 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 2000 -res 0.125x0.125 $(BACKGROUND) + +global-present-ne16np4 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 2000 -res ne16np4 $(BACKGROUND) + +global-historical : FORCE + $(MKSURFDATA) -glc_nec 10 -y 1850 -res $(STANDARD_RES) $(BACKGROUND) + +global-transient-rcp-2.6 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 1850-2100 -rcp 2.6 -res $(STANDARD_RES) $(BACKGROUND) + +global-transient-rcp-4.5 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 1850-2100 -rcp 4.5 -res $(STANDARD_RES) $(BACKGROUND) + +global-transient-rcp-6 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 1850-2100 -rcp 6 -res $(STANDARD_RES) $(BACKGROUND) + +global-transient-rcp-8.5 : FORCE + $(MKSURFDATA) -glc_nec 10 -y 1850-2100 -rcp 8.5 -res $(STANDARD_RES) $(BACKGROUND) + +# +# tropics +# +tropics : $(TROPICS) + +tropics-present : FORCE + $(MKSURFDATA) -y 2000 -res 5x5_amazon,1x1_brazil -hirespft $(BACKGROUND) + +tropics-transient : FORCE + $(MKSURFDATA) -y 1850-2100 -rcp 8.5 -res 1x1_brazil $(BACKGROUND) + +tropics-atlantic-historical : FORCE + $(MKSURFDATA) -y 1850 -res 1x1_tropicAtl $(BACKGROUND) + +tropics-atlantic-present : FORCE + $(MKSURFDATA) -y 2000 -res 1x1_tropicAtl $(BACKGROUND) + +tropics-atlantic-transient : FORCE + $(MKSURFDATA) -y 1850-2005 -res 1x1_tropicAtl $(BACKGROUND) + +# +# crop +# +crop : $(CROP) + +crop-global-1.9 : FORCE + $(MKSURFDATA) -crop -hirespft -glc_nec 10 -y 2000 -r 1.9x2.5 $(BACKGROUND) + +# time series generates a surface data set with the same name, so we skip this one. +#crop-global-10 : FORCE +# $(MKSURFDATA) -crop -hirespft -glc_nec 10 -y 2000 -r 10x15 $(BACKGROUND) + +crop-global-0.125 : FORCE + $(MKSURFDATA) -crop -hirespft -glc_nec 10 -y 2000 -r 0.125x0.125 $(BACKGROUND) + +crop-numa : FORCE + $(MKSURFDATA) -crop -hirespft -y 2000 -r 1x1_numaIA $(BACKGROUND) + +# time series generates a surface data set with the same name, so we skip this one. +#crop-smallville : FORCE +# $(MKSURFDATA) -crop -y 2000 -r 1x1_smallvilleIA \ +# -pft_idx 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78 \ +# -pft_frc 6.5,1.5,1.6,1.7,1.8,1.9,1.5,1.6,1.7,1.8,1.9,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5 \ +# $(BACKGROUND) + +# +# urban +# +urban : urban-present urban-alpha + +urban-present : FORCE + $(MKSURFDATA) -y 2000 -r 1x1_camdenNJ,1x1_vancouverCAN,1x1_mexicocityMEX $(BACKGROUND) + +# NOTE(bja, 2015-01) skip abort on invalid data necessary as of 2015-01. See +# /glade/p/cesm/cseg/inputdata/lnd/clm2/surfdata_map/README_c141219 +urban-alpha : FORCE + $(MKSURFDATA) -y 2000 -r 1x1_urbanc_alpha -urban_skip_abort_on_invalid_data_check $(BACKGROUND) + + +# +# landuse timeseries +# +landuse-timeseries : landuse-timeseries-f10 landuse-timeseries-smallville + +landuse-timeseries-f10 : FORCE + $(MKSURFDATA) -crop -glc_nec 10 -y 1850-2005 -r 10x15 $(BACKGROUND) + +landuse-timeseries-smallville : FORCE + $(MKSURFDATA) -crop -y 1850-1855 -r 1x1_smallvilleIA \ + -pft_idx 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78 \ + -pft_frc 6.5,1.5,1.6,1.7,1.8,1.9,1.5,1.6,1.7,1.8,1.9,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5 \ + -dynpft single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt \ + $(BACKGROUND) + +# +# clean up the working directory by removing generated files +# +clean : FORCE + -rm *~ + +clobber : clean + -rm surfdata_*.nc surfdata_*.log surfdata_*.namelist + +# +# generic rule to force things to happen +# +FORCE : + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/README b/components/clm/tools/clm4_5/mksurfdata_map/README new file mode 100644 index 0000000000..d2061ec86d --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/README @@ -0,0 +1,70 @@ +components/clm/tools/mksurfdata_map/README Jan 13, 2012 + +slevis comments: +See additional info for how I created the new surface data in slevis notes +at the top of this file: +surfdata_74pft_360x720cru_simyr2000_c130920.log + +The routines in this directory create a surface dataset. +The output grid is read in from the input namelist and +can correspond to either a global or regional grid. + +Supported model resolutions are those found in the repository input data directory + $DIN_LOC_ROOT/lnd/clm2/mappingdata/maps + +Surface datasets can either be created for two separate cases + a) for supported model resolutions + b) for unsupported (user-specified) model resolutions + +The following steps provide a method to create the executable +and generate the surface dataset: + +1) > cd src + > gmake + By default code compiles optimized so it's reasonably fast. If you want + to use the debugger, with bounds-checking, and float trapping on do the + following: + gmake OPT=FALSE + See Also: See the components/clm/tools/README file for notes about setting + the path for NetCDF and running with shared-memory parallelism. + +2) For supported model resolutions - skip this step + + For unsupported model resolutions - do the following... + determine the pathname of the model resolution SCRIP grid file + + > cd mkmapdata + invoke one of the following commands + (for global resolution) + > ./mkmapdata.sh -f -res -type global + (for regional resolution) + > ./mkmapdata.sh -f -res -type regional + > cd ../ + + note: the mapping files generated in ./mkmapdata will be used to + generate the surface dataset + note: the res argument above () MUST be identical to the one provided to + mksurfdata.pl (see below) + +3) make surface dataset(s) + > mksurfdata.pl --help (for full usage instructions) + For supported model resolution () + > mksurfdata.pl -res [options] + + For unsupported, user specified model resolutions + > mksurfdata.pl -res usrspec -usr_gname -usr_gdate + + Note that the argument to usr_gname MUST be the same as the -res argument value + when invoking mkmapdata + + Example, for gridname=1x1_boulderCO with maps created on Jan/13/2012 + + > mksurfdata.pl -res usrspec -usr_gname 1x_boulderCO -usr_gdate 20120113 + +Lists of input files for range of dates historical or future scenarios: + + landuse_timeseries_hist_simyr1850-2005.txt --- List of historical input PFT files from 1850 to 2005 + +(Historical period from 1850-2005 datafiles all point to the historical files, while + the future scenarios 2006-2100 are the scenario datasets) + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/README.developers b/components/clm/tools/clm4_5/mksurfdata_map/README.developers new file mode 100644 index 0000000000..8c1520465e --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/README.developers @@ -0,0 +1,176 @@ +============================================================================ +============================================================================ +Developer's guide for mksurfdata_map +============================================================================ +============================================================================ + +============================================================================ +Table of Contents +============================================================================ + +I. Adding a new raw data file + +II. Adding mapping files for a raw data file with a new grid / landmask + +============================================================================ +I. Adding a new raw data file +============================================================================ + +Here is what you need to change when adding a new raw data file, with one or +more fields that need to be remapped to the CLM resolution. Note that +additional steps are needed (beyond what's listed here) when the field +you're adding specifies something about the subgrid breakdown (into +landunits, columns & pfts): for those fields, additional code is needed to +ensure that percentages add to 100%. + +Note: The following assumes that the new file uses an existing set of +mapping files, or that you have already done everything necessary to add a +new set of mapping files. If your mapping file has a new grid, or a new +landmask on an existing grid, see the instructions for adding mapping files +in a separate section of this document. + +- Add a new module in mksurfdata_map/src that provides a routine for + remapping your new field(s). + + Note that there is generally one module per input file; multiple fields + can be regridded using a single subroutine or multiple subroutines. + +- Add your new file in mksurfdata_map/src/Srcfiles + +- Add new namelist options in mksurfdata_map/src/mkvarctl.F90; e.g., for a + new field xxx: + - mksrf_fxxx + - map_fxxx + +- Add output calls in mksurfdata_map/src/mkfileMod.F90; you need to add + calls in 3 places: + - raw data file name attribute (nf_put_att_text call) + - mapping file name attribute (nf_put_att_text call) + - variable definition (ncd_defvar calls) + Make sure this goes in an 'if (.not dynlanduse)' conditional, if + appropriate + +- Add code in mksurfdata_map/src/mksurfdat.F90; you need to add the + following: + - add a 'use' statement to use your new regridding routine(s) + - declare array(s) to hold data on the output grid + - add your new mksrf_fxxx and map_fxxx variables to the 'namelist + /clmexp/' declaration + - document your new mksrf_fxxx and map_fxxx variables in the long + comment following the 'namelist /clmexp/' declaration + - add your new array(s) to the allocation statement under the heading + "Allocate and initialize dynamic memory" + - initialize your new array(s) in the initialization section following + the allocation + - add output to ndiag (the log file) documenting your new mksrf_fxxx and + map_fxxx variables + - add call(s) to your new subroutine(s) for regridding the data + - add calls to nf_inq_varid & nf_put_var_double (or nf_put_var_int) for + each new output variable; make sure to put these calls in the section + for dynlanduse = false and/or true, as appropriate + - add a deallocation statement for each new output variable + +- Add your new file in bld/namelist_files/namelist_definition_clm4_5.xml; + e.g. (replace xxx with your new field): + + + XXX dataset for mksurfdata + + +- Add your new mksrf_fxxx variable to the list of valid_values for + mksrf_filename in bld/namelist_files/namelist_definition_clm4_5.xml + +- Add defaults in bld/namelist_files/namelist_defaults_clm4_5_tools.xml; + note that the "type" attribute is a short code that can be used in + mksurfdata.pl, and doesn't have to match the "xxx" that is used elsewhere + - lmask + - hgrid + - mksrf_filename + - mksrf_fxxx (including hgrid and lmask attributes) + +- Add hooks to your new files in mksurfdata_map/mksurfdata.pl: + - add new string in the list following 'foreach my $typ' + - add the new mapping file to clmexp, as in: + map_fxxx = '$map{'xxx'}' + - add the new raw data file to clmexp, as in: + mksrf_fxxx = '$datfil{'xxx'}' + +- Add new raw data file to the inputdata repository: lnd/clm2/rawdata + - locally + - check in to the inputdata svn repository + +- Add documentation for your new mksrf_fxxx in doc/UsersGuide/tools.xml + +============================================================================ +II. Adding mapping files for a raw data file with a new grid / landmask +============================================================================ + +If your raw data file is on a new grid, or just has a new landmask on an +existing grid, you will need to perform a number of additional steps, as +laid out here. + +- First, move your data file to the inputdata directory and give it its + final name. (This will ensure that the appropriate metadata is put in the + SCRIP grid file.) + +- Make a scrip grid file from your data file using mkmapgrids, and move it + to the inputdata directory + +- Add a scripgriddata entry for the new scrip grid file in + bld/namelist_files/namelist_defaults_clm4_5_tools.xml + +- If necessary, add other entries in + namelist_defaults_clm4_5_tools.xml giving information about your + scrip grid file: + - If this is a high resolution grid (e.g., 3min or higher), add a + scripgriddata_lrgfile_needed entry, saying we need 64bit_offset + (or netcdf4) support for mapping files made with this scrip grid + file + - If the grid file is in UGRID format rather than SCRIP grid + format, add scripgriddata_type and scripgriddata_meshname + entries. If you don't know what I'm talking about, then your + grid file is in SCRIP format and you can ignore this. + +- If necessary, add new grid and/or landmask to lists of valid values for + hgrid, res and lmask in bld/namelist_files/namelist_definition_clm4_5.xml + - Note that a new resolution currently needs to be added to both the hgrid + and res lists of valid values, although in the future this + should probably be changed so that these raw data grids just + appear in hgrid + +- Add the new grid-landmask combo to the 'mapgrids' list in + bld/namelist_files/checkmapfiles.ncl + +- Add the new grid-landmask combo to the 'grids' list in + tools/shared/mkmapdata/mkmapdata.sh (in the clm4_5 branch of the + conditional) + +- Make mapping files, from tools/shared/mkmapdata + - Modify mkmapdata.sh: + - edit the grids list so it only contains your new grid + - Modify regridbatch.sh as desired, e.g.: + - project number + - number of processors (BSUB -n line, span, and the regrid_num_proc setting) + - wall-clock limit + - if ESMFBIN_PATH is in your environment, you may want to unset it; + this can be important to allow mkmapdata.sh choose a different + executable for mpi vs serial runs + - if you renamed the mkmapdata.sh script, be sure to call the + renamed script at the bottom of regridbatch.sh + - Submit regridbatch.sh + +- When mapping files have all been created, run createXMLEntries.pl from + tools/shared/mkmapdata (usage: just run the script with no arguments) + +- Cut and paste the xml entries from mapping_entries.txt (created by + createXMLEntries.pl) into bld/namelist_files/namelist_defaults_clm4_5.xml, + in the correct locations + +- Move mapping files to correct location, either using mv_cmds.sh created by + createXMLEntries.pl, or using tools/shared/mkmapdata/mvNimport.sh. + - Note that the latter also imports to the inputdata directory; if you + don't use that, you'll need to add the files to the inputdata + directory yourself + + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt b/components/clm/tools/clm4_5/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt new file mode 100644 index 0000000000..96a1a7d990 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/landuse_timeseries_hist_simyr1850-2005.txt @@ -0,0 +1,156 @@ +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc 1850 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1851_c090630.nc 1851 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1852_c090630.nc 1852 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1853_c090630.nc 1853 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1854_c090630.nc 1854 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1855_c090630.nc 1855 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1856_c090630.nc 1856 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1857_c090630.nc 1857 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1858_c090630.nc 1858 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1859_c090630.nc 1859 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1860_c090630.nc 1860 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1861_c090630.nc 1861 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1862_c090630.nc 1862 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1863_c090630.nc 1863 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1864_c090630.nc 1864 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1865_c090630.nc 1865 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1866_c090630.nc 1866 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1867_c090630.nc 1867 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1868_c090630.nc 1868 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1869_c090630.nc 1869 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1870_c090630.nc 1870 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1871_c090630.nc 1871 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1872_c090630.nc 1872 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1873_c090630.nc 1873 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1874_c090630.nc 1874 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1875_c090630.nc 1875 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1876_c090630.nc 1876 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1877_c090630.nc 1877 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1878_c090630.nc 1878 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1879_c090630.nc 1879 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1880_c090630.nc 1880 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1881_c090630.nc 1881 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1882_c090630.nc 1882 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1883_c090630.nc 1883 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1884_c090630.nc 1884 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1885_c090630.nc 1885 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1886_c090630.nc 1886 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1887_c090630.nc 1887 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1888_c090630.nc 1888 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1889_c090630.nc 1889 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1890_c090630.nc 1890 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1891_c090630.nc 1891 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1892_c090630.nc 1892 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1893_c090630.nc 1893 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1894_c090630.nc 1894 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1895_c090630.nc 1895 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1896_c090630.nc 1896 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1897_c090630.nc 1897 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1898_c090630.nc 1898 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1899_c090630.nc 1899 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1900_c090630.nc 1900 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1901_c090630.nc 1901 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1902_c090630.nc 1902 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1903_c090630.nc 1903 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1904_c090630.nc 1904 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1905_c090630.nc 1905 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1906_c090630.nc 1906 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1907_c090630.nc 1907 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1908_c090630.nc 1908 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1909_c090630.nc 1909 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1910_c090630.nc 1910 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1911_c090630.nc 1911 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1912_c090630.nc 1912 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1913_c090630.nc 1913 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1914_c090630.nc 1914 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1915_c090630.nc 1915 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1916_c090630.nc 1916 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1917_c090630.nc 1917 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1918_c090630.nc 1918 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1919_c090630.nc 1919 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1920_c090630.nc 1920 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1921_c090630.nc 1921 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1922_c090630.nc 1922 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1923_c090630.nc 1923 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1924_c090630.nc 1924 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1925_c090630.nc 1925 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1926_c090630.nc 1926 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1927_c090630.nc 1927 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1928_c090630.nc 1928 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1929_c090630.nc 1929 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1930_c090630.nc 1930 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1931_c090630.nc 1931 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1932_c090630.nc 1932 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1933_c090630.nc 1933 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1934_c090630.nc 1934 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1935_c090630.nc 1935 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1936_c090630.nc 1936 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1937_c090630.nc 1937 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1938_c090630.nc 1938 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1939_c090630.nc 1939 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1940_c090630.nc 1940 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1941_c090630.nc 1941 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1942_c090630.nc 1942 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1943_c090630.nc 1943 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1944_c090630.nc 1944 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1945_c090630.nc 1945 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1946_c090630.nc 1946 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1947_c090630.nc 1947 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1948_c090630.nc 1948 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1949_c090630.nc 1949 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1950_c090630.nc 1950 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1951_c090630.nc 1951 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1952_c090630.nc 1952 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1953_c090630.nc 1953 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1954_c090630.nc 1954 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1955_c090630.nc 1955 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1956_c090630.nc 1956 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1957_c090630.nc 1957 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1958_c090630.nc 1958 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1959_c090630.nc 1959 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1960_c090630.nc 1960 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1961_c090630.nc 1961 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1962_c090630.nc 1962 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1963_c090630.nc 1963 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1964_c090630.nc 1964 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1965_c090630.nc 1965 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1966_c090630.nc 1966 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1967_c090630.nc 1967 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1968_c090630.nc 1968 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1969_c090630.nc 1969 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1970_c090630.nc 1970 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1971_c090630.nc 1971 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1972_c090630.nc 1972 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1973_c090630.nc 1973 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1974_c090630.nc 1974 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1975_c090630.nc 1975 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1976_c090630.nc 1976 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1977_c090630.nc 1977 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1978_c090630.nc 1978 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1979_c090630.nc 1979 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1980_c090630.nc 1980 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1981_c090630.nc 1981 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1982_c090630.nc 1982 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1983_c090630.nc 1983 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1984_c090630.nc 1984 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1985_c090630.nc 1985 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1986_c090630.nc 1986 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1987_c090630.nc 1987 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1988_c090630.nc 1988 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1989_c090630.nc 1989 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1990_c090630.nc 1990 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1991_c090630.nc 1991 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1992_c090630.nc 1992 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1993_c090630.nc 1993 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1994_c090630.nc 1994 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1995_c090630.nc 1995 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1996_c090630.nc 1996 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1997_c090630.nc 1997 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1998_c090630.nc 1998 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1999_c090630.nc 1999 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2000_c090630.nc 2000 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2001_c090630.nc 2001 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2002_c090630.nc 2002 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2003_c090630.nc 2003 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2004_c090630.nc 2004 +/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc2005_c090630.nc 2005 diff --git a/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl b/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl new file mode 100755 index 0000000000..83d1bd322b --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata.pl @@ -0,0 +1,863 @@ +#!/usr/bin/env perl +# +# Oct/30/2008 Erik Kluzek +# +# mksurfdata.pl Perl script to make surface datasets for all resolutions. +# +# +use Cwd; +use strict; +use English; +use IO::File; +use Getopt::Long; + + +#Figure out where configure directory is and where can use the XML/Lite module from +my $ProgName; +($ProgName = $PROGRAM_NAME) =~ s!(.*)/!!; # name of program +my $ProgDir = $1; # name of directory where program lives + +my $cwd = getcwd(); # current working directory +my $scrdir; + +if ($ProgDir) { $scrdir = $ProgDir; } +else { $scrdir = $cwd; } + +my $debug = 0; + +#----------------------------------------------------------------------------------------------- +# Add $scrdir to the list of paths that Perl searches for modules +my @dirs = ( $scrdir, "$scrdir/../../../../../cime/utils/perl5lib", + ); +unshift @INC, @dirs; +my $result = eval "require XML::Lite"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"XML/Lite.pm\" from directories: @dirs ** +EOF +} +my $result = eval "require Build::NamelistDefinition"; +if ( ! defined($result) ) { + die <<"EOF"; +** Cannot find perl module \"Build/NamelistDefinition.pm\" from directories: @dirs ** +EOF +} +my $nldef_file = "$scrdir/../../../bld/namelist_files/namelist_definition_clm4_5.xml"; + +my $definition = Build::NamelistDefinition->new( $nldef_file ); + +my $CSMDATA = "/glade/p/cesm/cseg/inputdata"; + +my %opts = ( + hgrid=>"all", + rcp=>"-999.9", + debug=>0, + exedir=>undef, + allownofile=>undef, + crop=>undef, + hirespft=>undef, + years=>"1850,2000", + glc_nec=>0, + merge_gis=>undef, + inlandwet=>undef, + help=>0, + mv=>0, + pft_override=>undef, + pft_frc=>undef, + pft_idx=>undef, + soil_override=>undef, + soil_cly=>undef, + soil_snd=>undef, + soil_col=>undef, + soil_fmx=>undef, + outnc_double=>undef, + outnc_dims=>"2", + usrname=>"", + usr_mapdir=>"../../shared/mkmapdata", + dynpft=>undef, + csmdata=>$CSMDATA, + urban_skip_abort_on_invalid_data_check=>undef, + ); + +my $numpft = 16; + +#----------------------------------------------------------------------------------------------- +sub usage { + die < [OPTIONS] + -res [or -r] is the supported resolution(s) to use for files (by default $opts{'hgrid'} ). + + + For unsupported, user-specified resolutions: + $ProgName -res usrspec -usr_gname -usr_gdate [OPTIONS] + -usr_gname "user_gname" User resolution name to find grid file with + (only used if -res is set to 'usrspec') + -usr_gdate "user_gdate" User map date to find mapping files with + (only used if -res is set to 'usrspec') + NOTE: all mapping files are assumed to be in mkmapdata + - and the user needs to have invoked mkmapdata in + that directory first + -usr_mapdir "mapdirectory" Directory where the user-supplied mapping files are + Default: $opts{'usr_mapdir'} + +OPTIONS + -allownofile Allow the script to run even if one of the input files + does NOT exist. + -crop Add in crop datasets + -dinlc [or -l] Enter the directory location for inputdata + (default $opts{'csmdata'}) + -debug [or -d] Do not actually run -- just print out what + would happen if ran. + -dynpft "filename" Dynamic PFT/harvesting file to use + (rather than create it on the fly) + (must be consistent with first year) + -glc_nec "number" Number of glacier elevation classes to use (by default $opts{'glc_nec'}) + -merge_gis If you want to use the glacier dataset that merges in + the Greenland Ice Sheet data that CISM uses (typically + used only if consistency with CISM is important) + -hirespft If you want to use the high-resolution pft dataset rather + than the default lower resolution dataset + (low resolution is at half-degree, high resolution at 3minute) + (hires only available for present-day [2000]) + -exedir "directory" Directory where mksurfdata_map program is + (by default assume it is in the current directory) + -inlandwet If you want to allow inland wetlands + -mv If you want to move the files after creation to the + correct location in inputdata + (by default -nomv is assumed so files are NOT moved) + -years [or -y] Simulation year(s) to run over (by default $opts{'years'}) + (can also be a simulation year range: i.e. 1850-2000) + -help [or -h] Display this help. + + -rcp [or -c] "rep-con-path" Representative concentration pathway(s) to use for + future scenarios + (by default $opts{'rcp'}, where -999.9 means historical ). + -usrname "clm_usrdat_name" CLM user data name to find grid file with. + + NOTE: years, res, and rcp can be comma delimited lists. + + +OPTIONS to override the mapping of the input gridded data with hardcoded input + + -pft_frc "list of fractions" Comma delimited list of percentages for veg types + -pft_idx "list of veg index" Comma delimited veg index for each fraction + -soil_cly "% of clay" % of soil that is clay + -soil_col "soil color" Soil color (1 [light] to 20 [dark]) + -soil_fmx "soil fmax" Soil maximum saturated fraction (0-1) + -soil_snd "% of sand" % of soil that is sand + +OPTIONS to work around bugs? + -urban_skip_abort_on_invalid_data_check + do not abort on an invalid data check in urban. + Added 2015-01 to avoid recompiling as noted in + /glade/p/cesm/cseg/inputdata/lnd/clm2/surfdata_map/README_c141219 + +EOF +} + +sub check_soil { +# +# check that the soil options are set correctly +# + foreach my $type ( "soil_cly", "soil_snd" ) { + if ( ! defined($opts{$type} ) ) { + die "ERROR: Soil variables were set, but $type was NOT set\n"; + } + } + #if ( $opts{'soil_col'} < 0 || $opts{'soil_col'} > 20 ) { + # die "ERROR: Soil color is out of range = ".$opts{'soil_col'}."\n"; + #} + my $texsum = $opts{'soil_cly'} + $opts{'soil_snd'}; + my $loam = 100.0 - $texsum; + if ( $texsum < 0.0 || $texsum > 100.0 ) { + die "ERROR: Soil textures are out of range: clay = ".$opts{'soil_cly'}. + " sand = ".$opts{'soil_snd'}." loam = $loam\n"; + } +} + +sub check_soil_col_fmx { +# +# check that the soil color or soil fmax option is set correctly +# + if ( defined($opts{'soil_col'}) ) { + if ( $opts{'soil_col'} < 0 || $opts{'soil_col'} > 20 ) { + die "ERROR: Soil color is out of range = ".$opts{'soil_col'}."\n"; + } + } + if ( defined($opts{'soil_fmx'}) ) { + if ( $opts{'soil_fmx'} < 0.0 || $opts{'soil_fmx'} > 1.0 ) { + die "ERROR: Soil fmax is out of range = ".$opts{'soil_fmx'}."\n"; + } + } +} + +sub check_pft { +# +# check that the pft options are set correctly +# + # Eliminate starting and ending square brackets + $opts{'pft_idx'} =~ s/^\[//; + $opts{'pft_idx'} =~ s/\]$//; + $opts{'pft_frc'} =~ s/^\[//; + $opts{'pft_frc'} =~ s/\]$//; + foreach my $type ( "pft_idx", "pft_frc" ) { + if ( ! defined($opts{$type} ) ) { + die "ERROR: PFT variables were set, but $type was NOT set\n"; + } + } + my @pft_idx = split( /,/, $opts{'pft_idx'} ); + my @pft_frc = split( /,/, $opts{'pft_frc'} ); + if ( $#pft_idx != $#pft_frc ) { + die "ERROR: PFT arrays are different sizes: pft_idx and pft_frc\n"; + } + my $sumfrc = 0.0; + for( my $i = 0; $i <= $#pft_idx; $i++ ) { + # check index in range + if ( $pft_idx[$i] < 0 || $pft_idx[$i] > $numpft ) { + die "ERROR: pft_idx out of range = ".$opts{'pft_idx'}."\n"; + } + # make sure there are no duplicates + for( my $j = 0; $j < $i; $j++ ) { + if ( $pft_idx[$i] == $pft_idx[$j] ) { + die "ERROR: pft_idx has duplicates = ".$opts{'pft_idx'}."\n"; + } + } + # check fraction in range + if ( $pft_frc[$i] <= 0.0 || $pft_frc[$i] > 100.0 ) { + die "ERROR: pft_frc out of range (>0.0 and <=100.0) = ".$opts{'pft_frc'}."\n"; + } + $sumfrc = $sumfrc + $pft_frc[$i]; + } + # check that fraction sums up to 100% + if ( abs( $sumfrc - 100.0) > 1.e-6 ) { + die "ERROR: pft_frc does NOT add up to 100% = ".$opts{'pft_frc'}."\n"; + } + +} + +# Perl trim function to remove whitespace from the start and end of the string +sub trim($) +{ + my $string = shift; + $string =~ s/^\s+//; + $string =~ s/\s+$//; + return $string; +} + +sub write_transient_timeseries_file { + my ($transient, $desc, $sim_yr0, $sim_yrn, $queryfilopts, $resol, $rcp, $mkcrop_off, $sim_yr_surfdat) = @_; + + my $strlen = 195; + my $dynpft_format = "%-${strlen}.${strlen}s %4.4d\n"; + my $landuse_timeseries_text_file; + if ( $transient ) { + if ( ! defined($opts{'dynpft'}) && ! $opts{'pft_override'} ) { + $landuse_timeseries_text_file = "landuse_timeseries_$desc.txt"; + my $fh_landuse_timeseries = IO::File->new; + $fh_landuse_timeseries->open( ">$landuse_timeseries_text_file" ) or die "** can't open file: $landuse_timeseries_text_file\n"; + print "Writing out landuse_timeseries text file: $landuse_timeseries_text_file\n"; + for( my $yr = $sim_yr0; $yr <= $sim_yrn; $yr++ ) { + # Note that, in the options in this query, we always use + # ${mkcrop_off}, even if we're generating datasets for crop. This + # is because, for now, we're using the non-crop transient raw data + # even when creating transient crop datasets. (See bug 2097.) + my $vegtypyr = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year=$yr,rcp=${rcp}${mkcrop_off} -var mksrf_fvegtyp -namelist clmexp`; + chomp( $vegtypyr ); + printf $fh_landuse_timeseries $dynpft_format, $vegtypyr, $yr; + if ( $yr % 100 == 0 ) { + print "year: $yr\n"; + } + } + $fh_landuse_timeseries->close; + print "Done writing file\n"; + } elsif ( $opts{'pft_override'} && defined($opts{'dynpft'}) ) { + $landuse_timeseries_text_file = $opts{'dynpft'}; + } else { + $landuse_timeseries_text_file = "landuse_timeseries_override_$desc.txt"; + my $fh_landuse_timeseries = IO::File->new; + $fh_landuse_timeseries->open( ">$landuse_timeseries_text_file" ) or die "** can't open file: $landuse_timeseries_text_file\n"; + my $frstpft = "$opts{'pft_frc'}" . + "$opts{'pft_idx'}" . + "0,0,0,0,00"; + print "Writing out landuse_timeseries text file: $landuse_timeseries_text_file\n"; + if ( (my $len = length($frstpft)) > $strlen ) { + die "ERROR PFT line is too long ($len): $frstpft\n"; + } + # NOTE(wjs, 2014-12-04) Using sim_yr_surfdat here rather than + # sim_yr0. As far as I can tell, it seems somewhat arbitrary which one + # we use, but sim_yr_surfdat seems more like what's intended. + printf $fh_landuse_timeseries $dynpft_format, $frstpft, $sim_yr_surfdat; + $fh_landuse_timeseries->close; + print "Done writing file\n"; + } + } + return $landuse_timeseries_text_file; +} + +sub write_namelist_file { + my ($ofile, $glc_nec, $griddata, $map, $datfil, $double, + $all_urb, $no_inlandwet, $vegtyp, $res, $desc, $sdate, + $transient, $landuse_timeseries_text_file, $setnumpft, + $res, $rcp, $sim_year, $nl) = @_; + + + my $fh = IO::File->new; + my $nl = "${ofile}.namelist"; + $fh->open( ">$nl" ) or die "** can't open file: $nl\n"; + print "CSMDATA is $CSMDATA \n"; + print $fh <<"EOF"; +&clmexp + nglcec = $glc_nec + mksrf_fgrid = '$griddata' + map_fpft = '$map->{'veg'}' + map_fglacier = '$map->{'glc'}' + map_fsoicol = '$map->{'col'}' + map_furban = '$map->{'urb'}' + map_fmax = '$map->{'fmx'}' + map_forganic = '$map->{'org'}' + map_flai = '$map->{'lai'}' + map_fharvest = '$map->{'lai'}' + map_flakwat = '$map->{'lak'}' + map_fwetlnd = '$map->{'wet'}' + map_fvocef = '$map->{'voc'}' + map_fsoitex = '$map->{'tex'}' + map_furbtopo = '$map->{'utp'}' + map_flndtopo = '$map->{'top'}' + map_fgdp = '$map->{'gdp'}' + map_fpeat = '$map->{'peat'}' + map_fabm = '$map->{'abm'}' + map_ftopostats = '$map->{'topostats'}' + map_fvic = '$map->{'vic'}' + map_fch4 = '$map->{'ch4'}' + mksrf_fsoitex = '$datfil->{'tex'}' + mksrf_forganic = '$datfil->{'org'}' + mksrf_flakwat = '$datfil->{'lak'}' + mksrf_fwetlnd = '$datfil->{'wet'}' + mksrf_fmax = '$datfil->{'fmx'}' + mksrf_fglacier = '$datfil->{'glc'}' + mksrf_fvocef = '$datfil->{'voc'}' + mksrf_furbtopo = '$datfil->{'utp'}' + mksrf_flndtopo = '$datfil->{'top'}' + mksrf_fgdp = '$datfil->{'gdp'}' + mksrf_fpeat = '$datfil->{'peat'}' + mksrf_fabm = '$datfil->{'abm'}' + mksrf_ftopostats = '$datfil->{'topostats'}' + mksrf_fvic = '$datfil->{'vic'}' + mksrf_fch4 = '$datfil->{'ch4'}' + outnc_double = $double + all_urban = $all_urb + no_inlandwet = $no_inlandwet + mksrf_furban = '$datfil->{'urb'}' +EOF + if ( defined($opts{'soil_override'}) ) { + print $fh <<"EOF"; + soil_clay = $opts{'soil_cly'} + soil_sand = $opts{'soil_snd'} +EOF + } + if ( defined($opts{'pft_override'}) ) { + print $fh <<"EOF"; + pft_frc = $opts{'pft_frc'} + pft_idx = $opts{'pft_idx'} +EOF + } + + print $fh <<"EOF"; + mksrf_fvegtyp = '$vegtyp' + mksrf_fsoicol = '$datfil->{'col'}' + mksrf_flai = '$datfil->{'lai'}' +EOF + print $fh <<"EOF"; + fsurdat = '$ofile.nc' + fsurlog = '$ofile.log' +EOF + + my $ofile_ts = "landuse.timeseries_${res}_${desc}_${sdate}"; + if ( $transient ) { + print $fh <<"EOF"; + mksrf_fdynuse = '$landuse_timeseries_text_file' + fdyndat = '$ofile_ts.nc' +EOF + } else { + print $fh <<"EOF"; + mksrf_fdynuse = ' ' + fdyndat = ' ' +EOF + } + if ( $setnumpft ) { + print $fh <<"EOF"; + $setnumpft +EOF + } + + if ( $opts{'urban_skip_abort_on_invalid_data_check'} ) { + print $fh <<"EOF"; + urban_skip_abort_on_invalid_data_check = .true. +EOF + } + # end the namelist + print $fh <<"EOF"; +/ +EOF + + $fh->close; + print "resolution: $res rcp=$rcp sim_year = $sim_year\n"; + print "namelist: $nl\n"; + # + # Print namelist file + $fh->open( "<$nl" ) or die "** can't open file: $nl\n"; + while( $_ = <$fh> ) { + print $_; + } + $fh->close; + return $nl, $ofile_ts; +} + +#----------------------------------------------------------------------------------------------- + + my $cmdline = "@ARGV"; + GetOptions( + "allownofile" => \$opts{'allownofile'}, + "r|res=s" => \$opts{'hgrid'}, + "usr_gname=s" => \$opts{'usr_gname'}, + "usr_gdate=s" => \$opts{'usr_gdate'}, + "usr_mapdir=s" => \$opts{'usr_mapdir'}, + "crop" => \$opts{'crop'}, + "hirespft" => \$opts{'hirespft'}, + "c|rcp=s" => \$opts{'rcp'}, + "l|dinlc=s" => \$opts{'csmdata'}, + "d|debug" => \$opts{'debug'}, + "dynpft=s" => \$opts{'dynpft'}, + "y|years=s" => \$opts{'years'}, + "exedir=s" => \$opts{'exedir'}, + "h|help" => \$opts{'help'}, + "usrname=s" => \$opts{'usrname'}, + "glc_nec=i" => \$opts{'glc_nec'}, + "merge_gis" => \$opts{'merge_gis'}, + "inlandwet" => \$opts{'inlandwet'}, + "mv" => \$opts{'mv'}, + "pft_frc=s" => \$opts{'pft_frc'}, + "pft_idx=s" => \$opts{'pft_idx'}, + "soil_col=i" => \$opts{'soil_col'}, + "soil_fmx=f" => \$opts{'soil_fmx'}, + "soil_cly=f" => \$opts{'soil_cly'}, + "soil_snd=f" => \$opts{'soil_snd'}, + "urban_skip_abort_on_invalid_data_check" => \$opts{'urban_skip_abort_on_invalid_data_check'}, + ) or usage(); + + # Check for unparsed arguments + if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); + } + if ( $opts{'help'} ) { + usage(); + } + # If csmdata was changed from the default + if ( $CSMDATA ne $opts{'csmdata'} ) { + $CSMDATA = $opts{'csmdata'}; + } + my $glc_nec = $opts{'glc_nec'}; + my $no_inlandwet = ".true."; + if (defined($opts{'inlandwet'})) { + $no_inlandwet = ".false."; + } + # + # Set disk location to send files to, and list resolutions to operate over, + # set filenames, and short-date-name + # + my @hresols; + my $mapdate; + if ( $opts{'hgrid'} eq "all" ) { + my @all_hresols = $definition->get_valid_values( "res" ); + @hresols = @all_hresols; + } elsif ( $opts{'hgrid'} eq "usrspec" ) { + @hresols = $opts{'usr_gname'}; + $mapdate = $opts{'usr_gdate'}; + } else { + @hresols = split( ",", $opts{'hgrid'} ); + # Check that resolutions are valid + foreach my $res ( @hresols ) { + if ( ! $definition->is_valid_value( "res", "'$res'" ) ) { + if ( $opts{'usrname'} eq "" || $res ne $opts{'usrname'} ) { + print "** Invalid resolution: $res\n"; + usage(); + } + } + } + } + # + # Set years to run over + # + my @years = split( ",", $opts{'years'} ); + # Check that resolutions are valid + foreach my $sim_year ( @years ) { + if ("-" eq substr($sim_year, 4, 1)) { + # range of years for transient run + if ( ! $definition->is_valid_value( "sim_year_range", "'$sim_year'" ) ) { + print "** Invalid simulation simulation year range: $sim_year\n"; + usage(); + } + } else { + # single year. + if ( ! $definition->is_valid_value( "sim_year", $sim_year ) ) { + print "** Invalid simulation year: $sim_year\n"; + usage(); + } + } + } + # + # Set rcp to use + # + my @rcpaths = split( ",", $opts{'rcp'} ); + # Check that rcp is valid + foreach my $rcp ( @rcpaths ) { + if ( ! $definition->is_valid_value( "rcp", $rcp ) ) { + if ( ! $definition->is_valid_value( "rcp", "$rcp" ) ) { + print "** Invalid rcp: $rcp\n"; + usage(); + } + } + } + # Check if soil set + if ( defined($opts{'soil_cly'}) || + defined($opts{'soil_snd'}) ) { + &check_soil( ); + $opts{'soil_override'} = 1; + } + # Check if pft set + if ( defined($opts{'crop'}) ) { $numpft = 78; } # First set numpft if crop is on + if ( defined($opts{'pft_frc'}) || defined($opts{'pft_idx'}) ) { + &check_pft( ); + $opts{'pft_override'} = 1; + } + # Check if dynpft set and is valid filename + if ( defined($opts{'dynpft'}) ) { + if ( ! -f $opts{'dynpft'} ) { + print "** Dynamic PFT file does NOT exist: $opts{'dynpft'}\n"; + usage(); + } + } + + my $sdate = "c" . `date +%y%m%d`; + chomp( $sdate ); + + my @ncfiles; + my @lfiles; + my @tsfiles; + my $cfile = "clm.input_data_files"; + if ( -f "$cfile" ) { + `/bin/mv -f $cfile ${cfile}.previous`; + } + my $cfh = IO::File->new; + $cfh->open( ">$cfile" ) or die "** can't open file: $cfile\n"; + system( "\rm -f $cfile" ); + system( "touch $cfile" ); + print $cfh <<"EOF"; +#! /bin/csh -f +set CSMDATA = $CSMDATA +EOF + system( "chmod +x $cfile" ); + my $svnrepo = "https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata"; + my $svnmesg = "Update fsurdat files with mksurfdata_map"; + my $surfdir = "lnd/clm2/surfdata"; + + # string to add to options for crop off or on + my $mkcrop_off = ",crop='off'"; + my $mkcrop_on = ",crop='on'"; + + # + # Loop over all resolutions listed + # + foreach my $res ( @hresols ) { + # + # Query the XML default file database to get the appropriate files + # + my $queryopts, my $queryfilopts; + if ( $opts{'hgrid'} eq "usrspec" ) { + $queryopts = "-csmdata $CSMDATA -silent -justvalue"; + } else { + $queryopts = "-res $res -csmdata $CSMDATA -silent -justvalue"; + } + $queryfilopts = "$queryopts -onlyfiles -phys clm4_5 "; + my $mkcrop = $mkcrop_off; + my $setnumpft = ""; + if ( defined($opts{'crop'}) ) { + $mkcrop = $mkcrop_on; + $setnumpft = "numpft = $numpft" + } + my $usrnam = ""; + if ( $opts{'usrname'} ne "" && $res eq $opts{'usrname'} ) { + $usrnam = "-usrname ".$opts{'usrname'}; + } + # + # Mapping files + # + my %map; my %hgrd; my %lmsk; my %datfil; + my $hirespft = "off"; + if ( defined($opts{'hirespft'}) ) { + $hirespft = "on"; + } + my $merge_gis = "off"; + if ( defined($opts{'merge_gis'}) ) { + $merge_gis = "on"; + } + my $mopts = "$queryopts -namelist default_settings $usrnam"; + my $mkopts = "-csmdata $CSMDATA -silent -justvalue -namelist clmexp $usrnam"; + foreach my $typ ( "lak", "veg", "voc", "top", "tex", "col", + "fmx", "lai", "urb", "org", "glc", "utp", "wet", + "gdp", "peat","abm", "topostats" , "vic", "ch4") { + my $lmask = `$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ,mergeGIS=$merge_gis,hirespft=$hirespft -var lmask`; + $lmask = trim($lmask); + my $hgrid_cmd = "$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ,hirespft=$hirespft -var hgrid"; + my $hgrid = `$hgrid_cmd`; + if ($debug) { + print "query to determine hgrid:\n $hgrid_cmd \n\n"; + } + $hgrid = trim($hgrid); + my $filnm = `$scrdir/../../../bld/queryDefaultNamelist.pl $mopts -options type=$typ -var mksrf_filename`; + $filnm = trim($filnm); + $hgrd{$typ} = $hgrid; + $lmsk{$typ} = $lmask; + if ( $opts{'hgrid'} eq "usrspec" ) { + $map{$typ} = $opts{'usr_mapdir'}."/map_${hgrid}_${lmask}_to_${res}_nomask_aave_da_c${mapdate}\.nc"; + } else { + $map{$typ} = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts -namelist clmexp -options frm_hgrid=$hgrid,frm_lmask=$lmask,to_hgrid=$res,to_lmask=nomask -var map`; + } + $map{$typ} = trim($map{$typ}); + if ( $map{$typ} !~ /[^ ]+/ ) { + die "ERROR: could NOT find a mapping file for this resolution: $res and type: $typ at $hgrid and $lmask.\n"; + } + if ( ! defined($opts{'allownofile'}) && ! -f $map{$typ} ) { + die "ERROR: mapping file for this resolution does NOT exist ($map{$typ}).\n"; + } + my $typ_cmd = "$scrdir/../../../bld/queryDefaultNamelist.pl $mkopts -options hgrid=$hgrid,lmask=$lmask,mergeGIS=$merge_gis$mkcrop -var $filnm"; + $datfil{$typ} = `$typ_cmd`; + $datfil{$typ} = trim($datfil{$typ}); + if ( $datfil{$typ} !~ /[^ ]+/ ) { + die "ERROR: could NOT find a $filnm data file for this resolution: $hgrid and type: $typ and $lmask.\n$typ_cmd\n\n"; + } + if ( ! defined($opts{'allownofile'}) && ! -f $datfil{$typ} ) { + die "ERROR: data file for this resolution does NOT exist ($datfil{$typ}).\n"; + } + } + # + # Grid file from the pft map file or grid if not found + # + my $griddata = trim($map{'veg'}); + if ( $griddata eq "" ) { + $griddata = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $usrnam -var fatmgrid`; + if ( $griddata eq "" ) { + die "ERROR: could NOT find a grid data file for this resolution: $res.\n"; + } + } + my $desc; + my $desc_surfdat; + # + # Check if all urban single point dataset + # + my @all_urb = ( "1x1_camdenNJ","1x1_vancouverCAN", "1x1_mexicocityMEX", "1x1_urbanc_alpha" ); + my $all_urb = ".false."; + my $urb_pt = 0; + foreach my $urb_res ( @all_urb ) { + if ( $res eq $urb_res ) { + $all_urb = ".true."; + if ( $res ne "1x1_camdenNJ" ) { $urb_pt = 1; } + } + } + # + # Always run at double precision for output + # + my $double = ".true."; + # + # Loop over each sim_year + # + RCP: foreach my $rcp ( @rcpaths ) { + # + # Loop over each sim_year + # + SIM_YEAR: foreach my $sim_year ( @years ) { + # + # Skip if urban unless sim_year=2000 + # + if ( $urb_pt && $sim_year != 2000 ) { + print "For urban -- skip this simulation year = $sim_year\n"; + next SIM_YEAR; + } + # + # If year is 1850-2000 actually run 1850-2005 + # + if ( $sim_year eq "1850-2000" ) { + my $actual = "1850-2005"; + print "For $sim_year actually run $actual\n"; + $sim_year = $actual; + } + my $urbdesc = "urb3den"; + my $resol = "-res $hgrd{'veg'}"; + my $sim_yr0 = $sim_year; + my $sim_yrn = $sim_year; + my $transient = 0; + if ( $sim_year =~ /([0-9]+)-([0-9]+)/ ) { + $sim_yr0 = $1; + $sim_yrn = $2; + $transient = 1; + } + # determine simulation year to use for the surface dataset: + my $sim_yr_surfdat = $sim_yr0; + if ($transient && defined($opts{'crop'})) { + # For transient crop, we currently can only generate a year-2000 surface + # dataset - not a year-1850 surface dataset as is typically done for + # transient cases. See http://bugs.cgd.ucar.edu/show_bug.cgi?id=2010 + print "For transient crop, generating a year-2000 surface dataset rather than the typical year-1850 surface dataset\n"; + $sim_yr_surfdat = 2000; + } + + my $cmd = "$scrdir/../../../bld/queryDefaultNamelist.pl $queryfilopts $resol -options sim_year=${sim_yr_surfdat}$mkcrop -var mksrf_fvegtyp -namelist clmexp"; + my $vegtyp = `$cmd`; + chomp( $vegtyp ); + if ( $vegtyp eq "" ) { + die "** trouble getting vegtyp file with: $cmd\n"; + } + my $options = ""; + my $crpdes = ""; + if ( $mkcrop ne "" ) { + $options = "-options $mkcrop"; + $crpdes = sprintf("%2.2dpfts_", $numpft); + } + if ( $rcp != -999.9 ) { + $desc = sprintf( "%s%2.1f_simyr%4.4d-%4.4d", "rcp", $rcp, $sim_yr0, $sim_yrn ); + $desc_surfdat = sprintf( "%s%2.1f_simyr%4.4d", "rcp", $rcp, $sim_yr_surfdat ); + } elsif ( $crpdes ne "") { + $desc = sprintf( "hist_%ssimyr%4.4d-%4.4d", $crpdes, $sim_yr0, $sim_yrn ); + $desc_surfdat = sprintf( "%ssimyr%4.4d", $crpdes, $sim_yr_surfdat ); + } else { + $desc = sprintf( "hist_simyr%4.4d-%4.4d", $sim_yr0, $sim_yrn ); + $desc_surfdat = sprintf( "simyr%4.4d", $sim_yr_surfdat ); + } + my $ofile = "surfdata_${res}_${desc_surfdat}_${sdate}"; + + my ($landuse_timeseries_text_file) = write_transient_timeseries_file( + $transient, $desc, $sim_yr0, $sim_yrn, + $queryfilopts, $resol, $rcp, $mkcrop_off, + $sim_yr_surfdat); + my ($nl, $ofile_ts) = write_namelist_file( + $ofile, $glc_nec, $griddata, \%map, \%datfil, $double, + $all_urb, $no_inlandwet, $vegtyp, $res, $desc, $sdate, + $transient, $landuse_timeseries_text_file, $setnumpft, + $res, $rcp, $sim_year); + + # + # Delete previous versions of files that will be created + # + system( "/bin/rm -f $ofile.nc $ofile.log" ); + # + # Run mksurfdata_map with the namelist file + # + my $exedir = $scrdir; + if ( defined($opts{'exedir'}) ) { + $exedir = $opts{'exedir'}; + } + print "$exedir/mksurfdata_map < $nl\n"; + my $filehead; + my $tsfilehead; + if ( ! $opts{'debug'} ) { + system( "$exedir/mksurfdata_map < $nl" ); + if ( $? ) { die "ERROR in mksurfdata_map: $?\n"; } + } else { + $filehead = "surfdata_$res"; + $tsfilehead = "landuse.timeseries_testfile"; + system( "touch $filehead.nc" ); + system( "touch $tsfilehead.nc" ); + system( "touch $filehead.log" ); + } + print "\n===========================================\n\n"; + # + # Check that files were created + # + @ncfiles = glob( "$ofile.nc" ); + if ( $#ncfiles != 0 ) { + die "ERROR surfdata netcdf file was NOT created!\n"; + } + chomp( $ncfiles[0] ); + @lfiles = glob( "$ofile.log" ); + chomp( $lfiles[0] ); + @tsfiles = glob( "$ofile_ts.nc" ); + chomp( $tsfiles[0] ); + if ( $#tsfiles != 0 ) { + die "ERROR surfdata landuse_timeseries netcdf file was NOT created!\n"; + } + # + # If urban point, overwrite urban variables from previous surface dataset to this one + # + if ( $urb_pt ) { + my $prvsurfdata = `$scrdir/../../../bld/queryDefaultNamelist.pl $queryopts -var fsurdat`; + if ( $? != 0 ) { + die "ERROR:: previous surface dataset file NOT found\n"; + } + chomp( $prvsurfdata ); + my $varlist = "CANYON_HWR,EM_IMPROAD,EM_PERROAD,EM_ROOF,EM_WALL,HT_ROOF,THICK_ROOF,THICK_WALL,T_BUILDING_MAX,T_BUILDING_MIN,WIND_HGT_CANYON,WTLUNIT_ROOF,WTROAD_PERV,ALB_IMPROAD_DIR,ALB_IMPROAD_DIF,ALB_PERROAD_DIR,ALB_PERROAD_DIF,ALB_ROOF_DIR,ALB_ROOF_DIF,ALB_WALL_DIR,ALB_WALL_DIF,TK_ROOF,TK_WALL,TK_IMPROAD,CV_ROOF,CV_WALL,CV_IMPROAD,NLEV_IMPROAD,PCT_URBAN,URBAN_REGION_ID"; + print "Overwrite urban parameters with previous surface dataset values\n"; + $cmd = "ncks -A -v $varlist $prvsurfdata $ncfiles[0]"; + print "$cmd\n"; + if ( ! $opts{'debug'} ) { system( $cmd ); } + } + # + # Rename files to CSMDATA + # + my $lsvnmesg = "'$svnmesg $urbdesc $desc'"; + if ( -f "$ncfiles[0]" && -f "$lfiles[0]" ) { + my $outdir = "$CSMDATA/$surfdir"; + my $ofile = "surfdata_${res}_${crpdes}${desc_surfdat}_${sdate}"; + my $mvcmd = "/bin/mv -f $ncfiles[0] $outdir/$ofile.nc"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.nc" ); + } + my $mvcmd = "/bin/mv -f $lfiles[0] $outdir/$ofile.log"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.log" ); + } + if ( $opts{'mv'} ) { + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.nc\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.nc " . + "$svnrepo/$surfdir/$ofile.nc\n"; + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.log\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.log " . + "$svnrepo/$surfdir/$ofile.log\n"; + } + # If running a transient case + if ( $transient ) { + $ofile = "landuse.timeseries_${res}_${desc}_${sdate}"; + $mvcmd = "/bin/mv -f $tsfiles[0] $outdir/$ofile.nc"; + if ( ! $opts{'debug'} && $opts{'mv'} ) { + print "$mvcmd\n"; + system( "$mvcmd" ); + chmod( 0444, "$outdir/$ofile.nc" ); + } + if ( $opts{'mv'} ) { + print $cfh "# FILE = \$DIN_LOC_ROOT/$surfdir/$ofile.nc\n"; + print $cfh "svn import -m $lsvnmesg \$CSMDATA/$surfdir/$ofile.nc " . + "$svnrepo/$surfdir/$ofile.nc\n"; + } + } + + } elsif ( ! $opts{'debug'} ) { + die "ERROR files were NOT created: nc=$ncfiles[0] log=$lfiles[0]\n"; + } + if ( (! $opts{'debug'}) && $opts{'mv'} && (-f "$ncfiles[0]" || -f "$lfiles[0]") ) { + die "ERROR files were NOT moved: nc=$ncfiles[0] log=$lfiles[0]\n"; + } + if ( ! $opts{'debug'} ) { + system( "/bin/rm -f $filehead.nc $filehead.log $tsfilehead.nc" ); + } + } # End of sim_year loop + } # End of rcp loop + } + close( $cfh ); + print "Successfully created fsurdat files\n"; diff --git a/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist b/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist new file mode 100644 index 0000000000..e0852e41ff --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/mksurfdata_map.namelist @@ -0,0 +1,51 @@ +&clmexp + nglcec = 0 + mksrf_fgrid = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fpft = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fglacier = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_3x3min_GLOBE-Gardner_to_10x15_nomask_aave_da_c120923.nc' + map_fsoicol = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_furban = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_3x3min_LandScan2004_to_10x15_nomask_aave_da_c120518.nc' + map_fmax = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_3x3min_USGS_to_10x15_nomask_aave_da_c120926.nc' + map_forganic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_5x5min_ISRIC-WISE_to_10x15_nomask_aave_da_c111115.nc' + map_flai = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_fharvest = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_landuse_to_10x15_aave_da_110307.nc' + map_flakwat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_3x3min_MODIS_to_10x15_nomask_aave_da_c111111.nc' + map_fwetlnd = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fvocef = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fsoitex = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_5minx5min_soitex_to_10x15_aave_da_110307.nc' + map_furbtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc' + map_flndtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_10minx10min_topo_to_10x15_aave_da_110307.nc' + map_fgdp = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fpeat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_fabm = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.5x0.5_lanwat_to_10x15_aave_da_110307.nc' + map_ftopostats = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_1km-merge-10min_HYDRO1K-merge-nomask_to_10x15_nomask_aave_da_c130411.nc' + map_fvic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_0.9x1.25_GRDC_to_10x15_nomask_aave_da_c130308.nc' + map_fch4 = '/glade/p/cesm/cseg/inputdata/lnd/clm2/mappingdata/maps/10x15/map_360x720_cruncep_to_10x15_nomask_aave_da_c130326.nc' + mksrf_fsoitex = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_soitex.10level.c010119.nc' + mksrf_forganic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_organic_10level_5x5min_ISRIC-WISE-NCSCD_nlev7_c120830.nc' + mksrf_flakwat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_LakePnDepth_3x3min_simyr2004_c111116.nc' + mksrf_fwetlnd = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_lanwat.050425.nc' + mksrf_fmax = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_fmax_3x3min_USGS_c120911.nc' + mksrf_fglacier = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_glacier_3x3min_simyr2000.c120926.nc' + mksrf_fvocef = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_vocef_0.5x0.5_simyr2000.c110531.nc' + mksrf_furbtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_topo.10min.c080912.nc' + mksrf_flndtopo = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/topodata_10min_USGS_071205.nc' + mksrf_fgdp = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_gdp_0.5x0.5_AVHRR_simyr2000.c130228.nc' + mksrf_fpeat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_peatf_0.5x0.5_AVHRR_simyr2000.c130228.nc' + mksrf_fabm = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_abm_0.5x0.5_AVHRR_simyr2000.c130201.nc' + mksrf_ftopostats = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_topostats_1km-merge-10min_HYDRO1K-merge-nomask_simyr2000.c130402.nc' + mksrf_fvic = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_vic_0.9x1.25_GRDC_simyr2000.c130307.nc' + mksrf_fch4 = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_ch4inversion_360x720_cruncep_simyr2000.c130322.nc' + outnc_double = .true. + all_urban = .false. + no_inlandwet = .true. + mksrf_furban = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120621.nc' + mksrf_fvegtyp = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_landuse_rc1850_c090630.nc' + mksrf_fsoicol = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_soilcol_global_c090324.nc' + mksrf_flai = '/glade/p/cesm/cseg/inputdata/lnd/clm2/rawdata/pftlandusedyn.0.5x0.5.simyr1850-2005.c090630/mksrf_lai_global_c090506.nc' + fsurdat = 'surfdata_10x15_simyr1850_c130412.nc' + fsurlog = 'surfdata_10x15_simyr1850_c130412.log' + mksrf_fdynuse = 'landuse_timeseries_hist_simyr1850-2005.txt' + fdyndat = 'landuse.timeseries_10x15_hist_simyr1850-2005_c130412.nc' + +/ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README new file mode 100644 index 0000000000..6bdb9a9980 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README @@ -0,0 +1,2 @@ +This directory contains files that can be used with the -dynpft option to +mksurfdata.pl when creating the respective single-point transient datasets. diff --git a/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README.landuse_timeseries_smallvilleIA_hist_simyr1850-1855 b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README.landuse_timeseries_smallvilleIA_hist_simyr1850-1855 new file mode 100644 index 0000000000..9cc79f0ecd --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/README.landuse_timeseries_smallvilleIA_hist_simyr1850-1855 @@ -0,0 +1,23 @@ +The file landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt is meant for +use with the 1x1_smallvilleIA test case. It tests a number of aspects of +transient crops: + +- It starts with two years of 100% natural veg (1850 & 1851) + +- It then transitions to 100% crop (1852) + +- It then shifts PCT_CFT while keeping PCT_CROP at 100% (1853) + +- It then increases natural veg to > 0, while also shifting PCT_CFT (1854) + +- It then adjusts both PCT_CROP and PCT_CFT (1855) + +To create a surface dataset and transient dataset that use this file: + +mksurfdata.pl -crop -y 1850-2000 -r 1x1_smallvilleIA -pft_idx 13 -pft_frc 100 -dynpft single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt +mv landuse.timeseries_1x1_smallvilleIA_hist_simyr1850-2005_cYYMMDD.nc landuse.timeseries_1x1_smallvilleIA_hist_simyr1850-1855_cYYMMDD.nc + + +This should be run with a transient crop case that starts in 1850 and runs for +at least 6 years. + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt new file mode 100644 index 0000000000..f6943e957f --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/single_point_dynpft_files/landuse_timeseries_smallvilleIA_hist_simyr1850-1855.txt @@ -0,0 +1,6 @@ +100130,0,0,0,00 1850 +100130,0,0,0,00 1851 +1,1,1,1,1,1,1,1,1,9115,16,17,18,19,20,21,22,23,240,0,0,0,00 1852 +91,1,1,1,1,1,1,1,1,115,16,17,18,19,20,21,22,23,240,0,0,0,00 1853 +50,1,2,2,3,3,4,4,5,5,2113,15,16,17,18,19,20,21,22,23,240,0,0,0,00 1854 +75,1,1,1,1,1,1,1,1,1,1613,15,16,17,18,19,20,21,22,23,240,0,0,0,00 1855 diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/CMakeLists.txt b/components/clm/tools/clm4_5/mksurfdata_map/src/CMakeLists.txt new file mode 100644 index 0000000000..40ceb20868 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/CMakeLists.txt @@ -0,0 +1,18 @@ +# This CMakeLists.txt file is currently used just for building unit tests. + +cmake_minimum_required(VERSION 2.8) +project(mksurfdat_tests Fortran) + +list(APPEND CMAKE_MODULE_PATH ${CESM_CMAKE_MODULE_DIRECTORY}) +include(CESM_utils) + +# Build library containing stuff needed for the unit tests +list(APPEND mksurfdat_sources shr_kind_mod.F90 mkpftConstantsMod.F90 mkpctPftTypeMod.F90 mkutilsMod.F90 mkpftUtilsMod.F90) +add_library(mksurfdat ${mksurfdat_sources}) + +# Tell cmake to look for libraries & mod files here, because this is where we built libraries +include_directories(${CMAKE_CURRENT_BINARY_DIR}) +link_directories(${CMAKE_CURRENT_BINARY_DIR}) + +# Add the test directory +add_subdirectory(test) \ No newline at end of file diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/Filepath b/components/clm/tools/clm4_5/mksurfdata_map/src/Filepath new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/Filepath @@ -0,0 +1 @@ +. diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile b/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile new file mode 100644 index 0000000000..248a913565 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile @@ -0,0 +1,10 @@ +# Makefile for mksurfdata_map + +EXENAME = ../mksurfdata_map + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +include Makefile.common \ No newline at end of file diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common b/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common new file mode 100644 index 0000000000..bf8c80eed6 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/Makefile.common @@ -0,0 +1,360 @@ +#----------------------------------------------------------------------- +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# These macros can be changed by setting environment variables: +# +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS - Additional CPP defines. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS -- Additional load flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#------------------------------------------------------------------------ + +# Set up special characters +null := + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +RM = rm + +# Check for the netcdf library and include directories +ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include +endif + +ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) +endif + +# Set user specified Fortran compiler +ifneq ($(USER_FC),$(null)) + FC := $(USER_FC) +endif + +# Set user specified C compiler +ifneq ($(USER_CC),$(null)) + CC := $(USER_CC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +CPPDEF := $(USER_CPPDEFS) + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +ifeq ($(OPT),TRUE) + CPPDEF := -DOPT +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +# (the vpath itself is set elsewhere, based on this variable) +vpath_dirs := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +vpath_dirs := $(subst $(space),:,$(vpath_dirs)) + +#Primary Target: build the tool +all: $(EXENAME) + +# Get list of files and build dependency file for all .o files +# using perl scripts mkSrcfiles and mkDepends + +SOURCES := $(shell cat Srcfiles) + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +# Set path to Mkdepends script; assumes that any Makefile including +# this file is in a sibling of the src directory, in which Mkdepends +# resides +Mkdepends := ../src/Mkdepends + +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + $(Mkdepends) Filepath Srcfiles > $@ + + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +CPPDEF += -DAIX +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(CPPDEF)) +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90 -qsuffix=f=f90:cpp=F90 \ + $(FPPFLAGS) -g -qfullpath -qarch=auto -qtune=auto -qsigtrap=xl__trcedump -qsclk=micro + +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdff -lnetcdf +ifneq ($(OPT),TRUE) + FFLAGS += -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en -qspillsize=4000 -C +else + FFLAGS += -O2 -qmaxmem=-1 -Q + LDFLAGS += -Q +endif +CFLAGS := -q64 -g $(CPPDEF) -O2 +FFLAGS += $(cpp_path) +CFLAGS += $(cpp_path) + +ifeq ($(SMP),TRUE) + FC = xlf90_r + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp +else + FC = xlf90 +endif + +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + +# Set the default Fortran compiler +ifeq ($(USER_FC),$(null)) + FC := g95 +endif +ifeq ($(USER_CC),$(null)) + CC := gcc +endif + +CFLAGS := -g -O2 +CPPDEF += -DSYSDARWIN -DDarwin -DLINUX +LDFLAGS := + +ifeq ($(FC),g95) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),gfortran) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) \ + -fno-range-check + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),ifort) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c -ftz -g -fp-model precise $(CPPDEF) $(cpp_path) \ + -convert big_endian -assume byterecl -traceback -FR + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + LDFLAGS += -openmp + endif +endif + +ifeq ($(FC),pgf90) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c $(CPPDEF) $(cpp_path) + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + +endif + +ifeq ($(CC),icc) + CFLAGS += -m64 -g + ifeq ($(SMP),TRUE) + CFLAGS += -openmp + endif +endif +ifeq ($(CC),pgcc) + CFLAGS += -g -fast +endif + +CFLAGS += $(CPPDEF) $(cpp_path) +LDFLAGS += -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := ifort + FCTYP := ifort + else + ifeq ($(USER_FC),ftn) + ifneq ($(USER_FCTYP),$(null)) + FCTYP := $(USER_FCTYP) + else + FCTYP := pgf90 + endif + else + FCTYP := $(USER_FC) + endif + endif + CPPDEF += -DLINUX -DFORTRANUNDERSCORE + CFLAGS := $(CPPDEF) + LDFLAGS := $(shell $(LIB_NETCDF)/../bin/nf-config --flibs) + FFLAGS = + + ifeq ($(FCTYP),pgf90) + CC := pgcc + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + CFLAGS += -fast + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + + endif + + ifeq ($(FCTYP),lf95) + ifneq ($(OPT),TRUE) + FFLAGS += -g --chk a,e,s,u -O0 + else + FFLAGS += -O + endif + # Threading only works by putting thread memory on the heap rather than the stack + # (--threadheap). + # As of lf95 version 6.2 the thread stacksize limits are (still) too small to run + # even small + # resolution problems (FV at 10x15 res fails). + ifeq ($(SMP),TRUE) + FFLAGS += --openmp --threadheap 4096 + LDFLAGS += --openmp --threadheap 4096 + endif + endif + ifeq ($(FCTYP),pathf90) + FFLAGS += -extend_source -ftpp -fno-second-underscore + ifneq ($(OPT),TRUE) + FFLAGS += -g -O0 + else + FFLAGS += -O + endif + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + endif + ifeq ($(FCTYP),ifort) + + FFLAGS += -ftz -g -fp-model precise -convert big_endian -assume byterecl -traceback -FR + CFLAGS += -m64 -g + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + CFLAGS += -openmp + LDFLAGS += -openmp + endif + endif + FFLAGS += -c -I$(INC_NETCDF) $(CPPDEF) $(cpp_path) + CFLAGS += $(cpp_path) +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Set the vpath for all file types EXCEPT .o +# We do this for individual file types rather than generally using +# VPATH, because for .o files, we don't want to use files from a +# different build (e.g., in building the unit tester, we don't want to +# use .o files from the main build) +vpath %.F90 $(vpath_dirs) +vpath %.c $(vpath_dirs) +vpath %.h $(vpath_dirs) + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifneq ($(USER_LINKER),$(null)) + LINKER := $(USER_LINKER) +else + LINKER := $(FC) +endif + +.F90.o: + $(FC) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod Depends + +include $(CURDIR)/Depends diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/Mkdepends b/components/clm/tools/clm4_5/mksurfdata_map/src/Mkdepends new file mode 100755 index 0000000000..a75e8fdde0 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/Mkdepends @@ -0,0 +1,327 @@ +#!/usr/bin/env perl + +# Generate dependencies in a form suitable for inclusion into a Makefile. +# The source filenames are provided in a file, one per line. Directories +# to be searched for the source files and for their dependencies are provided +# in another file, one per line. Output is written to STDOUT. +# +# For CPP type dependencies (lines beginning with #include) the dependency +# search is recursive. Only dependencies that are found in the specified +# directories are included. So, for example, the standard include file +# stdio.h would not be included as a dependency unless /usr/include were +# one of the specified directories to be searched. +# +# For Fortran module USE dependencies (lines beginning with a case +# insensitive "USE", possibly preceded by whitespace) the Fortran compiler +# must be able to access the .mod file associated with the .o file that +# contains the module. In order to correctly generate these dependencies +# two restrictions must be observed. +# 1) All modules must be contained in files that have the same base name as +# the module, in a case insensitive sense. This restriction implies that +# there can only be one module per file. +# 2) All modules that are to be contained in the dependency list must be +# contained in one of the source files in the list provided on the command +# line. +# The reason for the second restriction is that since the makefile doesn't +# contain rules to build .mod files the dependency takes the form of the .o +# file that contains the module. If a module is being used for which the +# source code is not available (e.g., a module from a library), then adding +# a .o dependency for that module is a mistake because make will attempt to +# build that .o file, and will fail if the source code is not available. +# +# Author: B. Eaton +# Climate Modelling Section, NCAR +# Feb 2001 + +use Getopt::Std; +use File::Basename; + +# Check for usage request. +@ARGV >= 2 or usage(); + +# Process command line. +my %opt = (); +getopts( "t:w", \%opt ) or usage(); +my $filepath_arg = shift() or usage(); +my $srcfile_arg = shift() or usage(); +@ARGV == 0 or usage(); # Check that all args were processed. + +my $obj_dir; +if ( defined $opt{'t'} ) { $obj_dir = $opt{'t'}; } + +open(FILEPATH, $filepath_arg) or die "Can't open $filepath_arg: $!\n"; +open(SRCFILES, $srcfile_arg) or die "Can't open $srcfile_arg: $!\n"; + +# Make list of paths to use when looking for files. +# Prepend "." so search starts in current directory. This default is for +# consistency with the way GNU Make searches for dependencies. +my @file_paths = ; +close(FILEPATH); +chomp @file_paths; +unshift(@file_paths,'.'); +foreach $dir (@file_paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Make list of files containing source code. +my @src = ; +close(SRCFILES); +chomp @src; + +# For each file that may contain a Fortran module (*.[fF]90 *.[fF]) convert the +# file's basename to uppercase and use it as a hash key whose value is the file's +# basename. This allows fast identification of the files that contain modules. +# The only restriction is that the file's basename and the module name must match +# in a case insensitive way. +my %module_files = (); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.[fF]90', '\.[fF]' ); +foreach $f (@src) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $module_files{$mod} = $name; +} + +# Now make a list of .mod files in the file_paths. If a .o source dependency +# can't be found based on the module_files list above, then maybe a .mod +# module dependency can if the mod file is visible. +my %trumod_files = (); +my ($dir); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.mod' ); +foreach $dir (@file_paths) { + @filenames = (glob("$dir/*.mod")); + foreach $f (@filenames) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $trumod_files{$mod} = $name; + } +} + +#print STDERR "\%module_files\n"; +#while ( ($k,$v) = each %module_files ) { +# print STDERR "$k => $v\n"; +#} + +# Find module and include dependencies of the source files. +my ($file_path, $rmods, $rincs); +my %file_modules = (); +my %file_includes = (); +my @check_includes = (); +foreach $f ( @src ) { + + # Find the file in the seach path (@file_paths). + unless ($file_path = find_file($f)) { + if (defined $opt{'w'}) {print STDERR "$f not found\n";} + next; + } + + # Find the module and include dependencies. + ($rmods, $rincs) = find_dependencies( $file_path ); + + # Remove redundancies (a file can contain multiple procedures that have + # the same dependencies). + $file_modules{$f} = rm_duplicates($rmods); + $file_includes{$f} = rm_duplicates($rincs); + + # Make a list of all include files. + push @check_includes, @{$file_includes{$f}}; +} + +#print STDERR "\%file_modules\n"; +#while ( ($k,$v) = each %file_modules ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\@check_includes\n"; +#print STDERR "@check_includes\n"; + +# Find include file dependencies. +my %include_depends = (); +while (@check_includes) { + $f = shift @check_includes; + if (defined($include_depends{$f})) { next; } + + # Mark files not in path so they can be removed from the dependency list. + unless ($file_path = find_file($f)) { + $include_depends{$f} = -1; + next; + } + + # Find include file dependencies. + ($rmods, $include_depends{$f}) = find_dependencies($file_path); + + # Add included include files to the back of the check_includes list so + # that their dependencies can be found. + push @check_includes, @{$include_depends{$f}}; + + # Add included modules to the include_depends list. + if ( @$rmods ) { push @{$include_depends{$f}}, @$rmods; } +} + +#print STDERR "\%include_depends\n"; +#while ( ($k,$v) = each %include_depends ) { +# print STDERR (ref $v ? "$k => @$v\n" : "$k => $v\n"); +#} + +# Remove include file dependencies that are not in the Filepath. +my $i, $ii; +foreach $f (keys %include_depends) { + + unless (ref $include_depends{$f}) { next; } + $rincs = $include_depends{$f}; + unless (@$rincs) { next; } + $ii = 0; + $num_incs = @$rincs; + for ($i = 0; $i < $num_incs; ++$i) { + if ($include_depends{$$rincs[$ii]} == -1) { + splice @$rincs, $ii, 1; + next; + } + ++$ii; + } +} + +# Substitute the include file dependencies into the %file_includes lists. +foreach $f (keys %file_includes) { + my @expand_incs = (); + + # Initialize the expanded %file_includes list. + my $i; + unless (@{$file_includes{$f}}) { next; } + foreach $i (@{$file_includes{$f}}) { + push @expand_incs, $i unless ($include_depends{$i} == -1); + } + unless (@expand_incs) { + $file_includes{$f} = []; + next; + } + + # Expand + for ($i = 0; $i <= $#expand_incs; ++$i) { + push @expand_incs, @{ $include_depends{$expand_incs[$i]} }; + } + + $file_includes{$f} = rm_duplicates(\@expand_incs); +} + +#print STDERR "expanded \%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} + +# Print dependencies to STDOUT. +foreach $f (sort keys %file_modules) { + $f =~ /(.+)\./; + $target = "$1.o"; + if ( defined $opt{'t'} ) { $target = "$opt{'t'}/$1.o"; } + print "$target : $f @{$file_modules{$f}} @{$file_includes{$f}}\n"; +} + +#-------------------------------------------------------------------------------------- + +sub find_dependencies { + + # Find dependencies of input file. + # Use'd Fortran 90 modules are returned in \@mods. + # Files that are "#include"d by the cpp preprocessor are returned in \@incs. + + my( $file ) = @_; + my( @mods, @incs ); + + open(FH, $file) or die "Can't open $file: $!\n"; + + while ( ) { + # Search for "#include" and strip filename when found. + if ( /^#include\s+[<"](.*)[>"]/ ) { + push @incs, $1; + } + # Search for Fortran include dependencies. + elsif ( /^\s*include\s+['"](.*)['"]/ ) { #" for emacs fontlock + push @incs, $1; + } + # Search for module dependencies. + elsif ( /^\s*USE\s+(\w+)/i ) { + ($module = $1) =~ tr/a-z/A-Z/; + # Return dependency in the form of a .o version of the file that contains + # the module. this is from the source list. + if ( defined $module_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$module_files{$module}.o"; + } else { + push @mods, "$module_files{$module}.o"; + } + } + # Return dependency in the form of a .mod version of the file that contains + # the module. this is from the .mod list. only if .o version not found + elsif ( defined $trumod_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$trumod_files{$module}.mod"; + } else { + push @mods, "$trumod_files{$module}.mod"; + } + } + } + } + close( FH ); + return (\@mods, \@incs); +} + +#-------------------------------------------------------------------------------------- + +sub find_file { + +# Search for the specified file in the list of directories in the global +# array @file_paths. Return the first occurance found, or the null string if +# the file is not found. + + my($file) = @_; + my($dir, $fname); + + foreach $dir (@file_paths) { + $fname = "$dir/$file"; + if ( -f $fname ) { return $fname; } + } + return ''; # file not found +} + +#-------------------------------------------------------------------------------------- + +sub rm_duplicates { + +# Return a list with duplicates removed. + + my ($in) = @_; # input arrary reference + my @out = (); + my $i; + my %h = (); + foreach $i (@$in) { + $h{$i} = ''; + } + @out = keys %h; + return \@out; +} + +#-------------------------------------------------------------------------------------- + +sub usage { + ($ProgName = $0) =~ s!.*/!!; # name of program + die <abort if file not found 1=>do not abort +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + integer klen !length of fulpath character string + logical lexist !true if local file exists +!------------------------------------------------------------------------ + + ! get local file name from full name + + locfn = get_filename( fulpath ) + if (len_trim(locfn) == 0) then + write(iulog,*)'(GETFIL): local filename has zero length' + call shr_sys_abort + else + write(iulog,*)'(GETFIL): attempting to find local file ', & + trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + write(iulog,*) '(GETFIL): using ',trim(locfn), & + ' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + locfn = fulpath + + inquire (file=fulpath,exist=lexist) + if (lexist) then + write(iulog,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath + if (present(iflag) .and. iflag==0) then + call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath)) + else + RETURN + endif + endif + + end subroutine getfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: opnfil +! +! !INTERFACE: + subroutine opnfil (locfn, iun, form) +! +! !DESCRIPTION: +! Open file locfn in unformatted or formatted form on unit iun +! +! !ARGUMENTS: +! + implicit none + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, + !f = formatted +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted +!------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(iulog,*)'(OPNFIL): local filename has zero length' + call shr_sys_abort + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + call shr_sys_abort + else + write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), & + & ' on unit= ',iun + end if + + end subroutine opnfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: getavu +! +! !INTERFACE: + integer function getavu() +! +! !DESCRIPTION: +! Get next available Fortran unit number. +! +! !USES: + use shr_file_mod, only : shr_file_getUnit +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! Modified for clm2 by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: relavu +! +! !INTERFACE: + subroutine relavu (iunit) +! +! !DESCRIPTION: +! Close and release Fortran unit no longer in use! +! +! !USES: + use shr_file_mod, only : shr_file_freeUnit +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: iunit !Fortran unit number +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! +!EOP +!------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 new file mode 100644 index 0000000000..d5124408cb --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkCH4inversionMod.F90 @@ -0,0 +1,172 @@ +module mkCH4inversionMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkCH4inversionMod +! +! !DESCRIPTION: +! make inversion-derived parameters for CH4 +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkCH4inversion ! make inversion-derived parameters for CH4 +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkCH4inversion +! +! !INTERFACE: +subroutine mkCH4inversion(ldomain, mapfname, datfname, ndiag, & + f0_o, p3_o, zwt0_o) +! +! !DESCRIPTION: +! make inversion-derived parameters for CH4 +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_continuous + use mkchecksMod, only : min_bad, max_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: f0_o(:) ! output grid: maximum gridcell fractional inundated area (unitless) + real(r8) , intent(out):: p3_o(:) ! output grid: coefficient for qflx_surf_lag for finundated (s/mm) + real(r8) , intent(out):: zwt0_o(:) ! output grid: decay factor for finundated (m) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid_f0 = 0._r8 + real(r8), parameter :: max_valid_f0 = 1._r8 + 1.0e-14_r8 + real(r8), parameter :: min_valid_p3 = 0._r8 + real(r8), parameter :: min_valid_zwt0 = 0._r8 + + character(len=32) :: subname = 'mkCH4inversion' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make inversion-derived CH4 parameters.....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname) + + call gridmap_mapread(tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open CH4 parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid f0 + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'F0', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, f0_o, nodata=0.01_r8) + + ! Check validity of output data + if (min_bad(f0_o, min_valid_f0, 'f0') .or. & + max_bad(f0_o, max_valid_f0, 'f0')) then + stop + end if + + call output_diagnostics_continuous(data_i, f0_o, tgridmap, "F0: max inundated area", "unitless", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid p3 + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'P3', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, p3_o, nodata=10._r8) + + ! Check validity of output data + if (min_bad(p3_o, min_valid_p3, 'p3')) then + stop + end if + + call output_diagnostics_continuous(data_i, p3_o, tgridmap, "P3: finundated coeff", "s/mm", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid zwt0 + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'ZWT0', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, zwt0_o, nodata=0.01_r8) + + ! Check validity of output data + if (min_bad(zwt0_o, min_valid_zwt0, 'zwt0')) then + stop + end if + + call output_diagnostics_continuous(data_i, zwt0_o, tgridmap, "ZWT0: finundated decay factor", "m", ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made inversion-derived CH4 parameters' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkCH4inversion + + +end module mkCH4inversionMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkVICparamsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkVICparamsMod.F90 new file mode 100644 index 0000000000..aa73f05ad5 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkVICparamsMod.F90 @@ -0,0 +1,187 @@ +module mkVICparamsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkVICparamsMod +! +! !DESCRIPTION: +! make parameters for VIC +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkVICparams ! make VIC parameters +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkVICparams +! +! !INTERFACE: +subroutine mkVICparams(ldomain, mapfname, datfname, ndiag, & + binfl_o, ws_o, dsmax_o, ds_o) +! +! !DESCRIPTION: +! make VIC parameters +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_continuous + use mkchecksMod, only : min_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: binfl_o(:) ! output grid: VIC b parameter for the Variable Infiltration Capacity Curve (unitless) + real(r8) , intent(out):: ws_o(:) ! output grid: VIC Ws parameter for the ARNO curve (unitless) + real(r8) , intent(out):: dsmax_o(:) ! output grid: VIC Dsmax parameter for the ARNO curve (mm/day) + real(r8) , intent(out):: ds_o(:) ! output grid: VIC Ds parameter for the ARNO curve (unitless) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid_binfl = 0._r8 + real(r8), parameter :: min_valid_ws = 0._r8 + real(r8), parameter :: min_valid_dsmax = 0._r8 + real(r8), parameter :: min_valid_ds = 0._r8 + + character(len=32) :: subname = 'mkVICparams' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make VIC parameters.....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname) + + call gridmap_mapread(tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open VIC parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid binfl + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'binfl', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, binfl_o, nodata=0.1_r8) + + ! Check validity of output data + if (min_bad(binfl_o, min_valid_binfl, 'binfl')) then + stop + end if + + call output_diagnostics_continuous(data_i, binfl_o, tgridmap, "VIC b parameter", "unitless", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid Ws + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'Ws', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, ws_o, nodata=0.75_r8) + + ! Check validity of output data + if (min_bad(ws_o, min_valid_ws, 'Ws')) then + stop + end if + + call output_diagnostics_continuous(data_i, ws_o, tgridmap, "VIC Ws parameter", "unitless", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid Dsmax + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'Dsmax', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, dsmax_o, nodata=10._r8) + + ! Check validity of output data + if (min_bad(dsmax_o, min_valid_dsmax, 'Dsmax')) then + stop + end if + + call output_diagnostics_continuous(data_i, dsmax_o, tgridmap, "VIC Dsmax parameter", "mm/day", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid Ds + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'Ds', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, ds_o, nodata=0.1_r8) + + ! Check validity of output data + if (min_bad(ds_o, min_valid_ds, 'Ds')) then + stop + end if + + call output_diagnostics_continuous(data_i, ds_o, tgridmap, "VIC Ds parameter", "unitless", ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made VIC parameters' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkVICparams + + +end module mkVICparamsMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkagfirepkmonthMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkagfirepkmonthMod.F90 new file mode 100644 index 0000000000..d3c98da3f2 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkagfirepkmonthMod.F90 @@ -0,0 +1,258 @@ +module mkagfirepkmonthMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkagfirepkmonthMod +! +! !DESCRIPTION: +! Make agricultural fire peak month data +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + SAVE + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mkagfirepkmon ! Set agricultural fire peak month +! +! !PRIVATE MEMBER FUNCTIONS: + private define_months ! define month strings +! +! !PRIVATE DATA MEMBERS: +! + integer , parameter :: min_valid_value = 1 + integer , parameter :: max_valid_value = 12 + integer , parameter :: unsetmon = 13 ! flag to indicate agricultural fire peak month NOT set +! +! !PRIVATE DATA MEMBERS: +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkagfirepkmon +! +! !INTERFACE: +subroutine mkagfirepkmon(ldomain, mapfname, datfname, ndiag, & + agfirepkmon_o) +! +! !DESCRIPTION: +! Make agricultural fire peak month data from higher resolution data +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkindexmapMod, only : get_dominant_indices + use mkvarpar, only : re + use mkncdio + use mkchecksMod, only : min_bad, max_bad +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + integer , intent(out):: agfirepkmon_o(:) ! agricultural fire peak month +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: gast_i(:) ! global area, by surface type + real(r8), allocatable :: gast_o(:) ! global area, by surface type + integer , allocatable :: agfirepkmon_i(:) ! input grid: agricultural fire peak month + integer :: nagfirepkmon ! number of peak months + character(len=35), allocatable :: month(:)! name of each month + integer :: k,ni,no,ns_i,ns_o ! indices + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + integer, parameter :: miss = unsetmon ! missing data indicator + integer, parameter :: min_valid = 1 ! minimum valid value + integer, parameter :: max_valid = 13 ! maximum valid value + character(len=32) :: subname = 'mkagfirepkmon' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make agricultural fire peak month data .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read( tdomain,datfname ) + + call gridmap_mapread( tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ns_i = tdomain%ns + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write (6,*) 'Open agricultural fire peak month file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(agfirepkmon_i(ns_i), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid ag fire peak month + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'abm', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, agfirepkmon_i), subname) + ! Note that any input point that is outside the range [min_valid_value,max_valid_value] + ! will be ignored; this ignores input points with value of unsetmon + call get_dominant_indices(tgridmap, agfirepkmon_i, agfirepkmon_o, & + min_valid_value, max_valid_value, miss) + + ! Check validity of output data + if (min_bad(agfirepkmon_o, min_valid, 'agfirepkmon') .or. & + max_bad(agfirepkmon_o, max_valid, 'agfirepkmon')) then + stop + end if + + + ! ----------------------------------------------------------------- + ! Output diagnostics comparing global area of each peak month on input and output grids + ! + ! WJS (3-4-13): I am trying to generally put these diagnostics in mkdiagnosticsMod, but + ! so far there isn't a general diagnostics routine for categorical data + ! ----------------------------------------------------------------- + + nagfirepkmon = maxval(agfirepkmon_i) + allocate(gast_i(1:nagfirepkmon),gast_o(1:nagfirepkmon),month(1:nagfirepkmon)) + call define_months(nagfirepkmon, month) + + gast_i(:) = 0.0_r8 + do ni = 1,ns_i + k = agfirepkmon_i(ni) + gast_i(k) = gast_i(k) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + + gast_o(:) = 0.0_r8 + do no = 1,ns_o + k = agfirepkmon_o(no) + gast_o(k) = gast_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! area comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Agricultural fire peak month Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'peak month',20x,' input grid area output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + do k = 1, nagfirepkmon + write (ndiag,1002) month(k),gast_i(k)*1.e-6,gast_o(k)*1.e-6 +1002 format (1x,a35,f16.3,f17.3) + end do + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (agfirepkmon_i,gast_i,gast_o,month) + + write (6,*) 'Successfully made Agricultural fire peak month' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkagfirepkmon + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: define_months +! +! !INTERFACE: +subroutine define_months(nagfirepkmon, month) +! +! !DESCRIPTION: +! Define month strings +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: nagfirepkmon ! max input value (including the 'unset' special value) + character(len=*), intent(out):: month(:) ! name of each month value +! +! !CALLED FROM: +! subroutine mkagfirepkmon +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + + if (nagfirepkmon == unsetmon) then + if (size(month) < 13) then + write(6,*) 'month array too small: ', size(month), ' < 13' + call abort() + end if + month(1) = 'January ' + month(2) = 'February ' + month(3) = 'March ' + month(4) = 'April ' + month(5) = 'May ' + month(6) = 'June ' + month(7) = 'July ' + month(8) = 'August ' + month(9) = 'September ' + month(10) = 'October ' + month(11) = 'November ' + month(12) = 'December ' + month(13) = 'no agricultural fire peak month data' + else + write(6,*)'nagfirepkmon value of ',nagfirepkmon,' not supported' + call abort() + end if + +end subroutine define_months +!----------------------------------------------------------------------- + + +end module mkagfirepkmonthMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkchecksMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkchecksMod.F90 new file mode 100644 index 0000000000..94b8fe5930 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkchecksMod.F90 @@ -0,0 +1,233 @@ +module mkchecksMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkchecks +! +! !DESCRIPTION: +! Generic routines to check validity of output fields +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: min_bad ! check the minimum value of a field + public :: max_bad ! check the maximum value of a field + + interface min_bad + module procedure min_bad_int + module procedure min_bad_r8 + end interface min_bad + + interface max_bad + module procedure max_bad_int + module procedure max_bad_r8 + end interface max_bad +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: min_bad_r8 +! +! !INTERFACE: +logical function min_bad_r8(data, min_allowed, varname) +! +! !DESCRIPTION: +! Confirm that no value of data is less than min_allowed. +! Returns true if errors found, false otherwise. +! Also prints offending points +! +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8) , intent(in) :: data(:) ! array of data to check + real(r8) , intent(in) :: min_allowed ! minimum valid value + character(len=*) , intent(in) :: varname ! name of field +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical :: errors_found ! true if any errors have been found + integer :: n ! index + + character(len=*), parameter :: subname = 'min_bad_r8' +!------------------------------------------------------------------------------ + + errors_found = .false. + + do n = 1, size(data) + if (data(n) < min_allowed) then + write(6,*) subname//' ERROR: ', trim(varname), ' = ', data(n), ' less than ',& + min_allowed, ' at ', n + errors_found = .true. + end if + end do + + call shr_sys_flush(6) + min_bad_r8 = errors_found +end function min_bad_r8 + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: min_bad_int +! +! !INTERFACE: +logical function min_bad_int(data, min_allowed, varname) +! +! !DESCRIPTION: +! Confirm that no value of data is less than min_allowed. +! Returns true if errors found, false otherwise. +! Also prints offending points +! +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: data(:) ! array of data to check + integer , intent(in) :: min_allowed ! minimum valid value + character(len=*) , intent(in) :: varname ! name of field +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical :: errors_found ! true if any errors have been found + integer :: n ! index + + character(len=*), parameter :: subname = 'min_bad_int' +!------------------------------------------------------------------------------ + + errors_found = .false. + + do n = 1, size(data) + if (data(n) < min_allowed) then + write(6,*) subname//' ERROR: ', trim(varname), ' = ', data(n), ' less than ',& + min_allowed, ' at ', n + errors_found = .true. + end if + end do + + call shr_sys_flush(6) + min_bad_int = errors_found +end function min_bad_int + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: max_bad_r8 +! +! !INTERFACE: +logical function max_bad_r8(data, max_allowed, varname) +! +! !DESCRIPTION: +! Confirm that no value of data is greate than max_allowed. +! Returns true if errors found, false otherwise. +! Also prints offending points +! +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8) , intent(in) :: data(:) ! array of data to check + real(r8) , intent(in) :: max_allowed ! maximum valid value + character(len=*) , intent(in) :: varname ! name of field +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical :: errors_found ! true if any errors have been found + integer :: n ! index + + character(len=*), parameter :: subname = 'max_bad_r8' +!------------------------------------------------------------------------------ + + errors_found = .false. + + do n = 1, size(data) + if (data(n) > max_allowed) then + write(6,*) subname//' ERROR: ', trim(varname), ' = ', data(n), ' greater than ',& + max_allowed, ' at ', n + errors_found = .true. + end if + end do + + call shr_sys_flush(6) + max_bad_r8 = errors_found +end function max_bad_r8 + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: max_bad_int +! +! !INTERFACE: +logical function max_bad_int(data, max_allowed, varname) +! +! !DESCRIPTION: +! Confirm that no value of data is greate than max_allowed. +! Returns true if errors found, false otherwise. +! Also prints offending points +! +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: data(:) ! array of data to check + integer , intent(in) :: max_allowed ! maximum valid value + character(len=*) , intent(in) :: varname ! name of field +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical :: errors_found ! true if any errors have been found + integer :: n ! index + + character(len=*), parameter :: subname = 'max_bad_int' +!------------------------------------------------------------------------------ + + errors_found = .false. + + do n = 1, size(data) + if (data(n) > max_allowed) then + write(6,*) subname//' ERROR: ', trim(varname), ' = ', data(n), ' greater than ',& + max_allowed, ' at ', n + errors_found = .true. + end if + end do + + call shr_sys_flush(6) + max_bad_int = errors_found +end function max_bad_int + + +end module mkchecksMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkdiagnosticsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkdiagnosticsMod.F90 new file mode 100644 index 0000000000..3091339ccf --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkdiagnosticsMod.F90 @@ -0,0 +1,312 @@ +module mkdiagnosticsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkdiagnostics +! +! !DESCRIPTION: +! Output diagnostics to log file +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: output_diagnostics_area ! output diagnostics for field that is % of grid area + public :: output_diagnostics_continuous ! output diagnostics for a continuous (real-valued) field + public :: output_diagnostics_continuous_outonly ! output diagnostics for a continuous (real-valued) field, just on the output grid +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: output_diagnostics_area +! +! !INTERFACE: +subroutine output_diagnostics_area(data_i, data_o, gridmap, name, percent, ndiag) +! +! !DESCRIPTION: +! Output diagnostics for a field that gives either fraction or percent of grid cell area +! +! !USES: + use mkgridmapMod, only : gridmap_type + use mkvarpar, only : re +! +! !ARGUMENTS: + implicit none + real(r8) , intent(in) :: data_i(:) ! data on input grid + real(r8) , intent(in) :: data_o(:) ! data on output grid + type(gridmap_type), intent(in) :: gridmap ! mapping info + character(len=*) , intent(in) :: name ! name of field + logical , intent(in) :: percent ! is field specified as percent? (alternative is fraction) + integer , intent(in) :: ndiag ! unit number for diagnostic output +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: gdata_i ! global sum of input data + real(r8) :: gdata_o ! global sum of output data + real(r8) :: garea_i ! global sum of input area + real(r8) :: garea_o ! global sum of output area + integer :: ns_i, ns_o ! sizes of input & output grids + integer :: ni,no,k ! indices + + character(len=*), parameter :: subname = "output_diagnostics_area" +!------------------------------------------------------------------------------ + + ! Error check for array size consistencies + + ns_i = gridmap%na + ns_o = gridmap%nb + if (size(data_i) /= ns_i .or. & + size(data_o) /= ns_o) then + write(6,*) subname//' ERROR: array size inconsistencies for ', trim(name) + write(6,*) 'size(data_i) = ', size(data_i) + write(6,*) 'ns_i = ', ns_i + write(6,*) 'size(data_o) = ', size(data_o) + write(6,*) 'ns_o = ', ns_o + stop + end if + + ! Sums on input grid + + gdata_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + gridmap%area_src(ni)*re**2 + gdata_i = gdata_i + data_i(ni)*gridmap%area_src(ni)*gridmap%frac_src(ni)*re**2 + end do + + ! Sums on output grid + + gdata_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + gridmap%area_dst(no)*re**2 + gdata_o = gdata_o + data_o(no)*gridmap%area_dst(no)*gridmap%frac_dst(no)*re**2 + end do + + ! Correct units + + if (percent) then + gdata_i = gdata_i / 100._r8 + gdata_o = gdata_o / 100._r8 + end if + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) trim(name), ' Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) name, gdata_i*1.e-06, gdata_o*1.e-06 + write (ndiag,2002) 'all surface', garea_i*1.e-06, garea_o*1.e-06 +2002 format (1x,a12, f14.3,f17.3) + +end subroutine output_diagnostics_area +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: output_diagnostics_continuous +! +! !INTERFACE: +subroutine output_diagnostics_continuous(data_i, data_o, gridmap, name, units, ndiag) +! +! !DESCRIPTION: +! Output diagnostics for a continuous field (but not area, for which there is a different routine) +! +! !USES: + use mkgridmapMod, only : gridmap_type + use mkvarpar, only : re +! +! !ARGUMENTS: + implicit none + real(r8) , intent(in) :: data_i(:) ! data on input grid + real(r8) , intent(in) :: data_o(:) ! data on output grid + type(gridmap_type), intent(in) :: gridmap ! mapping info + character(len=*) , intent(in) :: name ! name of field + character(len=*) , intent(in) :: units ! units of field + integer , intent(in) :: ndiag ! unit number for diagnostic output +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: gdata_i ! global sum of input data + real(r8) :: gdata_o ! global sum of output data + real(r8) :: gwt_i ! global sum of input weights (area * frac) + real(r8) :: gwt_o ! global sum of output weights (area * frac) + integer :: ns_i, ns_o ! sizes of input & output grids + integer :: ni,no,k ! indices + + character(len=*), parameter :: subname = "output_diagnostics_continuous" +!------------------------------------------------------------------------------ + + ! Error check for array size consistencies + + ns_i = gridmap%na + ns_o = gridmap%nb + if (size(data_i) /= ns_i .or. & + size(data_o) /= ns_o) then + write(6,*) subname//' ERROR: array size inconsistencies for ', trim(name) + write(6,*) 'size(data_i) = ', size(data_i) + write(6,*) 'ns_i = ', ns_i + write(6,*) 'size(data_o) = ', size(data_o) + write(6,*) 'ns_o = ', ns_o + stop + end if + + ! Sums on input grid + + gdata_i = 0. + gwt_i = 0. + do ni = 1,ns_i + gdata_i = gdata_i + data_i(ni)*gridmap%area_src(ni)*gridmap%frac_src(ni) + gwt_i = gwt_i + gridmap%area_src(ni)*gridmap%frac_src(ni) + end do + + ! Sums on output grid + + gdata_o = 0. + gwt_o = 0. + do no = 1,ns_o + gdata_o = gdata_o + data_o(no)*gridmap%area_dst(no)*gridmap%frac_dst(no) + gwt_o = gwt_o + gridmap%area_dst(no)*gridmap%frac_dst(no) + end do + + ! Correct units + + gdata_i = gdata_i / gwt_i + gdata_o = gdata_o / gwt_o + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) trim(name), ' Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) + write (ndiag,2002) units, units +2001 format (1x,' parameter input grid output grid') +2002 format (1x,' ', a24, a24) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) name, gdata_i, gdata_o +2003 format (1x,a12, f22.3,f17.3) + +end subroutine output_diagnostics_continuous +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: output_diagnostics_continuous_outonly +! +! !INTERFACE: +subroutine output_diagnostics_continuous_outonly(data_o, gridmap, name, units, ndiag) +! +! !DESCRIPTION: +! Output diagnostics for a continuous field, just on the output grid +! This is used when the average of the field on the input grid is not of interest (e.g., +! when the output quantity is the standard deviation of the input field) +! +! !USES: + use mkgridmapMod, only : gridmap_type + use mkvarpar, only : re +! +! !ARGUMENTS: + implicit none + real(r8) , intent(in) :: data_o(:) ! data on output grid + type(gridmap_type), intent(in) :: gridmap ! mapping info + character(len=*) , intent(in) :: name ! name of field + character(len=*) , intent(in) :: units ! units of field + integer , intent(in) :: ndiag ! unit number for diagnostic output +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: gdata_o ! global sum of output data + real(r8) :: gwt_o ! global sum of output weights (area * frac) + integer :: ns_o ! size of output grid + integer :: no,k ! indices + + character(len=*), parameter :: subname = "output_diagnostics_continuous_outonly" +!------------------------------------------------------------------------------ + + ! Error check for array size consistencies + + ns_o = gridmap%nb + if (size(data_o) /= ns_o) then + write(6,*) subname//' ERROR: array size inconsistencies for ', trim(name) + write(6,*) 'size(data_o) = ', size(data_o) + write(6,*) 'ns_o = ', ns_o + stop + end if + + ! Sums on output grid + + gdata_o = 0. + gwt_o = 0. + do no = 1,ns_o + gdata_o = gdata_o + data_o(no)*gridmap%area_dst(no)*gridmap%frac_dst(no) + gwt_o = gwt_o + gridmap%area_dst(no)*gridmap%frac_dst(no) + end do + + ! Correct units + + gdata_o = gdata_o / gwt_o + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) trim(name), ' Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) + write (ndiag,2002) units +2001 format (1x,' parameter output grid') +2002 format (1x,' ', a24) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) name, gdata_o +2003 format (1x,a12, f22.3) + +end subroutine output_diagnostics_continuous_outonly +!------------------------------------------------------------------------------ + + +end module mkdiagnosticsMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 new file mode 100644 index 0000000000..94cc2594ec --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkdomainMod.F90 @@ -0,0 +1,922 @@ +module mkdomainMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: domain1Mod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkvarpar , only : re + use nanMod , only : nan, bigint +! +! !PUBLIC TYPES: + implicit none + private +! + public :: domain_type + + type domain_type + character*16 :: set ! flag to check if domain is set + integer :: ns ! global size of domain + integer :: ni,nj ! for 2d domains only + real(r8) :: edgen ! lsmedge north + real(r8) :: edgee ! lsmedge east + real(r8) :: edges ! lsmedge south + real(r8) :: edgew ! lsmedge west + integer ,pointer :: mask(:) ! land mask: 1 = land, 0 = ocean + real(r8),pointer :: frac(:) ! fractional land + real(r8),pointer :: latc(:) ! latitude of grid cell (deg) + real(r8),pointer :: lonc(:) ! longitude of grid cell (deg) + real(r8),pointer :: lats(:) ! grid cell latitude, S edge (deg) + real(r8),pointer :: latn(:) ! grid cell latitude, N edge (deg) + real(r8),pointer :: lonw(:) ! grid cell longitude, W edge (deg) + real(r8),pointer :: lone(:) ! grid cell longitude, E edge (deg) + real(r8),pointer :: area(:) ! grid cell area (km**2) (only used for output grid) + logical :: is_2d ! if this is a 2-d domain + logical :: fracset ! if frac is set + logical :: maskset ! if mask is set + end type domain_type + +! +! !PUBLIC MEMBER FUNCTIONS: + public domain_clean + public domain_check + public domain_read + public domain_read_dims ! get dimensions from a domain file (only public for unit testing) + public domain_read_map + public domain_write + public domain_checksame +! +! +! !REVISION HISTORY: +! Originally clm_varsur by Mariana Vertenstein +! Migrated from clm_varsur to domainMod by T Craig +! + character*16,parameter :: set = 'domain_set ' + character*16,parameter :: unset = 'NOdomain_unsetNO' + + real(r8) :: flandmin = 0.001 !minimum land frac for land cell +! +! !PRIVATE MEMBER FUNCTIONS: + private domain_init +! +!EOP +!------------------------------------------------------------------------------ + +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_init +! +! !INTERFACE: + subroutine domain_init(domain,ns) +! +! !DESCRIPTION: +! This subroutine allocates and nans the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype + integer :: ns ! grid size, 2d +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier + integer nb,ne +! +!------------------------------------------------------------------------------ + + nb = 1 + ne = ns + + if (domain%set == set) then + call domain_clean(domain) + endif + + allocate(domain%mask(ns), & + domain%frac(ns), & + domain%latc(ns), & + domain%lonc(ns), & + domain%lats(ns), & + domain%latn(ns), & + domain%lonw(ns), & + domain%lone(ns), & + domain%area(ns), stat=ier) + if (ier /= 0) then + write(6,*) 'domain_init ERROR: allocate mask, frac, lat, lon, area ' + endif + + domain%ns = ns + domain%mask = -9999 + domain%frac = -1.0e36 + domain%latc = nan + domain%lonc = nan + domain%area = nan + domain%set = set + domain%fracset = .false. + domain%maskset = .false. + + end subroutine domain_init + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_clean +! +! !INTERFACE: + subroutine domain_clean(domain) +! +! !DESCRIPTION: +! This subroutine deallocates the domain type +! +! !ARGUMENTS: + implicit none + type(domain_type) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer ier +! +!------------------------------------------------------------------------------ + + if (domain%set == set) then + write(6,*) 'domain_clean: cleaning ',domain%ns + deallocate(domain%mask, & + domain%frac, & + domain%latc, & + domain%lonc, & + domain%lats, & + domain%latn, & + domain%lonw, & + domain%lone, & + domain%area, stat=ier) + if (ier /= 0) then + write(6,*) 'domain_clean ERROR: deallocate mask, frac, lat, lon, area ' + call abort() + endif + else + write(6,*) 'domain_clean WARN: clean domain unecessary ' + endif + + domain%ns = bigint + domain%set = unset + domain%fracset = .false. + domain%maskset = .false. + +end subroutine domain_clean + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: domain_check +! +! !INTERFACE: + subroutine domain_check(domain) +! +! !DESCRIPTION: +! This subroutine write domain info +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(in) :: domain ! domain datatype +! +! !REVISION HISTORY: +! Created by T Craig +! +! +! !LOCAL VARIABLES: +! +!EOP +!------------------------------------------------------------------------------ + + write(6,*) ' domain_check set = ',trim(domain%set) + write(6,*) ' domain_check ns = ',domain%ns + write(6,*) ' domain_check lonc = ',minval(domain%lonc),maxval(domain%lonc) + write(6,*) ' domain_check latc = ',minval(domain%latc),maxval(domain%latc) + write(6,*) ' domain_check mask = ',minval(domain%mask),maxval(domain%mask) + write(6,*) ' domain_check frac = ',minval(domain%frac),maxval(domain%frac) + write(6,*) ' ' + +end subroutine domain_check + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read_map +! +! !INTERFACE: + logical function domain_read_map(domain, fname) +! +! !DESCRIPTION: +! Read a grid file +! +! !USES: + use mkncdio, only : convert_latlon +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname ! this assumes a SCRIP mapping file - look at destination grid +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: i,j,n ! indices + integer :: grid_rank ! rank of domain grid + integer :: ns ! size of domain grid + integer :: ncid ! netCDF file id + integer :: dimid ! netCDF dimension id + integer :: varid ! netCDF variable id + integer :: ndims ! number of dims for variable + integer :: ier ! error status + real(r8), allocatable :: xv(:,:) ! local array for corner lons + real(r8), allocatable :: yv(:,:) ! local array for corner lats + integer :: grid_dims(2) + character(len= 32) :: subname = 'domain_read' +!----------------------------------------------------------------- + + domain_read_map = .true. + + ! Read domain file and compute stuff as needed + + call check_ret(nf_open(fname, 0, ncid), subname) + + ! Assume unstructured grid + + domain%ni = -9999 + domain%nj = -9999 + domain%is_2d = .false. + + ier = nf_inq_dimid (ncid, 'n_b', dimid) + if ( ier /= NF_NOERR )then + domain_read_map = .false. + else + call check_ret(nf_inq_dimlen (ncid, dimid, domain%ns), subname) + + call check_ret(nf_inq_dimid (ncid, 'dst_grid_rank', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, grid_rank), subname) + + if (grid_rank == 2) then + call check_ret(nf_inq_varid (ncid, 'dst_grid_dims', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, grid_dims), subname) + domain%ni = grid_dims(1) + domain%nj = grid_dims(2) + domain%is_2d = .true. + end if + + call domain_init(domain, domain%ns) + ns = domain%ns + + call check_ret(nf_inq_varid (ncid, 'xc_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%lonc), subname) + call convert_latlon(ncid, 'xc_b', domain%lonc) + + call check_ret(nf_inq_varid (ncid, 'yc_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%latc), subname) + call convert_latlon(ncid, 'yc_b', domain%latc) + + if (grid_rank == 2 ) then + allocate(yv(4,ns), xv(4,ns)) + call check_ret(nf_inq_varid (ncid, 'yv_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, yv), subname) + call check_ret(nf_inq_varid (ncid, 'xv_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, xv), subname) + + domain%lats(:) = yv(1,:) + call convert_latlon(ncid, 'yv_b', domain%lats(:)) + + domain%latn(:) = yv(3,:) + call convert_latlon(ncid, 'yv_b', domain%latn(:)) + + domain%lonw(:) = xv(1,:) + call convert_latlon(ncid, 'xv_b', domain%lonw(:)) + + domain%lone(:) = xv(2,:) + call convert_latlon(ncid, 'xv_b', domain%lone(:)) + + domain%edgen = maxval(domain%latn) + domain%edgee = maxval(domain%lone) + domain%edges = minval(domain%lats) + domain%edgew = minval(domain%lonw) + deallocate(yv,xv) + end if + + call check_ret(nf_inq_varid (ncid, 'frac_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + + call check_ret(nf_inq_varid (ncid, 'mask_b', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + + call check_ret(nf_inq_varid (ncid, 'area_b', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%area), subname) + domain%area = domain%area * re**2 + end if + domain%maskset = .true. + domain%fracset = .true. + + call check_ret(nf_close(ncid), subname) + + end function domain_read_map + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read +! +! !INTERFACE: + subroutine domain_read(domain, fname, readmask) +! +! !DESCRIPTION: +! Read a grid file +! +! !USES: + use mkncdio, only : convert_latlon +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname + logical,optional, intent(in) :: readmask ! true => read mask instead of landmask for urban parameters +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: i,j,n + real(r8), allocatable :: lon1d(:) ! local array for 1d lon + real(r8), allocatable :: lat1d(:) ! local array for 1d lat + real(r8), allocatable :: xv(:,:) ! local array for corner lons + real(r8), allocatable :: yv(:,:) ! local array for corner lats + integer :: ncid ! netCDF file id + integer :: varid ! netCDF variable id + logical :: edgeNESWset ! local EDGE[NESW] + logical :: lonlatset ! local lon(:,:), lat(:,:) + logical :: llneswset ! local lat[ns],lon[we] + logical :: landfracset ! local landfrac + logical :: maskset ! local mask + integer :: ndims ! number of dims for variable + integer :: ier ! error status + logical :: lreadmask ! local readmask + character(len= 32) :: lonvar ! name of 2-d longitude variable + character(len= 32) :: latvar ! name of 2-d latitude variable + character(len= 32) :: subname = 'domain_read' +!----------------------------------------------------------------- + + lonlatset = .false. + edgeNESWset = .false. + llneswset = .false. + landfracset = .false. + maskset = .false. + lreadmask = .false. + + if (present(readmask)) then + lreadmask = readmask + end if + + call check_ret(nf_open(fname, 0, ncid), subname) + + call domain_read_dims(domain, ncid) + call domain_init(domain, domain%ns) + write(6,*) trim(subname),' initialized domain' + + ! ----- Set lat/lon variable ------ + + lonvar = ' ' + latvar = ' ' + + if (.not. lonlatset) then + ier = nf_inq_varid (ncid, 'LONGXY', varid) + if (ier == NF_NOERR) then + lonvar = 'LONGXY' + latvar = 'LATIXY' + lonlatset = .true. + end if + end if + + if (.not. lonlatset) then + ier = nf_inq_varid (ncid, 'lon', varid) + if (ier == NF_NOERR) then + lonvar = 'lon' + latvar = 'lat' + lonlatset = .true. + end if + end if + + if (.not. lonlatset) then + ier = nf_inq_varid (ncid, 'LONGITUDE', varid) + if (ier == NF_NOERR) then + lonvar = 'LONGITUDE' + latvar = 'LATITUDE' + lonlatset = .true. + end if + end if + + if (.not. lonlatset) then + write(6,*)'lon/lat values not set' + write(6,*)'currently assume either that lon/lat or LONGXY/LATIXY', & + ' or LONGITUDE/LATITUDE variables are on input dataset' + call abort() + end if + + call check_ret(nf_inq_varid (ncid, lonvar, varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%lonc), subname) + call convert_latlon(ncid, lonvar, domain%lonc) + + call check_ret(nf_inq_varid (ncid, latvar, varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%latc), subname) + call convert_latlon(ncid, latvar, domain%latc) + + ! ----- Set landmask/landfrac ------ + + ier = nf_inq_varid (ncid, 'frac', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read frac' + call check_ret(nf_inq_varid (ncid, 'frac', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + ier = nf_inq_varid (ncid, 'LANDFRAC', varid) + if (ier == NF_NOERR) then + if (landfracset) write(6,*) trim(subname),' WARNING, overwriting frac' + landfracset = .true. + write(6,*) trim(subname),' read LANDFRAC' + call check_ret(nf_inq_varid (ncid, 'LANDFRAC', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, domain%frac), subname) + endif + + if (lreadmask) then + ier = nf_inq_varid (ncid, 'mask', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read mask with lreadmask set' + call check_ret(nf_inq_varid (ncid, 'mask', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + else + ier = nf_inq_varid (ncid, 'mask', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read mask' + call check_ret(nf_inq_varid (ncid, 'mask', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + ier = nf_inq_varid (ncid, 'LANDMASK', varid) + if (ier == NF_NOERR) then + if (maskset) write(6,*) trim(subname),' WARNING, overwriting mask' + maskset = .true. + write(6,*) trim(subname),' read LANDMASK' + call check_ret(nf_inq_varid (ncid, 'LANDMASK', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, domain%mask), subname) + endif + end if + + call check_ret(nf_close(ncid), subname) + + ! ----- set derived variables ---- + + if (.not.maskset.and.landfracset) then + maskset = .true. + where (domain%frac < flandmin) + domain%mask = 0 !ocean + elsewhere + domain%mask = 1 !land + endwhere + endif + + if (.not.landfracset.and.maskset) then + landfracset = .true. + do n = 1,domain%ns + if ( domain%mask(n) == 0 )then + domain%frac(n) = 0._r8 !ocean + else + domain%frac(n) = 1._r8 !land + end if + end do + endif + domain%maskset = maskset + domain%fracset = landfracset + + end subroutine domain_read + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read_dims +! +! !INTERFACE: + subroutine domain_read_dims(domain, ncid) +! +! !DESCRIPTION: +! get dimension size(s) from a domain file +! sets domain%ns, domain%is_2d; and (if 2-d) domain%ni and domain%nj +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + integer ,intent(in) :: ncid ! ID of an open netcdf file +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical :: dimset ! has dimension information been set? + character(len= 32) :: subname = 'domain_read_dims' +!----------------------------------------------------------------- + + ! Assume unstructured grid + domain%ni = -9999 + domain%nj = -9999 + domain%is_2d = .false. + + dimset = .false. + + ! Note: We use the first dimension that is found in the following list + + ! ----- First try to find 2-d info ------ + + call domain_read_dims_2d(domain, dimset, ncid, 'lsmlon', 'lsmlat') + call domain_read_dims_2d(domain, dimset, ncid, 'ni', 'nj') + call domain_read_dims_2d(domain, dimset, ncid, 'lon', 'lat') + + ! ----- If we haven't found 2-d info, try to find 1-d info ----- + + call domain_read_dims_1d(domain, dimset, ncid, 'num_pixels') + + ! ----- If we haven't found any info, abort ----- + + if (.not. dimset) then + write(6,*) trim(subname),' ERROR: dims not set' + call abort() + endif + + contains + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read_dims_2d +! +! !INTERFACE: + subroutine domain_read_dims_2d(domain, dimset, ncid, lon_name, lat_name) +! +! !DESCRIPTION: +! Try to read 2-d dimension size information +! +! Checks whether the given lon_name is found in the netcdf file. If it is: +! (a) If dimset is already true, then it issues a warning and returns +! (b) If dimset is false, then this sets: +! - domain%ni +! - domain%nj +! - domain%ns +! - domain%is_2d +! - dimset = true +! +! If the given lon_name is not found, the above variables are left unchanged +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + logical ,intent(inout) :: dimset ! has dimension information been set? + integer ,intent(in) :: ncid ! ID of an open netCDF file + character(len=*) ,intent(in) :: lon_name + character(len=*) ,intent(in) :: lat_name +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: dimid ! netCDF dimension id + integer :: nlon,nlat ! size + integer :: ier ! error status + + character(len= 32) :: subname = 'domain_read_dims_2d' + +!----------------------------------------------------------------- + + ier = nf_inq_dimid (ncid, lon_name, dimid) + if (ier == NF_NOERR) then + if (dimset) then + write(6,*) trim(subname),' WARNING: dimension sizes already set; skipping ', & + lon_name, '/', lat_name + else + write(6,*) trim(subname),' read lon and lat dims from ', lon_name, '/', lat_name + call check_ret(nf_inq_dimid (ncid, lon_name, dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlon), subname) + call check_ret(nf_inq_dimid (ncid, lat_name, dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlat), subname) + domain%ni = nlon + domain%nj = nlat + domain%ns = nlon * nlat + domain%is_2d = .true. + dimset = .true. + end if + endif + + end subroutine domain_read_dims_2d + + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_read_dims_1d +! +! !INTERFACE: + subroutine domain_read_dims_1d(domain, dimset, ncid, dim_name) +! +! !DESCRIPTION: +! Try to read 1-d dimension size information +! +! Checks whether the given dim_name is found in the netcdf file. If it is: +! (a) If dimset is already true, then it issues a warning and returns +! (b) If dimset is false, then this sets: +! - domain%ns +! - domain%is_2d +! - dimset = true +! +! If the given dim_name is not found, the above variables are left unchanged +! +! !ARGUMENTS: + implicit none + type(domain_type),intent(inout) :: domain + logical ,intent(inout) :: dimset ! has dimension information been set? + integer ,intent(in) :: ncid ! ID of an open netCDF file + character(len=*) ,intent(in) :: dim_name +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + include 'netcdf.inc' + integer :: dimid ! netCDF dimension id + integer :: npts ! size + integer :: ier ! error status + + character(len= 32) :: subname = 'domain_read_dims_1d' + +!----------------------------------------------------------------- + + ier = nf_inq_dimid (ncid, dim_name, dimid) + if (ier == NF_NOERR) then + if (dimset) then + write(6,*) trim(subname),' WARNING: dimension sizes already set; skipping ', dim_name + else + write(6,*) trim(subname),' read 1-d length from ', dim_name + call check_ret(nf_inq_dimid (ncid, dim_name, dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, npts), subname) + domain%ns = npts + domain%is_2d = .false. + dimset = .true. + end if + endif + + end subroutine domain_read_dims_1d + + end subroutine domain_read_dims + + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_write +! +! !INTERFACE: + subroutine domain_write(domain,fname) +! +! !DESCRIPTION: +! Write a domain to netcdf + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + type(domain_type),intent(inout) :: domain + character(len=*) ,intent(in) :: fname +! +! !REVISION HISTORY: +! Author: T Craig +! +! +! !LOCAL VARIABLES: +!EOP + integer :: varid !netCDF variable id + integer :: ncid !netCDF file id + integer :: omode !netCDF output mode + character(len= 32) :: subname = 'domain_write' +!----------------------------------------------------------------- + + call check_ret(nf_open(trim(fname), nf_write, ncid), subname) + ! File will be in define mode. Set fill mode to "no fill" to optimize performance + + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Write domain fields + + call check_ret(nf_inq_varid(ncid, 'AREA', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%area), subname) + + call check_ret(nf_inq_varid(ncid, 'LONGXY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%lonc), subname) + + call check_ret(nf_inq_varid(ncid, 'LATIXY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, domain%latc), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! Close grid data dataset + + call check_ret(nf_close(ncid), subname) + + end subroutine domain_write + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: check_ret +! +! !INTERFACE: + subroutine check_ret(ret, calling) +! +! !DESCRIPTION: +! Check return status from netcdf call +! +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ret + character(len=*) :: calling +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + + if (ret /= NF_NOERR) then + write(6,*)'netcdf error from ',trim(calling), ' rcode = ', ret, & + ' error = ', NF_STRERROR(ret) + call abort() + end if + + end subroutine check_ret + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: domain_checksame +! +! !INTERFACE: + subroutine domain_checksame( srcdomain, dstdomain, tgridmap ) +! +! !DESCRIPTION: +! Check that the input domains agree with the input map +! +! USES: + use mkgridmapMod, only : gridmap_type, gridmap_setptrs +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: srcdomain ! input domain + type(domain_type), intent(in) :: dstdomain ! output domain + type(gridmap_type),intent(in) :: tgridmap ! grid map +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + integer :: na, nb, ns ! gridmap sizes + integer :: n, ni ! indices + real(r8), pointer :: xc_src(:) ! Source longitude + real(r8), pointer :: yc_src(:) ! Source latitude + real(r8), pointer :: frac_src(:) ! Source fraction + integer, pointer :: mask_src(:) ! Source mask + integer, pointer :: src_indx(:) ! Source index + real(r8), pointer :: xc_dst(:) ! Destination longitude + real(r8), pointer :: yc_dst(:) ! Destination latitude + real(r8), pointer :: frac_dst(:) ! Destination fraction + integer, pointer :: mask_dst(:) ! Destination mask + integer, pointer :: dst_indx(:) ! Destination index + character(len= 32) :: subname = 'domain_checksame' + + ! tolerance for checking equality of lat & lon + ! We allow for single-precision rounding-level differences (approx. 1.2e-7 relative + ! error) For a value of 360 (max value for lat / lon), this means we can allow + ! absolute errors of about 5e-5. + real(r8), parameter :: eps = 5.e-5_r8 + + + if (srcdomain%set == unset) then + write(6,*) trim(subname)//'ERROR: source domain is unset!' + call abort() + end if + if (srcdomain%set == unset) then + write(6,*) trim(subname)//'ERROR: destination domain is unset!' + call abort() + end if + + call gridmap_setptrs( tgridmap, nsrc=na, ndst=nb, ns=ns, & + xc_src=xc_src, yc_src=yc_src, & + xc_dst=xc_dst, yc_dst=yc_dst, & + mask_src=mask_src, mask_dst=mask_dst, & + src_indx=src_indx, dst_indx=dst_indx & + ) + + if (srcdomain%ns /= na) then + write(6,*) trim(subname)// & + ' ERROR: input domain size and gridmap source size are not the same size' + write(6,*)' domain size = ',srcdomain%ns + write(6,*)' map src size= ',na + call abort() + end if + if (dstdomain%ns /= nb) then + write(6,*) trim(subname)// & + ' ERROR: output domain size and gridmap destination size are not the same size' + write(6,*)' domain size = ',dstdomain%ns + write(6,*)' map dst size= ',nb + call abort() + end if + do n = 1,ns + ni = src_indx(n) + if ( srcdomain%maskset )then + if (srcdomain%mask(ni) /= mask_src(ni)) then + write(6,*) trim(subname)// & + ' ERROR: input domain mask and gridmap mask are not the same at ni = ',ni + write(6,*)' domain mask= ',srcdomain%mask(ni) + write(6,*)' gridmap mask= ',mask_src(ni) + call abort() + end if + end if + if (abs(srcdomain%lonc(ni) - xc_src(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: input domain lon and gridmap lon not the same at ni = ',ni + write(6,*)' domain lon= ',srcdomain%lonc(ni) + write(6,*)' gridmap lon= ',xc_src(ni) + call abort() + end if + if (abs(srcdomain%latc(ni) - yc_src(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: input domain lat and gridmap lat not the same at ni = ',ni + write(6,*)' domain lat= ',srcdomain%latc(ni) + write(6,*)' gridmap lat= ',yc_src(ni) + call abort() + end if + end do + do n = 1,ns + ni = dst_indx(n) + if ( dstdomain%maskset )then + if (dstdomain%mask(ni) /= mask_dst(ni)) then + write(6,*) trim(subname)// & + ' ERROR: output domain mask and gridmap mask are not the same at ni = ',ni + write(6,*)' domain mask= ',dstdomain%mask(ni) + write(6,*)' gridmap mask= ',mask_dst(ni) + call abort() + end if + end if + if (abs(dstdomain%lonc(ni) - xc_dst(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: output domain lon and gridmap lon not the same at ni = ',ni + write(6,*)' domain lon= ',dstdomain%lonc(ni) + write(6,*)' gridmap lon= ',xc_dst(ni) + call abort() + end if + if (abs(dstdomain%latc(ni) - yc_dst(ni)) > eps) then + write(6,*) trim(subname)// & + ' ERROR: output domain lat and gridmap lat not the same at ni = ',ni + write(6,*)' domain lat= ',dstdomain%latc(ni) + write(6,*)' gridmap lat= ',yc_dst(ni) + call abort() + end if + end do + + end subroutine domain_checksame + +end module mkdomainMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 new file mode 100644 index 0000000000..589b2f5118 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 @@ -0,0 +1,535 @@ +module mkfileMod + +contains + +!----------------------------------------------------------------------- + subroutine mkfile(domain, fname, dynlanduse) + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_getenv + use fileutils , only : get_filename + use mkvarpar , only : nlevsoi, nlevurb, numrad + use mkvarctl + use mkurbanparMod, only : numurbl + use mkglcmecMod , only : nglcec + use mkpftMod , only : mkpftAtt + use mksoilMod , only : mksoilAtt + use mkharvestMod , only : mkharvest_fieldname, mkharvest_numtypes, mkharvest_longname + use mkncdio , only : check_ret, ncd_defvar, ncd_def_spatial_var + use mkdomainMod + + implicit none + include 'netcdf.inc' + type(domain_type) , intent(in) :: domain + character(len=*) , intent(in) :: fname + logical , intent(in) :: dynlanduse + + integer :: ncid + integer :: j ! index + integer :: dimid ! temporary + integer :: values(8) ! temporary + character(len=256) :: str ! global attribute string + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 18) :: datetime ! temporary + character(len= 8) :: date ! temporary + character(len= 10) :: time ! temporary + character(len= 5) :: zone ! temporary + integer :: ier ! error status + integer :: omode ! netCDF output mode + integer :: xtype ! external type + character(len=32) :: subname = 'mkfile' ! subroutine name +!----------------------------------------------------------------------- + + call check_ret(nf_create(trim(fname), ior(nf_clobber,nf_64bit_offset), & + ncid), subname) + + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Define dimensions. + + if (outnc_1d) then + call check_ret(nf_def_dim (ncid, 'gridcell', domain%ns, dimid), subname) + else + call check_ret(nf_def_dim (ncid, 'lsmlon' , domain%ni, dimid), subname) + call check_ret(nf_def_dim (ncid, 'lsmlat' , domain%nj, dimid), subname) + end if + + if (.not. dynlanduse) then + if ( nglcec > 0 )then + call check_ret(nf_def_dim (ncid, 'nglcec' , nglcec , dimid), subname) + call check_ret(nf_def_dim (ncid, 'nglcecp1', nglcec+1 , dimid), subname) + end if + end if + call check_ret(nf_def_dim (ncid, 'numurbl' , numurbl , dimid), subname) + call check_ret(nf_def_dim (ncid, 'nlevurb' , nlevurb , dimid), subname) + call check_ret(nf_def_dim (ncid, 'numrad' , numrad , dimid), subname) + call check_ret(nf_def_dim (ncid, 'nchar' , 256 , dimid), subname) + + ! Create global attributes. + + str = 'NCAR-CSM' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Conventions', len_trim(str), trim(str)), subname) + + call date_and_time (date, time, zone, values) + datetime(1:8) = date(5:6) // '-' // date(7:8) // '-' // date(3:4) + datetime(9:) = ' ' // time(1:2) // ':' // time(3:4) // ':' // time(5:6) // ' ' + str = 'created on: ' // datetime + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'History_Log', len_trim(str), trim(str)), subname) + + call shr_sys_getenv ('LOGNAME', str, ier) + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Logname', len_trim(str), trim(str)), subname) + + call shr_sys_getenv ('HOST', str, ier) + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Host', len_trim(str), trim(str)), subname) + + str = 'Community Land Model: CLM4' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Source', len_trim(str), trim(str)), subname) + + str = & +'$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/tools/clm4_5/mksurfdata_map/src/mkfileMod.F90 $' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Version', len_trim(str), trim(str)), subname) + + str = '$Id: mkfileMod.F90 66531 2014-12-27 13:54:58Z sacks $' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Revision_Id', len_trim(str), trim(str)), subname) + +#ifdef OPT + str = 'TRUE' +#else + str = 'FALSE' +#endif + + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'Compiler_Optimized', len_trim(str), trim(str)), subname) + + if ( all_urban )then + str = 'TRUE' + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'all_urban', len_trim(str), trim(str)), subname) + end if + + if ( no_inlandwet )then + str = 'TRUE' + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'no_inlandwet', len_trim(str), trim(str)), subname) + end if + + call check_ret(nf_put_att_int(ncid, NF_GLOBAL, & + 'nglcec', nf_int, 1, nglcec), subname) + + ! Raw data file names + + str = get_filename(mksrf_fgrid) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Input_grid_dataset', len_trim(str), trim(str)), subname) + + str = trim(mksrf_gridtype) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Input_gridtype', len_trim(str), trim(str)), subname) + + if (.not. dynlanduse) then + str = get_filename(mksrf_fvocef) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'VOC_EF_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + str = get_filename(mksrf_flakwat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Inland_lake_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fwetlnd) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Inland_wetland_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fglacier) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Glacier_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_furbtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Urban_Topography_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_flndtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Land_Topography_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_furban) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Urban_raw_data_file_name', len_trim(str), trim(str)), subname) + + if (.not. dynlanduse) then + str = get_filename(mksrf_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Lai_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + str = get_filename(mksrf_fabm) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'agfirepkmon_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fgdp) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'gdp_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fpeat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'peatland_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_ftopostats) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'topography_stats_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fvic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'vic_raw_data_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(mksrf_fch4) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'ch4_params_raw_data_file_name', len_trim(str), trim(str)), subname) + + ! Mapping file names + + str = get_filename(map_fpft) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_pft_file_name', len_trim(str), trim(str)), subname) + + str = get_filename(map_flakwat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_lakwat_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fwetlnd) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_wetlnd_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fglacier) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_glacier_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fsoitex) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_texture_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fsoicol) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_color_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_forganic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_soil_organic_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_furban) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_urban_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fmax) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_fmax_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fvocef) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_VOC_EF_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fharvest) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_harvest_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_lai_sai_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_furbtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_urban_topography_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_flndtopo) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_land_topography_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fabm) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_agfirepkmon_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fgdp) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_gdp_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fpeat) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_peatland_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_ftopostats) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_topography_stats_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fvic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_vic_file', len_trim(str), trim(str)), subname) + + str = get_filename(map_fch4) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'map_ch4_params_file', len_trim(str), trim(str)), subname) + + ! ---------------------------------------------------------------------- + ! Define variables + ! ---------------------------------------------------------------------- + + if ( .not. outnc_double )then + xtype = nf_float + else + xtype = nf_double + end if + + call mksoilAtt( ncid, dynlanduse, xtype ) + + call mkpftAtt( ncid, dynlanduse, xtype ) + + call ncd_def_spatial_var(ncid=ncid, varname='AREA' , xtype=nf_double, & + long_name='area', units='km^2') + + call ncd_def_spatial_var(ncid=ncid, varname='LONGXY', xtype=nf_double, & + long_name='longitude', units='degrees east') + + call ncd_def_spatial_var(ncid=ncid, varname='LATIXY', xtype=nf_double, & + long_name='latitude', units='degrees north') + + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='EF1_BTR', xtype=xtype, & + long_name='EF btr (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EF1_FET', xtype=xtype, & + long_name='EF fet (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EF1_FDT', xtype=xtype, & + long_name='EF fdt (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EF1_SHR', xtype=xtype, & + long_name='EF shr (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EF1_GRS', xtype=xtype, & + long_name='EF grs (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EF1_CRP', xtype=xtype, & + long_name='EF crp (isoprene)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='CANYON_HWR', xtype=xtype, & + lev1name='numurbl', & + long_name='canyon height to width ratio', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EM_IMPROAD', xtype=xtype, & + lev1name='numurbl', & + long_name='emissivity of impervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EM_PERROAD', xtype=xtype, & + lev1name='numurbl', & + long_name='emissivity of pervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EM_ROOF', xtype=xtype, & + lev1name='numurbl', & + long_name='emissivity of roof', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='EM_WALL', xtype=xtype, & + lev1name='numurbl', & + long_name='emissivity of wall', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='HT_ROOF', xtype=xtype, & + lev1name='numurbl', & + long_name='height of roof', units='meters') + + call ncd_def_spatial_var(ncid=ncid, varname='THICK_ROOF', xtype=xtype, & + lev1name='numurbl', & + long_name='thickness of roof', units='meters') + + call ncd_def_spatial_var(ncid=ncid, varname='THICK_WALL', xtype=xtype, & + lev1name='numurbl', & + long_name='thickness of wall', units='meters') + + call ncd_def_spatial_var(ncid=ncid, varname='T_BUILDING_MAX', xtype=xtype, & + lev1name='numurbl', & + long_name='maximum interior building temperature', units='K') + + call ncd_def_spatial_var(ncid=ncid, varname='T_BUILDING_MIN', xtype=xtype, & + lev1name='numurbl', & + long_name='minimum interior building temperature', units='K') + + call ncd_def_spatial_var(ncid=ncid, varname='WIND_HGT_CANYON', xtype=xtype, & + lev1name='numurbl', & + long_name='height of wind in canyon', units='meters') + + call ncd_def_spatial_var(ncid=ncid, varname='WTLUNIT_ROOF', xtype=xtype, & + lev1name='numurbl', & + long_name='fraction of roof', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='WTROAD_PERV', xtype=xtype, & + lev1name='numurbl', & + long_name='fraction of pervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_IMPROAD_DIR', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='direct albedo of impervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_IMPROAD_DIF', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='diffuse albedo of impervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_PERROAD_DIR', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='direct albedo of pervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_PERROAD_DIF', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='diffuse albedo of pervious road', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_ROOF_DIR', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='direct albedo of roof', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_ROOF_DIF', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='diffuse albedo of roof', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_WALL_DIR', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='direct albedo of wall', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ALB_WALL_DIF', xtype=xtype, & + lev1name='numurbl', lev2name='numrad', & + long_name='diffuse albedo of wall', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='TK_ROOF', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='thermal conductivity of roof', units='W/m*K') + + call ncd_def_spatial_var(ncid=ncid, varname='TK_WALL', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='thermal conductivity of wall', units='W/m*K') + + call ncd_def_spatial_var(ncid=ncid, varname='TK_IMPROAD', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='thermal conductivity of impervious road', units='W/m*K') + + call ncd_def_spatial_var(ncid=ncid, varname='CV_ROOF', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='volumetric heat capacity of roof', units='J/m^3*K') + + call ncd_def_spatial_var(ncid=ncid, varname='CV_WALL', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='volumetric heat capacity of wall', units='J/m^3*K') + + call ncd_def_spatial_var(ncid=ncid, varname='CV_IMPROAD', xtype=xtype, & + lev1name='numurbl', lev2name='nlevurb', & + long_name='volumetric heat capacity of impervious road', units='J/m^3*K') + + call ncd_def_spatial_var(ncid=ncid, varname='NLEV_IMPROAD', xtype=nf_int, & + lev1name='numurbl', & + long_name='number of impervious road layers', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='peatf', xtype=xtype, & + long_name='peatland fraction', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='abm', xtype=nf_int, & + long_name='agricultural fire peak month', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='gdp', xtype=xtype, & + long_name='gdp', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='SLOPE', xtype=xtype, & + long_name='mean topographic slope', units='degrees') + + call ncd_def_spatial_var(ncid=ncid, varname='STD_ELEV', xtype=xtype, & + long_name='standard deviation of elevation', units='m') + + call ncd_def_spatial_var(ncid=ncid, varname='binfl', xtype=xtype, & + long_name='VIC b parameter for the Variable Infiltration Capacity Curve', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='Ws', xtype=xtype, & + long_name='VIC Ws parameter for the ARNO curve', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='Dsmax', xtype=xtype, & + long_name='VIC Dsmax parameter for the ARNO curve', units='mm/day') + + call ncd_def_spatial_var(ncid=ncid, varname='Ds', xtype=xtype, & + long_name='VIC Ds parameter for the ARNO curve', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='LAKEDEPTH', xtype=xtype, & + long_name='lake depth', units='m') + + call ncd_def_spatial_var(ncid=ncid, varname='F0', xtype=xtype, & + long_name='maximum gridcell fractional inundated area', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='P3', xtype=xtype, & + long_name='coefficient for qflx_surf_lag for finundated', units='s/mm') + + call ncd_def_spatial_var(ncid=ncid, varname='ZWT0', xtype=xtype, & + long_name='decay factor for finundated', units='m') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_WETLAND', xtype=xtype, & + long_name='percent wetland', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_LAKE', xtype=xtype, & + long_name='percent lake', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLACIER', xtype=xtype, & + long_name='percent glacier', units='unitless') + + if ( nglcec > 0 )then + call ncd_defvar(ncid=ncid, varname='GLC_MEC', xtype=xtype, & + dim1name='nglcecp1', long_name='Glacier elevation class', units='m') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLC_MEC', xtype=xtype, & + lev1name='nglcec', & + long_name='percent glacier for each glacier elevation class (% of landunit)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLC_MEC_GIC', xtype=xtype, & + lev1name='nglcec', & + long_name='percent smaller glaciers and ice caps for each glacier elevation class (% of landunit)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLC_MEC_ICESHEET', xtype=xtype, & + lev1name='nglcec', & + long_name='percent ice sheet for each glacier elevation class (% of landunit)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLC_GIC', xtype=xtype, & + long_name='percent ice caps/glaciers (% of landunit)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_GLC_ICESHEET', xtype=xtype, & + long_name='percent ice sheet (% of landunit)', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='TOPO_GLC_MEC', xtype=xtype, & + lev1name='nglcec', & + long_name='mean elevation on glacier elevation classes', units='m') + end if + + call ncd_def_spatial_var(ncid=ncid, varname='TOPO', xtype=xtype, & + long_name='mean elevation on land', units='m') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_URBAN', xtype=xtype, & + lev1name='numurbl', & + long_name='percent urban for each density type', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='URBAN_REGION_ID', xtype=nf_int, & + long_name='urban region ID', units='unitless') + + end if ! .not. dynlanduse + + if (dynlanduse) then + do j = 1, mkharvest_numtypes() + call ncd_def_spatial_var(ncid=ncid, varname=mkharvest_fieldname(j), xtype=xtype, & + lev1name='time', & + long_name=mkharvest_longname(j), units='unitless') + end do + end if + + ! End of define mode + + call check_ret(nf_enddef(ncid), subname) + call check_ret(nf_close(ncid), subname) + + end subroutine mkfile + +end module mkfileMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkgdpMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkgdpMod.F90 new file mode 100644 index 0000000000..62e01d8135 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkgdpMod.F90 @@ -0,0 +1,134 @@ +module mkgdpMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkgdpMod +! +! !DESCRIPTION: +! make GDP from input GDP data +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkgdp ! regrid gdp data +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkgdp +! +! !INTERFACE: +subroutine mkgdp(ldomain, mapfname, datfname, ndiag, gdp_o) +! +! !DESCRIPTION: +! make GDP from input GDP data +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_continuous + use mkchecksMod, only : min_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: gdp_o(:) ! output grid: GDP (x1000 1995 US$ per capita) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid = 0._r8 ! minimum valid value + + character(len=32) :: subname = 'mkgdp' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make GDP.....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname) + + call gridmap_mapread(tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open GDP file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid gdp + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'gdp', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, gdp_o, nodata=0._r8) + + ! Check validity of output data + if (min_bad(gdp_o, min_valid, 'gdp')) then + stop + end if + + call output_diagnostics_continuous(data_i, gdp_o, tgridmap, "GDP", "x1000 US$ per capita", ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made GDP' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkgdp + +end module mkgdpMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 new file mode 100644 index 0000000000..c186904cb9 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkglcmecMod.F90 @@ -0,0 +1,792 @@ +module mkglcmecMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkglcmecMod +! +! !DESCRIPTION: +! Make glacier multi-elevation class data +! +! !REVISION HISTORY: +! Author: Erik Kluzek, Mariana Vertenstein +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mkglcmecInit ! Initialization + public mkglcmec ! Set glacier multi-elevation class + public mkglacier ! Set percent glacier +! +! !PUBLIC DATA MEMBERS: +! + integer, public :: nglcec = 10 ! number of elevation classes for glaciers + real(r8), pointer :: elevclass(:) ! elevation classes +! +! !PRIVATE MEMBER FUNCTIONS: + private get_elevclass ! get elevation class index + private mean_elevation_vc ! get the elevation of a virtual column +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglcmecInit +! +! !INTERFACE: +subroutine mkglcmecInit( elevclass_o ) +! +! !DESCRIPTION: +! Initialize of Make glacier multi-elevation class data +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(OUT) :: elevclass_o(:) ! elevation classes +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'mkglcmecInit:: ' +!----------------------------------------------------------------------- + allocate( elevclass(nglcec+1) ) + + ! ----------------------------------------------------------------- + ! Define elevation classes, represents lower boundary of each class + ! ----------------------------------------------------------------- + + if ( nglcec == 36 )then + elevclass(:) = (/ 0., 200., 400., 600., 800., & + 1000., 1200., 1400., 1600., 1800., & + 2000., 2200., 2400., 2600., 2800., & + 3000., 3200., 3400., 3600., 3800., & + 4000., 4200., 4400., 4600., 4800., & + 5000., 5200., 5400., 5600., 5800., & + 6000., 6200., 6400., 6600., 6800., & + 7000., 10000./) + else if ( nglcec == 10 )then + elevclass(1) = 0. + elevclass(2) = 200. + elevclass(3) = 400. + elevclass(4) = 700. + elevclass(5) = 1000. + elevclass(6) = 1300. + elevclass(7) = 1600. + elevclass(8) = 2000. + elevclass(9) = 2500. + elevclass(10) = 3000. + elevclass(11) = 10000. + else if ( nglcec == 5 )then + elevclass(1) = 0. + elevclass(2) = 500. + elevclass(3) = 1000. + elevclass(4) = 1500. + elevclass(5) = 2000. + elevclass(6) = 10000. + else if ( nglcec == 3 )then + elevclass(1) = 0. + elevclass(2) = 1000. + elevclass(3) = 2000. + elevclass(4) = 10000. + else if ( nglcec == 1 )then + elevclass(1) = 0. + elevclass(2) = 10000. + else if ( nglcec == 0 )then + elevclass(1) = 10000. + else + write(6,*) subname//"ERROR:: nglcec must be 0, 1, 3, 5, 10 or 36",& + " to work with CLM: " + call abort() + end if + + elevclass_o(:) = elevclass(:) + +end subroutine mkglcmecInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglcmec +! +! !INTERFACE: +subroutine mkglcmec(ldomain, mapfname, & + datfname_fglacier, ndiag, & + pctglcmec_o, topoglcmec_o, & + pctglcmec_gic_o, pctglcmec_icesheet_o, & + pctglc_gic_o, pctglc_icesheet_o) +! +! !DESCRIPTION: +! make percent glacier on multiple elevation classes, mean elevation for each +! elevation class, and associated fields +! +! Note that the raw glacier data are specified by level, and thus implicitly include the +! necessary topo data for breaking pct glacier into elevation classes. Each level in the +! input data is assigned to an elevation (given by BIN_CENTERS in the input data). Thus, +! all of the input glacier in level 1 is treated as being at the same elevation, and +! likewise for each other level. These elevations are then used in assigning pct_glacier +! to the appropriate elevation class in the output data, as well as determining the mean +! topographic height of each elevation class in the output data. +! +! Note that the various percentages computed here are given as % of the glc_mec landunit. +! If the input glacier area is 0 for a given grid cell, this requires setting these % +! variables in an arbitrary way. +! +! Does nothing if nglcec==0. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkutilsMod, only : slightly_below, slightly_above + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname_fglacier ! raw glacier data + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: pctglcmec_o (:,:) ! % for each elevation class on output glacier grid (% of landunit) + real(r8) , intent(out):: topoglcmec_o(:,:) ! mean elevation for each elevation classs on output glacier grid + real(r8) , intent(out):: pctglcmec_gic_o(:,:) ! % glc gic on output grid, by elevation class (% of landunit) + real(r8) , intent(out):: pctglcmec_icesheet_o(:,:) ! % glc ice sheet on output grid, by elevation class (% of landunit) + real(r8) , intent(out):: pctglc_gic_o(:) ! % glc gic on output grid, summed across elevation classes (% of landunit) + real(r8) , intent(out):: pctglc_icesheet_o(:) ! % glc ice sheet on output grid, summed across elevation classes (% of landunit) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: David Lawrence +! 7/12/11: Bill Sacks: substantial rewrite to use input topo and % glacier at same resolution +! 9/25/12: Bill Sacks: substantial rewrite to use new format of fglacier, which provides +! percent by elevation bin (thus the separate topo dataset is no longer needed +! in this routine) +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: pctglc_gic_i(:) ! input GIC percentage for a single level + real(r8), allocatable :: pctglc_icesheet_i(:) ! input icesheet percentage for a single level + real(r8), allocatable :: topoglcmec_unnorm_o(:,:) ! same as topoglcmec_o, but unnormalized + real(r8), allocatable :: pctglc_tot_o(:) ! total glacier cover for the grid cell + real(r8) :: topoice_i ! topographic height of this level + real(r8) :: pctglc_i ! input total pct glacier for a single level & single point + real(r8) :: wt, frac ! weighting factors for remapping + integer :: ndims ! number of dimensions in input variables + integer :: dim_lengths(nf_max_var_dims) ! lengths of dimensions in input variables + integer, allocatable :: starts(:), counts(:) ! start indices & counts for reading variable slices + integer :: ni,no,ns_o,nst,lev ! indices + integer :: n,m ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: nlev ! number of levels in input file + real(r8) :: glc_sum ! temporary + integer :: ier ! error status + logical :: errors ! error status + + real(r8), parameter :: eps = 2.e-5_r8 ! epsilon for error checks (note that we use a large-ish value + ! because data are stored as single-precision floats in the + ! raw dataset) + real(r8), parameter :: eps_small = 1.e-12_r8 ! epsilon for error checks that expect close match + character(len=32) :: subname = 'mkglcmec' +!----------------------------------------------------------------------- + + ! Initialize all output fields to zero + + pctglcmec_o(:,:) = 0. + topoglcmec_o(:,:) = 0. + pctglcmec_gic_o(:,:) = 0. + pctglcmec_icesheet_o(:,:) = 0. + pctglc_gic_o(:) = 0. + pctglc_icesheet_o(:) = 0. + + ! Set number of output points + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Exit early, if no elevation class info is requested + ! ----------------------------------------------------------------- + if ( nglcec == 0 )then + write (6,*) 'Number of glacier elevation classes is zero ',& + '-- set glcmec to zero as well' + call shr_sys_flush(6) + return + end if + + write (6,*) 'Attempting to make percent elevation class ',& + 'and mean elevation for glaciers .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and dimension information from glacier raw data file + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname_fglacier) + nst = tdomain%ns + + ! Read z dimension size + write (6,*) 'Open glacier file: ', trim(datfname_fglacier) + call check_ret(nf_open(datfname_fglacier, 0, ncid), subname) + ier = nf_inq_dimid (ncid, 'z', dimid) + if (ier /= NF_NOERR) then + write (6,*) trim(subname), ' ERROR: z dimension not found on glacier file:' + write (6,*) trim(datfname_fglacier) + write (6,*) 'Perhaps you are trying to use an old-format glacier file?' + write (6,*) '(prior to Sept., 2012)' + call abort() + end if + call check_ret(nf_inq_dimlen (ncid, dimid, nlev), subname) + + ! ----------------------------------------------------------------- + ! Read mapping data, check for consistency with domains + ! ----------------------------------------------------------------- + + ! Mapping for raw glacier -> model output grid + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Determine dimension lengths and create start & count arrays + ! for later reading one level at a time + ! ----------------------------------------------------------------- + + call get_dim_lengths(ncid, 'PCT_GLC_GIC', ndims, dim_lengths) + + allocate(starts(ndims), counts(ndims), stat=ier) + if (ier/=0) call abort() + + starts(1:ndims) = 1 + + ! We assume that the last dimension is the level dimension + counts(1:ndims-1) = dim_lengths(1:ndims-1) + counts(ndims) = 1 + + ! -------------------------------------------------------------------- + ! Compute fields on the output grid + ! -------------------------------------------------------------------- + + allocate(pctglc_gic_i(nst), pctglc_icesheet_i(nst), stat=ier) + if (ier/=0) call abort() + + allocate(topoglcmec_unnorm_o(ns_o,nglcec), stat=ier) + if (ier/=0) call abort() + + topoglcmec_unnorm_o(:,:) = 0. + + write(6,'(a,i4,a)',advance='no') 'Level (out of ', nlev, '): ' + do lev = 1, nlev + write(6,'(i4)',advance='no') lev + flush(6) + + ! Read this level's data + ! We assume that the last dimension is the level dimension + starts(ndims) = lev + call check_ret(nf_inq_varid (ncid, 'BIN_CENTERS', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, (/lev/), (/1/), topoice_i), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLC_GIC', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, pctglc_gic_i), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLC_ICESHEET', varid), subname) + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, pctglc_icesheet_i), subname) + + ! Determine elevation class + m = get_elevclass(topoice_i) + if (m < 1 .or. m > nglcec) then + call abort() + end if + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + + ! fraction of this destination cell that is covered by source cells that are within the source landmask + frac = tgridmap%frac_dst(no) + + ! If frac == 0, then we can't do this, to avoid divide by 0. In this case, the + ! outputs remain equal to 0 (their initialized value). + if (frac > 0) then + pctglc_i = pctglc_gic_i(ni) + pctglc_icesheet_i(ni) + pctglcmec_o(no,m) = pctglcmec_o(no,m) + wt*pctglc_i / frac + pctglcmec_gic_o(no,m) = pctglcmec_gic_o(no,m) + wt*pctglc_gic_i(ni) / frac + pctglcmec_icesheet_o(no,m) = pctglcmec_icesheet_o(no,m) + wt*pctglc_icesheet_i(ni) / frac + + ! note that, by weighting the following by pctglc_i, we are getting something + ! like the average topographic height over glaciated areas - NOT the average + ! topographic height of the entire grid cell + topoglcmec_unnorm_o(no,m) = topoglcmec_unnorm_o(no,m) + wt*pctglc_i*topoice_i / frac + end if + end do + end do + + ! Note: at this point, the various percentages are given as % of grid cell; below, we + ! renormalize these to be given as % of landunit. + + ! advance to next line (needed because of 'advance=no' writes above) + write(6,*) ' ' + + ! Close glacier input file + call check_ret(nf_close(ncid), subname) + + ! Normalize topoglcmec_o. To do this, note that pctglcmec_o(n,m) is equal to the sum of + ! the weights used in doing the weighted average of topoice_i (weight = + ! wt*pctglc_i/frac); hence pctglcmec_o(n,m) is the correct normalization factor + do no = 1,ns_o + do m = 1,nglcec + if (pctglcmec_o(no,m) > 0) then + topoglcmec_o(no,m) = topoglcmec_unnorm_o(no,m) / pctglcmec_o(no,m) + else + topoglcmec_o(no,m) = mean_elevation_vc(m) + end if + + ! Correct for rounding errors that put topoglcmec_o(no,m) slightly outside the + ! allowed bounds for this elevation class + if (slightly_below(topoglcmec_o(no,m), elevclass(m))) then + write(6,*) 'Warning: topoglcmec_o was slightly lower than lower bound; setting equal& + & to lower bound; for: ', no, m, topoglcmec_o(no,m), elevclass(m) + write(6,*) '(this is informational only, and probably just indicates rounding error)' + topoglcmec_o(no,m) = elevclass(m) + else if (slightly_above(topoglcmec_o(no,m), elevclass(m+1))) then + write(6,*) 'Warning: topoglcmec_o was slightly higher than upper bound; setting equal& + & to upper bound; for: ', no, m, topoglcmec_o(no,m), elevclass(m+1) + write(6,*) '(this is informational only, and probably just indicates rounding error)' + topoglcmec_o(no,m) = elevclass(m+1) + end if + end do + end do + + ! Renormalize percentages to be given as % of landunit rather than % of grid cell. + + allocate(pctglc_tot_o(ns_o), stat=ier) + if (ier/=0) call abort() + + do no = 1,ns_o + pctglc_tot_o(no) = sum(pctglcmec_o(no,:)) + + if (pctglc_tot_o(no) > 0._r8) then + pctglcmec_o(no,:) = pctglcmec_o(no,:) / pctglc_tot_o(no) * 100._r8 + pctglcmec_gic_o(no,:) = pctglcmec_gic_o(no,:) / pctglc_tot_o(no) * 100._r8 + pctglcmec_icesheet_o(no,:) = pctglcmec_icesheet_o(no,:) / pctglc_tot_o(no) * 100._r8 + + else + ! Division of landunit is ambiguous. Apply the rule that all area is assigned to + ! the lowest elevation class, and all GIC. + pctglcmec_o(no,1) = 100._r8 + pctglcmec_gic_o(no,1) = 100._r8 + end if + end do + + ! Set pctglc_gic_o to sum of pctglcmec_gic_o across elevation classes, and similarly for pctglc_icesheet_o + pctglc_gic_o = sum(pctglcmec_gic_o, dim=2) + pctglc_icesheet_o = sum(pctglcmec_icesheet_o, dim=2) + + ! -------------------------------------------------------------------- + ! Perform various sanity checks + ! -------------------------------------------------------------------- + + errors = .false. + + ! Confirm that the sum over pctglcmec_o (from 1 to nglcec) is 100% + do no = 1,ns_o + glc_sum = sum(pctglcmec_o(no,:)) + if (abs(glc_sum - 100._r8) > eps_small) then + write(6,*)'glc_sum differs from 100% at no,pctglc= ',no,glc_sum + errors = .true. + end if + end do + + ! Confirm that GIC + ICESHEET = 100% + do no = 1,ns_o + if (abs((pctglc_gic_o(no) + pctglc_icesheet_o(no)) - 100._r8) > eps) then + write(6,*)'GIC + ICESHEET differs from 100% at no,pctglc_gic,pctglc_icesheet,lon,lat=', & + no,pctglc_gic_o(no),pctglc_icesheet_o(no),& + tgridmap%xc_dst(no),tgridmap%yc_dst(no) + errors = .true. + end if + end do + + ! Check that GIC + ICESHEET = total glacier at each elevation class + do m = 1, nglcec + do no = 1,ns_o + if (abs((pctglcmec_gic_o(no,m) + pctglcmec_icesheet_o(no,m)) - & + pctglcmec_o(no,m)) > eps) then + write(6,*)'GIC + ICESHEET differs from total GLC ' + write(6,*)'at no,m,pctglcmec,pctglcmec_gic,pctglcmec_icesheet = ' + write(6,*) no,m,pctglcmec_o(no,m),pctglcmec_gic_o(no,m),pctglcmec_icesheet_o(no,m) + errors = .true. + end if + end do + end do + + + ! Error check: are all elevations within elevation class range + do no = 1,ns_o + do m = 1,nglcec + if (topoglcmec_o(no,m) < elevclass(m) .or. topoglcmec_o(no,m) > elevclass(m+1)) then + write(6,*) 'Error: mean elevation does not fall within elevation class ' + write(6,*) elevclass(m),elevclass(m+1),topoglcmec_o(no,m),m,no + errors = .true. + endif + end do + end do + + if (errors) then + call abort() + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate(pctglc_gic_i, pctglc_icesheet_i) + deallocate(topoglcmec_unnorm_o) + deallocate(pctglc_tot_o) + deallocate(starts, counts) + + write (6,*) 'Successfully made percent elevation class and mean elevation for glaciers' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkglcmec + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkglacier +! +! !INTERFACE: +subroutine mkglacier(ldomain, mapfname, datfname, ndiag, zero_out, glac_o) +! +! !DESCRIPTION: +! make percent glacier +! +! In contrast to mkglcmec, this uses a "flat" PCT_GLACIER field (not separated by +! elevation class, and not separated into icesheet vs GIC). +! +! This simpler routine is sufficient for cases when we run without multiple elevation +! classes. This routine is also used when running with multiple elevation classes: we +! first regrid the flat PCT_GLACIER field, then later create the multiple elevation class +! data. This multi-step process makes it easier to do corrections on the total +! PCT_GLACIER, and make sure these corrections apply appropriately to the multi-level +! output. The assumption is that PCT_GLACIER is the sum of both PCT_GLC_GIC and +! PCT_GLC_ICESHEET across all elevation bins. +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: glac_o(:) ! output grid: %glacier +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: glac_i(:) ! input grid: percent glac + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gglac_i ! input grid: global glac + real(r8) :: garea_i ! input grid: global area + real(r8) :: gglac_o ! output grid: global glac + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkglacier' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %glacier .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns = tdomain%ns + allocate(glac_i(ns), stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open glacier file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_GLACIER', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, glac_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + if ( zero_out )then + + do no = 1, ldomain%ns + glac_o(no) = 0. + enddo + + else + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine glac_o on output grid + + call gridmap_areaave(tgridmap, glac_i, glac_o, nodata=0._r8) + + do no = 1, ldomain%ns + if (glac_o(no) < 1.) glac_o(no) = 0. + enddo + end if + + ! Check for conservation + + do no = 1, ldomain%ns + if ((glac_o(no)) > 100.000001_r8) then + write (6,*) 'MKGLACIER error: glacier = ',glac_o(no), & + ' greater than 100.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + + ! Some error checking and writing of global values before and after the regrid + + if ( .not. zero_out )then + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1, tdomain%ns + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1, ldomain%ns + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKGLACIER error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gglac_i = 0. + garea_i = 0. + do ni = 1, tdomain%ns + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gglac_i = gglac_i + glac_i(ni)*(tgridmap%area_src(ni)/100.)*& + tgridmap%frac_src(ni)*re**2 + end do + + ! Output grid + + gglac_o = 0. + garea_o = 0. + do no = 1, ldomain%ns + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gglac_o = gglac_o + glac_o(no)*(tgridmap%area_dst(no)/100.)*& + tgridmap%frac_dst(no)*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Glacier Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) gglac_i*1.e-06,gglac_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'glaciers ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (glac_i) + end if + + write (6,*) 'Successfully made %glacier' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkglacier + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: get_elevclass +! +! !INTERFACE: +integer function get_elevclass(topo, writewarn) +! +! !DESCRIPTION: +! Returns elevation class index (1..nglcec) given the topographic height. +! If topo is lower than the lowest elevation class, returns 0. +! If topo is higher than the highest elevation class, returns (nglcec+1). +! In either of the two latter cases, the function also writes a warning message, unless +! writewarn is present and false. +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: topo ! topographic height (m) + logical, intent(in), optional :: writewarn ! should warning messages be written? (default: true) +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! !LOCAL VARIABLES: +!EOP + integer :: m + logical :: my_writewarn + character(len=32) :: subname = 'get_elevclass' +!----------------------------------------------------------------------- + + if (present(writewarn)) then + my_writewarn = writewarn + else + my_writewarn = .true. + end if + + if (topo < elevclass(1)) then + if (my_writewarn) then + write(6,*) 'WARNING in ', trim(subname) + write(6,*) 'topo out of bounds' + write(6,*) 'topo = ', topo + write(6,*) 'elevclass(1) = ', elevclass(1) + end if + get_elevclass = 0 + return + end if + + do m = 1, nglcec + if (topo < elevclass(m+1)) then + ! note that we already know that topo >= elevclass(m), otherwise we would have + ! returned earlier + get_elevclass = m + return + end if + end do + + if (my_writewarn) then + write(6,*) 'WARNING in ', trim(subname) + write(6,*) 'topo out of bounds' + write(6,*) 'topo = ', topo + write(6,*) 'elevclass(nglcec+1) = ', elevclass(nglcec+1) + end if + get_elevclass = nglcec+1 + +end function get_elevclass + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mean_elevation_vc +! +! !INTERFACE: +real(r8) function mean_elevation_vc(class) +! +! !DESCRIPTION: +! For a virtual column (thus, a column that has no true elevation data), return the +! "mean" elevation of the given elevation class. +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: class ! elevation class +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'mean_elevation_vc' +!----------------------------------------------------------------------- + + if (class < nglcec) then + mean_elevation_vc = 0.5_r8 * (elevclass(class) + elevclass(class+1)) + else if (class == nglcec) then + ! In the top elevation class; in this case, assignment of a "mean" elevation is + ! somewhat arbitrary + + if (nglcec > 1) then + mean_elevation_vc = 2.0_r8*elevclass(class) - elevclass(class-1) + else + ! entirely arbitrary + mean_elevation_vc = 1000._r8 + end if + else + write(6,*) 'ERROR in ', trim(subname), ': class out of bounds= ', class + call abort() + end if + +end function mean_elevation_vc + +end module mkglcmecMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 new file mode 100644 index 0000000000..cb3e36b3c8 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkgridmapMod.F90 @@ -0,0 +1,700 @@ +module mkgridmapMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkgridmapMod +! +! !DESCRIPTION: +! Module containing 2-d global surface boundary data information +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + +! !PUBLIC TYPES: + type gridmap_type + character(len=32) :: set ! If set or not + character(len=32) :: name + integer :: na ! size of source domain + integer :: nb ! size of destination domain + integer :: ni ! number of row in the matrix + integer :: nj ! number of col in the matrix + integer :: ns ! number of non-zero elements in matrix + real(r8), pointer :: yc_src(:) ! "degrees" + real(r8), pointer :: yc_dst(:) ! "degrees" + real(r8), pointer :: xc_src(:) ! "degrees" + real(r8), pointer :: xc_dst(:) ! "degrees" + integer , pointer :: mask_src(:) ! "unitless" + integer , pointer :: mask_dst(:) ! "unitless" + real(R8), pointer :: area_src(:) ! area of a grid in map (radians) + real(R8), pointer :: area_dst(:) ! area of b grid in map (radians) + real(r8), pointer :: frac_src(:) ! "unitless" + real(r8), pointer :: frac_dst(:) ! "unitless" + integer , pointer :: src_indx(:) ! correpsonding column index + integer , pointer :: dst_indx(:) ! correpsonding row index + real(r8), pointer :: wovr(:) ! wt of overlap input cell + end type gridmap_type + public :: gridmap_type +! +! !PUBLIC MEMBER FUNCTIONS: + public :: gridmap_setptrs ! Set pointers to gridmap data + public :: gridmap_mapread ! Read in gridmap + public :: gridmap_check ! Check validity of a gridmap + public :: gridmap_areaave ! do area average + public :: gridmap_areastddev ! do area-weighted standard deviation + public :: gridmap_clean ! Clean and deallocate a gridmap structure +! +! +! !REVISION HISTORY: +! Author Mariana Vertenstein + + interface gridmap_areaave + module procedure gridmap_areaave_default + module procedure gridmap_areaave_srcmask + module procedure gridmap_areaave_srcmask2 + end interface + + ! questions - how does the reverse mapping occur + ! is mask_dst read in - and what happens if this is very different + ! from frac_dst which is calculated by mapping frac_src? + ! in frac - isn't grid1_frac always 1 or 0? + +! !PRIVATE MEMBER FUNCTIONS: + private :: gridmap_checkifset + + character(len=32), parameter :: isSet = "gridmap_IsSet" + +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_setptrs +! +! !INTERFACE: + subroutine gridmap_setptrs(gridmap, nsrc, ndst, ns, yc_src, yc_dst, & + xc_src, xc_dst, mask_src, mask_dst, & + frac_src, frac_dst, src_indx, dst_indx ) +! +! !DESCRIPTION: +! This subroutine assigns pointers to some of the map type data. +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! mapping data + integer, optional :: nsrc ! size of source domain + integer, optional :: ndst ! size of destination domain + integer, optional :: ns ! number of non-zero elements in matrix + integer, optional, pointer :: dst_indx(:) ! Destination index + integer, optional, pointer :: src_indx(:) ! Destination index + real(r8), optional, pointer :: yc_src(:) ! "degrees" + real(r8), optional, pointer :: yc_dst(:) ! "degrees" + real(r8), optional, pointer :: xc_src(:) ! "degrees" + real(r8), optional, pointer :: xc_dst(:) ! "degrees" + integer , optional, pointer :: mask_src(:) ! "unitless" + integer , optional, pointer :: mask_dst(:) ! "unitless" + real(r8), optional, pointer :: frac_src(:) ! "unitless" + real(r8), optional, pointer :: frac_dst(:) ! "unitless" +! +! !REVISION HISTORY: +! Created by Erik Kluzek +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------------ + character(*),parameter :: subName = '(gridmap_setptrs) ' + + call gridmap_checkifset( gridmap, subname ) + if ( present(nsrc) ) nsrc = gridmap%na + if ( present(ndst) ) ndst = gridmap%nb + if ( present(ns) ) ns = gridmap%ns + if ( present(yc_src) ) yc_src => gridmap%yc_src + if ( present(xc_src) ) xc_src => gridmap%xc_src + if ( present(mask_src) ) mask_src => gridmap%mask_src + if ( present(frac_src) ) frac_src => gridmap%frac_src + if ( present(yc_dst) ) yc_dst => gridmap%yc_dst + if ( present(xc_dst) ) xc_dst => gridmap%xc_dst + if ( present(mask_dst) ) mask_dst => gridmap%mask_dst + if ( present(frac_dst) ) frac_dst => gridmap%frac_dst + if ( present(dst_indx) ) dst_indx => gridmap%dst_indx + if ( present(src_indx) ) src_indx => gridmap%src_indx + end subroutine gridmap_setptrs + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_mapread +! +! !INTERFACE: + subroutine gridmap_mapread(gridmap, fileName) +! +! !DESCRIPTION: +! This subroutine reads in the map file +! +! !USES: + use mkncdio, only : convert_latlon +! +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + type(gridmap_type), intent(out) :: gridmap ! mapping data + character(len=*) , intent(in) :: filename ! netCDF file to read +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n ! generic loop indicies + integer :: na ! size of source domain + integer :: nb ! size of destination domain + integer :: igrow ! aVect index for matrix row + integer :: igcol ! aVect index for matrix column + integer :: iwgt ! aVect index for matrix element + integer :: iarea ! aVect index for area + + + character,allocatable :: str(:) ! variable length char string + character(len=256) :: attstr ! netCDF attribute name string + integer :: rcode ! netCDF routine return code + integer :: fid ! netCDF file ID + integer :: vid ! netCDF variable ID + integer :: did ! netCDF dimension ID + integer :: ns ! size of array + + real(r8), parameter :: tol = 1.0e-4_r8 ! tolerance for checking that mapping data + ! are within expected bounds + + !--- formats --- + character(*),parameter :: subName = '(gridmap_map_read) ' + character(*),parameter :: F00 = '("(gridmap_map_read) ",4a)' + character(*),parameter :: F01 = '("(gridmap_map_read) ",2(a,i7))' +!EOP +!------------------------------------------------------------------------------ + + !------------------------------------------------------------------------------- + ! + !------------------------------------------------------------------------------- + + write(6,F00) "reading mapping matrix data..." + + ! open & read the file + write(6,F00) "* file name : ",trim(fileName) + + rcode = nf_open(filename ,NF_NOWRITE, fid) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + !--- allocate memory & get matrix data ---------- + rcode = nf_inq_dimid (fid, 'n_s', did) ! size of sparse matrix + rcode = nf_inq_dimlen(fid, did , gridmap%ns) + rcode = nf_inq_dimid (fid, 'n_a', did) ! size of input vector + rcode = nf_inq_dimlen(fid, did , gridmap%na) + rcode = nf_inq_dimid (fid, 'n_b', did) ! size of output vector + rcode = nf_inq_dimlen(fid, did , gridmap%nb) + + write(6,*) "* matrix dimensions rows x cols :",gridmap%na,' x',gridmap%nb + write(6,*) "* number of non-zero elements: ",gridmap%ns + + ns = gridmap%ns + na = gridmap%na + nb = gridmap%nb + allocate(gridmap%wovr(ns) , & + gridmap%src_indx(ns), & + gridmap%dst_indx(ns), & + gridmap%mask_src(na), & + gridmap%area_src(na), & + gridmap%frac_src(na), & + gridmap%area_dst(nb), & + gridmap%frac_dst(nb), & + gridmap%mask_dst(nb), & + gridmap%xc_dst(nb), & + gridmap%yc_dst(nb), & + gridmap%xc_src(na), & + gridmap%yc_src(na), stat=rcode) + if (rcode /= 0) then + write(6,*) SubName//' ERROR: allocate gridmap' + call abort() + endif + + rcode = nf_inq_varid(fid,'S' ,vid) + rcode = nf_get_var_double(fid,vid ,gridmap%wovr) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'row',vid) + rcode = nf_get_var_int(fid, vid ,gridmap%dst_indx) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'col',vid) + rcode = nf_get_var_int(fid, vid, gridmap%src_indx) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'area_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%area_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'area_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%area_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + + rcode = nf_inq_varid(fid,'frac_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%frac_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%frac_src(:) < 0.0_r8 .or. gridmap%frac_src > (1.0_r8 + tol)) )then + write(6,*) SubName//' ERROR: frac_src out of bounds' + write(6,*) 'max = ', maxval(gridmap%frac_src), ' min = ', minval(gridmap%frac_src) + call abort() + end if + + rcode = nf_inq_varid(fid,'frac_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%frac_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%frac_dst(:) < 0.0_r8 .or. gridmap%frac_dst > (1.0_r8 + tol)) )then + write(6,*) SubName//' ERROR: frac_dst out of bounds' + write(6,*) 'max = ', maxval(gridmap%frac_dst), ' min = ', minval(gridmap%frac_dst) + call abort() + end if + + rcode = nf_inq_varid(fid,'mask_a',vid) + rcode = nf_get_var_int(fid, vid, gridmap%mask_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%mask_src(:) < 0 .or. gridmap%mask_src > 1) )then + write(6,*) SubName//' ERROR: mask_src out of bounds' + call abort() + end if + + rcode = nf_inq_varid(fid,'mask_b',vid) + rcode = nf_get_var_int(fid, vid, gridmap%mask_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + if ( any(gridmap%mask_dst(:) < 0 .or. gridmap%mask_dst > 1) )then + write(6,*) SubName//' ERROR: mask_dst out of bounds' + call abort() + end if + + rcode = nf_inq_varid(fid,'xc_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%xc_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'xc_a', gridmap%xc_src) + + rcode = nf_inq_varid(fid,'yc_a',vid) + rcode = nf_get_var_double(fid, vid, gridmap%yc_src) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'yc_a', gridmap%yc_src) + + rcode = nf_inq_varid(fid,'xc_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%xc_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'xc_b', gridmap%xc_dst) + + rcode = nf_inq_varid(fid,'yc_b',vid) + rcode = nf_get_var_double(fid, vid, gridmap%yc_dst) + if (rcode /= NF_NOERR) write(6,F00) nf_strerror(rcode) + call convert_latlon(fid, 'yc_b', gridmap%yc_dst) + + rcode = nf_close(fid) + + gridmap%set = IsSet + + end subroutine gridmap_mapread + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_check +! +! !INTERFACE: + subroutine gridmap_check(gridmap, caller) +! +! !DESCRIPTION: +! Check validity of a gridmap +! Aborts if there are any errors +! +! !USES: + use mkvarctl, only : mksrf_gridtype + use mkvarpar, only : re +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! mapping data + character(len=*) , intent(in) :: caller ! calling subroutine (used for error messages) +! +! !REVISION HISTORY: +! Created by Bill Sacks +! +! !LOCAL VARIABLES: + real(r8) :: sum_area_i ! global sum of input area + real(r8) :: sum_area_o ! global sum of output area + integer :: ni,no,ns_i,ns_o ! indices + + real(r8), parameter :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=*), parameter :: subname = 'gridmap_check' +!EOP +!------------------------------------------------------------------------------ + + ns_i = gridmap%na + ns_o = gridmap%nb + + ! ----------------------------------------------------------------- + ! Error check prep + ! Global sum of output area -- must multiply by fraction of + ! output grid that is land as determined by input grid + ! ----------------------------------------------------------------- + + sum_area_i = 0.0_r8 + do ni = 1,ns_i + sum_area_i = sum_area_i + gridmap%area_src(ni)*gridmap%frac_src(ni)*re**2 + enddo + + sum_area_o = 0. + do no = 1,ns_o + sum_area_o = sum_area_o + gridmap%area_dst(no)*gridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum_area_i to global sum_area_o. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global' ) then + if ( abs(sum_area_o/sum_area_i-1.) > relerr ) then + write (6,*) subname//' ERROR from '//trim(caller)//': mapping areas not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_area_o + write (6,'(a30,e20.10)') 'global sum input field = ',sum_area_i + stop + end if + end if + + end subroutine gridmap_check + + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_default +! +! !INTERFACE: + subroutine gridmap_areaave_default (gridmap, src_array, dst_array, nodata) +! +! !DESCRIPTION: +! This subroutine does a simple area average +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: nodata ! value to apply where there are no input data +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt,frac + real(r8), allocatable :: sum_weights(:) ! sum of weights on the output grid + character(*),parameter :: subName = '(gridmap_areaave_default) ' +!EOP +!------------------------------------------------------------------------------ + call gridmap_checkifset( gridmap, subname ) + allocate(sum_weights(size(dst_array))) + sum_weights = 0._r8 + dst_array = 0._r8 + + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + frac = gridmap%frac_dst(no) + if (frac > 0.) then + dst_array(no) = dst_array(no) + wt * src_array(ni)/frac + sum_weights(no) = sum_weights(no) + wt + end if + end do + + where (sum_weights == 0._r8) + dst_array = nodata + end where + + deallocate(sum_weights) + + end subroutine gridmap_areaave_default + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_srcmask +! +! !INTERFACE: + subroutine gridmap_areaave_srcmask (gridmap, src_array, dst_array, nodata, mask_src) +! +! !DESCRIPTION: +! This subroutine does an area average with the source mask +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: nodata ! value to apply where there are no input data + real(r8), intent(in) :: mask_src(:) +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt + real(r8), allocatable :: wtnorm(:) + character(*),parameter :: subName = '(gridmap_areaave_srcmask) ' +!EOP +!------------------------------------------------------------------------------ + call gridmap_checkifset( gridmap, subname ) + ns = size(dst_array) + allocate(wtnorm(ns)) + wtnorm(:) = 0._r8 + + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + wtnorm(no) = wtnorm(no) + wt*mask_src(ni) + end if + end do + + dst_array = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + dst_array(no) = dst_array(no) + wt*mask_src(ni)*src_array(ni)/wtnorm(no) + end if + end do + + where (wtnorm == 0._r8) + dst_array = nodata + end where + + deallocate(wtnorm) + + end subroutine gridmap_areaave_srcmask + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areaave_srcmask2 +! +! !INTERFACE: + subroutine gridmap_areaave_srcmask2 (gridmap, src_array, dst_array, nodata, mask_src, & + mask_dst, mask_dst_min) +! +! !DESCRIPTION: +! This subroutine does an area average with the source mask and making sure the +! destination mask is valid as well. +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: nodata ! value to apply where there are no input data + real(r8), intent(in) :: mask_src(:) + real(r8), intent(in) :: mask_dst(:) + real(r8), intent(in) :: mask_dst_min +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + integer :: n,ns,ni,no + real(r8):: wt + real(r8), allocatable :: wtnorm(:) + character(*),parameter :: subName = '(gridmap_areaave_srcmask2) ' +!EOP +!------------------------------------------------------------------------------ + + call gridmap_checkifset( gridmap, subname ) + ns = size(dst_array) + allocate(wtnorm(ns)) + wtnorm(:) = 0._r8 + + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_src(ni) > 0) then + wtnorm(no) = wtnorm(no) + wt*mask_src(ni) + end if + end do + + dst_array = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + if (mask_dst(no) > mask_dst_min) then + if (mask_src(ni) > 0) then + dst_array(no) = dst_array(no) + wt*mask_src(ni)*src_array(ni)/wtnorm(no) + end if + end if + end do + + where ((wtnorm == 0._r8) .or. (mask_dst <= mask_dst_min)) + dst_array = nodata + end where + + deallocate(wtnorm) + + end subroutine gridmap_areaave_srcmask2 + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_areastddev +! +! !INTERFACE: + subroutine gridmap_areastddev (gridmap, src_array, dst_array, nodata) +! +! !DESCRIPTION: +! Computes area-weighted standard deviation +! +! We use the definition of standard deviation that applies if you measure the full +! population (as opposed to the unbiased standard deviation that should be used when +! sampling a subset of the full population). (This is equivalent to using 1/N rather than +! 1/(N-1).) This makes sense if we assume that the underlying values are constant +! throughout each source grid cell -- in that case, we know the full population as long as +! we know the values in all source grid cells, which is generally the case. +! +! The formula is from +! (accessed 3-4-13). +! +! !ARGUMENTS: + implicit none + type(gridmap_type) , intent(in) :: gridmap ! gridmap data + real(r8), intent(in) :: src_array(:) + real(r8), intent(out):: dst_array(:) + real(r8), intent(in) :: nodata ! value to apply where there are no input data +! +! !REVISION HISTORY: +! Created by Bill Sacks +! +! !LOCAL VARIABLES: + integer :: n,ni,no + integer :: ns_o ! number of output points + real(r8):: wt ! weight of overlap + real(r8), allocatable :: weighted_means(:) ! weighted mean on the output grid + real(r8), allocatable :: sum_weights(:) ! sum of weights on the output grid + character(*),parameter :: subName = '(gridmap_areastddev) ' +!EOP +!------------------------------------------------------------------------------ + call gridmap_checkifset( gridmap, subname ) + + ns_o = size(dst_array) + allocate(weighted_means(ns_o)) + call gridmap_areaave(gridmap, src_array, weighted_means, nodata=0._r8) + + ! WJS (3-5-13): I believe that sum_weights should be the same as gridmap%frac_dst, + ! but I'm not positive of this, so we compute it explicitly to be safe + allocate(sum_weights(ns_o)) + sum_weights(:) = 0._r8 + dst_array(:) = 0._r8 + do n = 1,gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + ! The following accumulates the numerator of the weighted sigma-squared + dst_array(no) = dst_array(no) + wt * (src_array(ni) - weighted_means(no))**2 + sum_weights(no) = sum_weights(no) + wt + end do + + do no = 1,ns_o + if (sum_weights(no) > 0._r8) then + dst_array(no) = sqrt(dst_array(no)/sum_weights(no)) + else + dst_array(no) = nodata + end if + end do + + deallocate(weighted_means, sum_weights) + + end subroutine gridmap_areastddev + +!========================================================================== + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: gridmap_clean +! +! !INTERFACE: + subroutine gridmap_clean(gridmap) +! +! !DESCRIPTION: +! This subroutine deallocates the gridmap type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(inout) :: gridmap +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subName = "gridmap_clean" + integer ier ! error flag +!EOP +!------------------------------------------------------------------------------ + if ( gridmap%set .eq. IsSet )then + deallocate(gridmap%wovr , & + gridmap%src_indx, & + gridmap%dst_indx, & + gridmap%mask_src, & + gridmap%mask_dst, & + gridmap%area_src, & + gridmap%area_dst, & + gridmap%frac_src, & + gridmap%frac_dst, & + gridmap%xc_src, & + gridmap%yc_src, stat=ier) + if (ier /= 0) then + write(6,*) SubName//' ERROR: deallocate gridmap' + call abort() + endif + else + write(6,*) SubName//' Warning: calling '//trim(subName)//' on unallocated gridmap' + end if + gridmap%set = "NOT-set" + + end subroutine gridmap_clean + +!========================================================================== + + subroutine gridmap_checkifset( gridmap, subname ) + + implicit none + type(gridmap_type), intent(in) :: gridmap + character(len=*), intent(in) :: subname + + if ( gridmap%set .ne. IsSet )then + write(6,*) SubName//' ERROR: gridmap NOT set yet, run gridmap_mapread first' + call abort() + end if + end subroutine gridmap_checkifset + +end module mkgridmapMod + + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 new file mode 100644 index 0000000000..02b5e4669b --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkharvestMod.F90 @@ -0,0 +1,458 @@ +module mkharvestMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkharvest +! +! !DESCRIPTION: +! Make harvest and grazing data to add to the dynamic PFT file. +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_CL + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkharvest_init ! Initialization + public mkharvest ! Calculate the harvest values on output grid + public mkharvest_fieldname ! Field name + public mkharvest_longname ! Long name + public mkharvest_numtypes ! Number of harvest types + public mkharvest_parse_oride ! Parse the over-ride string + +! !PRIVATE DATA MEMBERS: + + integer, parameter :: numharv = 6 ! number of harvest and grazing fields + integer, parameter :: harlen = 12 ! length of strings for harvest fieldnames + character(len=harlen), parameter :: harvest_fieldnames(numharv) = (/ & + 'HARVEST_VH1', & + 'HARVEST_VH2', & + 'HARVEST_SH1', & + 'HARVEST_SH2', & + 'HARVEST_SH3', & + 'GRAZING ' & + /) + character(len=CL), parameter :: string_undef = 'STRING_UNDEFINED' + real(r8), parameter :: real_undef = -999.99 + character(len=CL), save :: harvest_longnames(numharv) = string_undef + real(r8), pointer :: oride_harv(:) ! array that can override harvesting + + +!EOP +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_init +! +! !INTERFACE: + subroutine mkharvest_init( ns_o, init_val, harvest, fharvest ) +! +! !DESCRIPTION: +! Initialization of mkharvest module. +! +! !USES: + use mkncdio + implicit none +! +! !ARGUMENTS: + integer , intent(in) :: ns_o ! clm output grid resolution + real(r8) , intent(in) :: init_val ! initial value to set to + real(r8) , pointer :: harvest(:,:) ! output grid: normalized harvesting + character(len=*), intent(in) :: fharvest ! input harvest dataset file name +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_init' + integer :: ncid,varid ! input netCDF id's + integer :: ifld ! indices +!EOP +!----------------------------------------------------------------------- + + allocate(harvest(ns_o,numharv)) + harvest(:,:) = init_val + + call check_ret(nf_open(fharvest, 0, ncid), subname) + do ifld = 1, numharv + call check_ret(nf_inq_varid ( ncid, mkharvest_fieldname(ifld), varid), subname) + call check_ret(nf_get_att_text( ncid, varid, 'long_name', harvest_longnames(ifld)), subname) + end do + + call check_ret(nf_close(ncid), subname) + + allocate( oride_harv(numharv) ) + oride_harv(:) = real_undef + + end subroutine mkharvest_init + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_fieldname +! +! !INTERFACE: + character(len=harlen) function mkharvest_fieldname( nfield ) +! +! !DESCRIPTION: +! Return harvest fieldname of input field number. +! +! !USES: + implicit none +! +! !ARGUMENTS: + integer, intent(in) :: nfield +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_fieldname' +!EOP +!----------------------------------------------------------------------- + + if ( nfield < 1 )then + write(6,*) subname, ' error nfield < 1' + call abort() + else if ( nfield > numharv )then + write(6,*) subname, ' error nfield > max fields' + call abort() + else + mkharvest_fieldname = harvest_fieldnames(nfield) + end if + + end function mkharvest_fieldname + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_longname +! +! !INTERFACE: + character(len=CL) function mkharvest_longname( nfield ) +! +! !DESCRIPTION: +! Return longname description of given input field number. +! +! !USES: + implicit none +! +! !ARGUMENTS: + integer, intent(in) :: nfield +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'mkharvest_longname' +!EOP +!----------------------------------------------------------------------- + + if ( nfield < 1 )then + write(6,*) subname, ' error nfield < 1' + call abort() + else if ( nfield > numharv )then + write(6,*) subname, ' error nfield > max fields' + call abort() + else + if ( trim(harvest_longnames(nfield)) .eq. trim(string_undef) )then + write(6,*) subname, ' error harvest_longnames not set yet' + call abort() + end if + mkharvest_longname = harvest_longnames(nfield) + end if + + end function mkharvest_longname + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_numtypes +! +! !INTERFACE: + integer function mkharvest_numtypes( ) +! +! !DESCRIPTION: +! Return number of different harvest field types. +! +! !USES: + implicit none +! +! !ARGUMENTS: + character(len=*), parameter :: subname = 'mkharvest_numtypes' +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP +!----------------------------------------------------------------------- + mkharvest_numtypes = numharv + + end function mkharvest_numtypes + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest +! +! !INTERFACE: +subroutine mkharvest(ldomain, mapfname, datfname, ndiag, harv_o) +! +! !DESCRIPTION: +! Make harvest data for the dynamic PFT dataset. +! This dataset consists of the normalized harvest or grazing fraction (0-1) of +! the model. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: harv_o(:,:) ! output grid: normalized harvesting +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: harv_i(:,:) ! input grid: harvest/grazing percent + real(r8), allocatable :: pctlnd_o(:) ! output grid: percent land + real(r8) :: gharv_o(numharv) ! output grid: global area harvesting + real(r8) :: garea_o ! output grid: global area + real(r8) :: gharv_i(numharv) ! input grid: global area harvesting + real(r8) :: garea_i ! input grid: global area + integer :: ifld ! indices + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + character(len=*), parameter :: unit = '10**6 km**2' ! Output units + real(r8), parameter :: fac = 1.e-06_r8 ! Output factor + real(r8), parameter :: rat = fac/100._r8 ! Output factor divided by 100% + character(len=*), parameter :: subname = 'mkharvest' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make harvest fields .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Normally read in the harvesting file, and then regrid to output grid + ! ----------------------------------------------------------------- + + if ( all(oride_harv == real_undef ) )then + + ! ----------------------------------------------------------------- + ! Read input harvesting file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read HARVEST_VH1, HARVEST_VH2, ... GRAZING etc. + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(harv_i(ns_i,1:numharv), stat=ier) + if (ier/=0) call abort() + ns_o = ldomain%ns + + write (6,*) 'Open harvest file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + do ifld = 1, numharv + call check_ret(nf_inq_varid(ncid, mkharvest_fieldname(ifld), varid), subname) + call check_ret(nf_get_var_double (ncid, varid, harv_i(:,ifld)), subname) + end do + call check_ret(nf_close(ncid), subname) + + ! Area-average normalized harvest on input grid [harv_i] to output grid [harv_o] + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine harv_o on output grid + + do ifld = 1,numharv + call gridmap_areaave(tgridmap, harv_i(:,ifld), harv_o(:,ifld), nodata=0._r8) + end do + + ! ----------------------------------------------------------------- + ! Error check + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + gharv_i(:) = 0. + garea_i = 0. + do ni = 1, ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + do m = 1, numharv + gharv_i(m) = gharv_i(m) + harv_i(ni,m)*tgridmap%area_src(ni)* & + tgridmap%frac_src(ni)*re**2 + end do + end do + + gharv_o(:) = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + do m = 1, numharv + gharv_o(m) = gharv_o(m) + harv_o(no,m)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Write out to diagnostic output file + ! + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Harvesting Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) unit, unit +1001 format (1x,'harvest type ',20x,' input grid area',' output grid area',/ & + 1x,33x,' ',A,' ',A) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do m = 1, numharv + write (ndiag,1002) mkharvest_fieldname(m), gharv_i(m)*rat,gharv_o(m)*rat + end do +1002 format (1x,a35,f16.3,f17.3) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (harv_i) + + else + + ! ----------------------------------------------------------------- + ! Otherwise override the harvesting with the input harvest values + ! ----------------------------------------------------------------- + + if ( any(oride_harv == real_undef ) )then + write(6,*) subname, ' error some override harvesting fields set ', & + 'and others are not = ', oride_harv + call abort() + end if + do m = 1, numharv + if ( oride_harv(m) < 0.0_r8 .or. oride_harv(m) > 100.0_r8 )then + write(6,*) subname, ' error override harvesting field out of range', & + oride_harv(m), ' field = ', mkharvest_fieldname(m) + call abort() + end if + end do + do no = 1,ns_o + do m = 1, numharv + harv_o(no,m) = oride_harv(m) + end do + end do + + end if + + write (6,*) 'Successfully made harvest and grazing' + write (6,*) + +end subroutine mkharvest + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkharvest_parse_oride +! +! !INTERFACE: +subroutine mkharvest_parse_oride( string ) +! +! !DESCRIPTION: +! Parse the string with harvest and grazing information on it, to override +! the file with this information rather than reading from a file. +! +! !USES: + use shr_string_mod, only: shr_string_betweenTags +! !ARGUMENTS: + character(len=256), intent(IN) :: string ! String to parse with harvest and grazing data +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: rc ! error return code + character(len=256) :: substring ! substring between tags + character(len=*), parameter :: harv_start = "" + character(len=*), parameter :: harv_end = "" + character(len=*), parameter :: graz_start = "" + character(len=*), parameter :: graz_end = "" + character(len=*), parameter :: subname = 'mkharvest_parse_oride' +!----------------------------------------------------------------------- + call shr_string_betweenTags( string, harv_start, harv_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding harvest start end tags' + call abort() + end if + read(substring,*) oride_harv(1:numharv-1) + call shr_string_betweenTags( string, graz_start, graz_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding grazing start end tags' + call abort() + end if + read(substring,*) oride_harv(numharv) + if ( harvest_fieldnames(numharv) /= 'GRAZING' )then + write(6,*) subname, ' grazing is NOT last field as was expected' + call abort() + end if + +!----------------------------------------------------------------------- + +end subroutine mkharvest_parse_oride + +!----------------------------------------------------------------------- + +end module mkharvestMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkindexmapMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkindexmapMod.F90 new file mode 100644 index 0000000000..28ed621110 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkindexmapMod.F90 @@ -0,0 +1,697 @@ +module mkindexmapMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkindexmapMod +! +! !DESCRIPTION: +! Module containing subroutines for making maps of index data. +! +! This includes a routine for making a map using the dominant type among the input grid +! cells making up a given output cell, as well as routines for using an index map as +! indices into a lookup table, to essentially paint-by-number some other field, and some +! other related routines +! +! WJS (2-1-12): There is a lookup_2d subroutine, but not a lookup_1d (or any other +! dimensionality). That is simply because I needed lookup_2d, but have not yet needed a +! routine of other dimensionalities. In the future, it would probably be helpful to at +! least have lookup_1d and lookup_1d_netcdf. If this is done, see my notes under the +! lookup_2d_netcdf routine for some thoughts on avoiding duplication. +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkncdio, only : nf_max_name + + implicit none + private + +! !PUBLIC TYPES: +! + ! dim_slice_type: stores information about dimensions that we use for slicing a multi- + ! dimensional variable + type dim_slice_type + character(len=nf_max_name) :: name ! name of this dimension + integer :: val ! index to use for the slice + end type dim_slice_type + public :: dim_slice_type +! +! !PUBLIC MEMBER FUNCTIONS: + public :: get_dominant_indices ! make output map based on dominant type in each grid cell + public :: filter_same ! build a filter of overlaps where src_val == dst_val + public :: lookup_2d ! create map based on a 2-d lookup table + public :: lookup_2d_netcdf ! wrapper to lookup_2d; first read table from netcdf file + public :: which_max ! get index of the maximum value in an array +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: get_dominant_indices +! +! !INTERFACE: +subroutine get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter) +! +! !DESCRIPTION: +! Fills an output array on the destination grid (dst_array) whose values are equal to the +! (weighted) dominant value in the source grid cells overlapping a given destination grid +! cell +! +! Ignores all values in src_array that are less than minval or greater than maxval (treats +! those values the same as if they had wt=0). (Note: for memory-use efficiency, it is +! best if the indices are designed such that most values between minval and maxval are +! actually used, since an array is allocated of size (maxval - minval + 1)*gridmap%nb.) +! +! The filter argument can be used to exclude certain overlaps -- if provided, we only +! consider overlaps where filter is .true. If not provided, filter is treated as being +! .true. everywhere. +! +! Output grid cells with no contributing valid source points are given the nodata value +! +! !USES: + use mkgridmapMod, only : gridmap_type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! provides mapping from src -> dst + integer , intent(in) :: src_array(:) ! input values; length gridmap%na + integer , intent(out):: dst_array(:) ! output values; length gridmap%nb + integer , intent(in) :: minval ! minimum valid value in src_array + integer , intent(in) :: maxval ! maximum valid value in src_array + integer , intent(in) :: nodata ! value to assign to dst_array where there are no valid source points + + logical, intent(in), optional :: filter(:) ! only consider overlaps where filter is .true.; length gridmap%ns +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + logical, allocatable :: lfilter(:) ! local version of filter + logical, allocatable :: hasdata(:) ! true if an output cell has any valid data; + real(r8), allocatable :: weights(:,:) ! summed weight of each index value for each output cell + + integer :: n, ni, no + integer :: k + integer :: maxindex + real(r8) :: wt + real(r8) :: maxwt + + character(len=*), parameter :: subname = "get_dominant_indices" +!----------------------------------------------------------------------- + + ! Error-check inputs and initialize local variables + + if (size(src_array) /= gridmap%na .or. & + size(dst_array) /= gridmap%nb) then + write(6,*) subname//' ERROR: incorrect sizes of src_array or dst_array' + write(6,*) 'size(src_array) = ', size(src_array) + write(6,*) 'gridmap%na = ', gridmap%na + write(6,*) 'size(dst_array) = ', size(dst_array) + write(6,*) 'gridmap%nb = ', gridmap%nb + call abort() + end if + + allocate(lfilter(gridmap%ns)) + + if (present(filter)) then + if (size(filter) /= gridmap%ns) then + write(6,*) subname//' ERROR: incorrect size of filter' + write(6,*) 'size(filter) = ', size(filter) + write(6,*) 'gridmap%ns = ', gridmap%ns + call abort() + end if + + lfilter(:) = filter(:) + else + lfilter(:) = .true. + end if + + allocate(hasdata(gridmap%nb)) + hasdata(:) = .false. + allocate(weights(minval:maxval, gridmap%nb)) + weights(minval:maxval,:) = 0. + + ! Determine weight of each index value for each output (destination) cell + + do n = 1, gridmap%ns + if (lfilter(n)) then + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + wt = gridmap%wovr(n) + k = src_array(ni) + if (k >= minval .and. k <= maxval) then + ! Note: if we were doing something like weighted sums, I think we would + ! want to divide wt by gridmap%frac_dst(no), as is done in + ! gridmap_areaave_default. But since all we care about is the relative + ! values of weights for a given destination cell, this is unnecessary + weights(k,no) = weights(k,no) + wt + hasdata(no) = .true. + end if + end if + end do + + ! Determine output values + ! Note: if a given destination cell has no contributing source points (thus + ! hasdata(no) = false), or the max weight of any index overlapping this destination + ! cell is <= 0, then the output value there will be nodata. + ! (I don't think this latter condition -- weight <= 0 -- is possible, but we handle + ! it anyway) + + dst_array(:) = nodata + do no = 1, gridmap%nb + if (hasdata(no)) then + call which_max(weights(:,no), maxwt, maxindex, lbound=minval) + if (maxwt > 0.) then + dst_array(no) = maxindex + end if + end if + end do + + deallocate(lfilter, weights, hasdata) + +end subroutine get_dominant_indices +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: filter_same +! +! !INTERFACE: +subroutine filter_same(gridmap, filter, src_array, dst_array, nodata) +! +! !DESCRIPTION: +! Creates a filter of overlaps where src_array == dst_array. +! +! More specifically: given a src_array (of size gridmap%na) and an already-created +! dst_array (of size gridmap%nb): +! +! Creates a logical filter array, of size gridmap%ns (i.e., number of overlaps), +! according to the following rules: +! (1) anywhere where filter was already .false., it will remain .false. +! (2) if nodata is present: for any overlap where the value in dst_array is nodata, +! filter will be .false. +! (3) for any overlap where the value in the given src_array differs from the value +! in the given dst_array, filter will be .false. +! (4) anywhere else, filter will be .true. +! +! !USES: + use mkgridmapMod, only : gridmap_type +! +! !ARGUMENTS: + implicit none + type(gridmap_type), intent(in) :: gridmap ! provides mapping from src -> dst + logical , intent(inout):: filter(:) ! length gridmap%ns + integer , intent(in) :: src_array(:) ! length gridmap%na + integer , intent(in) :: dst_array(:) ! length gridmap%nb + + integer, intent(in), optional :: nodata ! wherever dst_array == nodata, filter will be false +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n, ni, no + + character(len=*), parameter :: subname = "make_filter" +!----------------------------------------------------------------------- + + ! Error check inputs + + if (size(filter) /= gridmap%ns .or. & + size(src_array) /= gridmap%na .or. & + size(dst_array) /= gridmap%nb) then + write(6,*) subname//' ERROR: incorrect array sizes' + write(6,*) 'size(src_array) = ', size(src_array) + write(6,*) 'gridmap%na = ', gridmap%na + write(6,*) 'size(dst_array) = ', size(dst_array) + write(6,*) 'gridmap%nb = ', gridmap%nb + write(6,*) 'size(filter) = ', size(filter) + write(6,*) 'gridmap%ns = ', gridmap%ns + call abort() + end if + + ! Create the filter + + do n = 1, gridmap%ns + ni = gridmap%src_indx(n) + no = gridmap%dst_indx(n) + + if (present(nodata)) then + if (dst_array(no) == nodata) then + filter(n) = .false. + end if + end if + + if (dst_array(no) /= src_array(ni)) then + filter(n) = .false. + end if + end do + +end subroutine filter_same +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: lookup_2d +! +! !INTERFACE: +subroutine lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, & + nodata, valid_entries, invalid_okay) +! +! !DESCRIPTION: +! Creates a data array using a paint-by-number approach according to a lookup table +! +! This routine operates on a 2-d lookup table. There are therefore two index arrays +! (index1 and index2); these index arrays are on the same grid as the desired data array +! (thus, index1, index2 and data must all have the same length). Each output point, n, is +! then generally determined as: +! +! data(n) = lookup_table(index1(n), index2(n)) +! +! fill_val: value to put in data array where either: +! (a) index1 or index2 are equal to nodata (if nodata is given) +! Note that this condition does NOT result in ierr being set +! (b) valid_entries(index1(n), index2(n)) is false (if valid_entries is given) +! Note that this condition also results in ierr being set, unless invalid_okay is +! present and .true. +! (If valid_entries is not given, it is treated as being .true. everywhere) +! (c) index1 or index2 out of range +! Note that this condition also results in ierr being set +! +! ierr: error return code (if non-0, indicates first error encountered): +! 0: no error +! 1: attempt to assign values from the lookup table that are invalid according +! to valid_entries (note: this is not considered an error if invalid_okay is +! present and .true.) +! 2: attempt to access an out-of-range index in lookup table +! WJS (2-2-12): My main reason for using ierr rather than aborting in case of error +! is to facilitate unit testing +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: index1(:) ! index into dim 1 of lookup_table + integer , intent(in) :: index2(:) ! index into dim 2 of lookup_table + real(r8), intent(in) :: lookup_table(:,:) + real(r8), intent(in) :: fill_val ! value to put in data where we don't have a valid value (see above for details) + real(r8), intent(out):: data(:) ! output arary + integer , intent(out):: ierr ! error return code (0 = no error) + + ! nodata flag in index1 and index2 (see above for details): + integer, intent(in), optional :: nodata + + ! which entries are considered valid (see above for details): + logical, intent(in), optional :: valid_entries(:,:) + + ! invalid_okay: if true, then assigning fill_val because valid_entries is false does + ! NOT raise an error flag (invalid_okay defaults to false, meaning an error is + ! raised in this case): + logical, intent(in), optional :: invalid_okay +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n + integer :: i1, i2 + integer :: data_size ! size of index1, index2 and data arrays + integer :: table_n1 ! size of dimension 1 of lookup table + integer :: table_n2 ! size of dimension 2 of lookup table + logical :: linvalid_okay ! local version of invalid_okay + logical, allocatable :: lvalid_entries(:,:) ! local version of valid_entries + + character(len=*), parameter :: subname = 'lookup_2d' +!----------------------------------------------------------------------- + + ierr = 0 + + ! Error-check array sizes + + data_size = size(data) + if (size(index1) /= data_size .or. size(index2) /= data_size) then + write(6,*) subname//' ERROR: data array sizes do not match' + write(6,*) 'size(data) = ', data_size + write(6,*) 'size(index1) = ', size(index1) + write(6,*) 'size(index2) = ', size(index2) + call abort() + end if + + table_n1 = size(lookup_table,1) + table_n2 = size(lookup_table,2) + if (present(valid_entries)) then + if (size(valid_entries,1) /= table_n1 .or. size(valid_entries,2) /= table_n2) then + write(6,*) subname//' ERROR: size of valid_entries does not match lookup_table' + write(6,*) 'size(lookup_table) = ', table_n1, table_n2 + write(6,*) 'size(valid_entries) = ', size(valid_entries,1), & + size(valid_entries,2) + call abort() + end if + end if + + ! Set local version of invalid_okay & valid_entries + + if (present(invalid_okay)) then + linvalid_okay = invalid_okay + else + linvalid_okay = .false. + end if + + allocate(lvalid_entries(table_n1, table_n2)) + if (present(valid_entries)) then + lvalid_entries(:,:) = valid_entries(:,:) + else + lvalid_entries(:,:) = .true. + end if + + ! Do the lookups + + do n = 1, data_size + i1 = index1(n) + i2 = index2(n) + + ! First handle special cases: + + ! index is nodata flag (this is NOT an error) + if (present(nodata)) then + if (i1 == nodata .or. i2 == nodata) then + data(n) = fill_val + cycle + end if + end if + + ! index out of range + if (i1 <= 0 .or. i1 > table_n1 .or. & + i2 <= 0 .or. i2 > table_n2) then + data(n) = fill_val + if (ierr == 0) ierr = 2 + cycle + end if + + ! lookup table entry is invalid + if (.not. lvalid_entries(i1, i2)) then + data(n) = fill_val + if (.not. linvalid_okay) then + if (ierr == 0) ierr = 1 + end if + cycle + end if + + ! Finally, the "normal" case, if none of the special cases were triggered: + data(n) = lookup_table(i1, i2) + end do + + deallocate(lvalid_entries) + +end subroutine lookup_2d +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: lookup_2d_netcdf +! +! !INTERFACE: +subroutine lookup_2d_netcdf(ncid, tablename, lookup_has_invalid, & + dimname1, dimname2, n_extra_dims, & + index1, index2, fill_val, data, ierr, & + extra_dims, nodata, invalid_okay) +! +! !DESCRIPTION: +! Wrapper to lookup_2d that first reads the lookup table from a netcdf file +! +! If lookup_has_invalid is false, then we treat all lookup table entries as valid data +! (i.e., all valid_entries are true in the call to lookup_2d). If lookup_has_invalid is +! true, then we read the _FillValue attribute for the lookup table variable, and consider +! any table entry with value _FillValue to be an invalid entry, thus putting fill_val in +! these data locations (and raising an error flag unless invalid_okay is present and +! true). +! +! The dimension given by dimname1 -- with the associated indices given by index1 -- is the +! fastest-varying dimension in the lookup table. Dimension dimname2 (associated with +! index2) is the second-fastest-varying dimension. Similarly, extra_dims should be ordered +! from faster-varying to slowest-varying dimension. (The first dimension in extra_dims is +! the third-fastest-varying dimension in the lookup table.) +! +! n_extra_dims gives the number of extra dimensions (in addition to the first two) in the +! lookup table. We take a single 2-d slice of the lookup table, by using a single value of +! each of these other dimensions. If n_extra_dims > 0, then extra_dims must be present, +! with at least n_extra_dims entries. Each entry in extra_dims gives the name of a +! dimension and the dimension index to use for the slice. +! +! If size(extra_dims) > n_extra_dims, then we use the first n_extra_dims entries in +! extra_dims. If n_extra_dims = 0, then extra_dims is ignored. +! +! Note that we ignore any coordinate variables associated with the dimensions of the +! lookup table; we simply treat the lookup table indices as 1,2,3,... +! +! See the lookup_2d documentation for documentation of some other arguments +! +! WJS (2-1-12): Some thoughts on avoiding duplication if we eventually want similar +! routines, lookup_1d_netcdf, lookup_3d_netcdf, etc.: +! +! Much of the code in lookup_2d_netcdf could then be pulled out to a shared subroutine +! (e.g., much of the error-checking code). +! +! Or, maybe better: we could try to make a single lookup_netcdf subroutine that handles +! 1-d, 2-d and any other dimensionality. To do that, we would (1) make a generic interface +! (of which lookup_1d and lookup_2d would be implementations); (2) change the repeated +! arguments in lookup_2d_netcdf (*1 and *2) to arrays -- maybe using an array of a derived +! type containing these arguments; (3) if possible, initially read the lookup table into a +! 1-d array (if the netcdf call allows reading a n-d array into a 1-d array) (if netcdf +! doesn't allow this, then I think we could achieve the same thing by reading 1-d slices +! of the lookup table in a loop, building the full lookup table as a long 1-d array); (4) +! in the call to the generic 'lookup' function, reshape the 1-d lookup table +! appropriately. (Note: I think it would be challenging to combine lookup_1d and lookup_2d +! (etc.) into a single routine using a similar method.) +! +! !USES: + use mkncdio +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! ID of an open netcdf file + character(len=*), intent(in) :: tablename ! name of the lookup table variable + logical , intent(in) :: lookup_has_invalid ! should we use _FillValue? (see above) + character(len=*), intent(in) :: dimname1 ! name of the first (fastest-varying) dimension of the lookup table + character(len=*), intent(in) :: dimname2 ! name of the second dimension of the lookup table + integer , intent(in) :: n_extra_dims ! number of extra dimensions in the lookup table + ! The following arguments are passed directly to lookup_2d: + integer , intent(in) :: index1(:) ! index into dim 1 of lookup table + integer , intent(in) :: index2(:) ! index into dim 2 of lookup table + real(r8) , intent(in) :: fill_val ! value to put in data where we don't have a valid value + real(r8) , intent(out):: data(:) ! output array + integer , intent(out):: ierr ! error return code from the call to lookup_2d + + ! slice to use if lookup table variable has more than 2 dimensions: + type(dim_slice_type), intent(in), optional :: extra_dims(:) + + ! nodata flag in index1 and index2, passed directly to lookup_2d: + integer , intent(in), optional :: nodata + + ! flag for whether trying to use a lookup table value that is equal to the _FillValue + ! should raise an error flag + ! (irrelevant if lookup_has_invalid is .false.) + ! (passed directly to lookup_2d - see the documentation there for more details) + logical , intent(in), optional :: invalid_okay +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: varid ! netcdf variable id of the lookup table + integer :: ndims ! total number of dimensions of lookup table + integer :: ndims_expected ! value we expect for ndims, for error checking + integer :: i + real(r8) :: table_fillval ! value of the _FillValue attribute for the lookup table + character(len=nf_max_name), allocatable :: dimnames(:) ! dimension names + integer , allocatable :: dimids(:) ! dimension ids + integer , allocatable :: dimlens(:) ! dimension lengths + integer , allocatable :: starts(:) ! starting indices for reading lookup table + integer , allocatable :: counts(:) ! dimension counts for reading lookup table + real(r8), allocatable :: lookup_table(:,:) + logical , allocatable :: valid_entries(:,:) ! which entries of the lookup table are considered valid + + character(len=*), parameter :: subname = 'lookup_2d_netcdf' +!----------------------------------------------------------------------- + + ! Error-check extra_dims + + if (n_extra_dims > 0) then + if (.not. present(extra_dims)) then + write(6,*) subname//' ERROR: extra_dims must be present for n_extra_dims > 0' + call abort() + end if + + if (size(extra_dims) < n_extra_dims) then + write(6,*) subname//' ERROR: not enough extra dimensions given' + write(6,*) 'n_extra_dims = ', n_extra_dims + write(6,*) 'size(extra_dims) = ', size(extra_dims) + call abort() + end if + end if + + ! Determine number of expected dimensions in the table, and actual number of + ! dimensions in the netcdf file + + ndims_expected = 2 + n_extra_dims + + call check_ret(nf_inq_varid (ncid, tablename, varid), subname) + call check_ret(nf_inq_varndims (ncid, varid, ndims), subname) + if (ndims /= ndims_expected) then + write(6,*) subname//' ERROR: unexpected number of dimensions in ', & + trim(tablename) + write(6,*) 'ndims = ', ndims + write(6,*) 'expected (based on n_extra_dims): ', ndims_expected + call abort() + end if + + ! Get dimension names & sizes, and error-check them + + allocate(dimids(ndims), dimlens(ndims), dimnames(ndims)) + call check_ret(nf_inq_vardimid (ncid, varid, dimids), subname) + do i = 1, ndims + call check_ret(nf_inq_dimname (ncid, dimids(i), dimnames(i)), subname) + call check_ret(nf_inq_dimlen (ncid, dimids(i), dimlens(i)), subname) + end do + + call check_dimname(dimnames(1), dimname1, 1) + call check_dimname(dimnames(2), dimname2, 2) + do i = 1, n_extra_dims + call check_dimname(dimnames(2+i), extra_dims(i)%name, 2+i) + call check_dimsize(dimlens(2+i), extra_dims(i)%val, 2+i) + end do + + ! Read the lookup table; if the given variable has more than 2 dimensions, we read + ! a single 2-d slice + + allocate(starts(ndims), counts(ndims)) + allocate(lookup_table(dimlens(1), dimlens(2))) + starts(1:2) = 1 + counts(1:2) = dimlens(1:2) + do i = 1, n_extra_dims + starts(2+i) = extra_dims(i)%val + counts(2+i) = 1 + end do + call check_ret(nf_get_vara_double (ncid, varid, starts, counts, lookup_table), subname) + + ! Determine which entries are valid + + allocate(valid_entries(size(lookup_table, 1), size(lookup_table, 2))) + valid_entries(:,:) = .true. + if (lookup_has_invalid) then + call check_ret(nf_get_att_double (ncid, varid, '_FillValue', table_fillval), subname) + where (lookup_table == table_fillval) + valid_entries = .false. + end where + end if + + ! Do the lookups + + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, nodata=nodata, & + valid_entries=valid_entries, invalid_okay=invalid_okay) + + deallocate(valid_entries) + deallocate(lookup_table) + deallocate(starts, counts) + deallocate(dimids, dimlens, dimnames) + +contains +!------------------------------------------------------------------------------ + subroutine check_dimname(actual, expected, i) + ! Make sure names are equal; if not, stop with an error message + + character(len=*), intent(in) :: actual, expected + integer , intent(in) :: i ! dimension number, for output purposes + + if (actual /= expected) then + write(6,*) subname//' ERROR: unexpected dimension name in ', trim(tablename) + write(6,*) 'dimension #', i + write(6,*) 'actual: ', trim(actual) + write(6,*) 'expected: ', trim(expected) + call abort() + end if + end subroutine check_dimname + +!------------------------------------------------------------------------------ + subroutine check_dimsize(length, index, i) + ! Make sure dimension length is long enough; if not, stop with an error message + + integer, intent(in) :: length, index + integer, intent(in) :: i ! dimension number, for output purposes + + if (index > length) then + write(6,*) subname//' ERROR: desired index exceeds dimension length in ', & + trim(tablename) + write(6,*) 'dimension #', i + write(6,*) 'index: ', index + write(6,*) 'length: ', length + call abort() + end if + end subroutine check_dimsize + +end subroutine lookup_2d_netcdf +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: which_max +! +! !INTERFACE: +subroutine which_max(arr, maxval, maxindex, lbound) +! +! !DESCRIPTION: +! Returns maximum value in arr along with the index of the maximum value +! +! If multiple values are tied, returns index of the first maximum +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: arr(:) + real(r8), intent(out):: maxval ! maximum value in arr(:) + integer , intent(out):: maxindex ! first index of maxval + + ! lower bound of indices of arr; if not supplied, assumed to be 1: + integer , intent(in), optional :: lbound +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i +!----------------------------------------------------------------------- + + maxindex = 1 + maxval = arr(1) + + do i = 2, size(arr) + if (arr(i) > maxval) then + maxindex = i + maxval = arr(i) + end if + end do + + if (present(lbound)) then + maxindex = maxindex + (lbound - 1) + end if +end subroutine which_max +!------------------------------------------------------------------------------ + +end module mkindexmapMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 new file mode 100644 index 0000000000..22a34bff75 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mklaiMod.F90 @@ -0,0 +1,444 @@ +module mklaiMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mklai +! +! !DESCRIPTION: +! Make LAI/SAI/height data +! +! !REVISION HISTORY: +! Author: Sam Levis +! +!EOP +!----------------------------------------------------------------------- + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + use mkvarctl + + implicit none + + private + + public :: mklai + private :: pft_laicheck + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mklai +! +! !INTERFACE: +subroutine mklai(ldomain, mapfname, datfname, ndiag, ncido) +! +! !DESCRIPTION: +! Make LAI/SAI/height data +! Portions of this code could be moved out of the month loop +! for improved efficiency +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar , only : re + use mkvarctl + use mkncdio + use mkpftConstantsMod, only : c3cropindex, c3irrcropindex +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + integer , intent(in) :: ncido ! output netcdf file id +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + integer :: numpft_i ! number of plant types on input + real(r8) :: glai_o(0:numpft) ! output grid: global area pfts + real(r8) :: gsai_o(0:numpft) ! output grid: global area pfts + real(r8) :: ghgtt_o(0:numpft) ! output grid: global area pfts + real(r8) :: ghgtb_o(0:numpft) ! output grid: global area pfts + real(r8) :: glai_i(0:numpft) ! input grid: global area pfts + real(r8) :: gsai_i(0:numpft) ! input grid: global area pfts + real(r8) :: ghgtt_i(0:numpft) ! input grid: global area pfts + real(r8) :: ghgtb_i(0:numpft) ! input grid: global area pfts + + real(r8), allocatable :: mlai_o(:,:) ! monthly lai + real(r8), allocatable :: msai_o(:,:) ! monthly sai + real(r8), allocatable :: mhgtt_o(:,:) ! monthly height (top) + real(r8), allocatable :: mhgtb_o(:,:) ! monthly height (bottom) + real(r8), allocatable :: mlai_max(:,:) ! monthly lai + real(r8), allocatable :: msai_max(:,:) ! monthly sai + real(r8), allocatable :: mhgtt_max(:,:) ! monthly height (top) + real(r8), allocatable :: mhgtb_max(:,:) ! monthly height (bottom) + real(r8), allocatable :: mlai_i(:,:) ! monthly lai in + real(r8), allocatable :: msai_i(:,:) ! monthly sai in + real(r8), allocatable :: mhgtt_i(:,:) ! monthly height (top) in + real(r8), allocatable :: mhgtb_i(:,:) ! monthly height (bottom) in + real(r8), allocatable :: mask_src(:) ! input grid: mask (0, 1) + integer, pointer :: laimask(:,:) ! lai+sai output mask for each plant function type + real(r8) :: garea_i ! input grid: global area + real(r8) :: garea_o ! output grid: global area + integer :: mwts ! number of weights + integer :: ni,no,ns_i,ns_o ! indices + integer :: k,l,n,m ! indices + integer :: ncidi,dimid,varid ! input netCDF id's + integer :: ndimsi,ndimso ! netCDF dimension sizes + integer :: dimids(4) ! netCDF dimension ids + integer :: bego(4),leno(4) ! netCDF bounds + integer :: begi(4),leni(4) ! netCDF bounds + integer :: ntim ! number of input time samples + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 32) :: subname = 'mklai' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make LAIs/SAIs/heights .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + write (6,*) 'Open LAI file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_dimid(ncidi, 'pft', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numpft_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'time', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, ntim), subname) + + if (numpft_i /= numpft+1) then + write(6,*) 'WARNING: ' // trim(subname) // '(): parameter numpft+1 = ', numpft+1, & + 'does not equal input dataset numpft = ', numpft_i + write(6,*)'This inconsistency used to stop the program. Now we allow it ' + write(6,*)'because crop pfts 17-last are assumed to never use satellite lai data.' +! stop + if (numpft_i > numpft + 1) then + ! NOTE(bja, 2015-01) If this error check is determined to be + ! invalid, all the loop bounds over output data in this + ! routine will need to be double checked! + write(6, *) "ERROR:" // trim(subname) // "(): input numpft must be less than or equal to output numpft+1." + stop + end if + endif + if (ntim /= 12) then + write(6,*)'MKLAI: must have 12 time samples on input data' + call abort() + endif + + ! NOTE - close data set at bottom of routine + + ! Dynamic allocation of variables + + allocate(mlai_i(ns_i,0:numpft_i), & + msai_i(ns_i,0:numpft_i), & + mhgtt_i(ns_i,0:numpft_i), & + mhgtb_i(ns_i,0:numpft_i), & + mask_src(ns_i), & + mlai_o(ns_o,0:numpft), & + msai_o(ns_o,0:numpft), & + mhgtt_o(ns_o,0:numpft), & + mhgtb_o(ns_o,0:numpft), & + laimask(ns_i,0:numpft), stat=ier ) + if (ier /= 0) then + write(6,*)'mklai allocation error'; call abort() + end if + + ! Determine mapping weights and map + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine number of dimensions in input by querying MONTHLY_LAI + + call check_ret(nf_inq_varid(ncidi, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_inq_vardimid(ncidi, varid, dimids), subname) + call check_ret(nf_inq_varndims(ncidi, varid, ndimsi), subname) + if (ndimsi ==4) then + begi(1) = 1 + begi(2) = 1 + begi(3) = 1 + leni(4) = 1 + call check_ret(nf_inq_dimlen(ncidi, dimids(1), leni(1)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(2), leni(2)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(3), leni(3)), subname) + else if (ndimsi== 3) then + begi(1) = 1 + begi(2) = 1 + leni(3) = 1 + call check_ret(nf_inq_dimlen(ncidi, dimids(1), leni(1)), subname) + call check_ret(nf_inq_dimlen(ncidi, dimids(2), leni(2)), subname) + end if + + ! Determine number of dimensions in output by querying MONTHLY_LAI + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_inq_varndims(ncido, varid, ndimso), subname) + call check_ret(nf_inq_vardimid(ncido, varid, dimids), subname) + if (ndimso ==4) then + bego(1) = 1 + bego(2) = 1 + bego(3) = 1 + leno(4) = 1 + call check_ret(nf_inq_dimlen(ncido, dimids(1), leno(1)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(2), leno(2)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(3), leno(3)), subname) + else if (ndimso== 3) then + bego(1) = 1 + bego(2) = 1 + leno(3) = 1 + call check_ret(nf_inq_dimlen(ncido, dimids(1), leno(1)), subname) + call check_ret(nf_inq_dimlen(ncido, dimids(2), leno(2)), subname) + end if + + ! Loop over months + + do m = 1, ntim + + if (ndimsi == 4) begi(4)=m + if (ndimsi == 3) begi(3)=m + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mlai_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_SAI', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + msai_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_HEIGHT_TOP', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mhgtt_i), subname) + + call check_ret(nf_inq_varid (ncidi, 'MONTHLY_HEIGHT_BOT', varid), subname) + call check_ret(nf_get_vara_double (ncidi, varid, begi(1:ndimsi), leni(1:ndimsi), & + mhgtb_i), subname) + + mlai_o(:,:) = 0. + msai_o(:,:) = 0. + mhgtt_o(:,:) = 0. + mhgtb_o(:,:) = 0. + + ! Loop over pft types to do mapping + + do l = 0, numpft_i - 1 + mask_src(:) = 1._r8 + call gridmap_areaave(tgridmap, mlai_i(:,l) , mlai_o(:,l) , nodata=0._r8, mask_src=mask_src) + call gridmap_areaave(tgridmap, msai_i(:,l) , msai_o(:,l) , nodata=0._r8, mask_src=mask_src) + call gridmap_areaave(tgridmap, mhgtt_i(:,l), mhgtt_o(:,l), nodata=0._r8, mask_src=mask_src) + call gridmap_areaave(tgridmap, mhgtb_i(:,l), mhgtb_o(:,l), nodata=0._r8, mask_src=mask_src) + enddo + + ! Determine laimask + + laimask(:,:) = 0 + + ! copy LAI, SAI, & heights from the C3 crop (pft15) + ! to the irrigated (pft16) whether crop is on or off + mlai_o(:,c3irrcropindex) = mlai_o(:,c3cropindex) + msai_o(:,c3irrcropindex) = msai_o(:,c3cropindex) + mhgtt_o(:,c3irrcropindex) = mhgtt_o(:,c3cropindex) + mhgtb_o(:,c3irrcropindex) = mhgtb_o(:,c3cropindex) + + ! ----------------------------------------------------------------- + ! Output model resolution LAI/SAI/HEIGHT data + ! ----------------------------------------------------------------- + + ! Now write out all variables + + if (ndimso == 4) bego(4)=m + if (ndimso == 3) bego(3)=m + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_LAI', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mlai_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_SAI', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, msai_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_HEIGHT_TOP', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mhgtt_o), subname) + + call check_ret(nf_inq_varid(ncido, 'MONTHLY_HEIGHT_BOT', varid), subname) + call check_ret(nf_put_vara_double(ncido, varid, bego, leno, mhgtb_o), subname) + + call check_ret(nf_inq_varid(ncido, 'time', varid), subname) + call check_ret(nf_put_vara_int(ncido, varid, bego(ndimso), leno(ndimso), m), subname) + + call check_ret(nf_sync(ncido), subname) + + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid global area + + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni) + end do + + glai_i(:) = 0. + gsai_i(:) = 0. + ghgtt_i(:) = 0. + ghgtb_i(:) = 0. + do l = 0, numpft_i - 1 + do ni = 1, ns_i + glai_i(l) = glai_i(l) + mlai_i(ni,l) *tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + gsai_i(l) = gsai_i(l) + msai_i(ni,l) *tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + ghgtt_i(l) = ghgtt_i(l)+ mhgtt_i(ni,l)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + ghgtb_i(l) = ghgtb_i(l)+ mhgtb_i(ni,l)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + end do + end do + + ! Output grid global area + + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no) + end do + + glai_o(:) = 0. + gsai_o(:) = 0. + ghgtt_o(:) = 0. + ghgtb_o(:) = 0. + do l = 0, numpft_i - 1 + do no = 1,ns_o + glai_o(l) = glai_o(l) + mlai_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + gsai_o(l) = gsai_o(l) + msai_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + ghgtt_o(l) = ghgtt_o(l)+ mhgtt_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + ghgtb_o(l) = ghgtb_o(l)+ mhgtb_o(no,l)*tgridmap%area_dst(no)* & + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'LAI Output for month ',m + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'PFT input grid area output grid area',/ & + 1x,3x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do l = 0, numpft + write (ndiag,1002) l, glai_i(l)*1.e-06*1.e-02,glai_o(l)*1.e-06*1.e-02 +1002 format (1x,i3,f16.3,f17.3) + end do + + write (6,*) 'Successfully made LAIs/SAIs/heights for month ', m + call shr_sys_flush(6) + + enddo + write (6,*) + + ! Close input file + call check_ret(nf_close(ncidi), subname) + + ! consistency check that PFT and LAI+SAI make sense + !call pft_laicheck( ni_s, pft_i, laimask ) + + ! Deallocate dynamic memory + deallocate(mlai_i) + deallocate(msai_i) + deallocate(mhgtt_i) + deallocate(mhgtb_i) + deallocate(mask_src) + deallocate(mlai_o) + deallocate(msai_o) + deallocate(mhgtt_o) + deallocate(mhgtb_o) + deallocate(laimask) + + call gridmap_clean(tgridmap) + call domain_clean(tdomain) + +end subroutine mklai + +!----------------------------------------------------------------------- +!BOP +! +! !INTERFACE: +subroutine pft_laicheck( ni_s, pctpft_i, laimask ) + +! !USES: +! +! !DESCRIPTION: +! +! consistency check that PFT and LAI+SAI make sense +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ni_s ! input PFT grid resolution + real(r8), pointer :: pctpft_i(:,:) ! % plant function types + integer, pointer :: laimask(:,:) ! mask where LAI+SAI > 0 +!EOP + + character(len=*), parameter :: subName="pft_laicheck" + integer :: ni,l,n,nc ! Indices +!----------------------------------------------------------------------- + + do l = 0, numpft + n = 0 + nc = 0 + do ni = 1,ni_s + if ( pctpft_i(ni,l) > 0.0_r8 ) nc = nc + 1 + if ( (pctpft_i(ni,l) > 0.0_r8) .and. (laimask(ni,l) /= 1) )then + write (6,*) subName//' :: warning: pft and LAI+SAI mask not consistent!' + write (6,*) 'ni,l = ', ni, l + write (6,*) 'pctpft_i = ',pctpft_i(ni,l) + write (6,*) 'laimask = ', laimask(ni,l) + n = n + 1 + end if + end do + if ( n > max(4,nc/4) ) then + write (6,*) subName//' :: pft/LAI+SAI inconsistency over more than 25% land-cover' + write (6,*) '# inconsistent points, total PFT pts, total LAI+SAI pts = ', & + n, nc, sum(laimask(:,l)) + stop + end if + end do + +end subroutine pft_laicheck + +!----------------------------------------------------------------------- + +end module mklaiMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 new file mode 100644 index 0000000000..220648e497 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mklanwatMod.F90 @@ -0,0 +1,509 @@ +module mklanwatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mklanwatMod +! +! !DESCRIPTION: +! make %lake and %wetland from input lake / wetland data +! also make lake parameters +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mklakwat ! make % lake + public mkwetlnd ! make % wetland + public mklakparams ! make lake parameters + +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mklakwat +! +! !INTERFACE: +subroutine mklakwat(ldomain, mapfname, datfname, ndiag, zero_out, lake_o) +! +! !DESCRIPTION: +! make %lake +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: lake_o(:) ! output grid: %lake +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: lake_i(:) ! input grid: percent lake + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: glake_i ! input grid: global lake + real(r8) :: garea_i ! input grid: global area + real(r8) :: glake_o ! output grid: global lake + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mklakwat' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %lake and %wetland .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + if ( .not. zero_out )then + allocate(lake_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write(6,*)'Open lake file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_LAKE', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, lake_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine lake_o on output grid + + call gridmap_areaave(tgridmap, lake_i,lake_o, nodata=0._r8) + + do no = 1,ns_o + if (lake_o(no) < 1.) lake_o(no) = 0. + enddo + + ! ----------------------------------------------------------------- + ! Error check prep + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + ! ----------------------------------------------------------------- + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( .not. zero_out .and. (trim(mksrf_gridtype) == 'global') ) then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKLANWAT error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + glake_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + glake_i = glake_i + lake_i(ni)*tgridmap%area_src(ni)/100.*re**2 + end do + + ! Output grid + + glake_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + glake_o = glake_o + lake_o(no)*tgridmap%area_dst(no)/100.*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Inland Water Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) glake_i*1.e-06,glake_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'lakes ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + else + do no = 1,ns_o + lake_o(no) = 0. + enddo + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (lake_i) + end if + + write (6,*) 'Successfully made %lake' + write (6,*) + call shr_sys_flush(6) + +end subroutine mklakwat + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkwetlnd +! +! !INTERFACE: +subroutine mkwetlnd(ldomain, mapfname, datfname, ndiag, zero_out, swmp_o) +! +! !DESCRIPTION: +! make %wetland +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero glacier out + real(r8) , intent(out):: swmp_o(:) ! output grid: %wetland +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: swmp_i(:) ! input grid: percent swamp + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gswmp_i ! input grid: global swamp + real(r8) :: garea_i ! input grid: global area + real(r8) :: gswmp_o ! output grid: global swamp + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k,n,m,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkwetlnd' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %wetland .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + ns_o = ldomain%ns + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + if ( .not. zero_out )then + allocate(swmp_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write(6,*)'Open wetland file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_WETLAND', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, swmp_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + ! Determine swmp_o on output grid + + call gridmap_areaave(tgridmap, swmp_i,swmp_o, nodata=0._r8) + + do no = 1,ns_o + if (swmp_o(no) < 1.) swmp_o(no) = 0. + enddo + + ! ----------------------------------------------------------------- + ! Error check prep + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + ! ----------------------------------------------------------------- + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( .not. zero_out .and. (trim(mksrf_gridtype) == 'global') ) then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKLANWAT error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gswmp_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gswmp_i = gswmp_i + swmp_i(ni)*tgridmap%area_src(ni)/100.*re**2 + end do + + ! Output grid + + gswmp_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gswmp_o = gswmp_o + swmp_o(no)*tgridmap%area_dst(no)/100.*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Inland Water Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) gswmp_i*1.e-06,gswmp_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2003 format (1x,'wetlands ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + else + do no = 1,ns_o + swmp_o(no) = 0. + enddo + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( .not. zero_out )then + call gridmap_clean(tgridmap) + deallocate (swmp_i) + end if + + write (6,*) 'Successfully made %wetland' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkwetlnd + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mklakparams +! +! !INTERFACE: +subroutine mklakparams(ldomain, mapfname, datfname, ndiag, & + lakedepth_o) +! +! !DESCRIPTION: +! make lake parameters (currently just lake depth) +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_continuous + use mkchecksMod, only : min_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: lakedepth_o(:) ! output grid: lake depth (m) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid_lakedepth = 0._r8 + + character(len=32) :: subname = 'mklakparams' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make lake parameters.....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname) + + call gridmap_mapread(tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open lake parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid lake depth + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'LAKEDEPTH', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, lakedepth_o, nodata=10._r8) + + ! Check validity of output data + if (min_bad(lakedepth_o, min_valid_lakedepth, 'lakedepth')) then + stop + end if + + call output_diagnostics_continuous(data_i, lakedepth_o, tgridmap, "Lake Depth", "m", ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made lake parameters' + write (6,*) + call shr_sys_flush(6) + +end subroutine mklakparams + +end module mklanwatMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 new file mode 100644 index 0000000000..5a5b6a79b0 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkncdio.F90 @@ -0,0 +1,551 @@ +module mkncdio + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkncdio +! +! !DESCRIPTION: +! Generic interfaces to write fields to netcdf files, and other useful netcdf operations +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush +! +! !PUBLIC TYPES: + implicit none + include 'netcdf.inc' + save + + private + + public :: check_ret ! checks return status of netcdf calls + public :: ncd_defvar ! define netCDF input variable + public :: ncd_def_spatial_var ! define spatial netCDF variable (convenience wrapper to ncd_defvar) + public :: ncd_put_time_slice ! write a single time slice of a variable + public :: get_dim_lengths ! get dimension lengths of a netcdf variable + + interface ncd_def_spatial_var + module procedure ncd_def_spatial_var_0lev + module procedure ncd_def_spatial_var_1lev + module procedure ncd_def_spatial_var_2lev + end interface ncd_def_spatial_var + + interface ncd_put_time_slice + module procedure ncd_put_time_slice_1d + module procedure ncd_put_time_slice_2d + end interface ncd_put_time_slice + + public :: convert_latlon ! convert a latitude or longitude variable to degrees E / N +! +! !REVISION HISTORY: +! +! +! !PRIVATE MEMBER FUNCTIONS: +! + private :: get_time_slice_beg_and_len ! determine beg and len vectors for writing a time slice + + logical :: masterproc = .true. ! always use 1 proc + real(r8) :: spval = 1.e36 ! special value + + public :: nf_open + public :: nf_close + public :: nf_write + public :: nf_sync + public :: nf_inq_attlen + public :: nf_inq_dimlen + public :: nf_inq_dimname + public :: nf_inq_varid + public :: nf_inq_varndims + public :: nf_inq_vardimid + public :: nf_get_att_double + public :: nf_get_att_text + public :: nf_get_var_double + public :: nf_get_vara_double + public :: nf_get_var_int + public :: nf_get_vara_int + public :: nf_put_var_double + public :: nf_put_vara_double + public :: nf_put_var_int + public :: nf_put_vara_int + public :: nf_inq_dimid + public :: nf_max_name + public :: nf_max_var_dims + public :: nf_noerr +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: check_ret +! +! !INTERFACE: + subroutine check_ret(ret, calling) +! +! !DESCRIPTION: +! Check return status from netcdf call +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: ret + character(len=*) :: calling +! +! !REVISION HISTORY: +! +!EOP +!----------------------------------------------------------------------- + + if (ret /= NF_NOERR) then + write(6,*)'netcdf error from ',trim(calling), ' rcode = ', ret, & + ' error = ', NF_STRERROR(ret) + call abort() + end if + + end subroutine check_ret + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: ncd_defvar +! +! !INTERFACE: + subroutine ncd_defvar(ncid, varname, xtype, & + dim1name, dim2name, dim3name, dim4name, dim5name, & + long_name, units, cell_method, missing_value, fill_value, & + imissing_value, ifill_value) +! +! !DESCRIPTION: +! Define a netcdf variable +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! input unit + character(len=*), intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*), intent(in), optional :: dim1name ! dimension name + character(len=*), intent(in), optional :: dim2name ! dimension name + character(len=*), intent(in), optional :: dim3name ! dimension name + character(len=*), intent(in), optional :: dim4name ! dimension name + character(len=*), intent(in), optional :: dim5name ! dimension name + character(len=*), intent(in), optional :: long_name ! attribute + character(len=*), intent(in), optional :: units ! attribute + character(len=*), intent(in), optional :: cell_method ! attribute + real(r8) , intent(in), optional :: missing_value ! attribute for real + real(r8) , intent(in), optional :: fill_value ! attribute for real + integer , intent(in), optional :: imissing_value ! attribute for int + integer , intent(in), optional :: ifill_value ! attribute for int +! +! !REVISION HISTORY: +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n ! indices + integer :: ndims ! dimension counter + integer :: dimid(5) ! dimension ids + integer :: varid ! variable id + integer :: itmp ! temporary + character(len=256) :: str ! temporary + character(len=32) :: subname='NCD_DEFVAR_REAL' ! subroutine name +!----------------------------------------------------------------------- + + if (.not. masterproc) return + + ! Determine dimension ids for variable + + dimid(:) = 0 + + if (present(dim1name)) then + call check_ret(nf_inq_dimid(ncid, dim1name, dimid(1)), subname) + end if + if (present(dim2name)) then + call check_ret(nf_inq_dimid(ncid, dim2name, dimid(2)), subname) + end if + if (present(dim3name)) then + call check_ret(nf_inq_dimid(ncid, dim3name, dimid(3)), subname) + end if + if (present(dim4name)) then + call check_ret(nf_inq_dimid(ncid, dim4name, dimid(4)), subname) + end if + if (present(dim5name)) then + call check_ret(nf_inq_dimid(ncid, dim5name, dimid(5)), subname) + end if + + ! Define variable + + if (present(dim1name)) then + ndims = 0 + do n = 1, size(dimid) + if (dimid(n) /= 0) ndims = ndims + 1 + end do + call check_ret(nf_def_var(ncid, trim(varname), xtype, ndims, dimid(1:ndims), varid), subname) + else + call check_ret(nf_def_var(ncid, varname, xtype, 0, 0, varid), subname) + end if + if (present(long_name)) then + call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) + end if + if (present(units)) then + call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) + end if + if (present(cell_method)) then + str = 'time: ' // trim(cell_method) + call check_ret(nf_put_att_text(ncid, varid, 'cell_method', len_trim(str), trim(str)), subname) + end if + if (present(fill_value)) then + call check_ret(nf_put_att_double(ncid, varid, '_FillValue', xtype, 1, fill_value), subname) + end if + if (present(missing_value)) then + call check_ret(nf_put_att_double(ncid, varid, 'missing_value', xtype, 1, missing_value), subname) + end if + if (present(ifill_value)) then + call check_ret(nf_put_att_int(ncid, varid, '_FillValue', xtype, 1, ifill_value), subname) + end if + if (present(imissing_value)) then + call check_ret(nf_put_att_int(ncid, varid, 'missing_value', xtype, 1, imissing_value), subname) + end if + + end subroutine ncd_defvar + + ! ======================================================================== + ! ncd_def_spatial_var routines: define a spatial netCDF variable (convenience wrapper to + ! ncd_defvar) + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine ncd_def_spatial_var_0lev(ncid, varname, xtype, long_name, units) + ! + ! !DESCRIPTION: + ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) + ! + ! The variable in question has ONLY spatial dimensions (no level or time dimensions) + ! + ! !USES: + use mkvarctl, only : outnc_1d + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! input unit + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in) :: long_name ! attribute + character(len=*) , intent(in) :: units ! attribute + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'ncd_def_spatial_var_0lev' + !----------------------------------------------------------------------- + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='gridcell', & + long_name=long_name, units=units) + else + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', & + long_name=long_name, units=units) + end if + + end subroutine ncd_def_spatial_var_0lev + + !----------------------------------------------------------------------- + subroutine ncd_def_spatial_var_1lev(ncid, varname, xtype, lev1name, long_name, units) + ! + ! !DESCRIPTION: + ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) + ! + ! The variable in question has one level (or time) dimension in addition to its + ! spatial dimensions + ! + ! !USES: + use mkvarctl, only : outnc_1d + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! input unit + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in) :: lev1name ! name of level (or time) dimension + character(len=*) , intent(in) :: long_name ! attribute + character(len=*) , intent(in) :: units ! attribute + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'ncd_def_spatial_var_1lev' + !----------------------------------------------------------------------- + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='gridcell', dim2name=lev1name, & + long_name=long_name, units=units) + else + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat',dim3name=lev1name, & + long_name=long_name, units=units) + end if + + end subroutine ncd_def_spatial_var_1lev + + !----------------------------------------------------------------------- + subroutine ncd_def_spatial_var_2lev(ncid, varname, xtype, lev1name, lev2name, long_name, units) + ! + ! !DESCRIPTION: + ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) + ! + ! The variable in question has two level (or time) dimensions in addition to its + ! spatial dimensions + ! + ! !USES: + use mkvarctl, only : outnc_1d + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! input unit + character(len=*) , intent(in) :: varname ! variable name + integer , intent(in) :: xtype ! external type + character(len=*) , intent(in) :: lev1name ! name of first level (or time) dimension + character(len=*) , intent(in) :: lev2name ! name of second level (or time) dimension + character(len=*) , intent(in) :: long_name ! attribute + character(len=*) , intent(in) :: units ! attribute + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'ncd_def_spatial_var_2lev' + !----------------------------------------------------------------------- + + if (outnc_1d) then + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='gridcell', dim2name=lev1name, dim3name=lev2name, & + long_name=long_name, units=units) + else + call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & + dim1name='lsmlon', dim2name='lsmlat', dim3name=lev1name, dim4name=lev2name, & + long_name=long_name, units=units) + end if + + end subroutine ncd_def_spatial_var_2lev + + ! ======================================================================== + ! ncd_put_time_slice routines: write a single time slice of a variable + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine ncd_put_time_slice_1d(ncid, varid, time_index, data) + ! + ! !DESCRIPTION: + ! Write a single time slice of a 1-d variable + ! + ! !USES: + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! netCDF id + integer , intent(in) :: varid ! variable id + integer , intent(in) :: time_index ! time index in file + real(r8), intent(in) :: data(:) ! data to write (a single time slice) + ! + ! !LOCAL VARIABLES: + integer, allocatable :: beg(:) ! begin indices for each dimension + integer, allocatable :: len(:) ! length along each dimension + + character(len=*), parameter :: subname = 'ncd_put_time_slice_1d' + !----------------------------------------------------------------------- + + call get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) + call check_ret(nf_put_vara_double(ncid, varid, beg, len, data), subname) + + deallocate(beg, len) + + end subroutine ncd_put_time_slice_1d + + !----------------------------------------------------------------------- + subroutine ncd_put_time_slice_2d(ncid, varid, time_index, data) + ! + ! !DESCRIPTION: + ! Write a single time slice of a 2-d variable + ! + ! !USES: + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! netCDF id + integer , intent(in) :: varid ! variable id + integer , intent(in) :: time_index ! time index in file + real(r8), intent(in) :: data(:,:) ! data to write (a single time slice) + ! + ! !LOCAL VARIABLES: + integer, allocatable :: beg(:) ! begin indices for each dimension + integer, allocatable :: len(:) ! length along each dimension + + character(len=*), parameter :: subname = 'ncd_put_time_slice_2d' + !----------------------------------------------------------------------- + + call get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) + call check_ret(nf_put_vara_double(ncid, varid, beg, len, data), subname) + + deallocate(beg, len) + + end subroutine ncd_put_time_slice_2d + + + !----------------------------------------------------------------------- + subroutine get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) + ! + ! !DESCRIPTION: + ! Determine beg and len vectors for writing a time slice. + ! + ! Assumes time is the last dimension of the given variable. + ! + ! Allocates memory for beg & len. + ! + ! !USES: + ! + ! !ARGUMENTS: + integer , intent(in) :: ncid ! netcdf ID + integer , intent(in) :: varid ! variable ID + integer , intent(in) :: time_index ! time index in file + integer, allocatable, intent(out) :: beg(:) ! begin indices for each dimension + integer, allocatable, intent(out) :: len(:) ! length along each dimension + ! + ! !LOCAL VARIABLES: + integer :: n ! index + integer :: ndims ! number of dimensions + integer, allocatable :: dimids(:) ! dimension IDs + + character(len=*), parameter :: subname = 'get_time_slice_beg_and_len' + !----------------------------------------------------------------------- + + call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) + allocate(beg(ndims)) + allocate(len(ndims)) + allocate(dimids(ndims)) + + call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) + beg(1:ndims-1) = 1 + do n = 1,ndims-1 + call check_ret(nf_inq_dimlen(ncid, dimids(n), len(n)), subname) + end do + len(ndims) = 1 + beg(ndims) = time_index + + deallocate(dimids) + + end subroutine get_time_slice_beg_and_len + + + + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: get_dim_lengths +! +! !INTERFACE: +subroutine get_dim_lengths(ncid, varname, ndims, dim_lengths) +! +! !DESCRIPTION: +! Returns the number of dimensions and an array containing the dimension lengths of a +! variable in an open netcdf file. +! +! Entries 1:ndims in the returned dim_lengths array contain the dimension lengths; the +! remaining entries in that vector are meaningless. The dim_lengths array must be large +! enough to hold all ndims values; if not, the code aborts (this can be ensured by passing +! in an array of length nf_max_var_dims). +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! netcdf id of an open netcdf file + character(len=*), intent(in) :: varname ! name of variable of interest + integer , intent(out):: ndims ! number of dimensions of variable + integer , intent(out):: dim_lengths(:) ! lengths of dimensions of variable +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: + integer :: varid + integer :: dimids(size(dim_lengths)) + integer :: i + character(len=*), parameter :: subname = 'get_dim_lengths' +!EOP +!------------------------------------------------------------------------------ + call check_ret(nf_inq_varid(ncid, varname, varid), subname) + call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) + + if (ndims > size(dim_lengths)) then + write(6,*) trim(subname), ' ERROR: dim_lengths too small' + call abort() + end if + + call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) + + dim_lengths(:) = 0 ! pre-fill with 0 so we won't have garbage in elements past ndims + do i = 1, ndims + call check_ret(nf_inq_dimlen(ncid, dimids(i), dim_lengths(i)), subname) + end do + end subroutine get_dim_lengths + +!---------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: convert_latlon +! +! !INTERFACE: + subroutine convert_latlon(ncid, varname, data) +! +! !DESCRIPTION: +! Convert a latitude or longitude variable from its units in the input file to degrees E / +! degrees N. Currently, this just handles conversions from radians to degrees. +! +! Assumes that the longitude / latitude variable has already been read from file, into +! the variable given by 'data'. ncid & varname give the file ID and variable name from +! which this variable was read (needed to obtain the variable's units). +! +! !USES: + use shr_const_mod, only : SHR_CONST_PI +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: ncid ! ID of open netcdf file + character(len=*), intent(in) :: varname ! name of lat or lon variable that was read into 'data' + real(r8) , intent(inout):: data(:) ! latitude or longitude data +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: ier ! error return code + integer :: varid ! netCDF variable id + integer :: units_len ! length of units attribute on file + character(len=256) :: units ! units attribute + character(len= 32) :: subname = 'convert_latlon' +!----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, varname, varid), subname) + ier = nf_inq_attlen(ncid, varid, 'units', units_len) + + ! Only do the following processing if there is no error; if ier /= NF_NOERR, that + ! probably means there isn't a units attribute -- in that case, assume units are + ! degrees and need no conversion + if (ier == NF_NOERR) then + if (units_len > len(units)) then + write(6,*) trim(subname), ' ERROR: units variable not long enough to hold attributue' + call abort() + end if + + call check_ret(nf_get_att_text(ncid, varid, 'units', units), subname) + + if (units(1:7) == 'radians') then + ! convert from radians to degrees + data(:) = data(:) * 180._r8 / SHR_CONST_PI + end if + end if + + end subroutine convert_latlon +!------------------------------------------------------------------------------ + + +end module mkncdio diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkpctPftTypeMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpctPftTypeMod.F90 new file mode 100644 index 0000000000..a70736b3cd --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpctPftTypeMod.F90 @@ -0,0 +1,549 @@ +module mkpctPftTypeMod + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: mkpctPftType + ! + ! !DESCRIPTION: + ! Derived type and associated methods for operating on pct_pft data + ! + ! !REVISION HISTORY: + ! Author: Bill Sacks + ! + !----------------------------------------------------------------------- + + !!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + ! !PUBLIC TYPES + public :: pct_pft_type + + type :: pct_pft_type + private + real(r8), allocatable :: pct_p2l(:) ! pct of each pft on the landunit + real(r8) :: pct_l2g ! pct of landunit on the grid cell + contains + ! Public routines: + ! Query routines: + procedure :: get_pct_p2l ! get an array holding % of each pft on the landunit + procedure :: get_pct_p2g ! get an array holding % of each pft on the gridcell + procedure :: get_pct_l2g ! get % of landunit on the grid cell + procedure :: get_first_pft_index ! get index of the first pft (lower bound of arrays) + procedure :: get_one_pct_p2g ! get % of gridcell for a single pft + ! Routines that modify the data: + procedure :: set_pct_l2g ! set % of landunit on the grid cell + procedure :: set_one_pct_p2g ! set % pft for a single pft + procedure :: merge_pfts ! merge all area from one PFT into another PFT + procedure :: remove_small_cover ! set % cover to 0 for any PFT whose grid cell coverage is less than a threshold + + ! Private routines: + procedure, private :: convert_from_p2g ! convert a p2g array into p2l and l2g + procedure, private :: check_vals ! perform a sanity check after setting values + end type pct_pft_type + + ! !PUBLIC MEMBER FUNCTIONS + public :: get_pct_p2l_array ! given an array of pct_pft_type variables, return a 2-d array of pct_p2l + public :: get_pct_l2g_array ! given an array of pct_pft_type variables, return an array of pct_l2g + + interface pct_pft_type + module procedure constructor ! initialize a new pct_pft_type object + module procedure constructor_empty ! initialize a new pct_pft_type object for an empty landunit + end interface pct_pft_type + + ! !PRIVATE TYPES: + real(r8), parameter :: tol = 1.e-12_r8 ! tolerance for checking equality + + !EOP + +contains + + ! ======================================================================== + ! Constructors + ! ======================================================================== + + !----------------------------------------------------------------------- + function constructor(pct_p2g, first_pft_index, default_pct_p2l) result(this) + ! + ! !DESCRIPTION: + ! Given the % of each pft on the grid cell, create a pct_pft_type object. + ! + ! Note that pct_p2g should just contain the pfts in this landunit. + ! + ! If all PFTs have 0 weight on the grid cell, we arbitrarily set % of each pft on the + ! landunit based on default_pct_p2l. Note that: + ! (1) size of default_pct_p2l must match size of pct_p2g + ! (2) default_pct_p2l must sum to 100% + ! + ! !ARGUMENTS: + type(pct_pft_type) :: this ! function result + + real(r8), intent(in) :: pct_p2g(:) ! % of each pft on the grid cell + integer , intent(in) :: first_pft_index ! index of the first pft (lower bound of arrays) + real(r8), intent(in) :: default_pct_p2l(:) ! default % of each pft on the landunit, used if total landunit area is 0% + ! + ! !LOCAL VARIABLES: + integer :: last_pft_index + + character(len=*), parameter :: subname = 'constructor' + !----------------------------------------------------------------------- + + if (size(default_pct_p2l) /= size(pct_p2g)) then + write(6,*) subname//' ERROR: size of default_pct_p2l must match size of pct_p2g' + call abort() + end if + + last_pft_index = first_pft_index + size(pct_p2g) - 1 + allocate(this%pct_p2l(first_pft_index : last_pft_index)) + call this%convert_from_p2g(pct_p2g, default_pct_p2l) + + end function constructor + + !----------------------------------------------------------------------- + function constructor_empty() result(this) + ! + ! !DESCRIPTION: + ! Initialize a new pct_pft_type object for an empty landunit - that is, one that has + ! no PFTs on it, and never can (e.g., the crop landunit when we're running without + ! prognostic crops, so that the landunit is always empty). + ! + ! !ARGUMENTS: + type(pct_pft_type) :: this ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'constructor_empty' + !----------------------------------------------------------------------- + + this%pct_l2g = 0._r8 + allocate(this%pct_p2l(0)) + + end function constructor_empty + + + + ! ======================================================================== + ! Public member functions + ! ======================================================================== + + !----------------------------------------------------------------------- + function get_pct_p2l(this) result(pct_p2l) + ! + ! !DESCRIPTION: + ! Get an array holding % of each pft on the landunit + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(in) :: this + real(r8) :: pct_p2l(size(this%pct_p2l)) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_pct_p2l' + !----------------------------------------------------------------------- + + pct_p2l = this%pct_p2l + + end function get_pct_p2l + + !----------------------------------------------------------------------- + function get_pct_p2g(this) result(pct_p2g) + ! + ! !DESCRIPTION: + ! Get an array holding % of each pft on the gridcell + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(in) :: this + real(r8) :: pct_p2g(size(this%pct_p2l)) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_pct_p2g' + !----------------------------------------------------------------------- + + pct_p2g(:) = this%pct_p2l(:) * this%pct_l2g / 100._r8 + + end function get_pct_p2g + + !----------------------------------------------------------------------- + function get_pct_l2g(this) result(pct_l2g) + ! + ! !DESCRIPTION: + ! Get % of landunit on the grid cell + ! + ! !ARGUMENTS: + real(r8) :: pct_l2g ! function result + class(pct_pft_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_pct_l2g' + !----------------------------------------------------------------------- + + pct_l2g = this%pct_l2g + + end function get_pct_l2g + + !----------------------------------------------------------------------- + function get_first_pft_index(this) result(first_pft_index) + ! + ! !DESCRIPTION: + ! Get index of the first pft (lower bound of arrays) + ! + ! !ARGUMENTS: + integer :: first_pft_index ! function result + class(pct_pft_type), intent(in) :: this + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_first_pft_index' + !----------------------------------------------------------------------- + + first_pft_index = lbound(this%pct_p2l, 1) + + end function get_first_pft_index + + !----------------------------------------------------------------------- + function get_one_pct_p2g(this, pft_index) result(pct_p2g) + ! + ! !DESCRIPTION: + ! Get % of gridcell for a single pft + ! + ! !ARGUMENTS: + real(r8) :: pct_p2g ! function result + class(pct_pft_type), intent(in) :: this + integer :: pft_index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_one_pct_p2g' + !----------------------------------------------------------------------- + + pct_p2g = this%pct_p2l(pft_index) * this%pct_l2g / 100._r8 + + end function get_one_pct_p2g + + !----------------------------------------------------------------------- + subroutine set_pct_l2g(this, pct_l2g_new) + ! + ! !DESCRIPTION: + ! Set percent of landunit on the grid cell. Keep pct_p2l the same as before. + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(inout) :: this + real(r8), intent(in) :: pct_l2g_new ! new percent of this landunit with respect to grid cell + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'set_pct_l2g' + !----------------------------------------------------------------------- + + if (pct_l2g_new < 0._r8 .or. pct_l2g_new > (100._r8 + tol)) then + write(6,*) subname//' ERROR: pct_l2g_new must be between 0 and 100%' + write(6,*) 'pct_l2g_new = ', pct_l2g_new + call abort() + end if + + this%pct_l2g = pct_l2g_new + + end subroutine set_pct_l2g + + !----------------------------------------------------------------------- + subroutine set_one_pct_p2g(this, pft_index, pct_p2g_new) + ! + ! !DESCRIPTION: + ! Set percent pft for a single pft, given its weight on the grid cell. + ! + ! The landunit percent is adjusted appropriately. In addition, the coverage of other + ! PFTs are adjusted proportionally so that the total pct_pft adds to 100%. + ! + ! If the resulting total weight on the grid cell is reduced to 0, then pct_p2l + ! remains as it was before this subroutine call. + ! + ! Note about pft_index: Note that the first element of the array has index given by + ! the first_pft_index value given to the constructor. + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(inout) :: this + integer , intent(in) :: pft_index ! index of the pft to change + real(r8), intent(in) :: pct_p2g_new ! new percent of this pft, with respect to grid cell + ! + ! !LOCAL VARIABLES: + real(r8), allocatable :: pct_p2g(:) ! % of each pft on the grid cell + + character(len=*), parameter :: subname = 'set_pct_p2g' + !----------------------------------------------------------------------- + + if (pct_p2g_new < 0._r8 .or. pct_p2g_new > (100._r8 + tol)) then + write(6,*) subname//' ERROR: pct_p2g_new must be between 0 and 100%' + write(6,*) 'pct_p2g_new = ', pct_p2g_new + call abort() + end if + + allocate(pct_p2g(lbound(this%pct_p2l, 1) : ubound(this%pct_p2l, 1))) + pct_p2g(:) = this%get_pct_p2g() + pct_p2g(pft_index) = pct_p2g_new + + ! Note that by using this%pct_p2l as the default_pct_pl2 argument, we ensure that, if + ! the new p2g value brings the total % on the grid cell to 0, then we keep the + ! previous values for pct_p2l + call this%convert_from_p2g(pct_p2g, this%pct_p2l) + + deallocate(pct_p2g) + + end subroutine set_one_pct_p2g + + !----------------------------------------------------------------------- + subroutine merge_pfts(this, source, dest) + ! + ! !DESCRIPTION: + ! Merge all area from one PFT into another PFT + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(inout) :: this + integer, intent(in) :: source ! index of source PFT + integer, intent(in) :: dest ! index of dest PFT + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'merge_pfts' + !----------------------------------------------------------------------- + + this%pct_p2l(dest) = this%pct_p2l(dest) + this%pct_p2l(source) + this%pct_p2l(source) = 0._r8 + + call this%check_vals(subname) + + end subroutine merge_pfts + + !----------------------------------------------------------------------- + subroutine remove_small_cover(this, too_small, nsmall) + ! + ! !DESCRIPTION: + ! Remove any small PFTs, defined as those whose grid cell coverage is below some + ! threshold. Also returns the number of small PFTs found. + ! + ! !USES: + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(inout) :: this + real(r8), intent(in) :: too_small ! threshold for considering a PFT too small (% of grid cell) + integer , intent(out) :: nsmall ! number of small (but non-zero) PFTs found + ! + ! !LOCAL VARIABLES: + integer :: pft_lbound + integer :: pft_ubound + integer :: pft_index + real(r8), allocatable :: pct_p2g(:) ! % of each pft on the grid cell + logical , allocatable :: is_small(:) ! whether each PFT is considered too small (but not 0) + logical , allocatable :: is_zero(:) ! whether each PFT is exactly 0 + + character(len=*), parameter :: subname = 'remove_small_cover' + !----------------------------------------------------------------------- + + pft_lbound = lbound(this%pct_p2l, 1) + pft_ubound = ubound(this%pct_p2l, 1) + allocate(pct_p2g (pft_lbound : pft_ubound)) + allocate(is_small(pft_lbound : pft_ubound)) + allocate(is_zero (pft_lbound : pft_ubound)) + + pct_p2g(:) = this%get_pct_p2g() + is_zero(:) = (pct_p2g == 0._r8) + is_small(:) = (pct_p2g < too_small .and. .not. is_zero(:)) + + nsmall = count(is_small(:)) + + if (nsmall > 0) then + + if (all(is_zero(:) .or. is_small(:))) then + ! If all PFTs are either 0 or small, then set pct_l2g to 0, but don't touch + ! pct_p2l(:) (We do NOT set pct_p2l to all 0 in this case, because we need to + ! maintain sum(pct_p2l) = 100%) + this%pct_l2g = 0._r8 + + else + ! If there are some big PFTs, then we need to adjust pct_p2l as well as pct_l2g + ! (setting pct_p2l to 0 for the small elements and renormalizing the others) + do pft_index = pft_lbound, pft_ubound + if (is_small(pft_index)) then + call this%set_one_pct_p2g(pft_index, 0._r8) + end if + end do + end if + + call this%check_vals(subname) + end if + + deallocate(pct_p2g, is_small, is_zero) + end subroutine remove_small_cover + + + + ! ======================================================================== + ! Private member functions + ! ======================================================================== + + !----------------------------------------------------------------------- + subroutine convert_from_p2g(this, pct_p2g, default_pct_p2l) + ! + ! !DESCRIPTION: + ! Given a p2g array, compute the p2l array and l2g + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(inout) :: this + real(r8), intent(in) :: pct_p2g(:) ! % of each pft on the grid cell + real(r8), intent(in) :: default_pct_p2l(:) ! default % of each pft on the landunit, used if total landunit area is 0% + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'convert_from_p2g' + !----------------------------------------------------------------------- + + ! Check pre-conditions + + if (size(pct_p2g) /= size(this%pct_p2l) .or. size(default_pct_p2l) /= size(this%pct_p2l)) then + write(6,*) subname//' ERROR: array size mismatch: ' + write(6,*) size(pct_p2g), size(default_pct_p2l), size(this%pct_p2l) + call abort() + end if + + if (abs(sum(default_pct_p2l) - 100._r8) > tol) then + write(6,*) subname//' ERROR: default_pct_p2l must sum to 100' + call abort() + end if + + if (any(pct_p2g < 0._r8)) then + write(6,*) subname//' ERROR: negative values found in pct_p2g array' + write(6,*) pct_p2g + call abort() + end if + + if (sum(pct_p2g) < 0._r8 .or. sum(pct_p2g) > (100._r8 + tol)) then + write(6,*) subname//' ERROR: pct_p2g must be between 0 and 100' + write(6,*) 'sum(pct_p2g) = ', sum(pct_p2g) + call abort() + end if + + ! Done checking pre-conditions + + this%pct_l2g = sum(pct_p2g) + if (this%pct_l2g > 0._r8) then + this%pct_p2l = pct_p2g / this%pct_l2g * 100._r8 + else + this%pct_p2l = default_pct_p2l + end if + + ! Check post-conditions + + call this%check_vals(subname) + + end subroutine convert_from_p2g + + + !----------------------------------------------------------------------- + subroutine check_vals(this, caller) + ! + ! !DESCRIPTION: + ! Perform a sanity check after setting values + ! + ! !ARGUMENTS: + class(pct_pft_type), intent(in) :: this + character(len=*), intent(in) :: caller ! name of the calling subroutine + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'check_vals' + !----------------------------------------------------------------------- + + if (abs(sum(this%pct_p2l) - 100._r8) > tol) then + write(6,*) subname//' ERROR from ', caller, ': pct_p2l does not sum to 100' + write(6,*) 'sum(this%pct_p2l) = ', sum(this%pct_p2l) + call abort() + end if + + if (any(this%pct_p2l < 0._r8)) then + write(6,*) subname//' ERROR from ', caller, ': negative values found in pct_p2l' + write(6,*) this%pct_p2l + call abort() + end if + + if (this%pct_l2g < 0._r8 .or. this%pct_l2g > (100._r8 + tol)) then + write(6,*) subname//' ERROR from ', caller, ': pct_l2g must be between 0 and 100' + write(6,*) 'pct_l2g = ', this%pct_l2g + call abort() + end if + + end subroutine check_vals + + ! ======================================================================== + ! Module-level routines (not member functions) + ! ======================================================================== + + !----------------------------------------------------------------------- + function get_pct_p2l_array(pct_pft_arr) result(pct_p2l) + ! + ! !DESCRIPTION: + ! Given an array of pct_pft_type variables, return a 2-d array of pct_p2l. + ! + ! Assumes that all elements of pct_pft_arr have the same size and lower bound for + ! their pct_p2l array. + ! + ! !ARGUMENTS: + real(r8), allocatable :: pct_p2l(:,:) ! function result (n_elements, n_pfts) + ! workaround for gfortran bug (58043): declare this 'type' rather than 'class': + type(pct_pft_type), intent(in) :: pct_pft_arr(:) + ! + ! !LOCAL VARIABLES: + integer :: pft_lbound + integer :: pft_ubound + integer :: arr_index + integer :: pft_index + + character(len=*), parameter :: subname = 'get_pct_p2l_array' + !----------------------------------------------------------------------- + + pft_lbound = lbound(pct_pft_arr(1)%pct_p2l, 1) + pft_ubound = ubound(pct_pft_arr(1)%pct_p2l, 1) + + allocate(pct_p2l(size(pct_pft_arr), pft_lbound:pft_ubound)) + + do arr_index = 1, size(pct_pft_arr) + if (lbound(pct_pft_arr(arr_index)%pct_p2l, 1) /= pft_lbound .or. & + ubound(pct_pft_arr(arr_index)%pct_p2l, 1) /= pft_ubound) then + write(6,*) subname//' ERROR: all elements of pct_pft_arr must have' + write(6,*) 'the same size and lower bound for their pct_p2l array' + call abort() + end if + + do pft_index = pft_lbound, pft_ubound + pct_p2l(arr_index, pft_index) = pct_pft_arr(arr_index)%pct_p2l(pft_index) + end do + end do + + end function get_pct_p2l_array + + !----------------------------------------------------------------------- + function get_pct_l2g_array(pct_pft_arr) result(pct_l2g) + ! + ! !DESCRIPTION: + ! Given an array of pct_pft_type variables, return an array of pct_l2g. + ! + ! !ARGUMENTS: + real(r8), allocatable :: pct_l2g(:) ! function result + class(pct_pft_type), intent(in) :: pct_pft_arr(:) + ! + ! !LOCAL VARIABLES: + integer :: arr_index + + character(len=*), parameter :: subname = 'get_pct_l2g_array' + !----------------------------------------------------------------------- + + allocate(pct_l2g(size(pct_pft_arr))) + pct_l2g = pct_pft_arr(:)%pct_l2g + + end function get_pct_l2g_array + + +end module mkpctPftTypeMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkpeatMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpeatMod.F90 new file mode 100644 index 0000000000..72ebec7d6d --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpeatMod.F90 @@ -0,0 +1,136 @@ +module mkpeatMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkpeatMod +! +! !DESCRIPTION: +! make fraction peat from input peat data +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mkpeat ! regrid peat data +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpeat +! +! !INTERFACE: +subroutine mkpeat(ldomain, mapfname, datfname, ndiag, peat_o) +! +! !DESCRIPTION: +! make peat +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_area + use mkchecksMod, only : min_bad, max_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: peat_o(:) ! output grid: fraction peat +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Sam Levis and Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid = 0._r8 ! minimum valid value + real(r8), parameter :: max_valid = 100.000001_r8 ! maximum valid value + character(len=32) :: subname = 'mkpeat' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make peat .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read( tdomain, datfname ) + + call gridmap_mapread( tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open peat file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Regrid peat + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'peatf', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, peat_o, nodata=0._r8) + + ! Check validity of output data + if (min_bad(peat_o, min_valid, 'peat') .or. & + max_bad(peat_o, max_valid, 'peat')) then + stop + end if + + call output_diagnostics_area(data_i, peat_o, tgridmap, "Peat", percent=.false., ndiag=ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made peat' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkpeat + + +end module mkpeatMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 new file mode 100644 index 0000000000..0355f9b696 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftConstantsMod.F90 @@ -0,0 +1,43 @@ +module mkpftConstantsMod + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: mkpftConstants + ! + ! !DESCRIPTION: + ! Constants used by mkpft and related code + ! + ! !REVISION HISTORY: + ! Author: Bill Sacks + ! + !----------------------------------------------------------------------- + !!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + ! + ! !PUBLIC DATA MEMBERS: + ! + + integer, parameter, public :: maxpft = 78 ! maximum # of PFT + + integer, public :: num_natpft ! number of PFTs on the natural vegetation + ! landunit, NOT including bare ground + ! (includes generic crops for runs with + ! create_crop_landunit=false) + + integer, public :: num_cft ! number of CFTs on the crop landunit + integer, public :: natpft_lb ! lower bound for natural pft arrays + integer, public :: natpft_ub ! upper bound for natural pft arrays + integer, public :: cft_lb ! lower bound for cft arrays + integer, public :: cft_ub ! upper bound for cft arrays + + integer, parameter, public :: baregroundindex = 0 ! index of bare ground in a natural pft array + + ! The following is NOT set as a parameter so that it can be overridden in unit tests + integer, public :: c3cropindex = 15 + integer, public :: c3irrcropindex = 16 + +end module mkpftConstantsMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 new file mode 100644 index 0000000000..62b050e58f --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftMod.F90 @@ -0,0 +1,901 @@ +module mkpftMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkpft +! +! !DESCRIPTION: +! Make PFT data +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkvarctl , only : numpft + use mkdomainMod , only : domain_checksame + use mkpftConstantsMod + + implicit none + + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mkpftInit ! Initialization + public mkpft ! Set PFT + public mkpft_parse_oride ! Parse the string with PFT fraction/index info to override + public mkpftAtt ! Write out attributes to output file on pft +! +! !PUBLIC DATA MEMBERS: +! + + ! + ! When pft_idx and pft_frc are set, they must be set together, and they will cause the + ! entire area to be covered with vegetation and zero out other landunits. + ! The sum of pft_frc must = 100%, and each pft_idx point in the array corresponds to + ! the fraction in pft_frc. Only the first few points are used until pft_frc = 0.0. + ! + integer :: m ! index + integer, public :: pft_idx(0:maxpft) = & ! PFT vegetation index to override with + (/ ( -1, m = 0, maxpft ) /) + real(r8), public :: pft_frc(0:maxpft) = & ! PFT vegetation fraction to override with + (/ ( 0.0_r8, m = 0, maxpft ) /) +! +! !PRIVATE DATA MEMBERS: +! + logical, private :: zero_out = .false. ! Flag to zero out PFT + logical, private :: use_input_pft = .false. ! Flag to override PFT with input values + integer, private :: nzero ! index of first zero fraction +! +! !PRIVATE MEMBER FUNCTIONS: +! + private :: mkpft_check_oride ! Check the pft_frc and pft_idx values for correctness +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpftInit +! +! !INTERFACE: +subroutine mkpftInit( zero_out_l, all_veg ) +! +! !DESCRIPTION: +! Initialize of Make PFT data +! !USES: + use mkvarpar, only : numstdpft, numstdcft +! +! !ARGUMENTS: + implicit none + logical, intent(IN) :: zero_out_l ! If veg should be zero'ed out + logical, intent(OUT) :: all_veg ! If should zero out other fractions so that + ! all land-cover is vegetation +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8), parameter :: hndrd = 100.0_r8 ! A hundred percent + character(len=32) :: subname = 'mkpftMod::mkpftInit() ' +!----------------------------------------------------------------------- + write (6, '(a, a, a)') "In ", trim(subname), "..." + call mkpft_check_oride( ) + if ( use_input_pft ) then + if ( maxpft < numpft ) then + write(6,*) subname//'number PFT is > max allowed!' + call abort() + end if + write(6,*) 'Set PFT fraction to : ', pft_frc(0:nzero-1) + write(6,*) 'With PFT index : ', pft_idx(0:nzero-1) + end if + + all_veg = use_input_pft + + if ( zero_out_l .and. all_veg )then + write(6,*) subname//'zeroing out vegetation and setting vegetation to 100% is a contradiction!' + call abort() + end if + + ! Copy local zero out to module data version + zero_out = zero_out_l + + ! Determine number of PFTs on the natural vegetation landunit, and number of CFTs on + ! the crop landunit. + ! + ! For the sake of dynamic PFTs and dynamic landunits, it helps for the structure of the + ! surface dataset to reflect the subgrid structure that will be used by CLM. Currently + ! (3-21-13), this means that, when we create a surface dataset without the extra + ! specific crops, the generic crops go on the natural vegetation landunit (because in + ! this case, we run with create_crop_landunit=.false.); when we create a surface dataset + ! WITH the extra specific crops, all crops (including the generic crops) go on the crop + ! landunit (in this case, we run with create_crop_landunit=.true.). However, in the + ! future, we plan to start setting create_crop_landunit=.true. always, in which case the + ! generic crops will always go on the crop landunit, regardless of whether or not we're + ! using the extra specific crops. + + if ( numpft == numstdpft) then + num_natpft = numpft + num_cft = 0 + else if ( numpft > numstdpft ) then + num_natpft = numstdpft - numstdcft + num_cft = numpft - num_natpft + else + write(6,*) 'Unhandled numpft: ', numpft + call abort() + end if + + ! Determine array bounds for arrays of just natural pfts and just crops. Note that + ! these are set up so that they always span 0:numpft, so that there is a 1:1 + ! correspondence between an element in a full 0:numpft array and an element with the + ! same index in either a natpft array or a cft array. + natpft_lb = 0 + natpft_ub = num_natpft + cft_lb = num_natpft+1 + cft_ub = cft_lb + num_cft - 1 + + ! Make sure the array indices have been set up properly, to ensure the 1:1 + ! correspondence mentioned above + if (cft_ub /= numpft) then + write(6,*) 'CFT_UB set up incorrectly: cft_ub, numpft = ', cft_ub, numpft + call abort() + end if + +end subroutine mkpftInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft +! +! !INTERFACE: +subroutine mkpft(ldomain, mapfname, fpft, ndiag, allow_no_crops, & + pctlnd_o, pctnatpft_o, pctcft_o, & + pctcft_o_saved) +! +! !DESCRIPTION: +! Make PFT data +! +! This dataset consists of the %cover of the [numpft]+1 PFTs used by +! the model. The input %cover pertains to the "vegetated" portion of the +! grid cell and sums to 100. The real portion of each grid cell +! covered by each PFT is the PFT cover times the fraction of the +! grid cell that is land. This is the quantity preserved when +! area-averaging from the input (1/2 degree) grid to the models grid. +! +! Upon return from this routine, the % cover of the natural veg + crop landunits is +! generally 100% everywhere; this will be normalized later to account for special landunits. +! +! If allow_no_crops is true, then we allow the input dataset to have no prognostic crop +! information (i.e., only contain information about the "standard" PFTs). In this case, +! pctcft_o_saved MUST be given. If the input dataset is found to not have information +! about the prognostic crops, then we take the generic c3 crop cover from the input +! dataset to specify the crop landunit area, and we take the individual crop breakdown +! from pctcft_o_saved (which will generally have come from some other input dataset that +! DID contain prognostic crop information). +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio + use mkpctPftTypeMod, only : pct_pft_type + use mkpftUtilsMod, only : convert_from_p2g +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(inout) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: fpft ! input pft dataset file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: allow_no_crops ! if it's okay to not have prognostic crops in the input file + real(r8) , intent(out):: pctlnd_o(:) ! output grid:%land/gridcell + type(pct_pft_type), intent(out):: pctnatpft_o(:) ! natural PFT cover + type(pct_pft_type), intent(out):: pctcft_o(:) ! crop (CFT) cover + +! saved crop cover information, in case the input dataset does not contain information about prognostic crops + type(pct_pft_type), intent(in), optional :: pctcft_o_saved(:) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: pctpft_i(:,:) ! input grid: PFT percent + real(r8), allocatable :: pctpft_o(:,:) ! output grid: PFT percent (% of grid cell) + integer :: numpft_i ! num of plant types input data + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: wst_sum ! sum of %pft + real(r8), allocatable :: gpft_o(:) ! output grid: global area pfts + real(r8) :: garea_o ! output grid: global area + real(r8), allocatable :: gpft_i(:) ! input grid: global area pfts + real(r8) :: garea_i ! input grid: global area + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + logical :: missing_crops ! if we need prognostic crop info, but the input dataset is missing this crop info + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + + character(len=35) veg(0:maxpft) ! vegetation types + character(len=32) :: subname = 'mkpftMod::mkpft()' +!----------------------------------------------------------------------- + + write (6,*) + write (6, '(a, a, a)') "In ", trim(subname), "..." + write (6,*) 'Attempting to make PFTs .....' + call shr_sys_flush(6) + + if (allow_no_crops) then + if (.not. present(pctcft_o_saved)) then + write(6,*) subname, ' ERROR: when allow_no_crops is true, pctcft_o_saved must be given' + call abort() + end if + end if + + ! Start by assuming the input dataset is NOT missing crop info + missing_crops = .false. + + ! ----------------------------------------------------------------- + ! Set the vegetation types + ! ----------------------------------------------------------------- + if ( numpft >= numstdpft )then + veg(0:maxpft) = (/ & + 'not vegetated ', & + 'needleleaf evergreen temperate tree', & + 'needleleaf evergreen boreal tree ', & + 'needleleaf deciduous boreal tree ', & + 'broadleaf evergreen tropical tree ', & + 'broadleaf evergreen temperate tree ', & + 'broadleaf deciduous tropical tree ', & + 'broadleaf deciduous temperate tree ', & + 'broadleaf deciduous boreal tree ', & + 'broadleaf evergreen shrub ', & + 'broadleaf deciduous temperate shrub', & + 'broadleaf deciduous boreal shrub ', & + 'c3 arctic grass ', & + 'c3 non-arctic grass ', & + 'c4 grass ', & + 'c3_crop ', & + 'c3_irrigated ', & + 'temperate_corn ', & + 'irrigated_temperate_corn ', & + 'spring_wheat ', & + 'irrigated_spring_wheat ', & + 'winter_wheat ', & + 'irrigated_winter_wheat ', & + 'temperate_soybean ', & + 'irrigated_temperate_soybean ', & + 'barley ', & + 'irrigated_barley ', & + 'winter_barley ', & + 'irrigated_winter_barley ', & + 'rye ', & + 'irrigated_rye ', & + 'winter_rye ', & + 'irrigated_winter_rye ', & + 'cassava ', & + 'irrigated_cassava ', & + 'citrus ', & + 'irrigated citrus ', & + 'cocoa ', & + 'irrigated_cocoa ', & + 'coffee ', & + 'irrigated_coffee ', & + 'cotton ', & + 'irrigated_cotton ', & + 'datepalm ', & + 'irrigated_datepalm ', & + 'foddergrass ', & + 'irrigated_foddergrass ', & + 'grapes ', & + 'irrigated_grapes ', & + 'groundnuts ', & + 'irrigated_groundnuts ', & + 'millet ', & + 'irrigated_millet ', & + 'oilpalm ', & + 'irrigated_oilpalm ', & + 'potatoes ', & + 'irrigated_potatoes ', & + 'pulses ', & + 'irrigated_pulses ', & + 'rapeseed ', & + 'irrigated_rapeseed ', & + 'rice ', & + 'irrigated_rice ', & + 'sorghum ', & + 'irrigated_sorghum ', & + 'sugarbeet ', & + 'irrigated_sugarbeet ', & + 'sugarcane ', & + 'irrigated_sugarcane ', & + 'sunflower ', & + 'irrigated_sunflower ', & + 'miscanthus ', & + 'irrigated_miscanthus ', & + 'switchgrass ', & + 'irrigated_switchgrass ', & + 'tropical_corn ', & + 'irrigated_tropical_corn ', & + 'tropical_soybean ', & + 'irrigated_tropical_soybean ' /) + end if + if ( numpft == numstdpft )then + write(6,*)'Creating surface datasets with the standard # of PFTs =', numpft + else if ( numpft > numstdpft )then + write(6,*)'Creating surface datasets with extra types for crops; total pfts =', numpft + else + write(6,*) subname//': parameter numpft is NOT set to a known value (should be 16 or more) =',numpft + call abort() + end if + + ! ----------------------------------------------------------------- + ! Read input PFT file + ! ----------------------------------------------------------------- + + ns_o = ldomain%ns + + if ( .not. use_input_pft ) then + ! Obtain input grid info, read PCT_PFT + + call domain_read(tdomain,fpft) + ns_i = tdomain%ns + + write (6,*) 'Open PFT file: ', trim(fpft) + call check_ret(nf_open(fpft, 0, ncid), subname) + + call check_ret(nf_inq_dimid (ncid, 'pft', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, numpft_i), subname) + + ! Check if the number of pfts on the input matches the expected number. A mismatch + ! is okay in the case that the input has the standard number of pfts (i.e., no + ! prognostic crop info), if allow_no_crops is true. Otherwise, a mismatch is an error. + if (numpft_i .ne. numpft+1) then + if (numpft_i .eq. numstdpft+1) then + if (allow_no_crops) then + write(6,*) subname//': using non-crop input file for a surface dataset with crops' + write(6,*) "(this is okay: we'll use the saved crop breakdown from the non-transient input file)" + missing_crops = .true. + else + write(6,*) subname//' ERROR: trying to use non-crop input file' + write(6,*) 'for a surface dataset with crops, but allow_no_crops is false' + write(6,*) "(This can happen if you're trying to use a non-crop input file" + write(6,*) "for the surface dataset itself: a non-crop input file is only" + write(6,*) "allowed for the transient PFT information.)" + call abort() + end if + else + write(6,*) subname//': parameter numpft+1= ',numpft+1, & + 'does not equal input dataset numpft= ',numpft_i + call abort() + end if + endif + + allocate(pctpft_i(ns_i,0:(numpft_i-1)), & + pctpft_o(ns_o,0:(numpft_i-1)), & + stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'PCT_PFT', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, pctpft_i), subname) + + call check_ret(nf_close(ncid), subname) + + else + ns_i = 1 + numpft_i = numpft+1 + allocate(pctpft_o(ns_o,0:numpft), stat=ier) + if (ier/=0) call abort() + end if + + ! Determine pctpft_o on output grid + + if ( zero_out ) then + + pctpft_o(:,:) = 0._r8 + pctlnd_o(:) = 100._r8 + + else if ( use_input_pft ) then + + call mkpft_check_oride( ) + + ! set PFT based on input pft_frc and pft_idx + pctpft_o(:,:) = 0._r8 + pctlnd_o(:) = 100._r8 + do m = 0, numpft + ! Once reach a PFT where fraction goes to zero -- exit + if ( pft_frc(m) .eq. 0.0_r8 ) exit + do no = 1,ns_o + pctpft_o(no,pft_idx(m)) = pft_frc(m) + end do + end do + + else + + ! Compute pctlnd_o, pctpft_o + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + ! Area-average percent cover on input grid [pctpft_i] to output grid + ! [pctpft_o] and correct [pctpft_o] according to land landmask + ! Note that percent cover is in terms of total grid area. + + do no = 1,ns_o + pctlnd_o(no) = tgridmap%frac_dst(no) * 100._r8 + ldomain%frac(no) = tgridmap%frac_dst(no) + end do + + do m = 0, numpft_i - 1 + call gridmap_areaave(tgridmap, pctpft_i(:,m), pctpft_o(:,m), nodata=0._r8) + do no = 1,ns_o + if (pctlnd_o(no) < 1.0e-6) then + if (m == 0) then + pctpft_o(no,m) = 100._r8 + else + pctpft_o(no,m) = 0._r8 + endif + end if + enddo + enddo + + end if + + ! Error check: percents should sum to 100 for land grid cells, within roundoff + ! Also correct sums so that if they differ slightly from 100, they are corrected to + ! equal 100 more exactly. + + if ( .not. zero_out) then + do no = 1,ns_o + wst_sum = 0. + do m = 0, numpft_i - 1 + wst_sum = wst_sum + pctpft_o(no,m) + enddo + if (abs(wst_sum-100._r8) > 0.00001_r8) then + write (6,*) subname//'error: pft = ', & + (pctpft_o(no,m), m = 0, numpft_i-1), & + ' do not sum to 100. at no = ',no,' but to ', wst_sum + stop + end if + + ! Correct sum so that if it differs slightly from 100, it is corrected to equal + ! 100 more exactly + do m = 0, numpft_i - 1 + pctpft_o(no,m) = pctpft_o(no,m) * 100._r8 / wst_sum + end do + + end do + end if + + ! ----------------------------------------------------------------- + ! Error check + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + if ( .not. (zero_out .or. use_input_pft) ) then + + allocate(gpft_i(0:numpft_i-1)) + allocate(gpft_o(0:numpft_i-1)) + + ! input grid + + gpft_i(:) = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + do m = 0, numpft_i - 1 + gpft_i(m) = gpft_i(m) + pctpft_i(ni,m)*tgridmap%area_src(ni)*& + tgridmap%frac_src(ni)*re**2 + end do + end do + if ( allocated(pctpft_i) ) deallocate (pctpft_i) + + ! output grid + + gpft_o(:) = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + do m = 0, numpft_i - 1 + gpft_o(m) = gpft_o(m) + pctpft_o(no,m)*tgridmap%area_dst(no)*& + tgridmap%frac_dst(no)*re**2 + end do + end do + + ! comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'PFTs Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'plant type ',20x,' input grid area',' output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + do m = 0, numpft_i - 1 + write (ndiag,1002) veg(m), gpft_i(m)*1.e-06/100.,gpft_o(m)*1.e-06/100. + end do +1002 format (1x,a35,f16.3,f17.3) + call shr_sys_flush(ndiag) + + deallocate(gpft_i, gpft_o) + + end if + + + ! Convert % pft as % of grid cell to % pft on the landunit and % of landunit on the + ! grid cell + if (missing_crops) then + do no = 1,ns_o + call convert_from_p2g(pct_p2g=pctpft_o(no,:), pctcft_saved=pctcft_o_saved(no), & + pctnatpft=pctnatpft_o(no), pctcft=pctcft_o(no)) + end do + else + do no = 1,ns_o + call convert_from_p2g(pct_p2g=pctpft_o(no,:), & + pctnatpft=pctnatpft_o(no), pctcft=pctcft_o(no)) + end do + end if + + ! Deallocate dynamic memory + + deallocate(pctpft_o) + call domain_clean(tdomain) + if ( .not. zero_out .and. .not. use_input_pft ) then + call gridmap_clean(tgridmap) + end if + + write (6,*) 'Successfully made PFTs' + write (6,*) + + +end subroutine mkpft + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft_parse_oride +! +! !INTERFACE: +subroutine mkpft_parse_oride( string ) +! +! !DESCRIPTION: +! Parse the string with pft fraction and index information on it, to override +! the file with this information rather than reading from a file. +! +! !USES: + use shr_string_mod, only: shr_string_betweenTags, shr_string_countChar +! !ARGUMENTS: + character(len=256), intent(IN) :: string ! String to parse with PFT fraction + ! and index data +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: rc ! error return code + integer :: num_elms ! number of elements + character(len=256) :: substring ! string between tags + character(len=*), parameter :: frc_start = "" + character(len=*), parameter :: frc_end = "" + character(len=*), parameter :: idx_start = "" + character(len=*), parameter :: idx_end = "" + character(len=*), parameter :: subname = 'mkpft_parse_oride' + !----------------------------------------------------------------------- + + ! NOTE(bja, 2015-02) pft_frc and pft_index can be reset multiple + ! times by calls to this function. If the number of elements being + ! set is different each time, then we are working with out of date + ! information, and the sums may not sum to 100%. + pft_frc = 0.0_r8 + pft_idx = -1 + + call shr_string_betweenTags( string, frc_start, frc_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding pft_frac start end tags' + call abort() + end if + num_elms = shr_string_countChar( substring, ",", rc ) + read(substring,*) pft_frc(0:num_elms) + call shr_string_betweenTags( string, idx_start, idx_end, substring, rc ) + if ( rc /= 0 )then + write(6,*) subname//'Trouble finding pft_index start end tags' + call abort() + end if + if ( num_elms /= shr_string_countChar( substring, ",", rc ) )then + write(6,*) subname//'number of elements different between frc and idx fields' + call abort() + end if + read(substring,*) pft_idx(0:num_elms) +!----------------------------------------------------------------------- + +end subroutine mkpft_parse_oride + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpft_check_oride +! +! !INTERFACE: +subroutine mkpft_check_oride( ) +! +! !DESCRIPTION: +! Check that the pft override values are valid +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i, j ! indices + real(r8) :: sumpft ! Sum of pft_frc + real(r8), parameter :: hndrd = 100.0_r8 ! A hundred percent + character(len=32) :: subname = 'mkpftMod::mkpft_check_oride() ' +!----------------------------------------------------------------------- + + sumpft = sum(pft_frc) + if ( sumpft == 0.0 )then + ! PFT fraction is NOT used + use_input_pft = .false. + else if ( abs(sumpft - hndrd) > 1.e-6 )then + write(6, '(a, a, f15.12)') trim(subname), 'Sum of PFT fraction is NOT equal to 100% =', sumpft + write(6,*) 'Set PFT fraction to : ', pft_frc(0:nzero-1) + write(6,*) 'With PFT index : ', pft_idx(0:nzero-1) + call abort() + else + use_input_pft = .true. + nzero = 0 + do i = 0, numpft + if ( pft_frc(i) == 0.0_r8 )then + nzero = i + exit + end if + end do + ! PFT fraction IS used, and sum is OK, now check details + do i = 0, nzero -1 + if ( pft_frc(i) < 0.0_r8 .or. pft_frc(i) > hndrd )then + write(6,*) subname//'PFT fraction is out of range: pft_frc=', pft_frc(i) + call abort() + else if ( pft_frc(i) > 0.0_r8 .and. pft_idx(i) == -1 )then + write(6,*) subname//'PFT fraction > zero, but index NOT set: pft_idx=', pft_idx(i) + call abort() + end if + ! PFT index out of range + if ( pft_idx(i) < 0 .or. pft_idx(i) > numpft )then + write(6,*) subname//'PFT index is out of range: ', pft_idx(i) + call abort() + end if + ! Make sure index values NOT used twice + do j = 0, i-1 + if ( pft_idx(i) == pft_idx(j) )then + write(6,*) subname//'Same PFT index is used twice: ', pft_idx(i) + call abort() + end if + end do + end do + ! Make sure the rest of the fraction is zero and index are not set as well + do i = nzero, numpft + if ( pft_frc(i) /= 0.0_r8 .or. pft_idx(i) /= -1 )then + write(6,*) subname//'After PFT fraction is zeroed out, fraction is non zero, or index set' + call abort() + end if + end do + end if + +end subroutine mkpft_check_oride + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkpftAtt +! +! !INTERFACE: +subroutine mkpftAtt( ncid, dynlanduse, xtype ) +! +! !DESCRIPTION: +! make PFT attributes on the output file +! + use mkncdio , only : check_ret, ncd_defvar, ncd_def_spatial_var + use fileutils , only : get_filename + use mkvarctl , only : mksrf_fvegtyp, mksrf_flai + use mkvarpar + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ncid ! NetCDF file ID to write out to + logical, intent(in) :: dynlanduse ! if dynamic land-use file + integer, intent(in) :: xtype ! external type to output real data as +! +! !CALLED FROM: +! subroutine mkfile in module mkfileMod +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: pftsize ! size of lsmpft dimension + integer :: natpftsize ! size of natpft dimension + integer :: dimid ! input netCDF id's + character(len=256) :: str ! global attribute string + character(len=32) :: subname = 'mkpftAtt' + + ! Define dimensions + call check_ret(nf_def_dim (ncid, 'time' , nf_unlimited, dimid), subname) + + if (.not. dynlanduse) then + pftsize = numpft + 1 + call check_ret(nf_def_dim (ncid, 'lsmpft' , pftsize , dimid), subname) + end if + + natpftsize = num_natpft + 1 + call check_ret(nf_def_dim (ncid, 'natpft' , natpftsize , dimid), subname) + + ! zero-size dimensions can cause problems, so we only include the cft dimension if num_cft > 0 + ! Note that this implies that we can only include PCT_CFT on the dataset if num_cft > 0 + if (num_cft > 0) then + call check_ret(nf_def_dim (ncid, 'cft' , num_cft , dimid), subname) + end if + + ! Add global attributes + + if (.not. dynlanduse) then + str = get_filename(mksrf_flai) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Lai_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + + if ( use_input_pft ) then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'pft_override', len_trim(str), trim(str)), subname) + else if ( zero_out )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'zero_out_pft_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fvegtyp) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Vegetation_type_raw_data_filename', len_trim(str), trim(str)), subname) + end if + + ! Define variables + + ! Coordinate variable for indices of natural PFTs + call ncd_defvar(ncid=ncid, varname='natpft', xtype=nf_int, & + dim1name='natpft', long_name='indices of natural PFTs', units='index') + + ! Coordinate variable for indices of CFTs + if (num_cft > 0) then + call ncd_defvar(ncid=ncid, varname='cft', xtype=nf_int, & + dim1name='cft', long_name='indices of CFTs', units='index') + end if + + call ncd_def_spatial_var(ncid=ncid, varname='LANDFRAC_PFT', xtype=nf_double, & + long_name='land fraction from pft dataset', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PFTDATA_MASK', xtype=nf_int, & + long_name='land mask from pft dataset, indicative of real/fake points', units='unitless') + + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='PCT_NATVEG', xtype=xtype, & + long_name='total percent natural vegetation landunit', units='unitless') + end if + + ! PCT_CROP + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='PCT_CROP', xtype=xtype, & + long_name='total percent crop landunit', units='unitless') + else + call ncd_def_spatial_var(ncid=ncid, varname='PCT_CROP', xtype=xtype, & + lev1name='time', & + long_name='total percent crop landunit', units='unitless') + end if + + ! PCT_NAT_PFT + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='PCT_NAT_PFT', xtype=xtype, & + lev1name='natpft', & + long_name='percent plant functional type on the natural veg landunit (% of landunit)', units='unitless') + else + call ncd_def_spatial_var(ncid=ncid, varname='PCT_NAT_PFT', xtype=xtype, & + lev1name='natpft', lev2name='time', & + long_name='percent plant functional type on the natural veg landunit (% of landunit)', units='unitless') + end if + + ! PCT_CFT + if (num_cft > 0) then + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='PCT_CFT', xtype=xtype, & + lev1name='cft', & + long_name='percent crop functional type on the crop landunit (% of landunit)', units='unitless') + else + call ncd_def_spatial_var(ncid=ncid, varname='PCT_CFT', xtype=xtype, & + lev1name='cft', lev2name='time', & + long_name='percent crop functional type on the crop landunit (% of landunit)', units='unitless') + end if + end if + + ! LAI,SAI,HTOP,HBOT + if (.not. dynlanduse) then + call ncd_def_spatial_var(ncid=ncid, varname='MONTHLY_LAI', xtype=xtype, & + lev1name='lsmpft', lev2name='time', & + long_name='monthly leaf area index', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='MONTHLY_SAI', xtype=xtype, & + lev1name='lsmpft', lev2name='time', & + long_name='monthly stem area index', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='MONTHLY_HEIGHT_TOP', xtype=xtype, & + lev1name='lsmpft', lev2name='time', & + long_name='monthly height top', units='meters') + + call ncd_def_spatial_var(ncid=ncid, varname='MONTHLY_HEIGHT_BOT', xtype=xtype, & + lev1name='lsmpft', lev2name='time', & + long_name='monthly height bottom', units='meters') + end if + + ! OTHER + if (dynlanduse) then + call ncd_defvar(ncid=ncid, varname='YEAR', xtype=nf_int, & + dim1name='time', & + long_name='Year of PFT data', units='unitless') + call ncd_defvar(ncid=ncid, varname='time', xtype=nf_int, & + dim1name='time', & + long_name='year', units='unitless') + call ncd_defvar(ncid=ncid, varname='input_pftdata_filename', xtype=nf_char, & + dim1name='nchar', & + dim2name='time', & + long_name='Input filepath for PFT values for this year', units='unitless') + else + call ncd_defvar(ncid=ncid, varname='time', xtype=nf_int, & + dim1name='time', & + long_name='Calendar month', units='month') + end if + +end subroutine mkpftAtt + +!----------------------------------------------------------------------- + +end module mkpftMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftUtilsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftUtilsMod.F90 new file mode 100644 index 0000000000..4a9ea12f97 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkpftUtilsMod.F90 @@ -0,0 +1,257 @@ +module mkpftUtilsMod + + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: mkpftUtils + ! + ! !DESCRIPTION: + ! Lower-level utilities used in making PFT data. + ! + ! These are separated out from mkpftMod mainly as an aid to testing. + ! + ! !REVISION HISTORY: + ! Author: Bill Sacks + ! + !----------------------------------------------------------------------- + !!USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + ! + ! !PUBLIC MEMBER FUNCTIONS: + ! + public :: convert_from_p2g ! Convert a p2g array into pct_pft_type objects + public :: adjust_total_veg_area ! Adjust the total vegetated area (natural veg & crop) to a new specified total + + ! + ! !PRIVATE MEMBER FUNCTIONS: + ! + + private :: get_default_natpft ! Get the default natural pft breakdown, for a 0-area natural veg. landunit + private :: get_default_cft ! Get the default cft breakdown, for a 0-area crop landunit + + interface convert_from_p2g + module procedure convert_from_p2g_default + module procedure convert_from_p2g_missing_crops + end interface convert_from_p2g + + !EOP + !=============================================================== +contains + !=============================================================== + + !----------------------------------------------------------------------- + subroutine convert_from_p2g_default(pct_p2g, pctnatpft, pctcft) + ! + ! !DESCRIPTION: + ! Given the % of each pft on the grid cell, create pct_pft_type objects that give % of + ! each pft on the landunit and % of each landunit on the grid cell. + ! + ! !USES: + use mkpctPftTypeMod , only : pct_pft_type + use mkpftConstantsMod, only : natpft_lb, natpft_ub, num_cft, cft_lb, cft_ub + ! + ! !ARGUMENTS: + real(r8), intent(in) :: pct_p2g(natpft_lb:) ! % of each pft on the grid cell (includes crops as well as natural veg types) + type(pct_pft_type), intent(out) :: pctnatpft ! natural PFT cover + type(pct_pft_type), intent(out) :: pctcft ! crop (CFT) COVER + ! + ! !LOCAL VARIABLES: + real(r8), allocatable :: default_natpft(:) ! default p2l for natural PFTs, for grid cells where the current size of the natural veg landunit is 0 + real(r8), allocatable :: default_cft(:) ! default p2l for CFTs, for grid cells where the current size of the crop landunit is 0 + + character(len=*), parameter :: subname = 'convert_from_p2g_default' + !----------------------------------------------------------------------- + + if (ubound(pct_p2g, 1) /= cft_ub) then + write(6,*) subname, ' ERROR: upper bound of pct_p2g should be cft_ub' + write(6,*) 'ubound(pct_p2g), cft_ub = ', ubound(pct_p2g), cft_ub + call abort() + end if + + allocate(default_natpft(natpft_lb:natpft_ub)) + default_natpft = get_default_natpft() + pctnatpft = pct_pft_type(pct_p2g(natpft_lb:natpft_ub), natpft_lb, default_natpft) + deallocate(default_natpft) + + if (num_cft > 0) then + allocate(default_cft(cft_lb:cft_ub)) + default_cft = get_default_cft() + pctcft = pct_pft_type(pct_p2g(cft_lb:cft_ub), cft_lb, default_cft) + deallocate(default_cft) + else + ! create an empty placeholder, with 0 area on the grid cell + pctcft = pct_pft_type() + end if + + end subroutine convert_from_p2g_default + + !----------------------------------------------------------------------- + subroutine convert_from_p2g_missing_crops(pct_p2g, pctcft_saved, pctnatpft, pctcft) + ! + ! !DESCRIPTION: + ! Given the % of each pft on the grid cell, create pct_pft_type objects that give % + ! of each pft on the landunit and % of each landunit on the grid cell. + ! + ! This version of the routine assumes that pct_p2g only includes the standard PFTs - + ! not prognostic crops. It takes the relative crop cover from pctcft_saved, and uses + ! the % cover of the generic c3 crop in pct_p2g to specify the total crop landunit + ! area. + ! + ! Typically, pct_p2g will have an upper bound of numstdpft; however, this is not + ! assumed. Any upper bound is fine as long as the upper bound is greater than + ! natpft_ub and includes c3cropindex. + ! + ! Assumptions: + ! - We are running with prognostic crops (i.e., NOT an empty crop landunit - although + ! it's fine for the crop landunit area to be 0%) + ! - In pct_p2g, the only non-zero areas should be: + ! - Areas of PFTs on the natural veg landunit + ! - The area of the generic c3 crop + ! + ! !USES: + use mkpctPftTypeMod , only : pct_pft_type + use mkpftConstantsMod , only : c3cropindex, natpft_lb, natpft_ub, num_cft + ! + ! !ARGUMENTS: + real(r8), intent(in) :: pct_p2g(natpft_lb:) ! % of each pft on the grid cell (includes crops as well as natural veg types) + type(pct_pft_type), intent(in) :: pctcft_saved ! saved crop cover information, used to specify the relative cover of each crop + type(pct_pft_type), intent(out) :: pctnatpft ! natural PFT cover + type(pct_pft_type), intent(out) :: pctcft ! crop (CFT) COVER + ! + ! !LOCAL VARIABLES: + real(r8), allocatable :: default_natpft(:) ! default p2l for natural PFTs, for grid cells where the current size of the natural veg landunit is 0 + integer :: pft_index + real(r8) :: crop_area ! area of the crop landunit on the grid cell + + character(len=*), parameter :: subname = 'convert_from_p2g_missing_crops' + !----------------------------------------------------------------------- + + ! Error checking on inputs + + if (num_cft == 0) then + write(6,*) subname, ' ERROR: this routine should only be called when running with prognostic crops' + write(6,*) '(i.e., with num_cft > 0)' + call abort() + end if + + do pft_index = natpft_ub + 1, ubound(pct_p2g, 1) + if (pft_index /= c3cropindex .and. pct_p2g(pft_index) > 0._r8) then + write(6,*) subname, ' ERROR: in pct_p2g, the only non-zero areas should be:' + write(6,*) ' - areas of PFTs on the natural veg landunit' + write(6,*) ' - the area of the generic c3 crop' + write(6,*) '(we do not currently handle the case where the transient input dataset' + write(6,*) 'has non-zero areas for both pft 15 and pft 16)' + write(6,*) 'pft_index, area = ', pft_index, pct_p2g(pft_index) + call abort() + end if + end do + + ! Done error checking on inputs + + allocate(default_natpft(natpft_lb:natpft_ub)) + default_natpft = get_default_natpft() + pctnatpft = pct_pft_type(pct_p2g(natpft_lb:natpft_ub), natpft_lb, default_natpft) + deallocate(default_natpft) + + pctcft = pctcft_saved + crop_area = pct_p2g(c3cropindex) + call pctcft%set_pct_l2g(crop_area) + + end subroutine convert_from_p2g_missing_crops + + !----------------------------------------------------------------------- + function get_default_natpft() result(default_natpft) + ! + ! !DESCRIPTION: + ! Get the default natural pft breakdown, for a 0-area natural veg. landunit. + ! + ! Currently we use the same default everywhere. In the future, we could change this + ! to compute default_natpft based on some function of location (e.g., different + ! values for high latitudes than low latitudes, etc.). + ! + ! !USES: + use mkpftConstantsMod, only : baregroundindex, natpft_lb, natpft_ub + ! + ! !ARGUMENTS: + real(r8), allocatable :: default_natpft(:) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_default_natpft' + !----------------------------------------------------------------------- + + allocate(default_natpft(natpft_lb:natpft_ub)) + default_natpft(:) = 0._r8 + default_natpft(baregroundindex) = 100._r8 + + end function get_default_natpft + + !----------------------------------------------------------------------- + function get_default_cft() result(default_cft) + ! + ! !DESCRIPTION: + ! Get the default cft breakdown, for a 0-area crop landunit. + ! + ! !USES: + use mkpftConstantsMod, only : c3cropindex, cft_lb, cft_ub + ! + ! !ARGUMENTS: + real(r8), allocatable :: default_cft(:) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'get_default_cft' + !----------------------------------------------------------------------- + + allocate(default_cft(cft_lb:cft_ub)) + default_cft(:) = 0._r8 + default_cft(c3cropindex) = 100._r8 + + end function get_default_cft + + + !----------------------------------------------------------------------- + subroutine adjust_total_veg_area(new_total_pct, pctnatpft, pctcft) + ! + ! !DESCRIPTION: + ! Adjust the total vegetated area on the grid cell (natural veg & crop) to a new + ! specified total. + ! + ! If the old areas are 0%, then all the new area goes into pctnatpft. + ! + ! !USES: + use mkpctPftTypeMod, only : pct_pft_type + ! + ! !ARGUMENTS: + real(r8), intent(in) :: new_total_pct ! new total % of natural veg + crop landunits + class(pct_pft_type), intent(inout) :: pctnatpft ! natural veg cover information + class(pct_pft_type), intent(inout) :: pctcft ! crop cover information + ! + ! !LOCAL VARIABLES: + real(r8) :: natpft_l2g ! grid cell % cover of nat. veg. + real(r8) :: cft_l2g ! grid cell % cover of crop + real(r8) :: old_total ! old total % cover of natural veg + crop landunits + + character(len=*), parameter :: subname = 'adjust_total_veg_area' + !----------------------------------------------------------------------- + + natpft_l2g = pctnatpft%get_pct_l2g() + cft_l2g = pctcft%get_pct_l2g() + old_total = natpft_l2g + cft_l2g + if (old_total > 0._r8) then + call pctnatpft%set_pct_l2g(natpft_l2g * new_total_pct / old_total) + call pctcft%set_pct_l2g(cft_l2g * new_total_pct / old_total) + else + call pctnatpft%set_pct_l2g(new_total_pct) + end if + + end subroutine adjust_total_veg_area + + +end module mkpftUtilsMod + + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 new file mode 100644 index 0000000000..1192863737 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mksoilMod.F90 @@ -0,0 +1,1409 @@ +module mksoilMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mksoilMod +! +! !DESCRIPTION: +! Make soil data (texture, color and organic) +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +!!USES: + use shr_kind_mod, only : r8 => shr_kind_r8, r4=>shr_kind_r4 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + implicit none + + SAVE + private ! By default make data private +! +! !PUBLIC MEMBER FUNCTIONS: +! + public mksoilInit ! Soil Initialization + + public mksoilAtt ! Add attributes to output file + + public mksoiltex ! Set soil texture + public mkorganic ! Set organic soil + public mksoilcol ! Set soil color + public mkfmax ! Make percent fmax +! +! !PUBLIC DATA MEMBERS: +! + real(r8), public, parameter :: unset = -999.99_r8 ! Flag to signify soil texture override not set + real(r8), public :: soil_sand = unset ! soil texture sand % to override with + real(r8), public :: soil_clay = unset ! soil texture clay % to override with + real(r8), public :: soil_fmax = unset ! soil max saturation frac to override with + integer , parameter :: unsetcol = -999 ! flag to indicate soil color NOT set + integer , public :: soil_color= unsetcol ! soil color to override with +! +! !PRIVATE DATA MEMBERS: +! +! !PRIVATE MEMBER FUNCTIONS: + private :: mkrank + private :: mksoiltexInit ! Soil texture Initialization + private :: mksoilcolInit ! Soil color Initialization + private :: mksoilfmaxInit ! Soil fmax Initialization + +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilInit +! +! !INTERFACE: +subroutine mksoilInit( ) +! +! !DESCRIPTION: +! Initialize the different soil types +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + character(len=32) :: subname = 'mksoilInit' +!----------------------------------------------------------------------- + call mksoiltexInit() + call mksoilcolInit() + call mksoilfmaxInit() + +end subroutine mksoilInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoiltexInit +! +! !INTERFACE: +subroutine mksoiltexInit( ) +! +! !DESCRIPTION: +! Initialize of make soil texture +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoiltexInit' +!----------------------------------------------------------------------- + if ( soil_clay /= unset )then + write(6,*) 'Replace soil clay % for all points with: ', soil_clay + if ( soil_sand == unset )then + write (6,*) subname//':error: soil_clay set, but NOT soil_sand' + call abort() + end if + end if + if ( soil_sand /= unset )then + write(6,*) 'Replace soil sand % for all points with: ', soil_sand + if ( soil_clay == unset )then + write (6,*) subname//':error: soil_sand set, but NOT soil_clay' + call abort() + end if + sumtex = soil_sand + soil_clay + if ( sumtex < 0.0_r8 .or. sumtex > 100.0_r8 )then + write (6,*) subname//':error: soil_sand and soil_clay out of bounds: sand, clay = ', & + soil_sand, soil_clay + call abort() + end if + end if + +end subroutine mksoiltexInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoiltex +! +! !INTERFACE: +subroutine mksoiltex(ldomain, mapfname, datfname, ndiag, sand_o, clay_o) +! +! !DESCRIPTION: +! make %sand and %clay from IGBP soil data, which includes +! igbp soil 'mapunits' and their corresponding textures +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: sand_o(:,:) ! % sand (output grid) + real(r8) , intent(out):: clay_o(:,:) ! % clay (output grid) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + character(len=38) :: typ ! soil texture based on ... + integer :: nlay ! number of soil layers + integer :: mapunitmax ! max value of igbp soil mapunits + integer :: mapunittemp ! temporary igbp soil mapunit + integer :: maxovr + integer , allocatable :: novr(:) + integer , allocatable :: kmap(:,:) + real(r8), allocatable :: kwgt(:,:) + integer , allocatable :: kmax(:) + real(r8), allocatable :: wst(:) + real(r8), allocatable :: sand_i(:,:) ! input grid: percent sand + real(r8), allocatable :: clay_i(:,:) ! input grid: percent clay + real(r8), allocatable :: mapunit_i(:) ! input grid: igbp soil mapunits + integer, parameter :: num=2 ! set soil mapunit number + integer :: wsti(num) ! index to 1st and 2nd largest wst + integer, parameter :: nlsm=4 ! number of soil textures + character(len=38) :: soil(0:nlsm) ! name of each soil texture + real(r8) :: gast_i(0:nlsm) ! global area, by texture type + real(r8) :: gast_o(0:nlsm) ! global area, by texture type + real(r8) :: wt ! map overlap weight + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + integer :: l,k,n,m,ni,no,ns_i,ns_o ! indices + integer :: k1,k2 ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + integer :: miss = 99999 ! missing data indicator + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + logical :: found ! temporary + integer :: kmap_max ! maximum overlap weights + integer, parameter :: kmap_max_min = 90 ! kmap_max mininum value + integer, parameter :: km_mx_ns_prod = 160000 ! product of kmap_max*ns_o to keep constant + character(len=32) :: subname = 'mksoiltex' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %sand and %clay .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Define the model surface types: 0 to nlsm + ! ----------------------------------------------------------------- + + soil(0) = 'no soil: ocean, glacier, lake, no data' + soil(1) = 'clays ' + soil(2) = 'sands ' + soil(3) = 'loams ' + soil(4) = 'silts ' + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + ns_o = ldomain%ns + + write (6,*) 'Open soil texture file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_dimid (ncid, 'number_of_layers', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlay), subname) + + call check_ret(nf_inq_dimid (ncid, 'max_value_mapunit', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, mapunitmax), subname) + + allocate(sand_i(mapunitmax,nlay), & + clay_i(mapunitmax,nlay), & + mapunit_i(ns_i), stat=ier) + if (ier/=0) call abort() + + call check_ret(nf_inq_varid (ncid, 'MAPUNITS', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, mapunit_i), subname) + + call check_ret(nf_inq_varid (ncid, 'PCT_SAND', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, sand_i), subname) + + call check_ret(nf_inq_varid (ncid, 'PCT_CLAY', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, clay_i), subname) + + call check_ret(nf_close(ncid), subname) + + ! Compute local fields _o + if (soil_sand==unset .and. soil_clay==unset) then + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! kmap_max are the maximum number of mapunits that will consider on + ! any output gridcell - this is set currently above and can be changed + ! kmap(:) are the mapunit values on the input grid + ! kwgt(:) are the weights on the input grid + + allocate(novr(ns_o)) + novr(:) = 0 + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + novr(no) = novr(no) + 1 + end do + maxovr = maxval(novr(:)) + kmap_max = min(maxovr,max(kmap_max_min,km_mx_ns_prod/ns_o)) + deallocate(novr) + + write(6,*)'kmap_max= ',kmap_max,' maxovr= ',maxovr,' ns_o= ',ns_o,' size= ',(kmap_max+1)*ns_o + + allocate(kmap(0:kmap_max,ns_o), stat=ier) + if (ier/=0) call abort() + allocate(kwgt(0:kmap_max,ns_o), stat=ier) + if (ier/=0) call abort() + allocate(kmax(ns_o), stat=ier) + if (ier/=0) call abort() + allocate(wst(0:kmap_max), stat=ier) + if (ier/=0) call abort() + + kwgt(:,:) = 0. + kmap(:,:) = 0 + kmax(:) = 0 + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + if (tgridmap%frac_src(ni) > 0) then + k = mapunit_i(ni) + else + k = 0 + end if + found = .false. + do l = 0,kmax(no) + if (k == kmap(l,no)) then + kwgt(l,no) = kwgt(l,no) + wt + kmap(l,no) = k + found = .true. + exit + end if + end do + if (.not. found) then + kmax(no) = kmax(no) + 1 + if (kmax(no) > kmap_max) then + write(6,*)'kmax is > kmap_max= ',kmax(no), 'kmap_max = ', & + kmap_max,' for no = ',no + write(6,*)'reset kmap_max in mksoilMod to a greater value' + stop + end if + kmap(kmax(no),no) = k + kwgt(kmax(no),no) = wt + end if + enddo + + end if + + do no = 1,ns_o + + if (soil_sand==unset .and. soil_clay==unset) then + wst(:) = 0. + wst(0:kmax(no)) = kwgt(0:kmax(no),no) + + ! Rank non-zero weights by soil mapunit. + ! k1 is the most extensive mapunit. + ! k2 is the second most extensive mapunit. + + if (maxval(wst(:)) > 0) then + call mkrank (kmax(no)+1, wst(0:kmax(no)), miss, wsti, num) + k1 = kmap(wsti(1),no) + if (wsti(2) == miss) then + k2 = miss + else + k2 = kmap(wsti(2),no) + end if + else + k1 = 0 + k2 = 0 + end if + + end if + + ! Set soil texture as follows: + ! a. Use dominant igbp soil mapunit based on area of overlap unless + ! 'no data' is dominant + ! b. In this case use second most dominant mapunit if it has data + ! c. If this has no data or if there isn't a second most dominant + ! mapunit, use loam for soil texture + + if (soil_sand/=unset .and. soil_clay/=unset) then !---soil texture is input + do l = 1, nlay + sand_o(no,l) = soil_sand + clay_o(no,l) = soil_clay + end do + else if (k1 /= 0) then !---not 'no data' + do l = 1, nlay + sand_o(no,l) = sand_i(k1,l) + clay_o(no,l) = clay_i(k1,l) + end do + else !---if (k1 == 0) then + if (k2 == 0 .or. k2 == miss) then !---no data + do l = 1, nlay + sand_o(no,l) = 43. !---use loam + clay_o(no,l) = 18. + end do + else !---if (k2 /= 0 and /= miss) + do l = 1, nlay + sand_o(no,l) = sand_i(k2,l) + clay_o(no,l) = clay_i(k2,l) + end do + end if !---end of k2 if-block + end if !---end of k1 if-block + + enddo + + if (soil_sand==unset .and. soil_clay==unset) then + + ! Global sum of output field + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKSOILTEX error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global area of each soil type on input and output grids + ! ----------------------------------------------------------------- + + ! input grid: global areas by texture class + + gast_i(:) = 0. + do l = 1, nlay + do ni = 1,ns_i + mapunittemp = nint(mapunit_i(ni)) + if (mapunittemp==0) then + typ = 'no soil: ocean, glacier, lake, no data' + else if (clay_i(mapunittemp,l) >= 40.) then + typ = 'clays' + else if (sand_i(mapunittemp,l) >= 50.) then + typ = 'sands' + else if (clay_i(mapunittemp,l)+sand_i(mapunittemp,l) < 50.) then + if (tdomain%mask(ni) /= 0.) then + typ = 'silts' + else !if (tdomain%mask(ni) == 0.) then no data + typ = 'no soil: ocean, glacier, lake, no data' + end if + else + typ = 'loams' + end if + do m = 0, nlsm + if (typ == soil(m)) go to 101 + end do + write (6,*) 'MKSOILTEX error: sand = ',sand_i(mapunittemp,l), & + ' clay = ',clay_i(mapunittemp,l), & + ' not assigned to soil type for input grid lon,lat,layer = ',ni,l + call abort() +101 continue + gast_i(m) = gast_i(m) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + end do + + ! output grid: global areas by texture class + + gast_o(:) = 0. + do l = 1, nlay + do no = 1,ns_o + if (clay_o(no,l)==0. .and. sand_o(no,l)==0.) then + typ = 'no soil: ocean, glacier, lake, no data' + else if (clay_o(no,l) >= 40.) then + typ = 'clays' + else if (sand_o(no,l) >= 50.) then + typ = 'sands' + else if (clay_o(no,l)+sand_o(no,l) < 50.) then + typ = 'silts' + else + typ = 'loams' + end if + do m = 0, nlsm + if (typ == soil(m)) go to 102 + end do + write (6,*) 'MKSOILTEX error: sand = ',sand_o(no,l), & + ' clay = ',clay_o(no,l), & + ' not assigned to soil type for output grid lon,lat,layer = ',no,l + call abort() +102 continue + gast_o(m) = gast_o(m) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',l=1,70) + write (ndiag,*) 'Soil Texture Output' + write (ndiag,'(1x,70a1)') ('=',l=1,70) + write (ndiag,*) + + write (ndiag,*) 'The following table of soil texture classes is for comparison only.' + write (ndiag,*) 'The actual data is continuous %sand, %silt and %clay not textural classes' + write (ndiag,*) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',l=1,70) + write (ndiag,1001) +1001 format (1x,'soil texture class',17x,' input grid area output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',l=1,70) + write (ndiag,*) + + do l = 0, nlsm + write (ndiag,1002) soil(l),gast_i(l)*1.e-6,gast_o(l)*1.e-6 +1002 format (1x,a38,f16.3,f17.3) + end do + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if (soil_sand==unset .and. soil_clay==unset) then + call gridmap_clean(tgridmap) + deallocate (kmap, kwgt, kmax, wst) + deallocate (sand_i,clay_i,mapunit_i) + end if + + + write (6,*) 'Successfully made %sand and %clay' + write (6,*) + call shr_sys_flush(6) + +end subroutine mksoiltex + +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilcolInit +! +! !INTERFACE: +subroutine mksoilcolInit( ) +! +! !DESCRIPTION: +! Initialize of make soil color +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoilcolInit' +!----------------------------------------------------------------------- + + ! Error check soil_color if it is set + if ( soil_color /= unsetcol )then + if ( soil_color < 0 .or. soil_color > 20 )then + write(6,*)'soil_color is out of range = ', soil_color + call abort() + end if + write(6,*) 'Replace soil color for all points with: ', soil_color + end if +end subroutine mksoilcolInit + + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilcol +! +! !INTERFACE: +subroutine mksoilcol(ldomain, mapfname, datfname, ndiag, & + soil_color_o, nsoicol) +! +! !DESCRIPTION: +! make %sand and %clay from IGBP soil data, which includes +! igbp soil 'mapunits' and their corresponding textures +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + integer , intent(out):: soil_color_o(:) ! soil color classes + integer , intent(out):: nsoicol ! number of soil colors +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + integer, parameter :: num=2 ! set soil mapunit number + integer :: wsti(num) ! index to 1st and 2nd largest wst + real(r8), allocatable :: wst(:,:) ! overlap weights, by surface type + real(r8), allocatable :: gast_i(:) ! global area, by surface type + real(r8), allocatable :: gast_o(:) ! global area, by surface type + integer , allocatable :: soil_color_i(:) ! input grid: BATS soil color + integer , allocatable :: color(:) ! 0: none; 1: some + real(r8) :: wt ! map overlap weight + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + character(len=35), allocatable :: col(:) ! name of each color + integer :: k,l,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + integer :: miss = 99999 ! missing data indicator + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mksoilcol' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make soil color classes .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ns_o = ldomain%ns + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(soil_color_i(ns_i), stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open soil color file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'SOIL_COLOR', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, soil_color_i), subname) + call check_ret(nf_close(ncid), subname) + + nsoicol = maxval(soil_color_i) + write(6,*)'nsoicol = ',nsoicol + + allocate(gast_i(0:nsoicol),gast_o(0:nsoicol),col(0:nsoicol)) + + ! ----------------------------------------------------------------- + ! Define the model color classes: 0 to nsoicol + ! ----------------------------------------------------------------- + + if (nsoicol == 20) then + col(0) = 'no soil ' + col(1) = 'class 1: light ' + col(2) = 'class 2: ' + col(3) = 'class 3: ' + col(4) = 'class 4: ' + col(5) = 'class 5: ' + col(6) = 'class 6: ' + col(7) = 'class 7: ' + col(8) = 'class 8: ' + col(9) = 'class 9: ' + col(10) = 'class 10: ' + col(11) = 'class 11: ' + col(12) = 'class 12: ' + col(13) = 'class 13: ' + col(14) = 'class 14: ' + col(15) = 'class 15: ' + col(16) = 'class 16: ' + col(17) = 'class 17: ' + col(18) = 'class 18: ' + col(19) = 'class 19: ' + col(20) = 'class 20: dark ' + else if (nsoicol == 8) then + col(0) = 'no soil ' + col(1) = 'class 1: light ' + col(2) = 'class 2: ' + col(3) = 'class 3: ' + col(4) = 'class 4: ' + col(5) = 'class 5: ' + col(6) = 'class 6: ' + col(7) = 'class 7: ' + col(8) = 'class 8: dark ' + else + write(6,*)'nsoicol value of ',nsoicol,' is not currently supported' + call abort() + end if + + ! Error check soil_color if it is set + if ( soil_color /= unsetcol )then + if ( soil_color > nsoicol )then + write(6,*)'soil_color is out of range = ', soil_color + call abort() + end if + + do no = 1,ns_o + soil_color_o(no) = soil_color + end do + + else + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! find area of overlap for each soil color for each no + + allocate(wst(0:nsoicol,ns_o)) + wst(0:nsoicol,:) = 0 + allocate(color(ns_o)) + color(:) = 0 + + ! TODO: need to do a loop to determine + ! the maximum number of over lap cells throughout the grid + ! first get an array that is novr(ns_o) and fill this in - then set + ! maxovr - to max(novr) - then allocate the array wst to be size of + ! maxovr,ns_o or 0:nsoilcol,ns_o + + do n = 1,tgridmap%ns + ni = tgridmap%src_indx(n) + no = tgridmap%dst_indx(n) + wt = tgridmap%wovr(n) + k = soil_color_i(ni) * tdomain%mask(ni) + wst(k,no) = wst(k,no) + wt + if (k>0 .and. wst(k,no)>0.) then + color(no) = 1 + wst(0,no) = 0.0 + end if + enddo + + soil_color_o(:) = 0 + do no = 1,ns_o + + ! Rank non-zero weights by color type. wsti(1) is the most extensive + ! color type. + + if (color(no) == 1) then + call mkrank (nsoicol, wst(0:nsoicol,no), miss, wsti, num) + soil_color_o(no) = wsti(1) + end if + + ! If land but no color, set color to 15 (in older dataset generic + ! soil color 4) + + if (nsoicol == 8) then + if (soil_color_o(no)==0) soil_color_o(no) = 4 + else if (nsoicol == 20) then + if (soil_color_o(no)==0) soil_color_o(no) = 15 + end if + + ! Error checks + + if (soil_color_o(no) < 0 .or. soil_color_o(no) > nsoicol) then + write (6,*) 'MKSOILCOL error: land model soil color = ', & + soil_color_o(no),' is not valid for lon,lat = ',no + call abort() + end if + + enddo + deallocate (wst) + deallocate (color) + + ! Global sum of output field + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKSOILCOL error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global area of each soil color on input and output grids + ! ----------------------------------------------------------------- + + gast_i(:) = 0. + do ni = 1,ns_i + k = soil_color_i(ni) + gast_i(k) = gast_i(k) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end do + + gast_o(:) = 0. + do no = 1,ns_o + k = soil_color_o(no) + gast_o(k) = gast_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end do + + ! area comparison + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Soil Color Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1001) +1001 format (1x,'soil color type',20x,' input grid area output grid area',/ & + 1x,33x,' 10**6 km**2',' 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + do k = 0, nsoicol + write (ndiag,1002) col(k),gast_i(k)*1.e-6,gast_o(k)*1.e-6 +1002 format (1x,a35,f16.3,f17.3) + end do + + end if + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + if ( soil_color == unsetcol )then + call gridmap_clean(tgridmap) + end if + deallocate (soil_color_i,gast_i,gast_o,col) + + write (6,*) 'Successfully made soil color classes' + write (6,*) + call shr_sys_flush(6) + +end subroutine mksoilcol + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkorganic +! +! !INTERFACE: +subroutine mkorganic(ldomain, mapfname, datfname, ndiag, organic_o) +! +! !DESCRIPTION: +! make organic matter dataset +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: organic_o(:,:) ! output grid: +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! +! Author: David Lawrence +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: organic_i(:,:) ! input grid: total column organic matter + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gomlev_i ! input grid: global organic on lev + real(r8) :: garea_i ! input grid: global area + real(r8) :: gomlev_o ! output grid: global organic on lev + real(r8) :: garea_o ! output grid: global area + integer :: k,n,m,ni,no,ns_i ! indices + integer :: lev ! level index + integer :: nlay ! number of soil layers + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkorganic' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make organic matter dataset .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + + write (6,*) 'Open soil organic file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + call check_ret(nf_inq_dimid (ncid, 'number_of_layers', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, nlay), subname) + + allocate(organic_i(ns_i,nlay),stat=ier) + if (ier/=0) call abort() + if (nlay /= nlevsoi) then + write(6,*)'nlay, nlevsoi= ',nlay,nlevsoi,' do not match' + stop + end if + + call check_ret(nf_inq_varid (ncid, 'ORGANIC', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, organic_i), subname) + + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + do lev = 1,nlay + call gridmap_areaave(tgridmap, organic_i(:,lev), organic_o(:,lev), nodata=0._r8) + end do + + do lev = 1,nlevsoi + + ! Check for conservation + + do no = 1,ldomain%ns + if ((organic_o(no,lev)) > 130.000001_r8) then + write (6,*) 'MKORGANIC error: organic = ',organic_o(no,lev), & + ' greater than 130.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + +! ! Diagnostic output + + ! TODO: there is nothing being written out here currently - all zeroes + ! So for now these are commented out +!!$ write (ndiag,*) +!!$ write (ndiag,'(1x,70a1)') ('.',k=1,70) +!!$ write (ndiag,2001) +!!$2001 format (1x,'surface type input grid area output grid area'/ & +!!$ 1x,' 10**6 km**2 10**6 km**2 ') +!!$ write (ndiag,'(1x,70a1)') ('.',k=1,70) +!!$ write (ndiag,*) +!!$ write (ndiag,2002) gomlev_i*1.e-06,gomlev_o*1.e-06 +!!$ write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +!!$2002 format (1x,'organic ',f14.3,f17.3) +!!$2004 format (1x,'all surface ',f14.3,f17.3) +!!$ + call shr_sys_flush(ndiag) + + write (6,*) 'Successfully made organic matter, level = ', lev + call shr_sys_flush(6) + + end do ! lev + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (organic_i) + + write (6,*) 'Successfully made organic matter' + call shr_sys_flush(6) + write(6,*) + +end subroutine mkorganic + +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: mkrank +! +! !INTERFACE: +subroutine mkrank (n, a, miss, iv, num) +! +! !DESCRIPTION: +! Return indices of largest [num] values in array [a]. Private method +! only used for soil color and soil texture. +! +! !USES: +! +! !ARGUMENTS: + implicit none + integer , intent(in) :: n !array length + real(r8), intent(in) :: a(0:n) !array to be ranked + integer , intent(in) :: miss !missing data value + integer , intent(in) :: num !number of largest values requested + integer , intent(out):: iv(num) !index to [num] largest values in array [a] +! +! !CALLED FROM: +! subroutine mksoilcol +! subroutine mksoiltex +! +! !REVISION HISTORY: +! Author: Gordon Bonan +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) a_max !maximum value in array + integer i !array index + real(r8) delmax !tolerance for finding if larger value + integer m !do loop index + integer k !do loop index + logical exclude !true if data value has already been chosen +!----------------------------------------------------------------------- + + delmax = 1.e-06 + + ! Find index of largest non-zero number + + iv(1) = miss + a_max = -9999. + + do i = 0, n + if (a(i)>0. .and. (a(i)-a_max)>delmax) then + a_max = a(i) + iv(1) = i + end if + end do + + ! iv(1) = miss indicates no values > 0. this is an error + + if (iv(1) == miss) then + write (6,*) 'MKRANK error: iv(1) = missing' + call abort() + end if + + ! Find indices of the next [num]-1 largest non-zero number. + ! iv(m) = miss if there are no more values > 0 + + do m = 2, num + iv(m) = miss + a_max = -9999. + do i = 0, n + + ! exclude if data value has already been chosen + + exclude = .false. + do k = 1, m-1 + if (i == iv(k)) exclude = .true. + end do + + ! if not already chosen, see if it is the largest of + ! the remaining values + + if (.not. exclude) then + if (a(i)>0. .and. (a(i)-a_max)>delmax) then + a_max = a(i) + iv(m) = i + end if + end if + end do + end do + +end subroutine mkrank + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilfmaxInit +! +! !INTERFACE: +subroutine mksoilfmaxInit( ) +! +! !DESCRIPTION: +! Initialize of make soil fmax +! !USES: +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sumtex + character(len=32) :: subname = 'mksoilfmaxInit' +!----------------------------------------------------------------------- + + ! Error check soil_fmax if it is set + if ( soil_fmax /= unset )then + if ( soil_fmax < 0.0 .or. soil_fmax > 1.0 )then + write(6,*)'soil_fmax is out of range = ', soil_fmax + stop + end if + write(6,*) 'Replace soil fmax for all points with: ', soil_fmax + end if + +end subroutine mksoilfmaxInit + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkfmax +! +! !INTERFACE: +subroutine mkfmax(ldomain, mapfname, datfname, ndiag, fmax_o) +! +! !DESCRIPTION: +! make percent fmax +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: fmax_o(:) ! output grid: %fmax +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Revised: Nan Rosenbloom - used mkglacier.F90 as template. +! Original Author: Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: fmax_i(:) ! input grid: percent fmax + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + real(r8) :: gfmax_i ! input grid: global fmax + real(r8) :: garea_i ! input grid: global area + real(r8) :: gfmax_o ! output grid: global fmax + real(r8) :: garea_o ! output grid: global area + integer :: k,n,m,ni,no,ns_i,ns_o ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkfmax' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %fmax .....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(fmax_i(ns_i), stat=ier) + if (ier/=0) call abort() + ns_o = ldomain%ns + + write (6,*) 'Open soil fmax file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'FMAX', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, fmax_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine fmax_o on output grid + + ! In points with no data, use globalAvg + ! (WJS (3-11-13): use real(.365783,r8) rather than .365783_r8 to maintain bfb results + ! with old code) + call gridmap_areaave(tgridmap, fmax_i, fmax_o, nodata=real(.365783,r8)) + + ! Check for conservation + + do no = 1, ns_o + if ((fmax_o(no)) > 1.000001_r8) then + write (6,*) 'MKFMAX error: fmax = ',fmax_o(no), & + ' greater than 1.000001 for column, row = ',no + call shr_sys_flush(6) + stop + end if + enddo + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0. + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1.) > relerr ) then + write (6,*) 'MKFMAX error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + gfmax_i = 0. + garea_i = 0. + do ni = 1,ns_i + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gfmax_i = gfmax_i + fmax_i(ni)*(tgridmap%area_src(ni)/100.)* & + tgridmap%frac_src(ni)*re**2 + end do + + gfmax_o = 0. + garea_o = 0. + do no = 1,ns_o + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gfmax_o = gfmax_o + fmax_o(no)*(tgridmap%area_dst(no)/100.) * & + tgridmap%frac_dst(no)*re**2 + if ((tgridmap%mask_dst(no) > 0)) then + if ((tgridmap%frac_dst(no) < 0.0) .or. (tgridmap%frac_dst(no) > 1.0001)) then + write(6,*) "ERROR:: frac out of range: ", tgridmap%frac_dst(no),no + stop + end if + end if + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Maximum Fractional Saturated Area Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2002) gfmax_i*1.e-06,gfmax_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'fmax ',f14.3,f17.3) +2004 format (1x,'all surface ',f14.3,f17.3) + + write (6,*) 'Successfully made %fmax' + write (6,*) + call shr_sys_flush(6) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (fmax_i) + +end subroutine mkfmax + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mksoilAtt +! +! !INTERFACE: +subroutine mksoilAtt( ncid, dynlanduse, xtype ) +! +! !DESCRIPTION: +! add atttributes to output file regarding the soil module +! +! !USES: + use fileutils , only : get_filename + use mkncdio , only : check_ret, ncd_defvar, ncd_def_spatial_var + use mkvarpar + use mkvarctl + +! !ARGUMENTS: + implicit none + include 'netcdf.inc' + integer, intent(in) :: ncid ! NetCDF file ID to write out to + logical, intent(in) :: dynlanduse ! if dynamic land-use file + integer, intent(in) :: xtype ! external type to output real data as +! +! !CALLED FROM: +! subroutine mkfile in module mkfileMod +! +! !REVISION HISTORY: +! Original Author: Erik Kluzek +! +! +! !LOCAL VARIABLES: +!EOP + integer :: dimid ! temporary + character(len=256) :: str ! global attribute string + character(len=32) :: subname = 'mksoilAtt' +!----------------------------------------------------------------------- + + if (.not. dynlanduse) then + + ! Define dimensions unique to soil + + call check_ret(nf_def_dim (ncid, 'nlevsoi', & + nlevsoi , dimid), subname) + + ! Add global attributes to file + + if ( soil_clay /= unset .and. soil_sand /= unset )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_clay_override', len_trim(str), trim(str)), subname) + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_sand_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fsoitex) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Soil_texture_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + if ( soil_color /= unsetcol )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_color_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fsoicol) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Soil_color_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + if ( soil_fmax /= unset )then + str = 'TRUE' + call check_ret(nf_put_att_text (ncid, NF_GLOBAL, & + 'soil_fmax_override', len_trim(str), trim(str)), subname) + else + str = get_filename(mksrf_fmax) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Fmax_raw_data_file_name', len_trim(str), trim(str)), subname) + end if + str = get_filename(mksrf_forganic) + call check_ret(nf_put_att_text(ncid, NF_GLOBAL, & + 'Organic_matter_raw_data_file_name', len_trim(str), trim(str)), subname) + + ! Define variables + + call ncd_defvar(ncid=ncid, varname='mxsoil_color', xtype=nf_int, & + long_name='maximum numbers of soil colors', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='SOIL_COLOR', xtype=nf_int, & + long_name='soil color', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_SAND', xtype=xtype, & + lev1name='nlevsoi', & + long_name='percent sand', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='PCT_CLAY', xtype=xtype, & + lev1name='nlevsoi', & + long_name='percent clay', units='unitless') + + call ncd_def_spatial_var(ncid=ncid, varname='ORGANIC', xtype=xtype, & + lev1name='nlevsoi', & + long_name='organic matter density at soil levels', & + units='kg/m3 (assumed carbon content 0.58 gC per gOM)') + + call ncd_def_spatial_var(ncid=ncid, varname='FMAX', xtype=xtype, & + long_name='maximum fractional saturated area', units='unitless') + + end if + +end subroutine mksoilAtt + +!----------------------------------------------------------------------- + +end module mksoilMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 new file mode 100644 index 0000000000..e7196fd32d --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mksurfdat.F90 @@ -0,0 +1,1527 @@ +program mksurfdat + +!----------------------------------------------------------------------- +!BOP +! +! !PROGRAM: mksurfdat +! +! !DESCRIPTION: +! Creates land model surface dataset from original "raw" data files. +! Surface dataset contains model grid, pfts, inland water, glacier, +! soil texture, soil color, LAI and SAI, urban fraction, and urban +! parameters. +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8, r4 => shr_kind_r4 + use fileutils , only : opnfil, getavu + use mklaiMod , only : mklai + use mkpctPftTypeMod , only : pct_pft_type, get_pct_p2l_array, get_pct_l2g_array + use mkpftConstantsMod , only : natpft_lb, natpft_ub, cft_lb, cft_ub, num_cft + use mkpftMod , only : pft_idx, pft_frc, mkpft, mkpftInit, mkpft_parse_oride + use mksoilMod , only : soil_sand, soil_clay, mksoiltex, mksoilInit, & + soil_color, mksoilcol, mkorganic, & + soil_fmax, mkfmax + use mkvocefMod , only : mkvocef + use mklanwatMod , only : mklakwat, mkwetlnd, mklakparams + use mkglcmecMod , only : nglcec, mkglcmec, mkglcmecInit, mkglacier + use mkharvestMod , only : mkharvest, mkharvest_init, mkharvest_fieldname, & + mkharvest_numtypes, mkharvest_parse_oride + use mkurbanparCommonMod, only : mkelev + use mkurbanparMod , only : mkurbanInit, mkurban, mkurbanpar, numurbl + use mkutilsMod , only : normalize_classes_by_gcell + use mkfileMod , only : mkfile + use mkvarpar , only : nlevsoi, elev_thresh + use mkvarctl + use nanMod , only : nan, bigint + use mkncdio , only : check_ret, ncd_put_time_slice + use mkdomainMod , only : domain_type, domain_read_map, domain_read, & + domain_write + use mkgdpMod , only : mkgdp + use mkpeatMod , only : mkpeat + use mkagfirepkmonthMod , only : mkagfirepkmon + use mktopostatsMod , only : mktopostats + use mkVICparamsMod , only : mkVICparams + use mkCH4inversionMod , only : mkCH4inversion +! +! !ARGUMENTS: + implicit none + + include 'netcdf.inc' +! +! !REVISION HISTORY: +! Authors: Gordon Bonan, Sam Levis and Mariana Vertenstein +! Revised: Nan Rosenbloom to add fmax processing. +! 3/18/08: David Lawrence added organic matter processing +! 1/22/09: Keith Oleson added urban parameter processing +! 2/11/13: Sam Levis added abm, peat, and gdp processing for new fire model +! +! +! !LOCAL VARIABLES: +!EOP + integer :: nsoicol ! number of model color classes + integer :: k,m,n ! indices + integer :: ni,nj,ns_o ! indices + integer :: ier ! error status + integer :: ndiag,nfdyn ! unit numbers + integer :: ncid ! netCDF id + integer :: omode ! netCDF output mode + integer :: varid ! netCDF variable id + integer :: ret ! netCDF return status + integer :: ntim ! time sample for dynamic land use + integer :: year ! year for dynamic land use + logical :: all_veg ! if gridcell will be 100% vegetated land-cover + real(r8) :: suma ! sum for error check + character(len=256) :: fgrddat ! grid data file + character(len=256) :: fsurdat ! output surface data file name + character(len=256) :: fsurlog ! output surface log file name + character(len=256) :: fdyndat ! dynamic landuse data file name + character(len=256) :: fname ! generic filename + character(len=256) :: string ! string read in + integer :: t1 ! timer + real(r8),parameter :: p5 = 0.5_r8 ! constant + real(r8),parameter :: p25 = 0.25_r8 ! constant + + real(r8), allocatable :: landfrac_pft(:) ! PFT data: % land per gridcell + real(r8), allocatable :: pctlnd_pft(:) ! PFT data: % of gridcell for PFTs + real(r8), allocatable :: pctlnd_pft_dyn(:) ! PFT data: % of gridcell for dyn landuse PFTs + integer , allocatable :: pftdata_mask(:) ! mask indicating real or fake land type + type(pct_pft_type), allocatable :: pctnatpft(:) ! % of grid cell that is nat veg, and breakdown into PFTs + type(pct_pft_type), allocatable :: pctcft(:) ! % of grid cell that is crop, and breakdown into CFTs + type(pct_pft_type), allocatable :: pctcft_saved(:) ! version of pctcft saved from the initial call to mkpft + real(r8), pointer :: harvest(:,:) ! harvest data: normalized harvesting + real(r8), allocatable :: pctgla(:) ! percent of grid cell that is glacier + real(r8), allocatable :: pctglc_gic(:) ! percent of grid cell that is gic (% of glc landunit) + real(r8), allocatable :: pctglc_icesheet(:) ! percent of grid cell that is ice sheet (% of glc landunit) + real(r8), allocatable :: pctglcmec(:,:) ! glacier_mec pct coverage in each class (% of landunit) + real(r8), allocatable :: topoglcmec(:,:) ! glacier_mec sfc elevation in each gridcell and class + real(r8), allocatable :: pctglcmec_gic(:,:) ! GIC pct coverage in each class (% of landunit) + real(r8), allocatable :: pctglcmec_icesheet(:,:) ! icesheet pct coverage in each class (% of landunit) + real(r8), allocatable :: elevclass(:) ! glacier_mec elevation classes + real(r8), allocatable :: pctlak(:) ! percent of grid cell that is lake + real(r8), allocatable :: pctwet(:) ! percent of grid cell that is wetland + real(r8), allocatable :: pcturb(:) ! percent of grid cell that is urbanized (total across all urban classes) + real(r8), allocatable :: urbn_classes(:,:) ! percent cover of each urban class, as % of total urban area + real(r8), allocatable :: urbn_classes_g(:,:)! percent cover of each urban class, as % of grid cell + real(r8), allocatable :: elev(:) ! glc elevation (m) + real(r8), allocatable :: topo(:) ! land elevation (m) + real(r8), allocatable :: fmax(:) ! fractional saturated area + integer , allocatable :: soicol(:) ! soil color + real(r8), allocatable :: pctsand(:,:) ! soil texture: percent sand + real(r8), allocatable :: pctclay(:,:) ! soil texture: percent clay + real(r8), allocatable :: ef1_btr(:) ! Isoprene emission factor for broadleaf + real(r8), allocatable :: ef1_fet(:) ! Isoprene emission factor for fine/everg + real(r8), allocatable :: ef1_fdt(:) ! Isoprene emission factor for fine/dec + real(r8), allocatable :: ef1_shr(:) ! Isoprene emission factor for shrubs + real(r8), allocatable :: ef1_grs(:) ! Isoprene emission factor for grasses + real(r8), allocatable :: ef1_crp(:) ! Isoprene emission factor for crops + real(r8), allocatable :: organic(:,:) ! organic matter density (kg/m3) + real(r8), allocatable :: gdp(:) ! GDP (x1000 1995 US$/capita) + real(r8), allocatable :: fpeat(:) ! peatland fraction of gridcell + integer , allocatable :: agfirepkmon(:) ! agricultural fire peak month + integer , allocatable :: urban_region(:) ! urban region ID + real(r8), allocatable :: topo_stddev(:) ! standard deviation of elevation (m) + real(r8), allocatable :: slope(:) ! topographic slope (degrees) + real(r8), allocatable :: vic_binfl(:) ! VIC b parameter (unitless) + real(r8), allocatable :: vic_ws(:) ! VIC Ws parameter (unitless) + real(r8), allocatable :: vic_dsmax(:) ! VIC Dsmax parameter (mm/day) + real(r8), allocatable :: vic_ds(:) ! VIC Ds parameter (unitless) + real(r8), allocatable :: lakedepth(:) ! lake depth (m) + real(r8), allocatable :: f0(:) ! max fractional inundated area (unitless) + real(r8), allocatable :: p3(:) ! coefficient for qflx_surf_lag for finundated (s/mm) + real(r8), allocatable :: zwt0(:) ! decay factor for finundated (m) + + ! NOTE(bja, 2015-01) added to work around a ?bug? causing 1x1_urbanc_alpha to abort. See + !/glade/p/cesm/cseg/inputdata/lnd/clm2/surfdata_map/README_c141219 + logical :: urban_skip_abort_on_invalid_data_check + + type(domain_type) :: ldomain + + character(len=32) :: subname = 'mksrfdat' ! program name + + namelist /clmexp/ & + mksrf_fgrid, & + mksrf_gridtype, & + mksrf_fvegtyp, & + mksrf_fsoitex, & + mksrf_forganic, & + mksrf_fsoicol, & + mksrf_fvocef, & + mksrf_flakwat, & + mksrf_fwetlnd, & + mksrf_fglacier, & + mksrf_furbtopo, & + mksrf_flndtopo, & + mksrf_fmax, & + mksrf_furban, & + mksrf_flai, & + mksrf_fdynuse, & + mksrf_fgdp, & + mksrf_fpeat, & + mksrf_fabm, & + mksrf_ftopostats, & + mksrf_fvic, & + mksrf_fch4, & + nglcec, & + numpft, & + soil_color, & + soil_sand, & + soil_fmax, & + soil_clay, & + pft_idx, & + pft_frc, & + all_urban, & + no_inlandwet, & + map_fpft, & + map_flakwat, & + map_fwetlnd, & + map_fglacier, & + map_fsoitex, & + map_fsoicol, & + map_furban, & + map_furbtopo, & + map_flndtopo, & + map_fmax, & + map_forganic, & + map_fvocef, & + map_flai, & + map_fharvest, & + map_fgdp, & + map_fpeat, & + map_fabm, & + map_ftopostats, & + map_fvic, & + map_fch4, & + outnc_large_files, & + outnc_double, & + outnc_dims, & + fsurdat, & + fdyndat, & + fsurlog, & + urban_skip_abort_on_invalid_data_check + +!----------------------------------------------------------------------- + + ! ====================================================================== + ! Read input namelist + ! ====================================== + ! Must specify settings for the output grid: + ! ====================================== + ! mksrf_fgrid -- Grid dataset + ! ====================================== + ! Must specify settings for input high resolution datafiles + ! ====================================== + ! mksrf_fglacier - Glacier dataset + ! mksrf_flai ----- Leaf Area Index dataset + ! mksrf_flakwat -- Lake water dataset + ! mksrf_fwetlnd -- Wetland water dataset + ! mksrf_forganic - Organic soil carbon dataset + ! mksrf_fmax ----- Max fractional saturated area dataset + ! mksrf_fsoicol -- Soil color dataset + ! mksrf_fsoitex -- Soil texture dataset + ! mksrf_furbtopo-- Topography dataset (for limiting urban areas) + ! mksrf_furban --- Urban dataset + ! mksrf_fvegtyp -- PFT vegetation type dataset + ! mksrf_fvocef -- Volatile Organic Compund Emission Factor dataset + ! mksrf_fgdp ----- GDP dataset + ! mksrf_fpeat ---- Peatland dataset + ! mksrf_fabm ----- Agricultural fire peak month dataset + ! mksrf_ftopostats Topography statistics dataset + ! mksrf_fvic ----- VIC parameters dataset + ! mksrf_fch4 ----- inversion-derived CH4 parameters dataset + ! ====================================== + ! Must specify mapping file for the different datafiles above + ! ====================================== + ! map_fpft -------- Mapping for mksrf_fvegtyp + ! map_flakwat ----- Mapping for mksrf_flakwat + ! map_fwetlnd ----- Mapping for mksrf_fwetlnd + ! map_fglacier ---- Mapping for mksrf_fglacier + ! map_fsoitex ----- Mapping for mksrf_fsoitex + ! map_fsoicol ----- Mapping for mksrf_fsoicol + ! map_furban ------ Mapping for mksrf_furban + ! map_furbtopo ---- Mapping for mksrf_furbtopo + ! map_flndtopo ---- Mapping for mksrf_flndtopo + ! map_fmax -------- Mapping for mksrf_fmax + ! map_forganic ---- Mapping for mksrf_forganic + ! map_fvocef ------ Mapping for mksrf_fvocef + ! map_flai -------- Mapping for mksrf_flai + ! map_fharvest ---- Mapping for mksrf_flai harvesting + ! map_fgdp -------- Mapping for mksrf_fgdp + ! map_fpeat ------- Mapping for mksrf_fpeat + ! map_fabm -------- Mapping for mksrf_fabm + ! map_ftopostats -- Mapping for mksrf_ftopostats + ! map_fvic -------- Mapping for mksrf_fvic + ! map_fch4 -------- Mapping for mksrf_fch4 + ! ====================================== + ! Optionally specify setting for: + ! ====================================== + ! mksrf_fdynuse ----- ASCII text file that lists each year of pft files to use + ! mksrf_gridtype ---- Type of grid (default is 'global') + ! outnc_double ------ If output should be in double precision + ! outnc_large_files - If output should be in NetCDF large file format + ! nglcec ------------ If you want to change the number of Glacier elevation classes + ! ====================================== + ! Optional settings to change values for entire area + ! ====================================== + ! all_urban --------- If entire area is urban + ! no_inlandwet ------ If wetland should be set to 0% over land + ! soil_color -------- If you want to change the soil_color to this value everywhere + ! soil_clay --------- If you want to change the soil_clay % to this value everywhere + ! soil_fmax --------- If you want to change the soil_fmax to this value everywhere + ! soil_sand --------- If you want to change the soil_sand % to this value everywhere + ! pft_idx ----------- If you want to change to 100% veg covered with given PFT indices + ! pft_frc ----------- Fractions that correspond to the pft_idx above + ! ================== + ! numpft (if different than default of 16) + ! ====================================== + ! Optional settings to work around urban bug? + ! ====================================== + ! urban_skip_abort_on_invalid_data_check + ! ====================================================================== + + write(6,*) 'Attempting to initialize control settings .....' + + mksrf_gridtype = 'global' + outnc_large_files = .false. + outnc_double = .true. + all_urban = .false. + no_inlandwet = .true. + + ! default value for bug work around + urban_skip_abort_on_invalid_data_check = .false. + + read(5, clmexp, iostat=ier) + if (ier /= 0) then + write(6,*)'error: namelist input resulted in error code ',ier + call abort() + endif + + write (6,*) 'Attempting to create surface boundary data .....' + write (6,'(72a1)') ("-",n=1,60) + + ! ---------------------------------------------------------------------- + ! Error check namelist input + ! ---------------------------------------------------------------------- + + if (urban_skip_abort_on_invalid_data_check) then + write(6, *) "WARNING: aborting on invalid data check in urban has been disabled!" + write(6, *) "WARNING: urban data may be invalid!" + end if + + if (mksrf_fgrid /= ' ')then + fgrddat = mksrf_fgrid + write(6,*)'mksrf_fgrid = ',mksrf_fgrid + else + write (6,*)'must specify mksrf_fgrid' + call abort() + endif + + if (trim(mksrf_gridtype) == 'global' .or. & + trim(mksrf_gridtype) == 'regional') then + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + else + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + write (6,*)'illegal mksrf_gridtype, must be global or regional ' + call abort() + endif + if ( outnc_large_files )then + write(6,*)'Output file in NetCDF 64-bit large_files format' + end if + if ( outnc_double )then + write(6,*)'Output ALL data in file as 64-bit' + end if + if ( all_urban )then + write(6,*) 'Output ALL data in file as 100% urban' + end if + if ( no_inlandwet )then + write(6,*) 'Set wetland to 0% over land' + end if + + ! + ! Call module initialization routines + ! + call mksoilInit( ) + call mkpftInit( all_urban, all_veg ) + allocate ( elevclass(nglcec+1) ) + call mkglcmecInit (elevclass) + call mkurbanInit (mksrf_furban) + + if ( all_veg )then + write(6,*) 'Output ALL data in file as 100% vegetated' + end if + + ! ---------------------------------------------------------------------- + ! Determine land model grid, fractional land and land mask + ! ---------------------------------------------------------------------- + + write(6,*)'calling domain_read' + if ( .not. domain_read_map(ldomain, fgrddat) )then + call domain_read(ldomain, fgrddat) + end if + write(6,*)'finished domain_read' + + ! Invalidate mask and frac for ldomain + + !ldomain%mask = bigint + !ldomain%frac = nan + + ! Determine if will have 1d output + + if (ldomain%ni /= -9999 .and. ldomain%nj /= -9999) then + write(6,*)'fsurdat is 2d lat/lon grid' + write(6,*)'nlon= ',ldomain%ni,' nlat= ',ldomain%nj + if (outnc_dims == 1) then + write(6,*)' writing output file in 1d gridcell format' + end if + else + write(6,*)'fsurdat is 1d gridcell grid' + outnc_dims = 1 + end if + + outnc_1d = .false. + if ((ldomain%ni == -9999 .and. ldomain%nj == -9999) .or. outnc_dims==1) then + outnc_1d = .true. + write(6,*)'output file will be 1d' + end if + + ! ---------------------------------------------------------------------- + ! Allocate and initialize dynamic memory + ! ---------------------------------------------------------------------- + + ns_o = ldomain%ns + allocate ( landfrac_pft(ns_o) , & + pctlnd_pft(ns_o) , & + pftdata_mask(ns_o) , & + pctnatpft(ns_o) , & + pctcft(ns_o) , & + pctcft_saved(ns_o) , & + pctgla(ns_o) , & + pctlak(ns_o) , & + pctwet(ns_o) , & + pcturb(ns_o) , & + urban_region(ns_o) , & + urbn_classes(ns_o,numurbl) , & + urbn_classes_g(ns_o,numurbl) , & + pctsand(ns_o,nlevsoi) , & + pctclay(ns_o,nlevsoi) , & + soicol(ns_o) , & + gdp(ns_o) , & + fpeat(ns_o) , & + agfirepkmon(ns_o) , & + topo_stddev(ns_o) , & + slope(ns_o) , & + vic_binfl(ns_o) , & + vic_ws(ns_o) , & + vic_dsmax(ns_o) , & + vic_ds(ns_o) , & + lakedepth(ns_o) , & + f0(ns_o) , & + p3(ns_o) , & + zwt0(ns_o) ) + landfrac_pft(:) = spval + pctlnd_pft(:) = spval + pftdata_mask(:) = -999 + pctgla(:) = spval + pctlak(:) = spval + pctwet(:) = spval + pcturb(:) = spval + urban_region(:) = -999 + urbn_classes(:,:) = spval + urbn_classes_g(:,:) = spval + pctsand(:,:) = spval + pctclay(:,:) = spval + soicol(:) = -999 + gdp(:) = spval + fpeat(:) = spval + agfirepkmon(:) = -999 + topo_stddev(:) = spval + slope(:) = spval + vic_binfl(:) = spval + vic_ws(:) = spval + vic_dsmax(:) = spval + vic_ds(:) = spval + lakedepth(:) = spval + f0(:) = spval + p3(:) = spval + zwt0(:) = spval + + ! ---------------------------------------------------------------------- + ! Open diagnostic output log file + ! ---------------------------------------------------------------------- + + if (fsurlog == ' ') then + write(6,*)' must specify fsurlog in namelist' + stop + else + ndiag = getavu(); call opnfil (fsurlog, ndiag, 'f') + end if + + if (urban_skip_abort_on_invalid_data_check) then + write(ndiag, *) "WARNING: aborting on invalid data check in urban has been disabled!" + write(ndiag, *) "WARNING: urban data may be invalid!" + end if + + if (mksrf_fgrid /= ' ')then + write (ndiag,*)'using fractional land data from file= ', & + trim(mksrf_fgrid),' to create the surface dataset' + endif + + if (trim(mksrf_gridtype) == 'global' .or. & + trim(mksrf_gridtype) == 'regional') then + write(6,*)'mksrf_gridtype = ',trim(mksrf_gridtype) + endif + + write(ndiag,*) 'PFTs from: ',trim(mksrf_fvegtyp) + write(ndiag,*) 'fmax from: ',trim(mksrf_fmax) + write(ndiag,*) 'glaciers from: ',trim(mksrf_fglacier) + write(ndiag,*) ' with: ', nglcec, ' glacier elevation classes' + write(ndiag,*) 'urban topography from: ',trim(mksrf_furbtopo) + write(ndiag,*) 'land topography from: ',trim(mksrf_flndtopo) + write(ndiag,*) 'urban from: ',trim(mksrf_furban) + write(ndiag,*) 'inland lake from: ',trim(mksrf_flakwat) + write(ndiag,*) 'inland wetland from: ',trim(mksrf_fwetlnd) + write(ndiag,*) 'soil texture from: ',trim(mksrf_fsoitex) + write(ndiag,*) 'soil organic from: ',trim(mksrf_forganic) + write(ndiag,*) 'soil color from: ',trim(mksrf_fsoicol) + write(ndiag,*) 'VOC emission factors from: ',trim(mksrf_fvocef) + write(ndiag,*) 'gdp from: ',trim(mksrf_fgdp) + write(ndiag,*) 'peat from: ',trim(mksrf_fpeat) + write(ndiag,*) 'abm from: ',trim(mksrf_fabm) + write(ndiag,*) 'topography statistics from: ',trim(mksrf_ftopostats) + write(ndiag,*) 'VIC parameters from: ',trim(mksrf_fvic) + write(ndiag,*) 'CH4 parameters from: ',trim(mksrf_fch4) + write(ndiag,*)' mapping for pft ',trim(map_fpft) + write(ndiag,*)' mapping for lake water ',trim(map_flakwat) + write(ndiag,*)' mapping for wetland ',trim(map_fwetlnd) + write(ndiag,*)' mapping for glacier ',trim(map_fglacier) + write(ndiag,*)' mapping for soil texture ',trim(map_fsoitex) + write(ndiag,*)' mapping for soil color ',trim(map_fsoicol) + write(ndiag,*)' mapping for soil organic ',trim(map_forganic) + write(ndiag,*)' mapping for urban ',trim(map_furban) + write(ndiag,*)' mapping for fmax ',trim(map_fmax) + write(ndiag,*)' mapping for VOC pct emis ',trim(map_fvocef) + write(ndiag,*)' mapping for harvest ',trim(map_fharvest) + write(ndiag,*)' mapping for lai/sai ',trim(map_flai) + write(ndiag,*)' mapping for urb topography ',trim(map_furbtopo) + write(ndiag,*)' mapping for land topography ',trim(map_flndtopo) + write(ndiag,*)' mapping for GDP ',trim(map_fgdp) + write(ndiag,*)' mapping for peatlands ',trim(map_fpeat) + write(ndiag,*)' mapping for ag fire pk month ',trim(map_fabm) + write(ndiag,*)' mapping for topography stats ',trim(map_ftopostats) + write(ndiag,*)' mapping for VIC parameters ',trim(map_fvic) + write(ndiag,*)' mapping for CH4 parameters ',trim(map_fch4) + + if (mksrf_fdynuse /= ' ') then + write(6,*)'mksrf_fdynuse = ',trim(mksrf_fdynuse) + end if + + ! ---------------------------------------------------------------------- + ! Make surface dataset fields + ! ---------------------------------------------------------------------- + + ! Make PFTs [pctnatpft, pctcft] from dataset [fvegtyp] + + call mkpft(ldomain, mapfname=map_fpft, fpft=mksrf_fvegtyp, & + ndiag=ndiag, allow_no_crops=.false., & + pctlnd_o=pctlnd_pft, pctnatpft_o=pctnatpft, pctcft_o=pctcft) + + ! Save the version of pctcft before any corrections are made. In particular, we want + ! to save the version before remove_small_cover is called. + pctcft_saved = pctcft + + ! Make inland water [pctlak, pctwet] [flakwat] [fwetlnd] + + call mklakwat (ldomain, mapfname=map_flakwat, datfname=mksrf_flakwat, & + ndiag=ndiag, zero_out=all_urban.or.all_veg, lake_o=pctlak) + + call mkwetlnd (ldomain, mapfname=map_fwetlnd, datfname=mksrf_fwetlnd, & + ndiag=ndiag, zero_out=all_urban.or.all_veg.or.no_inlandwet, swmp_o=pctwet) + + ! Make glacier fraction [pctgla] from [fglacier] dataset + + call mkglacier (ldomain, mapfname=map_fglacier, datfname=mksrf_fglacier, & + ndiag=ndiag, zero_out=all_urban.or.all_veg, glac_o=pctgla) + + ! Make soil texture [pctsand, pctclay] [fsoitex] + + call mksoiltex (ldomain, mapfname=map_fsoitex, datfname=mksrf_fsoitex, & + ndiag=ndiag, sand_o=pctsand, clay_o=pctclay) + ! Make soil color classes [soicol] [fsoicol] + + call mksoilcol (ldomain, mapfname=map_fsoicol, datfname=mksrf_fsoicol, & + ndiag=ndiag, soil_color_o=soicol, nsoicol=nsoicol) + + ! Make fmax [fmax] from [fmax] dataset + + allocate(fmax(ns_o)) + fmax(:) = spval + call mkfmax (ldomain, mapfname=map_fmax, datfname=mksrf_fmax, & + ndiag=ndiag, fmax_o=fmax) + + ! Make GDP data [gdp] from [gdp] + + call mkgdp (ldomain, mapfname=map_fgdp, datfname=mksrf_fgdp, & + ndiag=ndiag, gdp_o=gdp) + + ! Make peat data [fpeat] from [peatf] + + call mkpeat (ldomain, mapfname=map_fpeat, datfname=mksrf_fpeat, & + ndiag=ndiag, peat_o=fpeat) + + ! Make agricultural fire peak month data [abm] from [abm] + + call mkagfirepkmon (ldomain, mapfname=map_fabm, datfname=mksrf_fabm, & + ndiag=ndiag, agfirepkmon_o=agfirepkmon) + + ! Make urban fraction [pcturb] from [furban] dataset + + call mkurban (ldomain, mapfname=map_furban, datfname=mksrf_furban, & + ndiag=ndiag, zero_out=all_veg, urbn_o=pcturb, urbn_classes_o=urbn_classes, & + region_o=urban_region) + + ! WJS (9-25-12): Note about topo datasets: Until now, there have been two topography + ! datasets: flndtopo & fglctopo. flndtopo is used to create the TOPO variable, which I + ! believe is used to downscale grid cell-level climate to glc_mec columns (10-26-12: + ! Now I'm not surue about this: I think TOPO might actually come from a different file + ! in CLM, and TOPO on the surface dataset may be unused). Until now, fglctopo was used + ! for dividing pct_glacier data into multiple elevation classes in + ! mkglcmecMod. However, it is no longer needed for this purpose, since elevation data + ! is now folded into fglacier. fglctopo has also been used to screen urban points (I'm + ! not sure why fglctopo rather than flndtopo was chosen for that purpose). + ! + ! For now, I am keeping fglctopo around simply for the urban screening purpose. To + ! make its purpose clear, I am renaming it to furbtopo. I had planned to switch to a + ! new topo file that is consistent with the topo data that are implicitly included in + ! fglacier (i.e., a file that gives the topo that's used for glc purposes, even though + ! fglctopo itself isn't used for glc purposes any more). However, this caused problems + ! in coming up with a new elev_thresh. Thus, for now I am continuing to use the old + ! fglctopo file, which no longer has any meaning with respect to glc (and again, I am + ! renaming it to furbtopo to make it clear that it is not connected with glc). + ! + ! In the longer term, a better solution for this urban screening would probably be to + ! modify the raw urban data. In that case, I believe we could remove furbtopo. + ! + ! Why was TOPO created from flndtopo rather than fglctopo? It seems like, for the + ! purpose of downscaling, this TOPO variable should ideally represent CAM's + ! topographic height. For that purpose, flndtopo is more appropriate, because it seems + ! to have come from CAM's topo dataset. However, I believe that many (all??) CAM + ! resolutions use some sort of smoothed topography. So the ideal thing to do would be + ! for CLM to get its grid cell-level topography from CAM at initialization. If that + ! were done, then I think flndtopo and the TOPO variable on the surface dataset could + ! go away. (Update 10-26-12: it actually looks to me like CLM's TOPO comes from a + ! different source entirely (flndtopo in CLM), so it may be that TOPO on the surface + ! dataset isn't currently used for anything!) + + + ! Make elevation [elev] from [ftopo, ffrac] dataset + ! Used only to screen pcturb + ! Screen pcturb by elevation threshold from elev dataset + + if ( .not. all_urban .and. .not. all_veg )then + allocate(elev(ns_o)) + elev(:) = spval + call mkelev (ldomain, mapfname=map_furbtopo, datfname=mksrf_furbtopo, & + varname='TOPO_ICE', ndiag=ndiag, elev_o=elev) + + where (elev .gt. elev_thresh) + pcturb = 0._r8 + end where + deallocate(elev) + end if + + ! Determine topography + + allocate(topo(ns_o)) + call mkelev (ldomain, mapfname=map_flndtopo, datfname=mksrf_flndtopo, & + varname='TOPO', ndiag=ndiag, elev_o=topo) + + ! Compute topography statistics [topo_stddev, slope] from [ftopostats] + call mktopostats (ldomain, mapfname=map_ftopostats, datfname=mksrf_ftopostats, & + ndiag=ndiag, topo_stddev_o=topo_stddev, slope_o=slope) + + ! Make VIC parameters [binfl, ws, dsmax, ds] from [fvic] + call mkVICparams (ldomain, mapfname=map_fvic, datfname=mksrf_fvic, ndiag=ndiag, & + binfl_o=vic_binfl, ws_o=vic_ws, dsmax_o=vic_dsmax, ds_o=vic_ds) + + ! Make lake depth [lakedepth] from [flakwat] + call mklakparams (ldomain, mapfname=map_flakwat, datfname=mksrf_flakwat, ndiag=ndiag, & + lakedepth_o=lakedepth) + + ! Make inversion-derived CH4 parameters [f0, p3, zwt0] from [fch4] + call mkCH4inversion (ldomain, mapfname=map_fch4, datfname=mksrf_fch4, ndiag=ndiag, & + f0_o=f0, p3_o=p3, zwt0_o=zwt0) + + ! Make organic matter density [organic] [forganic] + allocate (organic(ns_o,nlevsoi)) + organic(:,:) = spval + call mkorganic (ldomain, mapfname=map_forganic, datfname=mksrf_forganic, & + ndiag=ndiag, organic_o=organic) + + ! Make VOC emission factors for isoprene & + ! [ef1_btr,ef1_fet,ef1_fdt,ef1_shr,ef1_grs,ef1_crp] + + allocate ( ef1_btr(ns_o) , & + ef1_fet(ns_o) , & + ef1_fdt(ns_o) , & + ef1_shr(ns_o) , & + ef1_grs(ns_o) , & + ef1_crp(ns_o) ) + ef1_btr(:) = 0._r8 + ef1_fet(:) = 0._r8 + ef1_fdt(:) = 0._r8 + ef1_shr(:) = 0._r8 + ef1_grs(:) = 0._r8 + ef1_crp(:) = 0._r8 + + call mkvocef (ldomain, mapfname=map_fvocef, datfname=mksrf_fvocef, ndiag=ndiag, & + ef_btr_o=ef1_btr, ef_fet_o=ef1_fet, ef_fdt_o=ef1_fdt, & + ef_shr_o=ef1_shr, ef_grs_o=ef1_grs, ef_crp_o=ef1_crp) + + ! Do landuse changes such as for the poles, etc. + + call change_landuse( ldomain, dynpft=.false. ) + + do n = 1,ns_o + + ! Assume wetland and/or lake when dataset landmask implies ocean + ! (assume medium soil color (15) and loamy texture). + ! Also set pftdata_mask here + + if (pctlnd_pft(n) < 1.e-6_r8) then + pftdata_mask(n) = 0 + soicol(n) = 15 + pctwet(n) = 100._r8 - pctlak(n) + pcturb(n) = 0._r8 + pctgla(n) = 0._r8 + call pctnatpft(n)%set_pct_l2g(0._r8) + call pctcft(n)%set_pct_l2g(0._r8) + pctsand(n,:) = 43._r8 + pctclay(n,:) = 18._r8 + organic(n,:) = 0._r8 + else + pftdata_mask(n) = 1 + end if + + ! Truncate all percentage fields on output grid. This is needed to + ! insure that wt is zero (not a very small number such as + ! 1e-16) where it really should be zero + + do k = 1,nlevsoi + pctsand(n,k) = float(nint(pctsand(n,k))) + pctclay(n,k) = float(nint(pctclay(n,k))) + end do + pctlak(n) = float(nint(pctlak(n))) + pctwet(n) = float(nint(pctwet(n))) + pctgla(n) = float(nint(pctgla(n))) + + ! Make sure sum of land cover types does not exceed 100. If it does, + ! subtract excess from most dominant land cover. + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if (suma > 250._r4) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb and pctgla is greater than 250%' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n) + call abort() + else if (suma > 100._r4) then + pctlak(n) = pctlak(n) * 100._r8/suma + pctwet(n) = pctwet(n) * 100._r8/suma + pcturb(n) = pcturb(n) * 100._r8/suma + pctgla(n) = pctgla(n) * 100._r8/suma + end if + + end do + + call normalizencheck_landuse(ldomain) + + ! Write out sum of PFT's + + do k = natpft_lb,natpft_ub + suma = 0._r8 + do n = 1,ns_o + suma = suma + pctnatpft(n)%get_one_pct_p2g(k) + enddo + write(6,*) 'sum over domain of pft ',k,suma + enddo + write(6,*) + + do k = cft_lb,cft_ub + suma = 0._r8 + do n = 1,ns_o + suma = suma + pctcft(n)%get_one_pct_p2g(k) + enddo + write(6,*) 'sum over domain of cft ',k,suma + enddo + write(6,*) + + ! Make final values of percent urban by class + ! This call needs to occur after all corrections are made to pcturb + + call normalize_classes_by_gcell(urbn_classes, pcturb, urbn_classes_g) + + + ! Make glacier multiple elevation classes [pctglcmec,topoglcmec] from [fglacier] dataset + ! This call needs to occur after pctgla has been adjusted for the final time + + if ( nglcec > 0 )then + + allocate (pctglcmec(ns_o,nglcec), & + topoglcmec(ns_o,nglcec), & + pctglcmec_gic(ns_o,nglcec), & + pctglcmec_icesheet(ns_o,nglcec)) + allocate (pctglc_gic(ns_o)) + allocate (pctglc_icesheet(ns_o)) + + pctglcmec(:,:) = spval + topoglcmec(:,:) = spval + pctglcmec_gic(:,:) = spval + pctglcmec_icesheet(:,:) = spval + pctglc_gic(:) = spval + pctglc_icesheet(:) = spval + + call mkglcmec (ldomain, mapfname=map_fglacier, & + datfname_fglacier=mksrf_fglacier, ndiag=ndiag, & + pctglcmec_o=pctglcmec, topoglcmec_o=topoglcmec, & + pctglcmec_gic_o=pctglcmec_gic, pctglcmec_icesheet_o=pctglcmec_icesheet, & + pctglc_gic_o=pctglc_gic, pctglc_icesheet_o=pctglc_icesheet) + end if + + ! Determine fractional land from pft dataset + + do n = 1,ns_o + landfrac_pft(n) = pctlnd_pft(n)/100._r8 + end do + + ! ---------------------------------------------------------------------- + ! Create surface dataset + ! ---------------------------------------------------------------------- + + ! Create netCDF surface dataset. + + if (fsurdat == ' ') then + write(6,*)' must specify fsurdat in namelist' + stop + end if + + call mkfile(ldomain, trim(fsurdat), dynlanduse = .false.) + + call domain_write(ldomain, fsurdat) + + call check_ret(nf_open(trim(fsurdat), nf_write, ncid), subname) + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + ! Write fields OTHER THAN lai, sai, heights, and urban parameters to netcdf surface dataset + + call check_ret(nf_inq_varid(ncid, 'natpft', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, (/(n,n=natpft_lb,natpft_ub)/)), subname) + + if (num_cft > 0) then + call check_ret(nf_inq_varid(ncid, 'cft', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, (/(n,n=cft_lb,cft_ub)/)), subname) + end if + + call check_ret(nf_inq_varid(ncid, 'PFTDATA_MASK', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, pftdata_mask), subname) + + call check_ret(nf_inq_varid(ncid, 'LANDFRAC_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, landfrac_pft), subname) + + call check_ret(nf_inq_varid(ncid, 'mxsoil_color', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, nsoicol), subname) + + call check_ret(nf_inq_varid(ncid, 'SOIL_COLOR', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, soicol), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_SAND', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctsand), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_CLAY', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctclay), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_WETLAND', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctwet), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_LAKE', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctlak), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLACIER', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctgla), subname) + + if ( nglcec > 0 )then + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec), subname) + + call check_ret(nf_inq_varid(ncid, 'GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, elevclass), subname) + + call check_ret(nf_inq_varid(ncid, 'TOPO_GLC_MEC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, topoglcmec), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC_GIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec_gic), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_MEC_ICESHEET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglcmec_icesheet), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_GIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglc_gic), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_GLC_ICESHEET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, pctglc_icesheet), subname) + + end if + + call check_ret(nf_inq_varid(ncid, 'TOPO', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, topo), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, urbn_classes_g), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_NATVEG', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_l2g_array(pctnatpft)), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_CROP', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_l2g_array(pctcft)), subname) + + call check_ret(nf_inq_varid(ncid, 'PCT_NAT_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctnatpft)), subname) + + if (num_cft > 0) then + call check_ret(nf_inq_varid(ncid, 'PCT_CFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, get_pct_p2l_array(pctcft)), subname) + end if + + call check_ret(nf_inq_varid(ncid, 'FMAX', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, fmax), subname) + + call check_ret(nf_inq_varid(ncid, 'gdp', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, gdp), subname) + + call check_ret(nf_inq_varid(ncid, 'peatf', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, fpeat), subname) + + call check_ret(nf_inq_varid(ncid, 'abm', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, agfirepkmon), subname) + + call check_ret(nf_inq_varid(ncid, 'SLOPE', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, slope), subname) + + call check_ret(nf_inq_varid(ncid, 'STD_ELEV', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, topo_stddev), subname) + + call check_ret(nf_inq_varid(ncid, 'binfl', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, vic_binfl), subname) + + call check_ret(nf_inq_varid(ncid, 'Ws', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, vic_ws), subname) + + call check_ret(nf_inq_varid(ncid, 'Dsmax', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, vic_dsmax), subname) + + call check_ret(nf_inq_varid(ncid, 'Ds', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, vic_ds), subname) + + call check_ret(nf_inq_varid(ncid, 'LAKEDEPTH', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, lakedepth), subname) + + call check_ret(nf_inq_varid(ncid, 'F0', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, f0), subname) + + call check_ret(nf_inq_varid(ncid, 'P3', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, p3), subname) + + call check_ret(nf_inq_varid(ncid, 'ZWT0', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, zwt0), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_BTR', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_btr), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_FET', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_fet), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_FDT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_fdt), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_SHR', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_shr), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_GRS', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_grs), subname) + + call check_ret(nf_inq_varid(ncid, 'EF1_CRP', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, ef1_crp), subname) + + call check_ret(nf_inq_varid(ncid, 'ORGANIC', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, organic), subname) + + call check_ret(nf_inq_varid(ncid, 'URBAN_REGION_ID', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, urban_region), subname) + + ! Deallocate arrays NOT needed for dynamic-pft section of code + + deallocate ( organic ) + deallocate ( ef1_btr, ef1_fet, ef1_fdt, ef1_shr, ef1_grs, ef1_crp ) + if ( nglcec > 0 ) deallocate ( pctglcmec, topoglcmec) + if ( nglcec > 0 ) deallocate ( pctglc_gic, pctglc_icesheet) + deallocate ( elevclass ) + deallocate ( fmax ) + deallocate ( pctsand, pctclay ) + deallocate ( soicol ) + deallocate ( gdp, fpeat, agfirepkmon ) + deallocate ( topo_stddev, slope ) + deallocate ( vic_binfl, vic_ws, vic_dsmax, vic_ds ) + deallocate ( lakedepth ) + deallocate ( f0, p3, zwt0 ) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! ---------------------------------------------------------------------- + ! Make Urban Parameters from raw input data and write to surface dataset + ! Write to netcdf file is done inside mkurbanpar routine + ! ---------------------------------------------------------------------- + + write(6,*)'calling mkurbanpar' + call mkurbanpar(datfname=mksrf_furban, ncido=ncid, region_o=urban_region, & + urbn_classes_gcell_o=urbn_classes_g, & + urban_skip_abort_on_invalid_data_check=urban_skip_abort_on_invalid_data_check) + + ! ---------------------------------------------------------------------- + ! Make LAI and SAI from 1/2 degree data and write to surface dataset + ! Write to netcdf file is done inside mklai routine + ! ---------------------------------------------------------------------- + + write(6,*)'calling mklai' + call mklai(ldomain, mapfname=map_flai, datfname=mksrf_flai, & + ndiag=ndiag, ncido=ncid ) + + ! Close surface dataset + + call check_ret(nf_close(ncid), subname) + + write (6,'(72a1)') ("-",n=1,60) + write (6,*)' land model surface data set successfully created for ', & + 'grid of size ',ns_o + + ! ---------------------------------------------------------------------- + ! Create dynamic land use dataset if appropriate + ! ---------------------------------------------------------------------- + + if (mksrf_fdynuse /= ' ') then + + write(6,*)'creating dynamic land use dataset' + + allocate(pctlnd_pft_dyn(ns_o)) + call mkharvest_init( ns_o, spval, harvest, mksrf_fvegtyp ) + + if (fdyndat == ' ') then + write(6,*)' must specify fdyndat in namelist if mksrf_fdynuse is not blank' + stop + end if + + ! Define dimensions and global attributes + + call mkfile(ldomain, fdyndat, dynlanduse=.true.) + + ! Write fields other pft to dynamic land use dataset + + call domain_write(ldomain, fdyndat) + + call check_ret(nf_open(trim(fdyndat), nf_write, ncid), subname) + call check_ret(nf_set_fill (ncid, nf_nofill, omode), subname) + + call check_ret(nf_inq_varid(ncid, 'natpft', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, (/(n,n=natpft_lb,natpft_ub)/)), subname) + + if (num_cft > 0) then + call check_ret(nf_inq_varid(ncid, 'cft', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, (/(n,n=cft_lb,cft_ub)/)), subname) + end if + + call check_ret(nf_inq_varid(ncid, 'PFTDATA_MASK', varid), subname) + call check_ret(nf_put_var_int(ncid, varid, pftdata_mask), subname) + + call check_ret(nf_inq_varid(ncid, 'LANDFRAC_PFT', varid), subname) + call check_ret(nf_put_var_double(ncid, varid, landfrac_pft), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + ! Read in each dynamic pft landuse dataset + + nfdyn = getavu(); call opnfil (mksrf_fdynuse, nfdyn, 'f') + + ntim = 0 + do + ! Read input pft data + + read(nfdyn, '(A195,1x,I4)', iostat=ier) string, year + if (ier /= 0) exit + ! + ! If pft fraction override is set, than intrepret string as PFT and harvesting override values + ! + if ( any(pft_frc > 0.0_r8 ) )then + fname = ' ' + call mkpft_parse_oride(string) + call mkharvest_parse_oride(string) + write(6, '(a, i4, a)') 'PFT and harvesting values for year ', year, ' :' + write(6, '(a, a)') ' ', trim(string) + ! + ! Otherwise intrepret string as a filename with PFT and harvesting values in it + ! + else + fname = string + write(6,*)'input pft dynamic dataset for year ', year, ' is : ', trim(fname) + end if + ntim = ntim + 1 + + ! Create pctpft data at model resolution + + call mkpft(ldomain, mapfname=map_fpft, fpft=fname, & + ndiag=ndiag, allow_no_crops=.true., & + pctlnd_o=pctlnd_pft_dyn, pctnatpft_o=pctnatpft, pctcft_o=pctcft, & + pctcft_o_saved=pctcft_saved) + + ! Create harvesting data at model resolution + + call mkharvest( ldomain, mapfname=map_fharvest, datfname=fname, & + ndiag=ndiag, harv_o=harvest ) + + ! Consistency check on input land fraction + + do n = 1,ns_o + if (pctlnd_pft_dyn(n) /= pctlnd_pft(n)) then + write(6,*) subname,' error: pctlnd_pft for dynamics data = ',& + pctlnd_pft_dyn(n), ' not equal to pctlnd_pft for surface data = ',& + pctlnd_pft(n),' at n= ',n + if ( trim(fname) == ' ' )then + write(6,*) ' PFT string = ', string + else + write(6,*) ' PFT file = ', fname + end if + call abort() + end if + end do + + call change_landuse(ldomain, dynpft=.true.) + + call normalizencheck_landuse(ldomain) + + ! Output time-varying data for current year + + call check_ret(nf_inq_varid(ncid, 'PCT_NAT_PFT', varid), subname) + call ncd_put_time_slice(ncid, varid, ntim, get_pct_p2l_array(pctnatpft)) + + call check_ret(nf_inq_varid(ncid, 'PCT_CROP', varid), subname) + call ncd_put_time_slice(ncid, varid, ntim, get_pct_l2g_array(pctcft)) + + if (num_cft > 0) then + call check_ret(nf_inq_varid(ncid, 'PCT_CFT', varid), subname) + call ncd_put_time_slice(ncid, varid, ntim, get_pct_p2l_array(pctcft)) + end if + + do k = 1, mkharvest_numtypes() + call check_ret(nf_inq_varid(ncid, trim(mkharvest_fieldname(k)), varid), subname) + call ncd_put_time_slice(ncid, varid, ntim, harvest(:,k)) + end do + + call check_ret(nf_inq_varid(ncid, 'YEAR', varid), subname) + call check_ret(nf_put_vara_int(ncid, varid, ntim, 1, year), subname) + + call check_ret(nf_inq_varid(ncid, 'time', varid), subname) + call check_ret(nf_put_vara_int(ncid, varid, ntim, 1, year), subname) + + call check_ret(nf_inq_varid(ncid, 'input_pftdata_filename', varid), subname) + call check_ret(nf_put_vara_text(ncid, varid, (/ 1, ntim /), (/ len_trim(string), 1 /), trim(string) ), subname) + + ! Synchronize the disk copy of a netCDF dataset with in-memory buffers + + call check_ret(nf_sync(ncid), subname) + + end do ! end of read loop + + call check_ret(nf_close(ncid), subname) + + end if ! end of if-create dynamic landust dataset + + ! ---------------------------------------------------------------------- + ! Close diagnostic dataset + ! ---------------------------------------------------------------------- + + close (ndiag) + write (6,*) + write (6,*) 'Surface data output file = ',trim(fsurdat) + write (6,*) ' This file contains the land model surface data' + write (6,*) 'Diagnostic log file = ',trim(fsurlog) + write (6,*) ' See this file for a summary of the dataset' + write (6,*) + + write (6,*) 'Successfully created surface dataset' + +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: change_landuse +! +! !INTERFACE: +subroutine change_landuse( ldomain, dynpft ) +! +! !DESCRIPTION: +! +! Do landuse changes such as for the poles, etc. +! +! !USES: + implicit none +! +! !ARGUMENTS: + type(domain_type) :: ldomain + logical, intent(in) :: dynpft ! if part of the dynpft section of code + +! +! !REVISION HISTORY: +! 9/10/09: Erik Kluzek spin off subroutine from original embedded code +! +!EOP +! +! !LOCAL VARIABLES: + logical :: first_time = .true. ! flag if this is the first pass through or not + integer ,parameter :: bdtroptree = 6 ! Index for broadleaf decidious tropical tree + integer ,parameter :: bdtemptree = 7 ! Index for broadleaf decidious temperate tree + integer ,parameter :: bdtempshrub = 10 ! Index for broadleaf decidious temperate shrub + real(r8),parameter :: troplat = 23.5_r8 ! Latitude to define as tropical + integer :: n,ns_o ! indices + character(len=32) :: subname = 'change_landuse' ! subroutine name +!----------------------------------------------------------------------- + + ns_o = ldomain%ns + do n = 1,ns_o + + ! Set pfts 7 and 10 to 6 in the tropics to avoid lais > 1000 + ! Using P. Thornton's method found in surfrdMod.F90 in clm3.5 + + if (abs(ldomain%latc(n)) 0._r8) then + call pctnatpft(n)%merge_pfts(source=bdtemptree, dest=bdtroptree) + if ( first_time ) write (6,*) subname, ' Warning: all wgt of pft ', & + bdtemptree, ' now added to pft ', bdtroptree + end if + if (abs(ldomain%latc(n)) 0._r8) then + call pctnatpft(n)%merge_pfts(source=bdtempshrub, dest=bdtroptree) + if ( first_time ) write (6,*) subname, ' Warning: all wgt of pft ', & + bdtempshrub, ' now added to pft ', bdtroptree + end if + first_time = .false. + + ! If have pole points on grid - set south pole to glacier + ! north pole is assumed as non-land + + if (abs((ldomain%latc(n) - 90._r8)) < 1.e-6_r8) then + pctlak(n) = 0._r8 + pctwet(n) = 0._r8 + pcturb(n) = 0._r8 + pctgla(n) = 100._r8 + call pctnatpft(n)%set_pct_l2g(0._r8) + call pctcft(n)%set_pct_l2g(0._r8) + if ( .not. dynpft )then + organic(n,:) = 0._r8 + ef1_btr(n) = 0._r8 + ef1_fet(n) = 0._r8 + ef1_fdt(n) = 0._r8 + ef1_shr(n) = 0._r8 + ef1_grs(n) = 0._r8 + ef1_crp(n) = 0._r8 + end if + end if + + end do + +end subroutine change_landuse + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: normalizencheck_landuse +! +! !INTERFACE: +subroutine normalizencheck_landuse(ldomain) +! +! !DESCRIPTION: +! +! Normalize land use and make sure things add up to 100% as well as +! checking that things are as they should be. +! +! Precondition: pctlak + pctwet + pcturb + pctgla <= 100 (within roundoff) +! +! !USES: + use mkpftConstantsMod , only : baregroundindex + use mkpftUtilsMod , only : adjust_total_veg_area + implicit none +! !ARGUMENTS: + type(domain_type) :: ldomain +! +! !REVISION HISTORY: +! 9/10/09: Erik Kluzek spin off subroutine from original embedded code +! +!EOP +! +! !LOCAL VARIABLES: + integer :: m,k,n,ns_o ! indices + integer :: nsmall ! number of small PFT values for a single check + integer :: nsmall_tot ! total number of small PFT values in all grid cells + real(r8) :: suma ! sum for error check + real(r8) :: suma2 ! another sum for error check + real(r8) :: new_total_veg_pct ! new % veg (% of grid cell, total of natural veg & crop) + real(r8) :: bare_pct_p2g ! % of bare soil, as % of grid cell + real(r8) :: bare_urb_diff ! difference between bare soil and urban % + real(r8) :: pcturb_excess ! excess urban % not accounted for by bare soil + real(r8) :: sum8, sum8a ! sum for error check + real(r4) :: sum4a ! sum for error check + real(r8), parameter :: tol_loose = 1.e-4_r8 ! tolerance for some 'loose' error checks + real(r8), parameter :: toosmallPFT = 1.e-10_r8 ! tolerance for PFT's to ignore + character(len=32) :: subname = 'normalizencheck_landuse' ! subroutine name +!----------------------------------------------------------------------- + + ! ------------------------------------------------------------------------ + ! Normalize vegetated area so that vegetated + special area is 100% + ! ------------------------------------------------------------------------ + + ns_o = ldomain%ns + do n = 1,ns_o + + ! Check preconditions + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if (suma > (100._r8 + tol_loose)) then + write(6,*) subname, ' ERROR: pctlak + pctwet + pcturb + pctgla must be' + write(6,*) '<= 100% before calling this subroutine' + write(6,*) 'n, pctlak, pctwet, pcturb, pctgla = ', & + n, pctlak(n), pctwet(n), pcturb(n), pctgla(n) + call abort() + end if + + ! First normalize vegetated (natural veg + crop) cover so that the total of + ! (vegetated + (special excluding urban)) is 100%. We'll deal with urban later. + ! + ! Note that, in practice, the total area of natural veg + crop is typically 100% + ! going into this routine. However, the following code does NOT rely on this, and + ! will work properly regardless of the initial area of natural veg + crop (even if + ! that initial area is 0%). + + suma = pctlak(n)+pctwet(n)+pctgla(n) + new_total_veg_pct = 100._r8 - suma + ! correct for rounding error: + new_total_veg_pct = max(new_total_veg_pct, 0._r8) + + call adjust_total_veg_area(new_total_veg_pct, pctnatpft=pctnatpft(n), pctcft=pctcft(n)) + + ! Make sure we did the above rescaling correctly + + suma = suma + pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() + if (abs(suma - 100._r8) > tol_loose) then + write(6,*) subname, ' ERROR in rescaling veg based on (special excluding urban' + write(6,*) 'suma = ', suma + call abort() + end if + + ! Now decrease the vegetated area to account for urban area. Urban needs to be + ! handled specially because we replace bare soil preferentially with urban, rather + ! than rescaling all PFTs equally. + + if (pcturb(n) > 0._r8) then + + ! Replace bare soil preferentially with urban + bare_pct_p2g = pctnatpft(n)%get_one_pct_p2g(baregroundindex) + bare_urb_diff = bare_pct_p2g - pcturb(n) + bare_pct_p2g = max(0._r8, bare_urb_diff) + call pctnatpft(n)%set_one_pct_p2g(baregroundindex, bare_pct_p2g) + pcturb_excess = abs(min(0._r8,bare_urb_diff)) + + ! For any urban not accounted for by bare soil, replace other PFTs + ! proportionally + if (pcturb_excess > 0._r8) then + ! Note that, in this case, we will have already reduced bare ground to 0% + + new_total_veg_pct = pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() - pcturb_excess + if (new_total_veg_pct < 0._r8) then + if (abs(new_total_veg_pct) < tol_loose) then + ! only slightly less than 0; correct it + new_total_veg_pct = 0._r8 + else + write(6,*) subname, ' ERROR: trying to replace veg with urban,' + write(6,*) 'but pcturb_excess exceeds current vegetation percent' + call abort() + end if + end if + + call adjust_total_veg_area(new_total_veg_pct, pctnatpft=pctnatpft(n), pctcft=pctcft(n)) + end if + + end if ! pcturb(n) > 0 + + ! Confirm that we have done the rescaling correctly: now the sum of all landunits + ! should be 100% + suma = pctlak(n)+pctwet(n)+pctgla(n)+pcturb(n) + suma = suma + pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() + if (abs(suma - 100._r8) > tol_loose) then + write(6,*) subname, ' ERROR: landunits do not sum to 100%' + write(6,*) 'n, suma, pctlak, pctwet, pctgla, pcturb, pctnatveg, pctcrop = ' + write(6,*) n, suma, pctlak(n), pctwet(n), pctgla(n), pcturb(n), & + pctnatpft(n)%get_pct_l2g(), pctcft(n)%get_pct_l2g() + call abort() + end if + + end do + + ! ------------------------------------------------------------------------ + ! Do other corrections and error checks + ! ------------------------------------------------------------------------ + + nsmall_tot = 0 + + do n = 1,ns_o + + ! If the coverage of any PFT or CFT is too small at the gridcell level, set its + ! % cover to 0, then renormalize everything else as needed + call pctnatpft(n)%remove_small_cover(toosmallPFT, nsmall) + nsmall_tot = nsmall_tot + nsmall + call pctcft(n)%remove_small_cover(toosmallPFT, nsmall) + nsmall_tot = nsmall_tot + nsmall + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + suma = suma + pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() + if ( abs(suma - 100.0_r8) > 2.0*epsilon(suma) )then + pctlak(n) = pctlak(n) * 100._r8/suma + pctwet(n) = pctwet(n) * 100._r8/suma + pcturb(n) = pcturb(n) * 100._r8/suma + pctgla(n) = pctgla(n) * 100._r8/suma + call pctnatpft(n)%set_pct_l2g(pctnatpft(n)%get_pct_l2g() * 100._r8/suma) + call pctcft(n)%set_pct_l2g(pctcft(n)%get_pct_l2g() * 100._r8/suma) + end if + + ! Roundoff error fix + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + suma2 = pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() + if ( (suma < 100._r8 .and. suma > (100._r8 - 1.e-6_r8)) .or. & + (suma2 > 0.0_r8 .and. suma2 < 1.e-6_r8) ) then + write (6,*) 'Special land units near 100%, but not quite for n,suma =',n,suma + write (6,*) 'Adjusting special land units to 100%' + if (pctlak(n) >= 25._r8) then + pctlak(n) = 100._r8 - (pctwet(n) + pcturb(n) + pctgla(n)) + else if (pctwet(n) >= 25._r8) then + pctwet(n) = 100._r8 - (pctlak(n) + pcturb(n) + pctgla(n)) + else if (pcturb(n) >= 25._r8) then + pcturb(n) = 100._r8 - (pctlak(n) + pctwet(n) + pctgla(n)) + else if (pctgla(n) >= 25._r8) then + pctgla(n) = 100._r8 - (pctlak(n) + pctwet(n) + pcturb(n)) + else + write (6,*) subname, 'Error: sum of special land units nearly 100% but none is >= 25% at ', & + 'n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),pctnatveg(n),pctcrop(n),suma = ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctnatpft(n)%get_pct_l2g(),pctcft(n)%get_pct_l2g(),suma + call abort() + end if + call pctnatpft(n)%set_pct_l2g(0._r8) + call pctcft(n)%set_pct_l2g(0._r8) + end if + if ( any(pctnatpft(n)%get_pct_p2g() > 0.0_r8 .and. pctnatpft(n)%get_pct_p2g() < toosmallPFT ) .or. & + any(pctcft(n)%get_pct_p2g() > 0.0_r8 .and. pctcft(n)%get_pct_p2g() < toosmallPFT )) then + write (6,*) 'pctnatpft or pctcft is small at n=', n + write (6,*) 'pctnatpft%pct_p2l = ', pctnatpft(n)%get_pct_p2l() + write (6,*) 'pctcft%pct_p2l = ', pctcft(n)%get_pct_p2l() + write (6,*) 'pctnatpft%pct_l2g = ', pctnatpft(n)%get_pct_l2g() + write (6,*) 'pctcft%pct_l2g = ', pctcft(n)%get_pct_l2g() + call abort() + end if + + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + if (suma < 100._r8-epsilon(suma) .and. suma > (100._r8 - 4._r8*epsilon(suma))) then + write (6,*) subname, 'n,pctlak,pctwet,pcturb,pctgla,pctnatveg,pctcrop= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctnatpft(n)%get_pct_l2g(), pctcft(n)%get_pct_l2g() + call abort() + end if + suma = suma + pctnatpft(n)%get_pct_l2g() + pctcft(n)%get_pct_l2g() + if ( abs(suma-100._r8) > 1.e-10_r8) then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla, pctnatveg and pctcrop is NOT equal to 100' + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctnatveg,pctcrop,sum= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctnatpft(n)%get_pct_l2g(),pctcft(n)%get_pct_l2g(), suma + call abort() + end if + + end do + + ! Check that when pctnatveg+pctcrop identically zero, sum of special landunits is identically 100% + + if ( .not. outnc_double )then + do n = 1,ns_o + sum8 = real(pctlak(n),r4) + sum8 = sum8 + real(pctwet(n),r4) + sum8 = sum8 + real(pcturb(n),r4) + sum8 = sum8 + real(pctgla(n),r4) + sum4a = real(pctnatpft(n)%get_pct_l2g(),r4) + sum4a = sum4a + real(pctcft(n)%get_pct_l2g(),r4) + if ( sum4a==0.0_r4 .and. sum8 < 100._r4-2._r4*epsilon(sum4a) )then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla is < 100% when pctnatveg+pctcrop==0 sum = ', sum8 + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctnatveg,pctcrop= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n), & + pctnatpft(n)%get_pct_l2g(),pctcft(n)%get_pct_l2g() + call abort() + end if + end do + else + do n = 1,ns_o + sum8 = pctlak(n) + sum8 = sum8 + pctwet(n) + sum8 = sum8 + pcturb(n) + sum8 = sum8 + pctgla(n) + sum8a = pctnatpft(n)%get_pct_l2g() + sum8a = sum8a + pctcft(n)%get_pct_l2g() + if ( sum8a==0._r8 .and. sum8 < (100._r8-4._r8*epsilon(sum8)) )then + write (6,*) subname, ' error: sum of pctlak, pctwet,', & + 'pcturb, pctgla is < 100% when pctnatveg+pctcrop==0 sum = ', sum8 + write (6,*) 'Total error, error/epsilon = ',100._r8-sum8, ((100._r8-sum8)/epsilon(sum8)) + write (6,*)'n,pctlak,pctwet,pcturb,pctgla,pctnatveg,pctcrop,epsilon= ', & + n,pctlak(n),pctwet(n),pcturb(n),pctgla(n),& + pctnatpft(n)%get_pct_l2g(),pctcft(n)%get_pct_l2g(), epsilon(sum8) + call abort() + end if + end do + end if + + ! Make sure that there is no vegetation outside the pft mask + do n = 1,ns_o + if (pftdata_mask(n) == 0 .and. (pctnatpft(n)%get_pct_l2g() > 0 .or. pctcft(n)%get_pct_l2g() > 0)) then + write (6,*)'vegetation found outside the pft mask at n=',n + write (6,*)'pctnatveg,pctcrop=', pctnatpft(n)%get_pct_l2g(), pctcft(n)%get_pct_l2g() + call abort() + end if + end do + + ! Make sure that sums at the landunit level all add to 100% + ! (Note that we don't check pctglcmec here, because it isn't computed at the point + ! that this subroutine is called -- but the check of sum(pctglcmec) is done in + ! mkglcmecMod) + ! (Also note that we don't need to check pctnatpft or pctcft, because a similar check + ! is done internally by the pct_pft_type routines.) + do n = 1,ns_o + if (abs(sum(urbn_classes(n,:)) - 100._r8) > 1.e-12_r8) then + write(6,*) 'sum(urbn_classes(n,:)) != 100: ', n, sum(urbn_classes(n,:)) + call abort() + end if + end do + + if ( nsmall_tot > 0 )then + write (6,*)'number of small pft = ', nsmall_tot + end if + +end subroutine normalizencheck_landuse + +end program mksurfdat diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mktopostatsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mktopostatsMod.F90 new file mode 100644 index 0000000000..2348a9f6f3 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mktopostatsMod.F90 @@ -0,0 +1,155 @@ +module mktopostatsMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mktopostatsMod +! +! !DESCRIPTION: +! make various topography statistics +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public mktopostats ! make topo stddev & mean slope +! +!EOP +!=============================================================== +contains +!=============================================================== + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mktopostats +! +! !INTERFACE: +subroutine mktopostats(ldomain, mapfname, datfname, ndiag, topo_stddev_o, slope_o) +! +! !DESCRIPTION: +! make various topography statistics +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkncdio + use mkdiagnosticsMod, only : output_diagnostics_continuous, output_diagnostics_continuous_outonly + use mkchecksMod, only : min_bad, max_bad +! +! !ARGUMENTS: + + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + real(r8) , intent(out):: topo_stddev_o(:) ! output grid: standard deviation of elevation (m) + real(r8) , intent(out):: slope_o(:) ! output grid: slope (degrees) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: data_i(:) ! data on input grid + integer :: ncid,varid ! input netCDF id's + integer :: ier ! error status + + real(r8), parameter :: min_valid_topo_stddev = 0._r8 + + real(r8), parameter :: min_valid_slope = 0._r8 + real(r8), parameter :: max_valid_slope = 90._r8 + + character(len=32) :: subname = 'mktopostats' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make Topography statistics.....' + call shr_sys_flush(6) + + ! ----------------------------------------------------------------- + ! Read domain and mapping information, check for consistency + ! ----------------------------------------------------------------- + + call domain_read(tdomain,datfname) + + call gridmap_mapread(tgridmap, mapfname ) + call gridmap_check( tgridmap, subname ) + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! ----------------------------------------------------------------- + ! Open input file, allocate memory for input data + ! ----------------------------------------------------------------- + + write(6,*)'Open Topography file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + + allocate(data_i(tdomain%ns), stat=ier) + if (ier/=0) call abort() + + ! ----------------------------------------------------------------- + ! Make topography standard deviation + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'ELEVATION', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areastddev(tgridmap, data_i, topo_stddev_o, nodata=0._r8) + + ! Check validity of output data + if (min_bad(topo_stddev_o, min_valid_topo_stddev, 'topo_stddev')) then + stop + end if + + call output_diagnostics_continuous_outonly(topo_stddev_o, tgridmap, "Topo Std Dev", "m", ndiag) + + ! ----------------------------------------------------------------- + ! Regrid slope + ! ----------------------------------------------------------------- + + call check_ret(nf_inq_varid (ncid, 'SLOPE', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, data_i), subname) + call gridmap_areaave(tgridmap, data_i, slope_o, nodata=0._r8) + + ! Check validity of output data + if (min_bad(slope_o, min_valid_slope, 'slope') .or. & + max_bad(slope_o, max_valid_slope, 'slope')) then + stop + end if + + call output_diagnostics_continuous(data_i, slope_o, tgridmap, "Slope", "degrees", ndiag) + + ! ----------------------------------------------------------------- + ! Close files and deallocate dynamic memory + ! ----------------------------------------------------------------- + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (data_i) + + write (6,*) 'Successfully made Topography statistics' + write (6,*) + call shr_sys_flush(6) + +end subroutine mktopostats + + +end module mktopostatsMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 new file mode 100644 index 0000000000..907eaf7297 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparCommonMod.F90 @@ -0,0 +1,354 @@ +module mkurbanparCommonMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkurbanparCommon +! +! !DESCRIPTION: +! Common routines for making urban parameter data, independent of the method used for +! making the urban parameters (e.g., averages, dominant type, etc.) +! +! (WJS 4-18-12: In the past, this contained routines shared between mkurbanparDomMod and +! mkurbanparAvgMod; now there is just a single module, mkurbanparMod, but I am keeping the +! separate mkurbanparCommonMod in case a similar split comes back in the future. However, +! if such a split seems unlikely in the future, these routines could be moved back into +! mkurbanparMod.) +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkurban_pct ! Make output urban %, given input urban % + public :: mkurban_pct_diagnostics ! print diagnostics related to pct urban + public :: mkelev ! Get elevation to reduce urban for high elevation areas +! +! !PUBLIC DATA MEMBERS: +! + real(r8), parameter :: MIN_DENS = 0.1_r8 ! minimum urban density (% of grid cell) - below this value, urban % is set to 0 + + public :: MIN_DENS +! +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban_pct +! +! !INTERFACE: +subroutine mkurban_pct(ldomain, tdomain, tgridmap, urbn_i, urbn_o) +! +! !DESCRIPTION: +! make percent urban on output grid, given percent urban on input grid +! +! This assumes that we're neither using all_urban or zero_out +! +! +! !USES: + use mkdomainMod , only : domain_type, domain_checksame + use mkgridmapMod + use mkvarctl , only : mksrf_gridtype +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + type(domain_type) , intent(in) :: tdomain ! local domain + type(gridmap_type), intent(in) :: tgridmap ! local gridmap + real(r8) , intent(in) :: urbn_i(:) ! input grid: percent urban + real(r8) , intent(out):: urbn_o(:) ! output grid: percent urban +! +! !REVISION HISTORY: +! Author: Bill Sacks +! (Moved from mkurbanparMod Feb, 2012) +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: sum_fldi ! global sum of dummy input fld + real(r8) :: sum_fldo ! global sum of dummy output fld + integer :: ni,no ! indices + real(r8) :: relerr = 0.00001_r8 ! max error: sum overlap wts ne 1 + character(len=*), parameter :: subname = 'mkurban_pct' +!----------------------------------------------------------------------- + + ! Error checks for array size consistencies + + if (size(urbn_i) /= tdomain%ns .or. & + size(urbn_o) /= ldomain%ns) then + write(6,*) subname//' ERROR: array size inconsistencies' + write(6,*) 'size(urbn_i) = ', size(urbn_i) + write(6,*) 'tdomain%ns = ', tdomain%ns + write(6,*) 'size(urbn_o) = ', size(urbn_o) + write(6,*) 'ldomain%ns = ', ldomain%ns + stop + end if + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine urbn_o on ouput grid: + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_areaave(tgridmap, urbn_i, urbn_o, nodata=0._r8) + + ! Check for conservation + + do no = 1, ldomain%ns + if ((urbn_o(no)) > 100.000001_r8) then + write (6,*) 'MKURBAN error: urban = ',urbn_o(no), & + ' greater than 100.000001 for column, row = ',no + stop + end if + enddo + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,tdomain%ns + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0._r8 + do no = 1, ldomain%ns + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + if (trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1._r8) > relerr ) then + write (6,*) 'MKURBAN error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + ! (Error check2 in mkurban_pct_diagnostics, which should be called separately) + +end subroutine mkurban_pct +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban_pct_diagnostics +! +! !INTERFACE: +subroutine mkurban_pct_diagnostics(ldomain, tdomain, tgridmap, urbn_i, urbn_o, ndiag, dens_class) +! +! !DESCRIPTION: +! print diagnostics related to pct urban +! +! This is intended to be called after mkurban_pct, but is split out into a separate +! routine so that modifications to urbn_o can be made in between the two calls (e.g., +! setting urbn_o to 0 wherever it is less than a certain threshold; the rules for doing +! this can't always be applied inline in mkurban_pct). +! +! !USES: + use mkdomainMod , only : domain_type + use mkgridmapMod, only : gridmap_type + use mkvarpar +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + type(domain_type) , intent(in) :: tdomain ! local domain + type(gridmap_type), intent(in) :: tgridmap ! local gridmap + real(r8) , intent(in) :: urbn_i(:) ! input grid: percent urban + real(r8) , intent(in) :: urbn_o(:) ! output grid: percent urban + integer , intent(in) :: ndiag ! unit number for diag out + + integer , intent(in), optional :: dens_class ! density class +! +! !REVISION HISTORY: +! Author: Bill Sacks +! (Moved from mkurbanparMod Feb, 2012) +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: gurbn_i ! input grid: global urbn + real(r8) :: garea_i ! input grid: global area + real(r8) :: gurbn_o ! output grid: global urbn + real(r8) :: garea_o ! output grid: global area + integer :: ni,no,k ! indices +!----------------------------------------------------------------------- + + ! ----------------------------------------------------------------- + ! Error check2 + ! Compare global areas on input and output grids + ! ----------------------------------------------------------------- + + ! Input grid + + gurbn_i = 0._r8 + garea_i = 0._r8 + + do ni = 1, tdomain%ns + garea_i = garea_i + tgridmap%area_src(ni)*re**2 + gurbn_i = gurbn_i + urbn_i(ni)*(tgridmap%area_src(ni)/100._r8)*& + tgridmap%frac_src(ni)*re**2 + end do + + ! Output grid + + gurbn_o = 0._r8 + garea_o = 0._r8 + + do no = 1, ldomain%ns + garea_o = garea_o + tgridmap%area_dst(no)*re**2 + gurbn_o = gurbn_o + urbn_o(no)* (tgridmap%area_dst(no)/100._r8)*& + tgridmap%frac_dst(no)*re**2 + end do + + ! Diagnostic output + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + if (present(dens_class)) then + write (ndiag,'(1x,a,i0)') 'Urban Output -- class ', dens_class + else + write (ndiag,'(1x,a)') 'Urban Output' + end if + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,2001) +2001 format (1x,'surface type input grid area output grid area'/ & + 1x,' 10**6 km**2 10**6 km**2 ') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + write (ndiag,2003) gurbn_i*1.e-06,gurbn_o*1.e-06 + write (ndiag,2004) garea_i*1.e-06,garea_o*1.e-06 +2002 format (1x,'urban ',f14.3,f17.3) +2003 format (1x,'urban ',f14.3,f22.8) +2004 format (1x,'all surface ',f14.3,f17.3) + +end subroutine mkurban_pct_diagnostics +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkelev +! +! !INTERFACE: +subroutine mkelev(ldomain, mapfname, datfname, varname, ndiag, elev_o) +! +! !DESCRIPTION: +! Make elevation data +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read, domain_checksame + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + character(len=*) , intent(in) :: varname ! topo variable name + real(r8) , intent(out):: elev_o(:) ! output elevation data +! +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Keith Oleson +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + + real(r8), allocatable :: elev_i(:) ! canyon_height to width ratio in + real(r8), allocatable :: mask_i(:) ! input grid: mask (0, 1) + integer :: ns_i,ns_o ! indices + integer :: k,l,n,m,ni ! indices + integer :: ncidi,dimid,varid ! input netCDF id's + integer :: ier ! error status + character(len=256) :: name ! name of attribute + character(len=256) :: unit ! units of attribute + character(len= 32) :: subname = 'mkelev' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make elevation .....' + call shr_sys_flush(6) + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Read input file + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + + ns_i = tdomain%ns + allocate(elev_i(ns_i), stat=ier) + if (ier /= 0) then + write(6,*)'mkelev allocation error'; call abort() + end if + + write (6,*) 'Open elevation file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_varid (ncidi, trim(varname), varid), subname) + call check_ret(nf_get_var_double (ncidi, varid, elev_i), subname) + call check_ret(nf_close(ncidi), subname) + + ! Read topo elev dataset with unit mask everywhere + + call gridmap_mapread(tgridmap, mapfname) + + ! Error checks for domain and map consistencies + ! Note that the topo dataset has no landmask - so a unit landmask is assumed + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Determine elev_o on output grid + + elev_o(:) = 0. + + call gridmap_areaave(tgridmap, elev_i, elev_o, nodata=0._r8) + + ! Deallocate dynamic memory + + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (elev_i) + + write (6,*) 'Successfully made elevation' + write (6,*) + call shr_sys_flush(6) + +end subroutine mkelev + +!----------------------------------------------------------------------- + +end module mkurbanparCommonMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 new file mode 100644 index 0000000000..d470e1f217 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkurbanparMod.F90 @@ -0,0 +1,790 @@ +module mkurbanparMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkurbanpar +! +! !DESCRIPTION: +! Make Urban Parameter data +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + implicit none + + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkurbanInit + public :: mkurban + public :: mkurbanpar + + ! The following could be private, but because there are associated test routines in a + ! separate module, it needs to be public + public :: normalize_urbn_by_tot + +! !PUBLIC DATA MEMBERS: + integer :: numurbl ! number of urban classes + + public :: numurbl + +! !PRIVATE DATA MEMBERS: + ! flag to indicate nodata for index variables in output file: + integer, parameter :: index_nodata = 0 + character(len=*), parameter :: modname = 'mkurbanparMod' + + private :: index_nodata + private :: modname + +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurbanInit +! +! !INTERFACE: +subroutine mkurbanInit(datfname) +! +! !DESCRIPTION: +! Initialize variables needed for urban +! +! !USES: + use mkncdio +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: datfname ! input data file name (same as file used in mkurban) +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: + integer :: ncid,dimid ! input netCDF id's + + character(len=*), parameter :: subname = 'mkurbanInit' +!EOP +!----------------------------------------------------------------------- + + ! Set numurbl + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_dimid (ncid, 'density_class', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, numurbl), subname) + call check_ret(nf_close(ncid), subname) + +end subroutine mkurbanInit +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurban +! +! !INTERFACE: +subroutine mkurban(ldomain, mapfname, datfname, ndiag, zero_out, & + urbn_o, urbn_classes_o, region_o) +! +! !DESCRIPTION: +! make total percent urban, breakdown into urban classes, and region ID on the output grid +! +! urbn_classes_o(n, i) gives the percent of the urban area in grid cell n that is in class #i. +! This is normalized so that sum(urbn_classes_o(n,:)) = 100 for all n, even for grid +! cells where urbn_o(n) = 0 (in the case where urbn_o(n) = 0, we come up with an +! arbitrary assignment of urban into the different classes). +! +! See comments under the normalize_urbn_by_tot subroutine for how urbn_classes_o is +! determined when the total % urban is 0, according to the input data. Note that this +! also applies when all_urban=.true., for points that have 0 urban according to the input +! data. +! +! TODO (WJS 6-12-14): I think this could be rewritten slightly to take advantage of the +! new mkpctPftTypeMod (which should then be renamed to something more general; or maybe +! better, in terms of maintaining helpful abstractions, there could be a new type to +! handle urban, and both that and pct_pft_type could be build on a single set of shared +! code - either as a single base class or through a "has-a" mechanism). This would allow +! us to combine urbn_o and urbn_classes_o into a single derived type variable. I think +! this would also replace the use of normalize_classes_by_gcell, and maybe some other +! urban-specific code. +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkindexmapMod, only : get_dominant_indices + use mkurbanparCommonMod, only : mkurban_pct, mkurban_pct_diagnostics, MIN_DENS + use mkutilsMod , only : normalize_classes_by_gcell + use mkvarctl , only : all_urban + use mkvarpar + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type), intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diag out + logical , intent(in) :: zero_out ! if should zero urban out + real(r8) , intent(out):: urbn_o(:) ! output grid: total % urban + real(r8) , intent(out):: urbn_classes_o(:,:) ! output grid: breakdown of total urban into each class + ! (dimensions: (ldomain%ns, numurbl)) + integer , intent(out):: region_o(:) ! output grid: region ID +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + type(domain_type) :: tdomain ! local domain + type(gridmap_type) :: tgridmap ! local gridmap + real(r8), allocatable :: urbn_classes_gcell_i(:,:) ! input grid: percent urban in each density class + ! (% of total grid cell area) + real(r8), allocatable :: urbn_classes_gcell_o(:,:) ! output grid: percent urban in each density class + ! (% of total grid cell area) + integer , allocatable :: region_i(:) ! input grid: region ID + real(r8), allocatable :: gar_i(:) ! input grid: global area of each urban region ID + real(r8), allocatable :: gar_o(:) ! output grid: global area of each urban region ID + integer :: ni,no,ns,k ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: dimlen ! netCDF dimension length + integer :: max_region ! maximum region index + integer :: ier ! error status + + character(len=*), parameter :: subname = 'mkurban' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make %urban .....' + + ! Obtain input grid info, read local fields + + call gridmap_mapread(tgridmap, mapfname) + call domain_read(tdomain, datfname) + + ns = tdomain%ns + + allocate(urbn_classes_gcell_i(ns, numurbl), & + urbn_classes_gcell_o(ldomain%ns, numurbl), & + stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open urban file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'PCT_URBAN', varid), subname) + call check_ret(nf_get_var_double (ncid, varid, urbn_classes_gcell_i), subname) + + ! Determine % urban by density class on the output grid + do k = 1, numurbl + call mkurban_pct(ldomain, tdomain, tgridmap, urbn_classes_gcell_i(:,k), urbn_classes_gcell_o(:,k)) + end do + + ! Determine total % urban + do no = 1, ldomain%ns + urbn_o(no) = sum(urbn_classes_gcell_o(no,:)) + end do + + call normalize_urbn_by_tot(urbn_classes_gcell_o, urbn_o, urbn_classes_o) + + ! Handle special cases + + ! Note that, for all these adjustments of total urban %, we do not change anything + ! about the breakdown into the different urban classes. In particular: when urbn_o is + ! set to 0 for a point, the breakdown into the different urban classes is maintained + ! as it was before. + if (all_urban) then + urbn_o(:) = 100._r8 + else if (zero_out) then + urbn_o(:) = 0._r8 + else + ! Set points to 0% if they fall below a given threshold + do no = 1, ldomain%ns + if (urbn_o(no) < MIN_DENS) then + urbn_o(no) = 0._r8 + end if + end do + end if + + ! Print diagnostics + ! First, recompute urbn_classes_gcell_o, based on any changes we have made to urbn_o + ! while handling special cases + call normalize_classes_by_gcell(urbn_classes_o, urbn_o, urbn_classes_gcell_o) + do k = 1, numurbl + call mkurban_pct_diagnostics(ldomain, tdomain, tgridmap, & + urbn_classes_gcell_i(:,k), urbn_classes_gcell_o(:,k), & + ndiag, dens_class=k) + end do + + write (6,*) 'Successfully made %urban' + + + write(6,*) 'Attempting to make urban region .....' + + ! Read in region field + ! Note: we do this here, rather than with the rest of the reads above, because we + ! expect the input urban fields to be large, so we're just reading the fields as + ! they're needed to try to avoid unnecessary memory paging + + allocate(region_i(ns), stat=ier) + if (ier/=0) call abort() + call check_ret(nf_inq_varid (ncid, 'REGION_ID', varid), subname) + call check_ret(nf_get_var_int (ncid, varid, region_i), subname) + + ! Determine max region value, and make sure it doesn't exceed bounds of the lookup tables. + ! + ! (Note: this check assumes that region_i=1 refers to region(1), region_i=2 refers to + ! region(2), etc. The alternative would be to use a coordinate variable associated with + ! the region dimension of the lookup table, which could result in an arbitrary mapping + ! between region values and the indices of the lookup table; however, this use of + ! coordinate variables currently isn't supported by lookup_2d_netcdf [as of 2-8-12].) + + max_region = maxval(region_i) + call check_ret(nf_inq_dimid (ncid, 'region', dimid), subname) + call check_ret(nf_inq_dimlen (ncid, dimid, dimlen), subname) + if (max_region > dimlen) then + write(6,*) modname//':'//subname// & + ' ERROR: max region value exceeds length of region dimension' + write(6,*) 'max region value : ', max_region + write(6,*) 'length of region dimension: ', dimlen + call abort() + end if + + ! Determine dominant region for each output cell + + call get_dominant_indices(tgridmap, region_i, region_o, 1, max_region, index_nodata) + + write (6,*) 'Successfully made urban region' + write (6,*) + + ! ----------------------------------------------------------------- + ! Error check + ! Compare areas of each region ID on input and output grids + ! ----------------------------------------------------------------- + + allocate(gar_i(max_region), gar_o(max_region), stat=ier) + if (ier/=0) call abort() + + gar_i(:) = 0. + do ni = 1,tdomain%ns + k = region_i(ni) + if (k >= 1 .and. k <= max_region) then + gar_i(k) = gar_i(k) + tgridmap%area_src(ni)*tgridmap%frac_src(ni)*re**2 + end if + end do + + gar_o(:) = 0. + do no = 1,ldomain%ns + k = region_o(no) + if (k >= 1 .and. k <= max_region) then + gar_o(k) = gar_o(k) + tgridmap%area_dst(no)*tgridmap%frac_dst(no)*re**2 + end if + end do + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('=',k=1,70) + write (ndiag,*) 'Urban Region ID Output' + write (ndiag,'(1x,70a1)') ('=',k=1,70) + + write (ndiag,*) + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,1003) +1003 format (1x,'region ID input grid area output grid area',/ & + 1x,' 10**6 km**2 10**6 km**2') + write (ndiag,'(1x,70a1)') ('.',k=1,70) + write (ndiag,*) + + do k = 1, max_region + write (ndiag,1004) k,gar_i(k)*1.e-06,gar_o(k)*1.e-06 +1004 format (1x,i9,f17.3,f18.3) + end do + + + ! Deallocate dynamic memory & other clean up + + call check_ret(nf_close(ncid), subname) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + deallocate (urbn_classes_gcell_i, urbn_classes_gcell_o, region_i) + deallocate(gar_i, gar_o) + +end subroutine mkurban +!----------------------------------------------------------------------- + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: normalize_urbn_by_tot +! +! !INTERFACE: +subroutine normalize_urbn_by_tot(classes_pct_gcell, sums, classes_pct_tot) +! +! !DESCRIPTION: +! Normalizes urban class areas to produce % cover of each class, as % of total urban area +! +! Specifically: Given (1) an array specifying the % cover of each urban class, as a % of +! the total grid cell area ('classes_pct_gcell'), and (2) a vector giving the total urban +! area in each grid cell, expressed as % of the grid cell area: Returns an array +! ('classes_pct_tot') of the same dimensionality as classes_pct_gcell, where the values +! now give % cover of each class as a % of the total urban area. +! +! Assumes that sums(n) = sum(classes_pct_gcell(n,:)) +! +! When sums(n) = 0, the creation of classes_pct_tot(n,:) is ambiguous. Here we use the +! rule that all area is assigned to the medium-density class, defined by parameter MD. +! +! The returned array satisfies sum(classes_pct_tot(n,:))==100 for all n (within rounding error) +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: classes_pct_gcell(:,:) ! % cover of classes as % of grid cell + real(r8), intent(in) :: sums(:) ! totals, as % of grid cell + real(r8), intent(out):: classes_pct_tot(:,:) ! % cover of classes as % of total +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n ! index + integer :: n_max ! number of points + integer :: nclasses ! number of classes + real(r8) :: suma ! sum for error check + + ! index of medium-density class, which is where we assign urban areas when the total + ! urban area is 0 + integer, parameter :: MD = 3 + + ! relative error tolerance for error check + real(r8), parameter :: relerr = 1.e-10_r8 + + character(len=*), parameter :: subname = 'normalize_urbn_by_tot' +!----------------------------------------------------------------------- + + ! Error-check inputs + + n_max = size(sums) + if (size(classes_pct_tot, 1) /= n_max .or. & + size(classes_pct_gcell, 1) /= n_max) then + write(6,*) subname//' ERROR: array size mismatch' + write(6,*) 'size(sums) = ', n_max + write(6,*) 'size(classes_pct_tot, 1) = ', size(classes_pct_tot, 1) + write(6,*) 'size(classes_pct_gcell, 1) = ', size(classes_pct_gcell, 1) + call abort() + end if + + if (size(classes_pct_tot, 2) /= size(classes_pct_gcell, 2)) then + write(6,*) subname//' ERROR: array size mismatch' + write(6,*) 'size(classes_pct_tot, 2) = ', size(classes_pct_tot, 2) + write(6,*) 'size(classes_pct_gcell, 2) = ', size(classes_pct_gcell, 2) + call abort() + end if + + nclasses = size(classes_pct_gcell, 2) + if (MD > nclasses) then + write(6,*) subname//' ERROR: MD exceeds nclasses' + write(6,*) 'MD = ', MD + write(6,*) 'nclasses = ', nclasses + call abort() + end if + + ! Do the work + + do n = 1, n_max + if (sums(n) > 0._r8) then + classes_pct_tot(n,:) = classes_pct_gcell(n,:)/sums(n) * 100._r8 + else + ! Creation of classes_pct_tot is ambiguous. Apply the rule that all area is + ! assigned to the medium-density class. + classes_pct_tot(n,:) = 0._r8 + classes_pct_tot(n,MD) = 100._r8 + end if + end do + + ! Error-check output: Make sure sum(classes_pct_tot(n,:)) = 100 for all n + + do n = 1, n_max + suma = sum(classes_pct_tot(n,:)) + if (abs(suma/100._r8 - 1._r8) > relerr) then + write(6,*) subname//' ERROR: sum does not equal 100 at point ', n + write(6,*) 'suma = ', suma + call abort() + end if + end do + +end subroutine normalize_urbn_by_tot +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkurbanpar +! +! !INTERFACE: +subroutine mkurbanpar(datfname, ncido, region_o, urbn_classes_gcell_o, urban_skip_abort_on_invalid_data_check) +! +! !DESCRIPTION: +! Make Urban Parameter data +! +! Note that, in a grid cell with region_o==r, parameter values are filled from region r +! for ALL density classes. Thus, the parameter variables have a numurbl dimension along +! with their other dimensions. +! +! Note that we will have a 'nodata' value (given by the fill_val value associated with +! each parameter) wherever (1) we have a nodata value for region_o, or (2) the parameter +! has nodata for the given region/density combination in the input lookup table. +! +! !USES: + use mkdomainMod , only : domain_type, domain_clean, domain_read + use mkindexmapMod, only : dim_slice_type, lookup_2d_netcdf + use mkvarpar + use mkncdio +! +! !ARGUMENTS: + implicit none + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ncido ! output netcdf file id + integer , intent(in) :: region_o(:) ! output grid: region ID (length: ns_o) + real(r8) , intent(in) :: urbn_classes_gcell_o(:,:) ! output grid: percent urban in each density class + ! (% of total grid cell area) (dimensions: ns_o, numurbl) + logical , intent(in) :: urban_skip_abort_on_invalid_data_check + +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + ! Type to store information about each urban parameter + type param + character(len=32) :: name ! name in input & output files + real(r8) :: fill_val ! value to put where we have no data in output + logical :: check_invalid ! should we check whether there are any invalid data in the output? + end type param + + real(r8), allocatable :: data_scalar_o(:,:) ! output array for parameters with no extra dimensions + real(r8), allocatable :: data_rad_o(:,:,:,:) ! output array for parameters dimensioned by numrad & numsolar + real(r8), allocatable :: data_levurb_o(:,:,:) ! output array for parameters dimensioned by nlevurb + integer , allocatable :: unity_dens_o(:,:) ! artificial density indices + integer :: nlevurb_i ! input grid: number of urban vertical levels + integer :: numsolar_i ! input grid: number of solar type (DIR/DIF) + integer :: numrad_i ! input grid: number of solar bands (VIS/NIR) + integer :: m,n,no,ns_o,p,k ! indices + integer :: ncidi,dimid,varid ! netCDF id's + integer :: ier ! error status + character(len=nf_max_name) :: varname ! variable name + + ! information on extra dimensions for lookup tables greater than 2-d: + type(dim_slice_type), allocatable :: extra_dims(:) + + ! suffix for variables dimensioned by numsolar, for each value of numsolar: + character(len=8), parameter :: solar_suffix(numsolar) = (/'_DIR', '_DIF'/) + + ! value to put where we have no data in output variables, for real-valued parameters + real(r8), parameter :: fill_val_real = 0._r8 + + ! To add a new urban parameter, simply add an element to one of the below lists + ! (params_scalar, params_rad or params_levurb) + + ! Urban parameters with no extra dimensions + type(param), parameter :: params_scalar(14) = & + (/ param('CANYON_HWR', fill_val_real, .true.), & + param('EM_IMPROAD', fill_val_real, .true.), & + param('EM_PERROAD', fill_val_real, .true.), & + param('EM_ROOF', fill_val_real, .true.), & + param('EM_WALL', fill_val_real, .true.), & + param('HT_ROOF', fill_val_real, .true.), & + param('THICK_ROOF', fill_val_real, .true.), & + param('THICK_WALL', fill_val_real, .true.), & + param('T_BUILDING_MAX', fill_val_real, .true.), & + param('T_BUILDING_MIN', fill_val_real, .true.), & + param('WIND_HGT_CANYON', fill_val_real, .true.), & + param('WTLUNIT_ROOF', fill_val_real, .true.), & + param('WTROAD_PERV', fill_val_real, .true.), & + + ! Note that NLEV_IMPROAD is written as an integer, meaning that type conversion occurs + ! by truncation. Thus we expect the values in the NLEV_IMPROAD lookup table to be exact; + ! e.g., if a value were 1.99999 rather than 2.0000, it would be written as 1 instead of 2 + ! Also note: we use fill_val=-1 rather than 0, because 0 appears in the lookup table + param('NLEV_IMPROAD', -1, .true.) /) + + ! Urban parameters dimensioned by numrad & numsolar + type(param), parameter :: params_rad(4) = & + (/ param('ALB_IMPROAD', fill_val_real, .true.), & + param('ALB_PERROAD', fill_val_real, .true.), & + param('ALB_ROOF', fill_val_real, .true.), & + param('ALB_WALL', fill_val_real, .true.) /) + + ! Urban parameters dimensioned by nlevurb + type(param), parameter :: params_levurb(6) = & + (/ param('TK_ROOF', fill_val_real, .true.), & + param('TK_WALL', fill_val_real, .true.), & + param('CV_ROOF', fill_val_real, .true.), & + param('CV_WALL', fill_val_real, .true.), & + + ! Impervious road thermal conductivity and heat capacity have varying levels of + ! data. Thus, we expect to find some missing values in the lookup table -- we + ! do not want to treat that as an error -- thus, we set check_invalid=.false. + param('CV_IMPROAD', fill_val_real, .false.), & + param('TK_IMPROAD', fill_val_real, .false.) /) + + + character(len=*), parameter :: subname = 'mkurbanpar' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make Urban Parameters .....' + call shr_sys_flush(6) + + ! Determine & error-check array sizes + ns_o = size(region_o) + if (size(urbn_classes_gcell_o, 1) /= ns_o) then + write(6,*) modname//':'//subname//' ERROR: array size mismatch' + write(6,*) 'size(region_o) = ', size(region_o) + write(6,*) 'size(urbn_classes_gcell_o, 1) = ', size(urbn_classes_gcell_o, 1) + call abort() + end if + if (size(urbn_classes_gcell_o, 2) /= numurbl) then + write(6,*) modname//':'//subname//' ERROR: array size mismatch' + write(6,*) 'size(urbn_classes_gcell_o, 2) = ', size(urbn_classes_gcell_o, 2) + write(6,*) 'numurbl = ', numurbl + end if + + + ! Read dimensions from input file + + write (6,*) 'Open urban parameter file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncidi), subname) + call check_ret(nf_inq_dimid(ncidi, 'nlevurb', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, nlevurb_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numsolar', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numsolar_i), subname) + call check_ret(nf_inq_dimid(ncidi, 'numrad', dimid), subname) + call check_ret(nf_inq_dimlen(ncidi, dimid, numrad_i), subname) + + if (nlevurb_i /= nlevurb) then + write(6,*)'MKURBANPAR: parameter nlevurb= ',nlevurb, & + 'does not equal input dataset nlevurb= ',nlevurb_i + stop + endif + if (numsolar_i /= numsolar) then + write(6,*)'MKURBANPAR: parameter numsolar= ',numsolar, & + 'does not equal input dataset numsolar= ',numsolar_i + stop + endif + if (numrad_i /= numrad) then + write(6,*)'MKURBANPAR: parameter numrad= ',numrad, & + 'does not equal input dataset numrad= ',numrad_i + stop + endif + + ! Create an array that will hold the density indices + ! In a given grid cell, we output parameter values for all density classes, for the + ! region of that grid cell. In order to do this while still using the lookup_2d + ! routine, we create a dummy unity_dens_o array that contains the density values + ! passed to the lookup routine. + + allocate(unity_dens_o(ns_o, numurbl)) + do k = 1, numurbl + unity_dens_o(:,k) = k + end do + + ! Handle urban parameters with no extra dimensions + + allocate(data_scalar_o(ns_o, numurbl), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + do p = 1, size(params_scalar) + call lookup_and_check_err(params_scalar(p)%name, params_scalar(p)%fill_val, & + params_scalar(p)%check_invalid, urban_skip_abort_on_invalid_data_check, & + data_scalar_o, 0) + + call check_ret(nf_inq_varid(ncido, params_scalar(p)%name, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_scalar_o), subname) + end do + + deallocate(data_scalar_o) + + ! Handle urban parameters dimensioned by numrad & numsolar + + allocate(data_rad_o(ns_o, numurbl, numrad, numsolar), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + allocate(extra_dims(2)) + extra_dims(1)%name = 'numrad' + extra_dims(2)%name = 'numsolar' + + do p = 1, size(params_rad) + do m = 1,numsolar + extra_dims(2)%val = m + do n = 1,numrad + extra_dims(1)%val = n + + call lookup_and_check_err(params_rad(p)%name, params_rad(p)%fill_val, & + params_rad(p)%check_invalid, urban_skip_abort_on_invalid_data_check, & + data_rad_o(:,:,n,m), & + 2, extra_dims) + end do + end do + + ! Special handling of numsolar: rather than outputting variables with a numsolar + ! dimension, we output separate variables for each value of numsolar + do m = 1,numsolar + if (len_trim(params_rad(p)%name) + len_trim(solar_suffix(m)) > len(varname)) then + write(6,*) 'variable name exceeds length of varname' + write(6,*) trim(params_rad(p)%name)//trim(solar_suffix(m)) + call abort() + end if + varname = trim(params_rad(p)%name)//trim(solar_suffix(m)) + call check_ret(nf_inq_varid(ncido, varname, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_rad_o(:,:,:,m)), subname) + end do + end do + + deallocate(data_rad_o) + deallocate(extra_dims) + + ! Handle urban parameters dimensioned by nlevurb + + allocate(data_levurb_o(ns_o, numurbl, nlevurb), stat=ier) + if (ier /= 0) then + write(6,*)'mkurbanpar allocation error'; call abort() + end if + + allocate(extra_dims(1)) + extra_dims(1)%name = 'nlevurb' + + do p = 1, size(params_levurb) + do n = 1,nlevurb + extra_dims(1)%val = n + + call lookup_and_check_err(params_levurb(p)%name, params_levurb(p)%fill_val, & + params_levurb(p)%check_invalid, & + urban_skip_abort_on_invalid_data_check, data_levurb_o(:,:,n), & + 1, extra_dims) + end do + + call check_ret(nf_inq_varid(ncido, params_levurb(p)%name, varid), subname) + ! In the following, note that type conversion occurs if we're writing to a variable of type + ! other than double; e.g., for an integer, conversion occurs by truncation! + call check_ret(nf_put_var_double(ncido, varid, data_levurb_o), subname) + end do + + deallocate(data_levurb_o) + deallocate(extra_dims) + + + call check_ret(nf_close(ncidi), subname) + call check_ret(nf_sync(ncido), subname) + + write (6,*) 'Successfully made Urban Parameters' + write (6,*) + call shr_sys_flush(6) + + deallocate(unity_dens_o) + +contains +!------------------------------------------------------------------------------ + subroutine lookup_and_check_err(varname, fill_val, check_invalid, & + urban_skip_abort_on_invalid_data_check, data, n_extra_dims, extra_dims) + + ! Wrapper to lookup_2d_netcdf: Loops over each density class, calling lookup_2d_netcdf + ! with that density class and filling the appropriate slice of the data array. Also + ! checks for any errors, aborting if there were any. + ! + ! Note that the lookup_2d_netcdf routine is designed to work with a single value of + ! each of the indices. However, we want to fill parameter values for ALL density + ! classes. This is why we loop over density class in this routine. + ! + ! Note: inherits a number of variables from the parent routine + + use mkindexmapMod, only : lookup_2d_netcdf + + implicit none + character(len=*), intent(in) :: varname ! name of lookup table + real(r8) , intent(in) :: fill_val ! value to put where we have no data in output variables + logical , intent(in) :: check_invalid ! should we check whether there are any invalid data in the output? + logical , intent(in) :: urban_skip_abort_on_invalid_data_check + + real(r8) , intent(out):: data(:,:) ! output from lookup_2d_netcdf + integer , intent(in) :: n_extra_dims ! number of extra dimensions in the lookup table + + ! slice to use if lookup table variable has more than 2 dimensions: + type(dim_slice_type), intent(in), optional :: extra_dims(:) + + ! Local variables: + + integer :: k,n ! indices + integer :: ierr ! error return code + + + do k = 1, numurbl + ! In the following, note that unity_dens_o(:,k) has been constructed so that + ! unity_dens_o(:,k)==k everywhere. Thus, we fill data(:,k) with the parameter + ! values corresponding to density class k. + ! Also note: We use invalid_okay=.true. because we fill all density classes, + ! some of which may have invalid entries. Because doing so disables some error + ! checking, we do our own error checking after the call. + call lookup_2d_netcdf(ncidi, varname, .true., & + 'density_class', 'region', n_extra_dims, & + unity_dens_o(:,k), region_o, fill_val, data(:,k), ierr, & + extra_dims=extra_dims, nodata=index_nodata, & + invalid_okay=.true.) + + if (ierr /= 0) then + write(6,*) modname//':'//subname//' ERROR in lookup_2d_netcdf for ', & + trim(varname), ' class', k, ': err=', ierr + call abort() + end if + + if (check_invalid) then + ! Make sure we have valid parameter values wherever we have non-zero urban cover + do n = 1, ns_o + ! This check assumes that fill_val doesn't appear in any of the valid entries + ! of the lookup table + if (urbn_classes_gcell_o(n,k) > 0. .and. data(n,k) == fill_val) then + write(6,*) modname//':'//subname//' ERROR: fill value found in output where urban cover > 0' + write(6,*) 'var: ', trim(varname) + write(6,*) 'class: ', k + write(6,*) 'n: ', n + write(6,*) 'region: ', region_o(n) + write(6,*) 'urbn_classes_gcell_o(n,k): ', urbn_classes_gcell_o(n,k) + if (.not. urban_skip_abort_on_invalid_data_check) then + ! NOTE(bja, 2015-01) added to work around a ?bug? noted in + ! /glade/p/cesm/cseg/inputdata/lnd/clm2/surfdata_map/README_c141219 + call abort() + end if + end if + end do + end if + + end do + + end subroutine lookup_and_check_err + +end subroutine mkurbanpar +!------------------------------------------------------------------------------ + +end module mkurbanparMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 new file mode 100644 index 0000000000..43e779745b --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkutilsMod.F90 @@ -0,0 +1,197 @@ +module mkutilsMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkutils +! +! !DESCRIPTION: +! General-purpose utilities for mksurfdata_map +! +! +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private +! +! !PUBLIC MEMBER FUNCTIONS: + public :: normalize_classes_by_gcell ! renormalize array so values are given as % of total grid cell area + public :: slightly_below + public :: slightly_above +! +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +!EOP +!------------------------------------------------------------------------------ +contains + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: normalize_classes_by_gcell +! +! !INTERFACE: +subroutine normalize_classes_by_gcell(classes_pct_tot, sums, classes_pct_gcell) +! +! !DESCRIPTION: +! Renormalizes an array (gcell x class) so that values are given as % of total grid cell area +! +! Specifically: Given (1) an array specifying the % cover of different classes, as a % of +! some total ('classes_pct_tot'), and (2) a vector giving these totals ('sums'), expressed +! as % of grid cell area: Returns an array ('classes_pct_gcell') of the same +! dimensionality as classes_pct_tot, where the values now give the % cover of each class +! as a % of total grid cell area. +! +! The size of 'sums' should match the size of the first dimension in 'classes_pct_tot' and +! 'classes_pct_gcell' +! +! For example, if classes_pct_tot(n,i) gives the % of the urban area in grid cell n that is +! in urban class #i, and sums(n) gives the % of grid cell n that is urban, then +! classes_pct_gcell(n,i) will give the % of the total area of grid cell n that is in urban +! class #i. +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: classes_pct_tot(:,:) ! % cover of classes as % of total + real(r8), intent(in) :: sums(:) ! totals, as % of grid cell + real(r8), intent(out):: classes_pct_gcell(:,:) ! % cover of classes as % of grid cell +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + integer :: n, n_max + + character(len=*), parameter :: subname = "normalize_classes_by_gcell" +!------------------------------------------------------------------------------ + + ! Error-check inputs + + n_max = size(sums) + if (size(classes_pct_tot, 1) /= n_max .or. & + size(classes_pct_gcell, 1) /= n_max) then + write(6,*) subname//' ERROR: array size mismatch' + write(6,*) 'size(sums) = ', n_max + write(6,*) 'size(classes_pct_tot, 1) = ', size(classes_pct_tot, 1) + write(6,*) 'size(classes_pct_gcell, 1) = ', size(classes_pct_gcell, 1) + call abort() + end if + + if (size(classes_pct_tot, 2) /= size(classes_pct_gcell, 2)) then + write(6,*) subname//' ERROR: array size mismatch' + write(6,*) 'size(classes_pct_tot, 2) = ', size(classes_pct_tot, 2) + write(6,*) 'size(classes_pct_gcell, 2) = ', size(classes_pct_gcell, 2) + call abort() + end if + + ! Do the work + + do n = 1, n_max + classes_pct_gcell(n,:) = classes_pct_tot(n,:) * (sums(n)/100._r8) + end do +end subroutine normalize_classes_by_gcell +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: slightly_below +! +! !INTERFACE: +logical function slightly_below(a, b, eps) +! +! !DESCRIPTION: +! Returns true if a is slightly below b; false if a is significantly below b or if a is +! greater than or equal to b +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: a + real(r8), intent(in) :: b + + ! if provided, eps gives the relative error allowed for checking the "slightly" + ! condition; if not provided, the tolerance defaults to the value given by eps_default + real(r8), intent(in), optional :: eps +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: l_eps + real(r8), parameter :: eps_default = 1.e-15_r8 ! default relative error tolerance +!------------------------------------------------------------------------------ + + if (present(eps)) then + l_eps = eps + else + l_eps = eps_default + end if + + if (a < b .and. (b - a)/b < l_eps) then + slightly_below = .true. + else + slightly_below = .false. + end if + +end function slightly_below +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: slightly_above +! +! !INTERFACE: +logical function slightly_above(a, b, eps) +! +! !DESCRIPTION: +! Returns true if a is slightly above b; false if a is significantly above b or if a is +! less than or equal to b +! +! !USES: +! +! !ARGUMENTS: + implicit none + real(r8), intent(in) :: a + real(r8), intent(in) :: b + + ! if provided, eps gives the relative error allowed for checking the "slightly" + ! condition; if not provided, the tolerance defaults to the value given by eps_default + real(r8), intent(in), optional :: eps +! +! !REVISION HISTORY: +! Author: Bill Sacks +! +! +! !LOCAL VARIABLES: +!EOP + real(r8) :: l_eps + real(r8), parameter :: eps_default = 1.e-15_r8 ! default relative error tolerance +!------------------------------------------------------------------------------ + + if (present(eps)) then + l_eps = eps + else + l_eps = eps_default + end if + + if (a > b .and. (a - b)/b < l_eps) then + slightly_above = .true. + else + slightly_above = .false. + end if + +end function slightly_above +!------------------------------------------------------------------------------ + +end module mkutilsMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 new file mode 100644 index 0000000000..ffc59614b4 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarctl.F90 @@ -0,0 +1,85 @@ +module mkvarctl + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkvarctl +! +! !DESCRIPTION: +! Module containing control variables +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + private + save +! + real(r8), public, parameter :: spval = 1.e36 ! special value + + logical, public :: outnc_large_files ! output files in 64-bit format for large files + logical, public :: outnc_double ! output ALL data in files as 64-bit + integer, public :: outnc_dims = 2 ! only applicable to lat/lon grids + logical, public :: outnc_1d ! true => output file is 1d + + character(len= 32), public :: mksrf_gridnm = ' ' ! name of grid to use on output file + character(len=256), public :: mksrf_fgrid = ' ' ! land grid file name to use + character(len=256), public :: mksrf_gridtype = ' ' ! land gridtype, global or reg + character(len=256), public :: mksrf_fvegtyp = ' ' ! vegetation data file name + character(len=256), public :: mksrf_fsoitex = ' ' ! soil texture data file name + character(len=256), public :: mksrf_forganic = ' ' ! organic matter data file name + character(len=256), public :: mksrf_fsoicol = ' ' ! soil color data file name + character(len=256), public :: mksrf_fabm = ' ' ! ag fire peak month and + character(len=256), public :: mksrf_fpeat = ' ' ! peatlands and + character(len=256), public :: mksrf_fgdp = ' ' ! gdp data file names + character(len=256), public :: mksrf_flakwat = ' ' ! inland lake data file name + character(len=256), public :: mksrf_fwetlnd = ' ' ! inland wetlands data file name + character(len=256), public :: mksrf_furban = ' ' ! urban data file name + character(len=256), public :: mksrf_fglacier = ' ' ! glacier data file name + character(len=256), public :: mksrf_furbtopo = ' ' ! urban topography data file name + character(len=256), public :: mksrf_flndtopo = ' ' ! land topography data file name + character(len=256), public :: mksrf_fmax = ' ' ! fmax data file name + character(len=256), public :: mksrf_flai = ' ' ! lai data filename + character(len=256), public :: mksrf_fdynuse = ' ' ! ascii file containing names of dynamic land use files + character(len=256), public :: mksrf_fvocef = ' ' ! VOC Emission Factor data file name + character(len=256), public :: mksrf_ftopostats = ' ' ! topography statistics data file name + character(len=256), public :: mksrf_fvic = ' ' ! VIC parameters data file name + character(len=256), public :: mksrf_fch4 = ' ' ! inversion-derived CH4 parameters data file name + + integer , public :: numpft = 16 ! number of plant types + + character(len=256), public :: map_fpft = ' ' ! Mapping file for PFT + character(len=256), public :: map_flakwat = ' ' ! Mapping file for lake water + character(len=256), public :: map_fwetlnd = ' ' ! Mapping file for wetland water + character(len=256), public :: map_fglacier = ' ' ! Mapping file for glacier + character(len=256), public :: map_fsoitex = ' ' ! Mapping file for soil texture + character(len=256), public :: map_fsoicol = ' ' ! Mapping file for soil color + character(len=256), public :: map_fabm = ' ' ! Mapping file: ag fire... + character(len=256), public :: map_fpeat = ' ' ! Mapping file: peatlands + character(len=256), public :: map_fgdp = ' ' ! Mapping file: gdp + character(len=256), public :: map_furban = ' ' ! Mapping file for urban + character(len=256), public :: map_furbtopo = ' ' ! Mapping file for urban topography + character(len=256), public :: map_flndtopo = ' ' ! Mapping file for land topography + character(len=256), public :: map_fmax = ' ' ! Mapping file for soil frac max + character(len=256), public :: map_forganic = ' ' ! Mapping file for organic soil + character(len=256), public :: map_fvocef = ' ' ! Mapping file for VOC emission factors + character(len=256), public :: map_flai = ' ' ! Mapping file for LAI + character(len=256), public :: map_fharvest = ' ' ! Mapping file for harvesting + character(len=256), public :: map_ftopostats = ' ' ! Mapping file for topography statistics + character(len=256), public :: map_fvic = ' ' ! Mapping file for VIC parameters + character(len=256), public :: map_fch4 = ' ' ! Mapping file for inversion-derived CH4 parameters +! +! Variables to override data read in with +! (all_urban is mostly for single-point mode, but could be used for sensitivity studies) +! + logical, public :: all_urban ! output ALL data as 100% covered in urban + logical, public :: no_inlandwet ! set wetland to 0% over land; wetland will only be used for ocean points +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein 11/04 +! +!EOP +!----------------------------------------------------------------------- + +end module mkvarctl diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 new file mode 100644 index 0000000000..ffcdac92d0 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvarpar.F90 @@ -0,0 +1,33 @@ +module mkvarpar + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: clm_varpar +! +! !DESCRIPTION: +! Module containing CLM parameters +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_REARTH +! +! !PUBLIC TYPES: + implicit none + save +! + integer, parameter :: nlevsoi = 10 ! number of soil layers + integer, parameter :: numstdpft = 16! number of standard PFT types + integer, parameter :: numstdcft = 2 ! of the number of standard PFT types, how many are crop (CFT) + integer, parameter :: noveg = 0 ! value for non-vegetated pft + integer, parameter :: nlevurb = 5 ! number of urban layers + integer, parameter :: numsolar = 2 ! number of solar types (Direct,Diffuse) + integer, parameter :: numrad = 2 ! number of solar bands (VIS,NIR) + real(r8),parameter :: elev_thresh = 2600._r8 ! elevation threshold for screening urban areas + real(r8),parameter :: re = SHR_CONST_REARTH*0.001 + +! +!EOP +!----------------------------------------------------------------------- + +end module mkvarpar diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 new file mode 100644 index 0000000000..bf4bc33702 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/mkvocefMod.F90 @@ -0,0 +1,218 @@ +module mkvocefMod +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: mkvocMod +! +! !DESCRIPTION: +! Make VOC percentage emissions for surface dataset +! +! !REVISION HISTORY: +! Author: Erik Kluzek +! +!----------------------------------------------------------------------- +! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use mkdomainMod , only : domain_checksame + + implicit none + private + +! !PUBLIC MEMBER FUNCTIONS: + public :: mkvocef ! Get the percentage emissions for VOC for different + ! land cover types +!EOP + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: mkvocef +! +! !INTERFACE: +subroutine mkvocef(ldomain, mapfname, datfname, ndiag, & + ef_btr_o, ef_fet_o, ef_fdt_o, ef_shr_o, ef_grs_o, ef_crp_o) +! +! !DESCRIPTION: +! make volatile organic coumpunds (VOC) emission factors. +! +! !USES: + use mkdomainMod, only : domain_type, domain_clean, domain_read + use mkgridmapMod + use mkvarpar + use mkvarctl + use mkncdio +! +! !ARGUMENTS: + implicit none + type(domain_type) , intent(in) :: ldomain + character(len=*) , intent(in) :: mapfname ! input mapping file name + character(len=*) , intent(in) :: datfname ! input data file name + integer , intent(in) :: ndiag ! unit number for diagnostic output + real(r8) , intent(out):: ef_btr_o(:) ! output grid: EFs for broadleaf trees + real(r8) , intent(out):: ef_fet_o(:) ! output grid: EFs for fineleaf evergreen + real(r8) , intent(out):: ef_fdt_o(:) ! output grid: EFs for fineleaf deciduous + real(r8) , intent(out):: ef_shr_o(:) ! output grid: EFs for shrubs + real(r8) , intent(out):: ef_grs_o(:) ! output grid: EFs for grasses + real(r8) , intent(out):: ef_crp_o(:) ! output grid: EFs for crops +! +! !CALLED FROM: +! subroutine mksrfdat in module mksrfdatMod +! +! !REVISION HISTORY: +! Author: Colette L. Heald +! 17 Jul 2007 F Vitt -- updated to pftintdat06_clm3_5_05 and corrected indexing of ef_*_i arrarys +! +!EOP +! +! !LOCAL VARIABLES: + type(gridmap_type) :: tgridmap + type(domain_type) :: tdomain ! local domain + real(r8), allocatable :: ef_btr_i(:) ! input grid: EFs for broadleaf trees + real(r8), allocatable :: ef_fet_i(:) ! input grid: EFs for fineleaf evergreen + real(r8), allocatable :: ef_fdt_i(:) ! input grid: EFs for fineleaf deciduous + real(r8), allocatable :: ef_shr_i(:) ! input grid: EFs for shrubs + real(r8), allocatable :: ef_grs_i(:) ! input grid: EFs for grasses + real(r8), allocatable :: ef_crp_i(:) ! input grid: EFs for crops + real(r8) :: sum_fldo ! global sum of dummy input fld + real(r8) :: sum_fldi ! global sum of dummy input fld + integer :: k,n,no,ni,ns_o,ns_i ! indices + integer :: ncid,dimid,varid ! input netCDF id's + integer :: ier ! error status + real(r8) :: relerr = 0.00001_r8 ! max error: sum overlap wts ne 1 + character(len=32) :: subname = 'mkvocef' +!----------------------------------------------------------------------- + + write (6,*) 'Attempting to make VOC emission factors .....' + call shr_sys_flush(6) + + ns_o = ldomain%ns + + ! ----------------------------------------------------------------- + ! Read input Emission Factors + ! ----------------------------------------------------------------- + + ! Obtain input grid info, read local fields + + call domain_read(tdomain,datfname) + ns_i = tdomain%ns + allocate(ef_btr_i(ns_i), ef_fet_i(ns_i), ef_fdt_i(ns_i), & + ef_shr_i(ns_i), ef_grs_i(ns_i), ef_crp_i(ns_i), & + stat=ier) + if (ier/=0) call abort() + + write (6,*) 'Open VOC file: ', trim(datfname) + call check_ret(nf_open(datfname, 0, ncid), subname) + call check_ret(nf_inq_varid (ncid, 'ef_btr', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_btr_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_fet', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_fet_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_fdt', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_fdt_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_shr', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_shr_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_grs', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_grs_i), subname) + call check_ret(nf_inq_varid (ncid, 'ef_crp', varid), subname) + call check_ret(nf_get_var_double(ncid, varid, ef_crp_i), subname) + call check_ret(nf_close(ncid), subname) + + ! Area-average percent cover on input grid to output grid + ! and correct according to land landmask + ! Note that percent cover is in terms of total grid area. + + call gridmap_mapread(tgridmap, mapfname ) + + ! Error checks for domain and map consistencies + + call domain_checksame( tdomain, ldomain, tgridmap ) + + ! Do mapping from input to output grid + + call gridmap_areaave(tgridmap, ef_btr_i, ef_btr_o, nodata=0._r8) + call gridmap_areaave(tgridmap, ef_fet_i, ef_fet_o, nodata=0._r8) + call gridmap_areaave(tgridmap, ef_fdt_i, ef_fdt_o, nodata=0._r8) + call gridmap_areaave(tgridmap, ef_shr_i, ef_shr_o, nodata=0._r8) + call gridmap_areaave(tgridmap, ef_grs_i, ef_grs_o, nodata=0._r8) + call gridmap_areaave(tgridmap, ef_crp_i, ef_crp_o, nodata=0._r8) + + ! Check for conservation + + do no = 1, ns_o + if ( ef_btr_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF btr = ',ef_btr_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_fet_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF fet = ',ef_fet_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_fdt_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF fdt = ',ef_fdt_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_shr_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF shr = ',ef_shr_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_grs_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF grs = ',ef_grs_o(no), & + ' is negative for no = ',no + call abort() + end if + if ( ef_crp_o(no) < 0._r8 ) then + write (6,*) 'MKVOCEF error: EF crp = ',ef_crp_o(no), & + ' is negative for no = ',no + call abort() + end if + enddo + + ! ----------------------------------------------------------------- + ! Error check1 + ! Compare global sum fld_o to global sum fld_i. + ! ----------------------------------------------------------------- + + ! Global sum of output field -- must multiply by fraction of + ! output grid that is land as determined by input grid + + sum_fldi = 0.0_r8 + do ni = 1,ns_i + sum_fldi = sum_fldi + tgridmap%area_src(ni) * tgridmap%frac_src(ni) + enddo + + sum_fldo = 0._r8 + do no = 1,ns_o + sum_fldo = sum_fldo + tgridmap%area_dst(no) * tgridmap%frac_dst(no) + end do + + if ( trim(mksrf_gridtype) == 'global') then + if ( abs(sum_fldo/sum_fldi-1._r8) > relerr ) then + write (6,*) 'MKVOCEF error: input field not conserved' + write (6,'(a30,e20.10)') 'global sum output field = ',sum_fldo + write (6,'(a30,e20.10)') 'global sum input field = ',sum_fldi + stop + end if + end if + + write (6,*) 'Successfully made VOC Emission Factors' + write (6,*) + call shr_sys_flush(6) + + ! Deallocate dynamic memory + + deallocate ( ef_btr_i, ef_fet_i, ef_fdt_i, & + ef_shr_i, ef_grs_i, ef_crp_i ) + call domain_clean(tdomain) + call gridmap_clean(tgridmap) + +end subroutine mkvocef + +!----------------------------------------------------------------------- + +end module mkvocefMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/nanMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/nanMod.F90 new file mode 100644 index 0000000000..0cbeeea112 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/nanMod.F90 @@ -0,0 +1,41 @@ +module nanMod + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: nanMod +! +! !DESCRIPTION: +! Set parameters for the floating point flags "inf" Infinity +! and "nan" not-a-number. As well as "bigint" the point +! at which integers start to overflow. These values are used +! to initialize arrays with as a way to detect if arrays +! are being used before being set. +! Note that bigint is the largest possible 32-bit integer. +! +! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 +! +! !PUBLIC TYPES: + implicit none + save +#ifdef __PGI +! quiet nan for portland group compilers + real(r8), parameter :: inf = O'0777600000000000000000' + real(r8), parameter :: nan = O'0777700000000000000000' + integer, parameter :: bigint = O'17777777777' +#else +! signaling nan otherwise + real(r8), parameter :: inf = O'0777600000000000000000' + real(r8), parameter :: nan = O'0777610000000000000000' + integer, parameter :: bigint = O'17777777777' +#endif +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein based on cam module created by +! CCM core group +! +!EOP +!----------------------------------------------------------------------- + +end module nanMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_const_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_const_mod.F90 new file mode 100644 index 0000000000..16529ae9b7 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_const_mod.F90 @@ -0,0 +1,61 @@ +!=============================================================================== +! SVN $Id: shr_const_mod.F90 6749 2007-10-04 20:58:20Z jwolfe $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_100228/shr/shr_const_mod.F90 $ +!=============================================================================== + +MODULE shr_const_mod + + use shr_kind_mod + + integer(SHR_KIND_IN),parameter,private :: R8 = SHR_KIND_R8 ! rename for local readability only + + !---------------------------------------------------------------------------- + ! physical constants (all data public) + !---------------------------------------------------------------------------- + public + + real(R8),parameter :: SHR_CONST_PI = 3.14159265358979323846_R8 ! pi + real(R8),parameter :: SHR_CONST_CDAY = 86400.0_R8 ! sec in calendar day ~ sec + real(R8),parameter :: SHR_CONST_SDAY = 86164.0_R8 ! sec in siderial day ~ sec + real(R8),parameter :: SHR_CONST_OMEGA = 2.0_R8*SHR_CONST_PI/SHR_CONST_SDAY ! earth rot ~ rad/sec + real(R8),parameter :: SHR_CONST_REARTH = 6.37122e6_R8 ! radius of earth ~ m + real(R8),parameter :: SHR_CONST_G = 9.80616_R8 ! acceleration of gravity ~ m/s^2 + + real(R8),parameter :: SHR_CONST_STEBOL = 5.67e-8_R8 ! Stefan-Boltzmann constant ~ W/m^2/K^4 + real(R8),parameter :: SHR_CONST_BOLTZ = 1.38065e-23_R8 ! Boltzmann's constant ~ J/K/molecule + real(R8),parameter :: SHR_CONST_AVOGAD = 6.02214e26_R8 ! Avogadro's number ~ molecules/kmole + real(R8),parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! Universal gas constant ~ J/K/kmole + real(R8),parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole + real(R8),parameter :: SHR_CONST_MWWV = 18.016_R8 ! molecular weight water vapor + real(R8),parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR ! Dry air gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_RWV = SHR_CONST_RGAS/SHR_CONST_MWWV ! Water vapor gas constant ~ J/K/kg + real(R8),parameter :: SHR_CONST_ZVIR = (SHR_CONST_RWV/SHR_CONST_RDAIR)-1.0_R8 ! RWV/RDAIR - 1.0 + real(R8),parameter :: SHR_CONST_KARMAN = 0.4_R8 ! Von Karman constant + real(R8),parameter :: SHR_CONST_PSTD = 101325.0_R8 ! standard pressure ~ pascals + real(R8),parameter :: SHR_CONST_PDB = 0.0112372_R8 ! ratio of 13C/12C in Pee Dee Belemnite (C isotope standard) + + real(R8),parameter :: SHR_CONST_TKTRIP = 273.16_R8 ! triple point of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZ = 273.15_R8 ! freezing T of fresh water ~ K + real(R8),parameter :: SHR_CONST_TKFRZSW = SHR_CONST_TKFRZ - 1.8_R8 ! freezing T of salt water ~ K + + real(R8),parameter :: SHR_CONST_RHODAIR = & ! density of dry air at STP ~ kg/m^3 + SHR_CONST_PSTD/(SHR_CONST_RDAIR*SHR_CONST_TKFRZ) + real(R8),parameter :: SHR_CONST_RHOFW = 1.000e3_R8 ! density of fresh water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOSW = 1.026e3_R8 ! density of sea water ~ kg/m^3 + real(R8),parameter :: SHR_CONST_RHOICE = 0.917e3_R8 ! density of ice ~ kg/m^3 + real(R8),parameter :: SHR_CONST_CPDAIR = 1.00464e3_R8 ! specific heat of dry air ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPWV = 1.810e3_R8 ! specific heat of water vap ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPVIR = (SHR_CONST_CPWV/SHR_CONST_CPDAIR)-1.0_R8 ! CPWV/CPDAIR - 1.0 + real(R8),parameter :: SHR_CONST_CPFW = 4.188e3_R8 ! specific heat of fresh h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPSW = 3.996e3_R8 ! specific heat of sea h2o ~ J/kg/K + real(R8),parameter :: SHR_CONST_CPICE = 2.11727e3_R8 ! specific heat of fresh ice ~ J/kg/K + real(R8),parameter :: SHR_CONST_LATICE = 3.337e5_R8 ! latent heat of fusion ~ J/kg + real(R8),parameter :: SHR_CONST_LATVAP = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + real(R8),parameter :: SHR_CONST_LATSUB = & ! latent heat of sublimation ~ J/kg + SHR_CONST_LATICE + SHR_CONST_LATVAP + real(R8),parameter :: SHR_CONST_OCN_REF_SAL = 34.7_R8 ! ocn ref salinity (psu) + real(R8),parameter :: SHR_CONST_ICE_REF_SAL = 4.0_R8 ! ice ref salinity (psu) + + real(R8),parameter :: SHR_CONST_SPVAL = 1.0e30_R8 ! special missing value + +END MODULE shr_const_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_file_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_file_mod.F90 new file mode 100644 index 0000000000..7e803c3194 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_file_mod.F90 @@ -0,0 +1,1027 @@ +!=============================================================================== +! SVN $Id: shr_file_mod.F90 22436 2010-04-18 05:32:48Z tcraig $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_110213/shr/shr_file_mod.F90 $ +!=============================================================================== +!BOP =========================================================================== +! +! !MODULE: shr_file_mod.F90 --- Module to handle various file utilily functions. +! +! !DESCRIPTION: +! +! Miscilaneous methods to handle file and directory utilities as well as FORTRAN +! unit control. Also put/get local files into/from archival location +! +! File utilites used with CCSM Message passing: +! +! shr_file_stdio is the main example here, it changes the working directory, +! changes stdin and stdout to a given filename. +! +! This is needed because some implementations of MPI with MPMD so that +! each executable can run in a different working directory and redirect +! output to different files. +! +! File name archival convention, eg. +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! is extensible -- the existence of the option file name prefix, eg. "mss:", +! and optional arguments, eg. rtpd-3650 can be used to access site-specific +! storage devices. Based on CCM (atmosphere) getfile & putfile routines, but +! intended to be a more extensible, shared code. +! +! !REVISION HISTORY: +! 2006-05-08 E. Kluzek, Add in shr_file_mod and getUnit, freeUnif methods. +! 2000-??-?? B. Kauffman, original version circa 2000 +! +! !INTERFACE: ------------------------------------------------------------------ + +MODULE shr_file_mod + +! !USES: + + use shr_kind_mod ! defines kinds + use shr_sys_mod ! system calls + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + IMPLICIT none + + PRIVATE ! By default everything is private to this module + +! !PUBLIC TYPES: + + ! no public types + +! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_file_put ! Put a file to an archive location + public :: shr_file_get ! Get a file from an archive location + public :: shr_file_queryPrefix ! Get prefix type for a filename + public :: shr_file_getUnit ! Get a logical unit for reading or writing + public :: shr_file_freeUnit ! Free a logical unit + public :: shr_file_stdio ! change dir and stdin and stdout + public :: shr_file_chDir ! change current working directory + public :: shr_file_dirio ! change stdin and stdout + public :: shr_file_chStdIn ! change stdin (attach to a file) + public :: shr_file_chStdOut ! change stdout (attach to a file) + public :: shr_file_setIO ! open a log file from namelist + public :: shr_file_setLogUnit ! Reset the log unit number + public :: shr_file_setLogLevel ! Reset the logging debug level + public :: shr_file_getLogUnit ! Get the log unit number + public :: shr_file_getLogLevel ! Get the logging debug level + +! !PUBLIC DATA MEMBERS: + + ! Integer flags for recognized prefixes on file get/put operations + integer(SHR_KIND_IN), parameter, public :: shr_file_noPrefix = 0 ! no recognized prefix + integer(SHR_KIND_IN), parameter, public :: shr_file_nullPrefix = 1 ! null: + integer(SHR_KIND_IN), parameter, public :: shr_file_cpPrefix = 2 ! cp: + integer(SHR_KIND_IN), parameter, public :: shr_file_mssPrefix = 3 ! mss: + integer(SHR_KIND_IN), parameter, public :: shr_file_hpssPrefix = 4 ! hpss: + +!EOP + !--- unit numbers, users can ask for unit numbers from 0 to min, but getUnit + !--- won't give a unit below min, users cannot ask for unit number above max + !--- for backward compatability. + !--- eventually, recommend min as hard lower limit (tcraig, 9/2007) + integer(SHR_KIND_IN),parameter :: shr_file_minUnit = 10 ! Min unit number to give + integer(SHR_KIND_IN),parameter :: shr_file_maxUnit = 99 ! Max unit number to give + logical, save :: UnitTag(0:shr_file_maxUnit) = .false. ! Logical units in use + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_put -- Put a file to an archival location. +! +! !DESCRIPTION: +! a generic, extensible put-local-file-into-archive routine +! USAGE: +! call shr_file_put(rcode,"foo","/home/user/foo") +! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) +! call shr_file_put(rcode,"foo","cp:/home/user/foo",remove=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error copying foo" ) +! call shr_file_put(rcode,"foo","mss:/USER/foo",rtpd=3650) +! if ( rcode /= 0 ) call shr_sys_abort( "error archiving foo to MSS" ) +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_put(rcode,loc_fn,rem_fn,passwd,rtpd,async,remove) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero -- error) + character(*), intent(in) :: loc_fn ! local filename + character(*), intent(in) :: rem_fn ! remote filename + character(*), intent(in),optional :: passwd ! password + integer(SHR_KIND_IN),intent(in),optional :: rtpd ! MSS retention period + logical, intent(in),optional :: async ! true <=> asynchronous put + logical, intent(in),optional :: remove ! true <=> rm after put + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: rtpd2 ! MSS retention period + logical :: remove2 ! true <=> rm after put + logical :: async2 ! true <=> asynchronous put + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_put) ' + character(*),parameter :: F00 = "('(shr_file_put) ',4a)" + character(*),parameter :: F01 = "('(shr_file_put) ',a,i3,2a)" + character(*),parameter :: F02 = "(a,i4)" + +!------------------------------------------------------------------------------- +! Notes: +! - On some machines the system call will not return a valid error code +! - when things are sent asynchronously, there probably won't be a error code +! returned. +!------------------------------------------------------------------------------- + + remove2 =.false. ; if ( PRESENT(remove )) remove2 = remove + async2 =.true. ; if ( PRESENT(async )) async2 = async + passwd2 = " " ; if ( PRESENT(passwd )) passwd2 = passwd + rtpd2 = 365 ; if ( PRESENT(rtpd )) rtpd2 = rtpd + rcode = 0 + + if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file = '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! put via unix cp + !------------------------------------------------------ + rfn = rem_fn + if ( rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) +#if defined(CATAMOUNT) + call shr_jlcp(trim(loc_fn),len_trim(loc_fn),trim(rfn),len_trim(rfn),rcode) + if (remove2) call unlink(trim(loc_fn)) + if (async2 .and. s_loglev > 0) write(s_logunit,F00) 'Error: asynchronous copy not supported.' + cmd = 'shr_jlcp -f '//trim(loc_fn)//' '//trim(rfn) + rcode = 0 +#else + cmd = '/bin/cp -f '//trim(loc_fn)//' '//trim(rfn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) +#endif + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! put onto NCAR's MSS + !------------------------------------------------------ + if (rtpd2 > 9999) rtpd2 = 9999 + write(cmd,F02) '/usr/local/bin/msrcp -period ',rtpd2 + if (async2 .and. (.not. remove2) ) cmd = trim(cmd)//' -async ' + if (len_trim(passwd2) > 0 ) cmd = trim(cmd)//' -wpwd '//trim(passwd) + cmd = trim(cmd)//' '//trim(loc_fn)//' '//trim(rem_fn) + if (remove2) cmd = trim(cmd)//' && /bin/rm -f '//trim(loc_fn) + if (async2 .and. remove2 ) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! put onto LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file archival, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + +END SUBROUTINE shr_file_put + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_get -- Get a file from archival location. +! +! !DESCRIPTION: +! a generic, extensible get-local-file-from-archive routine +! +! USAGE: +! call shr_file_get(rcode,"foo","/home/user/foo") +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) +! call shr_file_get(rcode,"foo","cp:/home/user/foo",remove=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo" ) +! call shr_file_get(rcode,"foo","mss:/USER/foo",clobber=.true.) +! if ( rcode /= 0 ) call shr_sys_abort( "error getting file foo from MSS" ) +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_get(rcode,loc_fn,rem_fn,passwd,async,clobber) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: rcode ! return code (non-zero means error) + character(*) ,intent(in) :: loc_fn ! local filename + character(*) ,intent(in) :: rem_fn ! remote filename + character(*) ,intent(in),optional :: passwd ! password + logical ,intent(in),optional :: async ! true <=> asynchronous get + logical ,intent(in),optional :: clobber ! true <=> clobber existing file + +!EOP + + !----- local ----- + logical :: async2 ! true <=> asynchronous get + logical :: clobber2 ! true <=> clobber existing file + logical :: exists ! true <=> local file a ready exists + character(SHR_KIND_CL) :: passwd2 ! password + character(SHR_KIND_CL) :: rfn ! rem_fn without the destination prefix + character(SHR_KIND_CL) :: cmd ! command sent to system call + integer(SHR_KIND_IN) :: prefix ! remote file prefix type + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_get) ' + character(*),parameter :: F00 = "('(shr_file_get) ',4a)" + character(*),parameter :: F01 = "('(shr_file_get) ',a,i3,2a)" + +!------------------------------------------------------------------------------- +! Notes: +! - On some machines the system call will not return a valid error code +! - When things are sent asynchronously, there probably won't be a error code +! returned. +!------------------------------------------------------------------------------- + + passwd2 = " " ; if (PRESENT(passwd )) passwd2 = passwd + async2 = .false. ; if (PRESENT(async )) async2 = async + clobber2 = .false. ; if (PRESENT(clobber)) clobber2 = clobber + rcode = 0 + + inquire(file=trim(loc_fn),exist=exists) + prefix = shr_file_queryPrefix( rem_fn ) + + if ( exists .and. .not. clobber2 ) then + !------------------------------------------------------ + ! (file exists) and (don't clobber) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: file exists & no-clobber for '//trim(loc_fn) + rcode = 0 + else if ( trim(rem_fn) == trim(loc_fn) ) then + !------------------------------------------------------ + ! (remote file name) == (local file name) => do nothing + !------------------------------------------------------ + cmd = 'do nothing: remote file = local file for '//trim(loc_fn) + rcode = 0 + else if ( prefix == shr_file_cpPrefix .or. prefix == shr_file_noPrefix )then + !------------------------------------------------------ + ! get via unix cp + !------------------------------------------------------ + rfn = rem_fn ! remove prefix from this temp file name + if (rem_fn(1:3) == "cp:") rfn = rem_fn(4:len_trim(rem_fn)) +#if defined(CATAMOUNT) + call shr_jlcp(trim(rfn),len(trim(rfn)),trim(loc_fn),len(trim(loc_fn)),rcode) + if (async2.and.s_loglev>0) write(s_logunit,F00) 'Error: asynchronous copy not supported.' + cmd = 'shr_jlcp -f '//trim(rfn)//' '//trim(loc_fn) + rcode = 0 +#else + cmd = '/bin/cp -f '//trim(rfn)//' '//trim(loc_fn) + if (async2) cmd = trim(cmd)//' & ' + call shr_sys_system(trim(cmd),rcode) +#endif + else if ( prefix == shr_file_mssPrefix )then + !------------------------------------------------------ + ! get from NCAR's MSS + !------------------------------------------------------ + cmd = '/usr/local/bin/msrcp ' + if (async2) cmd = trim(cmd)//' -async ' + cmd = trim(cmd)//' '//trim(rem_fn)//' '//trim(loc_fn) + call shr_sys_system(trim(cmd),rcode) + else if ( prefix == shr_file_hpssPrefix )then + !------------------------------------------------------ + ! get from LANL's hpss + !------------------------------------------------------ + rcode = -1 + cmd = 'rem_fn='//trim(rem_fn)//' loc_fn='//trim(loc_fn) + write(s_logunit,F00) 'ERROR: hpss option not yet implemented' + call shr_sys_abort( subName//'ERROR: hpss option not yet implemented' ) + else if ( prefix == shr_file_nullPrefix )then + ! do nothing + cmd = "null prefix => no file retrieval, do nothing" + rcode = 0 + end if + + if (s_loglev > 0) write(s_logunit,F01) 'rcode =',rcode,' cmd = ', trim(cmd) + +END SUBROUTINE shr_file_get + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_queryPrefix -- Get the prefix type from a filepath. +! +! !DESCRIPTION: +! +! !INTERFACE: ------------------------------------------------------------------ + +integer(SHR_KIND_IN) FUNCTION shr_file_queryPrefix( filepath, prefix ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*), intent(in) :: filepath ! Input filepath + character(*), intent(out), optional :: prefix ! Output prefix description + +!EOP + + !----- local ----- + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if ( filepath(1:5) == "null:" )then + shr_file_queryPrefix = shr_file_nullPrefix + if ( present(prefix) ) prefix = "null:" + else if( filepath(1:3) == "cp:" )then + shr_file_queryPrefix = shr_file_cpPrefix + if ( present(prefix) ) prefix = "cp:" + else if( filepath(1:4) == "mss:" )then + shr_file_queryPrefix = shr_file_mssPrefix + if ( present(prefix) ) prefix = "mss:" + else if( filepath(1:5) == "hpss:" )then + shr_file_queryPrefix = shr_file_hpssPrefix + if ( present(prefix) ) prefix = "hpss:" + else + shr_file_queryPrefix = shr_file_noPrefix + if ( present(prefix) ) prefix = "" + end if + +END FUNCTION shr_file_queryPrefix + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getUnit -- Get a free FORTRAN unit number +! +! !DESCRIPTION: Get the next free FORTRAN unit number. +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! +! !INTERFACE: ------------------------------------------------------------------ + +INTEGER FUNCTION shr_file_getUnit ( unit ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in),optional :: unit ! desired unit number + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! loop index + logical :: opened ! If unit opened or not + + !----- formats ----- + character(*),parameter :: subName = '(shr_file_getUnit) ' + character(*),parameter :: F00 = "('(shr_file_getUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (present (unit)) then + inquire( unit, opened=opened ) + if (unit < 0 .or. unit > shr_file_maxUnit) then + write(s_logunit,F00) 'invalid unit number request:', unit + call shr_sys_abort( 'ERROR: bad input unit number' ) + else if (opened .or. UnitTag(unit) .or. unit == 0 .or. unit == 5 & + .or. unit == 6) then + write(s_logunit,F00) 'unit number ', unit, ' is already in use' + call shr_sys_abort( 'ERROR: Input unit number already in use' ) + else + shr_file_getUnit = unit + UnitTag (unit) = .true. + return + end if + + else + ! --- Choose first available unit other than 0, 5, or 6 ------ + do n=shr_file_maxUnit, shr_file_minUnit, -1 + inquire( n, opened=opened ) + if (n == 5 .or. n == 6 .or. opened) then + cycle + end if + if ( .not. UnitTag(n) ) then + shr_file_getUnit = n + UnitTag(n) = .true. + return + end if + end do + end if + + call shr_sys_abort( subName//': Error: no available units found' ) + +END FUNCTION shr_file_getUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_freeUnit -- Free up a FORTRAN unit number +! +! !DESCRIPTION: Free up the given unit number +! +! !REVISION HISTORY: +! 2005-Dec-14 - E. Kluzek - creation +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_freeUnit ( unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! unit number to be freed + +!EOP + + !----- local ----- + + !----- formats ----- + character(*), parameter :: subName = '(shr_file_freeUnit) ' + character(*), parameter :: F00 = "('(shr_file_freeUnit) ',A,I4,A)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (unit < 0 .or. unit > shr_file_maxUnit) then + if (s_loglev > 0) write(s_logunit,F00) 'invalid unit number request:', unit + else if (unit == 0 .or. unit == 5 .or. unit == 6) then + call shr_sys_abort( subName//': Error: units 0, 5, and 6 must not be freed' ) + else if (UnitTag(unit)) then + UnitTag (unit) = .false. + else + if (s_loglev > 0) write(s_logunit,F00) 'unit ', unit, ' was not in use' + end if + + return + +END SUBROUTINE shr_file_freeUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdio -- Change working directory, and redirect stdin/stdout +! +! !DESCRIPTION: +! 1) change the cwd (current working directory) and +! 2) redirect stdin & stdout (units 5 & 6) to named files, +! where the desired cwd & files are specified by namelist file. +! +! Normally this is done to work around limitations in the execution syntax +! of common MPI implementations. For example, SGI's mpirun syntax is not +! flexible enough to allow MPMD models to select different execution +! directories or to redirect stdin & stdout on the command line. +! Such functionality is highly desireable for CCSM purposes. +! ie. mpirun can't handle this: +! unix> cd /usr/tmp/jdoe/csm/case01/atm ; atm < atm.parm > atm.log & +! unix> cd /usr/tmp/jdoe/csm/case01/cpl ; cpl < cpl.parm > cpl.log & +! etc. +! +! ASSUMPTIONS: +! o if the cwd, stdin, or stdout are to be changed, there must be a namelist +! file in the cwd named _stdio.nml where is provided via +! subroutine dummy argument. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_stdio(model) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdio) ' + character(*),parameter :: F00 = "('(shr_file_stdio) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_chdir (model) ! changes cwd + call shr_file_chStdOut(model) ! open units 5 & 6 to named files + call shr_file_chStdIn (model) ! open units 5 & 6 to named files + +END SUBROUTINE shr_file_stdio + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_chdir -- Change working directory. +! +! !DESCRIPTION: +! change the cwd (current working directory), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chdir(model, rcodeOut) + +! !USES: + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code + +!EOP + + !--- local --- + character(SHR_KIND_CL) :: dir ! directory to cd to + integer (SHR_KIND_IN) :: rcode ! Return error code + character(SHR_KIND_CL) :: filename ! namelist file to read + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chdir) ' + character(*),parameter :: F00 = "('(shr_file_chdir) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, dirOut=dir, rcodeOut=rcode ) + if (dir /= "nochange") then + call shr_sys_chdir(dir ,rcode) + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", changed cwd to ",trim(dir) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", cwd has *not* been changed" + rcode = 1 + endif + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chdir + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_dirio --- Change stdin and stdout. +! +! !DESCRIPTION: +! change the stdin & stdout (units 5 & 6), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_dirio(model) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: model ! used to construct env varible name + +!EOP + + !--- local --- + + !--- formats --- + character(*),parameter :: subName = '(shr_file_dirio) ' + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + call shr_file_chStdIn (model) + call shr_file_chStdOut(model) + +END SUBROUTINE shr_file_dirio + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_chStdIn -- Change stdin +! +! !DESCRIPTION: +! change the stdin (unit 5), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chStdIn( model, NLFilename, rcodeOut ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env var name + character(SHR_KIND_CL),intent(out),optional :: NLFilename ! open unit 5 to this + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + +!EOP + + !--- local --- + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: nlfile ! Namelist filename for model to read from + character(SHR_KIND_CL) :: filename ! namelist file to read + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdIn) ' + character(*),parameter :: F00 = "('(shr_file_chStdIn) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdinOut=stdin, & + nlfileOut=nlfile, rcodeOut=rcode ) + if (stdin /= "nochange") then + open(unit=5,file=stdin ,status='UNKNOWN',iostat=rcode) + if ( rcode /= 0 )then + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': error opening file as unit 5:', & + trim(nlfile) + else + if (s_loglev > 0) & + write(s_logunit,F00) "read ",trim(filename),': unit 5 connected to ', & + trim(stdin) + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 5 has *not* been redirected' + endif + if ( len_trim(nlfile) > 0) then + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': read namelist from file:',trim(nlfile) + if ( .not. present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename NOT present" + rcode = 7 + end if + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename),", " + if ( present(NLFilename) )then + if (s_loglev > 0) write(s_logunit,F00) "error: namelist filename present, but null" + rcode = 8 + end if + endif + if ( present(NLFilename) ) NLFilename = nlfile + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chStdIn + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdout -- Change stdout +! +! !DESCRIPTION: +! change the stdout (unit 6), see shr_file_stdio for notes +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_chStdOut(model,rcodeOut) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + !--- arguments --- + character(*) ,intent(in) :: model ! used to construct env varible name + integer(SHR_KIND_IN),intent(out),optional :: rcodeOut ! Return error code +!EOP + + !--- local --- + character(SHR_KIND_CL) :: filename ! namelist file to read + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + integer (SHR_KIND_IN) :: rcode ! return code + + !--- formats --- + character(*),parameter :: subName = '(shr_file_chStdOut) ' + character(*),parameter :: F00 = "('(shr_file_chStdOut) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + call shr_file_stdioReadNL( model, filename, stdoutOut=stdout, & + rcodeOut=rcode ) + if (stdout /= "nochange") then + close(6) + open(unit=6,file=stdout,position='APPEND') + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 connected to ',trim(stdout) + call shr_sys_flush(s_logunit) + else + if (s_loglev > 0) write(s_logunit,F00) "read ",trim(filename), & + ': unit 6 has *not* been redirected' + rcode = 1 + endif + + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_chStdOut + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_stdioReadNL -- read in stdio namelist +! +! !DESCRIPTION: +! Read in the stdio namelist for any given model type. Return any of the +! needed input namelist variables as optional arguments. Return "nochange" in +! dir, stdin, or stdout if shouldn't change. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_stdioReadNL( model, filename, dirOut, stdinOut, stdoutOut, & + NLFileOut, rcodeOut ) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: model ! used to construct env varible name + character(SHR_KIND_CL),intent(out) :: filename ! nml file to read from unit 5 + character(SHR_KIND_CL),intent(out),optional :: NLFileOut ! open unit 6 to this file + character(SHR_KIND_CL),intent(out),optional :: dirOut ! directory to cd to + character(SHR_KIND_CL),intent(out),optional :: stdinOut ! open unit 5 to this file + character(SHR_KIND_CL),intent(out),optional :: stdoutOut ! open unit 6 to this file + integer (SHR_KIND_IN),intent(out),optional :: rcodeOut ! return code + +!EOP + + !--- local --- + logical :: exists ! true iff file exists + character(SHR_KIND_CL) :: dir ! directory to cd to + character(SHR_KIND_CL) :: stdin ! open unit 5 to this file + character(SHR_KIND_CL) :: stdout ! open unit 6 to this file + character(SHR_KIND_CL) :: NLFile ! namelist file to read seperately + integer (SHR_KIND_IN) :: rcode ! return code + integer (SHR_KIND_IN) :: unit ! Unit to read from + + namelist / stdio / dir,stdin,stdout,NLFile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_stdioReadNL) ' + character(*),parameter :: F00 = "('(shr_file_stdioReadNL) ',4a)" + character(*),parameter :: F01 = "('(shr_file_stdioReadNL) ',2a,i6)" + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + rcode = 0 + dir = "nochange" + stdin = "nochange" + stdout = "nochange" + NLFile = " " + + filename = trim(model)//"_stdio.nml" ! eg. file="cpl_stdio.nml" + inquire(file=filename,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(filename),& + & " doesn't exist, can not read stdio namelist from it" + rcode = 9 + else + unit = shr_file_getUnit() + open (unit,file=filename,action="READ") + read (unit,nml=stdio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(filename),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(filename) ) + end if + endif + if ( len_trim(NLFile) > 0 .and. trim(stdin) /= "nochange" )then + write(s_logunit,F00) "Error: input namelist:" + write(s_logunit,nml=stdio) + call shr_sys_abort(subName//" ERROR trying to both redirect AND "// & + "open namelist filename" ) + end if + if ( present(NLFileOut) ) NLFileOut = NLFile + if ( present(dirOut) ) dirOut = dir + if ( present(stdinOut) ) stdinOut = stdin + if ( present(stdoutOut) ) stdoutOut = stdout + if ( present(rcodeOut) ) rcodeOut = rcode + +END SUBROUTINE shr_file_stdioReadNL + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setIO -- read in stdio namelist +! +! !DESCRIPTION: +! This opens a namelist file specified as an argument and then opens +! a log file associated with the unit argument. This may be extended +! in the future. +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setIO( nmlfile, funit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(len=*) ,intent(in) :: nmlfile ! namelist filename + integer(SHR_KIND_IN),intent(in) :: funit ! unit number for log file + +!EOP + + !--- local --- + logical :: exists ! true if file exists + character(SHR_KIND_CL) :: diri ! directory to cd to + character(SHR_KIND_CL) :: diro ! directory to cd to + character(SHR_KIND_CL) :: logfile ! open unit 6 to this file + integer(SHR_KIND_IN) :: unit ! unit number + integer(SHR_KIND_IN) :: rcode ! error code + + namelist / modelio / diri,diro,logfile + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setIO) ' + character(*),parameter :: F00 = "('(shr_file_setIO) ',4a)" + character(*),parameter :: F01 = "('(shr_file_setIO) ',2a,i6)" + +!------------------------------------------------------------------------------- +! Notes: +! +!------------------------------------------------------------------------------- + + diri = "." + diro = "." + logfile = "" + + inquire(file=nmlfile,exist=exists) + + if (.not. exists) then + if (s_loglev > 0) write(s_logunit,F00) "file ",trim(nmlfile)," non existant" + return + else + unit = shr_file_getUnit() + open (unit,file=nmlfile,action="READ") + read (unit,nml=modelio,iostat=rcode) + close(unit) + call shr_file_freeUnit( unit ) + if (rcode /= 0) then + write(s_logunit,F01) 'ERROR: reading ',trim(nmlfile),': iostat=',rcode + call shr_sys_abort(subName//" ERROR reading "//trim(nmlfile) ) + end if + endif + + if (len_trim(logfile) > 0) then + open(funit,file=trim(diro)//"/"//trim(logfile)) + else + if (s_loglev > 0) write(s_logunit,F00) "logfile not opened" + endif + +END SUBROUTINE shr_file_setIO + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setLogUnit -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setLogUnit(unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: unit ! new unit number + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_setLogUnit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: Caller must be sure it's a valid unit number +!------------------------------------------------------------------------------- + + if (s_loglev > 1 .and. s_logunit-unit /= 0) then + write(s_logunit,*) subName,': reset log unit number from/to ',s_logunit, unit + write( unit,*) subName,': reset log unit number from/to ',s_logunit, unit + endif + + s_logunit = unit + +END SUBROUTINE shr_file_setLogUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_setLogLevel -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_setLogLevel(newlevel) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: newlevel ! new log level + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_setLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_setLogLevel) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (s_loglev+newlevel > 2 .and. s_loglev-newlevel /= 0) & + write(s_logunit,*) subName,': reset log level from/to ',s_loglev, newlevel + + s_loglev = newlevel + +END SUBROUTINE shr_file_setLogLevel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getLogUnit -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_getLogUnit(unit) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: unit ! new unit number + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogUnit) ' + character(*),parameter :: F00 = "('(shr_file_getLogUnit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + unit = s_logunit + +END SUBROUTINE shr_file_getLogUnit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_file_getLogLevel -- Set the Log I/O Unit number +! +! !INTERFACE: ------------------------------------------------------------------ + +SUBROUTINE shr_file_getLogLevel(curlevel) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(out) :: curlevel ! new log level + +!EOP + + !--- formats --- + character(*),parameter :: subName = '(shr_file_getLogLevel) ' + character(*),parameter :: F00 = "('(shr_file_getLogLevel) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + curlevel = s_loglev + +END SUBROUTINE shr_file_getLogLevel + +!=============================================================================== +!=============================================================================== + +END MODULE shr_file_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_kind_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_kind_mod.F90 new file mode 100644 index 0000000000..79ee2fec05 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_kind_mod.F90 @@ -0,0 +1,22 @@ +!=============================================================================== +! SVN $Id: shr_kind_mod.F90 11926 2008-09-25 21:10:40Z mvertens $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_kind_mod.F90 $ +!=============================================================================== + +MODULE shr_kind_mod + + !---------------------------------------------------------------------------- + ! precision/kind constants add data public + !---------------------------------------------------------------------------- + public + integer,parameter :: SHR_KIND_R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: SHR_KIND_R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: SHR_KIND_RN = kind(1.0) ! native real + integer,parameter :: SHR_KIND_I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: SHR_KIND_I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: SHR_KIND_IN = kind(1) ! native integer + integer,parameter :: SHR_KIND_CS = 80 ! short char + integer,parameter :: SHR_KIND_CL = 256 ! long char + integer,parameter :: SHR_KIND_CX = 512 ! extra-long char + +END MODULE shr_kind_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_log_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_log_mod.F90 new file mode 100644 index 0000000000..244314a8de --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_log_mod.F90 @@ -0,0 +1,13 @@ +MODULE shr_log_mod + + use shr_kind_mod + + !---------------------------------------------------------------------------- + ! low-level shared variables for logging, these may not be parameters + !---------------------------------------------------------------------------- + public + + integer(SHR_KIND_IN) :: shr_log_Level = 1 + integer(SHR_KIND_IN) :: shr_log_Unit = 6 + +END MODULE shr_log_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_string_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_string_mod.F90 new file mode 100644 index 0000000000..e6596cc181 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_string_mod.F90 @@ -0,0 +1,1757 @@ +!=============================================================================== +! SVN $Id: shr_string_mod.F90 25247 2010-10-20 22:43:21Z tcraig $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_string_mod.F90 $ +!=============================================================================== +!=============================================================================== +!BOP =========================================================================== +! +! !MODULE: shr_string_mod -- string and list methods +! +! !DESCRIPTION: +! General string and specific list method. A list is a single string +! that is delimited by a character forming multiple fields, ie, +! character(len=*) :: mylist = "t:s:u1:v1:u2:v2:taux:tauy" +! The delimiter is called listDel in this module, is default ":", +! but can be set by a call to shr_string_listSetDel. +! +! !REVISION HISTORY: +! 2005-Apr-28 - T. Craig - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +module shr_string_mod + +! !USES: + + use shr_kind_mod ! F90 kinds + use shr_sys_mod ! shared system calls + use shr_timer_mod, only : shr_timer_get, shr_timer_start, shr_timer_stop + use shr_log_mod, only : s_loglev => shr_log_Level + use shr_log_mod, only : s_logunit => shr_log_Unit + + implicit none + private + +! !PUBLIC TYPES: + + ! no public types + +! !PUBLIC MEMBER FUNCTIONS: + + public :: shr_string_countChar ! Count number of char in string, fn + public :: shr_string_toUpper ! Convert string to upper-case + public :: shr_string_toLower ! Convert string to lower-case + public :: shr_string_getParentDir ! For a pathname get the parent directory name + public :: shr_string_lastIndex ! Index of last substr in str + public :: shr_string_endIndex ! Index of end of substr in str + public :: shr_string_leftAlign ! remove leading white space + public :: shr_string_alphanum ! remove all non alpha-numeric characters + public :: shr_string_betweenTags ! get the substring between the two tags + public :: shr_string_parseCFtunit ! parse CF time units + public :: shr_string_clean ! Set string to all white space + + public :: shr_string_listIsValid ! test for a valid "list" + public :: shr_string_listGetNum ! Get number of fields in list, fn + public :: shr_string_listGetIndex ! Get index of field + public :: shr_string_listGetIndexF ! function version of listGetIndex + public :: shr_string_listGetName ! get k-th field name + public :: shr_string_listIntersect ! get intersection of two field lists + public :: shr_string_listUnion ! get union of two field lists + public :: shr_string_listMerge ! merge two lists to form third + public :: shr_string_listAppend ! append list at end of another + public :: shr_string_listPrepend ! prepend list in front of another + public :: shr_string_listSetDel ! Set field delimeter in lists + public :: shr_string_listGetDel ! Get field delimeter in lists + + public :: shr_string_setAbort ! set local abort flag + public :: shr_string_setDebug ! set local debug flag + +! !PUBLIC DATA MEMBERS: + + ! no public data members + +!EOP + + character(len=1) ,save :: listDel = ":" ! note single exec implications + character(len=2) ,save :: listDel2 = "::" ! note single exec implications + logical ,save :: doabort = .true. + integer(SHR_KIND_IN),save :: debug = 0 + +!=============================================================================== +contains +!=============================================================================== + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_countChar -- Count number of occurances of a character +! +! !DESCRIPTION: +! count number of occurances of a single character in a string +! \newline +! n = shr\_string\_countChar(string,character) +! +! !REVISION HISTORY: +! 2005-Feb-28 - First version from dshr_bundle +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_countChar(str,char,rc) + + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: str ! string to search + character(1) ,intent(in) :: char ! char to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: count ! counts occurances of char + integer(SHR_KIND_IN) :: n ! generic index + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_countChar) " + character(*),parameter :: F00 = "('(shr_string_countChar) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == char) count = count + 1 + end do + shr_string_countChar = count + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_countChar + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_toUpper -- Convert string to upper case +! +! !DESCRIPTION: +! Convert the input string to upper-case. +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! !REVISION HISTORY: +! 2005-Dec-20 - Move CAM version over to shared code. +! +! !INTERFACE: ------------------------------------------------------------------ + +function shr_string_toUpper(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to upper case + character(len=len(str)) :: shr_string_toUpper + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: aseq ! ascii collating sequence + integer(SHR_KIND_IN) :: LowerToUpper ! integer to convert case + character(len=1) :: ctmp ! Character temporary + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_toUpper) " + character(*),parameter :: F00 = "('(shr_string_toUpper) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + LowerToUpper = iachar("A") - iachar("a") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) & + ctmp = achar(aseq + LowertoUpper) + shr_string_toUpper(i:i) = ctmp + end do + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_toUpper + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_toLower -- Convert string to lower case +! +! !DESCRIPTION: +! Convert the input string to lower-case. +! Use achar and iachar intrinsics to ensure use of ascii collating sequence. +! +! !REVISION HISTORY: +! 2006-Apr-20 - Creation +! +! !INTERFACE: ------------------------------------------------------------------ +function shr_string_toLower(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: shr_string_toLower + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: aseq ! ascii collating sequence + integer(SHR_KIND_IN) :: UpperToLower ! integer to convert case + character(len=1) :: ctmp ! Character temporary + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_toLower) " + character(*),parameter :: F00 = "('(shr_string_toLower) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + UpperToLower = iachar("a") - iachar("A") + + do i = 1, len(str) + ctmp = str(i:i) + aseq = iachar(ctmp) + if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) & + ctmp = achar(aseq + UpperToLower) + shr_string_toLower(i:i) = ctmp + end do + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_toLower + +!=============================================================================== +!BOP =========================================================================== +! !IROUTINE: shr_string_getParentDir -- For pathname get the parent directory name +! +! !DESCRIPTION: +! Get the parent directory name for a pathname. +! +! !REVISION HISTORY: +! 2006-May-09 - Creation +! +! !INTERFACE: ------------------------------------------------------------------ + +function shr_string_getParentDir(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + character(len=*), intent(in) :: str ! String to convert to lower case + character(len=len(str)) :: shr_string_getParentDir + + !----- local ----- + integer(SHR_KIND_IN) :: i ! Index + integer(SHR_KIND_IN) :: nlen ! Length of string + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_getParentDir) " + character(*),parameter :: F00 = "('(shr_string_getParentDir) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + nlen = len_trim(str) + if ( str(nlen:nlen) == "/" ) nlen = nlen - 1 + i = index( str(1:nlen), "/", back=.true. ) + if ( i == 0 )then + shr_string_getParentDir = str + else + shr_string_getParentDir = str(1:i-1) + end if + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_getParentDir + +!=============================================================================== +!BOP =========================================================================== +! +! +! !IROUTINE: shr_string_lastIndex -- Get index of last substr within string +! +! !DESCRIPTION: +! Get index of last substr within string +! \newline +! n = shr\_string\_lastIndex(string,substring) +! +! !REVISION HISTORY: +! 2005-Feb-28 - First version from dshr_domain +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_lastIndex(string,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: substr ! sub-string to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_lastIndex) " + character(*),parameter :: F00 = "('(shr_string_lastIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Note: +! - "new" F90 back option to index function makes this home-grown solution obsolete +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + shr_string_lastIndex = index(string,substr,.true.) + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_lastIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_endIndex -- Get the ending index of substr within string +! +! !DESCRIPTION: +! Get the ending index of substr within string +! \newline +! n = shr\_string\_endIndex(string,substring) +! +! !REVISION HISTORY: +! 2005-May-10 - B. Kauffman, first version. +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_endIndex(string,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: substr ! sub-string to search for + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: i ! generic index + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_endIndex) " + character(*),parameter :: F00 = "('(shr_string_endIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! * returns zero if substring not found, uses len_trim() intrinsic +! * very similar to: i = index(str,substr,back=.true.) +! * do we need this function? +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + i = index(trim(string),trim(substr)) + if ( i == 0 ) then + shr_string_endIndex = 0 ! substr is not in string + else + shr_string_endIndex = i + len_trim(substr) - 1 + end if + +! ------------------------------------------------------------------- +! i = index(trim(string),trim(substr),back=.true.) +! if (i == len(string)+1) i = 0 +! shr_string_endIndex = i +! ------------------------------------------------------------------- + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_endIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_leftAlign -- remove leading white space +! +! !DESCRIPTION: +! Remove leading white space +! \newline +! call shr\_string\_leftAlign(string) +! +! !REVISION HISTORY: +! 2005-Apr-28 - B. Kauffman - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_leftAlign(str,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: str + integer(SHR_KIND_IN),intent(out) ,optional :: rc ! return code + +!EOP + + !----- local ---- + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_leftAlign) " + character(*),parameter :: F00 = "('(shr_string_leftAlign) ',4a)" + +!------------------------------------------------------------------------------- +! note: +! * ?? this routine isn't needed, use the intrisic adjustL instead ?? +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + +! ------------------------------------------------------------------- +! --- I used this until I discovered the intrinsic function below - BK +! do while (len_trim(str) > 0 ) +! if (str(1:1) /= ' ') exit +! str = str(2:len_trim(str)) +! end do +! rCode = 0 +! !! (len_trim(str) == 0 ) rCode = 1 ! ?? appropriate ?? +! ------------------------------------------------------------------- + + str = adjustL(str) + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_leftAlign + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_alphanum -- remove non alpha numeric characters +! +! !DESCRIPTION: +! Remove all non alpha numeric characters from string +! \newline +! call shr\_string\_alphanum(string) +! +! !REVISION HISTORY: +! 2005-Aug-01 - T. Craig - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_alphanum(str,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: str + integer(SHR_KIND_IN),intent(out) ,optional :: rc ! return code + +!EOP + + !----- local ---- + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: n,icnt ! counters + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_alphaNum) " + character(*),parameter :: F00 = "('(shr_string_alphaNum) ',4a)" + +!------------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + icnt = 0 + do n=1,len_trim(str) + if ((str(n:n) >= 'a' .and. str(n:n) <= 'z') .or. & + (str(n:n) >= 'A' .and. str(n:n) <= 'Z') .or. & + (str(n:n) >= '0' .and. str(n:n) <= '9')) then + icnt = icnt + 1 + str(icnt:icnt) = str(n:n) + endif + enddo + do n=icnt+1,len(str) + str(n:n) = ' ' + enddo + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_alphanum + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_betweenTags -- Get the substring between the two tags. +! +! !DESCRIPTION: +! Get the substring found between the start and end tags. +! \newline +! call shr\_string\_betweenTags(string,startTag,endTag,substring,rc) +! +! !REVISION HISTORY: +! 2005-May-11 - B. Kauffman, first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_betweenTags(string,startTag,endTag,substr,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(in) :: startTag ! start tag + character(*) ,intent(in) :: endTag ! end tag + character(*) ,intent(out) :: substr ! sub-string between tags + integer(SHR_KIND_IN),intent(out),optional :: rc ! retrun code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: iStart ! substring start index + integer(SHR_KIND_IN) :: iEnd ! substring end index + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_betweenTags) " + character(*),parameter :: F00 = "('(shr_string_betweenTags) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! * assumes the leading/trailing white space is not part of start & end tags +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + iStart = shr_string_endIndex(string,trim(adjustL(startTag))) ! end of start tag + iEnd = index(string,trim(adjustL(endTag ))) ! start of end tag + + rCode = 0 + substr = "" + + if (iStart < 1) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: can't find start tag in string" + write(s_logunit,F00) "ERROR: start tag = ",trim(startTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 1 + else if (iEnd < 1) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: can't find end tag in string" + write(s_logunit,F00) "ERROR: end tag = ",trim( endTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 2 + else if ( iEnd <= iStart) then + if (s_loglev > 0) then + write(s_logunit,F00) "ERROR: start tag not before end tag" + write(s_logunit,F00) "ERROR: start tag = ",trim(startTag) + write(s_logunit,F00) "ERROR: end tag = ",trim( endTag) + write(s_logunit,F00) "ERROR: string = ",trim(string) + endif + rCode = 3 + else if ( iStart+1 == iEnd ) then + substr = "" + if (s_loglev > 0) write(s_logunit,F00) "WARNING: zero-length substring found in ",trim(string) + else + substr = string(iStart+1:iEnd-1) + if (len_trim(substr) == 0 .and. s_loglev > 0) & + & write(s_logunit,F00) "WARNING: white-space substring found in ",trim(string) + end if + + if (present(rc)) rc = rCode + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_betweenTags + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_parseCFtunit -- Parse CF time unit +! +! !DESCRIPTION: +! Parse CF time unit into a delta string name and a base time in yyyymmdd +! and seconds (nearest integer actually). +! \newline +! call shr\_string\_parseCFtunit(string,substring) +! \newline +! Input string is like "days since 0001-06-15 15:20:45.5 -6:00" +! - recognizes "days", "hours", "minutes", "seconds" +! - must have at least yyyy-mm-dd, hh:mm:ss.s is optional +! - expects a "since" in the string +! - ignores time zone part +! +! !REVISION HISTORY: +! 2005-May-15 - T. Craig - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_parseCFtunit(string,unit,bdate,bsec,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string to search + character(*) ,intent(out) :: unit ! delta time unit + integer(SHR_KIND_IN),intent(out) :: bdate ! base date yyyymmdd + real(SHR_KIND_R8) ,intent(out) :: bsec ! base seconds + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: i,i1,i2 ! generic index + character(SHR_KIND_CL) :: tbase ! baseline time + character(SHR_KIND_CL) :: lstr ! local string + integer(SHR_KIND_IN) :: yr,mo,da,hr,min ! time stuff + real(SHR_KIND_R8) :: sec ! time stuff + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_parseCFtunit) " + character(*),parameter :: F00 = "('(shr_string_parseCFtunit) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! o assume length of CF-1.0 time attribute char string < SHR_KIND_CL +! This is a reasonable assumption. +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + unit = 'none' + bdate = 0 + bsec = 0.0_SHR_KIND_R8 + + i = shr_string_lastIndex(string,'days ') + if (i > 0) unit = 'days' + i = shr_string_lastIndex(string,'hours ') + if (i > 0) unit = 'hours' + i = shr_string_lastIndex(string,'minutes ') + if (i > 0) unit = 'minutes' + i = shr_string_lastIndex(string,'seconds ') + if (i > 0) unit = 'seconds' + + if (trim(unit) == 'none') then + write(s_logunit,F00) ' ERROR time unit unknown' + call shr_string_abort(subName//' time unit unknown') + endif + + i = shr_string_lastIndex(string,' since ') + if (i < 1) then + write(s_logunit,F00) ' ERROR since does not appear in unit attribute for time ' + call shr_string_abort(subName//' no since in attr name') + endif + tbase = trim(string(i+6:)) + call shr_string_leftAlign(tbase) + + if (debug > 0 .and. s_logunit > 0) then + write(s_logunit,*) trim(subName)//' '//'unit '//trim(unit) + write(s_logunit,*) trim(subName)//' '//'tbase '//trim(tbase) + endif + + yr=0; mo=0; da=0; hr=0; min=0; sec=0 + i1 = 1 + + i2 = index(tbase,'-') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) yr + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,'-') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) mo + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,' ') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=200) da + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,':') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) hr + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,':') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) min + tbase = tbase(i2+2:) + call shr_string_leftAlign(tbase) + + i2 = index(tbase,' ') - 1 + lstr = tbase(i1:i2) + read(lstr,*,ERR=200,END=100) sec + +100 continue + + if (debug > 0 .and. s_loglev > 0) write(s_logunit,*) trim(subName),'ymdhms:',yr,mo,da,hr,min,sec + + bdate = abs(yr)*10000 + mo*100 + da + if (yr < 0) bdate = -bdate + bsec = real(hr*3600 + min*60,SHR_KIND_R8) + sec + + if (present(rc)) rc = 0 + + if (debug>1) call shr_timer_stop (t01) + return + +200 continue + write(s_logunit,F00) 'ERROR 200 on char num read ' + call shr_string_abort(subName//' ERROR on char num read') + if (debug>1) call shr_timer_stop (t01) + return + +end subroutine shr_string_parseCFtunit + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_clean -- Clean a string, set it to "blank" +! +! !DESCRIPTION: +! Clean a string, set it to blank +! \newline +! call shr\_string\_clean(string,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_clean(string,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: string ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! counter + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_clean) " + character(*),parameter :: F00 = "('(shr_string_clean) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + string = ' ' + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_clean + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listIsValid -- determine whether string is a valid list +! +! !DESCRIPTION: +! Determine whether string is a valid list +! \newline +! logical_var = shr\_string\_listIsValid(list,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - B. Kauffman +! +! !INTERFACE: ------------------------------------------------------------------ + +logical function shr_string_listIsValid(list,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer (SHR_KIND_IN) :: nChar ! lenth of list + integer (SHR_KIND_IN) :: rCode ! return code + integer (SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listIsValid) " + character(*),parameter :: F00 = "('(shr_string_listIsValid) ',4a)" + +!------------------------------------------------------------------------------- +! check that the list conforms to the list format +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + shr_string_listIsValid = .true. + + nChar = len_trim(list) + if (nChar < 1) then ! list is an empty string + rCode = 1 + else if ( list(1:1) == listDel ) then ! first char is delimiter + rCode = 2 + else if (list(nChar:nChar) == listDel ) then ! last char is delimiter + rCode = 3 + else if (index(trim(list)," " ) > 0) then ! white-space in a field name + rCode = 4 + else if (index(trim(list),listDel2) > 0) then ! found zero length field + rCode = 5 + end if + + if (rCode /= 0) then + shr_string_listIsValid = .false. + if (s_loglev > 0) write(s_logunit,F00) "WARNING: invalid list = ",trim(list) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listIsValid + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetName -- Get name of k-th field in list +! +! !DESCRIPTION: +! Get name of k-th field in list +! \newline +! call shr\_string\_listGetName(list,k,name,rc) +! +! !REVISION HISTORY: +! 2005-May-05 - B. Kauffman +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetName(list,k,name,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list ! list/string + integer(SHR_KIND_IN) ,intent(in) :: k ! index of field + character(*) ,intent(out) :: name ! k-th name in list + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: i,j,n ! generic indecies + integer(SHR_KIND_IN) :: kFlds ! number of fields in list + integer(SHR_KIND_IN) :: i0,i1 ! name = list(i0:i1) + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetName) " + character(*),parameter :: F00 = "('(shr_string_listGetName) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + + !--- check that this is a valid list --- + if (.not. shr_string_listIsValid(list,rCode) ) then + write(s_logunit,F00) "ERROR: invalid list = ",trim(list) + call shr_string_abort(subName//" ERROR: invalid list = "//trim(list)) + end if + + !--- check that this is a valid index --- + kFlds = shr_string_listGetNum(list) + if (k<1 .or. kFlds1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetName + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listIntersect -- Get intersection of two field lists +! +! !DESCRIPTION: +! Get intersection of two fields lists, write into third list +! \newline +! call shr\_string\_listIntersect(list1,list2,listout) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listIntersect(list1,list2,listout,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: nf,n1,n2 ! counters + character(SHR_KIND_CS) :: name ! field name + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listIntersect) " + character(*),parameter :: F00 = "('(shr_string_listIntersect) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + rCode = 0 + + nf = shr_string_listGetNum(list1) + call shr_string_clean(listout) + do n1 = 1,nf + call shr_string_listGetName(list1,n1,name,rCode) + n2 = shr_string_listGetIndexF(list2,name) + if (n2 > 0) then + call shr_string_listAppend(listout,name) + endif + enddo + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listIntersect + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listUnion -- Get union of two field lists +! +! !DESCRIPTION: +! Get union of two fields lists, write into third list +! \newline +! call shr\_string\_listUnion(list1,list2,listout) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listUnion(list1,list2,listout,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: nf,n1,n2 ! counters + character(SHR_KIND_CS) :: name ! field name + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listUnion) " + character(*),parameter :: F00 = "('(shr_string_listUnion) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + call shr_string_clean(listout) + + nf = shr_string_listGetNum(list1) + do n1 = 1,nf + call shr_string_listGetName(list1,n1,name,rCode) + n2 = shr_string_listGetIndexF(listout,name) + if (n2 < 1) then + call shr_string_listAppend(listout,name) + endif + enddo + + nf = shr_string_listGetNum(list2) + do n1 = 1,nf + call shr_string_listGetName(list2,n1,name,rCode) + n2 = shr_string_listGetIndexF(listout,name) + if (n2 < 1) then + call shr_string_listAppend(listout,name) + endif + enddo + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listUnion + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listMerge -- Merge lists two list to third +! +! !DESCRIPTION: +! Merge two list to third +! \newline +! call shr\_string\_listMerge(list1,list2,listout) +! call shr\_string\_listMerge(list1,list2,list1) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listMerge(list1,list2,listout,rc) + + implicit none +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: list1 ! list/string + character(*) ,intent(in) :: list2 ! list/string + character(*) ,intent(out) :: listout ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1,l2 ! local char strings + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listMerge) " + character(*),parameter :: F00 = "('(shr_string_listMerge) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp strings are large enough --- + if ( (len(l1) < len_trim(list1)) .or. (len(l2) < len_trim(list2))) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + call shr_string_clean(l2) + call shr_string_clean(listout) + l1 = trim(list1) + l2 = trim(list2) + call shr_string_leftAlign(l1,rCode) + call shr_string_leftAlign(l2,rCode) + if (len_trim(l1)+len_trim(l2)+1 > len(listout)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(l1) == 0) then + listout = trim(l2) + else + listout = trim(l1)//":"//trim(l2) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listMerge + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listAppend -- Append one list to another +! +! !DESCRIPTION: +! Append one list to another +! \newline +! call shr\_string\_listAppend(list,listadd) +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listAppend(list,listadd,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(inout) :: list ! list/string + character(*) ,intent(in) :: listadd ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1 ! local string + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listAppend) " + character(*),parameter :: F00 = "('(shr_string_listAppend) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp string is large enough --- + if (len(l1) < len_trim(listAdd)) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + l1 = trim(listadd) + call shr_string_leftAlign(l1,rCode) + if (len_trim(list)+len_trim(l1)+1 > len(list)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(list) == 0) then + list = trim(l1) + else + list = trim(list)//":"//trim(l1) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listAppend + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listPrepend -- Prepend one list to another +! +! !DESCRIPTION: +! Prepend one list to another +! \newline +! call shr\_string\_listPrepend(listadd,list) +! \newline +! results in listadd:list +! +! !REVISION HISTORY: +! 2005-May-05 - T. Craig +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listPrepend(listadd,list,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: listadd ! list/string + character(*) ,intent(inout) :: list ! list/string + integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code + +!EOP + + !----- local ----- + character(SHR_KIND_CX) :: l1 ! local string + integer(SHR_KIND_IN) :: rCode ! return code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listPrepend) " + character(*),parameter :: F00 = "('(shr_string_listPrepend) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + rCode = 0 + + !--- make sure temp string is large enough --- + if (len(l1) < len_trim(listAdd)) then + call shr_string_abort(subName//'ERROR: temp string not large enough') + end if + + call shr_string_clean(l1) + l1 = trim(listadd) + call shr_string_leftAlign(l1,rCode) + call shr_string_leftAlign(list,rCode) + if (len_trim(list)+len_trim(l1)+1 > len(list)) & + call shr_string_abort(subName//'ERROR: output list string not large enough') + if (len_trim(l1) == 0) then + list = trim(list) + else + list = trim(l1)//":"//trim(list) + endif + + if (present(rc)) rc = rCode + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listPrepend + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetIndexF -- Get index of field in string +! +! !DESCRIPTION: +! Get index of field in string +! \newline +! k = shr\_string\_listGetIndex(str,"taux") +! +! !REVISION HISTORY: +! 2005-Feb-28 - B. Kauffman and J. Schramm - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_listGetIndexF(string,fldStr) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: string ! string + character(*),intent(in) :: fldStr ! name of field + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: k ! local index variable + integer(SHR_KIND_IN) :: rc ! error code + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetIndexF) " + character(*),parameter :: F00 = "('(shr_string_listGetIndexF) ',4a)" + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + call shr_string_listGetIndex(string,fldStr,k,print=.false.,rc=rc) + shr_string_listGetIndexF = k + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listGetIndexF + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetIndex -- Get index of field in string +! +! !DESCRIPTION: +! Get index of field in string +! \newline +! call shr\_string\_listGetIndex(str,"taux",k,rc) +! +! !REVISION HISTORY: +! 2005-Feb-28 - B. Kauffman and J. Schramm - first version +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetIndex(string,fldStr,kFld,print,rc) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*) ,intent(in) :: string ! string + character(*) ,intent(in) :: fldStr ! name of field + integer(SHR_KIND_IN),intent(out) :: kFld ! index of field + logical ,intent(in) ,optional :: print ! print switch + integer(SHR_KIND_IN),intent(out),optional :: rc ! return code + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: n ! index for colon position + integer(SHR_KIND_IN) :: k ! index for field name position + integer(SHR_KIND_IN) :: nFields ! number of fields in a string + integer(SHR_KIND_IN) :: i0,i1 ! fldStr == string(i0,i1) ?? + integer(SHR_KIND_IN) :: j0,j1 ! fldStr == string(j0,j1) ?? + logical :: found ! T => field found in fieldNames + logical :: lprint ! local print flag + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetIndex) " + character(*),parameter :: F00 = "('(shr_string_listGetIndex) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +! - searching from both ends of the list at the same time seems to be 20% faster +! but I'm not sure why (B. Kauffman, Feb 2007) +! - I commented out sanity check to a little gain speed (B. Kauffman, Mar 2007) +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + if (present(rc)) rc = 0 + + lprint = .false. + if (present(print)) lprint = print + + !--- confirm proper size of input data --- + if (len_trim(fldStr) < 1) then + if (lprint) write(s_logunit,F00) "ERROR: input field name has 0 length" + call shr_string_abort(subName//"invalid field name") + end if + + !--- search for field name in string's list of fields --- + found = .false. + kFld = 0 + i0 = 1 ! ?? fldStr == string(i0:i1) ?? + i1 = -1 + j0 = -1 ! ?? fldStr == string(j0:j1) ?? + j1 = len_trim(string) + nFields = shr_string_listGetNum(string) + do k = 1,nFields + !-------------------------------------------------------- + ! search from end of list to end of list + !-------------------------------------------------------- + !--- get end index of of field number k --- + n = index(string(i0:len_trim(string)),listDel) + if (n > 0) then + i1 = i0 + n - 2 ! *not* the last field name in fieldNames + else + i1 = len_trim(string) ! this is the last field name in fieldNames + endif + !--- sanity check --- + ! if ((k 0)) then + ! call shr_string_abort(subName//"ERROR: wrong string%nf ?") + ! end if + !--- is it a match? --- + if (trim(fldStr) == string(i0:i1)) then + found = .true. + kFld = k + exit + endif + i0 = i1 + 2 ! start index for next iteration + !-------------------------------------------------------- + ! search from end of list to start of list + !-------------------------------------------------------- + !--- get start index of field number (nFields + 1 - k ) --- + n = index(string(1:j1),listDel,back=.true.) + j0 = n + 1 ! n==0 => the first field name in fieldNames + !--- sanity check --- + ! if ((k 0)) then + ! call shr_string_abort(subName//"ERROR: wrong string%nf ?") + ! end if + !--- is it a match? --- + if (trim(fldStr) == string(j0:j1)) then + found = .true. + kFld = nFields + 1 - k + exit + endif + j1 = j0 - 2 ! end index for next iteration + !-------------------------------------------------------- + ! exit if all field names have been checked + !-------------------------------------------------------- + if (2*k >= nFields) exit + end do + + !--- not finding a field is not a fatal error --- + if (.not. found) then + kFld = 0 + if (lprint .and. s_loglev > 0) write(s_logunit,F00) "FYI: field ",trim(fldStr)," not found in list ",trim(string) + if (present(rc)) rc = 1 + end if + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetIndex + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetNum -- get number of fields in a string list +! +! !DESCRIPTION: +! return number of fields in string list +! +! !REVISION HISTORY: +! 2005-Apr-28 - T. Craig - First version +! +! !INTERFACE: ------------------------------------------------------------------ + +integer function shr_string_listGetNum(str) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(in) :: str ! string to search + +!EOP + + !----- local ----- + integer(SHR_KIND_IN) :: count ! counts occurances of char + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !----- formats ----- + character(*),parameter :: subName = "(shr_string_listGetNum) " + character(*),parameter :: F00 = "('(shr_string_listGetNum) ',4a)" + +!------------------------------------------------------------------------------- +! Notes: +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + shr_string_listGetNum = 0 + + if (len_trim(str) > 0) then + count = shr_string_countChar(str,listDel) + shr_string_listGetNum = count + 1 + endif + + if (debug>1) call shr_timer_stop (t01) + +end function shr_string_listGetNum + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listSetDel -- Set list delimeter character +! +! !DESCRIPTION: +! Set field delimeter character in lists +! \newline +! call shr\_string\_listSetDel(":") +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listSetDel(cflag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(len=1),intent(in) :: cflag + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_listSetDel) " + character(*),parameter :: F00 = "('(shr_string_listSetDel) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + if (debug > 0 .and. s_loglev > 0) write(s_logunit,F00) 'changing listDel from '//trim(listDel)//' to '//trim(cflag) + listDel = trim(cflag) + listDel2 = listDel//listDel + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listSetDel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_listGetDel -- Get list delimeter character +! +! !DESCRIPTION: +! Get field delimeter character in lists +! \newline +! call shr\_string\_listGetDel(del) +! +! !REVISION HISTORY: +! 2005-May-15 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_listGetDel(del) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),intent(out) :: del + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_listGetDel) " + character(*),parameter :: F00 = "('(shr_string_listGetDel) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + del = trim(listDel) + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_listGetDel + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_setAbort -- Set local shr_string abort flag +! +! !DESCRIPTION: +! Set local shr_string abort flag, true = abort, false = print and continue +! \newline +! call shr\_string\_setAbort(.false.) +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_setAbort(flag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + logical,intent(in) :: flag + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_setAbort) " + character(*),parameter :: F00 = "('(shr_string_setAbort) ',a) " + +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + if (debug > 0 .and. s_loglev > 0) then + if (flag) then + write(s_logunit,F00) 'setting abort to true' + else + write(s_logunit,F00) 'setting abort to false' + endif + endif + + doabort = flag + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_setAbort + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: shr_string_setDebug -- Set local shr_string debug level +! +! !DESCRIPTION: +! Set local shr_string debug level, 0 = production +! \newline +! call shr\_string\_setDebug(2) +! +! !REVISION HISTORY: +! 2005-Apr-30 - T. Craig - first prototype +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine shr_string_setDebug(iFlag) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + integer(SHR_KIND_IN),intent(in) :: iFlag ! requested debug level + +!EOP + + !--- local --- + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- formats --- + character(*),parameter :: subName = "(shr_string_setDebug) " + character(*),parameter :: F00 = "('(shr_string_setDebug) ',a) " + character(*),parameter :: F01 = "('(shr_string_setDebug) ',a,i3,a,i3) " + +!------------------------------------------------------------------------------- +! NTOE: write statement can be expensive if called many times. +!------------------------------------------------------------------------------- + + if (iFlag>1 .and. t01<1) call shr_timer_get(t01,subName) + if (iFlag>1) call shr_timer_start(t01) + +! if (s_loglev > 0) write(s_logunit,F01) 'changing debug level from ',debug,' to ',iflag + debug = iFlag + + if (iFlag>1) call shr_timer_stop (t01) + +end subroutine shr_string_setDebug + +!=============================================================================== +!=============================================================================== + +subroutine shr_string_abort(string) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + character(*),optional,intent(in) :: string + +!EOP + + integer(SHR_KIND_IN) :: t01 = 0 ! timer + + !--- local --- + character(SHR_KIND_CX) :: lstring + character(*),parameter :: subName = "(shr_string_abort)" + character(*),parameter :: F00 = "('(shr_string_abort) ',a)" + +!------------------------------------------------------------------------------- +! NOTE: +! - no input or output string should be longer than SHR_KIND_CX +!------------------------------------------------------------------------------- + + if (debug>1 .and. t01<1) call shr_timer_get(t01,subName) + if (debug>1) call shr_timer_start(t01) + + lstring = '' + if (present(string)) lstring = string + + if (doabort) then + call shr_sys_abort(trim(lstring)) + else + write(s_logunit,F00) ' no abort:'//trim(lstring) + endif + + if (debug>1) call shr_timer_stop (t01) + +end subroutine shr_string_abort + +!=============================================================================== +!=============================================================================== + +end module shr_string_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_sys_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_sys_mod.F90 new file mode 100644 index 0000000000..500ac40698 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_sys_mod.F90 @@ -0,0 +1,355 @@ +!=============================================================================== +! SVN $Id: shr_sys_mod.F90 28978 2011-06-27 20:37:05Z jedwards $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_110803/shr/shr_sys_mod.F90 $ +!=============================================================================== + +MODULE shr_sys_mod + + use shr_kind_mod ! defines real & integer kinds + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + +! PUBLIC: Public interfaces + + private + + public :: shr_sys_system ! make a system call + public :: shr_sys_chdir ! change current working dir + public :: shr_sys_getenv ! get an environment variable + public :: shr_sys_abort ! abort a program + public :: shr_sys_irtc ! returns real-time clock tick + public :: shr_sys_sleep ! have program sleep for a while + public :: shr_sys_flush ! flush an i/o buffer + +!=============================================================================== +CONTAINS +!=============================================================================== + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_system(str,rcode) + + IMPLICIT none + + !----- arguments --- + character(*) ,intent(in) :: str ! system/shell command string + integer(SHR_KIND_IN),intent(out) :: rcode ! function return error code + + !----- functions ----- +#if (defined CRAY) || (defined UNICOSMP) + integer(SHR_KIND_IN),external :: ishell ! function to envoke shell command +#endif +#if (defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__ && !defined CATAMOUNT)) + integer(SHR_KIND_IN),external :: system ! function to envoke shell command +#endif + + !----- local ----- +#if (defined CATAMOUNT) + character(2*SHR_KIND_CL) :: file1 ! one or two filenames + character( SHR_KIND_CL) :: file2 ! 2nd file name + integer(SHR_KIND_IN) :: iloc ! index/location within a string +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_system) ' + character(*),parameter :: F00 = "('(shr_sys_system) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +! NOTE: +! - for Catamount (Cray, pheonix at ORNL) there is no system call -- workarounds +! exist only for simple "rm" and "cp" commands +!------------------------------------------------------------------------------- + + +#if (defined CRAY) || (defined UNICOSMP) + + rcode=ishell(str) + +#elif (defined IRIX64 || defined NEC_SX) + + rcode = 0 + call system(str) + +#elif (defined AIX) + + call system(str,rcode) + +#elif (defined OSF1 || defined SUNOS || defined __GFORTRAN__ || (defined LINUX && !defined CATAMOUNT)) + + rcode = system(str) + +#elif (defined CATAMOUNT) + if (str(1:3) == 'rm ') then + call unlink(str(4:)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT unlink ',trim(str(4:)) + rcode = 0 + elseif (str(1:3) == 'mv ') then + file1 = str(4:) + iloc = index(file1,' ') + 3 + if (iloc < 6) then + if (s_loglev > 0) write(s_logunit,*) 'CATAMOUNT mv error ',trim(str),iloc + rcode = -1 + else + file1 = str(4:iloc) + file2 = str(iloc+1:) + call rename(trim(file1),trim(file2)) + if (s_loglev > 0) write(s_logunit,F00) 'CATAMOUNT rename ',trim(file1)," ",trim(file2) + rcode = 0 + endif + else + rcode = -1 + endif + +#else + + write(s_logunit,F00) 'ERROR: no implementation of system call for this architecture' + call shr_sys_abort(subName//'no implementation of system call for this architecture') + +#endif + +END SUBROUTINE shr_sys_system + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_chdir(path, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: path ! chdir to this dir + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenpath ! length of path +#if (defined AIX || defined OSF1 || defined SUNOS || (defined LINUX && !defined __GFORTRAN__) || defined NEC_SX) + integer(SHR_KIND_IN),external :: chdir ! AIX system call +#endif + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_chdir) ' + character(*),parameter :: F00 = "('(shr_sys_chdir) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenpath=len_trim(path) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfchdir(path, lenpath, rcode) + +#elif (defined AIX) + + rcode = chdir(%ref(path(1:lenpath)//'\0')) + +#elif (defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + rcode=chdir(path(1:lenpath)) + +#else + + write(s_logunit,F00) 'ERROR: no implementation of chdir for this architecture' + call shr_sys_abort(subname//'no implementation of chdir for this machine') + +#endif + +END SUBROUTINE shr_sys_chdir + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_getenv(name, val, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: name ! env var name + character(*) ,intent(out) :: val ! env var value + integer(SHR_KIND_IN),intent(out) :: rcode ! return code + + !----- local ----- + integer(SHR_KIND_IN) :: lenname ! length of env var name + integer(SHR_KIND_IN) :: lenval ! length of env var value + character(SHR_KIND_CL) :: tmpval ! temporary env var value + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_getenv) ' + character(*),parameter :: F00 = "('(shr_sys_getenv) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenname=len_trim(name) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfgetenv(name, lenname, val, lenval, rcode) + +#elif (defined AIX || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) + + call getenv(trim(name),tmpval) + val=trim(tmpval) + rcode = 0 + if (len_trim(val) == 0 ) rcode = 1 + if (len_trim(val) > SHR_KIND_CL) rcode = 2 + +#else + + write(s_logunit,F00) 'ERROR: no implementation of getenv for this architecture' + call shr_sys_abort(subname//'no implementation of getenv for this machine') + +#endif + +END SUBROUTINE shr_sys_getenv + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_abort(string,rc) + + IMPLICIT none + + character(*) ,optional :: string ! error message string + integer(SHR_KIND_IN),optional :: rc ! error code + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_abort) ' + character(*),parameter :: F00 = "('(shr_sys_abort) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: consistent stopping mechanism +!------------------------------------------------------------------------------- + + call shr_sys_flush(s_logunit) + if (len_trim(string) > 0) write(s_logunit,F00) 'ERROR: '//trim(string) + write(s_logunit,F00) 'WARNING: stopping' + call shr_sys_flush(s_logunit) + call abort() + stop + +END SUBROUTINE shr_sys_abort + +!=============================================================================== +!=============================================================================== + +integer(SHR_KIND_I8) FUNCTION shr_sys_irtc( rate ) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_I8), optional :: rate + + !----- local ----- + integer(SHR_KIND_IN) :: count + integer(SHR_KIND_IN) :: count_rate + integer(SHR_KIND_IN) :: count_max + integer(SHR_KIND_IN),save :: last_count = -1 + integer(SHR_KIND_I8),save :: count_offset = 0 + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_irtc) ' + character(*),parameter :: F00 = "('(shr_sys_irtc) ',4a)" + +!------------------------------------------------------------------------------- +! emulates Cray/SGI irtc function (returns clock tick since last reboot) +!------------------------------------------------------------------------------- + + call system_clock(count=count,count_rate=count_rate, count_max=count_max) + if ( present(rate) ) rate = count_rate + shr_sys_irtc = count + + !--- adjust for clock wrap-around --- + if ( last_count /= -1 ) then + if ( count < last_count ) count_offset = count_offset + count_max + end if + shr_sys_irtc = shr_sys_irtc + count_offset + last_count = count + +END FUNCTION shr_sys_irtc + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_sleep(sec) + + IMPLICIT none + + !----- arguments ----- + real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep + + !----- local ----- + integer(SHR_KIND_IN) :: isec ! integer number of seconds + integer(SHR_KIND_IN) :: rcode ! return code + character(90) :: str ! system call string + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_sleep) ' + character(*),parameter :: F00 = "('(shr_sys_sleep) ',4a)" + character(*),parameter :: F10 = "('sleep ',i8 )" + +!------------------------------------------------------------------------------- +! PURPOSE: Sleep for approximately sec seconds +!------------------------------------------------------------------------------- + + isec = nint(sec) + + if (isec < 0) then + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: seconds must be > 0, sec=',sec + else if (isec == 0) then + ! Don't consider this an error and don't call system sleep + else +#if defined(CATAMOUNT) + call sleep(isec) +#else + write(str,FMT=F10) isec + call shr_sys_system( str, rcode ) +#endif + endif + +END SUBROUTINE shr_sys_sleep + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_sys_flush(unit) + + IMPLICIT none + + !----- arguments ----- + integer(SHR_KIND_IN) :: unit ! flush output buffer for this unit + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_flush) ' + character(*),parameter :: F00 = "('(shr_sys_flush) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + +#if (defined IRIX64 || defined CRAY || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX || defined UNICOSMP) + + call flush(unit) + +#elif (defined AIX) + + call flush_(unit) + +#else + + if (s_loglev > 0) write(s_logunit,F00) 'WARNING: no implementation of flush for this architecture' + +#endif + +END SUBROUTINE shr_sys_flush + +!=============================================================================== +!=============================================================================== + +END MODULE shr_sys_mod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/shr_timer_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_timer_mod.F90 new file mode 100644 index 0000000000..a764c7e1c1 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/shr_timer_mod.F90 @@ -0,0 +1,428 @@ +!=============================================================================== +! SVN $Id: shr_timer_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_101231/shr/shr_timer_mod.F90 $ +!=============================================================================== + +module shr_timer_mod + + !---------------------------------------------------------------------------- + ! + ! routines that support multiple CPU timers via F90 intrinsics + ! + ! Note: + ! o if an operation is requested on an invalid timer number n + ! then nothing is done in a routine + ! o if more than max_timers are requested, + ! then timer n=max_timers is "overloaded" and becomes invalid/undefined + ! + ! * cpp if-defs were introduced in 2005 to work-around a bug in the ORNL Cray + ! X1 F90 intrinsic system_clock() function -- ideally this Cray bug would be + ! fixed and cpp if-defs would be unnecessary and removed. + ! + ! !REVISION HISTORY: + ! 2005-??-?? - added workaround for Cray F90 bug, mods by Cray/ORNL + ! 2000-??-?? - 1st version by B. Kauffman + !---------------------------------------------------------------------------- + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + + private ! restricted access + + public :: shr_timer_init + public :: shr_timer_get + public :: shr_timer_start + public :: shr_timer_stop + public :: shr_timer_print + public :: shr_timer_print_all + public :: shr_timer_check + public :: shr_timer_check_all + public :: shr_timer_zero + public :: shr_timer_zero_all + public :: shr_timer_free + public :: shr_timer_free_all + public :: shr_timer_sleep + + integer(SHR_KIND_IN),parameter :: stat_free = 0 ! timer status constants + integer(SHR_KIND_IN),parameter :: stat_inuse = 1 + integer(SHR_KIND_IN),parameter :: stat_started = 2 + integer(SHR_KIND_IN),parameter :: stat_stopped = 3 + integer(SHR_KIND_IN),parameter :: max_timers = 200 ! max number of timers + + integer(SHR_KIND_IN) :: status (max_timers) ! status of each timer + !---------------------------------------------------------------------------- + ! the following ifdef circumvents a bug in the X1 system_clock function + !---------------------------------------------------------------------------- +#if (defined UNICOSMP) + integer(kind=8) :: cycles1(max_timers) ! cycle number at timer start + integer(kind=8) :: cycles2(max_timers) ! cycle number at timer stop +#else + integer(SHR_KIND_IN) :: cycles1(max_timers) ! cycle number at timer start + integer(SHR_KIND_IN) :: cycles2(max_timers) ! cycle number at timer stop +#endif + integer(SHR_KIND_IN) :: cycles_max = -1 ! max cycles before wrapping + character (len=80) :: name (max_timers) ! name assigned to each timer + real (SHR_KIND_R8) :: dt (max_timers) ! accumulated time + integer(SHR_KIND_IN) :: calls (max_timers) ! # of samples in accumulation + real (SHR_KIND_R8) :: clock_rate ! clock_rate: seconds per cycle + + save + +!=============================================================================== + contains +!=============================================================================== + +subroutine shr_timer_init + + !----- local ----- + integer(SHR_KIND_IN) :: cycles ! count rate return by system clock +#if (defined UNICOSMP) + integer(kind=8) :: irtc_rate +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_init) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine initializes: +! 1) values in all timer array locations +! 2) machine parameters necessary for computing cpu time from F90 intrinsics. +! F90 intrinsic: system_clock(count_rate=cycles, count_max=cycles_max) +!------------------------------------------------------------------------------- + + call shr_timer_free_all + +#if (defined UNICOSMP) + cycles = irtc_rate() +#else + call system_clock(count_rate=cycles, count_max=cycles_max) +#endif + + if (cycles /= 0) then + clock_rate = 1.0_SHR_KIND_R8/real(cycles,SHR_KIND_R8) + else + clock_rate = 0._SHR_KIND_R8 + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: no system clock available' + endif + +end subroutine shr_timer_init + +!=============================================================================== + +subroutine shr_timer_get(n, str) + + !----- arguments ----- + integer(SHR_KIND_IN),intent(out) :: n ! timer number + character (*) ,intent( in) :: str ! text string with timer name + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_get) ',a,i5)" + +!----------------------------------------------------------------------- +! search for next free timer +!----------------------------------------------------------------------- + + do n=1,max_timers + if (status(n) == stat_free) then + status(n) = stat_inuse + name (n) = str + calls (n) = 0 + return + endif + end do + + n=max_timers + name (n) = "" + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: exceeded maximum number of timers' + +end subroutine shr_timer_get + +!=============================================================================== + +subroutine shr_timer_start(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- local ----- +#if (defined UNICOSMP) + integer(kind=8) :: irtc +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_start) ',a,i5)" + +!----------------------------------------------------------------------- +! This routine starts a given timer. +!----------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) call shr_timer_stop(n) + + status(n) = stat_started +#if (defined UNICOSMP) + cycles1(n) = irtc() +#else + call system_clock(count=cycles1(n)) +#endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_start + +!=============================================================================== + +subroutine shr_timer_stop(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- local ----- + real (SHR_KIND_R8) :: elapse ! elapsed time returned by system counter +#if (defined UNICOSMP) + integer(kind=8) :: irtc +#endif + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_stop) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine stops a given timer, checks for cycle wrapping, computes the +! elapsed time, and accumulates the elapsed time in the dt(n) array +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if ( status(n) == stat_started) then +#if (defined UNICOSMP) + cycles2(n) = irtc() +#else + call system_clock(count=cycles2(n)) +#endif + if (cycles2(n) >= cycles1(n)) then + dt(n) = dt(n) + clock_rate*(cycles2(n) - cycles1(n)) + else + dt(n) = dt(n) + clock_rate*(cycles_max + cycles2(n) - cycles1(n)) + endif + calls (n) = calls(n) + 1 + status(n) = stat_stopped + end if + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_stop + +!=============================================================================== + +subroutine shr_timer_print(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_print) ',a,i5)" + character(len=*),parameter :: F01 = "('(shr_timer_print) timer',i3,& + & ':',i8,' calls,',f10.3,'s, id: ',a)" +!------------------------------------------------------------------------------- +! prints the accumulated time for a given timer +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) then + call shr_timer_stop(n) + if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n)) + call shr_timer_start(n) + else + if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n)) + endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_print + +!=============================================================================== + +subroutine shr_timer_print_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_print_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! prints accumulated time for all timers in use +!------------------------------------------------------------------------------- + + if (s_loglev > 0) write(s_logunit,F00) 'print all timing info:' + + do n=1,max_timers + if (status(n) /= stat_free) call shr_timer_print(n) + end do + +end subroutine shr_timer_print_all + +!=============================================================================== + +subroutine shr_timer_zero(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_zero) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine resets a given timer. +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + dt(n) = 0.0_SHR_KIND_R8 + calls(n) = 0 + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_zero + +!=============================================================================== + +subroutine shr_timer_zero_all + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_zero_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine resets all timers. +!------------------------------------------------------------------------------- + + dt = 0.0_SHR_KIND_R8 + calls = 0 + +end subroutine shr_timer_zero_all + +!=============================================================================== + +subroutine shr_timer_check(n) + + !----- arguments ----- + integer(SHR_KIND_IN), intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_check) ',a,i5)" + +!------------------------------------------------------------------------------- +! This routine checks a given timer. This is primarily used to +! periodically accumulate time in the timer to prevent timer cycles +! from wrapping around max_cycles. +!------------------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + if (status(n) == stat_started) then + call shr_timer_stop (n) + call shr_timer_start(n) + endif + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_check + +!=============================================================================== + +subroutine shr_timer_check_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_check_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! Call shr_timer_check for all timers in use +!------------------------------------------------------------------------------- + + do n=1,max_timers + if (status(n) == stat_started) then + call shr_timer_stop (n) + call shr_timer_start(n) + endif + end do + +end subroutine shr_timer_check_all + +!=============================================================================== + +subroutine shr_timer_free(n) + + !----- arguments ----- + integer(SHR_KIND_IN),intent(in) :: n ! timer number + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_free) ',a,i5)" + +!----------------------------------------------------------------------- +! initialize/free all timer array values +!----------------------------------------------------------------------- + + if ( n>0 .and. n<=max_timers) then + status (n) = stat_free + name (n) = "" + dt (n) = 0.0_SHR_KIND_R8 + cycles1(n) = 0 + cycles2(n) = 0 + else + if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n + end if + +end subroutine shr_timer_free + +!=============================================================================== + +subroutine shr_timer_free_all + + !----- local ----- + integer(SHR_KIND_IN) :: n + + !----- i/o formats ----- + character(len=*),parameter :: F00 = "('(shr_timer_free_all) ',a,i5)" + +!------------------------------------------------------------------------------- +! initialize/free all timer array values +!------------------------------------------------------------------------------- + + do n=1,max_timers + call shr_timer_free(n) + end do + +end subroutine shr_timer_free_all + +!=============================================================================== + +subroutine shr_timer_sleep(sec) + + use shr_sys_mod ! share system calls (namely, shr_sys_sleep) + + !----- local ----- + real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep + +!------------------------------------------------------------------------------- +! Sleep for approximately sec seconds +! +! Note: sleep is typically a system call, hence it is implemented in +! shr_sys_mod, although it probably would only be used in a timing +! context, which is why there is a shr_timer_* wrapper provided here. +!------------------------------------------------------------------------------- + + call shr_sys_sleep(sec) + +end subroutine shr_timer_sleep + +!=============================================================================== +end module shr_timer_mod +!=============================================================================== diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/CMakeLists.txt b/components/clm/tools/clm4_5/mksurfdata_map/src/test/CMakeLists.txt new file mode 100644 index 0000000000..60507de2cc --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/CMakeLists.txt @@ -0,0 +1,2 @@ +add_subdirectory(mkpctPftType_test) +add_subdirectory(mkpftUtils_test) diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/CMakeLists.txt b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/CMakeLists.txt new file mode 100644 index 0000000000..8fd784c672 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/CMakeLists.txt @@ -0,0 +1,4 @@ +create_pFUnit_test(mkpctPftType test_mkpctPftType_exe + "test_mkpctPftType.pf" "") + +target_link_libraries(test_mkpctPftType_exe mksurfdat) \ No newline at end of file diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/test_mkpctPftType.pf b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/test_mkpctPftType.pf new file mode 100644 index 0000000000..47e7e90f48 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpctPftType_test/test_mkpctPftType.pf @@ -0,0 +1,253 @@ +module test_mkpctPftType + + ! Tests of pct_pft_type + + use pfunit_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkpctPftTypeMod + + implicit none + save + + real(r8), parameter :: tol = 1.e-12_r8 + +contains + + @Test + subroutine test_constructor_nonzero() + ! Tests constructor with non-zero area + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + @assertEqual([10._r8, 40._r8, 50._r8], pct_pft%get_pct_p2l(), tolerance=tol) + @assertEqual(50._r8, pct_pft%get_pct_l2g(), tolerance=tol) + @assertEqual(11, pct_pft%get_first_pft_index()) + + end subroutine test_constructor_nonzero + + @Test + subroutine test_constructor_zero() + ! Tests constructor with zero area + type(pct_pft_type) :: pct_pft + real(r8) :: default_pct_p2l(3) + + default_pct_p2l = [0._r8, 100._r8, 0._r8] + + pct_pft = pct_pft_type([0._r8, 0._r8, 0._r8], 11, default_pct_p2l) + @assertEqual(default_pct_p2l, pct_pft%get_pct_p2l()) + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + end subroutine test_constructor_zero + + @Test + subroutine test_constructor_empty() + ! Tests version of constructor with an empty landunit + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type() + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + end subroutine test_constructor_empty + + @Test + subroutine test_assignment() + ! Tests assignment of one object to another + ! + ! Currently there is no defined assignment operator, so the point of this is to + ! ensure that intrinsic assignment works properly, particularly with respect to + ! maintaining the correct lower bound (get_first_pft_index). + type(pct_pft_type) :: source, dest + + source = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + dest = source + + @assertEqual([10._r8, 40._r8, 50._r8], dest%get_pct_p2l(), tolerance=tol) + @assertEqual(50._r8, dest%get_pct_l2g(), tolerance=tol) + @assertEqual(11, dest%get_first_pft_index()) + end subroutine test_assignment + + @Test + subroutine test_get_pct_p2g() + ! Test the get_pct_p2g routine + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + @assertEqual([5._r8, 20._r8, 25._r8], pct_pft%get_pct_p2g()) + end subroutine test_get_pct_p2g + + @Test + subroutine test_get_one_pct_p2g() + ! Test the get_one_pct_p2g routine + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + @assertEqual(20._r8, pct_pft%get_one_pct_p2g(12)) + end subroutine test_get_one_pct_p2g + + + @Test + subroutine test_set_pct_l2g() + ! Test the set_pct_l2g routine + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%set_pct_l2g(60._r8) + @assertEqual([10._r8, 40._r8, 50._r8], pct_pft%get_pct_p2l(), tolerance=tol) + @assertEqual(60._r8, pct_pft%get_pct_l2g(), tolerance=tol) + end subroutine test_set_pct_l2g + + + @Test + subroutine test_set_one_pct_p2g() + ! Test the set_one_pct_p2g routine + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%set_one_pct_p2g(12, 10._r8) + @assertEqual(40._r8, pct_pft%get_pct_l2g(), tolerance=tol) + @assertEqual([12.5_r8, 25._r8, 62.5_r8], pct_pft%get_pct_p2l(), tolerance=tol) + + end subroutine test_set_one_pct_p2g + + @Test + subroutine test_set_one_pct_p2g_to_zero() + ! Test the set_one_pct_p2g routine, when we go to a total area of 0 + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([20._r8, 0._r8, 0._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%set_one_pct_p2g(11, 0._r8) + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + ! note that pct_p2l stays at its original value + @assertEqual([100._r8, 0._r8, 0._r8], pct_pft%get_pct_p2l(), tolerance=tol) + + end subroutine test_set_one_pct_p2g_to_zero + + @Test + subroutine test_set_one_pct_p2g_from_zero() + ! Test the set_one_pct_p2g routine, when we start from a total area of 0 + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([0._r8, 0._r8, 0._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%set_one_pct_p2g(13, 5._r8) + @assertEqual(5._r8, pct_pft%get_pct_l2g()) + @assertEqual([0._r8, 0._r8, 100._r8], pct_pft%get_pct_p2l(), tolerance=tol) + + end subroutine test_set_one_pct_p2g_from_zero + + @Test + subroutine test_merge_pfts() + ! Test the merge_pfts routine + type(pct_pft_type) :: pct_pft + + pct_pft = pct_pft_type([5._r8, 20._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%merge_pfts(source=12, dest=13) + @assertEqual(50._r8, pct_pft%get_pct_l2g()) + @assertEqual([10._r8, 0._r8, 90._r8], pct_pft%get_pct_p2l(), tolerance=tol) + end subroutine test_merge_pfts + + @Test + subroutine test_remove_small_cover_no_small() + ! Test the remove_small_cover routine with no small pfts + type(pct_pft_type) :: pct_pft, pct_pft_orig + integer :: nsmall + + pct_pft = pct_pft_type([5._r8, 20._r8, 0._r8], 11, [0._r8, 100._r8, 0._r8]) + pct_pft_orig = pct_pft + + call pct_pft%remove_small_cover(1._r8, nsmall) + @assertEqual(pct_pft_orig%get_pct_l2g(), pct_pft%get_pct_l2g()) + @assertEqual(pct_pft_orig%get_pct_p2l(), pct_pft%get_pct_p2l()) + @assertEqual(0, nsmall) + end subroutine test_remove_small_cover_no_small + + @Test + subroutine test_remove_small_cover_all_small() + ! Test the remove_small_cover routine with all small (or zero) pfts + type(pct_pft_type) :: pct_pft, pct_pft_orig + integer :: nsmall + + pct_pft = pct_pft_type([5._r8, 20._r8, 0._r8], 11, [0._r8, 100._r8, 0._r8]) + pct_pft_orig = pct_pft + + call pct_pft%remove_small_cover(30._r8, nsmall) + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + @assertEqual(pct_pft_orig%get_pct_p2l(), pct_pft%get_pct_p2l()) + @assertEqual(2, nsmall) + end subroutine test_remove_small_cover_all_small + + @Test + subroutine test_remove_small_cover_some_small() + ! Test the remove_small_cover routine with some (but not all) small pfts + type(pct_pft_type) :: pct_pft + integer :: nsmall + + pct_pft = pct_pft_type([5._r8, 20._r8, 0._r8, 25._r8], 11, [0._r8, 100._r8, 0._r8, 0._r8]) + + call pct_pft%remove_small_cover(10._r8, nsmall) + @assertEqual(45._r8, pct_pft%get_pct_l2g()) + @assertEqual([0._r8, 20._r8, 0._r8, 25._r8]/45._r8 * 100._r8, pct_pft%get_pct_p2l(), tolerance=tol) + @assertEqual(1, nsmall) + end subroutine test_remove_small_cover_some_small + + @Test + subroutine test_remove_small_cover_zero_area() + ! Test the remove_small_cover routine with a starting area of 0 + type(pct_pft_type) :: pct_pft + integer :: nsmall + + pct_pft = pct_pft_type([0._r8, 0._r8, 0._r8], 11, [0._r8, 100._r8, 0._r8]) + + call pct_pft%remove_small_cover(1._r8, nsmall) + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + @assertEqual([0._r8, 100._r8, 0._r8], pct_pft%get_pct_p2l()) + @assertEqual(0, nsmall) + end subroutine test_remove_small_cover_zero_area + + @Test + subroutine test_remove_small_cover_no_landunit() + ! Test the remove_small_cover routine when there are no pfts on this landunit + type(pct_pft_type) :: pct_pft + integer :: nsmall + + pct_pft = pct_pft_type() + call pct_pft%remove_small_cover(1._r8, nsmall) + @assertEqual(0._r8, pct_pft%get_pct_l2g()) + @assertEqual(0, nsmall) + end subroutine test_remove_small_cover_no_landunit + + @Test + subroutine test_get_pct_p2l_array() + ! Test the get_pct_p2l_array routine + type(pct_pft_type) :: pct_pft(2) + real(r8) :: expected(2, 3) + + pct_pft(1) = pct_pft_type([10._r8, 40._r8, 50._r8], 11, [0._r8, 100._r8, 0._r8]) + pct_pft(2) = pct_pft_type([5._r8, 30._r8, 65._r8], 11, [0._r8, 100._r8, 0._r8]) + + expected(1,:) = [10._r8, 40._r8, 50._r8] + expected(2,:) = [5._r8, 30._r8, 65._r8] + + @assertEqual(expected, get_pct_p2l_array(pct_pft)) + + end subroutine test_get_pct_p2l_array + + @Test + subroutine test_get_pct_l2g_array() + ! Test the get_pct_l2g_array routine + type(pct_pft_type) :: pct_pft(2) + + pct_pft(1) = pct_pft_type([5._r8, 25._r8, 20._r8], 11, [0._r8, 100._r8, 0._r8]) + pct_pft(2) = pct_pft_type([1._r8, 2._r8, 3._r8], 11, [0._r8, 100._r8, 0._r8]) + + @assertEqual([50._r8, 6._r8], get_pct_l2g_array(pct_pft), tolerance=tol) + + end subroutine test_get_pct_l2g_array + +end module test_mkpctPftType diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/CMakeLists.txt b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/CMakeLists.txt new file mode 100644 index 0000000000..33dd01bcd9 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/CMakeLists.txt @@ -0,0 +1,8 @@ +set (pfunit_sources + test_adjust_total_veg_area.pf + test_convert_from_p2g.pf) + +create_pFUnit_test(mkpftUtils test_mkpftUtils_exe + "${pfunit_sources}" "") + +target_link_libraries(test_mkpftUtils_exe mksurfdat) \ No newline at end of file diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_adjust_total_veg_area.pf b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_adjust_total_veg_area.pf new file mode 100644 index 0000000000..345c1a7370 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_adjust_total_veg_area.pf @@ -0,0 +1,59 @@ +module test_adjust_total_veg_area + + ! Tests of mkpftUtilsMod: adjust_total_veg_area + + use pfunit_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkpctPftTypeMod, only : pct_pft_type + use mkpftUtilsMod, only : adjust_total_veg_area + + implicit none + save + + real(r8), parameter :: tol = 1.e-12_r8 + +contains + + @Test + subroutine test_standard_case() + type(pct_pft_type) :: pctnatpft, pctcft + + pctnatpft = pct_pft_type([5._r8, 10._r8], 1, [100._r8, 0._r8]) + pctcft = pct_pft_type([10._r8, 20._r8], 3, [100._r8, 0._r8]) + + call adjust_total_veg_area(90._r8, pctnatpft, pctcft) + + @assertEqual(30._r8, pctnatpft%get_pct_l2g()) + @assertEqual(60._r8, pctcft%get_pct_l2g()) + end subroutine test_standard_case + + @Test + subroutine test_initial_total_zero() + ! When the old areas are 0, all area should go into natural veg + type(pct_pft_type) :: pctnatpft, pctcft + + pctnatpft = pct_pft_type([0._r8, 0._r8], 1, [100._r8, 0._r8]) + pctcft = pct_pft_type([0._r8, 0._r8], 3, [100._r8, 0._r8]) + + call adjust_total_veg_area(90._r8, pctnatpft, pctcft) + + @assertEqual(90._r8, pctnatpft%get_pct_l2g()) + @assertEqual(0._r8, pctcft%get_pct_l2g()) + end subroutine test_initial_total_zero + + @Test + subroutine test_initial_one_zero() + ! Test a case where this is initially a 0 - make sure it stays 0 + type(pct_pft_type) :: pctnatpft, pctcft + + pctnatpft = pct_pft_type([0._r8, 0._r8], 1, [100._r8, 0._r8]) + pctcft = pct_pft_type([10._r8, 20._r8], 3, [100._r8, 0._r8]) + + call adjust_total_veg_area(90._r8, pctnatpft, pctcft) + + @assertEqual(0._r8, pctnatpft%get_pct_l2g()) + @assertEqual(90._r8, pctcft%get_pct_l2g()) + end subroutine test_initial_one_zero + +end module test_adjust_total_veg_area diff --git a/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_convert_from_p2g.pf b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_convert_from_p2g.pf new file mode 100644 index 0000000000..53548e4e6c --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/src/test/mkpftUtils_test/test_convert_from_p2g.pf @@ -0,0 +1,151 @@ +module test_convert_from_p2g + + ! Tests of mkpftUtilsMod: convert_from_p2g + + use pfunit_mod + + use shr_kind_mod, only : r8 => shr_kind_r8 + use mkpctPftTypeMod, only : pct_pft_type + use mkpftUtilsMod, only : convert_from_p2g + use mkpftConstantsMod, only : natpft_lb, natpft_ub, num_cft, cft_lb, cft_ub, c3cropindex + + implicit none + save + + real(r8), parameter :: tol = 1.e-12_r8 + +contains + + subroutine setup() + ! Perform setup for most tests + + natpft_lb = 0 + natpft_ub = 2 + cft_lb = 3 + cft_ub = 4 + num_cft = 2 + + c3cropindex = 3 + + end subroutine setup + + + ! ------------------------------------------------------------------------ + ! Tests of convert_from_p2g_default + ! ------------------------------------------------------------------------ + + @Test + subroutine test_standard() + ! Standard case: some nat pft, some crop + type(pct_pft_type) :: pctnatpft, pctcft + + call setup + + call convert_from_p2g([1._r8, 2._r8, 3._r8, 4._r8, 5._r8], pctnatpft, pctcft) + + @assertEqual(6._r8, pctnatpft%get_pct_l2g(), tolerance=tol) + @assertEqual([1._r8, 2._r8, 3._r8]/6._r8 * 100._r8, pctnatpft%get_pct_p2l(), tolerance=tol) + @assertEqual(9._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([4._r8, 5._r8]/9._r8 * 100._r8, pctcft%get_pct_p2l(), tolerance=tol) + end subroutine test_standard + + @Test + subroutine test_natpft0() + ! natpft all 0 (percents should be at their default) + type(pct_pft_type) :: pctnatpft, pctcft + + call setup + + call convert_from_p2g([0._r8, 0._r8, 0._r8, 4._r8, 5._r8], pctnatpft, pctcft) + + @assertEqual(0._r8, pctnatpft%get_pct_l2g()) + @assertEqual([100._r8, 0._r8, 0._r8], pctnatpft%get_pct_p2l()) + @assertEqual(9._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([4._r8, 5._r8]/9._r8 * 100._r8, pctcft%get_pct_p2l(), tolerance=tol) + end subroutine test_natpft0 + + @Test + subroutine test_cft0() + ! cft landunit present, but all 0 (percents should be at their default) + type(pct_pft_type) :: pctnatpft, pctcft + + call setup + + call convert_from_p2g([1._r8, 2._r8, 3._r8, 0._r8, 0._r8], pctnatpft, pctcft) + @assertEqual(6._r8, pctnatpft%get_pct_l2g(), tolerance=tol) + @assertEqual([1._r8, 2._r8, 3._r8]/6._r8 * 100._r8, pctnatpft%get_pct_p2l(), tolerance=tol) + @assertEqual(0._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([100._r8, 0._r8], pctcft%get_pct_p2l(), tolerance=tol) + end subroutine test_cft0 + + @Test + subroutine test_no_cft_landunit() + ! no cft landunit + type(pct_pft_type) :: pctnatpft, pctcft + + call setup + + cft_lb = 3 + cft_ub = 2 + num_cft = 0 + + call convert_from_p2g([1._r8, 2._r8, 3._r8], pctnatpft, pctcft) + @assertEqual(6._r8, pctnatpft%get_pct_l2g(), tolerance=tol) + @assertEqual([1._r8, 2._r8, 3._r8]/6._r8 * 100._r8, pctnatpft%get_pct_p2l(), tolerance=tol) + @assertEqual(0._r8, pctcft%get_pct_l2g(), tolerance=tol) + + end subroutine test_no_cft_landunit + + ! ------------------------------------------------------------------------ + ! Tests of convert_from_p2g_missing_crops + ! ------------------------------------------------------------------------ + + @Test + subroutine test_missing_crops() + type(pct_pft_type) :: pctnatpft, pctcft_saved, pctcft + + call setup + ! add an extra cft to make sure it's okay for the pct_p2g input to not contain the + ! same number of elements as the cft landunit + cft_ub = 5 + num_cft = 3 + pctcft_saved = pct_pft_type([10._r8, 15._r8, 20._r8], cft_lb, [100._r8, 0._r8, 0._r8]) + + call convert_from_p2g([1._r8, 2._r8, 3._r8, 4._r8, 0._r8], pctcft_saved, pctnatpft, pctcft) + @assertEqual(6._r8, pctnatpft%get_pct_l2g(), tolerance=tol) + @assertEqual([1._r8, 2._r8, 3._r8]/6._r8 * 100._r8, pctnatpft%get_pct_p2l(), tolerance=tol) + @assertEqual(4._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([10._r8, 15._r8, 20._r8]/45._r8 * 100._r8, pctcft%get_pct_p2l(), tolerance=tol) + + end subroutine test_missing_crops + + @Test + subroutine test_missing_crops_natpft0() + ! Make sure the setting of the natpft default works correctly for the missing_crops + ! version of the subroutine + type(pct_pft_type) :: pctnatpft, pctcft_saved, pctcft + + call setup + pctcft_saved = pct_pft_type([10._r8, 15._r8], cft_lb, [100._r8, 0._r8]) + + call convert_from_p2g([0._r8, 0._r8, 0._r8, 4._r8, 0._r8], pctcft_saved, pctnatpft, pctcft) + @assertEqual(0._r8, pctnatpft%get_pct_l2g()) + @assertEqual([100._r8, 0._r8, 0._r8], pctnatpft%get_pct_p2l()) + @assertEqual(4._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([10._r8, 15._r8]/25._r8 * 100._r8, pctcft%get_pct_p2l(), tolerance=tol) + end subroutine test_missing_crops_natpft0 + + @Test + subroutine test_missing_crops_cft0() + ! Make sure the cft cover is as expected when the cft landunit area goes to 0 + type(pct_pft_type) :: pctnatpft, pctcft_saved, pctcft + + call setup + pctcft_saved = pct_pft_type([10._r8, 15._r8], cft_lb, [100._r8, 0._r8]) + + call convert_from_p2g([1._r8, 2._r8, 3._r8, 0._r8, 0._r8], pctcft_saved, pctnatpft, pctcft) + @assertEqual(0._r8, pctcft%get_pct_l2g(), tolerance=tol) + @assertEqual([10._r8, 15._r8]/25._r8 * 100._r8, pctcft%get_pct_p2l(), tolerance=tol) + end subroutine test_missing_crops_cft0 + +end module test_convert_from_p2g diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Filepath b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Filepath new file mode 100644 index 0000000000..f5228276ec --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Filepath @@ -0,0 +1,2 @@ +. +../src diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Makefile b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Makefile new file mode 100644 index 0000000000..7260c828d8 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Makefile @@ -0,0 +1,10 @@ +# Makefile for mksurfdata_map unit testing + +EXENAME = ../test_mksurfdata_map + +# Set optimization off by default +ifeq ($(OPT),$(null)) + OPT := FALSE +endif + +include ../src/Makefile.common \ No newline at end of file diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/README b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/README new file mode 100644 index 0000000000..8620c3cc6d --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/README @@ -0,0 +1,6 @@ +This directory contains source code for building unit tests for +mksurfdata_map + +test_mod.F90 was copied from +https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk/unit_testers/test_mod.F90 + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles new file mode 100644 index 0000000000..a5c1b27f59 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/Srcfiles @@ -0,0 +1,29 @@ +test_mksurfdata_map.F90 +test_mkdomainMod.F90 +test_mkindexmapMod.F90 +test_mkgridmapMod.F90 +test_mkchecksMod.F90 +test_mkurbanparMod.F90 +test_mkutilsMod.F90 +test_mkncdio.F90 +test_mod.F90 +mkindexmapMod.F90 +mkchecksMod.F90 +mkurbanparMod.F90 +mkurbanparCommonMod.F90 +mkutilsMod.F90 +mkdomainMod.F90 +mkvarpar.F90 +mkgridmapMod.F90 +mkncdio.F90 +mkvarctl.F90 +nanMod.F90 +fileutils.F90 +shr_const_mod.F90 +shr_kind_mod.F90 +shr_sys_mod.F90 +shr_log_mod.F90 +shr_string_mod.F90 +shr_timer_mod.F90 +shr_file_mod.F90 + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon.nc new file mode 100644 index 0000000000..6d9132509a Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc new file mode 100644 index 0000000000..df021970e5 Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc new file mode 100644 index 0000000000..6cc3e34cf2 Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lsmlon.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lsmlon.nc new file mode 100644 index 0000000000..86fd6afe81 Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__lsmlon.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__num_pixels.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__num_pixels.nc new file mode 100644 index 0000000000..3bddc2b699 Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_domain_read_dims__num_pixels.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_lookup_2d_netcdf.nc b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_lookup_2d_netcdf.nc new file mode 100644 index 0000000000..c8fa0887d0 Binary files /dev/null and b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/inputs/test_lookup_2d_netcdf.nc differ diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 new file mode 100644 index 0000000000..edec7643e5 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkchecksMod.F90 @@ -0,0 +1,101 @@ +module test_mkchecksMod +! Module for testing mkchecksMod + + use mkchecksMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_min_bad + public :: test_max_bad + + character(len=*), parameter :: modname = 'test_mkchecksMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_min_bad + + implicit none + + character(len=128) :: testname + logical :: test_result + + character(len=*), parameter :: subname = 'test_min_bad' + + ! Tests for r8 + + testname = 'r8 - pass' + test_result = min_bad((/1._r8,2._r8,3._r8/), 0._r8, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'r8 - pass on border' + test_result = min_bad((/1._r8,2._r8,3._r8/), 1._r8, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + ! Note that we expect output to stdout from the following test that indicates an error + testname = 'r8 - fail' + test_result = min_bad((/1._r8,2._r8,3._r8/), 1.5_r8, 'testvar') + call test_is(test_result .eqv. .true., modname//' -- '//subname//' -- '//trim(testname)) + + ! Tests for int + + testname = 'int - pass' + test_result = min_bad((/1,2,3/), 0, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'int - pass on border' + test_result = min_bad((/1,2,3/), 1, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + ! Note that we expect output to stdout from the following test that indicates an error + testname = 'int - fail' + test_result = min_bad((/1,2,3/), 2, 'testvar') + call test_is(test_result .eqv. .true., modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_min_bad + +!------------------------------------------------------------------------------ + subroutine test_max_bad + + implicit none + + character(len=128) :: testname + logical :: test_result + + character(len=*), parameter :: subname = 'test_max_bad' + + ! Tests for r8 + + testname = 'r8 - pass' + test_result = max_bad((/1._r8,2._r8,3._r8/), 4._r8, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'r8 - pass on border' + test_result = max_bad((/1._r8,2._r8,3._r8/), 3._r8, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + ! Note that we expect output to stdout from the following test that indicates an error + testname = 'r8 - fail' + test_result = max_bad((/1._r8,2._r8,3._r8/), 2.5_r8, 'testvar') + call test_is(test_result .eqv. .true., modname//' -- '//subname//' -- '//trim(testname)) + + ! Tests for int + + testname = 'int - pass' + test_result = max_bad((/1,2,3/), 4, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'int - pass on border' + test_result = max_bad((/1,2,3/), 3, 'testvar') + call test_is(test_result .eqv. .false., modname//' -- '//subname//' -- '//trim(testname)) + + ! Note that we expect output to stdout from the following test that indicates an error + testname = 'int - fail' + test_result = max_bad((/1,2,3/), 2, 'testvar') + call test_is(test_result .eqv. .true., modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_max_bad +end module test_mkchecksMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 new file mode 100644 index 0000000000..56a37e7f28 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkdomainMod.F90 @@ -0,0 +1,95 @@ +module test_mkdomainMod +! Module for testing mkindexmapMod + + use mkdomainMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_domain_read_dims + + character(len=*), parameter :: modname = 'test_mkdomainMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_domain_read_dims + + use mkncdio + + implicit none + + type(domain_type) :: domain + integer :: ncid + character(len=128) :: testname + + integer :: ni_t, nj_t, ns_t + logical :: is_2d_t + + character(len=*), parameter :: subname = 'test_domain_read_dims' + + testname = 'lon' + call check_ret(nf_open('unit_testers/inputs/test_domain_read_dims__lon.nc', 0, ncid), subname) + ni_t = 2 + nj_t = 3 + ns_t = 6 + is_2d_t = .true. + call domain_read_dims(domain, ncid) + call check_results_2d + + testname = 'lsmlon' + call check_ret(nf_open('unit_testers/inputs/test_domain_read_dims__lsmlon.nc', 0, ncid), subname) + ni_t = 3 + nj_t = 4 + ns_t = 12 + is_2d_t = .true. + call domain_read_dims(domain, ncid) + call check_results_2d + + ! When we have both 'lon' and 'ni', should use 'ni' + testname = 'lon_and_ni' + call check_ret(nf_open('unit_testers/inputs/test_domain_read_dims__lon_and_ni.nc', 0, ncid), subname) + ni_t = 4 + nj_t = 5 + ns_t = 20 + is_2d_t = .true. + call domain_read_dims(domain, ncid) + call check_results_2d + + ! test 1-d + testname = 'num_pixels' + call check_ret(nf_open('unit_testers/inputs/test_domain_read_dims__num_pixels.nc', 0, ncid), subname) + ns_t = 17 + is_2d_t = .false. + call domain_read_dims(domain, ncid) + call check_results_1d + + ! When we have both 2-d and 1-d info, should use 2-d info + testname = 'lon_and_num_pixels' + call check_ret(nf_open('unit_testers/inputs/test_domain_read_dims__lon_and_num_pixels.nc', 0, ncid), subname) + ni_t = 2 + nj_t = 3 + ns_t = 6 + is_2d_t = .true. + call domain_read_dims(domain, ncid) + call check_results_2d + + contains + subroutine check_results_1d + call test_is(domain%ns, ns_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ns') + call test_is((domain%is_2d .eqv. is_2d_t), modname//' -- '//subname//' -- '//trim(testname)//' -- is_2d') + end subroutine check_results_1d + + subroutine check_results_2d + call test_is(domain%ns, ns_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ns') + call test_is(domain%ni, ni_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ni') + call test_is(domain%nj, nj_t, modname//' -- '//subname//' -- '//trim(testname)//' -- nj') + call test_is((domain%is_2d .eqv. is_2d_t), modname//' -- '//subname//' -- '//trim(testname)//' -- is_2d') + end subroutine check_results_2d + end subroutine test_domain_read_dims +end module test_mkdomainMod + + + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 new file mode 100644 index 0000000000..b802d16162 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkgridmapMod.F90 @@ -0,0 +1,664 @@ +module test_mkgridmapMod + ! Module for testing mkgridmapMod + + use mkgridmapMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_gridmap_areastddev + public :: test_gridmap_areaave_default + public :: test_gridmap_areaave_srcmask + public :: test_gridmap_areaave_srcmask2 + + character(len=*), parameter :: modname = 'test_mkgridmapMod' + +contains + + !------------------------------------------------------------------------------ + subroutine test_gridmap_areaave_default + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + real(r8), allocatable :: src_array(:) + real(r8), allocatable :: dst_array(:) + real(r8), allocatable :: dst_array_t(:) + + real(r8), parameter :: nodata = -1._r8 + real(r8), parameter :: eps = 1.e-13_r8 + + character(len=*), parameter :: subname = 'test_gridmap_areaave_default' + + ! Note about the gridmaps for the tests here: + ! For most tests here, the test arrays are: (1) simple case, (2) the main case to + ! test, (3) simple case. Thus, the main case in question is #2 of 3, and we're always + ! basically just testing one scenario in each call to the subroutine (rather than + ! doing a bunch of tests at once, which could make setting up the test arrays more + ! error-prone). + + ! Set up a gridmap with 0 weight of overlap on dest #2 + gridmap%na = 4 + gridmap%nb = 3 + gridmap%ns = 4 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4/) + gridmap%dst_indx = (/1,1,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.25_r8,0.75_r8/) ! weights of sources 3:4 on test 3 + gridmap%frac_dst = (/1.0, 0.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'no overlap' + src_array = (/0.1_r8,0.2_r8,0.3_r8,0.4_r8/) + dst_array_t = (/0.125_r8, nodata, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, dst_array, dst_array_t) + + ! Set up a gridmap with a single point overlapping dest #2 + gridmap%na = 5 + gridmap%nb = 3 + gridmap%ns = 5 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4,5/) + gridmap%dst_indx = (/1,1,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 1.0_r8, & ! weight of source 3 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 4:5 on test 3 + gridmap%frac_dst = (/1.0, 1.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'single overlap' + src_array = (/0.1_r8,0.2_r8,0.5_r8,0.3_r8,0.4_r8/) + dst_array_t = (/0.125_r8, 0.5_r8, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! Now change the overlap point to have weight=0 + testname = 'single overlap with 0 weight' + gridmap%wovr(3) = 0.0_r8 + gridmap%frac_dst(2) = 0.0_r8 + dst_array_t(2) = nodata + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, dst_array, dst_array_t) + + ! Set up a gridmap for the remaining tests + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.05_r8,0.05_r8,0.1_r8,0.3_r8,0.2_r8,0.15_r8,0.15_r8, & ! weights of sources 2:8 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 8:9 on test 3 + gridmap%frac_dst = (/1.0_r8, 1.0_r8, 1.0_r8/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + + + testname='multiple overlaps, all the same value' + src_array = (/0.1_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.6_r8/) + dst_array_t = (/0.2_r8, 0.5_r8, 0.575_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! dividing the weights by 2 shouldn't affect the mean + testname='weights divided by 2' + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + + ! using frac_dst > 1 should be okay + testname='frac_dst > 1' + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + + deallocate(src_array, dst_array, dst_array_t) + + end subroutine test_gridmap_areaave_default + + !------------------------------------------------------------------------------ + subroutine test_gridmap_areaave_srcmask + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + real(r8), allocatable :: src_array(:) + real(r8), allocatable :: mask_src(:) + real(r8), allocatable :: dst_array(:) + real(r8), allocatable :: dst_array_t(:) + + real(r8), parameter :: nodata = -1._r8 + real(r8), parameter :: eps = 1.e-13_r8 + + character(len=*), parameter :: subname = 'test_gridmap_areaave_srcmask' + + ! Note about the gridmaps for the tests here: + ! For most tests here, the test arrays are: (1) simple case, (2) the main case to + ! test, (3) simple case. Thus, the main case in question is #2 of 3, and we're always + ! basically just testing one scenario in each call to the subroutine (rather than + ! doing a bunch of tests at once, which could make setting up the test arrays more + ! error-prone). + + ! Set up a gridmap with 0 weight of overlap on dest #2 + gridmap%na = 4 + gridmap%nb = 3 + gridmap%ns = 4 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4/) + gridmap%dst_indx = (/1,1,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.25_r8,0.75_r8/) ! weights of sources 3:4 on test 3 + gridmap%frac_dst = (/1.0, 0.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'no overlap' + src_array = (/0.1_r8,0.2_r8,0.3_r8,0.4_r8/) + mask_src(:) = 1.0_r8 + dst_array_t = (/0.125_r8, nodata, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, mask_src, dst_array, dst_array_t) + + ! Set up a gridmap with a single point overlapping dest #2 + gridmap%na = 5 + gridmap%nb = 3 + gridmap%ns = 5 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4,5/) + gridmap%dst_indx = (/1,1,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 1.0_r8, & ! weight of source 3 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 4:5 on test 3 + gridmap%frac_dst = (/1.0, 1.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'single overlap' + src_array = (/0.1_r8,0.2_r8,0.5_r8,0.3_r8,0.4_r8/) + mask_src(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.5_r8, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! Now change the overlap point to have src_mask=0 + testname = 'single overlap with 0 src_mask' + mask_src(3) = 0.0_r8 + dst_array_t(2) = nodata + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, mask_src, dst_array, dst_array_t) + + ! Set up a gridmap for the remaining tests + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.05_r8,0.05_r8,0.1_r8,0.3_r8,0.2_r8,0.15_r8,0.15_r8, & ! weights of sources 2:8 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 8:9 on test 3 + gridmap%frac_dst = (/1.0_r8, 1.0_r8, 1.0_r8/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + + + testname='multiple overlaps, all the same value' + src_array = (/0.1_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.6_r8/) + mask_src(:) = 1.0_r8 + dst_array_t = (/0.2_r8, 0.5_r8, 0.575_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values, srcmask' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = (/1.0_r8, 1.0_r8, 0.0_r8, 0.5_r8, 1.0_r8, 0.5_r8, 0.0_r8, 1.0_r8, 1.0_r8/) + dst_array_t = (/0.125_r8, 0.923076923076923_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! dividing the weights by 2 and dividing mask_src by a constant shouldn't affect the mean + testname='weights divided by 2' + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 0.25_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + + ! using frac_dst > 1 should be okay + testname='frac_dst > 1' + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 0.25_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + + + deallocate(src_array, mask_src, dst_array, dst_array_t) + + end subroutine test_gridmap_areaave_srcmask + + !------------------------------------------------------------------------------ + subroutine test_gridmap_areaave_srcmask2 + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + real(r8), allocatable :: src_array(:) + real(r8), allocatable :: mask_src(:) + real(r8), allocatable :: dst_array(:) + real(r8), allocatable :: mask_dst(:) + real(r8), allocatable :: dst_array_t(:) + + real(r8), parameter :: mask_dst_min = 0.0_r8 + real(r8), parameter :: nodata = -1._r8 + real(r8), parameter :: eps = 1.e-13_r8 + + character(len=*), parameter :: subname = 'test_gridmap_areaave_srcmask2' + + ! Note about the gridmaps for the tests here: + ! For most tests here, the test arrays are: (1) simple case, (2) the main case to + ! test, (3) simple case. Thus, the main case in question is #2 of 3, and we're always + ! basically just testing one scenario in each call to the subroutine (rather than + ! doing a bunch of tests at once, which could make setting up the test arrays more + ! error-prone). + + ! Set up a gridmap with 0 weight of overlap on dest #2 + gridmap%na = 4 + gridmap%nb = 3 + gridmap%ns = 4 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4/) + gridmap%dst_indx = (/1,1,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.25_r8,0.75_r8/) ! weights of sources 3:4 on test 3 + gridmap%frac_dst = (/1.0, 0.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + mask_dst (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'no overlap' + src_array = (/0.1_r8,0.2_r8,0.3_r8,0.4_r8/) + mask_src(:) = 1.0_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, nodata, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, mask_src, dst_array, mask_dst, dst_array_t) + + ! Set up a gridmap with a single point overlapping dest #2 + gridmap%na = 5 + gridmap%nb = 3 + gridmap%ns = 5 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4,5/) + gridmap%dst_indx = (/1,1,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 1.0_r8, & ! weight of source 3 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 4:5 on test 3 + gridmap%frac_dst = (/1.0, 1.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + mask_dst (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'single overlap' + src_array = (/0.1_r8,0.2_r8,0.5_r8,0.3_r8,0.4_r8/) + mask_src(:) = 1.0_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.5_r8, 0.375_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! Now change the overlap point to have src_mask=0 + testname = 'single overlap with 0 src_mask' + mask_src(3) = 0.0_r8 + mask_dst(:) = 1.0_r8 + dst_array_t(2) = nodata + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, mask_src, dst_array, mask_dst, dst_array_t) + + ! Set up a gridmap for the remaining tests + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.05_r8,0.05_r8,0.1_r8,0.3_r8,0.2_r8,0.15_r8,0.15_r8, & ! weights of sources 2:8 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 8:9 on test 3 + gridmap%frac_dst = (/1.0_r8, 1.0_r8, 1.0_r8/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + mask_src (gridmap%na), & + dst_array (gridmap%nb), & + mask_dst (gridmap%nb), & + dst_array_t(gridmap%nb)) + + + testname='multiple overlaps, all the same value' + src_array = (/0.1_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.6_r8/) + mask_src(:) = 1.0_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.2_r8, 0.5_r8, 0.575_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 1.0_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values, dst mask' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 1.0_r8 + mask_dst(:) = (/1.0_r8, 0.0_r8, 1.0_r8/) + dst_array_t = (/0.125_r8, nodata, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values, srcmask' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = (/1.0_r8, 1.0_r8, 0.0_r8, 0.5_r8, 1.0_r8, 0.5_r8, 0.0_r8, 1.0_r8, 1.0_r8/) + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.923076923076923_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! dividing the weights by 2 and dividing mask_src by a constant shouldn't affect the mean + testname='weights divided by 2' + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 0.25_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + + ! using frac_dst > 1 should be okay + testname='frac_dst > 1' + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + mask_src(:) = 0.25_r8 + mask_dst(:) = 1.0_r8 + dst_array_t = (/0.125_r8, 0.875_r8, 1.775_r8/) + call gridmap_areaave(gridmap, src_array, dst_array, nodata, mask_src, mask_dst, mask_dst_min) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + + deallocate(src_array, mask_src, dst_array, mask_dst, dst_array_t) + + end subroutine test_gridmap_areaave_srcmask2 + + !------------------------------------------------------------------------------ + subroutine test_gridmap_areastddev + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + real(r8), allocatable :: src_array(:) + real(r8), allocatable :: dst_array(:) + real(r8), allocatable :: dst_array_t(:) + + real(r8), parameter :: nodata = -1._r8 + real(r8), parameter :: eps = 1.e-13_r8 + + character(len=*), parameter :: subname = 'test_gridmap_areastddev' + + ! Note about the gridmaps for the tests here: + ! For most tests here, the test arrays are: (1) simple case, (2) the main case to + ! test, (3) simple case. Thus, the main case in question is #2 of 3, and we're always + ! basically just testing one scenario in each call to the subroutine (rather than + ! doing a bunch of tests at once, which could make setting up the test arrays more + ! error-prone). + + ! Set up a gridmap with 0 weight of overlap on dest #2 + gridmap%na = 4 + gridmap%nb = 3 + gridmap%ns = 4 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4/) + gridmap%dst_indx = (/1,1,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.25_r8,0.75_r8/) ! weights of sources 3:4 on test 3 + gridmap%frac_dst = (/1.0, 0.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'no overlap' + src_array = (/0.1_r8,0.2_r8,0.3_r8,0.4_r8/) + dst_array_t = (/0.04330127018922193_r8, nodata, 0.04330127018922195_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, dst_array, dst_array_t) + + ! Set up a gridmap with a single point overlapping dest #2 + gridmap%na = 5 + gridmap%nb = 3 + gridmap%ns = 5 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,3,4,5/) + gridmap%dst_indx = (/1,1,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 1.0_r8, & ! weight of source 3 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 4:5 on test 3 + gridmap%frac_dst = (/1.0, 1.0, 1.0/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + testname = 'single overlap' + src_array = (/0.1_r8,0.2_r8,0.5_r8,0.3_r8,0.4_r8/) + dst_array_t = (/0.04330127018922193_r8, 0.0_r8, 0.04330127018922195_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, gridmap%frac_dst) + deallocate(src_array, dst_array, dst_array_t) + + ! Set up a gridmap for the remaining tests + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns), & + gridmap%frac_dst(gridmap%nb)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75_r8,0.25_r8, & ! weights of sources 1:2 on dest 1 + 0.05_r8,0.05_r8,0.1_r8,0.3_r8,0.2_r8,0.15_r8,0.15_r8, & ! weights of sources 2:8 on dest 2 + 0.25_r8,0.75_r8/) ! weights of sources 8:9 on test 3 + gridmap%frac_dst = (/1.0_r8, 1.0_r8, 1.0_r8/) + gridmap%set = 'gridmap_IsSet' + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb)) + + + testname='multiple overlaps, all the same value' + src_array = (/0.1_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.5_r8, 0.6_r8/) + dst_array_t = (/0.1732050807568877_r8, 0.0_r8, 0.04330127018922193_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + testname='multiple overlaps, different values' + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.04330127018922193_r8, 0.5346727971385864_r8, 0.04330127018922197_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + + ! dividing the weights by 2 shouldn't affect the standard deviation + testname='weights divided by 2' + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.04330127018922193_r8, 0.5346727971385864_r8, 0.04330127018922197_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + + ! using frac_dst > 1 should be okay + testname='frac_dst > 1' + gridmap%wovr(:) = gridmap%wovr(:) * 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) * 2.0_r8 + src_array = (/0.1_r8, 0.2_r8, 0.3_r8, 0.7_r8, 0.5_r8, 1.5_r8, 0.5_r8, 1.7_r8, 1.8_r8/) + dst_array_t = (/0.04330127018922193_r8, 0.5346727971385864_r8, 0.04330127018922197_r8/) + call gridmap_areastddev(gridmap, src_array, dst_array, nodata) + call test_close(dst_array, dst_array_t, eps, modname//' -- '//subname//' -- '//trim(testname)) + ! restore wovr & frac_dst + gridmap%wovr(:) = gridmap%wovr(:) / 2.0_r8 + gridmap%frac_dst(:) = gridmap%frac_dst(:) / 2.0_r8 + + deallocate(src_array, dst_array, dst_array_t) + + end subroutine test_gridmap_areastddev +end module test_mkgridmapMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 new file mode 100644 index 0000000000..4e6a099daa --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkindexmapMod.F90 @@ -0,0 +1,676 @@ +module test_mkindexmapMod +! Module for testing mkindexmapMod + + use mkindexmapMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_get_dominant_indices + public :: test_filter_same + public :: test_lookup_2d + public :: test_lookup_2d_netcdf + public :: test_which_max + + character(len=*), parameter :: modname = 'test_mkindexmapMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_get_dominant_indices + + use mkgridmapMod, only : gridmap_type + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + integer, allocatable :: src_array(:) + integer, allocatable :: dst_array(:) + integer, allocatable :: dst_array_t(:) + logical, allocatable :: filter(:) + integer :: minval, maxval, nodata + + character(len=*), parameter :: subname = 'test_get_dominant_indices' + + ! Set up a gridmap that will be used for most tests, and allocate corresponding + ! arrays: + ! Note that, for most tests here, the test arrays are: (1) simple case, (2) the main + ! case to test, (3) simple case. Thus, the main case in question is #2 of 3, and + ! we're always basically just testing one scenario in each call to the subroutine + ! (rather than doing a bunch of tests at once, which could make setting up the test + ! arrays more error-prone). + + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + ! Note: I'm not setting some things that aren't used in get_dominant_indices + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + gridmap%wovr = (/0.75,0.25, & ! weights of sources 1:2 on dest 1 + 0.1,0.1,0.1,0.3,0.2,0.2,0.2, & ! weights of sources 2:8 on dest 2 + 0.25,0.75/) ! weights of sources 8:9 on test 3 + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb), & + filter (gridmap%ns)) + + testname = 'basic test, all unique' + src_array = (/1, 2, 3, 4, 5, 6, 7, 8, 9/) + minval = 1 + maxval = 9 + nodata = -1 + ! dst 2 takes its value from src 5 because it has the largest weight: + dst_array_t = (/1, 5, 9/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'basic test, some duplicates' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'minval not 1' + src_array = (/3, 4, 5, 5, 6, 4, 4, 3, 3/) + minval = 3 + maxval = 6 + nodata = -1 + dst_array_t = (/3, 4, 3/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'single non-zero source value' + src_array = (/1, 0, 0, 0, 0, 2, 0, 0, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'single value within given min-max range' + src_array = (/1, 0, 9, 9, 0, 2, 9, 9, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, 2, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'no valid values' + src_array = (/1, 0, 9, 9, 0, 0, 9, 9, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'some filters false' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + filter = (/.true., .true., & + .false., .true., .true., .true., .false., .true., .true., & + .true., .true./) + dst_array_t = (/1, 4, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter=filter) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'all filters false' + src_array = (/1, 2, 3, 3, 4, 2, 2, 1, 1/) + minval = 1 + maxval = 4 + nodata = -1 + filter = (/.true., .true., & + .false., .false., .false., .false., .false., .false., .false., & + .true., .true./) + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata, filter=filter) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + ! Modify gridmap weights for the following test + gridmap%wovr = (/0.75,0.25, & ! weights of sources 1:2 on dest 1 + 0.0,0.0,0.0,0.0,0.0,0.0,0.0, & ! weights of sources 2:8 on dest 2 + 0.25,0.75/) ! weights of sources 8:9 on test 3 + testname='all weights 0' + src_array = (/1, 1, 1, 1, 1, 1, 1, 1, 1/) + minval = 1 + maxval = 2 + nodata = -1 + dst_array_t = (/1, nodata, 1/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + ! Make a new gridmap for the following test; + ! this involves more output cells and a more complex mapping from src to dst + ! This gridmap will have: + ! dst 1: from src 1, 4, 7 + ! dst 2: from src 2, 4, 6 + ! dst 3: from src 1 + ! dst 4: no overlapping src cells + ! dst 5: from src 5, 7, 8 + ! note that src 3 & 9 do not overlap with any dst + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, & + src_array, dst_array, dst_array_t, filter) + gridmap%na = 9 + gridmap%nb = 5 + gridmap%ns = 10 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns), & + gridmap%wovr (gridmap%ns)) + gridmap%src_indx = (/1, 2, 4, 4, 7, 6, 1, 5, 7, 8/) + gridmap%dst_indx = (/1, 2, 1, 2, 1, 2, 3, 5, 5, 5/) + gridmap%wovr = (/1, 1, 2, 2, 1, 3, 1, 2, 2, 3/) + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + dst_array_t(gridmap%nb), & + filter (gridmap%ns)) + + testname = 'more complex gridmap' + ! src index: 1 2 3 4 5 6 7 8 9 + src_array = (/1, 2, 3, 1, 5, 6, 5, 8, 9/) + minval = 1 + maxval = 9 + nodata = -1 + dst_array_t = (/1, 6, 1, nodata, 5/) + call get_dominant_indices(gridmap, src_array, dst_array, minval, maxval, nodata) + call test_is(dst_array, dst_array_t, modname//' -- '//subname//' -- '//trim(testname)) + + deallocate(gridmap%src_indx, gridmap%dst_indx, gridmap%wovr, & + src_array, dst_array_t, filter) + + end subroutine test_get_dominant_indices +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_filter_same + + use mkgridmapMod, only : gridmap_type + + implicit none + + type(gridmap_type) :: gridmap + character(len=128) :: testname + + integer, allocatable :: src_array(:) + integer, allocatable :: dst_array(:) + logical, allocatable :: filter(:) + logical, allocatable :: filter_t(:) + integer :: nodata + + character(len=*), parameter :: subname = 'test_filter_same' + + ! Set up a gridmap that will be used for most tests, and allocate corresponding + ! arrays: + ! Note that, for most tests here, the test arrays are: (1) simple case, (2) the main + ! case to test, (3) simple case. Thus, the main case in question is #2 of 3, and + ! we're always basically just testing one scenario in each call to the subroutine + ! (rather than doing a bunch of tests at once, which could make setting up the test + ! arrays more error-prone). + + ! This gridmap will have 3 src cells, 9 dest cells, and: + ! src 1: just overlaps with dst 1 + ! src 2: overlaps with dst 1 & dst 2 + ! src 3..7: just overlaps with dst 2 + ! src 8: overlaps with dst 2 & dst 3 + ! src 9: just overlaps with dst 3 + ! Note: I'm not setting some things that aren't used in filter_same + gridmap%na = 9 + gridmap%nb = 3 + gridmap%ns = 11 + allocate(gridmap%src_indx(gridmap%ns), & + gridmap%dst_indx(gridmap%ns)) + gridmap%src_indx = (/1,2,2,3,4,5,6,7,8,8,9/) + gridmap%dst_indx = (/1,1,2,2,2,2,2,2,2,3,3/) + allocate(src_array (gridmap%na), & + dst_array (gridmap%nb), & + filter (gridmap%ns), & + filter_t (gridmap%ns)) + + testname = 'maintain false values in filter' + src_array(:) = 1 + dst_array(:) = 1 + filter(:) = .true. + filter(3) = .false. + filter(5) = .false. + filter_t(:) = .true. + filter_t(3) = .false. + filter_t(5) = .false. + call filter_same(gridmap, filter, src_array, dst_array) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'dst_array = nodata in some places' + nodata = -1 + src_array(:) = 1 + src_array(5) = nodata ! make sure that even when src_array = dst_array = nodata, + ! we still end up with filter = false + dst_array = (/1, nodata, 1/) + filter(:) = .true. + filter_t(:) = .true. + filter_t(3:9) = .false. ! false for all overlaps with dst #2 + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'src_array not equal to dst_array in some places, no nodata argument' + src_array(:) = (/1, 1, 1, 1, 2, 3, 1, 3, 1/) + dst_array(:) = (/1, 1, 1/) + filter(:) = .true. + ! src_array index: 1 2 2 3 4 5 6 7 8 8 9 + filter_t(:) = (/.true.,.true.,.true.,.true.,.true.,.false.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'src_array not equal to dst_array in some places, nodata never applies' + nodata = -1 + src_array(:) = (/1, 1, 1, 1, 2, 3, 1, 3, 1/) + dst_array(:) = (/1, 1, 1/) + filter(:) = .true. + ! src_array index: 1 2 2 3 4 5 6 7 8 8 9 + filter_t(:) = (/.true.,.true.,.true.,.true.,.true.,.false.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + testname = 'combination of false filter, src_array not equal to dst_array, and nodata' + nodata = -1 + src_array(:) = (/1, 2, 1, 2, 1, 2, 1, 2, 1/) + dst_array(:) = (/nodata, 1, 1/) + filter(:) = .true. + filter(4) = .false. + filter_t(:) = (/.false.,.false.,.false.,.false.,.false.,.true.,.false.,.true.,.false.,.false.,.true./) + call filter_same(gridmap, filter, src_array, dst_array, nodata=nodata) + call test_is(filter, filter_t, modname//' -- '//subname//' -- '//trim(testname)) + + + deallocate(gridmap%src_indx, gridmap%dst_indx, & + src_array, dst_array, filter, filter_t) + + end subroutine test_filter_same +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_lookup_2d + + implicit none + + character(len=128) :: testname + real(r8), allocatable :: lookup_table(:,:) + logical , allocatable :: valid_entries(:,:) + integer , allocatable :: index1(:), index2(:) + real(r8), allocatable :: data(:), data_t(:) + real(r8) :: fill_val + integer :: nodata + integer :: ierr, ierr_t + + character(len=*), parameter :: subname = 'test_lookup_2d' + + ! Create lookup table for use in most tests + allocate(lookup_table(2,3), valid_entries(2,3)) + lookup_table(1,:) = (/11.,12.,13./) + lookup_table(2,:) = (/21.,22.,23./) + + testname = 'basic test; no nodata or valid_entries' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,2,1,2,2/) + index2 = (/1,2,3,2,3/) + fill_val = -1. + data_t = (/11., 22., 13., 22., 23./) + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'basic test but with index out of range' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,2,3,2,2/) + index2 = (/1,2,1,2,4/) + fill_val = -1. + data_t = (/11._r8, 22._r8, fill_val, 22._r8, fill_val/) + ierr_t = 2 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'basic test but with nodata present, and a nodata value in input' + allocate(index1(5), index2(5), data(5), data_t(5)) + nodata = -1 + index1 = (/nodata,2,1,2,nodata/) + index2 = (/1,2,3,nodata,nodata/) + fill_val = -1. + data_t = (/fill_val, 22._r8, 13._r8, fill_val, fill_val/) + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, nodata=nodata) + call check_results + deallocate(index1, index2, data, data_t) + + testname = 'valid_entries' + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,1,2,2,1/) + index2 = (/1,2,1,2,3/) + valid_entries(1,:) = (/.false.,.false.,.true./) + valid_entries(2,:) = (/.true. ,.true. ,.true./) + fill_val = -1. + data_t = (/fill_val, fill_val, 21._r8, 22._r8, 13._r8/) + ierr_t = 1 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, valid_entries=valid_entries) + call check_results + + testname = 'valid_entries, invalid_okay' + ! Note: this test reuses some setup from the previous test + ierr_t = 0 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, & + valid_entries=valid_entries, invalid_okay=.true.) + call check_results + deallocate(index1, index2, data, data_t) + + + testname = 'valid_entries, together with index out of range' + ! in addition to checking both valid_entries and index out of range, this also + ! makes sure that we get the appropriate ierr value when we have both errors + ! (because we encounter the valid_entries error first) + allocate(index1(5), index2(5), data(5), data_t(5)) + index1 = (/1,1,3,2,2/) + index2 = (/1,2,1,1,0/) + valid_entries(1,:) = (/.false.,.false.,.true./) + valid_entries(2,:) = (/.true. ,.true. ,.true./) + fill_val = -1. + data_t = (/fill_val, fill_val, fill_val, 21._r8, fill_val/) + ierr_t = 1 + call lookup_2d(index1, index2, lookup_table, fill_val, data, ierr, valid_entries=valid_entries) + call check_results + deallocate(index1, index2, data, data_t) + + + deallocate(lookup_table, valid_entries) + + contains + subroutine check_results + call test_is(data, data_t, modname//' -- '//subname//' -- '//trim(testname)//' -- data') + call test_is(ierr, ierr_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ierr') + end subroutine check_results + + end subroutine test_lookup_2d +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_lookup_2d_netcdf + + use mkncdio + + implicit none + + character(len=128) :: testname + character(len=64) :: tablename + character(len=4) :: dimname1, dimname2 + logical :: invalid_lookup + integer :: n_extra_dims + integer , allocatable :: index1(:), index2(:) + real(r8), allocatable :: data(:), data_t(:) + real(r8) :: fill_val + integer :: nodata + integer :: ierr, ierr_t + type(dim_slice_type), allocatable :: extra_dims(:) + + integer :: ncid + character(len=*), parameter :: filename = 'unit_testers/inputs/test_lookup_2d_netcdf.nc' + + ! flags to enable tests that we don't usually want to run, because they result in + ! an abort, but we may occasionally want to run to make sure this error-handling is + ! working properly + logical, parameter :: test_abort1 = .false. + logical, parameter :: test_abort2 = .false. + logical, parameter :: test_abort3 = .false. + + character(len=*), parameter :: subname = 'test_lookup_2d_netcdf' + + ! Open netcdf file that will be used for most tests: + ! Note that this file was created such that lookup4d(i,j,k,l) = 1000*i+100*j+10*k+l, + ! and similarly for the other variables + ! Also, lookup2d(1,2) is missing (i.e., equal to the _FillVal) + call check_ret(nf_open(filename, 0, ncid), subname) + + testname = '2-d lookup table with _FillValue resulting in valid_entries false somewhere' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup2d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 0 + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + ! Note that the third value is fill_val because lookup2d(1,2) is missing (i.e., + ! equal to the _FillVal in the netcdf file) + data_t = (/11._r8, 22._r8, fill_val, 21._r8, 23._r8/) + ierr_t = 1 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr) + call check_results + + testname = '2-d lookup table with _FillValue resulting in valid_entries false somewhere, invalid_okay' + ! Note: this test reuses some setup from the previous test + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, invalid_okay=.true.) + call check_results + deallocate(index1, index2, data, data_t) + + testname = '3-d lookup table with no _FillValue; nodata in index arrays' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 2) + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + call check_results + deallocate(index1, index2, data, data_t, extra_dims) + + testname = '4-d lookup table' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup4d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 2 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 4) + extra_dims(2) = dim_slice_type('dim4', 5) + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + data_t = (/1145., 2245., 1245., 2145., 2345./) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims) + call check_results + deallocate(index1, index2, data, data_t, extra_dims) + + ! The following tests should result in the code aborting with an error message. + ! + ! We don't usually want to run these tests, because they result in the code + ! aborting, but we may want to run them occasionally to make sure this + ! error-handling is working correctly. + + if (test_abort1) then + testname = '2-d lookup table with incorrect dimname for dimension 2' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup2d' + invalid_lookup = .true. + dimname1 = 'dim1' + dimname2 = 'bad2' ! this differs from the value in the file + n_extra_dims = 0 + index1 = (/1,2,1,2,2/) + index2 = (/1,2,2,1,3/) + fill_val = -1. + ! Note that the third value is fill_val because lookup2d(1,2) is missing (i.e., + ! equal to the _FillVal in the netcdf file) + data_t = (/11._r8, 22._r8, fill_val, 21._r8, 23._r8/) + ierr_t = 1 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr) + deallocate(index1, index2, data, data_t) + end if + + if (test_abort2) then + testname = '3-d lookup table with incorrect dimname for dimension 3' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('bad3', 2) ! this name differs from the value in the file + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + deallocate(index1, index2, data, data_t, extra_dims) + end if + + if (test_abort3) then + testname = '3-d lookup table, trying to access too large index for dimension 3' + allocate(index1(5), index2(5), data(5), data_t(5)) + tablename = 'lookup3d' + invalid_lookup = .false. + dimname1 = 'dim1' + dimname2 = 'dim2' + n_extra_dims = 1 + allocate(extra_dims(n_extra_dims)) + extra_dims(1) = dim_slice_type('dim3', 5) ! this index is out of bounds + nodata = -999 + index1 = (/nodata,2,1,2,2/) + index2 = (/1,2,2,1,nodata/) + fill_val = -1. + data_t = (/fill_val, 222._r8, 122._r8, 212._r8, fill_val/) + ierr_t = 0 + call lookup_2d_netcdf(ncid, tablename, invalid_lookup, dimname1, dimname2, & + n_extra_dims, index1, index2, fill_val, data, ierr, extra_dims=extra_dims, & + nodata=nodata) + deallocate(index1, index2, data, data_t, extra_dims) + end if + + call check_ret(nf_close(ncid), subname) + + contains + subroutine check_results + call test_is(data, data_t, modname//' -- '//subname//' -- '//trim(testname)//' -- data') + call test_is(ierr, ierr_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ierr') + end subroutine check_results + + end subroutine test_lookup_2d_netcdf +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_which_max + + implicit none + + real(r8), dimension(:), allocatable :: arr + + character(len=128) :: testname + + real(r8) :: maxval, maxval_t + integer :: maxindex, maxindex_t + + character(len=*), parameter :: subname = 'test_which_max' + + + testname = 'length-1 array' + allocate(arr(1)) + arr = (/3.0/) + maxval_t = 3.0 + maxindex_t = 1 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max @ 1' + allocate(arr(5)) + arr = (/5.0, 2.0, 3.0, 2.5, 1.5/) + maxval_t = 5.0 + maxindex_t = 1 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max in middle' + allocate(arr(5)) + arr = (/1.0, 2.0, 3.0, 2.5, 1.5/) + maxval_t = 3.0 + maxindex_t = 3 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max at end' + allocate(arr(5)) + arr = (/1.0, 2.0, 3.0, 2.5, 8.0/) + maxval_t = 8.0 + maxindex_t = 5 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'multiple tied max values' + allocate(arr(5)) + arr = (/1.0, 3.0, 3.0, 2.5, 1.5/) + maxval_t = 3.0 + maxindex_t = 2 + call which_max(arr, maxval, maxindex) + call check_results + deallocate(arr) + + testname = 'max in middle, with lbound present' + allocate(arr(3:7)) + arr = (/1.0, 3.0, 10.0, 2.5, 8.0/) + maxval_t = 10.0 + maxindex_t = 5 + call which_max(arr, maxval, maxindex, lbound=3) + call check_results + deallocate(arr) + + contains + subroutine check_results + call test_is(maxval, maxval_t, modname//' -- '//subname//' -- '//trim(testname)//' -- maxval') + call test_is(maxindex, maxindex_t, modname//' -- '//subname//' -- '//trim(testname)//' -- maxindex') + end subroutine check_results + + end subroutine test_which_max +!------------------------------------------------------------------------------ + +end module test_mkindexmapMod + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 new file mode 100644 index 0000000000..e427531da6 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkncdio.F90 @@ -0,0 +1,55 @@ +module test_mkncdio +! Module for testing mkncdio + + use mkncdio + use test_mod + + implicit none + private + + public :: test_get_dim_lengths + + character(len=*), parameter :: modname = 'test_mkncdio' + +contains + +!------------------------------------------------------------------------------ + subroutine test_get_dim_lengths + + implicit none + + character(len=128) :: testname + integer :: ncid + character(len=128) :: varname + integer :: ndims, ndims_t + integer :: dim_lengths(nf_max_var_dims), dim_lengths_t(nf_max_var_dims) + + character(len=*), parameter :: filename = 'unit_testers/inputs/test_lookup_2d_netcdf.nc' + + character(len=*), parameter :: subname = 'test_get_dim_lengths' + + ! Open netcdf file that will be used for most tests + call check_ret(nf_open(filename, 0, ncid), subname) + + testname = '3d variable' + varname = 'lookup3d' + ndims_t = 3 + dim_lengths_t = 0 + dim_lengths_t(1) = 2 + dim_lengths_t(2) = 3 + dim_lengths_t(3) = 4 + call get_dim_lengths(ncid, varname, ndims, dim_lengths) + call check_results + + call check_ret(nf_close(ncid), subname) + + contains + subroutine check_results + call test_is(ndims, ndims_t, modname//' -- '//subname//' -- '//trim(testname)//' -- ndims') + call test_is(dim_lengths(1:ndims), dim_lengths_t(1:ndims_t), & + modname//' -- '//subname//' -- '//trim(testname)//' -- dim_lengths') + end subroutine check_results + + end subroutine test_get_dim_lengths + +end module test_mkncdio diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 new file mode 100644 index 0000000000..1e72d515e5 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mksurfdata_map.F90 @@ -0,0 +1,46 @@ +! Run unit tests for mksurfdata_map +program mksurfdata_map_unit_tester + use test_mkdomainMod + use test_mkutilsMod + use test_mkgridmapMod + use test_mkindexmapMod + use test_mkchecksMod + use test_mkurbanparMod + use test_mkncdio + use test_mod, only : test_init, test_final + + call test_init + + ! Test mkdomainMod + call test_domain_read_dims + + ! Test mkutilsMod + call test_slightly_below + call test_slightly_above + + ! Test mkgridmapMod + call test_gridmap_areaave_default + call test_gridmap_areaave_srcmask + call test_gridmap_areaave_srcmask2 + call test_gridmap_areastddev + + ! Test mkindexmapMod + call test_get_dominant_indices + call test_filter_same + call test_lookup_2d + call test_lookup_2d_netcdf + call test_which_max + + ! Test mkchecksMod + call test_min_bad + call test_max_bad + + ! Test mkurbanparMod + call test_normalize_urbn_by_tot + + ! Test mkncdio + call test_get_dim_lengths + + call test_final + +end program mksurfdata_map_unit_tester diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkurbanparMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkurbanparMod.F90 new file mode 100644 index 0000000000..30168eb97c --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkurbanparMod.F90 @@ -0,0 +1,75 @@ +module test_mkurbanparMod +! Module for testing mkurbanparMod + + use mkurbanparMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_normalize_urbn_by_tot + + character(len=*), parameter :: modname = 'test_mkurbanparMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_normalize_urbn_by_tot + + use mkutilsMod, only : normalize_classes_by_gcell + + implicit none + + character(len=128) :: testname + + real(r8), allocatable :: classes_pct_gcell_t(:,:) + real(r8), allocatable :: classes_pct_gcell(:,:) + real(r8), allocatable :: classes_pct_tot(:,:) + real(r8), allocatable :: sums(:) + + integer :: n,nmax,nclass,totsize + + real(r8), parameter :: eps = 1.e-13_r8 + + character(len=*), parameter :: subname = 'test_normalize_urbn_by_tot' + + + ! This test does a basic check of both normalize_urbn_by_tot and + ! normalize_classes_by_gcell, by ensuring that when the two are called in + ! succession, the result is the same as the initial values + ! (Note that it doesn't directly check the intermediate values -- i.e. the output + ! produced by normalize_urbn_by_tot) + testname = 'normalize_urbn_by_tot then normalize_classes_by_gcell' + nmax = 7 + nclass = 3 + totsize = nmax*nclass + allocate(classes_pct_gcell_t(nmax,nclass), & + classes_pct_gcell (nmax,nclass), & + classes_pct_tot (nmax,nclass), & + sums (nmax)) + + ! The following values are designed to test a number of things, including summing + ! to 100, summing to 0, some values 0 for a given n, and no values being 0 for a + ! given n + classes_pct_gcell_t(:,1) = (/ 0., 5., 0., 0., 10., 0., 10./) + classes_pct_gcell_t(:,2) = (/ 0., 0., 0., 100., 30., 15., 50./) + classes_pct_gcell_t(:,3) = (/100., 30., 0., 0., 20., 0., 40./) + + do n = 1, nmax + sums(n) = sum(classes_pct_gcell_t(n,:)) + end do + + call normalize_urbn_by_tot(classes_pct_gcell_t, sums, classes_pct_tot) + call normalize_classes_by_gcell(classes_pct_tot, sums, classes_pct_gcell) + call test_close(reshape(classes_pct_gcell, (/totsize/)), & + reshape(classes_pct_gcell_t, (/totsize/)), & + eps, modname//' -- '//subname//' -- '//trim(testname), rel_diff=.true.) + + deallocate(classes_pct_gcell_t, classes_pct_gcell, classes_pct_tot, sums) + + + end subroutine test_normalize_urbn_by_tot +!------------------------------------------------------------------------------ + +end module test_mkurbanparMod diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 new file mode 100644 index 0000000000..53b5b1b8c3 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mkutilsMod.F90 @@ -0,0 +1,112 @@ +module test_mkutilsMod +! Module for testing mkutilsMod + + use mkutilsMod + use test_mod + use shr_kind_mod, only : r8 => shr_kind_r8 + + implicit none + private + + public :: test_slightly_below + public :: test_slightly_above + + character(len=*), parameter :: modname = 'test_mkutilsMod' + +contains + +!------------------------------------------------------------------------------ + subroutine test_slightly_below + + implicit none + + character(len=128) :: testname + + logical :: retval + real(r8) :: a + real(r8) :: b + + character(len=*), parameter :: subname = 'test_slightly_below' + + testname='basic-true' + b = 3.0 + a = 3.0 - b*epsilon(b) + retval = slightly_below(a,b) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='far below' + b = 3.0 + a = 2.0 + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='equal' + b = 3.0 + a = 3.0 + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='above' + b = 3.0 + a = 3.0 + epsilon(b) + retval = slightly_below(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='change epsilon to allow far below' + b = 3.0 + a = 2.0 + retval = slightly_below(a,b,eps=0.75_r8) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_slightly_below +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ + subroutine test_slightly_above + + implicit none + + character(len=128) :: testname + + logical :: retval + real(r8) :: a + real(r8) :: b + + character(len=*), parameter :: subname = 'test_slightly_above' + + testname='basic-true' + b = 3.0 + a = 3.0 + b*epsilon(b) + retval = slightly_above(a,b) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='far above' + b = 3.0 + a = 4.0 + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='equal' + b = 3.0 + a = 3.0 + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='below' + b = 3.0 + a = 3.0 - epsilon(b) + retval = slightly_above(a,b) + call test_is((retval .eqv. .false.), modname//' -- '//subname//' -- '//trim(testname)) + + testname='change epsilon to allow far above' + b = 3.0 + a = 4.0 + retval = slightly_above(a,b,eps=0.75_r8) + call test_is((retval .eqv. .true.), modname//' -- '//subname//' -- '//trim(testname)) + + end subroutine test_slightly_above +!------------------------------------------------------------------------------ + +end module test_mkutilsMod + + diff --git a/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mod.F90 b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mod.F90 new file mode 100644 index 0000000000..967eee1c89 --- /dev/null +++ b/components/clm/tools/clm4_5/mksurfdata_map/unit_testers/test_mod.F90 @@ -0,0 +1,339 @@ +module test_mod + +use shr_kind_mod, only : SHR_KIND_R8 +use shr_sys_mod, only : shr_sys_abort + +implicit none + +public test_init +public test_is +public test_close +public test_final + +integer, save :: ntests = 0 +integer, save :: npass = 0 +integer, save :: num_expected = 0 +logical, save :: num_expected_given = .false. +character(*), parameter :: formatTest = '(A4, " ", i5.5, " - ", A)' +character(*), parameter :: formatArrayMatch = & + '(" (all ", i5, " values match)")' +character(*), parameter :: formatArray2DMatch = & + '(" (all ", i5, "x", i5, " values match)")' +character(*), parameter :: formatArrayMisMatch = & + '(" (only ", i5, " values of ", i5, " values match)")' +character(*), parameter :: formatArray2DMisMatch = & + '(" (only ", i5, " values of ", i5, "x", i5, " values match)")' +character(*), parameter :: formatRArrayClose = & + '(" (all ", i5, " values are within", 1pe9.1e2, " )")' +character(*), parameter :: formatRArrayNotClose = & + '(" (only ", i5, " values of ", i5, " values are within", 1pe9.1e2, " max diff= ", 1pe9.1e2, ")")' +character(*), parameter :: formatRClose = & + '(" ( value within", 1pe9.1e2, " )")' +character(*), parameter :: formatRNotClose = & + '(" ( value within", 1pe9.1e2, " diff= ", 1pe9.1e2, ")")' + +interface test_is + module procedure test_is_logical + module procedure test_is_logical1D + module procedure test_is_string + module procedure test_is_integer + module procedure test_is_integer1D + module procedure test_is_real1D + module procedure test_is_real2D + module procedure test_is_realScalar +end interface test_is + +interface test_close + module procedure test_close_real1D + module procedure test_close_realScalar +end interface test_close + +private test_is_logical +private test_is_string +private test_is_integer +private test_is_integer1D +private test_is_real1D +private test_is_realScalar +private test_close_real1D + +contains + + +subroutine test_init( num_expected_tests ) + integer, intent(IN), optional :: num_expected_tests + + if ( present(num_expected_tests) ) then + num_expected = num_expected_tests + num_expected_given = .true. + write(*,formatTest) "1...", num_expected, "expected tests" + write(*,*) + end if + +end subroutine test_init + +subroutine test_is_logical( pass, description ) + + implicit none + + logical, intent(IN) :: pass ! If matches or not + character(*), intent(IN) :: description ! description of test + + character(4) :: status + + ntests = ntests + 1 + if ( pass )then + npass = npass + 1 + status = "PASS" + else + status = "FAIL" + end if + write(*,formatTest) status, ntests, trim(description) + +end subroutine test_is_logical + +subroutine test_is_logical1D( value, expected, description ) + + implicit none + + logical, intent(IN) :: value(:) ! test value + logical, intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value .eqv. expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value .eqv. expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_logical1D + + +subroutine test_is_string( value, expected, description ) + + implicit none + + character(len=*), intent(IN) :: value + character(len=*), intent(IN) :: expected + character(len=*), intent(IN) :: description ! description of test + + + logical :: pass ! If matches or not + + character(4) :: status + + if ( trim(value) == trim(expected) )then + pass = .true. + else + pass = .false. + end if + ntests = ntests + 1 + if ( pass )then + npass = npass + 1 + status = "PASS" + else + status = "FAIL" + end if + write(*,formatTest) status, ntests, trim(description) + +end subroutine test_is_string + +subroutine test_is_integer( value, expected, description ) + integer, intent(IN) :: value ! test value + integer, intent(IN) :: expected ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + + if ( value == expected )then + pass = .true. + else + pass = .false. + end if + call test_is_logical( pass, description ) + +end subroutine test_is_integer + +subroutine test_is_integer1D( value, expected, description ) + integer, intent(IN) :: value(:) ! test value + integer, intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value == expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_integer1D + +subroutine test_is_real1D( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value(:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize, nmatch + character(256) :: descrip + + nsize = size(value) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArrayMatch) nsize + else + nmatch = count(value == expected) + write(descrip,formatArrayMisMatch) nmatch, nsize + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_real1D + +subroutine test_is_real2D( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value(:,:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:,:) ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + integer :: nsize1, nsize2, nmatch + character(256) :: descrip + + nsize1 = size(value,1) + nsize2 = size(value,2) + if ( all(value == expected) )then + pass = .true. + write(descrip,formatArray2DMatch) nsize1, nsize2 + else + nmatch = count(value == expected) + write(descrip,formatArray2DMisMatch) nmatch, nsize1, nsize2 + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_is_real2D + +subroutine test_is_realScalar( value, expected, description ) + real(SHR_KIND_R8), intent(IN) :: value ! test value + real(SHR_KIND_R8), intent(IN) :: expected ! expected value + character(*), intent(IN) :: description ! description of test + + logical :: pass + + if ( value == expected )then + pass = .true. + else + pass = .false. + end if + call test_is_logical( pass, description ) + +end subroutine test_is_realScalar + +subroutine test_close_real1D( value, expected, eps, description, rel_diff ) + real(SHR_KIND_R8), intent(IN) :: value(:) ! test value + real(SHR_KIND_R8), intent(IN) :: expected(:) ! expected value + real(SHR_KIND_R8), intent(IN) :: eps ! epsilon -- how close to be within + character(*), intent(IN) :: description ! description of test + logical, optional, intent(IN) :: rel_diff ! if should do relative difference or not + + logical :: pass, lreldiff + integer :: nsize, nmatch, i, n0(1), nf(1) + real(SHR_KIND_R8) :: within, diff + character(256) :: descrip + + lreldiff = .false. + if ( present(rel_diff) ) lreldiff = rel_diff + nsize = size(value) + if ( nsize /= size(expected) )then + call shr_sys_abort( "size of value and expected array is different" ) + end if + if ( any(lbound(value) /= lbound(expected)) )then + call shr_sys_abort( "lower bound of value and expected array is different" ) + end if + nmatch = 0 + n0 = lbound(value) + nf = ubound(value) + within = abs(value(n0(1)) - expected(n0(1))) + if ( lreldiff .and. within > 0.0_SHR_KIND_R8 ) within = within / max( abs(value(n0(1))), abs(expected(n0(1))) ) + do i = n0(1), nf(1) + diff = abs(value(i) - expected(i)) + if ( lreldiff .and. diff > 0.0_SHR_KIND_R8 ) diff = diff / max(abs(value(i)),abs(expected(i)) ) + within = max( within, diff ) + if ( diff <= eps ) nmatch = nmatch + 1 + end do + if( nmatch == nsize )then + write(descrip,formatRArrayClose) nsize, eps + pass = .true. + else + write(descrip,formatRArrayNotClose) nmatch, nsize, eps, within + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_close_real1D + +subroutine test_close_realScalar( value, expected, eps, description ) + real(SHR_KIND_R8), intent(IN) :: value ! test value + real(SHR_KIND_R8), intent(IN) :: expected ! expected value + real(SHR_KIND_R8), intent(IN) :: eps ! epsilon -- how close to be within + character(*), intent(IN) :: description ! description of test + + logical :: pass + real(SHR_KIND_R8) :: diff + character(256) :: descrip + + diff = abs(value - expected) + if ( diff <= eps ) then + write(descrip,formatRClose) eps + pass = .true. + else + write(descrip,formatRNotClose) eps, diff + pass = .false. + end if + call test_is_logical( pass, trim(description)//trim(descrip) ) + +end subroutine test_close_realScalar + +subroutine test_final( PassStatus ) + + logical, intent(OUT), optional :: PassStatus + + character(4) :: status + character(50) :: desc + + write(*,*) + status = "PASS" + if ( present(PassStatus) ) PassStatus = .true. + desc = "All expected tests ran successfully" + if ( num_expected_given .and. ntests /= num_expected )then + status = "FAIL" + desc = "Different number of tests than expected" + if ( present(PassStatus) ) PassStatus = .false. + end if + if ( npass /= ntests )then + status = "FAIL" + if ( present(PassStatus) ) PassStatus = .false. + write(desc,'(A,i3,A)') "Not all tests passed (", & + ntests-npass, " tests failed)" + end if + write(*,formatTest) status, ntests, "tests run -- "//desc + +end subroutine test_final + +end module test_mod diff --git a/components/clm/tools/clm4_5/refactorTools/associate/README b/components/clm/tools/clm4_5/refactorTools/associate/README new file mode 100644 index 0000000000..5f0c335540 --- /dev/null +++ b/components/clm/tools/clm4_5/refactorTools/associate/README @@ -0,0 +1,108 @@ +README for refactoring the use of associate. +PERTAINS to: refactor_new.pl +CWD: components/clm/tools/clm4_5/refactorTools/associate + +Contents: + +I) What happened in clm4_5_15 +II) suggestions for how to merge your current sandbox up to trunk +III) hand modifications + +================================================================= + +I) What happened in clm4_5_15 + +Removed pointer declarations and move existing pointer assignements inside +of new associate blocks. A portion of the diffs from biogeophys/FracWetMod.F90 +below show the refactor applied. + +- real(r8), pointer :: h2ocan(:) ! total canopy water (mm H2O) +-! +-! local pointers to implicit out arguments +-! +- real(r8), pointer :: fwet(:) ! fraction of canopy that is wet (0 to 1) +- real(r8), pointer :: fdry(:) ! fraction of foliage that is green and dry [-] (new) +-! +-! +-! !OTHER LOCAL VARIABLES: + !EOP + ! + integer :: fp,p ! indices +@@ -80,15 +64,16 @@ + real(r8) :: dewmxi ! inverse of maximum allowed dew [1/mm] + !----------------------------------------------------------------------- + +- ! Assign local pointers to derived subtypes components (pft-level) + +- frac_veg_nosno => pps%frac_veg_nosno +- dewmx => pps%dewmx +- elai => pps%elai +- esai => pps%esai +- h2ocan => pws%h2ocan +- fwet => pps%fwet +- fdry => pps%fdry ++ associate(& ++ frac_veg_nosno => pps%frac_veg_nosno , & ! Input: [integer (:)] fraction of veg not covered by snow (0/1 now) [-] ++ dewmx => pps%dewmx , & ! Input: [real(r8) (:)] Maximum allowed dew [mm] ++ elai => pps%elai , & ! Input: [real(r8) (:)] one-sided leaf area index with burying by snow ++ esai => pps%esai , & ! Input: [real(r8) (:)] one-sided stem area index with burying by snow ++ h2ocan => pws%h2ocan , & ! Input: [real(r8) (:)] total canopy water (mm H2O) ++ fwet => pps%fwet , & ! Output: [real(r8) (:)] fraction of canopy that is wet (0 to 1) ++ fdry => pps%fdry & ! Output: [real(r8) (:)] fraction of foliage that is green and dry [-] (new) ++ ) + + ! Compute fraction of canopy that is wet and dry + +@@ -114,6 +99,7 @@ + end if + end do + +- end subroutine FracWet ++ end associate ++ end subroutine FracWet + +In order to convert code in a semi-automated way, we used a script, refactor_new.pl which parses a given +piece of source code and does this conversion automatically. There were many areas where we had to +modify code by hand. These hand modifications are listed in section III. + +Once this was complete, testing ran as expected. + +II) suggestions for how to merge your current sandbox up to trunk + +NOTE: The associate modifications are BFB. Any changes you may see are due to your code modifications. + +This is a work in progress and we will have to see how the process evolves in merging old with new code. I recommend +checking any file by hand using a tool that allows you to view two files with visual delineation of code mods (gvimdiff, +eclipse, etc...) + + - Ideally, make your branch and branch-tags from at least clm4_5_15. If you have a sandbox based on + an older trunk-tag you will have to merge in the changes yourself. If you have to do this: + 1) Update branch to clm4_5_10 and run test suite. Use components/clm/tools/clm4_5/refactorTools/clmType/README as a guide + the refactor_new.pl script we provide and try to apply the refactoring in a semi-automated way. + 2) Update to clm4_5_14 and run test suite. clm4_5_14 is a prepatory step to the clm4_5_15 refactor. + 3) Update to clm4_5_15 and run test suite. There are many ways to approach this, among them... + a) Use refactorAssociate.pl on your branch before you update to 4_5_15 + b) Apply the associate refactor manually then merge in 4_5_15 + c) merge in 4_5_15, then resolve your conflicts + +III) Some rough notes as to the hand-modifications that you may encounter. + + - CNDcompCascadeMod_BGC.F90 doesn't have associate and 'end associate stuff + - CNDecompCascadeMod_BGC - add real(r8), allocatable:: fr(:,:) + - remove c13 check in clm_atmlnd.F90 so that clm_a2l%forc_pc13o2 is initialized + - put in ifdef LCH4 for biogeophys/CanopyFluxesMod.F90 for grnd_ch4_cond and canopy_cond + - put in ifdef CH for rc13_* variables. make other mods for rc14_* variables + - mods in biogeophys/SLakeTemperatureMod.F90 for LCH4 ifdef + - mods in biogeophys/SoilHydrologyMod.F90 for VIC pointer b_infil, max_moist + - mods in biogeochem/CNMRespMod.F90 -- grainn, take out croplive + - mods in CNAllocationMod.F90 - put back in #ifndef NITRIF_DENITRIF in associate statement + - move gddmaturity,huileaf out of crop_prog check in clmtypeInitMod.F90 - actually many mods here. lots of stuff that had to be moved out of the prog_crop check because pointers were otherwise uninitialized. moved htmx out of crop_prog + - biogeochem/CNNStateupdate1Mod.F90 - put back NITRIF_DENIRIF + - main/clmtypeInitMod.F90 - remove all use_c13 and use_c14. these don't work with conditional assignments when using associate + - biogeochem/CNVegStructUpdateMod.F90 - put back ifdef cndv in associate block + - CNSummaryMod.F90 - add back ifdef CNDV and NITRIF_DENITRIF statement in associate block + - biogeochem/CNAnnualUpdateMod.F90 - putback CNDV in associate block + - biogeochem/CNBalanceCheckMod.F90 - putback CNDV in associate block + - biogeochem/CNDecompMod.F90 - put back CH4 and else part of NITRIF_DENITRIF + - biogeochem/CNNSTateUpdate3Mod.F90 - put back CH4 and else part of NITRIF_DENITRIF + - biogeochem/CNPrecisionControlMod - put back CH4 and else part of NITRIF_DENITRIF diff --git a/components/clm/tools/clm4_5/refactorTools/associate/refactorAssociate.pl b/components/clm/tools/clm4_5/refactorTools/associate/refactorAssociate.pl new file mode 100755 index 0000000000..45cd8c6c2e --- /dev/null +++ b/components/clm/tools/clm4_5/refactorTools/associate/refactorAssociate.pl @@ -0,0 +1,368 @@ +#!/usr/bin/env perl + +use strict; +use Cwd; +use File::Basename; +use Getopt::Long; +use FindBin qw($Bin); +use English; +use IO::File; +use Fcntl; + +my %opts = ( file => undef); +GetOptions( "file=s" => \$opts{'file'}) or die "need to specify file as input"; +my $file = $opts{'file'}; + +#---------------------------------------------------------------------- +# Add input/inout/output comments to pointer declarations +#---------------------------------------------------------------------- + +my $fh = new IO::File; +$fh->open("<$file") or die "** can't open file: $file\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp1") or die "** can't open file: $file.temp1\n"; + +my $select_case = 0; +my $type; +while (my $line = <$fh>) { + chomp $line; + if ($line =~ /.*pointers to .*implicit in /) { + $type = 'Input: '; + } + if ($line =~ /.*pointers to .*implicit in\/out /) { + $type = 'InOut: '; + } + if ($line =~ /.*pointers to .*implicit out /) { + $type = 'Output:'; + } + + if ($line =~ /(.+)(.*,.*pointer.*::.*)(\(:.*\))(.*\!)(.*)/) { + my $irl = $1; + $irl = clean($irl); + print $fhout "$1 $2 $3 $4 $type [$irl $3] $5 \n"; + } elsif ($line =~ /(.+)(.*,.*pointer.*::.*)(\(:.*\))( *$)/) { + my $irl = $1; + $irl = clean($irl); + print $fhout "$1 $2 $3 \! $type [$irl $3] $4\n"; + } elsif ($line =~ /(A|a)ssign local/) { + # do nothing + } else { + print $fhout "$line\n"; + } +} +$fhout->close(); +$fh->close(); + +#---------------------------------------------------------------------- +# Add input/inout/output comments to current pointer associations (=>) +# Output is $file.temp2 +#---------------------------------------------------------------------- + +my $fh = new IO::File; +$fh->open("<$file.temp1") or die "** can't open file: $file.temp1\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp2") or die "** can't open file: $file.temp2\n"; + +my $tell = 0; +my $tellm1 = 0; +my $end_file = 0; +my $is_module = 0; +my $module_name; +while(1) { + seek $fh, $tell, 0; + my %subst = (); + while (my $line = <$fh>) { + if ($line =~ /(^module)(.+)/) { + $is_module = 1; + $module_name = $2; + print "module name is $module_name\n"; + } + if ($line =~ /(.+pointer.*::)(.*)(\!.*\n)/) { + my $var = $2; + my $comment = $3; + $comment = clean($comment); + $var =~ s/\(.*\)//g; + $var = clean($var); + $subst{$var} = $comment; + } + if ($line =~ /end .*subroutine/) { + $tell = tell($fh); + last; + } + } + + seek $fh, $tellm1, 0; + my @vars = keys %subst; + my $select_case = 0; + while (my $line = <$fh>) { + if ($line =~ /(.+pointer.*::)(.*)(\!.*\n)/) { + my $newline = backwards_compatibility ($line, $module_name); + if ($newline) { + print $fhout $newline; + } else { + print $fhout "$line"; + } + } elsif ($line =~ /select case/) { + $select_case = 1; + print $fhout "$line"; + } elsif ($line =~ /end select/) { + $select_case = 0; + print $fhout "$line"; + + } elsif ($line =~ /(.+)(=\>)(.+%.+)/) { + if (!$select_case) { + my $varmatch = $1; + $varmatch = clean($varmatch); + foreach my $var (sort @vars) { + $var = clean($var); + if ($varmatch eq $var) { + my $add = $subst{$var}; + $line = $varmatch . " => $3 , & $add"; + $line =~ s/\n//g; + $line =~ /(.*)(=\>)([^,]*)(\,.+)/; + printf $fhout (" %-35s %-3s %-45s %-80s\n",$1,$2,$3,$4); + } + } + } else { + print $fhout "$line"; + } + } else { + print $fhout "$line"; + } + if ($line =~ /end .*subroutine/) { + if ($is_module) { + $tellm1 = tell($fh); + } else { + $end_file = 1; + } + last; + } + if ($line =~ /end .*module/) { + $end_file = 1; + last; + } + } + if ($end_file) { + last; + } +} + +$fh->close(); +$fhout->close(); + +#------------------------------------------------------------------- +# Read in file - fill in $line[] array - but skip lines that are +# pointer declarations - after "pointers to implicit" and before +# "LOCAL VARIABLE" +# Add associate(& and ) statements around subroutine declarations +# Output file is $file.temp3 +#------------------------------------------------------------------- + +my $fh = new IO::File; +$fh->open("<$file.temp2") or die "** can't open file: $file.temp2\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp3") or die "** can't open file: $file.temp3\n"; + +my @lines; +my $n = 0; +my $old_pointer_block = 0; +seek $fh, 0, 0; +while (my $line = <$fh>) { + if ($line =~ /.*pointers to.+implicit in /) { + $old_pointer_block = 1; + } + if ($line =~ /.*Assign.*pointer.*/) { + # do nothing + } elsif ($line =~ /.*local.*pointers.*to.*/) { + # do nothing + } elsif ($line =~ /OTHER LOCAL/) { + # do nothing + } elsif ($line =~ /^#endif/) { + if ($lines[$n-1] =~ /(.+)(\=\>)(.+%.+)/) { + # do nothing + } else { + $lines[$n] = $line; + $n++; + } + } elsif ($old_pointer_block) { + # Do not add lines in pointer declaration to $line[] array + if ($line !~ /.*pointer.*::.*/) { + $lines[$n] = $line; + $n++; + } + } else { + $lines[$n] = $line; + $n++; + } + if ($line =~ /.*LOCAL +VARIABLE.*/) { + $old_pointer_block = 0; + } +} +my $nsize = scalar(@lines); + +my $associate = 0; +$n = 0; +while ($n <= $nsize) { + my $line = $lines[$n]; + if ($line =~ /(.+)(\=\>)(.+%.+)/) { + if ($lines[$n-1] !~ /.+\=\>.+/) { + $line = " associate(& \n$line"; + $associate = 1; + } + if (($lines[$n+1] !~ /.+\=\>.+/) && + ($lines[$n+2] !~ /.+\=\>.+/) && + ($lines[$n+3] !~ /.+\=\>.+/) && + ($lines[$n+4] !~ /.+\=\>.+/)) { + $line =~ s/(.+), & \!/$1 & \!/g; + $line = $line . " )\n"; + } + } elsif ($line =~ /end *subroutine/ && ($associate)) { + $line = " end associate \n $line"; + $associate = 0; + } + $lines[$n] = $line; + $n = $n + 1; +} + +my $nsize = scalar(@lines); +$n = 0; +while ($n <= $nsize) { + print $fhout $lines[$n]; + $n++; +} +$fhout->close(); + +#---------------------------------------------------------------------- +# Remove non associate statements from associate block declarations +#---------------------------------------------------------------------- + +my $fh = new IO::File; +$fh->open("<$file.temp3") or die "** can't open file: $file.temp3\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp4") or die "** can't open file: $file.temp4\n"; + +my $associate = 0; +while (my $line = <$fh>) { + if ($line =~ /.+associate\(&/) { + if (!$associate) { + print $fhout $line; + } + $associate = 1; + } + if ($associate) { + if ($line =~ /.+=>.+/) { + print $fhout $line; + } + if ($line =~ /^ +\)$/) { + print $fhout $line; + $associate = 0; + } + } else { + print $fhout $line; + } +} +$fhout->close(); + +#---------------------------------------------------------------------- + +my $sysmod = "/bin/rm $file.temp1"; +system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; +my $sysmod = "/bin/rm $file.temp2"; +system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; +my $sysmod = "/bin/rm $file.temp3"; +system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; +my $sysmod = "/bin/mv $file.temp4 $file"; +system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; + +#---------------------------------------------------------------------- + +sub clean +{ + my ($name) = @_; + $name =~ s/^\s+//; # strip any leading whitespace + $name =~ s/\s+$//; # strip any trailing whitespace + return ($name); +} + +sub backwards_compatibility +{ + my ($line, $module_name) = @_; + + my @matches; + $module_name = clean($module_name); + + if ($module_name eq "ch4Mod") { + my @temp= qw(grnd_ch4_cond grnd_ch4_cond_col ch4_prod_depth o2_decomp_depth co2_decomp_depth conc_o2 conc_o2 + conc_ch4 ch4_oxid_depth o2_oxid_depth co2_oxid_depth o2_decomp_depth ch4_aere_depth ch4_tran_depth + o2_aere_depth co2_aere_depth conc_ch4 conc_o2 ch4_oxid_depth ch4_prod_depth ch4_aere_depth ch4_oxid_depth + ch4_ebul_depth ch4_ebul_total conc_ch4 ch4_prod_depth o2_oxid_depth conc_ch4 conc_o2 + ch4_oxid_depth ch4_aere_depth ch4_surf_aere ch4_surf_ebul ch4_ebul_depth ch4_ebul_total ch4_surf_diff + o2_decomp_depth o2_aere_depth co2_decomp_depth o2stress ch4stress); + push(@matches, @temp); + } + + if ($module_name eq 'CanopyFluxesMod') { + my @temp = qw(lai_z par_z vcmaxcint psn_z lmr_z rs_z ci_z psn psn_wc psn_wj psn_wp lmr rs alphapsn alphapsn par_z); + push(@matches, @temp); + } + + + foreach my $match (@matches) { + $match = clean($match); + if ($line =~ /(.+)($match)(.+)(!.*$)/) { + return "$1$2$3 ! needed for backwards compatiblity\n"; + } + if ($line =~ /(.+)($match)/) { + return "$1$2 ! needed for backwards compatiblity\n"; + } + } + + #--------------------------------------------------------- + + @matches = (); + if ($module_name eq 'MEGANFactorsMod') { + @matches = qw(eff comp_factors_table hash_table_indices); + } + if ($module_name eq 'CNAllocationMod') { + @matches = qw(arepr aroot col_plant_ndemand residual_plant_ndemand); + } + if ($module_name eq 'CNPhenologyMod') { + @matches = qw(inhemi); + } + if ($module_name eq 'CNDecompCascadeMod') { + @matches = qw(fr); + } + if ($module_name eq 'CNRestMod') { + @matches = qw(iptemp ptr1d data_r1); + } + if ($module_name eq 'CNDVMod') { + @matches = qw(rbuf2dg); + } + if ($module_name eq 'CNDecompCascadeMod_CENTURY') { + @matches = qw(fr); + } + if ($module_name eq 'CNSummaryMod') { + @matches = qw(gpp col_gppar col_ar rr col_rr npp col_npp vegfire col_vegfire + wood_harvestc col_wood_harvestc totvegc col_totvegc totpftc col_totpftc + pft_fire_closs col_pft_fire_closs litfall col_litfall + hrv_xsmrpool_to_atm col_hrv_xsmrpool_to_atm); + } + if ($module_name eq 'CNSoilLittVertTranspMod') { + @matches = qw(spinup_factor is_cwd altmax altmax_lastyear + som_adv_coef som_diffus_coef conc_ptr source + trcr_tendency_ptr); + } + if ($module_name eq 'clm_varcon') { + @matches = qw(zlak dzlak zsoi dzsoi zisoi dzsoi_decomp nlvic) + } + foreach my $match (@matches) { + $match = clean($match); + if ($line =~ /(.+)(pointer)(.*)($match)/) { + return $line; + } + } +} diff --git a/components/clm/tools/clm4_5/refactorTools/clmType/README b/components/clm/tools/clm4_5/refactorTools/clmType/README new file mode 100644 index 0000000000..4f4e5baef9 --- /dev/null +++ b/components/clm/tools/clm4_5/refactorTools/clmType/README @@ -0,0 +1,75 @@ +README for refactoring the use of clmtype. +PERTAINS to: renameClmType.pl +CWD: components/clm/tools/clm4_5/refactorTools/clmType + +Contents: + +I) What happened in clm4_5_10 +II) suggestions for how to merge your current sandbox up to trunk + +================================================================= + +I) What happened in clm4_5_10 + +Mariana refactored clmtype.F90 and clmtypeInitMod.F90 so that the access of derived type variables is only +one level of indirection deep. + +An example of the type of refactoring is seen here: + + call hist_addfld1d (fname='SNOOCFRCL', units='W/m^2', & + avgflag='A', long_name='surface forcing of OC in snow (land) ', & +- ptr_pft=clm3%g%l%c%p%pef%sfc_frc_oc, set_urb=spval) ++ ptr_pft=pef%sfc_frc_oc, set_urb=spval) + +In order to convert code in a semi-automated way, we used a script, renameClmType.pl which parses a given +piece of source code and does this conversion automatically. There were a few areas where we had to +modify things by hand. After creating a branch from clm4_5_09, I applied the script to my code as follows: + +cd commponents/clm/src +find . -name "*.F90" -exec {addYourPathTo}/renameClmType.pl -file {} \; +find . -name "*.temp1" -exec rm -rf {} \; + +At this point some hand modification was required mostly to fix the "use clmtype" statements as well as a few +other minor fixes that likely won't be encountered again. + +pfttype.F90 +clm_glclnd.F90. +mkarbinitMod.F90 +VOCEmissionMod.F90 +UrbanInitMod.F90 +reweightMod.F90 +clmtypeInitMod +initGridCellsMod.F90 +BiogeophysRestMod.F90 + +Once this was complete, testing ran as expected. + +II) suggestions for how to merge your current sandbox up to trunk + +NOTE: The clmtype modifications themselves are BFB. Any changes you may see are due to your code modifications. + +This is a work in progress and we will have to see how the process evolves in merging old with new code. I recommend +checking any file by hand using a tool that allows you to view two files with visual delineation of code mods (gvimdiff, +eclipse, etc...) + +There are two general categories of modifications: + + 1) if you have modified clmtype.F90 + 2) you didn't modify clmtype.F90 + +for case 1) + + - manually edit clmtype.F90 and clmtypeInitMod.F90 and make sure your additons are in line with the new scheme. + - run the renameClmType.pl script on your code + - merge this sandbox up to trunk and resolve differences by hand. be careful in this step and don't trust svn to + get everything correct. + - run tests as usual + +for case 2) + + - run the renameClmType.pl script on your code + - merge this sandbox up to trunk and resolve differences by hand. be careful in this step and don't trust svn to + get everything correct. + - run tests as usual + + diff --git a/components/clm/tools/clm4_5/refactorTools/clmType/renameClmType.pl b/components/clm/tools/clm4_5/refactorTools/clmType/renameClmType.pl new file mode 100755 index 0000000000..af10acbbdb --- /dev/null +++ b/components/clm/tools/clm4_5/refactorTools/clmType/renameClmType.pl @@ -0,0 +1,231 @@ +#!/usr/bin/env perl + +# +# script that will flatten pft type +# + +use strict; +use Cwd; +use File::Basename; +use Getopt::Long; +use FindBin qw($Bin); +use English; +use IO::File; + +my %opts = ( file => undef); +GetOptions( "file=s" => \$opts{'file'}) or die "need to specify file as input"; +my $file = $opts{'file'}; + +my $fh = new IO::File; +$fh->open("<$file") or die "** can't open file: $file\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp1") or die "** can't open file: $file.temp1\n"; + +my %subst = (); +while (my $line = <$fh>) { + + if ($line =~ /p%active/) { + $line =~ s/p%active/pft%active/g; + } + if ($line =~ /pactive.*[^:]/) { + $line =~ s/ active/pft%active/; + } + if ($line =~ /c%active/) { + $line =~ s/c%active/col%active/g; + } + if ($line =~ /cactive/) { + $line =~ s/\sactive/col%active/g; + } + + # -------------------------------------------------------- + if ($line =~ /\bp\b *=\>(.+)/) { + $line =~ s/$1/ pft/; + } + if ($line =~ /\bc\b *=\>(.+)/) { + $line =~ s/$1/ col/; + } + if ($line =~ /\bl\b *=\>(.+)/) { + $line =~ s/$1/ lun/; + } + if ($line =~ /\bg\b *=\>(.+)/) { + $line =~ s/$1/ grc/; + } + + # -------------------------------------------------------- + # substitute pptr => clm3%g%l%c%p with pptr => pft + # -------------------------------------------------------- + if ($line =~ / pptr *=\>(.+)/) { + $line =~ s/$1/ pft/; + } + if ($line =~ / cptr *=\>(.+)/) { + $line =~ s/$1/ col/; + } + if ($line =~ / lptr *=\>(.+)/) { + $line =~ s/$1/ lun/; + } + if ($line =~ / gptr *=\>(.+)/) { + $line =~ s/$1/ grc/; + } + + # -------------------------------------------------------- + # special clm3% substitution before general clm3% subst + # -------------------------------------------------------- + $line =~ s/clm3%g%l%itype/lun%itype/g; + $line =~ s/clm3%g%l%c%itype/col%itype/g; + + # ----------------------------------------- + # substitute clm3%g%l%c%p%TYPE% to TYPE% + # ----------------------------------------- + if ($line =~ /clm3%g%l%c%p%.+%/) { + $line =~ s/clm3%g%l%c%p%//g; + } + if ($line =~ /clm3%g%l%c%.+%/) { + $line =~ s/clm3%g%l%c%//g; + } + if ($line =~ /clm3%g%l%.+%/) { + $line =~ s/clm3%g%l%//g; + } + if ($line =~ /clm3%g%.+%/) { + $line =~ s/clm3%g%//g; + } + + # ----------------------------------------- + # substitute clm3%g%l%c%p%TYPE to pft%TYPE + # ----------------------------------------- + if ($line =~ /clm3%g%l%c%p%.+[^%]/) { + $line =~ s/clm3%g%l%c%p%/ pft%/g; + } + if ($line =~ /clm3%g%l%c%.+[^%]/) { + $line =~ s/clm3%g%l%c%/ col%/g; + } + if ($line =~ /clm3%g%l%.+[^%]/) { + $line =~ s/clm3%g%l%/ lun%/g; + } + if ($line =~ /clm3%g%.+[^%]/) { + $line =~ s/clm3%g%/ grc%/g; + } + + # ----------------------------------------- + if ($line =~ /\b(g%).+%/) { + $line =~ s/$1//g; + } + if ($line =~ /\b(l%).+%/) { + $line =~ s/$1//g; + } + if ($line =~ /\b(c%).+%/) { + $line =~ s/$1//g; + } + if ($line =~ /\b(p%).+%/) { + $line =~ s/$1//g; + } + + # ----------------------------------------- + $line =~ s/ p%(.+)/pft%$1/g; + $line =~ s/ c%(.+)/col%$1/g; + $line =~ s/ l%(.+)/lun%$1/g; + $line =~ s/ g%(.+)/grc%$1/g; + + # -------------------------------------------------------- + # substitution for (p% => (pft% + # -------------------------------------------------------- + $line =~ s/([^a-zA-Z0-9_])p%/$1pft%/; + $line =~ s/([^a-zA-Z0-9_])c%/$1col%/; + $line =~ s/([^a-zA-Z0-9_])l%/$1lun%/; + $line =~ s/([^a-zA-Z0-9_])g%/$1grc%/; + + # -------------------------------------------------------- + # another special substitution + # -------------------------------------------------------- + if ($line =~ /call *CNSet/){ + $line =~ s/pft%/ /; + $line =~ s/col%/ /; + $line =~ s/lun%/ /; + $line =~ s/grc%/ /; + } + + # ----------------------------------------- + # substitute ccf%pcf_a to pcf_a example + # ----------------------------------------- + $line =~ s/cc13f%pcf_a/pc13f_a/g; + $line =~ s/cc14f%pcf_a/pc14f_a/g; + + $line =~ s/..f%p(.)f_a/p$1f_a/g; + $line =~ s/..s%p(.)s_a/p$1s_a/g; + + # ---------------------------------------- + $line =~ s/pptr%(p[a-zA-Z0-9_]+%)/$1/g; + $line =~ s/cptr%(c[a-zA-Z0-9_]+%)/$1/g; + $line =~ s/lptr%(l[a-zA-Z0-9_]+%)/$1/g; + $line =~ s/gptr%(g[a-zA-Z0-9_]+%)/$1/g; + + print $fhout "$line"; +} + +$fh->close(); +$fhout->close(); + +my $sysmod = "/bin/mv $file.temp1 $file"; +system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; + +# ========================================================================= + +my $fh = new IO::File; +$fh->open("<$file") or die "** can't open file: $file\n"; + +my $fhout = new IO::File; +$fhout->open(">$file.temp1") or die "** can't open file: $file.temp1\n"; + +my $lmax1 = 0; +my $lmax2 = 0; +my $lmax3 = 3; +while (my $line = <$fh>) { + chomp $line; + if ($line =~ /(.*)(=\>)([^,]*)([, ] [\& ].*\!.+)/ ) { + my $var1 = $1; + my $var2 = $3; + my $var3 = $4; + $var1 =~ s/\s+$//g; + $var2 =~ s/\s+$//g; + $var3 =~ s/\s+$//g; + $var1 =~ s/^\s+//; #remove leading spaces + $var2 =~ s/^\s+//; #remove leading spaces + $var3 =~ s/^\s+//; #remove leading spaces + my $lvar1 = length($var1); + my $lvar2 = length($var2); + my $lvar3 = length($var3); + $lmax1 = ($lvar1 > $lmax1) ? $lvar1 : $lmax1; + $lmax2 = ($lvar2 > $lmax2) ? $lvar2 : $lmax2; + $lmax3 = ($lvar3 > $lmax3) ? $lvar3 : $lmax3; + } +} +my $max = $lmax1 + $lmax2 + $lmax3; +print " lmax1,lmax2,lmax3 are $lmax1,$lmax2,$lmax3 \n"; + +if ($lmax1 > 0 && $lmax2 > 0) { + seek $fh, 0, 0; + while (my $line = <$fh>) { + chomp $line; + if ($line =~ /(.*)(=\>)([^,]*)([, ] \& \!.+)/) { + my $var1 = $1; + my $arrow = $2; + my $var2 = $3; + my $var3 = $4; + $var1 =~ s/\s+$//g; + $var2 =~ s/\s+$//g; + $var3 =~ s/\s+$//g; + $var1 =~ s/^\s+//; #remove leading spaces + $var2 =~ s/^\s+//; #remove leading spaces + $var3 =~ s/^\s+//; #remove leading spaces + my $format = " %-${lmax1}s %-3s %-${lmax2}s %-${lmax3}s\n"; + printf $fhout ($format,$var1,$arrow,$var2,$var3); + } else { + print $fhout "$line\n"; + } + } + my $sysmod = "/bin/mv $file.temp1 $file"; + system($sysmod) == 0 or die "ERROR: $sysmod failed: $?\n"; +} + +$fh->close(); +$fhout->close(); diff --git a/components/clm/tools/shared/PTCLM/ChangeLog b/components/clm/tools/shared/PTCLM/ChangeLog new file mode 100644 index 0000000000..14a42037b3 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/ChangeLog @@ -0,0 +1,678 @@ +================================================================================ +This file describes changes made to the PTCLM tool +================================================================================ + +================================================================================ +Originator: erik +Date: Aug/26/2015 +Tag: PTCLM2_150826 +One-line: Allow for pft??_ in surface dataset filename +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r119 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +In clm4_5_1_r108, surface datasets change standard filenames to include the +PFT number. So PTCLMmkdata would no longer work for clm4_5. Add a wildcard for +the pft number, so both clm4_0 and clm4_5 will now work. + +Move goldbach to hobart. + +M buildtools +M PTCLMmkdata +M test/compdirs/*/* + +================================================================================ +Originator: erik +Date: Apr/14/2015 +Tag: PTCLM2_150414 +One-line: Send in cimeroot to buildtools +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r105 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +M buildtools + +================================================================================ +Originator: erik +Date: Apr/13/2015 +Tag: PTCLM2_150413 +One-line: Change output filenames of xmlchange_cmnds to shell_commands +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r105 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +R test/compdirs/*/xmlchange_cmnds +A test/compdirs/*/shell_commands +M test/compdirs/*/* +M test/PTCLMtestlist.py +M PTCLMmkdata + +================================================================================ +Originator: erik +Date: Apr/10/2015 +Tag: PTCLM2_150410 +One-line: Update to new cime directory structure +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r105 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +Change the relative paths to the new cime directory structure where clm +source and tools are under components, and CESM scripts are under +cime/scripts. + + M PTCLMmkdata + M mydatafiles/1x1pt_US-UMB/xmlchange_cmnds + M mydatafiles/1x1pt_US-UMB/README.PTCLM + M mydatafiles/1x1pt_US-UMB/user_nl_clm + M KnownBugs + M README + M test/PTCLMtesting_prog.py + M test/listings/help + M test/listings/list + M test/listings/sitelist + M test/compdirs/* + M test/PTCLMtestlist.py + M buildtools + +================================================================================ +Originator: erik +Date: Jan/26/2015 +Tag: PTCLM2_150126 +One-line: Update test comparison and listings +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r104 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values +------- Update test comparison and listings +M test/compdirs/* +M test/listings/sitelist +M test/listings/help +M test/listings/list + +================================================================================ +Originator: erik +Date: Aug/16/2014 +Tag: PTCLM2_140816 +One-line: Add geyser/caldera to yellowstone +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_1_r080 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +M buildtools -- Allow yellowstone to use geyser and/or caldera + +------- Update test comparison and listings +M test/compdirs/* +M test/listings/sitelist +M test/listings/help +M test/listings/list + +================================================================================ +Originator: sacks +Date: May/21/2014 +Tag: PTCLM2_140521 +One-line: rename fpftdyn to flanduse_timeseries, and do some other related variable renames +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in + dynlu_crops_n03_addclm50bld_n06_clm4_5_72 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +This is meant to go with an upcoming CLM tag, currently slated for clm4_5_74 + +A + PTCLM_sitedata/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl +D PTCLM_sitedata/cnvrt_trnsyrs2_pftdyntxtfile.pl +M PTCLMmkdata +M README +M test/compdirs/global_US-UMB/user_nl_clm +M test/compdirs/rcp26_US-Dk2/user_nl_clm +M test/compdirs/rcp45_US-Dk3/user_nl_clm +M test/compdirs/rcp6_US-IB1/user_nl_clm +M test/compdirs/rcp85_US-Me4/user_nl_clm +M test/compdirs/trans_20th_US-Ne3/user_nl_clm +M test/compdirs/trans_clm45_US-Ha1/user_nl_clm + +================================================================================ +Originator: erik +Date: Apr/23/2014 +Tag: PTCLM2_140423 +One-line: Fix documentation, set DIN_LOC_ROOT_CLMFORC, correct call to mkmapdata.sh + allow release_tags in version, add hopper/edison to machine list. +Testing: Standard PTCLM test script on yellowstone, and test_driver.sh in clm4_5_71 +Known Bugs: RF-Bra will work even without --donot_use_tower_yrs since it doesn't + check for valid values + +A PTCLMsublist --------- Script to submit a list of sites to the batch queue +A PTCLMsublist_prog.py - Python code to handle the submision list +A batchque.py ---------- Python code to handle batch command submission for single processor + +M PTCLMmkdata -- Set DIN_LOC_ROOT_CLMFORC, Correct call to mkmapdata.sh + Also allow release_tags in version find. +M README ------- Correct compset used. +M buildtools --- Add edison/hopper to list of machines will work for + change frankfurt to goldbach, update netcdf version for yellowstone +M test/compdirs/* -------- Update the comparison files +M test/listings/sitelist - Update sitelist +M test/listings/help ----- Update help +M test/listings/list ----- Update list + +M test/PTCLMtestlist.py ----- Change result codes to be more consistent with + other testing mechanisms +M test/PTCLMtesting_prog.py - Change result codes, and set sdate/map_gdate so sdate won't + change with the day testing was run. +M test/PTCLMtestlist.xml ---- Add new tests for new sites + +------> Add new sites for Rosie, RF-Bra,LBA-Cax,LTER-Sev +------> And Jinyun US-Bol +M PTCLM_sitedata/PTCLMDATA_pftdata.txt +M PTCLM_sitedata/PTCLMDATA_sitedata.txt +M PTCLM_sitedata/PTCLMDATA_soildata.txt + + +------> Add new comparison files for testing +A test/compdirs/std_RF-Bra +A test/compdirs/std_RF-Bra/user_nl_clm +A test/compdirs/std_RF-Bra/run.log +A test/compdirs/std_RF-Bra/xmlchange_cmnds +A test/compdirs/std_RF-Bra/README.PTCLM +A test/compdirs/std_LBA-Cax +A test/compdirs/std_LBA-Cax/user_nl_clm +A test/compdirs/std_LBA-Cax/run.log +A test/compdirs/std_LBA-Cax/xmlchange_cmnds +A test/compdirs/std_LBA-Cax/README.PTCLM +A test/compdirs/std_LTER-Sev +A test/compdirs/std_LTER-Sev/user_nl_clm +A test/compdirs/std_LTER-Sev/run.log +A test/compdirs/std_LTER-Sev/xmlchange_cmnds +A test/compdirs/std_LTER-Sev/README.PTCLM + +================================================================================ +Originator: erik +Date: Feb/04/2014 +Tag: PTCLM2_140204 +One-line: Add testing directory, some reworking, and bug fixes, remove -mach + Remove --mach, --sitegroupname options add --map_gdate options. +Testing: Ran PTCLM tests in test directory, and test_driver.sh tests on + yellowstone. + + Add test directory and XML based test list + A test + A test/compdirs + A test/compdirs/* ----------- Compare directory files + A test/PTCLMtestlist.py ----- Class for reading the test list + A test/run_PTCLM_tests ------ Main test script + A test/PTCLMtestlist.xml ---- XML test list + A test/PTCLMtesting_prog.py - Main class for test script + A test/listings ------------- List option compare directory + A test/listings/sitelist ---- Site list compare + A test/listings/help -------- Help compare + A test/listings/list -------- List compare + A test/README + + M buildtools ---- Remove *.o files for gen_domain and gmake clean everything else + M PTCLMmkdata --- STARTDATE and ALIGNYR only set if using tower years. Add more metadata to filenames. + More work on debug option so works well. Also run mksurfdata.pl in debug mode with + --debug and --allownofile so will test it's usage. Remove -mach option, add --map_gdate + option so can use old maps easier. Add function to get filenames of created files, and + touch the file in debug mode. Fix some of the use-case logic. Fix directory logic, and + allow being able to run from a different directory. Exercise more commands in system + function for debug mode. + + Remove -m option + M mydatafiles/1x1pt_US-UMB/user_nl_clm + M mydatafiles/1x1pt_US-UMB/xmlchange_cmnds + M mydatafiles/1x1pt_US-UMB/README.PTCLM + + M README --- Remove -m option + + Add some test sites for testing: TS-Ts1, TS-Ts2, TS-Ts3 + M PTCLM_sitedata/PTCLMDATA_sitedata.txt ----- Add test sites, change align year as first year to use when cycle_forcing used + This is usually the first year, unless it's a leap year and it's the year after that. If the site has less than 3 years + it's "1". + M PTCLM_sitedata/PTCLMDATA_soildata.txt + M PTCLM_sitedata/PTCLMDATA_pftdata.txt + +================================================================================ +Originator: erik +Date: Nov/22/2013 +Tag: PTCLM2_131122c +One-line: Add some example files +Testing: limited setup for US-UMB case on yellowstone + +A mydatafiles/1x1pt_US-UMB/user_nl_clm +A mydatafiles/1x1pt_US-UMB/xmlchange_cmnds +A mydatafiles/1x1pt_US-UMB/README.PTCLM + +================================================================================ +Originator: erik +Date: Nov/22/2013 +Tag: PTCLM2_131122b +One-line: Rename a bunch of files, add US-UMB sample data +Testing: limited setup for US-UMB case on yellowstone + +Rename files to new names: + +A + PTCLMmkdata +A + PTCLM_sitedata/PTCLMDATA_pftdata.txt +A + PTCLM_sitedata/PTCLMDATA_sitedata.txt +A + PTCLM_sitedata/PTCLMDATA_soildata.txt + +A mydatafiles/1x1pt_US-UMB ---- sample directory for US-UMB site + +D PTCLM.py +D PTCLM_sitedata/EXAMPLE_sitedata.txt +D PTCLM_sitedata/EXAMPLE_soildata.txt +D PTCLM_sitedata/EXAMPLE_pftdata.txt + +>>>>> Remove other site data files as we already have + a lot of sample data in the PTCLMDATA file set. +D PTCLM_sitedata/LBA_pftdata.txt +D PTCLM_sitedata/LBA_sitedata.txt +D PTCLM_sitedata/LBA_soildata.txt +D PTCLM_sitedata/Fluxnet-Canada_sitedata.txt +D PTCLM_sitedata/Fluxnet-Canada_soildata.txt +D PTCLM_sitedata/Fluxnet-Canada_pftdata.txt +D PTCLM_sitedata/AmeriFlux_sitedata.txt +D PTCLM_sitedata/AmeriFlux_soildata.txt +D PTCLM_sitedata/AmeriFlux_pftdata.txt +D PTCLM_sitedata/CarboEurope_pftdata.txt +D PTCLM_sitedata/CarboEurope_sitedata.txt +D PTCLM_sitedata/CarboEurope_soildata.txt + +>>>>>> Update documentation +M KnownBugs +M README + +================================================================================ +Originator: erik +Date: Nov/22/2013 +Tag: PTCLM2_131122 +One-line: Add more documentation, remove some case settings not needed, make +work a bit cleaner +Testing: limited setup for US-UMB case on yellowstone + +>>>> Add README file for the sample mydatafiles directory +A https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_131119/mydatafiles/README + +M https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_131119/PTCLM.py +-- remove some options not needed. Fix directory, and setup user_nl_clm and +xmlchange_cmnds files. +M https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_131119/README +-- update doc... + + +================================================================================ +Originator: erik +Date: Nov/19/2013 +Tag: PTCLM2_131119 +One-line: Remove create_newcase call from PTCLM, just create datasets +Testing: limited setup for US-UMB case on yellowstone +Requires: scripts4_131119 + +Change PTCLM to JUST be a tool that creates datasets rather than also +creates a case for you. Running create_newcase is now a seperate step +that you use the -user_mods_dir option with. + +There are some issues with this version. But, it has basic functionality. + +The xmlchange_xcmnds file that is created has many fields multiple times. The +dataset location is also screwy. + +Change name for CHATS datasite to US-CHATS so name is more similar to the +other FluxNet sites. CHATS is an experiment that NCAR ran. + +A buildtools -- new script to build all the tools needed for PTCLM +M PTCLM.py ---- Change so that only creates datasets, does NOT run create_newcase +M README ------ Update documentation + +M PTCLM_sitedata/EXAMPLE_sitedata.txt -- Add campaign name to end +M PTCLM_sitedata/EXAMPLE_soildata.txt -- Change CHATS to US-CHATS +M PTCLM_sitedata/EXAMPLE_pftdata.txt --- Change CHATS to US-CHATS + +================================================================================ +Originator: erik +Date: Sep/29/2013 +Tag: PTCLM1_130929 +cesm_baseline: scripts4_130929 +One-line: default compset: I1PTCLM45, files go under site subdir, add script to rename maps +Testing: limited ran mexicocity, US-UMB, US-Ha1, and BE-Vie cases + +M PTCLM.py -------------------- Make default compset: I1PTCLM45, make files in resolution + subdiretory (under mydatadir) +M README ---------------------- Update documentation +A mydatafiles/renamemapfiles -- Script to rename mapping files creation date, so don't have + to recreate mapping files again. + +Remove directory NOT needed anymore... + +D usr_files/mkgriddata.TEMPLATE +D usr_files + +================================================================================ +Originator: erik +Date: Sep/23/2013 +Tag: PTCLM1_130923 +cesm_baseline: scripts4_130916 +One-line: Add --cycle_forcing, and --mydatadir options, remove useQIAN, rename --QIAN_tower_yrs to --use_tower_yrs +Testing: limited ran a couple cases + +M PTCLM.py -------- Changes from Keith Oleson to cycle_forcing, check + what model version is being used (clm4_0 or clm4_5) + set time-step. +D testcases.csh --- Remove as not working well on yellowstone + +================================================================================ +Originator: erik +Date: Sep/20/2013 +Tag: PTCLM1_130920 +cesm_baseline: scripts4_130920 +One-line: Make datafiles in mydatafiles directory +Testing: Ran basic US-UMB, US-NR1 and 1x1_mexicocityMEX cases + +M PTCLM.py +---------------- File changes from Keith Oleson +M PTCLM_sitedata/Fluxnet-Canada_sitedata.txt +M PTCLM_sitedata/EXAMPLE_sitedata.txt +M PTCLM_sitedata/Fluxnet-Canada_soildata.txt +M PTCLM_sitedata/AmeriFlux_sitedata.txt +M PTCLM_sitedata/EXAMPLE_soildata.txt +M PTCLM_sitedata/AmeriFlux_soildata.txt +M PTCLM_sitedata/Fluxnet-Canada_pftdata.txt +M PTCLM_sitedata/EXAMPLE_pftdata.txt +M PTCLM_sitedata/AmeriFlux_pftdata.txt + +================================================================================ +Originator: erik +Date: Sep/10/2013 +Tag: PTCLM1_130910 +cesm_baseline: scripts4_130910 +One-line: Get rid of pft-phys file copy, fix mapping file names, correct domain file +Testing: Limited, basic test setup + +M PTCLM.py --------- Remove pft-phys file copy, fix mapping file name, correct + domain file path +M testcases.csh ---- change compsets testing, unzip log file to check status + +================================================================================ +Originator: erik +Date: Jul/24/2013 +Tag: PTCLM1_130724 +cesm_baseline: scripts4_130724 +One-line: Add some more error checking, more changes to get things working +Testing: Limited, basic test setup + +M PTCLM.py ------- error checking, correct mapfile name, get gen_domain working, + set ATM/LND_DOMAIN_FILE + +================================================================================ +Originator: erik +Date: May/29/2013 +Tag: PTCLM1_130529 +cesm_baseline: scripts4_130529 +One-line: Get PTCLM working with the new CLM tools +Testing: Limited, test mexicocity, and 1x1_US-UMB basic case setup + +M PTCLM.py ------- Remove spinup options, get working with new tools +M testcases.csh -- Remove spinup tests, get working again + +================================================================================ +Originator: erik +Date: Feb/16/2013 +Tag: PTCLM1_130216 +cesm_baseline: scripts4_130130 +One-line: Get supported compsets working and some progress with tools +Testing: Limited -- but surported res work on ys + +M PTCLM.py +M testcases.csh + +================================================================================ +Originator: erik +Date: Jan/30/2013 +Tag: PTCLM1_130130 +cesm_baseline: scripts4_130130 +One-line: Initial changes to get PTCLM working with new scripts and tools +Testing: Limited testing + +Initial add of yellowstone to testcases and switch frankfurt for edinburgh. +Remove generic stuff for userdefined. Remove ndep/aer grid. + +M PTCLM.py +M testcases.csh +D usr_files/mkdatadomain.TEMPLATE + +================================================================================ +Originator: erik +Date: Jan/11/2013 +Tag: PTCLM1_130111 +cesm_baseline: scripts4_120125 +One-line: Add some new sitedata from Keith Oleson +Testing: none + +A PTCLM_sitedata/LBA_pftdata.txt +M PTCLM_sitedata/Fluxnet-Canada_sitedata.txt +M PTCLM_sitedata/EXAMPLE_sitedata.txt +A PTCLM_sitedata/CarboEurope_pftdata.txt +M PTCLM_sitedata/AmeriFlux_sitedata.txt +M PTCLM_sitedata/Fluxnet-Canada_soildata.txt +M PTCLM_sitedata/EXAMPLE_soildata.txt +M PTCLM_sitedata/AmeriFlux_soildata.txt +A PTCLM_sitedata/LBA_sitedata.txt +A PTCLM_sitedata/LBA_soildata.txt +A PTCLM_sitedata/CarboEurope_sitedata.txt +A PTCLM_sitedata/CarboEurope_soildata.txt +M PTCLM_sitedata/Fluxnet-Canada_pftdata.txt +M PTCLM_sitedata/EXAMPLE_pftdata.txt +M PTCLM_sitedata/AmeriFlux_pftdata.txt + +================================================================================ +Originator: mvertens +Date: Jan/25/2012 +Tag: PTCLM1_120125 +cesm_baseline: scripts4_120125 +One-line: Remove USE_MPISERIAL replace with MPILIB + + +================================================================================ + +Originator: erik +Date: Nov/29/2011 +Tag: PTCLM1_111129 +cesm_baseline: clm4_0_39 / scripts4_111129 +One-line: Use CLM_USRDAT for resolution or supported single-point res name + so will work with latest scripts version +Bugs-fixed: +Known Bugs: (See KnownBugs file for details) + 1379 (All of the spinup tests fail for PTCLM) + 1364 (Problem running US-UMB case on Macintosh) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) +Testing: Limited testing + bluefire testing: All PASS + +M PTCLM.py -- Set res in create_newcase to either supported 1pt name + or to CLM_USRDAT. + +================================================================================ +Originator: erik +Date: Nov/14/2011 +Tag: PTCLM1_111114 +cesm_baseline: clm4_0_38 / scripts4_111108 +One-line: Update path for NetCDF4 +Bugs-fixed: +Known Bugs: (See KnownBugs file for details) + 1379 (All of the spinup tests fail for PTCLM) + 1364 (Problem running US-UMB case on Macintosh) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) +Testing: Limited testing + bluefire testing: All PASS + +Update path for NetCDF for bluefire, jaguar, lynx, and mirage. + +M testcases.csh + +================================================================================ +Originator: erik +Date: Sep/02/2011 +Tag: PTCLM1_110902 +cesm_baseline: clm4_0_35 / scripts4_110902 +One-line: Change name of mksurfdata to mksurfdata_map, fix soil texture of US-UMB +Bugs-fixed: + 1392 (US-UMB site has some incorrect data) +Known Bugs: (See KnownBugs file for details) + 1379 (All of the spinup tests fail for PTCLM) + 1364 (Problem running US-UMB case on Macintosh) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) +Testing: Limited testing + bluefire testing: All PASS + +Get basic script working with non2D grid version of clm. mksurfdata directory +was changed to mksurfdata_map, and tools directories now have a "src" subdirectory +to build the code in them. + +Also fix soil texture for US-UMB site (bug 1392). + +M PTCLM.py +M testcases.csh +M PTCLM_sitedata/EXAMPLE_soildata.txt +M PTCLM_sitedata/AmeriFlux_soildata.txt + +================================================================================ +Originator: erik +Date: Jul/26/2011 +Tag: PTCLM1_110726 +cesm_baseline: clm4_0_33 / scripts4_110724 +One-line: Test if should use skip_rundb option or not, fix transient problem +Bugs-fixed: + 1368 (PTCLM for US-UMB spins up with zero GPP) + 1361 (Problem with transient compsets for PTCLM) +Known Bugs: (See KnownBugs file for details) + 1392 (US-UMB site has some incorrect data) + 1379 (All of the spinup tests fail for PTCLM) + 1364 (Problem running US-UMB case on Macintosh) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) +Testing: All tests pass up to the spinup tests where they all fail + bluefire testing: + PTCLM.*_US-UMB_ICN_exit_spinup.PTCLM + jaguar testing: + PTCLM._US_US-UMB_ICN_exit_spinup.PTCLM + edinburgh testing: + PTCLM.*_US-UMB_ICN_exit_spinup.PTCLM + yong/intel testing: + PTCLM.*_US-UMB_ICN_exit_spinup.PTCLM + + M PTCLM.py ------ Add check for finidat file, check if should use -skip_rundb option, fix transient issue + M testcases.csh - Change order of arguments for spinup tests, so more likely to die on an error with finidat file + M KnownBugs ----- Update list of bugs + +================================================================================ +Originator: erik +Date: May/04/2011 +Tag: PTCLM1_110504 +cesm_baseline: clm4_0_28 / scripts4_110428a +One-line: Move PTCLM to own external, and fix cnvrt script so can take year-range + allow it to use older versions of Python +Bugs-fixed: + 1279 (Latest version of PTCLM requires python2.5) + 1248 (PTCLM can only run until 2005) +Known Bugs: (See KnownBugs file for details) + 1392 (US-UMB site has some incorrect data) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) +Testing: + bluefire testing: All PASS + jaguar testing: All PASS + edinburgh testing: All PASS except +4 PTCLM.8696_US-UMB_I_1850.PTCLM FAIL 0 +5 PTCLM.8696_US-UMB_I20TR.PTCLM FAIL 0 +6 PTCLM.8696_US-UMB_I20TRCN.PTCLM FAIL 0 +7 PTCLM.8696_US-UMB_ICN.PTCLM FAIL 0 +8 PTCLM.8696_US-UMB_I1850CN.PTCLM FAIL 0 +9 PTCLM.8696_US-UMB_IRCP85CN.PTCLM FAIL 0 +10 PTCLM.8696_US-UMB_I.PTCLM FAIL 0 +11 PTCLM.8696_US-UMB_I_QIAN.PTCLM FAIL 0 +12 PTCLM.8696_US-UMB_I.PTCLM FAIL 0 +14 PTCLM.8696_US-UMB_ICN_exit_spinup.PTCLM FAIL 0 +15 PTCLM.8696_US-UMB_ICN_final_spinup.PTCLM FAIL 0 + yong/intel testing: All PASS + + Send a year range to the convert script and have years that start at the beginning + of the year range and go to the end of it. + Add a DEBUG option to testcases.csh so can just run tests quickly to debug test script. + + M PTCLM.py + M PTCLM_sitedata/cnvrt_trnsyrs2_pftdyntxtfile.pl + M testcases.csh + M KnownBugs + + M PTCLM_sitedata/EXAMPLE_sitedata.txt - Remove all but US-UMB + M PTCLM_sitedata/EXAMPLE_soildata.txt - Remove all but US-UMB + M PTCLM_sitedata/EXAMPLE_pftdata.txt -- Remove all but US-UMB + +================================================================================ +Originator: erik +Date: Feb/03/2011 +Tag: clm4_0_23 / scripts4_110111 +One-line: Fix --list and --cesm_root options, add --scratchroot, fix bugs + update use-cases and compset names, add CESM_ROOT/CLM_SOFF to testcases.csh +Bugs-fixed: + 1256 (fix PTCLM testcases.csh test script on jaguar to use netcdf/3.6.2) + 1254 (pft-physiology copy doesn't have .nc extension/can't handle new files) + 1250 (add ability to set scratchroot) + 1224 (Fix -aerdepgrid/ndepgrid options in PTCLM.py) +Known Bugs: (See KnownBugs file for details) + 1392 (US-UMB site has some incorrect data) + 1251 (Test case aborts on Macintosh with seq-fault in US-Ha1 I_QIAN case) + 1248 (PTCLM can only run until 2005) +Testing: + bluefire testing: All PASS + edinburgh testing: All Fail (Python is too old 2.4 when needs 2.5) + yong/intel testing: All PASS except... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 +myPTCLMtests_US-Ha1_I20TR.PTCLM FAIL 0 + +M PTCLM.py ------- Fix bugs, get --list and --cesm_root options working, add + --scratchroot, update CLM use-cases and how queried + add ability to add directory to caseprefix +M testcases.csh -- Add ability to use env vars CESM_ROOT and CLM_SOFF + set scratchroot for generic machines. Put case directories + under the PTCLM directory, so can delete it easier +M KnownBugs + +================================================================================ +Originator: erik +Date: Jan/12/2011 +Tag: clm4_0_21 / scripts4_110108 +One-line: Create ChangeLog file for PTCLM +Testing: + bluefire testing: All PASS + edinburgh testing: All PASS up to ... +myPTCLMtests_US-Ha1_I_1850.PTCLM FAIL 0 + yong/intel testing: All PASS up to... +myPTCLMtests_US-Ha1_I_QIAN.PTCLM PASS + +================================================================================ +Originator: erik +Date: Dec/06/2010 +Tag: scripts4_101206 +One-line: Add some documentation files + +M ccsm_utils/Tools/lnd/clm/PTCLM/testcases.csh Add USER_CC setting to yong +M ccsm_utils/Tools/lnd/clm/PTCLM/README ------- Add note about aerdepgrid/ndepgrid +A ccsm_utils/Tools/lnd/clm/PTCLM/KnownBugs ---- Add file with list of bugs + +================================================================================ +Originator: erik +Date: Dec/02/2010 +Tag: scripts4_101202 +One-line: Updates for script changes + +>>>>>>>>>>>> Get PTCLM working with changes +>>>>>>>>>>>> PTCLM updates from mpiserial branch +>>>>>>>>>>>> Add PTCLM tests for yong (Mac OS-X laptop) + M ccsm_utils/Tools/lnd/clm/PTCLM/PTCLM.py + M ccsm_utils/Tools/lnd/clm/PTCLM/testcases.csh + M ccsm_utils/Tools/lnd/clm/PTCLM/README + +================================================================================ +Originator: erik +Date: Aug/30/2010 +Tag: scripts4_100830 +One-line: Bring PTCLM branch to scripts trunk + +================================================================================ diff --git a/components/clm/tools/shared/PTCLM/KnownBugs b/components/clm/tools/shared/PTCLM/KnownBugs new file mode 100644 index 0000000000..8c6ea36f4a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/KnownBugs @@ -0,0 +1,3 @@ +components/clm/tools/shared/PTCLM/KnownBugs Nov/22/2013 + +==================================================================================== diff --git a/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_pftdata.txt b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_pftdata.txt new file mode 100644 index 0000000000..652a2d35ba --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_pftdata.txt @@ -0,0 +1,43 @@ +site_code,pft_f1,pft_c1,pft_f2,pft_c2,pft_f3,pft_c3,pft_f4,pft_c4,pft_f5,pft_c5 +US-Blo,100,1,0,0,0,0,0,0,0,0 +US-CHATS,100,7,0,0,0,0,0,0,0,0 +US-FPe,100,12,0,0,0,0,0,0,0,0 +US-NR1,100,1,0,0,0,0,0,0,0,0 +CA-Let,100,12,0,0,0,0,0,0,0,0 +CA-Man,100,2,0,0,0,0,0,0,0,0 +BR-Sa1,100,4,0,0,0,0,0,0,0,0 +BR-Sa3,100,4,0,0,0,0,0,0,0,0 +ES-ES1,100,1,0,0,0,0,0,0,0,0 +FL-Hyy,100,2,0,0,0,0,0,0,0,0 +FL-Kaa,100,14,0,0,0,0,0,0,0,0 +IT-Col,100,7,0,0,0,0,0,0,0,0 +IT-Cpz,100,5,0,0,0,0,0,0,0,0 +DE-Tha,100,1,0,0,0,0,0,0,0,0 +US-Brw,100,12,0,0,0,0,0,0,0,0 +BE-Vie,100,7,0,0,0,0,0,0,0,0 +US-ARM,100,15,0,0,0,0,0,0,0,0 +US-Var,100,13,0,0,0,0,0,0,0,0 +US-UMB,100,7,0,0,0,0,0,0,0,0 +US-Ha1,100,7,0,0,0,0,0,0,0,0 +US-Ho1,100,1,0,0,0,0,0,0,0,0 +US-MMS,100,7,0,0,0,0,0,0,0,0 +US-Bo1,100,15,0,0,0,0,0,0,0,0 +CA-Ca1,100,2,0,0,0,0,0,0,0,0 +CA-Oas,100,8,0,0,0,0,0,0,0,0 +CA-Obs,100,2,0,0,0,0,0,0,0,0 +CA-Ojp,100,2,0,0,0,0,0,0,0,0 +CA-Qfo,100,2,0,0,0,0,0,0,0,0 +US-Me4,100,1,0,0,0,0,0,0,0,0 +US-Me2,100,1,0,0,0,0,0,0,0,0 +US-MOz,100,7,0,0,0,0,0,0,0,0 +US-WCr,100,7,0,0,0,0,0,0,0,0 +US-Dk3,100,1,0,0,0,0,0,0,0,0 +US-Dk2,100,7,0,0,0,0,0,0,0,0 +US-IB1,100,15,0,0,0,0,0,0,0,0 +US-Ne3,100,15,0,0,0,0,0,0,0,0 +TS-Ts1,100,1,0,0,0,0,0,0,0,0 +TS-Ts2,100,1,0,0,0,0,0,0,0,0 +TS-Ts3,100,1,0,0,0,0,0,0,0,0 +LTER-Sev,100,1,0,0,0,0,0,0,0,0 +RF-Bra,-999,-999,0,0,0,0,0,0,0,0 +LBA-Cax,100,4,0,0,0,0,0,0,0,0 diff --git a/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_sitedata.txt b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_sitedata.txt new file mode 100644 index 0000000000..457f6cc63d --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_sitedata.txt @@ -0,0 +1,43 @@ +site_code,name,state,lon,lat,elev,startyear,endyear,alignyear,timestep,campaign +US-Blo,"Blodgett Forest",CA,-120.6327,38.8952,1315,1997,2007,1997,30,AmeriFlux +US-CHATS,"Cilker Chandler walnut orchard",CA,-121.85,38.49,21,2007,2007,2007,30,CHATS +US-FPe,"Fort Peck",MT,-105.1019,48.3077,634,2000,2007,2001,30,AmeriFlux +CA-Let,"Lethbridge",CAN,-112.9402,49.7093,960,1998,2007,1998,30,Fluxnet-Canada +US-NR1,"Niwot Ridge",CO,-105.5464,40.0329,3050,1998,2007,1998,30,AmeriFlux +CA-Man,"BOREAS NSA - Old Black Spruce",CAN,-98.4808,55.8796,259,1994,2003,1994,30,Fluxnet-Canada +BR-Sa1,"SantaremKM67",BRAZIL,-54.9589,-2.85667,130,2002,2004,1,60,LBA +BR-Sa3,"SantaremKM83",BRAZIL,-54.9714,-3.01803,130,2001,2003,1,60,LBA +ES-ES1,"ElSaler",SPAIN,-0.31881,39.346,10,1999,2005,1999,30,CarboEurope +FL-Hyy,"Hyytiala",FINLAND,24.2948,61.8474,181,1997,2005,1997,30,CarboEurope +FL-Kaa,"Kaamanen",FINLAND,27.295,69.1407,155,2000,2005,2001,30,CarboEurope +IT-Col,"Collelongo",ITALY,13.5881,41.8494,1550,1996,2001,1997,30,CarboEurope +IT-Cpz,"CastelPorziano",ITALY,12.3761,41.7052,68,2001,2005,2001,30,CarboEurope +DE-Tha,"Tharandt",GERMANY,13.5669,50.9636,380,1998,2003,1998,30,CarboEurope +US-Brw,Barrow,AK,-156.6259,71.3225,1,1998,2006,1998,30,AmeriFlux +BE-Vie,"Vielsalm",BELGIUM,5.99683,50.3055,450,1997,2005,1997,30,CarboEurope +US-ARM,"ARM SGP Main",OK,-97.4888,36.6058,310,2000,2007,2001,30,AmeriFlux +US-Var,"Vaira Ranch",CA,-120.9507,38.4067,129,2000,2007,2001,30,AmeriFlux +US-UMB,UMBS,MI,-84.7138,45.5598,234,1999,2006,1999,60,AmeriFlux +US-Ha1,"Harvard Forest",MA,-72.1715,42.5378,303,1991,2006,1991,60,AmeriFlux +US-Ho1,"Howland Forest Main",ME,-68.7402,45.2041,60,1996,2004,1997,30,AmeriFlux +US-MMS,"Morgon Monroe State Forest",IN,-86.4131,39.3232,275,1999,2007,1999,60,AmeriFlux +US-Bo1,Bondville,IL,-88.2919,40.0061,300,1996,2008,1997,30,AmeriFlux +CA-Ca1,"British Columbia- Campbell River - Mature Forest Site",CAN,-125.3336,49.8673,300,1998,2006,1998,30,Fluxnet-Canada +CA-Oas,"Sask.- SSA Old Aspen",CAN,-106.19779,53.6289,530,1997,2006,1997,30,Fluxnet-Canada +CA-Obs,"Sask.- SSA Old Black Spruce",CAN,-105.1178,53.9872,629,2000,2006,2001,30,Fluxnet-Canada +CA-Ojp,"Sask.- SSA Old Jack Pine",CAN,-104.6920,53.9163,579,2000,2006,2001,30,Fluxnet-Canada +CA-Qfo,"Quebec Mature Boreal Forest Site",CAN,-74.3421,49.6925,382,2004,2006,2004,30,Fluxnet-Canada +US-Dk2,"Duke Forest Hardwoods",NC,-79.1004,35.9736,160,2003,2005,2003,30,AmeriFlux +US-Dk3,"Duke Forest Loblolly Pine",NC,-79.0942,35.9782,163,1998,2005,1998,30,AmeriFlux +US-IB1,"Fermi Agricultural",IL,-88.2227,41.8593,227,2005,2007,2005,30,AmeriFlux +US-Me4,"Metolius Old Pine",OR,-121.6224,44.4992,915,1996,2000,1996,30,AmeriFlux +US-Me2,"Metolius Intermediate Pine",OR,-121.5574,44.4523,1253,2002,2010,2002,30,AmeriFlux +US-MOz,"Missouri Ozark Site",MO,-92.2,38.7441,219,2004,2007,2005,30,AmeriFlux +US-Ne3,"Mead Rainfed",NE,-96.4396,41.1797,361,2001,2006,2001,60,AmeriFlux +US-WCr,"Willow Creek",WI,-90.0799,45.8059,520,1998,2006,1998,30,AmeriFlux +TS-Ts1,"Test short yrs",TEST,-105.5464,40.0329,3050,1998,2001,1998,30,PTCLMTestSite +TS-Ts2,"Test short yrs start on leap-year",TEST,-105.5464,40.0329,3050,2004,2007,2005,30,PTCLMTestSite +TS-Ts3,"Test long yrs",TEST,-105.5464,40.0329,3050,2004,2008,2005,30,PTCLMTestSite +LTER-Sev,"Sevilleta Long Term Ecological Research (LTER) project (Meteorology from LTER Cerro Montoso #42)",NM,-106.529444,34.386389,1911,1996,1999,1996,30,LTER +RF-Bra,"Brasillia arbitrary site, no met-data",BR,-50.0,-15.0,-999,-999,-999,-999,60,RFisher +LBA-Cax,"Caxiauna Rainforest 'throughfall exclusion’ (TFE) experiment",BR,-51.46,1.717639,-999,1996,1999,1996,30,LBA diff --git a/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_soildata.txt b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_soildata.txt new file mode 100644 index 0000000000..f3ee9b8054 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_soildata.txt @@ -0,0 +1,43 @@ +site_code,soil_depth,n_layers,layer_depth,layer_sand%,layer_clay% +US-Blo,-999,1,-999,60.0,11.0 +US-CHATS,-999,1,-999,10.0,35.0 +US-FPe,-999,1,-999,47.0,21.0 +CA-Let,-999,1,-999,28.0,36.0 +US-NR1,-999,1,-999,43.13,21.43 +CA-Man,-999,1,-999,33.0,33.0 +BR-Sa1,-999,1,-999,19.0,65.0 +BR-Sa3,-999,1,-999,52.0,40.0 +ES-ES1,-999,1,-999,82.0,5.0 +FL-Hyy,-999,1,-999,82.0,5.0 +FL-Kaa,-999,1,-999,42.0,18.0 +IT-Col,-999,1,-999,22.0,13.0 +IT-Cpz,-999,1,-999,82.0,5.0 +DE-Tha,-999,1,-999,42.0,18.0 +US-Brw,-999,1,-999,50.0,25.0 +BE-Vie,-999,1,-999,42.0,18.0 +US-ARM,-999,1,-999,28.0,43.1 +US-Var,-999,1,-999,30.0,13.0 +US-UMB,-999,1,-999,92.6,0.6 +US-Ha1,-999,1,-999,66.0,6.0 +US-Ho1,0.8,1,-999,50.3,15.9 +US-MMS,-999,1,-999,34.0,63.0 +US-Bo1,-999,1,-999,5.0,25.0 +CA-Ca1,-999,1,-999,84.42,2.63 +CA-Oas,-999,1,-999,50.32,18.8 +CA-Obs,-999,1,-999,80.89,4.12 +CA-Ojp,-999,1,-999,94.47,2.5 +CA-Qfo,-999,1,-999,51.5,4.0 +US-Dk2,-999,1,-999,54.43,21.62 +US-Dk3,-999,1,-999,51.59,13.66 +US-IB1,-999,1,-999,7.8,37.2 +US-Me4,-999,1,-999,66.0,10.0 +US-Me2,-999,1,-999,67.0,7.0 +US-MOz,-999,1,-999,46.38,24.68 +US-Ne3,-999,1,-999,30.7,31.68 +US-WCr,-999,1,-999,42.52,20.17 +TS-Ts1,-999,1,-999,43.13,21.43 +TS-Ts2,-999,1,-999,43.13,21.43 +TS-Ts3,-999,1,-999,43.13,21.43 +LTER-Sev,-999,1,-999,52.,5. +RF-Bra,-999,1,-999,-999,-999 +LBA-Cax,-999,1,-999,75.00,20.00 diff --git a/components/clm/tools/shared/PTCLM/PTCLM_sitedata/US-Ha1_dynpftdata.txt b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/US-Ha1_dynpftdata.txt new file mode 100644 index 0000000000..e94db29f8f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/US-Ha1_dynpftdata.txt @@ -0,0 +1,4 @@ +trans_year,pft_f1,pft_c1,pft_f2,pft_c2,pft_f3,pft_c3,pft_f4,pft_c4,pft_f5,pft_c5,har_vh1,har_vh2,har_sh1,har_sh2,har_sh3,graze,hold_harv,hold_graze +1850,100,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 +1946,100,7,0,0,0,0,0,0,0,0,0.50,0,0,0,0,0,0,0 +2005,100,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 diff --git a/components/clm/tools/shared/PTCLM/PTCLM_sitedata/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl new file mode 100755 index 0000000000..51f0305ac1 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLM_sitedata/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl @@ -0,0 +1,261 @@ +#!/usr/bin/env perl +# +# cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl Erik Kluzek +# Aug/5/2010 +# +# Convert the transition years files to landuse_timeseries text files. +# +use Cwd; +use strict; +use English; +use IO::File; +use Getopt::Long; + +# +# Some global constants +# +my $maxlen = 125; +my $numharv = 5; +my $numgraz = 1; +my $nbreak = 5*2; +my $numarray = 1 + $nbreak + $numharv + $numgraz + 2 - 1; +my @hd_pftarr; +my @hd_hrvarr; +my @hd_grzarr; + +sub parse_header { +# +# Parse the header and make sure it's correct +# + my $header = shift; + + my @harray = split( /,/, $header ); + if ( $#harray != $numarray ) { + die "** Number of elements in line is incorrect: $#harray should be: $numarray\n"; + } + if ( (my $hyear = shift( @harray )) ne "trans_year" ) { + die "** First header element is NOT trans_year as expected: $hyear\n"; + } + foreach my $var ( "hold_graze\n", "hold_harv" ) { + if ( (my $val = pop( @harray )) ne $var ) { + die "** Last header elements are NOT $var as expected: $val\n"; + } + } + for( my $i = 0; $i < $nbreak; $i++ ) { + push( @hd_pftarr, shift( @harray ) ); + } + for( my $i = 0; $i < $numharv; $i++ ) { + push( @hd_hrvarr, shift( @harray ) ); + } + for( my $i = 0; $i < $numgraz; $i++ ) { + push( @hd_grzarr, shift( @harray ) ); + } +} + +sub parse_pft { +# +# Parse the PFT array +# + my $frcname = shift; + my $idxname = shift; + my $head = shift; + my @pftarray = @_; + + my @header = split( /,/, $head ); + my $sum = 0.0; + my $frcline = "<$frcname>"; + my $idxline = "<$idxname>"; + my $n = 1; + my $endit= undef; + for( my $i = 0; $i <= $#pftarray; $i=$i+2 ) { + my $j = $i + 1; + my $expect = "pft_f$n"; + if ( $header[$i] ne $expect ) { + die "** PFT fraction header is wrong: $header[$i] expect $expect\n"; + } + if ( ! defined($endit) ) { $frcline .= $pftarray[$i]; } + $sum = $sum + $pftarray[$i]; + if ( $pftarray[$j] < 0 || $pftarray[$j] > 16 ) { + die "** PFT index is out of range: $pftarray[$j]\n"; + } + $expect = "pft_c$n"; + if ( $header[$j] ne $expect ) { + die "** PFT code header is wrong: $header[$j] expect $expect\n"; + } + if ( ! defined($endit) ) { $idxline .= $pftarray[$j]; } + if ( $sum > 100.0 ) { + die "** Sum of PFT fractions exceeds 100: $sum\n"; + } elsif ( $sum == 100.0 ) { + $endit = 1; + } + if ( ! defined($endit) && ($j < $#pftarray) ) { $frcline .= ","; } + if ( ! defined($endit) && ($j < $#pftarray) ) { $idxline .= ","; } + $n++; + } + if ( $sum != 100.0 ) { + die "** Sum of PFT fractions does NOT go to 100: $sum\n"; + } + $frcline .= ""; + $idxline .= ""; + + return( "$frcline$idxline" ); +} + +sub parse_hrv { +# +# Parse the harvesting array +# + my $name = shift; + my $head = shift; + my $exp = shift; + my @array = @_; + + my @exp = split( /,/, $exp ); + my @header = split( /,/, $head ); + my $line = "<$name>"; + for( my $i = 0; $i <= $#array; $i++ ) { + if ( $header[$i] ne $exp[$i] ) { + die "** harvesting header is wrong: $header[$i], expecting $exp[$i]\n"; + } + $line .= $array[$i]; + if ( $array[$i] < 0 || $array[$i] > 1 ) { + die "** Bad value for harvest value: $array[$i]\n"; + } + if ( $i < $#array ) { $line .= ","; } + } + $line .= ""; + + return( $line ); +} + +sub printoutline { +# +# Print the line out with the fill as well +# + my $pftline = shift; + my $harline = shift; + my $grzline = shift; + my $year = shift; + + my $outline = "$pftline$harline$grzline"; + my $length = length( $outline ); + if ( $length > $maxlen ) { + die "** line length is too long = $length\n"; + } + my $fill = ""; + for( my $i = 1; $i <= $maxlen - $length; $i++ ) { $fill .= " "; } + + print "$outline$fill $year\n"; + +} + +if ( $#ARGV != 1 ) { + die "** Wrong number of arguments: should just be filename and sim_year_range\n ". + "$0 "; +} +my $filename = $ARGV[0]; +my $sim_year_range = $ARGV[1]; +chomp( $sim_year_range ); +my $start_year; +my $end_year; +if ( $sim_year_range =~ /^([0-9]+)\-([0-9]+)$/ ) { + $start_year = $1; + $end_year = $2; +} else { + die "** bad format for sim_year_range (should be yyyy-yyyy): $sim_year_range\n"; +} + +my $fh = IO::File->new; +$fh->open( "<$filename" ) or die "** can't open file: $filename\n"; + +my $header = <$fh>; +my $last_year = undef; +my $frst_year = undef; + +&parse_header( $header ); + +my $pftline = ""; +my $harline = ""; +my $grzline = ""; +my $hold_h = undef; +my $hold_g = undef; +my $year = undef; +while( my $line = <$fh> ) { + my @array = split( /,/, $line ); + if ( $#array != $numarray ) { + die "** Number of elements in line is incorrect: $#array\n"; + } + $year = shift( @array ); + # + # Write out the years from last year until current year + # + if ( defined($last_year) ) { + for( my $yr = $last_year+1; $yr < $year; $yr++ ) { + if ( $yr >= $start_year ) { + &printoutline( $pftline, $harline, $grzline, $yr ); + } + } + } + # + # Last two parts of the array are harvesting and grazing hold values + # + $hold_g = pop( @array ); + chomp( $hold_g ); + $hold_h = pop( @array ); + # + # Separate out the array into the different sections + # + my @pftarray; + for( my $i = 0; $i < $nbreak; $i++ ) { + push( @pftarray, shift( @array ) ); + } + my @hrvarray; + for( my $i = 0; $i < $numharv; $i++ ) { + push( @hrvarray, shift( @array ) ); + } + my @grzarray; + for( my $i = 0; $i < $numgraz; $i++ ) { + push( @grzarray, shift( @array ) ); + } + # + # Parse the different sections + # + $pftline = &parse_pft( "pft_f", "pft_i", join( ",", @hd_pftarr ), @pftarray ); + $harline = &parse_hrv( "harv", join( ",", @hd_hrvarr ), "har_vh1,har_vh2,har_sh1,har_sh2,har_sh3", @hrvarray ); + $grzline = &parse_hrv( "graz", join( ",", @hd_grzarr ), "graze", @grzarray ); + + # + # Write out the years from start year until first year + # + if ( ! defined($frst_year) && ($year > $start_year) ) { + for( my $yr = $start_year; $yr < $year; $yr++ ) { + &printoutline( $pftline, $harline, $grzline, $yr ); + } + } + # + # Figure out the line length and the amount of fill to have and print it + # + if ( $year >= $start_year ) { + &printoutline( $pftline, $harline, $grzline, $year ); + } + # If NOT holding harvesting, set it to zero, for transition years + if ( ! $hold_h ) { + for( my $i = 0; $i <= $#hrvarray; $i++ ) { $hrvarray[$i] = 0; } + $harline = &parse_hrv( "harv", join( ",", @hd_hrvarr ), "har_vh1,har_vh2,har_sh1,har_sh2,har_sh3", @hrvarray ); + } + # If NOT holding grazing, set it to zero, for transition years + if ( ! $hold_g ) { + for( my $i = 0; $i <= $#grzarray; $i++ ) { $grzarray[$i] = 0; } + $grzline = &parse_hrv( "graz", join( ",", @hd_grzarr ), "graze", @grzarray ); + } + # Save last years value so can create transition years + $last_year = $year; + if ( ! defined($frst_year) ) { $frst_year = $year } +} +# +# Write out years from end to file to the end_year +# +for( my $yr = $year+1; $yr <= $end_year; $yr++ ) { + &printoutline( $pftline, $harline, $grzline, $yr ); +} +$fh->close(); diff --git a/components/clm/tools/shared/PTCLM/PTCLMmkdata b/components/clm/tools/shared/PTCLM/PTCLMmkdata new file mode 100755 index 0000000000..97f8e2a341 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLMmkdata @@ -0,0 +1,695 @@ +#!/usr/bin/env python +######################################################################################### +# +# PTCLMmkdata +# +# Python script to create datasets to run point simulations of CLM4 +# using Tower Datasets for Ameriflux tower sites, using the CESM1 +# framework. +# +# Python script originally created by: +# +# Daniel M. Riccciuto, Dali Wang, Peter E. Thornton, Wilfred M. Poist +# of Environmental Sciences Division, Oak Ridge National Lab. +# +# Quinn Thomas +# of Cornell University +# +# Modified by Erik Kluzek (NCAR) to be incorporated as a standard part of CLM4. +# +# For help on PTCLMmkdata type: +# +# PTCLMmkdata --help +# +# Also see the README file +# +# Requirements: +# +# python, UNIX shell, NCL (NCAR Command Language), +# GNU make, Fortran compiler, C compiler +# +# NOTE: mksurfdata_map, and gen_domain must be compiled! +# You should only have to compile them once. +# you must also have ncl installed. +# +######################################################################################### +description = 'Python script to create datasets to run single point simulations with tower site data.' +import os, csv, time, re, sys, shlex, subprocess +from xml.sax.handler import ContentHandler +from xml.sax import make_parser + +###### THE ERROR FUNCTION +############################################################## + +def error( desc ): + "error function" + print "ERROR("+sys.argv[0]+"):: "+desc + os.abort() + +###### SET SOME VARIABLES ############################################################## + +#configure case options +#run time defaults +defSitesGroup = "PTCLMDATA" #default site group name + +stdout = os.popen("pwd") +cwd = os.path.abspath( stdout.read().rstrip( ) ) +dirname = os.path.dirname(sys.argv[0]) +if ( dirname == "" ): + ptclm_dir = cwd +else: + ptclm_dir = os.path.abspath(dirname) + +wrkdir = cwd +cesm_input = " " +filen = " " +histrcp = str(-999.9) +mydatadir = ptclm_dir+"/mydatafiles" +clmphysvers = "clm4_5" +clmnmlusecase = "2000_control" +stdout = os.popen( "date +%y%m%d" ); +sdate = stdout.read().rstrip( ); + +###### GET VERSION INFORMATION ######################################################### + +if sys.version_info < (2, 4): + error( "The version of Python being used is too old for PTCLMmkdata" ) + + +svnurl="$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_150826/PTCLMmkdata $" +if ( svnurl.split('/')[4] == "trunk" ): + svnvers="PTCLM_trunk" +elif ( svnurl.split('/')[4] == "trunk_tags" ): + svnvers=svnurl.split('/')[5] +elif ( svnurl.split('/')[4] == "branches" ): + svnvers="PTCLM_branch_"+svnurl.split('/')[5] +elif ( svnurl.split('/')[4] == "branch_tags" ): + svnvers="PTCLM_brnchtag_"+svnurl.split('/')[6] +elif ( svnurl.split('/')[4] == "release_tags" ): + svnvers="PTCLM_releasetag_"+svnurl.split('/')[6] +else: + print( "Error getting version from: "+svnurl) + os.abort() +version="PTCLM"+str(2.0)+"_"+svnvers + +### PARSE THE COMMAND LINE INPUT ######################################################## + +from optparse import OptionParser, OptionGroup + +#parse arguments +cmdline = "" +for arg in sys.argv: + cmdline = cmdline+arg+" " +parser = OptionParser( usage="%prog [options] -d inputdatadir -s sitename", description=description, version=version ) +required = OptionGroup( parser, "Required Options" ) +required.add_option("-d", "--cesmdata", dest="cesm_input", default=" ", \ + help="Location of CCSM input data") +required.add_option("-s", "--site", dest="mysite", default="none", \ + help="Site-code to run, FLUXNET code (-s list to list valid names)") +parser.add_option_group(required) +options = OptionGroup( parser, "Configure and Run Options" ) +options.add_option("--cesm_root", dest="base_cesm", \ + default=" ", help = \ + "Root CESM directory (top level directory with components and cime subdirs)") +options.add_option("--debug", dest="debug", action="store_true", default=False, \ + help="Flag to turn on debug mode so won't run, but display what would happen") +options.add_option("--sdate", dest="sdate", default=sdate, \ + help="Use entered date string in all files"+\ + " (use the given date string in place of the current date:"+sdate+")" ) +options.add_option("--clmnmlusecase", dest="clmnmlusecase", default=clmnmlusecase, \ + help="CLM namelist use case to use (default:"+clmnmlusecase+")" ) +options.add_option("--phys", dest="clmphysvers", default=clmphysvers, \ + help="CLM physics version to use (default:" +clmphysvers+")") +options.add_option("--list", dest="list", default=False, action="store_true", \ + help="List all valid: sites") +options.add_option("--mydatadir", dest="mydatadir", default=mydatadir \ + ,help="Directory of where to put your data files (files will be under subdirectories for each site)"+\ + " (default: "+mydatadir+")" ) +options.add_option("--donot_use_tower_yrs",action="store_false",\ + dest="use_tower_yrs",default=True,\ + help="Do NOT use the data years that correspond to the tower years "+\ + "(when you plan on using global forcing)" ) +options.add_option("--quiet", action="store_true", \ + dest="quiet", default=False, \ + help="Print minimul information on what the script is doing") +options.add_option("--cycle_forcing", action="store_true", \ + dest="cycle_forcing", default=False, \ + help="Cycle over the forcing data rather than do one run through (modifies start/end year to get this to work)") +options.add_option("--verbose", action="store_true", \ + dest="verbose", default=False, \ + help="Print out extra information on what the script is doing") +parser.add_option_group(options) + +indatgengroup = OptionGroup( parser, "Input data generation options", \ + "These are options having to do with generation of input datasets. " ) +parser.add_option_group(indatgengroup) +indatgengroup.add_option("--pftgrid", dest="pftgrid", help = \ + "Use pft information from global gridded file (rather than site data)", \ + action="store_true", default=False) +indatgengroup.add_option("--soilgrid", dest="soilgrid", help = \ + "Use soil information from global gridded file (rather than site data)",\ + action="store_true", default=False) +indatgengroup.add_option("--map_gdate", dest="map_gdate", default=sdate, \ + help="Use existing mapping files with the given date string rather than create new ones with current date"+\ + " (if mapping files do NOT exist with this date, the script will abort)" ) +indatgengroup.add_option("--mksurfdata_opts", dest="mksurfdata_opts", help = \ + "Options to send directly to mksurfdata_map",\ + default="") +versiongroup = OptionGroup( parser, "Main Script Version Id: $Id: PTCLMmkdata 72597 2015-08-26 19:50:37Z erik $ Scripts URL: "+svnurl ) +parser.add_option_group(versiongroup) + +(options, args) = parser.parse_args() +if len(args) != 0: + parser.error("incorrect number of arguments") + +### END PARSE THE COMMAND LINE INPUT #################################################### + +### SOME FUNCTIONS ################################################################### + +def system( cmd ): + "system function with error checking and debug prining" + + if plev>0: print "Run command: "+cmd + + # Check if this is a command to always do regardless of debug + cmdsallow = [ "create_newcase", "mkdir", "mv", "cat", "which", "chmod", "touch", "mksurfdata.pl" ] + allowed_cmd = False + for allow_cmd in cmdsallow: + if ( cmd.find( allow_cmd ) > 0 ): + allowed_cmd = True + + # Error check that command exists + if ( not options.debug or allowed_cmd ): + firstspace = cmd.index(" "); + if ( firstspace == -1 ): + justcmd = cmd + else: + justcmd = cmd[:firstspace] + + if ( cmd.index("/") != -1 ): + if ( not os.path.exists(justcmd) ): + error( "Error command does NOT exist: "+justcmd ); + else: + rcode = os.system( "which "+justcmd ) + if ( rcode != 0 ): + error( "Error command is NOT in path: "+justcmd ) + + # Now actually run the command + if ( not options.debug or allowed_cmd ): + if ( options.debug and cmd.find( "mksurfdata.pl" ) > 0): + rcode = os.system( cmd+" --debug --allownofile" ) + else: + rcode = os.system( cmd ) + else: rcode = 0 + if ( rcode != 0 ): + error( "Error running command: "+cmd ) + if ( os.path.isfile(filen) ): + output = open( filen,'a') + output.write(cmd+"\n") + output.close + +def queryFilename( queryopts, filetype ): + "query the XML database to get a filename" + query = abs_base_cesm+"/components/clm/bld/queryDefaultNamelist.pl -silent " \ + +"-justvalue " + if ( cesm_input != " " ): + query = query + " -csmdata "+cesm_input + cmd = query+queryopts+" -var "+filetype + file = os.popen( cmd ) + filename = file.read() + if ( file.close() != None ): + print "Query = "+cmd + error( "Error getting file from XML database" ) + # Remove the trailing new line from the filename + if ( (filename == None) or (filename == "") ): + print "Query = "+cmd + error( "Trouble finding file from XML database: "+filetype ) + return( filename.replace( "\n", "" ) ) + +def setup_case_files( ): + "Setup the user_nl_clm and shell_commands files" + filex = data_dir+"/shell_commands" + output = open( filex,'w') + output.write("# shell commands to execute xmlchange commands written by PTCLMmkdata:\n") + output.write("# "+cmdline+"\n") + output.close + system( "/bin/chmod +x "+filex ) + usernlclm = data_dir+"/user_nl_clm" + output = open( usernlclm,'w') + output.write("! user_nl_clm namelist options written by PTCLMmkdata:\n") + output.write("! "+cmdline+"\n") + output.close + return( filex, usernlclm ) + +def xmlchange_env_value( filex, var, value ): + 'Function to set the value of a variable in one of the env_*.xml files' + change = "./xmlchange" + cmd = change+" "+var+"="+value + output = open( filex,'a') + output.write(cmd+"\n") + output.close + +def write_datm_namelistdefaults_file( dir ): + "Write namelist_defaults_datm.xml file" + datm_src_dir = data_dir+"/SourceMods/src.datm"; + os.system( "/bin/mkdir -p "+datm_src_dir ) + file = datm_src_dir+"/namelist_defaults_datm.xml" + output = open( file,'w') + filestrings = ( '', \ + ' ', \ + '', \ + ' ', \ + '', \ + ' ', \ + '' ) + # write out file + for line in filestrings: + output.write(line+"\n") + # Add data directory for files + if ( line.find( "" ) != -1 ): + output.write('\n') + value = ''+dir+'\n' + output.write(value) + + output.close + +def find_filename_created( wildcard, desc ): + "Find the filename of the file that was just created" + if ( not options.debug ): + # If NOT debug mode, get the filename from a directory listing + stdout = os.popen( "ls -1t1 "+wildcard+" | head -1" ); + filename = stdout.read().rstrip( ); + if ( not os.path.exists( filename) ): error( "filename does NOT exist" ) + else: + # For debug mode, create a file with current date replacing any wildcards + filename = wildcard.replace( "*", options.sdate ) + os.system( "touch "+filename ) + + print desc+" = "+filename + return( filename ) + + +if sys.version_info < (2, 5): + def rpartition( string, sep ): + 'Reverse order of dividing string by seperator' + before = string[0:string.rfind(sep)]; + after = string[before.count(""):]; + return ( before, sep, after ) + +###### SET OPTIONS BASED ON INPUT FROM PARSER ########################################## + +mysite = options.mysite +SitesGroup = defSitesGroup +infohelp = "\n\n Use --help option for help on usage.\n"; +if(options.list): + mysite = "list" +if ( mysite == "none" ): parser.error("sitename is a required argument, set it to a valid value"+infohelp ) +if ( options.verbose and options.quiet ): + parser.error( "options quiet and verbose are mutually exclusive"+infohelp ) + +if ( options.verbose ): plev = 2 +elif ( options.quiet ): plev = 0 +else: plev = 1 + +sitedata=SitesGroup+"_sitedata.txt" +soildata=SitesGroup+"_soildata.txt" +pftdata=SitesGroup+"_pftdata.txt" + + +if plev>0: print "---------------- PTCLMmkdata version "+str(version)+"-----------------------------\n" +if plev>0: print " "+cmdline+"\n" +if plev>0: print " OPTIONS:\n" +if plev>0: print "Site name:\t\t\t\t\t\t"+mysite+"\n" + +base_cesm = options.base_cesm +if base_cesm == " ": + #assume base directory is five levels up from where PTCLM script + # is executed, if not specified + stdout = os.popen("cd "+ptclm_dir+"/../../../../..; pwd") + base_cesm = os.path.abspath( stdout.read().rstrip( ) ) + +abs_base_cesm = os.path.abspath( base_cesm ) +if plev>0: print "Root CLM directory:\t\t\t\t\t"+abs_base_cesm + +if plev>0: print "** Surface data file will be built using site-level data " + \ + "when available unless otherwise specified ** \n" +if plev>0: print "\tExtract PFT data from gridded files:\t\t"+str(options.pftgrid) +if plev>0: print "\tExtract soil data from gridded files:\t\t"+str(options.soilgrid) + +###### END SET OPTIONS BASED ON INPUT FROM PARSER ###################################### + +########## GET SITE LAT, LON, AND TOWER MET YEARS ####################################### + +siteDir = ptclm_dir+"/"+"PTCLM_sitedata" +#get lat/lon, start/end years from sitedata file +if plev>0: print "\nOpen Site data file: "+siteDir+"/"+sitedata+"\n" +sitepath = siteDir+"/"+sitedata +AFdatareader = csv.reader(open(sitepath, "rb")) +if ( mysite == "list" ): plev = 2 +found=False +for row in AFdatareader: + if plev>1: print " site = %9s name: %-55s Region: %12s Campaign: %s" % ( row[0], row[1], row[2], row[10] ) + if row[0] == mysite: + found=True + lon=float(row[3]) + if (lon < 0): + lon=360.0+float(row[3]) + lat=float(row[4]) + startyear=int(row[6]) + endyear=int(row[7]) + alignyear = int(row[8]) + timestep = int(row[9]) + +# Exit early for list options +if ( mysite == "list" ): + exit() +if ( not found ): + parser.error( "Entered site is NOT in the list of valid sites: "+mysite ) + +# inputdata directory -- set after list options +cesm_input=options.cesm_input +if cesm_input == " ": + parser.error( "inputdatadir is a required argument, set it to the directory where you have your inputdata"+infohelp ) +if plev>0: print "CESM input data directory:\t\t\t\t"+cesm_input +#define data and utility directories +mask = "navy" +clmusrdatname = "1x1pt_"+mysite +clmusrdat = " -usrname "+clmusrdatname +clmres = clmusrdatname +clmmask = "navy" +myres = "CLM_USRDAT" #single-point mode (don't change) + +clm_tools = abs_base_cesm+'/components/clm/tools' +gen_dom_dir = abs_base_cesm+'/cime/tools/mapping/gen_domain_files' +mkmapgrd_dir= clm_tools+'/shared/mkmapgrids' +mkmapdat_dir= clm_tools+'/shared/mkmapdata' +clm_input = cesm_input+'/lnd/clm2' +datm_input = cesm_input+'/atm/datm7' + +mydata_dir = os.path.abspath( options.mydatadir ) +data_dir = mydata_dir+"/"+clmusrdatname +if ( not os.path.exists( data_dir ) ): os.system( "/bin/mkdir -p "+data_dir ) + +if plev>0: print "----------------------------------------------------------------\n" + +############# WRITE OUT README FILE ON DATA ############################################## + +opt = " " + +clmnmlusecase = options.clmnmlusecase + +filen = data_dir+"/README.PTCLM" +if plev>0: print "Write "+filen+" with command line" +output = open( filen,'w') +output.write(cmdline+"\n") +output.close + +############# GET SIM_YEAR, RCP and SIM_YEAR_RANGE based on USE-CASE #################### +############# CLM configure ensures naming conventions are followed #################### +############# And setup Query options based on them ##################################### + +if ( clmnmlusecase.endswith("_transient") ): + transient = re.search('^([0-9]+-[0-9]+)_*(.*)_(transient$)', clmnmlusecase ) + if ( transient ): + sim_year_range = transient.group(1) + sim_year = re.search( '^([0-9]+)-', transient.group(1) ).group(1) + rcpcase = re.search( '^rcp([0-9.]+)', transient.group(2) ) + if ( rcpcase == None ): rcp = histrcp + else: rcp = rcpcase.group(1) + elif ( clmnmlusecase.startswith("20thC_") ): + sim_year_range = "1850-2000" + sim_year = "1850" + rcp = histrcp + else: + error( "Can not parse use-case name, does not follow conventions: "+clmnmlusecase ) + + if ( sim_year_range == "1850-2000" ): actual_sim_year_range = "1850-2005" + else: actual_sim_year_range = sim_year_range +elif ( clmnmlusecase.endswith("_control") ): + control = re.search( '^([0-9]+)_', clmnmlusecase ) + if ( not control ): error( "Can NOT parse use-case name does NOT follow conventions: "+clmnmlusecase ) + sim_year = control.group(1) + if ( sim_year == None ): error( "Trouble finding sim_year from:"+clmnmlusecase ) + sim_year = str(sim_year) + sim_year_range = "constant" + rcp = histrcp +elif ( clmnmlusecase.endswith("_pd") or clmnmlusecase == "UNSET" ): + sim_year = "2000" + sim_year_range = "constant" + rcp = histrcp +else: + error( "Can not parse use-case name:, does not follow conventions: "+clmnmlusecase ) + +if ( rcp == histrcp ): + landuse_timeseries_type = "hist" +else: + landuse_timeseries_type = "rcp"+rcp + +qoptionsbase = " -options mask="+mask+",rcp="+rcp + +qoptions = qoptionsbase+",sim_year="+sim_year+",sim_year_range="+sim_year_range; +queryOpts = " -onlyfiles -res "+clmres+clmusrdat+qoptions +queryOptsNousr = qoptions +queryOptsNavy = " -res 0.33x0.33 "+qoptions + +# +# If you are trying to cycle the forcing years you need to be careful about +# the number of years cycling over and taking leap years into account. +# +if ( options.cycle_forcing ): + numyears = endyear - startyear + 1 + numfour = int(numyears/4) + # If have three years or less (numfour = 0) just repeat first year + # unless first year is leap year then use next year. + # Since just using one year that is not a leap year endyear is startyear + if (numfour == 0): + if (startyear % 4 == 0): + startyear = startyear + 1 + + endyear = startyear + else: + endyear = startyear + numfour * 4 - 1 + + # Use alignyear from file for cycle_forcing case +else: + # When NOT cycling forcing, use start year for the align year + alignyear = startyear + +if plev>0: print "CLM Physics Version: "+options.clmphysvers + +####### ANY OTHER LAST SETTINGS BEFORE CREATING DATASETS ################################ + +##### ENV XML CHANGES ################################################################## +filex, usernlclm = setup_case_files( ) + +if ( clmusrdatname != "" ): + xmlchange_env_value( filex, "CLM_USRDAT_NAME", clmusrdatname ) + +if(options.use_tower_yrs): + xmlchange_env_value( filex, "DATM_CLMNCEP_YR_START", str(startyear) ) + xmlchange_env_value( filex, "DATM_CLMNCEP_YR_END", str(endyear) ) + +xmlchange_env_value( filex, "CLM_BLDNML_OPTS", "'-mask "+mask+"'" ) + +xmlchange_env_value( filex, "MPILIB", "mpi-serial" ) + +############# BEGIN CREATE POINT DATASETS ############################################### + + +if plev>0: print("Making input files for the point (this may take a while if creating transient datasets)") + +os.chdir(data_dir) +#make map grid file and atm to ocean map ############################################ +if plev>0: print "Creating map file for a point with no ocean" +print "lat="+str(lat) +ptstr = str(lat)+","+str(lon) +if ( os.system( "which ncl" ) != 0 ): error( "ncl is NOT in path" ) # check for ncl +system(mkmapdat_dir+"/mknoocnmap.pl -p "+ptstr+" -name "+clmres+" > "+data_dir+"/mknoocnmap.log") +mapfile = find_filename_created( mkmapdat_dir+"/map_"+clmres+"_noocean_to_"+clmres+"_"+"nomask_aave_da_*.nc", "mapfile" ) +scripgridfile = find_filename_created( mkmapgrd_dir+"/SCRIPgrid_"+clmres+"_nomask_c*.nc", "scripgridfile" ) + +#make domain file needed by datm #################################################### +if plev>0: print "Creating data domain" +cmd = gen_dom_dir+"/gen_domain -m "+mapfile+" -o "+clmmask+" -l "+clmres+" -c 'Running gen_domain from PTCLMmkdata' > "+data_dir+"/gen_domain.log" +system(cmd); +domainfile = find_filename_created( "domain.lnd."+clmres+"_"+clmmask+".*.nc", "domainfile" ) + +#make surface data and dynpft ####################################################### +if plev>0: print "\n\nRe-create surface dataset:\t" +if ( sim_year_range == "constant" ): + mksrfyears = sim_year +else: + mksrfyears = sim_year_range + +#make mapping files needed for mksurfdata_map ####################################### + +mapdir = data_dir +if ( options.map_gdate == options.sdate ): + # mkmapdata.sh remembers where it is (although it starts over for a new date) + if plev>0: print "\n\nRe-create mapping files for surface dataset:" + cmd = mkmapdat_dir+"/mkmapdata.sh --gridfile "+scripgridfile+" --res "+clmres+" --gridtype regional -v --phys "+options.clmphysvers+" > "+mapdir+"/mkmapdata.log"; + system(cmd); +else: + mksrfmapfile = find_filename_created( mapdir+"/map_*"+"_c"+options.map_gdate+".nc", "mksrfmapfile" ) + if ( not os.path.exists( mksrfmapfile ) ): error( "mapping files with gdate of "+ \ + options.map_gdate+" do NOT exist, bad value for --map_gdate option" ) + +# --- use site-level data for mksurfdata_map when available ---- +#PFT information for the site +if (options.pftgrid == False): + if plev>0: print "Replacing PFT information in surface data file" + os.chdir(siteDir) + AFdatareader = csv.reader(open(pftdata, "rb")) + os.chdir(data_dir) + pft_frac=[0,0,0,0,0] + pft_code=[0,0,0,0,0] + found=0 + for row in AFdatareader: + if plev>1: print " site = %9s" % row[0] + if row[0] == mysite: + found=1 + output=open("./tempsitePFT.txt","w") + output.write(' '.join(row[1:11])) + output.close() + for thispft in range(0,5): + pft_frac[thispft]=float(row[1+2*thispft]) + pft_code[thispft]=int(row[2+2*thispft]) + if ( found == 0 ): + error( "Did NOT find input sitename:"+mysite+" in pftdata:"+pftdata+ \ + " run with pftgrid instead") + # Find index of first zero + for i in range(0,len(pft_frac)): + if ( pft_frac[i] == 0.0 ): + nzero = i + break + pftopts=" -pft_frc \""+str(pft_frac[0:nzero])+'"' \ + " -pft_idx \""+str(pft_code[0:nzero])+'"' +else: + pftopts="" + +#Read in the soil conditions for the site ####################################### +if (options.soilgrid == False): + + #soil information + os.chdir(siteDir) + if plev>0: print "Replacing soil information in surface data file" + AFdatareader = csv.reader(open(soildata, "rb")) + os.chdir(data_dir) + found=0 + for row in AFdatareader: + if plev>1: print " site = %9s" % row[0] + if row[0] == mysite: + found=1 + output=open("./tempsitesoil.txt","w") + output.write(' '.join(row[1:7])) + output.close() + # The first three items are NOT used + soil_depth = float(row[1]) # This is ignored + n_layers = int(row[2]) # This is ignored + layer_depth = float(row[3]) # This is ignored + sandpct = float(row[4]) + claypct = float(row[5]) + if ( found == 0 ): + error( "Did NOT find input sitename:"+mysite+" in soildata:"+soildata+ \ + " run with soilgrid instead") + if plev>0: print " sandpct="+str(sandpct)+" claypct="+str(claypct) + soilopts=" -soil_cly "+str(claypct)+" -soil_snd "+str(sandpct) +else: soilopts="" +#----- create dynamic pft input file --------------- ############################ +if (options.pftgrid == False) and (sim_year_range != "constant"): + + if plev>0: print "Creating site-specific dynamics PFTs and harvesting" + + landuse_timeseries_site_filename = siteDir + \ + mysite + "_dynpftdata.txt" + + # only set dynpft file if the file exists + if ( os.path.exists( landuse_timeseries_site_filename ) ): + if plev>0: print "Transition PFT file exists, so using it for changes in PFT" + # Convert the file from transition years format to mksurfdata_map landuse_timeseries_ format + cnv = siteDir + \ + "/cnvrt_trnsyrs2_landuse_timeseries_txtfile.pl " + \ + landuse_timeseries_site_filename+" "+sim_year_range + landuse_timeseries_outfile = data_dir+"/landuse_timeseries_"+mysite+".txt" + system( cnv+" > "+landuse_timeseries_outfile ) + dynpftopts = " -dynpft "+landuse_timeseries_outfile + else: + error( "Transition PFT file does NOT exist for this site, create one, use --pftgrid, or choose a non transient use-case" ) + +else: + dynpftopts = "" + +# Now run mksurfdata_map ########################################################### +mksurfopts = "-res usrspec -usr_gname "+clmres+" -usr_gdate "+options.map_gdate+ \ + " -usr_mapdir "+mapdir+" -dinlc "+cesm_input+" -y "+mksrfyears+ \ + " -rcp "+rcp+soilopts+pftopts+dynpftopts+" "+options.mksurfdata_opts +system(clm_tools+"/"+options.clmphysvers+"/mksurfdata_map/mksurfdata.pl "+mksurfopts+" > "+data_dir+"/mksurfdata_map.log") + +surffile = find_filename_created( data_dir+"/surfdata_"+clmres+"*_simyr"+sim_year+"_*.nc", "surface file" ) +logfile = find_filename_created( data_dir+"/surfdata_"+clmres+"*_simyr"+sim_year+"_*.log", "surface log file" ) +if ( sim_year_range != "constant" ): + landuse_timeseries_file = find_filename_created( data_dir+"/landuse.timeseries_"+clmres+"_"+landuse_timeseries_type+"_simyr"+actual_sim_year_range+"_*.nc", "landuse_timeseries_file" ) +# rename files with clm version in the filename +mkopts = "" +if (options.pftgrid == True): mkopts += "_pftgrd" +if (options.soilgrid == True): mkopts += "_soigrd" +if (options.mksurfdata_opts != "" ): mkopts += "_"+options.mksurfdata_opts.replace(" ","+") +newsurffile = "surfdata_"+clmres+"_simyr"+sim_year+"_"+options.clmphysvers+mkopts+"_c"+options.sdate+".nc" +newlogfile = "surfdata_"+clmres+"_simyr"+sim_year+"_"+options.clmphysvers+mkopts+"_c"+options.sdate+".log" +system("/bin/mv -f "+surffile+" "+newsurffile ) +system("/bin/mv -f "+logfile+" "+newlogfile ) +surffile = data_dir+"/"+newsurffile +if (sim_year_range != "constant"): + new_landuse_timeseries_file = "landuse.timeseries"+clmres+"_"+landuse_timeseries_type+"_simyr"+actual_sim_year_range+"_"+options.clmphysvers+mkopts+"_c"+options.sdate+".nc" + system("/bin/mv -f "+landuse_timeseries_file+" "+new_landuse_timeseries_file ) + landuse_timeseries_file = data_dir+"/"+new_landuse_timeseries_file + + + + +####### END CREATE POINT DATASETS ####################################################### + + +###### SET ENV_RUN.XML VALUES ########################################################### + +os.chdir(data_dir) +xmlchange_env_value( filex, "ATM_DOMAIN_PATH", data_dir ) +xmlchange_env_value( filex, "LND_DOMAIN_PATH", data_dir ) +xmlchange_env_value( filex, "ATM_DOMAIN_FILE", domainfile ) +xmlchange_env_value( filex, "LND_DOMAIN_FILE", domainfile ) + +xmlchange_env_value( filex, "CALENDAR", "GREGORIAN" ) +xmlchange_env_value( filex, "DOUT_S", "FALSE" ) +hist_nhtfrq = 0 +hist_mfilt = 1200 + +atm_ncpl = int((60 // timestep) * 24) +xmlchange_env_value( filex, "ATM_NCPL", str(atm_ncpl) ) +if(options.use_tower_yrs): + xmlchange_env_value( filex, "RUN_STARTDATE", str(alignyear)+"-01-01" ) + xmlchange_env_value( filex, "DATM_CLMNCEP_YR_ALIGN", str(alignyear) ) + +xmlchange_env_value( filex, "DIN_LOC_ROOT", cesm_input ) +xmlchange_env_value( filex, "DIN_LOC_ROOT_CLMFORC", mydata_dir ) + +#### NAMELIST DEFAULTS FILE MODIFICATIONS ############################################## +datm_dir = data_dir+"/CLM1PT_data" +if ( os.path.isdir(datm_dir) ): + write_datm_namelistdefaults_file( datm_dir ) + +#### SET NAMELIST OPTIONS ############################################################## +output = open(usernlclm,'a') +output.write( " fsurdat = '"+surffile+"'\n" ) +if (sim_year_range != "constant"): + output.write( " flanduse_timeseries = "+landuse_timeseries_file+"\n" ) +output.write( " hist_nhtfrq = "+str(hist_nhtfrq)+"\n" ) +output.write( " hist_mfilt = "+str(hist_mfilt)+"\n" ) +output.close() +if plev>1: os.system( "/bin/cat user_nl_clm" ) + +###### END SET Spinup and ENV_RUN.XML VALUES ############################################ + +if plev>0: print "Data created successfully in "+data_dir+"\n" + +### END PTCLM SCRIPT #################################################################### + diff --git a/components/clm/tools/shared/PTCLM/PTCLMsublist b/components/clm/tools/shared/PTCLM/PTCLMsublist new file mode 100755 index 0000000000..b059f100ef --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLMsublist @@ -0,0 +1,16 @@ +#!/usr/bin/env python +# +# Python program to submit a list of sites to the batch queue. +# Setup for: yellowstone, hopper, edison +# +from PTCLMsublist_prog import PTCLMsublist_prog + +bsub = PTCLMsublist_prog() +bsub.parse_cmdline_args() +print "Submit a list of sites to the batch queue\n" +bsub.Initialize() + +for site in bsub.get_SiteList(): + print "Submit for site: "+site+"\n"; + bsub.Submit( site ) + diff --git a/components/clm/tools/shared/PTCLM/PTCLMsublist_prog.py b/components/clm/tools/shared/PTCLM/PTCLMsublist_prog.py new file mode 100644 index 0000000000..690172bcae --- /dev/null +++ b/components/clm/tools/shared/PTCLM/PTCLMsublist_prog.py @@ -0,0 +1,199 @@ +######################################################################################### +# +# PTCLMsublist_prog +# +# Top level class to define the PTCLMsublist program. Parse's arguments and has Init, +# and run methods to submit a list of PTCLMmkdata sites to the batch queue. +# +######################################################################################### +import os, sys +from batchque import batchque + +class PTCLMsublist_prog: +#---------------------------------------------------------------------------------------- +# Class to handle command line input to the program +#---------------------------------------------------------------------------------------- + # Class data + name = "PTCLMsublist" + cmdline = "" + account = "P93300075" + cesmdir_def = "../../../../../.." + cesmdir = os.getenv("CESM_ROOT", cesmdir_def ) + inputdir_def = "/glade/p/cesmdata/cseg/inputdata" + inputdir = os.getenv("DIN_LOC_ROOT", inputdir_def ) + sitelistcsv = "US-CHATS,US-FPe,CA-Let,US-NR1,CA-Man,BR-Sa1,BR-Sa3" + mach = "yellowstone" + parse_args = False + ptclm_opts = "" + que = batchque() + setup = False + + # -- Error function --------------------------------- + def error( self, desc ): + "error function to abort with a message" + print "ERROR("+self.name+"):: "+desc + sys.exit(100) + + def parse_cmdline_args( self ): + "Parse the command line arguments for the PTCLM batch submission script" + from optparse import OptionParser, OptionGroup + + for arg in sys.argv: + self.cmdline = self.cmdline+arg+" " + parser = OptionParser( usage="%prog [options]" ) + options = OptionGroup( parser, "Options" ) + options.add_option("-r", "--cesm_root", dest="cesm_root", default=self.cesmdir, \ + help="Location of CESM root directory (also set with CESM_ROOT env variable)") + options.add_option("-d", "--inputdir", dest="inputdir", default=self.inputdir, \ + help="Location of CESM inputdata directory (also set with CSMDATA env variable)") + options.add_option("-o", "--PTCLM_options", dest="options", default=self.ptclm_opts, \ + help="PTCLM options to run with") + options.add_option("-l", "--list", dest="sitelist", default=self.sitelistcsv, \ + help="Comma seperated list of PTCLM sites to submit to batch") + options.add_option("--account", dest="account", default=self.account, \ + help="Account number to use for batch queue") + options.add_option("--mach", dest="mach", default=self.mach, \ + help="Machine name to use for batch submital") + parser.add_option_group(options) + svnurl = '$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_150826/PTCLMsublist_prog.py $' + versiongroup = OptionGroup( parser, "Version Id: $Id: PTCLMsublist_prog.py 59464 2014-04-23 16:27:26Z erik $ URL: "+svnurl ) + parser.add_option_group(versiongroup) + (options, args) = parser.parse_args() + if len(args) != 0: + parser.error("incorrect number of arguments") + + self.mach = options.mach + self.sitelistcsv = options.sitelist + self.account = options.account + self.options = options.options + self.cesmdir = options.cesm_root + self.inputdir = options.inputdir + # Initialize batch que object, will abort if bad machine + self.que.Initialize( self, mach=self.mach, account=self.account ) + # Error checking + if ( not os.path.isdir(self.cesmdir) ): + self.error( "CESM_root directory does NOT exist: "+self.cesmdir ) + if ( not os.path.isdir(self.inputdir) ): + self.error( "CESM inputdata directory does NOT exist: "+self.inputdir ) + + # Get site list from csv formatted string list + if ( self.sitelistcsv.find( " " ) != -1 ): + self.error( "Site list has white space in it, just use comma's to seperate sites: "+self.sitelistcsv ) + if ( self.sitelistcsv.find( ",," ) != -1 or self.sitelistcsv.endswith( "," ) or self.sitelistcsv.startswith( "," ) ): + self.error( "Site list has empty site names, make sure comma's do not go after each other: "+self.sitelistcsv ) + self.sitelist = self.sitelistcsv.split( "," ) + + # Flag that parsing was accomplished + self.parse_args = True + + def cesm_root( self ): + "Return the CESM_ROOT directory" + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + return( self.cesmdir ) + + def get_SiteList( self ): + "Return the Site list" + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + return( self.sitelist ) + + def Initialize( self ): + "Initialize the PTCLM batch submission" + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + + self.que.Initialize( self, self.mach, self.account ) + self.setup = True + + + def Submit( self, site, submit=True ): + "Submit the PTCLMmkdata job to the batch queue" + if ( not self.setup ): + self.error( "Initialize was NOT run first" ) + + jobcommand = "./PTCLMmkdata --cesm_root "+self.cesmdir+" -s "+site+" -d "+self.inputdir+" "+self.options + bsub = self.que.Submit( self, jobcommand, jobname="PTCLM_"+site, submit=submit ) + return( bsub ) + +# +# Unit testing for above classes +# +import unittest + +class test_PTCLMsublist_prog(unittest.TestCase): + + def setUp( self ): + self.prog = PTCLMsublist_prog() + + def test_badinit( self ): + # Bad option will fail + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "--zztop" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + # Test that doing stuff before parse_args fails + self.prog = PTCLMsublist_prog() + self.assertRaises(SystemExit, self.prog.cesm_root ) + self.assertRaises(SystemExit, self.prog.Initialize ) + self.assertRaises(SystemExit, self.prog.Submit, "US-UMB" ) + # Test that doing stuff after parse_args before Initialize fails + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ ] + self.prog.parse_cmdline_args( ) + self.assertRaises(SystemExit, self.prog.Submit, "US-UMB" ) + # Test that a non existant directory for cesm_root fails + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "--cesm_root", "zztop" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + # Test that a non existant directory for inputdata fails + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "-d", "inpzztop" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + # Test that a bad site list fails + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "-l", "thing thing2 thing3" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "-l", "thing,thing2,,thing3" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "-l", "thing,thing2,thing3," ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + self.prog = PTCLMsublist_prog() + sys.argv[1:] = [ "-l", ",thing,thing2,thing3" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + + def test_init( self ): + # check that setting cesm_root works + sys.argv[1:] = [ ] + self.prog.parse_cmdline_args( ) + cesmdir_def = os.getenv("CESM_ROOT", self.prog.cesmdir_def ) + self.assertTrue( self.prog.cesm_root( ) == cesmdir_def ) + cwd = os.getcwd() + sys.argv[1:] = [ "--cesm_root", cwd ] + self.prog.parse_cmdline_args( ) + self.assertTrue( self.prog.cesm_root( ) == cwd ) + # Initialize and submit + self.prog.Initialize( ) + site = "US-UMB" + bsub = self.prog.Submit( site, submit=False ) + checkstring = "bsub -oo PTCLM_US-UMB.stdout.out -J PTCLM_US-UMB -cwd " + cwd + " -W 4:00 " + \ + " -P P93300075 -n 1 -R 'span[ptile=15]' -q caldera -N -a poe ./PTCLMmkdata --cesm_root " + \ + self.prog.cesmdir+" -s "+site+" -d "+self.prog.inputdir+" " + print "\n" + print "bsubcm:"+bsub+":end" + print "expect:"+checkstring+":end" + self.assertTrue( bsub == checkstring ) + + def test_sitelist( self ): + sitelistcsv = "US-UMB,US-Ha1" + sitelist = [ "US-UMB", "US-Ha1" ] + sys.argv[1:] = [ "-l", sitelistcsv ] + self.prog.parse_cmdline_args( ) + self.prog.Initialize( ) + slist = self.prog.get_SiteList( ) + self.assertTrue( slist == sitelist ) + + +if __name__ == '__main__': + unittest.main() diff --git a/components/clm/tools/shared/PTCLM/README b/components/clm/tools/shared/PTCLM/README new file mode 100644 index 0000000000..23751313f7 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/README @@ -0,0 +1,103 @@ +components/clm/tools/shared/PTCLM/README 04/10/2015 + +PTCLMmkdata is a python tool built on top of CLM tools and CESM scripts +for building datasets to run CLM "I" cases for data from Ameriflux Tower-sites, +or other user-supplied single-point datasets. + +Original Authors: + +Daniel M. Ricciuto, Dali Wang, Peter E. Thornton, Wilfred M. Post + +Environmental Sciences Division, Oak Ridge National Laboratory (ORNL) + +R. Quinn Thomas + +Cornell University + +Modified by: + +Erik Kluzek (NCAR) + +General Directory structure: + + components/clm/tools/shared/PTCLM/PTCLMmkdata ----- Main script + components/clm/tools/shared/PTCLM/PTCLM_sitedata - Site data files of + static information latitude, longitude, soil info., and PFT information + for each site Also different "groups" of site-data lists, and the script to + convert the transient years landuse_timeseries files into landuse_timeseries text files that + mksurfdata can use. + components/clm/tools/shared/PTCLM/mydatafiles ----- Default location of + data files that will be created by PTCLMmkdata. Sites will be built + in their own subdirectories under here. Optionally you can give your + own location you'd like to use for your data. + + components/clm/tools/shared/PTCLM/PTCLMsublist --------- Script to submit a list of PTCLM + sites to the batch que (only setup for a few machines). + components/clm/tools/shared/PTCLM/PTCLMsublist_prog.py - Python module to support submit + list script. Handles command line arguments and such. + components/clm/tools/shared/PTCLM/batchque.py ---------- Python module for batch submital. + components/clm/tools/shared/PTCLM/buildtools ----------- Script to build the CLM + tools needed to run PTCLMmkdata (mksurfdata_map both clm4_0 and clm4_5 + versions and gen_domain). Works on yellowstone. + +Quickstart: + +# ASSUMPTIONS: +# For this example I'm running a I1PTCLM45 case on yellowstone using +# CSMDATA in the standard location +# Finally we use the 6-digit AmeriFlux site code for the University of Mich. Biological +# Station US-UMB (data for this station is checked into the inputdata repository). +# I also assume you are using UNIX C-shell, and GNU make is called gmake +setenv CSMDATA /glade/p/cesm/cseg/inputdata +setenv SITE US-UMB + + +cd components/clm/tools/shared/PTCLM +setenv MYDATAFILES `pwd`/mydatafiles + +# Next build all of the clm tools you will need +# The following script assumes yellowstone_intel, for other machines +# you'll need to build each tool by hand +./buildtools +# next run PTCLMmkdata (NOTE -- MAKE SURE python, NCO AND NCL IS IN YOUR PATH) +# NOTE: Every day you run PTCLMmkdata it will remake the map called +# renamemapfiles to rename files with todays creation date. +# This makes running PTCLMmkdata a reasonable amount of time. +# However, you can use the script in mydatafiles +# +./PTCLMmkdata -s $SITE -d $CSMDATA + +# Next copy the towersite meterology datafiles into your $MYDATAFILES space +# (For the US-UMB station you can skip this step as the .build step will bring the data over) +cd $MYDATAFILES/1x1pt_$SITE +mkdir $MYDATAFILES/1x1pt_$SITE/CLM1PT_data +# Copy meteorology data NetCDF files into 1x1pt_$SITE sub-directory +# (with filenames of yyyy-mm.nc) +# The variables assumed to be on the files are: +# ZBOT, TBOT, RH, WIND, PRECTmms, FSDS, PSRF, FLDS +# (if other fields are available or with different names this can be changed by +# adding a user_nl_datm.streams.txt file as we outline below) +# Make sure your data has time with the attribute: calendar="gregorian" + +# Make sure the forcing directory points to the location of your data +# (PTCLMmkdata should already do this) +./xmlchange DIN_LOC_ROOT_CLMFORC=$MYDATAFILES/1x1pt_$SITE + +# Then create a case using the data you just created +setenv MYCASE "testPTCLM" +cd ../../../../../ime/scripts +./create_newcase -user_mods_dir $MYDATAFILES/1x1pt_$SITE -case $MYCASE -res CLM_USRDAT -compset I1PTCLM45 -mach yellowstone_intel + +# Next setup as normal +cd $MYCASE +./cesm_setup + +# If you need to customize your list of fields uncomment and do the following... +# cp CaseDocs/datm.streams.txt.CLM1PT.CLM_USRDAT user_datm.streams.txt.CLM1PT.CLM_USRDAT +# chmod u+w user_datm.streams.txt.CLM1PT.CLM_USRDAT +# $EDITOR user_datm.streams.txt.CLM1PT.CLM_USRDAT +# ./preview_namelists + +# Finally build, and run the case as normal +./$MYCASE.build +./$MYCASE.submit diff --git a/components/clm/tools/shared/PTCLM/batchque.py b/components/clm/tools/shared/PTCLM/batchque.py new file mode 100644 index 0000000000..ac15dc150a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/batchque.py @@ -0,0 +1,250 @@ +######################################################################################### +# +# batchque.py +# +# Python class to handle batch submission of single-processor command-line jobs. +# +######################################################################################### +import os, sys + +class batchque: +#---------------------------------------------------------------------------------------- +# Class to handle batch queue submission +#---------------------------------------------------------------------------------------- + # Class data + setup = False + mach = "" + account = "" + submit = False + jobscript = "" + # + # hash's keyed off the list of machines known + # + # Basic options giving queue name, number of processors (1) and walltime + # yellowstone(LSF): -n 1=1 task, -R=Number of tasks on node, -q=queue name, -N=, -a=process type, -W=wallclock time + # edison/hopper(PBS): -l=tasks, processors per node, and wallclock time, -q=queue name, -V=use ALL env variables, + # -m=mail options (ae send mail on submit and exit) + # -j oe on edison/hopper and -oo on yellowstone (without -e/-eo means combine stderr and stdout + opts = { 'yellowstone':"-n 1 -R 'span[ptile=15]' -q caldera -N -a poe ", \ + 'edison' :"-l nodes=1:ppn=1 -q regular -V -m ae -j oe ", \ + 'hopper' :"-l nodes=1:ppn=1 -q regular -V -m ae -j oe ", \ + 'janus' :"-l nodes=1:ppn=1 -q janus-short -V -m ae -j oe " } + # batch submission command + bsub = { 'yellowstone':"bsub", 'edison':"qsub", 'hopper':"qsub", 'janus':"qsub" } + # Option to give file for standard output + bs_stdout = { 'yellowstone':" -oo ", 'edison':" -o ", 'hopper':" -o ", 'janus':" -o " } + # Option to give job name to use + bs_jobnam = { 'yellowstone':" -J ", 'edison':" -N ", 'hopper':" -N ", 'janus':" -N " } + # Option to give current directory to use + bs_curdir = { 'yellowstone':" -cwd ", 'edison':" -d ", 'hopper':" -d ", 'janus':" -d " } + # Option to give account name to use + bs_accnt = { 'yellowstone':" -P ", 'edison':"", 'hopper':"", 'janus':"" } + # If jobcommand needs to be script file + bs_script = { 'yellowstone':False, 'edison':True, 'hopper':True, 'janus':True } + # Option to give wallclock time to use + bs_wtime = { 'yellowstone':" -W ", 'edison':" -l walltime=", \ + 'hopper':" -l walltime=", 'janus':" -l walltime=" } + + def Initialize( self, prog, mach="yellowstone", account="" ): + "Initialize the batchque" + if ( not self.bsub.has_key(mach) ): + print "List of valid machines: "+str(self.bsub.keys()) + prog.error( "Machine NOT in list of valid machines for batch queue: "+mach ) + + self.mach = mach + if ( self.bs_accnt[mach] == "" and account != "" ): + prog.error( "Account entered but this machine does NOT have an account option: "+mach ) + + self.account = account + + self.setup = True + self.submit = False + + def Get_OutFilename( self, prog ): + "Get the output log filename" + if ( not self.setup ): + prog.error( "Trying to get the output filename and Initialize was NOT run first!" ) + if ( not self.submit ): + prog.error( "Trying to get the output filename and Submit was NOT run first!" ) + + return( self.stdout ) + + def Submit( self, prog, jobcommand, curdir=os.getcwd(), jobname="batchjob", wall="4:00", submit=True ): + "Get the command to submit the job to the batch queue" + if ( not self.setup ): + prog.error( "Initialize was NOT run first!" ) + + if ( not os.path.exists(curdir) ): + prog.error( "Input current directory does NOT exist: "+curdir ) + + cmd = self.bsub[self.mach] + opts = "" + stdout = str(jobname)+".stdout.out" + self.stdout = stdout + opts += self.bs_stdout[self.mach]+stdout+" " + opts += self.bs_jobnam[self.mach]+str(jobname)+" " + opts += self.bs_curdir[self.mach]+curdir+" " + opts += self.bs_wtime[self.mach]+wall+" " + if ( self.account != "" and self.bs_accnt[self.mach] != "" ): + opts += self.bs_accnt[self.mach]+self.account+" " + opts += self.opts[self.mach]+" " + if ( self.bs_script[self.mach] ): + self.jobscript = jobname+".job" + if ( os.path.exists( self.jobscript ) ): + os.system( "/bin/rm -rf "+self.jobscript ) + js = open(self.jobscript,"w") + js.write( jobcommand+"\n" ) + js.close() + os.chmod(self.jobscript,0555) + cmd += " "+opts+self.jobscript + else: + cmd += " "+opts+jobcommand + + if ( os.path.exists( self.stdout ) ): + os.system( "/bin/rm "+self.stdout ) + if ( submit ): + status = os.system( cmd ) + if ( status != 0 ): + prog.error( "Batch submit returns an error" ) + + self.submit = True + + return( cmd ) + + def SubmitCleanup( self, prog, rmout=False ): + "Cleanup any files made in submit and reset output filename -- only DO AFTER BATCH HAS RUN!" + if ( not self.setup ): + prog.error( "Initialize was NOT run first!" ) + if ( not self.submit ): + prog.error( "Submit was NOT run first!" ) + outfile = self.Get_OutFilename( prog ) + if ( not os.path.exists(outfile) ): + prog.error( "SubmitCleanup called before batch output was returned" ) + + if ( self.bs_script[self.mach] ): + os.system( "/bin/rm -rf "+self.jobscript ) + if ( rmout ): + os.system( "/bin/rm "+outfile ) + + self.submit = False + +# +# Unit testing for above classes +# +import unittest + +class error_prog: + def error( self, desc ): + print desc + sys.exit( 100 ) + +class test_batchque(unittest.TestCase): + + def setUp( self ): + "Setup tests" + self.prog = error_prog() + self.que = batchque() + + def test_badinit( self ): + "test bad initialization" + # Bad machine name + self.assertRaises(SystemExit, self.que.Initialize, self.prog, mach="zztop" ) + # account given on machine without account + self.assertRaises(SystemExit, self.que.Initialize, self.prog, mach="edison", account="thing" ) + # test using submit and Get_OutFilename before Initialization + self.assertRaises(SystemExit, self.que.Submit, self.prog, "ls" ) + self.assertRaises(SystemExit, self.que.Get_OutFilename, self.prog ) + # Test that all hashes have the same list of keys + keylist = str(self.que.opts.keys()) + self.assertTrue(keylist == str(self.que.bsub.keys()) ) + self.assertTrue(keylist == str(self.que.bs_stdout.keys()) ) + self.assertTrue(keylist == str(self.que.bs_jobnam.keys()) ) + self.assertTrue(keylist == str(self.que.bs_accnt.keys()) ) + self.assertTrue(keylist == str(self.que.bs_curdir.keys()) ) + + def test_init( self ): + "test initialization and submit" + + machlist = self.que.opts.keys() + for mach in machlist: + print "Test initialization for: "+mach + self.que.Initialize( self.prog, mach=mach ) + cmd = self.que.Submit( self.prog, "ls", jobname=mach, submit=False ) + print cmd+"\n" + outfile = self.que.Get_OutFilename( self.prog ) + os.system( "touch "+outfile ) + self.que.SubmitCleanup( self.prog, rmout=True ) + + mach = "yellowstone" + self.que.Initialize( self.prog, mach=mach, account="account" ) + cmd = self.que.Submit( self.prog, "ls", jobname=mach, submit=False ) + print cmd+"\n" + outfile = self.que.Get_OutFilename( self.prog ) + os.system( "touch "+outfile ) + print "outfile: "+outfile + self.que.SubmitCleanup( self.prog, rmout=True ) + + def test_bad_submit( self ): + "test bad submit" + mach = "yellowstone" + self.que.Initialize( self.prog, mach=mach, account="account" ) + self.assertRaises(SystemExit, self.que.Submit, self.prog, "ls", curdir="zztop", jobname=mach, submit=False ) + self.assertRaises(SystemExit, self.que.Get_OutFilename, self.prog ) + + def test_submit( self ): + "test submitting to local machine if on list" + stdout = os.popen("hostname") + host = stdout.read().rstrip( ) + startname = { 'ys':'yellowstone', 'edison':'edison', 'hopper':'hopper', 'login':'janus' } + mach = "" + for sname in startname: + if ( host.startswith(sname) ): + mach = startname[sname] + if ( mach != "" ): + if ( mach == "yellowstone" ): + account = "P93300606" + else: + account = "" + self.que.Initialize( self.prog, mach=mach, account=account ) + else: + print "Machine not known, so NOT trying a test submit" + return + + print "Submit ls to batch queue" + # Submit and get the output filename + scmd = "ls PTCLMmkdata" + wall = "0:01" + cmd = self.que.Submit( self.prog, scmd, jobname=mach, wall=wall, submit=False ) + print "submit: "+cmd + outfile = self.que.Get_OutFilename( self.prog ) + # make sure SubmitCleanup will fail since it wasn't submitted yet and output not returned + self.assertRaises(SystemExit, self.que.SubmitCleanup, self.prog ) + status = os.system( cmd ) + self.assertTrue( status == 0 ) + iter = 0 + exists = os.path.exists(outfile) + while( status == 0 and iter < 100 and not exists ): + iter += 1 + exists = os.path.exists(outfile) + if ( not exists ): + print "Sleep for a bit to check if outfile was created yet" + os.system( "sleep 20" ) + else: + print "Out file created cat it... should be ls of PTCLMmkdata" + self.assertTrue( os.path.exists(outfile) ) + os.system( "cat "+outfile ) + + # Cleanup after the submital + self.que.SubmitCleanup( self.prog, rmout=True ) + + # make sure files were deleted and submit status changed + self.assertTrue( not self.que.submit ) + self.assertRaises(SystemExit, self.que.Get_OutFilename, self.prog ) + self.assertTrue( not os.path.exists(outfile) ) + if ( self.que.jobscript != "" ): + self.assertTrue( not os.path.exists(self.que.jobscript) ) + # Now test that a bad submit returns an error (give bad walltime) + self.assertRaises(SystemExit, self.que.Submit, self.prog, scmd, jobname=mach, wall="--zztop" ) + +if __name__ == '__main__': + unittest.main() diff --git a/components/clm/tools/shared/PTCLM/buildtools b/components/clm/tools/shared/PTCLM/buildtools new file mode 100755 index 0000000000..c1c3693382 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/buildtools @@ -0,0 +1,131 @@ +#!/bin/bash +# +# buildtools +# +# Build the clm tools that PTCLM will need to run when creating files. +# +# Environment variables to set: +# +# CESM_ROOT: To build with a separate root to CLM/CESM code set the +# env variable CESM_ROOT to the root directory to use. +# + +pwd=`pwd` +host=`hostname` +echo "Build clm tools for PTCLM on "$host"" + +# +# Get path to root +# +if [ -z "$CESM_ROOT" ]; then + cd "../../../../.." + CESM_ROOT=`pwd` + cd - +fi +if [ ! -d "$CESM_ROOT" ];then + echo "Directory $CESM_ROOT does not exist" + echo "Set env variable CESM_ROOT" + exit -1 +fi +# +# Machine dependent stuff +# +toolsmake="" +if [[ "$host" =~ ys ]] || [[ "$host" =~ caldera ]] || [[ "host" =~ geyser ]]; then + echo "Setup for yellowstone" + module load netcdf/4.3.0 + module load ncl + gmake="gmake" + parcmp=32 + machine="yellowstone" + compiler="intel" + netcdf=$NETCDF +elif [[ "$host" =~ hobart ]]; then + echo "Setup for hobart" + gmake="gmake" + parcmp=2 + machine="hobart" + compiler="intel" + module load compiler/intel + netcdf=$NETCDF_PATH + export PATH="${PATH}:/usr/bin" +elif [[ "$host" =~ yongi ]] || [[ "$host" =~ vpn ]]; then + echo "Setup for yongi" + gmake="make" + parcmp=12 + machine="userdefined" + compiler="intel" + netcdf="/opt/local" + toolsmake="USER_FC=ifort USER_LINKER=ifort USER_CC=icc " + case='$CASE' + export NETCDF_PATH=$netcdf +elif [[ "$host" =~ hopper ]]; then + echo "Setup for hopper" + . /opt/modules/default/init/bash + module load netcdf + module load ncl/6.1.2 + gmake="gmake" + parcmp=32 + machine="hopper" + compiler="pgi" + USER_LDFLAGS="-L$NETCDF_DIR/lib -lnetcdff" + export USER_LDFLAGS + toolsmake="USER_FC=pgf90" + netcdf=$NETCDF_DIR +elif [[ "$host" =~ edison ]]; then + echo "Setup for edison" + . /opt/modules/default/init/bash + module load netcdf + module load ncl + gmake="gmake" + parcmp=32 + machine="edison" + compiler="intel" + USER_LDFLAGS="-L$LIB_NETCDF -lnetcdff" + export USER_LDFLAGS + toolsmake="USER_FC=ftn" + netcdf=$NETCDF_DIR +else + echo "Bad host to run on: know about yellowstone, hobart, hopper, edison or yongi" + exit -3 +fi +export INC_NETCDF=${netcdf}/include +export LIB_NETCDF=${netcdf}/lib +# +# Build the tools +# +echo "Build the tools" +dirs=( \ + $CESM_ROOT/components/clm/tools/clm4_0/mksurfdata_map/src \ + $CESM_ROOT/components/clm/tools/clm4_5/mksurfdata_map/src \ + $CESM_ROOT/cime/tools/mapping/gen_domain_files/src \ + ) +for dir in ${dirs[*]}; do + echo "Build in $dir" + cd $dir + if [[ "$dir" =~ gen_domain ]]; then + export CIMEROOT=$CESM_ROOT/cime + cmd="$CESM_ROOT/cime/machines/configure -cimeroot $CIMEROOT -mach $machine -compiler $compiler" + echo "$cmd" + $cmd + if [ $? != 0 ]; then + echo "Problem with configure: $?" + exit -1 + fi + fi + $gmake clean + cmd="$gmake OPT=TRUE SMP=TRUE -j $parcmp $toolsmake" + echo "$cmd" + $cmd + if [ $? != 0 ]; then + echo "Problem with build: $?" + exit -1 + fi + if [[ "$dir" =~ gen_domain ]]; then + /bin/rm *.o + else + $gmake clean + fi +done + +echo -e "\n\nSuccessfully built CLM tools needed to create datasets for PTCLM\n" diff --git a/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/README.PTCLM b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/README.PTCLM new file mode 100644 index 0000000000..93414c6294 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata -d /glade/p/cesmdata/cseg/inputdata -s US-UMB --clmnmlusecase=20thC_transient --debug --cesm_root ../../../../../.. diff --git a/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/user_nl_clm b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/user_nl_clm new file mode 100644 index 0000000000..d297b0017e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/user_nl_clm @@ -0,0 +1,2 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata -d /glade/p/cesmdata/cseg/inputdata -s US-UMB --clmnmlusecase=20thC_transient --debug --cesm_root ../../../../../.. diff --git a/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/xmlchange_cmnds b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/xmlchange_cmnds new file mode 100755 index 0000000000..5ab4fff2c9 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/mydatafiles/1x1pt_US-UMB/xmlchange_cmnds @@ -0,0 +1,7 @@ +# xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata -d /glade/p/cesmdata/cseg/inputdata -s US-UMB --clmnmlusecase=20thC_transient --debug --cesm_root ../../../../../.. +./xmlchange CLM_USRDAT_NAME=1x1pt_US-UMB +./xmlchange DATM_CLMNCEP_YR_START=1999 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial diff --git a/components/clm/tools/shared/PTCLM/mydatafiles/README b/components/clm/tools/shared/PTCLM/mydatafiles/README new file mode 100644 index 0000000000..97cd12548a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/mydatafiles/README @@ -0,0 +1,14 @@ +PTCLM/mydatafiles/README 11/22/2013 + +Sample data files directory for PTCLM. PTCLM will create directories +under here as 1x1pt_$SITE where $SITE is the site-code. You need +to put your meteorology data under the 1x1pt_$SITE directory in +a sub-directory called: CLM1PT_data. + +The script renamemapfiles is to rename mapping files with the current +creation date, so that PTCLM will not have to remake all of the mapping +files. + +For example: + +./renamemapfiles -oldate 131122 -newdate 131225 diff --git a/components/clm/tools/shared/PTCLM/mydatafiles/renamemapfiles b/components/clm/tools/shared/PTCLM/mydatafiles/renamemapfiles new file mode 100755 index 0000000000..ef11d77243 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/mydatafiles/renamemapfiles @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +# +# rename map files from one date to another date. +# +use strict; +use Getopt::Long; + +sub usage { + die < New creation date string to use + -oldate Old creation date on files to rename +EOF +} +my %opts = ( oldate => "130927", + newdate => "130928", + ); +GetOptions( + "o|oldate=s" => \$opts{'oldate'}, + "n|newdate=s" => \$opts{'newdate'}, +) or usage(); + +# Give usage message. +usage() if $opts{'help'}; +# +# Check for unparsed arguments +# +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +my $wildcard = "map_*_c".$opts{'oldate'}.".nc"; +my @files = glob($wildcard); +print @files; + +foreach my $file ( @files ) { + if ( $file =~ /^(map_.+)_c([0-9]+)\.nc$/ ) { + my $newfile = "${1}_c".$opts{'newdate'}.".nc"; + my $cmd = "mv $file $newfile"; + print "$cmd\n"; + system( $cmd ); + } +} diff --git a/components/clm/tools/shared/PTCLM/test/PTCLMtesting_prog.py b/components/clm/tools/shared/PTCLM/test/PTCLMtesting_prog.py new file mode 100644 index 0000000000..c431b02832 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/PTCLMtesting_prog.py @@ -0,0 +1,166 @@ +######################################################################################### +# +# PTCLMtesting_prog +# +# Top level class to define the PTCLMtesting program. Parse's arguments and has Init, +# run, and final methods to setup, execute, and then display test results. +# +######################################################################################### +from PTCLMtestlist import PTCLMtestlist +import os, sys + +class PTCLMtesting_prog: +#---------------------------------------------------------------------------------------- +# Class to handle command line input to the program +#---------------------------------------------------------------------------------------- + # Class data + name = "PTCLMtesting" + cmdline = "" + redo_compare = False + cesmdir_def = "../../../../../.." + cesmdir = os.getenv("CESM_ROOT", cesmdir_def ) + parse_args = False + setup = False + n_tests = {} + testlist = PTCLMtestlist() + + # -- Error function --------------------------------- + def error( self, desc ): + "error function to abort with a message" + print "ERROR("+self.name+"):: "+desc + sys.exit(100) + + def parse_cmdline_args( self ): + "Parse the command line arguments for the PTCLM testing script" + from optparse import OptionParser, OptionGroup + + for arg in sys.argv: + self.cmdline = self.cmdline+arg+" " + parser = OptionParser( usage="%prog [options]" ) + options = OptionGroup( parser, "Options" ) + options.add_option("-r", "--cesm_root", dest="cesm_root", default=self.cesmdir, \ + help="Location of CESM root directory (also set with CESM_ROOT env variable)") + options.add_option("--redo_compare_files", dest="redo_compare", action="store_true", default=self.redo_compare, \ + help="Redo the compare files") + parser.add_option_group(options) + svnurl = '$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_150826/test/PTCLMtesting_prog.py $' + versiongroup = OptionGroup( parser, "Version Id: $Id: PTCLMtesting_prog.py 69850 2015-04-09 22:00:22Z erik $ URL: "+svnurl ) + parser.add_option_group(versiongroup) + (options, args) = parser.parse_args() + if len(args) != 0: + parser.error("incorrect number of arguments") + + self.redo_compare = options.redo_compare + self.cesmdir = options.cesm_root + self.parse_args = True + + def redo_compare_files( self ): + "Check if should redo the comparison files" + + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + return( self.redo_compare ) + + def cesm_root( self ): + "Return the CESM_ROOT directory" + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + return( self.cesmdir ) + + def Initialize( self ): + "Initialize the PTCLM tests" + if ( not self.parse_args ): + self.error( "parse_cmdline_args was NOT run first" ) + self.testlist.Setup(self.cesm_root()) + self.testlist.Read() + + + self.n_tests['PASS'] = 0; + self.n_tests['FAIL'] = 0; + + self.n_tests['PASS-COMP'] = 0; + self.n_tests['FAIL-COMP'] = 0; + self.n_tests['NO-COMPS-DONE'] = 0; + self.itest = 0 + self.setup = True + + def Run( self ): + "Run the testing" + if ( not self.setup ): + self.error( "Initialize was NOT run first" ) + for test in self.testlist.get_testlist(): + self.itest += 1 + (stat,comp) = self.testlist.run_PTCLMtest( test, self.redo_compare_files() ) + self.n_tests[stat] += 1 + if ( comp == "PASS" ): self.n_tests['PASS-COMP'] += 1 + elif ( comp == "NO-COMPS-DONE" ): self.n_tests[comp] += 1 + else: self.n_tests['FAIL-COMP'] += 1 + + for test in self.testlist.get_failtestlist(): + self.itest += 1 + (stat,comp) = self.testlist.run_PTCLMtest( test, self.redo_compare_files() ) + self.n_tests[stat] += 1 + if ( comp == "PASS" ): self.n_tests['PASS-COMP'] += 1 + elif ( comp == "NO-COMPS-DONE" ): self.n_tests[comp] += 1 + else: self.n_tests['FAIL-COMP'] += 1 + + + def Finalize( self ): + "Finalize and print out results" + if ( not self.setup ): + self.error( "Initialize was NOT run first" ) + print "Total number of tests = "+str(self.itest) + print "Number of tests that PASS = "+str(self.n_tests['PASS']) + print "Number of tests that Fail = "+str(self.n_tests['FAIL']) + print "Number of compare tests that PASS = "+str(self.n_tests['PASS-COMP']) + print "Number of compare tests that Fail = "+str(self.n_tests['FAIL-COMP']) + print "Number of tests without compare = "+str(self.n_tests['NO-COMPS-DONE']) + + +# +# Unit testing for above classes +# +import unittest + +class test_PTCLMtesting_prog(unittest.TestCase): + + def setUp( self ): + self.prog = PTCLMtesting_prog() + + def test_badinit( self ): + # Bad option will fail + sys.argv[1:] = [ "--zztop" ] + self.assertRaises(SystemExit, self.prog.parse_cmdline_args ) + # Test that doing stuff before parse_args fails + self.prog = PTCLMtesting_prog() + self.assertRaises(SystemExit, self.prog.redo_compare_files ) + self.assertRaises(SystemExit, self.prog.cesm_root ) + self.assertRaises(SystemExit, self.prog.Initialize ) + self.assertRaises(SystemExit, self.prog.Run ) + self.assertRaises(SystemExit, self.prog.Finalize ) + # Test that doing stuff after parse_args before Initialize fails + sys.argv[1:] = [ ] + self.prog.parse_cmdline_args( ) + self.assertRaises(SystemExit, self.prog.Run ) + self.assertRaises(SystemExit, self.prog.Finalize ) + + def test_init( self ): + # check that setting redo_compare_files works + sys.argv[1:] = [ ] + self.prog.parse_cmdline_args( ) + self.assertFalse( self.prog.redo_compare_files( ) ) + sys.argv[1:] = [ "--redo_compare_files" ] + self.prog.parse_cmdline_args( ) + self.assertTrue( self.prog.redo_compare_files( ) ) + # check that setting cesm_root works + sys.argv[1:] = [ ] + self.prog.parse_cmdline_args( ) + cesmdir_def = os.getenv("CESM_ROOT", self.prog.cesmdir_def ) + self.assertTrue( self.prog.cesm_root( ) == cesmdir_def ) + checkstring = "A_string_to_check_to_make_sure_this_works" + sys.argv[1:] = [ "--cesm_root", checkstring ] + self.prog.parse_cmdline_args( ) + self.assertTrue( self.prog.cesm_root( ) == checkstring ) + +if __name__ == '__main__': + unittest.main() diff --git a/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.py b/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.py new file mode 100644 index 0000000000..047a7353b6 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.py @@ -0,0 +1,250 @@ +#---------------------------------------------------------------------------------- +# Class to read in a test list XML file for PTCLM +#---------------------------------------------------------------------------------- +from xml.sax.handler import ContentHandler +class PTCLMtestlistXML( ContentHandler ): + + def startDocument(self): + self.testlist = []; + self.failtestlist = []; + + def startElement(self, name, attrs): + + attributes = [ 'id', 'type', 'site', 'opts', 'resultfile', 'compdir' ] + testmap = {} + for key in attributes: + testmap[key] = str( attrs.get(key,"") ) + + if name == 'test': + for test in self.testlist: + if ( testmap['compdir'] != "" and testmap['compdir'] == test['compdir'] ): + print "compdir is repeated: "+test['compdir'] + sys.exit(100) + if ( testmap['id'] == test['id'] and testmap['site'] == test['site']): + print "id and site is duplicated: "+test['id']+" "+test['site'] + sys.exit(100) + + self.testlist.append( testmap ) + + if name == 'failtest': + self.failtestlist.append( testmap ) + +#---------------------------------------------------------------------------------- +# Class to read in a test list for PTCLM and do operations on it +#---------------------------------------------------------------------------------- +from xml.sax import make_parser +import os +import sys +class PTCLMtestlist: + # Class data + testlist = "PTCLMtestlist.xml" + testing_dir = "testing_dir" + inputdatadir = "/glade/p/cesmdata/cseg/inputdata" + + # Construct the class + def Setup( self, cesmdir ): + self.testXML = make_parser() + self.xml = PTCLMtestlistXML() + self.testXML.setContentHandler(self.xml) + # Get the CLM root directory + self.cesmdir = cesmdir + if ( not os.path.exists(self.cesmdir) or not os.path.isdir(self.cesmdir) or not os.path.exists(self.cesmdir+"/ChangeLog") ): + self.error("CESM_ROOT does NOT exist or NOT a directory (set with CESM_ROOT env variable):"+self.cesmdir) + + # Set the input-dir + def SetDataDir( self, inputdatadir ): + self.inputdatadir = inputdatadir + if ( not os.path.exists(self.inputdatadir) or \ + not os.path.isdir(self.inputdatadir) ): + self.error("Inputdatadir does NOT exist or NOT a directory:"+self.inputdatadir) + + # Read in the testlist file + def Read( self ): + if ( not os.path.exists( self.testlist) ): self.error("File does NOT exist:"+self.testlist) + print "Open file: "+self.testlist + self.testXML.parse( self.testlist ) + + # -- Error function --------------------------------- + def error( self, desc ): + "error function" + print "ERROR(PTCLMtestlist):: "+desc + sys.exit(100) + + # Get the list of tests to do + def get_testlist( self ): + return( self.xml.testlist ) + + # Get the list of fail tests to do + def get_failtestlist( self ): + return( self.xml.failtestlist ) + + # Get an Identifier name for this test + def get_testID( self, test ): + tid = "" + for att in ["id","opts","site"]: + val = test[att].replace(" ","+") + if ( val != "" ): + tid = tid + val + "." + + return( tid ) + + # Fail test or not... + def IsNOTFailTest( self, test ): + if ( test['type'] != "Fail" ): + return( True ) + else: + return( False ) + + # Get the PTCLM command line options to use + def get_PTCLMoptions( self, test ): + opts = test['opts'] + opts = opts + " --cesm_root "+self.cesmdir + if ( self.IsNOTFailTest( test ) ): + opts = opts + " -s " + test['site'] + opts = opts + " -d "+self.inputdatadir + opts = opts + " --debug" + opts = opts + " --sdate 140204" + opts = opts + " --map_gdate 140204" + if ( test['type'] == "RUN" ): + opts = opts + " --mydatadir "+self.testing_dir+"/"+test['id'] + + + return( opts ) + + # run the test + def run_PTCLMtest( self, test, redo_comp_files ): + opts = self.get_PTCLMoptions( test ) + tid = self.get_testID( test ) + tlog = "run.log" + if ( self.IsNOTFailTest( test ) ): + errcode = os.system( "../PTCLMmkdata "+opts+" > "+tlog ) + else: + errcode = os.system( "../PTCLMmkdata "+opts ) + if ( errcode == 0 ): + stat = True + else: + stat = False + + teststatus = "" + if ( stat == self.IsNOTFailTest( test ) ): + teststatus = "PASS" + else: + teststatus = "FAIL" + + print teststatus+" "+tid + + overallcompstatus = "NO-COMPS-DONE" + if ( test['resultfile'] != "" ): + dstat = os.system( "diff "+tlog+" "+test['resultfile'] ) + if ( dstat == 0 ): + compstatus = "PASS" + desc = " compare to result file" + else: + compstatus = "FAIL-COMP" + desc = " different from result file: "+test['resultfile'] + + if ( redo_comp_files ): + if ( not os.path.exists( test['resultfile'] ) ): + cmd = "mkdir "+os.path.dirname(test['resultfile']) + print "Create new file directory that does NOT exist\n" + print cmd+"\n"; + os.system( cmd ) + os.system( "cp "+tlog+" "+test['resultfile'] ) + overallcompstatus = compstatus + + print compstatus+" "+tid+" "+desc + + if ( test['compdir'] != "" ): + testdir = os.path.abspath(self.testing_dir)+"/"+test['id'] + stdout = os.popen("cd "+testdir+"/*"+test['site']+"; pwd") + testdir = os.path.abspath( stdout.read().rstrip( ) ) + os.system( "mv "+tlog+" "+testdir ) + filelist = ["README.PTCLM", tlog, "user_nl_clm", "shell_commands" ] + for file in filelist: + srcfile = testdir+"/"+file + cmpfile = "compdirs/"+test['compdir']+"/"+file + if ( not os.path.exists( srcfile ) ): + compstatus = "FAIL-DNE" + desc = "source compare file does NOT exist: "+srcfile + elif ( not os.path.exists( cmpfile ) ): + compstatus = "BFAIL" + desc = "compare file does NOT exist: "+cmpfile + else: + dstat = os.system( "diff "+srcfile+" "+cmpfile ) + + if ( dstat == 0 ): + compstatus = "PASS" + desc = "same as comp directory file: "+cmpfile + else: + compstatus = "FAIL-COMP" + desc = "different from comp directory file: "+cmpfile + + if ( redo_comp_files ): + if ( not os.path.exists( cmpfile ) ): + cmd = "mkdir "+os.path.dirname(cmpfile) + print "Create new file directory that does NOT exist\n" + print cmd+"\n"; + os.system( cmd ) + os.system( "cp "+srcfile+" "+cmpfile ) + + if ( overallcompstatus == "PASS" or overallcompstatus == "NO-COMPS-DONE" ): overallcompstatus = compstatus + + print compstatus+" "+tid+" "+desc+" "+file + + if ( teststatus == "PASS" and overallcompstatus == "PASS" and os.path.exists( tlog ) ): + os.system( "/bin/rm "+tlog ) + + return( [teststatus, overallcompstatus] ) +# +# Unit testing for above classes +# +import unittest + +class test_PTCLMtestlist(unittest.TestCase): + + def setUp( self ): + self.test = PTCLMtestlist() + cesmdir = os.getenv("CESM_ROOT", "../../../../../..") + if ( not os.path.exists( cesmdir+"/ChangeLog" ) ): + print "CESM_ROOT NOT input\n" + sys.exit( 200 ) + + self.test.Setup(cesmdir) + + def test_read( self ): + inpd_orig = self.test.inputdatadir + self.assertRaises(SystemExit, self.test.SetDataDir, "nodir" ) + self.assertRaises(SystemExit, self.test.SetDataDir, "PTCLMtestlist.py" ) + self.test.Read() + self.test.SetDataDir( inpd_orig ) + self.test.Read() + print "\nValid Tests: " + for test in self.test.get_testlist(): + print str(test) + self.assertTrue( self.test.IsNOTFailTest( test ) ) + print "\n\n"; + print "\nValid Fail Tests: " + for test in self.test.get_failtestlist(): + print str(test) + self.assertTrue( not self.test.IsNOTFailTest( test ) ) + print "\n\n"; + + def test_getopts( self ): + self.test.Read() + for test in self.test.get_testlist(): + print self.test.get_testID( test )+" = "+ self.test.get_PTCLMoptions( test ) + + for test in self.test.get_failtestlist(): + print self.test.get_testID( test )+" = "+ self.test.get_PTCLMoptions( test ) + + def test_run( self ): + self.test.Read() + testlist = self.test.get_testlist() + failtestlist = self.test.get_failtestlist() + + self.test.run_PTCLMtest( testlist[0], False ) + self.test.run_PTCLMtest( testlist[5], False ) + self.test.run_PTCLMtest( failtestlist[0], False ) + +if __name__ == '__main__': + unittest.main() diff --git a/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.xml b/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.xml new file mode 100644 index 0000000000..5c7bbdf777 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/PTCLMtestlist.xml @@ -0,0 +1,128 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/clm/tools/shared/PTCLM/test/README b/components/clm/tools/shared/PTCLM/test/README new file mode 100644 index 0000000000..6b54186917 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/README @@ -0,0 +1,112 @@ +PTCLM/test/README 02/04/2014 + Erik Kluzek + +Information on the PTCLM test system. + +I. Synopsis: + +This directory runs testing to make sure PTCLM works as expected. +It runs a series of tests for PTCLMmkdata described in a XML file +that gives the arguments to run. Some of the results are compared to +files created previously. An issue with the comparison is that file +creation dates are often in files and so a change in date will show +up as a "compare.Fail". The testing also runs using the "--debug" +flag so that the logic of PTCLMmkdata will be tested, but it won't +actually create files which would take an enourmous amount of time +(more than 6-days for the current test list). + +II. Description of files: + +README ------------------- This file + +listings/ ---------------- Sub directory with results for "list" options +compdirs/ ---------------- Comparison directory +testing_dir/ ------------- Testing directory that will be created when tests run + +PTCLMtesting_prog.py ----- Top level Python class for run script +PTCLMtestlist.py --------- Python class that reads in the test list and has + methods to run and execute PTCLMmkdata. + +PTCLMtestlist.xml -------- XML file that describes the tests + +run_PTCLM_tests ---------- Main script that runs the tests + +III. Running the tests: + +To run the tests when PTCLM is part of a CLM or CESM distribution you simply +execute the script: + +./run_PTCLM_tests + +To run whenen PTCLM is checked out seperately you need to tell it where your "CESM_ROOT" +directory is. You can do this by either setting the CESM_ROOT environment variable or use +the "--cesm_root" option to run_PTCLM_tests. + +So for example... + +./run_PTCLM_tests --cesm_root $HOME/clm4_5_99 + +IV. Test results: + +Each test will give a PASS or Fail status as the first part of standard output. Compare tests will +either report a PASS or a "compare.Fail" status. The final summary at the end is something like this... + + +Total number of tests = 51 +Number of tests that PASS = 51 +Number of tests that Fail = 0 +Number of compare tests that Fail = 44 +Number of compare tests that PASS = 0 +Number of tests without compare = 7 + + +So all the test PASS, none fail. 44 tests fail their comparison, and 7 tests don't have a comparison. + +V. Unit testing the Python code: + +The python *.py files are setup so they can be unit-tested by running through python. So... + +python PTCLMtestlist.py + +(and use python -m pdb PTCLMtestlist.py to run the interactive python debugger) +will unit-test the PTCLMtestlist.py python code (you need to set the env variable CESM_ROOT if you aren't +in the right directory to do this). Successful results look something like... + +e name: test + +Root CLM directory: /Users/erik/clm_transCO2 +** Surface data file will be built using site-level data when available unless otherwise specified ** + + Extract PFT data from gridded files: False + Extract soil data from gridded files: False + +Open Site data file: /Users/erik/PTCLM_trunk/PTCLM_sitedata/PTCLMDATA_sitedata.txt + +Usage: PTCLMmkdata [options] -d inputdatadir -s sitename + +PTCLMmkdata: error: Entered site is NOT in the list of valid sites: test +PASS fail-no-datadir.-s+test. +. +---------------------------------------------------------------------- +Ran 3 tests in 21.021s + +OK + + +testing with fails will look something like... + +.Open file: PTCLMtestlist.xml +E +====================================================================== +ERROR: test_run (__main__.test_PTCLMtestlist) +---------------------------------------------------------------------- +Traceback (most recent call last): + File "PTCLMtestlist.py", line 224, in test_run + self.test.run_PTCLMtest( testlist[0] ) +TypeError: run_PTCLMtest() takes exactly 3 arguments (2 given) + +---------------------------------------------------------------------- +Ran 3 tests in 0.059s + +FAILED (errors=1) + diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/copyfiles.csh b/components/clm/tools/shared/PTCLM/test/compdirs/copyfiles.csh new file mode 100755 index 0000000000..b346553faf --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/copyfiles.csh @@ -0,0 +1,17 @@ +#!/bin/csh -f +# +# This script is for initially populating a list of new sites +# +set sites = ( TS-Ts1/ TS-Ts2/ TS-Ts3/ US-CHATS/ CA-Let/ CA-Man/ US-WCr/ CA-Ca1/ CA-Obs/ CA-Ojp/ US-Dk2/ US-Dk3/ US-Me4/ CA-Qfo/ US-Me/ US-MOz/ BE-Vie/ BR-Sa3/ DE_Tha/ ES-ES1/ FL-Hyy/ FL-Kaa/ IT-Col/ IT-Cpz/ US-FPe/ US-NR1/ US-0Brw/ US-ARM/ US-Var/ US-Bo1/ US-Ho1/ US-MMS/ BR-Sa1/ CA-Oas/ US-Ne3/ ) +foreach site( $sites ) + echo $site + set dir = `ls -1d *$site` + echo "dir = $dir" + set copydir=`ls -qd ../testing_dir/*/1x1pt_$site` + echo "copydir = $copydir" + \cp $copydir/README.PTCLM $dir + \cp $copydir/*.log $dir + rm $copydir/surf*.log + \cp $copydir/user_nl_clm $dir + \cp $copydir/xmlchange_cmnds $dir +end diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/README.PTCLM new file mode 100644 index 0000000000..ec9fac6bd7 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --mksurfdata_opts=-crop -hirespft --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/croppft_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/shell_commands new file mode 100755 index 0000000000..964b8d762c --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --mksurfdata_opts=-crop -hirespft --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/croppft_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-IB1 +./xmlchange DATM_CLMNCEP_YR_START=2005 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/croppft_file_creation/1x1pt_US-IB1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/croppft_file_creation/1x1pt_US-IB1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-IB1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-IB1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2005-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2005 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/croppft_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/user_nl_clm new file mode 100644 index 0000000000..b6c13d7805 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/crop_US-IB1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --mksurfdata_opts=-crop -hirespft --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/croppft_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/croppft_file_creation/1x1pt_US-IB1/surfdata_1x1pt_US-IB1_simyr2000_clm4_5_pftgrd_-crop+-hirespft_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/README.PTCLM new file mode 100644 index 0000000000..0ec3c6f572 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling__file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/shell_commands new file mode 100755 index 0000000000..e6d5fed8a2 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling__file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_TS-Ts1 +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2001 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling__file_creation/1x1pt_TS-Ts1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling__file_creation/1x1pt_TS-Ts1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling__file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/user_nl_clm new file mode 100644 index 0000000000..485fb18c5e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling__file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling__file_creation/1x1pt_TS-Ts1/surfdata_1x1pt_TS-Ts1_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/README.PTCLM new file mode 100644 index 0000000000..acbdf26bec --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/shell_commands new file mode 100755 index 0000000000..c4dfeb53dd --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_TS-Ts2 +./xmlchange DATM_CLMNCEP_YR_START=2004 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts2 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts2 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts2_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts2_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2005-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2005 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/user_nl_clm new file mode 100644 index 0000000000..8b42a466c1 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts2/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts2/surfdata_1x1pt_TS-Ts2_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/README.PTCLM new file mode 100644 index 0000000000..57b8254262 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/shell_commands new file mode 100755 index 0000000000..cd16b2ca50 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_TS-Ts3 +./xmlchange DATM_CLMNCEP_YR_START=2004 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts3 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts3 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts3_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_TS-Ts3_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2005-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2005 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/user_nl_clm new file mode 100644 index 0000000000..e35e95c05a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/cyc_TS-Ts3/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s TS-Ts3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cycling_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cycling_file_creation/1x1pt_TS-Ts3/surfdata_1x1pt_TS-Ts3_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/README.PTCLM new file mode 100644 index 0000000000..f24fdbe22a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --pftgrid --soilgrid --verbose --donot_use_tower_yrs --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/global_surfdata_create diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/shell_commands new file mode 100755 index 0000000000..3cd3abeff1 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/shell_commands @@ -0,0 +1,14 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --pftgrid --soilgrid --verbose --donot_use_tower_yrs --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/global_surfdata_create +./xmlchange CLM_USRDAT_NAME=1x1pt_US-UMB +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/global_surfdata_create/1x1pt_US-UMB +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/global_surfdata_create/1x1pt_US-UMB +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/global_surfdata_create diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/user_nl_clm new file mode 100644 index 0000000000..d61cc31b89 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/global_US-UMB/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --pftgrid --soilgrid --verbose --donot_use_tower_yrs --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/global_surfdata_create + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/global_surfdata_create/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr1850_clm4_5_pftgrd_soigrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/global_surfdata_create/1x1pt_US-UMB/landuse.timeseries1x1pt_US-UMB_hist_simyr1850-2005_clm4_5_pftgrd_soigrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/README.PTCLM new file mode 100644 index 0000000000..e891a66375 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --cesm_root ../../../../../.. -s US-CHATS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/noopt_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/shell_commands new file mode 100755 index 0000000000..01639c1306 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --cesm_root ../../../../../.. -s US-CHATS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/noopt_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-CHATS +./xmlchange DATM_CLMNCEP_YR_START=2007 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/noopt_file_creation/1x1pt_US-CHATS +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/noopt_file_creation/1x1pt_US-CHATS +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-CHATS_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-CHATS_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2007-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2007 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/noopt_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/user_nl_clm new file mode 100644 index 0000000000..1a4460386f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/noopt_US-CHATS/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --cesm_root ../../../../../.. -s US-CHATS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/noopt_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/noopt_file_creation/1x1pt_US-CHATS/surfdata_1x1pt_US-CHATS_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/README.PTCLM new file mode 100644 index 0000000000..92e5b37d32 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Let -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/shell_commands new file mode 100755 index 0000000000..15b4c0aa93 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/shell_commands @@ -0,0 +1,14 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Let -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Let +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Let +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Let +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Let_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Let_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/user_nl_clm new file mode 100644 index 0000000000..423c7a4336 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Let/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Let -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Let/surfdata_1x1pt_CA-Let_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/README.PTCLM new file mode 100644 index 0000000000..0b5f229bb9 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Man -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/shell_commands new file mode 100755 index 0000000000..845e717f9d --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/shell_commands @@ -0,0 +1,14 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Man -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Man +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Man +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Man +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Man_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Man_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/user_nl_clm new file mode 100644 index 0000000000..6b12f56db5 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_CA-Man/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s CA-Man -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_CA-Man/surfdata_1x1pt_CA-Man_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/README.PTCLM new file mode 100644 index 0000000000..2e19a9b93f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s US-WCr -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/shell_commands new file mode 100755 index 0000000000..7509de2889 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/shell_commands @@ -0,0 +1,14 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s US-WCr -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-WCr +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_US-WCr +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_US-WCr +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-WCr_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-WCr_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/user_nl_clm new file mode 100644 index 0000000000..02b430fbeb --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/notowyrs_US-WCr/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --donot_use_tower_yrs --cesm_root ../../../../../.. -s US-WCr -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/notower_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/notower_file_creation/1x1pt_US-WCr/surfdata_1x1pt_US-WCr_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/README.PTCLM new file mode 100644 index 0000000000..8f5534463d --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Ca1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/shell_commands new file mode 100755 index 0000000000..58f5df1496 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Ca1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Ca1 +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Ca1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Ca1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Ca1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Ca1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/user_nl_clm new file mode 100644 index 0000000000..42b53a4927 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ca1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Ca1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Ca1/surfdata_1x1pt_CA-Ca1_simyr2000_clm4_5_pftgrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/README.PTCLM new file mode 100644 index 0000000000..16bd3a0f9c --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Obs -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/shell_commands new file mode 100755 index 0000000000..c05aa6a0ae --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Obs -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Obs +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Obs +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Obs +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Obs_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Obs_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/user_nl_clm new file mode 100644 index 0000000000..fde48e2846 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Obs/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --cesm_root ../../../../../.. -s CA-Obs -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/pftgrid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/pftgrid_file_creation/1x1pt_CA-Obs/surfdata_1x1pt_CA-Obs_simyr2000_clm4_5_pftgrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/README.PTCLM new file mode 100644 index 0000000000..90993f97ab --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --soilgrid -m yellowstone_intel -s CA-Ojp -d /glade/p/cesmdata/cseg/inputdata --cesm_root /Users/erik/clm_trunk --debug --mydatadir testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/user_nl_clm new file mode 100644 index 0000000000..ca88c174cf --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/pftgrd_CA-Ojp/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --soilgrid -m yellowstone_intel -s CA-Ojp -d /glade/p/cesmdata/cseg/inputdata --cesm_root /Users/erik/clm_trunk --debug --mydatadir testing_dir/soigrid_file_creation + fsurdat = '/Users/erik/PTCLM_trunk/test/testing_dir/soigrid_file_creation/1x1pt_CA-Ojp/surfdata_1x1pt_CA-Ojp_simyr2000_clm4_5_c140131.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/README.PTCLM new file mode 100644 index 0000000000..e7048b8e8b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp2.6_transient --cesm_root ../../../../../.. -s US-Dk2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp26grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/shell_commands new file mode 100755 index 0000000000..b297fce91c --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp2.6_transient --cesm_root ../../../../../.. -s US-Dk2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp26grd_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Dk2 +./xmlchange DATM_CLMNCEP_YR_START=2003 +./xmlchange DATM_CLMNCEP_YR_END=2005 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp26grd_file_creation/1x1pt_US-Dk2 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp26grd_file_creation/1x1pt_US-Dk2 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Dk2_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Dk2_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2003-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2003 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp26grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/user_nl_clm new file mode 100644 index 0000000000..6712e96a0e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp26_US-Dk2/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp2.6_transient --cesm_root ../../../../../.. -s US-Dk2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp26grd_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp26grd_file_creation/1x1pt_US-Dk2/surfdata_1x1pt_US-Dk2_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp26grd_file_creation/1x1pt_US-Dk2/landuse.timeseries1x1pt_US-Dk2_rcp2.6_simyr1850-2100_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/README.PTCLM new file mode 100644 index 0000000000..819986bb64 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp4.5_transient --cesm_root ../../../../../.. -s US-Dk3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp45grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/shell_commands new file mode 100755 index 0000000000..602912fc8e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp4.5_transient --cesm_root ../../../../../.. -s US-Dk3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp45grd_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Dk3 +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2005 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp45grd_file_creation/1x1pt_US-Dk3 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp45grd_file_creation/1x1pt_US-Dk3 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Dk3_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Dk3_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp45grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/user_nl_clm new file mode 100644 index 0000000000..bd4aaad2d3 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp45_US-Dk3/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp4.5_transient --cesm_root ../../../../../.. -s US-Dk3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp45grd_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp45grd_file_creation/1x1pt_US-Dk3/surfdata_1x1pt_US-Dk3_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp45grd_file_creation/1x1pt_US-Dk3/landuse.timeseries1x1pt_US-Dk3_rcp4.5_simyr1850-2100_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/README.PTCLM new file mode 100644 index 0000000000..e1a0733c11 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp6_transient --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp6grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/shell_commands new file mode 100755 index 0000000000..c06c784fae --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp6_transient --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp6grd_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-IB1 +./xmlchange DATM_CLMNCEP_YR_START=2005 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp6grd_file_creation/1x1pt_US-IB1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp6grd_file_creation/1x1pt_US-IB1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-IB1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-IB1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2005-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2005 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp6grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/user_nl_clm new file mode 100644 index 0000000000..f3987182e4 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp6_US-IB1/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp6_transient --cesm_root ../../../../../.. -s US-IB1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp6grd_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp6grd_file_creation/1x1pt_US-IB1/surfdata_1x1pt_US-IB1_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp6grd_file_creation/1x1pt_US-IB1/landuse.timeseries1x1pt_US-IB1_rcp6_simyr1850-2100_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/README.PTCLM new file mode 100644 index 0000000000..5d194c2c56 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp8.5_transient --cesm_root ../../../../../.. -s US-Me4 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp85grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/shell_commands new file mode 100755 index 0000000000..fcfd468a2e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp8.5_transient --cesm_root ../../../../../.. -s US-Me4 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp85grd_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Me4 +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=2000 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp85grd_file_creation/1x1pt_US-Me4 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp85grd_file_creation/1x1pt_US-Me4 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Me4_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Me4_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp85grd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/user_nl_clm new file mode 100644 index 0000000000..d9e5e6ec13 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/rcp85_US-Me4/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=1850-2100_rcp8.5_transient --cesm_root ../../../../../.. -s US-Me4 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/rcp85grd_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp85grd_file_creation/1x1pt_US-Me4/surfdata_1x1pt_US-Me4_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/rcp85grd_file_creation/1x1pt_US-Me4/landuse.timeseries1x1pt_US-Me4_rcp8.5_simyr1850-2100_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/README.PTCLM new file mode 100644 index 0000000000..d3c20ed723 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Ojp -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/shell_commands new file mode 100755 index 0000000000..9ef07625e0 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Ojp -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Ojp +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Ojp +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Ojp +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Ojp_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Ojp_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/user_nl_clm new file mode 100644 index 0000000000..0b9edabec3 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Ojp/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Ojp -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Ojp/surfdata_1x1pt_CA-Ojp_simyr2000_clm4_5_soigrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/README.PTCLM new file mode 100644 index 0000000000..6f525a3f23 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Qfo -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/shell_commands new file mode 100755 index 0000000000..2360d190cb --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Qfo -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Qfo +./xmlchange DATM_CLMNCEP_YR_START=2004 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Qfo +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Qfo +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Qfo_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Qfo_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2004-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2004 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/user_nl_clm new file mode 100644 index 0000000000..70bd5ed742 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/soigrd_CA-Qfo/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s CA-Qfo -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_CA-Qfo/surfdata_1x1pt_CA-Qfo_simyr2000_clm4_5_soigrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/README.PTCLM new file mode 100644 index 0000000000..43363d42fc --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --clmnmlusecase=1850_control --cesm_root ../../../../../.. -s US-Me2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std1850_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/shell_commands new file mode 100755 index 0000000000..2a67f2fa7b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --clmnmlusecase=1850_control --cesm_root ../../../../../.. -s US-Me2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std1850_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Me2 +./xmlchange DATM_CLMNCEP_YR_START=2002 +./xmlchange DATM_CLMNCEP_YR_END=2010 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std1850_file_creation/1x1pt_US-Me2 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std1850_file_creation/1x1pt_US-Me2 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Me2_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Me2_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2002-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2002 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std1850_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/user_nl_clm new file mode 100644 index 0000000000..664ff06c5f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_1850_US-Me2/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --clmnmlusecase=1850_control --cesm_root ../../../../../.. -s US-Me2 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std1850_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std1850_file_creation/1x1pt_US-Me2/surfdata_1x1pt_US-Me2_simyr1850_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/README.PTCLM new file mode 100644 index 0000000000..b6cc6c3cd4 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --clmnmlusecase=2000_control --cesm_root ../../../../../.. -s US-MOz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std2000_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/shell_commands new file mode 100755 index 0000000000..c6e0d8bf95 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --clmnmlusecase=2000_control --cesm_root ../../../../../.. -s US-MOz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std2000_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-MOz +./xmlchange DATM_CLMNCEP_YR_START=2004 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std2000_file_creation/1x1pt_US-MOz +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std2000_file_creation/1x1pt_US-MOz +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-MOz_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-MOz_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2004-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2004 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std2000_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/user_nl_clm new file mode 100644 index 0000000000..d2e961dd9e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_2000_US-MOz/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --clmnmlusecase=2000_control --cesm_root ../../../../../.. -s US-MOz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std2000_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std2000_file_creation/1x1pt_US-MOz/surfdata_1x1pt_US-MOz_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/README.PTCLM new file mode 100644 index 0000000000..03b2fcb1bc --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s BE-Vie -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/shell_commands new file mode 100755 index 0000000000..51f321d643 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s BE-Vie -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_BE-Vie +./xmlchange DATM_CLMNCEP_YR_START=1997 +./xmlchange DATM_CLMNCEP_YR_END=2005 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_BE-Vie +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_BE-Vie +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_BE-Vie_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_BE-Vie_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1997-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1997 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/user_nl_clm new file mode 100644 index 0000000000..5f964d293b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BE-Vie/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s BE-Vie -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_BE-Vie/surfdata_1x1pt_BE-Vie_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/README.PTCLM new file mode 100644 index 0000000000..f55dc8f5d7 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s BR-Sa3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/shell_commands new file mode 100755 index 0000000000..7feb33d3dc --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s BR-Sa3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_BR-Sa3 +./xmlchange DATM_CLMNCEP_YR_START=2001 +./xmlchange DATM_CLMNCEP_YR_END=2001 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_BR-Sa3 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_BR-Sa3 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_BR-Sa3_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_BR-Sa3_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/user_nl_clm new file mode 100644 index 0000000000..de4871f389 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_BR-Sa3/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s BR-Sa3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_BR-Sa3/surfdata_1x1pt_BR-Sa3_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/README.PTCLM new file mode 100644 index 0000000000..f9a24445c2 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s DE-Tha -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/shell_commands new file mode 100755 index 0000000000..d061953372 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s DE-Tha -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_DE-Tha +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2003 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_DE-Tha +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_DE-Tha +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_DE-Tha_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_DE-Tha_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/user_nl_clm new file mode 100644 index 0000000000..58756644f6 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_DE-Tha/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s DE-Tha -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_DE-Tha/surfdata_1x1pt_DE-Tha_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/README.PTCLM new file mode 100644 index 0000000000..d312d2fb05 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s ES-ES1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/shell_commands new file mode 100755 index 0000000000..9ce2348fa8 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s ES-ES1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_ES-ES1 +./xmlchange DATM_CLMNCEP_YR_START=1999 +./xmlchange DATM_CLMNCEP_YR_END=2002 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_ES-ES1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_ES-ES1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_ES-ES1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_ES-ES1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1999-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1999 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/user_nl_clm new file mode 100644 index 0000000000..1d2c7fa87b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_ES-ES1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s ES-ES1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_ES-ES1/surfdata_1x1pt_ES-ES1_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/README.PTCLM new file mode 100644 index 0000000000..81fdf5edc4 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s FL-Hyy -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/shell_commands new file mode 100755 index 0000000000..9863514c7e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s FL-Hyy -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_FL-Hyy +./xmlchange DATM_CLMNCEP_YR_START=1997 +./xmlchange DATM_CLMNCEP_YR_END=2004 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_FL-Hyy +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_FL-Hyy +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_FL-Hyy_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_FL-Hyy_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1997-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1997 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/user_nl_clm new file mode 100644 index 0000000000..53d72171ac --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Hyy/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cycle_forcing --cesm_root ../../../../../.. -s FL-Hyy -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/cyc_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/cyc_file_creation/1x1pt_FL-Hyy/surfdata_1x1pt_FL-Hyy_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/README.PTCLM new file mode 100644 index 0000000000..97925b914f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s FL-Kaa -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/shell_commands new file mode 100755 index 0000000000..fc6685c913 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s FL-Kaa -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_FL-Kaa +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2005 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_FL-Kaa +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_FL-Kaa +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_FL-Kaa_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_FL-Kaa_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/user_nl_clm new file mode 100644 index 0000000000..8c47663839 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_FL-Kaa/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s FL-Kaa -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_FL-Kaa/surfdata_1x1pt_FL-Kaa_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/README.PTCLM new file mode 100644 index 0000000000..d46d4893e9 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Col -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/shell_commands new file mode 100755 index 0000000000..049cbf73ca --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Col -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_IT-Col +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=2001 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Col +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Col +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_IT-Col_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_IT-Col_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/user_nl_clm new file mode 100644 index 0000000000..e92760f1b8 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Col/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Col -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Col/surfdata_1x1pt_IT-Col_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/README.PTCLM new file mode 100644 index 0000000000..220e5c9290 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Cpz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/shell_commands new file mode 100755 index 0000000000..7030727d78 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Cpz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_IT-Cpz +./xmlchange DATM_CLMNCEP_YR_START=2001 +./xmlchange DATM_CLMNCEP_YR_END=2005 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Cpz +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Cpz +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_IT-Cpz_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_IT-Cpz_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2001-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2001 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/user_nl_clm new file mode 100644 index 0000000000..4d135f3d4b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_IT-Cpz/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s IT-Cpz -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_IT-Cpz/surfdata_1x1pt_IT-Cpz_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/README.PTCLM new file mode 100644 index 0000000000..115d398328 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LBA-Cax -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/shell_commands new file mode 100755 index 0000000000..60460dca36 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LBA-Cax -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_LBA-Cax +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=1999 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LBA-Cax +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LBA-Cax +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_LBA-Cax_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_LBA-Cax_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/user_nl_clm new file mode 100644 index 0000000000..5ff190a6f2 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LBA-Cax/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LBA-Cax -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LBA-Cax/surfdata_1x1pt_LBA-Cax_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/README.PTCLM new file mode 100644 index 0000000000..460da999a7 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LTER-Sev -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/shell_commands new file mode 100755 index 0000000000..a59128e4b5 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LTER-Sev -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_LTER-Sev +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=1999 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LTER-Sev +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LTER-Sev +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_LTER-Sev_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_LTER-Sev_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/user_nl_clm new file mode 100644 index 0000000000..65f2cf7fef --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_LTER-Sev/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s LTER-Sev -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_LTER-Sev/surfdata_1x1pt_LTER-Sev_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/README.PTCLM new file mode 100644 index 0000000000..315308e250 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --soilgrid --donot_use_tower_yrs --cesm_root ../../../../../.. -s RF-Bra -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/grid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/shell_commands new file mode 100755 index 0000000000..d660c8f17e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/shell_commands @@ -0,0 +1,14 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --soilgrid --donot_use_tower_yrs --cesm_root ../../../../../.. -s RF-Bra -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/grid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_RF-Bra +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/grid_file_creation/1x1pt_RF-Bra +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/grid_file_creation/1x1pt_RF-Bra +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_RF-Bra_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_RF-Bra_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/grid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/user_nl_clm new file mode 100644 index 0000000000..3e409da862 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_RF-Bra/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --soilgrid --donot_use_tower_yrs --cesm_root ../../../../../.. -s RF-Bra -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/grid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/grid_file_creation/1x1pt_RF-Bra/surfdata_1x1pt_RF-Bra_simyr2000_clm4_5_pftgrd_soigrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/README.PTCLM new file mode 100644 index 0000000000..d694a288d0 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/shell_commands new file mode 100755 index 0000000000..0b2c442561 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-UMB +./xmlchange DATM_CLMNCEP_YR_START=1999 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_US-UMB +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_US-UMB +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-UMB_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1999-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1999 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/user_nl_clm new file mode 100644 index 0000000000..2b73ae31e5 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_US-UMB/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --cesm_root ../../../../../.. -s US-UMB -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/std_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/std_file_creation/1x1pt_US-UMB/surfdata_1x1pt_US-UMB_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/README.PTCLM new file mode 100644 index 0000000000..99970ba8f6 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-Brw -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/shell_commands new file mode 100755 index 0000000000..82d20cc0bf --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-Brw -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Brw +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-Brw +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-Brw +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Brw_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Brw_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/user_nl_clm new file mode 100644 index 0000000000..008ebe7f30 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-Brw/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-Brw -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-Brw/surfdata_1x1pt_US-Brw_simyr2000_clm4_0_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/README.PTCLM new file mode 100644 index 0000000000..20ed1e265e --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-FPe -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/shell_commands new file mode 100755 index 0000000000..87c14b9cdd --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-FPe -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-FPe +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-FPe +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-FPe +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-FPe_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-FPe_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/user_nl_clm new file mode 100644 index 0000000000..ce692d1707 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-FPe/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-FPe -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-FPe/surfdata_1x1pt_US-FPe_simyr2000_clm4_0_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/README.PTCLM new file mode 100644 index 0000000000..9fd428fb35 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-NR1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/shell_commands new file mode 100755 index 0000000000..1332f5a681 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-NR1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-NR1 +./xmlchange DATM_CLMNCEP_YR_START=1998 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-NR1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-NR1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-NR1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-NR1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1998-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1998 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/user_nl_clm new file mode 100644 index 0000000000..36a5d951fe --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm40_US-NR1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_0 --cesm_root ../../../../../.. -s US-NR1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm40_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm40_file_creation/1x1pt_US-NR1/surfdata_1x1pt_US-NR1_simyr2000_clm4_0_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/README.PTCLM new file mode 100644 index 0000000000..197fe2a991 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-ARM -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/shell_commands new file mode 100755 index 0000000000..1eedd4e1e6 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-ARM -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-ARM +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-ARM +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-ARM +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-ARM_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-ARM_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/user_nl_clm new file mode 100644 index 0000000000..a0e0dcd60a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-ARM/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-ARM -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-ARM/surfdata_1x1pt_US-ARM_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/README.PTCLM new file mode 100644 index 0000000000..8a901e5f11 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/shell_commands new file mode 100755 index 0000000000..0b05f5ce91 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Ha1 +./xmlchange DATM_CLMNCEP_YR_START=1991 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Ha1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Ha1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Ha1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Ha1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1991-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1991 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/user_nl_clm new file mode 100644 index 0000000000..94b2a589af --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Ha1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Ha1/surfdata_1x1pt_US-Ha1_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/README.PTCLM new file mode 100644 index 0000000000..24144e465b --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Var -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/shell_commands new file mode 100755 index 0000000000..fff5055d3c --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Var -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Var +./xmlchange DATM_CLMNCEP_YR_START=2000 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Var +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Var +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Var_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Var_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=2000-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2000 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/user_nl_clm new file mode 100644 index 0000000000..d663815036 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_clm45_US-Var/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --phys clm4_5 --cesm_root ../../../../../.. -s US-Var -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdclm45_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdclm45_file_creation/1x1pt_US-Var/surfdata_1x1pt_US-Var_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/README.PTCLM new file mode 100644 index 0000000000..646a5b69f2 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Bo1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/shell_commands new file mode 100755 index 0000000000..7aea4c78af --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Bo1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Bo1 +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=2008 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Bo1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Bo1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Bo1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Bo1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/user_nl_clm new file mode 100644 index 0000000000..05efd07e59 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Bo1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Bo1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Bo1/surfdata_1x1pt_US-Bo1_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/README.PTCLM new file mode 100644 index 0000000000..27998fa91f --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Ho1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/shell_commands new file mode 100755 index 0000000000..bb55c002f4 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Ho1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Ho1 +./xmlchange DATM_CLMNCEP_YR_START=1996 +./xmlchange DATM_CLMNCEP_YR_END=2004 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Ho1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Ho1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Ho1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Ho1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1996-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1996 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/user_nl_clm new file mode 100644 index 0000000000..0c3ad60a63 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-Ho1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-Ho1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-Ho1/surfdata_1x1pt_US-Ho1_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/README.PTCLM new file mode 100644 index 0000000000..24c9816461 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-MMS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/shell_commands new file mode 100755 index 0000000000..4da6c02123 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-MMS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-MMS +./xmlchange DATM_CLMNCEP_YR_START=1999 +./xmlchange DATM_CLMNCEP_YR_END=2007 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-MMS +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-MMS +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-MMS_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-MMS_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1999-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1999 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/user_nl_clm new file mode 100644 index 0000000000..6eee96c0cf --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_quiet_US-MMS/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --quiet --cesm_root ../../../../../.. -s US-MMS -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdquiet_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdquiet_file_creation/1x1pt_US-MMS/surfdata_1x1pt_US-MMS_simyr2000_clm4_5_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/README.PTCLM new file mode 100644 index 0000000000..2543980fd1 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s BR-Sa1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/shell_commands new file mode 100755 index 0000000000..3072f6538c --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s BR-Sa1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_BR-Sa1 +./xmlchange DATM_CLMNCEP_YR_START=2002 +./xmlchange DATM_CLMNCEP_YR_END=2004 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_BR-Sa1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_BR-Sa1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_BR-Sa1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_BR-Sa1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=2002-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2002 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/user_nl_clm new file mode 100644 index 0000000000..7937c8c856 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/std_soigrd_BR-Sa1/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --soilgrid --cesm_root ../../../../../.. -s BR-Sa1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/soigrid_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/soigrid_file_creation/1x1pt_BR-Sa1/surfdata_1x1pt_BR-Sa1_simyr2000_clm4_5_soigrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/README.PTCLM new file mode 100644 index 0000000000..b484479eb5 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=stdurbpt_pd --cesm_root ../../../../../.. -s CA-Oas -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdurbpt_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/shell_commands new file mode 100755 index 0000000000..307cad1274 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=stdurbpt_pd --cesm_root ../../../../../.. -s CA-Oas -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdurbpt_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_CA-Oas +./xmlchange DATM_CLMNCEP_YR_START=1997 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdurbpt_file_creation/1x1pt_CA-Oas +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdurbpt_file_creation/1x1pt_CA-Oas +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_CA-Oas_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_CA-Oas_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=48 +./xmlchange RUN_STARTDATE=1997-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1997 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdurbpt_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/user_nl_clm new file mode 100644 index 0000000000..6baf7eede5 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/stdurbpt_pftgrd_CA-Oas/user_nl_clm @@ -0,0 +1,5 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=stdurbpt_pd --cesm_root ../../../../../.. -s CA-Oas -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/stdurbpt_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/stdurbpt_file_creation/1x1pt_CA-Oas/surfdata_1x1pt_CA-Oas_simyr2000_clm4_5_pftgrd_c140204.nc' + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/README.PTCLM new file mode 100644 index 0000000000..bfb7c72f75 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ne3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/trans20thgrd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/shell_commands new file mode 100755 index 0000000000..ce83ec2b9a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ne3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/trans20thgrd_file_creation +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Ne3 +./xmlchange DATM_CLMNCEP_YR_START=2001 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/trans20thgrd_file_creation/1x1pt_US-Ne3 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/trans20thgrd_file_creation/1x1pt_US-Ne3 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Ne3_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Ne3_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=2001-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=2001 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/trans20thgrd_file_creation diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/user_nl_clm new file mode 100644 index 0000000000..c292aafc0a --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_20th_US-Ne3/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ne3 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/trans20thgrd_file_creation + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/trans20thgrd_file_creation/1x1pt_US-Ne3/surfdata_1x1pt_US-Ne3_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/trans20thgrd_file_creation/1x1pt_US-Ne3/landuse.timeseries1x1pt_US-Ne3_hist_simyr1850-2005_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/README.PTCLM b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/README.PTCLM new file mode 100644 index 0000000000..078fbc40a8 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/README.PTCLM @@ -0,0 +1 @@ +../PTCLMmkdata --verbose --pftgrid --phys clm4_5 --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/clm45grd_trans_pft diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/shell_commands b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/shell_commands new file mode 100755 index 0000000000..6785407422 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/shell_commands @@ -0,0 +1,18 @@ +# shell commands to execute xmlchange commands written by PTCLMmkdata: +# ../PTCLMmkdata --verbose --pftgrid --phys clm4_5 --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/clm45grd_trans_pft +./xmlchange CLM_USRDAT_NAME=1x1pt_US-Ha1 +./xmlchange DATM_CLMNCEP_YR_START=1991 +./xmlchange DATM_CLMNCEP_YR_END=2006 +./xmlchange CLM_BLDNML_OPTS='-mask navy' +./xmlchange MPILIB=mpi-serial +./xmlchange ATM_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/clm45grd_trans_pft/1x1pt_US-Ha1 +./xmlchange LND_DOMAIN_PATH=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/clm45grd_trans_pft/1x1pt_US-Ha1 +./xmlchange ATM_DOMAIN_FILE=domain.lnd.1x1pt_US-Ha1_navy.140204.nc +./xmlchange LND_DOMAIN_FILE=domain.lnd.1x1pt_US-Ha1_navy.140204.nc +./xmlchange CALENDAR=GREGORIAN +./xmlchange DOUT_S=FALSE +./xmlchange ATM_NCPL=24 +./xmlchange RUN_STARTDATE=1991-01-01 +./xmlchange DATM_CLMNCEP_YR_ALIGN=1991 +./xmlchange DIN_LOC_ROOT=/glade/p/cesmdata/cseg/inputdata +./xmlchange DIN_LOC_ROOT_CLMFORC=/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/clm45grd_trans_pft diff --git a/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/user_nl_clm b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/user_nl_clm new file mode 100644 index 0000000000..567edd2fe1 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/compdirs/trans_clm45_US-Ha1/user_nl_clm @@ -0,0 +1,6 @@ +! user_nl_clm namelist options written by PTCLMmkdata: +! ../PTCLMmkdata --verbose --pftgrid --phys clm4_5 --clmnmlusecase=20thC_transient --cesm_root ../../../../../.. -s US-Ha1 -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 --mydatadir testing_dir/clm45grd_trans_pft + fsurdat = '/glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/clm45grd_trans_pft/1x1pt_US-Ha1/surfdata_1x1pt_US-Ha1_simyr1850_clm4_5_pftgrd_c140204.nc' + flanduse_timeseries = /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/test/testing_dir/clm45grd_trans_pft/1x1pt_US-Ha1/landuse.timeseries1x1pt_US-Ha1_hist_simyr1850-2005_clm4_5_pftgrd_c140204.nc + hist_nhtfrq = 0 + hist_mfilt = 1200 diff --git a/components/clm/tools/shared/PTCLM/test/listings/help b/components/clm/tools/shared/PTCLM/test/listings/help new file mode 100644 index 0000000000..8616213a52 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/listings/help @@ -0,0 +1,58 @@ +Usage: PTCLMmkdata [options] -d inputdatadir -s sitename + +Python script to create datasets to run single point simulations with tower +site data. + +Options: + --version show program's version number and exit + -h, --help show this help message and exit + + Required Options: + -d CESM_INPUT, --cesmdata=CESM_INPUT + Location of CCSM input data + -s MYSITE, --site=MYSITE + Site-code to run, FLUXNET code (-s list to list valid + names) + + Configure and Run Options: + --cesm_root=BASE_CESM + Root CESM directory (top level directory with + components and cime subdirs) + --debug Flag to turn on debug mode so won't run, but display + what would happen + --sdate=SDATE Use entered date string in all files (use the given + date string in place of the current date:150826) + --clmnmlusecase=CLMNMLUSECASE + CLM namelist use case to use (default:2000_control) + --phys=CLMPHYSVERS CLM physics version to use (default:clm4_5) + --list List all valid: sites + --mydatadir=MYDATADIR + Directory of where to put your data files (files will + be under subdirectories for each site) (default: /glad + e/p/work/erik/clm_clean_trunk/components/clm/tools/sha + red/PTCLM/mydatafiles) + --donot_use_tower_yrs + Do NOT use the data years that correspond to the tower + years (when you plan on using global forcing) + --quiet Print minimul information on what the script is doing + --cycle_forcing Cycle over the forcing data rather than do one run + through (modifies start/end year to get this to work) + --verbose Print out extra information on what the script is + doing + + Input data generation options: + These are options having to do with generation of input datasets. + + --pftgrid Use pft information from global gridded file (rather + than site data) + --soilgrid Use soil information from global gridded file (rather + than site data) + --map_gdate=MAP_GDATE + Use existing mapping files with the given date string + rather than create new ones with current date (if + mapping files do NOT exist with this date, the script + will abort) + --mksurfdata_opts=MKSURFDATA_OPTS + Options to send directly to mksurfdata_map + + Main Script Version Id: $Id: PTCLMmkdata 72597 2015-08-26 19:50:37Z erik $ Scripts URL: $HeadURL: https://svn-ccsm-models.cgd.ucar.edu/PTCLM/trunk_tags/PTCLM2_150826/PTCLMmkdata $: diff --git a/components/clm/tools/shared/PTCLM/test/listings/list b/components/clm/tools/shared/PTCLM/test/listings/list new file mode 100644 index 0000000000..d9ec12f636 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/listings/list @@ -0,0 +1,59 @@ +---------------- PTCLMmkdata version PTCLM2.0_PTCLM2_150826----------------------------- + + ../PTCLMmkdata --list --cesm_root ../../../../../.. -s test -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 + + OPTIONS: + +Site name: list + +Root CLM directory: /glade/p/work/erik/clm_clean_trunk +** Surface data file will be built using site-level data when available unless otherwise specified ** + + Extract PFT data from gridded files: False + Extract soil data from gridded files: False + +Open Site data file: /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_sitedata.txt + + site = site_code name: name Region: state Campaign: campaign + site = US-Blo name: Blodgett Forest Region: CA Campaign: AmeriFlux + site = US-CHATS name: Cilker Chandler walnut orchard Region: CA Campaign: CHATS + site = US-FPe name: Fort Peck Region: MT Campaign: AmeriFlux + site = CA-Let name: Lethbridge Region: CAN Campaign: Fluxnet-Canada + site = US-NR1 name: Niwot Ridge Region: CO Campaign: AmeriFlux + site = CA-Man name: BOREAS NSA - Old Black Spruce Region: CAN Campaign: Fluxnet-Canada + site = BR-Sa1 name: SantaremKM67 Region: BRAZIL Campaign: LBA + site = BR-Sa3 name: SantaremKM83 Region: BRAZIL Campaign: LBA + site = ES-ES1 name: ElSaler Region: SPAIN Campaign: CarboEurope + site = FL-Hyy name: Hyytiala Region: FINLAND Campaign: CarboEurope + site = FL-Kaa name: Kaamanen Region: FINLAND Campaign: CarboEurope + site = IT-Col name: Collelongo Region: ITALY Campaign: CarboEurope + site = IT-Cpz name: CastelPorziano Region: ITALY Campaign: CarboEurope + site = DE-Tha name: Tharandt Region: GERMANY Campaign: CarboEurope + site = US-Brw name: Barrow Region: AK Campaign: AmeriFlux + site = BE-Vie name: Vielsalm Region: BELGIUM Campaign: CarboEurope + site = US-ARM name: ARM SGP Main Region: OK Campaign: AmeriFlux + site = US-Var name: Vaira Ranch Region: CA Campaign: AmeriFlux + site = US-UMB name: UMBS Region: MI Campaign: AmeriFlux + site = US-Ha1 name: Harvard Forest Region: MA Campaign: AmeriFlux + site = US-Ho1 name: Howland Forest Main Region: ME Campaign: AmeriFlux + site = US-MMS name: Morgon Monroe State Forest Region: IN Campaign: AmeriFlux + site = US-Bo1 name: Bondville Region: IL Campaign: AmeriFlux + site = CA-Ca1 name: British Columbia- Campbell River - Mature Forest Site Region: CAN Campaign: Fluxnet-Canada + site = CA-Oas name: Sask.- SSA Old Aspen Region: CAN Campaign: Fluxnet-Canada + site = CA-Obs name: Sask.- SSA Old Black Spruce Region: CAN Campaign: Fluxnet-Canada + site = CA-Ojp name: Sask.- SSA Old Jack Pine Region: CAN Campaign: Fluxnet-Canada + site = CA-Qfo name: Quebec Mature Boreal Forest Site Region: CAN Campaign: Fluxnet-Canada + site = US-Dk2 name: Duke Forest Hardwoods Region: NC Campaign: AmeriFlux + site = US-Dk3 name: Duke Forest Loblolly Pine Region: NC Campaign: AmeriFlux + site = US-IB1 name: Fermi Agricultural Region: IL Campaign: AmeriFlux + site = US-Me4 name: Metolius Old Pine Region: OR Campaign: AmeriFlux + site = US-Me2 name: Metolius Intermediate Pine Region: OR Campaign: AmeriFlux + site = US-MOz name: Missouri Ozark Site Region: MO Campaign: AmeriFlux + site = US-Ne3 name: Mead Rainfed Region: NE Campaign: AmeriFlux + site = US-WCr name: Willow Creek Region: WI Campaign: AmeriFlux + site = TS-Ts1 name: Test short yrs Region: TEST Campaign: PTCLMTestSite + site = TS-Ts2 name: Test short yrs start on leap-year Region: TEST Campaign: PTCLMTestSite + site = TS-Ts3 name: Test long yrs Region: TEST Campaign: PTCLMTestSite + site = LTER-Sev name: Sevilleta Long Term Ecological Research (LTER) project (Meteorology from LTER Cerro Montoso #42) Region: NM Campaign: LTER + site = RF-Bra name: Brasillia arbitrary site, no met-data Region: BR Campaign: RFisher + site = LBA-Cax name: Caxiauna Rainforest 'throughfall exclusion’ (TFE) experiment Region: BR Campaign: LBA diff --git a/components/clm/tools/shared/PTCLM/test/listings/sitelist b/components/clm/tools/shared/PTCLM/test/listings/sitelist new file mode 100644 index 0000000000..4fc8b1bdbf --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/listings/sitelist @@ -0,0 +1,59 @@ +---------------- PTCLMmkdata version PTCLM2.0_PTCLM2_150826----------------------------- + + ../PTCLMmkdata --cesm_root ../../../../../.. -s list -d /glade/p/cesmdata/cseg/inputdata --debug --sdate 140204 --map_gdate 140204 + + OPTIONS: + +Site name: list + +Root CLM directory: /glade/p/work/erik/clm_clean_trunk +** Surface data file will be built using site-level data when available unless otherwise specified ** + + Extract PFT data from gridded files: False + Extract soil data from gridded files: False + +Open Site data file: /glade/p/work/erik/clm_clean_trunk/components/clm/tools/shared/PTCLM/PTCLM_sitedata/PTCLMDATA_sitedata.txt + + site = site_code name: name Region: state Campaign: campaign + site = US-Blo name: Blodgett Forest Region: CA Campaign: AmeriFlux + site = US-CHATS name: Cilker Chandler walnut orchard Region: CA Campaign: CHATS + site = US-FPe name: Fort Peck Region: MT Campaign: AmeriFlux + site = CA-Let name: Lethbridge Region: CAN Campaign: Fluxnet-Canada + site = US-NR1 name: Niwot Ridge Region: CO Campaign: AmeriFlux + site = CA-Man name: BOREAS NSA - Old Black Spruce Region: CAN Campaign: Fluxnet-Canada + site = BR-Sa1 name: SantaremKM67 Region: BRAZIL Campaign: LBA + site = BR-Sa3 name: SantaremKM83 Region: BRAZIL Campaign: LBA + site = ES-ES1 name: ElSaler Region: SPAIN Campaign: CarboEurope + site = FL-Hyy name: Hyytiala Region: FINLAND Campaign: CarboEurope + site = FL-Kaa name: Kaamanen Region: FINLAND Campaign: CarboEurope + site = IT-Col name: Collelongo Region: ITALY Campaign: CarboEurope + site = IT-Cpz name: CastelPorziano Region: ITALY Campaign: CarboEurope + site = DE-Tha name: Tharandt Region: GERMANY Campaign: CarboEurope + site = US-Brw name: Barrow Region: AK Campaign: AmeriFlux + site = BE-Vie name: Vielsalm Region: BELGIUM Campaign: CarboEurope + site = US-ARM name: ARM SGP Main Region: OK Campaign: AmeriFlux + site = US-Var name: Vaira Ranch Region: CA Campaign: AmeriFlux + site = US-UMB name: UMBS Region: MI Campaign: AmeriFlux + site = US-Ha1 name: Harvard Forest Region: MA Campaign: AmeriFlux + site = US-Ho1 name: Howland Forest Main Region: ME Campaign: AmeriFlux + site = US-MMS name: Morgon Monroe State Forest Region: IN Campaign: AmeriFlux + site = US-Bo1 name: Bondville Region: IL Campaign: AmeriFlux + site = CA-Ca1 name: British Columbia- Campbell River - Mature Forest Site Region: CAN Campaign: Fluxnet-Canada + site = CA-Oas name: Sask.- SSA Old Aspen Region: CAN Campaign: Fluxnet-Canada + site = CA-Obs name: Sask.- SSA Old Black Spruce Region: CAN Campaign: Fluxnet-Canada + site = CA-Ojp name: Sask.- SSA Old Jack Pine Region: CAN Campaign: Fluxnet-Canada + site = CA-Qfo name: Quebec Mature Boreal Forest Site Region: CAN Campaign: Fluxnet-Canada + site = US-Dk2 name: Duke Forest Hardwoods Region: NC Campaign: AmeriFlux + site = US-Dk3 name: Duke Forest Loblolly Pine Region: NC Campaign: AmeriFlux + site = US-IB1 name: Fermi Agricultural Region: IL Campaign: AmeriFlux + site = US-Me4 name: Metolius Old Pine Region: OR Campaign: AmeriFlux + site = US-Me2 name: Metolius Intermediate Pine Region: OR Campaign: AmeriFlux + site = US-MOz name: Missouri Ozark Site Region: MO Campaign: AmeriFlux + site = US-Ne3 name: Mead Rainfed Region: NE Campaign: AmeriFlux + site = US-WCr name: Willow Creek Region: WI Campaign: AmeriFlux + site = TS-Ts1 name: Test short yrs Region: TEST Campaign: PTCLMTestSite + site = TS-Ts2 name: Test short yrs start on leap-year Region: TEST Campaign: PTCLMTestSite + site = TS-Ts3 name: Test long yrs Region: TEST Campaign: PTCLMTestSite + site = LTER-Sev name: Sevilleta Long Term Ecological Research (LTER) project (Meteorology from LTER Cerro Montoso #42) Region: NM Campaign: LTER + site = RF-Bra name: Brasillia arbitrary site, no met-data Region: BR Campaign: RFisher + site = LBA-Cax name: Caxiauna Rainforest 'throughfall exclusion’ (TFE) experiment Region: BR Campaign: LBA diff --git a/components/clm/tools/shared/PTCLM/test/run_PTCLM_tests b/components/clm/tools/shared/PTCLM/test/run_PTCLM_tests new file mode 100755 index 0000000000..caeb0c9a89 --- /dev/null +++ b/components/clm/tools/shared/PTCLM/test/run_PTCLM_tests @@ -0,0 +1,15 @@ +#!/usr/bin/env python +######################################################################################### +# +# run_PTCLM_tests +# +# Run the list of PTCLM unit-tests. +# +######################################################################################### +from PTCLMtesting_prog import PTCLMtesting_prog + +testing = PTCLMtesting_prog() +testing.parse_cmdline_args() +testing.Initialize() +testing.Run() +testing.Finalize() diff --git a/components/clm/tools/shared/gen_domain/INSTALL b/components/clm/tools/shared/gen_domain/INSTALL new file mode 100644 index 0000000000..80dfcb74c4 --- /dev/null +++ b/components/clm/tools/shared/gen_domain/INSTALL @@ -0,0 +1,36 @@ +============ +HOW TO BUILD +============ + +Prior to building, you must make sure $CIMEROOT is set. + +$ cd src +$ $CIMEROOT/machines/configure -mach [machine name] +$ gmake + +Note: in the second step, replace [machine name] with the machine you are +building on. Also, some machines (such as janus) have dedicated build nodes, +so you might need to SSH to another node before the 'gmake' step. + +================================== +COMMON BUILD / RUN ISSUES ON JANUS +================================== + +1) As hinted at in the "How to Build" section, you can not build on the login + nodes on janus. If you see the error + + ld: cannot find -lrdmacm + ld: cannot find -libverbs + + you are still on the headnode and need to SSH to node0001. + +2) At present, the netCDF libraries available on janus have all been built + with mpif90, which means that everything linking with netCDF must also + be built in parallel. Unfortunately, this means you can not run gen_domains + from the head node -- you either need to push it through the queue or just + run it from node0001. Running on node0001 is easier, but to run from the + queue, edit gen_domain.janus.run (both the header info to set the requested + walltime and the body of the script to point to the correct mapping file and + name the domain files appropriately), and then run + + qsub gen_domain.janus.run diff --git a/components/clm/tools/shared/gen_domain/README b/components/clm/tools/shared/gen_domain/README new file mode 100644 index 0000000000..e7e9401a5f --- /dev/null +++ b/components/clm/tools/shared/gen_domain/README @@ -0,0 +1,143 @@ +=============== +ABOUT THIS TOOL +=============== + +The src/ directory here contains an F90 file and a Makefile to produce the +gen_domains executable, which reads in a conservative ocean -> atmosphere +mapping file and outputs three domain description files: + +1. One ocean domain file +2. One land domain file with the land mask +3. One land domain file with the ocean mask + +Ocean fraction will be either 0 or 1, depending on the ocean domain mask, and +land fraction will be the complement of the ocean domain (hence the need for a +conservative ocean -> atmosphere mapping file). + +============ +HOW TO BUILD +============ + +Prior to building, you must make sure $CIMEROOT is set. + +$ cd src +$ $CIMEROOT/machines/configure -mach [machine name] +$ ./build.csh + +Note: in the second step, replace [machine name] with the machine you are +building on. Also, some machines (such as janus) have dedicated build nodes, +so you might need to SSH to another node before the 'build.csh' step. + +================================== +COMMON BUILD / RUN ISSUES ON JANUS +================================== + +1) As hinted at in the "How to Build" section, you can not build on the login + nodes on janus. If you see the error + + ld: cannot find -lrdmacm + ld: cannot find -libverbs + + you are still on the headnode and need to SSH to node0001. + +2) At present, the netCDF libraries available on janus have all been built + with mpif90, which means that everything linking with netCDF must also + be built in parallel. Unfortunately, this means you can not run gen_domains + from the head node -- you either need to push it through the queue or just + run it from node0001. Running on node0001 is easier, but to run from the + queue, edit gen_domain.janus.run (both the header info to set the requested + walltime and the body of the script to point to the correct mapping file and + name the domain files appropriately), and then run + + qsub gen_domain.janus.run + + +========== +HOW TO RUN +========== + +$ gen_domain -m + -o + -l + [-p set_fv_pole_yc] + [-c ] + +where: + filemap = input mapping file name (character string) + gridocn = output ocean grid name (NOT A FILE NAME!) + gridlnd = output land grid name (NOT A FILE NAME!) + usercomment = optional, netcdf global attribute (character string) + set_fv_pole_yc = [0,1,2] ~ optional, default = 0 (see comments below) + +The following output domain files are created: + domain.lnd.gridlnd_gridocn.nc + domain.ocn.gridlnd_gridocn.nc + domain.ocn.gridocn.nc' + +===== +NOTES +===== + +(a) Computation of land mask and cell fraction + + This code adds "cell fraction" data to the output domain files. + The "cell fraction" indicates how much of each grid cell is active. + Typically ocean models do not have fractional cells (their fraction + is either 0 or 1), where as land models do have fractional cells. + This code generates domain files where gridocn has fractions of either + 0 or 1 (for grid cells that are masked or unmasked, respectively) and + gridlnd has fractions that represent the complement of gridocn fraction + data, as computed by the input mapping data. Thus gridocn is intended + to be an ocean domain file and gridlnd is intended to be the complementary + land domain file. Related, the input mapping data, filemap, should be + a conservative mapping: ocean -> atmosphere. + + Computed land fractions will be truncated into the range [0,1] + after the min/max land fraction values have been documented. + Computed land fractions that are less than fminval will be truncated to 0 + to avoid active land cells with tiny land fractions. + + The input atmosphere grid is assumed to be unmasked (global) and the land + and atmosphere grids are assumed to be identical, except for cell fractions + and masks. Land cells whose fraction is zero will have land mask = 0. + +(b) Fraction error reported in stdout + + In the stdout, the min/max land fraction is reported. Land fractions should + be in the range [0,1], but due to either unavoidable/acceptable numerical + errors or other avoidable/unacceptable errors (eg. bad mapping matrix data) + this code may compute land fractions outside the range [0,1]. + + *** THE USER IS RESPONSIBLE FOR EXAMINING THE STDOUT MIN/MAX LAND + *** FRACTION DATA AND MAKING THEIR OWN SUBJECTIVE DECISION ABOUT WHETHER + *** SUCH ERRORS ARE ACCEPTABLE OR NOT. + +(c) The "pole fix" option + + set_fv_pole_yc = 0 => do not do the pole fix (default) + set_fv_pole_yc = 1 => do the pole-fix on gridocn + set_fv_pole_yc = 2 => do the pole-fix on gridlnd + + The "pole fix" means setting + yc(i,j) = -90 for j=1 (the min value of j: 1), and + yc(i,j) = 90 for j=nj (the max value of j, the size of the j-dimension) + regardless of what the coordinate values are in the input mapping data file. + + In other words, if the input mapping data min/max yc coordinates ARE NOT at + +/- 90 degrees but the desire is to have domain data with min/max yc coordinates + at +/- 90, the "pole fix" namelist option can be activated to accomplish this. + This would only work for lat/lon grids, ie. grids that could be described + by x(i) and y(j) coordinate arrays. + + Why? + + This option was introduced to accommodate a request by the CESM Atmosphere + Model Working Group wherein they want certain finite volume grids + with min/max yc coordinates (latitude of grid cell "centers") at +/- 90 degrees, + yet they want the corresponding mapping data created for grids + where the min/max yc coordinates ARE NOT at +/- 90 degrees, + (they are somewhat displaced toward the equator). + + While this type of manipulation has been requested by the AMWG, it is not + required by the CESM model, CESM coupler, or the SCRIP map generation tool. + diff --git a/components/clm/tools/shared/gen_domain/gen_domain.janus.run b/components/clm/tools/shared/gen_domain/gen_domain.janus.run new file mode 100755 index 0000000000..08318744a4 --- /dev/null +++ b/components/clm/tools/shared/gen_domain/gen_domain.janus.run @@ -0,0 +1,16 @@ +#!/bin/bash +#PBS -N gen_domain +#PBS -l walltime=0:01:00 +#PBS -l nodes=1:ppn=1 +#PBS -q janus-debug +#PBS -m ae +#PBS -M mlevy@ucar.edu +#PBS -j oe + +CESM_DIR=/lustre/janus_scratch/cesm +MAP_FILE=$CESM_DIR/inputdata/cpl/gridmaps/gx3v7/map_gx3v7_TO_ne16np4_aave.120406.nc +OCN_NAME=gx3v7 +LND_NAME=ne16np4 + +cd $CIMEROOT/tools/mapping/gen_domain_files +./gen_domain -m $MAP_FILE -o $OCN_NAME -l $LND_NAME diff --git a/components/clm/tools/shared/gen_domain/src/Filepath b/components/clm/tools/shared/gen_domain/src/Filepath new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/components/clm/tools/shared/gen_domain/src/Filepath @@ -0,0 +1 @@ +. diff --git a/components/clm/tools/shared/gen_domain/src/Makefile b/components/clm/tools/shared/gen_domain/src/Makefile new file mode 100644 index 0000000000..c3764e98cd --- /dev/null +++ b/components/clm/tools/shared/gen_domain/src/Makefile @@ -0,0 +1,138 @@ +#----------------------------------------------------------------------- +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# $Id: Makefile 35671 2012-03-22 21:23:14Z mlevy@ucar.edu $ +# $URL$ +# +# These macros can be changed by setting environment variables: +# +# NETCDF_PATH --- Diretory location of netcdf +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS - Additional CPP defines. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS -- Additional load flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#------------------------------------------------------------------------ + +# Definitions +null := +CURDIR = . +EXENAME = ../gen_domain +RM = rm + +default: $(EXENAME) + +Macros: + @echo "use the configure script located in the Machines directory to create the Makefile Macros file" + +-include Macros +# Check for the netcdf library and include directories +ifdef NETCDF_PATH + LIB_NETCDF:=$(NETCDF_PATH)/lib + INC_NETCDF:=$(NETCDF_PATH)/include + MOD_NETCDF:=$(NETCDF_PATH)/include +else + ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib + endif + ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include + endif + + ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) + endif +endif + +# Set Fortran compiler +ifneq ($(SFC),$(null)) + FC := $(SFC) +endif + +# Set user specified C compiler +ifneq ($(SCC),$(null)) + CC := $(SCC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +CPPDEF += $(USER_CPPDEFS) + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +ifeq ($(OPT),TRUE) + CPPDEF := -DOPT +endif + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +VPATH := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +VPATH := $(subst $(space),:,$(VPATH)) +ifdef CPRE + FPPDEFS := $(patsubst -D%,$(CPRE)%,$(CPPDEFS)) +else + FPPDEFS := $(CPPDEFS) +endif +#Primary Target: build the tool +all: $(EXENAME) Macros + +OBJS := gen_domain.o + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) -I$(INC_NETCDF) +FFLAGS += $(USER_FFLAGS) -I$(MOD_NETCDF) -I$(INC_NETCDF) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifneq ($(USER_LINKER),$(null)) + LINKER := $(USER_LINKER) +else + LINKER := $(FC) +endif + +.F90.o: + $(FC) -c $(FPPDEFS) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(SLIBS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) $(EXENAME) *.mod + +veryclean: + $(RM) -f $(OBJS) $(EXENAME) *.mod Macros env_mach* build* + +gen_domain.o : gen_domain.F90 diff --git a/components/clm/tools/shared/gen_domain/src/gen_domain.F90 b/components/clm/tools/shared/gen_domain/src/gen_domain.F90 new file mode 100644 index 0000000000..61ecb6711e --- /dev/null +++ b/components/clm/tools/shared/gen_domain/src/gen_domain.F90 @@ -0,0 +1,802 @@ +program fmain + +!------------------------------------------------------------------------------- +! PURPOSE: +! o given a SCRIP map matrix data file, create datm/dlnd/docn/dice domain data files +! +! NOTES: +! o all output data is base on the "_a" grid, the "_b" grid is ignored +! o to compile on an NCAR's SGI, tempest (Dec 2004): +! unix> f90 -64 -mips4 -r8 -i4 -lfpe -I/usr/local/include Make_domain.F90 \ +! -L/usr/local/lib64/r4i4 -lnetcdf +!------------------------------------------------------------------------------- + + implicit none + include 'netcdf.inc' + + integer,parameter :: R8 = selected_real_kind(12) ! 8 byte real + integer,parameter :: R4 = selected_real_kind( 6) ! 4 byte real + integer,parameter :: RN = kind(1.0) ! native real + integer,parameter :: I8 = selected_int_kind (13) ! 8 byte integer + integer,parameter :: I4 = selected_int_kind ( 6) ! 4 byte integer + integer,parameter :: IN = kind(1) ! native integer + integer,parameter :: CS = 80 ! short char + integer,parameter :: CL = 256 ! long char + integer,parameter :: CX = 512 ! extra-long char + integer :: n ! index + integer :: set_fv_pole_yc ! fix pole ycs on this grid [0,1,2] + integer :: nargs ! number of arguments + integer, external :: iargc ! number of arguments function + character(LEN=512) :: arg ! input argument + character(LEN=512) :: cmdline ! input command line + character(LEN=512) :: fmap ! file name ( input nc file) + character(LEN=512) :: fn1_out ! temporary + character(LEN=512) :: fn2_out ! temporary + character(LEN=512) :: fn1_out_ocn ! file name (output nc file) for grid _a + character(LEN=512) :: fn2_out_lnd ! file name (output nc file) for grid _b (lnd fraction) + character(LEN=512) :: fn2_out_ocn ! file name (output nc file) for grid _b (ocn fraction) + character(LEN=512) :: usercomment ! user comment + character(LEN= 8) :: cdate ! wall clock date + character(LEN=10) :: ctime ! wall clock time + !---------------------------------------------------- + + set_fv_pole_yc = 0 + fmap = 'null' + fn1_out = 'null' + fn2_out = 'null' + usercomment = 'null' + + nargs = iargc() + if (nargs == 0) then + write(6,*)'invoke gen_domain -h for usage' + stop + end if + + cmdline = 'gen_domain ' + n = 1 + do while (n <= nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + + select case (arg) + case ('-m') + ! input mapping file + call getarg (n, arg) + n = n + 1 + fmap = trim(arg) + cmdline = trim(cmdline) // ' -m ' // trim(arg) + case ('-o') + ! output ocean grid name + call getarg (n, arg) + n = n + 1 + fn1_out = trim(arg) + cmdline = trim(cmdline) // ' -o ' // trim(arg) + case ('-l') + ! output land grid name + call getarg (n, arg) + n = n + 1 + fn2_out = trim(arg) + cmdline = trim(cmdline) // ' -l ' // trim(arg) + case ('-p') + ! set pole on this grid [0,1,2] + call getarg (n, arg) + n = n + 1 + set_fv_pole_yc = ichar(trim(arg))-48 + write(6,*)'set_fv_pole_yc is ',set_fv_pole_yc + case ('-c') + ! user comment + call getarg (n, arg) + n = n + 1 + usercomment = trim(arg) + case ('-h') + call usage_exit (' ') + case default + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + end select + end do + + if (fmap == 'null' .or. fn1_out == 'null' .or. fn2_out== 'null') then + call usage_exit ('Must specify all the following arguments') + end if + + call date_and_time(cdate,ctime) + + fn1_out_ocn = 'domain.ocn.' // trim(fn1_out) // '.' // cdate(3:8) // '.nc' + fn2_out_lnd = 'domain.lnd.' // trim(fn2_out) // '_' // trim(fn1_out) // '.' // cdate(3:8) // '.nc' + fn2_out_ocn = 'domain.ocn.' // trim(fn2_out) // '_' // trim(fn1_out) // '.' // cdate(3:8) // '.nc' + + call gen_domain (fmap, fn1_out_ocn, fn2_out_lnd, fn2_out_ocn, set_fv_pole_yc, usercomment) + +contains + + subroutine gen_domain(fmap, fn1_out_ocn, fn2_out_lnd, fn2_out_ocn, set_fv_pole_yc, usercomment) + + implicit none + + !--- includes --- + include 'netcdf.inc' ! netCDF defs + + character(LEN=*), intent(in) :: fmap ! file name ( input nc file) + character(LEN=*), intent(in) :: fn1_out_ocn ! file name (output nc file) for grid _a + character(LEN=*), intent(in) :: fn2_out_lnd ! file name (output nc file) for grid _b (lnd frac) + character(LEN=*), intent(in) :: fn2_out_ocn ! file name (output nc file) for grid _b (ocn frac) + integer , intent(in) :: set_fv_pole_yc + character(LEN=*), intent(in) :: usercomment ! user comment from namelist + + !--- domain data --- + integer :: n ! size of 1d domain + integer :: ni ! size of i-axis of 2d domain + integer :: nj ! size of j-axis of 2d domain + integer :: nv = 4 ! assume retalinear grid + real(r8) ,pointer :: xc( :) ! x-coords of center + real(r8) ,pointer :: yc( :) ! y-coords of center + real(r8) ,pointer :: xv(:,:) ! x-coords of verticies + real(r8) ,pointer :: yv(:,:) ! y-coords of verticies + real(r8) ,pointer :: area(:) ! cell area + integer ,pointer :: lmask(:) ! domain mask + real(r8) ,pointer :: lfrac(:) ! cell fraction + integer ,pointer :: omask(:) ! domain mask + real(r8) ,pointer :: ofrac(:) ! cell fraction + integer ,pointer :: src_grid_dims(:) + integer ,pointer :: dst_grid_dims(:) + + + !--- for mapping --- + logical :: complf ! flag for computing landfrac + integer :: ns ! size of wgts list + integer ,pointer :: col ( :) ! column index + integer ,pointer :: row ( :) ! row index + real(r8),pointer :: S ( :) ! wgts + integer :: na ! size of source array + integer ,pointer :: mask_a(:) ! mask of source array, integer + real(r8),pointer :: frac_a(:) ! mask of source array, real + real(r8) :: eps ! allowable frac error + real(r8) :: lfrac_min ! min frac value before being set to fminval + real(r8) :: lfrac_max ! max frac value before being set to fmaxval + real(r8) :: fminval ! set frac to zero if frac < fminval + real(r8) :: fmaxval ! set frac to one if frac > fmaxval + + !--- local --- + character(LEN=CL) :: str_da ! global attribute str - domain_a + character(LEN=CL) :: str_db ! global attribute str - domain_b + character(LEN=CL) :: str_grido ! global attribute str - grid_file_ocn + character(LEN=CL) :: str_grida ! global attribute str - grid_file_atm + integer :: fid ! nc file ID + integer :: i,j,k ! generic indicies + integer :: attnum ! attribute number + character(LEN=CL) :: fn_out ! current output file name + character(LEN=CL) :: fn_out_lnd ! current output file name + character(LEN=CL) :: fn_out_ocn ! current output file name + integer :: nf ! number of files counter + character(LEN=CL) :: units_xc, units_yc ! netCDF attribute name string + character(LEN=2) :: suffix ! suffix _a or _b sets input grid + logical :: pole_fix ! fix pole ycs + integer :: vid ! nc variable ID + integer :: did ! nc dimension ID + integer :: rcode ! routine return error code + integer :: dst_grid_rank, src_grid_rank + real(r8),parameter :: pi = 3.14159265358979323846 + real(r8),parameter :: c0 = 0.00000000000000000000 + real(r8),parameter :: c1 = 1.00000000000000000000 + real(r8),parameter :: c90 = 90.0000000000000000000 + + !--- formats --- + ! character(LEN=*),parameter :: F00 = "(120a )" + ! character(LEN=*),parameter :: F02 = "(a,5i6,i12)" + ! character(LEN=*),parameter :: F10=& + ! & "('Data created: 'i4,'-',i2,2('-',i2),' ',i2,2('-',i2),' ')" + + !---------------------------------------------------------------------------- + + eps = 1.0e-12 + fminval = 0.001 + fmaxval = c1 + write(6,*) 'fmap = ',trim(fmap) + write(6,*) 'fn1_out_ocn= ',trim(fn1_out_ocn) + write(6,*) 'fn2_out_lnd= ',trim(fn2_out_lnd) + write(6,*) 'fn2_out_ocn= ',trim(fn2_out_ocn) + write(6,*) 'usercomment= ',trim(usercomment) + write(6,*) 'eps = ',eps + write(6,*) 'fminval= ',fminval + write(6,*) 'fmaxval= ',fmaxval + write(6,*) 'set_fv_pole_yc = ',set_fv_pole_yc + + !---------------------------------------------------------------------------- + write(6,*) ' ' + write(6,*) 'input SCRIP data...' + !---------------------------------------------------------------------------- + + do nf = 1,2 + + if (nf == 1) then + suffix = '_a' + fn_out = fn1_out_ocn + complf = .false. + elseif (nf == 2) then + suffix = '_b' + fn_out_lnd = fn2_out_lnd + fn_out_ocn = fn2_out_ocn + complf = .true. + pole_fix = .false. + else + write(6,*) ' ERROR: nf loop error ' + stop + endif + + pole_fix = .false. + if (nf == set_fv_pole_yc) pole_fix = .true. + write(6,*)'pole_fix = ',pole_fix + + write(6,*) ' ' + write(6,*) 'input file = ',fmap(1:len_trim(fmap)) + call check_ret(nf_open(fmap(1:len_trim(fmap)),NF_NOWRITE,fid)) + write(6,*) 'open ',trim(fmap) + + str_da = 'unknown' + str_db = 'unknown' + str_grido = 'unknown' + str_grida = 'unknown' + + call check_ret(nf_get_att_text(fid, NF_GLOBAL, 'domain_a', str_da)) + call check_ret(nf_get_att_text(fid, NF_GLOBAL, 'domain_b', str_db)) + + rcode = nf_get_att_text(fid, NF_GLOBAL, 'grid_file_ocn', str_grido) + if ( rcode == nf_enotatt ) then + rcode = nf_get_att_text(fid, NF_GLOBAL, 'grid_file_src', str_grido) + end if + + rcode = nf_get_att_text(fid, NF_GLOBAL, 'grid_file_atm', str_grida) + if ( rcode == nf_enotatt ) then + rcode = nf_get_att_text(fid, NF_GLOBAL, 'grid_file_dst', str_grida) + end if + + write(6,*) 'domain_a = ',trim(str_da) + write(6,*) 'domain_b = ',trim(str_db) + write(6,*) 'grid_file_ocn= ',trim(str_grido) + write(6,*) 'grid_file_atm= ',trim(str_grida) + + !---------------------------------------------- + ! get domain info + !---------------------------------------------- + if (trim(suffix) == '_b') then + call check_ret(nf_inq_varid(fid,'dst_grid_dims', vid)) + call check_ret(nf_get_var_int(fid,vid,dst_grid_dims )) + end if + + call check_ret(nf_inq_dimid (fid, 'n'//trim(suffix) , did)) + call check_ret(nf_inq_dimlen(fid, did , n)) + call check_ret(nf_inq_dimid (fid, 'nv'//trim(suffix), did)) + call check_ret(nf_inq_dimlen(fid, did , nv)) + rcode = nf_inq_dimid (fid, 'ni'//trim(suffix), did) + if (rcode == 0) then + call check_ret(nf_inq_dimlen(fid, did, ni)) + else + ni = n + end if + rcode = nf_inq_dimid (fid, 'nj'//trim(suffix), did) + if (rcode == 0) then + call check_ret(nf_inq_dimlen(fid, did, nj)) + else + nj = 1 + end if + if (ni == 1 .and. nj == 0) then + ni = n + nj = 1 + end if + + call check_ret(nf_inq_dimid (fid, 'n_s', did)) + call check_ret(nf_inq_dimlen(fid, did , ns)) + call check_ret(nf_inq_dimid (fid, 'n_a', did)) + call check_ret(nf_inq_dimlen(fid, did , na)) + call check_ret(nf_inq_dimid (fid, 'dst_grid_rank', did)) + call check_ret(nf_inq_dimlen(fid, did, dst_grid_rank)) + call check_ret(nf_inq_dimid (fid, 'src_grid_rank', did)) + call check_ret(nf_inq_dimlen(fid, did, src_grid_rank)) + + allocate(src_grid_dims(src_grid_rank), dst_grid_dims(dst_grid_rank)) + call check_ret(nf_inq_varid(fid,'src_grid_dims', vid)) + call check_ret(nf_get_var_int(fid,vid,src_grid_dims)) + call check_ret(nf_inq_varid(fid,'dst_grid_dims', vid)) + call check_ret(nf_get_var_int(fid,vid,dst_grid_dims)) + + rcode = nf_get_att_text(fid, NF_GLOBAL, 'grid_file_atm', str_grida) + if ( rcode == nf_enotatt ) then + call check_ret(nf_get_att_text(fid, NF_GLOBAL, 'grid_file_dst', str_grida)) + end if + + + write(6,*)'n,nv,ni,nj,na,ns= ',n,nv,ni,nj,na,ns + + allocate(xc(n)) ! x-coordinates of center for either _a or _b grid + allocate(yc(n)) ! y-coordinates of center for either _a or _b grid + allocate(xv(nv,n)) ! x-coordinates of verticies for either _a or _b grid + allocate(yv(nv,n)) ! y-coordinates of verticies for either _a or _b grid + allocate(area(n)) ! grid cell area + + call check_ret(nf_inq_varid(fid,'xc'//trim(suffix), vid)) + call check_ret(nf_get_att_text(fid, vid, 'units', units_xc)) + call check_ret(nf_get_var_double(fid,vid, xc )) + call check_ret(nf_inq_varid(fid,'yc'//trim(suffix), vid)) + call check_ret(nf_get_att_text(fid, vid, 'units', units_yc)) + call check_ret(nf_get_var_double(fid,vid, yc )) + call check_ret(nf_inq_varid(fid,'xv'//trim(suffix), vid)) + call check_ret(nf_get_var_double(fid,vid, xv )) + call check_ret(nf_inq_varid(fid,'yv'//trim(suffix), vid)) + call check_ret(nf_get_var_double(fid,vid, yv )) + call check_ret(nf_inq_varid(fid,'area'//trim(suffix), vid )) + call check_ret(nf_get_var_double(fid,vid,area )) + + !--- set default ocean frac --- + + allocate(omask(n)) ! domain mask ocean + allocate(ofrac(n)) ! area frac of mask "_a" on grid "_b" or float(mask) + + if (.not. complf) then + + ! Determine ocn mask on ocn grid + call check_ret(nf_inq_varid(fid,'mask'//trim(suffix), vid )) + call check_ret(nf_get_var_int (fid,vid,omask )) + ofrac(:) = c0 + where (omask /= 0) ofrac = c1 + + else + !---------------------------------------------------------------------------- + write(6,*) 'compute frac' + !---------------------------------------------------------------------------- + allocate(col(ns)) + allocate(row(ns)) + allocate(S(ns)) + allocate(mask_a(na)) + allocate(frac_a(na)) + + allocate(lmask(n)) ! domain mask land + allocate(lfrac(n)) ! area frac of mask "_a" on grid "_b" or float(mask) + + call check_ret(nf_inq_varid(fid,'col', vid )) + call check_ret(nf_get_var_int(fid,vid, col )) + call check_ret(nf_inq_varid(fid,'row', vid )) + call check_ret(nf_get_var_int(fid,vid, row )) + call check_ret(nf_inq_varid(fid,'S', vid )) + call check_ret(nf_get_var_double(fid,vid,S)) + call check_ret(nf_inq_varid(fid,'mask_a', vid )) + call check_ret(nf_get_var_int(fid,vid,mask_a )) + frac_a = c0 + where (mask_a /= 0) frac_a = c1 + !--- compute ocean fraction on atm grid --- + ofrac = c0 + do k = 1,ns + ofrac(row(k)) = ofrac(row(k)) + frac_a(col(k))*S(k) + enddo + !--- convert to land fraction, 1.0-frac and --- + !--- trap errors and modify computed frac --- + lmask(:) = 0 + omask(:) = 1 + lfrac_min = fmaxval + lfrac_max = fminval + do k = 1,n + lfrac(k) = c1 - ofrac(k) + lfrac_min = min(lfrac_min,lfrac(k)) + lfrac_max = max(lfrac_max,lfrac(k)) + if (lfrac(k) > fmaxval) lfrac(k) = c1 + if (lfrac(k) < fminval) lfrac(k) = c0 ! extra requirement for landfrac + ofrac(k) = c1 - lfrac(k) + if (lfrac(k) /= c0) then + lmask(k) = 1 + end if + if (ofrac(k) == c0) then + omask(k) = 0 + end if + enddo + write(6,*) '----------------------------------------------------------------------' + write(6,*) 'IMPORTANT: note original min/max frac and decide if that''s acceptable' + write(6,*) 'original lfrac clipped above by : ',fmaxval + write(6,*) 'original reset to zero when less than : ',fminval + write(6,*) 'original min, max lfrac : ',lfrac_min,lfrac_max + write(6,*) 'final min, max llfrac : ',minval(lfrac),maxval(lfrac) + write(6,*) '----------------------------------------------------------------------' + endif + + call check_ret(nf_close(fid)) + + !----------------------------------------------------------------- + ! adjust j = 1 and j = nj lats to -+ 90 degrees + !----------------------------------------------------------------- + + if (pole_fix) then + write(6,*)'ni,nj= ',ni,nj + if (ni > 1 .and. nj == 1) then + if (dst_grid_rank /= 2) then + write(6,*)'pole_fix not appropriate for unstructured grid' + stop + end if + end if + do i = 1,dst_grid_dims(1) + yc(i) = -c90 + yc(n-dst_grid_dims(1)+i) = c90 + enddo + endif + + !----------------------------------------------------------------- + ! create a new nc files + !----------------------------------------------------------------- + + write(6,*) ' ' + write(6,*) 'output domain data...' + + if (n /= ni*nj) then + STOP 'n' + end if + write(6,*) 'nf = ', nf + if (nf == 1) then + if (src_grid_rank == 2) then + ni = src_grid_dims(1) + nj = src_grid_dims(2) + end if + write(6,*) 'create ',trim(fn_out) + call check_ret(nf_create(fn_out(1:len_trim(fn_out)),NF_CLOBBER,fid)) + write(6,*) 'write ',trim(fn_out) + call write_file(fid, fmap, units_xc, units_yc, n, ni, nj, nv, & + xc, yc, xv, yv, area, omask, ofrac, suffix, eps, pole_fix, & + fmaxval, fminval, str_da, str_db, str_grido, str_grida) + call check_ret(nf_close(fid)) + write(6,*) 'successfully created domain file ', trim(fn_out) + else if (nf == 2) then + if (dst_grid_rank == 2) then + ni = dst_grid_dims(1) + nj = dst_grid_dims(2) + end if + call check_ret(nf_create(fn_out_lnd(1:len_trim(fn_out_lnd)),NF_CLOBBER,fid)) + write(6,*) 'write ',trim(fn_out_lnd) + call write_file(fid, fmap, units_xc, units_yc, n, ni, nj, nv, & + xc, yc, xv, yv, area, lmask, lfrac, suffix, eps, pole_fix, & + fmaxval, fminval, str_da, str_db, str_grido, str_grida) + call check_ret(nf_close(fid)) + write(6,*) 'successfully created domain file ', trim(fn_out_lnd) + + call check_ret(nf_create(fn_out_ocn(1:len_trim(fn_out_ocn)),NF_CLOBBER,fid)) + write(6,*) 'write ',trim(fn_out_ocn) + call write_file(fid, fmap, units_xc, units_yc, n, ni, nj, nv, & + xc, yc, xv, yv, area, omask, ofrac, suffix, eps, pole_fix, & + fmaxval, fminval, str_da, str_db, str_grido, str_grida) + call check_ret(nf_close(fid)) + write(6,*) 'successfully created domain file ', trim(fn_out_ocn) + end if + + enddo + + end subroutine gen_domain + +!=========================================================================== + + subroutine check_ret(ret) + ! Check return status from netcdf call + implicit none + integer, intent(in) :: ret + + if (ret /= NF_NOERR) then + write(6,*)'netcdf error with rcode = ', ret,' error = ', nf_strerror(ret) + call abort() + end if + + end subroutine check_ret + + subroutine usage_exit (arg) + implicit none + character(len=*) :: arg + if (arg /= ' ') then + write (6,*) arg + end if + write(6,*) ' Purpose:' + write(6,*) ' Given a SCRIP map matrix data file from the ocean grid ' + write(6,*) ' (where the mask is defined) to the land grid, gen_domain ' + write(6,*) ' creates land and ocean domain files' + write(6,*) ' These files are currently used by ' + write(6,*) ' datm, dlnd, dice, docn, clm, cice(prescribed mode)' + write(6,*) ' ' + write(6,*) ' Usage: ' + write(6,*) ' gen_domain -m ' + write(6,*) ' -o ' + write(6,*) ' -l ' + write(6,*) ' [-p set_fv_pole_yc]' + write(6,*) ' [-c ]' + write(6,*) ' ' + write(6,*) ' Where: ' + write(6,*) ' filemap = input conservative mapping file name (from ocn->atm)' + write(6,*) ' gridocn = output ocean grid name' + write(6,*) ' gridlnd = output land grid name' + write(6,*) ' set_fv_pole_yc = [0,1,2] ~ optional, default = 0' + write(6,*) ' usercomment = optional, netcdf global attribute (character string)' + write(6,*) ' ' + write(6,*) ' The following output domain files are created:' + write(6,*) ' domain.lnd.gridlnd_gridocn.nc' + write(6,*) ' land domain file on the land grid with a ' + write(6,*) ' land fraction corresponding to ' + write(6,*) ' (1-gridocn) mask mapped to the land grid' + write(6,*) ' domain.ocn.gridlnd_gridocn.nc' + write(6,*) ' ocean domain on the land grid with an ' + write(6,*) ' ocean fraction corresponding to the ' + write(6,*) ' gridocn mask mapped to the land grid' + write(6,*) ' this is used when both atm,lnd,ice,ocn are all on the' + write(6,*) ' same grid (F compset)' + write(6,*) ' domain.ocn.gridocn.nc' + write(6,*) ' ocean domain on the ocean grid ' + write(6,*) ' ' + stop + end subroutine usage_exit + +!=========================================================================== + + subroutine write_file(fid, fmap, units_xc, units_yc, n, ni, nj, nv, & + xc, yc, xv, yv, area, mask, frac, suffix, eps, pole_fix, & + fmaxval, fminval, str_da, str_db, str_grido, str_grida) + + implicit none + + !--- includes --- + include 'netcdf.inc' ! netCDF defs + + integer , intent(in) :: fid ! nc file ID + character(LEN=*), intent(in) :: fmap ! file name ( input nc file) + character(LEN=*), intent(in) :: units_xc, units_yc ! netCDF attribute name string + integer , intent(in) :: n ! size of 1d domain + integer , intent(in) :: ni ! size of i-axis of 2d domain + integer , intent(in) :: nj ! size of j-axis of 2d domain + integer , intent(in) :: nv ! number of vertices + real(r8) , pointer :: xc(:) ! x-coords of center + real(r8) , pointer :: yc(:) ! y-coords of center + real(r8) , pointer :: xv(:,:) ! x-coords of verticies + real(r8) , pointer :: yv(:,:) ! y-coords of verticies + real(r8) , pointer :: area(:) ! cell area + integer , pointer :: mask(:) ! domain mask + real(r8) , pointer :: frac(:) ! cell fraction + character(LEN=*), intent(in) :: suffix ! suffix _a or _b sets input grid + real(r8) , intent(in) :: eps ! allowable frac error + logical , intent(in) :: pole_fix ! fix pole ycs + real(r8) , intent(in) :: fminval ! set frac to zero if frac < fminval + real(r8) , intent(in) :: fmaxval ! set frac to one if frac > fmaxval + character(LEN=*), intent(in) :: str_da ! global attribute str - domain_a + character(LEN=*), intent(in) :: str_db ! global attribute str - domain_b + character(LEN=*), intent(in) :: str_grido ! global attribute str - grid_file_ocn + character(LEN=*), intent(in) :: str_grida ! global attribute str - grid_file_atm + + !--- local --- + character(LEN=CL) :: host ! hostname of machine running on + character(LEN=CL) :: str ! fixed length char string + character(LEN=CL) :: str_title ! global attribute str - title + character(LEN=CL) :: str_source ! global attribute str - source + character(LEN=CL) :: user ! user name + integer :: strlen ! (trimmed) length of string + integer :: vid ! nc variable ID + integer :: did ! nc dimension ID + integer :: vdid(3) ! vector of nc dimension ID + integer :: rcode ! routine return error code + + real(r8),parameter :: pi = 3.14159265358979323846 + character(*),parameter:: version = 'SVN $Id: gen_domain.F90 65202 2014-11-06 21:07:45Z mlevy@ucar.edu $' + + ! global attributes + str = 'CESM domain data: ' + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'title' ,len_trim(str),str)) + + str = 'CF-1.0' + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'Conventions',len_trim(str),str)) + + str = trim(version) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'source_code',len_trim(str),str)) + + str = ' $URL: https://svn-ccsm-models.cgd.ucar.edu/tools/mapping/gen_domain/trunk/src/gen_domain.F90 $' + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'SVN_url',len_trim(str),str)) + +#ifdef OPT + str = 'TRUE' +#else + str = 'FALSE' +#endif + + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'Compiler_Optimized',len_trim(str),str)) + + call sys_getenv('HOST',host,rcode) + if (rcode == 0) then + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'hostname' ,len_trim(host),host)) + else + call sys_getenv('HOSTNAME',host,rcode) + if (rcode == 0) then + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'hostname' ,len_trim(host),host)) + else + write(6,*) 'WARNING: could not determine hostname, so that information will not be stored in netCDF attribute. To avoid this warning in the future, set environment variable HOST or HOSTNAME.' + end if + end if + + call sys_getenv('LOGNAME',user,rcode) + if (rcode /= 0) then + write(6,*) ' ERROR: getting LOGNAME' + stop + end if + str = 'created by '//trim(user)//', '//cdate(1:4)//'-'//cdate(5:6)//'-'//cdate(7:8) & + & //' '//ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'history' ,len_trim(str),str)) + + str = trim(fmap) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'source' ,len_trim(str),str)) + str = trim(str_da) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'map_domain_a',len_trim(str),str)) + str = trim(str_db) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'map_domain_b',len_trim(str),str)) + str = trim(str_grido) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'map_grid_file_ocn',len_trim(str),str)) + str = trim(str_grida) + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'map_grid_file_atm',len_trim(str),str)) + str = trim(usercomment) + if ( str(1:4) /= 'null' ) then + call check_ret(nf_put_att_text(fid,NF_GLOBAL,'user_comment',len_trim(str),str)) + end if + + !----------------------------------------------------------------- + ! dimension data + !----------------------------------------------------------------- + call check_ret(nf_def_dim(fid, 'n' , n , did)) ! # of points total + call check_ret(nf_def_dim(fid, 'ni', ni, did)) ! # of points wrt i + call check_ret(nf_def_dim(fid, 'nj', nj, did)) ! # of points wrt j + call check_ret(nf_def_dim(fid, 'nv', nv, did)) ! # of verticies per cell + + !----------------------------------------------------------------- + ! define data -- coordinates, input grid + !----------------------------------------------------------------- + + call check_ret(nf_inq_dimid(fid,'n' , did )) + call check_ret(nf_inq_dimid(fid,'ni',vdid(1))) + call check_ret(nf_inq_dimid(fid,'nj',vdid(2))) + + call check_ret(nf_def_var (fid,'xc',NF_DOUBLE,2,vdid,vid)) + str = 'longitude of grid cell center' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'degrees_east' + call check_ret(nf_put_att_text(fid,vid,"units" ,len_trim(str),str)) + str = 'xv' + call check_ret(nf_put_att_text(fid,vid,"bounds" ,len_trim(str),str)) + + call check_ret(nf_def_var (fid,'yc',NF_DOUBLE,2,vdid,vid)) + str = 'latitude of grid cell center' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'degrees_north' + call check_ret(nf_put_att_text(fid,vid,"units" ,len_trim(str),str)) + str = 'yv' + call check_ret(nf_put_att_text(fid,vid,"bounds" ,len_trim(str),str)) + if (pole_fix) then + write(str,*) 'set_fv_pole_yc ON, yc = -+90 at j=1,j=nj' + call check_ret(nf_put_att_text(fid,vid,'filter1' ,len_trim(str),str)) + endif + + call check_ret(nf_inq_dimid(fid,'nv',vdid(1))) + call check_ret(nf_inq_dimid(fid,'ni',vdid(2))) + call check_ret(nf_inq_dimid(fid,'nj',vdid(3))) + + call check_ret(nf_def_var (fid,'xv',NF_DOUBLE,3,vdid,vid)) + str = 'longitude of grid cell verticies' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'degrees_east' + call check_ret(nf_put_att_text(fid,vid,"units" ,len_trim(str),str)) + + call check_ret(nf_def_var (fid,'yv',NF_DOUBLE,3,vdid,vid)) + str = 'latitude of grid cell verticies' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'degrees_north' + call check_ret(nf_put_att_text(fid,vid,"units" ,len_trim(str),str)) + + call check_ret(nf_inq_dimid(fid,'ni',vdid(1))) + call check_ret(nf_inq_dimid(fid,'nj',vdid(2))) + + call check_ret(nf_def_var (fid,'mask',NF_INT ,2,vdid,vid)) + str = 'domain mask' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'unitless' + call check_ret(nf_put_att_text(fid,vid,"note" ,len_trim(str),str)) + str = 'xc yc' + call check_ret(nf_put_att_text(fid,vid,"coordinates",len_trim(str),str)) + str = '0 value indicates cell is not active' + call check_ret(nf_put_att_text(fid,vid,"comment",len_trim(str),str)) + + call check_ret(nf_def_var (fid,'area',NF_DOUBLE,2,vdid,vid)) + str = 'area of grid cell in radians squared' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'xc yc' + call check_ret(nf_put_att_text(fid,vid,"coordinates",len_trim(str),str)) + str = 'radian2' + call check_ret(nf_put_att_text(fid,vid,"units" ,len_trim(str),str)) + + call check_ret(nf_def_var (fid,'frac',NF_DOUBLE ,2,vdid,vid)) + str = 'fraction of grid cell that is active' + call check_ret(nf_put_att_text(fid,vid,"long_name",len_trim(str),str)) + str = 'xc yc' + call check_ret(nf_put_att_text(fid,vid,"coordinates",len_trim(str),str)) + str = 'unitless' + call check_ret(nf_put_att_text(fid,vid,"note" ,len_trim(str),str)) + write(str,'(a,g14.7)') 'error if frac> 1.0+eps or frac < 0.0-eps; eps =',eps + call check_ret(nf_put_att_text(fid,vid,'filter1' ,len_trim(str),str)) + write(str,'(a,g14.7,a,g14.7)') 'limit frac to [fminval,fmaxval]; fminval=',fminval,' fmaxval=',fmaxval + call check_ret(nf_put_att_text(fid,vid,'filter2' ,len_trim(str),str)) + + call check_ret(nf_enddef(fid)) + + if (units_xc(1:7) == 'radians') then + xc = xc * 180._r8 / pi + xv = xv * 180._r8 / pi + end if + if (units_yc(1:7) == 'radians') then + yc = yc * 180._r8 / pi + yv = yv * 180._r8 / pi + end if + + call check_ret(nf_inq_varid(fid, 'xc', vid)) + call check_ret(nf_put_var_double(fid, vid , xc)) + + call check_ret(nf_inq_varid(fid, 'yc',vid)) + call check_ret(nf_put_var_double(fid, vid , yc)) + + call check_ret(nf_inq_varid(fid, 'xv',vid)) + call check_ret(nf_put_var_double(fid, vid , xv)) + + call check_ret(nf_inq_varid(fid, 'yv',vid)) + call check_ret(nf_put_var_double(fid, vid , yv)) + + call check_ret(nf_inq_varid(fid,'mask',vid)) + call check_ret(nf_put_var_int (fid, vid ,mask)) + + call check_ret(nf_inq_varid(fid,'area',vid)) + call check_ret(nf_put_var_double(fid, vid ,area)) + + call check_ret(nf_inq_varid(fid,'frac',vid)) + call check_ret(nf_put_var_double(fid, vid ,frac)) + + end subroutine write_file +SUBROUTINE sys_getenv(name, val, rcode) + + IMPLICIT none + + !----- arguments ----- + character(*) ,intent(in) :: name ! env var name + character(*) ,intent(out) :: val ! env var value + integer,intent(out) :: rcode ! return code + + !----- local ----- + integer :: lenname ! length of env var name + integer :: lenval ! length of env var value + character(len=80) :: tmpval ! temporary env var value + + !----- formats ----- + character(*),parameter :: subName = '(shr_sys_getenv) ' + character(*),parameter :: F00 = "('(shr_sys_getenv) ',4a)" + +!------------------------------------------------------------------------------- +! PURPOSE: an architecture independant system call +!------------------------------------------------------------------------------- + + lenname=len_trim(name) + +#if (defined IRIX64 || defined CRAY || defined UNICOSMP) + + call pxfgetenv(name, lenname, val, lenval, rcode) + +#elif (defined AIX || defined OSF1 || defined SUNOS || defined LINUX || defined NEC_SX) +#ifdef F2003 + call GET_ENVIRONMENT_VARIABLE(trim(name),value=val, length=lenval, status=rcode) +#else + call getenv(trim(name),tmpval) + val=trim(tmpval) + rcode = 0 + if (len_trim(val) == 0 ) rcode = 1 + if (len_trim(val) > CL) rcode = 2 +#endif +#else + + write(*,F00) 'ERROR: no implementation of getenv for this architecture' + stop subname//'no implementation of getenv for this machine' + +#endif + +END SUBROUTINE sys_getenv + + +end program fmain diff --git a/components/clm/tools/shared/mkmapdata/README b/components/clm/tools/shared/mkmapdata/README new file mode 100644 index 0000000000..6b7ef835ef --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/README @@ -0,0 +1,86 @@ +components/clm/tools/mkmapdata/README Feb/28/2014 + +The routines in this directory create a mapping dataset from +SCRIP grid files to map from one grid to another. These mapping files +are used by either CLM or mksurfdata_map to regrid from one resolution +to another. + +The script uses ESMF and requires that ESMF be built and the path +for ESMF binary files (using the program ESMF_RegridWeightGen) +be given as input to the script. You need to build at least +two versions, one with mpiuni and one with mpi. Both versions +also need to be built with NetCDF rather than the default +IO version. + +Currently uses: ESMF6.2.0 + +Do the following for help with the different options to the script... + + ./mkmapdata.sh -help + +The following steps provide a method to create the executable +and generate the grid map dataset: + +0) Background tasks you only have to do once + + a.) Export the input SCRIP grid files for the resolutions you'll need + + Most of these files are on the Subversion inputdata server at... + + https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata/lnd/clm2/mappingdata/grids/ + + Supported machines also have a copy on the CESM DIN_LOC_ROOT location + for that machine. + + b.) Obtain and build the versions of ESMF required for this script + +The version needs to support ESMF_RegridWeightGen and support the +options passed to it in the mkmapdata.sh script. As such it needs +to be built with NetCDF. You also need to build at least one +version with mpiuni and one with an mpi library. You also need +a version that supports the options: --netcdf4, --64bit_offset +and --src_type UGRID. + + http://www.earthsystemmodeling.org/ + +You may need more than one version to do everything above. On yellowstone +we use ESMF6.1.1 for the normal operations and ESMF6.2.0-bs18 for +the operations that need --netcdf4 and/or -src_type UGRID. + +The version of NetCDF used with ESMF needs to be version 4.1 or higher +and compiled with the NetCDF4 file format enabled (with HDF5 compression). +That will enable the --netcdf4 and --64bit_offset options to be used. + +1) cd to this directory + +2) Create map dataset(s) + Option A.) Use mkmapdata.sh directly + run script(e.g.): (see header of mkmapdata.sh for other environment that can be set) + + Example for standard resolutions + ./mkmapdata.sh -r 10x15 + Example for non-standard resolutions where you provide an input SCRIP grid file. + ./mkmapdata.sh -f + + Option B.) Alternatively, run regridbatch.sh to run mkmapdata.sh for a bunch of + different resolutions. + + Option C.) Alternatively, run mknoocnmap.pl to create a single-point/regional + map for an area without ocean. + + ./mknoocnmap.pl -help # for help on this script + +3) move (and rename if appropriate) generated map datasets + to $DIN_LOC_ROOT/lnd/clm/mappingdata/maps, etc. + + +Important files: + + regridbatch.sh ------- Script to run mkmapdata.sh for many resolutions + mvNimport.sh --------- Script to copy and import mapping files in for many resolutions + mkmapdata.sh --------- Script to create mapping datasets for a given resolution + + mknoocnmap.pl -------- Script to create unity mapping dataset for single-point + or regional studies over land-only (no ocean). + mkunitymap.ncl ------- NCL script to create a unity map -- ran by above script + diff --git a/components/clm/tools/shared/mkmapdata/createXMLEntries.pl b/components/clm/tools/shared/mkmapdata/createXMLEntries.pl new file mode 100755 index 0000000000..c65e6888f7 --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/createXMLEntries.pl @@ -0,0 +1,116 @@ +#!/usr/bin/env perl + +# Creates a file giving XML entries for all the mapping files in the +# current directory (mapping_entries.txt). Also creates another file +# giving commands to move these files to the inputdata space +# (mv_cmds.sh). +# +# Should be run with no arguments. +# +# See also bld/namelist_files/createMapEntry.pl, and mvNimport.sh in +# the current directory for scripts that share some of the +# functionality of this script. + +# Bill Sacks +# March, 2013 + +use strict; + +# ---------------------------------------------------------------------- +# FUNCTIONS +# ---------------------------------------------------------------------- + +# Given a map filename, returns a hash giving the resolutions and +# masks implicit in that filename. +# Inputs: +# - filename +# Output: +# - hash containing: +# - filename +# - from_res +# - from_mask +# - to_res +# - to_mask +# Or does a bare return if the filename doesn't match the expected pattern +sub get_resolutions_and_masks { + my $filename = shift; + + # The following match assumes that the destination mask is + # "nomask". This match will tolerate underscores in the + # destination grid (e.g., 5x5_amazon), but be careful about + # underscores in the source grid or source mask! + if ($filename =~ m/^map_(.*)_(.*)_to_(.*)_nomask/) { + my $from_res=$1; + my $from_mask=$2; + my $to_res=$3; + my $to_mask="nomask"; + + my %info = (filename => $filename, + from_res => $from_res, + from_mask => $from_mask, + to_res => $to_res, + to_mask => $to_mask); + + return %info; + } + else { + return; + } +} + + +# ---------------------------------------------------------------------- +# PARAMETERS DEFINED HERE +# ---------------------------------------------------------------------- + +my $CSMDATA = "/glade/p/cesm/cseg/inputdata"; +my $maps_dir = "lnd/clm2/mappingdata/maps"; # directory where mapping files are stored within the inputdata directory + +# ---------------------------------------------------------------------- +# BEGIN MAIN PROGRAM +# ---------------------------------------------------------------------- + +my @files = glob "map*.nc"; + +# Make a hash containing all of the files at each destination resolution. +# The keys of the hash are destination resolutions; the values are +# references to arrays of hash references, where these low-level +# hashes are the return values of get_resolutions_and_masks. +my %dest_resols; +foreach my $file (@files) { + my %info = get_resolutions_and_masks($file); + if (%info) { + my $to_res = $info{'to_res'}; + push @{$dest_resols{$to_res}}, \%info; + } + else { + warn "WARNING: $file doesn't match expected mapping filename pattern; skipping\n"; + } +} + +open MAP_ENTRIES, ">", "mapping_entries.txt"; +open MV_CMDS, ">", "mv_cmds.sh"; + +# Output xml entries (and mv commands) grouped by destination resolution +foreach my $to_res (sort keys %dest_resols) { + my $full_maps_dir = "$maps_dir/$to_res"; + + foreach my $info_ref (@{$dest_resols{$to_res}}) { + my $filename = ${$info_ref}{'filename'}; + my $from_res = ${$info_ref}{'from_res'}; + my $from_mask = ${$info_ref}{'from_mask'}; + my $to_res = ${$info_ref}{'to_res'}; + my $to_mask = ${$info_ref}{'to_mask'}; + + print MV_CMDS "mv $filename $CSMDATA/$full_maps_dir/$filename\n"; + print MAP_ENTRIES "$full_maps_dir/$filename\n"; + } + + # Print blank line between destination grids + print MAP_ENTRIES "\n"; +} + +system "chmod", "755", "mv_cmds.sh"; +close MAP_ENTRIES; +close MV_CMDS; diff --git a/components/clm/tools/shared/mkmapdata/mkmapdata.sh b/components/clm/tools/shared/mkmapdata/mkmapdata.sh new file mode 100755 index 0000000000..fa10e8846c --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/mkmapdata.sh @@ -0,0 +1,549 @@ +#!/bin/bash +#---------------------------------------------------------------------- +# +# mkmapdata.sh +# +# Create needed mapping files for mksurfdata_map and CLM. +# +# Example to run for an output resolution of 4x5 +# +# mkmapdata.sh -r 4x5 +# +# valid arguments: +# -f Input grid filename +# -t Output type, supported values are [regional, global] +# -r Output resolution +# -p CLM version to use (clm4_0 or clm4_5) (defaults to clm4_5) +# -b use batch mode (not default) +# -l list mapping files required (so can use check_input_data to get them) +# -d debug usage -- display mkmapdata that will be run but don't execute them +# -v verbose usage -- log more information on what is happening +# -h displays this help message +# +# You can also set the following env variables: +# +# ESMFBIN_PATH - Path to ESMF binaries +# CSMDATA ------ Path to CESM input data +# MPIEXEC ------ Name of mpirun executable +# REGRID_PROC -- Number of MPI processors to use +# +#---------------------------------------------------------------------- +echo $0 +dir=${0%/*} +if [ "$dir" = "$0" ];then + dir="." +fi +outfilelist="clm.input_data_list" +default_res="10x15" + +#---------------------------------------------------------------------- +# SET SOME DEFAULTS -- if not set via env variables outside + +if [ -z "$CSMDATA" ]; then + CSMDATA=/glade/p/cesm/cseg/inputdata +fi +if [ -z "$REGRID_PROC" ]; then + REGRID_PROC=8 +fi +#---------------------------------------------------------------------- +# Usage subroutine +usage() { + echo "" + echo "**********************" + echo "usage on yellowstone:" + echo "./mkmapdata.sh" + echo "" + echo "valid arguments: " + echo "[-f|--gridfile ] " + echo " Full pathname of model SCRIP grid file to use " + echo " This variable should be set if this is not a supported grid" + echo " This variable will override the automatic generation of the" + echo " filename generated from the -res argument " + echo " the filename is generated ASSUMING that this is a supported " + echo " grid that has entries in the file namelist_defaults_clm.xml" + echo " the -r|--res argument MUST be specied if this argument is specified" + echo "[-r|--res ]" + echo " Model output resolution (default is $default_res)" + echo "[-t|--gridtype ]" + echo " Model output grid type" + echo " supported values are [regional,global], (default is global)" + echo "[-p|--phys ]" + echo " Whether to generate mapping files for clm4_0 or clm4_5" + echo " supported values are [clm4_0,clm4_5], (default is clm4_5)" + echo "[-b|--batch]" + echo " Toggles batch mode usage. If you want to run in batch mode" + echo " you need to have a separate batch script for a supported machine" + echo " that calls this script interactively - you cannot submit this" + echo " script directory to the batch system" + echo "[-l|--list]" + echo " List mapping files required (use check_input_data to get them)" + echo " also writes data to $outfilelist" + echo "[-d|--debug]" + echo " Toggles debug-only (don't actually run mkmapdata just echo what would happen)" + echo "[-h|--help] " + echo " Displays this help message" + echo "[-v|--verbose]" + echo " Toggle verbose usage -- log more information on what is happening " + echo "" + echo " You can also set the following env variables:" + echo " ESMFBIN_PATH - Path to ESMF binaries " + echo " CSMDATA ------ Path to CESM input data" + echo " (default is /glade/p/cesm/cseg/inputdata)" + echo " MPIEXEC ------ Name of mpirun executable" + echo " (default is mpirun.lsf)" + echo " REGRID_PROC -- Number of MPI processors to use" + echo " (default is 8)" + echo "" + echo "**pass environment variables by preceding above commands " + echo " with 'env var1=setting var2=setting '" + echo "**********************" +} +#---------------------------------------------------------------------- +# runcmd subroutine +#---------------------------------------------------------------------- + +runcmd() { + cmd=$@ + if [ -z "$cmd" ]; then + echo "No command given to the runcmd function" + exit 3 + fi + if [ "$verbose" = "YES" ]; then + echo "$cmd" + fi + if [ "$debug" != "YES" ]; then + ${cmd} + rc=$? + else + rc=0 + fi + if [ $rc != 0 ]; then + echo "Error status returned from mkmapdata script" + exit 4 +undo + fi + return 0 +} + +#---------------------------------------------------------------------- +# Process input arguments +#---------------------------------------------------------------------- + +interactive="YES" +debug="no" +res="default" +type="global" +phys="clm4_5" +verbose="no" +list="no" +outgrid="" +gridfile="default" + +while [ $# -gt 0 ]; do + case $1 in + -v|-V) + verbose="YES" + ;; + -b|--batch) + interactive="NO" + ;; + -d|--debug) + debug="YES" + ;; + -l|--list) + debug="YES" + list="YES" + ;; + -r|--res) + res=$2 + shift + ;; + -f|--gridfile) + gridfile=$2 + shift + ;; + -t|--gridtype) + type=$2 + shift + ;; + -p|--phys) + phys=$2 + shift + ;; + -h|--help ) + usage + exit 0 + ;; + * ) + echo "ERROR:: invalid argument sent in: $2" + usage + exit 1 + ;; + esac + shift +done + +echo "Script to create mapping files required by mksurfdata_map" + +#---------------------------------------------------------------------- +# Determine output scrip grid file +#---------------------------------------------------------------------- + +# Set general query command used below +QUERY="$dir/../../../bld/queryDefaultNamelist.pl -silent -namelist clmexp -phys $phys " +QUERY="$QUERY -justvalue -options sim_year=2000 -csmdata $CSMDATA" +echo "query command is $QUERY" + +echo "" +DST_EXTRA_ARGS="" +if [ "$gridfile" != "default" ]; then + GRIDFILE=$gridfile + echo "Using user specified scrip grid file: $GRIDFILE" + if [ "$res" = "default" ]; then + echo "When user specified grid file is given you MUST set the resolution (as the name of your grid)\n"; + exit 1 + fi + + # For now, make some assumptions about user-specified grids -- + # that they are SCRIP format, and small enough to not require + # large file support for the output mapping file. In the future, + # we may want to provide command-line options to allow the user to + # override these defaults. + DST_LRGFIL="none" + DST_TYPE="SCRIP" +else + if [ "$res" = "default" ]; then + res=$default_res + fi + + QUERYARGS="-res $res -options lmask=nomask" + + # Find the output grid file for this resolution using the XML database + QUERYFIL="$QUERY -var scripgriddata $QUERYARGS -onlyfiles" + if [ "$verbose" = "YES" ]; then + echo $QUERYFIL + fi + GRIDFILE=`$QUERYFIL` + echo "Using default scrip grid file: $GRIDFILE" + + # Determine extra information about the destination grid file + DST_LRGFIL=`$QUERY -var scripgriddata_lrgfile_needed $QUERYARGS` + DST_TYPE=`$QUERY -var scripgriddata_type $QUERYARGS` + if [ "$DST_TYPE" = "UGRID" ]; then + # For UGRID, we need extra information: the meshname variable + dst_meshname=`$QUERY -var scripgriddata_meshname $QUERYARGS` + DST_EXTRA_ARGS="$DST_EXTRA_ARGS --dst_meshname $dst_meshname" + fi +fi + +if [ "$type" = "global" ] && [ `echo "$res" | grep -c "1x1_"` = 1 ]; then + echo "This is a regional resolution and yet it is being run as global, set type with '-t' option\n"; + exit 1 +fi +echo "Output grid resolution is $res" +if [ -z "$GRIDFILE" ]; then + echo "Output grid file was NOT found for this resolution: $res\n"; + exit 1 +fi + +if [ "$list" = "YES" ]; then + echo "outgrid = $GRIDFILE" + echo "outgrid = $GRIDFILE" > $outfilelist +elif [ ! -f "$GRIDFILE" ]; then + echo "Input SCRIP grid file does NOT exist: $GRIDFILE\n"; + echo "Make sure CSMDATA environment variable is set correctly" + exit 1 +fi + +#---------------------------------------------------------------------- +# Determine all input grid files and output file names +#---------------------------------------------------------------------- + +if [ "$phys" = "clm4_0" ]; then + grids=( \ + "0.5x0.5_USGS" \ + "0.5x0.5_AVHRR" \ + "0.5x0.5_MODIS" \ + "3x3min_LandScan2004" \ + "3x3min_MODIS" \ + "3x3min_USGS" \ + "5x5min_nomask" \ + "5x5min_IGBP-GSDP" \ + "5x5min_ISRIC-WISE" \ + "10x10min_nomask" \ + "3x3min_GLOBE-Gardner" \ + "3x3min_GLOBE-Gardner-mergeGIS" ) + +elif [ "$phys" = "clm4_5" ]; then + grids=( \ + "0.5x0.5_AVHRR" \ + "0.5x0.5_MODIS" \ + "3x3min_LandScan2004" \ + "3x3min_MODIS" \ + "3x3min_USGS" \ + "5x5min_nomask" \ + "5x5min_IGBP-GSDP" \ + "5x5min_ISRIC-WISE" \ + "10x10min_nomask" \ + "10x10min_IGBPmergeICESatGIS" \ + "3x3min_GLOBE-Gardner" \ + "3x3min_GLOBE-Gardner-mergeGIS" \ + "0.9x1.25_GRDC" \ + "360x720cru_cruncep" \ + "1km-merge-10min_HYDRO1K-merge-nomask" ) + +else + echo "ERROR: Unknown value for phys: $phys" + exit 1 +fi + +# Set timestamp for names below +CDATE="c"`date +%y%m%d` + +# Set name of each output mapping file +# First determine the name of the input scrip grid file +# for each of the above grids +declare -i nfile=1 +for gridmask in ${grids[*]} +do + grid=${gridmask%_*} + lmask=${gridmask#*_} + + QUERYARGS="-res $grid -options lmask=$lmask,glc_nec=10 " + + QUERYFIL="$QUERY -var scripgriddata $QUERYARGS -onlyfiles" + if [ "$verbose" = "YES" ]; then + echo $QUERYFIL + fi + INGRID[nfile]=`$QUERYFIL` + if [ "$list" = "YES" ]; then + echo "ingrid = ${INGRID[nfile]}" + echo "ingrid = ${INGRID[nfile]}" >> $outfilelist + fi + + OUTFILE[nfile]=map_${grid}_${lmask}_to_${res}_nomask_aave_da_$CDATE.nc + + # Determine extra information about the source grid file + SRC_EXTRA_ARGS[nfile]="" + SRC_LRGFIL[nfile]=`$QUERY -var scripgriddata_lrgfile_needed $QUERYARGS` + SRC_TYPE[nfile]=`$QUERY -var scripgriddata_type $QUERYARGS` + if [ "${SRC_TYPE[nfile]}" = "UGRID" ]; then + # For UGRID, we need extra information: the meshname variable + src_meshname=`$QUERY -var scripgriddata_meshname $QUERYARGS` + SRC_EXTRA_ARGS[nfile]="${SRC_EXTRA_ARGS[nfile]} --src_meshname $src_meshname" + fi + + nfile=nfile+1 +done + +#---------------------------------------------------------------------- +# Determine supported machine specific stuff +#---------------------------------------------------------------------- + +hostname=`hostname` +if [ -n "$NERSC_HOST" ]; then + hostname=$NERSC_HOST +fi +case $hostname in + ##yellowstone + ys* | caldera* | geyser* ) + . /glade/apps/opt/lmod/lmod/init/bash + module load esmf + module load ncl + module load nco + + if [ -z "$ESMFBIN_PATH" ]; then + if [ "$type" = "global" ]; then + mpi=mpi + mpitype="mpich2" + else + mpi=uni + mpitype="mpiuni" + fi + ESMFBIN_PATH=/glade/apps/opt/esmf/6.3.0-ncdfio/intel/12.1.5/bin/binO/Linux.intel.64.${mpitype}.default + fi + if [ -z "$MPIEXEC" ]; then + MPIEXEC="mpirun.lsf" + fi + ;; + + ## hopper + hopper* ) + . /opt/modules/default/init/bash + module load ncl/6.1.2 + module load nco + if [ -z "$ESMFBIN_PATH" ]; then + module use -a /project/projectdirs/ccsm1/modulefiles/hopper + if [ "$type" = "global" ]; then + mpi=mpi + mpitype="mpi" + else + mpi=uni + mpitype="mpiuni" + fi + module load esmf/6.3.0r-ncdfio-${mpitype}-O + ESMFBIN_PATH=$ESMF_LIBDIR/../bin + fi + if [ -z "$MPIEXEC" ]; then + MPIEXEC="aprun -n $REGRID_PROC" + fi + + ;; + + ## edison + edison* ) + . /opt/modules/default/init/bash + module load ncl/6.1.1 + module load nco + if [ -z "$ESMFBIN_PATH" ]; then + module use -a /project/projectdirs/ccsm1/modulefiles/edison + if [ "$type" = "global" ]; then + mpi=mpi + mpitype="mpi" + else + mpi=uni + mpitype="mpiuni" + fi + module load esmf/6.3.0r-ncdfio-${mpitype}-O + ESMFBIN_PATH=$ESMF_LIBDIR/../bin + fi + if [ -z "$MPIEXEC" ]; then + MPIEXEC="aprun -n $REGRID_PROC" + fi + + ;; + ##no other machine currently supported + *) + echo "Machine $hostname NOT recognized" + ;; + +esac + +# Error checks +if [ ! -d "$ESMFBIN_PATH" ]; then + echo "Path to ESMF binary directory does NOT exist: $ESMFBIN_PATH" + echo "Set the environment variable: ESMFBIN_PATH" + exit 1 +fi + +#---------------------------------------------------------------------- +# Generate the mapping files needed for surface dataset generation +#---------------------------------------------------------------------- + +# Resolve interactive or batch mode command +# NOTE - if you want to run in batch mode - you need to have a separate +# batch file that calls this script interactively - you cannot submit +# this script to the batch system + +if [ "$interactive" = "NO" ]; then + echo "Running in batch mode using MPI" + if [ -z "$MPIEXEC" ]; then + echo "Name of MPI exec to use was NOT set" + echo "Set the environment variable: MPIEXEC" + exit 1 + fi + if [ ! -x `which $MPIEXEC` ]; then + echo "The MPIEXEC pathname given is NOT an executable: $MPIEXEC" + echo "Set the environment variable: MPIEXEC or run in interactive mode without MPI" + exit 1 + fi + mpirun=$MPIEXEC + echo "Running in batch mode" +else + mpirun="" +fi + +ESMF_REGRID="$ESMFBIN_PATH/ESMF_RegridWeightGen" +if [ ! -x "$ESMF_REGRID" ]; then + echo "ESMF_RegridWeightGen does NOT exist in ESMF binary directory: $ESMFBIN_PATH\n" + echo "Upgrade to a newer version of ESMF with this utility included" + echo "Set the environment variable: ESMFBIN_PATH" + exit 1 +fi + +# Remove previous log files +rm PET*.Log + +# +# Now run the mapping for each file, checking that input files exist +# and then afterwards that the output mapping file exists +# +declare -i nfile=1 +until ((nfile>${#INGRID[*]})); do + echo "Creating mapping file: ${OUTFILE[nfile]}" + echo "From input grid: ${INGRID[nfile]}" + echo "For output grid: $GRIDFILE" + echo " " + if [ -z "${INGRID[nfile]}" ] || [ -z "$GRIDFILE" ] || [ -z "${OUTFILE[nfile]}" ]; then + echo "Either input or output grid or output mapping file is NOT set" + exit 3 + fi + if [ ! -f "${INGRID[nfile]}" ]; then + echo "Input grid file does NOT exist: ${INGRID[nfile]}" + if [ ! "$list" = "YES" ]; then + exit 2 + fi + fi + if [ ! -f "$GRIDFILE" ]; then + echo "Output grid file does NOT exist: $GRIDFILE" + exit 3 + fi + + # Determine what (if any) large file support is needed. Use the + # most extreme large file support needed by either the source file + # or the destination file. + if [ "$DST_LRGFIL" = "netcdf4" ] || [ "${SRC_LRGFIL[nfile]}" = "netcdf4" ]; then + lrgfil="--netcdf4" + elif [ "$DST_LRGFIL" = "64bit_offset" ] || [ "${SRC_LRGFIL[nfile]}" = "64bit_offset" ]; then + lrgfil="--64bit_offset" + elif [ "$DST_LRGFIL" = "none" ] && [ "${SRC_LRGFIL[nfile]}" = "none" ]; then + lrgfil="" + else + echo "Unknown LRGFIL type:" + echo "DST_LRGFIL = $DST_LRGFIL" + echo "SRC_LRGFIL = ${SRC_LRGFIL[nfile]}" + exit 4 + fi + + # Skip if file already exists + if [ -f "${OUTFILE[nfile]}" ]; then + echo "Skipping creation of ${OUTFILE[nfile]} as already exists" + else + + cmd="$mpirun $ESMF_REGRID --ignore_unmapped -s ${INGRID[nfile]} " + cmd="$cmd -d $GRIDFILE -m conserve -w ${OUTFILE[nfile]}" + if [ $type = "regional" ]; then + cmd="$cmd --dst_regional" + fi + + cmd="$cmd --src_type ${SRC_TYPE[nfile]} ${SRC_EXTRA_ARGS[nfile]} --dst_type $DST_TYPE $DST_EXTRA_ARGS" + cmd="$cmd $lrgfil" + + runcmd $cmd + + if [ "$debug" != "YES" ] && [ ! -f "${OUTFILE[nfile]}" ]; then + echo "Output mapping file was NOT created: ${OUTFILE[nfile]}" + exit 6 + fi + # add some metadata to the file + HOST=`hostname` + history="$ESMF_REGRID" + runcmd "ncatted -a history,global,a,c,"$history" ${OUTFILE[nfile]}" + runcmd "ncatted -a hostname,global,a,c,$HOST -h ${OUTFILE[nfile]}" + runcmd "ncatted -a logname,global,a,c,$LOGNAME -h ${OUTFILE[nfile]}" + + # check for duplicate mapping weights + newfile="rmdups_${OUTFILE[nfile]}" + runcmd "rm -f $newfile" + runcmd "env MAPFILE=${OUTFILE[nfile]} NEWMAPFILE=$newfile ncl $dir/rmdups.ncl" + if [ -f "$newfile" ]; then + runcmd "mv $newfile ${OUTFILE[nfile]}" + fi + fi + + nfile=nfile+1 +done + +echo "Successffully created needed mapping files for $res" + +exit 0 diff --git a/components/clm/tools/shared/mkmapdata/mknoocnmap.pl b/components/clm/tools/shared/mkmapdata/mknoocnmap.pl new file mode 100755 index 0000000000..67e65e6a70 --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/mknoocnmap.pl @@ -0,0 +1,297 @@ +#!/usr/bin/env perl +# +# mknoocnmap.pl Erik Kluzek +# Dec/07/2011 +# +# Create SCRIP grid and mapping files for a single-point or region +# that is assumed to be a land land-only region. +# +use Cwd; +use strict; +use English; +use IO::File; +use Getopt::Long; + +# +# Global constants +# +my $degsiz = 0.1; + +#----------------------------------------------------------------------------------------------- +# Set the directory that contains this scripts. If the command was issued using a +# relative or absolute path, that path is in $ProgDir. Otherwise assume the +# command was issued from the current working directory. + +(my $ProgName = $0) =~ s!(.*)/!!; # name of this script +my $ProgDir = $1; # name of directory containing this script -- may be a + # relative or absolute path, or null if the script + # is in + # the user's PATH +my $cmdline = "@ARGV"; # Command line arguments to script +my $cwd = getcwd(); # current working directory +my $scrdir; # absolute pathname of directory that contains this script +my $nm = "${ProgName}::"; # name to use if script dies +if ($ProgDir) { + $scrdir = absolute_path($ProgDir); +} else { + $scrdir = $cwd; +} + + +#----------------------------------------------------------------------------------------------- + +sub usage { + die < Center latitude,longitude of the grid to create. + -name [-or -n] Name to use to describe point + +OPTIONS + -dx Size of total grid in degrees in longitude direction + (default is $degsiz) + -dy Size of total grid in degrees in latitude direction + (default is $degsiz) + -silent [or -s] Make output silent + -help [or -h] Print usage to STDOUT. + -verbose [or -v] Make output more verbose. + -nx Number of longitudes (default is 1) + -ny Number of latitudes (default is 1) +EOF +} + +#----------------------------------------------------------------------------------------------- + +sub get_latlon { +# +# Return the latitude and longitude of the input string and validate it +# + my $string = shift; + my $desc = shift; + my $dx = shift; + my $dy = shift; + + my $lat = undef; + my $lon = undef; + my $valreal1 = "[+-]?[0-9]*\.?[0-9]*[EedDqQ]?[0-9+-]*"; + + if ( $string =~ /^($valreal1)\s*,\s*($valreal1)$/ ) { + $lat = $1; + $lon = $2; + } else { + die <<"EOF"; +** $ProgName - Error in entering latitude/longitude for $desc ** +EOF + } + if ( $dx <= 0.0 || $dx > 360. ) { + die <<"EOF"; +** $ProgName - Bad value for dx (=$dx) for $desc ** + } + if ( $dy <= 0.0 || $dy > 180. ) { + die <<"EOF"; +** $ProgName - Bad value for dy (=$dy) for $desc ** + } + if ( ($lat < -90.+$dy/2.0) || ($lat > 90.0-$dy/2.0) ) { + die <<"EOF"; +** $ProgName - Bad value for latitude (=$lat) for $desc ** +EOF + } + if ( ($lon < $dx/2.0) || ($lon > 360.0-$dx/2.0) ) { + die <<"EOF"; +** $ProgName - Bad value for longitude (=$lat) for $desc ** +EOF + } + return( $lat, $lon ); + +} + +#------------------------------------------------------------------------------- + +sub absolute_path { +# +# Convert a pathname into an absolute pathname, expanding any . or .. characters. +# Assumes pathnames refer to a local filesystem. +# Assumes the directory separator is "/". +# + my $path = shift; + my $cwd = getcwd(); # current working directory + my $abspath; # resulting absolute pathname + +# Strip off any leading or trailing whitespace. (This pattern won't match if +# there's embedded whitespace. + $path =~ s!^\s*(\S*)\s*$!$1!; + +# Convert relative to absolute path. + + if ($path =~ m!^\.$!) { # path is "." + return $cwd; + } elsif ($path =~ m!^\./!) { # path starts with "./" + $path =~ s!^\.!$cwd!; + } elsif ($path =~ m!^\.\.$!) { # path is ".." + $path = "$cwd/.."; + } elsif ($path =~ m!^\.\./!) { # path starts with "../" + $path = "$cwd/$path"; + } elsif ($path =~ m!^[^/]!) { # path starts with non-slash character + $path = "$cwd/$path"; + } + + my ($dir, @dirs2); + my @dirs = split "/", $path, -1; # The -1 prevents split from stripping trailing nulls + # This enables correct processing of the input "/". + + # Remove any "" that are not leading. + for (my $i=0; $i<=$#dirs; ++$i) { + if ($i == 0 or $dirs[$i] ne "") { + push @dirs2, $dirs[$i]; + } + } + @dirs = (); + + # Remove any "." + foreach $dir (@dirs2) { + unless ($dir eq ".") { + push @dirs, $dir; + } + } + @dirs2 = (); + + # Remove the "subdir/.." parts. + foreach $dir (@dirs) { + if ( $dir !~ /^\.\.$/ ) { + push @dirs2, $dir; + } else { + pop @dirs2; # remove previous dir when current dir is .. + } + } + if ($#dirs2 == 0 and $dirs2[0] eq "") { return "/"; } + $abspath = join '/', @dirs2; + return( $abspath ); +} + +#------------------------------------------------------------------------------- + +# Process command-line options + +my %opts = ( + ctr => undef, + help => undef, + name => undef, + nx => 1, + ny => 1, + dx => $degsiz, + dy => $degsiz, + silent => 0, + verbose => 0, + ); + +GetOptions( + "p|centerpoint=s" => \$opts{'ctr'}, + "n|name=s" => \$opts{'name'}, + "nx=i" => \$opts{'nx'}, + "ny=i" => \$opts{'ny'}, + "dx=f" => \$opts{'dx'}, + "dy=f" => \$opts{'dy'}, + "h|help" => \$opts{'help'}, + "s|silent" => \$opts{'silent'}, + "v|verbose" => \$opts{'verbose'}, +) or usage(); + +# Check for unparsed arguments +if (@ARGV) { + print "ERROR: unrecognized arguments: @ARGV\n"; + usage(); +} + +if ( $opts{'verbose'} && $opts{'silent'} ) { + print "ERROR: Can NOT set both silent and verbose at once!\n"; + usage(); +} +my $printlev; +if ( $opts{'verbose'} ) { + $printlev = 2; +} elsif ( $opts{'silent'} ) { + $printlev = 0; +} else { + $printlev = 1; +} + +if ( ! defined($opts{'ctr'}) ) { + print "ERROR: MUST set the center point\n"; + usage(); +} +if ( ! defined($opts{'name'}) ) { + print "ERROR: MUST set the name of the point\n"; + usage(); +} +my $name = $opts{'name'}; + +my ($lat,$lon) = get_latlon( $opts{'ctr'}, $name, $opts{'dx'}, $opts{'dy'} ); +my $S_lat = $lat - $opts{'dy'}/2.0; +my $N_lat = $lat + $opts{'dy'}/2.0; +my $W_lon = $lon - $opts{'dx'}/2.0; +my $E_lon = $lon + $opts{'dx'}/2.0; + +my $nx = $opts{'nx'}; +my $ny = $opts{'ny'}; +if ( $opts{'nx'} < 1 ) { + print "ERROR: nx MUST be greater than or equal to 1\n"; + usage(); +} +if ( $opts{'ny'} < 1 ) { + print "ERROR: ny MUST be greater than or equal to 1\n"; + usage(); +} + +#----------------------------------------------------------------------------------------------- +my $print; +if ( $printlev > 1 ) { + $print = "PRINT=TRUE"; +} + +# Creation date +my $cdate = `date +%y%m%d`; chomp( $cdate ); + +if ( $printlev > 0 ) { + print "\n\nCreate SCRIP grid and mapping files for a single-point\n"; +} +# land grid... +my $grddir = absolute_path( "$scrdir/../mkmapgrids" ); +my $grid1 = "$grddir/SCRIPgrid_${name}_nomask_c${cdate}.nc"; +my $cmdenv = "env S_LAT=$S_lat W_LON=$W_lon N_LAT=$N_lat E_LON=$E_lon " . + "NX=$nx NY=$ny PTNAME=$name $print "; + +chdir( "$grddir" ); +my $cmd = "$cmdenv GRIDFILE=$grid1 ncl mkscripgrid.ncl"; +if ( $printlev > 0 ) { + print "Create land SCRIP gridfile\n"; + print "Execute: $cmd\n"; +} +system( $cmd ); + +# ocean grid... +my $grid2 = "$grddir/SCRIPgrid_${name}_noocean_c${cdate}.nc"; +my $cmd = "$cmdenv GRIDFILE=$grid2 IMASK=0 ncl mkscripgrid.ncl"; +if ( $printlev > 0 ) { + print "Create ocean SCRIP gridfile\n"; + print "Execute: $cmd\n"; +} +system( $cmd ); + +# Now create a unity mapping between the two... +# Note reversal of grid1 & grid2, because we want an ocean -> land +# mapping file +chdir( "$scrdir" ); +my $mapfile = "map_${name}_noocean_to_${name}_nomask_aave_da_${cdate}.nc"; +my $cmd = "env GRIDFILE1=$grid2 GRIDFILE2=$grid1 MAPFILE=$mapfile " . + "$print ncl $scrdir/mkunitymap.ncl"; + +if ( $printlev > 0 ) { + print "Create unity mapping file between the two gridfile\n"; + print "Execute: $cmd\n"; +} +system( $cmd ); + +if ( $printlev > 0 ) { + print "\n\nSuccessfully created grid/mapping files for single-point\n"; +} diff --git a/components/clm/tools/shared/mkmapdata/mkunitymap.ncl b/components/clm/tools/shared/mkmapdata/mkunitymap.ncl new file mode 100644 index 0000000000..fdaef8bf11 --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/mkunitymap.ncl @@ -0,0 +1,163 @@ +; +; mkunitymap.ncl +; +; Create a unity map file either between two identical grids or between two +; grids that do NOT intersect at all. +; +; Erik Kluzek +; Dec/07/2011 +; $Id: getco2_historical.ncl 23741 2010-06-12 19:27:09Z erik $ +; $HeadURL; +; +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" +begin + ; Set a few constants needed later + cdate = systemfunc( "date +%y%m%d" ); + ldate = systemfunc( "date" ); + ; =========================================================================================================== + ; + ; IMPORTANT NOTE: EDIT THE FOLLOWING TO CUSTOMIZE or use ENV VARIABLE SETTINGS + ; Edit the following as needed to interpolate to a new resolution. + gridfile1 = getenv("GRIDFILE1"); ; Get name of the first SCRIP grid file + gridfile2 = getenv("GRIDFILE2"); ; Get name of the second SCRIP grid file + + outfilename = getenv("MAPFILE"); ; Get name of the output mapping file + + print_str = getenv("PRINT"); ; Do Extra printing for debugging + + if ( ismissing(gridfile1) )then + print( "ERROR: GRIDFILE1 is missing!" ); + exit + end if + if ( ismissing(gridfile2) )then + print( "ERROR: GRIDFILE2 is missing!" ); + exit + end if + if ( ismissing(outfilename) )then + print( "ERROR: MAPFILE is missing!" ); + exit + end if + if ( ismissing(print_str) )then + printn = False; + else + if ( print_str .eq. "TRUE" )then + printn = True; + else + printn = False; + end if + end if + + ; + ; Open up the input grid files + ; + nca = addfile( gridfile1, "r" ); + ncb = addfile( gridfile2, "r" ); + + system( "/bin/rm -f "+outfilename ); + if ( printn )then + print( "output mapping file to create: "+outfilename ); + end if + nc = addfile( outfilename, "c" ); + ; + ; Define dimensions + ; + n_a = dimsizes( nca->grid_center_lat ); + n_b = dimsizes( ncb->grid_center_lat ); + if ( n_a .ne. n_b )then + print( "ERROR: dimensions of input SCRIP grid files is NOT the same!" ); + exit + end if + if ( any(ncb->grid_imask .ne. 1.0d00) )then + print( "ERROR: the mask of the second file isn't identically 1!" ); + print( "(second file should be land grid file)"); + exit + end if + chkvars = (/ "grid_center_lat", "grid_center_lon", "grid_corner_lat", "grid_corner_lon" /); + do i = 1, dimsizes(chkvars)-1 + if ( any(nca->$chkvars(i)$ .ne. ncb->$chkvars(i)$) )then + print( "ERROR: the grid variables are different between the two files!: "+chkvars(i) ); + exit + end if + end do + n_s = n_a; + dimnames = (/ "n_a", "n_b", "n_s", "nv_a", "nv_b", "num_wgts", "src_grid_rank", "dst_grid_rank" /); + dsizes = (/ n_a, n_b, n_a, 4, 4, 1, 2, 2/); + is_unlim = (/ False, False, False, False, False, False, False, False /); + filedimdef( nc, dimnames, dsizes, is_unlim ); + + ; + ; Define grid dimensions + ; + filevardef( nc, "src_grid_dims", "integer", (/ "src_grid_rank" /)) + nc->src_grid_dims = (/nca->grid_dims/) + filevardef( nc, "dst_grid_dims", "integer", (/ "dst_grid_rank" /)) + nc->dst_grid_dims = (/ncb->grid_dims/) + + ; + ; Define variables + ; + cvars = (/ "yc", "xc", "yv", "xv", "mask" /); + gvars = (/ "grid_center_lat", "grid_center_lon", "grid_corner_lat", "grid_corner_lon", "grid_imask" /); + + do i = 0, dimsizes(cvars)-1 + var = cvars(i)+"_a"; + if ( cvars(i) .eq. "yv" .or. cvars(i) .eq. "xv" )then + dnamesa = (/ "n_a", "nv_a" /); + dnamesb = (/ "n_b", "nv_b" /); + else + dnamesa = (/ "n_a" /); + dnamesb = (/ "n_b" /); + end if + filevardef ( nc, var, typeof(nca->$gvars(i)$), dnamesa ); + filevarattdef ( nc, var, nca->$gvars(i)$ ); + nc->$var$ = (/ nca->$gvars(i)$ /); + var = cvars(i)+"_b"; + filevardef ( nc, var, typeof(nca->$gvars(i)$), dnamesb ); + filevarattdef ( nc, var, ncb->$gvars(i)$ ); + nc->$var$ = (/ ncb->$gvars(i)$ /); + delete( dnamesa ); + delete( dnamesb ); + end do + filevardef ( nc, "area_a", "double", (/ "n_a" /) ); + filevardef ( nc, "area_b", "double", (/ "n_b" /) ); + filevardef ( nc, "frac_a", "double", (/ "n_a" /) ); + filevardef ( nc, "frac_b", "double", (/ "n_b" /) ); + ; + ; Attributes + ; + nc->area_a@units = "square radians"; + nc->frac_a@units = "unitless"; + nc->area_b@units = nc->area_a@units; + nc->frac_b@units = nc->frac_a@units; + nc@conventions = "NCAR-CESM"; + nc@domain_a = gridfile1; + nc@domain_b = gridfile2; + nc@grid_file_src = gridfile1; + nc@grid_file_dst = gridfile2; + nc@title = "SCRIP mapping file between identical grids without ocean"; + nc@history = ldate+": create using mkunitymap.ncl"; + nc@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/branches/newgrid/models/lnd/clm/tools/ncl_scripts/ndeplintInterp.ncl $"; + nc@Revision = "$Id: ndeplintInterp.ncl 25175 2010-10-16 03:47:50Z erik $"; + + ; + ; Fraction + ; + nc->frac_a = int2dble( (/nc->mask_a/) ); + nc->frac_b = int2dble( (/nc->mask_b/) ); + ; + ; Area + ; + nc->area_a = gc_qarea( nc->yv_a(:,:), nc->xv_a(:,:) ); + nc->area_b = gc_qarea( nc->yv_b(:,:), nc->xv_b(:,:) ); + ; + ; Weights + ; + filevardef ( nc, "col", "integer", (/ "n_s" /) ); + filevardef ( nc, "row", "integer", (/ "n_s" /) ); + filevardef ( nc, "S", "double", (/ "n_s" /) ); + + nc->col = ispan( 1, n_s, 1 ); + nc->row = nc->col; + nc->S = 1.0d00; + +end diff --git a/components/clm/tools/shared/mkmapdata/mvNimport.sh b/components/clm/tools/shared/mkmapdata/mvNimport.sh new file mode 100755 index 0000000000..658e1812da --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/mvNimport.sh @@ -0,0 +1,75 @@ +#!/bin/bash +# +# +# Batch script to move and import mapping files to inputdata +# for several resolutions. +# + +#---------------------------------------------------------------------- + +if [ -z "$CSMDATA" ]; then + CSMDATA=/fis/cgd/cseg/csm/inputdata +fi + +if [ ! -d "$CSMDATA" ]; then + echo "Environment variable CSMDATA is not set to a valid directory!" + exit 1 +fi + +mapdir="lnd/clm2/mappingdata/maps" +if [ ! -d "$CSMDATA/$mapdir" ]; then + echo "Environment variable CSMDATA is not set to a valid inputdata directory!" + exit 1 +fi + +if [ -z "$SVN_INP_DIR" ]; then + SVN_INP_DIR=https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata +fi + +if [ $# -gt 0 ]; then + resols="" + for arg in $@; do + resols="$resols $arg" + done +else + echo "Run for all valid resolutions" + resols=`../../bld/queryDefaultNamelist.pl -res list -silent` +fi +echo "Move and import mapping files for this list of resolutions: $resols" + +#---------------------------------------------------------------------- + +for res in $resols; do + echo "Move and import mapping files for: $res" + dir=$mapdir/$res + #---------------------------------------------------------------------- + files=(map_*${res}*_aave_da_c??????.nc) + if [ ${#files[*]} -lt 2 ]; then + echo "No mappingfiles found for $res" + exit 2 + else + if [ ! -d "$CSMDATA/$dir" ]; then + echo "Create mapping directory: $CSMDATA/$dir" + mkdir $CSMDATA/$dir + svn mkdir $SVN_INP_URL/$dir -m "Create mapping directory for $res" + fi + for file in ${files[*]}; do + echo "Copy and import file $file" + cp -p $file $CSMDATA/$dir + if [ $? -ne 0 ]; then + echo "Problem copying file: $file" + exit 3 + fi + chmod 0444 $CSMDATA/$dir/$file + if [ $? -ne 0 ]; then + echo "Problem chmod on file: $file" + exit 4 + fi + svn import $CSMDATA/$dir/$file $SVN_INP_DIR/$dir/$file -m "Mapping file for $res" + if [ $? -ne 0 ]; then + echo "Problem doing svn import on file: $file" + exit 4 + fi + done + fi +done diff --git a/components/clm/tools/shared/mkmapdata/regridbatch.sh b/components/clm/tools/shared/mkmapdata/regridbatch.sh new file mode 100755 index 0000000000..43292dd8a1 --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/regridbatch.sh @@ -0,0 +1,98 @@ +#!/bin/bash +# +# +# Batch script to submit to create mapping files for all standard +# resolutions. If you provide a single resolution via "$RES", only +# that resolution will be used. In that case: If it is a regional or +# single point resolution, you should set 'BSUB -n' to 1, and be sure +# that '-t regional' is specified in cmdargs. +# +# Currently only setup to run on yellowstone/caldera/geyser. Note that +# geyser is needed for very high resolution files (e.g., 1 km) because +# of its large memory per node, so that is set as the default. +# However, for coarser resolutions, you may get better performance on +# caldera or yellowstone. +# +# yellowstone specific batch commands: +#BSUB -P P93300606 +#BSUB -n 8 +#BSUB -R "span[ptile=8]" +#BSUB -o regrid.%J.out # ouput filename +#BSUB -e regrid.%J.err # error filename +#BSUB -J regrid # job name +#BSUB -W 24:00 +#BSUB -q geyser # queue + +# hopper/edison specific batch commands: +#PBS -N regrid +#PBS -q regular +#PBS -l mppwidth=8 +#PBS -l walltime=24:00:00 +#PBS -j oe +#PBS -V +#PBS -S /bin/bash + +#---------------------------------------------------------------------- +# Set parameters +#---------------------------------------------------------------------- + +# Which version of CLM to generate mapping files for +# Can be clm4_0 or clm4_5 +phys="clm4_5" + +#---------------------------------------------------------------------- +# Begin main script +#---------------------------------------------------------------------- + +if [ -z "$RES" ]; then + echo "Run for all valid resolutions" + resols=`../../../bld/queryDefaultNamelist.pl -res list -silent -phys $phys` +else + resols="$RES" +fi +echo "Create mapping files for this list of resolutions: $resols" + +#---------------------------------------------------------------------- + +for res in $resols; do + echo "Create mapping files for: $res" +#---------------------------------------------------------------------- + cmdargs="--phys $phys -r $res" + + # For single-point and regional resolutions, tell mkmapdata that + # output type is regional + if [[ `echo "$res" | grep -c "1x1_"` -gt 0 || `echo "$res" | grep -c "5x5_"` -gt 0 ]]; then + res_type="regional" + else + res_type="global" + fi + + cmdargs="$cmdargs -t $res_type" + + echo "$res_type" + if [ "$res_type" = "regional" ]; then + echo "regional" + # For regional and (especially) single-point grids, we can get + # errors when trying to use multiple processors - so just use 1. + # We also do NOT set batch mode in this case, because some + # machines (e.g., yellowstone) do not listen to REGRID_PROC, so to + # get a single processor, we need to run mkmapdata.sh in + # interactive mode. + regrid_num_proc=1 + else + echo "global" + regrid_num_proc=8 + if [ ! -z "$LSFUSER" ]; then + echo "batch" + cmdargs="$cmdargs -b" + fi + if [ ! -z "$PBS_O_WORKDIR" ]; then + cd $PBS_O_WORKDIR + cmdargs="$cmdargs -b" + fi + fi + + echo "args: $cmdargs" + echo "time env REGRID_PROC=$regrid_num_proc ./mkmapdata.sh $cmdargs\n" + time env REGRID_PROC=$regrid_num_proc ./mkmapdata.sh $cmdargs +done diff --git a/components/clm/tools/shared/mkmapdata/rmdups.ncl b/components/clm/tools/shared/mkmapdata/rmdups.ncl new file mode 100644 index 0000000000..03ba46dc39 --- /dev/null +++ b/components/clm/tools/shared/mkmapdata/rmdups.ncl @@ -0,0 +1,134 @@ +; +; Remove duplicate weights from a mapping file. +; +; Mark Taylor (converted for use by CLM mkmapdata by Erik Kluzek) +; Sep/01/2011 +; $Id: rmdups.ncl 47629 2013-05-31 08:59:50Z erik $ +; $HeadURL; +; +load "$NCARG_NCARG/nclscripts/csm/gsn_code.ncl" +load "$NCARG_NCARG/nclscripts/csm/gsn_csm.ncl" +load "$NCARG_NCARG/nclscripts/csm/contributed.ncl" +begin + ; =========================================================================================================== + ; + ; IMPORTANT NOTE: EDIT THE FOLLOWING TO CUSTOMIZE or use ENV VARIABLE SETTINGS + ; Edit the following as needed + ; + ; Input mapping file to remove duplicate weights from a mapping file + ; + mapfile = getenv("MAPFILE") ; Get the mapping file + newmapfile = getenv("NEWMAPFILE") ; The new mapping file to create + logname = getenv("LOGNAME") ; Logname of user running the script + + if ( ismissing(mapfile) )then + print( "You did NOT enter an input mapping file to convert" ) + status_exit( -1 ) + end if + if ( ismissing(newmapfile) )then + sdate = systemfunc( "date +%y%m%d" ); + newmapfile = mapfile+"_c"+sdate+".nc"; + end if + ; =========================================================================================================== + + if ( systemfunc("test -f "+mapfile+"; echo $?" ) .ne. 0 )then + print( "Input file does not exist or not found: "+mapfile ); + status_exit( -1 ) + end if + print("map file: "+mapfile) + f = addfile(mapfile,"r") ; Open netCDF files. + + + n_s = dimsizes(f->col) + if ( n_s .eq. 0 )then + print( "n_s is size zero, so no overlap points just return: " ); + exit + end if + + n_b = dimsizes(f->area_b) + n_a = dimsizes(f->area_a) + print("n_s = "+n_s+" max(row)="+max(f->row)+" max(col)="+max(f->col)) + + + + row = f->row + col = f->col + + + print("checking for dups, sorting...") + hash = new( n_s, double ) + hash = col + hash= hash + row*n_b + index1d=dim_pqsort(hash,1) + row2=row(index1d) + col2=col(index1d) + S=f->S + print("zeroing out any dups...") + ndups=0 + i0=0 + do i=1,n_s-1 + if ( (col2(i) .eq. col2(i0)) .and. (row2(i) .eq. row2(i0))) then + iorig1 = index1d(i0) + iorig2 = index1d(i) + ;print("dup row: "+row2(i)+" "+row2(i0)+" "+row(iorig1)+" "+row(iorig2)) + ;print("dup col: "+col2(i)+" "+col2(i0)+" "+col(iorig1)+" "+col(iorig2)) + ;print("removing "+iorig2+" keeping "+iorig1) + S(iorig1)=S(iorig1)+S(iorig2) + S(iorig2)=0 + ndups=ndups+1 + ; dont increment i0 + else + i0=i + end if + end do + delete(row2) + delete(col2) + if ( ndups .gt. 0) then + print("ndups = "+ndups) + print("compacting S...") + ns2 = n_s-ndups + S2 = new( ns2, double) + row2= new( ns2, integer) + col2 = new( ns2, integer) + ns2=0 + do i=0,n_s-1 + if (S(i) .ne. 0) then + S2(ns2)=S(i) + row2(ns2)=row(i) + col2(ns2)=col(i) + ns2=ns2+1 + end if + end do + print("removed "+ndups+" dups") + delete(S) + delete(row) + delete(col) + S=S2 + row=row2 + col=col2 + n_s = ns2 + print("writing new netcdf file") + cmdout = systemfunc("ncks -O -x -v S,row,col "+mapfile+" "+newmapfile) + nco = addfile(newmapfile,"rw") ; Open netCDF files. + nco->S = S + nco->row = row + nco->col = col + ldate = systemfunc( "date" ); + nco@history = nco@history + ":"+ldate + ": "; + nco@history = nco@history + " Removed duplicate weights from mapping file with: rmdups.ncl " + nco@rmdups_Logname = logname; + nco@rmdups_mod_date = ldate; + nco@rmdups_version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/tools/shared/mkmapdata/rmdups.ncl $"; + nco@rmdups_revision_id = "$Id: rmdups.ncl 47629 2013-05-31 08:59:50Z erik $"; + + print("Successfully removed duplicate weights from mapping file" ); + + else + + print("No duplicate weights to remove from mapping file" ); + + end if + + + +end diff --git a/components/clm/tools/shared/mkmapgrids/README b/components/clm/tools/shared/mkmapgrids/README new file mode 100644 index 0000000000..0eafb162a0 --- /dev/null +++ b/components/clm/tools/shared/mkmapgrids/README @@ -0,0 +1,22 @@ +components/clm/tools/mkmapgrids/README Oct/03/2014 + +NCL script to create a SCRIP grid file for a regular lat/lon grid. + +To use the script, set the following environment variables + +Required (or defaults to a single point over Boulder Colorado) + +PTNAME ! name of your grid +S_LAT ! Southern latitude corner +N_LAT ! Northern latitude corner +E_LON ! Eastern longitude corner +W_LON ! Western longitude corner + +Optional: + +NX ! Number of grid points along longitude (default 1) +NY ! Number of grid points along latitude (default 1) +IMASK ! 0 or 1, mask to use if all points are active or not (default active) +PRINT ! TRUE/FALSE do extra verbose printing or not (default FALSE) +GRIDFILE ! Output filename + diff --git a/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl b/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl new file mode 100644 index 0000000000..c31c87193a --- /dev/null +++ b/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl @@ -0,0 +1,170 @@ +; +; mkscripgrid.ncl +; +; Create SCRIP grid and mapping file for a land-only point or region. +; Requires NCL 6.1.0 or later for the ESMF regridding functions +; +; Erik Kluzek +; Dec/07/2011 +; $Id: mkscripgrid.ncl 72547 2015-08-25 16:28:29Z erik $ +; $HeadURL; +; +load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl" +load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl" +begin + ; =========================================================================================================== + ; Set a few constants needed later + cdate = systemfunc( "date +%y%m%d" ); + ldate = systemfunc( "date" ); + ; + ; IMPORTANT NOTE: EDIT THE FOLLOWING TO CUSTOMIZE or use ENV VARIABLE SETTINGS + ; Edit the following as needed to interpolate to a new resolution. + ; + ; Input resolution and position + ; + name = getenv("PTNAME"); ; Get name of this point + + latS = stringtodouble( getenv("S_LAT") ); ; Get south latitude from env variable + latN = stringtodouble( getenv("N_LAT") ); ; Get north latitude from env variable + lonE = stringtodouble( getenv("E_LON") ); ; Get east longitude from env variable + lonW = stringtodouble( getenv("W_LON") ); ; Get west longitude from env variable + + nx = stringtointeger( getenv("NX" ) ); ; Get number of grids along longitude lines + ny = stringtointeger( getenv("NY" ) ); ; Get number of grids along latitude lines + + imask = stringtointeger( getenv("IMASK") ); ; Get imask to use from env variable + + print_str = getenv("PRINT"); ; Do Extra printing for debugging + + outfilename = getenv("GRIDFILE"); ; Get filename from env variable + + if ( ismissing(nx) )then + nx = 1; + end if + if ( ismissing(ny) )then + ny = 1; + end if + if ( ismissing(imask) )then + imask = 1; + end if + if ( ismissing(name) )then + name = nx+"x"+ny+"pt_US-UMB"; + end if + if ( ismissing(latS) )then + latS = 45.5098; + end if + if ( ismissing(latN) )then + latN = 45.6098; + end if + if ( ismissing(lonW) )then + lonW = 275.2362; + end if + if ( ismissing(lonE) )then + lonE = 275.3362; + end if + if ( ismissing(print_str) )then + printn = False; + else + if ( print_str .eq. "TRUE" )then + printn = True; + else + printn = False; + end if + end if + + if ( ismissing(outfilename) )then + if ( imask .eq. 1 )then + outfilename = "SCRIPgrid_"+name+"_nomask_c"+cdate+".nc"; + else + if ( imask .eq. 0 )then + outfilename = "SCRIPgrid_"+name+"_noocean_c"+cdate+".nc"; + else + outfilename = "SCRIPgrid_"+name+"_mask_c"+cdate+".nc"; + end if + end if + end if + + system( "/bin/rm -f "+outfilename ); + if ( printn )then + print( "output file: "+outfilename ); + end if + +function fspan1up( fbegin [*]:double, fend [*]:double, number:integer ) +; +; An "fspan" that can handle size of 1 and up. +; Do fspan for arrays of two or more, or average of end points for array of one. +; +local farray; +begin + if ( number .eq. 1) then + farray = (/ (fbegin + fend) / 2.0d00 /); + else + farray = fspan( fbegin, fend, number ); + end if + return( farray ); +end + + ; + ; Compute derived quantities + ; + + delX = (lonE - lonW) / int2dble(nx); + delY = (latN - latS) / int2dble(ny); + + lonCenters = fspan1up( (lonW + delX/2.d0), (lonE - delX/2.d0), nx) + latCenters = fspan1up( (latS + delY/2.d0), (latN - delY/2.d0), ny) + lon = new( (/ny, nx/), "double" ); + lat = new( (/ny, nx/), "double" ); + lonCorners = new( (/ny, nx, 4/), "double" ); + latCorners = new( (/ny, nx, 4/), "double" ); + do i = 0, nx-1 + lat(:,i) = latCenters; + latCorners(:,i,0) = latCenters - delY/2.d0; + latCorners(:,i,1) = latCenters + delY/2.d0; + latCorners(:,i,2) = latCenters + delY/2.d0; + latCorners(:,i,3) = latCenters - delY/2.d0; + end do + do j = 0, ny-1 + lon(j,:) = lonCenters; + lonCorners(j,:,0) = lonCenters - delX/2.d0; + lonCorners(j,:,1) = lonCenters - delX/2.d0; + lonCorners(j,:,2) = lonCenters + delX/2.d0; + lonCorners(j,:,3) = lonCenters + delX/2.d0; + end do + + ; for some reason, "No_FillValue" isn't working in the case where imask=1 + Mask2D = new( (/ny,nx/), "integer", "No_FillValue" ) + Mask2D(:,:) = imask + gridSize = delX+"x"+delY + + ; + ; Create SCRIP grid file + ; + + Opt = True + Opt@Mask2D = Mask2D + Opt@GridCornerLat = latCorners + Opt@GridCornerLon = lonCorners + Opt@Title = "SCRIP grid file for "+name + if (printn) then + Opt@Debug = True + end if + curvilinear_to_SCRIP(outfilename, lat, lon, Opt) + + ; + ; Add global attributes to file + ; + + nc = addfile( outfilename, "w" ); + nc@history = ldate+": create using mkscripgrid.ncl"; + nc@comment = "Ocean is assumed to non-existant at this point"; + nc@Version = "$HeadURL: https://svn-ccsm-models.cgd.ucar.edu/clm2/trunk_tags/clm4_5_1_r120/components/clm/tools/shared/mkmapgrids/mkscripgrid.ncl $"; + nc@Revision = "$Id: mkscripgrid.ncl 72547 2015-08-25 16:28:29Z erik $"; + if ( printn )then + print( "================================================================================================" ); + print( "Successfully created SCRIP grid file: "+outfilename); + end if + + ; =========================================================================================================== + +end diff --git a/components/clm/tools/shared/mkprocdata_map/README b/components/clm/tools/shared/mkprocdata_map/README new file mode 100644 index 0000000000..655e6eadec --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/README @@ -0,0 +1,152 @@ +components/clm/tools/mkprocdata_map/clm/README Oct 30, 2012 + +This directory contains scripts for regridding CLM output from an +unstructured grid (1-d output using the lndgrid dimension) to a 2-d +(lat/lon) grid. The regridding method is area-conservative. + +The following steps provide a method to create the necessary inputs to +this script, produce an executable, and regrid output: + +In the following instructions, the "original" resolution is the +resolution of the run on an unstructured grid, and the "target" +resolution is the regular lat/lon resolution to which you will regrid +the output. + +(0) Install prerequisites: + + (a) If you do not already have a mapping file from the original + resolution to the target resolution, you will need the + ESMF_RegridWeightGen tool installed on your system. + + (b) The wrapper scripts describe below require the netCDF operators + (NCO). These nco tools (ncks, ncap2, etc.) must be in your path. + +(1) Determine the target resolution. This resolution must be a regular + lat/lon resolution. Generally, this should be a resolution close + to the resolution of the CLM run. For example, when running CLM at + ne30_np4 resolution, a good target resolution is 0.9x1.25 (i.e., + finite volume 1 degree: f09); when running CLM at ne120_np4 + resolution, a good target resolution is 0.23x0.31 (i.e., finitev + volume 1/4 degree: f02). + +(2) Perform a short CLM run at the target resolution, producing at + least one history file. After this run completes, set the + environment variable $TEMPLATE_FILE to point to one of the history + files created by this run. + +(3) Create a conservative mapping file from the original resolution to + the target resolution using the ESMF regrid weight generator. The + basic method for doing this is: + + $ESMF_PATH/bin/ESMF_RegridWeightGen -s $INGRID -d $OUTGRID -m conserve -w $MAP_FILE -i + + where $INGRID gives the path to a SCRIP grid file at the original + resolution, $OUTGRID gives the path to a SCRIP grid file at the + template resolution, and $MAP_FILE gives the name of the mapping + file that will be generated. + + However, you may want to wrap this in a job script to run it on + multiple processors (using mpirun), and you may have to set other + machine-specific environment variables. You can follow the method + used in tools/mkmapdata/mkmapdata.sh. + +(4) Build the mkprocdata_map tool. From the current directory, do the + following: + + > cd src + > gmake + > cd .. + + By default code compiles optimized so it's reasonably fast. If you want + to use the debugger, with bounds-checking, and float trapping on do the + following: + gmake OPT=FALSE + See Also: See the components/clm/tools/README file for notes about setting + the path for NetCDF. + + This builds the mkprocdata_map executable. However, you generally + will not want to run this executable directly: instead, you should + use one of the wrapper scripts described below. + +(5) Do the regridding using one of the wrapper scripts in this + directory. To determine which script is most appropriate: Do you + need to regrid just one or a few output files, or most/all of the + output files in a directory? + + (a) If you are regridding just one or a few output files, you can + use mkprocdata_map_wrap. Its usage is: + + > mkprocdata_map_wrap -i input_file -o output_file -m $MAP_FILE -t $TEMPLATE_FILE + + where: + - input_file is the CLM history file you want to regrid + - output_file is the name of the regridded file that will be + created + - $MAP_FILE is the ESMF conservative mapping file created in + step (3) + - $TEMPLATE_FILE is a CLM history file at the target resolution, + created in step (2) + + You may also specify the '-l' option to this script. This option + determines whether to determine landfrac and related variables + by regridding the input file (when you don't give the '-l' + option), or by copying these variables from the template file + (when you give the '-l' option). These variables are important + for computing regional and global averages, e.g., as is done in + the land diagnostics package. Each method may be reasonable, + depending on the purposes of the regridding. For example, if you + want regional/global integrals to be as true as possible to the + original run, you should run withOUT the '-l' option; but if you + want to compare regional/global integrals between the original + run and a run at the target resolution, then you may want to run + WITH the '-l' option. + + Run 'mkprocdata_map_wrap -h' for full usage + + (b) If you need to regrid most or all of the output files in a + directory, you can use the convenience script + mkprocdata_map_all. This script runs mkprocdata_map_wrap on all + files matching a given pattern within a directory. Its basic + usage is the following, done from a directory containing many + CLM history files: + + > /path/to/mkprocdata_map_all -p $CASE -m $MAP_FILE -t $TEMPLATE_FILE + + where: + - $CASE is the case name of the original run (this -p argument + is actually more general: it provides the prefix of files on + which mkprocdata_map_wrap should be run; run + 'mkprocdata_map_all -h' for details) + - $MAP_FILE is the ESMF conservative mapping file created in + step (3) + - $TEMPLATE_FILE is a CLM history file at the target resolution, + created in step (2) + + There are a number of additional optional arguments to this + script, including the '-l' option described in (a), above. Run + 'mkprocdata_map_all -h' for full usage. + + +------------------------------------------------------------------------ +Some miscellaneous notes on the scripts contained here +------------------------------------------------------------------------ + +- area vs. area_regridded in the output of mkprocdata_map_wrap and + mkprocdata_map_all: The 'area' variable gives the actual grid cell + area on the destination grid. The 'area_regridded' variable is the + result of performing the regridding procedure on the 'area' variable + in the original source data. This seems to be the wrong way to + regrid areas (e.g., it leads to global totals that do not make + sense). However, area_regridded is left in the regridded files as a + diagnostic. BUT PLEASE USE CAUTION IF USING THIS AREA_REGRIDDED + VALUE, UNLESS YOU KNOW WHAT IT REALLY REPRESENTS! + +- At least as of this writing (Oct 29, 2012), there is insufficient + metadata on the CLM history files to regrid all variables + perfectly. In particular, note that many CLM history variables apply + only over a subset of the grid cell (e.g., over the non-lake portion + of the grid cell). Thus, to regrid these variables appropriately, we + would need to weight each grid cell's value by the portion of the + grid cell over which the field applies. However, doing this would + require metadata about each field that is not currently + available. diff --git a/components/clm/tools/shared/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc b/components/clm/tools/shared/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc new file mode 100644 index 0000000000..0b127b0bff Binary files /dev/null and b/components/clm/tools/shared/mkprocdata_map/clm4054_f19g16_I2000.clm2.h0.2000-01_c121107.nc differ diff --git a/components/clm/tools/shared/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc b/components/clm/tools/shared/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc new file mode 100644 index 0000000000..fbd4e3a631 Binary files /dev/null and b/components/clm/tools/shared/mkprocdata_map/clm4054_ne30g16_I2000.clm2.h0.2000-01_c121107.nc differ diff --git a/components/clm/tools/shared/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc b/components/clm/tools/shared/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc new file mode 100644 index 0000000000..9df027ae0c Binary files /dev/null and b/components/clm/tools/shared/mkprocdata_map/map_ne30np4_nomask_to_fv1.9x2.5_nomask_aave_da_c121107.nc differ diff --git a/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_all b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_all new file mode 100755 index 0000000000..73e8abedf1 --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_all @@ -0,0 +1,202 @@ +#!/bin/bash + +# This script runs mkprocdata_map_wrap on all files matching a given +# pattern within a directory. + +# Created by Bill Sacks, 5-26-11 + +# ---------------------------------------------------------------------- +# LOCAL FUNCTIONS DEFINED HERE +# ---------------------------------------------------------------------- + +function Usage { + script_name=`basename $0` + echo "Usage: $script_name -p prefix -m map_file -t template_file [-d] [-e executable-path] [-h] [-i] [-l] [-o output_suffix] [-r diRectory] [-s suffix]" + echo "" + echo "This script runs mkprocdata_map_wrap on all files matching a" + echo "given pattern within a directory." + echo "" + echo "'prefix' gives the prefix of the files on which" + echo "mkprocdata_map_wrap should be run; 'prefix' should NOT contain" + echo "wildcard characters. The prefix is also used to translate" + echo "from input to output file names (see examples below)" + echo "" + echo "'map_file' gives the name (and full path if not in the current" + echo "directory) of the mapping file" + echo "" + echo "'template_file' gives the name (and full path if not in the" + echo "current directory) of the template file, from which we read" + echo "lats, lons and some other variables" + echo "" + echo "The following are optional arguments:" + echo "" + echo "[-d]: Do a test (Dry run): do all error-checking on" + echo " arguments and print commands that would be run, but" + echo " don't actually run commands" + echo "" + echo "[-e executable-path]: Gives the path of the mkprocdata_map executable." + echo " If not specified, the path is determined by the" + echo " default value in mkprocdata_map_wrap." + echo "" + echo "[-h]: Print this help message and exit" + echo "" + echo "[-i]: Ignore (skip) existing output files; if this option is" + echo " not specified, then the script dies with an error if" + echo " any of the desired output files already exist" + echo "" + echo "[-l]: Option passed to mkprocdata_map_wrap: rather than computing" + echo " landfrac and related variables by regridding the input file," + echo " instead copy these variables directly from the template file." + echo "" + echo "[-o output_suffix]: suffix to append to the end of the prefix" + echo " on the output files" + echo " If not specified, '_2d' is used" + echo "" + echo "[-r diRectory]: Do the processing in the given directory." + echo " If not specified, processing is done in the" + echo " current working directory." + echo "" + echo "[-s suffix]: Run mkprocdata_map_wrap on all files matching the" + echo " pattern '\${prefix}\${suffix}'. The suffix can -" + echo " and often will - contain wildcards; but" + echo " remember to enclose 'suffix' in quotes to" + echo " prevent shell expansion." + echo " If not specified, run mkprocdata_map_wrap on all" + echo " files matching '\${prefix}*'" + echo "" + echo "" + echo "Example: $script_name -p Ib14_ne30np4_gx1v6 -m map_ne30np4_to_fv1.9x2.5_aave_da_091230.nc -t Ib19_1.9x2.5_gx1v6.clm2.h0.0001-01.nc" + echo "This will run mkprocdata_map_wrap on all files whose names begin" + echo "with 'Ib14_ne30np4_gx1v6' in the current directory, using the" + echo "mapping file named 'map_ne30np4_to_fv1.9x2.5_aave_da_091230.nc'" + echo "and the template file named 'Ib19_1.9x2.5_gx1v6.clm2.h0.0001-01.nc'" + echo "For an input file named:" + echo " Ib14_ne30np4_gx1v6.clm2.h0.0001-01-06-00000.nc" + echo "The output file will be named:" + echo " Ib14_ne30np4_gx1v6_2d.clm2.h0.0001-01-06-00000.nc" + echo "" + echo "Example: $script_name -o '_remap' -s '*.h0.0001*.nc' -p Ib14_ne30np4_gx1v6 -m map_ne30np4_to_fv1.9x2.5_aave_da_091230.nc -t Ib19_1.9x2.5_gx1v6.clm2.h0.0001-01.nc" + echo "This will run mkprocdata_map_wrap on all files whose names match" + echo "the pattern 'Ib14_ne30np4_gx1v6*.h0.0001*.nc', in the" + echo "current directory, using the mapping file named" + echo "'map_ne30np4_to_fv1.9x2.5_aave_da_091230.nc' and the" + echo "template file named Ib19_1.9x2.5_gx1v6.clm2.h0.0001-01.nc" + echo "For an input file named:" + echo " Ib14_ne30np4_gx1v6.clm2.h0.0001-01-06-00000.nc" + echo "The output file will be named:" + echo " Ib14_ne30np4_gx1v6_remap.clm2.h0.0001-01-06-00000.nc" + echo "" +} + +# ---------------------------------------------------------------------- +# BEGIN MAIN SCRIPT +# ---------------------------------------------------------------------- + +script_dir=`dirname $0` +source $script_dir/mkprocdata_map_functions.bash + +# ---------------------------------------------------------------------- +# Handle command-line arguments +# ---------------------------------------------------------------------- + +# define default values: +# required arguments: +prefix="" +map_file="" +template_file="" +# optional arguments: +directory="." +ignore_existing=0 +output_suffix="_2d" +suffix="*" +dryrun=0 +extra_args="" + +while getopts de:hilm:o:p:r:s:t: opt; do + case $opt in + d) dryrun=1;; + e) extra_args="$extra_args -e $OPTARG";; + h) Usage; exit;; + i) ignore_existing=1;; + l) extra_args="$extra_args -l";; + m) map_file=$OPTARG;; + o) output_suffix=$OPTARG;; + p) prefix=$OPTARG;; + r) directory=$OPTARG;; + s) suffix=$OPTARG;; + t) template_file=$OPTARG;; + \?) Usage; exit 1 + esac +done + +# ---------------------------------------------------------------------- +# Error checking on arguments +# ---------------------------------------------------------------------- + +if [ -z "$prefix" ]; then + echo "Must specify a prefix" + Usage + exit 1 +fi + +check_file_arg "$map_file" "map" +check_file_arg "$template_file" "template" + +# Make sure directory is really a directory +if [ ! -d $directory ]; then + echo "ERROR: $directory is not a directory" + echo "" + Usage + exit 1 +fi + + +# ---------------------------------------------------------------------- +# Change to desired directory +# ---------------------------------------------------------------------- + +olddir=`pwd` +cd $directory + +# ---------------------------------------------------------------------- +# Get list of files matching the given pattern; make sure there really +# are some matching files +# ---------------------------------------------------------------------- + +files=`ls ${prefix}${suffix}` +if [ $? -ne 0 ]; then + echo "ERROR trying to find files matching: ${prefix}${suffix}" + echo "" + Usage + exit 1 +fi + +# ---------------------------------------------------------------------- +# Loop through files matching the given pattern; run mkprocdata_map_wrap for each +# ---------------------------------------------------------------------- + +for infile in $files; do + outfile=${infile/$prefix/${prefix}${output_suffix}} + if [ -e $outfile ]; then + if [ $ignore_existing -eq 0 ]; then + echo "" + echo "ERROR: output file $outfile already exists" + exit 1 + else + echo "" + echo "WARNING: output file $outfile already exists: skipping" + echo "" + fi + + else # outfile does not exist + echo "" + do_cmd "${script_dir}/mkprocdata_map_wrap -i $infile -o $outfile -m $map_file -t $template_file $extra_args" $dryrun + fi +done + +# ---------------------------------------------------------------------- +# Clean up +# ---------------------------------------------------------------------- + +cd $olddir + diff --git a/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_functions.bash b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_functions.bash new file mode 100644 index 0000000000..bbc359fb89 --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_functions.bash @@ -0,0 +1,57 @@ +#!/bin/bash + +# This file contains functions used by other bash scripts in this directory. + +# This function echoes the command given by $1 (cmd), then executes it. +# However, if $2 (dryrun) is non-zero, then it only does the echo, not the execution. +# Usage: do_cmd cmd dryrun +# Returns 0 on success, non-zero on failure; if there is an error, the error string is echoed. +function do_cmd { + if [[ $# -ne 2 ]]; then + echo "ERROR in do_cmd: wrong number of arguments: expected 2, received $#" + exit 1 + fi + + local cmd=$1 + local dryrun=$2 + + echo $cmd + if [ $dryrun -eq 0 ]; then + # We use 'eval $cmd' rather than just '$cmd', because the + # latter doesn't work right if the command contains any quoted + # strings (e.g., svn ci -m "this is my message") + eval $cmd + if [ $? -ne 0 ]; then + echo "ERROR in do_cmd: error executing command" + exit 2 + fi + fi + + return 0 +} + +# make sure that the given file name argument was provided, and that +# the file exists; exit the script with a usage message if either of +# these is not true +# +# Usage: check_file_arg filename_arg description +# (description is echoed if there is an error) +# Example: check_file_arg "$input_file" "input" +# (note that $input_file must be in quotes) +function check_file_arg { + local filename=$1 + local description=$2 + + if [ -z "$filename" ]; then + echo "ERROR: Must specify $description file" + Usage + exit 1 + fi + + if [ ! -f $filename ]; then + echo "ERROR: Can't find $description file: $filename" + Usage + exit 1 + fi +} + diff --git a/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_in b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_in new file mode 100644 index 0000000000..99ed1ec15f --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_in @@ -0,0 +1,6 @@ +&mkprocdata_map_in + fmap = 'map_ne30np4_to_fv1.9x2.5_aave_da_091230.nc' + filei = 'Ib14_ne30np4_gx1v6.clm2.h0.0001-01-06-00000.nc' + fileo = 'Ib14_ne30np4_gx1v6_2d.clm2.h0.0001-01-06-00000.nc' +/ + diff --git a/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_wrap b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_wrap new file mode 100755 index 0000000000..9671b42c1f --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/mkprocdata_map_wrap @@ -0,0 +1,251 @@ +#!/bin/bash + +# This script is a wrapper around mkprocdata_map that runs that +# program and then copies some additional variables from the template +# file to the output file. It also does some additional pre and +# post-processing in order to create some additional variables. + +# Created by Bill Sacks, 5-25-11 + +# ---------------------------------------------------------------------- +# SET PARAMETERS HERE +# ---------------------------------------------------------------------- + +# comma-delimited list of extra variables to copy directly from +# template file; note that these variables should not be written out +# by mkprocdata_map (i.e., everything in this list should be listed in +# the 'ignore_var' function in mkprocdata_map.F90); however, there may +# be some variables in the 'ignore_var' function that are not listed +# here - e.g., variables that we treat specially. +copy_vars="lon,lat" + +# comma-delimited list of extra variables to copy from the template +# file if the -l option is specified -- this option says to copy +# landfrac and related variables. Note that some of these variables +# may be written out by mkprocdata_map, in which case they will be +# overwritten afterwards (slighly less efficient, but that keeps +# things simpler). +landfrac_copy_vars="landfrac,landmask,pftmask" + +# name of the executable; +# expected to be in the same directory as this script unless -e option is given +executable="mkprocdata_map" + +# minimum value for regridded pftmask variable for the output variable to be 1 +pftmask_min="1.e-6" + +# fill value for landmask +landmask_fill=-9999 + +# ---------------------------------------------------------------------- +# LOCAL FUNCTIONS DEFINED HERE +# ---------------------------------------------------------------------- + +function Usage { + script_name=`basename $0` + echo "Usage: $script_name -i input_file -o output_file -m map_file -t template_file [-e executable-path] [-h] [-l]" + echo "" + echo "This script runs mkprocdata_map with the given arguments (-i, -o, -m and -t)," + echo "then copies some additional variables from the template file" + echo "to the output file. It also does some additional pre and" + echo "post-processing in order to create some additional variables." + echo "" + echo "Additional optional arguments:" + echo "" + echo "[-e executable-path]: Gives the path of the mkprocdata_map executable." + echo " If not specified, the executable is assumed to be" + echo " in the same directory as this script." + echo "" + echo "[-h]: Print this help message and exit" + echo "" + echo "[-l]: Rather than computing landfrac and related variables" + echo "by regridding the input file, instead copy these variables" + echo "directly from the template file. The variables this pertains" + echo "to are:" + echo $landfrac_copy_vars +} + +# This function operates on a single variable in a file, changing all +# places where that variable is missing to some new (non-missing) +# value. The _FillValue attribute remains unchanged. +# Usage: change_missing_to_value varname newval infile outfile +# - varname: the name of the variable to change +# - newval: all instances of the missing value will be replaced with +# this new value +# - infile: input file name +# - outfile: output file name (can be the same as infile) +function change_missing_to_value { + if [[ $# -ne 4 ]]; then + echo "ERROR in change_missing_to_value: wrong number of arguments: expected 2, received $#" + exit 1 + fi + + varname=$1 + newval=$2 + infile=$3 + outfile=$4 + + varname_tmp=${varname}_tmp_$$ + + cat > cmds.nco.tmp.$$ <= $pftmask_min)' $output_file $output_file" 0 + do_cmd "ncks -O -x -v pftmask_float $output_file $output_file" 0 + + # --- Calculate landmask from landfrac --- + echo "" + + cat > cmds.nco.tmp.$$ < 0); +landmask_float.change_miss($landmask_fill); +landmask = int(landmask_float); +EOF + + do_cmd "ncap2 -O -S cmds.nco.tmp.$$ $output_file $output_file" 0 + rm cmds.nco.tmp.$$ + + change_missing_to_value landmask 0 $output_file $output_file + + # in the following, note that we need to manually set missing_value, because it doesn't get changed through the .set_miss call in nco: + do_cmd "ncatted -a long_name,landmask,o,c,'land/ocean mask (0.=ocean and 1.=land)' -a missing_value,landmask,o,i,$landmask_fill $output_file" 0 +fi + +echo "Successfully regridded data" +return 0 diff --git a/components/clm/tools/shared/mkprocdata_map/src/Filepath b/components/clm/tools/shared/mkprocdata_map/src/Filepath new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/Filepath @@ -0,0 +1 @@ +. diff --git a/components/clm/tools/shared/mkprocdata_map/src/Makefile b/components/clm/tools/shared/mkprocdata_map/src/Makefile new file mode 100644 index 0000000000..6f07deb741 --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/Makefile @@ -0,0 +1,10 @@ +# Makefile for mksurfdata_map + +EXENAME = ../mkprocdata_map + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +include Makefile.common \ No newline at end of file diff --git a/components/clm/tools/shared/mkprocdata_map/src/Makefile.common b/components/clm/tools/shared/mkprocdata_map/src/Makefile.common new file mode 100644 index 0000000000..bf8c80eed6 --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/Makefile.common @@ -0,0 +1,360 @@ +#----------------------------------------------------------------------- +# This Makefile is for building clm tools on AIX, Linux (with pgf90 or +# lf95 compiler), Darwin or IRIX platforms. +# +# These macros can be changed by setting environment variables: +# +# LIB_NETCDF --- Library directory location of netcdf. (defaults to /usr/local/lib) +# INC_NETCDF --- Include directory location of netcdf. (defaults to /usr/local/include) +# MOD_NETCDF --- Module directory location of netcdf. (defaults to $LIB_NETCDF) +# USER_FC ------ Allow user to override the default Fortran compiler specified in Makefile. +# USER_FCTYP --- Allow user to override the default type of Fortran compiler (linux and USER_FC=ftn only). +# USER_CC ------ Allow user to override the default C compiler specified in Makefile (linux only). +# USER_LINKER -- Allow user to override the default linker specified in Makefile. +# USER_CPPDEFS - Additional CPP defines. +# USER_CFLAGS -- Additional C compiler flags that the user wishes to set. +# USER_FFLAGS -- Additional Fortran compiler flags that the user wishes to set. +# USER_LDLAGS -- Additional load flags that the user wishes to set. +# SMP ---------- Shared memory Multi-processing (TRUE or FALSE) [default is FALSE] +# OPT ---------- Use optimized options. +# +#------------------------------------------------------------------------ + +# Set up special characters +null := + +# Newer makes set the CURDIR variable. +CURDIR := $(shell pwd) + +RM = rm + +# Check for the netcdf library and include directories +ifeq ($(LIB_NETCDF),$(null)) + LIB_NETCDF := /usr/local/lib +endif + +ifeq ($(INC_NETCDF),$(null)) + INC_NETCDF := /usr/local/include +endif + +ifeq ($(MOD_NETCDF),$(null)) + MOD_NETCDF := $(LIB_NETCDF) +endif + +# Set user specified Fortran compiler +ifneq ($(USER_FC),$(null)) + FC := $(USER_FC) +endif + +# Set user specified C compiler +ifneq ($(USER_CC),$(null)) + CC := $(USER_CC) +endif + +# Set if Shared memory multi-processing will be used +ifeq ($(SMP),$(null)) + SMP := FALSE +endif + +CPPDEF := $(USER_CPPDEFS) + +# Set optimization on by default +ifeq ($(OPT),$(null)) + OPT := TRUE +endif + +ifeq ($(OPT),TRUE) + CPPDEF := -DOPT +endif + +# Determine platform +UNAMES := $(shell uname -s) + +# Load dependency search path. +dirs := . $(shell cat Filepath) + +# Set cpp search path, include netcdf +cpp_dirs := $(dirs) $(INC_NETCDF) $(MOD_NETCDF) +cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line + +# Expand any tildes in directory names. Change spaces to colons. +# (the vpath itself is set elsewhere, based on this variable) +vpath_dirs := $(foreach dir,$(cpp_dirs),$(wildcard $(dir))) +vpath_dirs := $(subst $(space),:,$(vpath_dirs)) + +#Primary Target: build the tool +all: $(EXENAME) + +# Get list of files and build dependency file for all .o files +# using perl scripts mkSrcfiles and mkDepends + +SOURCES := $(shell cat Srcfiles) + +OBJS := $(addsuffix .o, $(basename $(SOURCES))) + +# Set path to Mkdepends script; assumes that any Makefile including +# this file is in a sibling of the src directory, in which Mkdepends +# resides +Mkdepends := ../src/Mkdepends + +$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath + $(Mkdepends) Filepath Srcfiles > $@ + + +# Architecture-specific flags and rules +#------------------------------------------------------------------------ +# AIX +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),AIX) +CPPDEF += -DAIX +cpre = $(null)-WF,-D$(null) +FPPFLAGS := $(patsubst -D%,$(cpre)%,$(CPPDEF)) +FFLAGS = -c -I$(INC_NETCDF) -q64 -qsuffix=f=f90 -qsuffix=f=f90:cpp=F90 \ + $(FPPFLAGS) -g -qfullpath -qarch=auto -qtune=auto -qsigtrap=xl__trcedump -qsclk=micro + +LDFLAGS = -L$(LIB_NETCDF) -q64 -lnetcdff -lnetcdf +ifneq ($(OPT),TRUE) + FFLAGS += -qinitauto=7FF7FFFF -qflttrap=ov:zero:inv:en -qspillsize=4000 -C +else + FFLAGS += -O2 -qmaxmem=-1 -Q + LDFLAGS += -Q +endif +CFLAGS := -q64 -g $(CPPDEF) -O2 +FFLAGS += $(cpp_path) +CFLAGS += $(cpp_path) + +ifeq ($(SMP),TRUE) + FC = xlf90_r + FFLAGS += -qsmp=omp + LDFLAGS += -qsmp=omp +else + FC = xlf90 +endif + +endif + +#------------------------------------------------------------------------ +# Darwin +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Darwin) + +# Set the default Fortran compiler +ifeq ($(USER_FC),$(null)) + FC := g95 +endif +ifeq ($(USER_CC),$(null)) + CC := gcc +endif + +CFLAGS := -g -O2 +CPPDEF += -DSYSDARWIN -DDarwin -DLINUX +LDFLAGS := + +ifeq ($(FC),g95) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),gfortran) + + CPPDEF += -DG95 + FFLAGS := -c -fno-second-underscore $(CPPDEF) $(cpp_path) -I$(MOD_NETCDF) \ + -fno-range-check + ifeq ($(OPT),TRUE) + FFLAGS += -O2 + else + FFLAGS += -g -fbounds-check + endif + +endif + +ifeq ($(FC),ifort) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c -ftz -g -fp-model precise $(CPPDEF) $(cpp_path) \ + -convert big_endian -assume byterecl -traceback -FR + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + LDFLAGS += -openmp + endif +endif + +ifeq ($(FC),pgf90) + + CPPDEF += -DFORTRANUNDERSCORE + FFLAGS += -c $(CPPDEF) $(cpp_path) + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + +endif + +ifeq ($(CC),icc) + CFLAGS += -m64 -g + ifeq ($(SMP),TRUE) + CFLAGS += -openmp + endif +endif +ifeq ($(CC),pgcc) + CFLAGS += -g -fast +endif + +CFLAGS += $(CPPDEF) $(cpp_path) +LDFLAGS += -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +endif + +#------------------------------------------------------------------------ +# Linux +#------------------------------------------------------------------------ + +ifeq ($(UNAMES),Linux) + ifeq ($(USER_FC),$(null)) + FC := ifort + FCTYP := ifort + else + ifeq ($(USER_FC),ftn) + ifneq ($(USER_FCTYP),$(null)) + FCTYP := $(USER_FCTYP) + else + FCTYP := pgf90 + endif + else + FCTYP := $(USER_FC) + endif + endif + CPPDEF += -DLINUX -DFORTRANUNDERSCORE + CFLAGS := $(CPPDEF) + LDFLAGS := $(shell $(LIB_NETCDF)/../bin/nf-config --flibs) + FFLAGS = + + ifeq ($(FCTYP),pgf90) + CC := pgcc + ifneq ($(OPT),TRUE) + FFLAGS += -g -Ktrap=fp -Mbounds -Kieee + else + FFLAGS += -fast -Kieee + CFLAGS += -fast + endif + + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + + endif + + ifeq ($(FCTYP),lf95) + ifneq ($(OPT),TRUE) + FFLAGS += -g --chk a,e,s,u -O0 + else + FFLAGS += -O + endif + # Threading only works by putting thread memory on the heap rather than the stack + # (--threadheap). + # As of lf95 version 6.2 the thread stacksize limits are (still) too small to run + # even small + # resolution problems (FV at 10x15 res fails). + ifeq ($(SMP),TRUE) + FFLAGS += --openmp --threadheap 4096 + LDFLAGS += --openmp --threadheap 4096 + endif + endif + ifeq ($(FCTYP),pathf90) + FFLAGS += -extend_source -ftpp -fno-second-underscore + ifneq ($(OPT),TRUE) + FFLAGS += -g -O0 + else + FFLAGS += -O + endif + ifeq ($(SMP),TRUE) + FFLAGS += -mp + LDFLAGS += -mp + endif + endif + ifeq ($(FCTYP),ifort) + + FFLAGS += -ftz -g -fp-model precise -convert big_endian -assume byterecl -traceback -FR + CFLAGS += -m64 -g + LDFLAGS += -m64 + + ifneq ($(OPT),TRUE) + FFLAGS += -CB -O0 + else + FFLAGS += -O2 + endif + ifeq ($(SMP),TRUE) + FFLAGS += -openmp + CFLAGS += -openmp + LDFLAGS += -openmp + endif + endif + FFLAGS += -c -I$(INC_NETCDF) $(CPPDEF) $(cpp_path) + CFLAGS += $(cpp_path) +endif + +#------------------------------------------------------------------------ +# Default rules and macros +#------------------------------------------------------------------------ + +.SUFFIXES: +.SUFFIXES: .F90 .c .o + +# Set the vpath for all file types EXCEPT .o +# We do this for individual file types rather than generally using +# VPATH, because for .o files, we don't want to use files from a +# different build (e.g., in building the unit tester, we don't want to +# use .o files from the main build) +vpath %.F90 $(vpath_dirs) +vpath %.c $(vpath_dirs) +vpath %.h $(vpath_dirs) + +# Append user defined compiler and load flags to Makefile defaults +CFLAGS += $(USER_CFLAGS) +FFLAGS += $(USER_FFLAGS) +LDFLAGS += $(USER_LDFLAGS) + +# Set user specified linker +ifneq ($(USER_LINKER),$(null)) + LINKER := $(USER_LINKER) +else + LINKER := $(FC) +endif + +.F90.o: + $(FC) $(FFLAGS) $< + +.c.o: + $(CC) -c $(CFLAGS) $< + + +$(EXENAME): $(OBJS) + $(LINKER) -o $@ $(OBJS) $(LDFLAGS) + +clean: + $(RM) -f $(OBJS) *.mod Depends + +include $(CURDIR)/Depends diff --git a/components/clm/tools/shared/mkprocdata_map/src/Mkdepends b/components/clm/tools/shared/mkprocdata_map/src/Mkdepends new file mode 100755 index 0000000000..a75e8fdde0 --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/Mkdepends @@ -0,0 +1,327 @@ +#!/usr/bin/env perl + +# Generate dependencies in a form suitable for inclusion into a Makefile. +# The source filenames are provided in a file, one per line. Directories +# to be searched for the source files and for their dependencies are provided +# in another file, one per line. Output is written to STDOUT. +# +# For CPP type dependencies (lines beginning with #include) the dependency +# search is recursive. Only dependencies that are found in the specified +# directories are included. So, for example, the standard include file +# stdio.h would not be included as a dependency unless /usr/include were +# one of the specified directories to be searched. +# +# For Fortran module USE dependencies (lines beginning with a case +# insensitive "USE", possibly preceded by whitespace) the Fortran compiler +# must be able to access the .mod file associated with the .o file that +# contains the module. In order to correctly generate these dependencies +# two restrictions must be observed. +# 1) All modules must be contained in files that have the same base name as +# the module, in a case insensitive sense. This restriction implies that +# there can only be one module per file. +# 2) All modules that are to be contained in the dependency list must be +# contained in one of the source files in the list provided on the command +# line. +# The reason for the second restriction is that since the makefile doesn't +# contain rules to build .mod files the dependency takes the form of the .o +# file that contains the module. If a module is being used for which the +# source code is not available (e.g., a module from a library), then adding +# a .o dependency for that module is a mistake because make will attempt to +# build that .o file, and will fail if the source code is not available. +# +# Author: B. Eaton +# Climate Modelling Section, NCAR +# Feb 2001 + +use Getopt::Std; +use File::Basename; + +# Check for usage request. +@ARGV >= 2 or usage(); + +# Process command line. +my %opt = (); +getopts( "t:w", \%opt ) or usage(); +my $filepath_arg = shift() or usage(); +my $srcfile_arg = shift() or usage(); +@ARGV == 0 or usage(); # Check that all args were processed. + +my $obj_dir; +if ( defined $opt{'t'} ) { $obj_dir = $opt{'t'}; } + +open(FILEPATH, $filepath_arg) or die "Can't open $filepath_arg: $!\n"; +open(SRCFILES, $srcfile_arg) or die "Can't open $srcfile_arg: $!\n"; + +# Make list of paths to use when looking for files. +# Prepend "." so search starts in current directory. This default is for +# consistency with the way GNU Make searches for dependencies. +my @file_paths = ; +close(FILEPATH); +chomp @file_paths; +unshift(@file_paths,'.'); +foreach $dir (@file_paths) { # (could check that directories exist here) + $dir =~ s!/?\s*$!!; # remove / and any whitespace at end of directory name + ($dir) = glob $dir; # Expand tildes in path names. +} + +# Make list of files containing source code. +my @src = ; +close(SRCFILES); +chomp @src; + +# For each file that may contain a Fortran module (*.[fF]90 *.[fF]) convert the +# file's basename to uppercase and use it as a hash key whose value is the file's +# basename. This allows fast identification of the files that contain modules. +# The only restriction is that the file's basename and the module name must match +# in a case insensitive way. +my %module_files = (); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.[fF]90', '\.[fF]' ); +foreach $f (@src) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $module_files{$mod} = $name; +} + +# Now make a list of .mod files in the file_paths. If a .o source dependency +# can't be found based on the module_files list above, then maybe a .mod +# module dependency can if the mod file is visible. +my %trumod_files = (); +my ($dir); +my ($f, $name, $path, $suffix, $mod); +my @suffixes = ('\.mod' ); +foreach $dir (@file_paths) { + @filenames = (glob("$dir/*.mod")); + foreach $f (@filenames) { + ($name, $path, $suffix) = fileparse($f, @suffixes); + ($mod = $name) =~ tr/a-z/A-Z/; + $trumod_files{$mod} = $name; + } +} + +#print STDERR "\%module_files\n"; +#while ( ($k,$v) = each %module_files ) { +# print STDERR "$k => $v\n"; +#} + +# Find module and include dependencies of the source files. +my ($file_path, $rmods, $rincs); +my %file_modules = (); +my %file_includes = (); +my @check_includes = (); +foreach $f ( @src ) { + + # Find the file in the seach path (@file_paths). + unless ($file_path = find_file($f)) { + if (defined $opt{'w'}) {print STDERR "$f not found\n";} + next; + } + + # Find the module and include dependencies. + ($rmods, $rincs) = find_dependencies( $file_path ); + + # Remove redundancies (a file can contain multiple procedures that have + # the same dependencies). + $file_modules{$f} = rm_duplicates($rmods); + $file_includes{$f} = rm_duplicates($rincs); + + # Make a list of all include files. + push @check_includes, @{$file_includes{$f}}; +} + +#print STDERR "\%file_modules\n"; +#while ( ($k,$v) = each %file_modules ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} +#print STDERR "\@check_includes\n"; +#print STDERR "@check_includes\n"; + +# Find include file dependencies. +my %include_depends = (); +while (@check_includes) { + $f = shift @check_includes; + if (defined($include_depends{$f})) { next; } + + # Mark files not in path so they can be removed from the dependency list. + unless ($file_path = find_file($f)) { + $include_depends{$f} = -1; + next; + } + + # Find include file dependencies. + ($rmods, $include_depends{$f}) = find_dependencies($file_path); + + # Add included include files to the back of the check_includes list so + # that their dependencies can be found. + push @check_includes, @{$include_depends{$f}}; + + # Add included modules to the include_depends list. + if ( @$rmods ) { push @{$include_depends{$f}}, @$rmods; } +} + +#print STDERR "\%include_depends\n"; +#while ( ($k,$v) = each %include_depends ) { +# print STDERR (ref $v ? "$k => @$v\n" : "$k => $v\n"); +#} + +# Remove include file dependencies that are not in the Filepath. +my $i, $ii; +foreach $f (keys %include_depends) { + + unless (ref $include_depends{$f}) { next; } + $rincs = $include_depends{$f}; + unless (@$rincs) { next; } + $ii = 0; + $num_incs = @$rincs; + for ($i = 0; $i < $num_incs; ++$i) { + if ($include_depends{$$rincs[$ii]} == -1) { + splice @$rincs, $ii, 1; + next; + } + ++$ii; + } +} + +# Substitute the include file dependencies into the %file_includes lists. +foreach $f (keys %file_includes) { + my @expand_incs = (); + + # Initialize the expanded %file_includes list. + my $i; + unless (@{$file_includes{$f}}) { next; } + foreach $i (@{$file_includes{$f}}) { + push @expand_incs, $i unless ($include_depends{$i} == -1); + } + unless (@expand_incs) { + $file_includes{$f} = []; + next; + } + + # Expand + for ($i = 0; $i <= $#expand_incs; ++$i) { + push @expand_incs, @{ $include_depends{$expand_incs[$i]} }; + } + + $file_includes{$f} = rm_duplicates(\@expand_incs); +} + +#print STDERR "expanded \%file_includes\n"; +#while ( ($k,$v) = each %file_includes ) { +# print STDERR "$k => @$v\n"; +#} + +# Print dependencies to STDOUT. +foreach $f (sort keys %file_modules) { + $f =~ /(.+)\./; + $target = "$1.o"; + if ( defined $opt{'t'} ) { $target = "$opt{'t'}/$1.o"; } + print "$target : $f @{$file_modules{$f}} @{$file_includes{$f}}\n"; +} + +#-------------------------------------------------------------------------------------- + +sub find_dependencies { + + # Find dependencies of input file. + # Use'd Fortran 90 modules are returned in \@mods. + # Files that are "#include"d by the cpp preprocessor are returned in \@incs. + + my( $file ) = @_; + my( @mods, @incs ); + + open(FH, $file) or die "Can't open $file: $!\n"; + + while ( ) { + # Search for "#include" and strip filename when found. + if ( /^#include\s+[<"](.*)[>"]/ ) { + push @incs, $1; + } + # Search for Fortran include dependencies. + elsif ( /^\s*include\s+['"](.*)['"]/ ) { #" for emacs fontlock + push @incs, $1; + } + # Search for module dependencies. + elsif ( /^\s*USE\s+(\w+)/i ) { + ($module = $1) =~ tr/a-z/A-Z/; + # Return dependency in the form of a .o version of the file that contains + # the module. this is from the source list. + if ( defined $module_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$module_files{$module}.o"; + } else { + push @mods, "$module_files{$module}.o"; + } + } + # Return dependency in the form of a .mod version of the file that contains + # the module. this is from the .mod list. only if .o version not found + elsif ( defined $trumod_files{$module} ) { + if ( defined $obj_dir ) { + push @mods, "$obj_dir/$trumod_files{$module}.mod"; + } else { + push @mods, "$trumod_files{$module}.mod"; + } + } + } + } + close( FH ); + return (\@mods, \@incs); +} + +#-------------------------------------------------------------------------------------- + +sub find_file { + +# Search for the specified file in the list of directories in the global +# array @file_paths. Return the first occurance found, or the null string if +# the file is not found. + + my($file) = @_; + my($dir, $fname); + + foreach $dir (@file_paths) { + $fname = "$dir/$file"; + if ( -f $fname ) { return $fname; } + } + return ''; # file not found +} + +#-------------------------------------------------------------------------------------- + +sub rm_duplicates { + +# Return a list with duplicates removed. + + my ($in) = @_; # input arrary reference + my @out = (); + my $i; + my %h = (); + foreach $i (@$in) { + $h{$i} = ''; + } + @out = keys %h; + return \@out; +} + +#-------------------------------------------------------------------------------------- + +sub usage { + ($ProgName = $0) =~ s!.*/!!; # name of program + die < shr_kind_r8 + implicit none + save + + real(R8),parameter :: SHR_CONST_REARTH = 6.37122e6_R8 ! radius of earth ~ m + real(r8),parameter :: re_km = SHR_CONST_REARTH*0.001 ! radius of earth (km) + +end module constMod diff --git a/components/clm/tools/shared/mkprocdata_map/src/fileutils.F90 b/components/clm/tools/shared/mkprocdata_map/src/fileutils.F90 new file mode 100644 index 0000000000..e1f8e633da --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/fileutils.F90 @@ -0,0 +1,282 @@ +module fileutils + +!----------------------------------------------------------------------- +!BOP +! +! !MODULE: fileutils +! +! !DESCRIPTION: +! Module containing file I/O utilities +! +! !USES: +! +! !PUBLIC TYPES: + implicit none + save +! +! !PUBLIC MEMBER FUNCTIONS: + public :: get_filename !Returns filename given full pathname + public :: opnfil !Open local unformatted or formatted file + public :: getfil !Obtain local copy of file + public :: relavu !Close and release Fortran unit no longer in use + public :: getavu !Get next available Fortran unit number +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !PRIVATE MEMBER FUNCTIONS: None +!EOP +!----------------------------------------------------------------------- + +contains + +!----------------------------------------------------------------------- +!BOP +! +! !IROUTINE: get_filename +! +! !INTERFACE: + character(len=256) function get_filename (fulpath) +! +! !DESCRIPTION: +! Returns filename given full pathname +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fulpath !full pathname +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + integer klen !length of fulpath character string +!------------------------------------------------------------------------ + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i) == '/') go to 10 + end do + i = 0 +10 get_filename = fulpath(i+1:klen) + + end function get_filename + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: set_filename +! +! !INTERFACE: + character(len=256) function set_filename (rem_dir, loc_fn) +! +! !DESCRIPTION: +! +! !ARGUMENTS: +! + implicit none + character(len=*), intent(in) :: rem_dir !remote directory + character(len=*), intent(in) :: loc_fn !local full path filename +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer :: i !integer +!------------------------------------------------------------------------ + + set_filename = ' ' + do i = len_trim(loc_fn), 1, -1 + if (loc_fn(i:i)=='/') go to 10 + end do + i = 0 +10 set_filename = trim(rem_dir) // loc_fn(i+1:len_trim(loc_fn)) + + end function set_filename + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: getfil +! +! !INTERFACE: + subroutine getfil (fulpath, locfn, iflag) +! +! !DESCRIPTION: +! Obtain local copy of file +! First check current working directory +! Next check full pathname[fulpath] on disk +! Finally check full pathname[fulpath] on archival system +! +! !USES: +! +! !ARGUMENTS: + implicit none + character(len=*), intent(in) :: fulpath !Archival or permanent disk full pathname + character(len=*), intent(out) :: locfn !output local file name + integer, optional, intent(in) :: iflag !0=>abort if file not found 1=>do not abort +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer i !loop index + integer klen !length of fulpath character string + integer ierr !error status + logical lexist !true if local file exists + character(len=len(fulpath)+5) :: fulpath2 !Archival full pathname +!------------------------------------------------------------------------ + + ! get local file name from full name: start at end. look for first "/" + + klen = len_trim(fulpath) + do i = klen, 1, -1 + if (fulpath(i:i).eq.'/') go to 100 + end do + i = 0 +100 locfn = fulpath(i+1:klen) + if (len_trim(locfn) == 0) then + write(6,*)'(GETFIL): local filename has zero length' + stop 1 + else + write(6,*)'(GETFIL): attempting to find local file ',trim(locfn) + endif + + ! first check if file is in current working directory. + + inquire (file=locfn,exist=lexist) + if (lexist) then + write(6,*) '(GETFIL): using ',trim(locfn),' in current working directory' + RETURN + endif + + ! second check for full pathname on disk + + inquire(file=fulpath, exist=lexist) + if (lexist) then + locfn = trim(fulpath) + write(6,*) '(GETFIL): using ',trim(fulpath) + RETURN + else + write(6,*) 'GETFIL: FAILED to get '//trim(fulpath) + stop 1 + end if + + end subroutine getfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: opnfil +! +! !INTERFACE: + subroutine opnfil (locfn, iun, form) +! +! !DESCRIPTION: +! Open file locfn in unformatted or formatted form on unit iun +! +! !ARGUMENTS: +! + implicit none + character(len=*), intent(in):: locfn !file name + integer, intent(in):: iun !fortran unit number + character(len=1), intent(in):: form !file format: u = unformatted, + !f = formatted +! +! !REVISION HISTORY: +! Created by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP + integer ioe !error return from fortran open + character(len=11) ft !format type: formatted. unformatted +!------------------------------------------------------------------------ + + if (len_trim(locfn) == 0) then + write(6,*)'OPNFIL: local filename has zero length' + stop 1 + endif + if (form=='u' .or. form=='U') then + ft = 'unformatted' + else + ft = 'formatted ' + end if + open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe) + if (ioe /= 0) then + write(6,*)'(OPNFIL): failed to open file ',trim(locfn), & + & ' on unit ',iun,' ierr=',ioe + stop 1 + else + write(6,*)'(OPNFIL): Successfully opened file ',trim(locfn),' on unit= ',iun + end if + + end subroutine opnfil + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: getavu +! +! !INTERFACE: + integer function getavu() +! +! !DESCRIPTION: +! Get next available Fortran unit number. +! +! !USES: + use shr_file_mod, only : shr_file_getUnit +! +! !ARGUMENTS: + implicit none +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! Modified for clm2 by Mariana Vertenstein +! +! +! !LOCAL VARIABLES: +!EOP +!------------------------------------------------------------------------ + + getavu = shr_file_getunit() + + end function getavu + +!------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: relavu +! +! !INTERFACE: + subroutine relavu (iunit) +! +! !DESCRIPTION: +! Close and release Fortran unit no longer in use! +! +! !USES: + use shr_file_mod, only : shr_file_freeUnit +! +! !ARGUMENTS: + implicit none + integer, intent(in) :: iunit !Fortran unit number +! +! !REVISION HISTORY: +! Created by Gordon Bonan +! +!EOP +!------------------------------------------------------------------------ + + close(iunit) + call shr_file_freeUnit(iunit) + + end subroutine relavu + +end module fileutils diff --git a/components/clm/tools/shared/mkprocdata_map/src/fmain.F90 b/components/clm/tools/shared/mkprocdata_map/src/fmain.F90 new file mode 100644 index 0000000000..ba9e593c1d --- /dev/null +++ b/components/clm/tools/shared/mkprocdata_map/src/fmain.F90 @@ -0,0 +1,78 @@ +program fmain + + use mkprocdata_map, only : mkmap + implicit none + + character(len= 256) :: arg + integer :: n !index + integer :: nargs !number of arguments + integer, external :: iargc !number of arguments function + character(len=256) :: filei !input file + character(len=256) :: fileo !output mapped file + character(len=256) :: fmap !maping file + character(len=256) :: ftemplate !template file, containing lat & lon arrays desired in output file + character(len=256) :: cmdline !input command line + integer, parameter :: inival = -999 !initial value for command-line integers + !---------------------------------------------------- + + filei = ' ' + fileo = ' ' + fmap = ' ' + ftemplate = ' ' + + cmdline = 'mkprocdata_map' + nargs = iargc() + n = 1 + do while (n <= nargs) + arg = ' ' + call getarg (n, arg) + n = n + 1 + + select case (arg) + case ('-i') + call getarg (n, arg) + n = n + 1 + filei = trim(arg) + cmdline = trim(cmdline) // ' -i ' // trim(arg) + case ('-o') + call getarg (n, arg) + n = n + 1 + fileo = trim(arg) + cmdline = trim(cmdline) // ' -o ' // trim(arg) + case ('-m') + call getarg (n, arg) + n = n + 1 + fmap = trim(arg) + cmdline = trim(cmdline) // ' -m ' // trim(arg) + case ('-t') + call getarg (n, arg) + n = n + 1 + ftemplate = trim(arg) + cmdline = trim(cmdline) // ' -t ' // trim(arg) + case default + write (6,*) 'Argument ', arg,' is not known' + call usage_exit (' ') + cmdline = trim(cmdline) // ' ' // trim(arg) + end select + end do + + if (filei == ' ' .or. fileo == ' ' .or. fmap == ' ' & + .or. ftemplate == ' ') then + call usage_exit ('Must specify all the following arguments') + end if + + call mkmap (filei, fileo, fmap, ftemplate) + +end program fmain + + +subroutine usage_exit (arg) + implicit none + character(len=*) :: arg + if (arg /= ' ') write (6,*) arg + write (6,*) 'Usage: mkprocdata_map -i -o -m -t